summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJason Molenda <jmolenda@apple.com>2000-02-07 00:19:28 +0000
committerJason Molenda <jmolenda@apple.com>2000-02-07 00:19:28 +0000
commitb111a96ea19bde1004ecea63c7827a1d4b0b73ef (patch)
tree2b8155215201f5224d8f68ec53f9720a89dfbdd9
parentb73e43e34794f4903b0bf2e0fc1298547ef01faf (diff)
downloadgdb-b111a96ea19bde1004ecea63c7827a1d4b0b73ef.tar.gz
import insight-2000-02-04 snapshot (2nd try)
-rw-r--r--itcl/ChangeLog290
-rw-r--r--itcl/INCOMPATIBLE102
-rw-r--r--itcl/Makefile.in94
-rw-r--r--itcl/TODO181
-rw-r--r--itcl/aclocal.m4524
-rwxr-xr-xitcl/config/config.guess483
-rwxr-xr-xitcl/config/config.sub793
-rwxr-xr-xitcl/config/install-sh119
-rwxr-xr-xitcl/config/mkinstalldirs32
-rwxr-xr-xitcl/configure976
-rw-r--r--itcl/configure.in37
-rw-r--r--itcl/doc/README14
-rw-r--r--itcl/itcl/doc/Resolvers.3222
-rw-r--r--itcl/itcl/doc/body.n124
-rw-r--r--itcl/itcl/doc/class.n490
-rw-r--r--itcl/itcl/doc/code.n96
-rw-r--r--itcl/itcl/doc/configbody.n129
-rw-r--r--itcl/itcl/doc/delete.n64
-rw-r--r--itcl/itcl/doc/ensemble.n173
-rw-r--r--itcl/itcl/doc/find.n62
-rw-r--r--itcl/itcl/doc/itcl.n147
-rw-r--r--itcl/itcl/doc/itcl_class.n419
-rw-r--r--itcl/itcl/doc/itcl_info.n62
-rw-r--r--itcl/itcl/doc/itclsh.130
-rw-r--r--itcl/itcl/doc/itclvars.n96
-rw-r--r--itcl/itcl/doc/license.terms27
-rw-r--r--itcl/itcl/doc/local.n75
-rw-r--r--itcl/itcl/doc/man.macros236
-rw-r--r--itcl/itcl/doc/scope.n77
-rw-r--r--itcl/itcl/generic/itcl.h188
-rw-r--r--itcl/itcl/generic/itclInt.h535
-rw-r--r--itcl/itcl/generic/itcl_bicmds.c1695
-rw-r--r--itcl/itcl/generic/itcl_class.c1728
-rw-r--r--itcl/itcl/generic/itcl_cmds.c1359
-rw-r--r--itcl/itcl/generic/itcl_ensemble.c2248
-rw-r--r--itcl/itcl/generic/itcl_linkage.c327
-rw-r--r--itcl/itcl/generic/itcl_methods.c2557
-rw-r--r--itcl/itcl/generic/itcl_migrate.c139
-rw-r--r--itcl/itcl/generic/itcl_objects.c1202
-rw-r--r--itcl/itcl/generic/itcl_obsolete.c1959
-rw-r--r--itcl/itcl/generic/itcl_parse.c1086
-rw-r--r--itcl/itcl/generic/itcl_util.c1383
-rw-r--r--itcl/itcl/itclConfig.sh.in42
-rw-r--r--itcl/itcl/library/itcl.tcl149
-rw-r--r--itcl/itcl/license.terms38
-rw-r--r--itcl/itcl/mac/itclMacApplication.r99
-rw-r--r--itcl/itcl/mac/itclMacLibrary.r154
-rw-r--r--itcl/itcl/mac/itclMacResource.r94
-rw-r--r--itcl/itcl/mac/itclMacTclCode.r32
-rw-r--r--itcl/itcl/mac/itclStaticApplication.r26
-rw-r--r--itcl/itcl/mac/pkgIndex.tcl3
-rw-r--r--itcl/itcl/mac/tclMacAppInit.c227
-rw-r--r--itcl/itcl/tests/all16
-rw-r--r--itcl/itcl/tests/basic.test319
-rw-r--r--itcl/itcl/tests/body.test218
-rw-r--r--itcl/itcl/tests/chain.test148
-rw-r--r--itcl/itcl/tests/defs343
-rw-r--r--itcl/itcl/tests/delete.test204
-rw-r--r--itcl/itcl/tests/ensemble.test185
-rw-r--r--itcl/itcl/tests/info.test384
-rw-r--r--itcl/itcl/tests/inherit.test576
-rw-r--r--itcl/itcl/tests/interp.test68
-rw-r--r--itcl/itcl/tests/local.test66
-rw-r--r--itcl/itcl/tests/methods.test128
-rw-r--r--itcl/itcl/tests/mkindex.itcl88
-rw-r--r--itcl/itcl/tests/mkindex.test44
-rw-r--r--itcl/itcl/tests/namespace.test74
-rw-r--r--itcl/itcl/tests/old/AAA.test82
-rw-r--r--itcl/itcl/tests/old/Bar.tcl39
-rw-r--r--itcl/itcl/tests/old/BarFoo.tcl31
-rw-r--r--itcl/itcl/tests/old/Baz.tcl27
-rw-r--r--itcl/itcl/tests/old/Foo.tcl99
-rw-r--r--itcl/itcl/tests/old/FooBar.tcl31
-rw-r--r--itcl/itcl/tests/old/Geek.tcl44
-rw-r--r--itcl/itcl/tests/old/Mongrel.tcl34
-rw-r--r--itcl/itcl/tests/old/VirtualErr.tcl23
-rw-r--r--itcl/itcl/tests/old/all32
-rw-r--r--itcl/itcl/tests/old/basic.test408
-rw-r--r--itcl/itcl/tests/old/inherit.test272
-rw-r--r--itcl/itcl/tests/old/tclIndex24
-rw-r--r--itcl/itcl/tests/old/testlib.tcl131
-rw-r--r--itcl/itcl/tests/old/toaster.test165
-rw-r--r--itcl/itcl/tests/old/toasters/Appliance.tcl43
-rw-r--r--itcl/itcl/tests/old/toasters/Hazard.tcl78
-rw-r--r--itcl/itcl/tests/old/toasters/Outlet.tcl81
-rw-r--r--itcl/itcl/tests/old/toasters/SmartToaster.tcl40
-rw-r--r--itcl/itcl/tests/old/toasters/Toaster.tcl75
-rw-r--r--itcl/itcl/tests/old/toasters/tclIndex18
-rw-r--r--itcl/itcl/tests/old/toasters/usualway.tcl122
-rw-r--r--itcl/itcl/tests/old/uplevel.test155
-rw-r--r--itcl/itcl/tests/old/upvar.test110
-rw-r--r--itcl/itcl/tests/protection.test370
-rw-r--r--itcl/itcl/tests/scope.test207
-rw-r--r--itcl/itcl/tests/tclIndex24
-rw-r--r--itcl/itcl/unix/Makefile.in321
-rwxr-xr-xitcl/itcl/unix/configure1521
-rw-r--r--itcl/itcl/unix/configure.in224
-rw-r--r--itcl/itcl/unix/pkgIndex.tcl.in3
-rw-r--r--itcl/itcl/unix/tclAppInit.c157
-rw-r--r--itcl/itcl/win/Makefile.in404
-rwxr-xr-xitcl/itcl/win/configure2781
-rw-r--r--itcl/itcl/win/configure.in429
-rw-r--r--itcl/itcl/win/dllEntryPoint.c90
-rw-r--r--itcl/itcl/win/itcl.rc41
-rw-r--r--itcl/itcl/win/itclsh.rc37
-rw-r--r--itcl/itcl/win/makefile.bc212
-rw-r--r--itcl/itcl/win/makefile.vc147
-rw-r--r--itcl/itcl/win/pkgIndex.tcl3
-rw-r--r--itcl/itcl/win/tclAppInit.c280
-rw-r--r--itcl/itk/demos/README9
-rw-r--r--itcl/itk/demos/itkedit227
-rw-r--r--itcl/itk/doc/Archetype.n353
-rw-r--r--itcl/itk/doc/Toplevel.n133
-rw-r--r--itcl/itk/doc/Widget.n123
-rw-r--r--itcl/itk/doc/itk.n96
-rw-r--r--itcl/itk/doc/itkvars.n43
-rw-r--r--itcl/itk/doc/itkwish.155
-rw-r--r--itcl/itk/doc/license.terms27
-rw-r--r--itcl/itk/doc/man.macros236
-rw-r--r--itcl/itk/doc/usual.n76
-rw-r--r--itcl/itk/examples/Info.itk59
-rw-r--r--itcl/itk/examples/MessageInfo.itk40
-rw-r--r--itcl/itk/examples/README30
-rw-r--r--itcl/itk/examples/TextDisplay.itk136
-rw-r--r--itcl/itk/examples/TextInfo.itk46
-rw-r--r--itcl/itk/examples/tclIndex16
-rw-r--r--itcl/itk/examples/viewfile44
-rw-r--r--itcl/itk/generic/itk.h157
-rw-r--r--itcl/itk/generic/itk_archetype.c4172
-rw-r--r--itcl/itk/generic/itk_cmds.c316
-rw-r--r--itcl/itk/generic/itk_option.c586
-rw-r--r--itcl/itk/generic/itk_util.c200
-rw-r--r--itcl/itk/itkConfig.sh.in39
-rw-r--r--itcl/itk/library/Archetype.itk100
-rw-r--r--itcl/itk/library/Toplevel.itk73
-rw-r--r--itcl/itk/library/Widget.itk70
-rw-r--r--itcl/itk/library/itk.tcl133
-rw-r--r--itcl/itk/library/tclIndex11
-rw-r--r--itcl/itk/license.terms38
-rw-r--r--itcl/itk/mac/MW_ItkHeader.pch73
-rw-r--r--itcl/itk/mac/itkMacApplication.r1676
-rw-r--r--itcl/itk/mac/itkMacLibrary.r94
-rw-r--r--itcl/itk/mac/itkMacResource.r1376
-rw-r--r--itcl/itk/mac/itkMacTclCode.r29
-rw-r--r--itcl/itk/mac/itkStaticApplication.r29
-rw-r--r--itcl/itk/mac/pkgIndex.tcl3
-rw-r--r--itcl/itk/mac/tclIndex11
-rw-r--r--itcl/itk/mac/tkMacAppInit.c418
-rw-r--r--itcl/itk/tests/all16
-rw-r--r--itcl/itk/tests/defs343
-rw-r--r--itcl/itk/tests/interp.test48
-rw-r--r--itcl/itk/tests/option.test179
-rw-r--r--itcl/itk/tests/privacy.test94
-rw-r--r--itcl/itk/tests/public.test75
-rw-r--r--itcl/itk/tests/toplevel.test80
-rw-r--r--itcl/itk/tests/widget.test243
-rw-r--r--itcl/itk/unix/Makefile.in336
-rwxr-xr-xitcl/itk/unix/configure1608
-rw-r--r--itcl/itk/unix/configure.in278
-rw-r--r--itcl/itk/unix/pkgIndex.tcl.in3
-rw-r--r--itcl/itk/unix/tkAppInit.c151
-rw-r--r--itcl/itk/win/Makefile.in424
-rw-r--r--itcl/itk/win/Makefile.in_first277
-rwxr-xr-xitcl/itk/win/configure4120
-rw-r--r--itcl/itk/win/configure.in630
-rw-r--r--itcl/itk/win/dllEntryPoint.c92
-rw-r--r--itcl/itk/win/makefile.bc228
-rw-r--r--itcl/itk/win/makefile.vc271
-rw-r--r--itcl/itk/win/pkgIndex.tcl3
-rw-r--r--itcl/itk/win/rc/cursor00.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor02.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor04.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor06.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor08.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor0a.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor0c.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor0e.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor10.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor12.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor14.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor16.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor18.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor1a.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor1c.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor1e.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor20.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor22.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor24.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor26.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor28.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor2a.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor2c.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor2e.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor30.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor32.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor34.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor36.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor38.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor3a.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor3c.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor3e.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor40.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor42.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor44.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor46.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor48.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor4a.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor4c.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor4e.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor50.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor52.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor54.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor56.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor58.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor5a.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor5c.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor5e.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor60.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor62.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor64.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor66.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor68.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor6a.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor6c.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor6e.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor70.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor72.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor74.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor76.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor78.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor7a.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor7c.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor7e.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor80.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor82.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor84.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor86.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor88.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor8a.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor8c.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor8e.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor90.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor92.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor94.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor96.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/cursor98.curbin0 -> 326 bytes
-rw-r--r--itcl/itk/win/rc/itk.icobin0 -> 1398 bytes
-rw-r--r--itcl/itk/win/rc/itk.rc126
-rw-r--r--itcl/itk/win/rc/itkwish.rc43
-rw-r--r--itcl/itk/win/winMain.c354
-rw-r--r--itcl/iwidgets3.0.0/CHANGES1508
-rw-r--r--itcl/iwidgets3.0.0/README282
-rwxr-xr-xitcl/iwidgets3.0.0/catalog373
-rwxr-xr-xitcl/iwidgets3.0.0/demos/buttonbox19
-rwxr-xr-xitcl/iwidgets3.0.0/demos/calendar30
-rwxr-xr-xitcl/iwidgets3.0.0/demos/canvasprintdialog36
-rwxr-xr-xitcl/iwidgets3.0.0/demos/checkbox18
-rwxr-xr-xitcl/iwidgets3.0.0/demos/combobox19
-rwxr-xr-xitcl/iwidgets3.0.0/demos/dateentry18
-rwxr-xr-xitcl/iwidgets3.0.0/demos/datefield17
-rw-r--r--itcl/iwidgets3.0.0/demos/demo.html41
-rwxr-xr-xitcl/iwidgets3.0.0/demos/dialog51
-rwxr-xr-xitcl/iwidgets3.0.0/demos/dialogshell40
-rwxr-xr-xitcl/iwidgets3.0.0/demos/disjointlistbox12
-rwxr-xr-xitcl/iwidgets3.0.0/demos/entryfield38
-rwxr-xr-xitcl/iwidgets3.0.0/demos/extfileselectionbox14
-rw-r--r--itcl/iwidgets3.0.0/demos/extfileselectiondialog18
-rw-r--r--itcl/iwidgets3.0.0/demos/feedback26
-rwxr-xr-xitcl/iwidgets3.0.0/demos/fileselectionbox14
-rwxr-xr-xitcl/iwidgets3.0.0/demos/fileselectiondialog18
-rwxr-xr-xitcl/iwidgets3.0.0/demos/finddialog225
-rwxr-xr-xitcl/iwidgets3.0.0/demos/hierarchy160
-rw-r--r--itcl/iwidgets3.0.0/demos/html/buttonbox.n.html245
-rw-r--r--itcl/iwidgets3.0.0/demos/html/canvasprintbox.n.html302
-rw-r--r--itcl/iwidgets3.0.0/demos/html/canvasprintdialog.n.html203
-rw-r--r--itcl/iwidgets3.0.0/demos/html/combobox.n.html411
-rw-r--r--itcl/iwidgets3.0.0/demos/html/dialog.n.html195
-rw-r--r--itcl/iwidgets3.0.0/demos/html/dialogshell.n.html254
-rw-r--r--itcl/iwidgets3.0.0/demos/html/entryfield.n.html305
-rw-r--r--itcl/iwidgets3.0.0/demos/html/feedback.n.html195
-rw-r--r--itcl/iwidgets3.0.0/demos/html/fileselectionbox.n.html510
-rw-r--r--itcl/iwidgets3.0.0/demos/html/fileselectiondialog.n.html255
-rw-r--r--itcl/iwidgets3.0.0/demos/html/hyperhelp.n.html200
-rw-r--r--itcl/iwidgets3.0.0/demos/html/iwidgets2.2.0UserCmds.html50
-rw-r--r--itcl/iwidgets3.0.0/demos/html/labeledwidget.n.html250
-rw-r--r--itcl/iwidgets3.0.0/demos/html/menubar.n.html563
-rw-r--r--itcl/iwidgets3.0.0/demos/html/messagedialog.n.html253
-rw-r--r--itcl/iwidgets3.0.0/demos/html/notebook.n.html402
-rw-r--r--itcl/iwidgets3.0.0/demos/html/optionmenu.n.html303
-rw-r--r--itcl/iwidgets3.0.0/demos/html/panedwindow.n.html353
-rw-r--r--itcl/iwidgets3.0.0/demos/html/promptdialog.n.html201
-rw-r--r--itcl/iwidgets3.0.0/demos/html/pushbutton.n.html197
-rw-r--r--itcl/iwidgets3.0.0/demos/html/radiobox.n.html247
-rw-r--r--itcl/iwidgets3.0.0/demos/html/scrolledcanvas.n.html306
-rw-r--r--itcl/iwidgets3.0.0/demos/html/scrolledframe.n.html306
-rw-r--r--itcl/iwidgets3.0.0/demos/html/scrolledhtml.n.html415
-rw-r--r--itcl/iwidgets3.0.0/demos/html/scrolledlistbox.n.html410
-rw-r--r--itcl/iwidgets3.0.0/demos/html/scrolledtext.n.html305
-rw-r--r--itcl/iwidgets3.0.0/demos/html/selectionbox.n.html305
-rw-r--r--itcl/iwidgets3.0.0/demos/html/selectiondialog.n.html255
-rw-r--r--itcl/iwidgets3.0.0/demos/html/shell.n.html195
-rw-r--r--itcl/iwidgets3.0.0/demos/html/spindate.n.html303
-rw-r--r--itcl/iwidgets3.0.0/demos/html/spinint.n.html203
-rw-r--r--itcl/iwidgets3.0.0/demos/html/spinner.n.html258
-rw-r--r--itcl/iwidgets3.0.0/demos/html/spintime.n.html301
-rw-r--r--itcl/iwidgets3.0.0/demos/html/tabnotebook.n.html770
-rw-r--r--itcl/iwidgets3.0.0/demos/html/tabset.n.html559
-rw-r--r--itcl/iwidgets3.0.0/demos/html/toolbar.n.html348
-rwxr-xr-xitcl/iwidgets3.0.0/demos/hyperhelp19
-rw-r--r--itcl/iwidgets3.0.0/demos/images/box.xbm14
-rw-r--r--itcl/iwidgets3.0.0/demos/images/clear.gifbin0 -> 279 bytes
-rw-r--r--itcl/iwidgets3.0.0/demos/images/close.gifbin0 -> 249 bytes
-rw-r--r--itcl/iwidgets3.0.0/demos/images/copy.gifbin0 -> 269 bytes
-rw-r--r--itcl/iwidgets3.0.0/demos/images/cut.gifbin0 -> 179 bytes
-rw-r--r--itcl/iwidgets3.0.0/demos/images/exit.gifbin0 -> 396 bytes
-rw-r--r--itcl/iwidgets3.0.0/demos/images/find.gifbin0 -> 386 bytes
-rw-r--r--itcl/iwidgets3.0.0/demos/images/help.gifbin0 -> 591 bytes
-rw-r--r--itcl/iwidgets3.0.0/demos/images/line.xbm14
-rw-r--r--itcl/iwidgets3.0.0/demos/images/mag.gifbin0 -> 183 bytes
-rw-r--r--itcl/iwidgets3.0.0/demos/images/new.gifbin0 -> 212 bytes
-rw-r--r--itcl/iwidgets3.0.0/demos/images/open.gifbin0 -> 258 bytes
-rw-r--r--itcl/iwidgets3.0.0/demos/images/oval.xbm14
-rw-r--r--itcl/iwidgets3.0.0/demos/images/paste.gifbin0 -> 376 bytes
-rw-r--r--itcl/iwidgets3.0.0/demos/images/points.xbm14
-rw-r--r--itcl/iwidgets3.0.0/demos/images/poly.gifbin0 -> 141 bytes
-rw-r--r--itcl/iwidgets3.0.0/demos/images/print.gifbin0 -> 263 bytes
-rw-r--r--itcl/iwidgets3.0.0/demos/images/ruler.gifbin0 -> 174 bytes
-rw-r--r--itcl/iwidgets3.0.0/demos/images/save.gifbin0 -> 270 bytes
-rw-r--r--itcl/iwidgets3.0.0/demos/images/select.gifbin0 -> 124 bytes
-rw-r--r--itcl/iwidgets3.0.0/demos/images/text.xbm14
-rw-r--r--itcl/iwidgets3.0.0/demos/iwidgets.gifbin0 -> 7727 bytes
-rwxr-xr-xitcl/iwidgets3.0.0/demos/labeledframe53
-rwxr-xr-xitcl/iwidgets3.0.0/demos/labeledwidget28
-rw-r--r--itcl/iwidgets3.0.0/demos/mainwindow165
-rwxr-xr-xitcl/iwidgets3.0.0/demos/menubar79
-rwxr-xr-xitcl/iwidgets3.0.0/demos/messagebox35
-rwxr-xr-xitcl/iwidgets3.0.0/demos/messagedialog26
-rwxr-xr-xitcl/iwidgets3.0.0/demos/notebook76
-rwxr-xr-xitcl/iwidgets3.0.0/demos/optionmenu18
-rwxr-xr-xitcl/iwidgets3.0.0/demos/panedwindow35
-rwxr-xr-xitcl/iwidgets3.0.0/demos/promptdialog26
-rwxr-xr-xitcl/iwidgets3.0.0/demos/pushbutton22
-rwxr-xr-xitcl/iwidgets3.0.0/demos/radiobox19
-rwxr-xr-xitcl/iwidgets3.0.0/demos/scrolledcanvas50
-rwxr-xr-xitcl/iwidgets3.0.0/demos/scrolledframe34
-rwxr-xr-xitcl/iwidgets3.0.0/demos/scrolledhtml19
-rwxr-xr-xitcl/iwidgets3.0.0/demos/scrolledlistbox35
-rwxr-xr-xitcl/iwidgets3.0.0/demos/scrolledtext18
-rwxr-xr-xitcl/iwidgets3.0.0/demos/selectionbox17
-rwxr-xr-xitcl/iwidgets3.0.0/demos/selectiondialog27
-rwxr-xr-xitcl/iwidgets3.0.0/demos/spindate14
-rwxr-xr-xitcl/iwidgets3.0.0/demos/spinint34
-rwxr-xr-xitcl/iwidgets3.0.0/demos/spinner33
-rwxr-xr-xitcl/iwidgets3.0.0/demos/spintime14
-rwxr-xr-xitcl/iwidgets3.0.0/demos/tabnotebook77
-rwxr-xr-xitcl/iwidgets3.0.0/demos/tabset21
-rwxr-xr-xitcl/iwidgets3.0.0/demos/timeentry10
-rwxr-xr-xitcl/iwidgets3.0.0/demos/timefield15
-rwxr-xr-xitcl/iwidgets3.0.0/demos/toolbar50
-rw-r--r--itcl/iwidgets3.0.0/demos/watch18
-rw-r--r--itcl/iwidgets3.0.0/doc/buttonbox.n188
-rw-r--r--itcl/iwidgets3.0.0/doc/calendar.n322
-rw-r--r--itcl/iwidgets3.0.0/doc/canvasprintbox.n266
-rw-r--r--itcl/iwidgets3.0.0/doc/canvasprintdialog.n167
-rwxr-xr-xitcl/iwidgets3.0.0/doc/checkbox.n167
-rw-r--r--itcl/iwidgets3.0.0/doc/combobox.n379
-rw-r--r--itcl/iwidgets3.0.0/doc/dateentry.n175
-rw-r--r--itcl/iwidgets3.0.0/doc/datefield.n192
-rw-r--r--itcl/iwidgets3.0.0/doc/dialog.n139
-rw-r--r--itcl/iwidgets3.0.0/doc/dialogshell.n216
-rwxr-xr-xitcl/iwidgets3.0.0/doc/disjointlistbox.n264
-rw-r--r--itcl/iwidgets3.0.0/doc/entryfield.n270
-rw-r--r--itcl/iwidgets3.0.0/doc/extfileselectionbox.n383
-rw-r--r--itcl/iwidgets3.0.0/doc/extfileselectiondialog.n237
-rw-r--r--itcl/iwidgets3.0.0/doc/feedback.n144
-rw-r--r--itcl/iwidgets3.0.0/doc/fileselectionbox.n379
-rw-r--r--itcl/iwidgets3.0.0/doc/fileselectiondialog.n216
-rw-r--r--itcl/iwidgets3.0.0/doc/finddialog.n292
-rw-r--r--itcl/iwidgets3.0.0/doc/hierarchy.n546
-rw-r--r--itcl/iwidgets3.0.0/doc/hyperhelp.n195
-rw-r--r--itcl/iwidgets3.0.0/doc/iwidgets.ps13149
-rw-r--r--itcl/iwidgets3.0.0/doc/labeledframe.n194
-rw-r--r--itcl/iwidgets3.0.0/doc/labeledwidget.n206
-rw-r--r--itcl/iwidgets3.0.0/doc/mainwindow.n306
-rw-r--r--itcl/iwidgets3.0.0/doc/man.macros186
-rw-r--r--itcl/iwidgets3.0.0/doc/menubar.n341
-rw-r--r--itcl/iwidgets3.0.0/doc/messagebox.n274
-rw-r--r--itcl/iwidgets3.0.0/doc/messagedialog.n214
-rwxr-xr-xitcl/iwidgets3.0.0/doc/mkitclman320
-rw-r--r--itcl/iwidgets3.0.0/doc/notebook.n318
-rw-r--r--itcl/iwidgets3.0.0/doc/optionmenu.n259
-rw-r--r--itcl/iwidgets3.0.0/doc/panedwindow.n297
-rw-r--r--itcl/iwidgets3.0.0/doc/promptdialog.n198
-rw-r--r--itcl/iwidgets3.0.0/doc/pushbutton.n147
-rw-r--r--itcl/iwidgets3.0.0/doc/radiobox.n169
-rwxr-xr-xitcl/iwidgets3.0.0/doc/scopedobject.n100
-rwxr-xr-xitcl/iwidgets3.0.0/doc/scopedobject.n.backup2
-rw-r--r--itcl/iwidgets3.0.0/doc/scrolledcanvas.n255
-rw-r--r--itcl/iwidgets3.0.0/doc/scrolledframe.n208
-rw-r--r--itcl/iwidgets3.0.0/doc/scrolledhtml.n304
-rw-r--r--itcl/iwidgets3.0.0/doc/scrolledlistbox.n354
-rw-r--r--itcl/iwidgets3.0.0/doc/scrolledtext.n279
-rw-r--r--itcl/iwidgets3.0.0/doc/selectionbox.n300
-rw-r--r--itcl/iwidgets3.0.0/doc/selectiondialog.n197
-rw-r--r--itcl/iwidgets3.0.0/doc/shell.n196
-rw-r--r--itcl/iwidgets3.0.0/doc/spindate.n274
-rw-r--r--itcl/iwidgets3.0.0/doc/spinint.n183
-rw-r--r--itcl/iwidgets3.0.0/doc/spinner.n227
-rw-r--r--itcl/iwidgets3.0.0/doc/spintime.n265
-rw-r--r--itcl/iwidgets3.0.0/doc/tabnotebook.n657
-rw-r--r--itcl/iwidgets3.0.0/doc/tabset.n464
-rw-r--r--itcl/iwidgets3.0.0/doc/timeentry.n194
-rwxr-xr-xitcl/iwidgets3.0.0/doc/timefield.n175
-rwxr-xr-xitcl/iwidgets3.0.0/doc/tk2html46
-rwxr-xr-xitcl/iwidgets3.0.0/doc/tk2html.awk320
-rwxr-xr-xitcl/iwidgets3.0.0/doc/tk2html.perl337
-rwxr-xr-xitcl/iwidgets3.0.0/doc/tk2html2.awk53
-rw-r--r--itcl/iwidgets3.0.0/doc/toolbar.n302
-rwxr-xr-xitcl/iwidgets3.0.0/doc/watch.n285
-rw-r--r--itcl/iwidgets3.0.0/generic/buttonbox.itk571
-rw-r--r--itcl/iwidgets3.0.0/generic/calendar.itk938
-rw-r--r--itcl/iwidgets3.0.0/generic/canvasprintbox.itk1110
-rw-r--r--itcl/iwidgets3.0.0/generic/canvasprintdialog.itk155
-rwxr-xr-xitcl/iwidgets3.0.0/generic/checkbox.itk313
-rw-r--r--itcl/iwidgets3.0.0/generic/colors.itcl209
-rw-r--r--itcl/iwidgets3.0.0/generic/combobox.itk1339
-rw-r--r--itcl/iwidgets3.0.0/generic/dateentry.itk408
-rw-r--r--itcl/iwidgets3.0.0/generic/datefield.itk854
-rw-r--r--itcl/iwidgets3.0.0/generic/dialog.itk92
-rw-r--r--itcl/iwidgets3.0.0/generic/dialogshell.itk350
-rwxr-xr-xitcl/iwidgets3.0.0/generic/disjointlistbox.itk489
-rw-r--r--itcl/iwidgets3.0.0/generic/entryfield.itk523
-rw-r--r--itcl/iwidgets3.0.0/generic/extfileselectionbox.itk1127
-rw-r--r--itcl/iwidgets3.0.0/generic/extfileselectiondialog.itk182
-rw-r--r--itcl/iwidgets3.0.0/generic/feedback.itk207
-rw-r--r--itcl/iwidgets3.0.0/generic/fileselectionbox.itk1242
-rw-r--r--itcl/iwidgets3.0.0/generic/fileselectiondialog.itk181
-rwxr-xr-xitcl/iwidgets3.0.0/generic/finddialog.itk488
-rw-r--r--itcl/iwidgets3.0.0/generic/hierarchy.itk1654
-rw-r--r--itcl/iwidgets3.0.0/generic/hyperhelp.itk505
-rw-r--r--itcl/iwidgets3.0.0/generic/labeledframe.itk516
-rw-r--r--itcl/iwidgets3.0.0/generic/labeledwidget.itk437
-rw-r--r--itcl/iwidgets3.0.0/generic/mainwindow.itk313
-rw-r--r--itcl/iwidgets3.0.0/generic/menubar.itk2240
-rw-r--r--itcl/iwidgets3.0.0/generic/messagebox.itk403
-rw-r--r--itcl/iwidgets3.0.0/generic/messagedialog.itk142
-rw-r--r--itcl/iwidgets3.0.0/generic/notebook.itk946
-rw-r--r--itcl/iwidgets3.0.0/generic/optionmenu.itk640
-rw-r--r--itcl/iwidgets3.0.0/generic/pane.itk128
-rw-r--r--itcl/iwidgets3.0.0/generic/panedwindow.itk893
-rw-r--r--itcl/iwidgets3.0.0/generic/promptdialog.itk199
-rw-r--r--itcl/iwidgets3.0.0/generic/pushbutton.itk356
-rw-r--r--itcl/iwidgets3.0.0/generic/radiobox.itk328
-rwxr-xr-xitcl/iwidgets3.0.0/generic/regexpfield.itk455
-rw-r--r--itcl/iwidgets3.0.0/generic/roman.itcl28
-rwxr-xr-xitcl/iwidgets3.0.0/generic/scopedobject.itcl181
-rw-r--r--itcl/iwidgets3.0.0/generic/scrolledcanvas.itk477
-rw-r--r--itcl/iwidgets3.0.0/generic/scrolledframe.itk250
-rw-r--r--itcl/iwidgets3.0.0/generic/scrolledhtml.itk2505
-rw-r--r--itcl/iwidgets3.0.0/generic/scrolledlistbox.itk719
-rw-r--r--itcl/iwidgets3.0.0/generic/scrolledtext.itk484
-rw-r--r--itcl/iwidgets3.0.0/generic/scrolledwidget.itk434
-rw-r--r--itcl/iwidgets3.0.0/generic/selectionbox.itk560
-rw-r--r--itcl/iwidgets3.0.0/generic/selectiondialog.itk233
-rw-r--r--itcl/iwidgets3.0.0/generic/shell.itk371
-rw-r--r--itcl/iwidgets3.0.0/generic/spindate.itk700
-rw-r--r--itcl/iwidgets3.0.0/generic/spinint.itk275
-rw-r--r--itcl/iwidgets3.0.0/generic/spinner.itk448
-rw-r--r--itcl/iwidgets3.0.0/generic/spintime.itk527
-rw-r--r--itcl/iwidgets3.0.0/generic/tabnotebook.itk1075
-rw-r--r--itcl/iwidgets3.0.0/generic/tabset.itk2747
-rw-r--r--itcl/iwidgets3.0.0/generic/tclIndex1336
-rw-r--r--itcl/iwidgets3.0.0/generic/timeentry.itk399
-rw-r--r--itcl/iwidgets3.0.0/generic/timefield.itk975
-rw-r--r--itcl/iwidgets3.0.0/generic/toolbar.itk980
-rw-r--r--itcl/iwidgets3.0.0/generic/unknownimage.gifbin0 -> 472 bytes
-rwxr-xr-xitcl/iwidgets3.0.0/generic/watch.itk626
-rw-r--r--itcl/iwidgets3.0.0/incoming/README21
-rw-r--r--itcl/iwidgets3.0.0/incoming/doc/man.macros186
-rw-r--r--itcl/iwidgets3.0.0/incoming/tests/all14
-rw-r--r--itcl/iwidgets3.0.0/incoming/tests/defs213
-rw-r--r--itcl/iwidgets3.0.0/license.terms31
-rw-r--r--itcl/iwidgets3.0.0/outgoing/README14
-rw-r--r--itcl/iwidgets3.0.0/tests/all14
-rw-r--r--itcl/iwidgets3.0.0/tests/buttonbox.test183
-rw-r--r--itcl/iwidgets3.0.0/tests/calendar.test153
-rw-r--r--itcl/iwidgets3.0.0/tests/canvasprintbox.test146
-rw-r--r--itcl/iwidgets3.0.0/tests/canvasprintdialog.test165
-rwxr-xr-xitcl/iwidgets3.0.0/tests/checkbox.test145
-rw-r--r--itcl/iwidgets3.0.0/tests/combobox.test297
-rw-r--r--itcl/iwidgets3.0.0/tests/dateentry.test183
-rw-r--r--itcl/iwidgets3.0.0/tests/datefield.test168
-rw-r--r--itcl/iwidgets3.0.0/tests/defs215
-rw-r--r--itcl/iwidgets3.0.0/tests/dialog.test131
-rw-r--r--itcl/iwidgets3.0.0/tests/dialogshell.test224
-rwxr-xr-xitcl/iwidgets3.0.0/tests/disjointlistbox.test98
-rw-r--r--itcl/iwidgets3.0.0/tests/entryfield.test172
-rw-r--r--itcl/iwidgets3.0.0/tests/extfileselectionbox.test192
-rw-r--r--itcl/iwidgets3.0.0/tests/extfileselectiondialog.test200
-rw-r--r--itcl/iwidgets3.0.0/tests/feedback.test132
-rw-r--r--itcl/iwidgets3.0.0/tests/fileselectionbox.test195
-rw-r--r--itcl/iwidgets3.0.0/tests/fileselectiondialog.test203
-rw-r--r--itcl/iwidgets3.0.0/tests/finddialog.test152
-rw-r--r--itcl/iwidgets3.0.0/tests/hierarchy.test281
-rw-r--r--itcl/iwidgets3.0.0/tests/hyperhelp.html157
-rw-r--r--itcl/iwidgets3.0.0/tests/hyperhelp.test162
-rw-r--r--itcl/iwidgets3.0.0/tests/labeledframe.test178
-rw-r--r--itcl/iwidgets3.0.0/tests/labeledwidget.test147
-rw-r--r--itcl/iwidgets3.0.0/tests/menubar.test524
-rw-r--r--itcl/iwidgets3.0.0/tests/messagebox.test179
-rw-r--r--itcl/iwidgets3.0.0/tests/messagedialog.test147
-rw-r--r--itcl/iwidgets3.0.0/tests/notebook.test294
-rw-r--r--itcl/iwidgets3.0.0/tests/optionmenu.test176
-rw-r--r--itcl/iwidgets3.0.0/tests/panedwindow.test157
-rw-r--r--itcl/iwidgets3.0.0/tests/promptdialog.test159
-rw-r--r--itcl/iwidgets3.0.0/tests/pushbutton.test136
-rw-r--r--itcl/iwidgets3.0.0/tests/radiobox.test137
-rwxr-xr-xitcl/iwidgets3.0.0/tests/regexpfield.test172
-rw-r--r--itcl/iwidgets3.0.0/tests/scrolledcanvas.test169
-rw-r--r--itcl/iwidgets3.0.0/tests/scrolledframe.test198
-rw-r--r--itcl/iwidgets3.0.0/tests/scrolledhtml.test197
-rw-r--r--itcl/iwidgets3.0.0/tests/scrolledlistbox.test200
-rw-r--r--itcl/iwidgets3.0.0/tests/scrolledtext.test165
-rw-r--r--itcl/iwidgets3.0.0/tests/selectionbox.test174
-rw-r--r--itcl/iwidgets3.0.0/tests/selectiondialog.test186
-rw-r--r--itcl/iwidgets3.0.0/tests/shell.test196
-rw-r--r--itcl/iwidgets3.0.0/tests/spindate.test156
-rw-r--r--itcl/iwidgets3.0.0/tests/spinint.test166
-rw-r--r--itcl/iwidgets3.0.0/tests/spinner.test148
-rw-r--r--itcl/iwidgets3.0.0/tests/spintime.test140
-rw-r--r--itcl/iwidgets3.0.0/tests/tabnotebook.test313
-rw-r--r--itcl/iwidgets3.0.0/tests/tabset.test317
-rwxr-xr-xitcl/iwidgets3.0.0/tests/timeentry.test178
-rwxr-xr-xitcl/iwidgets3.0.0/tests/timefield.test163
-rw-r--r--itcl/iwidgets3.0.0/tests/toolbar.test261
-rw-r--r--itcl/iwidgets3.0.0/tests/usual.test53
-rwxr-xr-xitcl/iwidgets3.0.0/tests/watch.test149
-rw-r--r--itcl/iwidgets3.0.0/unix/Makefile.in233
-rwxr-xr-xitcl/iwidgets3.0.0/unix/configure1118
-rw-r--r--itcl/iwidgets3.0.0/unix/configure.in142
-rw-r--r--itcl/iwidgets3.0.0/unix/iwidgets.tcl.in29
-rw-r--r--itcl/iwidgets3.0.0/unix/pkgIndex.tcl.in3
-rw-r--r--itcl/license.terms83
-rw-r--r--itcl/makefile.bc114
-rw-r--r--itcl/makefile.vc147
-rw-r--r--itcl/testsuite/config/default.exp20
-rw-r--r--itcl/testsuite/itcl.tests/itcl-test.exp39
-rw-r--r--libgui/ChangeLog828
-rw-r--r--libgui/Makefile.am4
-rw-r--r--libgui/Makefile.in430
-rw-r--r--libgui/README202
-rw-r--r--libgui/acconfig.h14
-rw-r--r--libgui/acinclude.m41
-rw-r--r--libgui/aclocal.m4250
-rw-r--r--libgui/config.h.in77
-rwxr-xr-xlibgui/configure2709
-rw-r--r--libgui/configure.in127
-rw-r--r--libgui/doc/tkTable.n1223
-rw-r--r--libgui/doc/tkTable_license.terms41
-rw-r--r--libgui/library/Makefile.am47
-rw-r--r--libgui/library/Makefile.in335
-rw-r--r--libgui/library/advice.tcl82
-rw-r--r--libgui/library/balloon.tcl532
-rw-r--r--libgui/library/bbox.tcl57
-rw-r--r--libgui/library/bgerror.tcl64
-rw-r--r--libgui/library/bindings.tcl88
-rw-r--r--libgui/library/canvas.tcl29
-rw-r--r--libgui/library/center.tcl18
-rw-r--r--libgui/library/cframe.tcl146
-rw-r--r--libgui/library/combobox.tcl1118
-rw-r--r--libgui/library/debug.tcl765
-rw-r--r--libgui/library/def.tcl29
-rw-r--r--libgui/library/font.tcl26
-rw-r--r--libgui/library/gensym.tcl13
-rw-r--r--libgui/library/gettext.tcl7
-rw-r--r--libgui/library/hooks.tcl35
-rw-r--r--libgui/library/internet.tcl64
-rw-r--r--libgui/library/lframe.tcl19
-rw-r--r--libgui/library/list.tcl83
-rw-r--r--libgui/library/looknfeel.tcl48
-rw-r--r--libgui/library/menu.tcl39
-rw-r--r--libgui/library/mono.tcl14
-rw-r--r--libgui/library/multibox.tcl251
-rw-r--r--libgui/library/pane.tcl136
-rw-r--r--libgui/library/panedwindow.tcl851
-rw-r--r--libgui/library/parse_args.tcl42
-rw-r--r--libgui/library/path.tcl20
-rw-r--r--libgui/library/pkgIndex.tcl11
-rw-r--r--libgui/library/postghost.tcl38
-rw-r--r--libgui/library/prefs.tcl198
-rw-r--r--libgui/library/print.tcl334
-rw-r--r--libgui/library/sendpr.tcl348
-rw-r--r--libgui/library/tclIndex199
-rw-r--r--libgui/library/toolbar.tcl235
-rw-r--r--libgui/library/topbind.tcl29
-rw-r--r--libgui/library/tree.tcl2104
-rw-r--r--libgui/library/treetable.tcl206
-rw-r--r--libgui/library/ulset.tcl22
-rw-r--r--libgui/library/ventry.tcl137
-rw-r--r--libgui/library/wframe.tcl87
-rw-r--r--libgui/library/wingrab.tcl59
-rw-r--r--libgui/src/Makefile.am85
-rw-r--r--libgui/src/Makefile.in442
-rw-r--r--libgui/src/guitcl.h113
-rw-r--r--libgui/src/paths.c289
-rw-r--r--libgui/src/subcommand.c126
-rw-r--r--libgui/src/subcommand.h31
-rw-r--r--libgui/src/tclcursor.c77
-rw-r--r--libgui/src/tclgetdir.c269
-rw-r--r--libgui/src/tclhelp.c618
-rw-r--r--libgui/src/tclmain.c100
-rw-r--r--libgui/src/tclmapi.c79
-rw-r--r--libgui/src/tclmsgbox.c462
-rw-r--r--libgui/src/tclshellexe.c76
-rw-r--r--libgui/src/tclsizebox.c236
-rw-r--r--libgui/src/tclwinfont.c331
-rw-r--r--libgui/src/tclwingrab.c64
-rw-r--r--libgui/src/tclwinmode.c89
-rw-r--r--libgui/src/tclwinpath.c181
-rw-r--r--libgui/src/tclwinprint.c935
-rw-r--r--libgui/src/tkCanvEdge.c2095
-rw-r--r--libgui/src/tkCanvLayout.c2680
-rw-r--r--libgui/src/tkCanvLayout.h117
-rw-r--r--libgui/src/tkGraphCanvas.c893
-rw-r--r--libgui/src/tkTable.c4898
-rw-r--r--libgui/src/tkTable.h418
-rw-r--r--libgui/src/tkTable.tcl560
-rw-r--r--libgui/src/tkTableCell.c563
-rw-r--r--libgui/src/tkTableCmd.c158
-rw-r--r--libgui/src/tkTableCmd.h52
-rw-r--r--libgui/src/tkTableTag.c756
-rw-r--r--libgui/src/tkTableWin.c856
-rw-r--r--libgui/src/tkTable_version.in1
-rw-r--r--libgui/src/tkTabletcl.h366
-rw-r--r--libgui/src/tkTreeTable.c8070
-rw-r--r--libgui/src/tkTreeTable.h172
-rw-r--r--libgui/src/tkWarpPointer.c70
-rw-r--r--libgui/src/tkWinPrintCanvas.c193
-rw-r--r--libgui/src/tkWinPrintText.c533
-rw-r--r--libgui/src/xpmlib.c1592
-rw-r--r--libgui/stamp-h.in1
-rw-r--r--tix/ABOUT.html119
-rw-r--r--tix/ABOUT.txt86
-rw-r--r--tix/ChangeLog623
-rw-r--r--tix/Makefile.in46
-rw-r--r--tix/README.html59
-rw-r--r--tix/README.txt39
-rw-r--r--tix/Version2
-rwxr-xr-xtix/configure960
-rw-r--r--tix/configure.in20
-rw-r--r--tix/demos/MkChoose.tcl279
-rw-r--r--tix/demos/MkDirLis.tcl65
-rw-r--r--tix/demos/MkManag.tcl171
-rw-r--r--tix/demos/MkSample.tcl269
-rw-r--r--tix/demos/MkScroll.tcl156
-rw-r--r--tix/demos/README24
-rw-r--r--tix/demos/bitmaps/about.xpm50
-rw-r--r--tix/demos/bitmaps/bold.xbm6
-rw-r--r--tix/demos/bitmaps/capital.xbm6
-rw-r--r--tix/demos/bitmaps/centerj.xbm6
-rw-r--r--tix/demos/bitmaps/combobox.xbm14
-rw-r--r--tix/demos/bitmaps/combobox.xpm49
-rw-r--r--tix/demos/bitmaps/drivea.xbm14
-rw-r--r--tix/demos/bitmaps/drivea.xpm43
-rw-r--r--tix/demos/bitmaps/exit.xpm48
-rw-r--r--tix/demos/bitmaps/filebox.xbm14
-rw-r--r--tix/demos/bitmaps/filebox.xpm49
-rw-r--r--tix/demos/bitmaps/harddisk.xbm14
-rw-r--r--tix/demos/bitmaps/harddisk.xpm43
-rw-r--r--tix/demos/bitmaps/italic.xbm6
-rw-r--r--tix/demos/bitmaps/justify.xbm6
-rw-r--r--tix/demos/bitmaps/leftj.xbm6
-rw-r--r--tix/demos/bitmaps/netw.xbm14
-rw-r--r--tix/demos/bitmaps/netw.xpm45
-rw-r--r--tix/demos/bitmaps/network.xbm14
-rw-r--r--tix/demos/bitmaps/network.xpm45
-rw-r--r--tix/demos/bitmaps/optmenu.xpm48
-rw-r--r--tix/demos/bitmaps/rightj.xbm6
-rw-r--r--tix/demos/bitmaps/select.xpm52
-rw-r--r--tix/demos/bitmaps/tix.gifbin0 -> 11042 bytes
-rw-r--r--tix/demos/bitmaps/underlin.xbm6
-rw-r--r--tix/demos/c-code/Makefile.in147
-rw-r--r--tix/demos/c-code/library/Init.tcl0
-rw-r--r--tix/demos/c-code/library/tclIndex9
-rw-r--r--tix/demos/c-code/myCmds.c48
-rw-r--r--tix/demos/c-code/myInit.c60
-rw-r--r--tix/demos/c-code/tixAppInit.c122
-rw-r--r--tix/demos/et/Makefile.demo16
-rw-r--r--tix/demos/et/README9
-rw-r--r--tix/demos/et/etdemo.et52
-rw-r--r--tix/demos/samples/AllSampl.tcl193
-rw-r--r--tix/demos/samples/ArrowBtn.tcl183
-rw-r--r--tix/demos/samples/Balloon.tcl44
-rw-r--r--tix/demos/samples/BtnBox.tcl53
-rw-r--r--tix/demos/samples/CObjView.tcl85
-rw-r--r--tix/demos/samples/ChkList.tcl175
-rw-r--r--tix/demos/samples/CmpImg.tcl60
-rw-r--r--tix/demos/samples/CmpImg1.tcl178
-rw-r--r--tix/demos/samples/CmpImg2.tcl132
-rw-r--r--tix/demos/samples/CmpImg3.tcl86
-rw-r--r--tix/demos/samples/CmpImg4.tcl121
-rw-r--r--tix/demos/samples/ComboBox.tcl115
-rw-r--r--tix/demos/samples/Control.tcl129
-rw-r--r--tix/demos/samples/DirDlg.tcl86
-rw-r--r--tix/demos/samples/DirList.tcl87
-rw-r--r--tix/demos/samples/DirTree.tcl88
-rw-r--r--tix/demos/samples/DragDrop.tcl46
-rw-r--r--tix/demos/samples/DynTree.tcl145
-rw-r--r--tix/demos/samples/EFileDlg.tcl99
-rw-r--r--tix/demos/samples/EditGrid.tcl277
-rw-r--r--tix/demos/samples/FileDlg.tcl94
-rw-r--r--tix/demos/samples/FileEnt.tcl77
-rw-r--r--tix/demos/samples/HList1.tcl155
-rw-r--r--tix/demos/samples/LabEntry.tcl90
-rw-r--r--tix/demos/samples/LabFrame.tcl81
-rw-r--r--tix/demos/samples/ListNBK.tcl83
-rw-r--r--tix/demos/samples/Meter.tcl73
-rw-r--r--tix/demos/samples/NoteBook.tcl98
-rw-r--r--tix/demos/samples/OptMenu.tcl99
-rw-r--r--tix/demos/samples/PanedWin.tcl108
-rw-r--r--tix/demos/samples/PopMenu.tcl69
-rw-r--r--tix/demos/samples/SGrid0.tcl131
-rw-r--r--tix/demos/samples/SGrid1.tcl211
-rw-r--r--tix/demos/samples/SHList.tcl107
-rw-r--r--tix/demos/samples/SHList2.tcl161
-rw-r--r--tix/demos/samples/SListBox.tcl81
-rw-r--r--tix/demos/samples/STList1.tcl53
-rw-r--r--tix/demos/samples/STList2.tcl81
-rw-r--r--tix/demos/samples/STList3.tcl121
-rw-r--r--tix/demos/samples/SText.tcl71
-rw-r--r--tix/demos/samples/SWindow.tcl85
-rw-r--r--tix/demos/samples/Sample.tcl32
-rw-r--r--tix/demos/samples/Select.tcl110
-rw-r--r--tix/demos/samples/StdBBox.tcl61
-rw-r--r--tix/demos/samples/Tree.tcl87
-rw-r--r--tix/demos/samples/Xpm.tcl85
-rw-r--r--tix/demos/samples/Xpm1.tcl104
-rw-r--r--tix/demos/tclIndex54
-rwxr-xr-xtix/demos/widget367
-rw-r--r--tix/docs/BinInst.html12
-rw-r--r--tix/docs/BinInst.txt11
-rw-r--r--tix/docs/Changes.html333
-rw-r--r--tix/docs/ET.txt1325
-rw-r--r--tix/docs/FAQ.html700
-rw-r--r--tix/docs/FAQ.txt476
-rw-r--r--tix/docs/Files.txt187
-rw-r--r--tix/docs/Install.html28
-rw-r--r--tix/docs/Install.txt25
-rw-r--r--tix/docs/Pkg.txt127
-rw-r--r--tix/docs/Plugin.txt17
-rw-r--r--tix/docs/Porting.html46
-rw-r--r--tix/docs/Release-4.1.0.html24
-rw-r--r--tix/docs/Release-4.1.0.txt23
-rw-r--r--tix/docs/Release-4.1a2.html40
-rw-r--r--tix/docs/Release-4.1a2.txt35
-rw-r--r--tix/docs/Release-4.1a3.html104
-rw-r--r--tix/docs/Release-4.1a3.txt88
-rw-r--r--tix/docs/Release-4.1b1.html152
-rw-r--r--tix/docs/Release-4.1b1.txt136
-rw-r--r--tix/docs/Release-4.1b2.html187
-rw-r--r--tix/docs/Release-4.1b2.txt161
-rw-r--r--tix/docs/Release.html20
-rw-r--r--tix/docs/Release.txt18
-rw-r--r--tix/docs/SAModule.txt89
-rw-r--r--tix/docs/UnixInst.html211
-rw-r--r--tix/docs/UnixInst.txt171
-rw-r--r--tix/docs/WinInst.html177
-rw-r--r--tix/docs/WinInst.txt141
-rw-r--r--tix/docs/img/demo1.gifbin0 -> 25024 bytes
-rw-r--r--tix/docs/img/setup0.gifbin0 -> 4259 bytes
-rw-r--r--tix/docs/img/setup1.gifbin0 -> 15626 bytes
-rw-r--r--tix/docs/img/setup2.gifbin0 -> 1568 bytes
-rw-r--r--tix/docs/img/setup3.gifbin0 -> 1579 bytes
-rw-r--r--tix/docs/img/setup5.gifbin0 -> 1546 bytes
-rw-r--r--tix/docs/img/setup6.gifbin0 -> 10539 bytes
-rw-r--r--tix/docs/img/tk42a.gifbin0 -> 1175 bytes
-rw-r--r--tix/docs/img/tk42b.gifbin0 -> 3149 bytes
-rw-r--r--tix/docs/license.html_lib38
-rw-r--r--tix/docs/license.tcltk39
-rw-r--r--tix/generic/tix.h467
-rw-r--r--tix/generic/tixBitmaps.h615
-rw-r--r--tix/generic/tixClass.c1971
-rw-r--r--tix/generic/tixCmds.c935
-rw-r--r--tix/generic/tixCompat.c60
-rw-r--r--tix/generic/tixDItem.c677
-rw-r--r--tix/generic/tixDef.h169
-rw-r--r--tix/generic/tixDiITxt.c758
-rw-r--r--tix/generic/tixDiImg.c611
-rw-r--r--tix/generic/tixDiStyle.c952
-rw-r--r--tix/generic/tixDiText.c667
-rw-r--r--tix/generic/tixDiWin.c739
-rw-r--r--tix/generic/tixError.c77
-rw-r--r--tix/generic/tixForm.c2114
-rw-r--r--tix/generic/tixForm.h149
-rw-r--r--tix/generic/tixFormMisc.c597
-rw-r--r--tix/generic/tixGeometry.c379
-rw-r--r--tix/generic/tixGrData.c923
-rw-r--r--tix/generic/tixGrData.h85
-rw-r--r--tix/generic/tixGrFmt.c806
-rw-r--r--tix/generic/tixGrRC.c112
-rw-r--r--tix/generic/tixGrSel.c302
-rw-r--r--tix/generic/tixGrSort.c461
-rw-r--r--tix/generic/tixGrUtl.c202
-rw-r--r--tix/generic/tixGrid.c3307
-rw-r--r--tix/generic/tixGrid.h462
-rw-r--r--tix/generic/tixHLCol.c405
-rw-r--r--tix/generic/tixHLHdr.c576
-rw-r--r--tix/generic/tixHLInd.c278
-rw-r--r--tix/generic/tixHList.c4417
-rw-r--r--tix/generic/tixHList.h323
-rw-r--r--tix/generic/tixImgCmp.c1456
-rw-r--r--tix/generic/tixImgXpm.c1267
-rw-r--r--tix/generic/tixImgXpm.h139
-rw-r--r--tix/generic/tixInit.c615
-rw-r--r--tix/generic/tixInputO.c441
-rw-r--r--tix/generic/tixInt.h880
-rw-r--r--tix/generic/tixItcl.c126
-rw-r--r--tix/generic/tixItcl.h78
-rw-r--r--tix/generic/tixList.c316
-rw-r--r--tix/generic/tixMethod.c604
-rw-r--r--tix/generic/tixMwm.c905
-rw-r--r--tix/generic/tixNBFrame.c1584
-rw-r--r--tix/generic/tixOption.c385
-rw-r--r--tix/generic/tixPort.h121
-rw-r--r--tix/generic/tixScroll.c188
-rw-r--r--tix/generic/tixSmpLs.c121
-rw-r--r--tix/generic/tixTList.c2469
-rw-r--r--tix/generic/tixTList.h138
-rw-r--r--tix/generic/tixUtils.c863
-rw-r--r--tix/generic/tixWidget.c309
-rw-r--r--tix/generic/tk4.2/console.tcl433
-rw-r--r--tix/generic/tk4.2/tk.tcl157
-rwxr-xr-xtix/install.sh119
-rw-r--r--tix/library/Balloon.tcl565
-rw-r--r--tix/library/BtnBox.tcl115
-rw-r--r--tix/library/CObjView.tcl359
-rw-r--r--tix/library/ChkList.tcl237
-rw-r--r--tix/library/ComboBox.tcl1549
-rw-r--r--tix/library/Compat.tcl39
-rw-r--r--tix/library/Console.tcl515
-rw-r--r--tix/library/Control.tcl498
-rw-r--r--tix/library/DefSchm.tcl86
-rw-r--r--tix/library/DialogS.tcl169
-rw-r--r--tix/library/DirBox.tcl220
-rw-r--r--tix/library/DirDlg.tcl90
-rw-r--r--tix/library/DirList.tcl286
-rw-r--r--tix/library/DirTree.tcl400
-rw-r--r--tix/library/DragDrop.tcl161
-rw-r--r--tix/library/DtlList.tcl44
-rw-r--r--tix/library/EFileBox.tcl452
-rw-r--r--tix/library/EFileDlg.tcl51
-rw-r--r--tix/library/Event.tcl239
-rw-r--r--tix/library/FileBox.tcl579
-rw-r--r--tix/library/FileCbx.tcl100
-rw-r--r--tix/library/FileCmpt.tcl31
-rw-r--r--tix/library/FileDlg.tcl70
-rw-r--r--tix/library/FileEnt.tcl235
-rw-r--r--tix/library/FileUtil.tcl92
-rw-r--r--tix/library/FloatEnt.tcl126
-rw-r--r--tix/library/Grid.tcl1113
-rw-r--r--tix/library/HList.tcl841
-rw-r--r--tix/library/HListDD.tcl199
-rw-r--r--tix/library/IconView.tcl271
-rw-r--r--tix/library/Init.tcl163
-rw-r--r--tix/library/LabEntry.tcl83
-rw-r--r--tix/library/LabFrame.tcl45
-rw-r--r--tix/library/LabWidg.tcl152
-rw-r--r--tix/library/ListNBk.tcl150
-rw-r--r--tix/library/Makefile5
-rw-r--r--tix/library/Meter.tcl124
-rw-r--r--tix/library/MultView.tcl152
-rw-r--r--tix/library/NoteBook.tcl248
-rw-r--r--tix/library/OldUtil.tcl223
-rw-r--r--tix/library/OptMenu.tcl389
-rw-r--r--tix/library/PanedWin.tcl1215
-rw-r--r--tix/library/PopMenu.tcl218
-rw-r--r--tix/library/Primitiv.tcl425
-rw-r--r--tix/library/ResizeH.tcl495
-rw-r--r--tix/library/SGrid.tcl228
-rw-r--r--tix/library/SHList.tcl155
-rw-r--r--tix/library/SListBox.tcl304
-rw-r--r--tix/library/STList.tcl92
-rw-r--r--tix/library/SText.tcl138
-rw-r--r--tix/library/SWidget.tcl507
-rw-r--r--tix/library/SWindow.tcl277
-rw-r--r--tix/library/Select.tcl295
-rw-r--r--tix/library/Shell.tcl41
-rw-r--r--tix/library/SimpDlg.tcl42
-rw-r--r--tix/library/StackWin.tcl80
-rw-r--r--tix/library/StatBar.tcl51
-rw-r--r--tix/library/StdBBox.tcl66
-rw-r--r--tix/library/StdShell.tcl44
-rw-r--r--tix/library/TList.tcl995
-rw-r--r--tix/library/Tix.tcl506
-rw-r--r--tix/library/Tree.tcl190
-rw-r--r--tix/library/UnixFile.tcl407
-rw-r--r--tix/library/Utils.tcl498
-rw-r--r--tix/library/VResize.tcl205
-rw-r--r--tix/library/VStack.tcl426
-rw-r--r--tix/library/VTree.tcl205
-rw-r--r--tix/library/Variable.tcl96
-rw-r--r--tix/library/Verify.tcl21
-rw-r--r--tix/library/Version.tcl17
-rw-r--r--tix/library/WInfo.tcl35
-rw-r--r--tix/library/WinFile.tcl648
-rw-r--r--tix/library/bitmaps/act_fold.gifbin0 -> 90 bytes
-rw-r--r--tix/library/bitmaps/act_fold.xbm5
-rw-r--r--tix/library/bitmaps/act_fold.xpm22
-rwxr-xr-xtix/library/bitmaps/balarrow.xbm4
-rwxr-xr-xtix/library/bitmaps/cbxarrow.xbm6
-rw-r--r--tix/library/bitmaps/ck_def.xbm6
-rw-r--r--tix/library/bitmaps/ck_off.xbm6
-rw-r--r--tix/library/bitmaps/ck_on.xbm6
-rwxr-xr-xtix/library/bitmaps/cross.xbm6
-rwxr-xr-xtix/library/bitmaps/decr.xbm4
-rw-r--r--tix/library/bitmaps/drop.xbm8
-rw-r--r--tix/library/bitmaps/file.gifbin0 -> 76 bytes
-rw-r--r--tix/library/bitmaps/file.xbm5
-rw-r--r--tix/library/bitmaps/file.xpm18
-rw-r--r--tix/library/bitmaps/folder.gifbin0 -> 79 bytes
-rw-r--r--tix/library/bitmaps/folder.xbm5
-rw-r--r--tix/library/bitmaps/folder.xpm21
-rwxr-xr-xtix/library/bitmaps/harddisk.xbm14
-rw-r--r--tix/library/bitmaps/hourglas.mask16
-rwxr-xr-xtix/library/bitmaps/hourglas.xbm16
-rwxr-xr-xtix/library/bitmaps/incr.xbm4
-rw-r--r--tix/library/bitmaps/info.gifbin0 -> 159 bytes
-rw-r--r--tix/library/bitmaps/info.xpm38
-rw-r--r--tix/library/bitmaps/maximize.xbm6
-rw-r--r--tix/library/bitmaps/minimize.xbm6
-rw-r--r--tix/library/bitmaps/minus.gifbin0 -> 57 bytes
-rw-r--r--tix/library/bitmaps/minus.xbm5
-rw-r--r--tix/library/bitmaps/minus.xpm14
-rw-r--r--tix/library/bitmaps/minusarm.gifbin0 -> 59 bytes
-rw-r--r--tix/library/bitmaps/minusarm.xbm5
-rw-r--r--tix/library/bitmaps/minusarm.xpm15
-rw-r--r--tix/library/bitmaps/mktransgif.tcl11
-rwxr-xr-xtix/library/bitmaps/network.xbm14
-rw-r--r--tix/library/bitmaps/no_entry.gifbin0 -> 176 bytes
-rw-r--r--tix/library/bitmaps/no_entry.xpm39
-rw-r--r--tix/library/bitmaps/openfile.xbm5
-rw-r--r--tix/library/bitmaps/openfold.gifbin0 -> 84 bytes
-rw-r--r--tix/library/bitmaps/openfold.xbm5
-rw-r--r--tix/library/bitmaps/openfold.xpm21
-rw-r--r--tix/library/bitmaps/plus.gifbin0 -> 58 bytes
-rw-r--r--tix/library/bitmaps/plus.xbm5
-rw-r--r--tix/library/bitmaps/plus.xpm14
-rw-r--r--tix/library/bitmaps/plusarm.gifbin0 -> 60 bytes
-rw-r--r--tix/library/bitmaps/plusarm.xbm5
-rw-r--r--tix/library/bitmaps/plusarm.xpm15
-rw-r--r--tix/library/bitmaps/resize1.xbm8
-rw-r--r--tix/library/bitmaps/resize2.xbm8
-rw-r--r--tix/library/bitmaps/restore.xbm6
-rw-r--r--tix/library/bitmaps/srcfile.gifbin0 -> 79 bytes
-rw-r--r--tix/library/bitmaps/srcfile.xbm5
-rw-r--r--tix/library/bitmaps/srcfile.xpm18
-rw-r--r--tix/library/bitmaps/system.xbm6
-rw-r--r--tix/library/bitmaps/textfile.gifbin0 -> 79 bytes
-rw-r--r--tix/library/bitmaps/textfile.xbm5
-rw-r--r--tix/library/bitmaps/textfile.xpm18
-rwxr-xr-xtix/library/bitmaps/tick.xbm6
-rw-r--r--tix/library/bitmaps/warning.gifbin0 -> 180 bytes
-rw-r--r--tix/library/bitmaps/warning.xpm38
-rw-r--r--tix/library/fs.tcl644
-rw-r--r--tix/library/pref/12Point.fs11
-rw-r--r--tix/library/pref/12Point.fsc32
-rw-r--r--tix/library/pref/14Point.fs10
-rw-r--r--tix/library/pref/14Point.fsc32
-rw-r--r--tix/library/pref/Bisque.cs32
-rw-r--r--tix/library/pref/Bisque.csc335
-rw-r--r--tix/library/pref/Blue.cs32
-rw-r--r--tix/library/pref/Blue.csc335
-rw-r--r--tix/library/pref/Gray.cs33
-rw-r--r--tix/library/pref/Gray.csc336
-rw-r--r--tix/library/pref/Makefile45
-rw-r--r--tix/library/pref/Old12Pt.fs11
-rw-r--r--tix/library/pref/Old14Pt.fs10
-rw-r--r--tix/library/pref/SGIGray.cs35
-rw-r--r--tix/library/pref/SGIGray.csc336
-rw-r--r--tix/library/pref/TK.cs32
-rw-r--r--tix/library/pref/TK.csc69
-rw-r--r--tix/library/pref/TK.fs13
-rw-r--r--tix/library/pref/TK.fsc16
-rw-r--r--tix/library/pref/TixGray.cs33
-rw-r--r--tix/library/pref/TixGray.csc336
-rw-r--r--tix/library/pref/TkWin.cs65
-rw-r--r--tix/library/pref/TkWin.csc320
-rw-r--r--tix/library/pref/TkWin.fs13
-rw-r--r--tix/library/pref/TkWin.fsc31
-rwxr-xr-xtix/library/pref/tixmkpref413
-rw-r--r--tix/library/tclIndex521
-rw-r--r--tix/license.terms32
-rw-r--r--tix/man/Balloon.html174
-rw-r--r--tix/man/Balloon.n237
-rw-r--r--tix/man/BtnBox.html154
-rw-r--r--tix/man/BtnBox.n219
-rw-r--r--tix/man/ChkList.html192
-rw-r--r--tix/man/ChkList.n252
-rw-r--r--tix/man/Control.html371
-rw-r--r--tix/man/Control.n478
-rw-r--r--tix/man/DItem.html420
-rw-r--r--tix/man/DItem.n542
-rw-r--r--tix/man/Destroy.html21
-rw-r--r--tix/man/Destroy.n32
-rw-r--r--tix/man/DirDlg.html123
-rw-r--r--tix/man/DirDlg.n175
-rw-r--r--tix/man/DirList.html220
-rw-r--r--tix/man/DirList.n302
-rw-r--r--tix/man/DirTree.html199
-rw-r--r--tix/man/DirTree.n273
-rw-r--r--tix/man/EFileBox.html284
-rw-r--r--tix/man/EFileBox.n376
-rw-r--r--tix/man/EFileDlg.html106
-rw-r--r--tix/man/EFileDlg.n164
-rw-r--r--tix/man/FileBox.html216
-rw-r--r--tix/man/FileBox.n259
-rw-r--r--tix/man/FileDlg.html115
-rw-r--r--tix/man/FileDlg.n174
-rw-r--r--tix/man/FileEnt.html262
-rw-r--r--tix/man/FileEnt.n345
-rw-r--r--tix/man/Form.html419
-rw-r--r--tix/man/Form.n460
-rw-r--r--tix/man/GetBool.html24
-rw-r--r--tix/man/GetBool.n44
-rw-r--r--tix/man/GetInt.html26
-rw-r--r--tix/man/GetInt.n45
-rw-r--r--tix/man/Grid.html225
-rw-r--r--tix/man/Grid.n347
-rw-r--r--tix/man/HList.html1087
-rw-r--r--tix/man/HList.n1182
-rw-r--r--tix/man/InpOnly.html77
-rw-r--r--tix/man/InpOnly.n126
-rw-r--r--tix/man/LabEntry.html136
-rw-r--r--tix/man/LabEntry.n201
-rw-r--r--tix/man/LabFrame.html155
-rw-r--r--tix/man/LabFrame.n222
-rw-r--r--tix/man/ListNBK.html213
-rw-r--r--tix/man/ListNBK.n277
-rw-r--r--tix/man/Meter.html96
-rw-r--r--tix/man/Meter.n139
-rw-r--r--tix/man/Mwm.html85
-rw-r--r--tix/man/Mwm.n110
-rw-r--r--tix/man/NBFrame.html100
-rw-r--r--tix/man/NBFrame.n147
-rw-r--r--tix/man/NoteBook.html263
-rw-r--r--tix/man/NoteBook.n329
-rw-r--r--tix/man/OptMenu.html232
-rw-r--r--tix/man/OptMenu.n306
-rw-r--r--tix/man/PanedWin.html307
-rw-r--r--tix/man/PanedWin.n400
-rw-r--r--tix/man/PopMenu.html177
-rw-r--r--tix/man/PopMenu.n246
-rw-r--r--tix/man/SHList.html160
-rw-r--r--tix/man/SHList.n220
-rw-r--r--tix/man/SListBox.html214
-rw-r--r--tix/man/SListBox.n285
-rw-r--r--tix/man/SText.html160
-rw-r--r--tix/man/SText.n220
-rw-r--r--tix/man/SWindow.html206
-rw-r--r--tix/man/SWindow.n271
-rw-r--r--tix/man/Select.html307
-rw-r--r--tix/man/Select.n400
-rw-r--r--tix/man/StdBBox.html166
-rw-r--r--tix/man/StdBBox.n239
-rw-r--r--tix/man/TList.html606
-rw-r--r--tix/man/TList.n680
-rw-r--r--tix/man/TixComboBox.html492
-rw-r--r--tix/man/TixComboBox.n619
-rw-r--r--tix/man/TixIntro.html55
-rw-r--r--tix/man/TixIntro.n73
-rw-r--r--tix/man/Tree.html237
-rw-r--r--tix/man/Tree.n306
-rw-r--r--tix/man/Utils.html70
-rw-r--r--tix/man/Utils.n82
-rw-r--r--tix/man/Wm.html45
-rw-r--r--tix/man/Wm.n59
-rw-r--r--tix/man/compound.html314
-rw-r--r--tix/man/compound.n339
-rw-r--r--tix/man/index.html67
-rw-r--r--tix/man/man.macros186
-rw-r--r--tix/man/pixmap.html77
-rw-r--r--tix/man/pixmap.n84
-rw-r--r--tix/man/tix.html216
-rw-r--r--tix/man/tix.n256
-rw-r--r--tix/man/tixwish.1192
-rw-r--r--tix/man/tixwish.html172
-rw-r--r--tix/tests/Driver.tcl356
-rw-r--r--tix/tests/Makefile.in198
-rw-r--r--tix/tests/README58
-rwxr-xr-xtix/tests/Test.tcl60
-rw-r--r--tix/tests/cleanup/cleanup.tcl28
-rw-r--r--tix/tests/cleanup/files1
-rw-r--r--tix/tests/files24
-rw-r--r--tix/tests/general/NoteBook.tcl60
-rw-r--r--tix/tests/general/api.tcl254
-rw-r--r--tix/tests/general/cmderror.tcl49
-rw-r--r--tix/tests/general/combobox.tcl107
-rw-r--r--tix/tests/general/dirbox.tcl281
-rw-r--r--tix/tests/general/draw.tcl22
-rw-r--r--tix/tests/general/event0.tcl100
-rw-r--r--tix/tests/general/filebox.tcl133
-rw-r--r--tix/tests/general/files20
-rw-r--r--tix/tests/general/fs.tcl236
-rw-r--r--tix/tests/general/labentry.tcl52
-rw-r--r--tix/tests/general/minterp.tcl60
-rw-r--r--tix/tests/general/mwm.tcl46
-rw-r--r--tix/tests/general/oop.tcl11
-rw-r--r--tix/tests/general/options.tcl17
-rw-r--r--tix/tests/general/optmenu.tcl105
-rw-r--r--tix/tests/general/pane.tcl29
-rw-r--r--tix/tests/general/pkginit.tcl6
-rw-r--r--tix/tests/general/samples.tcl73
-rw-r--r--tix/tests/general/select.tcl45
-rw-r--r--tix/tests/general/slistbox.tcl16
-rw-r--r--tix/tests/general/testtmpl.tcl28
-rw-r--r--tix/tests/general/var1.tcl59
-rw-r--r--tix/tests/grid/Grid.tcl155
-rw-r--r--tix/tests/grid/files1
-rw-r--r--tix/tests/hlist/DirList.tcl51
-rw-r--r--tix/tests/hlist/HLHdr.tcl94
-rw-r--r--tix/tests/hlist/HLInd.tcl51
-rw-r--r--tix/tests/hlist/HList.tcl76
-rw-r--r--tix/tests/hlist/files3
-rw-r--r--tix/tests/hlist/items.tcl40
-rw-r--r--tix/tests/itcl/files5
-rw-r--r--tix/tests/itcl/general.tcl9
-rw-r--r--tix/tests/itcl/itk.tcl24
-rw-r--r--tix/tests/itcl/namesp.tcl22
-rw-r--r--tix/tests/itcl/pkginit.tcl2
-rw-r--r--tix/tests/itcl/scope1.tcl54
-rw-r--r--tix/tests/library/CaseData.tcl148
-rw-r--r--tix/tests/library/TestLib.tcl598
-rw-r--r--tix/tests/library/TestLib.txt53
-rw-r--r--tix/tests/library/load-init.tcl7
-rw-r--r--tix/tests/load/files1
-rw-r--r--tix/tests/load/general.tcl22
-rw-r--r--tix/tests/load/pkginit.tcl0
-rw-r--r--tix/tests/tlist/TList.tcl38
-rw-r--r--tix/tests/tlist/files1
-rw-r--r--tix/tests/xpm/2cpp.xpm11
-rw-r--r--tix/tests/xpm/brace.xpm19
-rw-r--r--tix/tests/xpm/comments.xpm21
-rw-r--r--tix/tests/xpm/compound.tcl47
-rw-r--r--tix/tests/xpm/f-badcol.xpm21
-rw-r--r--tix/tests/xpm/f-badpix.xpm21
-rw-r--r--tix/tests/xpm/f-commt.xpm32
-rw-r--r--tix/tests/xpm/f-missline.xpm19
-rw-r--r--tix/tests/xpm/f-ok.xpm21
-rw-r--r--tix/tests/xpm/f-shortln.xpm21
-rw-r--r--tix/tests/xpm/files2
-rw-r--r--tix/tests/xpm/folder.xpm21
-rw-r--r--tix/tests/xpm/xpm.tcl145
-rw-r--r--tix/tixConfig.sh.in25
-rw-r--r--tix/tools/README.html32
-rwxr-xr-xtix/tools/color.tcl39
-rwxr-xr-xtix/tools/doconfig.tcl746
-rwxr-xr-xtix/tools/domakefile.tcl764
-rwxr-xr-xtix/tools/dosstrip.tcl72
-rw-r--r--tix/tools/doxx.tcl160
-rwxr-xr-xtix/tools/hanno.tcl66
-rwxr-xr-xtix/tools/icon.tcl17
-rwxr-xr-xtix/tools/makebitmap.tcl81
-rwxr-xr-xtix/tools/makescript.tcl150
-rwxr-xr-xtix/tools/mkfaq.tcl10
-rwxr-xr-xtix/tools/setcolon.sh32
-rw-r--r--tix/tools/tclc.tcl223
-rw-r--r--tix/tools/tclc_s.tcl85
-rwxr-xr-xtix/tools/tcltrim24
-rwxr-xr-xtix/tools/tixindex66
-rwxr-xr-xtix/tools/tixverify.tcl323
-rw-r--r--tix/unix/Makefile.in347
-rw-r--r--tix/unix/aclocal.m41
-rwxr-xr-xtix/unix/configure1506
-rw-r--r--tix/unix/configure.in35
-rw-r--r--tix/unix/samAppInit.c177
-rw-r--r--tix/unix/tixUnixDraw.c307
-rw-r--r--tix/unix/tixUnixInt.h20
-rw-r--r--tix/unix/tixUnixPort.h29
-rw-r--r--tix/unix/tixUnixSam.c39
-rw-r--r--tix/unix/tixUnixWm.c23
-rw-r--r--tix/unix/tixUnixXpm.c270
-rw-r--r--tix/unix/tk4.2/Makefile.in541
-rwxr-xr-xtix/unix/tk4.2/configure2190
-rw-r--r--tix/unix/tk4.2/configure.in431
-rw-r--r--tix/unix/tk4.2/pkgIndex.tcl.in4
-rw-r--r--tix/unix/tk4.2/tclUnixSam76.c26
-rw-r--r--tix/unix/tk4.2/tixAppInit.c112
-rw-r--r--tix/unix/tk4.2/tkUnixSam42.c215
-rw-r--r--tix/unix/tk8.0/Makefile.in555
-rwxr-xr-xtix/unix/tk8.0/configure2163
-rw-r--r--tix/unix/tk8.0/configure.in445
-rw-r--r--tix/unix/tk8.0/pkgIndex.tcl.in4
-rw-r--r--tix/unix/tk8.0/tixAppInit.c112
-rw-r--r--tix/unix/tk8.1/Makefile.in556
-rw-r--r--tix/unix/tk8.1/aclocal.m41
-rwxr-xr-xtix/unix/tk8.1/configure2480
-rw-r--r--tix/unix/tk8.1/configure.in372
-rw-r--r--tix/unix/tk8.1/pkgIndex.tcl.in4
-rw-r--r--tix/unix/tk8.1/tixAppInit.c112
-rw-r--r--tix/win/DLLDemo/Demo.c132
-rw-r--r--tix/win/DLLDemo/Makefile.bc178
-rw-r--r--tix/win/DLLDemo/README72
-rw-r--r--tix/win/Makefile.in620
-rw-r--r--tix/win/README2
-rw-r--r--tix/win/aclocal.m41
-rwxr-xr-xtix/win/configure1681
-rw-r--r--tix/win/configure.in65
-rw-r--r--tix/win/makefile.bc367
-rw-r--r--tix/win/makefile.vc292
-rw-r--r--tix/win/pkgIndex.tcl15
-rwxr-xr-xtix/win/rc/tixwish.icobin0 -> 1398 bytes
-rw-r--r--tix/win/rc/tixwish.rc40
-rw-r--r--tix/win/tcl7.6/dummy.dir0
-rw-r--r--tix/win/tcl8.0/dummy.dir0
-rw-r--r--tix/win/tcl8.1/dummy.dir0
-rw-r--r--tix/win/tixWCmpt.c184
-rw-r--r--tix/win/tixWinDraw.c310
-rw-r--r--tix/win/tixWinInt.h20
-rw-r--r--tix/win/tixWinMain.c303
-rw-r--r--tix/win/tixWinPort.h43
-rw-r--r--tix/win/tixWinWm.c24
-rw-r--r--tix/win/tixWinXpm.c309
-rw-r--r--tix/win/tkConsole41.c543
-rw-r--r--tix/win/tkConsole42.c624
-rw-r--r--tix/win/tkConsole80a1.c631
-rw-r--r--tix/win/tkConsole80b1.c611
-rw-r--r--tix/win/tkConsole81.c613
-rw-r--r--tk/ChangeLog886
-rw-r--r--tk/Makefile.in71
-rw-r--r--tk/README393
-rw-r--r--tk/bitmaps/error.bmp8
-rw-r--r--tk/bitmaps/gray12.bmp6
-rw-r--r--tk/bitmaps/gray25.bmp6
-rw-r--r--tk/bitmaps/gray50.bmp6
-rw-r--r--tk/bitmaps/gray75.bmp6
-rw-r--r--tk/bitmaps/hourglass.bmp9
-rw-r--r--tk/bitmaps/info.bmp5
-rw-r--r--tk/bitmaps/questhead.bmp9
-rw-r--r--tk/bitmaps/question.bmp10
-rw-r--r--tk/bitmaps/warning.bmp5
-rw-r--r--tk/changes4284
-rw-r--r--tk/compat/license.terms39
-rw-r--r--tk/compat/limits.h24
-rw-r--r--tk/compat/stdlib.h45
-rw-r--r--tk/compat/unistd.h84
-rwxr-xr-xtk/configure983
-rw-r--r--tk/configure.in28
-rw-r--r--tk/doc/3DBorder.3262
-rw-r--r--tk/doc/BindTable.3157
-rw-r--r--tk/doc/CanvPsY.3122
-rw-r--r--tk/doc/CanvTkwin.3161
-rw-r--r--tk/doc/CanvTxtInfo.3104
-rw-r--r--tk/doc/Clipboard.380
-rw-r--r--tk/doc/ClrSelect.342
-rw-r--r--tk/doc/ConfigWidg.3618
-rw-r--r--tk/doc/ConfigWind.3153
-rw-r--r--tk/doc/CoordToWin.351
-rw-r--r--tk/doc/CrtErrHdlr.3145
-rw-r--r--tk/doc/CrtGenHdlr.384
-rw-r--r--tk/doc/CrtImgType.3255
-rw-r--r--tk/doc/CrtItemType.3626
-rw-r--r--tk/doc/CrtPhImgFmt.3235
-rw-r--r--tk/doc/CrtSelHdlr.3120
-rw-r--r--tk/doc/CrtWindow.3142
-rw-r--r--tk/doc/DeleteImg.335
-rw-r--r--tk/doc/DrawFocHlt.340
-rw-r--r--tk/doc/EventHndlr.379
-rw-r--r--tk/doc/FindPhoto.3202
-rw-r--r--tk/doc/FontId.395
-rw-r--r--tk/doc/FreeXId.352
-rw-r--r--tk/doc/GeomReq.369
-rw-r--r--tk/doc/GetAnchor.364
-rw-r--r--tk/doc/GetBitmap.3266
-rw-r--r--tk/doc/GetCapStyl.363
-rw-r--r--tk/doc/GetClrmap.373
-rw-r--r--tk/doc/GetColor.3146
-rw-r--r--tk/doc/GetCursor.3188
-rw-r--r--tk/doc/GetFont.374
-rw-r--r--tk/doc/GetGC.374
-rw-r--r--tk/doc/GetImage.3135
-rw-r--r--tk/doc/GetJoinStl.362
-rw-r--r--tk/doc/GetJustify.369
-rw-r--r--tk/doc/GetOption.346
-rw-r--r--tk/doc/GetPixels.376
-rw-r--r--tk/doc/GetPixmap.356
-rw-r--r--tk/doc/GetRelief.359
-rw-r--r--tk/doc/GetRootCrd.343
-rw-r--r--tk/doc/GetScroll.365
-rw-r--r--tk/doc/GetSelect.379
-rw-r--r--tk/doc/GetUid.350
-rw-r--r--tk/doc/GetVRoot.349
-rw-r--r--tk/doc/GetVisual.398
-rw-r--r--tk/doc/HandleEvent.349
-rw-r--r--tk/doc/IdToWindow.336
-rw-r--r--tk/doc/ImgChanged.369
-rw-r--r--tk/doc/InternAtom.358
-rw-r--r--tk/doc/MainLoop.332
-rw-r--r--tk/doc/MainWin.336
-rw-r--r--tk/doc/MaintGeom.3102
-rw-r--r--tk/doc/ManageGeom.394
-rw-r--r--tk/doc/MapWindow.353
-rw-r--r--tk/doc/MeasureChar.3130
-rw-r--r--tk/doc/MoveToplev.355
-rw-r--r--tk/doc/Name.382
-rw-r--r--tk/doc/NameOfImg.334
-rw-r--r--tk/doc/OwnSelect.352
-rw-r--r--tk/doc/ParseArgv.3351
-rw-r--r--tk/doc/QWinEvent.342
-rw-r--r--tk/doc/Restack.349
-rw-r--r--tk/doc/RestrictEv.381
-rw-r--r--tk/doc/SetAppName.365
-rw-r--r--tk/doc/SetClass.361
-rw-r--r--tk/doc/SetGrid.367
-rw-r--r--tk/doc/SetVisual.354
-rw-r--r--tk/doc/StrictMotif.341
-rw-r--r--tk/doc/TextLayout.3270
-rw-r--r--tk/doc/Tk_Init.347
-rw-r--r--tk/doc/Tk_Main.361
-rw-r--r--tk/doc/WindowId.3151
-rw-r--r--tk/doc/bell.n34
-rw-r--r--tk/doc/bind.n523
-rw-r--r--tk/doc/bindtags.n81
-rw-r--r--tk/doc/bitmap.n114
-rw-r--r--tk/doc/button.n176
-rw-r--r--tk/doc/canvas.n1577
-rw-r--r--tk/doc/checkbutton.n238
-rw-r--r--tk/doc/chooseColor.n49
-rw-r--r--tk/doc/clipboard.n81
-rw-r--r--tk/doc/destroy.n34
-rw-r--r--tk/doc/dialog.n65
-rw-r--r--tk/doc/entry.n417
-rw-r--r--tk/doc/event.n352
-rw-r--r--tk/doc/focus.n113
-rw-r--r--tk/doc/focusNext.n60
-rw-r--r--tk/doc/font.n285
-rw-r--r--tk/doc/frame.n134
-rw-r--r--tk/doc/getOpenFile.n157
-rw-r--r--tk/doc/grab.n122
-rw-r--r--tk/doc/grid.n337
-rw-r--r--tk/doc/image.n90
-rw-r--r--tk/doc/label.n103
-rw-r--r--tk/doc/license.terms39
-rw-r--r--tk/doc/listbox.n491
-rw-r--r--tk/doc/loadTk.n76
-rw-r--r--tk/doc/lower.n38
-rw-r--r--tk/doc/man.macros236
-rw-r--r--tk/doc/menu.n757
-rw-r--r--tk/doc/menubar.n33
-rw-r--r--tk/doc/menubutton.n193
-rw-r--r--tk/doc/message.n147
-rw-r--r--tk/doc/messageBox.n90
-rw-r--r--tk/doc/option.n91
-rw-r--r--tk/doc/optionMenu.n40
-rw-r--r--tk/doc/options.n328
-rw-r--r--tk/doc/pack-old.n196
-rw-r--r--tk/doc/pack.n266
-rw-r--r--tk/doc/palette.n73
-rw-r--r--tk/doc/photo.n344
-rw-r--r--tk/doc/place.n237
-rw-r--r--tk/doc/popup.n33
-rw-r--r--tk/doc/radiobutton.n233
-rw-r--r--tk/doc/raise.n38
-rw-r--r--tk/doc/scale.n246
-rw-r--r--tk/doc/scrollbar.n340
-rw-r--r--tk/doc/selection.n128
-rw-r--r--tk/doc/send.n92
-rw-r--r--tk/doc/text.n1621
-rw-r--r--tk/doc/tk.n72
-rw-r--r--tk/doc/tkerror.n38
-rw-r--r--tk/doc/tkvars.n72
-rw-r--r--tk/doc/tkwait.n51
-rw-r--r--tk/doc/toplevel.n163
-rw-r--r--tk/doc/winfo.n330
-rw-r--r--tk/doc/wish.1186
-rw-r--r--tk/doc/wm.n503
-rw-r--r--tk/generic/README5
-rw-r--r--tk/generic/default.h29
-rw-r--r--tk/generic/ks_names.h921
-rw-r--r--tk/generic/tk.h1565
-rw-r--r--tk/generic/tk3d.c950
-rw-r--r--tk/generic/tk3d.h87
-rw-r--r--tk/generic/tkArgv.c439
-rw-r--r--tk/generic/tkAtom.c217
-rw-r--r--tk/generic/tkBind.c4552
-rw-r--r--tk/generic/tkBitmap.c630
-rw-r--r--tk/generic/tkButton.c1358
-rw-r--r--tk/generic/tkButton.h249
-rw-r--r--tk/generic/tkCanvArc.c1717
-rw-r--r--tk/generic/tkCanvBmap.c801
-rw-r--r--tk/generic/tkCanvImg.c677
-rw-r--r--tk/generic/tkCanvLine.c1623
-rw-r--r--tk/generic/tkCanvPoly.c1000
-rw-r--r--tk/generic/tkCanvPs.c1386
-rw-r--r--tk/generic/tkCanvText.c1314
-rw-r--r--tk/generic/tkCanvUtil.c376
-rw-r--r--tk/generic/tkCanvWind.c862
-rw-r--r--tk/generic/tkCanvas.c3829
-rw-r--r--tk/generic/tkCanvas.h259
-rw-r--r--tk/generic/tkClipboard.c606
-rw-r--r--tk/generic/tkCmds.c1649
-rw-r--r--tk/generic/tkColor.c524
-rw-r--r--tk/generic/tkColor.h77
-rw-r--r--tk/generic/tkConfig.c990
-rw-r--r--tk/generic/tkConsole.c616
-rw-r--r--tk/generic/tkCursor.c384
-rw-r--r--tk/generic/tkEntry.c2318
-rw-r--r--tk/generic/tkError.c307
-rw-r--r--tk/generic/tkEvent.c1043
-rw-r--r--tk/generic/tkFileFilter.c486
-rw-r--r--tk/generic/tkFileFilter.h92
-rw-r--r--tk/generic/tkFocus.c999
-rw-r--r--tk/generic/tkFont.c3040
-rw-r--r--tk/generic/tkFont.h220
-rw-r--r--tk/generic/tkFrame.c939
-rw-r--r--tk/generic/tkGC.c431
-rw-r--r--tk/generic/tkGeometry.c582
-rw-r--r--tk/generic/tkGet.c586
-rw-r--r--tk/generic/tkGrab.c1535
-rw-r--r--tk/generic/tkGrid.c2615
-rw-r--r--tk/generic/tkImage.c795
-rw-r--r--tk/generic/tkImgBmap.c1082
-rw-r--r--tk/generic/tkImgGIF.c1098
-rw-r--r--tk/generic/tkImgPPM.c421
-rw-r--r--tk/generic/tkImgPhoto.c4622
-rw-r--r--tk/generic/tkImgUtil.c78
-rw-r--r--tk/generic/tkInitScript.h56
-rw-r--r--tk/generic/tkInt.h994
-rw-r--r--tk/generic/tkListbox.c2337
-rw-r--r--tk/generic/tkMacWinMenu.c134
-rw-r--r--tk/generic/tkMain.c390
-rw-r--r--tk/generic/tkMenu.c3057
-rw-r--r--tk/generic/tkMenu.h549
-rw-r--r--tk/generic/tkMenuDraw.c1039
-rw-r--r--tk/generic/tkMenubutton.c872
-rw-r--r--tk/generic/tkMenubutton.h215
-rw-r--r--tk/generic/tkMessage.c849
-rw-r--r--tk/generic/tkOption.c1397
-rw-r--r--tk/generic/tkPack.c1727
-rw-r--r--tk/generic/tkPlace.c1060
-rw-r--r--tk/generic/tkPointer.c623
-rw-r--r--tk/generic/tkPort.h36
-rw-r--r--tk/generic/tkRectOval.c1032
-rw-r--r--tk/generic/tkScale.c1145
-rw-r--r--tk/generic/tkScale.h233
-rw-r--r--tk/generic/tkScrollbar.c691
-rw-r--r--tk/generic/tkScrollbar.h208
-rw-r--r--tk/generic/tkSelect.c1341
-rw-r--r--tk/generic/tkSelect.h184
-rw-r--r--tk/generic/tkSquare.c587
-rw-r--r--tk/generic/tkTest.c1135
-rw-r--r--tk/generic/tkText.c2364
-rw-r--r--tk/generic/tkText.h857
-rw-r--r--tk/generic/tkTextBTree.c3594
-rw-r--r--tk/generic/tkTextDisp.c5045
-rw-r--r--tk/generic/tkTextImage.c898
-rw-r--r--tk/generic/tkTextIndex.c840
-rw-r--r--tk/generic/tkTextMark.c775
-rw-r--r--tk/generic/tkTextTag.c1376
-rw-r--r--tk/generic/tkTextWind.c1176
-rw-r--r--tk/generic/tkTrig.c1467
-rw-r--r--tk/generic/tkUtil.c348
-rw-r--r--tk/generic/tkVisual.c540
-rw-r--r--tk/generic/tkWindow.c2836
-rw-r--r--tk/library/bgerror.tcl99
-rw-r--r--tk/library/button.tcl465
-rw-r--r--tk/library/clrpick.tcl691
-rw-r--r--tk/library/comdlg.tcl308
-rw-r--r--tk/library/console.tcl481
-rw-r--r--tk/library/demos/README46
-rw-r--r--tk/library/demos/arrow.tcl238
-rw-r--r--tk/library/demos/bind.tcl79
-rw-r--r--tk/library/demos/bitmap.tcl55
-rwxr-xr-xtk/library/demos/browse56
-rw-r--r--tk/library/demos/button.tcl36
-rw-r--r--tk/library/demos/check.tcl33
-rw-r--r--tk/library/demos/clrpick.tcl56
-rw-r--r--tk/library/demos/colors.tcl101
-rw-r--r--tk/library/demos/cscroll.tcl96
-rw-r--r--tk/library/demos/ctext.tcl146
-rw-r--r--tk/library/demos/dialog1.tcl15
-rw-r--r--tk/library/demos/dialog2.tcl19
-rw-r--r--tk/library/demos/entry1.tcl36
-rw-r--r--tk/library/demos/entry2.tcl48
-rw-r--r--tk/library/demos/filebox.tcl70
-rw-r--r--tk/library/demos/floor.tcl1370
-rw-r--r--tk/library/demos/form.tcl40
-rwxr-xr-xtk/library/demos/hello18
-rw-r--r--tk/library/demos/hscale.tcl47
-rw-r--r--tk/library/demos/icon.tcl52
-rw-r--r--tk/library/demos/image1.tcl36
-rw-r--r--tk/library/demos/image2.tcl80
-rw-r--r--tk/library/demos/images/earth.gifbin0 -> 51712 bytes
-rw-r--r--tk/library/demos/images/earthris.gifbin0 -> 6343 bytes
-rw-r--r--tk/library/demos/images/face.bmp173
-rw-r--r--tk/library/demos/images/flagdown.bmp27
-rw-r--r--tk/library/demos/images/flagup.bmp27
-rw-r--r--tk/library/demos/images/gray25.bmp6
-rw-r--r--tk/library/demos/images/letters.bmp27
-rw-r--r--tk/library/demos/images/noletter.bmp27
-rw-r--r--tk/library/demos/images/pattern.bmp6
-rw-r--r--tk/library/demos/images/tcllogo.gifbin0 -> 2341 bytes
-rw-r--r--tk/library/demos/images/teapot.ppm31
-rw-r--r--tk/library/demos/items.tcl285
-rwxr-xr-xtk/library/demos/ixset312
-rw-r--r--tk/library/demos/label.tcl40
-rw-r--r--tk/library/demos/license.terms39
-rw-r--r--tk/library/demos/menu.tcl152
-rw-r--r--tk/library/demos/menubu.tcl93
-rw-r--r--tk/library/demos/msgbox.tcl65
-rw-r--r--tk/library/demos/plot.tcl98
-rw-r--r--tk/library/demos/puzzle.tcl73
-rw-r--r--tk/library/demos/radio.tcl44
-rwxr-xr-xtk/library/demos/rmt205
-rwxr-xr-xtk/library/demos/rolodex196
-rw-r--r--tk/library/demos/ruler.tcl173
-rw-r--r--tk/library/demos/sayings.tcl46
-rw-r--r--tk/library/demos/search.tcl141
-rwxr-xr-xtk/library/demos/square55
-rw-r--r--tk/library/demos/states.tcl45
-rw-r--r--tk/library/demos/style.tcl152
-rw-r--r--tk/library/demos/tclIndex67
-rwxr-xr-xtk/library/demos/tcolor358
-rw-r--r--tk/library/demos/text.tcl76
-rwxr-xr-xtk/library/demos/timer40
-rw-r--r--tk/library/demos/twind.tcl196
-rw-r--r--tk/library/demos/vscale.tcl48
-rwxr-xr-xtk/library/demos/widget391
-rw-r--r--tk/library/dialog.tcl175
-rw-r--r--tk/library/entry.tcl610
-rw-r--r--tk/library/focus.tcl180
-rw-r--r--tk/library/images/README12
-rw-r--r--tk/library/images/logo100.gifbin0 -> 2341 bytes
-rw-r--r--tk/library/images/logo64.gifbin0 -> 1670 bytes
-rw-r--r--tk/library/images/logoLarge.gifbin0 -> 11000 bytes
-rw-r--r--tk/library/images/logoMed.gifbin0 -> 3889 bytes
-rw-r--r--tk/library/images/pwrdLogo100.gifbin0 -> 4147 bytes
-rw-r--r--tk/library/images/pwrdLogo150.gifbin0 -> 6809 bytes
-rw-r--r--tk/library/images/pwrdLogo175.gifbin0 -> 7964 bytes
-rw-r--r--tk/library/images/pwrdLogo200.gifbin0 -> 8964 bytes
-rw-r--r--tk/library/images/pwrdLogo75.gifbin0 -> 3189 bytes
-rw-r--r--tk/library/license.terms39
-rw-r--r--tk/library/listbox.tcl452
-rw-r--r--tk/library/menu.tcl1235
-rw-r--r--tk/library/msgbox.tcl268
-rw-r--r--tk/library/obsolete.tcl21
-rw-r--r--tk/library/optMenu.tcl45
-rw-r--r--tk/library/palette.tcl224
-rw-r--r--tk/library/safetk.tcl204
-rw-r--r--tk/library/scale.tcl265
-rw-r--r--tk/library/scrlbar.tcl417
-rw-r--r--tk/library/tclIndex244
-rw-r--r--tk/library/tearoff.tcl145
-rw-r--r--tk/library/text.tcl1010
-rw-r--r--tk/library/tk.tcl192
-rw-r--r--tk/library/tkfbox.tcl1665
-rw-r--r--tk/library/xmfbox.tcl650
-rw-r--r--tk/license.terms39
-rw-r--r--tk/mac/MW_TkHeader.pch59
-rw-r--r--tk/mac/README306
-rw-r--r--tk/mac/bugs.doc45
-rw-r--r--tk/mac/license.terms39
-rw-r--r--tk/mac/tclets.tcl215
-rw-r--r--tk/mac/tkMac.h81
-rw-r--r--tk/mac/tkMacAppInit.c393
-rw-r--r--tk/mac/tkMacApplication.r267
-rw-r--r--tk/mac/tkMacBitmap.c268
-rw-r--r--tk/mac/tkMacButton.c1443
-rw-r--r--tk/mac/tkMacClipboard.c293
-rw-r--r--tk/mac/tkMacColor.c493
-rw-r--r--tk/mac/tkMacCursor.c392
-rw-r--r--tk/mac/tkMacCursors.r130
-rw-r--r--tk/mac/tkMacDefault.h462
-rw-r--r--tk/mac/tkMacDialog.c939
-rw-r--r--tk/mac/tkMacDraw.c1130
-rw-r--r--tk/mac/tkMacEmbed.c1192
-rw-r--r--tk/mac/tkMacFont.c678
-rw-r--r--tk/mac/tkMacHLEvents.c437
-rw-r--r--tk/mac/tkMacInit.c240
-rw-r--r--tk/mac/tkMacInt.h296
-rw-r--r--tk/mac/tkMacKeyboard.c384
-rw-r--r--tk/mac/tkMacLibrary.r508
-rw-r--r--tk/mac/tkMacMDEF.c116
-rw-r--r--tk/mac/tkMacMDEF.r45
-rw-r--r--tk/mac/tkMacMenu.c4302
-rw-r--r--tk/mac/tkMacMenu.r47
-rw-r--r--tk/mac/tkMacMenubutton.c339
-rw-r--r--tk/mac/tkMacMenus.c346
-rw-r--r--tk/mac/tkMacPort.h147
-rw-r--r--tk/mac/tkMacRegion.c217
-rw-r--r--tk/mac/tkMacResource.r505
-rw-r--r--tk/mac/tkMacScale.c603
-rw-r--r--tk/mac/tkMacScrlbr.c1057
-rw-r--r--tk/mac/tkMacSend.c358
-rw-r--r--tk/mac/tkMacShLib.exp765
-rw-r--r--tk/mac/tkMacSubwindows.c1245
-rw-r--r--tk/mac/tkMacTest.c81
-rw-r--r--tk/mac/tkMacWindowMgr.c1630
-rw-r--r--tk/mac/tkMacWm.c4233
-rw-r--r--tk/mac/tkMacXCursors.r961
-rw-r--r--tk/mac/tkMacXStubs.c709
-rw-r--r--tk/tests/README30
-rw-r--r--tk/tests/arc.tcl140
-rw-r--r--tk/tests/bell.test37
-rw-r--r--tk/tests/bevel.tcl128
-rw-r--r--tk/tests/bgerror.test59
-rw-r--r--tk/tests/bind.test2559
-rw-r--r--tk/tests/bugs.tcl30
-rw-r--r--tk/tests/butGeom.tcl115
-rw-r--r--tk/tests/butGeom2.tcl113
-rw-r--r--tk/tests/button.test822
-rw-r--r--tk/tests/canvImg.test397
-rw-r--r--tk/tests/canvPs.test105
-rw-r--r--tk/tests/canvPsArc.tcl45
-rw-r--r--tk/tests/canvPsBmap.tcl71
-rw-r--r--tk/tests/canvPsGrph.tcl87
-rw-r--r--tk/tests/canvPsText.tcl83
-rw-r--r--tk/tests/canvRect.test329
-rw-r--r--tk/tests/canvText.test493
-rw-r--r--tk/tests/canvWind.test133
-rw-r--r--tk/tests/canvas.test238
-rw-r--r--tk/tests/clipboard.test234
-rw-r--r--tk/tests/clrpick.test215
-rw-r--r--tk/tests/cmap.tcl61
-rw-r--r--tk/tests/cmds.test43
-rw-r--r--tk/tests/color.test167
-rw-r--r--tk/tests/entry.test1269
-rw-r--r--tk/tests/event.test41
-rw-r--r--tk/tests/filebox.test302
-rw-r--r--tk/tests/focus.test636
-rw-r--r--tk/tests/focusTcl.test279
-rw-r--r--tk/tests/font.test1092
-rw-r--r--tk/tests/frame.test617
-rw-r--r--tk/tests/geometry.test251
-rw-r--r--tk/tests/grid.test1205
-rw-r--r--tk/tests/id.test102
-rw-r--r--tk/tests/image.test357
-rw-r--r--tk/tests/imgBmap.test474
-rw-r--r--tk/tests/imgPPM.test156
-rw-r--r--tk/tests/imgPhoto.test423
-rw-r--r--tk/tests/license.terms39
-rw-r--r--tk/tests/listbox.test1658
-rw-r--r--tk/tests/macEmbed.test297
-rw-r--r--tk/tests/macFont.test182
-rw-r--r--tk/tests/macMenu.test1565
-rw-r--r--tk/tests/macWinMenu.test117
-rw-r--r--tk/tests/macscrollbar.test101
-rw-r--r--tk/tests/main.test31
-rw-r--r--tk/tests/menu.test2385
-rw-r--r--tk/tests/menuDraw.test546
-rw-r--r--tk/tests/menubut.test352
-rw-r--r--tk/tests/msgbox.test157
-rw-r--r--tk/tests/obj.test37
-rw-r--r--tk/tests/oldpack.test508
-rw-r--r--tk/tests/option.file117
-rw-r--r--tk/tests/option.file22
-rw-r--r--tk/tests/option.test232
-rw-r--r--tk/tests/pack.test969
-rw-r--r--tk/tests/place.test221
-rw-r--r--tk/tests/raise.test299
-rw-r--r--tk/tests/safe.test169
-rw-r--r--tk/tests/scale.test801
-rw-r--r--tk/tests/scrollbar.test665
-rw-r--r--tk/tests/select.test987
-rw-r--r--tk/tests/send.test656
-rw-r--r--tk/tests/text.test1262
-rw-r--r--tk/tests/textBTree.test897
-rw-r--r--tk/tests/textDisp.test2868
-rw-r--r--tk/tests/textImage.test353
-rw-r--r--tk/tests/textIndex.test349
-rw-r--r--tk/tests/textMark.test222
-rw-r--r--tk/tests/textTag.test756
-rw-r--r--tk/tests/textWind.test826
-rw-r--r--tk/tests/tk.test80
-rw-r--r--tk/tests/unixButton.test182
-rw-r--r--tk/tests/unixEmbed.test627
-rw-r--r--tk/tests/unixFont.test293
-rw-r--r--tk/tests/unixMenu.test969
-rw-r--r--tk/tests/unixWm.test2358
-rw-r--r--tk/tests/util.test70
-rw-r--r--tk/tests/visual.test312
-rw-r--r--tk/tests/winButton.test154
-rw-r--r--tk/tests/winClipboard.test47
-rw-r--r--tk/tests/winFont.test185
-rw-r--r--tk/tests/winMenu.test1030
-rw-r--r--tk/tests/winWm.test219
-rw-r--r--tk/tests/window.test137
-rw-r--r--tk/tests/winfo.test367
-rw-r--r--tk/testsuite/config/default.exp254
-rw-r--r--tk/testsuite/tk.tests/tk-test.exp99
-rw-r--r--tk/unix/ChangeLog230
-rw-r--r--tk/unix/Makefile.in1061
-rw-r--r--tk/unix/README125
-rwxr-xr-xtk/unix/configure3335
-rwxr-xr-xtk/unix/configure.in553
-rwxr-xr-xtk/unix/install-sh128
-rw-r--r--tk/unix/license.terms39
-rwxr-xr-xtk/unix/mkLinks878
-rw-r--r--tk/unix/tkAppInit.c120
-rw-r--r--tk/unix/tkConfig.sh.in77
-rw-r--r--tk/unix/tkUnix.c79
-rw-r--r--tk/unix/tkUnix3d.c448
-rw-r--r--tk/unix/tkUnixButton.c478
-rw-r--r--tk/unix/tkUnixColor.c424
-rw-r--r--tk/unix/tkUnixCursor.c407
-rw-r--r--tk/unix/tkUnixDefault.h451
-rw-r--r--tk/unix/tkUnixDialog.c210
-rw-r--r--tk/unix/tkUnixDraw.c171
-rw-r--r--tk/unix/tkUnixEmbed.c1001
-rw-r--r--tk/unix/tkUnixEvent.c498
-rw-r--r--tk/unix/tkUnixFocus.c149
-rw-r--r--tk/unix/tkUnixFont.c998
-rw-r--r--tk/unix/tkUnixInit.c117
-rw-r--r--tk/unix/tkUnixInt.h32
-rw-r--r--tk/unix/tkUnixMenu.c1603
-rw-r--r--tk/unix/tkUnixMenubu.c307
-rw-r--r--tk/unix/tkUnixPort.h236
-rw-r--r--tk/unix/tkUnixScale.c828
-rw-r--r--tk/unix/tkUnixScrlbr.c476
-rw-r--r--tk/unix/tkUnixSelect.c1189
-rw-r--r--tk/unix/tkUnixSend.c1851
-rw-r--r--tk/unix/tkUnixWm.c4820
-rw-r--r--tk/unix/tkUnixXId.c537
-rw-r--r--tk/win/Makefile.in646
-rw-r--r--tk/win/README122
-rwxr-xr-xtk/win/configure1258
-rwxr-xr-xtk/win/configure.in110
-rw-r--r--tk/win/license.terms39
-rw-r--r--tk/win/makefile.bc340
-rw-r--r--tk/win/makefile.vc440
-rw-r--r--tk/win/mkd.bat21
-rw-r--r--tk/win/rc/buttons.bmpbin0 -> 846 bytes
-rw-r--r--tk/win/rc/cursor00.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor02.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor04.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor06.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor08.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor0a.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor0c.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor0e.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor10.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor12.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor14.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor16.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor18.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor1a.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor1c.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor1e.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor20.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor22.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor24.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor26.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor28.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor2a.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor2c.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor2e.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor30.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor32.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor34.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor36.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor38.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor3a.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor3c.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor3e.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor40.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor42.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor44.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor46.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor48.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor4a.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor4c.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor4e.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor50.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor52.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor54.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor56.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor58.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor5a.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor5c.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor5e.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor60.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor62.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor64.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor66.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor68.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor6a.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor6c.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor6e.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor70.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor72.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor74.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor76.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor78.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor7a.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor7c.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor7e.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor80.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor82.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor84.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor86.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor88.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor8a.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor8c.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor8e.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor90.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor92.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor94.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor96.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cursor98.curbin0 -> 326 bytes
-rw-r--r--tk/win/rc/cygnus.icobin0 -> 1398 bytes
-rw-r--r--tk/win/rc/tk.icobin0 -> 1398 bytes
-rw-r--r--tk/win/rc/tk.rc132
-rw-r--r--tk/win/rc/wish.icobin0 -> 1398 bytes
-rw-r--r--tk/win/rc/wish.rc44
-rw-r--r--tk/win/rmd.bat25
-rw-r--r--tk/win/stubs.c397
-rw-r--r--tk/win/tk.def1056
-rw-r--r--tk/win/tkWin.h64
-rw-r--r--tk/win/tkWin32Dll.c101
-rw-r--r--tk/win/tkWin3d.c535
-rw-r--r--tk/win/tkWinButton.c870
-rw-r--r--tk/win/tkWinClipboard.c291
-rw-r--r--tk/win/tkWinColor.c643
-rw-r--r--tk/win/tkWinCursor.c210
-rw-r--r--tk/win/tkWinDefault.h457
-rw-r--r--tk/win/tkWinDialog.c1136
-rw-r--r--tk/win/tkWinDraw.c1264
-rw-r--r--tk/win/tkWinEmbed.c645
-rw-r--r--tk/win/tkWinFont.c689
-rw-r--r--tk/win/tkWinImage.c329
-rw-r--r--tk/win/tkWinInit.c121
-rw-r--r--tk/win/tkWinInt.h202
-rw-r--r--tk/win/tkWinKey.c381
-rw-r--r--tk/win/tkWinMenu.c2699
-rw-r--r--tk/win/tkWinPixmap.c184
-rw-r--r--tk/win/tkWinPointer.c477
-rw-r--r--tk/win/tkWinPort.h135
-rw-r--r--tk/win/tkWinRegion.c179
-rw-r--r--tk/win/tkWinScrlbr.c745
-rw-r--r--tk/win/tkWinSend.c86
-rw-r--r--tk/win/tkWinWindow.c801
-rw-r--r--tk/win/tkWinWm.c4260
-rw-r--r--tk/win/tkWinX.c1088
-rw-r--r--tk/win/winMain.c321
-rw-r--r--tk/xlib/X11/X.h669
-rw-r--r--tk/xlib/X11/Xatom.h79
-rw-r--r--tk/xlib/X11/Xfuncproto.h60
-rw-r--r--tk/xlib/X11/Xlib.h4317
-rw-r--r--tk/xlib/X11/Xutil.h879
-rw-r--r--tk/xlib/X11/cursorfont.h79
-rw-r--r--tk/xlib/X11/keysym.h39
-rw-r--r--tk/xlib/X11/keysymdef.h1169
-rw-r--r--tk/xlib/X11/license.terms39
-rw-r--r--tk/xlib/license.terms39
-rw-r--r--tk/xlib/xbytes.h58
-rw-r--r--tk/xlib/xcolors.c911
-rw-r--r--tk/xlib/xdraw.c82
-rw-r--r--tk/xlib/xgc.c353
-rw-r--r--tk/xlib/ximage.c71
-rw-r--r--tk/xlib/xutil.c116
1859 files changed, 591150 insertions, 0 deletions
diff --git a/itcl/ChangeLog b/itcl/ChangeLog
new file mode 100644
index 00000000000..3388565e1a6
--- /dev/null
+++ b/itcl/ChangeLog
@@ -0,0 +1,290 @@
+2000-01-26 DJ Delorie <dj@cygnus.com>
+
+ * itcl/win/dllEntryPoint.c (DllMain): Use _imp__ instead of __imp_
+ * itk/win/dllEntryPoint.c (DllMain): ditto
+ * itcl/generic/itcl_methods.c (tclByteCodeType): ditto, but unused
+
+1999-12-21 Mo DeJong <mdejong@cygnus.com>
+
+ * itcl/generic/itcl_parse.c: Applied patch to fix
+ crash when tearing down the itcl::parser namespace.
+
+1999-09-23 Ben Elliston <bje@cygnus.com>
+
+ * itcl/unix/configure.in: Quoting fix for AC_EGREP_CPP.
+ * itcl/win/configure.in: Likewise.
+ * itk/unix/configure.in: Likewise.
+ * itk/win/configure.in: Likewise.
+ * itcl/unix/configure: Regenerate.
+ * itcl/win/configure: Likewise.
+ * itk/unix/configure: Likewise.
+ * itk/win/configure: Likewise.
+
+1999-09-22 DJ Delorie <dj@cygnus.com>
+
+ * itcl/win/Makefile.in (ITCL_LIB_DIR etc): use @dir@ form
+ * itk/win/Makefile.in (INSTALL_LIB_DIR etc): ditto
+
+1999-07-13 Jonathan Larmour <jlarmour@cygnus.co.uk>
+
+ * itcl/unix/configure.in: Workaround bug in autoconf 2.13 by adding
+ an extra AC_PROG_CPP before AC_EGREP_CPP
+ * itcl/win/configure.in: Likewise
+ * itk/unix/configure.in: Likewise
+ * itk/win/configure.in: Likewise
+ * itcl/unix/configure: regenerated
+ * itcl/win/configure: regenerated
+ * itk/unix/configure: regenerated
+ * itk/win/configure: regenerated
+
+1999-06-16 Keith Seitz <keiths@cygnus.com>
+
+ * itk/win/Makefile.in (install-man): Don't install *.3 -- there
+ are no manpages in this section.
+
+1999-03-26 Martin Hunt <hunt@cygnus.com>
+
+ * iwidgets3.0.0/generic/scrolledwidget.itk
+ (iwidgets::Scrolledwidget::sbwidth): The default width of 15
+ was incompatible with Windows. Change the default to "" and
+ only actually change the scrollbar width if someone changes
+ it to something else.
+
+1999-03-22 James Ingham <jingham@cygnus.com>
+
+ * itcl/unix/configure.in: Leave the LD_SEARCH_PATH off of
+ MAKE_LIBS. This loses on OSF with --enable-shared.
+ * itcl/unix/configure: regenerated
+ * itk/unix/configure.in: Leave the LD_SEARCH_PATH off of
+ MAKE_LIBS. This lses on OSF with --enable-shared.
+ * itk/unix/configure: regenerated
+
+1999-03-18 Keith Seitz <keiths@cygnus.com>
+
+ * iwidgets3.0.0/unix/Makefile.in (install-libraries): Don't bother with
+ making symlinks for other versions of iwidgets -- we don't use them.
+
+1999-03-03 James Ingham <jingham@cygnus.com>
+
+ * iwidgets3.0.0/generic/labeledframe.itk (_reconfigure): Make sure
+ that the widget has not been destroyed while in the update
+ idletasks. FIXME - see if we can eliminate the need for this
+ update.
+
+ * iwidgets3.0.0/generic/labeledframe.itk (clientHandlesConfigure):
+ Added method to allow the user of the labeled frame to do the
+ reconfigure, so this can be batched up and reduce flashing.
+
+1999-03-02 DJ Delorie <dj@cygnus.com>
+
+ * itk/win/configure.in: support cross compiling, fix syntax error
+ in BASELIBS.
+ * itk/win/configure: regenerate
+
+1999-03-02 Syd Polk <spolk@cygnus.com>
+
+ * itk/win/configure.in: Generated incorrect library name for cygwin
+ build.
+ * itk/win/configure: Regenerate.
+
+Fri Feb 26 12:48:01 1999 Geoffrey Noer <noer@cygnus.com>
+
+ * configure.in: Change "cygwin32*" check to "cygwin*".
+ * configure: Regenerate.
+ * itcl/win/configure.in: Change "cygwin32*" check to "cygwin*".
+ * itcl/win/configure: Regenerate.
+ * itk/win/configure.in: Change "cygwin32*" check to "cygwin*".
+ * itk/win/configure: Regenerate.
+
+1999-02-24 James Ingham <jingham@cygnus.com>
+
+ * iwidgets3.0.0/generic/labeledframe.itk: Make it derive from Widget
+ not Archetype (which was a BAD idea). Add an interposing frame so
+ you didn't have to much with the highlightthickness of the
+ MegaWidget itself. Doing this allows you to actually use the
+ labeledframe in derived classes.
+ * iwidgets3.0.0/generic/scrolledwidget.itk: Derive from labeledframe,
+ not labeledwidget. This way you can add a relief around the
+ label, which looks better for scrolled text, scrolled listboxes
+ and scrolled canvases.
+ * iwidgets3.0.0/generic scrolledcanvas.itk, scrolledlistbox.itk,
+ scrolledtext.itk: Pushed throught the changes needed to get the
+ derivation from labeledframe to work.
+
+1999-02-22 Syd Polk <spolk@cygnus.com>
+
+ * itcl/win/configure.in: Export ITCL_SH.
+ * itcl/win/configure: Regenerate.
+
+ * itk/win/configure.in: Set all of the build components based on cygwin
+ vs. Visual C++.
+ Fix ITK_BUILD_LIB_SPEC, ITK_LIB_SPEC, ITK_LIB_FULL_PATH.
+ * itk/win/configure: Regenerate.
+
+1999-02-19 Syd Polk <spolk@cygnus.com>
+
+ * itk/win/rc/itk.rc: Fixed problem in .rc file that winres did not
+ like.
+
+1999-02-18 Syd Polk <spolk@cygnus.com>
+
+ * itcl/unix/Makefile.in: "make install" was failing
+ with itclConfig.sh.
+
+ * itcl/win/configure.in: Export ITCL_BUILD_LIB_SPEC and
+ ITCL_LIB_FULL_PATH.
+ * itcl/win/configure: Regnerate.
+ * itcl/win/Makefile.in: Minor corrections to dependencies.
+
+ * itk/generic/itk_cmds.c: Fixed newline in constant.
+
+ * itk/win/configure.in: Added AC_OBJEXT.
+ * itk/win/configure: Regenerated.
+
+ * itk/win/Makefile.in: Added OBJEXT. Overhauled for MSVC
+ build.
+
+1999-02-18 James Ingham <jingham@cygnus.com>
+
+ * itcl/unix/Makefile.in itk/unix/Makefile.in: fix the install
+ target so it points to itclConfig.sh in the itcl or itk, rather
+ than in the itcl/unix or itk/unix directories.
+ * itcl/win/configure.in: use the ITCLCYGRC & ITCLCYGSHRC variables
+ in the name of the windres output file.
+ * itcl.rc: For some reason, windres is choking on STRINGIFY of the
+ Itcl version numbers. Some day we should figure out why. For
+ now, I just put in the version numbers by hand.
+
+1999-02-10 Syd Polk <spolk@cygnus.com>
+
+ * Makefile.in: Propogate make errors from subdirectories
+ back to the top level.
+
+ * itcl/win/configure.in: Moved itclConfig.sh. Fixed problems
+ finding tclConfig.sh and tkConfig.sh.
+ Figure out all of the appropriate directories at this level
+ so that cygwin and msvc differences can be accounted for.
+ * itcl/win/configure: Regenerate.
+ * itcl/win/Makefile.in: Use OBJEXT.
+ Set build directories correctly.
+ Set -DDLL_BUILD, -DSTATIC_BUILD, and -DBUILD_itcl correctly.
+
+ * itk/win/configure.in: Moved itkConfig.sh. Look for itclConfig.sh
+ in new place. Fixed problems finding tclConfig.sh and tkConfig.sh.
+ * itk/win/configure: Regnerate.
+
+ * itcl/generic/itcl_cmds.c (initScript): Fixed broken new line.
+
+ * itcl/win/dllEntryPoint.c: DllMain was not setup correctly for
+ Microsoft.
+
+1999-02-09 James Ingham <jingham@cygnus.com>
+
+ * itcl/itcl/unix/configure.in:
+ * itcl/itk/unix/configure.in:
+ LD_SEARCH_FLAGS should NOT be passed to the library build line.
+
+ * itcl/itcl/unix/configure:
+ * itcl/itk/unix/configure:
+ regenerate.
+
+ * itcl/itk/generic/itk_archetype.c: Put a few CYGNUS LOCAL markers
+ in around the 8.1 Fixups that I had left out.
+
+1992-02-08 Syd Polk <spolk@cygnus.com>
+
+ * itcl/itcl/unix/configure.in: Moved itclConfig.sh.in up a level
+ so that building on Windows will work.
+ Added exporting of itclsh so that other parts of the build
+ tree can call it.
+ Added exporting of TCL_CFLAGS.
+ Added exporting of TCL_LIB_FULL_PATH.
+ Generate and export ITCL_LIB_FULL_PATH.
+ * itcl/itcl/unix/configure: Regenerated
+ * itcl/itcl/unix/Makefile.in: Use TCL_CFLAGS so that
+ -fwritable-strings is enabled.
+ Add dependency for TCL_LIB_FULL_PATH.
+ * itcl/itclConfig.sh.in: Moved from lower directory.
+ * itcl/itk/unix/configure.in: Moved itkConfig.sh.in up a level.
+ Added export of TCL_CFLAGS.
+ Added export of TCL_LIB_FULL_PATH, TK_LIB_FULL_PATH,
+ ITCL_LIB_FULL_PATH, and ITK_LIB_FULL_PATH.
+ * itcl/itk/unix/Makefile.in: Use TCL_CFLAGS so that
+ -fwritable-strings is enabled.
+ Add dependencies for TCL_LIB_FULL_PATH and TK_LIB_FULL_PATH.
+ * itcl/itk/unix/configure: Regenerated.
+ * itcl/itkConfig.sh.in: Moved from a lwoer directory.
+ * itcl/iwidgets3.0.0/configure.in: Look for itclConfig.sh and
+ itkConfig.sh in different places.
+
+1999-02-05 James Ingham <jingham@cygnus.com>
+
+ * itcl/itk/generic/itk_archetype.c (Itk_ArchCompAddCmd):
+ * itcl/itcl/generic/itcl_cmds.c (Itcl_ProtectionCmd):
+ itcl/itcl/generic/itcl_ensemble.c (Itcl_EnsembleCmd):
+ itcl/itcl/generic/itcl_methods.c (Itcl_EvalMemberCode):
+ (Itcl_ConstructBase):
+ itcl/itcl/generic/itcl_obsolete.c (ItclOldClassCmd):
+ itcl/itcl/generic/itcl_parse.c (Itcl_ClassCmd):
+ (Itcl_ClassProtectionCmd):
+ Fix up calls to Tcl_EvalObj for Tcl8.1.
+
+ * itcl/itcl/unix/configure.in:
+ * itcl/itk/unix/configure.in:
+ Pick up CFLAGS from AC_PROG_CC rather than hard coding them.
+ * itcl/itcl/unix/configure:
+ * itcl/itk/unix/configure:
+ regenerate.
+
+1999-01-30 Brendan Kehoe <brendan@cygnus.com>
+
+ * Makefile.in (install-info info install-check): Add these null
+ rules, for the standard build process to work..
+
+1999-01-28 James Ingham <jingham@cygnus.com>
+
+ * itcl/itcl/unix/configure.in: Check the TCL_LIB_VERSIONS_OK
+ variable, and strip out dots if it is nodots.
+ * itcl/itk/unix/configure.in: Check the TCL_LIB_VERSIONS_OK
+ variable, and strip out dots if it is nodots.
+ * itcl/itcl/unix/configure: regenerate.
+ * itcl/itk/unix/configure: regenerate.
+
+1999-01-21 James Ingham <jingham@cygnus.com>
+
+ * itcl/library/init.tcl (auto_import): Comment out this function.
+ It does not work, because it can not populate the source
+ namespace's export list. There is no easy way to fix this, and
+ since it is just an optimization over the original Tcl proc, we
+ will just use Tcl one for now.
+
+1999-01-20 James Ingham <jingham@cygnus.com>
+
+ * itcl/library/init.tcl: updated to Itcl 3.0.1. Does not force
+ the addition of class to the auto_mkindex_parser namespace, but
+ uses the namespace import instead.
+
+1998-12-15 Martin M. Hunt <hunt@cygnus.com>
+
+ * iwidgets3.0.0/generic/panedwindow.itk: Reverted back to original
+ distribution. The new panedwindow widget is now in libgui.
+
+ * iwidgets3.0.0/generic/pane.itk: Reverted.
+
+1998-12-11 Martin M. Hunt <hunt@cygnus.com>
+
+ * iwidgets3.0.0/generic/panedwindow.itk: Major changes to
+ support panes that are fixed (non-resizable). This allows
+ the panedwindow to be used as a more general purpose
+ container widget where individual parts may or may not be
+ resizable.
+
+ * iwidgets3.0.0/generic/pane.itk (iwidgets::Pane): Added
+ -resizable option to support non-resizable panes.
+
+1998-12-08 Martin M. Hunt <hunt@cygnus.com>
+
+ * iwidgets3.0.0/generic/panedwindow.itk: Major changes to
+ the default look and resizing method to be more modern, more
+ windows-like, and work better when widgets are placed in childsites.
+
diff --git a/itcl/INCOMPATIBLE b/itcl/INCOMPATIBLE
new file mode 100644
index 00000000000..b0e2bd15d3a
--- /dev/null
+++ b/itcl/INCOMPATIBLE
@@ -0,0 +1,102 @@
+
+As much as possible, I've tried to make itcl3.0 backward-compatible
+with earlier releases. The class definition syntax has not changed
+at all from itcl2.2, and the old itcl1.x syntax is still supported.
+But you'll notice changes related to namespaces. John Ousterhout
+adopted a slightly different namespace model for Tcl8. The syntax
+of the "namespace" command is different, as well as the semantics
+for command/variable lookups and imports. Also, John Ousterhout
+failed to adopt ensembles into the Tcl core, so itcl can't add
+functions like "info objects" and "info classes" into the usual "info"
+command. These functions have been moved to a new "itcl::find" command.
+
+The [incr Widgets] package has changed quite a bit. There are many
+new widgets, and some of the existing widgets were streamlined--some
+of the widget options were removed to improve performance. For details,
+see the "CHANGES" file in the iwidgets3.0.0 directory. Because there
+are a lot of changes, this distribution contains the iwidgets2.2.0
+package, which is backward-compatible with the existing [incr Widgets].
+
+Following is a quick summary of changes, to serve as a porting guide.
+
+
+----------------------------------|-------------------------------------
+ You have code like this... | change to this...
+----------------------------------|-------------------------------------
+ namespace foo {...} | namespace eval foo {...}
+ |
+ delete namespace foo | namespace delete foo
+ |
+ info which -namespace $name | if {![string match ::* $name]} {
+ | set name [namespace current]::$name
+ | }
+ |
+ info context | namespace current
+ |
+ info objects ... | itcl::find objects ...
+ |
+ info classes ... | itcl::find classes ...
+ |
+ In itcl2.2, commands/classes | In Tcl8.0, all commands/classes that
+ could be found in any namespace | are not in the global namespace must
+ in a hierarchy. So within a | be qualified. For example, the
+ namespace like "iwidgets" you | "iwidgets" namespace has a bunch of
+ could use simple names like: | classes within it. You must always
+ | refer to these classes with qualified
+ | names, like this:
+ |
+ Labeledwidget::alignlabels ... | iwidgets::Labeledwidget::alignlabels ...
+ Pane #auto | iwidgets::Pane #auto
+ |
+ |
+ In itcl2.2, the "global" | In Tcl8.0, the "variable" command is
+ command was used to access | used to access variables in a namespace:
+ variables in a namespace: |
+ |
+ namespace foo { | namespace eval foo {
+ variable x 0 | variable x 0
+ proc example {} { | proc example {} {
+ global x | variable x
+ return $x | return $x
+ } | }
+ } | }
+ |
+ |
+ public itk_component add... | itk_component add ...
+ protected itk_component add... | itk_component add -protected ...
+ private itk_component add... | itk_component add -private ...
+ |
+ |
+
+ OTHER DIFFERENCES
+------------------------------------------------------------------------
+- You can now use instance variables (along with the usual common
+ variables) with the "scope" command. Thus, you're no longer forced
+ to use the trick with a common array like: [scope modes($this)]
+
+- All widget/mega-widget access commands (e.g., ".foo.bar") are
+ installed in the global namespace. Therefore, they can be accessed
+ from any namespace context.
+
+- The [incr Widgets] package used to be loaded by default. You must
+ now use the "package require" command to load it explicitly:
+
+ package require Iwidgets <-- loads the lastest (iwidgets3.0.0)
+ package require -exact Iwidgets 2.2 <-- loads the older release
+
+- Command/variable names are now reported with fully-qualified names
+ in "info" inquiries and in error messages.
+
+- No public/protected/private declarations outside of class definitions
+
+- The "scope" command used to be more or less the same as the "code"
+ command. In itcl3.x, "scope" is only for variables, and if a variable
+ is not recognized, you'll get an error.
+
+- The "code" command used to return a value like "@scope ...". It now
+ returns "namespace inscope ...", to be compatible with Tcl8.
+
+- The prototypes for Itcl_RegisterC and Itcl_FindC have changed. You
+ can now include ClientData when you register C functions. Also, there
+ is a new Itcl_RegisterObjC function for (objc,objv)-style command
+ handlers.
diff --git a/itcl/Makefile.in b/itcl/Makefile.in
new file mode 100644
index 00000000000..7e2c2872c1e
--- /dev/null
+++ b/itcl/Makefile.in
@@ -0,0 +1,94 @@
+#
+# This file is the toplevel Makefile for [incr Tcl]. 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$
+
+# Default top-level directories in which to install architecture-
+# specific files (exec_prefix) and machine-independent files such
+# as scripts (prefix). The values specified here may be overridden
+# at configure-time with the --exec-prefix and --prefix options
+# to the "configure" script.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+
+subdirs = @subdirs@
+
+# Some versions of make, like SGI's, use the following variable to
+# determine which shell to use for executing commands:
+SHELL = /bin/sh
+
+all:
+ @for dir in $(subdirs) ; do \
+ if (echo "Making in $$dir"; cd $$dir && $(MAKE) $@); \
+ then true; else exit 1; fi \
+ done;
+
+test:
+ for dir in $(subdirs) ; do \
+ if (echo "Making in $$dir"; cd $$dir && $(MAKE) $@); \
+ then true; else exit 1; fi \
+ done;
+
+static:
+ for dir in $(subdirs) ; do \
+ if (echo "Making in $$dir"; cd $$dir && $(MAKE) $@); \
+ then true; else exit 1; fi \
+ done;
+
+standalone:
+ for dir in $(subdirs) ; do \
+ if (echo "Making in $$dir"; cd $$dir && $(MAKE) $@); \
+ then true; else exit 1; fi \
+ done;
+
+plusplus:
+ for dir in $(subdirs) ; do \
+ if (echo "Making in $$dir"; cd $$dir && $(MAKE) $@); \
+ then true; else exit 1; fi \
+ done;
+
+install:
+ for dir in $(subdirs) ; do \
+ if (echo "Making in $$dir"; cd $$dir && $(MAKE) $@); \
+ then true; else exit 1; fi \
+ done;
+
+install-binaries:
+ for dir in $(subdirs) ; do \
+ if (echo "Making in $$dir"; cd $$dir && $(MAKE) $@); \
+ then true; else exit 1; fi \
+ done;
+
+install-libraries:
+ for dir in $(subdirs) ; do \
+ if (echo "Making in $$dir"; cd $$dir && $(MAKE) $@); \
+ then true; else exit 1; fi \
+ done;
+
+install-info info install-check:
+
+clean:
+ for dir in $(subdirs) ; do \
+ if (echo "Making in $$dir"; cd $$dir && $(MAKE) $@); \
+ then true; else exit 1; fi \
+ done;
+
+distclean:
+ rm -f Makefile config.log config.status config.cache
+ for dir in $(subdirs) ; do \
+ if (echo "Making in $$dir"; cd $$dir && $(MAKE) $@); \
+ then true; else exit 1; fi \
+ done;
+
+#
+# Target to create a proper Tcl distribution from information in the
+# master source directory. DISTDIR must be defined to indicate where
+# to put the distribution.
+#
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
diff --git a/itcl/TODO b/itcl/TODO
new file mode 100644
index 00000000000..8fc11e22b74
--- /dev/null
+++ b/itcl/TODO
@@ -0,0 +1,181 @@
+=======================================================================
+ Following is a list of notes describing things which might be
+ fixed or changed in a future release of [incr Tcl]
+=======================================================================
+
+Handle this case more elegantly:
+
+class Foo {
+ constructor {args} {
+ _init
+ }
+ proc _init {} {
+ puts "once!"
+ proc _init {} {}
+ }
+}
+Foo #auto
+Foo #auto
+
+
+itcl "wish" list
+------------------------------------------------------------------
+- add virtual inheritance
+- add "border" type to canvas widget
+- add "validate" and "valid" commands for type validation
+- add "unknownvar" and provide access to object data members: "obj.var"
+- check namespace [info class] {...} as a replacement for "virtual"
+- fix "auto_load_all" problem in Tcl-DP
+ (Their implementation uses "info commands" to verify that a command
+ has been successfully autoloaded, but absolute command names like
+ "::iwidgets::fileselectiondialog" don't show up.)
+- fix "auto_load" mechanism to be extensible like "unknown"
+- fix Itcl_RegisterC() to support ClientData
+- core dump with "cmdtrace" (tclX thing?)
+
+- ideas from Nelson Macy:
+ - add "delegate" keyword for inheritance via composition?
+ - add "forward" keyword for implementing error handlers
+ - add "get" code to public variables for "cget" access
+
+- equivalent of constructor/destructor for classes
+- protected/private recognized for constructor/destructor
+- add something like Tk_CreateWidgetCommand() for widget developers
+
+
+itcl documentation cleanup
+------------------------------------------------------------------
+- add "Finance: Trading Systems" to commercial uses of Itcl (Deshaw)
+- update doc: "config" code also gets invoked on startup for itk widgets
+- update doc: add to FAQ: class with common array interacts with Tk widget
+
+itcl "to do" list
+------------------------------------------------------------------
+
+- write "auto_load_all" proc for Tcl-DP
+
+- bad errorInfo:
+ > More specifically, the constructor for the class did the following:
+ >
+ > set hull [info namespace tail $this]
+ > ::frame $hull
+ >
+ > One of the class variables had a configuration script:
+ >
+ > public variable textvariable "" {
+ > if { $textvariable != "" } {
+ > regsub "\\(.*\\)" $textvariable "" global
+ > global ::$global
+ > trace variable $textvariable w "$hull adjust"
+ > }
+ > }
+
+- add "@body" in as many places as possible to support Tcl compiler
+
+- check out itcl with Tix:
+ lappend auto_path $env(TIX_LIBRARY)
+ source "$env(IWIDGETS_LIBRARY)/init.iwidgets"
+
+ iwidgets::Dialog ._Arcattributes -title "Code: Arc Annotations"
+ -modality application
+
+ set attrframe [._Arcattributes childsite]
+
+ tixScrolledHList $attrframe.ports
+ [$attrframe.ports subwidget hlist] configure -selectmode browse
+
+ pack $attrframe.ports -expand yes -fill both -padx 10 -pady 10
+
+ ._Arcattributes activate
+
+
+------------------------------------------------------------------
+
+To: ig4!att!cas.org!lvirden (Larry W. Virden) (lvirden@cas.org)
+cc: michael.mclennan@att.com
+Subject: Re: Question concerning the Japanese patches for Tcl 7.4
+In-reply-to: Your message of "Fri, 05 Jan 1996 06:43:46 EST."
+ <9601051143.AA15368@cas.org>
+--------
+Your message dated: Fri, 05 Jan 1996 06:43:46 EST
+>
+> The following instructions refer to the software which enables one to
+> build a KANJI supporting version of Tcl/Tk. Perhaps a note in the itcl
+> instructions letting folk know this package is also compatible would be
+> useful.
+>
+>
+> ----- Begin Included Message -----
+>
+> >From nisinaka@sra.co.jp Thu Jan 4 00:09:52 1996
+> Received: from srv07s4m by srv99dr.cas.org (5.65/CAS-1.23)
+> id AA29886; Thu, 4 Jan 1996 00:09:52 -0500
+> Received: from srv01s4.cas.org by srv07s4m.cas.org (5.0/CAS-1.23)
+> id AA11865; Thu, 4 Jan 1996 00:09:50 +0500
+> Received: from sraigw.sra.co.jp by srv01s4.cas.org (4.1/CAS-1.23)
+> id AA25691; Thu, 4 Jan 96 00:09:39 EST
+> Received: from sranhe.sra.co.jp by sraigw.sra.co.jp
+> (8.6.12+2.4W3/3.4W-2.1)
+> id OAA06131; Thu, 4 Jan 1996 14:09:32 +0900
+> Received: from srashc.sra.co.jp (srashc [133.137.44.5]) by
+> sranhe.sra.co.jp (8.6.12+2.4W3/3.4W-srambox) with ESMTP id OAA00935;
+> Thu, 4 Jan 1996 14:06:26 +0900
+> Received: from srashc.sra.co.jp (localhost [127.0.0.1]) by
+> srashc.sra.co.jp (8.6.12+2.4W3/3.4W-sra) with ESMTP id OAA25546; Thu, 4
+> Jan 1996 14:09:30 +0900
+> To: lvirden (Larry W. Virden, x2487)
+> Cc: tcl-jp-bugs@sra.co.jp
+> Reply-To: nisinaka@sra.co.jp
+> Subject: Re: Question concerning the Japanese patches for Tcl 7.4
+> In-Reply-To: Your message of Tue, 02 Jan 1996 10:32:32 EST.
+> <9601021032.AA2226@cas.org>
+> Date: Thu, 04 Jan 1996 14:09:29 +0900
+> Message-Id: <25544.820732169@srashc.sra.co.jp>
+> From: NISHINAKA Yoshiyuki <nisinaka@sra.co.jp>
+> Status: RO
+> X-Lines: 31
+>
+> > I notice that incr tcl 2.0 has been released with it's own,
+> customized,
+> > version of Tcl 7.4/Tk 4.0. Do any of you use itcl? If so, I
+> wondered if you
+> > had thought of constructing a specialized set of patches which could
+> be
+> > used with itcl.
+>
+> I have just got itcl2.0 and tried it with our Japanization
+> patches. Seems it works fine.
+>
+> What I really did was as follows:
+>
+> (1) Unpack itcl2.0.tar.gz.
+>
+> (2) Run `configure' at the directory `itcl2.0'.
+>
+> (3) Apply `tcl7.4p3jp-patch' at the directory `itcl2.0/tcl7.4'.
+> `Makefile.in.rej' was the only rejected file, so apply it
+> manually.
+>
+> (4) Apply `tk4.0p3jp-patch' at the directory `itcl2.0/tk4.0'.
+> There was no rejected file.
+>
+> (5) Make symbolic link from `tcl7.4' to `tcl7.4jp'.
+>
+> (6) Make all.
+>
+>
+> I haven't seriously tested yet though, `make test' was passed
+> and the Japanese translation of `demos/widgets' works fine.
+>
+>
+> Yosh Nishinaka (nisinaka@sra.co.jp)
+>
+>
+> ----- End Included Message -----
+>
+>
+> --
+> :s Larry W. Virden INET: lvirden@cas.org
+> :s <URL:http://www.teraform.com/%7Elvirden/> <*>
+> :s Unless explicitly stated to the contrary, nothing in this posting should
+> :s be construed as representing my employer's opinions.
diff --git a/itcl/aclocal.m4 b/itcl/aclocal.m4
new file mode 100644
index 00000000000..75024565f73
--- /dev/null
+++ b/itcl/aclocal.m4
@@ -0,0 +1,524 @@
+dnl written by Rob Savoye <rob@cygnus.com> for Cygnus Support
+dnl major rewriting for Tcl 7.5 by Don Libes <libes@nist.gov>
+
+dnl CY_AC_PATH_TCLCONFIG and CY_AC_LOAD_TCLCONFIG should be invoked
+dnl (in that order) before any other TCL macros. Similarly for TK.
+
+dnl CYGNUS LOCAL: This gets the right posix flag for gcc
+AC_DEFUN(CY_AC_TCL_LYNX_POSIX,
+[AC_REQUIRE([AC_PROG_CC])AC_REQUIRE([AC_PROG_CPP])
+AC_MSG_CHECKING([if running LynxOS])
+AC_CACHE_VAL(ac_cv_os_lynx,
+[AC_EGREP_CPP(yes,
+[/*
+ * The old Lynx "cc" only defines "Lynx", but the newer one uses "__Lynx__"
+ */
+#if defined(__Lynx__) || defined(Lynx)
+yes
+#endif
+], ac_cv_os_lynx=yes, ac_cv_os_lynx=no)])
+#
+if test "$ac_cv_os_lynx" = "yes" ; then
+ AC_MSG_RESULT(yes)
+ AC_DEFINE(LYNX)
+ AC_MSG_CHECKING([whether -mposix or -X is available])
+ AC_CACHE_VAL(ac_cv_c_posix_flag,
+ [AC_TRY_COMPILE(,[
+ /*
+ * This flag varies depending on how old the compiler is.
+ * -X is for the old "cc" and "gcc" (based on 1.42).
+ * -mposix is for the new gcc (at least 2.5.8).
+ */
+ #if defined(__GNUC__) && __GNUC__ >= 2
+ choke me
+ #endif
+ ], ac_cv_c_posix_flag=" -mposix", ac_cv_c_posix_flag=" -X")])
+ CC="$CC $ac_cv_c_posix_flag"
+ AC_MSG_RESULT($ac_cv_c_posix_flag)
+ else
+ AC_MSG_RESULT(no)
+fi
+])
+
+#
+# Sometimes the native compiler is a bogus stub for gcc or /usr/ucb/cc. This
+# makes configure think it's cross compiling. If --target wasn't used, then
+# we can't configure, so something is wrong. We don't use the cache
+# here cause if somebody fixes their compiler install, we want this to work.
+AC_DEFUN(CY_AC_C_WORKS,
+[# If we cannot compile and link a trivial program, we can't expect anything to work
+AC_MSG_CHECKING(whether the compiler ($CC) actually works)
+AC_TRY_COMPILE(, [/* don't need anything here */],
+ c_compiles=yes, c_compiles=no)
+
+AC_TRY_LINK(, [/* don't need anything here */],
+ c_links=yes, c_links=no)
+
+if test x"${c_compiles}" = x"no" ; then
+ AC_MSG_ERROR(the native compiler is broken and won't compile.)
+fi
+
+if test x"${c_links}" = x"no" ; then
+ AC_MSG_ERROR(the native compiler is broken and won't link.)
+fi
+AC_MSG_RESULT(yes)
+])
+
+AC_DEFUN(CY_AC_PATH_TCLH, [
+#
+# Ok, lets find the tcl source trees so we can use the headers
+# Warning: transition of version 9 to 10 will break this algorithm
+# because 10 sorts before 9. We also look for just tcl. We have to
+# be careful that we don't match stuff like tclX by accident.
+# the alternative search directory is involked by --with-tclinclude
+#
+no_tcl=true
+AC_MSG_CHECKING(for Tcl private headers)
+AC_ARG_WITH(tclinclude, [ --with-tclinclude directory where tcl private headers are], with_tclinclude=${withval})
+AC_CACHE_VAL(ac_cv_c_tclh,[
+# first check to see if --with-tclinclude was specified
+if test x"${with_tclinclude}" != x ; then
+ if test -f ${with_tclinclude}/tclInt.h ; then
+ ac_cv_c_tclh=`(cd ${with_tclinclude}; pwd)`
+ elif test -f ${with_tclinclude}/generic/tclInt.h ; then
+ ac_cv_c_tclh=`(cd ${with_tclinclude}/generic; pwd)`
+ else
+ AC_MSG_ERROR([${with_tclinclude} directory doesn't contain private headers])
+ fi
+fi
+
+# next check if it came with Tcl configuration file
+if test x"${ac_cv_c_tclconfig}" != x ; then
+ if test -f $ac_cv_c_tclconfig/../generic/tclInt.h ; then
+ ac_cv_c_tclh=`(cd $ac_cv_c_tclconfig/../generic; pwd)`
+ fi
+fi
+
+# next check in private source directory
+#
+# since ls returns lowest version numbers first, reverse its output
+if test x"${ac_cv_c_tclh}" = x ; then
+ for i in \
+ ${srcdir}/../tcl \
+ `ls -dr ${srcdir}/../tcl[[7-9]]* 2>/dev/null` \
+ ${srcdir}/../../tcl \
+ `ls -dr ${srcdir}/../../tcl[[7-9]]* 2>/dev/null` \
+ ${srcdir}/../../../tcl \
+ `ls -dr ${srcdir}/../../../tcl[[7-9]]* 2>/dev/null ` ; do
+ if test -f $i/generic/tclInt.h ; then
+ ac_cv_c_tclh=`(cd $i/generic; pwd)`
+ break
+ fi
+ done
+fi
+# finally check in a few common install locations
+#
+# since ls returns lowest version numbers first, reverse its output
+if test x"${ac_cv_c_tclh}" = x ; then
+ for i in \
+ `ls -dr /usr/local/src/tcl[[7-9]]* 2>/dev/null` \
+ `ls -dr /usr/local/lib/tcl[[7-9]]* 2>/dev/null` \
+ /usr/local/src/tcl \
+ /usr/local/lib/tcl \
+ ${prefix}/include ; do
+ if test -f $i/generic/tclInt.h ; then
+ ac_cv_c_tclh=`(cd $i/generic; pwd)`
+ break
+ fi
+ done
+fi
+# see if one is installed
+if test x"${ac_cv_c_tclh}" = x ; then
+ AC_HEADER_CHECK(tclInt.h, ac_cv_c_tclh=installed, ac_cv_c_tclh="")
+fi
+])
+if test x"${ac_cv_c_tclh}" = x ; then
+ TCLHDIR="# no Tcl private headers found"
+ AC_MSG_ERROR([Can't find Tcl private headers])
+fi
+if test x"${ac_cv_c_tclh}" != x ; then
+ no_tcl=""
+ if test x"${ac_cv_c_tclh}" = x"installed" ; then
+ AC_MSG_RESULT([is installed])
+ TCLHDIR=""
+ else
+ AC_MSG_RESULT([found in ${ac_cv_c_tclh}])
+ # this hack is cause the TCLHDIR won't print if there is a "-I" in it.
+ TCLHDIR="-I${ac_cv_c_tclh}"
+ fi
+fi
+
+AC_SUBST(TCLHDIR)
+])
+
+
+AC_DEFUN(CY_AC_PATH_TCLCONFIG, [
+#
+# Ok, lets find the tcl configuration
+# First, look for one uninstalled.
+# the alternative search directory is invoked by --with-tclconfig
+#
+
+if test x"${no_tcl}" = x ; then
+ # we reset no_tcl in case something fails here
+ no_tcl=true
+ AC_ARG_WITH(tclconfig, [ --with-tclconfig directory containing tcl configuration (tclConfig.sh)],
+ with_tclconfig=${withval})
+ AC_MSG_CHECKING([for Tcl configuration])
+ AC_CACHE_VAL(ac_cv_c_tclconfig,[
+
+ # First check to see if --with-tclconfig was specified.
+ if test x"${with_tclconfig}" != x ; then
+ if test -f "${with_tclconfig}/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd ${with_tclconfig}; pwd)`
+ else
+ AC_MSG_ERROR([${with_tclconfig} directory doesn't contain tclConfig.sh])
+ fi
+ fi
+
+ # then check for a private Tcl installation
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in \
+ ../tcl \
+ `ls -dr ../tcl[[7-9]]* 2>/dev/null` \
+ ../../tcl \
+ `ls -dr ../../tcl[[7-9]]* 2>/dev/null` \
+ ../../../tcl \
+ `ls -dr ../../../tcl[[7-9]]* 2>/dev/null` ; do
+ if test -f "$i/unix/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd $i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+ # check in a few common install locations
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in `ls -d ${prefix}/lib /usr/local/lib 2>/dev/null` ; do
+ if test -f "$i/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd $i; pwd)`
+ break
+ fi
+ done
+ fi
+ # check in a few other private locations
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in \
+ ${srcdir}/../tcl \
+ `ls -dr ${srcdir}/../tcl[[7-9]]* 2>/dev/null` ; do
+ if test -f "$i/unix/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd $i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+ ])
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ TCLCONFIG="# no Tcl configs found"
+ AC_MSG_WARN(Can't find Tcl configuration definitions)
+ else
+ no_tcl=
+ TCLCONFIG=${ac_cv_c_tclconfig}/tclConfig.sh
+ AC_MSG_RESULT(found $TCLCONFIG)
+ fi
+fi
+])
+
+# Defined as a separate macro so we don't have to cache the values
+# from PATH_TCLCONFIG (because this can also be cached).
+AC_DEFUN(CY_AC_LOAD_TCLCONFIG, [
+ . $TCLCONFIG
+
+dnl AC_SUBST(TCL_VERSION)
+dnl AC_SUBST(TCL_MAJOR_VERSION)
+dnl AC_SUBST(TCL_MINOR_VERSION)
+dnl AC_SUBST(TCL_CC)
+ AC_SUBST(TCL_DEFS)
+
+dnl not used, don't export to save symbols
+dnl AC_SUBST(TCL_LIB_FILE)
+
+ AC_SUBST(TCL_LIBS)
+dnl not used, don't export to save symbols
+dnl AC_SUBST(TCL_PREFIX)
+
+dnl not used, don't export to save symbols
+dnl AC_SUBST(TCL_EXEC_PREFIX)
+
+ AC_SUBST(TCL_SHLIB_CFLAGS)
+ AC_SUBST(TCL_SHLIB_LD)
+dnl don't export, not used outside of configure
+dnl AC_SUBST(TCL_SHLIB_LD_LIBS)
+dnl AC_SUBST(TCL_SHLIB_SUFFIX)
+dnl not used, don't export to save symbols
+dnl AC_SUBST(TCL_DL_LIBS)
+ AC_SUBST(TCL_LD_FLAGS)
+dnl don't export, not used outside of configure
+ AC_SUBST(TCL_LD_SEARCH_FLAGS)
+dnl AC_SUBST(TCL_COMPAT_OBJS)
+ AC_SUBST(TCL_RANLIB)
+ AC_SUBST(TCL_BUILD_LIB_SPEC)
+ AC_SUBST(TCL_LIB_SPEC)
+dnl AC_SUBST(TCL_LIB_VERSIONS_OK)
+
+dnl not used, don't export to save symbols
+dnl AC_SUBST(TCL_SHARED_LIB_SUFFIX)
+
+dnl not used, don't export to save symbols
+dnl AC_SUBST(TCL_UNSHARED_LIB_SUFFIX)
+])
+
+# Warning: Tk definitions are very similar to Tcl definitions but
+# are not precisely the same. There are a couple of differences,
+# so don't do changes to Tcl thinking you can cut and paste it do
+# the Tk differences and later simply substitute "Tk" for "Tcl".
+# Known differences:
+# - Acceptable Tcl major version #s is 7-9 while Tk is 4-9
+# - Searching for Tcl includes looking for tclInt.h, Tk looks for tk.h
+# - Computing major/minor versions is different because Tk depends on
+# headers to Tcl, Tk, and X.
+# - Symbols in tkConfig.sh are different than tclConfig.sh
+# - Acceptable for Tk to be missing but not Tcl.
+
+AC_DEFUN(CY_AC_PATH_TKH, [
+#
+# Ok, lets find the tk source trees so we can use the headers
+# If the directory (presumably symlink) named "tk" exists, use that one
+# in preference to any others. Same logic is used when choosing library
+# and again with Tcl. The search order is the best place to look first, then in
+# decreasing significance. The loop breaks if the trigger file is found.
+# Note the gross little conversion here of srcdir by cd'ing to the found
+# directory. This converts the path from a relative to an absolute, so
+# recursive cache variables for the path will work right. We check all
+# the possible paths in one loop rather than many seperate loops to speed
+# things up.
+# the alternative search directory is involked by --with-tkinclude
+#
+#no_tk=true
+AC_MSG_CHECKING(for Tk private headers)
+AC_ARG_WITH(tkinclude, [ --with-tkinclude directory where tk private headers are], with_tkinclude=${withval})
+AC_CACHE_VAL(ac_cv_c_tkh,[
+# first check to see if --with-tkinclude was specified
+if test x"${with_tkinclude}" != x ; then
+ if test -f ${with_tkinclude}/tk.h ; then
+ ac_cv_c_tkh=`(cd ${with_tkinclude}; pwd)`
+ elif test -f ${with_tkinclude}/generic/tk.h ; then
+ ac_cv_c_tkh=`(cd ${with_tkinclude}/generic; pwd)`
+ else
+ AC_MSG_ERROR([${with_tkinclude} directory doesn't contain private headers])
+ fi
+fi
+
+# next check if it came with Tk configuration file
+if test x"${ac_cv_c_tkconfig}" != x ; then
+ if test -f $ac_cv_c_tkconfig/../generic/tk.h ; then
+ ac_cv_c_tkh=`(cd $ac_cv_c_tkconfig/../generic; pwd)`
+ fi
+fi
+
+# next check in private source directory
+#
+# since ls returns lowest version numbers first, reverse its output
+if test x"${ac_cv_c_tkh}" = x ; then
+ for i in \
+ ${srcdir}/../tk \
+ `ls -dr ${srcdir}/../tk[[4-9]]* 2>/dev/null` \
+ ${srcdir}/../../tk \
+ `ls -dr ${srcdir}/../../tk[[4-9]]* 2>/dev/null` \
+ ${srcdir}/../../../tk \
+ `ls -dr ${srcdir}/../../../tk[[4-9]]* 2>/dev/null ` ; do
+ if test -f $i/generic/tk.h ; then
+ if test x"${TK_BUILD_INCLUDES}" != x; then
+ ac_cv_c_tkh=`echo "${TK_BUILD_INCLUDES}" | sed -e 's/^-I//'`
+ else
+ ac_cv_c_tkh=`(cd $i/generic; pwd)`
+ fi
+ break
+ fi
+ done
+fi
+# finally check in a few common install locations
+#
+# since ls returns lowest version numbers first, reverse its output
+if test x"${ac_cv_c_tkh}" = x ; then
+ for i in \
+ `ls -dr /usr/local/src/tk[[4-9]]* 2>/dev/null` \
+ `ls -dr /usr/local/lib/tk[[4-9]]* 2>/dev/null` \
+ /usr/local/src/tk \
+ /usr/local/lib/tk \
+ ${prefix}/include ; do
+ if test -f $i/generic/tk.h ; then
+ ac_cv_c_tkh=`(cd $i/generic; pwd)`
+ break
+ fi
+ done
+fi
+# see if one is installed
+if test x"${ac_cv_c_tkh}" = x ; then
+ AC_HEADER_CHECK(tk.h, ac_cv_c_tkh=installed, ac_cv_c_tkh="")
+fi
+])
+if test x"${ac_cv_c_tkh}" != x ; then
+# no_tk=""
+ if test x"${ac_cv_c_tkh}" = x"installed" ; then
+ AC_MSG_RESULT([is installed])
+ TKHDIR=""
+ else
+ AC_MSG_RESULT([found in ${ac_cv_c_tkh}])
+ # this hack is cause the TKHDIR won't print if there is a "-I" in it.
+ TKHDIR="-I${ac_cv_c_tkh}"
+ fi
+else
+ TKHDIR="# no Tk directory found"
+ AC_MSG_WARN([Can't find Tk private headers])
+ no_tk=true
+fi
+
+AC_SUBST(TKHDIR)
+])
+
+
+AC_DEFUN(CY_AC_PATH_TKCONFIG, [
+#
+# Ok, lets find the tk configuration
+# First, look for one uninstalled.
+# the alternative search directory is invoked by --with-tkconfig
+#
+
+if test x"${no_tk}" = x ; then
+ # we reset no_tk in case something fails here
+ no_tk=true
+ AC_ARG_WITH(tkconfig, [ --with-tkconfig directory containing tk configuration (tkConfig.sh)],
+ with_tkconfig=${withval})
+ AC_MSG_CHECKING([for Tk configuration])
+ AC_CACHE_VAL(ac_cv_c_tkconfig,[
+
+ # First check to see if --with-tkconfig was specified.
+ if test x"${with_tkconfig}" != x ; then
+ if test -f "${with_tkconfig}/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd ${with_tkconfig}; pwd)`
+ else
+ AC_MSG_ERROR([${with_tkconfig} directory doesn't contain tkConfig.sh])
+ fi
+ fi
+
+ # then check for a private Tk library
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ for i in \
+ ../tk \
+ `ls -dr ../tk[[4-9]]* 2>/dev/null` \
+ ../../tk \
+ `ls -dr ../../tk[[4-9]]* 2>/dev/null` \
+ ../../../tk \
+ `ls -dr ../../../tk[[4-9]]* 2>/dev/null` ; do
+ if test -f "$i/unix/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd $i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+ # check in a few common install locations
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ for i in `ls -d ${prefix}/lib /usr/local/lib 2>/dev/null` ; do
+ if test -f "$i/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd $i; pwd)`
+ break
+ fi
+ done
+ fi
+ # check in a few other private locations
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ for i in \
+ ${srcdir}/../tk \
+ `ls -dr ${srcdir}/../tk[[4-9]]* 2>/dev/null` ; do
+ if test -f "$i/unix/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd $i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+ ])
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ TKCONFIG="# no Tk configs found"
+ AC_MSG_WARN(Can't find Tk configuration definitions)
+ else
+ no_tk=
+ TKCONFIG=${ac_cv_c_tkconfig}/tkConfig.sh
+ AC_MSG_RESULT(found $TKCONFIG)
+ fi
+fi
+
+])
+
+# Defined as a separate macro so we don't have to cache the values
+# from PATH_TKCONFIG (because this can also be cached).
+AC_DEFUN(CY_AC_LOAD_TKCONFIG, [
+ if test -f "$TKCONFIG" ; then
+ . $TKCONFIG
+ fi
+
+ AC_SUBST(TK_VERSION)
+dnl not actually used, don't export to save symbols
+dnl AC_SUBST(TK_MAJOR_VERSION)
+dnl AC_SUBST(TK_MINOR_VERSION)
+ AC_SUBST(TK_DEFS)
+
+dnl not used, don't export to save symbols
+ dnl AC_SUBST(TK_LIB_FILE)
+
+dnl not used outside of configure
+dnl AC_SUBST(TK_LIBS)
+dnl not used, don't export to save symbols
+dnl AC_SUBST(TK_PREFIX)
+
+dnl not used, don't export to save symbols
+dnl AC_SUBST(TK_EXEC_PREFIX)
+
+ AC_SUBST(TK_XINCLUDES)
+ AC_SUBST(TK_XLIBSW)
+ AC_SUBST(TK_BUILD_LIB_SPEC)
+ AC_SUBST(TK_LIB_SPEC)
+])
+
+# Check to see if we're running under Win32, without using
+# AC_CANONICAL_*. If so, set output variable EXEEXT to ".exe".
+# Otherwise set it to "".
+
+dnl AM_EXEEXT()
+dnl This knows we add .exe if we're building in the Cygwin32
+dnl environment. But if we're not, then it compiles a test program
+dnl to see if there is a suffix for executables.
+AC_DEFUN(AM_EXEEXT,
+[AC_REQUIRE([AM_CYGWIN32])
+AC_MSG_CHECKING([for executable suffix])
+AC_CACHE_VAL(am_cv_exeext,
+[if test "$CYGWIN32" = yes; then
+am_cv_exeext=.exe
+else
+cat > am_c_test.c << 'EOF'
+int main() {
+/* Nothing needed here */
+}
+EOF
+${CC-cc} -o am_c_test $CFLAGS $CPPFLAGS $LDFLAGS am_c_test.c $LIBS 1>&5
+am_cv_exeext=`echo am_c_test.* | grep -v am_c_test.c | sed -e s/am_c_test//`
+rm -f am_c_test*])
+test x"${am_cv_exeext}" = x && am_cv_exeext=no
+fi
+EXEEXT=""
+test x"${am_cv_exeext}" != xno && EXEEXT=${am_cv_exeext}
+AC_MSG_RESULT(${am_cv_exeext})
+AC_SUBST(EXEEXT)])
+
+# Check to see if we're running under Cygwin32, without using
+# AC_CANONICAL_*. If so, set output variable CYGWIN32 to "yes".
+# Otherwise set it to "no".
+
+dnl AM_CYGWIN32()
+AC_DEFUN(AM_CYGWIN32,
+[AC_CACHE_CHECK(for Cygwin32 environment, am_cv_cygwin32,
+[AC_TRY_COMPILE(,[int main () { return __CYGWIN32__; }],
+am_cv_cygwin32=yes, am_cv_cygwin32=no)
+rm -f conftest*])
+CYGWIN32=
+test "$am_cv_cygwin32" = yes && CYGWIN32=yes])
+
diff --git a/itcl/config/config.guess b/itcl/config/config.guess
new file mode 100755
index 00000000000..62186fd1660
--- /dev/null
+++ b/itcl/config/config.guess
@@ -0,0 +1,483 @@
+#!/bin/sh
+# Attempt to guess a canonical system name.
+# Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
+#
+# This file is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+#
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# Written by Per Bothner <bothner@cygnus.com>.
+# The master version of this file is at the FSF in /home/gd/gnu/lib.
+#
+# This script attempts to guess a canonical system name similar to
+# config.sub. If it succeeds, it prints the system name on stdout, and
+# exits with 0. Otherwise, it exits with 1.
+#
+# The plan is that this can be called by configure scripts if you
+# don't specify an explicit system type (host/target name).
+#
+# Only a few systems have been added to this list; please add others
+# (but try to keep the structure clean).
+#
+
+# This is needed to find uname on a Pyramid OSx when run in the BSD universe.
+# (ghazi@noc.rutgers.edu 8/24/94.)
+if (test -f /.attbin/uname) >/dev/null 2>&1 ; then
+ PATH=$PATH:/.attbin ; export PATH
+fi
+
+UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown
+UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown
+UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown
+UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown
+
+trap 'rm -f dummy.c dummy.o dummy; exit 1' 1 2 15
+
+# Note: order is significant - the case branches are not exclusive.
+
+case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in
+ alpha:OSF1:V*:*)
+ # After 1.2, OSF1 uses "V1.3" for uname -r.
+ echo alpha-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^V//'`
+ exit 0 ;;
+ alpha:OSF1:*:*)
+ # 1.2 uses "1.2" for uname -r.
+ echo alpha-dec-osf${UNAME_RELEASE}
+ exit 0 ;;
+ arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*)
+ echo arm-acorn-riscix${UNAME_RELEASE}
+ exit 0;;
+ Pyramid*:OSx*:*:*)
+ if test "`(/bin/universe) 2>/dev/null`" = att ; then
+ echo pyramid-pyramid-sysv3
+ else
+ echo pyramid-pyramid-bsd
+ fi
+ exit 0 ;;
+ i86pc:SunOS:5.*:*)
+ echo i486-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit 0 ;;
+ sun4*:SunOS:5.*:*)
+ echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit 0 ;;
+ sun4*:SunOS:6*:*)
+ # According to config.sub, this is the proper way to canonicalize
+ # SunOS6. Hard to guess exactly what SunOS6 will be like, but
+ # it's likely to be more like Solaris than SunOS4.
+ echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'`
+ exit 0 ;;
+ sun4*:SunOS:*:*)
+ # Japanese Language versions have a version number like `4.1.3-JL'.
+ echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`
+ exit 0 ;;
+ sun3*:SunOS:*:*)
+ echo m68k-sun-sunos${UNAME_RELEASE}
+ exit 0 ;;
+ tp_s2*:SunOS:*:*)
+ # Tadpole Sparcbook 2 running a modified 4.1.3
+ echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'`
+ exit 0 ;;
+ RISC*:ULTRIX:*:*)
+ echo mips-dec-ultrix${UNAME_RELEASE}
+ exit 0 ;;
+ VAX*:ULTRIX*:*:*)
+ echo vax-dec-ultrix${UNAME_RELEASE}
+ exit 0 ;;
+ mips:*:5*:RISCos)
+ echo mips-mips-riscos${UNAME_RELEASE}
+ exit 0 ;;
+ m88k:CX/UX:7*:*)
+ echo m88k-harris-cxux7
+ exit 0 ;;
+ m88k:*:4*:R4*)
+ echo m88k-motorola-sysv4
+ exit 0 ;;
+ m88k:*:3*:R3*)
+ echo m88k-motorola-sysv3
+ exit 0 ;;
+ AViiON:dgux:*:*)
+ if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx \
+ -o ${TARGET_BINARY_INTERFACE}x = x ] ; then
+ echo m88k-dg-dgux${UNAME_RELEASE}
+ else
+ echo m88k-dg-dguxbcs${UNAME_RELEASE}
+ fi
+ exit 0 ;;
+ M88*:DolphinOS:*:*) # DolphinOS (SVR3)
+ echo m88k-dolphin-sysv3
+ exit 0 ;;
+ M88*:*:R3*:*)
+ # Delta 88k system running SVR3
+ echo m88k-motorola-sysv3
+ exit 0 ;;
+ XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3)
+ echo m88k-tektronix-sysv3
+ exit 0 ;;
+ Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD)
+ echo m68k-tektronix-bsd
+ exit 0 ;;
+ *:IRIX:*:*)
+ echo mips-sgi-irix${UNAME_RELEASE}
+ exit 0 ;;
+ i[34]86:AIX:*:*)
+ echo i386-ibm-aix
+ exit 0 ;;
+ *:AIX:2:3)
+ if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then
+ sed 's/^ //' << EOF >dummy.c
+ #include <sys/systemcfg.h>
+
+ main()
+ {
+ if (!__power_pc())
+ exit(1);
+ puts("powerpc-ibm-aix3.2.5");
+ exit(0);
+ }
+EOF
+ ${CC-cc} dummy.c -o dummy && ./dummy && rm dummy.c dummy && exit 0
+ rm -f dummy.c dummy
+ echo rs6000-ibm-aix3.2.5
+ elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then
+ echo rs6000-ibm-aix3.2.4
+ else
+ echo rs6000-ibm-aix3.2
+ fi
+ exit 0 ;;
+ *:AIX:*:4)
+ if /usr/sbin/lsattr -EHl proc0 | grep POWER >/dev/null 2>&1; then
+ IBM_ARCH=rs6000
+ else
+ IBM_ARCH=powerpc
+ fi
+ if grep bos410 /usr/include/stdio.h >/dev/null 2>&1; then
+ IBM_REV=4.1
+ elif grep bos411 /usr/include/stdio.h >/dev/null 2>&1; then
+ IBM_REV=4.1.1
+ else
+ IBM_REV=4.${UNAME_RELEASE}
+ fi
+ echo ${IBM_ARCH}-ibm-aix${IBM_REV}
+ exit 0 ;;
+ *:AIX:*:*)
+ echo rs6000-ibm-aix
+ exit 0 ;;
+ *:BOSX:*:*)
+ echo rs6000-bull-bosx
+ exit 0 ;;
+ DPX/2?00:B.O.S.:*:*)
+ echo m68k-bull-sysv3
+ exit 0 ;;
+ 9000/[34]??:4.3bsd:1.*:*)
+ echo m68k-hp-bsd
+ exit 0 ;;
+ hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*)
+ echo m68k-hp-bsd4.4
+ exit 0 ;;
+ 9000/[3478]??:HP-UX:*:*)
+ case "${UNAME_MACHINE}" in
+ 9000/31? ) HP_ARCH=m68000 ;;
+ 9000/[34]?? ) HP_ARCH=m68k ;;
+ 9000/7?? | 9000/8?7 ) HP_ARCH=hppa1.1 ;;
+ 9000/8?? ) HP_ARCH=hppa1.0 ;;
+ esac
+ HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'`
+ echo ${HP_ARCH}-hp-hpux${HPUX_REV}
+ exit 0 ;;
+ 3050*:HI-UX:*:*)
+ sed 's/^ //' << EOF >dummy.c
+ #include <unistd.h>
+ int
+ main ()
+ {
+ long cpu = sysconf (_SC_CPU_VERSION);
+ /* The order matters, because CPU_IS_HP_MC68K erroneously returns
+ true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct
+ results, however. */
+ if (CPU_IS_PA_RISC (cpu))
+ {
+ switch (cpu)
+ {
+ case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break;
+ case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break;
+ case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break;
+ default: puts ("hppa-hitachi-hiuxwe2"); break;
+ }
+ }
+ else if (CPU_IS_HP_MC68K (cpu))
+ puts ("m68k-hitachi-hiuxwe2");
+ else puts ("unknown-hitachi-hiuxwe2");
+ exit (0);
+ }
+EOF
+ ${CC-cc} dummy.c -o dummy && ./dummy && rm dummy.c dummy && exit 0
+ rm -f dummy.c dummy
+ echo unknown-hitachi-hiuxwe2
+ exit 0 ;;
+ 9000/7??:4.3bsd:*:* | 9000/8?7:4.3bsd:*:* )
+ echo hppa1.1-hp-bsd
+ exit 0 ;;
+ 9000/8??:4.3bsd:*:*)
+ echo hppa1.0-hp-bsd
+ exit 0 ;;
+ hp7??:OSF1:*:* | hp8?7:OSF1:*:* )
+ echo hppa1.1-hp-osf
+ exit 0 ;;
+ hp8??:OSF1:*:*)
+ echo hppa1.0-hp-osf
+ exit 0 ;;
+ C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*)
+ echo c1-convex-bsd
+ exit 0 ;;
+ C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*)
+ if getsysinfo -f scalar_acc
+ then echo c32-convex-bsd
+ else echo c2-convex-bsd
+ fi
+ exit 0 ;;
+ C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*)
+ echo c34-convex-bsd
+ exit 0 ;;
+ C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*)
+ echo c38-convex-bsd
+ exit 0 ;;
+ C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*)
+ echo c4-convex-bsd
+ exit 0 ;;
+ CRAY*X-MP:UNICOS:*:*)
+ echo xmp-cray-unicos
+ exit 0 ;;
+ CRAY*Y-MP:UNICOS:*:*)
+ echo ymp-cray-unicos
+ exit 0 ;;
+ CRAY-2:UNICOS:*:*)
+ echo cray2-cray-unicos
+ exit 0 ;;
+ hp3[0-9][05]:NetBSD:*:*)
+ echo m68k-hp-netbsd${UNAME_RELEASE}
+ exit 0 ;;
+ i[34]86:BSD/386:*:*)
+ echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
+ exit 0 ;;
+ i[34]86:BSD/OS:*:*)
+ echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE}
+ exit 0 ;;
+ *:FreeBSD:*:*)
+ echo ${UNAME_MACHINE}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`
+ exit 0 ;;
+ *:NetBSD:*:*)
+ echo ${UNAME_MACHINE}-unknown-netbsd`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'`
+ exit 0 ;;
+ *:GNU:*:*)
+ echo `echo ${UNAME_MACHINE}|sed -e 's,/.*$,,'`-unknown-gnu`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'`
+ exit 0 ;;
+ *:Linux:*:*)
+ echo ${UNAME_MACHINE}-unknown-linux
+ exit 0 ;;
+# ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. earlier versions
+# are messed up and put the nodename in both sysname and nodename.
+ i[34]86:DYNIX/ptx:4*:*)
+ echo i386-sequent-sysv4
+ exit 0 ;;
+ i[34]86:*:4.*:* | i[34]86:SYSTEM_V:4.*:*)
+ if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then
+ echo ${UNAME_MACHINE}-univel-sysv${UNAME_RELEASE}
+ else
+ echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}
+ fi
+ exit 0 ;;
+ i[34]86:*:3.2:*)
+ if /bin/uname -X 2>/dev/null >/dev/null ; then
+ UNAME_REL=`(/bin/uname -X|egrep Release|sed -e 's/.*= //')`
+ (/bin/uname -X|egrep i80486 >/dev/null) && UNAME_MACHINE=i486
+ echo ${UNAME_MACHINE}-unknown-sco$UNAME_REL
+ elif test -f /usr/options/cb.name; then
+ UNAME_REL=`sed -n 's/.*Version //p' </usr/options/cb.name`
+ echo ${UNAME_MACHINE}-unknown-isc$UNAME_REL
+ else
+ echo ${UNAME_MACHINE}-unknown-sysv32
+ fi
+ exit 0 ;;
+ Intel:Mach:3*:*)
+ echo i386-unknown-mach3
+ exit 0 ;;
+ i860:*:4.*:*) # i860-SVR4
+ if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then
+ echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4
+ else # Add other i860-SVR4 vendors below as they are discovered.
+ echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4
+ fi
+ exit 0 ;;
+ mini*:CTIX:SYS*5:*)
+ # "miniframe"
+ echo m68010-convergent-sysv
+ exit 0 ;;
+ M680[234]0:*:R3V[567]*:*)
+ test -r /sysV68 && echo 'm68k-motorola-sysv' && exit 0 ;;
+ 3[34]??:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0)
+ uname -p 2>/dev/null | grep 86 >/dev/null \
+ && echo i486-ncr-sysv4.3 && exit 0 ;;
+ 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*)
+ uname -p 2>/dev/null | grep 86 >/dev/null \
+ && echo i486-ncr-sysv4 && exit 0 ;;
+ m680[234]0:LynxOS:2.2*:*)
+ echo m68k-lynx-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+ PowerPC:LynxOS:2.2*:*)
+ echo powerpc-lynx-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+ mc68030:UNIX_System_V:4.*:*)
+ echo m68k-atari-sysv4
+ exit 0 ;;
+ i[34]86:LynxOS:2.2*:*)
+ echo i386-lynx-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+ TSUNAMI:LynxOS:2.2*:*)
+ echo sparc-lynx-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+ rs6000:LynxOS:2.2*:*)
+ echo rs6000-lynx-lynxos${UNAME_RELEASE}
+ exit 0 ;;
+ RM*:SINIX-*:*:*)
+ echo mips-sni-sysv4
+ exit 0 ;;
+ *:SINIX-*:*:*)
+ if uname -p 2>/dev/null >/dev/null ; then
+ UNAME_MACHINE=`(uname -p) 2>/dev/null`
+ echo ${UNAME_MACHINE}-sni-sysv4
+ else
+ echo ns32k-sni-sysv
+ fi
+ exit 0 ;;
+esac
+
+#echo '(No uname command or uname output not recognized.)' 1>&2
+#echo "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" 1>&2
+
+cat >dummy.c <<EOF
+main ()
+{
+#if defined (sony)
+#if defined (MIPSEB)
+ /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed,
+ I don't know.... */
+ printf ("mips-sony-bsd\n"); exit (0);
+#else
+ printf ("m68k-sony-newsos\n"); exit (0);
+#endif
+#endif
+
+#if defined (__arm) && defined (__acorn) && defined (__unix)
+ printf ("arm-acorn-riscix"); exit (0);
+#endif
+
+#if defined (hp300) && !defined (hpux)
+ printf ("m68k-hp-bsd\n"); exit (0);
+#endif
+
+#if defined (NeXT)
+#if !defined (__ARCHITECTURE__)
+#define __ARCHITECTURE__ "m68k"
+#endif
+ int version;
+ version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`;
+ printf ("%s-next-nextstep%s\n", __ARCHITECTURE__, version==2 ? "2" : "3");
+ exit (0);
+#endif
+
+#if defined (MULTIMAX) || defined (n16)
+#if defined (UMAXV)
+ printf ("ns32k-encore-sysv\n"); exit (0);
+#else
+#if defined (CMU)
+ printf ("ns32k-encore-mach\n"); exit (0);
+#else
+ printf ("ns32k-encore-bsd\n"); exit (0);
+#endif
+#endif
+#endif
+
+#if defined (__386BSD__)
+ printf ("i386-unknown-bsd\n"); exit (0);
+#endif
+
+#if defined (sequent)
+#if defined (i386)
+ printf ("i386-sequent-dynix\n"); exit (0);
+#endif
+#if defined (ns32000)
+ printf ("ns32k-sequent-dynix\n"); exit (0);
+#endif
+#endif
+
+#if defined (_SEQUENT_)
+ printf ("i386-sequent-ptx\n"); exit (0);
+#endif
+
+#if defined (vax)
+#if !defined (ultrix)
+ printf ("vax-dec-bsd\n"); exit (0);
+#else
+ printf ("vax-dec-ultrix\n"); exit (0);
+#endif
+#endif
+
+#if defined (alliant) && defined (i860)
+ printf ("i860-alliant-bsd\n"); exit (0);
+#endif
+
+ exit (1);
+}
+EOF
+
+${CC-cc} dummy.c -o dummy 2>/dev/null && ./dummy && rm dummy.c dummy && exit 0
+rm -f dummy.c dummy
+
+# Apollos put the system type in the environment.
+
+test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit 0; }
+
+# Convex versions that predate uname can use getsysinfo(1)
+
+if [ -x /usr/convex/getsysinfo ]
+then
+ case `getsysinfo -f cpu_type` in
+ c1*)
+ echo c1-convex-bsd
+ exit 0 ;;
+ c2*)
+ if getsysinfo -f scalar_acc
+ then echo c32-convex-bsd
+ else echo c2-convex-bsd
+ fi
+ exit 0 ;;
+ c34*)
+ echo c34-convex-bsd
+ exit 0 ;;
+ c38*)
+ echo c38-convex-bsd
+ exit 0 ;;
+ c4*)
+ echo c4-convex-bsd
+ exit 0 ;;
+ esac
+fi
+
+#echo '(Unable to guess system type)' 1>&2
+
+exit 1
diff --git a/itcl/config/config.sub b/itcl/config/config.sub
new file mode 100755
index 00000000000..bf932cb9dd7
--- /dev/null
+++ b/itcl/config/config.sub
@@ -0,0 +1,793 @@
+#!/bin/sh
+# Configuration validation subroutine script, version 1.1.
+# Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
+# This file is (in principle) common to ALL GNU software.
+# The presence of a machine in this file suggests that SOME GNU software
+# can handle that machine. It does not imply ALL GNU software can.
+#
+# This file is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# As a special exception to the GNU General Public License, if you
+# distribute this file as part of a program that contains a
+# configuration script generated by Autoconf, you may include it under
+# the same distribution terms that you use for the rest of that program.
+
+# Configuration subroutine to validate and canonicalize a configuration type.
+# Supply the specified configuration type as an argument.
+# If it is invalid, we print an error message on stderr and exit with code 1.
+# Otherwise, we print the canonical config type on stdout and succeed.
+
+# This file is supposed to be the same for all GNU packages
+# and recognize all the CPU types, system types and aliases
+# that are meaningful with *any* GNU software.
+# Each package is responsible for reporting which valid configurations
+# it does not support. The user should be able to distinguish
+# a failure to support a valid configuration from a meaningless
+# configuration.
+
+# The goal of this file is to map all the various variations of a given
+# machine specification into a single specification in the form:
+# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM
+# It is wrong to echo any other type of specification.
+
+# First pass through any local machine types.
+case $1 in
+ *local*)
+ echo $1
+ exit 0
+ ;;
+ *)
+ ;;
+esac
+
+# Separate what the user gave into CPU-COMPANY and OS (if any).
+basic_machine=`echo $1 | sed 's/-[^-]*$//'`
+if [ $basic_machine != $1 ]
+then os=`echo $1 | sed 's/.*-/-/'`
+else os=; fi
+
+### Let's recognize common machines as not being operating systems so
+### that things like config.sub decstation-3100 work. We also
+### recognize some manufacturers as not being operating systems, so we
+### can provide default operating systems below.
+case $os in
+ -sun*os*)
+ # Prevent following clause from handling this invalid input.
+ ;;
+ -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \
+ -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \
+ -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \
+ -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\
+ -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \
+ -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp )
+ os=
+ basic_machine=$1
+ ;;
+ -hiux*)
+ os=-hiuxwe2
+ ;;
+ -sco4)
+ os=-sco3.2v4
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'`
+ ;;
+ -sco3.2.[4-9]*)
+ os=`echo $os | sed -e 's/sco3.2./sco3.2v/'`
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'`
+ ;;
+ -sco3.2v[4-9]*)
+ # Don't forget version if it is 3.2v4 or newer.
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'`
+ ;;
+ -sco*)
+ os=-sco3.2v2
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'`
+ ;;
+ -isc)
+ os=-isc2.2
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'`
+ ;;
+ -clix*)
+ basic_machine=clipper-intergraph
+ ;;
+ -isc*)
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-unknown/'`
+ ;;
+ -lynx)
+ os=-lynxos
+ ;;
+ -ptx*)
+ basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'`
+ ;;
+ -windowsnt*)
+ os=`echo $os | sed -e 's/windowsnt/winnt/'`
+ ;;
+esac
+
+# Decode aliases for certain CPU-COMPANY combinations.
+case $basic_machine in
+ # Recognize the basic CPU types without company name.
+ # Some are omitted here because they have special meanings below.
+ tahoe | i[345]86 | i860 | m68k | m68000 | m88k | ns32k | arm | pyramid \
+ | tron | a29k | 580 | i960 | h8300 | hppa1.0 | hppa1.1 \
+ | alpha | we32k | ns16k | clipper | sparclite | i370 | sh \
+ | powerpc | sparc64 | 1750a | dsp16xx | mips64 | mipsel \
+ | pdp11 | mips64el | mips64orion | mips64orionel )
+ basic_machine=$basic_machine-unknown
+ ;;
+ # Object if more than one company name word.
+ *-*-*)
+ echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
+ exit 1
+ ;;
+ # Recognize the basic CPU types with company name.
+ vax-* | tahoe-* | i[345]86-* | i860-* | m68k-* | m68000-* | m88k-* \
+ | sparc-* | ns32k-* | fx80-* | arm-* | c[123]* \
+ | mips-* | pyramid-* | tron-* | a29k-* | romp-* | rs6000-* \
+ | none-* | 580-* | cray2-* | h8300-* | i960-* | xmp-* | ymp-* \
+ | hppa1.0-* | hppa1.1-* | alpha-* | we32k-* | cydra-* | ns16k-* \
+ | pn-* | np1-* | xps100-* | clipper-* | orion-* | sparclite-* \
+ | pdp11-* | sh-* | powerpc-* | sparc64-* | mips64-* | mipsel-* \
+ | mips64el-* | mips64orion-* | mips64orionel-* )
+ ;;
+ # Recognize the various machine names and aliases which stand
+ # for a CPU type and a company and sometimes even an OS.
+ 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc)
+ basic_machine=m68000-att
+ ;;
+ 3b*)
+ basic_machine=we32k-att
+ ;;
+ alliant | fx80)
+ basic_machine=fx80-alliant
+ ;;
+ altos | altos3068)
+ basic_machine=m68k-altos
+ ;;
+ am29k)
+ basic_machine=a29k-none
+ os=-bsd
+ ;;
+ amdahl)
+ basic_machine=580-amdahl
+ os=-sysv
+ ;;
+ amiga | amiga-*)
+ basic_machine=m68k-cbm
+ ;;
+ amigados)
+ basic_machine=m68k-cbm
+ os=-amigados
+ ;;
+ amigaunix | amix)
+ basic_machine=m68k-cbm
+ os=-sysv4
+ ;;
+ apollo68)
+ basic_machine=m68k-apollo
+ os=-sysv
+ ;;
+ balance)
+ basic_machine=ns32k-sequent
+ os=-dynix
+ ;;
+ convex-c1)
+ basic_machine=c1-convex
+ os=-bsd
+ ;;
+ convex-c2)
+ basic_machine=c2-convex
+ os=-bsd
+ ;;
+ convex-c32)
+ basic_machine=c32-convex
+ os=-bsd
+ ;;
+ convex-c34)
+ basic_machine=c34-convex
+ os=-bsd
+ ;;
+ convex-c38)
+ basic_machine=c38-convex
+ os=-bsd
+ ;;
+ cray | ymp)
+ basic_machine=ymp-cray
+ os=-unicos
+ ;;
+ cray2)
+ basic_machine=cray2-cray
+ os=-unicos
+ ;;
+ crds | unos)
+ basic_machine=m68k-crds
+ ;;
+ da30 | da30-*)
+ basic_machine=m68k-da30
+ ;;
+ decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn)
+ basic_machine=mips-dec
+ ;;
+ delta | 3300 | motorola-3300 | motorola-delta \
+ | 3300-motorola | delta-motorola)
+ basic_machine=m68k-motorola
+ ;;
+ delta88)
+ basic_machine=m88k-motorola
+ os=-sysv3
+ ;;
+ dpx20 | dpx20-*)
+ basic_machine=rs6000-bull
+ os=-bosx
+ ;;
+ dpx2* | dpx2*-bull)
+ basic_machine=m68k-bull
+ os=-sysv3
+ ;;
+ ebmon29k)
+ basic_machine=a29k-amd
+ os=-ebmon
+ ;;
+ elxsi)
+ basic_machine=elxsi-elxsi
+ os=-bsd
+ ;;
+ encore | umax | mmax)
+ basic_machine=ns32k-encore
+ ;;
+ fx2800)
+ basic_machine=i860-alliant
+ ;;
+ genix)
+ basic_machine=ns32k-ns
+ ;;
+ gmicro)
+ basic_machine=tron-gmicro
+ os=-sysv
+ ;;
+ h3050r* | hiux*)
+ basic_machine=hppa1.1-hitachi
+ os=-hiuxwe2
+ ;;
+ h8300hms)
+ basic_machine=h8300-hitachi
+ os=-hms
+ ;;
+ harris)
+ basic_machine=m88k-harris
+ os=-sysv3
+ ;;
+ hp300-*)
+ basic_machine=m68k-hp
+ ;;
+ hp300bsd)
+ basic_machine=m68k-hp
+ os=-bsd
+ ;;
+ hp300hpux)
+ basic_machine=m68k-hp
+ os=-hpux
+ ;;
+ hp9k2[0-9][0-9] | hp9k31[0-9])
+ basic_machine=m68000-hp
+ ;;
+ hp9k3[2-9][0-9])
+ basic_machine=m68k-hp
+ ;;
+ hp9k7[0-9][0-9] | hp7[0-9][0-9] | hp9k8[0-9]7 | hp8[0-9]7)
+ basic_machine=hppa1.1-hp
+ ;;
+ hp9k8[0-9][0-9] | hp8[0-9][0-9])
+ basic_machine=hppa1.0-hp
+ ;;
+ i370-ibm* | ibm*)
+ basic_machine=i370-ibm
+ os=-mvs
+ ;;
+# I'm not sure what "Sysv32" means. Should this be sysv3.2?
+ i[345]86v32)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+ os=-sysv32
+ ;;
+ i[345]86v4*)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+ os=-sysv4
+ ;;
+ i[345]86v)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+ os=-sysv
+ ;;
+ i[345]86sol2)
+ basic_machine=`echo $1 | sed -e 's/86.*/86-unknown/'`
+ os=-solaris2
+ ;;
+ iris | iris4d)
+ basic_machine=mips-sgi
+ case $os in
+ -irix*)
+ ;;
+ *)
+ os=-irix4
+ ;;
+ esac
+ ;;
+ isi68 | isi)
+ basic_machine=m68k-isi
+ os=-sysv
+ ;;
+ m88k-omron*)
+ basic_machine=m88k-omron
+ ;;
+ magnum | m3230)
+ basic_machine=mips-mips
+ os=-sysv
+ ;;
+ merlin)
+ basic_machine=ns32k-utek
+ os=-sysv
+ ;;
+ miniframe)
+ basic_machine=m68000-convergent
+ ;;
+ mips3*-*)
+ basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`
+ ;;
+ mips3*)
+ basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown
+ ;;
+ ncr3000)
+ basic_machine=i486-ncr
+ os=-sysv4
+ ;;
+ news | news700 | news800 | news900)
+ basic_machine=m68k-sony
+ os=-newsos
+ ;;
+ news1000)
+ basic_machine=m68030-sony
+ os=-newsos
+ ;;
+ news-3600 | risc-news)
+ basic_machine=mips-sony
+ os=-newsos
+ ;;
+ next | m*-next )
+ basic_machine=m68k-next
+ case $os in
+ -nextstep* )
+ ;;
+ -ns2*)
+ os=-nextstep2
+ ;;
+ *)
+ os=-nextstep3
+ ;;
+ esac
+ ;;
+ nh3000)
+ basic_machine=m68k-harris
+ os=-cxux
+ ;;
+ nh[45]000)
+ basic_machine=m88k-harris
+ os=-cxux
+ ;;
+ nindy960)
+ basic_machine=i960-intel
+ os=-nindy
+ ;;
+ np1)
+ basic_machine=np1-gould
+ ;;
+ pa-hitachi)
+ basic_machine=hppa1.1-hitachi
+ os=-hiuxwe2
+ ;;
+ paragon)
+ basic_machine=i860-intel
+ os=-osf
+ ;;
+ pbd)
+ basic_machine=sparc-tti
+ ;;
+ pbb)
+ basic_machine=m68k-tti
+ ;;
+ pc532 | pc532-*)
+ basic_machine=ns32k-pc532
+ ;;
+ pentium-*)
+ # We will change tis to say i586 once there has been
+ # time for various packages to start to recognize that.
+ basic_machine=i486-`echo $basic_machine | sed 's/^[^-]*-//'`
+ ;;
+ pn)
+ basic_machine=pn-gould
+ ;;
+ ps2)
+ basic_machine=i386-ibm
+ ;;
+ rtpc | rtpc-*)
+ basic_machine=romp-ibm
+ ;;
+ sequent)
+ basic_machine=i386-sequent
+ ;;
+ sh)
+ basic_machine=sh-hitachi
+ os=-hms
+ ;;
+ sps7)
+ basic_machine=m68k-bull
+ os=-sysv2
+ ;;
+ spur)
+ basic_machine=spur-unknown
+ ;;
+ sun2)
+ basic_machine=m68000-sun
+ ;;
+ sun2os3)
+ basic_machine=m68000-sun
+ os=-sunos3
+ ;;
+ sun2os4)
+ basic_machine=m68000-sun
+ os=-sunos4
+ ;;
+ sun3os3)
+ basic_machine=m68k-sun
+ os=-sunos3
+ ;;
+ sun3os4)
+ basic_machine=m68k-sun
+ os=-sunos4
+ ;;
+ sun4os3)
+ basic_machine=sparc-sun
+ os=-sunos3
+ ;;
+ sun4os4)
+ basic_machine=sparc-sun
+ os=-sunos4
+ ;;
+ sun3 | sun3-*)
+ basic_machine=m68k-sun
+ ;;
+ sun4)
+ basic_machine=sparc-sun
+ ;;
+ sun386 | sun386i | roadrunner)
+ basic_machine=i386-sun
+ ;;
+ symmetry)
+ basic_machine=i386-sequent
+ os=-dynix
+ ;;
+ tower | tower-32)
+ basic_machine=m68k-ncr
+ ;;
+ ultra3)
+ basic_machine=a29k-nyu
+ os=-sym1
+ ;;
+ vaxv)
+ basic_machine=vax-dec
+ os=-sysv
+ ;;
+ vms)
+ basic_machine=vax-dec
+ os=-vms
+ ;;
+ vxworks960)
+ basic_machine=i960-wrs
+ os=-vxworks
+ ;;
+ vxworks68)
+ basic_machine=m68k-wrs
+ os=-vxworks
+ ;;
+ xmp)
+ basic_machine=xmp-cray
+ os=-unicos
+ ;;
+ xps | xps100)
+ basic_machine=xps100-honeywell
+ ;;
+ none)
+ basic_machine=none-none
+ os=-none
+ ;;
+
+# Here we handle the default manufacturer of certain CPU types. It is in
+# some cases the only manufacturer, in others, it is the most popular.
+ mips)
+ basic_machine=mips-mips
+ ;;
+ romp)
+ basic_machine=romp-ibm
+ ;;
+ rs6000)
+ basic_machine=rs6000-ibm
+ ;;
+ vax)
+ basic_machine=vax-dec
+ ;;
+ pdp11)
+ basic_machine=pdp11-dec
+ ;;
+ we32k)
+ basic_machine=we32k-att
+ ;;
+ sparc)
+ basic_machine=sparc-sun
+ ;;
+ cydra)
+ basic_machine=cydra-cydrome
+ ;;
+ orion)
+ basic_machine=orion-highlevel
+ ;;
+ orion105)
+ basic_machine=clipper-highlevel
+ ;;
+ *)
+ echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2
+ exit 1
+ ;;
+esac
+
+# Here we canonicalize certain aliases for manufacturers.
+case $basic_machine in
+ *-digital*)
+ basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'`
+ ;;
+ *-commodore*)
+ basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'`
+ ;;
+ *)
+ ;;
+esac
+
+# Decode manufacturer-specific aliases for certain operating systems.
+
+if [ x"$os" != x"" ]
+then
+case $os in
+ # -solaris* is a basic system type, with this one exception.
+ -solaris1 | -solaris1.*)
+ os=`echo $os | sed -e 's|solaris1|sunos4|'`
+ ;;
+ -solaris)
+ os=-solaris2
+ ;;
+ -gnu/linux*)
+ os=`echo $os | sed -e 's|gnu/linux|linux|'`
+ ;;
+ # First accept the basic system types.
+ # The portable systems comes first.
+ # Each alternative must end in a *, to match a version number.
+ # -sysv* is not here because it comes later, after sysvr4.
+ -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \
+ | -vms* | -sco* | -esix* | -isc* | -aix* | -sunos | -sunos[345]* \
+ | -hpux* | -unos* | -osf* | -luna* | -dgux* | -solaris* | -sym* \
+ | -amigados* | -msdos* | -newsos* | -unicos* | -aos* \
+ | -nindy* | -vxworks* | -ebmon* | -hms* | -mvs* | -clix* \
+ | -riscos* | -linux* | -uniplus* | -iris* | -rtu* | -xenix* \
+ | -hiux* | -386bsd* | -netbsd* | -freebsd* | -riscix* \
+ | -lynxos* | -bosx* | -nextstep* | -cxux* | -aout* | -elf* \
+ | -ptx* | -coff* | -winnt*)
+ ;;
+ -sunos5*)
+ os=`echo $os | sed -e 's|sunos5|solaris2|'`
+ ;;
+ -sunos6*)
+ os=`echo $os | sed -e 's|sunos6|solaris3|'`
+ ;;
+ -osfrose*)
+ os=-osfrose
+ ;;
+ -osf*)
+ os=-osf
+ ;;
+ -utek*)
+ os=-bsd
+ ;;
+ -dynix*)
+ os=-bsd
+ ;;
+ -acis*)
+ os=-aos
+ ;;
+ -ctix* | -uts*)
+ os=-sysv
+ ;;
+ -triton*)
+ os=-sysv3
+ ;;
+ -oss*)
+ os=-sysv3
+ ;;
+ -svr4)
+ os=-sysv4
+ ;;
+ -svr3)
+ os=-sysv3
+ ;;
+ -sysvr4)
+ os=-sysv4
+ ;;
+ # This must come after -sysvr4.
+ -sysv*)
+ ;;
+ -xenix)
+ os=-xenix
+ ;;
+ -none)
+ ;;
+ *)
+ # Get rid of the `-' at the beginning of $os.
+ os=`echo $os | sed 's/[^-]*-//'`
+ echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2
+ exit 1
+ ;;
+esac
+else
+
+# Here we handle the default operating systems that come with various machines.
+# The value should be what the vendor currently ships out the door with their
+# machine or put another way, the most popular os provided with the machine.
+
+# Note that if you're going to try to match "-MANUFACTURER" here (say,
+# "-sun"), then you have to tell the case statement up towards the top
+# that MANUFACTURER isn't an operating system. Otherwise, code above
+# will signal an error saying that MANUFACTURER isn't an operating
+# system, and we'll never get to this point.
+
+case $basic_machine in
+ *-acorn)
+ os=-riscix1.2
+ ;;
+ pdp11-*)
+ os=-none
+ ;;
+ *-dec | vax-*)
+ os=-ultrix4.2
+ ;;
+ i386-sun)
+ os=-sunos4.0.2
+ ;;
+ m68000-sun)
+ os=-sunos3
+ # This also exists in the configure program, but was not the
+ # default.
+ # os=-sunos4
+ ;;
+ *-tti) # must be before sparc entry or we get the wrong os.
+ os=-sysv3
+ ;;
+ sparc-* | *-sun)
+ os=-sunos4.1.1
+ ;;
+ *-ibm)
+ os=-aix
+ ;;
+ *-hp)
+ os=-hpux
+ ;;
+ *-hitachi)
+ os=-hiux
+ ;;
+ i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent)
+ os=-sysv
+ ;;
+ *-cbm)
+ os=-amigados
+ ;;
+ *-dg)
+ os=-dgux
+ ;;
+ *-dolphin)
+ os=-sysv3
+ ;;
+ m68k-ccur)
+ os=-rtu
+ ;;
+ m88k-omron*)
+ os=-luna
+ ;;
+ *-sequent)
+ os=-ptx
+ ;;
+ *-crds)
+ os=-unos
+ ;;
+ *-ns)
+ os=-genix
+ ;;
+ i370-*)
+ os=-mvs
+ ;;
+ *-next)
+ os=-nextstep3
+ ;;
+ *-gould)
+ os=-sysv
+ ;;
+ *-highlevel)
+ os=-bsd
+ ;;
+ *-encore)
+ os=-bsd
+ ;;
+ *-sgi)
+ os=-irix
+ ;;
+ *-masscomp)
+ os=-rtu
+ ;;
+ *)
+ os=-none
+ ;;
+esac
+fi
+
+# Here we handle the case where we know the os, and the CPU type, but not the
+# manufacturer. We pick the logical manufacturer.
+vendor=unknown
+case $basic_machine in
+ *-unknown)
+ case $os in
+ -riscix*)
+ vendor=acorn
+ ;;
+ -sunos*)
+ vendor=sun
+ ;;
+ -lynxos*)
+ vendor=lynx
+ ;;
+ -aix*)
+ vendor=ibm
+ ;;
+ -hpux*)
+ vendor=hp
+ ;;
+ -hiux*)
+ vendor=hitachi
+ ;;
+ -unos*)
+ vendor=crds
+ ;;
+ -dgux*)
+ vendor=dg
+ ;;
+ -luna*)
+ vendor=omron
+ ;;
+ -genix*)
+ vendor=ns
+ ;;
+ -mvs*)
+ vendor=ibm
+ ;;
+ -ptx*)
+ vendor=sequent
+ ;;
+ esac
+ basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"`
+ ;;
+esac
+
+echo $basic_machine$os
diff --git a/itcl/config/install-sh b/itcl/config/install-sh
new file mode 100755
index 00000000000..0ff4b6a08e8
--- /dev/null
+++ b/itcl/config/install-sh
@@ -0,0 +1,119 @@
+#!/bin/sh
+
+#
+# install - install a program, script, or datafile
+# This comes from X11R5; it is not part of GNU.
+#
+# $XConsortium: install.sh,v 1.2 89/12/18 14:47:22 jim Exp $
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch.
+#
+
+
+# set DOITPROG to echo to test this script
+
+# Don't use :- since 4.3BSD and earlier shells don't like it.
+doit="${DOITPROG-}"
+
+
+# put in absolute paths if you don't have them in your path; or use env. vars.
+
+mvprog="${MVPROG-mv}"
+cpprog="${CPPROG-cp}"
+chmodprog="${CHMODPROG-chmod}"
+chownprog="${CHOWNPROG-chown}"
+chgrpprog="${CHGRPPROG-chgrp}"
+stripprog="${STRIPPROG-strip}"
+rmprog="${RMPROG-rm}"
+
+instcmd="$mvprog"
+chmodcmd=""
+chowncmd=""
+chgrpcmd=""
+stripcmd=""
+rmcmd="$rmprog -f"
+mvcmd="$mvprog"
+src=""
+dst=""
+
+while [ x"$1" != x ]; do
+ case $1 in
+ -c) instcmd="$cpprog"
+ shift
+ continue;;
+
+ -m) chmodcmd="$chmodprog $2"
+ shift
+ shift
+ continue;;
+
+ -o) chowncmd="$chownprog $2"
+ shift
+ shift
+ continue;;
+
+ -g) chgrpcmd="$chgrpprog $2"
+ shift
+ shift
+ continue;;
+
+ -s) stripcmd="$stripprog"
+ shift
+ continue;;
+
+ *) if [ x"$src" = x ]
+ then
+ src=$1
+ else
+ dst=$1
+ fi
+ shift
+ continue;;
+ esac
+done
+
+if [ x"$src" = x ]
+then
+ echo "install: no input file specified"
+ exit 1
+fi
+
+if [ x"$dst" = x ]
+then
+ echo "install: no destination specified"
+ exit 1
+fi
+
+
+# If destination is a directory, append the input filename; if your system
+# does not like double slashes in filenames, you may need to add some logic
+
+if [ -d $dst ]
+then
+ dst="$dst"/`basename $src`
+fi
+
+# Make a temp file name in the proper directory.
+
+dstdir=`dirname $dst`
+dsttmp=$dstdir/#inst.$$#
+
+# Move or copy the file name to the temp name
+
+$doit $instcmd $src $dsttmp
+
+# and set any options; do chmod last to preserve setuid bits
+
+if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; fi
+if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; fi
+if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; fi
+if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; fi
+
+# Now rename the file to the real destination.
+
+$doit $rmcmd $dst
+$doit $mvcmd $dsttmp $dst
+
+
+exit 0
diff --git a/itcl/config/mkinstalldirs b/itcl/config/mkinstalldirs
new file mode 100755
index 00000000000..0801ec2c966
--- /dev/null
+++ b/itcl/config/mkinstalldirs
@@ -0,0 +1,32 @@
+#! /bin/sh
+# mkinstalldirs --- make directory hierarchy
+# Author: Noah Friedman <friedman@prep.ai.mit.edu>
+# Created: 1993-05-16
+# Last modified: 1994-03-25
+# Public domain
+
+errstatus=0
+
+for file in ${1+"$@"} ; do
+ set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'`
+ shift
+
+ pathcomp=
+ for d in ${1+"$@"} ; do
+ pathcomp="$pathcomp$d"
+ case "$pathcomp" in
+ -* ) pathcomp=./$pathcomp ;;
+ esac
+
+ if test ! -d "$pathcomp"; then
+ echo "mkdir $pathcomp" 1>&2
+ mkdir "$pathcomp" || errstatus=$?
+ fi
+
+ pathcomp="$pathcomp/"
+ done
+done
+
+exit $errstatus
+
+# mkinstalldirs ends here
diff --git a/itcl/configure b/itcl/configure
new file mode 100755
index 00000000000..4e46ba23472
--- /dev/null
+++ b/itcl/configure
@@ -0,0 +1,976 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.12.2
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.12.2"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=itcl/generic/itcl.h
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+
+# Make sure we can run config.sub.
+if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then :
+else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking host system type""... $ac_c" 1>&6
+echo "configure:551: checking host system type" >&5
+
+host_alias=$host
+case "$host_alias" in
+NONE)
+ case $nonopt in
+ NONE)
+ if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then :
+ else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; }
+ fi ;;
+ *) host_alias=$nonopt ;;
+ esac ;;
+esac
+
+host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias`
+host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+echo "$ac_t""$host" 1>&6
+
+
+if test -d itcl; then
+ true
+else
+ mkdir itcl
+fi
+if test -d itk; then
+ true
+else
+ mkdir itk
+fi
+if test -d iwidgets3.0.0; then
+ true
+else
+ mkdir iwidgets3.0.0
+fi
+
+case "${host}" in
+*-*-cygwin*)
+ CONFIGDIR="itcl/win itk/win iwidgets3.0.0/unix" ;;
+*)
+ CONFIGDIR="itcl/unix itk/unix iwidgets3.0.0/unix" ;;
+esac
+
+
+echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6
+echo "configure:597: checking whether ${MAKE-make} sets \${MAKE}" >&5
+set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftestmake <<\EOF
+all:
+ @echo 'ac_maketemp="${MAKE}"'
+EOF
+# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=`
+if test -n "$ac_maketemp"; then
+ eval ac_cv_prog_make_${ac_make}_set=yes
+else
+ eval ac_cv_prog_make_${ac_make}_set=no
+fi
+rm -f conftestmake
+fi
+if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ SET_MAKE=
+else
+ echo "$ac_t""no" 1>&6
+ SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+
+subdirs="$CONFIGDIR"
+
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set) 2>&1 | grep ac_space` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.12.2"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+
+trap 'rm -fr `echo "Makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@host@%$host%g
+s%@host_alias@%$host_alias%g
+s%@host_cpu@%$host_cpu%g
+s%@host_vendor@%$host_vendor%g
+s%@host_os@%$host_os%g
+s%@CONFIGDIR@%$CONFIGDIR%g
+s%@SET_MAKE@%$SET_MAKE%g
+s%@subdirs@%$subdirs%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
+if test "$no_recursion" != yes; then
+
+ # Remove --cache-file and --srcdir arguments so they do not pile up.
+ ac_sub_configure_args=
+ ac_prev=
+ for ac_arg in $ac_configure_args; do
+ if test -n "$ac_prev"; then
+ ac_prev=
+ continue
+ fi
+ case "$ac_arg" in
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ ;;
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ ;;
+ *) ac_sub_configure_args="$ac_sub_configure_args $ac_arg" ;;
+ esac
+ done
+
+ for ac_config_dir in $CONFIGDIR; do
+
+ # Do not complain, so a configure script can configure whichever
+ # parts of a large source tree are present.
+ if test ! -d $srcdir/$ac_config_dir; then
+ continue
+ fi
+
+ echo configuring in $ac_config_dir
+
+ case "$srcdir" in
+ .) ;;
+ *)
+ if test -d ./$ac_config_dir || mkdir ./$ac_config_dir; then :;
+ else
+ { echo "configure: error: can not create `pwd`/$ac_config_dir" 1>&2; exit 1; }
+ fi
+ ;;
+ esac
+
+ ac_popdir=`pwd`
+ cd $ac_config_dir
+
+ # A "../" for each directory in /$ac_config_dir.
+ ac_dots=`echo $ac_config_dir|sed -e 's%^\./%%' -e 's%[^/]$%&/%' -e 's%[^/]*/%../%g'`
+
+ case "$srcdir" in
+ .) # No --srcdir option. We are building in place.
+ ac_sub_srcdir=$srcdir ;;
+ /*) # Absolute path.
+ ac_sub_srcdir=$srcdir/$ac_config_dir ;;
+ *) # Relative path.
+ ac_sub_srcdir=$ac_dots$srcdir/$ac_config_dir ;;
+ esac
+
+ # Check for guested configure; otherwise get Cygnus style configure.
+ if test -f $ac_sub_srcdir/configure; then
+ ac_sub_configure=$ac_sub_srcdir/configure
+ elif test -f $ac_sub_srcdir/configure.in; then
+ ac_sub_configure=$ac_configure
+ else
+ echo "configure: warning: no configuration information is in $ac_config_dir" 1>&2
+ ac_sub_configure=
+ fi
+
+ # The recursion is here.
+ if test -n "$ac_sub_configure"; then
+
+ # Make the cache file name correct relative to the subdirectory.
+ case "$cache_file" in
+ /*) ac_sub_cache_file=$cache_file ;;
+ *) # Relative path.
+ ac_sub_cache_file="$ac_dots$cache_file" ;;
+ esac
+
+ echo "running ${CONFIG_SHELL-/bin/sh} $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_sub_srcdir"
+ # The eval makes quoting arguments work.
+ if eval ${CONFIG_SHELL-/bin/sh} $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_sub_srcdir
+ then :
+ else
+ { echo "configure: error: $ac_sub_configure failed for $ac_config_dir" 1>&2; exit 1; }
+ fi
+ fi
+
+ cd $ac_popdir
+ done
+fi
+
diff --git a/itcl/configure.in b/itcl/configure.in
new file mode 100644
index 00000000000..41de7dc7591
--- /dev/null
+++ b/itcl/configure.in
@@ -0,0 +1,37 @@
+dnl This entire file is CYGNUS LOCAL.
+dnl Itcl configure file.
+
+AC_PREREQ(2.5)
+
+AC_INIT(itcl/generic/itcl.h)
+AC_CANONICAL_HOST
+
+if test -d itcl; then
+ true
+else
+ mkdir itcl
+fi
+if test -d itk; then
+ true
+else
+ mkdir itk
+fi
+if test -d iwidgets3.0.0; then
+ true
+else
+ mkdir iwidgets3.0.0
+fi
+
+case "${host}" in
+*-*-cygwin*)
+ CONFIGDIR="itcl/win itk/win iwidgets3.0.0/unix" ;;
+*)
+ CONFIGDIR="itcl/unix itk/unix iwidgets3.0.0/unix" ;;
+esac
+AC_SUBST(CONFIGDIR)
+
+AC_PROG_MAKE_SET
+
+AC_CONFIG_SUBDIRS($CONFIGDIR)
+
+AC_OUTPUT(Makefile)
diff --git a/itcl/doc/README b/itcl/doc/README
new file mode 100644
index 00000000000..3474a6466e2
--- /dev/null
+++ b/itcl/doc/README
@@ -0,0 +1,14 @@
+
+ OVERVIEW
+------------------------------------------------------------------------
+ If you are just getting started with [incr Tcl], download the
+ "tutorial" from the itcl web site:
+
+ http://www.tcltk.com/itcl/
+
+ This has over 100 pages of introductory text and code examples.
+ I didn't include it here, since it adds another megabyte to the
+ distribution, and long-time users won't need it.
+
+ You can find the same tutorial in the book "Tcl/Tk Tools"
+ published by O'Reilly and Associates.
diff --git a/itcl/itcl/doc/Resolvers.3 b/itcl/itcl/doc/Resolvers.3
new file mode 100644
index 00000000000..aa44f2cd648
--- /dev/null
+++ b/itcl/itcl/doc/Resolvers.3
@@ -0,0 +1,222 @@
+'\"
+'\" Copyright (c) 1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" SCCS: %W%
+'\"
+.so man.macros
+.TH Tcl_AddInterpResolvers 3 8.0 Tcl "Tcl Library Procedures"
+.BS
+.SH NAME
+Tcl_AddInterpResolvers, Tcl_GetInterpResolvers, Tcl_RemoveInterpResolvers, Tcl_SetNamespaceResolvers, Tcl_GetNamespaceResolvers \- change the name resolution rules for commands/variables
+.SH SYNOPSIS
+.nf
+\fB#include <tcl.h>\fR
+.sp
+void
+\fBTcl_AddInterpResolvers\fR(\fIinterp, name, cmdProc, varProc, compiledVarProc\fR)
+.sp
+int
+\fBTcl_GetInterpResolvers\fR(\fIinterp, name, resInfoPtr\fR)
+.sp
+int
+\fBTcl_RemoveInterpResolvers\fR(\fIinterp, name\fR)
+.sp
+void
+\fBTcl_SetNamespaceResolvers\fR(\fInamespacePtr, cmdProc, varProc, compiledVarProc\fR)
+.sp
+int
+\fBTcl_GetNamespaceResolvers\fR(\fInamespacePtr, resInfoPtr\fR)
+.SH ARGUMENTS
+.AS Tcl_ResolveCompiledVarProc *compiledVarProc
+.AP Tcl_Interp *interp in
+Interpreter whose name resolution rules are being queried or modified.
+.AP char *name in
+Name for a group of name resolution procedures.
+.AP Tcl_ResolveCmdProc *cmdProc in
+Procedure which will be used to resolve command names.
+.AP Tcl_ResolveVarProc *varProc in
+Procedure which will be used to resolve variable names at run time.
+.AP Tcl_ResolveCompiledVarProc *compiledVarProc in
+Procedure which will be used to resolve variable names at compile time.
+.AP Tcl_ResolverInfo *resInfoPtr out
+Returns the resolution procedures that are currently in effect for
+a particular namespace or for a particular name resolution scheme
+in the interpreter.
+.AP Tcl_Namespace *namespacePtr in
+Namespace whose name resolution rules are being queried or modified.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures make it possible to change the way that Tcl
+resolves command/variable names. The name resolution rules are
+changed by supplying three procedures: \fIcmdProc\fR, \fIvarProc\fR, and
+\fIcompiledVarProc\fR. See the section \fBHOW NAME RESOLUTION PROCEDURES
+WORK\fR for details about these procedures.
+.PP
+The name resolution rules can be changed for a particular namespace,
+for an entire interpreter, or both. When a name needs to be resolved,
+Tcl handles it as follows. The name resolution scheme for the
+current namespace is consulted first. Each of the name resolution
+schemes for the interpreter are consulted next. Finally, Tcl uses
+the default rules for name resolution as described for the
+\fBnamespace\fR command.
+.PP
+\fBTcl_AddInterpResolver\fR adds a set of name resolution procedures
+to an interpreter. The procedures are identified by a string \fIname\fR,
+so they can be queried or deleted later on. All of the name resolution
+schemes for the interpreter are kept on a list, and they are consulted
+in order from most- to least-recently added. For example, suppose one
+extension adds a name resolution scheme called "fred", and another
+extension adds another scheme called "barney". When a name is resolved,
+the "barney" scheme will be consulted first, followed by the "fred"
+scheme, if necessary.
+.PP
+\fBTcl_GetInterpResolver\fR looks for a particular name resolution
+scheme in an interpreter. If the \fIname\fR is recognized, this
+procedure returns a non-zero value along with pointers to the
+name resolution procedures in the \fIresInfoPtr\fR structure. Otherwise,
+the procedure returns 0.
+.PP
+\fBTcl_RemoveInterpResolver\fR looks for a particular name resolution
+scheme in an interpreter. If the \fIname\fR is recognized, this
+procedure deletes the scheme and returns a non-zero value. Otherwise,
+it returns 0.
+.PP
+\fBTcl_SetNamespaceResolver\fR sets the name resolution procedures
+for a particular namespace. Unlike an interpreter, a namespace can
+have only one name resolution scheme in effect at any given time.
+.PP
+\fBTcl_GetNamespaceResolver\fR returns the name resolution procedures
+for a particular namespace. If the namespace has a special name
+resolution scheme, this procedure returns a non-zero value along
+with pointers to the name resolution procedures in the \fIresInfoPtr\fR
+structure. Otherwise, the procedure returns 0.
+.SH "HOW NAME RESOLUTION PROCEDURES WORK"
+A name resolution scheme is enforced by three name resolution procedures.
+The \fIcmdProc\fR procedure is used to resolve command names. It must
+conform to the following type:
+.CS
+typedef int Tcl_ResolveCmdProc(Tcl_Interp* \fIinterp\fR,
+ char* \fIname\fR, Tcl_Namespace* \fIcontext\fR, int \fIflags\fR,
+ Tcl_Command* \fIrPtr\fR);
+.CE
+The \fIinterp\fR argument is the interpreter performing the resolution;
+\fIname\fR is the command name being resolved; \fIcontext\fR is the
+namespace context containing the command reference; and \fIflags\fR
+may contain TCL_LEAVE_ERR_MSG.
+.PP
+If this procedure recognizes the command \fIname\fR, it should
+store the Tcl_Command token for that command in the \fIrPtr\fR
+argument and return TCL_OK. If this procedure doesn't recognize
+the command \fIname\fR, it should return TCL_CONTINUE, and the
+name resolution will continue with another procedure or with the
+default Tcl resolution scheme. If this procedure recognizes
+the command \fIname\fR, but for some reason the command is
+invalid, the procedure should return TCL_ERROR. If the \fIflags\fR
+argument contains TCL_LEAVE_ERR_MSG, the procedure should leave
+an error message in the interpreter, explaining why the command
+is invalid.
+.PP
+The \fIvarProc\fR procedure is similar to \fIcmdProc\fR, but it is
+used to resolve variable names encountered at run time. It must
+conform to the following type:
+.CS
+typedef int Tcl_ResolveVarProc(Tcl_Interp* \fIinterp\fR,
+ char* \fIname\fR, Tcl_Namespace* \fIcontext\fR, int \fIflags\fR,
+ Tcl_Var* \fIrPtr\fR);
+.CE
+The \fIinterp\fR argument is the interpreter performing the resolution;
+\fIname\fR is the variable name being resolved; \fIcontext\fR is the
+namespace context containing the variable reference; and \fIflags\fR
+may contain TCL_GLOBAL_ONLY, TCL_NAMESPACE_ONLY, or TCL_LEAVE_ERR_MSG.
+.PP
+If this procedure recognizes the variable \fIname\fR, it should
+store the Tcl_Var token for that variable in the \fIrPtr\fR
+argument and return TCL_OK. If this procedure doesn't recognize
+the variable \fIname\fR, it should return TCL_CONTINUE, and the
+name resolution will continue with another procedure or with the
+default Tcl resolution scheme. If this procedure recognizes
+the variable \fIname\fR, but for some reason the variable is
+not accessible, the procedure should return TCL_ERROR. If the
+\fIflags\fR argument contains TCL_LEAVE_ERR_MSG, the procedure
+should leave an error message in the interpreter, explaining why
+the variable reference is invalid.
+.PP
+Note that this procedure should look for the TCL_GLOBAL_ONLY and
+TCL_NAMESPACE_ONLY flags. It should handle them appropriately, or
+return TCL_CONTINUE and let Tcl handle the reference. But it should
+not ignore the flags.
+.PP
+Tcl also resolves variables when a body of code is compiled; the
+\fIcompiledVarProc\fR procedure handles that case. It must
+conform to the following type:
+.CS
+typedef int Tcl_ResolveCompiledVarProc(Tcl_Interp* \fIinterp\fR,
+ char* \fIname\fR, int \fIlength\fR, Tcl_Namespace* \fIcontext\fR,
+ Tcl_ResolvedVarInfo* \fIrPtr\fR);
+.CE
+The \fIinterp\fR argument is the interpreter performing the resolution;
+\fIname\fR is the variable name being resolved; \fIlength\fR is the
+number of bytes in \fIname\fR, which is not a null-terminated
+string; and \fIcontext\fR is the namespace context containing the
+variable reference.
+.PP
+If this procedure recognizes the variable \fIname\fR, it should
+return some information characterizing the variable in the
+\fIrPtr\fR structure. This structure is defined as follows:
+.CS
+typedef struct Tcl_ResolvedVarInfo {
+ ClientData \fIidentity\fR;
+ Tcl_ResolveRuntimeVarProc *\fIfetchProc\fR;
+ Tcl_ResolveVarDeleteProc *\fIdeleteProc\fR;
+} Tcl_ResolvedVarInfo;
+.CE
+The \fIidentity\fR field is an arbitrary value that characterizes
+the variable. Each variable should have a unique identity. Each
+time the compiled code is executed, Tcl will call the \fIfetchProc\fR
+procedure to get the actual variable for a particular \fIidentity\fR
+value. This callback procedure must conform to the following type:
+.CS
+typedef Tcl_Var Tcl_ResolveRuntimeVarProc(Tcl_Interp* \fIinterp\fR,
+ ClientData \fIidentity\fR);
+.CE
+The \fIfetchProc\fR procedure takes the \fIinterp\fR interpreter
+and the \fIidentity\fR from compile time and returns a Tcl_Var
+token representing the variable. If for some reason the variable
+can't be found, this procedure should return NULL, and Tcl will
+create a local variable within the call frame of the procedure
+being executed.
+.PP
+When the compiled code is discarded, Tcl calls the \fIdeleteProc\fR
+procedure to release the \fIidentity\fR data. The delete procedure
+must conform to the following type:
+.CS
+typedef void Tcl_ResolveVarDeleteProc(ClientData \fIidentity\fR);
+.CE
+.PP
+In general, the \fIvarProc\fR and \fIcompiledVarProc\fR procedures
+should \fIboth\fR be defined. If the \fIcompiledVarProc\fR is not
+defined, then Tcl will create local variables for any variable
+names that are not recognized within a procedure. If the \fIvarProc\fR
+is not defined, then Tcl will not recognize variables that are
+encountered at runtime. For example, consider the following procedure:
+.CS
+proc foo {args} {
+ set anotherRef "1"
+ set name "another"
+ set ${name}Ref "2"
+}
+.CE
+Suppose that the \fIcompiledVarProc\fR resolves the name
+\fBanotherRef\fR at compile time. The name \fB${name}Ref\fR
+can't be resolved at compile time, so the resolution of that
+name is deferred to run time. If the \fIvarProc\fR procedure
+must intercept the name \fBanotherRef\fR at run time and
+supply the appropriate variable.
+
+.SH KEYWORDS
+interpreter, namespace, resolution
diff --git a/itcl/itcl/doc/body.n b/itcl/itcl/doc/body.n
new file mode 100644
index 00000000000..a01470140fe
--- /dev/null
+++ b/itcl/itcl/doc/body.n
@@ -0,0 +1,124 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH body n 3.0 itcl "[incr\ Tcl]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+body \- change the body for a class method/proc
+.SH SYNOPSIS
+\fBbody \fIclassName\fB::\fIfunction args body\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBbody\fR command is used outside of an \fB[incr\ Tcl]\fR
+class definition to define or redefine the body of a class
+method or proc. This facility allows a class definition
+to have separate "interface" and "implementation" parts.
+The "interface" part is a \fBclass\fR command with declarations
+for methods, procs, instance variables and common variables.
+The "implementation" part is a series of \fBbody\fR and
+\fBconfigbody\fR commands. If the "implementation" part
+is kept in a separate file, it can be sourced again and
+again as bugs are fixed, to support interactive development.
+When using the "tcl" mode in the \fBemacs\fR editor, the
+"interface" and "implementation" parts can be kept in the
+same file; as bugs are fixed, individual bodies can be
+highlighted and sent to the test application.
+.PP
+The name "\fIclassName\fB::\fIfunction\fR"
+identifies the method/proc being changed.
+.PP
+If an \fIargs\fR list was specified when the \fIfunction\fR was
+defined in the class definition, the \fIargs\fR list for the
+\fBbody\fR command must match in meaning. Variable names
+can change, but the argument lists must have the same required
+arguments and the same default values for optional arguments.
+The special \fBargs\fR argument acts as a wildcard when included
+in the \fIargs\fR list in the class definition; it will match
+zero or more arguments of any type when the body is redefined.
+.PP
+If the \fIbody\fR string starts with "\fB@\fR", it is treated
+as the symbolic name for a C procedure. The \fIargs\fR list
+has little meaning for the C procedure, except to document
+the expected usage. (The C procedure is not guaranteed to
+use arguments in this manner.) If \fIbody\fR does not start
+with "\fB@\fR", it is treated as a Tcl command script. When
+the function is invoked, command line arguments are matched
+against the \fIargs\fR list, and local variables are created
+to represent each argument. This is the usual behavior for
+a Tcl-style proc.
+.PP
+Symbolic names for C procedures are established by registering
+procedures via \fBItcl_RegisterC()\fR. This is usually done
+in the \fBTcl_AppInit()\fR procedure, which is automatically called
+when the interpreter starts up. In the following example,
+the procedure \fCMy_FooCmd()\fR is registered with the
+symbolic name "foo". This procedure can be referenced in
+the \fBbody\fR command as "\fC@foo\fR".
+.CS
+int
+Tcl_AppInit(interp)
+ Tcl_Interp *interp; /* Interpreter for application. */
+{
+ if (Itcl_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (Itcl_RegisterC(interp, "foo", My_FooCmd) != TCL_OK) {
+ return TCL_ERROR;
+ }
+}
+.CE
+
+.SH EXAMPLE
+In the following example, a "File" class is defined to represent
+open files. The method bodies are included below the class
+definition via the \fBbody\fR command. Note that the bodies
+of the constructor/destructor must be included in the class
+definition, but they can be redefined via the \fBbody\fR command
+as well.
+.CS
+class File {
+ private variable fid ""
+ constructor {name access} {
+ set fid [open $name $access]
+ }
+ destructor {
+ close $fid
+ }
+
+ method get {}
+ method put {line}
+ method eof {}
+}
+
+body File::get {} {
+ return [gets $fid]
+}
+body File::put {line} {
+ puts $fid $line
+}
+body File::eof {} {
+ return [::eof $fid]
+}
+
+#
+# See the File class in action:
+#
+File x /etc/passwd "r"
+while {![x eof]} {
+ puts "=> [x get]"
+}
+delete object x
+.CE
+
+.SH KEYWORDS
+class, object, procedure
diff --git a/itcl/itcl/doc/class.n b/itcl/itcl/doc/class.n
new file mode 100644
index 00000000000..16f84f8aaa7
--- /dev/null
+++ b/itcl/itcl/doc/class.n
@@ -0,0 +1,490 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH class n "" itcl "[incr\ Tcl]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+class \- create a class of objects
+.SH SYNOPSIS
+\fBclass \fIclassName\fR \fB{
+.br
+ \fBinherit \fIbaseClass\fR ?\fIbaseClass\fR...?
+.br
+ \fBconstructor \fIargs\fR ?\fIinit\fR? \fIbody\fR
+.br
+ \fBdestructor \fIbody\fR
+.br
+ \fBmethod \fIname\fR ?\fIargs\fR? ?\fIbody\fR?
+.br
+ \fBproc \fIname ?\fIargs\fR? ?\fIbody\fR?
+.br
+ \fBvariable \fIvarName\fR ?\fIinit\fR? ?\fIconfig\fR?
+.br
+ \fBcommon \fIvarName\fR ?\fIinit\fR?
+.sp
+ \fBpublic \fIcommand\fR ?\fIarg arg ...\fR?
+.br
+ \fBprotected \fIcommand\fR ?\fIarg arg ...\fR?
+.br
+ \fBprivate \fIcommand\fR ?\fIarg arg ...\fR?
+.sp
+ \fBset \fIvarName\fR ?\fIvalue\fR?
+.br
+ \fBarray \fIoption\fR ?\fIarg arg ...\fR?
+.br
+\fB}\fR
+.sp
+\fIclassName objName\fR ?\fIarg arg ...\fR?
+.sp
+\fIobjName method\fR ?\fIarg arg ...\fR?
+.sp
+\fIclassName::proc ?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The fundamental construct in \fB[incr\ Tcl]\fR is the class definition.
+Each class acts as a template for actual objects that can be created.
+The class itself is a namespace which contains things common to all
+objects. Each object has its own unique bundle of data which contains
+instances of the "variables" defined in the class definition. Each
+object also has a built-in variable named "this", which contains the
+name of the object. Classes can also have "common" data members that
+are shared by all objects in a class.
+.PP
+Two types of functions can be included in the class definition.
+"Methods" are functions which operate on a specific object, and
+therefore have access to both "variables" and "common" data members.
+"Procs" are ordinary procedures in the class namespace, and only
+have access to "common" data members.
+.PP
+If the body of any method or proc starts with "\fB@\fR", it is treated
+as the symbolic name for a C procedure. Otherwise, it is treated as
+a Tcl code script. See below for details on registering and using
+C procedures.
+.PP
+A class can only be defined once, although the bodies of class
+methods and procs can be defined again and again for interactive
+debugging. See the \fBbody\fR and \fBconfigbody\fR commands for
+details.
+.PP
+Each namespace can have its own collection of objects and classes.
+The list of classes available in the current context can be queried
+using the "\fBitcl::find classes\fR" command, and the list of objects,
+with the "\fBitcl::find objects\fR" command.
+.PP
+A class can be deleted using the "\fBdelete class\fR" command.
+Individual objects can be deleted using the "\fBdelete object\fR"
+command.
+
+.SH CLASS DEFINITIONS
+.TP
+\fBclass \fIclassName definition\fR
+Provides the definition for a class named \fIclassName\fR. If
+the class \fIclassName\fR already exists, or if a command called
+\fIclassName\fR exists in the current namespace context, this
+command returns an error. If the class definition is successfully
+parsed, \fIclassName\fR becomes a command in the current context,
+handling the creation of objects for this class.
+.PP
+The class \fIdefinition\fR is evaluated as a series of Tcl
+statements that define elements within the class. The following
+class definition commands are recognized:
+.RS
+.TP
+\fBinherit \fIbaseClass\fR ?\fIbaseClass\fR...?
+Causes the current class to inherit characteristics from one or
+more base classes. Classes must have been defined by a previous
+\fBclass\fR command, or must be available to the auto-loading
+facility (see "AUTO-LOADING" below). A single class definition
+can contain no more than one \fBinherit\fR command.
+.sp
+The order of \fIbaseClass\fR names in the \fBinherit\fR list
+affects the name resolution for class members. When the same
+member name appears in two or more base classes, the base class
+that appears first in the \fBinherit\fR list takes precedence.
+For example, if classes "Foo" and "Bar" both contain the member
+"x", and if another class has the "\fBinherit\fR" statement:
+.CS
+inherit Foo Bar
+.CE
+then the name "x" means "Foo::x". Other inherited members named
+"x" must be referenced with their explicit name, like "Bar::x".
+.TP
+\fBconstructor \fIargs\fR ?\fIinit\fR? \fIbody\fR
+Declares the \fIargs\fR argument list and \fIbody\fR used for
+the constructor, which is automatically invoked whenever an
+object is created.
+.sp
+Before the \fIbody\fR is executed, the
+optional \fIinit\fR statement is used to invoke any base class
+constructors that require arguments. Variables in the \fIargs\fR
+specification can be accessed in the \fIinit\fR code fragment,
+and passed to base class constructors. After evaluating the
+\fIinit\fR statement, any base class constructors that have
+not been executed are invoked automatically without arguments.
+This ensures that all base classes are fully constructed before
+the constructor \fIbody\fR is executed. By default, this
+scheme causes constructors to be invoked in order from least-
+to most-specific. This is exactly the opposite of the order
+that classes are reported by the \fBinfo heritage\fR command.
+.sp
+If construction is successful, the constructor always returns
+the object name\-regardless of how the \fIbody\fR is defined\-and
+the object name becomes a command in the current namespace context.
+If construction fails, an error message is returned.
+.TP
+\fBdestructor \fIbody\fR
+Declares the \fIbody\fR used for the destructor, which is automatically
+invoked when an object is deleted. If the destructor is successful,
+the object data is destroyed and the object name is removed as a command
+from the interpreter. If destruction fails, an error message is returned
+and the object remains.
+.sp
+When an object is destroyed, all destructors in its class hierarchy
+are invoked in order from most- to least-specific. This is the
+order that the classes are reported by the "\fBinfo heritage\fR"
+command, and it is exactly the opposite of the default constructor
+order.
+.TP
+\fBmethod \fIname\fR ?\fIargs\fR? ?\fIbody\fR?
+Declares a method called \fIname\fR. When the method \fIbody\fR is
+executed, it will have automatic access to object-specific variables
+and common data members.
+.sp
+If the \fIargs\fR list is specified, it establishes the usage
+information for this method. The \fBbody\fR command can be used
+to redefine the method body, but the \fIargs\fR list must match
+this specification.
+.sp
+Within the body of another class method, a method can be invoked
+like any other command\-simply by using its name. Outside of the
+class context, the method name must be prefaced an object name,
+which provides the context for the data that it manipulates.
+Methods in a base class that are redefined in the current class,
+or hidden by another base class, can be qualified using the
+"\fIclassName\fR::\fImethod\fR" syntax.
+.TP
+\fBproc \fIname\fR ?\fIargs\fR? ?\fIbody\fR?
+Declares a proc called \fIname\fR. A proc is an ordinary procedure
+within the class namespace. Unlike a method, a proc is invoked
+without referring to a specific object. When the proc \fIbody\fR is
+executed, it will have automatic access only to common data members.
+.sp
+If the \fIargs\fR list is specified, it establishes the usage
+information for this proc. The \fBbody\fR command can be used
+to redefine the proc body, but the \fIargs\fR list must match
+this specification.
+.sp
+Within the body of another class method or proc, a proc can be
+invoked like any other command\-simply by using its name.
+In any other namespace context, the proc is invoked using a
+qualified name like "\fIclassName\fB::\fIproc\fR". Procs in
+a base class that are redefined in the current class, or hidden
+by another base class, can also be accessed via their qualified
+name.
+.TP
+\fBvariable \fIvarName\fR ?\fIinit\fR? ?\fIconfig\fR?
+Defines an object-specific variable named \fIvarName\fR. All
+object-specific variables are automatically available in class
+methods. They need not be declared with anything like the
+\fBglobal\fR command.
+.sp
+If the optional \fIinit\fR string is specified, it is used as the
+initial value of the variable when a new object is created.
+Initialization forces the variable to be a simple scalar
+value; uninitialized variables, on the other hand, can be set
+within the constructor and used as arrays.
+.sp
+The optional \fIconfig\fR script is only allowed for public variables.
+If specified, this code fragment is executed whenever a public
+variable is modified by the built-in "configure" method. The
+\fIconfig\fR script can also be specified outside of the class
+definition using the \fBconfigbody\fR command.
+.TP
+\fBcommon \fIvarName\fR ?\fIinit\fR?
+Declares a common variable named \fIvarName\fR. Common variables
+reside in the class namespace and are shared by all objects belonging
+to the class. They are just like global variables, except that
+they need not be declared with the usual \fBglobal\fR command.
+They are automatically visible in all class methods and procs.
+.sp
+If the optional \fIinit\fR string is specified, it is used as the
+initial value of the variable. Initialization forces the variable
+to be a simple scalar value; uninitialized variables, on the other
+hand, can be set with subsequent \fBset\fR and \fBarray\fR commands
+and used as arrays.
+.sp
+Once a common data member has been defined, it can be set using
+\fBset\fR and \fBarray\fR commands within the class definition.
+This allows common data members to be initialized as arrays.
+For example:
+.CS
+class Foo {
+ common boolean
+ set boolean(true) 1
+ set boolean(false) 0
+}
+.CE
+Note that if common data members are initialized within the
+constructor, they get initialized again and again whenever new
+objects are created.
+.TP
+\fBpublic \fIcommand\fR ?\fIarg arg ...\fR?
+.TP
+\fBprotected \fIcommand\fR ?\fIarg arg ...\fR?
+.TP
+\fBprivate \fIcommand\fR ?\fIarg arg ...\fR?
+These commands are used to set the protection level for class
+members that are created when \fIcommand\fR is evaluated.
+The \fIcommand\fR is usually \fBmethod\fR, \fBproc\fR,
+\fBvariable\fR or\fBcommon\fR, and the remaining \fIarg\fR's
+complete the member definition. However, \fIcommand\fR can
+also be a script containing many different member definitions,
+and the protection level will apply to all of the members
+that are created.
+
+.SH CLASS USAGE
+.PP
+Once a class has been defined, the class name can be used as a
+command to create new objects belonging to the class.
+.TP
+\fIclassName objName\fR ?\fIargs...\fR?
+Creates a new object in class \fIclassName\fR with the name \fIobjName\fR.
+Remaining arguments are passed to the constructor of the most-specific
+class. This in turn passes arguments to base class constructors before
+invoking its own body of commands. If construction is successful, a
+command called \fIobjName\fR is created in the current namespace context,
+and \fIobjName\fR is returned as the result of this operation.
+If an error is encountered during construction, the destructors are
+automatically invoked to free any resources that have been allocated,
+the object is deleted, and an error is returned.
+.sp
+If \fIobjName\fR contains the string "\fB#auto\fR", that string is
+replaced with an automatically generated name. Names have the
+form \fIclassName<number>\fR, where the \fIclassName\fR part is
+modified to start with a lowercase letter. In class "Toaster",
+for example, the "\fB#auto\fR" specification would produce names
+like toaster0, toaster1, etc. Note that "\fB#auto\fR" can be
+also be buried within an object name:
+.CS
+fileselectiondialog .foo.bar.#auto -background red
+.CE
+This would generate an object named ".foo.bar.fileselectiondialog0".
+
+.SH OBJECT USAGE
+Once an object has been created, the object name can be used
+as a command to invoke methods that operate on the object.
+.TP
+\fIobjName method\fR ?\fIargs...\fR?
+Invokes a method named \fImethod\fR on an object named \fIobjName\fR.
+Remaining arguments are passed to the argument list for the
+method. The method name can be "constructor", "destructor",
+any method name appearing in the class definition, or any of
+the following built-in methods.
+.SH BUILT-IN METHODS
+.TP
+\fIobjName\fR \fBcget option\fR
+Provides access to public variables as configuration options. This
+mimics the behavior of the usual "cget" operation for Tk widgets.
+The \fIoption\fR argument is a string of the form "\fB-\fIvarName\fR",
+and this method returns the current value of the public variable
+\fIvarName\fR.
+.TP
+\fIobjName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Provides access to public variables as configuration options. This
+mimics the behavior of the usual "configure" operation for Tk widgets.
+With no arguments, this method returns a list of lists describing
+all of the public variables. Each list has three elements: the
+variable name, its initial value and its current value.
+.sp
+If a single \fIoption\fR of the form "\fB-\fIvarName\fR" is specified,
+then this method returns the information for that one variable.
+.sp
+Otherwise, the arguments are treated as \fIoption\fR/\fIvalue\fR
+pairs assigning new values to public variables. Each variable
+is assigned its new value, and if it has any "config" code associated
+with it, it is executed in the context of the class where it was
+defined. If the "config" code generates an error, the variable
+is set back to its previous value, and the \fBconfigure\fR method
+returns an error.
+.TP
+\fIobjName\fR \fBisa \fIclassName\fR
+Returns non-zero if the given \fIclassName\fR can be found in the
+object's heritage, and zero otherwise.
+.TP
+\fIobjName\fR \fBinfo \fIoption\fR ?\fIargs...\fR?
+Returns information related to a particular object named
+\fIobjName\fR, or to its class definition. The \fIoption\fR
+parameter includes the following things, as well as the options
+recognized by the usual Tcl "info" command:
+.RS
+.TP
+\fIobjName\fR \fBinfo class\fR
+Returns the name of the most-specific class for object \fIobjName\fR.
+.TP
+\fIobjName\fR \fBinfo inherit\fR
+Returns the list of base classes as they were defined in the
+"\fBinherit\fR" command, or an empty string if this class
+has no base classes.
+.TP
+\fIobjName\fR \fBinfo heritage\fR
+Returns the current class name and the entire list of base classes
+in the order that they are traversed for member lookup and object
+destruction.
+.TP
+\fIobjName\fR \fBinfo function\fR ?\fIcmdName\fR? ?\fB-protection\fR? ?\fB-type\fR? ?\fB-name\fR? ?\fB-args\fR? ?\fB-body\fR?
+With no arguments, this command returns a list of all class methods
+and procs. If \fIcmdName\fR is specified, it returns information
+for a specific method or proc. If no flags are specified, this
+command returns a list with the following elements: the protection
+level, the type (method/proc), the qualified name, the argument list
+and the body. Flags can be used to request specific elements from
+this list.
+.TP
+\fIobjName\fR \fBinfo variable\fR ?\fIvarName\fR? ?\fB-protection\fR? ?\fB-type\fR? ?\fB-name\fR? ?\fB-init\fR? ?\fB-value\fR? ?\fB-config\fR?
+With no arguments, this command returns a list of all object-specific
+variables and common data members. If \fIvarName\fR is specified, it
+returns information for a specific data member. If no flags are
+specified, this command returns a list with the following elements: the
+protection level, the type (variable/common), the qualified name, the
+initial value, and the current value. If \fIvarName\fR is a public
+variable, the "config" code is included on this list. Flags can be
+used to request specific elements from this list.
+
+.SH CHAINING METHODS/PROCS
+Sometimes a base class has a method or proc that is redefined with
+the same name in a derived class. This is a way of making the
+derived class handle the same operations as the base class, but
+with its own specialized behavior. For example, suppose we have
+a Toaster class that looks like this:
+.CS
+class Toaster {
+ variable crumbs 0
+ method toast {nslices} {
+ if {$crumbs > 50} {
+ error "== FIRE! FIRE! =="
+ }
+ set crumbs [expr $crumbs+4*$nslices]
+ }
+ method clean {} {
+ set crumbs 0
+ }
+}
+.CE
+We might create another class like SmartToaster that redefines
+the "toast" method. If we want to access the base class method,
+we can qualify it with the base class name, to avoid ambiguity:
+.CS
+class SmartToaster {
+ inherit Toaster
+ method toast {nslices} {
+ if {$crumbs > 40} {
+ clean
+ }
+ return [Toaster::toast $nslices]
+ }
+}
+.CE
+Instead of hard-coding the base class name, we can use the
+"chain" command like this:
+.CS
+class SmartToaster {
+ inherit Toaster
+ method toast {nslices} {
+ if {$crumbs > 40} {
+ clean
+ }
+ return [chain $nslices]
+ }
+}
+.CE
+The chain command searches through the class hierarchy for
+a slightly more generic (base class) implementation of a method
+or proc, and invokes it with the specified arguments. It starts
+at the current class context and searches through base classes
+in the order that they are reported by the "info heritage" command.
+If another implementation is not found, this command does nothing
+and returns the null string.
+
+.SH AUTO-LOADING
+.PP
+Class definitions need not be loaded explicitly; they can be loaded as
+needed by the usual Tcl auto-loading facility. Each directory containing
+class definition files should have an accompanying "tclIndex" file.
+Each line in this file identifies a Tcl procedure or \fB[incr\ Tcl]\fR
+class definition and the file where the definition can be found.
+.PP
+For example, suppose a directory contains the definitions for classes
+"Toaster" and "SmartToaster". Then the "tclIndex" file for this
+directory would look like:
+.CS
+# Tcl autoload index file, version 2.0 for [incr Tcl]
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(::Toaster) "source $dir/Toaster.itcl"
+set auto_index(::SmartToaster) "source $dir/SmartToaster.itcl"
+.PP
+The \fBauto_mkindex\fR command is used to automatically
+generate "tclIndex" files.
+.CE
+The auto-loader must be made aware of this directory by appending
+the directory name to the "auto_path" variable. When this is in
+place, classes will be auto-loaded as needed when used in an
+application.
+
+.SH C PROCEDURES
+.PP
+C procedures can be integrated into an \fB[incr\ Tcl]\fR class
+definition to implement methods, procs, and the "config" code
+for public variables. Any body that starts with "\fB@\fR"
+is treated as the symbolic name for a C procedure.
+.PP
+Symbolic names are established by registering procedures via
+\fBItcl_RegisterC()\fR. This is usually done in the \fBTcl_AppInit()\fR
+procedure, which is automatically called when the interpreter starts up.
+In the following example, the procedure \fCMy_FooCmd()\fR is registered
+with the symbolic name "foo". This procedure can be referenced in
+the \fBbody\fR command as "\fC@foo\fR".
+.CS
+int
+Tcl_AppInit(interp)
+ Tcl_Interp *interp; /* Interpreter for application. */
+{
+ if (Itcl_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (Itcl_RegisterC(interp, "foo", My_FooCmd) != TCL_OK) {
+ return TCL_ERROR;
+ }
+}
+.CE
+C procedures are implemented just like ordinary Tcl commands.
+See the \fBCrtCommand\fR man page for details. Within the procedure,
+class data members can be accessed like ordinary variables
+using \fBTcl_SetVar()\fR, \fBTcl_GetVar()\fR, \fBTcl_TraceVar()\fR,
+etc. Class methods and procs can be executed like ordinary commands
+using \fBTcl_Eval()\fR. \fB[incr\ Tcl]\fR makes this possible by
+automatically setting up the context before executing the C procedure.
+.PP
+This scheme provides a natural migration path for code development.
+Classes can be developed quickly using Tcl code to implement the
+bodies. An entire application can be built and tested. When
+necessary, individual bodies can be implemented with C code to
+improve performance.
+
+.SH KEYWORDS
+class, object, object-oriented
diff --git a/itcl/itcl/doc/code.n b/itcl/itcl/doc/code.n
new file mode 100644
index 00000000000..294ba7a41cd
--- /dev/null
+++ b/itcl/itcl/doc/code.n
@@ -0,0 +1,96 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH code n 3.0 itcl "[incr\ Tcl]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+code \- capture the namespace context for a code fragment
+.SH SYNOPSIS
+\fBcode \fR?\fB-namespace \fIname\fR? \fIcommand \fR?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+Creates a scoped value for the specified \fIcommand\fR and its
+associated \fIarg\fR arguments. A scoped value is a list with three
+elements: the "\fC@scope\fR" keyword, a namespace context,
+and a value string. For example, the command
+.CS
+namespace foo {
+ code puts "Hello World!"
+}
+.CE
+produces the scoped value:
+.CS
+@scope ::foo {puts {Hello World!}}
+.CE
+Note that the \fBcode\fR command captures the current namespace
+context. If the \fB-namespace\fR flag is specified, then the
+current context is ignored, and the \fIname\fR string is used
+as the namespace context.
+.PP
+Extensions like Tk execute ordinary code fragments in the global
+namespace. A scoped value captures a code fragment together with
+its namespace context in a way that allows it to be executed
+properly later. It is needed, for example, to wrap up code fragments
+when a Tk widget is used within a namespace:
+.CS
+namespace foo {
+ private proc report {mesg} {
+ puts "click: $mesg"
+ }
+
+ button .b1 -text "Push Me" \
+ -command [code report "Hello World!"]
+ pack .b1
+}
+.CE
+The code fragment associated with button \fC.b1\fR only makes
+sense in the context of namespace "foo". Furthermore, the
+"report" procedure is private, and can only be accessed within
+that namespace. The \fBcode\fR command wraps up the code
+fragment in a way that allows it to be executed properly
+when the button is pressed.
+.PP
+Also, note that the \fBcode\fR command preserves the integrity
+of arguments on the command line. This makes it a natural replacement
+for the \fBlist\fR command, which is often used to format Tcl code
+fragments. In other words, instead of using the \fBlist\fR command
+like this:
+.CS
+after 1000 [list puts "Hello $name!"]
+.CE
+use the \fBcode\fR command like this:
+.CS
+after 1000 [code puts "Hello $name!"]
+.CE
+This not only formats the command correctly, but also captures
+its namespace context.
+.PP
+Scoped commands can be invoked like ordinary code fragments, with
+or without the \fBeval\fR command. For example, the following
+statements work properly:
+.CS
+set cmd {@scope ::foo .b1}
+$cmd configure -background red
+
+set opts {-bg blue -fg white}
+eval $cmd configure $opts
+.CE
+Note that scoped commands by-pass the usual protection mechanisms;
+the command:
+.CS
+@scope ::foo {report {Hello World!}}
+.CE
+can be used to access the "foo::report" proc from any namespace
+context, even though it is private.
+
+.SH KEYWORDS
+scope, callback, namespace, public, protected, private
diff --git a/itcl/itcl/doc/configbody.n b/itcl/itcl/doc/configbody.n
new file mode 100644
index 00000000000..51760cf686d
--- /dev/null
+++ b/itcl/itcl/doc/configbody.n
@@ -0,0 +1,129 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH configbody n 3.0 itcl "[incr\ Tcl]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+configbody \- change the "config" code for a public variable
+.SH SYNOPSIS
+\fBconfigbody \fIclassName\fB::\fIvarName body\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBconfigbody\fR command is used outside of an \fB[incr\ Tcl]\fR
+class definition to define or redefine the configuration code
+associated with a public variable. Public variables act like
+configuration options for an object. They can be modified
+outside the class scope using the built-in \fBconfigure\fR method.
+Each variable can have a bit of "config" code associate with it
+that is automatically executed when the variable is configured.
+The \fBconfigbody\fR command can be used to define or redefine
+this body of code.
+.PP
+Like the \fBbody\fR command, this facility allows a class definition
+to have separate "interface" and "implementation" parts.
+The "interface" part is a \fBclass\fR command with declarations
+for methods, procs, instance variables and common variables.
+The "implementation" part is a series of \fBbody\fR and
+\fBconfigbody\fR commands. If the "implementation" part
+is kept in a separate file, it can be sourced again and
+again as bugs are fixed, to support interactive development.
+When using the "tcl" mode in the \fBemacs\fR editor, the
+"interface" and "implementation" parts can be kept in the
+same file; as bugs are fixed, individual bodies can be
+highlighted and sent to the test application.
+.PP
+The name "\fIclassName\fB::\fIvarName\fR"
+identifies the public variable being updated.
+If the \fIbody\fR string starts with "\fB@\fR", it is treated
+as the symbolic name for a C procedure. Otherwise, it is
+treated as a Tcl command script.
+.PP
+Symbolic names for C procedures are established by registering
+procedures via \fBItcl_RegisterC()\fR. This is usually done
+in the \fBTcl_AppInit()\fR procedure, which is automatically called
+when the interpreter starts up. In the following example,
+the procedure \fCMy_FooCmd()\fR is registered with the
+symbolic name "foo". This procedure can be referenced in
+the \fBconfigbody\fR command as "\fC@foo\fR".
+.CS
+int
+Tcl_AppInit(interp)
+ Tcl_Interp *interp; /* Interpreter for application. */
+{
+ if (Itcl_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (Itcl_RegisterC(interp, "foo", My_FooCmd) != TCL_OK) {
+ return TCL_ERROR;
+ }
+}
+.CE
+
+.SH EXAMPLE
+In the following example, a "File" class is defined to represent
+open files. Whenever the "-name" option is configured, the
+existing file is closed, and a new file is opened. Note that
+the "config" code for a public variable is optional. The "-access"
+option, for example, does not have it.
+.CS
+class File {
+ private variable fid ""
+
+ public variable name ""
+ public variable access "r"
+
+ constructor {args} {
+ eval configure $args
+ }
+ destructor {
+ if {$fid != ""} {
+ close $fid
+ }
+ }
+
+ method get {}
+ method put {line}
+ method eof {}
+}
+
+body File::get {} {
+ return [gets $fid]
+}
+body File::put {line} {
+ puts $fid $line
+}
+body File::eof {} {
+ return [::eof $fid]
+}
+
+configbody File::name {
+ if {$fid != ""} {
+ close $fid
+ }
+ set fid [open $name $access]
+}
+
+#
+# See the File class in action:
+#
+File x
+
+x configure -name /etc/passwd
+while {![x eof]} {
+ puts "=> [x get]"
+}
+delete object x
+.CE
+
+.SH KEYWORDS
+class, object, variable, configure
diff --git a/itcl/itcl/doc/delete.n b/itcl/itcl/doc/delete.n
new file mode 100644
index 00000000000..709b2e13ab3
--- /dev/null
+++ b/itcl/itcl/doc/delete.n
@@ -0,0 +1,64 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH delete n 3.0 itcl "[incr\ Tcl]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+delete \- delete things in the interpreter
+.SH SYNOPSIS
+\fBdelete \fIoption\fR ?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBdelete\fR command is used to delete things in the interpreter.
+It is implemented as an ensemble, so extensions can add their own
+options and extend the behavior of this command. By default, the
+\fBdelete\fR command handles the destruction of namespaces.
+.PP
+The \fIoption\fR argument determines what action is carried out
+by the command. The legal \fIoptions\fR (which may be abbreviated)
+are:
+.TP
+\fBdelete class \fIname\fR ?\fIname...\fR?
+Deletes one or more \fB[incr\ Tcl]\fR classes called \fIname\fR.
+This deletes all objects in the class, and all derived classes
+as well.
+.sp
+If an error is encountered while destructing an object, it will
+prevent the destruction of the class and any remaining objects.
+To destroy the entire class without regard for errors, use the
+"\fBdelete namespace\fR" command.
+.TP
+\fBdelete object \fIname\fR ?\fIname...\fR?
+Deletes one or more \fB[incr\ Tcl]\fR objects called \fIname\fR.
+An object is deleted by invoking all destructors in its class
+hierarchy, in order from most- to least-specific. If all destructors
+are successful, data associated with the object is deleted and
+the \fIname\fR is removed as a command from the interpreter.
+.sp
+If the access command for an object resides in another namespace,
+then its qualified name can be used:
+.CS
+delete object foo::bar::x
+.CE
+If an error is encountered while destructing an object, the
+\fBdelete\fR command is aborted and the object remains alive.
+To destroy an object without regard for errors, use the
+"\fBrename\fR" command to destroy the object access command.
+.TP
+\fBdelete namespace \fIname\fR ?\fIname...\fR?
+Deletes one or more namespaces called \fIname\fR. This deletes
+all commands and variables in the namespace, and deletes all
+child namespaces as well. When a namespace is deleted, it is
+automatically removed from the import lists of all other namespaces.
+
+.SH KEYWORDS
+namespace, proc, variable, ensemble
diff --git a/itcl/itcl/doc/ensemble.n b/itcl/itcl/doc/ensemble.n
new file mode 100644
index 00000000000..58e9adacf11
--- /dev/null
+++ b/itcl/itcl/doc/ensemble.n
@@ -0,0 +1,173 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH ensemble n 3.0 itcl "[incr\ Tcl]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+ensemble \- create or modify a composite command
+.SH SYNOPSIS
+\fBensemble \fIensName\fR ?\fIcommand arg arg...\fR?
+.br
+or
+.br
+\fBensemble \fIensName\fR {
+.br
+ \fBpart \fIpartName args body\fR
+.br
+ \fI...\fR
+.br
+ \fBensemble \fIpartName\fR {
+.br
+ \fBpart \fIsubPartName args body\fR
+.br
+ \fBpart \fIsubPartName args body\fR
+.br
+ \fI...\fR
+ }
+.br
+}
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBensemble\fR command is used to create or modify a composite
+command. See the section \fBWHAT IS AN ENSEMBLE?\fR below for a
+brief overview of ensembles.
+.PP
+If the \fBensemble\fR command finds an existing ensemble called
+\fIensName\fR, it updates that ensemble. Otherwise, it creates an
+ensemble called \fIensName\fR. If the \fIensName\fR is a simple name
+like "foo", then an ensemble command named "foo" is added to the
+current namespace context. If a command named "foo" already exists
+in that context, then it is deleted. If the \fIensName\fR contains
+namespace qualifiers like "a::b::foo", then the namespace path is
+resolved, and the ensemble command is added that namespace context.
+Parent namespaces like "a" and "b" are created automatically, as needed.
+.PP
+If the \fIensName\fR contains spaces like "a::b::foo bar baz", then
+additional words like "bar" and "baz" are treated as sub-ensembles.
+Sub-ensembles are merely parts within an ensemble; they do not have
+a Tcl command associated with them. An ensemble like "foo" can
+have a sub-ensemble called "foo bar", which in turn can have a
+sub-ensemble called "foo bar baz". In this case, the sub-ensemble
+"foo bar" must be created before the sub-ensemble "foo bar baz"
+that resides within it.
+.PP
+If there are any arguments following \fIensName\fR, then they are
+treated as commands, and they are executed to update the ensemble.
+The following commands are recognized in this context: \fBpart\fR
+and \fBensemble\fR.
+.PP
+The \fBpart\fR command defines a new part for the ensemble.
+Its syntax is identical to the usual \fBproc\fR command, but
+it defines a part within an ensemble, instead of a Tcl command.
+If a part called \fIpartName\fR already exists within the ensemble,
+then the \fBpart\fR command returns an error.
+.PP
+The \fBensemble\fR command can be nested inside another \fBensemble\fR
+command to define a sub-ensemble.
+
+.SH "WHAT IS AN ENSEMBLE?"
+The usual "info" command is a composite command--the command name
+\fBinfo\fR must be followed by a sub-command like \fBbody\fR or \fBglobals\fR.
+We will refer to a command like \fBinfo\fR as an \fIensemble\fR, and to
+sub-commands like \fBbody\fR or \fBglobals\fR as its \fIparts\fR.
+.PP
+Ensembles can be nested. For example, the \fBinfo\fR command has
+an ensemble \fBinfo namespace\fR within it. This ensemble has parts
+like \fBinfo namespace all\fR and \fBinfo namespace children\fR.
+.PP
+With ensembles, composite commands can be created and extended
+in an automatic way. Any package can find an existing ensemble
+and add new parts to it. So extension writers can add their
+own parts, for example, to the \fBinfo\fR command.
+.PP
+The ensemble facility manages all of the part names and keeps
+track of unique abbreviations. Normally, you can abbreviate
+\fBinfo complete\fR to \fBinfo comp\fR. But if an extension adds the
+part \fBinfo complexity\fR, the minimum abbreviation for \fBinfo complete\fR
+becomes \fBinfo complet\fR.
+.PP
+The ensemble facility not only automates the construction of
+composite commands, but it automates the error handling as well.
+If you invoke an ensemble command without specifying a part name,
+you get an automatically generated error message that summarizes
+the usage information. For example, when the \fBinfo\fR command
+is invoked without any arguments, it produces the following error
+message:
+.CS
+wrong # args: should be one of...
+ info args procname
+ info body procname
+ info cmdcount
+ info commands ?pattern?
+ info complete command
+ info context
+ info default procname arg varname
+ info exists varName
+ info globals ?pattern?
+ info level ?number?
+ info library
+ info locals ?pattern?
+ info namespace option ?arg arg ...?
+ info patchlevel
+ info procs ?pattern?
+ info protection ?-command? ?-variable? name
+ info script
+ info tclversion
+ info vars ?pattern?
+ info which ?-command? ?-variable? ?-namespace? name\fR
+.CE
+You can also customize the way an ensemble responds to errors.
+When an ensemble encounters an unspecified or ambiguous part
+name, it looks for a part called \fB@error\fR. If it exists,
+then it is used to handle the error. This part will receive all
+of the arguments on the command line starting with the offending
+part name. It can find another way of resolving the command,
+or generate its own error message.
+
+.SH EXAMPLE
+We could use an ensemble to clean up the syntax of the various
+"wait" commands in Tcl/Tk. Instead of using a series of
+strange commands like this:
+.CS
+vwait x
+tkwait visibility .top
+tkwait window .
+.CE
+we could use commands with a uniform syntax, like this:
+.CS
+wait variable x
+wait visibility .top
+wait window .
+.CE
+The Tcl package could define the following ensemble:
+.CS
+ensemble wait part variable {name} {
+ uplevel vwait $name
+}
+.CE
+The Tk package could add some options to this ensemble, with a
+command like this:
+.CS
+ensemble wait {
+ part visibility {name} {
+ tkwait visibility $name
+ }
+ part window {name} {
+ tkwait window $name
+ }
+}
+.CE
+Other extensions could add their own parts to the \fBwait\fR command
+too.
+
+.SH KEYWORDS
+ensemble, part, info
diff --git a/itcl/itcl/doc/find.n b/itcl/itcl/doc/find.n
new file mode 100644
index 00000000000..154cfbbf50c
--- /dev/null
+++ b/itcl/itcl/doc/find.n
@@ -0,0 +1,62 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH find n 3.0 itcl "[incr\ Tcl]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+find \- search for classes and objects
+.SH SYNOPSIS
+\fBfind \fIoption\fR ?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBfind\fR command is used to find classes and objects
+that are available in the current context. A class or object is
+"available" if its access command can be found in the current
+namespace context or in the global namespace. Therefore,
+classes and objects created in the global namespace are
+available to all other namespaces in a program. Classes and
+objects created in one namespace can also be imported into
+another using the \fBnamespace import\fR command.
+.PP
+The \fIoption\fR argument determines what action is carried out
+by the command. The legal \fIoptions\fR (which may be abbreviated)
+are:
+.TP
+\fBfind classes ?\fIpattern\fR?
+Returns a list of classes found in the current namespace context.
+If the optional \fIpattern\fR is specified, then the reported names
+are compared using the rules of the "\fBstring match\fR" command,
+and only matching names are reported.
+.sp
+If a class resides in the current namespace context, this command
+reports its simple name--without any qualifiers. However, if the
+\fIpattern\fR contains \fB::\fR qualifiers, or if the class resides
+in another context, this command reports its fully-qualified name.
+.TP
+\fBfind objects ?\fIpattern\fR? ?\fB-class \fIclassName\fR? ?\fB-isa \fIclassName\fR?
+Returns a list of objects found in the current namespace context.
+If the optional \fIpattern\fR is specified, then the reported names
+are compared using the rules of the "\fBstring match\fR" command,
+and only matching names are reported.
+If the optional "\fB-class\fR" parameter is specified, this list is
+restricted to objects whose most-specific class is \fIclassName\fR.
+If the optional "\fB-isa\fR" parameter is specified, this list is
+further restricted to objects having the given \fIclassName\fR
+anywhere in their heritage.
+.sp
+If an object resides in the current namespace context, this command
+reports its simple name--without any qualifiers. However, if the
+\fIpattern\fR contains \fB::\fR qualifiers, or if the object resides
+in another context, this command reports its fully-qualified name.
+
+.SH KEYWORDS
+class, object, search, import
diff --git a/itcl/itcl/doc/itcl.n b/itcl/itcl/doc/itcl.n
new file mode 100644
index 00000000000..89e3a4428a7
--- /dev/null
+++ b/itcl/itcl/doc/itcl.n
@@ -0,0 +1,147 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH itcl n 3.0 itcl "[incr\ Tcl]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+itcl \- object-oriented extensions to Tcl
+.BE
+
+.SH DESCRIPTION
+.PP
+\fB[incr\ Tcl]\fR provides object-oriented extensions to Tcl, much as
+C++ provides object-oriented extensions to C. The emphasis of this
+work, however, is not to create a whiz-bang object-oriented
+programming environment. Rather, it is to support more structured
+programming practices in Tcl without changing the flavor of the language.
+More than anything else, \fB[incr\ Tcl]\fR provides a means of
+encapsulating related procedures together with their shared data
+in a namespace that is hidden from the outside world.
+It encourages better programming by promoting the object-oriented
+"library" mindset. It also allows for code re-use through inheritance.
+
+.SH CLASSES
+.PP
+The fundamental construct in \fB[incr\ Tcl]\fR is the class definition.
+Each class acts as a template for actual objects that can be created.
+Each object has its own unique bundle of data, which contains instances
+of the "variables" defined in the class. Special procedures called
+"methods" are used to manipulate individual objects. Methods are just
+like the operations that are used to manipulate Tk widgets. The
+"\fBbutton\fR" widget, for example, has methods such as "flash" and
+"invoke" that cause a particular button to blink and invoke its command.
+.PP
+Within the body of a method, the "variables" defined in the class
+are automatically available. They need not be declared with anything
+like the \fBglobal\fR command. Within another class method, a method
+can be invoked like any other command\-simply by using its name.
+From any other context, the method name must be prefaced by an object
+name, which provides a context for the data that the method can access.
+.PP
+Each class has its own namespace containing things that are common
+to all objects which belong to the class. For example, "common" data
+members are shared by all objects in the class. They are global
+variables that exist in the class namespace, but since they are
+included in the class definition, they need not be declared using
+the \fBglobal\fR command; they are automatically available to any
+code executing in the class context. A class can also create
+ordinary global variables, but these must be declared using the
+\fBglobal\fR command each time they are used.
+.PP
+Classes can also have ordinary procedures declared as "procs".
+Within another class method or proc, a proc can be invoked like
+any other command\-simply by using its name. From any other context,
+the procedure name should be qualified with the class namespace
+like "\fIclassName\fB::\fIproc\fR". Class procs execute in the
+class context, and therefore have automatic access to all "common"
+data members. However, they cannot access object-specific "variables",
+since they are invoked without reference to any specific object.
+They are usually used to perform generic operations which affect
+all objects belonging to the class.
+.PP
+Each of the elements in a class can be declared "public", "protected"
+or "private". Public elements can be accessed by the class, by
+derived classes (other classes that inherit this class), and by
+external clients that use the class. Protected elements can be
+accessed by the class, and by derived classes. Private elements
+are only accessible in the class where they are defined.
+.PP
+The "public" elements within a class define its interface to the
+external world. Public methods define the operations that can
+be used to manipulate an object. Public variables are recognized
+as configuration options by the "configure" and "cget" methods
+that are built into each class. The public interface says
+\fIwhat\fR an object will do but not \fIhow\fR it will do it.
+Protected and private members, along with the bodies of class
+methods and procs, provide the implementation details. Insulating
+the application developer from these details leaves the class designer
+free to change them at any time, without warning, and without affecting
+programs that rely on the class. It is precisely this encapsulation
+that makes object-oriented programs easier to understand and maintain.
+.PP
+The fact that \fB[incr\ Tcl]\fR objects look like Tk widgets is
+no accident. \fB[incr\ Tcl]\fR was designed this way, to blend
+naturally into a Tcl/Tk application. But \fB[incr\ Tcl]\fR
+extends the Tk paradigm from being merely object-based to being
+fully object-oriented. An object-oriented system supports
+inheritance, allowing classes to share common behaviors by
+inheriting them from an ancestor or base class. Having a base
+class as a common abstraction allows a programmer to treat
+related classes in a similar manner. For example, a toaster
+and a blender perform different (specialized) functions, but
+both share the abstraction of being appliances. By abstracting
+common behaviors into a base class, code can be \fIshared\fR rather
+than \fIcopied\fR. The resulting application is easier to
+understand and maintain, and derived classes (e.g., specialized
+appliances) can be added or removed more easily.
+.PP
+This description was merely a brief overview of object-oriented
+programming and \fB[incr\ Tcl]\fR. A more tutorial introduction is
+presented in the paper included with this distribution. See the
+\fBclass\fR command for more details on creating and using classes.
+
+.SH NAMESPACES
+.PP
+\fB[incr\ Tcl]\fR now includes a complete namespace facility.
+A namespace is a collection of commands and global variables that
+is kept apart from the usual global scope. This allows Tcl code
+libraries to be packaged in a well-defined manner, and prevents
+unwanted interactions with other libraries. A namespace can also
+have child namespaces within it, so one library can contain its
+own private copy of many other libraries. A namespace can also
+be used to wrap up a group of related classes. The global scope
+(named "\fC::\fR") is the root namespace for an interpreter; all
+other namespaces are contained within it.
+.PP
+See the \fBnamespace\fR command for details on creating and
+using namespaces.
+
+.SH MEGA-WIDGETS
+.PP
+Mega-widgets are high-level widgets that are constructed using
+Tk widgets as component parts, usually without any C code. A
+fileselectionbox, for example, may have a few listboxes, some
+entry widgets and some control buttons. These individual widgets
+are put together in a way that makes them act like one big
+widget.
+.PP
+\fB[incr\ Tk]\fR is a framework for building mega-widgets. It
+uses \fB[incr\ Tcl]\fR to support the object paradigm, and adds
+base classes which provide default widget behaviors. See the
+\fBitk\fR man page for more details.
+.PP
+\fB[incr\ Widgets]\fR is a library of mega-widgets built using
+\fB[incr\ Tk]\fR. It contains more than 30 different widget
+classes that can be used right out of the box to build Tcl/Tk
+applications. Each widget class has its own man page describing
+the features available.
+
+.SH KEYWORDS
+class, object, object-oriented, namespace, mega-widget
diff --git a/itcl/itcl/doc/itcl_class.n b/itcl/itcl/doc/itcl_class.n
new file mode 100644
index 00000000000..5f571cd3a3a
--- /dev/null
+++ b/itcl/itcl/doc/itcl_class.n
@@ -0,0 +1,419 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH itcl_class n 3.0 itcl "[incr\ Tcl]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+itcl_class \- create a class of objects (obsolete)
+.SH SYNOPSIS
+\fBitcl_class \fIclassName\fR \fB{
+.br
+ \fBinherit \fIbaseClass\fR ?\fIbaseClass\fR...?
+.br
+ \fBconstructor \fIargs\fR ?\fIinit\fR? \fIbody\fR
+.br
+ \fBdestructor \fIbody\fR
+.br
+ \fBmethod \fIname args body\fR
+.br
+ \fBproc \fIname args body\fR
+.br
+ \fBpublic \fIvarName\fR ?\fIinit\fR? ?\fIconfig\fR?
+.br
+ \fBprotected \fIvarName\fR ?\fIinit\fR?
+.br
+ \fBcommon \fIvarName\fR ?\fIinit\fR?
+.br
+\fB}\fR
+.sp
+\fIclassName objName\fR ?\fIargs...\fR?
+.br
+\fIclassName\fR \fB#auto\fR ?\fIargs...\fR?
+.br
+\fIclassName\fR \fB::\fR \fIproc\fR ?\fIargs...\fR?
+.sp
+\fIobjName method\fR ?\fIargs...\fR?
+.sp
+\fICommands available within class methods/procs:\fR
+.br
+\fBglobal \fIvarName\fR ?\fIvarName...\fR?
+.br
+\fBprevious \fIcommand\fR ?\fIargs...\fR?
+.br
+\fBvirtual \fIcommand\fR ?\fIargs...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command is considered obsolete, but is retained for
+backward-compatibility with earlier versions of \fB[incr\ Tcl]\fR.
+It has been replaced by the \fBclass\fR command, which should
+be used for any new development.
+
+.TP
+\fBitcl_class \fIclassName definition\fR
+Provides the definition for a class named \fIclassName\fR. If
+\fIclassName\fR is already defined, then this command returns
+an error. If the class definition is successfully parsed,
+\fIclassName\fR becomes a command in the current namespace
+context, handling the
+creation of objects and providing access to class scope.
+The class \fIdefinition\fR
+is evaluated as a series of Tcl statements that define
+elements within the class. In addition to the usual
+commands, the following class definition commands are recognized:
+.RS
+.TP
+\fBinherit \fIbaseClass\fR ?\fIbaseClass\fR...?
+Declares one or more base classes, causing the current class to
+inherit their characteristics. Classes must have been defined by
+a previous \fBitcl_class\fR command, or must be available to the
+auto-loading facility (see "AUTO-LOADING" below). A single class
+definition can contain no more than one \fBinherit\fR command.
+.RS
+.LP
+When the same member name appears in two or more base classes,
+the base class that appears first in the \fBinherit\fR list takes
+precedence. For example, if classes "Foo" and "Bar" both contain
+the member "x", then the "\fBinherit\fR" statement:
+.CS
+inherit Foo Bar
+.CE
+allows "Foo::x" to be accessed simply as "x" but forces "Bar::x" (and
+all other inherited members named "x") to be referenced with their
+explicit "\fIclass\fR::\fImember\fR" name.
+.RE
+.TP
+\fBconstructor \fIargs\fR ?\fIinit\fR? \fIbody\fR
+Declares the argument list and body used for the constructor, which
+is automatically invoked whenever an object is created. Before
+.VS
+the \fIbody\fR is executed, the optional \fIinit\fR statement is
+used to invoke any base class constructors that require arguments.
+Variables in the \fIargs\fR specification can be accessed in the
+\fIinit\fR code fragment, and passed to base class constructors.
+After evaluating the \fIinit\fR statement, any base class
+constructors that have not been executed are invoked without
+arguments. This ensures that all base classes are fully
+constructed before the constructor \fIbody\fR is executed.
+.VE
+If construction is successful, the constructor always returns
+the object name\-regardless of how the \fIbody\fR is defined\-and
+the object name becomes a command in the current namespace context.
+If construction fails, an error message is returned.
+.TP
+\fBdestructor \fIbody\fR
+Declares the body used for the destructor, which is automatically invoked
+whenever an object is deleted. If the destructor is successful, the object
+data is destroyed and the object name is removed as a command from the
+interpreter. If destruction fails, an error message is returned
+and the object remains.
+.RS
+.LP
+.VS
+When an object is destroyed, all destructors in a class hierarchy
+are invoked in order from most- to least-specific. This is the
+order that the classes are reported by the "\fBinfo heritage\fR"
+command, and it is exactly the opposite of the default constructor
+order.
+.VE
+.RE
+.TP
+\fBmethod \fIname args body\fR
+Declares a method called \fIname\fR with an argument list \fIargs\fR
+and a \fIbody\fR of Tcl statements. A method is just like the usual
+Tcl "proc" except that it has transparent access to
+.VS
+object-specific variables, as well as
+.VE
+common variables. Within the class scope, a method can be invoked
+like any other command\-simply by using its name. Outside of the
+class scope, the method name must be prefaced by an object
+name. Methods in a base class that are redefined in the current class
+or hidden by another base class can be explicitly scoped using the
+"\fIclass\fR::\fImethod\fR" syntax.
+.TP
+\fBproc \fIname args body\fR
+Declares a proc called \fIname\fR with an argument list \fIargs\fR
+and a \fIbody\fR of Tcl statements. A proc is similar to a method,
+except that it can be invoked without referring to a specific object,
+and therefore has access only to common variables\-not
+.VS
+to object-specific variables declared with the \fBpublic\fR
+and \fBprotected\fR commands.
+.VE
+Within the class scope, a proc can be invoked
+like any other command\-simply by using its name. In any other
+namespace context, the proc is invoked using a qualified name
+like "\fIclassName\fB::\fIproc\fR".
+Procs in a base class that are redefined in the current
+class, or hidden by another base class, can also be accessed
+via their qualified name.
+.TP
+\fBpublic \fIvarName\fR ?\fIinit\fR? ?\fIconfig\fR?
+Declares a public variable named \fIvarName\fR. Public variables are
+visible in methods within the scope of their class and any derived class.
+In addition, they can be modified outside of the class scope using the special
+"config" formal argument (see "ARGUMENT LISTS" above). If the optional
+\fIinit\fR is specified, it is used as the initial value of the variable
+when a new object is created. If the optional \fIconfig\fR command
+is specified,
+it is invoked whenever a public variable is modified via the "config"
+formal argument; if the \fIconfig\fR command returns an error, the
+public variable is reset to its value before configuration, and the
+method handling the configuration returns an error.
+.TP
+\fBprotected \fIvarName\fR ?\fIinit\fR?
+Declares a protected variable named \fIvarName\fR. Protected variables
+are visible in methods within the scope of their class and any derived class,
+but cannot
+be modified outside of the class scope. If the optional \fIinit\fR
+is specified, it is used as the initial value of the variable when a new
+object is created. Initialization forces the variable to be a simple
+scalar value; uninitialized variables, on the other hand, can be used
+as arrays. All objects have a built-in protected variable named
+"this" which is initialized to the instance name for the object.
+.TP
+\fBcommon \fIvarName\fR ?\fIinit\fR?
+Declares a common variable named \fIvarName\fR. Common variables are
+shared among all objects in a class. They are visible in methods and
+procs in the scope of their class and any derived class, but cannot be
+modified outside of the class scope.
+If the optional \fIinit\fR is specified, it is used as the
+initial value of the variable. Initialization forces the variable to be
+a simple scalar value; uninitialized variables, on the other hand, can
+be used as arrays.
+.RS
+.LP
+Once a common variable has been declared, it can be configured using
+ordinary Tcl code within the class definition. This facility is
+particularly useful when the initialization of the variable is
+non-trivial\-when the variable contains an array of values, for example:
+.CS
+itcl_class Foo {
+ .
+ .
+ common boolean
+ set boolean(true) 1
+ set boolean(false) 0
+}
+.CE
+.RE
+.RE
+
+.SH CLASS USAGE
+.PP
+When a class definition has been loaded (or made available to the
+auto-loader), the class name can be used as a command.
+.TP
+\fIclassName objName\fR ?\fIargs...\fR?
+Creates a new object in class \fIclassName\fR with the name \fIobjName\fR.
+Remaining arguments are passed to the constructor. If construction is
+successful, the object name is returned and this name becomes a command
+in the current namespace context. Otherwise, an error is returned.
+.TP
+\fIclassName\fR #auto ?\fIargs...\fR?
+Creates a new object in class \fIclassName\fR with an automatically
+generated name. Names are of the form \fIclassName<number>\fR,
+.VS
+where the \fIclassName\fR part is modified to start with a lowercase
+letter. In class "Toaster", for example, the "\fB#auto\fR" specification
+would produce names toaster0, toaster1, etc. Remaining arguments are
+.VE
+passed to the constructor. If construction is successful, the object
+name is returned and this name becomes a command in the current
+namespace context. Otherwise, an error is returned.
+.TP
+\fIclassName\fR :: \fIproc\fR ?\fIargs...\fR?
+Used outside of the class scope to invoke a class proc named \fIproc\fR.
+Class procs are like ordinary Tcl procs, except that they are executed
+in the scope of the class and therefore have transparent
+access to common data members.
+.RS
+.LP
+.VS
+Notice that, unlike any other scope qualifier in \fB[incr\ Tcl]\fR, the "::"
+shown above is surrounded by spaces. This is unnecessary with the
+new namespace facility, and is considered obsolete. The capability
+is still supported, however, to provide backward-compatibility with
+earlier versions.
+.VE
+.RE
+
+.SH OBJECT USAGE
+.TP
+\fIobjName method\fR ?\fIargs...\fR?
+Invokes a method named \fImethod\fR to operate on the specified object.
+Remaining arguments are passed to the method. The method name can
+be "constructor", "destructor", any method name appearing in the
+class definition, or any of the following built-in methods.
+.SH BUILT-IN METHODS
+.TP
+\fIobjName\fR \fBisa \fIclassName\fR
+Returns non-zero if the given \fIclassName\fR can be found in the
+object's heritage, and zero otherwise.
+.TP
+\fIobjName\fR \fBdelete\fR
+Invokes the destructor associated with an object.
+If the destructor is successful, data associated with the object is
+deleted and \fIobjName\fR is removed as a command from the
+interpreter. Returns the empty string, regardless of the destructor
+body.
+.RS
+.LP
+.VS
+The built-in \fBdelete\fR method has been replaced by the
+"\fBdelete object\fR" command in the global namespace, and
+is considered obsolete. The capability is still supported,
+however, to provide backward-compatibility with earlier versions.
+.VE
+.RE
+.TP
+\fIobjName\fR \fBinfo \fIoption\fR ?\fIargs...\fR?
+Returns information related to the class definition or to
+a particular object named \fIobjName\fR.
+The \fIoption\fR parameter includes the following things, as well as
+the options recognized by the usual Tcl "info" command:
+.RS
+.TP
+\fIobjName\fR \fBinfo class\fR
+.VS
+Returns the name of the most-specific class for object \fIobjName\fR.
+.VE
+.TP
+\fIobjName\fR \fBinfo inherit\fR
+Returns the list of base classes as they were defined in the
+"\fBinherit\fR" command, or an empty string if this class
+has no base classes.
+.TP
+\fIobjName\fR \fBinfo heritage\fR
+Returns the current class name and the entire list of base classes in
+the order that they are traversed for member lookup and object
+destruction.
+.TP
+\fIobjName\fR \fBinfo method\fR ?\fImethodName\fR? ?\fB-args\fR? ?\fB-body\fR?
+With no arguments, this command returns a list of all class methods.
+If \fImethodName\fR is specified, it returns information for a specific method.
+If neither of the optional \fB-args\fR or \fB-body\fR flags is specified,
+a complete method definition is returned as a list of three elements
+including the method name, argument list and body. Otherwise, the
+requested information is returned without the method name.
+If the \fImethodName\fR is not recognized, an empty string is returned.
+.TP
+\fIobjName\fR \fBinfo proc\fR ?\fIprocName\fR? ?\fB-args\fR? ?\fB-body\fR?
+With no arguments, this command returns a list of all class procs.
+If \fIprocName\fR is specified, it returns information for a specific proc.
+If neither of the optional \fB-args\fR or \fB-body\fR flags is specified,
+a complete proc definition is returned as a list of three elements
+including the proc name, argument list and body. Otherwise, the
+requested information is returned without the proc name.
+If the \fIprocName\fR is not recognized, an empty string is returned.
+.TP
+\fIobjName\fR \fBinfo public\fR ?\fIvarName\fR? ?\fB-init\fR? ?\fB-value\fR? ?\fB-config\fR?
+With no arguments, this command returns a list of all public variables.
+If \fIvarName\fR is specified, it returns information for a specific public
+variable.
+If none of the optional \fB-init\fR, \fB-value\fR or \fB-config\fR flags
+are specified, all available information is returned as a list of four
+elements including the variable name, initial value, current value,
+and configuration commands. Otherwise, the requested information is
+returned without the variable name.
+If the \fIvarName\fR is not recognized, an empty string is returned.
+.TP
+\fIobjName\fR \fBinfo protected\fR ?\fIvarName\fR? ?\fB-init\fR? ?\fB-value\fR?
+With no arguments, this command returns a list of all protected variables.
+If \fIvarName\fR is specified, it returns information for a specific protected
+variable.
+If neither of the optional \fB-init\fR or \fB-value\fR flags is specified,
+all available information is returned as a list of three elements
+including the variable name, initial value and current value.
+Otherwise, the requested information is returned without the variable name.
+If the \fIvarName\fR is not recognized, an empty string is returned.
+.TP
+\fIobjName\fR \fBinfo common\fR ?\fIvarName\fR? ?\fB-init\fR? ?\fB-value\fR?
+With no arguments, this command returns a list of all common variables.
+If \fIvarName\fR is specified, it returns information for a specific common
+variable.
+If neither of the optional \fB-init\fR or \fB-value\fR flags is specified,
+all available information is returned as a list of three elements
+including the variable name, initial value and current value.
+Otherwise, the requested information is returned without the variable name.
+If the \fIvarName\fR is not recognized, an empty string is returned.
+.RE
+.SH OTHER BUILT-IN COMMANDS
+The following commands are also available within the scope of each class.
+They cannot be accessed from outside of the class as proper methods or
+procs; rather, they are useful inside the class when implementing its
+functionality.
+.TP
+\fBglobal \fIvarName\fR ?\fIvarName...\fR?
+Creates a link to one or more global variables in the current
+namespace context. Global variables can also be accessed in
+other namespaces by including namespace qualifiers in \fIvarName\fR.
+This is useful when communicating with Tk widgets that rely on global
+variables.
+.TP
+\fBprevious \fIcommand\fR ?\fIargs...\fR?
+Invokes \fIcommand\fR in the scope of the most immediate base class
+.VS
+(i.e., the "previous" class) for the object. For classes using single
+.VE
+inheritance, this facility can be used to avoid hard-wired base class
+references of the form "\fIclass\fR::\fIcommand\fR", making code easier
+to maintain. For classes using multiple inheritance, the utility of
+this function is dubious.
+If the class at the relevant scope has no base class, an error is returned.
+.TP
+\fBvirtual \fIcommand\fR ?\fIargs...\fR?
+.VS
+Invokes \fIcommand\fR in the scope of the most-specific class for the
+object. The methods within a class are automatically virtual; whenever
+an unqualified method name is used, it always refers to the most-specific
+implementation for that method. This function provides a way of
+evaluating code fragments in a base class that have access to the
+most-specific object information. It is useful, for example, for
+creating base classes that can capture and save an object's state.
+It inverts the usual notions of object-oriented programming, however,
+and should therefore be used sparingly.
+.VE
+
+.SH AUTO-LOADING
+.PP
+Class definitions need not be loaded explicitly; they can be loaded as
+needed by the usual Tcl auto-loading facility. Each directory containing
+class definition files should have an accompanying "tclIndex" file.
+Each line in this file identifies a Tcl procedure or \fB[incr\ Tcl]\fR
+class definition and the file where the definition can be found.
+.PP
+For example, suppose a directory contains the definitions for classes
+"Toaster" and "SmartToaster". Then the "tclIndex" file for this
+directory would look like:
+.CS
+# Tcl autoload index file, version 2.0 for [incr Tcl]
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(::Toaster) "source $dir/Toaster.itcl"
+set auto_index(::SmartToaster) "source $dir/SmartToaster.itcl"
+.PP
+The \fBauto_mkindex\fR command is used to automatically
+generate "tclIndex" files.
+.CE
+The auto-loader must be made aware of this directory by appending
+the directory name to the "auto_path" variable. When this is in
+place, classes will be auto-loaded as needed when used in an
+application.
+
+.SH KEYWORDS
+class, object, object-oriented
diff --git a/itcl/itcl/doc/itcl_info.n b/itcl/itcl/doc/itcl_info.n
new file mode 100644
index 00000000000..083616a3503
--- /dev/null
+++ b/itcl/itcl/doc/itcl_info.n
@@ -0,0 +1,62 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH itcl_info n 3.0 itcl "[incr\ Tcl]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+itcl_info \- query info regarding classes and objects (obsolete)
+.SH SYNOPSIS
+\fBitcl_info classes ?\fIpattern\fR?
+.br
+\fBitcl_info objects ?\fIpattern\fR? ?\fB-class \fIclassName\fR? ?\fB-isa \fIclassName\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command is considered obsolete, but is retained for
+backward-compatibility with earlier versions of \fB[incr\ Tcl]\fR.
+It has been replaced by the "\fBinfo classes\fR" and "\fBinfo objects\fR"
+commands, which should be used for any new development.
+
+.PP
+The following commands are available in the global namespace to
+query information about classes and objects that have been created.
+.TP
+\fBitcl_info classes ?\fIpattern\fR?
+Returns a list of classes available in the current namespace context.
+.VS
+If a class belongs to the current namespace context, its simple name
+is reported; otherwise, if a class is imported from another namespace,
+its fully-qualified name is reported.
+.VE
+.sp
+If the optional \fIpattern\fR is specified, then the reported names
+are compared using the rules of the "\fBstring match\fR" command,
+and only matching names are reported.
+.TP
+\fBitcl_info objects ?\fIpattern\fR? ?\fB-class \fIclassName\fR? ?\fB-isa \fIclassName\fR?
+Returns a list of objects available in the current namespace context.
+.VS
+If an object belongs to the current namespace context, its simple name
+is reported; otherwise, if an object is imported from another namespace,
+its fully-qualified access command is reported.
+.VE
+.sp
+If the optional \fIpattern\fR is specified, then the reported names
+are compared using the rules of the "\fBstring match\fR" command,
+and only matching names are reported.
+If the optional "\fB-class\fR" parameter is specified, this list is
+restricted to objects whose most-specific class is \fIclassName\fR.
+If the optional "\fB-isa\fR" parameter is specified, this list is
+further restricted to objects having the given \fIclassName\fR
+anywhere in their heritage.
+
+.SH KEYWORDS
+class, object, object-oriented
diff --git a/itcl/itcl/doc/itclsh.1 b/itcl/itcl/doc/itclsh.1
new file mode 100644
index 00000000000..6fe87d24aa1
--- /dev/null
+++ b/itcl/itcl/doc/itclsh.1
@@ -0,0 +1,30 @@
+'\"
+'\" Copyright (c) 1996 Lucent Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" $Id$
+'\"
+.so man.macros
+.TH itclsh 1 "" itcl "[incr\ Tcl]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+itclsh \- Simple shell for [incr Tcl]
+.SH SYNOPSIS
+\fBitclsh\fR ?\fIfileName arg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBitclsh\fR is a shell-like application that reads Tcl commands
+from its standard input, or from a file, and evaluates them.
+It is just like \fBtclsh\fR, but includes the \fB[incr\ Tcl]\fR
+extensions for object-oriented programming.
+.PP
+See the \fBtclsh\fR man page for details concerning usage. See
+the \fBitcl\fR man page for an overview of \fB[incr\ Tcl]\fR.
+
+.SH KEYWORDS
+Tcl, itcl, interpreter, script file, shell
diff --git a/itcl/itcl/doc/itclvars.n b/itcl/itcl/doc/itclvars.n
new file mode 100644
index 00000000000..507124109b3
--- /dev/null
+++ b/itcl/itcl/doc/itclvars.n
@@ -0,0 +1,96 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH itclvars n 3.0 itcl "[incr\ Tcl]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+itclvars \- variables used by [incr\ Tcl]
+.BE
+
+.SH DESCRIPTION
+.PP
+The following global variables are created and managed automatically
+by the \fB[incr\ Tcl]\fR library. Except where noted below, these
+variables should normally be treated as read-only by application-specific
+code and by users.
+.TP
+\fBitcl::library\fR
+When an interpreter is created, \fB[incr\ Tcl]\fR initializes this variable
+to hold the name of a directory containing the system library of
+\fB[incr\ Tcl]\fR scripts. The initial value of \fBitcl::library\fR
+is set from the ITCL_LIBRARY environment variable if it exists,
+or from a compiled-in value otherwise.
+.TP
+\fBitcl::patchLevel\fR
+When an interpreter is created, \fB[incr\ Tcl]\fR initializes this
+variable to hold the current patch level for \fB[incr\ Tcl]\fR.
+For example, the value "\fB2.0p1\fR" indicates \fB[incr\ Tcl]\fR
+version 2.0 with the first set of patches applied.
+.TP
+\fBitcl::purist\fR
+When an interpreter is created containing Tcl/Tk and the
+\fB[incr\ Tcl]\fR namespace facility, this variable controls
+a "backward-compatibility" mode for widget access.
+.sp
+In vanilla Tcl/Tk, there is a single pool of commands, so the
+access command for a widget is the same as the window name.
+When a widget is created within a namespace, however, its access
+command is installed in that namespace, and should be accessed
+outside of the namespace using a qualified name. For example,
+.CS
+namespace foo {
+ namespace bar {
+ button .b -text "Testing"
+ }
+}
+foo::bar::.b configure -background red
+pack .b
+.CE
+Note that the window name "\fC.b\fR" is still used in conjunction
+with commands like \fBpack\fR and \fBdestroy\fR. However, the
+access command for the widget (i.e., name that appears as the
+\fIfirst\fR argument on a command line) must be more specific.
+.sp
+The "\fBwinfo command\fR" command can be used to query the
+fully-qualified access command for any widget, so one can write:
+.CS
+[winfo command .b] configure -background red
+.CE
+and this is good practice when writing library procedures. Also,
+in conjunction with the \fBbind\fR command, the "%q" field can be
+used in place of "%W" as the access command:
+.CS
+bind Button <Key-Return> {%q flash; %q invoke}
+.CE
+While this behavior makes sense from the standpoint of encapsulation,
+it causes problems with existing Tcl/Tk applications. Many existing
+applications are written with bindings that use "%W". Many
+library procedures assume that the window name is the access
+command.
+.sp
+The \fBitcl::purist\fR variable controls a backward-compatibility
+mode. By default, this variable is "0", and the window name
+can be used as an access command in any context. Whenever the
+\fBunknown\fR procedure stumbles across a widget name, it simply
+uses "\fBwinfo command\fR" to determine the appropriate command
+name. If this variable is set to "1", this backward-compatibility
+mode is disabled. This gives better encapsulation, but using the
+window name as the access command may lead to "invalid command"
+errors.
+.TP
+\fBitcl::version\fR
+When an interpreter is created, \fB[incr\ Tcl]\fR initializes this
+variable to hold the version number of the form \fIx.y\fR.
+Changes to \fIx\fR represent major changes with probable
+incompatibilities and changes to \fIy\fR represent small enhancements
+and bug fixes that retain backward compatibility.
+
+.SH KEYWORDS
+itcl, variables
diff --git a/itcl/itcl/doc/license.terms b/itcl/itcl/doc/license.terms
new file mode 100644
index 00000000000..5ad564315d8
--- /dev/null
+++ b/itcl/itcl/doc/license.terms
@@ -0,0 +1,27 @@
+------------------------------------------------------------------------
+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> [incr Tcl] <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+ AUTHOR: Michael J. McLennan
+ Bell Labs Innovations for Lucent Technologies
+ mmclennan@lucent.com
+ http://www.tcltk.com/itcl
+========================================================================
+ Copyright (c) 1993-1996 Lucent Technologies
+========================================================================
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that the copyright notice and warranty disclaimer appear in
+supporting documentation, and that the names of Lucent Technologies
+any of their entities not be used in advertising or publicity
+pertaining to distribution of the software without specific, written
+prior permission.
+
+Lucent Technologies disclaims all warranties with regard to this
+software, including all implied warranties of merchantability and
+fitness. In no event shall Lucent be liable for any special, indirect
+or consequential damages or any damages whatsoever resulting from loss
+of use, data or profits, whether in an action of contract, negligence
+or other tortuous action, arising out of or in connection with the use
+or performance of this software.
+========================================================================
diff --git a/itcl/itcl/doc/local.n b/itcl/itcl/doc/local.n
new file mode 100644
index 00000000000..2c3a0c883bd
--- /dev/null
+++ b/itcl/itcl/doc/local.n
@@ -0,0 +1,75 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH local n "" itcl "[incr\ Tcl]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+local \- create an object local to a procedure
+.SH SYNOPSIS
+\fBlocal \fIclassName objName\fR ?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBlocal\fR command creates an \fB[incr\ Tcl]\fR object that
+is local to the current call frame. When the call frame goes away,
+the object is automatically deleted. This command is useful for
+creating objects that are local to a procedure.
+.PP
+As a side effect, this command creates a variable named
+"\fCitcl-local-\fIxxx\fR", where \fIxxx\fR is the name of
+the object that is created. This variable detects when the
+call frame is destroyed and automatically deletes the
+associated object.
+
+.SH EXAMPLE
+In the following example, a simple "counter" object is used
+within the procedure "test". The counter is created as a
+local object, so it is automatically deleted each time the
+procedure exits. The \fBputs\fR statements included in the
+constructor/destructor show the object coming and going
+as the procedure is called.
+.CS
+class counter {
+ private variable count 0
+ constructor {} {
+ puts "created: $this"
+ }
+ destructor {
+ puts "deleted: $this"
+ }
+
+ method bump {{by 1}} {
+ incr count $by
+ }
+ method get {} {
+ return $count
+ }
+}
+
+proc test {val} {
+ local counter x
+ for {set i 0} {$i < $val} {incr i} {
+ x bump
+ }
+ return [x get]
+}
+
+set result [test 5]
+puts "test: $result"
+
+set result [test 10]
+puts "test: $result"
+
+puts "objects: [info objects]"
+.CE
+
+.SH KEYWORDS
+class, object, procedure
diff --git a/itcl/itcl/doc/man.macros b/itcl/itcl/doc/man.macros
new file mode 100644
index 00000000000..3af2da92934
--- /dev/null
+++ b/itcl/itcl/doc/man.macros
@@ -0,0 +1,236 @@
+'\" The definitions below are for supplemental macros used in Tcl/Tk
+'\" manual entries.
+'\"
+'\" .AP type name in/out ?indent?
+'\" Start paragraph describing an argument to a library procedure.
+'\" type is type of argument (int, etc.), in/out is either "in", "out",
+'\" or "in/out" to describe whether procedure reads or modifies arg,
+'\" and indent is equivalent to second arg of .IP (shouldn't ever be
+'\" needed; use .AS below instead)
+'\"
+'\" .AS ?type? ?name?
+'\" Give maximum sizes of arguments for setting tab stops. Type and
+'\" name are examples of largest possible arguments that will be passed
+'\" to .AP later. If args are omitted, default tab stops are used.
+'\"
+'\" .BS
+'\" Start box enclosure. From here until next .BE, everything will be
+'\" enclosed in one large box.
+'\"
+'\" .BE
+'\" End of box enclosure.
+'\"
+'\" .CS
+'\" Begin code excerpt.
+'\"
+'\" .CE
+'\" End code excerpt.
+'\"
+'\" .VS ?version? ?br?
+'\" Begin vertical sidebar, for use in marking newly-changed parts
+'\" of man pages. The first argument is ignored and used for recording
+'\" the version when the .VS was added, so that the sidebars can be
+'\" found and removed when they reach a certain age. If another argument
+'\" is present, then a line break is forced before starting the sidebar.
+'\"
+'\" .VE
+'\" End of vertical sidebar.
+'\"
+'\" .DS
+'\" Begin an indented unfilled display.
+'\"
+'\" .DE
+'\" End of indented unfilled display.
+'\"
+'\" .SO
+'\" Start of list of standard options for a Tk widget. The
+'\" options follow on successive lines, in four columns separated
+'\" by tabs.
+'\"
+'\" .SE
+'\" End of list of standard options for a Tk widget.
+'\"
+'\" .OP cmdName dbName dbClass
+'\" Start of description of a specific option. cmdName gives the
+'\" option's name as specified in the class command, dbName gives
+'\" the option's name in the option database, and dbClass gives
+'\" the option's class in the option database.
+'\"
+'\" .UL arg1 arg2
+'\" Print arg1 underlined, then print arg2 normally.
+'\"
+'\" SCCS: @(#) man.macros 1.9 97/08/22 18:50:59
+'\"
+'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages.
+.if t .wh -1.3i ^B
+.nr ^l \n(.l
+.ad b
+'\" # Start an argument description
+.de AP
+.ie !"\\$4"" .TP \\$4
+.el \{\
+. ie !"\\$2"" .TP \\n()Cu
+. el .TP 15
+.\}
+.ie !"\\$3"" \{\
+.ta \\n()Au \\n()Bu
+\&\\$1 \\fI\\$2\\fP (\\$3)
+.\".b
+.\}
+.el \{\
+.br
+.ie !"\\$2"" \{\
+\&\\$1 \\fI\\$2\\fP
+.\}
+.el \{\
+\&\\fI\\$1\\fP
+.\}
+.\}
+..
+'\" # define tabbing values for .AP
+.de AS
+.nr )A 10n
+.if !"\\$1"" .nr )A \\w'\\$1'u+3n
+.nr )B \\n()Au+15n
+.\"
+.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n
+.nr )C \\n()Bu+\\w'(in/out)'u+2n
+..
+.AS Tcl_Interp Tcl_CreateInterp in/out
+'\" # BS - start boxed text
+'\" # ^y = starting y location
+'\" # ^b = 1
+.de BS
+.br
+.mk ^y
+.nr ^b 1u
+.if n .nf
+.if n .ti 0
+.if n \l'\\n(.lu\(ul'
+.if n .fi
+..
+'\" # BE - end boxed text (draw box now)
+.de BE
+.nf
+.ti 0
+.mk ^t
+.ie n \l'\\n(^lu\(ul'
+.el \{\
+.\" Draw four-sided box normally, but don't draw top of
+.\" box if the box started on an earlier page.
+.ie !\\n(^b-1 \{\
+\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.el \}\
+\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.\}
+.fi
+.br
+.nr ^b 0
+..
+'\" # VS - start vertical sidebar
+'\" # ^Y = starting y location
+'\" # ^v = 1 (for troff; for nroff this doesn't matter)
+.de VS
+.if !"\\$2"" .br
+.mk ^Y
+.ie n 'mc \s12\(br\s0
+.el .nr ^v 1u
+..
+'\" # VE - end of vertical sidebar
+.de VE
+.ie n 'mc
+.el \{\
+.ev 2
+.nf
+.ti 0
+.mk ^t
+\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n'
+.sp -1
+.fi
+.ev
+.\}
+.nr ^v 0
+..
+'\" # Special macro to handle page bottom: finish off current
+'\" # box/sidebar if in box/sidebar mode, then invoked standard
+'\" # page bottom macro.
+.de ^B
+.ev 2
+'ti 0
+'nf
+.mk ^t
+.if \\n(^b \{\
+.\" Draw three-sided box if this is the box's first page,
+.\" draw two sides but no top otherwise.
+.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.\}
+.if \\n(^v \{\
+.nr ^x \\n(^tu+1v-\\n(^Yu
+\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c
+.\}
+.bp
+'fi
+.ev
+.if \\n(^b \{\
+.mk ^y
+.nr ^b 2
+.\}
+.if \\n(^v \{\
+.mk ^Y
+.\}
+..
+'\" # DS - begin display
+.de DS
+.RS
+.nf
+.sp
+..
+'\" # DE - end display
+.de DE
+.fi
+.RE
+.sp
+..
+'\" # SO - start of list of standard options
+.de SO
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+.ft B
+..
+'\" # SE - end of list of standard options
+.de SE
+.fi
+.ft R
+.LP
+See the \\fBoptions\\fR manual entry for details on the standard options.
+..
+'\" # OP - start of full description for a single option
+.de OP
+.LP
+.nf
+.ta 4c
+Command-Line Name: \\fB\\$1\\fR
+Database Name: \\fB\\$2\\fR
+Database Class: \\fB\\$3\\fR
+.fi
+.IP
+..
+'\" # CS - begin code excerpt
+.de CS
+.RS
+.nf
+.ta .25i .5i .75i 1i
+..
+'\" # CE - end code excerpt
+.de CE
+.fi
+.RE
+..
+.de UL
+\\$1\l'|0\(ul'\\$2
+..
diff --git a/itcl/itcl/doc/scope.n b/itcl/itcl/doc/scope.n
new file mode 100644
index 00000000000..690a99e7511
--- /dev/null
+++ b/itcl/itcl/doc/scope.n
@@ -0,0 +1,77 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH scope n "" Tcl "[incr\ Tcl]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+scope \- capture the namespace context for a variable
+.SH SYNOPSIS
+\fBscope \fIname\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+Creates a scoped value for the specified \fIname\fR, which must
+be a variable name. If the \fIname\fR is an instance variable,
+then the scope command returns a string of the following form:
+.CS
+@itcl \fIobject varName\fP
+.CE
+This is recognized in any context as an instance variable belonging
+to \fIobject\fR. So with itcl3.0 and beyond, it is possible to use
+instance variables in conjunction with widgets. For example, if you
+have an object with a private variable \fCx\fR, and you can use
+\fCx\fR in conjunction with the \fC-textvariable\fR option of an
+entry widget. Before itcl3.0, only common variables could be used
+in this manner.
+.PP
+If the \fIname\fR is not an instance variable, then it must be
+a common variable or a global variable. In that case, the scope
+command returns the fully qualified name of the variable, e.g.,
+\fC::foo::bar::x\fR.
+.PP
+If the \fIname\fR is not recognized as a variable, the scope
+command returns an error.
+.PP
+Ordinary variable names refer to variables in the global namespace.
+A scoped value captures a variable name together with its namespace
+context in a way that allows it to be referenced properly later.
+It is needed, for example, to wrap up variable names when a Tk
+widget is used within a namespace:
+.CS
+namespace foo {
+ private variable mode 1
+
+ radiobutton .rb1 -text "Mode #1" \
+ -variable [scope mode] -value 1
+ pack .rb1
+
+ radiobutton .rb2 -text "Mode #2" \
+ -variable [scope mode] -value 2
+ pack .rb2
+}
+.CE
+Radiobuttons \fC.rb1\fR and \fC.rb2\fR interact via the variable
+"mode" contained in the namespace "foo". The \fBscope\fR command
+guarantees this by returning the fully qualified variable name
+\fC::foo::mode\fR.
+.PP
+You should never use the \fC@itcl\fR syntax directly. For example,
+it is a bad idea to write code like this:
+.CS
+set {@itcl ::fred x} 3
+puts "value = ${@itcl ::fred x}"
+.CE
+Instead, you should always use the scope command to generate the
+variable name dynamically. Then, you can pass that name to a widget
+or to any other bit of code in your program.
+
+.SH KEYWORDS
+code, namespace, variable
diff --git a/itcl/itcl/generic/itcl.h b/itcl/itcl/generic/itcl.h
new file mode 100644
index 00000000000..fa4c2d36e9e
--- /dev/null
+++ b/itcl/itcl/generic/itcl.h
@@ -0,0 +1,188 @@
+/*
+ * ------------------------------------------------------------------------
+ * PACKAGE: [incr Tcl]
+ * DESCRIPTION: Object-Oriented Extensions to Tcl
+ *
+ * [incr Tcl] provides object-oriented extensions to Tcl, much as
+ * C++ provides object-oriented extensions to C. It provides a means
+ * of encapsulating related procedures together with their shared data
+ * in a local namespace that is hidden from the outside world. It
+ * promotes code re-use through inheritance. More than anything else,
+ * it encourages better organization of Tcl applications through the
+ * object-oriented paradigm, leading to code that is easier to
+ * understand and maintain.
+ *
+ * ADDING [incr Tcl] TO A Tcl-BASED APPLICATION:
+ *
+ * To add [incr Tcl] facilities to a Tcl application, modify the
+ * Tcl_AppInit() routine as follows:
+ *
+ * 1) Include this header file near the top of the file containing
+ * Tcl_AppInit():
+ *
+ * #include "itcl.h"
+ *
+ * 2) Within the body of Tcl_AppInit(), add the following lines:
+ *
+ * if (Itcl_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * 3) Link your application with libitcl.a
+ *
+ * NOTE: An example file "tclAppInit.c" containing the changes shown
+ * above is included in this distribution.
+ *
+ * ========================================================================
+ * AUTHOR: Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ * http://www.tcltk.com/itcl
+ *
+ * RCS: $Id$
+ * ========================================================================
+ * Copyright (c) 1993-1998 Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#ifndef ITCL_H
+#define ITCL_H
+
+#include "tcl.h"
+
+#define ITCL_VERSION "3.0"
+#define ITCL_PATCH_LEVEL "3.0"
+#define ITCL_MAJOR_VERSION 3
+#define ITCL_MINOR_VERSION 0
+#define ITCL_RELEASE_LEVEL 0
+
+/*
+ * A special definition used to allow this header file to be included
+ * in resource files so that they can get obtain version information from
+ * this file. Resource compilers don't like all the C stuff, like typedefs
+ * and procedure declarations, that occur below.
+ */
+
+#ifndef RESOURCE_INCLUDED
+
+#include "tclInt.h"
+
+#ifdef BUILD_itcl
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * Protection levels:
+ *
+ * ITCL_PUBLIC - accessible from any namespace
+ * ITCL_PROTECTED - accessible from namespace that imports in "protected" mode
+ * ITCL_PRIVATE - accessible only within the namespace that contains it
+ */
+#define ITCL_PUBLIC 1
+#define ITCL_PROTECTED 2
+#define ITCL_PRIVATE 3
+#define ITCL_DEFAULT_PROTECT 4
+
+
+/*
+ * Generic stack.
+ */
+typedef struct Itcl_Stack {
+ ClientData *values; /* values on stack */
+ int len; /* number of values on stack */
+ int max; /* maximum size of stack */
+ ClientData space[5]; /* initial space for stack data */
+} Itcl_Stack;
+
+#define Itcl_GetStackSize(stackPtr) ((stackPtr)->len)
+
+/*
+ * Generic linked list.
+ */
+struct Itcl_List;
+typedef struct Itcl_ListElem {
+ struct Itcl_List* owner; /* list containing this element */
+ ClientData value; /* value associated with this element */
+ struct Itcl_ListElem *prev; /* previous element in linked list */
+ struct Itcl_ListElem *next; /* next element in linked list */
+} Itcl_ListElem;
+
+typedef struct Itcl_List {
+ int validate; /* validation stamp */
+ int num; /* number of elements */
+ struct Itcl_ListElem *head; /* previous element in linked list */
+ struct Itcl_ListElem *tail; /* next element in linked list */
+} Itcl_List;
+
+#define Itcl_FirstListElem(listPtr) ((listPtr)->head)
+#define Itcl_LastListElem(listPtr) ((listPtr)->tail)
+#define Itcl_NextListElem(elemPtr) ((elemPtr)->next)
+#define Itcl_PrevListElem(elemPtr) ((elemPtr)->prev)
+#define Itcl_GetListLength(listPtr) ((listPtr)->num)
+#define Itcl_GetListValue(elemPtr) ((elemPtr)->value)
+
+/*
+ * Token representing the state of an interpreter.
+ */
+typedef struct Itcl_InterpState_ *Itcl_InterpState;
+
+
+/*
+ * Exported functions
+ */
+EXTERN int Itcl_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int Itcl_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
+
+EXTERN int Itcl_RegisterC _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, Tcl_CmdProc *proc, ClientData clientData,
+ Tcl_CmdDeleteProc *deleteProc));
+EXTERN int Itcl_RegisterObjC _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, Tcl_ObjCmdProc *proc, ClientData clientData,
+ Tcl_CmdDeleteProc *deleteProc));
+EXTERN int Itcl_FindC _ANSI_ARGS_((Tcl_Interp *interp, char *name,
+ Tcl_CmdProc **argProcPtr, Tcl_ObjCmdProc **objProcPtr,
+ ClientData *cDataPtr));
+
+EXTERN void Itcl_InitStack _ANSI_ARGS_((Itcl_Stack *stack));
+EXTERN void Itcl_DeleteStack _ANSI_ARGS_((Itcl_Stack *stack));
+EXTERN void Itcl_PushStack _ANSI_ARGS_((ClientData cdata,
+ Itcl_Stack *stack));
+EXTERN ClientData Itcl_PopStack _ANSI_ARGS_((Itcl_Stack *stack));
+EXTERN ClientData Itcl_PeekStack _ANSI_ARGS_((Itcl_Stack *stack));
+EXTERN ClientData Itcl_GetStackValue _ANSI_ARGS_((Itcl_Stack *stack,
+ int pos));
+
+EXTERN void Itcl_InitList _ANSI_ARGS_((Itcl_List *listPtr));
+EXTERN void Itcl_DeleteList _ANSI_ARGS_((Itcl_List *listPtr));
+EXTERN Itcl_ListElem* Itcl_CreateListElem _ANSI_ARGS_((Itcl_List *listPtr));
+EXTERN Itcl_ListElem* Itcl_DeleteListElem _ANSI_ARGS_((Itcl_ListElem *elemPtr));
+EXTERN Itcl_ListElem* Itcl_InsertList _ANSI_ARGS_((Itcl_List *listPtr,
+ ClientData val));
+EXTERN Itcl_ListElem* Itcl_InsertListElem _ANSI_ARGS_((Itcl_ListElem *pos,
+ ClientData val));
+EXTERN Itcl_ListElem* Itcl_AppendList _ANSI_ARGS_((Itcl_List *listPtr,
+ ClientData val));
+EXTERN Itcl_ListElem* Itcl_AppendListElem _ANSI_ARGS_((Itcl_ListElem *pos,
+ ClientData val));
+EXTERN void Itcl_SetListValue _ANSI_ARGS_((Itcl_ListElem *elemPtr,
+ ClientData val));
+
+EXTERN void Itcl_EventuallyFree _ANSI_ARGS_((ClientData cdata,
+ Tcl_FreeProc *fproc));
+EXTERN void Itcl_PreserveData _ANSI_ARGS_((ClientData cdata));
+EXTERN void Itcl_ReleaseData _ANSI_ARGS_((ClientData cdata));
+
+EXTERN Itcl_InterpState Itcl_SaveInterpState _ANSI_ARGS_((Tcl_Interp* interp,
+ int status));
+EXTERN int Itcl_RestoreInterpState _ANSI_ARGS_((Tcl_Interp* interp,
+ Itcl_InterpState state));
+EXTERN void Itcl_DiscardInterpState _ANSI_ARGS_((Itcl_InterpState state));
+
+#endif /* RESOURCE_INCLUDED */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* ITCL_H */
diff --git a/itcl/itcl/generic/itclInt.h b/itcl/itcl/generic/itclInt.h
new file mode 100644
index 00000000000..9ca1323dab0
--- /dev/null
+++ b/itcl/itcl/generic/itclInt.h
@@ -0,0 +1,535 @@
+/*
+ * ------------------------------------------------------------------------
+ * PACKAGE: [incr Tcl]
+ * DESCRIPTION: Object-Oriented Extensions to Tcl
+ *
+ * [incr Tcl] provides object-oriented extensions to Tcl, much as
+ * C++ provides object-oriented extensions to C. It provides a means
+ * of encapsulating related procedures together with their shared data
+ * in a local namespace that is hidden from the outside world. It
+ * promotes code re-use through inheritance. More than anything else,
+ * it encourages better organization of Tcl applications through the
+ * object-oriented paradigm, leading to code that is easier to
+ * understand and maintain.
+ *
+ * ADDING [incr Tcl] TO A Tcl-BASED APPLICATION:
+ *
+ * To add [incr Tcl] facilities to a Tcl application, modify the
+ * Tcl_AppInit() routine as follows:
+ *
+ * 1) Include this header file near the top of the file containing
+ * Tcl_AppInit():
+ *
+ * #include "itcl.h"
+ *
+ * 2) Within the body of Tcl_AppInit(), add the following lines:
+ *
+ * if (Itcl_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * 3) Link your application with libitcl.a
+ *
+ * NOTE: An example file "tclAppInit.c" containing the changes shown
+ * above is included in this distribution.
+ *
+ * ========================================================================
+ * AUTHOR: Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ * http://www.tcltk.com/itcl
+ *
+ * RCS: $Id$
+ * ========================================================================
+ * Copyright (c) 1993-1998 Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#ifndef ITCLINT_H
+#define ITCLINT_H
+
+#include "itcl.h"
+#include "tclInt.h"
+
+#ifdef BUILD_itcl
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * Since the Tcl/Tk distribution doesn't perform any asserts,
+ * dynamic loading can fail to find the __assert function.
+ * As a workaround, we'll include our own.
+ */
+#undef assert
+#ifdef NDEBUG
+#define assert(EX) ((void)0)
+#else
+EXTERN void Itcl_Assert _ANSI_ARGS_((char *testExpr, char *fileName, int lineNum)
+);
+#if defined(__STDC__)
+#define assert(EX) (void)((EX) || (Itcl_Assert(#EX, __FILE__, __LINE__), 0))
+#else
+#define assert(EX) (void)((EX) || (Itcl_Assert("EX", __FILE__, __LINE__), 0))
+#endif /* __STDC__ */
+#endif /* NDEBUG */
+
+
+/*
+ * Common info for managing all known objects.
+ * Each interpreter has one of these data structures stored as
+ * clientData in the "itcl" namespace. It is also accessible
+ * as associated data via the key ITCL_INTERP_DATA.
+ */
+struct ItclObject;
+typedef struct ItclObjectInfo {
+ Tcl_Interp *interp; /* interpreter that manages this info */
+ Tcl_HashTable objects; /* list of all known objects */
+
+ Itcl_Stack transparentFrames; /* stack of call frames that should be
+ * treated transparently. When
+ * Itcl_EvalMemberCode is invoked in
+ * one of these contexts, it does an
+ * "uplevel" to get past the transparent
+ * frame and back to the calling context. */
+ Tcl_HashTable contextFrames; /* object contexts for active call frames */
+
+ int protection; /* protection level currently in effect */
+
+ Itcl_Stack cdefnStack; /* stack of class definitions currently
+ * being parsed */
+} ItclObjectInfo;
+
+#define ITCL_INTERP_DATA "itcl_data"
+
+/*
+ * Representation for each [incr Tcl] class.
+ */
+typedef struct ItclClass {
+ char *name; /* class name */
+ char *fullname; /* fully qualified class name */
+ Tcl_Interp *interp; /* interpreter that manages this info */
+ Tcl_Namespace *namesp; /* namespace representing class scope */
+ Tcl_Command accessCmd; /* access command for creating instances */
+
+ struct ItclObjectInfo *info; /* info about all known objects */
+ Itcl_List bases; /* list of base classes */
+ Itcl_List derived; /* list of all derived classes */
+ Tcl_HashTable heritage; /* table of all base classes. Look up
+ * by pointer to class definition. This
+ * provides fast lookup for inheritance
+ * tests. */
+ Tcl_Obj *initCode; /* initialization code for new objs */
+ Tcl_HashTable variables; /* definitions for all data members
+ in this class. Look up simple string
+ names and get back ItclVarDefn* ptrs */
+ Tcl_HashTable functions; /* definitions for all member functions
+ in this class. Look up simple string
+ names and get back ItclMemberFunc* ptrs */
+ int numInstanceVars; /* number of instance vars in variables
+ table */
+ Tcl_HashTable resolveVars; /* all possible names for variables in
+ * this class (e.g., x, foo::x, etc.) */
+ Tcl_HashTable resolveCmds; /* all possible names for functions in
+ * this class (e.g., x, foo::x, etc.) */
+ int unique; /* unique number for #auto generation */
+ int flags; /* maintains class status */
+} ItclClass;
+
+typedef struct ItclHierIter {
+ ItclClass *current; /* current position in hierarchy */
+ Itcl_Stack stack; /* stack used for traversal */
+} ItclHierIter;
+
+/*
+ * Representation for each [incr Tcl] object.
+ */
+typedef struct ItclObject {
+ ItclClass *classDefn; /* most-specific class */
+ Tcl_Command accessCmd; /* object access command */
+
+ int dataSize; /* number of elements in data array */
+ Var** data; /* all object-specific data members */
+ Tcl_HashTable* constructed; /* temp storage used during construction */
+ Tcl_HashTable* destructed; /* temp storage used during destruction */
+} ItclObject;
+
+#define ITCL_IGNORE_ERRS 0x002 /* useful for construction/destruction */
+
+/*
+ * Implementation for any code body in an [incr Tcl] class.
+ */
+typedef struct ItclMemberCode {
+ int flags; /* flags describing implementation */
+ CompiledLocal *arglist; /* list of arg names and initial values */
+ int argcount; /* number of args in arglist */
+ Proc *procPtr; /* Tcl proc representation (needed to
+ * handle compiled locals) */
+ union {
+ Tcl_CmdProc *argCmd; /* (argc,argv) C implementation */
+ Tcl_ObjCmdProc *objCmd; /* (objc,objv) C implementation */
+ } cfunc;
+
+ ClientData clientData; /* client data for C implementations */
+
+} ItclMemberCode;
+
+/*
+ * Basic representation for class members (commands/variables)
+ */
+typedef struct ItclMember {
+ Tcl_Interp* interp; /* interpreter containing the class */
+ ItclClass* classDefn; /* class containing this member */
+ char* name; /* member name */
+ char* fullname; /* member name with "class::" qualifier */
+ int protection; /* protection level */
+ int flags; /* flags describing member (see below) */
+ ItclMemberCode *code; /* code associated with member */
+} ItclMember;
+
+/*
+ * Flag bits for ItclMemberCode and ItclMember:
+ */
+#define ITCL_IMPLEMENT_NONE 0x001 /* no implementation */
+#define ITCL_IMPLEMENT_TCL 0x002 /* Tcl implementation */
+#define ITCL_IMPLEMENT_ARGCMD 0x004 /* (argc,argv) C implementation */
+#define ITCL_IMPLEMENT_OBJCMD 0x008 /* (objc,objv) C implementation */
+#define ITCL_IMPLEMENT_C 0x00c /* either kind of C implementation */
+#define ITCL_CONSTRUCTOR 0x010 /* non-zero => is a constructor */
+#define ITCL_DESTRUCTOR 0x020 /* non-zero => is a destructor */
+#define ITCL_COMMON 0x040 /* non-zero => is a "proc" */
+#define ITCL_ARG_SPEC 0x080 /* non-zero => has an argument spec */
+
+#define ITCL_OLD_STYLE 0x100 /* non-zero => old-style method
+ * (process "config" argument) */
+
+#define ITCL_THIS_VAR 0x200 /* non-zero => built-in "this" variable */
+
+/*
+ * Representation of member functions in an [incr Tcl] class.
+ */
+typedef struct ItclMemberFunc {
+ ItclMember *member; /* basic member info */
+ Tcl_Command accessCmd; /* Tcl command installed for this function */
+ CompiledLocal *arglist; /* list of arg names and initial values */
+ int argcount; /* number of args in arglist */
+} ItclMemberFunc;
+
+/*
+ * Instance variables.
+ */
+typedef struct ItclVarDefn {
+ ItclMember *member; /* basic member info */
+ char* init; /* initial value */
+} ItclVarDefn;
+
+/*
+ * Instance variable lookup entry.
+ */
+typedef struct ItclVarLookup {
+ ItclVarDefn* vdefn; /* variable definition */
+ int usage; /* number of uses for this record */
+ int accessible; /* non-zero => accessible from class with
+ * this lookup record in its resolveVars */
+ char *leastQualName; /* simplist name for this variable, with
+ * the fewest qualifiers. This string is
+ * taken from the resolveVars table, so
+ * it shouldn't be freed. */
+ union {
+ int index; /* index into virtual table (instance data) */
+ Tcl_Var common; /* variable (common data) */
+ } var;
+} ItclVarLookup;
+
+/*
+ * Representation for the context in which a body of [incr Tcl]
+ * code executes. In ordinary Tcl, this is a CallFrame. But for
+ * [incr Tcl] code bodies, we must be careful to set up the
+ * CallFrame properly, to plug in instance variables before
+ * executing the code body.
+ */
+typedef struct ItclContext {
+ ItclClass *classDefn; /* class definition */
+ CallFrame frame; /* call frame for object context */
+ Var *compiledLocals; /* points to storage for compiled locals */
+ Var localStorage[20]; /* default storage for compiled locals */
+} ItclContext;
+
+
+/*
+ * Functions used within the package, but not considered "public"
+ */
+
+EXTERN int Itcl_IsClassNamespace _ANSI_ARGS_((Tcl_Namespace *namesp));
+EXTERN int Itcl_IsClass _ANSI_ARGS_((Tcl_Command cmd));
+EXTERN ItclClass* Itcl_FindClass _ANSI_ARGS_((Tcl_Interp* interp,
+ char* path, int autoload));
+
+EXTERN int Itcl_FindObject _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, ItclObject **roPtr));
+EXTERN int Itcl_IsObject _ANSI_ARGS_((Tcl_Command cmd));
+EXTERN int Itcl_ObjectIsa _ANSI_ARGS_((ItclObject *contextObj,
+ ItclClass *cdefn));
+
+
+EXTERN int Itcl_Protection _ANSI_ARGS_((Tcl_Interp *interp,
+ int newLevel));
+EXTERN char* Itcl_ProtectionStr _ANSI_ARGS_((int pLevel));
+EXTERN int Itcl_CanAccess _ANSI_ARGS_((ItclMember* memberPtr,
+ Tcl_Namespace* fromNsPtr));
+EXTERN int Itcl_CanAccessFunc _ANSI_ARGS_((ItclMemberFunc* mfunc,
+ Tcl_Namespace* fromNsPtr));
+EXTERN Tcl_Namespace* Itcl_GetTrueNamespace _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclObjectInfo *info));
+
+EXTERN void Itcl_ParseNamespPath _ANSI_ARGS_((char *name,
+ Tcl_DString *buffer, char **head, char **tail));
+EXTERN int Itcl_DecodeScopedCommand _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, Tcl_Namespace **rNsPtr, char **rCmdPtr));
+EXTERN int Itcl_EvalArgs _ANSI_ARGS_((Tcl_Interp *interp, int objc,
+ Tcl_Obj *CONST objv[]));
+EXTERN Tcl_Obj* Itcl_CreateArgs _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, int objc, Tcl_Obj *CONST objv[]));
+
+EXTERN int Itcl_PushContext _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclMember *member, ItclClass *contextClass, ItclObject *contextObj,
+ ItclContext *contextPtr));
+EXTERN void Itcl_PopContext _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclContext *contextPtr));
+EXTERN int Itcl_GetContext _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclClass **cdefnPtr, ItclObject **odefnPtr));
+
+EXTERN void Itcl_InitHierIter _ANSI_ARGS_((ItclHierIter *iter,
+ ItclClass *cdefn));
+EXTERN void Itcl_DeleteHierIter _ANSI_ARGS_((ItclHierIter *iter));
+EXTERN ItclClass* Itcl_AdvanceHierIter _ANSI_ARGS_((ItclHierIter *iter));
+
+EXTERN int Itcl_FindClassesCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_FindObjectsCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_ProtectionCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_DelClassCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_DelObjectCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_ScopeCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_CodeCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_StubCreateCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_StubExistsCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_IsStub _ANSI_ARGS_((Tcl_Command cmd));
+
+
+/*
+ * Functions for manipulating classes
+ */
+EXTERN int Itcl_CreateClass _ANSI_ARGS_((Tcl_Interp* interp, char* path,
+ ItclObjectInfo *info, ItclClass **rPtr));
+EXTERN int Itcl_DeleteClass _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclClass *cdefnPtr));
+EXTERN Tcl_Namespace* Itcl_FindClassNamespace _ANSI_ARGS_((Tcl_Interp* interp,
+ char* path));
+EXTERN int Itcl_HandleClass _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_ClassCmdResolver _ANSI_ARGS_((Tcl_Interp *interp,
+ char* name, Tcl_Namespace *context, int flags, Tcl_Command *rPtr));
+EXTERN int Itcl_ClassVarResolver _ANSI_ARGS_((Tcl_Interp *interp,
+ char* name, Tcl_Namespace *context, int flags, Tcl_Var *rPtr));
+EXTERN int Itcl_ClassCompiledVarResolver _ANSI_ARGS_((Tcl_Interp *interp,
+ char* name, int length, Tcl_Namespace *context, Tcl_ResolvedVarInfo **rPtr));
+EXTERN void Itcl_BuildVirtualTables _ANSI_ARGS_((ItclClass* cdefnPtr));
+EXTERN int Itcl_CreateVarDefn _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclClass* cdefn, char* name, char* init, char* config,
+ ItclVarDefn** vdefnPtr));
+EXTERN void Itcl_DeleteVarDefn _ANSI_ARGS_((ItclVarDefn *vdefn));
+EXTERN char* Itcl_GetCommonVar _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, ItclClass *contextClass));
+EXTERN ItclMember* Itcl_CreateMember _ANSI_ARGS_((Tcl_Interp* interp,
+ ItclClass *cdefn, char* name));
+EXTERN void Itcl_DeleteMember _ANSI_ARGS_((ItclMember *memPtr));
+
+
+/*
+ * Functions for manipulating objects
+ */
+EXTERN int Itcl_CreateObject _ANSI_ARGS_((Tcl_Interp *interp,
+ char* name, ItclClass *cdefn, int objc, Tcl_Obj *CONST objv[],
+ ItclObject **roPtr));
+EXTERN int Itcl_DeleteObject _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclObject *contextObj));
+EXTERN int Itcl_DestructObject _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclObject *contextObj, int flags));
+EXTERN int Itcl_HandleInstance _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN char* Itcl_GetInstanceVar _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, ItclObject *contextObj, ItclClass *contextClass));
+EXTERN int Itcl_ScopedVarResolver _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, Tcl_Namespace *contextNs, int flags, Tcl_Var *rPtr));
+
+
+/*
+ * Functions for manipulating methods and procs
+ */
+EXTERN int Itcl_BodyCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_ConfigBodyCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_CreateMethod _ANSI_ARGS_((Tcl_Interp* interp,
+ ItclClass *cdefn, char* name, char* arglist, char* body));
+EXTERN int Itcl_CreateProc _ANSI_ARGS_((Tcl_Interp* interp,
+ ItclClass *cdefn, char* name, char* arglist, char* body));
+EXTERN int Itcl_CreateMemberFunc _ANSI_ARGS_((Tcl_Interp* interp,
+ ItclClass *cdefn, char* name, char* arglist, char* body,
+ ItclMemberFunc** mfuncPtr));
+EXTERN int Itcl_ChangeMemberFunc _ANSI_ARGS_((Tcl_Interp* interp,
+ ItclMemberFunc* mfunc, char* arglist, char* body));
+EXTERN void Itcl_DeleteMemberFunc _ANSI_ARGS_((char* cdata));
+EXTERN int Itcl_CreateMemberCode _ANSI_ARGS_((Tcl_Interp* interp,
+ ItclClass *cdefn, char* arglist, char* body, ItclMemberCode** mcodePtr));
+EXTERN void Itcl_DeleteMemberCode _ANSI_ARGS_((char* cdata));
+EXTERN int Itcl_GetMemberCode _ANSI_ARGS_((Tcl_Interp* interp,
+ ItclMember* member));
+EXTERN int Itcl_CompileMemberCodeBody _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclMember *member, char *desc, Tcl_Obj *bodyPtr));
+EXTERN int Itcl_EvalMemberCode _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclMemberFunc *mfunc, ItclMember *member, ItclObject *contextObj,
+ int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_CreateArgList _ANSI_ARGS_((Tcl_Interp* interp,
+ char* decl, int* argcPtr, CompiledLocal** argPtr));
+EXTERN CompiledLocal* Itcl_CreateArg _ANSI_ARGS_((char* name,
+ char* init));
+EXTERN void Itcl_DeleteArgList _ANSI_ARGS_((CompiledLocal *arglist));
+EXTERN Tcl_Obj* Itcl_ArgList _ANSI_ARGS_((int argc, CompiledLocal* arglist));
+EXTERN int Itcl_EquivArgLists _ANSI_ARGS_((CompiledLocal* arg1, int arg1c,
+ CompiledLocal* arg2, int arg2c));
+EXTERN void Itcl_GetMemberFuncUsage _ANSI_ARGS_((ItclMemberFunc *mfunc,
+ ItclObject *contextObj, Tcl_Obj *objPtr));
+EXTERN int Itcl_ExecMethod _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_ExecProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_AssignArgs _ANSI_ARGS_((Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[], ItclMemberFunc *mfunc));
+EXTERN int Itcl_ConstructBase _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclObject *contextObj, ItclClass *contextClass));
+EXTERN int Itcl_InvokeMethodIfExists _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, ItclClass *contextClass, ItclObject *contextObj,
+ int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_EvalBody _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *bodyPtr));
+EXTERN int Itcl_ReportFuncErrors _ANSI_ARGS_((Tcl_Interp* interp,
+ ItclMemberFunc *mfunc, ItclObject *contextObj, int result));
+
+
+/*
+ * Commands for parsing class definitions
+ */
+EXTERN int Itcl_ParseInit _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclObjectInfo *info));
+EXTERN int Itcl_ClassCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_ClassInheritCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_ClassProtectionCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_ClassConstructorCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_ClassDestructorCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_ClassMethodCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_ClassProcCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_ClassVariableCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_ClassCommonCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_ParseVarResolver _ANSI_ARGS_((Tcl_Interp *interp,
+ char* name, Tcl_Namespace *contextNs, int flags, Tcl_Var* rPtr));
+
+
+/*
+ * Commands in the "builtin" namespace
+ */
+EXTERN int Itcl_BiInit _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int Itcl_InstallBiMethods _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclClass *cdefn));
+EXTERN int Itcl_BiIsaCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_BiConfigureCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_BiCgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_BiChainCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_BiInfoClassCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_BiInfoInheritCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_BiInfoHeritageCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_BiInfoFunctionCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_BiInfoVariableCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_BiInfoBodyCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_BiInfoArgsCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_DefaultInfoCmd _ANSI_ARGS_((ClientData dummy,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+
+
+/*
+ * Ensembles
+ */
+EXTERN int Itcl_EnsembleInit _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int Itcl_CreateEnsemble _ANSI_ARGS_((Tcl_Interp *interp,
+ char* ensName));
+EXTERN int Itcl_AddEnsemblePart _ANSI_ARGS_((Tcl_Interp *interp,
+ char* ensName, char* partName, char* usageInfo,
+ Tcl_ObjCmdProc *objProc, ClientData clientData,
+ Tcl_CmdDeleteProc *deleteProc));
+EXTERN int Itcl_GetEnsemblePart _ANSI_ARGS_((Tcl_Interp *interp,
+ char *ensName, char *partName, Tcl_CmdInfo *infoPtr));
+EXTERN int Itcl_IsEnsemble _ANSI_ARGS_((Tcl_CmdInfo* infoPtr));
+EXTERN int Itcl_GetEnsembleUsage _ANSI_ARGS_((Tcl_Interp *interp,
+ char *ensName, Tcl_Obj *objPtr));
+EXTERN int Itcl_GetEnsembleUsageForObj _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *ensObjPtr, Tcl_Obj *objPtr));
+EXTERN int Itcl_EnsembleCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_EnsPartCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itcl_EnsembleErrorCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+
+
+/*
+ * Commands provided for backward compatibility
+ */
+EXTERN int Itcl_OldInit _ANSI_ARGS_((Tcl_Interp* interp,
+ ItclObjectInfo* info));
+EXTERN int Itcl_InstallOldBiMethods _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclClass *cdefn));
+
+
+/*
+ * Things that should be in the Tcl core.
+ */
+EXTERN Tcl_CallFrame* _Tcl_GetCallFrame _ANSI_ARGS_((Tcl_Interp *interp,
+ int level));
+EXTERN Tcl_CallFrame* _Tcl_ActivateCallFrame _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_CallFrame *framePtr));
+EXTERN Var* _TclNewVar _ANSI_ARGS_((void));
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* ITCLINT_H */
diff --git a/itcl/itcl/generic/itcl_bicmds.c b/itcl/itcl/generic/itcl_bicmds.c
new file mode 100644
index 00000000000..d9319a4b4e9
--- /dev/null
+++ b/itcl/itcl/generic/itcl_bicmds.c
@@ -0,0 +1,1695 @@
+/*
+ * ------------------------------------------------------------------------
+ * PACKAGE: [incr Tcl]
+ * DESCRIPTION: Object-Oriented Extensions to Tcl
+ *
+ * [incr Tcl] provides object-oriented extensions to Tcl, much as
+ * C++ provides object-oriented extensions to C. It provides a means
+ * of encapsulating related procedures together with their shared data
+ * in a local namespace that is hidden from the outside world. It
+ * promotes code re-use through inheritance. More than anything else,
+ * it encourages better organization of Tcl applications through the
+ * object-oriented paradigm, leading to code that is easier to
+ * understand and maintain.
+ *
+ * These procedures handle built-in class methods, including the
+ * "isa" method (to query hierarchy info) and the "info" method
+ * (to query class/object data).
+ *
+ * ========================================================================
+ * AUTHOR: Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ * http://www.tcltk.com/itcl
+ *
+ * RCS: $Id$
+ * ========================================================================
+ * Copyright (c) 1993-1998 Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#include "itclInt.h"
+
+/*
+ * Standard list of built-in methods for all objects.
+ */
+typedef struct BiMethod {
+ char* name; /* method name */
+ char* usage; /* string describing usage */
+ char* registration; /* registration name for C proc */
+ Tcl_ObjCmdProc *proc; /* implementation C proc */
+} BiMethod;
+
+static BiMethod BiMethodList[] = {
+ { "cget", "-option",
+ "@itcl-builtin-cget", Itcl_BiCgetCmd },
+ { "configure", "?-option? ?value -option value...?",
+ "@itcl-builtin-configure", Itcl_BiConfigureCmd },
+ { "isa", "className",
+ "@itcl-builtin-isa", Itcl_BiIsaCmd },
+};
+static int BiMethodListLen = sizeof(BiMethodList)/sizeof(BiMethod);
+
+
+/*
+ * FORWARD DECLARATIONS
+ */
+static Tcl_Obj* ItclReportPublicOpt _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclVarDefn *vdefn, ItclObject *contextObj));
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_BiInit()
+ *
+ * Creates a namespace full of built-in methods/procs for [incr Tcl]
+ * classes. This includes things like the "isa" method and "info"
+ * for querying class info. Usually invoked by Itcl_Init() when
+ * [incr Tcl] is first installed into an interpreter.
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_BiInit(interp)
+ Tcl_Interp *interp; /* current interpreter */
+{
+ int i;
+ Tcl_Namespace *itclBiNs;
+
+ /*
+ * Declare all of the built-in methods as C procedures.
+ */
+ for (i=0; i < BiMethodListLen; i++) {
+ if (Itcl_RegisterObjC(interp,
+ BiMethodList[i].registration+1, BiMethodList[i].proc,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK) {
+
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Create the "::itcl::builtin" namespace for built-in class
+ * commands. These commands are imported into each class
+ * just before the class definition is parsed.
+ */
+ Tcl_CreateObjCommand(interp, "::itcl::builtin::chain", Itcl_BiChainCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
+
+ if (Itcl_CreateEnsemble(interp, "::itcl::builtin::info") != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Itcl_AddEnsemblePart(interp, "::itcl::builtin::info",
+ "class", "",
+ Itcl_BiInfoClassCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK ||
+ Itcl_AddEnsemblePart(interp, "::itcl::builtin::info",
+ "inherit", "",
+ Itcl_BiInfoInheritCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK ||
+ Itcl_AddEnsemblePart(interp, "::itcl::builtin::info",
+ "heritage", "",
+ Itcl_BiInfoHeritageCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK ||
+ Itcl_AddEnsemblePart(interp, "::itcl::builtin::info",
+ "function", "?name? ?-protection? ?-type? ?-name? ?-args? ?-body?",
+ Itcl_BiInfoFunctionCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK ||
+ Itcl_AddEnsemblePart(interp, "::itcl::builtin::info",
+ "variable", "?name? ?-protection? ?-type? ?-name? ?-init? ?-value? ?-config?",
+ Itcl_BiInfoVariableCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK ||
+ Itcl_AddEnsemblePart(interp, "::itcl::builtin::info",
+ "args", "procname",
+ Itcl_BiInfoArgsCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK ||
+ Itcl_AddEnsemblePart(interp, "::itcl::builtin::info",
+ "body", "procname",
+ Itcl_BiInfoBodyCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK
+ ) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Add an error handler to support all of the usual inquiries
+ * for the "info" command in the global namespace.
+ */
+ if (Itcl_AddEnsemblePart(interp, "::itcl::builtin::info",
+ "@error", "",
+ Itcl_DefaultInfoCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK
+ ) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Export all commands in the built-in namespace so we can
+ * import them later on.
+ */
+ itclBiNs = Tcl_FindNamespace(interp, "::itcl::builtin",
+ (Tcl_Namespace*)NULL, TCL_LEAVE_ERR_MSG);
+
+ if (!itclBiNs ||
+ Tcl_Export(interp, itclBiNs, "*", /* resetListFirst */ 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_InstallBiMethods()
+ *
+ * Invoked when a class is first created, just after the class
+ * definition has been parsed, to add definitions for built-in
+ * methods to the class. If a method already exists in the class
+ * with the same name as the built-in, then the built-in is skipped.
+ * Otherwise, a method definition for the built-in method is added.
+ *
+ * Returns TCL_OK if successful, or TCL_ERROR (along with an error
+ * message in the interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_InstallBiMethods(interp, cdefn)
+ Tcl_Interp *interp; /* current interpreter */
+ ItclClass *cdefn; /* class definition to be updated */
+{
+ int result = TCL_OK;
+ Tcl_HashEntry *entry = NULL;
+
+ int i;
+ ItclHierIter hier;
+ ItclClass *cdPtr;
+
+ /*
+ * Scan through all of the built-in methods and see if
+ * that method already exists in the class. If not, add
+ * it in.
+ *
+ * TRICKY NOTE: The virtual tables haven't been built yet,
+ * so look for existing methods the hard way--by scanning
+ * through all classes.
+ */
+ for (i=0; i < BiMethodListLen; i++) {
+ Itcl_InitHierIter(&hier, cdefn);
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ while (cdPtr) {
+ entry = Tcl_FindHashEntry(&cdPtr->functions, BiMethodList[i].name);
+ if (entry) {
+ break;
+ }
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ }
+ Itcl_DeleteHierIter(&hier);
+
+ if (!entry) {
+ result = Itcl_CreateMethod(interp, cdefn, BiMethodList[i].name,
+ BiMethodList[i].usage, BiMethodList[i].registration);
+
+ if (result != TCL_OK) {
+ break;
+ }
+ }
+ }
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_BiIsaCmd()
+ *
+ * Invoked whenever the user issues the "isa" method for an object.
+ * Handles the following syntax:
+ *
+ * <objName> isa <className>
+ *
+ * Checks to see if the object has the given <className> anywhere
+ * in its heritage. Returns 1 if so, and 0 otherwise.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_BiIsaCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* class definition */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclClass *contextClass, *cdefn;
+ ItclObject *contextObj;
+ char *token;
+
+ /*
+ * Make sure that this command is being invoked in the proper
+ * context.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (!contextObj) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "improper usage: should be \"object isa className\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ if (objc != 2) {
+ token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be \"object ", token, " className\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look for the requested class. If it is not found, then
+ * try to autoload it. If it absolutely cannot be found,
+ * signal an error.
+ */
+ token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ cdefn = Itcl_FindClass(interp, token, /* autoload */ 1);
+ if (cdefn == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (Itcl_ObjectIsa(contextObj, cdefn)) {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+ } else {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_BiConfigureCmd()
+ *
+ * Invoked whenever the user issues the "configure" method for an object.
+ * Handles the following syntax:
+ *
+ * <objName> configure ?-<option>? ?<value> -<option> <value>...?
+ *
+ * Allows access to public variables as if they were configuration
+ * options. With no arguments, this command returns the current
+ * list of public variable options. If -<option> is specified,
+ * this returns the information for just one option:
+ *
+ * -<optionName> <initVal> <currentVal>
+ *
+ * Otherwise, the list of arguments is parsed, and values are
+ * assigned to the various public variable options. When each
+ * option changes, a big of "config" code associated with the option
+ * is executed, to bring the object up to date.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_BiConfigureCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* class definition */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+
+ int i, result;
+ char *token, *lastval;
+ ItclClass *cdPtr;
+ Tcl_HashSearch place;
+ Tcl_HashEntry *entry;
+ ItclVarDefn *vdefn;
+ ItclVarLookup *vlookup;
+ ItclMember *member;
+ ItclMemberCode *mcode;
+ ItclHierIter hier;
+ Tcl_Obj *resultPtr, *objPtr;
+ Tcl_DString buffer;
+ ItclContext context;
+ Tcl_CallFrame *oldFramePtr, *uplevelFramePtr;
+
+ /*
+ * Make sure that this command is being invoked in the proper
+ * context.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (!contextObj) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "improper usage: should be ",
+ "\"object configure ?-option? ?value -option value...?\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * BE CAREFUL: work in the virtual scope!
+ */
+ contextClass = contextObj->classDefn;
+
+ /*
+ * HANDLE: configure
+ */
+ if (objc == 1) {
+ resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
+
+ Itcl_InitHierIter(&hier, contextClass);
+ while ((cdPtr=Itcl_AdvanceHierIter(&hier)) != NULL) {
+ entry = Tcl_FirstHashEntry(&cdPtr->variables, &place);
+ while (entry) {
+ vdefn = (ItclVarDefn*)Tcl_GetHashValue(entry);
+ if (vdefn->member->protection == ITCL_PUBLIC) {
+ objPtr = ItclReportPublicOpt(interp, vdefn, contextObj);
+
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr,
+ objPtr);
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+ }
+ Itcl_DeleteHierIter(&hier);
+
+ Tcl_SetObjResult(interp, resultPtr);
+ return TCL_OK;
+ }
+
+ /*
+ * HANDLE: configure -option
+ */
+ else if (objc == 2) {
+ token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ if (*token != '-') {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "improper usage: should be ",
+ "\"object configure ?-option? ?value -option value...?\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ vlookup = NULL;
+ entry = Tcl_FindHashEntry(&contextClass->resolveVars, token+1);
+ if (entry) {
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+
+ if (vlookup->vdefn->member->protection != ITCL_PUBLIC) {
+ vlookup = NULL;
+ }
+ }
+
+ if (!vlookup) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "unknown option \"", token, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ resultPtr = ItclReportPublicOpt(interp, vlookup->vdefn, contextObj);
+ Tcl_SetObjResult(interp, resultPtr);
+ return TCL_OK;
+ }
+
+ /*
+ * HANDLE: configure -option value -option value...
+ *
+ * Be careful to work in the virtual scope. If this "configure"
+ * method was defined in a base class, the current namespace
+ * (from Itcl_ExecMethod()) will be that base class. Activate
+ * the derived class namespace here, so that instance variables
+ * are accessed properly.
+ */
+ result = TCL_OK;
+
+ if (Itcl_PushContext(interp, (ItclMember*)NULL, contextObj->classDefn,
+ contextObj, &context) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_DStringInit(&buffer);
+
+ for (i=1; i < objc; i+=2) {
+ vlookup = NULL;
+ token = Tcl_GetStringFromObj(objv[i], (int*)NULL);
+ if (*token == '-') {
+ entry = Tcl_FindHashEntry(&contextClass->resolveVars, token+1);
+ if (entry) {
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+ }
+ }
+
+ if (!vlookup || vlookup->vdefn->member->protection != ITCL_PUBLIC) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "unknown option \"", token, "\"",
+ (char*)NULL);
+ result = TCL_ERROR;
+ goto configureDone;
+ }
+ if (i == objc-1) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "value for \"", token, "\" missing",
+ (char*)NULL);
+ result = TCL_ERROR;
+ goto configureDone;
+ }
+
+ member = vlookup->vdefn->member;
+ lastval = Tcl_GetVar2(interp, member->fullname, (char*)NULL, 0);
+ Tcl_DStringSetLength(&buffer, 0);
+ Tcl_DStringAppend(&buffer, (lastval) ? lastval : "", -1);
+
+ token = Tcl_GetStringFromObj(objv[i+1], (int*)NULL);
+
+ if (Tcl_SetVar2(interp, member->fullname, (char*)NULL, token,
+ TCL_LEAVE_ERR_MSG) == NULL) {
+
+ char msg[256];
+ sprintf(msg, "\n (error in configuration of public variable \"%.100s\")", member->fullname);
+ Tcl_AddErrorInfo(interp, msg);
+ result = TCL_ERROR;
+ goto configureDone;
+ }
+
+ /*
+ * If this variable has some "config" code, invoke it now.
+ *
+ * TRICKY NOTE: Be careful to evaluate the code one level
+ * up in the call stack, so that it's executed in the
+ * calling context, and not in the context that we've
+ * set up for public variable access.
+ */
+ mcode = member->code;
+ if (mcode && mcode->procPtr->bodyPtr) {
+
+ uplevelFramePtr = _Tcl_GetCallFrame(interp, 1);
+ oldFramePtr = _Tcl_ActivateCallFrame(interp, uplevelFramePtr);
+
+ result = Itcl_EvalMemberCode(interp, (ItclMemberFunc*)NULL,
+ member, contextObj, 0, (Tcl_Obj**)NULL);
+
+ (void) _Tcl_ActivateCallFrame(interp, oldFramePtr);
+
+ if (result == TCL_OK) {
+ Tcl_ResetResult(interp);
+ } else {
+ char msg[256];
+ sprintf(msg, "\n (error in configuration of public variable \"%.100s\")", member->fullname);
+ Tcl_AddErrorInfo(interp, msg);
+
+ Tcl_SetVar2(interp, member->fullname,(char*)NULL,
+ Tcl_DStringValue(&buffer), 0);
+
+ goto configureDone;
+ }
+ }
+ }
+
+configureDone:
+ Itcl_PopContext(interp, &context);
+ Tcl_DStringFree(&buffer);
+
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_BiCgetCmd()
+ *
+ * Invoked whenever the user issues the "cget" method for an object.
+ * Handles the following syntax:
+ *
+ * <objName> cget -<option>
+ *
+ * Allows access to public variables as if they were configuration
+ * options. Mimics the behavior of the usual "cget" method for
+ * Tk widgets. Returns the current value of the public variable
+ * with name <option>.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_BiCgetCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* class definition */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+
+ char *name, *val;
+ ItclVarLookup *vlookup;
+ Tcl_HashEntry *entry;
+
+ /*
+ * Make sure that this command is being invoked in the proper
+ * context.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (!contextObj || objc != 2) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "improper usage: should be \"object cget -option\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * BE CAREFUL: work in the virtual scope!
+ */
+ contextClass = contextObj->classDefn;
+
+ name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+
+ vlookup = NULL;
+ entry = Tcl_FindHashEntry(&contextClass->resolveVars, name+1);
+ if (entry) {
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+ }
+
+ if (!vlookup || vlookup->vdefn->member->protection != ITCL_PUBLIC) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "unknown option \"", name, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ val = Itcl_GetInstanceVar(interp, vlookup->vdefn->member->fullname,
+ contextObj, contextObj->classDefn);
+
+ if (val) {
+ Tcl_SetResult(interp, val, TCL_VOLATILE);
+ } else {
+ Tcl_SetResult(interp, "<undefined>", TCL_STATIC);
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclReportPublicOpt()
+ *
+ * Returns information about a public variable formatted as a
+ * configuration option:
+ *
+ * -<varName> <initVal> <currentVal>
+ *
+ * Used by Itcl_BiConfigureCmd() to report configuration options.
+ * Returns a Tcl_Obj containing the information.
+ * ------------------------------------------------------------------------
+ */
+static Tcl_Obj*
+ItclReportPublicOpt(interp, vdefn, contextObj)
+ Tcl_Interp *interp; /* interpreter containing the object */
+ ItclVarDefn *vdefn; /* public variable to be reported */
+ ItclObject *contextObj; /* object containing this variable */
+{
+ char *val;
+ ItclClass *cdefnPtr;
+ Tcl_HashEntry *entry;
+ ItclVarLookup *vlookup;
+ Tcl_DString optName;
+ Tcl_Obj *listPtr, *objPtr;
+
+ listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
+
+ /*
+ * Determine how the option name should be reported.
+ * If the simple name can be used to find it in the virtual
+ * data table, then use the simple name. Otherwise, this
+ * is a shadowed variable; use the full name.
+ */
+ Tcl_DStringInit(&optName);
+ Tcl_DStringAppend(&optName, "-", -1);
+
+ cdefnPtr = (ItclClass*)contextObj->classDefn;
+ entry = Tcl_FindHashEntry(&cdefnPtr->resolveVars, vdefn->member->fullname);
+ assert(entry != NULL);
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+ Tcl_DStringAppend(&optName, vlookup->leastQualName, -1);
+
+ objPtr = Tcl_NewStringObj(Tcl_DStringValue(&optName), -1);
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);
+ Tcl_DStringFree(&optName);
+
+
+ if (vdefn->init) {
+ objPtr = Tcl_NewStringObj(vdefn->init, -1);
+ } else {
+ objPtr = Tcl_NewStringObj("<undefined>", -1);
+ }
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);
+
+ val = Itcl_GetInstanceVar(interp, vdefn->member->fullname, contextObj,
+ contextObj->classDefn);
+
+ if (val) {
+ objPtr = Tcl_NewStringObj(val, -1);
+ } else {
+ objPtr = Tcl_NewStringObj("<undefined>", -1);
+ }
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);
+
+ return listPtr;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_BiChainCmd()
+ *
+ * Invoked to handle the "chain" command, to access the version of
+ * a method or proc that exists in a base class. Handles the
+ * following syntax:
+ *
+ * chain ?<arg> <arg>...?
+ *
+ * Looks up the inheritance hierarchy for another implementation
+ * of the method/proc that is currently executing. If another
+ * implementation is found, it is invoked with the specified
+ * <arg> arguments. If it is not found, this command does nothing.
+ * This allows a base class method to be called out in a generic way,
+ * so the code will not have to change if the base class changes.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_BiChainCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int result = TCL_OK;
+
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+
+ char *cmd, *head;
+ ItclClass *cdefn;
+ ItclHierIter hier;
+ Tcl_HashEntry *entry;
+ ItclMemberFunc *mfunc;
+ Tcl_DString buffer;
+ CallFrame *framePtr;
+ Tcl_Obj *cmdlinePtr, **newobjv;
+
+ /*
+ * If this command is not invoked within a class namespace,
+ * signal an error.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot chain functions outside of a class context",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Try to get the command name from the current call frame.
+ * If it cannot be determined, do nothing. Otherwise, trim
+ * off any leading path names.
+ */
+ framePtr = (CallFrame*) _Tcl_GetCallFrame(interp, 0);
+ if (!framePtr || !framePtr->objv) {
+ return TCL_OK;
+ }
+ cmd = Tcl_GetStringFromObj(framePtr->objv[0], (int*)NULL);
+ Itcl_ParseNamespPath(cmd, &buffer, &head, &cmd);
+
+ /*
+ * Look for the specified command in one of the base classes.
+ * If we have an object context, then start from the most-specific
+ * class and walk up the hierarchy to the current context. If
+ * there is multiple inheritance, having the entire inheritance
+ * hierarchy will allow us to jump over to another branch of
+ * the inheritance tree.
+ *
+ * If there is no object context, just start with the current
+ * class context.
+ */
+ if (contextObj) {
+ Itcl_InitHierIter(&hier, contextObj->classDefn);
+ while ((cdefn=Itcl_AdvanceHierIter(&hier)) != NULL) {
+ if (cdefn == contextClass) {
+ break;
+ }
+ }
+ }
+ else {
+ Itcl_InitHierIter(&hier, contextClass);
+ Itcl_AdvanceHierIter(&hier); /* skip the current class */
+ }
+
+ /*
+ * Now search up the class hierarchy for the next implementation.
+ * If found, execute it. Otherwise, do nothing.
+ */
+ while ((cdefn=Itcl_AdvanceHierIter(&hier)) != NULL) {
+ entry = Tcl_FindHashEntry(&cdefn->functions, cmd);
+ if (entry) {
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+
+ /*
+ * NOTE: Avoid the usual "virtual" behavior of
+ * methods by passing the full name as
+ * the command argument.
+ */
+ cmdlinePtr = Itcl_CreateArgs(interp, mfunc->member->fullname,
+ objc-1, objv+1);
+
+ (void) Tcl_ListObjGetElements((Tcl_Interp*)NULL, cmdlinePtr,
+ &objc, &newobjv);
+
+ result = Itcl_EvalArgs(interp, objc, newobjv);
+
+ Tcl_DecrRefCount(cmdlinePtr);
+ break;
+ }
+ }
+
+ Tcl_DStringFree(&buffer);
+ Itcl_DeleteHierIter(&hier);
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_BiInfoClassCmd()
+ *
+ * Returns information regarding the class for an object. This command
+ * can be invoked with or without an object context:
+ *
+ * <objName> info class <= returns most-specific class name
+ * info class <= returns active namespace name
+ *
+ * Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_BiInfoClassCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ Tcl_Namespace *activeNs = Tcl_GetCurrentNamespace(interp);
+ Tcl_Namespace *contextNs = NULL;
+
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+
+ char *name;
+
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If this command is not invoked within a class namespace,
+ * signal an error.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ name = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\nget info like this instead: ",
+ "\n namespace eval className { info ", name, "... }",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If there is an object context, then return the most-specific
+ * class for the object. Otherwise, return the class namespace
+ * name. Use normal class names when possible.
+ */
+ if (contextObj) {
+ contextNs = contextObj->classDefn->namesp;
+ }
+
+ if (contextNs->parentPtr == activeNs) {
+ name = contextNs->name;
+ } else {
+ name = contextNs->fullName;
+ }
+
+ Tcl_SetResult(interp, name, TCL_VOLATILE);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_BiInfoInheritCmd()
+ *
+ * Returns the list of base classes for the current class context.
+ * Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_BiInfoInheritCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ Tcl_Namespace *activeNs = Tcl_GetCurrentNamespace(interp);
+
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+
+ ItclClass *cdefn;
+ Itcl_ListElem *elem;
+ Tcl_Obj *listPtr, *objPtr;
+
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If this command is not invoked within a class namespace,
+ * signal an error.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ char *name = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\nget info like this instead: ",
+ "\n namespace eval className { info ", name, "... }",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Return the list of base classes.
+ */
+ listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
+
+ elem = Itcl_FirstListElem(&contextClass->bases);
+ while (elem) {
+ cdefn = (ItclClass*)Itcl_GetListValue(elem);
+ if (cdefn->namesp->parentPtr == activeNs) {
+ objPtr = Tcl_NewStringObj(cdefn->namesp->name, -1);
+ } else {
+ objPtr = Tcl_NewStringObj(cdefn->namesp->fullName, -1);
+ }
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);
+ elem = Itcl_NextListElem(elem);
+ }
+
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_BiInfoHeritageCmd()
+ *
+ * Returns the entire derivation hierarchy for this class, presented
+ * in the order that classes are traversed for finding data members
+ * and member functions.
+ *
+ * Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_BiInfoHeritageCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ Tcl_Namespace *activeNs = Tcl_GetCurrentNamespace(interp);
+
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+
+ char *name;
+ ItclHierIter hier;
+ Tcl_Obj *listPtr, *objPtr;
+ ItclClass *cdefn;
+
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If this command is not invoked within a class namespace,
+ * signal an error.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ name = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\nget info like this instead: ",
+ "\n namespace eval className { info ", name, "... }",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Traverse through the derivation hierarchy and return
+ * base class names.
+ */
+ listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
+
+ Itcl_InitHierIter(&hier, contextClass);
+ while ((cdefn=Itcl_AdvanceHierIter(&hier)) != NULL) {
+ if (cdefn->namesp->parentPtr == activeNs) {
+ objPtr = Tcl_NewStringObj(cdefn->namesp->name, -1);
+ } else {
+ objPtr = Tcl_NewStringObj(cdefn->namesp->fullName, -1);
+ }
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objPtr);
+ }
+ Itcl_DeleteHierIter(&hier);
+
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_BiInfoFunctionCmd()
+ *
+ * Returns information regarding class member functions (methods/procs).
+ * Handles the following syntax:
+ *
+ * info function ?cmdName? ?-protection? ?-type? ?-name? ?-args? ?-body?
+ *
+ * If the ?cmdName? is not specified, then a list of all known
+ * command members is returned. Otherwise, the information for
+ * a specific command is returned. Returns a status TCL_OK/TCL_ERROR
+ * to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_BiInfoFunctionCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ char *cmdName = NULL;
+ Tcl_Obj *resultPtr = NULL;
+ Tcl_Obj *objPtr = NULL;
+
+ static char *options[] = {
+ "-args", "-body", "-name", "-protection", "-type",
+ (char*)NULL
+ };
+ enum BIfIdx {
+ BIfArgsIdx, BIfBodyIdx, BIfNameIdx, BIfProtectIdx, BIfTypeIdx
+ } *iflist, iflistStorage[5];
+
+ static enum BIfIdx DefInfoFunction[5] = {
+ BIfProtectIdx,
+ BIfTypeIdx,
+ BIfNameIdx,
+ BIfArgsIdx,
+ BIfBodyIdx
+ };
+
+ ItclClass *contextClass, *cdefn;
+ ItclObject *contextObj;
+
+ int i, result;
+ char *name, *val;
+ Tcl_HashSearch place;
+ Tcl_HashEntry *entry;
+ ItclMemberFunc *mfunc;
+ ItclMemberCode *mcode;
+ ItclHierIter hier;
+
+ /*
+ * If this command is not invoked within a class namespace,
+ * signal an error.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ name = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\nget info like this instead: ",
+ "\n namespace eval className { info ", name, "... }",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Process args:
+ * ?cmdName? ?-protection? ?-type? ?-name? ?-args? ?-body?
+ */
+ objv++; /* skip over command name */
+ objc--;
+
+ if (objc > 0) {
+ cmdName = Tcl_GetStringFromObj(*objv, (int*)NULL);
+ objc--; objv++;
+ }
+
+ /*
+ * Return info for a specific command.
+ */
+ if (cmdName) {
+ entry = Tcl_FindHashEntry(&contextClass->resolveCmds, cmdName);
+ if (entry == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\"", cmdName, "\" isn't a member function in class \"",
+ contextClass->namesp->fullName, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+ mcode = mfunc->member->code;
+
+ /*
+ * By default, return everything.
+ */
+ if (objc == 0) {
+ objc = 5;
+ iflist = DefInfoFunction;
+ }
+
+ /*
+ * Otherwise, scan through all remaining flags and
+ * figure out what to return.
+ */
+ else {
+ iflist = &iflistStorage[0];
+ for (i=0 ; i < objc; i++) {
+ result = Tcl_GetIndexFromObj(interp, objv[i],
+ options, "option", 0, (int*)(&iflist[i]));
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ if (objc > 1) {
+ resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
+ }
+
+ for (i=0 ; i < objc; i++) {
+ switch (iflist[i]) {
+ case BIfArgsIdx:
+ if (mcode && mcode->arglist) {
+ objPtr = Itcl_ArgList(mcode->argcount, mcode->arglist);
+ }
+ else if ((mfunc->member->flags & ITCL_ARG_SPEC) != 0) {
+ objPtr = Itcl_ArgList(mfunc->argcount, mfunc->arglist);
+ }
+ else {
+ objPtr = Tcl_NewStringObj("<undefined>", -1);
+ }
+ break;
+
+ case BIfBodyIdx:
+ if (mcode && mcode->procPtr->bodyPtr) {
+ objPtr = mcode->procPtr->bodyPtr;
+ } else {
+ objPtr = Tcl_NewStringObj("<undefined>", -1);
+ }
+ break;
+
+ case BIfNameIdx:
+ objPtr = Tcl_NewStringObj(mfunc->member->fullname, -1);
+ break;
+
+ case BIfProtectIdx:
+ val = Itcl_ProtectionStr(mfunc->member->protection);
+ objPtr = Tcl_NewStringObj(val, -1);
+ break;
+
+ case BIfTypeIdx:
+ val = ((mfunc->member->flags & ITCL_COMMON) != 0)
+ ? "proc" : "method";
+ objPtr = Tcl_NewStringObj(val, -1);
+ break;
+ }
+
+ if (objc == 1) {
+ resultPtr = objPtr;
+ } else {
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr, objPtr);
+ }
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ }
+
+ /*
+ * Return the list of available commands.
+ */
+ else {
+ resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
+
+ Itcl_InitHierIter(&hier, contextClass);
+ while ((cdefn=Itcl_AdvanceHierIter(&hier)) != NULL) {
+ entry = Tcl_FirstHashEntry(&cdefn->functions, &place);
+ while (entry) {
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+ objPtr = Tcl_NewStringObj(mfunc->member->fullname, -1);
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr, objPtr);
+
+ entry = Tcl_NextHashEntry(&place);
+ }
+ }
+ Itcl_DeleteHierIter(&hier);
+
+ Tcl_SetObjResult(interp, resultPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_BiInfoVariableCmd()
+ *
+ * Returns information regarding class data members (variables and
+ * commons). Handles the following syntax:
+ *
+ * info variable ?varName? ?-protection? ?-type? ?-name?
+ * ?-init? ?-config? ?-value?
+ *
+ * If the ?varName? is not specified, then a list of all known
+ * data members is returned. Otherwise, the information for a
+ * specific member is returned. Returns a status TCL_OK/TCL_ERROR
+ * to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_BiInfoVariableCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ char *varName = NULL;
+ Tcl_Obj *resultPtr = NULL;
+ Tcl_Obj *objPtr = NULL;
+
+ static char *options[] = {
+ "-config", "-init", "-name", "-protection", "-type",
+ "-value", (char*)NULL
+ };
+ enum BIvIdx {
+ BIvConfigIdx, BIvInitIdx, BIvNameIdx, BIvProtectIdx,
+ BIvTypeIdx, BIvValueIdx
+ } *ivlist, ivlistStorage[6];
+
+ static enum BIvIdx DefInfoVariable[5] = {
+ BIvProtectIdx,
+ BIvTypeIdx,
+ BIvNameIdx,
+ BIvInitIdx,
+ BIvValueIdx
+ };
+
+ static enum BIvIdx DefInfoPubVariable[6] = {
+ BIvProtectIdx,
+ BIvTypeIdx,
+ BIvNameIdx,
+ BIvInitIdx,
+ BIvConfigIdx,
+ BIvValueIdx
+ };
+
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+
+ int i, result;
+ char *val, *name;
+ ItclClass *cdefn;
+ Tcl_HashSearch place;
+ Tcl_HashEntry *entry;
+ ItclVarDefn *vdefn;
+ ItclVarLookup *vlookup;
+ ItclMember *member;
+ ItclHierIter hier;
+
+ /*
+ * If this command is not invoked within a class namespace,
+ * signal an error.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ name = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\nget info like this instead: ",
+ "\n namespace eval className { info ", name, "... }",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Process args:
+ * ?varName? ?-protection? ?-type? ?-name? ?-init? ?-config? ?-value?
+ */
+ objv++; /* skip over command name */
+ objc--;
+
+ if (objc > 0) {
+ varName = Tcl_GetStringFromObj(*objv, (int*)NULL);
+ objc--; objv++;
+ }
+
+ /*
+ * Return info for a specific variable.
+ */
+ if (varName) {
+ entry = Tcl_FindHashEntry(&contextClass->resolveVars, varName);
+ if (entry == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\"", varName, "\" isn't a variable in class \"",
+ contextClass->namesp->fullName, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+ member = vlookup->vdefn->member;
+
+ /*
+ * By default, return everything.
+ */
+ if (objc == 0) {
+ if (member->protection == ITCL_PUBLIC &&
+ ((member->flags & ITCL_COMMON) == 0)) {
+ ivlist = DefInfoPubVariable;
+ objc = 6;
+ } else {
+ ivlist = DefInfoVariable;
+ objc = 5;
+ }
+ }
+
+ /*
+ * Otherwise, scan through all remaining flags and
+ * figure out what to return.
+ */
+ else {
+ ivlist = &ivlistStorage[0];
+ for (i=0 ; i < objc; i++) {
+ result = Tcl_GetIndexFromObj(interp, objv[i],
+ options, "option", 0, (int*)(&ivlist[i]));
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ if (objc > 1) {
+ resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
+ }
+
+ for (i=0 ; i < objc; i++) {
+ switch (ivlist[i]) {
+ case BIvConfigIdx:
+ if (member->code && member->code->procPtr->bodyPtr) {
+ objPtr = member->code->procPtr->bodyPtr;
+ } else {
+ objPtr = Tcl_NewStringObj("", -1);
+ }
+ break;
+
+ case BIvInitIdx:
+ /*
+ * If this is the built-in "this" variable, then
+ * report the object name as its initialization string.
+ */
+ if ((member->flags & ITCL_THIS_VAR) != 0) {
+ if (contextObj && contextObj->accessCmd) {
+ objPtr = Tcl_NewStringObj((char*)NULL, 0);
+ Tcl_GetCommandFullName(
+ contextObj->classDefn->interp,
+ contextObj->accessCmd, objPtr);
+ } else {
+ objPtr = Tcl_NewStringObj("<objectName>", -1);
+ }
+ }
+ else if (vlookup->vdefn->init) {
+ objPtr = Tcl_NewStringObj(vlookup->vdefn->init, -1);
+ }
+ else {
+ objPtr = Tcl_NewStringObj("<undefined>", -1);
+ }
+ break;
+
+ case BIvNameIdx:
+ objPtr = Tcl_NewStringObj(member->fullname, -1);
+ break;
+
+ case BIvProtectIdx:
+ val = Itcl_ProtectionStr(member->protection);
+ objPtr = Tcl_NewStringObj(val, -1);
+ break;
+
+ case BIvTypeIdx:
+ val = ((member->flags & ITCL_COMMON) != 0)
+ ? "common" : "variable";
+ objPtr = Tcl_NewStringObj(val, -1);
+ break;
+
+ case BIvValueIdx:
+ if ((member->flags & ITCL_COMMON) != 0) {
+ val = Itcl_GetCommonVar(interp, member->fullname,
+ member->classDefn);
+ }
+ else if (contextObj == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp,
+ "cannot access object-specific info ",
+ "without an object context",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ else {
+ val = Itcl_GetInstanceVar(interp, member->fullname,
+ contextObj, member->classDefn);
+ }
+
+ if (val == NULL) {
+ val = "<undefined>";
+ }
+ objPtr = Tcl_NewStringObj(val, -1);
+ break;
+ }
+
+ if (objc == 1) {
+ resultPtr = objPtr;
+ } else {
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, resultPtr,
+ objPtr);
+ }
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ }
+
+ /*
+ * Return the list of available variables. Report the built-in
+ * "this" variable only once, for the most-specific class.
+ */
+ else {
+ resultPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
+
+ Itcl_InitHierIter(&hier, contextClass);
+ while ((cdefn=Itcl_AdvanceHierIter(&hier)) != NULL) {
+ entry = Tcl_FirstHashEntry(&cdefn->variables, &place);
+ while (entry) {
+ vdefn = (ItclVarDefn*)Tcl_GetHashValue(entry);
+ if ((vdefn->member->flags & ITCL_THIS_VAR) != 0) {
+ if (cdefn == contextClass) {
+ objPtr = Tcl_NewStringObj(vdefn->member->fullname, -1);
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
+ resultPtr, objPtr);
+ }
+ }
+ else {
+ objPtr = Tcl_NewStringObj(vdefn->member->fullname, -1);
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
+ resultPtr, objPtr);
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+ }
+ Itcl_DeleteHierIter(&hier);
+
+ Tcl_SetObjResult(interp, resultPtr);
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_BiInfoBodyCmd()
+ *
+ * Handles the usual "info body" request, returning the body for a
+ * specific proc. Included here for backward compatibility, since
+ * otherwise Tcl would complain that class procs are not real "procs".
+ * Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_BiInfoBodyCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ char *name;
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+ ItclMemberFunc *mfunc;
+ ItclMemberCode *mcode;
+ Tcl_HashEntry *entry;
+ Tcl_Obj *objPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "function");
+ return TCL_ERROR;
+ }
+
+ /*
+ * If this command is not invoked within a class namespace,
+ * then treat the procedure name as a normal Tcl procedure.
+ */
+ if (!Itcl_IsClassNamespace(Tcl_GetCurrentNamespace(interp))) {
+ Proc *procPtr;
+
+ name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ procPtr = TclFindProc((Interp*)interp, name);
+ if (procPtr == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\"", name, "\" isn't a procedure",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetObjResult(interp, procPtr->bodyPtr);
+ }
+
+ /*
+ * Otherwise, treat the name as a class method/proc.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ name = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\nget info like this instead: ",
+ "\n namespace eval className { info ", name, "... }",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ entry = Tcl_FindHashEntry(&contextClass->resolveCmds, name);
+ if (entry == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\"", name, "\" isn't a procedure",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+ mcode = mfunc->member->code;
+
+ /*
+ * Return a string describing the implementation.
+ */
+ if (mcode && mcode->procPtr->bodyPtr) {
+ objPtr = mcode->procPtr->bodyPtr;
+ } else {
+ objPtr = Tcl_NewStringObj("<undefined>", -1);
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_BiInfoArgsCmd()
+ *
+ * Handles the usual "info args" request, returning the argument list
+ * for a specific proc. Included here for backward compatibility, since
+ * otherwise Tcl would complain that class procs are not real "procs".
+ * Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_BiInfoArgsCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ char *name;
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+ ItclMemberFunc *mfunc;
+ ItclMemberCode *mcode;
+ Tcl_HashEntry *entry;
+ Tcl_Obj *objPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "function");
+ return TCL_ERROR;
+ }
+
+ name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+
+ /*
+ * If this command is not invoked within a class namespace,
+ * then treat the procedure name as a normal Tcl procedure.
+ */
+ if (!Itcl_IsClassNamespace(Tcl_GetCurrentNamespace(interp))) {
+ Proc *procPtr;
+ CompiledLocal *localPtr;
+
+ procPtr = TclFindProc((Interp*)interp, name);
+ if (procPtr == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\"", name, "\" isn't a procedure",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ objPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
+ for (localPtr = procPtr->firstLocalPtr;
+ localPtr != NULL;
+ localPtr = localPtr->nextPtr) {
+ if (TclIsVarArgument(localPtr)) {
+ Tcl_ListObjAppendElement(interp, objPtr,
+ Tcl_NewStringObj(localPtr->name, -1));
+ }
+ }
+
+ Tcl_SetObjResult(interp, objPtr);
+ }
+
+ /*
+ * Otherwise, treat the name as a class method/proc.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ name = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\nget info like this instead: ",
+ "\n namespace eval className { info ", name, "... }",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ entry = Tcl_FindHashEntry(&contextClass->resolveCmds, name);
+ if (entry == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\"", name, "\" isn't a procedure",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+ mcode = mfunc->member->code;
+
+ /*
+ * Return a string describing the argument list.
+ */
+ if (mcode && mcode->arglist != NULL) {
+ objPtr = Itcl_ArgList(mcode->argcount, mcode->arglist);
+ }
+ else if ((mfunc->member->flags & ITCL_ARG_SPEC) != 0) {
+ objPtr = Itcl_ArgList(mfunc->argcount, mfunc->arglist);
+ }
+ else {
+ objPtr = Tcl_NewStringObj("<undefined>", -1);
+ }
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_DefaultInfoCmd()
+ *
+ * Handles any unknown options for the "itcl::builtin::info" command
+ * by passing requests on to the usual "::info" command. If the
+ * option is recognized, then it is handled. Otherwise, if it is
+ * still unknown, then an error message is returned with the list
+ * of possible options.
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_DefaultInfoCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int result;
+ char *name;
+ Tcl_Command cmd;
+ Command *cmdPtr;
+ Tcl_Obj *resultPtr;
+
+ /*
+ * Look for the usual "::info" command, and use it to
+ * evaluate the unknown option.
+ */
+ cmd = Tcl_FindCommand(interp, "::info", (Tcl_Namespace*)NULL, 0);
+ if (cmd == NULL) {
+ name = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_ResetResult(interp);
+
+ resultPtr = Tcl_GetObjResult(interp);
+ Tcl_AppendStringsToObj(resultPtr,
+ "bad option \"", name, "\" should be one of...\n",
+ (char*)NULL);
+ Itcl_GetEnsembleUsageForObj(interp, objv[0], resultPtr);
+
+ return TCL_ERROR;
+ }
+
+ cmdPtr = (Command*)cmd;
+ result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+
+ /*
+ * If the option was not recognized by the usual "info" command,
+ * then we got a "bad option" error message. Add the options
+ * for the current ensemble to the error message.
+ */
+ if (result != TCL_OK && strncmp(interp->result,"bad option",10) == 0) {
+ resultPtr = Tcl_GetObjResult(interp);
+ Tcl_AppendToObj(resultPtr, "\nor", -1);
+ Itcl_GetEnsembleUsageForObj(interp, objv[0], resultPtr);
+ }
+ return result;
+}
diff --git a/itcl/itcl/generic/itcl_class.c b/itcl/itcl/generic/itcl_class.c
new file mode 100644
index 00000000000..9ef772a55ee
--- /dev/null
+++ b/itcl/itcl/generic/itcl_class.c
@@ -0,0 +1,1728 @@
+/*
+ * ------------------------------------------------------------------------
+ * PACKAGE: [incr Tcl]
+ * DESCRIPTION: Object-Oriented Extensions to Tcl
+ *
+ * [incr Tcl] provides object-oriented extensions to Tcl, much as
+ * C++ provides object-oriented extensions to C. It provides a means
+ * of encapsulating related procedures together with their shared data
+ * in a local namespace that is hidden from the outside world. It
+ * promotes code re-use through inheritance. More than anything else,
+ * it encourages better organization of Tcl applications through the
+ * object-oriented paradigm, leading to code that is easier to
+ * understand and maintain.
+ *
+ * These procedures handle class definitions. Classes are composed of
+ * data members (public/protected/common) and the member functions
+ * (methods/procs) that operate on them. Each class has its own
+ * namespace which manages the class scope.
+ *
+ * ========================================================================
+ * AUTHOR: Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ * http://www.tcltk.com/itcl
+ *
+ * RCS: $Id$
+ * ========================================================================
+ * Copyright (c) 1993-1998 Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#include "itclInt.h"
+
+/*
+ * This structure is a subclass of Tcl_ResolvedVarInfo that contains the
+ * ItclVarLookup info needed at runtime.
+ */
+typedef struct ItclResolvedVarInfo {
+ Tcl_ResolvedVarInfo vinfo; /* This must be the first element. */
+ ItclVarLookup *vlookup; /* Pointer to lookup info. */
+} ItclResolvedVarInfo;
+
+/*
+ * FORWARD DECLARATIONS
+ */
+static void ItclDestroyClass _ANSI_ARGS_((ClientData cdata));
+static void ItclDestroyClassNamesp _ANSI_ARGS_((ClientData cdata));
+static void ItclFreeClass _ANSI_ARGS_((char* cdata));
+
+static Tcl_Var ItclClassRuntimeVarResolver _ANSI_ARGS_((
+ Tcl_Interp *interp, Tcl_ResolvedVarInfo *vinfoPtr));
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_CreateClass()
+ *
+ * Creates a namespace and its associated class definition data.
+ * If a namespace already exists with that name, then this routine
+ * returns TCL_ERROR, along with an error message in the interp.
+ * If successful, it returns TCL_OK and a pointer to the new class
+ * definition.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_CreateClass(interp, path, info, rPtr)
+ Tcl_Interp* interp; /* interpreter that will contain new class */
+ char* path; /* name of new class */
+ ItclObjectInfo *info; /* info for all known objects */
+ ItclClass **rPtr; /* returns: pointer to class definition */
+{
+ char *head, *tail;
+ Tcl_DString buffer;
+ Tcl_Command cmd;
+ Tcl_Namespace *classNs;
+ ItclClass *cdPtr;
+ ItclVarDefn *vdefn;
+ Tcl_HashEntry *entry;
+ int newEntry;
+
+ /*
+ * Make sure that a class with the given name does not
+ * already exist in the current namespace context. If a
+ * namespace exists, that's okay. It may have been created
+ * to contain stubs during a "namespace import" operation.
+ * We'll just replace the namespace data below with the
+ * proper class data.
+ */
+ classNs = Tcl_FindNamespace(interp, path, (Tcl_Namespace*)NULL,
+ /* flags */ 0);
+
+ if (classNs != NULL && Itcl_IsClassNamespace(classNs)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "class \"", path, "\" already exists",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that a command with the given class name does not
+ * already exist in the current namespace. This prevents the
+ * usual Tcl commands from being clobbered when a programmer
+ * makes a bogus call like "class info".
+ */
+ cmd = Tcl_FindCommand(interp, path, (Tcl_Namespace*)NULL,
+ /* flags */ TCL_NAMESPACE_ONLY);
+
+ if (cmd != NULL && !Itcl_IsStub(cmd)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "command \"", path, "\" already exists",
+ (char*)NULL);
+
+ if (strstr(path,"::") == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ " in namespace \"",
+ Tcl_GetCurrentNamespace(interp)->fullName, "\"",
+ (char*)NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that the class name does not have any goofy
+ * characters:
+ *
+ * . => reserved for member access like: class.publicVar
+ */
+ Itcl_ParseNamespPath(path, &buffer, &head, &tail);
+
+ if (strstr(tail,".")) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad class name \"", tail, "\"",
+ (char*)NULL);
+ Tcl_DStringFree(&buffer);
+ return TCL_ERROR;
+ }
+ Tcl_DStringFree(&buffer);
+
+ /*
+ * Allocate class definition data.
+ */
+ cdPtr = (ItclClass*)ckalloc(sizeof(ItclClass));
+ cdPtr->name = NULL;
+ cdPtr->fullname = NULL;
+ cdPtr->interp = interp;
+ cdPtr->info = info; Itcl_PreserveData((ClientData)info);
+ cdPtr->namesp = NULL;
+ cdPtr->accessCmd = NULL;
+
+ Tcl_InitHashTable(&cdPtr->variables, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&cdPtr->functions, TCL_STRING_KEYS);
+
+ cdPtr->numInstanceVars = 0;
+ Tcl_InitHashTable(&cdPtr->resolveVars, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&cdPtr->resolveCmds, TCL_STRING_KEYS);
+
+ Itcl_InitList(&cdPtr->bases);
+ Itcl_InitList(&cdPtr->derived);
+
+ cdPtr->initCode = NULL;
+ cdPtr->unique = 0;
+ cdPtr->flags = 0;
+
+ /*
+ * Initialize the heritage info--each class starts with its
+ * own class definition in the heritage. Base classes are
+ * added to the heritage from the "inherit" statement.
+ */
+ Tcl_InitHashTable(&cdPtr->heritage, TCL_ONE_WORD_KEYS);
+ (void) Tcl_CreateHashEntry(&cdPtr->heritage, (char*)cdPtr, &newEntry);
+
+ /*
+ * Create a namespace to represent the class. Add the class
+ * definition info as client data for the namespace. If the
+ * namespace already exists, then replace any existing client
+ * data with the class data.
+ */
+ Itcl_PreserveData((ClientData)cdPtr);
+
+ if (classNs == NULL) {
+ classNs = Tcl_CreateNamespace(interp, path,
+ (ClientData)cdPtr, ItclDestroyClassNamesp);
+ }
+ else {
+ if (classNs->clientData && classNs->deleteProc) {
+ (*classNs->deleteProc)(classNs->clientData);
+ }
+ classNs->clientData = (ClientData)cdPtr;
+ classNs->deleteProc = ItclDestroyClassNamesp;
+ }
+
+ Itcl_EventuallyFree((ClientData)cdPtr, ItclFreeClass);
+
+ if (classNs == NULL) {
+ Itcl_ReleaseData((ClientData)cdPtr);
+ return TCL_ERROR;
+ }
+
+ cdPtr->namesp = classNs;
+
+ cdPtr->name = (char*)ckalloc((unsigned)(strlen(classNs->name)+1));
+ strcpy(cdPtr->name, classNs->name);
+
+ cdPtr->fullname = (char*)ckalloc((unsigned)(strlen(classNs->fullName)+1));
+ strcpy(cdPtr->fullname, classNs->fullName);
+
+ /*
+ * Add special name resolution procedures to the class namespace
+ * so that members are accessed according to the rules for
+ * [incr Tcl].
+ */
+ Tcl_SetNamespaceResolvers(classNs, Itcl_ClassCmdResolver,
+ Itcl_ClassVarResolver, Itcl_ClassCompiledVarResolver);
+
+ /*
+ * Add the built-in "this" variable to the list of data members.
+ */
+ (void) Itcl_CreateVarDefn(interp, cdPtr, "this",
+ (char*)NULL, (char*)NULL, &vdefn);
+
+ vdefn->member->protection = ITCL_PROTECTED; /* always "protected" */
+ vdefn->member->flags |= ITCL_THIS_VAR; /* mark as "this" variable */
+
+ entry = Tcl_CreateHashEntry(&cdPtr->variables, "this", &newEntry);
+ Tcl_SetHashValue(entry, (ClientData)vdefn);
+
+ /*
+ * Create a command in the current namespace to manage the class:
+ * <className>
+ * <className> <objName> ?<constructor-args>?
+ */
+ Itcl_PreserveData((ClientData)cdPtr);
+
+ cdPtr->accessCmd = Tcl_CreateObjCommand(interp,
+ cdPtr->fullname, Itcl_HandleClass,
+ (ClientData)cdPtr, ItclDestroyClass);
+
+ *rPtr = cdPtr;
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_DeleteClass()
+ *
+ * Deletes a class by deleting all derived classes and all objects in
+ * that class, and finally, by destroying the class namespace. This
+ * procedure provides a friendly way of doing this. If any errors
+ * are detected along the way, the process is aborted.
+ *
+ * Returns TCL_OK if successful, or TCL_ERROR (along with an error
+ * message in the interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_DeleteClass(interp, cdefnPtr)
+ Tcl_Interp *interp; /* interpreter managing this class */
+ ItclClass *cdefnPtr; /* class namespace */
+{
+ ItclClass *cdPtr = NULL;
+
+ Itcl_ListElem *elem;
+ ItclObject *contextObj;
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch place;
+ Tcl_DString buffer;
+
+ /*
+ * Destroy all derived classes, since these lose their meaning
+ * when the base class goes away. If anything goes wrong,
+ * abort with an error.
+ *
+ * TRICKY NOTE: When a derived class is destroyed, it
+ * automatically deletes itself from the "derived" list.
+ */
+ elem = Itcl_FirstListElem(&cdefnPtr->derived);
+ while (elem) {
+ cdPtr = (ItclClass*)Itcl_GetListValue(elem);
+ elem = Itcl_NextListElem(elem); /* advance here--elem will go away */
+
+ if (Itcl_DeleteClass(interp, cdPtr) != TCL_OK) {
+ goto deleteClassFail;
+ }
+ }
+
+ /*
+ * Scan through and find all objects that belong to this class.
+ * Note that more specialized objects have already been
+ * destroyed above, when derived classes were destroyed.
+ * Destroy objects and report any errors.
+ */
+ entry = Tcl_FirstHashEntry(&cdefnPtr->info->objects, &place);
+ while (entry) {
+ contextObj = (ItclObject*)Tcl_GetHashValue(entry);
+ if (contextObj->classDefn == cdefnPtr) {
+ if (Itcl_DeleteObject(interp, contextObj) != TCL_OK) {
+ cdPtr = cdefnPtr;
+ goto deleteClassFail;
+ }
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+
+ /*
+ * Destroy the namespace associated with this class.
+ *
+ * TRICKY NOTE:
+ * The cleanup procedure associated with the namespace is
+ * invoked automatically. It does all of the same things
+ * above, but it also disconnects this class from its
+ * base-class lists, and removes the class access command.
+ */
+ Tcl_DeleteNamespace(cdefnPtr->namesp);
+ return TCL_OK;
+
+deleteClassFail:
+ Tcl_DStringInit(&buffer);
+ Tcl_DStringAppend(&buffer, "\n (while deleting class \"", -1);
+ Tcl_DStringAppend(&buffer, cdPtr->namesp->fullName, -1);
+ Tcl_DStringAppend(&buffer, "\")", -1);
+ Tcl_AddErrorInfo(interp, Tcl_DStringValue(&buffer));
+ Tcl_DStringFree(&buffer);
+ return TCL_ERROR;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclDestroyClass()
+ *
+ * Invoked whenever the access command for a class is destroyed.
+ * Destroys the namespace associated with the class, which also
+ * destroys all objects in the class and all derived classes.
+ * Disconnects this class from the "derived" class lists of its
+ * base classes, and releases any claim to the class definition
+ * data. If this is the last use of that data, the class will
+ * completely vanish at this point.
+ * ------------------------------------------------------------------------
+ */
+static void
+ItclDestroyClass(cdata)
+ ClientData cdata; /* class definition to be destroyed */
+{
+ ItclClass *cdefnPtr = (ItclClass*)cdata;
+ cdefnPtr->accessCmd = NULL;
+
+ Tcl_DeleteNamespace(cdefnPtr->namesp);
+ Itcl_ReleaseData((ClientData)cdefnPtr);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclDestroyClassNamesp()
+ *
+ * Invoked whenever the namespace associated with a class is destroyed.
+ * Destroys all objects associated with this class and all derived
+ * classes. Disconnects this class from the "derived" class lists
+ * of its base classes, and removes the class access command. Releases
+ * any claim to the class definition data. If this is the last use
+ * of that data, the class will completely vanish at this point.
+ * ------------------------------------------------------------------------
+ */
+static void
+ItclDestroyClassNamesp(cdata)
+ ClientData cdata; /* class definition to be destroyed */
+{
+ ItclClass *cdefnPtr = (ItclClass*)cdata;
+ ItclObject *contextObj;
+ Itcl_ListElem *elem, *belem;
+ ItclClass *cdPtr, *basePtr, *derivedPtr;
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch place;
+
+ /*
+ * Destroy all derived classes, since these lose their meaning
+ * when the base class goes away.
+ *
+ * TRICKY NOTE: When a derived class is destroyed, it
+ * automatically deletes itself from the "derived" list.
+ */
+ elem = Itcl_FirstListElem(&cdefnPtr->derived);
+ while (elem) {
+ cdPtr = (ItclClass*)Itcl_GetListValue(elem);
+ elem = Itcl_NextListElem(elem); /* advance here--elem will go away */
+
+ Tcl_DeleteNamespace(cdPtr->namesp);
+ }
+
+ /*
+ * Scan through and find all objects that belong to this class.
+ * Destroy them quietly by deleting their access command.
+ */
+ entry = Tcl_FirstHashEntry(&cdefnPtr->info->objects, &place);
+ while (entry) {
+ contextObj = (ItclObject*)Tcl_GetHashValue(entry);
+ if (contextObj->classDefn == cdefnPtr) {
+ Tcl_DeleteCommandFromToken(cdefnPtr->interp, contextObj->accessCmd);
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+
+ /*
+ * Next, remove this class from the "derived" list in
+ * all base classes.
+ */
+ belem = Itcl_FirstListElem(&cdefnPtr->bases);
+ while (belem) {
+ basePtr = (ItclClass*)Itcl_GetListValue(belem);
+
+ elem = Itcl_FirstListElem(&basePtr->derived);
+ while (elem) {
+ derivedPtr = (ItclClass*)Itcl_GetListValue(elem);
+ if (derivedPtr == cdefnPtr) {
+ Itcl_ReleaseData( Itcl_GetListValue(elem) );
+ elem = Itcl_DeleteListElem(elem);
+ } else {
+ elem = Itcl_NextListElem(elem);
+ }
+ }
+ belem = Itcl_NextListElem(belem);
+ }
+
+ /*
+ * Next, destroy the access command associated with the class.
+ */
+ if (cdefnPtr->accessCmd) {
+ Command *cmdPtr = (Command*)cdefnPtr->accessCmd;
+
+ cmdPtr->deleteProc = Itcl_ReleaseData;
+ Tcl_DeleteCommandFromToken(cdefnPtr->interp, cdefnPtr->accessCmd);
+ }
+
+ /*
+ * Release the namespace's claim on the class definition.
+ */
+ Itcl_ReleaseData((ClientData)cdefnPtr);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclFreeClass()
+ *
+ * Frees all memory associated with a class definition. This is
+ * usually invoked automatically by Itcl_ReleaseData(), when class
+ * data is no longer being used.
+ * ------------------------------------------------------------------------
+ */
+static void
+ItclFreeClass(cdata)
+ char *cdata; /* class definition to be destroyed */
+{
+ ItclClass *cdefnPtr = (ItclClass*)cdata;
+
+ int newEntry;
+ Itcl_ListElem *elem;
+ Tcl_HashSearch place;
+ Tcl_HashEntry *entry, *hPtr;
+ ItclVarDefn *vdefn;
+ ItclVarLookup *vlookup;
+ Var *varPtr;
+ Tcl_HashTable varTable;
+
+ /*
+ * Tear down the list of derived classes. This list should
+ * really be empty if everything is working properly, but
+ * release it here just in case.
+ */
+ elem = Itcl_FirstListElem(&cdefnPtr->derived);
+ while (elem) {
+ Itcl_ReleaseData( Itcl_GetListValue(elem) );
+ elem = Itcl_NextListElem(elem);
+ }
+ Itcl_DeleteList(&cdefnPtr->derived);
+
+ /*
+ * Tear down the variable resolution table. Some records
+ * appear multiple times in the table (for x, foo::x, etc.)
+ * so each one has a reference count.
+ */
+ Tcl_InitHashTable(&varTable, TCL_STRING_KEYS);
+
+ entry = Tcl_FirstHashEntry(&cdefnPtr->resolveVars, &place);
+ while (entry) {
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+ if (--vlookup->usage == 0) {
+ /*
+ * If this is a common variable owned by this class,
+ * then release the class's hold on it. If it's no
+ * longer being used, move it into a variable table
+ * for destruction.
+ */
+ if ( (vlookup->vdefn->member->flags & ITCL_COMMON) != 0 &&
+ vlookup->vdefn->member->classDefn == cdefnPtr ) {
+ varPtr = (Var*)vlookup->var.common;
+ if (--varPtr->refCount == 0) {
+ hPtr = Tcl_CreateHashEntry(&varTable,
+ vlookup->vdefn->member->fullname, &newEntry);
+ Tcl_SetHashValue(hPtr, (ClientData) varPtr);
+ }
+ }
+ ckfree((char*)vlookup);
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+
+ TclDeleteVars((Interp*)cdefnPtr->interp, &varTable);
+ Tcl_DeleteHashTable(&cdefnPtr->resolveVars);
+
+ /*
+ * Tear down the virtual method table...
+ */
+ Tcl_DeleteHashTable(&cdefnPtr->resolveCmds);
+
+ /*
+ * Delete all variable definitions.
+ */
+ entry = Tcl_FirstHashEntry(&cdefnPtr->variables, &place);
+ while (entry) {
+ vdefn = (ItclVarDefn*)Tcl_GetHashValue(entry);
+ Itcl_DeleteVarDefn(vdefn);
+ entry = Tcl_NextHashEntry(&place);
+ }
+ Tcl_DeleteHashTable(&cdefnPtr->variables);
+
+ /*
+ * Delete all function definitions.
+ */
+ entry = Tcl_FirstHashEntry(&cdefnPtr->functions, &place);
+ while (entry) {
+ Itcl_ReleaseData( Tcl_GetHashValue(entry) );
+ entry = Tcl_NextHashEntry(&place);
+ }
+ Tcl_DeleteHashTable(&cdefnPtr->functions);
+
+ /*
+ * Release the claim on all base classes.
+ */
+ elem = Itcl_FirstListElem(&cdefnPtr->bases);
+ while (elem) {
+ Itcl_ReleaseData( Itcl_GetListValue(elem) );
+ elem = Itcl_NextListElem(elem);
+ }
+ Itcl_DeleteList(&cdefnPtr->bases);
+ Tcl_DeleteHashTable(&cdefnPtr->heritage);
+
+ /*
+ * Free up the object initialization code.
+ */
+ if (cdefnPtr->initCode) {
+ Tcl_DecrRefCount(cdefnPtr->initCode);
+ }
+
+ Itcl_ReleaseData((ClientData)cdefnPtr->info);
+
+ ckfree(cdefnPtr->name);
+ ckfree(cdefnPtr->fullname);
+
+ ckfree((char*)cdefnPtr);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_IsClassNamespace()
+ *
+ * Checks to see whether or not the given namespace represents an
+ * [incr Tcl] class. Returns non-zero if so, and zero otherwise.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_IsClassNamespace(namesp)
+ Tcl_Namespace *namesp; /* namespace being tested */
+{
+ Namespace *nsPtr = (Namespace*)namesp;
+
+ if (nsPtr != NULL) {
+ return (nsPtr->deleteProc == ItclDestroyClassNamesp);
+ }
+ return 0;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_IsClass()
+ *
+ * Checks the given Tcl command to see if it represents an itcl class.
+ * Returns non-zero if the command is associated with a class.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_IsClass(cmd)
+ Tcl_Command cmd; /* command being tested */
+{
+ Command *cmdPtr = (Command*)cmd;
+
+ if (cmdPtr->deleteProc == ItclDestroyClass) {
+ return 1;
+ }
+
+ /*
+ * This may be an imported command. Try to get the real
+ * command and see if it represents a class.
+ */
+ cmdPtr = (Command*)TclGetOriginalCommand(cmd);
+ if (cmdPtr && cmdPtr->deleteProc == ItclDestroyClass) {
+ return 1;
+ }
+ return 0;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_FindClass()
+ *
+ * Searches for the specified class in the active namespace. If the
+ * class is found, this procedure returns a pointer to the class
+ * definition. Otherwise, if the autoload flag is non-zero, an
+ * attempt will be made to autoload the class definition. If it
+ * still can't be found, this procedure returns NULL, along with an
+ * error message in the interpreter.
+ * ------------------------------------------------------------------------
+ */
+ItclClass*
+Itcl_FindClass(interp, path, autoload)
+ Tcl_Interp* interp; /* interpreter containing class */
+ char* path; /* path name for class */
+{
+ Tcl_Namespace* classNs;
+
+ /*
+ * Search for a namespace with the specified name, and if
+ * one is found, see if it is a class namespace.
+ */
+ classNs = Itcl_FindClassNamespace(interp, path);
+
+ if (classNs && Itcl_IsClassNamespace(classNs)) {
+ return (ItclClass*)classNs->clientData;
+ }
+
+ /*
+ * If the autoload flag is set, try to autoload the class
+ * definition.
+ */
+ if (autoload) {
+ if (Tcl_VarEval(interp, "::auto_load ", path, (char*)NULL) != TCL_OK) {
+ char msg[256];
+ sprintf(msg, "\n (while attempting to autoload class \"%.200s\")", path);
+ Tcl_AddErrorInfo(interp, msg);
+ return NULL;
+ }
+ Tcl_ResetResult(interp);
+
+ classNs = Itcl_FindClassNamespace(interp, path);
+ if (classNs && Itcl_IsClassNamespace(classNs)) {
+ return (ItclClass*)classNs->clientData;
+ }
+ }
+
+ Tcl_AppendResult(interp, "class \"", path, "\" not found in context \"",
+ Tcl_GetCurrentNamespace(interp)->fullName, "\"",
+ (char*)NULL);
+
+ return NULL;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_FindClassNamespace()
+ *
+ * Searches for the specified class namespace. The normal Tcl procedure
+ * Tcl_FindNamespace also searches for namespaces, but only in the
+ * current namespace context. This makes it hard to find one class
+ * from within another. For example, suppose. you have two namespaces
+ * Foo and Bar. If you're in the context of Foo and you look for
+ * Bar, you won't find it with Tcl_FindNamespace. This behavior is
+ * okay for namespaces, but wrong for classes.
+ *
+ * This procedure search for a class namespace. If the name is
+ * absolute (i.e., starts with "::"), then that one name is checked,
+ * and the class is either found or not. But if the name is relative,
+ * it is sought in the current namespace context and in the global
+ * context, just like the normal command lookup.
+ *
+ * This procedure returns a pointer to the desired namespace, or
+ * NULL if the namespace was not found.
+ * ------------------------------------------------------------------------
+ */
+Tcl_Namespace*
+Itcl_FindClassNamespace(interp, path)
+ Tcl_Interp* interp; /* interpreter containing class */
+ char* path; /* path name for class */
+{
+ Tcl_Namespace* contextNs = Tcl_GetCurrentNamespace(interp);
+ Tcl_Namespace* classNs;
+ Tcl_DString buffer;
+
+ /*
+ * Look up the namespace. If the name is not absolute, then
+ * see if it's the current namespace, and try the global
+ * namespace as well.
+ */
+ classNs = Tcl_FindNamespace(interp, path, (Tcl_Namespace*)NULL,
+ /* flags */ 0);
+
+ if ( !classNs && contextNs->parentPtr != NULL &&
+ (*path != ':' || *(path+1) != ':') ) {
+
+ if (strcmp(contextNs->name, path) == 0) {
+ classNs = contextNs;
+ }
+ else {
+ Tcl_DStringInit(&buffer);
+ Tcl_DStringAppend(&buffer, "::", -1);
+ Tcl_DStringAppend(&buffer, path, -1);
+
+ classNs = Tcl_FindNamespace(interp, Tcl_DStringValue(&buffer),
+ (Tcl_Namespace*)NULL, /* flags */ 0);
+
+ Tcl_DStringFree(&buffer);
+ }
+ }
+ return classNs;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_HandleClass()
+ *
+ * Invoked by Tcl whenever the user issues the command associated with
+ * a class name. Handles the following syntax:
+ *
+ * <className>
+ * <className> <objName> ?<args>...?
+ *
+ * Without any arguments, the command does nothing. In the olden days,
+ * this allowed the class name to be invoked by itself to prompt the
+ * autoloader to load the class definition. Today, this behavior is
+ * retained for backward compatibility with old releases.
+ *
+ * If arguments are specified, then this procedure creates a new
+ * object named <objName> in the appropriate class. Note that if
+ * <objName> contains "#auto", that part is automatically replaced
+ * by a unique string built from the class name.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_HandleClass(clientData, interp, objc, objv)
+ ClientData clientData; /* class definition */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclClass *cdefnPtr = (ItclClass*)clientData;
+ int result = TCL_OK;
+
+ char unique[256]; /* buffer used for unique part of object names */
+ Tcl_DString buffer; /* buffer used to build object names */
+ char *token, *objName, tmp, *start, *pos, *match;
+
+ ItclObject *newObj;
+ Tcl_CallFrame frame;
+
+ /*
+ * If the command is invoked without an object name, then do nothing.
+ * This used to support autoloading--that the class name could be
+ * invoked as a command by itself, prompting the autoloader to
+ * load the class definition. We retain the behavior here for
+ * backward-compatibility with earlier releases.
+ */
+ if (objc == 1) {
+ return TCL_OK;
+ }
+
+ /*
+ * If the object name is "::", and if this is an old-style class
+ * definition, then treat the remaining arguments as a command
+ * in the class namespace. This used to be the way of invoking
+ * a class proc, but the new syntax is "class::proc" (without
+ * spaces).
+ */
+ token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ if ((*token == ':') && (strcmp(token,"::") == 0) && (objc > 2)) {
+ if ((cdefnPtr->flags & ITCL_OLD_STYLE) != 0) {
+
+ result = Tcl_PushCallFrame(interp, &frame,
+ cdefnPtr->namesp, /* isProcCallFrame */ 0);
+
+ if (result != TCL_OK) {
+ return result;
+ }
+ result = Itcl_EvalArgs(interp, objc-2, objv+2);
+
+ Tcl_PopCallFrame(interp);
+ return result;
+ }
+
+ /*
+ * If this is not an old-style class, then return an error
+ * describing the syntax change.
+ */
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "syntax \"class :: proc\" is an anachronism\n",
+ "[incr Tcl] no longer supports this syntax.\n",
+ "Instead, remove the spaces from your procedure invocations:\n",
+ " ",
+ Tcl_GetStringFromObj(objv[0], (int*)NULL), "::",
+ Tcl_GetStringFromObj(objv[2], (int*)NULL), " ?args?",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Otherwise, we have a proper object name. Create a new instance
+ * with that name. If the name contains "#auto", replace this with
+ * a uniquely generated string based on the class name.
+ */
+ Tcl_DStringInit(&buffer);
+ objName = NULL;
+
+ match = "#auto";
+ start = token;
+ for (pos=start; *pos != '\0'; pos++) {
+ if (*pos == *match) {
+ if (*(++match) == '\0') {
+ tmp = *start;
+ *start = '\0'; /* null-terminate first part */
+
+ /*
+ * Substitute a unique part in for "#auto", and keep
+ * incrementing a counter until a valid name is found.
+ */
+ do {
+ sprintf(unique,"%.200s%d", cdefnPtr->name,
+ cdefnPtr->unique++);
+ unique[0] = tolower(unique[0]);
+
+ Tcl_DStringTrunc(&buffer, 0);
+ Tcl_DStringAppend(&buffer, token, -1);
+ Tcl_DStringAppend(&buffer, unique, -1);
+ Tcl_DStringAppend(&buffer, start+5, -1);
+
+ objName = Tcl_DStringValue(&buffer);
+ if (Itcl_FindObject(interp, objName, &newObj) != TCL_OK) {
+ break; /* if an error is found, bail out! */
+ }
+ } while (newObj != NULL);
+
+ *start = tmp; /* undo null-termination */
+ objName = Tcl_DStringValue(&buffer);
+ break; /* object name is ready to go! */
+ }
+ }
+ else {
+ match = "#auto";
+ pos = start++;
+ }
+ }
+
+ /*
+ * If "#auto" was not found, then just use object name as-is.
+ */
+ if (objName == NULL) {
+ objName = token;
+ }
+
+ /*
+ * Try to create a new object. If successful, return the
+ * object name as the result of this command.
+ */
+ result = Itcl_CreateObject(interp, objName, cdefnPtr,
+ objc-2, objv+2, &newObj);
+
+ if (result == TCL_OK) {
+ Tcl_SetResult(interp, objName, TCL_VOLATILE);
+ }
+
+ Tcl_DStringFree(&buffer);
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ClassCmdResolver()
+ *
+ * Used by the class namespaces to handle name resolution for all
+ * commands. This procedure looks for references to class methods
+ * and procs, and returns TCL_OK along with the appropriate Tcl
+ * command in the rPtr argument. If a particular command is private,
+ * this procedure returns TCL_ERROR and access to the command is
+ * denied. If a command is not recognized, this procedure returns
+ * TCL_CONTINUE, and lookup continues via the normal Tcl name
+ * resolution rules.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ClassCmdResolver(interp, name, context, flags, rPtr)
+ Tcl_Interp *interp; /* current interpreter */
+ char* name; /* name of the command being accessed */
+ Tcl_Namespace *context; /* namespace performing the resolution */
+ int flags; /* TCL_LEAVE_ERR_MSG => leave error messages
+ * in interp if anything goes wrong */
+ Tcl_Command *rPtr; /* returns: resolved command */
+{
+ ItclClass *cdefn = (ItclClass*)context->clientData;
+
+ Tcl_HashEntry *entry;
+ ItclMemberFunc *mfunc;
+ Command *cmdPtr;
+
+ /*
+ * If the command is a member function, and if it is
+ * accessible, return its Tcl command handle.
+ */
+ entry = Tcl_FindHashEntry(&cdefn->resolveCmds, name);
+ if (!entry) {
+ return TCL_CONTINUE;
+ }
+
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+
+
+ /*
+ * For protected/private functions, figure out whether or
+ * not the function is accessible from the current context.
+ *
+ * TRICKY NOTE: Use Itcl_GetTrueNamespace to determine
+ * the current context. If the current call frame is
+ * "transparent", this handles it properly.
+ */
+ if (mfunc->member->protection != ITCL_PUBLIC) {
+ context = Itcl_GetTrueNamespace(interp, cdefn->info);
+
+ if (!Itcl_CanAccessFunc(mfunc, context)) {
+
+ if ((flags & TCL_LEAVE_ERR_MSG) != 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "can't access \"", name, "\": ",
+ Itcl_ProtectionStr(mfunc->member->protection),
+ " variable",
+ (char*)NULL);
+ }
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Looks like we found an accessible member function.
+ *
+ * TRICKY NOTE: Check to make sure that the command handle
+ * is still valid. If someone has deleted or renamed the
+ * command, it may not be. This is just the time to catch
+ * it--as it is being resolved again by the compiler.
+ */
+ cmdPtr = (Command*)mfunc->accessCmd;
+ if (!cmdPtr || cmdPtr->deleted) {
+ mfunc->accessCmd = NULL;
+
+ if ((flags & TCL_LEAVE_ERR_MSG) != 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "can't access \"", name, "\": deleted or redefined\n",
+ "(use the \"body\" command to redefine methods/procs)",
+ (char*)NULL);
+ }
+ return TCL_ERROR; /* disallow access! */
+ }
+
+ *rPtr = mfunc->accessCmd;
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ClassVarResolver()
+ *
+ * Used by the class namespaces to handle name resolution for runtime
+ * variable accesses. This procedure looks for references to both
+ * common variables and instance variables at runtime. It is used as
+ * a second line of defense, to handle references that could not be
+ * resolved as compiled locals.
+ *
+ * If a variable is found, this procedure returns TCL_OK along with
+ * the appropriate Tcl variable in the rPtr argument. If a particular
+ * variable is private, this procedure returns TCL_ERROR and access
+ * to the variable is denied. If a variable is not recognized, this
+ * procedure returns TCL_CONTINUE, and lookup continues via the normal
+ * Tcl name resolution rules.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ClassVarResolver(interp, name, context, flags, rPtr)
+ Tcl_Interp *interp; /* current interpreter */
+ char* name; /* name of the variable being accessed */
+ Tcl_Namespace *context; /* namespace performing the resolution */
+ int flags; /* TCL_LEAVE_ERR_MSG => leave error messages
+ * in interp if anything goes wrong */
+ Tcl_Var *rPtr; /* returns: resolved variable */
+{
+ ItclClass *cdefn = (ItclClass*)context->clientData;
+ ItclObject *contextObj;
+ Tcl_CallFrame *framePtr;
+ Tcl_HashEntry *entry;
+ ItclVarLookup *vlookup;
+
+ assert(Itcl_IsClassNamespace(context));
+
+ /*
+ * If this is a global variable, handle it in the usual
+ * Tcl manner.
+ */
+ if (flags & TCL_GLOBAL_ONLY) {
+ return TCL_CONTINUE;
+ }
+
+ /*
+ * See if the variable is a known data member and accessible.
+ */
+ entry = Tcl_FindHashEntry(&cdefn->resolveVars, name);
+ if (entry == NULL) {
+ return TCL_CONTINUE;
+ }
+
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+ if (!vlookup->accessible) {
+ return TCL_CONTINUE;
+ }
+
+ /*
+ * If this is a common data member, then its variable
+ * is easy to find. Return it directly.
+ */
+ if ((vlookup->vdefn->member->flags & ITCL_COMMON) != 0) {
+ *rPtr = vlookup->var.common;
+ return TCL_OK;
+ }
+
+ /*
+ * If this is an instance variable, then we have to
+ * find the object context, then index into its data
+ * array to get the actual variable.
+ */
+ framePtr = _Tcl_GetCallFrame(interp, 0);
+
+ entry = Tcl_FindHashEntry(&cdefn->info->contextFrames, (char*)framePtr);
+ if (entry == NULL) {
+ return TCL_CONTINUE;
+ }
+ contextObj = (ItclObject*)Tcl_GetHashValue(entry);
+
+ /*
+ * TRICKY NOTE: We've resolved the variable in the current
+ * class context, but we must also be careful to get its
+ * index from the most-specific class context. Variables
+ * are arranged differently depending on which class
+ * constructed the object.
+ */
+ if (contextObj->classDefn != vlookup->vdefn->member->classDefn) {
+ entry = Tcl_FindHashEntry(&contextObj->classDefn->resolveVars,
+ vlookup->vdefn->member->fullname);
+
+ if (entry) {
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+ }
+ }
+ *rPtr = (Tcl_Var)contextObj->data[vlookup->var.index];
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ClassCompiledVarResolver()
+ *
+ * Used by the class namespaces to handle name resolution for compile
+ * time variable accesses. This procedure looks for references to
+ * both common variables and instance variables at compile time. If
+ * the variables are found, they are characterized in a generic way
+ * by their ItclVarLookup record. At runtime, Tcl constructs the
+ * compiled local variables by calling ItclClassRuntimeVarResolver.
+ *
+ * If a variable is found, this procedure returns TCL_OK along with
+ * information about the variable in the rPtr argument. If a particular
+ * variable is private, this procedure returns TCL_ERROR and access
+ * to the variable is denied. If a variable is not recognized, this
+ * procedure returns TCL_CONTINUE, and lookup continues via the normal
+ * Tcl name resolution rules.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ClassCompiledVarResolver(interp, name, length, context, rPtr)
+ Tcl_Interp *interp; /* current interpreter */
+ char* name; /* name of the variable being accessed */
+ int length; /* number of characters in name */
+ Tcl_Namespace *context; /* namespace performing the resolution */
+ Tcl_ResolvedVarInfo **rPtr; /* returns: info that makes it possible to
+ * resolve the variable at runtime */
+{
+ ItclClass *cdefn = (ItclClass*)context->clientData;
+ Tcl_HashEntry *entry;
+ ItclVarLookup *vlookup;
+ char *buffer, storage[64];
+
+ assert(Itcl_IsClassNamespace(context));
+
+ /*
+ * Copy the name to local storage so we can NULL terminate it.
+ * If the name is long, allocate extra space for it.
+ */
+ if (length < sizeof(storage)) {
+ buffer = storage;
+ } else {
+ buffer = (char*)ckalloc((unsigned)(length+1));
+ }
+ memcpy((void*)buffer, (void*)name, (size_t)length);
+ buffer[length] = '\0';
+
+ entry = Tcl_FindHashEntry(&cdefn->resolveVars, buffer);
+
+ if (buffer != storage) {
+ ckfree(buffer);
+ }
+
+ /*
+ * If the name is not found, or if it is inaccessible,
+ * continue on with the normal Tcl name resolution rules.
+ */
+ if (entry == NULL) {
+ return TCL_CONTINUE;
+ }
+
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+ if (!vlookup->accessible) {
+ return TCL_CONTINUE;
+ }
+
+ /*
+ * Return the ItclVarLookup record. At runtime, Tcl will
+ * call ItclClassRuntimeVarResolver with this record, to
+ * plug in the appropriate variable for the current object
+ * context.
+ */
+ (*rPtr) = (Tcl_ResolvedVarInfo *) ckalloc(sizeof(ItclResolvedVarInfo));
+ (*rPtr)->fetchProc = ItclClassRuntimeVarResolver;
+ (*rPtr)->deleteProc = NULL;
+ ((ItclResolvedVarInfo*)(*rPtr))->vlookup = vlookup;
+
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclClassRuntimeVarResolver()
+ *
+ * Invoked when Tcl sets up the call frame for an [incr Tcl] method/proc
+ * at runtime. Resolves data members identified earlier by
+ * Itcl_ClassCompiledVarResolver. Returns the Tcl_Var representation
+ * for the data member.
+ * ------------------------------------------------------------------------
+ */
+static Tcl_Var
+ItclClassRuntimeVarResolver(interp, resVarInfo)
+ Tcl_Interp *interp; /* current interpreter */
+ Tcl_ResolvedVarInfo *resVarInfo; /* contains ItclVarLookup rep
+ * for variable */
+{
+ ItclVarLookup *vlookup = ((ItclResolvedVarInfo*)resVarInfo)->vlookup;
+
+ Tcl_CallFrame *framePtr;
+ ItclClass *cdefn;
+ ItclObject *contextObj;
+ Tcl_HashEntry *entry;
+
+ /*
+ * If this is a common data member, then the associated
+ * variable is known directly.
+ */
+ if ((vlookup->vdefn->member->flags & ITCL_COMMON) != 0) {
+ return vlookup->var.common;
+ }
+ cdefn = vlookup->vdefn->member->classDefn;
+
+ /*
+ * Otherwise, get the current object context and find the
+ * variable in its data table.
+ *
+ * TRICKY NOTE: Get the index for this variable using the
+ * virtual table for the MOST-SPECIFIC class.
+ */
+ framePtr = _Tcl_GetCallFrame(interp, 0);
+
+ entry = Tcl_FindHashEntry(&cdefn->info->contextFrames, (char*)framePtr);
+ if (entry) {
+ contextObj = (ItclObject*)Tcl_GetHashValue(entry);
+
+ if (contextObj != NULL) {
+ if (contextObj->classDefn != vlookup->vdefn->member->classDefn) {
+ entry = Tcl_FindHashEntry(&contextObj->classDefn->resolveVars,
+ vlookup->vdefn->member->fullname);
+
+ if (entry) {
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+ }
+ }
+ return (Tcl_Var)contextObj->data[vlookup->var.index];
+ }
+ }
+ return NULL;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_BuildVirtualTables()
+ *
+ * Invoked whenever the class heritage changes or members are added or
+ * removed from a class definition to rebuild the member lookup
+ * tables. There are two tables:
+ *
+ * METHODS: resolveCmds
+ * Used primarily in Itcl_ClassCmdResolver() to resolve all
+ * command references in a namespace.
+ *
+ * DATA MEMBERS: resolveVars
+ * Used primarily in Itcl_ClassVarResolver() to quickly resolve
+ * variable references in each class scope.
+ *
+ * These tables store every possible name for each command/variable
+ * (member, class::member, namesp::class::member, etc.). Members
+ * in a derived class may shadow members with the same name in a
+ * base class. In that case, the simple name in the resolution
+ * table will point to the most-specific member.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_BuildVirtualTables(cdefnPtr)
+ ItclClass* cdefnPtr; /* class definition being updated */
+{
+ Tcl_HashEntry *entry, *hPtr;
+ Tcl_HashSearch place;
+ ItclVarLookup *vlookup;
+ ItclVarDefn *vdefn;
+ ItclMemberFunc *mfunc;
+ ItclHierIter hier;
+ ItclClass *cdPtr;
+ Namespace* nsPtr;
+ Tcl_DString buffer, buffer2;
+ int newEntry;
+
+ Tcl_DStringInit(&buffer);
+ Tcl_DStringInit(&buffer2);
+
+ /*
+ * Clear the variable resolution table.
+ */
+ entry = Tcl_FirstHashEntry(&cdefnPtr->resolveVars, &place);
+ while (entry) {
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+ if (--vlookup->usage == 0) {
+ ckfree((char*)vlookup);
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+ Tcl_DeleteHashTable(&cdefnPtr->resolveVars);
+ Tcl_InitHashTable(&cdefnPtr->resolveVars, TCL_STRING_KEYS);
+ cdefnPtr->numInstanceVars = 0;
+
+ /*
+ * Set aside the first object-specific slot for the built-in
+ * "this" variable. Only allocate one of these, even though
+ * there is a definition for "this" in each class scope.
+ */
+ cdefnPtr->numInstanceVars++;
+
+ /*
+ * Scan through all classes in the hierarchy, from most to
+ * least specific. Add a lookup entry for each variable
+ * into the table.
+ */
+ Itcl_InitHierIter(&hier, cdefnPtr);
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ while (cdPtr != NULL) {
+ entry = Tcl_FirstHashEntry(&cdPtr->variables, &place);
+ while (entry) {
+ vdefn = (ItclVarDefn*)Tcl_GetHashValue(entry);
+
+ vlookup = (ItclVarLookup*)ckalloc(sizeof(ItclVarLookup));
+ vlookup->vdefn = vdefn;
+ vlookup->usage = 0;
+ vlookup->leastQualName = NULL;
+
+ /*
+ * If this variable is PRIVATE to another class scope,
+ * then mark it as "inaccessible".
+ */
+ vlookup->accessible =
+ ( vdefn->member->protection != ITCL_PRIVATE ||
+ vdefn->member->classDefn == cdefnPtr );
+
+ /*
+ * If this is a common variable, then keep a reference to
+ * the variable directly. Otherwise, keep an index into
+ * the object's variable table.
+ */
+ if ((vdefn->member->flags & ITCL_COMMON) != 0) {
+ nsPtr = (Namespace*)cdPtr->namesp;
+ hPtr = Tcl_FindHashEntry(&nsPtr->varTable, vdefn->member->name);
+ assert(hPtr != NULL);
+
+ vlookup->var.common = (Tcl_Var)Tcl_GetHashValue(hPtr);
+ }
+ else {
+ /*
+ * If this is a reference to the built-in "this"
+ * variable, then its index is "0". Otherwise,
+ * add another slot to the end of the table.
+ */
+ if ((vdefn->member->flags & ITCL_THIS_VAR) != 0) {
+ vlookup->var.index = 0;
+ }
+ else {
+ vlookup->var.index = cdefnPtr->numInstanceVars++;
+ }
+ }
+
+ /*
+ * Create all possible names for this variable and enter
+ * them into the variable resolution table:
+ * var
+ * class::var
+ * namesp1::class::var
+ * namesp2::namesp1::class::var
+ * ...
+ */
+ Tcl_DStringSetLength(&buffer, 0);
+ Tcl_DStringAppend(&buffer, vdefn->member->name, -1);
+ nsPtr = (Namespace*)cdPtr->namesp;
+
+ while (1) {
+ entry = Tcl_CreateHashEntry(&cdefnPtr->resolveVars,
+ Tcl_DStringValue(&buffer), &newEntry);
+
+ if (newEntry) {
+ Tcl_SetHashValue(entry, (ClientData)vlookup);
+ vlookup->usage++;
+
+ if (!vlookup->leastQualName) {
+ vlookup->leastQualName =
+ Tcl_GetHashKey(&cdefnPtr->resolveVars, entry);
+ }
+ }
+
+ if (nsPtr == NULL) {
+ break;
+ }
+ Tcl_DStringSetLength(&buffer2, 0);
+ Tcl_DStringAppend(&buffer2, Tcl_DStringValue(&buffer), -1);
+ Tcl_DStringSetLength(&buffer, 0);
+ Tcl_DStringAppend(&buffer, nsPtr->name, -1);
+ Tcl_DStringAppend(&buffer, "::", -1);
+ Tcl_DStringAppend(&buffer, Tcl_DStringValue(&buffer2), -1);
+
+ nsPtr = nsPtr->parentPtr;
+ }
+
+ /*
+ * If this record is not needed, free it now.
+ */
+ if (vlookup->usage == 0) {
+ ckfree((char*)vlookup);
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ }
+ Itcl_DeleteHierIter(&hier);
+
+ /*
+ * Clear the command resolution table.
+ */
+ Tcl_DeleteHashTable(&cdefnPtr->resolveCmds);
+ Tcl_InitHashTable(&cdefnPtr->resolveCmds, TCL_STRING_KEYS);
+
+ /*
+ * Scan through all classes in the hierarchy, from most to
+ * least specific. Look for the first (most-specific) definition
+ * of each member function, and enter it into the table.
+ */
+ Itcl_InitHierIter(&hier, cdefnPtr);
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ while (cdPtr != NULL) {
+ entry = Tcl_FirstHashEntry(&cdPtr->functions, &place);
+ while (entry) {
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+
+ /*
+ * Create all possible names for this function and enter
+ * them into the command resolution table:
+ * func
+ * class::func
+ * namesp1::class::func
+ * namesp2::namesp1::class::func
+ * ...
+ */
+ Tcl_DStringSetLength(&buffer, 0);
+ Tcl_DStringAppend(&buffer, mfunc->member->name, -1);
+ nsPtr = (Namespace*)cdPtr->namesp;
+
+ while (1) {
+ entry = Tcl_CreateHashEntry(&cdefnPtr->resolveCmds,
+ Tcl_DStringValue(&buffer), &newEntry);
+
+ if (newEntry) {
+ Tcl_SetHashValue(entry, (ClientData)mfunc);
+ }
+
+ if (nsPtr == NULL) {
+ break;
+ }
+ Tcl_DStringSetLength(&buffer2, 0);
+ Tcl_DStringAppend(&buffer2, Tcl_DStringValue(&buffer), -1);
+ Tcl_DStringSetLength(&buffer, 0);
+ Tcl_DStringAppend(&buffer, nsPtr->name, -1);
+ Tcl_DStringAppend(&buffer, "::", -1);
+ Tcl_DStringAppend(&buffer, Tcl_DStringValue(&buffer2), -1);
+
+ nsPtr = nsPtr->parentPtr;
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ }
+ Itcl_DeleteHierIter(&hier);
+
+ Tcl_DStringFree(&buffer);
+ Tcl_DStringFree(&buffer2);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_CreateVarDefn()
+ *
+ * Creates a new class variable definition. If this is a public
+ * variable, it may have a bit of "config" code that is used to
+ * update the object whenever the variable is modified via the
+ * built-in "configure" method.
+ *
+ * Returns TCL_ERROR along with an error message in the specified
+ * interpreter if anything goes wrong. Otherwise, this returns
+ * TCL_OK and a pointer to the new variable definition in "vdefnPtr".
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_CreateVarDefn(interp, cdefn, name, init, config, vdefnPtr)
+ Tcl_Interp *interp; /* interpreter managing this transaction */
+ ItclClass* cdefn; /* class containing this variable */
+ char* name; /* variable name */
+ char* init; /* initial value */
+ char* config; /* code invoked when variable is configured */
+ ItclVarDefn** vdefnPtr; /* returns: new variable definition */
+{
+ int newEntry;
+ ItclVarDefn *vdefn;
+ ItclMemberCode *mcode;
+ Tcl_HashEntry *entry;
+
+ /*
+ * Add this variable to the variable table for the class.
+ * Make sure that the variable name does not already exist.
+ */
+ entry = Tcl_CreateHashEntry(&cdefn->variables, name, &newEntry);
+ if (!newEntry) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "variable name \"", name, "\" already defined in class \"",
+ cdefn->fullname, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If this variable has some "config" code, try to capture
+ * its implementation.
+ */
+ if (config) {
+ if (Itcl_CreateMemberCode(interp, cdefn, (char*)NULL, config,
+ &mcode) != TCL_OK) {
+
+ Tcl_DeleteHashEntry(entry);
+ return TCL_ERROR;
+ }
+ Itcl_PreserveData((ClientData)mcode);
+ Itcl_EventuallyFree((ClientData)mcode, Itcl_DeleteMemberCode);
+ }
+ else {
+ mcode = NULL;
+ }
+
+
+ /*
+ * If everything looks good, create the variable definition.
+ */
+ vdefn = (ItclVarDefn*)ckalloc(sizeof(ItclVarDefn));
+ vdefn->member = Itcl_CreateMember(interp, cdefn, name);
+ vdefn->member->code = mcode;
+
+ if (vdefn->member->protection == ITCL_DEFAULT_PROTECT) {
+ vdefn->member->protection = ITCL_PROTECTED;
+ }
+
+ if (init) {
+ vdefn->init = (char*)ckalloc((unsigned)(strlen(init)+1));
+ strcpy(vdefn->init, init);
+ }
+ else {
+ vdefn->init = NULL;
+ }
+
+ Tcl_SetHashValue(entry, (ClientData)vdefn);
+
+ *vdefnPtr = vdefn;
+ return TCL_OK;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_DeleteVarDefn()
+ *
+ * Destroys a variable definition created by Itcl_CreateVarDefn(),
+ * freeing all resources associated with it.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_DeleteVarDefn(vdefn)
+ ItclVarDefn *vdefn; /* variable definition to be destroyed */
+{
+ Itcl_DeleteMember(vdefn->member);
+
+ if (vdefn->init) {
+ ckfree(vdefn->init);
+ }
+ ckfree((char*)vdefn);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_GetCommonVar()
+ *
+ * Returns the current value for a common class variable. The member
+ * name is interpreted with respect to the given class scope. That
+ * scope is installed as the current context before querying the
+ * variable. This by-passes the protection level in case the variable
+ * is "private".
+ *
+ * If successful, this procedure returns a pointer to a string value
+ * which remains alive until the variable changes it value. If
+ * anything goes wrong, this returns NULL.
+ * ------------------------------------------------------------------------
+ */
+char*
+Itcl_GetCommonVar(interp, name, contextClass)
+ Tcl_Interp *interp; /* current interpreter */
+ char *name; /* name of desired instance variable */
+ ItclClass *contextClass; /* name is interpreted in this scope */
+{
+ char *val = NULL;
+ int result;
+ Tcl_CallFrame frame;
+
+ /*
+ * Activate the namespace for the given class. That installs
+ * the appropriate name resolution rules and by-passes any
+ * security restrictions.
+ */
+ result = Tcl_PushCallFrame(interp, &frame,
+ contextClass->namesp, /*isProcCallFrame*/ 0);
+
+ if (result == TCL_OK) {
+ val = Tcl_GetVar2(interp, name, (char*)NULL, 0);
+ Tcl_PopCallFrame(interp);
+ }
+ return val;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_CreateMember()
+ *
+ * Creates the data record representing a class member. This is the
+ * generic representation for a data member or member function.
+ * Returns a pointer to the new representation.
+ * ------------------------------------------------------------------------
+ */
+ItclMember*
+Itcl_CreateMember(interp, cdefn, name)
+ Tcl_Interp* interp; /* interpreter managing this action */
+ ItclClass *cdefn; /* class definition */
+ char* name; /* name of new member */
+{
+ ItclMember *memPtr;
+ int fullsize;
+
+ /*
+ * Allocate the memory for a class member and fill in values.
+ */
+ memPtr = (ItclMember*)ckalloc(sizeof(ItclMember));
+ memPtr->interp = interp;
+ memPtr->classDefn = cdefn;
+ memPtr->flags = 0;
+ memPtr->protection = Itcl_Protection(interp, 0);
+ memPtr->code = NULL;
+
+ fullsize = strlen(cdefn->fullname) + strlen(name) + 2;
+ memPtr->fullname = (char*)ckalloc((unsigned)(fullsize+1));
+ strcpy(memPtr->fullname, cdefn->fullname);
+ strcat(memPtr->fullname, "::");
+ strcat(memPtr->fullname, name);
+
+ memPtr->name = (char*)ckalloc((unsigned)(strlen(name)+1));
+ strcpy(memPtr->name, name);
+
+ return memPtr;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_DeleteMember()
+ *
+ * Destroys all data associated with the given member function definition.
+ * Usually invoked by the interpreter when a member function is deleted.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_DeleteMember(memPtr)
+ ItclMember *memPtr; /* pointer to member function definition */
+{
+ if (memPtr) {
+ ckfree(memPtr->name);
+ ckfree(memPtr->fullname);
+
+ if (memPtr->code) {
+ Itcl_ReleaseData((ClientData)memPtr->code);
+ }
+ memPtr->code = NULL;
+
+ ckfree((char*)memPtr);
+ }
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_InitHierIter()
+ *
+ * Initializes an iterator for traversing the hierarchy of the given
+ * class. Subsequent calls to Itcl_AdvanceHierIter() will return
+ * the base classes in order from most-to-least specific.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_InitHierIter(iter,cdefn)
+ ItclHierIter *iter; /* iterator used for traversal */
+ ItclClass *cdefn; /* class definition for start of traversal */
+{
+ Itcl_InitStack(&iter->stack);
+ Itcl_PushStack((ClientData)cdefn, &iter->stack);
+ iter->current = cdefn;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_DeleteHierIter()
+ *
+ * Destroys an iterator for traversing class hierarchies, freeing
+ * all memory associated with it.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_DeleteHierIter(iter)
+ ItclHierIter *iter; /* iterator used for traversal */
+{
+ Itcl_DeleteStack(&iter->stack);
+ iter->current = NULL;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_AdvanceHierIter()
+ *
+ * Moves a class hierarchy iterator forward to the next base class.
+ * Returns a pointer to the current class definition, or NULL when
+ * the end of the hierarchy has been reached.
+ * ------------------------------------------------------------------------
+ */
+ItclClass*
+Itcl_AdvanceHierIter(iter)
+ ItclHierIter *iter; /* iterator used for traversal */
+{
+ register Itcl_ListElem *elem;
+ ItclClass *cdPtr;
+
+ iter->current = (ItclClass*)Itcl_PopStack(&iter->stack);
+
+ /*
+ * Push classes onto the stack in reverse order, so that
+ * they will be popped off in the proper order.
+ */
+ if (iter->current) {
+ cdPtr = (ItclClass*)iter->current;
+ elem = Itcl_LastListElem(&cdPtr->bases);
+ while (elem) {
+ Itcl_PushStack(Itcl_GetListValue(elem), &iter->stack);
+ elem = Itcl_PrevListElem(elem);
+ }
+ }
+ return iter->current;
+}
diff --git a/itcl/itcl/generic/itcl_cmds.c b/itcl/itcl/generic/itcl_cmds.c
new file mode 100644
index 00000000000..bd06331e936
--- /dev/null
+++ b/itcl/itcl/generic/itcl_cmds.c
@@ -0,0 +1,1359 @@
+/*
+ * ------------------------------------------------------------------------
+ * PACKAGE: [incr Tcl]
+ * DESCRIPTION: Object-Oriented Extensions to Tcl
+ *
+ * [incr Tcl] provides object-oriented extensions to Tcl, much as
+ * C++ provides object-oriented extensions to C. It provides a means
+ * of encapsulating related procedures together with their shared data
+ * in a local namespace that is hidden from the outside world. It
+ * promotes code re-use through inheritance. More than anything else,
+ * it encourages better organization of Tcl applications through the
+ * object-oriented paradigm, leading to code that is easier to
+ * understand and maintain.
+ *
+ * This file defines information that tracks classes and objects
+ * at a global level for a given interpreter.
+ *
+ * ========================================================================
+ * AUTHOR: Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ * http://www.tcltk.com/itcl
+ *
+ * RCS: $Id$
+ * ========================================================================
+ * Copyright (c) 1993-1998 Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#include "itclInt.h"
+
+/*
+ * FORWARD DECLARATIONS
+ */
+static void ItclDelObjectInfo _ANSI_ARGS_((char* cdata));
+static int Initialize _ANSI_ARGS_((Tcl_Interp *interp));
+static int ItclHandleStubCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static void ItclDeleteStub _ANSI_ARGS_((ClientData cdata));
+
+/*
+ * The following string is the startup script executed in new
+ * interpreters. It locates the Tcl code in the [incr Tcl] library
+ * directory and loads it in.
+ */
+
+static char initScript[] = "\n\
+namespace eval ::itcl {\n\
+ proc _find_init {} {\n\
+ global env tcl_library\n\
+ variable library\n\
+ variable version\n\
+ rename _find_init {}\n\
+ if {[catch {uplevel #0 source -rsrc itcl}] == 0} {\n\
+ return\n\
+ }\n\
+ tcl_findLibrary itcl 3.0 {} itcl.tcl ITCL_LIBRARY ::itcl::library {} {} itcl\n\
+ }\n\
+ _find_init\n\
+}";
+
+/*
+ * The following script is used to initialize Itcl in a safe interpreter.
+ */
+
+static char safeInitScript[] =
+"proc ::itcl::local {class name args} {\n\
+ set ptr [uplevel eval [list $class $name] $args]\n\
+ uplevel [list set itcl-local-$ptr $ptr]\n\
+ set cmd [uplevel namespace which -command $ptr]\n\
+ uplevel [list trace variable itcl-local-$ptr u \"::itcl::delete object $cmd; list\"]\n\
+ return $ptr\n\
+}";
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Initialize()
+ *
+ * Invoked whenever a new interpeter is created to install the
+ * [incr Tcl] package. Usually invoked within Tcl_AppInit() at
+ * the start of execution.
+ *
+ * Creates the "::itcl" namespace and installs access commands for
+ * creating classes and querying info.
+ *
+ * Returns TCL_OK on success, or TCL_ERROR (along with an error
+ * message in the interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+static int
+Initialize(interp)
+ Tcl_Interp *interp; /* interpreter to be updated */
+{
+ Tcl_CmdInfo cmdInfo;
+ Tcl_Namespace *itclNs;
+ ItclObjectInfo *info;
+
+ if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * See if [incr Tcl] is already installed.
+ */
+ if (Tcl_GetCommandInfo(interp, "::itcl::class", &cmdInfo)) {
+ Tcl_SetResult(interp, "already installed: [incr Tcl]", TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize the ensemble package first, since we need this
+ * for other parts of [incr Tcl].
+ */
+ if (Itcl_EnsembleInit(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the top-level data structure for tracking objects.
+ * Store this as "associated data" for easy access, but link
+ * it to the itcl namespace for ownership.
+ */
+ info = (ItclObjectInfo*)ckalloc(sizeof(ItclObjectInfo));
+ info->interp = interp;
+ Tcl_InitHashTable(&info->objects, TCL_ONE_WORD_KEYS);
+ Itcl_InitStack(&info->transparentFrames);
+ Tcl_InitHashTable(&info->contextFrames, TCL_ONE_WORD_KEYS);
+ info->protection = ITCL_DEFAULT_PROTECT;
+ Itcl_InitStack(&info->cdefnStack);
+
+ Tcl_SetAssocData(interp, ITCL_INTERP_DATA,
+ (Tcl_InterpDeleteProc*)NULL, (ClientData)info);
+
+ /*
+ * Install commands into the "::itcl" namespace.
+ */
+ Tcl_CreateObjCommand(interp, "::itcl::class", Itcl_ClassCmd,
+ (ClientData)info, Itcl_ReleaseData);
+ Itcl_PreserveData((ClientData)info);
+
+ Tcl_CreateObjCommand(interp, "::itcl::body", Itcl_BodyCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itcl::configbody", Itcl_ConfigBodyCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
+
+ Itcl_EventuallyFree((ClientData)info, ItclDelObjectInfo);
+
+ /*
+ * Create the "itcl::find" command for high-level queries.
+ */
+ if (Itcl_CreateEnsemble(interp, "::itcl::find") != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Itcl_AddEnsemblePart(interp, "::itcl::find",
+ "classes", "?pattern?",
+ Itcl_FindClassesCmd,
+ (ClientData)info, Itcl_ReleaseData) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Itcl_PreserveData((ClientData)info);
+
+ if (Itcl_AddEnsemblePart(interp, "::itcl::find",
+ "objects", "?-class className? ?-isa className? ?pattern?",
+ Itcl_FindObjectsCmd,
+ (ClientData)info, Itcl_ReleaseData) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Itcl_PreserveData((ClientData)info);
+
+
+ /*
+ * Create the "itcl::delete" command to delete objects
+ * and classes.
+ */
+ if (Itcl_CreateEnsemble(interp, "::itcl::delete") != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Itcl_AddEnsemblePart(interp, "::itcl::delete",
+ "class", "name ?name...?",
+ Itcl_DelClassCmd,
+ (ClientData)info, Itcl_ReleaseData) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Itcl_PreserveData((ClientData)info);
+
+ if (Itcl_AddEnsemblePart(interp, "::itcl::delete",
+ "object", "name ?name...?",
+ Itcl_DelObjectCmd,
+ (ClientData)info, Itcl_ReleaseData) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Itcl_PreserveData((ClientData)info);
+
+ /*
+ * Add "code" and "scope" commands for handling scoped values.
+ */
+ Tcl_CreateObjCommand(interp, "::itcl::code", Itcl_CodeCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itcl::scope", Itcl_ScopeCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
+
+ /*
+ * Add commands for handling import stubs at the Tcl level.
+ */
+ if (Itcl_CreateEnsemble(interp, "::itcl::import::stub") != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Itcl_AddEnsemblePart(interp, "::itcl::import::stub",
+ "create", "name", Itcl_StubCreateCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Itcl_AddEnsemblePart(interp, "::itcl::import::stub",
+ "exists", "name", Itcl_StubExistsCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Install a variable resolution procedure to handle scoped
+ * values everywhere within the interpreter.
+ */
+ Tcl_AddInterpResolvers(interp, "itcl", (Tcl_ResolveCmdProc*)NULL,
+ Itcl_ScopedVarResolver, (Tcl_ResolveCompiledVarProc*)NULL);
+
+ /*
+ * Install the "itcl::parser" namespace used to parse the
+ * class definitions.
+ */
+ if (Itcl_ParseInit(interp, info) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create "itcl::builtin" namespace for commands that
+ * are automatically built into class definitions.
+ */
+ if (Itcl_BiInit(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Install stuff needed for backward compatibility with previous
+ * version of [incr Tcl].
+ */
+ if (Itcl_OldInit(interp, info) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Export all commands in the "itcl" namespace so that they
+ * can be imported with something like "namespace import itcl::*"
+ */
+ itclNs = Tcl_FindNamespace(interp, "::itcl", (Tcl_Namespace*)NULL,
+ TCL_LEAVE_ERR_MSG);
+
+ if (!itclNs ||
+ Tcl_Export(interp, itclNs, "*", /* resetListFirst */ 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Set up the variables containing version info.
+ */
+
+ Tcl_SetVar(interp, "::itcl::patchLevel", ITCL_PATCH_LEVEL,
+ TCL_NAMESPACE_ONLY);
+
+ Tcl_SetVar(interp, "::itcl::version", ITCL_VERSION,
+ TCL_NAMESPACE_ONLY);
+
+ /*
+ * Package is now loaded.
+ */
+ if (Tcl_PkgProvide(interp, "Itcl", ITCL_VERSION) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_Init()
+ *
+ * Invoked whenever a new INTERPRETER is created to install the
+ * [incr Tcl] package. Usually invoked within Tcl_AppInit() at
+ * the start of execution.
+ *
+ * Creates the "::itcl" namespace and installs access commands for
+ * creating classes and querying info.
+ *
+ * Returns TCL_OK on success, or TCL_ERROR (along with an error
+ * message in the interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_Init(interp)
+ Tcl_Interp *interp; /* interpreter to be updated */
+{
+ if (Initialize(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return Tcl_Eval(interp, initScript);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_SafeInit()
+ *
+ * Invoked whenever a new SAFE INTERPRETER is created to install
+ * the [incr Tcl] package.
+ *
+ * Creates the "::itcl" namespace and installs access commands for
+ * creating classes and querying info.
+ *
+ * Returns TCL_OK on success, or TCL_ERROR (along with an error
+ * message in the interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_SafeInit(interp)
+ Tcl_Interp *interp; /* interpreter to be updated */
+{
+ if (Initialize(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return Tcl_Eval(interp, safeInitScript);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclDelObjectInfo()
+ *
+ * Invoked when the management info for [incr Tcl] is no longer being
+ * used in an interpreter. This will only occur when all class
+ * manipulation commands are removed from the interpreter.
+ * ------------------------------------------------------------------------
+ */
+static void
+ItclDelObjectInfo(cdata)
+ char* cdata; /* client data for class command */
+{
+ ItclObjectInfo *info = (ItclObjectInfo*)cdata;
+
+ ItclObject *contextObj;
+ Tcl_HashSearch place;
+ Tcl_HashEntry *entry;
+
+ /*
+ * Destroy all known objects by deleting their access
+ * commands.
+ */
+ entry = Tcl_FirstHashEntry(&info->objects, &place);
+ while (entry) {
+ contextObj = (ItclObject*)Tcl_GetHashValue(entry);
+ Tcl_DeleteCommandFromToken(info->interp, contextObj->accessCmd);
+ entry = Tcl_NextHashEntry(&place);
+ }
+ Tcl_DeleteHashTable(&info->objects);
+
+ /*
+ * Discard all known object contexts.
+ */
+ entry = Tcl_FirstHashEntry(&info->contextFrames, &place);
+ while (entry) {
+ Itcl_ReleaseData( Tcl_GetHashValue(entry) );
+ entry = Tcl_NextHashEntry(&place);
+ }
+ Tcl_DeleteHashTable(&info->contextFrames);
+
+ Itcl_DeleteStack(&info->transparentFrames);
+ Itcl_DeleteStack(&info->cdefnStack);
+ ckfree((char*)info);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_FindClassesCmd()
+ *
+ * Part of the "::info" ensemble. Invoked by Tcl whenever the user
+ * issues an "info classes" command to query the list of classes
+ * in the current namespace. Handles the following syntax:
+ *
+ * info classes ?<pattern>?
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_FindClassesCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* class/object info */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ Tcl_Namespace *activeNs = Tcl_GetCurrentNamespace(interp);
+ Tcl_Namespace *globalNs = Tcl_GetGlobalNamespace(interp);
+ int forceFullNames = 0;
+
+ char *pattern;
+ char *name;
+ int i, nsearch, newEntry;
+ Tcl_HashTable unique;
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch place;
+ Tcl_Namespace *search[2];
+ Tcl_Command cmd, originalCmd;
+ Namespace *nsPtr;
+ Tcl_Obj *listPtr, *objPtr;
+
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?pattern?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 2) {
+ pattern = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ forceFullNames = (strstr(pattern, "::") != NULL);
+ } else {
+ pattern = NULL;
+ }
+
+ /*
+ * Search through all commands in the current namespace and
+ * in the global namespace. If we find any commands that
+ * represent classes, report them.
+ */
+ listPtr = Tcl_NewListObj(0, (Tcl_Obj* CONST*)NULL);
+
+ nsearch = 0;
+ search[nsearch++] = activeNs;
+ if (activeNs != globalNs) {
+ search[nsearch++] = globalNs;
+ }
+
+ Tcl_InitHashTable(&unique, TCL_ONE_WORD_KEYS);
+
+ for (i=0; i < nsearch; i++) {
+ nsPtr = (Namespace*)search[i];
+
+ entry = Tcl_FirstHashEntry(&nsPtr->cmdTable, &place);
+ while (entry) {
+ cmd = (Tcl_Command)Tcl_GetHashValue(entry);
+ if (Itcl_IsClass(cmd)) {
+ originalCmd = TclGetOriginalCommand(cmd);
+
+ /*
+ * Report full names if:
+ * - the pattern has namespace qualifiers
+ * - the class namespace is not in the current namespace
+ * - the class's object creation command is imported from
+ * another namespace.
+ *
+ * Otherwise, report short names.
+ */
+ if (forceFullNames || nsPtr != (Namespace*)activeNs ||
+ originalCmd != NULL) {
+
+ objPtr = Tcl_NewStringObj((char*)NULL, 0);
+ Tcl_GetCommandFullName(interp, cmd, objPtr);
+ name = Tcl_GetStringFromObj(objPtr, (int*)NULL);
+ } else {
+ name = Tcl_GetCommandName(interp, cmd);
+ objPtr = Tcl_NewStringObj(name, -1);
+ }
+
+ if (originalCmd) {
+ cmd = originalCmd;
+ }
+ Tcl_CreateHashEntry(&unique, (char*)cmd, &newEntry);
+
+ if (newEntry && (!pattern || Tcl_StringMatch(name, pattern))) {
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
+ listPtr, objPtr);
+ }
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+ }
+ Tcl_DeleteHashTable(&unique);
+
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_FindObjectsCmd()
+ *
+ * Part of the "::info" ensemble. Invoked by Tcl whenever the user
+ * issues an "info objects" command to query the list of known objects.
+ * Handles the following syntax:
+ *
+ * info objects ?-class <className>? ?-isa <className>? ?<pattern>?
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_FindObjectsCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* class/object info */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ Tcl_Namespace *activeNs = Tcl_GetCurrentNamespace(interp);
+ Tcl_Namespace *globalNs = Tcl_GetGlobalNamespace(interp);
+ int forceFullNames = 0;
+
+ char *pattern = NULL;
+ ItclClass *classDefn = NULL;
+ ItclClass *isaDefn = NULL;
+
+ char *name, *token;
+ int i, pos, nsearch, newEntry, match;
+ ItclObject *contextObj;
+ Tcl_HashTable unique;
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch place;
+ Tcl_Namespace *search[2];
+ Tcl_Command cmd, originalCmd;
+ Namespace *nsPtr;
+ Command *cmdPtr;
+ Tcl_Obj *listPtr, *objPtr;
+
+ /*
+ * Parse arguments:
+ * objects ?-class <className>? ?-isa <className>? ?<pattern>?
+ */
+ pos = 0;
+ while (++pos < objc) {
+ token = Tcl_GetStringFromObj(objv[pos], (int*)NULL);
+ if (*token != '-') {
+ if (!pattern) {
+ pattern = token;
+ forceFullNames = (strstr(pattern, "::") != NULL);
+ } else {
+ break;
+ }
+ }
+ else if ((pos+1 < objc) && (strcmp(token,"-class") == 0)) {
+ name = Tcl_GetStringFromObj(objv[pos+1], (int*)NULL);
+ classDefn = Itcl_FindClass(interp, name, /* autoload */ 1);
+ if (classDefn == NULL) {
+ return TCL_ERROR;
+ }
+ pos++;
+ }
+ else if ((pos+1 < objc) && (strcmp(token,"-isa") == 0)) {
+ name = Tcl_GetStringFromObj(objv[pos+1], (int*)NULL);
+ isaDefn = Itcl_FindClass(interp, name, /* autoload */ 1);
+ if (isaDefn == NULL) {
+ return TCL_ERROR;
+ }
+ pos++;
+ }
+ else {
+ break;
+ }
+ }
+
+ if (pos < objc) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-class className? ?-isa className? ?pattern?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Search through all commands in the current namespace and
+ * in the global namespace. If we find any commands that
+ * represent objects, report them.
+ */
+ listPtr = Tcl_NewListObj(0, (Tcl_Obj* CONST*)NULL);
+
+ nsearch = 0;
+ search[nsearch++] = activeNs;
+ if (activeNs != globalNs) {
+ search[nsearch++] = globalNs;
+ }
+
+ Tcl_InitHashTable(&unique, TCL_ONE_WORD_KEYS);
+
+ for (i=0; i < nsearch; i++) {
+ nsPtr = (Namespace*)search[i];
+
+ entry = Tcl_FirstHashEntry(&nsPtr->cmdTable, &place);
+ while (entry) {
+ cmd = (Tcl_Command)Tcl_GetHashValue(entry);
+ if (Itcl_IsObject(cmd)) {
+ originalCmd = TclGetOriginalCommand(cmd);
+ if (originalCmd) {
+ cmd = originalCmd;
+ }
+ cmdPtr = (Command*)cmd;
+ contextObj = (ItclObject*)cmdPtr->objClientData;
+
+ /*
+ * Report full names if:
+ * - the pattern has namespace qualifiers
+ * - the class namespace is not in the current namespace
+ * - the class's object creation command is imported from
+ * another namespace.
+ *
+ * Otherwise, report short names.
+ */
+ if (forceFullNames || nsPtr != (Namespace*)activeNs ||
+ originalCmd != NULL) {
+
+ objPtr = Tcl_NewStringObj((char*)NULL, 0);
+ Tcl_GetCommandFullName(interp, cmd, objPtr);
+ name = Tcl_GetStringFromObj(objPtr, (int*)NULL);
+ } else {
+ name = Tcl_GetCommandName(interp, cmd);
+ objPtr = Tcl_NewStringObj(name, -1);
+ }
+
+ Tcl_CreateHashEntry(&unique, (char*)cmd, &newEntry);
+
+ match = 0;
+ if (newEntry && (!pattern || Tcl_StringMatch(name, pattern))) {
+ if (!classDefn || (contextObj->classDefn == classDefn)) {
+ if (!isaDefn) {
+ match = 1;
+ } else {
+ entry = Tcl_FindHashEntry(
+ &contextObj->classDefn->heritage,
+ (char*)isaDefn);
+
+ if (entry) {
+ match = 1;
+ }
+ }
+ }
+ }
+
+ if (match) {
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL,
+ listPtr, objPtr);
+ } else {
+ Tcl_IncrRefCount(objPtr); /* throw away the name */
+ Tcl_DecrRefCount(objPtr);
+ }
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+ }
+ Tcl_DeleteHashTable(&unique);
+
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ProtectionCmd()
+ *
+ * Invoked by Tcl whenever the user issues a protection setting
+ * command like "public" or "private". Creates commands and
+ * variables, and assigns a protection level to them. Protection
+ * levels are defined as follows:
+ *
+ * public => accessible from any namespace
+ * protected => accessible from selected namespaces
+ * private => accessible only in the namespace where it was defined
+ *
+ * Handles the following syntax:
+ *
+ * public <command> ?<arg> <arg>...?
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ProtectionCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* protection level (public/protected/private) */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int pLevel = (int)clientData;
+
+ int result;
+ int oldLevel;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "command ?arg arg...?");
+ return TCL_ERROR;
+ }
+
+ oldLevel = Itcl_Protection(interp, pLevel);
+
+ if (objc == 2) {
+ /* CYGNUS LOCAL - Fix for 8.1 */
+#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ result = Tcl_EvalObj(interp, objv[1]);
+#else
+ result = Tcl_EvalObj(interp, objv[1], 0);
+#endif
+ /* END CYGNUS LOCAL */
+ } else {
+ result = Itcl_EvalArgs(interp, objc-1, objv+1);
+ }
+
+ if (result == TCL_BREAK) {
+ Tcl_SetResult(interp, "invoked \"break\" outside of a loop",
+ TCL_STATIC);
+ result = TCL_ERROR;
+ }
+ else if (result == TCL_CONTINUE) {
+ Tcl_SetResult(interp, "invoked \"continue\" outside of a loop",
+ TCL_STATIC);
+ result = TCL_ERROR;
+ }
+ else if (result != TCL_OK) {
+ char mesg[256], *name;
+ name = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ sprintf(mesg, "\n (%.100s body line %d)",
+ name, interp->errorLine);
+ Tcl_AddErrorInfo(interp, mesg);
+ }
+
+ Itcl_Protection(interp, oldLevel);
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_DelClassCmd()
+ *
+ * Part of the "delete" ensemble. Invoked by Tcl whenever the
+ * user issues a "delete class" command to delete classes.
+ * Handles the following syntax:
+ *
+ * delete class <name> ?<name>...?
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_DelClassCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* unused */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int i;
+ char *name;
+ ItclClass *cdefn;
+
+ /*
+ * Since destroying a base class will destroy all derived
+ * classes, calls like "destroy class Base Derived" could
+ * fail. Break this into two passes: first check to make
+ * sure that all classes on the command line are valid,
+ * then delete them.
+ */
+ for (i=1; i < objc; i++) {
+ name = Tcl_GetStringFromObj(objv[i], (int*)NULL);
+ cdefn = Itcl_FindClass(interp, name, /* autoload */ 1);
+ if (cdefn == NULL) {
+ return TCL_ERROR;
+ }
+ }
+
+ for (i=1; i < objc; i++) {
+ name = Tcl_GetStringFromObj(objv[i], (int*)NULL);
+ cdefn = Itcl_FindClass(interp, name, /* autoload */ 0);
+
+ if (cdefn) {
+ Tcl_ResetResult(interp);
+ if (Itcl_DeleteClass(interp, cdefn) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ }
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_DelObjectCmd()
+ *
+ * Part of the "delete" ensemble. Invoked by Tcl whenever the user
+ * issues a "delete object" command to delete [incr Tcl] objects.
+ * Handles the following syntax:
+ *
+ * delete object <name> ?<name>...?
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_DelObjectCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* object management info */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int i;
+ char *name;
+ ItclObject *contextObj;
+
+ /*
+ * Scan through the list of objects and attempt to delete them.
+ * If anything goes wrong (i.e., destructors fail), then
+ * abort with an error.
+ */
+ for (i=1; i < objc; i++) {
+ name = Tcl_GetStringFromObj(objv[i], (int*)NULL);
+ if (Itcl_FindObject(interp, name, &contextObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (contextObj == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "object \"", name, "\" not found",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ if (Itcl_DeleteObject(interp, contextObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ScopeCmd()
+ *
+ * Invoked by Tcl whenever the user issues a "scope" command to
+ * create a fully qualified variable name. Handles the following
+ * syntax:
+ *
+ * scope <variable>
+ *
+ * If the input string is already fully qualified (starts with "::"),
+ * then this procedure does nothing. Otherwise, it looks for a
+ * data member called <variable> and returns its fully qualified
+ * name. If the <variable> is a common data member, this procedure
+ * returns a name of the form:
+ *
+ * ::namesp::namesp::class::variable
+ *
+ * If the <variable> is an instance variable, this procedure returns
+ * a name of the form:
+ *
+ * @itcl ::namesp::namesp::object variable
+ *
+ * This kind of scoped value is recognized by the Itcl_ScopedVarResolver
+ * proc, which handles variable resolution for the entire interpreter.
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_ScopeCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* unused */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int result = TCL_OK;
+ Tcl_Namespace *contextNs = Tcl_GetCurrentNamespace(interp);
+ char *openParen = NULL;
+
+ register char *p;
+ char *token;
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+ ItclObjectInfo *info;
+ Tcl_CallFrame *framePtr;
+ Tcl_HashEntry *entry;
+ ItclVarLookup *vlookup;
+ Tcl_Obj *objPtr;
+ Tcl_Var var;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "varname");
+ return TCL_ERROR;
+ }
+
+ /*
+ * If this looks like a fully qualified name already,
+ * then return it as is.
+ */
+ token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ if (*token == ':' && *(token+1) == ':') {
+ Tcl_SetObjResult(interp, objv[1]);
+ return TCL_OK;
+ }
+
+ /*
+ * If the variable name is an array reference, pick out
+ * the array name and use that for the lookup operations
+ * below.
+ */
+ for (p=token; *p != '\0'; p++) {
+ if (*p == '(') {
+ openParen = p;
+ }
+ else if (*p == ')' && openParen) {
+ *openParen = '\0';
+ break;
+ }
+ }
+
+ /*
+ * Figure out what context we're in. If this is a class,
+ * then look up the variable in the class definition.
+ * If this is a namespace, then look up the variable in its
+ * varTable. Note that the normal Itcl_GetContext function
+ * returns an error if we're not in a class context, so we
+ * perform a similar function here, the hard way.
+ *
+ * TRICKY NOTE: If this is an array reference, we'll get
+ * the array variable as the variable name. We must be
+ * careful to add the index (everything from openParen
+ * onward) as well.
+ */
+ if (Itcl_IsClassNamespace(contextNs)) {
+ contextClass = (ItclClass*)contextNs->clientData;
+
+ entry = Tcl_FindHashEntry(&contextClass->resolveVars, token);
+ if (!entry) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "variable \"", token, "\" not found in class \"",
+ contextClass->fullname, "\"",
+ (char*)NULL);
+ result = TCL_ERROR;
+ goto scopeCmdDone;
+ }
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+
+ if (vlookup->vdefn->member->flags & ITCL_COMMON) {
+ Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+ Tcl_AppendToObj(resultPtr, vlookup->vdefn->member->fullname, -1);
+ if (openParen) {
+ *openParen = '(';
+ Tcl_AppendToObj(resultPtr, openParen, -1);
+ openParen = NULL;
+ }
+ result = TCL_OK;
+ goto scopeCmdDone;
+ }
+
+ /*
+ * If this is not a common variable, then we better have
+ * an object context. Return the name "@itcl object variable".
+ */
+ framePtr = _Tcl_GetCallFrame(interp, 0);
+ info = contextClass->info;
+
+ entry = Tcl_FindHashEntry(&info->contextFrames, (char*)framePtr);
+ if (!entry) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "can't scope variable \"", token,
+ "\": missing object context\"",
+ (char*)NULL);
+ result = TCL_ERROR;
+ goto scopeCmdDone;
+ }
+ contextObj = (ItclObject*)Tcl_GetHashValue(entry);
+
+ Tcl_AppendElement(interp, "@itcl");
+
+ objPtr = Tcl_NewStringObj((char*)NULL, 0);
+ Tcl_IncrRefCount(objPtr);
+ Tcl_GetCommandFullName(interp, contextObj->accessCmd, objPtr);
+ Tcl_AppendElement(interp, Tcl_GetStringFromObj(objPtr, (int*)NULL));
+ Tcl_DecrRefCount(objPtr);
+
+ objPtr = Tcl_NewStringObj((char*)NULL, 0);
+ Tcl_IncrRefCount(objPtr);
+ Tcl_AppendToObj(objPtr, vlookup->vdefn->member->fullname, -1);
+
+ if (openParen) {
+ *openParen = '(';
+ Tcl_AppendToObj(objPtr, openParen, -1);
+ openParen = NULL;
+ }
+ Tcl_AppendElement(interp, Tcl_GetStringFromObj(objPtr, (int*)NULL));
+ Tcl_DecrRefCount(objPtr);
+ }
+
+ /*
+ * We must be in an ordinary namespace context. Resolve
+ * the variable using Tcl_FindNamespaceVar.
+ *
+ * TRICKY NOTE: If this is an array reference, we'll get
+ * the array variable as the variable name. We must be
+ * careful to add the index (everything from openParen
+ * onward) as well.
+ */
+ else {
+ Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+
+ var = Tcl_FindNamespaceVar(interp, token, contextNs,
+ TCL_NAMESPACE_ONLY);
+
+ if (!var) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "variable \"", token, "\" not found in namespace \"",
+ contextNs->fullName, "\"",
+ (char*)NULL);
+ result = TCL_ERROR;
+ goto scopeCmdDone;
+ }
+
+ Tcl_GetVariableFullName(interp, var, resultPtr);
+ if (openParen) {
+ *openParen = '(';
+ Tcl_AppendToObj(resultPtr, openParen, -1);
+ openParen = NULL;
+ }
+ }
+
+scopeCmdDone:
+ if (openParen) {
+ *openParen = '(';
+ }
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_CodeCmd()
+ *
+ * Invoked by Tcl whenever the user issues a "code" command to
+ * create a scoped command string. Handles the following syntax:
+ *
+ * code ?-namespace foo? arg ?arg arg ...?
+ *
+ * Unlike the scope command, the code command DOES NOT look for
+ * scoping information at the beginning of the command. So scopes
+ * will nest in the code command.
+ *
+ * The code command is similar to the "namespace code" command in
+ * Tcl, but it preserves the list structure of the input arguments,
+ * so it is a lot more useful.
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_CodeCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* unused */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ Tcl_Namespace *contextNs = Tcl_GetCurrentNamespace(interp);
+
+ int pos;
+ char *token;
+ Tcl_Obj *listPtr, *objPtr;
+
+ /*
+ * Handle flags like "-namespace"...
+ */
+ for (pos=1; pos < objc; pos++) {
+ token = Tcl_GetStringFromObj(objv[pos], (int*)NULL);
+ if (*token != '-') {
+ break;
+ }
+
+ if (strcmp(token, "-namespace") == 0) {
+ if (objc == 2) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-namespace name? command ?arg arg...?");
+ return TCL_ERROR;
+ } else {
+ token = Tcl_GetStringFromObj(objv[pos+1], (int*)NULL);
+ contextNs = Tcl_FindNamespace(interp, token,
+ (Tcl_Namespace*)NULL, TCL_LEAVE_ERR_MSG);
+
+ if (!contextNs) {
+ return TCL_ERROR;
+ }
+ pos++;
+ }
+ }
+ else if (strcmp(token, "--") == 0) {
+ pos++;
+ break;
+ }
+ else {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad option \"", token, "\": should be -namespace or --",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "?-namespace name? command ?arg arg...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Now construct a scoped command by integrating the
+ * current namespace context, and appending the remaining
+ * arguments AS A LIST...
+ */
+ listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
+
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj("namespace", -1));
+ Tcl_ListObjAppendElement(interp, listPtr,
+ Tcl_NewStringObj("inscope", -1));
+
+ if (contextNs == Tcl_GetGlobalNamespace(interp)) {
+ objPtr = Tcl_NewStringObj("::", -1);
+ } else {
+ objPtr = Tcl_NewStringObj(contextNs->fullName, -1);
+ }
+ Tcl_ListObjAppendElement(interp, listPtr, objPtr);
+
+ if (objc-pos == 1) {
+ objPtr = objv[pos];
+ } else {
+ objPtr = Tcl_NewListObj(objc-pos, &objv[pos]);
+ }
+ Tcl_ListObjAppendElement(interp, listPtr, objPtr);
+
+ Tcl_SetObjResult(interp, listPtr);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_StubCreateCmd()
+ *
+ * Invoked by Tcl whenever the user issues a "stub create" command to
+ * create an autoloading stub for imported commands. Handles the
+ * following syntax:
+ *
+ * stub create <name>
+ *
+ * Creates a command called <name>. Executing this command will cause
+ * the real command <name> to be autoloaded.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_StubCreateCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ char *cmdName;
+ Command *cmdPtr;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ cmdName = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+
+ /*
+ * Create a stub command with the characteristic ItclDeleteStub
+ * procedure. That way, we can recognize this command later
+ * on as a stub. Save the cmd token as client data, so we can
+ * get the full name of this command later on.
+ */
+ cmdPtr = (Command *) Tcl_CreateObjCommand(interp, cmdName,
+ ItclHandleStubCmd, (ClientData)NULL,
+ (Tcl_CmdDeleteProc*)ItclDeleteStub);
+
+ cmdPtr->objClientData = (ClientData) cmdPtr;
+
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_StubExistsCmd()
+ *
+ * Invoked by Tcl whenever the user issues a "stub exists" command to
+ * see if an existing command is an autoloading stub. Handles the
+ * following syntax:
+ *
+ * stub exists <name>
+ *
+ * Looks for a command called <name> and checks to see if it is an
+ * autoloading stub. Returns a boolean result.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_StubExistsCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ char *cmdName;
+ Tcl_Command cmd;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name");
+ return TCL_ERROR;
+ }
+ cmdName = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+
+ cmd = Tcl_FindCommand(interp, cmdName, (Tcl_Namespace*)NULL, 0);
+
+ if (cmd != NULL && Itcl_IsStub(cmd)) {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), 1);
+ } else {
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), 0);
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_IsStub()
+ *
+ * Checks the given Tcl command to see if it represents an autoloading
+ * stub created by the "stub create" command. Returns non-zero if
+ * the command is indeed a stub.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_IsStub(cmd)
+ Tcl_Command cmd; /* command being tested */
+{
+ Command *cmdPtr = (Command*)cmd;
+
+ /*
+ * This may be an imported command, but don't try to get the
+ * original. Just check to see if this particular command
+ * is a stub. If we really want the original command, we'll
+ * find it at a higher level.
+ */
+ if (cmdPtr->deleteProc == ItclDeleteStub) {
+ return 1;
+ }
+ return 0;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclHandleStubCmd()
+ *
+ * Invoked by Tcl to handle commands created by "stub create".
+ * Calls "auto_load" with the full name of the current command to
+ * trigger autoloading of the real implementation. Then, calls the
+ * command to handle its function. If successful, this command
+ * returns TCL_OK along with the result from the real implementation
+ * of this command. Otherwise, it returns TCL_ERROR, along with an
+ * error message in the interpreter.
+ * ------------------------------------------------------------------------
+ */
+static int
+ItclHandleStubCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* command token for this stub */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ Tcl_Command cmd = (Tcl_Command) clientData;
+
+ int result, loaded;
+ char *cmdName;
+ int cmdlinec;
+ Tcl_Obj **cmdlinev;
+ Tcl_Obj *objAutoLoad[2], *objPtr, *cmdNamePtr, *cmdlinePtr;
+
+ cmdNamePtr = Tcl_NewStringObj((char*)NULL, 0);
+ Tcl_GetCommandFullName(interp, cmd, cmdNamePtr);
+ Tcl_IncrRefCount(cmdNamePtr);
+ cmdName = Tcl_GetStringFromObj(cmdNamePtr, (int*)NULL);
+
+ /*
+ * Try to autoload the real command for this stub.
+ */
+ objAutoLoad[0] = Tcl_NewStringObj("::auto_load", -1);
+ Tcl_IncrRefCount(objAutoLoad[0]);
+ objAutoLoad[1] = cmdNamePtr;
+ Tcl_IncrRefCount(objAutoLoad[1]);
+
+ result = Itcl_EvalArgs(interp, 2, objAutoLoad);
+
+ Tcl_DecrRefCount(objAutoLoad[0]);
+ Tcl_DecrRefCount(objAutoLoad[1]);
+
+ if (result != TCL_OK) {
+ Tcl_DecrRefCount(cmdNamePtr);
+ return TCL_ERROR;
+ }
+
+ objPtr = Tcl_GetObjResult(interp);
+ result = Tcl_GetIntFromObj(interp, objPtr, &loaded);
+ if (result != TCL_OK || !loaded) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "can't autoload \"", cmdName, "\"", (char*)NULL);
+ Tcl_DecrRefCount(cmdNamePtr);
+ return TCL_ERROR;
+ }
+
+ /*
+ * At this point, the real implementation has been loaded.
+ * Invoke the command again with the arguments passed in.
+ */
+ cmdlinePtr = Itcl_CreateArgs(interp, cmdName, objc-1, objv+1);
+
+ (void) Tcl_ListObjGetElements((Tcl_Interp*)NULL, cmdlinePtr,
+ &cmdlinec, &cmdlinev);
+
+ Tcl_ResetResult(interp);
+ result = Itcl_EvalArgs(interp, cmdlinec, cmdlinev);
+ Tcl_DecrRefCount(cmdlinePtr);
+
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclDeleteStub()
+ *
+ * Invoked by Tcl whenever a stub command is deleted. This procedure
+ * does nothing, but its presence identifies a command as a stub.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static void
+ItclDeleteStub(cdata)
+ ClientData cdata; /* not used */
+{
+ /* do nothing */
+}
diff --git a/itcl/itcl/generic/itcl_ensemble.c b/itcl/itcl/generic/itcl_ensemble.c
new file mode 100644
index 00000000000..60ba06ebab7
--- /dev/null
+++ b/itcl/itcl/generic/itcl_ensemble.c
@@ -0,0 +1,2248 @@
+/*
+ * ------------------------------------------------------------------------
+ * PACKAGE: [incr Tcl]
+ * DESCRIPTION: Object-Oriented Extensions to Tcl
+ *
+ * [incr Tcl] provides object-oriented extensions to Tcl, much as
+ * C++ provides object-oriented extensions to C. It provides a means
+ * of encapsulating related procedures together with their shared data
+ * in a local namespace that is hidden from the outside world. It
+ * promotes code re-use through inheritance. More than anything else,
+ * it encourages better organization of Tcl applications through the
+ * object-oriented paradigm, leading to code that is easier to
+ * understand and maintain.
+ *
+ * This part handles ensembles, which support compound commands in Tcl.
+ * The usual "info" command is an ensemble with parts like "info body"
+ * and "info globals". Extension developers can extend commands like
+ * "info" by adding their own parts to the ensemble.
+ *
+ * ========================================================================
+ * AUTHOR: Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ * http://www.tcltk.com/itcl
+ *
+ * RCS: $Id$
+ * ========================================================================
+ * Copyright (c) 1993-1998 Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#include "itclInt.h"
+
+/*
+ * Data used to represent an ensemble:
+ */
+struct Ensemble;
+typedef struct EnsemblePart {
+ char *name; /* name of this part */
+ int minChars; /* chars needed to uniquely identify part */
+ Command *cmdPtr; /* command handling this part */
+ char *usage; /* usage string describing syntax */
+ struct Ensemble* ensemble; /* ensemble containing this part */
+} EnsemblePart;
+
+/*
+ * Data used to represent an ensemble:
+ */
+typedef struct Ensemble {
+ Tcl_Interp *interp; /* interpreter containing this ensemble */
+ EnsemblePart **parts; /* list of parts in this ensemble */
+ int numParts; /* number of parts in part list */
+ int maxParts; /* current size of parts list */
+ Tcl_Command cmd; /* command representing this ensemble */
+ EnsemblePart* parent; /* parent part for sub-ensembles
+ * NULL => toplevel ensemble */
+} Ensemble;
+
+/*
+ * Data shared by ensemble access commands and ensemble parser:
+ */
+typedef struct EnsembleParser {
+ Tcl_Interp* master; /* master interp containing ensembles */
+ Tcl_Interp* parser; /* slave interp for parsing */
+ Ensemble* ensData; /* add parts to this ensemble */
+} EnsembleParser;
+
+/*
+ * Declarations for local procedures to this file:
+ */
+static void FreeEnsInvocInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr));
+static void DupEnsInvocInternalRep _ANSI_ARGS_((Tcl_Obj *objPtr,
+ Tcl_Obj *copyPtr));
+static void UpdateStringOfEnsInvoc _ANSI_ARGS_((Tcl_Obj *objPtr));
+static int SetEnsInvocFromAny _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *objPtr));
+
+/*
+ * This structure defines a Tcl object type that takes the
+ * place of a part name during ensemble invocations. When an
+ * error occurs and the caller tries to print objv[0], it will
+ * get a string that contains a complete path to the ensemble
+ * part.
+ */
+Tcl_ObjType itclEnsInvocType = {
+ "ensembleInvoc", /* name */
+ FreeEnsInvocInternalRep, /* freeIntRepProc */
+ DupEnsInvocInternalRep, /* dupIntRepProc */
+ UpdateStringOfEnsInvoc, /* updateStringProc */
+ SetEnsInvocFromAny /* setFromAnyProc */
+};
+
+/*
+ * Boolean flag indicating whether or not the "ensemble" object
+ * type has been registered with the Tcl compiler.
+ */
+static int ensInitialized = 0;
+
+/*
+ * Forward declarations for the procedures used in this file.
+ */
+static void GetEnsembleUsage _ANSI_ARGS_((Ensemble *ensData,
+ Tcl_Obj *objPtr));
+
+static void GetEnsemblePartUsage _ANSI_ARGS_((EnsemblePart *ensPart,
+ Tcl_Obj *objPtr));
+
+static int CreateEnsemble _ANSI_ARGS_((Tcl_Interp *interp,
+ Ensemble *parentEnsData, char *ensName));
+
+static int AddEnsemblePart _ANSI_ARGS_((Tcl_Interp *interp,
+ Ensemble* ensData, char* partName, char* usageInfo,
+ Tcl_ObjCmdProc *objProc, ClientData clientData,
+ Tcl_CmdDeleteProc *deleteProc, EnsemblePart **rVal));
+
+static void DeleteEnsemble _ANSI_ARGS_((ClientData clientData));
+
+static int FindEnsemble _ANSI_ARGS_((Tcl_Interp *interp, char **nameArgv,
+ int nameArgc, Ensemble** ensDataPtr));
+
+static int CreateEnsemblePart _ANSI_ARGS_((Tcl_Interp *interp,
+ Ensemble *ensData, char* partName, EnsemblePart **ensPartPtr));
+
+static void DeleteEnsemblePart _ANSI_ARGS_((EnsemblePart *ensPart));
+
+static int FindEnsemblePart _ANSI_ARGS_((Tcl_Interp *interp,
+ Ensemble *ensData, char* partName, EnsemblePart **rensPart));
+
+static int FindEnsemblePartIndex _ANSI_ARGS_((Ensemble *ensData,
+ char *partName, int *posPtr));
+
+static void ComputeMinChars _ANSI_ARGS_((Ensemble *ensData, int pos));
+
+static int HandleEnsemble _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+
+static EnsembleParser* GetEnsembleParser _ANSI_ARGS_((Tcl_Interp *interp));
+
+static void DeleteEnsParser _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp* interp));
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Itcl_EnsembleInit --
+ *
+ * Called when any interpreter is created to make sure that
+ * things are properly set up for ensembles.
+ *
+ * Results:
+ * Returns TCL_OK if successful, and TCL_ERROR if anything goes
+ * wrong.
+ *
+ * Side effects:
+ * On the first call, the "ensemble" object type is registered
+ * with the Tcl compiler. If an error is encountered, an error
+ * is left as the result in the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+ /* ARGSUSED */
+int
+Itcl_EnsembleInit(interp)
+ Tcl_Interp *interp; /* interpreter being initialized */
+{
+ if (!ensInitialized) {
+ Tcl_RegisterObjType(&itclEnsInvocType);
+ ensInitialized = 1;
+ }
+
+ Tcl_CreateObjCommand(interp, "::itcl::ensemble",
+ Itcl_EnsembleCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
+
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Itcl_CreateEnsemble --
+ *
+ * Creates an ensemble command, or adds a sub-ensemble to an
+ * existing ensemble command. The ensemble name is a space-
+ * separated list. The first word in the list is the command
+ * name for the top-level ensemble. Other names do not have
+ * commands associated with them; they are merely sub-ensembles
+ * within the ensemble. So a name like "a::b::foo bar baz"
+ * represents an ensemble command called "foo" in the namespace
+ * "a::b" that has a sub-ensemble "bar", that has a sub-ensemble
+ * "baz".
+ *
+ * If the name is a single word, then this procedure creates
+ * a top-level ensemble and installs an access command for it.
+ * If a command already exists with that name, it is deleted.
+ *
+ * If the name has more than one word, then the leading words
+ * are treated as a path name for an existing ensemble. The
+ * last word is treated as the name for a new sub-ensemble.
+ * If an part already exists with that name, it is an error.
+ *
+ * Results:
+ * Returns TCL_OK if successful, and TCL_ERROR if anything goes
+ * wrong.
+ *
+ * Side effects:
+ * If an error is encountered, an error is left as the result
+ * in the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+Itcl_CreateEnsemble(interp, ensName)
+ Tcl_Interp *interp; /* interpreter to be updated */
+ char* ensName; /* name of the new ensemble */
+{
+ char **nameArgv = NULL;
+ int nameArgc;
+ Ensemble *parentEnsData;
+ Tcl_DString buffer;
+
+ /*
+ * Split the ensemble name into its path components.
+ */
+ if (Tcl_SplitList(interp, ensName, &nameArgc, &nameArgv) != TCL_OK) {
+ goto ensCreateFail;
+ }
+ if (nameArgc < 1) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "invalid ensemble name \"", ensName, "\"",
+ (char*)NULL);
+ goto ensCreateFail;
+ }
+
+ /*
+ * If there is more than one path component, then follow
+ * the path down to the last component, to find the containing
+ * ensemble.
+ */
+ parentEnsData = NULL;
+ if (nameArgc > 1) {
+ if (FindEnsemble(interp, nameArgv, nameArgc-1, &parentEnsData)
+ != TCL_OK) {
+ goto ensCreateFail;
+ }
+
+ if (parentEnsData == NULL) {
+ char *pname = Tcl_Merge(nameArgc-1, nameArgv);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "invalid ensemble name \"", pname, "\"",
+ (char*)NULL);
+ ckfree(pname);
+ goto ensCreateFail;
+ }
+ }
+
+ /*
+ * Create the ensemble.
+ */
+ if (CreateEnsemble(interp, parentEnsData, nameArgv[nameArgc-1])
+ != TCL_OK) {
+ goto ensCreateFail;
+ }
+
+ ckfree((char*)nameArgv);
+ return TCL_OK;
+
+ensCreateFail:
+ if (nameArgv) {
+ ckfree((char*)nameArgv);
+ }
+ Tcl_DStringInit(&buffer);
+ Tcl_DStringAppend(&buffer, "\n (while creating ensemble \"", -1);
+ Tcl_DStringAppend(&buffer, ensName, -1);
+ Tcl_DStringAppend(&buffer, "\")", -1);
+ Tcl_AddObjErrorInfo(interp, Tcl_DStringValue(&buffer), -1);
+ Tcl_DStringFree(&buffer);
+
+ return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Itcl_AddEnsemblePart --
+ *
+ * Adds a part to an ensemble which has been created by
+ * Itcl_CreateEnsemble. Ensembles are addressed by name, as
+ * described in Itcl_CreateEnsemble.
+ *
+ * If the ensemble already has a part with the specified name,
+ * this procedure returns an error. Otherwise, it adds a new
+ * part to the ensemble.
+ *
+ * Any client data specified is automatically passed to the
+ * handling procedure whenever the part is invoked. It is
+ * automatically destroyed by the deleteProc when the part is
+ * deleted.
+ *
+ * Results:
+ * Returns TCL_OK if successful, and TCL_ERROR if anything goes
+ * wrong.
+ *
+ * Side effects:
+ * If an error is encountered, an error is left as the result
+ * in the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+Itcl_AddEnsemblePart(interp, ensName, partName, usageInfo,
+ objProc, clientData, deleteProc)
+
+ Tcl_Interp *interp; /* interpreter to be updated */
+ char* ensName; /* ensemble containing this part */
+ char* partName; /* name of the new part */
+ char* usageInfo; /* usage info for argument list */
+ Tcl_ObjCmdProc *objProc; /* handling procedure for part */
+ ClientData clientData; /* client data associated with part */
+ Tcl_CmdDeleteProc *deleteProc; /* procedure used to destroy client data */
+{
+ char **nameArgv = NULL;
+ int nameArgc;
+ Ensemble *ensData;
+ EnsemblePart *ensPart;
+ Tcl_DString buffer;
+
+ /*
+ * Parse the ensemble name and look for a containing ensemble.
+ */
+ if (Tcl_SplitList(interp, ensName, &nameArgc, &nameArgv) != TCL_OK) {
+ goto ensPartFail;
+ }
+ if (FindEnsemble(interp, nameArgv, nameArgc, &ensData) != TCL_OK) {
+ goto ensPartFail;
+ }
+
+ if (ensData == NULL) {
+ char *pname = Tcl_Merge(nameArgc, nameArgv);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "invalid ensemble name \"", pname, "\"",
+ (char*)NULL);
+ ckfree(pname);
+ goto ensPartFail;
+ }
+
+ /*
+ * Install the new part into the part list.
+ */
+ if (AddEnsemblePart(interp, ensData, partName, usageInfo,
+ objProc, clientData, deleteProc, &ensPart) != TCL_OK) {
+ goto ensPartFail;
+ }
+
+ ckfree((char*)nameArgv);
+ return TCL_OK;
+
+ensPartFail:
+ if (nameArgv) {
+ ckfree((char*)nameArgv);
+ }
+ Tcl_DStringInit(&buffer);
+ Tcl_DStringAppend(&buffer, "\n (while adding to ensemble \"", -1);
+ Tcl_DStringAppend(&buffer, ensName, -1);
+ Tcl_DStringAppend(&buffer, "\")", -1);
+ Tcl_AddObjErrorInfo(interp, Tcl_DStringValue(&buffer), -1);
+ Tcl_DStringFree(&buffer);
+
+ return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Itcl_GetEnsemblePart --
+ *
+ * Looks for a part within an ensemble, and returns information
+ * about it.
+ *
+ * Results:
+ * If the ensemble and its part are found, this procedure
+ * loads information about the part into the "infoPtr" structure
+ * and returns 1. Otherwise, it returns 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+Itcl_GetEnsemblePart(interp, ensName, partName, infoPtr)
+ Tcl_Interp *interp; /* interpreter to be updated */
+ char *ensName; /* ensemble containing the part */
+ char *partName; /* name of the desired part */
+ Tcl_CmdInfo *infoPtr; /* returns: info associated with part */
+{
+ char **nameArgv = NULL;
+ int nameArgc;
+ Ensemble *ensData;
+ EnsemblePart *ensPart;
+ Command *cmdPtr;
+ Itcl_InterpState state;
+
+ /*
+ * Parse the ensemble name and look for a containing ensemble.
+ * Save the interpreter state before we do this. If we get any
+ * errors, we don't want them to affect the interpreter.
+ */
+ state = Itcl_SaveInterpState(interp, TCL_OK);
+
+ if (Tcl_SplitList(interp, ensName, &nameArgc, &nameArgv) != TCL_OK) {
+ goto ensGetFail;
+ }
+ if (FindEnsemble(interp, nameArgv, nameArgc, &ensData) != TCL_OK) {
+ goto ensGetFail;
+ }
+ if (ensData == NULL) {
+ goto ensGetFail;
+ }
+
+ /*
+ * Look for a part with the desired name. If found, load
+ * its data into the "infoPtr" structure.
+ */
+ if (FindEnsemblePart(interp, ensData, partName, &ensPart)
+ != TCL_OK || ensPart == NULL) {
+ goto ensGetFail;
+ }
+
+ cmdPtr = ensPart->cmdPtr;
+ infoPtr->isNativeObjectProc = (cmdPtr->objProc != TclInvokeStringCommand);
+ infoPtr->objProc = cmdPtr->objProc;
+ infoPtr->objClientData = cmdPtr->objClientData;
+ infoPtr->proc = cmdPtr->proc;
+ infoPtr->clientData = cmdPtr->clientData;
+ infoPtr->deleteProc = cmdPtr->deleteProc;
+ infoPtr->deleteData = cmdPtr->deleteData;
+ infoPtr->namespacePtr = (Tcl_Namespace*)cmdPtr->nsPtr;
+
+ Itcl_DiscardInterpState(state);
+ return 1;
+
+ensGetFail:
+ Itcl_RestoreInterpState(interp, state);
+ return 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Itcl_IsEnsemble --
+ *
+ * Determines whether or not an existing command is an ensemble.
+ *
+ * Results:
+ * Returns non-zero if the command is an ensemble, and zero
+ * otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+Itcl_IsEnsemble(infoPtr)
+ Tcl_CmdInfo* infoPtr; /* command info from Tcl_GetCommandInfo() */
+{
+ if (infoPtr) {
+ return (infoPtr->deleteProc == DeleteEnsemble);
+ }
+ return 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Itcl_GetEnsembleUsage --
+ *
+ * Returns a summary of all of the parts of an ensemble and
+ * the meaning of their arguments. Each part is listed on
+ * a separate line. Having this summary is sometimes useful
+ * when building error messages for the "@error" handler in
+ * an ensemble.
+ *
+ * Ensembles are accessed by name, as described in
+ * Itcl_CreateEnsemble.
+ *
+ * Results:
+ * If the ensemble is found, its usage information is appended
+ * onto the object "objPtr", and this procedure returns
+ * non-zero. It is the responsibility of the caller to
+ * initialize and free the object. If anything goes wrong,
+ * this procedure returns 0.
+ *
+ * Side effects:
+ * Object passed in is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+Itcl_GetEnsembleUsage(interp, ensName, objPtr)
+ Tcl_Interp *interp; /* interpreter containing the ensemble */
+ char *ensName; /* name of the ensemble */
+ Tcl_Obj *objPtr; /* returns: summary of usage info */
+{
+ char **nameArgv = NULL;
+ int nameArgc;
+ Ensemble *ensData;
+ Itcl_InterpState state;
+
+ /*
+ * Parse the ensemble name and look for the ensemble.
+ * Save the interpreter state before we do this. If we get
+ * any errors, we don't want them to affect the interpreter.
+ */
+ state = Itcl_SaveInterpState(interp, TCL_OK);
+
+ if (Tcl_SplitList(interp, ensName, &nameArgc, &nameArgv) != TCL_OK) {
+ goto ensUsageFail;
+ }
+ if (FindEnsemble(interp, nameArgv, nameArgc, &ensData) != TCL_OK) {
+ goto ensUsageFail;
+ }
+ if (ensData == NULL) {
+ goto ensUsageFail;
+ }
+
+ /*
+ * Add a summary of usage information to the return buffer.
+ */
+ GetEnsembleUsage(ensData, objPtr);
+
+ Itcl_DiscardInterpState(state);
+ return 1;
+
+ensUsageFail:
+ Itcl_RestoreInterpState(interp, state);
+ return 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Itcl_GetEnsembleUsageForObj --
+ *
+ * Returns a summary of all of the parts of an ensemble and
+ * the meaning of their arguments. This procedure is just
+ * like Itcl_GetEnsembleUsage, but it determines the desired
+ * ensemble from a command line argument. The argument should
+ * be the first argument on the command line--the ensemble
+ * command or one of its parts.
+ *
+ * Results:
+ * If the ensemble is found, its usage information is appended
+ * onto the object "objPtr", and this procedure returns
+ * non-zero. It is the responsibility of the caller to
+ * initialize and free the object. If anything goes wrong,
+ * this procedure returns 0.
+ *
+ * Side effects:
+ * Object passed in is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+Itcl_GetEnsembleUsageForObj(interp, ensObjPtr, objPtr)
+ Tcl_Interp *interp; /* interpreter containing the ensemble */
+ Tcl_Obj *ensObjPtr; /* argument representing ensemble */
+ Tcl_Obj *objPtr; /* returns: summary of usage info */
+{
+ Ensemble *ensData;
+ Tcl_Obj *chainObj;
+ Tcl_Command cmd;
+ Command *cmdPtr;
+
+ /*
+ * If the argument is an ensemble part, then follow the chain
+ * back to the command word for the entire ensemble.
+ */
+ chainObj = ensObjPtr;
+ while (chainObj && chainObj->typePtr == &itclEnsInvocType) {
+ chainObj = (Tcl_Obj*)chainObj->internalRep.twoPtrValue.ptr2;
+ }
+
+ if (chainObj) {
+ cmd = Tcl_GetCommandFromObj(interp, chainObj);
+ cmdPtr = (Command*)cmd;
+ if (cmdPtr->deleteProc == DeleteEnsemble) {
+ ensData = (Ensemble*)cmdPtr->objClientData;
+ GetEnsembleUsage(ensData, objPtr);
+ return 1;
+ }
+ }
+ return 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetEnsembleUsage --
+ *
+ *
+ * Returns a summary of all of the parts of an ensemble and
+ * the meaning of their arguments. Each part is listed on
+ * a separate line. This procedure is used internally to
+ * generate usage information for error messages.
+ *
+ * Results:
+ * Appends usage information onto the object in "objPtr".
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+GetEnsembleUsage(ensData, objPtr)
+ Ensemble *ensData; /* ensemble data */
+ Tcl_Obj *objPtr; /* returns: summary of usage info */
+{
+ char *spaces = " ";
+ int isOpenEnded = 0;
+
+ int i;
+ EnsemblePart *ensPart;
+
+ for (i=0; i < ensData->numParts; i++) {
+ ensPart = ensData->parts[i];
+
+ if (*ensPart->name == '@' && strcmp(ensPart->name,"@error") == 0) {
+ isOpenEnded = 1;
+ }
+ else {
+ Tcl_AppendToObj(objPtr, spaces, -1);
+ GetEnsemblePartUsage(ensPart, objPtr);
+ spaces = "\n ";
+ }
+ }
+ if (isOpenEnded) {
+ Tcl_AppendToObj(objPtr,
+ "\n...and others described on the man page", -1);
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetEnsemblePartUsage --
+ *
+ * Determines the usage for a single part within an ensemble,
+ * and appends a summary onto a dynamic string. The usage
+ * is a combination of the part name and the argument summary.
+ * It is the caller's responsibility to initialize and free
+ * the dynamic string.
+ *
+ * Results:
+ * Returns usage information in the object "objPtr".
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+GetEnsemblePartUsage(ensPart, objPtr)
+ EnsemblePart *ensPart; /* ensemble part for usage info */
+ Tcl_Obj *objPtr; /* returns: usage information */
+{
+ EnsemblePart *part;
+ Command *cmdPtr;
+ char *name;
+ Itcl_List trail;
+ Itcl_ListElem *elem;
+ Tcl_DString buffer;
+
+ /*
+ * Build the trail of ensemble names leading to this part.
+ */
+ Tcl_DStringInit(&buffer);
+ Itcl_InitList(&trail);
+ for (part=ensPart; part; part=part->ensemble->parent) {
+ Itcl_InsertList(&trail, (ClientData)part);
+ }
+
+ cmdPtr = (Command*)ensPart->ensemble->cmd;
+ name = Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr);
+ Tcl_DStringAppendElement(&buffer, name);
+
+ for (elem=Itcl_FirstListElem(&trail); elem; elem=Itcl_NextListElem(elem)) {
+ part = (EnsemblePart*)Itcl_GetListValue(elem);
+ Tcl_DStringAppendElement(&buffer, part->name);
+ }
+ Itcl_DeleteList(&trail);
+
+ /*
+ * If the part has usage info, use it directly.
+ */
+ if (ensPart->usage && *ensPart->usage != '\0') {
+ Tcl_DStringAppend(&buffer, " ", 1);
+ Tcl_DStringAppend(&buffer, ensPart->usage, -1);
+ }
+
+ /*
+ * If the part is itself an ensemble, summarize its usage.
+ */
+ else if (ensPart->cmdPtr &&
+ ensPart->cmdPtr->deleteProc == DeleteEnsemble) {
+ Tcl_DStringAppend(&buffer, " option ?arg arg ...?", 21);
+ }
+
+ Tcl_AppendToObj(objPtr, Tcl_DStringValue(&buffer),
+ Tcl_DStringLength(&buffer));
+
+ Tcl_DStringFree(&buffer);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateEnsemble --
+ *
+ * Creates an ensemble command, or adds a sub-ensemble to an
+ * existing ensemble command. Works like Itcl_CreateEnsemble,
+ * except that the ensemble name is a single name, not a path.
+ * If a parent ensemble is specified, then a new ensemble is
+ * added to that parent. If a part already exists with the
+ * same name, it is an error. If a parent ensemble is not
+ * specified, then a top-level ensemble is created. If a
+ * command already exists with the same name, it is deleted.
+ *
+ * Results:
+ * Returns TCL_OK if successful, and TCL_ERROR if anything goes
+ * wrong.
+ *
+ * Side effects:
+ * If an error is encountered, an error is left as the result
+ * in the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+CreateEnsemble(interp, parentEnsData, ensName)
+ Tcl_Interp *interp; /* interpreter to be updated */
+ Ensemble *parentEnsData; /* parent ensemble or NULL */
+ char *ensName; /* name of the new ensemble */
+{
+ Ensemble *ensData;
+ EnsemblePart *ensPart;
+ Command *cmdPtr;
+ Tcl_CmdInfo cmdInfo;
+
+ /*
+ * Create the data associated with the ensemble.
+ */
+ ensData = (Ensemble*)ckalloc(sizeof(Ensemble));
+ ensData->interp = interp;
+ ensData->numParts = 0;
+ ensData->maxParts = 10;
+ ensData->parts = (EnsemblePart**)ckalloc(
+ (unsigned)(ensData->maxParts*sizeof(EnsemblePart*))
+ );
+ ensData->cmd = NULL;
+ ensData->parent = NULL;
+
+ /*
+ * If there is no parent data, then this is a top-level
+ * ensemble. Create the ensemble by installing its access
+ * command.
+ *
+ * BE CAREFUL: Set the string-based proc to the wrapper
+ * procedure TclInvokeObjectCommand. Otherwise, the
+ * ensemble command may fail. For example, it will fail
+ * when invoked as a hidden command.
+ */
+ if (parentEnsData == NULL) {
+ ensData->cmd = Tcl_CreateObjCommand(interp, ensName,
+ HandleEnsemble, (ClientData)ensData, DeleteEnsemble);
+
+ if (Tcl_GetCommandInfo(interp, ensName, &cmdInfo)) {
+ cmdInfo.proc = TclInvokeObjectCommand;
+ Tcl_SetCommandInfo(interp, ensName, &cmdInfo);
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Otherwise, this ensemble is contained within another parent.
+ * Install the new ensemble as a part within its parent.
+ */
+ if (CreateEnsemblePart(interp, parentEnsData, ensName, &ensPart)
+ != TCL_OK) {
+ DeleteEnsemble((ClientData)ensData);
+ return TCL_ERROR;
+ }
+
+ ensData->cmd = parentEnsData->cmd;
+ ensData->parent = ensPart;
+
+ cmdPtr = (Command*)ckalloc(sizeof(Command));
+ cmdPtr->hPtr = NULL;
+ cmdPtr->nsPtr = ((Command*)ensData->cmd)->nsPtr;
+ cmdPtr->refCount = 0;
+ cmdPtr->cmdEpoch = 0;
+ cmdPtr->compileProc = NULL;
+ cmdPtr->objProc = HandleEnsemble;
+ cmdPtr->objClientData = (ClientData)ensData;
+ cmdPtr->proc = NULL;
+ cmdPtr->clientData = NULL;
+ cmdPtr->deleteProc = DeleteEnsemble;
+ cmdPtr->deleteData = cmdPtr->objClientData;
+ cmdPtr->deleted = 0;
+ cmdPtr->importRefPtr = NULL;
+
+ ensPart->cmdPtr = cmdPtr;
+
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AddEnsemblePart --
+ *
+ * Adds a part to an existing ensemble. Works like
+ * Itcl_AddEnsemblePart, but the part name is a single word,
+ * not a path.
+ *
+ * If the ensemble already has a part with the specified name,
+ * this procedure returns an error. Otherwise, it adds a new
+ * part to the ensemble.
+ *
+ * Any client data specified is automatically passed to the
+ * handling procedure whenever the part is invoked. It is
+ * automatically destroyed by the deleteProc when the part is
+ * deleted.
+ *
+ * Results:
+ * Returns TCL_OK if successful, along with a pointer to the
+ * new part. Returns TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ * If an error is encountered, an error is left as the result
+ * in the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+AddEnsemblePart(interp, ensData, partName, usageInfo,
+ objProc, clientData, deleteProc, rVal)
+
+ Tcl_Interp *interp; /* interpreter to be updated */
+ Ensemble* ensData; /* ensemble that will contain this part */
+ char* partName; /* name of the new part */
+ char* usageInfo; /* usage info for argument list */
+ Tcl_ObjCmdProc *objProc; /* handling procedure for part */
+ ClientData clientData; /* client data associated with part */
+ Tcl_CmdDeleteProc *deleteProc; /* procedure used to destroy client data */
+ EnsemblePart **rVal; /* returns: new ensemble part */
+{
+ EnsemblePart *ensPart;
+ Command *cmdPtr;
+
+ /*
+ * Install the new part into the part list.
+ */
+ if (CreateEnsemblePart(interp, ensData, partName, &ensPart) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (usageInfo) {
+ ensPart->usage = ckalloc((unsigned)(strlen(usageInfo)+1));
+ strcpy(ensPart->usage, usageInfo);
+ }
+
+ cmdPtr = (Command*)ckalloc(sizeof(Command));
+ cmdPtr->hPtr = NULL;
+ cmdPtr->nsPtr = ((Command*)ensData->cmd)->nsPtr;
+ cmdPtr->refCount = 0;
+ cmdPtr->cmdEpoch = 0;
+ cmdPtr->compileProc = NULL;
+ cmdPtr->objProc = objProc;
+ cmdPtr->objClientData = (ClientData)clientData;
+ cmdPtr->proc = NULL;
+ cmdPtr->clientData = NULL;
+ cmdPtr->deleteProc = deleteProc;
+ cmdPtr->deleteData = (ClientData)clientData;
+ cmdPtr->deleted = 0;
+ cmdPtr->importRefPtr = NULL;
+
+ ensPart->cmdPtr = cmdPtr;
+ *rVal = ensPart;
+
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteEnsemble --
+ *
+ * Invoked when the command associated with an ensemble is
+ * destroyed, to delete the ensemble. Destroys all parts
+ * included in the ensemble, and frees all memory associated
+ * with it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+DeleteEnsemble(clientData)
+ ClientData clientData; /* ensemble data */
+{
+ Ensemble* ensData = (Ensemble*)clientData;
+
+ /*
+ * BE CAREFUL: Each ensemble part removes itself from the list.
+ * So keep deleting the first part until all parts are gone.
+ */
+ while (ensData->numParts > 0) {
+ DeleteEnsemblePart(ensData->parts[0]);
+ }
+ ckfree((char*)ensData->parts);
+ ckfree((char*)ensData);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindEnsemble --
+ *
+ * Searches for an ensemble command and follows a path to
+ * sub-ensembles.
+ *
+ * Results:
+ * Returns TCL_OK if the ensemble was found, along with a
+ * pointer to the ensemble data in "ensDataPtr". Returns
+ * TCL_ERROR if anything goes wrong.
+ *
+ * Side effects:
+ * If anything goes wrong, this procedure returns an error
+ * message as the result in the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+FindEnsemble(interp, nameArgv, nameArgc, ensDataPtr)
+ Tcl_Interp *interp; /* interpreter containing the ensemble */
+ char **nameArgv; /* path of names leading to ensemble */
+ int nameArgc; /* number of strings in nameArgv */
+ Ensemble** ensDataPtr; /* returns: ensemble data */
+{
+ int i;
+ Command* cmdPtr;
+ Ensemble *ensData;
+ EnsemblePart *ensPart;
+
+ *ensDataPtr = NULL; /* assume that no data will be found */
+
+ /*
+ * If there are no names in the path, then return an error.
+ */
+ if (nameArgc < 1) {
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "invalid ensemble name \"\"", -1);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Use the first name to find the command for the top-level
+ * ensemble.
+ */
+ cmdPtr = (Command*) Tcl_FindCommand(interp, nameArgv[0],
+ (Tcl_Namespace*)NULL, TCL_LEAVE_ERR_MSG);
+
+ if (cmdPtr == NULL || cmdPtr->deleteProc != DeleteEnsemble) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "command \"", nameArgv[0], "\" is not an ensemble",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ ensData = (Ensemble*)cmdPtr->objClientData;
+
+ /*
+ * Follow the trail of sub-ensemble names.
+ */
+ for (i=1; i < nameArgc; i++) {
+ if (FindEnsemblePart(interp, ensData, nameArgv[i], &ensPart)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (ensPart == NULL) {
+ char *pname = Tcl_Merge(i, nameArgv);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "invalid ensemble name \"", pname, "\"",
+ (char*)NULL);
+ ckfree(pname);
+ return TCL_ERROR;
+ }
+
+ cmdPtr = ensPart->cmdPtr;
+ if (cmdPtr == NULL || cmdPtr->deleteProc != DeleteEnsemble) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "part \"", nameArgv[i], "\" is not an ensemble",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ ensData = (Ensemble*)cmdPtr->objClientData;
+ }
+ *ensDataPtr = ensData;
+
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateEnsemblePart --
+ *
+ * Creates a new part within an ensemble.
+ *
+ * Results:
+ * If successful, this procedure returns TCL_OK, along with a
+ * pointer to the new part in "ensPartPtr". If a part with the
+ * same name already exists, this procedure returns TCL_ERROR.
+ *
+ * Side effects:
+ * If anything goes wrong, this procedure returns an error
+ * message as the result in the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+CreateEnsemblePart(interp, ensData, partName, ensPartPtr)
+ Tcl_Interp *interp; /* interpreter containing the ensemble */
+ Ensemble *ensData; /* ensemble being modified */
+ char* partName; /* name of the new part */
+ EnsemblePart **ensPartPtr; /* returns: new ensemble part */
+{
+ int i, pos, size;
+ EnsemblePart** partList;
+ EnsemblePart* part;
+
+ /*
+ * If a matching entry was found, then return an error.
+ */
+ if (FindEnsemblePartIndex(ensData, partName, &pos)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "part \"", partName, "\" already exists in ensemble",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Otherwise, make room for a new entry. Keep the parts in
+ * lexicographical order, so we can search them quickly
+ * later.
+ */
+ if (ensData->numParts >= ensData->maxParts) {
+ size = ensData->maxParts*sizeof(EnsemblePart*);
+ partList = (EnsemblePart**)ckalloc((unsigned)2*size);
+ memcpy((VOID*)partList, (VOID*)ensData->parts, (size_t)size);
+ ckfree((char*)ensData->parts);
+
+ ensData->parts = partList;
+ ensData->maxParts *= 2;
+ }
+
+ for (i=ensData->numParts; i > pos; i--) {
+ ensData->parts[i] = ensData->parts[i-1];
+ }
+ ensData->numParts++;
+
+ part = (EnsemblePart*)ckalloc(sizeof(EnsemblePart));
+ part->name = (char*)ckalloc((unsigned)(strlen(partName)+1));
+ strcpy(part->name, partName);
+ part->cmdPtr = NULL;
+ part->usage = NULL;
+ part->ensemble = ensData;
+
+ ensData->parts[pos] = part;
+
+ /*
+ * Compare the new part against the one on either side of
+ * it. Determine how many letters are needed in each part
+ * to guarantee that an abbreviated form is unique. Update
+ * the parts on either side as well, since they are influenced
+ * by the new part.
+ */
+ ComputeMinChars(ensData, pos);
+ ComputeMinChars(ensData, pos-1);
+ ComputeMinChars(ensData, pos+1);
+
+ *ensPartPtr = part;
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteEnsemblePart --
+ *
+ * Deletes a single part from an ensemble. The part must have
+ * been created previously by CreateEnsemblePart.
+ *
+ * If the part has a delete proc, then it is called to free the
+ * associated client data.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Delete proc is called.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+DeleteEnsemblePart(ensPart)
+ EnsemblePart *ensPart; /* part being destroyed */
+{
+ int i, pos;
+ Command *cmdPtr;
+ Ensemble *ensData;
+ cmdPtr = ensPart->cmdPtr;
+
+ /*
+ * If this part has a delete proc, then call it to free
+ * up the client data.
+ */
+ if (cmdPtr->deleteData && cmdPtr->deleteProc) {
+ (*cmdPtr->deleteProc)(cmdPtr->deleteData);
+ }
+ ckfree((char*)cmdPtr);
+
+ /*
+ * Find this part within its ensemble, and remove it from
+ * the list of parts.
+ */
+ if (FindEnsemblePartIndex(ensPart->ensemble, ensPart->name, &pos)) {
+ ensData = ensPart->ensemble;
+ for (i=pos; i < ensData->numParts-1; i++) {
+ ensData->parts[i] = ensData->parts[i+1];
+ }
+ ensData->numParts--;
+ }
+
+ /*
+ * Free the memory associated with the part.
+ */
+ if (ensPart->usage) {
+ ckfree(ensPart->usage);
+ }
+ ckfree(ensPart->name);
+ ckfree((char*)ensPart);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindEnsemblePart --
+ *
+ * Searches for a part name within an ensemble. Recognizes
+ * unique abbreviations for part names.
+ *
+ * Results:
+ * If the part name is not a unique abbreviation, this procedure
+ * returns TCL_ERROR. Otherwise, it returns TCL_OK. If the
+ * part can be found, "rensPart" returns a pointer to the part.
+ * Otherwise, it returns NULL.
+ *
+ * Side effects:
+ * If anything goes wrong, this procedure returns an error
+ * message as the result in the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+FindEnsemblePart(interp, ensData, partName, rensPart)
+ Tcl_Interp *interp; /* interpreter containing the ensemble */
+ Ensemble *ensData; /* ensemble being searched */
+ char* partName; /* name of the desired part */
+ EnsemblePart **rensPart; /* returns: pointer to the desired part */
+{
+ int pos = 0;
+ int first, last, nlen;
+ int i, cmp;
+
+ *rensPart = NULL;
+
+ /*
+ * Search for the desired part name.
+ * All parts are in lexicographical order, so use a
+ * binary search to find the part quickly. Match only
+ * as many characters as are included in the specified
+ * part name.
+ */
+ first = 0;
+ last = ensData->numParts-1;
+ nlen = strlen(partName);
+
+ while (last >= first) {
+ pos = (first+last)/2;
+ if (*partName == *ensData->parts[pos]->name) {
+ cmp = strncmp(partName, ensData->parts[pos]->name, nlen);
+ if (cmp == 0) {
+ break; /* found it! */
+ }
+ }
+ else if (*partName < *ensData->parts[pos]->name) {
+ cmp = -1;
+ }
+ else {
+ cmp = 1;
+ }
+
+ if (cmp > 0) {
+ first = pos+1;
+ } else {
+ last = pos-1;
+ }
+ }
+
+ /*
+ * If a matching entry could not be found, then quit.
+ */
+ if (last < first) {
+ return TCL_OK;
+ }
+
+ /*
+ * If a matching entry was found, there may be some ambiguity
+ * if the user did not specify enough characters. Find the
+ * top-most match in the list, and see if the part name has
+ * enough characters. If there are two parts like "foo"
+ * and "food", this allows us to match "foo" exactly.
+ */
+ if (nlen < ensData->parts[pos]->minChars) {
+ while (pos > 0) {
+ pos--;
+ if (strncmp(partName, ensData->parts[pos]->name, nlen) != 0) {
+ pos++;
+ break;
+ }
+ }
+ }
+ if (nlen < ensData->parts[pos]->minChars) {
+ Tcl_Obj *resultPtr = Tcl_NewStringObj((char*)NULL, 0);
+
+ Tcl_AppendStringsToObj(resultPtr,
+ "ambiguous option \"", partName, "\": should be one of...",
+ (char*)NULL);
+
+ for (i=pos; i < ensData->numParts; i++) {
+ if (strncmp(partName, ensData->parts[i]->name, nlen) != 0) {
+ break;
+ }
+ Tcl_AppendToObj(resultPtr, "\n ", 3);
+ GetEnsemblePartUsage(ensData->parts[i], resultPtr);
+ }
+ Tcl_SetObjResult(interp, resultPtr);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Found a match. Return the desired part.
+ */
+ *rensPart = ensData->parts[pos];
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindEnsemblePartIndex --
+ *
+ * Searches for a part name within an ensemble. The part name
+ * must be an exact match for an existing part name in the
+ * ensemble. This procedure is useful for managing (i.e.,
+ * creating and deleting) parts in an ensemble.
+ *
+ * Results:
+ * If an exact match is found, this procedure returns
+ * non-zero, along with the index of the part in posPtr.
+ * Otherwise, it returns zero, along with an index in posPtr
+ * indicating where the part should be.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+FindEnsemblePartIndex(ensData, partName, posPtr)
+ Ensemble *ensData; /* ensemble being searched */
+ char *partName; /* name of desired part */
+ int *posPtr; /* returns: index for part */
+{
+ int pos = 0;
+ int first, last;
+ int cmp;
+
+ /*
+ * Search for the desired part name.
+ * All parts are in lexicographical order, so use a
+ * binary search to find the part quickly.
+ */
+ first = 0;
+ last = ensData->numParts-1;
+
+ while (last >= first) {
+ pos = (first+last)/2;
+ if (*partName == *ensData->parts[pos]->name) {
+ cmp = strcmp(partName, ensData->parts[pos]->name);
+ if (cmp == 0) {
+ break; /* found it! */
+ }
+ }
+ else if (*partName < *ensData->parts[pos]->name) {
+ cmp = -1;
+ }
+ else {
+ cmp = 1;
+ }
+
+ if (cmp > 0) {
+ first = pos+1;
+ } else {
+ last = pos-1;
+ }
+ }
+
+ if (last >= first) {
+ *posPtr = pos;
+ return 1;
+ }
+ *posPtr = first;
+ return 0;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeMinChars --
+ *
+ * Compares part names on an ensemble's part list and
+ * determines the minimum number of characters needed for a
+ * unique abbreviation. The parts on either side of a
+ * particular part index are compared. As long as there is
+ * a part on one side or the other, this procedure updates
+ * the parts to have the proper minimum abbreviations.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Updates three parts within the ensemble to remember
+ * the minimum abbreviations.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ComputeMinChars(ensData, pos)
+ Ensemble *ensData; /* ensemble being modified */
+ int pos; /* index of part being updated */
+{
+ int min, max;
+ char *p, *q;
+
+ /*
+ * If the position is invalid, do nothing.
+ */
+ if (pos < 0 || pos >= ensData->numParts) {
+ return;
+ }
+
+ /*
+ * Start by assuming that only the first letter is required
+ * to uniquely identify this part. Then compare the name
+ * against each neighboring part to determine the real minimum.
+ */
+ ensData->parts[pos]->minChars = 1;
+
+ if (pos-1 >= 0) {
+ p = ensData->parts[pos]->name;
+ q = ensData->parts[pos-1]->name;
+ for (min=1; *p == *q && *p != '\0' && *q != '\0'; min++) {
+ p++;
+ q++;
+ }
+ if (min > ensData->parts[pos]->minChars) {
+ ensData->parts[pos]->minChars = min;
+ }
+ }
+
+ if (pos+1 < ensData->numParts) {
+ p = ensData->parts[pos]->name;
+ q = ensData->parts[pos+1]->name;
+ for (min=1; *p == *q && *p != '\0' && *q != '\0'; min++) {
+ p++;
+ q++;
+ }
+ if (min > ensData->parts[pos]->minChars) {
+ ensData->parts[pos]->minChars = min;
+ }
+ }
+
+ max = strlen(ensData->parts[pos]->name);
+ if (ensData->parts[pos]->minChars > max) {
+ ensData->parts[pos]->minChars = max;
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HandleEnsemble --
+ *
+ * Invoked by Tcl whenever the user issues an ensemble-style
+ * command. Handles commands of the form:
+ *
+ * <ensembleName> <partName> ?<arg> <arg>...?
+ *
+ * Looks for the <partName> within the ensemble, and if it
+ * exists, the procedure transfers control to it.
+ *
+ * Results:
+ * Returns TCL_OK if successful, and TCL_ERROR if anything
+ * goes wrong.
+ *
+ * Side effects:
+ * If anything goes wrong, this procedure returns an error
+ * message as the result in the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+HandleEnsemble(clientData, interp, objc, objv)
+ ClientData clientData; /* ensemble data */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ Ensemble *ensData = (Ensemble*)clientData;
+
+ int i, result;
+ Command *cmdPtr;
+ EnsemblePart *ensPart;
+ char *partName;
+ int partNameLen;
+ Tcl_Obj *cmdlinePtr, *chainObj;
+ int cmdlinec;
+ Tcl_Obj **cmdlinev;
+
+ /*
+ * If a part name is not specified, return an error that
+ * summarizes the usage for this ensemble.
+ */
+ if (objc < 2) {
+ Tcl_Obj *resultPtr = Tcl_NewStringObj(
+ "wrong # args: should be one of...\n", -1);
+
+ GetEnsembleUsage(ensData, resultPtr);
+ Tcl_SetObjResult(interp, resultPtr);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Lookup the desired part. If an ambiguous abbrevition is
+ * found, return an error immediately.
+ */
+ partName = Tcl_GetStringFromObj(objv[1], &partNameLen);
+ if (FindEnsemblePart(interp, ensData, partName, &ensPart) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the part was not found, then look for an "@error" part
+ * to handle the error.
+ */
+ if (ensPart == NULL) {
+ if (FindEnsemblePart(interp, ensData, "@error", &ensPart) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (ensPart != NULL) {
+ cmdPtr = (Command*)ensPart->cmdPtr;
+ result = (*cmdPtr->objProc)(cmdPtr->objClientData,
+ interp, objc, objv);
+ return result;
+ }
+ }
+ if (ensPart == NULL) {
+ return Itcl_EnsembleErrorCmd((ClientData)ensData,
+ interp, objc-1, objv+1);
+ }
+
+ /*
+ * Pass control to the part, and return the result.
+ */
+ chainObj = Tcl_NewObj();
+ chainObj->bytes = NULL;
+ chainObj->typePtr = &itclEnsInvocType;
+ chainObj->internalRep.twoPtrValue.ptr1 = (VOID *) ensPart;
+ Tcl_IncrRefCount(objv[1]);
+ chainObj->internalRep.twoPtrValue.ptr2 = (VOID *) objv[0];
+ Tcl_IncrRefCount(objv[0]);
+
+ cmdlinePtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, cmdlinePtr, chainObj);
+ for (i=2; i < objc; i++) {
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, cmdlinePtr, objv[i]);
+ }
+ Tcl_IncrRefCount(cmdlinePtr);
+
+ result = Tcl_ListObjGetElements((Tcl_Interp*)NULL, cmdlinePtr,
+ &cmdlinec, &cmdlinev);
+
+ if (result == TCL_OK) {
+ cmdPtr = (Command*)ensPart->cmdPtr;
+ result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
+ cmdlinec, cmdlinev);
+ }
+ Tcl_DecrRefCount(cmdlinePtr);
+
+ return result;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Itcl_EnsembleCmd --
+ *
+ * Invoked by Tcl whenever the user issues the "ensemble"
+ * command to manipulate an ensemble. Handles the following
+ * syntax:
+ *
+ * ensemble <ensName> ?<command> <arg> <arg>...?
+ * ensemble <ensName> {
+ * part <partName> <args> <body>
+ * ensemble <ensName> {
+ * ...
+ * }
+ * }
+ *
+ * Finds or creates the ensemble <ensName>, and then executes
+ * the commands to add parts.
+ *
+ * Results:
+ * Returns TCL_OK if successful, and TCL_ERROR if anything
+ * goes wrong.
+ *
+ * Side effects:
+ * If anything goes wrong, this procedure returns an error
+ * message as the result in the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+Itcl_EnsembleCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* ensemble data */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int status;
+ char *ensName;
+ EnsembleParser *ensInfo;
+ Ensemble *ensData, *savedEnsData;
+ EnsemblePart *ensPart;
+ Tcl_Command cmd;
+ Command *cmdPtr;
+ Tcl_Obj *objPtr;
+
+ /*
+ * Make sure that an ensemble name was specified.
+ */
+ if (objc < 2) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be \"",
+ Tcl_GetStringFromObj(objv[0], (int*)NULL),
+ " name ?command arg arg...?\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If this is the "ensemble" command in the main interpreter,
+ * then the client data will be null. Otherwise, it is
+ * the "ensemble" command in the ensemble body parser, and
+ * the client data indicates which ensemble we are modifying.
+ */
+ if (clientData) {
+ ensInfo = (EnsembleParser*)clientData;
+ } else {
+ ensInfo = GetEnsembleParser(interp);
+ }
+ ensData = ensInfo->ensData;
+
+ /*
+ * Find or create the desired ensemble. If an ensemble is
+ * being built, then this "ensemble" command is enclosed in
+ * another "ensemble" command. Use the current ensemble as
+ * the parent, and find or create an ensemble part within it.
+ */
+ ensName = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+
+ if (ensData) {
+ if (FindEnsemblePart(interp, ensData, ensName, &ensPart) != TCL_OK) {
+ ensPart = NULL;
+ }
+ if (ensPart == NULL) {
+ if (CreateEnsemble(interp, ensData, ensName) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (FindEnsemblePart(interp, ensData, ensName, &ensPart)
+ != TCL_OK) {
+ panic("Itcl_EnsembleCmd: can't create ensemble");
+ }
+ }
+
+ cmdPtr = (Command*)ensPart->cmdPtr;
+ if (cmdPtr->deleteProc != DeleteEnsemble) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "part \"", Tcl_GetStringFromObj(objv[1], (int*)NULL),
+ "\" is not an ensemble",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ ensData = (Ensemble*)cmdPtr->objClientData;
+ }
+
+ /*
+ * Otherwise, the desired ensemble is a top-level ensemble.
+ * Find or create the access command for the ensemble, and
+ * then get its data.
+ */
+ else {
+ cmd = Tcl_FindCommand(interp, ensName, (Tcl_Namespace*)NULL, 0);
+ if (cmd == NULL) {
+ if (CreateEnsemble(interp, (Ensemble*)NULL, ensName)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ cmd = Tcl_FindCommand(interp, ensName, (Tcl_Namespace*)NULL, 0);
+ }
+ cmdPtr = (Command*)cmd;
+
+ if (cmdPtr == NULL || cmdPtr->deleteProc != DeleteEnsemble) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "command \"", Tcl_GetStringFromObj(objv[1], (int*)NULL),
+ "\" is not an ensemble",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ ensData = (Ensemble*)cmdPtr->objClientData;
+ }
+
+ /*
+ * At this point, we have the data for the ensemble that is
+ * being manipulated. Plug this into the parser, and then
+ * interpret the rest of the arguments in the ensemble parser.
+ */
+ status = TCL_OK;
+ savedEnsData = ensInfo->ensData;
+ ensInfo->ensData = ensData;
+
+ if (objc == 3) {
+ /* CYGNUS LOCAL - fix for Tcl8.1 */
+#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ status = Tcl_EvalObj(ensInfo->parser, objv[2]);
+#else
+ status = Tcl_EvalObj(ensInfo->parser, objv[2], 0);
+#endif
+ }
+ else if (objc > 3) {
+ objPtr = Tcl_NewListObj(objc-2, objv+2);
+#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ status = Tcl_EvalObj(ensInfo->parser, objPtr);
+#else
+ Tcl_IncrRefCount(objPtr);
+ status = Tcl_EvalObj(ensInfo->parser, objPtr, 0);
+#endif
+ /* END CYGNUS LOCAL */
+ Tcl_DecrRefCount(objPtr); /* we're done with the object */
+ }
+
+ /*
+ * Copy the result from the parser interpreter to the
+ * master interpreter. If an error was encountered,
+ * copy the error info first, and then set the result.
+ * Otherwise, the offending command is reported twice.
+ */
+ if (status == TCL_ERROR) {
+ char *errInfo = Tcl_GetVar2(ensInfo->parser, "::errorInfo",
+ (char*)NULL, TCL_GLOBAL_ONLY);
+
+ if (errInfo) {
+ Tcl_AddObjErrorInfo(interp, errInfo, -1);
+ }
+
+ if (objc == 3) {
+ char msg[128];
+ sprintf(msg, "\n (\"ensemble\" body line %d)",
+ ensInfo->parser->errorLine);
+ Tcl_AddObjErrorInfo(interp, msg, -1);
+ }
+ }
+ Tcl_SetObjResult(interp, Tcl_GetObjResult(ensInfo->parser));
+
+ ensInfo->ensData = savedEnsData;
+ return status;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetEnsembleParser --
+ *
+ * Returns the slave interpreter that acts as a parser for
+ * the body of an "ensemble" definition. The first time that
+ * this is called for an interpreter, the parser is created
+ * and registered as associated data. After that, it is
+ * simply returned.
+ *
+ * Results:
+ * Returns a pointer to the ensemble parser data structure.
+ *
+ * Side effects:
+ * On the first call, the ensemble parser is created and
+ * registered as "itcl_ensembleParser" with the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+static EnsembleParser*
+GetEnsembleParser(interp)
+ Tcl_Interp *interp; /* interpreter handling the ensemble */
+{
+ Namespace *nsPtr;
+ Tcl_Namespace *childNs;
+ EnsembleParser *ensInfo;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ Tcl_Command cmd;
+
+ /*
+ * Look for an existing ensemble parser. If it is found,
+ * return it immediately.
+ */
+ ensInfo = (EnsembleParser*) Tcl_GetAssocData(interp,
+ "itcl_ensembleParser", NULL);
+
+ if (ensInfo) {
+ return ensInfo;
+ }
+
+ /*
+ * Create a slave interpreter that can be used to parse
+ * the body of an ensemble definition.
+ */
+ ensInfo = (EnsembleParser*)ckalloc(sizeof(EnsembleParser));
+ ensInfo->master = interp;
+ ensInfo->parser = Tcl_CreateInterp();
+ ensInfo->ensData = NULL;
+
+ /*
+ * Remove all namespaces and all normal commands from the
+ * parser interpreter.
+ */
+ nsPtr = (Namespace*)Tcl_GetGlobalNamespace(ensInfo->parser);
+
+ for (hPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search);
+ hPtr != NULL;
+ hPtr = Tcl_FirstHashEntry(&nsPtr->childTable, &search)) {
+
+ childNs = (Tcl_Namespace*)Tcl_GetHashValue(hPtr);
+ Tcl_DeleteNamespace(childNs);
+ }
+
+ for (hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search);
+ hPtr != NULL;
+ hPtr = Tcl_FirstHashEntry(&nsPtr->cmdTable, &search)) {
+
+ cmd = (Tcl_Command)Tcl_GetHashValue(hPtr);
+ Tcl_DeleteCommandFromToken(ensInfo->parser, cmd);
+ }
+
+ /*
+ * Add the allowed commands to the parser interpreter:
+ * part, delete, ensemble
+ */
+ Tcl_CreateObjCommand(ensInfo->parser, "part", Itcl_EnsPartCmd,
+ (ClientData)ensInfo, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(ensInfo->parser, "option", Itcl_EnsPartCmd,
+ (ClientData)ensInfo, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(ensInfo->parser, "ensemble", Itcl_EnsembleCmd,
+ (ClientData)ensInfo, (Tcl_CmdDeleteProc*)NULL);
+
+ /*
+ * Install the parser data, so we'll have it the next time
+ * we call this procedure.
+ */
+ (void) Tcl_SetAssocData(interp, "itcl_ensembleParser",
+ DeleteEnsParser, (ClientData)ensInfo);
+
+ return ensInfo;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteEnsParser --
+ *
+ * Called when an interpreter is destroyed to clean up the
+ * ensemble parser within it. Destroys the slave interpreter
+ * and frees up the data associated with it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+ /* ARGSUSED */
+static void
+DeleteEnsParser(clientData, interp)
+ ClientData clientData; /* client data for ensemble-related commands */
+ Tcl_Interp *interp; /* interpreter containing the data */
+{
+ EnsembleParser* ensInfo = (EnsembleParser*)clientData;
+ Tcl_DeleteInterp(ensInfo->parser);
+ ckfree((char*)ensInfo);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Itcl_EnsPartCmd --
+ *
+ * Invoked by Tcl whenever the user issues the "part" command
+ * to manipulate an ensemble. This command can only be used
+ * inside the "ensemble" command, which handles ensembles.
+ * Handles the following syntax:
+ *
+ * ensemble <ensName> {
+ * part <partName> <args> <body>
+ * }
+ *
+ * Adds a new part called <partName> to the ensemble. If a
+ * part already exists with that name, it is an error. The
+ * new part is handled just like an ordinary Tcl proc, with
+ * a list of <args> and a <body> of code to execute.
+ *
+ * Results:
+ * Returns TCL_OK if successful, and TCL_ERROR if anything
+ * goes wrong.
+ *
+ * Side effects:
+ * If anything goes wrong, this procedure returns an error
+ * message as the result in the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+Itcl_EnsPartCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* ensemble data */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ EnsembleParser *ensInfo = (EnsembleParser*)clientData;
+ Ensemble *ensData = (Ensemble*)ensInfo->ensData;
+
+ int status, varArgs, space;
+ char *partName, *usage;
+ Proc *procPtr;
+ Command *cmdPtr;
+ CompiledLocal *localPtr;
+ EnsemblePart *ensPart;
+ Tcl_DString buffer;
+
+ if (objc != 4) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be \"",
+ Tcl_GetStringFromObj(objv[0], (int*)NULL),
+ " name args body\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create a Tcl-style proc definition using the specified args
+ * and body. This is not a proc in the usual sense. It belongs
+ * to the namespace that contains the ensemble, but it is
+ * accessed through the ensemble, not through a Tcl command.
+ */
+ partName = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ cmdPtr = (Command*)ensData->cmd;
+
+ if (TclCreateProc(interp, cmdPtr->nsPtr, partName, objv[2], objv[3],
+ &procPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Deduce the usage information from the argument list.
+ * We'll register this when we create the part, in a moment.
+ */
+ Tcl_DStringInit(&buffer);
+ varArgs = 0;
+ space = 0;
+
+ for (localPtr=procPtr->firstLocalPtr;
+ localPtr != NULL;
+ localPtr=localPtr->nextPtr) {
+
+ if (TclIsVarArgument(localPtr)) {
+ varArgs = 0;
+ if (strcmp(localPtr->name, "args") == 0) {
+ varArgs = 1;
+ }
+ else if (localPtr->defValuePtr) {
+ if (space) {
+ Tcl_DStringAppend(&buffer, " ", 1);
+ }
+ Tcl_DStringAppend(&buffer, "?", 1);
+ Tcl_DStringAppend(&buffer, localPtr->name, -1);
+ Tcl_DStringAppend(&buffer, "?", 1);
+ space = 1;
+ }
+ else {
+ if (space) {
+ Tcl_DStringAppend(&buffer, " ", 1);
+ }
+ Tcl_DStringAppend(&buffer, localPtr->name, -1);
+ space = 1;
+ }
+ }
+ }
+ if (varArgs) {
+ if (space) {
+ Tcl_DStringAppend(&buffer, " ", 1);
+ }
+ Tcl_DStringAppend(&buffer, "?arg arg ...?", 13);
+ }
+
+ usage = Tcl_DStringValue(&buffer);
+
+ /*
+ * Create a new part within the ensemble. If successful,
+ * plug the command token into the proc; we'll need it later
+ * if we try to compile the Tcl code for the part. If
+ * anything goes wrong, clean up before bailing out.
+ */
+ status = AddEnsemblePart(interp, ensData, partName, usage,
+ TclObjInterpProc, (ClientData)procPtr, TclProcDeleteProc,
+ &ensPart);
+
+ if (status == TCL_OK) {
+ procPtr->cmdPtr = ensPart->cmdPtr;
+ } else {
+ TclProcDeleteProc((ClientData)procPtr);
+ }
+ Tcl_DStringFree(&buffer);
+
+ return status;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Itcl_EnsembleErrorCmd --
+ *
+ * Invoked when the user tries to access an unknown part for
+ * an ensemble. Acts as the default handler for the "@error"
+ * part. Generates an error message like:
+ *
+ * bad option "foo": should be one of...
+ * info args procname
+ * info body procname
+ * info cmdcount
+ * ...
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * Returns the error message as the result in the interpreter.
+ *
+ *----------------------------------------------------------------------
+ */
+ /* ARGSUSED */
+int
+Itcl_EnsembleErrorCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* ensemble info */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ Ensemble *ensData = (Ensemble*)clientData;
+
+ char *cmdName;
+ Tcl_Obj *objPtr;
+
+ cmdName = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+
+ objPtr = Tcl_NewStringObj((char*)NULL, 0);
+ Tcl_AppendStringsToObj(objPtr,
+ "bad option \"", cmdName, "\": should be one of...\n",
+ (char*)NULL);
+ GetEnsembleUsage(ensData, objPtr);
+
+ Tcl_SetObjResult(interp, objPtr);
+ return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeEnsInvocInternalRep --
+ *
+ * Frees the resources associated with an ensembleInvoc object's
+ * internal representation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Decrements the ref count of the two objects referenced by
+ * this object. If there are no more uses, this will free
+ * the other objects.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+FreeEnsInvocInternalRep(objPtr)
+ register Tcl_Obj *objPtr; /* namespName object with internal
+ * representation to free */
+{
+ Tcl_Obj *prevArgObj = (Tcl_Obj*)objPtr->internalRep.twoPtrValue.ptr2;
+
+ if (prevArgObj) {
+ Tcl_DecrRefCount(prevArgObj);
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DupEnsInvocInternalRep --
+ *
+ * Initializes the internal representation of an ensembleInvoc
+ * object to a copy of the internal representation of
+ * another ensembleInvoc object.
+ *
+ * This shouldn't be called. Normally, a temporary ensembleInvoc
+ * object is created while an ensemble call is in progress.
+ * This object may be converted to string form if an error occurs.
+ * It does not stay around long, and there is no reason for it
+ * to be duplicated.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * copyPtr's internal rep is set to duplicates of the objects
+ * pointed to by srcPtr's internal rep.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+DupEnsInvocInternalRep(srcPtr, copyPtr)
+ Tcl_Obj *srcPtr; /* Object with internal rep to copy. */
+ register Tcl_Obj *copyPtr; /* Object with internal rep to set. */
+{
+ EnsemblePart *ensPart = (EnsemblePart*)srcPtr->internalRep.twoPtrValue.ptr1;
+ Tcl_Obj *prevArgObj = (Tcl_Obj*)srcPtr->internalRep.twoPtrValue.ptr2;
+ Tcl_Obj *objPtr;
+
+ copyPtr->internalRep.twoPtrValue.ptr1 = (VOID *) ensPart;
+
+ if (prevArgObj) {
+ objPtr = Tcl_DuplicateObj(prevArgObj);
+ copyPtr->internalRep.twoPtrValue.ptr2 = (VOID *) objPtr;
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetEnsInvocFromAny --
+ *
+ * Generates the internal representation for an ensembleInvoc
+ * object. This conversion really shouldn't take place.
+ * Normally, a temporary ensembleInvoc object is created while
+ * an ensemble call is in progress. This object may be converted
+ * to string form if an error occurs. But there is no reason
+ * for any other object to be converted to ensembleInvoc form.
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * The string representation is saved as if it were the
+ * command line argument for the ensemble invocation. The
+ * reference to the ensemble part is set to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+SetEnsInvocFromAny(interp, objPtr)
+ Tcl_Interp *interp; /* Determines the context for
+ name resolution */
+ register Tcl_Obj *objPtr; /* The object to convert */
+{
+ int length;
+ char *name;
+ Tcl_Obj *argObj;
+
+ /*
+ * Get objPtr's string representation.
+ * Make it up-to-date if necessary.
+ * THIS FAILS IF THE OBJECT'S STRING REP CONTAINS NULLS.
+ */
+ name = Tcl_GetStringFromObj(objPtr, &length);
+
+ /*
+ * Make an argument object to contain the string, and
+ * set the ensemble part definition to NULL. At this point,
+ * we don't know anything about an ensemble, so we'll just
+ * keep the string around as if it were the command line
+ * invocation.
+ */
+ argObj = Tcl_NewStringObj(name, -1);
+
+ /*
+ * Free the old representation and install a new one.
+ */
+ if (objPtr->typePtr && objPtr->typePtr->freeIntRepProc != NULL) {
+ (*objPtr->typePtr->freeIntRepProc)(objPtr);
+ }
+ objPtr->internalRep.twoPtrValue.ptr1 = (VOID *) NULL;
+ objPtr->internalRep.twoPtrValue.ptr2 = (VOID *) argObj;
+ objPtr->typePtr = &itclEnsInvocType;
+
+ return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateStringOfEnsInvoc --
+ *
+ * Updates the string representation for an ensembleInvoc object.
+ * This is called when an error occurs in an ensemble part, when
+ * the code tries to print objv[0] as the command name. This
+ * code automatically chains together all of the names leading
+ * to the ensemble part, so the error message references the
+ * entire command, not just the part name.
+ *
+ * Note: This procedure does not free an existing old string rep
+ * so storage will be lost if this has not already been done.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The object's string is set to the full command name for
+ * the ensemble part.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+UpdateStringOfEnsInvoc(objPtr)
+ register Tcl_Obj *objPtr; /* NamespName obj to update string rep. */
+{
+ EnsemblePart *ensPart = (EnsemblePart*)objPtr->internalRep.twoPtrValue.ptr1;
+ Tcl_Obj *prevArgObj = (Tcl_Obj*)objPtr->internalRep.twoPtrValue.ptr2;
+
+ Tcl_DString buffer;
+ int length;
+ char *name;
+
+ Tcl_DStringInit(&buffer);
+
+ /*
+ * Get the string representation for the previous argument.
+ * This will force each ensembleInvoc argument up the line
+ * to get its string representation. So we will get the
+ * original command name, followed by the sub-ensemble, and
+ * the next sub-ensemble, and so on. Then add the part
+ * name from the ensPart argument.
+ */
+ if (prevArgObj) {
+ name = Tcl_GetStringFromObj(prevArgObj, &length);
+ Tcl_DStringAppend(&buffer, name, length);
+ }
+
+ if (ensPart) {
+ Tcl_DStringAppendElement(&buffer, ensPart->name);
+ }
+
+ /*
+ * The following allocates an empty string on the heap if name is ""
+ * (e.g., if the internal rep is NULL).
+ */
+ name = Tcl_DStringValue(&buffer);
+ length = strlen(name);
+ objPtr->bytes = (char *) ckalloc((unsigned) (length + 1));
+ memcpy((VOID *) objPtr->bytes, (VOID *) name, (unsigned) length);
+ objPtr->bytes[length] = '\0';
+ objPtr->length = length;
+}
diff --git a/itcl/itcl/generic/itcl_linkage.c b/itcl/itcl/generic/itcl_linkage.c
new file mode 100644
index 00000000000..7ad678e92d6
--- /dev/null
+++ b/itcl/itcl/generic/itcl_linkage.c
@@ -0,0 +1,327 @@
+/*
+ * ------------------------------------------------------------------------
+ * PACKAGE: [incr Tcl]
+ * DESCRIPTION: Object-Oriented Extensions to Tcl
+ *
+ * [incr Tcl] provides object-oriented extensions to Tcl, much as
+ * C++ provides object-oriented extensions to C. It provides a means
+ * of encapsulating related procedures together with their shared data
+ * in a local namespace that is hidden from the outside world. It
+ * promotes code re-use through inheritance. More than anything else,
+ * it encourages better organization of Tcl applications through the
+ * object-oriented paradigm, leading to code that is easier to
+ * understand and maintain.
+ *
+ * This part adds a mechanism for integrating C procedures into
+ * [incr Tcl] classes as methods and procs. Each C procedure must
+ * either be declared via Itcl_RegisterC() or dynamically loaded.
+ *
+ * ========================================================================
+ * AUTHOR: Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ * http://www.tcltk.com/itcl
+ *
+ * RCS: $Id$
+ * ========================================================================
+ * Copyright (c) 1993-1998 Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#include "itclInt.h"
+
+/*
+ * These records store the pointers for all "RegisterC" functions.
+ */
+typedef struct ItclCfunc {
+ Tcl_CmdProc *argCmdProc; /* old-style (argc,argv) command handler */
+ Tcl_ObjCmdProc *objCmdProc; /* new (objc,objv) command handler */
+ ClientData clientData; /* client data passed into this function */
+ Tcl_CmdDeleteProc *deleteProc; /* proc called to free clientData */
+} ItclCfunc;
+
+static Tcl_HashTable* ItclGetRegisteredProcs _ANSI_ARGS_((Tcl_Interp *interp));
+static void ItclFreeC _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp));
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_RegisterC()
+ *
+ * Used to associate a symbolic name with an (argc,argv) C procedure
+ * that handles a Tcl command. Procedures that are registered in this
+ * manner can be referenced in the body of an [incr Tcl] class
+ * definition to specify C procedures to acting as methods/procs.
+ * Usually invoked in an initialization routine for an extension,
+ * called out in Tcl_AppInit() at the start of an application.
+ *
+ * Each symbolic procedure can have an arbitrary client data value
+ * associated with it. This value is passed into the command
+ * handler whenever it is invoked.
+ *
+ * A symbolic procedure name can be used only once for a given style
+ * (arg/obj) handler. If the name is defined with an arg-style
+ * handler, it can be redefined with an obj-style handler; or if
+ * the name is defined with an obj-style handler, it can be redefined
+ * with an arg-style handler. In either case, any previous client
+ * data is discarded and the new client data is remembered. However,
+ * if a name is redefined to a different handler of the same style,
+ * this procedure returns an error.
+ *
+ * Returns TCL_OK on success, or TCL_ERROR (along with an error message
+ * in interp->result) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_RegisterC(interp, name, proc, clientData, deleteProc)
+ Tcl_Interp *interp; /* interpreter handling this registration */
+ char *name; /* symbolic name for procedure */
+ Tcl_CmdProc *proc; /* procedure handling Tcl command */
+ ClientData clientData; /* client data associated with proc */
+ Tcl_CmdDeleteProc *deleteProc; /* proc called to free up client data */
+{
+ int newEntry;
+ Tcl_HashEntry *entry;
+ Tcl_HashTable *procTable;
+ ItclCfunc *cfunc;
+
+ /*
+ * Make sure that a proc was specified.
+ */
+ if (!proc) {
+ Tcl_AppendResult(interp, "initialization error: null pointer for ",
+ "C procedure \"", name, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Add a new entry for the given procedure. If an entry with
+ * this name already exists, then make sure that it was defined
+ * with the same proc.
+ */
+ procTable = ItclGetRegisteredProcs(interp);
+ entry = Tcl_CreateHashEntry(procTable, name, &newEntry);
+ if (!newEntry) {
+ cfunc = (ItclCfunc*)Tcl_GetHashValue(entry);
+ if (cfunc->argCmdProc != NULL && cfunc->argCmdProc != proc) {
+ Tcl_AppendResult(interp, "initialization error: C procedure ",
+ "with name \"", name, "\" already defined",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ if (cfunc->deleteProc != NULL) {
+ (*cfunc->deleteProc)(cfunc->clientData);
+ }
+ }
+ else {
+ cfunc = (ItclCfunc*)ckalloc(sizeof(ItclCfunc));
+ cfunc->objCmdProc = NULL;
+ }
+
+ cfunc->argCmdProc = proc;
+ cfunc->clientData = clientData;
+ cfunc->deleteProc = deleteProc;
+
+ Tcl_SetHashValue(entry, (ClientData)cfunc);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_RegisterObjC()
+ *
+ * Used to associate a symbolic name with an (objc,objv) C procedure
+ * that handles a Tcl command. Procedures that are registered in this
+ * manner can be referenced in the body of an [incr Tcl] class
+ * definition to specify C procedures to acting as methods/procs.
+ * Usually invoked in an initialization routine for an extension,
+ * called out in Tcl_AppInit() at the start of an application.
+ *
+ * Each symbolic procedure can have an arbitrary client data value
+ * associated with it. This value is passed into the command
+ * handler whenever it is invoked.
+ *
+ * A symbolic procedure name can be used only once for a given style
+ * (arg/obj) handler. If the name is defined with an arg-style
+ * handler, it can be redefined with an obj-style handler; or if
+ * the name is defined with an obj-style handler, it can be redefined
+ * with an arg-style handler. In either case, any previous client
+ * data is discarded and the new client data is remembered. However,
+ * if a name is redefined to a different handler of the same style,
+ * this procedure returns an error.
+ *
+ * Returns TCL_OK on success, or TCL_ERROR (along with an error message
+ * in interp->result) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_RegisterObjC(interp, name, proc, clientData, deleteProc)
+ Tcl_Interp *interp; /* interpreter handling this registration */
+ char *name; /* symbolic name for procedure */
+ Tcl_ObjCmdProc *proc; /* procedure handling Tcl command */
+ ClientData clientData; /* client data associated with proc */
+ Tcl_CmdDeleteProc *deleteProc; /* proc called to free up client data */
+{
+ int newEntry;
+ Tcl_HashEntry *entry;
+ Tcl_HashTable *procTable;
+ ItclCfunc *cfunc;
+
+ /*
+ * Make sure that a proc was specified.
+ */
+ if (!proc) {
+ Tcl_AppendResult(interp, "initialization error: null pointer for ",
+ "C procedure \"", name, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Add a new entry for the given procedure. If an entry with
+ * this name already exists, then make sure that it was defined
+ * with the same proc.
+ */
+ procTable = ItclGetRegisteredProcs(interp);
+ entry = Tcl_CreateHashEntry(procTable, name, &newEntry);
+ if (!newEntry) {
+ cfunc = (ItclCfunc*)Tcl_GetHashValue(entry);
+ if (cfunc->objCmdProc != NULL && cfunc->objCmdProc != proc) {
+ Tcl_AppendResult(interp, "initialization error: C procedure ",
+ "with name \"", name, "\" already defined",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ if (cfunc->deleteProc != NULL) {
+ (*cfunc->deleteProc)(cfunc->clientData);
+ }
+ }
+ else {
+ cfunc = (ItclCfunc*)ckalloc(sizeof(ItclCfunc));
+ cfunc->argCmdProc = NULL;
+ }
+
+ cfunc->objCmdProc = proc;
+ cfunc->clientData = clientData;
+ cfunc->deleteProc = deleteProc;
+
+ Tcl_SetHashValue(entry, (ClientData)cfunc);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_FindC()
+ *
+ * Used to query a C procedure via its symbolic name. Looks at the
+ * list of procedures registered previously by either Itcl_RegisterC
+ * or Itcl_RegisterObjC and returns pointers to the appropriate
+ * (argc,argv) or (objc,objv) handlers. Returns non-zero if the
+ * name is recognized and pointers are returned; returns zero
+ * otherwise.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_FindC(interp, name, argProcPtr, objProcPtr, cDataPtr)
+ Tcl_Interp *interp; /* interpreter handling this registration */
+ char *name; /* symbolic name for procedure */
+ Tcl_CmdProc **argProcPtr; /* returns (argc,argv) command handler */
+ Tcl_ObjCmdProc **objProcPtr; /* returns (objc,objv) command handler */
+ ClientData *cDataPtr; /* returns client data */
+{
+ Tcl_HashEntry *entry;
+ Tcl_HashTable *procTable;
+ ItclCfunc *cfunc;
+
+ *argProcPtr = NULL; /* assume info won't be found */
+ *objProcPtr = NULL;
+ *cDataPtr = NULL;
+
+ if (interp) {
+ procTable = (Tcl_HashTable*)Tcl_GetAssocData(interp,
+ "itcl_RegC", (Tcl_InterpDeleteProc**)NULL);
+
+ if (procTable) {
+ entry = Tcl_FindHashEntry(procTable, name);
+ if (entry) {
+ cfunc = (ItclCfunc*)Tcl_GetHashValue(entry);
+ *argProcPtr = cfunc->argCmdProc;
+ *objProcPtr = cfunc->objCmdProc;
+ *cDataPtr = cfunc->clientData;
+ }
+ }
+ }
+ return (*argProcPtr != NULL || *objProcPtr != NULL);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclGetRegisteredProcs()
+ *
+ * Returns a pointer to a hash table containing the list of registered
+ * procs in the specified interpreter. If the hash table does not
+ * already exist, it is created.
+ * ------------------------------------------------------------------------
+ */
+static Tcl_HashTable*
+ItclGetRegisteredProcs(interp)
+ Tcl_Interp *interp; /* interpreter handling this registration */
+{
+ Tcl_HashTable* procTable;
+
+ /*
+ * If the registration table does not yet exist, then create it.
+ */
+ procTable = (Tcl_HashTable*)Tcl_GetAssocData(interp, "itcl_RegC",
+ (Tcl_InterpDeleteProc**)NULL);
+
+ if (!procTable) {
+ procTable = (Tcl_HashTable*)ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(procTable, TCL_STRING_KEYS);
+ Tcl_SetAssocData(interp, "itcl_RegC", ItclFreeC,
+ (ClientData)procTable);
+ }
+ return procTable;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclFreeC()
+ *
+ * When an interpreter is deleted, this procedure is called to
+ * free up the associated data created by Itcl_RegisterC and
+ * Itcl_RegisterObjC.
+ * ------------------------------------------------------------------------
+ */
+static void
+ItclFreeC(clientData, interp)
+ ClientData clientData; /* associated data */
+ Tcl_Interp *interp; /* intepreter being deleted */
+{
+ Tcl_HashTable *tablePtr = (Tcl_HashTable*)clientData;
+ Tcl_HashSearch place;
+ Tcl_HashEntry *entry;
+ ItclCfunc *cfunc;
+
+ entry = Tcl_FirstHashEntry(tablePtr, &place);
+ while (entry) {
+ cfunc = (ItclCfunc*)Tcl_GetHashValue(entry);
+
+ if (cfunc->deleteProc != NULL) {
+ (*cfunc->deleteProc)(cfunc->clientData);
+ }
+ ckfree ( (char*)cfunc );
+ entry = Tcl_NextHashEntry(&place);
+ }
+
+ Tcl_DeleteHashTable(tablePtr);
+ ckfree((char*)tablePtr);
+}
diff --git a/itcl/itcl/generic/itcl_methods.c b/itcl/itcl/generic/itcl_methods.c
new file mode 100644
index 00000000000..06e6e65e316
--- /dev/null
+++ b/itcl/itcl/generic/itcl_methods.c
@@ -0,0 +1,2557 @@
+/*
+ * ------------------------------------------------------------------------
+ * PACKAGE: [incr Tcl]
+ * DESCRIPTION: Object-Oriented Extensions to Tcl
+ *
+ * [incr Tcl] provides object-oriented extensions to Tcl, much as
+ * C++ provides object-oriented extensions to C. It provides a means
+ * of encapsulating related procedures together with their shared data
+ * in a local namespace that is hidden from the outside world. It
+ * promotes code re-use through inheritance. More than anything else,
+ * it encourages better organization of Tcl applications through the
+ * object-oriented paradigm, leading to code that is easier to
+ * understand and maintain.
+ *
+ * These procedures handle commands available within a class scope.
+ * In [incr Tcl], the term "method" is used for a procedure that has
+ * access to object-specific data, while the term "proc" is used for
+ * a procedure that has access only to common class data.
+ *
+ * ========================================================================
+ * AUTHOR: Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ * http://www.tcltk.com/itcl
+ *
+ * RCS: $Id$
+ * ========================================================================
+ * Copyright (c) 1993-1998 Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#include "itclInt.h"
+#include "tclCompile.h"
+
+/* CYGNUS LOCAL */
+/* FIXME - it looks like Michael removed the dependance on these... */
+#if 0
+#ifdef __CYGWIN32__
+
+/* On cygwin32, this is how we import these variables from the Tcl DLL. */
+
+extern int *_imp__tclTraceCompile;
+
+#define tclTraceCompile (*_imp__tclTraceCompile)
+
+extern int *_imp__tclTraceExec;
+
+#define tclTraceExec (*_imp__tclTraceExec)
+
+extern Tcl_ObjType *_imp__tclByteCodeType;
+
+#define tclByteCodeType (*_imp__tclByteCodeType)
+
+#endif
+#endif
+/* END CYGNUS LOCAL */
+
+/*
+ * FORWARD DECLARATIONS
+ */
+static int ItclParseConfig _ANSI_ARGS_((Tcl_Interp *interp,
+ int objc, Tcl_Obj *CONST objv[], ItclObject *contextObj,
+ int *rargc, ItclVarDefn ***rvars, char ***rvals));
+
+static int ItclHandleConfig _ANSI_ARGS_((Tcl_Interp *interp,
+ int argc, ItclVarDefn **vars, char **vals, ItclObject *contextObj));
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_BodyCmd()
+ *
+ * Invoked by Tcl whenever the user issues an "itcl::body" command to
+ * define or redefine the implementation for a class method/proc.
+ * Handles the following syntax:
+ *
+ * itcl::body <class>::<func> <arglist> <body>
+ *
+ * Looks for an existing class member function with the name <func>,
+ * and if found, tries to assign the implementation. If an argument
+ * list was specified in the original declaration, it must match
+ * <arglist> or an error is flagged. If <body> has the form "@name"
+ * then it is treated as a reference to a C handling procedure;
+ * otherwise, it is taken as a body of Tcl statements.
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_BodyCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* unused */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int status = TCL_OK;
+
+ char *head, *tail, *token, *arglist, *body;
+ ItclClass *cdefn;
+ ItclMemberFunc *mfunc;
+ Tcl_HashEntry *entry;
+ Tcl_DString buffer;
+
+ if (objc != 4) {
+ token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be \"",
+ token, " class::func arglist body\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the member name "namesp::namesp::class::func".
+ * Make sure that a class name was specified, and that the
+ * class exists.
+ */
+ token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ Itcl_ParseNamespPath(token, &buffer, &head, &tail);
+
+ if (!head || *head == '\0') {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "missing class specifier for body declaration \"", token, "\"",
+ (char*)NULL);
+ status = TCL_ERROR;
+ goto bodyCmdDone;
+ }
+
+ cdefn = Itcl_FindClass(interp, head, /* autoload */ 1);
+ if (cdefn == NULL) {
+ status = TCL_ERROR;
+ goto bodyCmdDone;
+ }
+
+ /*
+ * Find the function and try to change its implementation.
+ * Note that command resolution table contains *all* functions,
+ * even those in a base class. Make sure that the class
+ * containing the method definition is the requested class.
+ */
+ if (objc != 4) {
+ token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be \"",
+ token, " class::func arglist body\"",
+ (char*)NULL);
+ status = TCL_ERROR;
+ goto bodyCmdDone;
+ }
+
+ mfunc = NULL;
+ entry = Tcl_FindHashEntry(&cdefn->resolveCmds, tail);
+ if (entry) {
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+ if (mfunc->member->classDefn != cdefn) {
+ mfunc = NULL;
+ }
+ }
+
+ if (mfunc == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "function \"", tail, "\" is not defined in class \"",
+ cdefn->fullname, "\"",
+ (char*)NULL);
+ status = TCL_ERROR;
+ goto bodyCmdDone;
+ }
+
+ arglist = Tcl_GetStringFromObj(objv[2], (int*)NULL);
+ body = Tcl_GetStringFromObj(objv[3], (int*)NULL);
+
+ if (Itcl_ChangeMemberFunc(interp, mfunc, arglist, body) != TCL_OK) {
+ status = TCL_ERROR;
+ goto bodyCmdDone;
+ }
+
+bodyCmdDone:
+ Tcl_DStringFree(&buffer);
+ return status;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ConfigBodyCmd()
+ *
+ * Invoked by Tcl whenever the user issues an "itcl::configbody" command
+ * to define or redefine the configuration code associated with a
+ * public variable. Handles the following syntax:
+ *
+ * itcl::configbody <class>::<publicVar> <body>
+ *
+ * Looks for an existing public variable with the name <publicVar>,
+ * and if found, tries to assign the implementation. If <body> has
+ * the form "@name" then it is treated as a reference to a C handling
+ * procedure; otherwise, it is taken as a body of Tcl statements.
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_ConfigBodyCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* unused */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int status = TCL_OK;
+
+ char *head, *tail, *token;
+ Tcl_DString buffer;
+ ItclClass *cdefn;
+ ItclVarLookup *vlookup;
+ ItclMember *member;
+ ItclMemberCode *mcode;
+ Tcl_HashEntry *entry;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "class::option body");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the member name "namesp::namesp::class::option".
+ * Make sure that a class name was specified, and that the
+ * class exists.
+ */
+ token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ Itcl_ParseNamespPath(token, &buffer, &head, &tail);
+
+ if (!head || *head == '\0') {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "missing class specifier for body declaration \"", token, "\"",
+ (char*)NULL);
+ status = TCL_ERROR;
+ goto configBodyCmdDone;
+ }
+
+ cdefn = Itcl_FindClass(interp, head, /* autoload */ 1);
+ if (cdefn == NULL) {
+ status = TCL_ERROR;
+ goto configBodyCmdDone;
+ }
+
+ /*
+ * Find the variable and change its implementation.
+ * Note that variable resolution table has *all* variables,
+ * even those in a base class. Make sure that the class
+ * containing the variable definition is the requested class.
+ */
+ vlookup = NULL;
+ entry = Tcl_FindHashEntry(&cdefn->resolveVars, tail);
+ if (entry) {
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+ if (vlookup->vdefn->member->classDefn != cdefn) {
+ vlookup = NULL;
+ }
+ }
+
+ if (vlookup == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "option \"", tail, "\" is not defined in class \"",
+ cdefn->fullname, "\"",
+ (char*)NULL);
+ status = TCL_ERROR;
+ goto configBodyCmdDone;
+ }
+ member = vlookup->vdefn->member;
+
+ if (member->protection != ITCL_PUBLIC) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "option \"", member->fullname,
+ "\" is not a public configuration option",
+ (char*)NULL);
+ status = TCL_ERROR;
+ goto configBodyCmdDone;
+ }
+
+ token = Tcl_GetStringFromObj(objv[2], (int*)NULL);
+
+ if (Itcl_CreateMemberCode(interp, cdefn, (char*)NULL, token,
+ &mcode) != TCL_OK) {
+
+ status = TCL_ERROR;
+ goto configBodyCmdDone;
+ }
+
+ Itcl_PreserveData((ClientData)mcode);
+ Itcl_EventuallyFree((ClientData)mcode, Itcl_DeleteMemberCode);
+
+ if (member->code) {
+ Itcl_ReleaseData((ClientData)member->code);
+ }
+ member->code = mcode;
+
+configBodyCmdDone:
+ Tcl_DStringFree(&buffer);
+ return status;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_CreateMethod()
+ *
+ * Installs a method into the namespace associated with a class.
+ * If another command with the same name is already installed, then
+ * it is overwritten.
+ *
+ * Returns TCL_OK on success, or TCL_ERROR (along with an error message
+ * in the specified interp) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_CreateMethod(interp, cdefn, name, arglist, body)
+ Tcl_Interp* interp; /* interpreter managing this action */
+ ItclClass *cdefn; /* class definition */
+ char* name; /* name of new method */
+ char* arglist; /* space-separated list of arg names */
+ char* body; /* body of commands for the method */
+{
+ ItclMemberFunc *mfunc;
+ Tcl_DString buffer;
+
+ /*
+ * Make sure that the method name does not contain anything
+ * goofy like a "::" scope qualifier.
+ */
+ if (strstr(name,"::")) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad method name \"", name, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the method definition.
+ */
+ if (Itcl_CreateMemberFunc(interp, cdefn, name, arglist, body, &mfunc)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Build a fully-qualified name for the method, and install
+ * the command handler.
+ */
+ Tcl_DStringInit(&buffer);
+ Tcl_DStringAppend(&buffer, cdefn->namesp->fullName, -1);
+ Tcl_DStringAppend(&buffer, "::", 2);
+ Tcl_DStringAppend(&buffer, name, -1);
+ name = Tcl_DStringValue(&buffer);
+
+ Itcl_PreserveData((ClientData)mfunc);
+ mfunc->accessCmd = Tcl_CreateObjCommand(interp, name, Itcl_ExecMethod,
+ (ClientData)mfunc, Itcl_ReleaseData);
+
+ Tcl_DStringFree(&buffer);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_CreateProc()
+ *
+ * Installs a class proc into the namespace associated with a class.
+ * If another command with the same name is already installed, then
+ * it is overwritten. Returns TCL_OK on success, or TCL_ERROR (along
+ * with an error message in the specified interp) if anything goes
+ * wrong.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_CreateProc(interp, cdefn, name, arglist, body)
+ Tcl_Interp* interp; /* interpreter managing this action */
+ ItclClass *cdefn; /* class definition */
+ char* name; /* name of new proc */
+ char* arglist; /* space-separated list of arg names */
+ char* body; /* body of commands for the proc */
+{
+ ItclMemberFunc *mfunc;
+ Tcl_DString buffer;
+
+ /*
+ * Make sure that the proc name does not contain anything
+ * goofy like a "::" scope qualifier.
+ */
+ if (strstr(name,"::")) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad proc name \"", name, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the proc definition.
+ */
+ if (Itcl_CreateMemberFunc(interp, cdefn, name, arglist, body, &mfunc)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Mark procs as "common". This distinguishes them from methods.
+ */
+ mfunc->member->flags |= ITCL_COMMON;
+
+ /*
+ * Build a fully-qualified name for the proc, and install
+ * the command handler.
+ */
+ Tcl_DStringInit(&buffer);
+ Tcl_DStringAppend(&buffer, cdefn->namesp->fullName, -1);
+ Tcl_DStringAppend(&buffer, "::", 2);
+ Tcl_DStringAppend(&buffer, name, -1);
+ name = Tcl_DStringValue(&buffer);
+
+ Itcl_PreserveData((ClientData)mfunc);
+ mfunc->accessCmd = Tcl_CreateObjCommand(interp, name, Itcl_ExecProc,
+ (ClientData)mfunc, Itcl_ReleaseData);
+
+ Tcl_DStringFree(&buffer);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_CreateMemberFunc()
+ *
+ * Creates the data record representing a member function. This
+ * includes the argument list and the body of the function. If the
+ * body is of the form "@name", then it is treated as a label for
+ * a C procedure registered by Itcl_RegisterC().
+ *
+ * If any errors are encountered, this procedure returns TCL_ERROR
+ * along with an error message in the interpreter. Otherwise, it
+ * returns TCL_OK, and "mfuncPtr" returns a pointer to the new
+ * member function.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_CreateMemberFunc(interp, cdefn, name, arglist, body, mfuncPtr)
+ Tcl_Interp* interp; /* interpreter managing this action */
+ ItclClass *cdefn; /* class definition */
+ char* name; /* name of new member */
+ char* arglist; /* space-separated list of arg names */
+ char* body; /* body of commands for the method */
+ ItclMemberFunc** mfuncPtr; /* returns: pointer to new method defn */
+{
+ int newEntry;
+ ItclMemberFunc *mfunc;
+ ItclMemberCode *mcode;
+ Tcl_HashEntry *entry;
+
+ /*
+ * Add the member function to the list of functions for
+ * the class. Make sure that a member function with the
+ * same name doesn't already exist.
+ */
+ entry = Tcl_CreateHashEntry(&cdefn->functions, name, &newEntry);
+
+ if (!newEntry) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\"", name, "\" already defined in class \"",
+ cdefn->fullname, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Try to create the implementation for this command member.
+ */
+ if (Itcl_CreateMemberCode(interp, cdefn, arglist, body,
+ &mcode) != TCL_OK) {
+
+ Tcl_DeleteHashEntry(entry);
+ return TCL_ERROR;
+ }
+ Itcl_PreserveData((ClientData)mcode);
+ Itcl_EventuallyFree((ClientData)mcode, Itcl_DeleteMemberCode);
+
+ /*
+ * Allocate a member function definition and return.
+ */
+ mfunc = (ItclMemberFunc*)ckalloc(sizeof(ItclMemberFunc));
+ mfunc->member = Itcl_CreateMember(interp, cdefn, name);
+ mfunc->member->code = mcode;
+
+ if (mfunc->member->protection == ITCL_DEFAULT_PROTECT) {
+ mfunc->member->protection = ITCL_PUBLIC;
+ }
+
+ mfunc->arglist = NULL;
+ mfunc->argcount = 0;
+ mfunc->accessCmd = NULL;
+
+ if (arglist) {
+ mfunc->member->flags |= ITCL_ARG_SPEC;
+ }
+ if (mcode->arglist) {
+ Itcl_CreateArgList(interp, arglist, &mfunc->argcount, &mfunc->arglist);
+ }
+
+ if (strcmp(name,"constructor") == 0) {
+ mfunc->member->flags |= ITCL_CONSTRUCTOR;
+ }
+ if (strcmp(name,"destructor") == 0) {
+ mfunc->member->flags |= ITCL_DESTRUCTOR;
+ }
+
+ Tcl_SetHashValue(entry, (ClientData)mfunc);
+ Itcl_PreserveData((ClientData)mfunc);
+ Itcl_EventuallyFree((ClientData)mfunc, Itcl_DeleteMemberFunc);
+
+ *mfuncPtr = mfunc;
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ChangeMemberFunc()
+ *
+ * Modifies the data record representing a member function. This
+ * is usually the body of the function, but can include the argument
+ * list if it was not defined when the member was first created.
+ * If the body is of the form "@name", then it is treated as a label
+ * for a C procedure registered by Itcl_RegisterC().
+ *
+ * If any errors are encountered, this procedure returns TCL_ERROR
+ * along with an error message in the interpreter. Otherwise, it
+ * returns TCL_OK, and "mfuncPtr" returns a pointer to the new
+ * member function.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ChangeMemberFunc(interp, mfunc, arglist, body)
+ Tcl_Interp* interp; /* interpreter managing this action */
+ ItclMemberFunc* mfunc; /* command member being changed */
+ char* arglist; /* space-separated list of arg names */
+ char* body; /* body of commands for the method */
+{
+ ItclMemberCode *mcode = NULL;
+ Tcl_Obj *objPtr;
+
+ /*
+ * Try to create the implementation for this command member.
+ */
+ if (Itcl_CreateMemberCode(interp, mfunc->member->classDefn,
+ arglist, body, &mcode) != TCL_OK) {
+
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the argument list was defined when the function was
+ * created, compare the arg lists or usage strings to make sure
+ * that the interface is not being redefined.
+ */
+ if ((mfunc->member->flags & ITCL_ARG_SPEC) != 0 &&
+ !Itcl_EquivArgLists(mfunc->arglist, mfunc->argcount,
+ mcode->arglist, mcode->argcount)) {
+
+ objPtr = Itcl_ArgList(mfunc->argcount, mfunc->arglist);
+ Tcl_IncrRefCount(objPtr);
+
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "argument list changed for function \"",
+ mfunc->member->fullname, "\": should be \"",
+ Tcl_GetStringFromObj(objPtr, (int*)NULL), "\"",
+ (char*)NULL);
+ Tcl_DecrRefCount(objPtr);
+
+ Itcl_DeleteMemberCode((char*)mcode);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Free up the old implementation and install the new one.
+ */
+ Itcl_PreserveData((ClientData)mcode);
+ Itcl_EventuallyFree((ClientData)mcode, Itcl_DeleteMemberCode);
+
+ Itcl_ReleaseData((ClientData)mfunc->member->code);
+ mfunc->member->code = mcode;
+
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_DeleteMemberFunc()
+ *
+ * Destroys all data associated with the given member function definition.
+ * Usually invoked by the interpreter when a member function is deleted.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_DeleteMemberFunc(cdata)
+ char* cdata; /* pointer to member function definition */
+{
+ ItclMemberFunc* mfunc = (ItclMemberFunc*)cdata;
+
+ if (mfunc) {
+ Itcl_DeleteMember(mfunc->member);
+
+ if (mfunc->arglist) {
+ Itcl_DeleteArgList(mfunc->arglist);
+ }
+ ckfree((char*)mfunc);
+ }
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_CreateMemberCode()
+ *
+ * Creates the data record representing the implementation behind a
+ * class member function. This includes the argument list and the body
+ * of the function. If the body is of the form "@name", then it is
+ * treated as a label for a C procedure registered by Itcl_RegisterC().
+ *
+ * The implementation is kept by the member function definition, and
+ * controlled by a preserve/release paradigm. That way, if it is in
+ * use while it is being redefined, it will stay around long enough
+ * to avoid a core dump.
+ *
+ * If any errors are encountered, this procedure returns TCL_ERROR
+ * along with an error message in the interpreter. Otherwise, it
+ * returns TCL_OK, and "mcodePtr" returns a pointer to the new
+ * implementation.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_CreateMemberCode(interp, cdefn, arglist, body, mcodePtr)
+ Tcl_Interp* interp; /* interpreter managing this action */
+ ItclClass *cdefn; /* class containing this member */
+ char* arglist; /* space-separated list of arg names */
+ char* body; /* body of commands for the method */
+ ItclMemberCode** mcodePtr; /* returns: pointer to new implementation */
+{
+ int argc;
+ CompiledLocal *args, *localPtr;
+ ItclMemberCode *mcode;
+ Proc *procPtr;
+
+ /*
+ * Allocate some space to hold the implementation.
+ */
+ mcode = (ItclMemberCode*)ckalloc(sizeof(ItclMemberCode));
+ mcode->flags = 0;
+ mcode->argcount = 0;
+ mcode->arglist = NULL;
+ mcode->procPtr = NULL;
+ mcode->cfunc.objCmd = NULL;
+ mcode->clientData = NULL;
+
+ if (arglist) {
+ if (Itcl_CreateArgList(interp, arglist, &argc, &args)
+ != TCL_OK) {
+
+ Itcl_DeleteMemberCode((char*)mcode);
+ return TCL_ERROR;
+ }
+ mcode->argcount = argc;
+ mcode->arglist = args;
+ mcode->flags |= ITCL_ARG_SPEC;
+ } else {
+ argc = 0;
+ args = NULL;
+ }
+
+ /*
+ * Create a standard Tcl Proc representation for this code body.
+ * This is required, since the Tcl compiler looks for a proc
+ * when handling things such as the call frame context and
+ * compiled locals.
+ */
+ procPtr = (Proc*)ckalloc(sizeof(Proc));
+ mcode->procPtr = procPtr;
+
+ procPtr->iPtr = (Interp*)interp;
+ procPtr->refCount = 1;
+ procPtr->cmdPtr = (Command*)ckalloc(sizeof(Command));
+ procPtr->cmdPtr->nsPtr = (Namespace*)cdefn->namesp;
+
+ if (body) {
+ procPtr->bodyPtr = Tcl_NewStringObj(body, -1);
+ Tcl_IncrRefCount(procPtr->bodyPtr);
+ } else {
+ procPtr->bodyPtr = NULL;
+ }
+
+ /*
+ * Plug the argument list into the "compiled locals" list.
+ *
+ * NOTE: The storage for this argument list is owned by
+ * the caller, so although we plug it in here, it is not
+ * our responsibility to free it.
+ */
+ procPtr->firstLocalPtr = args;
+ procPtr->lastLocalPtr = NULL;
+
+ for (localPtr=mcode->arglist; localPtr; localPtr=localPtr->nextPtr) {
+ procPtr->lastLocalPtr = localPtr;
+ }
+ procPtr->numArgs = argc;
+ procPtr->numCompiledLocals = argc;
+
+ /*
+ * If the body definition starts with '@', then treat the value
+ * as a symbolic name for a C procedure.
+ */
+ if (body == NULL) {
+ mcode->flags |= ITCL_IMPLEMENT_NONE;
+ }
+ else if (*body == '@') {
+ Tcl_CmdProc *argCmdProc;
+ Tcl_ObjCmdProc *objCmdProc;
+ ClientData cdata;
+
+ if (!Itcl_FindC(interp, body+1, &argCmdProc, &objCmdProc, &cdata)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "no registered C procedure with name \"", body+1, "\"",
+ (char*)NULL);
+ Itcl_DeleteMemberCode((char*)mcode);
+ return TCL_ERROR;
+ }
+
+ if (objCmdProc != NULL) {
+ mcode->flags |= ITCL_IMPLEMENT_OBJCMD;
+ mcode->cfunc.objCmd = objCmdProc;
+ mcode->clientData = cdata;
+ }
+ else if (argCmdProc != NULL) {
+ mcode->flags |= ITCL_IMPLEMENT_ARGCMD;
+ mcode->cfunc.argCmd = argCmdProc;
+ mcode->clientData = cdata;
+ }
+ }
+
+ /*
+ * Otherwise, treat the body as a chunk of Tcl code.
+ */
+ else {
+ mcode->flags |= ITCL_IMPLEMENT_TCL;
+ }
+
+ *mcodePtr = mcode;
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_DeleteMemberCode()
+ *
+ * Destroys all data associated with the given command implementation.
+ * Invoked automatically by Itcl_ReleaseData() when the implementation
+ * is no longer being used.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_DeleteMemberCode(cdata)
+ char* cdata; /* pointer to member function definition */
+{
+ ItclMemberCode* mcode = (ItclMemberCode*)cdata;
+
+ if (mcode->arglist) {
+ Itcl_DeleteArgList(mcode->arglist);
+ }
+ if (mcode->procPtr) {
+ ckfree((char*) mcode->procPtr->cmdPtr);
+
+ /* don't free compiled locals -- that is handled by arglist above */
+
+ if (mcode->procPtr->bodyPtr) {
+ Tcl_DecrRefCount(mcode->procPtr->bodyPtr);
+ }
+ ckfree((char*)mcode->procPtr);
+ }
+ ckfree((char*)mcode);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_GetMemberCode()
+ *
+ * Makes sure that the implementation for an [incr Tcl] code body is
+ * ready to run. Note that a member function can be declared without
+ * being defined. The class definition may contain a declaration of
+ * the member function, but its body may be defined in a separate file.
+ * If an undefined function is encountered, this routine automatically
+ * attempts to autoload it. If the body is implemented via Tcl code,
+ * then it is compiled here as well.
+ *
+ * Returns TCL_ERROR (along with an error message in the interpreter)
+ * if an error is encountered, or if the implementation is not defined
+ * and cannot be autoloaded. Returns TCL_OK if implementation is
+ * ready to use.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_GetMemberCode(interp, member)
+ Tcl_Interp* interp; /* interpreter managing this action */
+ ItclMember* member; /* member containing code body */
+{
+ ItclMemberCode *mcode = member->code;
+
+ int result;
+
+ /*
+ * If the implementation has not yet been defined, try to
+ * autoload it now.
+ */
+ if ((mcode->flags & ITCL_IMPLEMENT_NONE) != 0) {
+ result = Tcl_VarEval(interp, "::auto_load ", member->fullname,
+ (char*)NULL);
+
+ if (result != TCL_OK) {
+ char msg[256];
+ sprintf(msg, "\n (while autoloading code for \"%.100s\")",
+ member->fullname);
+ Tcl_AddErrorInfo(interp, msg);
+ return result;
+ }
+ Tcl_ResetResult(interp); /* get rid of 1/0 status */
+ }
+
+ /*
+ * If the implementation is still not available, then
+ * autoloading must have failed.
+ *
+ * TRICKY NOTE: If code has been autoloaded, then the
+ * old mcode pointer is probably invalid. Go back to
+ * the member and look at the current code pointer again.
+ */
+ mcode = member->code;
+
+ if ((mcode->flags & ITCL_IMPLEMENT_NONE) != 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "member function \"", member->fullname,
+ "\" is not defined and cannot be autoloaded",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the member is a constructor and the class has an
+ * initialization command, compile it here.
+ */
+ if ((member->flags & ITCL_CONSTRUCTOR) != 0 &&
+ (member->classDefn->initCode != NULL)) {
+
+ result = TclProcCompileProc(interp, mcode->procPtr,
+ member->classDefn->initCode, (Namespace*)member->classDefn->namesp,
+ "initialization code for", member->fullname);
+
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ /*
+ * If the code body has a Tcl implementation, then compile it here.
+ */
+ if ((mcode->flags & ITCL_IMPLEMENT_TCL) != 0) {
+
+ result = TclProcCompileProc(interp, mcode->procPtr,
+ mcode->procPtr->bodyPtr, (Namespace*)member->classDefn->namesp,
+ "body for", member->fullname);
+
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_EvalMemberCode()
+ *
+ * Used to execute an ItclMemberCode representation of a code
+ * fragment. This code may be a body of Tcl commands, or a C handler
+ * procedure.
+ *
+ * Executes the command with the given arguments (objc,objv) and
+ * returns an integer status code (TCL_OK/TCL_ERROR). Returns the
+ * result string or an error message in the interpreter.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_EvalMemberCode(interp, mfunc, member, contextObj, objc, objv)
+ Tcl_Interp *interp; /* current interpreter */
+ ItclMemberFunc *mfunc; /* member func, or NULL (for error messages) */
+ ItclMember *member; /* command member containing code */
+ ItclObject *contextObj; /* object context, or NULL */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int result = TCL_OK;
+ Tcl_CallFrame *oldFramePtr = NULL;
+
+ int i, transparent, newEntry;
+ ItclObjectInfo *info;
+ ItclMemberCode *mcode;
+ ItclContext context;
+ Tcl_CallFrame *framePtr, *transFramePtr;
+
+ /*
+ * If this code does not have an implementation yet, then
+ * try to autoload one. Also, if this is Tcl code, make sure
+ * that it's compiled and ready to use.
+ */
+ if (Itcl_GetMemberCode(interp, member) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ mcode = member->code;
+
+ /*
+ * Bump the reference count on this code, in case it is
+ * redefined or deleted during execution.
+ */
+ Itcl_PreserveData((ClientData)mcode);
+
+ /*
+ * Install a new call frame context for the current code.
+ * If the current call frame is marked as "transparent", then
+ * do an "uplevel" operation to move past it. Transparent
+ * call frames are installed by Itcl_HandleInstance. They
+ * provide a way of entering an object context without
+ * interfering with the normal call stack.
+ */
+ transparent = 0;
+
+ info = member->classDefn->info;
+ framePtr = _Tcl_GetCallFrame(interp, 0);
+ for (i = Itcl_GetStackSize(&info->transparentFrames)-1; i >= 0; i--) {
+ transFramePtr = (Tcl_CallFrame*)
+ Itcl_GetStackValue(&info->transparentFrames, i);
+
+ if (framePtr == transFramePtr) {
+ transparent = 1;
+ break;
+ }
+ }
+
+ if (transparent) {
+ framePtr = _Tcl_GetCallFrame(interp, 1);
+ oldFramePtr = _Tcl_ActivateCallFrame(interp, framePtr);
+ }
+
+ if (Itcl_PushContext(interp, member, member->classDefn, contextObj,
+ &context) != TCL_OK) {
+
+ return TCL_ERROR;
+ }
+
+ /*
+ * If this is a method with a Tcl implementation, or a
+ * constructor with initCode, then parse its arguments now.
+ */
+ if (mfunc && objc > 0) {
+ if ((mcode->flags & ITCL_IMPLEMENT_TCL) != 0 ||
+ ( (member->flags & ITCL_CONSTRUCTOR) != 0 &&
+ (member->classDefn->initCode != NULL) ) ) {
+
+ if (Itcl_AssignArgs(interp, objc, objv, mfunc) != TCL_OK) {
+ result = TCL_ERROR;
+ goto evalMemberCodeDone;
+ }
+ }
+ }
+
+ /*
+ * If this code is a constructor, and if it is being invoked
+ * when an object is first constructed (i.e., the "constructed"
+ * table is still active within the object), then handle the
+ * "initCode" associated with the constructor and make sure that
+ * all base classes are properly constructed.
+ *
+ * TRICKY NOTE:
+ * The "initCode" must be executed here. This is the only
+ * opportunity where the arguments of the constructor are
+ * available in a call frame.
+ */
+ if ((member->flags & ITCL_CONSTRUCTOR) && contextObj &&
+ contextObj->constructed) {
+
+ result = Itcl_ConstructBase(interp, contextObj, member->classDefn);
+
+ if (result != TCL_OK) {
+ goto evalMemberCodeDone;
+ }
+ }
+
+ /*
+ * Execute the code body...
+ */
+ if ((mcode->flags & ITCL_IMPLEMENT_OBJCMD) != 0) {
+ result = (*mcode->cfunc.objCmd)(mcode->clientData,
+ interp, objc, objv);
+ }
+ else if ((mcode->flags & ITCL_IMPLEMENT_ARGCMD) != 0) {
+ char **argv;
+ argv = (char**)ckalloc( (unsigned)(objc*sizeof(char*)) );
+ for (i=0; i < objc; i++) {
+ argv[i] = Tcl_GetStringFromObj(objv[i], (int*)NULL);
+ }
+
+ result = (*mcode->cfunc.argCmd)(mcode->clientData,
+ interp, objc, argv);
+
+ ckfree((char*)argv);
+ }
+ else if ((mcode->flags & ITCL_IMPLEMENT_TCL) != 0) {
+ /* CYGNUS LOCAL - Fix for Tcl8.1 */
+#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ result = Tcl_EvalObj(interp, mcode->procPtr->bodyPtr);
+#else
+ result = Tcl_EvalObj(interp, mcode->procPtr->bodyPtr, 0);
+#endif
+ /* END CYGNUS LOCAL */
+ }
+ else {
+ panic("itcl: bad implementation flag for %s", member->fullname);
+ }
+
+ /*
+ * If this is a constructor or destructor, and if it is being
+ * invoked at the appropriate time, keep track of which methods
+ * have been called. This information is used to implicitly
+ * invoke constructors/destructors as needed.
+ */
+ if ((member->flags & ITCL_DESTRUCTOR) && contextObj &&
+ contextObj->destructed) {
+
+ Tcl_CreateHashEntry(contextObj->destructed,
+ member->classDefn->name, &newEntry);
+ }
+ if ((member->flags & ITCL_CONSTRUCTOR) && contextObj &&
+ contextObj->constructed) {
+
+ Tcl_CreateHashEntry(contextObj->constructed,
+ member->classDefn->name, &newEntry);
+ }
+
+evalMemberCodeDone:
+ Itcl_PopContext(interp, &context);
+
+ if (transparent) {
+ (void) _Tcl_ActivateCallFrame(interp, oldFramePtr);
+ }
+ Itcl_ReleaseData((ClientData)mcode);
+
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_CreateArgList()
+ *
+ * Parses a Tcl list representing an argument declaration and returns
+ * a linked list of CompiledLocal values. Usually invoked as part
+ * of Itcl_CreateMemberFunc() when a new method or procedure is being
+ * defined.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_CreateArgList(interp, decl, argcPtr, argPtr)
+ Tcl_Interp* interp; /* interpreter managing this function */
+ char* decl; /* string representing argument list */
+ int* argcPtr; /* returns number of args in argument list */
+ CompiledLocal** argPtr; /* returns pointer to parsed argument list */
+{
+ int status = TCL_OK; /* assume that this will succeed */
+
+ int i, argc, fargc;
+ char **argv, **fargv;
+ CompiledLocal *localPtr, *last;
+
+ *argPtr = last = NULL;
+ *argcPtr = 0;
+
+ if (decl) {
+ if (Tcl_SplitList(interp, decl, &argc, &argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ for (i=0; i < argc && status == TCL_OK; i++) {
+ if (Tcl_SplitList(interp, argv[i], &fargc, &fargv) != TCL_OK) {
+ status = TCL_ERROR;
+ }
+ else {
+ localPtr = NULL;
+
+ if (fargc == 0 || *fargv[0] == '\0') {
+ char mesg[100];
+ sprintf(mesg, "argument #%d has no name", i);
+ Tcl_SetResult(interp, mesg, TCL_VOLATILE);
+ status = TCL_ERROR;
+ }
+ else if (fargc > 2) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "too many fields in argument specifier \"",
+ argv[i], "\"",
+ (char*)NULL);
+ status = TCL_ERROR;
+ }
+ else if (strstr(fargv[0],"::")) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad argument name \"", fargv[0], "\"",
+ (char*)NULL);
+ status = TCL_ERROR;
+ }
+ else if (fargc == 1) {
+ localPtr = Itcl_CreateArg(fargv[0], (char*)NULL);
+ }
+ else {
+ localPtr = Itcl_CreateArg(fargv[0], fargv[1]);
+ }
+
+ if (localPtr) {
+ localPtr->frameIndex = i;
+
+ if (*argPtr == NULL) {
+ *argPtr = last = localPtr;
+ }
+ else {
+ last->nextPtr = localPtr;
+ last = localPtr;
+ }
+ }
+ }
+ ckfree((char*)fargv);
+ }
+ ckfree((char*)argv);
+ }
+
+ /*
+ * If anything went wrong, destroy whatever arguments were
+ * created and return an error.
+ */
+ if (status == TCL_OK) {
+ *argcPtr = argc;
+ } else {
+ Itcl_DeleteArgList(*argPtr);
+ *argPtr = NULL;
+ }
+ return status;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_CreateArg()
+ *
+ * Creates a new Tcl Arg structure and fills it with the given
+ * information. Returns a pointer to the new Arg structure.
+ * ------------------------------------------------------------------------
+ */
+CompiledLocal*
+Itcl_CreateArg(name, init)
+ char* name; /* name of new argument */
+ char* init; /* initial value */
+{
+ CompiledLocal *localPtr = NULL;
+ int nameLen;
+
+ if (name == NULL) {
+ name = "";
+ }
+ nameLen = strlen(name);
+
+ localPtr = (CompiledLocal*)ckalloc(
+ (unsigned)(sizeof(CompiledLocal)-sizeof(localPtr->name) + nameLen+1)
+ );
+
+ localPtr->nextPtr = NULL;
+ localPtr->nameLength = nameLen;
+ localPtr->frameIndex = 0; /* set this later */
+ localPtr->flags = VAR_SCALAR | VAR_ARGUMENT;
+ localPtr->resolveInfo = NULL;
+
+ if (init != NULL) {
+ localPtr->defValuePtr = Tcl_NewStringObj(init, -1);
+ Tcl_IncrRefCount(localPtr->defValuePtr);
+ } else {
+ localPtr->defValuePtr = NULL;
+ }
+
+ strcpy(localPtr->name, name);
+
+ return localPtr;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_DeleteArgList()
+ *
+ * Destroys a chain of arguments acting as an argument list. Usually
+ * invoked when a method/proc is being destroyed, to discard its
+ * argument list.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_DeleteArgList(arglist)
+ CompiledLocal *arglist; /* first argument in arg list chain */
+{
+ CompiledLocal *localPtr, *next;
+
+ for (localPtr=arglist; localPtr; localPtr=next) {
+ if (localPtr->defValuePtr != NULL) {
+ Tcl_DecrRefCount(localPtr->defValuePtr);
+ }
+ if (localPtr->resolveInfo) {
+ if (localPtr->resolveInfo->deleteProc) {
+ localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
+ } else {
+ ckfree((char*)localPtr->resolveInfo);
+ }
+ localPtr->resolveInfo = NULL;
+ }
+ next = localPtr->nextPtr;
+ ckfree((char*)localPtr);
+ }
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ArgList()
+ *
+ * Returns a Tcl_Obj containing the string representation for the
+ * given argument list. This object has a reference count of 1.
+ * The reference count should be decremented when the string is no
+ * longer needed, and it will free itself.
+ * ------------------------------------------------------------------------
+ */
+Tcl_Obj*
+Itcl_ArgList(argc, arglist)
+ int argc; /* number of arguments */
+ CompiledLocal* arglist; /* first argument in arglist */
+{
+ char *val;
+ Tcl_Obj *objPtr;
+ Tcl_DString buffer;
+
+ Tcl_DStringInit(&buffer);
+
+ while (arglist && argc-- > 0) {
+ if (arglist->defValuePtr) {
+ val = Tcl_GetStringFromObj(arglist->defValuePtr, (int*)NULL);
+ Tcl_DStringStartSublist(&buffer);
+ Tcl_DStringAppendElement(&buffer, arglist->name);
+ Tcl_DStringAppendElement(&buffer, val);
+ Tcl_DStringEndSublist(&buffer);
+ }
+ else {
+ Tcl_DStringAppendElement(&buffer, arglist->name);
+ }
+ arglist = arglist->nextPtr;
+ }
+
+ objPtr = Tcl_NewStringObj(Tcl_DStringValue(&buffer),
+ Tcl_DStringLength(&buffer));
+
+ Tcl_DStringFree(&buffer);
+
+ return objPtr;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_EquivArgLists()
+ *
+ * Compares two argument lists to see if they are equivalent. The
+ * first list is treated as a prototype, and the second list must
+ * match it. Argument names may be different, but they must match in
+ * meaning. If one argument is optional, the corresponding argument
+ * must also be optional. If the prototype list ends with the magic
+ * "args" argument, then it matches everything in the other list.
+ *
+ * Returns non-zero if the argument lists are equivalent.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_EquivArgLists(arg1, arg1c, arg2, arg2c)
+ CompiledLocal* arg1; /* prototype argument list */
+ int arg1c; /* number of args in prototype arg list */
+ CompiledLocal* arg2; /* another argument list to match against */
+ int arg2c; /* number of args in matching list */
+{
+ char *dval1, *dval2;
+
+ while (arg1 && arg1c > 0 && arg2 && arg2c > 0) {
+ /*
+ * If the prototype argument list ends with the magic "args"
+ * argument, then it matches everything in the other list.
+ */
+ if (arg1c == 1 && strcmp(arg1->name,"args") == 0) {
+ return 1;
+ }
+
+ /*
+ * If one has a default value, then the other must have the
+ * same default value.
+ */
+ if (arg1->defValuePtr) {
+ if (arg2->defValuePtr == NULL) {
+ return 0;
+ }
+
+ dval1 = Tcl_GetStringFromObj(arg1->defValuePtr, (int*)NULL);
+ dval2 = Tcl_GetStringFromObj(arg2->defValuePtr, (int*)NULL);
+ if (strcmp(dval1, dval2) != 0) {
+ return 0;
+ }
+ }
+ else if (arg2->defValuePtr) {
+ return 0;
+ }
+
+ arg1 = arg1->nextPtr; arg1c--;
+ arg2 = arg2->nextPtr; arg2c--;
+ }
+ if (arg1c == 1 && strcmp(arg1->name,"args") == 0) {
+ return 1;
+ }
+ return (arg1c == 0 && arg2c == 0);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_GetMemberFuncUsage()
+ *
+ * Returns a string showing how a command member should be invoked.
+ * If the command member is a method, then the specified object name
+ * is reported as part of the invocation path:
+ *
+ * obj method arg ?arg arg ...?
+ *
+ * Otherwise, the "obj" pointer is ignored, and the class name is
+ * used as the invocation path:
+ *
+ * class::proc arg ?arg arg ...?
+ *
+ * Returns the string by appending it onto the Tcl_Obj passed in as
+ * an argument.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_GetMemberFuncUsage(mfunc, contextObj, objPtr)
+ ItclMemberFunc *mfunc; /* command member being examined */
+ ItclObject *contextObj; /* invoked with respect to this object */
+ Tcl_Obj *objPtr; /* returns: string showing usage */
+{
+ int argcount;
+ char *name;
+ CompiledLocal *arglist, *argPtr;
+ Tcl_HashEntry *entry;
+ ItclMemberFunc *mf;
+ ItclClass *cdefnPtr;
+
+ /*
+ * If the command is a method and an object context was
+ * specified, then add the object context. If the method
+ * was a constructor, and if the object is being created,
+ * then report the invocation via the class creation command.
+ */
+ if ((mfunc->member->flags & ITCL_COMMON) == 0) {
+ if ((mfunc->member->flags & ITCL_CONSTRUCTOR) != 0 &&
+ contextObj->constructed) {
+
+ cdefnPtr = (ItclClass*)contextObj->classDefn;
+ mf = NULL;
+ entry = Tcl_FindHashEntry(&cdefnPtr->resolveCmds, "constructor");
+ if (entry) {
+ mf = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+ }
+
+ if (mf == mfunc) {
+ Tcl_GetCommandFullName(contextObj->classDefn->interp,
+ contextObj->classDefn->accessCmd, objPtr);
+ Tcl_AppendToObj(objPtr, " ", -1);
+ name = Tcl_GetCommandName(contextObj->classDefn->interp,
+ contextObj->accessCmd);
+ Tcl_AppendToObj(objPtr, name, -1);
+ } else {
+ Tcl_AppendToObj(objPtr, mfunc->member->fullname, -1);
+ }
+ }
+ else if (contextObj && contextObj->accessCmd) {
+ name = Tcl_GetCommandName(contextObj->classDefn->interp,
+ contextObj->accessCmd);
+ Tcl_AppendStringsToObj(objPtr, name, " ", mfunc->member->name,
+ (char*)NULL);
+ }
+ else {
+ Tcl_AppendStringsToObj(objPtr, "<object> ", mfunc->member->name,
+ (char*)NULL);
+ }
+ }
+ else {
+ Tcl_AppendToObj(objPtr, mfunc->member->fullname, -1);
+ }
+
+ /*
+ * Add the argument usage info.
+ */
+ if (mfunc->member->code) {
+ arglist = mfunc->member->code->arglist;
+ argcount = mfunc->member->code->argcount;
+ } else if (mfunc->arglist) {
+ arglist = mfunc->arglist;
+ argcount = mfunc->argcount;
+ } else {
+ arglist = NULL;
+ argcount = 0;
+ }
+
+ if (arglist) {
+ for (argPtr=arglist;
+ argPtr && argcount > 0;
+ argPtr=argPtr->nextPtr, argcount--) {
+
+ if (argcount == 1 && strcmp(argPtr->name, "args") == 0) {
+ Tcl_AppendToObj(objPtr, " ?arg arg ...?", -1);
+ }
+ else if (argPtr->defValuePtr) {
+ Tcl_AppendStringsToObj(objPtr, " ?", argPtr->name, "?",
+ (char*)NULL);
+ }
+ else {
+ Tcl_AppendStringsToObj(objPtr, " ", argPtr->name,
+ (char*)NULL);
+ }
+ }
+ }
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ExecMethod()
+ *
+ * Invoked by Tcl to handle the execution of a user-defined method.
+ * A method is similar to the usual Tcl proc, but has access to
+ * object-specific data. If for some reason there is no current
+ * object context, then a method call is inappropriate, and an error
+ * is returned.
+ *
+ * Methods are implemented either as Tcl code fragments, or as C-coded
+ * procedures. For Tcl code fragments, command arguments are parsed
+ * according to the argument list, and the body is executed in the
+ * scope of the class where it was defined. For C procedures, the
+ * arguments are passed in "as-is", and the procedure is executed in
+ * the most-specific class scope.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ExecMethod(clientData, interp, objc, objv)
+ ClientData clientData; /* method definition */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclMemberFunc *mfunc = (ItclMemberFunc*)clientData;
+ ItclMember *member = mfunc->member;
+ int result = TCL_OK;
+
+ char *token;
+ Tcl_HashEntry *entry;
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+
+ /*
+ * Make sure that the current namespace context includes an
+ * object that is being manipulated. Methods can be executed
+ * only if an object context exists.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (contextObj == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot access object-specific info without an object context",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that this command member can be accessed from
+ * the current namespace context.
+ */
+ if (mfunc->member->protection != ITCL_PUBLIC) {
+ Tcl_Namespace *contextNs = Itcl_GetTrueNamespace(interp,
+ contextClass->info);
+
+ if (!Itcl_CanAccessFunc(mfunc, contextNs)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "can't access \"", member->fullname, "\": ",
+ Itcl_ProtectionStr(member->protection), " function",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * All methods should be "virtual" unless they are invoked with
+ * a "::" scope qualifier.
+ *
+ * To implement the "virtual" behavior, find the most-specific
+ * implementation for the method by looking in the "resolveCmds"
+ * table for this class.
+ */
+ token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ if (strstr(token, "::") == NULL) {
+ entry = Tcl_FindHashEntry(&contextObj->classDefn->resolveCmds,
+ member->name);
+
+ if (entry) {
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+ member = mfunc->member;
+ }
+ }
+
+ /*
+ * Execute the code for the method. Be careful to protect
+ * the method in case it gets deleted during execution.
+ */
+ Itcl_PreserveData((ClientData)mfunc);
+
+ result = Itcl_EvalMemberCode(interp, mfunc, member, contextObj,
+ objc, objv);
+
+ result = Itcl_ReportFuncErrors(interp, mfunc, contextObj, result);
+
+ Itcl_ReleaseData((ClientData)mfunc);
+
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ExecProc()
+ *
+ * Invoked by Tcl to handle the execution of a user-defined proc.
+ *
+ * Procs are implemented either as Tcl code fragments, or as C-coded
+ * procedures. For Tcl code fragments, command arguments are parsed
+ * according to the argument list, and the body is executed in the
+ * scope of the class where it was defined. For C procedures, the
+ * arguments are passed in "as-is", and the procedure is executed in
+ * the most-specific class scope.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ExecProc(clientData, interp, objc, objv)
+ ClientData clientData; /* proc definition */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclMemberFunc *mfunc = (ItclMemberFunc*)clientData;
+ ItclMember *member = mfunc->member;
+ int result = TCL_OK;
+
+ /*
+ * Make sure that this command member can be accessed from
+ * the current namespace context.
+ */
+ if (mfunc->member->protection != ITCL_PUBLIC) {
+ Tcl_Namespace *contextNs = Itcl_GetTrueNamespace(interp,
+ mfunc->member->classDefn->info);
+
+ if (!Itcl_CanAccessFunc(mfunc, contextNs)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "can't access \"", member->fullname, "\": ",
+ Itcl_ProtectionStr(member->protection), " function",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Execute the code for the proc. Be careful to protect
+ * the proc in case it gets deleted during execution.
+ */
+ Itcl_PreserveData((ClientData)mfunc);
+
+ result = Itcl_EvalMemberCode(interp, mfunc, member, (ItclObject*)NULL,
+ objc, objv);
+
+ result = Itcl_ReportFuncErrors(interp, mfunc, (ItclObject*)NULL, result);
+
+ Itcl_ReleaseData((ClientData)mfunc);
+
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_PushContext()
+ *
+ * Sets up the class/object context so that a body of [incr Tcl]
+ * code can be executed. This procedure pushes a call frame with
+ * the proper namespace context for the class. If an object context
+ * is supplied, the object's instance variables are integrated into
+ * the call frame so they can be accessed as local variables.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_PushContext(interp, member, contextClass, contextObj, contextPtr)
+ Tcl_Interp *interp; /* interpreter managing this body of code */
+ ItclMember *member; /* member containing code body */
+ ItclClass *contextClass; /* class context */
+ ItclObject *contextObj; /* object context, or NULL */
+ ItclContext *contextPtr; /* storage space for class/object context */
+{
+ CallFrame *framePtr = &contextPtr->frame;
+
+ int result, localCt, newEntry;
+ ItclMemberCode *mcode;
+ Proc *procPtr;
+ Tcl_HashEntry *entry;
+
+ /*
+ * Activate the call frame. If this fails, we'll bail out
+ * before allocating any resources.
+ *
+ * NOTE: Always push a call frame that looks like a proc.
+ * This causes global variables to be handled properly
+ * inside methods/procs.
+ */
+ result = Tcl_PushCallFrame(interp, (Tcl_CallFrame*)framePtr,
+ contextClass->namesp, /* isProcCallFrame */ 1);
+
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ contextPtr->classDefn = contextClass;
+ contextPtr->compiledLocals = &contextPtr->localStorage[0];
+
+ /*
+ * If this is an object context, register it in a hash table
+ * of all known contexts. We'll need this later if we
+ * call Itcl_GetContext to get the object context for the
+ * current call frame.
+ */
+ if (contextObj) {
+ entry = Tcl_CreateHashEntry(&contextClass->info->contextFrames,
+ (char*)framePtr, &newEntry);
+
+ Itcl_PreserveData((ClientData)contextObj);
+ Tcl_SetHashValue(entry, (ClientData)contextObj);
+ }
+
+ /*
+ * Set up the compiled locals in the call frame and assign
+ * argument variables.
+ */
+ if (member) {
+ mcode = member->code;
+ procPtr = mcode->procPtr;
+
+ /*
+ * If there are too many compiled locals to fit in the default
+ * storage space for the context, then allocate more space.
+ */
+ localCt = procPtr->numCompiledLocals;
+ if (localCt > sizeof(contextPtr->localStorage)/sizeof(Var)) {
+ contextPtr->compiledLocals = (Var*)ckalloc(
+ (unsigned)(localCt * sizeof(Var))
+ );
+ }
+
+ /*
+ * Initialize and resolve compiled variable references.
+ * Class variables will have special resolution rules.
+ * In that case, we call their "resolver" procs to get our
+ * hands on the variable, and we make the compiled local a
+ * link to the real variable.
+ */
+
+ framePtr->procPtr = procPtr;
+ framePtr->numCompiledLocals = localCt;
+ framePtr->compiledLocals = contextPtr->compiledLocals;
+
+ TclInitCompiledLocals(interp, framePtr,
+ (Namespace*)contextClass->namesp);
+ }
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_PopContext()
+ *
+ * Removes a class/object context previously set up by Itcl_PushContext.
+ * Usually called after an [incr Tcl] code body has been executed,
+ * to clean up.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_PopContext(interp, contextPtr)
+ Tcl_Interp *interp; /* interpreter managing this body of code */
+ ItclContext *contextPtr; /* storage space for class/object context */
+{
+ Tcl_CallFrame *framePtr;
+ ItclObjectInfo *info;
+ ItclObject *contextObj;
+ Tcl_HashEntry *entry;
+
+ /*
+ * See if the current call frame has an object context
+ * associated with it. If so, release the claim on the
+ * object info.
+ */
+ framePtr = _Tcl_GetCallFrame(interp, 0);
+ info = contextPtr->classDefn->info;
+
+ entry = Tcl_FindHashEntry(&info->contextFrames, (char*)framePtr);
+ if (entry != NULL) {
+ contextObj = (ItclObject*)Tcl_GetHashValue(entry);
+ Itcl_ReleaseData((ClientData)contextObj);
+ Tcl_DeleteHashEntry(entry);
+ }
+
+ /*
+ * Remove the call frame.
+ */
+ Tcl_PopCallFrame(interp);
+
+ /*
+ * Free the compiledLocals array if malloc'ed storage was used.
+ */
+ if (contextPtr->compiledLocals != &contextPtr->localStorage[0]) {
+ ckfree((char*)contextPtr->compiledLocals);
+ }
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_GetContext()
+ *
+ * Convenience routine for looking up the current object/class context.
+ * Useful in implementing methods/procs to see what class, and perhaps
+ * what object, is active.
+ *
+ * Returns TCL_OK if the current namespace is a class namespace.
+ * Also returns pointers to the class definition, and to object
+ * data if an object context is active. Returns TCL_ERROR (along
+ * with an error message in the interpreter) if a class namespace
+ * is not active.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_GetContext(interp, cdefnPtr, odefnPtr)
+ Tcl_Interp *interp; /* current interpreter */
+ ItclClass **cdefnPtr; /* returns: class definition or NULL */
+ ItclObject **odefnPtr; /* returns: object data or NULL */
+{
+ Tcl_Namespace *activeNs = Tcl_GetCurrentNamespace(interp);
+ ItclObjectInfo *info;
+ Tcl_CallFrame *framePtr;
+ Tcl_HashEntry *entry;
+
+ /*
+ * Return NULL for anything that cannot be found.
+ */
+ *cdefnPtr = NULL;
+ *odefnPtr = NULL;
+
+ /*
+ * If the active namespace is a class namespace, then return
+ * all known info. See if the current call frame is a known
+ * object context, and if so, return that context.
+ */
+ if (Itcl_IsClassNamespace(activeNs)) {
+ *cdefnPtr = (ItclClass*)activeNs->clientData;
+
+ framePtr = _Tcl_GetCallFrame(interp, 0);
+
+ info = (*cdefnPtr)->info;
+ entry = Tcl_FindHashEntry(&info->contextFrames, (char*)framePtr);
+
+ if (entry != NULL) {
+ *odefnPtr = (ItclObject*)Tcl_GetHashValue(entry);
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * If there is no class/object context, return an error message.
+ */
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "namespace \"", activeNs->fullName, "\" is not a class namespace",
+ (char*)NULL);
+
+ return TCL_ERROR;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_AssignArgs()
+ *
+ * Matches a list of arguments against a Tcl argument specification.
+ * Supports all of the rules regarding arguments for Tcl procs, including
+ * default arguments and variable-length argument lists.
+ *
+ * Assumes that a local call frame is already installed. As variables
+ * are successfully matched, they are stored as variables in the call
+ * frame. Returns TCL_OK on success, or TCL_ERROR (along with an error
+ * message in interp->result) on error.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_AssignArgs(interp, objc, objv, mfunc)
+ Tcl_Interp *interp; /* interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+ ItclMemberFunc *mfunc; /* member function info (for error messages) */
+{
+ ItclMemberCode *mcode = mfunc->member->code;
+
+ int result = TCL_OK;
+
+ int defargc;
+ char **defargv = NULL;
+ Tcl_Obj **defobjv = NULL;
+ int configc = 0;
+ ItclVarDefn **configVars = NULL;
+ char **configVals = NULL;
+
+ int vi, argsLeft;
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+ CompiledLocal *argPtr;
+ CallFrame *framePtr;
+ Var *varPtr;
+ Tcl_Obj *objPtr, *listPtr;
+ char *value;
+
+ framePtr = (CallFrame*) _Tcl_GetCallFrame(interp, 0);
+ framePtr->objc = objc;
+ framePtr->objv = objv; /* ref counts for args are incremented below */
+
+ /*
+ * See if there is a current object context. We may need
+ * it later on.
+ */
+ (void) Itcl_GetContext(interp, &contextClass, &contextObj);
+ Tcl_ResetResult(interp);
+
+ /*
+ * Match the actual arguments against the procedure's formal
+ * parameters to compute local variables.
+ */
+ varPtr = framePtr->compiledLocals;
+
+ for (argsLeft=mcode->argcount, argPtr=mcode->arglist, objv++, objc--;
+ argsLeft > 0;
+ argPtr=argPtr->nextPtr, argsLeft--, varPtr++, objv++, objc--)
+ {
+ if (!TclIsVarArgument(argPtr)) {
+ panic("local variable %s is not argument but should be",
+ argPtr->name);
+ return TCL_ERROR;
+ }
+ if (TclIsVarTemporary(argPtr)) {
+ panic("local variable is temporary but should be an argument");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Handle the special case of the last formal being "args".
+ * When it occurs, assign it a list consisting of all the
+ * remaining actual arguments.
+ */
+ if ((argsLeft == 1) && (strcmp(argPtr->name, "args") == 0)) {
+ if (objc < 0) objc = 0;
+
+ listPtr = Tcl_NewListObj(objc, objv);
+ varPtr->value.objPtr = listPtr;
+ Tcl_IncrRefCount(listPtr); /* local var is a reference */
+ varPtr->flags &= ~VAR_UNDEFINED;
+ objc = 0;
+
+ break;
+ }
+
+ /*
+ * Handle the special case of the last formal being "config".
+ * When it occurs, treat all remaining arguments as public
+ * variable assignments. Set the local "config" variable
+ * to the list of public variables assigned.
+ */
+ else if ( (argsLeft == 1) &&
+ (strcmp(argPtr->name, "config") == 0) &&
+ contextObj )
+ {
+ /*
+ * If this is not an old-style method, discourage against
+ * the use of the "config" argument.
+ */
+ if ((mfunc->member->flags & ITCL_OLD_STYLE) == 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\"config\" argument is an anachronism\n",
+ "[incr Tcl] no longer supports the \"config\" argument.\n",
+ "Instead, use the \"args\" argument and then use the\n",
+ "built-in configure method to handle args like this:\n",
+ " eval configure $args",
+ (char*)NULL);
+ result = TCL_ERROR;
+ goto argErrors;
+ }
+
+ /*
+ * Otherwise, handle the "config" argument in the usual way...
+ * - parse all "-name value" assignments
+ * - set "config" argument to the list of variable names
+ */
+ if (objc > 0) { /* still have some arguments left? */
+
+ result = ItclParseConfig(interp, objc, objv, contextObj,
+ &configc, &configVars, &configVals);
+
+ if (result != TCL_OK) {
+ goto argErrors;
+ }
+
+ listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
+ for (vi=0; vi < configc; vi++) {
+ objPtr = Tcl_NewStringObj(
+ configVars[vi]->member->classDefn->name, -1);
+ Tcl_AppendToObj(objPtr, "::", -1);
+ Tcl_AppendToObj(objPtr, configVars[vi]->member->name, -1);
+
+ Tcl_ListObjAppendElement(interp, listPtr, objPtr);
+ }
+
+ varPtr->value.objPtr = listPtr;
+ Tcl_IncrRefCount(listPtr); /* local var is a reference */
+ varPtr->flags &= ~VAR_UNDEFINED;
+
+ objc = 0; /* all remaining args handled */
+ }
+
+ else if (argPtr->defValuePtr) {
+ value = Tcl_GetStringFromObj(argPtr->defValuePtr, (int*)NULL);
+
+ result = Tcl_SplitList(interp, value, &defargc, &defargv);
+ if (result != TCL_OK) {
+ goto argErrors;
+ }
+ defobjv = (Tcl_Obj**)ckalloc(
+ (unsigned)(defargc*sizeof(Tcl_Obj*))
+ );
+ for (vi=0; vi < defargc; vi++) {
+ objPtr = Tcl_NewStringObj(defargv[vi], -1);
+ Tcl_IncrRefCount(objPtr);
+ defobjv[vi] = objPtr;
+ }
+
+ result = ItclParseConfig(interp, defargc, defobjv, contextObj,
+ &configc, &configVars, &configVals);
+
+ if (result != TCL_OK) {
+ goto argErrors;
+ }
+
+ listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
+ for (vi=0; vi < configc; vi++) {
+ objPtr = Tcl_NewStringObj(
+ configVars[vi]->member->classDefn->name, -1);
+ Tcl_AppendToObj(objPtr, "::", -1);
+ Tcl_AppendToObj(objPtr, configVars[vi]->member->name, -1);
+
+ Tcl_ListObjAppendElement(interp, listPtr, objPtr);
+ }
+
+ varPtr->value.objPtr = listPtr;
+ Tcl_IncrRefCount(listPtr); /* local var is a reference */
+ varPtr->flags &= ~VAR_UNDEFINED;
+ }
+ else {
+ objPtr = Tcl_NewStringObj("", 0);
+ varPtr->value.objPtr = objPtr;
+ Tcl_IncrRefCount(objPtr); /* local var is a reference */
+ varPtr->flags &= ~VAR_UNDEFINED;
+ }
+ }
+
+ /*
+ * Resume the usual processing of arguments...
+ */
+ else if (objc > 0) { /* take next arg as value */
+ objPtr = *objv;
+ varPtr->value.objPtr = objPtr;
+ varPtr->flags &= ~VAR_UNDEFINED;
+ Tcl_IncrRefCount(objPtr); /* local var is a reference */
+ }
+ else if (argPtr->defValuePtr) { /* ...or use default value */
+ objPtr = argPtr->defValuePtr;
+ varPtr->value.objPtr = objPtr;
+ varPtr->flags &= ~VAR_UNDEFINED;
+ Tcl_IncrRefCount(objPtr); /* local var is a reference */
+ }
+ else {
+ if (mfunc) {
+ objPtr = Tcl_GetObjResult(interp);
+ Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
+ Itcl_GetMemberFuncUsage(mfunc, contextObj, objPtr);
+ Tcl_AppendToObj(objPtr, "\"", -1);
+ } else {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "no value given for parameter \"", argPtr->name, "\"",
+ (char*)NULL);
+ }
+ result = TCL_ERROR;
+ goto argErrors;
+ }
+ }
+
+ if (objc > 0) {
+ if (mfunc) {
+ objPtr = Tcl_GetObjResult(interp);
+ Tcl_AppendToObj(objPtr, "wrong # args: should be \"", -1);
+ Itcl_GetMemberFuncUsage(mfunc, contextObj, objPtr);
+ Tcl_AppendToObj(objPtr, "\"", -1);
+ } else {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "too many arguments",
+ (char*)NULL);
+ }
+ result = TCL_ERROR;
+ goto argErrors;
+ }
+
+ /*
+ * Handle any "config" assignments.
+ */
+ if (configc > 0) {
+ if (ItclHandleConfig(interp, configc, configVars, configVals,
+ contextObj) != TCL_OK) {
+
+ result = TCL_ERROR;
+ goto argErrors;
+ }
+ }
+
+ /*
+ * All arguments were successfully matched.
+ */
+ result = TCL_OK;
+
+ /*
+ * If any errors were found, clean up and return error status.
+ */
+argErrors:
+ if (defobjv) {
+ for (vi=0; vi < defargc; vi++) {
+ Tcl_DecrRefCount(defobjv[vi]);
+ }
+ ckfree((char*)defobjv);
+ }
+ if (defargv) {
+ ckfree((char*)defargv);
+ }
+ if (configVars) {
+ ckfree((char*)configVars);
+ }
+ if (configVals) {
+ ckfree((char*)configVals);
+ }
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclParseConfig()
+ *
+ * Parses a set of arguments as "-variable value" assignments.
+ * Interprets all variable names in the most-specific class scope,
+ * so that an inherited method with a "config" parameter will work
+ * correctly. Returns a list of public variable names and their
+ * corresponding values; both lists should passed to ItclHandleConfig()
+ * to perform assignments, and freed when no longer in use. Returns a
+ * status TCL_OK/TCL_ERROR and returns error messages in the interpreter.
+ * ------------------------------------------------------------------------
+ */
+static int
+ItclParseConfig(interp, objc, objv, contextObj, rargc, rvars, rvals)
+ Tcl_Interp *interp; /* interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+ ItclObject *contextObj; /* object whose public vars are being config'd */
+ int *rargc; /* return: number of variables accessed */
+ ItclVarDefn ***rvars; /* return: list of variables */
+ char ***rvals; /* return: list of values */
+{
+ int result = TCL_OK;
+ ItclVarLookup *vlookup;
+ Tcl_HashEntry *entry;
+ char *varName, *value;
+
+ if (objc < 0) objc = 0;
+ *rargc = 0;
+ *rvars = (ItclVarDefn**)ckalloc((unsigned)(objc*sizeof(ItclVarDefn*)));
+ *rvals = (char**)ckalloc((unsigned)(objc*sizeof(char*)));
+
+ while (objc-- > 0) {
+ /*
+ * Next argument should be "-variable"
+ */
+ varName = Tcl_GetStringFromObj(*objv, (int*)NULL);
+ if (*varName != '-') {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "syntax error in config assignment \"",
+ varName, "\": should be \"-variable value\"",
+ (char*)NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ else if (objc-- <= 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "syntax error in config assignment \"",
+ varName, "\": should be \"-variable value\" (missing value)",
+ (char*)NULL);
+ result = TCL_ERROR;
+ break;
+ }
+
+ entry = Tcl_FindHashEntry(&contextObj->classDefn->resolveVars,
+ varName+1);
+
+ if (entry) {
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+ value = Tcl_GetStringFromObj(*(objv+1), (int*)NULL);
+
+ (*rvars)[*rargc] = vlookup->vdefn; /* variable definition */
+ (*rvals)[*rargc] = value; /* config value */
+ (*rargc)++;
+ objv += 2;
+ }
+ else {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "syntax error in config assignment \"",
+ varName, "\": unrecognized variable",
+ (char*)NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ }
+ return result;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclHandleConfig()
+ *
+ * Handles the assignment of "config" values to public variables.
+ * The list of assignments is parsed in ItclParseConfig(), but the
+ * actual assignments are performed here. If the variables have any
+ * associated "config" code, it is invoked here as well. If errors
+ * are detected during assignment or "config" code execution, the
+ * variable is set back to its previous value and an error is returned.
+ *
+ * Returns a status TCL_OK/TCL_ERROR, and returns any error messages
+ * in the given interpreter.
+ * ------------------------------------------------------------------------
+ */
+static int
+ItclHandleConfig(interp, argc, vars, vals, contextObj)
+ Tcl_Interp *interp; /* interpreter currently in control */
+ int argc; /* number of assignments */
+ ItclVarDefn **vars; /* list of public variable definitions */
+ char **vals; /* list of public variable values */
+ ItclObject *contextObj; /* object whose public vars are being config'd */
+{
+ int result = TCL_OK;
+
+ int i;
+ char *val;
+ Tcl_DString lastval;
+ ItclContext context;
+ Tcl_CallFrame *oldFramePtr, *uplevelFramePtr;
+
+ Tcl_DStringInit(&lastval);
+
+ /*
+ * All "config" assignments are performed in the most-specific
+ * class scope, so that inherited methods with "config" arguments
+ * will work correctly.
+ */
+ result = Itcl_PushContext(interp, (ItclMember*)NULL,
+ contextObj->classDefn, contextObj, &context);
+
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Perform each assignment and execute the "config" code
+ * associated with each variable. If any errors are encountered,
+ * set the variable back to its previous value, and return an error.
+ */
+ for (i=0; i < argc; i++) {
+ val = Tcl_GetVar2(interp, vars[i]->member->fullname, (char*)NULL, 0);
+ if (!val) {
+ val = "";
+ }
+ Tcl_DStringSetLength(&lastval, 0);
+ Tcl_DStringAppend(&lastval, val, -1);
+
+ /*
+ * Set the variable to the specified value.
+ */
+ if (!Tcl_SetVar2(interp, vars[i]->member->fullname, (char*)NULL,
+ vals[i], 0)) {
+
+ char msg[256];
+ sprintf(msg, "\n (while configuring public variable \"%.100s\")", vars[i]->member->fullname);
+ Tcl_AddErrorInfo(interp, msg);
+ result = TCL_ERROR;
+ break;
+ }
+
+ /*
+ * If the variable has a "config" condition, then execute it.
+ * If it fails, put the variable back the way it was and return
+ * an error.
+ *
+ * TRICKY NOTE: Be careful to evaluate the code one level
+ * up in the call stack, so that it's executed in the
+ * calling context, and not in the context that we've
+ * set up for public variable access.
+ */
+ if (vars[i]->member->code) {
+
+ uplevelFramePtr = _Tcl_GetCallFrame(interp, 1);
+ oldFramePtr = _Tcl_ActivateCallFrame(interp, uplevelFramePtr);
+
+ result = Itcl_EvalMemberCode(interp, (ItclMemberFunc*)NULL,
+ vars[i]->member, contextObj, 0, (Tcl_Obj* CONST*)NULL);
+
+ (void) _Tcl_ActivateCallFrame(interp, oldFramePtr);
+
+ if (result != TCL_OK) {
+ char msg[256];
+ sprintf(msg, "\n (while configuring public variable \"%.100s\")", vars[i]->member->fullname);
+ Tcl_AddErrorInfo(interp, msg);
+ Tcl_SetVar2(interp, vars[i]->member->fullname, (char*)NULL,
+ Tcl_DStringValue(&lastval), 0);
+ break;
+ }
+ }
+ }
+
+ /*
+ * Clean up and return.
+ */
+ Itcl_PopContext(interp, &context);
+ Tcl_DStringFree(&lastval);
+
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ConstructBase()
+ *
+ * Usually invoked just before executing the body of a constructor
+ * when an object is first created. This procedure makes sure that
+ * all base classes are properly constructed. If an "initCode" fragment
+ * was defined with the constructor for the class, then it is invoked.
+ * After that, the list of base classes is checked for constructors
+ * that are defined but have not yet been invoked. Each of these is
+ * invoked implicitly with no arguments.
+ *
+ * Assumes that a local call frame is already installed, and that
+ * constructor arguments have already been matched and are sitting in
+ * this frame. Returns TCL_OK on success; otherwise, this procedure
+ * returns TCL_ERROR, along with an error message in the interpreter.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ConstructBase(interp, contextObj, contextClass)
+ Tcl_Interp *interp; /* interpreter */
+ ItclObject *contextObj; /* object being constructed */
+ ItclClass *contextClass; /* current class being constructed */
+{
+ int result;
+ Itcl_ListElem *elem;
+ ItclClass *cdefn;
+ Tcl_HashEntry *entry;
+
+ /*
+ * If the class has an "initCode", invoke it in the current context.
+ *
+ * TRICKY NOTE:
+ * This context is the call frame containing the arguments
+ * for the constructor. The "initCode" makes sense right
+ * now--just before the body of the constructor is executed.
+ */
+ if (contextClass->initCode) {
+ /* CYGNUS LOCAL - Fix for Tcl8.1 */
+#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ if (Tcl_EvalObj(interp, contextClass->initCode) != TCL_OK) {
+#else
+ if (Tcl_EvalObj(interp, contextClass->initCode, 0) != TCL_OK) {
+#endif
+ /* END CYGNUS LOCAL */
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Scan through the list of base classes and see if any of these
+ * have not been constructed. Invoke base class constructors
+ * implicitly, as needed. Go through the list of base classes
+ * in reverse order, so that least-specific classes are constructed
+ * first.
+ */
+ elem = Itcl_LastListElem(&contextClass->bases);
+ while (elem) {
+ cdefn = (ItclClass*)Itcl_GetListValue(elem);
+
+ if (!Tcl_FindHashEntry(contextObj->constructed, cdefn->name)) {
+
+ result = Itcl_InvokeMethodIfExists(interp, "constructor",
+ cdefn, contextObj, 0, (Tcl_Obj* CONST*)NULL);
+
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * The base class may not have a constructor, but its
+ * own base classes could have one. If the constructor
+ * wasn't found in the last step, then other base classes
+ * weren't constructed either. Make sure that all of its
+ * base classes are properly constructed.
+ */
+ entry = Tcl_FindHashEntry(&cdefn->functions, "constructor");
+ if (entry == NULL) {
+ result = Itcl_ConstructBase(interp, contextObj, cdefn);
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ }
+ elem = Itcl_PrevListElem(elem);
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_InvokeMethodIfExists()
+ *
+ * Looks for a particular method in the specified class. If the
+ * method is found, it is invoked with the given arguments. Any
+ * protection level (protected/private) for the method is ignored.
+ * If the method does not exist, this procedure does nothing.
+ *
+ * This procedure is used primarily to invoke the constructor/destructor
+ * when an object is created/destroyed.
+ *
+ * Returns TCL_OK on success; otherwise, this procedure returns
+ * TCL_ERROR along with an error message in the interpreter.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_InvokeMethodIfExists(interp, name, contextClass, contextObj, objc, objv)
+ Tcl_Interp *interp; /* interpreter */
+ char *name; /* name of desired method */
+ ItclClass *contextClass; /* current class being constructed */
+ ItclObject *contextObj; /* object being constructed */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int result = TCL_OK;
+
+ ItclMemberFunc *mfunc;
+ ItclMember *member;
+ Tcl_HashEntry *entry;
+ Tcl_Obj *cmdlinePtr;
+ int cmdlinec;
+ Tcl_Obj **cmdlinev;
+
+ /*
+ * Scan through the list of base classes and see if any of these
+ * have not been constructed. Invoke base class constructors
+ * implicitly, as needed. Go through the list of base classes
+ * in reverse order, so that least-specific classes are constructed
+ * first.
+ */
+ entry = Tcl_FindHashEntry(&contextClass->functions, name);
+
+ if (entry) {
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+ member = mfunc->member;
+
+ /*
+ * Prepend the method name to the list of arguments.
+ */
+ cmdlinePtr = Itcl_CreateArgs(interp, name, objc, objv);
+
+ (void) Tcl_ListObjGetElements((Tcl_Interp*)NULL, cmdlinePtr,
+ &cmdlinec, &cmdlinev);
+
+ /*
+ * Execute the code for the method. Be careful to protect
+ * the method in case it gets deleted during execution.
+ */
+ Itcl_PreserveData((ClientData)mfunc);
+
+ result = Itcl_EvalMemberCode(interp, mfunc, member,
+ contextObj, cmdlinec, cmdlinev);
+
+ result = Itcl_ReportFuncErrors(interp, mfunc,
+ contextObj, result);
+
+ Itcl_ReleaseData((ClientData)mfunc);
+ Tcl_DecrRefCount(cmdlinePtr);
+ }
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ReportFuncErrors()
+ *
+ * Used to interpret the status code returned when the body of a
+ * Tcl-style proc is executed. Handles the "errorInfo" and "errorCode"
+ * variables properly, and adds error information into the interpreter
+ * if anything went wrong. Returns a new status code that should be
+ * treated as the return status code for the command.
+ *
+ * This same operation is usually buried in the Tcl InterpProc()
+ * procedure. It is defined here so that it can be reused more easily.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ReportFuncErrors(interp, mfunc, contextObj, result)
+ Tcl_Interp* interp; /* interpreter being modified */
+ ItclMemberFunc *mfunc; /* command member that was invoked */
+ ItclObject *contextObj; /* object context for this command */
+ int result; /* integer status code from proc body */
+{
+ Interp* iPtr = (Interp*)interp;
+ Tcl_Obj *objPtr;
+ char num[20];
+
+ if (result != TCL_OK) {
+ if (result == TCL_RETURN) {
+ result = TclUpdateReturnInfo(iPtr);
+ }
+ else if (result == TCL_ERROR) {
+ objPtr = Tcl_NewStringObj("\n ", -1);
+ Tcl_IncrRefCount(objPtr);
+
+ if (mfunc->member->flags & ITCL_CONSTRUCTOR) {
+ Tcl_AppendToObj(objPtr, "while constructing object \"", -1);
+ Tcl_GetCommandFullName(contextObj->classDefn->interp,
+ contextObj->accessCmd, objPtr);
+ Tcl_AppendToObj(objPtr, "\" in ", -1);
+ Tcl_AppendToObj(objPtr, mfunc->member->fullname, -1);
+ if ((mfunc->member->code->flags & ITCL_IMPLEMENT_TCL) != 0) {
+ Tcl_AppendToObj(objPtr, " (", -1);
+ }
+ }
+
+ else if (mfunc->member->flags & ITCL_DESTRUCTOR) {
+ Tcl_AppendToObj(objPtr, "while deleting object \"", -1);
+ Tcl_GetCommandFullName(contextObj->classDefn->interp,
+ contextObj->accessCmd, objPtr);
+ Tcl_AppendToObj(objPtr, "\" in ", -1);
+ Tcl_AppendToObj(objPtr, mfunc->member->fullname, -1);
+ if ((mfunc->member->code->flags & ITCL_IMPLEMENT_TCL) != 0) {
+ Tcl_AppendToObj(objPtr, " (", -1);
+ }
+ }
+
+ else {
+ Tcl_AppendToObj(objPtr, "(", -1);
+
+ if (contextObj && contextObj->accessCmd) {
+ Tcl_AppendToObj(objPtr, "object \"", -1);
+ Tcl_GetCommandFullName(contextObj->classDefn->interp,
+ contextObj->accessCmd, objPtr);
+ Tcl_AppendToObj(objPtr, "\" ", -1);
+ }
+
+ if ((mfunc->member->flags & ITCL_COMMON) != 0) {
+ Tcl_AppendToObj(objPtr, "procedure", -1);
+ } else {
+ Tcl_AppendToObj(objPtr, "method", -1);
+ }
+ Tcl_AppendToObj(objPtr, " \"", -1);
+ Tcl_AppendToObj(objPtr, mfunc->member->fullname, -1);
+ Tcl_AppendToObj(objPtr, "\" ", -1);
+ }
+
+ if ((mfunc->member->code->flags & ITCL_IMPLEMENT_TCL) != 0) {
+ Tcl_AppendToObj(objPtr, "body line ", -1);
+ sprintf(num, "%d", iPtr->errorLine);
+ Tcl_AppendToObj(objPtr, num, -1);
+ Tcl_AppendToObj(objPtr, ")", -1);
+ } else {
+ Tcl_AppendToObj(objPtr, ")", -1);
+ }
+
+ Tcl_AddErrorInfo(interp, Tcl_GetStringFromObj(objPtr, (int*)NULL));
+ Tcl_DecrRefCount(objPtr);
+ }
+
+ else if (result == TCL_BREAK) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "invoked \"break\" outside of a loop", -1);
+ result = TCL_ERROR;
+ }
+
+ else if (result == TCL_CONTINUE) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendToObj(Tcl_GetObjResult(interp),
+ "invoked \"continue\" outside of a loop", -1);
+ result = TCL_ERROR;
+ }
+ }
+ return result;
+}
diff --git a/itcl/itcl/generic/itcl_migrate.c b/itcl/itcl/generic/itcl_migrate.c
new file mode 100644
index 00000000000..8eb5bc82433
--- /dev/null
+++ b/itcl/itcl/generic/itcl_migrate.c
@@ -0,0 +1,139 @@
+/*
+ * ------------------------------------------------------------------------
+ * PACKAGE: [incr Tcl]
+ * DESCRIPTION: Object-Oriented Extensions to Tcl
+ *
+ * This file contains procedures that belong in the Tcl/Tk core.
+ * Hopefully, they'll migrate there soon.
+ *
+ * ========================================================================
+ * AUTHOR: Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ * http://www.tcltk.com/itcl
+ *
+ * RCS: $Id$
+ * ========================================================================
+ * Copyright (c) 1993-1998 Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#include "itclInt.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * _Tcl_GetCallFrame --
+ *
+ * Checks the call stack and returns the call frame some number
+ * of levels up. It is often useful to know the invocation
+ * context for a command.
+ *
+ * Results:
+ * Returns a token for the call frame 0 or more levels up in
+ * the call stack.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_CallFrame*
+_Tcl_GetCallFrame(interp, level)
+ Tcl_Interp *interp; /* interpreter being queried */
+ int level; /* number of levels up in the call stack (>= 0) */
+{
+ Interp *iPtr = (Interp*)interp;
+ CallFrame *framePtr;
+
+ if (level < 0) {
+ panic("itcl: _Tcl_GetCallFrame called with bad number of levels");
+ }
+
+ framePtr = iPtr->varFramePtr;
+ while (framePtr && level > 0) {
+ framePtr = framePtr->callerVarPtr;
+ level--;
+ }
+ return (Tcl_CallFrame*)framePtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * _Tcl_ActivateCallFrame --
+ *
+ * Makes an existing call frame the current frame on the
+ * call stack. Usually called in conjunction with
+ * _Tcl_GetCallFrame to simulate the effect of an "uplevel"
+ * command.
+ *
+ * Note that this procedure is different from Tcl_PushCallFrame,
+ * which adds a new call frame to the call stack. This procedure
+ * assumes that the call frame is already initialized, and it
+ * merely activates it on the call stack.
+ *
+ * Results:
+ * Returns a token for the call frame that was in effect before
+ * activating the new context. That call frame can be restored
+ * by calling _Tcl_ActivateCallFrame again.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+Tcl_CallFrame*
+_Tcl_ActivateCallFrame(interp, framePtr)
+ Tcl_Interp *interp; /* interpreter being queried */
+ Tcl_CallFrame *framePtr; /* call frame to be activated */
+{
+ Interp *iPtr = (Interp*)interp;
+ CallFrame *oldFramePtr;
+
+ oldFramePtr = iPtr->varFramePtr;
+ iPtr->varFramePtr = (CallFrame *) framePtr;
+
+ return (Tcl_CallFrame *) oldFramePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * _TclNewVar --
+ *
+ * Create a new heap-allocated variable that will eventually be
+ * entered into a hashtable.
+ *
+ * Results:
+ * The return value is a pointer to the new variable structure. It is
+ * marked as a scalar variable (and not a link or array variable). Its
+ * value initially is NULL. The variable is not part of any hash table
+ * yet. Since it will be in a hashtable and not in a call frame, its
+ * name field is set NULL. It is initially marked as undefined.
+ *
+ * Side effects:
+ * Storage gets allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Var *
+_TclNewVar()
+{
+ register Var *varPtr;
+
+ varPtr = (Var *) ckalloc(sizeof(Var));
+ varPtr->value.objPtr = NULL;
+ varPtr->name = NULL;
+ varPtr->nsPtr = NULL;
+ varPtr->hPtr = NULL;
+ varPtr->refCount = 0;
+ varPtr->tracePtr = NULL;
+ varPtr->searchPtr = NULL;
+ varPtr->flags = (VAR_SCALAR | VAR_UNDEFINED | VAR_IN_HASHTABLE);
+ return varPtr;
+}
diff --git a/itcl/itcl/generic/itcl_objects.c b/itcl/itcl/generic/itcl_objects.c
new file mode 100644
index 00000000000..fa1ab2ff21f
--- /dev/null
+++ b/itcl/itcl/generic/itcl_objects.c
@@ -0,0 +1,1202 @@
+/*
+ * ------------------------------------------------------------------------
+ * PACKAGE: [incr Tcl]
+ * DESCRIPTION: Object-Oriented Extensions to Tcl
+ *
+ * [incr Tcl] provides object-oriented extensions to Tcl, much as
+ * C++ provides object-oriented extensions to C. It provides a means
+ * of encapsulating related procedures together with their shared data
+ * in a local namespace that is hidden from the outside world. It
+ * promotes code re-use through inheritance. More than anything else,
+ * it encourages better organization of Tcl applications through the
+ * object-oriented paradigm, leading to code that is easier to
+ * understand and maintain.
+ *
+ * This segment handles "objects" which are instantiated from class
+ * definitions. Objects contain public/protected/private data members
+ * from all classes in a derivation hierarchy.
+ *
+ * ========================================================================
+ * AUTHOR: Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ * http://www.tcltk.com/itcl
+ *
+ * RCS: $Id$
+ * ========================================================================
+ * Copyright (c) 1993-1998 Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#include "itclInt.h"
+
+/*
+ * FORWARD DECLARATIONS
+ */
+static void ItclReportObjectUsage _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclObject* obj));
+
+static char* ItclTraceThisVar _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, char *name1, char *name2, int flags));
+
+static void ItclDestroyObject _ANSI_ARGS_((ClientData cdata));
+static void ItclFreeObject _ANSI_ARGS_((char* cdata));
+
+static int ItclDestructBase _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclObject* obj, ItclClass* cdefn, int flags));
+
+static void ItclCreateObjVar _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclVarDefn* vdefn, ItclObject* obj));
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_CreateObject()
+ *
+ * Creates a new object instance belonging to the given class.
+ * Supports complex object names like "namesp::namesp::name" by
+ * following the namespace path and creating the object in the
+ * desired namespace.
+ *
+ * Automatically creates and initializes data members, including the
+ * built-in protected "this" variable containing the object name.
+ * Installs an access command in the current namespace, and invokes
+ * the constructor to initialize the object.
+ *
+ * If any errors are encountered, the object is destroyed and this
+ * procedure returns TCL_ERROR (along with an error message in the
+ * interpreter). Otherwise, it returns TCL_OK, along with a pointer
+ * to the new object data in roPtr.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_CreateObject(interp, name, cdefn, objc, objv, roPtr)
+ Tcl_Interp *interp; /* interpreter mananging new object */
+ char* name; /* name of new object */
+ ItclClass *cdefn; /* class for new object */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+ ItclObject **roPtr; /* returns: pointer to object data */
+{
+ ItclClass *cdefnPtr = (ItclClass*)cdefn;
+ int result = TCL_OK;
+
+ char *head, *tail;
+ Tcl_DString buffer, objName;
+ Tcl_Namespace *parentNs;
+ ItclContext context;
+ Tcl_Command cmd;
+ ItclObject *newObj;
+ ItclClass *cdPtr;
+ ItclVarDefn *vdefn;
+ ItclHierIter hier;
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch place;
+ int newEntry;
+ Itcl_InterpState istate;
+
+ /*
+ * If installing an object access command will clobber another
+ * command, signal an error.
+ */
+ cmd = Tcl_FindCommand(interp, name, (Tcl_Namespace*)NULL, /* flags */ 0);
+ if (cmd != NULL && !Itcl_IsStub(cmd)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "command \"", name, "\" already exists in namespace \"",
+ Tcl_GetCurrentNamespace(interp)->fullName, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Extract the namespace context and the simple object
+ * name for the new object.
+ */
+ Itcl_ParseNamespPath(name, &buffer, &head, &tail);
+ if (head) {
+ parentNs = Itcl_FindClassNamespace(interp, head);
+
+ if (!parentNs) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "namespace \"", head, "\" not found in context \"",
+ Tcl_GetCurrentNamespace(interp)->fullName, "\"",
+ (char*)NULL);
+ Tcl_DStringFree(&buffer);
+ return TCL_ERROR;
+ }
+ } else {
+ parentNs = Tcl_GetCurrentNamespace(interp);
+ }
+
+ Tcl_DStringInit(&objName);
+ if (parentNs != Tcl_GetGlobalNamespace(interp)) {
+ Tcl_DStringAppend(&objName, parentNs->fullName, -1);
+ }
+ Tcl_DStringAppend(&objName, "::", -1);
+ Tcl_DStringAppend(&objName, tail, -1);
+
+ /*
+ * Create a new object and initialize it.
+ */
+ newObj = (ItclObject*)ckalloc(sizeof(ItclObject));
+ newObj->classDefn = cdefnPtr;
+ Itcl_PreserveData((ClientData)cdefnPtr);
+
+ newObj->dataSize = cdefnPtr->numInstanceVars;
+ newObj->data = (Var**)ckalloc((unsigned)(newObj->dataSize*sizeof(Var*)));
+
+ newObj->constructed = (Tcl_HashTable*)ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(newObj->constructed, TCL_STRING_KEYS);
+ newObj->destructed = NULL;
+
+ /*
+ * Add a command to the current namespace with the object name.
+ * This is done before invoking the constructors so that the
+ * command can be used during construction to query info.
+ */
+ Itcl_PreserveData((ClientData)newObj);
+ newObj->accessCmd = Tcl_CreateObjCommand(interp,
+ Tcl_DStringValue(&objName), Itcl_HandleInstance,
+ (ClientData)newObj, ItclDestroyObject);
+
+ Itcl_PreserveData((ClientData)newObj); /* while we're using this... */
+ Itcl_EventuallyFree((ClientData)newObj, ItclFreeObject);
+
+ Tcl_DStringFree(&buffer);
+ Tcl_DStringFree(&objName);
+
+ /*
+ * Install the class namespace and object context so that
+ * the object's data members can be initialized via simple
+ * "set" commands.
+ */
+ if (Itcl_PushContext(interp, (ItclMember*)NULL, cdefnPtr, newObj,
+ &context) != TCL_OK) {
+
+ return TCL_ERROR;
+ }
+
+ Itcl_InitHierIter(&hier, cdefn);
+
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ while (cdPtr != NULL) {
+ entry = Tcl_FirstHashEntry(&cdPtr->variables, &place);
+ while (entry) {
+ vdefn = (ItclVarDefn*)Tcl_GetHashValue(entry);
+ if ((vdefn->member->flags & ITCL_THIS_VAR) != 0) {
+ if (cdPtr == cdefnPtr) {
+ ItclCreateObjVar(interp, vdefn, newObj);
+ Tcl_SetVar2(interp, "this", (char*)NULL, "", 0);
+ Tcl_TraceVar2(interp, "this", (char*)NULL,
+ TCL_TRACE_READS|TCL_TRACE_WRITES, ItclTraceThisVar,
+ (ClientData)newObj);
+ }
+ }
+ else if ( (vdefn->member->flags & ITCL_COMMON) == 0) {
+ ItclCreateObjVar(interp, vdefn, newObj);
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ }
+ Itcl_DeleteHierIter(&hier);
+
+ Itcl_PopContext(interp, &context); /* back to calling context */
+
+ /*
+ * Now construct the object. Look for a constructor in the
+ * most-specific class, and if there is one, invoke it.
+ * This will cause a chain reaction, making sure that all
+ * base classes constructors are invoked as well, in order
+ * from least- to most-specific. Any constructors that are
+ * not called out explicitly in "initCode" code fragments are
+ * invoked implicitly without arguments.
+ */
+ result = Itcl_InvokeMethodIfExists(interp, "constructor",
+ cdefn, newObj, objc, objv);
+
+ /*
+ * If there is no constructor, construct the base classes
+ * in case they have constructors. This will cause the
+ * same chain reaction.
+ */
+ if (!Tcl_FindHashEntry(&cdefn->functions, "constructor")) {
+ result = Itcl_ConstructBase(interp, newObj, cdefn);
+ }
+
+ /*
+ * If construction failed, then delete the object access
+ * command. This will destruct the object and delete the
+ * object data. Be careful to save and restore the interpreter
+ * state, since the destructors may generate errors of their own.
+ */
+ if (result != TCL_OK) {
+ istate = Itcl_SaveInterpState(interp, result);
+ if (newObj->accessCmd != NULL) {
+ Tcl_DeleteCommandFromToken(interp, newObj->accessCmd);
+ newObj->accessCmd = NULL;
+ }
+ result = Itcl_RestoreInterpState(interp, istate);
+ }
+
+ /*
+ * At this point, the object is fully constructed.
+ * Destroy the "constructed" table in the object data, since
+ * it is no longer needed.
+ */
+ Tcl_DeleteHashTable(newObj->constructed);
+ ckfree((char*)newObj->constructed);
+ newObj->constructed = NULL;
+
+ /*
+ * Add it to the list of all known objects.
+ */
+ if (result == TCL_OK) {
+ entry = Tcl_CreateHashEntry(&cdefnPtr->info->objects,
+ (char*)newObj->accessCmd, &newEntry);
+
+ Tcl_SetHashValue(entry, (ClientData)newObj);
+ }
+
+ /*
+ * Release the object. If it was destructed above, it will
+ * die at this point.
+ */
+ Itcl_ReleaseData((ClientData)newObj);
+
+ *roPtr = newObj;
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_DeleteObject()
+ *
+ * Attempts to delete an object by invoking its destructor.
+ *
+ * If the destructor is successful, then the object is deleted by
+ * removing its access command, and this procedure returns TCL_OK.
+ * Otherwise, the object will remain alive, and this procedure
+ * returns TCL_ERROR (along with an error message in the interpreter).
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_DeleteObject(interp, contextObj)
+ Tcl_Interp *interp; /* interpreter mananging object */
+ ItclObject *contextObj; /* object to be deleted */
+{
+ ItclClass *cdefnPtr = (ItclClass*)contextObj->classDefn;
+
+ Tcl_HashEntry *entry;
+ Command *cmdPtr;
+
+ Itcl_PreserveData((ClientData)contextObj);
+
+ /*
+ * Invoke the object's destructors.
+ */
+ if (Itcl_DestructObject(interp, contextObj, 0) != TCL_OK) {
+ Itcl_ReleaseData((ClientData)contextObj);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Remove the object from the global list.
+ */
+ entry = Tcl_FindHashEntry(&cdefnPtr->info->objects,
+ (char*)contextObj->accessCmd);
+
+ if (entry) {
+ Tcl_DeleteHashEntry(entry);
+ }
+
+ /*
+ * Change the object's access command so that it can be
+ * safely deleted without attempting to destruct the object
+ * again. Then delete the access command. If this is
+ * the last use of the object data, the object will die here.
+ */
+ cmdPtr = (Command*)contextObj->accessCmd;
+ cmdPtr->deleteProc = Itcl_ReleaseData;
+
+ Tcl_DeleteCommandFromToken(interp, contextObj->accessCmd);
+ contextObj->accessCmd = NULL;
+
+ Itcl_ReleaseData((ClientData)contextObj); /* object should die here */
+
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_DestructObject()
+ *
+ * Invokes the destructor for a particular object. Usually invoked
+ * by Itcl_DeleteObject() or Itcl_DestroyObject() as a part of the
+ * object destruction process. If the ITCL_IGNORE_ERRS flag is
+ * included, all destructors are invoked even if errors are
+ * encountered, and the result will always be TCL_OK.
+ *
+ * Returns TCL_OK on success, or TCL_ERROR (along with an error
+ * message in the interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_DestructObject(interp, contextObj, flags)
+ Tcl_Interp *interp; /* interpreter mananging new object */
+ ItclObject *contextObj; /* object to be destructed */
+ int flags; /* flags: ITCL_IGNORE_ERRS */
+{
+ int result;
+
+ /*
+ * If there is a "destructed" table, then this object is already
+ * being destructed. Flag an error, unless errors are being
+ * ignored.
+ */
+ if (contextObj->destructed) {
+ if ((flags & ITCL_IGNORE_ERRS) == 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "can't delete an object while it is being destructed",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Create a "destructed" table to keep track of which destructors
+ * have been invoked. This is used in ItclDestructBase to make
+ * sure that all base class destructors have been called,
+ * explicitly or implicitly.
+ */
+ contextObj->destructed = (Tcl_HashTable*)ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(contextObj->destructed, TCL_STRING_KEYS);
+
+ /*
+ * Destruct the object starting from the most-specific class.
+ * If all goes well, return the null string as the result.
+ */
+ result = ItclDestructBase(interp, contextObj, contextObj->classDefn, flags);
+
+ if (result == TCL_OK) {
+ Tcl_ResetResult(interp);
+ }
+
+ Tcl_DeleteHashTable(contextObj->destructed);
+ ckfree((char*)contextObj->destructed);
+ contextObj->destructed = NULL;
+
+ return result;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclDestructBase()
+ *
+ * Invoked by Itcl_DestructObject() to recursively destruct an object
+ * from the specified class level. Finds and invokes the destructor
+ * for the specified class, and then recursively destructs all base
+ * classes. If the ITCL_IGNORE_ERRS flag is included, all destructors
+ * are invoked even if errors are encountered, and the result will
+ * always be TCL_OK.
+ *
+ * Returns TCL_OK on success, or TCL_ERROR (along with an error message
+ * in interp->result) on error.
+ * ------------------------------------------------------------------------
+ */
+static int
+ItclDestructBase(interp, contextObj, contextClass, flags)
+ Tcl_Interp *interp; /* interpreter */
+ ItclObject *contextObj; /* object being destructed */
+ ItclClass *contextClass; /* current class being destructed */
+ int flags; /* flags: ITCL_IGNORE_ERRS */
+{
+ int result;
+ Itcl_ListElem *elem;
+ ItclClass *cdefn;
+
+ /*
+ * Look for a destructor in this class, and if found,
+ * invoke it.
+ */
+ if (!Tcl_FindHashEntry(contextObj->destructed, contextClass->name)) {
+
+ result = Itcl_InvokeMethodIfExists(interp, "destructor",
+ contextClass, contextObj, 0, (Tcl_Obj* CONST*)NULL);
+
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Scan through the list of base classes recursively and destruct
+ * them. Traverse the list in normal order, so that we destruct
+ * from most- to least-specific.
+ */
+ elem = Itcl_FirstListElem(&contextClass->bases);
+ while (elem) {
+ cdefn = (ItclClass*)Itcl_GetListValue(elem);
+
+ if (ItclDestructBase(interp, contextObj, cdefn, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ elem = Itcl_NextListElem(elem);
+ }
+
+ /*
+ * Throw away any result from the destructors and return.
+ */
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_FindObject()
+ *
+ * Searches for an object with the specified name, which have
+ * namespace scope qualifiers like "namesp::namesp::name", or may
+ * be a scoped value such as "namespace inscope ::foo obj".
+ *
+ * If an error is encountered, this procedure returns TCL_ERROR
+ * along with an error message in the interpreter. Otherwise, it
+ * returns TCL_OK. If an object was found, "roPtr" returns a
+ * pointer to the object data. Otherwise, it returns NULL.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_FindObject(interp, name, roPtr)
+ Tcl_Interp *interp; /* interpreter containing this object */
+ char *name; /* name of the object */
+ ItclObject **roPtr; /* returns: object data or NULL */
+{
+ Tcl_Namespace *contextNs = NULL;
+
+ char *cmdName;
+ Tcl_Command cmd;
+ Command *cmdPtr;
+
+ /*
+ * The object name may be a scoped value of the form
+ * "namespace inscope <namesp> <command>". If it is,
+ * decode it.
+ */
+ if (Itcl_DecodeScopedCommand(interp, name, &contextNs, &cmdName)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look for the object's access command, and see if it has
+ * the appropriate command handler.
+ */
+ cmd = Tcl_FindCommand(interp, cmdName, contextNs, /* flags */ 0);
+ if (cmd != NULL && Itcl_IsObject(cmd)) {
+ cmdPtr = (Command*)cmd;
+ *roPtr = (ItclObject*)cmdPtr->objClientData;
+ }
+ else {
+ *roPtr = NULL;
+ }
+
+ if (cmdName != name) {
+ ckfree(cmdName);
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_IsObject()
+ *
+ * Checks the given Tcl command to see if it represents an itcl object.
+ * Returns non-zero if the command is associated with an object.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_IsObject(cmd)
+ Tcl_Command cmd; /* command being tested */
+{
+ Command *cmdPtr = (Command*)cmd;
+
+ if (cmdPtr->deleteProc == ItclDestroyObject) {
+ return 1;
+ }
+
+ /*
+ * This may be an imported command. Try to get the real
+ * command and see if it represents an object.
+ */
+ cmdPtr = (Command*)TclGetOriginalCommand(cmd);
+ if (cmdPtr && cmdPtr->deleteProc == ItclDestroyObject) {
+ return 1;
+ }
+ return 0;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ObjectIsa()
+ *
+ * Checks to see if an object belongs to the given class. An object
+ * "is-a" member of the class if the class appears anywhere in its
+ * inheritance hierarchy. Returns non-zero if the object belongs to
+ * the class, and zero otherwise.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ObjectIsa(contextObj, cdefn)
+ ItclObject *contextObj; /* object being tested */
+ ItclClass *cdefn; /* class to test for "is-a" relationship */
+{
+ Tcl_HashEntry *entry;
+ entry = Tcl_FindHashEntry(&contextObj->classDefn->heritage, (char*)cdefn);
+ return (entry != NULL);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_HandleInstance()
+ *
+ * Invoked by Tcl whenever the user issues a command associated with
+ * an object instance. Handles the following syntax:
+ *
+ * <objName> <method> <args>...
+ *
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_HandleInstance(clientData, interp, objc, objv)
+ ClientData clientData; /* object definition */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclObject *contextObj = (ItclObject*)clientData;
+
+ int result;
+ char *token;
+ Tcl_HashEntry *entry;
+ ItclMemberFunc *mfunc;
+ ItclObjectInfo *info;
+ ItclContext context;
+ CallFrame *framePtr;
+
+ if (objc < 2) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be one of...",
+ (char*)NULL);
+ ItclReportObjectUsage(interp, contextObj);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that the specified operation is really an
+ * object method, and it is accessible. If not, return usage
+ * information for the object.
+ */
+ token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ mfunc = NULL;
+
+ entry = Tcl_FindHashEntry(&contextObj->classDefn->resolveCmds, token);
+ if (entry) {
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+
+ if ((mfunc->member->flags & ITCL_COMMON) != 0) {
+ mfunc = NULL;
+ }
+ else if (mfunc->member->protection != ITCL_PUBLIC) {
+ Tcl_Namespace *contextNs = Itcl_GetTrueNamespace(interp,
+ mfunc->member->classDefn->info);
+
+ if (!Itcl_CanAccessFunc(mfunc, contextNs)) {
+ mfunc = NULL;
+ }
+ }
+ }
+
+ if ( !mfunc && (*token != 'i' || strcmp(token,"info") != 0) ) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad option \"", token, "\": should be one of...",
+ (char*)NULL);
+ ItclReportObjectUsage(interp, contextObj);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Install an object context and invoke the method.
+ *
+ * TRICKY NOTE: We need to pass the object context into the
+ * method, but activating the context here puts us one level
+ * down, and when the method is called, it will activate its
+ * own context, putting us another level down. If anyone
+ * were to execute an "uplevel" command in the method, they
+ * would notice the extra call frame. So we mark this frame
+ * as "transparent" and Itcl_EvalMemberCode will automatically
+ * do an "uplevel" operation to correct the problem.
+ */
+ info = contextObj->classDefn->info;
+
+ if (Itcl_PushContext(interp, (ItclMember*)NULL, contextObj->classDefn,
+ contextObj, &context) != TCL_OK) {
+
+ return TCL_ERROR;
+ }
+
+ framePtr = &context.frame;
+ Itcl_PushStack((ClientData)framePtr, &info->transparentFrames);
+
+ result = Itcl_EvalArgs(interp, objc-1, objv+1);
+
+ Itcl_PopStack(&info->transparentFrames);
+ Itcl_PopContext(interp, &context);
+
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_GetInstanceVar()
+ *
+ * Returns the current value for an object data member. The member
+ * name is interpreted with respect to the given class scope, which
+ * is usually the most-specific class for the object.
+ *
+ * If successful, this procedure returns a pointer to a string value
+ * which remains alive until the variable changes it value. If
+ * anything goes wrong, this returns NULL.
+ * ------------------------------------------------------------------------
+ */
+char*
+Itcl_GetInstanceVar(interp, name, contextObj, contextClass)
+ Tcl_Interp *interp; /* current interpreter */
+ char *name; /* name of desired instance variable */
+ ItclObject *contextObj; /* current object */
+ ItclClass *contextClass; /* name is interpreted in this scope */
+{
+ ItclContext context;
+ char *val;
+
+ /*
+ * Make sure that the current namespace context includes an
+ * object that is being manipulated.
+ */
+ if (contextObj == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot access object-specific info without an object context",
+ (char*)NULL);
+ return NULL;
+ }
+
+ /*
+ * Install the object context and access the data member
+ * like any other variable.
+ */
+ if (Itcl_PushContext(interp, (ItclMember*)NULL, contextClass,
+ contextObj, &context) != TCL_OK) {
+
+ return NULL;
+ }
+
+ val = Tcl_GetVar2(interp, name, (char*)NULL, TCL_LEAVE_ERR_MSG);
+ Itcl_PopContext(interp, &context);
+
+ return val;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclReportObjectUsage()
+ *
+ * Appends information to the given interp summarizing the usage
+ * for all of the methods available for this object. Useful when
+ * reporting errors in Itcl_HandleInstance().
+ * ------------------------------------------------------------------------
+ */
+static void
+ItclReportObjectUsage(interp, contextObj)
+ Tcl_Interp *interp; /* current interpreter */
+ ItclObject *contextObj; /* current object */
+{
+ ItclClass *cdefnPtr = (ItclClass*)contextObj->classDefn;
+ int ignore = ITCL_CONSTRUCTOR | ITCL_DESTRUCTOR | ITCL_COMMON;
+
+ int cmp;
+ char *name;
+ Itcl_List cmdList;
+ Itcl_ListElem *elem;
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch place;
+ ItclMemberFunc *mfunc, *cmpDefn;
+ Tcl_Obj *resultPtr;
+
+ /*
+ * Scan through all methods in the virtual table and sort
+ * them in alphabetical order. Report only the methods
+ * that have simple names (no ::'s) and are accessible.
+ */
+ Itcl_InitList(&cmdList);
+ entry = Tcl_FirstHashEntry(&cdefnPtr->resolveCmds, &place);
+ while (entry) {
+ name = Tcl_GetHashKey(&cdefnPtr->resolveCmds, entry);
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+
+ if (strstr(name,"::") || (mfunc->member->flags & ignore) != 0) {
+ mfunc = NULL;
+ }
+ else if (mfunc->member->protection != ITCL_PUBLIC) {
+ Tcl_Namespace *contextNs = Itcl_GetTrueNamespace(interp,
+ mfunc->member->classDefn->info);
+
+ if (!Itcl_CanAccessFunc(mfunc, contextNs)) {
+ mfunc = NULL;
+ }
+ }
+
+ if (mfunc) {
+ elem = Itcl_FirstListElem(&cmdList);
+ while (elem) {
+ cmpDefn = (ItclMemberFunc*)Itcl_GetListValue(elem);
+ cmp = strcmp(mfunc->member->name, cmpDefn->member->name);
+ if (cmp < 0) {
+ Itcl_InsertListElem(elem, (ClientData)mfunc);
+ mfunc = NULL;
+ break;
+ }
+ else if (cmp == 0) {
+ mfunc = NULL;
+ break;
+ }
+ elem = Itcl_NextListElem(elem);
+ }
+ if (mfunc) {
+ Itcl_AppendList(&cmdList, (ClientData)mfunc);
+ }
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+
+ /*
+ * Add a series of statements showing usage info.
+ */
+ resultPtr = Tcl_GetObjResult(interp);
+ elem = Itcl_FirstListElem(&cmdList);
+ while (elem) {
+ mfunc = (ItclMemberFunc*)Itcl_GetListValue(elem);
+ Tcl_AppendToObj(resultPtr, "\n ", -1);
+ Itcl_GetMemberFuncUsage(mfunc, contextObj, resultPtr);
+
+ elem = Itcl_NextListElem(elem);
+ }
+ Itcl_DeleteList(&cmdList);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclTraceThisVar()
+ *
+ * Invoked to handle read/write traces on the "this" variable built
+ * into each object.
+ *
+ * On read, this procedure updates the "this" variable to contain the
+ * current object name. This is done dynamically, since an object's
+ * identity can change if its access command is renamed.
+ *
+ * On write, this procedure returns an error string, warning that
+ * the "this" variable cannot be set.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static char*
+ItclTraceThisVar(cdata, interp, name1, name2, flags)
+ ClientData cdata; /* object instance data */
+ Tcl_Interp *interp; /* interpreter managing this variable */
+ char *name1; /* variable name */
+ char *name2; /* unused */
+ int flags; /* flags indicating read/write */
+{
+ ItclObject *contextObj = (ItclObject*)cdata;
+ char *objName;
+ Tcl_Obj *objPtr;
+
+ /*
+ * Handle read traces on "this"
+ */
+ if ((flags & TCL_TRACE_READS) != 0) {
+ objPtr = Tcl_NewStringObj("", -1);
+ Tcl_IncrRefCount(objPtr);
+
+ if (contextObj->accessCmd) {
+ Tcl_GetCommandFullName(contextObj->classDefn->interp,
+ contextObj->accessCmd, objPtr);
+ }
+
+ objName = Tcl_GetStringFromObj(objPtr, (int*)NULL);
+ Tcl_SetVar(interp, name1, objName, 0);
+
+ Tcl_DecrRefCount(objPtr);
+ return NULL;
+ }
+
+ /*
+ * Handle write traces on "this"
+ */
+ if ((flags & TCL_TRACE_WRITES) != 0) {
+ return "variable \"this\" cannot be modified";
+ }
+ return NULL;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclDestroyObject()
+ *
+ * Invoked when the object access command is deleted to implicitly
+ * destroy the object. Invokes the object's destructors, ignoring
+ * any errors encountered along the way. Removes the object from
+ * the list of all known objects and releases the access command's
+ * claim to the object data.
+ *
+ * Note that the usual way to delete an object is via Itcl_DeleteObject().
+ * This procedure is provided as a back-up, to handle the case when
+ * an object is deleted by removing its access command.
+ * ------------------------------------------------------------------------
+ */
+static void
+ItclDestroyObject(cdata)
+ ClientData cdata; /* object instance data */
+{
+ ItclObject *contextObj = (ItclObject*)cdata;
+ ItclClass *cdefnPtr = (ItclClass*)contextObj->classDefn;
+ Tcl_HashEntry *entry;
+ Itcl_InterpState istate;
+
+ /*
+ * Attempt to destruct the object, but ignore any errors.
+ */
+ istate = Itcl_SaveInterpState(cdefnPtr->interp, 0);
+ Itcl_DestructObject(cdefnPtr->interp, contextObj, ITCL_IGNORE_ERRS);
+ Itcl_RestoreInterpState(cdefnPtr->interp, istate);
+
+ /*
+ * Now, remove the object from the global object list.
+ * We're careful to do this here, after calling the destructors.
+ * Once the access command is nulled out, the "this" variable
+ * won't work properly.
+ */
+ if (contextObj->accessCmd) {
+ entry = Tcl_FindHashEntry(&cdefnPtr->info->objects,
+ (char*)contextObj->accessCmd);
+
+ if (entry) {
+ Tcl_DeleteHashEntry(entry);
+ }
+ contextObj->accessCmd = NULL;
+ }
+
+ Itcl_ReleaseData((ClientData)contextObj);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclFreeObject()
+ *
+ * Deletes all instance variables and frees all memory associated with
+ * the given object instance. This is usually invoked automatically
+ * by Itcl_ReleaseData(), when an object's data is no longer being used.
+ * ------------------------------------------------------------------------
+ */
+static void
+ItclFreeObject(cdata)
+ char* cdata; /* object instance data */
+{
+ ItclObject *contextObj = (ItclObject*)cdata;
+ Tcl_Interp *interp = contextObj->classDefn->interp;
+
+ int i;
+ ItclClass *cdPtr;
+ ItclHierIter hier;
+ Tcl_HashSearch place;
+ Tcl_HashEntry *entry;
+ ItclVarDefn *vdefn;
+ ItclContext context;
+ Itcl_InterpState istate;
+
+ /*
+ * Install the class namespace and object context so that
+ * the object's data members can be destroyed via simple
+ * "unset" commands. This makes sure that traces work properly
+ * and all memory gets cleaned up.
+ *
+ * NOTE: Be careful to save and restore the interpreter state.
+ * Data can get freed in the middle of any operation, and
+ * we can't affort to clobber the interpreter with any errors
+ * from below.
+ */
+ istate = Itcl_SaveInterpState(interp, 0);
+
+ /*
+ * Scan through all object-specific data members and destroy the
+ * actual variables that maintain the object state. Do this
+ * by unsetting each variable, so that traces are fired off
+ * correctly. Make sure that the built-in "this" variable is
+ * only destroyed once. Also, be careful to activate the
+ * namespace for each class, so that private variables can
+ * be accessed.
+ */
+ Itcl_InitHierIter(&hier, contextObj->classDefn);
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ while (cdPtr != NULL) {
+
+ if (Itcl_PushContext(interp, (ItclMember*)NULL, cdPtr,
+ contextObj, &context) == TCL_OK) {
+
+ entry = Tcl_FirstHashEntry(&cdPtr->variables, &place);
+ while (entry) {
+ vdefn = (ItclVarDefn*)Tcl_GetHashValue(entry);
+ if ((vdefn->member->flags & ITCL_THIS_VAR) != 0) {
+ if (cdPtr == contextObj->classDefn) {
+ Tcl_UnsetVar2(interp, vdefn->member->fullname,
+ (char*)NULL, 0);
+ }
+ }
+ else if ((vdefn->member->flags & ITCL_COMMON) == 0) {
+ Tcl_UnsetVar2(interp, vdefn->member->fullname,
+ (char*)NULL, 0);
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+ Itcl_PopContext(interp, &context);
+ }
+
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ }
+ Itcl_DeleteHierIter(&hier);
+
+ /*
+ * Free the memory associated with object-specific variables.
+ * For normal variables this would be done automatically by
+ * CleanupVar() when the variable is unset. But object-specific
+ * variables are protected by an extra reference count, and they
+ * must be deleted explicitly here.
+ */
+ for (i=0; i < contextObj->dataSize; i++) {
+ if (contextObj->data[i]) {
+ ckfree((char*)contextObj->data[i]);
+ }
+ }
+
+ Itcl_RestoreInterpState(interp, istate);
+
+ /*
+ * Free any remaining memory associated with the object.
+ */
+ ckfree((char*)contextObj->data);
+
+ if (contextObj->constructed) {
+ Tcl_DeleteHashTable(contextObj->constructed);
+ ckfree((char*)contextObj->constructed);
+ }
+ if (contextObj->destructed) {
+ Tcl_DeleteHashTable(contextObj->destructed);
+ ckfree((char*)contextObj->destructed);
+ }
+ Itcl_ReleaseData((ClientData)contextObj->classDefn);
+
+ ckfree((char*)contextObj);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclCreateObjVar()
+ *
+ * Creates one variable acting as a data member for a specific
+ * object. Initializes the variable according to its definition,
+ * and sets up its reference count so that it cannot be deleted
+ * by ordinary means. Installs the new variable directly into
+ * the data array for the specified object.
+ * ------------------------------------------------------------------------
+ */
+static void
+ItclCreateObjVar(interp, vdefn, contextObj)
+ Tcl_Interp* interp; /* interpreter managing this object */
+ ItclVarDefn* vdefn; /* variable definition */
+ ItclObject* contextObj; /* object being updated */
+{
+ Var *varPtr;
+ Tcl_HashEntry *entry;
+ ItclVarLookup *vlookup;
+ ItclContext context;
+
+ varPtr = _TclNewVar();
+ varPtr->name = vdefn->member->name;
+ varPtr->nsPtr = (Namespace*)vdefn->member->classDefn->namesp;
+
+ /*
+ * NOTE: Tcl reports a "dangling upvar" error for variables
+ * with a null "hPtr" field. Put something non-zero
+ * in here to keep Tcl_SetVar2() happy. The only time
+ * this field is really used is it remove a variable
+ * from the hash table that contains it in CleanupVar,
+ * but since these variables are protected by their
+ * higher refCount, they will not be deleted by CleanupVar
+ * anyway. These variables are unset and removed in
+ * ItclFreeObject().
+ */
+ varPtr->hPtr = (Tcl_HashEntry*)0x1;
+ varPtr->refCount = 1; /* protect from being deleted */
+
+ /*
+ * Install the new variable in the object's data array.
+ * Look up the appropriate index for the object using
+ * the data table in the class definition.
+ */
+ entry = Tcl_FindHashEntry(&contextObj->classDefn->resolveVars,
+ vdefn->member->fullname);
+
+ if (entry) {
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+ contextObj->data[vlookup->var.index] = varPtr;
+ }
+
+ /*
+ * If this variable has an initial value, initialize it
+ * here using a "set" command.
+ *
+ * TRICKY NOTE: We push an object context for the class that
+ * owns the variable, so that we don't have any trouble
+ * accessing it.
+ */
+ if (vdefn->init) {
+ if (Itcl_PushContext(interp, (ItclMember*)NULL,
+ vdefn->member->classDefn, contextObj, &context) == TCL_OK) {
+
+ Tcl_SetVar2(interp, vdefn->member->fullname,
+ (char*)NULL, vdefn->init, 0);
+ Itcl_PopContext(interp, &context);
+ }
+ }
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ScopedVarResolver()
+ *
+ * This procedure is installed to handle variable resolution throughout
+ * an entire interpreter. It looks for scoped variable references of
+ * the form:
+ *
+ * @itcl ::namesp::namesp::object variable
+ *
+ * If a reference like this is recognized, this procedure finds the
+ * desired variable in the object and returns the variable, along with
+ * the status code TCL_OK. If the variable does not start with
+ * "@itcl", this procedure returns TCL_CONTINUE, and variable
+ * resolution continues using the normal rules. If anything goes
+ * wrong, this procedure returns TCL_ERROR, and access to the
+ * variable is denied.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ScopedVarResolver(interp, name, contextNs, flags, rPtr)
+ Tcl_Interp *interp; /* current interpreter */
+ char *name; /* variable name being resolved */
+ Tcl_Namespace *contextNs; /* current namespace context */
+ int flags; /* TCL_LEAVE_ERR_MSG => leave error message */
+ Tcl_Var *rPtr; /* returns: resolved variable */
+{
+ int namec;
+ char **namev;
+ Tcl_Interp *errs;
+ Tcl_CmdInfo cmdInfo;
+ ItclObject *contextObj;
+ ItclVarLookup *vlookup;
+ Tcl_HashEntry *entry;
+
+ /*
+ * See if the variable starts with "@itcl". If not, then
+ * let the variable resolution process continue.
+ */
+ if (*name != '@' || strncmp(name, "@itcl", 5) != 0) {
+ return TCL_CONTINUE;
+ }
+
+ /*
+ * Break the variable name into parts and extract the object
+ * name and the variable name.
+ */
+ if (flags & TCL_LEAVE_ERR_MSG) {
+ errs = interp;
+ } else {
+ errs = NULL;
+ }
+
+ if (Tcl_SplitList(errs, name, &namec, &namev) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (namec != 3) {
+ if (errs) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(errs),
+ "scoped variable \"", name, "\" is malformed: ",
+ "should be: @itcl object variable",
+ (char*)NULL);
+ }
+ ckfree((char*)namev);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look for the command representing the object and extract
+ * the object context.
+ */
+ if (!Tcl_GetCommandInfo(interp, namev[1], &cmdInfo)) {
+ if (errs) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(errs),
+ "can't resolve scoped variable \"", name, "\": ",
+ "can't find object ", namev[1],
+ (char*)NULL);
+ }
+ ckfree((char*)namev);
+ return TCL_ERROR;
+ }
+ contextObj = (ItclObject*)cmdInfo.objClientData;
+
+ /*
+ * Resolve the variable with respect to the most-specific
+ * class definition.
+ */
+ entry = Tcl_FindHashEntry(&contextObj->classDefn->resolveVars, namev[2]);
+ if (!entry) {
+ if (errs) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(errs),
+ "can't resolve scoped variable \"", name, "\": ",
+ "no such data member ", namev[2],
+ (char*)NULL);
+ }
+ ckfree((char*)namev);
+ return TCL_ERROR;
+ }
+
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+ *rPtr = (Tcl_Var) contextObj->data[vlookup->var.index];
+
+ ckfree((char*)namev);
+ return TCL_OK;
+}
diff --git a/itcl/itcl/generic/itcl_obsolete.c b/itcl/itcl/generic/itcl_obsolete.c
new file mode 100644
index 00000000000..37c9336885d
--- /dev/null
+++ b/itcl/itcl/generic/itcl_obsolete.c
@@ -0,0 +1,1959 @@
+/*
+ * ------------------------------------------------------------------------
+ * PACKAGE: [incr Tcl]
+ * DESCRIPTION: Object-Oriented Extensions to Tcl
+ *
+ * [incr Tcl] provides object-oriented extensions to Tcl, much as
+ * C++ provides object-oriented extensions to C. It provides a means
+ * of encapsulating related procedures together with their shared data
+ * in a local namespace that is hidden from the outside world. It
+ * promotes code re-use through inheritance. More than anything else,
+ * it encourages better organization of Tcl applications through the
+ * object-oriented paradigm, leading to code that is easier to
+ * understand and maintain.
+ *
+ * Procedures in this file support the old-style syntax for [incr Tcl]
+ * class definitions:
+ *
+ * itcl_class <className> {
+ * inherit <base-class>...
+ *
+ * constructor {<arglist>} { <body> }
+ * destructor { <body> }
+ *
+ * method <name> {<arglist>} { <body> }
+ * proc <name> {<arglist>} { <body> }
+ *
+ * public <varname> ?<init>? ?<config>?
+ * protected <varname> ?<init>?
+ * common <varname> ?<init>?
+ * }
+ *
+ * This capability will be removed in a future release, after users
+ * have had a chance to switch over to the new syntax.
+ *
+ * ========================================================================
+ * AUTHOR: Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ * http://www.tcltk.com/itcl
+ *
+ * RCS: $Id$
+ * ========================================================================
+ * Copyright (c) 1993-1998 Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#include "itclInt.h"
+
+/*
+ * FORWARD DECLARATIONS
+ */
+static int ItclOldClassCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj* CONST objv[]));
+
+static int ItclOldMethodCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj* CONST objv[]));
+static int ItclOldPublicCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj* CONST objv[]));
+static int ItclOldProtectedCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj* CONST objv[]));
+static int ItclOldCommonCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj* CONST objv[]));
+
+static int ItclOldBiDeleteCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj* CONST objv[]));
+static int ItclOldBiVirtualCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj* CONST objv[]));
+static int ItclOldBiPreviousCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj* CONST objv[]));
+
+static int ItclOldBiInfoMethodsCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj* CONST objv[]));
+static int ItclOldBiInfoProcsCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj* CONST objv[]));
+static int ItclOldBiInfoPublicsCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj* CONST objv[]));
+static int ItclOldBiInfoProtectedsCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj* CONST objv[]));
+static int ItclOldBiInfoCommonsCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj* CONST objv[]));
+
+
+/*
+ * Standard list of built-in methods for old-style objects.
+ */
+typedef struct BiMethod {
+ char* name; /* method name */
+ char* usage; /* string describing usage */
+ char* registration; /* registration name for C proc */
+ Tcl_ObjCmdProc *proc; /* implementation C proc */
+} BiMethod;
+
+static BiMethod BiMethodList[] = {
+ { "cget", "-option",
+ "@itcl-oldstyle-cget", Itcl_BiCgetCmd },
+ { "configure", "?-option? ?value -option value...?",
+ "@itcl-oldstyle-configure", Itcl_BiConfigureCmd },
+ { "delete", "",
+ "@itcl-oldstyle-delete", ItclOldBiDeleteCmd },
+ { "isa", "className",
+ "@itcl-oldstyle-isa", Itcl_BiIsaCmd },
+};
+static int BiMethodListLen = sizeof(BiMethodList)/sizeof(BiMethod);
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_OldInit()
+ *
+ * Invoked by Itcl_Init() whenever a new interpeter is created to add
+ * [incr Tcl] facilities. Adds the commands needed for backward
+ * compatibility with previous releases of [incr Tcl].
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_OldInit(interp,info)
+ Tcl_Interp *interp; /* interpreter to be updated */
+ ItclObjectInfo *info; /* info regarding all known objects */
+{
+ int i;
+ Tcl_Namespace *parserNs, *oldBiNs;
+
+ /*
+ * Declare all of the old-style built-in methods as C procedures.
+ */
+ for (i=0; i < BiMethodListLen; i++) {
+ if (Itcl_RegisterObjC(interp,
+ BiMethodList[i].registration+1, BiMethodList[i].proc,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK) {
+
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Create the "itcl::old-parser" namespace for backward
+ * compatibility, to handle the old-style class definitions.
+ */
+ parserNs = Tcl_CreateNamespace(interp, "::itcl::old-parser",
+ (ClientData)info, Itcl_ReleaseData);
+
+ if (!parserNs) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ " (cannot initialize itcl old-style parser)",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ Itcl_PreserveData((ClientData)info);
+
+ /*
+ * Add commands for parsing old-style class definitions.
+ */
+ Tcl_CreateObjCommand(interp, "::itcl::old-parser::inherit",
+ Itcl_ClassInheritCmd, (ClientData)info, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itcl::old-parser::constructor",
+ Itcl_ClassConstructorCmd, (ClientData)info, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itcl::old-parser::destructor",
+ Itcl_ClassDestructorCmd, (ClientData)info, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itcl::old-parser::method",
+ ItclOldMethodCmd, (ClientData)info, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itcl::old-parser::proc",
+ Itcl_ClassProcCmd, (ClientData)info, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itcl::old-parser::public",
+ ItclOldPublicCmd, (ClientData)info, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itcl::old-parser::protected",
+ ItclOldProtectedCmd, (ClientData)info, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itcl::old-parser::common",
+ ItclOldCommonCmd, (ClientData)info, (Tcl_CmdDeleteProc*)NULL);
+
+ /*
+ * Set the runtime variable resolver for the parser namespace,
+ * to control access to "common" data members while parsing
+ * the class definition.
+ */
+ Tcl_SetNamespaceResolvers(parserNs, (Tcl_ResolveCmdProc*)NULL,
+ Itcl_ParseVarResolver, (Tcl_ResolveCompiledVarProc*)NULL);
+
+ /*
+ * Create the "itcl::old-builtin" namespace for backward
+ * compatibility with the old-style built-in commands.
+ */
+ Tcl_CreateObjCommand(interp, "::itcl::old-builtin::virtual",
+ ItclOldBiVirtualCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itcl::old-builtin::previous",
+ ItclOldBiPreviousCmd, (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
+
+ if (Itcl_CreateEnsemble(interp, "::itcl::old-builtin::info") != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Itcl_AddEnsemblePart(interp, "::itcl::old-builtin::info",
+ "class", "", Itcl_BiInfoClassCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK ||
+
+ Itcl_AddEnsemblePart(interp, "::itcl::old-builtin::info",
+ "inherit", "", Itcl_BiInfoInheritCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK ||
+
+ Itcl_AddEnsemblePart(interp, "::itcl::old-builtin::info",
+ "heritage", "", Itcl_BiInfoHeritageCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK ||
+
+ Itcl_AddEnsemblePart(interp, "::itcl::old-builtin::info",
+ "method", "?methodName? ?-args? ?-body?",
+ ItclOldBiInfoMethodsCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK ||
+
+ Itcl_AddEnsemblePart(interp, "::itcl::old-builtin::info",
+ "proc", "?procName? ?-args? ?-body?",
+ ItclOldBiInfoProcsCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK ||
+
+ Itcl_AddEnsemblePart(interp, "::itcl::old-builtin::info",
+ "public", "?varName? ?-init? ?-value? ?-config?",
+ ItclOldBiInfoPublicsCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK ||
+
+ Itcl_AddEnsemblePart(interp, "::itcl::old-builtin::info",
+ "protected", "?varName? ?-init? ?-value?",
+ ItclOldBiInfoProtectedsCmd,
+ (ClientData)NULL,(Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK ||
+
+ Itcl_AddEnsemblePart(interp, "::itcl::old-builtin::info",
+ "common", "?varName? ?-init? ?-value?",
+ ItclOldBiInfoCommonsCmd,
+ (ClientData)NULL,(Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK ||
+
+ Itcl_AddEnsemblePart(interp, "::itcl::old-builtin::info",
+ "args", "procname", Itcl_BiInfoArgsCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK ||
+
+ Itcl_AddEnsemblePart(interp, "::itcl::old-builtin::info",
+ "body", "procname", Itcl_BiInfoBodyCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK
+ ) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Plug in an "@error" handler to handle other options from
+ * the usual info command.
+ */
+ if (Itcl_AddEnsemblePart(interp, "::itcl::old-builtin::info",
+ "@error", (char*)NULL, Itcl_DefaultInfoCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL)
+ != TCL_OK
+ ) {
+ return TCL_ERROR;
+ }
+
+ oldBiNs = Tcl_FindNamespace(interp, "::itcl::old-builtin",
+ (Tcl_Namespace*)NULL, TCL_LEAVE_ERR_MSG);
+
+ if (!oldBiNs ||
+ Tcl_Export(interp, oldBiNs, "*", /* resetListFirst */ 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Install the "itcl_class" and "itcl_info" commands into
+ * the global scope. This supports the old syntax for
+ * backward compatibility.
+ */
+ Tcl_CreateObjCommand(interp, "::itcl_class", ItclOldClassCmd,
+ (ClientData)info, Itcl_ReleaseData);
+ Itcl_PreserveData((ClientData)info);
+
+
+ if (Itcl_CreateEnsemble(interp, "::itcl_info") != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Itcl_AddEnsemblePart(interp, "::itcl_info",
+ "classes", "?pattern?",
+ Itcl_FindClassesCmd, (ClientData)info, Itcl_ReleaseData)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Itcl_PreserveData((ClientData)info);
+
+ if (Itcl_AddEnsemblePart(interp, "::itcl_info",
+ "objects", "?-class className? ?-isa className? ?pattern?",
+ Itcl_FindObjectsCmd, (ClientData)info, Itcl_ReleaseData)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Itcl_PreserveData((ClientData)info);
+
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_InstallOldBiMethods()
+ *
+ * Invoked when a class is first created, just after the class
+ * definition has been parsed, to add definitions for built-in
+ * methods to the class. If a method already exists in the class
+ * with the same name as the built-in, then the built-in is skipped.
+ * Otherwise, a method definition for the built-in method is added.
+ *
+ * Returns TCL_OK if successful, or TCL_ERROR (along with an error
+ * message in the interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_InstallOldBiMethods(interp, cdefn)
+ Tcl_Interp *interp; /* current interpreter */
+ ItclClass *cdefn; /* class definition to be updated */
+{
+ int result = TCL_OK;
+
+ int i;
+ ItclHierIter hier;
+ ItclClass *cdPtr;
+ Tcl_HashEntry *entry;
+
+ /*
+ * Scan through all of the built-in methods and see if
+ * that method already exists in the class. If not, add
+ * it in.
+ *
+ * TRICKY NOTE: The virtual tables haven't been built yet,
+ * so look for existing methods the hard way--by scanning
+ * through all classes.
+ */
+ for (i=0; i < BiMethodListLen; i++) {
+ Itcl_InitHierIter(&hier, cdefn);
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+
+ entry = NULL;
+ while (cdPtr) {
+ entry = Tcl_FindHashEntry(&cdPtr->functions, BiMethodList[i].name);
+ if (entry) {
+ break;
+ }
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ }
+ Itcl_DeleteHierIter(&hier);
+
+ if (!entry) {
+ result = Itcl_CreateMethod(interp, cdefn, BiMethodList[i].name,
+ BiMethodList[i].usage, BiMethodList[i].registration);
+
+ if (result != TCL_OK) {
+ break;
+ }
+ }
+ }
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclOldClassCmd()
+ *
+ * Invoked by Tcl whenever the user issues a "itcl_class" command to
+ * specify a class definition. Handles the following syntax:
+ *
+ * itcl_class <className> {
+ * inherit <base-class>...
+ *
+ * constructor {<arglist>} { <body> }
+ * destructor { <body> }
+ *
+ * method <name> {<arglist>} { <body> }
+ * proc <name> {<arglist>} { <body> }
+ *
+ * public <varname> ?<init>? ?<config>?
+ * protected <varname> ?<init>?
+ * common <varname> ?<init>?
+ * }
+ *
+ * NOTE: This command is will only be provided for a limited time,
+ * to support backward compatibility with the old-style
+ * [incr Tcl] syntax. Users should convert their scripts
+ * to use the newer syntax (Itcl_ClassCmd()) as soon as possible.
+ *
+ * ------------------------------------------------------------------------
+ */
+static int
+ItclOldClassCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* info for all known objects */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclObjectInfo* info = (ItclObjectInfo*)clientData;
+
+ int result;
+ char *className;
+ Tcl_Namespace *parserNs;
+ ItclClass *cdefnPtr;
+ Tcl_HashEntry* entry;
+ ItclMemberFunc *mfunc;
+ Tcl_CallFrame frame;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name { definition }");
+ return TCL_ERROR;
+ }
+ className = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+
+ /*
+ * Find the namespace to use as a parser for the class definition.
+ * If for some reason it is destroyed, bail out here.
+ */
+ parserNs = Tcl_FindNamespace(interp, "::itcl::old-parser",
+ (Tcl_Namespace*)NULL, TCL_LEAVE_ERR_MSG);
+
+ if (parserNs == NULL) {
+ char msg[256];
+ sprintf(msg, "\n (while parsing class definition for \"%.100s\")",
+ className);
+ Tcl_AddErrorInfo(interp, msg);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Try to create the specified class and its namespace.
+ */
+ if (Itcl_CreateClass(interp, className, info, &cdefnPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ cdefnPtr->flags |= ITCL_OLD_STYLE;
+
+ /*
+ * Import the built-in commands from the itcl::old-builtin
+ * and itcl::builtin namespaces. Do this before parsing the
+ * class definition, so methods/procs can override the built-in
+ * commands.
+ */
+ result = Tcl_Import(interp, cdefnPtr->namesp, "::itcl::builtin::*",
+ /* allowOverwrite */ 1);
+
+ if (result == TCL_OK) {
+ result = Tcl_Import(interp, cdefnPtr->namesp, "::itcl::old-builtin::*",
+ /* allowOverwrite */ 1);
+ }
+
+ if (result != TCL_OK) {
+ char msg[256];
+ sprintf(msg, "\n (while installing built-in commands for class \"%.100s\")", className);
+ Tcl_AddErrorInfo(interp, msg);
+
+ Tcl_DeleteNamespace(cdefnPtr->namesp);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Push this class onto the class definition stack so that it
+ * becomes the current context for all commands in the parser.
+ * Activate the parser and evaluate the class definition.
+ */
+ Itcl_PushStack((ClientData)cdefnPtr, &info->cdefnStack);
+
+ result = Tcl_PushCallFrame(interp, &frame, parserNs,
+ /* isProcCallFrame */ 0);
+
+ if (result == TCL_OK) {
+ /* CYGNUS LOCAL - Fix for Tcl8.1 */
+#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ result = Tcl_EvalObj(interp, objv[2]);
+#else
+ result = Tcl_EvalObj(interp, objv[2], 0);
+#endif
+ /* END CYGNUS LOCAL */
+ Tcl_PopCallFrame(interp);
+ }
+ Itcl_PopStack(&info->cdefnStack);
+
+ if (result != TCL_OK) {
+ char msg[256];
+ sprintf(msg, "\n (class \"%.200s\" body line %d)",
+ className, interp->errorLine);
+ Tcl_AddErrorInfo(interp, msg);
+
+ Tcl_DeleteNamespace(cdefnPtr->namesp);
+ return TCL_ERROR;
+ }
+
+ /*
+ * At this point, parsing of the class definition has succeeded.
+ * Add built-in methods such as "configure" and "cget"--as long
+ * as they don't conflict with those defined in the class.
+ */
+ if (Itcl_InstallOldBiMethods(interp, cdefnPtr) != TCL_OK) {
+ Tcl_DeleteNamespace(cdefnPtr->namesp);
+ return TCL_ERROR;
+ }
+
+ /*
+ * See if this class has a "constructor", and if it does, mark
+ * it as "old-style". This will allow the "config" argument
+ * to work.
+ */
+ entry = Tcl_FindHashEntry(&cdefnPtr->functions, "constructor");
+ if (entry) {
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+ mfunc->member->flags |= ITCL_OLD_STYLE;
+ }
+
+ /*
+ * Build the virtual tables for this class.
+ */
+ Itcl_BuildVirtualTables(cdefnPtr);
+
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclOldMethodCmd()
+ *
+ * Invoked by Tcl during the parsing of a class definition whenever
+ * the "method" command is invoked to define an object method.
+ * Handles the following syntax:
+ *
+ * method <name> {<arglist>} {<body>}
+ *
+ * ------------------------------------------------------------------------
+ */
+static int
+ItclOldMethodCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* info for all known objects */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclObjectInfo *info = (ItclObjectInfo*)clientData;
+ ItclClass *cdefn = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);
+
+ char *name, *arglist, *body;
+ Tcl_HashEntry *entry;
+ ItclMemberFunc *mfunc;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name args body");
+ return TCL_ERROR;
+ }
+
+ name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ if (Tcl_FindHashEntry(&cdefn->functions, name)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\"", name, "\" already defined in class \"", cdefn->name, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ arglist = Tcl_GetStringFromObj(objv[2], (int*)NULL);
+ body = Tcl_GetStringFromObj(objv[3], (int*)NULL);
+
+ if (Itcl_CreateMethod(interp, cdefn, name, arglist, body) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Find the method that was just created and mark it as an
+ * "old-style" method, so that the magic "config" argument
+ * will be allowed to work. This is done for backward-
+ * compatibility with earlier releases. In the latest version,
+ * use of the "config" argument is discouraged.
+ */
+ entry = Tcl_FindHashEntry(&cdefn->functions, name);
+ if (entry) {
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+ mfunc->member->flags |= ITCL_OLD_STYLE;
+ }
+
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclOldPublicCmd()
+ *
+ * Invoked by Tcl during the parsing of a class definition whenever
+ * the "public" command is invoked to define a public variable.
+ * Handles the following syntax:
+ *
+ * public <varname> ?<init>? ?<config>?
+ *
+ * ------------------------------------------------------------------------
+ */
+static int
+ItclOldPublicCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* info for all known objects */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclObjectInfo *info = (ItclObjectInfo*)clientData;
+ ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);
+
+ char *name, *init, *config;
+ ItclVarDefn *vdefn;
+
+ if ((objc < 2) || (objc > 4)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "varname ?init? ?config?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that the variable name does not contain anything
+ * goofy like a "::" scope qualifier.
+ */
+ name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ if (strstr(name, "::")) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad variable name \"", name, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ init = NULL;
+ config = NULL;
+ if (objc >= 3) {
+ init = Tcl_GetStringFromObj(objv[2], (int*)NULL);
+ }
+ if (objc >= 4) {
+ config = Tcl_GetStringFromObj(objv[3], (int*)NULL);
+ }
+
+ if (Itcl_CreateVarDefn(interp, cdefnPtr, name, init, config,
+ &vdefn) != TCL_OK) {
+
+ return TCL_ERROR;
+ }
+
+ vdefn->member->protection = ITCL_PUBLIC;
+
+ return TCL_OK;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclOldProtectedCmd()
+ *
+ * Invoked by Tcl during the parsing of a class definition whenever
+ * the "protected" command is invoked to define a protected variable.
+ * Handles the following syntax:
+ *
+ * protected <varname> ?<init>?
+ *
+ * ------------------------------------------------------------------------
+ */
+static int
+ItclOldProtectedCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* info for all known objects */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclObjectInfo *info = (ItclObjectInfo*)clientData;
+ ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);
+
+ char *name, *init;
+ ItclVarDefn *vdefn;
+
+ if ((objc < 2) || (objc > 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "varname ?init?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that the variable name does not contain anything
+ * goofy like a "::" scope qualifier.
+ */
+ name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ if (strstr(name, "::")) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad variable name \"", name, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ init = Tcl_GetStringFromObj(objv[2], (int*)NULL);
+ } else {
+ init = NULL;
+ }
+
+ if (Itcl_CreateVarDefn(interp, cdefnPtr, name, init, (char*)NULL,
+ &vdefn) != TCL_OK) {
+
+ return TCL_ERROR;
+ }
+
+ vdefn->member->protection = ITCL_PROTECTED;
+
+ return TCL_OK;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclOldCommonCmd()
+ *
+ * Invoked by Tcl during the parsing of a class definition whenever
+ * the "common" command is invoked to define a variable that is
+ * common to all objects in the class. Handles the following syntax:
+ *
+ * common <varname> ?<init>?
+ *
+ * ------------------------------------------------------------------------
+ */
+static int
+ItclOldCommonCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* info for all known objects */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclObjectInfo *info = (ItclObjectInfo*)clientData;
+ ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);
+
+ int newEntry;
+ char *name, *init;
+ ItclVarDefn *vdefn;
+ Tcl_HashEntry *entry;
+ Namespace *nsPtr;
+ Var *varPtr;
+
+ if ((objc < 2) || (objc > 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "varname ?init?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that the variable name does not contain anything
+ * goofy like a "::" scope qualifier.
+ */
+ name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ if (strstr(name, "::")) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad variable name \"", name, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ init = Tcl_GetStringFromObj(objv[2], (int*)NULL);
+ } else {
+ init = NULL;
+ }
+
+ if (Itcl_CreateVarDefn(interp, cdefnPtr, name, init, (char*)NULL,
+ &vdefn) != TCL_OK) {
+
+ return TCL_ERROR;
+ }
+
+ vdefn->member->protection = ITCL_PROTECTED;
+ vdefn->member->flags |= ITCL_COMMON;
+
+ /*
+ * Create the variable in the namespace associated with the
+ * class. Do this the hard way, to avoid the variable resolver
+ * procedures. These procedures won't work until we rebuild
+ * the virtual tables below.
+ */
+ nsPtr = (Namespace*)cdefnPtr->namesp;
+ entry = Tcl_CreateHashEntry(&nsPtr->varTable,
+ vdefn->member->name, &newEntry);
+
+ varPtr = _TclNewVar();
+ varPtr->hPtr = entry;
+ varPtr->nsPtr = nsPtr;
+ varPtr->refCount++; /* protect from being deleted */
+
+ Tcl_SetHashValue(entry, varPtr);
+
+ /*
+ * TRICKY NOTE: Make sure to rebuild the virtual tables for this
+ * class so that this variable is ready to access. The variable
+ * resolver for the parser namespace needs this info to find the
+ * variable if the developer tries to set it within the class
+ * definition.
+ *
+ * If an initialization value was specified, then initialize
+ * the variable now.
+ */
+ Itcl_BuildVirtualTables(cdefnPtr);
+
+ if (init) {
+ init = Tcl_SetVar(interp, vdefn->member->name, init,
+ TCL_NAMESPACE_ONLY);
+
+ if (!init) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot initialize common variable \"",
+ vdefn->member->name, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclOldDeleteCmd()
+ *
+ * Invokes the destructors, and deletes the object that invoked this
+ * operation. If an error is encountered during destruction, the
+ * delete operation is aborted. Handles the following syntax:
+ *
+ * <objName> delete
+ *
+ * When an object is successfully deleted, it is removed from the
+ * list of known objects, and its access command is deleted.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+ItclOldBiDeleteCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "");
+ return TCL_ERROR;
+ }
+
+ /*
+ * If there is an object context, then destruct the object
+ * and delete it.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (!contextObj) {
+ Tcl_SetResult(interp, "improper usage: should be \"object delete\"",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ if (Itcl_DeleteObject(interp, contextObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclOldVirtualCmd()
+ *
+ * Executes the remainder of its command line arguments in the
+ * most-specific class scope for the current object. If there is
+ * no object context, this fails.
+ *
+ * NOTE: All methods are now implicitly virtual, and there are
+ * much better ways to manipulate scope. This command is only
+ * provided for backward-compatibility, and should be avoided.
+ *
+ * Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+ItclOldBiVirtualCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int result;
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+ ItclContext context;
+
+ if (objc == 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "command ?args...?");
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\n This command will be removed soon.",
+ "\n Commands are now virtual by default.",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If there is no object context, then return an error.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (!contextObj) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot use \"virtual\" without an object context\n",
+ " This command will be removed soon.\n",
+ " Commands are now virtual by default.",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Install the most-specific namespace for this object, with
+ * the object context as clientData. Invoke the rest of the
+ * args as a command in that namespace.
+ */
+ if (Itcl_PushContext(interp, (ItclMember*)NULL, contextObj->classDefn,
+ contextObj, &context) != TCL_OK) {
+
+ return TCL_ERROR;
+ }
+
+ result = Itcl_EvalArgs(interp, objc-1, objv+1);
+ Itcl_PopContext(interp, &context);
+
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclOldPreviousCmd()
+ *
+ * Executes the remainder of its command line arguments in the
+ * previous class scope (i.e., the next scope up in the heritage
+ * list).
+ *
+ * NOTE: There are much better ways to manipulate scope. This
+ * command is only provided for backward-compatibility, and should
+ * be avoided.
+ *
+ * Returns a status TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+ItclOldBiPreviousCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int result;
+ char *name;
+ ItclClass *contextClass, *base;
+ ItclObject *contextObj;
+ ItclMember *member;
+ ItclMemberFunc *mfunc;
+ Itcl_ListElem *elem;
+ Tcl_HashEntry *entry;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "command ?args...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the current context is not a class namespace,
+ * return an error.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Get the heritage information for this class and move one
+ * level up in the hierarchy. If there is no base class,
+ * return an error.
+ */
+ elem = Itcl_FirstListElem(&contextClass->bases);
+ if (!elem) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "no previous class in inheritance hierarchy for \"",
+ contextClass->name, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ base = (ItclClass*)Itcl_GetListValue(elem);
+
+ /*
+ * Look in the command resolution table for the base class
+ * to find the desired method.
+ */
+ name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ entry = Tcl_FindHashEntry(&base->resolveCmds, name);
+ if (!entry) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "invalid command name \"", base->name, "::", name, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+ member = mfunc->member;
+
+ /*
+ * Make sure that this method is accessible.
+ */
+ if (mfunc->member->protection != ITCL_PUBLIC) {
+ Tcl_Namespace *contextNs = Itcl_GetTrueNamespace(interp,
+ member->classDefn->info);
+
+ if (!Itcl_CanAccessFunc(mfunc, contextNs)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "can't access \"", member->fullname, "\": ",
+ Itcl_ProtectionStr(member->protection), " function",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Invoke the desired method by calling Itcl_EvalMemberCode.
+ * directly. This bypasses the virtual behavior built into
+ * the usual Itcl_ExecMethod handler.
+ */
+ result = Itcl_EvalMemberCode(interp, mfunc, member, contextObj,
+ objc-1, objv+1);
+
+ result = Itcl_ReportFuncErrors(interp, mfunc, contextObj, result);
+
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclOldBiInfoMethodsCmd()
+ *
+ * Returns information regarding methods for an object. This command
+ * can be invoked with or without an object context:
+ *
+ * <objName> info... <= returns info for most-specific class
+ * info... <= returns info for active namespace
+ *
+ * Handles the following syntax:
+ *
+ * info method ?methodName? ?-args? ?-body?
+ *
+ * If the ?methodName? is not specified, then a list of all known
+ * methods is returned. Otherwise, the information (args/body) for
+ * a specific method is returned. Returns a status TCL_OK/TCL_ERROR
+ * to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+ItclOldBiInfoMethodsCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ char *methodName = NULL;
+ int methodArgs = 0;
+ int methodBody = 0;
+
+ char *token;
+ ItclClass *contextClass, *cdefn;
+ ItclObject *contextObj;
+ ItclHierIter hier;
+ Tcl_HashSearch place;
+ Tcl_HashEntry *entry;
+ ItclMemberFunc *mfunc;
+ ItclMemberCode *mcode;
+ Tcl_Obj *objPtr, *listPtr;
+
+ /*
+ * If this command is not invoked within a class namespace,
+ * signal an error.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If there is an object context, then use the most-specific
+ * class for the object. Otherwise, use the current class
+ * namespace.
+ */
+ if (contextObj) {
+ contextClass = contextObj->classDefn;
+ }
+
+ /*
+ * Process args: ?methodName? ?-args? ?-body?
+ */
+ objv++; /* skip over command name */
+ objc--;
+
+ if (objc > 0) {
+ methodName = Tcl_GetStringFromObj(*objv, (int*)NULL);
+ objc--; objv++;
+ }
+ for ( ; objc > 0; objc--, objv++) {
+ token = Tcl_GetStringFromObj(*objv, (int*)NULL);
+ if (strcmp(token, "-args") == 0)
+ methodArgs = ~0;
+ else if (strcmp(token, "-body") == 0)
+ methodBody = ~0;
+ else {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad option \"", token, "\": should be -args or -body",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Return info for a specific method.
+ */
+ if (methodName) {
+ entry = Tcl_FindHashEntry(&contextClass->resolveCmds, methodName);
+ if (entry) {
+ int i, valc = 0;
+ Tcl_Obj *valv[5];
+
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+ if ((mfunc->member->flags & ITCL_COMMON) != 0) {
+ return TCL_OK;
+ }
+
+ /*
+ * If the implementation has not yet been defined,
+ * autoload it now.
+ */
+ if (Itcl_GetMemberCode(interp, mfunc->member) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ mcode = mfunc->member->code;
+
+ if (!methodArgs && !methodBody) {
+ objPtr = Tcl_NewStringObj(mfunc->member->classDefn->name, -1);
+ Tcl_AppendToObj(objPtr, "::", -1);
+ Tcl_AppendToObj(objPtr, mfunc->member->name, -1);
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ methodArgs = methodBody = ~0;
+ }
+ if (methodArgs) {
+ if (mcode->arglist) {
+ objPtr = Itcl_ArgList(mcode->argcount, mcode->arglist);
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ }
+ else {
+ objPtr = Tcl_NewStringObj("", -1);
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ }
+ }
+ if (methodBody) {
+ objPtr = mcode->procPtr->bodyPtr;
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ }
+
+ /*
+ * If the result list has a single element, then
+ * return it using Tcl_SetResult() so that it will
+ * look like a string and not a list with one element.
+ */
+ if (valc == 1) {
+ objPtr = valv[0];
+ } else {
+ objPtr = Tcl_NewListObj(valc, valv);
+ }
+ Tcl_SetObjResult(interp, objPtr);
+
+ for (i=0; i < valc; i++) {
+ Tcl_DecrRefCount(valv[i]);
+ }
+ }
+ }
+
+ /*
+ * Return the list of available methods.
+ */
+ else {
+ listPtr = Tcl_NewListObj(0, (Tcl_Obj* CONST*)NULL);
+
+ Itcl_InitHierIter(&hier, contextClass);
+ while ((cdefn=Itcl_AdvanceHierIter(&hier)) != NULL) {
+ entry = Tcl_FirstHashEntry(&cdefn->functions, &place);
+ while (entry) {
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+
+ if ((mfunc->member->flags & ITCL_COMMON) == 0) {
+ objPtr = Tcl_NewStringObj(mfunc->member->classDefn->name, -1);
+ Tcl_AppendToObj(objPtr, "::", -1);
+ Tcl_AppendToObj(objPtr, mfunc->member->name, -1);
+
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
+ objPtr);
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+ }
+ Itcl_DeleteHierIter(&hier);
+
+ Tcl_SetObjResult(interp, listPtr);
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclOldBiInfoProcsCmd()
+ *
+ * Returns information regarding procs for a class. This command
+ * can be invoked with or without an object context:
+ *
+ * <objName> info... <= returns info for most-specific class
+ * info... <= returns info for active namespace
+ *
+ * Handles the following syntax:
+ *
+ * info proc ?procName? ?-args? ?-body?
+ *
+ * If the ?procName? is not specified, then a list of all known
+ * procs is returned. Otherwise, the information (args/body) for
+ * a specific proc is returned. Returns a status TCL_OK/TCL_ERROR
+ * to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+ItclOldBiInfoProcsCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ char *procName = NULL;
+ int procArgs = 0;
+ int procBody = 0;
+
+ char *token;
+ ItclClass *contextClass, *cdefn;
+ ItclObject *contextObj;
+ ItclHierIter hier;
+ Tcl_HashSearch place;
+ Tcl_HashEntry *entry;
+ ItclMemberFunc *mfunc;
+ ItclMemberCode *mcode;
+ Tcl_Obj *objPtr, *listPtr;
+
+ /*
+ * If this command is not invoked within a class namespace,
+ * signal an error.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If there is an object context, then use the most-specific
+ * class for the object. Otherwise, use the current class
+ * namespace.
+ */
+ if (contextObj) {
+ contextClass = contextObj->classDefn;
+ }
+
+ /*
+ * Process args: ?procName? ?-args? ?-body?
+ */
+ objv++; /* skip over command name */
+ objc--;
+
+ if (objc > 0) {
+ procName = Tcl_GetStringFromObj(*objv, (int*)NULL);
+ objc--; objv++;
+ }
+ for ( ; objc > 0; objc--, objv++) {
+ token = Tcl_GetStringFromObj(*objv, (int*)NULL);
+ if (strcmp(token, "-args") == 0)
+ procArgs = ~0;
+ else if (strcmp(token, "-body") == 0)
+ procBody = ~0;
+ else {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad option \"", token, "\": should be -args or -body",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Return info for a specific proc.
+ */
+ if (procName) {
+ entry = Tcl_FindHashEntry(&contextClass->resolveCmds, procName);
+ if (entry) {
+ int i, valc = 0;
+ Tcl_Obj *valv[5];
+
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+ if ((mfunc->member->flags & ITCL_COMMON) == 0) {
+ return TCL_OK;
+ }
+
+ /*
+ * If the implementation has not yet been defined,
+ * autoload it now.
+ */
+ if (Itcl_GetMemberCode(interp, mfunc->member) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ mcode = mfunc->member->code;
+
+ if (!procArgs && !procBody) {
+ objPtr = Tcl_NewStringObj(mfunc->member->fullname, -1);
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ procArgs = procBody = ~0;
+ }
+ if (procArgs) {
+ if (mcode->arglist) {
+ objPtr = Itcl_ArgList(mcode->argcount, mcode->arglist);
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ }
+ else {
+ objPtr = Tcl_NewStringObj("", -1);
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ }
+ }
+ if (procBody) {
+ objPtr = mcode->procPtr->bodyPtr;
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ }
+
+ /*
+ * If the result list has a single element, then
+ * return it using Tcl_SetResult() so that it will
+ * look like a string and not a list with one element.
+ */
+ if (valc == 1) {
+ objPtr = valv[0];
+ } else {
+ objPtr = Tcl_NewListObj(valc, valv);
+ }
+ Tcl_SetObjResult(interp, objPtr);
+
+ for (i=0; i < valc; i++) {
+ Tcl_DecrRefCount(valv[i]);
+ }
+ }
+ }
+
+ /*
+ * Return the list of available procs.
+ */
+ else {
+ listPtr = Tcl_NewListObj(0, (Tcl_Obj* CONST*)NULL);
+
+ Itcl_InitHierIter(&hier, contextClass);
+ while ((cdefn=Itcl_AdvanceHierIter(&hier)) != NULL) {
+ entry = Tcl_FirstHashEntry(&cdefn->functions, &place);
+ while (entry) {
+ mfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+
+ if ((mfunc->member->flags & ITCL_COMMON) != 0) {
+ objPtr = Tcl_NewStringObj(mfunc->member->classDefn->name, -1);
+ Tcl_AppendToObj(objPtr, "::", -1);
+ Tcl_AppendToObj(objPtr, mfunc->member->name, -1);
+
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
+ objPtr);
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+ }
+ Itcl_DeleteHierIter(&hier);
+
+ Tcl_SetObjResult(interp, listPtr);
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclOldBiInfoPublicsCmd()
+ *
+ * Sets the interpreter result to contain information for public
+ * variables in the class. Handles the following syntax:
+ *
+ * info public ?varName? ?-init? ?-value? ?-config?
+ *
+ * If the ?varName? is not specified, then a list of all known public
+ * variables is returned. Otherwise, the information (init/value/config)
+ * for a specific variable is returned. Returns a status
+ * TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+ItclOldBiInfoPublicsCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ char *varName = NULL;
+ int varInit = 0;
+ int varCheck = 0;
+ int varValue = 0;
+
+ char *token, *val;
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+
+ ItclClass *cdPtr;
+ ItclVarLookup *vlookup;
+ ItclVarDefn *vdefn;
+ ItclMember *member;
+ ItclHierIter hier;
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch place;
+ Tcl_Obj *objPtr, *listPtr;
+
+ /*
+ * If this command is not invoked within a class namespace,
+ * signal an error.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Process args: ?varName? ?-init? ?-value? ?-config?
+ */
+ objv++; /* skip over command name */
+ objc--;
+
+ if (objc > 0) {
+ varName = Tcl_GetStringFromObj(*objv, (int*)NULL);
+ objc--; objv++;
+ }
+ for ( ; objc > 0; objc--, objv++) {
+ token = Tcl_GetStringFromObj(*objv, (int*)NULL);
+ if (strcmp(token, "-init") == 0)
+ varInit = ~0;
+ else if (strcmp(token, "-value") == 0)
+ varValue = ~0;
+ else if (strcmp(token, "-config") == 0)
+ varCheck = ~0;
+ else {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad option \"", token,
+ "\": should be -init, -value or -config",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Return info for a specific variable.
+ */
+ if (varName) {
+ vlookup = NULL;
+ entry = Tcl_FindHashEntry(&contextClass->resolveVars, varName);
+ if (entry) {
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+ if (vlookup->vdefn->member->protection != ITCL_PUBLIC) {
+ vlookup = NULL;
+ }
+ }
+
+ if (vlookup) {
+ int i, valc = 0;
+ Tcl_Obj *valv[5];
+
+ member = vlookup->vdefn->member;
+
+ if (!varInit && !varCheck && !varValue) {
+ objPtr = Tcl_NewStringObj(member->classDefn->name, -1);
+ Tcl_AppendToObj(objPtr, "::", -1);
+ Tcl_AppendToObj(objPtr, member->name, -1);
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ varInit = varCheck = varValue = ~0;
+ }
+ if (varInit) {
+ val = (vlookup->vdefn->init) ? vlookup->vdefn->init : "";
+ objPtr = Tcl_NewStringObj(val, -1);
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ }
+ if (varValue) {
+ val = Itcl_GetInstanceVar(interp, member->fullname,
+ contextObj, contextObj->classDefn);
+
+ if (!val) {
+ val = "<undefined>";
+ }
+ objPtr = Tcl_NewStringObj(val, -1);
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ }
+
+ if (varCheck) {
+ if (member->code && member->code->procPtr->bodyPtr) {
+ objPtr = member->code->procPtr->bodyPtr;
+ } else {
+ objPtr = Tcl_NewStringObj("", -1);
+ }
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ }
+
+ /*
+ * If the result list has a single element, then
+ * return it using Tcl_SetResult() so that it will
+ * look like a string and not a list with one element.
+ */
+ if (valc == 1) {
+ objPtr = valv[0];
+ } else {
+ objPtr = Tcl_NewListObj(valc, valv);
+ }
+ Tcl_SetObjResult(interp, objPtr);
+
+ for (i=0; i < valc; i++) {
+ Tcl_DecrRefCount(valv[i]);
+ }
+ }
+ }
+
+ /*
+ * Return the list of public variables.
+ */
+ else {
+ listPtr = Tcl_NewListObj(0, (Tcl_Obj* CONST*)NULL);
+
+ Itcl_InitHierIter(&hier, contextClass);
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ while (cdPtr != NULL) {
+ entry = Tcl_FirstHashEntry(&cdPtr->variables, &place);
+ while (entry) {
+ vdefn = (ItclVarDefn*)Tcl_GetHashValue(entry);
+ member = vdefn->member;
+
+ if ((member->flags & ITCL_COMMON) == 0 &&
+ member->protection == ITCL_PUBLIC) {
+
+ objPtr = Tcl_NewStringObj(member->classDefn->name, -1);
+ Tcl_AppendToObj(objPtr, "::", -1);
+ Tcl_AppendToObj(objPtr, member->name, -1);
+
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
+ objPtr);
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ }
+ Itcl_DeleteHierIter(&hier);
+
+ Tcl_SetObjResult(interp, listPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclOldBiInfoProtectedsCmd()
+ *
+ * Sets the interpreter result to contain information for protected
+ * variables in the class. Handles the following syntax:
+ *
+ * info protected ?varName? ?-init? ?-value?
+ *
+ * If the ?varName? is not specified, then a list of all known public
+ * variables is returned. Otherwise, the information (init/value)
+ * for a specific variable is returned. Returns a status
+ * TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+ItclOldBiInfoProtectedsCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ char *varName = NULL;
+ int varInit = 0;
+ int varValue = 0;
+
+ char *token, *val;
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+
+ ItclClass *cdPtr;
+ ItclVarLookup *vlookup;
+ ItclVarDefn *vdefn;
+ ItclMember *member;
+ ItclHierIter hier;
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch place;
+ Tcl_Obj *objPtr, *listPtr;
+
+ /*
+ * If this command is not invoked within a class namespace,
+ * signal an error.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Process args: ?varName? ?-init? ?-value?
+ */
+ objv++; /* skip over command name */
+ objc--;
+
+ if (objc > 0) {
+ varName = Tcl_GetStringFromObj(*objv, (int*)NULL);
+ objc--; objv++;
+ }
+ for ( ; objc > 0; objc--, objv++) {
+ token = Tcl_GetStringFromObj(*objv, (int*)NULL);
+ if (strcmp(token, "-init") == 0)
+ varInit = ~0;
+ else if (strcmp(token, "-value") == 0)
+ varValue = ~0;
+ else {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad option \"", token, "\": should be -init or -value",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Return info for a specific variable.
+ */
+ if (varName) {
+ vlookup = NULL;
+ entry = Tcl_FindHashEntry(&contextClass->resolveVars, varName);
+ if (entry) {
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+ if (vlookup->vdefn->member->protection != ITCL_PROTECTED) {
+ vlookup = NULL;
+ }
+ }
+
+ if (vlookup) {
+ int i, valc = 0;
+ Tcl_Obj *valv[5];
+
+ member = vlookup->vdefn->member;
+
+ if (!varInit && !varValue) {
+ objPtr = Tcl_NewStringObj(member->classDefn->name, -1);
+ Tcl_AppendToObj(objPtr, "::", -1);
+ Tcl_AppendToObj(objPtr, member->name, -1);
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ varInit = varValue = ~0;
+ }
+
+ /*
+ * If this is the built-in "this" variable, then
+ * report the object name as its initialization string.
+ */
+ if (varInit) {
+ if ((member->flags & ITCL_THIS_VAR) != 0) {
+ if (contextObj && contextObj->accessCmd) {
+ objPtr = Tcl_NewStringObj("", -1);
+ Tcl_IncrRefCount(objPtr);
+ Tcl_GetCommandFullName(contextObj->classDefn->interp,
+ contextObj->accessCmd, objPtr);
+ valv[valc++] = objPtr;
+ }
+ else {
+ objPtr = Tcl_NewStringObj("<objectName>", -1);
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ }
+ }
+ else {
+ val = (vlookup->vdefn->init) ? vlookup->vdefn->init : "";
+ objPtr = Tcl_NewStringObj(val, -1);
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ }
+ }
+
+ if (varValue) {
+ val = Itcl_GetInstanceVar(interp, member->fullname,
+ contextObj, contextObj->classDefn);
+
+ if (!val) {
+ val = "<undefined>";
+ }
+ objPtr = Tcl_NewStringObj(val, -1);
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ }
+
+ /*
+ * If the result list has a single element, then
+ * return it using Tcl_SetResult() so that it will
+ * look like a string and not a list with one element.
+ */
+ if (valc == 1) {
+ objPtr = valv[0];
+ } else {
+ objPtr = Tcl_NewListObj(valc, valv);
+ }
+ Tcl_SetObjResult(interp, objPtr);
+
+ for (i=0; i < valc; i++) {
+ Tcl_DecrRefCount(valv[i]);
+ }
+ }
+ }
+
+ /*
+ * Return the list of public variables.
+ */
+ else {
+ listPtr = Tcl_NewListObj(0, (Tcl_Obj* CONST*)NULL);
+
+ Itcl_InitHierIter(&hier, contextClass);
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ while (cdPtr != NULL) {
+ entry = Tcl_FirstHashEntry(&cdPtr->variables, &place);
+ while (entry) {
+ vdefn = (ItclVarDefn*)Tcl_GetHashValue(entry);
+ member = vdefn->member;
+
+ if ((member->flags & ITCL_COMMON) == 0 &&
+ member->protection == ITCL_PROTECTED) {
+
+ objPtr = Tcl_NewStringObj(member->classDefn->name, -1);
+ Tcl_AppendToObj(objPtr, "::", -1);
+ Tcl_AppendToObj(objPtr, member->name, -1);
+
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
+ objPtr);
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ }
+ Itcl_DeleteHierIter(&hier);
+
+ Tcl_SetObjResult(interp, listPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclOldBiInfoCommonsCmd()
+ *
+ * Sets the interpreter result to contain information for common
+ * variables in the class. Handles the following syntax:
+ *
+ * info common ?varName? ?-init? ?-value?
+ *
+ * If the ?varName? is not specified, then a list of all known common
+ * variables is returned. Otherwise, the information (init/value)
+ * for a specific variable is returned. Returns a status
+ * TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+ItclOldBiInfoCommonsCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* not used */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ char *varName = NULL;
+ int varInit = 0;
+ int varValue = 0;
+
+ char *token, *val;
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+
+ ItclClass *cdPtr;
+ ItclVarDefn *vdefn;
+ ItclVarLookup *vlookup;
+ ItclMember *member;
+ ItclHierIter hier;
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch place;
+ Tcl_Obj *objPtr, *listPtr;
+
+ /*
+ * If this command is not invoked within a class namespace,
+ * signal an error.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Process args: ?varName? ?-init? ?-value?
+ */
+ objv++; /* skip over command name */
+ objc--;
+
+ if (objc > 0) {
+ varName = Tcl_GetStringFromObj(*objv, (int*)NULL);
+ objc--; objv++;
+ }
+ for ( ; objc > 0; objc--, objv++) {
+ token = Tcl_GetStringFromObj(*objv, (int*)NULL);
+ if (strcmp(token, "-init") == 0)
+ varInit = ~0;
+ else if (strcmp(token, "-value") == 0)
+ varValue = ~0;
+ else {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad option \"", token, "\": should be -init or -value",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Return info for a specific variable.
+ */
+ if (varName) {
+ vlookup = NULL;
+ entry = Tcl_FindHashEntry(&contextClass->resolveVars, varName);
+ if (entry) {
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+ if (vlookup->vdefn->member->protection != ITCL_PROTECTED) {
+ vlookup = NULL;
+ }
+ }
+
+ if (vlookup) {
+ int i, valc = 0;
+ Tcl_Obj *valv[5];
+
+ member = vlookup->vdefn->member;
+
+ if (!varInit && !varValue) {
+ objPtr = Tcl_NewStringObj(member->classDefn->name, -1);
+ Tcl_AppendToObj(objPtr, "::", -1);
+ Tcl_AppendToObj(objPtr, member->name, -1);
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ varInit = varValue = ~0;
+ }
+ if (varInit) {
+ val = (vlookup->vdefn->init) ? vlookup->vdefn->init : "";
+ objPtr = Tcl_NewStringObj(val, -1);
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ }
+
+ if (varValue) {
+ val = Itcl_GetCommonVar(interp, member->fullname,
+ contextObj->classDefn);
+
+ if (!val) {
+ val = "<undefined>";
+ }
+ objPtr = Tcl_NewStringObj(val, -1);
+ Tcl_IncrRefCount(objPtr);
+ valv[valc++] = objPtr;
+ }
+
+ /*
+ * If the result list has a single element, then
+ * return it using Tcl_SetResult() so that it will
+ * look like a string and not a list with one element.
+ */
+ if (valc == 1) {
+ objPtr = valv[0];
+ } else {
+ objPtr = Tcl_NewListObj(valc, valv);
+ }
+ Tcl_SetObjResult(interp, objPtr);
+
+ for (i=0; i < valc; i++) {
+ Tcl_DecrRefCount(valv[i]);
+ }
+ }
+ }
+
+ /*
+ * Return the list of public variables.
+ */
+ else {
+ listPtr = Tcl_NewListObj(0, (Tcl_Obj* CONST*)NULL);
+
+ Itcl_InitHierIter(&hier, contextClass);
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ while (cdPtr != NULL) {
+ entry = Tcl_FirstHashEntry(&cdPtr->variables, &place);
+ while (entry) {
+ vdefn = (ItclVarDefn*)Tcl_GetHashValue(entry);
+ member = vdefn->member;
+
+ if ((member->flags & ITCL_COMMON) &&
+ member->protection == ITCL_PROTECTED) {
+
+ objPtr = Tcl_NewStringObj(member->classDefn->name, -1);
+ Tcl_AppendToObj(objPtr, "::", -1);
+ Tcl_AppendToObj(objPtr, member->name, -1);
+
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
+ objPtr);
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ }
+ Itcl_DeleteHierIter(&hier);
+
+ Tcl_SetObjResult(interp, listPtr);
+ }
+ return TCL_OK;
+}
diff --git a/itcl/itcl/generic/itcl_parse.c b/itcl/itcl/generic/itcl_parse.c
new file mode 100644
index 00000000000..dac966f4e01
--- /dev/null
+++ b/itcl/itcl/generic/itcl_parse.c
@@ -0,0 +1,1086 @@
+/*
+ * ------------------------------------------------------------------------
+ * PACKAGE: [incr Tcl]
+ * DESCRIPTION: Object-Oriented Extensions to Tcl
+ *
+ * [incr Tcl] provides object-oriented extensions to Tcl, much as
+ * C++ provides object-oriented extensions to C. It provides a means
+ * of encapsulating related procedures together with their shared data
+ * in a local namespace that is hidden from the outside world. It
+ * promotes code re-use through inheritance. More than anything else,
+ * it encourages better organization of Tcl applications through the
+ * object-oriented paradigm, leading to code that is easier to
+ * understand and maintain.
+ *
+ * Procedures in this file support the new syntax for [incr Tcl]
+ * class definitions:
+ *
+ * itcl_class <className> {
+ * inherit <base-class>...
+ *
+ * constructor {<arglist>} ?{<init>}? {<body>}
+ * destructor {<body>}
+ *
+ * method <name> {<arglist>} {<body>}
+ * proc <name> {<arglist>} {<body>}
+ * variable <name> ?<init>? ?<config>?
+ * common <name> ?<init>?
+ *
+ * public <thing> ?<args>...?
+ * protected <thing> ?<args>...?
+ * private <thing> ?<args>...?
+ * }
+ *
+ * ========================================================================
+ * AUTHOR: Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ * http://www.tcltk.com/itcl
+ *
+ * RCS: $Id$
+ * ========================================================================
+ * Copyright (c) 1993-1998 Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#include "itclInt.h"
+
+/*
+ * Info needed for public/protected/private commands:
+ */
+typedef struct ProtectionCmdInfo {
+ int pLevel; /* protection level */
+ ItclObjectInfo *info; /* info regarding all known objects */
+} ProtectionCmdInfo;
+
+/*
+ * FORWARD DECLARATIONS
+ */
+static void ItclFreeParserCommandData _ANSI_ARGS_((char* cdata));
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ParseInit()
+ *
+ * Invoked by Itcl_Init() whenever a new interpeter is created to add
+ * [incr Tcl] facilities. Adds the commands needed to parse class
+ * definitions.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ParseInit(interp, info)
+ Tcl_Interp *interp; /* interpreter to be updated */
+ ItclObjectInfo *info; /* info regarding all known objects */
+{
+ Tcl_Namespace *parserNs;
+ ProtectionCmdInfo *pInfo;
+
+ /*
+ * Create the "itcl::parser" namespace used to parse class
+ * definitions.
+ */
+ parserNs = Tcl_CreateNamespace(interp, "::itcl::parser",
+ (ClientData)info, Itcl_ReleaseData);
+
+ if (!parserNs) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ " (cannot initialize itcl parser)",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ Itcl_PreserveData((ClientData)info);
+
+ /*
+ * Add commands for parsing class definitions.
+ */
+ Tcl_CreateObjCommand(interp, "::itcl::parser::inherit",
+ Itcl_ClassInheritCmd, (ClientData)info, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itcl::parser::constructor",
+ Itcl_ClassConstructorCmd, (ClientData)info, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itcl::parser::destructor",
+ Itcl_ClassDestructorCmd, (ClientData)info, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itcl::parser::method",
+ Itcl_ClassMethodCmd, (ClientData)info, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itcl::parser::proc",
+ Itcl_ClassProcCmd, (ClientData)info, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itcl::parser::common",
+ Itcl_ClassCommonCmd, (ClientData)info, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itcl::parser::variable",
+ Itcl_ClassVariableCmd, (ClientData)info, (Tcl_CmdDeleteProc*)NULL);
+
+ pInfo = (ProtectionCmdInfo*)ckalloc(sizeof(ProtectionCmdInfo));
+ pInfo->pLevel = ITCL_PUBLIC;
+ pInfo->info = info;
+
+ Tcl_CreateObjCommand(interp, "::itcl::parser::public",
+ Itcl_ClassProtectionCmd, (ClientData)pInfo,
+ (Tcl_CmdDeleteProc*) ItclFreeParserCommandData);
+
+ pInfo = (ProtectionCmdInfo*)ckalloc(sizeof(ProtectionCmdInfo));
+ pInfo->pLevel = ITCL_PROTECTED;
+ pInfo->info = info;
+
+ Tcl_CreateObjCommand(interp, "::itcl::parser::protected",
+ Itcl_ClassProtectionCmd, (ClientData)pInfo,
+ (Tcl_CmdDeleteProc*) ItclFreeParserCommandData);
+
+ pInfo = (ProtectionCmdInfo*)ckalloc(sizeof(ProtectionCmdInfo));
+ pInfo->pLevel = ITCL_PRIVATE;
+ pInfo->info = info;
+
+ Tcl_CreateObjCommand(interp, "::itcl::parser::private",
+ Itcl_ClassProtectionCmd, (ClientData)pInfo,
+ (Tcl_CmdDeleteProc*) ItclFreeParserCommandData);
+
+ /*
+ * Set the runtime variable resolver for the parser namespace,
+ * to control access to "common" data members while parsing
+ * the class definition.
+ */
+ Tcl_SetNamespaceResolvers(parserNs, (Tcl_ResolveCmdProc*)NULL,
+ Itcl_ParseVarResolver, (Tcl_ResolveCompiledVarProc*)NULL);
+
+ /*
+ * Install the "class" command for defining new classes.
+ */
+ Tcl_CreateObjCommand(interp, "::itcl::class", Itcl_ClassCmd,
+ (ClientData)info, Itcl_ReleaseData);
+ Itcl_PreserveData((ClientData)info);
+
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ClassCmd()
+ *
+ * Invoked by Tcl whenever the user issues an "itcl::class" command to
+ * specify a class definition. Handles the following syntax:
+ *
+ * itcl::class <className> {
+ * inherit <base-class>...
+ *
+ * constructor {<arglist>} ?{<init>}? {<body>}
+ * destructor {<body>}
+ *
+ * method <name> {<arglist>} {<body>}
+ * proc <name> {<arglist>} {<body>}
+ * variable <varname> ?<init>? ?<config>?
+ * common <varname> ?<init>?
+ *
+ * public <args>...
+ * protected <args>...
+ * private <args>...
+ * }
+ *
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ClassCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* info for all known objects */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclObjectInfo* info = (ItclObjectInfo*)clientData;
+
+ int result;
+ char *className;
+ Tcl_Namespace *parserNs;
+ ItclClass *cdefnPtr;
+ Tcl_CallFrame frame;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name { definition }");
+ return TCL_ERROR;
+ }
+ className = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+
+ /*
+ * Find the namespace to use as a parser for the class definition.
+ * If for some reason it is destroyed, bail out here.
+ */
+ parserNs = Tcl_FindNamespace(interp, "::itcl::parser",
+ (Tcl_Namespace*)NULL, TCL_LEAVE_ERR_MSG);
+
+ if (parserNs == NULL) {
+ char msg[256];
+ sprintf(msg, "\n (while parsing class definition for \"%.100s\")",
+ className);
+ Tcl_AddErrorInfo(interp, msg);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Try to create the specified class and its namespace.
+ */
+ if (Itcl_CreateClass(interp, className, info, &cdefnPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Import the built-in commands from the itcl::builtin namespace.
+ * Do this before parsing the class definition, so methods/procs
+ * can override the built-in commands.
+ */
+ result = Tcl_Import(interp, cdefnPtr->namesp, "::itcl::builtin::*",
+ /* allowOverwrite */ 1);
+
+ if (result != TCL_OK) {
+ char msg[256];
+ sprintf(msg, "\n (while installing built-in commands for class \"%.100s\")", className);
+ Tcl_AddErrorInfo(interp, msg);
+
+ Tcl_DeleteNamespace(cdefnPtr->namesp);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Push this class onto the class definition stack so that it
+ * becomes the current context for all commands in the parser.
+ * Activate the parser and evaluate the class definition.
+ */
+ Itcl_PushStack((ClientData)cdefnPtr, &info->cdefnStack);
+
+ result = Tcl_PushCallFrame(interp, &frame, parserNs,
+ /* isProcCallFrame */ 0);
+
+ if (result == TCL_OK) {
+ /* CYGNUS LOCAL - Fix for Tcl8.1 */
+#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ result = Tcl_EvalObj(interp, objv[2]);
+#else
+ result = Tcl_EvalObj(interp, objv[2], 0);
+#endif
+ /* END CYGNUS LOCAL */
+ Tcl_PopCallFrame(interp);
+ }
+ Itcl_PopStack(&info->cdefnStack);
+
+ if (result != TCL_OK) {
+ char msg[256];
+ sprintf(msg, "\n (class \"%.200s\" body line %d)",
+ className, interp->errorLine);
+ Tcl_AddErrorInfo(interp, msg);
+
+ Tcl_DeleteNamespace(cdefnPtr->namesp);
+ return TCL_ERROR;
+ }
+
+ /*
+ * At this point, parsing of the class definition has succeeded.
+ * Add built-in methods such as "configure" and "cget"--as long
+ * as they don't conflict with those defined in the class.
+ */
+ if (Itcl_InstallBiMethods(interp, cdefnPtr) != TCL_OK) {
+ Tcl_DeleteNamespace(cdefnPtr->namesp);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Build the name resolution tables for all data members.
+ */
+ Itcl_BuildVirtualTables(cdefnPtr);
+
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ClassInheritCmd()
+ *
+ * Invoked by Tcl during the parsing of a class definition whenever
+ * the "inherit" command is invoked to define one or more base classes.
+ * Handles the following syntax:
+ *
+ * inherit <baseclass> ?<baseclass>...?
+ *
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ClassInheritCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* info for all known objects */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclObjectInfo *info = (ItclObjectInfo*)clientData;
+ ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);
+
+ int result, i, newEntry;
+ char *token;
+ Itcl_ListElem *elem, *elem2;
+ ItclClass *cdPtr, *baseCdefnPtr, *badCdPtr;
+ ItclHierIter hier;
+ Itcl_Stack stack;
+ Tcl_CallFrame frame;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "class ?class...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * In "inherit" statement can only be included once in a
+ * class definition.
+ */
+ elem = Itcl_FirstListElem(&cdefnPtr->bases);
+ if (elem != NULL) {
+ Tcl_AppendToObj(Tcl_GetObjResult(interp), "inheritance \"", -1);
+
+ while (elem) {
+ cdPtr = (ItclClass*)Itcl_GetListValue(elem);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ cdPtr->name, " ", (char*)NULL);
+
+ elem = Itcl_NextListElem(elem);
+ }
+
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\" already defined for class \"", cdefnPtr->fullname, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Validate each base class and add it to the "bases" list.
+ */
+ result = Tcl_PushCallFrame(interp, &frame, cdefnPtr->namesp->parentPtr,
+ /* isProcCallFrame */ 0);
+
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ for (objc--,objv++; objc > 0; objc--,objv++) {
+
+ /*
+ * Make sure that the base class name is known in the
+ * parent namespace (currently active). If not, try
+ * to autoload its definition.
+ */
+ token = Tcl_GetStringFromObj(*objv, (int*)NULL);
+ baseCdefnPtr = Itcl_FindClass(interp, token, /* autoload */ 1);
+ if (!baseCdefnPtr) {
+ Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+ int errlen;
+ char *errmsg;
+
+ Tcl_IncrRefCount(resultPtr);
+ errmsg = Tcl_GetStringFromObj(resultPtr, &errlen);
+
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot inherit from \"", token, "\"",
+ (char*)NULL);
+
+ if (errlen > 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ " (", errmsg, ")", (char*)NULL);
+ }
+ Tcl_DecrRefCount(resultPtr);
+ goto inheritError;
+ }
+
+ /*
+ * Make sure that the base class is not the same as the
+ * class that is being built.
+ */
+ if (baseCdefnPtr == cdefnPtr) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "class \"", cdefnPtr->name, "\" cannot inherit from itself",
+ (char*)NULL);
+ goto inheritError;
+ }
+
+ Itcl_AppendList(&cdefnPtr->bases, (ClientData)baseCdefnPtr);
+ Itcl_PreserveData((ClientData)baseCdefnPtr);
+ }
+
+ /*
+ * Scan through the inheritance list to make sure that no
+ * class appears twice.
+ */
+ elem = Itcl_FirstListElem(&cdefnPtr->bases);
+ while (elem) {
+ elem2 = Itcl_NextListElem(elem);
+ while (elem2) {
+ if (Itcl_GetListValue(elem) == Itcl_GetListValue(elem2)) {
+ cdPtr = (ItclClass*)Itcl_GetListValue(elem);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "class \"", cdefnPtr->fullname,
+ "\" cannot inherit base class \"",
+ cdPtr->fullname, "\" more than once",
+ (char*)NULL);
+ goto inheritError;
+ }
+ elem2 = Itcl_NextListElem(elem2);
+ }
+ elem = Itcl_NextListElem(elem);
+ }
+
+ /*
+ * Add each base class and all of its base classes into
+ * the heritage for the current class. Along the way, make
+ * sure that no class appears twice in the heritage.
+ */
+ Itcl_InitHierIter(&hier, cdefnPtr);
+ cdPtr = Itcl_AdvanceHierIter(&hier); /* skip the class itself */
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ while (cdPtr != NULL) {
+ (void) Tcl_CreateHashEntry(&cdefnPtr->heritage,
+ (char*)cdPtr, &newEntry);
+
+ if (!newEntry) {
+ break;
+ }
+ cdPtr = Itcl_AdvanceHierIter(&hier);
+ }
+ Itcl_DeleteHierIter(&hier);
+
+ /*
+ * Same base class found twice in the hierarchy?
+ * Then flag error. Show the list of multiple paths
+ * leading to the same base class.
+ */
+ if (!newEntry) {
+ Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+
+ badCdPtr = cdPtr;
+ Tcl_AppendStringsToObj(resultPtr,
+ "class \"", cdefnPtr->fullname, "\" inherits base class \"",
+ badCdPtr->fullname, "\" more than once:",
+ (char*)NULL);
+
+ cdPtr = cdefnPtr;
+ Itcl_InitStack(&stack);
+ Itcl_PushStack((ClientData)cdPtr, &stack);
+
+ /*
+ * Show paths leading to bad base class
+ */
+ while (Itcl_GetStackSize(&stack) > 0) {
+ cdPtr = (ItclClass*)Itcl_PopStack(&stack);
+
+ if (cdPtr == badCdPtr) {
+ Tcl_AppendToObj(resultPtr, "\n ", -1);
+ for (i=0; i < Itcl_GetStackSize(&stack); i++) {
+ if (Itcl_GetStackValue(&stack, i) == NULL) {
+ cdPtr = (ItclClass*)Itcl_GetStackValue(&stack, i-1);
+ Tcl_AppendStringsToObj(resultPtr,
+ cdPtr->name, "->",
+ (char*)NULL);
+ }
+ }
+ Tcl_AppendToObj(resultPtr, badCdPtr->name, -1);
+ }
+ else if (!cdPtr) {
+ (void)Itcl_PopStack(&stack);
+ }
+ else {
+ elem = Itcl_LastListElem(&cdPtr->bases);
+ if (elem) {
+ Itcl_PushStack((ClientData)cdPtr, &stack);
+ Itcl_PushStack((ClientData)NULL, &stack);
+ while (elem) {
+ Itcl_PushStack(Itcl_GetListValue(elem), &stack);
+ elem = Itcl_PrevListElem(elem);
+ }
+ }
+ }
+ }
+ Itcl_DeleteStack(&stack);
+ goto inheritError;
+ }
+
+ /*
+ * At this point, everything looks good.
+ * Finish the installation of the base classes. Update
+ * each base class to recognize the current class as a
+ * derived class.
+ */
+ elem = Itcl_FirstListElem(&cdefnPtr->bases);
+ while (elem) {
+ baseCdefnPtr = (ItclClass*)Itcl_GetListValue(elem);
+
+ Itcl_AppendList(&baseCdefnPtr->derived, (ClientData)cdefnPtr);
+ Itcl_PreserveData((ClientData)cdefnPtr);
+
+ elem = Itcl_NextListElem(elem);
+ }
+
+ Tcl_PopCallFrame(interp);
+ return TCL_OK;
+
+
+ /*
+ * If the "inherit" list cannot be built properly, tear it
+ * down and return an error.
+ */
+inheritError:
+ Tcl_PopCallFrame(interp);
+
+ elem = Itcl_FirstListElem(&cdefnPtr->bases);
+ while (elem) {
+ Itcl_ReleaseData( Itcl_GetListValue(elem) );
+ elem = Itcl_DeleteListElem(elem);
+ }
+ return TCL_ERROR;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ClassProtectionCmd()
+ *
+ * Invoked by Tcl whenever the user issues a protection setting
+ * command like "public" or "private". Creates commands and
+ * variables, and assigns a protection level to them. Protection
+ * levels are defined as follows:
+ *
+ * public => accessible from any namespace
+ * protected => accessible from selected namespaces
+ * private => accessible only in the namespace where it was defined
+ *
+ * Handles the following syntax:
+ *
+ * public <command> ?<arg> <arg>...?
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ClassProtectionCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* protection level (public/protected/private) */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ProtectionCmdInfo *pInfo = (ProtectionCmdInfo*)clientData;
+
+ int result;
+ int oldLevel;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "command ?arg arg...?");
+ return TCL_ERROR;
+ }
+
+ oldLevel = Itcl_Protection(interp, pInfo->pLevel);
+
+ if (objc == 2) {
+ /* CYGNUS LOCAL - Fix for Tcl8.1 */
+#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ result = Tcl_EvalObj(interp, objv[1]);
+#else
+ result = Tcl_EvalObj(interp, objv[1], 0);
+#endif
+ /* END CYGNUS LOCAL */
+ } else {
+ result = Itcl_EvalArgs(interp, objc-1, objv+1);
+ }
+
+ if (result == TCL_BREAK) {
+ Tcl_SetResult(interp, "invoked \"break\" outside of a loop",
+ TCL_STATIC);
+ result = TCL_ERROR;
+ }
+ else if (result == TCL_CONTINUE) {
+ Tcl_SetResult(interp, "invoked \"continue\" outside of a loop",
+ TCL_STATIC);
+ result = TCL_ERROR;
+ }
+ else if (result != TCL_OK) {
+ char mesg[256], *token;
+ token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ sprintf(mesg, "\n (%.100s body line %d)", token, interp->errorLine);
+ Tcl_AddErrorInfo(interp, mesg);
+ }
+
+ Itcl_Protection(interp, oldLevel);
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ClassConstructorCmd()
+ *
+ * Invoked by Tcl during the parsing of a class definition whenever
+ * the "constructor" command is invoked to define the constructor
+ * for an object. Handles the following syntax:
+ *
+ * constructor <arglist> ?<init>? <body>
+ *
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ClassConstructorCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* info for all known objects */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclObjectInfo *info = (ItclObjectInfo*)clientData;
+ ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);
+
+ char *name, *arglist, *body;
+
+ if (objc < 3 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "args ?init? body");
+ return TCL_ERROR;
+ }
+
+ name = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ if (Tcl_FindHashEntry(&cdefnPtr->functions, name)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\"", name, "\" already defined in class \"",
+ cdefnPtr->fullname, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If there is an object initialization statement, pick this
+ * out and take the last argument as the constructor body.
+ */
+ arglist = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ if (objc == 3) {
+ body = Tcl_GetStringFromObj(objv[2], (int*)NULL);
+ } else {
+ cdefnPtr->initCode = objv[2];
+ Tcl_IncrRefCount(cdefnPtr->initCode);
+ body = Tcl_GetStringFromObj(objv[3], (int*)NULL);
+ }
+
+ if (Itcl_CreateMethod(interp, cdefnPtr, name, arglist, body) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ClassDestructorCmd()
+ *
+ * Invoked by Tcl during the parsing of a class definition whenever
+ * the "destructor" command is invoked to define the destructor
+ * for an object. Handles the following syntax:
+ *
+ * destructor <body>
+ *
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ClassDestructorCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* info for all known objects */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclObjectInfo *info = (ItclObjectInfo*)clientData;
+ ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);
+
+ char *name, *body;
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "body");
+ return TCL_ERROR;
+ }
+
+ name = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ body = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+
+ if (Tcl_FindHashEntry(&cdefnPtr->functions, name)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "\"", name, "\" already defined in class \"",
+ cdefnPtr->fullname, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ if (Itcl_CreateMethod(interp, cdefnPtr, name, (char*)NULL, body)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ClassMethodCmd()
+ *
+ * Invoked by Tcl during the parsing of a class definition whenever
+ * the "method" command is invoked to define an object method.
+ * Handles the following syntax:
+ *
+ * method <name> ?<arglist>? ?<body>?
+ *
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ClassMethodCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* info for all known objects */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclObjectInfo *info = (ItclObjectInfo*)clientData;
+ ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);
+
+ char *name, *arglist, *body;
+
+ if (objc < 2 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name ?args? ?body?");
+ return TCL_ERROR;
+ }
+
+ name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+
+ arglist = NULL;
+ body = NULL;
+ if (objc >= 3) {
+ arglist = Tcl_GetStringFromObj(objv[2], (int*)NULL);
+ }
+ if (objc >= 4) {
+ body = Tcl_GetStringFromObj(objv[3], (int*)NULL);
+ }
+
+ if (Itcl_CreateMethod(interp, cdefnPtr, name, arglist, body) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ClassProcCmd()
+ *
+ * Invoked by Tcl during the parsing of a class definition whenever
+ * the "proc" command is invoked to define a common class proc.
+ * A "proc" is like a "method", but only has access to "common"
+ * class variables. Handles the following syntax:
+ *
+ * proc <name> ?<arglist>? ?<body>?
+ *
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ClassProcCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* info for all known objects */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclObjectInfo *info = (ItclObjectInfo*)clientData;
+ ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);
+ char *name, *arglist, *body;
+
+ if (objc < 2 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name ?args? ?body?");
+ return TCL_ERROR;
+ }
+
+ name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+
+ arglist = NULL;
+ body = NULL;
+ if (objc >= 3) {
+ arglist = Tcl_GetStringFromObj(objv[2], (int*)NULL);
+ }
+ if (objc >= 4) {
+ body = Tcl_GetStringFromObj(objv[3], (int*)NULL);
+ }
+
+ if (Itcl_CreateProc(interp, cdefnPtr, name, arglist, body) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ClassVariableCmd()
+ *
+ * Invoked by Tcl during the parsing of a class definition whenever
+ * the "variable" command is invoked to define an instance variable.
+ * Handles the following syntax:
+ *
+ * variable <varname> ?<init>? ?<config>?
+ *
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ClassVariableCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* info for all known objects */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclObjectInfo *info = (ItclObjectInfo*)clientData;
+ ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);
+
+ int pLevel;
+ ItclVarDefn *vdefn;
+ char *name, *init, *config;
+
+ pLevel = Itcl_Protection(interp, 0);
+
+ if (pLevel == ITCL_PUBLIC) {
+ if (objc < 2 || objc > 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name ?init? ?config?");
+ return TCL_ERROR;
+ }
+ }
+ else if ((objc < 2) || (objc > 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "name ?init?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that the variable name does not contain anything
+ * goofy like a "::" scope qualifier.
+ */
+ name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ if (strstr(name, "::")) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad variable name \"", name, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ init = NULL;
+ config = NULL;
+ if (objc >= 3) {
+ init = Tcl_GetStringFromObj(objv[2], (int*)NULL);
+ }
+ if (objc >= 4) {
+ config = Tcl_GetStringFromObj(objv[3], (int*)NULL);
+ }
+
+ if (Itcl_CreateVarDefn(interp, cdefnPtr, name, init, config,
+ &vdefn) != TCL_OK) {
+
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ClassCommonCmd()
+ *
+ * Invoked by Tcl during the parsing of a class definition whenever
+ * the "common" command is invoked to define a variable that is
+ * common to all objects in the class. Handles the following syntax:
+ *
+ * common <varname> ?<init>?
+ *
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_ClassCommonCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* info for all known objects */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclObjectInfo *info = (ItclObjectInfo*)clientData;
+ ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);
+
+ int newEntry;
+ char *name, *init;
+ ItclVarDefn *vdefn;
+ Tcl_HashEntry *entry;
+ Namespace *nsPtr;
+ Var *varPtr;
+
+ if ((objc < 2) || (objc > 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "varname ?init?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that the variable name does not contain anything
+ * goofy like a "::" scope qualifier.
+ */
+ name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ if (strstr(name, "::")) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad variable name \"", name, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ init = NULL;
+ if (objc >= 3) {
+ init = Tcl_GetStringFromObj(objv[2], (int*)NULL);
+ }
+
+ if (Itcl_CreateVarDefn(interp, cdefnPtr, name, init, (char*)NULL,
+ &vdefn) != TCL_OK) {
+
+ return TCL_ERROR;
+ }
+ vdefn->member->flags |= ITCL_COMMON;
+
+ /*
+ * Create the variable in the namespace associated with the
+ * class. Do this the hard way, to avoid the variable resolver
+ * procedures. These procedures won't work until we rebuild
+ * the virtual tables below.
+ */
+ nsPtr = (Namespace*)cdefnPtr->namesp;
+ entry = Tcl_CreateHashEntry(&nsPtr->varTable,
+ vdefn->member->name, &newEntry);
+
+ varPtr = _TclNewVar();
+ varPtr->hPtr = entry;
+ varPtr->nsPtr = nsPtr;
+ varPtr->flags |= VAR_NAMESPACE_VAR;
+ varPtr->refCount++; /* one use by namespace */
+ varPtr->refCount++; /* another use by class */
+
+ Tcl_SetHashValue(entry, varPtr);
+
+ /*
+ * TRICKY NOTE: Make sure to rebuild the virtual tables for this
+ * class so that this variable is ready to access. The variable
+ * resolver for the parser namespace needs this info to find the
+ * variable if the developer tries to set it within the class
+ * definition.
+ *
+ * If an initialization value was specified, then initialize
+ * the variable now.
+ */
+ Itcl_BuildVirtualTables(cdefnPtr);
+
+ if (init) {
+ init = Tcl_SetVar(interp, vdefn->member->name, init,
+ TCL_NAMESPACE_ONLY);
+
+ if (!init) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot initialize common variable \"",
+ vdefn->member->name, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ParseVarResolver()
+ *
+ * Used by the "parser" namespace to resolve variable accesses to
+ * common variables. The runtime resolver procedure is consulted
+ * whenever a variable is accessed within the namespace. It can
+ * deny access to certain variables, or perform special lookups itself.
+ *
+ * This procedure allows access only to "common" class variables that
+ * have been declared within the class or inherited from another class.
+ * A "set" command can be used to initialized common data members within
+ * the body of the class definition itself:
+ *
+ * itcl::class Foo {
+ * common colors
+ * set colors(red) #ff0000
+ * set colors(green) #00ff00
+ * set colors(blue) #0000ff
+ * ...
+ * }
+ *
+ * itcl::class Bar {
+ * inherit Foo
+ * set colors(gray) #a0a0a0
+ * set colors(white) #ffffff
+ *
+ * common numbers
+ * set numbers(0) zero
+ * set numbers(1) one
+ * }
+ *
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itcl_ParseVarResolver(interp, name, contextNs, flags, rPtr)
+ Tcl_Interp *interp; /* current interpreter */
+ char* name; /* name of the variable being accessed */
+ Tcl_Namespace *contextNs; /* namespace context */
+ int flags; /* TCL_GLOBAL_ONLY => global variable
+ * TCL_NAMESPACE_ONLY => namespace variable */
+ Tcl_Var* rPtr; /* returns: Tcl_Var for desired variable */
+{
+ ItclObjectInfo *info = (ItclObjectInfo*)contextNs->clientData;
+ ItclClass *cdefnPtr = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);
+
+ Tcl_HashEntry *entry;
+ ItclVarLookup *vlookup;
+
+ /*
+ * See if the requested variable is a recognized "common" member.
+ * If it is, make sure that access is allowed.
+ */
+ entry = Tcl_FindHashEntry(&cdefnPtr->resolveVars, name);
+ if (entry) {
+ vlookup = (ItclVarLookup*)Tcl_GetHashValue(entry);
+
+ if ((vlookup->vdefn->member->flags & ITCL_COMMON) != 0) {
+ if (!vlookup->accessible) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "can't access \"", name, "\": ",
+ Itcl_ProtectionStr(vlookup->vdefn->member->protection),
+ " variable",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ *rPtr = vlookup->var.common;
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * If the variable is not recognized, return TCL_CONTINUE and
+ * let lookup continue via the normal name resolution rules.
+ * This is important for variables like "errorInfo"
+ * that might get set while the parser namespace is active.
+ */
+ return TCL_CONTINUE;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * ItclFreeParserCommandData()
+ *
+ * This callback will free() up memory dynamically allocated
+ * and passed as the ClientData argument to Tcl_CreateObjCommand.
+ * This callback is required because one can not simply pass
+ * a pointer to the free() or ckfree() to Tcl_CreateObjCommand.
+ * ------------------------------------------------------------------------
+ */
+static void
+ItclFreeParserCommandData(cdata)
+ char* cdata; /* client data to be destroyed */
+{
+ ckfree(cdata);
+}
diff --git a/itcl/itcl/generic/itcl_util.c b/itcl/itcl/generic/itcl_util.c
new file mode 100644
index 00000000000..e33823ba877
--- /dev/null
+++ b/itcl/itcl/generic/itcl_util.c
@@ -0,0 +1,1383 @@
+/*
+ * ------------------------------------------------------------------------
+ * PACKAGE: [incr Tcl]
+ * DESCRIPTION: Object-Oriented Extensions to Tcl
+ *
+ * [incr Tcl] provides object-oriented extensions to Tcl, much as
+ * C++ provides object-oriented extensions to C. It provides a means
+ * of encapsulating related procedures together with their shared data
+ * in a local namespace that is hidden from the outside world. It
+ * promotes code re-use through inheritance. More than anything else,
+ * it encourages better organization of Tcl applications through the
+ * object-oriented paradigm, leading to code that is easier to
+ * understand and maintain.
+ *
+ * This segment provides common utility functions used throughout
+ * the other [incr Tcl] source files.
+ *
+ * ========================================================================
+ * AUTHOR: Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ * http://www.tcltk.com/itcl
+ *
+ * RCS: $Id$
+ * ========================================================================
+ * Copyright (c) 1993-1998 Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#include "itclInt.h"
+#include "tclCompile.h"
+
+/*
+ * POOL OF LIST ELEMENTS FOR LINKED LIST
+ */
+static Itcl_ListElem *listPool = NULL;
+static int listPoolLen = 0;
+
+#define ITCL_VALID_LIST 0x01face10 /* magic bit pattern for validation */
+#define ITCL_LIST_POOL_SIZE 200 /* max number of elements in listPool */
+
+
+/*
+ * These records are used to keep track of reference-counted data
+ * for Itcl_PreserveData and Itcl_ReleaseData.
+ */
+typedef struct ItclPreservedData {
+ ClientData data; /* reference to data */
+ int usage; /* number of active uses */
+ Tcl_FreeProc *fproc; /* procedure used to free data */
+} ItclPreservedData;
+
+static Tcl_HashTable *ItclPreservedList = NULL;
+
+
+/*
+ * This structure is used to take a snapshot of the interpreter
+ * state in Itcl_SaveInterpState. You can snapshot the state,
+ * execute a command, and then back up to the result or the
+ * error that was previously in progress.
+ */
+typedef struct InterpState {
+ int validate; /* validation stamp */
+ int status; /* return code status */
+ Tcl_Obj *objResult; /* result object */
+ char *errorInfo; /* contents of errorInfo variable */
+ char *errorCode; /* contents of errorCode variable */
+} InterpState;
+
+#define TCL_STATE_VALID 0x01233210 /* magic bit pattern for validation */
+
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_Assert()
+ *
+ * Called whenever an assert() test fails. Prints a diagnostic
+ * message and abruptly exits.
+ * ------------------------------------------------------------------------
+ */
+#ifndef NDEBUG
+
+void
+Itcl_Assert(testExpr, fileName, lineNumber)
+ char *testExpr; /* string representing test expression */
+ char *fileName; /* file name containing this call */
+ int lineNumber; /* line number containing this call */
+{
+ fprintf(stderr, "Assertion failed: \"%s\" (line %d of %s)",
+ testExpr, lineNumber, fileName);
+ abort();
+}
+
+#endif
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_InitStack()
+ *
+ * Initializes a stack structure, allocating a certain amount of memory
+ * for the stack and setting the stack length to zero.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_InitStack(stack)
+ Itcl_Stack *stack; /* stack to be initialized */
+{
+ stack->values = stack->space;
+ stack->max = sizeof(stack->space)/sizeof(ClientData);
+ stack->len = 0;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_DeleteStack()
+ *
+ * Destroys a stack structure, freeing any memory that may have been
+ * allocated to represent it.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_DeleteStack(stack)
+ Itcl_Stack *stack; /* stack to be deleted */
+{
+ /*
+ * If memory was explicitly allocated (instead of using the
+ * built-in buffer) then free it.
+ */
+ if (stack->values != stack->space) {
+ ckfree((char*)stack->values);
+ }
+ stack->values = NULL;
+ stack->len = stack->max = 0;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_PushStack()
+ *
+ * Pushes a piece of client data onto the top of the given stack.
+ * If the stack is not large enough, it is automatically resized.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_PushStack(cdata,stack)
+ ClientData cdata; /* data to be pushed onto stack */
+ Itcl_Stack *stack; /* stack */
+{
+ ClientData *newStack;
+
+ if (stack->len+1 >= stack->max) {
+ stack->max = 2*stack->max;
+ newStack = (ClientData*)
+ ckalloc((unsigned)(stack->max*sizeof(ClientData)));
+
+ if (stack->values) {
+ memcpy((char*)newStack, (char*)stack->values,
+ (size_t)(stack->len*sizeof(ClientData)));
+
+ if (stack->values != stack->space)
+ ckfree((char*)stack->values);
+ }
+ stack->values = newStack;
+ }
+ stack->values[stack->len++] = cdata;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_PopStack()
+ *
+ * Pops a bit of client data from the top of the given stack.
+ * ------------------------------------------------------------------------
+ */
+ClientData
+Itcl_PopStack(stack)
+ Itcl_Stack *stack; /* stack to be manipulated */
+{
+ if (stack->values && (stack->len > 0)) {
+ stack->len--;
+ return stack->values[stack->len];
+ }
+ return (ClientData)NULL;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_PeekStack()
+ *
+ * Gets the current value from the top of the given stack.
+ * ------------------------------------------------------------------------
+ */
+ClientData
+Itcl_PeekStack(stack)
+ Itcl_Stack *stack; /* stack to be examined */
+{
+ if (stack->values && (stack->len > 0)) {
+ return stack->values[stack->len-1];
+ }
+ return (ClientData)NULL;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_GetStackValue()
+ *
+ * Gets a value at some index within the stack. Index "0" is the
+ * first value pushed onto the stack.
+ * ------------------------------------------------------------------------
+ */
+ClientData
+Itcl_GetStackValue(stack,pos)
+ Itcl_Stack *stack; /* stack to be examined */
+ int pos; /* get value at this index */
+{
+ if (stack->values && (stack->len > 0)) {
+ assert(pos < stack->len);
+ return stack->values[pos];
+ }
+ return (ClientData)NULL;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_InitList()
+ *
+ * Initializes a linked list structure, setting the list to the empty
+ * state.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_InitList(listPtr)
+ Itcl_List *listPtr; /* list to be initialized */
+{
+ listPtr->validate = ITCL_VALID_LIST;
+ listPtr->num = 0;
+ listPtr->head = NULL;
+ listPtr->tail = NULL;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_DeleteList()
+ *
+ * Destroys a linked list structure, deleting all of its elements and
+ * setting it to an empty state. If the elements have memory associated
+ * with them, this memory must be freed before deleting the list or it
+ * will be lost.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_DeleteList(listPtr)
+ Itcl_List *listPtr; /* list to be deleted */
+{
+ Itcl_ListElem *elemPtr;
+
+ assert(listPtr->validate == ITCL_VALID_LIST);
+
+ elemPtr = listPtr->head;
+ while (elemPtr) {
+ elemPtr = Itcl_DeleteListElem(elemPtr);
+ }
+ listPtr->validate = 0;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_CreateListElem()
+ *
+ * Low-level routined used by procedures like Itcl_InsertList() and
+ * Itcl_AppendList() to create new list elements. If elements are
+ * available, one is taken from the list element pool. Otherwise,
+ * a new one is allocated.
+ * ------------------------------------------------------------------------
+ */
+Itcl_ListElem*
+Itcl_CreateListElem(listPtr)
+ Itcl_List *listPtr; /* list that will contain this new element */
+{
+ Itcl_ListElem *elemPtr;
+
+ if (listPoolLen > 0) {
+ elemPtr = listPool;
+ listPool = elemPtr->next;
+ --listPoolLen;
+ }
+ else {
+ elemPtr = (Itcl_ListElem*)ckalloc((unsigned)sizeof(Itcl_ListElem));
+ }
+ elemPtr->owner = listPtr;
+ elemPtr->value = NULL;
+ elemPtr->next = NULL;
+ elemPtr->prev = NULL;
+
+ return elemPtr;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_DeleteListElem()
+ *
+ * Destroys a single element in a linked list, returning it to a pool of
+ * elements that can be later reused. Returns a pointer to the next
+ * element in the list.
+ * ------------------------------------------------------------------------
+ */
+Itcl_ListElem*
+Itcl_DeleteListElem(elemPtr)
+ Itcl_ListElem *elemPtr; /* list element to be deleted */
+{
+ Itcl_List *listPtr;
+ Itcl_ListElem *nextPtr;
+
+ nextPtr = elemPtr->next;
+
+ if (elemPtr->prev) {
+ elemPtr->prev->next = elemPtr->next;
+ }
+ if (elemPtr->next) {
+ elemPtr->next->prev = elemPtr->prev;
+ }
+
+ listPtr = elemPtr->owner;
+ if (elemPtr == listPtr->head)
+ listPtr->head = elemPtr->next;
+ if (elemPtr == listPtr->tail)
+ listPtr->tail = elemPtr->prev;
+ --listPtr->num;
+
+ if (listPoolLen < ITCL_LIST_POOL_SIZE) {
+ elemPtr->next = listPool;
+ listPool = elemPtr;
+ ++listPoolLen;
+ }
+ else {
+ ckfree((char*)elemPtr);
+ }
+ return nextPtr;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_InsertList()
+ *
+ * Creates a new list element containing the given value and returns
+ * a pointer to it. The element is inserted at the beginning of the
+ * specified list.
+ * ------------------------------------------------------------------------
+ */
+Itcl_ListElem*
+Itcl_InsertList(listPtr,val)
+ Itcl_List *listPtr; /* list being modified */
+ ClientData val; /* value associated with new element */
+{
+ Itcl_ListElem *elemPtr;
+ assert(listPtr->validate == ITCL_VALID_LIST);
+
+ elemPtr = Itcl_CreateListElem(listPtr);
+
+ elemPtr->value = val;
+ elemPtr->next = listPtr->head;
+ elemPtr->prev = NULL;
+ if (listPtr->head) {
+ listPtr->head->prev = elemPtr;
+ }
+ listPtr->head = elemPtr;
+ if (listPtr->tail == NULL) {
+ listPtr->tail = elemPtr;
+ }
+ ++listPtr->num;
+
+ return elemPtr;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_InsertListElem()
+ *
+ * Creates a new list element containing the given value and returns
+ * a pointer to it. The element is inserted in the list just before
+ * the specified element.
+ * ------------------------------------------------------------------------
+ */
+Itcl_ListElem*
+Itcl_InsertListElem(pos,val)
+ Itcl_ListElem *pos; /* insert just before this element */
+ ClientData val; /* value associated with new element */
+{
+ Itcl_List *listPtr;
+ Itcl_ListElem *elemPtr;
+
+ listPtr = pos->owner;
+ assert(listPtr->validate == ITCL_VALID_LIST);
+ assert(pos != NULL);
+
+ elemPtr = Itcl_CreateListElem(listPtr);
+ elemPtr->value = val;
+
+ elemPtr->prev = pos->prev;
+ if (elemPtr->prev) {
+ elemPtr->prev->next = elemPtr;
+ }
+ elemPtr->next = pos;
+ pos->prev = elemPtr;
+
+ if (listPtr->head == pos) {
+ listPtr->head = elemPtr;
+ }
+ if (listPtr->tail == NULL) {
+ listPtr->tail = elemPtr;
+ }
+ ++listPtr->num;
+
+ return elemPtr;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_AppendList()
+ *
+ * Creates a new list element containing the given value and returns
+ * a pointer to it. The element is appended at the end of the
+ * specified list.
+ * ------------------------------------------------------------------------
+ */
+Itcl_ListElem*
+Itcl_AppendList(listPtr,val)
+ Itcl_List *listPtr; /* list being modified */
+ ClientData val; /* value associated with new element */
+{
+ Itcl_ListElem *elemPtr;
+ assert(listPtr->validate == ITCL_VALID_LIST);
+
+ elemPtr = Itcl_CreateListElem(listPtr);
+
+ elemPtr->value = val;
+ elemPtr->prev = listPtr->tail;
+ elemPtr->next = NULL;
+ if (listPtr->tail) {
+ listPtr->tail->next = elemPtr;
+ }
+ listPtr->tail = elemPtr;
+ if (listPtr->head == NULL) {
+ listPtr->head = elemPtr;
+ }
+ ++listPtr->num;
+
+ return elemPtr;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_AppendListElem()
+ *
+ * Creates a new list element containing the given value and returns
+ * a pointer to it. The element is inserted in the list just after
+ * the specified element.
+ * ------------------------------------------------------------------------
+ */
+Itcl_ListElem*
+Itcl_AppendListElem(pos,val)
+ Itcl_ListElem *pos; /* insert just after this element */
+ ClientData val; /* value associated with new element */
+{
+ Itcl_List *listPtr;
+ Itcl_ListElem *elemPtr;
+
+ listPtr = pos->owner;
+ assert(listPtr->validate == ITCL_VALID_LIST);
+ assert(pos != NULL);
+
+ elemPtr = Itcl_CreateListElem(listPtr);
+ elemPtr->value = val;
+
+ elemPtr->next = pos->next;
+ if (elemPtr->next) {
+ elemPtr->next->prev = elemPtr;
+ }
+ elemPtr->prev = pos;
+ pos->next = elemPtr;
+
+ if (listPtr->tail == pos) {
+ listPtr->tail = elemPtr;
+ }
+ if (listPtr->head == NULL) {
+ listPtr->head = elemPtr;
+ }
+ ++listPtr->num;
+
+ return elemPtr;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_SetListValue()
+ *
+ * Modifies the value associated with a list element.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_SetListValue(elemPtr,val)
+ Itcl_ListElem *elemPtr; /* list element being modified */
+ ClientData val; /* new value associated with element */
+{
+ Itcl_List *listPtr = elemPtr->owner;
+ assert(listPtr->validate == ITCL_VALID_LIST);
+ assert(elemPtr != NULL);
+
+ elemPtr->value = val;
+}
+
+
+/*
+ * ========================================================================
+ * REFERENCE-COUNTED DATA
+ *
+ * The following procedures manage generic reference-counted data.
+ * They are similar in spirit to the Tcl_Preserve/Tcl_Release
+ * procedures defined in the Tcl/Tk core. But these procedures use
+ * a hash table instead of a linked list to maintain the references,
+ * so they scale better. Also, the Tcl procedures have a bad behavior
+ * during the "exit" command. Their exit handler shuts them down
+ * when other data is still being reference-counted and cleaned up.
+ *
+ * ------------------------------------------------------------------------
+ * Itcl_EventuallyFree()
+ *
+ * Registers a piece of data so that it will be freed when no longer
+ * in use. The data is registered with an initial usage count of "0".
+ * Future calls to Itcl_PreserveData() increase this usage count, and
+ * calls to Itcl_ReleaseData() decrease the count until it reaches
+ * zero and the data is freed.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_EventuallyFree(cdata, fproc)
+ ClientData cdata; /* data to be freed when not in use */
+ Tcl_FreeProc *fproc; /* procedure called to free data */
+{
+ int newEntry;
+ Tcl_HashEntry *entry;
+ ItclPreservedData *chunk;
+
+ /*
+ * If the clientData value is NULL, do nothing.
+ */
+ if (cdata == NULL) {
+ return;
+ }
+
+ /*
+ * If a list has not yet been created to manage bits of
+ * preserved data, then create it.
+ */
+ if (!ItclPreservedList) {
+ ItclPreservedList = (Tcl_HashTable*)ckalloc(
+ (unsigned)sizeof(Tcl_HashTable)
+ );
+ Tcl_InitHashTable(ItclPreservedList, TCL_ONE_WORD_KEYS);
+ }
+
+ /*
+ * Find or create the data in the global list.
+ */
+ entry = Tcl_CreateHashEntry(ItclPreservedList,(char*)cdata, &newEntry);
+ if (newEntry) {
+ chunk = (ItclPreservedData*)ckalloc(
+ (unsigned)sizeof(ItclPreservedData)
+ );
+ chunk->data = cdata;
+ chunk->usage = 0;
+ chunk->fproc = fproc;
+ Tcl_SetHashValue(entry, (ClientData)chunk);
+ }
+ else {
+ chunk = (ItclPreservedData*)Tcl_GetHashValue(entry);
+ chunk->fproc = fproc;
+ }
+
+ /*
+ * If the usage count is zero, then delete the data now.
+ */
+ if (chunk->usage == 0) {
+ chunk->usage = -1; /* cannot preserve/release anymore */
+
+ (*chunk->fproc)((char*)chunk->data);
+ Tcl_DeleteHashEntry(entry);
+ ckfree((char*)chunk);
+ }
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_PreserveData()
+ *
+ * Increases the usage count for a piece of data that will be freed
+ * later when no longer needed. Each call to Itcl_PreserveData()
+ * puts one claim on a piece of data, and subsequent calls to
+ * Itcl_ReleaseData() remove those claims. When Itcl_EventuallyFree()
+ * is called, and when the usage count reaches zero, the data is
+ * freed.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_PreserveData(cdata)
+ ClientData cdata; /* data to be preserved */
+{
+ Tcl_HashEntry *entry;
+ ItclPreservedData *chunk;
+ int newEntry;
+
+ /*
+ * If the clientData value is NULL, do nothing.
+ */
+ if (cdata == NULL) {
+ return;
+ }
+
+ /*
+ * If a list has not yet been created to manage bits of
+ * preserved data, then create it.
+ */
+ if (!ItclPreservedList) {
+ ItclPreservedList = (Tcl_HashTable*)ckalloc(
+ (unsigned)sizeof(Tcl_HashTable)
+ );
+ Tcl_InitHashTable(ItclPreservedList,TCL_ONE_WORD_KEYS);
+ }
+
+ /*
+ * Find the data in the global list and bump its usage count.
+ */
+ entry = Tcl_CreateHashEntry(ItclPreservedList,(char*)cdata, &newEntry);
+ if (newEntry) {
+ chunk = (ItclPreservedData*)ckalloc(
+ (unsigned)sizeof(ItclPreservedData)
+ );
+ chunk->data = cdata;
+ chunk->usage = 0;
+ chunk->fproc = NULL;
+ Tcl_SetHashValue(entry, (ClientData)chunk);
+ }
+ else {
+ chunk = (ItclPreservedData*)Tcl_GetHashValue(entry);
+ }
+
+ /*
+ * Only increment the usage if it is non-negative.
+ * Negative numbers mean that the data is in the process
+ * of being destroyed by Itcl_ReleaseData(), and should
+ * not be further preserved.
+ */
+ if (chunk->usage >= 0) {
+ chunk->usage++;
+ }
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ReleaseData()
+ *
+ * Decreases the usage count for a piece of data that was registered
+ * previously via Itcl_PreserveData(). After Itcl_EventuallyFree()
+ * is called and the usage count reaches zero, the data is
+ * automatically freed.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_ReleaseData(cdata)
+ ClientData cdata; /* data to be released */
+{
+ Tcl_HashEntry *entry;
+ ItclPreservedData *chunk;
+
+ /*
+ * If the clientData value is NULL, do nothing.
+ */
+ if (cdata == NULL) {
+ return;
+ }
+
+ /*
+ * Otherwise, find the data in the global list and
+ * decrement its usage count.
+ */
+ entry = NULL;
+ if (ItclPreservedList) {
+ entry = Tcl_FindHashEntry(ItclPreservedList,(char*)cdata);
+ }
+ if (!entry) {
+ panic("Itcl_ReleaseData can't find reference for 0x%x", cdata);
+ }
+
+ /*
+ * Only decrement the usage if it is non-negative.
+ * When the usage reaches zero, set it to a negative number
+ * to indicate that data is being destroyed, and then
+ * invoke the client delete proc. When the data is deleted,
+ * remove the entry from the preservation list.
+ */
+ chunk = (ItclPreservedData*)Tcl_GetHashValue(entry);
+ if (chunk->usage > 0 && --chunk->usage == 0) {
+
+ if (chunk->fproc) {
+ chunk->usage = -1; /* cannot preserve/release anymore */
+ (*chunk->fproc)((char*)chunk->data);
+ }
+
+ Tcl_DeleteHashEntry(entry);
+ ckfree((char*)chunk);
+ }
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_SaveInterpState()
+ *
+ * Takes a snapshot of the current result state of the interpreter.
+ * The snapshot can be restored at any point by Itcl_RestoreInterpState.
+ * So if you are in the middle of building a return result, you can
+ * snapshot the interpreter, execute a command that might generate an
+ * error, restore the snapshot, and continue building the result string.
+ *
+ * Once a snapshot is saved, it must be restored by calling
+ * Itcl_RestoreInterpState, or discarded by calling
+ * Itcl_DiscardInterpState. Otherwise, memory will be leaked.
+ *
+ * Returns a token representing the state of the interpreter.
+ * ------------------------------------------------------------------------
+ */
+Itcl_InterpState
+Itcl_SaveInterpState(interp, status)
+ Tcl_Interp* interp; /* interpreter being modified */
+ int status; /* integer status code for current operation */
+{
+ Interp *iPtr = (Interp*)interp;
+
+ InterpState *info;
+ char *val;
+
+ info = (InterpState*)ckalloc(sizeof(InterpState));
+ info->validate = TCL_STATE_VALID;
+ info->status = status;
+ info->errorInfo = NULL;
+ info->errorCode = NULL;
+
+ /*
+ * Get the result object from the interpreter. This synchronizes
+ * the old-style result, so we don't have to worry about it.
+ * Keeping the object result is enough.
+ */
+ info->objResult = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(info->objResult);
+
+ /*
+ * If an error is in progress, preserve its state.
+ */
+ if ((iPtr->flags & ERR_IN_PROGRESS) != 0) {
+ val = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
+ if (val) {
+ info->errorInfo = ckalloc((unsigned)(strlen(val)+1));
+ strcpy(info->errorInfo, val);
+ }
+
+ val = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
+ if (val) {
+ info->errorCode = ckalloc((unsigned)(strlen(val)+1));
+ strcpy(info->errorCode, val);
+ }
+ }
+
+ /*
+ * Now, reset the interpreter to a clean state.
+ */
+ Tcl_ResetResult(interp);
+
+ return (Itcl_InterpState)info;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_RestoreInterpState()
+ *
+ * Restores the state of the interpreter to a snapshot taken by
+ * Itcl_SaveInterpState. This affects variables such as "errorInfo"
+ * and "errorCode". After this call, the token for the interpreter
+ * state is no longer valid.
+ *
+ * Returns the status code that was pending at the time the state was
+ * captured.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_RestoreInterpState(interp, state)
+ Tcl_Interp* interp; /* interpreter being modified */
+ Itcl_InterpState state; /* token representing interpreter state */
+{
+ Interp *iPtr = (Interp*)interp;
+ InterpState *info = (InterpState*)state;
+ int status;
+
+ if (info->validate != TCL_STATE_VALID) {
+ panic("bad token in Itcl_RestoreInterpState");
+ }
+ Tcl_ResetResult(interp);
+
+ /*
+ * If an error is in progress, restore its state.
+ * Set the error code the hard way--set the variable directly
+ * and fix the interpreter flags. Otherwise, if the error code
+ * string is really a list, it will get wrapped in extra {}'s.
+ */
+ if (info->errorInfo) {
+ Tcl_AddErrorInfo(interp, info->errorInfo);
+ ckfree(info->errorInfo);
+ }
+
+ if (info->errorCode) {
+ (void) Tcl_SetVar2(interp, "errorCode", (char*)NULL,
+ info->errorCode, TCL_GLOBAL_ONLY);
+ iPtr->flags |= ERROR_CODE_SET;
+
+ ckfree(info->errorCode);
+ }
+
+ /*
+ * Assign the object result back to the interpreter, then
+ * release our hold on it.
+ */
+ Tcl_SetObjResult(interp, info->objResult);
+ Tcl_DecrRefCount(info->objResult);
+
+ status = info->status;
+ info->validate = 0;
+ ckfree((char*)info);
+
+ return status;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_DiscardInterpState()
+ *
+ * Frees the memory associated with an interpreter snapshot taken by
+ * Itcl_SaveInterpState. If the snapshot is not restored, this
+ * procedure must be called to discard it, or the memory will be lost.
+ * After this call, the token for the interpreter state is no longer
+ * valid.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_DiscardInterpState(state)
+ Itcl_InterpState state; /* token representing interpreter state */
+{
+ InterpState *info = (InterpState*)state;
+
+ if (info->validate != TCL_STATE_VALID) {
+ panic("bad token in Itcl_DiscardInterpState");
+ }
+
+ if (info->errorInfo) {
+ ckfree(info->errorInfo);
+ }
+ if (info->errorCode) {
+ ckfree(info->errorCode);
+ }
+ Tcl_DecrRefCount(info->objResult);
+
+ info->validate = 0;
+ ckfree((char*)info);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_Protection()
+ *
+ * Used to query/set the protection level used when commands/variables
+ * are defined within a class. The default protection level (when
+ * no public/protected/private command is active) is ITCL_DEFAULT_PROTECT.
+ * In the default case, new commands are treated as public, while new
+ * variables are treated as protected.
+ *
+ * If the specified level is 0, then this procedure returns the
+ * current value without changing it. Otherwise, it sets the current
+ * value to the specified protection level, and returns the previous
+ * value.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_Protection(interp, newLevel)
+ Tcl_Interp *interp; /* interpreter being queried */
+ int newLevel; /* new protection level or 0 */
+{
+ int oldVal;
+ ItclObjectInfo *info;
+
+ /*
+ * If a new level was specified, then set the protection level.
+ * In any case, return the protection level as it stands right now.
+ */
+ info = (ItclObjectInfo*) Tcl_GetAssocData(interp, ITCL_INTERP_DATA,
+ (Tcl_InterpDeleteProc**)NULL);
+
+ assert(info != NULL);
+ oldVal = info->protection;
+
+ if (newLevel != 0) {
+ assert(newLevel == ITCL_PUBLIC ||
+ newLevel == ITCL_PROTECTED ||
+ newLevel == ITCL_PRIVATE ||
+ newLevel == ITCL_DEFAULT_PROTECT);
+ info->protection = newLevel;
+ }
+ return oldVal;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ProtectionStr()
+ *
+ * Converts an integer protection code (ITCL_PUBLIC, ITCL_PROTECTED,
+ * or ITCL_PRIVATE) into a human-readable character string. Returns
+ * a pointer to this string.
+ * ------------------------------------------------------------------------
+ */
+char*
+Itcl_ProtectionStr(pLevel)
+ int pLevel; /* protection level */
+{
+ switch (pLevel) {
+ case ITCL_PUBLIC:
+ return "public";
+ case ITCL_PROTECTED:
+ return "protected";
+ case ITCL_PRIVATE:
+ return "private";
+ }
+ return "<bad-protection-code>";
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_CanAccess()
+ *
+ * Checks to see if a class member can be accessed from a particular
+ * namespace context. Public things can always be accessed. Protected
+ * things can be accessed if the "from" namespace appears in the
+ * inheritance hierarchy of the class namespace. Private things
+ * can be accessed only if the "from" namespace is the same as the
+ * class that contains them.
+ *
+ * Returns 1/0 indicating true/false.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_CanAccess(memberPtr, fromNsPtr)
+ ItclMember* memberPtr; /* class member being tested */
+ Tcl_Namespace* fromNsPtr; /* namespace requesting access */
+{
+ ItclClass* fromCdPtr;
+ Tcl_HashEntry *entry;
+
+ /*
+ * If the protection level is "public" or "private", then the
+ * answer is known immediately.
+ */
+ if (memberPtr->protection == ITCL_PUBLIC) {
+ return 1;
+ }
+ else if (memberPtr->protection == ITCL_PRIVATE) {
+ return (memberPtr->classDefn->namesp == fromNsPtr);
+ }
+
+ /*
+ * If the protection level is "protected", then check the
+ * heritage of the namespace requesting access. If cdefnPtr
+ * is in the heritage, then access is allowed.
+ */
+ assert (memberPtr->protection == ITCL_PROTECTED);
+
+ if (Itcl_IsClassNamespace(fromNsPtr)) {
+ fromCdPtr = (ItclClass*)fromNsPtr->clientData;
+
+ entry = Tcl_FindHashEntry(&fromCdPtr->heritage,
+ (char*)memberPtr->classDefn);
+
+ if (entry) {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_CanAccessFunc()
+ *
+ * Checks to see if a member function with the specified protection
+ * level can be accessed from a particular namespace context. This
+ * follows the same rules enforced by Itcl_CanAccess, but adds one
+ * special case: If the function is a protected method, and if the
+ * current context is a base class that has the same method, then
+ * access is allowed.
+ *
+ * Returns 1/0 indicating true/false.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_CanAccessFunc(mfunc, fromNsPtr)
+ ItclMemberFunc* mfunc; /* member function being tested */
+ Tcl_Namespace* fromNsPtr; /* namespace requesting access */
+{
+ ItclClass *cdPtr, *fromCdPtr;
+ ItclMemberFunc *ovlfunc;
+ Tcl_HashEntry *entry;
+
+ /*
+ * Apply the usual rules first.
+ */
+ if (Itcl_CanAccess(mfunc->member, fromNsPtr)) {
+ return 1;
+ }
+
+ /*
+ * As a last resort, see if the namespace is really a base
+ * class of the class containing the method. Look for a
+ * method with the same name in the base class. If there
+ * is one, then this method overrides it, and the base class
+ * has access.
+ */
+ if ((mfunc->member->flags & ITCL_COMMON) == 0 &&
+ Itcl_IsClassNamespace(fromNsPtr)) {
+
+ cdPtr = mfunc->member->classDefn;
+ fromCdPtr = (ItclClass*)fromNsPtr->clientData;
+
+ if (Tcl_FindHashEntry(&cdPtr->heritage, (char*)fromCdPtr)) {
+ entry = Tcl_FindHashEntry(&fromCdPtr->resolveCmds,
+ mfunc->member->name);
+
+ if (entry) {
+ ovlfunc = (ItclMemberFunc*)Tcl_GetHashValue(entry);
+ if ((ovlfunc->member->flags & ITCL_COMMON) == 0 &&
+ ovlfunc->member->protection < ITCL_PRIVATE) {
+ return 1;
+ }
+ }
+ }
+ }
+ return 0;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_GetTrueNamespace()
+ *
+ * Returns the current namespace context. This procedure is similar
+ * to Tcl_GetCurrentNamespace, but it supports the notion of
+ * "transparent" call frames installed by Itcl_HandleInstance.
+ *
+ * Returns a pointer to the current namespace calling context.
+ * ------------------------------------------------------------------------
+ */
+Tcl_Namespace*
+Itcl_GetTrueNamespace(interp, info)
+ Tcl_Interp *interp; /* interpreter being queried */
+ ItclObjectInfo *info; /* object info associated with interp */
+{
+ int i, transparent;
+ Tcl_CallFrame *framePtr, *transFramePtr;
+ Tcl_Namespace *contextNs;
+
+ /*
+ * See if the current call frame is on the list of transparent
+ * call frames.
+ */
+ transparent = 0;
+
+ framePtr = _Tcl_GetCallFrame(interp, 0);
+ for (i = Itcl_GetStackSize(&info->transparentFrames)-1; i >= 0; i--) {
+ transFramePtr = (Tcl_CallFrame*)
+ Itcl_GetStackValue(&info->transparentFrames, i);
+
+ if (framePtr == transFramePtr) {
+ transparent = 1;
+ break;
+ }
+ }
+
+ /*
+ * If this is a transparent call frame, return the namespace
+ * context one level up.
+ */
+ if (transparent) {
+ framePtr = _Tcl_GetCallFrame(interp, 1);
+ if (framePtr) {
+ contextNs = framePtr->nsPtr;
+ } else {
+ contextNs = Tcl_GetGlobalNamespace(interp);
+ }
+ }
+ else {
+ contextNs = Tcl_GetCurrentNamespace(interp);
+ }
+ return contextNs;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_ParseNamespPath()
+ *
+ * Parses a reference to a namespace element of the form:
+ *
+ * namesp::namesp::namesp::element
+ *
+ * Returns pointers to the head part ("namesp::namesp::namesp")
+ * and the tail part ("element"). If the head part is missing,
+ * a NULL pointer is returned and the rest of the string is taken
+ * as the tail.
+ *
+ * Both head and tail point to locations within the given dynamic
+ * string buffer. This buffer must be uninitialized when passed
+ * into this procedure, and it must be freed later on, when the
+ * strings are no longer needed.
+ * ------------------------------------------------------------------------
+ */
+void
+Itcl_ParseNamespPath(name, buffer, head, tail)
+ char *name; /* path name to class member */
+ Tcl_DString *buffer; /* dynamic string buffer (uninitialized) */
+ char **head; /* returns "namesp::namesp::namesp" part */
+ char **tail; /* returns "element" part */
+{
+ register char *sep;
+
+ Tcl_DStringInit(buffer);
+
+ /*
+ * Copy the name into the buffer and parse it. Look
+ * backward from the end of the string to the first '::'
+ * scope qualifier.
+ */
+ Tcl_DStringAppend(buffer, name, -1);
+ name = Tcl_DStringValue(buffer);
+
+ for (sep=name; *sep != '\0'; sep++)
+ ;
+
+ while (--sep > name) {
+ if (*sep == ':' && *(sep-1) == ':') {
+ break;
+ }
+ }
+
+ /*
+ * Found head/tail parts. If there are extra :'s, keep backing
+ * up until the head is found. This supports the Tcl namespace
+ * behavior, which allows names like "foo:::bar".
+ */
+ if (sep > name) {
+ *tail = sep+1;
+ while (sep > name && *(sep-1) == ':') {
+ sep--;
+ }
+ *sep = '\0';
+ *head = name;
+ }
+
+ /*
+ * No :: separators--the whole name is treated as a tail.
+ */
+ else {
+ *tail = name;
+ *head = NULL;
+ }
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_DecodeScopedCommand()
+ *
+ * Decodes a scoped command of the form:
+ *
+ * namespace inscope <namesp> <command>
+ *
+ * If the given string is not a scoped value, this procedure does
+ * nothing and returns TCL_OK. If the string is a scoped value,
+ * then it is decoded, and the namespace, and the simple command
+ * string are returned as arguments; the simple command should
+ * be freed when no longer in use. If anything goes wrong, this
+ * procedure returns TCL_ERROR, along with an error message in
+ * the interpreter.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_DecodeScopedCommand(interp, name, rNsPtr, rCmdPtr)
+ Tcl_Interp *interp; /* current interpreter */
+ char *name; /* string to be decoded */
+ Tcl_Namespace **rNsPtr; /* returns: namespace for scoped value */
+ char **rCmdPtr; /* returns: simple command word */
+{
+ Tcl_Namespace *nsPtr = NULL;
+ char *cmdName = name;
+ int len = strlen(name);
+
+ char *pos;
+ int listc, result;
+ char **listv;
+
+ if ((*name == 'n') && (len > 17) && (strncmp(name, "namespace", 9) == 0)) {
+ for (pos = (name + 9); (*pos == ' '); pos++) {
+ /* empty body: skip over spaces */
+ }
+ if ((*pos == 'i') && ((pos + 7) <= (name + len))
+ && (strncmp(pos, "inscope", 7) == 0)) {
+
+ result = Tcl_SplitList(interp, name, &listc, &listv);
+ if (result == TCL_OK) {
+ if (listc != 4) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "malformed command \"", name, "\": should be \"",
+ "namespace inscope namesp command\"",
+ (char*)NULL);
+ result = TCL_ERROR;
+ }
+ else {
+ nsPtr = Tcl_FindNamespace(interp, listv[2],
+ (Tcl_Namespace*)NULL, TCL_LEAVE_ERR_MSG);
+
+ if (!nsPtr) {
+ result = TCL_ERROR;
+ }
+ else {
+ cmdName = ckalloc((unsigned)(strlen(listv[3])+1));
+ strcpy(cmdName, listv[3]);
+ }
+ }
+ }
+ ckfree((char*)listv);
+
+ if (result != TCL_OK) {
+ char msg[512];
+ sprintf(msg, "\n (while decoding scoped command \"%.400s\")", name);
+ Tcl_AddObjErrorInfo(interp, msg, -1);
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ *rNsPtr = nsPtr;
+ *rCmdPtr = cmdName;
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_EvalArgs()
+ *
+ * This procedure invokes a list of (objc,objv) arguments as a
+ * single command. It is similar to Tcl_EvalObj, but it doesn't
+ * do any parsing or compilation. It simply treats the first
+ * argument as a command and invokes that command in the current
+ * context.
+ *
+ * Returns TCL_OK if successful. Otherwise, this procedure returns
+ * TCL_ERROR along with an error message in the interpreter.
+ * ------------------------------------------------------------------------
+ */
+int
+Itcl_EvalArgs(interp, objc, objv)
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int result;
+ Tcl_Command cmd;
+ Command *cmdPtr;
+ int cmdlinec;
+ Tcl_Obj **cmdlinev;
+ Tcl_Obj *cmdlinePtr = NULL;
+
+ /*
+ * Resolve the command by converting it to a CmdName object.
+ * This caches a pointer to the Command structure for the
+ * command, so if we need it again, it's ready to use.
+ */
+ cmd = Tcl_GetCommandFromObj(interp, objv[0]);
+ cmdPtr = (Command*)cmd;
+
+ cmdlinec = objc;
+ cmdlinev = (Tcl_Obj**)objv;
+
+ /*
+ * If the command is still not found, handle it with the
+ * "unknown" proc.
+ */
+ if (cmdPtr == NULL) {
+ cmd = Tcl_FindCommand(interp, "unknown",
+ (Tcl_Namespace *) NULL, /*flags*/ TCL_GLOBAL_ONLY);
+
+ if (cmd == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "invalid command name \"",
+ Tcl_GetStringFromObj(objv[0], (int*)NULL), "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ cmdPtr = (Command*)cmd;
+
+ cmdlinePtr = Itcl_CreateArgs(interp, "unknown", objc, objv);
+
+ (void) Tcl_ListObjGetElements((Tcl_Interp*)NULL, cmdlinePtr,
+ &cmdlinec, &cmdlinev);
+ }
+
+ /*
+ * Finally, invoke the command's Tcl_ObjCmdProc. Be careful
+ * to pass in the proper client data.
+ */
+ Tcl_ResetResult(interp);
+ result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
+ cmdlinec, cmdlinev);
+
+ if (cmdlinePtr) {
+ Tcl_DecrRefCount(cmdlinePtr);
+ }
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itcl_CreateArgs()
+ *
+ * This procedure takes a string and a list of (objc,objv) arguments,
+ * and glues them together in a single list. This is useful when
+ * a command word needs to be prepended or substituted into a command
+ * line before it is executed. The arguments are returned in a single
+ * list object, and they can be retrieved by calling
+ * Tcl_ListObjGetElements. When the arguments are no longer needed,
+ * they should be discarded by decrementing the reference count for
+ * the list object.
+ *
+ * Returns a pointer to the list object containing the arguments.
+ * ------------------------------------------------------------------------
+ */
+Tcl_Obj*
+Itcl_CreateArgs(interp, string, objc, objv)
+ Tcl_Interp *interp; /* current interpreter */
+ char *string; /* first command word */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int i;
+ Tcl_Obj *listPtr;
+
+ listPtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr,
+ Tcl_NewStringObj(string, -1));
+
+ for (i=0; i < objc; i++) {
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, listPtr, objv[i]);
+ }
+
+ Tcl_IncrRefCount(listPtr);
+ return listPtr;
+}
diff --git a/itcl/itcl/itclConfig.sh.in b/itcl/itcl/itclConfig.sh.in
new file mode 100644
index 00000000000..82bebb1be31
--- /dev/null
+++ b/itcl/itcl/itclConfig.sh.in
@@ -0,0 +1,42 @@
+# itclConfig.sh --
+#
+# This shell script (for sh) is generated automatically by Itcl'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 Itcl 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.
+
+# Itcl's version number.
+ITCL_VERSION='@ITCL_VERSION@'
+ITCL_MAJOR_VERSION='@ITCL_MAJOR_VERSION@'
+ITCL_MINOR_VERSION='@ITCL_MINOR_VERSION@'
+ITCL_RELEASE_LEVEL='@ITCL_RELEASE_LEVEL@'
+
+# The name of the Itcl library (may be either a .a file or a shared library):
+ITCL_LIB_FILE=@ITCL_LIB_FILE@
+
+# String to pass to linker to pick up the Itcl library from its
+# build directory.
+ITCL_BUILD_LIB_SPEC='@ITCL_BUILD_LIB_SPEC@'
+
+# String to pass to linker to pick up the Itcl library from its
+# installed directory.
+ITCL_LIB_SPEC='@ITCL_LIB_SPEC@'
+
+# Location of the top-level source directories from which [incr Tcl]
+# was built. This is the directory that contains generic, unix, etc.
+# If [incr Tcl] was compiled in a different place than the directory
+# containing the source files, this points to the location of the sources,
+# not the location where [incr Tcl] was compiled.
+ITCL_SRC_DIR='@ITCL_SRC_DIR@'
+
+# Name and location of the incr tcl shell. Used during the build process.
+ITCL_SH='@ITCL_SH@'
+
+# Full path to itcl library for dependency checking.
+ITCL_LIB_FULL_PATH='@ITCL_LIB_FULL_PATH@' \ No newline at end of file
diff --git a/itcl/itcl/library/itcl.tcl b/itcl/itcl/library/itcl.tcl
new file mode 100644
index 00000000000..cb3ad949b2a
--- /dev/null
+++ b/itcl/itcl/library/itcl.tcl
@@ -0,0 +1,149 @@
+#
+# itcl.tcl
+# ----------------------------------------------------------------------
+# Invoked automatically upon startup to customize the interpreter
+# for [incr Tcl].
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# ----------------------------------------------------------------------
+# USAGE: local <className> <objName> ?<arg> <arg>...?
+#
+# Creates a new object called <objName> in class <className>, passing
+# the remaining <arg>'s to the constructor. Unlike the usual
+# [incr Tcl] objects, however, an object created by this procedure
+# will be automatically deleted when the local call frame is destroyed.
+# This command is useful for creating objects that should only remain
+# alive until a procedure exits.
+# ----------------------------------------------------------------------
+proc ::itcl::local {class name args} {
+ set ptr [uplevel eval [list $class $name] $args]
+ uplevel [list set itcl-local-$ptr $ptr]
+ set cmd [uplevel namespace which -command $ptr]
+ uplevel [list trace variable itcl-local-$ptr u \
+ "itcl::delete object $cmd; list"]
+ return $ptr
+}
+
+# ----------------------------------------------------------------------
+# auto_mkindex
+# ----------------------------------------------------------------------
+# Define Itcl commands that will be recognized by the auto_mkindex
+# parser in Tcl...
+#
+
+#
+# USAGE: itcl::class name body
+# Adds an entry for the given class declaration.
+#
+foreach cmd {itcl::class itcl_class} {
+ auto_mkindex_parser::command $cmd {name body} {
+ variable index
+ variable scriptFile
+ append index "set [list auto_index([fullname $name])]"
+ append index " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
+
+ variable parser
+ variable contextStack
+ set contextStack [linsert $contextStack 0 $name]
+ $parser eval $body
+ set contextStack [lrange $contextStack 1 end]
+ }
+}
+
+#
+# USAGE: itcl::body name arglist body
+# Adds an entry for the given method/proc body.
+#
+auto_mkindex_parser::command itcl::body {name arglist body} {
+ variable index
+ variable scriptFile
+ append index "set [list auto_index([fullname $name])]"
+ append index " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
+}
+
+#
+# USAGE: itcl::configbody name arglist body
+# Adds an entry for the given method/proc body.
+#
+auto_mkindex_parser::command itcl::configbody {name body} {
+ variable index
+ variable scriptFile
+ append index "set [list auto_index([fullname $name])]"
+ append index " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
+}
+
+#
+# USAGE: ensemble name ?body?
+# Adds an entry to the auto index list for the given ensemble name.
+#
+auto_mkindex_parser::command itcl::ensemble {name {body ""}} {
+ variable index
+ variable scriptFile
+ append index "set [list auto_index([fullname $name])]"
+ append index " \[list source \[file join \$dir [list $scriptFile]\]\]\n"
+}
+
+#
+# USAGE: public arg ?arg arg...?
+# protected arg ?arg arg...?
+# private arg ?arg arg...?
+#
+# Evaluates the arguments as commands, so we can recognize proc
+# declarations within classes.
+#
+foreach cmd {public protected private} {
+ auto_mkindex_parser::command $cmd {args} {
+ variable parser
+ $parser eval $args
+ }
+}
+
+# CYGNUS LOCAL
+# This version of auto_import does not work, because it relies
+# WHOLLY on the tclIndex files, but the tclIndex files have no
+# notion of what the export list for a namespace is. So at the
+# time you do "namespace import" the export list is empty, and
+# so nothing is imported.
+# Until that is fixed, it is best just to go back to the original
+# Tcl version of auto_import...
+
+# ----------------------------------------------------------------------
+# auto_import
+# ----------------------------------------------------------------------
+# This procedure overrides the usual "auto_import" function in the
+# Tcl library. It is invoked during "namespace import" to make see
+# if the imported commands reside in an autoloaded library. If so,
+# stubs are created to represent the commands. Executing a stub
+# later on causes the real implementation to be autoloaded.
+#
+# Arguments -
+# pattern The pattern of commands being imported (like "foo::*")
+# a canonical namespace as returned by [namespace current]
+
+#proc auto_import {pattern} {
+# global auto_index
+
+# set ns [uplevel namespace current]
+# set patternList [auto_qualify $pattern $ns]
+
+# auto_load_index
+
+# foreach pattern $patternList {
+# foreach name [array names auto_index $pattern] {
+# if {"" == [info commands $name]} {
+# ::itcl::import::stub create $name
+# }
+# }
+# }
+# }
diff --git a/itcl/itcl/license.terms b/itcl/itcl/license.terms
new file mode 100644
index 00000000000..b76171b0a91
--- /dev/null
+++ b/itcl/itcl/license.terms
@@ -0,0 +1,38 @@
+This software is copyrighted by Lucent Technologies, Inc., and other
+parties. The following terms apply to all files associated with the
+software unless explicitly disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
diff --git a/itcl/itcl/mac/itclMacApplication.r b/itcl/itcl/mac/itclMacApplication.r
new file mode 100644
index 00000000000..dedc8741477
--- /dev/null
+++ b/itcl/itcl/mac/itclMacApplication.r
@@ -0,0 +1,99 @@
+/*
+ * tclMacApplication.r --
+ *
+ * This file creates resources for use Tcl Shell application.
+ * It should be viewed as an example of how to create a new
+ * Tcl application using the shared Tcl libraries.
+ *
+ * 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: @(#) tclMacApplication.r 1.1 96/09/11 21:12:54
+ */
+
+#include <Types.r>
+#include <SysTypes.r>
+
+/*
+ * The folowing include and defines help construct
+ * the version string for Tcl.
+ */
+
+#define RESOURCE_INCLUDED
+#include "tcl.h"
+#include "itcl.h"
+#include "itclPatch.h"
+
+/* Should really have one of these in itcl too, but for now... */
+
+#if (TCL_RELEASE_LEVEL == 0)
+# define RELEASE_LEVEL alpha
+#elif (TCL_RELEASE_LEVEL == 1)
+# define RELEASE_LEVEL beta
+#elif (TCL_RELEASE_LEVEL == 2)
+# define RELEASE_LEVEL final
+#endif
+
+#if (TCL_RELEASE_LEVEL == 2)
+# define MINOR_VERSION (ITCL_MINOR_VERSION * 16) + TCL_RELEASE_SERIAL
+#else
+# define MINOR_VERSION ITCL_MINOR_VERSION * 16
+#endif
+
+resource 'vers' (1) {
+ ITCL_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ ITCL_PATCH_LEVEL,
+ ITCL_PATCH_LEVEL ", by Michael McLennan © Lucent Technologies, Inc."
+};
+
+resource 'vers' (2) {
+ ITCL_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ ITCL_PATCH_LEVEL,
+ "Itcl Shell " ITCL_PATCH_LEVEL " © 1993-1998"
+};
+
+#define ITCL_APP_CREATOR 'ITcL'
+
+type ITCL_APP_CREATOR as 'STR ';
+resource ITCL_APP_CREATOR (0, purgeable) {
+ "Itcl Shell " ITCL_PATCH_LEVEL " © 1993-1998"
+};
+
+/*
+ * The 'kind' resource works with a 'BNDL' in Macintosh Easy Open
+ * to affect the text the Finder displays in the "kind" column and
+ * file info dialog. This information will be applied to all files
+ * with the listed creator and type.
+ */
+
+resource 'kind' (128, "Itcl kind", purgeable) {
+ ITCL_APP_CREATOR,
+ 0, /* region = USA */
+ {
+ 'APPL', "Itcl Shell",
+ }
+};
+
+/*
+ * 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
+ * the resource must be of the form "KEYWORD=SOME STRING". See Tcl
+ * documentation for futher information about the env variable.
+ *
+ * A good example of something you may want to set is: "TCL_LIBRARY=My
+ * disk:etc."
+ */
+
+resource 'STR#' (128, "Tcl Environment Variables") {
+ { "SCHEDULE_NAME=Agent Controller Schedule",
+ "SCHEDULE_PATH=Lozoya:System Folder:Tcl Lib:Tcl-Scheduler"
+ };
+};
+
diff --git a/itcl/itcl/mac/itclMacLibrary.r b/itcl/itcl/mac/itclMacLibrary.r
new file mode 100644
index 00000000000..44b38d2cb54
--- /dev/null
+++ b/itcl/itcl/mac/itclMacLibrary.r
@@ -0,0 +1,154 @@
+/*
+ * tclMacLibrary.r --
+ *
+ * This file creates resources used by the Tcl shared library.
+ * Many thanks go to "Jay Lieske, Jr." <lieske@princeton.edu> who
+ * wrote the initial version of this file.
+ *
+ * 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: @(#) tclMacLibrary.r 1.3 96/09/12 17:40:07
+ */
+
+#include <Types.r>
+#include <SysTypes.r>
+
+/*
+ * The folowing include and defines help construct
+ * the version string for Tcl.
+ */
+
+#define RESOURCE_INCLUDED
+#include "tcl.h"
+#include "itcl.h"
+
+#if (TCL_RELEASE_LEVEL == 0)
+# define RELEASE_LEVEL alpha
+#elif (TCL_RELEASE_LEVEL == 1)
+# define RELEASE_LEVEL beta
+#elif (TCL_RELEASE_LEVEL == 2)
+# define RELEASE_LEVEL final
+#endif
+
+#if (TCL_RELEASE_LEVEL == 2)
+# define MINOR_VERSION (ITCL_MINOR_VERSION * 16) + TCL_RELEASE_SERIAL
+#else
+# define MINOR_VERSION ITCL_MINOR_VERSION * 16
+#endif
+
+resource 'vers' (1) {
+ ITCL_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ ITCL_PATCH_LEVEL,
+ ITCL_PATCH_LEVEL ", by Michael McLennan © Lucent Technologies, Inc."
+};
+
+resource 'vers' (2) {
+ ITCL_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ ITCL_PATCH_LEVEL,
+ "Itcl Shell " ITCL_PATCH_LEVEL " © 1993-1998"
+};
+
+
+/*
+ * Currently the creator for all Tcl/Tk libraries and extensions
+ * should be 'TclL'. This will allow those extension and libraries
+ * to use the common icon for Tcl extensions. However, this signature
+ * still needs to be approved by the signature police at Apple and may
+ * change.
+ */
+#define ITCL_CREATOR 'ITcL'
+#define TCL_LIBRARY_RESOURCES 2000
+#define ITCL_LIBRARY_RESOURCES 2000
+
+/*
+ * The 'BNDL' resource is the primary link between a file's
+ * creator/type and its icon. This resource acts for all Tcl shared
+ * libraries; other libraries will not need one and ought to use
+ * custom icons rather than new file types for a different appearance.
+ */
+
+resource 'BNDL' (TCL_LIBRARY_RESOURCES, "Tcl bundle", purgeable)
+{
+ ITCL_CREATOR,
+ 0,
+ { /* array TypeArray: 2 elements */
+ /* [1] */
+ 'FREF',
+ { /* array IDArray: 1 elements */
+ /* [1] */
+ 0, TCL_LIBRARY_RESOURCES
+ },
+ /* [2] */
+ 'ICN#',
+ { /* array IDArray: 1 elements */
+ /* [1] */
+ 0, TCL_LIBRARY_RESOURCES
+ }
+ }
+};
+
+resource 'FREF' (TCL_LIBRARY_RESOURCES, purgeable)
+{
+ 'shlb', 0, ""
+};
+
+type ITCL_CREATOR as 'STR ';
+resource ITCL_CREATOR (0, purgeable) {
+ "Itcl Library " ITCL_PATCH_LEVEL " © 1993-1998"
+};
+
+/*
+ * The 'kind' resource works with a 'BNDL' in Macintosh Easy Open
+ * to affect the text the Finder displays in the "kind" column and
+ * file info dialog. This information will be applied to all files
+ * with the listed creator and type.
+ */
+
+resource 'kind' (TCL_LIBRARY_RESOURCES, "Itcl kind", purgeable) {
+ ITCL_CREATOR,
+ 0, /* region = USA */
+ {
+ 'shlb', "Itcl Library"
+ }
+};
+
+
+/*
+ * The -16397 string will be displayed by Finder when a user
+ * tries to open the shared library. The string should
+ * give the user a little detail about the library's capabilities
+ * and enough information to install the library in the correct location.
+ * A similar string should be placed in all shared libraries.
+ */
+resource 'STR ' (-16397, purgeable) {
+ "Itcl Library\n\n"
+ "This is one of the libraries needed to run the Itcl flavor of the Tool Command Language programs. "
+ "To work properly, it should be placed in the ŒTool Command Language¹ folder "
+ "within the Extensions folder."
+};
+
+/*
+ * The mechanisim below loads Tcl source into the resource fork of the
+ * application. The example below creates a TEXT resource named
+ * "Init" from the file "init.tcl". This allows applications to use
+ * Tcl to define the behavior of the application without having to
+ * 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 "itclMacTclCode.r"
+
+data 'TEXT' (ITCL_LIBRARY_RESOURCES+1,"pkgIndex",purgeable, preload) {
+ "# Tcl package index file, version 1.0\n"
+ "package ifneeded Itcl 3.0 [list load [file join $dir itcl30[info sharedlibextension]] Itcl]\n"
+};
+
+
diff --git a/itcl/itcl/mac/itclMacResource.r b/itcl/itcl/mac/itclMacResource.r
new file mode 100644
index 00000000000..6cc333f5c36
--- /dev/null
+++ b/itcl/itcl/mac/itclMacResource.r
@@ -0,0 +1,94 @@
+/*
+ * tclMacResource.r --
+ *
+ * This file creates resources for use in a simple shell.
+ * This is designed to be an example of using the Tcl libraries
+ * statically in a Macintosh Application. For an example of
+ * of using the dynamic libraries look at tclMacApplication.r.
+ *
+ * Copyright (c) 1993-94 Lockheed Missle & Space Company
+ * Copyright (c) 1994-96 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) tclMacResource.r 1.14 96/09/11 21:14:36
+ */
+
+#include <Types.r>
+#include <SysTypes.r>
+
+/*
+ * The folowing include and defines help construct
+ * the version string for Tcl.
+ */
+
+#define RESOURCE_INCLUDED
+#include "tcl.h"
+#include "itcl.h"
+#include "itclPatch.h"
+
+#if (TCL_RELEASE_LEVEL == 0)
+# define RELEASE_LEVEL alpha
+#elif (TCL_RELEASE_LEVEL == 1)
+# define RELEASE_LEVEL beta
+#elif (TCL_RELEASE_LEVEL == 2)
+# define RELEASE_LEVEL final
+#endif
+
+#if (TCL_RELEASE_LEVEL == 2)
+# define MINOR_VERSION (ITCL_MINOR_VERSION * 16) + TCL_RELEASE_SERIAL
+#else
+# define MINOR_VERSION ITCL_MINOR_VERSION * 16
+#endif
+
+resource 'vers' (1) {
+ ITCL_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ ITCL_PATCH_LEVEL,
+ ITCL_PATCH_LEVEL ", by Michael McLennan © Lucent Technologies, Inc."
+};
+
+resource 'vers' (2) {
+ ITCL_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ ITCL_PATCH_LEVEL,
+ "Simple Itcl Shell " ITCL_PATCH_LEVEL " © 1993-1998"
+};
+
+#define TCL_LIBRARY_RESOURCES 1000
+#define ITCL_LIBRARY_RESOURCES 2000
+
+/*
+ * The mechanisim below loads Tcl source into the resource fork of the
+ * application. The example below creates a TEXT resource named
+ * "Init" from the file "init.tcl". This allows applications to use
+ * Tcl to define the behavior of the application without having to
+ * 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' (TCL_LIBRARY_RESOURCES, "Init", purgeable, preload) ":::tcl" TCL_VERSION ":library:init.tcl";
+read 'TEXT' (ITCL_LIBRARY_RESOURCES, "itcl", purgeable,preload) "::library:itcl.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
+ * the resource must be of the form "KEYWORD=SOME STRING". See Tcl
+ * documentation for futher information about the env variable.
+ *
+ * A good example of something you may want to set is: "TCL_LIBRARY=My
+ * disk:etc."
+ */
+
+resource 'STR#' (128, "Tcl Environment Variables") {
+ { "SCHEDULE_NAME=Agent Controller Schedule",
+ "SCHEDULE_PATH=Lozoya:System Folder:Tcl Lib:Tcl-Scheduler"
+ };
+};
+
diff --git a/itcl/itcl/mac/itclMacTclCode.r b/itcl/itcl/mac/itclMacTclCode.r
new file mode 100644
index 00000000000..18411a7c8e3
--- /dev/null
+++ b/itcl/itcl/mac/itclMacTclCode.r
@@ -0,0 +1,32 @@
+/*
+ * itclMacTclCode.r
+ *
+ * This file includes the Itcl code that is needed to startup Tcl.
+ * It is to be included either in the resource fork of the shared library, or in the
+ * resource fork of the application for a statically bound application.
+ *
+ * Jim Ingham
+ * Lucent Technologies 1996
+ *
+ */
+
+#include <Types.r>
+#include <SysTypes.r>
+
+
+
+#define ITCL_LIBRARY_RESOURCES 2500
+
+/*
+ * The mechanisim below loads Tcl source into the resource fork of the
+ * application. The example below creates a TEXT resource named
+ * "Init" from the file "init.tcl". This allows applications to use
+ * Tcl to define the behavior of the application without having to
+ * 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' (ITCL_LIBRARY_RESOURCES, "itcl", purgeable,preload) "::library:itcl.tcl";
diff --git a/itcl/itcl/mac/itclStaticApplication.r b/itcl/itcl/mac/itclStaticApplication.r
new file mode 100644
index 00000000000..8fc2b09556a
--- /dev/null
+++ b/itcl/itcl/mac/itclStaticApplication.r
@@ -0,0 +1,26 @@
+/*
+ * itkStaticPkgIndex.r --
+ *
+ * This file creates resources which bind in the static version of the
+ * pkgIndex files.
+ *
+ * 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.5 96/10/03 17:54:21
+ */
+
+#include <Types.r>
+#include <SysTypes.r>
+#include <AEUserTermTypes.r>
+
+#define ITCL_LIBRARY_RESOURCES 2500
+
+#include "itclMacTclCode.r"
+
+data 'TEXT' (ITCL_LIBRARY_RESOURCES+20,"itcl:pkgIndex",purgeable, preload) {
+ "# Tcl package index file, version 1.0\n"
+ "package ifneeded Itcl 2.2 {load {} Itcl}\n"
+};
diff --git a/itcl/itcl/mac/pkgIndex.tcl b/itcl/itcl/mac/pkgIndex.tcl
new file mode 100644
index 00000000000..921b9b4f8fb
--- /dev/null
+++ b/itcl/itcl/mac/pkgIndex.tcl
@@ -0,0 +1,3 @@
+# Tcl package index file, version 1.0
+
+package ifneeded Itcl 3.0 [list load [file join $dir itcl30[info sharedlibextension]] Itcl]
diff --git a/itcl/itcl/mac/tclMacAppInit.c b/itcl/itcl/mac/tclMacAppInit.c
new file mode 100644
index 00000000000..4ef59bd5404
--- /dev/null
+++ b/itcl/itcl/mac/tclMacAppInit.c
@@ -0,0 +1,227 @@
+/*
+ * tclMacAppInit.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: @(#) tclMacAppInit.c 1.20 97/07/28 11:03:58
+ */
+
+/* include tclInt.h for access to namespace API */
+#include "tclInt.h"
+
+#include "tclInt.h"
+#include "tclPort.h"
+#include "tclMac.h"
+#include "tclMacInt.h"
+
+#include "itcl.h"
+
+#if defined(THINK_C)
+# include <console.h>
+#elif defined(__MWERKS__)
+# include <SIOUX.h>
+short InstallConsole _ANSI_ARGS_((short fd));
+#endif
+
+#ifdef TCL_TEST
+EXTERN int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#endif /* TCL_TEST */
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int MacintoshInit _ANSI_ARGS_((void));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ * Main program for tclsh. This file can be used as a prototype
+ * for other applications using the Tcl library.
+ *
+ * Results:
+ * None. This procedure never returns (it exits the process when
+ * it's done.
+ *
+ * Side effects:
+ * This procedure initializes the Macintosh world and then
+ * calls Tcl_Main. Tcl_Main will never return except to exit.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+main(
+ int argc, /* Number of arguments. */
+ char **argv) /* Array of argument strings. */
+{
+ char *newArgv[2];
+
+ if (MacintoshInit() != TCL_OK) {
+ Tcl_Exit(1);
+ }
+
+ argc = 1;
+ newArgv[0] = "itclsh";
+ newArgv[1] = NULL;
+ Tcl_Main(argc, newArgv, Tcl_AppInit);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppInit(
+ Tcl_Interp *interp) /* Interpreter for application. */
+{
+ if (Tcl_Init(interp) == TCL_ERROR) {
+ return TCL_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 */
+
+ /*
+ * Call the init procedures for included packages. Each call should
+ * look like this:
+ *
+ * if (Mod_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * where "Mod" is the name of the module.
+ */
+ if (Itcl_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Itcl", Itcl_Init, Itcl_SafeInit);
+
+ /*
+ * This is itclsh, so import all [incr Tcl] commands by
+ * default into the global namespace. Fix up the autoloader
+ * to do the same.
+ */
+ if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
+ "::itcl::*", /* allowOverwrite */ 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_Eval(interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* }") != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Call Tcl_CreateCommand for application-specific commands, if
+ * they weren't already created by the init procedures called above.
+ * Each call would loo like this:
+ *
+ * Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
+ */
+
+ /*
+ * Specify a user-specific startup script to invoke if the application
+ * is run interactively. On the Mac we can specifiy either a TEXT resource
+ * which contains the script or the more UNIX like file location
+ * may also used. (I highly recommend using the resource method.)
+ */
+
+ Tcl_SetVar(interp, "tcl_rcRsrcName", "itclshrc", TCL_GLOBAL_ONLY);
+ /* Tcl_SetVar(interp, "tcl_rcFileName", "~/.itclshrc", TCL_GLOBAL_ONLY); */
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MacintoshInit --
+ *
+ * This procedure calls initalization routines to set up a simple
+ * console on a Macintosh. This is necessary as the Mac doesn't
+ * have a stdout & stderr by default.
+ *
+ * Results:
+ * Returns TCL_OK if everything went fine. If it didn't the
+ * application should probably fail.
+ *
+ * Side effects:
+ * Inits the appropiate console package.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MacintoshInit()
+{
+#if GENERATING68K && !GENERATINGCFM
+ SetApplLimit(GetApplLimit() - (TCL_MAC_68K_STACK_GROWTH));
+#endif
+ MaxApplZone();
+
+#if defined(THINK_C)
+
+ /* Set options for Think C console package */
+ /* The console package calls the Mac init calls */
+ console_options.pause_atexit = 0;
+ console_options.title = "\pTcl Interpreter";
+
+#elif defined(__MWERKS__)
+
+ /* Set options for CodeWarrior SIOUX package */
+ SIOUXSettings.autocloseonquit = true;
+ SIOUXSettings.showstatusline = true;
+ SIOUXSettings.asktosaveonclose = false;
+ InstallConsole(0);
+ SIOUXSetTitle("\pTcl Interpreter");
+
+#elif defined(applec)
+
+ /* Init packages used by MPW SIOW package */
+ InitGraf((Ptr)&qd.thePort);
+ InitFonts();
+ InitWindows();
+ InitMenus();
+ TEInit();
+ InitDialogs(nil);
+ InitCursor();
+
+#endif
+
+ Tcl_MacSetEventProc((Tcl_MacConvertEventPtr) SIOUXHandleOneEvent);
+
+ /* No problems with initialization */
+ return TCL_OK;
+}
diff --git a/itcl/itcl/tests/all b/itcl/itcl/tests/all
new file mode 100644
index 00000000000..b50794c1448
--- /dev/null
+++ b/itcl/itcl/tests/all
@@ -0,0 +1,16 @@
+# 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.7 96/02/16 08:55:38
+
+foreach i [lsort [glob *.test]] {
+ if [string match l.*.test $i] {
+ # This is an SCCS lock file; ignore it.
+ continue
+ }
+ puts stdout $i
+ if [catch {source $i} msg] {
+ puts $msg
+ }
+}
diff --git a/itcl/itcl/tests/basic.test b/itcl/itcl/tests/basic.test
new file mode 100644
index 00000000000..5aba6bb2560
--- /dev/null
+++ b/itcl/itcl/tests/basic.test
@@ -0,0 +1,319 @@
+#
+# Basic tests for class definition and method/proc access
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Simple class definition
+# ----------------------------------------------------------------------
+test basic-1.1 {define a simple class} {
+ itcl::class Counter {
+ constructor {args} {
+ incr num
+ eval configure $args
+ }
+ destructor {
+ incr num -1
+ }
+
+ method ++ {} {
+ return [incr val $by]
+ }
+ proc num {} {
+ return $num
+ }
+ public variable by 1
+ protected variable val 0
+ private common num 0
+ }
+} ""
+
+test basic-1.2 {class is now defined} {
+ find classes Counter
+} {Counter}
+
+test basic-1.3 {access command exists with class name} {
+ namespace which -command Counter
+} {::Counter}
+
+test basic-1.4 {create a simple object} {
+ Counter x
+} {x}
+
+test basic-1.5a {object names cannot be duplicated} {
+ list [catch "Counter x" msg] $msg
+} {1 {command "x" already exists in namespace "::"}}
+
+test basic-1.5b {built-in commands cannot be clobbered} {
+ list [catch "Counter info" msg] $msg
+} {1 {command "info" already exists in namespace "::"}}
+
+test basic-1.6 {objects have an access command} {
+ namespace which -command x
+} {::x}
+
+test basic-1.7a {objects are added to the master list} {
+ find objects x
+} {x}
+
+test basic-1.7b {objects are added to the master list} {
+ find objects -class Counter x
+} {x}
+
+test basic-1.8 {objects can be deleted} {
+ list [delete object x] [namespace which -command x]
+} {{} {}}
+
+test basic-1.9 {objects can be recreated with the same name} {
+ Counter x
+} {x}
+
+test basic-1.10 {objects can be destroyed by deleting their access command} {
+ rename ::x ""
+ find objects x
+} {}
+
+# ----------------------------------------------------------------------
+# #auto names
+# ----------------------------------------------------------------------
+test basic-2.1 {create an object with an automatic name} {
+ Counter #auto
+} {counter0}
+
+test basic-2.2 {bury "#auto" within object name} {
+ Counter x#autoy
+} {xcounter1y}
+
+test basic-2.3 {bury "#auto" within object name} {
+ Counter a#aut#autob
+} {a#autcounter2b}
+
+test basic-2.4 {"#auto" is smart enough to skip names that are taken} {
+ Counter counter3
+ Counter #auto
+} {counter4}
+
+# ----------------------------------------------------------------------
+# Simple object use
+# ----------------------------------------------------------------------
+test basic-3.1 {object access command works} {
+ Counter c
+ list [c ++] [c ++] [c ++]
+} {1 2 3}
+
+test basic-3.2 {errors produce usage info} {
+ list [catch "c xyzzy" msg] $msg
+} {1 {bad option "xyzzy": should be one of...
+ c ++
+ c cget -option
+ c configure ?-option? ?value -option value...?
+ c isa className}}
+
+test basic-3.3 {built-in configure can query public variables} {
+ c configure
+} {{-by 1 1}}
+
+test basic-3.4 {built-in configure can query one public variable} {
+ c configure -by
+} {-by 1 1}
+
+test basic-3.5 {built-in configure can set public variable} {
+ list [c configure -by 2] [c cget -by]
+} {{} 2}
+
+test basic-3.6 {configure actually changes public variable} {
+ list [c ++] [c ++]
+} {5 7}
+
+test basic-3.7 {class procs can be accessed} {
+ Counter::num
+} {6}
+
+test basic-3.8 {obsolete syntax is no longer allowed} {
+ list [catch "Counter :: num" msg] $msg
+} {1 {syntax "class :: proc" is an anachronism
+[incr Tcl] no longer supports this syntax.
+Instead, remove the spaces from your procedure invocations:
+ Counter::num ?args?}}
+
+# ----------------------------------------------------------------------
+# Classes can be destroyed and redefined
+# ----------------------------------------------------------------------
+test basic-4.1 {classes can be destroyed} {
+ list [delete class Counter] \
+ [find classes Counter] \
+ [namespace children :: Counter] \
+ [namespace which -command Counter]
+} {{} {} {} {}}
+
+test basic-4.2 {classes can be redefined} {
+ itcl::class Counter {
+ method ++ {} {
+ return [incr val $by]
+ }
+ public variable by 1
+ protected variable val 0
+ }
+} {}
+
+test basic-4.3 {the redefined class is actually different} {
+ list [catch "Counter::num" msg] $msg
+} {1 {invalid command name "Counter::num"}}
+
+test basic-4.4 {objects can be created from the new class} {
+ list [Counter #auto] [Counter #auto]
+} {counter0 counter1}
+
+test basic-4.5 {when a class is destroyed, its objects are deleted} {
+ list [lsort [find objects counter*]] \
+ [delete class Counter] \
+ [lsort [find objects counter*]]
+} {{counter0 counter1} {} {}}
+
+# ----------------------------------------------------------------------
+# Namespace variables
+# ----------------------------------------------------------------------
+test basic-5.1 {define a simple class with variables in the namespace} {
+ itcl::class test_globals {
+ common g1 "global1"
+ proc getval {name} {
+ variable $name
+ return [set [namespace tail $name]]
+ }
+ proc setval {name val} {
+ variable $name
+ return [set [namespace tail $name] $val]
+ }
+ method do {args} {
+ return [eval $args]
+ }
+ }
+ namespace eval test_globals {
+ variable g2 "global2"
+ }
+} ""
+
+test basic-5.2 {create an object for the tests} {
+ test_globals #auto
+} {test_globals0}
+
+test basic-5.3 {common variables live in the namespace} {
+ lsort [info vars ::test_globals::*]
+} {::test_globals::g1 ::test_globals::g2}
+
+test basic-5.4 {common variables can be referenced transparently} {
+ list [catch {test_globals0 do set g1} msg] $msg
+} {0 global1}
+
+test basic-5.5 {namespace variables require a declaration} {
+ list [catch {test_globals0 do set g2} msg] $msg
+} {1 {can't read "g2": no such variable}}
+
+test basic-5.6a {variable accesses variables within namespace} {
+ list [catch {test_globals::getval g1} msg] $msg
+} {0 global1}
+
+test basic-5.6a {variable accesses variables within namespace} {
+ list [catch {test_globals::getval g2} msg] $msg
+} {0 global2}
+
+test basic-5.7 {variable command will not find vars in other namespaces} {
+ set ::test_global_0 "g0"
+ list [catch {test_globals::getval test_global_0} msg] $msg \
+ [catch {test_globals::getval ::test_global_0} msg] $msg \
+} {1 {can't read "test_global_0": no such variable} 0 g0}
+
+test basic-5.8 {to create globals in a namespace, use the full path} {
+ test_globals::setval ::test_global_1 g1
+ namespace eval :: {lsort [info globals test_global_*]}
+} {test_global_0 test_global_1}
+
+test basic-5.9 {variable names can have ":" in them} {
+ test_globals::setval ::test:global:2 g2
+ namespace eval :: {info globals test:global:2}
+} {test:global:2}
+
+# ----------------------------------------------------------------------
+# Array variables
+# ----------------------------------------------------------------------
+test basic-6.1 {set up a class definition with array variables} {
+ proc test_arrays_get {name} {
+ upvar $name x
+ set rlist {}
+ foreach index [lsort [array names x]] {
+ lappend rlist [list $index $x($index)]
+ }
+ return $rlist
+ }
+ itcl::class test_arrays {
+ variable nums
+ common undefined
+
+ common colors
+ set colors(red) #ff0000
+ set colors(green) #00ff00
+ set colors(blue) #0000ff
+
+ constructor {} {
+ set nums(one) 1
+ set nums(two) 2
+ set nums(three) 3
+
+ set undefined(a) A
+ set undefined(b) B
+ }
+ method do {args} {
+ return [eval $args]
+ }
+ }
+ test_arrays #auto
+} {test_arrays0}
+
+test basic-6.2 {test array access for instance variables} {
+ lsort [test_arrays0 do array get nums]
+} {1 2 3 one three two}
+
+test basic-6.3 {test array access for commons} {
+ lsort [test_arrays0 do array get colors]
+} {#0000ff #00ff00 #ff0000 blue green red}
+
+test basic-6.4 {test array access for instance variables via "upvar"} {
+ test_arrays0 do test_arrays_get nums
+} {{one 1} {three 3} {two 2}}
+
+test basic-6.5 {test array access for commons via "upvar"} {
+ test_arrays0 do test_arrays_get colors
+} {{blue #0000ff} {green #00ff00} {red #ff0000}}
+
+test basic-6.6a {test array access for commons defined in constructor} {
+ lsort [test_arrays0 do array get undefined]
+} {A B a b}
+
+test basic-6.6b {test array access for commons defined in constructor} {
+ test_arrays0 do test_arrays_get undefined
+} {{a A} {b B}}
+
+test basic-6.6c {test array access for commons defined in constructor} {
+ list [test_arrays0 do set undefined(a)] [test_arrays0 do set undefined(b)]
+} {A B}
+
+test basic-6.7 {common variables can be unset} {
+ test_arrays0 do unset undefined
+ test_arrays0 do array names undefined
+} {}
+
+test basic-6.8 {common variables can be redefined} {
+ test_arrays0 do set undefined "scalar"
+} {scalar}
diff --git a/itcl/itcl/tests/body.test b/itcl/itcl/tests/body.test
new file mode 100644
index 00000000000..fbd4e65e21a
--- /dev/null
+++ b/itcl/itcl/tests/body.test
@@ -0,0 +1,218 @@
+#
+# Tests for "body" and "configbody" commands
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Test "body" command
+# ----------------------------------------------------------------------
+test body-1.1 {define a class with missing bodies and arg lists} {
+ class test_body {
+ constructor {args} {}
+ destructor {}
+
+ method any
+ method zero {}
+ method one {x}
+ method two {x y}
+ method defvals {x {y 0} {z 1}}
+ method varargs {x args}
+
+ method override {mesg} {
+ return "override: $mesg"
+ }
+ }
+} ""
+
+test body-1.2 {cannot use methods without a body} {
+ test_body #auto
+ list [catch "test_body0 any" msg] $msg
+} {1 {member function "::test_body::any" is not defined and cannot be autoloaded}}
+
+test body-1.3 {check syntax of "body" command} {
+ list [catch "body test_body::any" msg] $msg
+} {1 {wrong # args: should be "body class::func arglist body"}}
+
+test body-1.4 {make sure members are found correctly} {
+ list [catch "body test_body::xyzzyxyzzyxyzzy {} {}" msg] $msg
+} {1 {function "xyzzyxyzzyxyzzy" is not defined in class "::test_body"}}
+
+test body-1.5a {members without an argument list can have any args} {
+ body test_body::any {} {return "any"}
+ list [catch "test_body0 any" msg] $msg
+} {0 any}
+
+test body-1.5b {members without an argument list can have any args} {
+ body test_body::any {x} {return "any: $x"}
+ list [catch "test_body0 any 1" msg] $msg
+} {0 {any: 1}}
+
+test body-1.5c {members without an argument list can have any args} {
+ body test_body::any {x {y 2}} {return "any: $x $y"}
+ list [catch "test_body0 any 1" msg] $msg
+} {0 {any: 1 2}}
+
+test body-1.6a {an empty argument list must stay empty} {
+ list [catch {body test_body::zero {x y} {return "zero: $x $y"}} msg] $msg
+} {1 {argument list changed for function "::test_body::zero": should be ""}}
+
+test body-1.6b {an empty argument list must stay empty} {
+ list [catch {body test_body::zero {} {return "zero"}} msg] $msg
+} {0 {}}
+
+test body-1.7a {preserve argument list: fixed arguments} {
+ list [catch {body test_body::one {x y} {return "one: $x $y"}} msg] $msg
+} {1 {argument list changed for function "::test_body::one": should be "x"}}
+
+test body-1.7b {preserve argument list: fixed arguments} {
+ list [catch {body test_body::one {a} {return "one: $a"}} msg] $msg
+} {0 {}}
+
+test body-1.7c {preserve argument list: fixed arguments} {
+ list [catch "test_body0 one 1.0" msg] $msg
+} {0 {one: 1.0}}
+
+test body-1.8a {preserve argument list: fixed arguments} {
+ list [catch {body test_body::two {x} {return "two: $x"}} msg] $msg
+} {1 {argument list changed for function "::test_body::two": should be "x y"}}
+
+test body-1.8b {preserve argument list: fixed arguments} {
+ list [catch {body test_body::two {a b} {return "two: $a $b"}} msg] $msg
+} {0 {}}
+
+test body-1.8c {preserve argument list: fixed arguments} {
+ list [catch "test_body0 two 2.0 3.0" msg] $msg
+} {0 {two: 2.0 3.0}}
+
+test body-1.9a {preserve argument list: default arguments} {
+ list [catch {body test_body::defvals {x} {}} msg] $msg
+} {1 {argument list changed for function "::test_body::defvals": should be "x {y 0} {z 1}"}}
+
+test body-1.9b {preserve argument list: default arguments} {
+ list [catch {body test_body::defvals {a {b 0} {c 2}} {}} msg] $msg
+} {1 {argument list changed for function "::test_body::defvals": should be "x {y 0} {z 1}"}}
+
+test body-1.9c {preserve argument list: default arguments} {
+ list [catch {body test_body::defvals {a {b 0} {c 1}} {}} msg] $msg
+} {0 {}}
+
+test body-1.10a {preserve argument list: variable arguments} {
+ list [catch {body test_body::varargs {} {}} msg] $msg
+} {1 {argument list changed for function "::test_body::varargs": should be "x args"}}
+
+test body-1.10b {preserve argument list: variable arguments} {
+ list [catch {body test_body::varargs {a} {}} msg] $msg
+} {0 {}}
+
+test body-1.10c {preserve argument list: variable arguments} {
+ list [catch {body test_body::varargs {a b c} {}} msg] $msg
+} {0 {}}
+
+test body-1.11 {redefined body really does change} {
+ list [test_body0 override "test #1"] \
+ [body test_body::override {text} {return "new: $text"}] \
+ [test_body0 override "test #2"]
+} {{override: test #1} {} {new: test #2}}
+
+# ----------------------------------------------------------------------
+# Test "body" command with inheritance
+# ----------------------------------------------------------------------
+test body-2.1 {inherit from a class with missing bodies} {
+ class test_ibody {
+ inherit test_body
+ method zero {}
+ }
+ test_ibody #auto
+} {test_ibody0}
+
+test body-2.2 {redefine a method in a derived class} {
+ body test_ibody::zero {} {return "ibody zero"}
+ list [test_ibody0 info function zero] \
+ [test_ibody0 info function test_body::zero]
+} {{public method ::test_ibody::zero {} {return "ibody zero"}} {public method ::test_body::zero {} {return "zero"}}}
+
+test body-2.3 {try to redefine a method that was not declared} {
+ list [catch {body test_ibody::one {x} {return "new"}} msg] $msg
+} {1 {function "one" is not defined in class "::test_ibody"}}
+
+# ----------------------------------------------------------------------
+# Test "configbody" command
+# ----------------------------------------------------------------------
+test body-3.1 {define a class with public variables} {
+ class test_cbody {
+ private variable priv
+ protected variable prot
+
+ public variable option {} {
+ lappend messages "option: $option"
+ }
+ public variable nocode {}
+ public common messages
+ }
+} ""
+
+test body-3.2 {check syntax of "configbody" command} {
+ list [catch "configbody test_cbody::option" msg] $msg
+} {1 {wrong # args: should be "configbody class::option body"}}
+
+test body-3.3 {make sure that members are found correctly} {
+ list [catch "configbody test_cbody::xyzzy {}" msg] $msg
+} {1 {option "xyzzy" is not defined in class "::test_cbody"}}
+
+test body-3.4 {private variables have no config code} {
+ list [catch "configbody test_cbody::priv {bogus}" msg] $msg
+} {1 {option "::test_cbody::priv" is not a public configuration option}}
+
+test body-3.5 {protected variables have no config code} {
+ list [catch "configbody test_cbody::prot {bogus}" msg] $msg
+} {1 {option "::test_cbody::prot" is not a public configuration option}}
+
+test body-3.6 {can use public variables without a body} {
+ test_cbody #auto
+ list [catch "test_cbody0 configure -nocode 1" msg] $msg
+} {0 {}}
+
+test body-3.7 {redefined body really does change} {
+ list [test_cbody0 configure -option "hello"] \
+ [configbody test_cbody::option {lappend messages "new: $option"}] \
+ [test_cbody0 configure -option "goodbye"] \
+ [set test_cbody::messages] \
+} {{} {} {} {{option: hello} {new: goodbye}}}
+
+# ----------------------------------------------------------------------
+# Test "configbody" command with inheritance
+# ----------------------------------------------------------------------
+test body-4.1 {inherit from a class with missing config bodies} {
+ class test_icbody {
+ inherit test_cbody
+ public variable option "icbody"
+ }
+ test_icbody #auto
+} {test_icbody0}
+
+test body-4.2 {redefine a body in a derived class} {
+ configbody test_icbody::option {lappend messages "test_icbody: $option"}
+ list [test_icbody0 info variable option] \
+ [test_icbody0 info variable test_cbody::option]
+} {{public variable ::test_icbody::option icbody {lappend messages "test_icbody: $option"} icbody} {public variable ::test_cbody::option {} {lappend messages "new: $option"} {}}}
+
+test body-4.3 {try to redefine a body for a variable that was not declared} {
+ list [catch {configbody test_icbody::nocode {return "new"}} msg] $msg
+} {1 {option "nocode" is not defined in class "::test_icbody"}}
+
+# ----------------------------------------------------------------------
+# Clean up
+# ----------------------------------------------------------------------
+delete class test_body test_cbody
diff --git a/itcl/itcl/tests/chain.test b/itcl/itcl/tests/chain.test
new file mode 100644
index 00000000000..c78d5f34792
--- /dev/null
+++ b/itcl/itcl/tests/chain.test
@@ -0,0 +1,148 @@
+#
+# Tests for chaining methods and procs
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Chaining methods and procs
+# ----------------------------------------------------------------------
+test chain-1.1 {define simple classes with inheritance} {
+ itcl::class test_chain_a {
+ constructor {args} {
+ eval chain $args
+ } {
+ global ::test_chain_status
+ lappend test_chain_status "a::constructor $args"
+ }
+ method show {mesg} {
+ chain $mesg
+ global ::test_chain_status
+ lappend test_chain_status "a::show $mesg"
+ }
+ proc tell {mesg} {
+ global ::test_chain_status
+ lappend test_chain_status "a::tell $mesg"
+ chain $mesg
+ }
+ }
+ itcl::class test_chain_b {
+ constructor {args} {
+ eval chain $args
+ } {
+ global ::test_chain_status
+ lappend test_chain_status "b::constructor $args"
+ }
+ method show {mesg} {
+ chain $mesg
+ global ::test_chain_status
+ lappend test_chain_status "b::show $mesg"
+ }
+ proc tell {mesg} {
+ global ::test_chain_status
+ lappend test_chain_status "b::tell $mesg"
+ chain $mesg
+ }
+ }
+ itcl::class test_chain_c {
+ inherit test_chain_a test_chain_b
+ constructor {args} {
+ eval chain $args
+ } {
+ global ::test_chain_status
+ lappend test_chain_status "c::constructor $args"
+ }
+ proc tell {mesg} {
+ global ::test_chain_status
+ lappend test_chain_status "c::tell $mesg"
+ chain $mesg
+ }
+ }
+ itcl::class test_chain_d {
+ inherit test_chain_c
+ constructor {args} {
+ eval chain $args
+ } {
+ global ::test_chain_status
+ lappend test_chain_status "d::constructor $args"
+ }
+ method show {mesg} {
+ chain $mesg
+ global ::test_chain_status
+ lappend test_chain_status "d::show $mesg"
+ }
+ proc tell {mesg} {
+ global ::test_chain_status
+ lappend test_chain_status "d::tell $mesg"
+ chain $mesg
+ }
+ }
+} ""
+
+test chain-1.2 {create a test object} {
+ set test_chain_status ""
+ set testobj [test_chain_d #auto 1 2 3]
+ set test_chain_status
+} {{b::constructor 1 2 3} {a::constructor 1 2 3} {c::constructor 1 2 3} {d::constructor 1 2 3}}
+
+test chain-1.3 {invoke a chained method} {
+ set test_chain_status ""
+ $testobj show "hello there"
+ set test_chain_status
+} {{b::show hello there} {a::show hello there} {d::show hello there}}
+
+test chain-1.4 {invoke a chained method with a specific name} {
+ set test_chain_status ""
+ $testobj test_chain_d::show "hello there"
+ set test_chain_status
+} {{b::show hello there} {a::show hello there} {d::show hello there}}
+
+test chain-1.5 {chained methods can cross multiple-inheritance branches} {
+ set test_chain_status ""
+ $testobj test_chain_a::show "hello there"
+ set test_chain_status
+} {{b::show hello there} {a::show hello there}}
+
+test chain-1.6 {invoke a chained proc} {
+ set test_chain_status ""
+ test_chain_d::tell "testing 1 2 3"
+ set test_chain_status
+} {{d::tell testing 1 2 3} {c::tell testing 1 2 3} {a::tell testing 1 2 3}}
+
+test chain-1.7 {invoke a chained proc} {
+ set test_chain_status ""
+ test_chain_c::tell "testing 1 2 3"
+ set test_chain_status
+} {{c::tell testing 1 2 3} {a::tell testing 1 2 3}}
+
+test chain-2.1 {create a test object in a base class} {
+ set test_chain_status ""
+ set testobj [test_chain_c #auto 4 5 6]
+ set test_chain_status
+} {{b::constructor 4 5 6} {a::constructor 4 5 6} {c::constructor 4 5 6}}
+
+test chain-2.2 {invoke a chained method} {
+ set test_chain_status ""
+ $testobj show "hello there"
+ set test_chain_status
+} {{b::show hello there} {a::show hello there}}
+
+test chain-3.0 {invoke "chain" outside of a class} {
+ list [catch {itcl::builtin::chain 1 2 3} err] $err
+} {1 {cannot chain functions outside of a class context}}
+
+# ----------------------------------------------------------------------
+# Clean up
+# ----------------------------------------------------------------------
+delete class test_chain_d test_chain_c test_chain_b test_chain_a
diff --git a/itcl/itcl/tests/defs b/itcl/itcl/tests/defs
new file mode 100644
index 00000000000..4be66bc07c2
--- /dev/null
+++ b/itcl/itcl/tests/defs
@@ -0,0 +1,343 @@
+# 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) 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: @(#) defs 1.44 96/10/08 17:26:58
+
+if ![info exists VERBOSE] {
+ set VERBOSE 0
+}
+if ![info exists TESTS] {
+ set TESTS {}
+}
+
+# If tests are being run as root, issue a warning message and set a
+# variable to prevent some tests from running at all.
+
+set user {}
+if {$tcl_platform(platform) == "unix"} {
+ catch {set user [exec whoami]}
+ if {$user == ""} {
+ catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
+ }
+ if {$user == ""} {set user root}
+ if {$user == "root"} {
+ puts stdout "Warning: you're executing as root. I'll have to"
+ puts stdout "skip some of the tests, since they'll fail as root."
+ }
+}
+
+# Some of the tests don't work on some system configurations due to
+# differences in word length, file system configuration, etc. In order
+# to prevent false alarms, these tests are generally only run in the
+# master development directory for Tcl. The presence of a file
+# "doAllTests" in this directory is used to indicate that the non-portable
+# tests should be run.
+
+set doNonPortableTests [file exists doAllTests]
+
+# 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 {}
+}
+
+# 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.
+# tempNotPc - The inverse of pcOnly. This flag is used to
+# temporarily disable a test.
+# nonBlockFiles - 1 means this platform supports setting files into
+# nonblocking mode.
+# asyncPipeClose- 1 means this platform supports async flush and
+# async close on a pipe.
+# unixExecs - 1 means this machine has commands such as 'cat',
+# 'echo' etc available.
+
+catch {unset testConfig}
+if {$tcl_platform(platform) == "unix"} {
+ set testConfig(unixOnly) 1
+ set testConfig(tempNotPc) 1
+} else {
+ set testConfig(unixOnly) 0
+}
+if {$tcl_platform(platform) == "macintosh"} {
+ set testConfig(tempNotPc) 1
+ set testConfig(macOnly) 1
+} else {
+ set testConfig(macOnly) 0
+}
+if {$tcl_platform(platform) == "windows"} {
+ set testConfig(pcOnly) 1
+} else {
+ set testConfig(pcOnly) 0
+}
+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) [file exists doAllTests]
+
+set f [open defs r]
+if {[expr [catch {fconfigure $f -blocking off}]] == 0} {
+ set testConfig(nonBlockFiles) 1
+} else {
+ set testConfig(nonBlockFiles) 0
+}
+close $f
+
+# 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 testConfig(asyncPipeClose) 0
+ } else {
+ set testConfig(asyncPipeClose) 1
+ }
+} else {
+ set testConfig(asyncPipeClose) 1
+}
+
+# Test to see if execed commands such as cat, echo, rm and so forth are
+# present on this machine.
+
+set testConfig(unixExecs) 1
+if {$tcl_platform(platform) == "macintosh"} {
+ set testConfig(unixExecs) 0
+}
+if {($testConfig(unixExecs) == 1) && ($tcl_platform(platform) == "windows")} {
+ if {[catch {exec cat defs}] == 1} {
+ set testConfig(unixExecs) 0
+ }
+ if {($testConfig(unixExecs) == 1) && ([catch {exec echo hello}] == 1)} {
+ set testConfig(unixExecs) 0
+ }
+ if {($testConfig(unixExecs) == 1) && \
+ ([catch {exec sh -c echo hello}] == 1)} {
+ set testConfig(unixExecs) 0
+ }
+ if {($testConfig(unixExecs) == 1) && ([catch {exec wc defs}] == 1)} {
+ set testConfig(unixExecs) 0
+ }
+ if {$testConfig(unixExecs) == 1} {
+ exec echo hello > removeMe
+ if {[catch {exec rm removeMe}] == 1} {
+ set testConfig(unixExecs) 0
+ }
+ }
+ if {($testConfig(unixExecs) == 1) && ([catch {exec sleep 1}] == 1)} {
+ set testConfig(unixExecs) 0
+ }
+ if {($testConfig(unixExecs) == 1) && \
+ ([catch {exec fgrep unixExecs defs}] == 1)} {
+ set testConfig(unixExecs) 0
+ }
+ if {($testConfig(unixExecs) == 1) && ([catch {exec ps}] == 1)} {
+ set testConfig(unixExecs) 0
+ }
+ if {($testConfig(unixExecs) == 1) && \
+ ([catch {exec echo abc > removeMe}] == 0) && \
+ ([catch {exec chmod 644 removeMe}] == 1) && \
+ ([catch {exec rm removeMe}] == 0)} {
+ set testConfig(unixExecs) 0
+ } else {
+ catch {exec rm -f removeMe}
+ }
+ if {($testConfig(unixExecs) == 1) && \
+ ([catch {exec mkdir removeMe}] == 1)} {
+ set testConfig(unixExecs) 0
+ } else {
+ catch {exec rm -r removeMe}
+ }
+ if {$testConfig(unixExecs) == 0} {
+ puts stdout "Warning: Unix-style executables are not available, so"
+ puts stdout "some tests will be skipped."
+ }
+}
+
+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} then {
+ set ok 0
+ foreach test $TESTS {
+ if [string match $test $name] then {
+ set ok 1
+ break
+ }
+ }
+ if !$ok then 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]
+ foreach constraint $constraints {
+ if {![info exists testConfig($constraint)]
+ || !$testConfig($constraint)} {
+ 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} then {
+ if $VERBOSE then {
+ if {$VERBOSE > 0} {
+ print_verbose $name $description $script \
+ $code $result
+ }
+ 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
+}
+
+proc normalizeMsg {msg} {
+ regsub "\n$" [string tolower $msg] "" msg
+ regsub -all "\n\n" $msg "\n" msg
+ regsub -all "\n\}" $msg "\}" msg
+ return $msg
+}
+
+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
+}
+
+proc makeDirectory {name} {
+ file mkdir $name
+}
+
+proc removeDirectory {name} {
+ file delete -force $name
+}
+
+proc viewFile {name} {
+ global tcl_platform testConfig
+ if {($tcl_platform(platform) == "macintosh") || \
+ ($testConfig(unixExecs) == 0)} {
+ set f [open $name]
+ set data [read -nonewline $f]
+ close $f
+ return $data
+ } else {
+ exec cat $name
+ }
+}
+
+# Locate tcltest executable
+
+set tcltest [list [info nameofexecutable]]
+if {$tcltest == "{}"} {
+ set tcltest {}
+ puts "Unable to find tcltest executable, multiple process tests will fail."
+}
+
+
diff --git a/itcl/itcl/tests/delete.test b/itcl/itcl/tests/delete.test
new file mode 100644
index 00000000000..bf4ce5b61b8
--- /dev/null
+++ b/itcl/itcl/tests/delete.test
@@ -0,0 +1,204 @@
+#
+# Tests for deleting classes and objects
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Deleting classes and objects
+# ----------------------------------------------------------------------
+test delete-1.1 {define a simple classes with inheritance} {
+ itcl::class test_delete_base {
+ variable num 0
+ method show {} {
+ return $num
+ }
+ }
+} ""
+
+test delete-1.2 {create some base class objects} {
+ for {set i 0} {$i < 5} {incr i} {
+ test_delete_base #auto
+ }
+ lsort [find objects -class test_delete_base]
+} {test_delete_base0 test_delete_base1 test_delete_base2 test_delete_base3 test_delete_base4}
+
+test delete-1.3 {delete the base class--class and all objects go away} {
+ list [delete class test_delete_base] \
+ [find classes test_delete_base] \
+ [namespace children :: test_delete_base] \
+ [namespace which -command test_delete_base] \
+ [find objects test_delete_base*]
+} {{} {} {} {} {}}
+
+# ----------------------------------------------------------------------
+# Deleting classes and objects with inheritance
+# ----------------------------------------------------------------------
+test delete-2.1 {define a simple classes with inheritance} {
+ variable ::test_delete_watch ""
+ itcl::class test_delete_base {
+ variable num 0
+ method show {} {
+ return $num
+ }
+ destructor {
+ global ::test_delete_watch
+ lappend test_delete_watch $this
+ }
+ }
+ itcl::class test_delete {
+ inherit test_delete_base
+ method show {} {
+ return ">$num<"
+ }
+ }
+} ""
+
+test delete-2.2 {create some base and derived class objects} {
+ for {set i 0} {$i < 3} {incr i} {
+ test_delete_base #auto
+ }
+ for {set i 0} {$i < 3} {incr i} {
+ test_delete #auto
+ }
+ lsort [find objects -isa test_delete_base]
+} {test_delete0 test_delete1 test_delete2 test_delete_base0 test_delete_base1 test_delete_base2}
+
+test delete-2.3 {delete the base class--class and all objects go away} {
+ list [delete class test_delete_base] \
+ [find classes test_delete*] \
+ [namespace children :: test_delete*] \
+ [namespace which -command test_delete_base] \
+ [namespace which -command test_delete] \
+ [find objects test_delete*]
+} {{} {} {} {} {} {}}
+
+test delete-2.4 {object destructors get invoked properly} {
+ lsort $test_delete_watch
+} {::test_delete0 ::test_delete1 ::test_delete2 ::test_delete_base0 ::test_delete_base1 ::test_delete_base2}
+
+# ----------------------------------------------------------------------
+# Deleting class namespaces
+# ----------------------------------------------------------------------
+test delete-3.1 {redefine classes with inheritance} {
+ variable ::test_delete_watch ""
+ itcl::class test_delete_base {
+ variable num 0
+ method show {} {
+ return $num
+ }
+ destructor {
+ global test_delete_watch
+ lappend test_delete_watch $this
+ }
+ }
+ itcl::class test_delete {
+ inherit test_delete_base
+ method show {} {
+ return ">$num<"
+ }
+ }
+} ""
+
+test delete-3.2 {create some base and derived class objects} {
+ for {set i 0} {$i < 3} {incr i} {
+ test_delete_base #auto
+ }
+ for {set i 0} {$i < 3} {incr i} {
+ test_delete #auto
+ }
+ lsort [find objects -isa test_delete_base]
+} {test_delete0 test_delete1 test_delete2 test_delete_base0 test_delete_base1 test_delete_base2}
+
+test delete-3.3 {deleting a class namespace is like deleting a class} {
+ list [namespace delete test_delete_base] \
+ [find classes test_delete*] \
+ [namespace children :: test_delete*] \
+ [namespace which -command test_delete_base] \
+ [namespace which -command test_delete] \
+ [find objects test_delete*]
+} {{} {} {} {} {} {}}
+
+test delete-3.4 {object destructors get invoked, even during catastrophe} {
+ lsort $test_delete_watch
+} {::test_delete0 ::test_delete1 ::test_delete2 ::test_delete_base0 ::test_delete_base1 ::test_delete_base2}
+
+# ----------------------------------------------------------------------
+# Self-destructing objects
+# ----------------------------------------------------------------------
+test basic-4.1 {define a class where objects destroy themselves} {
+ itcl::class test_delete {
+ public variable x ""
+ public variable deletecommand ""
+ constructor {args} {
+ eval configure $args
+ }
+ destructor {
+ eval $deletecommand
+ }
+ method killme {code} {
+ delete object $this
+ eval $code
+ }
+ }
+} {}
+
+test basic-4.2 {an object can delete itself} {
+ set obj [test_delete #auto -x "data stays"]
+ list [$obj killme {return $x}] [find objects -isa test_delete]
+} {{data stays} {}}
+
+test basic-4.3 {the "this" variable becomes null after delete} {
+ set obj [test_delete #auto]
+ list [$obj killme {return $this}] [find objects -isa test_delete]
+} {{} {}}
+
+test basic-4.4 {an object being destructed can't be deleted} {
+ set obj [test_delete #auto -deletecommand {delete object $this}]
+ list [catch {delete object $obj} msg] $msg
+} {1 {can't delete an object while it is being destructed}}
+
+namespace delete test_delete
+
+# ----------------------------------------------------------------------
+# Delete objects using path names and scoped values
+# ----------------------------------------------------------------------
+test basic-5.1 {define a simple class} {
+ itcl::class test_delete_name {
+ private variable x 0
+ method test {x} {
+ return $x
+ }
+ }
+} {}
+
+test basic-5.2 {delete using a qualified name} {
+ namespace eval test_delete2 {test_delete_name #auto}
+ set cmd {delete object test_delete2::test_delete_name0}
+ list [catch $cmd msg] $msg [find objects -isa test_delete_name]
+} {0 {} {}}
+
+test basic-5.3 {delete using a scoped value} {
+ set obj [namespace eval test_delete2 {code [test_delete_name #auto]}]
+ set cmd [list delete object $obj]
+ list [catch $cmd msg] $msg [find objects -isa test_delete_name]
+} {0 {} {}}
+
+test basic-5.4 {scoped command names are decoded properly} {
+ list [catch {delete object {namespace inscope ::xyzzy xxx}} msg] $msg \
+ [catch {delete object {namespace inscope :: xxx yyy}} msg] $msg \
+ [catch {delete object {namespace inscope :: xyzzy}} msg] $msg
+} {1 {unknown namespace "::xyzzy"} 1 {malformed command "namespace inscope :: xxx yyy": should be "namespace inscope namesp command"} 1 {object "namespace inscope :: xyzzy" not found}}
+
+namespace delete test_delete_name test_delete2
diff --git a/itcl/itcl/tests/ensemble.test b/itcl/itcl/tests/ensemble.test
new file mode 100644
index 00000000000..21892a9fed5
--- /dev/null
+++ b/itcl/itcl/tests/ensemble.test
@@ -0,0 +1,185 @@
+#
+# Tests for the "ensemble" compound command facility
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+test ensemble-1.1 {ensemble name must be specified} {
+ list [catch {ensemble} msg] $msg
+} {1 {wrong # args: should be "ensemble name ?command arg arg...?"}}
+
+test ensemble-1.2 {creating a new ensemble} {
+ ensemble test_numbers {
+ part one {x} {
+ return "one: $x"
+ }
+ part two {x y} {
+ return "two: $x $y"
+ }
+ }
+} ""
+test ensemble-1.3 {adding to an existing ensemble} {
+ ensemble test_numbers part three {x y z} {
+ return "three: $x $y $z"
+ }
+} ""
+
+test ensemble-1.4 {invoking ensemble parts} {
+ list [test_numbers one 1] [test_numbers two 2 3] [test_numbers three 3 4 5]
+} {{one: 1} {two: 2 3} {three: 3 4 5}}
+
+test ensemble-1.5 {invoking parts with improper arguments} {
+ list [catch "test_numbers three x" msg] $msg
+} {1 {no value given for parameter "y" to "test_numbers three"}}
+
+test ensemble-1.6 {errors trigger a usage summary} {
+ list [catch "test_numbers foo x y" msg] $msg
+} {1 {bad option "foo": should be one of...
+ test_numbers one x
+ test_numbers three x y z
+ test_numbers two x y}}
+
+test ensemble-1.7 {one part can't overwrite another} {
+ set cmd {
+ ensemble test_numbers part three {} {
+ return "three: new version"
+ }
+ }
+ list [catch $cmd msg] $msg
+} {1 {part "three" already exists in ensemble}}
+
+test ensemble-1.8 {an ensemble can't overwrite another part} {
+ set cmd {
+ ensemble test_numbers ensemble three part new {} {
+ return "three: new version"
+ }
+ }
+ list [catch $cmd msg] $msg
+} {1 {part "three" is not an ensemble}}
+
+test ensemble-1.9 {body errors are handled gracefully} {
+ list [catch "ensemble test_numbers {foo bar baz}" msg] $msg $errorInfo
+} {1 {invalid command name "foo"} {invalid command name "foo"
+ while executing
+"foo bar baz"
+ ("ensemble" body line 1)
+ invoked from within
+"ensemble test_numbers {foo bar baz}"}}
+
+test ensemble-1.10 {part errors are handled gracefully} {
+ list [catch "ensemble test_numbers {part foo}" msg] $msg $errorInfo
+} {1 {wrong # args: should be "part name args body"} {wrong # args: should be "part name args body"
+ while executing
+"part foo"
+ ("ensemble" body line 1)
+ invoked from within
+"ensemble test_numbers {part foo}"}}
+
+test ensemble-1.11 {part argument errors are handled gracefully} {
+ list [catch "ensemble test_numbers {part foo {{}} {}}" msg] $msg $errorInfo
+} {1 {procedure "foo" has argument with no name} {procedure "foo" has argument with no name
+ while executing
+"part foo {{}} {}"
+ ("ensemble" body line 1)
+ invoked from within
+"ensemble test_numbers {part foo {{}} {}}"}}
+
+test ensemble-2.0 {defining subensembles} {
+ ensemble test_numbers {
+ ensemble hex {
+ part base {} {
+ return 16
+ }
+ part digits {args} {
+ foreach num $args {
+ lappend result "0x$num"
+ }
+ return $result
+ }
+ }
+ ensemble octal {
+ part base {} {
+ return 8
+ }
+ part digits {{prefix 0} args} {
+ foreach num $args {
+ lappend result "$prefix$num"
+ }
+ return $result
+ }
+ }
+ }
+ list [catch "test_numbers foo" msg] $msg
+} {1 {bad option "foo": should be one of...
+ test_numbers hex option ?arg arg ...?
+ test_numbers octal option ?arg arg ...?
+ test_numbers one x
+ test_numbers three x y z
+ test_numbers two x y}}
+
+test ensemble-2.1 {invoking sub-ensemble parts} {
+ list [catch "test_numbers hex base" msg] $msg
+} {0 16}
+
+test ensemble-2.2 {invoking sub-ensemble parts} {
+ list [catch "test_numbers hex digits 3 a f" msg] $msg
+} {0 {0x3 0xa 0xf}}
+
+test ensemble-2.3 {errors from sub-ensembles} {
+ list [catch "test_numbers hex" msg] $msg
+} {1 {wrong # args: should be one of...
+ test_numbers hex base
+ test_numbers hex digits ?arg arg ...?}}
+
+test ensemble-2.4 {invoking sub-ensemble parts} {
+ list [catch "test_numbers octal base" msg] $msg
+} {0 8}
+
+test ensemble-2.5 {invoking sub-ensemble parts} {
+ list [catch "test_numbers octal digits 0o 3 5 10" msg] $msg
+} {0 {0o3 0o5 0o10}}
+
+test ensemble-2.6 {errors from sub-ensembles} {
+ list [catch "test_numbers octal" msg] $msg
+} {1 {wrong # args: should be one of...
+ test_numbers octal base
+ test_numbers octal digits ?prefix? ?arg arg ...?}}
+
+test ensemble-2.7 {sub-ensembles can't be accidentally redefined} {
+ set cmd {
+ ensemble test_numbers part octal {args} {
+ return "octal: $args"
+ }
+ }
+ list [catch $cmd msg] $msg
+} {1 {part "octal" already exists in ensemble}}
+
+test ensemble-3.0 {an error handler part can be used to handle errors} {
+ ensemble test_numbers {
+ part @error {args} {
+ return "error: $args"
+ }
+ }
+ list [catch {test_numbers foo 1 2 3} msg] $msg
+} {0 {error: foo 1 2 3}}
+
+test ensemble-3.1 {the error handler part shows up as generic "...and"} {
+ list [catch {test_numbers} msg] $msg
+} {1 {wrong # args: should be one of...
+ test_numbers hex option ?arg arg ...?
+ test_numbers octal option ?arg arg ...?
+ test_numbers one x
+ test_numbers three x y z
+ test_numbers two x y
+...and others described on the man page}}
diff --git a/itcl/itcl/tests/info.test b/itcl/itcl/tests/info.test
new file mode 100644
index 00000000000..34d49da2966
--- /dev/null
+++ b/itcl/itcl/tests/info.test
@@ -0,0 +1,384 @@
+#
+# Tests for information accessed by the "info" command
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Class definition with one of everything
+# ----------------------------------------------------------------------
+test info-1.1 {define a simple class} {
+ class test_info_base {
+ method base {} {return "default"}
+ variable base {}
+
+ method do {args} {eval $args}
+ }
+ class test_info {
+ inherit test_info_base
+
+ constructor {args} {
+ foreach v [info variable] {
+ catch {set $v "new-[set $v]"}
+ }
+ }
+ destructor {}
+
+ method defm {} {return "default method"}
+ public method pubm {x} {return "public method"}
+ protected method prom {x y} {return "protected method"}
+ private method prim {x y z} {return "private method"}
+
+ proc defp {} {return "default proc"}
+ public proc pubp {x} {return "public proc"}
+ protected proc prop {x y} {return "protected proc"}
+ private proc prip {x y z} {return "private proc"}
+
+ variable defv "default"
+ public variable pubv "public" {set pubv "public: $pubv"}
+ protected variable prov "protected"
+ private variable priv "private"
+
+ common defc "default"
+ public common pubc "public"
+ protected common proc "protected"
+ private common pric "private"
+
+ method uninitm
+ proc uninitp {x y}
+ variable uninitv
+ common uninitc
+ set uninitc(0) zero
+ set uninitc(1) one
+ }
+} ""
+
+test info-1.2 {info: errors trigger usage info} {
+ list [catch {namespace eval test_info {info}} msg] $msg
+} {1 {wrong # args: should be one of...
+ info args procname
+ info body procname
+ info class
+ info function ?name? ?-protection? ?-type? ?-name? ?-args? ?-body?
+ info heritage
+ info inherit
+ info variable ?name? ?-protection? ?-type? ?-name? ?-init? ?-value? ?-config?
+...and others described on the man page}}
+
+test basic-1.3 {info: errors trigger usage info} {
+ test_info ti
+ list [catch {ti info} msg] $msg
+} {1 {wrong # args: should be one of...
+ info args procname
+ info body procname
+ info class
+ info function ?name? ?-protection? ?-type? ?-name? ?-args? ?-body?
+ info heritage
+ info inherit
+ info variable ?name? ?-protection? ?-type? ?-name? ?-init? ?-value? ?-config?
+...and others described on the man page}}
+
+# ----------------------------------------------------------------------
+# Data members
+# ----------------------------------------------------------------------
+test info-2.1 {info: all variables} {
+ lsort [ti info variable]
+} {::test_info::defc ::test_info::defv ::test_info::pric ::test_info::priv ::test_info::proc ::test_info::prov ::test_info::pubc ::test_info::pubv ::test_info::this ::test_info::uninitc ::test_info::uninitv ::test_info_base::base}
+
+test info-2.2a {info: public variables} {
+ ti info variable pubv
+} {public variable ::test_info::pubv public {set pubv "public: $pubv"} new-public}
+
+test info-2.2b {info: public variables} {
+ list [ti info variable pubv -protection] \
+ [ti info variable pubv -type] \
+ [ti info variable pubv -name] \
+ [ti info variable pubv -init] \
+ [ti info variable pubv -config] \
+ [ti info variable pubv -value] \
+} {public variable ::test_info::pubv public {set pubv "public: $pubv"} new-public}
+
+test info-2.3a {info: protected variables} {
+ ti info variable prov
+} {protected variable ::test_info::prov protected new-protected}
+
+test info-2.3b {info: protected variables} {
+ list [ti info variable prov -protection] \
+ [ti info variable prov -type] \
+ [ti info variable prov -name] \
+ [ti info variable prov -init] \
+ [ti info variable prov -value] \
+} {protected variable ::test_info::prov protected new-protected}
+
+test info-2.4a {info: private variables} {
+ ti info variable priv
+} {private variable ::test_info::priv private new-private}
+
+test info-2.4b {info: private variables} {
+ list [ti info variable priv -protection] \
+ [ti info variable priv -type] \
+ [ti info variable priv -name] \
+ [ti info variable priv -init] \
+ [ti info variable priv -value] \
+} {private variable ::test_info::priv private new-private}
+
+test info-2.5 {"this" variable is built in} {
+ ti info variable this
+} {protected variable ::test_info::this ::ti ::ti}
+
+test info-2.6 {info: protected/private variables have no "config" code} {
+ list [ti info variable prov -config] [ti info variable priv -config]
+} {{} {}}
+
+test info-2.7 {by default, variables are "protected"} {
+ ti info variable defv
+} {protected variable ::test_info::defv default new-default}
+
+test info-2.8 {data members may be uninitialized} {
+ ti info variable uninitv
+} {protected variable ::test_info::uninitv <undefined> <undefined>}
+
+test info-2.9a {info: public common variables} {
+ ti info variable pubc
+} {public common ::test_info::pubc public new-public}
+
+test info-2.9b {info: public common variables} {
+ list [ti info variable pubc -protection] \
+ [ti info variable pubc -type] \
+ [ti info variable pubc -name] \
+ [ti info variable pubc -init] \
+ [ti info variable pubc -value] \
+} {public common ::test_info::pubc public new-public}
+
+test info-2.10a {info: protected common variables} {
+ ti info variable proc
+} {protected common ::test_info::proc protected new-protected}
+
+test info-2.10b {info: protected common variables} {
+ list [ti info variable proc -protection] \
+ [ti info variable proc -type] \
+ [ti info variable proc -name] \
+ [ti info variable proc -init] \
+ [ti info variable proc -value] \
+} {protected common ::test_info::proc protected new-protected}
+
+test info-2.11a {info: private common variables} {
+ ti info variable pric
+} {private common ::test_info::pric private new-private}
+
+test info-2.11b {info: private common variables} {
+ list [ti info variable pric -protection] \
+ [ti info variable pric -type] \
+ [ti info variable pric -name] \
+ [ti info variable pric -init] \
+ [ti info variable pric -value] \
+} {private common ::test_info::pric private new-private}
+
+test info-2.12 {info: public/protected/private vars have no "config" code} {
+ list [ti info variable pubc -config] \
+ [ti info variable proc -config] \
+ [ti info variable pric -config]
+} {{} {} {}}
+
+test info-2.13 {by default, variables are "protected"} {
+ ti info variable defc
+} {protected common ::test_info::defc default new-default}
+
+test info-2.14 {data members may be uninitialized} {
+ ti info variable uninitc
+} {protected common ::test_info::uninitc <undefined> <undefined>}
+
+test info-2.15 {common vars can be initialized within class definition} {
+ list [namespace eval test_info {lsort [array names uninitc]}] \
+ [namespace eval test_info {set uninitc(0)}] \
+ [namespace eval test_info {set uninitc(1)}]
+} {{0 1} zero one}
+
+test info-2.16 {flag syntax errors} {
+ list [catch {ti info variable defv -xyzzy} msg] $msg
+} {1 {bad option "-xyzzy": must be -config, -init, -name, -protection, -type, or -value}}
+
+# ----------------------------------------------------------------------
+# Member functions
+# ----------------------------------------------------------------------
+test basic-3.1 {info: all functions} {
+ lsort [ti info function]
+} {::test_info::constructor ::test_info::defm ::test_info::defp ::test_info::destructor ::test_info::prim ::test_info::prip ::test_info::prom ::test_info::prop ::test_info::pubm ::test_info::pubp ::test_info::uninitm ::test_info::uninitp ::test_info_base::base ::test_info_base::cget ::test_info_base::configure ::test_info_base::do ::test_info_base::isa}
+
+test info-3.2a {info: public methods} {
+ ti info function pubm
+} {public method ::test_info::pubm x {return "public method"}}
+
+test info-3.2b {info: public methods} {
+ list [ti info function pubm -protection] \
+ [ti info function pubm -type] \
+ [ti info function pubm -name] \
+ [ti info function pubm -args] \
+ [ti info function pubm -body]
+} {public method ::test_info::pubm x {return "public method"}}
+
+test info-3.3a {info: protected methods} {
+ ti info function prom
+} {protected method ::test_info::prom {x y} {return "protected method"}}
+
+test info-3.3b {info: protected methods} {
+ list [ti info function prom -protection] \
+ [ti info function prom -type] \
+ [ti info function prom -name] \
+ [ti info function prom -args] \
+ [ti info function prom -body]
+} {protected method ::test_info::prom {x y} {return "protected method"}}
+
+test info-3.4a {info: private methods} {
+ ti info function prim
+} {private method ::test_info::prim {x y z} {return "private method"}}
+
+test info-3.4b {info: private methods} {
+ list [ti info function prim -protection] \
+ [ti info function prim -type] \
+ [ti info function prim -name] \
+ [ti info function prim -args] \
+ [ti info function prim -body]
+} {private method ::test_info::prim {x y z} {return "private method"}}
+
+test info-3.5 {"configure" function is built in} {
+ ti info function configure
+} {public method ::test_info_base::configure {?-option? ?value -option value...?} @itcl-builtin-configure}
+
+test info-3.6 {by default, methods are "public"} {
+ ti info function defm
+} {public method ::test_info::defm {} {return "default method"}}
+
+test info-3.7 {methods may not have arg lists or bodies defined} {
+ ti info function uninitm
+} {public method ::test_info::uninitm <undefined> <undefined>}
+
+test info-3.8a {info: public procs} {
+ ti info function pubp
+} {public proc ::test_info::pubp x {return "public proc"}}
+
+test info-3.8b {info: public procs} {
+ list [ti info function pubp -protection] \
+ [ti info function pubp -type] \
+ [ti info function pubp -name] \
+ [ti info function pubp -args] \
+ [ti info function pubp -body]
+} {public proc ::test_info::pubp x {return "public proc"}}
+
+test info-3.9a {info: protected procs} {
+ ti info function prop
+} {protected proc ::test_info::prop {x y} {return "protected proc"}}
+
+test info-3.9b {info: protected procs} {
+ list [ti info function prop -protection] \
+ [ti info function prop -type] \
+ [ti info function prop -name] \
+ [ti info function prop -args] \
+ [ti info function prop -body]
+} {protected proc ::test_info::prop {x y} {return "protected proc"}}
+
+test info-3.10a {info: private procs} {
+ ti info function prip
+} {private proc ::test_info::prip {x y z} {return "private proc"}}
+
+test info-3.10b {info: private procs} {
+ list [ti info function prip -protection] \
+ [ti info function prip -type] \
+ [ti info function prip -name] \
+ [ti info function prip -args] \
+ [ti info function prip -body]
+} {private proc ::test_info::prip {x y z} {return "private proc"}}
+
+test info-3.11 {by default, procs are "public"} {
+ ti info function defp
+} {public proc ::test_info::defp {} {return "default proc"}}
+
+test info-3.12 {procs may not have arg lists or bodies defined} {
+ ti info function uninitp
+} {public proc ::test_info::uninitp {x y} <undefined>}
+
+test info-3.13 {flag syntax errors} {
+ list [catch {ti info function defm -xyzzy} msg] $msg
+} {1 {bad option "-xyzzy": must be -args, -body, -name, -protection, or -type}}
+
+# ----------------------------------------------------------------------
+# Other object-related queries
+# ----------------------------------------------------------------------
+
+test info-4.1a {query class (wrong # args)} {
+ list [catch {ti info class x} result] $result
+} {1 {wrong # args: should be "info class"}}
+
+test info-4.1b {query most-specific class} {
+ list [ti info class] [ti do info class]
+} {::test_info ::test_info}
+
+test info-4.2a {query inheritance info (wrong # args)} {
+ list [catch {ti info inherit x} result] $result
+} {1 {wrong # args: should be "info inherit"}}
+
+test info-4.2b {query inheritance info} {
+ list [ti info inherit] [ti do info inherit]
+} {::test_info_base {}}
+
+test info-4.3a {query heritage info (wrong # args)} {
+ list [catch {ti info heritage x} result] $result
+} {1 {wrong # args: should be "info heritage"}}
+
+test info-4.3b {query heritage info} {
+ list [ti info heritage] [ti do info heritage]
+} {{::test_info ::test_info_base} ::test_info_base}
+
+test info-4.4a {query argument list (wrong # args)} {
+ list [catch {ti info args} result] $result \
+ [catch {ti info args x y} result] $result
+} {1 {wrong # args: should be "info args function"} 1 {wrong # args: should be "info args function"}}
+
+test info-4.4b {query argument list} {
+ ti info args prim
+} {x y z}
+
+test info-4.4c {query argument list (undefined)} {
+ ti info args uninitm
+} {<undefined>}
+
+test info-4.5a {query body (wrong # args)} {
+ list [catch {ti info body} result] $result \
+ [catch {ti info body x y} result] $result
+} {1 {wrong # args: should be "info body function"} 1 {wrong # args: should be "info body function"}}
+
+test info-4.5b {query body} {
+ ti info body prim
+} {return "private method"}
+
+test info-4.5c {query body (undefined)} {
+ ti info body uninitm
+} {<undefined>}
+
+# ----------------------------------------------------------------------
+# Other parts of the usual "info" command
+# ----------------------------------------------------------------------
+
+test info-5.1 {info vars} {
+ ti do info vars
+} {args}
+
+test info-5.2 {info exists} {
+ list [ti do info exists args] [ti do info exists xyzzy]
+} {1 0}
+
+# ----------------------------------------------------------------------
+# Clean up
+# ----------------------------------------------------------------------
+delete class test_info test_info_base
diff --git a/itcl/itcl/tests/inherit.test b/itcl/itcl/tests/inherit.test
new file mode 100644
index 00000000000..d391573dee4
--- /dev/null
+++ b/itcl/itcl/tests/inherit.test
@@ -0,0 +1,576 @@
+#
+# Tests for inheritance and scope handling
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Test construction/destruction with inheritance
+# ----------------------------------------------------------------------
+test inherit-1.1 {define classes with constructors/destructors} {
+ variable ::test_cd_watch ""
+ itcl::class test_cd_foo {
+ constructor {x y} {
+ global ::test_cd_watch
+ lappend test_cd_watch "foo: $x $y"
+ }
+ destructor {
+ global ::test_cd_watch
+ lappend test_cd_watch "foo destruct"
+ }
+ }
+ itcl::class test_cd_bar {
+ constructor {args} {
+ global ::test_cd_watch
+ lappend test_cd_watch "bar: $args"
+ }
+ destructor {
+ global ::test_cd_watch
+ lappend test_cd_watch "bar destruct"
+ }
+ }
+ itcl::class test_cd_foobar {
+ inherit test_cd_foo test_cd_bar
+ constructor {x y args} {
+ test_cd_foo::constructor $x $y
+ } {
+ global ::test_cd_watch
+ lappend test_cd_watch "foobar: $x $y ($args)"
+ }
+ destructor {
+ global ::test_cd_watch
+ lappend test_cd_watch "foobar destruct"
+ }
+ }
+ itcl::class test_cd_geek {
+ constructor {} {
+ global ::test_cd_watch
+ lappend test_cd_watch "geek"
+ }
+ destructor {
+ global ::test_cd_watch
+ lappend test_cd_watch "geek destruct"
+ }
+ }
+ itcl::class test_cd_mongrel {
+ inherit test_cd_foobar test_cd_geek
+ constructor {x} {
+ eval test_cd_foobar::constructor 1 2 fred $x
+ } {
+ global ::test_cd_watch
+ lappend test_cd_watch "mongrel: $x"
+ }
+ destructor {
+ global ::test_cd_watch
+ lappend test_cd_watch "mongrel destruct"
+ }
+ }
+ itcl::class test_cd_none {
+ inherit test_cd_bar test_cd_geek
+ }
+ itcl::class test_cd_skip {
+ inherit test_cd_none
+ constructor {} {
+ global ::test_cd_watch
+ lappend test_cd_watch "skip"
+ }
+ destructor {
+ global ::test_cd_watch
+ lappend test_cd_watch "skip destruct"
+ }
+ }
+} {}
+
+test inherit-1.2 {constructors should be invoked in the proper order} {
+ set ::test_cd_watch ""
+ list [test_cd_mongrel #auto bob] [set ::test_cd_watch]
+} {test_cd_mongrel0 {{foo: 1 2} {bar: } {foobar: 1 2 (fred bob)} geek {mongrel: bob}}}
+
+test inherit-1.3 {destructors should be invoked in the proper order} {
+ set ::test_cd_watch ""
+ list [delete object test_cd_mongrel0] [set ::test_cd_watch]
+} {{} {{mongrel destruct} {foobar destruct} {foo destruct} {bar destruct} {geek destruct}}}
+
+test inherit-1.4 {constructors are optional} {
+ set ::test_cd_watch ""
+ list [test_cd_none #auto] [set ::test_cd_watch]
+} {test_cd_none0 {geek {bar: }}}
+
+test inherit-1.5 {destructors are optional} {
+ set ::test_cd_watch ""
+ list [delete object test_cd_none0] [set ::test_cd_watch]
+} {{} {{bar destruct} {geek destruct}}}
+
+test inherit-1.6 {construction ok if constructors are missing} {
+ set ::test_cd_watch ""
+ list [test_cd_skip #auto] [set ::test_cd_watch]
+} {test_cd_skip0 {geek {bar: } skip}}
+
+test inherit-1.7 {destruction ok if destructors are missing} {
+ set ::test_cd_watch ""
+ list [delete object test_cd_skip0] [set ::test_cd_watch]
+} {{} {{skip destruct} {bar destruct} {geek destruct}}}
+
+test inherit-1.8 {errors during construction are cleaned up and reported} {
+ global errorInfo test_cd_watch
+ set test_cd_watch ""
+ body test_cd_bar::constructor {args} {error "bar: failed"}
+ list [catch {test_cd_mongrel #auto bob} msg] $msg \
+ $errorInfo $test_cd_watch
+} {1 {bar: failed} {bar: failed
+ while executing
+"error "bar: failed""
+ while constructing object "::test_cd_mongrel1" in ::test_cd_bar::constructor (body line 1)
+ while constructing object "::test_cd_mongrel1" in ::test_cd_foobar::constructor (body line 1)
+ invoked from within
+"test_cd_foobar::constructor 1 2 fred bob"
+ ("eval" body line 1)
+ invoked from within
+"eval test_cd_foobar::constructor 1 2 fred $x"
+ while constructing object "::test_cd_mongrel1" in ::test_cd_mongrel::constructor (body line 2)
+ invoked from within
+"test_cd_mongrel #auto bob"} {{foo: 1 2} {mongrel destruct} {foobar destruct} {foo destruct} {bar destruct} {geek destruct}}}
+
+test inherit-1.9 {errors during destruction prevent object delete} {
+ global errorInfo test_cd_watch
+ body test_cd_bar::constructor {args} {return "bar: $args"}
+ body test_cd_bar::destructor {} {error "bar: failed"}
+ test_cd_mongrel mongrel1 ted
+ set test_cd_watch ""
+ list [catch {delete object mongrel1} msg] $msg \
+ $errorInfo $test_cd_watch [find objects mongrel*]
+} {1 {bar: failed} {bar: failed
+ while executing
+"error "bar: failed""
+ while deleting object "::mongrel1" in ::test_cd_bar::destructor (body line 1)
+ invoked from within
+"delete object mongrel1"} {{mongrel destruct} {foobar destruct} {foo destruct}} mongrel1}
+
+test inherit-1.10 {errors during destruction prevent class delete} {
+ list [catch {delete class test_cd_foo} msg] $msg
+} {1 {bar: failed}}
+
+eval namespace delete [find classes test_cd_*]
+
+# ----------------------------------------------------------------------
+# Test data member access and scoping
+# ----------------------------------------------------------------------
+test inherit-2.1 {define classes with data members} {
+ itcl::class test_cd_foo {
+ protected variable x "foo-x"
+ method do {args} {eval $args}
+ }
+ itcl::class test_cd_bar {
+ protected variable x "bar-x"
+ method do {args} {eval $args}
+ }
+ itcl::class test_cd_foobar {
+ inherit test_cd_foo test_cd_bar
+ method do {args} {eval $args}
+ }
+ itcl::class test_cd_geek {
+ method do {args} {eval $args}
+ }
+ itcl::class test_cd_mongrel {
+ inherit test_cd_foobar test_cd_geek
+ protected variable x "mongrel-x"
+ method do {args} {eval $args}
+ }
+} {}
+
+test inherit-2.2 {"info" provides access to shadowed data members} {
+ test_cd_mongrel #auto
+ list [lsort [test_cd_mongrel0 info variable]] \
+ [test_cd_mongrel0 info variable test_cd_foo::x] \
+ [test_cd_mongrel0 info variable test_cd_bar::x] \
+ [test_cd_mongrel0 info variable test_cd_mongrel::x] \
+ [test_cd_mongrel0 info variable x]
+} {{::test_cd_bar::x ::test_cd_foo::x ::test_cd_mongrel::this ::test_cd_mongrel::x} {protected variable ::test_cd_foo::x foo-x foo-x} {protected variable ::test_cd_bar::x bar-x bar-x} {protected variable ::test_cd_mongrel::x mongrel-x mongrel-x} {protected variable ::test_cd_mongrel::x mongrel-x mongrel-x}}
+
+test inherit-2.3 {variable resolution works properly in methods} {
+ list [test_cd_mongrel0 test_cd_foo::do set x] \
+ [test_cd_mongrel0 test_cd_bar::do set x] \
+ [test_cd_mongrel0 test_cd_foobar::do set x] \
+ [test_cd_mongrel0 test_cd_mongrel::do set x]
+} {foo-x bar-x foo-x mongrel-x}
+
+test inherit-2.4 {methods have access to shadowed data members} {
+ list [test_cd_mongrel0 test_cd_foobar::do set x] \
+ [test_cd_mongrel0 test_cd_foobar::do set test_cd_foo::x] \
+ [test_cd_mongrel0 test_cd_foobar::do set test_cd_bar::x] \
+ [test_cd_mongrel0 test_cd_mongrel::do set test_cd_foo::x] \
+ [test_cd_mongrel0 test_cd_mongrel::do set test_cd_bar::x]
+} {foo-x foo-x bar-x foo-x bar-x}
+
+eval namespace delete [find classes test_cd_*]
+
+# ----------------------------------------------------------------------
+# Test public variables and "configure" method
+# ----------------------------------------------------------------------
+test inherit-3.1 {define classes with public variables} {
+ variable ::test_cd_watch ""
+ itcl::class test_cd_foo {
+ public variable x "foo-x" {
+ global test_cd_watch
+ lappend test_cd_watch "foo: $x in scope [namespace current]"
+ }
+ method do {args} {eval $args}
+ }
+ itcl::class test_cd_bar {
+ public variable x "bar-x" {
+ global test_cd_watch
+ lappend test_cd_watch "bar: $x in scope [namespace current]"
+ }
+ method do {args} {eval $args}
+ }
+ itcl::class test_cd_foobar {
+ inherit test_cd_foo test_cd_bar
+ method do {args} {eval $args}
+ }
+ itcl::class test_cd_geek {
+ method do {args} {eval $args}
+ }
+ itcl::class test_cd_mongrel {
+ inherit test_cd_foobar test_cd_geek
+ public variable x "mongrel-x" {
+ global test_cd_watch
+ lappend test_cd_watch "mongrel: $x in scope [namespace current]"
+ }
+ method do {args} {eval $args}
+ }
+} {}
+
+test inherit-3.2 {create an object with public variables} {
+ test_cd_mongrel #auto
+} {test_cd_mongrel0}
+
+test inherit-3.3 {"configure" lists all public variables} {
+ lsort [test_cd_mongrel0 configure]
+} {{-test_cd_bar::x bar-x bar-x} {-test_cd_foo::x foo-x foo-x} {-x mongrel-x mongrel-x}}
+
+test inherit-3.4 {"configure" treats simple names as "most specific"} {
+ lsort [test_cd_mongrel0 configure -x]
+} {-x mongrel-x mongrel-x}
+
+test inherit-3.5 {"configure" treats simple names as "most specific"} {
+ set ::test_cd_watch ""
+ list [test_cd_mongrel0 configure -x hello] \
+ [set ::test_cd_watch]
+} {{} {{mongrel: hello in scope ::test_cd_mongrel}}}
+
+test inherit-3.6 {"configure" allows access to shadowed options} {
+ set ::test_cd_watch ""
+ list [test_cd_mongrel0 configure -test_cd_foo::x hello] \
+ [test_cd_mongrel0 configure -test_cd_bar::x there] \
+ [set ::test_cd_watch]
+} {{} {} {{foo: hello in scope ::test_cd_foo} {bar: there in scope ::test_cd_bar}}}
+
+test inherit-3.7 {"configure" will change several variables at once} {
+ set ::test_cd_watch ""
+ list [test_cd_mongrel0 configure -x one \
+ -test_cd_foo::x two \
+ -test_cd_bar::x three] \
+ [set ::test_cd_watch]
+} {{} {{mongrel: one in scope ::test_cd_mongrel} {foo: two in scope ::test_cd_foo} {bar: three in scope ::test_cd_bar}}}
+
+test inherit-3.8 {"cget" does proper name resolution} {
+ list [test_cd_mongrel0 cget -x] \
+ [test_cd_mongrel0 cget -test_cd_foo::x] \
+ [test_cd_mongrel0 cget -test_cd_bar::x] \
+ [test_cd_mongrel0 cget -test_cd_mongrel::x]
+} {one two three one}
+
+eval namespace delete [find classes test_cd_*]
+
+# ----------------------------------------------------------------------
+# Test inheritance info
+# ----------------------------------------------------------------------
+test inherit-4.1 {define classes for inheritance info} {
+ itcl::class test_cd_foo {
+ method do {args} {eval $args}
+ }
+ itcl::class test_cd_bar {
+ method do {args} {eval $args}
+ }
+ itcl::class test_cd_foobar {
+ inherit test_cd_foo test_cd_bar
+ method do {args} {eval $args}
+ }
+ itcl::class test_cd_geek {
+ method do {args} {eval $args}
+ }
+ itcl::class test_cd_mongrel {
+ inherit test_cd_foobar test_cd_geek
+ method do {args} {eval $args}
+ }
+} {}
+
+test inherit-4.2 {create an object for inheritance tests} {
+ test_cd_mongrel #auto
+} {test_cd_mongrel0}
+
+test inherit-4.3 {"info class" should be virtual} {
+ list [test_cd_mongrel0 info class] \
+ [test_cd_mongrel0 test_cd_foo::do info class] \
+ [test_cd_mongrel0 test_cd_geek::do info class]
+} {::test_cd_mongrel ::test_cd_mongrel ::test_cd_mongrel}
+
+test inherit-4.4 {"info inherit" depends on class scope} {
+ list [test_cd_mongrel0 info inherit] \
+ [test_cd_mongrel0 test_cd_foo::do info inherit] \
+ [test_cd_mongrel0 test_cd_foobar::do info inherit]
+} {{::test_cd_foobar ::test_cd_geek} {} {::test_cd_foo ::test_cd_bar}}
+
+test inherit-4.5 {"info heritage" depends on class scope} {
+ list [test_cd_mongrel0 info heritage] \
+ [test_cd_mongrel0 test_cd_foo::do info heritage] \
+ [test_cd_mongrel0 test_cd_foobar::do info heritage]
+} {{::test_cd_mongrel ::test_cd_foobar ::test_cd_foo ::test_cd_bar ::test_cd_geek} ::test_cd_foo {::test_cd_foobar ::test_cd_foo ::test_cd_bar}}
+
+test inherit-4.6 {built-in "isa" method works} {
+ set status ""
+ foreach c [test_cd_mongrel0 info heritage] {
+ lappend status [test_cd_mongrel0 isa $c]
+ }
+ set status
+} {1 1 1 1 1}
+
+test inherit-4.7 {built-in "isa" method works within methods} {
+ set status ""
+ foreach c [test_cd_mongrel0 info heritage] {
+ lappend status [test_cd_mongrel0 test_cd_foo::do isa $c]
+ }
+ set status
+} {1 1 1 1 1}
+
+test inherit-4.8 {built-in "isa" method recognizes bad classes} {
+ class test_cd_other {}
+ test_cd_mongrel0 isa test_cd_other
+} {0}
+
+test inherit-4.9 {built-in "isa" method recognizes bad classes} {
+ list [catch {test_cd_mongrel0 isa test_cd_bogus} msg] $msg
+} {1 {class "test_cd_bogus" not found in context "::test_cd_foo"}}
+
+eval namespace delete [find classes test_cd_*]
+
+# ----------------------------------------------------------------------
+# Test "find objects"
+# ----------------------------------------------------------------------
+test inherit-5.1 {define classes for inheritance info} {
+ itcl::class test_cd_foo {
+ }
+ itcl::class test_cd_bar {
+ }
+ itcl::class test_cd_foobar {
+ inherit test_cd_foo test_cd_bar
+ }
+ itcl::class test_cd_geek {
+ }
+ itcl::class test_cd_mongrel {
+ inherit test_cd_foobar test_cd_geek
+ }
+} {}
+
+test inherit-5.2 {create objects for info tests} {
+ list [test_cd_foo #auto] [test_cd_foo #auto] \
+ [test_cd_foobar #auto] \
+ [test_cd_geek #auto] \
+ [test_cd_mongrel #auto]
+} {test_cd_foo0 test_cd_foo1 test_cd_foobar0 test_cd_geek0 test_cd_mongrel0}
+
+test inherit-5.3 {find objects: -class qualifier} {
+ lsort [find objects -class test_cd_foo]
+} {test_cd_foo0 test_cd_foo1}
+
+test inherit-5.4 {find objects: -class qualifier} {
+ lsort [find objects -class test_cd_mongrel]
+} {test_cd_mongrel0}
+
+test inherit-5.5 {find objects: -isa qualifier} {
+ lsort [find objects -isa test_cd_foo]
+} {test_cd_foo0 test_cd_foo1 test_cd_foobar0 test_cd_mongrel0}
+
+test inherit-5.6 {find objects: -isa qualifier} {
+ lsort [find objects -isa test_cd_mongrel]
+} {test_cd_mongrel0}
+
+test inherit-5.7 {find objects: name qualifier} {
+ lsort [find objects test_cd_foo*]
+} {test_cd_foo0 test_cd_foo1 test_cd_foobar0}
+
+test inherit-5.8 {find objects: -class and -isa qualifiers} {
+ lsort [find objects -isa test_cd_foo -class test_cd_foobar]
+} {test_cd_foobar0}
+
+test inherit-5.9 {find objects: -isa and name qualifiers} {
+ lsort [find objects -isa test_cd_foo *0]
+} {test_cd_foo0 test_cd_foobar0 test_cd_mongrel0}
+
+test inherit-5.10 {find objects: usage errors} {
+ list [catch {find objects -xyzzy} msg] $msg
+} {1 {wrong # args: should be "find objects ?-class className? ?-isa className? ?pattern?"}}
+
+eval namespace delete [find classes test_cd_*]
+
+# ----------------------------------------------------------------------
+# Test method scoping and execution
+# ----------------------------------------------------------------------
+test inherit-6.1 {define classes for scope tests} {
+ itcl::class test_cd_foo {
+ method check {} {return "foo"}
+ method do {args} {return "foo says: [eval $args]"}
+ }
+ itcl::class test_cd_bar {
+ method check {} {return "bar"}
+ method do {args} {return "bar says: [eval $args]"}
+ }
+ itcl::class test_cd_foobar {
+ inherit test_cd_foo test_cd_bar
+ method check {} {return "foobar"}
+ method do {args} {return "foobar says: [eval $args]"}
+ }
+ itcl::class test_cd_geek {
+ method check {} {return "geek"}
+ method do {args} {return "geek says: [eval $args]"}
+ }
+ itcl::class test_cd_mongrel {
+ inherit test_cd_foobar test_cd_geek
+ method check {} {return "mongrel"}
+ method do {args} {return "mongrel says: [eval $args]"}
+ }
+} {}
+
+test inherit-6.2 {create objects for scoping tests} {
+ list [test_cd_mongrel #auto] [test_cd_foobar #auto]
+} {test_cd_mongrel0 test_cd_foobar0}
+
+test inherit-6.3 {methods are "virtual" outside of the class} {
+ test_cd_mongrel0 check
+} {mongrel}
+
+test inherit-6.4 {specific methods can be accessed by name} {
+ test_cd_mongrel0 test_cd_foo::check
+} {foo}
+
+test inherit-6.5 {methods are "virtual" within a class too} {
+ test_cd_mongrel0 test_cd_foobar::do check
+} {foobar says: mongrel}
+
+test inherit-6.6 {methods are executed where they were defined} {
+ list [test_cd_mongrel0 test_cd_foo::do namespace current] \
+ [test_cd_mongrel0 test_cd_foobar::do namespace current] \
+ [test_cd_mongrel0 do namespace current] \
+} {{foo says: ::test_cd_foo} {foobar says: ::test_cd_foobar} {mongrel says: ::test_cd_mongrel}}
+
+test inherit-6.7 {"virtual" command no longer exists} {
+ list [catch {
+ test_cd_mongrel0 test_cd_foobar::do virtual namespace current
+ } msg] $msg
+} {1 {invalid command name "virtual"}}
+
+test inherit-6.8 {"previous" command no longer exists} {
+ list [catch {
+ test_cd_mongrel0 test_cd_foobar::do previous check
+ } msg] $msg
+} {1 {invalid command name "previous"}}
+
+test inherit-6.9 {errors are detected and reported across class boundaries} {
+ list [catch {
+ test_cd_mongrel0 do test_cd_foobar0 do error "test" "some error"
+ } msg] $msg [set ::errorInfo]
+} {1 test {some error
+ ("eval" body line 1)
+ invoked from within
+"eval $args"
+ (object "::test_cd_foobar0" method "::test_cd_foobar::do" body line 1)
+ invoked from within
+"test_cd_foobar0 do error test {some error}"
+ ("eval" body line 1)
+ invoked from within
+"eval $args"
+ (object "::test_cd_mongrel0" method "::test_cd_mongrel::do" body line 1)
+ invoked from within
+"test_cd_mongrel0 do test_cd_foobar0 do error "test" "some error""}}
+
+test inherit-6.10 {errors codes are preserved across class boundaries} {
+ list [catch {
+ test_cd_mongrel0 do test_cd_foobar0 do error "test" "problem" CODE-BLUE
+ } msg] $msg [set ::errorCode]
+} {1 test CODE-BLUE}
+
+test inherit-6.11 {multi-value error codes are preserved across class boundaries} {
+ list [catch {
+ test_cd_mongrel0 do test_cd_foobar0 do error "test" "problem" "CODE BLUE 123"
+ } msg] $msg [set ::errorCode]
+} {1 test {CODE BLUE 123}}
+
+eval namespace delete [find classes test_cd_*]
+
+# ----------------------------------------------------------------------
+# Test inheritance errors
+# ----------------------------------------------------------------------
+test inherit-7.1 {cannot inherit from non-existant class} {
+ list [catch {
+ itcl::class bogus {
+ inherit non_existant_class_xyzzy
+ }
+ } msg] $msg
+} {1 {cannot inherit from "non_existant_class_xyzzy" (class "non_existant_class_xyzzy" not found in context "::")}}
+
+test inherit-7.2 {cannot inherit from procs} {
+ proc inherit_test_proc {x y} {
+ error "never call this"
+ }
+ list [catch {
+ itcl::class bogus {
+ inherit inherit_test_proc
+ }
+ } msg] $msg
+} {1 {cannot inherit from "inherit_test_proc" (class "inherit_test_proc" not found in context "::")}}
+
+test inherit-7.3 {cannot inherit from yourself} {
+ list [catch {
+ itcl::class bogus {
+ inherit bogus
+ }
+ } msg] $msg
+} {1 {class "bogus" cannot inherit from itself}}
+
+test inherit-7.4 {cannot have more than one inherit statement} {
+ list [catch {
+ itcl::class test_inherit_base1 { }
+ itcl::class test_inherit_base2 { }
+ itcl::class bogus {
+ inherit test_inherit_base1
+ inherit test_inherit_base2
+ }
+ } msg] $msg
+} {1 {inheritance "test_inherit_base1 " already defined for class "::bogus"}}
+
+# ----------------------------------------------------------------------
+# Multiple base class error detection
+# ----------------------------------------------------------------------
+test inherit-8.1 {cannot inherit from the same base class more than once} {
+ class test_mi_base {}
+ class test_mi_foo {inherit test_mi_base}
+ class test_mi_bar {inherit test_mi_base}
+ list [catch {
+ class test_mi_foobar {inherit test_mi_foo test_mi_bar}
+ } msg] $msg
+} {1 {class "::test_mi_foobar" inherits base class "::test_mi_base" more than once:
+ test_mi_foobar->test_mi_foo->test_mi_base
+ test_mi_foobar->test_mi_bar->test_mi_base}}
+
+delete class test_mi_base
diff --git a/itcl/itcl/tests/interp.test b/itcl/itcl/tests/interp.test
new file mode 100644
index 00000000000..e25c680bbd1
--- /dev/null
+++ b/itcl/itcl/tests/interp.test
@@ -0,0 +1,68 @@
+#
+# Tests for using [incr Tcl] in slave interpreters
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Make sure that slave interpreters can be created and loaded
+# with [incr Tcl]...
+# ----------------------------------------------------------------------
+test interp-1.1 {create a slave interp with [incr Tcl]} {
+ interp create slave
+ load "" Itcl slave
+ list [slave eval "namespace children :: itcl"] [interp delete slave]
+} {::itcl {}}
+
+test interp-1.2 {create a safe slave interp with [incr Tcl]} {
+ interp create -safe slave
+ load "" Itcl slave
+ list [slave eval "namespace children :: itcl"] [interp delete slave]
+} {::itcl {}}
+
+test interp-1.3 {errors are okay when slave interp is deleted} {
+ interp create slave
+ load "" Itcl slave
+ slave eval {
+ itcl::class Troublemaker {
+ destructor { error "cannot delete this object" }
+ }
+ itcl::class Foo {
+ variable obj ""
+ constructor {} {
+ set obj [Troublemaker #auto]
+ }
+ destructor {
+ delete object $obj
+ }
+ }
+ Foo f
+ }
+ interp delete slave
+} {}
+
+test interp-1.4 {one namespace can cause another to be destroyed} {
+ interp create slave
+ load "" Itcl slave
+ slave eval {
+ namespace eval group {
+ itcl::class base1 {}
+ itcl::class base2 {}
+ }
+ itcl::class TroubleMaker {
+ inherit group::base1 group::base2
+ }
+ }
+ interp delete slave
+} {}
diff --git a/itcl/itcl/tests/local.test b/itcl/itcl/tests/local.test
new file mode 100644
index 00000000000..5f288a02835
--- /dev/null
+++ b/itcl/itcl/tests/local.test
@@ -0,0 +1,66 @@
+#
+# Tests for "local" command for creating objects local to a proc
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Test "local" to create objects that only exist within a proc
+# ----------------------------------------------------------------------
+test local-1.1 {define a class to use for testing} {
+ class test_local {
+ common status ""
+ constructor {} {
+ lappend status "created $this"
+ }
+ destructor {
+ lappend status "deleted $this"
+ }
+ proc clear {} {
+ set status ""
+ }
+ proc check {} {
+ return $status
+ }
+ proc test {} {
+ local test_local #auto
+ lappend status "processing"
+ }
+ proc test2 {} {
+ local test_local #auto
+ lappend status "call test..."
+ test
+ lappend status "...back"
+ }
+ }
+ test_local #auto
+} {test_local0}
+
+test local-1.2 {} {
+ test_local::clear
+ test_local::test
+ test_local::check
+} {{created ::test_local::test_local1} processing {deleted ::test_local::test_local1}}
+
+test local-1.3 {} {
+ test_local::clear
+ test_local::test2
+ test_local::check
+} {{created ::test_local::test_local2} {call test...} {created ::test_local::test_local3} processing {deleted ::test_local::test_local3} ...back {deleted ::test_local::test_local2}}
+
+test local-1.4 {} {
+ find objects -isa test_local
+} {test_local0}
+
+delete class test_local
diff --git a/itcl/itcl/tests/methods.test b/itcl/itcl/tests/methods.test
new file mode 100644
index 00000000000..edb1ea88f0e
--- /dev/null
+++ b/itcl/itcl/tests/methods.test
@@ -0,0 +1,128 @@
+#
+# Tests for argument lists and method execution
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Methods with various argument lists
+# ----------------------------------------------------------------------
+test methods-1.1 {define a class with lots of methods and arg lists} {
+ itcl::class test_args {
+ method none {} {
+ return "none"
+ }
+ method two {x y} {
+ return "two: $x $y"
+ }
+ method defvals {x {y def1} {z def2}} {
+ return "defvals: $x $y $z"
+ }
+ method varargs {x {y def1} args} {
+ return "varargs: $x $y ($args)"
+ }
+ method nomagic {args x} {
+ return "nomagic: $args $x"
+ }
+ method clash {x bang boom} {
+ return "clash: $x $bang $boom"
+ }
+ proc crash {x bang boom} {
+ return "crash: $x $bang $boom"
+ }
+ variable bang "ok"
+ common boom "no-problem"
+ }
+} ""
+
+test methods-1.2 {create an object to execute tests} {
+ test_args ta
+} {ta}
+
+test methods-1.3 {argument checking: not enough args} {
+ list [catch {ta two 1} msg] $msg
+} {1 {wrong # args: should be "ta two x y"}}
+
+test methods-1.4a {argument checking: too many args} {
+ list [catch {ta two 1 2 3} msg] $msg
+} {1 {wrong # args: should be "ta two x y"}}
+
+test methods-1.4b {argument checking: too many args} {
+ list [catch {ta none 1 2 3} msg] $msg
+} {1 {wrong # args: should be "ta none"}}
+
+test methods-1.5a {argument checking: just right} {
+ list [catch {ta two 1 2} msg] $msg
+} {0 {two: 1 2}}
+
+test methods-1.5b {argument checking: just right} {
+ list [catch {ta none} msg] $msg
+} {0 none}
+
+test methods-1.6a {default arguments: not enough args} {
+ list [catch {ta defvals} msg] $msg
+} {1 {wrong # args: should be "ta defvals x ?y? ?z?"}}
+
+test methods-1.6b {default arguments: missing arguments supplied} {
+ list [catch {ta defvals 1} msg] $msg
+} {0 {defvals: 1 def1 def2}}
+
+test methods-1.6c {default arguments: missing arguments supplied} {
+ list [catch {ta defvals 1 2} msg] $msg
+} {0 {defvals: 1 2 def2}}
+
+test methods-1.6d {default arguments: all arguments assigned} {
+ list [catch {ta defvals 1 2 3} msg] $msg
+} {0 {defvals: 1 2 3}}
+
+test methods-1.6e {default arguments: too many args} {
+ list [catch {ta defvals 1 2 3 4} msg] $msg
+} {1 {wrong # args: should be "ta defvals x ?y? ?z?"}}
+
+test methods-1.7a {variable arguments: not enough args} {
+ list [catch {ta varargs} msg] $msg
+} {1 {wrong # args: should be "ta varargs x ?y? ?arg arg ...?"}}
+
+test methods-1.7b {variable arguments: empty} {
+ list [catch {ta varargs 1 2} msg] $msg
+} {0 {varargs: 1 2 ()}}
+
+test methods-1.7c {variable arguments: one} {
+ list [catch {ta varargs 1 2 one} msg] $msg
+} {0 {varargs: 1 2 (one)}}
+
+test methods-1.7d {variable arguments: two} {
+ list [catch {ta varargs 1 2 one two} msg] $msg
+} {0 {varargs: 1 2 (one two)}}
+
+test methods-1.8 {magic "args" argument has no magic unless at end of list} {
+ list [catch {ta nomagic 1 2 3 4} msg] $msg
+} {1 {wrong # args: should be "ta nomagic args x"}}
+
+test methods-1.9 {formal args don't clobber class members} {
+ list [catch {ta clash 1 2 3} msg] $msg \
+ [ta info variable bang -value] \
+ [ta info variable boom -value]
+} {0 {clash: 1 2 3} ok no-problem}
+
+test methods-1.10 {formal args don't clobber class members} {
+ list [catch {test_args::crash 4 5 6} msg] $msg \
+ [ta info variable bang -value] \
+ [ta info variable boom -value]
+} {0 {crash: 4 5 6} ok no-problem}
+
+# ----------------------------------------------------------------------
+# Clean up
+# ----------------------------------------------------------------------
+delete class test_args
diff --git a/itcl/itcl/tests/mkindex.itcl b/itcl/itcl/tests/mkindex.itcl
new file mode 100644
index 00000000000..fb293b6a4ec
--- /dev/null
+++ b/itcl/itcl/tests/mkindex.itcl
@@ -0,0 +1,88 @@
+# Test file for:
+# auto_mkindex
+#
+# This file provides example cases for testing the Tcl autoloading
+# facility. Things are much more complicated with namespaces and classes.
+# The "auto_mkindex" facility can no longer be built on top of a simple
+# regular expression parser. It must recognize constructs like this:
+#
+# namespace eval foo {
+# class Internal { ... }
+# body Internal::func {x y} { ... }
+# namespace eval bar {
+# class Another { ... }
+# }
+# }
+#
+# Note that class definitions can be nested inside of namespaces.
+#
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+
+#
+# Should be able to handle simple class definitions, even if
+# they are prefaced with white space.
+#
+namespace import blt::*
+
+class Simple1 {
+ variable x 0
+ public method bump {} {incr x}
+}
+ itcl::class Simple2 {
+ variable x 0
+ public variable by 1
+ public method bump {}
+ }
+
+itcl_class OldStyle {
+ public x 0
+ method foo {args} {return $args}
+}
+
+itcl::ensemble ens {
+ part one {x} {}
+ part two {x y} {}
+ part three {x y z} {}
+}
+
+#
+# Should be able to handle "body" and "configbody" declarations.
+#
+body Simple2::bump {} {incr x $by}
+configbody Simple2::by {if {$by <= 0} {error "bad increment}}
+
+#
+# Should be able to handle class declarations within namespaces,
+# even if they have explicit namespace paths.
+#
+namespace eval buried {
+ class inside {
+ variable x 0
+ public variable by 1
+ public method bump {}
+ method skip {x y z} {}
+ proc find {args} {}
+ }
+ body inside::bump {} {incr x $by}
+ configbody inside::by {if {$by <= 0} {error "bad increment}}
+
+ class ::top {
+ method skip {x y z} {}
+ method ignore {} {}
+ public proc find {args} {}
+ protected proc notice {args} {}
+ }
+
+ ensemble ens {
+ part one {x} {}
+ part two {x y} {}
+ part three {x y z} {}
+ }
+
+ namespace eval under {
+ itcl::class neath { }
+ }
+ namespace eval deep {
+ ::itcl::class within { }
+ }
+}
diff --git a/itcl/itcl/tests/mkindex.test b/itcl/itcl/tests/mkindex.test
new file mode 100644
index 00000000000..47a98b41269
--- /dev/null
+++ b/itcl/itcl/tests/mkindex.test
@@ -0,0 +1,44 @@
+#
+# Tests for "auto_mkindex" and autoloading facility
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Test "auto_mkindex" in the presence of class definitions
+# ----------------------------------------------------------------------
+test mkindex-1.1 {remove any existing tclIndex file} {
+ file delete tclIndex
+ file exists tclIndex
+} {0}
+
+test mkindex-1.2 {build tclIndex based on a test file} {
+ auto_mkindex . mkindex.itcl
+ file exists tclIndex
+} {1}
+
+set element "{source [file join . mkindex.itcl]}"
+
+test mkindex-1.3 {examine tclIndex} {
+ namespace eval itcl_mkindex_tmp {
+ set dir "."
+ variable auto_index
+ source tclIndex
+ set result ""
+ foreach elem [lsort [array names auto_index]] {
+ lappend result [list $elem $auto_index($elem)]
+ }
+ set result
+ }
+} "{::Simple2::bump $element} {::Simple2::by $element} {::buried::deep::within $element} {::buried::ens $element} {::buried::inside $element} {::buried::inside::bump $element} {::buried::inside::by $element} {::buried::inside::find $element} {::buried::under::neath $element} {::top::find $element} {::top::notice $element} {OldStyle $element} {Simple1 $element} {Simple2 $element} {ens $element} {top $element}"
diff --git a/itcl/itcl/tests/namespace.test b/itcl/itcl/tests/namespace.test
new file mode 100644
index 00000000000..35a1e9cf975
--- /dev/null
+++ b/itcl/itcl/tests/namespace.test
@@ -0,0 +1,74 @@
+#
+# Tests for classes within namespaces
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Classes within namespaces
+# ----------------------------------------------------------------------
+test namespace-1.1 {same class name can be used in different namespaces} {
+ namespace eval test_ns_1 {
+ class Counter {
+ variable num 0
+ method ++ {{by 1}} {
+ incr num $by
+ }
+ method do {args} {
+ return [eval $args]
+ }
+ common tag 1
+ }
+ }
+ namespace eval test_ns_2 {
+ class Counter {
+ variable num 0
+ method ++ {{by 2}} {
+ if {$num == 0} {
+ set num 1
+ } else {
+ set num [expr $num*$by]
+ }
+ }
+ method do {args} {
+ return [eval $args]
+ }
+ common tag 2
+ }
+ }
+} ""
+
+test namespace-1.2 {classes in different namespaces are different} {
+ list [namespace eval test_ns_1::Counter {info variable tag}] \
+ [namespace eval test_ns_2::Counter {info variable tag}] \
+} {{protected common ::test_ns_1::Counter::tag 1 1} {protected common ::test_ns_2::Counter::tag 2 2}}
+
+test namespace-1.3 {create an object in one namespace} {
+ namespace eval test_ns_1 {
+ list [Counter c] [c ++] [c ++] [c ++] [c ++]
+ }
+} {c 1 2 3 4}
+
+test namespace-1.4 {create an object in another namespace} {
+ namespace eval test_ns_2 {
+ list [Counter c] [c ++] [c ++] [c ++] [c ++]
+ }
+} {c 1 2 4 8}
+
+test namespace-1.5 {can find classes wrapped in a namespace} {
+ list [catch {test_ns_1::c do find objects -isa Counter} msg] $msg \
+ [catch {test_ns_1::c do find objects -class Counter} msg] $msg
+} {0 {} 0 {}}
+
+namespace delete test_ns_1 test_ns_2
diff --git a/itcl/itcl/tests/old/AAA.test b/itcl/itcl/tests/old/AAA.test
new file mode 100644
index 00000000000..d3cda41d121
--- /dev/null
+++ b/itcl/itcl/tests/old/AAA.test
@@ -0,0 +1,82 @@
+#
+# AAA - first test executed in test suite
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# ----------------------------------------------------------------------
+# SHOULD HAVE A CLEAN SLATE
+# ----------------------------------------------------------------------
+test {No object info (no classes)} {
+ itcl_info classes
+} {
+ $result == ""
+}
+
+test {No object info (no objects)} {
+ itcl_info objects
+} {
+ $result == ""
+}
+
+# ----------------------------------------------------------------------
+# TEST CLASS AUTO-LOADING
+# ----------------------------------------------------------------------
+test {Force auto-loading through inheritance} {
+ FooBar x
+} {
+ $result == "x"
+}
+
+test {Info: all classes} {
+ itcl_info classes
+} {
+ [test_cmp_lists $result {Foo Bar FooBar}]
+}
+
+test {Info: all classes matching a pattern} {
+ itcl_info classes *oo*
+} {
+ [test_cmp_lists $result {Foo FooBar}]
+}
+
+# ----------------------------------------------------------------------
+# OBJECT AUTO-NUMBERING
+# ----------------------------------------------------------------------
+test {Create object with auto-naming} {
+ FooBar #auto -blit x
+} {
+ $result == "fooBar0" && [fooBar0 info public blit -value] == "x"
+}
+
+test {Create object with auto-naming} {
+ FooBar #auto -blit y
+} {
+ $result == "fooBar1" && [fooBar1 info public blit -value] == "y"
+}
+
+test {Auto-naming should avoid names already in use} {
+ FooBar fooBar2
+ FooBar fooBar3
+ FooBar fooBar4
+ FooBar #auto
+} {
+ $result == "fooBar5"
+}
+
+test {Destroy all outstanding objects} {
+ foreach obj [itcl_info objects] {
+ $obj delete
+ }
+} {
+ $result == ""
+}
diff --git a/itcl/itcl/tests/old/Bar.tcl b/itcl/itcl/tests/old/Bar.tcl
new file mode 100644
index 00000000000..4ab50f0c7a1
--- /dev/null
+++ b/itcl/itcl/tests/old/Bar.tcl
@@ -0,0 +1,39 @@
+#
+# Old test suite for [incr Tcl] v1.5
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+itcl_class Bar {
+ #
+ # Constructor/destructor add their name to a global var for
+ # tracking implicit constructors/destructors
+ #
+ constructor {config} {
+ global WATCH
+ lappend WATCH [namespace current]
+ }
+ destructor {
+ global WATCH
+ lappend WATCH [namespace current]
+ }
+
+ method config {config} {
+ return $config
+ }
+
+ #
+ # Define variables that will be shadowed by another class.
+ #
+ public blit
+ protected _blit
+}
diff --git a/itcl/itcl/tests/old/BarFoo.tcl b/itcl/itcl/tests/old/BarFoo.tcl
new file mode 100644
index 00000000000..1854eaf34a1
--- /dev/null
+++ b/itcl/itcl/tests/old/BarFoo.tcl
@@ -0,0 +1,31 @@
+#
+# Old test suite for [incr Tcl] v1.5
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+itcl_class BarFoo {
+ inherit Bar Foo
+
+ #
+ # Constructor/destructor add their name to a global var for
+ # tracking implicit constructors/destructors
+ #
+ constructor {config} {
+ global WATCH
+ lappend WATCH [namespace current]
+ }
+ destructor {
+ global WATCH
+ lappend WATCH [namespace current]
+ }
+}
diff --git a/itcl/itcl/tests/old/Baz.tcl b/itcl/itcl/tests/old/Baz.tcl
new file mode 100644
index 00000000000..725a1d0ed9e
--- /dev/null
+++ b/itcl/itcl/tests/old/Baz.tcl
@@ -0,0 +1,27 @@
+#
+# Old test suite for [incr Tcl] v1.5
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+itcl_class Baz {
+ #
+ # Avoid defining constructor/destructor
+ #
+
+ #
+ # Generic method for doing something in "Baz" interp
+ #
+ method do {cmds} {
+ return "Baz says '[eval $cmds]'"
+ }
+}
diff --git a/itcl/itcl/tests/old/Foo.tcl b/itcl/itcl/tests/old/Foo.tcl
new file mode 100644
index 00000000000..e73846edeed
--- /dev/null
+++ b/itcl/itcl/tests/old/Foo.tcl
@@ -0,0 +1,99 @@
+#
+# Old test suite for [incr Tcl] v1.5
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+itcl_class Foo {
+ #
+ # Constructor/destructor add their name to a global var for
+ # tracking implicit constructors/destructors
+ #
+ constructor {config} {
+ global WATCH
+ lappend WATCH [namespace current]
+ set foos([namespace tail $this]) $this
+ incr nfoo
+ }
+ destructor {
+ global WATCH
+ lappend WATCH [namespace current]
+ unset foos([namespace tail $this])
+ }
+
+ method nothing {} {}
+
+ method do {cmds} {
+ return "Foo says '[eval $cmds]'"
+ }
+
+ #
+ # Test formal arguments for methods/procs
+ # (formal args should not clobber data members)
+ #
+ method testMethodArgs {blit _blit args} {
+ return "$blit, $_blit, and [llength $args] other args"
+ }
+ proc testProcArgs {nfoo args} {
+ return "$nfoo, and [llength $args] other args"
+ }
+
+ #
+ # Test methods using the "config" argument
+ #
+ method config {{config "-blit auto -blat matic"}} {
+ return $config
+ }
+ method xconfig {x config} {
+ return "$x|$config"
+ }
+ method configx {config x} {
+ return "$config|$x"
+ }
+ method xecho {x args} {
+ return "$x | [llength $args]: $args"
+ }
+
+ #
+ # Test procs and access to common vars
+ #
+ proc echo {x args} {
+ return "$x | [llength $args]: $args"
+ }
+ proc foos {{pattern *}} {
+ set retn {}
+ foreach i [array names foos] {
+ if {$i != "_ignore_" && [string match $pattern $i]} {
+ lappend retn $i
+ }
+ }
+ return $retn
+ }
+ proc nfoos {} {
+ return $nfoo
+ }
+
+ #
+ # Test public/protected/common variable definitions
+ #
+ public blit
+ public blat 0
+ public blot 1 {global WATCH; set WATCH "blot=$blot"}
+
+ protected _blit
+ protected _blat 0
+
+ common foos
+ set foos(_ignore_) "foos-is-now-an-array"
+
+ common nfoo 0
+}
diff --git a/itcl/itcl/tests/old/FooBar.tcl b/itcl/itcl/tests/old/FooBar.tcl
new file mode 100644
index 00000000000..81227a84eda
--- /dev/null
+++ b/itcl/itcl/tests/old/FooBar.tcl
@@ -0,0 +1,31 @@
+#
+# Old test suite for [incr Tcl] v1.5
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+itcl_class FooBar {
+ inherit Foo Bar
+
+ #
+ # Constructor/destructor add their name to a global var for
+ # tracking implicit constructors/destructors
+ #
+ constructor {config} {
+ global WATCH
+ lappend WATCH [namespace current]
+ }
+ destructor {
+ global WATCH
+ lappend WATCH [namespace current]
+ }
+}
diff --git a/itcl/itcl/tests/old/Geek.tcl b/itcl/itcl/tests/old/Geek.tcl
new file mode 100644
index 00000000000..f431f40f10a
--- /dev/null
+++ b/itcl/itcl/tests/old/Geek.tcl
@@ -0,0 +1,44 @@
+#
+# Old test suite for [incr Tcl] v1.5
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+itcl_class Geek {
+
+ #
+ # Constructor/destructor add their name to a global var for
+ # tracking implicit constructors/destructors
+ #
+ constructor {config} {
+ global WATCH
+ lappend WATCH [namespace current]
+ }
+ destructor {
+ global WATCH
+ lappend WATCH [namespace current]
+ }
+
+ method do {cmds} {
+ return "Geek says '[eval $cmds]'"
+ }
+
+ method config {config} {
+ return $config
+ }
+
+ #
+ # Define variables that will be shadowed by another class.
+ #
+ public blat
+ protected _blat
+}
diff --git a/itcl/itcl/tests/old/Mongrel.tcl b/itcl/itcl/tests/old/Mongrel.tcl
new file mode 100644
index 00000000000..ef48e2968ef
--- /dev/null
+++ b/itcl/itcl/tests/old/Mongrel.tcl
@@ -0,0 +1,34 @@
+#
+# Old test suite for [incr Tcl] v1.5
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+itcl_class Mongrel {
+ inherit FooBar Geek
+
+ #
+ # Constructor/destructor add their name to a global var for
+ # tracking implicit constructors/destructors
+ #
+ constructor {config} {
+ global WATCH
+ lappend WATCH [namespace current]
+ }
+ destructor {
+ global WATCH
+ lappend WATCH [namespace current]
+ }
+
+ public blit nonnull
+ public tag
+}
diff --git a/itcl/itcl/tests/old/VirtualErr.tcl b/itcl/itcl/tests/old/VirtualErr.tcl
new file mode 100644
index 00000000000..ae09581ae96
--- /dev/null
+++ b/itcl/itcl/tests/old/VirtualErr.tcl
@@ -0,0 +1,23 @@
+#
+# Old test suite for [incr Tcl] v1.5
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+itcl_class VirtualErr {
+ #
+ # The following inherit statement will cause an error,
+ # since it will find the same base class "Foo" inherited
+ # from several places.
+ #
+ inherit Mongrel Foo BarFoo
+}
diff --git a/itcl/itcl/tests/old/all b/itcl/itcl/tests/old/all
new file mode 100644
index 00000000000..2c40a9c6402
--- /dev/null
+++ b/itcl/itcl/tests/old/all
@@ -0,0 +1,32 @@
+#
+# Old test suite for [incr Tcl] v1.5
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+variable WATCH
+
+global TEST_ABS_TOL TEST_REL_TOL
+set TEST_ABS_TOL 1.0e-6
+set TEST_REL_TOL 1.0e-5
+
+if {![file readable "testlib.tcl"]} {
+ error "ERROR: execute test suite in \"tests\" directory"
+}
+
+lappend auto_path .
+
+foreach i [lsort [glob ./*.test]] {
+ source $i
+}
+puts stdout "== ALL TESTS SUCCESSFUL =="
+exit
diff --git a/itcl/itcl/tests/old/basic.test b/itcl/itcl/tests/old/basic.test
new file mode 100644
index 00000000000..c5240073f58
--- /dev/null
+++ b/itcl/itcl/tests/old/basic.test
@@ -0,0 +1,408 @@
+#
+# Basic tests for class definition and method/proc access
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# ----------------------------------------------------------------------
+# CLEAN THE SLATE
+# ----------------------------------------------------------------------
+foreach obj [itcl_info objects -class Foo] {
+ $obj delete
+}
+
+# ----------------------------------------------------------------------
+# CREATING OBJECTS
+# ----------------------------------------------------------------------
+test {Create a simple object} {
+ Foo x
+} {
+ $result == "x"
+}
+
+test {Make sure that object names cannot be duplicated} {
+ catch "Foo x" errmsg
+} {
+ $result == 1
+}
+
+test {Create another object} {
+ Foo xx
+} {
+ $result == "xx"
+}
+
+test {Create an object with an automatic name} {
+ Foo #auto
+} {
+ [string match foo* $result]
+}
+
+test {Get list of objects in a class} {
+ itcl_info objects -class Foo
+} {
+ [llength $result] == 3
+}
+
+# ----------------------------------------------------------------------
+# PUBLIC VARIABLES
+# ----------------------------------------------------------------------
+test {Info: all public variables} {
+ x info public
+} {
+ [test_cmp_lists $result {Foo::blit Foo::blat Foo::blot}]
+}
+
+test {Info: public variable initial value} {
+ x info public blit -init
+} {
+ $result == ""
+}
+
+test {Info: public variable initial value (undefined)} {
+ x info public blit -value
+} {
+ $result == "<undefined>"
+}
+
+test {Info: public variable initial value} {
+ x info public blat -init
+} {
+ $result == 0
+}
+
+test {Info: public variable current value} {
+ x info public blot -value
+} {
+ $result == 1
+}
+
+test {Info: public variable config statement} {
+ x info public blit -config
+} {
+ $result == ""
+}
+
+test {Info: public variable config statement} {
+ x info public blot -config
+} {
+ $result == {global WATCH; set WATCH "blot=$blot"}
+}
+
+# ----------------------------------------------------------------------
+# CONFIG-ING PUBLIC VARIABLES
+# ----------------------------------------------------------------------
+test {Setting public variables via "config"} {
+ x config -blit 27 -blat xyz
+} {
+ $result == "Foo::blit Foo::blat"
+}
+
+test {Info: public variable init/current value} {
+ x info public blit -init -value
+} {
+ $result == {{} 27}
+}
+
+test {Info: public variable init/current value} {
+ x info public blat -init -value
+} {
+ $result == {0 xyz}
+}
+
+test {"config" is ordinary arg if it is not last arg} {
+ x configx -blit pdq
+} {
+ $result == {-blit|pdq}
+}
+
+test {Public variables with "config" code} {
+ set WATCH ""
+ concat [x config -blot abc] / $WATCH
+} {
+ $result == "Foo::blot / blot=abc"
+}
+
+test {Make sure object data is local to objects} {
+ x config -blit abc
+ xx config -blit xyz
+ concat [x info public blit -value] / [xx info public blit -value]
+} {
+ $result == "abc / xyz"
+}
+
+# ----------------------------------------------------------------------
+# PROTECTED VARIABLES
+# ----------------------------------------------------------------------
+test {Info: all protected variables} {
+ x info protected
+} {
+ [test_cmp_lists $result {Foo::_blit Foo::_blat Foo::this}]
+}
+
+test {Info: protected "this" variable} {
+ x info protected this -value
+} {
+ $result == "::x"
+}
+
+test {Info: protected "this" variable} {
+ xx info protected this -value
+} {
+ $result == "::xx"
+}
+
+test {Info: protected variable initial value} {
+ x info protected _blit -init
+} {
+ $result == ""
+}
+
+test {Info: protected variable access/value} {
+ x do {set _blit rst}
+} {
+ $result == "Foo says 'rst'" &&
+ [x info protected _blit -value] == "rst"
+}
+
+# ----------------------------------------------------------------------
+# COMMON VARIABLES
+# ----------------------------------------------------------------------
+test {Info: all protected variables} {
+ x info common
+} {
+ [test_cmp_lists $result {Foo::foos Foo::nfoo}]
+}
+
+test {Info: common variable initial value} {
+ x info common foos -init
+} {
+ $result == ""
+}
+
+test {Info: common variable initial value} {
+ x info common nfoo -init
+} {
+ $result == 0
+}
+
+test {Info: common variable access/value} {
+ x do {set nfoo 999}
+ x info common nfoo -value
+} {
+ $result == 999
+}
+
+test {Make sure common data is really common} {
+ x do {set nfoo 0}
+ x info common nfoo -value
+} {
+ $result == [xx info common nfoo -value]
+}
+
+test {Access common data in proc} {
+ x do {set nfoo 10}
+ Foo :: nfoos
+} {
+ $result == 10
+}
+
+test {Common variables can be initialized within class definition} {
+ x do {if {[info exists foos(_ignore_)]} {set foos(_ignore_)}}
+} {
+ $result == "Foo says 'foos-is-now-an-array'"
+}
+
+test {Arrays as common data} {
+ Foo :: foos
+} {
+ [test_cmp_lists $result [itcl_info objects -class Foo]]
+}
+
+# ----------------------------------------------------------------------
+# METHODS
+# ----------------------------------------------------------------------
+test {Info: all methods} {
+ x info method
+} {
+ [test_cmp_lists $result {
+ Foo::constructor Foo::destructor
+ Foo::nothing Foo::do Foo::xecho
+ Foo::config Foo::xconfig Foo::configx
+ Foo::testMethodArgs
+ Foo::configure Foo::delete Foo::cget Foo::isa
+ }]
+}
+
+test {Info: method args} {
+ x info method nothing -args
+} {
+ $result == ""
+}
+
+test {Info: method args} {
+ x info method xconfig -args
+} {
+ $result == "x config"
+}
+
+test {Info: method body} {
+ x info method nothing -body
+} {
+ $result == ""
+}
+
+test {Info: method body} {
+ x info method xconfig -body
+} {
+ $result == {
+ return "$x|$config"
+ }
+}
+
+# ----------------------------------------------------------------------
+# PROCS
+# ----------------------------------------------------------------------
+test {Info: all procs} {
+ x info proc
+} {
+ [test_cmp_lists $result {
+ Foo::echo Foo::foos Foo::nfoos Foo::testProcArgs
+ }]
+}
+
+test {Info: proc args} {
+ x info proc nfoos -args
+} {
+ $result == ""
+}
+
+test {Info: proc args} {
+ x info proc foos -args
+} {
+ $result == "{pattern *}"
+}
+
+test {Info: proc body} {
+ x info proc nfoos -body
+} {
+ $result == {
+ return $nfoo
+ }
+}
+
+test {Info: proc body} {
+ x info body nfoos
+} {
+ $result == {
+ return $nfoo
+ }
+}
+
+# ----------------------------------------------------------------------
+# ARGUMENT LISTS
+# ----------------------------------------------------------------------
+test {Default arguments can get assigned a proper value} {
+ Foo :: foos x*
+} {
+ [test_cmp_lists $result {x xx}]
+}
+
+test {Default value for "config" argument} {
+ x config
+} {
+ $result == "Foo::blit Foo::blat" &&
+ [x info public blit -value] == "auto" &&
+ [x info public blat -value] == "matic"
+}
+
+test {"args" formal argument absorbs extra arguments} {
+ Foo :: echo abc 1 2 3
+} {
+ $result == "abc | 3: 1 2 3"
+}
+
+test {"args" formal argument absorbs extra arguments} {
+ Foo :: echo def
+} {
+ $result == "def | 0: "
+}
+
+test {"args" formal argument absorbs extra arguments} {
+ x xecho abc 1 2 3
+} {
+ $result == "abc | 3: 1 2 3"
+}
+
+test {"args" formal argument absorbs extra arguments} {
+ x xecho def
+} {
+ $result == "def | 0: "
+}
+
+test {Extra args cause an error} {
+ catch "x configx arg arg error"
+} {
+ $result != 0
+}
+
+test {Extra args cause an error} {
+ catch "x nothing error"
+} {
+ $result != 0
+}
+
+test {Formal arguments don't clobber public/protected variables} {
+ x do {
+ set blit okay
+ set _blit no-problem
+ }
+ x testMethodArgs yuck puke etc.
+} {
+ $result == "yuck, puke, and 1 other args" &&
+ [x info public blit -value] == "okay" &&
+ [x info protected _blit -value] == "no-problem"
+}
+
+test {Formal arguments don't clobber common variables} {
+ Foo :: testProcArgs yuck etc.
+} {
+ $result == "yuck, and 1 other args" &&
+ [x info common nfoo -value] != "yuck"
+}
+
+# ----------------------------------------------------------------------
+# DELETING OBJECTS
+# ----------------------------------------------------------------------
+test {Delete an object} {
+ x delete
+} {
+ $result == ""
+}
+
+test {Delete an object} {
+ xx delete
+} {
+ $result == ""
+}
+
+test {Destructor is properly invoked} {
+ Foo :: foos
+} {
+ [test_cmp_lists $result [itcl_info objects -class Foo]]
+}
+
+test {Object names are removed as commands} {
+ expr {[info commands x] == "" && [info commands xx] == ""}
+} {
+ $result == 1
+}
diff --git a/itcl/itcl/tests/old/inherit.test b/itcl/itcl/tests/old/inherit.test
new file mode 100644
index 00000000000..2e3f0a2c134
--- /dev/null
+++ b/itcl/itcl/tests/old/inherit.test
@@ -0,0 +1,272 @@
+#
+# Tests for inheritance and scope handling
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# ----------------------------------------------------------------------
+# MULTIPLE BASE-CLASS ERROR DETECTION
+# ----------------------------------------------------------------------
+test {Cannot inherit from the same base class more than once} {
+ catch "VirtualErr" errmsg
+ set errmsg
+} {
+ [string match {*class "::VirtualErr" inherits base class "::Foo" more than once:
+ VirtualErr->Mongrel->FooBar->Foo
+ VirtualErr->Foo
+ VirtualErr->BarFoo->Foo} $result]
+}
+
+# ----------------------------------------------------------------------
+# CONSTRUCTION
+# ----------------------------------------------------------------------
+test {Constructors should be invoked implicitly} {
+ set WATCH ""
+ concat [Mongrel m] / $WATCH
+} {
+ $result == "m / ::Geek ::Bar ::Foo ::FooBar ::Mongrel"
+}
+
+test {Initialization of shadowed variables works properly} {
+ concat [m info public blit -value] / [m info public Foo::blit -value]
+} {
+ $result == "nonnull / <undefined>"
+}
+
+# ----------------------------------------------------------------------
+# PUBLIC VARIABLES
+# ----------------------------------------------------------------------
+test {Inherited "config" method works on derived classes} {
+ m config -blit xyz -Foo::blit pdq
+} {
+ $result == "Mongrel::blit Foo::blit"
+}
+
+test {Inherited "config" method works on derived classes} {
+ m config -blit xyz -Foo::blit pdq
+ concat [m info public blit -value] / [m info public Foo::blit -value]
+} {
+ $result == "xyz / pdq"
+}
+
+test {Inherited "config" method works on derived classes} {
+ m config -tag #0000
+} {
+ $result == "Mongrel::tag"
+}
+
+# ----------------------------------------------------------------------
+# INHERITANCE INFO
+# ----------------------------------------------------------------------
+test {Info: class} {
+ m info class
+} {
+ $result == "::Mongrel"
+}
+
+test {Info: inherit} {
+ m info inherit
+} {
+ $result == "::FooBar ::Geek"
+}
+
+test {Info: heritage} {
+ m info heritage
+} {
+ $result == "::Mongrel ::FooBar ::Foo ::Bar ::Geek"
+}
+
+test {Built-in "isa" method} {
+ set status 1
+ foreach c [m info heritage] {
+ set status [expr {$status && [m isa $c]}]
+ }
+ set status
+} {
+ $result == 1
+}
+
+test {Built-in "isa" method} {
+ itcl_class Watermelon {}
+ m isa Watermelon
+} {
+ $result == 0
+}
+
+# ----------------------------------------------------------------------
+# SCOPE MANIPULATION
+# ----------------------------------------------------------------------
+test {commands normally execute in the scope of their class} {
+ m Foo::do {namespace current}
+} {
+ $result == "Foo says '::Foo'"
+}
+
+test {"virtual" command moves scope to most specific class} {
+ m Foo::do {virtual namespace current}
+} {
+ $result == "Foo says '::Mongrel'"
+}
+
+test {"previous" command moves scope upward in hierarchy} {
+ m do {virtual previous namespace current}
+} {
+ $result == "Foo says '::FooBar'"
+}
+
+test {"previous" command can be chained} {
+ m do {virtual previous previous namespace current}
+} {
+ $result == "Foo says '::Foo'"
+}
+
+# ----------------------------------------------------------------------
+# METHOD INVOCATION
+# ----------------------------------------------------------------------
+test {Simple method names are assigned based on heritage} {
+ m do {concat "$this ([virtual info class]) at scope [namespace current]"}
+} {
+ $result == "Foo says '::m (Mongrel) at scope ::Foo'"
+}
+
+test {Explicit scoping can be used to reach shadowed members} {
+ m Geek::do {concat "$this ([virtual info class]) at scope [namespace current]"}
+} {
+ $result == "Geek says '::m (Mongrel) at scope ::Geek'"
+}
+
+test {Methods execute in local scope of class, e.g., Foo::do} {
+ m config -blit abc -Foo::blit def
+ m Foo::do {set blit xyz}
+ concat [m info public blit -value] / [m info public Foo::blit -value]
+} {
+ $result == "abc / xyz"
+}
+
+# ----------------------------------------------------------------------
+# DESTRUCTION
+# ----------------------------------------------------------------------
+test {Destructors should be invoked implicitly} {
+ set WATCH ""
+ concat [m delete] / $WATCH
+} {
+ $result == "/ ::Mongrel ::FooBar ::Foo ::Bar ::Geek"
+}
+
+# ----------------------------------------------------------------------
+# OBJECT INFO
+# ----------------------------------------------------------------------
+foreach obj [itcl_info objects] {
+ $obj delete
+}
+Mongrel m
+FooBar fb
+Foo f
+Geek g
+
+test {Object queries can be restricted by object name} {
+ itcl_info objects f*
+} {
+ [test_cmp_lists $result {f fb}]
+}
+
+test {Object queries can be restricted to specific classes} {
+ itcl_info objects -class Foo
+} {
+ $result == "f"
+}
+
+test {Object queries can be restricted by object heritage} {
+ itcl_info objects -isa Foo
+} {
+ [test_cmp_lists $result {m f fb}]
+}
+
+test {Object queries can be restricted by object name / specific classes} {
+ itcl_info objects f* -class Foo
+} {
+ $result == "f"
+}
+
+test {Object queries can be restricted by object name / object heritage} {
+ itcl_info objects f* -isa Foo
+} {
+ [test_cmp_lists $result {f fb}]
+}
+
+# ----------------------------------------------------------------------
+# ERROR HANDLING ACROSS CLASS BOUNDARIES
+# ----------------------------------------------------------------------
+Mongrel m1
+FooBar fb2
+
+test {Errors and detected and reported across class boundaries} {
+ set status [catch {m1 do {fb2 do {error "test"}}} mesg]
+ format "$mesg $status"
+} {
+ $result == "test 1"
+}
+
+test {Stack trace unwinds properly across class boundaries} {
+ catch {m1 do {fb2 do {error "test"}}} mesg
+ format "$errorInfo"
+} {
+ $result == {test
+ while executing
+"error "test""
+ ("eval" body line 1)
+ invoked from within
+"eval $cmds"
+ invoked from within
+"return "Foo says '[eval $cmds]..."
+ (object "::fb2" method "::Foo::do" body line 2)
+ invoked from within
+"fb2 do {error "test"}"
+ ("eval" body line 1)
+ invoked from within
+"eval $cmds"
+ invoked from within
+"return "Foo says '[eval $cmds]..."
+ (object "::m1" method "::Foo::do" body line 2)
+ invoked from within
+"m1 do {fb2 do {error "test"}}"}
+}
+
+test {Stack trace unwinds properly across class boundaries} {
+ catch {m1 do {fb2 do {error "test" "some error"}}} mesg
+ format "$errorInfo"
+} {
+ $result == {some error
+ ("eval" body line 1)
+ invoked from within
+"eval $cmds"
+ invoked from within
+"return "Foo says '[eval $cmds]..."
+ (object "::fb2" method "::Foo::do" body line 2)
+ invoked from within
+"fb2 do {error "test" "some error"}"
+ ("eval" body line 1)
+ invoked from within
+"eval $cmds"
+ invoked from within
+"return "Foo says '[eval $cmds]..."
+ (object "::m1" method "::Foo::do" body line 2)
+ invoked from within
+"m1 do {fb2 do {error "test" "some error"}}"}
+}
+
+test {Error codes are preserved across class boundaries} {
+ catch {m1 do {fb2 do {error "test" "some error" CODE-BLUE}}} mesg
+ format "$errorCode"
+} {
+ $result == "CODE-BLUE"
+}
diff --git a/itcl/itcl/tests/old/tclIndex b/itcl/itcl/tests/old/tclIndex
new file mode 100644
index 00000000000..85918fe24c6
--- /dev/null
+++ b/itcl/itcl/tests/old/tclIndex
@@ -0,0 +1,24 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(Bar) "source $dir/Bar.tcl"
+set auto_index(Foo) "source $dir/Foo.tcl"
+set auto_index(BarFoo) "source $dir/BarFoo.tcl"
+set auto_index(FooBar) "source $dir/FooBar.tcl"
+set auto_index(Geek) "source $dir/Geek.tcl"
+set auto_index(Mongrel) "source $dir/Mongrel.tcl"
+set auto_index(VirtualErr) "source $dir/VirtualErr.tcl"
+set auto_index(test) "source $dir/testlib.tcl"
+set auto_index(test_cmp_nums) "source $dir/testlib.tcl"
+set auto_index(test_cmp_vectors) "source $dir/testlib.tcl"
+set auto_index(test_cmp_lists) "source $dir/testlib.tcl"
+set auto_index(upvarTest_show_var) "source $dir/upvar.test"
+set auto_index(upvarTest_upvar_in_procs) "source $dir/upvar.test"
+set auto_index(uplevelTest_show_var) "source $dir/uplevel.test"
+set auto_index(uplevelTest_do) "source $dir/uplevel.test"
+set auto_index(Baz) "source $dir/Baz.tcl"
diff --git a/itcl/itcl/tests/old/testlib.tcl b/itcl/itcl/tests/old/testlib.tcl
new file mode 100644
index 00000000000..9ba4b31dd0d
--- /dev/null
+++ b/itcl/itcl/tests/old/testlib.tcl
@@ -0,0 +1,131 @@
+#
+# Old test suite for [incr Tcl] v1.5
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# ----------------------------------------------------------------------
+# USAGE: test <test-desc> <test-cmd> <check>
+#
+# Executes the given test, the evaluates the <check> condition to
+# see if the test passed. The result from the <test-cmd> is kept
+# in the variable $result. If this condition evaluates non-zero,
+# the test has passed. Otherwise, the test has failed. A variety
+# if checking routines (test_cmp_*) are provided below to make
+# the check condition easier to write.
+# ----------------------------------------------------------------------
+proc test {desc cmd check} {
+ set result [uplevel $cmd]
+
+ if {![expr $check]} {
+ puts stdout "-------------------------------------------------------"
+ puts stdout ">>>> FAILED TEST <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<"
+ puts stdout "-------------------------------------------------------"
+ set lines [split $desc "\n"]
+ foreach i $lines {
+ puts stdout $i
+ }
+ puts stdout "======================================================="
+ set lines [split $cmd "\n"]
+ set label TEST
+ foreach i $lines {
+ puts stdout " $label | $i"
+ set label " "
+ }
+ puts stdout "-------------------------------------------------------"
+ set lines [split $check "\n"]
+ set label CHECK
+ foreach i $lines {
+ if {$i != ""} {
+ puts stdout " $label | $i"
+ set label " "
+ }
+ }
+ puts stdout "-------------------------------------------------------"
+ set lines [split $result "\n"]
+ set label RESULT
+ foreach i $lines {
+ if {$i != ""} {
+ puts stdout " $label | \$result => $i"
+ set label " "
+ }
+ }
+ puts stdout "======================================================="
+ error "tests aborted"
+ }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: test_cmp_nums <num1> <num2>
+#
+# Compares two numbers to see if they are "equal." Numbers are
+# "equal" if they have an absolute value greater than 1.0e-6 and they
+# have at least 5 significant figures. Returns 1/0 for true/false.
+# ----------------------------------------------------------------------
+proc test_cmp_nums {num1 num2} {
+ global TEST_ABS_TOL TEST_REL_TOL
+
+ if {[expr abs($num1)] > $TEST_ABS_TOL &&
+ [expr abs($num2)] > $TEST_ABS_TOL} {
+ set avg [expr 0.5*($num1+$num2)]
+ set diff [expr abs(($num1-$num2)/$avg)]
+
+ if {$diff > $TEST_REL_TOL} {
+ return 0
+ }
+ }
+ return 1
+}
+
+# ----------------------------------------------------------------------
+# USAGE: test_cmp_vectors <list1> <list2>
+#
+# Compares two lists of numbers to see if they are "equal." Vectors
+# are "equal" if elements are "equal" in the numeric sense.
+# Returns 1/0 for true/false.
+# ----------------------------------------------------------------------
+proc test_cmp_vectors {list1 list2} {
+ if {[llength $list1] != [llength $list2]} {
+ return 0
+ }
+ for {set i 0} {$i < [llength $list1]} {incr i} {
+ set n1 [lindex $list1 $i]
+ set n2 [lindex $list2 $i]
+
+ if {![test_cmp_nums $n1 $n2]} {
+ return 0
+ }
+ }
+ return 1
+}
+
+# ----------------------------------------------------------------------
+# USAGE: test_cmp_lists <list1> <list2>
+#
+# Compares two lists to see if they are "equal." Lists are "equal"
+# if they contain exactly the same elements, but perhaps in a
+# different order. Returns 1/0 for true/false.
+# ----------------------------------------------------------------------
+proc test_cmp_lists {list1 list2} {
+ if {[llength $list1] != [llength $list2]} {
+ return 0
+ }
+ foreach elem $list1 {
+ set i [lsearch $list2 $elem]
+ if {$i >= 0} {
+ set list2 [lreplace $list2 $i $i]
+ } else {
+ return 0
+ }
+ }
+ return 1
+}
diff --git a/itcl/itcl/tests/old/toaster.test b/itcl/itcl/tests/old/toaster.test
new file mode 100644
index 00000000000..593676a648c
--- /dev/null
+++ b/itcl/itcl/tests/old/toaster.test
@@ -0,0 +1,165 @@
+#
+# Tests for "toaster" example
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# ----------------------------------------------------------------------
+# Get toaster classes from "demos" directory.
+# ----------------------------------------------------------------------
+lappend auto_path toasters
+
+# ----------------------------------------------------------------------
+# Outlets send bills to an e-mail address. Determine this address.
+# ----------------------------------------------------------------------
+if {[info exists env(USER)]} {
+ set Owner $env(USER)
+} elseif {[info exists env(LOGNAME)]} {
+ set Owner $env(LOGNAME)
+} else {
+ set Owner [exec logname]
+}
+
+# ----------------------------------------------------------------------
+# TOASTERS
+# ----------------------------------------------------------------------
+test {Create a toaster and plug it in} {
+ global Owner
+ Toaster original -heat 1 -outlet [Outlet #auto -owner $Owner]
+} {
+ $result == "original"
+}
+
+test {Turn up the heat setting on the toaster} {
+ original config -heat 5
+} {
+ $result == ""
+}
+
+test {Toast a few slices of bread} {
+ original toast 2
+} {
+ $result == "crumb tray: 25% full"
+}
+
+test {Clean the toaster} {
+ original clean
+} {
+ $result == "crumb tray: 0% full"
+}
+
+test {Toast a few slices of bread a few different times} {
+ original clean
+ original toast 2
+ original toast 1
+} {
+ $result == "crumb tray: 38% full"
+}
+
+test {Toast too many slices of bread and cause a fire} {
+ puts stdout ">>> should say \"== FIRE! FIRE! ==\""
+ original clean
+ original toast 2
+ original toast 2
+ original toast 2
+ original toast 2
+} {
+ $result == "crumb tray: 100% full"
+}
+
+test {Destroy the toaster} {
+ original clean
+ original toast 2
+ original toast 1
+ puts stdout ">>> should say \"15 crumbs ... what a mess!\""
+ original delete
+} {
+ $result == ""
+}
+
+# ----------------------------------------------------------------------
+# SMART TOASTERS
+# ----------------------------------------------------------------------
+test {Create a toaster and plug it in} {
+ global Owner
+ SmartToaster deluxe -heat 4 -outlet [Outlet #auto -owner $Owner]
+} {
+ $result == "deluxe"
+}
+
+test {Toast a few slices of bread} {
+ deluxe toast 2
+} {
+ $result == "crumb tray: 20% full"
+}
+
+test {Toast a few slices of bread and look for auto-clean} {
+ deluxe clean
+ deluxe toast 2
+ deluxe toast 2
+ deluxe toast 2
+ deluxe toast 2
+ deluxe toast 2
+} {
+ $result == "crumb tray: 20% full"
+}
+
+# ----------------------------------------------------------------------
+# PRODUCT STATISTICS
+# ----------------------------------------------------------------------
+test {Check statistics gathered by Hazard base class} {
+ set tmp [Toaster #auto]
+ set stats [Hazard :: report ::Toaster]
+ $tmp delete
+ set stats
+} {
+ $result == "::Toaster: 2 produced, 1 active, 1 accidents"
+}
+
+test {Check statistics gathered by Hazard base class} {
+ Hazard :: report ::SmartToaster
+} {
+ $result == "::SmartToaster: 1 produced, 1 active, 0 accidents"
+}
+
+test {Destroy all Toasters} {
+ foreach toaster [itcl_info objects -isa Toaster] {
+ $toaster clean
+ $toaster delete
+ }
+} {
+ $result == ""
+}
+
+test {SmartToasters should have been destroyed along with Toasters} {
+ itcl_info objects -class SmartToaster
+} {
+ $result == ""
+}
+
+# ----------------------------------------------------------------------
+# OUTLETS
+# ----------------------------------------------------------------------
+test {Bill all customers for outlet charges} {
+ Outlet :: bill
+ puts stdout ">>> should send two bills for outlets via e-mail"
+} {
+ $result == ""
+}
+
+test {Destroy all outlets} {
+ foreach outlet [itcl_info objects -class Outlet] {
+ $outlet delete
+ }
+} {
+ $result == ""
+}
diff --git a/itcl/itcl/tests/old/toasters/Appliance.tcl b/itcl/itcl/tests/old/toasters/Appliance.tcl
new file mode 100644
index 00000000000..8cc2de1e8d7
--- /dev/null
+++ b/itcl/itcl/tests/old/toasters/Appliance.tcl
@@ -0,0 +1,43 @@
+# ----------------------------------------------------------------------
+# PURPOSE: Base class for all electrical appliances that interact
+# with Outlets.
+#
+# AUTHOR: Michael J. McLennan Phone: (610)712-2842
+# AT&T Bell Laboratories E-mail: michael.mclennan@att.com
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993 AT&T Bell Laboratories
+# ======================================================================
+# Permission to use, copy, modify, and distribute this software and its
+# documentation for any purpose and without fee is hereby granted,
+# provided that the above copyright notice appear in all copies and that
+# both that the copyright notice and warranty disclaimer appear in
+# supporting documentation, and that the names of AT&T Bell Laboratories
+# any of their entities not be used in advertising or publicity
+# pertaining to distribution of the software without specific, written
+# prior permission.
+#
+# AT&T disclaims all warranties with regard to this software, including
+# all implied warranties of merchantability and fitness. In no event
+# shall AT&T be liable for any special, indirect or consequential
+# damages or any damages whatsoever resulting from loss of use, data or
+# profits, whether in an action of contract, negligence or other
+# tortuous action, arising out of or in connection with the use or
+# performance of this software.
+# ======================================================================
+
+itcl_class Appliance {
+
+ method power {power} {
+ if {[itcl_info objects [info which $outlet]] == ""} {
+ set outlet {}
+ }
+ if {$outlet == ""} {
+ error "cannot use $this: not plugged in"
+ }
+ $outlet use $power
+ }
+
+ public outlet {}
+}
diff --git a/itcl/itcl/tests/old/toasters/Hazard.tcl b/itcl/itcl/tests/old/toasters/Hazard.tcl
new file mode 100644
index 00000000000..7b50552ba3e
--- /dev/null
+++ b/itcl/itcl/tests/old/toasters/Hazard.tcl
@@ -0,0 +1,78 @@
+# ----------------------------------------------------------------------
+# PURPOSE: Tracking for hazardous products manufactured by the
+# "toaster" company.
+#
+# AUTHOR: Michael J. McLennan Phone: (610)712-2842
+# AT&T Bell Laboratories E-mail: michael.mclennan@att.com
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993 AT&T Bell Laboratories
+# ======================================================================
+# Permission to use, copy, modify, and distribute this software and its
+# documentation for any purpose and without fee is hereby granted,
+# provided that the above copyright notice appear in all copies and that
+# both that the copyright notice and warranty disclaimer appear in
+# supporting documentation, and that the names of AT&T Bell Laboratories
+# any of their entities not be used in advertising or publicity
+# pertaining to distribution of the software without specific, written
+# prior permission.
+#
+# AT&T disclaims all warranties with regard to this software, including
+# all implied warranties of merchantability and fitness. In no event
+# shall AT&T be liable for any special, indirect or consequential
+# damages or any damages whatsoever resulting from loss of use, data or
+# profits, whether in an action of contract, negligence or other
+# tortuous action, arising out of or in connection with the use or
+# performance of this software.
+# ======================================================================
+
+itcl_class HazardRec {
+ constructor {cname} {
+ set class $cname
+ }
+ method change {var inc} {
+ if {![info exists $var]} {
+ error "bad field \"$var\""
+ }
+ incr $var $inc
+ }
+ method report {} {
+ return "$class: $total produced, $actives active, $accidents accidents"
+ }
+ protected class {}
+ protected total 0
+ protected actives 0
+ protected accidents 0
+}
+
+itcl_class Hazard {
+
+ constructor {} {
+ set class [virtual info class]
+ if {![info exists recs($class)]} {
+ set recs($class) [HazardRec #auto $class]
+ }
+ $recs($class) change total +1
+ $recs($class) change actives +1
+ }
+ destructor {
+ set class [virtual info class]
+ $recs($class) change actives -1
+ }
+
+ method accident {mesg} {
+ set class [virtual info class]
+ $recs($class) change accidents +1
+ puts stderr $mesg
+ }
+
+ proc report {class} {
+ if {[info exists recs($class)]} {
+ return [$recs($class) report]
+ } else {
+ error "no information for class \"$class\""
+ }
+ }
+ common recs
+}
diff --git a/itcl/itcl/tests/old/toasters/Outlet.tcl b/itcl/itcl/tests/old/toasters/Outlet.tcl
new file mode 100644
index 00000000000..27c69f552a5
--- /dev/null
+++ b/itcl/itcl/tests/old/toasters/Outlet.tcl
@@ -0,0 +1,81 @@
+# ----------------------------------------------------------------------
+# PURPOSE: Electrical outlet supplying power for Appliances.
+#
+# AUTHOR: Michael J. McLennan Phone: (610)712-2842
+# AT&T Bell Laboratories E-mail: michael.mclennan@att.com
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993 AT&T Bell Laboratories
+# ======================================================================
+# Permission to use, copy, modify, and distribute this software and its
+# documentation for any purpose and without fee is hereby granted,
+# provided that the above copyright notice appear in all copies and that
+# both that the copyright notice and warranty disclaimer appear in
+# supporting documentation, and that the names of AT&T Bell Laboratories
+# any of their entities not be used in advertising or publicity
+# pertaining to distribution of the software without specific, written
+# prior permission.
+#
+# AT&T disclaims all warranties with regard to this software, including
+# all implied warranties of merchantability and fitness. In no event
+# shall AT&T be liable for any special, indirect or consequential
+# damages or any damages whatsoever resulting from loss of use, data or
+# profits, whether in an action of contract, negligence or other
+# tortuous action, arising out of or in connection with the use or
+# performance of this software.
+# ======================================================================
+
+itcl_class Outlet {
+ constructor {config} {}
+ method config {config} {}
+
+ destructor {
+ if {$usage > 0} bill
+ }
+
+ method use {power} {
+ set usage [expr $usage+$power]
+ }
+
+ method sendBill {} {
+ if {[catch "open /tmp/bill w" fout] != 0} {
+ error "cannot create bill in /tmp"
+ } else {
+ set amount [format "$%.2f" [expr $usage*$rate]]
+ puts $fout "----------------------------------------"
+ puts $fout "/////////// MEGA-POWER, INC. ///////////"
+ puts $fout "----------------------------------------"
+ puts $fout " Customer: $owner"
+ puts $fout " Outlet: $this"
+ puts $fout " Usage: $usage kilowatt-hours"
+ puts $fout " "
+ puts $fout " Amount Due: $amount"
+ puts $fout "----------------------------------------"
+ close $fout
+ exec mail $owner < /tmp/bill
+ set usage 0
+ }
+ }
+
+ proc bill {{customer *}} {
+ foreach outlet [itcl_info objects -class Outlet] {
+ set owner [$outlet info public owner -value]
+ if {[string match $customer $owner]} {
+ $outlet sendBill
+ }
+ }
+ }
+
+ proc rate {{newval ""}} {
+ if {$newval == ""} {
+ return $rate
+ }
+ set rate $newval
+ }
+
+ public owner {}
+ protected usage 0
+
+ common rate 0.05
+}
diff --git a/itcl/itcl/tests/old/toasters/SmartToaster.tcl b/itcl/itcl/tests/old/toasters/SmartToaster.tcl
new file mode 100644
index 00000000000..7a97225319d
--- /dev/null
+++ b/itcl/itcl/tests/old/toasters/SmartToaster.tcl
@@ -0,0 +1,40 @@
+# ----------------------------------------------------------------------
+# PURPOSE: Class definition for handling "smart" toasters via
+# [incr Tcl]. A "smart" toaster is a toaster that
+# automatically cleans itself when the crumb tray is full.
+#
+# AUTHOR: Michael J. McLennan Phone: (610)712-2842
+# AT&T Bell Laboratories E-mail: michael.mclennan@att.com
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993 AT&T Bell Laboratories
+# ======================================================================
+# Permission to use, copy, modify, and distribute this software and its
+# documentation for any purpose and without fee is hereby granted,
+# provided that the above copyright notice appear in all copies and that
+# both that the copyright notice and warranty disclaimer appear in
+# supporting documentation, and that the names of AT&T Bell Laboratories
+# any of their entities not be used in advertising or publicity
+# pertaining to distribution of the software without specific, written
+# prior permission.
+#
+# AT&T disclaims all warranties with regard to this software, including
+# all implied warranties of merchantability and fitness. In no event
+# shall AT&T be liable for any special, indirect or consequential
+# damages or any damages whatsoever resulting from loss of use, data or
+# profits, whether in an action of contract, negligence or other
+# tortuous action, arising out of or in connection with the use or
+# performance of this software.
+# ======================================================================
+
+itcl_class SmartToaster {
+ inherit Toaster
+
+ method toast {nslices} {
+ if {$crumbs >= [expr $maxcrumbs-10]} {
+ clean
+ }
+ return [Toaster::toast $nslices]
+ }
+}
diff --git a/itcl/itcl/tests/old/toasters/Toaster.tcl b/itcl/itcl/tests/old/toasters/Toaster.tcl
new file mode 100644
index 00000000000..f844c88d6c8
--- /dev/null
+++ b/itcl/itcl/tests/old/toasters/Toaster.tcl
@@ -0,0 +1,75 @@
+# ----------------------------------------------------------------------
+# PURPOSE: Class definition for handling toasters via [incr Tcl].
+#
+# AUTHOR: Michael J. McLennan Phone: (610)712-2842
+# AT&T Bell Laboratories E-mail: michael.mclennan@att.com
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993 AT&T Bell Laboratories
+# ======================================================================
+# Permission to use, copy, modify, and distribute this software and its
+# documentation for any purpose and without fee is hereby granted,
+# provided that the above copyright notice appear in all copies and that
+# both that the copyright notice and warranty disclaimer appear in
+# supporting documentation, and that the names of AT&T Bell Laboratories
+# any of their entities not be used in advertising or publicity
+# pertaining to distribution of the software without specific, written
+# prior permission.
+#
+# AT&T disclaims all warranties with regard to this software, including
+# all implied warranties of merchantability and fitness. In no event
+# shall AT&T be liable for any special, indirect or consequential
+# damages or any damages whatsoever resulting from loss of use, data or
+# profits, whether in an action of contract, negligence or other
+# tortuous action, arising out of or in connection with the use or
+# performance of this software.
+# ======================================================================
+
+itcl_class Toaster {
+ inherit Appliance Hazard
+
+ constructor {config} {}
+ destructor {
+ if {$crumbs > 0} {
+ puts stdout "$crumbs crumbs ... what a mess!"
+ }
+ }
+ method config {config} {}
+
+ method toast {nslices} {
+ power [expr 0.03*$heat]
+ if {$nslices < 1 || $nslices > 2} {
+ error "bad number of slices: should be 1 or 2"
+ }
+ set crumbs [expr $crumbs+$heat*$nslices]
+ if {$crumbs >= $maxcrumbs} {
+ accident "== FIRE! FIRE! =="
+ set crumbs $maxcrumbs
+ }
+ return [check]
+ }
+
+ method clean {} {
+ power 0.5
+ set crumbs 0
+ return [check]
+ }
+
+ method check {} {
+ set level [expr $crumbs*100.0/$maxcrumbs]
+ return [format "crumb tray: %.0f%% full" $level]
+ }
+
+ proc resize {newsize} {
+ set maxcrumbs $newsize
+ }
+
+ public heat 3 {
+ if {$heat < 1 || $heat > 5} {
+ error "invalid setting $heat: should be 1-5"
+ }
+ }
+ protected crumbs 0
+ common maxcrumbs 40
+}
diff --git a/itcl/itcl/tests/old/toasters/tclIndex b/itcl/itcl/tests/old/toasters/tclIndex
new file mode 100644
index 00000000000..01017bc7dae
--- /dev/null
+++ b/itcl/itcl/tests/old/toasters/tclIndex
@@ -0,0 +1,18 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(Appliance) "source $dir/Appliance.tcl"
+set auto_index(HazardRec) "source $dir/Hazard.tcl"
+set auto_index(Hazard) "source $dir/Hazard.tcl"
+set auto_index(Outlet) "source $dir/Outlet.tcl"
+set auto_index(SmartToaster) "source $dir/SmartToaster.tcl"
+set auto_index(Toaster) "source $dir/Toaster.tcl"
+set auto_index(make_toaster) "source $dir/usualway.tcl"
+set auto_index(toast_bread) "source $dir/usualway.tcl"
+set auto_index(clean_toaster) "source $dir/usualway.tcl"
+set auto_index(destroy_toaster) "source $dir/usualway.tcl"
diff --git a/itcl/itcl/tests/old/toasters/usualway.tcl b/itcl/itcl/tests/old/toasters/usualway.tcl
new file mode 100644
index 00000000000..dad4e15be07
--- /dev/null
+++ b/itcl/itcl/tests/old/toasters/usualway.tcl
@@ -0,0 +1,122 @@
+# ----------------------------------------------------------------------
+# PURPOSE: Procedures for managing toasters in the usual
+# procedure-oriented Tcl programming style. These
+# routines illustrate data sharing through global
+# variables and naming conventions to logically group
+# related procedures. The same programming task can
+# be accomplished much more cleanly with [incr Tcl].
+# Inheritance also allows new behavior to be "mixed-in"
+# more cleanly (see Appliance and Product base classes).
+#
+# AUTHOR: Michael J. McLennan Phone: (610)712-2842
+# AT&T Bell Laboratories E-mail: michael.mclennan@att.com
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993 AT&T Bell Laboratories
+# ======================================================================
+# Permission to use, copy, modify, and distribute this software and its
+# documentation for any purpose and without fee is hereby granted,
+# provided that the above copyright notice appear in all copies and that
+# both that the copyright notice and warranty disclaimer appear in
+# supporting documentation, and that the names of AT&T Bell Laboratories
+# any of their entities not be used in advertising or publicity
+# pertaining to distribution of the software without specific, written
+# prior permission.
+#
+# AT&T disclaims all warranties with regard to this software, including
+# all implied warranties of merchantability and fitness. In no event
+# shall AT&T be liable for any special, indirect or consequential
+# damages or any damages whatsoever resulting from loss of use, data or
+# profits, whether in an action of contract, negligence or other
+# tortuous action, arising out of or in connection with the use or
+# performance of this software.
+# ======================================================================
+
+# ----------------------------------------------------------------------
+# COMMAND: make_toaster <name> <heat>
+#
+# INPUTS
+# <name> = name of new toaster
+# <heat> = heat setting (1-5)
+#
+# RETURNS
+# name of new toaster
+#
+# SIDE-EFFECTS
+# Creates a record of a new toaster with the given heat setting
+# and an empty crumb tray.
+# ----------------------------------------------------------------------
+proc make_toaster {name heat} {
+ global allToasters
+
+ if {$heat < 1 || $heat > 5} {
+ error "invalid heat setting: should be 1-5"
+ }
+ set allToasters($name-heat) $heat
+ set allToasters($name-crumbs) 0
+}
+
+# ----------------------------------------------------------------------
+# COMMAND: toast_bread <name> <slices>
+#
+# INPUTS
+# <name> = name of toaster used to toast bread
+# <slices> = number of bread slices (1 or 2)
+#
+# RETURNS
+# current crumb count
+#
+# SIDE-EFFECTS
+# Toasts bread and adds crumbs to crumb tray.
+# ----------------------------------------------------------------------
+proc toast_bread {name slices} {
+ global allToasters
+
+ if {[info exists allToasters($name-crumbs)]} {
+ set c $allToasters($name-crumbs)
+ set c [expr $c+$allToasters($name-heat)*$slices]
+ set allToasters($name-crumbs) $c
+ } else {
+ error "not a toaster: $name"
+ }
+}
+
+# ----------------------------------------------------------------------
+# COMMAND: clean_toaster <name>
+#
+# INPUTS
+# <name> = name of toaster to be cleaned
+#
+# RETURNS
+# current crumb count
+#
+# SIDE-EFFECTS
+# Cleans toaster by emptying crumb tray.
+# ----------------------------------------------------------------------
+proc clean_toaster {name} {
+ global allToasters
+ set allToasters($name-crumbs) 0
+}
+
+# ----------------------------------------------------------------------
+# COMMAND: destroy_toaster <name>
+#
+# INPUTS
+# <name> = name of toaster to be destroyed
+#
+# RETURNS
+# nothing
+#
+# SIDE-EFFECTS
+# Spills all crumbs in the toaster and then destroys it.
+# ----------------------------------------------------------------------
+proc destroy_toaster {name} {
+ global allToasters
+
+ if {[info exists allToasters($name-crumbs)]} {
+ puts stdout "$allToasters($name-crumbs) crumbs ... what a mess!"
+ unset allToasters($name-heat)
+ unset allToasters($name-crumbs)
+ }
+}
diff --git a/itcl/itcl/tests/old/uplevel.test b/itcl/itcl/tests/old/uplevel.test
new file mode 100644
index 00000000000..527cb2cf200
--- /dev/null
+++ b/itcl/itcl/tests/old/uplevel.test
@@ -0,0 +1,155 @@
+#
+# Tests for "uplevel" across interpreter boundaries
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# ----------------------------------------------------------------------
+# DEFINE SOME USEFUL ROUTINES
+# ----------------------------------------------------------------------
+proc uplevelTest_show_var {level var} {
+ return "$var>>[uplevel $level set $var]"
+}
+
+proc uplevelTest_do {cmd} {
+ eval $cmd
+}
+
+# ----------------------------------------------------------------------
+# CREATE SOME OBJECTS
+# ----------------------------------------------------------------------
+Foo foo
+Baz baz
+
+# ----------------------------------------------------------------------
+# UPLEVEL TESTS (main interp)
+# ----------------------------------------------------------------------
+test {"uplevel" can access global variables (via relative level)} {
+ set globalvar "global value"
+ uplevelTest_show_var 1 globalvar
+} {
+ $result == "globalvar>>global value"
+}
+
+test {"uplevel" can access global variables (via "#0")} {
+ set globalvar "global value"
+ uplevelTest_show_var #0 globalvar
+} {
+ $result == "globalvar>>global value"
+}
+
+test {"uplevel" can access local variables (via relative level)} {
+ uplevelTest_do {
+ set localvar "local value"
+ uplevelTest_show_var 1 localvar
+ }
+} {
+ $result == "localvar>>local value"
+}
+
+test {"uplevel" can access local variables (via relative level)} {
+ uplevelTest_do {
+ set localvar "proper value"
+ uplevelTest_do {
+ set localvar "not this one"
+ uplevelTest_show_var 2 localvar
+ }
+ }
+} {
+ $result == "localvar>>proper value"
+}
+
+test {"uplevel" can access local variables (via explicit level)} {
+ uplevelTest_do {
+ set localvar "local value"
+ uplevelTest_show_var #1 localvar
+ }
+} {
+ $result == "localvar>>local value"
+}
+
+# ----------------------------------------------------------------------
+# UPLEVEL TESTS (across class interps)
+# ----------------------------------------------------------------------
+test {"uplevel" can cross class interps to access global variables} {
+ set globalvar "global value"
+ foo do {
+ uplevel #0 uplevelTest_show_var 1 globalvar
+ }
+} {
+ $result == "Foo says 'globalvar>>global value'"
+}
+
+test {"uplevel" can cross several class interps to access global variables} {
+ set globalvar "global value"
+ baz do {
+ foo do {
+ uplevel 2 uplevelTest_show_var #0 globalvar
+ }
+ }
+} {
+ $result == "Baz says 'Foo says 'globalvar>>global value''"
+}
+
+test {"uplevel" finds proper scope for execution} {
+ baz do {
+ foo do {
+ uplevel do {{info class}}
+ }
+ }
+} {
+ $result == "Baz says 'Foo says 'Baz says '::Baz'''"
+}
+
+test {"uplevel" finds proper scope for execution,
+and works in conjunction with "unknown" to access
+commands at the global scope with local call frames} {
+ baz do {
+ set bazvar "value in Baz"
+ foo do {
+ uplevel ::info locals
+ }
+ }
+} {
+ $result == "Baz says 'Foo says 'bazvar cmds''"
+}
+
+# ----------------------------------------------------------------------
+# LEVEL TESTS (across class scopes)
+# ----------------------------------------------------------------------
+test {"info level" works across scope boundaries} {
+ baz do {
+ foo do {
+ info level
+ }
+ }
+} {
+ $result == "Baz says 'Foo says '2''"
+}
+
+test {"info level" works across scope boundaries} {
+ baz do {
+ foo do {
+ info level 0
+ }
+ }
+} {
+ $result == "Baz says 'Foo says 'do {
+ info level 0
+ }''"
+}
+
+# ----------------------------------------------------------------------
+# CLEAN UP
+# ----------------------------------------------------------------------
+foo delete
+baz delete
diff --git a/itcl/itcl/tests/old/upvar.test b/itcl/itcl/tests/old/upvar.test
new file mode 100644
index 00000000000..15cf233be8d
--- /dev/null
+++ b/itcl/itcl/tests/old/upvar.test
@@ -0,0 +1,110 @@
+#
+# Tests for "upvar" across interpreter boundaries
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# ----------------------------------------------------------------------
+# DEFINE SOME USEFUL ROUTINES
+# ----------------------------------------------------------------------
+proc upvarTest_show_var {var val} {
+ return "$var>>$val"
+}
+
+proc upvarTest_upvar_in_procs {} {
+ set upvarTest_var_local "value in main interp"
+ foo do {
+ upvar upvarTest_var_local var
+ set var
+ }
+}
+
+# ----------------------------------------------------------------------
+# CREATE SOME OBJECTS
+# ----------------------------------------------------------------------
+Foo foo
+Baz baz
+
+# ----------------------------------------------------------------------
+# UPVAR TESTS
+# ----------------------------------------------------------------------
+test {"::" sends command to global interp but preserves
+local variables. This ensures that when control
+shifts to the global scope for Extended Tcl commands,
+Expect commands, etc., local variables will be
+recognized.} {
+ foo do {
+ set localvar "special"
+ ::eval {upvarTest_show_var localvar $localvar}
+ }
+} {
+ $result == "Foo says 'localvar>>special'"
+}
+
+
+test {"upvar" can cross interp boundaries to access local variables} {
+ upvarTest_upvar_in_procs
+} {
+ $result == "Foo says 'value in main interp'"
+}
+
+test {"upvar" can cross interp boundaries to access global variables} {
+ set upvarTest_var_global "value in main interp"
+ foo do {
+ upvar upvarTest_var_global var
+ set var
+ }
+} {
+ $result == "Foo says 'value in main interp'"
+}
+
+test {"upvar" can handle multiple call frames on the stack} {
+ set upvarTest_var_global "new value"
+ foo do {
+ foo do {
+ upvar #0 upvarTest_var_global var
+ set var
+ }
+ }
+} {
+ $result == "Foo says 'Foo says 'new value''"
+}
+
+test {"upvar" can cross class interp boundaries} {
+ baz do {
+ set localvar "value in Baz"
+ foo do {
+ upvar localvar var
+ set var
+ }
+ }
+} {
+ $result == "Baz says 'Foo says 'value in Baz''"
+}
+
+test {"upvar" can cross class interp boundaries back to main interp} {
+ set upvarTest_var_global "global value"
+ baz do {
+ foo do {
+ upvar 2 upvarTest_var_global var
+ set var
+ }
+ }
+} {
+ $result == "Baz says 'Foo says 'global value''"
+}
+
+# ----------------------------------------------------------------------
+# CLEAN UP
+# ----------------------------------------------------------------------
+foo delete
+baz delete
diff --git a/itcl/itcl/tests/protection.test b/itcl/itcl/tests/protection.test
new file mode 100644
index 00000000000..acf5ee650e8
--- /dev/null
+++ b/itcl/itcl/tests/protection.test
@@ -0,0 +1,370 @@
+#
+# Tests for method/variable protection and access
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Class members are protected by access restrictions
+# ----------------------------------------------------------------------
+test protect-1.1 {define a class with various protection levels} {
+ itcl::class test_pr {
+ public {
+ variable pubv "public var"
+ common pubc "public com"
+ method pubm {} {return "public method"}
+ method ovpubm {} {return "overloaded public method"}
+ proc pubp {} {return "public proc"}
+ }
+ protected {
+ variable prov "protected var"
+ common proc "protected com"
+ method prom {} {return "protected method"}
+ method ovprom {} {return "overloaded protected method"}
+ proc prop {} {return "protected proc"}
+ }
+ private {
+ variable priv "private var"
+ common pric "private com"
+ method prim {} {return "private method"}
+ method ovprim {} {return "overloaded private method"}
+ proc prip {} {return "private proc"}
+ }
+ method do {args} {eval $args}
+ }
+} ""
+
+test protect-1.2 {create an object to execute tests} {
+ test_pr #auto
+} {test_pr0}
+
+test protect-1.3a {public methods can be accessed from outside} {
+ list [catch {test_pr0 pubm} msg] $msg
+} {0 {public method}}
+
+test protect-1.3b {public methods can be accessed from inside} {
+ list [catch {test_pr0 do pubm} msg] $msg
+} {0 {public method}}
+
+test protect-1.4a {protected methods are blocked from outside} {
+ list [catch {test_pr0 prom} msg] $msg
+} {1 {bad option "prom": should be one of...
+ test_pr0 cget -option
+ test_pr0 configure ?-option? ?value -option value...?
+ test_pr0 do ?arg arg ...?
+ test_pr0 isa className
+ test_pr0 ovpubm
+ test_pr0 pubm}}
+
+test protect-1.4b {protected methods can be accessed from inside} {
+ list [catch {test_pr0 do prom} msg] $msg
+} {0 {protected method}}
+
+test protect-1.5a {private methods are blocked from outside} {
+ list [catch {test_pr0 prim} msg] $msg
+} {1 {bad option "prim": should be one of...
+ test_pr0 cget -option
+ test_pr0 configure ?-option? ?value -option value...?
+ test_pr0 do ?arg arg ...?
+ test_pr0 isa className
+ test_pr0 ovpubm
+ test_pr0 pubm}}
+
+test protect-1.5b {private methods can be accessed from inside} {
+ list [catch {test_pr0 do prim} msg] $msg
+} {0 {private method}}
+
+test protect-1.6a {public procs can be accessed from outside} {
+ list [catch {test_pr::pubp} msg] $msg
+} {0 {public proc}}
+
+test protect-1.6b {public procs can be accessed from inside} {
+ list [catch {test_pr0 do pubp} msg] $msg
+} {0 {public proc}}
+
+test protect-1.7a {protected procs are blocked from outside} {
+ list [catch {test_pr::prop} msg] $msg
+} {1 {can't access "::test_pr::prop": protected function}}
+
+test protect-1.7b {protected procs can be accessed from inside} {
+ list [catch {test_pr0 do prop} msg] $msg
+} {0 {protected proc}}
+
+test protect-1.8a {private procs are blocked from outside} {
+ list [catch {test_pr::prip} msg] $msg
+} {1 {can't access "::test_pr::prip": private function}}
+
+test protect-1.8b {private procs can be accessed from inside} {
+ list [catch {test_pr0 do prip} msg] $msg
+} {0 {private proc}}
+
+test protect-1.9a {public commons can be accessed from outside} {
+ list [catch {set test_pr::pubc} msg] $msg
+} {0 {public com}}
+
+test protect-1.9b {public commons can be accessed from inside} {
+ list [catch {test_pr0 do set pubc} msg] $msg
+} {0 {public com}}
+
+test protect-1.10 {protected commons can be accessed from inside} {
+ list [catch {test_pr0 do set proc} msg] $msg
+} {0 {protected com}}
+
+test protect-1.11 {private commons can be accessed from inside} {
+ list [catch {test_pr0 do set pric} msg] $msg
+} {0 {private com}}
+
+test protect-1.12a {object-specific variables require an access command} {
+ list [catch {set test_pr::pubv} msg] $msg
+} {1 {can't read "test_pr::pubv": no such variable}}
+
+test protect-1.12b {public variables can be accessed from inside} {
+ list [catch {test_pr0 do set pubv} msg] $msg
+} {0 {public var}}
+
+test protect-1.13a {object-specific variables require an access command} {
+ list [catch {set test_pr::prov} msg] $msg
+} {1 {can't read "test_pr::prov": no such variable}}
+
+test protect-1.13b {protected variables can be accessed from inside} {
+ list [catch {test_pr0 do set prov} msg] $msg
+} {0 {protected var}}
+
+test protect-1.14a {object-specific variables require an access command} {
+ list [catch {set test_pr::priv} msg] $msg
+} {1 {can't read "test_pr::priv": no such variable}}
+
+test protect-1.14b {private variables can be accessed from inside} {
+ list [catch {test_pr0 do set priv} msg] $msg
+} {0 {private var}}
+
+# ----------------------------------------------------------------------
+# Access restrictions work properly with inheritance
+# ----------------------------------------------------------------------
+test protect-2.1 {define a derived class} {
+ itcl::class test_pr_derived {
+ inherit test_pr
+ method do {args} {eval $args}
+
+ public method ovpubm {} {return "specific public method"}
+ protected method ovprom {} {return "specific protected method"}
+ private method ovprim {} {return "specific private method"}
+
+ public method dpubm {} {return "pub (only in derived)"}
+ protected method dprom {} {return "pro (only in derived)"}
+ private method dprim {} {return "pri (only in derived)"}
+ }
+} ""
+
+test protect-2.2 {create an object to execute tests} {
+ test_pr_derived #auto
+} {test_pr_derived0}
+
+test protect-2.3 {public methods can be accessed from inside} {
+ list [catch {test_pr_derived0 do pubm} msg] $msg
+} {0 {public method}}
+
+test protect-2.4 {protected methods can be accessed from inside} {
+ list [catch {test_pr_derived0 do prom} msg] $msg
+} {0 {protected method}}
+
+test protect-2.5 {private methods are blocked} {
+ list [catch {test_pr_derived0 do prim} msg] $msg
+} {1 {invalid command name "prim"}}
+
+test protect-2.6 {public procs can be accessed from inside} {
+ list [catch {test_pr_derived0 do pubp} msg] $msg
+} {0 {public proc}}
+
+test protect-2.7 {protected procs can be accessed from inside} {
+ list [catch {test_pr_derived0 do prop} msg] $msg
+} {0 {protected proc}}
+
+test protect-2.8 {private procs are blocked} {
+ list [catch {test_pr_derived0 do prip} msg] $msg
+} {1 {invalid command name "prip"}}
+
+test protect-2.9 {public commons can be accessed from inside} {
+ list [catch {test_pr_derived0 do set pubc} msg] $msg
+} {0 {public com}}
+
+test protect-2.10 {protected commons can be accessed from inside} {
+ list [catch {test_pr_derived0 do set proc} msg] $msg
+} {0 {protected com}}
+
+test protect-2.11 {private commons are blocked} {
+ list [catch {test_pr_derived0 do set pric} msg] $msg
+} {1 {can't read "pric": no such variable}}
+
+test protect-2.12 {public variables can be accessed from inside} {
+ list [catch {test_pr_derived0 do set pubv} msg] $msg
+} {0 {public var}}
+
+test protect-2.13 {protected variables can be accessed from inside} {
+ list [catch {test_pr_derived0 do set prov} msg] $msg
+} {0 {protected var}}
+
+test protect-2.14 {private variables are blocked} {
+ list [catch {test_pr_derived0 do set priv} msg] $msg
+} {1 {can't read "priv": no such variable}}
+
+test protect-2.15 {can access overloaded public method} {
+ set cmd {namespace eval test_pr_derived {test_pr_derived0 ovpubm}}
+ list [catch $cmd msg] $msg
+} {0 {specific public method}}
+
+test protect-2.16 {can access overloaded public method} {
+ set cmd {namespace eval test_pr_derived {test_pr_derived0 ovprom}}
+ list [catch $cmd msg] $msg
+} {0 {specific protected method}}
+
+test protect-2.17 {can access overloaded private method} {
+ set cmd {namespace eval test_pr_derived {test_pr_derived0 ovprim}}
+ list [catch $cmd msg] $msg
+} {0 {specific private method}}
+
+test protect-2.18 {can access overloaded public method from base class} {
+ set cmd {namespace eval test_pr {test_pr_derived0 ovpubm}}
+ list [catch $cmd msg] $msg
+} {0 {specific public method}}
+
+test protect-2.19 {can access overloaded protected method from base class} {
+ set cmd {namespace eval test_pr {test_pr_derived0 ovprom}}
+ list [catch $cmd msg] $msg
+} {0 {specific protected method}}
+
+test protect-2.20 {*cannot* access overloaded private method from base class} {
+ set cmd {namespace eval test_pr {test_pr_derived0 ovprim}}
+ list [catch $cmd msg] $msg
+} {1 {bad option "ovprim": should be one of...
+ test_pr_derived0 cget -option
+ test_pr_derived0 configure ?-option? ?value -option value...?
+ test_pr_derived0 do ?arg arg ...?
+ test_pr_derived0 dpubm
+ test_pr_derived0 isa className
+ test_pr_derived0 ovprom
+ test_pr_derived0 ovpubm
+ test_pr_derived0 prim
+ test_pr_derived0 prom
+ test_pr_derived0 pubm}}
+
+test protect-2.21 {can access non-overloaded public method from base class} {
+ set cmd {namespace eval test_pr {test_pr_derived0 dpubm}}
+ list [catch $cmd msg] $msg
+} {0 {pub (only in derived)}}
+
+test protect-2.22 {*cannot* access non-overloaded protected method from base class} {
+ set cmd {namespace eval test_pr {test_pr_derived0 dprom}}
+ list [catch $cmd msg] $msg
+} {1 {bad option "dprom": should be one of...
+ test_pr_derived0 cget -option
+ test_pr_derived0 configure ?-option? ?value -option value...?
+ test_pr_derived0 do ?arg arg ...?
+ test_pr_derived0 dpubm
+ test_pr_derived0 isa className
+ test_pr_derived0 ovprom
+ test_pr_derived0 ovpubm
+ test_pr_derived0 prim
+ test_pr_derived0 prom
+ test_pr_derived0 pubm}}
+
+test protect-2.23 {*cannot* access non-overloaded private method from base class} {
+ set cmd {namespace eval test_pr {test_pr_derived0 dprim}}
+ list [catch $cmd msg] $msg
+} {1 {bad option "dprim": should be one of...
+ test_pr_derived0 cget -option
+ test_pr_derived0 configure ?-option? ?value -option value...?
+ test_pr_derived0 do ?arg arg ...?
+ test_pr_derived0 dpubm
+ test_pr_derived0 isa className
+ test_pr_derived0 ovprom
+ test_pr_derived0 ovpubm
+ test_pr_derived0 prim
+ test_pr_derived0 prom
+ test_pr_derived0 pubm}}
+
+eval namespace delete [find classes test_pr*]
+
+# ----------------------------------------------------------------------
+# Access restrictions don't mess up "info"
+# ----------------------------------------------------------------------
+test protect-3.1 {define a base class with private variables} {
+ itcl::class test_info_base {
+ private variable pribv "pribv-value"
+ private common pribc "pribc-value"
+ protected variable probv "probv-value"
+ protected common probc "probc-value"
+ public variable pubbv "pubbv-value"
+ public common pubbc "pubbc-value"
+ }
+ itcl::class test_info_derived {
+ inherit test_info_base
+ private variable pridv "pridv-value"
+ private common pridc "pridc-value"
+ }
+} ""
+
+test protect-3.2 {create an object to execute tests} {
+ test_info_derived #auto
+} {test_info_derived0}
+
+test protect-3.3 {all variables are reported} {
+ list [catch {test_info_derived0 info variable} msg] [lsort $msg]
+} {0 {::test_info_base::pribc ::test_info_base::pribv ::test_info_base::probc ::test_info_base::probv ::test_info_base::pubbc ::test_info_base::pubbv ::test_info_derived::pridc ::test_info_derived::pridv ::test_info_derived::this}}
+
+test protect-3.4 {private base class variables can be accessed} {
+ list [catch {test_info_derived0 info variable pribv} msg] $msg
+} {0 {private variable ::test_info_base::pribv pribv-value pribv-value}}
+
+test protect-3.5 {private base class commons can be accessed} {
+ list [catch {test_info_derived0 info variable pribc} msg] $msg
+} {0 {private common ::test_info_base::pribc pribc-value pribc-value}}
+
+test protect-3.6 {protected base class variables can be accessed} {
+ list [catch {test_info_derived0 info variable probv} msg] $msg
+} {0 {protected variable ::test_info_base::probv probv-value probv-value}}
+
+test protect-3.7 {protected base class commons can be accessed} {
+ list [catch {test_info_derived0 info variable probc} msg] $msg
+} {0 {protected common ::test_info_base::probc probc-value probc-value}}
+
+test protect-3.8 {public base class variables can be accessed} {
+ list [catch {test_info_derived0 info variable pubbv} msg] $msg
+} {0 {public variable ::test_info_base::pubbv pubbv-value {} pubbv-value}}
+
+test protect-3.9 {public base class commons can be accessed} {
+ list [catch {test_info_derived0 info variable pubbc} msg] $msg
+} {0 {public common ::test_info_base::pubbc pubbc-value pubbc-value}}
+
+test protect-3.10 {private derived class variables can be accessed} {
+ list [catch {test_info_derived0 info variable pridv} msg] $msg
+} {0 {private variable ::test_info_derived::pridv pridv-value pridv-value}}
+
+test protect-3.11 {private derived class commons can be accessed} {
+ list [catch {test_info_derived0 info variable pridc} msg] $msg
+} {0 {private common ::test_info_derived::pridc pridc-value pridc-value}}
+
+test protect-3.12 {private base class variables can't be accessed from class} {
+ list [catch {
+ namespace eval test_info_derived {info variable pribv}
+ } msg] $msg
+} {1 {cannot access object-specific info without an object context}}
+
+test protect-3.13 {private base class commons can be accessed from class} {
+ list [catch {
+ namespace eval test_info_derived {info variable pribc}
+ } msg] $msg
+} {0 {private common ::test_info_base::pribc pribc-value pribc-value}}
+
+eval namespace delete [find classes test_info*]
diff --git a/itcl/itcl/tests/scope.test b/itcl/itcl/tests/scope.test
new file mode 100644
index 00000000000..8ce1e05b810
--- /dev/null
+++ b/itcl/itcl/tests/scope.test
@@ -0,0 +1,207 @@
+#
+# Tests for code/scope commands
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Syntax of the "scope" command
+# ----------------------------------------------------------------------
+test scope-1.1 {scope command takes one argument} {
+ list [catch {itcl::scope} msg] $msg [catch {itcl::scope x y} msg] $msg
+} {1 {wrong # args: should be "itcl::scope varname"} 1 {wrong # args: should be "itcl::scope varname"}}
+
+test scope-1.2 {argument to scope command must be a variable} {
+ variable test_scope_var 0
+ list [catch {itcl::scope xyzzy} msg] $msg \
+ [catch {itcl::scope test_scope_var} msg] $msg
+} {1 {variable "xyzzy" not found in namespace "::"} 0 ::test_scope_var}
+
+test scope-1.3 {if variable is already fully qualified, scope does nothing} {
+ list [itcl::scope ::xyzzy] [itcl::scope ::test_scope_var]
+} {::xyzzy ::test_scope_var}
+
+test scope-1.4 {scope command returns fully qualified name} {
+ namespace eval test_scope_ns {
+ namespace eval child {
+ variable v1 0
+ itcl::scope v1
+ }
+ }
+} {::test_scope_ns::child::v1}
+
+namespace delete test_scope_ns
+unset test_scope_var
+
+# ----------------------------------------------------------------------
+# Syntax of the "code" command
+# ----------------------------------------------------------------------
+test scope-2.1 {code command takes at least one argument} {
+ list [catch {itcl::code} msg] $msg
+} {1 {wrong # args: should be "itcl::code ?-namespace name? command ?arg arg...?"}}
+
+test scope-2.2 {code command with one argument} {
+ itcl::code arg1
+} {namespace inscope :: arg1}
+
+test scope-2.3 {code command with many arguments} {
+ list [itcl::code arg1 arg2] [itcl::code arg1 arg2 arg3 arg4]
+} {{namespace inscope :: {arg1 arg2}} {namespace inscope :: {arg1 arg2 arg3 arg4}}}
+
+test scope-2.4 {code command appends arguments as list elements} {
+ list [itcl::code "foo bar"] \
+ [itcl::code "foo bar" "hello, world!" "one, two, three"]
+} {{namespace inscope :: {foo bar}} {namespace inscope :: {{foo bar} {hello, world!} {one, two, three}}}}
+
+test scope-2.5 {code command inside code command} {
+ itcl::code [itcl::code arg1 arg2] arg3
+} {namespace inscope :: {{namespace inscope :: {arg1 arg2}} arg3}}
+
+test scope-2.6 {code command returns fully qualified names} {
+ namespace eval test_scope_ns {
+ namespace eval child {
+ itcl::code foo bar baz
+ }
+ }
+} {namespace inscope ::test_scope_ns::child {foo bar baz}}
+
+test scope-2.7 {code command lets you specify a namespace} {
+ list [catch {itcl::code -namespace xyzzy arg1 arg2} msg] $msg \
+ [catch {itcl::code -namespace test_scope_ns::child arg1 arg2} msg] $msg
+} {1 {unknown namespace "xyzzy"} 0 {namespace inscope ::test_scope_ns::child {arg1 arg2}}}
+
+test scope-2.8 {last namespace wins} {
+ itcl::code -namespace test_scope_ns::child -namespace test_scope_ns arg1
+} {namespace inscope ::test_scope_ns arg1}
+
+test scope-2.9 {"--" terminates switches} {
+ list [catch {itcl::code -namespace test_scope_ns -foo -bar} msg] $msg \
+ [catch {itcl::code -namespace test_scope_ns -- -foo -bar} msg] $msg
+
+} {1 {bad option "-foo": should be -namespace or --} 0 {namespace inscope ::test_scope_ns {-foo -bar}}}
+
+namespace delete test_scope_ns
+
+# ----------------------------------------------------------------------
+# Test code/scope commands in a class
+# ----------------------------------------------------------------------
+test scope-3.1 {define simple classes with things to export} {
+ itcl::class test_scope {
+ private variable priv "private-value"
+ protected variable prov "protected-value"
+ public variable pubv "public-value"
+
+ private common pric "private-common-value"
+ protected common proc "protected-common-value"
+ public common pubc "public-common-value"
+
+ variable varray
+ common carray
+
+ method mcontext {args} {
+ return [eval $args]
+ }
+ proc pcontext {args} {
+ return [eval $args]
+ }
+
+ private method prim {args} {
+ return "prim: $args"
+ }
+ protected method prom {args} {
+ return "prom: $args"
+ }
+ public method pubm {args} {
+ return "pubm: $args"
+ }
+ }
+ test_scope #auto
+} {test_scope0}
+
+test scope-3.2 {code command captures only class context} {
+ list [test_scope0 mcontext itcl::code arg1 arg2] \
+ [test_scope::pcontext itcl::code arg1 arg2]
+} {{namespace inscope ::test_scope {arg1 arg2}} {namespace inscope ::test_scope {arg1 arg2}}}
+
+test scope-3.3 {scope command captures class and object context} {
+ list [test_scope0 mcontext itcl::scope priv] \
+ [test_scope::pcontext itcl::scope pric]
+} {{@itcl ::test_scope0 ::test_scope::priv} ::test_scope::pric}
+
+test scope-3.4 {scope command must recognize variable} {
+ list [catch {test_scope0 mcontext itcl::scope xyzzy} msg] $msg
+} {1 {variable "xyzzy" not found in class "::test_scope"}}
+
+test scope-3.5 {scope command provides access to instance variables} {
+ set result ""
+ foreach vname {priv prov pubv} {
+ lappend result [test_scope0 info variable $vname]
+ set var [test_scope0 mcontext itcl::scope $vname]
+ set $var "$vname-new"
+ lappend result [test_scope0 info variable $vname]
+ }
+ set result
+} {{private variable ::test_scope::priv private-value private-value} {private variable ::test_scope::priv private-value priv-new} {protected variable ::test_scope::prov protected-value protected-value} {protected variable ::test_scope::prov protected-value prov-new} {public variable ::test_scope::pubv public-value {} public-value} {public variable ::test_scope::pubv public-value {} pubv-new}}
+
+test scope-3.6 {scope command provides access to common variables} {
+ set result ""
+ foreach vname {pric proc pubc} {
+ lappend result [test_scope0 info variable $vname]
+ set var [test_scope0 mcontext itcl::scope $vname]
+ set $var "$vname-new"
+ lappend result [test_scope0 info variable $vname]
+ }
+ set result
+} {{private common ::test_scope::pric private-common-value private-common-value} {private common ::test_scope::pric private-common-value pric-new} {protected common ::test_scope::proc protected-common-value protected-common-value} {protected common ::test_scope::proc protected-common-value proc-new} {public common ::test_scope::pubc public-common-value public-common-value} {public common ::test_scope::pubc public-common-value pubc-new}}
+
+test scope-3.7 {code command provides access to methods} {
+ set result ""
+ foreach mname {prim prom pubm} {
+ set cmd [test_scope0 mcontext eval itcl::code \$this $mname]
+ lappend result $cmd [$cmd 1 2 3]
+ }
+ set result
+} {{namespace inscope ::test_scope {::test_scope0 prim}} {prim: 1 2 3} {namespace inscope ::test_scope {::test_scope0 prom}} {prom: 1 2 3} {namespace inscope ::test_scope {::test_scope0 pubm}} {pubm: 1 2 3}}
+
+test scope-3.8 {scope command allows access to slots in an array} {
+ test_scope0 mcontext set varray(0) "defined"
+ test_scope::pcontext set carray(0) "defined"
+ list [catch {test_scope0 mcontext scope varray(0)} msg] $msg \
+ [catch {test_scope0 mcontext scope varray(1)} msg] $msg \
+ [catch {test_scope::pcontext scope carray(0)} msg] $msg \
+ [catch {test_scope::pcontext scope carray(1)} msg] $msg
+} {0 {@itcl ::test_scope0 ::test_scope::varray(0)} 0 {@itcl ::test_scope0 ::test_scope::varray(1)} 0 ::test_scope::carray(0) 0 ::test_scope::carray(1)}
+
+itcl::delete class test_scope
+
+# ----------------------------------------------------------------------
+# Test code/scope commands in a namespace
+# ----------------------------------------------------------------------
+test scope-4.1 {define simple namespace with things to export} {
+ namespace eval test_scope_ns {
+ variable array
+ proc pcontext {args} {
+ return [eval $args]
+ }
+ }
+ namespace children :: ::test_scope_ns
+} {::test_scope_ns}
+
+test scope-4.2 {scope command allows access to slots in an array} {
+ test_scope_ns::pcontext set array(0) "defined"
+ list [catch {test_scope_ns::pcontext scope array(0)} msg] $msg \
+ [catch {test_scope_ns::pcontext scope array(1)} msg] $msg
+} {0 ::test_scope_ns::array(0) 0 ::test_scope_ns::array(1)}
+
+namespace delete test_scope_ns
diff --git a/itcl/itcl/tests/tclIndex b/itcl/itcl/tests/tclIndex
new file mode 100644
index 00000000000..f63ca93c630
--- /dev/null
+++ b/itcl/itcl/tests/tclIndex
@@ -0,0 +1,24 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(Simple1) [list source [file join $dir mkindex.itcl]]
+set auto_index(Simple2) [list source [file join $dir mkindex.itcl]]
+set auto_index(OldStyle) [list source [file join $dir mkindex.itcl]]
+set auto_index(ens) [list source [file join $dir mkindex.itcl]]
+set auto_index(::Simple2::bump) [list source [file join $dir mkindex.itcl]]
+set auto_index(::Simple2::by) [list source [file join $dir mkindex.itcl]]
+set auto_index(::buried::inside) [list source [file join $dir mkindex.itcl]]
+set auto_index(::buried::inside::find) [list source [file join $dir mkindex.itcl]]
+set auto_index(::buried::inside::bump) [list source [file join $dir mkindex.itcl]]
+set auto_index(::buried::inside::by) [list source [file join $dir mkindex.itcl]]
+set auto_index(top) [list source [file join $dir mkindex.itcl]]
+set auto_index(::top::find) [list source [file join $dir mkindex.itcl]]
+set auto_index(::top::notice) [list source [file join $dir mkindex.itcl]]
+set auto_index(::buried::ens) [list source [file join $dir mkindex.itcl]]
+set auto_index(::buried::under::neath) [list source [file join $dir mkindex.itcl]]
+set auto_index(::buried::deep::within) [list source [file join $dir mkindex.itcl]]
diff --git a/itcl/itcl/unix/Makefile.in b/itcl/itcl/unix/Makefile.in
new file mode 100644
index 00000000000..824550623af
--- /dev/null
+++ b/itcl/itcl/unix/Makefile.in
@@ -0,0 +1,321 @@
+#
+# This file is a Makefile for [incr Tcl]. 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$
+
+# Current [incr Tcl] version; used in various names.
+
+MAJOR_VERSION = @ITCL_MAJOR_VERSION@
+MINOR_VERSION = @ITCL_MINOR_VERSION@
+RELEASE_LEVEL = @ITCL_RELEASE_LEVEL@
+VERSION = @ITCL_VERSION@
+
+#----------------------------------------------------------------
+# Things you can change to personalize the Makefile for your own
+# site (you can make these changes in either Makefile.in or
+# Makefile, but changes to Makefile will get lost if you re-run
+# the configuration script).
+#----------------------------------------------------------------
+
+# Default top-level directories in which to install architecture-
+# specific files (exec_prefix) and machine-independent files such
+# as scripts (prefix). The values specified here may be overridden
+# at configure-time with the --exec-prefix and --prefix options
+# to the "configure" script.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+
+# The following definition can be set to non-null for special systems
+# like AFS with replication. It allows the pathnames used for installation
+# to be different than those used for actually reference files at
+# run-time. INSTALL_ROOT is prepended to $prefix and $exec_prefix
+# when installing files.
+INSTALL_ROOT =
+
+# Directory from which applications will reference the library of
+# [incr Tcl] scripts (note: you can set the ITCL_LIBRARY environment
+# variable at run-time to override this value):
+# CYGNUS LOCAL: we use "share" rather than "lib" as the prefix for our
+# Tcl files
+ITCL_LIBRARY = $(prefix)/share/itcl$(VERSION)
+# END CYGNUS LOCAL
+
+# Path name to use when installing library scripts:
+SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(ITCL_LIBRARY)
+
+# Directory in which to install the archive libtcl.a:
+LIB_INSTALL_DIR = $(INSTALL_ROOT)$(exec_prefix)/lib
+
+# Path to use at runtime to refer to LIB_INSTALL_DIR:
+LIB_RUNTIME_DIR = $(exec_prefix)/lib
+
+# Directory in which to install the program tclsh:
+BIN_INSTALL_DIR = $(INSTALL_ROOT)$(exec_prefix)/bin
+
+# Directory in which to install the include file itcl.h:
+INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(prefix)/include
+
+# Top-level directory in which to install manual entries:
+MAN_INSTALL_DIR = $(INSTALL_ROOT)$(prefix)/man
+
+# Directory in which to install manual entry for itclsh:
+MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1
+
+# Directory in which to install manual entries for [incr Tcl]'s
+# C library procedures:
+MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3
+
+# Directory in which to install manual entries for the built-in
+# [incr Tcl] commands:
+MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann
+
+# Tcl source directory is included in this distribution. Use this to
+# get the correct path:
+TCL_SRC_DIR = @TCL_SRC_DIR@
+
+# The directory containing the Tcl library archive file appropriate
+# for this version of Tk:
+TCL_LIB_DIR = @TCL_LIB_DIR@
+
+# Library flags for Tcl library
+TCL_LIB_FLAG = @TCL_LIB_FLAG@
+
+# Tcl libraries built with optimization switches have this additional extension
+DBGX = @TCL_DBGX@
+
+# Additional libraries to use when linking. The "LIBS" part will be
+# replaced (or has already been replaced) with relevant libraries as
+# determined by the configure script.
+LIBS = @TCL_BUILD_LIB_SPEC@ @TCL_LIBS@ @DL_LIBS@ -lc
+
+# To change the compiler switches, for example to change from -O
+# to -g, change the following line:
+CFLAGS = @CFLAGS@
+
+# To disable ANSI-C procedure prototypes reverse the comment characters
+# on the following lines:
+PROTO_FLAGS =
+#PROTO_FLAGS = -DNO_PROTOTYPE
+
+# To enable memory debugging reverse the comment characters on the following
+# lines. Warning: if you enable memory debugging, you must do it
+# *everywhere*, including all the code that calls Tcl, and you must use
+# ckalloc and ckfree everywhere instead of malloc and free.
+MEM_DEBUG_FLAGS =
+#MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG
+
+# Some versions of make, like SGI's, use the following variable to
+# determine which shell to use for executing commands:
+SHELL = /bin/sh
+
+# Tcl 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
+# with the distribution, which is slower but guaranteed to work.
+
+INSTALL = $(TOP_DIR)/../config/install-sh -c
+INSTALL_PROGRAM = ${INSTALL}
+INSTALL_DATA = ${INSTALL} -m 644
+MKINSTALLDIRS = $(TOP_DIR)/../config/mkinstalldirs
+
+# 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.
+
+SHLIB_CFLAGS = @SHLIB_CFLAGS@
+TCL_CFLAGS = @TCL_CFLAGS@
+
+LD_SEARCH_FLAGS = @LD_SEARCH_FLAGS@
+
+ITCL_LIB_FILE = @ITCL_LIB_FILE@
+#ITCL_LIB_FILE = libitcl.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@
+
+#----------------------------------------------------------------
+# 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 = @TCL_DEFS@
+RANLIB = @RANLIB@
+TOP_DIR = @ITCL_SRC_DIR@
+GENERIC_DIR = $(TOP_DIR)/generic
+UNIX_DIR = $(TOP_DIR)/unix
+VPATH = @srcdir@
+
+#----------------------------------------------------------------
+# 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) $(TCL_CFLAGS) $(SHLIB_CFLAGS) \
+-I$(UNIX_DIR) -I$(GENERIC_DIR) \
+-I$(TCL_SRC_DIR)/generic $(AC_FLAGS) $(PROTO_FLAGS) $(MEM_DEBUG_FLAGS) \
+-DITCL_LIBRARY=\"$(ITCL_LIBRARY)\"
+
+SRCS = $(GENERIC_DIR)/itcl_bicmds.c \
+ $(GENERIC_DIR)/itcl_class.c \
+ $(GENERIC_DIR)/itcl_cmds.c \
+ $(GENERIC_DIR)/itcl_ensemble.c \
+ $(GENERIC_DIR)/itcl_linkage.c \
+ $(GENERIC_DIR)/itcl_methods.c \
+ $(GENERIC_DIR)/itcl_migrate.c \
+ $(GENERIC_DIR)/itcl_objects.c \
+ $(GENERIC_DIR)/itcl_obsolete.c \
+ $(GENERIC_DIR)/itcl_parse.c \
+ $(GENERIC_DIR)/itcl_util.c \
+ $(GENERIC_DIR)/tclAppInit.c
+
+OBJS = itcl_bicmds.o itcl_class.o itcl_cmds.o itcl_ensemble.o \
+ itcl_linkage.o itcl_methods.o itcl_migrate.o itcl_objects.o \
+ itcl_obsolete.o itcl_parse.o itcl_util.o
+
+SOBJS = itcl_bicmds.so itcl_class.so itcl_cmds.so itcl_ensemble.so \
+ itcl_linkage.so itcl_methods.so itcl_migrate.so itcl_objects.so \
+ itcl_obsolete.so itcl_parse.so itcl_util.so
+
+all: $(ITCL_LIB_FILE) itclsh
+
+@ITCL_LIB_FILE@: $(OBJS)
+ rm -f $(ITCL_LIB_FILE)
+ @MAKE_LIB@
+ $(RANLIB) $(ITCL_LIB_FILE)
+
+itclsh: tclAppInit.o $(ITCL_LIB_FILE) @TCL_LIB_FULL_PATH@
+ $(CC) @LD_FLAGS@ tclAppInit.o @ITCL_BUILD_LIB_SPEC@ \
+ $(LIBS) $(LD_SEARCH_FLAGS) -o itclsh
+
+test: itclsh
+ LD_LIBRARY_PATH="$(TCL_LIB_DIR):`pwd`:$(LD_LIBRARY_PATH)"; \
+ export LD_LIBRARY_PATH; \
+ TCL_LIBRARY="$(TCL_SRC_DIR)/library"; export TCL_LIBRARY; \
+ ITCL_LIBRARY=$(TOP_DIR)/library; export ITCL_LIBRARY; \
+ TCLLIBPATH=$(TOP_DIR)/unix; export TCLLIBPATH; \
+ ( echo cd $(TOP_DIR)/tests\; source all ) | ./itclsh
+
+install: install-binaries install-libraries install-man
+
+install-binaries: $(ITCL_LIB_FILE) itclsh
+ @$(MKINSTALLDIRS) $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR)
+ @echo "Installing $(ITCL_LIB_FILE)"
+ @$(INSTALL_DATA) $(ITCL_LIB_FILE) $(LIB_INSTALL_DIR)/$(ITCL_LIB_FILE)
+ @(cd $(LIB_INSTALL_DIR); $(RANLIB) $(ITCL_LIB_FILE))
+ chmod 555 $(LIB_INSTALL_DIR)/$(ITCL_LIB_FILE)
+ @echo "Installing itclsh"
+ $(INSTALL_PROGRAM) itclsh $(BIN_INSTALL_DIR)/itclsh$(VERSION)
+ @echo "Installing itclConfig.sh"
+ @$(INSTALL_DATA) ../itclConfig.sh $(LIB_INSTALL_DIR)/itclConfig.sh
+
+install-libraries:
+ @$(MKINSTALLDIRS) $(INCLUDE_INSTALL_DIR) $(SCRIPT_INSTALL_DIR)
+ @echo "Installing itcl.h"
+ @$(INSTALL_DATA) $(GENERIC_DIR)/itcl.h $(INCLUDE_INSTALL_DIR)
+ @for i in $(TOP_DIR)/library/*.* $(UNIX_DIR)/tclAppInit.c; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
+ done;
+ @echo "Installing pkgIndex.tcl"
+ @$(INSTALL_DATA) pkgIndex.tcl $(SCRIPT_INSTALL_DIR)
+
+install-man:
+ @$(MKINSTALLDIRS) $(MAN1_INSTALL_DIR) $(MANN_INSTALL_DIR)
+ @cd $(TOP_DIR)/doc; for i in *.1; \
+ do \
+ echo "Installing doc/$$i"; \
+ rm -f $(MAN1_INSTALL_DIR)/$$i; \
+ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+ $$i > $(MAN1_INSTALL_DIR)/$$i; \
+ chmod 444 $(MAN1_INSTALL_DIR)/$$i; \
+ done;
+ @cd $(TOP_DIR)/doc; for i in *.n; \
+ do \
+ echo "Installing doc/$$i"; \
+ rm -f $(MANN_INSTALL_DIR)/$$i; \
+ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+ $$i > $(MANN_INSTALL_DIR)/$$i; \
+ chmod 444 $(MANN_INSTALL_DIR)/$$i; \
+ done;
+
+# CYGNUS LOCAL: install-minimal target.
+install-minimal:
+
+Makefile: $(UNIX_DIR)/Makefile.in
+ $(SHELL) config.status
+
+clean:
+ rm -f *.a *.o core errs *~ \#* TAGS *.E a.out errors \
+ rm -f itclsh* libitcl* *pure* *% ../tests/core
+
+distclean: clean
+ rm -f Makefile config.status config.cache config.log
+ rm -f ../itclConfig.sh pkgIndex.tcl
+
+pure: tclAppInit.o $(ITCL_LIB_FILE) @TCL_LIB_FULL_PATH@
+ purify $(CC) @LD_FLAGS@ tclAppInit.o @ITCL_BUILD_LIB_SPEC@ \
+ $(LIBS) $(LD_SEARCH_FLAGS) -o itclsh.pure
+
+profile: tclAppInit.o $(ITCL_LIB_FILE) @TCL_LIB_FULL_PATH@
+ quantify $(CC) @LD_FLAGS@ tclAppInit.o @ITCL_BUILD_LIB_SPEC@ \
+ $(LIBS) $(LD_SEARCH_FLAGS) -o itclsh.pure
+
+depend:
+ makedepend -- $(CC_SWITCHES) -- $(SRCS)
+
+configure: configure.in
+ autoconf
+
+.c.o:
+ $(CC) -c $(CC_SWITCHES) $<
+
+tclAppInit.o: $(UNIX_DIR)/tclAppInit.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tclAppInit.c
+
+itcl_bicmds.o: $(GENERIC_DIR)/itcl_bicmds.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/itcl_bicmds.c
+
+itcl_class.o: $(GENERIC_DIR)/itcl_class.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/itcl_class.c
+
+itcl_cmds.o: $(GENERIC_DIR)/itcl_cmds.c Makefile
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/itcl_cmds.c
+
+itcl_ensemble.o: $(GENERIC_DIR)/itcl_ensemble.c Makefile
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/itcl_ensemble.c
+
+itcl_linkage.o: $(GENERIC_DIR)/itcl_linkage.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/itcl_linkage.c
+
+itcl_methods.o: $(GENERIC_DIR)/itcl_methods.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/itcl_methods.c
+
+itcl_migrate.o: $(GENERIC_DIR)/itcl_migrate.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/itcl_migrate.c
+
+itcl_objects.o: $(GENERIC_DIR)/itcl_objects.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/itcl_objects.c
+
+itcl_obsolete.o: $(GENERIC_DIR)/itcl_obsolete.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/itcl_obsolete.c
+
+itcl_parse.o: $(GENERIC_DIR)/itcl_parse.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/itcl_parse.c
+
+itcl_util.o: $(GENERIC_DIR)/itcl_util.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/itcl_util.c
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
diff --git a/itcl/itcl/unix/configure b/itcl/itcl/unix/configure
new file mode 100755
index 00000000000..f8e24db65f7
--- /dev/null
+++ b/itcl/itcl/unix/configure
@@ -0,0 +1,1521 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+ac_default_prefix=/usr/local
+ac_help="$ac_help
+ --with-tcl=DIR use Tcl 8.0 binaries from DIR"
+ac_help="$ac_help
+ --with-cflags=FLAGS set compiler flags to FLAGS"
+ac_help="$ac_help
+ --enable-shared build libitcl as a shared library"
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.13"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=../generic/itcl.h
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+# RCS: $Id$
+
+ITCL_VERSION=3.0
+ITCL_MAJOR_VERSION=3
+ITCL_MINOR_VERSION=0
+ITCL_RELEASE_LEVEL=0
+VERSION=${ITCL_VERSION}
+
+ac_aux_dir=
+for ac_dir in ../../config $srcdir/../../config; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in ../../config $srcdir/../../config" 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+
+
+# -----------------------------------------------------------------------
+# Set up a new default --prefix. If a previous installation of
+# [incr Tcl] can be found searching $PATH use that directory.
+# -----------------------------------------------------------------------
+
+
+if test "x$prefix" = xNONE; then
+echo $ac_n "checking for prefix by $ac_c" 1>&6
+# Extract the first word of "tclsh", so it can be a program name with args.
+set dummy tclsh; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:572: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_path_TCLSH'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ case "$TCLSH" in
+ /*)
+ ac_cv_path_TCLSH="$TCLSH" # Let the user override the test with a path.
+ ;;
+ ?:/*)
+ ac_cv_path_TCLSH="$TCLSH" # Let the user override the test with a dos path.
+ ;;
+ *)
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_path_TCLSH="$ac_dir/$ac_word"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac
+fi
+TCLSH="$ac_cv_path_TCLSH"
+if test -n "$TCLSH"; then
+ echo "$ac_t""$TCLSH" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -n "$ac_cv_path_TCLSH"; then
+ prefix=`echo $ac_cv_path_TCLSH|sed 's%/[^/][^/]*//*[^/][^/]*$%%'`
+ fi
+fi
+
+
+if test "${prefix}" = "NONE"; then
+ prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+ exec_prefix=$prefix
+fi
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:629: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ # Account for people who put trailing slashes in PATH elements.
+ case "$ac_dir/" in
+ /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ if test -f $ac_dir/$ac_prog; then
+ if test $ac_prog = install &&
+ grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ else
+ ac_cv_path_install="$ac_dir/$ac_prog -c"
+ break 2
+ fi
+ fi
+ done
+ ;;
+ esac
+ done
+ IFS="$ac_save_IFS"
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL="$ac_cv_path_install"
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL="$ac_install_sh"
+ fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+# Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:684: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_RANLIB="ranlib"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+# -----------------------------------------------------------------------
+BUILD_DIR=`pwd`
+ITCL_SRC_DIR=`cd $srcdir/..; pwd`
+cd ${BUILD_DIR}
+
+ # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:720: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:750: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_prog_rejected=no
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -z "$CC"; then
+ case "`uname -s`" in
+ *win32* | *WIN32*)
+ # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:801: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="cl"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+ ;;
+ esac
+ fi
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:833: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 844 "configure"
+#include "confdefs.h"
+
+main(){return(0);}
+EOF
+if { (eval echo configure:849: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cc_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:875: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:880: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:889: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gcc=yes
+else
+ ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+else
+ GCC=
+fi
+
+ac_test_CFLAGS="${CFLAGS+set}"
+ac_save_CFLAGS="$CFLAGS"
+CFLAGS=
+echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:908: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ 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.
+# CYGNUS LOCAL - Actually, tcl is one level higher - a sibling of the
+# itcl directory that contains itcl proper, itk & iwidgets.
+#--------------------------------------------------------------------
+
+# Check whether --with-tcl or --without-tcl was given.
+if test "${with_tcl+set}" = set; then
+ withval="$with_tcl"
+ itcl_search=$withval
+else
+ itcl_search=`cd ../../..; ls -d \`pwd\`/tcl*/unix`
+fi
+
+
+TCL_LIB_DIR=""
+for dir in $itcl_search $exec_prefix/lib ; do
+ if test -r $dir/tclConfig.sh; then
+ TCL_LIB_DIR=$dir
+ break
+ fi
+done
+
+if test -z "$TCL_LIB_DIR"; then
+ { echo "configure: error: Can't find Tcl libraries. Use --with-tcl to specify the directory containing tclConfig.sh on your system." 1>&2; exit 1; }
+fi
+
+#--------------------------------------------------------------------
+# Read in configuration information generated by Tcl for shared
+# libraries, and arrange for it to be substituted into our
+# Makefile.
+#--------------------------------------------------------------------
+
+file=$TCL_LIB_DIR/tclConfig.sh
+. $file
+CFLAGS=$TCL_CFLAGS
+SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS
+SHLIB_LD=$TCL_SHLIB_LD
+SHLIB_LD_LIBS=$TCL_SHLIB_LD_LIBS
+SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX
+DL_LIBS=$TCL_DL_LIBS
+LD_FLAGS=$TCL_LD_FLAGS
+LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
+
+#--------------------------------------------------------------------
+# Make sure that we can find the Tcl sources, so we can include
+# the "tclInt.h" file.
+#--------------------------------------------------------------------
+
+if test ! -d "$TCL_SRC_DIR"; then
+ { echo "configure: error: Can't find Tcl source directory "$TCL_SRC_DIR". Itcl can't be built without this directory." 1>&2; exit 1; }
+fi
+
+#--------------------------------------------------------------------
+# If this is gcc, add some extra compile flags.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking whether C compiler is gcc""... $ac_c" 1>&6
+echo "configure:999: checking whether C compiler is gcc" >&5
+if eval "test \"`echo '$''{'itcl_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+ echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:1005: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # This must be in double quotes, not single quotes, because CPP may get
+ # substituted into the Makefile and "${CC-cc}" will confuse make.
+ CPP="${CC-cc} -E"
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp.
+ cat > conftest.$ac_ext <<EOF
+#line 1020 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1026: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -E -traditional-cpp"
+ cat > conftest.$ac_ext <<EOF
+#line 1037 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1043: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -nologo -E"
+ cat > conftest.$ac_ext <<EOF
+#line 1054 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1060: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+ ac_cv_prog_CPP="$CPP"
+fi
+ CPP="$ac_cv_prog_CPP"
+else
+ ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+cat > conftest.$ac_ext <<EOF
+#line 1085 "configure"
+#include "confdefs.h"
+
+#ifdef __GNUC__
+_cc_is_gcc_
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "_cc_is_gcc_" >/dev/null 2>&1; then
+ rm -rf conftest*
+ itcl_cv_prog_gcc=yes
+else
+ rm -rf conftest*
+ itcl_cv_prog_gcc=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$itcl_cv_prog_gcc" 1>&6
+
+# CYGNUS LOCAL - CFLAGS for gcc should include -g -O2
+if test -z "$CFLAGS" ; then
+if test "$itcl_cv_prog_gcc" = "yes" ; then
+ CFLAGS="-g -O2"
+else
+ CFLAGS="-O"
+fi
+fi
+# CYGNUS LOCAL - use -fwritable-strings with gcc, needed for Tcl8.1
+if test "$itcl_cv_prog_gcc" = "yes" ; then
+ CFLAGS="$CFLAGS -fwritable-strings -Wshadow -Wtraditional -Wall"
+fi
+
+echo $ac_n "checking default compiler flags""... $ac_c" 1>&6
+echo "configure:1121: checking default compiler flags" >&5
+# Check whether --with-cflags or --without-cflags was given.
+if test "${with_cflags+set}" = set; then
+ withval="$with_cflags"
+ CFLAGS="$with_cflags"
+fi
+
+
+echo "$ac_t""$CFLAGS" 1>&6
+
+if test "$TCL_CC" != "$CC" ; then
+ echo ""
+ echo "WARNING: Compiler is $CC but Tcl was compiled with $TCL_CC"
+ echo ""
+fi
+
+#--------------------------------------------------------------------
+# The statements below define a collection of symbols related to
+# building libitcl as a shared library instead of a static library.
+#--------------------------------------------------------------------
+
+# Check whether --enable-shared or --disable-shared was given.
+if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ ok=$enableval
+else
+ ok=no
+fi
+
+if test "$ok" = "yes"; then
+ if test ${TCL_SHARED_BUILD} = 0; then
+ { echo "configure: error: Tcl was not built with --enable-shared" 1>&2; exit 1; }
+ fi
+ SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+ eval "ITCL_LIB_FILE=libitcl${VERSION}${SHLIB_SUFFIX}"
+ ITCL_PKG_FILE="[file join [file dirname \$dir] ${ITCL_LIB_FILE}]"
+ MAKE_LIB="\$(SHLIB_LD) -o ${ITCL_LIB_FILE} \$(OBJS) ${SHLIB_LD_LIBS} "
+ RANLIB=":"
+else
+ SHLIB_CFLAGS=""
+ # CYGNUS LOCAL - Strip dots from library name for SunOS4, etc...
+ if test ${TCL_LIB_VERSIONS_OK} = "nodots"; then
+ ITCL_LIB_FILE="libitcl`echo ${VERSION} | tr -d .`.a"
+ else
+ eval "ITCL_LIB_FILE=libitcl${VERSION}.a"
+ fi
+ ITCL_PKG_FILE=""
+ MAKE_LIB="ar cr ${ITCL_LIB_FILE} \${OBJS}"
+fi
+
+ITCL_SH="`pwd`/itclsh"
+
+# 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
+ ITCL_BUILD_LIB_SPEC="-L`pwd` -litcl${VERSION}"
+ ITCL_LIB_SPEC="-L${exec_prefix}/lib -litcl${VERSION}"
+else
+ ITCL_BUILD_LIB_SPEC="-L`pwd` -litcl`echo ${VERSION} | tr -d .`"
+ ITCL_LIB_SPEC="-L${exec_prefix}/lib -litcl`echo ${VERSION} | tr -d .`"
+fi
+
+ITCL_LIB_FULL_PATH="`pwd`/${ITCL_LIB_FILE}"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.13"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "Makefile pkgIndex.tcl ../itclConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@TCLSH@%$TCLSH%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@RANLIB@%$RANLIB%g
+s%@CC@%$CC%g
+s%@CPP@%$CPP%g
+s%@DL_LIBS@%$DL_LIBS%g
+s%@LD_FLAGS@%$LD_FLAGS%g
+s%@MAKE_LIB@%$MAKE_LIB%g
+s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
+s%@SHLIB_LD@%$SHLIB_LD%g
+s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
+s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
+s%@LD_SEARCH_FLAGS@%$LD_SEARCH_FLAGS%g
+s%@TCL_VERSION@%$TCL_VERSION%g
+s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
+s%@TCL_LIB_DIR@%$TCL_LIB_DIR%g
+s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
+s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
+s%@TCL_LIB_FLAG@%$TCL_LIB_FLAG%g
+s%@TCL_DBGX@%$TCL_DBGX%g
+s%@TCL_DEFS@%$TCL_DEFS%g
+s%@TCL_LIBS@%$TCL_LIBS%g
+s%@TCL_SHLIB_LD_LIBS@%$TCL_SHLIB_LD_LIBS%g
+s%@TCL_SHLIB_SUFFIX@%$TCL_SHLIB_SUFFIX%g
+s%@TCL_COMPAT_OBJS@%$TCL_COMPAT_OBJS%g
+s%@TCL_CFLAGS@%$TCL_CFLAGS%g
+s%@TCL_LIB_FULL_PATH@%$TCL_LIB_FULL_PATH%g
+s%@ITCL_VERSION@%$ITCL_VERSION%g
+s%@ITCL_MAJOR_VERSION@%$ITCL_MAJOR_VERSION%g
+s%@ITCL_MINOR_VERSION@%$ITCL_MINOR_VERSION%g
+s%@ITCL_RELEASE_LEVEL@%$ITCL_RELEASE_LEVEL%g
+s%@ITCL_BUILD_LIB_SPEC@%$ITCL_BUILD_LIB_SPEC%g
+s%@ITCL_LIB_FILE@%$ITCL_LIB_FILE%g
+s%@ITCL_LIB_SPEC@%$ITCL_LIB_SPEC%g
+s%@ITCL_PKG_FILE@%$ITCL_PKG_FILE%g
+s%@ITCL_SRC_DIR@%$ITCL_SRC_DIR%g
+s%@ITCL_SH@%$ITCL_SH%g
+s%@ITCL_LIB_FULL_PATH@%$ITCL_LIB_FULL_PATH%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile pkgIndex.tcl ../itclConfig.sh"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+ case "$ac_given_INSTALL" in
+ [/$]*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ esac
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
diff --git a/itcl/itcl/unix/configure.in b/itcl/itcl/unix/configure.in
new file mode 100644
index 00000000000..c83e5f26a7e
--- /dev/null
+++ b/itcl/itcl/unix/configure.in
@@ -0,0 +1,224 @@
+dnl This file is an input file used by the GNU "autoconf" program to
+dnl generate the file "configure", which is run during [incr Tcl]
+dnl installation to configure the system for the local environment.
+
+AC_INIT(../generic/itcl.h)
+# RCS: $Id$
+
+ITCL_VERSION=3.0
+ITCL_MAJOR_VERSION=3
+ITCL_MINOR_VERSION=0
+ITCL_RELEASE_LEVEL=0
+VERSION=${ITCL_VERSION}
+
+AC_CONFIG_AUX_DIR(../../config)
+AC_PREREQ(2.0)
+
+# -----------------------------------------------------------------------
+# Set up a new default --prefix. If a previous installation of
+# [incr Tcl] can be found searching $PATH use that directory.
+# -----------------------------------------------------------------------
+
+AC_PREFIX_DEFAULT(/usr/local)
+AC_PREFIX_PROGRAM(tclsh)
+
+if test "${prefix}" = "NONE"; then
+ prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+ exec_prefix=$prefix
+fi
+
+AC_PROG_INSTALL
+AC_PROG_RANLIB
+
+# -----------------------------------------------------------------------
+BUILD_DIR=`pwd`
+ITCL_SRC_DIR=`cd $srcdir/..; pwd`
+cd ${BUILD_DIR}
+
+dnl CYGNUS LOCAL: allow gcc without a special flag
+dnl AC_ARG_ENABLE(gcc, [ --enable-gcc allow use of gcc if available],
+dnl [itcl_ok=$enableval], [itcl_ok=no])
+dnl if test "$itcl_ok" = "yes"; then
+ AC_PROG_CC
+dnl else
+dnl CC=${CC-cc}
+dnl AC_SUBST(CC)
+dnl fi
+dnl END CYGNUS LOCAL
+
+#--------------------------------------------------------------------
+# 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.
+# CYGNUS LOCAL - Actually, tcl is one level higher - a sibling of the
+# itcl directory that contains itcl proper, itk & iwidgets.
+#--------------------------------------------------------------------
+
+dnl CYGNUS LOCAL: We just call the Tcl directory "tcl", not "tcl8.0"
+AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.0 binaries from DIR],
+ itcl_search=$withval, itcl_search=`cd ../../..; ls -d \`pwd\`/tcl*/unix`)
+dnl END CYGNUS LOCAL
+
+TCL_LIB_DIR=""
+dnl CYGNUS LOCAL: Look in the local tree FIRST, not the install directory...
+for dir in $itcl_search $exec_prefix/lib ; do
+ if test -r $dir/tclConfig.sh; then
+ TCL_LIB_DIR=$dir
+ break
+ fi
+done
+
+if test -z "$TCL_LIB_DIR"; then
+ AC_MSG_ERROR(Can't find Tcl libraries. Use --with-tcl to specify the directory containing tclConfig.sh on your system.)
+fi
+
+#--------------------------------------------------------------------
+# Read in configuration information generated by Tcl for shared
+# libraries, and arrange for it to be substituted into our
+# Makefile.
+#--------------------------------------------------------------------
+
+file=$TCL_LIB_DIR/tclConfig.sh
+. $file
+CFLAGS=$TCL_CFLAGS
+SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS
+SHLIB_LD=$TCL_SHLIB_LD
+SHLIB_LD_LIBS=$TCL_SHLIB_LD_LIBS
+SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX
+DL_LIBS=$TCL_DL_LIBS
+LD_FLAGS=$TCL_LD_FLAGS
+LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
+
+#--------------------------------------------------------------------
+# Make sure that we can find the Tcl sources, so we can include
+# the "tclInt.h" file.
+#--------------------------------------------------------------------
+
+if test ! -d "$TCL_SRC_DIR"; then
+ AC_MSG_ERROR(Can't find Tcl source directory "$TCL_SRC_DIR". Itcl can't be built without this directory.)
+fi
+
+#--------------------------------------------------------------------
+# If this is gcc, add some extra compile flags.
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING([whether C compiler is gcc])
+AC_CACHE_VAL(itcl_cv_prog_gcc, [
+ AC_EGREP_CPP(_cc_is_gcc_, [
+#ifdef __GNUC__
+_cc_is_gcc_
+#endif
+], [itcl_cv_prog_gcc=yes], [itcl_cv_prog_gcc=no])])
+AC_MSG_RESULT([$itcl_cv_prog_gcc])
+
+# CYGNUS LOCAL - CFLAGS for gcc should include -g -O2
+if test -z "$CFLAGS" ; then
+if test "$itcl_cv_prog_gcc" = "yes" ; then
+ CFLAGS="-g -O2"
+else
+ CFLAGS="-O"
+fi
+fi
+# CYGNUS LOCAL - use -fwritable-strings with gcc, needed for Tcl8.1
+if test "$itcl_cv_prog_gcc" = "yes" ; then
+ CFLAGS="$CFLAGS -fwritable-strings -Wshadow -Wtraditional -Wall"
+fi
+
+AC_MSG_CHECKING([default compiler flags])
+AC_ARG_WITH(cflags, [ --with-cflags=FLAGS set compiler flags to FLAGS],
+ [CFLAGS="$with_cflags"])
+
+AC_MSG_RESULT([$CFLAGS])
+
+if test "$TCL_CC" != "$CC" ; then
+ echo ""
+ echo "WARNING: Compiler is $CC but Tcl was compiled with $TCL_CC"
+ echo ""
+fi
+
+#--------------------------------------------------------------------
+# The statements below define a collection of symbols related to
+# building libitcl as a shared library instead of a static library.
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(shared,
+ [ --enable-shared build libitcl as a shared library],
+ [ok=$enableval], [ok=no])
+if test "$ok" = "yes"; then
+ if test ${TCL_SHARED_BUILD} = 0; then
+ AC_MSG_ERROR(Tcl was not built with --enable-shared, so you can't use shared libraries.)
+ fi
+ SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+ eval "ITCL_LIB_FILE=libitcl${VERSION}${SHLIB_SUFFIX}"
+ ITCL_PKG_FILE="[[file join [file dirname \$dir] ${ITCL_LIB_FILE}]]"
+ MAKE_LIB="\$(SHLIB_LD) -o ${ITCL_LIB_FILE} \$(OBJS) ${SHLIB_LD_LIBS} "
+ RANLIB=":"
+else
+ SHLIB_CFLAGS=""
+ # CYGNUS LOCAL - Strip dots from library name for SunOS4, etc...
+ if test ${TCL_LIB_VERSIONS_OK} = "nodots"; then
+ ITCL_LIB_FILE="libitcl`echo ${VERSION} | tr -d .`.a"
+ else
+ eval "ITCL_LIB_FILE=libitcl${VERSION}.a"
+ fi
+ ITCL_PKG_FILE=""
+ MAKE_LIB="ar cr ${ITCL_LIB_FILE} \${OBJS}"
+fi
+
+ITCL_SH="`pwd`/itclsh"
+
+# 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
+ ITCL_BUILD_LIB_SPEC="-L`pwd` -litcl${VERSION}"
+ ITCL_LIB_SPEC="-L${exec_prefix}/lib -litcl${VERSION}"
+else
+ ITCL_BUILD_LIB_SPEC="-L`pwd` -litcl`echo ${VERSION} | tr -d .`"
+ ITCL_LIB_SPEC="-L${exec_prefix}/lib -litcl`echo ${VERSION} | tr -d .`"
+fi
+
+ITCL_LIB_FULL_PATH="`pwd`/${ITCL_LIB_FILE}"
+
+AC_SUBST(CFLAGS)
+AC_SUBST(DL_LIBS)
+AC_SUBST(LD_FLAGS)
+AC_SUBST(MAKE_LIB)
+AC_SUBST(SHLIB_CFLAGS)
+AC_SUBST(SHLIB_LD)
+AC_SUBST(SHLIB_LD_LIBS)
+AC_SUBST(SHLIB_SUFFIX)
+AC_SUBST(LD_SEARCH_FLAGS)
+
+AC_SUBST(TCL_VERSION)
+AC_SUBST(TCL_SRC_DIR)
+AC_SUBST(TCL_LIB_DIR)
+AC_SUBST(TCL_LIB_SPEC)
+AC_SUBST(TCL_BUILD_LIB_SPEC)
+AC_SUBST(TCL_LIB_FLAG)
+AC_SUBST(TCL_DBGX)
+AC_SUBST(TCL_DEFS)
+AC_SUBST(TCL_LIBS)
+AC_SUBST(TCL_SHLIB_LD_LIBS)
+AC_SUBST(TCL_SHLIB_SUFFIX)
+AC_SUBST(TCL_COMPAT_OBJS)
+AC_SUBST(TCL_CFLAGS)
+AC_SUBST(TCL_LIB_FULL_PATH)
+
+AC_SUBST(ITCL_VERSION)
+AC_SUBST(ITCL_MAJOR_VERSION)
+AC_SUBST(ITCL_MINOR_VERSION)
+AC_SUBST(ITCL_RELEASE_LEVEL)
+
+AC_SUBST(ITCL_BUILD_LIB_SPEC)
+AC_SUBST(ITCL_LIB_FILE)
+AC_SUBST(ITCL_LIB_SPEC)
+AC_SUBST(ITCL_PKG_FILE)
+AC_SUBST(ITCL_SRC_DIR)
+AC_SUBST(ITCL_SH)
+AC_SUBST(ITCL_LIB_FULL_PATH)
+
+AC_OUTPUT(Makefile pkgIndex.tcl ../itclConfig.sh)
diff --git a/itcl/itcl/unix/pkgIndex.tcl.in b/itcl/itcl/unix/pkgIndex.tcl.in
new file mode 100644
index 00000000000..33808f1d411
--- /dev/null
+++ b/itcl/itcl/unix/pkgIndex.tcl.in
@@ -0,0 +1,3 @@
+# Tcl package index file, version 1.0
+
+package ifneeded Itcl @ITCL_VERSION@ [list load "@ITCL_PKG_FILE@" Itcl]
diff --git a/itcl/itcl/unix/tclAppInit.c b/itcl/itcl/unix/tclAppInit.c
new file mode 100644
index 00000000000..4835f6cd1fa
--- /dev/null
+++ b/itcl/itcl/unix/tclAppInit.c
@@ -0,0 +1,157 @@
+/*
+ * tclAppInit.c --
+ *
+ * Provides a default version of the main program and Tcl_AppInit
+ * procedure for Tcl applications (without Tk).
+ *
+ * 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.
+ *
+ * SCCS: @(#) tclAppInit.c 1.20 97/03/24 14:29:43
+ */
+
+#ifdef TCL_XT_TEST
+#include <X11/Intrinsic.h>
+#endif
+
+/* include tclInt.h for access to namespace API */
+#include "tclInt.h"
+
+#include "itcl.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 TCL_TEST
+EXTERN int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#endif /* TCL_TEST */
+#ifdef TCL_XT_TEST
+EXTERN int Tclxttest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ * This is the main program for the application.
+ *
+ * Results:
+ * None: Tcl_Main never returns here, so this procedure never
+ * returns either.
+ *
+ * Side effects:
+ * Whatever the application does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+main(argc, argv)
+ int argc; /* Number of command-line arguments. */
+ char **argv; /* Values of command-line arguments. */
+{
+#ifdef TCL_XT_TEST
+ XtToolkitInitialize();
+#endif
+ Tcl_Main(argc, argv, Tcl_AppInit);
+ return 0; /* Needed only to prevent compiler warning. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppInit(interp)
+ Tcl_Interp *interp; /* Interpreter for application. */
+{
+ if (Tcl_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+#ifdef TCL_TEST
+#ifdef TCL_XT_TEST
+ if (Tclxttest_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+#endif
+ 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 */
+
+ /*
+ * Call the init procedures for included packages. Each call should
+ * look like this:
+ *
+ * if (Mod_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * where "Mod" is the name of the module.
+ */
+ if (Itcl_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Itcl", Itcl_Init, Itcl_SafeInit);
+
+ /*
+ * This is itclsh, so import all [incr Tcl] commands by
+ * default into the global namespace. Fix up the autoloader
+ * to do the same.
+ */
+ if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
+ "::itcl::*", /* allowOverwrite */ 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_Eval(interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* }") != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Call Tcl_CreateCommand for application-specific commands, if
+ * they weren't already created by the init procedures called above.
+ */
+
+ /*
+ * Specify a user-specific startup file to invoke if the application
+ * is run interactively. Typically the startup file is "~/.apprc"
+ * where "app" is the name of the application. If this line is deleted
+ * then no user-specific startup file will be run under any conditions.
+ */
+
+ Tcl_SetVar(interp, "tcl_rcFileName", "~/.itclshrc", TCL_GLOBAL_ONLY);
+ return TCL_OK;
+}
diff --git a/itcl/itcl/win/Makefile.in b/itcl/itcl/win/Makefile.in
new file mode 100644
index 00000000000..a9cb288f6da
--- /dev/null
+++ b/itcl/itcl/win/Makefile.in
@@ -0,0 +1,404 @@
+# This file is CYGNUS LOCAL. It is a copy of makefile.vc modified for
+# GNU make.
+#
+# Visual C++ 4.0 makefile
+#
+# Copyright (c) 1993-1996 Lucent Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+VPATH = @srcdir@:@srcdir@/../generic:@srcdir@/../unix
+srcdir = @srcdir@
+
+CC = @CC@
+CFLAGS = @CFLAGS@
+NM = @NM@
+AS = @AS@
+LD = @LD@
+DLLTOOL = @DLLTOOL@
+WINDRES = @WINDRES@
+OBJEXT = @OBJEXT@
+
+DLL_LDFLAGS = @DLL_LDFLAGS@
+DLL_LDLIBS = @DLL_LDLIBS@
+
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+#
+# Project directories
+#
+# ROOT = top of source tree
+#
+# TMPDIR = location where .obj files should be stored during build
+#
+
+ROOT = @ITCL_SRC_DIR@
+TMPDIR = .
+TCLDIR = @TCL_SRC_DIR@
+
+TCLLIBDIR = @TCL_BIN_DIR@
+
+SRC_INC_DIR = $(ROOT)/generic
+SRC_WIN_DIR = $(ROOT)/win
+SRC_UNIX_DIR = $(ROOT)/unix
+SRC_MAN_DIR = $(ROOT)/doc
+
+ITCL_VERSION = @ITCL_VERSION@
+VERSION = 30
+
+CYGITCLLIB = @CYGITCLLIB@
+CYGITCLDLL = @CYGITCLDLL@
+CYGITCLSH = @CYGITCLSH@
+CYGITCLDEF = @CYGITCLDEF@
+CYGITCLTEST = @CYGITCLTEST@
+CYGIMPORTLIB = @CYGIMPORTLIB@
+CYGITCLRES = @CYGITCLRES@
+CYGITCLSHRES = @CYGITCLSHRES@
+
+SNITCLLIB = @SNITCLLIB@
+SNITCLDLL = @SNITCLDLL@
+SNITCLSH = @SNITCLSH@
+SNITCLDEF = @SNITCLDEF@
+SNITCLTEST = @SNITCLTEST@
+SNIMPORTLIB = @SNIMPORTLIB@
+SNITCLRES = @SNITCLRES@
+SNITCLSHRES = @SNITCLSHRES@
+
+ITCLLIB = @ITCLLIB@
+ITCLDLL = @ITCLDLL@
+ITCLSH = @ITCLSH@
+ITCLDEF = @ITCLDEF@
+ITCLTEST = @ITCLTEST@
+ITCLIMPORTLIB = @ITCLIMPORTLIB@
+ITCLRES = @ITCLRES@
+ITCLSHRES = @ITCLSHRES@
+
+
+# Directory in which to install the library of Itcl scripts and demos
+# (note: you can set the ITCL_LIBRARY environment variable at run-time to
+# override the compiled-in location):
+ITCL_LIBRARY = $(prefix)/share/itcl$(ITCL_VERSION)
+
+# CYGNUS LOCAL: dj - use @dir@ form
+
+# Directory in which to install the archive libitcl.a:
+INSTALL_LIB_DIR = @libdir@
+
+# Directory in which to install the program itclsh:
+INSTALL_BIN_DIR = @bindir@
+
+# Directory in which to install the include file itcl.h:
+INSTALL_INCLUDE_DIR = @includedir@
+
+# Top-level directory for manual entries:
+INSTALL_MAN_DIR = @mandir@
+
+# Directory in which to install manual entry for itclsh:
+INSTALL_MAN1_DIR = $(INSTALL_MAN_DIR)/man1
+
+# Directory in which to install manual entries for Itcl's C library
+# procedures:
+INSTALL_MAN3_DIR = $(INSTALL_MAN_DIR)/man3
+
+# Directory in which to install manual entries for the built-in
+# Tcl commands implemented by Itcl:
+INSTALL_MANN_DIR = $(INSTALL_MAN_DIR)/mann
+
+
+# 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
+
+
+ITCLSHOBJS = \
+ $(TMPDIR)/tclAppInit.$(OBJEXT)
+
+ITCLOBJS = \
+ $(TMPDIR)/itcl_bicmds.$(OBJEXT) \
+ $(TMPDIR)/itcl_class.$(OBJEXT) \
+ $(TMPDIR)/itcl_cmds.$(OBJEXT) \
+ $(TMPDIR)/itcl_ensemble.$(OBJEXT) \
+ $(TMPDIR)/itcl_linkage.$(OBJEXT) \
+ $(TMPDIR)/itcl_methods.$(OBJEXT) \
+ $(TMPDIR)/itcl_migrate.$(OBJEXT) \
+ $(TMPDIR)/itcl_objects.$(OBJEXT) \
+ $(TMPDIR)/itcl_obsolete.$(OBJEXT) \
+ $(TMPDIR)/itcl_parse.$(OBJEXT) \
+ $(TMPDIR)/itcl_util.$(OBJEXT) \
+ $(TMPDIR)/dllEntryPoint.$(OBJEXT)
+
+DUMPEXTS = $(TCLLIBDIR)/dumpexts.exe
+
+TCLLIB = @TCL_LIB_FILE@
+TCL_BUILD_LIB_SPEC = @TCL_BUILD_LIB_SPEC@
+TCL_LIB_FULL_PATH = @TCL_LIB_FULL_PATH@
+
+ITCL_INCLUDES = -I$(SRC_WIN_DIR) -I$(SRC_INC_DIR) -I$(TCLDIR)/generic -I$(TCLDIR)/win
+
+ITCL_DEFINES = -D__WIN32__ $(DEBUGDEFINES) -DDLL_BUILD -DBUILD_itcl -D_DLL
+ITCL_CFLAGS = $(ITCL_INCLUDES) $(ITCL_DEFINES) $(CFLAGS)
+
+CPU = i386
+
+######################################################################
+# Link flags
+######################################################################
+
+conlflags = -Wl,--subsystem,console -mwindows
+guilflags = -mwindows
+dlllflags =
+
+baselibs = @BASELIBS@
+winlibs = @WINLIBS@
+libcdll = @LIBCDLL@
+
+guilibs = $(baselibs) $(winlibs)
+conlibs = $(baselibs)
+guilibsdll = $(libcdll) $(baselibs) $(winlibs)
+conlibsdll = $(libcdll) $(baselibs)
+
+#
+# Targets
+#
+
+release: $(ITCLDLL) $(ITCLSH)
+all: $(ITCLDLL) $(ITCLSH)
+test: $(ITCLSH)
+ $(CP) $(TCLLIBDIR)\*.dll
+ $(ITCLSH) <<
+ cd ../tests
+ source all
+
+# Cygwin-specific targets.
+
+$(TMPDIR)/$(CYGITCLDEF): $(ITCLOBJS)
+ echo 'EXPORTS' > tmp.def
+ -for o in $(ITCLOBJS); do \
+ $(NM) --extern-only --defined-only $$o | sed -e 's/[^ ]* [^ ]* //' -e 's/^_//' | fgrep -v DllEntryPoint | fgrep -v DllMain | fgrep -v impure_ptr >> tmp.def; \
+ done
+ mv tmp.def $(TMPDIR)/$(CYGITCLDEF)
+
+$(CYGITCLDLL): $(ITCLOBJS) $(TMPDIR)/$(CYGITCLDEF) $(TMPDIR)/$(CYGITCLRES)
+ $(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,itcl.base \
+ -o $(CYGITCLDLL) $(ITCLOBJS) $(TMPDIR)/$(CYGITCLRES) \
+ $(TCLLIBDIR)/$(TCLLIB) \
+ $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 \
+ -Wl,--image-base,0x66700000
+ $(DLLTOOL) --as=$(AS) --dllname $(CYGITCLDLL) --def $(TMPDIR)/$(CYGITCLDEF) \
+ --base-file itcl.base --output-exp itcl.exp
+ $(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,itcl.base -Wl,itcl.exp \
+ -o $(CYGITCLDLL) $(ITCLOBJS) \
+ $(TCLLIBDIR)/$(TCLLIB) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 \
+ -Wl,--image-base,0x66700000
+ $(DLLTOOL) --as=$(AS) --dllname $(CYGITCLDLL) --def $(TMPDIR)/$(CYGITCLDEF) \
+ --base-file itcl.base --output-exp itcl.exp
+ $(CC) $(DLL_LDFLAGS) -Wl,itcl.exp -o $(CYGITCLDLL) $(ITCLOBJS) \
+ $(TCLLIBDIR)/$(TCLLIB) \
+ $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 \
+ -Wl,--image-base,0x66700000
+
+$(CYGITCLLIB): $(TMPDIR)/$(CYGITCLDEF)
+ $(DLLTOOL) --as=$(AS) --dllname $(CYGITCLDLL) --def $(TMPDIR)/$(CYGITCLDEF) \
+ --output-lib $(CYGITCLLIB)
+
+$(CYGITCLSH): $(ITCLSHOBJS) $(CYGITCLLIB) $(TMPDIR)/$(CYGITCLSHRES)
+ $(CC) $(linkdebug) $(conlflags) -Wl,--stack=0x2300000 \
+ $(ITCL_CFLAGS) \
+ $(ITCLSHOBJS) $(TMPDIR)/$(CYGITCLSHRES) \
+ $(CYGITCLLIB) $(TCLLIBDIR)/$(TCLLIB) $(conlibsdll) \
+ -o $(CYGITCLSH)
+
+$(CYGITCLTEST): $(ITCLTESTOBJS) $(CYGITCLLIB) $(TMPDIR)/$(CYGITCLSHRES)
+ $(CC) $(linkdebug) $(conlflags) -Wl,--stack=0x2300000 \
+ $(ITCL_CFLAGS) \
+ $(ITCLTESTOBJS) $(TMPDIR)/$(CYGITCLSHRES) \
+ $(CYGITCLLIB) $(TCLLIBDIR)/$(TCLLIB) $(conlibsdll) \
+ -o $(CYGITCLTEST)
+
+$(TMPDIR)/$(CYGITCLSHRES):: $(ROOT)/win/itclsh.rc
+ $(WINDRES) --include $(TCLDIR)/generic --include $(srcdir)/../generic \
+ --define VS_VERSION_INFO=1 $(srcdir)/itclsh.rc $(TMPDIR)/$(CYGITCLSHRES)
+
+$(TMPDIR)/$(CYGITCLRES):: $(ROOT)/win/itcl.rc
+ $(WINDRES) --include $(TCDIR)/generic --include $(srcdir)/../generic \
+ --define VS_VERSION_INFO=1 $(srcdir)/itcl.rc $(TMPDIR)/$(CYGITCLRES)
+
+# Visual C++ specific targets
+$(TMPDIR)/$(SNITCLDEF): $(DUMPEXTS) $(ITCLOBJS)
+ $(DUMPEXTS) -o $@ $(SNITCLDLL) $(ITCLOBJS)
+
+$(SNITCLDLL): $(ITCLOBJS) $(TMPDIR)/$(SNITCLDEF) $(TMPDIR)/$(SNITCLRES) $(TCL_LIB_FULL_PATH)
+ link.exe -DEBUG -dll -def:$(TMPDIR)/$(SNITCLDEF) -NODEFAULTLIB \
+ -out:$(SNITCLDLL) $(guilibsdll) $(ITCLOBJS) $(TMPDIR)/$(SNITCLRES) \
+ $(TCL_BUILD_LIB_SPEC)
+
+$(SNITCLLIB) $(SNIMPORTLIB):
+ cp $(SNIMPORTLIB) $(SNITCLLIB)
+
+$(SNITCLSH): $(ITCLSHOBJS) $(SNITCLLIB) $(TMPDIR)/$(SNITCLSHRES) $(TCL_LIB_FULL_PATH)
+ link.exe -DEBUG -NODEFAULTLIB -entry:mainCRTStartup \
+ -out:$@ $(conlibsdll) $(ITCLSHOBJS) $(TMPDIR)/$(SNITCLSHRES) \
+ $(SNITCLLIB) $(TCL_BUILD_LIB_SPEC)
+
+$(SNITCLTEST): $(ITCLTESTOBJS) $(SNITCLLIB) $(TMPDIR)/$(SNITCLSHRES) $(TCL_LIB_FULL_PATH)
+ link.exe -DEBUG -NODEFAULTLIB -entry:mainCRTStartup \
+ -out $@ $(conlibsdll) $(ITCLSHOBJS) $(TMPDIR)/$(SNITCLSHRES) \
+ $(SNITCLLIB) $(TCL_BUILD_LIB_SPEC)
+
+$(TMPDIR)/$(SNITCLSHRES):: $(SRC_WIN_DIR)/itclsh.rc
+ rc $(ITCL_INCLUDES) -d__WIN32__ -dVS_VERSION_INFO=1 -fo$@ $?
+
+$(TMPDIR)/$(SNITCLRES):: $(SRC_WIN_DIR)/itcl.rc
+ rc $(ITCL_INCLUDES) -d__WIN32__ -dVS_VERSION_INFO=1 -fo$@ $?
+
+#
+# Special case object file targets
+#
+
+$(TMPDIR)/testMain.$(OBJEXT):: $(SRC_WIN_DIR)/tclAppInit.c
+ $(CC) -c $(ITCL_CFLAGS) -DTCL_TEST -DSTATIC_BUILD $(CFLAGS) -o $@ $?
+
+$(TMPDIR)/tclAppInit.$(OBJEXT): $(SRC_WIN_DIR)/tclAppInit.c
+ $(CC) -c $(ITCL_CFLAGS) $(CFLAGS) -DSTATIC_BUILD -o $@ $?
+
+#$(DUMPEXTS): $(TCLDIR)\win\winDumpExts.c
+# $(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $?
+# set LIB=$(TOOLS32)\lib
+# $(link32) $(ldebug) $(conlflags) $(guilibs) -out:$@ \
+# $(TMPDIR)\winDumpExts.obj
+
+#
+# Implicit rules
+#
+
+$(TMPDIR)/%.$(OBJEXT):: $(SRC_INC_DIR)/%.c
+ $(CC) -c $(ITCL_CFLAGS) -o $@ $<
+
+$(TMPDIR)/%.$(OBJEXT):: $(SRC_WIN_DIR)/%.c
+ $(CC) -c $(ITCL_CFLAGS) -o $@ $<
+
+clean:
+
+ rm -f $(TMPDIR)/*.$(OBJEXT) $(TMPDIR)/*.exp $(TMPDIR)/*.def
+ rm -f $(ITCLLIB) $(ITCLDLL) $(ITCLDLL) $(ITCLSH)
+
+
+Makefile: $(srcdir)/Makefile.in config.status
+ $(SHELL) config.status
+
+config.status: $(srcdir)/configure
+ ./config.status --recheck
+
+#----------------------------------------------------------------------
+#
+# Installation
+#
+#----------------------------------------------------------------------
+
+
+install:: install-basic install-binaries
+ @echo done
+
+install-binaries::
+ @for i in $(INSTALL_LIB_DIR) $(INSTALL_BIN_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing $(CYGITCLLIB) as $(INSTALL_LIB_DIR)/$(CYGITCLLIB)"
+ @$(INSTALL_DATA) $(CYGITCLLIB) $(INSTALL_LIB_DIR)/$(CYGITCLLIB)
+ @echo "Installing $(CYGITCLSH) as $(INSTALL_BIN_DIR)/$(CYGITCLSH)"
+ @$(INSTALL_PROGRAM) $(CYGITCLSH) $(INSTALL_BIN_DIR)/$(CYGITCLSH)
+ @echo "Installing $(CYGITCLDLL) as $(INSTALL_BIN_DIR)/$(CYGITCLDLL)"
+ @$(INSTALL_PROGRAM) $(CYGITCLDLL) $(INSTALL_BIN_DIR)/$(CYGITCLDLL)
+
+#
+# Basic installtion
+#
+install-basic:: install-libraries install-headers \
+ install-man
+
+
+install-headers:
+ @for i in $(INSTALL_INCLUDE_DIR); \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @for i in $(SRC_INC_DIR)/itcl.h; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(INSTALL_INCLUDE_DIR); \
+ done;
+
+install-libraries:
+ @for i in $(prefix)/lib $(ITCL_LIBRARY); \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing pkgIndex.tcl"
+ @$(INSTALL_DATA) $(srcdir)/pkgIndex.tcl $(ITCL_LIBRARY)
+ @$(INSTALL_DATA) $(srcdir)/../library/itcl.tcl $(ITCL_LIBRARY)
+
+
+install-man:
+ @for i in $(INSTALL_MAN_DIR) $(INSTALL_MAN1_DIR) \
+ $(INSTALL_MAN3_DIR) $(INSTALL_MANN_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @cd $(SRC_MAN_DIR); for i in *.n ; \
+ do \
+ echo "Installing doc/$$i"; \
+ rm -f $(INSTALL_MANN_DIR)/$$i; \
+ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+ $$i > $(INSTALL_MANN_DIR)/$$i; \
+ chmod 444 $(INSTALL_MANN_DIR)/$$i; \
+ done; \
+ for i in *.1 ; \
+ do \
+ echo "Installing doc/$$i"; \
+ rm -f $(INSTALL_MAN1_DIR)/$$i; \
+ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+ $$i > $(INSTALL_MAN1_DIR)/$$i; \
+ chmod 444 $(INSTALL_MAN1_DIR)/$$i; \
+ done; \
+ for i in *.3 ; \
+ do \
+ echo "Installing doc/$$i"; \
+ rm -f $(INSTALL_MAN3_DIR)/$$i; \
+ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+ $$i > $(INSTALL_MAN3_DIR)/$$i; \
+ chmod 444 $(INSTALL_MAN3_DIR)/$$i; \
+ done;
+
+install-info info installcheck:
+
+install-minimal: install-libraries
+ @echo "Installing $(ITCLDLL) as $(INSTALL_BIN_DIR)/$(ITCLDLL)"
+ @$(INSTALL_PROGRAM) $(ITCLDLL) $(INSTALL_BIN_DIR)/$(ITCLDLL)
diff --git a/itcl/itcl/win/configure b/itcl/itcl/win/configure
new file mode 100755
index 00000000000..fa3d1cc86a3
--- /dev/null
+++ b/itcl/itcl/win/configure
@@ -0,0 +1,2781 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+ac_default_prefix=/usr/local
+ac_help="$ac_help
+ --enable-gcc allow use of gcc if available"
+ac_help="$ac_help
+ --with-tcl=DIR use Tcl 8.0 binaries from DIR"
+ac_help="$ac_help
+ --with-cflags=FLAGS set compiler flags to FLAGS"
+ac_help="$ac_help
+ --enable-shared build libitcl as a shared library"
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.13"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=../generic/itcl.h
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+
+ac_aux_dir=
+for ac_dir in ../../../ $srcdir/../../../; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in ../../../ $srcdir/../../../" 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+
+# Make sure we can run config.sub.
+if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then :
+else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking host system type""... $ac_c" 1>&6
+echo "configure:561: checking host system type" >&5
+
+host_alias=$host
+case "$host_alias" in
+NONE)
+ case $nonopt in
+ NONE)
+ if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then :
+ else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; }
+ fi ;;
+ *) host_alias=$nonopt ;;
+ esac ;;
+esac
+
+host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias`
+host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+echo "$ac_t""$host" 1>&6
+
+
+# Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:585: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_RANLIB="ranlib"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+# Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:616: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:646: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_prog_rejected=no
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -z "$CC"; then
+ case "`uname -s`" in
+ *win32* | *WIN32*)
+ # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:697: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="cl"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+ ;;
+ esac
+ fi
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:729: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 740 "configure"
+#include "confdefs.h"
+
+main(){return(0);}
+EOF
+if { (eval echo configure:745: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cc_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:771: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:776: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:785: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gcc=yes
+else
+ ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+else
+ GCC=
+fi
+
+ac_test_CFLAGS="${CFLAGS+set}"
+ac_save_CFLAGS="$CFLAGS"
+CFLAGS=
+echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:804: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+
+echo $ac_n "checking for object suffix""... $ac_c" 1>&6
+echo "configure:836: checking for object suffix" >&5
+if eval "test \"`echo '$''{'ac_cv_objext'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ rm -f conftest*
+echo 'int i = 1;' > conftest.$ac_ext
+if { (eval echo configure:842: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ for ac_file in conftest.*; do
+ case $ac_file in
+ *.c) ;;
+ *) ac_cv_objext=`echo $ac_file | sed -e s/conftest.//` ;;
+ esac
+ done
+else
+ { echo "configure: error: installation or configuration problem; compiler does not work" 1>&2; exit 1; }
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_objext" 1>&6
+OBJEXT=$ac_cv_objext
+ac_objext=$ac_cv_objext
+
+NM=${NM-nm}
+
+AS=${AS-as}
+
+LD=${LD-ld}
+
+DLLTOOL=${DLLTOOL-dlltool}
+
+WINDRES=${WINDRES-windres}
+
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:882: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ # Account for people who put trailing slashes in PATH elements.
+ case "$ac_dir/" in
+ /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ if test -f $ac_dir/$ac_prog; then
+ if test $ac_prog = install &&
+ grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ else
+ ac_cv_path_install="$ac_dir/$ac_prog -c"
+ break 2
+ fi
+ fi
+ done
+ ;;
+ esac
+ done
+ IFS="$ac_save_IFS"
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL="$ac_cv_path_install"
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL="$ac_install_sh"
+ fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+
+# needed for the subtle differences between cygwin and mingw32
+case "${host}" in
+*-*-cygwin*)
+ TCL_ALLOC_OBJ=
+ DLL_LDLIBS=-lcygwin
+ DLL_LDFLAGS='-nostartfiles -Wl,--dll'
+ ;;
+*-*-mingw32*)
+ TCL_ALLOC_OBJ='$(TMPDIR)/tclAlloc.o'
+ DLL_LDLIBS=
+ DLL_LDFLAGS='-mdll'
+ ;;
+esac
+
+
+
+ITCL_VERSION=3.0
+ITCL_MAJOR_VERSION=3
+ITCL_MINOR_VERSION=0
+VERSION=${ITCL_MAJOR_VERSION}${ITCL_MINOR_VERSION}
+
+
+if test "${prefix}" = "NONE"; then
+ prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+ exec_prefix=$prefix
+fi
+
+# -----------------------------------------------------------------------
+# Set up a new default --prefix. If a previous installation of
+# [incr Tcl] can be found searching $PATH use that directory.
+# -----------------------------------------------------------------------
+
+
+if test "x$prefix" = xNONE; then
+echo $ac_n "checking for prefix by $ac_c" 1>&6
+# Extract the first word of "itkwish", so it can be a program name with args.
+set dummy itkwish; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:975: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_path_ITKWISH'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ case "$ITKWISH" in
+ /*)
+ ac_cv_path_ITKWISH="$ITKWISH" # Let the user override the test with a path.
+ ;;
+ ?:/*)
+ ac_cv_path_ITKWISH="$ITKWISH" # Let the user override the test with a dos path.
+ ;;
+ *)
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_path_ITKWISH="$ac_dir/$ac_word"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac
+fi
+ITKWISH="$ac_cv_path_ITKWISH"
+if test -n "$ITKWISH"; then
+ echo "$ac_t""$ITKWISH" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -n "$ac_cv_path_ITKWISH"; then
+ prefix=`echo $ac_cv_path_ITKWISH|sed 's%/[^/][^/]*//*[^/][^/]*$%%'`
+ fi
+fi
+
+
+if test "${prefix}" = "NONE"; then
+ prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+ exec_prefix=$prefix
+fi
+
+# -----------------------------------------------------------------------
+BUILD_DIR=`pwd`
+ITCL_SRC_DIR=`cd $srcdir/..; pwd`
+
+if ! test "$GCC" = yes; then
+ tmp="`cygpath --windows $ITCL_SRC_DIR`"
+ ITCL_SRC_DIR="`echo $tmp | sed -e s#\\\\\\\\#/#g`"
+fi
+
+cd ${BUILD_DIR}
+
+# Check whether --enable-gcc or --disable-gcc was given.
+if test "${enable_gcc+set}" = set; then
+ enableval="$enable_gcc"
+ itcl_ok=$enableval
+else
+ itcl_ok=no
+fi
+
+if test "$itcl_ok" = "yes"; then
+ # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1043: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1073: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_prog_rejected=no
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -z "$CC"; then
+ case "`uname -s`" in
+ *win32* | *WIN32*)
+ # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1124: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="cl"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+ ;;
+ esac
+ fi
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:1156: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 1167 "configure"
+#include "confdefs.h"
+
+main(){return(0);}
+EOF
+if { (eval echo configure:1172: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cc_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:1198: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:1203: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1212: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gcc=yes
+else
+ ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+else
+ GCC=
+fi
+
+ac_test_CFLAGS="${CFLAGS+set}"
+ac_save_CFLAGS="$CFLAGS"
+CFLAGS=
+echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:1231: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+
+else
+ CC=${CC-cc}
+
+fi
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:1267: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # This must be in double quotes, not single quotes, because CPP may get
+ # substituted into the Makefile and "${CC-cc}" will confuse make.
+ CPP="${CC-cc} -E"
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp.
+ cat > conftest.$ac_ext <<EOF
+#line 1282 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1288: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -E -traditional-cpp"
+ cat > conftest.$ac_ext <<EOF
+#line 1299 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1305: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -nologo -E"
+ cat > conftest.$ac_ext <<EOF
+#line 1316 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1322: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+ ac_cv_prog_CPP="$CPP"
+fi
+ CPP="$ac_cv_prog_CPP"
+else
+ ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+for ac_hdr in unistd.h limits.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:1350: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1355 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1360: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+
+#--------------------------------------------------------------------
+# 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.
+# CYGNUS LOCAL - Actually, tcl is one level higher - a sibling of the
+# itcl directory that contains itcl proper, itk & iwidgets.
+#--------------------------------------------------------------------
+
+# Check whether --with-tcl or --without-tcl was given.
+if test "${with_tcl+set}" = set; then
+ withval="$with_tcl"
+ TCL_BIN_DIR=$withval
+else
+ TCL_BIN_DIR=`cd ../../../tcl/win; pwd`
+fi
+
+
+if test ! -f $TCL_BIN_DIR/../unix/tclConfig.sh; then
+ TCL_BIN_DIR=`cd ../../../tcl8.1/win;pwd`
+fi
+
+if test ! -f $TCL_BIN_DIR/../unix/tclConfig.sh; then
+ { echo "configure: error: There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" 1>&2; exit 1; }
+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/../unix/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
+ITCL_LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
+
+echo $ac_n "checking whether C compiler is gcc""... $ac_c" 1>&6
+echo "configure:1430: checking whether C compiler is gcc" >&5
+if eval "test \"`echo '$''{'itcl_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+ cat > conftest.$ac_ext <<EOF
+#line 1436 "configure"
+#include "confdefs.h"
+
+#ifdef __GNUC__
+_cc_is_gcc_
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "_cc_is_gcc_" >/dev/null 2>&1; then
+ rm -rf conftest*
+ itcl_cv_prog_gcc=yes
+else
+ rm -rf conftest*
+ itcl_cv_prog_gcc=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$itcl_cv_prog_gcc" 1>&6
+
+if test -z "$CFLAGS" ; then
+ CFLAGS="-O"
+fi
+if test "$itcl_cv_prog_gcc" = "yes" ; then
+ CFLAGS="$CFLAGS -Wshadow -Wtraditional -Wall"
+fi
+
+echo $ac_n "checking default compiler flags""... $ac_c" 1>&6
+echo "configure:1466: checking default compiler flags" >&5
+# Check whether --with-cflags or --without-cflags was given.
+if test "${with_cflags+set}" = set; then
+ withval="$with_cflags"
+ CFLAGS="$with_cflags"
+fi
+
+
+echo "$ac_t""$CFLAGS" 1>&6
+
+#--------------------------------------------------------------------
+# Supply a substitute for stdlib.h if it doesn't define strtol,
+# strtoul, or strtod (which it doesn't in some versions of SunOS).
+#--------------------------------------------------------------------
+
+echo $ac_n "checking stdlib.h""... $ac_c" 1>&6
+echo "configure:1482: checking stdlib.h" >&5
+cat > conftest.$ac_ext <<EOF
+#line 1484 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "strtol" >/dev/null 2>&1; then
+ rm -rf conftest*
+ itcl_ok=yes
+else
+ rm -rf conftest*
+ itcl_ok=no
+fi
+rm -f conftest*
+
+cat > conftest.$ac_ext <<EOF
+#line 1499 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "strtoul" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ itcl_ok=no
+fi
+rm -f conftest*
+
+cat > conftest.$ac_ext <<EOF
+#line 1513 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "strtod" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ itcl_ok=no
+fi
+rm -f conftest*
+
+if test $itcl_ok = no; then
+ cat >> confdefs.h <<\EOF
+#define NO_STDLIB_H 1
+EOF
+
+fi
+echo "$ac_t""$itcl_ok" 1>&6
+
+#--------------------------------------------------------------------
+# Check for various typedefs and provide substitutes if
+# they don't exist.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6
+echo "configure:1540: checking for ANSI C header files" >&5
+if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1545 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1553: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ ac_cv_header_stdc=yes
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+if test $ac_cv_header_stdc = yes; then
+ # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+cat > conftest.$ac_ext <<EOF
+#line 1570 "configure"
+#include "confdefs.h"
+#include <string.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "memchr" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+ # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+cat > conftest.$ac_ext <<EOF
+#line 1588 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "free" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+ # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+if test "$cross_compiling" = yes; then
+ :
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1609 "configure"
+#include "confdefs.h"
+#include <ctype.h>
+#define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+#define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int main () { int i; for (i = 0; i < 256; i++)
+if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2);
+exit (0); }
+
+EOF
+if { (eval echo configure:1620: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ :
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_header_stdc=no
+fi
+rm -fr conftest*
+fi
+
+fi
+fi
+
+echo "$ac_t""$ac_cv_header_stdc" 1>&6
+if test $ac_cv_header_stdc = yes; then
+ cat >> confdefs.h <<\EOF
+#define STDC_HEADERS 1
+EOF
+
+fi
+
+echo $ac_n "checking for mode_t""... $ac_c" 1>&6
+echo "configure:1644: checking for mode_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_mode_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1649 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "(^|[^a-zA-Z_0-9])mode_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_mode_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_mode_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_mode_t" 1>&6
+if test $ac_cv_type_mode_t = no; then
+ cat >> confdefs.h <<\EOF
+#define mode_t int
+EOF
+
+fi
+
+echo $ac_n "checking for pid_t""... $ac_c" 1>&6
+echo "configure:1677: checking for pid_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_pid_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1682 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "(^|[^a-zA-Z_0-9])pid_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_pid_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_pid_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_pid_t" 1>&6
+if test $ac_cv_type_pid_t = no; then
+ cat >> confdefs.h <<\EOF
+#define pid_t int
+EOF
+
+fi
+
+echo $ac_n "checking for size_t""... $ac_c" 1>&6
+echo "configure:1710: checking for size_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1715 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "(^|[^a-zA-Z_0-9])size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_size_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_size_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_size_t" 1>&6
+if test $ac_cv_type_size_t = no; then
+ cat >> confdefs.h <<\EOF
+#define size_t unsigned
+EOF
+
+fi
+
+echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6
+echo "configure:1743: checking for uid_t in sys/types.h" >&5
+if eval "test \"`echo '$''{'ac_cv_type_uid_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1748 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "uid_t" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_uid_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_uid_t=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_type_uid_t" 1>&6
+if test $ac_cv_type_uid_t = no; then
+ cat >> confdefs.h <<\EOF
+#define uid_t int
+EOF
+
+ cat >> confdefs.h <<\EOF
+#define gid_t int
+EOF
+
+fi
+
+
+#--------------------------------------------------------------------
+# 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
+# "gethostbyname" to check for -lnsl.
+# 2. Use each function name only once: can't redo a check because
+# autoconf caches the results of the last check and won't redo it.
+# 3. Use -lnsl and -lsocket only if they supply procedures that
+# aren't already present in the normal libraries. This is because
+# IRIX 5.2 has libraries, but they aren't needed and they're
+# bogus: they goof up name resolution if used.
+# 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+# To get around this problem, check for both libraries together
+# if -lsocket doesn't work by itself.
+#--------------------------------------------------------------------
+
+itcl_checkBoth=0
+echo $ac_n "checking for connect""... $ac_c" 1>&6
+echo "configure:1797: checking for connect" >&5
+if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1802 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char connect(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char connect();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_connect) || defined (__stub___connect)
+choke me
+#else
+connect();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1825: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_connect=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_connect=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'connect`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ itcl_checkSocket=0
+else
+ echo "$ac_t""no" 1>&6
+itcl_checkSocket=1
+fi
+
+if test "$itcl_checkSocket" = 1; then
+ echo $ac_n "checking for main in -lsocket""... $ac_c" 1>&6
+echo "configure:1847: checking for main in -lsocket" >&5
+ac_lib_var=`echo socket'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lsocket $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1855 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:1862: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ LIBS="$LIBS -lsocket"
+else
+ echo "$ac_t""no" 1>&6
+itcl_checkBoth=1
+fi
+
+fi
+if test "$itcl_checkBoth" = 1; then
+ itcl_oldLibs=$LIBS
+ LIBS="$LIBS -lsocket -lnsl"
+ echo $ac_n "checking for accept""... $ac_c" 1>&6
+echo "configure:1888: checking for accept" >&5
+if eval "test \"`echo '$''{'ac_cv_func_accept'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1893 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char accept(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char accept();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_accept) || defined (__stub___accept)
+choke me
+#else
+accept();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1916: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_accept=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_accept=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'accept`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ itcl_checkNsl=0
+else
+ echo "$ac_t""no" 1>&6
+LIBS=$itcl_oldLibs
+fi
+
+fi
+echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6
+echo "configure:1938: checking for gethostbyname" >&5
+if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1943 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char gethostbyname(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char gethostbyname();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_gethostbyname) || defined (__stub___gethostbyname)
+choke me
+#else
+gethostbyname();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1966: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_gethostbyname=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_gethostbyname=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+echo $ac_n "checking for main in -lnsl""... $ac_c" 1>&6
+echo "configure:1984: checking for main in -lnsl" >&5
+ac_lib_var=`echo nsl'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lnsl $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1992 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:1999: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ LIBS="$LIBS -lnsl"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+fi
+
+
+#--------------------------------------------------------------------
+# On a few very rare systems, all of the libm.a stuff is
+# already in libc.a. Set compiler flags accordingly.
+# Also, Linux requires the "ieee" library for math to
+# work right (and it must appear before "-lm").
+#--------------------------------------------------------------------
+
+MATH_LIBS=""
+echo $ac_n "checking for sin""... $ac_c" 1>&6
+echo "configure:2031: checking for sin" >&5
+if eval "test \"`echo '$''{'ac_cv_func_sin'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2036 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char sin(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char sin();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_sin) || defined (__stub___sin)
+choke me
+#else
+sin();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2059: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_sin=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_sin=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'sin`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+MATH_LIBS="-lm"
+fi
+
+echo $ac_n "checking for main in -lieee""... $ac_c" 1>&6
+echo "configure:2080: checking for main in -lieee" >&5
+ac_lib_var=`echo ieee'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lieee $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2088 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:2095: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ MATH_LIBS="-lieee $MATH_LIBS"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+#--------------------------------------------------------------------
+# If this system doesn't have a memmove procedure, use memcpy
+# instead.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for memmove""... $ac_c" 1>&6
+echo "configure:2122: checking for memmove" >&5
+if eval "test \"`echo '$''{'ac_cv_func_memmove'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2127 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char memmove(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char memmove();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_memmove) || defined (__stub___memmove)
+choke me
+#else
+memmove();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2150: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_memmove=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_memmove=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'memmove`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define memmove memcpy
+EOF
+
+fi
+
+
+#--------------------------------------------------------------------
+# Figure out whether "char" is unsigned. If so, set a
+# #define for __CHAR_UNSIGNED__.
+#--------------------------------------------------------------------
+
+#AC_C_CHAR_UNSIGNED
+
+#--------------------------------------------------------------------
+# Under Solaris 2.4, strtod returns the wrong value for the
+# terminating character under some conditions. Check for this
+# and if the problem exists use a substitute procedure
+# "fixstrtod" (provided by Tcl) that corrects the error.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for strtod""... $ac_c" 1>&6
+echo "configure:2189: checking for strtod" >&5
+if eval "test \"`echo '$''{'ac_cv_func_strtod'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2194 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char strtod(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char strtod();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_strtod) || defined (__stub___strtod)
+choke me
+#else
+strtod();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2217: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_strtod=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_strtod=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'strtod`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ itcl_strtod=1
+else
+ echo "$ac_t""no" 1>&6
+itcl_strtod=0
+fi
+
+if test "$itcl_strtod" = 1; then
+ echo $ac_n "checking for Solaris 2.4 strtod bug""... $ac_c" 1>&6
+echo "configure:2239: checking for Solaris 2.4 strtod bug" >&5
+ if test "$cross_compiling" = yes; then
+ itcl_ok=0
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2244 "configure"
+#include "confdefs.h"
+
+ extern double strtod();
+ int main()
+ {
+ char *string = "NaN";
+ char *term;
+ strtod(string, &term);
+ if ((term != string) && (term[-1] == 0)) {
+ exit(1);
+ }
+ exit(0);
+ }
+EOF
+if { (eval echo configure:2259: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ itcl_ok=1
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ itcl_ok=0
+fi
+rm -fr conftest*
+fi
+
+ if test "$itcl_ok" = 1; then
+ echo "$ac_t""ok" 1>&6
+ else
+ echo "$ac_t""buggy" 1>&6
+ cat >> confdefs.h <<\EOF
+#define strtod fixstrtod
+EOF
+
+ fi
+fi
+
+#--------------------------------------------------------------------
+# If we are building with cygwin, we need one set of library names,
+# otherwise, we need the Source-Navigator set.
+#--------------------------------------------------------------------
+
+if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
+ CYGITCLLIBSPEC=itcl${VERSION}
+else
+ CYGITCLLIBSPEC="itcl`echo ${VERSION} | tr -d .`"
+fi
+CYGITCLLIB=lib${CYGITCLLIBSPEC}.a
+CYGITCLDLL=cygitcl${VERSION}.dll
+CYGITCLSH=cygitclsh${VERSION}.exe
+CYGITCLDEF=itclcyg.def
+CYGITCLTEST=cygitcltest.exe
+CYGIMPORTLIB=cygitcl${VERSION}.lib
+CYGITCLRES=cygitcl.o
+CYGITCLSHRES=cygitclsh.o
+
+SNITCLLIBSPEC=itcl30.lib
+SNITCLLIB=${SNITCLLIBSPEC}
+SNITCLDLL=snitcl30.dll
+SNITCLSH=snitclsh30.exe
+SNITCLDEF=itclsn.def
+SNITCLTEST=snitcltest.exe
+SNIMPORTLIB=snitcl30.lib
+SNITCLRES=snitcl.obj
+SNITCLSHRES=snitclsh.obj
+
+if test "$GCC" = yes; then
+ITCLLIBSPEC=${CYGITCLLIBSPEC}
+ITCLLIB=${CYGITCLLIB}
+ITCLDLL=${CYGITCLDLL}
+ITCLSH=${CYGITCLSH}
+ITCLDEF=${CYGITCLDEF}
+ITCLTEST=${CYGITCLTEST}
+ITCLIMPORTLIB=${CYGIMPORTLIB}
+ITCLRES=${CYGITCLRES}
+ITCLSHRES=${CYGITCLSHRES}
+else
+ITCLLIBSPEC=${SNITCLLIBSPEC}
+ITCLLIB=${SNITCLLIB}
+ITCLDLL=${SNITCLDLL}
+ITCLSH=${SNITCLSH}
+ITCLDEF=${SNITCLDEF}
+ITCLTEST=${SNITCLTEST}
+ITCLIMPORTLIB=${SNIMPORTLIB}
+ITCLRES=${SNITCLRES}
+ITCLSHRES=${SNITCLSHRES}
+fi
+
+ITCL_SH="`pwd`/${ITCLSH}"
+if ! test "$GCC" = yes; then
+ tmp="`cygpath --windows $ITCL_SH`"
+ ITCL_SH="`echo $tmp | sed -e s#\\\\\\\\#/#g`"
+fi
+
+
+#--------------------------------------------------------------------
+# The statements below define a collection of symbols related to
+# building libitcl as a shared library instead of a static library.
+#--------------------------------------------------------------------
+
+# Check whether --enable-shared or --disable-shared was given.
+if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ ok=$enableval
+else
+ ok=no
+fi
+
+if test "$ok" = "yes" -a "${SHLIB_SUFFIX}" != ""; then
+ ITCL_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+ eval "ITCL_LIB_FILE=libitcl${VERSION}${SHLIB_SUFFIX}"
+ ITCL_PKG_FILE="[file join [file dirname \$dir] ${ITCL_LIB_FILE}]"
+ MAKE_LIB="\${SHLIB_LD} -o ${ITCL_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}"
+ RANLIB=":"
+else
+ ITCL_SHLIB_CFLAGS=""
+ eval "ITCL_LIB_FILE=libitcl${VERSION}.a"
+ ITCL_PKG_FILE=""
+ MAKE_LIB="ar cr ${ITCL_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 "$GCC" = yes; then
+ ITCL_BUILD_LIB_SPEC="-L`pwd` -l${ITCLLIBSPEC}"
+ ITCL_LIB_SPEC="-L${exec_prefix}/lib/itcl -l{ITCLLIBSPEC}"
+ ITCL_LIB_FULL_PATH="`pwd`/${ITCLLIB}"
+else
+ tmp="`pwd`/${ITCLLIB}"
+ tmp2="`cygpath --windows $tmp`"
+ ITCL_BUILD_LIB_SPEC="`echo $tmp2 | sed -e s#\\\\\\\\#/#g`"
+ ITCL_LIB_FULL_PATH=${ITCL_BUILD_LIB_SPEC}
+ tmp="${exec_prefix}/lib/itcl/${ITCLLIB}"
+ tmp2="`cygpath --windows $tmp`"
+ ITCL_LIB_SPEC="`echo $tmp2 | sed -e s#\\\\\\\\#/#g`"
+fi
+
+#-------------------------------------------------------------------
+# Set up the libraries to link with.
+#-------------------------------------------------------------------
+if test "$GCC" = yes; then
+ BASELIBS="-lkernel32 $(optlibs) -ladvapi32 -luser32"
+ WINLIBS="-lgdi32 -lcomdlg32 -lwinspool"
+ LIBCDLL=
+else
+ BASELIBS="kernel32.lib advapi32.lib user32.lib"
+ WINLIBS="gdi32.lib comdlg32.lib winspool.lib"
+ LIBCDLL="msvcrt.lib oldnames.lib"
+fi
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.13"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "Makefile ../unix/pkgIndex.tcl ../itclConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@host@%$host%g
+s%@host_alias@%$host_alias%g
+s%@host_cpu@%$host_cpu%g
+s%@host_vendor@%$host_vendor%g
+s%@host_os@%$host_os%g
+s%@RANLIB@%$RANLIB%g
+s%@CC@%$CC%g
+s%@OBJEXT@%$OBJEXT%g
+s%@NM@%$NM%g
+s%@AS@%$AS%g
+s%@LD@%$LD%g
+s%@DLLTOOL@%$DLLTOOL%g
+s%@WINDRES@%$WINDRES%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@DLL_LDFLAGS@%$DLL_LDFLAGS%g
+s%@DLL_LDLIBS@%$DLL_LDLIBS%g
+s%@ITKWISH@%$ITKWISH%g
+s%@CPP@%$CPP%g
+s%@DL_LIBS@%$DL_LIBS%g
+s%@LD_FLAGS@%$LD_FLAGS%g
+s%@MATH_LIBS@%$MATH_LIBS%g
+s%@MAKE_LIB@%$MAKE_LIB%g
+s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
+s%@SHLIB_LD@%$SHLIB_LD%g
+s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
+s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
+s%@SHLIB_VERSION@%$SHLIB_VERSION%g
+s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g
+s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
+s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
+s%@TCL_VERSION@%$TCL_VERSION%g
+s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g
+s%@TCL_LIB_FULL_PATH@%$TCL_LIB_FULL_PATH%g
+s%@ITCL_BUILD_LIB_SPEC@%$ITCL_BUILD_LIB_SPEC%g
+s%@ITCL_LD_SEARCH_FLAGS@%$ITCL_LD_SEARCH_FLAGS%g
+s%@ITCL_LIB_FILE@%$ITCL_LIB_FILE%g
+s%@ITCL_LIB_FULL_PATH@%$ITCL_LIB_FULL_PATH%g
+s%@ITCL_LIB_SPEC@%$ITCL_LIB_SPEC%g
+s%@ITCL_MAJOR_VERSION@%$ITCL_MAJOR_VERSION%g
+s%@ITCL_MINOR_VERSION@%$ITCL_MINOR_VERSION%g
+s%@ITCL_PKG_FILE@%$ITCL_PKG_FILE%g
+s%@ITCL_SHLIB_CFLAGS@%$ITCL_SHLIB_CFLAGS%g
+s%@ITCL_SRC_DIR@%$ITCL_SRC_DIR%g
+s%@ITCL_VERSION@%$ITCL_VERSION%g
+s%@CYGITCLLIB@%$CYGITCLLIB%g
+s%@CYGITCLDLL@%$CYGITCLDLL%g
+s%@CYGITCLSH@%$CYGITCLSH%g
+s%@CYGITCLDEF@%$CYGITCLDEF%g
+s%@CYGITCLTEST@%$CYGITCLTEST%g
+s%@CYGIMPORTLIB@%$CYGIMPORTLIB%g
+s%@CYGITCLRES@%$CYGITCLRES%g
+s%@CYGITCLSHRES@%$CYGITCLSHRES%g
+s%@SNITCLLIB@%$SNITCLLIB%g
+s%@SNITCLDLL@%$SNITCLDLL%g
+s%@SNITCLSH@%$SNITCLSH%g
+s%@SNITCLDEF@%$SNITCLDEF%g
+s%@SNITCLTEST@%$SNITCLTEST%g
+s%@SNIMPORTLIB@%$SNIMPORTLIB%g
+s%@SNITCLRES@%$SNITCLRES%g
+s%@SNITCLSHRES@%$SNITCLSHRES%g
+s%@ITCLLIB@%$ITCLLIB%g
+s%@ITCLDLL@%$ITCLDLL%g
+s%@ITCLSH@%$ITCLSH%g
+s%@ITCLDEF@%$ITCLDEF%g
+s%@ITCLTEST@%$ITCLTEST%g
+s%@ITCLIMPORTLIB@%$ITCLIMPORTLIB%g
+s%@ITCLRES@%$ITCLRES%g
+s%@ITCL_SH@%$ITCL_SH%g
+s%@BASELIBS@%$BASELIBS%g
+s%@WINLIBS@%$WINLIBS%g
+s%@LIBCDLL@%$LIBCDLL%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile ../unix/pkgIndex.tcl ../itclConfig.sh"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+ case "$ac_given_INSTALL" in
+ [/$]*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ esac
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
diff --git a/itcl/itcl/win/configure.in b/itcl/itcl/win/configure.in
new file mode 100644
index 00000000000..a6cde54ab42
--- /dev/null
+++ b/itcl/itcl/win/configure.in
@@ -0,0 +1,429 @@
+dnl This whole file is CYGNUS LOCAL
+dnl This file is an input file used by the GNU "autoconf" program to
+dnl generate the file "configure", which is run during [incr Tcl]
+dnl installation to configure the system for the local environment.
+
+AC_PREREQ(2.5)
+
+AC_INIT(../generic/itcl.h)
+
+AC_CONFIG_AUX_DIR(../../../)
+AC_CANONICAL_HOST
+
+AC_PROG_RANLIB
+
+AC_PROG_CC
+AC_OBJEXT
+NM=${NM-nm}
+AC_SUBST(NM)
+AS=${AS-as}
+AC_SUBST(AS)
+LD=${LD-ld}
+AC_SUBST(LD)
+DLLTOOL=${DLLTOOL-dlltool}
+AC_SUBST(DLLTOOL)
+WINDRES=${WINDRES-windres}
+AC_SUBST(WINDRES)
+
+AC_PROG_INSTALL
+
+# needed for the subtle differences between cygwin and mingw32
+case "${host}" in
+*-*-cygwin*)
+ TCL_ALLOC_OBJ=
+ DLL_LDLIBS=-lcygwin
+ DLL_LDFLAGS='-nostartfiles -Wl,--dll'
+ ;;
+*-*-mingw32*)
+ TCL_ALLOC_OBJ='$(TMPDIR)/tclAlloc.o'
+ DLL_LDLIBS=
+ DLL_LDFLAGS='-mdll'
+ ;;
+esac
+AC_SUBST(DLL_LDFLAGS)
+AC_SUBST(DLL_LDLIBS)
+
+ITCL_VERSION=3.0
+ITCL_MAJOR_VERSION=3
+ITCL_MINOR_VERSION=0
+VERSION=${ITCL_MAJOR_VERSION}${ITCL_MINOR_VERSION}
+
+
+if test "${prefix}" = "NONE"; then
+ prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+ exec_prefix=$prefix
+fi
+
+# -----------------------------------------------------------------------
+# Set up a new default --prefix. If a previous installation of
+# [incr Tcl] can be found searching $PATH use that directory.
+# -----------------------------------------------------------------------
+
+AC_PREFIX_DEFAULT(/usr/local)
+AC_PREFIX_PROGRAM(itkwish)
+
+if test "${prefix}" = "NONE"; then
+ prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+ exec_prefix=$prefix
+fi
+
+# -----------------------------------------------------------------------
+BUILD_DIR=`pwd`
+ITCL_SRC_DIR=`cd $srcdir/..; pwd`
+
+if ! test "$GCC" = yes; then
+ tmp="`cygpath --windows $ITCL_SRC_DIR`"
+ ITCL_SRC_DIR="`echo $tmp | sed -e s#\\\\\\\\#/#g`"
+fi
+
+cd ${BUILD_DIR}
+
+AC_ARG_ENABLE(gcc, [ --enable-gcc allow use of gcc if available],
+ [itcl_ok=$enableval], [itcl_ok=no])
+if test "$itcl_ok" = "yes"; then
+ AC_PROG_CC
+else
+ CC=${CC-cc}
+AC_SUBST(CC)
+fi
+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.
+# CYGNUS LOCAL - Actually, tcl is one level higher - a sibling of the
+# itcl directory that contains itcl proper, itk & iwidgets.
+#--------------------------------------------------------------------
+
+AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.0 binaries from DIR],
+ TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../../tcl/win; pwd`)
+
+if test ! -f $TCL_BIN_DIR/../unix/tclConfig.sh; then
+ TCL_BIN_DIR=`cd ../../../tcl8.1/win;pwd`
+fi
+
+if test ! -f $TCL_BIN_DIR/../unix/tclConfig.sh; then
+ AC_MSG_ERROR(There's no tclConfig.sh 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/../unix/tclConfig.sh
+. $file
+
+dnl CFLAGS=$TCL_CFLAGS
+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
+ITCL_LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
+
+AC_MSG_CHECKING([whether C compiler is gcc])
+AC_CACHE_VAL(itcl_cv_prog_gcc, [
+ AC_EGREP_CPP(_cc_is_gcc_, [
+#ifdef __GNUC__
+_cc_is_gcc_
+#endif
+], [itcl_cv_prog_gcc=yes], [itcl_cv_prog_gcc=no])])
+AC_MSG_RESULT([$itcl_cv_prog_gcc])
+
+if test -z "$CFLAGS" ; then
+ CFLAGS="-O"
+fi
+if test "$itcl_cv_prog_gcc" = "yes" ; then
+ CFLAGS="$CFLAGS -Wshadow -Wtraditional -Wall"
+fi
+
+AC_MSG_CHECKING([default compiler flags])
+AC_ARG_WITH(cflags, [ --with-cflags=FLAGS set compiler flags to FLAGS],
+ [CFLAGS="$with_cflags"])
+
+AC_MSG_RESULT([$CFLAGS])
+
+#--------------------------------------------------------------------
+# Supply a substitute for stdlib.h if it doesn't define strtol,
+# strtoul, or strtod (which it doesn't in some versions of SunOS).
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING(stdlib.h)
+AC_HEADER_EGREP(strtol, stdlib.h, itcl_ok=yes, itcl_ok=no)
+AC_HEADER_EGREP(strtoul, stdlib.h, , itcl_ok=no)
+AC_HEADER_EGREP(strtod, stdlib.h, , itcl_ok=no)
+if test $itcl_ok = no; then
+ AC_DEFINE(NO_STDLIB_H)
+fi
+AC_MSG_RESULT($itcl_ok)
+
+#--------------------------------------------------------------------
+# Check for various typedefs and provide substitutes if
+# they don't exist.
+#--------------------------------------------------------------------
+
+AC_MODE_T
+AC_PID_T
+AC_SIZE_T
+AC_UID_T
+
+#--------------------------------------------------------------------
+# 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
+# "gethostbyname" to check for -lnsl.
+# 2. Use each function name only once: can't redo a check because
+# autoconf caches the results of the last check and won't redo it.
+# 3. Use -lnsl and -lsocket only if they supply procedures that
+# aren't already present in the normal libraries. This is because
+# IRIX 5.2 has libraries, but they aren't needed and they're
+# bogus: they goof up name resolution if used.
+# 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+# To get around this problem, check for both libraries together
+# if -lsocket doesn't work by itself.
+#--------------------------------------------------------------------
+
+itcl_checkBoth=0
+AC_CHECK_FUNC(connect, itcl_checkSocket=0, itcl_checkSocket=1)
+if test "$itcl_checkSocket" = 1; then
+ AC_CHECK_LIB(socket, main, LIBS="$LIBS -lsocket", itcl_checkBoth=1)
+fi
+if test "$itcl_checkBoth" = 1; then
+ itcl_oldLibs=$LIBS
+ LIBS="$LIBS -lsocket -lnsl"
+ AC_CHECK_FUNC(accept, itcl_checkNsl=0, [LIBS=$itcl_oldLibs])
+fi
+AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main, [LIBS="$LIBS -lnsl"]))
+
+#--------------------------------------------------------------------
+# On a few very rare systems, all of the libm.a stuff is
+# already in libc.a. Set compiler flags accordingly.
+# Also, Linux requires the "ieee" library for math to
+# 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
+
+#--------------------------------------------------------------------
+# Under Solaris 2.4, strtod returns the wrong value for the
+# terminating character under some conditions. Check for this
+# and if the problem exists use a substitute procedure
+# "fixstrtod" (provided by Tcl) that corrects the error.
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(strtod, itcl_strtod=1, itcl_strtod=0)
+if test "$itcl_strtod" = 1; then
+ AC_MSG_CHECKING([for Solaris 2.4 strtod bug])
+ AC_TRY_RUN([
+ extern double strtod();
+ int main()
+ {
+ char *string = "NaN";
+ char *term;
+ strtod(string, &term);
+ if ((term != string) && (term[-1] == 0)) {
+ exit(1);
+ }
+ exit(0);
+ }], itcl_ok=1, itcl_ok=0, itcl_ok=0)
+ if test "$itcl_ok" = 1; then
+ AC_MSG_RESULT(ok)
+ else
+ AC_MSG_RESULT(buggy)
+ AC_DEFINE(strtod, fixstrtod)
+ fi
+fi
+
+#--------------------------------------------------------------------
+# If we are building with cygwin, we need one set of library names,
+# otherwise, we need the Source-Navigator set.
+#--------------------------------------------------------------------
+
+if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
+ CYGITCLLIBSPEC=itcl${VERSION}
+else
+ CYGITCLLIBSPEC="itcl`echo ${VERSION} | tr -d .`"
+fi
+CYGITCLLIB=lib${CYGITCLLIBSPEC}.a
+CYGITCLDLL=cygitcl${VERSION}.dll
+CYGITCLSH=cygitclsh${VERSION}.exe
+CYGITCLDEF=itclcyg.def
+CYGITCLTEST=cygitcltest.exe
+CYGIMPORTLIB=cygitcl${VERSION}.lib
+CYGITCLRES=cygitcl.o
+CYGITCLSHRES=cygitclsh.o
+
+SNITCLLIBSPEC=itcl30.lib
+SNITCLLIB=${SNITCLLIBSPEC}
+SNITCLDLL=snitcl30.dll
+SNITCLSH=snitclsh30.exe
+SNITCLDEF=itclsn.def
+SNITCLTEST=snitcltest.exe
+SNIMPORTLIB=snitcl30.lib
+SNITCLRES=snitcl.obj
+SNITCLSHRES=snitclsh.obj
+
+if test "$GCC" = yes; then
+ITCLLIBSPEC=${CYGITCLLIBSPEC}
+ITCLLIB=${CYGITCLLIB}
+ITCLDLL=${CYGITCLDLL}
+ITCLSH=${CYGITCLSH}
+ITCLDEF=${CYGITCLDEF}
+ITCLTEST=${CYGITCLTEST}
+ITCLIMPORTLIB=${CYGIMPORTLIB}
+ITCLRES=${CYGITCLRES}
+ITCLSHRES=${CYGITCLSHRES}
+else
+ITCLLIBSPEC=${SNITCLLIBSPEC}
+ITCLLIB=${SNITCLLIB}
+ITCLDLL=${SNITCLDLL}
+ITCLSH=${SNITCLSH}
+ITCLDEF=${SNITCLDEF}
+ITCLTEST=${SNITCLTEST}
+ITCLIMPORTLIB=${SNIMPORTLIB}
+ITCLRES=${SNITCLRES}
+ITCLSHRES=${SNITCLSHRES}
+fi
+
+ITCL_SH="`pwd`/${ITCLSH}"
+if ! test "$GCC" = yes; then
+ tmp="`cygpath --windows $ITCL_SH`"
+ ITCL_SH="`echo $tmp | sed -e s#\\\\\\\\#/#g`"
+fi
+
+
+#--------------------------------------------------------------------
+# The statements below define a collection of symbols related to
+# building libitcl as a shared library instead of a static library.
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(shared,
+ [ --enable-shared build libitcl as a shared library],
+ [ok=$enableval], [ok=no])
+if test "$ok" = "yes" -a "${SHLIB_SUFFIX}" != ""; then
+ ITCL_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+ eval "ITCL_LIB_FILE=libitcl${VERSION}${SHLIB_SUFFIX}"
+ ITCL_PKG_FILE="[[file join [file dirname \$dir] ${ITCL_LIB_FILE}]]"
+ MAKE_LIB="\${SHLIB_LD} -o ${ITCL_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}"
+ RANLIB=":"
+else
+ ITCL_SHLIB_CFLAGS=""
+ eval "ITCL_LIB_FILE=libitcl${VERSION}.a"
+ ITCL_PKG_FILE=""
+ MAKE_LIB="ar cr ${ITCL_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 "$GCC" = yes; then
+ ITCL_BUILD_LIB_SPEC="-L`pwd` -l${ITCLLIBSPEC}"
+ ITCL_LIB_SPEC="-L${exec_prefix}/lib/itcl -l{ITCLLIBSPEC}"
+ ITCL_LIB_FULL_PATH="`pwd`/${ITCLLIB}"
+else
+ tmp="`pwd`/${ITCLLIB}"
+ tmp2="`cygpath --windows $tmp`"
+ ITCL_BUILD_LIB_SPEC="`echo $tmp2 | sed -e s#\\\\\\\\#/#g`"
+ ITCL_LIB_FULL_PATH=${ITCL_BUILD_LIB_SPEC}
+ tmp="${exec_prefix}/lib/itcl/${ITCLLIB}"
+ tmp2="`cygpath --windows $tmp`"
+ ITCL_LIB_SPEC="`echo $tmp2 | sed -e s#\\\\\\\\#/#g`"
+fi
+
+#-------------------------------------------------------------------
+# Set up the libraries to link with.
+#-------------------------------------------------------------------
+if test "$GCC" = yes; then
+ BASELIBS="-lkernel32 $(optlibs) -ladvapi32 -luser32"
+ WINLIBS="-lgdi32 -lcomdlg32 -lwinspool"
+ LIBCDLL=
+else
+ BASELIBS="kernel32.lib advapi32.lib user32.lib"
+ WINLIBS="gdi32.lib comdlg32.lib winspool.lib"
+ LIBCDLL="msvcrt.lib oldnames.lib"
+fi
+
+AC_SUBST(CFLAGS)
+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(TCL_LIB_FILE)
+AC_SUBST(TCL_LIB_FULL_PATH)
+AC_SUBST(ITCL_BUILD_LIB_SPEC)
+AC_SUBST(ITCL_LD_SEARCH_FLAGS)
+AC_SUBST(ITCL_LIB_FILE)
+AC_SUBST(ITCL_LIB_FULL_PATH)
+AC_SUBST(ITCL_LIB_SPEC)
+AC_SUBST(ITCL_MAJOR_VERSION)
+AC_SUBST(ITCL_MINOR_VERSION)
+AC_SUBST(ITCL_PKG_FILE)
+AC_SUBST(ITCL_SHLIB_CFLAGS)
+AC_SUBST(ITCL_SRC_DIR)
+AC_SUBST(ITCL_VERSION)
+AC_SUBST(CYGITCLLIB)
+AC_SUBST(CYGITCLDLL)
+AC_SUBST(CYGITCLSH)
+AC_SUBST(CYGITCLDEF)
+AC_SUBST(CYGITCLTEST)
+AC_SUBST(CYGIMPORTLIB)
+AC_SUBST(CYGITCLRES)
+AC_SUBST(CYGITCLSHRES)
+AC_SUBST(SNITCLLIB)
+AC_SUBST(SNITCLDLL)
+AC_SUBST(SNITCLSH)
+AC_SUBST(SNITCLDEF)
+AC_SUBST(SNITCLTEST)
+AC_SUBST(SNIMPORTLIB)
+AC_SUBST(SNITCLRES)
+AC_SUBST(SNITCLSHRES)
+AC_SUBST(ITCLLIB)
+AC_SUBST(ITCLDLL)
+AC_SUBST(ITCLSH)
+AC_SUBST(ITCLDEF)
+AC_SUBST(ITCLTEST)
+AC_SUBST(ITCLIMPORTLIB)
+AC_SUBST(ITCLRES)
+AC_SUBST(ITCL_SH)
+AC_SUBST(BASELIBS)
+AC_SUBST(WINLIBS)
+AC_SUBST(LIBCDLL)
+
+AC_OUTPUT(Makefile ../unix/pkgIndex.tcl ../itclConfig.sh)
diff --git a/itcl/itcl/win/dllEntryPoint.c b/itcl/itcl/win/dllEntryPoint.c
new file mode 100644
index 00000000000..a988c0823d0
--- /dev/null
+++ b/itcl/itcl/win/dllEntryPoint.c
@@ -0,0 +1,90 @@
+/*
+ * dllEntryPoint.c --
+ *
+ * This file implements the Dll entry point as needed by Windows.
+ */
+
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#include <tcl.h>
+
+/* CYGNUS LOCAL */
+#ifdef __CYGWIN32__
+/*
+ * The following declaration is for the VC++ DLL entry point.
+ */
+
+BOOL APIENTRY DllMain _ANSI_ARGS_((HINSTANCE hInst,
+ DWORD reason, LPVOID reserved));
+
+/* cygwin32 requires an impure pointer variable, which must be
+ explicitly initialized when the DLL starts up. */
+struct _reent *_impure_ptr;
+extern struct _reent *_imp__reent_data;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DllMain --
+ *
+ * DLL entry point.
+ *
+ * Results:
+ * TRUE on sucess, FALSE on failure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+BOOL APIENTRY
+DllMain(hInstance, reason, reserved)
+ HINSTANCE hInstance;
+ DWORD reason;
+ LPVOID reserved;
+{
+ /* CYGNUS LOCAL */
+ /* cygwin32 requires the impure data pointer to be initialized
+ when the DLL starts up. */
+ _impure_ptr = _imp__reent_data;
+ /* END CYGNUS LOCAL */
+
+ return(TRUE);
+}
+
+/* END CYGNUS LOCAL */
+#else /* __CYGWIN32__ */
+
+#if defined(_MSC_VER)
+# define DllEntryPoint DllMain
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DllEntryPoint --
+ *
+ * This wrapper function is used by Windows to invoke the
+ * initialization code for the DLL. If we are compiling
+ * with Visual C++, this routine will be renamed to DllMain.
+ *
+ * Results:
+ * Returns TRUE;
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+BOOL APIENTRY
+DllEntryPoint(hInst, reason, reserved)
+ HINSTANCE hInst; /* Library instance handle. */
+ DWORD reason; /* Reason this function is being called. */
+ LPVOID reserved; /* Not used. */
+{
+ return TRUE;
+}
+
+#endif
diff --git a/itcl/itcl/win/itcl.rc b/itcl/itcl/win/itcl.rc
new file mode 100644
index 00000000000..305d25473fe
--- /dev/null
+++ b/itcl/itcl/win/itcl.rc
@@ -0,0 +1,41 @@
+// SCCS: @(#) tcl.rc 1.20 96/09/12 14:57:51
+//
+// Version
+//
+
+#define RESOURCE_INCLUDED
+#include <itcl.h>
+
+
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION ITCL_MAJOR_VERSION ,ITCL_MINOR_VERSION ,ITCL_RELEASE_LEVEL,0
+ PRODUCTVERSION ITCL_MAJOR_VERSION ,ITCL_MINOR_VERSION ,ITCL_RELEASE_LEVEL,0
+ FILEFLAGSMASK 0x3fL
+ FILEFLAGS 0x0L
+ FILEOS 0x4L
+ FILETYPE 0x2L
+ FILESUBTYPE 0x0L
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904b0"
+ BEGIN
+ VALUE "FileDescription", "Itcl DLL\0"
+ VALUE "Authors", "Michael McLennan\0"
+ VALUE "OriginalFilename", "itcl30.dll\0"
+ VALUE "CompanyName", "Bell Labs Innovations for Lucent Technologies\0"
+ VALUE "FileVersion", ITCL_PATCH_LEVEL
+ VALUE "LegalCopyright", "Copyright \251 1993-1998\0"
+ VALUE "ProductName", "[incr Tcl] 3.0 for Windows\0"
+ VALUE "ProductVersion", ITCL_PATCH_LEVEL
+ END
+ END
+ BLOCK "VarFileInfo"
+ BEGIN
+ VALUE "Translation", 0x409, 1200
+ END
+END
+
+
+
+
diff --git a/itcl/itcl/win/itclsh.rc b/itcl/itcl/win/itclsh.rc
new file mode 100644
index 00000000000..217df6c76cb
--- /dev/null
+++ b/itcl/itcl/win/itclsh.rc
@@ -0,0 +1,37 @@
+// SCCS: @(#) tclsh.rc 1.14 96/09/12 14:59:29
+//
+// Version
+//
+
+#define RESOURCE_INCLUDED
+#include <itcl.h>
+
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION ITCL_MAJOR_VERSION,ITCL_MINOR_VERSION,ITCL_RELEASE_LEVEL,0
+ PRODUCTVERSION ITCL_MAJOR_VERSION,ITCL_MINOR_VERSION,ITCL_RELEASE_LEVEL,0
+ FILEFLAGSMASK 0x3fL
+ FILEFLAGS 0x0L
+ FILEOS 0x4L
+ FILETYPE 0x1L
+ FILESUBTYPE 0x0L
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904b0"
+ BEGIN
+ VALUE "FileDescription", "[incr Tcl] Object-Oriented Tcl Application\0"
+ VALUE "Authors", "Michael McLennan\0"
+ VALUE "OriginalFilename", "itclsh.exe\0"
+ VALUE "CompanyName", "Bell Labs Innovations for Lucent Technologies\0"
+ VALUE "FileVersion", ITCL_PATCH_LEVEL
+ VALUE "LegalCopyright", "Copyright \251 1993-1998\0"
+ VALUE "ProductName", "[incr Tcl] "STRINGIFY(ITCL_MAJOR_VERSION)"."STRINGIFY(ITCL_MINOR_VERSION)" for Windows\0"
+ VALUE "ProductVersion", ITCL_PATCH_LEVEL
+ END
+ END
+ BLOCK "VarFileInfo"
+ BEGIN
+ VALUE "Translation", 0x409, 1200
+ END
+END
+
diff --git a/itcl/itcl/win/makefile.bc b/itcl/itcl/win/makefile.bc
new file mode 100644
index 00000000000..b8983a218e9
--- /dev/null
+++ b/itcl/itcl/win/makefile.bc
@@ -0,0 +1,212 @@
+# Borland C++ 4.52 makefile
+#
+# Copyright (c) 1993-1996 Lucent Technologies
+# based on original from
+# 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.
+
+!include "..\..\Makefile.bc"
+
+#
+# Project directories
+#
+# ROOT = top of source tree
+# TMPDIR = location where .obj files should be stored during build
+
+ROOT = ..
+TMPDIR = .
+TARGET_LIB_ITCL = $(TARGET_LIB)\Itcl2.2
+TARGET_DOC_ITCL = $(TARGET_DOC)\Itcl
+
+# uncomment the following line to compile with symbols
+#DEBUG=1
+
+# uncomment the following two lines to compile with TCL_MEM_DEBUG
+#DEBUGDEFINES =TCL_MEM_DEBUG
+
+INCLUDES =$(BORLAND)\include;$(ROOT)\generic;$(ROOT)\win;$(TCLDIR)\generic
+LIBDIRS =$(BORLAND)\lib;$(ROOT)\win
+
+!ifndef DEBUG
+
+# these macros cause maximum optimization and no symbols
+DEBUGLDFLAGS =
+DEBUGCCFLAGS = -v- -vi- -O2
+DEBUGLDFLAGS16 = -Oc -Oi -Oa -Or
+!else
+
+# these macros enable debugging
+DEBUGLDFLAGS = -v
+DEBUGCCFLAGS = -k -Od -v
+DEBUGLDFLAGS16 =
+!endif
+
+DEFINES = _RTLDLL;USE_TCLALLOC=0;$(DEBUGDEFINES);NO_DLFCN_H=1;ITCL_NAMESPACES=1
+PROJECTCCFLAGS = $(DEBUGCCFLAGS) -w-par -w-stu
+
+CFLAGS16_dll = $(PROJECTCCFLAGS) -I$(INCLUDES) -D$(DEFINES) -WD -ml -c -3 -d -w
+
+LNFLAGS_exe = -Tpe -aa -c $(DEBUGLDFLAGS) $(BORLAND)\lib\c0w32
+LNFLAGS_CONSOLE_exe = -Tpe -ap -c $(DEBUGLDFLAGS) $(BORLAND)\lib\c0x32
+LNFLAGS_dll = -Tpd -aa -c $(DEBUGLDFLAGS) $(BORLAND)\lib\c0d32
+LNFLAGS16_dll = -Twd -c -C -A=16 $(DEBUGLDFLAGS16) $(BORLAND)\lib\c0dl.obj
+
+LNLIBS_exe = $(ITCLLIB) $(TCLLIBDIR)\$(TCLLIB) import32 cw32i
+LNLIBS_dll = $(TCLLIBDIR)\$(TCLLIB) import32 cw32i
+LNLIBS16_dll = import cwl
+
+#
+# Global makefile settings
+#
+
+.AUTODEPEND
+.CACHEAUTODEPEND
+
+.suffixes: .c .dll .lib .obj .exe
+
+.path.c=$(ROOT)\win;$(ROOT)\generic
+.path.obj=$(TMPDIR)
+.path.dll=$(ROOT)\win;$(WINDIR);$(WINDIR)\SYSTEM32;$(WINDIR)\SYSTEM
+
+ITCLSHOBJS = \
+ $(TMPDIR)\tclAppInit.obj
+
+ITCLOBJS = \
+ $(TMPDIR)\itcl_bicmds.obj \
+ $(TMPDIR)\itcl_class.obj \
+ $(TMPDIR)\itcl_cmds.obj \
+ $(TMPDIR)\itcl_linkage.obj \
+ $(TMPDIR)\itcl_methods.obj \
+ $(TMPDIR)\itcl_objects.obj \
+ $(TMPDIR)\itcl_obsolete.obj \
+ $(TMPDIR)\itcl_parse.obj \
+ $(TMPDIR)\itcl_util.obj \
+ $(TMPDIR)\dllEntryPoint.obj
+
+
+DUMPEXTS = $(TCLLIBDIR)\dumpexts.exe
+ITCLSH = itclsh.exe
+
+#
+# Targets
+#
+
+all: cfgcln cfgdll $(ITCLDLL) cfgexe $(ITCLSH) cfgcln
+test: $(ITCLSH)
+ $(CP) $(TCLLIBDIR)\*.dll
+ $(ITCLSH) <<|
+ cd ../tests
+ source all
+|
+
+install: all
+ $(MKDIR) "$(TARGET_ROOT)"
+ $(MKDIR) "$(TARGET_BIN)"
+ $(MKDIR) "$(TARGET_LIB_ROOT)"
+ $(MKDIR) "$(TARGET_LIB)"
+ $(MKDIR) "$(TARGET_LIB_ITCL)"
+ $(MKDIR) "$(TARGET_INCLUDE_ROOT)"
+ $(MKDIR) "$(TARGET_INCLUDE)"
+ $(MKDIR) "$(TARGET_DOC)"
+ $(MKDIR) "$(TARGET_DOC_ITCL)"
+ $(CP) $(TMPDIR)\$(ITCLSH) "$(TARGET_BIN)"
+ $(CP) $(TMPDIR)\$(ITCLDLL) "$(TARGET_BIN)"
+ $(CP) $(ROOT)\generic\itcl.h "$(TARGET_INCLUDE)"
+ $(CP) $(ROOT)\library\*.* "$(TARGET_LIB_ITCL)"
+ $(CP) $(ROOT)\win\*.tcl "$(TARGET_LIB_ITCL)"
+ $(CP) $(ROOT)\..\html\Itcl\*.* "$(TARGET_DOC_ITCL)"
+
+# Implicit Targets
+
+.c.obj:
+ @$(BCC32) {$< }
+
+.dll.lib:
+ $(IMPLIB) -c $@ $<
+
+#.rc.res:
+# $(RC) -i$(INCLUDES) -d__WIN32__;$(DEFINES) $<
+
+.rc.res:
+ $(RC) -i$(INCLUDES) -d__WIN32__; $<
+
+
+#
+# Configuration file targets - these files are implicitly used by the compiler
+#
+
+cfgdll:
+ @$(CP) &&|
+ -n$(TMPDIR) -I$(INCLUDES) -c -WD
+ -D$(DEFINES) -3 -d -w $(PROJECTCCFLAGS)
+| bcc32.cfg >NUL
+
+cfgexe:
+ @$(CP) &&|
+ -n$(TMPDIR) -I$(INCLUDES) -c -W
+ -D$(DEFINES) -3 -d -w $(PROJECTCCFLAGS)
+| bcc32.cfg >NUL
+
+cfgcln:
+ -@$(RM) *.cfg
+
+#
+# Executable targets
+#
+
+$(ITCLDLL): $(ITCLOBJS) itcl.def itcl.res
+ $(TLINK32) $(LNFLAGS_dll) @&&|
+ $(ITCLOBJS)
+$@
+-x
+$(LNLIBS_dll)
+|, itcl.def, itcl.res
+
+$(ITCLSH): $(ITCLSHOBJS) $(ITCLLIB) itclsh.res
+ $(TLINK32) $(LNFLAGS_CONSOLE_exe) @&&|
+ $(ITCLSHOBJS)
+$@
+-x
+$(LNLIBS_exe)
+|, &&|
+EXETYPE WINDOWS
+CODE PRELOAD MOVEABLE DISCARDABLE
+DATA PRELOAD MOVEABLE MULTIPLE
+|, itclsh.res
+
+
+# The following rule automatically generates a tcl.def file containing
+# an export entry for every public symbol in the tcl.dll library.
+
+itcl.def: $(ITCLOBJS)
+ $(DUMPEXTS) -o itcl.def $(ITCLDLL) @&&|
+ $(ITCLOBJS)
+|
+
+
+# debugging rules, the .dll and .exe files must be in the same
+# directory as the object files for debugging purposes
+
+$(TMPDIR)\$(ITCLDLL): $(ITCLDLL)
+ $(CP) $(ITCLDLL) $(TMPDIR)
+
+$(TMPDIR)\$(TCLDLL): $(TCLLIBDIR)\$(TCLDLL)
+ $(CP) $(TCLLIBDIR)\$(TCLDLL) $(TMPDIR)
+
+$(TMPDIR)\$(ITCLSH): $(ITCLSH)
+ $(CP) $(ITCLSH) $(TMPDIR)
+
+debug: $(TMPDIR)\$(ITCLDLL) $(TMPDIR)\$(TCLDLL)
+
+# remove all generated files
+
+clean:
+ -@$(RM) *.exe
+ -@$(RM) *.lib
+ -@$(RM) *.dll
+ -@$(RM) *.res
+ -@$(RM) itcl.def
+ -@$(RM) $(TMPDIR)\*.obj
+ -@$(RM) *.cfg
diff --git a/itcl/itcl/win/makefile.vc b/itcl/itcl/win/makefile.vc
new file mode 100644
index 00000000000..dd97faac9ca
--- /dev/null
+++ b/itcl/itcl/win/makefile.vc
@@ -0,0 +1,147 @@
+# Visual C++ 4.0 makefile
+#
+# Copyright (c) 1993-1996 Lucent Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+#
+# Project directories
+#
+# ROOT = top of source tree
+#
+# TMPDIR = location where .obj files should be stored during build
+#
+
+!include "..\..\Makefile.vc"
+
+ROOT = ..
+TMPDIR = .
+TARGET_LIB_ITCL = $(TARGET_LIB)\Itcl2.2
+TARGET_DOC_ITCL = $(TARGET_DOC)\Itcl
+
+# 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
+
+WINDIR = $(ROOT)\win
+GENERICDIR = $(ROOT)\generic
+
+TCL_INCLUDES = -I$(WINDIR) -I$(GENERICDIR) -I$(TCLDIR)\generic
+
+TCL_DEFINES = -D__WIN32__ -DUSE_TCLALLOC=0 $(DEBUGDEFINES) -Dtry=__try \
+ -Dexcept=__except
+
+ITCLSHOBJS = \
+ $(TMPDIR)\tclAppInit.obj
+
+ITCLOBJS = \
+ $(TMPDIR)\itcl_bicmds.obj \
+ $(TMPDIR)\itcl_class.obj \
+ $(TMPDIR)\itcl_cmds.obj \
+ $(TMPDIR)\itcl_linkage.obj \
+ $(TMPDIR)\itcl_methods.obj \
+ $(TMPDIR)\itcl_objects.obj \
+ $(TMPDIR)\itcl_obsolete.obj \
+ $(TMPDIR)\itcl_parse.obj \
+ $(TMPDIR)\itcl_util.obj \
+ $(TMPDIR)\dllEntryPoint.obj
+
+DUMPEXTS = $(TCLLIBDIR)\dumpexts.exe
+ITCLSH = itclsh.exe
+ITCLTEST = itcltest.exe
+
+CPU = i386
+INCLUDE = $(TOOLS32)\include
+!include <ntwin32.mak>
+
+TCL_CFLAGS = $(cdebug) $(cflags) $(cvarsdll) $(include32) $(TCL_INCLUDES) $(TCL_DEFINES)
+CON_CFLAGS = $(cdebug) $(cflags) $(cvars) $(include32) -DCONSOLE
+DOS_CFLAGS = $(cdebug) $(cflags) $(include16) -AL
+DLL16_CFLAGS = $(cdebug) $(cflags) $(include16) -ALw
+
+#
+# Targets
+#
+
+release: $(ITCLDLL) $(ITCLSH)
+all: $(ITCLDLL) $(ITCLSH)
+test: $(ITCLSH)
+ $(CP) $(TCLLIBDIR)\*.dll
+ $(ITCLSH) <<
+ cd ../tests
+ source all
+<<
+
+install: all
+ $(MKDIR) "$(TARGET_ROOT)"
+ $(MKDIR) "$(TARGET_BIN)"
+ $(MKDIR) "$(TARGET_LIB_ROOT)"
+ $(MKDIR) "$(TARGET_LIB)"
+ $(MKDIR) "$(TARGET_LIB_ITCL)"
+ $(MKDIR) "$(TARGET_INCLUDE_ROOT)"
+ $(MKDIR) "$(TARGET_INCLUDE)"
+ $(MKDIR) "$(TARGET_DOC)"
+ $(MKDIR) "$(TARGET_DOC_ITCL)"
+ $(CP) $(TMPDIR)\$(ITCLSH) "$(TARGET_BIN)"
+ $(CP) $(TMPDIR)\$(ITCLDLL) "$(TARGET_BIN)"
+ $(CP) $(ROOT)\generic\itcl.h "$(TARGET_INCLUDE)"
+ $(CP) $(ROOT)\library\*.* "$(TARGET_LIB_ITCL)"
+ $(CP) $(ROOT)\win\*.tcl "$(TARGET_LIB_ITCL)"
+ $(CP) $(ROOT)\..\html\Itcl\*.* "$(TARGET_DOC_ITCL)"
+
+$(ITCLDLL): $(ITCLOBJS) $(TCLLIBDIR)\$(TCLLIB) $(TMPDIR)\itclvc.def $(TMPDIR)\itcl.res
+ set LIB=$(TOOLS32)\lib
+ $(link32) $(linkdebug) $(dlllflags) -def:$(TMPDIR)\itclvc.def \
+ -out:$@ $(TMPDIR)\itcl.res $(guilibsdll) @<<
+$(ITCLOBJS) $(TCLLIBDIR)\$(TCLLIB)
+<<
+
+$(ITCLSH): $(ITCLSHOBJS) $(ITCLLIB) $(TCLLIBDIR)\$(TCLLIB) $(TMPDIR)\itclsh.res
+ set LIB=$(TOOLS32)\lib
+ $(link32) $(linkdebug) $(conlflags) $(TMPDIR)\itclsh.res \
+ -out:$@ $(conlibsdll) $(ITCLLIB) $(TCLLIBDIR)\$(TCLLIB) $(ITCLSHOBJS)
+
+$(ITCLTEST): $(ITCLTESTOBJS) $(ITCLLIB) $(TCLLIBDIR)\$(TCLLIB) $(TMPDIR)\itclsh.res
+ set LIB=$(TOOLS32)\lib
+ $(link32) $(linkdebug) $(conlflags) $(TMPDIR)\itclsh.res \
+ -out:$@ $(conlibsdll) $(ITCLLIB) $(TCLLIBDIR)\$(TCLLIB) $(ITCLTESTOBJS)
+
+#
+# Special case object file targets
+#
+
+$(TMPDIR)\itclvc.def: $(DUMPEXTS) $(ITCLOBJS)
+ $(DUMPEXTS) -o $@ $(ITCLDLL) @<<
+$(ITCLOBJS)
+<<
+
+$(TMPDIR)\testMain.obj: $(WINDIR)\tclAppInit.c
+ $(cc32) $(TCL_CFLAGS) -DTCL_TEST -Fo$(TMPDIR)\testMain.obj $?
+
+#
+# Implicit rules
+#
+
+{$(WINDIR)}.c{$(TMPDIR)}.obj:
+ $(cc32) $(TCL_CFLAGS) -Fo$(TMPDIR)\ $<
+
+{$(GENERICDIR)}.c{$(TMPDIR)}.obj:
+ $(cc32) $(TCL_CFLAGS) -Fo$(TMPDIR)\ $<
+
+{$(ROOT)\compat}.c{$(TMPDIR)}.obj:
+ $(cc32) $(TCL_CFLAGS) -Fo$(TMPDIR)\ $<
+
+{$(WINDIR)}.rc{$(TMPDIR)}.res:
+ $(rc32) -fo $@ -r -i $(GENERICDIR) -i $(WINDIR) -i $(TCLDIR)\generic $(TCL_DEFINES) $<
+
+clean:
+ -@$(RM) *.exe
+ -@$(RM) *.lib
+ -@$(RM) *.dll
+ -@$(RM) *.res
+ -@$(RM) itclvc.def
+ -@$(RM) $(TMPDIR)\*.obj
+ -@$(RM) *.exp
diff --git a/itcl/itcl/win/pkgIndex.tcl b/itcl/itcl/win/pkgIndex.tcl
new file mode 100644
index 00000000000..b09e5d73ef1
--- /dev/null
+++ b/itcl/itcl/win/pkgIndex.tcl
@@ -0,0 +1,3 @@
+# Tcl package index file, version 1.0
+
+package ifneeded Itcl 3.0 [list load itcl30.dll Itcl]
diff --git a/itcl/itcl/win/tclAppInit.c b/itcl/itcl/win/tclAppInit.c
new file mode 100644
index 00000000000..b105a215f93
--- /dev/null
+++ b/itcl/itcl/win/tclAppInit.c
@@ -0,0 +1,280 @@
+/*
+ * tclAppInit.c --
+ *
+ * Provides a default version of the main program and Tcl_AppInit
+ * procedure for Tcl applications (without Tk). Note that this
+ * program must be built in Win32 console mode to work properly.
+ *
+ * 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: @(#) tclAppInit.c 1.12 97/04/30 11:04:50
+ */
+
+/* include tclInt.h for access to namespace API */
+#include "tclInt.h"
+
+#include "itcl.h"
+#include <windows.h>
+#include <locale.h>
+
+#ifdef TCL_TEST
+EXTERN int Tcltest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int TclObjTest_Init _ANSI_ARGS_((Tcl_Interp *interp));
+#endif /* TCL_TEST */
+
+static void setargv _ANSI_ARGS_((int *argcPtr, char ***argvPtr));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ * This is the main program for the application.
+ *
+ * Results:
+ * None: Tcl_Main never returns here, so this procedure never
+ * returns either.
+ *
+ * Side effects:
+ * Whatever the application does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+main(argc, argv)
+ int argc; /* Number of command-line arguments. */
+ char **argv; /* Values of command-line arguments. */
+{
+ char *p;
+ char buffer[MAX_PATH];
+
+ /*
+ * Set up the default locale to be standard "C" locale so parsing
+ * is performed correctly.
+ */
+
+ setlocale(LC_ALL, "C");
+
+ 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 = '/';
+ }
+ }
+
+ Tcl_Main(argc, argv, Tcl_AppInit);
+ return 0; /* Needed only to prevent compiler warning. */
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppInit(interp)
+ Tcl_Interp *interp; /* Interpreter for application. */
+{
+ if (Tcl_Init(interp) == TCL_ERROR) {
+ return TCL_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 */
+
+ /*
+ * Call the init procedures for included packages. Each call should
+ * look like this:
+ *
+ * if (Mod_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * where "Mod" is the name of the module.
+ */
+ if (Itcl_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Itcl", Itcl_Init, Itcl_SafeInit);
+
+ /*
+ * This is itclsh, so import all [incr Tcl] commands by
+ * default into the global namespace. Fix up the autoloader
+ * to do the same.
+ */
+ if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
+ "::itcl::*", /* allowOverwrite */ 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_Eval(interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* }") != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Call Tcl_CreateCommand for application-specific commands, if
+ * they weren't already created by the init procedures called above.
+ */
+
+ /*
+ * Specify a user-specific startup file to invoke if the application
+ * is run interactively. Typically the startup file is "~/.apprc"
+ * where "app" is the name of the application. If this line is deleted
+ * then no user-specific startup file will be run under any conditions.
+ */
+
+ Tcl_SetVar(interp, "tcl_rcFileName", "~/itclshrc.tcl", TCL_GLOBAL_ONLY);
+ return TCL_OK;
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * setargv --
+ *
+ * Parse the Windows command line string into argc/argv. Done here
+ * because we don't trust the builtin argument parser in crt0.
+ * Windows applications are responsible for breaking their command
+ * line into arguments.
+ *
+ * 2N backslashes + quote -> N backslashes + begin quoted string
+ * 2N + 1 backslashes + quote -> literal
+ * N backslashes + non-quote -> literal
+ * quote + quote in a quoted string -> single quote
+ * quote + quote not in quoted string -> empty string
+ * quote -> begin quoted string
+ *
+ * Results:
+ * Fills argcPtr with the number of arguments and argvPtr with the
+ * array of arguments.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *--------------------------------------------------------------------------
+ */
+
+static void
+setargv(argcPtr, argvPtr)
+ 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;
+ slashes = 0;
+ while (1) {
+ copy = 1;
+ while (*p == '\\') {
+ slashes++;
+ p++;
+ }
+ if (*p == '"') {
+ if ((slashes & 1) == 0) {
+ copy = 0;
+ if ((inquote) && (p[1] == '"')) {
+ p++;
+ copy = 1;
+ } else {
+ inquote = !inquote;
+ }
+ }
+ slashes >>= 1;
+ }
+
+ 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;
+}
diff --git a/itcl/itk/demos/README b/itcl/itk/demos/README
new file mode 100644
index 00000000000..4884011f75f
--- /dev/null
+++ b/itcl/itk/demos/README
@@ -0,0 +1,9 @@
+
+ DEMOS
+------------------------------------------------------------------------
+ This directory contains some simple demos which show nifty things
+ you can build using [incr Tk]:
+
+ itkedit ......... Simple split-screen editor written
+ with [incr Widgets] in ~220 lines of code!
+
diff --git a/itcl/itk/demos/itkedit b/itcl/itk/demos/itkedit
new file mode 100644
index 00000000000..b20aef7265c
--- /dev/null
+++ b/itcl/itk/demos/itkedit
@@ -0,0 +1,227 @@
+#!/bin/sh
+#\
+exec itkwish $0
+# ======================================================================
+# Simple text editor built with [incr Widgets]
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# CLASS: Object-Oriented Programming with [incr Tcl]
+# ======================================================================
+package require Iwidgets 2.1
+
+option add *edit.width 5i startupFile
+option add *edit.height 4i startupFile
+option add *Fileselectiondialog.width 4i startupFile
+option add *Fileselectiondialog.height 5i startupFile
+
+# ----------------------------------------------------------------------
+set FileWindows 0
+
+# ----------------------------------------------------------------------
+# Dialog boxes
+# ----------------------------------------------------------------------
+messagedialog .notice -title "itkedit: Notice" \
+ -bitmap info -buttonboxpos e -modality application
+.notice hide OK
+.notice hide Help
+.notice buttonconfigure Cancel -text "Dismiss"
+
+messagedialog .confirm -title "itkedit: Confirm" \
+ -bitmap questhead -modality application
+.confirm hide Help
+.confirm buttonconfigure OK -text "Yes"
+.confirm buttonconfigure Cancel -text "No"
+
+fileselectiondialog .files -title "itkedit: Files" \
+ -childsitepos s -modality application
+.files hide Help
+
+set PaneMenu "[.files childsite].panes"
+optionmenu $PaneMenu -labeltext "Edit Window:"
+pack $PaneMenu -pady 6
+
+# ----------------------------------------------------------------------
+# USAGE: file_load
+#
+# Initiates the process of loading a new text file for editing.
+# Pops up a Fileselectiondialog, allowing the user to select a
+# file for editing. If the user pushes the "load" button, the
+# file is loaded.
+# ----------------------------------------------------------------------
+proc file_load {} {
+ global FileName PaneMenu
+
+ .files buttonconfigure OK -text "Load"
+ if {[.files activate]} {
+ set fname [.files get]
+ set cmd {
+ set fid [open $fname r]
+ set text [read $fid]
+ close $fid
+ }
+ if {[catch $cmd err] != 0} {
+ .notice configure -bitmap error \
+ -text "Cannot load file \"$fname\":\n$err"
+ .notice activate
+ return
+ }
+
+ set pane [$PaneMenu get]
+ set win [.edit childsite $pane]
+ clear_text $win
+ $win.text insert end $text
+ $win.text configure -labeltext "file: $fname"
+
+ set FileName($win) $fname
+ }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: file_save_as
+#
+# Initiates the process of saving the current text into a particular
+# file. Pops up a Fileselectiondialog, allowing the user to select
+# a file for saving. If the user pushes the "save" button, the
+# file is saved.
+# ----------------------------------------------------------------------
+proc file_save_as {} {
+ global FileName PaneMenu
+
+ .files buttonconfigure OK -text "Save"
+ if {[.files activate]} {
+ set pane [$PaneMenu get]
+ set win [.edit childsite $pane]
+
+ set FileName($win) [.files get]
+
+ file_save $win
+ }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: file_save <win>
+#
+# Saves the context of <win> into its associated file. Does the
+# dirty work to finish the file_save_as operation.
+# ----------------------------------------------------------------------
+proc file_save {win} {
+ global FileName FileChanged
+
+ set cmd {
+ set fid [open $FileName($win) w]
+ puts $fid [$win.text get 1.0 end]
+ close $fid
+ set FileChanged($win) 0
+ $win.text configure -labeltext "file: $FileName($win)"
+ }
+ if {[catch $cmd err] != 0} {
+ .notice configure -bitmap error \
+ -text "Cannot save file \"$FileName($win)\":\n$err"
+ .notice activate
+ }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: clear_text ?<win>?
+#
+# Clears the text area associated with <win>, making sure to save
+# any pending changes. If no <win> is specified, then all text
+# areas are cleared.
+# ----------------------------------------------------------------------
+proc clear_text {{areas ""}} {
+ global FileName FileChanged FileWindows
+
+ if {$areas == ""} {
+ for {set i 0} {$i < $FileWindows} {incr i} {
+ set pane "area #[expr $i+1]"
+ lappend areas [.edit childsite $pane]
+ }
+ }
+
+ foreach win $areas {
+ if {$FileChanged($win)} {
+ set fname [file tail $FileName($win)]
+ .confirm configure -text "File \"$fname\" has changed.\nSave changes?"
+ if {[.confirm activate]} {
+ file_save $win
+ }
+ }
+ $win.text delete 1.0 end
+ set FileChanged($win) 0
+ }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: split_view
+#
+# Adds another editing pane to the current editor.
+# ----------------------------------------------------------------------
+proc split_view {} {
+ global FileName FileChanged FileWindows PaneMenu
+
+ set pane "area #[incr FileWindows]"
+ .edit add $pane -minimum 100
+ $PaneMenu insert end $pane
+
+ set win [.edit childsite $pane]
+
+ set FileName($win) untitled.txt
+ set FileChanged($win) 0
+
+ scrolledtext $win.text -wrap none -labeltext "file: $FileName($win)" \
+ -hscrollmode none -vscrollmode dynamic -visibleitems 1x1
+ pack $win.text -expand yes -fill both
+
+ bind [$win.text component text] <KeyPress> "
+ set FileChanged($win) 1
+ "
+}
+
+frame .mbar -borderwidth 2 -relief raised
+pack .mbar -side top -fill x
+
+# ----------------------------------------------------------------------
+# FILE menu
+# ----------------------------------------------------------------------
+menubutton .mbar.file -text "File" -underline 0 -menu .mbar.file.menu
+pack .mbar.file -side left -padx 4
+
+menu .mbar.file.menu
+.mbar.file.menu add command -label "Load..." \
+ -accelerator " ^L" -underline 0 -command file_load
+bind . <Control-KeyPress-l> { .mbar.file.menu invoke "Load..." }
+
+.mbar.file.menu add command -label "Save As..." \
+ -accelerator " ^S" -underline 0 -command file_save_as
+bind . <Control-KeyPress-s> { .mbar.file.menu invoke "Save As..." }
+
+.mbar.file.menu add separator
+.mbar.file.menu add command -label "Quit" \
+ -accelerator " ^Q" -underline 0 -command {clear_text; exit}
+bind . <Control-KeyPress-q> { .mbar.file.menu invoke Quit }
+
+# ----------------------------------------------------------------------
+# VIEW menu
+# ----------------------------------------------------------------------
+menubutton .mbar.view -text "View" -underline 0 -menu .mbar.view.menu
+pack .mbar.view -side left -padx 4
+
+menu .mbar.view.menu
+.mbar.view.menu add command -label "Split" \
+ -underline 0 -command split_view
+
+# ----------------------------------------------------------------------
+# Editor
+# ----------------------------------------------------------------------
+panedwindow .edit -orient horizontal
+pack .edit -expand yes -fill both
+
+split_view
+
+wm title . "itkedit"
+wm protocol . WM_DELETE_WINDOW { .mbar.file.menu invoke Quit }
+
+after idle {
+ update idletasks
+ wm minsize . [winfo reqwidth .] [winfo reqheight .]
+}
diff --git a/itcl/itk/doc/Archetype.n b/itcl/itk/doc/Archetype.n
new file mode 100644
index 00000000000..5389d32d19f
--- /dev/null
+++ b/itcl/itk/doc/Archetype.n
@@ -0,0 +1,353 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH Archetype n 3.0 itk "[incr\ Tk]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+Archetype \- base class for all [incr\ Tk] mega-widgets
+.SH "INHERITANCE"
+none
+.ta 4c 8c 12c
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBclientData\fR
+Class: \fBClientData\fR
+Command-Line Switch: \fB-clientdata\fR
+.fi
+.IP
+This does not affect the widget operation in any way. It is
+simply a hook that clients can use to store a bit of data with
+each widget. This can come in handy when using widgets to
+build applications.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBArchetype\fR class is the basis for all \fB[incr\ Tk]\fR
+mega-widgets. It keeps track of component widgets and provides
+methods like "configure" and "cget" that are used to access
+the composite configuration options. Each component widget
+must be registered with the \fBArchetype\fR base class using
+the "\fBitk_component add\fR" method. When the component
+is registered, its configuration options are integrated into
+the composite option list. Configuring a composite option
+like "-background" causes all of the internal components
+to change their background color.
+.PP
+It is not used as a widget by itself, but is used as a base
+class for more specialized widgets. The \fBWidget\fR base class
+inherits from \fBArchetype\fR, and adds a Tk frame which acts as
+the "hull" for the mega-widget. The \fBToplevel\fR base class
+inherits from \fBArchetype\fR, but adds a Tk toplevel which acts
+as the "hull".
+.PP
+\fIEach derived class must invoke the \fBitk_initialize\fP method
+within its constructor\fR, so that all options are properly
+integrated and initialized in the composite list.
+
+
+.SH "PUBLIC METHODS"
+.PP
+The following methods are provided to support the public
+interface of the mega-widget.
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+.sp
+In this case, \fIoption\fR refers to a composite configuration
+option for the mega-widget. Individual components integrate
+their own configuration options onto the composite list when
+they are registered by the "\fBitk_component add\fR" method.
+.TP
+\fIpathName\fR \fBcomponent\fR ?\fIname\fR? ?\fIcommand arg arg ...\fR?
+Used to query or access component widgets within a mega-widget.
+With no arguments, this returns a list of symbolic names for
+component widgets that are accessible in the current scope.
+The symbolic name for a component is established when it is
+registered by the "\fBitk_component add\fR" method. Note that
+component widgets obey any public/protected/private access
+restriction that is in force when the component is created.
+.sp
+If a symbolic \fIname\fR is specified, this method returns the
+window path name for that component.
+.sp
+Otherwise, the \fIcommand\fR and any remaining \fIarg\fR arguments
+are invoked as a method on the component with the symbolic
+name \fIname\fR. This provides a well-defined way of accessing
+internal components without relying on specific window path
+names, which are really details of the implementation.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+.sp
+In this case, the \fIoptions\fR refer to composite configuration
+options for the mega-widget. Individual components integrate their
+own configuration options onto the composite list when they are
+registered by the "\fBitk_component add\fR" method.
+
+.SH "PROTECTED METHODS"
+.PP
+The following methods are used in derived classes as part of
+the implementation for a mega-widget.
+.TP
+\fBitk_component add\fR ?\fB-protected\fR? ?\fB-private\fR? ?\fB--\fR? \fIname createCmds\fR ?\fIoptionCmds\fR?
+Creates a component widget by executing the \fIcreateCmds\fR
+argument and registers the new component with the symbolic
+name \fIname\fR. The \fB-protected\fR and \fB-private\fR options
+can be used to keep the component hidden from the outside world.
+These options have a similar effect on component visibility as
+they have on class members.
+.sp
+The \fIcreateCmds\fR code can contain any
+number of commands, but it must return the window path name
+for the new component widget.
+.sp
+The \fIoptionCmds\fR script contains commands that describe
+how the configuration options for the new component should
+be integrated into the composite list for the mega-widget.
+It can contain any of the following commands:
+.RS
+.TP
+\fBignore \fIoption\fR ?\fIoption option ...\fR?
+Removes one or more configuration \fIoptions\fR from the
+composite list. All options are ignored by default,
+so the \fBignore\fR command is only used to negate the
+effect of a previous \fBkeep\fR or \fBrename\fR command.
+This is useful, for example, when the some of the options
+added by the \fBusual\fR command should not apply to
+a particular component, and need to be ignored.
+.TP
+\fBkeep \fIoption\fR ?\fIoption option ...\fR?
+Integrates one or more configuration \fIoptions\fR into the
+composite list, keeping the name the same. Whenever the
+mega-widget option is configured, the new value is also
+applied to the current component. Options like "-background"
+and "-cursor" are commonly found on the \fBkeep\fR list.
+.TP
+\fBrename \fIoption switchName resourceName resourceClass\fR
+Integrates the configuration \fIoption\fR into the composite
+list with a different name. The option will be called
+\fIswitchName\fR on the composite list. It will also be
+modified by setting values for \fIresourceName\fR and \fIresourceClass\fR
+in the X11 resource database. The "-highlightbackground"
+option is commonly renamed to "-background", so that when
+the mega-widget background changes, the background of the
+focus ring will change as well.
+.TP
+\fBusual ?\fItag\fR?
+Finds the usual option-handling commands for the specified
+\fItag\fR name and executes them. If the \fItag\fR is
+not specified, then the widget class name is used as the
+\fItag\fR name. The "usual" option-handling commands
+are registered via the \fBusual\fR command.
+.RE
+.sp
+If the \fIoptionCmds\fR script is not specified, the usual
+option-handling commands associated with the class of the
+component widget are used by default.
+
+.TP
+\fBitk_component delete\fR \fIname\fR ?\fIname name ...\fR?
+Removes the component widget with the symbolic name \fIname\fR
+from the mega-widget. The component widget will still exist,
+but it will no longer be accessible as a component of the
+mega-widget. Also, any options associated with the component
+are removed from the composite option list.
+.sp
+Note that you can destroy a component using the \fBdestroy\fR
+command, just as you would destroy any Tk widget. Components
+automatically detach themselves from their mega-widget parent
+when destroyed, so "\fBitk_component delete\fR" is rarely used.
+
+.TP
+\fBitk_initialize ?\fIoption value option value...\fR?
+\fIThis method must be invoked within the constructor for
+each class in a mega-widget hierarchy.\fR It makes sure
+that all options are properly integrated into the composite
+option list, and synchronizes all components to the initial
+option values. It is usually invoked near the bottom of
+the constructor, after all component widgets have been
+added.
+.sp
+If any \fIoption\fR/\fIvalue\fR pairs are specified, they
+override settings determined from the X11 resource database.
+The arguments to the constructor are usually passed along
+to this method as follows:
+.CS
+class MyWidget {
+ inherit Widget
+
+ constructor {args} {
+ .
+ .
+ .
+ eval itk_initialize $args
+ }
+}
+.CE
+
+.TP
+\fBitk_option add\fR \fIoptName\fR ?\fIoptName optName ...\fR?
+Adds one or more options to the composite option list for
+a mega-widget. Here, \fIoptName\fR can have one of the
+following forms:
+.RS
+.TP
+\fIcomponent\fR.\fIoption\fR
+Accesses an \fIoption\fR belonging to a component with the
+symbolic name \fIcomponent\fR. The \fIoption\fR name is
+specified without a leading "\fB-\fR" sign.
+.TP
+\fIclassName\fR::\fIoption\fR
+Accesses an \fIoption\fR defined by the "\fBitk_option define\fR"
+command in class \fIclassName\fR. The \fIoption\fR name is
+specified without a leading "\fB-\fR" sign.
+.RE
+.PP
+Options are normally integrated into the composite option list
+when a component widget is first created. This method can be
+used to add options at a later time. For example, the \fBWidget\fR
+and \fBToplevel\fR base classes keep only the bare minimum options
+for their "hull" component: -background and -cursor. A derived
+class can override this decision, and add options that control
+the border of the "hull" component as well:
+.CS
+class MyWidget {
+ inherit Widget
+
+ constructor {args} {
+ itk_option add hull.borderwidth hull.relief
+
+ itk_component add label {
+ label $itk_interior.l1 -text "Hello World!"
+ }
+ pack $itk_component(label)
+
+ eval itk_initialize $args
+ }
+}
+.CE
+
+.TP
+\fBitk_option define\fR \fIswitchName resourceName resourceClass init\fR ?\fIconfig\fR?
+This command is used at the level of the class definition to
+define a synthetic mega-widget option. Within the \fBconfigure\fR
+and \fBcget\fR methods, this option is referenced by \fIswitchName\fR,
+which must start with a "\fB-\fR" sign. It can also be
+modified by setting values for \fIresourceName\fR and \fIresourceClass\fR
+in the X11 resource database. The \fIinit\fR value string is used
+as a last resort to initialize the option if no other value can
+be used from an existing option, or queried from the X11 resource
+database. If any \fIconfig\fR code is specified, it is executed
+whenever the option is modified via the \fBconfigure\fR method.
+The \fIconfig\fR code can also be specified outside of the class
+definition via the \fBconfigbody\fR command.
+.sp
+In the following example, a synthetic "-background" option is
+added to the class, so that whenever the background changes, the
+new value is reported to standard output. Note that this synthetic
+option is integrated with the rest of the "-background" options
+that have been kept from component widgets:
+.CS
+class MyWidget {
+ inherit Widget
+ constructor {args} {
+ itk_component add label {
+ label $itk_interior.l1 -text "Hello World!"
+ }
+ pack $itk_component(label)
+
+ eval itk_initialize $args
+ }
+ itk_option define -background background Background #d9d9d9 {
+ puts "new background: $itk_option(-background)"
+ }
+}
+.CE
+
+.TP
+\fBitk_option remove\fR \fIoptName\fR ?\fIoptName optName ...\fR?
+Removes one or more options from the composite option list for
+a mega-widget. Here, \fIoptName\fR can have one of the forms
+described above for the "\fBitk_option add\fR" command.
+.sp
+Options are normally integrated into the composite option list
+when a component widget is first created. This method can be
+used to remove options at a later time. For example, a derived
+class can override an option defined in a base class by removing
+and redefining the option:
+.CS
+class Base {
+ inherit Widget
+ constructor {args} {
+ eval itk_initialize $args
+ }
+
+ itk_option define -foo foo Foo "" {
+ puts "Base: $itk_option(-foo)"
+ }
+}
+
+class Derived {
+ inherit Base
+
+ constructor {args} {
+ itk_option remove Base::foo
+ eval itk_initialize $args
+ }
+ itk_option define -foo foo Foo "" {
+ puts "Derived: $itk_option(-foo)"
+ }
+}
+.CE
+Without the "\fBitk_option remove\fR" command, the code fragments
+for both of the "-foo" options would be executed each time the
+composite "-foo" option is configured. In the example above,
+the \fCBase::foo\fR option is suppressed in all Derived class
+widgets, so only the \fCDerived::foo\fR option remains.
+
+.SH "PROTECTED VARIABLES"
+Derived classes can find useful information in the following
+protected variables.
+.TP
+itk_component(\fIname\fR)
+The "itk_component" array returns the real window path name
+for a component widget with the symbolic name \fIname\fR.
+The same information can be queried using the \fBcomponent\fR
+method, but accessing this array is faster and more convenient.
+.TP
+itk_interior
+This variable contains the name of the window that acts as
+a parent for internal components. It is initialized to the
+name of the "hull" component provided by the \fBWidget\fR
+and \fBToplevel\fR classes. Derived classes can override
+the initial setting to point to another interior window
+to be used for further-derived classes.
+.TP
+itk_option(\fIoption\fR)
+The "itk_option" array returns the current option value
+for the composite widget option named \fIoption\fR. Here,
+the \fIoption\fR name should include a leading "\fB-\fR" sign.
+The same information can be queried using the \fBcget\fR
+method, but accessing this array is faster and more convenient.
+
+.SH KEYWORDS
+itk, Widget, Toplevel, mega-widget
diff --git a/itcl/itk/doc/Toplevel.n b/itcl/itk/doc/Toplevel.n
new file mode 100644
index 00000000000..b11c4b2d029
--- /dev/null
+++ b/itcl/itk/doc/Toplevel.n
@@ -0,0 +1,133 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH Toplevel n 3.0 itk "[incr\ Tk]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+Toplevel \- base class for mega-widgets in a top-level window
+.SH "INHERITANCE"
+itk::Archetype <- itk::Toplevel
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBcursor\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBtitle\fR
+Class: \fBTitle\fR
+Command-Line Switch: \fB-title\fR
+.fi
+.IP
+Sets the title that the window manager displays in the title bar
+above the window. The default title is the null string.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBToplevel\fR class inherits everything from the \fBArchetype\fR
+class, and adds a Tk toplevel called the "hull" component to represent
+the body of the mega-widget. The window class name for the hull
+is set to the most-specific class name for the mega-widget.
+The protected variable \fBitk_interior\fR contains the window
+path name for the "hull" component. Derived classes specialize
+this widget by packing other widget components into the hull.
+.PP
+Since the hull for the \fBToplevel\fR class is implemented with
+a Tk toplevel, mega-widgets in the \fBToplevel\fR class have
+their own toplevel window. This class is used to create dialog
+boxes and other pop-up windows.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBhull\fR
+Class: \fBToplevel\fR
+.fi
+.IP
+The "hull" component acts as the body for the entire mega-widget.
+Other components are packed into the hull to further specialize
+the widget.
+
+.SH EXAMPLE
+.PP
+The following example implements a \fBMessageInfo\fR
+mega-widget. It creates a pop-up message that the
+user can dismiss by pushing the "Dismiss" button.
+.CS
+option add *MessageInfo.title "Notice" widgetDefault
+
+class MessageInfo {
+ inherit itk::Toplevel
+
+ constructor {args} {
+ itk_component add dismiss {
+ button $itk_interior.dismiss -text "Dismiss" \
+ -command "destroy $itk_component(hull)"
+ }
+ pack $itk_component(dismiss) -side bottom -pady 4
+
+ itk_component add separator {
+ frame $itk_interior.sep -height 2 -borderwidth 1 -relief sunken
+ }
+ pack $itk_component(separator) -side bottom -fill x -padx 4
+
+ itk_component add icon {
+ label $itk_interior.icon -bitmap info
+ }
+ pack $itk_component(icon) -side left -padx 8 -pady 8
+
+ itk_component add infoFrame {
+ frame $itk_interior.info
+ }
+ pack $itk_component(infoFrame) -side left -expand yes \
+ -fill both -padx 4 -pady 4
+
+ itk_component add message {
+ label $itk_interior.mesg -width 20
+ } {
+ usual
+ rename -text -message message Text
+ }
+ pack $itk_component(message) -expand yes -fill both
+
+ eval itk_initialize $args
+
+ after idle [code $this centerOnScreen]
+ }
+
+ protected method centerOnScreen {} {
+ update idletasks
+ set wd [winfo reqwidth $itk_component(hull)]
+ set ht [winfo reqheight $itk_component(hull)]
+ set x [expr ([winfo screenwidth $itk_component(hull)]-$wd)/2]
+ set y [expr ([winfo screenheight $itk_component(hull)]-$ht)/2]
+ wm geometry $itk_component(hull) +$x+$y
+ }
+}
+
+usual MessageInfo {
+ keep -background -cursor -foreground -font
+ keep -activebackground -activeforeground -disabledforeground
+ keep -highlightcolor -highlightthickness
+}
+
+#
+# EXAMPLE: Create a notice window:
+#
+MessageInfo .m -message "File not found:\\n/usr/local/bin/foo"
+.CE
+
+.SH KEYWORDS
+itk, Archetype, Widget, mega-widget
diff --git a/itcl/itk/doc/Widget.n b/itcl/itk/doc/Widget.n
new file mode 100644
index 00000000000..0c74fd92ebe
--- /dev/null
+++ b/itcl/itk/doc/Widget.n
@@ -0,0 +1,123 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH Widget n 3.0 itk "[incr\ Tk]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+Widget \- base class for mega-widgets within a frame
+.SH "INHERITANCE"
+itk::Archetype <- itk::Widget
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBcursor\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBWidget\fR class inherits everything from the \fBArchetype\fR
+class, and adds a Tk frame called the "hull" component to represent
+the body of the mega-widget. The window class name for the hull
+is set to the most-specific class name for the mega-widget.
+The protected variable \fBitk_interior\fR contains the window
+path name for the "hull" component. Derived classes specialize
+this widget by packing other widget components into the hull.
+.PP
+Since the hull for the \fBWidget\fR class is implemented with a
+Tk frame, mega-widgets in the \fBWidget\fR class can be packed
+into other frames and toplevels.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBhull\fR
+Class: \fBFrame\fR
+.fi
+.IP
+The "hull" component acts as the body for the entire mega-widget.
+Other components are packed into the hull to further specialize
+the widget.
+
+.SH EXAMPLE
+.PP
+The following example implements a simple \fBTextDisplay\fR
+mega-widget. It creates a read-only display of text with
+a text widget and a scrollbar.
+.CS
+option add *TextDisplay.wrap none widgetDefault
+option add *TextDisplay.textBackground ivory widgetDefault
+option add *TextDisplay.width 40 widgetDefault
+option add *TextDisplay.height 10 widgetDefault
+
+class TextDisplay {
+ inherit itk::Widget
+
+ constructor {args} {
+ itk_component add text {
+ text $itk_interior.info -state disabled \
+ -yscrollcommand [code $itk_interior.sbar set]
+ } {
+ usual
+ keep -tabs -wrap -width -height
+ rename -background -textbackground textBackground Background
+ }
+ pack $itk_component(text) -side left -expand yes -fill both
+
+ itk_component add scrollbar {
+ scrollbar $itk_interior.sbar \
+ -command [code $itk_interior.info yview]
+ }
+ pack $itk_component(scrollbar) -side right -fill y
+
+ eval itk_initialize $args
+ }
+
+ public method display {info}
+ public method append {info}
+}
+
+body TextDisplay::display {info} {
+ $itk_component(text) configure -state normal
+ $itk_component(text) delete 1.0 end
+ $itk_component(text) insert 1.0 $info
+ $itk_component(text) configure -state disabled
+}
+
+body TextDisplay::append {info} {
+ $itk_component(text) configure -state normal
+ $itk_component(text) insert end $info
+ $itk_component(text) configure -state disabled
+}
+
+usual TextDisplay {
+ keep -background -cursor -foreground -font
+ keep -activebackground -activerelief
+ keep -highlightcolor -highlightthickness
+ keep -insertbackground -insertborderwidth -insertwidth
+ keep -insertontime -insertofftime
+ keep -selectbackground -selectborderwidth -selectforeground
+ keep -textbackground -troughcolor
+}
+
+#
+# EXAMPLE: Display the /etc/passwd file
+#
+TextDisplay .file -background red
+pack .file
+
+\&.file display [exec cat /etc/passwd]
+.CE
+
+.SH KEYWORDS
+itk, Archetype, Widget, mega-widget
diff --git a/itcl/itk/doc/itk.n b/itcl/itk/doc/itk.n
new file mode 100644
index 00000000000..6a58bb19948
--- /dev/null
+++ b/itcl/itk/doc/itk.n
@@ -0,0 +1,96 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH itk n 3.0 itk "[incr\ Tk]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+itk \- framework for building mega-widgets in Tcl/Tk
+.BE
+
+.SH DESCRIPTION
+.PP
+Mega-widgets are high-level widgets that are constructed using
+Tk widgets as component parts, usually without any C code. A
+fileselectionbox, for example, may have a few listboxes, some
+entry widgets and some control buttons. These individual widgets
+are put together in a way that makes them act like one big
+widget. A fileselectionbox mega-widget can be created with a
+command like:
+.CS
+fileselectionbox .fsb -background blue -foreground white
+.CE
+Once it has been created, it can be reconfigured with a command
+like:
+.CS
+\&.fsb configure -background green -foreground black
+.CE
+and all of its internal components will change color. Each
+mega-widget has a set of methods that can be used to manipulate
+it. For example, the current selection can be queried from a
+fileselectionbox like this:
+.CS
+set fileName [.fsb get]
+.CE
+In effect, a mega-widget looks and acts exactly like a Tk widget,
+but is considerably easier to implement.
+.PP
+\fB[incr\ Tk]\fR is a framework for building mega-widgets. It
+uses \fB[incr\ Tcl]\fR to support the object paradigm, and adds
+base classes which provide default widget behaviors.
+.PP
+All \fB[incr\ Tk]\fR widgets are derived from the \fBArchetype\fR
+base class. This class manages internal component widgets,
+and provides methods like "configure" and "cget" to access
+configuration options.
+.PP
+The \fBWidget\fR base class inherits everything from \fBArchetype\fR,
+and adds a Tk frame which acts as a container for the mega-widget.
+It is used to build mega-widgets that sit inside of other frames
+and toplevels. Derived classes create other internal components
+and pack them into the "hull" frame created by the \fBWidget\fR
+base class.
+.PP
+The \fBToplevel\fR base class inherits everything from \fBArchetype\fR,
+but adds a Tk toplevel which acts as a container for the mega-widget.
+It is used to build mega-widgets, such as dialog boxes, that have
+their own toplevel window. Derived classes create other internal
+components and pack them into the "hull" toplevel created by the
+\fBToplevel\fR base class.
+
+.SH [incr Widgets] LIBRARY
+.PP
+\fB[incr\ Widgets]\fR is a mega-widget library built using
+\fB[incr\ Tk]\fR. It can be used right out of the box, and
+contains more than 30 different widget classes, including:
+.IP -
+fileselectiondialog
+.IP -
+tabnotebook
+.IP -
+panedwindow
+.IP -
+combobox
+.IP -
+optionmenu
+.IP -
+scrolledlistbox
+.IP -
+scrolledframe
+.IP -
+messagedialog
+.IP -
+and many others...
+.LP
+The \fBcatalog\fR demo in the "iwidgets/demos" directory
+shows all of the available widgets in action. Each widget
+class has its own man page describing the features available.
+
+.SH KEYWORDS
+class, object, object-oriented, mega-widget
diff --git a/itcl/itk/doc/itkvars.n b/itcl/itk/doc/itkvars.n
new file mode 100644
index 00000000000..6271ae9821b
--- /dev/null
+++ b/itcl/itk/doc/itkvars.n
@@ -0,0 +1,43 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH itkvars n 3.0 itk "[incr\ Tk]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+itkvars \- variables used by [incr\ Tk]
+.BE
+
+.SH DESCRIPTION
+.PP
+The following global variables are created and managed automatically
+by the \fB[incr\ Tk]\fR library. Except where noted below, these
+variables should normally be treated as read-only by application-specific
+code and by users.
+.TP
+\fBitk::library\fR
+When an interpreter is created, \fB[incr\ Tk]\fR initializes this
+variable to hold the name of a directory containing the system library
+of \fB[incr\ Tk]\fR scripts. The initial value of \fBitk::library\fR
+is set from the ITK_LIBRARY environment variable if it exists,
+or from a compiled-in value otherwise.
+.sp
+When \fB[incr\ Tk]\fR is added to an interpreter, it executes
+the script "\fCinit.itk\fR" in this directory. This script,
+in turn, looks for other script files with the name "\fCinit.\fIxxx\fR".
+Mega-widget libraries will be automatically initialized if they
+install a script named "\fCinit.\fIxxx\fR" in this directory,
+where "\fIxxx\fR" is the name of the mega-widget library.
+For example, the \fB[incr\ Widgets]\fR library installs
+the script "\fCinit.iwidgets\fR" in this directory.
+This script establishes the "iwidgets" namespace, and sets
+up autoloading for all \fB[incr\ Widgets]\fR commands.
+
+.SH KEYWORDS
+itcl, itk, variables
diff --git a/itcl/itk/doc/itkwish.1 b/itcl/itk/doc/itkwish.1
new file mode 100644
index 00000000000..b6a12194b81
--- /dev/null
+++ b/itcl/itk/doc/itkwish.1
@@ -0,0 +1,55 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH itkwish 1 3.0 itk "[incr\ Tk]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+itkwish \- Simple windowing shell for [incr\ Tcl] / [incr\ Tk]
+.SH SYNOPSIS
+\fBitkwish\fR ?\fIfileName arg arg ...\fR?
+.SH OPTIONS
+.IP "\fB\-display \fIdisplay\fR" 20
+Display (and screen) on which to display window.
+.IP "\fB\-geometry \fIgeometry\fR" 20
+Initial geometry to use for window. If this option is specified, its
+value is stored in the \fBgeometry\fR global variable of the application's
+Tcl interpreter.
+.IP "\fB\-name \fIname\fR" 20
+Use \fIname\fR as the title to be displayed in the window, and
+as the name of the interpreter for \fBsend\fR commands.
+.IP "\fB\-sync\fR" 20
+Execute all X server commands synchronously, so that errors
+are reported immediately. This will result in much slower
+execution, but it is useful for debugging.
+.IP "\fB\-\|\-\fR" 20
+Pass all remaining arguments through to the script's \fBargv\fR
+variable without interpreting them.
+This provides a mechanism for passing arguments such as \fB\-name\fR
+to a script instead of having \fBitkwish\fR interpret them.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBitkwish\fR is a simple program consisting of the Tcl command
+language, the Tk toolkit, the \fB[incr\ Tcl]\fR extension for
+object-oriented programming, and the \fB[incr\ Tk]\fR extension
+for building mega-widgets. The main program creates an
+interpreter, creates a main window, and then processes Tcl
+commands from standard input or from a file.
+.PP
+\fBitkwish\fR is just like \fBwish\fR, but includes the
+\fB[incr\ Tcl]\fR / \fB[incr\ Tk]\fR extensions.
+.PP
+See the \fBwish\fR man page for details concerning usage. See
+the \fBitcl\fR and \fBitk\fR man pages for an overview of
+\fB[incr\ Tcl]\fR / \fB[incr\ Tk]\fR.
+
+.SH KEYWORDS
+Tcl, Tk, itcl, itk, interpreter, shell, toolkit
diff --git a/itcl/itk/doc/license.terms b/itcl/itk/doc/license.terms
new file mode 100644
index 00000000000..5ad564315d8
--- /dev/null
+++ b/itcl/itk/doc/license.terms
@@ -0,0 +1,27 @@
+------------------------------------------------------------------------
+>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> [incr Tcl] <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+
+ AUTHOR: Michael J. McLennan
+ Bell Labs Innovations for Lucent Technologies
+ mmclennan@lucent.com
+ http://www.tcltk.com/itcl
+========================================================================
+ Copyright (c) 1993-1996 Lucent Technologies
+========================================================================
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that the copyright notice and warranty disclaimer appear in
+supporting documentation, and that the names of Lucent Technologies
+any of their entities not be used in advertising or publicity
+pertaining to distribution of the software without specific, written
+prior permission.
+
+Lucent Technologies disclaims all warranties with regard to this
+software, including all implied warranties of merchantability and
+fitness. In no event shall Lucent be liable for any special, indirect
+or consequential damages or any damages whatsoever resulting from loss
+of use, data or profits, whether in an action of contract, negligence
+or other tortuous action, arising out of or in connection with the use
+or performance of this software.
+========================================================================
diff --git a/itcl/itk/doc/man.macros b/itcl/itk/doc/man.macros
new file mode 100644
index 00000000000..3af2da92934
--- /dev/null
+++ b/itcl/itk/doc/man.macros
@@ -0,0 +1,236 @@
+'\" The definitions below are for supplemental macros used in Tcl/Tk
+'\" manual entries.
+'\"
+'\" .AP type name in/out ?indent?
+'\" Start paragraph describing an argument to a library procedure.
+'\" type is type of argument (int, etc.), in/out is either "in", "out",
+'\" or "in/out" to describe whether procedure reads or modifies arg,
+'\" and indent is equivalent to second arg of .IP (shouldn't ever be
+'\" needed; use .AS below instead)
+'\"
+'\" .AS ?type? ?name?
+'\" Give maximum sizes of arguments for setting tab stops. Type and
+'\" name are examples of largest possible arguments that will be passed
+'\" to .AP later. If args are omitted, default tab stops are used.
+'\"
+'\" .BS
+'\" Start box enclosure. From here until next .BE, everything will be
+'\" enclosed in one large box.
+'\"
+'\" .BE
+'\" End of box enclosure.
+'\"
+'\" .CS
+'\" Begin code excerpt.
+'\"
+'\" .CE
+'\" End code excerpt.
+'\"
+'\" .VS ?version? ?br?
+'\" Begin vertical sidebar, for use in marking newly-changed parts
+'\" of man pages. The first argument is ignored and used for recording
+'\" the version when the .VS was added, so that the sidebars can be
+'\" found and removed when they reach a certain age. If another argument
+'\" is present, then a line break is forced before starting the sidebar.
+'\"
+'\" .VE
+'\" End of vertical sidebar.
+'\"
+'\" .DS
+'\" Begin an indented unfilled display.
+'\"
+'\" .DE
+'\" End of indented unfilled display.
+'\"
+'\" .SO
+'\" Start of list of standard options for a Tk widget. The
+'\" options follow on successive lines, in four columns separated
+'\" by tabs.
+'\"
+'\" .SE
+'\" End of list of standard options for a Tk widget.
+'\"
+'\" .OP cmdName dbName dbClass
+'\" Start of description of a specific option. cmdName gives the
+'\" option's name as specified in the class command, dbName gives
+'\" the option's name in the option database, and dbClass gives
+'\" the option's class in the option database.
+'\"
+'\" .UL arg1 arg2
+'\" Print arg1 underlined, then print arg2 normally.
+'\"
+'\" SCCS: @(#) man.macros 1.9 97/08/22 18:50:59
+'\"
+'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages.
+.if t .wh -1.3i ^B
+.nr ^l \n(.l
+.ad b
+'\" # Start an argument description
+.de AP
+.ie !"\\$4"" .TP \\$4
+.el \{\
+. ie !"\\$2"" .TP \\n()Cu
+. el .TP 15
+.\}
+.ie !"\\$3"" \{\
+.ta \\n()Au \\n()Bu
+\&\\$1 \\fI\\$2\\fP (\\$3)
+.\".b
+.\}
+.el \{\
+.br
+.ie !"\\$2"" \{\
+\&\\$1 \\fI\\$2\\fP
+.\}
+.el \{\
+\&\\fI\\$1\\fP
+.\}
+.\}
+..
+'\" # define tabbing values for .AP
+.de AS
+.nr )A 10n
+.if !"\\$1"" .nr )A \\w'\\$1'u+3n
+.nr )B \\n()Au+15n
+.\"
+.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n
+.nr )C \\n()Bu+\\w'(in/out)'u+2n
+..
+.AS Tcl_Interp Tcl_CreateInterp in/out
+'\" # BS - start boxed text
+'\" # ^y = starting y location
+'\" # ^b = 1
+.de BS
+.br
+.mk ^y
+.nr ^b 1u
+.if n .nf
+.if n .ti 0
+.if n \l'\\n(.lu\(ul'
+.if n .fi
+..
+'\" # BE - end boxed text (draw box now)
+.de BE
+.nf
+.ti 0
+.mk ^t
+.ie n \l'\\n(^lu\(ul'
+.el \{\
+.\" Draw four-sided box normally, but don't draw top of
+.\" box if the box started on an earlier page.
+.ie !\\n(^b-1 \{\
+\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.el \}\
+\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.\}
+.fi
+.br
+.nr ^b 0
+..
+'\" # VS - start vertical sidebar
+'\" # ^Y = starting y location
+'\" # ^v = 1 (for troff; for nroff this doesn't matter)
+.de VS
+.if !"\\$2"" .br
+.mk ^Y
+.ie n 'mc \s12\(br\s0
+.el .nr ^v 1u
+..
+'\" # VE - end of vertical sidebar
+.de VE
+.ie n 'mc
+.el \{\
+.ev 2
+.nf
+.ti 0
+.mk ^t
+\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n'
+.sp -1
+.fi
+.ev
+.\}
+.nr ^v 0
+..
+'\" # Special macro to handle page bottom: finish off current
+'\" # box/sidebar if in box/sidebar mode, then invoked standard
+'\" # page bottom macro.
+.de ^B
+.ev 2
+'ti 0
+'nf
+.mk ^t
+.if \\n(^b \{\
+.\" Draw three-sided box if this is the box's first page,
+.\" draw two sides but no top otherwise.
+.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.\}
+.if \\n(^v \{\
+.nr ^x \\n(^tu+1v-\\n(^Yu
+\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c
+.\}
+.bp
+'fi
+.ev
+.if \\n(^b \{\
+.mk ^y
+.nr ^b 2
+.\}
+.if \\n(^v \{\
+.mk ^Y
+.\}
+..
+'\" # DS - begin display
+.de DS
+.RS
+.nf
+.sp
+..
+'\" # DE - end display
+.de DE
+.fi
+.RE
+.sp
+..
+'\" # SO - start of list of standard options
+.de SO
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+.ft B
+..
+'\" # SE - end of list of standard options
+.de SE
+.fi
+.ft R
+.LP
+See the \\fBoptions\\fR manual entry for details on the standard options.
+..
+'\" # OP - start of full description for a single option
+.de OP
+.LP
+.nf
+.ta 4c
+Command-Line Name: \\fB\\$1\\fR
+Database Name: \\fB\\$2\\fR
+Database Class: \\fB\\$3\\fR
+.fi
+.IP
+..
+'\" # CS - begin code excerpt
+.de CS
+.RS
+.nf
+.ta .25i .5i .75i 1i
+..
+'\" # CE - end code excerpt
+.de CE
+.fi
+.RE
+..
+.de UL
+\\$1\l'|0\(ul'\\$2
+..
diff --git a/itcl/itk/doc/usual.n b/itcl/itk/doc/usual.n
new file mode 100644
index 00000000000..0e2c4646c6c
--- /dev/null
+++ b/itcl/itk/doc/usual.n
@@ -0,0 +1,76 @@
+'\"
+'\" Copyright (c) 1993-1998 Lucent Technologies, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" RCS: $Id$
+'\"
+.so man.macros
+.TH usual n 3.0 itk "[incr\ Tk]"
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+usual \- access default option-handling commands
+.br
+ for a mega-widget component
+.SH SYNOPSIS
+\fBusual ?\fItag\fR? ?\fIcommands\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBusual\fR command is used outside of an \fB[incr\ Tcl]\fR
+class definition to define the usual set of option-handling
+commands for a component widget. Option-handling commands
+are used when a component is registered with the \fBArchetype\fR
+base class via the "\fBitk_component add\fR" method. They
+specify how the component's configuration options should be
+integrated into the composite option list for the mega-widget.
+Options can be kept, renamed, or ignored, as described in the
+\fBArchetype\fR man page.
+.PP
+It is tedious to include the same declarations again and again
+whenever components are added. The \fBusual\fR command allows
+a standard code fragment to be registered for each widget class,
+which is used by default to handle the options. All of the
+standard Tk widgets have \fBusual\fR declarations defined in
+the \fB[incr\ Tk]\fR library. Similar \fBusual\fR declarations
+should be created whenever a new mega-widget class is conceived.
+Only the most-generic options should be included in the \fBusual\fR
+declaration.
+.PP
+The \fItag\fR name is usually the name of a widget class,
+which starts with a capital letter; however, any string registered
+here can be used later with the \fBusual\fR command described
+on the \fBArchetype\fR man page.
+.PP
+If the \fIcommands\fR argument is specified, it is associated
+with the \fItag\fR string, and can be accessed later via
+\fBitk_component add\fR.
+.PP
+If only the \fItag\fR argument is specified, this command looks for
+an existing \fItag\fR name and returns the commands associated
+with it. If there are no commands associated with \fItag\fR,
+this command returns the null string.
+.PP
+If no arguments are specified, this command returns a list of
+all \fItag\fR names previously registered.
+
+.SH EXAMPLE
+Following is the \fBusual\fR declaration for the standard
+Tk button widget:
+.CS
+usual Button {
+ keep -background -cursor -foreground -font
+ keep -activebackground -activeforeground -disabledforeground
+ keep -highlightcolor -highlightthickness
+ rename -highlightbackground -background background Background
+}
+.CE
+Only the options that would be common to all buttons in a
+single mega-widget are kept or renamed. Options like "-text"
+that would be unique to a particular button are ignored.
+
+.SH KEYWORDS
+itk, Archetype, component, mega-widget
diff --git a/itcl/itk/examples/Info.itk b/itcl/itk/examples/Info.itk
new file mode 100644
index 00000000000..c4f86d52ddd
--- /dev/null
+++ b/itcl/itk/examples/Info.itk
@@ -0,0 +1,59 @@
+# ----------------------------------------------------------------------
+# EXAMPLE: info dialog box (Toplevel widget)
+# ----------------------------------------------------------------------
+# COURSE: Object-Oriented Programming with [incr Tcl]
+# AUTHOR: Michael J. McLennan, Bell Labs Innovations
+# ======================================================================
+# Copyright (c) 1996 Lucent Technologies
+# ======================================================================
+
+option add *Info.title "Info" widgetDefault
+
+class Info {
+ inherit itk::Toplevel
+
+ constructor {args} {
+ itk_component add dismiss {
+ button $itk_interior.dismiss -text "Dismiss" \
+ -command "destroy $itk_component(hull)"
+ }
+ pack $itk_component(dismiss) -side bottom -pady 4
+
+ itk_component add separator {
+ frame $itk_interior.sep -height 2 -borderwidth 1 -relief sunken
+ }
+ pack $itk_component(separator) -side bottom -fill x -padx 4
+
+ itk_component add icon {
+ label $itk_interior.icon -bitmap info
+ }
+ pack $itk_component(icon) -side left -padx 8 -pady 8
+
+ itk_component add infoFrame {
+ frame $itk_interior.info
+ }
+ pack $itk_component(infoFrame) -side left -expand yes \
+ -fill both -padx 4 -pady 4
+
+ set itk_interior $itk_component(infoFrame)
+
+ eval itk_initialize $args
+
+ after idle [code $this centerOnScreen]
+ }
+
+ protected method centerOnScreen {} {
+ update idletasks
+ set wd [winfo reqwidth $itk_component(hull)]
+ set ht [winfo reqheight $itk_component(hull)]
+ set x [expr ([winfo screenwidth $itk_component(hull)]-$wd)/2]
+ set y [expr ([winfo screenheight $itk_component(hull)]-$ht)/2]
+ wm geometry $itk_component(hull) +$x+$y
+ }
+}
+
+usual Info {
+ keep -background -cursor -foreground -font
+ keep -activebackground -activeforeground -disabledforeground
+ keep -highlightcolor -highlightthickness
+}
diff --git a/itcl/itk/examples/MessageInfo.itk b/itcl/itk/examples/MessageInfo.itk
new file mode 100644
index 00000000000..eb25fbae980
--- /dev/null
+++ b/itcl/itk/examples/MessageInfo.itk
@@ -0,0 +1,40 @@
+# ----------------------------------------------------------------------
+# EXAMPLE: using inheritance to specialize mega-widgets
+# ----------------------------------------------------------------------
+# COURSE: Object-Oriented Programming with [incr Tcl]
+# AUTHOR: Michael J. McLennan, Bell Labs Innovations
+# ======================================================================
+# Copyright (c) 1996 Lucent Technologies
+# ======================================================================
+
+option add *MessageInfo.title "Notice" widgetDefault
+
+class MessageInfo {
+ inherit Info
+
+ constructor {args} {
+ itk_component add message {
+ label $itk_interior.mesg -width 20
+ } {
+ usual
+ rename -text -message message Text
+ }
+ pack $itk_component(message) -expand yes -fill both
+ bind $itk_component(message) <Configure> [code $this resize]
+
+ eval itk_initialize $args
+ }
+
+ private method resize {} {
+ set w [winfo width $itk_component(message)]
+ if {$w > 1} {
+ $itk_component(message) configure -wraplength $w
+ }
+ }
+}
+
+usual MessageInfo {
+ keep -background -cursor -foreground -font
+ keep -activebackground -activeforeground -disabledforeground
+ keep -highlightcolor -highlightthickness
+}
diff --git a/itcl/itk/examples/README b/itcl/itk/examples/README
new file mode 100644
index 00000000000..8e999444962
--- /dev/null
+++ b/itcl/itk/examples/README
@@ -0,0 +1,30 @@
+
+ EXAMPLES
+------------------------------------------------------------------------
+ This directory contains some simple code examples for mega-widgets
+ built using [incr Tk]:
+
+ TextDisplay ........ derived from itk::Widget
+ Acts as a read-only display of text.
+ Has a text widget and an automatic scrollbar.
+
+ Info ............... derived from itk::Toplevel
+ Base class for notice windows with an "info"
+ icon and a "Dismiss" button.
+
+ MessageInfo ........ derived from class Info
+ Adds a label and a "-message" option for
+ displaying pop-up messages.
+
+ TextInfo ........... derived from class Info
+ Adds a TextDisplay and display/append
+ methods for adding text to the display
+
+
+ To see these in action, run the "viewfile" demo program. For this
+ simple demo to work properly, it must be executed in this directory.
+
+ The "viewfile" program has an entry widget which prompts for a file
+ name. Type a file name into the entry and press return. If the file
+ is found, a TextInfo widget will appear displaying its contents.
+ Otherwise, a MessageInfo widget will appear with an error message.
diff --git a/itcl/itk/examples/TextDisplay.itk b/itcl/itk/examples/TextDisplay.itk
new file mode 100644
index 00000000000..327ed83dd45
--- /dev/null
+++ b/itcl/itk/examples/TextDisplay.itk
@@ -0,0 +1,136 @@
+# ----------------------------------------------------------------------
+# EXAMPLE: TextDisplay widget
+# ----------------------------------------------------------------------
+# COURSE: Object-Oriented Programming with [incr Tcl]
+# AUTHOR: Michael J. McLennan, Bell Labs Innovations
+# ======================================================================
+# Copyright (c) 1996 Lucent Technologies
+# ======================================================================
+
+option add *TextDisplay.width 3i widgetDefault
+option add *TextDisplay.height 2i widgetDefault
+
+option add *TextDisplay.scrollbar auto widgetDefault
+option add *TextDisplay.wrap none widgetDefault
+option add *TextDisplay.textBackground ivory widgetDefault
+
+class TextDisplay {
+ inherit itk::Widget
+
+ constructor {args} {
+ itk_option add hull.width hull.height
+
+ itk_component add text {
+ text $itk_interior.info -state disabled -width 1 -height 1 \
+ -yscrollcommand [code $itk_interior.sbar set]
+ } {
+ usual
+ keep -wrap -tabs
+ rename -background -textbackground textBackground Background
+ }
+ pack $itk_component(text) -side left -expand yes -fill both
+
+ itk_component add scrollbar {
+ scrollbar $itk_interior.sbar \
+ -command [code $itk_interior.info yview]
+ }
+ pack $itk_component(scrollbar) -side right -fill y
+
+ eval itk_initialize $args
+
+ pack propagate $itk_component(hull) 0
+
+ fixScrollbar
+ bind $itk_component(text) <Configure> [code $this fixScrollbar]
+
+ $itk_component(text) tag configure bold \
+ -font -*-courier-bold-r-normal--*-120-*
+
+ $itk_component(text) tag configure italic \
+ -font -*-courier-medium-o-normal--*-120-*
+ }
+
+ public method display {info}
+ public method append {info}
+ public method substitute {word newword}
+
+ itk_option define -scrollbar scrollbar Scrollbar "on" {
+ switch -- $itk_option(-scrollbar) {
+ on - off - auto {
+ fixScrollbar
+ }
+ default {
+ error "bad value \"$itk_option(-scollbar)\""
+ }
+ }
+ }
+
+ protected method fixScrollbar {}
+ private variable sbvisible 1
+}
+
+body TextDisplay::display {args} {
+ $itk_component(text) configure -state normal
+ $itk_component(text) delete 1.0 end
+ eval $itk_component(text) insert 1.0 $args
+ $itk_component(text) configure -state disabled
+ fixScrollbar
+}
+
+body TextDisplay::append {args} {
+ $itk_component(text) configure -state normal
+ eval $itk_component(text) insert end $args
+ $itk_component(text) configure -state disabled
+ fixScrollbar
+}
+
+body TextDisplay::substitute {word newword} {
+ $itk_component(text) configure -state normal
+
+ set index 1.0
+ while {1} {
+ set index [$itk_component(text) search -count len $word $index]
+ if {$index != ""} {
+ $itk_component(text) delete $index "$index + $len chars"
+ $itk_component(text) insert $index $newword
+ } else {
+ break
+ }
+ }
+ $itk_component(text) configure -state disabled
+ fixScrollbar
+}
+
+body TextDisplay::fixScrollbar {} {
+ switch $itk_option(-scrollbar) {
+ on { set sbstate 1 }
+ off { set sbstate 0 }
+
+ auto {
+ if {[$itk_component(text) bbox 1.0] == "" ||
+ [$itk_component(text) bbox end-1char] == ""} {
+ set sbstate 1
+ } else {
+ set sbstate 0
+ }
+ }
+ }
+ if {$sbstate != $sbvisible} {
+ if {$sbstate} {
+ pack $itk_component(scrollbar) -side right -fill y
+ } else {
+ pack forget $itk_component(scrollbar)
+ }
+ set sbvisible $sbstate
+ }
+}
+
+usual TextDisplay {
+ keep -background -cursor -foreground -font
+ keep -activebackground -activerelief
+ keep -highlightcolor -highlightthickness
+ keep -insertbackground -insertborderwidth -insertwidth
+ keep -insertontime -insertofftime
+ keep -selectbackground -selectborderwidth -selectforeground
+ keep -textbackground -troughcolor
+}
diff --git a/itcl/itk/examples/TextInfo.itk b/itcl/itk/examples/TextInfo.itk
new file mode 100644
index 00000000000..ddfcebb5960
--- /dev/null
+++ b/itcl/itk/examples/TextInfo.itk
@@ -0,0 +1,46 @@
+# ----------------------------------------------------------------------
+# EXAMPLE: using mega-widgets as components
+# ----------------------------------------------------------------------
+# COURSE: Object-Oriented Programming with [incr Tcl]
+# AUTHOR: Michael J. McLennan, Bell Labs Innovations
+# ======================================================================
+# Copyright (c) 1996 Lucent Technologies
+# ======================================================================
+
+option add *TextInfo.title "Text" widgetDefault
+
+class TextInfo {
+ inherit Info
+
+ constructor {args} {
+ itk_component add textArea {
+ TextDisplay $itk_interior.txt -scrollbar auto
+ } {
+ usual
+ keep -wrap -tabs
+ rename -font -textfont textFont Font
+ }
+ pack $itk_component(textArea) -expand yes -fill both
+
+ eval itk_initialize $args
+ }
+
+ public method display {args} {
+ eval $itk_component(textArea) display $args
+ }
+
+ public method append {args} {
+ eval $itk_component(textArea) append $args
+ }
+}
+
+usual TextInfo {
+ keep -background -cursor -foreground -font
+ keep -activebackground -activeforeground -activerelief
+ keep -disabledforeground
+ keep -highlightcolor -highlightthickness
+ keep -insertbackground -insertborderwidth -insertwidth
+ keep -insertontime -insertofftime
+ keep -selectbackground -selectborderwidth -selectforeground
+ keep -textbackground -troughcolor
+}
diff --git a/itcl/itk/examples/tclIndex b/itcl/itk/examples/tclIndex
new file mode 100644
index 00000000000..473987aa027
--- /dev/null
+++ b/itcl/itk/examples/tclIndex
@@ -0,0 +1,16 @@
+# Tcl autoload index file, version 2.0 for [incr Tcl]
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(::TextDisplay) [list source [file join $dir TextDisplay.itk]]
+set auto_index(::TextDisplay::display) [list source [file join $dir TextDisplay.itk]]
+set auto_index(::TextDisplay::append) [list source [file join $dir TextDisplay.itk]]
+set auto_index(::TextDisplay::substitute) [list source [file join $dir TextDisplay.itk]]
+set auto_index(::TextDisplay::fixScrollbar) [list source [file join $dir TextDisplay.itk]]
+set auto_index(::TextInfo) [list source [file join $dir TextInfo.itk]]
+set auto_index(::MessageInfo) [list source [file join $dir MessageInfo.itk]]
+set auto_index(::Info) [list source [file join $dir Info.itk]]
diff --git a/itcl/itk/examples/viewfile b/itcl/itk/examples/viewfile
new file mode 100644
index 00000000000..ea70002c423
--- /dev/null
+++ b/itcl/itk/examples/viewfile
@@ -0,0 +1,44 @@
+#!/bin/sh
+#\
+exec itkwish $0
+# ----------------------------------------------------------------------
+# EXAMPLE: show "TextInfo" and "MessageInfo" widgets in action
+# ----------------------------------------------------------------------
+# COURSE: Object-Oriented Programming with [incr Tcl]
+# AUTHOR: Michael J. McLennan, Bell Labs Innovations
+# ======================================================================
+# Copyright (c) 1996 Lucent Technologies
+# ======================================================================
+lappend auto_path .
+
+if {[string match *color [winfo screenvisual .]]} {
+ option add *textBackground ivory startupFile
+ option add *MessageInfo.background DarkSeaGreen startupFile
+ option add *TextInfo.background DarkSeaGreen startupFile
+ option add *activeBackground ForestGreen startupFile
+ option add *activeForeground white startupFile
+ option add *selectForeground white startupFile
+ option add *selectBackground ForestGreen startupFile
+}
+
+label .label -text "View File:"
+pack .label -anchor w
+
+entry .file
+pack .file -fill x
+
+bind .file <KeyPress-Return> {show_file [.file get]}
+
+proc show_file {file} {
+ set cmd {
+ set fid [open $file r]
+ set info [read $fid]
+ close $fid
+ }
+ if {[catch $cmd] == 0} {
+ set win [TextInfo .#auto -wrap none]
+ $win display $info
+ } else {
+ MessageInfo .#auto -message "Cannot read file:\n$file"
+ }
+}
diff --git a/itcl/itk/generic/itk.h b/itcl/itk/generic/itk.h
new file mode 100644
index 00000000000..c754ba449eb
--- /dev/null
+++ b/itcl/itk/generic/itk.h
@@ -0,0 +1,157 @@
+/*
+ * ------------------------------------------------------------------------
+ * PACKAGE: [incr Tk]
+ * DESCRIPTION: Building mega-widgets with [incr Tcl]
+ *
+ * [incr Tk] provides a framework for building composite "mega-widgets"
+ * using [incr Tcl] classes. It defines a set of base classes that are
+ * specialized to create all other widgets.
+ *
+ * ADDING [incr Tk] TO A Tcl-BASED APPLICATION:
+ *
+ * To add [incr Tk] facilities to a Tcl application, modify the
+ * Tcl_AppInit() routine as follows:
+ *
+ * 1) Include the header files for [incr Tcl] and [incr Tk] near
+ * the top of the file containing Tcl_AppInit():
+ *
+ * #include "itcl.h"
+ * #include "itk.h"
+ *
+ * 2) Within the body of Tcl_AppInit(), add the following lines:
+ *
+ * if (Itcl_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ * if (Itk_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * 3) Link your application with libitcl.a and libitk.a
+ *
+ * NOTE: An example file "tkAppInit.c" containing the changes shown
+ * above is included in this distribution.
+ *
+ * ========================================================================
+ * AUTHOR: Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ * http://www.tcltk.com/itcl
+ *
+ * RCS: $Id$
+ * ========================================================================
+ * Copyright (c) 1993-1998 Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#ifndef ITK_H
+#define ITK_H
+
+/*
+ * A special definition used to allow this header file to be included
+ * in resource files so that they can get obtain version information from
+ * this file. Resource compilers don't like all the C stuff, like typedefs
+ * and procedure declarations, that occur below.
+ */
+
+#ifndef RESOURCE_INCLUDED
+
+#include "itclInt.h"
+#include "tk.h"
+
+#ifdef BUILD_itk
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * List of options in alphabetical order:
+ */
+typedef struct ItkOptList {
+ Tcl_HashTable *options; /* list containing the real options */
+ Tcl_HashEntry **list; /* gives ordering of options */
+ int len; /* number of entries in order list */
+ int max; /* maximum size of order list */
+} ItkOptList;
+
+/*
+ * List of options created in the class definition:
+ */
+typedef struct ItkClassOptTable {
+ Tcl_HashTable options; /* option storage with fast lookup */
+ ItkOptList order; /* gives ordering of options */
+} ItkClassOptTable;
+
+/*
+ * Each option created in the class definition:
+ */
+typedef struct ItkClassOption {
+ ItclMember *member; /* info about this option */
+ char *resName; /* resource name in X11 database */
+ char *resClass; /* resource class name in X11 database */
+ char *init; /* initial value for option */
+} ItkClassOption;
+
+
+/*
+ * Exported functions:
+ */
+EXTERN int Itk_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int Itk_SafeInit _ANSI_ARGS_((Tcl_Interp *interp));
+
+/*
+ * Functions used internally by this package:
+ */
+EXTERN int Itk_ConfigBodyCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itk_UsualCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+
+/*
+ * Functions for managing options included in class definitions:
+ */
+EXTERN int Itk_ClassOptionDefineCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+EXTERN int Itk_ClassOptionIllegalCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+
+EXTERN int Itk_ConfigClassOption _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclObject *contextObj, ClientData cdata, char* newVal));
+
+EXTERN ItkClassOptTable* Itk_CreateClassOptTable _ANSI_ARGS_((
+ Tcl_Interp *interp, ItclClass *cdefn));
+EXTERN ItkClassOptTable* Itk_FindClassOptTable _ANSI_ARGS_((
+ ItclClass *cdefn));
+EXTERN void Itk_DeleteClassOptTable _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclClass *cdefn));
+
+EXTERN int Itk_CreateClassOption _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclClass *cdefn, char *switchName, char *resName, char *resClass,
+ char *defVal, char *config, ItkClassOption **optPtr));
+EXTERN ItkClassOption* Itk_FindClassOption _ANSI_ARGS_((
+ ItclClass *cdefn, char *switchName));
+EXTERN void Itk_DelClassOption _ANSI_ARGS_((ItkClassOption *opt));
+
+/*
+ * Functions needed for the Archetype base class:
+ */
+EXTERN int Itk_ArchetypeInit _ANSI_ARGS_((Tcl_Interp* interp));
+
+/*
+ * Functions for maintaining the ordered option list:
+ */
+EXTERN void Itk_OptListInit _ANSI_ARGS_((ItkOptList* olist,
+ Tcl_HashTable *options));
+EXTERN void Itk_OptListFree _ANSI_ARGS_((ItkOptList* olist));
+
+EXTERN void Itk_OptListAdd _ANSI_ARGS_((ItkOptList* olist,
+ Tcl_HashEntry *entry));
+EXTERN void Itk_OptListRemove _ANSI_ARGS_((ItkOptList* olist,
+ Tcl_HashEntry *entry));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* RESOURCE INCLUDED */
+#endif /* ITK_H */
diff --git a/itcl/itk/generic/itk_archetype.c b/itcl/itk/generic/itk_archetype.c
new file mode 100644
index 00000000000..06a031f745b
--- /dev/null
+++ b/itcl/itk/generic/itk_archetype.c
@@ -0,0 +1,4172 @@
+/*
+ * ------------------------------------------------------------------------
+ * PACKAGE: [incr Tk]
+ * DESCRIPTION: Building mega-widgets with [incr Tcl]
+ *
+ * [incr Tk] provides a framework for building composite "mega-widgets"
+ * using [incr Tcl] classes. It defines a set of base classes that are
+ * specialized to create all other widgets.
+ *
+ * This part adds C implementations for some of the methods in the
+ * base class itk::Archetype.
+ *
+ * Itk_ArchComponentCmd <=> itk_component
+ * Itk_ArchOptionCmd <=> itk_option
+ * Itk_ArchInitCmd <=> itk_initialize
+ * Itk_ArchCompAccessCmd <=> component
+ * Itk_ArchConfigureCmd <=> configure
+ * Itk_ArchCgetCmd <=> cget
+ *
+ * Itk_ArchInitOptsCmd <=> _initOptionInfo (used to set things up)
+ * Itk_ArchDeleteOptsCmd <=> _deleteOptionInfo (used to clean things up)
+ *
+ * ========================================================================
+ * AUTHOR: Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ * http://www.tcltk.com/itcl
+ *
+ * RCS: $Id$
+ * ========================================================================
+ * Copyright (c) 1993-1998 Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#include <assert.h>
+#include "itk.h"
+
+/*
+ * Info associated with each Archetype mega-widget:
+ */
+typedef struct ArchInfo {
+ ItclObject *itclObj; /* object containing this info */
+ Tk_Window tkwin; /* window representing this mega-widget */
+ Tcl_HashTable components; /* list of all mega-widget components */
+ Tcl_HashTable options; /* list of all mega-widget options */
+ ItkOptList order; /* gives ordering of options */
+} ArchInfo;
+
+/*
+ * Each component widget in an Archetype mega-widget:
+ */
+typedef struct ArchComponent {
+ ItclMember *member; /* contains protection level for this comp */
+ Tcl_Command accessCmd; /* access command for component widget */
+ Tk_Window tkwin; /* Tk window for this component widget */
+} ArchComponent;
+
+/*
+ * Each option in an Archetype mega-widget:
+ */
+typedef struct ArchOption {
+ char *switchName; /* command-line switch for this option */
+ char *resName; /* resource name in X11 database */
+ char *resClass; /* resource class name in X11 database */
+ char *init; /* initial value for option */
+ int flags; /* flags representing option state */
+ Itcl_List parts; /* parts relating to this option */
+} ArchOption;
+
+/*
+ * Flag bits for ArchOption state:
+ */
+#define ITK_ARCHOPT_INIT 0x01 /* option has been initialized */
+
+/*
+ * Various parts of a composite option in an Archetype mega-widget:
+ */
+typedef int (Itk_ConfigOptionPartProc) _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclObject *contextObj, ClientData cdata, char* newVal));
+
+typedef struct ArchOptionPart {
+ ClientData clientData; /* data associated with this part */
+ Itk_ConfigOptionPartProc *configProc; /* update when new vals arrive */
+ Tcl_CmdDeleteProc *deleteProc; /* clean up after clientData */
+
+ ClientData from; /* token that indicates who
+ * contributed this option part */
+} ArchOptionPart;
+
+
+/*
+ * Info kept by the itk::option-parser namespace and shared by
+ * all option processing commands:
+ */
+typedef struct ArchMergeInfo {
+ Tcl_HashTable usualCode; /* usual option handling code for the
+ * various widget classes */
+
+ ArchInfo *archInfo; /* internal option info for mega-widget */
+ ArchComponent *archComp; /* component being merged into mega-widget */
+ Tcl_HashTable *optionTable; /* table of valid configuration options
+ * for component being merged */
+} ArchMergeInfo;
+
+/*
+ * Used to capture component widget configuration options when a
+ * new component is being merged into a mega-widget:
+ */
+typedef struct GenericConfigOpt {
+ char *switchName; /* command-line switch for this option */
+ char *resName; /* resource name in X11 database */
+ char *resClass; /* resource class name in X11 database */
+ char *init; /* initial value for this option */
+ char *value; /* current value for this option */
+ char **storage; /* storage for above strings */
+
+ ArchOption *integrated; /* integrated into this mega-widget option */
+ ArchOptionPart *optPart; /* integrated as this option part */
+} GenericConfigOpt;
+
+/*
+ * Options that are propagated by a "configure" method:
+ */
+typedef struct ConfigCmdline {
+ Tcl_Obj *objv[4]; /* objects representing "configure" command */
+} ConfigCmdline;
+
+
+/*
+ * FORWARD DECLARATIONS
+ */
+static void Itk_DelMergeInfo _ANSI_ARGS_((char* cdata));
+
+static int Itk_ArchInitOptsCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static void Itk_DelArchInfo _ANSI_ARGS_((ClientData cdata));
+static int Itk_ArchDeleteOptsCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+
+static int Itk_ArchComponentCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int Itk_ArchCompAddCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int Itk_ArchCompDeleteCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int Itk_ArchOptKeepCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int Itk_ArchOptIgnoreCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int Itk_ArchOptRenameCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int Itk_ArchOptUsualCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+
+static int Itk_ArchInitCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int Itk_ArchOptionCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int Itk_ArchOptionAddCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int Itk_ArchOptionRemoveCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+
+static int Itk_ArchCompAccessCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int Itk_ArchConfigureCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int Itk_ArchCgetCmd _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[]));
+static int Itk_PropagateOption _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclObject *contextObj, ClientData cdata, char *newval));
+static int Itk_PropagatePublicVar _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclObject *contextObj, ClientData cdata, char *newval));
+
+static int Itk_ArchSetOption _ANSI_ARGS_((Tcl_Interp *interp,
+ ArchInfo *info, char *name, char *value));
+static int Itk_ArchConfigOption _ANSI_ARGS_((Tcl_Interp *interp,
+ ArchInfo *info, char *name, char *value));
+static void Itk_ArchOptConfigError _ANSI_ARGS_((Tcl_Interp *interp,
+ ArchInfo *info, ArchOption *archOpt));
+static void Itk_ArchOptAccessError _ANSI_ARGS_((Tcl_Interp *interp,
+ ArchInfo *info, ArchOption *archOpt));
+
+static int Itk_GetArchInfo _ANSI_ARGS_((Tcl_Interp *interp,
+ ItclObject* contextObj, ArchInfo **infoPtr));
+
+static ArchComponent* Itk_CreateArchComponent _ANSI_ARGS_((
+ Tcl_Interp *interp, ArchInfo *info, char *name,
+ ItclClass *cdefn, Tcl_Command accessCmd));
+static void Itk_DelArchComponent _ANSI_ARGS_((ArchComponent *archComp));
+
+static int Itk_GetArchOption _ANSI_ARGS_((Tcl_Interp *interp,
+ ArchInfo *info, char *switchName, char *resName, char *resClass,
+ char *defVal, char *currVal, ArchOption **aoPtr));
+static void Itk_InitArchOption _ANSI_ARGS_((Tcl_Interp *interp,
+ ArchInfo *info, ArchOption *archOpt, char *defVal,
+ char *currVal));
+static void Itk_DelArchOption _ANSI_ARGS_((ArchOption *archOpt));
+
+static ArchOptionPart* Itk_CreateOptionPart _ANSI_ARGS_((
+ Tcl_Interp *interp, ClientData cdata, Itk_ConfigOptionPartProc* cproc,
+ Tcl_CmdDeleteProc *dproc, ClientData from));
+static int Itk_AddOptionPart _ANSI_ARGS_((Tcl_Interp *interp,
+ ArchInfo *info, char *switchName, char *resName, char *resClass,
+ char *defVal, char *currVal, ArchOptionPart *optPart,
+ ArchOption **raOpt));
+static ArchOptionPart* Itk_FindArchOptionPart _ANSI_ARGS_((
+ ArchInfo *info, char *switchName, ClientData from));
+static int Itk_RemoveArchOptionPart _ANSI_ARGS_((ArchInfo *info,
+ char *switchName, ClientData from));
+static int Itk_IgnoreArchOptionPart _ANSI_ARGS_((ArchInfo *info,
+ GenericConfigOpt *opt));
+static void Itk_DelOptionPart _ANSI_ARGS_((ArchOptionPart *optPart));
+
+static ConfigCmdline* Itk_CreateConfigCmdline _ANSI_ARGS_((
+ Tcl_Interp *interp, Tcl_Command accessCmd, char *switchName));
+static void Itk_DeleteConfigCmdline _ANSI_ARGS_((ClientData cdata));
+
+static Tcl_HashTable* Itk_CreateGenericOptTable _ANSI_ARGS_((Tcl_Interp *interp,
+ char *options));
+static void Itk_DelGenericOptTable _ANSI_ARGS_((Tcl_HashTable *tPtr));
+
+static GenericConfigOpt* Itk_CreateGenericOpt _ANSI_ARGS_((Tcl_Interp *interp,
+ char *switchName, Tcl_Command accessCmd));
+static void Itk_DelGenericOpt _ANSI_ARGS_((GenericConfigOpt* opt));
+
+static Tcl_HashTable* ItkGetObjsWithArchInfo _ANSI_ARGS_((Tcl_Interp *interp));
+static void ItkFreeObjsWithArchInfo _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp));
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchetypeInit()
+ *
+ * Invoked by Itk_Init() whenever a new interpreter is created to
+ * declare the procedures used in the itk::Archetype base class.
+ * ------------------------------------------------------------------------
+ */
+int
+Itk_ArchetypeInit(interp)
+ Tcl_Interp *interp; /* interpreter to be updated */
+{
+ ArchMergeInfo *mergeInfo;
+ Tcl_Namespace *parserNs;
+
+ /*
+ * Declare all of the C routines that are integrated into
+ * the Archetype base class.
+ */
+ if (Itcl_RegisterObjC(interp,
+ "Archetype-init", Itk_ArchInitOptsCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK ||
+
+ Itcl_RegisterObjC(interp,
+ "Archetype-delete", Itk_ArchDeleteOptsCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK ||
+
+ Itcl_RegisterObjC(interp,
+ "Archetype-itk_component", Itk_ArchComponentCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK ||
+
+ Itcl_RegisterObjC(interp,
+ "Archetype-itk_option", Itk_ArchOptionCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK ||
+
+ Itcl_RegisterObjC(interp,
+ "Archetype-itk_initialize", Itk_ArchInitCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK ||
+
+ Itcl_RegisterObjC(interp,
+ "Archetype-component", Itk_ArchCompAccessCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK ||
+
+ Itcl_RegisterObjC(interp,
+ "Archetype-configure",Itk_ArchConfigureCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK ||
+
+ Itcl_RegisterObjC(interp,
+ "Archetype-cget",Itk_ArchCgetCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK) {
+
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the namespace containing the option parser commands.
+ */
+ mergeInfo = (ArchMergeInfo*)ckalloc(sizeof(ArchMergeInfo));
+ Tcl_InitHashTable(&mergeInfo->usualCode, TCL_STRING_KEYS);
+ mergeInfo->archInfo = NULL;
+ mergeInfo->archComp = NULL;
+ mergeInfo->optionTable = NULL;
+
+ parserNs = Tcl_CreateNamespace(interp, "::itk::option-parser",
+ (ClientData)mergeInfo, Itcl_ReleaseData);
+
+ if (!parserNs) {
+ Itk_DelMergeInfo((char*)mergeInfo);
+ Tcl_AddErrorInfo(interp, "\n (while initializing itk)");
+ return TCL_ERROR;
+ }
+ Itcl_PreserveData((ClientData)mergeInfo);
+ Itcl_EventuallyFree((ClientData)mergeInfo, Itk_DelMergeInfo);
+
+ Tcl_CreateObjCommand(interp, "::itk::option-parser::keep",
+ Itk_ArchOptKeepCmd,
+ (ClientData)mergeInfo, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itk::option-parser::ignore",
+ Itk_ArchOptIgnoreCmd,
+ (ClientData)mergeInfo, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itk::option-parser::rename",
+ Itk_ArchOptRenameCmd,
+ (ClientData)mergeInfo, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_CreateObjCommand(interp, "::itk::option-parser::usual",
+ Itk_ArchOptUsualCmd,
+ (ClientData)mergeInfo, (Tcl_CmdDeleteProc*)NULL);
+
+ /*
+ * Add the "itk::usual" command to register option handling code.
+ */
+ Tcl_CreateObjCommand(interp, "::itk::usual", Itk_UsualCmd,
+ (ClientData)mergeInfo, Itcl_ReleaseData);
+ Itcl_PreserveData((ClientData)mergeInfo);
+
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_DelMergeInfo()
+ *
+ * Destroys the "merge" info record shared by commands in the
+ * itk::option-parser namespace. Invoked automatically when the
+ * namespace containing the parsing commands is destroyed and there
+ * are no more uses of the data.
+ * ------------------------------------------------------------------------
+ */
+static void
+Itk_DelMergeInfo(cdata)
+ char* cdata; /* data to be destroyed */
+{
+ ArchMergeInfo *mergeInfo = (ArchMergeInfo*)cdata;
+
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch place;
+ Tcl_Obj *codePtr;
+
+ assert(mergeInfo->optionTable == NULL);
+
+ entry = Tcl_FirstHashEntry(&mergeInfo->usualCode, &place);
+ while (entry) {
+ codePtr = (Tcl_Obj*)Tcl_GetHashValue(entry);
+ Tcl_DecrRefCount(codePtr);
+ entry = Tcl_NextHashEntry(&place);
+ }
+ Tcl_DeleteHashTable(&mergeInfo->usualCode);
+
+ ckfree((char*)mergeInfo);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchInitOptsCmd()
+ *
+ * Invoked by [incr Tcl] to handle the itk::Archetype::_initOptionInfo
+ * method. This method should be called out in the constructor for
+ * each object, to initialize the object so that it can be used with
+ * the other access methods in this file. Allocates some extra
+ * data associated with the object at the C-language level.
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+Itk_ArchInitOptsCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* unused */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int newEntry, result;
+ ArchInfo *info;
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+ Tcl_HashTable *objsWithArchInfo;
+ Tcl_HashEntry *entry;
+ Command *cmdPtr;
+
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "");
+ return TCL_ERROR;
+ }
+
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
+ !contextObj) {
+
+ char *token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot use \"", token, "\" without an object context",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create some archetype info for the current object and
+ * register it on the list of all known objects.
+ */
+ objsWithArchInfo = ItkGetObjsWithArchInfo(interp);
+
+ info = (ArchInfo*)ckalloc(sizeof(ArchInfo));
+ info->itclObj = contextObj;
+ info->tkwin = NULL; /* not known yet */
+ Tcl_InitHashTable(&info->components, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&info->options, TCL_STRING_KEYS);
+ Itk_OptListInit(&info->order, &info->options);
+
+ entry = Tcl_CreateHashEntry(objsWithArchInfo, (char*)contextObj, &newEntry);
+ if (!newEntry) {
+ Itk_DelArchInfo( Tcl_GetHashValue(entry) );
+ }
+ Tcl_SetHashValue(entry, (ClientData)info);
+
+ /*
+ * Make sure that the access command for this object
+ * resides in the global namespace. If need be, move
+ * the command.
+ */
+ result = TCL_OK;
+ cmdPtr = (Command*)contextObj->accessCmd;
+
+ if (cmdPtr->nsPtr != (Namespace*)Tcl_GetGlobalNamespace(interp)) {
+ Tcl_Obj *oldNamePtr, *newNamePtr;
+
+ oldNamePtr = Tcl_NewStringObj((char*)NULL, 0);
+ Tcl_GetCommandFullName(interp, contextObj->accessCmd, oldNamePtr);
+ Tcl_IncrRefCount(oldNamePtr);
+
+ newNamePtr = Tcl_NewStringObj("::", -1);
+ Tcl_AppendToObj(newNamePtr,
+ Tcl_GetCommandName(interp, contextObj->accessCmd), -1);
+ Tcl_IncrRefCount(newNamePtr);
+
+ result = TclRenameCommand(interp,
+ Tcl_GetStringFromObj(oldNamePtr, (int*)NULL),
+ Tcl_GetStringFromObj(newNamePtr, (int*)NULL));
+
+ Tcl_DecrRefCount(oldNamePtr);
+ Tcl_DecrRefCount(newNamePtr);
+ }
+
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_DelArchInfo()
+ *
+ * Invoked when the option info associated with an itk::Archetype
+ * widget is no longer needed. This usually happens when a widget
+ * is destroyed. Frees the given bundle of data and removes it
+ * from the global list of Archetype objects.
+ * ------------------------------------------------------------------------
+ */
+static void
+Itk_DelArchInfo(cdata)
+ ClientData cdata; /* client data for Archetype objects */
+{
+ ArchInfo *info = (ArchInfo*)cdata;
+
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch place;
+ ArchOption *archOpt;
+ ArchComponent *archComp;
+
+ /*
+ * Destroy all component widgets.
+ */
+ entry = Tcl_FirstHashEntry(&info->components, &place);
+ while (entry) {
+ archComp = (ArchComponent*)Tcl_GetHashValue(entry);
+ Itk_DelArchComponent(archComp);
+ entry = Tcl_NextHashEntry(&place);
+ }
+ Tcl_DeleteHashTable(&info->components);
+
+ /*
+ * Destroy all information associated with configuration options.
+ */
+ entry = Tcl_FirstHashEntry(&info->options, &place);
+ while (entry) {
+ archOpt = (ArchOption*)Tcl_GetHashValue(entry);
+ Itk_DelArchOption(archOpt);
+ entry = Tcl_NextHashEntry(&place);
+ }
+ Tcl_DeleteHashTable(&info->options);
+ Itk_OptListFree(&info->order);
+
+ ckfree((char*)info);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchDeleteOptsCmd()
+ *
+ * Invoked by [incr Tcl] to handle the itk::Archetype::_deleteOptionInfo
+ * method. This method should be called out in the destructor for each
+ * object, to clean up data allocated by Itk_ArchInitOptsCmd().
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+Itk_ArchDeleteOptsCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* unused */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+ Tcl_HashTable *objsWithArchInfo;
+ Tcl_HashEntry *entry;
+
+ if (objc != 1) {
+ Tcl_WrongNumArgs(interp, 1, objv, "");
+ return TCL_ERROR;
+ }
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
+ !contextObj) {
+
+ char *token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot use \"", token, "\" without an object context",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Find the info associated with this object.
+ * Destroy the data and remove it from the global list.
+ */
+ objsWithArchInfo = ItkGetObjsWithArchInfo(interp);
+ entry = Tcl_FindHashEntry(objsWithArchInfo, (char*)contextObj);
+
+ if (entry) {
+ Itk_DelArchInfo( Tcl_GetHashValue(entry) );
+ Tcl_DeleteHashEntry(entry);
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchComponentCmd()
+ *
+ * Invoked by [incr Tcl] to handle the itk::Archetype::itk_component
+ * method. Handles the following options:
+ *
+ * itk_component add ?-protected? ?-private? ?--? <name> \
+ * <createCmds> ?<optionCmds>?
+ *
+ * itk_component delete <name> ?<name>...?
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+Itk_ArchComponentCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* unused */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ char *cmd, *token, c;
+ int length;
+
+ /*
+ * Check arguments and handle the various options...
+ */
+ if (objc < 2) {
+ cmd = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be one of...\n",
+ " ", cmd, " add ?-protected? ?-private? ?--? name createCmds ?optionCmds?\n",
+ " ", cmd, " delete name ?name name...?",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ c = *token;
+ length = strlen(token);
+
+ /*
+ * Handle: itk_component add...
+ */
+ if (c == 'a' && strncmp(token, "add", length) == 0) {
+ if (objc < 4) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "add ?-protected? ?-private? ?--? name createCmds ?optionCmds?");
+ return TCL_ERROR;
+ }
+ return Itk_ArchCompAddCmd(dummy, interp, objc-1, objv+1);
+ }
+
+ /*
+ * Handle: itk_component delete...
+ */
+ else if (c == 'd' && strncmp(token, "delete", length) == 0) {
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "delete name ?name name...?");
+ return TCL_ERROR;
+ }
+ return Itk_ArchCompDeleteCmd(dummy, interp, objc-1, objv+1);
+ }
+
+ /*
+ * Flag any errors.
+ */
+ cmd = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad option \"", token,
+ "\": should be one of...\n",
+ " ", cmd, " add name createCmds ?optionCmds?\n",
+ " ", cmd, " delete name ?name name...?",
+ (char*)NULL);
+ return TCL_ERROR;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchCompAddCmd()
+ *
+ * Invoked by [incr Tcl] to handle the itk::Archetype::itk_component
+ * method. Adds a new component widget into the mega-widget,
+ * integrating its configuration options into the master list.
+ *
+ * itk_component add ?-protected? ?-private? ?--? <name> \
+ * <createCmds> <optionCmds>
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+Itk_ArchCompAddCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* unused */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ Tcl_HashEntry *entry = NULL;
+ char *path = NULL;
+ ArchComponent *archComp = NULL;
+ ArchMergeInfo *mergeInfo = NULL;
+ Tcl_Obj *objNamePtr = NULL;
+ Tcl_Obj *tmpNamePtr = NULL;
+ Tcl_Obj *winNamePtr = NULL;
+ Tcl_Obj *hullNamePtr = NULL;
+ int pLevel = ITCL_PUBLIC;
+
+ int newEntry, result;
+ char *cmd, *token, *name, *resultStr;
+ Tcl_Namespace *parserNs;
+ ItclClass *contextClass, *ownerClass;
+ ItclObject *contextObj;
+ ArchInfo *info;
+ Tcl_CallFrame frame, *uplevelFramePtr, *oldFramePtr;
+ Tcl_Command accessCmd;
+ Tcl_Obj *objPtr;
+ Tcl_DString buffer;
+
+ /*
+ * Get the Archetype info associated with this widget.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
+ !contextObj) {
+
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot access components without an object context",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ if (Itk_GetArchInfo(interp, contextObj, &info) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look for options like "-protected" or "-private".
+ */
+ cmd = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+
+ while (objc > 1) {
+ token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ if (*token != '-') {
+ break;
+ }
+ else if (strcmp(token,"-protected") == 0) {
+ pLevel = ITCL_PROTECTED;
+ }
+ else if (strcmp(token,"-private") == 0) {
+ pLevel = ITCL_PRIVATE;
+ }
+ else if (strcmp(token,"--") == 0) {
+ objc--;
+ objv++;
+ break;
+ }
+ else {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad option \"", token,
+ "\": should be -private, -protected or --",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ objc--;
+ objv++;
+ }
+
+ if (objc < 3 || objc > 4) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be \"", cmd,
+ " ?-protected? ?-private? ?--? name createCmds ?optionCmds?",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * See if a component already exists with the symbolic name.
+ */
+ name = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ entry = Tcl_CreateHashEntry(&info->components, name, &newEntry);
+ if (!newEntry) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "component \"", name, "\" already defined",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If this component is the "hull" for the mega-widget, then
+ * move the object access command out of the way before
+ * creating the component, so it is not accidentally deleted.
+ */
+ Tcl_DStringInit(&buffer);
+
+ objNamePtr = Tcl_NewStringObj((char*)NULL, 0);
+ Tcl_GetCommandFullName(contextObj->classDefn->interp,
+ contextObj->accessCmd, objNamePtr);
+ Tcl_IncrRefCount(objNamePtr);
+
+ if (strcmp(name, "hull") == 0) {
+ tmpNamePtr = Tcl_NewStringObj((char*)NULL, 0);
+ Tcl_GetCommandFullName(contextObj->classDefn->interp,
+ contextObj->accessCmd, tmpNamePtr);
+ Tcl_AppendToObj(tmpNamePtr, "-widget-", -1);
+ Tcl_IncrRefCount(tmpNamePtr);
+
+ result = TclRenameCommand(interp,
+ Tcl_GetStringFromObj(objNamePtr, (int*)NULL),
+ Tcl_GetStringFromObj(tmpNamePtr, (int*)NULL));
+
+ if (result != TCL_OK) {
+ goto compFail;
+ }
+ }
+
+ /*
+ * Execute the <createCmds> to create the component widget.
+ * Do this one level up, in the scope of the calling routine.
+ */
+ uplevelFramePtr = _Tcl_GetCallFrame(interp, 1);
+ oldFramePtr = _Tcl_ActivateCallFrame(interp, uplevelFramePtr);
+
+ /* CYGNUS LOCAL - Fix for Tcl8.1 */
+#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ if (Tcl_EvalObj(interp, objv[2]) != TCL_OK) {
+#else
+ if (Tcl_EvalObj(interp, objv[2], 0) != TCL_OK) {
+#endif
+ /* END CYGNUS LOCAL */
+ goto compFail;
+ }
+
+ /*
+ * Take the result from the widget creation commands as the
+ * path name for the new component. Make a local copy of
+ * this, since the interpreter will get used in the mean time.
+ */
+ resultStr = Tcl_GetStringResult(interp);
+ path = (char*)ckalloc((unsigned)(strlen(resultStr)+1));
+ strcpy(path, resultStr);
+
+ /*
+ * Look for the access command token in the context of the
+ * calling namespace. By-pass any protection at this point.
+ */
+ accessCmd = Tcl_FindCommand(interp, path, (Tcl_Namespace*)NULL,
+ /* flags */ 0);
+
+ if (!accessCmd) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot find component access command \"",
+ path, "\" for component \"", name, "\"",
+ (char*)NULL);
+ goto compFail;
+ }
+
+ winNamePtr = Tcl_NewStringObj((char*)NULL, 0);
+ Tcl_GetCommandFullName(interp, accessCmd, winNamePtr);
+ Tcl_IncrRefCount(winNamePtr);
+
+ (void) _Tcl_ActivateCallFrame(interp, oldFramePtr);
+
+ /*
+ * Create the component record. Set the protection level
+ * according to the "-protected" or "-private" option.
+ */
+ ownerClass = contextClass;
+ uplevelFramePtr = _Tcl_GetCallFrame(interp, 1);
+ if (uplevelFramePtr && Itcl_IsClassNamespace(uplevelFramePtr->nsPtr)) {
+ ownerClass = (ItclClass*)uplevelFramePtr->nsPtr->clientData;
+ }
+
+ archComp = Itk_CreateArchComponent(interp, info, name, ownerClass,
+ accessCmd);
+
+ if (!archComp) {
+ goto compFail;
+ }
+
+ Tcl_SetHashValue(entry, (ClientData)archComp);
+ archComp->member->protection = pLevel;
+
+ /*
+ * If this component is the "hull" for the mega-widget, then
+ * move the hull widget access command to a different name,
+ * and move the object access command back into place. This
+ * way, when the widget name is used as a command, the object
+ * access command will handle all requests.
+ */
+ if (strcmp(name, "hull") == 0) {
+ hullNamePtr = Tcl_NewStringObj((char*)NULL, 0);
+ Tcl_GetCommandFullName(interp, accessCmd, hullNamePtr);
+ Tcl_AppendToObj(hullNamePtr, "-itk_hull", -1);
+ Tcl_IncrRefCount(hullNamePtr);
+
+ result = TclRenameCommand(interp,
+ Tcl_GetStringFromObj(winNamePtr, (int*)NULL),
+ Tcl_GetStringFromObj(hullNamePtr, (int*)NULL));
+
+ if (result != TCL_OK) {
+ goto compFail;
+ }
+
+ Tcl_DecrRefCount(winNamePtr); /* winNamePtr keeps current name */
+ winNamePtr = hullNamePtr;
+ hullNamePtr = NULL;
+
+ result = TclRenameCommand(interp,
+ Tcl_GetStringFromObj(tmpNamePtr, (int*)NULL),
+ Tcl_GetStringFromObj(objNamePtr, (int*)NULL));
+
+ if (result != TCL_OK) {
+ goto compFail;
+ }
+ }
+
+ /*
+ * Add a binding onto the new component, so that when its
+ * window is destroyed, it will automatically remove itself
+ * from its parent's component list. Avoid doing these things
+ * for the "hull" component, since it is a special case and
+ * these things are not really necessary.
+ */
+ else {
+ Tcl_DStringSetLength(&buffer, 0);
+ Tcl_DStringAppend(&buffer, "bindtags ", -1);
+ Tcl_DStringAppend(&buffer, path, -1);
+ if (Tcl_Eval(interp, Tcl_DStringValue(&buffer)) != TCL_OK) {
+ goto compFail;
+ }
+
+ Tcl_DStringSetLength(&buffer, 0);
+ Tcl_DStringAppend(&buffer, "bind itk-destroy-", -1);
+ Tcl_DStringAppend(&buffer, path, -1);
+ Tcl_DStringAppend(&buffer, " <Destroy> [itcl::code ", -1);
+
+ Tcl_DStringAppend(&buffer,
+ Tcl_GetStringFromObj(objNamePtr,(int*)NULL), -1);
+
+ Tcl_DStringAppend(&buffer, " itk_component delete ", -1);
+ Tcl_DStringAppend(&buffer, name, -1);
+ Tcl_DStringAppend(&buffer, "]\n", -1);
+ Tcl_DStringAppend(&buffer, "bindtags ", -1);
+ Tcl_DStringAppend(&buffer, path, -1);
+ Tcl_DStringAppend(&buffer, " {itk-destroy-", -1);
+ Tcl_DStringAppend(&buffer, path, -1);
+ Tcl_DStringAppend(&buffer, " ", -1);
+ Tcl_DStringAppend(&buffer, Tcl_GetStringResult(interp), -1);
+ Tcl_DStringAppend(&buffer, "}", -1);
+ if (Tcl_Eval(interp, Tcl_DStringValue(&buffer)) != TCL_OK) {
+ goto compFail;
+ }
+ }
+
+ /*
+ * Query the list of configuration options for this widget,
+ * so we will know which ones are valid. Build an option
+ * table to represent these, so they can be found quickly
+ * by the option parsing commands in "itk::option-parser".
+ */
+ Tcl_DStringTrunc(&buffer, 0);
+ Tcl_DStringAppendElement(&buffer,
+ Tcl_GetStringFromObj(winNamePtr, (int*)NULL));
+ Tcl_DStringAppendElement(&buffer, "configure");
+
+ result = Tcl_Eval(interp, Tcl_DStringValue(&buffer));
+
+ if (result != TCL_OK) {
+ goto compFail;
+ }
+ Tcl_DStringSetLength(&buffer, 0);
+ Tcl_DStringAppend(&buffer, Tcl_GetStringResult(interp), -1);
+
+ /*
+ * Find the "itk::option-parser" namespace and get the data
+ * record shared by all of the parsing commands.
+ */
+ parserNs = Tcl_FindNamespace(interp, "::itk::option-parser",
+ (Tcl_Namespace*)NULL, TCL_LEAVE_ERR_MSG);
+
+ if (!parserNs) {
+ goto compFail;
+ }
+ mergeInfo = (ArchMergeInfo*)parserNs->clientData;
+ assert(mergeInfo);
+
+ /*
+ * Initialize the data record used by the option parsing commands.
+ * Store a table of valid configuration options, along with the
+ * info for the mega-widget that is being updated.
+ */
+ mergeInfo->optionTable = Itk_CreateGenericOptTable(interp,
+ Tcl_DStringValue(&buffer));
+
+ if (!mergeInfo->optionTable) {
+ goto compFail;
+ }
+ mergeInfo->archInfo = info;
+ mergeInfo->archComp = archComp;
+
+ /*
+ * Execute the option-handling commands in the "itk::option-parser"
+ * namespace. If there are no option-handling commands, invoke
+ * the "usual" command instead.
+ */
+ if (objc != 4) {
+ objPtr = Tcl_NewStringObj("usual", -1);
+ Tcl_IncrRefCount(objPtr);
+ } else {
+ objPtr = objv[3];
+ }
+
+ result = Tcl_PushCallFrame(interp, &frame,
+ parserNs, /* isProcCallFrame */ 0);
+
+ if (result == TCL_OK) {
+ /* CYGNUS LOCAL - Fix for Tcl8.1 */
+#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ result = Tcl_EvalObj(interp, objPtr);
+#else
+ result = Tcl_EvalObj(interp, objPtr, 0);
+#endif
+ /* END CYGNUS LOCAL */
+ Tcl_PopCallFrame(interp);
+ }
+
+ if (objPtr != objv[3]) {
+ Tcl_DecrRefCount(objPtr);
+ }
+ if (result != TCL_OK) {
+ goto compFail;
+ }
+
+ Itk_DelGenericOptTable(mergeInfo->optionTable);
+ mergeInfo->optionTable = NULL;
+ mergeInfo->archInfo = NULL;
+ mergeInfo->archComp = NULL;
+
+ ckfree(path);
+
+ Tcl_DStringFree(&buffer);
+ if (objNamePtr) {
+ Tcl_DecrRefCount(objNamePtr);
+ }
+ if (tmpNamePtr) {
+ Tcl_DecrRefCount(tmpNamePtr);
+ }
+ if (winNamePtr) {
+ Tcl_DecrRefCount(winNamePtr);
+ }
+ if (hullNamePtr) {
+ Tcl_DecrRefCount(hullNamePtr);
+ }
+
+ Tcl_SetResult(interp, name, TCL_VOLATILE);
+ return TCL_OK;
+
+ /*
+ * If any errors were encountered, clean up and return.
+ */
+compFail:
+ if (archComp) {
+ Itk_DelArchComponent(archComp);
+ }
+ if (entry) {
+ Tcl_DeleteHashEntry(entry);
+ }
+ if (path) {
+ ckfree(path);
+ }
+ if (mergeInfo && mergeInfo->optionTable) {
+ Itk_DelGenericOptTable(mergeInfo->optionTable);
+ mergeInfo->optionTable = NULL;
+ mergeInfo->archInfo = NULL;
+ mergeInfo->archComp = NULL;
+ }
+
+ Tcl_DStringFree(&buffer);
+ if (objNamePtr) {
+ Tcl_DecrRefCount(objNamePtr);
+ }
+ if (tmpNamePtr) {
+ Tcl_DecrRefCount(tmpNamePtr);
+ }
+ if (winNamePtr) {
+ Tcl_DecrRefCount(winNamePtr);
+ }
+ if (hullNamePtr) {
+ Tcl_DecrRefCount(hullNamePtr);
+ }
+
+ /*
+ * Add error info and return.
+ */
+ objPtr = Tcl_NewStringObj((char*)NULL, 0);
+ Tcl_AppendToObj(objPtr, "\n (while creating component \"", -1);
+ Tcl_AppendToObj(objPtr, name, -1);
+ Tcl_AppendToObj(objPtr, "\" for widget \"", -1);
+ Tcl_GetCommandFullName(contextObj->classDefn->interp,
+ contextObj->accessCmd, objPtr);
+ Tcl_AppendToObj(objPtr, "\")", -1);
+ Tcl_IncrRefCount(objPtr);
+
+ Tcl_AddErrorInfo(interp, Tcl_GetStringFromObj(objPtr, (int*)NULL));
+ Tcl_DecrRefCount(objPtr);
+
+
+ return TCL_ERROR;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchCompDeleteCmd()
+ *
+ * Invoked by [incr Tcl] to handle the itk::Archetype::itk_component
+ * method. Removes an existing component widget from a mega-widget,
+ * and removes any configuration options associated with it.
+ *
+ * itk_component delete <name> ?<name> <name>...?
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+Itk_ArchCompDeleteCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* unused */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int i;
+ char *token;
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+ ArchInfo *info;
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch place;
+ Itcl_ListElem *elem;
+ ArchComponent *archComp;
+ ArchOption *archOpt;
+ ArchOptionPart *optPart;
+
+ /*
+ * Get the Archetype info associated with this widget.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
+ !contextObj) {
+
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot access components without an object context",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ if (Itk_GetArchInfo(interp, contextObj, &info) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Scan through the list of component names and delete each
+ * one. Make sure that each component exists.
+ */
+ for (i=1; i < objc; i++) {
+ token = Tcl_GetStringFromObj(objv[i], (int*)NULL);
+ entry = Tcl_FindHashEntry(&info->components, token);
+ if (!entry) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "name \"", token, "\" is not a component",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ archComp = (ArchComponent*)Tcl_GetHashValue(entry);
+ Tcl_DeleteHashEntry(entry);
+
+ entry = Tcl_FirstHashEntry(&info->options, &place);
+ while (entry) {
+ archOpt = (ArchOption*)Tcl_GetHashValue(entry);
+ elem = Itcl_FirstListElem(&archOpt->parts);
+ while (elem) {
+ optPart = (ArchOptionPart*)Itcl_GetListValue(elem);
+ if (optPart->from == (ClientData)archComp) {
+ Itk_DelOptionPart(optPart);
+ elem = Itcl_DeleteListElem(elem);
+ }
+ else {
+ elem = Itcl_NextListElem(elem);
+ }
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+
+ Itk_DelArchComponent(archComp);
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchOptKeepCmd()
+ *
+ * Invoked by [incr Tcl] to handle the "keep" command in the itk
+ * option parser. Integrates a list of component configuration options
+ * into a mega-widget, so that whenever the mega-widget is updated,
+ * the component will be updated as well.
+ *
+ * Handles the following syntax:
+ *
+ * keep <option> ?<option>...?
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+Itk_ArchOptKeepCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* option merging info record */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ArchMergeInfo *mergeInfo = (ArchMergeInfo*)clientData;
+ int result = TCL_OK;
+
+ int i;
+ char *token;
+ Tcl_HashEntry *entry;
+ GenericConfigOpt *opt;
+ ArchOption *archOpt;
+ ArchOptionPart *optPart;
+ ConfigCmdline *cmdlinePtr;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?option...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that this command is being accessed in the
+ * proper context. The merge info record should be set up
+ * properly.
+ */
+ if (!mergeInfo->archInfo || !mergeInfo->optionTable) {
+ token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "improper usage: \"", token,
+ "\" should only be accessed via itk_component",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Scan through all of the options on the list, and make
+ * sure that they are valid options for this component.
+ * Integrate them into the option info for the mega-widget.
+ */
+ for (i=1; i < objc; i++) {
+ token = Tcl_GetStringFromObj(objv[i], (int*)NULL);
+ entry = Tcl_FindHashEntry(mergeInfo->optionTable, token);
+ if (!entry) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "option not recognized: ", token,
+ (char*)NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ opt = (GenericConfigOpt*)Tcl_GetHashValue(entry);
+
+ /*
+ * If this option has already been integrated, then
+ * remove it and start again.
+ */
+ Itk_IgnoreArchOptionPart(mergeInfo->archInfo, opt);
+
+ /*
+ * Build a command prefix that can be used to apply changes
+ * to this option for this component.
+ */
+ cmdlinePtr = Itk_CreateConfigCmdline(interp,
+ mergeInfo->archComp->accessCmd, token);
+
+ optPart = Itk_CreateOptionPart(interp, (ClientData)cmdlinePtr,
+ Itk_PropagateOption, Itk_DeleteConfigCmdline,
+ (ClientData)mergeInfo->archComp);
+
+ result = Itk_AddOptionPart(interp, mergeInfo->archInfo,
+ opt->switchName, opt->resName, opt->resClass,
+ opt->init, opt->value, optPart, &archOpt);
+
+ if (result == TCL_OK) {
+ opt->integrated = archOpt;
+ opt->optPart = optPart;
+ } else {
+ Itk_DelOptionPart(optPart);
+ result = TCL_ERROR;
+ break;
+ }
+ }
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchOptIgnoreCmd()
+ *
+ * Invoked by [incr Tcl] to handle the "ignore" command in the itk
+ * option parser. Removes a list of component configuration options
+ * from a mega-widget. This negates the action of previous "keep"
+ * and "rename" commands.
+ *
+ * Handles the following syntax:
+ *
+ * ignore <option> ?<option>...?
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+Itk_ArchOptIgnoreCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* option merging info record */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ArchMergeInfo *mergeInfo = (ArchMergeInfo*)clientData;
+
+ int i;
+ char *token;
+ Tcl_HashEntry *entry;
+ GenericConfigOpt *opt;
+
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?option...?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that this command is being accessed in the
+ * proper context. The merge info record should be set up
+ * properly.
+ */
+ if (!mergeInfo->archInfo || !mergeInfo->optionTable) {
+ token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "improper usage: \"", token,
+ "\" should only be accessed via itk_component",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Scan through all of the options on the list, and make
+ * sure that they are valid options for this component.
+ * Remove them from the mega-widget.
+ */
+ for (i=1; i < objc; i++) {
+ token = Tcl_GetStringFromObj(objv[i], (int*)NULL);
+ entry = Tcl_FindHashEntry(mergeInfo->optionTable, token);
+ if (!entry) {
+ Tcl_AppendResult(interp, "option not recognized: ", token,
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ opt = (GenericConfigOpt*)Tcl_GetHashValue(entry);
+
+ /*
+ * If this option has already been integrated, then
+ * remove it. Otherwise, ignore it.
+ */
+ Itk_IgnoreArchOptionPart(mergeInfo->archInfo, opt);
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchOptRenameCmd()
+ *
+ * Invoked by [incr Tcl] to handle the "rename" command in the itk
+ * option parser. Integrates one configuration option into a
+ * mega-widget, using a different name for the option. Whenever the
+ * mega-widget option is updated, the renamed option will be updated
+ * as well. Handles the following syntax:
+ *
+ * rename <oldSwitch> <newSwitch> <resName> <resClass>
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+Itk_ArchOptRenameCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* option merging info record */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ArchMergeInfo *mergeInfo = (ArchMergeInfo*)clientData;
+
+ int result;
+ char *oldSwitch, *newSwitch, *resName, *resClass;
+ Tcl_HashEntry *entry;
+ GenericConfigOpt *opt;
+ ArchOption *archOpt;
+ ArchOptionPart *optPart;
+ ConfigCmdline *cmdlinePtr;
+
+ if (objc != 5) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "oldSwitch newSwitch resourceName resourceClass");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that this command is being accessed in the
+ * proper context. The merge info record should be set up
+ * properly.
+ */
+ if (!mergeInfo->archInfo || !mergeInfo->optionTable) {
+ char *token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "improper usage: \"", token,
+ "\" should only be accessed via itk_component",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ oldSwitch = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ newSwitch = Tcl_GetStringFromObj(objv[2], (int*)NULL);
+ resName = Tcl_GetStringFromObj(objv[3], (int*)NULL);
+ resClass = Tcl_GetStringFromObj(objv[4], (int*)NULL);
+
+ /*
+ * Make sure that the resource name and resource class look good.
+ */
+ if (!islower((int)*resName)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad resource name \"", resName,
+ "\": should start with a lower case letter",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ if (!isupper((int)*resClass)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad resource class \"", resClass,
+ "\": should start with an upper case letter",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that the specified switch exists in the widget.
+ */
+ entry = Tcl_FindHashEntry(mergeInfo->optionTable, oldSwitch);
+ if (!entry) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "option not recognized: ", oldSwitch,
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ opt = (GenericConfigOpt*)Tcl_GetHashValue(entry);
+
+ /*
+ * If this option has already been integrated, then
+ * remove it and start again.
+ */
+ Itk_IgnoreArchOptionPart(mergeInfo->archInfo, opt);
+
+ /*
+ * Build a command prefix that can be used to apply changes
+ * to this option for this component.
+ */
+ cmdlinePtr = Itk_CreateConfigCmdline(interp,
+ mergeInfo->archComp->accessCmd, oldSwitch);
+
+ optPart = Itk_CreateOptionPart(interp, (ClientData)cmdlinePtr,
+ Itk_PropagateOption, Itk_DeleteConfigCmdline,
+ (ClientData)mergeInfo->archComp);
+
+ /*
+ * Merge this option into the mega-widget with a new name.
+ */
+ result = Itk_AddOptionPart(interp, mergeInfo->archInfo, newSwitch,
+ resName, resClass, opt->init, opt->value, optPart,
+ &archOpt);
+
+ if (result == TCL_OK) {
+ opt->integrated = archOpt;
+ opt->optPart = optPart;
+ } else {
+ Itk_DelOptionPart(optPart);
+ result = TCL_ERROR;
+ }
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchOptUsualCmd()
+ *
+ * Invoked by [incr Tcl] to handle the "usual" command in the itk
+ * option parser. Looks for a set of "usual" option-handling commands
+ * associated with the given tag or component class and then evaluates
+ * the commands in the option parser namespace. This keeps the user
+ * from having to type a bunch of "keep" and "rename" commands for
+ * each component widget.
+ *
+ * Handles the following syntax:
+ *
+ * usual ?<tag>?
+ *
+ * If the <tag> is not specified, then the class name for the
+ * component is used as the tag name.
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+Itk_ArchOptUsualCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* option merging info record */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ArchMergeInfo *mergeInfo = (ArchMergeInfo*)clientData;
+
+ char *tag;
+ Tcl_HashEntry *entry;
+ Tcl_Obj *codePtr;
+
+ if (objc > 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?tag?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that this command is being accessed in the
+ * proper context. The merge info record should be set up
+ * properly.
+ */
+ if (!mergeInfo->archInfo || !mergeInfo->optionTable) {
+ char *token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "improper usage: \"", token,
+ "\" should only be accessed via itk_component",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If a tag name was specified, then use this to look up
+ * the "usual" code. Otherwise, use the class name for
+ * the component widget.
+ */
+ if (objc == 2) {
+ tag = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ } else {
+ tag = Tk_Class(mergeInfo->archComp->tkwin);
+ }
+
+ /*
+ * Look for some code associated with the tag and evaluate
+ * it in the current context.
+ */
+ entry = Tcl_FindHashEntry(&mergeInfo->usualCode, tag);
+ if (entry) {
+ codePtr = (Tcl_Obj*)Tcl_GetHashValue(entry);
+ /* CYGNUS LOCAL - Fix for Tcl8.1 */
+#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ return Tcl_EvalObj(interp, codePtr);
+#else
+ return Tcl_EvalObj(interp, codePtr, 0);
+#endif
+ /* END CYGNUS LOCAL */
+ }
+
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "can't find usual code for tag \"", tag, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_UsualCmd()
+ *
+ * Invoked by [incr Tcl] to handle the "usual" command in the ::itk
+ * namespace. Used to query or set the option-handling code associated
+ * with a widget class or arbitrary tag name. This code is later
+ * used by the "usual" command in the "itk::option-parser" namespace.
+ *
+ * Handles the following syntax:
+ *
+ * usual ?<tag>? ?<code>?
+ *
+ * If the <tag> is not specified, then this returns a list of all
+ * known tags. If the <code> is not specified, then this returns
+ * the current code associated with <tag>, or an empty string if
+ * <tag> is not recognized. Otherwise, it sets the code fragment
+ * for <tag> to <code>.
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itk_UsualCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* option merging info record */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ArchMergeInfo *mergeInfo = (ArchMergeInfo*)clientData;
+
+ int newEntry;
+ char *tag, *token;
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch place;
+ Tcl_Obj *codePtr;
+
+ if (objc > 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?tag? ?commands?");
+ return TCL_ERROR;
+ }
+
+ /*
+ * If no arguments were specified, then return a list of
+ * all known tags.
+ */
+ if (objc == 1) {
+ entry = Tcl_FirstHashEntry(&mergeInfo->usualCode, &place);
+ while (entry) {
+ tag = Tcl_GetHashKey(&mergeInfo->usualCode, entry);
+ Tcl_AppendElement(interp, tag);
+ entry = Tcl_NextHashEntry(&place);
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * If a code fragment was specified, then save it in the
+ * hash table for "usual" code.
+ */
+ else if (objc == 3) {
+ token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ entry = Tcl_CreateHashEntry(&mergeInfo->usualCode, token, &newEntry);
+ if (!newEntry) {
+ codePtr = (Tcl_Obj*)Tcl_GetHashValue(entry);
+ Tcl_DecrRefCount(codePtr);
+ }
+
+ codePtr = objv[2];
+ Tcl_IncrRefCount(codePtr);
+ Tcl_SetHashValue(entry, (ClientData)codePtr);
+
+ return TCL_OK;
+ }
+
+ /*
+ * Otherwise, look for a code fragment with the specified tag.
+ */
+ token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ entry = Tcl_FindHashEntry(&mergeInfo->usualCode, token);
+ if (entry) {
+ codePtr = (Tcl_Obj*)Tcl_GetHashValue(entry);
+ Tcl_SetObjResult(interp, codePtr);
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchInitCmd()
+ *
+ * Invoked by [incr Tcl] to handle the itk::Archetype::itk_initialize
+ * method. This method should be called out in the constructor for
+ * each mega-widget class, to build the composite option list at
+ * each class level. Handles the following syntax:
+ *
+ * itk_initialize ?-option val -option val...?
+ *
+ * Integrates any class-based options into the composite option list,
+ * handles option settings from the command line, and then configures
+ * all options to have the proper initial value.
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+Itk_ArchInitCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* unused */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclClass *contextClass, *cdefn;
+ ItclObject *contextObj;
+ ArchInfo *info;
+
+ int i, result;
+ char *token, *val;
+ Tcl_CallFrame *framePtr;
+ ItkClassOption *opt;
+ ItkClassOptTable *optTable;
+ Itcl_ListElem *part;
+ ArchOption *archOpt;
+ ArchOptionPart *optPart;
+ ItclHierIter hier;
+ ItclVarDefn *vdefn;
+ Tcl_HashSearch place;
+ Tcl_HashEntry *entry;
+
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
+ !contextObj) {
+
+ token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "improper usage: should be \"object ",
+ token, " ?-option value -option value...?\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ if (Itk_GetArchInfo(interp, contextObj, &info) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * See what class is being initialized by getting the namespace
+ * for the calling context.
+ */
+ framePtr = _Tcl_GetCallFrame(interp, 1);
+ if (framePtr && Itcl_IsClassNamespace(framePtr->nsPtr)) {
+ contextClass = (ItclClass*)framePtr->nsPtr->clientData;
+ }
+
+ /*
+ * Integrate all public variables for the current class
+ * context into the composite option list.
+ */
+ Itcl_InitHierIter(&hier, contextClass);
+ while ((cdefn=Itcl_AdvanceHierIter(&hier)) != NULL) {
+ entry = Tcl_FirstHashEntry(&cdefn->variables, &place);
+ while (entry) {
+ vdefn = (ItclVarDefn*)Tcl_GetHashValue(entry);
+
+ if (vdefn->member->protection == ITCL_PUBLIC) {
+ optPart = Itk_FindArchOptionPart(info,
+ vdefn->member->name, (ClientData)vdefn);
+
+ if (!optPart) {
+ optPart = Itk_CreateOptionPart(interp, (ClientData)vdefn,
+ Itk_PropagatePublicVar, (Tcl_CmdDeleteProc*)NULL,
+ (ClientData)vdefn);
+
+ val = Itcl_GetInstanceVar(interp, vdefn->member->fullname,
+ contextObj, contextObj->classDefn);
+
+ result = Itk_AddOptionPart(interp, info,
+ vdefn->member->name, (char*)NULL, (char*)NULL,
+ val, (char*)NULL, optPart, &archOpt);
+
+ if (result != TCL_OK) {
+ Itk_DelOptionPart(optPart);
+ return TCL_ERROR;
+ }
+ }
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+ }
+ Itcl_DeleteHierIter(&hier);
+
+ /*
+ * Integrate all class-based options for the current class
+ * context into the composite option list.
+ */
+ optTable = Itk_FindClassOptTable(contextClass);
+ if (optTable) {
+ for (i=0; i < optTable->order.len; i++) {
+ opt = (ItkClassOption*)Tcl_GetHashValue(optTable->order.list[i]);
+
+ optPart = Itk_FindArchOptionPart(info, opt->member->name,
+ (ClientData)contextClass);
+
+ if (!optPart) {
+ optPart = Itk_CreateOptionPart(interp, (ClientData)opt,
+ Itk_ConfigClassOption, (Tcl_CmdDeleteProc*)NULL,
+ (ClientData)contextClass);
+
+ result = Itk_AddOptionPart(interp, info,
+ opt->member->name, opt->resName, opt->resClass,
+ opt->init, (char*)NULL, optPart, &archOpt);
+
+ if (result != TCL_OK) {
+ Itk_DelOptionPart(optPart);
+ return TCL_ERROR;
+ }
+ }
+ }
+ }
+
+ /*
+ * If any option values were specified on the command line,
+ * override the current option settings.
+ */
+ if (objc > 1) {
+ for (objc--,objv++; objc > 0; objc-=2, objv+=2) {
+ token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ if (objc < 2) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "value for \"", token, "\" missing",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ val = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ if (Itk_ArchConfigOption(interp, info, token, val) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ /*
+ * If this is most-specific class, then finish constructing
+ * the mega-widget:
+ *
+ * Scan through all options in the composite list and
+ * look for any that have been set but not initialized.
+ * Invoke the parts of uninitialized options to propagate
+ * changes and update the widget.
+ */
+ if (contextObj->classDefn == contextClass) {
+ for (i=0; i < info->order.len; i++) {
+ archOpt = (ArchOption*)Tcl_GetHashValue(info->order.list[i]);
+
+ if ((archOpt->flags & ITK_ARCHOPT_INIT) == 0) {
+ val = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);
+
+ if (!val) {
+ Itk_ArchOptAccessError(interp, info, archOpt);
+ return TCL_ERROR;
+ }
+
+ part = Itcl_FirstListElem(&archOpt->parts);
+ while (part) {
+ optPart = (ArchOptionPart*)Itcl_GetListValue(part);
+ result = (*optPart->configProc)(interp, contextObj,
+ optPart->clientData, val);
+
+ if (result != TCL_OK) {
+ Itk_ArchOptConfigError(interp, info, archOpt);
+ return result;
+ }
+ part = Itcl_NextListElem(part);
+ }
+ archOpt->flags |= ITK_ARCHOPT_INIT;
+ }
+ }
+ }
+
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchOptionCmd()
+ *
+ * Invoked by [incr Tcl] to handle the itk::Archetype::itk_option
+ * method. Handles the following options:
+ *
+ * itk_option define <switch> <resName> <resClass> <init> ?<config>?
+ * itk_option add <name> ?<name>...?
+ * itk_option remove <name> ?<name>...?
+ *
+ * These commands customize the options list of a specific widget.
+ * They are similar to the "itk_option" ensemble in the class definition
+ * parser, but manipulate a single instance instead of an entire class.
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+Itk_ArchOptionCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* unused */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ char *cmd, *token, c;
+ int length;
+
+ /*
+ * Check arguments and handle the various options...
+ */
+ if (objc < 2) {
+ cmd = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "wrong # args: should be one of...\n",
+ " ", cmd, " add name ?name name...?\n",
+ " ", cmd, " define -switch resourceName resourceClass init ?config?\n",
+ " ", cmd, " remove name ?name name...?",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ c = *token;
+ length = strlen(token);
+
+ /*
+ * Handle: itk_option add...
+ */
+ if (c == 'a' && strncmp(token, "add", length) == 0) {
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "add name ?name name...?");
+ return TCL_ERROR;
+ }
+ return Itk_ArchOptionAddCmd(dummy, interp, objc-1, objv+1);
+ }
+
+ /*
+ * Handle: itk_option remove...
+ */
+ else if (c == 'r' && strncmp(token, "remove", length) == 0) {
+ if (objc < 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "remove name ?name name...?");
+ return TCL_ERROR;
+ }
+ return Itk_ArchOptionRemoveCmd(dummy, interp, objc-1, objv+1);
+ }
+
+ /*
+ * Handle: itk_option define...
+ */
+ else if (c == 'd' && strncmp(token, "define", length) == 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "can only ", token, " options at the class level\n",
+ "(move this command into the class definition)",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Flag any errors.
+ */
+ cmd = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad option \"", token,
+ "\": should be one of...\n",
+ " ", cmd, " add name ?name name...?\n",
+ " ", cmd, " define -switch resourceName resourceClass init ?config?\n",
+ " ", cmd, " remove name ?name name...?",
+ (char*)NULL);
+ return TCL_ERROR;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchOptionAddCmd()
+ *
+ * Invoked by [incr Tcl] to handle the itk::Archetype::itk_option add
+ * method. Finds an option within a class definition or belonging to
+ * a component widget and adds it into the option list for this widget.
+ * If the option is already on the list, this method does nothing.
+ * Handles the following syntax:
+ *
+ * itk_option add <name> ?<name> <name>...?
+ *
+ * where <name> is one of:
+ * class::option
+ * component.option
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+Itk_ArchOptionAddCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* unused */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclClass *contextClass, *cdefn;
+ ItclObject *contextObj;
+ ArchInfo *info;
+
+ int i, result;
+ char *token, *head, *tail, *sep, tmp;
+ ItkClassOption *opt;
+ GenericConfigOpt *generic;
+ ArchOption *archOpt;
+ ArchOptionPart *optPart;
+ ArchComponent *archComp;
+ ConfigCmdline *cmdlinePtr;
+ Tcl_HashEntry *entry;
+ Tcl_DString buffer;
+
+ /*
+ * Get the Archetype info associated with this widget.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
+ !contextObj) {
+
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot access options without an object context",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ if (Itk_GetArchInfo(interp, contextObj, &info) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Scan through the list of options and locate each one.
+ * If it is not already on the option part list, add it.
+ */
+ for (i=1; i < objc; i++) {
+ token = Tcl_GetStringFromObj(objv[i], (int*)NULL);
+ Itcl_ParseNamespPath(token, &buffer, &head, &tail);
+
+ /*
+ * HANDLE: class::option
+ */
+ if (head) {
+ cdefn = Itcl_FindClass(interp, head, /* autoload */ 1);
+ if (!cdefn) {
+ Tcl_DStringFree(&buffer);
+ return TCL_ERROR;
+ }
+
+ opt = Itk_FindClassOption(cdefn, tail);
+ if (!opt) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "option \"", tail, "\" not defined in class \"",
+ cdefn->fullname, "\"",
+ (char*)NULL);
+ Tcl_DStringFree(&buffer);
+ return TCL_ERROR;
+ }
+
+ optPart = Itk_FindArchOptionPart(info, opt->member->name,
+ (ClientData)cdefn);
+
+ if (!optPart) {
+ optPart = Itk_CreateOptionPart(interp, (ClientData)opt,
+ Itk_ConfigClassOption, (Tcl_CmdDeleteProc*)NULL,
+ (ClientData)cdefn);
+
+ result = Itk_AddOptionPart(interp, info, opt->member->name,
+ opt->resName, opt->resClass, opt->init, (char*)NULL,
+ optPart, &archOpt);
+
+ if (result != TCL_OK) {
+ Itk_DelOptionPart(optPart);
+ Tcl_DStringFree(&buffer);
+ return TCL_ERROR;
+ }
+ }
+ Tcl_DStringFree(&buffer);
+ continue;
+ }
+
+ Tcl_DStringFree(&buffer);
+
+ /*
+ * HANDLE: component.option
+ */
+ sep = strstr(token, ".");
+ if (sep) {
+ tmp = *sep;
+ *sep = '\0';
+ head = token;
+ tail = sep+1;
+
+ entry = Tcl_FindHashEntry(&info->components, head);
+ if (!entry) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "name \"", head, "\" is not a component",
+ (char*)NULL);
+ *sep = tmp;
+ return TCL_ERROR;
+ }
+ *sep = tmp;
+ archComp = (ArchComponent*)Tcl_GetHashValue(entry);
+
+ generic = Itk_CreateGenericOpt(interp, tail, archComp->accessCmd);
+ if (!generic) {
+ char msg[256];
+ sprintf(msg, "\n (while adding option \"%.100s\")", token);
+ Tcl_AddErrorInfo(interp, msg);
+ return TCL_ERROR;
+ }
+
+ optPart = Itk_FindArchOptionPart(info, generic->switchName,
+ (ClientData)archComp);
+
+ if (!optPart) {
+ cmdlinePtr = Itk_CreateConfigCmdline(interp,
+ archComp->accessCmd, generic->switchName);
+
+ optPart = Itk_CreateOptionPart(interp, (ClientData)cmdlinePtr,
+ Itk_PropagateOption, Itk_DeleteConfigCmdline,
+ (ClientData)archComp);
+
+ result = Itk_AddOptionPart(interp, info,
+ generic->switchName, generic->resName, generic->resClass,
+ generic->init, generic->value, optPart, &archOpt);
+
+ if (result != TCL_OK) {
+ Itk_DelOptionPart(optPart);
+ Itk_DelGenericOpt(generic);
+ return TCL_ERROR;
+ }
+ }
+ Itk_DelGenericOpt(generic);
+ continue;
+ }
+
+ /*
+ * Anything else is an error.
+ */
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad option \"", token, "\": should be one of...\n",
+ " class::option\n",
+ " component.option",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchOptionRemoveCmd()
+ *
+ * Invoked by [incr Tcl] to handle the itk::Archetype::itk_option remove
+ * method. Finds an option within a class definition or belonging to
+ * a component widget and removes it from the option list for this widget.
+ * If the option has already been removed from the list, this method does
+ * nothing. Handles the following syntax:
+ *
+ * itk_option remove <name> ?<name> <name>...?
+ *
+ * where <name> is one of:
+ * class::option
+ * component.option
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+Itk_ArchOptionRemoveCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* unused */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclClass *contextClass, *cdefn;
+ ItclObject *contextObj;
+ ArchInfo *info;
+
+ int i;
+ char *name, *head, *tail, *sep, tmp;
+ ItkClassOption *opt;
+ GenericConfigOpt *generic;
+ ArchComponent *archComp;
+ Tcl_HashEntry *entry;
+ Tcl_DString buffer;
+
+ /*
+ * Get the Archetype info associated with this widget.
+ */
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
+ !contextObj) {
+
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot access options without an object context",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ if (Itk_GetArchInfo(interp, contextObj, &info) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Scan through the list of options and locate each one.
+ * If it is on the option list, remove it.
+ */
+ for (i=1; i < objc; i++) {
+ name = Tcl_GetStringFromObj(objv[i], (int*)NULL);
+ Itcl_ParseNamespPath(name, &buffer, &head, &tail);
+
+ /*
+ * HANDLE: class::option
+ */
+ if (head) {
+ cdefn = Itcl_FindClass(interp, head, /* autoload */ 1);
+ if (!cdefn) {
+ Tcl_DStringFree(&buffer);
+ return TCL_ERROR;
+ }
+
+ opt = Itk_FindClassOption(cdefn, tail);
+ if (!opt) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "option \"", tail, "\" not defined in class \"",
+ cdefn->fullname, "\"",
+ (char*)NULL);
+ Tcl_DStringFree(&buffer);
+ return TCL_ERROR;
+ }
+
+ Itk_RemoveArchOptionPart(info, opt->member->name,
+ (ClientData)cdefn);
+
+ Tcl_DStringFree(&buffer);
+ continue;
+ }
+ Tcl_DStringFree(&buffer);
+
+ /*
+ * HANDLE: component.option
+ */
+ sep = strstr(name, ".");
+ if (sep) {
+ tmp = *sep;
+ *sep = '\0';
+ head = name;
+ tail = sep+1;
+
+ entry = Tcl_FindHashEntry(&info->components, head);
+ if (!entry) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "name \"", head, "\" is not a component",
+ (char*)NULL);
+ *sep = tmp;
+ return TCL_ERROR;
+ }
+ *sep = tmp;
+ archComp = (ArchComponent*)Tcl_GetHashValue(entry);
+
+ generic = Itk_CreateGenericOpt(interp, tail, archComp->accessCmd);
+ if (!generic) {
+ char msg[256];
+ sprintf(msg, "\n (while removing option \"%.100s\")",
+ name);
+ Tcl_AddErrorInfo(interp, msg);
+ return TCL_ERROR;
+ }
+
+ Itk_RemoveArchOptionPart(info, generic->switchName,
+ (ClientData)archComp);
+
+ Itk_DelGenericOpt(generic);
+ continue;
+ }
+
+ /*
+ * Anything else is an error.
+ */
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad option \"", name, "\": should be one of...\n",
+ " class::option\n",
+ " component.option",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchCompAccessCmd()
+ *
+ * Invoked by [incr Tcl] to handle the itk::Archetype::component method.
+ * Finds the requested component and invokes the <command> as a method
+ * on that component.
+ *
+ * Handles the following syntax:
+ *
+ * component
+ * component <name>
+ * component <name> <command> ?<arg> <arg>...?
+ *
+ * With no arguments, this command returns the names of components
+ * that can be accessed from the current context. Note that components
+ * respect public/protected/private declarations, so private and
+ * protected components may not be accessible from all namespaces.
+ *
+ * If a component name is specified, then this command returns the
+ * window name for that component.
+ *
+ * If a series of arguments follow the component name, they are treated
+ * as a method invocation, and dispatched to the component.
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+Itk_ArchCompAccessCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* unused */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int i, result;
+ char *token, *name, *val;
+ Tcl_Namespace *callingNs;
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+ Tcl_CallFrame *framePtr;
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch place;
+ ArchInfo *info;
+ ArchComponent *archComp;
+ int cmdlinec;
+ Tcl_Obj *objPtr, *cmdlinePtr, **cmdlinev;
+
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
+ !contextObj) {
+
+ token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "improper usage: should be \"object ",
+ token, " ?name option arg arg...?\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ if (Itk_GetArchInfo(interp, contextObj, &info) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ framePtr = _Tcl_GetCallFrame(interp, 1);
+ if (framePtr) {
+ callingNs = framePtr->nsPtr;
+ } else {
+ callingNs = Tcl_GetGlobalNamespace(interp);
+ }
+
+ /*
+ * With no arguments, return a list of components that can be
+ * accessed from the calling scope.
+ */
+ if (objc == 1) {
+ entry = Tcl_FirstHashEntry(&info->components, &place);
+ while (entry) {
+ archComp = (ArchComponent*)Tcl_GetHashValue(entry);
+ if (Itcl_CanAccess(archComp->member, callingNs)) {
+ name = Tcl_GetHashKey(&info->components, entry);
+ Tcl_AppendElement(interp, name);
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Make sure the requested component exists.
+ */
+ token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ entry = Tcl_FindHashEntry(&info->components, token);
+ if (entry) {
+ archComp = (ArchComponent*)Tcl_GetHashValue(entry);
+ } else {
+ archComp = NULL;
+ }
+
+ if (archComp == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "name \"", token, "\" is not a component",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ if (!Itcl_CanAccess(archComp->member, callingNs)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "can't access component \"", token, "\" from context \"",
+ callingNs->fullName, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If only the component name is specified, then return the
+ * window name for this component.
+ */
+ if (objc == 2) {
+ val = Tcl_GetVar2(interp, "itk_component", token, 0);
+ if (!val) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "internal error: cannot access itk_component(", token, ")",
+ (char*)NULL);
+
+ if (contextObj->accessCmd) {
+ Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+ Tcl_AppendToObj(resultPtr, " in widget \"", -1);
+ Tcl_GetCommandFullName(contextObj->classDefn->interp,
+ contextObj->accessCmd, resultPtr);
+ Tcl_AppendToObj(resultPtr, "\"", -1);
+ }
+ return TCL_ERROR;
+ }
+ Tcl_SetResult(interp, val, TCL_VOLATILE);
+ return TCL_OK;
+ }
+
+ /*
+ * Otherwise, treat the rest of the command line as a method
+ * invocation on the requested component. Invoke the remaining
+ * command-line arguments as a method for that component.
+ */
+ cmdlinePtr = Tcl_NewListObj(0, (Tcl_Obj**)NULL);
+ Tcl_IncrRefCount(cmdlinePtr);
+
+ objPtr = Tcl_NewStringObj((char*)NULL, 0);
+ Tcl_GetCommandFullName(interp, archComp->accessCmd, objPtr);
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, cmdlinePtr, objPtr);
+
+ for (i=2; i < objc; i++) {
+ Tcl_ListObjAppendElement((Tcl_Interp*)NULL, cmdlinePtr, objv[i]);
+ }
+
+ (void) Tcl_ListObjGetElements((Tcl_Interp*)NULL, cmdlinePtr,
+ &cmdlinec, &cmdlinev);
+
+ result = Itcl_EvalArgs(interp, cmdlinec, cmdlinev);
+
+ Tcl_DecrRefCount(cmdlinePtr);
+
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchConfigureCmd()
+ *
+ * Invoked by [incr Tcl] to handle the itk::Archetype::configure method.
+ * Mimics the usual Tk "configure" method for Archetype mega-widgets.
+ *
+ * configure
+ * configure -name
+ * configure -name value ?-name value ...?
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+Itk_ArchConfigureCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* unused */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int i;
+ char *token, *val;
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+ ArchInfo *info;
+ Tcl_HashEntry *entry;
+ ArchOption *archOpt;
+ Tcl_DString buffer;
+
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
+ !contextObj) {
+
+ token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "improper usage: should be \"object ",
+ token, " ?-option? ?value -option value...?\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ if (Itk_GetArchInfo(interp, contextObj, &info) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If there are no extra arguments, then return a list of all
+ * known configuration options. Each option has the form:
+ * {name resName resClass init value}
+ */
+ if (objc == 1) {
+ Tcl_DStringInit(&buffer);
+
+ for (i=0; i < info->order.len; i++) {
+ archOpt = (ArchOption*)Tcl_GetHashValue(info->order.list[i]);
+ val = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);
+ if (!val) {
+ Itk_ArchOptAccessError(interp, info, archOpt);
+ Tcl_DStringFree(&buffer);
+ return TCL_ERROR;
+ }
+
+ Tcl_DStringStartSublist(&buffer);
+ Tcl_DStringAppendElement(&buffer, archOpt->switchName);
+ Tcl_DStringAppendElement(&buffer,
+ (archOpt->resName) ? archOpt->resName : "");
+ Tcl_DStringAppendElement(&buffer,
+ (archOpt->resClass) ? archOpt->resClass : "");
+ Tcl_DStringAppendElement(&buffer,
+ (archOpt->init) ? archOpt->init : "");
+ Tcl_DStringAppendElement(&buffer, val);
+ Tcl_DStringEndSublist(&buffer);
+ }
+ Tcl_DStringResult(interp, &buffer);
+ Tcl_DStringFree(&buffer);
+ return TCL_OK;
+ }
+
+ /*
+ * If there is just one argument, then query the information
+ * for that one argument and return:
+ * {name resName resClass init value}
+ */
+ else if (objc == 2) {
+ token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ entry = Tcl_FindHashEntry(&info->options, token);
+ if (!entry) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "unknown option \"", token, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ archOpt = (ArchOption*)Tcl_GetHashValue(entry);
+ val = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);
+ if (!val) {
+ Itk_ArchOptAccessError(interp, info, archOpt);
+ return TCL_ERROR;
+ }
+
+ Tcl_AppendElement(interp, archOpt->switchName);
+ Tcl_AppendElement(interp,
+ (archOpt->resName) ? archOpt->resName : "");
+ Tcl_AppendElement(interp,
+ (archOpt->resClass) ? archOpt->resClass : "");
+ Tcl_AppendElement(interp,
+ (archOpt->init) ? archOpt->init : "");
+ Tcl_AppendElement(interp, val);
+
+ return TCL_OK;
+ }
+
+ /*
+ * Otherwise, it must be a series of "-option value" assignments.
+ * Look up each option and assign the new value.
+ */
+ for (objc--,objv++; objc > 0; objc-=2, objv+=2) {
+ token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ if (objc < 2) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "value for \"", token, "\" missing",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ val = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+
+ if (Itk_ArchConfigOption(interp, info, token, val) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchCgetCmd()
+ *
+ * Invoked by [incr Tcl] to handle the itk::Archetype::cget method.
+ * Mimics the usual Tk "cget" method for Archetype mega-widgets.
+ *
+ * cget -name
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+Itk_ArchCgetCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* unused */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ char *token, *val;
+ ItclClass *contextClass;
+ ItclObject *contextObj;
+ ArchInfo *info;
+ Tcl_HashEntry *entry;
+ ArchOption *archOpt;
+
+ if (Itcl_GetContext(interp, &contextClass, &contextObj) != TCL_OK ||
+ !contextObj) {
+
+ token = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "improper usage: should be \"object ", token, " -option\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ if (Itk_GetArchInfo(interp, contextObj, &info) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look up the specified option and get its current value.
+ */
+ token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ entry = Tcl_FindHashEntry(&info->options, token);
+ if (!entry) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "unknown option \"", token, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ archOpt = (ArchOption*)Tcl_GetHashValue(entry);
+ val = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);
+ if (!val) {
+ Itk_ArchOptAccessError(interp, info, archOpt);
+ return TCL_ERROR;
+ }
+
+ Tcl_SetResult(interp, val, TCL_VOLATILE);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_PropagateOption()
+ *
+ * Invoked whenever a widget-based configuration option has been
+ * configured with a new value. Propagates the new value down to
+ * the widget by invoking the "configure" method on the widget.
+ * This causes the widget to bring itself up to date automatically.
+ *
+ * Returns TCL_OK on success, or TCL_ERROR (along with an error
+ * message in the interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+Itk_PropagateOption(interp, contextObj, cdata, newval)
+ Tcl_Interp *interp; /* interpreter managing the class */
+ ItclObject *contextObj; /* itcl object being configured */
+ ClientData cdata; /* command prefix to use for configuration */
+ char *newval; /* new value for this option */
+{
+ ConfigCmdline *cmdlinePtr = (ConfigCmdline*)cdata;
+ int result;
+ Tcl_Obj *objPtr;
+
+ objPtr = Tcl_NewStringObj(newval, -1);
+ Tcl_IncrRefCount(objPtr);
+
+ cmdlinePtr->objv[3] = objPtr;
+ result = Itcl_EvalArgs(interp, 4, cmdlinePtr->objv);
+
+ Tcl_DecrRefCount(objPtr);
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_PropagatePublicVar()
+ *
+ * Invoked whenever a mega-widget configuration option containing
+ * a public variable part has been configured with a new value.
+ * Updates the public variable with the new value and invokes any
+ * "config" code associated with it.
+ *
+ * Returns TCL_OK on success, or TCL_ERROR (along with an error
+ * message in the interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static int
+Itk_PropagatePublicVar(interp, contextObj, cdata, newval)
+ Tcl_Interp *interp; /* interpreter managing the class */
+ ItclObject *contextObj; /* itcl object being configured */
+ ClientData cdata; /* command prefix to use for configuration */
+ char *newval; /* new value for this option */
+{
+ ItclVarDefn *vdefn = (ItclVarDefn*)cdata;
+
+ int result;
+ char *val;
+ ItclContext context;
+ ItclMemberCode *mcode;
+ Tcl_CallFrame *uplevelFramePtr, *oldFramePtr;
+
+ /*
+ * Update the public variable with the new option value.
+ * There should already be a call frame installed for handling
+ * instance variables, but make sure that the namespace context
+ * is the most-specific class, so that the public variable can
+ * be found.
+ */
+ result = Itcl_PushContext(interp, (ItclMember*)NULL,
+ contextObj->classDefn, contextObj, &context);
+
+ if (result == TCL_OK) {
+ val = Tcl_SetVar2(interp, vdefn->member->fullname, (char*)NULL,
+ newval, TCL_LEAVE_ERR_MSG);
+
+ if (!val) {
+ result = TCL_ERROR;
+ }
+ Itcl_PopContext(interp, &context);
+ }
+
+ if (result != TCL_OK) {
+ char msg[256];
+ sprintf(msg, "\n (error in configuration of public variable \"%.100s\")", vdefn->member->fullname);
+ Tcl_AddErrorInfo(interp, msg);
+ return TCL_ERROR;
+ }
+
+ /*
+ * If this variable has some "config" code, invoke it now.
+ *
+ * NOTE: Invoke the "config" code in the class scope
+ * containing the data member.
+ */
+ mcode = vdefn->member->code;
+ if (mcode && mcode->procPtr->bodyPtr) {
+
+ uplevelFramePtr = _Tcl_GetCallFrame(interp, 1);
+ oldFramePtr = _Tcl_ActivateCallFrame(interp, uplevelFramePtr);
+
+ result = Itcl_EvalMemberCode(interp, (ItclMemberFunc*)NULL,
+ vdefn->member, contextObj, 0, (Tcl_Obj**)NULL);
+
+ (void) _Tcl_ActivateCallFrame(interp, oldFramePtr);
+
+ if (result == TCL_OK) {
+ Tcl_ResetResult(interp);
+ } else {
+ char msg[256];
+ sprintf(msg, "\n (error in configuration of public variable \"%.100s\")", vdefn->member->fullname);
+ Tcl_AddErrorInfo(interp, msg);
+ }
+ }
+
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchSetOption()
+ *
+ * Sets a configuration option within an Archetype mega-widget.
+ * Changes the "itk_option" array to reflect the new value, but
+ * unlike Itk_ArchConfigOption(), this procedure does not update
+ * the widget by propagating changes or invoking any "config" code.
+ * It merely sets the widget state. It is useful when a widget is
+ * first being constructed, to initialize option values.
+ *
+ * NOTE: This procedure assumes that there is a valid object context
+ * and a call frame supporting object data member access. It is
+ * usually called from within the methods of the Archetype base
+ * class, so this is a good assumption. If it is called anywhere
+ * else, the caller is responsible for installing the object context
+ * and setting up a call frame.
+ *
+ * Returns TCL_OK on success, or TCL_ERROR (along with an error
+ * message in the interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+static int
+Itk_ArchSetOption(interp, info, name, value)
+ Tcl_Interp *interp; /* interpreter managing this widget */
+ ArchInfo *info; /* Archetype info */
+ char *name; /* name of configuration option */
+ char *value; /* new value for configuration option */
+{
+ Tcl_HashEntry *entry;
+ ArchOption *archOpt;
+
+ entry = Tcl_FindHashEntry(&info->options, name);
+ if (!entry) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "unknown option \"", name, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ archOpt = (ArchOption*)Tcl_GetHashValue(entry);
+
+ if (!Tcl_SetVar2(interp, "itk_option", archOpt->switchName, value, 0)) {
+ Itk_ArchOptAccessError(interp, info, archOpt);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchConfigOption()
+ *
+ * Sets a configuration option within an Archetype mega-widget.
+ * Changes the "itk_option" array to reflect the new value, and then
+ * invokes any option parts to handle the new setting or propagate
+ * the value down to component parts.
+ *
+ * NOTE: This procedure assumes that there is a valid object context
+ * and a call frame supporting object data member access. It is
+ * usually called from within the methods of the Archetype base
+ * class, so this is a good assumption. If it is called anywhere
+ * else, the caller is responsible for installing the object context
+ * and setting up a call frame.
+ *
+ * Returns TCL_OK on success, or TCL_ERROR (along with an error
+ * message in the interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+static int
+Itk_ArchConfigOption(interp, info, name, value)
+ Tcl_Interp *interp; /* interpreter managing this widget */
+ ArchInfo *info; /* Archetype info */
+ char *name; /* name of configuration option */
+ char *value; /* new value for configuration option */
+{
+ int result;
+ char *v, *lastval;
+ Tcl_HashEntry *entry;
+ ArchOption *archOpt;
+ Itcl_ListElem *part;
+ ArchOptionPart *optPart;
+ Itcl_InterpState istate;
+
+ /*
+ * Query the "itk_option" array to get the current setting.
+ */
+ entry = Tcl_FindHashEntry(&info->options, name);
+ if (!entry) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "unknown option \"", name, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ archOpt = (ArchOption*)Tcl_GetHashValue(entry);
+
+ v = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);
+ if (v) {
+ lastval = (char*)ckalloc((unsigned)(strlen(v)+1));
+ strcpy(lastval, v);
+ } else {
+ lastval = NULL;
+ }
+
+ /*
+ * Update the "itk_option" array with the new setting.
+ */
+ if (!Tcl_SetVar2(interp, "itk_option", archOpt->switchName, value, 0)) {
+ Itk_ArchOptAccessError(interp, info, archOpt);
+ result = TCL_ERROR;
+ goto configDone;
+ }
+
+ /*
+ * Scan through all option parts to handle the new setting.
+ */
+ result = TCL_OK;
+ part = Itcl_FirstListElem(&archOpt->parts);
+
+ while (part) {
+ optPart = (ArchOptionPart*)Itcl_GetListValue(part);
+ result = (*optPart->configProc)(interp, info->itclObj,
+ optPart->clientData, value);
+
+ if (result != TCL_OK) {
+ Itk_ArchOptConfigError(interp, info, archOpt);
+ break;
+ }
+ part = Itcl_NextListElem(part);
+ }
+
+ /*
+ * If the option configuration failed, then set the option
+ * back to its previous settings. Scan back through all of
+ * the option parts and sync them up with the old value.
+ */
+ if (result == TCL_ERROR) {
+ istate = Itcl_SaveInterpState(interp, result);
+
+ Tcl_SetVar2(interp, "itk_option", archOpt->switchName, lastval, 0);
+
+ part = Itcl_FirstListElem(&archOpt->parts);
+ while (part) {
+ optPart = (ArchOptionPart*)Itcl_GetListValue(part);
+ (*optPart->configProc)(interp, info->itclObj,
+ optPart->clientData, lastval);
+
+ part = Itcl_NextListElem(part);
+ }
+ result = Itcl_RestoreInterpState(interp, istate);
+ }
+
+ archOpt->flags |= ITK_ARCHOPT_INIT; /* option has been set */
+
+configDone:
+ if (lastval) {
+ ckfree(lastval);
+ }
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchOptConfigError()
+ *
+ * Simply utility which adds error information after a option
+ * configuration fails. Adds traceback information to the given
+ * interpreter.
+ * ------------------------------------------------------------------------
+ */
+static void
+Itk_ArchOptConfigError(interp, info, archOpt)
+ Tcl_Interp *interp; /* interpreter handling this object */
+ ArchInfo *info; /* info associated with mega-widget */
+ ArchOption *archOpt; /* configuration option that failed */
+{
+ Tcl_Obj *objPtr;
+
+ objPtr = Tcl_NewStringObj((char*)NULL, 0);
+ Tcl_IncrRefCount(objPtr);
+
+ Tcl_AppendToObj(objPtr, "\n (while configuring option \"", -1);
+ Tcl_AppendToObj(objPtr, archOpt->switchName, -1);
+ Tcl_AppendToObj(objPtr, "\"", -1);
+
+ if (info->itclObj && info->itclObj->accessCmd) {
+ Tcl_AppendToObj(objPtr, " for widget \"", -1);
+ Tcl_GetCommandFullName(interp, info->itclObj->accessCmd, objPtr);
+ Tcl_AppendToObj(objPtr, "\")", -1);
+ }
+ Tcl_AddErrorInfo(interp, Tcl_GetStringFromObj(objPtr, (int*)NULL));
+ Tcl_DecrRefCount(objPtr);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ArchOptAccessError()
+ *
+ * Simply utility which adds error information after an option
+ * value access fails. Adds traceback information to the given
+ * interpreter.
+ * ------------------------------------------------------------------------
+ */
+static void
+Itk_ArchOptAccessError(interp, info, archOpt)
+ Tcl_Interp *interp; /* interpreter handling this object */
+ ArchInfo *info; /* info associated with mega-widget */
+ ArchOption *archOpt; /* option that couldn't be accessed */
+{
+ Tcl_ResetResult(interp);
+
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "internal error: cannot access itk_option(", archOpt->switchName, ")",
+ (char*)NULL);
+
+ if (info->itclObj->accessCmd) {
+ Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+ Tcl_AppendToObj(resultPtr, " in widget \"", -1);
+ Tcl_GetCommandFullName(interp, info->itclObj->accessCmd, resultPtr);
+ Tcl_AppendToObj(resultPtr, "\"", -1);
+ }
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_GetArchInfo()
+ *
+ * Finds the extra Archetype info associated with the given object.
+ * Returns TCL_OK and a pointer to the info if found. Returns
+ * TCL_ERROR along with an error message in interp->result if not.
+ * ------------------------------------------------------------------------
+ */
+static int
+Itk_GetArchInfo(interp, contextObj, infoPtr)
+ Tcl_Interp *interp; /* interpreter handling this object */
+ ItclObject *contextObj; /* object with desired data */
+ ArchInfo **infoPtr; /* returns: pointer to extra info */
+{
+ Tcl_HashTable *objsWithArchInfo;
+ Tcl_HashEntry *entry;
+
+ /*
+ * If there is any problem finding the info, return an error.
+ */
+ objsWithArchInfo = ItkGetObjsWithArchInfo(interp);
+ entry = Tcl_FindHashEntry(objsWithArchInfo, (char*)contextObj);
+
+ if (!entry) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "internal error: no Archetype information for widget",
+ (char*)NULL);
+
+ if (contextObj->accessCmd) {
+ Tcl_Obj *resultPtr = Tcl_GetObjResult(interp);
+ Tcl_AppendToObj(resultPtr, " \"", -1);
+ Tcl_GetCommandFullName(interp, contextObj->accessCmd, resultPtr);
+ Tcl_AppendToObj(resultPtr, "\"", -1);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * Otherwise, return the requested info.
+ */
+ *infoPtr = (ArchInfo*)Tcl_GetHashValue(entry);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_CreateArchComponent()
+ *
+ * Creates the data representing a component widget within an Archetype
+ * mega-widget. Each component has an access command that is used to
+ * communicate with it. Each component is registered by its symbolic
+ * name in the "itk_component" array.
+ *
+ * Returns a pointer to the new record. If anything goes wrong,
+ * this returns NULL, along with an error message in the interpreter.
+ * ------------------------------------------------------------------------
+ */
+static ArchComponent*
+Itk_CreateArchComponent(interp, info, name, cdefn, accessCmd)
+ Tcl_Interp *interp; /* interpreter managing the object */
+ ArchInfo *info; /* info associated with mega-widget */
+ char *name; /* symbolic name for this component */
+ ItclClass *cdefn; /* component created in this class */
+ Tcl_Command accessCmd; /* access command for component */
+{
+ char *wname, *init;
+ ArchComponent *archComp;
+ ArchOption *archOpt;
+ Tk_Window tkwin;
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch place;
+ ItclMember *memPtr;
+
+ /*
+ * Save this component in the itk_component() array.
+ */
+ wname = Tcl_GetCommandName(interp, accessCmd);
+ Tcl_SetVar2(interp, "itk_component", name, wname, 0);
+
+ /*
+ * If the symbolic name for the component is "hull", then this
+ * is the toplevel or frame that embodies a mega-widget. Update
+ * the Archtype info to include the window token.
+ */
+ tkwin = Tk_NameToWindow(interp, wname, Tk_MainWindow(interp));
+
+ if (strcmp(name, "hull") == 0) {
+ if (tkwin == NULL) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot find hull window with access command \"", wname, "\"",
+ (char*)NULL);
+ return NULL;
+ }
+ info->tkwin = tkwin;
+
+ /*
+ * We are now in a position to query configuration options
+ * relative to this window. Scan through all existing options
+ * and update the initial values according to the X11 resource
+ * database.
+ */
+ entry = Tcl_FirstHashEntry(&info->options, &place);
+ while (entry) {
+ archOpt = (ArchOption*)Tcl_GetHashValue(entry);
+
+ init = NULL;
+ if (archOpt->resName && archOpt->resClass) {
+ init = Tk_GetOption(tkwin, archOpt->resName, archOpt->resClass);
+ }
+
+ if (init && (!archOpt->init || strcmp(init, archOpt->init) != 0)) {
+ if (!archOpt->init) {
+ ckfree(archOpt->init);
+ }
+ archOpt->init = (char*)ckalloc((unsigned)(strlen(init)+1));
+ strcpy(archOpt->init, init);
+
+ if (Itk_ArchSetOption(interp, info,
+ archOpt->switchName, init) != TCL_OK) {
+ return NULL;
+ }
+ }
+ entry = Tcl_NextHashEntry(&place);
+ }
+ }
+
+ /*
+ * Create the record to represent this component.
+ */
+ archComp = (ArchComponent*)ckalloc(sizeof(ArchComponent));
+
+ memPtr = (ItclMember*)ckalloc(sizeof(ItclMember));
+ memPtr->interp = interp;
+ memPtr->classDefn = cdefn;
+ memPtr->name = NULL;
+ memPtr->fullname = NULL;
+ memPtr->flags = 0;
+ memPtr->protection = ITCL_PUBLIC;
+ memPtr->code = NULL;
+
+ archComp->member = memPtr;
+ archComp->accessCmd = accessCmd;
+ archComp->tkwin = tkwin;
+
+ return archComp;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_DelArchComponent()
+ *
+ * Destroys an Archetype component record previously created by
+ * Itk_CreateArchComponent().
+ * ------------------------------------------------------------------------
+ */
+static void
+Itk_DelArchComponent(archComp)
+ ArchComponent *archComp; /* pointer to component data */
+{
+ ckfree((char*)archComp->member);
+ ckfree((char*)archComp);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_GetArchOption()
+ *
+ * Finds or creates the data representing a composite configuration
+ * option for an Archetype mega-widget. Each option acts as a single
+ * entity, but is composed of several parts which propagate changes
+ * down to the component widgets. If the option already exists, then
+ * the specified resource name and resource class must match the
+ * existing definition.
+ *
+ * If the option is created, an initial value for is determined by
+ * querying the X11 resource database, and if this fails, the
+ * hard-wired default value is used.
+ *
+ * If successful, returns TCL_OK along with a pointer to the option
+ * record. Returns TCL_ERROR (along with an error message in the
+ * interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+static int
+Itk_GetArchOption(interp, info, switchName, resName, resClass,
+ defVal, currVal, aoPtr)
+
+ Tcl_Interp *interp; /* interpreter managing the object */
+ ArchInfo *info; /* info for Archetype mega-widget */
+ char *switchName; /* name of command-line switch */
+ char *resName; /* resource name in X11 database */
+ char *resClass; /* resource class name in X11 database */
+ char *defVal; /* last-resort default value */
+ char *currVal; /* current option value */
+ ArchOption **aoPtr; /* returns: option record */
+{
+ int result = TCL_OK;
+
+ int newEntry;
+ char *name;
+ ArchOption *archOpt;
+ Tcl_HashEntry *entry;
+
+ /*
+ * If the switch does not have a leading "-", add it on.
+ */
+ if (*switchName != '-') {
+ name = ckalloc((unsigned)(strlen(switchName)+2));
+ *name = '-';
+ strcpy(name+1, switchName);
+ } else {
+ name = switchName;
+ }
+
+ /*
+ * See if an option already exists with the switch name.
+ * If it does, then make sure that the given resource name
+ * and resource class match the existing definition.
+ */
+ entry = Tcl_CreateHashEntry(&info->options, name, &newEntry);
+ if (!newEntry) {
+ archOpt = (ArchOption*)Tcl_GetHashValue(entry);
+
+ if (resName && !archOpt->resName) {
+ archOpt->resName = (char*)ckalloc((unsigned)(strlen(resName)+1));
+ strcpy(archOpt->resName, resName);
+ }
+ else if (resName && strcmp(archOpt->resName, resName) != 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad resource name \"", resName, "\" for option \"",
+ name, "\": should be \"", archOpt->resName, "\"",
+ (char*)NULL);
+ result = TCL_ERROR;
+ goto getArchOptionDone;
+ }
+
+ if (resClass && !archOpt->resClass) {
+ archOpt->resClass = (char*)ckalloc((unsigned)(strlen(resClass)+1));
+ strcpy(archOpt->resClass, resClass);
+ }
+ else if (resClass && strcmp(archOpt->resClass, resClass) != 0) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad resource class \"", resClass, "\" for option \"",
+ name, "\": should be \"", archOpt->resClass, "\"",
+ (char*)NULL);
+ result = TCL_ERROR;
+ goto getArchOptionDone;
+ }
+
+ if (!archOpt->init) {
+ Itk_InitArchOption(interp, info, archOpt, defVal, currVal);
+ }
+ *aoPtr = archOpt;
+
+ result = TCL_OK;
+ goto getArchOptionDone;
+ }
+
+ /*
+ * Create the record to represent this option, and save it
+ * in the option table.
+ */
+ archOpt = (ArchOption*)ckalloc(sizeof(ArchOption));
+
+ archOpt->switchName = (char*)ckalloc((unsigned)(strlen(name)+1));
+ strcpy(archOpt->switchName, name);
+
+ if (resName) {
+ archOpt->resName = (char*)ckalloc((unsigned)(strlen(resName)+1));
+ strcpy(archOpt->resName, resName);
+ }
+ else {
+ archOpt->resName = NULL;
+ }
+
+ if (resClass) {
+ archOpt->resClass = (char*)ckalloc((unsigned)(strlen(resClass)+1));
+ strcpy(archOpt->resClass, resClass);
+ }
+ else {
+ archOpt->resClass = NULL;
+ }
+
+ archOpt->flags = 0;
+ Itcl_InitList(&archOpt->parts);
+
+ archOpt->init = NULL;
+ Itk_InitArchOption(interp,info,archOpt,defVal,currVal);
+
+ Tcl_SetHashValue(entry, (ClientData)archOpt);
+ Itk_OptListAdd(&info->order, entry);
+
+ *aoPtr = archOpt;
+
+getArchOptionDone:
+ if (name != switchName) {
+ ckfree(name);
+ }
+ return result;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_InitArchOption()
+ *
+ * Sets the initial value for a composite configuration option for
+ * an Archetype mega-widget. This is usually invoked when an option
+ * is first created by Itk_GetArchOption(). It queries the X11
+ * resource database for an initial value, and if nothing is found,
+ * falls back on a last-resort value. It stores the initial value
+ * in the "itk_option" array, adds a copy to the option info, and
+ * returns.
+ *
+ * If successful, returns TCL_OK along with a pointer to the option
+ * record. Returns TCL_ERROR (along with an error message in the
+ * interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+static void
+Itk_InitArchOption(interp, info, archOpt, defVal, currVal)
+ Tcl_Interp *interp; /* interpreter managing the object */
+ ArchInfo *info; /* info for Archetype mega-widget */
+ ArchOption *archOpt; /* option to initialize */
+ char *defVal; /* last-resort default value */
+ char *currVal; /* current option value */
+{
+ char *init = NULL;
+
+ int result;
+ char c, *ival;
+ ItclContext context;
+
+ /*
+ * If the option is already initialized, then abort.
+ */
+ if (archOpt->init) {
+ return;
+ }
+
+ /*
+ * If this widget has a Tk window, query the X11 resource
+ * database for an initial option value. If all else fails,
+ * use the hard-wired default value.
+ */
+ if (archOpt->resName && archOpt->resClass && info->tkwin != NULL) {
+ init = Tk_GetOption(info->tkwin, archOpt->resName, archOpt->resClass);
+ }
+ if (init == NULL) {
+ init = defVal;
+ }
+
+ /*
+ * Normally, the initial value for the itk_option array is
+ * the same as the initial value for the option. Watch
+ * out for the fixed Tk options (-class, -colormap, -screen
+ * and -visual). Since these cannot be modified later,
+ * they must be set to their current value.
+ */
+ c = *(archOpt->switchName+1);
+
+ if ((c == 'c' && strcmp(archOpt->switchName,"-class") == 0) ||
+ (c == 'c' && strcmp(archOpt->switchName,"-colormap") == 0) ||
+ (c == 's' && strcmp(archOpt->switchName,"-screen") == 0) ||
+ (c == 'v' && strcmp(archOpt->switchName,"-visual") == 0)) {
+ ival = currVal;
+ }
+ else {
+ ival = init;
+ }
+
+ /*
+ * Set the initial value in the itk_option array.
+ * Since this might be called from the itk::option-parser
+ * namespace, reinstall the object context.
+ */
+ result = Itcl_PushContext(interp, (ItclMember*)NULL,
+ info->itclObj->classDefn, info->itclObj, &context);
+
+ if (result == TCL_OK) {
+ Tcl_SetVar2(interp, "itk_option", archOpt->switchName,
+ (ival) ? ival : "", 0);
+ Itcl_PopContext(interp, &context);
+ }
+
+ if (ival) {
+ archOpt->init = (char*)ckalloc((unsigned)(strlen(ival)+1));
+ strcpy(archOpt->init, ival);
+ }
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_DelArchOption()
+ *
+ * Destroys an Archetype configuration option previously created by
+ * Itk_CreateArchOption().
+ * ------------------------------------------------------------------------
+ */
+static void
+Itk_DelArchOption(archOpt)
+ ArchOption *archOpt; /* pointer to option data */
+{
+ Itcl_ListElem *elem;
+ ArchOptionPart *optPart;
+
+ /*
+ * Delete all "parts" relating to component widgets.
+ */
+ elem = Itcl_FirstListElem(&archOpt->parts);
+ while (elem) {
+ optPart = (ArchOptionPart*)Itcl_GetListValue(elem);
+ Itk_DelOptionPart(optPart);
+ elem = Itcl_DeleteListElem(elem);
+ }
+
+ /*
+ * Free any remaining data.
+ */
+ ckfree(archOpt->switchName);
+ if (archOpt->resName) {
+ ckfree(archOpt->resName);
+ }
+ if (archOpt->resClass) {
+ ckfree(archOpt->resClass);
+ }
+ if (archOpt->init) {
+ ckfree(archOpt->init);
+ }
+ ckfree((char*)archOpt);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_CreateOptionPart()
+ *
+ * Creates the data representing a part within a configuration option
+ * for an Archetype mega-widget. Each part has a bit of code used to
+ * apply configuration changes to some part of the mega-widget.
+ * This is characterized by a bit of ClientData, and a "config"
+ * procedure that knows how to execute it. The ClientData is
+ * automatically disposed of by the delete proc when this option
+ * part is destroyed.
+ *
+ * Option parts typically come from two sources: Options defined
+ * in the class definition, and options propagated upward from
+ * component parts.
+ *
+ * Returns a pointer to the new option part.
+ * ------------------------------------------------------------------------
+ */
+static ArchOptionPart*
+Itk_CreateOptionPart(interp, cdata, cproc, dproc, from)
+ Tcl_Interp *interp; /* interpreter handling this request */
+ ClientData cdata; /* data representing this part */
+ Itk_ConfigOptionPartProc *cproc; /* proc used to apply config changes */
+ Tcl_CmdDeleteProc *dproc; /* proc used to clean up ClientData */
+ ClientData from; /* who contributed this option */
+{
+ ArchOptionPart *optPart;
+
+ /*
+ * Create the record to represent this part of the option.
+ */
+ optPart = (ArchOptionPart*)ckalloc(sizeof(ArchOptionPart));
+ optPart->clientData = cdata;
+ optPart->configProc = cproc;
+ optPart->deleteProc = dproc;
+ optPart->from = from;
+
+ return optPart;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_AddOptionPart()
+ *
+ * Integrates an option part into a composite configuration option
+ * for an Archetype mega-widget. If a composite option does not
+ * yet exist with the specified switch name, it is created automatically.
+ *
+ * Adds the option part onto the composite list, and reconfigures
+ * the widget to update this option properly.
+ *
+ * Returns TCL_OK on success, or TCL_ERROR (along with an error message
+ * in the interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+static int
+Itk_AddOptionPart(interp, info, switchName, resName, resClass,
+ defVal, currVal, optPart, raOpt)
+
+ Tcl_Interp *interp; /* interpreter handling this request */
+ ArchInfo *info; /* info for Archetype mega-widget */
+ char *switchName; /* name of command-line switch */
+ char *resName; /* resource name in X11 database */
+ char *resClass; /* resource class name in X11 database */
+ char *defVal; /* last-resort default value */
+ char *currVal; /* current value (or NULL) */
+ ArchOptionPart *optPart; /* part to be added in */
+ ArchOption **raOpt; /* returns: option containing new part */
+{
+ char *init = NULL;
+
+ int result;
+ ArchOption *archOpt;
+ ItclContext context;
+
+ *raOpt = NULL;
+
+ /*
+ * Find or create a composite option for the mega-widget.
+ */
+ result = Itk_GetArchOption(interp, info, switchName, resName, resClass,
+ defVal, currVal, &archOpt);
+
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Add the option part to the composite option. If the
+ * composite option has already been configured, then
+ * simply update this part to the current value. Otherwise,
+ * leave the configuration to Itk_ArchInitCmd().
+ */
+ Itcl_AppendList(&archOpt->parts, (ClientData)optPart);
+
+ if ((archOpt->flags & ITK_ARCHOPT_INIT) != 0) {
+
+ result = Itcl_PushContext(interp, (ItclMember*)NULL,
+ info->itclObj->classDefn, info->itclObj, &context);
+
+ if (result == TCL_OK) {
+ init = Tcl_GetVar2(interp, "itk_option", archOpt->switchName, 0);
+ Itcl_PopContext(interp, &context);
+ }
+
+ if (!init) {
+ Itk_ArchOptAccessError(interp, info, archOpt);
+ return TCL_ERROR;
+ }
+
+ if (!currVal || (strcmp(init,currVal) != 0)) {
+ result = (*optPart->configProc)(interp, info->itclObj,
+ optPart->clientData, init);
+
+ if (result != TCL_OK) {
+ Itk_ArchOptConfigError(interp, info, archOpt);
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ *raOpt = archOpt;
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_FindArchOptionPart()
+ *
+ * Searches for a specific piece of a composite configuration option
+ * for an Archetype mega-widget. The specified name is treated as the
+ * "switch" name (e.g., "-option"), but this procedure will recognize
+ * it even without the leading "-".
+ *
+ * Returns a pointer to the option with the matching switch name and
+ * source, or NULL if the option is not recognized.
+ * ------------------------------------------------------------------------
+ */
+static ArchOptionPart*
+Itk_FindArchOptionPart(info, switchName, from)
+ ArchInfo *info; /* info for Archetype mega-widget */
+ char *switchName; /* name of command-line switch */
+ ClientData from; /* who contributed this option */
+{
+ ArchOptionPart *optPart = NULL;
+
+ char *name;
+ Tcl_HashEntry *entry;
+ ArchOption *archOpt;
+ ArchOptionPart *op;
+ Itcl_ListElem *elem;
+
+ /*
+ * If the switch does not have a leading "-", add it on.
+ */
+ if (*switchName != '-') {
+ name = ckalloc((unsigned)(strlen(switchName)+2));
+ *name = '-';
+ strcpy(name+1, switchName);
+ } else {
+ name = switchName;
+ }
+
+ /*
+ * Look for a composite option, and then for a part with the
+ * matching source.
+ */
+ entry = Tcl_FindHashEntry(&info->options, name);
+
+ if (entry) {
+ archOpt = (ArchOption*)Tcl_GetHashValue(entry);
+ elem = Itcl_FirstListElem(&archOpt->parts);
+ while (elem) {
+ op = (ArchOptionPart*)Itcl_GetListValue(elem);
+ if (op->from == from) {
+ optPart = op;
+ break;
+ }
+ elem = Itcl_NextListElem(elem);
+ }
+ }
+
+ if (name != switchName) {
+ ckfree(name);
+ }
+ return optPart;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_RemoveArchOptionPart()
+ *
+ * Searches for a specific piece of a composite configuration option
+ * for an Archetype mega-widget. The specified name is treated as the
+ * "switch" name (e.g., "-option"), but this procedure will recognize
+ * it even without the leading "-". If an option part with the
+ * specified name and source is found on the list, it is removed.
+ *
+ * NOTE: This procedure assumes that there is a valid object context
+ * and a call frame supporting object data member access. It is
+ * usually called from within the methods of the Archetype base
+ * class, so this is a good assumption. If it is called anywhere
+ * else, the caller is responsible for installing the object context
+ * and setting up a call frame.
+ *
+ * Returns non-zero if the part was found and removed, and 0 otherwise.
+ * ------------------------------------------------------------------------
+ */
+static int
+Itk_RemoveArchOptionPart(info, switchName, from)
+ ArchInfo *info; /* info for Archetype mega-widget */
+ char *switchName; /* name of command-line switch */
+ ClientData from; /* who contributed this option */
+{
+ int result = 0;
+
+ char *name;
+ Tcl_HashEntry *entry;
+ ArchOption *archOpt;
+ ArchOptionPart *op;
+ Itcl_ListElem *elem;
+
+
+ /*
+ * If the switch does not have a leading "-", add it on.
+ */
+ if (*switchName != '-') {
+ name = ckalloc((unsigned)(strlen(switchName)+2));
+ *name = '-';
+ strcpy(name+1, switchName);
+ } else {
+ name = switchName;
+ }
+
+ /*
+ * Look for a composite option, and then for a part with the
+ * matching source. If found, remove it.
+ */
+ entry = Tcl_FindHashEntry(&info->options, name);
+
+ if (entry) {
+ archOpt = (ArchOption*)Tcl_GetHashValue(entry);
+ elem = Itcl_FirstListElem(&archOpt->parts);
+ while (elem) {
+ op = (ArchOptionPart*)Itcl_GetListValue(elem);
+ if (op->from == from) {
+ Itk_DelOptionPart(op);
+ result = 1;
+ elem = Itcl_DeleteListElem(elem);
+ }
+ else {
+ elem = Itcl_NextListElem(elem);
+ }
+ }
+
+ /*
+ * If this option is now dead (no parts left), then
+ * remove it from the widget. Be careful to delete it
+ * from the "itk_option" array as well.
+ */
+ if (Itcl_GetListLength(&archOpt->parts) == 0) {
+ Tcl_UnsetVar2(info->itclObj->classDefn->interp,
+ "itk_option", archOpt->switchName, 0);
+
+ Itk_DelArchOption(archOpt);
+ Itk_OptListRemove(&info->order, entry);
+ Tcl_DeleteHashEntry(entry);
+ }
+ }
+
+ if (name != switchName) {
+ ckfree(name);
+ }
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_IgnoreArchOptionPart()
+ *
+ * Removes the specified part from a composite configuration option
+ * for an Archetype mega-widget. This is usually called before
+ * keeping or renaming an option, to make sure that the option
+ * is not already integrated elsewhere on the composite list.
+ * This also handles the action of "ignoring" a configuration option.
+ *
+ * NOTE: This procedure assumes that there is a valid object context
+ * and a call frame supporting object data member access. It is
+ * usually called from within the methods of the Archetype base
+ * class, so this is a good assumption. If it is called anywhere
+ * else, the caller is responsible for installing the object context
+ * and setting up a call frame.
+ *
+ * Returns non-zero if the part was found and removed, and 0 otherwise.
+ * ------------------------------------------------------------------------
+ */
+static int
+Itk_IgnoreArchOptionPart(info, opt)
+ ArchInfo *info; /* info for Archetype mega-widget */
+ GenericConfigOpt *opt; /* part to be ignored */
+{
+ int result = 0;
+
+ Tcl_HashEntry *entry;
+ ArchOptionPart *op;
+ Itcl_ListElem *elem;
+
+ /*
+ * If the part is not integrated, then do nothing.
+ * Otherwise, find the missing part and remove it.
+ */
+ if (opt->integrated) {
+ elem = Itcl_FirstListElem(&opt->integrated->parts);
+ while (elem) {
+ op = (ArchOptionPart*)Itcl_GetListValue(elem);
+ if (op == opt->optPart) {
+ Itk_DelOptionPart(op);
+ result = 1;
+ elem = Itcl_DeleteListElem(elem);
+ }
+ else {
+ elem = Itcl_NextListElem(elem);
+ }
+ }
+
+ /*
+ * If this option is now dead (no parts left), then
+ * remove it from the widget. Be careful to delete it
+ * from the "itk_option" array as well.
+ */
+ if (Itcl_GetListLength(&opt->integrated->parts) == 0) {
+ Tcl_UnsetVar2(info->itclObj->classDefn->interp,
+ "itk_option", opt->integrated->switchName, 0);
+
+ entry = Tcl_FindHashEntry(&info->options,
+ opt->integrated->switchName);
+
+ if (entry) {
+ Itk_OptListRemove(&info->order, entry);
+ Tcl_DeleteHashEntry(entry);
+ }
+ Itk_DelArchOption(opt->integrated);
+ }
+
+ /*
+ * Forget that this part was ever integrated.
+ */
+ opt->integrated = NULL;
+ opt->optPart = NULL;
+ }
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_DelOptionPart()
+ *
+ * Destroys part of an Archetype configuration option created by
+ * Itk_CreateOptionPart().
+ * ------------------------------------------------------------------------
+ */
+static void
+Itk_DelOptionPart(optPart)
+ ArchOptionPart *optPart; /* option part data to be destroyed */
+{
+ if (optPart->clientData && optPart->deleteProc) {
+ (*optPart->deleteProc)(optPart->clientData);
+ }
+ ckfree((char*)optPart);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_CreateConfigCmdline()
+ *
+ * Creates the data representing a command line for a "configure"
+ * operation. Each "configure" command has the following form:
+ *
+ * <object> configure -<option> <value>
+ *
+ * The first three arguments are created in this procedure. The
+ * <value> argument is reinitialized each time the command is
+ * executed.
+ *
+ * Returns a pointer to the new command record.
+ * ------------------------------------------------------------------------
+ */
+static ConfigCmdline*
+Itk_CreateConfigCmdline(interp, accessCmd, switchName)
+ Tcl_Interp *interp; /* interpreter handling this request */
+ Tcl_Command accessCmd; /* command for <object> being config'd */
+ char *switchName; /* switch name of option being config'd */
+{
+ int i;
+ ConfigCmdline *cmdlinePtr;
+ Tcl_Obj *objPtr;
+
+ /*
+ * Create the record to represent this part of the option.
+ */
+ cmdlinePtr = (ConfigCmdline*)ckalloc(sizeof(ConfigCmdline));
+
+ objPtr = Tcl_NewStringObj((char*)NULL, 0);
+ Tcl_GetCommandFullName(interp, accessCmd, objPtr);
+ cmdlinePtr->objv[0] = objPtr;
+ cmdlinePtr->objv[1] = Tcl_NewStringObj("configure", -1);
+ cmdlinePtr->objv[2] = Tcl_NewStringObj(switchName, -1);
+
+ for (i=0; i < 3; i++) {
+ Tcl_IncrRefCount(cmdlinePtr->objv[i]);
+ }
+ return cmdlinePtr;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_DeleteConfigCmdline()
+ *
+ * Deletes the data created by Itk_CreateConfigCmdline. Called
+ * when an option part is deleted to free up the memory associated
+ * with the configure command.
+ * ------------------------------------------------------------------------
+ */
+static void
+Itk_DeleteConfigCmdline(cdata)
+ ClientData cdata; /* command to be freed */
+{
+ ConfigCmdline *cmdlinePtr = (ConfigCmdline*)cdata;
+ int i;
+
+ /*
+ * TRICKY NOTE: Decrement the reference counts for only the
+ * first three arguments on the command line. The fourth
+ * argument is released after each configure operation.
+ */
+ for (i=0; i < 3; i++) {
+ Tcl_DecrRefCount(cmdlinePtr->objv[i]);
+ }
+ ckfree((char*)cmdlinePtr);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_CreateGenericOptTable()
+ *
+ * Parses a string describing a widget's configuration options (of the
+ * form returned by the usual widget "configure" method) and creates
+ * a hash table for easy lookup of option information. Entries in
+ * the hash table are indexed by switch names like "-background".
+ * Values are GenericConfigOpt records. Alias options like "-bg" are
+ * ignored.
+ *
+ * This table is used by option parsing commands in "itk::option-parser"
+ * to validate widget options.
+ *
+ * Returns a pointer to a new hash table, which should later be freed
+ * via Itk_DelGenericOptTable(). Returns NULL if an error is found in
+ * the configuration list.
+ * ------------------------------------------------------------------------
+ */
+static Tcl_HashTable*
+Itk_CreateGenericOptTable(interp, options)
+ Tcl_Interp *interp; /* interpreter handling this request */
+ char *options; /* string description of config options */
+{
+ int confc;
+ char **confv = NULL;
+ int optc;
+ char **optv = NULL;
+
+ int i, newEntry;
+ Tcl_HashTable *tPtr;
+ Tcl_HashEntry *entry;
+ GenericConfigOpt *info;
+
+ tPtr = (Tcl_HashTable*)ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tPtr, TCL_STRING_KEYS);
+
+ /*
+ * Split the list of options and store each one in the table.
+ * Only consider options with all 5 required components. Avoid
+ * aliases like "-bg".
+ */
+ if (Tcl_SplitList(interp, options, &confc, &confv) != TCL_OK) {
+ goto tableFail;
+ }
+ for (i=0; i < confc; i++) {
+ if (Tcl_SplitList(interp, confv[i], &optc, &optv) != TCL_OK) {
+ goto tableFail;
+ }
+ if (optc == 5) { /* avoid aliased options */
+ entry = Tcl_CreateHashEntry(tPtr, optv[0], &newEntry);
+ if (newEntry) {
+ info = (GenericConfigOpt*)ckalloc(sizeof(GenericConfigOpt));
+ info->switchName = optv[0];
+ info->resName = optv[1];
+ info->resClass = optv[2];
+ info->init = optv[3];
+ info->value = optv[4];
+ info->storage = optv;
+ info->integrated = NULL;
+ info->optPart = NULL;
+ Tcl_SetHashValue(entry, (ClientData)info);
+ }
+ }
+ else {
+ ckfree((char*)optv);
+ }
+ }
+
+ ckfree((char*)confv);
+ return tPtr;
+
+tableFail:
+ if (confv) {
+ ckfree((char*)confv);
+ }
+ Itk_DelGenericOptTable(tPtr);
+ return NULL;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_DelGenericOptTable()
+ *
+ * Destroys an option table previously created by
+ * Itk_CreateGenericOptTable() and frees all memory associated with it.
+ * Should be called whenever a table is no longer needed, to free up
+ * resources.
+ * ------------------------------------------------------------------------
+ */
+static void
+Itk_DelGenericOptTable(tPtr)
+ Tcl_HashTable *tPtr; /* option table to be destroyed */
+{
+ Tcl_HashEntry *entry;
+ Tcl_HashSearch place;
+ GenericConfigOpt *info;
+
+ /*
+ * Scan through all options in the table and free entries.
+ */
+ entry = Tcl_FirstHashEntry(tPtr, &place);
+ while (entry) {
+ info = (GenericConfigOpt*)Tcl_GetHashValue(entry);
+ ckfree((char*)info->storage);
+ ckfree((char*)info);
+ entry = Tcl_NextHashEntry(&place);
+ }
+
+ Tcl_DeleteHashTable(tPtr);
+ ckfree((char*)tPtr);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_CreateGenericOpt()
+ *
+ * Parses a string describing a widget's configuration option (of the
+ * form returned by the usual widget "configure" method) and creates
+ * a representation for one option. Similar to
+ * Itk_CreateGenericOptTable(), but only handles one option at a
+ * time.
+ *
+ * Returns a pointer to the option info, which should later be freed
+ * via Itk_DelGenericOpt(). Returns NULL (along with an error
+ * message in the interpreter) if an error is found.
+ *
+ * SIDE EFFECT: Resets the interpreter result.
+ * ------------------------------------------------------------------------
+ */
+static GenericConfigOpt*
+Itk_CreateGenericOpt(interp, switchName, accessCmd)
+ Tcl_Interp *interp; /* interpreter handling this request */
+ char *switchName; /* command-line switch for option */
+ Tcl_Command accessCmd; /* access command for component */
+{
+ GenericConfigOpt *genericOpt = NULL;
+ Tcl_Obj *codePtr = NULL;
+
+ int optc, result;
+ char **optv;
+ char *name, *info;
+ Tcl_Obj *resultPtr;
+
+ /*
+ * If the switch does not have a leading "-", add it on.
+ */
+ if (*switchName != '-') {
+ name = ckalloc((unsigned)(strlen(switchName)+2));
+ *name = '-';
+ strcpy(name+1, switchName);
+ } else {
+ name = switchName;
+ }
+
+ /*
+ * Build a "configure" command to query info for the requested
+ * option. Evaluate the command and get option info.
+ */
+ codePtr = Tcl_NewStringObj((char*)NULL, 0);
+ Tcl_IncrRefCount(codePtr);
+
+ Tcl_GetCommandFullName(interp, accessCmd, codePtr);
+ Tcl_AppendToObj(codePtr, " configure ", -1);
+ Tcl_AppendToObj(codePtr, name, -1);
+
+ /* CYGNUS LOCAL - Fix for Tcl8.1 */
+#if TCL_MAJOR_VERSION == 8 && TCL_MINOR_VERSION == 0
+ if (Tcl_EvalObj(interp, codePtr) != TCL_OK) {
+#else
+ if (Tcl_EvalObj(interp, codePtr, 0) != TCL_OK) {
+#endif
+ /* END CYGNUS LOCAL */
+ goto optionDone;
+ }
+
+ /*
+ * Only consider options with all 5 required components. Avoid
+ * aliases like "-bg".
+ */
+ resultPtr = Tcl_GetObjResult(interp);
+ Tcl_IncrRefCount(resultPtr);
+ info = Tcl_GetStringFromObj(resultPtr, (int*)NULL);
+
+ result = Tcl_SplitList(interp, info, &optc, &optv);
+
+ Tcl_DecrRefCount(resultPtr);
+
+ if (result != TCL_OK) {
+ goto optionDone;
+ }
+ if (optc == 5) { /* avoid aliased options */
+ genericOpt = (GenericConfigOpt*)ckalloc(sizeof(GenericConfigOpt));
+ genericOpt->switchName = optv[0];
+ genericOpt->resName = optv[1];
+ genericOpt->resClass = optv[2];
+ genericOpt->init = optv[3];
+ genericOpt->value = optv[4];
+ genericOpt->storage = optv;
+ genericOpt->integrated = NULL;
+ genericOpt->optPart = NULL;
+ }
+ else {
+ ckfree((char*)optv);
+ }
+
+optionDone:
+ if (name != switchName) {
+ ckfree(name);
+ }
+ if (codePtr) {
+ Tcl_DecrRefCount(codePtr);
+ }
+ if (genericOpt) {
+ Tcl_ResetResult(interp);
+ }
+ return genericOpt;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_DelGenericOpt()
+ *
+ * Destroys a generic option previously created by Itk_CreateGenericOpt()
+ * and frees all memory associated with it. Should be called whenever
+ * an option representation is no longer needed, to free up resources.
+ * ------------------------------------------------------------------------
+ */
+static void
+Itk_DelGenericOpt(opt)
+ GenericConfigOpt *opt; /* option info to be destroyed */
+{
+ ckfree((char*)opt->storage);
+ ckfree((char*)opt);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItkGetObjsWithArchInfo()
+ *
+ * Returns a pointer to a hash table containing the list of registered
+ * objects in the specified interpreter. If the hash table does not
+ * already exist, it is created.
+ * ------------------------------------------------------------------------
+ */
+static Tcl_HashTable*
+ItkGetObjsWithArchInfo(interp)
+ Tcl_Interp *interp; /* interpreter handling this registration */
+{
+ Tcl_HashTable* objTable;
+
+ /*
+ * If the registration table does not yet exist, then create it.
+ */
+ objTable = (Tcl_HashTable*)Tcl_GetAssocData(interp,
+ "itk_objsWithArchInfo", (Tcl_InterpDeleteProc**)NULL);
+
+ if (!objTable) {
+ objTable = (Tcl_HashTable*)ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(objTable, TCL_ONE_WORD_KEYS);
+ Tcl_SetAssocData(interp, "itk_objsWithArchInfo",
+ ItkFreeObjsWithArchInfo, (ClientData)objTable);
+ }
+ return objTable;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * ItkFreeObjsWithArchInfo()
+ *
+ * When an interpreter is deleted, this procedure is called to
+ * free up the associated data created by ItkGetObjsWithArchInfo.
+ * ------------------------------------------------------------------------
+ */
+static void
+ItkFreeObjsWithArchInfo(clientData, interp)
+ ClientData clientData; /* associated data */
+ Tcl_Interp *interp; /* interpreter being freed */
+{
+ Tcl_HashTable *tablePtr = (Tcl_HashTable*)clientData;
+ Tcl_HashSearch place;
+ Tcl_HashEntry *entry;
+
+ entry = Tcl_FirstHashEntry(tablePtr, &place);
+ while (entry) {
+ Itk_DelArchInfo( Tcl_GetHashValue(entry) );
+ entry = Tcl_NextHashEntry(&place);
+ }
+
+ Tcl_DeleteHashTable(tablePtr);
+ ckfree((char*)tablePtr);
+}
diff --git a/itcl/itk/generic/itk_cmds.c b/itcl/itk/generic/itk_cmds.c
new file mode 100644
index 00000000000..0a789705d44
--- /dev/null
+++ b/itcl/itk/generic/itk_cmds.c
@@ -0,0 +1,316 @@
+/*
+ * ------------------------------------------------------------------------
+ * PACKAGE: [incr Tk]
+ * DESCRIPTION: Building mega-widgets with [incr Tcl]
+ *
+ * [incr Tk] provides a framework for building composite "mega-widgets"
+ * using [incr Tcl] classes. It defines a set of base classes that are
+ * specialized to create all other widgets.
+ *
+ * This file defines the initialization and facilities common to all
+ * mega-widgets.
+ *
+ * ========================================================================
+ * AUTHOR: Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ * http://www.tcltk.com/itcl
+ *
+ * RCS: $Id$
+ * ========================================================================
+ * Copyright (c) 1993-1998 Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#include "itk.h"
+
+/*
+ * FORWARD DECLARATIONS
+ */
+static int Initialize _ANSI_ARGS_((Tcl_Interp *interp));
+
+/*
+ * The following string is the startup script executed in new
+ * interpreters. It looks on disk in several different directories
+ * for a script "init.tcl" that is compatible with this version
+ * of Tcl. The init.tcl script does all of the real work of
+ * initialization.
+ */
+
+static char initScript[] = "\n\
+namespace eval ::itk {\n\
+ proc _find_init {} {\n\
+ global env tcl_library\n\
+ variable library\n\
+ variable version\n\
+ rename _find_init {}\n\
+ tcl_findLibrary itk 3.0 {} itk.tcl ITK_LIBRARY ::itk::library {} {} itcl\n\
+ }\n\
+ _find_init\n\
+}";
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Initialize()
+ *
+ * Invoked whenever a new interpeter is created to install the
+ * [incr Tk] package.
+ *
+ * Creates the "::itk" namespace and installs access commands.
+ *
+ * Returns TCL_OK on success, or TCL_ERROR (along with an error
+ * message in the interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+static int
+Initialize(interp)
+ Tcl_Interp *interp; /* interpreter to be updated */
+{
+ Tcl_Namespace *itkNs, *parserNs;
+ ClientData parserInfo;
+
+ if (Tcl_PkgRequire(interp, "Tk", TK_VERSION, 0) == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tcl_PkgRequire(interp, "Itcl", ITCL_VERSION, 0) == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Install [incr Tk] facilities if not already installed.
+ */
+ itkNs = Tcl_FindNamespace(interp, "::itk", (Tcl_Namespace*)NULL,
+ /* flags */ 0);
+
+ if (itkNs) {
+ Tcl_SetResult(interp, "already installed: [incr Tk]", TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Add the "itk_option" ensemble to the itcl class definition parser.
+ */
+ parserNs = Tcl_FindNamespace(interp, "::itcl::parser",
+ (Tcl_Namespace*)NULL, /* flags */ 0);
+
+ if (!parserNs) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "cannot initialize [incr Tk]: [incr Tcl] has not been installed\n",
+ "Make sure that Itcl_Init() is called before Itk_Init()",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ parserInfo = parserNs->clientData;
+
+ if (Itcl_CreateEnsemble(interp, "::itcl::parser::itk_option") != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Itcl_AddEnsemblePart(interp, "::itcl::parser::itk_option",
+ "define", "-switch resourceName resourceClass init ?config?",
+ Itk_ClassOptionDefineCmd,
+ parserInfo, Itcl_ReleaseData) != TCL_OK) {
+
+ return TCL_ERROR;
+ }
+ Itcl_PreserveData(parserInfo);
+
+ if (Itcl_AddEnsemblePart(interp, "::itcl::parser::itk_option",
+ "add", "name ?name name...?",
+ Itk_ClassOptionIllegalCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK ||
+
+ Itcl_AddEnsemblePart(interp, "::itcl::parser::itk_option",
+ "remove", "name ?name name...?",
+ Itk_ClassOptionIllegalCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL) != TCL_OK) {
+
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the "itk" namespace. Export all the commands in
+ * the namespace so that they can be imported by a command
+ * such as "namespace import itk::*"
+ */
+ itkNs = Tcl_CreateNamespace(interp, "::itk",
+ (ClientData)NULL, (Tcl_NamespaceDeleteProc*)NULL);
+
+ if (!itkNs ||
+ Tcl_Export(interp, itkNs, "*", /* resetListFirst */ 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Setup things for itk::Archetype base class.
+ */
+ if (Itk_ArchetypeInit(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Fix the "itcl::configbody" command to recognize mega-widget
+ * options.
+ */
+ Tcl_CreateObjCommand(interp, "::itcl::configbody", Itk_ConfigBodyCmd,
+ (ClientData)NULL, (Tcl_CmdDeleteProc*)NULL);
+
+ Tcl_SetVar(interp, "::itk::version", ITCL_VERSION, 0);
+ Tcl_SetVar(interp, "::itk::patchLevel", ITCL_PATCH_LEVEL, 0);
+
+ /*
+ * Signal that the package has been loaded.
+ */
+ if (Tcl_PkgProvide(interp, "Itk", ITCL_VERSION) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_Init()
+ *
+ * Invoked whenever a new interpeter is created to install the
+ * [incr Tcl] package. Usually invoked within Tcl_AppInit() at
+ * the start of execution.
+ *
+ * Creates the "::itk" namespace and installs access commands.
+ *
+ * Returns TCL_OK on success, or TCL_ERROR (along with an error
+ * message in the interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+int
+Itk_Init(interp)
+ Tcl_Interp *interp; /* interpreter to be updated */
+{
+ if (Initialize(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return Tcl_Eval(interp, initScript);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ConfigBodyCmd()
+ *
+ * Replacement for the usual "itcl::configbody" command. Recognizes
+ * mega-widget options included in a class definition. Options are
+ * identified by their "switch" name, but without the "-" prefix:
+ *
+ * itcl::configbody <class>::<itkOption> <body>
+ *
+ * Handles bodies for public variables as well:
+ *
+ * itcl::configbody <class>::<publicVar> <body>
+ *
+ * If an <itkOption> is found, it has priority over public variables.
+ * If <body> has the form "@name" then it is treated as a reference
+ * to a C handling procedure; otherwise, it is taken as a body of
+ * Tcl statements.
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itk_ConfigBodyCmd(dummy, interp, objc, objv)
+ ClientData dummy; /* unused */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ int result = TCL_OK;
+
+ char *token, *head, *tail;
+ ItclClass *cdefn;
+ ItclMemberCode *mcode;
+ ItkClassOptTable *optTable;
+ Tcl_HashEntry *entry;
+ ItkClassOption *opt;
+ Tcl_DString buffer;
+
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 1, objv, "class::option body");
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the member name "namesp::namesp::class::option".
+ * Make sure that a class name was specified, and that the
+ * class exists.
+ */
+ token = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ Itcl_ParseNamespPath(token, &buffer, &head, &tail);
+
+ if (!head || *head == '\0') {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "missing class specifier for body declaration \"", token, "\"",
+ (char*)NULL);
+ result = TCL_ERROR;
+ goto configBodyCmdDone;
+ }
+
+ cdefn = Itcl_FindClass(interp, head, /* autoload */ 1);
+ if (cdefn == NULL) {
+ result = TCL_ERROR;
+ goto configBodyCmdDone;
+ }
+
+ /*
+ * Look first for a configuration option with that name.
+ * If it is not found, assume the reference is for a public
+ * variable, and use the usual "configbody" implementation
+ * to handle it.
+ */
+ optTable = Itk_FindClassOptTable(cdefn);
+ opt = NULL;
+
+ if (optTable) {
+ Tcl_DString optName;
+
+ Tcl_DStringInit(&optName);
+ Tcl_DStringAppend(&optName, "-", -1);
+ Tcl_DStringAppend(&optName, tail, -1);
+ entry = Tcl_FindHashEntry(&optTable->options,
+ Tcl_DStringValue(&optName));
+
+ if (entry) {
+ opt = (ItkClassOption*)Tcl_GetHashValue(entry);
+ }
+ Tcl_DStringFree(&optName);
+ }
+
+ if (opt == NULL) {
+ result = Itcl_ConfigBodyCmd(dummy, interp, objc, objv);
+ goto configBodyCmdDone;
+ }
+
+ /*
+ * Otherwise, change the implementation for this option.
+ */
+ token = Tcl_GetStringFromObj(objv[2], (int*)NULL);
+
+ if (Itcl_CreateMemberCode(interp, cdefn, (char*)NULL, token,
+ &mcode) != TCL_OK) {
+
+ result = TCL_ERROR;
+ goto configBodyCmdDone;
+ }
+
+ Itcl_PreserveData((ClientData)mcode);
+ Itcl_EventuallyFree((ClientData)mcode, Itcl_DeleteMemberCode);
+
+ if (opt->member->code) {
+ Itcl_ReleaseData((ClientData)opt->member->code);
+ }
+ opt->member->code = mcode;
+
+configBodyCmdDone:
+ Tcl_DStringFree(&buffer);
+ return result;
+}
diff --git a/itcl/itk/generic/itk_option.c b/itcl/itk/generic/itk_option.c
new file mode 100644
index 00000000000..d329b59348c
--- /dev/null
+++ b/itcl/itk/generic/itk_option.c
@@ -0,0 +1,586 @@
+/*
+ * ------------------------------------------------------------------------
+ * PACKAGE: [incr Tk]
+ * DESCRIPTION: Building mega-widgets with [incr Tcl]
+ *
+ * [incr Tk] provides a framework for building composite "mega-widgets"
+ * using [incr Tcl] classes. It defines a set of base classes that are
+ * specialized to create all other widgets.
+ *
+ * This file defines procedures used to manage mega-widget options
+ * specified within class definitions.
+ *
+ * ========================================================================
+ * AUTHOR: Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ * http://www.tcltk.com/itcl
+ *
+ * RCS: $Id$
+ * ========================================================================
+ * Copyright (c) 1993-1998 Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#include "itk.h"
+
+/*
+ * FORWARD DECLARATIONS
+ */
+static char* ItkTraceClassDestroy _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp, char *name1, char *name2, int flags));
+static Tcl_HashTable* ItkGetClassesWithOptInfo _ANSI_ARGS_((
+ Tcl_Interp *interp));
+static void ItkFreeClassesWithOptInfo _ANSI_ARGS_((ClientData cdata,
+ Tcl_Interp *interp));
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ClassOptionDefineCmd()
+ *
+ * Invoked when a class definition is being parse to handle an
+ * itk_option declaration. Adds a new option to a mega-widget
+ * declaration, with some code that will be executed whenever the
+ * option is changed via "configure". If there is already an existing
+ * option by that name, then this new option is folded into the
+ * existing option, but the <init> value is ignored. The X11 resource
+ * database names must be consistent with the existing option.
+ *
+ * Handles the following syntax:
+ *
+ * itk_option define <switch> <resName> <resClass> <init> ?<config>?
+ *
+ * Returns TCL_OK/TCL_ERROR to indicate success/failure.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itk_ClassOptionDefineCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* class parser info */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ ItclObjectInfo *info = (ItclObjectInfo*)clientData;
+ ItclClass *cdefn = (ItclClass*)Itcl_PeekStack(&info->cdefnStack);
+
+ int newEntry;
+ char *switchName, *resName, *resClass, *init, *config;
+ ItkClassOptTable *optTable;
+ Tcl_HashEntry *entry;
+ ItkClassOption *opt;
+
+ /*
+ * Make sure that the arguments look right. The option switch
+ * name must start with a '-'.
+ */
+ if (objc < 5 || objc > 6) {
+ Tcl_WrongNumArgs(interp, 1, objv,
+ "-switch resourceName resourceClass init ?config?");
+ return TCL_ERROR;
+ }
+
+ switchName = Tcl_GetStringFromObj(objv[1], (int*)NULL);
+ if (*switchName != '-') {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad option name \"", switchName, "\": should be -", switchName,
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+ if (strstr(switchName, ".")) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad option name \"", switchName, "\": illegal character \".\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ resName = Tcl_GetStringFromObj(objv[2], (int*)NULL);
+ if (!islower((int)*resName)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad resource name \"", resName,
+ "\": should start with a lower case letter",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ resClass = Tcl_GetStringFromObj(objv[3], (int*)NULL);
+ if (!isupper((int)*resClass)) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "bad resource class \"", resClass,
+ "\": should start with an upper case letter",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that this option has not already been defined in
+ * the context of this class. Options can be redefined in
+ * other classes, but can only be defined once in a given
+ * class. This ensures that there will be no confusion about
+ * which option is being referenced if the configuration code
+ * is redefined by a subsequent "body" command.
+ */
+ optTable = Itk_CreateClassOptTable(interp, cdefn);
+ entry = Tcl_CreateHashEntry(&optTable->options, switchName, &newEntry);
+
+ if (!newEntry) {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "option \"", switchName, "\" already defined in class \"",
+ cdefn->fullname, "\"",
+ (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create a new option record and add it to the table for this
+ * class.
+ */
+ init = Tcl_GetStringFromObj(objv[4], (int*)NULL);
+
+ if (objc == 6) {
+ config = Tcl_GetStringFromObj(objv[5], (int*)NULL);
+ } else {
+ config = NULL;
+ }
+
+ if (Itk_CreateClassOption(interp, cdefn, switchName, resName, resClass,
+ init, config, &opt) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tcl_SetHashValue(entry, (ClientData)opt);
+ Itk_OptListAdd(&optTable->order, entry);
+ return TCL_OK;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ClassOptionIllegalCmd()
+ *
+ * Invoked when a class definition is being parse to handle an
+ * itk_option declaration. Handles an "illegal" declaration like
+ * "add" or "remove", which can only be used after a widget has
+ * been created. Returns TCL_ERROR along with an error message.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itk_ClassOptionIllegalCmd(clientData, interp, objc, objv)
+ ClientData clientData; /* class parser info */
+ Tcl_Interp *interp; /* current interpreter */
+ int objc; /* number of arguments */
+ Tcl_Obj *CONST objv[]; /* argument objects */
+{
+ char *op = Tcl_GetStringFromObj(objv[0], (int*)NULL);
+
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "can only ", op, " options for a specific widget\n",
+ "(move this command into the constructor)",
+ (char*)NULL);
+
+ return TCL_ERROR;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_ConfigClassOption()
+ *
+ * Invoked whenever a class-based configuration option has been
+ * configured with a new value. If the option has any extra code
+ * associated with it, the code is invoked at this point to bring
+ * the widget up-to-date.
+ *
+ * Returns TCL_OK on success, or TCL_ERROR (along with an error
+ * message in the interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+int
+Itk_ConfigClassOption(interp, contextObj, cdata, newval)
+ Tcl_Interp *interp; /* interpreter managing the class */
+ ItclObject *contextObj; /* object being configured */
+ ClientData cdata; /* class option */
+ char *newval; /* new value for this option */
+{
+ ItkClassOption *opt = (ItkClassOption*)cdata;
+ int result = TCL_OK;
+ ItclMemberCode *mcode;
+
+ /*
+ * If the option has any config code, execute it now.
+ * Make sure that the namespace context is set up correctly.
+ */
+ mcode = opt->member->code;
+ if (mcode && mcode->procPtr->bodyPtr) {
+ result = Itcl_EvalMemberCode(interp, (ItclMemberFunc*)NULL,
+ opt->member, contextObj, 0, (Tcl_Obj**)NULL);
+ }
+ return result;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_CreateClassOptTable()
+ *
+ * Finds or creates an option table which will contain all of the
+ * class-based configuration options for a mega-widget. These are
+ * the options included in the class definition which add new behavior
+ * to the mega-widget.
+ *
+ * This table is automatically deleted by ItkTraceClassDestroy
+ * whenever the class namespace is destroyed. The "unset" operation
+ * of a private class variable is used to detect the destruction of
+ * the namespace.
+ *
+ * Returns a pointer to an option table which will contain pointers to
+ * ItkClassOption records.
+ * ------------------------------------------------------------------------
+ */
+ItkClassOptTable*
+Itk_CreateClassOptTable(interp, cdefn)
+ Tcl_Interp *interp; /* interpreter managing the class */
+ ItclClass *cdefn; /* class definition */
+{
+ int newEntry, result;
+ Tcl_HashTable *itkClasses;
+ Tcl_HashEntry *entry;
+ ItkClassOptTable *optTable;
+ Tcl_CallFrame frame;
+
+ /*
+ * Look for the specified class definition in the table.
+ * If it does not yet exist, then create a new slot for it.
+ * When a table is created for the first time, add a
+ * special sentinel variable "_itk_option_data" to the
+ * class namespace, and put a trace on this variable.
+ * Whenever it is destroyed, have it delete the option table
+ * for this class.
+ */
+ itkClasses = ItkGetClassesWithOptInfo(interp);
+
+ entry = Tcl_CreateHashEntry(itkClasses, (char*)cdefn, &newEntry);
+ if (newEntry) {
+ optTable = (ItkClassOptTable*)ckalloc(sizeof(ItkClassOptTable));
+ Tcl_InitHashTable(&optTable->options, TCL_STRING_KEYS);
+ Itk_OptListInit(&optTable->order, &optTable->options);
+
+ Tcl_SetHashValue(entry, (ClientData)optTable);
+
+ result = Tcl_PushCallFrame(interp, &frame,
+ cdefn->namesp, /* isProcCallFrame */ 0);
+
+ if (result == TCL_OK) {
+ Tcl_TraceVar(interp, "_itk_option_data",
+ (TCL_TRACE_UNSETS | TCL_NAMESPACE_ONLY),
+ ItkTraceClassDestroy, (ClientData)cdefn);
+ Tcl_PopCallFrame(interp);
+ }
+ }
+ else {
+ optTable = (ItkClassOptTable*)Tcl_GetHashValue(entry);
+ }
+ return optTable;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_FindClassOptTable()
+ *
+ * Looks for an option table containing all of the class-based
+ * configuration options for a mega-widget. These are the options
+ * included in a class definition which add new behavior to the
+ * mega-widget.
+ *
+ * Returns a pointer to an option table which will contain pointers to
+ * Itk_ClassOption records. If a table does not exist for this class,
+ * this returns NULL.
+ * ------------------------------------------------------------------------
+ */
+ItkClassOptTable*
+Itk_FindClassOptTable(cdefn)
+ ItclClass *cdefn; /* class definition */
+{
+ Tcl_HashTable *itkClasses;
+ Tcl_HashEntry *entry;
+
+ /*
+ * Look for the specified class definition in the table.
+ */
+ itkClasses = ItkGetClassesWithOptInfo(cdefn->interp);
+ entry = Tcl_FindHashEntry(itkClasses, (char*)cdefn);
+ if (entry) {
+ return (ItkClassOptTable*)Tcl_GetHashValue(entry);
+ }
+ return NULL;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItkTraceClassDestroy()
+ *
+ * Invoked automatically whenever the "_itk_option_data" variable
+ * is destroyed within a class namespace. This should be a signal
+ * that the namespace is being destroyed.
+ *
+ * Releases any option data that exists for the class.
+ *
+ * Returns NULL on success, or a pointer to a string describing any
+ * error that is encountered.
+ * ------------------------------------------------------------------------
+ */
+/* ARGSUSED */
+static char*
+ItkTraceClassDestroy(cdata, interp, name1, name2, flags)
+ ClientData cdata; /* class definition data */
+ Tcl_Interp *interp; /* interpreter managing the class */
+ char *name1; /* name of variable involved in trace */
+ char *name2; /* name of array element within variable */
+ int flags; /* flags describing trace */
+{
+ ItclClass *cdefn = (ItclClass*)cdata;
+
+ Tcl_HashTable *itkClasses;
+ Tcl_HashEntry *entry;
+ ItkClassOptTable *optTable;
+ Tcl_HashSearch place;
+ ItkClassOption *opt;
+
+ /*
+ * Look for the specified class definition in the table.
+ * If it is found, delete all the option records and tear
+ * down the table.
+ */
+ itkClasses = ItkGetClassesWithOptInfo(cdefn->interp);
+ entry = Tcl_FindHashEntry(itkClasses, (char*)cdefn);
+ if (entry) {
+ optTable = (ItkClassOptTable*)Tcl_GetHashValue(entry);
+ Tcl_DeleteHashEntry(entry);
+
+ entry = Tcl_FirstHashEntry(&optTable->options, &place);
+ while (entry) {
+ opt = (ItkClassOption*)Tcl_GetHashValue(entry);
+ Itk_DelClassOption(opt);
+ entry = Tcl_NextHashEntry(&place);
+ }
+ Tcl_DeleteHashTable(&optTable->options);
+ Itk_OptListFree(&optTable->order);
+ ckfree((char*)optTable);
+ }
+ return NULL;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_CreateClassOption()
+ *
+ * Creates the data representing a configuration option for an
+ * Archetype mega-widget. This record represents an option included
+ * in the class definition. It adds new behavior to the mega-widget
+ * class.
+ *
+ * If successful, returns TCL_OK along with a pointer to the option
+ * record. Returns TCL_ERROR (along with an error message in the
+ * interpreter) if anything goes wrong.
+ * ------------------------------------------------------------------------
+ */
+int
+Itk_CreateClassOption(interp, cdefn, switchName, resName, resClass,
+ defVal, config, optPtr)
+
+ Tcl_Interp *interp; /* interpreter managing the class */
+ ItclClass *cdefn; /* class containing this option */
+ char *switchName; /* name of command-line switch */
+ char *resName; /* resource name in X11 database */
+ char *resClass; /* resource class name in X11 database */
+ char *defVal; /* last-resort default value */
+ char *config; /* configuration code */
+ ItkClassOption **optPtr; /* returns: option record */
+{
+ ItkClassOption *opt;
+ ItclMemberCode *mcode;
+
+ /*
+ * If this option has any "config" code, then try to create
+ * an implementation for it.
+ */
+ if (config) {
+ if (Itcl_CreateMemberCode(interp, cdefn, (char*)NULL, config,
+ &mcode) != TCL_OK) {
+
+ return TCL_ERROR;
+ }
+ Itcl_PreserveData((ClientData)mcode);
+ Itcl_EventuallyFree((ClientData)mcode, Itcl_DeleteMemberCode);
+ }
+ else {
+ mcode = NULL;
+ }
+
+ /*
+ * Create the record to represent this option.
+ */
+ opt = (ItkClassOption*)ckalloc(sizeof(ItkClassOption));
+ opt->member = Itcl_CreateMember(interp, cdefn, switchName);
+ opt->member->code = mcode;
+
+ opt->resName = (char*)ckalloc((unsigned)(strlen(resName)+1));
+ strcpy(opt->resName, resName);
+
+ opt->resClass = (char*)ckalloc((unsigned)(strlen(resClass)+1));
+ strcpy(opt->resClass, resClass);
+
+ opt->init = (char*)ckalloc((unsigned)(strlen(defVal)+1));
+ strcpy(opt->init, defVal);
+
+ *optPtr = opt;
+ return TCL_OK;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_FindClassOption()
+ *
+ * Searches for a class-based configuration option for an Archetype
+ * mega-widget. The specified name is treated as the "switch" name
+ * (e.g., "-option"), but this procedure will recognize it even without
+ * the leading "-".
+ *
+ * If an option is found that was defined in the specified class,
+ * then this procedure returns a pointer to the option definition.
+ * Otherwise, it returns NULL.
+ * ------------------------------------------------------------------------
+ */
+ItkClassOption*
+Itk_FindClassOption(cdefn, switchName)
+ ItclClass *cdefn; /* class containing this option */
+ char *switchName; /* name of command-line switch */
+{
+ ItkClassOption *opt = NULL;
+
+ Tcl_DString buffer;
+ ItkClassOptTable *optTable;
+ Tcl_HashEntry *entry;
+
+ /*
+ * If the switch does not have a leading "-", add it on.
+ */
+ Tcl_DStringInit(&buffer);
+ if (*switchName != '-') {
+ Tcl_DStringAppend(&buffer, "-", -1);
+ Tcl_DStringAppend(&buffer, switchName, -1);
+ switchName = Tcl_DStringValue(&buffer);
+ }
+
+ /*
+ * Look for the option table for the specified class, and check
+ * for the requested switch.
+ */
+ optTable = Itk_FindClassOptTable(cdefn);
+ if (optTable) {
+ entry = Tcl_FindHashEntry(&optTable->options, switchName);
+ if (entry) {
+ opt = (ItkClassOption*)Tcl_GetHashValue(entry);
+ }
+ }
+ Tcl_DStringFree(&buffer);
+ return opt;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_DelClassOption()
+ *
+ * Destroys a configuration option previously created by
+ * Itk_CreateClassOption().
+ * ------------------------------------------------------------------------
+ */
+void
+Itk_DelClassOption(opt)
+ ItkClassOption *opt; /* pointer to option data */
+{
+ Itcl_DeleteMember(opt->member);
+ ckfree(opt->resName);
+ ckfree(opt->resClass);
+ ckfree(opt->init);
+
+ ckfree((char*)opt);
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * ItkGetClassesWithOptInfo()
+ *
+ * Returns a pointer to a hash table containing the list of registered
+ * classes in the specified interpreter. If the hash table does not
+ * already exist, it is created.
+ * ------------------------------------------------------------------------
+ */
+static Tcl_HashTable*
+ItkGetClassesWithOptInfo(interp)
+ Tcl_Interp *interp; /* interpreter handling this registration */
+{
+ Tcl_HashTable* classesTable;
+
+ /*
+ * If the registration table does not yet exist, then create it.
+ */
+ classesTable = (Tcl_HashTable*)Tcl_GetAssocData(interp,
+ "itk_classesWithOptInfo", (Tcl_InterpDeleteProc**)NULL);
+
+ if (!classesTable) {
+ classesTable = (Tcl_HashTable*)ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(classesTable, TCL_ONE_WORD_KEYS);
+ Tcl_SetAssocData(interp, "itk_classesWithOptInfo",
+ ItkFreeClassesWithOptInfo, (ClientData)classesTable);
+ }
+ return classesTable;
+}
+
+/*
+ * ------------------------------------------------------------------------
+ * ItkFreeClassesWithOptInfo()
+ *
+ * When an interpreter is deleted, this procedure is called to
+ * free up the associated data created by ItkGetClassesWithOptInfo.
+ * ------------------------------------------------------------------------
+ */
+static void
+ItkFreeClassesWithOptInfo(clientData, interp)
+ ClientData clientData; /* associated data */
+ Tcl_Interp *interp; /* interpreter being freed */
+{
+ Tcl_HashTable *tablePtr = (Tcl_HashTable*)clientData;
+ Tcl_HashSearch place, place2;
+ Tcl_HashEntry *entry, *entry2;
+ ItkClassOptTable *optTable;
+ ItkClassOption *opt;
+
+ entry = Tcl_FirstHashEntry(tablePtr, &place);
+ while (entry) {
+ optTable = (ItkClassOptTable*)Tcl_GetHashValue(entry);
+
+ entry2 = Tcl_FirstHashEntry(&optTable->options, &place2);
+ while (entry2) {
+ opt = (ItkClassOption*)Tcl_GetHashValue(entry2);
+ Itk_DelClassOption(opt);
+ entry2 = Tcl_NextHashEntry(&place2);
+ }
+ Tcl_DeleteHashTable(&optTable->options);
+ Itk_OptListFree(&optTable->order);
+ ckfree((char*)optTable);
+
+ entry = Tcl_NextHashEntry(&place);
+ }
+
+ Tcl_DeleteHashTable(tablePtr);
+ ckfree((char*)tablePtr);
+}
diff --git a/itcl/itk/generic/itk_util.c b/itcl/itk/generic/itk_util.c
new file mode 100644
index 00000000000..102002d0b80
--- /dev/null
+++ b/itcl/itk/generic/itk_util.c
@@ -0,0 +1,200 @@
+/*
+ * ------------------------------------------------------------------------
+ * PACKAGE: [incr Tk]
+ * DESCRIPTION: Building mega-widgets with [incr Tcl]
+ *
+ * [incr Tk] provides a framework for building composite "mega-widgets"
+ * using [incr Tcl] classes. It defines a set of base classes that are
+ * specialized to create all other widgets.
+ *
+ * This part defines some utility procedures that are useful for
+ * [incr Tk].
+ *
+ * ========================================================================
+ * AUTHOR: Michael J. McLennan
+ * Bell Labs Innovations for Lucent Technologies
+ * mmclennan@lucent.com
+ * http://www.tcltk.com/itcl
+ *
+ * RCS: $Id$
+ * ========================================================================
+ * Copyright (c) 1993-1998 Lucent Technologies, Inc.
+ * ------------------------------------------------------------------------
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+#include "itk.h"
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_OptListInit()
+ *
+ * Initializes an ordered option list, allocating a certain amount of
+ * memory for an initial option list.
+ * ------------------------------------------------------------------------
+ */
+void
+Itk_OptListInit(olist, options)
+ ItkOptList *olist; /* list to be initialized */
+ Tcl_HashTable *options; /* table containing the real option entries */
+{
+ olist->options = options;
+ olist->len = 0;
+ olist->max = 10;
+ olist->list = (Tcl_HashEntry**)ckalloc(
+ (unsigned)(olist->max*sizeof(Tcl_HashEntry*))
+ );
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_OptListFree()
+ *
+ * Frees an ordered option list created by Itk_OptListInit().
+ * This only frees the memory associated with the list, not the
+ * list itself.
+ * ------------------------------------------------------------------------
+ */
+void
+Itk_OptListFree(olist)
+ ItkOptList *olist; /* list to be freed */
+{
+ ckfree((char*)olist->list);
+ olist->len = olist->max = 0;
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_OptListAdd()
+ *
+ * Adds the hash table entry for an option like '-background' to an
+ * ordered list of options. The list is kept in alphabetical order,
+ * so that it can be searched quickly and printed out in order.
+ * ------------------------------------------------------------------------
+ */
+void
+Itk_OptListAdd(olist, entry)
+ ItkOptList *olist; /* ordered list */
+ Tcl_HashEntry *entry; /* entry to be added to the list */
+{
+ int i, first, last, cmp, pos, size;
+ Tcl_HashEntry** newOrder;
+ char *swname, *optname;
+
+ /*
+ * Make sure that the option list is big enough. Resize
+ * if needed.
+ */
+ if (olist->len >= olist->max) {
+ size = olist->max*sizeof(Tcl_HashEntry*);
+ newOrder = (Tcl_HashEntry**)ckalloc((unsigned)2*size);
+ memcpy((VOID*)newOrder, (VOID*)olist->list, (size_t)size);
+ ckfree((char*)olist->list);
+
+ olist->list = newOrder;
+ olist->max *= 2;
+ }
+
+ /*
+ * Perform a binary search to find the option switch quickly.
+ */
+ first = 0;
+ last = olist->len-1;
+ swname = Tcl_GetHashKey(olist->options, entry) + 1;
+
+ while (last >= first) {
+ pos = (first+last)/2;
+ optname = Tcl_GetHashKey(olist->options, olist->list[pos]) + 1;
+ if (*swname == *optname) {
+ cmp = strcmp(swname, optname);
+ if (cmp == 0) {
+ break; /* found it! */
+ }
+ }
+ else if (*swname < *optname) {
+ cmp = -1;
+ }
+ else {
+ cmp = 1;
+ }
+
+ if (cmp > 0)
+ first = pos+1;
+ else
+ last = pos-1;
+ }
+
+ /*
+ * If a matching entry was not found, then insert one.
+ */
+ if (last < first) {
+ pos = first;
+
+ for (i=olist->len; i > pos; i--) {
+ olist->list[i] = olist->list[i-1];
+ }
+ olist->list[pos] = entry;
+ olist->len++;
+ }
+}
+
+
+/*
+ * ------------------------------------------------------------------------
+ * Itk_OptListRemove()
+ *
+ * Removes a hash table entry from an ordered list of options.
+ * This negates the action of Itk_OptionListAdd(), and is usually
+ * called when an option is completely removed from a mega-widget.
+ * This should be called before the entry is removed from the
+ * real option table.
+ * ------------------------------------------------------------------------
+ */
+void
+Itk_OptListRemove(olist, entry)
+ ItkOptList *olist; /* ordered list */
+ Tcl_HashEntry *entry; /* entry to be removed from the list */
+{
+ int pos = 0;
+ int i, first, last, cmp;
+ char *swname, *optname;
+
+ first = 0;
+ last = olist->len-1;
+ swname = Tcl_GetHashKey(olist->options, entry) + 1;
+
+ while (last >= first) {
+ pos = (first+last)/2;
+ optname = Tcl_GetHashKey(olist->options, olist->list[pos]) + 1;
+ if (*swname == *optname) {
+ cmp = strcmp(swname, optname);
+ if (cmp == 0) {
+ break; /* found it! */
+ }
+ }
+ else if (*swname < *optname) {
+ cmp = -1;
+ }
+ else {
+ cmp = 1;
+ }
+
+ if (cmp > 0)
+ first = pos+1;
+ else
+ last = pos-1;
+ }
+
+ /*
+ * If a matching entry was found, then remove it.
+ */
+ if (last >= first) {
+ olist->len--;
+ for (i=pos; i < olist->len; i++) {
+ olist->list[i] = olist->list[i+1];
+ }
+ }
+}
diff --git a/itcl/itk/itkConfig.sh.in b/itcl/itk/itkConfig.sh.in
new file mode 100644
index 00000000000..daad0d2e3fa
--- /dev/null
+++ b/itcl/itk/itkConfig.sh.in
@@ -0,0 +1,39 @@
+# itkConfig.sh --
+#
+# This shell script (for sh) is generated automatically by Itk'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 Itk 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, tkConfig.sh or itclConfig.sh,
+# so you may need to use those files in addition to this one.
+#
+# The information in this file is specific to a single platform.
+
+# Itcl's version number.
+ITCL_VERSION='@ITCL_VERSION@'
+ITCL_MAJOR_VERSION='@ITCL_MAJOR_VERSION@'
+ITCL_MINOR_VERSION='@ITCL_MINOR_VERSION@'
+
+# The name of the Itk library (may be either a .a file or a shared library):
+ITK_LIB_FILE=@ITK_LIB_FILE@
+
+# String to pass to linker to pick up the Itk library from its
+# build directory.
+ITK_BUILD_LIB_SPEC='@ITK_BUILD_LIB_SPEC@'
+
+# String to pass to linker to pick up the Itk library from its
+# installed directory.
+ITK_LIB_SPEC='@ITK_LIB_SPEC@'
+
+# Location of the top-level source directories from which [incr Tk]
+# was built. This is the directory that contains a README file as well
+# as subdirectories such as generic, unix, etc. If [incr Tk] was
+# compiled in a different place than the directory containing the source
+# files, this points to the location of the sources, not the location
+# where [incr Tk] was compiled.
+ITK_SRC_DIR='@ITK_SRC_DIR@'
+
+# Path to the library name. Used for dependencies.
+ITK_LIB_FULL_PATH='@ITK_LIB_FULL_PATH@'
diff --git a/itcl/itk/library/Archetype.itk b/itcl/itk/library/Archetype.itk
new file mode 100644
index 00000000000..411a4b65efe
--- /dev/null
+++ b/itcl/itk/library/Archetype.itk
@@ -0,0 +1,100 @@
+#
+# itk::Archetype
+# ----------------------------------------------------------------------
+# Base class for all widgets in the [incr Tk] Toolkit. Provides
+# facilities to merge widget options into a composite list of options
+# for the overall widget. Derived classes add widgets and methods to
+# specialize behavior.
+#
+# METHODS:
+# configure
+# configure -option
+# configure -option value ?-option value?...
+# Used to set/query configuration options
+#
+# component
+# component <name> <command> ?<arg> <arg>...?
+# Invokes the given <command> as a method on the component
+# called <name>.
+#
+# itk_component add <name> <create-cmd> <option-cmds>
+# Creates a component widget and merges its options into
+# the composite option list for the overall widget
+#
+# itk_component delete <name> ?<name>...?
+# Destroys a component widget and removes its options from
+# the composite option list
+#
+# itk_option add <name> ?<name>...?
+# Adds the option <name> belonging to a class or component
+# widget into the option list. Options can be added even
+# if they were not originally kept when the component was
+# created.
+#
+# itk_option remove <name> ?<name>...?
+# Removes the option <name> belonging to a class or component
+# widget from the option list. This allows a derived class
+# to turn off or redefine undesirable options inherited from
+# a base class.
+#
+# WIDGET ATTRIBUTES:
+# none
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+itcl::class itk::Archetype {
+
+ constructor {args} {
+ _initOptionInfo
+ eval itk_initialize $args
+ }
+
+ destructor {
+ _deleteOptionInfo
+ }
+
+ method cget {option} @Archetype-cget
+ method configure {{option ""} args} \
+ @Archetype-configure
+ method config {{option ""} args} {
+ eval configure $option $args
+ }
+
+ method component {{name ""} args} \
+ @Archetype-component
+
+ protected method itk_component {option args} \
+ @Archetype-itk_component
+
+ protected method itk_option {option args} \
+ @Archetype-itk_option
+
+ protected method itk_initialize {args} \
+ @Archetype-itk_initialize
+
+ protected variable itk_option
+ protected variable itk_component
+ protected variable itk_interior ""
+
+ # ------------------------------------------------------------------
+ # Options common to all widgets
+ # ------------------------------------------------------------------
+ itk_option define -clientdata clientData ClientData ""
+
+ # ------------------------------------------------------------------
+ # Private methods needed for option management
+ # ------------------------------------------------------------------
+ private method _initOptionInfo {} @Archetype-init
+ private method _deleteOptionInfo {} @Archetype-delete
+}
diff --git a/itcl/itk/library/Toplevel.itk b/itcl/itk/library/Toplevel.itk
new file mode 100644
index 00000000000..cb01a6db79d
--- /dev/null
+++ b/itcl/itk/library/Toplevel.itk
@@ -0,0 +1,73 @@
+#
+# itk::Toplevel
+# ----------------------------------------------------------------------
+# Base class for toplevel windows in the [incr Tk] Toolkit. Creates
+# a new toplevel window to contain the widget. Derived classes add
+# widgets and methods to specialize behavior.
+#
+# WIDGET ATTRIBUTES:
+# switch: -background .... normal background color for widget
+# name: background
+# class: Background
+#
+# switch: -cursor ........ cursor for widget
+# name: cursor
+# class: Cursor
+#
+# switch: -title ......... title given to window manager
+# name: title
+# class: Title
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+itcl::class itk::Toplevel {
+ inherit itk::Archetype
+
+ constructor {args} {
+ #
+ # Create a toplevel window with the same name as this object
+ #
+ set itk_hull [namespace tail $this]
+ set itk_interior $itk_hull
+
+ itk_component add hull {
+ toplevel $itk_hull -class [namespace tail [info class]]
+ } {
+ keep -background -cursor -takefocus
+ }
+ bind itk-delete-$itk_hull <Destroy> "itcl::delete object $this"
+
+ set tags [bindtags $itk_hull]
+ bindtags $itk_hull [linsert $tags 0 itk-delete-$itk_hull]
+
+ eval itk_initialize $args
+ }
+
+ destructor {
+ if {[winfo exists $itk_hull]} {
+ set tags [bindtags $itk_hull]
+ set i [lsearch $tags itk-delete-$itk_hull]
+ if {$i >= 0} {
+ bindtags $itk_hull [lreplace $tags $i $i]
+ }
+ destroy $itk_hull
+ }
+ }
+
+ itk_option define -title title Title "" {
+ wm title $itk_hull $itk_option(-title)
+ }
+
+ private variable itk_hull ""
+}
diff --git a/itcl/itk/library/Widget.itk b/itcl/itk/library/Widget.itk
new file mode 100644
index 00000000000..8c455e3211e
--- /dev/null
+++ b/itcl/itk/library/Widget.itk
@@ -0,0 +1,70 @@
+#
+# itk::Widget
+# ----------------------------------------------------------------------
+# Base class for ordinary widgets in the [incr Tk] Toolkit. Creates
+# a frame to contain the widget. Derived classes add widgets and
+# methods to specialize behavior.
+#
+# METHODS:
+#
+# WIDGET ATTRIBUTES:
+# switch: -background .... normal background color for widget
+# name: background
+# class: Background
+#
+# switch: -cursor ........ cursor used when pointer is inside
+# name: cursur widget
+# class: Cursur
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+itcl::class itk::Widget {
+ inherit itk::Archetype
+
+ # ------------------------------------------------------------------
+ # CONSTRUCTOR
+ # ------------------------------------------------------------------
+ constructor {args} {
+ #
+ # Create a window with the same name as this object
+ #
+ set itk_hull [namespace tail $this]
+ set itk_interior $itk_hull
+
+ itk_component add hull {
+ frame $itk_hull -class [namespace tail [info class]]
+ } {
+ keep -background -cursor
+ }
+ bind itk-delete-$itk_hull <Destroy> "itcl::delete object $this"
+
+ set tags [bindtags $itk_hull]
+ bindtags $itk_hull [linsert $tags 0 itk-delete-$itk_hull]
+
+ eval itk_initialize $args
+ }
+
+ destructor {
+ if {[winfo exists $itk_hull]} {
+ set tags [bindtags $itk_hull]
+ set i [lsearch $tags itk-delete-$itk_hull]
+ if {$i >= 0} {
+ bindtags $itk_hull [lreplace $tags $i $i]
+ }
+ destroy $itk_hull
+ }
+ }
+
+ private variable itk_hull ""
+}
diff --git a/itcl/itk/library/itk.tcl b/itcl/itk/library/itk.tcl
new file mode 100644
index 00000000000..54ef1ec507b
--- /dev/null
+++ b/itcl/itk/library/itk.tcl
@@ -0,0 +1,133 @@
+#
+# itk.tcl
+# ----------------------------------------------------------------------
+# Invoked automatically upon startup to customize the interpreter
+# for [incr Tk].
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+#
+# Provide transparent access to all [incr Tk] commands
+#
+if {$tcl_platform(os) == "MacOS"} {
+ source -rsrc itk:tclIndex
+} else {
+ lappend auto_path ${itk::library}
+}
+
+#
+# Define "usual" option-handling code for the Tk widgets:
+#
+itk::usual Button {
+ keep -background -cursor -foreground -font
+ keep -activebackground -activeforeground -disabledforeground
+ keep -highlightcolor -highlightthickness
+ rename -highlightbackground -background background Background
+}
+
+itk::usual Canvas {
+ keep -background -cursor
+ keep -insertbackground -insertborderwidth -insertwidth
+ keep -insertontime -insertofftime
+ keep -selectbackground -selectborderwidth -selectforeground
+ keep -highlightcolor -highlightthickness
+ rename -highlightbackground -background background Background
+}
+
+itk::usual Checkbutton {
+ keep -background -cursor -foreground -font
+ keep -activebackground -activeforeground -disabledforeground
+ keep -selectcolor
+ keep -highlightcolor -highlightthickness
+ rename -highlightbackground -background background Background
+}
+
+itk::usual Entry {
+ keep -background -cursor -foreground -font
+ keep -insertbackground -insertborderwidth -insertwidth
+ keep -insertontime -insertofftime
+ keep -selectbackground -selectborderwidth -selectforeground
+ keep -highlightcolor -highlightthickness
+ rename -highlightbackground -background background Background
+}
+
+itk::usual Frame {
+ keep -background -cursor
+}
+
+itk::usual Label {
+ keep -background -cursor -foreground -font
+ keep -highlightcolor -highlightthickness
+ rename -highlightbackground -background background Background
+}
+
+itk::usual Listbox {
+ keep -background -cursor -foreground -font
+ keep -selectbackground -selectborderwidth -selectforeground
+ keep -highlightcolor -highlightthickness
+ rename -highlightbackground -background background Background
+}
+
+itk::usual Menu {
+ keep -background -cursor -foreground -font
+ keep -activebackground -activeforeground -disabledforeground
+ keep -selectcolor -tearoff
+}
+
+itk::usual Menubutton {
+ keep -background -cursor -foreground -font
+ keep -activebackground -activeforeground -disabledforeground
+ keep -highlightcolor -highlightthickness
+ rename -highlightbackground -background background Background
+}
+
+itk::usual Message {
+ keep -background -cursor -foreground -font
+ keep -highlightcolor -highlightthickness
+ rename -highlightbackground -background background Background
+}
+
+itk::usual Radiobutton {
+ keep -background -cursor -foreground -font
+ keep -activebackground -activeforeground -disabledforeground
+ keep -selectcolor
+ keep -highlightcolor -highlightthickness
+ rename -highlightbackground -background background Background
+}
+
+itk::usual Scale {
+ keep -background -cursor -foreground -font -troughcolor
+ keep -activebackground
+ keep -highlightcolor -highlightthickness
+ rename -highlightbackground -background background Background
+}
+
+itk::usual Scrollbar {
+ keep -background -cursor -troughcolor
+ keep -activebackground -activerelief
+ keep -highlightcolor -highlightthickness
+ rename -highlightbackground -background background Background
+}
+
+itk::usual Text {
+ keep -background -cursor -foreground -font
+ keep -insertbackground -insertborderwidth -insertwidth
+ keep -insertontime -insertofftime
+ keep -selectbackground -selectborderwidth -selectforeground
+ keep -highlightcolor -highlightthickness
+ rename -highlightbackground -background background Background
+}
+
+itk::usual Toplevel {
+ keep -background -cursor
+}
diff --git a/itcl/itk/library/tclIndex b/itcl/itk/library/tclIndex
new file mode 100644
index 00000000000..af4ea1f4f07
--- /dev/null
+++ b/itcl/itk/library/tclIndex
@@ -0,0 +1,11 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(::itk::Archetype) [list source [file join $dir Archetype.itk]]
+set auto_index(::itk::Toplevel) [list source [file join $dir Toplevel.itk]]
+set auto_index(::itk::Widget) [list source [file join $dir Widget.itk]]
diff --git a/itcl/itk/license.terms b/itcl/itk/license.terms
new file mode 100644
index 00000000000..b76171b0a91
--- /dev/null
+++ b/itcl/itk/license.terms
@@ -0,0 +1,38 @@
+This software is copyrighted by Lucent Technologies, Inc., and other
+parties. The following terms apply to all files associated with the
+software unless explicitly disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
diff --git a/itcl/itk/mac/MW_ItkHeader.pch b/itcl/itk/mac/MW_ItkHeader.pch
new file mode 100644
index 00000000000..40663118c1b
--- /dev/null
+++ b/itcl/itk/mac/MW_ItkHeader.pch
@@ -0,0 +1,73 @@
+/*
+ * MW_ItkHeader.pch --
+ *
+ * This file is the source for a pre-compilied header that gets used
+ * for all files in the Tk projects. This make compilies go a bit
+ * faster. This file is only intended to be used in the MetroWerks
+ * CodeWarrior environment. It essentially acts as a place to set
+ * compiler flags. See MetroWerks documention for more details.
+ *
+ * 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: @(#) MW_TkHeader.pch 1.16 96/09/04 17:01:00
+ */
+
+/*
+ * Support for automatically naming the precompiled header file ...
+ */
+#if __POWERPC__
+#pragma precompile_target "MW_ItkHeaderPPC"
+#include "MW_TkHeaderPPC"
+#elif __CFM68K__
+#pragma precompile_target "MW_ItkHeaderCFM68K"
+#include "MW_TkHeaderCFM68K"
+#else
+#pragma precompile_target "MW_ItkHeader68K"
+#include "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
+
+#include <tcl.h>
+#include <tk.h>
+#include <itcl.h>
+
+/*
+ * Place any includes below that will are needed by the majority of the
+ * and is OK to be in any file in the system. The pragma's are used
+ * to control what functions are exported in the Tcl shared library.
+ */
+
+#pragma export on
+#include "itk.h"
+#pragma export reset
diff --git a/itcl/itk/mac/itkMacApplication.r b/itcl/itk/mac/itkMacApplication.r
new file mode 100644
index 00000000000..989ea0735a3
--- /dev/null
+++ b/itcl/itk/mac/itkMacApplication.r
@@ -0,0 +1,1676 @@
+/*
+ * 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.2 96/10/03 17:53:57
+ */
+
+#include <Types.r>
+#include <SysTypes.r>
+#include <AEUserTermTypes.r>
+
+/*
+ * The folowing include and defines help construct
+ * the version string for Tcl.
+ */
+
+#define RESOURCE_INCLUDED
+#include "tk.h"
+#include "itcl.h"
+#include "itkPatch.h"
+
+#if (TK_RELEASE_LEVEL == 0)
+# define RELEASE_LEVEL alpha
+#elif (TK_RELEASE_LEVEL == 1)
+# define RELEASE_LEVEL beta
+#elif (TK_RELEASE_LEVEL == 2)
+# define RELEASE_LEVEL final
+#endif
+
+#if (TK_RELEASE_LEVEL == 2)
+# define MINOR_VERSION (ITCL_MINOR_VERSION * 16) + TK_RELEASE_SERIAL
+#else
+# define MINOR_VERSION ITCL_MINOR_VERSION * 16
+#endif
+
+#define RELEASE_CODE 0x00
+
+#define ITCL_LIBRARY_RESOURCES 3000
+#define ITK_LIBRARY_RESOURCES 3500
+
+resource 'vers' (1) {
+ ITCL_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ ITK_PATCH_LEVEL,
+ ITK_PATCH_LEVEL ", by Michael McLennan © 1993-1998" "\n" "Lucent Technologies, Inc."
+};
+
+resource 'vers' (2) {
+ ITCL_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ ITK_PATCH_LEVEL,
+ "ItkWish " ITK_PATCH_LEVEL " © 1993-1998"
+};
+
+
+#define ITK_APP_RESOURCES 128
+#define ITK_APP_CREATOR 'ITkW'
+
+/*
+ * The 'BNDL' resource is the primary link between a file's
+ * creator/type and its icon. This resource acts for all Tcl shared
+ * libraries; other libraries will not need one and ought to use
+ * custom icons rather than new file types for a different appearance.
+ */
+
+resource 'BNDL' (ITK_APP_RESOURCES, "Itk app bundle", purgeable)
+{
+ ITK_APP_CREATOR,
+ 0,
+ {
+ 'FREF',
+ {
+ 0, ITK_APP_RESOURCES,
+ 1, ITK_APP_RESOURCES+1
+ },
+ 'ICN#',
+ {
+ 0, ITK_APP_RESOURCES,
+ 1, ITK_APP_RESOURCES+1
+ }
+ }
+};
+
+resource 'FREF' (ITK_APP_RESOURCES, purgeable)
+{
+ 'APPL', 0, ""
+};
+resource 'FREF' (ITK_APP_RESOURCES+1, purgeable)
+{
+ 'TEXT', 1, ""
+};
+
+type ITK_APP_CREATOR as 'STR ';
+resource ITK_APP_CREATOR (0, purgeable) {
+ "ItkWish " ITK_PATCH_LEVEL " © 1993-1998"
+};
+
+/*
+ * The 'kind' resource works with a 'BNDL' in Macintosh Easy Open
+ * to affect the text the Finder displays in the "kind" column and
+ * file info dialog. This information will be applied to all files
+ * with the listed creator and type.
+ */
+resource 'kind' (ITK_APP_RESOURCES, "Itcl kind", purgeable) {
+ ITK_APP_CREATOR,
+ 0, /* region = USA */
+ {
+ 'APPL', "ItkWish",
+ 'TEXT', "Itcl/Itk Script"
+ }
+};
+
+/* This resource will be picked up by tkMacMenus.c, and used for the
+ * "About" entry in the Apple Menu
+ */
+
+resource 'STR ' (2000,"AppleMenuAboutSTR") {
+ "About ItkwishÉ"
+};
+
+
+/*
+ * The following resource define the icon used by Tcl scripts. Any
+ * TEXT file with the creator of WIsH will get this icon.
+ */
+
+data 'icl4' (ITK_APP_RESOURCES, "Itk Doc", purgeable) {
+ $"0000 0000 CEFE EFDA DAFA AAC0 0000 0000" /* ....ÎþïÚÚúªÀ.... */
+ $"0000 000E F010 DFFE 0DAF ECEF C000 0000" /* ....ð.ßþ¯ìïÀ... */
+ $"0000 00AC 0001 00EF F00D FED0 FE00 0000" /* ...¬...ïðÂþÐþ... */
+ $"0000 CA10 0000 100D FA00 DFAD 0EA0 0000" /* ..Ê....Âú.ß­. .. */
+ $"000C F000 0000 0000 AFC0 0DFE 00EA 0000" /* ..ð.....¯ÀÂþ.ê.. */
+ $"000F D000 F000 0100 EFC0 0EFD 000A E000" /* ..Ð.ð...ïÀ.ý..à. */
+ $"00FD 0000 F000 0000 DE00 0EAD 0000 FD00" /* .ý..ð...Þ..­..ý. */
+ $"0FED C000 F000 0000 0000 0000 0000 0FD0" /* .íÀ.ð..........Ð */
+ $"00AD C000 F000 0000 0000 0000 000C FAA0" /* .­À.ð.........ú  */
+ $"000D C000 F000 0000 0000 0000 00CD A000" /* .ÂÀ.ð........Í . */
+ $"000D DCC0 F000 0000 0000 0000 00CF 0000" /* .ÂÜÀð........Ï.. */
+ $"000D DCCC FC00 0000 0000 0000 0CA0 0000" /* .ÂÜÌü........ .. */
+ $"0000 ACCD FC00 000C 00CC 0C0C CDD0 0000" /* ..¬Íü....Ì..ÍÐ.. */
+ $"0000 DCCC FCC0 000C C0CC 0C0C CA00 0000" /* ..ÜÌüÀ..ÀÌ..Ê... */
+ $"0000 DDDD FCCC 00CC CCCC 0CCC A000 0000" /* ..ÝÝüÌ.ÌÌÌ.Ì ... */
+ $"0000 0DDD FCCC 0CCC CCCC CCCD E000 0000" /* ..ÂÝüÌ.ÌÌÌÌÍà... */
+ $"0000 0ADD FADC CCCC CCCC CCCD 0000 0000" /* ...ÝúÜÌÌÌÌÌÍ.... */
+ $"000F FFFF FFFA CDDC CDCC CDDF 0000 0000" /* ..ÿÿÿúÍÜÍÌÍß.... */
+ $"000F FFFF FFED DCDD DDDC DDDE 0000 0000" /* ..ÿÿÿíÜÝÝÜÝÞ.... */
+ $"0000 00ED FDDD CD5D DDDD DDF0 0000 0000" /* ...íýÝÍ]ÝÝÝð.... */
+ $"0000 00ED DDDD DDDD DDDD DDA0 0000 0000" /* ...íÝÝÝÝÝÝÝ .... */
+ $"0000 00DE DDDD DD5D DEED DA00 0000 0000" /* ...ÞÝÝÝ]ÞíÚ..... */
+ $"00FF FFFF FFFF 5DDD EDE5 DE00 0000 0000" /* .ÿÿÿÿÿ]ÝíåÞ..... */
+ $"00DF FFFF FFFF F5DD D5ED 5FFF D000 0000" /* .ßÿÿÿÿõÝÕí_ÿÐ... */
+ $"0000 EFFF FFFF AE5D DD55 DFFF D000 0000" /* ..ïÿÿÿ®]ÝUßÿÐ... */
+ $"0000 00FF FFFF FFEE DED5 FFD0 0000 0000" /* ...ÿÿÿÿîÞÕÿÐ.... */
+ $"0000 00FF FFFF FFFF FAAF FD00 0000 0000" /* ...ÿÿÿÿÿú¯ý..... */
+ $"0000 00FF FFFF FFFF FFFF A000 0000 0000" /* ...ÿÿÿÿÿÿÿ ..... */
+ $"0000 00DF FFFF FFFF FFFF E000 0000 0000" /* ...ßÿÿÿÿÿÿà..... */
+ $"0000 0000 0DAF FFFF FFFF E000 0000 0000" /* ....¯ÿÿÿÿà..... */
+ $"0000 0000 000C DEAF FFFF A000 0000 0000" /* ......Þ¯ÿÿ ..... */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+};
+
+data 'icl8' (ITK_APP_RESOURCES + 1, "Itk Doc", purgeable) {
+ $"0000 00FF FFFF FFFF FFFF FFFF FFFF FFFF" /* ...ÿÿÿÿÿÿÿÿÿÿÿÿÿ */
+ $"FFFF FFFF FFFF 0000 0000 0000 0000 0000" /* ÿÿÿÿÿÿ.......... */
+ $"0000 00FF 0000 0000 0000 0000 0000 0000" /* ...ÿ............ */
+ $"0000 0000 00FF FF00 0000 0000 0000 0000" /* .....ÿÿ......... */
+ $"0000 00FF 00F6 F6F6 F6F6 F6F6 F6F6 F6F6" /* ...ÿ.ööööööööööö */
+ $"F6F6 F6F6 F6FF 00FF 0000 0000 0000 0000" /* öööööÿ.ÿ........ */
+ $"0000 00FF 00F6 F6F6 F6F6 F6F6 F6F6 F6F6" /* ...ÿ.ööööööööööö */
+ $"F6F6 F6F6 F6FF 00F6 FF00 0000 0000 0000" /* öööööÿ.öÿ....... */
+ $"0000 00FF 00F6 F6F6 F6F6 F6F6 F6F6 F6F6" /* ...ÿ.ööööööööööö */
+ $"F6F6 F6F6 F6FF 00F6 F6FF 0000 0000 0000" /* öööööÿ.ööÿ...... */
+ $"0000 00FF 00F6 F6F6 F6F6 F6F6 F6F6 F6F6" /* ...ÿ.ööööööööööö */
+ $"F6F6 F6F6 F6FF F8F8 F8F8 FF00 0000 0000" /* öööööÿøøøøÿ..... */
+ $"0000 00FF 00F6 F6F6 F6F6 F6F6 F6F6 F6F6" /* ...ÿ.ööööööööööö */
+ $"F6F6 F6F6 F6FF FFFF FFFF FFFF 0000 0000" /* öööööÿÿÿÿÿÿÿ.... */
+ $"0000 00FF 00F6 F6F6 F6F6 F6F6 F6F6 F6F6" /* ...ÿ.ööööööööööö */
+ $"F6F6 F6F6 F6F6 F6F6 F6F6 F8FF 0000 0000" /* ööööööööööøÿ.... */
+ $"0000 00FF 00F6 F6F6 F65F B3B3 B35F F6F6" /* ...ÿ.öööö_³³³_öö */
+ $"5FB3 B3B3 B35F F6F6 F6F6 F8FF 0000 0000" /* _³³³³_ööööøÿ.... */
+ $"0000 00FF 00F6 F6F6 5F89 8989 8989 89B3" /* ...ÿ.ööö_‰‰‰‰‰‰³ */
+ $"8989 8989 8989 B35F F6F6 F8FF 0000 0000" /* ‰‰‰‰‰‰³_ööøÿ.... */
+ $"0000 00FF 00F6 F65F 3489 B3B3 B389 B389" /* ...ÿ.öö_4‰³³³‰³‰ */
+ $"89B3 B3B3 895F 89B3 5FF6 F8FF 0000 0000" /* ‰³³³‰_‰³_öøÿ.... */
+ $"0000 00FF 00F6 F634 8900 0000 0034 8989" /* ...ÿ.öö4‰....4‰‰ */
+ $"3400 0000 00B3 5F89 B334 F8FF 0000 0000" /* 4....³_‰³4øÿ.... */
+ $"0000 00FF 00F6 5F89 0000 0000 0000 3434" /* ...ÿ.ö_‰......44 */
+ $"0000 0000 0000 B389 895F F8FF 0000 0000" /* ......³‰‰_øÿ.... */
+ $"0000 00FF 00F6 8934 0000 0000 F500 0000" /* ...ÿ.ö‰4....õ... */
+ $"0000 0000 0000 34B3 89B3 F8FF 0000 0000" /* ......4³‰³øÿ.... */
+ $"0000 00FF 00F6 B300 0000 F501 0100 0000" /* ...ÿ.ö³...õ..... */
+ $"0000 0000 0000 00B3 89B3 F8FF 0000 0000" /* .......³‰³øÿ.... */
+ $"0000 00FF 00F6 8934 0000 00F7 0000 00F7" /* ...ÿ.ö‰4...÷...÷ */
+ $"0101 0100 0000 3489 89B3 F8FF 0000 0000" /* ......4‰‰³øÿ.... */
+ $"0000 00FF 00F6 F6B3 3400 0000 0000 0000" /* ...ÿ.öö³4....... */
+ $"F701 F500 0034 B389 B3F6 F8FF 0000 0000" /* ÷.õ..4³‰³öøÿ.... */
+ $"0000 00FF 00F6 F6F6 8934 0000 0000 0000" /* ...ÿ.ööö‰4...... */
+ $"0000 F700 3489 895F F6F6 F8FF 0000 0000" /* ..÷.4‰‰_ööøÿ.... */
+ $"0000 00FF 00F6 F6F6 B334 0000 0000 0000" /* ...ÿ.ööö³4...... */
+ $"0000 0000 34B3 89B3 F6F6 F8FF 0000 0000" /* ....4³‰³ööøÿ.... */
+ $"0000 00FF 00F6 F634 8900 0000 0001 0000" /* ...ÿ.öö4‰....... */
+ $"0000 0000 0089 3489 B3F6 F8FF 0000 0000" /* .....‰4‰³öøÿ.... */
+ $"0000 00FF 00F6 F689 0000 0000 F701 F500" /* ...ÿ.öö‰....÷.õ. */
+ $"0000 0000 0000 8989 B3F6 F8FF 0000 0000" /* ......‰‰³öøÿ.... */
+ $"0000 00FF 00F6 F6B3 0000 0000 00F7 0000" /* ...ÿ.öö³.....÷.. */
+ $"0000 0000 0000 B389 B3F6 F8FF 0000 0000" /* ......³‰³öøÿ.... */
+ $"0000 00FF 00F6 F689 0000 0000 0000 0000" /* ...ÿ.öö‰........ */
+ $"0001 0000 0000 8989 B3F6 F8FF 0000 0000" /* ......‰‰³öøÿ.... */
+ $"0000 00FF 00F6 F6B3 0000 0000 0101 0000" /* ...ÿ.öö³........ */
+ $"F701 0101 0000 B389 B3F6 F8FF 0000 0000" /* ÷.....³‰³öøÿ.... */
+ $"0000 00FF 00F6 F6B3 0000 0101 01F5 0000" /* ...ÿ.öö³.....õ.. */
+ $"00F7 01F5 0000 B389 B3F6 F8FF 0000 0000" /* .÷.õ..³‰³öøÿ.... */
+ $"0000 00FF 00F6 F689 0000 01F5 0100 0000" /* ...ÿ.öö‰...õ.... */
+ $"00F5 F5F5 0000 8989 B3F6 F8FF 0000 0000" /* .õõõ..‰‰³öøÿ.... */
+ $"0000 00FF 00F6 F6B3 0000 F7F7 0000 0000" /* ...ÿ.öö³..÷÷.... */
+ $"0000 0000 0000 B389 B3F6 F8FF 0000 0000" /* ......³‰³öøÿ.... */
+ $"0000 00FF 00F6 F634 8900 0000 0000 0000" /* ...ÿ.öö4‰....... */
+ $"0000 0000 0089 5FB3 34F6 F8FF 0000 0000" /* .....‰_³4öøÿ.... */
+ $"0000 00FF 00F6 F6F6 34B3 89B3 B3B3 B3B3" /* ...ÿ.ööö4³‰³³³³³ */
+ $"B389 B3B3 8934 34F6 F6F6 F8FF 0000 0000" /* ³‰³³‰44öööøÿ.... */
+ $"0000 00FF 00F6 F6F6 F6F6 F6F6 F6F6 F6F6" /* ...ÿ.ööööööööööö */
+ $"F6F6 F6F6 F6F6 F6F6 F6F6 F8FF 0000 0000" /* ööööööööööøÿ.... */
+ $"0000 00FF F8F8 F8F8 F8F8 F8F8 F8F8 F8F8" /* ...ÿøøøøøøøøøøøø */
+ $"F8F8 F8F8 F8F8 F8F8 F8F8 F8FF 0000 0000" /* øøøøøøøøøøøÿ.... */
+ $"0000 00FF FFFF FFFF FFFF FFFF FFFF FFFF" /* ...ÿÿÿÿÿÿÿÿÿÿÿÿÿ */
+ $"FFFF FFFF FFFF FFFF FFFF FFFF 0000 0000" /* ÿÿÿÿÿÿÿÿÿÿÿÿ.... */
+};
+
+data 'ICN#' (ITK_APP_RESOURCES + 1, "Itk Doc", purgeable) {
+ $"1FFF FC00 1000 0600 1000 0500 1000 0480" /* .ÿü............€ */
+ $"1000 0440 1000 0420 1000 07F0 1000 0010" /* ...@... ...ð.... */
+ $"107C FC10 10FF FF10 117F FF90 1083 0790" /* .|ü..ÿÿ...ÿ.ƒ. */
+ $"1300 03D0 1200 01D0 1200 01D0 1200 01D0" /* ...Ð...Ð...Ð...Ð */
+ $"1100 0390 1080 0710 1080 0710 1080 0590" /* ....€...€...€. */
+ $"1100 0390 1100 0390 1100 0390 1100 0390" /* ............ */
+ $"1100 0390 1100 0390 1100 0390 1080 0710" /* ..........€.. */
+ $"107F F810 1000 0010 1000 0010 1FFF FFF0" /* ..ø..........ÿÿð */
+ $"1FFF FC00 1FFF FE00 1FFF FF00 1FFF FF80" /* .ÿü..ÿþ..ÿÿ..ÿÿ€ */
+ $"1FFF FFC0 1FFF FFE0 1FFF FFF0 1FFF FFF0" /* .ÿÿÀ.ÿÿà.ÿÿð.ÿÿð */
+ $"1FFF FFF0 1FFF FFF0 1FFF FFF0 1FFF FFF0" /* .ÿÿð.ÿÿð.ÿÿð.ÿÿð */
+ $"1FFF FFF0 1FFF FFF0 1FFF FFF0 1FFF FFF0" /* .ÿÿð.ÿÿð.ÿÿð.ÿÿð */
+ $"1FFF FFF0 1FFF FFF0 1FFF FFF0 1FFF FFF0" /* .ÿÿð.ÿÿð.ÿÿð.ÿÿð */
+ $"1FFF FFF0 1FFF FFF0 1FFF FFF0 1FFF FFF0" /* .ÿÿð.ÿÿð.ÿÿð.ÿÿð */
+ $"1FFF FFF0 1FFF FFF0 1FFF FFF0 1FFF FFF0" /* .ÿÿð.ÿÿð.ÿÿð.ÿÿð */
+ $"1FFF FFF0 1FFF FFF0 1FFF FFF0 1FFF FFF0" /* .ÿÿð.ÿÿð.ÿÿð.ÿÿð */
+};
+
+data 'ics#' (ITK_APP_RESOURCES + 1, "Itk Doc", purgeable) {
+ $"7FF0 4038 402C 403C 46E4 4FF4 5014 5014" /* .ð@8@,@<FäOôP.P. */
+ $"4824 4834 5014 5014 5014 5FF4 4004 7FFC" /* H$H4P.P.P._ô@..ü */
+ $"7FF0 7FF8 7FFC 7FFC 7FFC 7FFC 7FFC 7FFC" /* .ð.ø.ü.ü.ü.ü.ü.ü */
+ $"7FFC 7FFC 7FFC 7FFC 7FFC 7FFC 7FFC 7FFC" /* .ü.ü.ü.ü.ü.ü.ü.ü */
+};
+
+data 'ics4' (ITK_APP_RESOURCES + 1, "Itk Doc", purgeable) {
+ $"0FFF FFFF FFFF 0000 0FCC CCCC CCFF F000" /* .ÿÿÿÿÿ...ÌÌÌÌÿð. */
+ $"0FCC CCCC CCFC FF00 0FCC CCCC CCFF FF00" /* .ÌÌÌÌüÿ..ÌÌÌÌÿÿ. */
+ $"0FCC CFFC FFAC CF00 0FCC AFFF FFFA CF00" /* .ÌÏüÿ¬Ï..̯ÿÿúÏ. */
+ $"0FCA 000B 000F CF00 0FCF 0C0C 000F CF00" /* .Ê....Ï..Ï....Ï. */
+ $"0FCC A000 CCAC CF00 0FCC F000 00FA CF00" /* .Ì .̬Ï..Ìð..úÏ. */
+ $"0FCF 00C0 000F CF00 0FCF 0000 C00F CF00" /* .Ï.À..Ï..Ï..À.Ï. */
+ $"0FCF 0000 C00F CF00 0FCF AAAA AAAF CF00" /* .Ï..À.Ï..Ϫªª¯Ï. */
+ $"0FCC CCCC CCCC CF00 0FFF FFFF FFFF FF00" /* .ÌÌÌÌÌÏ..ÿÿÿÿÿÿ. */
+};
+
+/*
+ * The following resources define the icons for the Wish
+ * application.
+ */
+
+data 'icl4' (ITK_APP_RESOURCES + 1, "Itk App", purgeable) {
+ $"000F FFFF FFFF FFFF FFFF FF00 0000 0000" /* ..ÿÿÿÿÿÿÿÿÿ..... */
+ $"000F 0000 0000 0000 0000 0FF0 0000 0000" /* ...........ð.... */
+ $"000F 0CCC CCCC CCCC CCCC CF0F 0000 0000" /* ...ÌÌÌÌÌÌÌÏ..... */
+ $"000F 0CCC CCCC CCCC CCCC CF0C F000 0000" /* ...ÌÌÌÌÌÌÌÏ.ð... */
+ $"000F 0CCC CCCC CCCC CCCC CF0C CF00 0000" /* ...ÌÌÌÌÌÌÌÏ.Ï... */
+ $"000F 0CCC CCCC CCCC CCCC CFCC CCF0 0000" /* ...ÌÌÌÌÌÌÌÏÌÌð.. */
+ $"000F 0CCC CCCC CCCC CCCC CFFF FFFF 0000" /* ...ÌÌÌÌÌÌÌÏÿÿÿ.. */
+ $"000F 0CCC CCCC CCCC CCCC CCCC CCCF 0000" /* ...ÌÌÌÌÌÌÌÌÌÌÏ.. */
+ $"000F 0CCC CBFF FBCC BFFF FBCC CCCF 0000" /* ...ÌËÿûÌ¿ÿûÌÌÏ.. */
+ $"000F 0CCC BAAA AAAF AAAA AAFB CCCF 0000" /* ...̺ªª¯ªªªûÌÏ.. */
+ $"000F 0CCB BAFF FAFA AFFF ABAF BCCF 0000" /* ...˺ÿúú¯ÿ«¯¼Ï.. */
+ $"000F 0CCB A000 0BAA B000 0FBA FBCF 0000" /* ...Ë ..ª°..ºûÏ.. */
+ $"000F 0CBA 0000 00BB 0000 00FA ABCF 0000" /* ...º...»...ú«Ï.. */
+ $"000F 0CAB 0000 0000 0000 00BF AFCF 0000" /* ...«.......¿¯Ï.. */
+ $"000F 0CF0 0000 0000 0000 000F AFCF 0000" /* ...ð........¯Ï.. */
+ $"000F 0CAB 000C 000C 0000 00BA AFCF 0000" /* ...«.......º¯Ï.. */
+ $"000F 0CCF B000 0000 C000 0BFA FCCF 0000" /* ...Ï°...À..úüÏ.. */
+ $"000F 0CCC AB00 0000 00C0 BAAB CCCF 0000" /* ...Ì«....Àº«ÌÏ.. */
+ $"000F 0CCC FB00 0000 0000 BFAF CCCF 0000" /* ...Ìû.....¿¯ÌÏ.. */
+ $"000F 0CCB A000 0000 0000 0ABA FCCF 0000" /* ...Ë ......ºüÏ.. */
+ $"000F 0CCA 0000 C000 0000 00AA FCCF 0000" /* ...Ê..À....ªüÏ.. */
+ $"000F 0CCF 0000 0C00 0000 00FA FCCF 0000" /* ...Ï.......úüÏ.. */
+ $"000F 0CCA 0000 0000 0000 00AA FCCF 0000" /* ...Ê.......ªüÏ.. */
+ $"000F 0CCF 0000 0000 C000 00FA FCCF 0000" /* ...Ï....À..úüÏ.. */
+ $"000F 0CCF 0000 0000 0C00 00FA FCCF 0000" /* ...Ï.......úüÏ.. */
+ $"000F 0CCA 0000 0000 0000 00AA FCCF 0000" /* ...Ê.......ªüÏ.. */
+ $"000F 0CCF 00CC 0000 0000 00FA FCCF 0000" /* ...Ï.Ì.....úüÏ.. */
+ $"000F 0CCB A000 0000 0000 0ABF BCCF 0000" /* ...Ë ......¿¼Ï.. */
+ $"000F 0CCC BFAF FFFF FAFF ABBC CCCF 0000" /* ...Ì¿¯ÿÿúÿ«¼ÌÏ.. */
+ $"000F 0CCC CCCC CCCC CCCC CCCC CCCF 0000" /* ...ÌÌÌÌÌÌÌÌÌÌÏ.. */
+ $"000F CCCC CCCC CCCC CCCC CCCC CCCF 0000" /* ..ÌÌÌÌÌÌÌÌÌÌÌÏ.. */
+ $"000F FFFF FFFF FFFF FFFF FFFF FFFF 0000" /* ..ÿÿÿÿÿÿÿÿÿÿÿÿ.. */
+};
+
+data 'ICN#' (ITK_APP_RESOURCES, "Itk App", purgeable) {
+ $"007F FE00 0187 3B80 0203 8CC0 0401 C660" /* ..þ..‡;€..ŒÀ..Æ` */
+ $"0800 C330 1080 C318 2080 4308 6080 0004" /* ..Ã0.€Ã. €C.`€.. */
+ $"2080 000E 1080 0018 1080 0010 0880 0020" /* €...€...€...€. */
+ $"0880 0060 0880 0040 0480 0080 0480 0180" /* .€.`.€.@.€.€.€.€ */
+ $"0480 0100 1FE0 0100 1FE0 0300 0280 0600" /* .€...à...à...€.. */
+ $"0280 0600 03FE 0400 3FFF 0400 3FFF 8F80" /* .€...þ..?ÿ..?ÿ€ */
+ $"0FFF FF00 03FF FE00 03FF FC00 03FF F800" /* .ÿÿ..ÿþ..ÿü..ÿø. */
+ $"01FF F800 003F F800 0007 F800 0000 0000" /* .ÿø..?ø...ø..... */
+ $"00FF FE00 01FF FF80 03FF FFC0 0FFF FFE0" /* .ÿþ..ÿÿ€.ÿÿÀ.ÿÿà */
+ $"1FFF FFF0 1FFF FFF8 3FFF FFFC 7FFF FFFE" /* .ÿÿð.ÿÿø?ÿÿü.ÿÿþ */
+ $"3FFF FFFE 1FFF FFF8 1FFF FFF0 1FFF FFE0" /* ?ÿÿþ.ÿÿø.ÿÿð.ÿÿà */
+ $"0FFF FFE0 0FFF FFC0 0FFF FF80 07FF FF80" /* .ÿÿà.ÿÿÀ.ÿÿ€.ÿÿ€ */
+ $"07FF FF00 1FFF FF00 1FFF FF00 03FF FE00" /* .ÿÿ..ÿÿ..ÿÿ..ÿþ. */
+ $"03FF FE00 03FF FC00 3FFF FC00 3FFF FF80" /* .ÿþ..ÿü.?ÿü.?ÿÿ€ */
+ $"1FFF FF80 07FF FE00 03FF FC00 03FF F800" /* .ÿÿ€.ÿþ..ÿü..ÿø. */
+ $"03FF F800 007F F800 001F F800 0000 0000" /* .ÿø...ø...ø..... */
+};
+
+
+data 'ics#' (ITK_APP_RESOURCES, "Itk App", purgeable) {
+ $"0FF0 1148 28A4 48A2 C803 4804 2804 2808" /* .ð.H(¤H¢È.H.(.(. */
+ $"7C08 1810 1C10 7E38 3FF0 1FE0 1FE0 03E0" /* |.....~8?ð.à.à.à */
+ $"1FF8 3FFC 7FFE FFFF 7FFF 7FFC 3FFC 3FF8" /* .ø?ü.þÿÿ.ÿ.ü?ü?ø */
+ $"7FF0 7FF0 1FF0 7FF8 7FF8 1FE0 1FE0 07E0" /* .ð.ð.ð.ø.ø.à.à.à */
+};
+
+data 'ics4' (ITK_APP_RESOURCES, "Itk App", purgeable) {
+ $"000E FFFF DFEF C000 00CC 011F FDFD FA00" /* ..ÿÿßïÀ..Ì..ýýú. */
+ $"0FF0 F010 FCEF 0EE0 FFC0 F000 E0ED 00FD" /* .ðð.üï.àÿÀð.àí.ý */
+ $"0DC0 F000 0000 0DFA 0DDC F000 0000 CF00" /* ÂÀð...ÂúÂÜð...Ï. */
+ $"00DD FC0C CCCC DD00 00DD FCCC CCCD E000" /* .Ýü.ÌÌÝ..ÝüÌÌÍà. */
+ $"0FFF FFDD DCDF 0000 0FFF FEDD DDDF 0000" /* .ÿÿÝÜß...ÿþÝÝß.. */
+ $"000E DDDD EEDA 0000 0FFF FFFD EEFF D000" /* ..ÝÝîÚ...ÿÿýîÿÐ. */
+ $"00FF FFFE EDFF D000 000F FFFF FFF0 0000" /* .ÿÿþíÿÐ...ÿÿÿð.. */
+ $"000F FFFF FFE0 0000 0000 0CEF FFA0 0000" /* ..ÿÿÿà.....ïÿ .. */
+};
+
+data 'icl8' (ITK_APP_RESOURCES, "Itk App", purgeable) {
+ $"0000 0000 0000 0000 F8FC FEFC FCFF 81FD" /* ........øüþüüÿý */
+ $"81FD FFFD FDFD F800 0000 0000 0000 0000" /* ýÿýýýø......... */
+ $"0000 0000 0000 00FC FE02 0402 56FF FFFB" /* .......üþ...Vÿÿû */
+ $"0281 FDFF FBF8 FBFF F800 0000 0000 0000" /* .ýÿûøûÿø....... */
+ $"0000 0000 0000 FD2B 0102 0204 0201 ACFF" /* ......ý+......¬ÿ */
+ $"FF02 01F9 FFFB F902 FFFB 0000 0000 0000" /* ÿ..ùÿûù.ÿû...... */
+ $"0000 0000 F8FD 04F5 0201 0202 0402 01FA" /* ....øý.õ.......ú */
+ $"FFFD 0202 F9FF FDF9 01FB FD00 0000 0000" /* ÿý..ùÿýù.ûý..... */
+ $"0000 002B FF02 0101 0101 0102 0202 0101" /* ...+ÿ........... */
+ $"FDFF 2B01 0181 FFFB 0102 FBFD 0000 0000" /* ýÿ+..ÿû..ûý.... */
+ $"0000 00FF F9F5 F502 FF01 0101 0204 0201" /* ...ÿùõõ.ÿ....... */
+ $"FBFF 2BF5 01FB FFF9 0201 02FD FB00 0000" /* ûÿ+õ.ûÿù...ýû... */
+ $"0000 FFF9 F5F5 F502 FF02 0101 0102 0201" /* ..ÿùõõõ.ÿ....... */
+ $"56FB 0102 01FB FDF9 0202 0101 FF56 0000" /* Vû...ûýù....ÿV.. */
+ $"00FF FBF9 F7F5 F5F5 FFF5 F501 F501 0202" /* .ÿûù÷õõõÿõõ.õ... */
+ $"0101 0102 0101 0201 0102 01F5 F5FF 5600" /* ...........õõÿV. */
+ $"0000 FDF9 F7F5 F5F5 FFF5 F5F5 F5F5 F502" /* ..ýù÷õõõÿõõõõõõ. */
+ $"01F5 F502 02F5 01F5 01F5 F5F7 FFFD FD00" /* .õõ..õ.õ.õõ÷ÿýý. */
+ $"0000 0081 4EF5 F5F5 FFF5 F5F5 F5F5 F501" /* ...Nõõõÿõõõõõõ. */
+ $"0101 F501 F501 F501 0101 F781 FD00 0000" /* ..õ.õ.õ...÷ý... */
+ $"0000 00F9 F94E F7F5 FFF5 F5F5 F5F5 F5F5" /* ...ùùN÷õÿõõõõõõõ */
+ $"F5F5 01F5 01F5 F5F5 0101 F7FF 0000 0000" /* õõ.õ.õõõ..÷ÿ.... */
+ $"0000 00F9 81F7 4E4F FFF7 F5F5 F5F5 F5F5" /* ...ù÷NOÿ÷õõõõõõ */
+ $"F5F5 F5F5 F5F5 F5F5 01F7 FD00 0000 0000" /* õõõõõõõõ.÷ý..... */
+ $"0000 0000 FDF7 4F79 FF4F F5F5 F5F5 F52B" /* ....ý÷OyÿOõõõõõ+ */
+ $"F5F5 4E4F F54F F54F F781 8100 0000 0000" /* õõNOõOõO÷..... */
+ $"0000 0000 814E F7F7 FF2B F7F5 F5F5 F54F" /* ....N÷÷ÿ+÷õõõõO */
+ $"4EF5 4E4F F54F F54F F7FD 0000 0000 0000" /* NõNOõOõO÷ý...... */
+ $"0000 0000 F9F9 7979 FFF7 4E4F F5F5 4EF7" /* ....ùùyyÿ÷NOõõN÷ */
+ $"F74F F7F7 F5F7 4E4E FD00 0000 0000 0000" /* ÷O÷÷õ÷NNý....... */
+ $"0000 0000 0081 F979 FFF7 F74E F5F7 4FF7" /* .....ùyÿ÷÷Nõ÷O÷ */
+ $"F7F7 4FF7 4E4F 4EFA FC00 0000 0000 0000" /* ÷÷O÷NONúü....... */
+ $"0000 0000 00FD F9F9 FFFD 81F7 4F4E 4EF8" /* .....ýùùÿý÷ONNø */
+ $"4FF7 F74F F74E 4FFA 0000 0000 0000 0000" /* O÷÷O÷NOú........ */
+ $"0000 00FF FFFF FFFF FFFF FFFD F779 79F8" /* ...ÿÿÿÿÿÿÿÿý÷yyø */
+ $"F87A F74E 4F79 79FE 0000 0000 0000 0000" /* øz÷NOyyþ........ */
+ $"0000 00FF FFFF FFFF FFFF ACFA 79F8 797A" /* ...ÿÿÿÿÿÿÿ¬úyøyz */
+ $"797A 79F7 7979 FAFB 0000 0000 0000 0000" /* yzy÷yyúû........ */
+ $"0000 0000 0000 FCFA FF79 79FA F8FA A480" /* ......üúÿyyúøú¤€ */
+ $"7980 8079 8080 FE00 0000 0000 0000 0000" /* y€€y€€þ......... */
+ $"0000 0000 0000 FCFA FAFA 8080 FAFA 7AFA" /* ......üúúú€€úúzú */
+ $"80FA FA80 FAFA FD00 0000 0000 0000 0000" /* €úú€úúý......... */
+ $"0000 0000 0000 81FC FA80 FAFA 80FA A47A" /* ......üú€úú€ú¤z */
+ $"80FB FB79 80FD 0000 0000 0000 0000 0000" /* €ûûy€ý.......... */
+ $"0000 FFFF FFFF FFFF FFFF FFFF A480 80FA" /* ..ÿÿÿÿÿÿÿÿÿÿ¤€€ú */
+ $"FB7A FBA4 79FB 0000 0000 0000 0000 0000" /* ûzû¤yû.......... */
+ $"0000 81FF FFFF FFFF FFFF FFFF FFA4 80FA" /* ..ÿÿÿÿÿÿÿÿÿÿ¤€ú */
+ $"80A4 FB80 A4FF FFFF FA00 0000 0000 0000" /* €¤û€¤ÿÿÿú....... */
+ $"0000 00F5 FBFF FFFF FFFF FFFF FDFC A480" /* ...õûÿÿÿÿÿÿÿýü¤€ */
+ $"8080 A4A4 FAFF FFFF 5600 0000 0000 0000" /* €€¤¤úÿÿÿV....... */
+ $"0000 0000 00F5 FFFF FFFF FFFF FFFF FCFB" /* .....õÿÿÿÿÿÿÿÿüû */
+ $"80FC 80A4 FFFF 8100 0000 0000 0000 0000" /* €ü€¤ÿÿ......... */
+ $"0000 0000 0000 FFFF FFFF FFFF FFFF FFFF" /* ......ÿÿÿÿÿÿÿÿÿÿ */
+ $"FEFD FDFE FF81 0000 0000 0000 0000 0000" /* þýýþÿ.......... */
+ $"0000 0000 0000 EAFF FFFF FFFF FFFF FFFF" /* ......êÿÿÿÿÿÿÿÿÿ */
+ $"FFFF FFFF FD00 0000 0000 0000 0000 0000" /* ÿÿÿÿý........... */
+ $"0000 0000 0000 56FF FFFF FFFF FFFF FFFF" /* ......Vÿÿÿÿÿÿÿÿÿ */
+ $"FFFF FFFF AC00 0000 0000 0000 0000 0000" /* ÿÿÿÿ¬........... */
+ $"0000 0000 0000 0000 0056 FDFF FFFF FFFF" /* .........Výÿÿÿÿÿ */
+ $"FFFF FFFF AC00 0000 0000 0000 0000 0000" /* ÿÿÿÿ¬........... */
+ $"0000 0000 0000 0000 0000 00F7 F9AC FDFF" /* ...........÷ù¬ýÿ */
+ $"FFFF FFFF FD00 0000 0000 0000 0000 0000" /* ÿÿÿÿý........... */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+ $"0000 0000 0000 0000 0000 0000 0000 0000" /* ................ */
+};
+
+/*
+ * 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
+ * the resource must be of the form "KEYWORD=SOME STRING". See Tcl
+ * documentation for futher information about the env variable.
+ */
+
+/* A good example of something you may want to set is:
+ * "TCL_LIBRARY=My disk:etc."
+ */
+
+resource 'STR#' (128, "Tcl Environment Variables") {
+ { "SCHEDULE_NAME=Agent Controller Schedule",
+ "SCHEDULE_PATH=Lozoya:System Folder:Tcl Lib:Tcl-Scheduler"
+ };
+};
+
+
+/*
+ * The following resources defines the Apple Events that Tk can be
+ * sent from Apple Script.
+ */
+
+resource 'aete' (0, "Wish Suite") {
+ 0x01, 0x00, english, roman,
+ {
+ "Required Suite",
+ "Events that every application should support",
+ 'reqd', 1, 1,
+ {},
+ {},
+ {},
+ {},
+
+ "Wish Suite", "Events for the Wish application", 'WIsH', 1, 1,
+ {
+ "do script", "Execute a Tcl script", 'misc', 'dosc',
+ 'TEXT', "Result", replyOptional, singleItem,
+ notEnumerated, reserved, reserved, reserved, reserved,
+ reserved, reserved, reserved, reserved, reserved,
+ reserved, reserved, reserved, reserved,
+ 'TEXT', "Script to execute", directParamRequired,
+ singleItem, notEnumerated, changesState, reserved,
+ reserved, reserved, reserved, reserved, reserved,
+ reserved, reserved, reserved, reserved, reserved,
+ reserved,
+ {},
+ },
+ {},
+ {},
+ {},
+ }
+};
+
+/*
+ * 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
+ * create and manage an About Dialog box.
+ */
+data 'DLOG' (128, "Default About Box", purgeable) {
+ $"002E 0026 011B 01E0 0001 0100 0100 0000"
+ $"0000 0081 00"
+};
+
+
+resource 'DITL' (129, "About Box", purgeable) {
+ {
+ {198, 278, 220, 362}, Button {enabled, "Ok"},
+ { 21, 205, 181, 442}, StaticText {disabled,
+ "ItkWish" ITK_PATCH_LEVEL " - an Object-Oriented Wish"
+ "\n\n" "Michael McLennan"
+ "\n" "Jim Ingham" "\n" "Lee Bernhard" "\n\n"
+ "©Lucent Technologies, Inc. 1993-1998" "\n\n" "For more Info, see:" "\n"
+ "http://www.tcltk.com/itcl"},
+ { 37, 22, 204, 182}, Picture {enabled, 128}
+ }
+};
+
+data 'PICT' (128) {
+ $"46B2 0000 0000 00A7 00A0 0011 02FF 0C00"
+ $"FFFE 0000 0048 0000 0048 0000 0000 0000"
+ $"00A7 00A0 0000 0000 001E 0001 000A 0000"
+ $"0000 00A7 00A0 0099 80A0 0000 0000 00A7"
+ $"00A0 0000 0000 0000 0000 0048 0000 0048"
+ $"0000 0000 0008 0001 0008 0000 0000 0157"
+ $"9668 0000 0000 0000 8746 8000 00FF 0004"
+ $"F800 FC00 F800 0066 F800 F800 F800 015D"
+ $"F000 F400 F000 0000 F000 F000 F000 0000"
+ $"E800 EC00 E800 01C1 E800 E800 E800 0000"
+ $"E000 E400 E000 011E E000 E000 E000 01C3"
+ $"D800 DC00 D800 0000 D800 D800 D800 0000"
+ $"D000 D400 D000 0000 D000 D000 D000 0000"
+ $"C800 C800 C800 0000 C000 C400 C000 0000"
+ $"C000 C000 C000 0000 B800 BC00 B800 0000"
+ $"B800 B800 B800 0000 B000 B400 B000 0000"
+ $"B000 B000 B000 0000 A800 AC00 A800 0000"
+ $"A800 A800 A800 0000 A000 A400 A000 0000"
+ $"A000 A000 9800 0000 A000 A000 A000 0000"
+ $"9800 9C00 9800 0000 9800 9800 9800 0000"
+ $"9000 9400 9000 0000 8800 8C00 8800 0000"
+ $"8800 8800 8800 0000 8800 8400 8000 0000"
+ $"8800 A000 5800 0000 8000 8400 8000 0000"
+ $"8000 9C00 5800 0000 7800 8C00 6000 0000"
+ $"7800 7C00 7800 0000 7800 7800 7800 0000"
+ $"7000 8000 6000 0000 7000 7400 7000 0000"
+ $"7000 7000 6800 0000 7000 7800 5800 0000"
+ $"6800 6C00 6800 0000 6800 6800 6800 0000"
+ $"6000 6400 6000 0000 6000 6C00 5000 0000"
+ $"6000 6000 6000 0000 5800 6400 5000 0000"
+ $"5800 5C00 5800 0000 5800 5800 5800 0000"
+ $"5000 5400 5000 0000 5000 9800 4000 0000"
+ $"5000 5400 4800 0000 5000 A800 4000 0000"
+ $"5000 5000 5000 0000 5000 8800 4000 0000"
+ $"5000 B400 3800 0000 4800 7C00 4000 0000"
+ $"4800 4C00 4800 0000 4800 4800 4800 0000"
+ $"4800 C000 3000 0000 4800 6C00 4000 0000"
+ $"4000 4800 4000 0000 4000 4400 4000 0000"
+ $"4000 4000 4000 0000 4000 9000 3800 0000"
+ $"4000 CC00 2800 0000 4000 8400 3800 0000"
+ $"4000 9800 3000 0000 4000 7400 3800 0000"
+ $"4000 5C00 3800 0000 3800 8000 3800 0000"
+ $"3800 3C00 3800 0000 3800 3800 3800 0000"
+ $"3800 6400 3800 0000 3800 A800 3000 0000"
+ $"3800 3800 3000 0000 3800 5000 3000 0000"
+ $"3800 C400 2800 0000 3000 D800 2000 0000"
+ $"3000 4800 3000 0000 3000 3400 3000 0000"
+ $"3000 BC00 2800 0000 3000 3000 3000 0000"
+ $"3000 4400 3000 0000 2800 2C00 2800 0000"
+ $"2800 3800 2800 0000 2800 E400 1800 0000"
+ $"2800 A800 2000 0000 2800 2800 2800 0000"
+ $"2800 CC00 2000 0000 2800 AC00 2000 4D61"
+ $"2800 7000 2000 015D 2800 3800 2000 0001"
+ $"2000 2C00 2000 015D 2000 D400 1800 0000"
+ $"2000 B000 2000 015A 2000 9C00 1800 015A"
+ $"2000 2400 2000 0000 2000 2000 2000 0003"
+ $"2000 D800 1800 0066 2000 4C00 1800 025B"
+ $"2000 B800 1800 0000 2000 A800 1800 0010"
+ $"2000 8C00 2000 015D 2000 B400 1800 0000"
+ $"1800 EC00 1000 0000 1800 E800 1000 015D"
+ $"1800 C000 1800 0000 1800 3800 1800 0000"
+ $"1800 1C00 1800 0000 1800 DC00 1800 0000"
+ $"1800 8C00 1800 7400 1800 7400 1800 0159"
+ $"1800 E000 1000 0000 1800 2C00 1000 0003"
+ $"1800 1800 1800 0066 1800 CC00 1000 015D"
+ $"1800 E400 1000 0004 1000 EC00 1000 0066"
+ $"1000 F000 0800 015D 1000 E400 1000 0000"
+ $"1000 9000 1000 0000 1000 2400 1000 01C1"
+ $"1000 EC00 0800 0000 1000 3400 1000 011E"
+ $"1000 E800 0800 01C3 1000 E000 1000 0000"
+ $"1000 4C00 1000 0000 1000 2000 1000 0000"
+ $"1000 1000 1000 0000 1000 5C00 1000 0000"
+ $"1000 5800 1000 0000 1000 1000 0800 0000"
+ $"1000 6400 1000 0000 0800 F400 0000 0000"
+ $"0800 7000 0800 0000 0800 1400 0800 0000"
+ $"0800 F400 0800 0000 0800 8000 0800 0000"
+ $"0800 8800 0800 0000 0800 EC00 0800 0000"
+ $"0800 0800 0800 0000 0000 F400 0000 0000"
+ $"0000 FC00 0000 0000 0000 F800 0000 0000"
+ $"0000 0400 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 5845"
+ $"0000 0000 0000 015C 0000 0000 0000 0001"
+ $"0000 0000 0000 015D 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0D09"
+ $"0000 0000 0000 0000 0000 0000 0000 055E"
+ $"0000 0000 0000 0106 0000 0000 0000 0054"
+ $"0000 0000 0000 013B 0000 0000 0000 20F9"
+ $"0000 0000 0000 005C 0000 0000 0000 0002"
+ $"0000 0000 0000 20FC 0000 0000 0000 0064"
+ $"0000 0000 0000 00E5 0000 0000 0000 015D"
+ $"0000 0000 0000 0000 0000 0000 0000 067E"
+ $"0000 0000 0000 0159 0000 0000 0000 0000"
+ $"0000 0000 0000 0003 0000 0000 0000 0066"
+ $"0000 0000 0000 015D 0000 0000 0000 0004"
+ $"0000 0000 0000 0066 0000 0000 0000 015D"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 015D 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 5400"
+ $"0000 0000 0000 6F64 0000 0000 0000 6573"
+ $"0000 0000 0000 4B65 0000 0000 0000 0000"
+ $"0000 0000 0000 5074 0000 0000 0000 4572"
+ $"0000 0000 0000 646C 0000 0000 0000 6972"
+ $"0000 0000 0000 6573 0000 0000 0000 7374"
+ $"0000 0000 0000 7400 0000 0000 0000 7200"
+ $"0000 0000 0000 7243 0000 0000 0000 6572"
+ $"0000 0000 0000 6300 0000 0000 0000 6E74"
+ $"0000 0000 0000 3064 0000 0000 0000 6F75"
+ $"0000 0000 0000 6F6D 0000 0000 0000 0002"
+ $"0000 0000 0000 6E64 0000 0000 0000 636F"
+ $"0000 0000 0000 6572 0000 0000 0000 6567"
+ $"0000 0000 0000 726F 0000 0000 0000 0720"
+ $"0000 0000 0000 6550 0000 0000 0000 7900"
+ $"0000 0000 0000 6374 0000 0000 0000 6F50"
+ $"0000 0000 0000 6B53 0000 0000 0000 6F6E"
+ $"0000 0000 0000 E86D 0000 0000 0000 6541"
+ $"0000 0000 0000 696E 0000 0000 0000 0003"
+ $"0000 0000 0000 7473 0000 0000 0000 1E74"
+ $"0000 0000 0000 6D70 0000 0000 0000 D274"
+ $"0000 0000 0000 6D00 0000 0000 0000 6F75"
+ $"0000 0000 0000 4174 0000 0000 0000 7070"
+ $"0000 0000 0000 6F6E 0000 0000 0000 CD77"
+ $"0000 0000 0000 746F 0000 0000 0000 0000"
+ $"0000 00A7 00A0 0000 0000 00A7 00A0 0000"
+ $"000A 0000 0000 00A7 00A0 0481 00E1 0004"
+ $"8100 E100 A27F 0000 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 1F01 0001 0001 0001 0001"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"0001 0001 0001 009F FE00 7F01 0001 0001"
+ $"0C22 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2018 2220 2220"
+ $"2220 2220 2220 2220 2220 2220 2220 2220"
+ $"2208 0001 01FD 0014 0200 0001 FC00 0020"
+ $"818E F28E 0408 0606 0101 FE00 15FD 0000"
+ $"01FE 0000 2281 8EF2 8E07 0C0A 0805 0101"
+ $"0000 1708 0000 0100 0001 0002 2081 8EF2"
+ $"8E07 1411 0C0A 0501 0100 16FE 0000 01FE"
+ $"0001 0222 818E F28E 071F 1912 0C05 0401"
+ $"0017 0800 0001 0001 0000 0220 818E F28E"
+ $"0728 1F19 0F08 0501 0014 FC00 0301 0002"
+ $"2281 8EF2 8E07 2F23 1B11 0905 0100 1708"
+ $"0000 0100 0100 0002 2081 8EF2 8E07 2F28"
+ $"1B11 0A05 0100 27FE 0000 01FE 0001 0222"
+ $"C58E 0F5D 6578 6F5A 5254 5254 524E 5A78"
+ $"7867 77BE 8E07 3828 1F12 0A05 0100 2B08"
+ $"0000 0100 0001 0002 20C8 8E01 584B FD6C"
+ $"0172 72FB 6C08 726C 726C 7260 4549 6DC2"
+ $"8E07 3828 1C12 0A05 0100 26FD 0004 0100"
+ $"0002 22CA 8E03 5060 6C6C F172 086C 726C"
+ $"726C 7253 4449 C68E 0738 281C 120A 0501"
+ $"0042 0200 0001 FD00 0102 20D3 8E21 5D78"
+ $"5A4B 7868 6A66 6072 6C72 6C72 6C6C 3E22"
+ $"1912 1213 141B 2547 726C 7272 6C72 6C72"
+ $"FE6C 0572 6C54 6F65 77CB 8E07 3828 1C12"
+ $"0A05 0100 3AFE 0005 0100 0100 0222 D58E"
+ $"0250 5472 FC6C FC72 046C 726C 6C0C F700"
+ $"0708 236C 6C72 6C72 6CFE 7207 6C72 6C72"
+ $"6C72 545D CD8E 0738 281C 120A 0501 0047"
+ $"0800 0001 0001 0000 0220 D98E 175D 6563"
+ $"6C6C 726C 7260 3D60 6C72 726C 726C 726C"
+ $"7272 471B 05F7 0013 081C 3872 6C72 6C72"
+ $"6C72 6C72 6C72 6C72 6C4E 7877 D08E 0738"
+ $"281C 120A 0501 0049 FA00 0102 22DA 8E01"
+ $"5A72 FE6C 0E72 6C3E 0F01 0007 3E72 6C72"
+ $"6C72 6C72 FE6C 0972 610C 0100 0100 0100"
+ $"01FC 0011 1B72 6C72 6C72 6C72 281B 5172"
+ $"6C72 6C72 6C41 D18E 0738 281C 120A 0501"
+ $"0049 0800 0001 0001 0000 0220 DC8E 085D"
+ $"536C 7272 6C6C 3E0F FC00 0301 0C51 6CFE"
+ $"7200 6CFD 7203 6C72 2E03 F700 1201 1B6C"
+ $"7272 6C72 6C60 0800 2351 6C72 726C 725A"
+ $"D28E 0738 281C 120A 0501 004E FE00 0501"
+ $"0001 0002 22DE 8E08 676F 606C 7251 2A14"
+ $"04F8 0008 0419 386C 7272 6C72 6CFD 7208"
+ $"4719 0300 0100 0100 01FD 0002 1051 6CFD"
+ $"720C 6C12 0001 122E 6072 6C72 536F 75D5"
+ $"8E07 3828 1C12 0A05 0100 5202 0000 01FD"
+ $"0001 0220 DF8E 065A 6C72 6C72 1F01 FB00"
+ $"0201 0001 FB00 020C 476C FE72 026C 726C"
+ $"FE72 016C 0EFE 0002 0100 01FD 0004 012A"
+ $"6C72 6CFE 7200 11FE 0007 0138 7272 6C6C"
+ $"5377 D68E 0738 281C 120A 0501 0056 FD00"
+ $"0401 0000 0222 E28E 0776 7854 6C72 6C22"
+ $"05FB 0007 0100 0001 0001 0001 FD00 0E01"
+ $"122E 6072 726C 726C 726C 726C 1F07 FC00"
+ $"0001 FD00 131F 7272 6C72 6C72 2804 0000"
+ $"0119 3E6C 6C72 724B 73D8 8E07 3828 1C12"
+ $"0A05 0100 5608 0000 0100 0001 0002 20E2"
+ $"8E05 4B6C 6C72 2A01 FB00 0301 0000 01FD"
+ $"0000 01F9 001A 0138 7272 6C72 6C72 6C72"
+ $"7246 0100 0100 0100 0001 0000 0122 7272"
+ $"6CFE 7200 2AFD 0003 033E 7272 FE6C 0050"
+ $"D98E 0738 281C 120A 0501 0059 FE00 0001"
+ $"FE00 0102 22E3 8E05 4E6C 6C72 2801 FB00"
+ $"0701 0001 0000 0100 01FE 0002 0100 01FB"
+ $"0010 2E72 726C 726C 726C 7272 5108 0001"
+ $"0000 01FD 0008 0123 6C72 6C72 6C6C 07FD"
+ $"0007 0123 6C72 6C72 6C5D DA8E 0738 281C"
+ $"120A 0501 0061 0800 0001 0001 0000 0220"
+ $"E58E 0667 6372 6C2E 1901 FE00 0201 0001"
+ $"FD00 0E01 0000 0100 0100 0100 0100 0001"
+ $"0001 FE00 0C0F 2F6C 7272 6C72 6C72 726C"
+ $"1A01 FD00 0001 FD00 0728 6C72 6C72 6C6C"
+ $"1AFC 0007 1251 6C72 7253 7876 DC8E 0738"
+ $"281C 120A 0501 005C FC00 0301 0002 22E7"
+ $"8E05 6D60 7272 6C14 FC00 0901 0001 0001"
+ $"0001 0000 01FD 0000 01FD 0002 0100 01FB"
+ $"0006 0760 6C72 6C72 6CFE 7206 3D01 0001"
+ $"0000 01FD 0003 6072 726C FE72 000C FC00"
+ $"0203 2872 FE6C 0160 76DD 8E07 3828 1C12"
+ $"0A05 0100 6708 0000 0100 0100 0002 20EC"
+ $"8E09 4B60 6D8E 8E54 6C6C 600C FC00 0001"
+ $"FC00 0701 0001 0000 0100 01FE 0002 0100"
+ $"01FD 0000 01FC 0006 106C 7272 6C72 6CFE"
+ $"7206 4703 0000 0100 01FE 000A 076C 7272"
+ $"6C72 6C1C 0000 01FE 0006 0134 726C 726C"
+ $"5ADD 8E07 3828 1C12 0A05 0100 66FE 0000"
+ $"01FE 0001 0222 ED8E 0449 6C6C 495A FE6C"
+ $"012A 0BFD 0000 01FE 0002 0100 01FD 0012"
+ $"0100 0001 0001 0001 0001 0000 0100 0100"
+ $"0100 01FE 000B 091F 6C72 6C72 6C72 726C"
+ $"3803 F900 071F 726C 726C 7247 01FB 0002"
+ $"0422 6CFE 7201 5A6D DF8E 0738 281C 120A"
+ $"0501 006D 0800 0001 0000 0100 0220 ED8E"
+ $"0049 FD6C 0272 5108 FD00 0E01 0000 0100"
+ $"0100 0100 0100 0100 0001 FD00 0001 FD00"
+ $"0201 0001 FE00 0201 0001 FD00 1E17 6C72"
+ $"6C72 6C72 726C 6109 0000 0100 0100 0001"
+ $"516C 7272 6C6C 2300 0001 0001 FE00 061F"
+ $"726C 7272 6C5D E08E 0738 281C 120A 0501"
+ $"0065 FD00 0401 0000 0222 ED8E 0149 6CFE"
+ $"7201 380C FD00 0501 0001 0000 01FC 0007"
+ $"0100 0100 0001 0001 FE00 0201 0001 FD00"
+ $"0001 F800 0110 4FFE 7208 6C72 726C 3D05"
+ $"0000 01FD 000A 0B6C 726C 7272 6C05 0000"
+ $"01FD 0007 0119 516C 6C72 546A E18E 0738"
+ $"281C 120A 0501 0070 0200 0001 FD00 0102"
+ $"20ED 8E05 4372 6C6C 1B01 FE00 0001 FE00"
+ $"0701 0001 0000 0100 01FD 0016 0100 0001"
+ $"0001 0001 0001 0000 0100 0100 0100 0100"
+ $"0100 01FE 0005 1072 6C72 726C FE72 0160"
+ $"07FE 0000 01FE 0006 5172 726C 726C 12FD"
+ $"0000 01FD 0006 0157 726C 726C 6DE2 8E07"
+ $"3828 1C12 0A05 0100 6DFE 0005 0100 0100"
+ $"0222 EE8E 0449 6C72 722A FB00 1001 0001"
+ $"5146 1901 0000 0100 0100 0100 0001 FD00"
+ $"0001 FD00 0201 0001 FE00 0401 0001 0001"
+ $"FD00 1E01 2272 6C72 726C 726C 7247 0000"
+ $"0100 0100 0051 6C72 726C 7212 0000 0100"
+ $"0001 FD00 0019 FE72 016C 5AE2 8E07 3828"
+ $"1C12 0A05 0100 6D08 0000 0100 0100 0002"
+ $"20EF 8E05 656C 726C 7204 FD00 0901 0000"
+ $"0100 5772 6C72 0AFD 0007 0100 0100 0001"
+ $"0001 FE00 0201 0001 FD00 0001 FA00 0001"
+ $"FD00 0812 6C6C 7272 6C72 7251 FB00 0301"
+ $"5772 6CFE 7200 12FE 0000 01FE 0000 01FE"
+ $"0006 1951 6C72 725A 76E4 8E07 3828 1C12"
+ $"0A05 0100 73FA 0001 0222 F08E 0550 6C72"
+ $"6C72 6CFE 0006 0100 0001 0000 01FE 7204"
+ $"6C0C 0000 01FD 0018 0100 0001 0001 0001"
+ $"0001 0000 0100 0100 0100 0100 0100 0100"
+ $"01FD 001E 2572 726C 726C 6C57 0000 0100"
+ $"0100 016C 7272 6C72 7211 0000 0100 0100"
+ $"0100 01FE 0006 0157 6C72 7260 76E5 8E07"
+ $"3828 1C12 0A05 0100 6E08 0000 0100 0100"
+ $"0002 20F1 8E06 416C 726C 726C 72FD 000A"
+ $"0100 0001 0001 7272 6C72 0BFE 0005 0100"
+ $"0100 0001 FD00 0001 FD00 0201 0001 FE00"
+ $"0401 0001 0001 FA00 071B 726C 726C 7272"
+ $"51FE 000A 0100 0107 726C 7272 6C72 0CFC"
+ $"0000 01FA 0005 1A72 726C 7278 E58E 0738"
+ $"281C 120A 0501 0077 FE00 0501 0001 0002"
+ $"22F2 8E11 5D6C 726C 4E6A 6C6C 0A00 0001"
+ $"0001 0000 0101 FE72 0D6C 0C00 0001 0001"
+ $"0001 0000 0100 01FE 0002 0100 01FD 0000"
+ $"01FA 0010 0100 0100 0100 1072 726C 726C"
+ $"7251 0000 01FE 001B 236C 726C 7272 6C01"
+ $"0000 0100 0100 0001 0001 0001 0001 1F72"
+ $"726C 6064 E68E 0738 281C 120A 0501 0073"
+ $"0200 0001 FD00 0102 20F1 8E07 4B6C 5A8E"
+ $"8E60 720C FC00 0801 0000 0172 726C 720C"
+ $"FA00 2401 0000 0100 0100 0100 0100 0001"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"096C 7272 6C72 6C57 FD00 0201 0047 FE72"
+ $"026C 7251 FD00 0701 0000 0100 0100 01FD"
+ $"0001 2572 FE6C 0049 E78E 0738 281C 120A"
+ $"0501 006F FD00 0401 0000 0222 F18E 1076"
+ $"7877 8E8E 606C 0B00 0001 0001 0001 0001"
+ $"FE72 0A6C 0B00 0001 0001 0001 0001 FD00"
+ $"0001 FD00 0201 0001 FE00 0401 0001 0001"
+ $"F900 1372 6C72 726C 722A 0000 0100 0005"
+ $"6C72 6C72 726C 23FE 0003 0100 0001 F800"
+ $"0005 FE72 026C 6C6A E88E 0738 281C 120A"
+ $"0501 0074 0800 0001 0000 0100 0220 EC8E"
+ $"0254 6C0F FE00 0001 FE00 0601 0172 726C"
+ $"720C FE00 0201 0001 FE00 0201 0001 FE00"
+ $"0201 0001 FD00 0001 FA00 0D01 0001 0001"
+ $"0000 7272 6C72 726C 19FE 0020 0100 1172"
+ $"6C72 6C72 7208 0000 0100 0001 0000 0100"
+ $"0100 0100 0100 1972 726C 726C 5AE8 8E07"
+ $"3828 1C12 0A05 0100 76FE 0000 01FE 0001"
+ $"0222 EC8E 0B52 6C12 0000 0100 0001 0000"
+ $"01FE 7204 6C0C 0000 01FD 0031 0100 0001"
+ $"0001 0001 0001 0000 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0001 6C72 726C 7272"
+ $"0100 0001 0000 196C 726C 726C 6C01 FD00"
+ $"1201 0000 0100 0100 0100 0100 0134 6C72"
+ $"726C 7278 E88E 0738 281C 120A 0501 006B"
+ $"0800 0001 0001 0000 0220 EC8E 1052 6C13"
+ $"0001 0000 0100 0100 0172 726C 720B FD00"
+ $"0401 0001 0001 FD00 0001 FD00 0201 0001"
+ $"FE00 0401 0001 0001 F900 0672 6C72 726C"
+ $"3801 FD00 0701 1C72 6057 473D 28FE 0000"
+ $"01FE 0000 01F9 0007 1C6C 726C 6054 5276"
+ $"E88E 0738 281C 120A 0501 006A FC00 0301"
+ $"0002 22EC 8E02 5A72 17FE 0000 01FE 0001"
+ $"0101 FE72 076C 0C00 0001 0000 01FE 0002"
+ $"0100 01FE 0002 0100 01FD 0000 01FA 000C"
+ $"0100 0100 0100 0572 726C 7272 12FE 0002"
+ $"0100 00FE 01FB 0012 0100 0100 0100 0001"
+ $"0001 0001 000C 7272 6C72 78E5 8E07 3828"
+ $"1C12 0A05 0100 7008 0000 0100 0100 0002"
+ $"20EC 8E10 4B6C 1900 0001 0000 0100 0001"
+ $"7272 6C72 0CFE 0000 01FE 0028 0100 0001"
+ $"0001 0001 0001 0000 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 000B 726C 3E2F 1201"
+ $"0000 0100 01F8 0000 01FE 000A 0100 0001"
+ $"0001 0001 0001 1FFE 7201 6C77 E58E 0738"
+ $"281C 120A 0501 005F FE00 0001 FE00 0102"
+ $"22EC 8E02 6F6C 1BFD 0004 0100 0100 01FE"
+ $"720A 6C0B 0000 0100 0100 0100 01FD 0000"
+ $"01FD 0002 0100 01FE 0004 0100 0100 01FB"
+ $"0003 0101 0001 F200 0501 0001 0000 01FE"
+ $"0000 01FB 0005 0C60 726C 545D E48E 0738"
+ $"281C 120A 0501 0066 0800 0001 0000 0100"
+ $"0220 EC8E 0578 721C 0000 01FD 0006 0101"
+ $"7272 6C72 0CFC 0000 01FE 0002 0100 01FE"
+ $"0002 0100 01FD 0000 01FA 0004 0100 0100"
+ $"01F8 001E 0100 0100 0100 0100 0100 0001"
+ $"0000 0100 0100 0100 0001 0001 0001 6072"
+ $"6C6C 6DE3 8E07 3828 1C12 0A05 0100 6DFD"
+ $"0004 0100 0002 22EC 8E02 786C 1FFE 0005"
+ $"0100 0100 0001 FE72 236C 0C00 0001 0001"
+ $"0000 0100 0001 0001 0001 0001 0000 0100"
+ $"0100 0100 0100 0100 0100 0100 01FA 000C"
+ $"0100 0100 0100 0100 0100 0100 01FE 0000"
+ $"01FE 0008 0100 0001 0001 0001 3DFE 7200"
+ $"66E2 8E07 3828 1C12 0A05 0100 6302 0000"
+ $"01FD 0001 0220 EC8E 1078 6C2E 0000 0100"
+ $"0100 0100 016C 6C72 7212 FE00 0501 0000"
+ $"0100 01FD 0000 01FD 0002 0100 01FE 0004"
+ $"0100 0100 01FB 0007 0100 0100 0100 0001"
+ $"F600 0501 0001 0000 01FE 0000 01FD 0004"
+ $"1972 726C 60E1 8E07 3828 1C12 0A05 0100"
+ $"68FE 0005 0100 0100 0222 EC8E 0278 6C2E"
+ $"FA00 0C01 0051 7272 6C12 0000 0100 0001"
+ $"FE00 0201 0001 FE00 0201 0001 FD00 0001"
+ $"FA00 0A01 0001 0001 0001 0001 0001 FE00"
+ $"1C01 0001 0001 0001 0001 0000 0100 0001"
+ $"0001 0001 0000 0100 002E 726C 7250 E18E"
+ $"0738 281C 120A 0501 006C 0800 0001 0001"
+ $"0000 0220 EC8E 1067 6C3D 0000 0100 0100"
+ $"0100 0057 726C 7212 FD00 1D01 0000 0100"
+ $"0001 0001 0001 0001 0000 0100 0100 0100"
+ $"0100 0100 0100 0100 01FA 000C 0100 0100"
+ $"0100 0100 0100 0100 01FE 0000 01FE 000A"
+ $"0100 0001 0001 106C 6C72 6FE0 8E07 3828"
+ $"1C12 0A05 0100 5FFA 0001 0222 EC8E 0267"
+ $"7246 FE00 0201 0001 FE00 0051 FE72 0312"
+ $"0000 01FE 0002 0100 01FD 0000 01FD 0002"
+ $"0100 01FE 0004 0100 0100 01FB 0007 0100"
+ $"0100 0100 0001 F600 0501 0001 0000 01FE"
+ $"0008 0100 0007 6C6C 7272 6DE0 8E07 3828"
+ $"1C12 0A05 0100 6A08 0000 0100 0100 0002"
+ $"20EC 8E05 5D6C 6000 0001 FD00 0601 0057"
+ $"6C72 7212 FE00 0201 0001 FE00 0201 0001"
+ $"FE00 0201 0001 FD00 0001 FA00 0A01 0001"
+ $"0001 0001 0001 0001 FE00 1201 0001 0001"
+ $"0001 0001 0000 0100 0001 0001 0001 FE00"
+ $"042E 7272 6C4B DF8E 0738 281C 120A 0501"
+ $"006A FE00 0501 0001 0002 22EC 8E02 5D72"
+ $"61FD 0005 0100 0100 0051 FE72 2214 0000"
+ $"0100 0100 0001 0000 0100 0100 0100 0100"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"FA00 0C01 0001 0001 0001 0001 0001 0001"
+ $"FE00 0001 FE00 0901 0000 010C 726C 724B"
+ $"76DF 8E07 3828 1C12 0A05 0100 5C02 0000"
+ $"01FD 0001 0220 EB8E 0F6C 7201 0000 0100"
+ $"0100 0001 516C 726C 19FB 0002 0100 01FD"
+ $"0000 01FD 0002 0100 01FE 0004 0100 0100"
+ $"01FB 0007 0100 0100 0100 0001 F600 0501"
+ $"0001 0000 01FE 0005 0100 2572 7253 DD8E"
+ $"0738 281C 120A 0501 0062 FD00 0401 0000"
+ $"0222 EB8E 026C 6C0B FB00 0201 0057 FE72"
+ $"0519 0000 0100 01FD 0002 0100 01FE 0002"
+ $"0100 01FD 0000 01FA 000A 0100 0100 0100"
+ $"0100 0100 01FE 0018 0100 0100 0100 0100"
+ $"0100 0001 0000 0100 0100 0100 0761 726C"
+ $"66DD 8E07 3828 1C12 0A05 0100 6908 0000"
+ $"0100 0001 0002 20EB 8E07 5472 1900 0001"
+ $"0001 FE00 0051 FE72 0019 FE00 1E01 0001"
+ $"0001 0000 0100 0100 0100 0100 0001 0001"
+ $"0001 0001 0001 0001 0001 0001 FA00 0C01"
+ $"0001 0001 0001 0001 0001 0001 FE00 0001"
+ $"FE00 0701 0001 476C 726C 76DD 8E07 3828"
+ $"1C12 0A05 0100 5EFE 0000 01FE 0001 0222"
+ $"EB8E 0253 7222 FE00 0C01 0001 0000 576C"
+ $"726C 1900 0001 FE00 0201 0001 FD00 0001"
+ $"FD00 0201 0001 FE00 0401 0001 0001 FB00"
+ $"0701 0001 0001 0000 01F6 0005 0100 0100"
+ $"0001 FE00 040B 7272 6C41 DC8E 0738 281C"
+ $"120A 0501 0065 0800 0001 0001 0000 0220"
+ $"EB8E 054B 6C2E 0000 01FE 0002 0100 51FE"
+ $"7205 1F00 0100 0001 FD00 0201 0001 FE00"
+ $"0201 0001 FD00 0001 FA00 0A01 0001 0001"
+ $"0001 0001 0001 FE00 1601 0001 0001 0001"
+ $"0001 0000 0100 0001 0001 0000 2372 725A"
+ $"DB8E 0738 281C 120A 0501 0062 FC00 0301"
+ $"0002 22EB 8E02 4872 51FD 0000 01FE 0004"
+ $"5772 6C72 1CFE 001E 0100 0100 0100 0001"
+ $"0001 0001 0001 0000 0100 0100 0100 0100"
+ $"0100 0100 0100 01FA 000C 0100 0100 0100"
+ $"0100 0100 0100 01FE 0000 01FE 0004 0101"
+ $"6172 53DA 8E07 3828 1C12 0A05 0100 5D08"
+ $"0000 0100 0100 0002 20EB 8E12 4272 5100"
+ $"0001 0000 0100 002E 7272 6C1F 0000 01FE"
+ $"0002 0100 01FD 0000 01FD 0002 0100 01FE"
+ $"0004 0100 0100 01FB 0007 0100 0100 0100"
+ $"0001 F600 0B01 0001 0000 0100 0019 6C72"
+ $"6FDA 8E07 3828 1C12 0A05 0100 62FE 0000"
+ $"01FE 0001 0222 EB8E 0B49 6C72 0100 0001"
+ $"0000 0100 2EFE 7200 1FFD 0000 01FD 0002"
+ $"0100 01FE 0002 0100 01FD 0000 01FA 000A"
+ $"0100 0100 0100 0100 0100 01FE 0015 0100"
+ $"0100 0100 0100 0100 0001 0000 0100 010C"
+ $"6072 6C73 DA8E 0738 281C 120A 0501 0064"
+ $"0800 0001 0000 0100 0220 EA8E 026C 720C"
+ $"FE00 2A01 0000 012E 7272 6C2A 0001 0001"
+ $"0001 0001 0000 0100 0100 0100 0100 0001"
+ $"0001 0001 0001 0001 0001 0001 0001 FA00"
+ $"0C01 0001 0001 0001 0001 0001 0001 FE00"
+ $"0001 FE00 0347 726C 48D9 8E07 3828 1C12"
+ $"0A05 0100 59FD 0004 0100 0002 22EA 8E0A"
+ $"6C72 1900 0001 0001 0000 2EFE 7203 2E00"
+ $"0001 FE00 0201 0001 FD00 0001 FD00 0201"
+ $"0001 FE00 0401 0001 0001 FB00 0701 0001"
+ $"0001 0000 01F6 000A 0100 0100 0001 0E72"
+ $"7253 76D9 8E07 3828 1C12 0A05 0100 5D02"
+ $"0000 01FD 0001 0220 EA8E 0260 722F FC00"
+ $"0601 002E 7272 6C2E FD00 0001 FD00 0201"
+ $"0001 FE00 0201 0001 FD00 0001 FA00 0A01"
+ $"0001 0001 0001 0001 0001 FE00 1301 0001"
+ $"0001 0001 0001 0000 0100 0001 0025 726C"
+ $"78D8 8E07 3828 1C12 0A05 0100 62FE 0005"
+ $"0100 0100 0222 EA8E 0A60 6C2E 0000 0100"
+ $"0100 012E FE72 222E 0000 0100 0001 0001"
+ $"0000 0100 0100 0100 0100 0001 0001 0001"
+ $"0001 0001 0001 0001 0001 FA00 0C01 0001"
+ $"0001 0001 0001 0001 0001 FE00 0601 0001"
+ $"576C 7264 D88E 0738 281C 120A 0501 0059"
+ $"0800 0001 0001 0000 0220 EA8E 0254 7251"
+ $"FE00 0001 FE00 0428 7272 6C2F FE00 0501"
+ $"0000 0100 01FD 0000 01FD 0002 0100 01FE"
+ $"0004 0100 0100 01FB 0007 0100 0100 0100"
+ $"0001 F600 0801 0001 0000 196C 724B D78E"
+ $"0738 281C 120A 0501 005A FA00 0102 22EA"
+ $"8E13 546C 7200 0001 0000 0100 196C 7272"
+ $"4700 0001 0001 FD00 0201 0001 FE00 0201"
+ $"0001 FD00 0001 FA00 0A01 0001 0001 0001"
+ $"0001 0001 FE00 1101 0001 0001 0001 0001"
+ $"0000 0100 0007 6C72 6CD6 8E07 3828 1C12"
+ $"0A05 0100 5D08 0000 0100 0100 0002 20EA"
+ $"8E02 4E6C 72FD 0007 0100 0117 726C 7246"
+ $"FC00 1C01 0001 0000 0100 0100 0100 0100"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"FA00 0C01 0001 0001 0001 0001 0001 0001"
+ $"FD00 032E 7272 41D6 8E07 3828 1C12 0A05"
+ $"0100 56FE 0005 0100 0100 0222 EA8E 065A"
+ $"7272 0800 0001 FE00 0D19 6C72 6C46 0000"
+ $"0100 0100 0100 01FD 0000 01FD 0002 0100"
+ $"01FE 0004 0100 0100 01FB 0007 0100 0100"
+ $"0100 0001 F600 0601 0001 086C 7254 D58E"
+ $"0738 281C 120A 0501 005B 0200 0001 FD00"
+ $"0102 20EA 8E03 5A72 720C FD00 0201 0017"
+ $"FE72 0446 0001 0001 FC00 0201 0001 FE00"
+ $"0201 0001 FD00 0001 FA00 0A01 0001 0001"
+ $"0001 0001 0001 FE00 1001 0001 0001 0001"
+ $"0001 0000 0100 1C72 726F D58E 0738 281C"
+ $"120A 0501 005C FD00 0401 0000 0222 EA8E"
+ $"068A 726C 1200 0001 FE00 0419 6C72 7251"
+ $"FC00 1C01 0001 0000 0100 0100 0100 0100"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"FA00 0C01 0001 0001 0001 0001 0001 0001"
+ $"FE00 033E 6C72 73D5 8E07 3828 1C12 0A05"
+ $"0100 5608 0000 0100 0001 0002 20EA 8E03"
+ $"786C 7219 FE00 1001 0000 0172 726C 6100"
+ $"0001 0001 0001 0001 FD00 0001 FD00 0201"
+ $"0001 FE00 0401 0001 0001 FB00 0701 0001"
+ $"0001 0000 01F6 0005 0100 1772 7248 D48E"
+ $"0738 281C 120A 0501 005B FE00 0001 FE00"
+ $"0102 22EA 8E0A 786C 6C19 0000 0100 0100"
+ $"01FE 7200 60FE 0000 01FC 0002 0100 01FE"
+ $"0002 0100 01FD 0000 01FA 000A 0100 0100"
+ $"0100 0100 0100 01FE 000F 0100 0100 0100"
+ $"0100 0100 0001 3D72 7270 D48E 0738 281C"
+ $"120A 0501 005C 0800 0001 0001 0000 0220"
+ $"EA8E 0378 6C72 1BFC 0027 0101 7272 6C60"
+ $"0000 0100 0001 0001 0000 0100 0100 0100"
+ $"0100 0001 0001 0001 0001 0001 0001 0001"
+ $"0001 FA00 1101 0001 0001 0001 0001 0001"
+ $"0001 000E 7272 66D3 8E07 3828 1C12 0A05"
+ $"0100 4FFC 0003 0100 0222 EA8E 0A67 6C72"
+ $"1F00 0001 0001 0001 FE72 0060 FD00 0401"
+ $"0001 0001 FD00 0001 FD00 0201 0001 FE00"
+ $"0401 0001 0001 FB00 0701 0001 0001 0000"
+ $"01F5 0002 226C 51D2 8E07 3828 1C12 0A05"
+ $"0100 5908 0000 0100 0100 0002 20EA 8E03"
+ $"6772 6C28 FE00 0A01 0000 0172 726C 6100"
+ $"0001 FB00 0201 0001 FE00 0201 0001 FD00"
+ $"0001 FA00 0A01 0001 0001 0001 0001 0001"
+ $"FE00 0D01 0001 0001 0001 0001 0003 5772"
+ $"6ED2 8E07 3828 1C12 0A05 0100 5CFE 0000"
+ $"01FE 0001 0222 EA8E 0E64 6C72 2E00 0001"
+ $"0000 0100 6072 7260 FE00 1E01 0001 0001"
+ $"0000 0100 0100 0100 0100 0001 0001 0001"
+ $"0001 0001 0001 0001 0001 FA00 1001 0001"
+ $"0001 0001 0001 0001 0000 236C 725D D28E"
+ $"0738 281C 120A 0501 0053 0800 0001 0000"
+ $"0100 0220 EA8E 036D 726C 38FD 000F 0100"
+ $"0060 726C 6000 0001 0001 0001 0001 FD00"
+ $"0001 FD00 0201 0001 FE00 0401 0001 0001"
+ $"FB00 0701 0001 0001 0000 01F7 0003 016C"
+ $"726C D18E 0738 281C 120A 0501 0055 FD00"
+ $"0401 0000 0222 EA8E 065D 6C72 4600 0001"
+ $"FD00 0461 6C72 6C01 FB00 0405 0B04 0001"
+ $"FE00 0201 0001 FD00 0001 FA00 0A01 0001"
+ $"0001 0001 0001 0001 FE00 0C01 0001 0001"
+ $"0001 0001 3872 6C58 D18E 0738 281C 120A"
+ $"0501 0059 0200 0001 FD00 0102 20EA 8E03"
+ $"766C 7251 FE00 0C01 0317 1961 726C 722E"
+ $"5751 5761 FD72 1819 0000 0100 0100 0100"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"FA00 0E01 0001 0001 0001 0001 0001 0E72"
+ $"6C54 D08E 0738 281C 120A 0501 0052 FE00"
+ $"0501 0001 0002 22EC 8E0E 5D49 4872 726C"
+ $"2E2E 5761 7272 6C72 6CFA 7204 6C72 6C72"
+ $"19FE 0000 01FD 0002 0100 01FE 0004 0100"
+ $"0100 01FB 0007 0100 0100 0100 0001 F800"
+ $"031A 7272 6FD0 8E07 3828 1C12 0A05 0100"
+ $"6008 0000 0100 0100 0002 20F1 8E08 785A"
+ $"5260 6C72 6C72 6CFD 721A 6C72 6C72 726C"
+ $"726C 726C 726C 726C 726C 726C 1B00 0001"
+ $"0000 0100 01FD 0000 01FA 000A 0100 0100"
+ $"0100 0100 0100 01FE 000B 0100 0100 0100"
+ $"0100 3E72 6C73 D08E 0738 281C 120A 0501"
+ $"005C FA00 0102 22F1 8E37 5472 6C72 6C72"
+ $"726C 726C 726C 7272 6C72 6C72 726C 726C"
+ $"726C 726C 726C 726C 721F 0001 0000 0100"
+ $"0100 0001 0001 0001 0001 0001 0001 0001"
+ $"0001 FA00 0D01 0001 0001 0001 0001 0017"
+ $"7272 4ECF 8E07 3828 1C12 0A05 0100 5D08"
+ $"0000 0100 0100 0002 20F1 8E1F 5372 726C"
+ $"726C 7272 6C72 6C72 6C72 726C 726C 7272"
+ $"6C72 6C72 6C72 6C72 6C72 6C1C FE00 0001"
+ $"FD00 0201 0001 FE00 0401 0001 0001 FB00"
+ $"0701 0001 0001 0000 01FA 0004 0C61 7260"
+ $"6DCF 8E07 3828 1C12 0A05 0100 5EFE 0005"
+ $"0100 0100 0222 F18E 0054 FE72 236C 726C"
+ $"7272 6C72 6C72 6C72 726C 726C 7272 6C72"
+ $"6C72 6C72 6C72 6C72 1F00 0001 0000 0100"
+ $"01FD 0000 01FA 000A 0100 0100 0100 0100"
+ $"0100 01FE 0009 0100 0100 0100 516C 7249"
+ $"CE8E 0738 281C 120A 0501 005D 0200 0001"
+ $"FD00 0102 20F1 8E1F 4E72 6C72 726C 726C"
+ $"7272 6C72 6C72 6C72 726C 726C 7272 6C72"
+ $"6C72 6C72 6C72 6C1F FD00 1301 0001 0000"
+ $"0100 0100 0100 0100 0100 0100 0100 01FA"
+ $"000B 0100 0100 0100 0100 0772 726C CD8E"
+ $"0738 281C 120A 0501 005A FD00 0401 0000"
+ $"0222 F18E 2348 6C72 6C72 726C 726C 7272"
+ $"6C72 6C72 6C72 726C 726C 7272 6C72 6C72"
+ $"6C72 6C6C 1B00 0100 01FD 0002 0100 01FE"
+ $"0004 0100 0100 01FB 0007 0100 0100 0100"
+ $"0001 FB00 031F 6C72 5ACD 8E07 3828 1C12"
+ $"0A05 0100 5E08 0000 0100 0001 0002 20F1"
+ $"8E1E 4372 6C72 6C72 726C 726C 7272 6C72"
+ $"6C72 6C72 726C 726C 726C 513E 2E19 1901"
+ $"01FE 0005 0100 0001 0001 FD00 0001 FA00"
+ $"0A01 0001 0001 0001 0001 0001 FE00 0801"
+ $"0001 0001 516C 6C6A CD8E 0738 281C 120A"
+ $"0501 0058 FE00 0001 FE00 0102 22F1 8E17"
+ $"496C 726C 726C 7272 6C72 6C72 726C 726C"
+ $"726C 7272 6C72 0101 F800 1601 0000 0100"
+ $"0100 0001 0001 0001 0001 0001 0001 0001"
+ $"0001 FA00 0701 0001 0001 0001 0CFE 7200"
+ $"76CD 8E07 3828 1C12 0A05 0100 5408 0000"
+ $"0100 0100 0002 20F1 8E01 7653 FB60 0E6C"
+ $"7272 2F2F 1F1B 1912 0C6C 6C72 6C01 F800"
+ $"0301 0000 01FD 0002 0100 01FE 0004 0100"
+ $"0100 01FB 0007 0100 0100 0100 0001 FD00"
+ $"0403 516C 7249 CC8E 0738 281C 120A 0501"
+ $"0068 FC00 0301 0002 22E9 8E03 496C 6C03"
+ $"FB00 0360 726C 60FD 0004 0100 0100 01FE"
+ $"0005 0100 0001 0001 FD00 0001 FA00 0A01"
+ $"0001 0001 0001 0001 0001 FE00 0601 0000"
+ $"1972 7248 FD8E 0058 FA3B 075C 648E 4D3A"
+ $"3333 36FD 4D00 55F9 8E04 7631 545C 36F1"
+ $"8E07 3828 1C12 0A05 0100 8108 0000 0100"
+ $"0100 0002 20E9 8E03 4972 7211 FB00 0360"
+ $"7272 60FE 001E 0100 0100 0100 0100 0100"
+ $"0001 0001 0000 0100 0100 0100 0100 0100"
+ $"0100 0100 01FA 0009 0100 0100 0100 3872"
+ $"6077 FD8E 245E 6C60 2E2A 2328 2F6C 5965"
+ $"462A 3E6C 303E 383E 723B 775A 484B 5A77"
+ $"8E8E 6561 2828 5366 8E8E FD6C 0371 8E68"
+ $"68FC 8E07 3828 1C12 0A05 0100 7FFE 0000"
+ $"01FE 0001 0222 E98E 1049 6C72 1900 0001"
+ $"0001 0060 726C 6100 0001 FA00 0301 0000"
+ $"01FD 0002 0100 01FE 0004 0100 0100 01FB"
+ $"0007 0100 0100 0100 0001 FE00 030C 726C"
+ $"6FFC 8E02 5E6C 0CFD 0026 0572 5E8A 1800"
+ $"1B72 304A 1900 6C4B 4E6C 6C2F 7266 8E8E"
+ $"4B22 0000 084B 8E8E 6C00 0023 6C4B 6C6C"
+ $"4DFD 8E07 3828 1C12 0A05 0100 8208 0000"
+ $"0100 0001 0002 20E9 8E03 496C 7219 FE00"
+ $"0601 0000 5772 7260 FD00 0401 0001 0001"
+ $"FE00 0501 0000 0100 01FD 0000 01FA 000A"
+ $"0100 0100 0100 0100 0100 01FE 0005 0101"
+ $"3E72 7265 FC8E 025E 6C0C FE00 1801 0C47"
+ $"5E6A 1F00 196C 304A 1500 7272 6C22 0100"
+ $"114B 8E8E 5C08 FE00 063E 768E 6C00 0023"
+ $"FD6C 005A FD8E 0738 281C 120A 0501 007F"
+ $"FD00 0401 0000 0222 E98E 0649 6C72 1F00"
+ $"0001 FE00 2546 7272 6000 0001 0000 0100"
+ $"0100 0100 0100 0001 0001 0000 0100 0100"
+ $"0100 0100 0100 0100 0100 01FA 0008 0100"
+ $"0100 1F72 7253 76FC 8E03 656C 0C00 FC72"
+ $"0C5E 8A2B 0011 8976 7E0C 0038 6012 FD00"
+ $"034B 8E3A 3EFD 000B 2C3A 8E60 0000 1B11"
+ $"0100 194B FD8E 0738 281C 120A 0501 0079"
+ $"0200 0001 FD00 0102 20E9 8E03 496C 722E"
+ $"FD00 0501 0046 7272 60FE 0000 01FB 0003"
+ $"0100 0001 FD00 0201 0001 FE00 0401 0001"
+ $"0001 FB00 0D01 0001 0001 0000 0100 0572"
+ $"726C 58FB 8E05 786C 0C0C 6C54 FE3B 0B70"
+ $"6A2E 000C 898E 7E0C 0025 09FC 0003 4E8E"
+ $"4423 FD00 0323 318E 6CFB 0001 194E FD8E"
+ $"0738 281C 120A 0501 007D FE00 0501 0001"
+ $"0002 22E9 8E06 496C 722E 0000 01FE 000C"
+ $"2857 5160 0000 0100 0100 0100 01FE 0005"
+ $"0100 0001 0001 FD00 0001 FA00 0A01 0001"
+ $"0001 0001 0001 0001 FE00 0317 7272 53FA"
+ $"8E05 786C 0C0C 6C5A FD8E 098A 5400 1A89"
+ $"8E7E 0C00 01FE 000E 0100 0052 6871 1F00"
+ $"011F 001F 3B8E 60FB 0001 194E FD8E 0738"
+ $"281C 120A 0501 007C 0800 0001 0001 0000"
+ $"0220 E98E 0349 6C72 47FE 0002 0100 01F8"
+ $"001C 0100 0100 0100 0100 0001 0001 0000"
+ $"0100 0100 0100 0100 0100 0100 0100 01FA"
+ $"0006 0100 002E 726C 6EFA 8E05 786C 0C0C"
+ $"6C78 FD8E 0764 796C 6C8A 887E 0CFE 0018"
+ $"0C0C 0001 0046 216C 0C00 2538 0017 3B8E"
+ $"5300 000B 2807 0019 52FD 8E07 3828 1C12"
+ $"0A05 0100 72FA 0001 0222 E98E 0449 6C72"
+ $"6C01 FE00 0001 FB00 0201 0001 FB00 0301"
+ $"0000 01FD 0002 0100 01FE 0004 0100 0100"
+ $"01FB 000C 0100 0100 0100 0001 0772 6C72"
+ $"77FA 8E05 786C 0C14 6C65 F88E 1E4D 6C01"
+ $"0001 3872 720E 0000 4A30 7205 0972 6100"
+ $"113B 8E3E 0000 1972 1B00 194E FD8E 0738"
+ $"281C 120A 0501 0084 0800 0001 0001 0000"
+ $"0220 FA8E 0065 F078 056C 6C72 1900 01FE"
+ $"0015 0100 0100 0100 0100 0100 0907 0001"
+ $"0000 0100 0001 0001 FD00 0001 FA00 1001"
+ $"0001 0001 0001 0001 0001 0003 4672 6C66"
+ $"F98E 0578 6C0C 196C 5EFE 8E24 3A48 4B48"
+ $"4B52 246C 0000 1272 386C 2800 053E 574A"
+ $"0022 6B81 0710 6E8E 4800 0025 7222 000E"
+ $"52FD 8E07 3828 1C12 0A05 0100 7FFE 0005"
+ $"0100 0100 0222 FA8E EE6C 0472 6C72 726C"
+ $"FE72 256C 726C 726C 726C 726C 726C 721B"
+ $"0000 0100 0001 0001 0000 0100 0100 0100"
+ $"0100 0100 0100 0100 01F9 0003 2E72 7248"
+ $"F88E 0567 7F0C 1972 58FE 8E24 336C 3E2E"
+ $"3E86 8E7E 0100 1C72 276C 2E00 0C4A 6C28"
+ $"0051 6F65 3860 6F8E 4800 002E 5125 000C"
+ $"4EFD 8E07 3828 1C12 0A05 0100 9202 0000"
+ $"01FD 0001 0220 FB8E 2950 6C72 6C72 6C72"
+ $"6C72 6C72 6C72 6C72 6C72 6C72 726C 726C"
+ $"7272 6C72 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"6C72 22FE 0000 01FD 0002 0100 01FE 0004"
+ $"0100 0100 01FB 000A 0100 0100 0100 0372"
+ $"726C 70F8 8E05 6787 0C2E 6C58 FE8E 2433"
+ $"6C0F 001B 868E 7E01 002C 7224 722E 0011"
+ $"4672 1900 725E 8A71 4B8E 8E48 0001 462E"
+ $"2E00 0C4E FD8E 0738 281C 120A 0501 0090"
+ $"FD00 0401 0000 0222 FB8E 3154 726C 726C"
+ $"726C 726C 726C 726C 726C 726C 726C 7272"
+ $"6C72 6C72 726C 726C 726C 726C 726C 726C"
+ $"726C 726C 723D 1B03 0000 0100 01FD 0000"
+ $"01FA 000F 0100 0100 0100 0100 0100 0019"
+ $"6C72 5A88 F88E 058A 710C 2E6C 55FE 8E18"
+ $"3372 0400 1B6F 8E63 0000 3E7E 6D6C 1900"
+ $"1A46 720F 0572 4D8E 58FE 8E08 4800 0054"
+ $"3A3C 1125 52FD 8E07 3828 1C12 0A05 0100"
+ $"9108 0000 0100 0001 0002 20FC 8E2D 5D6C"
+ $"7272 6C72 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"6C72 6C72 726C 726C 7272 6C72 6C72 6C72"
+ $"6C72 6C72 6C72 6C72 6C72 7219 FE00 1101"
+ $"0000 0100 0100 0100 0100 0100 0100 0100"
+ $"01FA 0003 3872 6C65 F78E 056A 6C0C 2E6C"
+ $"68FE 8E16 3351 0000 2351 243E 0000 7281"
+ $"736C 1400 2E46 7208 0581 76FC 8E08 4800"
+ $"006B 8E6B 6C72 5AFD 8E07 3828 1C12 0A05"
+ $"0100 97FE 0000 01FE 0001 0222 FC8E 3565"
+ $"6C6C 7272 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"6C72 6C72 6C72 726C 726C 7272 6C72 6C72"
+ $"6C72 6C72 6C72 6C72 6C72 6C72 1400 0001"
+ $"0000 0100 01FE 0004 0100 0100 01FB 000C"
+ $"0100 0100 0101 6C72 6C77 8E8E 58FD 4908"
+ $"678E 8E8A 6C0C 3872 68FE 8E15 333E 0000"
+ $"2530 243E 0003 726C 5E6C 0C00 3D3D 6C00"
+ $"0581 FC8E 0975 4800 006B 8E7E 6C35 55FD"
+ $"8E07 3828 1C12 0A05 0100 9508 0000 0100"
+ $"0100 0002 20FC 8E2D 786C 726C 7272 6C72"
+ $"6C72 6C72 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"726C 726C 7272 6C72 6C72 6C72 6C72 6C72"
+ $"6C72 6C72 6C10 FD00 0001 FD00 0001 FA00"
+ $"0A01 0001 0001 0001 0001 0038 FE72 106C"
+ $"6C72 726C 726C 725A 8E8E 6A6C 0C6C 6C68"
+ $"FE8E 2133 3800 002A 2D27 3E00 056C 4478"
+ $"6C04 0172 3072 0005 818E 785A 5A4E 3334"
+ $"000A 4E8E 58FA 8E07 3828 1C12 0A05 0100"
+ $"91FC 0003 0100 0222 FA8E 0148 6CFE 7229"
+ $"6C72 6C72 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"6C72 726C 726C 7272 6C72 6C72 6C72 6C72"
+ $"6C72 6C72 6C72 0900 0001 FE00 0E01 0001"
+ $"0001 0001 0001 0001 0001 0001 FC00 140E"
+ $"726C 726C 7272 6C72 726C 7272 4B8E 8E8A"
+ $"710C 6C6C FD8E 1F33 2E00 002E 2432 3E00"
+ $"0C6C 316E 3E00 0572 326C 0005 818E 6319"
+ $"226C 242E 000C 4EF8 8E07 3828 1C12 0A05"
+ $"0100 9108 0000 0100 0100 0002 20F9 8E29"
+ $"7765 5A60 6C72 726C 726C 726C 726C 726C"
+ $"726C 726C 726C 7272 6C72 6C72 726C 726C"
+ $"726C 726C 726C 726C 7260 FD00 0401 0001"
+ $"0001 FE00 0401 0001 0001 FB00 1801 0001"
+ $"0023 7272 6C72 6C72 726C 7272 6C6C 4E8E"
+ $"8E64 800C 6C71 FD8E 1F33 2E00 0038 2132"
+ $"3800 0C81 7665 2500 0C6C 5A6C 0005 6B42"
+ $"2D00 1251 242E 000B 4BF8 8E07 3828 1C12"
+ $"0A05 0100 8CFE 0000 01FE 0001 0222 F58E"
+ $"0258 526C FE72 256C 726C 726C 726C 726C"
+ $"726C 726C 7272 6C72 6C72 726C 726C 726C"
+ $"726C 726C 726C 2F00 0001 0000 01FD 0000"
+ $"01FA 001E 0100 0100 0100 0100 0161 726C"
+ $"726C 726C 7272 6C72 726C 548E 8E48 6C0C"
+ $"6C6C 76FE 8E1F 332E 0000 461E 322E 0012"
+ $"818E 7818 0012 6C78 6C00 006C 6C25 001B"
+ $"3024 2E00 0C48 F88E 0738 281C 120A 0501"
+ $"008F 0800 0001 0000 0100 0220 F38E 0149"
+ $"54FE 721E 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"6C72 726C 726C 7272 6C72 6C72 6C72 6C72"
+ $"6C72 11FE 0000 01FE 000E 0100 0100 0100"
+ $"0100 0100 0100 0100 01FD 0039 1272 6C72"
+ $"6C72 6C72 6C72 726C 7272 548E 8E48 6C0C"
+ $"386C 3133 4D55 3323 0000 511E 322E 0012"
+ $"6C8E 4B0D 0014 4478 6C00 0072 7219 001C"
+ $"2B32 2E01 1148 F88E 0738 281C 120A 0501"
+ $"008A FD00 0401 0000 0222 F28E 2B88 6478"
+ $"4E6C 6C72 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"726C 726C 7272 6C72 6C72 6C72 6C72 5101"
+ $"0000 0100 0100 0100 01FE 0004 0100 0100"
+ $"01FB 0004 0100 0751 6CFE 7234 6C72 6C72"
+ $"6C72 726C 7254 8E8E 4872 0C1C 2F3E 616C"
+ $"3824 2500 016C 7671 2E00 194E 8E4E 0800"
+ $"1B37 786C 0400 2C23 0100 2A21 322E 0019"
+ $"6FF8 8E07 3828 1C12 0A05 0100 7F02 0000"
+ $"01FD 0001 0220 EE8E 1D70 416C 726C 726C"
+ $"726C 726C 726C 726C 7272 6C72 6C72 726C"
+ $"726C 726C 726C 1BFB 0000 01FD 0000 01FA"
+ $"0007 0100 0100 0100 0138 FE72 076C 7272"
+ $"6C72 6C72 6CFE 7205 658E 8E4B 6C0C FD00"
+ $"1572 3824 2500 056C 8E6C 2E00 1B37 8E60"
+ $"0000 2333 786C 0CFC 0006 5476 3B2E 0019"
+ $"5AF8 8E07 3828 1C12 0A05 0100 86FE 0005"
+ $"0100 0100 0222 EC8E 205D 536C 7272 6C72"
+ $"6C72 6C72 6C72 6C72 726C 726C 7272 6C72"
+ $"6C72 6C72 0100 0001 0001 FE00 2001 0001"
+ $"0001 0001 0001 0001 0001 0001 0000 036C"
+ $"726C 7272 6C72 726C 726C 726C 5349 FE8E"
+ $"0248 6C0C FD00 1572 6562 2500 0C4E 8E71"
+ $"2E00 2333 8E6C 0000 2533 786C 19FD 0007"
+ $"0B52 8E3B 2800 285A F88E 0738 281C 120A"
+ $"0501 0082 0800 0001 0001 0000 0220 EA8E"
+ $"236A 4B6C 6C72 726C 726C 726C 726C 7272"
+ $"6C72 6C72 726C 726C 7260 1912 0900 0100"
+ $"0001 0000 01FE 0004 0100 0100 01FA 000D"
+ $"1972 6C72 6C72 726C 7272 6C53 6F6A FC8E"
+ $"2948 7247 3E38 2E2E 6C8A 553C 1B23 523A"
+ $"602E 1038 333A 6005 0F3E 3365 6C38 0000"
+ $"010B 5766 883B 2F12 3E66 88F9 8E07 3828"
+ $"1C12 0A05 0100 79FA 0001 0222 E98E 2049"
+ $"6C72 6C72 726C 726C 726C 726C 7272 6C72"
+ $"6C72 726C 726C 726C 726C 7251 3817 0B01"
+ $"FE00 0001 FA00 1001 0001 0001 0038 7272"
+ $"6C72 6C72 726C 4E49 F98E 244E 796C 6C71"
+ $"6C6C 716A 7572 726C 484D 6C72 726C 5540"
+ $"6C72 726C 3376 446C 382C 7272 6C4D 8E3B"
+ $"FE72 0166 88F9 8E07 3828 1C12 0A05 0100"
+ $"7408 0000 0100 0100 0002 20E8 8E1B 6C6C"
+ $"726C 7272 6C72 6C72 6C72 6C72 726C 726C"
+ $"7272 6C72 6C72 6C72 726C FE72 1A6C 573C"
+ $"281C 1A12 0C01 0100 0100 0100 0100 0C6C"
+ $"6C72 726C 7254 6E6A ED8E 1E55 6868 8E68"
+ $"6258 584D 8E55 4878 6562 768E 8E73 648A"
+ $"786A 768E 8E76 625E 7873 F88E 0738 281C"
+ $"120A 0501 007A FE00 0501 0001 0002 22E8"
+ $"8E19 5472 6C72 6C72 726C 726C 726C 726C"
+ $"7272 6C72 6C72 726C 726C 726C FE72 026C"
+ $"726C F972 0E61 3C23 1701 0000 013D 7272"
+ $"6C72 7249 F58E 1C73 4E63 7F87 6C87 876C"
+ $"8787 7F87 6C87 7F87 6C7F 877F 8772 877F"
+ $"714E 6363 FE78 025A 634E FE63 0160 7FFE"
+ $"8702 6C87 6CFC 8E07 3828 1C12 0A05 0100"
+ $"5102 0000 01FD 0001 0220 E88E 2048 6C72"
+ $"6C72 6C72 726C 726C 726C 726C 7272 6C72"
+ $"6C72 726C 726C 726C 726C 726C 726C FC72"
+ $"006C FE72 0B6C 726C 5138 2E72 726C 726C"
+ $"50F4 8E00 5FD4 90FC 8E07 3828 1C12 0A05"
+ $"0100 6BFD 0004 0100 0002 22E8 8E2B 496C"
+ $"7272 6C72 6C72 726C 726C 726C 726C 7272"
+ $"6C72 6C72 726C 726C 726C 726C 726C 726C"
+ $"726C 726C 726C 726C 726C FA72 014E 73F3"
+ $"8E00 5FFE 90FB 8C09 6C72 616C 616C 616C"
+ $"616C F690 023C 3D72 FE90 056C 1F22 1F22"
+ $"4FFE 90FC 8E07 3828 1C12 0A05 0100 6608"
+ $"0000 0100 0001 0002 20E7 8E2B 6C72 6C72"
+ $"6C72 6C72 726C 726C 726C 726C 7272 6C72"
+ $"6C72 726C 726C 726C 726C 726C 726C 726C"
+ $"726C 726C 726C 726C FE72 026C 7241 F18E"
+ $"0356 9090 1FF2 0000 17F7 9003 8C00 0017"
+ $"FE90 003D FD00 0017 FE90 FC8E 0738 281C"
+ $"120A 0501 0065 FE00 0001 FE00 0102 22E7"
+ $"8E30 606C 726C 726C 726C 7272 6C72 6C72"
+ $"6C72 6C72 726C 726C 7272 6C72 6C72 6C72"
+ $"6C72 6C72 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"6C72 4EF0 8E03 5F90 901F F200 001C F790"
+ $"038C 0000 17FE 9005 803D 3E3E 0E00 FE90"
+ $"FC8E 0738 281C 120A 0501 0071 0800 0001"
+ $"0001 0000 0220 E78E 3054 726C 726C 726C"
+ $"726C 7272 6C72 6C72 6C72 6C72 726C 726C"
+ $"7272 6C72 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"6C72 6C72 6C72 6C72 6C73 F08E 035F 9090"
+ $"3DFC 1F04 1A01 0001 19FC 1C00 38FE 9001"
+ $"5128 FE1C 053E 908C 0000 17FA 9001 1700"
+ $"FE90 FC8E 0738 281C 120A 0501 0065 FC00"
+ $"0301 0002 22E7 8E00 5AFD 722A 6C72 6C72"
+ $"6C72 726C 726C 726C 726C 7272 6C72 6C72"
+ $"726C 726C 726C 726C 726C 726C 726C 726C"
+ $"726C 726C 726C 48EF 8E00 56F9 9004 6100"
+ $"0100 8CF9 9000 22FC 0005 6090 8C00 001C"
+ $"FA90 0419 008C 9090 FC8E 0738 281C 120A"
+ $"0501 006A 0800 0001 0001 0000 0220 E78E"
+ $"2F6F 6C6C 726C 726C 726C 726C 7272 6C72"
+ $"6C72 6C72 6C72 726C 726C 7272 6C72 6C72"
+ $"6C72 6C72 6C72 6C72 6C72 6C72 6C72 6C54"
+ $"76EF 8E00 66F9 9000 57FE 00F9 900C 3E01"
+ $"0003 388C 8C90 908C 0000 1BFA 9004 1700"
+ $"8C90 90FC 8E07 3828 1C12 0A05 0100 69FE"
+ $"0000 01FE 0001 0222 E78E 2E78 6C72 6C72"
+ $"6C72 6C72 6C72 6C72 726C 726C 726C 726C"
+ $"7272 6C72 6C72 726C 726C 726C 726C 726C"
+ $"726C 726C 726C 726C 7270 EE8E 0063 F990"
+ $"033C 0100 00F9 9000 1CFE 0008 576C 8C90"
+ $"9061 0000 1CFA 9004 1900 8C90 90FC 8E07"
+ $"3828 1C12 0A05 0100 6908 0000 0100 0001"
+ $"0002 20E7 8E2D 656C 6C72 6C72 6C72 6C72"
+ $"6C72 6C72 726C 726C 726C 726C 7272 6C72"
+ $"6C72 726C 726C 726C 726C 726C 726C 726C"
+ $"726C 7254 ED8E 004E F990 033D 0100 00F9"
+ $"9001 6003 FE00 0701 0C90 9061 0000 1BFA"
+ $"9004 1700 8C90 90FC 8E07 3828 1C12 0A05"
+ $"0100 6BFD 0004 0100 0002 22E7 8E2D 736C"
+ $"726C 726C 726C 726C 726C 726C 7272 6C72"
+ $"6C72 6C72 6C72 726C 726C 7272 6C72 6C72"
+ $"6C72 6C72 6C72 6C72 6C72 6C6E ED8E 0063"
+ $"F990 0357 170E 0EF8 9001 471A FE17 0623"
+ $"9090 6100 001C FE90 0938 1C19 1903 008C"
+ $"9090 88FD 8E07 3828 1C12 0A05 0100 5B02"
+ $"0000 01FD 0001 0220 E68E 2C41 4E6C 6C72"
+ $"6C72 6C72 6C72 6C72 6C72 726C 726C 726C"
+ $"726C 7272 6C72 6C72 726C 726C 726C 726C"
+ $"726C 726C 726C 725D ED8E 007F E490 038C"
+ $"3D72 8CFE 9004 383C 3E72 6CFD 9000 73FD"
+ $"8E07 3828 1C12 0A05 0100 49FE 0005 0100"
+ $"0100 0222 E48E 0476 3F4B 6C6C FE72 216C"
+ $"726C 726C 7272 6C72 6C72 6C72 6C72 726C"
+ $"726C 7272 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"6CEC 8E00 87D4 9000 7DFD 8E07 3828 1C12"
+ $"0A05 0100 4D08 0000 0100 0100 0002 20E0"
+ $"8E05 5D78 785A 536C FE72 1C6C 7272 6C72"
+ $"6C72 6C72 6C72 726C 726C 7272 6C72 6C72"
+ $"6C72 6C72 6C72 6C48 EC8E 0078 ED8A F889"
+ $"F68A 0365 7873 77FB 8E07 3828 1C12 0A05"
+ $"0100 33FA 0001 0222 DA8E 1F43 6C6C 726C"
+ $"7272 6C72 6C72 6C72 6C72 726C 726C 7272"
+ $"6C72 6C72 6C72 6C72 6C72 50B9 8E07 3828"
+ $"1C12 0A05 0100 3508 0000 0100 0100 0002"
+ $"20D8 8E06 7765 6F4B 606C 6CFE 7212 6C72"
+ $"6C72 726C 726C 7272 6C72 6C72 6C72 6C72"
+ $"6CB8 8E07 3828 1C12 0A05 0100 30FE 0005"
+ $"0100 0100 0222 D48E 1876 4160 6C72 6C72"
+ $"6C72 6C72 726C 726C 7272 6C72 6C72 604B"
+ $"4277 B88E 0738 281C 120A 0501 002A 0200"
+ $"0001 FD00 0102 20D2 8E12 7748 6C72 6C72"
+ $"6C72 6C72 726C 726C 7272 5443 49B4 8E07"
+ $"3828 1C12 0A05 0100 23FD 0004 0100 0002"
+ $"22CF 8E0C 6A5A 5472 6C6C 5352 5A78 786A"
+ $"76B1 8E07 3828 1C12 0A05 0100 1A08 0000"
+ $"0100 0001 0002 20CC 8E01 7758 A98E 0738"
+ $"281C 120A 0501 0016 FE00 0001 FE00 0102"
+ $"2281 8EF2 8E07 3828 1C12 0A05 0100 1708"
+ $"0000 0100 0100 0002 2081 8EF2 8E07 3828"
+ $"1C12 0A05 0100 14FC 0003 0100 0222 818E"
+ $"F28E 0738 281C 120A 0501 00A2 7F00 0001"
+ $"0001 0000 0213 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 201F 2220"
+ $"2220 2220 2220 2220 2220 2220 2220 2220"
+ $"2220 2220 2220 3B25 1F12 0A05 0100 16FE"
+ $"0000 01FE 0001 0208 810A F20A 072E 281F"
+ $"120A 0501 0019 0900 0001 0000 0100 0002"
+ $"0481 06F4 0608 0430 281F 120A 0501 0013"
+ $"FD00 0001 FC00 8102 F302 0738 281F 120A"
+ $"0501 0015 0200 0001 FC00 0001 8100 F200"
+ $"0738 251F 120A 0501 0038 FE00 0501 0001"
+ $"0000 01F8 0000 03FD 0002 1214 07E3 0009"
+ $"0307 080C 1214 112A 2E1F E300 0901 0A0C"
+ $"0C07 0000 1722 1FD3 0007 3828 1C12 0A05"
+ $"0100 4B07 0000 0100 0100 0001 F900 0903"
+ $"2572 2A00 0014 6C6C 11F5 0008 0519 0C00"
+ $"0003 0C0C 01FD 0005 031F 343E 6C72 FC6C"
+ $"0334 2F6C 2FE4 0001 013E FE6C 0522 0000"
+ $"6C72 2FD3 0007 3428 1F12 0A05 0100 97F9"
+ $"002E 0100 0001 0001 0001 126C 7272 0A00"
+ $"3D6C 6C1B 0001 051C 2F25 0B00 0119 6C60"
+ $"6172 1B00 1260 6C6C 470C 0000 0105 6C72"
+ $"6CFA 7261 2F47 6C34 0000 0100 0100 0B1B"
+ $"1A14 0001 0001 000A 0A05 1C1A 0B00 0100"
+ $"0100 0100 013D 6C6C 7272 2F00 056C 6C34"
+ $"0000 0100 0105 1C13 0719 1C13 0300 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0105 0C0A 0100 0100 0100 0100 0100 3828"
+ $"1C12 0A05 0100 A007 0000 0100 0100 0001"
+ $"FD00 0901 0001 0014 7272 6C51 3CFE 720A"
+ $"2500 1F72 6C6C 726C 2E08 25FE 720C 6C1F"
+ $"2F6C 5125 1B51 6C17 0000 05FE 4703 516C"
+ $"726C FE47 1923 6C6C 2A12 1F19 0500 256C"
+ $"726C 7261 2F0A 003E 7272 6C72 6C51 0EFE"
+ $"0044 0100 0019 7272 3822 2522 0007 7272"
+ $"3E23 2F2A 1701 0C6C 726C 6C72 7219 0E28"
+ $"3447 2F1B 070E 473C 1F25 1A2A 342F 0E00"
+ $"0E38 6C6C 7238 0700 0100 0100 0100 0134"
+ $"281F 120A 0501 008B FE00 0801 0001 0000"
+ $"0100 0001 FD00 0213 726C FB72 172F 036C"
+ $"7272 1414 6172 2A28 726C 3E07 1172 6C19"
+ $"0828 7272 3EFB 0008 0C72 726C 0800 0001"
+ $"6CFD 720D 6C6C 0719 382A 2A6C 726C 2E00"
+ $"726C FB72 0804 0001 0000 012A 7228 FC00"
+ $"0305 6C72 6CFE 7203 6C13 0C6C FD72 036C"
+ $"146C 72FE 6C03 726C 236C FC72 FE6C 0808"
+ $"7272 340C 1972 4701 FA00 0738 281C 120A"
+ $"0501 0096 0200 0001 FC00 0001 FD00 2601"
+ $"0000 1372 726C 726C 726C 6C60 0C72 6C19"
+ $"0000 2E72 2F28 6C72 0A00 126C 7272 6C72"
+ $"6C47 1700 0001 FE00 0B05 6C72 7205 0000"
+ $"056C 7272 6CFE 7202 1900 1FFC 720A 6101"
+ $"6C72 7247 1B47 6C72 11FE 0004 0100 2F6C"
+ $"0CFE 0002 0100 07FE 7200 6CFE 7210 280C"
+ $"7272 6C2A 0C11 1F72 380C 0C19 7272 34F8"
+ $"7217 1B72 6C0F 0528 6C6C 0500 0001 0001"
+ $"0000 3428 1F12 0A05 0100 9FFD 0003 0100"
+ $"0001 FE00 6701 0000 0100 1372 6C3E 7272"
+ $"5147 6C72 0A6C 7228 0C19 516C 2A25 7272"
+ $"0000 0E72 726C 512F 3860 1A01 0000 0100"
+ $"0100 6172 7205 0000 0772 726C 2A38 6C72"
+ $"3C08 6172 120C 1F72 6C1A 6172 6C0B 0001"
+ $"4772 1F00 0001 0000 2F6C 3813 131C 2E1F"
+ $"0A6C 726C 1911 6C6C 5101 726C 72FE 001A"
+ $"2372 1900 000B 726C 4672 6014 2E6C 720A"
+ $"2E72 2F6C 7251 7261 383C 11FE 000B 0100"
+ $"0100 3828 1C12 0A05 0100 9C08 0000 0100"
+ $"0001 0000 01FE 0010 0100 0001 1372 7212"
+ $"146C 0A34 726C 0C34 6CFE 7205 6C47 0328"
+ $"6C72 FE00 0813 7272 6C6C 7272 5101 FE00"
+ $"0E01 0000 4772 7205 0000 0B72 6C1B 0005"
+ $"FE72 1105 6C6C 1B3C 726C 723C 4772 7205"
+ $"0000 2572 2EFD 0001 0123 FA72 0C1B 726C"
+ $"2500 001A 726C 1372 7260 FE00 1D19 6C72"
+ $"382A 4F72 722E 7228 000C 726C 001B 722C"
+ $"726C 726C 4751 6C1A 0100 01FE 0008 0134"
+ $"281F 120A 0501 009D FE00 0001 FD00 1D01"
+ $"0000 0100 0100 0011 4747 1100 0300 1F34"
+ $"2F0C 0413 1B1B 1911 0300 1228 25FD 0006"
+ $"081C 2825 2319 08FE 0000 01FE 0008 232F"
+ $"3805 0000 0825 1FFE 002E 1222 1B08 0F38"
+ $"473C 2A51 5728 3838 3403 0000 1728 0B00"
+ $"0001 0000 031B 516C 7260 3823 142F 2A0C"
+ $"0000 012A 280E 4760 2FFE 001A 0314 2F3E"
+ $"4738 1F08 2F72 1900 081B 0F00 1323 0810"
+ $"2A6C 7272 6038 0CFD 000A 0100 0038 281C"
+ $"120A 0501 002F 0700 0001 0001 0000 01FB"
+ $"0000 01DD 0003 0100 0001 DE00 0201 0001"
+ $"EA00 0001 E400 0D01 0001 0001 0034 281F"
+ $"120A 0501 0038 FC00 0801 0000 0100 0001"
+ $"0001 E900 0201 0001 F800 0301 0000 01F8"
+ $"0004 0100 0100 01F9 0000 01F9 0000 01C4"
+ $"0000 01FD 0007 3828 1C12 0A05 0100 A204"
+ $"0000 0100 01FE 0000 01FE 007F 0100 0001"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"0001 0000 0100 0001 0001 0001 0001 0000"
+ $"0100 0100 0001 0001 0001 0001 0000 0100"
+ $"0100 0100 0100 0001 0001 0001 0001 0001"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"0001 0001 0001 0001 0001 0001 0500 0100"
+ $"0100 01FE 000A 0100 0134 281F 120A 0501"
+ $"009C FE00 0001 FE00 0001 FE00 1901 0000"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 01FC 0014 0100 0100 0100"
+ $"0100 0001 0000 0100 0100 0100 0100 01FC"
+ $"005B 0100 0100 0100 0100 0001 0001 0001"
+ $"0001 0000 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 3428 1C11 0A05 0100 3A08"
+ $"0000 0100 0001 0000 01FD 0000 01E9 0002"
+ $"0100 01F8 0003 0100 0001 F800 0401 0001"
+ $"0001 F900 0001 F900 0001 C400 0001 FD00"
+ $"0734 251C 110A 0501 003B FD00 0001 FE00"
+ $"0801 0405 0B0E 1112 1714 EC17 0014 F617"
+ $"0314 1717 14F8 1700 14FE 1700 14F9 1700"
+ $"14F9 1700 14C4 170C 1417 1714 142E 2319"
+ $"1108 0501 0038 0200 0001 FD00 0801 0308"
+ $"0C12 1F23 2A2E EB2F 0034 F62F 0034 F52F"
+ $"0034 FE2F 0034 F92F 0034 F92F 0034 C42F"
+ $"0034 FE2F 082E 251C 190C 0804 0100 30FE"
+ $"000C 0100 0100 0001 050A 0F14 191F 22DF"
+ $"2300 22F1 2300 22F9 2300 22F9 2300 22C4"
+ $"230C 2223 2322 1F1B 1411 0C05 0400 00A1"
+ $"0400 0001 0001 FE00 7F01 0405 0B0F 1112"
+ $"1414 1914 1714 1914 1914 1714 1914 1914"
+ $"1714 1914 1914 1714 1914 1914 1419 1419"
+ $"1414 1914 1914 1714 1914 1914 1714 1914"
+ $"1914 1419 1419 1414 1914 1914 1419 1419"
+ $"1414 1914 1914 1714 1914 1914 1419 1419"
+ $"1414 1914 1914 1419 1419 1414 1914 1914"
+ $"1419 1419 1414 1914 1914 1419 1419 1414"
+ $"1914 1914 1419 1419 140B 1419 1419 1414"
+ $"1914 1914 1419 FD14 0712 0E0C 0804 0100"
+ $"007B FB00 0B01 0001 0105 080A 0C0C 0F0F"
+ $"0EFC 0F00 0EFC 0F00 0EFC 0F00 0EFC 0F00"
+ $"0EFD 0F00 0EFD 0F00 0EFC 0F00 0EFC 0F00"
+ $"0EFD 0F00 0EFD 0F00 0EFD 0F00 0EFD 0F00"
+ $"0EFC 0F00 0EFD 0F00 0EFD 0F00 0EFD 0F00"
+ $"0EFD 0F00 0EFD 0F00 0EFD 0F00 0EFD 0F00"
+ $"0EFD 0F00 0EFD 0F00 0EFD 0F00 0EFD 0F00"
+ $"0EFB 0F08 0C0C 0A08 0501 0100 0087 0400"
+ $"0001 0001 FD00 0601 0103 0505 0807 FE08"
+ $"0207 0807 FD08 0007 FD08 0207 0807 FD08"
+ $"0007 FD08 0007 FD08 0007 FD08 0207 0807"
+ $"FD08 0007 FD08 0007 FD08 0007 FD08 0007"
+ $"FD08 0007 FD08 0207 0807 FD08 0007 FD08"
+ $"0007 FD08 0007 FD08 0007 FD08 0007 FD08"
+ $"0007 FD08 0007 FD08 0007 FD08 0007 FD08"
+ $"0007 FD08 0007 FD08 0007 FE08 0507 0505"
+ $"0401 01FE 0099 FE00 0201 0001 FC00 FD01"
+ $"7F03 0101 0301 0301 0301 0103 0103 0101"
+ $"0301 0301 0301 0103 0103 0101 0301 0301"
+ $"0103 0103 0101 0301 0301 0301 0103 0103"
+ $"0101 0301 0301 0103 0103 0101 0301 0301"
+ $"0103 0103 0101 0301 0301 0301 0103 0103"
+ $"0101 0301 0301 0103 0103 0101 0301 0301"
+ $"0103 0103 0101 0301 0301 0103 0103 0101"
+ $"0301 0301 0103 0103 0101 0301 0301 0103"
+ $"0108 0301 0103 0103 0101 04FD 01FD 0099"
+ $"0200 0001 FE00 0001 FA00 7F01 0001 0100"
+ $"0100 0100 0101 0001 0001 0100 0100 0100"
+ $"0101 0001 0001 0100 0100 0101 0001 0001"
+ $"0100 0100 0100 0101 0001 0001 0100 0100"
+ $"0101 0001 0001 0100 0100 0101 0001 0001"
+ $"0100 0100 0100 0101 0001 0001 0100 0100"
+ $"0101 0001 0001 0100 0100 0101 0001 0001"
+ $"0100 0100 0101 0001 0001 0100 0100 0101"
+ $"0001 0001 0100 0100 0101 000A 0100 0101"
+ $"0001 0001 0100 01FA 0010 FD00 0501 0000"
+ $"0100 0181 00ED 0001 0100 150B 0000 0100"
+ $"0001 0000 0100 0001 8100 F000 0201 0000"
+ $"00FF"
+};
+/*
+ * Here is the custom file open dialog. This dialog is used instead of
+ * the default file dialog if the -filetypes flag is specified.
+ */
+
+resource 'DLOG' (130, purgeable) {
+ {0, 0, 195, 344}, dBoxProc, invisible, noGoAway, 0,
+ 130, ""
+};
+
+resource 'DITL' (130, "File Open Box", purgeable) {
+ {
+ {135, 252, 155, 332}, Button {enabled, "Open"},
+ {104, 252, 124, 332}, Button {enabled, "Cancel"},
+ { 0, 0, 0, 0}, HelpItem {disabled, HMScanhdlg {130}},
+ { 8, 235, 24, 337}, UserItem {enabled},
+ { 32, 252, 52, 332}, Button {enabled, "Eject"},
+ { 60, 252, 80, 332}, Button {enabled, "Desktop"},
+ { 29, 12, 159, 230}, UserItem {enabled},
+ { 6, 12, 25, 230}, UserItem {enabled},
+ { 91, 251, 92, 333}, Picture {disabled, 11},
+ {168, 20, 187, 300}, Control {enabled, 131}
+ }
+};
+
+resource 'CNTL' (131, "File Types menu", purgeable) {
+ {168, 20, 187, 300},
+ popupTitleLeftJust,
+ visible,
+ 80,
+ 132,
+ popupMenuCDEFProc,
+ 0,
+ "File Type:"
+};
+
+
+resource 'MENU' (132, preload) {
+ 132,
+ textMenuProc,
+ 0xFFFF, enabled, "", {}
+};
diff --git a/itcl/itk/mac/itkMacLibrary.r b/itcl/itk/mac/itkMacLibrary.r
new file mode 100644
index 00000000000..5b82cf8fea8
--- /dev/null
+++ b/itcl/itk/mac/itkMacLibrary.r
@@ -0,0 +1,94 @@
+/*
+ * 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.5 96/10/03 17:54:21
+ */
+
+#include <Types.r>
+#include <SysTypes.r>
+#include <AEUserTermTypes.r>
+
+/*
+ * The folowing include and defines help construct
+ * the version string for Tcl.
+ */
+
+#define RESOURCE_INCLUDED
+#include <tcl.h>
+#include <tk.h>
+#include "itcl.h"
+#include "itk.h"
+
+#if (TK_RELEASE_LEVEL == 0)
+# define RELEASE_LEVEL alpha
+#elif (TK_RELEASE_LEVEL == 1)
+# define RELEASE_LEVEL beta
+#elif (TK_RELEASE_LEVEL == 2)
+# define RELEASE_LEVEL final
+#endif
+
+#if (TK_RELEASE_LEVEL == 2)
+# define MINOR_VERSION (ITCL_MINOR_VERSION * 16) + TK_RELEASE_SERIAL
+#else
+# define MINOR_VERSION ITCL_MINOR_VERSION * 16
+#endif
+
+#define RELEASE_CODE 0x00
+
+#define ITCL_LIBRARY_RESOURCES 3000
+#define ITK_LIBRARY_RESOURCES 3500
+
+resource 'vers' (1) {
+ ITCL_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ ITK_PATCH_LEVEL,
+ ITK_PATCH_LEVEL ", by Michael McLennan © 1993-1998" "\n" "Lucent Technologies, Inc."
+};
+
+resource 'vers' (2) {
+ ITCL_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ ITK_PATCH_LEVEL,
+ "ItkWish " ITK_PATCH_LEVEL " © 1993-1998"
+};
+
+
+#define ITCL_LIBRARY_RESOURCES 2000
+#define ITK_LIBRARY_RESOURCES 3500
+/*
+ * The -16397 string will be displayed by Finder when a user
+ * tries to open the shared library. The string should
+ * give the user a little detail about the library's capabilities
+ * and enough information to install the library in the correct location.
+ * A similar string should be placed in all shared libraries.
+ */
+resource 'STR ' (-16397, purgeable) {
+ "Itk Library\n\n"
+ "This is the library needed to run add Itcl to the Tcl/Tk shell. "
+ "To work properly, it should be placed in the ŒTool Command Language¹ folder "
+ "within the Extensions folder."
+};
+
+
+/*
+ * We now load the Tk library into the resource fork of the library.
+ */
+
+#include "itkMacTclCode.r"
+
+read 'TEXT' (ITK_LIBRARY_RESOURCES+12, "itk:tclIndex", purgeable)
+ "::mac:tclIndex";
+data 'TEXT' (ITK_LIBRARY_RESOURCES+13,"pkgIndex",purgeable, preload) {
+ "# Tcl package index file, version 1.0\n"
+ "package ifneeded Itk 3.0 [list package require Itcl 3.0 \; load [file join $dir itk30[info sharedlibextension]] Itk \; source -rsrc itk:tclIndex]\n"
+};
+
diff --git a/itcl/itk/mac/itkMacResource.r b/itcl/itk/mac/itkMacResource.r
new file mode 100644
index 00000000000..88c4f808591
--- /dev/null
+++ b/itcl/itk/mac/itkMacResource.r
@@ -0,0 +1,1376 @@
+/*
+ * 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.5 96/10/03 17:54:21
+ */
+
+#include <Types.r>
+#include <SysTypes.r>
+#include <AEUserTermTypes.r>
+
+/*
+ * The folowing include and defines help construct
+ * the version string for Tcl.
+ */
+
+#define RESOURCE_INCLUDED
+#include "tcl.h"
+#include "tk.h"
+#include "itcl.h"
+#include "itkPatch.h"
+
+#if (TK_RELEASE_LEVEL == 0)
+# define RELEASE_LEVEL alpha
+#elif (TK_RELEASE_LEVEL == 1)
+# define RELEASE_LEVEL beta
+#elif (TK_RELEASE_LEVEL == 2)
+# define RELEASE_LEVEL final
+#endif
+
+#if (TK_RELEASE_LEVEL == 2)
+# define MINOR_VERSION (ITCL_MINOR_VERSION * 16) + TK_RELEASE_SERIAL
+#else
+# define MINOR_VERSION ITCL_MINOR_VERSION * 16
+#endif
+
+#define RELEASE_CODE 0x00
+
+#define ITCL_LIBRARY_RESOURCES 3000
+#define ITK_LIBRARY_RESOURCES 3500
+
+resource 'vers' (1) {
+ ITCL_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ ITK_PATCH_LEVEL,
+ ITK_PATCH_LEVEL ", by Michael McLennan © 1993-1998" "\n" "Lucent Technologies, Inc."
+};
+
+resource 'vers' (2) {
+ ITCL_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ ITK_PATCH_LEVEL,
+ "ItkWish " ITK_PATCH_LEVEL " © 1993-1998"
+};
+
+
+
+/*
+ * The mechanisim below loads Tcl source into the resource fork of the
+ * application. The example below creates a TEXT resource named
+ * "Init" from the file "init.tcl". This allows applications to use
+ * Tcl to define the behavior of the application without having to
+ * 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, "tk", purgeable, preload) "::library:tk.tcl";
+read 'TEXT' (2, "button", purgeable, preload) "::library:button.tcl";
+read 'TEXT' (3, "dialog", purgeable, preload) "::library:dialog.tcl";
+read 'TEXT' (4, "entry", purgeable, preload) "::library:entry.tcl";
+read 'TEXT' (5, "focus", purgeable, preload) "::library:focus.tcl";
+read 'TEXT' (6, "listbox", purgeable, preload) "::library:listbox.tcl";
+read 'TEXT' (7, "menu", purgeable, preload) "::library:menu.tcl";
+read 'TEXT' (8, "optionMenu", purgeable, preload) "::library:optMenu.tcl";
+read 'TEXT' (9, "palette", purgeable, preload) "::library:palette.tcl";
+read 'TEXT' (10, "scale", purgeable, preload) "::library:scale.tcl";
+read 'TEXT' (11, "scrollbar", purgeable, preload) "::library:scrlbar.tcl";
+read 'TEXT' (12, "tearoff", purgeable, preload) "::library:tearoff.tcl";
+read 'TEXT' (13, "text", purgeable, preload) "::library:text.tcl";
+read 'TEXT' (14, "tkerror", purgeable, preload) "::library:bgerror.tcl";
+read 'TEXT' (15, "Console", purgeable, preload) "::library:console.tcl";
+read 'TEXT' (16, "msgbox", purgeable, preload) "::library:msgbox.tcl";
+read 'TEXT' (17, "comdlg", purgeable, preload) "::library:comdlg.tcl";
+read 'TEXT' (18, "prolog", purgeable, preload) "::library:prolog.ps";
+
+/*
+ * We now load the Itk library into the resource fork of the application.
+ */
+
+read 'TEXT' (ITCL_LIBRARY_RESOURCES, "itcl", purgeable)
+ ":::itcl:library:itcl.tcl";
+read 'TEXT' (ITK_LIBRARY_RESOURCES+1, "itk", purgeable)
+ "::library:itk.tcl";
+read 'TEXT' (ITK_LIBRARY_RESOURCES+2, "Itk_tclIndex", purgeable)
+ "::mac:tclIndex";
+read 'TEXT' (ITK_LIBRARY_RESOURCES+3, "Itk_Archetype", purgeable)
+ "::library:Archetype.itk";
+read 'TEXT' (ITK_LIBRARY_RESOURCES+4, "Itk_Widget", purgeable)
+ "::library:Widget.itk";
+read 'TEXT' (ITK_LIBRARY_RESOURCES+5, "Itk_Toplevel", purgeable)
+ "::library:Toplevel.itk";
+
+
+/*
+ * 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
+ * the resource must be of the form "KEYWORD=SOME STRING". See Tcl
+ * documentation for futher information about the env variable.
+ */
+
+/* A good example of something you may want to set is:
+ * "TCL_LIBRARY=My disk:etc."
+ */
+
+resource 'STR#' (128, "Tcl Environment Variables") {
+ { "SCHEDULE_NAME=Agent Controller Schedule",
+ "SCHEDULE_PATH=Lozoya:System Folder:Tcl Lib:Tcl-Scheduler"
+ };
+};
+
+
+/*
+ * The following resources defines the Apple Events that Tk can be
+ * sent from Apple Script.
+ */
+
+resource 'aete' (0, "Wish Suite") {
+ 0x01, 0x00, english, roman,
+ {
+ "Required Suite",
+ "Events that every application should support",
+ 'reqd', 1, 1,
+ {},
+ {},
+ {},
+ {},
+
+ "Wish Suite", "Events for the Wish application", 'WIsH', 1, 1,
+ {
+ "do script", "Execute a Tcl script", 'misc', 'dosc',
+ 'TEXT', "Result", replyOptional, singleItem,
+ notEnumerated, reserved, reserved, reserved, reserved,
+ reserved, reserved, reserved, reserved, reserved,
+ reserved, reserved, reserved, reserved,
+ 'TEXT', "Script to execute", directParamRequired,
+ singleItem, notEnumerated, changesState, reserved,
+ reserved, reserved, reserved, reserved, reserved,
+ reserved, reserved, reserved, reserved, reserved,
+ reserved,
+ {},
+ },
+ {},
+ {},
+ {},
+ }
+};
+
+/*
+ * 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
+ * create and manage an About Dialog box.
+ */
+data 'DLOG' (128, "Default About Box", purgeable) {
+ $"002E 0026 011B 01E0 0001 0100 0100 0000"
+ $"0000 0081 00"
+};
+
+
+resource 'DITL' (129, "About Box", purgeable) {
+ {
+ {198, 278, 220, 362}, Button {enabled, "Ok"},
+ { 21, 205, 181, 442}, StaticText {disabled,
+ "ItkWish" ITK_PATCH_LEVEL " - an Object-Oriented Wish"
+ "\n\n" "Michael McLennan"
+ "\n" "Jim Ingham" "\n" "Lee Bernhard" "\n\n"
+ "©Lucent Technologies, Inc. 1993-1998" "\n\n" "For more Info, see:" "\n"
+ "http://www.tcltk.com/itcl"},
+ { 37, 22, 204, 182}, Picture {enabled, 128}
+ }
+};
+
+data 'PICT' (128) {
+ $"46B2 0000 0000 00A7 00A0 0011 02FF 0C00"
+ $"FFFE 0000 0048 0000 0048 0000 0000 0000"
+ $"00A7 00A0 0000 0000 001E 0001 000A 0000"
+ $"0000 00A7 00A0 0099 80A0 0000 0000 00A7"
+ $"00A0 0000 0000 0000 0000 0048 0000 0048"
+ $"0000 0000 0008 0001 0008 0000 0000 0157"
+ $"9668 0000 0000 0000 8746 8000 00FF 0004"
+ $"F800 FC00 F800 0066 F800 F800 F800 015D"
+ $"F000 F400 F000 0000 F000 F000 F000 0000"
+ $"E800 EC00 E800 01C1 E800 E800 E800 0000"
+ $"E000 E400 E000 011E E000 E000 E000 01C3"
+ $"D800 DC00 D800 0000 D800 D800 D800 0000"
+ $"D000 D400 D000 0000 D000 D000 D000 0000"
+ $"C800 C800 C800 0000 C000 C400 C000 0000"
+ $"C000 C000 C000 0000 B800 BC00 B800 0000"
+ $"B800 B800 B800 0000 B000 B400 B000 0000"
+ $"B000 B000 B000 0000 A800 AC00 A800 0000"
+ $"A800 A800 A800 0000 A000 A400 A000 0000"
+ $"A000 A000 9800 0000 A000 A000 A000 0000"
+ $"9800 9C00 9800 0000 9800 9800 9800 0000"
+ $"9000 9400 9000 0000 8800 8C00 8800 0000"
+ $"8800 8800 8800 0000 8800 8400 8000 0000"
+ $"8800 A000 5800 0000 8000 8400 8000 0000"
+ $"8000 9C00 5800 0000 7800 8C00 6000 0000"
+ $"7800 7C00 7800 0000 7800 7800 7800 0000"
+ $"7000 8000 6000 0000 7000 7400 7000 0000"
+ $"7000 7000 6800 0000 7000 7800 5800 0000"
+ $"6800 6C00 6800 0000 6800 6800 6800 0000"
+ $"6000 6400 6000 0000 6000 6C00 5000 0000"
+ $"6000 6000 6000 0000 5800 6400 5000 0000"
+ $"5800 5C00 5800 0000 5800 5800 5800 0000"
+ $"5000 5400 5000 0000 5000 9800 4000 0000"
+ $"5000 5400 4800 0000 5000 A800 4000 0000"
+ $"5000 5000 5000 0000 5000 8800 4000 0000"
+ $"5000 B400 3800 0000 4800 7C00 4000 0000"
+ $"4800 4C00 4800 0000 4800 4800 4800 0000"
+ $"4800 C000 3000 0000 4800 6C00 4000 0000"
+ $"4000 4800 4000 0000 4000 4400 4000 0000"
+ $"4000 4000 4000 0000 4000 9000 3800 0000"
+ $"4000 CC00 2800 0000 4000 8400 3800 0000"
+ $"4000 9800 3000 0000 4000 7400 3800 0000"
+ $"4000 5C00 3800 0000 3800 8000 3800 0000"
+ $"3800 3C00 3800 0000 3800 3800 3800 0000"
+ $"3800 6400 3800 0000 3800 A800 3000 0000"
+ $"3800 3800 3000 0000 3800 5000 3000 0000"
+ $"3800 C400 2800 0000 3000 D800 2000 0000"
+ $"3000 4800 3000 0000 3000 3400 3000 0000"
+ $"3000 BC00 2800 0000 3000 3000 3000 0000"
+ $"3000 4400 3000 0000 2800 2C00 2800 0000"
+ $"2800 3800 2800 0000 2800 E400 1800 0000"
+ $"2800 A800 2000 0000 2800 2800 2800 0000"
+ $"2800 CC00 2000 0000 2800 AC00 2000 4D61"
+ $"2800 7000 2000 015D 2800 3800 2000 0001"
+ $"2000 2C00 2000 015D 2000 D400 1800 0000"
+ $"2000 B000 2000 015A 2000 9C00 1800 015A"
+ $"2000 2400 2000 0000 2000 2000 2000 0003"
+ $"2000 D800 1800 0066 2000 4C00 1800 025B"
+ $"2000 B800 1800 0000 2000 A800 1800 0010"
+ $"2000 8C00 2000 015D 2000 B400 1800 0000"
+ $"1800 EC00 1000 0000 1800 E800 1000 015D"
+ $"1800 C000 1800 0000 1800 3800 1800 0000"
+ $"1800 1C00 1800 0000 1800 DC00 1800 0000"
+ $"1800 8C00 1800 7400 1800 7400 1800 0159"
+ $"1800 E000 1000 0000 1800 2C00 1000 0003"
+ $"1800 1800 1800 0066 1800 CC00 1000 015D"
+ $"1800 E400 1000 0004 1000 EC00 1000 0066"
+ $"1000 F000 0800 015D 1000 E400 1000 0000"
+ $"1000 9000 1000 0000 1000 2400 1000 01C1"
+ $"1000 EC00 0800 0000 1000 3400 1000 011E"
+ $"1000 E800 0800 01C3 1000 E000 1000 0000"
+ $"1000 4C00 1000 0000 1000 2000 1000 0000"
+ $"1000 1000 1000 0000 1000 5C00 1000 0000"
+ $"1000 5800 1000 0000 1000 1000 0800 0000"
+ $"1000 6400 1000 0000 0800 F400 0000 0000"
+ $"0800 7000 0800 0000 0800 1400 0800 0000"
+ $"0800 F400 0800 0000 0800 8000 0800 0000"
+ $"0800 8800 0800 0000 0800 EC00 0800 0000"
+ $"0800 0800 0800 0000 0000 F400 0000 0000"
+ $"0000 FC00 0000 0000 0000 F800 0000 0000"
+ $"0000 0400 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 5845"
+ $"0000 0000 0000 015C 0000 0000 0000 0001"
+ $"0000 0000 0000 015D 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0D09"
+ $"0000 0000 0000 0000 0000 0000 0000 055E"
+ $"0000 0000 0000 0106 0000 0000 0000 0054"
+ $"0000 0000 0000 013B 0000 0000 0000 20F9"
+ $"0000 0000 0000 005C 0000 0000 0000 0002"
+ $"0000 0000 0000 20FC 0000 0000 0000 0064"
+ $"0000 0000 0000 00E5 0000 0000 0000 015D"
+ $"0000 0000 0000 0000 0000 0000 0000 067E"
+ $"0000 0000 0000 0159 0000 0000 0000 0000"
+ $"0000 0000 0000 0003 0000 0000 0000 0066"
+ $"0000 0000 0000 015D 0000 0000 0000 0004"
+ $"0000 0000 0000 0066 0000 0000 0000 015D"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 015D 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 5400"
+ $"0000 0000 0000 6F64 0000 0000 0000 6573"
+ $"0000 0000 0000 4B65 0000 0000 0000 0000"
+ $"0000 0000 0000 5074 0000 0000 0000 4572"
+ $"0000 0000 0000 646C 0000 0000 0000 6972"
+ $"0000 0000 0000 6573 0000 0000 0000 7374"
+ $"0000 0000 0000 7400 0000 0000 0000 7200"
+ $"0000 0000 0000 7243 0000 0000 0000 6572"
+ $"0000 0000 0000 6300 0000 0000 0000 6E74"
+ $"0000 0000 0000 3064 0000 0000 0000 6F75"
+ $"0000 0000 0000 6F6D 0000 0000 0000 0002"
+ $"0000 0000 0000 6E64 0000 0000 0000 636F"
+ $"0000 0000 0000 6572 0000 0000 0000 6567"
+ $"0000 0000 0000 726F 0000 0000 0000 0720"
+ $"0000 0000 0000 6550 0000 0000 0000 7900"
+ $"0000 0000 0000 6374 0000 0000 0000 6F50"
+ $"0000 0000 0000 6B53 0000 0000 0000 6F6E"
+ $"0000 0000 0000 E86D 0000 0000 0000 6541"
+ $"0000 0000 0000 696E 0000 0000 0000 0003"
+ $"0000 0000 0000 7473 0000 0000 0000 1E74"
+ $"0000 0000 0000 6D70 0000 0000 0000 D274"
+ $"0000 0000 0000 6D00 0000 0000 0000 6F75"
+ $"0000 0000 0000 4174 0000 0000 0000 7070"
+ $"0000 0000 0000 6F6E 0000 0000 0000 CD77"
+ $"0000 0000 0000 746F 0000 0000 0000 0000"
+ $"0000 00A7 00A0 0000 0000 00A7 00A0 0000"
+ $"000A 0000 0000 00A7 00A0 0481 00E1 0004"
+ $"8100 E100 A27F 0000 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 1F01 0001 0001 0001 0001"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"0001 0001 0001 009F FE00 7F01 0001 0001"
+ $"0C22 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2018 2220 2220"
+ $"2220 2220 2220 2220 2220 2220 2220 2220"
+ $"2208 0001 01FD 0014 0200 0001 FC00 0020"
+ $"818E F28E 0408 0606 0101 FE00 15FD 0000"
+ $"01FE 0000 2281 8EF2 8E07 0C0A 0805 0101"
+ $"0000 1708 0000 0100 0001 0002 2081 8EF2"
+ $"8E07 1411 0C0A 0501 0100 16FE 0000 01FE"
+ $"0001 0222 818E F28E 071F 1912 0C05 0401"
+ $"0017 0800 0001 0001 0000 0220 818E F28E"
+ $"0728 1F19 0F08 0501 0014 FC00 0301 0002"
+ $"2281 8EF2 8E07 2F23 1B11 0905 0100 1708"
+ $"0000 0100 0100 0002 2081 8EF2 8E07 2F28"
+ $"1B11 0A05 0100 27FE 0000 01FE 0001 0222"
+ $"C58E 0F5D 6578 6F5A 5254 5254 524E 5A78"
+ $"7867 77BE 8E07 3828 1F12 0A05 0100 2B08"
+ $"0000 0100 0001 0002 20C8 8E01 584B FD6C"
+ $"0172 72FB 6C08 726C 726C 7260 4549 6DC2"
+ $"8E07 3828 1C12 0A05 0100 26FD 0004 0100"
+ $"0002 22CA 8E03 5060 6C6C F172 086C 726C"
+ $"726C 7253 4449 C68E 0738 281C 120A 0501"
+ $"0042 0200 0001 FD00 0102 20D3 8E21 5D78"
+ $"5A4B 7868 6A66 6072 6C72 6C72 6C6C 3E22"
+ $"1912 1213 141B 2547 726C 7272 6C72 6C72"
+ $"FE6C 0572 6C54 6F65 77CB 8E07 3828 1C12"
+ $"0A05 0100 3AFE 0005 0100 0100 0222 D58E"
+ $"0250 5472 FC6C FC72 046C 726C 6C0C F700"
+ $"0708 236C 6C72 6C72 6CFE 7207 6C72 6C72"
+ $"6C72 545D CD8E 0738 281C 120A 0501 0047"
+ $"0800 0001 0001 0000 0220 D98E 175D 6563"
+ $"6C6C 726C 7260 3D60 6C72 726C 726C 726C"
+ $"7272 471B 05F7 0013 081C 3872 6C72 6C72"
+ $"6C72 6C72 6C72 6C72 6C4E 7877 D08E 0738"
+ $"281C 120A 0501 0049 FA00 0102 22DA 8E01"
+ $"5A72 FE6C 0E72 6C3E 0F01 0007 3E72 6C72"
+ $"6C72 6C72 FE6C 0972 610C 0100 0100 0100"
+ $"01FC 0011 1B72 6C72 6C72 6C72 281B 5172"
+ $"6C72 6C72 6C41 D18E 0738 281C 120A 0501"
+ $"0049 0800 0001 0001 0000 0220 DC8E 085D"
+ $"536C 7272 6C6C 3E0F FC00 0301 0C51 6CFE"
+ $"7200 6CFD 7203 6C72 2E03 F700 1201 1B6C"
+ $"7272 6C72 6C60 0800 2351 6C72 726C 725A"
+ $"D28E 0738 281C 120A 0501 004E FE00 0501"
+ $"0001 0002 22DE 8E08 676F 606C 7251 2A14"
+ $"04F8 0008 0419 386C 7272 6C72 6CFD 7208"
+ $"4719 0300 0100 0100 01FD 0002 1051 6CFD"
+ $"720C 6C12 0001 122E 6072 6C72 536F 75D5"
+ $"8E07 3828 1C12 0A05 0100 5202 0000 01FD"
+ $"0001 0220 DF8E 065A 6C72 6C72 1F01 FB00"
+ $"0201 0001 FB00 020C 476C FE72 026C 726C"
+ $"FE72 016C 0EFE 0002 0100 01FD 0004 012A"
+ $"6C72 6CFE 7200 11FE 0007 0138 7272 6C6C"
+ $"5377 D68E 0738 281C 120A 0501 0056 FD00"
+ $"0401 0000 0222 E28E 0776 7854 6C72 6C22"
+ $"05FB 0007 0100 0001 0001 0001 FD00 0E01"
+ $"122E 6072 726C 726C 726C 726C 1F07 FC00"
+ $"0001 FD00 131F 7272 6C72 6C72 2804 0000"
+ $"0119 3E6C 6C72 724B 73D8 8E07 3828 1C12"
+ $"0A05 0100 5608 0000 0100 0001 0002 20E2"
+ $"8E05 4B6C 6C72 2A01 FB00 0301 0000 01FD"
+ $"0000 01F9 001A 0138 7272 6C72 6C72 6C72"
+ $"7246 0100 0100 0100 0001 0000 0122 7272"
+ $"6CFE 7200 2AFD 0003 033E 7272 FE6C 0050"
+ $"D98E 0738 281C 120A 0501 0059 FE00 0001"
+ $"FE00 0102 22E3 8E05 4E6C 6C72 2801 FB00"
+ $"0701 0001 0000 0100 01FE 0002 0100 01FB"
+ $"0010 2E72 726C 726C 726C 7272 5108 0001"
+ $"0000 01FD 0008 0123 6C72 6C72 6C6C 07FD"
+ $"0007 0123 6C72 6C72 6C5D DA8E 0738 281C"
+ $"120A 0501 0061 0800 0001 0001 0000 0220"
+ $"E58E 0667 6372 6C2E 1901 FE00 0201 0001"
+ $"FD00 0E01 0000 0100 0100 0100 0100 0001"
+ $"0001 FE00 0C0F 2F6C 7272 6C72 6C72 726C"
+ $"1A01 FD00 0001 FD00 0728 6C72 6C72 6C6C"
+ $"1AFC 0007 1251 6C72 7253 7876 DC8E 0738"
+ $"281C 120A 0501 005C FC00 0301 0002 22E7"
+ $"8E05 6D60 7272 6C14 FC00 0901 0001 0001"
+ $"0001 0000 01FD 0000 01FD 0002 0100 01FB"
+ $"0006 0760 6C72 6C72 6CFE 7206 3D01 0001"
+ $"0000 01FD 0003 6072 726C FE72 000C FC00"
+ $"0203 2872 FE6C 0160 76DD 8E07 3828 1C12"
+ $"0A05 0100 6708 0000 0100 0100 0002 20EC"
+ $"8E09 4B60 6D8E 8E54 6C6C 600C FC00 0001"
+ $"FC00 0701 0001 0000 0100 01FE 0002 0100"
+ $"01FD 0000 01FC 0006 106C 7272 6C72 6CFE"
+ $"7206 4703 0000 0100 01FE 000A 076C 7272"
+ $"6C72 6C1C 0000 01FE 0006 0134 726C 726C"
+ $"5ADD 8E07 3828 1C12 0A05 0100 66FE 0000"
+ $"01FE 0001 0222 ED8E 0449 6C6C 495A FE6C"
+ $"012A 0BFD 0000 01FE 0002 0100 01FD 0012"
+ $"0100 0001 0001 0001 0001 0000 0100 0100"
+ $"0100 01FE 000B 091F 6C72 6C72 6C72 726C"
+ $"3803 F900 071F 726C 726C 7247 01FB 0002"
+ $"0422 6CFE 7201 5A6D DF8E 0738 281C 120A"
+ $"0501 006D 0800 0001 0000 0100 0220 ED8E"
+ $"0049 FD6C 0272 5108 FD00 0E01 0000 0100"
+ $"0100 0100 0100 0100 0001 FD00 0001 FD00"
+ $"0201 0001 FE00 0201 0001 FD00 1E17 6C72"
+ $"6C72 6C72 726C 6109 0000 0100 0100 0001"
+ $"516C 7272 6C6C 2300 0001 0001 FE00 061F"
+ $"726C 7272 6C5D E08E 0738 281C 120A 0501"
+ $"0065 FD00 0401 0000 0222 ED8E 0149 6CFE"
+ $"7201 380C FD00 0501 0001 0000 01FC 0007"
+ $"0100 0100 0001 0001 FE00 0201 0001 FD00"
+ $"0001 F800 0110 4FFE 7208 6C72 726C 3D05"
+ $"0000 01FD 000A 0B6C 726C 7272 6C05 0000"
+ $"01FD 0007 0119 516C 6C72 546A E18E 0738"
+ $"281C 120A 0501 0070 0200 0001 FD00 0102"
+ $"20ED 8E05 4372 6C6C 1B01 FE00 0001 FE00"
+ $"0701 0001 0000 0100 01FD 0016 0100 0001"
+ $"0001 0001 0001 0000 0100 0100 0100 0100"
+ $"0100 01FE 0005 1072 6C72 726C FE72 0160"
+ $"07FE 0000 01FE 0006 5172 726C 726C 12FD"
+ $"0000 01FD 0006 0157 726C 726C 6DE2 8E07"
+ $"3828 1C12 0A05 0100 6DFE 0005 0100 0100"
+ $"0222 EE8E 0449 6C72 722A FB00 1001 0001"
+ $"5146 1901 0000 0100 0100 0100 0001 FD00"
+ $"0001 FD00 0201 0001 FE00 0401 0001 0001"
+ $"FD00 1E01 2272 6C72 726C 726C 7247 0000"
+ $"0100 0100 0051 6C72 726C 7212 0000 0100"
+ $"0001 FD00 0019 FE72 016C 5AE2 8E07 3828"
+ $"1C12 0A05 0100 6D08 0000 0100 0100 0002"
+ $"20EF 8E05 656C 726C 7204 FD00 0901 0000"
+ $"0100 5772 6C72 0AFD 0007 0100 0100 0001"
+ $"0001 FE00 0201 0001 FD00 0001 FA00 0001"
+ $"FD00 0812 6C6C 7272 6C72 7251 FB00 0301"
+ $"5772 6CFE 7200 12FE 0000 01FE 0000 01FE"
+ $"0006 1951 6C72 725A 76E4 8E07 3828 1C12"
+ $"0A05 0100 73FA 0001 0222 F08E 0550 6C72"
+ $"6C72 6CFE 0006 0100 0001 0000 01FE 7204"
+ $"6C0C 0000 01FD 0018 0100 0001 0001 0001"
+ $"0001 0000 0100 0100 0100 0100 0100 0100"
+ $"01FD 001E 2572 726C 726C 6C57 0000 0100"
+ $"0100 016C 7272 6C72 7211 0000 0100 0100"
+ $"0100 01FE 0006 0157 6C72 7260 76E5 8E07"
+ $"3828 1C12 0A05 0100 6E08 0000 0100 0100"
+ $"0002 20F1 8E06 416C 726C 726C 72FD 000A"
+ $"0100 0001 0001 7272 6C72 0BFE 0005 0100"
+ $"0100 0001 FD00 0001 FD00 0201 0001 FE00"
+ $"0401 0001 0001 FA00 071B 726C 726C 7272"
+ $"51FE 000A 0100 0107 726C 7272 6C72 0CFC"
+ $"0000 01FA 0005 1A72 726C 7278 E58E 0738"
+ $"281C 120A 0501 0077 FE00 0501 0001 0002"
+ $"22F2 8E11 5D6C 726C 4E6A 6C6C 0A00 0001"
+ $"0001 0000 0101 FE72 0D6C 0C00 0001 0001"
+ $"0001 0000 0100 01FE 0002 0100 01FD 0000"
+ $"01FA 0010 0100 0100 0100 1072 726C 726C"
+ $"7251 0000 01FE 001B 236C 726C 7272 6C01"
+ $"0000 0100 0100 0001 0001 0001 0001 1F72"
+ $"726C 6064 E68E 0738 281C 120A 0501 0073"
+ $"0200 0001 FD00 0102 20F1 8E07 4B6C 5A8E"
+ $"8E60 720C FC00 0801 0000 0172 726C 720C"
+ $"FA00 2401 0000 0100 0100 0100 0100 0001"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"096C 7272 6C72 6C57 FD00 0201 0047 FE72"
+ $"026C 7251 FD00 0701 0000 0100 0100 01FD"
+ $"0001 2572 FE6C 0049 E78E 0738 281C 120A"
+ $"0501 006F FD00 0401 0000 0222 F18E 1076"
+ $"7877 8E8E 606C 0B00 0001 0001 0001 0001"
+ $"FE72 0A6C 0B00 0001 0001 0001 0001 FD00"
+ $"0001 FD00 0201 0001 FE00 0401 0001 0001"
+ $"F900 1372 6C72 726C 722A 0000 0100 0005"
+ $"6C72 6C72 726C 23FE 0003 0100 0001 F800"
+ $"0005 FE72 026C 6C6A E88E 0738 281C 120A"
+ $"0501 0074 0800 0001 0000 0100 0220 EC8E"
+ $"0254 6C0F FE00 0001 FE00 0601 0172 726C"
+ $"720C FE00 0201 0001 FE00 0201 0001 FE00"
+ $"0201 0001 FD00 0001 FA00 0D01 0001 0001"
+ $"0000 7272 6C72 726C 19FE 0020 0100 1172"
+ $"6C72 6C72 7208 0000 0100 0001 0000 0100"
+ $"0100 0100 0100 1972 726C 726C 5AE8 8E07"
+ $"3828 1C12 0A05 0100 76FE 0000 01FE 0001"
+ $"0222 EC8E 0B52 6C12 0000 0100 0001 0000"
+ $"01FE 7204 6C0C 0000 01FD 0031 0100 0001"
+ $"0001 0001 0001 0000 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0001 6C72 726C 7272"
+ $"0100 0001 0000 196C 726C 726C 6C01 FD00"
+ $"1201 0000 0100 0100 0100 0100 0134 6C72"
+ $"726C 7278 E88E 0738 281C 120A 0501 006B"
+ $"0800 0001 0001 0000 0220 EC8E 1052 6C13"
+ $"0001 0000 0100 0100 0172 726C 720B FD00"
+ $"0401 0001 0001 FD00 0001 FD00 0201 0001"
+ $"FE00 0401 0001 0001 F900 0672 6C72 726C"
+ $"3801 FD00 0701 1C72 6057 473D 28FE 0000"
+ $"01FE 0000 01F9 0007 1C6C 726C 6054 5276"
+ $"E88E 0738 281C 120A 0501 006A FC00 0301"
+ $"0002 22EC 8E02 5A72 17FE 0000 01FE 0001"
+ $"0101 FE72 076C 0C00 0001 0000 01FE 0002"
+ $"0100 01FE 0002 0100 01FD 0000 01FA 000C"
+ $"0100 0100 0100 0572 726C 7272 12FE 0002"
+ $"0100 00FE 01FB 0012 0100 0100 0100 0001"
+ $"0001 0001 000C 7272 6C72 78E5 8E07 3828"
+ $"1C12 0A05 0100 7008 0000 0100 0100 0002"
+ $"20EC 8E10 4B6C 1900 0001 0000 0100 0001"
+ $"7272 6C72 0CFE 0000 01FE 0028 0100 0001"
+ $"0001 0001 0001 0000 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 000B 726C 3E2F 1201"
+ $"0000 0100 01F8 0000 01FE 000A 0100 0001"
+ $"0001 0001 0001 1FFE 7201 6C77 E58E 0738"
+ $"281C 120A 0501 005F FE00 0001 FE00 0102"
+ $"22EC 8E02 6F6C 1BFD 0004 0100 0100 01FE"
+ $"720A 6C0B 0000 0100 0100 0100 01FD 0000"
+ $"01FD 0002 0100 01FE 0004 0100 0100 01FB"
+ $"0003 0101 0001 F200 0501 0001 0000 01FE"
+ $"0000 01FB 0005 0C60 726C 545D E48E 0738"
+ $"281C 120A 0501 0066 0800 0001 0000 0100"
+ $"0220 EC8E 0578 721C 0000 01FD 0006 0101"
+ $"7272 6C72 0CFC 0000 01FE 0002 0100 01FE"
+ $"0002 0100 01FD 0000 01FA 0004 0100 0100"
+ $"01F8 001E 0100 0100 0100 0100 0100 0001"
+ $"0000 0100 0100 0100 0001 0001 0001 6072"
+ $"6C6C 6DE3 8E07 3828 1C12 0A05 0100 6DFD"
+ $"0004 0100 0002 22EC 8E02 786C 1FFE 0005"
+ $"0100 0100 0001 FE72 236C 0C00 0001 0001"
+ $"0000 0100 0001 0001 0001 0001 0000 0100"
+ $"0100 0100 0100 0100 0100 0100 01FA 000C"
+ $"0100 0100 0100 0100 0100 0100 01FE 0000"
+ $"01FE 0008 0100 0001 0001 0001 3DFE 7200"
+ $"66E2 8E07 3828 1C12 0A05 0100 6302 0000"
+ $"01FD 0001 0220 EC8E 1078 6C2E 0000 0100"
+ $"0100 0100 016C 6C72 7212 FE00 0501 0000"
+ $"0100 01FD 0000 01FD 0002 0100 01FE 0004"
+ $"0100 0100 01FB 0007 0100 0100 0100 0001"
+ $"F600 0501 0001 0000 01FE 0000 01FD 0004"
+ $"1972 726C 60E1 8E07 3828 1C12 0A05 0100"
+ $"68FE 0005 0100 0100 0222 EC8E 0278 6C2E"
+ $"FA00 0C01 0051 7272 6C12 0000 0100 0001"
+ $"FE00 0201 0001 FE00 0201 0001 FD00 0001"
+ $"FA00 0A01 0001 0001 0001 0001 0001 FE00"
+ $"1C01 0001 0001 0001 0001 0000 0100 0001"
+ $"0001 0001 0000 0100 002E 726C 7250 E18E"
+ $"0738 281C 120A 0501 006C 0800 0001 0001"
+ $"0000 0220 EC8E 1067 6C3D 0000 0100 0100"
+ $"0100 0057 726C 7212 FD00 1D01 0000 0100"
+ $"0001 0001 0001 0001 0000 0100 0100 0100"
+ $"0100 0100 0100 0100 01FA 000C 0100 0100"
+ $"0100 0100 0100 0100 01FE 0000 01FE 000A"
+ $"0100 0001 0001 106C 6C72 6FE0 8E07 3828"
+ $"1C12 0A05 0100 5FFA 0001 0222 EC8E 0267"
+ $"7246 FE00 0201 0001 FE00 0051 FE72 0312"
+ $"0000 01FE 0002 0100 01FD 0000 01FD 0002"
+ $"0100 01FE 0004 0100 0100 01FB 0007 0100"
+ $"0100 0100 0001 F600 0501 0001 0000 01FE"
+ $"0008 0100 0007 6C6C 7272 6DE0 8E07 3828"
+ $"1C12 0A05 0100 6A08 0000 0100 0100 0002"
+ $"20EC 8E05 5D6C 6000 0001 FD00 0601 0057"
+ $"6C72 7212 FE00 0201 0001 FE00 0201 0001"
+ $"FE00 0201 0001 FD00 0001 FA00 0A01 0001"
+ $"0001 0001 0001 0001 FE00 1201 0001 0001"
+ $"0001 0001 0000 0100 0001 0001 0001 FE00"
+ $"042E 7272 6C4B DF8E 0738 281C 120A 0501"
+ $"006A FE00 0501 0001 0002 22EC 8E02 5D72"
+ $"61FD 0005 0100 0100 0051 FE72 2214 0000"
+ $"0100 0100 0001 0000 0100 0100 0100 0100"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"FA00 0C01 0001 0001 0001 0001 0001 0001"
+ $"FE00 0001 FE00 0901 0000 010C 726C 724B"
+ $"76DF 8E07 3828 1C12 0A05 0100 5C02 0000"
+ $"01FD 0001 0220 EB8E 0F6C 7201 0000 0100"
+ $"0100 0001 516C 726C 19FB 0002 0100 01FD"
+ $"0000 01FD 0002 0100 01FE 0004 0100 0100"
+ $"01FB 0007 0100 0100 0100 0001 F600 0501"
+ $"0001 0000 01FE 0005 0100 2572 7253 DD8E"
+ $"0738 281C 120A 0501 0062 FD00 0401 0000"
+ $"0222 EB8E 026C 6C0B FB00 0201 0057 FE72"
+ $"0519 0000 0100 01FD 0002 0100 01FE 0002"
+ $"0100 01FD 0000 01FA 000A 0100 0100 0100"
+ $"0100 0100 01FE 0018 0100 0100 0100 0100"
+ $"0100 0001 0000 0100 0100 0100 0761 726C"
+ $"66DD 8E07 3828 1C12 0A05 0100 6908 0000"
+ $"0100 0001 0002 20EB 8E07 5472 1900 0001"
+ $"0001 FE00 0051 FE72 0019 FE00 1E01 0001"
+ $"0001 0000 0100 0100 0100 0100 0001 0001"
+ $"0001 0001 0001 0001 0001 0001 FA00 0C01"
+ $"0001 0001 0001 0001 0001 0001 FE00 0001"
+ $"FE00 0701 0001 476C 726C 76DD 8E07 3828"
+ $"1C12 0A05 0100 5EFE 0000 01FE 0001 0222"
+ $"EB8E 0253 7222 FE00 0C01 0001 0000 576C"
+ $"726C 1900 0001 FE00 0201 0001 FD00 0001"
+ $"FD00 0201 0001 FE00 0401 0001 0001 FB00"
+ $"0701 0001 0001 0000 01F6 0005 0100 0100"
+ $"0001 FE00 040B 7272 6C41 DC8E 0738 281C"
+ $"120A 0501 0065 0800 0001 0001 0000 0220"
+ $"EB8E 054B 6C2E 0000 01FE 0002 0100 51FE"
+ $"7205 1F00 0100 0001 FD00 0201 0001 FE00"
+ $"0201 0001 FD00 0001 FA00 0A01 0001 0001"
+ $"0001 0001 0001 FE00 1601 0001 0001 0001"
+ $"0001 0000 0100 0001 0001 0000 2372 725A"
+ $"DB8E 0738 281C 120A 0501 0062 FC00 0301"
+ $"0002 22EB 8E02 4872 51FD 0000 01FE 0004"
+ $"5772 6C72 1CFE 001E 0100 0100 0100 0001"
+ $"0001 0001 0001 0000 0100 0100 0100 0100"
+ $"0100 0100 0100 01FA 000C 0100 0100 0100"
+ $"0100 0100 0100 01FE 0000 01FE 0004 0101"
+ $"6172 53DA 8E07 3828 1C12 0A05 0100 5D08"
+ $"0000 0100 0100 0002 20EB 8E12 4272 5100"
+ $"0001 0000 0100 002E 7272 6C1F 0000 01FE"
+ $"0002 0100 01FD 0000 01FD 0002 0100 01FE"
+ $"0004 0100 0100 01FB 0007 0100 0100 0100"
+ $"0001 F600 0B01 0001 0000 0100 0019 6C72"
+ $"6FDA 8E07 3828 1C12 0A05 0100 62FE 0000"
+ $"01FE 0001 0222 EB8E 0B49 6C72 0100 0001"
+ $"0000 0100 2EFE 7200 1FFD 0000 01FD 0002"
+ $"0100 01FE 0002 0100 01FD 0000 01FA 000A"
+ $"0100 0100 0100 0100 0100 01FE 0015 0100"
+ $"0100 0100 0100 0100 0001 0000 0100 010C"
+ $"6072 6C73 DA8E 0738 281C 120A 0501 0064"
+ $"0800 0001 0000 0100 0220 EA8E 026C 720C"
+ $"FE00 2A01 0000 012E 7272 6C2A 0001 0001"
+ $"0001 0001 0000 0100 0100 0100 0100 0001"
+ $"0001 0001 0001 0001 0001 0001 0001 FA00"
+ $"0C01 0001 0001 0001 0001 0001 0001 FE00"
+ $"0001 FE00 0347 726C 48D9 8E07 3828 1C12"
+ $"0A05 0100 59FD 0004 0100 0002 22EA 8E0A"
+ $"6C72 1900 0001 0001 0000 2EFE 7203 2E00"
+ $"0001 FE00 0201 0001 FD00 0001 FD00 0201"
+ $"0001 FE00 0401 0001 0001 FB00 0701 0001"
+ $"0001 0000 01F6 000A 0100 0100 0001 0E72"
+ $"7253 76D9 8E07 3828 1C12 0A05 0100 5D02"
+ $"0000 01FD 0001 0220 EA8E 0260 722F FC00"
+ $"0601 002E 7272 6C2E FD00 0001 FD00 0201"
+ $"0001 FE00 0201 0001 FD00 0001 FA00 0A01"
+ $"0001 0001 0001 0001 0001 FE00 1301 0001"
+ $"0001 0001 0001 0000 0100 0001 0025 726C"
+ $"78D8 8E07 3828 1C12 0A05 0100 62FE 0005"
+ $"0100 0100 0222 EA8E 0A60 6C2E 0000 0100"
+ $"0100 012E FE72 222E 0000 0100 0001 0001"
+ $"0000 0100 0100 0100 0100 0001 0001 0001"
+ $"0001 0001 0001 0001 0001 FA00 0C01 0001"
+ $"0001 0001 0001 0001 0001 FE00 0601 0001"
+ $"576C 7264 D88E 0738 281C 120A 0501 0059"
+ $"0800 0001 0001 0000 0220 EA8E 0254 7251"
+ $"FE00 0001 FE00 0428 7272 6C2F FE00 0501"
+ $"0000 0100 01FD 0000 01FD 0002 0100 01FE"
+ $"0004 0100 0100 01FB 0007 0100 0100 0100"
+ $"0001 F600 0801 0001 0000 196C 724B D78E"
+ $"0738 281C 120A 0501 005A FA00 0102 22EA"
+ $"8E13 546C 7200 0001 0000 0100 196C 7272"
+ $"4700 0001 0001 FD00 0201 0001 FE00 0201"
+ $"0001 FD00 0001 FA00 0A01 0001 0001 0001"
+ $"0001 0001 FE00 1101 0001 0001 0001 0001"
+ $"0000 0100 0007 6C72 6CD6 8E07 3828 1C12"
+ $"0A05 0100 5D08 0000 0100 0100 0002 20EA"
+ $"8E02 4E6C 72FD 0007 0100 0117 726C 7246"
+ $"FC00 1C01 0001 0000 0100 0100 0100 0100"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"FA00 0C01 0001 0001 0001 0001 0001 0001"
+ $"FD00 032E 7272 41D6 8E07 3828 1C12 0A05"
+ $"0100 56FE 0005 0100 0100 0222 EA8E 065A"
+ $"7272 0800 0001 FE00 0D19 6C72 6C46 0000"
+ $"0100 0100 0100 01FD 0000 01FD 0002 0100"
+ $"01FE 0004 0100 0100 01FB 0007 0100 0100"
+ $"0100 0001 F600 0601 0001 086C 7254 D58E"
+ $"0738 281C 120A 0501 005B 0200 0001 FD00"
+ $"0102 20EA 8E03 5A72 720C FD00 0201 0017"
+ $"FE72 0446 0001 0001 FC00 0201 0001 FE00"
+ $"0201 0001 FD00 0001 FA00 0A01 0001 0001"
+ $"0001 0001 0001 FE00 1001 0001 0001 0001"
+ $"0001 0000 0100 1C72 726F D58E 0738 281C"
+ $"120A 0501 005C FD00 0401 0000 0222 EA8E"
+ $"068A 726C 1200 0001 FE00 0419 6C72 7251"
+ $"FC00 1C01 0001 0000 0100 0100 0100 0100"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"FA00 0C01 0001 0001 0001 0001 0001 0001"
+ $"FE00 033E 6C72 73D5 8E07 3828 1C12 0A05"
+ $"0100 5608 0000 0100 0001 0002 20EA 8E03"
+ $"786C 7219 FE00 1001 0000 0172 726C 6100"
+ $"0001 0001 0001 0001 FD00 0001 FD00 0201"
+ $"0001 FE00 0401 0001 0001 FB00 0701 0001"
+ $"0001 0000 01F6 0005 0100 1772 7248 D48E"
+ $"0738 281C 120A 0501 005B FE00 0001 FE00"
+ $"0102 22EA 8E0A 786C 6C19 0000 0100 0100"
+ $"01FE 7200 60FE 0000 01FC 0002 0100 01FE"
+ $"0002 0100 01FD 0000 01FA 000A 0100 0100"
+ $"0100 0100 0100 01FE 000F 0100 0100 0100"
+ $"0100 0100 0001 3D72 7270 D48E 0738 281C"
+ $"120A 0501 005C 0800 0001 0001 0000 0220"
+ $"EA8E 0378 6C72 1BFC 0027 0101 7272 6C60"
+ $"0000 0100 0001 0001 0000 0100 0100 0100"
+ $"0100 0001 0001 0001 0001 0001 0001 0001"
+ $"0001 FA00 1101 0001 0001 0001 0001 0001"
+ $"0001 000E 7272 66D3 8E07 3828 1C12 0A05"
+ $"0100 4FFC 0003 0100 0222 EA8E 0A67 6C72"
+ $"1F00 0001 0001 0001 FE72 0060 FD00 0401"
+ $"0001 0001 FD00 0001 FD00 0201 0001 FE00"
+ $"0401 0001 0001 FB00 0701 0001 0001 0000"
+ $"01F5 0002 226C 51D2 8E07 3828 1C12 0A05"
+ $"0100 5908 0000 0100 0100 0002 20EA 8E03"
+ $"6772 6C28 FE00 0A01 0000 0172 726C 6100"
+ $"0001 FB00 0201 0001 FE00 0201 0001 FD00"
+ $"0001 FA00 0A01 0001 0001 0001 0001 0001"
+ $"FE00 0D01 0001 0001 0001 0001 0003 5772"
+ $"6ED2 8E07 3828 1C12 0A05 0100 5CFE 0000"
+ $"01FE 0001 0222 EA8E 0E64 6C72 2E00 0001"
+ $"0000 0100 6072 7260 FE00 1E01 0001 0001"
+ $"0000 0100 0100 0100 0100 0001 0001 0001"
+ $"0001 0001 0001 0001 0001 FA00 1001 0001"
+ $"0001 0001 0001 0001 0000 236C 725D D28E"
+ $"0738 281C 120A 0501 0053 0800 0001 0000"
+ $"0100 0220 EA8E 036D 726C 38FD 000F 0100"
+ $"0060 726C 6000 0001 0001 0001 0001 FD00"
+ $"0001 FD00 0201 0001 FE00 0401 0001 0001"
+ $"FB00 0701 0001 0001 0000 01F7 0003 016C"
+ $"726C D18E 0738 281C 120A 0501 0055 FD00"
+ $"0401 0000 0222 EA8E 065D 6C72 4600 0001"
+ $"FD00 0461 6C72 6C01 FB00 0405 0B04 0001"
+ $"FE00 0201 0001 FD00 0001 FA00 0A01 0001"
+ $"0001 0001 0001 0001 FE00 0C01 0001 0001"
+ $"0001 0001 3872 6C58 D18E 0738 281C 120A"
+ $"0501 0059 0200 0001 FD00 0102 20EA 8E03"
+ $"766C 7251 FE00 0C01 0317 1961 726C 722E"
+ $"5751 5761 FD72 1819 0000 0100 0100 0100"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"FA00 0E01 0001 0001 0001 0001 0001 0E72"
+ $"6C54 D08E 0738 281C 120A 0501 0052 FE00"
+ $"0501 0001 0002 22EC 8E0E 5D49 4872 726C"
+ $"2E2E 5761 7272 6C72 6CFA 7204 6C72 6C72"
+ $"19FE 0000 01FD 0002 0100 01FE 0004 0100"
+ $"0100 01FB 0007 0100 0100 0100 0001 F800"
+ $"031A 7272 6FD0 8E07 3828 1C12 0A05 0100"
+ $"6008 0000 0100 0100 0002 20F1 8E08 785A"
+ $"5260 6C72 6C72 6CFD 721A 6C72 6C72 726C"
+ $"726C 726C 726C 726C 726C 726C 1B00 0001"
+ $"0000 0100 01FD 0000 01FA 000A 0100 0100"
+ $"0100 0100 0100 01FE 000B 0100 0100 0100"
+ $"0100 3E72 6C73 D08E 0738 281C 120A 0501"
+ $"005C FA00 0102 22F1 8E37 5472 6C72 6C72"
+ $"726C 726C 726C 7272 6C72 6C72 726C 726C"
+ $"726C 726C 726C 726C 721F 0001 0000 0100"
+ $"0100 0001 0001 0001 0001 0001 0001 0001"
+ $"0001 FA00 0D01 0001 0001 0001 0001 0017"
+ $"7272 4ECF 8E07 3828 1C12 0A05 0100 5D08"
+ $"0000 0100 0100 0002 20F1 8E1F 5372 726C"
+ $"726C 7272 6C72 6C72 6C72 726C 726C 7272"
+ $"6C72 6C72 6C72 6C72 6C72 6C1C FE00 0001"
+ $"FD00 0201 0001 FE00 0401 0001 0001 FB00"
+ $"0701 0001 0001 0000 01FA 0004 0C61 7260"
+ $"6DCF 8E07 3828 1C12 0A05 0100 5EFE 0005"
+ $"0100 0100 0222 F18E 0054 FE72 236C 726C"
+ $"7272 6C72 6C72 6C72 726C 726C 7272 6C72"
+ $"6C72 6C72 6C72 6C72 1F00 0001 0000 0100"
+ $"01FD 0000 01FA 000A 0100 0100 0100 0100"
+ $"0100 01FE 0009 0100 0100 0100 516C 7249"
+ $"CE8E 0738 281C 120A 0501 005D 0200 0001"
+ $"FD00 0102 20F1 8E1F 4E72 6C72 726C 726C"
+ $"7272 6C72 6C72 6C72 726C 726C 7272 6C72"
+ $"6C72 6C72 6C72 6C1F FD00 1301 0001 0000"
+ $"0100 0100 0100 0100 0100 0100 0100 01FA"
+ $"000B 0100 0100 0100 0100 0772 726C CD8E"
+ $"0738 281C 120A 0501 005A FD00 0401 0000"
+ $"0222 F18E 2348 6C72 6C72 726C 726C 7272"
+ $"6C72 6C72 6C72 726C 726C 7272 6C72 6C72"
+ $"6C72 6C6C 1B00 0100 01FD 0002 0100 01FE"
+ $"0004 0100 0100 01FB 0007 0100 0100 0100"
+ $"0001 FB00 031F 6C72 5ACD 8E07 3828 1C12"
+ $"0A05 0100 5E08 0000 0100 0001 0002 20F1"
+ $"8E1E 4372 6C72 6C72 726C 726C 7272 6C72"
+ $"6C72 6C72 726C 726C 726C 513E 2E19 1901"
+ $"01FE 0005 0100 0001 0001 FD00 0001 FA00"
+ $"0A01 0001 0001 0001 0001 0001 FE00 0801"
+ $"0001 0001 516C 6C6A CD8E 0738 281C 120A"
+ $"0501 0058 FE00 0001 FE00 0102 22F1 8E17"
+ $"496C 726C 726C 7272 6C72 6C72 726C 726C"
+ $"726C 7272 6C72 0101 F800 1601 0000 0100"
+ $"0100 0001 0001 0001 0001 0001 0001 0001"
+ $"0001 FA00 0701 0001 0001 0001 0CFE 7200"
+ $"76CD 8E07 3828 1C12 0A05 0100 5408 0000"
+ $"0100 0100 0002 20F1 8E01 7653 FB60 0E6C"
+ $"7272 2F2F 1F1B 1912 0C6C 6C72 6C01 F800"
+ $"0301 0000 01FD 0002 0100 01FE 0004 0100"
+ $"0100 01FB 0007 0100 0100 0100 0001 FD00"
+ $"0403 516C 7249 CC8E 0738 281C 120A 0501"
+ $"0068 FC00 0301 0002 22E9 8E03 496C 6C03"
+ $"FB00 0360 726C 60FD 0004 0100 0100 01FE"
+ $"0005 0100 0001 0001 FD00 0001 FA00 0A01"
+ $"0001 0001 0001 0001 0001 FE00 0601 0000"
+ $"1972 7248 FD8E 0058 FA3B 075C 648E 4D3A"
+ $"3333 36FD 4D00 55F9 8E04 7631 545C 36F1"
+ $"8E07 3828 1C12 0A05 0100 8108 0000 0100"
+ $"0100 0002 20E9 8E03 4972 7211 FB00 0360"
+ $"7272 60FE 001E 0100 0100 0100 0100 0100"
+ $"0001 0001 0000 0100 0100 0100 0100 0100"
+ $"0100 0100 01FA 0009 0100 0100 0100 3872"
+ $"6077 FD8E 245E 6C60 2E2A 2328 2F6C 5965"
+ $"462A 3E6C 303E 383E 723B 775A 484B 5A77"
+ $"8E8E 6561 2828 5366 8E8E FD6C 0371 8E68"
+ $"68FC 8E07 3828 1C12 0A05 0100 7FFE 0000"
+ $"01FE 0001 0222 E98E 1049 6C72 1900 0001"
+ $"0001 0060 726C 6100 0001 FA00 0301 0000"
+ $"01FD 0002 0100 01FE 0004 0100 0100 01FB"
+ $"0007 0100 0100 0100 0001 FE00 030C 726C"
+ $"6FFC 8E02 5E6C 0CFD 0026 0572 5E8A 1800"
+ $"1B72 304A 1900 6C4B 4E6C 6C2F 7266 8E8E"
+ $"4B22 0000 084B 8E8E 6C00 0023 6C4B 6C6C"
+ $"4DFD 8E07 3828 1C12 0A05 0100 8208 0000"
+ $"0100 0001 0002 20E9 8E03 496C 7219 FE00"
+ $"0601 0000 5772 7260 FD00 0401 0001 0001"
+ $"FE00 0501 0000 0100 01FD 0000 01FA 000A"
+ $"0100 0100 0100 0100 0100 01FE 0005 0101"
+ $"3E72 7265 FC8E 025E 6C0C FE00 1801 0C47"
+ $"5E6A 1F00 196C 304A 1500 7272 6C22 0100"
+ $"114B 8E8E 5C08 FE00 063E 768E 6C00 0023"
+ $"FD6C 005A FD8E 0738 281C 120A 0501 007F"
+ $"FD00 0401 0000 0222 E98E 0649 6C72 1F00"
+ $"0001 FE00 2546 7272 6000 0001 0000 0100"
+ $"0100 0100 0100 0001 0001 0000 0100 0100"
+ $"0100 0100 0100 0100 0100 01FA 0008 0100"
+ $"0100 1F72 7253 76FC 8E03 656C 0C00 FC72"
+ $"0C5E 8A2B 0011 8976 7E0C 0038 6012 FD00"
+ $"034B 8E3A 3EFD 000B 2C3A 8E60 0000 1B11"
+ $"0100 194B FD8E 0738 281C 120A 0501 0079"
+ $"0200 0001 FD00 0102 20E9 8E03 496C 722E"
+ $"FD00 0501 0046 7272 60FE 0000 01FB 0003"
+ $"0100 0001 FD00 0201 0001 FE00 0401 0001"
+ $"0001 FB00 0D01 0001 0001 0000 0100 0572"
+ $"726C 58FB 8E05 786C 0C0C 6C54 FE3B 0B70"
+ $"6A2E 000C 898E 7E0C 0025 09FC 0003 4E8E"
+ $"4423 FD00 0323 318E 6CFB 0001 194E FD8E"
+ $"0738 281C 120A 0501 007D FE00 0501 0001"
+ $"0002 22E9 8E06 496C 722E 0000 01FE 000C"
+ $"2857 5160 0000 0100 0100 0100 01FE 0005"
+ $"0100 0001 0001 FD00 0001 FA00 0A01 0001"
+ $"0001 0001 0001 0001 FE00 0317 7272 53FA"
+ $"8E05 786C 0C0C 6C5A FD8E 098A 5400 1A89"
+ $"8E7E 0C00 01FE 000E 0100 0052 6871 1F00"
+ $"011F 001F 3B8E 60FB 0001 194E FD8E 0738"
+ $"281C 120A 0501 007C 0800 0001 0001 0000"
+ $"0220 E98E 0349 6C72 47FE 0002 0100 01F8"
+ $"001C 0100 0100 0100 0100 0001 0001 0000"
+ $"0100 0100 0100 0100 0100 0100 0100 01FA"
+ $"0006 0100 002E 726C 6EFA 8E05 786C 0C0C"
+ $"6C78 FD8E 0764 796C 6C8A 887E 0CFE 0018"
+ $"0C0C 0001 0046 216C 0C00 2538 0017 3B8E"
+ $"5300 000B 2807 0019 52FD 8E07 3828 1C12"
+ $"0A05 0100 72FA 0001 0222 E98E 0449 6C72"
+ $"6C01 FE00 0001 FB00 0201 0001 FB00 0301"
+ $"0000 01FD 0002 0100 01FE 0004 0100 0100"
+ $"01FB 000C 0100 0100 0100 0001 0772 6C72"
+ $"77FA 8E05 786C 0C14 6C65 F88E 1E4D 6C01"
+ $"0001 3872 720E 0000 4A30 7205 0972 6100"
+ $"113B 8E3E 0000 1972 1B00 194E FD8E 0738"
+ $"281C 120A 0501 0084 0800 0001 0001 0000"
+ $"0220 FA8E 0065 F078 056C 6C72 1900 01FE"
+ $"0015 0100 0100 0100 0100 0100 0907 0001"
+ $"0000 0100 0001 0001 FD00 0001 FA00 1001"
+ $"0001 0001 0001 0001 0001 0003 4672 6C66"
+ $"F98E 0578 6C0C 196C 5EFE 8E24 3A48 4B48"
+ $"4B52 246C 0000 1272 386C 2800 053E 574A"
+ $"0022 6B81 0710 6E8E 4800 0025 7222 000E"
+ $"52FD 8E07 3828 1C12 0A05 0100 7FFE 0005"
+ $"0100 0100 0222 FA8E EE6C 0472 6C72 726C"
+ $"FE72 256C 726C 726C 726C 726C 726C 721B"
+ $"0000 0100 0001 0001 0000 0100 0100 0100"
+ $"0100 0100 0100 0100 01F9 0003 2E72 7248"
+ $"F88E 0567 7F0C 1972 58FE 8E24 336C 3E2E"
+ $"3E86 8E7E 0100 1C72 276C 2E00 0C4A 6C28"
+ $"0051 6F65 3860 6F8E 4800 002E 5125 000C"
+ $"4EFD 8E07 3828 1C12 0A05 0100 9202 0000"
+ $"01FD 0001 0220 FB8E 2950 6C72 6C72 6C72"
+ $"6C72 6C72 6C72 6C72 6C72 6C72 726C 726C"
+ $"7272 6C72 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"6C72 22FE 0000 01FD 0002 0100 01FE 0004"
+ $"0100 0100 01FB 000A 0100 0100 0100 0372"
+ $"726C 70F8 8E05 6787 0C2E 6C58 FE8E 2433"
+ $"6C0F 001B 868E 7E01 002C 7224 722E 0011"
+ $"4672 1900 725E 8A71 4B8E 8E48 0001 462E"
+ $"2E00 0C4E FD8E 0738 281C 120A 0501 0090"
+ $"FD00 0401 0000 0222 FB8E 3154 726C 726C"
+ $"726C 726C 726C 726C 726C 726C 726C 7272"
+ $"6C72 6C72 726C 726C 726C 726C 726C 726C"
+ $"726C 726C 723D 1B03 0000 0100 01FD 0000"
+ $"01FA 000F 0100 0100 0100 0100 0100 0019"
+ $"6C72 5A88 F88E 058A 710C 2E6C 55FE 8E18"
+ $"3372 0400 1B6F 8E63 0000 3E7E 6D6C 1900"
+ $"1A46 720F 0572 4D8E 58FE 8E08 4800 0054"
+ $"3A3C 1125 52FD 8E07 3828 1C12 0A05 0100"
+ $"9108 0000 0100 0001 0002 20FC 8E2D 5D6C"
+ $"7272 6C72 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"6C72 6C72 726C 726C 7272 6C72 6C72 6C72"
+ $"6C72 6C72 6C72 6C72 6C72 7219 FE00 1101"
+ $"0000 0100 0100 0100 0100 0100 0100 0100"
+ $"01FA 0003 3872 6C65 F78E 056A 6C0C 2E6C"
+ $"68FE 8E16 3351 0000 2351 243E 0000 7281"
+ $"736C 1400 2E46 7208 0581 76FC 8E08 4800"
+ $"006B 8E6B 6C72 5AFD 8E07 3828 1C12 0A05"
+ $"0100 97FE 0000 01FE 0001 0222 FC8E 3565"
+ $"6C6C 7272 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"6C72 6C72 6C72 726C 726C 7272 6C72 6C72"
+ $"6C72 6C72 6C72 6C72 6C72 6C72 1400 0001"
+ $"0000 0100 01FE 0004 0100 0100 01FB 000C"
+ $"0100 0100 0101 6C72 6C77 8E8E 58FD 4908"
+ $"678E 8E8A 6C0C 3872 68FE 8E15 333E 0000"
+ $"2530 243E 0003 726C 5E6C 0C00 3D3D 6C00"
+ $"0581 FC8E 0975 4800 006B 8E7E 6C35 55FD"
+ $"8E07 3828 1C12 0A05 0100 9508 0000 0100"
+ $"0100 0002 20FC 8E2D 786C 726C 7272 6C72"
+ $"6C72 6C72 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"726C 726C 7272 6C72 6C72 6C72 6C72 6C72"
+ $"6C72 6C72 6C10 FD00 0001 FD00 0001 FA00"
+ $"0A01 0001 0001 0001 0001 0038 FE72 106C"
+ $"6C72 726C 726C 725A 8E8E 6A6C 0C6C 6C68"
+ $"FE8E 2133 3800 002A 2D27 3E00 056C 4478"
+ $"6C04 0172 3072 0005 818E 785A 5A4E 3334"
+ $"000A 4E8E 58FA 8E07 3828 1C12 0A05 0100"
+ $"91FC 0003 0100 0222 FA8E 0148 6CFE 7229"
+ $"6C72 6C72 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"6C72 726C 726C 7272 6C72 6C72 6C72 6C72"
+ $"6C72 6C72 6C72 0900 0001 FE00 0E01 0001"
+ $"0001 0001 0001 0001 0001 0001 FC00 140E"
+ $"726C 726C 7272 6C72 726C 7272 4B8E 8E8A"
+ $"710C 6C6C FD8E 1F33 2E00 002E 2432 3E00"
+ $"0C6C 316E 3E00 0572 326C 0005 818E 6319"
+ $"226C 242E 000C 4EF8 8E07 3828 1C12 0A05"
+ $"0100 9108 0000 0100 0100 0002 20F9 8E29"
+ $"7765 5A60 6C72 726C 726C 726C 726C 726C"
+ $"726C 726C 726C 7272 6C72 6C72 726C 726C"
+ $"726C 726C 726C 726C 7260 FD00 0401 0001"
+ $"0001 FE00 0401 0001 0001 FB00 1801 0001"
+ $"0023 7272 6C72 6C72 726C 7272 6C6C 4E8E"
+ $"8E64 800C 6C71 FD8E 1F33 2E00 0038 2132"
+ $"3800 0C81 7665 2500 0C6C 5A6C 0005 6B42"
+ $"2D00 1251 242E 000B 4BF8 8E07 3828 1C12"
+ $"0A05 0100 8CFE 0000 01FE 0001 0222 F58E"
+ $"0258 526C FE72 256C 726C 726C 726C 726C"
+ $"726C 726C 7272 6C72 6C72 726C 726C 726C"
+ $"726C 726C 726C 2F00 0001 0000 01FD 0000"
+ $"01FA 001E 0100 0100 0100 0100 0161 726C"
+ $"726C 726C 7272 6C72 726C 548E 8E48 6C0C"
+ $"6C6C 76FE 8E1F 332E 0000 461E 322E 0012"
+ $"818E 7818 0012 6C78 6C00 006C 6C25 001B"
+ $"3024 2E00 0C48 F88E 0738 281C 120A 0501"
+ $"008F 0800 0001 0000 0100 0220 F38E 0149"
+ $"54FE 721E 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"6C72 726C 726C 7272 6C72 6C72 6C72 6C72"
+ $"6C72 11FE 0000 01FE 000E 0100 0100 0100"
+ $"0100 0100 0100 0100 01FD 0039 1272 6C72"
+ $"6C72 6C72 6C72 726C 7272 548E 8E48 6C0C"
+ $"386C 3133 4D55 3323 0000 511E 322E 0012"
+ $"6C8E 4B0D 0014 4478 6C00 0072 7219 001C"
+ $"2B32 2E01 1148 F88E 0738 281C 120A 0501"
+ $"008A FD00 0401 0000 0222 F28E 2B88 6478"
+ $"4E6C 6C72 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"726C 726C 7272 6C72 6C72 6C72 6C72 5101"
+ $"0000 0100 0100 0100 01FE 0004 0100 0100"
+ $"01FB 0004 0100 0751 6CFE 7234 6C72 6C72"
+ $"6C72 726C 7254 8E8E 4872 0C1C 2F3E 616C"
+ $"3824 2500 016C 7671 2E00 194E 8E4E 0800"
+ $"1B37 786C 0400 2C23 0100 2A21 322E 0019"
+ $"6FF8 8E07 3828 1C12 0A05 0100 7F02 0000"
+ $"01FD 0001 0220 EE8E 1D70 416C 726C 726C"
+ $"726C 726C 726C 726C 7272 6C72 6C72 726C"
+ $"726C 726C 726C 1BFB 0000 01FD 0000 01FA"
+ $"0007 0100 0100 0100 0138 FE72 076C 7272"
+ $"6C72 6C72 6CFE 7205 658E 8E4B 6C0C FD00"
+ $"1572 3824 2500 056C 8E6C 2E00 1B37 8E60"
+ $"0000 2333 786C 0CFC 0006 5476 3B2E 0019"
+ $"5AF8 8E07 3828 1C12 0A05 0100 86FE 0005"
+ $"0100 0100 0222 EC8E 205D 536C 7272 6C72"
+ $"6C72 6C72 6C72 6C72 726C 726C 7272 6C72"
+ $"6C72 6C72 0100 0001 0001 FE00 2001 0001"
+ $"0001 0001 0001 0001 0001 0001 0000 036C"
+ $"726C 7272 6C72 726C 726C 726C 5349 FE8E"
+ $"0248 6C0C FD00 1572 6562 2500 0C4E 8E71"
+ $"2E00 2333 8E6C 0000 2533 786C 19FD 0007"
+ $"0B52 8E3B 2800 285A F88E 0738 281C 120A"
+ $"0501 0082 0800 0001 0001 0000 0220 EA8E"
+ $"236A 4B6C 6C72 726C 726C 726C 726C 7272"
+ $"6C72 6C72 726C 726C 7260 1912 0900 0100"
+ $"0001 0000 01FE 0004 0100 0100 01FA 000D"
+ $"1972 6C72 6C72 726C 7272 6C53 6F6A FC8E"
+ $"2948 7247 3E38 2E2E 6C8A 553C 1B23 523A"
+ $"602E 1038 333A 6005 0F3E 3365 6C38 0000"
+ $"010B 5766 883B 2F12 3E66 88F9 8E07 3828"
+ $"1C12 0A05 0100 79FA 0001 0222 E98E 2049"
+ $"6C72 6C72 726C 726C 726C 726C 7272 6C72"
+ $"6C72 726C 726C 726C 726C 7251 3817 0B01"
+ $"FE00 0001 FA00 1001 0001 0001 0038 7272"
+ $"6C72 6C72 726C 4E49 F98E 244E 796C 6C71"
+ $"6C6C 716A 7572 726C 484D 6C72 726C 5540"
+ $"6C72 726C 3376 446C 382C 7272 6C4D 8E3B"
+ $"FE72 0166 88F9 8E07 3828 1C12 0A05 0100"
+ $"7408 0000 0100 0100 0002 20E8 8E1B 6C6C"
+ $"726C 7272 6C72 6C72 6C72 6C72 726C 726C"
+ $"7272 6C72 6C72 6C72 726C FE72 1A6C 573C"
+ $"281C 1A12 0C01 0100 0100 0100 0100 0C6C"
+ $"6C72 726C 7254 6E6A ED8E 1E55 6868 8E68"
+ $"6258 584D 8E55 4878 6562 768E 8E73 648A"
+ $"786A 768E 8E76 625E 7873 F88E 0738 281C"
+ $"120A 0501 007A FE00 0501 0001 0002 22E8"
+ $"8E19 5472 6C72 6C72 726C 726C 726C 726C"
+ $"7272 6C72 6C72 726C 726C 726C FE72 026C"
+ $"726C F972 0E61 3C23 1701 0000 013D 7272"
+ $"6C72 7249 F58E 1C73 4E63 7F87 6C87 876C"
+ $"8787 7F87 6C87 7F87 6C7F 877F 8772 877F"
+ $"714E 6363 FE78 025A 634E FE63 0160 7FFE"
+ $"8702 6C87 6CFC 8E07 3828 1C12 0A05 0100"
+ $"5102 0000 01FD 0001 0220 E88E 2048 6C72"
+ $"6C72 6C72 726C 726C 726C 726C 7272 6C72"
+ $"6C72 726C 726C 726C 726C 726C 726C FC72"
+ $"006C FE72 0B6C 726C 5138 2E72 726C 726C"
+ $"50F4 8E00 5FD4 90FC 8E07 3828 1C12 0A05"
+ $"0100 6BFD 0004 0100 0002 22E8 8E2B 496C"
+ $"7272 6C72 6C72 726C 726C 726C 726C 7272"
+ $"6C72 6C72 726C 726C 726C 726C 726C 726C"
+ $"726C 726C 726C 726C 726C FA72 014E 73F3"
+ $"8E00 5FFE 90FB 8C09 6C72 616C 616C 616C"
+ $"616C F690 023C 3D72 FE90 056C 1F22 1F22"
+ $"4FFE 90FC 8E07 3828 1C12 0A05 0100 6608"
+ $"0000 0100 0001 0002 20E7 8E2B 6C72 6C72"
+ $"6C72 6C72 726C 726C 726C 726C 7272 6C72"
+ $"6C72 726C 726C 726C 726C 726C 726C 726C"
+ $"726C 726C 726C 726C FE72 026C 7241 F18E"
+ $"0356 9090 1FF2 0000 17F7 9003 8C00 0017"
+ $"FE90 003D FD00 0017 FE90 FC8E 0738 281C"
+ $"120A 0501 0065 FE00 0001 FE00 0102 22E7"
+ $"8E30 606C 726C 726C 726C 7272 6C72 6C72"
+ $"6C72 6C72 726C 726C 7272 6C72 6C72 6C72"
+ $"6C72 6C72 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"6C72 4EF0 8E03 5F90 901F F200 001C F790"
+ $"038C 0000 17FE 9005 803D 3E3E 0E00 FE90"
+ $"FC8E 0738 281C 120A 0501 0071 0800 0001"
+ $"0001 0000 0220 E78E 3054 726C 726C 726C"
+ $"726C 7272 6C72 6C72 6C72 6C72 726C 726C"
+ $"7272 6C72 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"6C72 6C72 6C72 6C72 6C73 F08E 035F 9090"
+ $"3DFC 1F04 1A01 0001 19FC 1C00 38FE 9001"
+ $"5128 FE1C 053E 908C 0000 17FA 9001 1700"
+ $"FE90 FC8E 0738 281C 120A 0501 0065 FC00"
+ $"0301 0002 22E7 8E00 5AFD 722A 6C72 6C72"
+ $"6C72 726C 726C 726C 726C 7272 6C72 6C72"
+ $"726C 726C 726C 726C 726C 726C 726C 726C"
+ $"726C 726C 726C 48EF 8E00 56F9 9004 6100"
+ $"0100 8CF9 9000 22FC 0005 6090 8C00 001C"
+ $"FA90 0419 008C 9090 FC8E 0738 281C 120A"
+ $"0501 006A 0800 0001 0001 0000 0220 E78E"
+ $"2F6F 6C6C 726C 726C 726C 726C 7272 6C72"
+ $"6C72 6C72 6C72 726C 726C 7272 6C72 6C72"
+ $"6C72 6C72 6C72 6C72 6C72 6C72 6C72 6C54"
+ $"76EF 8E00 66F9 9000 57FE 00F9 900C 3E01"
+ $"0003 388C 8C90 908C 0000 1BFA 9004 1700"
+ $"8C90 90FC 8E07 3828 1C12 0A05 0100 69FE"
+ $"0000 01FE 0001 0222 E78E 2E78 6C72 6C72"
+ $"6C72 6C72 6C72 6C72 726C 726C 726C 726C"
+ $"7272 6C72 6C72 726C 726C 726C 726C 726C"
+ $"726C 726C 726C 726C 7270 EE8E 0063 F990"
+ $"033C 0100 00F9 9000 1CFE 0008 576C 8C90"
+ $"9061 0000 1CFA 9004 1900 8C90 90FC 8E07"
+ $"3828 1C12 0A05 0100 6908 0000 0100 0001"
+ $"0002 20E7 8E2D 656C 6C72 6C72 6C72 6C72"
+ $"6C72 6C72 726C 726C 726C 726C 7272 6C72"
+ $"6C72 726C 726C 726C 726C 726C 726C 726C"
+ $"726C 7254 ED8E 004E F990 033D 0100 00F9"
+ $"9001 6003 FE00 0701 0C90 9061 0000 1BFA"
+ $"9004 1700 8C90 90FC 8E07 3828 1C12 0A05"
+ $"0100 6BFD 0004 0100 0002 22E7 8E2D 736C"
+ $"726C 726C 726C 726C 726C 726C 7272 6C72"
+ $"6C72 6C72 6C72 726C 726C 7272 6C72 6C72"
+ $"6C72 6C72 6C72 6C72 6C72 6C6E ED8E 0063"
+ $"F990 0357 170E 0EF8 9001 471A FE17 0623"
+ $"9090 6100 001C FE90 0938 1C19 1903 008C"
+ $"9090 88FD 8E07 3828 1C12 0A05 0100 5B02"
+ $"0000 01FD 0001 0220 E68E 2C41 4E6C 6C72"
+ $"6C72 6C72 6C72 6C72 6C72 726C 726C 726C"
+ $"726C 7272 6C72 6C72 726C 726C 726C 726C"
+ $"726C 726C 726C 725D ED8E 007F E490 038C"
+ $"3D72 8CFE 9004 383C 3E72 6CFD 9000 73FD"
+ $"8E07 3828 1C12 0A05 0100 49FE 0005 0100"
+ $"0100 0222 E48E 0476 3F4B 6C6C FE72 216C"
+ $"726C 726C 7272 6C72 6C72 6C72 6C72 726C"
+ $"726C 7272 6C72 6C72 6C72 6C72 6C72 6C72"
+ $"6CEC 8E00 87D4 9000 7DFD 8E07 3828 1C12"
+ $"0A05 0100 4D08 0000 0100 0100 0002 20E0"
+ $"8E05 5D78 785A 536C FE72 1C6C 7272 6C72"
+ $"6C72 6C72 6C72 726C 726C 7272 6C72 6C72"
+ $"6C72 6C72 6C72 6C48 EC8E 0078 ED8A F889"
+ $"F68A 0365 7873 77FB 8E07 3828 1C12 0A05"
+ $"0100 33FA 0001 0222 DA8E 1F43 6C6C 726C"
+ $"7272 6C72 6C72 6C72 6C72 726C 726C 7272"
+ $"6C72 6C72 6C72 6C72 6C72 50B9 8E07 3828"
+ $"1C12 0A05 0100 3508 0000 0100 0100 0002"
+ $"20D8 8E06 7765 6F4B 606C 6CFE 7212 6C72"
+ $"6C72 726C 726C 7272 6C72 6C72 6C72 6C72"
+ $"6CB8 8E07 3828 1C12 0A05 0100 30FE 0005"
+ $"0100 0100 0222 D48E 1876 4160 6C72 6C72"
+ $"6C72 6C72 726C 726C 7272 6C72 6C72 604B"
+ $"4277 B88E 0738 281C 120A 0501 002A 0200"
+ $"0001 FD00 0102 20D2 8E12 7748 6C72 6C72"
+ $"6C72 6C72 726C 726C 7272 5443 49B4 8E07"
+ $"3828 1C12 0A05 0100 23FD 0004 0100 0002"
+ $"22CF 8E0C 6A5A 5472 6C6C 5352 5A78 786A"
+ $"76B1 8E07 3828 1C12 0A05 0100 1A08 0000"
+ $"0100 0001 0002 20CC 8E01 7758 A98E 0738"
+ $"281C 120A 0501 0016 FE00 0001 FE00 0102"
+ $"2281 8EF2 8E07 3828 1C12 0A05 0100 1708"
+ $"0000 0100 0100 0002 2081 8EF2 8E07 3828"
+ $"1C12 0A05 0100 14FC 0003 0100 0222 818E"
+ $"F28E 0738 281C 120A 0501 00A2 7F00 0001"
+ $"0001 0000 0213 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 2022 2022"
+ $"2022 2022 2022 2022 2022 2022 201F 2220"
+ $"2220 2220 2220 2220 2220 2220 2220 2220"
+ $"2220 2220 2220 3B25 1F12 0A05 0100 16FE"
+ $"0000 01FE 0001 0208 810A F20A 072E 281F"
+ $"120A 0501 0019 0900 0001 0000 0100 0002"
+ $"0481 06F4 0608 0430 281F 120A 0501 0013"
+ $"FD00 0001 FC00 8102 F302 0738 281F 120A"
+ $"0501 0015 0200 0001 FC00 0001 8100 F200"
+ $"0738 251F 120A 0501 0038 FE00 0501 0001"
+ $"0000 01F8 0000 03FD 0002 1214 07E3 0009"
+ $"0307 080C 1214 112A 2E1F E300 0901 0A0C"
+ $"0C07 0000 1722 1FD3 0007 3828 1C12 0A05"
+ $"0100 4B07 0000 0100 0100 0001 F900 0903"
+ $"2572 2A00 0014 6C6C 11F5 0008 0519 0C00"
+ $"0003 0C0C 01FD 0005 031F 343E 6C72 FC6C"
+ $"0334 2F6C 2FE4 0001 013E FE6C 0522 0000"
+ $"6C72 2FD3 0007 3428 1F12 0A05 0100 97F9"
+ $"002E 0100 0001 0001 0001 126C 7272 0A00"
+ $"3D6C 6C1B 0001 051C 2F25 0B00 0119 6C60"
+ $"6172 1B00 1260 6C6C 470C 0000 0105 6C72"
+ $"6CFA 7261 2F47 6C34 0000 0100 0100 0B1B"
+ $"1A14 0001 0001 000A 0A05 1C1A 0B00 0100"
+ $"0100 0100 013D 6C6C 7272 2F00 056C 6C34"
+ $"0000 0100 0105 1C13 0719 1C13 0300 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0105 0C0A 0100 0100 0100 0100 0100 3828"
+ $"1C12 0A05 0100 A007 0000 0100 0100 0001"
+ $"FD00 0901 0001 0014 7272 6C51 3CFE 720A"
+ $"2500 1F72 6C6C 726C 2E08 25FE 720C 6C1F"
+ $"2F6C 5125 1B51 6C17 0000 05FE 4703 516C"
+ $"726C FE47 1923 6C6C 2A12 1F19 0500 256C"
+ $"726C 7261 2F0A 003E 7272 6C72 6C51 0EFE"
+ $"0044 0100 0019 7272 3822 2522 0007 7272"
+ $"3E23 2F2A 1701 0C6C 726C 6C72 7219 0E28"
+ $"3447 2F1B 070E 473C 1F25 1A2A 342F 0E00"
+ $"0E38 6C6C 7238 0700 0100 0100 0100 0134"
+ $"281F 120A 0501 008B FE00 0801 0001 0000"
+ $"0100 0001 FD00 0213 726C FB72 172F 036C"
+ $"7272 1414 6172 2A28 726C 3E07 1172 6C19"
+ $"0828 7272 3EFB 0008 0C72 726C 0800 0001"
+ $"6CFD 720D 6C6C 0719 382A 2A6C 726C 2E00"
+ $"726C FB72 0804 0001 0000 012A 7228 FC00"
+ $"0305 6C72 6CFE 7203 6C13 0C6C FD72 036C"
+ $"146C 72FE 6C03 726C 236C FC72 FE6C 0808"
+ $"7272 340C 1972 4701 FA00 0738 281C 120A"
+ $"0501 0096 0200 0001 FC00 0001 FD00 2601"
+ $"0000 1372 726C 726C 726C 6C60 0C72 6C19"
+ $"0000 2E72 2F28 6C72 0A00 126C 7272 6C72"
+ $"6C47 1700 0001 FE00 0B05 6C72 7205 0000"
+ $"056C 7272 6CFE 7202 1900 1FFC 720A 6101"
+ $"6C72 7247 1B47 6C72 11FE 0004 0100 2F6C"
+ $"0CFE 0002 0100 07FE 7200 6CFE 7210 280C"
+ $"7272 6C2A 0C11 1F72 380C 0C19 7272 34F8"
+ $"7217 1B72 6C0F 0528 6C6C 0500 0001 0001"
+ $"0000 3428 1F12 0A05 0100 9FFD 0003 0100"
+ $"0001 FE00 6701 0000 0100 1372 6C3E 7272"
+ $"5147 6C72 0A6C 7228 0C19 516C 2A25 7272"
+ $"0000 0E72 726C 512F 3860 1A01 0000 0100"
+ $"0100 6172 7205 0000 0772 726C 2A38 6C72"
+ $"3C08 6172 120C 1F72 6C1A 6172 6C0B 0001"
+ $"4772 1F00 0001 0000 2F6C 3813 131C 2E1F"
+ $"0A6C 726C 1911 6C6C 5101 726C 72FE 001A"
+ $"2372 1900 000B 726C 4672 6014 2E6C 720A"
+ $"2E72 2F6C 7251 7261 383C 11FE 000B 0100"
+ $"0100 3828 1C12 0A05 0100 9C08 0000 0100"
+ $"0001 0000 01FE 0010 0100 0001 1372 7212"
+ $"146C 0A34 726C 0C34 6CFE 7205 6C47 0328"
+ $"6C72 FE00 0813 7272 6C6C 7272 5101 FE00"
+ $"0E01 0000 4772 7205 0000 0B72 6C1B 0005"
+ $"FE72 1105 6C6C 1B3C 726C 723C 4772 7205"
+ $"0000 2572 2EFD 0001 0123 FA72 0C1B 726C"
+ $"2500 001A 726C 1372 7260 FE00 1D19 6C72"
+ $"382A 4F72 722E 7228 000C 726C 001B 722C"
+ $"726C 726C 4751 6C1A 0100 01FE 0008 0134"
+ $"281F 120A 0501 009D FE00 0001 FD00 1D01"
+ $"0000 0100 0100 0011 4747 1100 0300 1F34"
+ $"2F0C 0413 1B1B 1911 0300 1228 25FD 0006"
+ $"081C 2825 2319 08FE 0000 01FE 0008 232F"
+ $"3805 0000 0825 1FFE 002E 1222 1B08 0F38"
+ $"473C 2A51 5728 3838 3403 0000 1728 0B00"
+ $"0001 0000 031B 516C 7260 3823 142F 2A0C"
+ $"0000 012A 280E 4760 2FFE 001A 0314 2F3E"
+ $"4738 1F08 2F72 1900 081B 0F00 1323 0810"
+ $"2A6C 7272 6038 0CFD 000A 0100 0038 281C"
+ $"120A 0501 002F 0700 0001 0001 0000 01FB"
+ $"0000 01DD 0003 0100 0001 DE00 0201 0001"
+ $"EA00 0001 E400 0D01 0001 0001 0034 281F"
+ $"120A 0501 0038 FC00 0801 0000 0100 0001"
+ $"0001 E900 0201 0001 F800 0301 0000 01F8"
+ $"0004 0100 0100 01F9 0000 01F9 0000 01C4"
+ $"0000 01FD 0007 3828 1C12 0A05 0100 A204"
+ $"0000 0100 01FE 0000 01FE 007F 0100 0001"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"0001 0000 0100 0001 0001 0001 0001 0000"
+ $"0100 0100 0001 0001 0001 0001 0000 0100"
+ $"0100 0100 0100 0001 0001 0001 0001 0001"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"0001 0001 0001 0001 0001 0001 0001 0001"
+ $"0001 0001 0001 0001 0001 0001 0500 0100"
+ $"0100 01FE 000A 0100 0134 281F 120A 0501"
+ $"009C FE00 0001 FE00 0001 FE00 1901 0000"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 01FC 0014 0100 0100 0100"
+ $"0100 0001 0000 0100 0100 0100 0100 01FC"
+ $"005B 0100 0100 0100 0100 0001 0001 0001"
+ $"0001 0000 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 3428 1C11 0A05 0100 3A08"
+ $"0000 0100 0001 0000 01FD 0000 01E9 0002"
+ $"0100 01F8 0003 0100 0001 F800 0401 0001"
+ $"0001 F900 0001 F900 0001 C400 0001 FD00"
+ $"0734 251C 110A 0501 003B FD00 0001 FE00"
+ $"0801 0405 0B0E 1112 1714 EC17 0014 F617"
+ $"0314 1717 14F8 1700 14FE 1700 14F9 1700"
+ $"14F9 1700 14C4 170C 1417 1714 142E 2319"
+ $"1108 0501 0038 0200 0001 FD00 0801 0308"
+ $"0C12 1F23 2A2E EB2F 0034 F62F 0034 F52F"
+ $"0034 FE2F 0034 F92F 0034 F92F 0034 C42F"
+ $"0034 FE2F 082E 251C 190C 0804 0100 30FE"
+ $"000C 0100 0100 0001 050A 0F14 191F 22DF"
+ $"2300 22F1 2300 22F9 2300 22F9 2300 22C4"
+ $"230C 2223 2322 1F1B 1411 0C05 0400 00A1"
+ $"0400 0001 0001 FE00 7F01 0405 0B0F 1112"
+ $"1414 1914 1714 1914 1914 1714 1914 1914"
+ $"1714 1914 1914 1714 1914 1914 1419 1419"
+ $"1414 1914 1914 1714 1914 1914 1714 1914"
+ $"1914 1419 1419 1414 1914 1914 1419 1419"
+ $"1414 1914 1914 1714 1914 1914 1419 1419"
+ $"1414 1914 1914 1419 1419 1414 1914 1914"
+ $"1419 1419 1414 1914 1914 1419 1419 1414"
+ $"1914 1914 1419 1419 140B 1419 1419 1414"
+ $"1914 1914 1419 FD14 0712 0E0C 0804 0100"
+ $"007B FB00 0B01 0001 0105 080A 0C0C 0F0F"
+ $"0EFC 0F00 0EFC 0F00 0EFC 0F00 0EFC 0F00"
+ $"0EFD 0F00 0EFD 0F00 0EFC 0F00 0EFC 0F00"
+ $"0EFD 0F00 0EFD 0F00 0EFD 0F00 0EFD 0F00"
+ $"0EFC 0F00 0EFD 0F00 0EFD 0F00 0EFD 0F00"
+ $"0EFD 0F00 0EFD 0F00 0EFD 0F00 0EFD 0F00"
+ $"0EFD 0F00 0EFD 0F00 0EFD 0F00 0EFD 0F00"
+ $"0EFB 0F08 0C0C 0A08 0501 0100 0087 0400"
+ $"0001 0001 FD00 0601 0103 0505 0807 FE08"
+ $"0207 0807 FD08 0007 FD08 0207 0807 FD08"
+ $"0007 FD08 0007 FD08 0007 FD08 0207 0807"
+ $"FD08 0007 FD08 0007 FD08 0007 FD08 0007"
+ $"FD08 0007 FD08 0207 0807 FD08 0007 FD08"
+ $"0007 FD08 0007 FD08 0007 FD08 0007 FD08"
+ $"0007 FD08 0007 FD08 0007 FD08 0007 FD08"
+ $"0007 FD08 0007 FD08 0007 FE08 0507 0505"
+ $"0401 01FE 0099 FE00 0201 0001 FC00 FD01"
+ $"7F03 0101 0301 0301 0301 0103 0103 0101"
+ $"0301 0301 0301 0103 0103 0101 0301 0301"
+ $"0103 0103 0101 0301 0301 0301 0103 0103"
+ $"0101 0301 0301 0103 0103 0101 0301 0301"
+ $"0103 0103 0101 0301 0301 0301 0103 0103"
+ $"0101 0301 0301 0103 0103 0101 0301 0301"
+ $"0103 0103 0101 0301 0301 0103 0103 0101"
+ $"0301 0301 0103 0103 0101 0301 0301 0103"
+ $"0108 0301 0103 0103 0101 04FD 01FD 0099"
+ $"0200 0001 FE00 0001 FA00 7F01 0001 0100"
+ $"0100 0100 0101 0001 0001 0100 0100 0100"
+ $"0101 0001 0001 0100 0100 0101 0001 0001"
+ $"0100 0100 0100 0101 0001 0001 0100 0100"
+ $"0101 0001 0001 0100 0100 0101 0001 0001"
+ $"0100 0100 0100 0101 0001 0001 0100 0100"
+ $"0101 0001 0001 0100 0100 0101 0001 0001"
+ $"0100 0100 0101 0001 0001 0100 0100 0101"
+ $"0001 0001 0100 0100 0101 000A 0100 0101"
+ $"0001 0001 0100 01FA 0010 FD00 0501 0000"
+ $"0100 0181 00ED 0001 0100 150B 0000 0100"
+ $"0001 0000 0100 0001 8100 F000 0201 0000"
+ $"00FF"
+};
+/*
+ * Here is the custom file open dialog. This dialog is used instead of
+ * the default file dialog if the -filetypes flag is specified.
+ */
+
+resource 'DLOG' (130, purgeable) {
+ {0, 0, 195, 344}, dBoxProc, invisible, noGoAway, 0,
+ 130, ""
+};
+
+resource 'DITL' (130, "File Open Box", purgeable) {
+ {
+ {135, 252, 155, 332}, Button {enabled, "Open"},
+ {104, 252, 124, 332}, Button {enabled, "Cancel"},
+ { 0, 0, 0, 0}, HelpItem {disabled, HMScanhdlg {130}},
+ { 8, 235, 24, 337}, UserItem {enabled},
+ { 32, 252, 52, 332}, Button {enabled, "Eject"},
+ { 60, 252, 80, 332}, Button {enabled, "Desktop"},
+ { 29, 12, 159, 230}, UserItem {enabled},
+ { 6, 12, 25, 230}, UserItem {enabled},
+ { 91, 251, 92, 333}, Picture {disabled, 11},
+ {168, 20, 187, 300}, Control {enabled, 131}
+ }
+};
+
+resource 'CNTL' (131, "File Types menu", purgeable) {
+ {168, 20, 187, 300},
+ popupTitleLeftJust,
+ visible,
+ 80,
+ 132,
+ popupMenuCDEFProc,
+ 0,
+ "File Type:"
+};
+
+
+resource 'MENU' (132, preload) {
+ 132,
+ textMenuProc,
+ 0xFFFF, enabled, "", {}
+};
diff --git a/itcl/itk/mac/itkMacTclCode.r b/itcl/itk/mac/itkMacTclCode.r
new file mode 100644
index 00000000000..898da31b4dc
--- /dev/null
+++ b/itcl/itk/mac/itkMacTclCode.r
@@ -0,0 +1,29 @@
+/*
+ * itkMacTclCode.r
+ *
+ * This file includes the Itk code that is needed to startup Itk.
+ * It is to be included either in the resource fork of the shared library, or in the
+ * resource fork of the application for a statically bound application.
+ *
+ * Jim Ingham
+ * Lucent Technologies 1996
+ *
+ */
+
+
+#define ITK_LIBRARY_RESOURCES 3500
+
+/*
+ * We now load the Itk library into the resource fork of the application.
+ */
+
+read 'TEXT' (ITK_LIBRARY_RESOURCES+1, "itk", purgeable)
+ "::library:itk.tcl";
+read 'TEXT' (ITK_LIBRARY_RESOURCES+3, "Itk_Archetype", purgeable)
+ "::library:Archetype.itk";
+read 'TEXT' (ITK_LIBRARY_RESOURCES+4, "Itk_Widget", purgeable)
+ "::library:Widget.itk";
+read 'TEXT' (ITK_LIBRARY_RESOURCES+5, "Itk_Toplevel", purgeable)
+ "::library:Toplevel.itk";
+
+
diff --git a/itcl/itk/mac/itkStaticApplication.r b/itcl/itk/mac/itkStaticApplication.r
new file mode 100644
index 00000000000..05b411c4c01
--- /dev/null
+++ b/itcl/itk/mac/itkStaticApplication.r
@@ -0,0 +1,29 @@
+/*
+ * itkStaticApplication.r --
+ *
+ * This file creates resources which bind in the static version of the
+ * pkgIndex tclIndex and itk's Tcl code files.
+ *
+ * Jim Ingham for Itcl 2.2
+ *
+ * Copyright (c) 1996 Lucent Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * SCCS: @(#) itkStaticApplication.r 1.5 96/10/03 17:54:21
+ */
+
+#include <Types.r>
+#include <SysTypes.r>
+
+#define ITK_LIBRARY_RESOURCES 3500
+
+#include "itkMacTclCode.r"
+
+data 'TEXT' (ITK_LIBRARY_RESOURCES+6,"itk:pkgIndex",purgeable, preload) {
+ "# Tcl package index file, version 1.0\n"
+ "package ifneeded Itk 2.2 {load {} Itk}\n"
+};
+read 'TEXT' (ITK_LIBRARY_RESOURCES+2, "Itk:tclIndex", purgeable)
+ "::mac:tclIndex";
diff --git a/itcl/itk/mac/pkgIndex.tcl b/itcl/itk/mac/pkgIndex.tcl
new file mode 100644
index 00000000000..8b8cad8bea4
--- /dev/null
+++ b/itcl/itk/mac/pkgIndex.tcl
@@ -0,0 +1,3 @@
+# Tcl package index file, version 1.0
+
+package ifneeded Itk 3.0 [list load [file join $dir itk30[info sharedlibextension]] Itk]
diff --git a/itcl/itk/mac/tclIndex b/itcl/itk/mac/tclIndex
new file mode 100644
index 00000000000..21cadd3695b
--- /dev/null
+++ b/itcl/itk/mac/tclIndex
@@ -0,0 +1,11 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(::itk::Archetype) [list source -rsrc Itk_Archetype]
+set auto_index(::itk::Toplevel) [list source -rsrc Itk_Toplevel]
+set auto_index(::itk::Widget) [list source -rsrc Itk_Widget]
diff --git a/itcl/itk/mac/tkMacAppInit.c b/itcl/itk/mac/tkMacAppInit.c
new file mode 100644
index 00000000000..cc606a490a5
--- /dev/null
+++ b/itcl/itk/mac/tkMacAppInit.c
@@ -0,0 +1,418 @@
+/*
+ * 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 <Appearance.h>
+
+#include "tk.h"
+#include "tkInt.h"
+#include "tkMacInt.h"
+#include "tclMac.h"
+
+#include "itk.h"
+
+/* include tclInt.h for access to namespace API */
+#include "tclInt.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));
+
+/*
+ * Prototypes for functions the ANSI library needs to link against.
+ */
+short InstallConsole _ANSI_ARGS_((short fd));
+void RemoveConsole _ANSI_ARGS_((void));
+long WriteCharsToConsole _ANSI_ARGS_((char *buff, long n));
+long ReadCharsFromConsole _ANSI_ARGS_((char *buff, long n));
+extern char * __ttyname _ANSI_ARGS_((long fildes));
+short SIOUXHandleOneEvent _ANSI_ARGS_((EventRecord *event));
+
+/*
+ * Prototypes for functions from the tkConsole.c file.
+ */
+
+EXTERN void TkConsoleCreate _ANSI_ARGS_((void));
+EXTERN int TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
+ int devId, char *buffer, long size));
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int MacintoshInit _ANSI_ARGS_((void));
+static int SetupMainInterp _ANSI_ARGS_((Tcl_Interp *interp));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ * Main program for Wish.
+ *
+ * Results:
+ * None. This procedure never returns (it exits the process when
+ * it's done
+ *
+ * Side effects:
+ * This procedure initializes the wish world and then
+ * calls Tk_Main.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+main(
+ int argc, /* Number of arguments. */
+ char **argv) /* Array of argument strings. */
+{
+ char *newArgv[2];
+
+ if (MacintoshInit() != TCL_OK) {
+ Tcl_Exit(1);
+ }
+
+ argc = 1;
+ newArgv[0] = "itkwish";
+ newArgv[1] = NULL;
+ Tk_Main(argc, newArgv, Tcl_AppInit);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppInit(
+ 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);
+
+ /*
+ * Call the init procedures for included packages. Each call should
+ * look like this:
+ *
+ * if (Mod_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * where "Mod" is the name of the module.
+ */
+
+#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) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tktest", Tktest_Init,
+ (Tcl_PackageInitProc *) NULL);
+#endif /* TK_TEST */
+
+ /*
+ * Call Tcl_CreateCommand for application-specific commands, if
+ * they weren't already created by the init procedures called above.
+ * Each call would look like this:
+ *
+ * Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
+ */
+ if (Itcl_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (Itk_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Itcl", Itcl_Init, Itcl_SafeInit);
+ Tcl_StaticPackage(interp, "Itk", Itk_Init, (Tcl_PackageInitProc *) NULL);
+
+ /*
+ * This is itkwish, so import all [incr Tcl] commands by
+ * default into the global namespace. Fix up the autoloader
+ * to do the same.
+ */
+ if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
+ "::itk::*", /* allowOverwrite */ 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
+ "::itcl::*", /* allowOverwrite */ 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_Eval(interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* ::itk::* }") != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ SetupMainInterp(interp);
+
+ /*
+ * Specify a user-specific startup script to invoke if the application
+ * is run interactively. On the Mac we can specifiy either a TEXT resource
+ * which contains the script or the more UNIX like file location
+ * may also used. (I highly recommend using the resource method.)
+ */
+
+ Tcl_SetVar(interp, "tcl_rcRsrcName", "itkwishrc", TCL_GLOBAL_ONLY);
+ /* Tcl_SetVar(interp, "tcl_rcFileName", "~/.itkwishrc", TCL_GLOBAL_ONLY); */
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MacintoshInit --
+ *
+ * This procedure calls Mac specific initilization calls. Most of
+ * these calls must be made as soon as possible in the startup
+ * process.
+ *
+ * Results:
+ * Returns TCL_OK if everything went fine. If it didn't the
+ * application should probably fail.
+ *
+ * Side effects:
+ * Inits the application.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MacintoshInit()
+{
+ int i;
+ long result, mask = 0x0700; /* mask = system 7.x */
+
+#if GENERATING68K && !GENERATINGCFM
+ SetApplLimit(GetApplLimit() - (TK_MAC_68K_STACK_GROWTH));
+#endif
+ MaxApplZone();
+ for (i = 0; i < 4; i++) {
+ (void) MoreMasters();
+ }
+
+ /*
+ * 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();
+
+ /*
+ * Make sure we are running on system 7 or higher
+ */
+
+ if ((NGetTrapAddress(_Gestalt, ToolTrap) ==
+ NGetTrapAddress(_Unimplemented, ToolTrap))
+ || (((Gestalt(gestaltSystemVersion, &result) != noErr)
+ || (result < mask)))) {
+ panic("Tcl/Tk requires System 7 or higher.");
+ }
+
+ /*
+ * Make sure we have color quick draw
+ * (this means we can't run on 68000 macs)
+ */
+
+ if (((Gestalt(gestaltQuickdrawVersion, &result) != noErr)
+ || (result < gestalt32BitQD13))) {
+ panic("Tk requires Color QuickDraw.");
+ }
+
+
+ FlushEvents(everyEvent, 0);
+ SetEventMask(everyEvent);
+
+
+ Tcl_MacSetEventProc(TkMacConvertEvent);
+ TkConsoleCreate();
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetupMainInterp --
+ *
+ * This procedure calls initalization routines require a Tcl
+ * interp as an argument. This call effectively makes the passed
+ * iterpreter the "main" interpreter for the application.
+ *
+ * Results:
+ * Returns TCL_OK if everything went fine. If it didn't the
+ * application should probably fail.
+ *
+ * Side effects:
+ * More initilization.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetupMainInterp(
+ Tcl_Interp *interp)
+{
+ /*
+ * Initialize the console only if we are running as an interactive
+ * application.
+ */
+
+ TkMacInitAppleEvents(interp);
+ TkMacInitMenus(interp);
+
+ if (strcmp(Tcl_GetVar(interp, "tcl_interactive", TCL_GLOBAL_ONLY), "1")
+ == 0) {
+ if (TkConsoleInit(interp) == TCL_ERROR) {
+ goto error;
+ }
+ }
+
+ /*
+ * Attach the global interpreter to tk's expected global console
+ */
+
+ gStdoutInterp = interp;
+
+ return TCL_OK;
+
+error:
+ panic(interp->result);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InstallConsole, RemoveConsole, etc. --
+ *
+ * The following functions provide the UI for the console package.
+ * Users wishing to replace SIOUX with their own console package
+ * need only provide the four functions below in a library.
+ *
+ * Results:
+ * See SIOUX documentation for details.
+ *
+ * Side effects:
+ * See SIOUX documentation for details.
+ *
+ *----------------------------------------------------------------------
+ */
+
+short
+InstallConsole(short fd)
+{
+#pragma unused (fd)
+
+ return 0;
+}
+
+void
+RemoveConsole(void)
+{
+}
+
+long
+WriteCharsToConsole(char *buffer, long n)
+{
+ TkConsolePrint(gStdoutInterp, TCL_STDOUT, buffer, n);
+ return n;
+}
+
+long
+ReadCharsFromConsole(char *buffer, long n)
+{
+ return 0;
+}
+
+extern char *
+__ttyname(long fildes)
+{
+ static char *__devicename = "null device";
+
+ if (fildes >= 0 && fildes <= 2) {
+ return (__devicename);
+ }
+
+ return (0L);
+}
+
+short
+SIOUXHandleOneEvent(EventRecord *event)
+{
+ return 0;
+}
diff --git a/itcl/itk/tests/all b/itcl/itk/tests/all
new file mode 100644
index 00000000000..b50794c1448
--- /dev/null
+++ b/itcl/itk/tests/all
@@ -0,0 +1,16 @@
+# 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.7 96/02/16 08:55:38
+
+foreach i [lsort [glob *.test]] {
+ if [string match l.*.test $i] {
+ # This is an SCCS lock file; ignore it.
+ continue
+ }
+ puts stdout $i
+ if [catch {source $i} msg] {
+ puts $msg
+ }
+}
diff --git a/itcl/itk/tests/defs b/itcl/itk/tests/defs
new file mode 100644
index 00000000000..4be66bc07c2
--- /dev/null
+++ b/itcl/itk/tests/defs
@@ -0,0 +1,343 @@
+# 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) 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: @(#) defs 1.44 96/10/08 17:26:58
+
+if ![info exists VERBOSE] {
+ set VERBOSE 0
+}
+if ![info exists TESTS] {
+ set TESTS {}
+}
+
+# If tests are being run as root, issue a warning message and set a
+# variable to prevent some tests from running at all.
+
+set user {}
+if {$tcl_platform(platform) == "unix"} {
+ catch {set user [exec whoami]}
+ if {$user == ""} {
+ catch {regexp {^[^(]*\(([^)]*)\)} [exec id] dummy user}
+ }
+ if {$user == ""} {set user root}
+ if {$user == "root"} {
+ puts stdout "Warning: you're executing as root. I'll have to"
+ puts stdout "skip some of the tests, since they'll fail as root."
+ }
+}
+
+# Some of the tests don't work on some system configurations due to
+# differences in word length, file system configuration, etc. In order
+# to prevent false alarms, these tests are generally only run in the
+# master development directory for Tcl. The presence of a file
+# "doAllTests" in this directory is used to indicate that the non-portable
+# tests should be run.
+
+set doNonPortableTests [file exists doAllTests]
+
+# 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 {}
+}
+
+# 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.
+# tempNotPc - The inverse of pcOnly. This flag is used to
+# temporarily disable a test.
+# nonBlockFiles - 1 means this platform supports setting files into
+# nonblocking mode.
+# asyncPipeClose- 1 means this platform supports async flush and
+# async close on a pipe.
+# unixExecs - 1 means this machine has commands such as 'cat',
+# 'echo' etc available.
+
+catch {unset testConfig}
+if {$tcl_platform(platform) == "unix"} {
+ set testConfig(unixOnly) 1
+ set testConfig(tempNotPc) 1
+} else {
+ set testConfig(unixOnly) 0
+}
+if {$tcl_platform(platform) == "macintosh"} {
+ set testConfig(tempNotPc) 1
+ set testConfig(macOnly) 1
+} else {
+ set testConfig(macOnly) 0
+}
+if {$tcl_platform(platform) == "windows"} {
+ set testConfig(pcOnly) 1
+} else {
+ set testConfig(pcOnly) 0
+}
+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) [file exists doAllTests]
+
+set f [open defs r]
+if {[expr [catch {fconfigure $f -blocking off}]] == 0} {
+ set testConfig(nonBlockFiles) 1
+} else {
+ set testConfig(nonBlockFiles) 0
+}
+close $f
+
+# 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 testConfig(asyncPipeClose) 0
+ } else {
+ set testConfig(asyncPipeClose) 1
+ }
+} else {
+ set testConfig(asyncPipeClose) 1
+}
+
+# Test to see if execed commands such as cat, echo, rm and so forth are
+# present on this machine.
+
+set testConfig(unixExecs) 1
+if {$tcl_platform(platform) == "macintosh"} {
+ set testConfig(unixExecs) 0
+}
+if {($testConfig(unixExecs) == 1) && ($tcl_platform(platform) == "windows")} {
+ if {[catch {exec cat defs}] == 1} {
+ set testConfig(unixExecs) 0
+ }
+ if {($testConfig(unixExecs) == 1) && ([catch {exec echo hello}] == 1)} {
+ set testConfig(unixExecs) 0
+ }
+ if {($testConfig(unixExecs) == 1) && \
+ ([catch {exec sh -c echo hello}] == 1)} {
+ set testConfig(unixExecs) 0
+ }
+ if {($testConfig(unixExecs) == 1) && ([catch {exec wc defs}] == 1)} {
+ set testConfig(unixExecs) 0
+ }
+ if {$testConfig(unixExecs) == 1} {
+ exec echo hello > removeMe
+ if {[catch {exec rm removeMe}] == 1} {
+ set testConfig(unixExecs) 0
+ }
+ }
+ if {($testConfig(unixExecs) == 1) && ([catch {exec sleep 1}] == 1)} {
+ set testConfig(unixExecs) 0
+ }
+ if {($testConfig(unixExecs) == 1) && \
+ ([catch {exec fgrep unixExecs defs}] == 1)} {
+ set testConfig(unixExecs) 0
+ }
+ if {($testConfig(unixExecs) == 1) && ([catch {exec ps}] == 1)} {
+ set testConfig(unixExecs) 0
+ }
+ if {($testConfig(unixExecs) == 1) && \
+ ([catch {exec echo abc > removeMe}] == 0) && \
+ ([catch {exec chmod 644 removeMe}] == 1) && \
+ ([catch {exec rm removeMe}] == 0)} {
+ set testConfig(unixExecs) 0
+ } else {
+ catch {exec rm -f removeMe}
+ }
+ if {($testConfig(unixExecs) == 1) && \
+ ([catch {exec mkdir removeMe}] == 1)} {
+ set testConfig(unixExecs) 0
+ } else {
+ catch {exec rm -r removeMe}
+ }
+ if {$testConfig(unixExecs) == 0} {
+ puts stdout "Warning: Unix-style executables are not available, so"
+ puts stdout "some tests will be skipped."
+ }
+}
+
+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} then {
+ set ok 0
+ foreach test $TESTS {
+ if [string match $test $name] then {
+ set ok 1
+ break
+ }
+ }
+ if !$ok then 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]
+ foreach constraint $constraints {
+ if {![info exists testConfig($constraint)]
+ || !$testConfig($constraint)} {
+ 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} then {
+ if $VERBOSE then {
+ if {$VERBOSE > 0} {
+ print_verbose $name $description $script \
+ $code $result
+ }
+ 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
+}
+
+proc normalizeMsg {msg} {
+ regsub "\n$" [string tolower $msg] "" msg
+ regsub -all "\n\n" $msg "\n" msg
+ regsub -all "\n\}" $msg "\}" msg
+ return $msg
+}
+
+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
+}
+
+proc makeDirectory {name} {
+ file mkdir $name
+}
+
+proc removeDirectory {name} {
+ file delete -force $name
+}
+
+proc viewFile {name} {
+ global tcl_platform testConfig
+ if {($tcl_platform(platform) == "macintosh") || \
+ ($testConfig(unixExecs) == 0)} {
+ set f [open $name]
+ set data [read -nonewline $f]
+ close $f
+ return $data
+ } else {
+ exec cat $name
+ }
+}
+
+# Locate tcltest executable
+
+set tcltest [list [info nameofexecutable]]
+if {$tcltest == "{}"} {
+ set tcltest {}
+ puts "Unable to find tcltest executable, multiple process tests will fail."
+}
+
+
diff --git a/itcl/itk/tests/interp.test b/itcl/itk/tests/interp.test
new file mode 100644
index 00000000000..894b3c6f88b
--- /dev/null
+++ b/itcl/itk/tests/interp.test
@@ -0,0 +1,48 @@
+#
+# Tests for using [incr Tcl] in slave interpreters
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Make sure that slave interpreters can be created and loaded
+# with [incr Tcl] / [incr Tk]...
+# ----------------------------------------------------------------------
+test interp-1.1 {create a slave interp with [incr Tk]} {
+ interp create slave
+ load "" Itcl slave
+ load "" Tk slave
+ load "" Itk slave
+ list [slave eval "namespace children :: ::itk"] [interp delete slave]
+} {::itk {}}
+
+test interp-1.2 {can't load [incr Tk] into a safe interp} {
+ interp create -safe slave
+ load "" Itcl slave
+ set result [list [catch {load "" Itk slave} msg] $msg]
+ interp delete slave
+ set result
+} {1 {can't use package in a safe interpreter: no Itk_SafeInit procedure}}
+
+test interp-1.3 {errors are okay when slave interp is deleted} {
+ interp create slave
+ load "" Itcl slave
+ load "" Tk slave
+ load "" Itk slave
+ slave eval {
+ label .l
+ bind .l <Destroy> {error "dying!"}
+ }
+ interp delete slave
+} {}
diff --git a/itcl/itk/tests/option.test b/itcl/itk/tests/option.test
new file mode 100644
index 00000000000..857525c4deb
--- /dev/null
+++ b/itcl/itk/tests/option.test
@@ -0,0 +1,179 @@
+#
+# Basic tests for [incr Tk] mega-widgets
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Component option processing
+# ----------------------------------------------------------------------
+test option-1.1 {create a widget for the following tests} {
+ itcl::class TestOptComp {
+ inherit itk::Widget
+ constructor {args} {
+ itk_component add test1 {
+ label $itk_interior.t1
+ } {
+ keep -background -foreground -cursor
+ keep -text
+ }
+ pack $itk_component(test1) -side left -padx 2
+ eval itk_initialize $args
+ }
+ private variable status ""
+ public method action {info} {
+ lappend status $info
+ }
+ public method do {cmd} {
+ eval $cmd
+ }
+ itk_option define -status status Status {} {
+ lappend status $itk_option(-status)
+ }
+ }
+
+ itcl::class TestOptWidget {
+ inherit itk::Widget
+ constructor {args} {
+ itk_component add test1 {
+ label $itk_interior.t1
+ } {
+ keep -background -foreground -cursor
+ keep -text
+ }
+ pack $itk_component(test1) -side left -padx 2
+ eval itk_initialize $args
+ }
+ public method do {cmd} {
+ eval $cmd
+ }
+ }
+ TestOptWidget .#auto
+} {.testOptWidget0}
+
+test option-1.2 {"keep" can be called more than once} {
+ .testOptWidget0 do {
+ itk_component add k0 {
+ TestOptComp $itk_interior.k0 -status "create"
+ } {
+ keep -background -foreground -cursor
+ keep -background -foreground -cursor
+ keep -status
+ keep -status
+ }
+ pack $itk_component(k0)
+ }
+ .testOptWidget0 configure -status "foo"
+ .testOptWidget0 component k0 do {set status}
+} {create foo}
+
+test option-1.3 {"rename" can be called more than once} {
+ .testOptWidget0 do {
+ itk_component add k1 {
+ TestOptComp $itk_interior.k1 -status "create"
+ } {
+ rename -status -test test Test
+ rename -status -test test Test
+ }
+ pack $itk_component(k1)
+ }
+ .testOptWidget0 configure -test "bar"
+ .testOptWidget0 component k1 do {set status}
+} {create bar}
+
+test option-1.4 {"ignore" overrides keep and rename} {
+ .testOptWidget0 do {
+ itk_component add k2 {
+ TestOptComp $itk_interior.k2 -status "create"
+ } {
+ keep -status
+ rename -status -test test Test
+ ignore -status
+ }
+ pack $itk_component(k2)
+ }
+ .testOptWidget0 configure -status k2 -test k2
+ .testOptWidget0 component k2 do {set status}
+} {create foo bar}
+
+# ----------------------------------------------------------------------
+# Option processing with "usual" command
+# ----------------------------------------------------------------------
+test option-2.1 {create a widget for the following tests} {
+ TestOptComp .testUsual
+} {.testUsual}
+
+test option-2.2 {register some "usual" code} {
+ usual TestOptComp-test {keep -cursor -foreground}
+} {}
+
+test option-2.3 {query back "usual" code} {
+ usual TestOptComp-test
+} {keep -cursor -foreground}
+
+test option-2.4 {query back unknown "usual" code} {
+ usual xyzzyxyzzy
+} {}
+
+test option-2.5 {add a component using "usual" code} {
+ .testUsual do {
+ itk_component add u0 {
+ label $itk_interior.u0 -text "Usual Test #0"
+ } {
+ usual TestOptComp-test
+ }
+ pack $itk_component(u0)
+ }
+ .testUsual configure -foreground green -cursor gumby
+
+ list [.testUsual component u0 cget -foreground] \
+ [.testUsual component u0 cget -cursor]
+} {green gumby}
+
+test option-2.6 {override "usual" options} {
+ .testUsual do {
+ itk_component add u1 {
+ label $itk_interior.u1 -text "Usual Test #1"
+ } {
+ usual TestOptComp-test
+ ignore -cursor
+ keep -background
+ }
+ pack $itk_component(u1)
+ }
+ .testUsual configure -foreground red -background white -cursor dot
+
+ list [.testUsual component u1 cget -foreground] \
+ [.testUsual component u1 cget -background] \
+ [.testUsual component u1 cget -cursor]
+} {red white gumby}
+
+set unique 0
+foreach widget {button canvas checkbutton entry frame label listbox
+ menu menubutton message radiobutton scale scrollbar
+ text toplevel} {
+ set name "c[incr unique]"
+ test option-2.7.$name {verify "usual" options for all Tk widgets} {
+ .testUsual do [format {
+ itk_component add %s {
+ %s $itk_interior.%s
+ }
+ } $name $widget $name]
+ } $name
+}
+
+# ----------------------------------------------------------------------
+# Clean up
+# ----------------------------------------------------------------------
+itcl::delete class TestOptComp TestOptWidget
diff --git a/itcl/itk/tests/privacy.test b/itcl/itk/tests/privacy.test
new file mode 100644
index 00000000000..19ce700fd44
--- /dev/null
+++ b/itcl/itk/tests/privacy.test
@@ -0,0 +1,94 @@
+#
+# Privacy options for components
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Define a base class with public variables and a simple mega-widget
+# ----------------------------------------------------------------------
+test privacy-1.1 {define simple mega-widget class} {
+ itcl::class TestPrivacy {
+ inherit itk::Widget
+ constructor {args} {
+ eval itk_initialize $args
+ }
+ method do {args} {
+ return [eval $args]
+ }
+ }
+ set testobj [TestPrivacy .#auto]
+ pack $testobj
+} {}
+
+test privacy-1.2 {"itk_component add" requires certain arguments} {
+ list [catch {$testobj do itk_component add foo} msg] $msg \
+ [catch {$testobj do itk_component add foo bar baz qux} msg] $msg
+} {1 {wrong # args: should be "itk_component add ?-protected? ?-private? ?--? name createCmds ?optionCmds?"} 1 {wrong # args: should be "add ?-protected? ?-private? ?--? name createCmds ?optionCmds?}}
+
+test privacy-1.3 {"itk_component add" rejects invalid options} {
+ list [catch {
+ $testobj do itk_component add -foo bar baz qux
+ } msg] $msg \
+ [catch {
+ $testobj do itk_component add -- -foo {label $itk_interior.l}
+ } msg] $msg
+} {1 {bad option "-foo": should be -private, -protected or --} 0 -foo}
+
+test privacy-1.4 {"itk_component add" recognizes privacy options} {
+ list [catch {
+ $testobj do itk_component add -protected x {label $itk_interior.x}
+ } msg] $msg \
+ [catch {
+ $testobj do itk_component add -private y {label $itk_interior.y}
+ } msg] $msg
+} {0 x 0 y}
+
+test privacy-1.5 {protected/private components are hidden} {
+ list [lsort [$testobj component]] \
+ [lsort [$testobj do component]]
+} {{-foo hull} {-foo hull x y}}
+
+test privacy-1.6 {define a derived class and add protected/private comps} {
+ itcl::class TestMorePrivacy {
+ inherit TestPrivacy
+ constructor {args} {
+ eval itk_initialize $args
+ }
+ method do {args} {
+ return [eval $args]
+ }
+ }
+ set testobj2 [TestMorePrivacy .#auto]
+ $testobj2 TestPrivacy::do itk_component add -private x {
+ label $itk_interior.x
+ }
+ $testobj2 TestPrivacy::do itk_component add -protected y {
+ label $itk_interior.y
+ }
+ $testobj2 TestPrivacy::do itk_component add z {
+ label $itk_interior.z
+ }
+} {z}
+
+test privacy-1.7 {components are visible depending on namespace context} {
+ list [lsort [$testobj2 component]] \
+ [lsort [$testobj2 do component]] \
+ [lsort [$testobj2 TestPrivacy::do component]]
+} {{hull z} {hull y z} {hull x y z}}
+
+# ----------------------------------------------------------------------
+# Clean up
+# ----------------------------------------------------------------------
+itcl::delete class TestPrivacy TestMorePrivacy
diff --git a/itcl/itk/tests/public.test b/itcl/itk/tests/public.test
new file mode 100644
index 00000000000..03f54ac5737
--- /dev/null
+++ b/itcl/itk/tests/public.test
@@ -0,0 +1,75 @@
+#
+# Public variables as configuration options
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Define a base class with public variables and a simple mega-widget
+# ----------------------------------------------------------------------
+test public-1.1 {define base class and simple mega-widget class} {
+ itcl::class test_public_base {
+ public variable null
+ public variable background "not used"
+ public variable message
+ }
+ itcl::configbody test_public_base::message {
+ global ::test_public_status
+ lappend test_public_status "message: $message"
+ }
+ itcl::configbody test_public_base::background {
+ global ::test_public_status
+ lappend test_public_status "background: $background"
+ }
+ option add *TestPublic.background red
+ option add *TestPublic.foreground white
+ option add *TestPublic.cursor trek
+ option add *TestPublic.message "Hello, World!"
+
+ itcl::class TestPublic {
+ inherit itk::Widget test_public_base
+ constructor {args} {
+ itk_component add mesg {
+ label $itk_interior.mesg
+ } {
+ keep -background -foreground -cursor
+ rename -text -message message Message
+ }
+ pack $itk_component(mesg) -side left -padx 2
+
+ eval itk_initialize $args
+ }
+ }
+ set testobj [TestPublic .#auto]
+ pack $testobj
+} {}
+
+test public-1.2 {check the list of configuration options} {
+ $testobj configure
+} {{-background background Background red red} {-clientdata clientData ClientData {} {}} {-cursor cursor Cursor trek trek} {-foreground foreground Foreground white white} {-message message Message {Hello, World!} {Hello, World!}} {-null {} {} {} {}}}
+
+test public-1.3 {uninitialized public variables are set to ""} {
+ $testobj info variable null
+} {public variable ::test_public_base::null <undefined> {} {}}
+
+test public-1.4 {config code gets fired off} {
+ set test_public_status ""
+ $testobj configure -background blue -message "All Clear"
+ set test_public_status
+} {{background: blue} {message: All Clear}}
+
+# ----------------------------------------------------------------------
+# Clean up
+# ----------------------------------------------------------------------
+itcl::delete class TestPublic test_public_base
diff --git a/itcl/itk/tests/toplevel.test b/itcl/itk/tests/toplevel.test
new file mode 100644
index 00000000000..ac6a07f0eb9
--- /dev/null
+++ b/itcl/itk/tests/toplevel.test
@@ -0,0 +1,80 @@
+#
+# Tests for [incr Tk] widgets based on itk::Toplevel
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Toplevel mega-widget
+# ----------------------------------------------------------------------
+test toplevel-1.1 {define a toplevel mega-widget class} {
+ option add *TestToplevel.background linen
+ option add *TestToplevel.cursor ""
+ option add *TestToplevel.foreground navy
+ option add *TestToplevel.highlight white
+ option add *TestToplevel.normal ivory
+ option add *TestToplevel.text ""
+
+ itcl::class TestToplevel {
+ inherit itk::Toplevel
+ constructor {args} {
+ itk_component add test1 {
+ label $itk_interior.t1
+ } {
+ keep -background -foreground -cursor
+ keep -text
+ }
+ pack $itk_component(test1) -side left -padx 2
+ eval itk_initialize $args
+ }
+ public method do {cmd} {
+ eval $cmd
+ }
+
+ private variable status ""
+ itk_option define -background background Background {} {
+ lappend status "background: $itk_option(-background)"
+ }
+ }
+ TestToplevel .#auto
+} {.testToplevel0}
+
+test toplevel-1.2 {check the list of configuration options} {
+ .testToplevel0 configure
+} {{-background background Background linen linen} {-clientdata clientData ClientData {} {}} {-cursor cursor Cursor {} {}} {-foreground foreground Foreground navy navy} {-takefocus takeFocus TakeFocus 0 0} {-text text Text {} {}} {-title title Title {} {}}}
+
+test toplevel-1.3 {check the list components} {
+ lsort [.testToplevel0 component]
+} {hull test1}
+
+test toplevel-1.4 {check the propagation of configuration options} {
+ .testToplevel0 configure -background red
+ list [.testToplevel0 component hull cget -background] \
+ [.testToplevel0 component test1 cget -background] \
+ [.testToplevel0 do {set status}]
+} {red red {{background: linen} {background: red}}}
+
+test toplevel-1.5 {mega-widgets show up on the object list} {
+ itcl::find objects .testToplevel*
+} {.testToplevel0}
+
+test toplevel-1.6 {when a mega-widget is destroyed, its object is deleted} {
+ destroy .testToplevel0
+ itcl::find objects .testToplevel*
+} {}
+
+# ----------------------------------------------------------------------
+# Clean up
+# ----------------------------------------------------------------------
+itcl::delete class TestToplevel
diff --git a/itcl/itk/tests/widget.test b/itcl/itk/tests/widget.test
new file mode 100644
index 00000000000..f793b7d81c4
--- /dev/null
+++ b/itcl/itk/tests/widget.test
@@ -0,0 +1,243 @@
+#
+# Tests for [incr Tk] widgets based on itk::Widget
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+if {[string compare test [info procs test]] == 1} then {source defs}
+
+# ----------------------------------------------------------------------
+# Simple mega-widget
+# ----------------------------------------------------------------------
+test widget-1.1 {define a simple mega-widget class} {
+ option add *TestWidget.background linen
+ option add *TestWidget.borderWidth 2
+ option add *TestWidget.command ""
+ option add *TestWidget.cursor ""
+ option add *TestWidget.foreground navy
+ option add *TestWidget.highlight white
+ option add *TestWidget.normal ivory
+ option add *TestWidget.text ""
+
+ itcl::class TestWidget {
+ inherit itk::Widget
+ constructor {args} {
+ itk_component add test1 {
+ label $itk_interior.t1
+ } {
+ keep -background -foreground -cursor
+ keep -text
+ }
+ pack $itk_component(test1) -side left -padx 2
+
+ itk_component add test2 {
+ button $itk_interior.t2 -text "Push Me"
+ } {
+ keep -foreground -cursor -borderwidth -command
+ rename -background -normal normal Background
+ rename -activebackground -highlight highlight Foreground
+ }
+ pack $itk_component(test2) -side right -fill x -pady 2
+
+ eval itk_initialize $args
+ }
+ private variable status ""
+ public method action {info} {
+ lappend status $info
+ }
+
+ public method do {cmd} {
+ eval $cmd
+ }
+
+ itk_option define -status status Status {} {
+ lappend status $itk_option(-status)
+ }
+ }
+ TestWidget .#auto
+} {.testWidget0}
+
+pack .testWidget0
+
+test widget-1.2 {check the list of configuration options} {
+ .testWidget0 configure
+} {{-background background Background linen linen} {-borderwidth borderWidth BorderWidth 2 2} {-clientdata clientData ClientData {} {}} {-command command Command {} {}} {-cursor cursor Cursor {} {}} {-foreground foreground Foreground navy navy} {-highlight highlight Foreground white white} {-normal normal Background ivory ivory} {-status status Status {} {}} {-text text Text {} {}}}
+
+set unique 0
+foreach test {
+ {-background {-background background Background linen linen}}
+ {-borderwidth {-borderwidth borderWidth BorderWidth 2 2}}
+ {-clientdata {-clientdata clientData ClientData {} {}}}
+ {-command {-command command Command {} {}}}
+ {-cursor {-cursor cursor Cursor {} {}}}
+ {-foreground {-foreground foreground Foreground navy navy}}
+ {-highlight {-highlight highlight Foreground white white}}
+ {-normal {-normal normal Background ivory ivory}}
+ {-status {-status status Status {} {}}}
+ {-text {-text text Text {} {}}}
+} {
+ set opt [lindex $test 0]
+ set result [lindex $test 1]
+
+ test widget-1.3.[incr unique] {check individual configuration options} {
+ .testWidget0 configure $opt
+ } $result
+}
+
+set unique 0
+foreach test {
+ {-background red}
+ {-borderwidth 1}
+ {-clientdata "foo bar"}
+ {-command {puts "hello!"}}
+ {-cursor trek}
+ {-foreground IndianRed}
+ {-highlight MistyRose}
+ {-normal MistyRose2}
+ {-status "test message"}
+ {-text "Label:"}
+} {
+ set opt [lindex $test 0]
+ set value [lindex $test 1]
+
+ test widget-1.4.[incr unique] {set individual configuration options} {
+ list [.testWidget0 configure $opt $value] \
+ [.testWidget0 cget $opt] \
+ [.testWidget0 do "set itk_option($opt)"]
+ } [list "" $value $value]
+}
+
+test widget-1.5 {check the list components} {
+ lsort [.testWidget0 component]
+} {hull test1 test2}
+
+set unique 0
+foreach test {
+ {hull .testWidget0}
+ {test1 .testWidget0.t1}
+ {test2 .testWidget0.t2}
+} {
+ set name [lindex $test 0]
+ set win [lindex $test 1]
+
+ test widget-1.6 {check the window for each component} {
+ list [.testWidget0 component $name] \
+ [.testWidget0 do "set itk_component($name)"]
+ } [list $win $win]
+}
+
+test widget-1.7 {check the propagation of configuration options} {
+ list [.testWidget0 component hull cget -cursor] \
+ [.testWidget0 component test1 cget -cursor] \
+ [.testWidget0 component test2 cget -cursor]
+} {trek trek trek}
+
+test widget-1.8 {check the propagation of configuration options} {
+ list [.testWidget0 component hull cget -background] \
+ [.testWidget0 component test1 cget -background] \
+ [.testWidget0 component test2 cget -background]
+} {red red MistyRose2}
+
+test widget-1.9 {check the propagation of configuration options} {
+ list [.testWidget0 component test1 cget -text] \
+ [.testWidget0 component test2 cget -text]
+} {Label: {Push Me}}
+
+test widget-1.10 {check the invocation of "config" code} {
+ .testWidget0 do {set status}
+} {{} {test message}}
+
+test widget-1.11a {configure using the "code" command} {
+ .testWidget0 do {configure -command [code $this action "button press"]}
+ .testWidget0 cget -command
+} {namespace inscope ::TestWidget {::.testWidget0 action {button press}}}
+
+test widget-1.11b {execute some code created by "code" command} {
+ .testWidget0 do {set status ""}
+ .testWidget0 component test2 invoke
+ .testWidget0 configure -status "in between"
+ .testWidget0 component test2 invoke
+ .testWidget0 do {set status}
+} {{button press} {in between} {button press}}
+
+test widget-1.12a {components can be added on the fly} {
+ .testWidget0 do {
+ itk_component add test3 {
+ label $itk_interior.t3 -text "Temporary"
+ } {
+ keep -background -foreground -cursor
+ }
+ }
+} {test3}
+
+test widget-1.12b {components can be added on the fly} {
+ .testWidget0 do {
+ pack $itk_component(test3) -fill x
+ }
+} {}
+
+test widget-1.13 {new components show up on the component list} {
+ lsort [.testWidget0 component]
+} {hull test1 test2 test3}
+
+test widget-1.14 {new components are initialized properly} {
+ list [.testWidget0 component test3 cget -background] \
+ [.testWidget0 component test3 cget -foreground] \
+ [.testWidget0 component test3 cget -cursor]
+} {red IndianRed trek}
+
+test widget-1.15 {components can be deleted like ordinary widgets} {
+ destroy [.testWidget0 component test3]
+} {}
+
+test widget-1.16 {dead components are removed from the component list} {
+ lsort [.testWidget0 component]
+} {hull test1 test2}
+
+test widget-1.17 {use "configbody" command to change "config" code} {
+ configbody TestWidget::status {lappend status "new"}
+} {}
+
+test widget-1.18 {"config" code can really change} {
+ .testWidget0 do {set status ""}
+ .testWidget0 configure -status "test message"
+ .testWidget0 configure -status "another"
+ .testWidget0 do {set status}
+} {new new}
+
+test widget-1.19 {"config" code can change back} {
+ configbody TestWidget::status {lappend status $itk_option(-status)}
+} {}
+
+test widget-1.20 {mega-widgets show up on the object list} {
+ itcl::find objects .testWidget*
+} {.testWidget0}
+
+test widget-1.21 {when a mega-widget is destroyed, its object is deleted} {
+ destroy .testWidget0
+ itcl::find objects .testWidget*
+} {}
+
+test widget-1.22 {recreate a test widget} {
+ TestWidget .testWidget0
+ itcl::find objects .testWidget*
+} {.testWidget0}
+
+test widget-1.23 {when an object is deleted the widget is destroyed} {
+ itcl::delete object .testWidget0
+ winfo exists .testWidget0
+} {0}
+
+# ----------------------------------------------------------------------
+# Clean up
+# ----------------------------------------------------------------------
+itcl::delete class TestWidget
diff --git a/itcl/itk/unix/Makefile.in b/itcl/itk/unix/Makefile.in
new file mode 100644
index 00000000000..d7f227178ba
--- /dev/null
+++ b/itcl/itk/unix/Makefile.in
@@ -0,0 +1,336 @@
+#
+# This file is a Makefile for [incr 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$
+
+# Current [incr Tcl] version; used in various names.
+
+MAJOR_VERSION = @ITCL_MAJOR_VERSION@
+MINOR_VERSION = @ITCL_MINOR_VERSION@
+RELEASE_LEVEL = @ITCL_RELEASE_LEVEL@
+VERSION = @ITCL_VERSION@
+
+#----------------------------------------------------------------
+# Things you can change to personalize the Makefile for your own
+# site (you can make these changes in either Makefile.in or
+# Makefile, but changes to Makefile will get lost if you re-run
+# the configuration script).
+#----------------------------------------------------------------
+
+# Default top-level directories in which to install architecture-
+# specific files (exec_prefix) and machine-independent files such
+# as scripts (prefix). The values specified here may be overridden
+# at configure-time with the --exec-prefix and --prefix options
+# to the "configure" script.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+
+# The following definition can be set to non-null for special systems
+# like AFS with replication. It allows the pathnames used for installation
+# to be different than those used for actually reference files at
+# run-time. INSTALL_ROOT is prepended to $prefix and $exec_prefix
+# when installing files.
+INSTALL_ROOT =
+
+# Directory from which applications will reference the library of Tcl
+# scripts (note: you can set the ITK_LIBRARY environment variable at
+# run-time to override the compiled-in location):
+# CYGNUS LOCAL: we use "share" rather than "lib" as the prefix for our
+# Tcl files
+ITK_LIBRARY = $(prefix)/share/itk$(VERSION)
+# END CYGNUS LOCAL
+
+# Path name to use when installing library scripts:
+SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(ITK_LIBRARY)
+
+# Directory in which to install the archive libitk.a:
+LIB_INSTALL_DIR = $(INSTALL_ROOT)$(exec_prefix)/lib
+
+# Path to use at runtime to refer to LIB_INSTALL_DIR:
+LIB_RUNTIME_DIR = $(exec_prefix)/lib
+
+# Directory in which to install the program wish:
+BIN_INSTALL_DIR = $(INSTALL_ROOT)$(exec_prefix)/bin
+
+# Directory in which to install the include file itk.h:
+INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(prefix)/include
+
+# Top-level directory for manual entries:
+MAN_INSTALL_DIR = $(INSTALL_ROOT)$(prefix)/man
+
+# Directory in which to install manual entry for wish:
+MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1
+
+# Directory in which to install manual entries for Tk's C library
+# procedures:
+MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3
+
+# Directory in which to install manual entries for the built-in
+# 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 [incr Tk]:
+TCL_SRC_DIR = @TCL_SRC_DIR@
+
+# The directory containing the Tcl library archive file appropriate
+# for this version of [incr Tk]:
+TCL_LIB_DIR = @TCL_LIB_DIR@
+
+# Library flags for Tcl library
+TCL_LIB_FLAG = @TCL_LIB_FLAG@
+
+# Tcl libraries built with optimization switches have this additional extension
+DBGX = @TCL_DBGX@
+
+# The directory containing the Tk sources and headers appropriate
+# for this version of [incr Tk]:
+TK_SRC_DIR = @TK_SRC_DIR@
+
+# The directory containing the Tk library archive file appropriate
+# for this version of [incr Tk]:
+TK_LIB_DIR = @TK_LIB_DIR@
+
+# Library flags for Tk library
+TK_LIB_FLAG = @TK_LIB_FLAG@
+
+# The directory containing the [incr Tcl] sources and headers appropriate
+# for this version of [incr Tk]:
+ITCL_SRC_DIR = @ITCL_SRC_DIR@
+
+# The directory containing the [incr Tcl] library archive file appropriate
+# for this version of [incr Tk]:
+ITCL_LIB_DIR = @ITCL_LIB_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 = @TK_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 = @TK_XLIBSW@
+
+# Libraries to use when linking: must include at least Tk, Tcl, Xlib,
+# and the math library (in that order). The "LIBS" part will be
+# replaced (or has already been replaced) with relevant libraries as
+# determined by the configure script.
+# CYGNUS LOCAL: Replace TCL_LIB_SPEC with TCL_BUILD_LIB_SPEC since we
+# seldom build from an installed tree.
+
+LIBS = @TK_BUILD_LIB_SPEC@ $(X11_LIB_SWITCHES) \
+ @ITCL_BUILD_LIB_SPEC@ @TCL_BUILD_LIB_SPEC@ \
+ @TCL_LIBS@ @DL_LIBS@ -lc
+# END CYGNUS LOCAL
+
+# To change the compiler switches, for example to change from -O
+# to -g, change the following line:
+CFLAGS = @CFLAGS@
+
+# To disable ANSI-C procedure prototypes reverse the comment characters
+# on the following lines:
+PROTO_FLAGS =
+#PROTO_FLAGS = -DNO_PROTOTYPE
+
+# To enable memory debugging reverse the comment characters on the following
+# lines. Warning: if you enable memory debugging, you must do it
+# *everywhere*, including all the code that calls Tcl, and you must use
+# ckalloc and ckfree everywhere instead of malloc and free.
+MEM_DEBUG_FLAGS =
+#MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG
+
+# 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
+# with the distribution, which is slower but guaranteed to work.
+
+INSTALL = $(TOP_DIR)/../config/install-sh -c
+INSTALL_PROGRAM = ${INSTALL}
+INSTALL_DATA = ${INSTALL} -m 644
+MKINSTALLDIRS = $(TOP_DIR)/../config/mkinstalldirs
+
+# 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.
+
+SHLIB_CFLAGS = @SHLIB_CFLAGS@
+TCL_CFLAGS = @TCL_CFLAGS@
+
+LD_SEARCH_FLAGS = @LD_SEARCH_FLAGS@
+
+ITK_LIB_FILE = @ITK_LIB_FILE@
+#ITK_LIB_FILE = libitk.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@
+
+#----------------------------------------------------------------
+# 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 = @TCL_DEFS@
+RANLIB = @RANLIB@
+TOP_DIR = @ITK_SRC_DIR@
+GENERIC_DIR = $(TOP_DIR)/generic
+UNIX_DIR = $(TOP_DIR)/unix
+
+#----------------------------------------------------------------
+# 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) $(TCL_CFLAGS) $(SHLIB_CFLAGS) \
+-I$(UNIX_DIR) -I$(GENERIC_DIR) \
+-I$(TCL_SRC_DIR)/generic -I$(ITCL_SRC_DIR)/generic \
+-I$(TK_SRC_DIR)/generic $(X11_INCLUDES) \
+$(AC_FLAGS) $(PROTO_FLAGS) $(MEM_DEBUG_FLAGS) $(KEYSYM_FLAGS) \
+-DITK_LIBRARY=\"$(ITK_LIBRARY)\"
+
+OBJS = itk_cmds.o itk_option.o itk_archetype.o itk_util.o
+
+SRCS = $(GENERIC_DIR)/itk_cmds.c $(GENERIC_DIR)/itk_option.c \
+ $(GENERIC_DIR)/itk_archetype.c $(GENERIC_DIR)/itk_util.c
+
+all: itkwish
+
+# The following target is configured by autoconf to generate either
+# a shared library or non-shared library for [incr Tk].
+
+@ITK_LIB_FILE@: ${OBJS}
+ rm -f $(ITK_LIB_FILE)
+ @MAKE_LIB@
+ $(RANLIB) $(ITK_LIB_FILE)
+
+itkwish: tkAppInit.o $(ITK_LIB_FILE) @TCL_LIB_FULL_PATH@ @TK_LIB_FULL_PATH@ \
+ @ITCL_LIB_FULL_PATH@
+ $(CC) @LD_FLAGS@ tkAppInit.o @ITK_BUILD_LIB_SPEC@ \
+ $(LIBS) $(LD_SEARCH_FLAGS) -o itkwish
+
+# 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: itkwish
+ TCLLIBPATH="`pwd` $(TK_LIB_DIR) $(ITCL_LIB_DIR) $(TCL_LIB_DIR)"; export TCLLIBPATH; \
+ LD_LIBRARY_PATH=`pwd`:$(ITCL_LIB_DIR):$(TK_LIB_DIR):$(TCL_LIB_DIR):$(LD_LIBRARY_PATH); export LD_LIBRARY_PATH; \
+ TCL_LIBRARY=$(TCL_SRC_DIR)/library; export TCL_LIBRARY; \
+ TK_LIBRARY=$(TK_SRC_DIR)/library; export TK_LIBRARY; \
+ ITCL_LIBRARY=$(ITCL_SRC_DIR)/library; export ITCL_LIBRARY; \
+ ITK_LIBRARY=$(TOP_DIR)/library; export ITK_LIBRARY; \
+ ( echo cd $(TOP_DIR)/tests\; source all\; exit ) \
+ | ./itkwish -geometry +0+0
+
+install: install-binaries install-libraries install-man
+
+install-binaries: $(ITK_LIB_FILE) itkwish
+ @$(MKINSTALLDIRS) $(LIB_INSTALL_DIR) $(BIN_INSTALL_DIR)
+ @echo "Installing $(ITK_LIB_FILE)"
+ @$(INSTALL_DATA) $(ITK_LIB_FILE) $(LIB_INSTALL_DIR)
+ @(cd $(LIB_INSTALL_DIR); $(RANLIB) $(ITK_LIB_FILE))
+ @chmod 555 $(LIB_INSTALL_DIR)/$(ITK_LIB_FILE)
+ @echo "Installing itkwish"
+ $(INSTALL_PROGRAM) itkwish $(BIN_INSTALL_DIR)/itkwish$(VERSION)
+ @echo "Installing itkConfig.sh"
+ @$(INSTALL_DATA) ../itkConfig.sh $(LIB_INSTALL_DIR)/itkConfig.sh
+
+install-libraries:
+ @$(MKINSTALLDIRS) $(INCLUDE_INSTALL_DIR) $(SCRIPT_INSTALL_DIR)
+ @echo "Installing itk.h"
+ @$(INSTALL_DATA) $(GENERIC_DIR)/itk.h $(INCLUDE_INSTALL_DIR)
+ @for i in $(TOP_DIR)/library/*.* $(TOP_DIR)/library/tclIndex $(UNIX_DIR)/tkAppInit.c; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
+ done;
+ @echo "Installing pkgIndex.tcl"
+ @$(INSTALL_DATA) pkgIndex.tcl $(SCRIPT_INSTALL_DIR)
+
+install-man:
+ @$(MKINSTALLDIRS) $(MAN1_INSTALL_DIR) $(MANN_INSTALL_DIR)
+ @cd $(TOP_DIR)/doc; for i in *.1; \
+ do \
+ echo "Installing doc/$$i"; \
+ rm -f $(MAN1_INSTALL_DIR)/$$i; \
+ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+ $$i > $(MAN1_INSTALL_DIR)/$$i; \
+ chmod 444 $(MAN1_INSTALL_DIR)/$$i; \
+ done;
+ @cd $(TOP_DIR)/doc; for i in *.n; \
+ do \
+ echo "Installing doc/$$i"; \
+ rm -f $(MANN_INSTALL_DIR)/$$i; \
+ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+ $$i > $(MANN_INSTALL_DIR)/$$i; \
+ chmod 444 $(MANN_INSTALL_DIR)/$$i; \
+ done;
+
+Makefile: $(UNIX_DIR)/Makefile.in
+ $(SHELL) config.status
+
+clean:
+ rm -f *.a *.o core errs *~ \#* TAGS *.E a.out errors \
+ rm -f itkwish* libitk* *pure* *% ../tests/core
+
+distclean: clean
+ rm -f Makefile config.status config.log config.cache pkgIndex.tcl
+
+pure: tkAppInit.o $(ITK_LIB_FILE) @TCL_LIB_FULL_PATH@ @TK_LIB_FULL_PATH@
+ purify $(CC) @LD_FLAGS@ tkAppInit.o @ITK_BUILD_LIB_SPEC@ \
+ $(LIBS) $(LD_SEARCH_FLAGS) -o itkwish.pure
+
+profile: tkAppInit.o $(ITK_LIB_FILE) @TCL_LIB_FULL_PATH@ @TK_LIB_FULL_PATH@
+ quantify $(CC) @LD_FLAGS@ tkAppInit.o @ITK_BUILD_LIB_SPEC@ \
+ $(LIBS) $(LD_SEARCH_FLAGS) -o itkwish.pure
+
+depend:
+ makedepend -- $(CC_SWITCHES) -- $(SRCS)
+
+configure: configure.in
+ autoconf
+
+.c.o:
+ $(CC) -c $(CC_SWITCHES) $<
+
+tkAppInit.o: $(UNIX_DIR)/tkAppInit.c Makefile
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkAppInit.c
+
+itk_cmds.o: $(GENERIC_DIR)/itk_cmds.c Makefile
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/itk_cmds.c
+
+itk_option.o: $(GENERIC_DIR)/itk_option.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/itk_option.c
+
+itk_archetype.o: $(GENERIC_DIR)/itk_archetype.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/itk_archetype.c
+
+itk_util.o: $(GENERIC_DIR)/itk_util.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/itk_util.c
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
diff --git a/itcl/itk/unix/configure b/itcl/itk/unix/configure
new file mode 100755
index 00000000000..e3d43ca1d2a
--- /dev/null
+++ b/itcl/itk/unix/configure
@@ -0,0 +1,1608 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+ac_default_prefix=/usr/local
+ac_help="$ac_help
+ --with-tcl=DIR use Tcl 8.0 binaries from DIR"
+ac_help="$ac_help
+ --with-tk=DIR use Tk 8.0 binaries from DIR"
+ac_help="$ac_help
+ --with-itcl=DIR use Itcl 3.0 binaries from DIR"
+ac_help="$ac_help
+ --with-cflags=FLAGS set compiler flags to FLAGS"
+ac_help="$ac_help
+ --enable-shared build libitk as a shared library"
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.13"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=../generic/itk.h
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+# RCS: $Id$
+
+ITCL_VERSION=3.0
+ITCL_MAJOR_VERSION=3
+ITCL_MINOR_VERSION=0
+ITCL_RELEASE_LEVEL=0
+VERSION=${ITCL_VERSION}
+
+ac_aux_dir=
+for ac_dir in ../../config $srcdir/../../config; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in ../../config $srcdir/../../config" 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+
+
+# -----------------------------------------------------------------------
+# Set up a new default --prefix. If a previous installation of
+# [incr Tcl] can be found searching $PATH use that directory.
+# -----------------------------------------------------------------------
+
+
+if test "x$prefix" = xNONE; then
+echo $ac_n "checking for prefix by $ac_c" 1>&6
+# Extract the first word of "tclsh", so it can be a program name with args.
+set dummy tclsh; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:576: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_path_TCLSH'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ case "$TCLSH" in
+ /*)
+ ac_cv_path_TCLSH="$TCLSH" # Let the user override the test with a path.
+ ;;
+ ?:/*)
+ ac_cv_path_TCLSH="$TCLSH" # Let the user override the test with a dos path.
+ ;;
+ *)
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_path_TCLSH="$ac_dir/$ac_word"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac
+fi
+TCLSH="$ac_cv_path_TCLSH"
+if test -n "$TCLSH"; then
+ echo "$ac_t""$TCLSH" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -n "$ac_cv_path_TCLSH"; then
+ prefix=`echo $ac_cv_path_TCLSH|sed 's%/[^/][^/]*//*[^/][^/]*$%%'`
+ fi
+fi
+
+
+if test "${prefix}" = "NONE"; then
+ prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+ exec_prefix=$prefix
+fi
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:633: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ # Account for people who put trailing slashes in PATH elements.
+ case "$ac_dir/" in
+ /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ if test -f $ac_dir/$ac_prog; then
+ if test $ac_prog = install &&
+ grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ else
+ ac_cv_path_install="$ac_dir/$ac_prog -c"
+ break 2
+ fi
+ fi
+ done
+ ;;
+ esac
+ done
+ IFS="$ac_save_IFS"
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL="$ac_cv_path_install"
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL="$ac_install_sh"
+ fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+# Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:688: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_RANLIB="ranlib"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+# -----------------------------------------------------------------------
+BUILD_DIR=`pwd`
+ITK_SRC_DIR=`cd $srcdir/..; pwd`
+cd ${BUILD_DIR}
+
+ # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:724: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:754: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_prog_rejected=no
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -z "$CC"; then
+ case "`uname -s`" in
+ *win32* | *WIN32*)
+ # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:805: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="cl"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+ ;;
+ esac
+ fi
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:837: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 848 "configure"
+#include "confdefs.h"
+
+main(){return(0);}
+EOF
+if { (eval echo configure:853: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cc_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:879: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:884: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:893: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gcc=yes
+else
+ ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+else
+ GCC=
+fi
+
+ac_test_CFLAGS="${CFLAGS+set}"
+ac_save_CFLAGS="$CFLAGS"
+CFLAGS=
+echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:912: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+
+# END CYGNUS LOCAL
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Tcl is; if
+# not, search for Tcl.
+# not, assume that its top-level directory is a sibling of ours.
+# CYGNUS LOCAL - Actually Tcl & Tk are just called "tcl" & "tk" without the 8.0
+#--------------------------------------------------------------------
+
+# Check whether --with-tcl or --without-tcl was given.
+if test "${with_tcl+set}" = set; then
+ withval="$with_tcl"
+ itcl_search=$withval
+else
+ itcl_search=`cd ../../..; ls -d \`pwd\`/tcl*/unix`
+fi
+
+
+TCL_LIB_DIR=""
+for dir in $itcl_search $exec_prefix/lib ; do
+ if test -r $dir/tclConfig.sh; then
+ TCL_LIB_DIR=$dir
+ break
+ fi
+done
+
+if test -z "$TCL_LIB_DIR"; then
+ { echo "configure: error: Can't find Tcl libraries. Use --with-tcl to specify the directory containing tclConfig.sh on your system." 1>&2; exit 1; }
+fi
+
+#--------------------------------------------------------------------
+# Read in configuration information generated by Tcl for shared
+# libraries, and arrange for it to be substituted into our
+# Makefile.
+#--------------------------------------------------------------------
+
+file=$TCL_LIB_DIR/tclConfig.sh
+. $file
+CFLAGS=$TCL_CFLAGS
+SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS
+SHLIB_LD=$TCL_SHLIB_LD
+SHLIB_LD_LIBS=$TCL_SHLIB_LD_LIBS
+SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX
+DL_LIBS=$TCL_DL_LIBS
+LD_FLAGS=$TCL_LD_FLAGS
+LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
+
+#--------------------------------------------------------------------
+# Make sure that we can find the Tcl sources, so we can include
+# the "tclInt.h" file.
+#--------------------------------------------------------------------
+
+if test ! -d "$TCL_SRC_DIR"; then
+ { echo "configure: error: Can't find Tcl source directory "$TCL_SRC_DIR". Itcl can't be built without this directory." 1>&2; exit 1; }
+fi
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Tk is; if
+# not, search for Tk.
+# CYGNUS LOCAL - Actually Tcl & Tk are just called "tcl" & "tk" without the 8.0
+#--------------------------------------------------------------------
+
+# Check whether --with-tk or --without-tk was given.
+if test "${with_tk+set}" = set; then
+ withval="$with_tk"
+ itcl_search=$withval
+else
+ itcl_search=`cd ../../..; ls -d \`pwd\`/tk*/unix`
+fi
+
+
+TK_LIB_DIR=""
+for dir in $itcl_search $exec_prefix/lib ; do
+ if test -r $dir/tkConfig.sh; then
+ TK_LIB_DIR=$dir
+ break
+ fi
+done
+
+if test -z "$TK_LIB_DIR"; then
+ { echo "configure: error: Can't find Tk libraries. Use --with-tk to specify the directory containing tkConfig.sh on your system." 1>&2; exit 1; }
+fi
+
+file=$TK_LIB_DIR/tkConfig.sh
+. $file
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where [incr Tcl] is.
+# If not, assume that its top-level directory is a sibling of ours.
+#--------------------------------------------------------------------
+
+# Check whether --with-itcl or --without-itcl was given.
+if test "${with_itcl+set}" = set; then
+ withval="$with_itcl"
+ ITCL_LIB_DIR=$withval
+else
+ ITCL_LIB_DIR=`cd ../../itcl; pwd`
+fi
+
+
+if test ! -r "$ITCL_LIB_DIR/itclConfig.sh"; then
+ { echo "configure: error: Can't find Itcl libraries. Have you built Itcl yet? Use --with-itcl to specify the directory containing itclConfig.sh on your system." 1>&2; exit 1; }
+fi
+
+file=$ITCL_LIB_DIR/itclConfig.sh
+. $file
+
+#--------------------------------------------------------------------
+# If this is gcc, add some extra compile flags.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking whether C compiler is gcc""... $ac_c" 1>&6
+echo "configure:1055: checking whether C compiler is gcc" >&5
+if eval "test \"`echo '$''{'itcl_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+ echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:1061: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # This must be in double quotes, not single quotes, because CPP may get
+ # substituted into the Makefile and "${CC-cc}" will confuse make.
+ CPP="${CC-cc} -E"
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp.
+ cat > conftest.$ac_ext <<EOF
+#line 1076 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1082: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -E -traditional-cpp"
+ cat > conftest.$ac_ext <<EOF
+#line 1093 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1099: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -nologo -E"
+ cat > conftest.$ac_ext <<EOF
+#line 1110 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1116: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+ ac_cv_prog_CPP="$CPP"
+fi
+ CPP="$ac_cv_prog_CPP"
+else
+ ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+cat > conftest.$ac_ext <<EOF
+#line 1141 "configure"
+#include "confdefs.h"
+
+#ifdef __GNUC__
+_cc_is_gcc_
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "_cc_is_gcc_" >/dev/null 2>&1; then
+ rm -rf conftest*
+ itcl_cv_prog_gcc=yes
+else
+ rm -rf conftest*
+ itcl_cv_prog_gcc=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$itcl_cv_prog_gcc" 1>&6
+
+# CYGNUS LOCAL - set CFLAGS to -g -O2 for gcc.
+if test -z "$CFLAGS" ; then
+if test "$itcl_cv_prog_gcc" = "yes" ; then
+ CFLAGS="-g -O2"
+else
+ CFLAGS="-O"
+fi
+fi
+
+if test "$itcl_cv_prog_gcc" = "yes" ; then
+ # leave -Wimplicit-int out, the X libs generate so many of these warnings
+ # that they obscure everything else.
+ # CYGNUS LOCAL - add -fwritable-strings to CFLAGS for gcc. Needed
+ # with Tcl8.1
+ CFLAGS="$CFLAGS -fwritable-strings -Wshadow -Wtraditional -Wall -Wno-implicit-int"
+fi
+
+echo $ac_n "checking default compiler flags""... $ac_c" 1>&6
+echo "configure:1181: checking default compiler flags" >&5
+# Check whether --with-cflags or --without-cflags was given.
+if test "${with_cflags+set}" = set; then
+ withval="$with_cflags"
+ CFLAGS="$with_cflags"
+fi
+
+
+echo "$ac_t""$CFLAGS" 1>&6
+
+if test "$TCL_CC" != "$CC" ; then
+ echo ""
+ echo "WARNING: Compiler is $CC but Tcl was compiled with $TCL_CC"
+ echo ""
+fi
+
+#--------------------------------------------------------------------
+# The statements below define a collection of symbols related to
+# building libitk as a shared library instead of a static library.
+#--------------------------------------------------------------------
+
+# Check whether --enable-shared or --disable-shared was given.
+if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ ok=$enableval
+else
+ ok=no
+fi
+
+if test "$ok" = "yes"; then
+ if test ${TCL_SHARED_BUILD} = 0; then
+ { echo "configure: error: Tcl was not built with --enable-shared" 1>&2; exit 1; }
+ fi
+ SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+ eval "ITK_LIB_FILE=libitk${VERSION}${SHLIB_SUFFIX}"
+ ITK_PKG_FILE="[file join [file dirname \$dir] ${ITK_LIB_FILE}]"
+ # CYGNUS LOCAL - don't pass LD_SEARCH_FLAGS to libraries
+ MAKE_LIB="\$(SHLIB_LD) -o ${ITK_LIB_FILE} \$(OBJS) "
+ # END CYGNUS LOCAL
+ RANLIB=":"
+else
+ SHLIB_CFLAGS=""
+ # CYGNUS LOCAL - Strip dots from library name for SunOS4, etc...
+ if test ${TCL_LIB_VERSIONS_OK} = "nodots"; then
+ ITK_LIB_FILE="libitk`echo ${VERSION} | tr -d .`.a"
+ else
+ eval "ITK_LIB_FILE=libitk${VERSION}.a"
+ fi
+ ITK_PKG_FILE=""
+ MAKE_LIB="ar cr ${ITK_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
+ ITK_BUILD_LIB_SPEC="-L`pwd` -litk${VERSION}"
+ ITK_LIB_SPEC="-L${exec_prefix}/lib -litk${VERSION}"
+else
+ ITK_BUILD_LIB_SPEC="-L`pwd` -litk`echo ${VERSION} | tr -d .`"
+ ITK_LIB_SPEC="-L${exec_prefix}/lib -litk`echo ${VERSION} | tr -d .`"
+fi
+
+ITK_LIB_FULL_PATH="`pwd`/${ITK_LIB_FILE}"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.13"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "Makefile pkgIndex.tcl ../itkConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@TCLSH@%$TCLSH%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@RANLIB@%$RANLIB%g
+s%@CC@%$CC%g
+s%@CPP@%$CPP%g
+s%@DL_LIBS@%$DL_LIBS%g
+s%@LD_FLAGS@%$LD_FLAGS%g
+s%@MAKE_LIB@%$MAKE_LIB%g
+s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
+s%@SHLIB_LD@%$SHLIB_LD%g
+s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
+s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
+s%@LD_SEARCH_FLAGS@%$LD_SEARCH_FLAGS%g
+s%@TCL_VERSION@%$TCL_VERSION%g
+s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
+s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
+s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
+s%@TCL_LIB_FLAG@%$TCL_LIB_FLAG%g
+s%@TCL_DBGX@%$TCL_DBGX%g
+s%@TCL_DEFS@%$TCL_DEFS%g
+s%@TCL_LIBS@%$TCL_LIBS%g
+s%@TCL_SHLIB_LD_LIBS@%$TCL_SHLIB_LD_LIBS%g
+s%@TCL_SHLIB_SUFFIX@%$TCL_SHLIB_SUFFIX%g
+s%@TCL_COMPAT_OBJS@%$TCL_COMPAT_OBJS%g
+s%@TCL_CFLAGS@%$TCL_CFLAGS%g
+s%@TCL_LIB_FULL_PATH@%$TCL_LIB_FULL_PATH%g
+s%@TK_VERSION@%$TK_VERSION%g
+s%@TK_BUILD_LIB_SPEC@%$TK_BUILD_LIB_SPEC%g
+s%@TK_LIB_DIR@%$TK_LIB_DIR%g
+s%@TK_LIB_SPEC@%$TK_LIB_SPEC%g
+s%@TK_LIB_FLAG@%$TK_LIB_FLAG%g
+s%@TK_XINCLUDES@%$TK_XINCLUDES%g
+s%@TK_XLIBSW@%$TK_XLIBSW%g
+s%@TK_SRC_DIR@%$TK_SRC_DIR%g
+s%@TK_LIB_FULL_PATH@%$TK_LIB_FULL_PATH%g
+s%@ITCL_VERSION@%$ITCL_VERSION%g
+s%@ITCL_MAJOR_VERSION@%$ITCL_MAJOR_VERSION%g
+s%@ITCL_MINOR_VERSION@%$ITCL_MINOR_VERSION%g
+s%@ITCL_RELEASE_LEVEL@%$ITCL_RELEASE_LEVEL%g
+s%@ITCL_BUILD_LIB_SPEC@%$ITCL_BUILD_LIB_SPEC%g
+s%@ITCL_LIB_FULL_PATH@%$ITCL_LIB_FULL_PATH%g
+s%@ITCL_LIB_DIR@%$ITCL_LIB_DIR%g
+s%@ITCL_LIB_SPEC@%$ITCL_LIB_SPEC%g
+s%@ITCL_PKG_FILE@%$ITCL_PKG_FILE%g
+s%@ITCL_SRC_DIR@%$ITCL_SRC_DIR%g
+s%@ITK_BUILD_LIB_SPEC@%$ITK_BUILD_LIB_SPEC%g
+s%@ITK_LIB_FILE@%$ITK_LIB_FILE%g
+s%@ITK_LIB_SPEC@%$ITK_LIB_SPEC%g
+s%@ITK_PKG_FILE@%$ITK_PKG_FILE%g
+s%@ITK_SRC_DIR@%$ITK_SRC_DIR%g
+s%@ITK_LIB_FULL_PATH@%$ITK_LIB_FULL_PATH%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile pkgIndex.tcl ../itkConfig.sh"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+ case "$ac_given_INSTALL" in
+ [/$]*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ esac
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
diff --git a/itcl/itk/unix/configure.in b/itcl/itk/unix/configure.in
new file mode 100644
index 00000000000..7624fe4b3a2
--- /dev/null
+++ b/itcl/itk/unix/configure.in
@@ -0,0 +1,278 @@
+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/itk.h)
+# RCS: $Id$
+
+ITCL_VERSION=3.0
+ITCL_MAJOR_VERSION=3
+ITCL_MINOR_VERSION=0
+ITCL_RELEASE_LEVEL=0
+VERSION=${ITCL_VERSION}
+
+AC_CONFIG_AUX_DIR(../../config)
+AC_PREREQ(2.0)
+
+# -----------------------------------------------------------------------
+# Set up a new default --prefix. If a previous installation of
+# [incr Tcl] can be found searching $PATH use that directory.
+# -----------------------------------------------------------------------
+
+AC_PREFIX_DEFAULT(/usr/local)
+AC_PREFIX_PROGRAM(tclsh)
+
+if test "${prefix}" = "NONE"; then
+ prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+ exec_prefix=$prefix
+fi
+
+AC_PROG_INSTALL
+AC_PROG_RANLIB
+
+# -----------------------------------------------------------------------
+BUILD_DIR=`pwd`
+ITK_SRC_DIR=`cd $srcdir/..; pwd`
+cd ${BUILD_DIR}
+
+dnl CYGNUS LOCAL: allow gcc without a special flag
+dnl AC_ARG_ENABLE(gcc, [ --enable-gcc allow use of gcc if available],
+dnl [itk_ok=$enableval], [itk_ok=no])
+dnl if test "$itk_ok" = "yes"; then
+ AC_PROG_CC
+dnl else
+dnl CC=${CC-cc}
+dnl AC_SUBST(CC)
+dnl fi
+# END CYGNUS LOCAL
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Tcl is; if
+# not, search for Tcl.
+# not, assume that its top-level directory is a sibling of ours.
+# CYGNUS LOCAL - Actually Tcl & Tk are just called "tcl" & "tk" without the 8.0
+#--------------------------------------------------------------------
+
+AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.0 binaries from DIR],
+ itcl_search=$withval, itcl_search=`cd ../../..; ls -d \`pwd\`/tcl*/unix`)
+
+TCL_LIB_DIR=""
+for dir in $itcl_search $exec_prefix/lib ; do
+ if test -r $dir/tclConfig.sh; then
+ TCL_LIB_DIR=$dir
+ break
+ fi
+done
+
+if test -z "$TCL_LIB_DIR"; then
+ AC_MSG_ERROR(Can't find Tcl libraries. Use --with-tcl to specify the directory containing tclConfig.sh on your system.)
+fi
+
+#--------------------------------------------------------------------
+# Read in configuration information generated by Tcl for shared
+# libraries, and arrange for it to be substituted into our
+# Makefile.
+#--------------------------------------------------------------------
+
+file=$TCL_LIB_DIR/tclConfig.sh
+. $file
+CFLAGS=$TCL_CFLAGS
+SHLIB_CFLAGS=$TCL_SHLIB_CFLAGS
+SHLIB_LD=$TCL_SHLIB_LD
+SHLIB_LD_LIBS=$TCL_SHLIB_LD_LIBS
+SHLIB_SUFFIX=$TCL_SHLIB_SUFFIX
+DL_LIBS=$TCL_DL_LIBS
+LD_FLAGS=$TCL_LD_FLAGS
+LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
+
+#--------------------------------------------------------------------
+# Make sure that we can find the Tcl sources, so we can include
+# the "tclInt.h" file.
+#--------------------------------------------------------------------
+
+if test ! -d "$TCL_SRC_DIR"; then
+ AC_MSG_ERROR(Can't find Tcl source directory "$TCL_SRC_DIR". Itcl can't be built without this directory.)
+fi
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Tk is; if
+# not, search for Tk.
+# CYGNUS LOCAL - Actually Tcl & Tk are just called "tcl" & "tk" without the 8.0
+#--------------------------------------------------------------------
+
+AC_ARG_WITH(tk, [ --with-tk=DIR use Tk 8.0 binaries from DIR],
+ itcl_search=$withval, itcl_search=`cd ../../..; ls -d \`pwd\`/tk*/unix`)
+
+TK_LIB_DIR=""
+for dir in $itcl_search $exec_prefix/lib ; do
+ if test -r $dir/tkConfig.sh; then
+ TK_LIB_DIR=$dir
+ break
+ fi
+done
+
+if test -z "$TK_LIB_DIR"; then
+ AC_MSG_ERROR(Can't find Tk libraries. Use --with-tk to specify the directory containing tkConfig.sh on your system.)
+fi
+
+file=$TK_LIB_DIR/tkConfig.sh
+. $file
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where [incr Tcl] is.
+# If not, assume that its top-level directory is a sibling of ours.
+#--------------------------------------------------------------------
+
+AC_ARG_WITH(itcl, [ --with-itcl=DIR use Itcl 3.0 binaries from DIR],
+ ITCL_LIB_DIR=$withval, ITCL_LIB_DIR=`cd ../../itcl; pwd`)
+
+if test ! -r "$ITCL_LIB_DIR/itclConfig.sh"; then
+ AC_MSG_ERROR(Can't find Itcl libraries. Have you built Itcl yet? Use --with-itcl to specify the directory containing itclConfig.sh on your system.)
+fi
+
+file=$ITCL_LIB_DIR/itclConfig.sh
+. $file
+
+#--------------------------------------------------------------------
+# If this is gcc, add some extra compile flags.
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING([whether C compiler is gcc])
+AC_CACHE_VAL(itcl_cv_prog_gcc, [
+ AC_EGREP_CPP(_cc_is_gcc_, [
+#ifdef __GNUC__
+_cc_is_gcc_
+#endif
+], [itcl_cv_prog_gcc=yes], [itcl_cv_prog_gcc=no])])
+AC_MSG_RESULT([$itcl_cv_prog_gcc])
+
+# CYGNUS LOCAL - set CFLAGS to -g -O2 for gcc.
+if test -z "$CFLAGS" ; then
+if test "$itcl_cv_prog_gcc" = "yes" ; then
+ CFLAGS="-g -O2"
+else
+ CFLAGS="-O"
+fi
+fi
+
+if test "$itcl_cv_prog_gcc" = "yes" ; then
+ # leave -Wimplicit-int out, the X libs generate so many of these warnings
+ # that they obscure everything else.
+ # CYGNUS LOCAL - add -fwritable-strings to CFLAGS for gcc. Needed
+ # with Tcl8.1
+ CFLAGS="$CFLAGS -fwritable-strings -Wshadow -Wtraditional -Wall -Wno-implicit-int"
+fi
+
+AC_MSG_CHECKING([default compiler flags])
+AC_ARG_WITH(cflags, [ --with-cflags=FLAGS set compiler flags to FLAGS],
+ [CFLAGS="$with_cflags"])
+
+AC_MSG_RESULT([$CFLAGS])
+
+if test "$TCL_CC" != "$CC" ; then
+ echo ""
+ echo "WARNING: Compiler is $CC but Tcl was compiled with $TCL_CC"
+ echo ""
+fi
+
+#--------------------------------------------------------------------
+# The statements below define a collection of symbols related to
+# building libitk as a shared library instead of a static library.
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(shared,
+ [ --enable-shared build libitk as a shared library],
+ [ok=$enableval], [ok=no])
+if test "$ok" = "yes"; then
+ if test ${TCL_SHARED_BUILD} = 0; then
+ AC_MSG_ERROR(Tcl was not built with --enable-shared, so you can't use shared libraries.)
+ fi
+ SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+ eval "ITK_LIB_FILE=libitk${VERSION}${SHLIB_SUFFIX}"
+ ITK_PKG_FILE="[[file join [file dirname \$dir] ${ITK_LIB_FILE}]]"
+ # CYGNUS LOCAL - don't pass LD_SEARCH_FLAGS to libraries
+ MAKE_LIB="\$(SHLIB_LD) -o ${ITK_LIB_FILE} \$(OBJS) "
+ # END CYGNUS LOCAL
+ RANLIB=":"
+else
+ SHLIB_CFLAGS=""
+ # CYGNUS LOCAL - Strip dots from library name for SunOS4, etc...
+ if test ${TCL_LIB_VERSIONS_OK} = "nodots"; then
+ ITK_LIB_FILE="libitk`echo ${VERSION} | tr -d .`.a"
+ else
+ eval "ITK_LIB_FILE=libitk${VERSION}.a"
+ fi
+ ITK_PKG_FILE=""
+ MAKE_LIB="ar cr ${ITK_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
+ ITK_BUILD_LIB_SPEC="-L`pwd` -litk${VERSION}"
+ ITK_LIB_SPEC="-L${exec_prefix}/lib -litk${VERSION}"
+else
+ ITK_BUILD_LIB_SPEC="-L`pwd` -litk`echo ${VERSION} | tr -d .`"
+ ITK_LIB_SPEC="-L${exec_prefix}/lib -litk`echo ${VERSION} | tr -d .`"
+fi
+
+ITK_LIB_FULL_PATH="`pwd`/${ITK_LIB_FILE}"
+
+AC_SUBST(CFLAGS)
+AC_SUBST(DL_LIBS)
+AC_SUBST(LD_FLAGS)
+AC_SUBST(MAKE_LIB)
+AC_SUBST(SHLIB_CFLAGS)
+AC_SUBST(SHLIB_LD)
+AC_SUBST(SHLIB_LD_LIBS)
+AC_SUBST(SHLIB_SUFFIX)
+AC_SUBST(LD_SEARCH_FLAGS)
+
+AC_SUBST(TCL_VERSION)
+AC_SUBST(TCL_SRC_DIR)
+AC_SUBST(TCL_LIB_SPEC)
+AC_SUBST(TCL_BUILD_LIB_SPEC)
+AC_SUBST(TCL_LIB_FLAG)
+AC_SUBST(TCL_DBGX)
+AC_SUBST(TCL_DEFS)
+AC_SUBST(TCL_LIBS)
+AC_SUBST(TCL_SHLIB_LD_LIBS)
+AC_SUBST(TCL_SHLIB_SUFFIX)
+AC_SUBST(TCL_COMPAT_OBJS)
+AC_SUBST(TCL_CFLAGS)
+AC_SUBST(TCL_LIB_FULL_PATH)
+
+AC_SUBST(TK_VERSION)
+AC_SUBST(TK_BUILD_LIB_SPEC)
+AC_SUBST(TK_LIB_DIR)
+AC_SUBST(TK_LIB_SPEC)
+AC_SUBST(TK_LIB_FLAG)
+AC_SUBST(TK_XINCLUDES)
+AC_SUBST(TK_XLIBSW)
+AC_SUBST(TK_SRC_DIR)
+AC_SUBST(TK_LIB_FULL_PATH)
+
+AC_SUBST(ITCL_VERSION)
+AC_SUBST(ITCL_MAJOR_VERSION)
+AC_SUBST(ITCL_MINOR_VERSION)
+AC_SUBST(ITCL_RELEASE_LEVEL)
+AC_SUBST(ITCL_BUILD_LIB_SPEC)
+AC_SUBST(ITCL_LIB_FULL_PATH)
+AC_SUBST(ITCL_LIB_DIR)
+AC_SUBST(ITCL_LIB_SPEC)
+AC_SUBST(ITCL_PKG_FILE)
+AC_SUBST(ITCL_SRC_DIR)
+
+AC_SUBST(ITK_BUILD_LIB_SPEC)
+AC_SUBST(ITK_LIB_FILE)
+AC_SUBST(ITK_LIB_SPEC)
+AC_SUBST(ITK_PKG_FILE)
+AC_SUBST(ITK_SRC_DIR)
+AC_SUBST(ITK_LIB_FULL_PATH)
+
+AC_OUTPUT(Makefile pkgIndex.tcl ../itkConfig.sh)
diff --git a/itcl/itk/unix/pkgIndex.tcl.in b/itcl/itk/unix/pkgIndex.tcl.in
new file mode 100644
index 00000000000..6ff2a7d78b7
--- /dev/null
+++ b/itcl/itk/unix/pkgIndex.tcl.in
@@ -0,0 +1,3 @@
+# Tcl package index file, version 1.0
+
+package ifneeded Itk @ITCL_VERSION@ [list load "@ITK_PKG_FILE@" Itk]
diff --git a/itcl/itk/unix/tkAppInit.c b/itcl/itk/unix/tkAppInit.c
new file mode 100644
index 00000000000..9d3c240db3e
--- /dev/null
+++ b/itcl/itk/unix/tkAppInit.c
@@ -0,0 +1,151 @@
+/*
+ * 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"
+#include "itk.h"
+
+/* include tclInt.h for access to namespace API */
+#include "tclInt.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 --
+ *
+ * This is the main program for the application.
+ *
+ * Results:
+ * None: Tk_Main never returns here, so this procedure never
+ * returns either.
+ *
+ * Side effects:
+ * Whatever the application does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+main(argc, argv)
+ int argc; /* Number of command-line arguments. */
+ char **argv; /* Values of command-line arguments. */
+{
+ Tk_Main(argc, argv, Tcl_AppInit);
+ return 0; /* Needed only to prevent compiler warning. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 */
+
+
+ /*
+ * Call the init procedures for included packages. Each call should
+ * look like this:
+ *
+ * if (Mod_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * where "Mod" is the name of the module.
+ */
+ if (Itcl_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (Itk_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Itcl", Itcl_Init, Itcl_SafeInit);
+ Tcl_StaticPackage(interp, "Itk", Itk_Init, (Tcl_PackageInitProc *) NULL);
+
+ /*
+ * This is itkwish, so import all [incr Tcl] commands by
+ * default into the global namespace. Fix up the autoloader
+ * to do the same.
+ */
+ if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
+ "::itk::*", /* allowOverwrite */ 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
+ "::itcl::*", /* allowOverwrite */ 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_Eval(interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* ::itk::* }") != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Call Tcl_CreateCommand for application-specific commands, if
+ * they weren't already created by the init procedures called above.
+ */
+
+ /*
+ * Specify a user-specific startup file to invoke if the application
+ * is run interactively. Typically the startup file is "~/.apprc"
+ * where "app" is the name of the application. If this line is deleted
+ * then no user-specific startup file will be run under any conditions.
+ */
+
+ Tcl_SetVar(interp, "tcl_rcFileName", "~/.itkwishrc", TCL_GLOBAL_ONLY);
+ return TCL_OK;
+}
diff --git a/itcl/itk/win/Makefile.in b/itcl/itk/win/Makefile.in
new file mode 100644
index 00000000000..52dd3f487fb
--- /dev/null
+++ b/itcl/itk/win/Makefile.in
@@ -0,0 +1,424 @@
+# This file is CYGNUS LOCAL. It is a copy of makefile.vc modified for
+# GNU make.
+#
+# Visual C++ 4.0 makefile
+#
+# Copyright (c) 1993-1996 Lucent Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+VPATH = @srcdir@:@srcdir@/../generic:@srcdir@/../unix
+srcdir = @srcdir@
+
+CC = @CC@
+CFLAGS = @CFLAGS@
+NM = @NM@
+AS = @AS@
+LD = @LD@
+DLLTOOL = @DLLTOOL@
+WINDRES = @WINDRES@
+OBJEXT = @OBJEXT@
+
+DLL_LDFLAGS = @DLL_LDFLAGS@
+DLL_LDLIBS = @DLL_LDLIBS@
+
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+#
+# Project directories
+#
+# ROOT = top of source tree
+#
+# TMPDIR = location where .obj files should be stored during build
+#
+
+ROOT = @ITK_SRC_DIR@
+TMPDIR = .
+
+TCLLIBDIR = @TCL_BIN_DIR@
+TKLIBDIR = @TK_BIN_DIR@
+ITCLLIBDIR = @ITCL_BIN_DIR@
+
+TCLSRCDIR = @TCL_SRC_DIR@
+TKSRCDIR = @TK_SRC_DIR@
+ITCLSRCDIR = @ITCL_SRC_DIR@
+
+
+SRC_INC_DIR = $(ROOT)/generic
+SRC_WIN_DIR = $(ROOT)/win
+SRC_UNIX_DIR = $(ROOT)/unix
+SRC_LIB_DIR = $(ROOT)/library
+SRC_MAN_DIR = $(ROOT)/doc
+
+#
+# Here are all the built files we will need:
+#
+
+ITCL_VERSION = @ITCL_VERSION@
+VERSION = 30
+
+CYGITKLIB = @CYGITKLIB@
+CYGITKDLL = @CYGITKDLL@
+CYGITKWISH = @CYGITKWISH@
+CYGITKDEF = @CYGITKDEF@
+CYGITKTEST = @CYGITKTEST@
+CYGIMPORTLIB = @CYGIMPORTLIB@
+CYGITKRES = @CYGITKRES@
+CYGITKWISHRES = @CYGITKWISHRES@
+
+SNITKLIB = @SNITKLIB@
+SNITKDLL = @SNITKDLL@
+SNITKWISH = @SNITKWISH@
+SNITKDEF = @SNITKDEF@
+SNITKTEST = @SNITKTEST@
+SNIMPORTLIB = @SNIMPORTLIB@
+SNITKRES = @SNITKRES@
+SNITKWISHRES = @SNITKWISHRES@
+
+ITKLIB = @ITKLIB@
+ITKDLL = @ITKDLL@
+ITKWISH = @ITKWISH@
+ITKDEF = @ITKDEF@
+ITKTEST = @ITKTEST@
+ITKIMPORTLIB = @ITKIMPORTLIB@
+ITKRES = @ITKRES@
+ITKWISHRES = @ITKWISHRES@
+
+
+# Directory in which to install the library of Itcl scripts and demos
+# (note: you can set the ITK_LIBRARY environment variable at run-time to
+# override the compiled-in location):
+ITK_LIBRARY = $(prefix)/share/itk$(ITCL_VERSION)
+
+# Directory in which to install the archive libitcl.a:
+INSTALL_LIB_DIR = @libdir@
+
+# Directory in which to install the program itclsh:
+INSTALL_BIN_DIR = @bindir@
+
+# Directory in which to install the include file itcl.h:
+INSTALL_INCLUDE_DIR = @includedir@
+
+# Top-level directory for manual entries:
+INSTALL_MAN_DIR = @mandir@
+
+# Directory in which to install manual entry for itclsh:
+INSTALL_MAN1_DIR = $(INSTALL_MAN_DIR)/man1
+
+# Directory in which to install manual entries for Itcl's C library
+# procedures:
+INSTALL_MAN3_DIR = $(INSTALL_MAN_DIR)/man3
+
+# Directory in which to install manual entries for the built-in
+# Tcl commands implemented by Itcl:
+INSTALL_MANN_DIR = $(INSTALL_MAN_DIR)/mann
+
+
+# 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
+
+ITKWISHOBJS = \
+ $(TKLIBDIR)/tkConsole.$(OBJEXT) \
+ $(TMPDIR)/winMain.$(OBJEXT)
+
+TKTESTOBJS = \
+ $(TMPDIR)/tkConsole.$(OBJEXT) \
+ $(TMPDIR)/tkTest.$(OBJEXT) \
+ $(TMPDIR)/tkSquare.$(OBJEXT) \
+ $(TMPDIR)/testMain.$(OBJEXT)
+
+ITKOBJS = \
+ $(TMPDIR)/itk_archetype.$(OBJEXT) \
+ $(TMPDIR)/itk_cmds.$(OBJEXT) \
+ $(TMPDIR)/itk_option.$(OBJEXT) \
+ $(TMPDIR)/itk_util.$(OBJEXT) \
+ $(TMPDIR)/dllEntryPoint.$(OBJEXT)
+
+DUMPEXTS = $(TCLLIBDIR)/dumpexts.exe
+
+TCLLIB = @TCL_LIB_FILE@
+TCL_BUILD_LIB_SPEC = @TCL_BUILD_LIB_SPEC@
+TCL_LIB_FULL_PATH = @TCL_LIB_FULL_PATH@
+TKLIB = @TK_LIB_FILE@
+TK_BUILD_LIB_SPEC = @TK_BUILD_LIB_SPEC@
+TK_LIB_FULL_PATH = @TK_LIB_FULL_PATH@
+ITCLLIB = @ITCL_LIB_FILE@
+ITCL_BUILD_LIB_SPEC = @ITCL_BUILD_LIB_SPEC@
+ITCL_LIB_FULL_PATH = @ITCL_LIB_FULL_PATH@
+
+TCL_INCLUDES = -I$(TCLSRCDIR)/generic -I$(TCLSRCDIR)/win
+TK_INCLUDES = -I$(TKSRCDIR)/generic -I$(TKSRCDIR)/win -I$(TKSRCDIR)/xlib
+ITCL_INCLUDES = -I$(ITCLSRCDIR)/generic -I$(ITCLSRCDIR)/win
+ITK_INCLUDES = -I$(SRC_INC_DIR) -I$(SRC_WIN_DIR) $(ITCL_INCLUDES) \
+ $(TCL_INCLUDES) $(TK_INCLUDES)
+
+ITK_DEFINES = -D__WIN32__ $(DEBUGDEFINES) -DDLL_BUILD -DBUILD_itk -D_DLL
+ITK_CFLAGS = $(ITK_INCLUDES) $(ITK_DEFINES) $(CFLAGS)
+
+CPU = i386
+
+######################################################################
+# Link flags
+######################################################################
+
+conlflags = -Wl,--subsystem,console -mwindows
+guilflags = -mwindows
+dlllflags =
+
+baselibs = @BASELIBS@
+winlibs = @WINLIBS@
+libcdll = @LIBCDLL@
+
+guilibs = $(baselibs) $(winlibs)
+conlibs = $(baselibs)
+guilibsdll = $(libcdll) $(baselibs) $(winlibs)
+conlibsdll = $(libcdll) $(baselibs)
+
+#
+# Targets
+#
+
+release: $(ITKDLL) $(ITKWISH) $(ITKLIB)
+all: $(ITKDLL) $(ITKWISH) $(ITKLIB)
+test: $(ITKWISH)
+ $(CP) $(TCLLIBDIR)\*.dll
+ $(ITKWISH) <<
+ cd ../tests
+ source all
+
+$(TMPDIR)/$(CYGITKDEF): $(ITKOBJS)
+ echo 'EXPORTS' > tmp.def
+ -for o in $(ITKOBJS); do \
+ $(NM) --extern-only --defined-only $$o | sed -e 's/[^ ]* [^ ]* //' -e 's/^_//' | fgrep -v DllEntryPoint | fgrep -v DllMain | fgrep -v impure_ptr >> tmp.def; \
+ done
+ mv tmp.def $(TMPDIR)/$(CYGITKDEF)
+
+$(CYGITKDLL): $(ITKOBJS) $(TMPDIR)/$(CYGITKDEF) $(TMPDIR)/$(CYGITKRES)
+ $(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,itk.base \
+ -o $(CYGITKDLL) $(ITKOBJS) $(TMPDIR)/$(CYGITKRES) \
+ $(TKLIBDIR)/$(TKLIB) $(ITCLLIBDIR)/$(ITCLLIB) $(TCLLIBDIR)/$(TCLLIB) \
+ $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 \
+ -Wl,--image-base,0x66800000
+ $(DLLTOOL) --as=$(AS) --dllname $(CYGITKDLL) --def $(TMPDIR)/$(CYGITKDEF) \
+ --base-file itk.base --output-exp itk.exp
+ $(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,itk.base -Wl,itk.exp \
+ -o $(CYGITKDLL) $(ITKOBJS) \
+ $(TKLIBDIR)/$(TKLIB) $(ITCLLIBDIR)/$(ITCLLIB) $(TCLLIBDIR)/$(TCLLIB) \
+ $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 \
+ -Wl,--image-base,0x66800000
+ $(DLLTOOL) --as=$(AS) --dllname $(ITKDLL) --def $(TMPDIR)/$(CYGITKDEF) \
+ --base-file itk.base --output-exp itk.exp
+ $(CC) $(DLL_LDFLAGS) -Wl,itk.exp -o $(CYGITKDLL) $(ITKOBJS) \
+ $(TKLIBDIR)/$(TKLIB) $(ITCLLIBDIR)/$(ITCLLIB) $(TCLLIBDIR)/$(TCLLIB) \
+ $(DLL_LDLIBS) -mwindows \
+ -Wl,-e,_DllMain@12 -Wl,--image-base,0x66800000
+
+$(CYGITKLIB): $(TMPDIR)/$(CYGITKDEF)
+ $(DLLTOOL) --as=$(AS) --dllname $(ITKDLL) --def $(TMPDIR)/$(CYGITKDEF) \
+ --output-lib $(CYGITKLIB)
+
+$(CYGITKWISH): $(ITKWISHOBJS) $(CYGITKLIB) $(TMPDIR)/$(CYGITKWISHRES)
+ $(CC) $(ldebug) $(guilflags) $(ITKWISHOBJS) $(ITK_CFLAGS) $(TMPDIR)/$(CYGITKWISHRES) \
+ $(ITKLIB) $(TKLIBDIR)/$(TKLIB) \
+ $(ITCLLIBDIR)/$(ITCLLIB) $(TCLLIBDIR)/$(TCLLIB) \
+ $(guilibsdll) \
+ -o $(CYGITKWISH)
+
+$(CYGITKTEST): $(ITKTESTOBJS) $(CYGITKLIB) $(TMPDIR)/$(CYGITKWISHRES)
+ $(CC) $(ldebug) $(guilflags) $(WISHOBJS) $(ITK_CFLAGS) $(TMPDIR)/$(CYGITKWISHRES) \
+ $(CYGITKLIB) $(TKLIBDIR)/$(TKLIB) \
+ $(ITCLLIBDIR)/$(ITCLLIB) $(TCLLIBDIR)/$(TCLLIB) \
+ $(guilibsdll) \
+ -o $(CYGITKTEST)
+
+$(TMPDIR)/$(CYGITKRES): $(ROOT)/win/rc/itk.rc
+ $(WINDRES) --include $(ROOT)/win/rc --include $(ROOT)/generic \
+ --include $(ITCLSRCDIR)/generic \
+ --include $(TCLSRCDIR)/generic --include $(TKSRCDIR)/generic \
+ --define VS_VERSION_INFO=1 $(ROOT)/win/rc/itk.rc $(TMPDIR)/$(CYGITKRES)
+
+$(TMPDIR)/$(CYGITKWISHRES): $(ROOT)/win/rc/itkwish.rc
+ $(WINDRES) --include $(ROOT)/win/rc --include $(ITCLSRCDIR)/generic \
+ --include $(TCLSRCDIR)/generic --include $(TKSRCDIR)/generic\
+ --include $(ROOT)/generic --define VS_VERSION_INFO=1 \
+ $(ROOT)/win/rc/itkwish.rc $(TMPDIR)/$(CYGITKWISHRES)
+
+# Visual C++ specific targets
+
+$(TMPDIR)/$(SNITKDEF): $(DUMPEXTS) $(ITKOBJS)
+ $(DUMPEXTS) -o $@ $(SNITKDLL) $(ITKOBJS)
+
+$(SNITKDLL): $(ITKOBJS) $(TMPDIR)/$(SNITKDEF) $(TMPDIR)/$(SNITKRES) $(TCL_LIB_FULL_PATH) \
+ $(TK_LIB_FULL_PATH) $(ITCL_LIB_FULL_PATH)
+ link.exe -DEBUG -dll -def:$(TMPDIR)/$(SNITKDEF) -NODEFAULTLIB \
+ -out:$(SNITKDLL) $(guilibsdll) $(ITKOBJS) $(TMPDIR)/$(SNITKRES) \
+ $(TCL_BUILD_LIB_SPEC) $(TK_BUILD_LIB_SPEC) $(ITCL_BUILD_LIB_SPEC)
+
+$(SNITKLIB) $(SNIMPORTLIB):
+ cp $(SNIMPORTLIB) $(SNITKLIB)
+
+$(SNITKWISH): $(ITKWISHOBJS) $(SNITKLIB) $(TMPDIR)/$(SNITKWISHRES) $(TCL_LIB_FULL_PATH) \
+ $(TK_LIB_FULL_PATH) $(ITCL_LIB_FULL_PATH)
+ link.exe -DEBUG -NODEFAULTLIB -entry:WinMainCRTStartup \
+ -out:$@ $(guilibsdll) $(ITKWISHOBJS) $(TMPDIR)/$(SNITKWISHRES) \
+ $(SNITKLIB) $(TCL_BUILD_LIB_SPEC) $(TK_BUILD_LIB_SPEC) \
+ $(ITCL_BUILD_LIB_SPEC)
+
+$(SNITKTEST): $(ITKWISHOBJS) $(ITCLTESTOBJS) $(SNITKLIB) $(TMPDIR)/$(SNITKWISHRES) \
+ $(TCL_LIB_FULL_PATH) $(TK_LIB_FULL_PATH) $(ITCL_LIB_FULL_PATH)
+ link.exe -DEBUG -NODEFAULTLIB -entry:WinMainCRTStartup \
+ -out $@ $(guilibsdll) $(ITKWISHOBJS) $(TMPDIR)/$(SNITKWISHRES) \
+ $(SNITKLIB) $(TCL_BUILD_LIB_SPEC) $(TK_BUILD_LIB_SPEC) \
+ $(ITCL_BUILD_LIB_SPEC)
+
+$(TMPDIR)/$(SNITKWISHRES):: $(SRC_WIN_DIR)/rc/itkwish.rc
+ rc $(ITK_INCLUDES) -d__WIN32__ -dVS_VERSION_INFO=1 -fo$@ $?
+
+$(TMPDIR)/$(SNITKRES):: $(SRC_WIN_DIR)/rc/itk.rc
+ rc $(ITK_INCLUDES) -d__WIN32__ -dVS_VERSION_INFO=1 -fo$@ $?
+
+#
+# Special case object file targets
+#
+
+$(TMPDIR)/testMain.$(OBJEXT): $(ROOT)/win/winMain.c
+ $(CC) -c $(ITK_CFLAGS) -DTCL_TEST -DTK_TEST -DSTATIC_BUILD -o $@ $?
+
+$(TMPDIR)/winMain.$(OBJEXT): $(ROOT)/win/winMain.c
+ $(CC) -c $(ITK_CFLAGS) -DSTATIC_BUILD -o $@ $?
+
+#
+# Implicit rules
+#
+
+$(TMPDIR)/%.$(OBJEXT): $(SRC_INC_DIR)/%.c
+ $(CC) -c $(ITK_CFLAGS) -o $@ $<
+
+$(TMPDIR)/%.$(OBJEXT): $(SRC_WIN_DIR)/%.c
+ $(CC) -c $(ITK_CFLAGS) -o $@ $<
+
+clean:
+
+ rm -f $(TMPDIR)/*.$(OBJEXT) $(TMPDIR)/*.exp $(TMPDIR)/*.def
+ rm -f $(ITKLIB) $(ITKDLL) $(ITKDLL) $(ITKWISH)
+
+
+Makefile: $(srcdir)/Makefile.in config.status
+ $(SHELL) config.status
+
+config.status: $(srcdir)/configure
+ ./config.status --recheck
+
+#----------------------------------------------------------------------
+#
+# Installation
+#
+#----------------------------------------------------------------------
+
+
+install:: install-basic install-binaries
+ @echo done
+
+install-binaries::
+ @for i in $(INSTALL_LIB_DIR) $(INSTALL_BIN_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing $(ITKLIB) as $(INSTALL_LIB_DIR)/$(ITKLIB)"
+ @$(INSTALL_DATA) $(ITKLIB) $(INSTALL_LIB_DIR)/$(ITKLIB)
+ @echo "Installing $(ITKWISH) as $(INSTALL_BIN_DIR)/$(ITKWISH)"
+ @$(INSTALL_PROGRAM) $(ITKWISH) $(INSTALL_BIN_DIR)/$(ITKWISH)
+ @echo "Installing $(ITKDLL) as $(INSTALL_BIN_DIR)/$(ITKDLL)"
+ @$(INSTALL_PROGRAM) $(ITKDLL) $(INSTALL_BIN_DIR)/$(ITKDLL)
+
+#
+# Basic installation
+#
+install-basic:: install-libraries install-headers \
+ install-man
+
+
+install-headers:
+ @for i in $(INSTALL_INCLUDE_DIR); \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @for i in $(SRC_INC_DIR)/itk.h; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(INSTALL_INCLUDE_DIR); \
+ done;
+
+install-libraries:
+ @for i in $(prefix)/lib $(ITK_LIBRARY); \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @for i in $(SRC_LIB_DIR)/*.tcl $(SRC_LIB_DIR)/*.itk; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(ITK_LIBRARY); \
+ done;
+
+ @echo "Installing pkgIndex.tcl"
+ @$(INSTALL_DATA) $(srcdir)/pkgIndex.tcl $(ITK_LIBRARY)
+
+ @echo "Installing tclIndex"
+ @$(INSTALL_DATA) $(SRC_LIB_DIR)/tclIndex $(ITK_LIBRARY)
+
+install-man:
+ @for i in $(INSTALL_MAN_DIR) $(INSTALL_MAN1_DIR) \
+ $(INSTALL_MAN3_DIR) $(INSTALL_MANN_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @cd $(SRC_MAN_DIR); for i in *.n ; \
+ do \
+ echo "Installing doc/$$i"; \
+ rm -f $(INSTALL_MANN_DIR)/$$i; \
+ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+ $$i > $(INSTALL_MANN_DIR)/$$i; \
+ chmod 444 $(INSTALL_MANN_DIR)/$$i; \
+ done; \
+ for i in *.1 ; \
+ do \
+ echo "Installing doc/$$i"; \
+ rm -f $(INSTALL_MAN1_DIR)/$$i; \
+ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+ $$i > $(INSTALL_MAN1_DIR)/$$i; \
+ chmod 444 $(INSTALL_MAN1_DIR)/$$i; \
+ done;
+
+install-info info installcheck:
+
+install-minimal: install-libraries
+ @echo "Installing $(ITKDLL) as $(INSTALL_BIN_DIR)/$(ITKDLL)"
+ @$(INSTALL_PROGRAM) $(ITKDLL) $(INSTALL_BIN_DIR)/$(ITKDLL)
diff --git a/itcl/itk/win/Makefile.in_first b/itcl/itk/win/Makefile.in_first
new file mode 100644
index 00000000000..9956124ad4d
--- /dev/null
+++ b/itcl/itk/win/Makefile.in_first
@@ -0,0 +1,277 @@
+## This file is CYGNUS LOCAL. It is a copy of makefile.vc modified for
+# GNU make.
+#
+# Visual C++ 4.0 makefile
+#
+# Copyright (c) 1993-1996 Lucent Technologies
+# based on original from
+# 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.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+VPATH = @srcdir@:@srcdir@/../generic:@srcdir@/../unix
+srcdir = @srcdir@
+
+CC = @CC@
+CFLAGS = @CFLAGS@
+NM = @NM@
+AS = @AS@
+LD = @LD@
+DLLTOOL = @DLLTOOL@
+WINDRES = @WINDRES@
+
+DLL_LDFLAGS = @DLL_LDFLAGS@
+DLL_LDLIBS = @DLL_LDLIBS@
+
+
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+ITCL_VERSION = @ITCL_VERSION@
+VERSION = $(ITCL_VERSION)
+
+ITKLIB = libitk$(VERSION).a
+ITKDLL = cygitk$(VERSION).dll
+ITKWISH = cygitkwish$(VERSION).exe
+ITKTEST = itktest.exe
+
+TCLLIBDIR = @TCL_BIN_DIR@
+TCLLIB = @TCL_LIB_FILE@
+TKLIBDIR = @TK_BIN_DIR@
+TKLIB = @TK_LIB_FILE@
+ITCLLIBDIR = @ITCL_BIN_DIR@
+ITCLLIB = @ITCL_LIB_FILE@
+
+# Project directories
+#
+# ROOT = top of source tree
+# TMPDIR = location where .obj files should be stored during build
+
+ROOT = $(srcdir)/..
+TMPDIR = .
+
+######################################################################
+# Link flags
+######################################################################
+
+conlflags = $(lflags) -Wl,--subsystem,console -mwindows
+guilflags = $(lflags) -mwindows
+dlllflags = $(lflags)
+
+baselibs = -lkernel32 $(optlibs) -ladvapi32
+winlibs = $(baselibs) -luser32 -lgdi32 -lcomdlg32 -lwinspool
+guilibs = $(libc) $(winlibs)
+
+guilibsdll = $(libcdll) $(winlibs)
+
+######################################################################
+# Compile flags
+######################################################################
+
+# 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
+
+
+WINDIR = $(ROOT)/win
+GENERICDIR = $(ROOT)/generic
+
+TCLSRCDIR = @TCL_SRC_DIR@
+TKSRCDIR = @TK_SRC_DIR@
+ITCLSRCDIR = @ITCL_SRC_DIR@
+
+TCL_INCLUDES = -I$(TCLSRCDIR)/generic -I$(TCLSRCDIR)/win
+TK_INCLUDES = -I$(TKSRCDIR)/generic -I$(TKSRCDIR)/win -I$(TKSRCDIR)/xlib
+ITCL_INCLUDES = -I$(ITCLSRCDIR)/generic -I$(ITCLSRCDIR)/win
+ITK_INCLUDES = -I$(GENERICDIR) -I$(WINDIR) $(ITCL_INCLUDES) \
+ $(TCL_INCLUDES) $(TK_INCLUDES)
+
+ITK_DEFINES = -D__WIN32__ $(DEBUGDEFINES)
+ITK_CFLAGS = $(ITK_INCLUDES) $(ITK_DEFINES) $(CFLAGS)
+
+ITKWISHOBJS = \
+ $(TKLIBDIR)/tkConsole.o \
+ $(TMPDIR)/winMain.o
+
+TKTESTOBJS = \
+ $(TMPDIR)/tkConsole.o \
+ $(TMPDIR)/tkTest.o \
+ $(TMPDIR)/tkSquare.o \
+ $(TMPDIR)/testMain.o
+
+ITKOBJS = \
+ $(TMPDIR)/itk_archetype.o \
+ $(TMPDIR)/itk_cmds.o \
+ $(TMPDIR)/itk_option.o \
+ $(TMPDIR)/itk_util.o \
+ $(TMPDIR)/dllEntryPoint.o
+
+ITKDLL = itk$(VERSION).dll
+ITKLIB = libitk$(VERSION).a
+ITKWISH = itkwish.exe
+ITKTEST = tktest.exe
+DUMPEXTS = # $(TCLLIBDIR)/dumpexts.exe
+
+CPU = i386
+
+#
+# Targets
+#
+
+all: $(ITKDLL) $(ITKWISH)
+test: $(ITKDLL) $(ITKTEST)
+
+install: install-binaries install-libraries
+
+install-binaries: $(ITKDLL) $(ITKLIB) $(ITKWISH)
+ @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 $(ITKLIB)"
+ @$(INSTALL_DATA) $(ITKLIB) $(LIB_INSTALL_DIR)/$(ITKLIB)
+ @chmod 555 $(LIB_INSTALL_DIR)/$(ITKLIB)
+ @echo "Installing wish"
+ @$(INSTALL_PROGRAM) $(ITKWISH) $(BIN_INSTALL_DIR)/$(ITKWISH)
+ @echo "Installing tkConfig.sh"
+ @$(INSTALL_DATA) ../unix/tkConfig.sh $(LIB_INSTALL_DIR)/tkConfig.sh
+
+install-libraries:
+ @echo "Installing DLL"
+ @$(INSTALL_DATA) $(ITKDLL) $(BIN_INSTALL_DIR)/$(ITKDLL)
+ @for i in $(INSTALL_ROOT)@datadir@ $(INCLUDE_INSTALL_DIR) \
+ $(SCRIPT_INSTALL_DIR) $(INSTALL_ROOT)@exec_prefix@ \
+ $(INSTALL_ROOT)@exec_prefix@/@host_alias@ \
+ $(INSTALL_ROOT)@exec_prefix@/@host_alias@/include \
+ $(X11_INCLUDE_INSTALL_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing tk.h"
+ @$(INSTALL_DATA) $(GENERICDIR)/tk.h $(INCLUDE_INSTALL_DIR)/tk.h
+ for i in $(XLIBDIR)/X11/*.h; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(X11_INCLUDE_INSTALL_DIR); \
+ done;
+ for i in $(ROOT)/library/*.tcl $(ROOT)/library/tclIndex $(ROOT)/library/prolog.ps $(ROOT)/unix/tkAppInit.c; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
+ done;
+
+install-minimal:
+ @echo "Installing DLL"
+ @$(INSTALL_DATA) $(ITKDLL) $(BIN_INSTALL_DIR)/$(ITKDLL)
+ @for i in $(INSTALL_ROOT)@datadir@ $(SCRIPT_INSTALL_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ for i in $(ROOT)/library/*.tcl $(ROOT)/library/tclIndex $(ROOT)/library/prolog.ps; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
+ done;
+
+$(TMPDIR)/itkcyg.def: $(DUMPEXTS) $(ITKOBJS)
+ echo 'EXPORTS' > tmp.def
+ -for o in $(ITKOBJS); do \
+ $(NM) --extern-only --defined-only $$o | sed -e 's/[^ ]* [^ ]* //' -e 's/^_//' | fgrep -v DllEntryPoint | fgrep -v DllMain | fgrep -v impure_ptr >> tmp.def; \
+ done
+ mv tmp.def $(TMPDIR)/itkcyg.def
+
+$(ITKDLL): $(ITKOBJS) $(TMPDIR)/itkcyg.def
+ $(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,itk.base \
+ -o $(ITKDLL) $(ITKOBJS) \
+ $(TKLIBDIR)/$(TKLIB) $(ITCLLIBDIR)/$(ITCLLIB) $(TCLLIBDIR)/$(TCLLIB) \
+ $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 \
+ -Wl,--image-base,0x66600000
+ $(DLLTOOL) --as=$(AS) --dllname $(ITKDLL) --def $(TMPDIR)/itkcyg.def \
+ --base-file itk.base --output-exp itk.exp
+ $(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,itk.base -Wl,itk.exp \
+ -o $(ITKDLL) $(ITKOBJS) \
+ $(TKLIBDIR)/$(TKLIB) $(ITCLLIBDIR)/$(ITCLLIB) $(TCLLIBDIR)/$(TCLLIB) \
+ $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 \
+ -Wl,--image-base,0x66600000
+ $(DLLTOOL) --as=$(AS) --dllname $(ITKDLL) --def $(TMPDIR)/itkcyg.def \
+ --base-file itk.base --output-exp itk.exp
+ $(CC) $(DLL_LDFLAGS) -Wl,itk.exp -o $(ITKDLL) $(ITKOBJS) \
+ $(TKLIBDIR)/$(TKLIB) $(ITCLLIBDIR)/$(ITCLLIB) $(TCLLIBDIR)/$(TCLLIB) \
+ $(DLL_LDLIBS) -mwindows \
+ -Wl,-e,_DllMain@12 -Wl,--image-base,0x66600000
+
+$(ITKLIB): $(TMPDIR)/itkcyg.def
+ $(DLLTOOL) --as=$(AS) --dllname $(ITKDLL) --def $(TMPDIR)/itkcyg.def \
+ --output-lib $(ITKLIB)
+
+$(ITKWISH): $(ITKWISHOBJS) $(ITKLIB) $(TMPDIR)/itkwishres.o
+ $(CC) $(ldebug) $(guilflags) $(ITKWISHOBJS) $(ITK_CFLAGS) $(TMPDIR)/itkwishres.o \
+ $(ITKLIB) $(TKLIBDIR)/$(TKLIB) \
+ $(ITCLLIBDIR)/$(ITCLLIB) $(TCLLIBDIR)/$(TCLLIB) \
+ $(guilibsdll) \
+ -o $(ITKWISH)
+
+$(ITKTEST): $(ITKTESTOBJS) $(ITKLIB) $(TMPDIR)/itkwishres.o
+ $(CC) $(ldebug) $(guilflags) $(WISHOBJS) $(ITK_CFLAGS) $(TMPDIR)/itkwishres.o \
+ $(ITKLIB) $(TKLIBDIR)/$(TKLIB) \
+ $(ITCLLIBDIR)/$(ITCLLIB) $(TCLLIBDIR)/$(TCLLIB) \
+ $(guilibsdll) \
+ -o $(ITKTEST)
+
+#
+# Special case object file targets
+#
+
+$(TMPDIR)/testMain.o: $(ROOT)/win/winMain.c
+ $(CC) -c $(ITK_CFLAGS) -DTK_TEST -o $@ $?
+
+$(TMPDIR)/winMain.o: $(ROOT)/win/winMain.c
+ $(CC) -c $(ITK_CFLAGS) -DTK_TEST -o $@ $?
+
+#
+# Implicit rules
+#
+
+$(TMPDIR)/%.o: $(GENERICDIR)/%.c
+ $(CC) -c $(ITK_CFLAGS) -o $@ $<
+
+itkres.o: $(ROOT)/win/rc/itk.rc
+ $(WINDRES) --include $(ROOT)/win/rc --include $(ROOT)/generic \
+ --include $(ITCLSRCDIR)/generic \
+ --include $(TCLSRCDIR)/generic --include $(TKSRCDIR)/generic \
+ --define VS_VERSION_INFO=1 $(ROOT)/win/rc/itk.rc itkres.o
+
+itkwishres.o: $(ROOT)/win/rc/itkwish.rc
+ $(WINDRES) --include $(ROOT)/win/rc --include $(ITCLSRCDIR)/generic \
+ --include $(TCLSRCDIR)/generic --include $(TKSRCDIR)/generic\
+ --include $(ROOT)/generic --define VS_VERSION_INFO=1 \
+ $(ROOT)/win/rc/itkwish.rc itkwishres.o
+
+
+Makefile: $(WINDIR)/Makefile.in config.status
+ $(SHELL) config.status
+
+config.status: $(WINDIR)/configure
+ ./config.status --recheck
diff --git a/itcl/itk/win/configure b/itcl/itk/win/configure
new file mode 100755
index 00000000000..4058c11a21d
--- /dev/null
+++ b/itcl/itk/win/configure
@@ -0,0 +1,4120 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+ac_default_prefix=/usr/local
+ac_help="$ac_help
+ --enable-gcc allow use of gcc if available"
+ac_help="$ac_help
+ --with-tcl=DIR use Tcl 8.0 binaries from DIR"
+ac_help="$ac_help
+ --with-tk=DIR use Tk 8.0 binaries from DIR"
+ac_help="$ac_help
+ --with-itcl=DIR use Itcl 3.0 binaries from DIR"
+ac_help="$ac_help
+ --with-cflags=FLAGS set compiler flags to FLAGS"
+ac_help="$ac_help
+ --with-cc=CC set C compiler to CC"
+ac_help="$ac_help
+ --with-x use the X Window System"
+ac_help="$ac_help
+ --enable-shared build libitk as a shared library"
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.13"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=../generic/itk.h
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+
+ac_aux_dir=
+for ac_dir in ../../../ $srcdir/../../../; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in ../../../ $srcdir/../../../" 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+
+# Make sure we can run config.sub.
+if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then :
+else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking host system type""... $ac_c" 1>&6
+echo "configure:569: checking host system type" >&5
+
+host_alias=$host
+case "$host_alias" in
+NONE)
+ case $nonopt in
+ NONE)
+ if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then :
+ else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; }
+ fi ;;
+ *) host_alias=$nonopt ;;
+ esac ;;
+esac
+
+host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias`
+host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+echo "$ac_t""$host" 1>&6
+
+
+# Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:593: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_RANLIB="ranlib"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+# Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:624: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:654: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_prog_rejected=no
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -z "$CC"; then
+ case "`uname -s`" in
+ *win32* | *WIN32*)
+ # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:705: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="cl"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+ ;;
+ esac
+ fi
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:737: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 748 "configure"
+#include "confdefs.h"
+
+main(){return(0);}
+EOF
+if { (eval echo configure:753: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cc_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:779: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:784: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:793: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gcc=yes
+else
+ ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+else
+ GCC=
+fi
+
+ac_test_CFLAGS="${CFLAGS+set}"
+ac_save_CFLAGS="$CFLAGS"
+CFLAGS=
+echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:812: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+
+echo $ac_n "checking for object suffix""... $ac_c" 1>&6
+echo "configure:844: checking for object suffix" >&5
+if eval "test \"`echo '$''{'ac_cv_objext'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ rm -f conftest*
+echo 'int i = 1;' > conftest.$ac_ext
+if { (eval echo configure:850: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ for ac_file in conftest.*; do
+ case $ac_file in
+ *.c) ;;
+ *) ac_cv_objext=`echo $ac_file | sed -e s/conftest.//` ;;
+ esac
+ done
+else
+ { echo "configure: error: installation or configuration problem; compiler does not work" 1>&2; exit 1; }
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_objext" 1>&6
+OBJEXT=$ac_cv_objext
+ac_objext=$ac_cv_objext
+
+echo $ac_n "checking build system type""... $ac_c" 1>&6
+echo "configure:868: checking build system type" >&5
+
+build_alias=$build
+case "$build_alias" in
+NONE)
+ case $nonopt in
+ NONE) build_alias=$host_alias ;;
+ *) build_alias=$nonopt ;;
+ esac ;;
+esac
+
+build=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $build_alias`
+build_cpu=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+build_vendor=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+build_os=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+echo "$ac_t""$build" 1>&6
+
+if test $host != $build; then
+ ac_tool_prefix=${host_alias}-
+else
+ ac_tool_prefix=
+fi
+
+# Extract the first word of "${ac_tool_prefix}nm", so it can be a program name with args.
+set dummy ${ac_tool_prefix}nm; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:894: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_NM'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$NM"; then
+ ac_cv_prog_NM="$NM" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_NM="${ac_tool_prefix}nm"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+NM="$ac_cv_prog_NM"
+if test -n "$NM"; then
+ echo "$ac_t""$NM" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+if test -z "$ac_cv_prog_NM"; then
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "nm", so it can be a program name with args.
+set dummy nm; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:926: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_NM'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$NM"; then
+ ac_cv_prog_NM="$NM" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_NM="nm"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_NM" && ac_cv_prog_NM="nm"
+fi
+fi
+NM="$ac_cv_prog_NM"
+if test -n "$NM"; then
+ echo "$ac_t""$NM" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+else
+ NM="nm"
+fi
+fi
+
+
+# Extract the first word of "${ac_tool_prefix}as", so it can be a program name with args.
+set dummy ${ac_tool_prefix}as; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:962: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_AS'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$AS"; then
+ ac_cv_prog_AS="$AS" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_AS="${ac_tool_prefix}as"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+AS="$ac_cv_prog_AS"
+if test -n "$AS"; then
+ echo "$ac_t""$AS" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+if test -z "$ac_cv_prog_AS"; then
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "as", so it can be a program name with args.
+set dummy as; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:994: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_AS'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$AS"; then
+ ac_cv_prog_AS="$AS" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_AS="as"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_AS" && ac_cv_prog_AS="as"
+fi
+fi
+AS="$ac_cv_prog_AS"
+if test -n "$AS"; then
+ echo "$ac_t""$AS" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+else
+ AS="as"
+fi
+fi
+
+
+# Extract the first word of "${ac_tool_prefix}ld", so it can be a program name with args.
+set dummy ${ac_tool_prefix}ld; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1030: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_LD'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$LD"; then
+ ac_cv_prog_LD="$LD" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_LD="${ac_tool_prefix}ld"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+LD="$ac_cv_prog_LD"
+if test -n "$LD"; then
+ echo "$ac_t""$LD" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+if test -z "$ac_cv_prog_LD"; then
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "ld", so it can be a program name with args.
+set dummy ld; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1062: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_LD'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$LD"; then
+ ac_cv_prog_LD="$LD" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_LD="ld"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_LD" && ac_cv_prog_LD="ld"
+fi
+fi
+LD="$ac_cv_prog_LD"
+if test -n "$LD"; then
+ echo "$ac_t""$LD" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+else
+ LD="ld"
+fi
+fi
+
+
+# Extract the first word of "${ac_tool_prefix}dlltool", so it can be a program name with args.
+set dummy ${ac_tool_prefix}dlltool; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1098: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_DLLTOOL'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$DLLTOOL"; then
+ ac_cv_prog_DLLTOOL="$DLLTOOL" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_DLLTOOL="${ac_tool_prefix}dlltool"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+DLLTOOL="$ac_cv_prog_DLLTOOL"
+if test -n "$DLLTOOL"; then
+ echo "$ac_t""$DLLTOOL" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+if test -z "$ac_cv_prog_DLLTOOL"; then
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "dlltool", so it can be a program name with args.
+set dummy dlltool; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1130: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_DLLTOOL'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$DLLTOOL"; then
+ ac_cv_prog_DLLTOOL="$DLLTOOL" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_DLLTOOL="dlltool"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_DLLTOOL" && ac_cv_prog_DLLTOOL="dlltool"
+fi
+fi
+DLLTOOL="$ac_cv_prog_DLLTOOL"
+if test -n "$DLLTOOL"; then
+ echo "$ac_t""$DLLTOOL" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+else
+ DLLTOOL="dlltool"
+fi
+fi
+
+
+# Extract the first word of "${ac_tool_prefix}windres", so it can be a program name with args.
+set dummy ${ac_tool_prefix}windres; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1166: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_WINDRES'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$WINDRES"; then
+ ac_cv_prog_WINDRES="$WINDRES" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_WINDRES="${ac_tool_prefix}windres"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+WINDRES="$ac_cv_prog_WINDRES"
+if test -n "$WINDRES"; then
+ echo "$ac_t""$WINDRES" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+if test -z "$ac_cv_prog_WINDRES"; then
+if test -n "$ac_tool_prefix"; then
+ # Extract the first word of "windres", so it can be a program name with args.
+set dummy windres; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1198: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_WINDRES'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$WINDRES"; then
+ ac_cv_prog_WINDRES="$WINDRES" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_WINDRES="windres"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_WINDRES" && ac_cv_prog_WINDRES="windres"
+fi
+fi
+WINDRES="$ac_cv_prog_WINDRES"
+if test -n "$WINDRES"; then
+ echo "$ac_t""$WINDRES" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+else
+ WINDRES="windres"
+fi
+fi
+
+
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:1244: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ # Account for people who put trailing slashes in PATH elements.
+ case "$ac_dir/" in
+ /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ if test -f $ac_dir/$ac_prog; then
+ if test $ac_prog = install &&
+ grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ else
+ ac_cv_path_install="$ac_dir/$ac_prog -c"
+ break 2
+ fi
+ fi
+ done
+ ;;
+ esac
+ done
+ IFS="$ac_save_IFS"
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL="$ac_cv_path_install"
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL="$ac_install_sh"
+ fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+
+# needed for the subtle differences between cygwin and mingw32
+case "${host}" in
+*-*-cygwin*)
+ DLL_LDLIBS=-lcygwin
+ DLL_LDFLAGS='-nostartfiles -Wl,--dll'
+ ;;
+*-*-mingw32*)
+ DLL_LDLIBS=
+ DLL_LDFLAGS='-mdll'
+ ;;
+esac
+
+
+
+ITCL_VERSION=3.0
+ITCL_MAJOR_VERSION=3
+ITCL_MINOR_VERSION=0
+VERSION=${ITCL_MAJOR_VERSION}${ITCL_MINOR_VERSION}
+
+if test "${prefix}" = "NONE"; then
+ prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+ exec_prefix=$prefix
+fi
+
+# -----------------------------------------------------------------------
+# Set up a new default --prefix. If a previous installation of
+# [incr Tcl] can be found searching $PATH use that directory.
+# -----------------------------------------------------------------------
+
+
+if test "x$prefix" = xNONE; then
+echo $ac_n "checking for prefix by $ac_c" 1>&6
+# Extract the first word of "itclsh", so it can be a program name with args.
+set dummy itclsh; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1334: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_path_ITCLSH'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ case "$ITCLSH" in
+ /*)
+ ac_cv_path_ITCLSH="$ITCLSH" # Let the user override the test with a path.
+ ;;
+ ?:/*)
+ ac_cv_path_ITCLSH="$ITCLSH" # Let the user override the test with a dos path.
+ ;;
+ *)
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_path_ITCLSH="$ac_dir/$ac_word"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac
+fi
+ITCLSH="$ac_cv_path_ITCLSH"
+if test -n "$ITCLSH"; then
+ echo "$ac_t""$ITCLSH" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -n "$ac_cv_path_ITCLSH"; then
+ prefix=`echo $ac_cv_path_ITCLSH|sed 's%/[^/][^/]*//*[^/][^/]*$%%'`
+ fi
+fi
+
+
+# -----------------------------------------------------------------------
+BUILD_DIR=`pwd`
+ITK_SRC_DIR=`cd $srcdir/..; pwd`
+
+if ! test "$GCC" = yes; then
+ tmp="`cygpath --windows $ITK_SRC_DIR`"
+ ITK_SRC_DIR="`echo $tmp | sed -e s#\\\\\\\\#/#g`"
+fi
+
+cd ${BUILD_DIR}
+
+# Check whether --enable-gcc or --disable-gcc was given.
+if test "${enable_gcc+set}" = set; then
+ enableval="$enable_gcc"
+ itk_ok=$enableval
+else
+ itk_ok=no
+fi
+
+if test "$itk_ok" = "yes"; then
+ # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1395: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1425: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_prog_rejected=no
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -z "$CC"; then
+ case "`uname -s`" in
+ *win32* | *WIN32*)
+ # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1476: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="cl"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+ ;;
+ esac
+ fi
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:1508: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 1519 "configure"
+#include "confdefs.h"
+
+main(){return(0);}
+EOF
+if { (eval echo configure:1524: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cc_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:1550: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:1555: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1564: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gcc=yes
+else
+ ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+else
+ GCC=
+fi
+
+ac_test_CFLAGS="${CFLAGS+set}"
+ac_save_CFLAGS="$CFLAGS"
+CFLAGS=
+echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:1583: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+
+else
+ CC=${CC-cc}
+
+fi
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:1619: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # This must be in double quotes, not single quotes, because CPP may get
+ # substituted into the Makefile and "${CC-cc}" will confuse make.
+ CPP="${CC-cc} -E"
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp.
+ cat > conftest.$ac_ext <<EOF
+#line 1634 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1640: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -E -traditional-cpp"
+ cat > conftest.$ac_ext <<EOF
+#line 1651 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1657: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -nologo -E"
+ cat > conftest.$ac_ext <<EOF
+#line 1668 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1674: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+ ac_cv_prog_CPP="$CPP"
+fi
+ CPP="$ac_cv_prog_CPP"
+else
+ ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+for ac_hdr in unistd.h limits.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:1702: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1707 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1712: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+
+
+#--------------------------------------------------------------------
+# 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.
+# CYGNUS LOCAL - Actually Tcl & Tk are siblings of the itcl directory
+# that contains itcl & itk & iwidgets.
+#--------------------------------------------------------------------
+
+# Check whether --with-tcl or --without-tcl was given.
+if test "${with_tcl+set}" = set; then
+ withval="$with_tcl"
+ TCL_BIN_DIR=$withval
+else
+ TCL_BIN_DIR=`cd ../../../tcl/win; pwd`
+fi
+
+
+if test ! -f $TCL_BIN_DIR/../unix/tclConfig.sh; then
+ TCL_BIN_DIR=`cd ../../../tcl8.1/win;pwd`
+fi
+
+if test ! -f $TCL_BIN_DIR/../unix/tclConfig.sh; then
+ { echo "configure: error: There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" 1>&2; exit 1; }
+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/../unix/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
+ITK_LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Tk is; if
+# not, assume that its top-level directory is a sibling of ours.
+# CYGNUS LOCAL - actually these are one level higher in the CYGNUS tree.
+#--------------------------------------------------------------------
+
+# Check whether --with-tcl or --without-tcl was given.
+if test "${with_tcl+set}" = set; then
+ withval="$with_tcl"
+ TK_BIN_DIR=$withval
+else
+ TK_BIN_DIR=`cd ../../../tk/win; pwd`
+fi
+
+
+if test ! -f $TK_BIN_DIR/../unix/tkConfig.sh; then
+ TK_BIN_DIR=`cd ../../../tk8.1/win;pwd`
+fi
+
+if test ! -f $TK_BIN_DIR/../unix/tkConfig.sh; then
+ { echo "configure: error: There's no tkConfig.sh in $TK_BIN_DIR; perhaps you didn't specify the Tk *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" 1>&2; exit 1; }
+fi
+
+file=$TK_BIN_DIR/../unix/tkConfig.sh
+. $file
+
+if ! test "$GCC" = yes; then
+ tmp="`cygpath --windows $TK_BIN_DIR`"
+ TK_BIN_DIR="`echo $tmp | sed -e s#\\\\\\\\#/#g`"
+fi
+
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where [incr Tcl] is.
+# If not, assume that its top-level directory is a sibling of ours.
+#--------------------------------------------------------------------
+
+# Check whether --with-itcl or --without-itcl was given.
+if test "${with_itcl+set}" = set; then
+ withval="$with_itcl"
+ ITCL_BIN_DIR=$withval
+else
+ ITCL_BIN_DIR=`cd ../../itcl/win; pwd`
+fi
+
+if test ! -d $ITCL_BIN_DIR; then
+ { echo "configure: error: Itcl directory $ITCL_BIN_DIR doesn't exist" 1>&2; exit 1; }
+fi
+if test ! -f $ITCL_BIN_DIR/Makefile; then
+ { echo "configure: error: There's no Makefile in $ITCL_BIN_DIR; perhaps you didn't specify the Itcl *build* directory (not the toplevel Itcl directory) or you forgot to configure Itcl?" 1>&2; exit 1; }
+fi
+
+file=$ITCL_BIN_DIR/../itclConfig.sh
+. $file
+
+
+echo $ac_n "checking whether C compiler is gcc""... $ac_c" 1>&6
+echo "configure:1840: checking whether C compiler is gcc" >&5
+if eval "test \"`echo '$''{'itcl_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+ cat > conftest.$ac_ext <<EOF
+#line 1846 "configure"
+#include "confdefs.h"
+
+#ifdef __GNUC__
+_cc_is_gcc_
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "_cc_is_gcc_" >/dev/null 2>&1; then
+ rm -rf conftest*
+ itcl_cv_prog_gcc=yes
+else
+ rm -rf conftest*
+ itcl_cv_prog_gcc=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$itcl_cv_prog_gcc" 1>&6
+
+if test -z "$CFLAGS" ; then
+ CFLAGS="-O"
+fi
+if test "$itcl_cv_prog_gcc" = "yes" ; then
+ CFLAGS="$CFLAGS -Wshadow -Wtraditional -Wall"
+fi
+
+echo $ac_n "checking default compiler flags""... $ac_c" 1>&6
+echo "configure:1876: checking default compiler flags" >&5
+# Check whether --with-cflags or --without-cflags was given.
+if test "${with_cflags+set}" = set; then
+ withval="$with_cflags"
+ CFLAGS="$with_cflags"
+fi
+
+
+echo "$ac_t""$CFLAGS" 1>&6
+
+#--------------------------------------------------------------------
+# Supply a substitute for stdlib.h if it doesn't define strtol,
+# strtoul, or strtod (which it doesn't in some versions of SunOS).
+#--------------------------------------------------------------------
+
+echo $ac_n "checking stdlib.h""... $ac_c" 1>&6
+echo "configure:1892: checking stdlib.h" >&5
+cat > conftest.$ac_ext <<EOF
+#line 1894 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "strtol" >/dev/null 2>&1; then
+ rm -rf conftest*
+ itk_ok=yes
+else
+ rm -rf conftest*
+ itk_ok=no
+fi
+rm -f conftest*
+
+cat > conftest.$ac_ext <<EOF
+#line 1909 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "strtoul" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ itk_ok=no
+fi
+rm -f conftest*
+
+cat > conftest.$ac_ext <<EOF
+#line 1923 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "strtod" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ itk_ok=no
+fi
+rm -f conftest*
+
+if test $itk_ok = no; then
+ cat >> confdefs.h <<\EOF
+#define NO_STDLIB_H 1
+EOF
+
+fi
+echo "$ac_t""$itk_ok" 1>&6
+
+#--------------------------------------------------------------------
+# Check for various typedefs and provide substitutes if
+# they don't exist.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6
+echo "configure:1950: checking for ANSI C header files" >&5
+if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1955 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1963: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ ac_cv_header_stdc=yes
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+if test $ac_cv_header_stdc = yes; then
+ # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+cat > conftest.$ac_ext <<EOF
+#line 1980 "configure"
+#include "confdefs.h"
+#include <string.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "memchr" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+ # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+cat > conftest.$ac_ext <<EOF
+#line 1998 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "free" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+ # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+if test "$cross_compiling" = yes; then
+ :
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2019 "configure"
+#include "confdefs.h"
+#include <ctype.h>
+#define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+#define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int main () { int i; for (i = 0; i < 256; i++)
+if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2);
+exit (0); }
+
+EOF
+if { (eval echo configure:2030: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ :
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_header_stdc=no
+fi
+rm -fr conftest*
+fi
+
+fi
+fi
+
+echo "$ac_t""$ac_cv_header_stdc" 1>&6
+if test $ac_cv_header_stdc = yes; then
+ cat >> confdefs.h <<\EOF
+#define STDC_HEADERS 1
+EOF
+
+fi
+
+echo $ac_n "checking for mode_t""... $ac_c" 1>&6
+echo "configure:2054: checking for mode_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_mode_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2059 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "(^|[^a-zA-Z_0-9])mode_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_mode_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_mode_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_mode_t" 1>&6
+if test $ac_cv_type_mode_t = no; then
+ cat >> confdefs.h <<\EOF
+#define mode_t int
+EOF
+
+fi
+
+echo $ac_n "checking for pid_t""... $ac_c" 1>&6
+echo "configure:2087: checking for pid_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_pid_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2092 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "(^|[^a-zA-Z_0-9])pid_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_pid_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_pid_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_pid_t" 1>&6
+if test $ac_cv_type_pid_t = no; then
+ cat >> confdefs.h <<\EOF
+#define pid_t int
+EOF
+
+fi
+
+echo $ac_n "checking for size_t""... $ac_c" 1>&6
+echo "configure:2120: checking for size_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2125 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "(^|[^a-zA-Z_0-9])size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_size_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_size_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_size_t" 1>&6
+if test $ac_cv_type_size_t = no; then
+ cat >> confdefs.h <<\EOF
+#define size_t unsigned
+EOF
+
+fi
+
+echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6
+echo "configure:2153: checking for uid_t in sys/types.h" >&5
+if eval "test \"`echo '$''{'ac_cv_type_uid_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2158 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "uid_t" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_uid_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_uid_t=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_type_uid_t" 1>&6
+if test $ac_cv_type_uid_t = no; then
+ cat >> confdefs.h <<\EOF
+#define uid_t int
+EOF
+
+ cat >> confdefs.h <<\EOF
+#define gid_t int
+EOF
+
+fi
+
+
+# -----------------------------------------------------------------------
+# C compiler and debugging flags
+# -----------------------------------------------------------------------
+echo $ac_n "checking which C compiler""... $ac_c" 1>&6
+echo "configure:2191: checking which C compiler" >&5
+if test -z "$CC" ; then
+ CC="cc"
+fi
+# Check whether --with-cc or --without-cc was given.
+if test "${with_cc+set}" = set; then
+ withval="$with_cc"
+ CC=$with_cc
+fi
+
+echo "$ac_t""$CC" 1>&6
+
+
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:2205: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # This must be in double quotes, not single quotes, because CPP may get
+ # substituted into the Makefile and "${CC-cc}" will confuse make.
+ CPP="${CC-cc} -E"
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp.
+ cat > conftest.$ac_ext <<EOF
+#line 2220 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2226: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -E -traditional-cpp"
+ cat > conftest.$ac_ext <<EOF
+#line 2237 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2243: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -nologo -E"
+ cat > conftest.$ac_ext <<EOF
+#line 2254 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2260: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+ ac_cv_prog_CPP="$CPP"
+fi
+ CPP="$ac_cv_prog_CPP"
+else
+ ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+
+#--------------------------------------------------------------------
+# Supply substitutes for missing POSIX header files.
+# Replacements are handled in "tclInt.h" which we include here.
+#--------------------------------------------------------------------
+
+ac_safe=`echo "limits.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for limits.h""... $ac_c" 1>&6
+echo "configure:2292: checking for limits.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2297 "configure"
+#include "confdefs.h"
+#include <limits.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2302: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define NO_LIMITS_H 1
+EOF
+
+fi
+
+ac_safe=`echo "stdlib.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for stdlib.h""... $ac_c" 1>&6
+echo "configure:2329: checking for stdlib.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2334 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2339: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_ok=1
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+cat > conftest.$ac_ext <<EOF
+#line 2362 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "strtol" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ tcl_ok=0
+fi
+rm -f conftest*
+
+cat > conftest.$ac_ext <<EOF
+#line 2376 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "strtoul" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ tcl_ok=0
+fi
+rm -f conftest*
+
+cat > conftest.$ac_ext <<EOF
+#line 2390 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "strtod" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ tcl_ok=0
+fi
+rm -f conftest*
+
+if test $tcl_ok = 0; then
+ cat >> confdefs.h <<\EOF
+#define NO_STDLIB_H 1
+EOF
+
+fi
+ac_safe=`echo "string.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for string.h""... $ac_c" 1>&6
+echo "configure:2411: checking for string.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2416 "configure"
+#include "confdefs.h"
+#include <string.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2421: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_ok=1
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+cat > conftest.$ac_ext <<EOF
+#line 2444 "configure"
+#include "confdefs.h"
+#include <string.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "strstr" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ tcl_ok=0
+fi
+rm -f conftest*
+
+cat > conftest.$ac_ext <<EOF
+#line 2458 "configure"
+#include "confdefs.h"
+#include <string.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "strerror" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ tcl_ok=0
+fi
+rm -f conftest*
+
+if test $tcl_ok = 0; then
+ cat >> confdefs.h <<\EOF
+#define NO_STRING_H 1
+EOF
+
+fi
+
+#--------------------------------------------------------------------
+# Check for various typedefs and provide substitutes if
+# they don't exist.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for mode_t""... $ac_c" 1>&6
+echo "configure:2484: checking for mode_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_mode_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2489 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "(^|[^a-zA-Z_0-9])mode_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_mode_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_mode_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_mode_t" 1>&6
+if test $ac_cv_type_mode_t = no; then
+ cat >> confdefs.h <<\EOF
+#define mode_t int
+EOF
+
+fi
+
+echo $ac_n "checking for pid_t""... $ac_c" 1>&6
+echo "configure:2517: checking for pid_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_pid_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2522 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "(^|[^a-zA-Z_0-9])pid_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_pid_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_pid_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_pid_t" 1>&6
+if test $ac_cv_type_pid_t = no; then
+ cat >> confdefs.h <<\EOF
+#define pid_t int
+EOF
+
+fi
+
+echo $ac_n "checking for size_t""... $ac_c" 1>&6
+echo "configure:2550: checking for size_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2555 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "(^|[^a-zA-Z_0-9])size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_size_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_size_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_size_t" 1>&6
+if test $ac_cv_type_size_t = no; then
+ cat >> confdefs.h <<\EOF
+#define size_t unsigned
+EOF
+
+fi
+
+echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6
+echo "configure:2583: checking for uid_t in sys/types.h" >&5
+if eval "test \"`echo '$''{'ac_cv_type_uid_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2588 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "uid_t" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_uid_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_uid_t=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_type_uid_t" 1>&6
+if test $ac_cv_type_uid_t = no; then
+ cat >> confdefs.h <<\EOF
+#define uid_t int
+EOF
+
+ cat >> confdefs.h <<\EOF
+#define gid_t int
+EOF
+
+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
+# no include files, so double-check its result just to be safe.
+#--------------------------------------------------------------------
+
+# If we find X, set shell vars x_includes and x_libraries to the
+# paths, otherwise set no_x=yes.
+# Uses ac_ vars as temps to allow command line to override cache and checks.
+# --without-x overrides everything else, but does not touch the cache.
+echo $ac_n "checking for X""... $ac_c" 1>&6
+echo "configure:2631: checking for X" >&5
+
+# Check whether --with-x or --without-x was given.
+if test "${with_x+set}" = set; then
+ withval="$with_x"
+ :
+fi
+
+# $have_x is `yes', `no', `disabled', or empty when we do not yet know.
+if test "x$with_x" = xno; then
+ # The user explicitly disabled X.
+ have_x=disabled
+else
+ if test "x$x_includes" != xNONE && test "x$x_libraries" != xNONE; then
+ # Both variables are already set.
+ have_x=yes
+ else
+if eval "test \"`echo '$''{'ac_cv_have_x'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # One or both of the vars are not set, and there is no cached value.
+ac_x_includes=NO ac_x_libraries=NO
+rm -fr conftestdir
+if mkdir conftestdir; then
+ cd conftestdir
+ # Make sure to not put "make" in the Imakefile rules, since we grep it out.
+ cat > Imakefile <<'EOF'
+acfindx:
+ @echo 'ac_im_incroot="${INCROOT}"; ac_im_usrlibdir="${USRLIBDIR}"; ac_im_libdir="${LIBDIR}"'
+EOF
+ if (xmkmf) >/dev/null 2>/dev/null && test -f Makefile; then
+ # GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+ eval `${MAKE-make} acfindx 2>/dev/null | grep -v make`
+ # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR.
+ for ac_extension in a so sl; do
+ if test ! -f $ac_im_usrlibdir/libX11.$ac_extension &&
+ test -f $ac_im_libdir/libX11.$ac_extension; then
+ ac_im_usrlibdir=$ac_im_libdir; break
+ fi
+ done
+ # Screen out bogus values from the imake configuration. They are
+ # bogus both because they are the default anyway, and because
+ # using them would break gcc on systems where it needs fixed includes.
+ case "$ac_im_incroot" in
+ /usr/include) ;;
+ *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes="$ac_im_incroot" ;;
+ esac
+ case "$ac_im_usrlibdir" in
+ /usr/lib | /lib) ;;
+ *) test -d "$ac_im_usrlibdir" && ac_x_libraries="$ac_im_usrlibdir" ;;
+ esac
+ fi
+ cd ..
+ rm -fr conftestdir
+fi
+
+if test "$ac_x_includes" = NO; then
+ # Guess where to find include files, by looking for this one X11 .h file.
+ test -z "$x_direct_test_include" && x_direct_test_include=X11/Intrinsic.h
+
+ # First, try using that file with no special directory specified.
+cat > conftest.$ac_ext <<EOF
+#line 2693 "configure"
+#include "confdefs.h"
+#include <$x_direct_test_include>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2698: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ # We can compile using X headers with no special include directory.
+ac_x_includes=
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ # Look for the header file in a standard set of common directories.
+# Check X11 before X11Rn because it is often a symlink to the current release.
+ for ac_dir in \
+ /usr/X11/include \
+ /usr/X11R6/include \
+ /usr/X11R5/include \
+ /usr/X11R4/include \
+ \
+ /usr/include/X11 \
+ /usr/include/X11R6 \
+ /usr/include/X11R5 \
+ /usr/include/X11R4 \
+ \
+ /usr/local/X11/include \
+ /usr/local/X11R6/include \
+ /usr/local/X11R5/include \
+ /usr/local/X11R4/include \
+ \
+ /usr/local/include/X11 \
+ /usr/local/include/X11R6 \
+ /usr/local/include/X11R5 \
+ /usr/local/include/X11R4 \
+ \
+ /usr/X386/include \
+ /usr/x386/include \
+ /usr/XFree86/include/X11 \
+ \
+ /usr/include \
+ /usr/local/include \
+ /usr/unsupported/include \
+ /usr/athena/include \
+ /usr/local/x11r5/include \
+ /usr/lpp/Xamples/include \
+ \
+ /usr/openwin/include \
+ /usr/openwin/share/include \
+ ; \
+ do
+ if test -r "$ac_dir/$x_direct_test_include"; then
+ ac_x_includes=$ac_dir
+ break
+ fi
+ done
+fi
+rm -f conftest*
+fi # $ac_x_includes = NO
+
+if test "$ac_x_libraries" = NO; then
+ # Check for the libraries.
+
+ test -z "$x_direct_test_library" && x_direct_test_library=Xt
+ test -z "$x_direct_test_function" && x_direct_test_function=XtMalloc
+
+ # See if we find them without any special options.
+ # Don't add to $LIBS permanently.
+ ac_save_LIBS="$LIBS"
+ LIBS="-l$x_direct_test_library $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2767 "configure"
+#include "confdefs.h"
+
+int main() {
+${x_direct_test_function}()
+; return 0; }
+EOF
+if { (eval echo configure:2774: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ LIBS="$ac_save_LIBS"
+# We can link X programs with no special library path.
+ac_x_libraries=
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ LIBS="$ac_save_LIBS"
+# First see if replacing the include by lib works.
+# Check X11 before X11Rn because it is often a symlink to the current release.
+for ac_dir in `echo "$ac_x_includes" | sed s/include/lib/` \
+ /usr/X11/lib \
+ /usr/X11R6/lib \
+ /usr/X11R5/lib \
+ /usr/X11R4/lib \
+ \
+ /usr/lib/X11 \
+ /usr/lib/X11R6 \
+ /usr/lib/X11R5 \
+ /usr/lib/X11R4 \
+ \
+ /usr/local/X11/lib \
+ /usr/local/X11R6/lib \
+ /usr/local/X11R5/lib \
+ /usr/local/X11R4/lib \
+ \
+ /usr/local/lib/X11 \
+ /usr/local/lib/X11R6 \
+ /usr/local/lib/X11R5 \
+ /usr/local/lib/X11R4 \
+ \
+ /usr/X386/lib \
+ /usr/x386/lib \
+ /usr/XFree86/lib/X11 \
+ \
+ /usr/lib \
+ /usr/local/lib \
+ /usr/unsupported/lib \
+ /usr/athena/lib \
+ /usr/local/x11r5/lib \
+ /usr/lpp/Xamples/lib \
+ /lib/usr/lib/X11 \
+ \
+ /usr/openwin/lib \
+ /usr/openwin/share/lib \
+ ; \
+do
+ for ac_extension in a so sl; do
+ if test -r $ac_dir/lib${x_direct_test_library}.$ac_extension; then
+ ac_x_libraries=$ac_dir
+ break 2
+ fi
+ done
+done
+fi
+rm -f conftest*
+fi # $ac_x_libraries = NO
+
+if test "$ac_x_includes" = NO || test "$ac_x_libraries" = NO; then
+ # Didn't find X anywhere. Cache the known absence of X.
+ ac_cv_have_x="have_x=no"
+else
+ # Record where we found X for the cache.
+ ac_cv_have_x="have_x=yes \
+ ac_x_includes=$ac_x_includes ac_x_libraries=$ac_x_libraries"
+fi
+fi
+ fi
+ eval "$ac_cv_have_x"
+fi # $with_x != no
+
+if test "$have_x" != yes; then
+ echo "$ac_t""$have_x" 1>&6
+ no_x=yes
+else
+ # If each of the values was on the command line, it overrides each guess.
+ test "x$x_includes" = xNONE && x_includes=$ac_x_includes
+ test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries
+ # Update the cache value to reflect the command line values.
+ ac_cv_have_x="have_x=yes \
+ ac_x_includes=$x_includes ac_x_libraries=$x_libraries"
+ echo "$ac_t""libraries $x_libraries, headers $x_includes" 1>&6
+fi
+
+not_really_there=""
+if test "$no_x" = ""; then
+ if test "$x_includes" = ""; then
+ cat > conftest.$ac_ext <<EOF
+#line 2864 "configure"
+#include "confdefs.h"
+#include <X11/XIntrinsic.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2869: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ not_really_there="yes"
+fi
+rm -f conftest*
+ else
+ if test ! -r $x_includes/X11/Intrinsic.h; then
+ not_really_there="yes"
+ fi
+ fi
+fi
+if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then
+ echo checking for X11 header files
+ XINCLUDES="# no special path needed"
+ cat > conftest.$ac_ext <<EOF
+#line 2891 "configure"
+#include "confdefs.h"
+#include <X11/Intrinsic.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2896: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ XINCLUDES="nope"
+fi
+rm -f conftest*
+ if test "$XINCLUDES" = nope; then
+ dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/X11R6/include /usr/include/X11R6 /usr/X11R5/include /usr/include/X11R5 /usr/include/X11R4 /usr/openwin/include /usr/X11/include /usr/sww/include"
+ for i in $dirs ; do
+ if test -r $i/X11/Intrinsic.h; then
+ XINCLUDES=" -I$i"
+ fi
+ done
+ fi
+else
+ if test "$x_includes" != ""; then
+ XINCLUDES=-I$x_includes
+ else
+ XINCLUDES="# no special path needed"
+ fi
+fi
+if test "$XINCLUDES" = nope; then
+ echo "Warning: couldn't find any X11 include files."
+ XINCLUDES="# no include files found"
+fi
+
+
+if test "$no_x" = yes; then
+ XLIBSW=nope
+ if test "$XLIBSW" = nope; then
+ dirs="/usr/unsupported/lib /usr/local/lib /usr/X386/lib /usr/X11R6/lib /usr/lib/X11R6 /usr/X11R5/lib /usr/lib/X11R5 /usr/lib/X11R4 /usr/openwin/lib /usr/X11/lib /usr/sww/X11/lib"
+ for i in $dirs ; do
+ if test -r $i/libX11.a; then
+ XLIBSW="-L$i -lX11"
+ fi
+ done
+ fi
+else
+ if test "$x_libraries" = ""; then
+ XLIBSW=-lX11
+ else
+ XLIBSW="-L$x_libraries -lX11"
+ fi
+fi
+if test "$XLIBSW" = nope ; then
+ echo $ac_n "checking for XCreateWindow in -lXwindow""... $ac_c" 1>&6
+echo "configure:2948: checking for XCreateWindow in -lXwindow" >&5
+ac_lib_var=`echo Xwindow'_'XCreateWindow | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lXwindow $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2956 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char XCreateWindow();
+
+int main() {
+XCreateWindow()
+; return 0; }
+EOF
+if { (eval echo configure:2967: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ XLIBSW=-lXwindow
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+fi
+if test "$XLIBSW" = nope ; then
+ echo "$ac_t""couldn't find any! Using -lX11." 1>&6
+ XLIBSW=-lX11
+fi
+
+#--------------------------------------------------------------------
+# If the X library binaries are in a non-standard directory, and
+# if a mechanism such as -R is available on this platform for
+# specifying a runtime search path for shared libraries, add the X
+# library location into that search path.
+#--------------------------------------------------------------------
+
+if test "$x_libraries" != "" -a "$ITK_LD_SEARCH_FLAGS" != ""; then
+ itk_tmp=`sed -e "s|\\\${LIB_RUNTIME_DIR}|$x_libraries|" << EOF
+$ITK_LD_SEARCH_FLAGS
+EOF`
+ ITK_LD_SEARCH_FLAGS="$ITK_LD_SEARCH_FLAGS $itk_tmp"
+fi
+
+#--------------------------------------------------------------------
+# 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
+# "gethostbyname" to check for -lnsl.
+# 2. Use each function name only once: can't redo a check because
+# autoconf caches the results of the last check and won't redo it.
+# 3. Use -lnsl and -lsocket only if they supply procedures that
+# aren't already present in the normal libraries. This is because
+# IRIX 5.2 has libraries, but they aren't needed and they're
+# bogus: they goof up name resolution if used.
+# 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+# To get around this problem, check for both libraries together
+# if -lsocket doesn't work by itself.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for main in -lXbsd""... $ac_c" 1>&6
+echo "configure:3026: checking for main in -lXbsd" >&5
+ac_lib_var=`echo Xbsd'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lXbsd $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 3034 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:3041: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ LIBS="$LIBS -lXbsd"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+itk_checkBoth=0
+echo $ac_n "checking for connect""... $ac_c" 1>&6
+echo "configure:3064: checking for connect" >&5
+if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 3069 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char connect(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char connect();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_connect) || defined (__stub___connect)
+choke me
+#else
+connect();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3092: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_connect=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_connect=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'connect`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ itk_checkSocket=0
+else
+ echo "$ac_t""no" 1>&6
+itk_checkSocket=1
+fi
+
+if test "$itk_checkSocket" = 1; then
+ echo $ac_n "checking for main in -lsocket""... $ac_c" 1>&6
+echo "configure:3114: checking for main in -lsocket" >&5
+ac_lib_var=`echo socket'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lsocket $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 3122 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:3129: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ LIBS="$LIBS -lsocket"
+else
+ echo "$ac_t""no" 1>&6
+itk_checkBoth=1
+fi
+
+fi
+if test "$itk_checkBoth" = 1; then
+ itk_oldLibs=$LIBS
+ LIBS="$LIBS -lsocket -lnsl"
+ echo $ac_n "checking for accept""... $ac_c" 1>&6
+echo "configure:3155: checking for accept" >&5
+if eval "test \"`echo '$''{'ac_cv_func_accept'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 3160 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char accept(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char accept();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_accept) || defined (__stub___accept)
+choke me
+#else
+accept();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3183: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_accept=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_accept=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'accept`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ itk_checkNsl=0
+else
+ echo "$ac_t""no" 1>&6
+LIBS=$itk_oldLibs
+fi
+
+fi
+echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6
+echo "configure:3205: checking for gethostbyname" >&5
+if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 3210 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char gethostbyname(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char gethostbyname();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_gethostbyname) || defined (__stub___gethostbyname)
+choke me
+#else
+gethostbyname();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3233: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_gethostbyname=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_gethostbyname=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+echo $ac_n "checking for main in -lnsl""... $ac_c" 1>&6
+echo "configure:3251: checking for main in -lnsl" >&5
+ac_lib_var=`echo nsl'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lnsl $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 3259 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:3266: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ LIBS="$LIBS -lnsl"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+fi
+
+
+#--------------------------------------------------------------------
+# 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.
+#
+# Note: can't use ac_check_lib macro (at least, not in Autoconf 2.1)
+# because it can't deal with the "-" in the library name.
+#--------------------------------------------------------------------
+
+if test -d /usr/include/mit ; then
+ echo $ac_n "checking MIT X libraries""... $ac_c" 1>&6
+echo "configure:3302: checking MIT X libraries" >&5
+ itk_oldCFlags=$CFLAGS
+ CFLAGS="$CFLAGS -I/usr/include/mit"
+ itk_oldLibs=$LIBS
+ LIBS="$LIBS -lX11-mit"
+ cat > conftest.$ac_ext <<EOF
+#line 3308 "configure"
+#include "confdefs.h"
+
+ #include <X11/Xlib.h>
+
+int main() {
+
+ XOpenDisplay(0);
+
+; return 0; }
+EOF
+if { (eval echo configure:3319: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+
+ echo "$ac_t""yes" 1>&6
+ XLIBSW="-lX11-mit"
+ XINCLUDES="-I/usr/include/mit"
+
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ echo "$ac_t""no" 1>&6
+fi
+rm -f conftest*
+ CFLAGS=$itk_oldCFlags
+ LIBS=$itk_oldLibs
+fi
+
+#--------------------------------------------------------------------
+# On a few very rare systems, all of the libm.a stuff is
+# already in libc.a. Set compiler flags accordingly.
+# Also, Linux requires the "ieee" library for math to
+# work right (and it must appear before "-lm").
+#--------------------------------------------------------------------
+
+MATH_LIBS=""
+echo $ac_n "checking for sin""... $ac_c" 1>&6
+echo "configure:3346: checking for sin" >&5
+if eval "test \"`echo '$''{'ac_cv_func_sin'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 3351 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char sin(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char sin();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_sin) || defined (__stub___sin)
+choke me
+#else
+sin();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3374: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_sin=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_sin=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'sin`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+MATH_LIBS="-lm"
+fi
+
+echo $ac_n "checking for main in -lieee""... $ac_c" 1>&6
+echo "configure:3395: checking for main in -lieee" >&5
+ac_lib_var=`echo ieee'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lieee $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 3403 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:3410: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ MATH_LIBS="-lieee $MATH_LIBS"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+#--------------------------------------------------------------------
+# If this system doesn't have a memmove procedure, use memcpy
+# instead.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for memmove""... $ac_c" 1>&6
+echo "configure:3437: checking for memmove" >&5
+if eval "test \"`echo '$''{'ac_cv_func_memmove'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 3442 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char memmove(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char memmove();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_memmove) || defined (__stub___memmove)
+choke me
+#else
+memmove();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3465: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_memmove=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_memmove=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'memmove`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+cat >> confdefs.h <<\EOF
+#define memmove memcpy
+EOF
+
+fi
+
+
+#--------------------------------------------------------------------
+# Figure out whether "char" is unsigned. If so, set a
+# #define for __CHAR_UNSIGNED__.
+#--------------------------------------------------------------------
+
+#AC_C_CHAR_UNSIGNED
+
+#--------------------------------------------------------------------
+# Under Solaris 2.4, strtod returns the wrong value for the
+# terminating character under some conditions. Check for this
+# and if the problem exists use a substitute procedure
+# "fixstrtod" (provided by Tcl) that corrects the error.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for strtod""... $ac_c" 1>&6
+echo "configure:3504: checking for strtod" >&5
+if eval "test \"`echo '$''{'ac_cv_func_strtod'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 3509 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char strtod(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char strtod();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_strtod) || defined (__stub___strtod)
+choke me
+#else
+strtod();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:3532: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_strtod=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_strtod=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'strtod`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ itk_strtod=1
+else
+ echo "$ac_t""no" 1>&6
+itk_strtod=0
+fi
+
+if test "$itk_strtod" = 1; then
+ echo $ac_n "checking for Solaris 2.4 strtod bug""... $ac_c" 1>&6
+echo "configure:3554: checking for Solaris 2.4 strtod bug" >&5
+ if test "$cross_compiling" = yes; then
+ itk_ok=0
+else
+ cat > conftest.$ac_ext <<EOF
+#line 3559 "configure"
+#include "confdefs.h"
+
+ extern double strtod();
+ int main()
+ {
+ char *string = "NaN";
+ char *term;
+ strtod(string, &term);
+ if ((term != string) && (term[-1] == 0)) {
+ exit(1);
+ }
+ exit(0);
+ }
+EOF
+if { (eval echo configure:3574: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ itk_ok=1
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ itk_ok=0
+fi
+rm -fr conftest*
+fi
+
+ if test "$itk_ok" = 1; then
+ echo "$ac_t""ok" 1>&6
+ else
+ echo "$ac_t""buggy" 1>&6
+ cat >> confdefs.h <<\EOF
+#define strtod fixstrtod
+EOF
+
+ fi
+fi
+
+#--------------------------------------------------------------------
+# If we are building with cygwin, we need one set of library names,
+# otherwise, we need the Source-Navigator set.
+#--------------------------------------------------------------------
+
+
+
+if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
+ CYGITKLIBSPEC=itk${VERSION}
+else
+ CYGITKLIBSPEC="itk`echo ${VERSION} | tr -d .`"
+fi
+CYGITKLIB=lib${CYGITKLIBSPEC}.a
+CYGITKDLL=cygitk${VERSION}.dll
+CYGITKWISH=cygitkwish${VERSION}.exe
+CYGITKDEF=itkcyg.def
+CYGITKTEST=cygitktest.exe
+CYGIMPORTLIB=cygitk${VERSION}.lib
+CYGITKRES=cygitk.o
+CYGITKWISHRES=cygitkwish.o
+
+SNITKLIBSPEC=itk30.lib
+SNITKLIB=${SNITKLIBSPEC}
+SNITKDLL=snitk30.dll
+SNITKWISH=snitkwish30.exe
+SNITKDEF=itksn.def
+SNITKTEST=snitktest.exe
+SNIMPORTLIB=snitk30.lib
+SNITKRES=snitk.obj
+SNITKWISHRES=snitksh.obj
+
+if test "$GCC" = yes; then
+ITKLIBSPEC=${CYGITKLIBSPEC}
+ITKLIB=${CYGITKLIB}
+ITKDLL=${CYGITKDLL}
+ITKWISH=${CYGITKWISH}
+ITKDEF=${CYGITKDEF}
+ITKTEST=${CYGITKTEST}
+ITKIMPORTLIB=${CYGIMPORTLIB}
+ITKRES=${CYGITKRES}
+ITKWISHRES=${CYGITKWISHRES}
+else
+ITKLIBSPEC=${SNITKLIBSPEC}
+ITKLIB=${SNITKLIB}
+ITKDLL=${SNITKDLL}
+ITKWISH=${SNITKWISH}
+ITKDEF=${SNITKDEF}
+ITKTEST=${SNITKTEST}
+ITKIMPORTLIB=${SNIMPORTLIB}
+ITKRES=${SNITKRES}
+ITKWISHRES=${SNITKWISHRES}
+fi
+
+#--------------------------------------------------------------------
+# The statements below define a collection of symbols related to
+# building libitk as a shared library instead of a static library.
+#--------------------------------------------------------------------
+
+# Check whether --enable-shared or --disable-shared was given.
+if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ ok=$enableval
+else
+ ok=no
+fi
+
+if test "$ok" = "yes" -a "${SHLIB_SUFFIX}" != ""; then
+ ITK_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+ eval "ITK_LIB_FILE=libitk${VERSION}${SHLIB_SUFFIX}"
+ ITK_PKG_FILE="[file join [file dirname \$dir] ${ITK_LIB_FILE}]"
+ MAKE_LIB="\${SHLIB_LD} -o ${ITK_LIB_FILE} ${LIBS} \${OBJS} ${SHLIB_LD_LIBS}"
+ RANLIB=":"
+else
+ ITK_SHLIB_CFLAGS=""
+ eval "ITK_LIB_FILE=libitk${VERSION}.a"
+ ITK_PKG_FILE=""
+ MAKE_LIB="ar cr ${ITK_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 "$GCC" = yes; then
+ ITK_BUILD_LIB_SPEC="-L`pwd` -l${ITKLIBSPEC}"
+ ITK_LIB_SPEC="-L${exec_prefix}/lib/ITK -l{ITKLIBSPEC}"
+ ITK_LIB_FULL_PATH="`pwd`/${ITKLIB}"
+else
+ tmp="`pwd`/${ITKLIB}"
+ tmp2="`cygpath --windows $tmp`"
+ ITK_BUILD_LIB_SPEC="`echo $tmp2 | sed -e s#\\\\\\\\#/#g`"
+ ITK_LIB_FULL_PATH=${ITK_BUILD_LIB_SPEC}
+ tmp="${exec_prefix}/lib/ITK/${ITKLIB}"
+ tmp2="`cygpath --windows $tmp`"
+ ITK_LIB_SPEC="`echo $tmp2 | sed -e s#\\\\\\\\#/#g`"
+fi
+
+if test "$GCC" = yes; then
+ BASELIBS="-lkernel32 $optlibs -ladvapi32 -luser32"
+ WINLIBS="-lgdi32 -lcomdlg32 -lwinspool"
+ LIBCDLL=
+else
+ BASELIBS="kernel32.lib advapi32.lib user32.lib"
+ WINLIBS="gdi32.lib comdlg32.lib winspool.lib"
+ LIBCDLL="msvcrt.lib oldnames.lib"
+fi
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.13"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "Makefile ../unix/pkgIndex.tcl ../itkConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@host@%$host%g
+s%@host_alias@%$host_alias%g
+s%@host_cpu@%$host_cpu%g
+s%@host_vendor@%$host_vendor%g
+s%@host_os@%$host_os%g
+s%@RANLIB@%$RANLIB%g
+s%@CC@%$CC%g
+s%@OBJEXT@%$OBJEXT%g
+s%@build@%$build%g
+s%@build_alias@%$build_alias%g
+s%@build_cpu@%$build_cpu%g
+s%@build_vendor@%$build_vendor%g
+s%@build_os@%$build_os%g
+s%@NM@%$NM%g
+s%@AS@%$AS%g
+s%@LD@%$LD%g
+s%@DLLTOOL@%$DLLTOOL%g
+s%@WINDRES@%$WINDRES%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@DLL_LDFLAGS@%$DLL_LDFLAGS%g
+s%@DLL_LDLIBS@%$DLL_LDLIBS%g
+s%@ITCLSH@%$ITCLSH%g
+s%@CPP@%$CPP%g
+s%@XINCLUDES@%$XINCLUDES%g
+s%@DL_LIBS@%$DL_LIBS%g
+s%@LD_FLAGS@%$LD_FLAGS%g
+s%@MATH_LIBS@%$MATH_LIBS%g
+s%@MAKE_LIB@%$MAKE_LIB%g
+s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
+s%@SHLIB_LD@%$SHLIB_LD%g
+s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
+s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
+s%@SHLIB_VERSION@%$SHLIB_VERSION%g
+s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g
+s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
+s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
+s%@TCL_VERSION@%$TCL_VERSION%g
+s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g
+s%@TCL_LIB_FULL_PATH@%$TCL_LIB_FULL_PATH%g
+s%@TK_BIN_DIR@%$TK_BIN_DIR%g
+s%@TK_BUILD_LIB_SPEC@%$TK_BUILD_LIB_SPEC%g
+s%@TK_SRC_DIR@%$TK_SRC_DIR%g
+s%@TK_VERSION@%$TK_VERSION%g
+s%@TK_LIB_FILE@%$TK_LIB_FILE%g
+s%@TK_LIB_FULL_PATH@%$TK_LIB_FULL_PATH%g
+s%@ITCL_BIN_DIR@%$ITCL_BIN_DIR%g
+s%@ITCL_BUILD_LIB_SPEC@%$ITCL_BUILD_LIB_SPEC%g
+s%@ITCL_MAJOR_VERSION@%$ITCL_MAJOR_VERSION%g
+s%@ITCL_MINOR_VERSION@%$ITCL_MINOR_VERSION%g
+s%@ITCL_SRC_DIR@%$ITCL_SRC_DIR%g
+s%@ITCL_VERSION@%$ITCL_VERSION%g
+s%@ITCL_LIB_FILE@%$ITCL_LIB_FILE%g
+s%@ITCL_LIB_FULL_PATH@%$ITCL_LIB_FULL_PATH%g
+s%@ITK_BUILD_LIB_SPEC@%$ITK_BUILD_LIB_SPEC%g
+s%@ITK_LD_SEARCH_FLAGS@%$ITK_LD_SEARCH_FLAGS%g
+s%@ITK_LIB_FILE@%$ITK_LIB_FILE%g
+s%@ITK_LIB_FULL_PATH@%$ITK_LIB_FULL_PATH%g
+s%@ITK_LIB_SPEC@%$ITK_LIB_SPEC%g
+s%@ITK_PKG_FILE@%$ITK_PKG_FILE%g
+s%@ITK_SHLIB_CFLAGS@%$ITK_SHLIB_CFLAGS%g
+s%@ITK_SRC_DIR@%$ITK_SRC_DIR%g
+s%@XLIBSW@%$XLIBSW%g
+s%@CYGITKLIB@%$CYGITKLIB%g
+s%@CYGITKDLL@%$CYGITKDLL%g
+s%@CYGITKWISH@%$CYGITKWISH%g
+s%@CYGITKDEF@%$CYGITKDEF%g
+s%@CYGITKTEST@%$CYGITKTEST%g
+s%@CYGIMPORTLIB@%$CYGIMPORTLIB%g
+s%@CYGITKRES@%$CYGITKRES%g
+s%@CYGITKWISHRES@%$CYGITKWISHRES%g
+s%@SNITKLIB@%$SNITKLIB%g
+s%@SNITKDLL@%$SNITKDLL%g
+s%@SNITKWISH@%$SNITKWISH%g
+s%@SNITKDEF@%$SNITKDEF%g
+s%@SNITKTEST@%$SNITKTEST%g
+s%@SNIMPORTLIB@%$SNIMPORTLIB%g
+s%@SNITKRES@%$SNITKRES%g
+s%@SNITKWISHRES@%$SNITKWISHRES%g
+s%@ITKLIB@%$ITKLIB%g
+s%@ITKDLL@%$ITKDLL%g
+s%@ITKWISH@%$ITKWISH%g
+s%@ITKDEF@%$ITKDEF%g
+s%@ITKTEST@%$ITKTEST%g
+s%@ITKIMPORTLIB@%$ITKIMPORTLIB%g
+s%@ITKRES@%$ITKRES%g
+s%@ITKWISHRES@%$ITKWISHRES%g
+s%@BASELIBS@%$BASELIBS%g
+s%@WINLIBS@%$WINLIBS%g
+s%@LIBCDLL@%$LIBCDLL%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile ../unix/pkgIndex.tcl ../itkConfig.sh"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+ case "$ac_given_INSTALL" in
+ [/$]*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ esac
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
+
diff --git a/itcl/itk/win/configure.in b/itcl/itk/win/configure.in
new file mode 100644
index 00000000000..42beccee3ca
--- /dev/null
+++ b/itcl/itk/win/configure.in
@@ -0,0 +1,630 @@
+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_PREREQ(2.5)
+
+AC_INIT(../generic/itk.h)
+
+AC_CONFIG_AUX_DIR(../../../)
+AC_CANONICAL_HOST
+
+AC_PROG_RANLIB
+
+AC_PROG_CC
+AC_OBJEXT
+AC_CHECK_TOOL(NM, nm, nm)
+AC_SUBST(NM)
+AC_CHECK_TOOL(AS, as, as)
+AC_SUBST(AS)
+AC_CHECK_TOOL(LD, ld, ld)
+AC_SUBST(LD)
+AC_CHECK_TOOL(DLLTOOL, dlltool, dlltool)
+AC_SUBST(DLLTOOL)
+AC_CHECK_TOOL(WINDRES, windres, windres)
+AC_SUBST(WINDRES)
+
+AC_PROG_INSTALL
+
+# needed for the subtle differences between cygwin and mingw32
+case "${host}" in
+*-*-cygwin*)
+ DLL_LDLIBS=-lcygwin
+ DLL_LDFLAGS='-nostartfiles -Wl,--dll'
+ ;;
+*-*-mingw32*)
+ DLL_LDLIBS=
+ DLL_LDFLAGS='-mdll'
+ ;;
+esac
+AC_SUBST(DLL_LDFLAGS)
+AC_SUBST(DLL_LDLIBS)
+
+ITCL_VERSION=3.0
+ITCL_MAJOR_VERSION=3
+ITCL_MINOR_VERSION=0
+VERSION=${ITCL_MAJOR_VERSION}${ITCL_MINOR_VERSION}
+
+if test "${prefix}" = "NONE"; then
+ prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+ exec_prefix=$prefix
+fi
+
+# -----------------------------------------------------------------------
+# Set up a new default --prefix. If a previous installation of
+# [incr Tcl] can be found searching $PATH use that directory.
+# -----------------------------------------------------------------------
+
+AC_PREFIX_DEFAULT(/usr/local)
+AC_PREFIX_PROGRAM(itclsh)
+
+# -----------------------------------------------------------------------
+BUILD_DIR=`pwd`
+ITK_SRC_DIR=`cd $srcdir/..; pwd`
+
+if ! test "$GCC" = yes; then
+ tmp="`cygpath --windows $ITK_SRC_DIR`"
+ ITK_SRC_DIR="`echo $tmp | sed -e s#\\\\\\\\#/#g`"
+fi
+
+cd ${BUILD_DIR}
+
+AC_ARG_ENABLE(gcc, [ --enable-gcc allow use of gcc if available],
+ [itk_ok=$enableval], [itk_ok=no])
+if test "$itk_ok" = "yes"; then
+ AC_PROG_CC
+else
+ CC=${CC-cc}
+AC_SUBST(CC)
+fi
+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.
+# CYGNUS LOCAL - Actually Tcl & Tk are siblings of the itcl directory
+# that contains itcl & itk & iwidgets.
+#--------------------------------------------------------------------
+
+AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.0 binaries from DIR],
+ TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../../tcl/win; pwd`)
+
+if test ! -f $TCL_BIN_DIR/../unix/tclConfig.sh; then
+ TCL_BIN_DIR=`cd ../../../tcl8.1/win;pwd`
+fi
+
+if test ! -f $TCL_BIN_DIR/../unix/tclConfig.sh; then
+ AC_MSG_ERROR(There's no tclConfig.sh 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/../unix/tclConfig.sh
+. $file
+
+dnl CFLAGS=$TCL_CFLAGS
+
+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
+ITK_LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Tk is; if
+# not, assume that its top-level directory is a sibling of ours.
+# CYGNUS LOCAL - actually these are one level higher in the CYGNUS tree.
+#--------------------------------------------------------------------
+
+AC_ARG_WITH(tcl, [ --with-tk=DIR use Tk 8.0 binaries from DIR],
+ TK_BIN_DIR=$withval, TK_BIN_DIR=`cd ../../../tk/win; pwd`)
+
+if test ! -f $TK_BIN_DIR/../unix/tkConfig.sh; then
+ TK_BIN_DIR=`cd ../../../tk8.1/win;pwd`
+fi
+
+if test ! -f $TK_BIN_DIR/../unix/tkConfig.sh; then
+ AC_MSG_ERROR(There's no tkConfig.sh in $TK_BIN_DIR; perhaps you didn't specify the Tk *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
+fi
+
+file=$TK_BIN_DIR/../unix/tkConfig.sh
+. $file
+
+if ! test "$GCC" = yes; then
+ tmp="`cygpath --windows $TK_BIN_DIR`"
+ TK_BIN_DIR="`echo $tmp | sed -e s#\\\\\\\\#/#g`"
+fi
+
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where [incr Tcl] is.
+# If not, assume that its top-level directory is a sibling of ours.
+#--------------------------------------------------------------------
+
+AC_ARG_WITH(itcl, [ --with-itcl=DIR use Itcl 3.0 binaries from DIR],
+ ITCL_BIN_DIR=$withval, ITCL_BIN_DIR=`cd ../../itcl/win; pwd`)
+if test ! -d $ITCL_BIN_DIR; then
+ AC_MSG_ERROR(Itcl directory $ITCL_BIN_DIR doesn't exist)
+fi
+if test ! -f $ITCL_BIN_DIR/Makefile; then
+ AC_MSG_ERROR(There's no Makefile in $ITCL_BIN_DIR; perhaps you didn't specify the Itcl *build* directory (not the toplevel Itcl directory) or you forgot to configure Itcl?)
+fi
+
+file=$ITCL_BIN_DIR/../itclConfig.sh
+. $file
+
+
+AC_MSG_CHECKING([whether C compiler is gcc])
+AC_CACHE_VAL(itcl_cv_prog_gcc, [
+ AC_EGREP_CPP(_cc_is_gcc_, [
+#ifdef __GNUC__
+_cc_is_gcc_
+#endif
+], [itcl_cv_prog_gcc=yes], [itcl_cv_prog_gcc=no])])
+AC_MSG_RESULT([$itcl_cv_prog_gcc])
+
+if test -z "$CFLAGS" ; then
+ CFLAGS="-O"
+fi
+if test "$itcl_cv_prog_gcc" = "yes" ; then
+ CFLAGS="$CFLAGS -Wshadow -Wtraditional -Wall"
+fi
+
+AC_MSG_CHECKING([default compiler flags])
+AC_ARG_WITH(cflags, [ --with-cflags=FLAGS set compiler flags to FLAGS],
+ [CFLAGS="$with_cflags"])
+
+AC_MSG_RESULT([$CFLAGS])
+
+#--------------------------------------------------------------------
+# Supply a substitute for stdlib.h if it doesn't define strtol,
+# strtoul, or strtod (which it doesn't in some versions of SunOS).
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING(stdlib.h)
+AC_HEADER_EGREP(strtol, stdlib.h, itk_ok=yes, itk_ok=no)
+AC_HEADER_EGREP(strtoul, stdlib.h, , itk_ok=no)
+AC_HEADER_EGREP(strtod, stdlib.h, , itk_ok=no)
+if test $itk_ok = no; then
+ AC_DEFINE(NO_STDLIB_H)
+fi
+AC_MSG_RESULT($itk_ok)
+
+#--------------------------------------------------------------------
+# Check for various typedefs and provide substitutes if
+# they don't exist.
+#--------------------------------------------------------------------
+
+AC_MODE_T
+AC_PID_T
+AC_SIZE_T
+AC_UID_T
+
+# -----------------------------------------------------------------------
+# C compiler and debugging flags
+# -----------------------------------------------------------------------
+AC_MSG_CHECKING([which C compiler])
+if test -z "$CC" ; then
+ CC="cc"
+fi
+AC_ARG_WITH(cc, [ --with-cc=CC set C compiler to CC],
+ [CC=$with_cc])
+AC_MSG_RESULT([$CC])
+AC_SUBST(CC)
+
+AC_PROG_CPP
+
+#--------------------------------------------------------------------
+# Supply substitutes for missing POSIX header files.
+# Replacements are handled in "tclInt.h" which we include here.
+#--------------------------------------------------------------------
+
+AC_CHECK_HEADER(limits.h, , AC_DEFINE(NO_LIMITS_H))
+AC_CHECK_HEADER(stdlib.h, tcl_ok=1, tcl_ok=0)
+AC_EGREP_HEADER(strtol, stdlib.h, , tcl_ok=0)
+AC_EGREP_HEADER(strtoul, stdlib.h, , tcl_ok=0)
+AC_EGREP_HEADER(strtod, stdlib.h, , tcl_ok=0)
+if test $tcl_ok = 0; then
+ AC_DEFINE(NO_STDLIB_H)
+fi
+AC_CHECK_HEADER(string.h, tcl_ok=1, tcl_ok=0)
+AC_EGREP_HEADER(strstr, string.h, , tcl_ok=0)
+AC_EGREP_HEADER(strerror, string.h, , tcl_ok=0)
+if test $tcl_ok = 0; then
+ AC_DEFINE(NO_STRING_H)
+fi
+
+#--------------------------------------------------------------------
+# Check for various typedefs and provide substitutes if
+# they don't exist.
+#--------------------------------------------------------------------
+
+AC_MODE_T
+AC_PID_T
+AC_SIZE_T
+AC_UID_T
+
+#--------------------------------------------------------------------
+# 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
+# no include files, so double-check its result just to be safe.
+#--------------------------------------------------------------------
+
+AC_PATH_X
+not_really_there=""
+if test "$no_x" = ""; then
+ if test "$x_includes" = ""; then
+ AC_TRY_CPP([#include <X11/XIntrinsic.h>], , not_really_there="yes")
+ else
+ if test ! -r $x_includes/X11/Intrinsic.h; then
+ not_really_there="yes"
+ fi
+ fi
+fi
+if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then
+ echo checking for X11 header files
+ XINCLUDES="# no special path needed"
+ AC_TRY_CPP([#include <X11/Intrinsic.h>], , XINCLUDES="nope")
+ if test "$XINCLUDES" = nope; then
+ dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/X11R6/include /usr/include/X11R6 /usr/X11R5/include /usr/include/X11R5 /usr/include/X11R4 /usr/openwin/include /usr/X11/include /usr/sww/include"
+ for i in $dirs ; do
+ if test -r $i/X11/Intrinsic.h; then
+ XINCLUDES=" -I$i"
+ fi
+ done
+ fi
+else
+ if test "$x_includes" != ""; then
+ XINCLUDES=-I$x_includes
+ else
+ XINCLUDES="# no special path needed"
+ fi
+fi
+if test "$XINCLUDES" = nope; then
+ echo "Warning: couldn't find any X11 include files."
+ XINCLUDES="# no include files found"
+fi
+AC_SUBST(XINCLUDES)
+
+if test "$no_x" = yes; then
+ XLIBSW=nope
+ if test "$XLIBSW" = nope; then
+ dirs="/usr/unsupported/lib /usr/local/lib /usr/X386/lib /usr/X11R6/lib /usr/lib/X11R6 /usr/X11R5/lib /usr/lib/X11R5 /usr/lib/X11R4 /usr/openwin/lib /usr/X11/lib /usr/sww/X11/lib"
+ for i in $dirs ; do
+ if test -r $i/libX11.a; then
+ XLIBSW="-L$i -lX11"
+ fi
+ done
+ fi
+else
+ if test "$x_libraries" = ""; then
+ XLIBSW=-lX11
+ else
+ XLIBSW="-L$x_libraries -lX11"
+ fi
+fi
+if test "$XLIBSW" = nope ; then
+ AC_CHECK_LIB(Xwindow, XCreateWindow, XLIBSW=-lXwindow)
+fi
+if test "$XLIBSW" = nope ; then
+ AC_MSG_RESULT(couldn't find any! Using -lX11.)
+ XLIBSW=-lX11
+fi
+
+#--------------------------------------------------------------------
+# If the X library binaries are in a non-standard directory, and
+# if a mechanism such as -R is available on this platform for
+# specifying a runtime search path for shared libraries, add the X
+# library location into that search path.
+#--------------------------------------------------------------------
+
+if test "$x_libraries" != "" -a "$ITK_LD_SEARCH_FLAGS" != ""; then
+ itk_tmp=`sed -e "s|\\\${LIB_RUNTIME_DIR}|$x_libraries|" << EOF
+$ITK_LD_SEARCH_FLAGS
+EOF`
+ ITK_LD_SEARCH_FLAGS="$ITK_LD_SEARCH_FLAGS $itk_tmp"
+fi
+
+#--------------------------------------------------------------------
+# 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
+# "gethostbyname" to check for -lnsl.
+# 2. Use each function name only once: can't redo a check because
+# autoconf caches the results of the last check and won't redo it.
+# 3. Use -lnsl and -lsocket only if they supply procedures that
+# aren't already present in the normal libraries. This is because
+# IRIX 5.2 has libraries, but they aren't needed and they're
+# bogus: they goof up name resolution if used.
+# 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+# To get around this problem, check for both libraries together
+# if -lsocket doesn't work by itself.
+#--------------------------------------------------------------------
+
+AC_CHECK_LIB(Xbsd, main, [LIBS="$LIBS -lXbsd"])
+
+itk_checkBoth=0
+AC_CHECK_FUNC(connect, itk_checkSocket=0, itk_checkSocket=1)
+if test "$itk_checkSocket" = 1; then
+ AC_CHECK_LIB(socket, main, LIBS="$LIBS -lsocket", itk_checkBoth=1)
+fi
+if test "$itk_checkBoth" = 1; then
+ itk_oldLibs=$LIBS
+ LIBS="$LIBS -lsocket -lnsl"
+ AC_CHECK_FUNC(accept, itk_checkNsl=0, [LIBS=$itk_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.
+#
+# Note: can't use ac_check_lib macro (at least, not in Autoconf 2.1)
+# because it can't deal with the "-" in the library name.
+#--------------------------------------------------------------------
+
+if test -d /usr/include/mit ; then
+ AC_MSG_CHECKING([MIT X libraries])
+ itk_oldCFlags=$CFLAGS
+ CFLAGS="$CFLAGS -I/usr/include/mit"
+ itk_oldLibs=$LIBS
+ LIBS="$LIBS -lX11-mit"
+ AC_TRY_LINK([
+ #include <X11/Xlib.h>
+ ], [
+ XOpenDisplay(0);
+ ], [
+ AC_MSG_RESULT(yes)
+ XLIBSW="-lX11-mit"
+ XINCLUDES="-I/usr/include/mit"
+ ], AC_MSG_RESULT(no))
+ CFLAGS=$itk_oldCFlags
+ LIBS=$itk_oldLibs
+fi
+
+#--------------------------------------------------------------------
+# On a few very rare systems, all of the libm.a stuff is
+# already in libc.a. Set compiler flags accordingly.
+# Also, Linux requires the "ieee" library for math to
+# 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
+
+#--------------------------------------------------------------------
+# Under Solaris 2.4, strtod returns the wrong value for the
+# terminating character under some conditions. Check for this
+# and if the problem exists use a substitute procedure
+# "fixstrtod" (provided by Tcl) that corrects the error.
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(strtod, itk_strtod=1, itk_strtod=0)
+if test "$itk_strtod" = 1; then
+ AC_MSG_CHECKING([for Solaris 2.4 strtod bug])
+ AC_TRY_RUN([
+ extern double strtod();
+ int main()
+ {
+ char *string = "NaN";
+ char *term;
+ strtod(string, &term);
+ if ((term != string) && (term[-1] == 0)) {
+ exit(1);
+ }
+ exit(0);
+ }], itk_ok=1, itk_ok=0, itk_ok=0)
+ if test "$itk_ok" = 1; then
+ AC_MSG_RESULT(ok)
+ else
+ AC_MSG_RESULT(buggy)
+ AC_DEFINE(strtod, fixstrtod)
+ fi
+fi
+
+#--------------------------------------------------------------------
+# If we are building with cygwin, we need one set of library names,
+# otherwise, we need the Source-Navigator set.
+#--------------------------------------------------------------------
+
+
+
+if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
+ CYGITKLIBSPEC=itk${VERSION}
+else
+ CYGITKLIBSPEC="itk`echo ${VERSION} | tr -d .`"
+fi
+CYGITKLIB=lib${CYGITKLIBSPEC}.a
+CYGITKDLL=cygitk${VERSION}.dll
+CYGITKWISH=cygitkwish${VERSION}.exe
+CYGITKDEF=itkcyg.def
+CYGITKTEST=cygitktest.exe
+CYGIMPORTLIB=cygitk${VERSION}.lib
+CYGITKRES=cygitk.o
+CYGITKWISHRES=cygitkwish.o
+
+SNITKLIBSPEC=itk30.lib
+SNITKLIB=${SNITKLIBSPEC}
+SNITKDLL=snitk30.dll
+SNITKWISH=snitkwish30.exe
+SNITKDEF=itksn.def
+SNITKTEST=snitktest.exe
+SNIMPORTLIB=snitk30.lib
+SNITKRES=snitk.obj
+SNITKWISHRES=snitksh.obj
+
+if test "$GCC" = yes; then
+ITKLIBSPEC=${CYGITKLIBSPEC}
+ITKLIB=${CYGITKLIB}
+ITKDLL=${CYGITKDLL}
+ITKWISH=${CYGITKWISH}
+ITKDEF=${CYGITKDEF}
+ITKTEST=${CYGITKTEST}
+ITKIMPORTLIB=${CYGIMPORTLIB}
+ITKRES=${CYGITKRES}
+ITKWISHRES=${CYGITKWISHRES}
+else
+ITKLIBSPEC=${SNITKLIBSPEC}
+ITKLIB=${SNITKLIB}
+ITKDLL=${SNITKDLL}
+ITKWISH=${SNITKWISH}
+ITKDEF=${SNITKDEF}
+ITKTEST=${SNITKTEST}
+ITKIMPORTLIB=${SNIMPORTLIB}
+ITKRES=${SNITKRES}
+ITKWISHRES=${SNITKWISHRES}
+fi
+
+#--------------------------------------------------------------------
+# The statements below define a collection of symbols related to
+# building libitk as a shared library instead of a static library.
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(shared,
+ [ --enable-shared build libitk as a shared library],
+ [ok=$enableval], [ok=no])
+if test "$ok" = "yes" -a "${SHLIB_SUFFIX}" != ""; then
+ ITK_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+ eval "ITK_LIB_FILE=libitk${VERSION}${SHLIB_SUFFIX}"
+ ITK_PKG_FILE="[[file join [file dirname \$dir] ${ITK_LIB_FILE}]]"
+ MAKE_LIB="\${SHLIB_LD} -o ${ITK_LIB_FILE} ${LIBS} \${OBJS} ${SHLIB_LD_LIBS}"
+ RANLIB=":"
+else
+ ITK_SHLIB_CFLAGS=""
+ eval "ITK_LIB_FILE=libitk${VERSION}.a"
+ ITK_PKG_FILE=""
+ MAKE_LIB="ar cr ${ITK_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 "$GCC" = yes; then
+ ITK_BUILD_LIB_SPEC="-L`pwd` -l${ITKLIBSPEC}"
+ ITK_LIB_SPEC="-L${exec_prefix}/lib/ITK -l{ITKLIBSPEC}"
+ ITK_LIB_FULL_PATH="`pwd`/${ITKLIB}"
+else
+ tmp="`pwd`/${ITKLIB}"
+ tmp2="`cygpath --windows $tmp`"
+ ITK_BUILD_LIB_SPEC="`echo $tmp2 | sed -e s#\\\\\\\\#/#g`"
+ ITK_LIB_FULL_PATH=${ITK_BUILD_LIB_SPEC}
+ tmp="${exec_prefix}/lib/ITK/${ITKLIB}"
+ tmp2="`cygpath --windows $tmp`"
+ ITK_LIB_SPEC="`echo $tmp2 | sed -e s#\\\\\\\\#/#g`"
+fi
+
+if test "$GCC" = yes; then
+ BASELIBS="-lkernel32 $optlibs -ladvapi32 -luser32"
+ WINLIBS="-lgdi32 -lcomdlg32 -lwinspool"
+ LIBCDLL=
+else
+ BASELIBS="kernel32.lib advapi32.lib user32.lib"
+ WINLIBS="gdi32.lib comdlg32.lib winspool.lib"
+ LIBCDLL="msvcrt.lib oldnames.lib"
+fi
+
+AC_SUBST(CFLAGS)
+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(TCL_LIB_FILE)
+AC_SUBST(TCL_LIB_FULL_PATH)
+AC_SUBST(TK_BIN_DIR)
+AC_SUBST(TK_BUILD_LIB_SPEC)
+AC_SUBST(TK_SRC_DIR)
+AC_SUBST(TK_VERSION)
+AC_SUBST(TK_LIB_FILE)
+AC_SUBST(TK_LIB_FULL_PATH)
+AC_SUBST(ITCL_BIN_DIR)
+AC_SUBST(ITCL_BUILD_LIB_SPEC)
+AC_SUBST(ITCL_MAJOR_VERSION)
+AC_SUBST(ITCL_MINOR_VERSION)
+AC_SUBST(ITCL_SRC_DIR)
+AC_SUBST(ITCL_VERSION)
+AC_SUBST(ITCL_LIB_FILE)
+AC_SUBST(ITCL_LIB_FULL_PATH)
+AC_SUBST(ITK_BUILD_LIB_SPEC)
+AC_SUBST(ITK_LD_SEARCH_FLAGS)
+AC_SUBST(ITK_LIB_FILE)
+AC_SUBST(ITK_LIB_FULL_PATH)
+AC_SUBST(ITK_LIB_SPEC)
+AC_SUBST(ITK_PKG_FILE)
+AC_SUBST(ITK_SHLIB_CFLAGS)
+AC_SUBST(ITK_SRC_DIR)
+AC_SUBST(XINCLUDES)
+AC_SUBST(XLIBSW)
+AC_SUBST(CYGITKLIB)
+AC_SUBST(CYGITKDLL)
+AC_SUBST(CYGITKWISH)
+AC_SUBST(CYGITKDEF)
+AC_SUBST(CYGITKTEST)
+AC_SUBST(CYGIMPORTLIB)
+AC_SUBST(CYGITKRES)
+AC_SUBST(CYGITKWISHRES)
+AC_SUBST(SNITKLIB)
+AC_SUBST(SNITKDLL)
+AC_SUBST(SNITKWISH)
+AC_SUBST(SNITKDEF)
+AC_SUBST(SNITKTEST)
+AC_SUBST(SNIMPORTLIB)
+AC_SUBST(SNITKRES)
+AC_SUBST(SNITKWISHRES)
+AC_SUBST(ITKLIB)
+AC_SUBST(ITKDLL)
+AC_SUBST(ITKWISH)
+AC_SUBST(ITKDEF)
+AC_SUBST(ITKTEST)
+AC_SUBST(ITKIMPORTLIB)
+AC_SUBST(ITKRES)
+AC_SUBST(ITKWISHRES)
+AC_SUBST(BASELIBS)
+AC_SUBST(WINLIBS)
+AC_SUBST(LIBCDLL)
+
+AC_OUTPUT(Makefile ../unix/pkgIndex.tcl ../itkConfig.sh)
+
diff --git a/itcl/itk/win/dllEntryPoint.c b/itcl/itk/win/dllEntryPoint.c
new file mode 100644
index 00000000000..d7b2f9e3613
--- /dev/null
+++ b/itcl/itk/win/dllEntryPoint.c
@@ -0,0 +1,92 @@
+/*
+ * dllEntryPoint.c --
+ *
+ * This file implements the Dll entry point as needed by Windows.
+ */
+
+/*
+ * dllEntryPoint.c --
+ *
+ * This file implements the Dll entry point as needed by Windows.
+ */
+
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#include <tcl.h>
+
+/*
+ * The following declaration is for the VC++ DLL entry point.
+ */
+
+BOOL APIENTRY DllMain _ANSI_ARGS_((HINSTANCE hInst,
+ DWORD reason, LPVOID reserved));
+
+/* CYGNUS LOCAL */
+#ifdef __CYGWIN32__
+
+/* cygwin32 requires an impure pointer variable, which must be
+ explicitly initialized when the DLL starts up. */
+struct _reent *_impure_ptr;
+extern struct _reent *_imp__reent_data;
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DllEntryPoint --
+ *
+ * This wrapper function is used by Borland to invoke the
+ * initialization code for Tk. It simply calls the DllMain
+ * routine.
+ *
+ * Results:
+ * See DllMain.
+ *
+ * Side effects:
+ * See DllMain.
+ *
+ *----------------------------------------------------------------------
+ */
+
+BOOL APIENTRY
+DllEntryPoint(hInst, reason, reserved)
+ HINSTANCE hInst; /* Library instance handle. */
+ DWORD reason; /* Reason this function is being called. */
+ LPVOID reserved; /* Not used. */
+{
+ return DllMain(hInst, reason, reserved);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DllMain --
+ *
+ * DLL entry point.
+ *
+ * Results:
+ * TRUE on sucess, FALSE on failure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+BOOL APIENTRY
+DllMain(hInstance, reason, reserved)
+ HINSTANCE hInstance;
+ DWORD reason;
+ LPVOID reserved;
+{
+/* CYGNUS LOCAL */
+#ifdef __CYGWIN32__
+ /* CYGNUS LOCAL */
+ /* cygwin32 requires the impure data pointer to be initialized
+ when the DLL starts up. */
+ _impure_ptr = _imp__reent_data;
+ /* END CYGNUS LOCAL */
+#endif
+
+ return(TRUE);
+}
diff --git a/itcl/itk/win/makefile.bc b/itcl/itk/win/makefile.bc
new file mode 100644
index 00000000000..27fd4e783ba
--- /dev/null
+++ b/itcl/itk/win/makefile.bc
@@ -0,0 +1,228 @@
+# Borland C++ 4.52 makefile
+#
+# Copyright (c) 1993-1996 Lucent Technologies
+# based on original from
+# 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.
+
+!include "..\..\Makefile.bc"
+
+#
+# Project directories
+#
+# ROOT = top of source tree
+# TMPDIR = location where .obj files should be stored during build
+
+ROOT = ..
+TMPDIR = .
+TARGET_LIB_ITK = $(TARGET_LIB)\Itk2.2
+TARGET_DOC_ITK = $(TARGET_DOC)\Itk
+
+# uncomment the following line to compile with symbols
+#DEBUG=1
+
+# uncomment the following two lines to compile with TCL_MEM_DEBUG
+#DEBUGDEFINES =TCL_MEM_DEBUG
+
+
+INCLUDES =$(BORLAND)\include;$(ROOT)\generic;$(ROOT);$(TCLDIR)\generic;$(ITCLDIR)\generic;$(TKDIR)\generic;$(TKDIR)\xlib;$(TKDIR)\bitmaps
+LIBDIRS =$(BORLAND)\lib;$(ROOT)\win
+
+!ifndef DEBUG
+
+# these macros cause maximum optimization and no symbols
+DEBUGLDFLAGS =
+DEBUGCCFLAGS = -v- -vi- -O2
+
+!else
+
+# these macros enable debugging
+DEBUGLDFLAGS = -v
+DEBUGCCFLAGS = -k -Od -v
+
+!endif
+
+DEFINES = _RTLDLL;USE_TCLALLOC=0;STRICT;$(DEBUGDEFINES);ITCL_NAMESPACES=1
+PROJECTCCFLAGS= $(DEBUGCCFLAGS) -w-par -w-stu
+
+LNFLAGS_exe = -Tpe -aa -c $(DEBUGLDFLAGS) $(BORLAND)\lib\c0w32
+LNFLAGS_dll = -Tpd -aa -c $(DEBUGLDFLAGS) $(BORLAND)\lib\c0d32
+
+LNLIBS_exe = $(ITKLIB) $(ITCLLIBDIR)\$(ITCLLIB) $(TKLIBDIR)\$(TKLIB) $(TCLLIBDIR)\$(TCLLIB) import32 cw32i
+LNLIBS_dll = $(ITCLLIBDIR)\$(ITCLLIB) $(TKLIBDIR)\$(TKLIB) $(TCLLIBDIR)\$(TCLLIB) import32 cw32i
+
+#
+# Global makefile settings
+#
+
+.AUTODEPEND
+.CACHEAUTODEPEND
+
+.suffixes: .c .dll .lib .obj .exe
+
+.path.c=$(ROOT)\win;$(ROOT)\generic;
+.path.obj=$(TMPDIR)
+
+ITKWISHOBJS = \
+ $(TKLIBDIR)\tkConsole.obj \
+ $(TMPDIR)\winMain.obj
+
+ITKOBJS = \
+ $(TMPDIR)\itk_archetype.obj \
+ $(TMPDIR)\itk_cmds.obj \
+ $(TMPDIR)\itk_option.obj \
+ $(TMPDIR)\itk_util.obj \
+ $(TMPDIR)\dllEntryPoint.obj
+
+ITKWISH = itkwish.exe
+
+
+#
+# Targets
+#
+
+all: cfgdll $(ITKDLL) cfgexe $(ITKWISH) cfgcln
+test: $(ITKWISH)
+ $(CP) $(TCLLIBDIR)\*.dll
+ $(CP) $(TKLIBDIR)\*.dll
+ $(CP) $(ITCLLIBDIR)\*.dll
+#set ITK_
+ $(ITKWISH) <<|
+ cd ..\tests
+ source all
+ exit
+|
+
+install: all
+ $(MKDIR) "$(TARGET_ROOT)"
+ $(MKDIR) "$(TARGET_BIN)"
+ $(MKDIR) "$(TARGET_LIB_ROOT)"
+ $(MKDIR) "$(TARGET_LIB)"
+ $(MKDIR) "$(TARGET_LIB_ITK)"
+ $(MKDIR) "$(TARGET_INCLUDE_ROOT)"
+ $(MKDIR) "$(TARGET_INCLUDE)"
+ $(MKDIR) "$(TARGET_DOC)"
+ $(MKDIR) "$(TARGET_DOC_ITK)"
+ $(CP) $(TMPDIR)\$(ITKWISH) "$(TARGET_BIN)"
+ $(CP) $(TMPDIR)\$(ITKDLL) "$(TARGET_BIN)"
+ $(CP) $(ROOT)\generic\itk.h "$(TARGET_INCLUDE)"
+ $(CP) $(ROOT)\library\*.* "$(TARGET_LIB_ITK)"
+ $(CP) $(ROOT)\win\*.tcl "$(TARGET_LIB_ITK)"
+ $(CP) $(ROOT)\..\html\Itk\*.* "$(TARGET_DOC_ITK)"
+
+# Implicit Targets
+
+.c.obj:
+ @$(BCC32) {$< }
+
+.dll.lib:
+ $(IMPLIB) -c $@ $<
+
+.rc.res:
+ $(RC) -i$(ROOT)\generic;$(ITCLDIR)\generic;$(TCLDIR)\generic;$(TKDIR)\generic $<
+
+#
+# Special case object file targets
+#
+
+#
+# Configuration file targets - these files are implicitly used by the compiler
+#
+
+cfgdll:
+ @$(CP) &&|
+ -n$(TMPDIR) -I$(INCLUDES) -c -WD
+ -D$(DEFINES) -3 -d $(PROJECTCCFLAGS)
+| bcc32.cfg >NUL
+
+cfgexe:
+ @$(CP) &&|
+ -n$(TMPDIR) -I$(INCLUDES) -c -W
+ -D$(DEFINES) -3 -d $(PROJECTCCFLAGS)
+| bcc32.cfg >NUL
+
+cfgtest:
+ @$(CP) &&|
+ -n$(TMPDIR) -I$(INCLUDES) -c -W
+ -D$(DEFINES);TCL_TEST -3 -d $(PROJECTCCFLAGS)
+| bcc32.cfg >NUL
+
+cfgcln:
+ @$(RM) bcc32.cfg
+
+#
+# Executable targets
+#
+
+$(ITKDLL): $(ITKOBJS) itk.def rc\itk.res
+ $(TLINK32) @&&|
+$(LNFLAGS_dll) $(ITKOBJS)
+$@
+-x
+$(LNLIBS_dll)
+itk.def
+rc\itk.res
+|
+
+$(ITKWISH): $(ITKWISHOBJS) $(ITKLIB) rc\itkwish.res
+ $(TLINK32) @&&|
+$(LNFLAGS_exe) $(ITKWISHOBJS)
+$@
+-x
+$(LNLIBS_exe)
+|, &&|
+EXETYPE WINDOWS
+CODE PRELOAD MOVEABLE DISCARDABLE
+DATA PRELOAD MOVEABLE MULTIPLE
+|, rc\itkwish.res
+
+#
+# Other dependencies
+#
+
+
+# The following rule automatically generates a tk.def file containing
+# an export entry for every public symbol in the $(TKDLL) library.
+
+itk.def: $(ITKOBJS)
+ $(TCLLIBDIR)\dumpexts.exe -o $@ $(ITKDLL) @&&|
+ $(ITKOBJS)
+|
+
+# Dependencies for .rc files:
+rc\itk.res: rc\*.cur rc\itk.ico
+rc\itkwish.res: rc\*.cur rc\itk.ico
+
+# debugging rules, the .dll and .exe files must be in the same
+# directory as the object files for debugging purposes
+
+$(TMPDIR)\$(ITKDLL): $(ITKDLL)
+ $(CP) $(ITKDLL) $(TMPDIR)
+
+$(TMPDIR)\$(ITCLDLL): $(ITCLLIBDIR)\$(ITCLDLL)
+ $(CP) $(ITCLLIBDIR)\$(ITCLDLL) $(TMPDIR)
+
+$(TMPDIR)\$(TKDLL): $(TKLIBDIR)\$(TKDLL)
+ $(CP) $(TKLIBDIR)\$(TKDLL) $(TMPDIR)
+
+$(TMPDIR)\$(TCLDLL): $(TCLLIBDIR)\$(TCLDLL)
+ $(CP) $(TCLLIBDIR)\$(TCLDLL) $(TMPDIR)
+
+$(TMPDIR)\$(ITKWISH): $(ITKWISH)
+ $(CP) $(ITKWISH) $(TMPDIR)
+
+debug: $(TMPDIR)\$(ITKDLL) $(TMPDIR)\$(ITCLDLL) $(TMPDIR)\$(TKDLL) $(TMPDIR)\$(TCLDLL)
+
+
+# remove all generated files
+
+clean:
+ -@$(RM) $(ITKWISH)
+ -@$(RM) $(ITKLIB)
+ -@$(RM) $(ITKDLL)
+ -@$(RM) itk.def
+ -@$(RM) $(TMPDIR)\Rc\*.res
+ -@$(RM) $(TMPDIR)\*.obj
+ -@$(RM) *.cfg
diff --git a/itcl/itk/win/makefile.vc b/itcl/itk/win/makefile.vc
new file mode 100644
index 00000000000..b0653f31892
--- /dev/null
+++ b/itcl/itk/win/makefile.vc
@@ -0,0 +1,271 @@
+# 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.8 98/07/29 13:14:52
+
+# 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.
+#
+# NOTE: Be sure to modify the "makefile.vc" file in the toplevel directory
+# for the itcl distribution. Include the location of your VC++ development
+# tools and the installation directory.
+
+!include "..\..\makefile.vc"
+
+
+# ROOT = top of source tree
+#
+# TMPDIR = location where .obj files should be stored during build
+
+ROOT = ..
+ITCLDIR = ..\..\itcl
+
+######################################################################
+# Do not modify below this line
+######################################################################
+
+ITKNAMEPREFIX = itk
+WISHNAMEPREFIX = itkwish
+VERSION = 30
+DOTVERSION = 3.0
+
+BINROOT = .
+!IF "$(NODEBUG)" == "1"
+TMPDIR = $(BINROOT)\Release
+DBGX =
+!ELSE
+TMPDIR = $(BINROOT)\Debug
+DBGX = d
+!ENDIF
+OUTDIR = $(TMPDIR)
+
+ITKDLLNAME = $(ITKNAMEPREFIX)$(VERSION)$(DBGX).dll
+ITKDLL = $(OUTDIR)\$(ITKDLLNAME)
+ITKLIB = $(OUTDIR)\$(ITKNAMEPREFIX)$(VERSION)$(DBGX).lib
+
+ITKWISH = $(OUTDIR)\$(WISHNAMEPREFIX)$(VERSION)$(DBGX).exe
+DUMPEXTS = $(TMPDIR)\dumpexts.exe
+
+LIB_INSTALL_DIR = $(INSTALLDIR)\lib
+BIN_INSTALL_DIR = $(INSTALLDIR)\bin
+SCRIPT_INSTALL_DIR = $(INSTALLDIR)\lib\itk$(DOTVERSION)
+INCLUDE_INSTALL_DIR = $(INSTALLDIR)\include
+
+ITKWISHOBJS = \
+ $(TMPDIR)\winMain.obj \
+ $(TMPDIR)\tkConsole.obj
+
+ITKOBJS = \
+ $(TMPDIR)\itk_archetype.obj \
+ $(TMPDIR)\itk_cmds.obj \
+ $(TMPDIR)\itk_option.obj \
+ $(TMPDIR)\itk_util.obj \
+ $(TMPDIR)\dllEntryPoint.obj
+
+cc32 = $(TOOLS32)\bin\cl.exe
+link32 = $(TOOLS32)\bin\link.exe
+rc32 = $(TOOLS32_rc)\bin\rc.exe
+include32 = -I$(TOOLS32)\include
+
+WINDIR = $(ROOT)\win
+GENERICDIR = $(ROOT)\generic
+RCDIR = $(WINDIR)\rc
+
+TCLBUILDDIR = $(TCLDIR)\win\$(OUTDIR)
+TCLLIB = $(TCLBUILDDIR)\tcl80$(DBGX).lib
+TCLDLL = $(TCLBUILDDIR)\tcl80$(DBGX).dll
+TKBUILDDIR = $(TKDIR)\win\$(OUTDIR)
+TKLIB = $(TKBUILDDIR)\tk80$(DBGX).lib
+TKDLL = $(TKBUILDDIR)\tk80$(DBGX).dll
+ITCLBUILDDIR = $(ITCLDIR)\win\$(OUTDIR)
+ITCLLIB = $(ITCLBUILDDIR)\itcl$(VERSION)$(DBGX).lib
+ITCLDLL = $(ITCLBUILDDIR)\itcl$(VERSION)$(DBGX).dll
+
+ITK_INCLUDES = -I$(WINDIR) -I$(GENERICDIR) \
+ -I$(TCLDIR)\generic -I$(TKDIR)\generic -I$(TKDIR)\xlib -I$(ITCLDIR)\generic
+ITK_DEFINES = -DBUILD_itk $(DEBUGDEFINES)
+
+ITK_CFLAGS = $(cdebug) $(cflags) $(cvarsdll) $(include32) \
+ $(ITK_INCLUDES) $(ITK_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) -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
+######################################################################
+
+!IF "$(NODEBUG)" == "1"
+!IF "$(MACHINE)" == "ALPHA"
+# MSVC on Alpha doesn't understand -Ot
+cdebug = -O2i -Gs -GD
+!ELSE
+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 $(ITKWISH)
+test: setup $(ITKWISH)
+ -@copy $(TCLDLL) $(TMPDIR)
+ -@copy $(TKDLL) $(TMPDIR)
+ -@copy $(ITCLDLL) $(TMPDIR)
+ $(ITKWISH)
+
+setup:
+ if not exist $(TMPDIR) mkdir $(TMPDIR)
+ if not exist $(OUTDIR) mkdir $(OUTDIR)
+
+$(ITKLIB): $(ITKDLL)
+
+$(ITKDLL): $(ITKOBJS) $(TMPDIR)\itk.res $(TMPDIR)\itkvc.def
+ set LIB=$(TOOLS32)\lib
+ $(link32) $(ldebug) $(dlllflags) -def:$(TMPDIR)\itkvc.def \
+ -out:$@ $(TMPDIR)\itk.res $(TCLLIB) $(TKLIB) $(ITCLLIB) \
+ $(guilibsdll) @<<
+ $(ITKOBJS)
+<<
+
+$(ITKWISH): $(ITKWISHOBJS) $(ITKLIB) $(TMPDIR)\itkwish.res
+ set LIB=$(TOOLS32)\lib
+ $(link32) $(ldebug) $(guilflags) $(TMPDIR)\itkwish.res -out:$@ \
+ $(guilibsdll) $(TCLLIB) $(TKLIB) $(ITCLLIB) $(ITKLIB) $(ITKWISHOBJS)
+
+$(TMPDIR)\itkvc.def: $(DUMPEXTS) $(ITKOBJS)
+ $(DUMPEXTS) -o $@ $(ITKDLLNAME) @<<
+ $(ITKOBJS)
+<<
+
+$(DUMPEXTS): $(TCLDIR)\win\winDumpExts.c
+ $(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $?
+ set LIB=$(TOOLS32)\lib
+ $(link32) $(ldebug) $(conlflags) $(guilibs) -out:$@ \
+ $(TMPDIR)\winDumpExts.obj
+
+install: all
+ if not exist $(INSTALLDIR) mkdir $(INSTALLDIR)
+ if not exist $(BIN_INSTALL_DIR) mkdir $(BIN_INSTALL_DIR)
+ if not exist $(LIB_INSTALL_DIR) mkdir $(LIB_INSTALL_DIR)
+ if not exist $(SCRIPT_INSTALL_DIR) mkdir $(SCRIPT_INSTALL_DIR)
+ if not exist $(INCLUDE_INSTALL_DIR) mkdir $(INCLUDE_INSTALL_DIR)
+ copy $(ITKWISH) "$(BIN_INSTALL_DIR)"
+ copy $(ITKDLL) "$(BIN_INSTALL_DIR)"
+ copy $(ROOT)\generic\itk.h "$(INCLUDE_INSTALL_DIR)"
+ copy $(ROOT)\library\*.* "$(SCRIPT_INSTALL_DIR)"
+ copy $(ROOT)\win\*.tcl "$(SCRIPT_INSTALL_DIR)"
+
+#
+# Special case object file targets
+#
+
+$(TMPDIR)\winMain.obj: $(ROOT)\win\winMain.c
+ $(cc32) -DBUILD_tcl -DBUILD_tk $(ITK_CFLAGS) -Fo$@ $?
+
+$(TMPDIR)\tkConsole.obj: $(TKDIR)\generic\tkConsole.c
+ $(cc32) -DBUILD_tcl -DBUILD_tk $(ITK_CFLAGS) -Fo$@ $?
+
+#
+# Implicit rules
+#
+
+{$(GENERICDIR)}.c{$(TMPDIR)}.obj:
+ $(cc32) -DDLL_BUILD $(ITK_CFLAGS) -Fo$(TMPDIR)\ $<
+
+{$(WINDIR)}.c{$(TMPDIR)}.obj:
+ $(cc32) -DDLL_BUILD $(ITK_CFLAGS) -Fo$(TMPDIR)\ $<
+
+{$(ROOT)\unix}.c{$(TMPDIR)}.obj:
+ $(cc32) -DDLL_BUILD $(ITK_CFLAGS) -Fo$(TMPDIR)\ $<
+
+{$(RCDIR)}.rc{$(TMPDIR)}.res:
+ $(rc32) -fo $@ -r -i $(GENERICDIR) -i $(TCLDIR)\generic -i $(ITCLDIR)\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
+ -@rmdir $(OUTDIR)
+ -@rmdir $(TMPDIR)
diff --git a/itcl/itk/win/pkgIndex.tcl b/itcl/itk/win/pkgIndex.tcl
new file mode 100644
index 00000000000..e9eac5973a9
--- /dev/null
+++ b/itcl/itk/win/pkgIndex.tcl
@@ -0,0 +1,3 @@
+# Tcl package index file, version 1.0
+
+package ifneeded Itk 3.0 [list load itk30.dll Itk]
diff --git a/itcl/itk/win/rc/cursor00.cur b/itcl/itk/win/rc/cursor00.cur
new file mode 100644
index 00000000000..337e6d4e901
--- /dev/null
+++ b/itcl/itk/win/rc/cursor00.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor02.cur b/itcl/itk/win/rc/cursor02.cur
new file mode 100644
index 00000000000..fbc47749fd4
--- /dev/null
+++ b/itcl/itk/win/rc/cursor02.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor04.cur b/itcl/itk/win/rc/cursor04.cur
new file mode 100644
index 00000000000..9634c42f3b5
--- /dev/null
+++ b/itcl/itk/win/rc/cursor04.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor06.cur b/itcl/itk/win/rc/cursor06.cur
new file mode 100644
index 00000000000..f7188b22c2f
--- /dev/null
+++ b/itcl/itk/win/rc/cursor06.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor08.cur b/itcl/itk/win/rc/cursor08.cur
new file mode 100644
index 00000000000..d9f15f77562
--- /dev/null
+++ b/itcl/itk/win/rc/cursor08.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor0a.cur b/itcl/itk/win/rc/cursor0a.cur
new file mode 100644
index 00000000000..3f8ef45620a
--- /dev/null
+++ b/itcl/itk/win/rc/cursor0a.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor0c.cur b/itcl/itk/win/rc/cursor0c.cur
new file mode 100644
index 00000000000..1014eddca2e
--- /dev/null
+++ b/itcl/itk/win/rc/cursor0c.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor0e.cur b/itcl/itk/win/rc/cursor0e.cur
new file mode 100644
index 00000000000..964058d9ade
--- /dev/null
+++ b/itcl/itk/win/rc/cursor0e.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor10.cur b/itcl/itk/win/rc/cursor10.cur
new file mode 100644
index 00000000000..c4f78096f3b
--- /dev/null
+++ b/itcl/itk/win/rc/cursor10.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor12.cur b/itcl/itk/win/rc/cursor12.cur
new file mode 100644
index 00000000000..920c936ae04
--- /dev/null
+++ b/itcl/itk/win/rc/cursor12.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor14.cur b/itcl/itk/win/rc/cursor14.cur
new file mode 100644
index 00000000000..c7de122e01f
--- /dev/null
+++ b/itcl/itk/win/rc/cursor14.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor16.cur b/itcl/itk/win/rc/cursor16.cur
new file mode 100644
index 00000000000..cfc08f23f96
--- /dev/null
+++ b/itcl/itk/win/rc/cursor16.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor18.cur b/itcl/itk/win/rc/cursor18.cur
new file mode 100644
index 00000000000..95ed2ee9623
--- /dev/null
+++ b/itcl/itk/win/rc/cursor18.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor1a.cur b/itcl/itk/win/rc/cursor1a.cur
new file mode 100644
index 00000000000..ea51361200c
--- /dev/null
+++ b/itcl/itk/win/rc/cursor1a.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor1c.cur b/itcl/itk/win/rc/cursor1c.cur
new file mode 100644
index 00000000000..6f10bfbee82
--- /dev/null
+++ b/itcl/itk/win/rc/cursor1c.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor1e.cur b/itcl/itk/win/rc/cursor1e.cur
new file mode 100644
index 00000000000..49fa7f70ddb
--- /dev/null
+++ b/itcl/itk/win/rc/cursor1e.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor20.cur b/itcl/itk/win/rc/cursor20.cur
new file mode 100644
index 00000000000..cf177a16c4f
--- /dev/null
+++ b/itcl/itk/win/rc/cursor20.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor22.cur b/itcl/itk/win/rc/cursor22.cur
new file mode 100644
index 00000000000..2f8e91247f8
--- /dev/null
+++ b/itcl/itk/win/rc/cursor22.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor24.cur b/itcl/itk/win/rc/cursor24.cur
new file mode 100644
index 00000000000..87ba5b4db19
--- /dev/null
+++ b/itcl/itk/win/rc/cursor24.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor26.cur b/itcl/itk/win/rc/cursor26.cur
new file mode 100644
index 00000000000..0b2dbd2578e
--- /dev/null
+++ b/itcl/itk/win/rc/cursor26.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor28.cur b/itcl/itk/win/rc/cursor28.cur
new file mode 100644
index 00000000000..30550f95613
--- /dev/null
+++ b/itcl/itk/win/rc/cursor28.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor2a.cur b/itcl/itk/win/rc/cursor2a.cur
new file mode 100644
index 00000000000..13bdffd79ed
--- /dev/null
+++ b/itcl/itk/win/rc/cursor2a.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor2c.cur b/itcl/itk/win/rc/cursor2c.cur
new file mode 100644
index 00000000000..7be349469a3
--- /dev/null
+++ b/itcl/itk/win/rc/cursor2c.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor2e.cur b/itcl/itk/win/rc/cursor2e.cur
new file mode 100644
index 00000000000..7a0bc694bd1
--- /dev/null
+++ b/itcl/itk/win/rc/cursor2e.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor30.cur b/itcl/itk/win/rc/cursor30.cur
new file mode 100644
index 00000000000..70ef4fd23f8
--- /dev/null
+++ b/itcl/itk/win/rc/cursor30.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor32.cur b/itcl/itk/win/rc/cursor32.cur
new file mode 100644
index 00000000000..93b5c4759c2
--- /dev/null
+++ b/itcl/itk/win/rc/cursor32.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor34.cur b/itcl/itk/win/rc/cursor34.cur
new file mode 100644
index 00000000000..0fad3f1cfb3
--- /dev/null
+++ b/itcl/itk/win/rc/cursor34.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor36.cur b/itcl/itk/win/rc/cursor36.cur
new file mode 100644
index 00000000000..fc8d4f6d4e5
--- /dev/null
+++ b/itcl/itk/win/rc/cursor36.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor38.cur b/itcl/itk/win/rc/cursor38.cur
new file mode 100644
index 00000000000..4447d7d0bab
--- /dev/null
+++ b/itcl/itk/win/rc/cursor38.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor3a.cur b/itcl/itk/win/rc/cursor3a.cur
new file mode 100644
index 00000000000..8217856353f
--- /dev/null
+++ b/itcl/itk/win/rc/cursor3a.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor3c.cur b/itcl/itk/win/rc/cursor3c.cur
new file mode 100644
index 00000000000..6a3111d7fb6
--- /dev/null
+++ b/itcl/itk/win/rc/cursor3c.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor3e.cur b/itcl/itk/win/rc/cursor3e.cur
new file mode 100644
index 00000000000..fa6fe5b694b
--- /dev/null
+++ b/itcl/itk/win/rc/cursor3e.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor40.cur b/itcl/itk/win/rc/cursor40.cur
new file mode 100644
index 00000000000..f07bf4f5c47
--- /dev/null
+++ b/itcl/itk/win/rc/cursor40.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor42.cur b/itcl/itk/win/rc/cursor42.cur
new file mode 100644
index 00000000000..387d5f0bef9
--- /dev/null
+++ b/itcl/itk/win/rc/cursor42.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor44.cur b/itcl/itk/win/rc/cursor44.cur
new file mode 100644
index 00000000000..e8bdfd2639e
--- /dev/null
+++ b/itcl/itk/win/rc/cursor44.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor46.cur b/itcl/itk/win/rc/cursor46.cur
new file mode 100644
index 00000000000..3e97094d931
--- /dev/null
+++ b/itcl/itk/win/rc/cursor46.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor48.cur b/itcl/itk/win/rc/cursor48.cur
new file mode 100644
index 00000000000..2a5689731ed
--- /dev/null
+++ b/itcl/itk/win/rc/cursor48.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor4a.cur b/itcl/itk/win/rc/cursor4a.cur
new file mode 100644
index 00000000000..30febfa2d45
--- /dev/null
+++ b/itcl/itk/win/rc/cursor4a.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor4c.cur b/itcl/itk/win/rc/cursor4c.cur
new file mode 100644
index 00000000000..0407d77a21c
--- /dev/null
+++ b/itcl/itk/win/rc/cursor4c.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor4e.cur b/itcl/itk/win/rc/cursor4e.cur
new file mode 100644
index 00000000000..a58e3dba5e2
--- /dev/null
+++ b/itcl/itk/win/rc/cursor4e.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor50.cur b/itcl/itk/win/rc/cursor50.cur
new file mode 100644
index 00000000000..7352420db49
--- /dev/null
+++ b/itcl/itk/win/rc/cursor50.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor52.cur b/itcl/itk/win/rc/cursor52.cur
new file mode 100644
index 00000000000..435f99f46bb
--- /dev/null
+++ b/itcl/itk/win/rc/cursor52.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor54.cur b/itcl/itk/win/rc/cursor54.cur
new file mode 100644
index 00000000000..3c1c9208165
--- /dev/null
+++ b/itcl/itk/win/rc/cursor54.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor56.cur b/itcl/itk/win/rc/cursor56.cur
new file mode 100644
index 00000000000..2f3732ba615
--- /dev/null
+++ b/itcl/itk/win/rc/cursor56.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor58.cur b/itcl/itk/win/rc/cursor58.cur
new file mode 100644
index 00000000000..98b6a2fb592
--- /dev/null
+++ b/itcl/itk/win/rc/cursor58.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor5a.cur b/itcl/itk/win/rc/cursor5a.cur
new file mode 100644
index 00000000000..b00070e5c57
--- /dev/null
+++ b/itcl/itk/win/rc/cursor5a.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor5c.cur b/itcl/itk/win/rc/cursor5c.cur
new file mode 100644
index 00000000000..a407b55fb2d
--- /dev/null
+++ b/itcl/itk/win/rc/cursor5c.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor5e.cur b/itcl/itk/win/rc/cursor5e.cur
new file mode 100644
index 00000000000..ab3449f7a9d
--- /dev/null
+++ b/itcl/itk/win/rc/cursor5e.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor60.cur b/itcl/itk/win/rc/cursor60.cur
new file mode 100644
index 00000000000..847969d261c
--- /dev/null
+++ b/itcl/itk/win/rc/cursor60.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor62.cur b/itcl/itk/win/rc/cursor62.cur
new file mode 100644
index 00000000000..36404a50b00
--- /dev/null
+++ b/itcl/itk/win/rc/cursor62.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor64.cur b/itcl/itk/win/rc/cursor64.cur
new file mode 100644
index 00000000000..a6bdd0efc93
--- /dev/null
+++ b/itcl/itk/win/rc/cursor64.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor66.cur b/itcl/itk/win/rc/cursor66.cur
new file mode 100644
index 00000000000..81d53b42696
--- /dev/null
+++ b/itcl/itk/win/rc/cursor66.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor68.cur b/itcl/itk/win/rc/cursor68.cur
new file mode 100644
index 00000000000..27cfaf07796
--- /dev/null
+++ b/itcl/itk/win/rc/cursor68.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor6a.cur b/itcl/itk/win/rc/cursor6a.cur
new file mode 100644
index 00000000000..20f138e45d8
--- /dev/null
+++ b/itcl/itk/win/rc/cursor6a.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor6c.cur b/itcl/itk/win/rc/cursor6c.cur
new file mode 100644
index 00000000000..1e8d6d82e3f
--- /dev/null
+++ b/itcl/itk/win/rc/cursor6c.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor6e.cur b/itcl/itk/win/rc/cursor6e.cur
new file mode 100644
index 00000000000..3a9b6b0ff1e
--- /dev/null
+++ b/itcl/itk/win/rc/cursor6e.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor70.cur b/itcl/itk/win/rc/cursor70.cur
new file mode 100644
index 00000000000..e2d76732afc
--- /dev/null
+++ b/itcl/itk/win/rc/cursor70.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor72.cur b/itcl/itk/win/rc/cursor72.cur
new file mode 100644
index 00000000000..4994c6e7a26
--- /dev/null
+++ b/itcl/itk/win/rc/cursor72.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor74.cur b/itcl/itk/win/rc/cursor74.cur
new file mode 100644
index 00000000000..d5e43613d34
--- /dev/null
+++ b/itcl/itk/win/rc/cursor74.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor76.cur b/itcl/itk/win/rc/cursor76.cur
new file mode 100644
index 00000000000..ce6e3972403
--- /dev/null
+++ b/itcl/itk/win/rc/cursor76.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor78.cur b/itcl/itk/win/rc/cursor78.cur
new file mode 100644
index 00000000000..70e25dd1c67
--- /dev/null
+++ b/itcl/itk/win/rc/cursor78.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor7a.cur b/itcl/itk/win/rc/cursor7a.cur
new file mode 100644
index 00000000000..5ea95c4c674
--- /dev/null
+++ b/itcl/itk/win/rc/cursor7a.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor7c.cur b/itcl/itk/win/rc/cursor7c.cur
new file mode 100644
index 00000000000..4166eba8ac3
--- /dev/null
+++ b/itcl/itk/win/rc/cursor7c.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor7e.cur b/itcl/itk/win/rc/cursor7e.cur
new file mode 100644
index 00000000000..4b24e50885a
--- /dev/null
+++ b/itcl/itk/win/rc/cursor7e.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor80.cur b/itcl/itk/win/rc/cursor80.cur
new file mode 100644
index 00000000000..a3955a5f7e7
--- /dev/null
+++ b/itcl/itk/win/rc/cursor80.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor82.cur b/itcl/itk/win/rc/cursor82.cur
new file mode 100644
index 00000000000..984cfbaac8e
--- /dev/null
+++ b/itcl/itk/win/rc/cursor82.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor84.cur b/itcl/itk/win/rc/cursor84.cur
new file mode 100644
index 00000000000..cd6807ec40c
--- /dev/null
+++ b/itcl/itk/win/rc/cursor84.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor86.cur b/itcl/itk/win/rc/cursor86.cur
new file mode 100644
index 00000000000..2d38c0351f1
--- /dev/null
+++ b/itcl/itk/win/rc/cursor86.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor88.cur b/itcl/itk/win/rc/cursor88.cur
new file mode 100644
index 00000000000..62b80615f85
--- /dev/null
+++ b/itcl/itk/win/rc/cursor88.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor8a.cur b/itcl/itk/win/rc/cursor8a.cur
new file mode 100644
index 00000000000..6c5358d69a8
--- /dev/null
+++ b/itcl/itk/win/rc/cursor8a.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor8c.cur b/itcl/itk/win/rc/cursor8c.cur
new file mode 100644
index 00000000000..103010b645c
--- /dev/null
+++ b/itcl/itk/win/rc/cursor8c.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor8e.cur b/itcl/itk/win/rc/cursor8e.cur
new file mode 100644
index 00000000000..515f3187939
--- /dev/null
+++ b/itcl/itk/win/rc/cursor8e.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor90.cur b/itcl/itk/win/rc/cursor90.cur
new file mode 100644
index 00000000000..08731f8236a
--- /dev/null
+++ b/itcl/itk/win/rc/cursor90.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor92.cur b/itcl/itk/win/rc/cursor92.cur
new file mode 100644
index 00000000000..4364b5df1ce
--- /dev/null
+++ b/itcl/itk/win/rc/cursor92.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor94.cur b/itcl/itk/win/rc/cursor94.cur
new file mode 100644
index 00000000000..7777d5380a7
--- /dev/null
+++ b/itcl/itk/win/rc/cursor94.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor96.cur b/itcl/itk/win/rc/cursor96.cur
new file mode 100644
index 00000000000..cecaea39b5a
--- /dev/null
+++ b/itcl/itk/win/rc/cursor96.cur
Binary files differ
diff --git a/itcl/itk/win/rc/cursor98.cur b/itcl/itk/win/rc/cursor98.cur
new file mode 100644
index 00000000000..5cab68ebace
--- /dev/null
+++ b/itcl/itk/win/rc/cursor98.cur
Binary files differ
diff --git a/itcl/itk/win/rc/itk.ico b/itcl/itk/win/rc/itk.ico
new file mode 100644
index 00000000000..4887478ba8a
--- /dev/null
+++ b/itcl/itk/win/rc/itk.ico
Binary files differ
diff --git a/itcl/itk/win/rc/itk.rc b/itcl/itk/win/rc/itk.rc
new file mode 100644
index 00000000000..65cb79be4cf
--- /dev/null
+++ b/itcl/itk/win/rc/itk.rc
@@ -0,0 +1,126 @@
+// SCCS: @(#) tk.rc 1.17 96/09/12 16:22:08
+//
+// Version
+//
+
+#define RESOURCE_INCLUDED
+#include <itcl.h>
+#include <itk.h>
+
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION ITCL_MAJOR_VERSION,ITCL_MINOR_VERSION,ITCL_RELEASE_LEVEL,0
+ PRODUCTVERSION ITCL_MAJOR_VERSION,ITCL_MINOR_VERSION,ITCL_RELEASE_LEVEL,0
+ FILEFLAGSMASK 0x3fL
+ FILEFLAGS 0x0L
+ FILEOS 0x4L
+ FILETYPE 0x2L
+ FILESUBTYPE 0x0L
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904b0"
+ BEGIN
+ VALUE "FileDescription", "Itk DLL\0"
+ VALUE "Authors", "Michael McLennan\0"
+
+ VALUE "OriginalFilename", "itk" STRINGIFY(ITCL_MAJOR_VERSION) STRINGIFY(ITCL_MINOR_VERSION) ".dll\0"
+ VALUE "CompanyName", "Bell Labs Innovations for Lucent Technologies\0"
+ VALUE "FileVersion", ITCL_PATCH_LEVEL
+ VALUE "LegalCopyright", "Copyright \251 1993-1998\0"
+ VALUE "ProductName", "[incr Tk] " ITCL_VERSION " for Windows\0"
+ VALUE "ProductVersion", ITCL_PATCH_LEVEL
+ END
+ END
+ BLOCK "VarFileInfo"
+ BEGIN
+ VALUE "Translation", 0x409, 1200
+ END
+END
+
+//
+// Icon
+//
+
+tk ICON DISCARDABLE "itk.ico"
+
+//
+// Cursor
+//
+
+X_cursor CURSOR DISCARDABLE "cursor00.cur"
+arrow CURSOR DISCARDABLE "cursor02.cur"
+based_arrow_down CURSOR DISCARDABLE "cursor04.cur"
+based_arrow_up CURSOR DISCARDABLE "cursor06.cur"
+boat CURSOR DISCARDABLE "cursor08.cur"
+bogosity CURSOR DISCARDABLE "cursor0a.cur"
+bottom_left_corner CURSOR DISCARDABLE "cursor0c.cur"
+bottom_right_corner CURSOR DISCARDABLE "cursor0e.cur"
+bottom_side CURSOR DISCARDABLE "cursor10.cur"
+bottom_tee CURSOR DISCARDABLE "cursor12.cur"
+box_spiral CURSOR DISCARDABLE "cursor14.cur"
+center_ptr CURSOR DISCARDABLE "cursor16.cur"
+circle CURSOR DISCARDABLE "cursor18.cur"
+clock CURSOR DISCARDABLE "cursor1a.cur"
+coffee_mug CURSOR DISCARDABLE "cursor1c.cur"
+cross CURSOR DISCARDABLE "cursor1e.cur"
+cross_reverse CURSOR DISCARDABLE "cursor20.cur"
+crosshair CURSOR DISCARDABLE "cursor22.cur"
+diamond_cross CURSOR DISCARDABLE "cursor24.cur"
+dot CURSOR DISCARDABLE "cursor26.cur"
+dotbox CURSOR DISCARDABLE "cursor28.cur"
+double_arrow CURSOR DISCARDABLE "cursor2a.cur"
+draft_large CURSOR DISCARDABLE "cursor2c.cur"
+draft_small CURSOR DISCARDABLE "cursor2e.cur"
+draped_box CURSOR DISCARDABLE "cursor30.cur"
+exchange CURSOR DISCARDABLE "cursor32.cur"
+fleur CURSOR DISCARDABLE "cursor34.cur"
+gobbler CURSOR DISCARDABLE "cursor36.cur"
+gumby CURSOR DISCARDABLE "cursor38.cur"
+hand1 CURSOR DISCARDABLE "cursor3a.cur"
+hand2 CURSOR DISCARDABLE "cursor3c.cur"
+heart CURSOR DISCARDABLE "cursor3e.cur"
+icon CURSOR DISCARDABLE "cursor40.cur"
+iron_cross CURSOR DISCARDABLE "cursor42.cur"
+left_ptr CURSOR DISCARDABLE "cursor44.cur"
+left_side CURSOR DISCARDABLE "cursor46.cur"
+left_tee CURSOR DISCARDABLE "cursor48.cur"
+leftbutton CURSOR DISCARDABLE "cursor4a.cur"
+ll_angle CURSOR DISCARDABLE "cursor4c.cur"
+lr_angle CURSOR DISCARDABLE "cursor4e.cur"
+man CURSOR DISCARDABLE "cursor50.cur"
+middlebutton CURSOR DISCARDABLE "cursor52.cur"
+mouse CURSOR DISCARDABLE "cursor54.cur"
+pencil CURSOR DISCARDABLE "cursor56.cur"
+pirate CURSOR DISCARDABLE "cursor58.cur"
+plus CURSOR DISCARDABLE "cursor5a.cur"
+question_arrow CURSOR DISCARDABLE "cursor5c.cur"
+right_ptr CURSOR DISCARDABLE "cursor5e.cur"
+right_side CURSOR DISCARDABLE "cursor60.cur"
+right_tee CURSOR DISCARDABLE "cursor62.cur"
+rightbutton CURSOR DISCARDABLE "cursor64.cur"
+rtl_logo CURSOR DISCARDABLE "cursor66.cur"
+sailboat CURSOR DISCARDABLE "cursor68.cur"
+sb_down_arrow CURSOR DISCARDABLE "cursor6a.cur"
+sb_h_double_arrow CURSOR DISCARDABLE "cursor6c.cur"
+sb_left_arrow CURSOR DISCARDABLE "cursor6e.cur"
+sb_right_arrow CURSOR DISCARDABLE "cursor70.cur"
+sb_up_arrow CURSOR DISCARDABLE "cursor72.cur"
+sb_v_double_arrow CURSOR DISCARDABLE "cursor74.cur"
+shuttle CURSOR DISCARDABLE "cursor76.cur"
+sizing CURSOR DISCARDABLE "cursor78.cur"
+spider CURSOR DISCARDABLE "cursor7a.cur"
+spraycan CURSOR DISCARDABLE "cursor7c.cur"
+star CURSOR DISCARDABLE "cursor7e.cur"
+target CURSOR DISCARDABLE "cursor80.cur"
+tcross CURSOR DISCARDABLE "cursor82.cur"
+top_left_arrow CURSOR DISCARDABLE "cursor84.cur"
+top_left_corner CURSOR DISCARDABLE "cursor86.cur"
+top_right_corner CURSOR DISCARDABLE "cursor88.cur"
+top_side CURSOR DISCARDABLE "cursor8a.cur"
+top_tee CURSOR DISCARDABLE "cursor8c.cur"
+trek CURSOR DISCARDABLE "cursor8e.cur"
+ul_angle CURSOR DISCARDABLE "cursor90.cur"
+umbrella CURSOR DISCARDABLE "cursor92.cur"
+ur_angle CURSOR DISCARDABLE "cursor94.cur"
+watch CURSOR DISCARDABLE "cursor96.cur"
+xterm CURSOR DISCARDABLE "cursor98.cur"
diff --git a/itcl/itk/win/rc/itkwish.rc b/itcl/itk/win/rc/itkwish.rc
new file mode 100644
index 00000000000..88b91e08186
--- /dev/null
+++ b/itcl/itk/win/rc/itkwish.rc
@@ -0,0 +1,43 @@
+// SCCS: @(#) wish.rc 1.13 96/09/12 16:22:14
+//
+// Version
+//
+
+#define RESOURCE_INCLUDED
+#include <itcl.h>
+#include <itk.h>
+
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION ITCL_MAJOR_VERSION,ITCL_MINOR_VERSION,ITCL_RELEASE_LEVEL,0
+ PRODUCTVERSION ITCL_MAJOR_VERSION,ITCL_MINOR_VERSION,ITCL_RELEASE_LEVEL,0
+ FILEFLAGSMASK 0x3fL
+ FILEFLAGS 0x0L
+ FILEOS 0x4L
+ FILETYPE 0x1L
+ FILESUBTYPE 0x0L
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904b0"
+ BEGIN
+ VALUE "FileDescription", "[incr Tk] Object-Oriented Wish Application\0"
+ VALUE "Authors", "Michael McLennan\0"
+ VALUE "OriginalFilename", "itkwish.exe\0"
+ VALUE "CompanyName", "Bell Labs Innovations for Lucent Technologies\0"
+ VALUE "FileVersion", ITCL_PATCH_LEVEL
+ VALUE "LegalCopyright", "Copyright \251 1993-1998\0"
+ VALUE "ProductName", "[incr Tk] " ITCL_VERSION " for Windows\0"
+ VALUE "ProductVersion", ITCL_PATCH_LEVEL
+ END
+ END
+ BLOCK "VarFileInfo"
+ BEGIN
+ VALUE "Translation", 0x409, 1200
+ END
+END
+
+//
+// Icon
+//
+
+wish ICON DISCARDABLE "itk.ico"
diff --git a/itcl/itk/win/winMain.c b/itcl/itk/win/winMain.c
new file mode 100644
index 00000000000..bcd32cba6b3
--- /dev/null
+++ b/itcl/itk/win/winMain.c
@@ -0,0 +1,354 @@
+/*
+ * 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>
+
+#include "itk.h"
+
+/* include tclInt.h for access to namespace API */
+#include "tclInt.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.
+ *
+ * Results:
+ * Returns false if initialization fails, otherwise it never
+ * returns.
+ *
+ * Side effects:
+ * Just about anything, since from here we call arbitrary Tcl code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppInit(interp)
+ Tcl_Interp *interp; /* Interpreter for application. */
+{
+ if (Tcl_Init(interp) == TCL_ERROR) {
+ goto error;
+ }
+ if (Tk_Init(interp) == TCL_ERROR) {
+ goto error;
+ }
+ Tcl_StaticPackage(interp, "Tk", Tk_Init, Tk_SafeInit);
+
+ if (Itcl_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (Itk_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Itcl", Itcl_Init, Itcl_SafeInit);
+ Tcl_StaticPackage(interp, "Itk", Itk_Init, (Tcl_PackageInitProc *) NULL);
+
+ /*
+ * This is itkwish, so import all [incr Tcl] commands by
+ * default into the global namespace. Fix up the autoloader
+ * to do the same.
+ */
+ if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
+ "::itk::*", /* allowOverwrite */ 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_Import(interp, Tcl_GetGlobalNamespace(interp),
+ "::itcl::*", /* allowOverwrite */ 1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_Eval(interp, "auto_mkindex_parser::slavehook { _%@namespace import -force ::itcl::* ::itk::* }") != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * 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", "~/itkwishrc.tcl", TCL_GLOBAL_ONLY);
+ return TCL_OK;
+
+error:
+ WishPanic(interp->result);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WishPanic --
+ *
+ * Display a message and exit.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Exits the program.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+WishPanic TCL_VARARGS_DEF(char *,arg1)
+{
+ va_list argList;
+ char buf[1024];
+ char *format;
+
+ 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 --
+ *
+ * Parse the Windows command line string into argc/argv. Done here
+ * because we don't trust the builtin argument parser in crt0.
+ * Windows applications are responsible for breaking their command
+ * line into arguments.
+ *
+ * 2N backslashes + quote -> N backslashes + begin quoted string
+ * 2N + 1 backslashes + quote -> literal
+ * N backslashes + non-quote -> literal
+ * quote + quote in a quoted string -> single quote
+ * quote + quote not in quoted string -> empty string
+ * quote -> begin quoted string
+ *
+ * Results:
+ * Fills argcPtr with the number of arguments and argvPtr with the
+ * array of arguments.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *--------------------------------------------------------------------------
+ */
+
+static void
+setargv(argcPtr, argvPtr)
+ 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;
+ slashes = 0;
+ while (1) {
+ copy = 1;
+ while (*p == '\\') {
+ slashes++;
+ p++;
+ }
+ if (*p == '"') {
+ if ((slashes & 1) == 0) {
+ copy = 0;
+ if ((inquote) && (p[1] == '"')) {
+ p++;
+ copy = 1;
+ } else {
+ inquote = !inquote;
+ }
+ }
+ slashes >>= 1;
+ }
+
+ 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;
+}
+
diff --git a/itcl/iwidgets3.0.0/CHANGES b/itcl/iwidgets3.0.0/CHANGES
new file mode 100644
index 00000000000..7356fe253cd
--- /dev/null
+++ b/itcl/iwidgets3.0.0/CHANGES
@@ -0,0 +1,1508 @@
+[incr Widgets] CHANGE LOG
+
+==========================================================================
+ -------------------------- iwidgets-3.0.0 ------------------------------
+ -------------------- CHANGES FROM iwidgets-2.2.0 -----------------------
+==========================================================================
+
+ [incr Widgets] version 3.0.0 is compatable with itcl3.0
+
+ [incr Widgets] has undergone a major overhaul between the last version
+and 3.0.0. Since so many changes have taken place it made more since to
+list them by widget class name rather than the old style of new features
+and bug fixes. The majority of the changes are under the covers and will
+have minimal impact of existing scripts, but there are a few that may
+bite you. To locate possible incompatabilities, just search this file
+for the key words "POSSIBLE INCOMPATIBILITY".
+
+ In addition, quite a few new widgets have been added to the set. They
+include the following:
+
+ Calendar
+ Checkbox
+ Dateentry
+ Datefield
+ Disjointlistbox
+ Extfileselectionbox
+ Extfileselectiondialog
+ Finddialog
+ Hierarchy
+ Labeledframe
+ Mainwindow
+ Messagebox
+ Scrolledwidget
+ Timeentry
+ Timefield
+ Watch
+
+ Thanx to the following contributors who have been kind enough to help
+me support this effort through enhancements, bug fixes, and new widgets.
+
+ John Tucker jatucker@austin.dsccc.com
+ Mitch Gorman emrys@net-gate.com
+ John Reekie johnr@EECS.Berkeley.EDU
+ Alfredo Jahn ajahn@spd.dsccc.com
+ Michael McLennan mmclennan@lucent.com
+
+
+Labeledwidget
+______________________________________________________________________________
+
+>> Reimplemented geometry management using the grid instead of the packer.
+
+>> Changed component option basis to be that of the "usuals".
+
+>> Removed a redundant frame component named "shell" just below the hull.
+
+>> Corrected labelvariable bug. Setting the labelvariable had no effect.
+ The code has been corrected such that a trace is installed on the variable
+ which forces an update of the label text upon writes to the variable.
+
+>> Removed the labmargin frame component used for implementing a margin.
+ This is now accomplished via the grid by maintaining an empty row/column
+ for the margin and adjusting its minsize.
+
+>> POSSIBLE INCOMPATIBILITY - The childsite is now a protected component.
+ If you need access to it, use the childsite command.
+
+>> Added new label position orientation settings. The current label
+ positions are nw, n, ne, sw, s, se, en, e, es, wn, w, and ws.
+
+>> Updated the test script and man page.
+
+
+Scrolledlistbox
+______________________________________________________________________________
+
+>> Derived from the Scrolledwidget class which provides the vertical
+ and horizontal scrollbars along with the options to control their
+ display.
+
+>> Reimplemented geometry management using the grid instead of the packer.
+
+>> Changed component option basis to be that of the "usuals".
+
+>> Added a -state option that allows you to disable the listbox. Selection
+ is blocked. The foreground of the scrolledlistbox label is changed
+ to disbabledforeground.
+
+>> Fixed the infinite looping problem which would occur with -hscrollmode
+ set to dynamic and a really long line added just out of the view port.
+ As you'd scroll down the horizontal scrollbar bar would start flashing
+ on and off.
+
+>> Removed the margin frame components used for implementing a margin
+ between the listbox and scrollbars. This is now accomplished via
+ the grid by maintaining an empty row/column for the margin and
+ adjusting its minsize.
+
+>> POSSIBLE INCOMPATIBILITY - Removed -items option. This was originally
+ put in as a convienence, but it turns out to be quite costly in terms
+ of performance. It had to go. The insert/delete/get commands can be
+ used instead which is much more in line with Tk.
+
+>> Updated the test script, demo, and man page.
+
+
+Entryfield
+______________________________________________________________________________
+
+>> Reimplemented geometry management using the grid instead of the packer.
+
+>> Modified the real type validation to except exponents. Patch provided
+ by evans@engineous.com (Rick Evans).
+
+>> The -state option changes the label to disabledforeground when the
+ entryfield is disabled.
+
+>> Changed component option basis to be that of the "usuals".
+
+
+Pushbutton
+______________________________________________________________________________
+
+>> Changed component option basis to be that of the "usuals".
+
+>> POSSIBLE INCOMPATABILITY - The pushButton component has been changed
+ to pushbutton.
+
+>> POSSIBLE INCOMPATABILITY - The following options have been removed
+ and are not directly available in the pushbutton anymore:
+ -anchor -justify -textvariable
+
+ The underlying button component still maintains them , but not the
+ pushbutton itself. You can still set them via the component
+ command, i.e. ".pb component pushButton configure -justify left"
+
+
+Buttonbox
+______________________________________________________________________________
+
+>> Changed component option basis to be that of the "usuals".
+
+
+Shell
+______________________________________________________________________________
+
+>> Changed component option basis to be that of the "usuals".
+
+>> Added a -width and -height option. A value of zero causes the width
+ and/or height to be adjusted to the required value based on the size
+ requests of the components placed in the childsite. Otherwise, the
+ width and/or height is fixed. The default is zero.
+
+>> Added -width and -height tests to the test script and updated the
+ man page.
+
+>> The activate method no longer returns an error if it is called when
+ the shell is already active. Instead, the shell is just raised.
+
+
+Dialogshell
+______________________________________________________________________________
+
+>> Reimplemented geometry management using the grid instead of the packer.
+
+>> Changed component option basis to be that of the "usuals".
+
+>> Updated the test script and man page, adding the -width and -height
+ options that are inherited from the shell.
+
+
+Dialog
+______________________________________________________________________________
+
+>> Updated the test script and man page, adding the -width and -height
+ options that are inherited from the shell.
+
+
+Selectionbox
+______________________________________________________________________________
+
+>> Reimplemented geometry management using the grid instead of the packer.
+
+>> Changed component option basis to be that of the "usuals".
+
+>> Modified the insert and delete methods to use the items insert and
+ delete method rather than configuring the -items option which has
+ been removed from the underlying scrolledlistbox.
+
+>> Removed the margin frame component used for implementing a margin
+ between the items and selection. This is now accomplished via
+ the grid by maintaining an empty row for the margin and adjusting
+ its minsize.
+
+>> Removed the unecessary frame that was used to contrain the width
+ and height of the widget. This is now performed directly on the
+ widget hull.
+
+>> POSSIBLE INCOMPATABILITY - The following options have been removed
+ and are not directly available in the selectionbox anymore:
+ -hscrollmode -itemslabelpos -labelmargin -margin -relief
+ -sbwidth -scrollmargin -selectionlabelpos -vscrollmode
+
+ The underlying components still maintain them, but not the
+ selectionbox itself. You can still set them via the component
+ command, i.e. ".sb component selection configure -labelpos nw" or
+ ".sb component items configure -hscrollmode static"
+
+>> Added a -width and -height option. A value of zero causes the width
+ and/or height to be adjusted to the required value based on the size
+ requests of the components placed in the childsite. Otherwise, the
+ width and/or height is fixed. The default is zero.
+
+>> Updated the test script, demo, and man page.
+
+
+Selectiondialog
+______________________________________________________________________________
+
+>> Pack propagation is now handled by the shell class.
+
+>> Modified the insert and delete methods to use the insert and
+ delete method rather than configuring the -items option which has
+ been removed from the underlying scrolledlistbox.
+
+>> Changed component option basis to be that of the "usuals".
+
+>> POSSIBLE INCOMPATABILITY - The "sb" component has been renamed to be
+ "selectionbox". This is much more descriptive.
+
+>> POSSIBLE INCOMPATABILITY - The following options have been removed
+ and are not directly available in the selectiondialog anymore:
+ -hscrollmode -itemslabelpos -labelmargin -margin -relief
+ -sbwidth -scrollmargin -selectionlabelpos -vscrollmode
+
+ The underlying components still maintain them, but not the
+ selectiondialog itself. You can still set them via the component
+ command, i.e. ".sd component selectionbox configure -margin 10" or
+ ".sd component selectionbox component items configure -hscrollmode static"
+
+>> The -width and -height options are now controlled by the shell class.
+ A value of zero causes the width and/or height to be adjusted to the
+ required value based on the size requests of the components. Otherwise,
+ the width and/or height is fixed. The default is zero.
+
+
+Scrolledtext
+______________________________________________________________________________
+
+>> Derived from the Scrolledwidget class which provides the vertical
+ and horizontal scrollbars along with the options to control their
+ display.
+
+>> Reimplemented geometry management using the grid instead of the packer,
+ eliminating quite a few unneeded frames along the way.
+
+>> Changed component option basis to be that of the "usuals".
+
+>> Removed the margin frame components used for implementing a margin
+ between the text and scrollbars. This is now accomplished via
+ the grid by maintaining an empty row/column for the margin and
+ adjusting its minsize.
+
+>> The -state option changes the label to disabledforeground when the
+ scrolledtext is disabled.
+
+>> Fixed the infinite looping problem which would occur with -wrap set
+ to none, -hscrollmode set to dynamic and a really long line added
+ just out of the view port. As you'd scroll down the horizontal
+ scrollbar bar would start flashing on and off.
+
+>> Added an index argument to the import method so a file can be
+ imported into the text area at positions other than just the end.
+
+>> Updated the test script and man page.
+
+
+Feedback
+______________________________________________________________________________
+
+>> Corrected namspace problem by removing global scope qualifier from
+ class definition as well as method and option bodies. Bug report
+ and patch provided by evans@engineous.com (Rick Evans).
+
+
+Hyperhelp
+______________________________________________________________________________
+
+>> Corrected namspace problem by removing global scope qualifier from
+ class definition as well as method and option bodies. Bug report
+ provided by evans@engineous.com (Rick Evans).
+
+
+Scrolledhtml
+______________________________________________________________________________
+
+>> Corrected namspace problem by removing global scope qualifier from
+ class definition as well as method and option bodies. Bug report
+ provided by evans@engineous.com (Rick Evans).
+
+
+Canvasprintbox
+______________________________________________________________________________
+
+>> Added tcl_platform to list of global variables declared in print
+ method. Bug report provided by evans@engineous.com (Rick Evans).
+
+
+Scrolledcanvas
+______________________________________________________________________________
+
+>> Derived from the Scrolledwidget class which provides the vertical
+ and horizontal scrollbars along with the options to control their
+ display.
+
+>> POSSIBLE INCOMPATIBILITY - The ScrCanvas component has been renamed
+ canvas.
+
+>> The -state option changes the label to disabledforeground when the
+ scrolledcanvas is disabled.
+
+>> Reimplemented geometry management using the grid instead of the packer.
+
+>> Changed component option basis to be that of the "usuals".
+
+>> Removed the margin frame components used for implementing a margin
+ between the canvas and scrollbars. This is now accomplished via
+ the grid by maintaining an empty row/column for the margin and
+ adjusting its minsize.
+
+>> Updated the test script, demo, and man page.
+
+
+Scrolledframe
+______________________________________________________________________________
+
+>> Derived from the Scrolledwidget class which provides the vertical
+ and horizontal scrollbars along with the options to control their
+ display.
+
+>> POSSIBLE INCOMPATIBILITY - The childsite is now a protected component.
+ If you need access to it, use the childsite command.
+
+>> POSSIBLE INCOMPATIBILITY - The scrCanvas component has been renamed
+ canvas and the scrFrame component to sfchildsite.
+
+>> Reimplemented geometry management using the grid instead of the packer.
+
+>> Changed component option basis to be that of the "usuals".
+
+>> Fixed the infinite looping problem which would occur with -hscrollmode
+ set to dynamic and a really long component added just out of the view
+ port. As you'd scroll down the horizontal scrollbar bar would start
+ flashing on and off.
+
+>> Removed the margin frame components used for implementing a margin
+ between the canvas and scrollbars. This is now accomplished via
+ the grid by maintaining an empty row/column for the margin and
+ adjusting its minsize.
+
+>> Updated the test script, demo, and man page.
+
+
+Promptdialog
+______________________________________________________________________________
+
+>> Changed component option basis to be that of the "usuals".
+
+>> POSSIBLE INCOMPATABILITY - Renamed the "ef" component to "prompt".
+
+>> POSSIBLE INCOMPATABILITY - The following options have been removed
+ and are not directly available in the promptdialog anymore:
+ -fixed -justify -labelbitmap -labelimage -labelmargin
+ -state -textvariable -width
+
+ The underlying components still maintain them, but not the
+ promptdialog itself. You can still set them via the component
+ command, i.e. ".pd component prompt configure -labelpos w"
+
+>> Updated the test script, demo, and man page.
+
+
+Messagedialog
+______________________________________________________________________________
+
+>> Changed component option basis to be that of the "usuals".
+
+>> POSSIBLE INCOMPATABILITY - Renamed the "msg" component to "message".
+
+>> POSSIBLE INCOMPATABILITY - The following options have been removed
+ and are not directly available in the messagedialog anymore:
+ -anchor -justify -wraplength
+
+ The underlying components still maintain them, but not the
+ messagedialog itself. You can still set them via the component
+ command, i.e. ".md component message configure -justify left"
+
+>> Reimplemented geometry management using the grid instead of the packer.
+
+>> Updated the test script, demo, and man page.
+
+
+Hierarchy
+______________________________________________________________________________
+
+>> New iwidgets hierarchical data viewer mega-widget which manages a list
+ of nodes that can be expanded or collapsed. Individual nodes can be
+ highlighted. Clicking with the right mouse button on any item brings
+ up a special item menu. Clicking on the background area brings up
+ a different popup menu.
+
+>> Many thanks to Michael McLennan who provided the nucleus of this code.
+
+>> Man page, test script, and demo have been produced.
+
+>> The catalog demo has been updated to include the hierarchy demo.
+
+
+Checkbox
+______________________________________________________________________________
+
+>> New iwidget checkbox mega-widget which manages a group of check
+ buttons quite similar to that of the existing radiobox.
+
+>> Thanks to John Tucker for the contributed code.
+
+>> Man page, test script, and demo have been produced.
+
+>> The catalog demo has been updated to include the checkbox demo.
+
+
+Radiobox
+______________________________________________________________________________
+
+>> Changed component option basis to be that of the "usuals".
+
+>> Changed the base class to be labeledframe.
+
+>> Updated the test script, demo, and man page.
+
+
+Spinner
+______________________________________________________________________________
+
+>> Reimplemented geometry management using the grid instead of the packer.
+
+>> Removed a redundant frame component named "arrowFrame".
+
+>> Removed the use of the option database to set the option values.
+
+
+Spinint
+______________________________________________________________________________
+
+>> Removed the use of the option database to set the option values.
+
+
+Datefield
+______________________________________________________________________________
+
+>> New iwidget. The datefield is a smart date entry field with adjustable
+ built-in intelligence levels. It can be made smart enough not to accept
+ any bad dates or made dumb enough to accept any old thing typed. Since
+ it is derived from the labeledwidget, it also includes an optional label.
+
+>> Man page, test script, and demo have been produced.
+
+>> The catalog demo has been updated to include the datefield demo.
+
+
+Calendar
+______________________________________________________________________________
+
+>> New iwidget. The calendar widget provide for the selection and/or
+ display of dates. It displays a single month at a time. Buttons exist
+ on the top to change the month in effect turning th pages of a calendar.
+ As a page is turned, the dates for the month are modified. Selection
+ of a date visually marks that date. The selected value can be monitored
+ via the -command option or just retrieved using the get method. Methods
+ also exist to select a date and show a particular month.
+
+ The option set allows the calendars appearance to take on many forms.
+ For example, the background of the weekdays and weekends can be
+ independently changed, the starting day of the week can be set to
+ any of the days, the titles and fonts of everything is configurable,
+ and an outline can be displayed around the each day.
+
+>> Many thanks to Michael McLennan who provided me a early copy of his
+ book which gave me the example on which this code is based.
+
+>> Man page, test script, and demo have been produced.
+
+>> The catalog demo has been updated to include the calendar demo.
+
+
+Dateentry
+______________________________________________________________________________
+
+>> New iwidget. Dateentry is a quicken style date entry field with a
+ popup calendar produced by combining the datefield and calendar widgets
+ together. This allows a user to enter the date via the keyboard or by
+ using the mouse by selecting the calendar icon which brings up a popup
+ calendar. Since it is based on both the datefield and calendar, both
+ option sets exists under the same roof in the dateentry.
+
+>> Man page, test script, and demo have been produced.
+
+>> The catalog demo has been updated to include the dateentry demo.
+
+
+Messagebox
+______________________________________________________________________________
+
+>> New iwidget. Implements an information messages area widget with
+ scrollbars. Message types can be user defined and configured. Their
+ options include foreground, background, font, bell, and their display
+ mode of on or off. This allows message types to defined as needed,
+ removed when no longer so, and modified when necessary.
+
+ The number of lines that can be displayed may be limited. When this
+ limit is reached, the oldest line is removed. There is also support
+ for saving the contents to a file, using the standard file selection
+ dialog.
+
+>> Many thanks to Alfredo Jahn who came up with idea and provided me a
+ very stable working version which I extended to support user defined
+ message types.
+
+>> Man page, test script, and demo have been produced.
+
+>> The catalog demo has been updated to include the messagebox demo.
+
+
+Spintime
+______________________________________________________________________________
+
+>> Reimplemented geometry management using the grid instead of the packer.
+
+>> Removed the margin frame component used for implementing a margin
+ between the hour, minute and second components. This is now accomplished
+ via the grid by maintaining an empty row for the margin and adjusting
+ its minsize.
+
+>> POSSIBLE INCOMPATIBILITY - The delete, clear, and insert methods have
+ been removed. Use the show method to set the time.
+
+>> POSSIBLE INCOMPATIBILITY - The get method has been changed such that
+ it returns the time as either a colon separated string or a clock clicks
+ value.
+
+>> Added a show method to be used to set the time. The method takes as
+ an argument either a valid time string, a clock clicks value, or the
+ keyword now.
+
+>> The current time will now appear as the default.
+
+>> Updated the test script, demo, and man page.
+
+
+Spindate
+______________________________________________________________________________
+
+>> Reimplemented geometry management using the grid instead of the packer.
+
+>> Removed the margin frame component used for implementing a margin
+ between the month, day and year components. This is now accomplished
+ via the grid by maintaining an empty row for the margin and adjusting
+ its minsize.
+
+>> Spindate now uses the clock command during the spinning of the date
+ components. Only valid dates are spun now.
+
+>> POSSIBLE INCOMPATIBILITY - Changed the -monthformat option to be
+ string, brief, and full doing away with the optional user specified list.
+
+>> POSSIBLE INCOMPATIBILITY - The delete, clear, and insert methods have
+ been removed. Use the show method to set the date.
+
+>> POSSIBLE INCOMPATIBILITY - The get method has been changed such that
+ it returns the date as either a string or a clock clicks value.
+
+>> Added a show method to be used to set the time. The method takes as
+ an argument either a valid time string, a clock clicks value, or the
+ keyword now.
+
+>> The current date will now appear as the default.
+
+>> Selection and keyboard entry of values has been disabled. The value
+ may only be changed via the spinners which insures correct operation.
+
+>> Updated the test script, demo, and man page..
+
+
+Feedback
+______________________________________________________________________________
+
+>> Reimplemented geometry management using the grid instead of the packer.
+
+>> Made all the itk_components public.
+
+>> Added a trough which appears beneath the feedback widget. It has a
+ -troughcolor option to set its color.
+
+
+Scrolledhtml
+______________________________________________________________________________
+
+>> Added -alink (same as -linkhighlight, but matches html naming) and -update
+ options.
+
+>> Added new tags to come up to html3.2:
+ basefont
+ div
+ font
+ table
+ td
+ th
+ tr
+
+>> Added numbering formats for <li> tag.
+
+>> Fixed to delete images after page is cleared.
+
+>> Fixed to bring anchor points to middle when moving down to a nearby
+ anchor point.
+
+>> Fixes to regular expression matches.
+
+>> Performance enhancements with stack algorithm and regular expression
+ searches.
+
+
+Hyperhelp
+______________________________________________________________________________
+
+>> Added -closecmd and -maxhistory options.
+
+>> Made itk_components public/private (which could conceivably break
+ someone, if they were using a component directly that is now private)
+
+>> Fixed bindings.
+
+
+Toolbar
+______________________________________________________________________________
+
+>> Added a destructor to cancel the possibly pending after command request
+ to display the popup help.
+
+>> Corrected the vertical packing such that items are expanded horizontally.
+
+
+Finddialog
+______________________________________________________________________________
+
+>> New iwidget. Finddialog works in conjunction with a text or
+ scrolledtext widget to provide a means of performing search operations.
+ The user is prompted for a text pattern to be found in the text or
+ scrolledtext widget. The search can be for all occurances, by regular
+ expression, considerate of the case, or backwards.
+
+>> Man page, test script, and demo have been produced.
+
+>> The catalog demo has been updated to include the finddialog demo.
+
+
+Panedwindow
+______________________________________________________________________________
+
+>> Corrected show/hide bug which caused the placement of the sash and
+ separator to be incorrect. If you added a couple of panes and then
+ hid them all of them followed by showing them, the sash distribution
+ was wrong.
+
+>> Corrected a divide by zero problem which occurred when you hid all
+ of the panes.
+
+
+Combobox
+______________________________________________________________________________
+
+>> Mitch Gorman (emrys@net-gate.com) has taken over maintenance of the
+ combobox from John Sigler.
+
+>> Entry completion has been added. Should your typing in the entry
+ field match an item in the list, it is completed for you automatically.
+ This feature is switchable via the -completion option. The default
+ is on.
+
+>> It now utilizes a true button for the arrowBtn component.
+
+>> The -state option has been fixed such that it can be truly disabled.
+
+>> Reimplemented geometry management using the grid instead of the packer.
+
+>> A -grab option has been added to do both local and global grabs
+ of the drop-down listbox.
+
+>> POSSIBLE INCOMPATIBILITY - Removed -items option. This was originally
+ put in as a convienence, but it turns out to be quite costly in terms
+ of performance. It had to go. The insert/delete/get commands can be
+ used instead which is much more in line with Tk.
+
+>> POSSIBLE INCOMPATIBILITY - The following options have been removed:
+ -autoclear and -fliparrow.
+
+>> The combobox now utilizes built-in bitmaps for button glyphs.
+
+>> Removed the margin frame component used for implementing a margin
+ between the entry and arrow button. This is now accomplished via
+ the grid by maintaining an empty column for the margin and adjusting
+ its minsize.
+
+>> List elements are preserved when switching between drop-down and simple
+ styles via the -dropdown option.
+
+>> The functionality of the -state and -editable options have been made
+ completely independent of each other. It can be editable/normal,
+ non-editable/normal, or disabled, and toggling one option will not
+ impact the other option when the first is toggled back
+
+>> Corrected the validation processing in the -unique option.
+
+>> Fixed various error messages returned due to bad arguments, options, etc.
+
+
+Fileselectionbox
+______________________________________________________________________________
+
+>> Reimplemented geometry management using the grid instead of the packer.
+
+>> Changed component option basis to be that of the "usuals".
+
+>> Removed frame components used for margins. This is now accomplished
+ via the grid by maintaining an empty row/column for the margin and
+ setting its minsize.
+
+>> Changed the default value of -nomatchstring to "".
+
+>> The directory and files lists are now shown without the leading
+ directory name. Although this differs from the Motif standard, it
+ keeps the fileselectionbox more in line with the tk_getSaveFile dialog.
+
+>> POSSIBLE INCOMPATIBILITY - The -style option which allowed you to
+ display the fileselectionbox in a "notif" style using comboboxes
+ for the filter and selection and kept the lists in a panedwindow
+ has been removed. A related option, -dirsfraction is also gone.
+
+ This feature caused the fileselectionbox to be much slower during
+ construction than anticipated. If you liked the "notif" style, it
+ exists in a new mega-widget call extfileselectionbox and
+ extfileselectiondialog.
+
+>> POSSIBLE INCOMPATIBILITY - The childsite is now a protected component.
+ If you need access to it, use the childsite command.
+
+>> POSSIBLE INCOMPATABILITY - The following options have been removed
+ and are not directly available in the fileselectionbox anymore:
+
+ -relief -repeatdelay -repeatinterval -labelmargin
+ -hscrollmode -sbwidth -scrollmargin -vscrollmode
+ -dirslabelpos -fileslabelpos -filterlabelpos
+ -selectionimage- selectionlabelpos -filterfocuscommand
+ -selectionfocuscommand -dbldirscommand -dblfilescommand
+
+ The underlying components still maintain them , but not the
+ fileselectionbox itself. You can still set them via the component
+ command, i.e. ".fsb component dirs configure -hscrollmode none"
+
+>> POSSIBLE INCOMPATIBILITY - The -horizmargin and -vertmargin options
+ have been removed. I doubt if anybody other than the most picky
+ of people will be effected.
+
+>> Added new childsite position orientation settings. The new
+ positions are n, s, e, w, top, bottom, and center.
+
+>> Updated the test script and man page.
+
+
+Extfileselectionbox
+______________________________________________________________________________
+
+>> New Iwidget. The extfileselectionbox is basically the "notif" portion
+ of the previous version of the fileselectionbox. It was separated from
+ the fileselectionbox for performance reasons.
+
+>> Created test script, demo and man page.
+
+>> The catalog demo has been updated to include the extfileselectionbox demo.
+
+
+Tabset
+______________________________________________________________________________
+>> Corrected tab display problem which was occurring on HP machines.
+
+ Some additional updates were installed in tab selection and deselection.
+ They will only be invoke should the os be HP-UX. Also, the ability
+ to scroll the tabs via MB2 has been disabled for HPs. Thanks to
+ tilt@designacc.com (Thomas Tempero) for first reporting the problem
+ mikesz@pcs.mot.com (Michael Szilagyi) for sending me the fix which
+ was implemented.
+
+
+Timefield
+______________________________________________________________________________
+
+>> New iwidget. The timefield is a smart time entry field. It verifies
+ user time input prior to its display. Since it is derived from the
+ labeledwidget, it also includes an optional label.
+
+>> Man page, test script, and demo have been produced.
+
+>> The catalog demo has been updated to include the timefield demo.
+
+
+Watch
+______________________________________________________________________________
+
+>> New iwidget. The watch widget displays a simple clock face. Methods
+ exist to set/get the time. The hands can be adjusted via mouse selection
+ with the new setting being retrievable via the get method. It is
+ very configurable. The colors of the hands, face, and marks can all
+ be changed to suit your needs.
+
+>> Many thanks to John Tucker who developed this nice widget.
+
+>> Man page, test script, and demo have been produced.
+
+>> The catalog demo has been updated to include the watch demo.
+
+
+Timeentry
+______________________________________________________________________________
+
+>> New iwidget. Timeentry, like the dateentry, is along the quicken
+ lines as well. It displays a timefield with a watch icon button
+ beside it. Selection of button presents a popup watch which enables
+ you to select the time by dragging the hands about the face. The
+ popup has a close button that removes the popup and sets the timefield
+ to the value previously displayed in the watch. You can also just
+ enter the time directly as you would in the standard timefield.
+
+>> Man page, test script, and demo have been produced.
+
+>> The catalog demo has been updated to include the timeentry demo.
+
+
+==========================================================================
+ -------------------------- iwidgets-2.1.1 ------------------------------
+ -------------------- CHANGES FROM iwidgets-2.1.0 -----------------------
+==========================================================================
+
+ [incr Widgets] version 2.1.1 is compatable with itcl2.1
+
+NEW FEATURES
+------------------------------------------------------------------------------
+>> Added pagecget method to notebook class.
+
+ Patch supplied by Tom Tromey (tromey@cygnus.com).
+
+>> Added buttoncget method to buttonbox class.
+
+ Patch supplied by Tom Tromey (tromey@cygnus.com).
+
+>> Added buttoncget method to dialogshell class.
+
+ Patch supplied by Tom Tromey (tromey@cygnus.com).
+
+>> Added -closecmd option to the hyperhelp mega-widget.
+
+ Previously, closing the hyperhelp widget deleted the object which was
+ deemed to be user hostile. Now, there exists a -closecmd option
+ which defaults to just deactivating the widget. Should you wish to
+ destroy the widget, either do so explictly or modify the -closecmd
+ to do it.
+
+
+BUG FIXES
+------------------------------------------------------------------------------
+>> Corrected selectborderwidth option class name in the toolbar
+
+ The class name was set to SelectBorderWidth rather than BorderWidth.
+ This created problems when attempting to use the toolbar with
+ other widgets like the scrolledcanvas. Bug report by csmith@adc.com
+ (Chad Smith).
+
+>> Allow negative indexes in scrolledlistbox
+
+ Negative indicies are reasonable and valid. Bug report by
+ wfarel@cas.org (Bill Farel).
+
+>> Corrected problem with caps-lock and num-lock in entryfields
+
+ Validation was not being being done if the num-lock or caps-lock
+ keys are down. Bug report by ronnie@r2d2.wink.com (Ronnie Carpio).
+
+>> Corrected problem with special character entry in entryfields
+
+ Upon entry of a special character in the entry field like \ or [
+ an error would be reported: "Error: missing "". The substitutions
+ being performed in iwidgets::Entryfield::_keyPress have been corrected.
+ Bug report and patch provided by ronnie@r2d2.wink.com (Ronnie Carpio).
+
+>> Made the relayout method in pushbutton protected.
+
+ The relayout method in the pushbutton needed to be changed from private
+ to protected so parent classes can have access. Bug discovered by
+ Mario Weilguni <e8732250@student.tuwien.ac.at>
+
+>> Corrected html tag parsing in scrolledhtml mega-widget
+
+ Fixed regular expressions parsing html tags to ignore text in quotes
+ and only examine first attribute in list.
+
+>> Corrected optionmenu insert bug
+
+ The option menu would not allow you to insert an entry beyond the
+ current length of the popup menu. It should just default to using
+ the end in this case.
+
+>> Corrected scrolledtext import method newline insertion problem
+
+ There was a bug in the scrolledtext widget. It always inserted a
+ newline before the text of the file when doing an "import". And it
+ didn't correctly preserve a trailing newline on the file. Reported
+ by Tom Tromey (tromey@cygnus.com)
+
+>> Corrected minor problems in notebook class.
+
+ The index method gave an error if (eg) "select" wass passed but
+ there is no selection. Instead it should return -1 as documented.
+ Changed it to always return -1 in case of error. This makes more
+ sense.
+
+ If there are no items in the notebook, the -scrollcommand should
+ still be run (if it is set). Otherwise, you end up with a
+ scrollbar that looks odd, and when you try to scroll you get
+ errors. Changed it so that it will tell the scrollbar that
+ the entire notebook is being displayed. Reported by Tom Tromey
+ (tromey@cygnus.com)
+
+>> Corrected menubar menucget command to return errors for bad options.
+
+ The command "<menubar> menucget .element" returned something other
+ than an error message. This has been corrected. Reported by Tom
+ Tromey (tromey@cygnus.com)
+
+>> Corrected menubar man page.
+
+ The usage for the menubar menucget command was wrong and has been
+ fixed. Reported by Tom Tromey (tromey@cygnus.com)
+
+
+INCOMPATIBLE CHANGES
+------------------------------------------------------------------------------
+
+
+==========================================================================
+ -------------------------- iwidgets-2.1.0 ------------------------------
+ -------------------- CHANGES FROM iwidgets-2.0.1 -----------------------
+==========================================================================
+
+ [incr Widgets] version 2.1.0 is compatable with itcl2.1
+
+NEW FEATURES
+------------------------------------------------------------------------------
+>> Eliminated unneeded update idletask calls.
+
+ Went through many of the [incr Widgets] and got rid of those update
+ idletask calls that were not really needed. This should speed a few
+ of them up a bit.
+
+>> The hyperhelp mega-widget has been enhanced such that topic items
+ don't need to be in the help directory.
+
+ It's just an added option in specifying topics. To use it, you would
+ replace '-topics {topic1 topic2 topic3}' with
+ '-topics {topic1 {topicname2 filename2} {topic3 filename3}}'. In other
+ words, you only have to change where you want to specify a pathname. If
+ you don't specify a filename, everything works the same.
+
+>> Added a -autoclear option to the combobox.
+
+ The combobox was doing an automatic erasure of the entry field contents
+ upon hitting return. With this option, you can turn that off but it
+ still puts the string in the list.
+
+>> Added a -master option to the shell class.
+
+ The shell made all instances transient with "." as the master. With
+ this option, you can change the master to other toplevels. The default
+ is no master for shells, and "." for all dialogs which are derived from
+ shell.
+
+>> Added a -style option to the fileselectionbox and fileselection dialog.
+
+ Tony Parent did a great job of augmenting the fileselectionbox with
+ a style option that allows you to change the layout from the standard
+ motif look-and-feel to a better than motif layout. This new layout
+ is called notif and features comboboxes for the filter and selection
+ entry fields and a paned window contains the two listboxes allowing
+ you to change the allocation of space for the lists.
+
+>> Removed the center childsite position for the fileselectionbox.
+
+ This is a side effect of the notif change made by Tony Parent. It
+ just isn't easy to have a center position when your in a pane window.
+ It is a small sacrifice for the having an alternate layout of the
+ fileselectionbox.
+
+
+BUG FIXES
+------------------------------------------------------------------------------
+>> The makefile was amended to install the unknown.gif file correctly.
+
+ The hyperhelp and scrolledhtml widgets need an unknown gif file that
+ is used when unable to load an image. The makefile was not properly
+ installing it.
+
+>> The scrolledhtml.n man page was fixed to allow man2html to work.
+
+ The scrolledhtml.n file had a bug which would hang man2html during a
+ "make install-html". The bug affected only the htmling of the file
+ not the man page itself.
+
+
+INCOMPATIBLE CHANGES
+------------------------------------------------------------------------------
+
+
+==========================================================================
+ -------------------------- iwidgets-2.0.1 ------------------------------
+ -------------------- CHANGES FROM iwidgets-2.0.0 -----------------------
+==========================================================================
+
+ [incr Widgets] version 2.0.1 is compatable with itcl2.0
+
+NEW FEATURES
+------------------------------------------------------------------------------
+>> Added extra frame around canvas widget in Scrolledcanvas class
+
+ The borderwidth, relief, and hightlight options have been removed from
+ the canvas widget and placed on the new encompassing frame widget. This
+ fixes the problem with canvas widgets including the border and highlight
+ ring in the clipping region.
+
+>> Added extra frame around text widget in Scrolledtext class
+
+ The borderwidth, relief, and hightlight options have been removed from
+ the text widget and placed on the new encompassing frame widget. This
+ fixes the problem with text widgets including the border and highlight
+ ring in the clipping region.
+
+>> The canvasprintbox stamp supports resizing and default print buttons
+
+ Tako Schotanus updated the canvasprintbox such that the stamp now gets
+ updated whenever the window is resized. Also, he modified the dialog
+ default buttons to be Print, Apply and Cancel. Apply does a refresh and
+ Print does what you'd expect.
+
+>> Added feedback mega-widget to [incr Widgets]
+
+ The feedback widget is a gage for displaying process status. Display
+ is given as a percentage and as a thermometer type bar. Options exist
+ for adding a label and controlling its position.
+
+ Special thanks go to Sam Shen(SLShen@lbl.gov), as this code is based on his
+ feedback.tcl code from tk inspect. The original code is copyright 1995
+ Lawrence Berkeley Laboratory.
+
+>> Added scrolledhtml mega-widget to [incr Widgets]
+
+ The scrolledhtml widget implements a scrollable html text widget through
+ inheritance from scrolledtext. Import reads from an html file, while
+ export still writes plain text. Also provides a render command, to
+ display html text passed in as an argument.
+
+ Special thanks go to Sam Shen(SLShen@lbl.gov), as this code is based on his
+ tkhtml.tcl code from tk inspect. The original code is copyright 1995
+ Lawrence Berkeley Laboratory.
+
+>> Added hyperhelp mega-widget to [incr Widgets]
+
+ The hyperhelp widget implements a help facility using html formatted
+ hypertext files.
+
+ Special thanks go to Sam Shen(SLShen@lbl.gov), as this code is based on his
+ help.tcl code from tk inspect.
+
+>> Added menubar mega-widget to [incr Widgets]
+
+ Actually it was kind-of already an iwidget. It was living in the incoming
+ directory for a time. No one had a complaints about it so now it is
+ a full citizen.
+
+
+BUG FIXES
+------------------------------------------------------------------------------
+>> Corrected spurious quote in toolbar.itk
+
+ Thanks to Tom Tromey for finding this elusive little buglet and sending
+ the patch. Wish all problems were reported in this manner.
+
+>> Corrected problem with dialogs being unable to acquire a grab.
+
+ The dialogshell activate method would generate an error if unable to
+ acquire a grab for application and global modal dialogs. The fix
+ installed adds a catch and a reattempt loop with a delay. In other
+ words, the dialog shell will continuously attempt to acquire the grab
+ with a delay between attempts.
+
+>> Corrected problem with pushbutton not displaying the tab traversal ring.
+
+ The pushbutton would not display the tab traversal ring when the default
+ ring was enabled. This has been corrected.
+
+>> Corrected scrolledlistbox getcurselection method with multiple selectmode.
+
+ If the current scrolledlistbox selectmode is multiple, then the
+ getcurselection method should always return the selected items as
+ a list, regardless of the number of items selected. It used to
+ return a list only if more than one item is selected.
+
+>> Buttonbox wasn't adjusting geometrically following hides if not mapped.
+
+ Bernard Johnson from TI was good enough to find this one. It could
+ be seen by creating a dialog, activating, deactivating, then hiding
+ a button. Next, activate it again and you'd notice that the dialog's
+ buttonbox had not been resized. The problem was that the resizing
+ of the buttonbox was bound to the map event, which once mapped, was
+ removed when it shouldn't have been.
+
+>> Buttonbox wasn't adjusting properly following button additions which
+ were preceeded by deletions.
+
+ Greg McFarlane found this one. The buttonbox needed to do perform
+ and update idletasks following the sizing of the box during a deletion.
+ Otherwise, the values returned by winfo were incorrect during a
+ subsequent button addition.
+
+>> Removed underlining of listbox items in the combobox.
+
+ Milind Khandekar requested that this feature be removed. It was
+ annoying.
+
+
+INCOMPATIBLE CHANGES
+------------------------------------------------------------------------------
+
+
+==========================================================================
+ -------------------------- iwidgets-2.0.0 ------------------------------
+ -------------------- CHANGES FROM iwidgets-2.0b4 -----------------------
+==========================================================================
+
+ [incr Widgets] version 2.0.0 is compatable with itcl2.0
+
+NEW FEATURES
+------------------------------------------------------------------------------
+>> The copyright has been assigned to DSC Communications Corporation.
+
+ The copyright has been transferred from private individuals to DSC.
+ It is still an open copyright, just changes in the legalize wording.
+
+>> Added several new mega-widgets.
+
+ The new mega-widgets include the toolbar, tabnotebook, tabset, and
+ notebook. Check the man pages for details.
+
+>> Added demo catalog.
+
+ The demos directory now contains a catalog program. It displays the
+ code for each demo upon single select. Double-click starts the demo.
+
+>> Added incoming directory for experimental mega-widgets.
+
+ An incoming directory exists in the distribution which contains beta
+ state mega-widgets. They are not installed, but do include the needed
+ doc, demos, and tests. These mega-widgets may or may not make the cut.
+ Please send feedback on their viability. If enough positive response
+ is felt, then they will be moved up. Otherwise, I'll move them to an
+ outgoing directory and later delete them altogether.
+
+>> With the introduction of the new itcl-2.0b3 code command, the following
+ changes were required.
+
+ All "bind" and "after" commands now use "code".
+
+ All "-command" options and scrollbar commands now use "code".
+
+ Removed "uplevel /scope" combinations from command type options.
+
+ Replaced "eval" with "uplevel #0" for evaluation of command options.
+
+>> Added curselection method to selectionbox and selectiondialog class.
+
+ The curselection command from the contained listbox of the selectionbox
+ has been thinwrapped.
+
+>> Removed BLT dependency for implementing application modal dialogs.
+
+ The dialogshell class no longer uses blt_busy for application modal
+ dialogs. Instead, local grabs are performed. The benefits are speed
+ and extension independence. Minus is the loss of the watch cursor
+ which blt_busy used. I figure, programmers wanting the cursor action
+ can implement it themselves on an as needed basis.
+
+>> Added a grab stack in the dialogshell.
+
+ The dialogshell uses a grabstack to keep track of the current blocking
+ levels. Thus a application modal dialog can activate another one and
+ upon closing the last one, the next one in the stack gets the block.
+ This feature did not exist before.
+
+>> Replace "after 1" commands with "after idle"
+
+ This produces the same result, but makes for a cleaner syntax.
+
+>> Added center command to the dialogshell.
+
+ The dialogshell provides a center command which takes an optional argument
+ of the path for another widget. Upon activation, the dialogshell will
+ be centered with respect to it. The command may also be invoked with
+ no arguments to center the dialogshell on the screen as a whole. Since
+ all other dialog classes are derived from dialogshell, all dialogs now
+ have the center command available.
+
+>> Made the Help button hidden by default for dialogs
+
+ Most people turn it off right away anyway. It is still there. Just need
+ to do a "show Help" if you need it back.
+
+>> Comboxbox now derived from entryfield.
+
+ The combobox structure has been modified to be derived from the entryfield
+ class. Now combobox labels can be aligned using the labeledwidget
+ alignlabels method along with optionmenus, entryfields and such.
+
+>> Added -justify and -wraplength to Messagedialog.
+
+ The justify and wraplength options are now kept for the label in the
+ messagedialog widget.
+
+>> Added a man page generator for itcl.
+
+ In the doc directory is a new utility called mkitclman. It does a good
+ job at an initial pass of man page generation for new iwidget classes.
+ You still need to get in there and beef up the man page which is produced,
+ but it is better than starting from scratch.
+
+>> Added the canvasprintbox and canvasprintdialog mega-widgets.
+
+ Two new mega-widgets, canvasprintbox and canvasprintdialog, have been
+ contributed to [incr Widgets]. Thanks to Tako Schotanus,
+ Tako.Schotanus@bouw.tno.nl.
+
+>> Added the textbackground option to the scrolledcanvas widget
+
+ The textbackground option has been added to the scrolledcanvas widget
+ similarly to the scrolledlistbox and entryfield widgets.
+
+
+BUG FIXES
+------------------------------------------------------------------------------
+>> Enabled repeat action in spinners.
+
+ This was available in iwidgets two versions ago. I made in incorrect
+ merge and lost the change. It has now been added back into the spinner.
+
+>> Eliminated use of #auto in panedwindow.
+
+ Using #auto made the test script fail should you run it two times in a
+ row. Instead, the class keeps its own unique counter which is always
+ reset upon construction. This was more of an annoyance than a bug.
+
+>> Corrected selection problem in selectiondialog.
+
+ The selectiondialog wasn't configuring the itemscommand properly, so
+ selection of an item was not reflected in the selection entryfield.
+
+>> Corrected index usage problem in buttonbox insert method.
+
+ The buttonbox insert method didn't correctly convert the index argument
+ prior to inserting the new pushbutton. This has been fixed.
+
+>> Corrected flicker problem in scrolled* widgets.
+
+ Modified the scrolled* widgets to only change the current scrollbar
+ display if different than the current setting. This fixes the flicker
+ problem which was apparent during horizontal scrolling.
+
+>> Entryfield command option performs a break.
+
+ Following evaluation of the command option for entryfield widgets, a
+ break is performed. This caused a problem when entryfields were in
+ a dialog. Hitting return in the entryfield, invoked the dialogs
+ default button. This has been fixed.
+
+
+INCOMPATIBLE CHANGES
+------------------------------------------------------------------------------
+>> Removed -highlightbackground option from mega-widgets
+
+ All the -highlightbackground options have been renamed to be -background.
+ This was always an annoyance anyway. Now, setting the -background changes
+ all the highlightbackgrounds as well. Should anybody still for some odd
+ reason need -highlightbackground, just access the component with the
+ "component name configure" command.
+
+
+==========================================================================
+ -------------------------- iwidgets-2.0b0 ------------------------------
+ -------------------- CHANGES FROM iwidgets-2.0b1 -----------------------
+==========================================================================
+
+ [incr Widgets] versions b1, b2, b3, and b4 are compatable with itcl-2.0b2
+
+NEW FEATURES
+------------------------------------------------------------------------------
+
+>> A secondary lower case mega-widget command now exits.
+
+ Mega-widgets can now be created using the new lower case, more tk'ish
+ method or still using the class name.
+
+ Entryfield .ef and entryfield .ef
+
+ both perform the same operation.
+
+>> The demos should now all work.
+
+ The correct wish is now called. itkwish instead of the old itcl_wish.
+
+>> The man pages have all been updated to the best of my ability.
+
+>> A new more minimal format for the code style has been implemented.
+
+ The class declaration only contains declarations. All implementation is
+ spearate. This creates a much more readable class.
+
+>> All class file names as well as the tests, doc, and demos are all lower
+ case.
+
+>> Several new validate types such as hexidecimal and real have been added
+ to the Entryfield.
+
+>> The Panedwindow class additional commands:
+
+ A paneconfigure command exists for configuring indiviual tagged panes.
+
+ panedwindow .pw
+ .pw add first
+ .pw add last
+ .pw paneconfigure first -margin 10
+
+ An insert command exists. It takes an index and tag as arguments followed
+ by optional arguments to be applied to the pane.
+
+ .pw insert end second -minimum 20
+
+>> The Buttonbox class now has additional commands:
+
+ A buttonconfigure command exists for configuring indiviual tagged buttons.
+
+ buttonbox .bb
+ .bb add OK -text OK
+ .bb add Cancel -text Cancel
+ .bb buttonconfigure OK -command [list puts OK]
+
+ An insert command has been added. It takes an index as the first arg,
+ followed by the tag and button arguments.
+
+ .bb insert Cancel Apply -text Apply
+
+ The invoke command no long excepts a list of buttons to invoke. That
+ didn't make much sense. It takes an optional index for a single button
+ to invoke. Without any arguments, the default button is invoked.
+
+BUG FIXES
+------------------------------------------------------------------------------
+
+>> Corrected scrolled* packing
+
+ The packing order of all the scrolled* mega-widgets has been modified
+ such that the scrollbars are the last to be clipped.
+
+>> Corrected buttonbox single button centering
+
+ The buttonbox has been modified such that a box with only one button
+ will be correctly centered.
+
+>> scrolledlist selection corrected
+
+ The -selectioncommand is now invoked following any selection of an item,
+ regardless if it was already selected. The programmer must now determine
+ if the selected item has changed if necessary. The previous approach of
+ only invoking the -selectioncommand if the selection has changed caused
+ too many problems, making it behave erraticly.
+
+>> Corrected problems preventing classes being derived from scrolled* classes
+
+ Several variables were incorrectly declared to be private rather than
+ protected. Also, the _scroll* method was incorrectly declared private
+ instead of protected. These problems prevented inheritance from the
+ scrolled* classes.
+
+
+INCOMPATIBLE CHANGES
+------------------------------------------------------------------------------
+
+>> The class names are now upper case on the first character only.
+
+ Class names have been changed to be upper case on the first character
+ only to be more X'ish. Old class names like EntryField are now Entryfield.
+
+>> All public methods are now all lowercase.
+
+ This effects the typical common method such as childsite. Others effected
+ include :
+
+ ::iwidgets::Labeledwidget::alignlabels
+
+>> Labeledwidget class changes:
+
+ The -labelon option has been removed. The mega-widget now unpacks both
+ the label and margin if neither the -labeltext, -labelbitmap, or
+ -labeimage have a value.
+
+ The -font option has been removed. The -labelfont option should be used
+ instead.
+
+>> Entryfield class changes:
+
+ The -labelon option is not inherited by the Entryfield anymore. See the
+ Labeledwidget changes above.
+
+ The Entryfield fixed option has a different meaning. It now specified
+ the maximum number of characters allowed. A value of zero is unlimited.
+ This frees up the width option to be able to specify a greater number
+ of characters than the fixed amount for visual effect.
+
+ The -type and -validate options have been combined to just -validate
+ which now takes either a type keyword or a command. The command receives
+ additional trailing arguments consisting of the input character and the
+ the widget. I hope to change this soon to use substitutions like %c
+ for the character at a later date.
+
+ The -background option has been removed. The -textbackground option
+ should be used instead.
+
+ The -validate option now has several substitution strings which may be
+ passed to the validation script.
+
+>> ScrollBar class changes:
+
+ It has been deleted. It wasn't a big win. The only benefit was that the
+ -background option automatically calculated the troughcolor at 80% of
+ its value. It's just as easy to use the option database and change the
+ Tk scrollbar troughcolor to whatever value is desired. The various
+ scrolled* classes now all use the straight Tk scrollbar.
+
+>> Panedwindow class changes:
+
+ Panes are now tagged. This means the add, and insert methods take an
+ additional argument which is the tag for that pane.
+
+ The panedwindow index method now takes the tag as well as the number and
+ keyword "end". Other methods such as delete, hide, and show now can use
+ the pane tag as an index.
+
+ panedwindow .pw
+ .pw add bottom
+ .pw insert 0 top
+ .pw insert 1 middle
+ .pw delete middle
+
+ The refresh method has been renamed to reset.
+
+ The semi-private -state option has been removed. The only method of
+ controlling the display of panes is via the hide and show methods.
+
+>> Dialogshell class changes:
+
+ The modality option value of "system" has been renamed to be "global"
+
+>> Dialog class changes:
+
+ All the options for the buttons have been removed. The buttonconfigure
+ method should be used instead. The class simply creates the standard
+ OK, Apply, Cancel, and Help buttons tagged by their default labels.
+ The buttonconfigure method can be used to make modifications to the
+ buttons. The hide and show methods should now be used instead of the
+ the -disp* options.
+
+ dialog .d
+ .d buttonconfigure OK -text Enter
+ .d hide Help
+ .d hide Apply
+
+ The -orient option is no longer kept. It seemed rarely used if at all.
+ The -buttonboxpos option handles the mojority of the cases as is.
+
+>> Scrolledcanvas class changes:
+
+ The binditem method is now been renamed back to bind. This is what it
+ should have been all along. A problem in the alpha version of [incr Tcl]
+ prevented use of this word.
+
diff --git a/itcl/iwidgets3.0.0/README b/itcl/iwidgets3.0.0/README
new file mode 100644
index 00000000000..36416d9553f
--- /dev/null
+++ b/itcl/iwidgets3.0.0/README
@@ -0,0 +1,282 @@
+------------------------------------------------------------------------------
+ [incr Widgets] - version 3.0.0
+------------------------------------------------------------------------------
+ This version is compatible with itcl3.0
+
+ Please send general comments or suggestions to mulferts@spd.dsccc.com.
+ Should you have an enhancement or comment regarding a specific mega-widget,
+ please send email to the author listed in the source header.
+==============================================================================
+ Copyright (c) 1995 DSC Technologies Corporation
+==============================================================================
+ This software is copyrighted by DSC Technologies and private individual
+ contributors. The copyright holder is specifically listed in the header
+ of each file. The following terms apply to all files associated with the
+ software unless explicitly disclaimed in individual files by private
+ contributors.
+
+ Permission to use, copy, modify, distribute and license this software and
+ its documentation for any purpose, and without fee or written agreement
+ with DSC, is hereby granted, provided that the above copyright notice
+ appears in all copies and that both the copyright notice and warranty
+ disclaimer below appear in supporting documentation, and that the names of
+ DSC Technologies Corporation or DSC Communications Corporation not be used
+ in advertising or publicity pertaining to the software without specific,
+ written prior permission.
+
+ DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL
+ IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-INFRINGEMENT.
+ THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND
+ DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES,
+ ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL DSC BE LIABLE FOR ANY
+ SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
+ RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
+ CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, ARISING OUT OF OR IN
+ CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+ RESTRICTED RIGHTS: Use, duplication or disclosure by the government
+ is subject to the restrictions as set forth in subparagraph (c) (1) (ii)
+ of the Rights in Technical Data and Computer Software Clause as DFARS
+ 252.227-7013 and FAR 52.227-19.
+==============================================================================
+
+ OVERVIEW
+------------------------------------------------------------------------------
+ - Introduction
+ - Distribution
+ - Web site
+ - Getting started
+ - Contributions
+ - Acknowledgements
+------------------------------------------------------------------------------
+
+
+ Introduction
+------------------------------------------------------------------------------
+ [incr Widgets] is an object-oriented mega-widget set which extends
+ Tcl/Tk and is based on [incr Tcl] and [incr Tk]. This set of mega-widgets
+ delivers many new, general purpose widgets like option menus, comboboxes,
+ selection boxes, and various dialogs whose couterparts are found in Motif
+ and Windows. Since [incr Widgets] is based on the [incr Tk] extension, the
+ Tk framework of configuration options, widget commands, and default bindings
+ is maintained. In other words, each [incr Widgets] mega-widget seamlessly
+ blends with the standard Tk widgets. They look, act and feel like Tk
+ widgets. In addition, all [incr Widgets] mega-widgets are object oriented and
+ may themselves be extended, using either inheritance or composition.
+
+ [incr Widgets] offers a strong object-oriented foundation which addresses
+ the need for a flexible and extensible mega-widget set. Its usage replaces
+ common widget combinations with higher level abstractions, simplifying code,
+ reducing errors, increasing readability, adding productivity, and promoting
+ a singular look-and-feel. The ability to extend [incr Widgets] enables
+ developers to create new mega-widgets based on previous work.
+
+ In short, [incr Widgets] is a library of reusable mega-widgets that can
+ be easily extended using composition or inheritance, allowing quicker
+ development of large scale applications. Usage drastically reduces
+ development time. New dialogs can be created in hours. Whole applications
+ in a few days. Reuse becomes a reality. Many projects are benefitting frm
+ the intergration of this mega-widget set into their development strategy.
+ [incr Widgets] is an [incr Tcl] and [incr Tk] success story. Good products
+ come from good foundations.
+
+
+ Distribution
+------------------------------------------------------------------------------
+ The [incr Widgets] distribution is included with [incr Tcl] version 2.0
+ and greater. It is available via ftp at ftp.neosoft.com/tcl. Consult the
+ included release documentation for installation notes. For the latest
+ in distribution information, this web site should be consulted.
+
+ The [incr Tcl] distribution will always include the most current release
+ of [incr Widgets] which was possible at the time of its release. It is
+ anticipated that [incr Widgets] will change more rapidly than [incr Tcl].
+ This being the case, in between [incr Tcl] releases, the latest version
+ of [incr Widgets] is also separately available via ftp at the same
+ location list above as well as the web site.
+
+ The version number of [incr Widgets] tracks the release of [incr Tcl]
+ for which it is compatible. The version numbering system for [incr Widgets]
+ includes an extra number. For example version 2.1.1 of [incr Widgets] is
+ compatible with [incr Tcl] 2.1. As the minor number of [incr Tcl] increases
+ the second digit of the [incr Widgets] version varies. This makes for
+ easy release identification.
+
+ Web site
+------------------------------------------------------------------------------
+ For the most current news regarding [incr Widgets] please consult the web
+ set - http://www.tcltk.com/iwidgets. The site contains a lot of good
+ information such as tutotials, man pages, and examples. Plus, I'm real
+ proud of our new logo. Also, catch our picture under the development
+ team link. Many thanks to the good people at Webnet Technologies for
+ the excellent web production work. Joe Bob says "Check it out !"
+
+
+ Getting started
+------------------------------------------------------------------------------
+ The "doc" directory contains man pages and a technical paper. The man
+ pages are installed under the man directory off your --prefix. In
+ addition, the makefile includes an install-html target for creating
+ a HTML version of the man pages. They are placed under your prefixed
+ doc directory.
+
+ doc/iwidgets.ps ... Updated paper presented at Tcl Workshop 95.
+
+ doc/*.n ........... Man pages
+
+ The "demos" directory contains demo scripts for each mega-widget. The
+ demos are also installed under the lib directory off your --prefix.
+
+ demos/catalog ..... Comprehensive demo package which illustrates
+ [incr Widgets] usage additionally displaying the
+ source.
+
+ The "tests" directory contains a set of test scripts for [incr Widgets].
+ They also make for a great demo of the flexiblity of the mega-widgets.
+ Once you've built your itkwish, try firing it up and sourcing "all" in
+ the tests directory.
+
+
+ Installation
+------------------------------------------------------------------------------
+ [incr Tcl] with [incr Widgets]
+
+ As previously stated, the latest version of itcl contains the latest
+ version of iwidgets. Having the itcl distribution is a prerequsite
+ to using iwidgets. Thus, if you don't have itcl follow the these steps
+ to acquire itcl and iwidgets.
+
+ 1) Read the distribution section notes above.
+
+ 2) Obtain the [incr Tcl] 3.x distribution from the archive site like this:
+
+ ftp ftp.neosoft.com
+ cd /pub/tcl/sorted/devel/
+ binary
+ get itcl3.0.tar.gz
+ get itcl3.0.README
+ quit
+
+ 3) Follow the directions in the itcl README file.
+
+ If you've already got itcl and have found a newer version of iwidgets
+ at neosoft, then follow the following steps.
+
+ 1) Read the distribtion scetion notes above.
+
+ 2) Obtain the [incr Widgets] 3.x.y distribution from the archive site
+ like this:
+
+ ftp ftp.neosoft.com
+ cd /pub/tcl/sorted/devel/
+ binary
+ get iwidgets3.0.1.tar.gz
+ quit
+
+ 3) cd to your compatable itcl source directory. For example:
+
+ cd /usr/local/src/itcl3.0
+
+ 4) Uncompress and untar the iwidgets distribution:
+
+ gunzip iwidgets3.0.1.tar.gz
+ tar xvf iwidgets3.0.1.tar
+
+ 5) Run the configuration script:
+
+ cd iwidgets3.0.1
+ ./configure
+
+ or, for systems that don't recognize "#!" in shell scripts:
+
+ cd itcl3.0
+ /bin/sh ./configure
+
+ By default, the configuration script will set things up
+ to be installed in "/usr/local". You can change this
+ by specifying a different "prefix" in the "configure" command.
+ You'll want to use the same value you used for the prefix in
+ the configuration of your itcl3.0 distribution.
+
+ ./configure --prefix=/your/install/path
+
+ You can also add options for a particular "cc" compiler and
+ compiler flags:
+
+ ./configure --with-cc=gcc --with-cflags=-g
+
+ The "configure" script generates new Makefiles from their
+ respective templates (Makefile.in).
+
+ 6) Build the iwidgets library:
+
+ make all
+
+ 7) Install the iwidgets library, man pages and script files.
+
+ make install
+
+ 8) Optionally, you can install the html'ed version of the iwidgets
+ man pages:
+
+ make install-html
+
+
+ Contributions
+------------------------------------------------------------------------------
+ I feel that [incr Widgets] is a good start in the direction of establishing
+ a strong set of object-oriented mega-widgets, but I swear that everytime I
+ go back and look at the source I see an even better more simplier way
+ something could have been accomplished. Should anybody within the Tcl/Tk
+ community come upon an even better way, a great enhancement, or an awesome
+ new mega-widget altogether, please don't hesitate to send it to the author
+ listed in the header or myself, mulferts@spd.dsccc.com, as moderator. I or
+ any of the development team members are always available via email for a
+ technical interchange of ideas.
+
+ [incr Widgets] is a continuing effort. We have many new mega-widgets
+ currently under development and are actively looking for volunteers willing
+ to contribute their own [incr Tk] based mega-widgets for inclusion into
+ the [incr Widgets] set. The distribution is moderated. Contributed
+ mega-widgets should be of good quality and complete with documentation,
+ tests, and demonstrations. Please follow the coding style found in the
+ distribution source. This includes man page and test script formats as well.
+ The languages and extensions on which [incr Widgets] is based are of high
+ standards. [incr Widgets] strives to attain this same level. Be fore
+ warned, the moderator is a facist.
+
+
+ Acknowledgements
+------------------------------------------------------------------------------
+ Thanks to the original develment team, comprised of Mark Ulferts, Sue
+ Yockey, Bret Schuhmacher, Alfredo Jahn, John Sigler, and Bill Scott. Also
+ thanks to Mark Harrison for his influence, confidence, and ideas.
+
+ Thanks also to the new set of contributors which include John Tucker,
+ Mitch Gorman, John Reekie, Alfredo Jahn, Ken Copeland, Tako Schotanus,
+ Tony Parent and Michael McLennan
+
+ Thanks to Michael McLennan, creator of [incr Tcl] and [incr Tk], for the
+ beta copies, training, assistance, and his infectious enthusiasm.
+
+ Thanks to DSC Communications for picking up the copyright and supporting
+ the public release of this software.
+
+ Thanks to John P. Davis for creating the [incr Widgets] "Flaming Toaster"
+ logo which can be seen at http://www.tcltk.com/iwidgets
+
+ Thanks to WebNet Technologies for their assistance is designing the [incr
+ Widgets] web site, as well as hosting it.
+
+ Special thanks to my wife Karen for supporting this effort and to our two
+ girls, Katelyn and Bailey, who occasionally shared the PC with me. Also
+ thanks to my Discman and its relentless power supply as well as my rock
+ and roll CD collection. No music, no software.
+
+--
+ ____________________________________________________________________________
+ _/_/ _/_/ _/ _/ _/ Mark L. Ulferts
+ _/ _/ _/ _/ _/ _/ _/ ulferts@swbell.net
+ _/ _/_/ _/ _/ _/ _/ mulferts@austin.dsccc.com
+ _/ _/ _/ _/ _/_/_/ _/ _/_/_/_/ _/ DSC Communications Corp, Austin Texas
+ ____________________________________________________________________________ \ No newline at end of file
diff --git a/itcl/iwidgets3.0.0/catalog b/itcl/iwidgets3.0.0/catalog
new file mode 100755
index 00000000000..545f04118b1
--- /dev/null
+++ b/itcl/iwidgets3.0.0/catalog
@@ -0,0 +1,373 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# PROGRAM: demo program for [incr Widgets]
+# ----------------------------------------------------------------------
+# Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+# http://www.tcltk.com/itcl/
+# ======================================================================
+# Copyright (c) 1993-1998 Lucent Technologies, Inc.
+# ======================================================================
+#\
+exec itkwish3.0 "$0"
+
+package require Iwidgets 3.0
+
+# everything else is executed by itkwish...
+# ----------------------------------------------------------------------
+option add *Scrolledtext.textBackground white startupFile
+option add *Scrolledlistbox.textBackground white startupFile
+option add *Scrolledhtml.textBackground white startupFile
+option add *Scrolledhtml.padX 10 startupFile
+option add *boxColor blue startupFile
+option add *boxTextColor white startupFile
+
+# ----------------------------------------------------------------------
+# USAGE: iw_demo_file <name>
+#
+# Returns the proper demo file name for a demo called <name>.
+# ----------------------------------------------------------------------
+proc iw_demo_file {name} {
+ global iwidgets::library
+ return [file join $library demos $name]
+}
+
+# ----------------------------------------------------------------------
+# USAGE: iw_demo_manpage <name>
+#
+# Returns the proper man page file for a demo called <name>.
+# ----------------------------------------------------------------------
+proc iw_demo_manpage {name} {
+ global iwidgets::library
+ return [file join $library demos html $name.n.html]
+}
+
+# ----------------------------------------------------------------------
+# USAGE: iw_load_demo <name>
+#
+# Loads a demo program with the given <name>. Demos can be written
+# as if they will pop up in the main application window, but they will
+# pop up inside the tab notebook instead.
+# ----------------------------------------------------------------------
+proc iw_load_demo {name} {
+ global widgets
+
+ catch {eval destroy [winfo children $widgets(info-example)]}
+ iw_lock on
+ iw_status "Loading..."
+
+ set win [frame $widgets(info-example).inner]
+ pack $win -expand yes
+
+ set loadcmd {
+ set fid [open [iw_demo_file $name] r]
+ set code [read $fid]
+ close $fid
+ }
+ if {[catch $loadcmd result] == 0} {
+ regsub -all "(\"|\{|\\\[| |\n|^)((\\.\[A-Za-z0-9\]+)+)" \
+ $code "\\1$win\\2" code
+ regsub -all "(\"|\{|\\\[| |\n|^)(\\. )" \
+ $code "\\1$win " code
+ if {[catch {uplevel #0 $code} result] == 0} {
+ $widgets(info-code) clear
+ $widgets(info-code) import [iw_demo_file $name]
+ iw_draw_hier $name
+ iw_load_manpage $name
+ iw_lock off
+ iw_status ""
+ return
+ }
+ }
+ catch {eval destroy [winfo children $win]}
+ label $win.err -background white -wraplength 4i \
+ -text "Can't load demo:\n$result"
+ pack $win.err -expand yes
+ iw_lock off
+ iw_status ""
+}
+
+# overload a few critical functions that might be used by demo programs...
+rename exit tcl_exit
+proc exit {{status 0}} {
+ # do nothing
+}
+
+rename puts tcl_puts
+proc puts {args} {
+ global widgets
+ if {[llength $args] == 1} {
+ iw_status [lindex $args 0]
+ } else {
+ eval tcl_puts $args
+ }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: iw_load_manpage
+#
+# Loads the man page for the current demo. Man pages are not
+# automatically loaded unless the man page viewer is visible.
+# This procedure checks to see if the viewer is visible, and loads
+# the man page if needed.
+# ----------------------------------------------------------------------
+set iwManPage ""
+proc iw_load_manpage {{name ""}} {
+ global widgets iwManPage
+
+ if {[winfo ismapped $widgets(info-manpage)]} {
+ if {$name == ""} {
+ set name [$widgets(list) getcurselection]
+ }
+ if {$name != $iwManPage} {
+ iw_lock on
+ iw_status "Loading man page..."
+ $widgets(info-manpage) import [iw_demo_manpage $name]
+ iw_lock off
+ iw_status ""
+ }
+ set iwManPage $name
+ }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: iw_manpage_progress
+#
+# Handles the progress meter whenever an HTML man page is rendered.
+# If the progress meter is not showing, it is put up, and the current
+# state is updated. If the meter is at 100%, it is taken down.
+# ----------------------------------------------------------------------
+proc iw_manpage_progress {n max} {
+ global widgets
+
+ if {$n == $max} {
+ place forget $widgets(info-manpage-feedback)
+ } else {
+ if {![winfo ismapped $widgets(info-manpage-feedback)]} {
+ $widgets(info-manpage-feedback) configure -steps $max
+ $widgets(info-manpage-feedback) reset
+ place $widgets(info-manpage-feedback) -relx 0.5 -rely 0.5 -anchor c
+ update
+ }
+ $widgets(info-manpage-feedback) step
+ }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: iw_status <message>
+#
+# Displays a status <message> near the top of the window.
+# ----------------------------------------------------------------------
+proc iw_status {message} {
+ global widgets
+ $widgets(status) configure -text $message
+ update
+}
+
+# ----------------------------------------------------------------------
+# USAGE: iw_lock <state>
+#
+# Locks or unlocks the main window. Sets a grab on the main menu,
+# so that all events are sent to it.
+# ----------------------------------------------------------------------
+proc iw_lock {state} {
+ global widgets
+ if {$state} {
+ grab set $widgets(mainMenu)
+ . configure -cursor watch
+ } else {
+ grab release $widgets(mainMenu)
+ . configure -cursor ""
+ }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: iw_draw_hier <name>
+#
+# Queries the hierarchy for a particular class in demo <name> and
+# draws a class diagram into a display window. Usually invoked when
+# a demo is loaded to display the class hierarchy for the associated
+# widget.
+# ----------------------------------------------------------------------
+proc iw_draw_hier {name} {
+ global widgets
+ set canv $widgets(info-hier)
+ $canv delete all
+
+ set class [string toupper [string index $name 0]][string tolower [string range $name 1 end]]
+
+ if {[catch {namespace eval $class {info inherit}}] == 0} {
+ iw_draw_level $canv $class
+ set bbox [$canv bbox all]
+ $canv move all [lindex $bbox 0] [lindex $bbox 1]
+ update idletasks
+ $canv xview moveto 0
+ $canv yview moveto 0
+ }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: iw_draw_level <canv> <class>
+#
+# Draws one level of the hierarchy for <class>.
+# ----------------------------------------------------------------------
+proc iw_draw_level {canv class} {
+ set org [iw_draw_box $canv $class]
+ set top $org
+
+ set offset 0
+ foreach base [namespace eval $class {info inherit}] {
+ $canv lower [$canv create line $offset $org \
+ $offset [expr $top-10] \
+ -40 [expr $top-10] \
+ -24 [expr $top-10] \
+ -20 [expr $top-16] \
+ -16 [expr $top-10] \
+ -20 [expr $top-16] \
+ -20 [expr $top-26]]
+ $canv move all 20 [expr -($top-26+$org)]
+ set del [iw_draw_level $canv $base]
+ $canv move all -20 [expr $top-26+$org]
+ set top [expr $top+$del-30+$org]
+ incr offset 4
+ }
+ return $top
+}
+
+# ----------------------------------------------------------------------
+# USAGE: iw_draw_box <canv> <class>
+#
+# Draws one box for a class hierarchy onto a canvas window.
+# ----------------------------------------------------------------------
+proc iw_draw_box {canv class} {
+ set bg [option get $canv boxColor BoxColor]
+ set textbg [option get $canv boxTextColor BoxTextColor]
+
+ set cname [string trimleft $class :]
+ $canv create text 0 0 -anchor center -text $cname \
+ -fill $textbg -tags $class
+
+ set bbox [$canv bbox $class]
+ set x0 [expr [lindex $bbox 0]-4]
+ set y0 [expr [lindex $bbox 1]-4]
+ set x1 [expr [lindex $bbox 2]+4]
+ set y1 [expr [lindex $bbox 3]+4]
+
+ $canv create rectangle $x0 $y0 $x1 $y1 \
+ -outline black -fill $bg
+
+ $canv raise $class
+
+ return $y0
+}
+
+# ----------------------------------------------------------------------
+wm title . {[incr Widgets] Demo}
+wm geometry . 620x440
+
+frame .mbar -borderwidth 2 -relief raised
+pack .mbar -fill x
+set widgets(mainMenu) [menubutton .mbar.main -text "Main" -menu .mbar.main.m]
+pack .mbar.main -side left
+
+menu .mbar.main.m
+.mbar.main.m add command -label "About..." -command {.about activate}
+.mbar.main.m add separator
+.mbar.main.m add command -label "Quit" -command tcl_exit
+
+iwidgets::panedwindow .pw -orient vertical
+pack .pw -expand yes -fill both
+
+.pw add "widgets"
+set pane [.pw childsite "widgets"]
+set widgets(list) $pane.wlist
+
+iwidgets::scrolledlistbox $widgets(list) -labeltext "Select a widget:" \
+ -selectioncommand {iw_load_demo [$widgets(list) getcurselection]} \
+ -labelpos nw -vscrollmode dynamic -hscrollmode none \
+ -exportselection no
+pack $widgets(list) -expand yes -fill both -padx 8
+
+.pw add "info"
+set pane [.pw childsite "info"]
+set widgets(info) $pane.info
+
+set widgets(status) [label $pane.status]
+pack $pane.status -anchor w
+
+iwidgets::tabnotebook $widgets(info) -tabpos s
+pack $widgets(info) -expand yes -fill both
+
+set widgets(info-example) [$widgets(info) add -label "Example"]
+$widgets(info-example) configure -background white
+
+set win [$widgets(info) add -label "Example Code"]
+set widgets(info-code) [iwidgets::scrolledtext $win.code \
+ -wrap none -vscrollmode dynamic -hscrollmode none]
+pack $widgets(info-code) -expand yes -fill both -padx 4 -pady 4
+
+set win [$widgets(info) add -label "Inheritance"]
+set widgets(info-hier) [iwidgets::scrolledcanvas $win.canv -textbackground white \
+ -vscrollmode dynamic -hscrollmode dynamic]
+pack $widgets(info-hier) -expand yes -fill both -padx 4 -pady 4
+
+set win [$widgets(info) add -label "Man Page"]
+set widgets(info-manpage) [iwidgets::scrolledhtml $win.html \
+ -wrap word -vscrollmode dynamic -hscrollmode none \
+ -feedback "iw_manpage_progress" \
+ -linkcommand "$win.html import -link"]
+pack $widgets(info-manpage) -expand yes -fill both -padx 4 -pady 4
+
+set widgets(info-manpage-feedback) [iwidgets::feedback $win.html.fb \
+ -borderwidth 2 -relief raised]
+
+bind $widgets(info-manpage) <Map> {iw_load_manpage}
+
+.pw fraction 25 75
+$widgets(info) select "Example"
+
+# ----------------------------------------------------------------------
+# "About" window
+# ----------------------------------------------------------------------
+iwidgets::dialog .about -title {About: [incr Widgets] Demo} -modality none
+.about hide "Apply"
+.about hide "Help"
+.about hide "Cancel"
+.about buttonconfigure "OK" -command ".about deactivate"
+.about default "OK"
+
+set win [.about childsite]
+label $win.title -text {[incr Widgets]}
+pack $win.title
+catch {$win.title configure -font -*-helvetica-bold-o-normal-*-*-180-*}
+
+set file [file join ${iwidgets::library} demos iwidgets.gif]
+label $win.icon -image [image create photo -file $file]
+pack $win.icon -side left
+
+label $win.by -text "Contributed By"
+pack $win.by
+catch {$win.by configure -font -*-helvetica-medium-r-normal-*-*-100-*}
+
+label $win.authors -text "Mark L. Ulferts
+Sue Yockey
+John Sigler
+Bill Scott
+Alfredo Jahn
+Tako Schotanus
+Kris Raney"
+pack $win.authors
+catch {$win.authors configure -font -*-helvetica-medium-o-normal-*-*-120-*}
+
+# ----------------------------------------------------------------------
+# Load up a list of demos...
+# ----------------------------------------------------------------------
+foreach file [lsort [glob [file join ${iwidgets::library} demos *]]] {
+ set name [file tail $file]
+ if {![file isdirectory $file] && ![string match *.* $name]} {
+ $widgets(list) insert end $name
+ }
+}
+$widgets(list) selection set 0
+uplevel #0 [$widgets(list) cget -selectioncommand]
diff --git a/itcl/iwidgets3.0.0/demos/buttonbox b/itcl/iwidgets3.0.0/demos/buttonbox
new file mode 100755
index 00000000000..9da6977a6d7
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/buttonbox
@@ -0,0 +1,19 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: buttonbox in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+#
+# Demo script for Buttonbox class
+#
+iwidgets::buttonbox .bb
+
+.bb add OK -text OK -command "puts OK"
+.bb add Apply -text Apply -command "puts Apply"
+.bb add Cancel -text Cancel -command "puts Cancel"
+.bb default OK
+
+pack .bb -expand yes -fill both
diff --git a/itcl/iwidgets3.0.0/demos/calendar b/itcl/iwidgets3.0.0/demos/calendar
new file mode 100755
index 00000000000..c7d2cf855fb
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/calendar
@@ -0,0 +1,30 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: calendar in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# ----------------------------------------------------------------------
+option add *Calendar.buttonForeground black
+option add *Calendar.outline black
+option add *Calendar.weekdayBackground white
+option add *Calendar.weekendBackground mistyrose
+option add *Calendar.selectColor red
+. configure -background white
+
+iwidgets::calendar .cal
+pack .cal -expand yes -fill both
+
+iwidgets::optionmenu .days -labeltext "Start Day:" -command {
+ set day [.days get]
+ .cal configure -startday $day -days $caldays($day)
+}
+pack .days -padx 4 -pady 4
+
+array set caldays {
+ sunday {S M T W T F S}
+ monday {Mo Tu We Th Fr Sa Su}
+}
+.days insert end sunday monday
diff --git a/itcl/iwidgets3.0.0/demos/canvasprintdialog b/itcl/iwidgets3.0.0/demos/canvasprintdialog
new file mode 100755
index 00000000000..3dece3ab68f
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/canvasprintdialog
@@ -0,0 +1,36 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: canvasprintdialog in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+
+#
+# Make a canvas for the main application:
+#
+canvas .c -width 200 -height 200 -background white
+pack .c
+
+.c create rectangle 30 30 150 150 -fill blue
+.c create oval 70 70 190 190 -fill red
+.c create polygon 60 50 110 180 10 180 -fill green
+.c create text 100 5 -anchor n -text "Example Drawing"
+
+button .print -text "Print..." -command {
+ if {[.pcd activate]} {
+ puts "use command \".pcd print\" to really print"
+ } else {
+ puts "aborted"
+ }
+}
+pack .print
+
+iwidgets::canvasprintdialog .pcd -modality application \
+ -printcmd "lpr" -pagesize "A4"
+
+.pcd setcanvas .c
diff --git a/itcl/iwidgets3.0.0/demos/checkbox b/itcl/iwidgets3.0.0/demos/checkbox
new file mode 100755
index 00000000000..fe3fa8adc53
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/checkbox
@@ -0,0 +1,18 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: checkbox in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+#
+# Demo script for the Checkbox class
+#
+iwidgets::checkbox .cb -labeltext Styles
+.cb add bold -text Bold
+.cb add italic -text Italic
+.cb add underline -text Underline
+.cb select underline
+
+pack .cb -padx 10 -pady 10 -fill both -expand yes
diff --git a/itcl/iwidgets3.0.0/demos/combobox b/itcl/iwidgets3.0.0/demos/combobox
new file mode 100755
index 00000000000..6d02a762038
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/combobox
@@ -0,0 +1,19 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: combobox in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+
+iwidgets::combobox .cb -labeltext "Font:" -labelpos w -selectioncommand {
+ puts "selected: [.cb getcurselection]"
+}
+pack .cb
+
+.cb insert list end Ariel Courier Helvetica Knarly Lucida \
+ Rumpus Symbol Times "Zapf Dingbats"
diff --git a/itcl/iwidgets3.0.0/demos/dateentry b/itcl/iwidgets3.0.0/demos/dateentry
new file mode 100755
index 00000000000..bdfdade9327
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/dateentry
@@ -0,0 +1,18 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: dateentry in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+#
+# Demo script for dateentry class
+#
+proc returnCmd {} {
+ puts [.de get]
+}
+
+iwidgets::dateentry .de -labeltext "Date:" -command returnCmd
+pack .de -fill x -expand yes -padx 10 -pady 10
+
diff --git a/itcl/iwidgets3.0.0/demos/datefield b/itcl/iwidgets3.0.0/demos/datefield
new file mode 100755
index 00000000000..e348c7441dc
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/datefield
@@ -0,0 +1,17 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: datefield in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+#
+# Demo script for Datefield class
+#
+proc returnCmd {} {
+ puts [.df get]
+}
+
+iwidgets::datefield .df -labeltext "Date:" -command returnCmd
+pack .df -fill x -expand yes -padx 10 -pady 10
diff --git a/itcl/iwidgets3.0.0/demos/demo.html b/itcl/iwidgets3.0.0/demos/demo.html
new file mode 100644
index 00000000000..60819c50737
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/demo.html
@@ -0,0 +1,41 @@
+<title>Demo HTML Page</title>
+<body bgcolor="white" link="blue" vlink="NavyBlue" alink="red">
+<center>
+<img src="iwidgets.gif" alt="iwidgets logo"> <br>
+</center>
+<blockquote>
+<h2>Display Your HTML Pages</h2>
+<p>
+Now you can write all of your documentation in HTML format!
+You can publish it on the World Wide Web, or bundle it with
+your tool and display it using
+a <a href="html/hyperhelp.n.html">hyperhelp</a>
+or <a href="html/scrolledhtml.n.html">scrolledhtml</a> widget.
+
+<p>
+<hr size=3 width=95% align=center noshade>
+<p>
+
+Most of the usual HTML tags are recognized and supported.<br>
+So you can include things like:
+<p>
+<ul>
+<li> block quotes
+<li> <b>bold</b>
+<li> <tt>code</tt>
+<li> color images
+<li> definition lists
+<li> directory lists
+<li> <i>italic</i>
+<li> preformatted text
+<li> <sup>sup</sup>erscript
+<li> unordered lists
+<li> ...and much, <em>much</em> more!
+
+<p>
+<hr size=3 width=95% align=center noshade>
+<p>
+
+<big>Build it. Document it. Let us display it.</big>
+</blockquote>
+</body>
diff --git a/itcl/iwidgets3.0.0/demos/dialog b/itcl/iwidgets3.0.0/demos/dialog
new file mode 100755
index 00000000000..55b88b5f87d
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/dialog
@@ -0,0 +1,51 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: dialog in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+iwidgets::radiobox .rb -labeltext "Use modality to\nlock up your\napplication:"
+pack .rb -padx 4 -pady 4
+
+.rb add none -text "none"
+.rb add application -text "application"
+.rb add global -text "global"
+.rb select none
+
+button .activate -text "Push Me" -command {
+ .d configure -modality [.rb get]
+ .d activate
+}
+pack .activate
+
+#
+# Build a generic dialog
+#
+iwidgets::dialog .d
+.d buttonconfigure OK -command {
+ puts "pushed: OK"
+ .d deactivate 1
+}
+.d buttonconfigure Apply -command {
+ puts "pushed: Apply"
+}
+.d buttonconfigure Cancel -command {
+ puts "pushed: Cancel"
+ .d deactivate 0
+}
+.d buttonconfigure Help -command {
+ puts "pushed: Help"
+}
+
+#
+# Add something to the top of the dialog...
+#
+set win [.d childsite]
+label $win.ex -text "Standard Dialog\n(put your widgets here)" \
+ -background black -foreground white \
+ -width 40 -height 5
+pack $win.ex -expand yes -fill both -padx 4 -pady 4
diff --git a/itcl/iwidgets3.0.0/demos/dialogshell b/itcl/iwidgets3.0.0/demos/dialogshell
new file mode 100755
index 00000000000..325d8ba13ac
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/dialogshell
@@ -0,0 +1,40 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: dialogshell in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+iwidgets::radiobox .rb -labeltext "Use modality to\nlock up your\napplication:"
+pack .rb -padx 4 -pady 4
+
+.rb add none -text "none"
+.rb add application -text "application"
+.rb add global -text "global"
+.rb select none
+
+button .activate -text "Push Me" -command {
+ .ds configure -modality [.rb get]
+ .ds activate
+}
+pack .activate
+
+#
+# Build a generic dialog
+#
+iwidgets::dialogshell .ds
+
+.ds add dismiss -text "Dismiss" -command {.ds deactivate}
+.ds default dismiss
+
+#
+# Add something to the top of the dialog...
+#
+set win [.ds childsite]
+label $win.ex -text "Minimal Dialog\n(put your widgets here)" \
+ -background black -foreground white \
+ -width 40 -height 5
+pack $win.ex -expand yes -fill both -padx 4 -pady 4
diff --git a/itcl/iwidgets3.0.0/demos/disjointlistbox b/itcl/iwidgets3.0.0/demos/disjointlistbox
new file mode 100755
index 00000000000..a5bb447a684
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/disjointlistbox
@@ -0,0 +1,12 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: disjointlistbox in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+iwidgets::disjointlistbox .dlb
+pack .dlb -padx 10 -pady 10 -fill both -expand yes
+
+.dlb insertlhs {black white red blue yellow green magenta}
diff --git a/itcl/iwidgets3.0.0/demos/entryfield b/itcl/iwidgets3.0.0/demos/entryfield
new file mode 100755
index 00000000000..aacba604d5c
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/entryfield
@@ -0,0 +1,38 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: entryfield in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+. configure -background white
+
+iwidgets::entryfield .login -labeltext "Login:" -labelpos nw \
+ -command { focus [.passwd component entry] }
+pack .login -padx 4 -pady 4
+
+iwidgets::entryfield .passwd -labeltext "Password:" -labelpos nw -show "\267" \
+ -command { focus [.phone component entry] }
+pack .passwd -padx 4 -pady 4
+
+iwidgets::entryfield .phone -labeltext "Phone:" -labelpos nw \
+ -command { focus [.login component entry] } \
+ -validate {check_phonenum %W "%c"}
+pack .phone -padx 4 -pady 4
+
+proc check_phonenum {entry char} {
+ set current [$entry get]
+ set len [string length $current]
+ if {$len == 3 || $len == 7} {
+ $entry delete 0 end
+ $entry insert 0 "$current-"
+ }
+ if {$len < 12 && [string match {[0-9]} $char]} {
+ return 1
+ }
+ return 0
+}
diff --git a/itcl/iwidgets3.0.0/demos/extfileselectionbox b/itcl/iwidgets3.0.0/demos/extfileselectionbox
new file mode 100755
index 00000000000..880549b5170
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/extfileselectionbox
@@ -0,0 +1,14 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: extfileselectionbox in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+
+iwidgets::extfileselectionbox .fsb -width 4i -height 4i
+pack .fsb
diff --git a/itcl/iwidgets3.0.0/demos/extfileselectiondialog b/itcl/iwidgets3.0.0/demos/extfileselectiondialog
new file mode 100644
index 00000000000..564a77e1576
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/extfileselectiondialog
@@ -0,0 +1,18 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: extfileselectiondialog in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+iwidgets::extfileselectiondialog .efsd -modality application
+
+button .select -text "Files..." -command {
+ if {[.efsd activate]} {
+ puts "selected: [.efsd get]"
+ } else {
+ puts ""
+ }
+}
+pack .select -side left
diff --git a/itcl/iwidgets3.0.0/demos/feedback b/itcl/iwidgets3.0.0/demos/feedback
new file mode 100644
index 00000000000..3241b2f7c40
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/feedback
@@ -0,0 +1,26 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: feedback in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+
+frame .f -width 200 -height 100
+pack propagate .f no
+
+iwidgets::feedback .f.fb -labeltext "Status" -steps 22
+pack .f.fb -padx 4 -pady 4 -fill both -expand yes
+
+button .go -text "Go" -command {
+ .f.fb reset
+ for {set i 0} {$i < 22} {incr i} {
+ .f.fb step
+ after 100
+ }
+}
+pack .f
+pack .go -padx 4 -pady 4
diff --git a/itcl/iwidgets3.0.0/demos/fileselectionbox b/itcl/iwidgets3.0.0/demos/fileselectionbox
new file mode 100755
index 00000000000..e79801505a2
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/fileselectionbox
@@ -0,0 +1,14 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: fileselectionbox in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+
+iwidgets::fileselectionbox .fsb -width 4i -height 4i
+pack .fsb
diff --git a/itcl/iwidgets3.0.0/demos/fileselectiondialog b/itcl/iwidgets3.0.0/demos/fileselectiondialog
new file mode 100755
index 00000000000..ab85491d15f
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/fileselectiondialog
@@ -0,0 +1,18 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: fileselectiondialog in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+iwidgets::fileselectiondialog .fsd -modality application
+
+button .select -text "Files..." -command {
+ if {[.fsd activate]} {
+ puts "selected: [.fsd get]"
+ } else {
+ puts ""
+ }
+}
+pack .select -side left
diff --git a/itcl/iwidgets3.0.0/demos/finddialog b/itcl/iwidgets3.0.0/demos/finddialog
new file mode 100755
index 00000000000..d45ccd8387d
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/finddialog
@@ -0,0 +1,225 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: finddialog in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+#
+# Demo script for the Finddialog class
+#
+proc find {} {
+ if {! [winfo exists .findd]} {
+ iwidgets::finddialog .findd -textwidget .st
+ }
+
+ .findd center .st
+ .findd activate
+}
+
+iwidgets::scrolledtext .st -visibleitems 50x14 -wrap none
+pack .st
+
+button .findb -text "Press to Search Text" -command find
+pack .findb -pady 5
+
+.st insert end "
+ The Declaration of Independence
+ (Adopted in Congress 4 July 1776)
+
+When, in the course of human events, it becomes necessary for one
+people to dissolve the political bonds which have connected them with
+another, and to assume among the powers of the earth, the separate and
+equal station to which the laws of nature and of nature's God entitle
+them, a decent respect to the opinions of mankind requires that they
+should declare the causes which impel them to the separation.
+
+We hold these truths to be self-evident, that all men are created
+equal, that they are endowed by their Creator with certain unalienable
+rights, that among these are life, liberty and the pursuit of
+happiness. That to secure these rights, governments are instituted
+among men, deriving their just powers form the consent of the
+governed. That whenever any form of government becomes destructive to
+these ends, it is the right of the people to alter or to abolish it,
+and to institute new government, laying its foundation on such
+principles and organizing its powers in such form, as to them shall
+seem most likely to effect their safety and happiness. Prudence,
+indeed, will dictate that governments long established should not be
+changed for light and transient causes; and accordingly all experience
+hath shown that mankind are more disposed to suffer, while evils are
+sufferable, than to right themselves by abolishing the forms to which
+they are accustomed. But when a long train of abuses and usurpations,
+pursuing invariably the same object evinces a design to reduce them
+under absolute despotism, it is their right, it is their duty, to
+throw off such government, and to provide new guards for their future
+security. --Such has been the patient sufferance of these colonies;
+and such is now the necessity which constrains them to alter their
+former systems of government. The history of the present King of Great
+Britain is a history of repeated injuries and usurpations, all having
+in direct object the establishment of an absolute tyranny over these
+states. To prove this, let facts be submitted to a candid world.
+
+He has refused his assent to laws, the most wholesome and necessary
+for the public good.
+
+He has forbidden his governors to pass laws of immediate and pressing
+importance, unless suspended in their operation till his assent should
+be obtained; and when so suspended, he has utterly neglected to attend
+to them.
+
+He has refused to pass other laws for the accommodation of large
+districts of people, unless those people would relinquish the right of
+representation in the legislature, a right inestimable to them and
+formidable to tyrants only.
+
+He has called together legislative bodies at places unusual,
+uncomfortable, and distant from the depository of their public
+records, for the sole purpose of fatiguing them into compliance with
+his measures.
+
+He has dissolved representative houses repeatedly, for opposing with
+manly firmness his invasions on the rights of the people.
+
+He has refused for a long time, after such dissolutions, to cause
+others to be elected; whereby the legislative powers, incapable of
+annihilation, have returned to the people at large for their exercise;
+the state remaining in the meantime exposed to all the dangers of
+invasion from without, and convulsions within.
+
+He has endeavored to prevent the population of these states; for that
+purpose obstructing the laws for naturalization of foreigners;
+refusing to pass others to encourage their migration hither, and
+raising the conditions of new appropriations of lands.
+
+He has obstructed the administration of justice, by refusing his
+assent to laws for establishing judiciary powers.
+
+He has made judges dependent on his will alone, for the tenure of
+their offices, and the amount and payment of their salaries.
+
+He has erected a multitude of new offices, and sent hither swarms of
+officers to harass our people, and eat out their substance.
+
+He has kept among us, in times of peace, standing armies without the
+consent of our legislature.
+
+He has affected to render the military independent of and superior to
+civil power.
+
+He has combined with others to subject us to a jurisdiction foreign to
+our constitution, and unacknowledged by our laws; giving his assent to
+their acts of pretended legislation:
+
+For quartering large bodies of armed troops among us:
+
+For protecting them, by mock trial, from punishment for any murders
+which they should commit on the inhabitants of these states:
+
+For cutting off our trade with all parts of the world:
+
+For imposing taxes on us without our consent:
+
+For depriving us in many cases, of the benefits of trial by jury:
+
+For transporting us beyond seas to be tried for pretended offenses:
+
+For abolishing the free system of English laws in a neighboring
+province, establishing therein an arbitrary government, and enlarging
+its boundaries so as to render it at once an example and fit
+instrument for introducing the same absolute rule in these colonies:
+
+For taking away our charters, abolishing our most valuable laws, and
+altering fundamentally the forms of our governments:
+
+For suspending our own legislatures, and declaring themselves invested
+with power to legislate for us in all cases whatsoever.
+
+He has abdicated government here, by declaring us out of his
+protection and waging war against us.
+
+He has plundered our seas, ravaged our coasts, burned our towns, and
+destroyed the lives of our people.
+
+He is at this time transporting large armies of foreign mercenaries to
+complete the works of death, desolation and tyranny, already begun
+with circumstances of cruelty and perfidy scarcely paralleled in the
+most barbarous ages, and totally unworthy the head of a civilized
+nation.
+
+He has constrained our fellow citizens taken captive on the high seas
+to bear arms against their country, to become the executioners of
+their friends and brethren, or to fall themselves by their hands.
+
+He has excited domestic insurrections amongst us, and has endeavored
+to bring on the inhabitants of our frontiers, the merciless Indian
+savages, whose known rule of warfare, is undistinguished destruction
+of all ages, sexes and conditions.
+
+In every stage of these oppressions we have petitioned for redress in
+the most humble terms: our repeated petitions have been answered only
+by repeated injury. A prince, whose character is thus marked by every
+act which may define a tyrant, is unfit to be the ruler of a free
+people.
+
+Nor have we been wanting in attention to our British brethren. We have
+warned them from time to time of attempts by their legislature to
+extend an unwarrantable jurisdiction over us. We have reminded them of
+the circumstances of our emigration and settlement here. We have
+appealed to their native justice and magnanimity, and we have conjured
+them by the ties of our common kindred to disavow these usurpations,
+which, would inevitably interrupt our connections and
+correspondence. We must, therefore, acquiesce in the necessity, which
+denounces our separation, and hold them, as we hold the rest of
+mankind, enemies in war, in peace friends.
+
+We, therefore, the representatives of the United States of America, in
+General Congress, assembled, appealing to the Supreme Judge of the
+world for the rectitude of our intentions, do, in the name, and by the
+authority of the good people of these colonies, solemnly publish and
+declare, that these united colonies are, and of right ought to be free
+and independent states; that they are absolved from all allegiance to
+the British Crown, and that all political connection between them and
+the state of Great Britain, is and ought to be totally dissolved; and
+that as free and independent states, they have full power to levy war,
+conclude peace, contract alliances, establish commerce, and to do all
+other acts and things which independent states may of right do. And
+for the support of this declaration, with a firm reliance on the
+protection of Divine Providence, we mutually pledge to each other our
+lives, our fortunes and our sacred honor.
+
+New Hampshire: Josiah Bartlett, William Whipple, Matthew Thornton
+
+Massachusetts: John Hancock, Samual Adams, John Adams, Robert Treat
+Paine, Elbridge Gerry
+
+Rhode Island: Stephen Hopkins, William Ellery
+
+Connecticut: Roger Sherman, Samuel Huntington, William Williams,
+Oliver Wolcott
+
+New York: William Floyd, Philip Livingston, Francis Lewis, Lewis
+Morris
+
+New Jersey: Richard Stockton, John Witherspoon, Francis Hopkinson,
+John Hart, Abraham Clark
+
+Pennsylvania: Robert Morris, Benjamin Rush, Benjamin Franklin, John
+Morton, George Clymer, James Smith, George Taylor, James Wilson,
+George Ross
+
+Delaware: Caesar Rodney, George Read, Thomas McKean
+
+Maryland: Samuel Chase, William Paca, Thomas Stone, Charles Carroll of
+Carrollton
+
+Virginia: George Wythe, Richard Henry Lee, Thomas Jefferson, Benjamin
+Harrison, Thomas Nelson, Jr., Francis Lightfoot Lee, Carter Braxton
+
+North Carolina: William Hooper, Joseph Hewes, John Penn
+
+South Carolina: Edward Rutledge, Thomas Heyward, Jr., Thomas Lynch,
+Jr., Arthur Middleton
+
+Georgia: Button Gwinnett, Lyman Hall, George Walton
+"
diff --git a/itcl/iwidgets3.0.0/demos/hierarchy b/itcl/iwidgets3.0.0/demos/hierarchy
new file mode 100755
index 00000000000..4812127505f
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/hierarchy
@@ -0,0 +1,160 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: buttonbox in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+#
+# Demo script for the Hierarchy class.
+#
+# This demo displays a users file system starting at thier HOME
+# directory. You can change the starting directory by setting the
+# environment variable SHOWDIR.
+#
+if {![info exists env(SHOWDIR)]} {
+ set env(SHOWDIR) $env(HOME)
+}
+
+# ----------------------------------------------------------------------
+# PROC: get_files file
+#
+# Used as the -querycommand for the hierarchy viewer. Returns the
+# list of files under a particular directory. If the file is "",
+# then the SHOWDIR is used as the directory. Otherwise, the node itself
+# is treated as a directory. The procedure returns a unique id and
+# the text to be displayed for each file. The unique id is the complete
+# path name and the text is the file name.
+# ----------------------------------------------------------------------
+proc get_files {file} {
+ global env
+
+ if {$file == ""} {
+ set dir $env(SHOWDIR)
+ } else {
+ set dir $file
+ }
+
+ if {[catch {cd $dir}] != 0} {
+ return ""
+ }
+
+ set rlist ""
+
+ foreach file [lsort [glob -nocomplain *]] {
+ lappend rlist [list [file join $dir $file] $file]
+ }
+
+ return $rlist
+}
+
+# ----------------------------------------------------------------------
+# PROC: select_node tags status
+#
+# Select/Deselect the node given the tags and current selection status.
+# The unique id which is the complete file path name is mixed in with
+# all the tags for the node. So, we'll find it by searching for our
+# SHOWDIR and then doing the selection or deselection.
+# ----------------------------------------------------------------------
+proc select_node {tags status} {
+ global env
+
+ set uid [lindex $tags [lsearch -regexp $tags $env(SHOWDIR)]]
+
+ if {$status} {
+ .h selection remove $uid
+ } else {
+ .h selection add $uid
+ }
+}
+
+# ----------------------------------------------------------------------
+# PROC: expand_node tags
+#
+# Expand the node given the tags. The unique id which is the complete
+# file path name is mixed in with all the tags for the node. So, we'll
+# find it by searching for our SHOWDIR and then doing the expansion.
+# ----------------------------------------------------------------------
+proc expand_node {tags} {
+ global env
+
+ set uid [lindex $tags [lsearch -regexp $tags $env(SHOWDIR)]]
+
+ .h expand $uid
+}
+
+# ----------------------------------------------------------------------
+# PROC: collapse_node tags
+#
+# Collapse the node given the tags. The unique id which is the complete
+# file path name is mixed in with all the tags for the node. So, we'll
+# find it by searching for our SHOWDIR and then doing the collapse.
+# ----------------------------------------------------------------------
+proc collapse_node {tags} {
+ global env
+
+ set uid [lindex $tags [lsearch -regexp $tags $env(SHOWDIR)]]
+
+ .h collapse $uid
+}
+
+# ----------------------------------------------------------------------
+# PROC: expand_recursive
+#
+# Recursively expand all the file nodes in the hierarchy.
+# ----------------------------------------------------------------------
+proc expand_recursive {node} {
+ set files [get_files $node]
+
+ foreach tagset $files {
+ set uid [lindex $tagset 0]
+
+ .h expand $uid
+
+ if {[get_files $uid] != {}} {
+ expand_recursive $uid
+ }
+ }
+}
+
+# ----------------------------------------------------------------------
+# PROC: expand_all
+#
+# Expand all the file nodes in the hierarchy.
+# ----------------------------------------------------------------------
+proc expand_all {} {
+ expand_recursive ""
+}
+
+# ----------------------------------------------------------------------
+# PROC: collapse_all
+#
+# Collapse all the nodes in the hierarchy.
+# ----------------------------------------------------------------------
+proc collapse_all {} {
+ .h configure -querycommand "get_files %n"
+}
+
+#
+# Create the hierarchy mega-widget, adding commands to both the item
+# and background popup menus.
+#
+iwidgets::hierarchy .h -querycommand "get_files %n" -visibleitems 30x15 \
+ -labeltext $env(SHOWDIR) -selectcommand "select_node %n %s"
+pack .h -side left -expand yes -fill both
+
+.h component itemMenu add command -label "Select" \
+ -command {select_node [.h current] 0}
+.h component itemMenu add command -label "Deselect" \
+ -command {select_node [.h current] 1}
+.h component itemMenu add separator
+.h component itemMenu add command -label "Expand" \
+ -command {expand_node [.h current]}
+.h component itemMenu add command -label "Collapse" \
+ -command {collapse_node [.h current]}
+
+.h component bgMenu add command -label "Expand All" -command expand_all
+.h component bgMenu add command -label "Collapse All" -command collapse_all
+.h component bgMenu add command -label "Clear Selections" \
+ -command {.h selection clear}
diff --git a/itcl/iwidgets3.0.0/demos/html/buttonbox.n.html b/itcl/iwidgets3.0.0/demos/html/buttonbox.n.html
new file mode 100644
index 00000000000..33211248355
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/buttonbox.n.html
@@ -0,0 +1,245 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - buttonbox</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - buttonbox</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ buttonbox - Create and manipulate a manager widget for but-
+ tons
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>buttonbox</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- buttonbox
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>background</STRONG> <STRONG>cursor</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>orient</STRONG>
+ Class: <STRONG>Orient</STRONG>
+ Command-Line Switch: <STRONG>-orient</STRONG>
+
+ Orientation of the button box: <STRONG>horizontal</STRONG> or <STRONG>vertical</STRONG>.
+ The default is horizontal.
+
+ Name: <STRONG>padX</STRONG>
+ Class: <STRONG>PadX</STRONG>
+ Command-Line Switch: <STRONG>-padx</STRONG>
+
+ Specifies a non-negative padding distance to leave
+ between the button group and the outer edge of the but-
+ ton box in the x direction. The value may be given in
+ any of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The
+ default is 5 pixels.
+
+ Name: <STRONG>padY</STRONG>
+ Class: <STRONG>PadY</STRONG>
+ Command-Line Switch: <STRONG>-pady</STRONG>
+
+ Specifies a non-negative padding distance to leave
+ between the button group and the outer edge of the but-
+ ton box in the y direction. The value may be given in
+ any of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The
+ default is 5 pixels.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>buttonbox</STRONG> command creates a manager widget for control-
+ ling buttons. The button box also supports the display and
+ invocation of a default button. The button box can be con-
+ figured either horizontally or vertically.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>buttonbox</STRONG> command creates a new Tcl command whose name
+ is <EM>pathName</EM>. This command may be used to invoke various
+ operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand.
+
+ Many of the widget commands for the buttonbox take as one
+ argument an indicator of which button of the button box to
+ operate on. These indicators are called <EM>indexes</EM> and allow
+ reference and manipulation of buttons regardless of their
+ current map state. buttonbox indexes may be specified in
+ any of the following forms:
+
+ <EM>number</EM> Specifies the button numerically, where 0
+ corresponds to the left/top-most button of the
+ button box.
+
+ <STRONG>end</STRONG> Indicates the right/bottom-most button of the
+ button box.
+
+ <STRONG>default</STRONG> Indicates the current default button of the but-
+ ton box. This is the button with the default
+ ring displayed.
+
+ <EM>pattern</EM> If the index doesn't satisfy one of the above
+ forms then this form is used. <EM>Pattern</EM> is
+ pattern-matched against the tag of each button
+ in the button box, in order from left/top to
+ right/left, until a matching entry is found.
+ The rules of <STRONG>Tcl_StringMatch</STRONG> are used.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>add</STRONG> <EM>tag</EM> <EM>args</EM>
+ Add a button distinguished by <EM>tag</EM> to the end of the
+ button box. If additional arguments are present they
+ specify options to be applied to the button. See <STRONG>Push-</STRONG>
+ <STRONG>Button</STRONG> for information on the options available.
+
+ <EM>pathName</EM> <STRONG>buttonconfigure</STRONG> <EM>index</EM> ?<EM>options</EM>?
+ This command is similar to the <STRONG>configure</STRONG> command,
+ except that it applies to the options for an individual
+ button, whereas <STRONG>configure</STRONG> applies to the options for
+ the button box as a whole. <EM>Options</EM> may have any of the
+ values accepted by the <STRONG>PushButton</STRONG> command. If <EM>options</EM>
+ are specified, options are modified as indicated in the
+ command and the command returns an empty string. If no
+ <EM>options</EM> are specified, returns a list describing the
+ current options for entry <EM>index</EM> (see <STRONG>Tk_ConfigureInfo</STRONG>
+ for information on the format of this list).
+
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>buttonbox</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>buttonbox</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>default</STRONG> <EM>index</EM>
+ Sets the default button to the button given by <EM>index</EM>.
+ This causes the default ring to appear arround the
+ specified button.
+
+ <EM>pathName</EM> <STRONG>delete</STRONG> <EM>index</EM>
+ Deletes the button given by <EM>index</EM> from the button box.
+
+ <EM>pathName</EM> <STRONG>hide</STRONG> <EM>index</EM>
+ Hides the button denoted by <EM>index</EM>. This doesn't remove
+ the button permanently, just inhibits its display.
+
+ <EM>pathName</EM> <STRONG>index</STRONG> <EM>index</EM>
+ Returns the numerical index corresponding to <EM>index</EM>.
+
+ <EM>pathName</EM> <STRONG>insert</STRONG> <EM>index</EM> <EM>tag</EM> ?<EM>option</EM> <EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Same as the <STRONG>add</STRONG> command except that it inserts the new
+ button just before the one given by <EM>index</EM>, instead of
+ appending to the end of the button box. The <EM>option</EM>,
+ and <EM>value</EM> arguments have the same interpretation as for
+ the <STRONG>add</STRONG> widget command.
+
+ <EM>pathName</EM> <STRONG>invoke</STRONG> ?<EM>index</EM>?
+ Invoke the command associated with a button. If no
+ arguments are given then the current default button is
+ invoked, otherwise the argument is expected to be a
+ button <EM>index</EM>.
+
+ <EM>pathName</EM> <STRONG>show</STRONG> <EM>index</EM>
+ Display a previously hidden button denoted by <EM>index</EM>.
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ buttonbox .bb
+
+ .bb add Yes -text Yes -command "puts Yes"
+ .bb add No -text No -command "puts No"
+ .bb add Maybe -text Maybe -command "puts Maybe"
+ .bb default Yes
+
+ pack .bb -expand yes -fill both
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Bret A. Schuhmacher
+
+ Mark L. Ulferts
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ buttonbox, pushbutton, button, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/canvasprintbox.n.html b/itcl/iwidgets3.0.0/demos/html/canvasprintbox.n.html
new file mode 100644
index 00000000000..a103402def1
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/canvasprintbox.n.html
@@ -0,0 +1,302 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - canvasprintbox</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - canvasprintbox</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ canvasprintbox - Create and manipulate a canvas print box
+ widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>canvasprintbox</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- Canvasprintbox
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>activeBackground</STRONG> <STRONG>background</STRONG> <STRONG>borderWidthcursor</STRONG>
+ <STRONG>foreground</STRONG> <STRONG>highlightBackground</STRONG> <STRONG>highlightColorhighlightThickness</STRONG>
+ <STRONG>insertBackground</STRONG> <STRONG>insertBorderWidthinsertOffTimeinsertOnTime</STRONG>
+ <STRONG>insertWidth</STRONG> <STRONG>relief</STRONG> <STRONG>repeatDelay</STRONG> <STRONG>repeatInterval</STRONG>
+ <STRONG>selectBackground</STRONG> <STRONG>selectBorderWidthselectForeground</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>filename</STRONG>
+ Class: <STRONG>FileName</STRONG>
+ Command-Line Switch: <STRONG>-filename</STRONG>
+
+ The file to write the postscript output to (Only when
+ output is set to "file"). If posterizing is turned on
+ and <STRONG>hpagecnt</STRONG> and/or <STRONG>vpagecnt</STRONG> is more than 1, x.y is
+ appended to the filename where x is the horizontal page
+ number and y the vertical page number.
+
+ Name: <STRONG>hpagecnt</STRONG>
+ Class: <STRONG>PageCnt</STRONG>
+ Command-Line Switch: <STRONG>-hpagecnt</STRONG>
+
+ Is used in combination with <STRONG>posterize</STRONG> to determine over
+ how many pages the output should be distributed. This
+ attribute specifies how many pages should be used hor-
+ izontaly. Any change to this attribute will automati-
+ cally update the "stamp". Defaults to 1.
+
+ Name: <STRONG>orient</STRONG>
+ Class: <STRONG>Orient</STRONG>
+ Command-Line Switch: <STRONG>-orient</STRONG>
+
+ Determines the orientation of the output to the printer
+ (or file). It can take the value "portrait" or
+ "landscape" (default). Changes to this attribute will
+ be reflected immediately in the "stamp". Defaults to
+ "landscape" but will be changed automaticaly to the
+ value deemed appropiate for the current canvas. Setting
+ this attribute when the canvasprintbox is first con-
+ structed (instead of using the "configure" method) will
+ turn off the auto adjustment of this attribute.
+
+ Name: <STRONG>output</STRONG>
+ Class: <STRONG>Output</STRONG>
+ Command-Line Switch: <STRONG>-output</STRONG>
+
+ Specifies where the postscript output should go: to the
+ printer or to a file. Can take on the values "printer"
+ or "file". The corresponding entry-widget will reflect
+ the contents of either the <STRONG>printcmd</STRONG> attribute or the
+ <STRONG>filename</STRONG> attribute. Defaults to "printer".
+
+ Name: <STRONG>pageSize</STRONG>
+ Class: <STRONG>PageSize</STRONG>
+ Command-Line Switch: <STRONG>-pagesize</STRONG>
+
+ The pagesize the printer supports. Changes to this
+ attribute will be reflected immediately in the "stamp".
+ Defaults to "a4".
+
+ Name: <STRONG>posterize</STRONG>
+ Class: <STRONG>Posterize</STRONG>
+ Command-Line Switch: <STRONG>-posterize</STRONG>
+
+ Indicates if posterizing is turned on or not. Posteriz-
+ ing the output means that it is possible to distribute
+ the output over more than one page. This way it is pos-
+ sible to print a canvas/region which is larger than the
+ specified pagesize without stretching. If used in com-
+ bination with stretching it can be used to "blow up"
+ the contents of a canvas to as large as size as you
+ want (See attributes: hpagecnt and vpagecnt). Any
+ change to this attribute will automatically update the
+ "stamp". Defaults to 0.
+
+ Name: <STRONG>printCmd</STRONG>
+ Class: <STRONG>PrintCmd</STRONG>
+ Command-Line Switch: <STRONG>-printcmd</STRONG>
+
+ The command to execute when printing the postscript
+ output. The command will get the postscript directed
+ to its standard input (Only when output is set to
+ "printer"). Defaults to "lpr".
+
+ Name: <STRONG>printRegion</STRONG>
+ Class: <STRONG>PrintRegion</STRONG>
+ Command-Line Switch: <STRONG>-printregion</STRONG>
+
+ A list of four coordinates specifying which part of the
+ canvas to print. An empty list means that the canvas'
+ entire <STRONG>scrollregion</STRONG> should be printed. Any change to
+ this attribute will automatically update the "stamp".
+ Defaults to an empty list.
+
+ Name: <STRONG>stretch</STRONG>
+ Class: <STRONG>Stretch</STRONG>
+ Command-Line Switch: <STRONG>-stretch</STRONG>
+
+ Determines if the output should be stretched to fill
+ the page (as defined by the attribute pagesize) as
+ large as possible. The aspect-ratio of the output will
+ be retained and the output will never fall outside of
+ the boundaries of the page. Defaults to 0 but will be
+ changed automaticaly to the value deemed appropiate for
+ the current canvas. Setting this attribute when the
+ canvasprintbox is first constructed (instead of using
+ the "configure" method) will turn off the auto adjust-
+ ment of this attribute.
+
+ Name: <STRONG>vPageCnt</STRONG>
+ Class: <STRONG>PageCnt</STRONG>
+ Command-Line Switch: <STRONG>-vpagecnt</STRONG>
+
+ Is used in combination with "posterize" to determine
+ over how many pages the output should be distributed.
+ This attribute specifies how many pages should be used
+ verticaly. Any change to this attribute will automati-
+ cally update the "stamp". Defaults to 1.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ Implements a print box for printing the contents of a canvas
+ widget to a printer or a file. It is possible to specify
+ page orientation, the number of pages to print the image on
+ and if the output should be stretched to fit the page.
+ Options exist to control the appearance and actions of the
+ widget.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>canvasprintbox</STRONG> command creates a new Tcl command whose
+ name is <EM>pathName</EM>. This command may be used to invoke vari-
+ ous operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for can-
+ vasprintbox widgets:
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>canvasprintbox</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>canvasprintbox</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>getoutput</STRONG>
+ Returns the value of the <STRONG>printercmd</STRONG> or <STRONG>filename</STRONG> option
+ depending on the current setting of <STRONG>output</STRONG>.
+
+ <EM>pathName</EM> <STRONG>print</STRONG>
+ Perfrom the actual printing of the canvas using the
+ current settings of all the attributes. Returns a
+ boolean indicating wether the printing was successful
+ or not.
+
+ <EM>pathName</EM> <STRONG>refresh</STRONG>
+ Retrieves the current value for all edit fields and
+ updates the stamp accordingly. Is useful for Apply-
+ buttons.
+
+ <EM>pathName</EM> <STRONG>setcanvas</STRONG> <EM>canvas</EM>
+ This is used to set the <EM>canvas</EM> that has to be printed.
+ A stamp-sized copy will automatically be drawn to show
+ how the output would look with the current settings.
+
+ <EM>pathName</EM> <STRONG>stop</STRONG>
+ Stops the drawing of the "stamp". I'm currently unable
+ to detect when a Canvasprintbox gets destroyed or with-
+ drawn. It's therefore advised that you perform a stop
+ before you do something like that.
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>prtflentry</STRONG>
+ Class: <STRONG>Entry</STRONG>
+
+ The prtflentry component is the entry field for user
+ input of the <STRONG>filename</STRONG> or <STRONG>printer</STRONG> command (depending on
+ the value of <STRONG>output</STRONG>).
+
+ Name: <STRONG>hpcnt</STRONG>
+ Class: <STRONG>Entry</STRONG>
+
+ The hpcnt component is the entry field for user input
+ of the number of pages to use horizontaly when <STRONG>poster-</STRONG>
+ <STRONG>ize</STRONG> is turned on.
+ Name: <STRONG>vpcnt</STRONG>
+ Class: <STRONG>Entry</STRONG>
+
+ The vpcnt component is the entry field for user input
+ of the number of pages to use verticaly when <STRONG>posterize</STRONG>
+ is turned on.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ option add *textBackground GhostWhite
+
+ canvasprintbox .fsb -orient landscape -stretch 1
+ pack .fsb -padx 10 -pady 10 -fill both -expand yes
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Tako Schotanus
+
+ Tako.Schotanus@bouw.tno.nl
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ canvasprintbox, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/canvasprintdialog.n.html b/itcl/iwidgets3.0.0/demos/html/canvasprintdialog.n.html
new file mode 100644
index 00000000000..3a5ee09c407
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/canvasprintdialog.n.html
@@ -0,0 +1,203 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - canvasprintdialog</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - canvasprintdialog</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ canvasprintdialog - Create and manipulate a canvas print
+ dialog widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>canvasprintdialog</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Toplevel &lt;- Dialogshell &lt;- Dialog &lt;- Canvasprintdialog
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>activeBackground</STRONG> <STRONG>background</STRONG> <STRONG>borderWidthcursor</STRONG>
+ <STRONG>foreground</STRONG> <STRONG>highlightBackground</STRONG> <STRONG>highlightColorhighlightThickness</STRONG>
+ <STRONG>insertBackground</STRONG> <STRONG>insertBorderWidthinsertOffTimeinsertOnTime</STRONG>
+ <STRONG>insertWidth</STRONG> <STRONG>relief</STRONG> <STRONG>repeatDelay</STRONG> <STRONG>repeatInterval</STRONG>
+ <STRONG>selectBackground</STRONG> <STRONG>selectBorderWidthselectForeground</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+ <STRONG>filename</STRONG> <STRONG>hpagecnt</STRONG> <STRONG>orient</STRONG> <STRONG>output</STRONG>
+ <STRONG>pagesize</STRONG> <STRONG>posterize</STRONG> <STRONG>printcmd</STRONG> <STRONG>printregion</STRONG>
+ <STRONG>vpagecnt</STRONG>
+
+ See the "canvasprintbox" widget manual entry for details on
+ the above associated options.
+
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>buttonBoxPadX</STRONG> <STRONG>buttonBoxPadY</STRONG> <STRONG>buttonBoxPos</STRONG> <STRONG>padX</STRONG>
+ <STRONG>padY</STRONG> <STRONG>separator</STRONG> <STRONG>thickness</STRONG>
+
+ See the "dialogshell" widget manual entry for details on the
+ above inherited options.
+
+ <STRONG>master</STRONG> <STRONG>modality</STRONG> <STRONG>title</STRONG>
+
+ See the "shell" widget manual entry for details on the above
+ inherited options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>canvasprintdialog</STRONG> command creates a print dialog for
+ printing the contents of a canvas widget to a printer or a
+ file. It is possible to specify page orientation, the number
+ of pages to print the image on and if the output should be
+ stretched to fit the page.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>canvasprintdialog</STRONG> command creates a new Tcl command
+ whose name is <EM>pathName</EM>. This command may be used to invoke
+ various operations on the widget. It has the following gen-
+ eral form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for can-
+ vasprintdialog widgets:
+
+
+</PRE>
+<H2>ASSOCIATED METHODS</H2><PRE>
+ <STRONG>getoutput</STRONG> <STRONG>setcanvas</STRONG> <STRONG>refresh</STRONG> <STRONG>print</STRONG>
+
+ See the "canvasprintbox" class manual entry for details on
+ the associated methods.
+
+
+</PRE>
+<H2>INHERITED METHODS</H2><PRE>
+ <STRONG>add</STRONG> <STRONG>buttonconfigure</STRONG> <STRONG>defaulthide</STRONG>
+ <STRONG>insert</STRONG> <STRONG>invoke</STRONG> <STRONG>show</STRONG>
+
+ See the "buttonbox" widget manual entry for details on the
+ above inherited methods.
+
+ <STRONG>activate</STRONG> <STRONG>deactivate</STRONG>
+
+ See the "dialogshell" widget manual entry for details on the
+ above inherited methods.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>canvasprintdialog</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>canvasprintdialog</STRONG> com-
+ mand.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>cpb</STRONG>
+ Class: <STRONG>Canvasprintbox</STRONG>
+
+ The cpb component is the canvas print box for the can-
+ vas print dialog. See the "canvasprintbox" widget
+ manual entry for details on the cpb component item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ option add *textBackground white
+
+ canvasprintdialog .cpb
+ .cpb activate
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Tako Schotanus
+
+ Tako.Schotanus@bouw.tno.nl
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ canvasprintdialog, canvasprintbox, dialog, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/combobox.n.html b/itcl/iwidgets3.0.0/demos/html/combobox.n.html
new file mode 100644
index 00000000000..db2f54e32c9
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/combobox.n.html
@@ -0,0 +1,411 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - combobox</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - combobox</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ combobox - Create and manipulate combination box widgets
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>combobox</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- LabeledWidget &lt;- Entryfield &lt;- Combobox
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>background</STRONG> <STRONG>borderWidth</STRONG> <STRONG>cursor</STRONG> <STRONG>exportSelection</STRONG>
+ <STRONG>foreground</STRONG> <STRONG>highlightColor</STRONG> <STRONG>highlightThicknessinsertBackground</STRONG>
+ <STRONG>insertBorderWidth</STRONG> <STRONG>insertOffTime</STRONG> <STRONG>insertOnTimeinsertWidth</STRONG>
+ <STRONG>justify</STRONG> <STRONG>relief</STRONG> <STRONG>selectBackgroundselectBorderWidth</STRONG>
+ <STRONG>selectForeground</STRONG> <STRONG>textVariable</STRONG> <STRONG>width</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+ <STRONG>hscrollmode</STRONG> <STRONG>items</STRONG> <STRONG>textBackground</STRONG> <STRONG>textFont</STRONG>
+ <STRONG>vscrollmode</STRONG>
+
+ See the "scrolledlistbox" manual entry for details on the
+ above inherited options.
+
+ <STRONG>show</STRONG> <STRONG>state</STRONG>
+
+ See the "entry" manual entry for details on the above inher-
+ ited options.
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>childSitePos</STRONG> <STRONG>command</STRONG> <STRONG>fixed</STRONG> <STRONG>focusCommand</STRONG>
+ <STRONG>invalid</STRONG> <STRONG>textBackground</STRONG> <STRONG>textFont</STRONG> <STRONG>validate</STRONG>
+
+ See the "entryfield" class manual entry for details on the
+ inherited options.
+
+ <STRONG>labelBitmap</STRONG> <STRONG>labelFont</STRONG> <STRONG>labelImage</STRONG> <STRONG>labelMargin</STRONG>
+ <STRONG>labelPos</STRONG> <STRONG>labelText</STRONG> <STRONG>labelVariable</STRONG>
+
+ See the "labeledwidget" class manual entry for details on
+ the inherited options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>autoClear</STRONG>
+ Class: <STRONG>AutoClear</STRONG>
+ Command-Line Switch: <STRONG>-autoclear</STRONG>
+
+ Boolean value that specifies wheather or not to clear
+ the entry field as items are added to the list given in
+ any of the forms acceptable to <STRONG>Tcl_GetBoolean</STRONG>. The
+ default is true.
+
+ Name: <STRONG>arrowRelief</STRONG>
+ Class: <STRONG>Relief</STRONG>
+ Command-Line Switch: <STRONG>-arrowrelief</STRONG>
+
+ Specifies the relief style to use for a dropdown
+ Combobox's arrow button in a normal (not depressed)
+ state. Acceptable values are <STRONG>raised</STRONG>, <STRONG>sunken</STRONG>, <STRONG>flat</STRONG>,
+ <STRONG>ridge</STRONG>, and <STRONG>groove</STRONG>. Sunken is discouraged as this is the
+ relief used to indicate a depressed state. This option
+ has no effect on simple Comboboxes. The default is
+ raised.
+
+ Name: <STRONG>dropdown</STRONG>
+ Class: <STRONG>Dropdown</STRONG>
+ Command-Line Switch: <STRONG>-dropdown</STRONG>
+
+ Boolean describing the Combobox layout style given in
+ any of the forms acceptable to <STRONG>Tcl_GetBoolean</STRONG>. If true,
+ the Combobox will be a dropdown style widget which
+ displays an entry field and an arrow button which when
+ activated will pop up a scrollable list of items. If
+ false, a simple Combobox style will be used which has
+ an entry field and a scrollable list beneath it which
+ is always visible. Both styles allow an optional label
+ for the entry field area. The default is true.
+
+ Name: <STRONG>editable</STRONG>
+ Class: <STRONG>Editable</STRONG>
+ Command-Line Switch: <STRONG>-editable</STRONG>
+
+ Boolean describing whether or not the text entry area
+ is editable by the user. If true the user can add items
+ to the combobox by entering text into the entry area
+ and then pressing Return. If false, the list of items
+ is non-editable and can only be changed by calling the
+ insert or delete methods. Given in any of the forms
+ acceptable to <STRONG>Tcl_GetBoolean</STRONG>. The default is true.
+
+ Name: <STRONG>flipArrow</STRONG>
+ Class: <STRONG>FlipArrow</STRONG>
+ Command-Line Switch: <STRONG>-fliparrow</STRONG>
+
+ Boolean describing whether or not the arrow button of
+ dropdowns should be reversed (point up) when the list
+ is popped up. Given in any of the forms acceptable to
+ <STRONG>Tcl_GetBoolean</STRONG>. The default is false.
+
+
+ Name: <STRONG>listHeight</STRONG>
+ Class: <STRONG>Height</STRONG>
+ Command-Line Switch: <STRONG>-listheight</STRONG>
+
+ Height of the listbox specified in any of the forms
+ acceptable to <STRONG>Tk_GetPixels</STRONG>. The default is 100 pixels.
+
+ Name: <STRONG>margin</STRONG>
+ Class: <STRONG>Margin</STRONG>
+ Command-Line Switch: <STRONG>-margin</STRONG>
+
+ Specifies the width in pixels between the entry com-
+ ponent and the arrow button for a dropdown Combobox
+ given in any of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>.
+ This option has no effect on a simple Combobox. The
+ default is 0.
+
+ Name: <STRONG>popupCursor</STRONG>
+ Class: <STRONG>Cursor</STRONG>
+ Command-Line Switch: <STRONG>-popupcursor</STRONG>
+
+ Specifies the cursor to be used for dropdown style
+ listboxes. The value may have any of the forms accept-
+ able to <STRONG>Tk_GetCursor</STRONG>. The default is arrow.
+
+ Name: <STRONG>selectionCommand</STRONG>
+ Class: <STRONG>SelectionCommand</STRONG>
+ Command-Line Switch: <STRONG>-selectioncommand</STRONG>
+
+ Specifies a Tcl command procedure which is called when
+ an item in the listbox area is selected. The item will
+ be selected in the list, the listbox will be removed if
+ it is a dropdown Combobox, and the selected item's text
+ will be inserted into the entry field before the
+ -selectioncommand proc is called. The default is {}.
+
+ Name: <STRONG>unique</STRONG>
+ Class: <STRONG>Unique</STRONG>
+ Command-Line Switch: <STRONG>-unique</STRONG>
+
+ Boolean describing whether or not duplicate items are
+ allowed in the combobox list. If true, then duplicates
+ are not allowed to be inserted. If false, a duplicate
+ entry causes selection of the item. Given in any of the
+ forms acceptable to <STRONG>Tcl_GetBoolean</STRONG>. The default is
+ true.
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>combobox</STRONG> command creates an enhanced entry field widget
+ with an optional associated label and a scrollable list.
+ When an item is selected in the list area of a Combobox it's
+ value is then displayed in the entry field text area. Func-
+ tionally similar to an Optionmenu, the Combobox adds
+ (optional) list scrolling and (optional) item editing and
+ inserting capabilities.
+
+ There are two basic styles of Comboboxes (determined by the
+ -dropdown option): dropdown and simple. The dropdown style
+ adds an arrow button to the right of the entry field which
+ when activated will pop up (and down) the scrolled listbox
+ beneath the entry field. The simple (non-dropdown) Combobox
+ permanently displays the listbox beneath the entry field and
+ has no arrow button. Either style allows an optional entry
+ field label.
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>combobox</STRONG> command creates a new Tcl command whose name is
+ <EM>pathName</EM>. This command may be used to invoke various opera-
+ tions on the widget. It has the following general form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for Combobox widg-
+ ets:
+
+
+</PRE>
+<H2>ASSOCIATED METHODS</H2><PRE>
+ <STRONG>icursor</STRONG> <STRONG>scan</STRONG>
+
+ See the "entry" manual entries for details on the above
+ associated methods.
+
+ <STRONG>curselection</STRONG> <STRONG>index</STRONG> <STRONG>see</STRONG> <STRONG>size</STRONG>
+ <STRONG>xview</STRONG> <STRONG>yview</STRONG>
+
+ See the "listbox" manual entries for details on the above
+ associated methods.
+
+ <STRONG>getcurselection</STRONG> <STRONG>justify</STRONG> <STRONG>sort</STRONG>
+
+ See the "scrolledlistbox" manual entries for details on the
+ above associated methods.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>combobox</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>clear</STRONG> ?<STRONG>component</STRONG>?
+ Clears the contents from one or both components. Valid
+ component values are <STRONG>list</STRONG>, or <STRONG>entry</STRONG>. With no component
+ specified, both are cleared.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>combobox</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>delete</STRONG> <EM>component</EM> <EM>first</EM> ?<EM>last</EM>?
+ Delete one or more elements from a given component,
+ <STRONG>list</STRONG> or <STRONG>entry</STRONG>. If a list item to be removed is
+ currently selected (displayed in the entry field area),
+ the entry field will be cleared.
+
+ <EM>pathName</EM> <STRONG>get</STRONG> <STRONG>?</STRONG><EM>index</EM>?
+ With no arguments, returns the contents currently in
+ the entry field area. With a single argument, returns
+ the contents of the listbox item at the indicated
+ index.
+
+ <EM>pathName</EM> <STRONG>insert</STRONG> <EM>component</EM> <EM>index</EM> <EM>element</EM> ?<EM>element</EM> <EM>element</EM> ...?
+ Insert one or more new elements into the given com-
+ ponent, <STRONG>list</STRONG> or <STRONG>entry</STRONG>, just before the element given by
+ <EM>index</EM>.
+
+ <EM>pathName</EM> <STRONG>selection</STRONG> <EM>option</EM> <EM>first</EM> ?<EM>last</EM>?
+ Adjust the selection within the listbox component and
+ updates the contents of the entry field component to
+ the value of the selected item. See the "listbox"
+ manual entry for more details on parameter options.
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>entry</STRONG>
+ Class: <STRONG>Entryfield</STRONG>
+
+ Text entry area where the current selection is
+ displayed. If the Combobox is editable, the user can
+ edit the contents of this item.
+
+ Name: <STRONG>list</STRONG>
+ Class: <STRONG>Scrolledlistbox</STRONG>
+
+ Scrollable list which stores all the items which the
+ user can select from. For dropdown Comboboxes, this
+ component is hidden until the user pops it up by press-
+ ing on the arrow button to the right of the entry com-
+ ponent. For simple Comboboxes this component is always
+ visible just beneath the entry component.
+
+
+</PRE>
+<H2>DEFAULT BINDINGS</H2><PRE>
+ The Combobox generally has the same bindings as it's primary
+ component items - the Scrolledlistbox and Entryfield. How-
+ ever it also adds these:
+
+ [1] Button-1 mouse press on the arrow key of a dropdown Com-
+ bobox causes the list to be popped up. If the combobox is
+ non-editable, a Button-1 press on the entry field area will
+ also pop up the list.
+
+ [2] Button-1 mouse press anywhere on the display removes a
+ dropdown listbox which has been popped up, unless the
+ keypress is upon one of the Combobox scrollbars which
+ scrolls the list. If it is pressed upon an item in the list
+ area, that item will be selected before the list is removed.
+
+ [3] Button-3 mouse press on the arrow key of a dropdown Com-
+ bobox causes the next item to be selected. Shift-Button-3
+ causes the previous item to be selected.
+
+ [4] Escape keypress removes a dropdown list which has been
+ popped up.
+
+ [5] The &lt;space&gt; and &lt;Return&gt; keystrokes select the current
+ item. They also remove the popped up list for dropdown com-
+ boboxes.
+
+ [6] Up and Down arrow keypresses from the entry field and
+ arrow button component cause the previous and next items in
+ the listbox to be selected respectively. Ctl-P and Ctl-N are
+ similarly mapped for emacs emulation.
+
+ [7] Entry field and arrow button component Shift-Up and
+ Shift-Down arrow keys pop up and down the listbox of a drop-
+ down Combobox. The arrow button component also maps &lt;Return&gt;
+ and &lt;space&gt; similarly.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ proc selectCmd {} {
+ puts stdout "[.cb2 getcurselection]"
+ }
+
+ #
+ # Non-editable Dropdown Combobox
+ #
+ combobox .cb1 -labeltext Month: \
+ -selectioncommand {puts "selected: [.cb1 getcurselection]"} \
+ -editable false -listheight 185 -popupcursor hand1 \
+ -items {Jan Feb Mar Apr May June Jul Aug Sept Oct Nov Dec}
+
+ #
+ # Editable Dropdown Combobox
+ #
+ combobox .cb2 -labeltext "Operating System:" \
+ -items {Linux HP-UX SunOS Solaris Irix} -selectioncommand selectCmd
+
+ #
+ # Simple Combobox
+ #
+ combobox .cb3 -labeltext Fonts: -labelpos nw \
+ -dropdown false -listheight 220 -items [exec xlsfonts]
+
+ pack .cb1 -padx 10 -pady 10 -fill x
+ pack .cb2 -padx 10 -pady 10 -fill x
+ pack .cb3 -padx 10 -pady 10 -fill x
+
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ John S. Sigler
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ combobox, entryfield, scrolledlistbox, itk::Widget, entry,
+ listbox, widget, iwidgets
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/dialog.n.html b/itcl/iwidgets3.0.0/demos/html/dialog.n.html
new file mode 100644
index 00000000000..928666a96db
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/dialog.n.html
@@ -0,0 +1,195 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - dialog</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - dialog</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ dialog - Create and manipulate a dialog widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>dialog</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Toplevel &lt;- Shell &lt;- Dialogshell &lt;- Dialog
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>background</STRONG> <STRONG>cursor</STRONG> <STRONG>foreground</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>buttonBoxPadX</STRONG> <STRONG>buttonBoxPadY</STRONG> <STRONG>buttonBoxPos</STRONG> <STRONG>padX</STRONG>
+ <STRONG>padY</STRONG> <STRONG>separator</STRONG> <STRONG>thickness</STRONG>
+
+ See the "dialogshell" manual entry for details on the above
+ inherited options.
+
+ <STRONG>master</STRONG> <STRONG>modality</STRONG> <STRONG>title</STRONG>
+
+ See the "shell" manual entry for details on the above inher-
+ ited options.
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>dialog</STRONG> command creates a dialog box providing standard
+ buttons and a child site for use in derived classes. The
+ buttons include ok, apply, cancel, and help. Methods and
+ Options exist to configure the buttons and their containing
+ box.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>dialog</STRONG> command creates a new Tcl command whose name is
+ <EM>pathName</EM>. This command may be used to invoke various opera-
+ tions on the widget. It has the following general form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for dialog widg-
+ ets:
+
+
+</PRE>
+<H2>INHERITED METHODS</H2><PRE>
+
+ <STRONG>add</STRONG> <STRONG>buttonconfigure</STRONG> <STRONG>defaulthide</STRONG>
+ <STRONG>index</STRONG> <STRONG>insert</STRONG> <STRONG>invoke</STRONG> <STRONG>show</STRONG>
+
+ See the "buttonbox" manual entry for details on the above
+ inherited methods.
+
+ <STRONG>childsite</STRONG>
+
+ See the "dialogshell" manual entry for details on the above
+ inherited methods.
+
+ <STRONG>activate</STRONG> <STRONG>center</STRONG> <STRONG>deactivate</STRONG>
+
+ See the "shell" manual entry for details on the above inher-
+ ited methods.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>dialog</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>dialog</STRONG> command.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ dialog .d -modality global
+ .d buttonconfigure OK -command {puts OK; .d deactivate 1}
+ .d buttonconfigure Apply -command {puts Apply}
+ .d buttonconfigure Cancel -command {puts Cancel; .d deactivate 0}
+ .d buttonconfigure Help -command {puts Help}
+
+ listbox [.d childsite].lb -relief sunken
+ pack [.d childsite].lb -expand yes -fill both
+
+ if {[.d activate]} {
+ puts "Exit via OK button"
+ } else {
+ puts "Exit via Cancel button"
+ }
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Mark L. Ulferts
+
+ Bret A. Schuhmacher
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ dialog, dialogshell, shell, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/dialogshell.n.html b/itcl/iwidgets3.0.0/demos/html/dialogshell.n.html
new file mode 100644
index 00000000000..00742a1e231
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/dialogshell.n.html
@@ -0,0 +1,254 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - dialogshell</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - dialogshell</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ dialogshell - Create and manipulate a dialog shell widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>dialogshell</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Toplevel &lt;- Shell &lt;- Dialogshell
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>background</STRONG> <STRONG>cursor</STRONG> <STRONG>foreground</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>master</STRONG> <STRONG>modality</STRONG> <STRONG>title</STRONG>
+
+ See the "shell" manual entry for details on the above inher-
+ ited options.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>buttonBoxPadX</STRONG>
+ Class: <STRONG>Pad</STRONG>
+ Command-Line Switch: <STRONG>-buttonboxpadx</STRONG>
+
+ Specifies a non-negative padding distance to leave
+ between the button group and the outer edge of the but-
+ ton box in the x direction. The value may be given in
+ any of the forms accpetable to <STRONG>Tk_GetPixels</STRONG>. The
+ default is 5 pixels.
+
+ Name: <STRONG>buttonBoxPadY</STRONG>
+ Class: <STRONG>Pad</STRONG>
+ Command-Line Switch: <STRONG>-buttonboxpady</STRONG>
+
+ Specifies a non-negative padding distance to leave
+ between the button group and the outer edge of the but-
+ ton box in the y direction. The value may be given in
+ any of the forms accpetable to <STRONG>Tk_GetPixels</STRONG>. The
+ default is 5 pixels.
+
+ Name: <STRONG>buttonBoxPos</STRONG>
+ Class: <STRONG>Position</STRONG>
+ Command-Line Switch: <STRONG>-buttonboxpos</STRONG>
+
+ Attaches buttons to the given side of the dialog: <STRONG>n</STRONG>, <STRONG>s</STRONG>,
+ <STRONG>e</STRONG> or <STRONG>w</STRONG>. The default is s.
+
+ Name: <STRONG>padX</STRONG>
+ Class: <STRONG>Pad</STRONG>
+ Command-Line Switch: <STRONG>-padx</STRONG>
+
+ Specifies a padding distance for the childsite in the
+ X-direction in any of the forms acceptable to
+ <STRONG>Tk_GetPixels</STRONG>. The default is 10.
+
+ Name: <STRONG>padY</STRONG>
+ Class: <STRONG>Pad</STRONG>
+ Command-Line Switch: <STRONG>-pady</STRONG>
+
+ Specifies a padding distance for the childsite in the
+ Y-direction in any of the forms acceptable to
+ <STRONG>Tk_GetPixels</STRONG>. The default is 10.
+
+ Name: <STRONG>separator</STRONG>
+ Class: <STRONG>Separator</STRONG>
+ Command-Line Switch: <STRONG>-separator</STRONG>
+
+ Specifies whether a line is drawn to separate the but-
+ tons from the dialog box contents in any of the forms
+ acceptable to <STRONG>Tcl_GetBoolean</STRONG>. The default is true.
+
+ Name: <STRONG>thickness</STRONG>
+ Class: <STRONG>Thickness</STRONG>
+ Command-Line Switch: <STRONG>-thickness</STRONG>
+
+ Specifies the thickness of the separator in any of the
+ forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The default is 3
+ pixels.
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>dialogshell</STRONG> command creates a dialog shell which is a
+ top level widget composed of a button box, separator, and
+ child site area. The class also has methods to control but-
+ ton construction.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>dialogshell</STRONG> command create a new Tcl command whose name
+ is <EM>pathName</EM>. This command may be used to invoke various
+ operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for dialogshell
+ widgets:
+
+
+</PRE>
+<H2>INHERITED METHODS</H2><PRE>
+ <STRONG>activate</STRONG> <STRONG>center</STRONG> <STRONG>deactivate</STRONG>
+
+ See the "shell" manual entry for details on the above inher-
+ ited methods.
+
+
+</PRE>
+<H2>ASSOCIATED METHODS</H2><PRE>
+ <STRONG>add</STRONG> <STRONG>buttonconfigure</STRONG> <STRONG>defaultdelete</STRONG>
+ <STRONG>hide</STRONG> <STRONG>index</STRONG> <STRONG>insert</STRONG> <STRONG>invoke</STRONG>
+ <STRONG>show</STRONG>
+
+ See the "buttonbox" manual entry for details on the associ-
+ ated methods.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>dialogshell</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>childsite</STRONG>
+ Returns the pathname of the child site widget.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>dialogshell</STRONG> command.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>dschildsite</STRONG>
+ Class: <STRONG>frame</STRONG>
+
+ The dschildsite component is the user child site for
+ the dialog shell. See the "frame" widget manual entry
+ for details on the dschildsite component item.
+
+ Name: <STRONG>separator</STRONG>
+ Class: <STRONG>frame</STRONG>
+
+ The separator component devides the area between the
+ user child site and the button box. See the "frame"
+ widget manual entry for details on the separator com-
+ ponent item.
+
+ Name: <STRONG>bbox</STRONG>
+ Class: <STRONG>ButtonBox</STRONG>
+
+ The bbox component is the button box containing the
+ buttons for the dialog shell. See the "ButtonBox"
+ widget manual entry for details on the bbox component
+ item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ dialogshell .ds -modality none
+
+ .ds add OK -text "OK"
+ .ds add Cancel -text "Cancel"
+ .ds default OK
+
+ .ds activate
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Mark L. Ulferts
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ dialogshell, dialog, shell, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/entryfield.n.html b/itcl/iwidgets3.0.0/demos/html/entryfield.n.html
new file mode 100644
index 00000000000..9ac0accb2ff
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/entryfield.n.html
@@ -0,0 +1,305 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - entryfield</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - entryfield</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ entryfield - Create and manipulate a entry field widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>entryfield</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- LabeledWidget &lt;- entryfield
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>background</STRONG> <STRONG>borderWidth</STRONG> <STRONG>cursor</STRONG> <STRONG>exportSelection</STRONG>
+ <STRONG>foreground</STRONG> <STRONG>highlightColor</STRONG> <STRONG>highlightThicknessinsertBackground</STRONG>
+ <STRONG>insertBorderWidth</STRONG> <STRONG>insertOffTime</STRONG> <STRONG>insertOnTimeinsertWidth</STRONG>
+ <STRONG>justify</STRONG> <STRONG>relief</STRONG> <STRONG>selectBackgroundselectBorderWidth</STRONG>
+ <STRONG>selectForeground</STRONG> <STRONG>textVariable</STRONG> <STRONG>width</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+ <STRONG>show</STRONG> <STRONG>state</STRONG>
+
+ See the "entry" manual entry for details on the associated
+ options.
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>labelBitmap</STRONG> <STRONG>labelFont</STRONG> <STRONG>labelImage</STRONG> <STRONG>labelMargin</STRONG>
+ <STRONG>labelPos</STRONG> <STRONG>labelText</STRONG> <STRONG>labelVariable</STRONG>
+
+ See the "labeledwidget" class manual entry for details on
+ the inherited options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>childSitePos</STRONG>
+ Class: <STRONG>Position</STRONG>
+ Command-Line Switch: <STRONG>-childsitepos</STRONG>
+
+ Specifies the position of the child site in the entry
+ field: <STRONG>n</STRONG>, <STRONG>s</STRONG>, <STRONG>e</STRONG>, or <STRONG>w</STRONG>. The default is e.
+
+ Name: <STRONG>command</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-command</STRONG>
+
+ Specifies a Tcl command to be executed upon detection
+ of a Return key press event.
+
+ Name: <STRONG>fixed</STRONG>
+ Class: <STRONG>Fixed</STRONG>
+ Command-Line Switch: <STRONG>-fixed</STRONG>
+ Restrict entry to the specified number of chars. A
+ value of 0, which is the default, denotes no limit.
+ The value is the maximum number of chars the user may
+ type into the field, regardles of field width. For
+ example, if the field width is set to 20 and the fixed
+ value is 10, the user will only be able to type 10
+ characters into the field which is 20 characters long.
+
+ Name: <STRONG>focusCommand</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-focuscommand</STRONG>
+
+ Specifies a Tcl command to be executed upon reception
+ of focus.
+
+ Name: <STRONG>invalid</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-invalid</STRONG>
+
+ Specifies a Tcl command to be executed upon determina-
+ tion of invalid input. The default is bell.
+
+ Name: <STRONG>textBackground</STRONG>
+ Class: <STRONG>Background</STRONG>
+ Command-Line Switch: <STRONG>-textbackground</STRONG>
+
+ Background color for inside textual portion of the
+ entry field. The value may be given in any of the
+ forms acceptable to <STRONG>Tk_GetColor</STRONG>.
+
+ Name: <STRONG>textFont</STRONG>
+ Class: <STRONG>Font</STRONG>
+ Command-Line Switch: <STRONG>-textfont</STRONG>
+
+ Name of font to use for display of text in entryfield.
+ The value may be given in any of the forms acceptable
+ to <STRONG>Tk_GetFont</STRONG>.
+
+ Name: <STRONG>validate</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-validate</STRONG>
+
+ The validate option allows specification of a valida-
+ tion mechanism. Standard character validation such as
+ <STRONG>numeric</STRONG>, <STRONG>alphabetic</STRONG>, <STRONG>integer</STRONG>, <STRONG>hexidecimal</STRONG>, <STRONG>real</STRONG>, and
+ <STRONG>alphanumeric</STRONG> can be handled through the use of key-
+ words. Should more extensive validation be necessary,
+ the value may contain the name of a command script.
+ The script should return a boolean value. True for
+ valid, false for invalid. If false is returned, then
+ the procedure associated with the invalid option will
+ be invoked. If the validation script contains any <STRONG>%</STRONG>
+ characters, then the script will not be executed
+ directly. Instead, a new script will be generated by
+ replacing each <STRONG>%</STRONG>, and the character following it, with
+ information from the entryfield. The replacement
+ depends on the character following the <STRONG>%</STRONG>, as defined in
+ the list below.
+
+ <STRONG>%c</STRONG> Replaced with the current input character.
+
+ <STRONG>%P</STRONG> Replaced with the contents of the entryfield modified
+ to include the latest keystoke. This is equivalent to
+ peeking at the future contents, enabling rejection
+ prior to the update.
+
+ <STRONG>%S</STRONG> Replaced with the current contents of the entryfield
+ prior to the latest keystroke being added.
+
+ <STRONG>%W</STRONG> Replaced with the entryfield widget pathname.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>entryfield</STRONG> command creates an enhanced text entry widget
+ with an optional associated label. Addtional options sup-
+ port validation and establishing a upper limit on the number
+ of characters which may be entered in the field.
+
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>entryfield</STRONG> command creates a new Tcl command whose name
+ is <EM>pathName</EM>. This command may be used to invoke various
+ operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for entryfield
+ widgets:
+
+
+</PRE>
+<H2>ASSOCIATED METHODS</H2><PRE>
+ <STRONG>delete</STRONG> <STRONG>get</STRONG> <STRONG>icursor</STRONG> <STRONG>index</STRONG>
+ <STRONG>insert</STRONG> <STRONG>scan</STRONG> <STRONG>selection</STRONG> <STRONG>xview</STRONG>
+
+ See the "entry" manual entry for details on the associated
+ methods.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>entryfield</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>childsite</STRONG>
+ Returns the path name of the child site.
+
+ <EM>pathName</EM> <STRONG>clear</STRONG>
+ Clear entry widget
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>entryfield</STRONG> command.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>efchildsite</STRONG>
+ Class: <STRONG>frame</STRONG>
+
+ The efchildsite component is the user child site for
+ the entry field. See the "frame" widget manual entry
+ for details on the efchildsite component item.
+
+ Name: <STRONG>entry</STRONG>
+ Class: <STRONG>entry</STRONG>
+
+ The entry component provides the entry field for user
+ text input and display. See the "entry" widget manual
+ entry for details on the entry component item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ option add *textBackground white
+
+ proc returnCmd {} {
+ puts stdout "Return Pressed"
+ }
+
+ proc invalidCmd {} {
+ puts stdout "Alphabetic contents invalid"
+ }
+
+ entryfield .ef -command returnCmd
+
+ entryfield .fef -labeltext "Fixed:" -fixed 10 -width 12
+
+ entryfield .nef -labeltext "Numeric:" -validate numeric -width 12
+
+ entryfield .aef -labeltext "Alphabetic:" \
+ -validate alphabetic -width 12 -invalid invalidCmd
+
+ entryfield .pef -labeltext "Password:" \
+ -show 267 -width 12 -command returnCmd
+
+ LabeledWidget::alignLabels .ef .fef .nef .aef .pef
+
+ pack .ef -fill x -expand yes -padx 10 -pady 5
+ pack .fef -fill x -expand yes -padx 10 -pady 5
+ pack .nef -fill x -expand yes -padx 10 -pady 5
+ pack .aef -fill x -expand yes -padx 10 -pady 5
+ pack .pef -fill x -expand yes -padx 10 -pady 5
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Sue Yockey
+
+ Mark L. Ulferts
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ entryfield, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/feedback.n.html b/itcl/iwidgets3.0.0/demos/html/feedback.n.html
new file mode 100644
index 00000000000..b67ebaba087
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/feedback.n.html
@@ -0,0 +1,195 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - feedback</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - feedback</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ feedback - Create and manipulate a feedback widget to
+ display feedback on the current status of an ongoing opera-
+ tion to the user.
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>feedback</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- Labeledwidget &lt;- Feedback
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>background</STRONG> <STRONG>borderWidth</STRONG> <STRONG>cursor</STRONG> <STRONG>foreground</STRONG>
+ <STRONG>highlightColor</STRONG> <STRONG>highlightThickness</STRONG> <STRONG>relief</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>labelBitmap</STRONG> <STRONG>labelFont</STRONG> <STRONG>labelImage</STRONG> <STRONG>labelMargin</STRONG>
+ <STRONG>labelPos</STRONG> <STRONG>labelText</STRONG> <STRONG>labelVariable</STRONG>
+
+ See the "labeledwidget" class manual entry for details on
+ the inherited options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>barColor</STRONG>
+ Class: <STRONG>BarColor</STRONG>
+ Command-Line Switch: <STRONG>-barcolor</STRONG>
+
+ Specifies the color of the status bar, in any of the
+ forms acceptable to <STRONG>Tk_GetColor</STRONG>.
+
+ Name: <STRONG>barHeight</STRONG>
+ Class: <STRONG>BarHeight</STRONG>
+ Command-Line Switch: <STRONG>-barheight</STRONG>
+
+ Specifies the height of the status bar, in any of the
+ forms acceptable to <STRONG>Tk_GetPixels</STRONG>.
+
+ Name: <STRONG>barWidth</STRONG>
+ Class: <STRONG>BarWidth</STRONG>
+ Command-Line Switch: <STRONG>-barwidth</STRONG>
+
+ Specifies the total width of the status bar (when
+ full,) in any of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>.
+
+ Name: <STRONG>elementBorderWidth</STRONG>
+ Class: <STRONG>BorderWidth</STRONG>
+ Command-Line Switch: <STRONG>-elementborderwidth</STRONG>
+ Sets the width of the border around the status bar, in
+ any of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>. If it is
+ set to zero, the status bar has no border.
+
+ Name: <STRONG>steps</STRONG>
+ Class: <STRONG>Steps</STRONG>
+ Command-Line Switch: <STRONG>-steps</STRONG>
+
+ Specifies the total number of steps for the status bar.
+ The default is 10.
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>feedback</STRONG> command creates a feedback widget to display
+ feedback on the current status of an ongoing operation to
+ the user. Display is given as a percentage and as a thermom-
+ eter type bar. Options exist for adding a label and control-
+ ling its position.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>feedback</STRONG> command creates a new Tcl command whose name is
+ <EM>pathName</EM>. This command may be used to invoke various opera-
+ tions on the widget. It has the following general form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for scrolledtext
+ widgets:
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>scrolledhtml</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>feedback</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>reset</STRONG>
+ Reset status to 0%
+
+ <EM>pathName</EM> <STRONG>step</STRONG> ?<EM>inc</EM>?
+ Increase the current number of steps completed by <EM>inc</EM>.
+ <EM>Inc</EM> defaults to 1.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ feedback .fb -labeltext "Status" -steps 20
+ pack .fb -padx 10 -pady 10 -fill both -expand yes
+
+ for {set i 0} {$i &lt; 20} {incr i} {
+ .fb step
+ after 500
+ }
+
+
+
+</PRE>
+<H2>ACKNOWLEDGEMENTS</H2><PRE>
+ Sam Shen
+
+ This code is based largely on his feedback.tcl code
+ from tk inspect. The original feedback code is copy-
+ right 1995 Lawrence Berkeley Laboratory.
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Kris Raney
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ feedback, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/fileselectionbox.n.html b/itcl/iwidgets3.0.0/demos/html/fileselectionbox.n.html
new file mode 100644
index 00000000000..4d61d442e78
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/fileselectionbox.n.html
@@ -0,0 +1,510 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - fileselectionbox</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - fileselectionbox</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ fileselectionbox - Create and manipulate a file selection
+ box widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>fileselectionbox</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- Fileselectionbox
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>activeBackground</STRONG> <STRONG>background</STRONG> <STRONG>borderWidthcursor</STRONG>
+ <STRONG>foreground</STRONG> <STRONG>highlightColor</STRONG> <STRONG>highlightThicknessinsertBackground</STRONG>
+ <STRONG>insertBorderWidth</STRONG> <STRONG>insertOffTime</STRONG> <STRONG>insertOnTimeinsertWidth</STRONG>
+ <STRONG>relief</STRONG> <STRONG>repeatDelay</STRONG> <STRONG>repeatInterval</STRONG> <STRONG>selectBackground</STRONG>
+ <STRONG>selectBorderWidth</STRONG> <STRONG>selectForeground</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+ <STRONG>textBackground</STRONG> <STRONG>textFont</STRONG>
+
+ See the "entryfield" widget manual entry for details on the
+ above associated options.
+
+ <STRONG>labelFont</STRONG> <STRONG>labelMargin</STRONG>
+
+ See the "labeledwidget" widget manual entry for details on
+ the above associated options.
+
+ <STRONG>activeRelief</STRONG> <STRONG>elementBorderWidth</STRONG> <STRONG>jumptroughColor</STRONG>
+
+ See the "scrollbar" widget class manual entry for details on
+ the above associated options.
+
+ <STRONG>hscrollMode</STRONG> <STRONG>sbWidth</STRONG> <STRONG>scrollMargin</STRONG> <STRONG>textBackground</STRONG>
+ <STRONG>textFont</STRONG> <STRONG>vscrollMode</STRONG>
+
+ See the "scrolledlistbox" widget manual entry for details on
+ the above associated options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>childSitePos</STRONG>
+ Class: <STRONG>Position</STRONG>
+ Command-Line Switch: <STRONG>-childsitepos</STRONG>
+
+ Specifies the position of the child site in the selec-
+ tion box: <STRONG>n</STRONG>, <STRONG>s</STRONG>, <STRONG>e</STRONG>, or <STRONG>w</STRONG>. The default is s.
+
+ Name: <STRONG>dblDirsCommand</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-dbldirscommand</STRONG>
+
+ Specifies a Tcl command procedure which is called when
+ an directory list item is double clicked. Typically
+ this occurs when mouse button 1 is double clicked over
+ a directory name.
+
+ Name: <STRONG>dblFilesCommand</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-dblfilescommand</STRONG>
+
+ Specifies a Tcl command procedure which is called when
+ an file list item is double clicked. Typically this
+ occurs when mouse button 1 is double clicked over a
+ file name.
+
+ Name: <STRONG>directory</STRONG>
+ Class: <STRONG>Directory</STRONG>
+ Command-Line Switch: <STRONG>-directory</STRONG>
+
+ Specifies the initial default directory. The default
+ is the present working directory.
+
+ Name: <STRONG>dirsfraction</STRONG>
+ Class: <STRONG>DirsFraction</STRONG>
+ Command-Line Switch: <STRONG>-dirsfraction</STRONG>
+
+ Specifies the fraction as a percentage of the overall
+ width that the directory list takes up.
+
+ Name: <STRONG>dirSearchCommand</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-dirsearchcommand</STRONG>
+
+ Specifies a Tcl command to be executed to perform a
+ directory search. The command will receive the current
+ working directory and filter mask as arguments. The
+ command should return a list of files which will be
+ placed into the directory list.
+
+ Name: <STRONG>dirsLabel</STRONG>
+ Class: <STRONG>Text</STRONG>
+ Command-Line Switch: <STRONG>-dirslabel</STRONG>
+
+ Specifies the text of the label for the directory list.
+ The default is "Directories".
+
+ Name: <STRONG>dirsLabelPos</STRONG>
+ Class: <STRONG>Position</STRONG>
+ Command-Line Switch: <STRONG>-dirslabelpos</STRONG>
+ Specifies the position of the label along the side of
+ the directory list: <STRONG>n</STRONG>, <STRONG>ne</STRONG>, <STRONG>e</STRONG>, <STRONG>se</STRONG>, <STRONG>s</STRONG>, <STRONG>sw</STRONG>, <STRONG>w</STRONG>, or <STRONG>nw</STRONG>. The
+ default is nw.
+
+ Name: <STRONG>dirsOn</STRONG>
+ Class: <STRONG>DirsOn</STRONG>
+ Command-Line Switch: <STRONG>-dirson</STRONG>
+
+ Specifies whether or not to display the directory list.
+ The value may be given in any of the forms acceptable
+ to <STRONG>Tcl_GetBoolean</STRONG>. The default is true.
+
+ Name: <STRONG>fileSearchCommand</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-filesearchcommand</STRONG>
+
+ Specifies a Tcl command to be executed to perform a
+ file search. The command will receive the current
+ working directory and filter mask as arguments. The
+ command should return a list of files which will be
+ placed into the file list.
+
+ Name: <STRONG>filesLabel</STRONG>
+ Class: <STRONG>Text</STRONG>
+ Command-Line Switch: <STRONG>-fileslabel</STRONG>
+
+ Specifies the text of the label for the files list.
+ The default is "Files".
+
+ Name: <STRONG>filesLabelPos</STRONG>
+ Class: <STRONG>Position</STRONG>
+ Command-Line Switch: <STRONG>-fileslabelpos</STRONG>
+
+ Specifies the position of the label along the side of
+ the files list: : <STRONG>n</STRONG>, <STRONG>ne</STRONG>, <STRONG>e</STRONG>, <STRONG>se</STRONG>, <STRONG>s</STRONG>, <STRONG>sw</STRONG>, <STRONG>w</STRONG>, or <STRONG>nw</STRONG>. The
+ default is nw.
+
+ Name: <STRONG>filesOn</STRONG>
+ Class: <STRONG>FilesOn</STRONG>
+ Command-Line Switch: <STRONG>-fileson</STRONG>
+
+ Specifies whether or not to display the files list.
+ The value may be given in any of the forms acceptable
+ to <STRONG>Tcl_GetBoolean</STRONG>. The default is true.
+
+ Name: <STRONG>fileType</STRONG>
+ Class: <STRONG>FileType</STRONG>
+ Command-Line Switch: <STRONG>-filetype</STRONG>
+
+ Specify the type of files which may appear in the file
+ list: <STRONG>regular</STRONG>, <STRONG>directory</STRONG>, or <STRONG>any</STRONG>. The default is regu-
+ lar.
+
+ Name: <STRONG>filterCommand</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-filtercommand</STRONG>
+
+ Specifies a Tcl command to be executed upon hitting the
+ Return key in the filter entry widget.
+
+ Name: <STRONG>filterFocusCommand</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-filterfocuscommand</STRONG>
+
+ Specifies a Tcl command to be executed upon reception
+ of focus by the filter.
+
+ Name: <STRONG>filterLabel</STRONG>
+ Class: <STRONG>Text</STRONG>
+ Command-Line Switch: <STRONG>-filterlabel</STRONG>
+
+ Specifies the text of the label for the filter entry
+ field. The default is "Filter".
+
+ Name: <STRONG>filterLabelPos</STRONG>
+ Class: <STRONG>Position</STRONG>
+ Command-Line Switch: <STRONG>-filterlabelpos</STRONG>
+
+ Specifies the position of the label along the side of
+ the filter: <STRONG>n</STRONG>, <STRONG>ne</STRONG>, <STRONG>e</STRONG>, <STRONG>se</STRONG>, <STRONG>s</STRONG>, <STRONG>sw</STRONG>, <STRONG>w</STRONG>, or <STRONG>nw</STRONG>. The default
+ is nw.
+
+ Name: <STRONG>filterOn</STRONG>
+ Class: <STRONG>FilterOn</STRONG>
+ Command-Line Switch: <STRONG>-filteron</STRONG>
+
+ Specifies whether or not to display the filter entry.
+ The value may be given in any of the forms acceptable
+ to <STRONG>Tcl_GetBoolean</STRONG>. The default is true.
+
+ Name: <STRONG>height</STRONG>
+ Class: <STRONG>Height</STRONG>
+ Command-Line Switch: <STRONG>-height</STRONG>
+
+ Specifies the height of the selection box. The value
+ may be specified in any of the forms acceptable to
+ Tk_GetPixels. The default is 360 pixels.
+
+ Name: <STRONG>horizmargin</STRONG>
+ Class: <STRONG>Margin</STRONG>
+ Command-Line Switch: <STRONG>-horizmargin</STRONG>
+
+ Specifies distance between the lists and
+ filter/selection entries. The value may be given in
+ any of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The
+ default is 7.
+
+ Name: <STRONG>invalid</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-invalid</STRONG>
+
+ Command to be executed should the filter contents be
+ proven invalid. The default is {bell}.
+
+ Name: <STRONG>mask</STRONG>
+ Class: <STRONG>Mask</STRONG>
+ Command-Line Switch: <STRONG>-mask</STRONG>
+
+ Specifies the initial file mask string. The default is
+ "*".
+
+ Name: <STRONG>noMatchString</STRONG>
+ Class: <STRONG>NoMatchString</STRONG>
+ Command-Line Switch: <STRONG>-nomatchstring</STRONG>
+
+ Specifies the string to be displayed in the files list
+ should no files match the mask. The default is "[
+ ]".
+
+ Name: <STRONG>selectDirCommand</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-selectdirommand</STRONG>
+
+ Specifies a Tcl command to be executed following selec-
+ tion of a directory in the directory list.
+
+ Name: <STRONG>selectFileCommand</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-selectfileommand</STRONG>
+
+ Specifies a Tcl command to be executed following selec-
+ tion of a file in the files list.
+
+ Name: <STRONG>selectionCommand</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-selectioncommand</STRONG>
+
+ Specifies a Tcl command to be executed upon hitting the
+ Return key in the selection entry widget.
+
+ Name: <STRONG>selectionFocusCommand</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-selectionfocuscommand</STRONG>
+
+ Specifies a Tcl command to be executed upon reception
+ of focus by the selection entry.
+
+ Name: <STRONG>selectionImage</STRONG>
+ Class: <STRONG>Image</STRONG>
+ Command-Line Switch: <STRONG>-selectionimage</STRONG>
+
+ Specifies a image to be used as the selection entry
+ label. The image may be any of the values created by
+ the <STRONG>image</STRONG> <STRONG>create</STRONG> command.
+
+ Name: <STRONG>selectionLabel</STRONG>
+ Class: <STRONG>Text</STRONG>
+ Command-Line Switch: <STRONG>-selectionlabel</STRONG>
+
+ Specifies the text of the label for the selection entry
+ field. The default is "Selection".
+
+ Name: <STRONG>selectionLabelPos</STRONG>
+ Class: <STRONG>Position</STRONG>
+ Command-Line Switch: <STRONG>-selectionlabelpos</STRONG>
+
+ Specifies the position of the label along the side of
+ the selection: <STRONG>n</STRONG>, <STRONG>ne</STRONG>, <STRONG>e</STRONG>, <STRONG>se</STRONG>, <STRONG>s</STRONG>, <STRONG>sw</STRONG>, <STRONG>w</STRONG>, or <STRONG>nw</STRONG>. The
+ default is nw.
+
+ Name: <STRONG>selectionOn</STRONG>
+ Class: <STRONG>SelectionOn</STRONG>
+ Command-Line Switch: <STRONG>-selectionon</STRONG>
+
+ Specifies whether or not to display the selection
+ entry. The value may be given in any of the forms
+ acceptable to <STRONG>Tcl_GetBoolean</STRONG>. The default is true.
+
+ Name: <STRONG>style</STRONG>
+ Class: <STRONG>Syle</STRONG>
+ Command-Line Switch: <STRONG>-style</STRONG>
+
+ Specifies display style of the fileselectionbox: <STRONG>motif</STRONG>
+ or <STRONG>notif</STRONG>. The default is motif which reflects the lay-
+ out of the OSF/Motif standard Xmfileselectionbox widget
+ composed of directory and file scrolled lists as well
+ as filter and selection entry fields. The notif option
+ setting varies the layout by removing directory names
+ from the files, separates the lists by a paned window,
+ and changes the filter and entry fields into com-
+ boboxes.
+
+ Name: <STRONG>vertmargin</STRONG>
+ Class: <STRONG>Margin</STRONG>
+ Command-Line Switch: <STRONG>-vertmargin</STRONG>
+
+ Specifies distance between the directory and file
+ lists. The value may be given in any of the forms
+ acceptable to <STRONG>Tk_GetPixels</STRONG>. The default is 7. This
+ option is only useful for motif styled fileselection-
+ boxes. For notif styled ones, use the dirsfraction
+ option to modify spacing between the directory and
+ files lists.
+
+ Name: <STRONG>width</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-width</STRONG>
+
+ Specifies the width of the selection box. The value
+ may be specified in any of the forms acceptable to
+ Tk_GetPixels. The default is 470 pixels.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>fileselectionbox</STRONG> command creates a file selection box
+ similar to the OSF/Motif standard Xmfileselectionbox compo-
+ site widget. The fileselectionbox is composed of directory
+ and file scrolled lists as well as filter and selection
+ entry fields. Bindings are in place such that selection of
+ a directory list item loads the filter entry field and
+ selection of a file list item loads the selection entry
+ field. Options exist to control the appearance and actions
+ of the widget.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>fileselectionbox</STRONG> command creates a new Tcl command whose
+ name is <EM>pathName</EM>. This command may be used to invoke vari-
+ ous operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for fileselec-
+ tionbox widgets:
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>fileselectionbox</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>childsite</STRONG>
+ Returns the child site widget path name.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>fileselectionbox</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>filter</STRONG>
+ Update the current contents of the file selection box
+ based on the current filter entry field value.
+
+ <EM>pathName</EM> <STRONG>get</STRONG>
+ Returns the current value of the selection entry
+ widget.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>childsite</STRONG>
+ Class: <STRONG>Frame</STRONG>
+
+ The childsite component is the user child site for the
+ file selection box. See the "frame" widget manual
+ entry for details on the childsite component item.
+
+ Name: <STRONG>dirs</STRONG>
+ Class: <STRONG>Scrolledlistbox</STRONG>
+
+ The dirs component is the directory list box for the
+ file selection box. See the "scrolledlistbox" widget
+ manual entry for details on the dirs component item.
+
+ Name: <STRONG>files</STRONG>
+ Class: <STRONG>Scrolledlistbox</STRONG>
+
+ The files component is the file list box for the file
+ selection box. See the "scrolledlistbox" widget manual
+ entry for details on the files component item.
+
+ Name: <STRONG>filter</STRONG>
+ Class: <STRONG>Entryfield</STRONG>
+
+ The filter component is the entry field for user input
+ of the filter value. See the "entryfield" widget
+ manual entry for details on the filter component item.
+
+
+ Name: <STRONG>selection</STRONG>
+ Class: <STRONG>Entryfield</STRONG>
+
+ The selection component is the entry field for user
+ input of the currently selected file value. See the
+ "entryfield" widget manual entry for details on the
+ selection component item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ option add *textBackground GhostWhite
+
+ fileselectionbox .fsb
+ pack .fsb -padx 10 -pady 10 -fill both -expand yes
+
+
+
+</PRE>
+<H2>AUTHOR(S)</H2><PRE>
+ Mark L. Ulferts
+
+ Anthony Parent
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ fileselectionbox, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/fileselectiondialog.n.html b/itcl/iwidgets3.0.0/demos/html/fileselectiondialog.n.html
new file mode 100644
index 00000000000..aeea455cd31
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/fileselectiondialog.n.html
@@ -0,0 +1,255 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - fileselectiondialog</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - fileselectiondialog</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ fileselectiondialog - Create and manipulate a file selection
+ dialog widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>fileselectiondialog</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Toplevel &lt;- Shell &lt;- Dialogshell &lt;- Dialog &lt;-
+ Fileselectiondialog
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>activeBackground</STRONG> <STRONG>background</STRONG> <STRONG>borderWidthcursor</STRONG>
+ <STRONG>foreground</STRONG> <STRONG>highlightColor</STRONG> <STRONG>highlightThicknessinsertBackground</STRONG>
+ <STRONG>insertBorderWidth</STRONG> <STRONG>insertOffTime</STRONG> <STRONG>insertOnTimeinsertWidth</STRONG>
+ <STRONG>relief</STRONG> <STRONG>repeatDelay</STRONG> <STRONG>repeatInterval</STRONG> <STRONG>selectBackground</STRONG>
+ <STRONG>selectBorderWidth</STRONG> <STRONG>selectForeground</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+ <STRONG>textBackground</STRONG> <STRONG>textFont</STRONG>
+
+ See the "entryfield" widget manual entry for details on the
+ above associated options.
+
+ <STRONG>childSitePos</STRONG> <STRONG>directory</STRONG> <STRONG>dirsLabel</STRONG> <STRONG>dirSearchCommand</STRONG>
+ <STRONG>dirsFraction</STRONG> <STRONG>dirsLabelPos</STRONG> <STRONG>dirsOn</STRONG> <STRONG>filesLabel</STRONG>
+ <STRONG>filesLabelOn</STRONG> <STRONG>fileSearchCommand</STRONG> <STRONG>filesLabelPosfilesOn</STRONG>
+ <STRONG>fileType</STRONG> <STRONG>filterLabel</STRONG> <STRONG>filterLabelPos</STRONG> <STRONG>filterOn</STRONG>
+ <STRONG>invalid</STRONG> <STRONG>mask</STRONG> <STRONG>noMatchString</STRONG> <STRONG>selectionCommand</STRONG>
+ <STRONG>selectionLabel</STRONG> <STRONG>selectionLabelPos</STRONG> <STRONG>selectionOnstyle</STRONG>
+ <STRONG>vertMargin</STRONG>
+
+ See the "fileselectionbox" widget manual entry for details
+ on the above associated options.
+
+ <STRONG>labelFont</STRONG> <STRONG>labelMargin</STRONG>
+
+ See the "labeledwidget" widget manual entry for details on
+ the above associated options.
+
+ <STRONG>horizMargin</STRONG> <STRONG>hscrollMode</STRONG> <STRONG>sbWidth</STRONG> <STRONG>scrollMargin</STRONG>
+ <STRONG>textBackground</STRONG> <STRONG>textFont</STRONG> <STRONG>vScrollMode</STRONG>
+
+ See the "scrolledlistbox" widget manual entry for details on
+ the above associated options.
+
+
+ <STRONG>activeRelief</STRONG> <STRONG>elementBorderWidth</STRONG> <STRONG>jumptroughColor</STRONG>
+
+ See the "scrollbar" widget class manual entry for details on
+ the above associated options.
+
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>buttonBoxPadX</STRONG> <STRONG>buttonBoxPadY</STRONG> <STRONG>buttonBoxPos</STRONG> <STRONG>padX</STRONG>
+ <STRONG>padY</STRONG> <STRONG>separator</STRONG> <STRONG>thickness</STRONG>
+
+ See the "dialogshell" widget manual entry for details on the
+ above inherited options.
+
+ <STRONG>master</STRONG> <STRONG>modality</STRONG> <STRONG>title</STRONG>
+
+ See the "shell" widget manual entry for details on the above
+ inherited options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>height</STRONG>
+ Class: <STRONG>Height</STRONG>
+ Command-Line Switch: <STRONG>-height</STRONG>
+
+ Specifies the height of the file selection dialog. The
+ value may be specified in any of the forms acceptable
+ to Tk_GetPixels. The default is 435 pixels.
+
+ Name: <STRONG>width</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-width</STRONG>
+
+ Specifies the width of the file selection dialog. The
+ value may be specified in any of the forms acceptable
+ to Tk_GetPixels. The default is 450 pixels.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>fileselectiondialog</STRONG> command creates a file selection
+ dialog similar to the OSF/Motif standard composite widget.
+ The fileselectiondialog is derived from the Dialog class and
+ is composed of a FileSelectionBox with attributes set to
+ manipulate the dialog buttons.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>fileselectiondialog</STRONG> command creates a new Tcl command
+ whose name is <EM>pathName</EM>. This command may be used to invoke
+ various operations on the widget. It has the following gen-
+ eral form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for fileselec-
+ tiondialog widgets:
+
+
+</PRE>
+<H2>ASSOCIATED METHODS</H2><PRE>
+ <STRONG>get</STRONG> <STRONG>childsite</STRONG> <STRONG>filter</STRONG>
+
+ See the "fileselectionbox" class manual entry for details on
+ the associated methods.
+
+
+</PRE>
+<H2>INHERITED METHODS</H2><PRE>
+ <STRONG>add</STRONG> <STRONG>buttonconfigure</STRONG> <STRONG>defaulthide</STRONG>
+ <STRONG>insert</STRONG> <STRONG>invoke</STRONG> <STRONG>show</STRONG>
+
+ See the "buttonbox" widget manual entry for details on the
+ above inherited methods.
+
+ <STRONG>activate</STRONG> <STRONG>center</STRONG> <STRONG>deactivate</STRONG>
+
+ See the "shell" widget manual entry for details on the above
+ inherited methods.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>fileselectiondialog</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>fileselectiondialog</STRONG> com-
+ mand.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>fsb</STRONG>
+ Class: <STRONG>Fileselectionbox</STRONG>
+
+ The fsb component is the file selection box for the
+ file selection dialog. See the "fileselectionbox"
+ widget manual entry for details on the fsb component
+ item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ option add *textBackground white
+
+ fileselectiondialog .fsd
+ .fsd activate
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Mark L. Ulferts
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ fileselectiondialog, fileselectionbox, dialog, dialogshell,
+ shell, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/hyperhelp.n.html b/itcl/iwidgets3.0.0/demos/html/hyperhelp.n.html
new file mode 100644
index 00000000000..42e4740c660
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/hyperhelp.n.html
@@ -0,0 +1,200 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - hyperhelp</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - hyperhelp</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ hyperhelp - Create and manipulate a hyperhelp widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>hyperhelp</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Toplevel &lt;- shell &lt;- hyperhelp
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>activeBackground</STRONG> <STRONG>background</STRONG> <STRONG>borderWidth</STRONG>
+ <STRONG>cursor</STRONG> <STRONG>exportSelection</STRONG> <STRONG>foreground</STRONG>
+ <STRONG>highlightColor</STRONG> <STRONG>highlightThickness</STRONG> <STRONG>insertBackground</STRONG>
+ <STRONG>insertBorderWidth</STRONG> <STRONG>insertOffTime</STRONG> <STRONG>insertOnTime</STRONG>
+ <STRONG>insertWidth</STRONG> <STRONG>padX</STRONG> <STRONG>padY</STRONG>
+ <STRONG>relief</STRONG> <STRONG>repeatDelay</STRONG> <STRONG>repeatInterval</STRONG>
+ <STRONG>selectBackground</STRONG> <STRONG>selectBorderWidth</STRONG> <STRONG>selectForeground</STRONG>
+ <STRONG>setGrid</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+ <STRONG>hscrollmode</STRONG> <STRONG>vscrollmode</STRONG> <STRONG>textbackground</STRONG> <STRONG>fontname</STRONG>
+ <STRONG>fontsize</STRONG> <STRONG>fixedfont</STRONG> <STRONG>link</STRONG> <STRONG>linkhighlight</STRONG>
+ <STRONG>width</STRONG> <STRONG>height</STRONG> <STRONG>state</STRONG> <STRONG>wrap</STRONG>
+ <STRONG>unknownimage</STRONG>
+
+ See the "scrolledhtml" widget manual entry for details on
+ the above associated options.
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>modality</STRONG> <STRONG>title</STRONG>
+
+ See the "shell" manual entry for details on the above inher-
+ ited options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>topics</STRONG>
+ Class: <STRONG>Topics</STRONG>
+ Command-Line Switch: <STRONG>-topics</STRONG>
+
+ Specifies a list of help topics in the form {?<EM>topic</EM>?
+ ... }. <EM>Topic</EM> may either be a topic name, in which case
+ the document associated with the topic should be in the
+ file <STRONG>helpdir</STRONG>/<EM>topic</EM>.html, or it may be of the form {<EM>name</EM>
+ <EM>file</EM>}. In the latter case, <EM>name</EM> is displayed in the
+ topic menu, and selecting the name loads <EM>file</EM>. If file
+ has a relative path, it is assumed to be relative to
+ helpdir.
+
+ Name: <STRONG>helpdir</STRONG>
+ Class: <STRONG>Directory</STRONG>
+ Command-Line Switch: <STRONG>-helpdir</STRONG>
+
+ Specifies the directory where help files are located.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>hyperhelp</STRONG> command creates a shell window with a pulldown
+ menu showing a list of topics. The topics are displayed by
+ importing a HTML formatted file named <STRONG>helpdir</STRONG>/<EM>topic</EM>.html.
+ For a list of supported HTML tags, see <STRONG>scrolledhtml(n)</STRONG>.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>hyperhelp</STRONG> command creates a new Tcl command whose name
+ is <EM>pathName</EM>. This command may be used to invoke various
+ operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for dialog widg-
+ ets:
+
+
+</PRE>
+<H2>INHERITED METHODS</H2><PRE>
+ <STRONG>activate</STRONG> <STRONG>center</STRONG> <STRONG>childsite</STRONG> <STRONG>deactivate</STRONG>
+
+ See the "shell" manual entry for details on the above inher-
+ ited methods.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>hyperhelp</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>hyperhelp</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>showtopic</STRONG> <EM>topic</EM>
+ Display html file <STRONG>helpdir</STRONG>/<EM>topic</EM>.html. <EM>Topic</EM> may option-
+ ally be of the form <EM>topicname</EM>#<EM>anchorname</EM>. In this form,
+ either <EM>topicname</EM> or <EM>anchorname</EM> or both may be empty. If
+ <EM>topicname</EM> is empty, the current topic is assumed. If
+ <EM>anchorname</EM> is empty, the top of the document is assumed
+
+ <EM>pathName</EM> <STRONG>followlink</STRONG> <EM>href</EM>
+ Display html file <EM>href</EM>. <EM>Href</EM> may be optionally be of
+ the form <EM>filename</EM>#<EM>anchorname</EM>. In this form, either
+ <EM>filename</EM> or <EM>anchorname</EM> or both may be empty. If
+ <EM>filename</EM> is empty, the current document is assumed. If
+ <EM>anchorname</EM> is empty, the top of the document is
+ assumed.
+
+ <EM>pathName</EM> <STRONG>forward</STRONG>
+ Display html file one forward in history list, if
+ applicable.
+
+ <EM>pathName</EM> <STRONG>back</STRONG>
+ Display html file one back in history list, if applica-
+ ble.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ hyperhelp .h -topics { Intro Help } -helpdir ~/help
+ .h showtopic Intro
+
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Kris Raney
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ hyperhelp, html, help, shell, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/iwidgets2.2.0UserCmds.html b/itcl/iwidgets3.0.0/demos/html/iwidgets2.2.0UserCmds.html
new file mode 100644
index 00000000000..953e3147c68
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/iwidgets2.2.0UserCmds.html
@@ -0,0 +1,50 @@
+
+<HTML>
+<HEADER>
+<TITLE> iwidgets2.2.0 User Commands </TITLE>
+</HEADER>
+<BODY BGCOLOR = "#FFFFFF">
+<CENTER>
+<H5>iwidgets2.2.0 User Commands</H5>
+</CENTER>
+<HR ALIGN=CENTER WIDTH="80%">
+<UL>
+
+<LI> <A HREF="buttonbox.n.html" TARGET="ManPage"> buttonbox </A>
+<LI> <A HREF="canvasprintbox.n.html" TARGET="ManPage"> canvasprintbox </A>
+<LI> <A HREF="canvasprintdialog.n.html" TARGET="ManPage"> canvasprintdialog </A>
+<LI> <A HREF="combobox.n.html" TARGET="ManPage"> combobox </A>
+<LI> <A HREF="dialog.n.html" TARGET="ManPage"> dialog </A>
+<LI> <A HREF="dialogshell.n.html" TARGET="ManPage"> dialogshell </A>
+<LI> <A HREF="entryfield.n.html" TARGET="ManPage"> entryfield </A>
+<LI> <A HREF="feedback.n.html" TARGET="ManPage"> feedback </A>
+<LI> <A HREF="fileselectionbox.n.html" TARGET="ManPage"> fileselectionbox </A>
+<LI> <A HREF="fileselectiondialog.n.html" TARGET="ManPage"> fileselectiondialog </A>
+<LI> <A HREF="hyperhelp.n.html" TARGET="ManPage"> hyperhelp </A>
+<LI> <A HREF="labeledwidget.n.html" TARGET="ManPage"> labeledwidget </A>
+<LI> <A HREF="menubar.n.html" TARGET="ManPage"> menubar </A>
+<LI> <A HREF="messagedialog.n.html" TARGET="ManPage"> messagedialog </A>
+<LI> <A HREF="notebook.n.html" TARGET="ManPage"> notebook </A>
+<LI> <A HREF="optionmenu.n.html" TARGET="ManPage"> optionmenu </A>
+<LI> <A HREF="panedwindow.n.html" TARGET="ManPage"> panedwindow </A>
+<LI> <A HREF="promptdialog.n.html" TARGET="ManPage"> promptdialog </A>
+<LI> <A HREF="pushbutton.n.html" TARGET="ManPage"> pushbutton </A>
+<LI> <A HREF="radiobox.n.html" TARGET="ManPage"> radiobox </A>
+<LI> <A HREF="scrolledcanvas.n.html" TARGET="ManPage"> scrolledcanvas </A>
+<LI> <A HREF="scrolledframe.n.html" TARGET="ManPage"> scrolledframe </A>
+<LI> <A HREF="scrolledhtml.n.html" TARGET="ManPage"> scrolledhtml </A>
+<LI> <A HREF="scrolledlistbox.n.html" TARGET="ManPage"> scrolledlistbox </A>
+<LI> <A HREF="scrolledtext.n.html" TARGET="ManPage"> scrolledtext </A>
+<LI> <A HREF="selectionbox.n.html" TARGET="ManPage"> selectionbox </A>
+<LI> <A HREF="selectiondialog.n.html" TARGET="ManPage"> selectiondialog </A>
+<LI> <A HREF="shell.n.html" TARGET="ManPage"> shell </A>
+<LI> <A HREF="spindate.n.html" TARGET="ManPage"> spindate </A>
+<LI> <A HREF="spinint.n.html" TARGET="ManPage"> spinint </A>
+<LI> <A HREF="spinner.n.html" TARGET="ManPage"> spinner </A>
+<LI> <A HREF="spintime.n.html" TARGET="ManPage"> spintime </A>
+<LI> <A HREF="tabnotebook.n.html" TARGET="ManPage"> tabnotebook </A>
+<LI> <A HREF="tabset.n.html" TARGET="ManPage"> tabset </A>
+<LI> <A HREF="toolbar.n.html" TARGET="ManPage"> toolbar </A>
+</UL>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/labeledwidget.n.html b/itcl/iwidgets3.0.0/demos/html/labeledwidget.n.html
new file mode 100644
index 00000000000..f84526c2bd0
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/labeledwidget.n.html
@@ -0,0 +1,250 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - labeledwidget</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - labeledwidget</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ labeledwidget - Create and manipulate a labeled widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>labeledwidget</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- labeledwidget
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>background</STRONG> <STRONG>cursor</STRONG> <STRONG>foreground</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>labelBitmap</STRONG>
+ Class: <STRONG>Bitmap</STRONG>
+ Command-Line Switch: <STRONG>-labelbitmap</STRONG>
+
+ Specifies a bitmap to display in the widget, in any of
+ the forms acceptable to <STRONG>Tk_GetBitmap</STRONG>. This option
+ overrides the <EM>labeltext</EM> option.
+
+ Name: <STRONG>labelFont</STRONG>
+ Class: <STRONG>Font</STRONG>
+ Command-Line Switch: <STRONG>-labelfont</STRONG>
+
+ Specifies the font to be used for the label.
+
+ Name: <STRONG>labelImage</STRONG>
+ Class: <STRONG>Image</STRONG>
+ Command-Line Switch: <STRONG>-labelimage</STRONG>
+
+ Specifies a image to be used as the label. The image
+ may be any of the values created by the <STRONG>image</STRONG> <STRONG>create</STRONG>
+ command. This option overrides both the <EM>labelbitmap</EM>
+ and <EM>labeletext</EM> options.
+
+ Name: <STRONG>labelMargin</STRONG>
+ Class: <STRONG>Margin</STRONG>
+ Command-Line Switch: <STRONG>-labelmargin</STRONG>
+
+ Specifies the distance between the childsite and label
+ in any of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The
+ default is 1 pixel.
+
+ Name: <STRONG>labelPos</STRONG>
+ Class: <STRONG>Position</STRONG>
+ Command-Line Switch: <STRONG>-labelpos</STRONG>
+ Specifies the position of the label along the side of
+ the childsite: <STRONG>n</STRONG>, <STRONG>ne</STRONG>, <STRONG>e</STRONG>, <STRONG>se</STRONG>, <STRONG>s</STRONG>, <STRONG>sw</STRONG>, <STRONG>w</STRONG>, or <STRONG>nw</STRONG>. The
+ default is w.
+
+ Name: <STRONG>labelText</STRONG>
+ Class: <STRONG>Text</STRONG>
+ Command-Line Switch: <STRONG>-labeltext</STRONG>
+
+ Specifies the text of the label around the childsite.
+
+ Name: <STRONG>labelVariable</STRONG>
+ Class: <STRONG>Variable</STRONG>
+ Command-Line Switch: <STRONG>-labelvariable</STRONG>
+
+ Specifies the text variable of the label around the
+ childsite.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>labeledwidget</STRONG> command creates a labeled widget which
+ contains a label and child site. The child site is a frame
+ which can filled with any widget via a derived class or
+ though the use of the childsite method. This class was
+ designed to be a general purpose base class for supporting
+ the combination of label widget and a childsite. The
+ options include the ability to position the label around the
+ childsite widget, modify the font and margin, and control
+ the display of the labels.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>labeledwidget</STRONG> command creates a new Tcl command whose
+ name is <EM>pathName</EM>. This command may be used to invoke vari-
+ ous operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for labeledwidget
+ widgets:
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>childsite</STRONG>
+ Return the path name of the child site.
+
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>labeledwidget</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>labeledwidget</STRONG> command.
+
+
+
+</PRE>
+<H2>STATIC METHODS</H2><PRE>
+ <STRONG>Labeledwidget::alignlabels</STRONG> <EM>widget</EM> ?<EM>widget</EM> ...?
+ The alignlabels procedure takes a list of widgets
+ derived from the Labeledwidget class and uses the label
+ margin to make each widget have the same total space
+ for the combination of label and margin. The net
+ effect is to left align the labels. Generally, this
+ method is only useful with a label position of w, which
+ is the default.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>label</STRONG>
+ Class: <STRONG>label</STRONG>
+
+ The label component provides the label for the labeled
+ widget. See the "label" widget manual entry for
+ details on the label component item.
+
+ Name: <STRONG>lwchildsite</STRONG>
+ Class: <STRONG>frame</STRONG>
+
+ The lwchildsite component is the user child site for
+ the labeled widget. See the "frame" widget manual
+ entry for details on the lwchildsite component item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ The labeledwidget was primarily meant to be a base
+ class. The ScrolledListBox and EntryField are good
+ examples of derived classes of the labeledwidget class.
+ In order to provide equal support for composite
+ classes, the 'childsite' methods also exists. The fol-
+ lowing is an example of 'childsite' method usage.
+
+
+ labeledwidget .lw -labeltext "Canvas Widget" -labelpos s
+ pack .lw -fill both -expand yes -padx 10 -pady 10
+
+ set cw [canvas [.lw childsite].c -relief raised -width 200 -height 200]
+ pack $cw -padx 10 -pady 10
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Mark L. Ulferts
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ labeledwidget, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/menubar.n.html b/itcl/iwidgets3.0.0/demos/html/menubar.n.html
new file mode 100644
index 00000000000..ad2a33da95d
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/menubar.n.html
@@ -0,0 +1,563 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - menubar</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - menubar</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ menubar - Create and manipulate menubar menu widgets
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>menubar</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- menubar
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>activeBackground</STRONG> <STRONG>borderWidth</STRONG> <STRONG>highlightBackgroundpadY</STRONG>
+ <STRONG>activeBorderWidth</STRONG> <STRONG>cursor</STRONG> <STRONG>highligthThicknessrelief</STRONG>
+ <STRONG>activeForeground</STRONG> <STRONG>disabledForegroundhighlightColorwrapLength</STRONG>
+ <STRONG>anchor</STRONG> <STRONG>font</STRONG> <STRONG>justify</STRONG>
+ <STRONG>background</STRONG> <STRONG>foreground</STRONG> <STRONG>padX</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>helpVariable</STRONG>
+ Class: <STRONG>HelpVariable</STRONG>
+ Command-Line Switch: <STRONG>-helpvariable</STRONG>
+
+ Specifies the global variable to update whenever the
+ mouse is in motion over a menu entry. This global vari-
+ able is updated with the current value of the active
+ menu entry's <STRONG>helpStr</STRONG>. Other widgets can "watch" this
+ variable with the trace command, or as is the case with
+ entry or label widgets, they can set their <STRONG>textVariable</STRONG>
+ to the same global variable. This allows for a simple
+ implementation of a help status bar. Whenever the mouse
+ leaves a menu entry, the helpVariable is set to the
+ empty string {}. The mainwindow(1) associates its
+ helpstatus and its menubar in this fashion.
+
+ Name: <STRONG>menuButtons</STRONG>
+ Class: <STRONG>MenuButtons</STRONG>
+ Command-Line Switch: <STRONG>-menubuttons</STRONG>
+
+ The menuButton option is a string which specifies the
+ arrangement of menubuttons on the menubar frame. Each
+ menubutton entry is delimited by the newline character.
+
+ menubar .mb -menubuttons {
+ menubutton file -text File
+ menubutton edit -text Edit
+ menubutton options -text Options
+ }
+
+ specifies that three menubuttons will be added to the
+ menubar (file, edit, options). Each entry is translated
+ into an add command call.
+
+ The <STRONG>menuButtons</STRONG> option can accept embedded variables,
+ commands, and backslash quoting. Embedded variables and
+ commands must be enclosed in curly braces ({}) to
+ ensure proper parsing of the substituted values.
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>menubar</STRONG> command creates a new window (given by the <EM>path-</EM>
+ <EM>Name</EM> argument) and makes it into a <STRONG>menubar</STRONG> menu widget.
+ Additional options, described above may be specified on the
+ command line or in the option database to configure aspects
+ of the menubar such as its colors and font. The <STRONG>menubar</STRONG> com-
+ mand returns its <EM>pathName</EM> argument. At the time this command
+ is invoked, there must not exist a window named pathName,
+ but pathName's parent must exist.
+
+ A <STRONG>menubar</STRONG> is a widget that simplifies the task of creating
+ menu hierarchies. It encapsulates a <STRONG>frame</STRONG> widget, as well as
+ <STRONG>menubuttons</STRONG>, <STRONG>menus</STRONG>, and menu <STRONG>entries</STRONG>. The menubar allows
+ menus to be specified and referenced in a more consistent
+ manner than using Tk to build menus directly.
+
+ <STRONG>Menubar</STRONG> allows a menu tree to be expressed in a hierachical
+ "language". The <STRONG>menubar</STRONG> accepts a <STRONG>menuButtons</STRONG> option that
+ allows a list of menubuttons to be added to the menubar. In
+ turn, each menubutton accepts a <STRONG>menu</STRONG> option that specifies a
+ list of menu entries to be added to the menubutton's menu.
+ Cascade entries also accept the <STRONG>menu</STRONG> option for specifying a
+ list of menu entries to be added to the cascade's menu.
+
+ Additionally, the menubar allows each component of the menu-
+ bar system to be referenced by a simple <EM>menuPathName</EM> syntax.
+ The menubar also extends the set of options for menu entries
+ to include a <STRONG>helpStr</STRONG> option.
+
+
+</PRE>
+<H2>MENU PATH NAMES</H2><PRE>
+ A <EM>menuPathName</EM> is a series of component names separated by
+ the `.' character. Each menubar component can be referenced
+ via these <EM>menuPathNames</EM>. <EM>menuPathNames</EM> are similar to widget
+ pathNames in Tk. Some correspond directly to a widget path-
+ Name (components of type <STRONG>menu</STRONG> or <STRONG>menubutton</STRONG>), others
+ correspond to a menu entry type. Every widget and entry in a
+ menubar can be referenced with the <EM>menuPathName</EM> naming con-
+ vention. A menubar can have four types of components:
+
+ <STRONG>frame</STRONG>. A menubar holds exactly one frame which manages
+ menubuttons. The frame is always signified by the `.'
+ character as the path name.
+ <STRONG>menubutton</STRONG>. A menubutton corresponds directly to a Tk
+ menubutton. See menubutton(n).
+
+ <STRONG>menu</STRONG>. A menu is attached to a menubutton and
+ corresponds directly to Tk's menu widget. A menu is
+ always signified by the <EM>menuPathName</EM> ending with the
+ keyword <STRONG>menu</STRONG>. See menu(n).
+
+ <STRONG>entry</STRONG>. An entry corresponds directly to Tk's menu
+ widget entries. Menus consist of a column of one line
+ entries. Entries may be of type: <STRONG>command</STRONG>, <STRONG>checkbutton</STRONG>,
+ <STRONG>radiobutton</STRONG>, <STRONG>separator</STRONG>, or <STRONG>cascade</STRONG>. For a complete
+ description of these types see the discussion on
+ <STRONG>ENTRIES</STRONG> in menu(n).
+
+ The suffix of a <EM>menuPathName</EM> may have the form of:
+
+ <EM>tkWidgetName</EM> Specifies the name of the component, either a
+ <STRONG>frame</STRONG>, <STRONG>menubutton</STRONG>, <STRONG>menu</STRONG>, or an <STRONG>entry</STRONG>. This is
+ the normal naming of widgets. For example,
+ .file references a <STRONG>menubutton</STRONG> named <EM>file</EM>.
+
+ The <EM>menuPathName</EM> is a series of segment names, each
+ separated by the '.' character. Segment names may be one of
+ the following forms:
+
+ <EM>number</EM> Specifies the index of the the component. For
+ menubuttons, 0 corresponds to the left-most
+ menubutton of the menu bar frame. As an exam-
+ ple, .<EM>1</EM> would correspond to the second menu-
+ button on the menu bar frame.
+
+ For entries, 0 corresponds to the top-most
+ entry of the menu. For example, .file.0 would
+ correspond to the first entry on the menu
+ attached to the menubutton named <EM>file</EM>.
+
+ <STRONG>end</STRONG> Specifes the last component. For menubuttons,
+ it specifies the right-most entry of the menu
+ bar frame. For menu entries, it specifies the
+ bottom-most entry of the menu.
+
+ <STRONG>last</STRONG> Same as end.
+
+ Finally, menu components always end with the <STRONG>menu</STRONG> keyword.
+ These components are automatically created via the -menu
+ option on menubuttons and cascades or via the <STRONG>add</STRONG> or <STRONG>insert</STRONG>
+ commands.
+
+ <STRONG>menu</STRONG> Specifes the menu pane that is associated with
+ the given menubutton prefix. For example,
+ .<EM>file</EM>.<EM>menu</EM> specifies the menu pane attached to
+ the
+
+ For example, the path .<EM>file</EM>.<EM>new</EM> specifies the entry named
+ new on the menu associated with the file menubutton located
+ on the menu bar. The path .<EM>file</EM>.<EM>menu</EM> specifies the menu pane
+ associated with the menubutton .<EM>file</EM>. The path .<EM>last</EM> speci-
+ fies the last menu on the menu bar. The path .<EM>0</EM>.<EM>last</EM> would
+ specify the first menu (file) and the last entry on that
+ menu (quit), yielding .<EM>file</EM>.<EM>quit</EM>.
+
+ As a restriction, the last name segment of <EM>menuPathName</EM> can-
+ not be one of the keywords last, menu, end, nor may it be a
+ numeric value (integer).
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ The <STRONG>menubar</STRONG> command creates a new Tcl command whose name is
+ <EM>pathName</EM>. This command may be used to invoke various opera-
+ tions on the widget. It has the following general form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand.
+
+ In addition, many of the widget commands for menubar take as
+ one argument a path name to a menu component. These path
+ names are called <EM>menuPathName</EM>s. See the discussion on <STRONG>MENU-</STRONG>
+ <STRONG>BAR</STRONG> <STRONG>PATH</STRONG> <STRONG>NAMES</STRONG> above.
+
+ The following commands are possible for menubar widgets:
+
+ <EM>pathName</EM> <STRONG>add</STRONG> <EM>type</EM> <EM>menuPathName</EM> ?<EM>option</EM> <EM>value</EM> <EM>option</EM> <EM>value</EM>?
+ Adds either a menu to the menu bar or a menu entry to a
+ menu pane.
+
+ If additional arguments are present, they specify
+ <EM>option</EM>s available to component type <STRONG>entry</STRONG>. See the man
+ pages for <STRONG>menu</STRONG>(1) in the section on <STRONG>ENTRIES</STRONG>.
+
+ If <EM>type</EM> is one of <STRONG>cascade</STRONG>, <STRONG>checkbutton</STRONG>, <STRONG>command</STRONG>,
+ <STRONG>radiobutton</STRONG>, or <STRONG>separator</STRONG> it adds a new entry to the
+ bottom of the menu denoted by the prefix of <EM>menuPath-</EM>
+ <EM>Name</EM>. If additonal arguments are present, they specify
+ options available to menu <STRONG>entry</STRONG> widgets. In addition,
+ the <STRONG>helpStr</STRONG> option is added by the menubar widget to
+ all components of type entry.
+
+ <STRONG>-helpstr</STRONG> <EM>value</EM>
+ Specifes the string to associate with the entry.
+ When the mouse moves over the associated entry,
+ the variable denoted by <STRONG>helpVariable</STRONG> is set.
+ Another widget can bind to the helpVariable and
+ thus display status help.
+
+ If the type of the component added is <STRONG>menubutton</STRONG> or
+ <STRONG>cascade</STRONG>, a menubutton or cascade is added to the menu-
+ bar. If additional arguments are present, they specify
+ options available to menubutton or cascade widgets. In
+ addition, the <STRONG>menu</STRONG> option is added by the menubar
+ widget to all menubutton and cascade widgets.
+
+ <STRONG>-menu</STRONG> <EM>menuSpec</EM>
+ This is only valid for <EM>menuPathName</EM>s of type <STRONG>menu-</STRONG>
+ <STRONG>button</STRONG> or <STRONG>cascade</STRONG>. Specifes an option set and/or a
+ set of entries to place on a menu and associate
+ with the menubutton or cascade. The <STRONG>option</STRONG> keyword
+ allows the menu widget to be configured. Each item
+ in the <EM>menuSpec</EM> is treated as add commands (each
+ with the possibility of having other -menu
+ options). In this way a menu can be recursively
+ built.
+
+ The last segment of <EM>menuPathName</EM> cannot be one of
+ the keywords <STRONG>last</STRONG>, <STRONG>menu</STRONG>, <STRONG>end</STRONG>. Additionally, it may
+ not be a <EM>number</EM>. However the <EM>menuPathName</EM> may be
+ referenced in this manner (see discussion of <STRONG>COM-</STRONG>
+ <STRONG>PONENT</STRONG> <STRONG>PATH</STRONG> <STRONG>NAMES</STRONG>).
+
+ Note that the same curly brace quoting rules apply
+ to <STRONG>-menu</STRONG> option strings as did to <STRONG>-menubuttons</STRONG>
+ option strings. See the earlier discussion on
+ <STRONG>umenubuttons</STRONG> in the "<STRONG>WIDGET-SPECIFIC</STRONG> <STRONG>OPTIONS</STRONG>" sec-
+ tion.
+
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>options</EM> <EM>value</EM> <EM>option</EM> <EM>value</EM>?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <STRONG>pathName</STRONG>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no value, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no option is
+ specified). If one or more option-value pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string.
+
+ <EM>pathName</EM> <STRONG>delete</STRONG> <EM>menuPathName</EM> ?<EM>menuPathName2</EM>?
+ If <EM>menuPathName</EM> is of component type <STRONG>Menubutton</STRONG> or
+ <STRONG>Menu</STRONG>, delete operates on menus. If <EM>menuPathName</EM> is of
+ component type <STRONG>Entry</STRONG>, delete operates on menu entries.
+
+ This command deletes all components between <EM>menuPath-</EM>
+ <EM>Name</EM> and <EM>menuPathName2</EM> inclusive. If <EM>menuPathName2</EM> is
+ omitted then it defaults to <EM>menuPathName</EM>. Returns an
+ empty string.
+
+ If <EM>menuPathName</EM> is of type menubar, then all menus and
+ the menu bar frame will be destroyed. In this case
+ <EM>menuPathName2</EM> is ignored.
+
+ <EM>pathName</EM> <STRONG>index</STRONG> <EM>menuPathName</EM>
+ If <EM>menuPathName</EM> is of type menubutton or menu, it
+ returns the position of the menu/menubutton on the
+ menubar frame.
+
+ If <EM>menuPathName</EM> is of type <STRONG>command</STRONG>, <STRONG>separator</STRONG>,
+ <STRONG>radiobutton</STRONG>, <STRONG>checkbutton</STRONG>, or <STRONG>cascade</STRONG>, it returns the
+ menu widget's numerical index for the entry correspond-
+ ing to <EM>menuPathName</EM>. If path is not found or the path
+ is equal to ".", a value of -1 is returned.
+
+ <EM>pathName</EM> <STRONG>insert</STRONG> <EM>menuPathName</EM> <EM>type</EM> <EM>name</EM> ?<EM>option</EM> <EM>value</EM>?
+ Insert a new component named name before the component
+ specified by <EM>menuPathName</EM>.
+
+ If <EM>menuPathName</EM> is of type <STRONG>Menubutton</STRONG> or <STRONG>Menu</STRONG>, the new
+ component inserted is of type <STRONG>Menu</STRONG> and given the name
+ name. In this case valid <EM>option</EM> <EM>value</EM> pairs are those
+ accepted by menubuttons.
+
+ If <EM>menuPathName</EM> is of type <STRONG>Entry</STRONG>, the new component
+ inserted is of type <STRONG>entry</STRONG> and given the name <EM>name</EM>. In
+ this case, valid <EM>option</EM> <EM>value</EM> pairs are those accepted
+ by menu entries. <EM>Name</EM> cannot be one of the keywords
+ <STRONG>last</STRONG>, <STRONG>menu</STRONG>, <STRONG>end</STRONG>. Additionally, it may not be a number.
+ However the <EM>menuPathName</EM> may be referenced in this
+ manner (see discussion of <STRONG>COMPONENT</STRONG> <STRONG>PATH</STRONG> <STRONG>NAMES</STRONG>).
+
+ <EM>pathName</EM> <STRONG>invoke</STRONG> <EM>menuPathName</EM>
+ Invoke the action of the menu entry denoted by <EM>menu-</EM>
+ <EM>PathName</EM>. See the sections on the individual entries in
+ the menu(1) man pages. If the menu entry is disabled
+ then nothing happens. If the entry has a command asso-
+ ciated with it then the result of that command is
+ returned as the result of the <STRONG>invoke</STRONG> widget command.
+ Otherwise the result is an empty string.
+
+ If <EM>menuPathName</EM> is not a menu entry, an error is
+ issued.
+
+ <EM>pathName</EM> <STRONG>menucget</STRONG> <EM>menuPathName</EM> ?<EM>option</EM> <EM>value</EM> <EM>option</EM> <EM>value</EM>?
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. The component type of <EM>menuPathName</EM>
+ determines the valid available options.
+
+ <EM>pathName</EM> <STRONG>menuconfigure</STRONG> <EM>menuPathName</EM> ?<EM>option</EM> <EM>value</EM>?
+ Query or modify the configuration options of the com-
+ ponet of the menubar specified by <EM>menuPathName</EM>. If no
+ <EM>option</EM> is specified, returns a list describing all of
+ the available options for <EM>menuPathName</EM> (see
+ <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of this
+ list). If <EM>option</EM> is specified with no value, then the
+ command returns a list describing the one named option
+ (this list will be identical to the corresponding sub-
+ list of the value returned if no option is specified).
+ If one or more option-value pairs are specified, then
+ the command modifies the given widget option(s) to have
+ the given value(s); in this case the command returns an
+ empty string. The component type of <EM>menuPathName</EM> deter-
+ mines the valid available options.
+
+ <EM>pathName</EM> <STRONG>path</STRONG> ?<EM>mode</EM>? <EM>pattern</EM>
+ Returns a fully formed <EM>menuPathName</EM> that matches <EM>pat-</EM>
+ <EM>tern</EM>. If no match is found it returns -1. The <EM>mode</EM>
+ argument indicates how the search is to be matched
+ against <EM>pattern</EM> and it must have one of the following
+ values:
+
+ <STRONG>-glob</STRONG>
+ Pattern is a glob-style pattern which is matched
+ against each component path using the same rules
+ as the string match command.
+
+ <STRONG>-regexp</STRONG>
+ Pattern is treated as a regular expression and
+ matched against each component of the <EM>menuPathName</EM>
+ using the same rules as the regexp command. The
+ default mode is -glob.
+
+ <EM>pathName</EM> <STRONG>type</STRONG> <EM>menuPathName</EM>
+ Returns the type of the component specified by <EM>menu-</EM>
+ <EM>PathName</EM>. For menu entries, this is the type argument
+ passed to the <STRONG>add</STRONG>/<STRONG>insert</STRONG> widget command when the entry
+ was created, such as <STRONG>command</STRONG> or <STRONG>separator</STRONG>. Othewise it
+ is either a <STRONG>menubutton</STRONG> or a <STRONG>menu</STRONG>.
+
+ <EM>pathName</EM> <STRONG>yposition</STRONG> <EM>menuPathName</EM>
+ Returns a decimal string giving the y-coordinate within
+ the menu window of the topmost pixel in the entry
+ specified by <EM>menuPathName</EM>. If the <EM>menuPathName</EM> is not
+ an entry, an error is issued.
+
+
+</PRE>
+<H2>EXAMPLE ONE: USING GRAMMAR</H2><PRE>
+ The following example creates a menubar with "File", "Edit",
+ "Options" menubuttons. Each of these menubuttons has an
+ associated menu. In turn the File menu has menu entries, as
+ well as the Edit menu and the Options menu. The Options menu
+ is a tearoff menu with selectColor (for radiobuttons) set to
+ blue. In addition, the Options menu has a cascade titled
+ More, with several menu entries attached to it as well. An
+ entry widget is provided to display help status.
+
+ menubar .mb -helpvariable helpVar -menubuttons {
+ menubutton file -text File -menu {
+ options -tearoff false
+ command new -label New \
+ -helpstr "Open new document" \
+ -command {puts NEW}
+ command close -label Close \
+ -helpstr "Close current document" \
+ -command {puts CLOSE}
+ separator sep1
+ command exit -label Exit -command {exit} \
+ -helpstr "Exit application"
+ }
+ menubutton edit -text Edit -menu {
+ options -tearoff false
+ command undo -label Undo -underline 0 \
+ -helpstr "Undo last command" \
+ -command {puts UNDO}
+ separator sep2
+ command cut -label Cut -underline 1 \
+ -helpstr "Cut selection to clipboard" \
+ -command {puts CUT}
+ command copy -label Copy -underline 1 \
+ -helpstr "Copy selection to clipboard" \
+ -command {puts COPY}
+ command paste -label Paste -underline 0 \
+ -helpstr "Paste clipboard contents" \
+ -command {puts PASTE}
+ }
+ menubutton options -text Options -menu {
+ options -tearoff false -selectcolor blue
+ radiobutton byName -variable viewMode \
+ -value NAME -label "by Name" \
+ -helpstr "View files by name order" \
+ -command {puts NAME}
+ radiobutton byDate -variable viewMode \
+ -value DATE -label "by Date" \
+ -helpstr "View files by date order" \
+ -command {puts DATE}
+ cascade prefs -label Preferences -menu {
+ command colors -label Colors... \
+ -helpstr "Change text colors" \
+ -command {puts COLORS}
+ command fonts -label Fonts... \
+ -helpstr "Change text font" \
+ -command {puts FONT}
+ }
+ }
+
+ }
+
+ frame .fr -width 300 -height 300
+ entry .ef -textvariable helpVar
+ pack .mb -anchor nw -fill x -expand yes
+ pack .fr -fill both -expand yes
+ pack .ef -anchor sw -fill x -expand yes
+
+
+
+</PRE>
+<H2>EXAMPLE TWO: USING METHODS</H2><PRE>
+ Alternatively the same menu could be created by using the
+ add and configure methods:
+
+ menubar .mb
+ .mb configure -menubuttons {
+ menubutton file -text File -menu {
+ command new -label New
+ command close -label Close
+ separator sep1
+ command quit -label Quit
+ }
+ menubutton edit -text Edit
+ }
+
+
+ .mb add command .edit.undo -label Undo -underline 0
+ .mb add separator .edit.sep2
+ .mb add command .edit.cut -label Cut -underline 1
+ .mb add command .edit.copy -label Copy -underline 1
+ .mb add command .edit.paste -label Paste -underline 0
+
+ .mb add menubutton .options -text Options -menu {
+ radiobutton byName -variable viewMode \
+ -value NAME -label "by Name"
+ radiobutton byDate -variable viewMode \
+ -value DATE -label "by Date"
+ }
+
+ .mb add cascade .options.prefs -label Preferences -menu {
+ command colors -label Colors...
+ command fonts -label Fonts...
+ }
+ pack .mb -side left -anchor nw -fill x -expand yes
+
+
+
+</PRE>
+<H2>CAVEATS</H2><PRE>
+ The <STRONG>-menubuttons</STRONG> option as well as the <STRONG>-menu</STRONG> option is
+ evaluated by menubar with the <STRONG>subst</STRONG> command. The positive
+ side of this is that the option string may contain vari-
+ ables, commands, and/or backslash substitutions. However,
+ substitutions might expand into more than a single word.
+ These expansions can be protected by enclosing candidate
+ substitutions in curly braces ({}). This ensures, for exam-
+ ple, a value for an option will still be treated as a single
+ value and not multiple values. The following example illus-
+ trates this case:
+
+ set fileMenuName "File Menu"
+ set var {}
+ menubar .mb -menubuttons {
+ menubutton file -text {$fileMenuName}
+ menubutton edit -text Edit -menu {
+ checkbutton check \
+ -label Check \
+ -variable {[scope var]} \
+ -onvalue 1 \
+ -offvalue 0
+ }
+ menubutton options -text Options
+ }
+
+ The variable <EM>fileMenuName</EM> will expand to "File Menu"
+ when the <STRONG>subst</STRONG> command is used on the menubutton
+ specification. In addition, the [<STRONG>scope</STRONG>...] command will
+ expand to @scope :: var. By enclosing these inside {}
+ they stay as a single value. Note that only {} work for
+ this. [list...], "" etc. will not protect these from
+ the subst command.
+
+
+</PRE>
+<H2>ACKNOWLEDGMENTS</H2><PRE>
+ Bret Schumaker
+
+ 1994 - Early work on a menubar widget.
+
+ Mark Ulferts, Mark Harrison, John Sigler
+
+ Invaluable feedback on grammar and usability of the
+ menubar widget
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Bill W. Scott
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ frame, menu, menubutton, entries, help
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/messagedialog.n.html b/itcl/iwidgets3.0.0/demos/html/messagedialog.n.html
new file mode 100644
index 00000000000..321baeb58f9
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/messagedialog.n.html
@@ -0,0 +1,253 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - messagedialog</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - messagedialog</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ messagedialog - Create and manipulate a message dialog
+ widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>messagedialog</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Toplevel &lt;- Shell &lt;- Dialogshell &lt;- Dialog &lt;- Mes-
+ sagedialog
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>anchor</STRONG> <STRONG>background</STRONG> <STRONG>bitmap</STRONG> <STRONG>cursor</STRONG>
+ <STRONG>font</STRONG> <STRONG>foreground</STRONG> <STRONG>image</STRONG> <STRONG>justify</STRONG>
+ <STRONG>text</STRONG> <STRONG>wrapLength</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>buttonBoxPadX</STRONG> <STRONG>buttonBoxPadY</STRONG> <STRONG>buttonBoxPos</STRONG> <STRONG>padX</STRONG>
+ <STRONG>padY</STRONG> <STRONG>separator</STRONG> <STRONG>thickness</STRONG>
+
+ See the "dialogshell" widget manual entry for details on the
+ above inherited options.
+
+ <STRONG>master</STRONG> <STRONG>modality</STRONG> <STRONG>title</STRONG>
+
+ See the "shell" widget manual entry for details on the above
+ inherited options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>imagePos</STRONG>
+ Class: <STRONG>Position</STRONG>
+ Command-Line Switch: <STRONG>-imagepos</STRONG>
+
+ Specifies the image position relative to the message
+ text: <STRONG>n</STRONG>, <STRONG>s</STRONG>, <STRONG>e</STRONG>, or <STRONG>w</STRONG>. The default is w.
+
+ Name: <STRONG>textPadX</STRONG>
+ Class: <STRONG>Pad</STRONG>
+ Command-Line Switch: <STRONG>-textpadx</STRONG>
+
+ Specifies a non-negative value indicating how much
+ extra space to request for the message text in the X
+ direction. The value may have any of the forms accept-
+ able to Tk_GetPixels.
+
+ Name: <STRONG>textPadY</STRONG>
+ Class: <STRONG>Pad</STRONG>
+ Command-Line Switch: <STRONG>-textpady</STRONG>
+
+ Specifies a non-negative value indicating how much
+ extra space to request for the message text in the X
+ direction. The value may have any of the forms accept-
+ able to Tk_GetPixels.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>messagedialog</STRONG> command creates a message dialog composite
+ widget. The messagedialog is derived from the Dialog class
+ and is composed of an image and associated message text with
+ commands to manipulate the dialog buttons.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>messagedialog</STRONG> command creates a new Tcl command whose
+ name is <EM>pathName</EM>. This command may be used to invoke vari-
+ ous operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for messagedialog
+ widgets:
+
+
+
+</PRE>
+<H2>INHERITED METHODS</H2><PRE>
+ <STRONG>add</STRONG> <STRONG>buttonconfigure</STRONG> <STRONG>defaulthide</STRONG>
+ <STRONG>insert</STRONG> <STRONG>invoke</STRONG> <STRONG>show</STRONG>
+
+ See the "buttonbox" widget manual entry for details on the
+ above inherited methods.
+
+ <STRONG>childsite</STRONG>
+
+ See the "dialogshell" widget manual entry for details on the
+ above inherited methods.
+
+ <STRONG>activate</STRONG> <STRONG>center</STRONG> <STRONG>deactivate</STRONG>
+
+ See the "dialogshell" widget manual entry for details on the
+ above inherited methods.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>messagedialog</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>messagedialog</STRONG> command.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>image</STRONG>
+ Class: <STRONG>Label</STRONG>
+
+ The image component is the bitmap or image of the mes-
+ sage dialog. See the "label" widget manual entry for
+ details on the image component item.
+
+ Name: <STRONG>msg</STRONG>
+ Class: <STRONG>Label</STRONG>
+
+ The msg component provides the textual portion of the
+ message dialog. See the "label" widget manual entry
+ for details on the msg component item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ #
+ # Standard question message dialog used for confirmation.
+ #
+ messagedialog .md -title "Message Dialog" -text "Are you sure ?" \
+ -bitmap questhead -modality global
+
+ .md hide Help
+ .md buttonconfigure OK -text Yes
+ .md buttonconfigure Cancel -text No
+
+ if {[.md activate]} {
+ .md configure -text "Are you really sure ?"
+ if {[.md activate]} {
+ puts stdout "Yes"
+ } else {
+ puts stdout "No"
+ }
+ } else {
+ puts stdout "No"
+
+ }
+
+ destroy .md
+
+ #
+ # Copyright notice with automatic deactivation.
+ #
+ messagedialog .cr -title "Copyright" -bitmap @dsc.xbm -imagepos n \
+ -text "Copyright 1995 DSC Communications Corporation\n \
+ All rights reserved"
+
+ .cr hide Apply
+ .cr hide Cancel
+ .cr hide Help
+
+ .cr activate
+ after 10000 ".cr deactivate"
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Mark L. Ulferts
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ messagedialog, dialog, dialogshell, shell, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/notebook.n.html b/itcl/iwidgets3.0.0/demos/html/notebook.n.html
new file mode 100644
index 00000000000..5dfd49c2d00
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/notebook.n.html
@@ -0,0 +1,402 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - notebook</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - notebook</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ notebook - create and manipulate notebook widgets
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>notebook</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- notebook
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>background</STRONG> <STRONG>foreground</STRONG> <STRONG>scrollCommand</STRONG> <STRONG>width</STRONG>
+ <STRONG>cursor</STRONG> <STRONG>height</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>auto</STRONG>
+ Class: <STRONG>Auto</STRONG>
+ Command-Line Switch: <STRONG>-auto</STRONG>
+
+ Specifies whether to use the automatic
+ packing/unpacking algorithm of the notebook. A value of
+ <STRONG>true</STRONG> indicates that page frames will be unpacked and
+ packed acoording to the algorithm described in the
+ <STRONG>select</STRONG> command. A value of <STRONG>false</STRONG> leaves the current
+ page packed and subsequent selects, next, or previous
+ commands do not switch pages automatically. In either
+ case the page's associated command (see the <STRONG>add</STRONG>
+ command's description of the <STRONG>command</STRONG> option) is
+ invoked. The value may have any of the forms accepted
+ by the <STRONG>Tcl_GetBoolean</STRONG>, such as true, false, 0, 1, yes,
+ or no.
+
+ For example, if a series of pages in a notebook simply
+ change certain display configurations of a graphical
+ display, the <STRONG>-auto</STRONG> flag could be used. By setting it,
+ the <STRONG>-command</STRONG> procs could do the appropriate reconfigur-
+ ing of the page when the page is switched.
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>notebook</STRONG> command creates a new window (given by the
+ pathName argument) and makes it into a notebook widget.
+ Additional options, described above may be specified on the
+ command line or in the option database to configure aspects
+ of the notebook such as its colors, font, and text. The
+ <STRONG>notebook</STRONG> command returns its <EM>pathName</EM> argument. At the time
+ this command is invoked, there must not exist a window named
+ pathName, but pathName's parent must exist.
+ A notebook is a widget that contains a set of pages. It
+ displays one page from the set as the selected page. When a
+ page is selected, the page's contents are displayed in the
+ page area. When first created a notebook has no pages. Pages
+ may be added or deleted using widget commands described
+ below.
+
+
+
+</PRE>
+<H2>NOTEBOOK PAGES</H2><PRE>
+ A notebook's pages area contains a single child site <STRONG>frame</STRONG>.
+ When a new page is created it is a child of this frame. The
+ page's child site frame serves as a geometry container for
+ applications to pack widgets into. It is this frame that is
+ automatically unpacked or packed when the <STRONG>auto</STRONG> option is
+ <STRONG>true</STRONG>. This creates the effect of one page being visible at a
+ time. When a new page is selected, the previously selected
+ page's child site frame is automatically unpacked from the
+ notebook's child site frame and the newly selected page's
+ child site is packed into the notebook's child site frame.
+
+ However, sometimes it is desirable to handle page changes in
+ a different manner. By specifying the <STRONG>auto</STRONG> option as <STRONG>false</STRONG>,
+ child site packing can be disabled and done differently. For
+ example, all widgets might be packed into the first page's
+ child site frame. Then when a new page is selected, the
+ application can reconfigure the widgets and give the appear-
+ ance that the page was flipped.
+
+ In both cases the <STRONG>command</STRONG> option for a page specifies a Tcl
+ Command to execute when the page is selected. In the case of
+ <STRONG>auto</STRONG> being <STRONG>true</STRONG>, it is called between the unpacking of the
+ previously selected page and the packing of the newly
+ selected page.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ The <STRONG>notebookfR</STRONG> <STRONG>command</STRONG> <STRONG>creates</STRONG> <STRONG>a</STRONG> <STRONG>new</STRONG> <STRONG>Tcl</STRONG> <STRONG>command</STRONG> <STRONG>whose</STRONG> <STRONG>name</STRONG>
+ <STRONG>is</STRONG> <EM>pathName</EM>. This command may be used to invoke various
+ operations on the widget. It has the following general form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand.
+
+ Many of the widget commands for a notebook take as one argu-
+ ment an indicator of which page of the notebook to operate
+ on. These indicators are called indexes and may be specified
+ in any of the following forms:
+
+ <EM>number</EM>
+ Specifies the index of the the component. For menus, 0
+ corresponds to the left-most menu of the menu bar. For
+ entries, 0 corresponds to the top-most entry of the
+ menu. <EM>number</EM> Specifies the page numerically, where 0
+ corresponds to the first page in the notebook, 1 to the
+ second, and so on.
+
+ <STRONG>select</STRONG>
+ Specifies the currently selected page's index. If no
+ page is currently selected, the value -1 is returned.
+
+ <STRONG>end</STRONG> Specifes the last page in the notebooks's index. If the
+ notebook is empty this will return -1.
+
+ <EM>pattern</EM>
+ If the index doesn't satisfy the form of a number, then
+ this form is used. Pattern is pattern-matched against
+ the <STRONG>label</STRONG> of each page in the notebook, in order from
+ the first to the last page, until a matching entry is
+ found. The rules of <STRONG>Tcl_StringMatch</STRONG> are used.
+
+ The following commands are possible for notebook widgets:
+
+ <EM>pathName</EM> <STRONG>add</STRONG> ?<EM>option</EM> <EM>value</EM>?
+ Add a new page at the end of the notebook. A new child
+ site frame is created. Returns the child site pathName.
+ If additional arguments are present, they specify any
+ of the following options:
+
+ <STRONG>-background</STRONG> <EM>value</EM>
+ Specifies a background color to use for displaying
+ the child site frame of this page. If this option
+ is specified as an empty string (the default),
+ then the background option for the overall note-
+ book is used.
+
+ <STRONG>-command</STRONG> <EM>value</EM>
+ Specifies a Tcl command to be executed when this
+ page is selected. This allows the programmer a
+ hook to reconfigure this page's widgets or any
+ other page's widgets.
+
+ If the notebook has the auto option set to true,
+ when a page is selected this command will be
+ called immediately after the previously selected
+ page is unpacked and immediately before this page
+ is selected. The index value select is valid dur-
+ ing this Tcl command. `index select' will return
+ this page's page number.
+
+ If the auto option is set to false, when a page is
+ selected the unpack and pack calls are bypassed.
+ This Tcl command is still called.
+
+ <STRONG>-foreground</STRONG> <EM>value</EM>
+ Specifies a foreground color to use for displaying
+ tab labels when tabs are in their normal
+ unselected state. If this option is specified as
+ an empty string (the default), then the foreground
+ option for the overall notebook is used.
+
+ <STRONG>-label</STRONG> <EM>value</EM>
+ Specifies a string to associate with this page.
+ This label serves as an additional identifier used
+ to reference the page. This label may be used for
+ the index value in widget commands.
+
+ <EM>pathName</EM> <STRONG>childSite</STRONG> ?<EM>index</EM>?
+ If passed no arguments, returns a list of pathNames for
+ all the pages in the notebook. If the notebook is
+ empty, an empty list is returned
+
+ If index is passed, it returns the pathName for the
+ page's child site frame specified by index. Widgets
+ that are created with this pathName will be displayed
+ when the associated page is selected. If index is not a
+ valid index, an empty string is returned.
+
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no option is
+ specified). If one or more option-value pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any of
+ the values accepted by the <STRONG>notebook</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>delete</STRONG> <EM>index1</EM> ?index2?
+ Delete all of the pages between <EM>index1</EM> and <EM>index2</EM>
+ inclusive. If <EM>index2</EM> is omitted then it defaults to
+ <EM>index1</EM>. Returns an empty string.
+
+ <EM>pathName</EM> <STRONG>index</STRONG> <EM>index</EM>
+ Returns the numerical index corresponding to <EM>index</EM>.
+
+ <STRONG>pathName</STRONG> <STRONG>insert</STRONG> <EM>index</EM> ?<EM>option</EM> <EM>value</EM>?
+ Insert a new page in the notebook before the page
+ specified by <EM>index</EM>. A new child site <STRONG>frame</STRONG> is created.
+ See the <STRONG>add</STRONG> command for valid options. Returns the
+ child site pathName.
+
+ <EM>pathName</EM> <STRONG>next</STRONG>
+ Advances the selected page to the next page (order is
+ determined by insertion order). If the currently
+ selected page is the last page in the notebook, the
+ selection wraps around to the first page in the note-
+ book.
+
+ For notebooks with auto set to true the current page's
+ child site is unpacked from the notebook's child site
+ frame. Then the next page's child site is packed into
+ the notebooks child site frame. The Tcl command given
+ with the command option will be invoked between these
+ two operations.
+
+ For notebooks with auto set to false the Tcl command
+ given with the command option will be invoked.
+
+ <EM>pathName</EM> <STRONG>pagecget</STRONG> <EM>index</EM> ?<EM>option</EM>?
+ Returns the current value of the configuration option
+ given by <EM>option</EM> for the page specified by <EM>index</EM>. The
+ valid available options are the same as available to
+ the <STRONG>add</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>pageconfigure</STRONG> <EM>index</EM> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ This command is similar to the configure command,
+ except that it applies to the options for an individual
+ page, whereas configure applies to the options for the
+ notebook. Options may have any of the values accepted
+ by the add widget command. If options are specified,
+ options are modified as indicated in the command and
+ the command returns an empty string. If no options are
+ specified, returns a list describing the current
+ options for page <EM>index</EM> (see <STRONG>Tk_ConfigureInfo</STRONG> for infor-
+ mation on the format of this list).
+
+ <EM>pathName</EM> <STRONG>prev</STRONG>
+ Moves the selected page to the previous page (order is
+ determined by insertion order). If the currently
+ selected page is the first page in the notebook, the
+ selection wraps around to the last page in the note-
+ book.
+
+ For notebooks with <STRONG>auto</STRONG> set to <STRONG>true</STRONG> the current page's
+ child site is unpacked from the notebook's child site
+ frame. Then the previous page's child site is packed
+ into the notebooks child site frame. The Tcl command
+ given with the command option will be invoked between
+ these two operations.
+
+ For notebooks with <STRONG>auto</STRONG> set to <STRONG>false</STRONG> the Tcl command
+ given with the command option will be invoked.
+
+ <EM>pathName</EM> <STRONG>select</STRONG> <EM>index</EM>
+ Selects the page specified by <EM>index</EM> as the currently
+ selected page.
+
+ For notebooks with <STRONG>auto</STRONG> set to <STRONG>true</STRONG> the current page's
+ child site is unpacked from the notebook's child site
+ frame. Then the index page's child site is packed into
+ the notebooks child site frame. The Tcl command given
+ with the command option will be invoked between these
+ two operations.
+
+ For notebooks with <STRONG>auto</STRONG> set to <STRONG>false</STRONG> the Tcl command
+ given with the command option will be invoked.
+
+ <EM>pathName</EM> <STRONG>view</STRONG>
+ Returns the currently selected page. This command is
+ for compatibility with the scrollbar widget.
+
+ <EM>pathName</EM> <STRONG>view</STRONG> <EM>index</EM>
+ Selects the page specified by <EM>index</EM> as the currently
+ selected page. This command is for compatibility with
+ the scrollbar widget.
+
+ <EM>pathName</EM> <STRONG>view</STRONG> <EM>moveto</EM> <EM>fraction</EM>
+ Uses the fraction value to determine the corresponding
+ page to move to. This command is for compatibility with
+ the scrollbar widget.
+
+ <EM>pathName</EM> <STRONG>view</STRONG> <EM>scroll</EM> <EM>num</EM> <EM>what</EM>
+ Uses the <EM>num</EM> value to determine how many pages to move
+ forward or backward (num can be negative or positive).
+ The <EM>what</EM> argument is ignored. This command is for com-
+ patibility with the scrollbar widget.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ Following is an example that creates a notebook with two
+ pages. In this example, we use a scrollbar widget to control
+ the notebook widget.
+
+ # Create the notebook widget and pack it.
+ notebook .nb -width 100 -height 100
+ pack .nb -anchor nw \
+ -fill both \
+ -expand yes \
+ -side left \
+ -padx 10 \
+ -pady 10
+
+ # Add two pages to the notebook, labelled
+ # "Page One" and "Page Two", respectively.
+ .nb add -label "Page One"
+ .nb add -label "Page Two"
+
+ # Get the child site frames of these two pages.
+ set page1CS [.nb childsite 0]
+ set page2CS [.nb childsite "Page Two"]
+
+ # Create buttons on each page of the notebook
+ button $page1CS.b -text "Button One"
+ pack $page1CS.b
+ button $page2CS.b -text "Button Two"
+ pack $page2CS.b
+
+ # Select the first page of the notebook
+ .nb select 0
+
+ # Create the scrollbar and associate teh scrollbar
+ # and the notebook together, then pack the scrollbar
+ ScrollBar .scroll -command ".nb view"
+ .nb configure -scrollcommand ".scroll set"
+ pack .scroll -fill y -expand yes -pady 10
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Bill W. Scott
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ notebook page
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/optionmenu.n.html b/itcl/iwidgets3.0.0/demos/html/optionmenu.n.html
new file mode 100644
index 00000000000..606a8825ed5
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/optionmenu.n.html
@@ -0,0 +1,303 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - optionmenu</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - optionmenu</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ optionmenu - Create and manipulate a option menu widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>optionmenu</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- Labeledwidget &lt;- optionmenu
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>activeBackground</STRONG> <STRONG>activeBorderWidthactiveForegroundbackground</STRONG>
+ <STRONG>borderWidth</STRONG> <STRONG>cursor</STRONG> <STRONG>disabledForegroundfont</STRONG>
+ <STRONG>foreground</STRONG> <STRONG>highlightColor</STRONG> <STRONG>highlightThicknessrelief</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>labelBitmap</STRONG> <STRONG>labelFont</STRONG> <STRONG>labelImage</STRONG> <STRONG>labelMargin</STRONG>
+ <STRONG>labelPos</STRONG> <STRONG>labelText</STRONG> <STRONG>labelVariable</STRONG>
+
+ See the "LabeledWidget" manual entry for details on the
+ inherited options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>clickTime</STRONG>
+ Class: <STRONG>ClickTime</STRONG>
+ Command-Line Switch: <STRONG>-clicktime</STRONG>
+
+ Interval time, in msec, used to determine that a single
+ mouse click has occurred. Used to post menu on a
+ "quick" mouse click. <STRONG>Note</STRONG>: changing this value may
+ cause the sigle-click functionality to not work prop-
+ erly. The default is 150 msec.
+
+ Name: <STRONG>command</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-command</STRONG>
+
+ Specifies a Tcl command procedure to be evaluated fol-
+ lowing a change in the current option menu selection.
+
+ Name: <STRONG>cyclicOn</STRONG>
+ Class: <STRONG>CyclicOn</STRONG>
+ Command-Line Switch: <STRONG>-cyclicon</STRONG>
+
+ Turns on/off the 3rd mouse button capability. The value
+ may be specified in any of the forms acceptable to
+ <STRONG>Tcl_GetBoolean</STRONG>. This feature allows the right mouse
+ button to cycle through the popup menu list without
+ poping it up. The right mouse button cycles through the
+ menu in reverse order. The default is true.
+
+ Name: <STRONG>items</STRONG>
+ Class: <STRONG>Items</STRONG>
+ Command-Line Switch: <STRONG>-items</STRONG>
+
+ Sepcifies the list of items to be displayed in the
+ menu.
+
+ Name: <STRONG>popupCursor</STRONG>
+ Class: <STRONG>Cursor</STRONG>
+ Command-Line Switch: <STRONG>-popupcursor</STRONG>
+
+ Specifies the mouse cursor to be used for the popup
+ menu. The value may have any of the forms acceptable
+ to <STRONG>Tk_GetCursor</STRONG>.
+
+ Name: <STRONG>state</STRONG>
+ Class: <STRONG>State</STRONG>
+ Command-Line Switch: <STRONG>-state</STRONG>
+
+ Specified one of two states for the optionmenu: <STRONG>normal</STRONG>,
+ or <STRONG>disabled</STRONG>. If the optionmenu is disabled, then
+ option menu selection is ignored.
+
+ Name: <STRONG>width</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-width</STRONG>
+
+ Specifies a fixed size for the menu button label in any
+ of the forms acceptable to Tk_GetPixels. If the text
+ is too small to fit in the label, the text is clipped.
+ Note: Normally, when a new list is created, or new
+ items are added to an existing list, the menu button
+ label is resized automatically. Setting this option
+ overrides that functionality.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>optionmenu</STRONG> command creates an option menu widget with
+ options to manage it. An option menu displays a frame con-
+ taining a label and a button. A pop-up menu will allow for
+ the value of the button to change.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>optionmenu</STRONG> command creates a new Tcl command whose name
+ is <EM>pathName</EM>. This command may be used to invoke various
+ operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand.
+
+ Many of the widget commands for an optionmenu take as one
+ argument an indicator of which entry of the option menu to
+ operate on. These indicators are called <EM>index</EM>es and may be
+ specified in any of the following forms:
+
+ <EM>number</EM> Specifies the entry numerically, where 0
+ corresponds to the top-most entry of the option
+ menu, 1 to the entry below it, and so on.
+
+ <STRONG>end</STRONG> Indicates the bottommost entry in the menu. If
+ there are no entries in the menu then zero is
+ returned.
+
+ <STRONG>select</STRONG> Returns the numerical index of the currently
+ selected option menu entry. If no entries exist
+ in the menu, then -1 is returned.
+
+ <EM>pattern</EM> If the index doesn't satisfy one of the above
+ forms then this form is used. <EM>Pattern</EM> is
+ pattern-matched against the label of each entry
+ in the option menu, in order from the top down,
+ until a matching entry is found. The rules of
+ <STRONG>Tcl_StringMatch</STRONG> are used.
+
+ The following widget commands are possible for optionmenu
+ widgets:
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>optionmenu</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>optionmenu</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>delete</STRONG> <EM>first</EM> ?<EM>last</EM>?
+ Delete all of the option menu entries between <EM>first</EM> and
+ <EM>last</EM> inclusive. If <EM>last</EM> is omitted then it defaults to
+ <EM>first</EM>.
+
+ <EM>pathName</EM> <STRONG>disable</STRONG> <EM>index</EM>
+ Disable the option menu entry specified by <EM>index</EM>. Disa-
+ bling a menu item will prevent the user from being able
+ to select this item from the menu. This only effects
+ the state of the item in the menu, in other words,
+ should the item be the currently selected item, the
+ programmer is responsible for determining this condi-
+ tion and taking appropriate action.
+
+ <EM>pathName</EM> <STRONG>enable</STRONG> <EM>index</EM>
+ Enable the option menu entry specified by <EM>index</EM>. Ena-
+ bling a menu item allows the user to select this item
+ from the menu.
+
+ <EM>pathName</EM> <STRONG>get</STRONG>
+ Returns the currently selected option menu item.
+
+ <EM>pathName</EM> <STRONG>index</STRONG> <EM>index</EM>
+ Returns the numerical index corresponding to <EM>index</EM>.
+
+ <EM>pathName</EM> <STRONG>insert</STRONG> <EM>index</EM> <EM>string</EM> ?<EM>string</EM>?
+ Insert an item, or list of items, into the menu at
+ location <EM>index</EM>.
+
+ <EM>pathName</EM> <STRONG>select</STRONG> <EM>index</EM>
+ Select an item from the option menu to be displayed as
+ the currently selected item.
+
+ <EM>pathName</EM> <STRONG>sort</STRONG> <EM>mode</EM>
+ Sort the current menu in either <STRONG>ascending</STRONG>, or <STRONG>descend-</STRONG>
+ <STRONG>ing</STRONG> order. The values <STRONG>increasing</STRONG>, or <STRONG>decreasing</STRONG> are
+ also accepted.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>menuBtn</STRONG>
+ Class: <STRONG>Frame</STRONG>
+
+ The menuBtn component is the option menu button which
+ displays the current choice from the popup menu. See
+ the "frame" widget manual entry for details on the
+ menuBtn component item.
+
+ Name: <STRONG>menuLabel</STRONG>
+ Class: <STRONG>Label</STRONG>
+
+ The menuLabel component is the label whose text is the
+ currently selected choice from the popup menu. See the
+ "label" widget manual entry for details on the menuLa-
+ bel component item.
+
+ Name: <STRONG>popupMenu</STRONG>
+ Class: <STRONG>Menu</STRONG>
+
+ The popupMenu component is menu displayed upon selec-
+ tion of the menu button. The menu contains the choices
+ for the option menu. See the "menu" widget manual
+ entry for details on the popupMenu component item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ optionmenu .om -labelmargin 5 \
+ -labelon true -labelpos w -labeltext "Operating System :" \
+ -items {Unix VMS Linux OS/2 {Windows NT} DOS}
+
+ .om insert end CPM {MS DOS} HP/UX
+ .om sort ascending
+ .om select Linux
+
+ pack .om -padx 10 -pady 10
+
+
+
+</PRE>
+<H2>ACKNOWLEDGEMENTS:</H2><PRE>
+ Michael J. McLennan
+
+ Borrowed some ideas (next &amp; previous) from OptionButton
+ class.
+
+ Steven B. Jaggers
+
+ Provided an initial prototype in [incr Tcl].
+
+ Bret Schuhmacher
+
+ Helped with popup menu functionality.
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Alfredo Jahn
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ optionmenu, widget
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/panedwindow.n.html b/itcl/iwidgets3.0.0/demos/html/panedwindow.n.html
new file mode 100644
index 00000000000..07c9e6dff57
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/panedwindow.n.html
@@ -0,0 +1,353 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - panedwindow</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - panedwindow</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ panedwindow - Create and manipulate a paned window widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>panedwindow</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- panedwindow
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>background</STRONG> <STRONG>cursor</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>height</STRONG>
+ Class: <STRONG>Height</STRONG>
+ Command-Line Switch: <STRONG>-height</STRONG>
+
+ Specifies the overall height of the paned window in any
+ of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The default
+ is 10 pixels.
+
+ Name: <STRONG>orient</STRONG>
+ Class: <STRONG>Orient</STRONG>
+ Command-Line Switch: <STRONG>-orient</STRONG>
+
+ Specifies the orientation of the separators: <STRONG>vertical</STRONG>
+ or <STRONG>horizontal</STRONG>. The default is horizontal.
+
+ Name: <STRONG>sashBorderWidth</STRONG>
+ Class: <STRONG>BorderWidth</STRONG>
+ Command-Line Switch: <STRONG>-sashborderwidth</STRONG>
+
+ Specifies a value indicating the width of the 3-D
+ border to draw around the outside of the sash in any of
+ the forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The default is 2
+ pixels.
+
+ Name: <STRONG>sashCursor</STRONG>
+ Class: <STRONG>Cursor</STRONG>
+ Command-Line Switch: <STRONG>-sashcursor</STRONG>
+
+ Specifies the type of cursor to be displayed in the
+ sash. The default is crosshair.
+
+ Name: <STRONG>sashHeight</STRONG>
+ Class: <STRONG>Height</STRONG>
+ Command-Line Switch: <STRONG>-sashheight</STRONG>
+ Specifies the height of the sash in any of the forms
+ acceptable to <STRONG>Tk_GetPixels</STRONG>. The default is 10 pixels.
+
+ Name: <STRONG>sashIndent</STRONG>
+ Class: <STRONG>SashIndent</STRONG>
+ Command-Line Switch <STRONG>sashindent</STRONG>
+
+ Specifies the placement of the sash along the panes in
+ any of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>. A posi-
+ tive value causes the sash to be offset from the near
+ (left/top) side of the pane, and a negative value
+ causes the sash to be offset from the far
+ (right/bottom) side. If the offset is greater than the
+ width, then the sash is placed flush against the side.
+ The default is -10 pixels.
+
+ Name: <STRONG>sashWidth</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-sashwidth</STRONG>
+
+ Specifies the width of the sash in any of the forms
+ acceptable to <STRONG>Tk_GetPixels</STRONG>. The default is 10 pixels.
+
+ Name: <STRONG>thickness</STRONG>
+ Class: <STRONG>Thickness</STRONG>
+ Command-Line Switch: <STRONG>-thickness</STRONG>
+
+ Specifies the thickness of the separators in any of the
+ forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The default is 3
+ pixels.
+
+ Name: <STRONG>width</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-width</STRONG>
+
+ Specifies the overall width of the paned window in any
+ of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The default
+ is 10 pixels.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>panedwindow</STRONG> command creates a multiple paned window
+ widget capable of orienting the panes either vertically or
+ horizontally. Each pane is itself a frame acting as a child
+ site for other widgets. The border separating each pane
+ contains a sash which allows user positioning of the panes
+ relative to one another.
+
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>panedwindow</STRONG> command creates a new Tcl command whose name
+ is <EM>pathName</EM>. This command may be used to invoke various
+ operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand.
+
+ Many of the widget commands for the <STRONG>panedwindow</STRONG> take as one
+ argument an indicator of which pane of the paned window to
+ operate on. These indicators are called <EM>indexes</EM> and allow
+ reference and manipulation of panes regardless of their
+ current map state. Paned window indexes may be specified in
+ any of the following forms:
+
+ <EM>number</EM> Specifies the pane numerically, where 0
+ corresponds to the nearest (top/left-most) pane
+ of the paned window.
+
+ <STRONG>end</STRONG> Indicates the farthest (bottom/right-most) pane
+ of the paned window.
+
+ <EM>pattern</EM> If the index doesn't satisfy one of the above
+ forms then this form is used. <EM>Pattern</EM> is
+ pattern-matched against the tag of each pane in
+ the panedwindow, in order from left/top to
+ right/left, until a matching entry is found.
+ The rules of <STRONG>Tcl_StringMatch</STRONG> are used.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>add</STRONG> <EM>tag</EM> ?<EM>option</EM> <EM>value</EM> <EM>option</EM> <EM>value</EM>?
+ Adds a new pane to the paned window on the far side
+ (right/bottom). The following options may be speci-
+ fied:
+
+ <STRONG>-margin</STRONG> <EM>value</EM>
+ Specifies the border distance between the pane and
+ pane contents is any of the forms acceptable to
+ <STRONG>Tk_GetPixels</STRONG>. The default is 8 pixels.
+
+ <STRONG>-minimum</STRONG> <EM>value</EM>
+ Specifies the minimum size that a pane's contents
+ may reach not inclusive of twice the margin in any
+ of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The
+ default is 10 pixels.
+
+ The <STRONG>add</STRONG> method returns the path name of the pane.
+
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>panedwindow</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>childsite</STRONG> ?<EM>index</EM>?
+ Returns a list of the child site path names or a
+ specific child site given an index. The list is con-
+ structed from the near side (left/top) to the far side
+ (right/bottom).
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>panedwindow</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>delete</STRONG> <EM>index</EM>
+ Deletes a specified pane given an <EM>index</EM>.
+
+ <EM>pathName</EM> <STRONG>fraction</STRONG> <EM>percentage</EM> <EM>percentage</EM> ?<EM>percentage</EM> <EM>percentage</EM>
+ Sets the visible percentage of the panes. Specifies a
+ set of percentages which are applied to the visible
+ panes from the near side (left/top). The number of
+ percentages must be equal to the current number of
+ visible (mapped) panes and add up to 100.
+
+ <EM>pathName</EM> <STRONG>hide</STRONG> <EM>index</EM>
+ Changes the visiblity of the specified pane, allowing a
+ previously displayed pane to be visually removed rather
+ than deleted.
+
+ <EM>pathName</EM> <STRONG>index</STRONG> <EM>index</EM>
+ Returns the numerical index corresponding to index.
+
+ <EM>pathName</EM> <STRONG>insert</STRONG> <EM>index</EM> <EM>tag</EM> ?<EM>option</EM> <EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Same as the <STRONG>add</STRONG> command except that it inserts the new
+ pane just before the one given by <EM>index</EM>, instead of
+ appending to the end of the panedwindow. The <EM>option</EM>,
+ and <EM>value</EM> arguments have the same interpretation as for
+ the <STRONG>add</STRONG> widget command.
+
+ <EM>pathName</EM> <STRONG>paneconfigure</STRONG> <EM>index</EM> ?<EM>options</EM>?
+ This command is similar to the <STRONG>configure</STRONG> command,
+ except that it applies to the options for an individual
+ pane, whereas <STRONG>configure</STRONG> applies to the options for the
+ paned window as a whole. <EM>Options</EM> may have any of the
+ values accepted by the <STRONG>add</STRONG> widget command. If <EM>options</EM>
+ are specified, options are modified as indicated in the
+ command and the command returns an empty string. If no
+ <EM>options</EM> are specified, returns a list describing the
+ current options for entry <EM>index</EM> (see <STRONG>Tk_ConfigureInfo</STRONG>
+ for information on the format of this list).
+
+ <EM>pathName</EM> <STRONG>reset</STRONG>
+ Redisplays the pane window using default percentages.
+
+ <EM>pathName</EM> <STRONG>show</STRONG> <EM>index</EM>
+ Changes the visiblity of the specified pane, allowing a
+ previously hidden pane to be displayed.
+
+
+
+</PRE>
+<H2>NOTES</H2><PRE>
+ Dynamic changing of the margin and or minimum options
+ to values which make the current configuration invalid
+ will block subsequent sash movement until the fractions
+ are modified via the fraction method. For example a
+ panedwindow is created with three panes and the minimum
+ and margin options are at their default settings. Next
+ the user moves the sashes to compact the panes to one
+ side. Now, if the minimum is increased on the most
+ compressed pane via the paneconfigure method to a large
+ enough value, then sash movement is blocked until the
+ fractions are adjusted. This situation is unusual and
+ under normal operation of the panedwindow, this problem
+ will never occur.
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ panedwindow .pw -width 300 -height 300
+ .pw add top
+ .pw add middle -margin 10
+ .pw add bottom -margin 10 -minimum 10
+
+ pack .pw -fill both -expand yes
+
+ foreach pane [.pw childSite] {
+ button $pane.b -text $pane -relief raised -borderwidth 2
+ pack $pane.b -fill both -expand yes
+ }
+
+ .pw fraction 50 30 20
+ .pw paneconfigure 0 -minimum 20
+ .pw paneconfigure bottom -margin 15
+
+
+
+</PRE>
+<H2>ACKNOWLEDGEMENTS:</H2><PRE>
+ Jay Schmidgall
+
+ 1994 - Base logic posted to comp.lang.tcl
+
+ Joe Hidebrand &lt;hildjj@fuentez.com&gt;
+
+ 07/25/94 - Posted first multipane version to
+ comp.lang.tcl
+
+ 07/28/94 - Added support for vertical panes
+
+ Ken Copeland &lt;ken@hilco.com&gt;
+
+ 09/28/95 - Smoothed out the sash movement and added
+ squeezable panes.
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Mark L. Ulferts
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ panedwindow, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/promptdialog.n.html b/itcl/iwidgets3.0.0/demos/html/promptdialog.n.html
new file mode 100644
index 00000000000..05d4ea73ca6
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/promptdialog.n.html
@@ -0,0 +1,201 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - promptdialog</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - promptdialog</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ promptdialog - Create and manipulate a prompt dialog widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>promptdialog</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Toplevel &lt;- dialogshell &lt;- dialog &lt;- promptdialog
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>background</STRONG> <STRONG>borderWidth</STRONG> <STRONG>cursor</STRONG> <STRONG>exportSelection</STRONG>
+ <STRONG>foreground</STRONG> <STRONG>highlightColor</STRONG> <STRONG>highlightThicknessinsertBackground</STRONG>
+ <STRONG>insertBorderWidth</STRONG> <STRONG>insertOffTime</STRONG> <STRONG>insertOnTimeinsertWidth</STRONG>
+ <STRONG>justify</STRONG> <STRONG>relief</STRONG> <STRONG>selectBackgroundselectBorderWidth</STRONG>
+ <STRONG>selectForeground</STRONG> <STRONG>textVariable</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+ <STRONG>show</STRONG> <STRONG>state</STRONG> <STRONG>width</STRONG>
+
+ See the "entry" widget manual entry for details on the above
+ associated options.
+
+ <STRONG>childSitePos</STRONG> <STRONG>fixed</STRONG> <STRONG>invalid</STRONG> <STRONG>textBackground</STRONG>
+ <STRONG>textFont</STRONG> <STRONG>validate</STRONG>
+
+ See the "entryfield" widget manual entry for details on the
+ above associated options.
+
+ <STRONG>labelBitmap</STRONG> <STRONG>labelFont</STRONG> <STRONG>labelImage</STRONG> <STRONG>labelMargin</STRONG>
+ o<STRONG>labelPos</STRONG> <STRONG>labelText</STRONG>
+
+ See the "labeledwidget" widget manual entry for details on
+ the above associated options.
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>buttonBoxPadX</STRONG> <STRONG>buttonBoxPadY</STRONG> <STRONG>buttonBoxPos</STRONG> <STRONG>padX</STRONG>
+ <STRONG>padY</STRONG> <STRONG>separator</STRONG> <STRONG>thickness</STRONG>
+
+ See the "dialogshell" widget manual entry for details on the
+ above inherited options.
+
+ <STRONG>master</STRONG> <STRONG>modality</STRONG> <STRONG>title</STRONG>
+
+ See the "shell" widget manual entry for details on the above
+ inherited options.
+
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>promptdialog</STRONG> command creates a prompt dialog similar to
+ the OSF/Motif standard prompt dialog composite widget. The
+ promptdialog is derived from the dialog class and is com-
+ posed of a EntryField with commands to manipulate the dialog
+ buttons.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>promptdialog</STRONG> command creates a new Tcl command whose
+ name is <EM>pathName</EM>. This command may be used to invoke vari-
+ ous operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for promptdialog
+ widgets:
+
+
+</PRE>
+<H2>ASSOCIATED METHODS</H2><PRE>
+ <STRONG>delete</STRONG> <STRONG>get</STRONG> <STRONG>icursor</STRONG> <STRONG>index</STRONG>
+ <STRONG>insert</STRONG> <STRONG>scan</STRONG> <STRONG>selection</STRONG> <STRONG>xview</STRONG>
+
+ See the "entry" widget manual entry for details on the above
+ associated methods.
+
+ <STRONG>clear</STRONG>
+
+ See the "entryfield" widget manual entry for details on the
+ above associated methods.
+
+
+</PRE>
+<H2>INHERITED METHODS</H2><PRE>
+ <STRONG>add</STRONG> <STRONG>buttonconfigure</STRONG> <STRONG>defaulthide</STRONG>
+ <STRONG>invoke</STRONG> <STRONG>show</STRONG>
+
+ See the "buttonbox" widget manual entry for details on the
+ above inherited methods.
+
+ <STRONG>childsite</STRONG>
+
+ See the "dialogshell" widget manual entry for details on the
+ above inherited methods.
+
+ <STRONG>activate</STRONG> <STRONG>center</STRONG> <STRONG>deactivate</STRONG>
+
+ See the "shell" widget manual entry for details on the above
+ inherited methods.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>promptdialog</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>promptdialog</STRONG> command.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>ef</STRONG>
+ Class: <STRONG>Entryfield</STRONG>
+
+ The ef component is the entry field for user input in
+ the prompt dialog. See the "entryfield" widget manual
+ entry for details on the ef component item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ option add *textBackground white
+
+ promptdialog .pd -modality global -title Password -labeltext Password: -show *
+ .pd buttonconfigure OK -command {.pd deactivate 1}
+ .pd hide Apply
+ .pd buttonconfigure Cancel -command {.pd deactivate 0}
+ .pd hide Help
+
+ if {[.pd activate]} {
+ puts "Password entered: [.pd get]"
+ } else {
+ puts "Password prompt cancelled"
+ }
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Mark L. Ulferts
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ promptdialog, dialog, dialogshell, shell, widget
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/pushbutton.n.html b/itcl/iwidgets3.0.0/demos/html/pushbutton.n.html
new file mode 100644
index 00000000000..a1a9ceca405
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/pushbutton.n.html
@@ -0,0 +1,197 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - pushbutton</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - pushbutton</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ pushbutton - Create and manipulate a push button widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>pushbutton</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- pushbutton
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>activeBackground</STRONG> <STRONG>activeForegroundanchorbackground</STRONG>
+ <STRONG>bitmap</STRONG> <STRONG>borderWidth</STRONG> <STRONG>command</STRONG> <STRONG>cursor</STRONG>
+ <STRONG>disabledForeground</STRONG> <STRONG>font</STRONG> <STRONG>foregroundhighlightBackground</STRONG>
+ <STRONG>highlightColor</STRONG> <STRONG>highlightThickness</STRONG> <STRONG>imagejustify</STRONG>
+ <STRONG>padX</STRONG> <STRONG>padY</STRONG> <STRONG>state</STRONG> <STRONG>text</STRONG>
+ <STRONG>textVariable</STRONG> <STRONG>underline</STRONG> <STRONG>wrapLength</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>defaultRing</STRONG>
+ Class: <STRONG>DefaultRing</STRONG>
+ Command-Line Switch: <STRONG>-defaultring</STRONG>
+
+ Boolean describing whether the button displays its
+ default ring given in any of the forms acceptable to
+ <STRONG>Tcl_GetBoolean</STRONG>. The default is false.
+
+ Name: <STRONG>defaultRingPad</STRONG>
+ Class: <STRONG>Pad</STRONG>
+ Command-Line Switch: <STRONG>-defaultringpad</STRONG>
+
+ Specifies the amount of space to be allocated to the
+ indentation of the default ring ring given in any of
+ the forms acceptable to <STRONG>Tcl_GetPixels</STRONG>. The option has
+ no effect if the defaultring option is set to false.
+ The default is 2 pixels.
+
+ Name: <STRONG>height</STRONG>
+ Class: <STRONG>Height</STRONG>
+ Command-Line Switch: <STRONG>-height</STRONG>
+
+ Specifies the height of the button inclusive of any
+ default ring given in any of the forms acceptable to
+ <STRONG>Tk_GetPixels</STRONG>. A value of zero lets the push button
+ determine the height based on the requested height plus
+ highlightring and defaultringpad.
+
+
+ Name: <STRONG>width</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-width</STRONG>
+
+ Specifies the width of the button inclusive of any
+ default ring given in any of the forms acceptable to
+ <STRONG>Tk_GetPixels</STRONG>. A value of zero lets the push button
+ determine the width based on the requested width plus
+ highlightring and defaultringpad.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>pushbutton</STRONG> command creates a push button with an
+ optional default ring used for default designation and
+ traversal.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>pushbutton</STRONG> command creates a new Tcl command whose name
+ is <EM>pathName</EM>. This command may be used to invoke various
+ operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for pushbutton
+ widgets:
+
+
+</PRE>
+<H2>ASSOCIATED METHODS</H2><PRE>
+ <STRONG>flash</STRONG> <STRONG>invoke</STRONG>
+
+ See the "button" manual entry for details on the associated
+ methods.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>pushbutton</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the
+ corresponding sublist of the value returned if no
+ <EM>option</EM> is specified). If one or more <EM>option</EM> - <EM>value</EM>
+ pairs are specified, then the command modifies the
+ given widget option(s) to have the given value(s); in
+ this case the command returns an empty string. <EM>Option</EM>
+ may have any of the values accepted by the <STRONG>pushbutton</STRONG>
+ command.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>pushbutton</STRONG>
+ Class: <STRONG>Button</STRONG>
+
+ The pushbutton component is the button surrounded by
+ the optional default ring. See the "button" widget
+ manual entry for details on the pushbutton component
+ item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ pushbutton .pb -text "Hello" -command {puts "Hello World"} -defaultring 1
+ pack .pb -padx 10 -pady 10
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Bret A. Schuhmacher
+
+ Mark L. Ulferts
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ pushbutton, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/radiobox.n.html b/itcl/iwidgets3.0.0/demos/html/radiobox.n.html
new file mode 100644
index 00000000000..25dc0df9c38
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/radiobox.n.html
@@ -0,0 +1,247 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - radiobox</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - radiobox</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ radiobox - Create and manipulate a radiobox widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>radiobox</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- labeledwidget &lt;- radiobox
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>background</STRONG> <STRONG>borderWidth</STRONG> <STRONG>cursor</STRONG> <STRONG>foreground</STRONG>
+ <STRONG>relief</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>labelBitmap</STRONG> <STRONG>labelFont</STRONG> <STRONG>labelImage</STRONG> <STRONG>labelMargin</STRONG>
+ <STRONG>labelPos</STRONG> <STRONG>labelText</STRONG> <STRONG>labelVariable</STRONG>
+
+ See the "labeledwidget" class manual entry for details on
+ the inherited options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>command</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-command</STRONG>
+
+ Specifies a Tcl command procedure to be evaluated fol-
+ lowing a change in the current radio box selection.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>radiobox</STRONG> command creates a radio button box widget capa-
+ ble of adding, inserting, deleting, selecting, and configur-
+ ing radiobuttons as well as obtaining the currently selected
+ button.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>radiobox</STRONG> command creates a new Tcl command whose name is
+ <EM>pathName</EM>. This command may be used to invoke various opera-
+ tions on the widget. It has the following general form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand.
+ Many of the widget commands for the <STRONG>radiobox</STRONG> take as one
+ argument an indicator of which radiobutton of the radiobox
+ to operate on. These indicators are called <EM>indexes</EM> and
+ allow reference and manipulation of radiobuttons. Radiobox
+ indexes may be specified in any of the following forms:
+
+ <EM>number</EM> Specifies the radiobutton numerically, where 0
+ corresponds to the top radiobutton of the
+ radiobox.
+
+ <STRONG>end</STRONG> Indicates the last radiobutton of the radiobox.
+
+ <EM>pattern</EM> If the index doesn't satisfy one of the above
+ forms then this form is used. <EM>Pattern</EM> is
+ pattern-matched against the tag of each
+ radiobutton in the radiobox, in order from top
+ to bottom, until a matching entry is found. The
+ rules of <STRONG>Tcl_StringMatch</STRONG> are used.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>add</STRONG> <EM>tag</EM> ?<EM>option</EM> <EM>value</EM> <EM>option</EM> <EM>value</EM>?
+ Adds a new radiobutton to the radiobuttond window on
+ the bottom. The command takes additional options which
+ are passed on to the radiobutton as construction argu-
+ ments. These include the standard Tk radiobutton
+ options. The tag is returned.
+
+ <EM>pathName</EM> <STRONG>buttonconfigure</STRONG> <EM>index</EM> ?<EM>options</EM>?
+ This command is similar to the <STRONG>configure</STRONG> command,
+ except that it applies to the options for an individual
+ radiobutton, whereas <STRONG>configure</STRONG>applies to the options
+ for the radiobox as a whole. <EM>Options</EM> may have any of
+ the values accepted by the <STRONG>add</STRONG> widget command. If
+ <EM>options</EM> are specified, options are modified as indi-
+ cated in the command and the command returns an empty
+ string. If no <EM>options</EM> are specified, returns a list
+ describing the current options for entry <EM>index</EM> (see
+ <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of this
+ list).
+
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>radiobox</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>radiobox</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>delete</STRONG> <EM>index</EM>
+ Deletes a specified radiobutton given an <EM>index</EM>.
+
+ <EM>pathName</EM> <STRONG>deselect</STRONG> <EM>index</EM>
+ Deselects a specified radiobutton given an <EM>index</EM>.
+
+ <EM>pathName</EM> <STRONG>flash</STRONG> <EM>index</EM>
+ Flashes a specified radiobutton given an <EM>index</EM>.
+
+ <EM>pathName</EM> <STRONG>get</STRONG>
+ Returns the tag of the currently selected radiobutton.
+
+ <EM>pathName</EM> <STRONG>index</STRONG> <EM>index</EM>
+ Returns the numerical index corresponding to index.
+
+ <EM>pathName</EM> <STRONG>insert</STRONG> <EM>index</EM> <EM>tag</EM> ?<EM>option</EM> <EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Same as the <STRONG>add</STRONG> command except that it inserts the new
+ radiobutton just before the one given by <EM>index</EM>, instead
+ of appending to the end of the radiobox. The <EM>option</EM>,
+ and <EM>value</EM> arguments have the same interpretation as for
+ the <STRONG>add</STRONG> widget command.
+
+ <EM>pathName</EM> <STRONG>select</STRONG> <EM>index</EM>
+ Selects a specified radiobutton given an <EM>index</EM>.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ radiobox .rb -labeltext Fonts
+ .rb add times -text Times
+ .rb add helvetica -text Helvetica
+ .rb add courier -text Courier
+ .rb add symbol -text Symbol
+ .rb select courier
+
+ pack .rb -padx 10 -pady 10 -fill both -expand yes
+
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Michael J. McLennan
+
+ Mark L. Ulferts
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ radiobox, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/scrolledcanvas.n.html b/itcl/iwidgets3.0.0/demos/html/scrolledcanvas.n.html
new file mode 100644
index 00000000000..bf0da2c7f77
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/scrolledcanvas.n.html
@@ -0,0 +1,306 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - scrolledcanvas</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - scrolledcanvas</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ scrolledcanvas - Create and manipulate scrolled canvas widg-
+ ets
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>scrolledcanvas</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- Labeledwidget &lt;- scrolledcanvas
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>activeBackground</STRONG> <STRONG>background</STRONG> <STRONG>borderWidthcursor</STRONG>
+ <STRONG>exportSelection</STRONG> <STRONG>font</STRONG> <STRONG>foreground</STRONG> <STRONG>highlightColor</STRONG>
+ <STRONG>highlightThickness</STRONG> <STRONG>insertBorderWidthinsertOffTimeinsertOnTime</STRONG>
+ <STRONG>insertWidth</STRONG> <STRONG>relief</STRONG> <STRONG>repeatDelay</STRONG> <STRONG>repeatInterval</STRONG>
+ <STRONG>selectBackground</STRONG> <STRONG>selectBorderWidthselectForeground</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+ <STRONG>closeEnough</STRONG> <STRONG>confine</STRONG> <STRONG>scrollRegion</STRONG> <STRONG>xScrollIncrement</STRONG>
+ <STRONG>yScrollIncrement</STRONG>
+
+ See the "canvas" widget manual entry for details on the
+ above associated options.
+
+ <STRONG>activeRelief</STRONG> <STRONG>elementBorderWidth</STRONG> <STRONG>jumptroughColor</STRONG>
+
+ See the "scrollbar" widget manual entry for details on the
+ above associated options.
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>labelBitmap</STRONG> <STRONG>labelFont</STRONG> <STRONG>labelImage</STRONG> <STRONG>labelMargin</STRONG>
+ <STRONG>labelPos</STRONG> <STRONG>labelText</STRONG> <STRONG>labelVariable</STRONG>
+
+ See the "labeledwidget" class manual entry for details on
+ the inherited options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>autoMargin</STRONG>
+ Class: <STRONG>AutoMargin</STRONG>
+ Command-Line Switch: <STRONG>-automargin</STRONG>
+
+ Specifies the autoresize extra margin to reserve. This
+ option is only effective with autoresize turned on.
+ The default is 10.
+
+ Name: <STRONG>autoResize</STRONG>
+ Class: <STRONG>AutoResize</STRONG>
+ Command-Line Switch: <STRONG>-autoresize</STRONG>
+
+ Automatically adjusts the scrolled region to be the
+ bounding box covering all the items in the canvas fol-
+ lowing the execution of any method which creates or
+ destroys items. Thus, as new items are added, the
+ scrollbars adjust accordingly.
+
+ Name: <STRONG>height</STRONG>
+ Class: <STRONG>Height</STRONG>
+ Command-Line Switch: <STRONG>-height</STRONG>
+
+ Specifies the height of the scrolled canvas widget in
+ any of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The
+ default height is 30 pixels.
+
+ Name: <STRONG>hscrollMode</STRONG>
+ Class: <STRONG>ScrollMode</STRONG>
+ Command-Line Switch: <STRONG>-hscrollmode</STRONG>
+
+ Specifies the the display mode to be used for the hor-
+ izontal scrollbar: <STRONG>static,</STRONG> <STRONG>dynamic,</STRONG> or <STRONG>none</STRONG>. In static
+ mode, the scroll bar is displayed at all times.
+ Dynamic mode displays the scroll bar as required, and
+ none disables the scroll bar display. The default is
+ static.
+
+ Name: <STRONG>sbWidth</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-sbwidth</STRONG>
+
+ Specifies the width of the scrollbar in any of the
+ forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The default width is
+ 15 pixels..
+
+ Name: <STRONG>scrollMargin</STRONG>
+ Class: <STRONG>ScrollMargin</STRONG>
+ Command-Line Switch: <STRONG>-scrollmargin</STRONG>
+
+ Specifies the distance between the canvas and scrollbar
+ in any of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The
+ default is 3 pixels.
+
+ Name: <STRONG>textBackground</STRONG>
+ Class: <STRONG>Background</STRONG>
+ Command-Line Switch <STRONG>-textbackground</STRONG>
+
+ Specifies the background color for the canvas. This
+ allows the background within the canvas to be different
+ from the normal background color.
+
+
+ Name: <STRONG>vscrollMode</STRONG>
+ Class: <STRONG>ScrollMode</STRONG>
+ Command-Line Switch: <STRONG>-vscrollmode</STRONG>
+
+ Specifies the the display mode to be used for the vert-
+ ical scrollbar: <STRONG>static,</STRONG> <STRONG>dynamic,</STRONG> or <STRONG>none</STRONG>. In static
+ mode, the scroll bar is displayed at all times.
+ Dynamic mode displays the scroll bar as required, and
+ none disables the scroll bar display. The default is
+ static.
+
+ Name: <STRONG>width</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-width</STRONG>
+
+ Specifies the width of the scrolled canvas widget in
+ any of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The
+ default height is 30 pixels.
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>scrolledcanvas</STRONG> command creates a scrolled canvas with
+ additional options to manage horizontal and vertical
+ scrollbars. This includes options to control which
+ scrollbars are displayed and the method, i.e. statically or
+ dynamically.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>scrolledcanvas</STRONG> command creates a new Tcl command whose
+ name is <EM>pathName</EM>. This command may be used to invoke vari-
+ ous operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for scrolledcan-
+ vas widgets:
+
+
+</PRE>
+<H2>ASSOCIATED METHODS</H2><PRE>
+ <STRONG>addtag</STRONG> <STRONG>bbox</STRONG> <STRONG>bind</STRONG> <STRONG>canvasx</STRONG>
+ <STRONG>canvasy</STRONG> <STRONG>coords</STRONG> <STRONG>create</STRONG> <STRONG>dchars</STRONG>
+ <STRONG>delete</STRONG> <STRONG>dtag</STRONG> <STRONG>find</STRONG> <STRONG>focus</STRONG>
+ <STRONG>gettags</STRONG> <STRONG>icursor</STRONG> <STRONG>index</STRONG> <STRONG>insert</STRONG>
+ <STRONG>itemconfigure</STRONG> <STRONG>lower</STRONG> <STRONG>move</STRONG> <STRONG>postscript</STRONG>
+ <STRONG>raise</STRONG> <STRONG>scale</STRONG> <STRONG>scan</STRONG> <STRONG>select</STRONG>
+ <STRONG>type</STRONG> <STRONG>xview</STRONG> <STRONG>yview</STRONG>
+
+ See the "canvas" manual entry for details on the associated
+ methods.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>scrolledcanvas</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>childsite</STRONG>
+ Returns the child site widget path name.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>scrolledcanvas</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>justify</STRONG> <EM>direction</EM>
+ Justifies the canvas contents via the scroll bars in
+ one of four directions: <STRONG>left</STRONG>, <STRONG>right</STRONG>, <STRONG>top</STRONG>, or <STRONG>bottom</STRONG>.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>scrCanvas</STRONG>
+ Class: <STRONG>Canvas</STRONG>
+
+ The scrCanvas component is the canvas widget. See the
+ "canvas" widget manual entry for details on the scrCan-
+ vas component item.
+
+ Name: <STRONG>hSB</STRONG>
+ Class: <STRONG>Scrollbar</STRONG>
+
+ The hSB component is the horizontal scroll bar. See
+ the "ScrollBar" widget manual entry for details on the
+ hSB component item.
+
+ Name: <STRONG>vSB</STRONG>
+ Class: <STRONG>Scrollbar</STRONG>
+
+ The vSB component is the vertical scroll bar. See the
+ "ScrollBar" widget manual entry for details on the vSB
+ component item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ scrolledcanvas .sc
+
+ .sc create rectangle 100 100 400 400 -fill red
+ .sc create rectangle 300 300 600 600 -fill green
+ .sc create rectangle 200 200 500 500 -fill blue
+
+ pack .sc -padx 10 -pady 10 -fill both -expand yes
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Mark L. Ulferts
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ scrolledcanvas, canvas, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/scrolledframe.n.html b/itcl/iwidgets3.0.0/demos/html/scrolledframe.n.html
new file mode 100644
index 00000000000..e8dede3c4ec
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/scrolledframe.n.html
@@ -0,0 +1,306 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - scrolledframe</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - scrolledframe</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ scrolledframe - Create and manipulate scrolled frame widgets
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>scrolledframe</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- Labeledwidget &lt;- scrolledframe
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>activeBackground</STRONG> <STRONG>background</STRONG> <STRONG>borderWidthcursor</STRONG>
+ <STRONG>font</STRONG> <STRONG>foreground</STRONG> <STRONG>highlightColor</STRONG> <STRONG>highlightThickness</STRONG>
+ <STRONG>relief</STRONG> <STRONG>repeatDelay</STRONG> <STRONG>repeatInterval</STRONG> <STRONG>selectBackground</STRONG>
+ <STRONG>selectBorderWidth</STRONG> <STRONG>selectForeground</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+ <STRONG>activeRelief</STRONG> <STRONG>elementBorderWidth</STRONG> <STRONG>jumptroughColor</STRONG>
+
+ See the "scrollbar" manual entry for details on the associ-
+ ated options.
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>LabelBitmap</STRONG> <STRONG>labelFont</STRONG> <STRONG>labelImage</STRONG> <STRONG>labelMargin</STRONG>
+ <STRONG>labelPos</STRONG> <STRONG>labelText</STRONG> <STRONG>labelVariable</STRONG>
+
+ See the "labeledwidget" class manual entry for details on
+ the inherited options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>height</STRONG>
+ Class: <STRONG>Height</STRONG>
+ Command-Line Switch: <STRONG>-height</STRONG>
+
+ Specifies the height of the scrolled frame widget in
+ any of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The
+ default height is 100 pixels.
+
+ Name: <STRONG>hscrollMode</STRONG>
+ Class: <STRONG>ScrollMode</STRONG>
+ Command-Line Switch: <STRONG>-hscrollmode</STRONG>
+
+ Specifies the the display mode to be used for the hor-
+ izontal scrollbar: <STRONG>static</STRONG>, <STRONG>dynamic</STRONG>, or <STRONG>none</STRONG>. In static
+ mode, the scroll bar is displayed at all times.
+ Dynamic mode displays the scroll bar as required, and
+ none disables the scroll bar display. The default is
+ static.
+
+ Name: <STRONG>sbWidth</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-sbwidth</STRONG>
+
+ Specifies the width of the scrollbar in any of the
+ forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The default width is
+ 15 pixels.
+
+ Name: <STRONG>scrollMargin</STRONG>
+ Class: <STRONG>Margin</STRONG>
+ Command-Line Switch: <STRONG>-scrollmargin</STRONG>
+
+ Specifies the distance between the frame and scrollbar
+ in any of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The
+ default is 3 pixels.
+
+ Name: <STRONG>vscrollMode</STRONG>
+ Class: <STRONG>ScrollMode</STRONG>
+ Command-Line Switch: <STRONG>-vscrollmode</STRONG>
+
+ Specifies the the display mode to be used for the vert-
+ ical scrollbar: <STRONG>static</STRONG>, <STRONG>dynamic</STRONG>, or <STRONG>none</STRONG>. In static
+ mode, the scroll bar is displayed at all times.
+ Dynamic mode displays the scroll bar as required, and
+ none disables the scroll bar display. The default is
+ static.
+
+ Name: <STRONG>width</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-width</STRONG>
+
+ Specifies the width of the scrolled frame widget in any
+ of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The default
+ height is 100 pixels.
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>scrolledframe</STRONG> combines the functionallity of scrolling
+ with that of a typical frame widget to implement a clipable
+ viewing area whose visible region may be modified with the
+ scroll bars. This enables the contruction of visually larger
+ areas than which could normally be displayed, containing a
+ heterogenous mix of other widgets. Options exist which allow
+ full control over which scrollbars are displayed and the
+ method, i.e. statically or dynamically. The frame itself may
+ be accessed by the <STRONG>childsite</STRONG> method and then filled with
+ other widget combinations.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+
+ The <STRONG>scrolledframe</STRONG> command creates a new Tcl command whose
+ name is <EM>pathName</EM>. This command may be used to invoke vari-
+ ous operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for scrolledframe
+ widgets:
+
+
+</PRE>
+<H2>ASSOCIATED METHODS</H2><PRE>
+ <STRONG>xview</STRONG> <STRONG>yview</STRONG>
+
+ See the "canvas" manual entry for details on the associated
+ methods.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>scrolledframe</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>childsite</STRONG>
+ Return the path name of the child site.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>scrolledframe</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>justify</STRONG> <EM>direction</EM>
+ Justifies the frame contents via the scroll bars in one
+ of four directions: <STRONG>left</STRONG>, <STRONG>right</STRONG>, <STRONG>top</STRONG>, or <STRONG>bottom</STRONG>.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>canvasFrame</STRONG>
+ Class: <STRONG>Frame</STRONG>
+
+ The canvasFrame component provides relief for the
+ scrCanvas component. See the "frame" widget manual
+ entry for details on the canvasFrame component item.
+
+ Name: <STRONG>scrCanvas</STRONG>
+ Class: <STRONG>Canvas</STRONG>
+
+ The scrCanvas component provides the scrolling region
+ for the scrolled frame. See the "canvas" widget manual
+ entry for details on the scrCanvas component item.
+
+ Name: <STRONG>scrFrame</STRONG>
+ Class: <STRONG>Frame</STRONG>
+
+ The scrFrame component is internal to the scrCanvas
+ component, providing a container for children of the
+ scrolled frame. See the "frame" widget manual entry
+ for details on the scrFrame component item.
+
+ Name: <STRONG>hSB</STRONG>
+ Class: <STRONG>Scrollbar</STRONG>
+
+ The hSB component is the horizontal scroll bar. See
+ the "ScrollBar" widget manual entry for details on the
+ hSB component item.
+
+ Name: <STRONG>vSB</STRONG>
+ Class: <STRONG>Scrollbar</STRONG>
+
+ The vSB component is the vertical scroll bar. See the
+ "ScrollBar" widget manual entry for details on the vSB
+ component item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ scrolledframe .sf -width 150 -height 180 -labelon yes -labeltext scrolledframe
+
+ set cs [.sf childsite]
+ pack [button $cs.b1 -text Hello] -pady 10
+ pack [button $cs.b2 -text World] -pady 10
+ pack [button $cs.b3 -text "This is a test"] -pady 10
+ pack [button $cs.b4 -text "This is a really big button"] -pady 10
+ pack [button $cs.b5 -text "This is another really big button"] -pady 10
+ pack [button $cs.b6 -text "This is the last really big button"] -pady 10
+
+ pack .sf -expand yes -fill both -padx 10 -pady 10
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Sue Yockey
+
+ Mark L. Ulferts
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ scrolledframe, frame, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/scrolledhtml.n.html b/itcl/iwidgets3.0.0/demos/html/scrolledhtml.n.html
new file mode 100644
index 00000000000..4b46b100f84
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/scrolledhtml.n.html
@@ -0,0 +1,415 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - scrolledhtml</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - scrolledhtml</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ scrolledhtml - Create and manipulate a scrolled text widget
+ with the capability of displaying HTML formatted documents.
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>scrolledhtml</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- Labeledwidget &lt;- Scrolledtext &lt;- Scrolledhtml
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>activeBackground</STRONG> <STRONG>background</STRONG> <STRONG>borderWidthcursor</STRONG>
+ <STRONG>exportSelection</STRONG> <STRONG>foreground</STRONG> <STRONG>highlightColor</STRONG> <STRONG>highlightThickness</STRONG>
+ <STRONG>insertBackground</STRONG> <STRONG>insertBorderWidthinsertOffTimeinsertOnTime</STRONG>
+ <STRONG>insertWidth</STRONG> <STRONG>padX</STRONG> <STRONG>padY</STRONG> <STRONG>relief</STRONG>
+ <STRONG>repeatDelay</STRONG> <STRONG>repeatInterval</STRONG> <STRONG>selectBackgroundselectBorderWidth</STRONG>
+ <STRONG>selectForeground</STRONG> <STRONG>setGrid</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+ <STRONG>activeRelief</STRONG> <STRONG>elementBorderWidth</STRONG> <STRONG>jumptroughColor</STRONG>
+
+ See the "scrollbar" widget manual entry for details on the
+ above associated options.
+
+ <STRONG>spacing1</STRONG> <STRONG>spacing2</STRONG> <STRONG>spacing3</STRONG> <STRONG>state</STRONG>
+ <STRONG>wrap</STRONG>
+
+ See the "text" widget manual entry for details on the above
+ associated options.
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>labelBitmap</STRONG> <STRONG>labelFont</STRONG> <STRONG>labelImage</STRONG> <STRONG>labelMargin</STRONG>
+ <STRONG>labelPos</STRONG> <STRONG>labelText</STRONG> <STRONG>labelVariable</STRONG> <STRONG>height</STRONG>
+ <STRONG>hscrollMode</STRONG> <STRONG>sbWidth</STRONG> <STRONG>scrollMargin</STRONG> <STRONG>visibleitems</STRONG>
+ <STRONG>vscrollMode</STRONG> <STRONG>width</STRONG>
+
+ See the "scrolledtext" class manual entry for details on the
+ inherited options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>feedback</STRONG>
+ Class: <STRONG>FeedBack</STRONG>
+ Command-Line Switch: <STRONG>-feedback</STRONG>
+
+ Specifies the callback command to use to give feedback
+ on current status. Two integers are appended onto this
+ command. They represent the current point in the
+ rendering process, and the maximum point. The maximum
+ depends on the length of the text being rendered.
+
+ Name: <STRONG>fixedfont</STRONG>
+ Class: <STRONG>FixedFont</STRONG>
+ Command-Line Switch: <STRONG>-fixedfont</STRONG>
+
+ Specifies the name of the font to be used for fixed-
+ width character text (such as &lt;pre&gt;...&lt;/pre&gt; or
+ &lt;tt&gt;...&lt;/tt&gt;.) The size, style, and other font attri-
+ butes are determined by the format tags in the docu-
+ ment. The default is courier.
+
+ Name: <STRONG>fontname</STRONG>
+ Class: <STRONG>FontName</STRONG>
+ Command-Line Switch: <STRONG>-fontname</STRONG>
+
+ Specifies the name of the font to be used for normal-
+ width character spaced text. The size, style, and other
+ font attributes are determined by the format tags in
+ the document. The default is times.
+
+ Name: <STRONG>fontsize</STRONG>
+ Class: <STRONG>FontSize</STRONG>
+ Command-Line Switch: <STRONG>-fontsize</STRONG>
+
+ Specifies the general size of the fonts used. One of
+ small, medium, large, or huge. The default is medium.
+
+ Name: <STRONG>foreground</STRONG>
+ Class: <STRONG>Foreground</STRONG>
+ Command-Line Switch: <STRONG>-foreground</STRONG>
+
+ Specifies the color of text other than hypertext links,
+ in any of the forms acceptable to <STRONG>Tk_GetColor</STRONG>. This
+ value may be overridden in a particular document by the
+ <EM>text</EM> attribute of the <STRONG>Body</STRONG> HTML tag.
+
+ Name: <STRONG>link</STRONG>
+ Class: <STRONG>Link</STRONG>
+ Command-Line Switch: <STRONG>-link</STRONG>
+
+ Specifies the default color of hypertext links in any
+ of the forms acceptable to <STRONG>Tk_GetColor</STRONG>. This value may
+ be overridden in a particular document by the <EM>link</EM>
+ attribute of the <STRONG>Body</STRONG> HTML tag. The default is blue.
+
+ Name: <STRONG>linkcommand</STRONG>
+ Class: <STRONG>LinkCommand</STRONG>
+ Command-Line Switch: <STRONG>-linkcommand</STRONG>
+
+ Specifies the command to execute when the user clicks
+ on a hypertext link. Execution is of the form <STRONG>linkcom-</STRONG>
+ <STRONG>mand</STRONG> <STRONG>href</STRONG>, where <STRONG>href</STRONG> is the value given in the <EM>href</EM>
+ attribute of the <STRONG>A</STRONG> HTML tag.
+
+ Name: <STRONG>linkhighlight</STRONG>
+ Class: <STRONG>LinkHighlight</STRONG>
+ Command-Line Switch: <STRONG>-linkhighlight</STRONG>
+
+ Specifies the color of hypertext links when the cursor
+ is over the link in any of the forms acceptable to
+ <STRONG>Tk_GetColor</STRONG>. The default is red.
+
+ Name: <STRONG>textBackground</STRONG>
+ Class: <STRONG>Background</STRONG>
+ Command-Line Switch: <STRONG>-textbackground</STRONG>
+
+ Specifies the background color for the text area in any
+ of the forms acceptable to <STRONG>Tk_GetColor</STRONG>. This value may
+ be overridden in a particular document by the <EM>bgcolor</EM>
+ attribute of the <STRONG>Body</STRONG> HTML tag.
+
+ Name: <STRONG>unknownimage</STRONG>
+ Class: <STRONG>UnknownImage</STRONG>
+ Command-Line Switch: <STRONG>-unknownimage</STRONG>
+
+ Specifies the name of the image file to display when an
+ <STRONG>img</STRONG> specified in the html document cannot be loaded.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>scrolledhtml</STRONG> command creates a scrolled text widget with
+ the additional capability to display html formatted docu-
+ ments. An import method is provided to read an html docu-
+ ment file, and a render method is provided to display a html
+ formatted text string.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>scrolledhtml</STRONG> command creates a new Tcl command whose
+ name is <EM>pathName</EM>. This command may be used to invoke vari-
+ ous operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for scrolledhtml
+ widgets:
+
+
+
+</PRE>
+<H2>ASSOCIATED METHODS</H2><PRE>
+ <STRONG>bbox</STRONG> <STRONG>compare</STRONG> <STRONG>debug</STRONG> <STRONG>delete</STRONG>
+ <STRONG>dlineinfo</STRONG> <STRONG>get</STRONG> <STRONG>index</STRONG> <STRONG>insert</STRONG>
+ <STRONG>mark</STRONG> <STRONG>scan</STRONG> <STRONG>search</STRONG> <STRONG>see</STRONG>
+ <STRONG>tag</STRONG> <STRONG>window</STRONG> <STRONG>xview</STRONG> <STRONG>yview</STRONG>
+
+ See the "text" manual entry for details on the standard
+ methods.
+
+
+</PRE>
+<H2>INHERITED METHODS</H2><PRE>
+ <STRONG>export</STRONG> <STRONG>clear</STRONG>
+
+ See the "scrolledhtml" manual entry for details on the
+ inherited methods.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>scrolledhtml</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>scrolledhtml</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>import</STRONG> ?<EM>option</EM>? <EM>href</EM>
+ Load html formatted text from a file. <EM>Href</EM> must exist.
+ If <EM>option</EM> is -link, <EM>href</EM> is assumed to be relative to
+ the application's current working directory. Otherwise,
+ <EM>href</EM> is assumed to be relative to the path of the last
+ page loaded. <EM>Href</EM> is either a filename, or a reference
+ of the form <EM>filename</EM>#<EM>anchorname</EM>. In the latter form,
+ fIFilename and/or <EM>anchorname</EM> may be empty. If <EM>filename</EM>
+ is empty, the current document is assumed. If <EM>anchor-</EM>
+ <EM>name</EM> is empty, the top of the document is assumed.
+
+ <EM>pathName</EM> <STRONG>pwd</STRONG>
+ Print the current working directory of the widget, i.e.
+ the directory of the last page loaded.
+
+ <EM>pathName</EM> <STRONG>render</STRONG> <EM>htmltext</EM> ?<EM>wd</EM>?
+ Display HTML formatted text <EM>htmltext</EM>. <EM>Wd</EM> gives the base
+ path to use for all links and images in the document.
+ <EM>Wd</EM> defaults to the application's current working direc-
+ tory.
+
+ <EM>pathName</EM> <STRONG>title</STRONG>
+ Return the title of the current page, as given in the
+ &lt;title&gt;...&lt;/title&gt; field in the document.
+
+
+
+</PRE>
+<H2>SUPPORTED HTML TAGS</H2><PRE>
+ <STRONG>a</STRONG> <STRONG>/code</STRONG> <STRONG>h5</STRONG> <STRONG>/samp</STRONG>
+ <STRONG>/a</STRONG> <STRONG>dir</STRONG> <STRONG>/h5</STRONG> <STRONG>small</STRONG>
+ <STRONG>address</STRONG> <STRONG>/dir</STRONG> <STRONG>h6</STRONG> <STRONG>/small</STRONG>
+ <STRONG>/address</STRONG> <STRONG>dl</STRONG> <STRONG>/h6</STRONG> <STRONG>sub</STRONG>
+ <STRONG>b</STRONG> <STRONG>/dl</STRONG> <STRONG>i</STRONG> <STRONG>/sub</STRONG>
+ <STRONG>/b</STRONG> <STRONG>dt</STRONG> <STRONG>/i</STRONG> <STRONG>sup</STRONG>
+ <STRONG>base</STRONG> <STRONG>dd</STRONG> <STRONG>img</STRONG> <STRONG>/sup</STRONG>
+ <STRONG>big</STRONG> <STRONG>dfn</STRONG> <STRONG>kbd</STRONG> <STRONG>strong</STRONG>
+ <STRONG>/big</STRONG> <STRONG>/dfn</STRONG> <STRONG>li</STRONG> <STRONG>/strong</STRONG>
+ <STRONG>blockquote</STRONG> <STRONG>em</STRONG> <STRONG>listing</STRONG> <STRONG>title</STRONG>
+ <STRONG>/blockquote</STRONG> <STRONG>/em</STRONG> <STRONG>/listing</STRONG> <STRONG>/title</STRONG>
+ <STRONG>body</STRONG> <STRONG>h1</STRONG> <STRONG>menu</STRONG> <STRONG>tt</STRONG>
+ <STRONG>/body</STRONG> <STRONG>/h1</STRONG> <STRONG>/menu</STRONG> <STRONG>/tt</STRONG>
+ <STRONG>br</STRONG> <STRONG>h2</STRONG> <STRONG>ol</STRONG> <STRONG>u</STRONG>
+ <STRONG>center</STRONG> <STRONG>/h2</STRONG> <STRONG>/ol</STRONG> <STRONG>/u</STRONG>
+ <STRONG>/center</STRONG> <STRONG>h3</STRONG> <STRONG>p</STRONG> <STRONG>ul</STRONG>
+ <STRONG>cite</STRONG> <STRONG>/h3</STRONG> <STRONG>pre</STRONG> <STRONG>/ul</STRONG>
+ <STRONG>/cite</STRONG> <STRONG>h4</STRONG> <STRONG>/pre</STRONG> <STRONG>var</STRONG>
+ <STRONG>code</STRONG> <STRONG>/h4</STRONG> <STRONG>samp</STRONG> <STRONG>/var</STRONG>
+
+
+</PRE>
+<H2>TAGS WITH ATTRIBUTES</H2><PRE>
+ <STRONG>a</STRONG>
+
+ <EM>href</EM> reference to html document, of the form
+ filename#anchorname
+
+ <EM>name</EM> name of this anchor, to be used in an href
+
+ <EM>id</EM> same as name
+
+ <STRONG>body</STRONG>
+
+ <EM>bgcolor</EM>
+ background color
+
+ <EM>link</EM> color of hypertext links
+
+ <EM>text</EM> color of text
+
+ <STRONG>h</STRONG><EM>n</EM>
+ <EM>align</EM>
+ text alignment, one of <STRONG>left</STRONG>, <STRONG>right</STRONG>, or <STRONG>center</STRONG>
+
+ <EM>src</EM> path to image to precede text
+
+ <STRONG>hr</STRONG>
+
+ <EM>noshade</EM>
+ if present, indicates the rule should be a plain
+ black line
+
+ <EM>size</EM> height of the rule, in pixels
+
+ <STRONG>img</STRONG>
+
+ <EM>alt</EM> text to display in place of image if image is not
+ found
+
+ <EM>height</EM>
+ height of area to reserve if image is not found
+
+ <EM>src</EM> filename of image
+
+ <EM>width</EM>
+ width of area to reserve if image is not found
+
+ <STRONG>p</STRONG>
+
+ <EM>align</EM>
+ alignment of following paragraph, one of <STRONG>left</STRONG>,
+ <STRONG>right</STRONG>, or <STRONG>center</STRONG>. Defaults to alignment of previ-
+ ous paragraph, or <STRONG>left</STRONG> for first paragraph
+
+ <EM>id</EM> ID for use as anchorname in a link to this docu-
+ ment
+
+ <STRONG>ul</STRONG>
+
+ <EM>plain</EM>
+ if present list will not use bullets
+
+ <EM>src</EM> image to use as bullet
+
+ <EM>dingbat</EM>
+ same as src
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ option add *textBackground white
+
+ scrolledhtml .sh -fontname helvetica -linkcommand "this import -link"
+
+ pack .sh -padx 10 -pady 10 -fill both -expand yes
+ .sh import ~/public_html/index.html
+
+
+
+</PRE>
+<H2>ACKNOWLEDGEMENTS</H2><PRE>
+ Sam Shen
+
+ This code is based largely on his tkhtml.tcl code from
+ tk inspect. Tkhtml is copyright 1995 Lawrence Berkeley
+ Laboratory.
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Kris Raney
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ scrolledhtml, html, text, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/scrolledlistbox.n.html b/itcl/iwidgets3.0.0/demos/html/scrolledlistbox.n.html
new file mode 100644
index 00000000000..0f7d7b8e68f
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/scrolledlistbox.n.html
@@ -0,0 +1,410 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - scrolledlistbox</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - scrolledlistbox</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ scrolledlistbox - Create and manipulate scrolled listbox
+ widgets
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>scrolledlistbox</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- Labeledwidget &lt;- Scrolledlistbox
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>activeBackground</STRONG> <STRONG>background</STRONG> <STRONG>borderWidthcursor</STRONG>
+ <STRONG>exportSelection</STRONG> <STRONG>foreground</STRONG> <STRONG>highlightColor</STRONG> <STRONG>highlightThickness</STRONG>
+ <STRONG>relief</STRONG> <STRONG>repeatDelay</STRONG> <STRONG>repeatInterval</STRONG> <STRONG>selectBackground</STRONG>
+ <STRONG>selectBorderWidth</STRONG> <STRONG>selectForeground</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+ <STRONG>selectMode</STRONG>
+
+ See the "listbox" widget manual entry for details on the
+ above associated options.
+
+ <STRONG>activeRelief</STRONG> <STRONG>elementBorderwidth</STRONG> <STRONG>jumptroughColor</STRONG>
+
+ See the "scrollbar" widget manual entry for details on the
+ above associated options.
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>labeledBitmap</STRONG> <STRONG>labelFont</STRONG> <STRONG>labelImage</STRONG> <STRONG>labelMargin</STRONG>
+ <STRONG>labelPos</STRONG> <STRONG>labelText</STRONG> <STRONG>labelVariable</STRONG>
+
+ See the "labeledwidget" class manual entry for details on
+ the inherited options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>dblClickCommand</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-dblclickcommand</STRONG>
+
+ Specifies a Tcl command procedure which is called when
+ an item is double clicked. Typically this occurs when
+ mouse button 1 is double clicked over an item. Selec-
+ tion policy does not matter.
+
+ Name: <STRONG>height</STRONG>
+ Class: <STRONG>Height</STRONG>
+ Command-Line Switch: <STRONG>-height</STRONG>
+ Specifies the height of the scrolled list box as an
+ entire unit. The value may be specified in any of the
+ forms acceptable to <STRONG>Tk_GetPixels</STRONG>. Any additional space
+ needed to display the other components such as labels,
+ margins, and scrollbars force the listbox to be
+ compressed. A value of zero along with the same value
+ for the width causes the value given for the visi-
+ bleitems option to be applied which administers
+ geometry constraints in a different manner. The
+ default height is zero.
+
+ Name: <STRONG>hscrollMode</STRONG>
+ Class: <STRONG>ScrollMode</STRONG>
+ Command-Line Switch: <STRONG>-hscrollmode</STRONG>
+
+ Specifies the the display mode to be used for the hor-
+ izontal scrollbar: <STRONG>static,</STRONG> <STRONG>dynamic,</STRONG> or <STRONG>none</STRONG>. In static
+ mode, the scroll bar is displayed at all times.
+ Dynamic mode displays the scroll bar as required, and
+ none disables the scroll bar display. The default is
+ static.
+
+ Name: <STRONG>items</STRONG>
+ Class: <STRONG>Items</STRONG>
+ Command-Line Switch: <STRONG>-items</STRONG>
+
+ Specifies the contents of the listbox as a proper list
+ of elements.
+
+ Name: <STRONG>sbWidth</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-sbwidth</STRONG>
+
+ Specifies the width of the scrollbar in any of the
+ forms acceptable to <STRONG>Tk_GetPixels</STRONG>. The default width is
+ 15 pixels..
+
+ Name: <STRONG>scrollMargin</STRONG>
+ Class: <STRONG>Margin</STRONG>
+ Command-Line Switch: <STRONG>-scrollmargin</STRONG>
+
+ Specifies the distance between the listbox and
+ scrollbar in any of the forms acceptable to
+ <STRONG>Tk_GetPixels</STRONG>. The default is 3 pixels.
+
+ Name: <STRONG>selectionCommand</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-selectioncommand</STRONG>
+
+ Specifies a Tcl command procedure which is called when
+ an item is selected. Selection policy does not matter.
+
+ Name: <STRONG>textBackground</STRONG>
+ Class: <STRONG>Background</STRONG>
+ Command-Line Switch <STRONG>-textbackground</STRONG>
+
+ Specifies the background color for the listbox. This
+ allows the background within the listbox to be dif-
+ ferent from the normal background color.
+
+ Name: <STRONG>textFont</STRONG>
+ Class: <STRONG>Font</STRONG>
+ Command-Line Switch: <STRONG>-textfont</STRONG>
+
+ Specifies the font to be used for text in the listbox.
+ This allows for the font associated with text internal
+ to the scrolled listbox to be different than the font
+ for labels.
+
+ Name: <STRONG>visibleitems</STRONG>
+ Class: <STRONG>VisibleItems</STRONG>
+ Command-Line Switch: <STRONG>-visibleitems</STRONG>
+
+ Specifies the widthxheight in characters and lines for
+ the listbox. This option is only administered if the
+ width and height options are both set to zero, other-
+ wise they take precedence. The default value is 20x10.
+ With the visibleitems option engaged, geometry con-
+ straints are maintained only on the listbox. The size
+ of the other components such as labels, margins, and
+ scroll bars, are additive and independent, effecting
+ the overall size of the scrolled list box. In con-
+ trast, should the width and height options have non
+ zero values, they are applied to the scrolled list box
+ as a whole. The listbox is compressed or expanded to
+ maintain the geometry constraints.
+
+ Name: <STRONG>vscrollMode</STRONG>
+ Class: <STRONG>ScrollMode</STRONG>
+ Command-Line Switch: <STRONG>-vscrollmode</STRONG>
+
+ Specifies the the display mode to be used for the vert-
+ ical scrollbar: <STRONG>static,</STRONG> <STRONG>dynamic,</STRONG> or <STRONG>none</STRONG>. In static
+ mode, the scroll bar is displayed at all times.
+ Dynamic mode displays the scroll bar as required, and
+ none disables the scroll bar display. The default is
+ static.
+
+ Name: <STRONG>width</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-width</STRONG>
+
+ Specifies the width of the scrolled list box as an
+ entire unit. The value may be specified in any of the
+ forms acceptable to <STRONG>Tk_GetPixels</STRONG>. Any additional space
+ needed to display the other components such as labels,
+ margins, and scrollbars force the listbox to be
+ compressed. A value of zero along with the same value
+ for the height causes the value given for the visi-
+ bleitems option to be applied which administers
+ geometry constraints in a different manner. The
+ default width is zero.
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>scrolledlistbox</STRONG> command creates a scrolled listbox with
+ additional options to manage horizontal and vertical
+ scrollbars. This includes options to control which
+ scrollbars are displayed and the method, i.e. statically or
+ dynamically.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>scrolledlistbox</STRONG> command creates a new Tcl command whose
+ name is <EM>pathName</EM>. This command may be used to invoke vari-
+ ous operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand.
+
+ Many of the widget commands for a scrolledlistbox take as
+ one argument an indicator of which entry of the list box to
+ operate on. These indicators are called <EM>index</EM>es and may be
+ specified in any of the following forms:
+
+ <EM>number</EM> Specifies the element as a numerical index,
+ where 0 corresponds to the first element in the
+ listbox.
+
+ <STRONG>active</STRONG> Indicates the element that has the location cur-
+ sor. This element will be displayed with an
+ underline when the listbox has the keyboard
+ focus, and it is specified with the <STRONG>activate</STRONG>
+ widget command.
+
+ <STRONG>anchor</STRONG> Indicates the anchor point for the selection,
+ which is set with the <STRONG>selection</STRONG> <STRONG>anchor</STRONG> widget
+ command.
+
+ <STRONG>end</STRONG> Indicates the end of the listbox. For some com-
+ mands this means just after the last element;
+ for other commands it means the last element.
+
+ <STRONG>@</STRONG><EM>x</EM><STRONG>,</STRONG><EM>y</EM> Indicates the element that covers the point in
+ the listbox window specified by <EM>x</EM> and <EM>y</EM> (in
+ pixel coordinates). If no element covers that
+ point, then the closest element to that point is
+ used.
+
+ <EM>pattern</EM> If the index doesn't satisfy one of the above
+ forms then this form is used. <EM>Pattern</EM> is
+ pattern-matched against the items in the list
+ box, in order from the top down, until a match-
+ ing entry is found. The rules of
+ <STRONG>Tcl_StringMatch</STRONG> are used.
+
+ The following widget commands are possible for scrolledlist-
+ box widgets:
+
+
+
+</PRE>
+<H2>ASSOCIATED METHODS</H2><PRE>
+ <STRONG>activate</STRONG> <STRONG>bbox</STRONG> <STRONG>curselection</STRONG> <STRONG>delete</STRONG>
+ <STRONG>get</STRONG> <STRONG>index</STRONG> <STRONG>insert</STRONG> <STRONG>nearest</STRONG>
+ <STRONG>scan</STRONG> <STRONG>see</STRONG> <STRONG>selection</STRONG> <STRONG>size</STRONG>
+ <STRONG>xview</STRONG> <STRONG>yview</STRONG>
+
+ See the "listbox" manual entry for details on the associated
+ methods.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>scrolledlistbox</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>clear</STRONG>
+ Clears the listbox of all items.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>scrolledlistbox</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>getcurselection</STRONG>
+ Returns the contents of the listbox element indicated
+ by the current selection indexes. Short cut version of
+ get and curselection command combination.
+
+ <EM>pathName</EM> <STRONG>justify</STRONG> <EM>direction</EM>
+ Justifies the list contents via teh scroll bars in one
+ of four directions: <STRONG>left</STRONG>, <STRONG>right</STRONG>, <STRONG>top</STRONG>, or <STRONG>bottom</STRONG>.
+
+ <EM>pathName</EM> <STRONG>selecteditemcount</STRONG>
+ Returns the number of items currently selected in the
+ list.
+
+ <EM>pathName</EM> <STRONG>sort</STRONG> <EM>order</EM>
+ Sort the current list in either <STRONG>ascending</STRONG> or <STRONG>descending</STRONG>
+ order. The values <STRONG>increasing</STRONG> and <STRONG>decreasing</STRONG> are also
+ accepted.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>listbox</STRONG>
+ Class: <STRONG>listbox</STRONG>
+
+ The listbox component is the listbox widget. See the
+ "listbox" widget manual entry for details on the list-
+ box component item.
+
+ Name: <STRONG>horizsb</STRONG>
+ Class: <STRONG>Scrollbar</STRONG>
+
+ The horizsb component is the horizontal scroll bar.
+ See the "scrollbar" widget manual entry for details on
+ the horizsb component item.
+
+ Name: <STRONG>vertsb</STRONG>
+ Class: <STRONG>Scrollbar</STRONG>
+
+ The vertsb component is the vertical scroll bar. See
+ the "scrollbar" widget manual entry for details on the
+ vertsb component item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ wm minsize . 0 0
+ option add *textBackground white
+ proc selCmd {} {
+ puts stdout "[.slb getcurselection]"
+ }
+ proc defCmd {} {
+ puts stdout "Double Click"
+ return [selCmd]
+ }
+ scrolledlistbox .slb -selection single \
+ -items {Hello {Out There} World} \
+ -vscrollmode static -hscrollmode dynamic -labeltext "List" \
+ -selectioncommand selCmd -dblclickcommand defCmd
+ pack .slb -padx 10 -pady 10 -fill both -expand yes
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Mark L. Ulferts
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ scrolledlistbox, listbox, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/scrolledtext.n.html b/itcl/iwidgets3.0.0/demos/html/scrolledtext.n.html
new file mode 100644
index 00000000000..8ef52c78ded
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/scrolledtext.n.html
@@ -0,0 +1,305 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - scrolledtext</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - scrolledtext</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ scrolledtext - Create and manipulate a scrolled text widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>scrolledtext</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- Labeledwidget &lt;- Scrolledtext
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>activeBackground</STRONG> <STRONG>background</STRONG> <STRONG>borderWidthcursor</STRONG>
+ <STRONG>exportSelection</STRONG> <STRONG>foreground</STRONG> <STRONG>highlightColor</STRONG> <STRONG>highlightThickness</STRONG>
+ <STRONG>insertBackground</STRONG> <STRONG>insertBorderWidthinsertOffTimeinsertOnTime</STRONG>
+ <STRONG>insertWidth</STRONG> <STRONG>padX</STRONG> <STRONG>padY</STRONG> <STRONG>relief</STRONG>
+ <STRONG>repeatDelay</STRONG> <STRONG>repeatInterval</STRONG> <STRONG>selectBackgroundselectBorderWidth</STRONG>
+ <STRONG>selectForeground</STRONG> <STRONG>setGrid</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+ <STRONG>activeRelief</STRONG> <STRONG>elementBorderWidth</STRONG> <STRONG>jumptroughColor</STRONG>
+
+ See the "scrollbar" widget manual entry for details on the
+ above associated options.
+
+ <STRONG>spacing1</STRONG> <STRONG>spacing2</STRONG> <STRONG>spacing3</STRONG> <STRONG>state</STRONG>
+ <STRONG>wrap</STRONG>
+
+ See the "text" widget manual entry for details on the above
+ associated options.
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>labelBitmap</STRONG> <STRONG>labelFont</STRONG> <STRONG>labelImage</STRONG> <STRONG>labelMargin</STRONG>
+ <STRONG>labelPos</STRONG> <STRONG>labelText</STRONG> <STRONG>labelVariable</STRONG>
+
+ See the "labeledwidget" class manual entry for details on
+ the inherited options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>height</STRONG>
+ Class: <STRONG>Height</STRONG>
+ Command-Line Switch: <STRONG>-height</STRONG>
+
+ Specifies the height of the scrolled text as an entire
+ unit. The value may be specified in any of the forms
+ acceptable to <STRONG>Tk_GetPixels</STRONG>. Any additional space
+ needed to display the other components such as labels,
+ margins, and scrollbars force the text to be
+ compressed. A value of zero along with the same value
+ for the width causes the value given for the visi-
+ bleitems option to be applied which administers
+ geometry constraints in a different manner. The
+ default height is zero.
+
+ Name: <STRONG>hscrollMode</STRONG>
+ Class: <STRONG>ScrollMode</STRONG>
+ Command-Line Switch: <STRONG>-hscrollmode</STRONG>
+
+ Specifies the the display mode to be used for the hor-
+ izontal scrollbar: <STRONG>static,</STRONG> <STRONG>dynamic,</STRONG> or <STRONG>none</STRONG>. In static
+ mode, the scroll bar is displayed at all times.
+ Dynamic mode displays the scroll bar as required, and
+ none disables the scroll bar display. The default is
+ static.
+
+ Name: <STRONG>sbWidth</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-sbwidth</STRONG>
+
+ Specifies the width of the scrollbar in any of the
+ forms acceptable to <STRONG>Tk_GetPixels</STRONG>.
+
+ Name: <STRONG>scrollMargin</STRONG>
+ Class: <STRONG>Margin</STRONG>
+ Command-Line Switch: <STRONG>-scrollmargin</STRONG>
+
+ Specifies the distance between the text area and
+ scrollbar in any of the forms acceptable to
+ <STRONG>Tk_GetPixels</STRONG>. The default is 3 pixels.
+
+ Name: <STRONG>textBackground</STRONG>
+ Class: <STRONG>Background</STRONG>
+ Command-Line Switch: <STRONG>-textbackground</STRONG>
+
+ Specifies the background color for the text area in any
+ of the forms acceptable to <STRONG>Tk_GetColor</STRONG>.
+
+ Name: <STRONG>textFont</STRONG>
+ Class: <STRONG>Font</STRONG>
+ Command-Line Switch: <STRONG>-textfont</STRONG>
+
+ Specifies the font to be used in the scrolled text
+ area.
+
+ Name: <STRONG>visibleitems</STRONG>
+ Class: <STRONG>VisibleItems</STRONG>
+ Command-Line Switch: <STRONG>-visibleitems</STRONG>
+
+ Specifies the widthxheight in characters and lines for
+ the text. This option is only administered if the
+ width and height options are both set to zero,
+ otherwise they take precedence. The default value is
+ 80x24. With the visibleitems option engaged, geometry
+ constraints are maintained only on the text. The size
+ of the other components such as labels, margins, and
+ scroll bars, are additive and independent, effecting
+ the overall size of the scrolled text. In contrast,
+ should the width and height options have non zero
+ values, they are applied to the scrolled text as a
+ whole. The text is compressed or expanded to maintain
+ the geometry constraints.
+
+ Name: <STRONG>vscrollMode</STRONG>
+ Class: <STRONG>ScrollMode</STRONG>
+ Command-Line Switch: <STRONG>-vscrollmode</STRONG>
+
+ Specifies the the display mode to be used for the vert-
+ ical scrollbar: <STRONG>static,</STRONG> <STRONG>dynamic,</STRONG> or <STRONG>none</STRONG>. In static
+ mode, the scroll bar is displayed at all times.
+ Dynamic mode displays the scroll bar as required, and
+ none disables the scroll bar display. The default is
+ static.
+
+ Name: <STRONG>width</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-width</STRONG>
+
+ Specifies the width of the scrolled text as an entire
+ unit. The value may be specified in any of the forms
+ acceptable to <STRONG>Tk_GetPixels</STRONG>. Any additional space
+ needed to display the other components such as labels,
+ margins, and scrollbars force the text to be
+ compressed. A value of zero along with the same value
+ for the height causes the value given for the visi-
+ bleitems option to be applied which administers
+ geometry constraints in a different manner. The
+ default width is zero.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>scrolledtext</STRONG> command creates a scrolled text widget with
+ additional options to manage the scrollbars. This includes
+ options to control the method in which the scrollbars are
+ displayed, i.e. statically or dynamically. Options also
+ exist for adding a label to the scrolled text area and con-
+ trolling its position. Import/export of methods are pro-
+ vided for file I/O.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+
+ The <STRONG>scrolledtext</STRONG> command creates a new Tcl command whose
+ name is <EM>pathName</EM>. This command may be used to invoke vari-
+ ous operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for scrolledtext
+ widgets:
+
+
+</PRE>
+<H2>ASSOCIATED METHODS</H2><PRE>
+ <STRONG>bbox</STRONG> <STRONG>compare</STRONG> <STRONG>debug</STRONG> <STRONG>delete</STRONG>
+ <STRONG>dlineinfo</STRONG> <STRONG>get</STRONG> <STRONG>index</STRONG> <STRONG>insert</STRONG>
+ <STRONG>mark</STRONG> <STRONG>scan</STRONG> <STRONG>search</STRONG> <STRONG>see</STRONG>
+ <STRONG>tag</STRONG> <STRONG>window</STRONG> <STRONG>xview</STRONG> <STRONG>yview</STRONG>
+
+ See the "text" manual entry for details on the standard
+ methods.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>scrolledtext</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>clear</STRONG>
+ Clear the text area of all characters.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>scrolledtext</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>import</STRONG> <EM>filename</EM>
+ Load text from a file. The <EM>filename</EM> must exist.
+
+ <EM>pathName</EM> <STRONG>export</STRONG> <EM>filename</EM>
+ Write text to a file. If <EM>filename</EM> exists then contents
+ are replaced with text widget contents.
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>text</STRONG>
+ Class: <STRONG>Text</STRONG>
+
+ The text component is the text widget. See the "text"
+ widget manual entry for details on the text component
+ item.
+
+ Name: <STRONG>horizsb</STRONG>
+ Class: <STRONG>Scrollbar</STRONG>
+
+ The horizsb component is the horizontal scroll bar.
+ See the "scrollbar" widget manual entry for details on
+ the horizsb component item.
+
+ Name: <STRONG>vertsb</STRONG>
+ Class: <STRONG>Scrollbar</STRONG>
+
+ The vertsb component is the vertical scroll bar. See
+ the "scrollbar" widget manual entry for details on the
+ vertsb component item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ option add *textBackground white
+
+ scrolledtext .st -scrollmode dynamic -labeltext "Password File"
+
+ pack .st -padx 10 -pady 10 -fill both -expand yes
+
+ .st import /etc/passwd
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Mark L. Ulferts
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ scrolledtext, text, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/selectionbox.n.html b/itcl/iwidgets3.0.0/demos/html/selectionbox.n.html
new file mode 100644
index 00000000000..6e628fe8e34
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/selectionbox.n.html
@@ -0,0 +1,305 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - selectionbox</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - selectionbox</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ selectionbox - Create and manipulate a selection box widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>selectionbox</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- selectionbox
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>activeBackground</STRONG> <STRONG>background</STRONG> <STRONG>borderWidthcursor</STRONG>
+ <STRONG>exportSelection</STRONG> <STRONG>foreground</STRONG> <STRONG>highlightColor</STRONG> <STRONG>highlightThickness</STRONG>
+ <STRONG>insertBackground</STRONG> <STRONG>insertBorderWidthinsertOffTimeinsertOnTime</STRONG>
+ <STRONG>insertWidth</STRONG> <STRONG>relief</STRONG> <STRONG>repeatDelay</STRONG> <STRONG>repeatInterval</STRONG>
+ <STRONG>selectBackground</STRONG> <STRONG>selectBorderWidthselectForeground</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+ <STRONG>textBackground</STRONG> <STRONG>textFont</STRONG>
+
+ See the "entryfield" widget class manual entry for details
+ on the above associated options.
+
+ <STRONG>labelFont</STRONG> <STRONG>labelMargin</STRONG>
+
+ See the "labeledwidget" class manual entry for details on
+ the above associated options.
+
+ <STRONG>activeRelief</STRONG> <STRONG>elementBorderWidth</STRONG> <STRONG>jumptroughColor</STRONG>
+
+ See the "scrollbar" widget class manual entry for details on
+ the above associated options.
+
+ <STRONG>dblClickCommand</STRONG> <STRONG>hscrollMode</STRONG> <STRONG>items</STRONG> <STRONG>sbWidth</STRONG>
+ <STRONG>scrollMargin</STRONG> <STRONG>textBackground</STRONG> <STRONG>textFont</STRONG> <STRONG>vscrollMode</STRONG>
+
+ See the "scrolledlistbox" widget class manual entry for
+ details on the above associated options.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>childSitePos</STRONG>
+ Class: <STRONG>Position</STRONG>
+ Command-Line Switch: <STRONG>-childsitepos</STRONG>
+
+ Specifies the position of the child site in the selec-
+ tion box: <STRONG>n</STRONG>, <STRONG>s</STRONG>, <STRONG>e</STRONG>, <STRONG>w</STRONG>, or . The default is center
+
+ Name: <STRONG>height</STRONG>
+ Class: <STRONG>Height</STRONG>
+ Command-Line Switch: <STRONG>-height</STRONG>
+
+ Specifies the height of the selection box. The value
+ may be specified in any of the forms acceptable to
+ Tk_GetPixels. The default is 320 pixels.
+
+ Name: <STRONG>itemsCommand</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-itemscommand</STRONG>
+
+ Specifies a command to be evaluated following selection
+ of an item.
+
+ Name: <STRONG>itemsLabel</STRONG>
+ Class: <STRONG>Text</STRONG>
+ Command-Line Switch: <STRONG>-itemslabel</STRONG>
+
+ Specifies the text of the label for the items list.
+ The default is "List".
+
+ Name: <STRONG>itemsLabelPos</STRONG>
+ Class: <STRONG>Position</STRONG>
+ Command-Line Switch: <STRONG>-itemslabelpos</STRONG>
+
+ Specifies the position of the label along the side of
+ the items list: <STRONG>n</STRONG>, <STRONG>ne</STRONG>, <STRONG>e</STRONG>, <STRONG>se</STRONG>, <STRONG>s</STRONG>, <STRONG>sw</STRONG>, <STRONG>w</STRONG>, or <STRONG>nw</STRONG>. The
+ default is nw.
+
+ Name: <STRONG>itemsOn</STRONG>
+ Class: <STRONG>ItemsOn</STRONG>
+ Command-Line Switch: <STRONG>-itemson</STRONG>
+
+ Specifies whether or not to display the items list in
+ any of the forms acceptable to <STRONG>Tcl_GetBoolean</STRONG>. The
+ default is true.
+
+ Name: <STRONG>margin</STRONG>
+ Class: <STRONG>Margin</STRONG>
+ Command-Line Switch: <STRONG>-margin</STRONG>
+
+ Specifies distance between the items list and selection
+ entry in any of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>.
+ The default is 7 pixels.
+
+ Name: <STRONG>selectionCommand</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-selectioncommand</STRONG>
+
+ Specifies a Tcl procedure to be associated with a
+ return key press event in the selection entry field.
+
+ Name: <STRONG>selectionLabel</STRONG>
+ Class: <STRONG>Text</STRONG>
+ Command-Line Switch: <STRONG>-selectionlabel</STRONG>
+
+ Specifies the text of the label for the selection entry
+ field. The default is "Selection".
+
+ Name: <STRONG>selectionLabelPos</STRONG>
+ Class: <STRONG>Position</STRONG>
+ Command-Line Switch: <STRONG>-selectionlabelpos</STRONG>
+
+ Specifies the position of the label along the side of
+ the selection: <STRONG>n</STRONG>, <STRONG>ne</STRONG>, <STRONG>e</STRONG>, <STRONG>se</STRONG>, <STRONG>s</STRONG>, <STRONG>sw</STRONG>, <STRONG>w</STRONG>, or <STRONG>nw</STRONG>. The
+ default is nw.
+
+ Name: <STRONG>selectionOn</STRONG>
+ Class: <STRONG>SelectionOn</STRONG>
+ Command-Line Switch: <STRONG>-selectionon</STRONG>
+
+ Specifies whether or not to display the selection entry
+ in any of the forms acceptable to <STRONG>Tcl_GetBoolean</STRONG>. The
+ default is true.
+
+ Name: <STRONG>width</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-width</STRONG>
+
+ Specifies the width of the selection box. The value
+ may be specified in any of the forms acceptable to
+ Tk_GetPixels. The default is 260 pixels.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>selectionbox</STRONG> command creates a scrolled list of items
+ and a selection entry field. The user may choose any of the
+ items displayed in the scrolled list of alternatives and the
+ selection field will be filled with the choice. The user is
+ also free to enter a new value in the selection entry field.
+ Both the list and entry areas have labels. A child site is
+ also provided in which the user may create other widgets to
+ be used in conjunction with the selection box.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>selectionbox</STRONG> command creates a new Tcl command whose
+ name is <EM>pathName</EM>. This command may be used to invoke vari-
+ ous operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand.
+
+
+
+</PRE>
+<H2>ASSOCIATED METHODS</H2><PRE>
+ <STRONG>curselection</STRONG> <STRONG>delete</STRONG> <STRONG>index</STRONG> <STRONG>nearest</STRONG>
+ <STRONG>scan</STRONG> <STRONG>selection</STRONG> <STRONG>size</STRONG>
+
+ See the "listbox" widget class manual entry for details on
+ the associated methods.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>selectionbox</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>childsite</STRONG>
+ Returns the child site widget path name.
+
+ <EM>pathName</EM> <STRONG>clear</STRONG> <EM>component</EM>
+ Delete the contents of either the selection entry
+ widget or items list. The <EM>component</EM> argument may be
+ either <STRONG>items</STRONG> or <STRONG>selection</STRONG>.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>selectionbox</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>get</STRONG>
+ Returns the current value of the selection entry
+ widget.
+
+ <EM>pathName</EM> <STRONG>insert</STRONG> <EM>component</EM> <EM>args</EM>
+ Insert element(s) into either the selection entry
+ widget or items list. The <EM>component</EM> argument may be
+ either <STRONG>items</STRONG> or <STRONG>selection</STRONG>. The <EM>args</EM> follow the rules
+ of either an entry or list widget depending on the <EM>com-</EM>
+ <EM>ponent</EM> value.
+
+ <EM>pathName</EM> <STRONG>selectitem</STRONG>
+ Replace the selection entry field contents with the
+ currently selected items value.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>childsite</STRONG>
+ Class: <STRONG>Frame</STRONG>
+
+ The childsite component is the user child site for the
+ selection box. See the "frame" widget manual entry for
+ details on the childsite component item.
+
+ Name: <STRONG>items</STRONG>
+ Class: <STRONG>Scrolledlistbox</STRONG>
+
+ The items component provides the scrolled list box of
+ items for the selection box. See the "scrolledlistbox"
+ widget manual entry for details on the items component
+ item.
+
+ Name: <STRONG>selection</STRONG>
+ Class: <STRONG>Entryfield</STRONG>
+
+ The selection component provides the entry field in the
+ selection box for display of the selected item in the
+ items component. See the "entryfield" widget manual
+ entry for details on the selection component item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ option add *textBackground white
+
+ selectionbox .sb -items {Hello {Out There} World}
+ pack .sb -padx 10 -pady 10 -fill both -expand yes
+
+ set cs [label [.sb childsite].label -text "Child Site"]
+ pack $cs -fill x -padx 10 -pady 10
+
+ .sb insert items 2 {Cruel Cruel}
+
+ .sb selection set 1
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Mark L. Ulferts
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ selectionbox, widget
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/selectiondialog.n.html b/itcl/iwidgets3.0.0/demos/html/selectiondialog.n.html
new file mode 100644
index 00000000000..73139ab0a35
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/selectiondialog.n.html
@@ -0,0 +1,255 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - selectiondialog</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - selectiondialog</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ selectiondialog - Create and manipulate a selection dialog
+ widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>selectiondialog</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Toplevel &lt;- Shell &lt;- Dialogshell &lt;- Dialog &lt;- Selec-
+ tiondialog
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>activeBackground</STRONG> <STRONG>background</STRONG> <STRONG>borderWidthcursor</STRONG>
+ <STRONG>exportSelection</STRONG> <STRONG>foreground</STRONG> <STRONG>highlightColor</STRONG> <STRONG>highlightThickness</STRONG>
+ <STRONG>insertBackground</STRONG> <STRONG>insertBorderWidthinsertOffTimeinsertOnTime</STRONG>
+ <STRONG>insertWidth</STRONG> <STRONG>relief</STRONG> <STRONG>repeatDelay</STRONG> <STRONG>repeatInterval</STRONG>
+ <STRONG>selectBackground</STRONG> <STRONG>selectBorderWidthselectForeground</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+ <STRONG>textBackground</STRONG> <STRONG>textFont</STRONG>
+
+ See the "entryfield" widget manual entry for details on the
+ above associated options.
+
+ <STRONG>labelFont</STRONG> <STRONG>labelMargin</STRONG>
+
+ See the "labeledwidget" widget manual entry for details on
+ the above associated options.
+
+ <STRONG>activeRelief</STRONG> <STRONG>elementBorderWidth</STRONG> <STRONG>jumptroughColor</STRONG>
+
+ See the "scrollbar" widget class manual entry for details on
+ the above associated options.
+
+ <STRONG>hscrollMode</STRONG> <STRONG>items</STRONG> <STRONG>sbWidth</STRONG> <STRONG>scrollMargin</STRONG>
+ <STRONG>textBackground</STRONG> <STRONG>textFont</STRONG> <STRONG>vscrollMode</STRONG>
+
+ See the "scrolledlistbox" widget class manual entry for
+ details on the above associated options.
+ <STRONG>childsitepos</STRONG> <STRONG>itemsCommand</STRONG> <STRONG>itemsLabel</STRONG> <STRONG>itemsLabelPos</STRONG>
+ <STRONG>itemsOn</STRONG> <STRONG>margin</STRONG> <STRONG>selectionCommandselectionLabel</STRONG>
+ <STRONG>selectionLabelPos</STRONG> <STRONG>selectionOn</STRONG>
+
+ See the "selectionbox" widget manual entry for details on
+ the above associated options.
+
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>buttonBoxPadX</STRONG> <STRONG>buttonBoxPadY</STRONG> <STRONG>buttonBoxPos</STRONG> <STRONG>padX</STRONG>
+ <STRONG>padY</STRONG> <STRONG>separator</STRONG> <STRONG>thickness</STRONG>
+
+ See the "dialogshell" widget manual entry for details on
+ the above inherited options.
+
+ <STRONG>master</STRONG> <STRONG>modality</STRONG> <STRONG>title</STRONG>
+
+ See the "shell" widget manual entry for details on the
+ above inherited options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>height</STRONG>
+ Class: <STRONG>Height</STRONG>
+ Command-Line Switch: <STRONG>-height</STRONG>
+
+ Specifies the height of the selection dialog. The
+ value may be specified in any of the forms acceptable
+ to Tk_GetPixels. The default is 350 pixels.
+
+ Name: <STRONG>width</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-width</STRONG>
+
+ Specifies the width of the selection dialog. The value
+ may be specified in any of the forms acceptable to
+ Tk_GetPixels. The default is 300 pixels.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>selectiondialog</STRONG> command creates a selection box similar
+ to the OSF/Motif standard selection dialog composite widget.
+ The selectiondialog is derived from the Dialog class and is
+ composed of a selectionbox with commands to manipulate the
+ dialog buttons.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>selectiondialog</STRONG> command creates a new Tcl command whose
+ name is <EM>pathName</EM>. This command may be used to invoke vari-
+ ous operations on the widget. It has the following general
+ form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for selectiondia-
+ log widgets:
+
+
+</PRE>
+<H2>ASSOCIATED METHODS</H2><PRE>
+ <STRONG>childsite</STRONG> <STRONG>clear</STRONG> <STRONG>get</STRONG> <STRONG>insert</STRONG>
+ <STRONG>selectitem</STRONG>
+
+ See the "selectionbox" widget manual entry for details on
+ the above associated methods.
+
+ <STRONG>curselection</STRONG> <STRONG>delete</STRONG> <STRONG>index</STRONG> <STRONG>nearest</STRONG>
+ <STRONG>scan</STRONG> <STRONG>selection</STRONG> <STRONG>size</STRONG>
+
+ See the "listbox" widget manual entry for details on the
+ above associated methods.
+
+
+</PRE>
+<H2>INHERITED METHODS</H2><PRE>
+ <STRONG>add</STRONG> <STRONG>buttonconfigure</STRONG> <STRONG>defaulthide</STRONG>
+ <STRONG>invoke</STRONG> <STRONG>show</STRONG>
+
+ See the "buttonbox" widget manual entry for details on the
+ above inherited methods.
+
+ <STRONG>activate</STRONG> <STRONG>center</STRONG> <STRONG>deactivate</STRONG>
+
+ See the "shell" widget manual entry for details on the above
+ inherited methods.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>selectiondialog</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>selectiondialog</STRONG> command.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>sb</STRONG>
+ Class: <STRONG>Selectionbox</STRONG>
+
+ The sb component is the selection box for the selection
+ dialog.
+ See the "selectionbox" widget manual entry for details
+ on the sb component item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ option add *textBackground GhostWhite
+
+ selectiondialog .sd
+ .sd activate
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Mark L. Ulferts
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ selectiondialog, selectionbox, dialog, dialogshell, shell,
+ widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/shell.n.html b/itcl/iwidgets3.0.0/demos/html/shell.n.html
new file mode 100644
index 00000000000..10eb5ea4406
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/shell.n.html
@@ -0,0 +1,195 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - shell</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - shell</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ shell - Create and manipulate a shell widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>shell</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Toplevel &lt;- shell
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>background</STRONG> <STRONG>cursor</STRONG> <STRONG>foreground</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>master</STRONG>
+ Class: <STRONG>Window</STRONG>
+ Command-Line Switch: <STRONG>-master</STRONG>
+
+ Defines the shell as being a transient window with the
+ master window given by the master option. The master
+ window should be either another existing toplevel win-
+ dow or {} for no master. The default is {} for shells
+ and "." for dialogs.
+
+ Name: <STRONG>modality</STRONG>
+ Class: <STRONG>Modality</STRONG>
+ Command-Line Switch: <STRONG>-modality</STRONG>
+
+ Allows the shell to grab control of the screen in one
+ of three different ways: <STRONG>application</STRONG>, <STRONG>system</STRONG>, or <STRONG>none</STRONG>.
+ Application modal prevents any other toplevel windows
+ within the application which are direct children of '.'
+ from gaining focus. System modal locks the screen and
+ prevents all windows from gaining focus regardless of
+ application. A modality of none performs no grabs at
+ all. The default is none.
+
+ Name: <STRONG>padX</STRONG>
+ Class: <STRONG>Pad</STRONG>
+ Command-Line Switch: <STRONG>-padx</STRONG>
+
+ Specifies a padding distance for the childsite in the
+ X-direction in any of the forms acceptable to
+ <STRONG>Tk_GetPixels</STRONG>. The default is 10.
+
+ Name: <STRONG>padY</STRONG>
+ Class: <STRONG>Pad</STRONG>
+ Command-Line Switch: <STRONG>-pady</STRONG>
+ Specifies a padding distance for the childsite in the
+ Y-direction in any of the forms acceptable to
+ <STRONG>Tk_GetPixels</STRONG>. The default is 10.
+
+ Name: <STRONG>title</STRONG>
+ Class: <STRONG>Title</STRONG>
+ Command-Line Switch: <STRONG>-title</STRONG>
+
+ String to be displayed in the title window decoration.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>shell</STRONG> command creates a shell which is a top level
+ widget which supports modal operation.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>shell</STRONG> command create a new Tcl command whose name is
+ <EM>pathName</EM>. This command may be used to invoke various opera-
+ tions on the widget. It has the following general form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for shell widg-
+ ets:
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>activate</STRONG>
+ Display the shell and wait based on the modality. For
+ application and system modal activations, perform a
+ grab operation, and wait for the result. The result
+ may be returned via an argument to the <STRONG>deactivate</STRONG>
+ method.
+
+ <EM>pathName</EM> <STRONG>center</STRONG> ?<EM>widget</EM>?
+ Centers the shell with respect to another widget. The
+ widget argument is optional. If provided, it should be
+ the path of another widget with to center upon. If
+ absent, then the shell will be centered on the screen
+ as a whole.
+
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>shell</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>childsite</STRONG>
+ Returns the pathname of the child site widget.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>shell</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>deactivate</STRONG> ?<EM>arg</EM>?
+ Deactivate the display of the shell. The method takes
+ an optional argument to be passed to the <STRONG>activate</STRONG>
+ method which returns the value. The optional argument
+ is only effective for application and system modal dia-
+ logs.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>shellchildsite</STRONG>
+ Class: <STRONG>frame</STRONG>
+
+ The shellchildsite component is the user child site for
+ the shell. See the "frame" widget manual entry for
+ details on the shellchildsite component item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ shell .sh -modality application -padx 20 -pady 20 -title Shell
+
+ pack [label [.sh childsite].l -text SHELL]
+
+ .sh center
+ .sh activate
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Mark L. Ulferts
+
+ Kris Raney
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ shell, widget
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/spindate.n.html b/itcl/iwidgets3.0.0/demos/html/spindate.n.html
new file mode 100644
index 00000000000..1409acc45f2
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/spindate.n.html
@@ -0,0 +1,303 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - spindate</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - spindate</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ spindate - Create and manipulate time spinner widgets
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>spindate</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- Spindate
+
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>background</STRONG> <STRONG>cursor</STRONG> <STRONG>foreground</STRONG> <STRONG>highlightColor</STRONG>
+ <STRONG>highlightThickness</STRONG> <STRONG>relief</STRONG> <STRONG>selectBackgroundselectBorderWidth</STRONG>
+ <STRONG>selectForeground</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+ <STRONG>textBackground</STRONG> <STRONG>textFont</STRONG>
+
+ See the "entryfield" manual entry for details on the above
+ associated options.
+
+ <STRONG>labelFont</STRONG> <STRONG>labelMargin</STRONG>
+
+ See the "labeledwidget" manual entry for details on the
+ above associated options.
+
+ <STRONG>step</STRONG>
+
+ See the "spinint" manual entry for details on the above
+ associated options.
+
+ <STRONG>arrowOrient</STRONG> <STRONG>repeatDelay</STRONG> <STRONG>repeatInterval</STRONG>
+
+ See the "spinner" manual entry for details on the above
+ associated options.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>dateMargin</STRONG>
+ Class: <STRONG>Margin</STRONG>
+ Command-Line Switch: <STRONG>-datemargin</STRONG>
+
+ Specifies the margin space between the month, day, and
+ year spinners is any of the forms accpetable to
+ <STRONG>Tcl_GetPixels</STRONG>. The default is 1 pixel.
+
+
+ Name: <STRONG>dayLabel</STRONG>
+ Class: <STRONG>Text</STRONG>
+ Command-Line Switch: <STRONG>-daylabel</STRONG>
+
+ Specifies the text of the label for the day spinner.
+ The default is "Day".
+
+ Name: <STRONG>dayOn</STRONG>
+ Class: <STRONG>dayOn</STRONG>
+ Command-Line Switch: <STRONG>-dayon</STRONG>
+
+ Specifies whether or not to display the day spinner in
+ any of the forms acceptable to <STRONG>Tcl_GetBoolean</STRONG>. The
+ default is true.
+
+ Name: <STRONG>dayWidth</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-daywidth</STRONG>
+
+ Specifies the width of the day spinner in any of the
+ forms acceptable to <STRONG>Tcl_GetPixels</STRONG>. The default is 3
+ pixels.
+
+ Name: <STRONG>labelPos</STRONG>
+ Class: <STRONG>Position</STRONG>
+ Command-Line Switch: <STRONG>-labelpos</STRONG>
+
+ Specifies the position of the label along the sides of
+ the various spinners: <STRONG>n</STRONG>, <STRONG>e</STRONG>, <STRONG>s</STRONG>, or <STRONG>w</STRONG>. The default is w.
+
+ Name: <STRONG>monthFormat</STRONG>
+ Class: <STRONG>MonthFormat</STRONG>
+ Command-Line Switch: <STRONG>-monthformat</STRONG>
+
+ Specifies the format of month display, <STRONG>integer</STRONG> (1-12)
+ or <STRONG>string</STRONG> (Jan - Dec), or a user specified list of
+ values.
+
+ Name: <STRONG>monthLabel</STRONG>
+ Class: <STRONG>Text</STRONG>
+ Command-Line Switch: <STRONG>-monthlabel</STRONG>
+
+ Specifies the text of the label for the month spinner.
+ The default is "Month".
+
+ Name: <STRONG>monthOn</STRONG>
+ Class: <STRONG>monthOn</STRONG>
+ Command-Line Switch: <STRONG>-monthon</STRONG>
+
+ Specifies whether or not to display the month spinner
+ in any of the forms acceptable to <STRONG>Tcl_GetBoolean</STRONG>. The
+ default is true.
+
+ Name: <STRONG>monthWidth</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-monthwidth</STRONG>
+
+ Specifies the width of the month spinner in any of the
+ forms acceptable to <STRONG>Tcl_GetPixels</STRONG>. The default is 3
+ pixels.
+
+ Name: <STRONG>orient</STRONG>
+ Class: <STRONG>Orient</STRONG>
+ Command-Line Switch: <STRONG>-orient</STRONG>
+
+ Specifies the orientation of the month, day, and year
+ spinners: <STRONG>vertical</STRONG> or <STRONG>horizontal</STRONG>. The default is hor-
+ izontal.
+
+ Name: <STRONG>yearDigits</STRONG>
+ Class: <STRONG>YearDigits</STRONG>
+ Command-Line Switch: <STRONG>-yeardigits</STRONG>
+
+ Specifies the number of digits to be displayed as the
+ value for the year spinner. The valid values are 2 and
+ 4. The default is 2.
+
+ Name: <STRONG>yearLabel</STRONG>
+ Class: <STRONG>Text</STRONG>
+ Command-Line Switch: <STRONG>-yearlabel</STRONG>
+
+ Specifies the text of the label for the year spinner.
+ The default is "Year"
+
+ Name: <STRONG>yearOn</STRONG>
+ Class: <STRONG>yearOn</STRONG>
+ Command-Line Switch: <STRONG>-yearon</STRONG>
+
+ Specifies whether or not to display the year spinner in
+ any of the forms acceptable to <STRONG>Tcl_GetBoolean</STRONG>. The
+ default is true.
+
+ Name: <STRONG>yearWidth</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-yearwidth</STRONG>
+
+ Specifies the width of the year spinner in any of the
+ forms acceptable to <STRONG>Tcl_GetPixels</STRONG>. The default is 3
+ pixels.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+
+ The <STRONG>spindate</STRONG> command creates a set of spinners for use in
+ date value entry. The set includes an month, day, and year
+ spinner widget.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>spindate</STRONG> command creates a new Tcl command whose name is
+ <EM>pathName</EM>. This command may be used to invoke various opera-
+ tions on the widget. It has the following general form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for spindate widg-
+ ets:
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>spindate</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>clear</STRONG>
+ Delete the contents of all spinner components.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>spindate</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>delete</STRONG> <EM>component</EM> <EM>first</EM> ?<EM>last</EM>?
+ Delete one or more characters of the specified <EM>com-</EM>
+ <EM>ponent</EM>, where <EM>component</EM> can be <STRONG>month</STRONG>, <STRONG>day</STRONG>, or <STRONG>year</STRONG>.
+ <EM>First</EM> is the index of the first character to delete,
+ and <EM>last</EM> is the index of the character just after the
+ last one to delete.
+
+ <EM>pathName</EM> <STRONG>get</STRONG> ?<EM>component</EM>?
+ Get returns the value for the speicifed component:
+ <STRONG>month</STRONG>, <STRONG>day</STRONG>, or <STRONG>year</STRONG>. Without parameters the command
+ returns the all three values as a list.
+
+ <EM>pathName</EM> <STRONG>insert</STRONG> <EM>component</EM> <EM>index</EM> <EM>string</EM>
+ Inserts the characters of <EM>string</EM> just before the char-
+ acter indicated by <EM>index</EM> in the <EM>component</EM>, where <EM>com-</EM>
+ <EM>ponent</EM> can be <STRONG>month</STRONG>, <STRONG>day</STRONG>, or <STRONG>year</STRONG>.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>month</STRONG>
+ Class: <STRONG>Spinner</STRONG>
+
+ The month spinner component is the month spinner of the
+ date spinner. See the Spinner widget manual entry for
+ details on the month component item.
+
+ Name: <STRONG>day</STRONG>
+ Class: <STRONG>Spinint</STRONG>
+
+ The day spinner component is the day spinner of the
+ date spinner. See the SpinInt widget manual entry for
+ details on the day component item.
+
+ Name: <STRONG>year</STRONG>
+ Class: <STRONG>Spinint</STRONG>
+
+ The year spinner component is the year spinner of the
+ date spinner. See the SpinInt widget manual entry for-
+ details on the year component item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ spindate .sd
+ pack .sd -padx 10 -pady 10
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Sue Yockey
+
+ Mark L. Ulferts
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ spindate, spinint, spinner, entryfield, entry, widget
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/spinint.n.html b/itcl/iwidgets3.0.0/demos/html/spinint.n.html
new file mode 100644
index 00000000000..e0c74ece501
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/spinint.n.html
@@ -0,0 +1,203 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - spinint</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - spinint</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ spinint - Create and manipulate a integer spinner widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>spinint</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- Labeledwidget &lt;- Spinner &lt;- Spinint
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>background</STRONG> <STRONG>borderWidth</STRONG> <STRONG>cursor</STRONG> <STRONG>exportSelection</STRONG>
+ <STRONG>foreground</STRONG> <STRONG>highlightColor</STRONG> <STRONG>highlightThicknessinsertBackground</STRONG>
+ <STRONG>insertBorderWidth</STRONG> <STRONG>insertOffTime</STRONG> <STRONG>insertOnTimeinsertWidth</STRONG>
+ <STRONG>justify</STRONG> <STRONG>relief</STRONG> <STRONG>selectBackgroundselectBorderWidth</STRONG>
+ <STRONG>selectForeground</STRONG> <STRONG>textVariable</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+ <STRONG>show</STRONG> <STRONG>state</STRONG>
+
+ See the "entry" manual entry for details on the associated
+ options.
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>command</STRONG> <STRONG>childSitePos</STRONG> <STRONG>fixed</STRONG> <STRONG>focusCommand</STRONG>
+ <STRONG>invalid</STRONG> <STRONG>textBackground</STRONG> <STRONG>textFont</STRONG> <STRONG>validate</STRONG>
+ <STRONG>width</STRONG>
+
+ See the "entryfield" widget manual entry for details on the
+ above inherited options.
+
+ <STRONG>labelBitmap</STRONG> <STRONG>labelFont</STRONG> <STRONG>labelImage</STRONG> <STRONG>labelMargin</STRONG>
+ <STRONG>labelPos</STRONG> <STRONG>labelText</STRONG> <STRONG>labelVariable</STRONG>
+
+ See the "labeledwidget" widget manual entry for details on
+ the above inherited options.
+
+ <STRONG>arroworient</STRONG> <STRONG>decrement</STRONG> <STRONG>increment</STRONG> <STRONG>repeatDelay</STRONG>
+ <STRONG>repeatInterval</STRONG>
+
+ See the "spinner" widget manual entry for details on the
+ above inherited options.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>range</STRONG>
+ Class: <STRONG>Range</STRONG>
+ Command-Line Switch: <STRONG>-range</STRONG>
+ Specifies a two element list of minimum and maximum
+ integer values. The default is no range, {{} {}}.
+
+ Name: <STRONG>step</STRONG>
+ Class: <STRONG>Step</STRONG>
+ Command-Line Switch: <STRONG>-step</STRONG>
+
+ Specifies the increment/decrement value. The default
+ is 1.
+
+ Name: <STRONG>wrap</STRONG>
+ Class: <STRONG>Wrap</STRONG>
+ Command-Line Switch: <STRONG>-wrap</STRONG>
+
+ Specifies whether to wrap the spinner value upon reach-
+ ing the minimum or maximum value in any of the forms
+ acceptable to <STRONG>Tcl_GetBoolean</STRONG>. The default is true.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>spinint</STRONG> command creates a spinint widget. The spinint
+ allows "spinning" of integer values within a specified range
+ with wrap support. The spinner arrows may be drawn horizon-
+ tally or vertically.
+
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>spinint</STRONG> command creates a new Tcl command whose name is
+ <EM>pathName</EM>. This command may be used to invoke various opera-
+ tions on the widget. It has the following general form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for spinint widg-
+ ets:
+
+
+</PRE>
+<H2>ASSOCIATED METHODS</H2><PRE>
+ <STRONG>delete</STRONG> <STRONG>get</STRONG> <STRONG>icursor</STRONG> <STRONG>index</STRONG>
+ <STRONG>insert</STRONG> <STRONG>peek</STRONG> <STRONG>scan</STRONG> <STRONG>selection</STRONG>
+ <STRONG>xview</STRONG>
+
+ See the "entry" manual entry for details on the associated
+ methods.
+
+
+</PRE>
+<H2>INHERITED METHODS</H2><PRE>
+ <STRONG>childsite</STRONG> <STRONG>clear</STRONG>
+
+
+ See the "entryfield" manual entry for details on the associ-
+ ated methods.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>spinint</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>spinint</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>down</STRONG>
+ Decrement the spinner value by the value given in the
+ step option.
+
+ <EM>pathName</EM> <STRONG>up</STRONG>
+ Increment the spinner value by the value given in the
+ step option.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ See the "Spinner" widget manual entry for details on
+ the integer spinner component items.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ option add *textBackground white
+
+ spinint .si -labeltext "Temperature" -labelpos w \
+ -fixed yes -width 5 -range {32 212}
+
+ pack .si -pady 10
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Sue Yockey
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ spinint, widget
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/spinner.n.html b/itcl/iwidgets3.0.0/demos/html/spinner.n.html
new file mode 100644
index 00000000000..005ac298062
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/spinner.n.html
@@ -0,0 +1,258 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - spinner</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - spinner</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ spinner - Create and manipulate a spinner widget
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>spinner</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- Labeledwidget &lt;- Spinner
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>background</STRONG> <STRONG>borderWidth</STRONG> <STRONG>cursor</STRONG> <STRONG>exportSelection</STRONG>
+ <STRONG>foreground</STRONG> <STRONG>highlightColor</STRONG> <STRONG>highlightThicknessinsertBackground</STRONG>
+ <STRONG>insertBorderWidth</STRONG> <STRONG>insertOffTime</STRONG> <STRONG>insertOnTimeinsertWidth</STRONG>
+ <STRONG>justify</STRONG> <STRONG>relief</STRONG> <STRONG>selectBackgroundselectBorderWidth</STRONG>
+ <STRONG>selectForeground</STRONG> <STRONG>textVariable</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+ <STRONG>show</STRONG> <STRONG>state</STRONG>
+
+ See the "entry" manual entry for details on the associated
+ options.
+
+
+</PRE>
+<H2>INHERITED OPTIONS</H2><PRE>
+ <STRONG>childSitePos</STRONG> <STRONG>command</STRONG> <STRONG>fixed</STRONG> <STRONG>focusCommand</STRONG>
+ <STRONG>invalid</STRONG> <STRONG>textBackground</STRONG> <STRONG>textFont</STRONG> <STRONG>validate</STRONG>
+ <STRONG>width</STRONG>
+
+ See the "entryfield" widget manual entry for details on the
+ above inherited options.
+
+ <STRONG>labelBitmap</STRONG> <STRONG>labelFont</STRONG> <STRONG>labelImage</STRONG> <STRONG>labelMargin</STRONG>
+ <STRONG>labelPos</STRONG> <STRONG>labelText</STRONG> <STRONG>labelVariable</STRONG>
+
+ See the "labeledwidget" widget manual entry for details on
+ the above inherited options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>arrowOrient</STRONG>
+ Class: <STRONG>Orient</STRONG>
+ Command-Line Switch: <STRONG>-arroworient</STRONG>
+
+ Specifies placement of arrow buttons: <STRONG>horizontal</STRONG> or
+ <STRONG>vertical</STRONG>. The default is vertical.
+
+ Name: <STRONG>decrement</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-decrement</STRONG>
+ Tcl command to be executed when down arrow is pressed.
+
+ Name: <STRONG>increment</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-increment</STRONG>
+
+ Tcl command to be executed when up arrow is pressed.
+
+ Name: <STRONG>repeatDelay</STRONG>
+ Class: <STRONG>RepeatDelay</STRONG>
+ Command-Line Switch: <STRONG>-repeatdelay</STRONG>
+
+ Specifies the initial delay in milliseconds before the
+ spinner repeat action on the arrow buttons engages.
+ The default is 300 milliseconds.
+
+ Name: <STRONG>repeatInterval</STRONG>
+ Class: <STRONG>RepeatInterval</STRONG>
+ Command-Line Switch: <STRONG>-repeatinterval</STRONG>
+
+ Specifies the repeat delay in milliseconds between
+ selections of the arrow buttons. A repeatinterval of 0
+ disables button repeat. The default is 100 mil-
+ liseconds.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>spinner</STRONG> command creates a spinner widget. The spinner
+ is comprised of an entryfield plus up and down arrow but-
+ tons. Arrows may be drawn horizontally or vertically.
+
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>spinner</STRONG> command creates a new Tcl command whose name is
+ <EM>pathName</EM>. This command may be used to invoke various opera-
+ tions on the widget. It has the following general form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for spinner widg-
+ ets:
+
+
+</PRE>
+<H2>ASSOCIATED METHODS</H2><PRE>
+ <STRONG>delete</STRONG> <STRONG>get</STRONG> <STRONG>icursor</STRONG> <STRONG>index</STRONG>
+ <STRONG>insert</STRONG> <STRONG>scan</STRONG> <STRONG>selection</STRONG> <STRONG>xview</STRONG>
+
+ See the "entry" manual entry for details on the associated
+ methods.
+
+
+</PRE>
+<H2>INHERITED METHODS</H2><PRE>
+ <STRONG>childsite</STRONG> <STRONG>clear</STRONG> <STRONG>peek</STRONG>
+
+ See the "entryfield" manual entry for details on the associ-
+ ated methods.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>spinner</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>spinner</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>down</STRONG>
+ Derived classes may overload this method to specialize
+ functionality.
+
+ <EM>pathName</EM> <STRONG>up</STRONG>
+ Derived classes may overload this method to specialize
+ functionality.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>downarrow</STRONG>
+ Class: <STRONG>Canvas</STRONG>
+
+ The downarrow component is the downward pointing button
+ of the spinner. See the "canvas" widget manual entry
+ for details on the downarrow component item.
+
+ Name: <STRONG>uparrow</STRONG>
+ Class: <STRONG>Canvas</STRONG>
+
+ The uparrow component is the upward pointing button of
+ the spinner. See the "canvas" widget manual entry for
+ details on the uparrow component item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ option add *textBackground GhostWhite
+
+ set months {January February March April May June July \
+ August September October November December}
+
+ proc blockInput {char} {
+ return 0
+ }
+
+ proc spinMonth {step} {
+ global months
+
+ set index [expr [lsearch $months [.sm get]] + $step]
+
+ if {$index &lt; 0} {set index 11}
+ if {$index &gt; 11} {set index 0}
+
+ .sm delete 0 end
+ .sm insert 0 [lindex $months $index]
+ }
+
+ spinner .sm -labeltext "Month : " -width 10 -fixed 10 -validate blockInput \
+ -decrement {spinMonth -1} -increment {spinMonth 1}
+ .sm insert 0 January
+
+ pack .sm -padx 10 -pady 10
+
+
+
+</PRE>
+<H2>ACKNOWLEDGEMENTS:</H2><PRE>
+ Ken Copeland &lt;ken@hilco.com&gt;
+
+ 10/18/95 - Added auto-repeat action to spinner arrow
+ buttons.
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Sue Yockey
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ spinner, widget
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/spintime.n.html b/itcl/iwidgets3.0.0/demos/html/spintime.n.html
new file mode 100644
index 00000000000..3e9a8b4613f
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/spintime.n.html
@@ -0,0 +1,301 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - spintime</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - spintime</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ spintime - Create and manipulate time spinner widgets
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>spintime</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- Spintime
+
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>background</STRONG> <STRONG>cursor</STRONG> <STRONG>foreground</STRONG> <STRONG>highlightColor</STRONG>
+ <STRONG>highlightThickness</STRONG> <STRONG>relief</STRONG> <STRONG>selectBackgroundselectBorderWidth</STRONG>
+ <STRONG>selectForeground</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>ASSOCIATED OPTIONS</H2><PRE>
+ <STRONG>textBackground</STRONG> <STRONG>textFont</STRONG>
+
+ See the "entryfield" manual entry for details on the above
+ associated options.
+
+ <STRONG>labelFont</STRONG> <STRONG>labelMargin</STRONG>
+
+ See the "labeledwidget" manual entry for details on the
+ above associated options.
+
+ <STRONG>step</STRONG>
+
+ See the "spinint" manual entry for details on the above
+ associated options.
+
+ <STRONG>arrowOrient</STRONG> <STRONG>repeatDelay</STRONG> <STRONG>repeatInterval</STRONG>
+
+ See the "spinner" manual entry for details on the above
+ associated options.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>labelPos</STRONG>
+ Class: <STRONG>Position</STRONG>
+ Command-Line Switch: <STRONG>-labelpos</STRONG>
+
+ Specifies the position of the label along the sides of
+ the various spinners: <STRONG>n</STRONG>, <STRONG>e</STRONG>, <STRONG>s</STRONG>, or <STRONG>w</STRONG>. The default is w.
+
+ Name: <STRONG>hourLabel</STRONG>
+ Class: <STRONG>Text</STRONG>
+ Command-Line Switch: <STRONG>-hourlabel</STRONG>
+
+ Specifies the text of the label for the hour spinner.
+ The default is "Hour".
+
+ Name: <STRONG>hourOn</STRONG>
+ Class: <STRONG>hourOn</STRONG>
+ Command-Line Switch: <STRONG>-houron</STRONG>
+
+ Specifies whether or not to display the hour spinner in
+ any of the forms acceptable to <STRONG>Tcl_GetBoolean</STRONG>. The
+ default is true.
+
+ Name: <STRONG>hourWidth</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-hourwidth</STRONG>
+
+ Specifies the width of the hour spinner in any of the
+ forms acceptable to <STRONG>Tcl_GetPixels</STRONG>. The default is 3
+ pixels.
+
+ Name: <STRONG>militaryOn</STRONG>
+ Class: <STRONG>militaryOn</STRONG>
+ Command-Line Switch: <STRONG>-militaryon</STRONG>
+
+ Specifies use of a 24 hour clock for hour display in
+ any of the forms acceptable to <STRONG>Tcl_GetBoolean</STRONG>. The
+ default is true.
+
+ Name: <STRONG>minuteLabel</STRONG>
+ Class: <STRONG>Text</STRONG>
+ Command-Line Switch: <STRONG>-minutelabel</STRONG>
+
+ Specifies the text of the label for the minute spinner.
+ The default is "Minute".
+
+ Name: <STRONG>minuteOn</STRONG>
+ Class: <STRONG>minuteOn</STRONG>
+ Command-Line Switch: <STRONG>-minuteon</STRONG>
+
+ Specifies whether or not to display the minute spinner
+ in any of the forms acceptable to <STRONG>Tcl_GetBoolean</STRONG>. The
+ default is true.
+
+ Name: <STRONG>minuteWidth</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-minutewidth</STRONG>
+
+ Specifies the width of the minute spinner in any of the
+ forms acceptable to <STRONG>Tcl_GetPixels</STRONG>. The default is 3
+ pixels.
+
+ Name: <STRONG>orient</STRONG>
+ Class: <STRONG>Orient</STRONG>
+ Command-Line Switch: <STRONG>-orient</STRONG>
+
+ Specifies the orientation of the hour, minute, and
+ second spinners: <STRONG>vertical</STRONG> or <STRONG>horizontal</STRONG>. The default
+ is horizontal.
+
+ Name: <STRONG>secondLabel</STRONG>
+ Class: <STRONG>Text</STRONG>
+ Command-Line Switch: <STRONG>-secondlabel</STRONG>
+
+ Specifies the text of the label for the second spinner.
+ The default is "Second"
+
+ Name: <STRONG>secondOn</STRONG>
+ Class: <STRONG>secondOn</STRONG>
+ Command-Line Switch: <STRONG>-secondon</STRONG>
+
+ Specifies whether or not to display the second spinner
+ in any of the forms acceptable to <STRONG>Tcl_GetBoolean</STRONG>. The
+ default is true.
+
+ Name: <STRONG>secondWidth</STRONG>
+ Class: <STRONG>Width</STRONG>
+ Command-Line Switch: <STRONG>-secondwidth</STRONG>
+
+ Specifies the width of the second spinner in any of the
+ forms acceptable to <STRONG>Tcl_GetPixels</STRONG>. The default is 3
+ pixels.
+
+ Name: <STRONG>timeMargin</STRONG>
+ Class: <STRONG>Margin</STRONG>
+ Command-Line Switch: <STRONG>-timemargin</STRONG>
+
+ Specifies the margin space between the hour, minute,
+ and second spinners is any of the forms accpetable to
+ <STRONG>Tcl_GetPixels</STRONG>. The default is 1 pixel.
+
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>spintime</STRONG> command creates a set of spinners for use in
+ time value entry. The set includes an hour, minute, and
+ second spinner widget.
+
+
+
+</PRE>
+<H2>METHODS</H2><PRE>
+ The <STRONG>spintime</STRONG> command creates a new Tcl command whose name is
+ <EM>pathName</EM>. This command may be used to invoke various opera-
+ tions on the widget. It has the following general form:
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>Option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand. The following commands are possible for spintime widg-
+ ets:
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>. <EM>Option</EM> may have any of the values
+ accepted by the <STRONG>spintime</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>clear</STRONG>
+ Delete the contents of all spinner components.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If <EM>option</EM> is specified with no <EM>value</EM>, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no <EM>option</EM> is
+ specified). If one or more <EM>option</EM> - <EM>value</EM> pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any
+ of the values accepted by the <STRONG>spintime</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>delete</STRONG> <EM>component</EM> <EM>first</EM> ?<EM>last</EM>?
+ Delete one or more characters of the specified <EM>com-</EM>
+ <EM>ponent</EM>, where <EM>component</EM> can be <STRONG>hour</STRONG>, <STRONG>minute</STRONG>, or <STRONG>second</STRONG>.
+ <EM>First</EM> is the index of the first character to delete,
+ and <EM>last</EM> is the index of the character just after the
+ last one to delete.
+
+ <EM>pathName</EM> <STRONG>get</STRONG> ?<EM>component</EM>?
+ Get returns the value for the speicifed component:
+ <STRONG>hour</STRONG>, <STRONG>minute</STRONG>, or <STRONG>second</STRONG>. Without parameters the com-
+ mand returns the all three values as a list.
+
+ <EM>pathName</EM> <STRONG>insert</STRONG> <EM>component</EM> <EM>index</EM> <EM>string</EM>
+ Inserts the characters of <EM>string</EM> just before the char-
+ acter indicated by <EM>index</EM> in the <EM>component</EM>, where <EM>com-</EM>
+ <EM>ponent</EM> can be <STRONG>hour</STRONG>, <STRONG>minute</STRONG>, or <STRONG>second</STRONG>.
+
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Name: <STRONG>hour</STRONG>
+ Class: <STRONG>Spinint</STRONG>
+ The hour component is the hour spinner of the time
+ spinner. See the SpinInt widget manual entry for
+ details on the hour component item.
+
+ Name: <STRONG>minute</STRONG>
+ Class: <STRONG>Spinint</STRONG>
+
+ The minute component is the minute spinner of the time
+ spinner. See the SpinInt widget manual entry for
+ details on the minute component item.
+
+ Name: <STRONG>second</STRONG>
+ Class: <STRONG>Spinint</STRONG>
+
+ The second component is the second spinner of the time
+ spinner. See the SpinInt widget manual entry for
+ details on the second component item.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ spintime .st
+ pack .st -padx 10 -pady 10
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Sue Yockey
+
+ Mark L. Ulferts
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ spintime, spinint, spinner, entryfield, entry, widget
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/tabnotebook.n.html b/itcl/iwidgets3.0.0/demos/html/tabnotebook.n.html
new file mode 100644
index 00000000000..c900fff8685
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/tabnotebook.n.html
@@ -0,0 +1,770 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - tabnotebook</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - tabnotebook</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ tabnotebook - create and manipulate tabnotebook widgets
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>tabnotebook</STRONG> <EM>pathName</EM>? <EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- tabnotebook
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>background</STRONG> <STRONG>disabledForeground</STRONG> <STRONG>foregroundscrollCommand</STRONG>
+ <STRONG>cursor</STRONG> <STRONG>font</STRONG> <STRONG>height</STRONG> <STRONG>width</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>angle</STRONG>
+ Class: <STRONG>Angle</STRONG>
+ Command-Line Switch: <STRONG>-angle</STRONG>
+
+ Specifes the angle of slope from the inner edge to the
+ outer edge of the tab. An angle of 0 specifies square
+ tabs. Valid ranges are 0 to 45 degrees inclusive.
+ Default is 15 degrees. If <STRONG>tabPos</STRONG> is e or w, this option
+ is ignored.
+
+ Name: <STRONG>auto</STRONG>
+ Class: <STRONG>Auto</STRONG>
+ Command-Line Switch: <STRONG>-auto</STRONG>
+
+ Specifies whether to use the automatic
+ packing/unpacking algorithm of the notebook. A value of
+ true indicates that page frames will be unpacked and
+ packed acoording to the algorithm described in the
+ select command. A value of <STRONG>false</STRONG> leaves the current
+ page packed and subsequent <STRONG>selects</STRONG>, <STRONG>next</STRONG>, or <STRONG>previous</STRONG>
+ commands do not switch pages automatically. In either
+ case the page's associated command (see the <STRONG>add</STRONG>
+ command's description of the command option) is
+ invoked. The value may have any of the forms accepted
+ by the <STRONG>Tcl_GetBoolean</STRONG>, such as <STRONG>true</STRONG>, <STRONG>false</STRONG>, <STRONG>0</STRONG>, <STRONG>1</STRONG>, <STRONG>yes</STRONG>,
+ or <STRONG>no</STRONG>.
+
+ Name: <STRONG>backdrop</STRONG>
+ Class: <STRONG>Backdrop</STRONG>
+ Command-Line Switch: <STRONG>-backdrop</STRONG>
+
+ Specifies a background color to use when filling in the
+ backdrop area behind the tabs.
+
+ Name: <STRONG>background</STRONG>
+ Class: <STRONG>Background</STRONG>
+ Command-Line Switch: <STRONG>-background</STRONG>
+
+ Specifies a background color to use for displaying a
+ page and its associated tab. This can be thought of as
+ the selected tab background color, since the tab asso-
+ ciated with the selected page is the selected tab.
+
+ Name: <STRONG>bevelAmount</STRONG>
+ Class: <STRONG>BevelAmount</STRONG>
+ Command-Line Switch: <STRONG>-bevelamount</STRONG>
+
+ Specifes the size of tab corners. A value of 0 with
+ <STRONG>angle</STRONG> set to 0 results in square tabs. A <STRONG>bevelAmount</STRONG> of
+ 4, means that the tab will be drawn with angled corners
+ that cut in 4 pixels from the edge of the tab. The
+ default is 0.
+
+ Name: <STRONG>borderWidth</STRONG>
+ Class: <STRONG>BorderWidth</STRONG>
+ Command-Line Switch: <STRONG>-borderwidth</STRONG>
+
+ Specifies the width of shadowed border to place around
+ the notebook area of the tabnotebook. The default value
+ is 2.
+
+ Name: <STRONG>disabledForeground</STRONG>
+ Class: <STRONG>DisabledForeground</STRONG>
+ Command-Line Switch: <STRONG>-disabledforeground</STRONG>
+
+ Specifies a foreground color to use for displaying a
+ tab's label when its <STRONG>state</STRONG> is disabled.
+
+ Name: <STRONG>equalTabs</STRONG>
+ Class: <STRONG>EqualTabs</STRONG>
+ Command-Line Switch: <STRONG>-equaltabs</STRONG>
+
+ Specifies whether to force tabs to be equal sized or
+ not. A value of <STRONG>true</STRONG> means constrain tabs to be equal
+ sized. A value of <STRONG>false</STRONG> allows each tab to size based
+ on the text label size. The value may have any of the
+ forms accepted by the <STRONG>Tcl_GetBoolean</STRONG>, such as <STRONG>true</STRONG>,
+ <STRONG>false</STRONG>, <STRONG>0</STRONG>, <STRONG>1</STRONG>, <STRONG>yes</STRONG>, or <STRONG>no</STRONG>.
+
+ For horizontally positioned tabs (<STRONG>tabpos</STRONG> is either <STRONG>s</STRONG> or
+ <STRONG>n</STRONG>), <STRONG>true</STRONG> forces all tabs to be equal width (the width
+ being equal to the longest label plus any <STRONG>padX</STRONG> speci-
+ fied). Horizontal tabs are always equal in height.
+
+ For vertically positioned tabs (<STRONG>tabpos</STRONG> is either <STRONG>w</STRONG> or
+ <STRONG>e</STRONG>), <STRONG>true</STRONG> forces all tabs to be equal height (the height
+ being equal to the height of the label with the largest
+ font). Vertically oriented tabs are always equal in
+ width.
+
+ Name: <STRONG>foreground</STRONG>
+ Class: <STRONG>Foreground</STRONG>
+ Command-Line Switch: <STRONG>-foreground</STRONG>
+
+ Specifies a foreground color to use for displaying a
+ page and its associated tab label. This can be thought
+ of as the selected tab background color, since the tab
+ associated with the selected page is the selected tab.
+
+ Name: <STRONG>gap</STRONG>
+ Class: <STRONG>Gap</STRONG>
+ Command-Line Switch: <STRONG>-gap</STRONG>
+
+ Specifies the amount of pixel space to place between
+ each tab. Value may be any pixel offset value. In addi-
+ tion, a special keyword <STRONG>overlap</STRONG> can be used as the
+ value to achieve a standard overlap of tabs. This value
+ may have any of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>.
+
+ Name: <STRONG>margin</STRONG>
+ Class: <STRONG>Margin</STRONG>
+ Command-Line Switch: <STRONG>-Bmargin</STRONG>
+
+ Specifies the amount of space to place between the out-
+ side edge of the tabnotebook and the outside edge of
+ its tabs. If <STRONG>tabPos</STRONG> is <STRONG>s</STRONG>, this is the amount of space
+ between the bottom edge of the tabnotebook and the bot-
+ tom edge of the set of tabs. If <STRONG>tabPos</STRONG> is <STRONG>n</STRONG>, this is
+ the amount of space between the top edge of the tab-
+ notebook and the top edge of the set of tabs. If <STRONG>tabPos</STRONG>
+ is <STRONG>e</STRONG>, this is the amount of space between the right
+ edge of the tabnotebook and the right edge of the set
+ of tabs. If <STRONG>tabPos</STRONG> is <STRONG>w</STRONG>, this is the amount of space
+ between the left edge of the tabnotebook and the left
+ edge of the set of tabs. This value may have any of the
+ forms acceptable to <STRONG>Tk_GetPixels</STRONG>.
+
+ Name: <STRONG>padX</STRONG>
+ Class: <STRONG>PadX</STRONG>
+ Command-Line Switch: <STRONG>-padx</STRONG>
+
+ Specifies a non-negative value indicating how much
+ extra space to request for a tab around its label in
+ the X-direction. When computing how large a window it
+ needs, the tab will add this amount to the width it
+ would normally need The tab will end up with extra
+ internal space to the left and right of its text label.
+ This value may have any of the forms acceptable to
+ <STRONG>Tk_GetPixels</STRONG>.
+
+ Name: <STRONG>padY</STRONG>
+ Class: <STRONG>PadY</STRONG>
+ Command-Line Switch: <STRONG>-pady</STRONG>
+
+ Specifies a non-negative value indicating how much
+ extra space to request for a tab around its label in
+ the Y-direction. When computing how large a window it
+ needs, the tab will add this amount to the height it
+ would normally need The tab will end up with extra
+ internal space to the top and bottom of its text label.
+ This value may have any of the forms acceptable to
+ <STRONG>Tk_GetPixels</STRONG>.
+
+ Name: <STRONG>raiseSelect</STRONG>
+ Class: <STRONG>RaiseSelect</STRONG>
+ Command-Line Switch: <STRONG>-raiseselect</STRONG>
+
+ Specifes whether to slightly raise the selected tab
+ from the rest of the tabs. The selected tab is drawn 2
+ pixels closer to the outside of the tabnotebook than
+ the unselected tabs. A value of <STRONG>true</STRONG> says to raise
+ selected tabs, a value of <STRONG>false</STRONG> turns this feature off.
+ The default is <STRONG>false</STRONG>. The value may have any of the
+ forms accepted by the <STRONG>Tcl_GetBoolean</STRONG>, such as <STRONG>true</STRONG>,
+ <STRONG>false</STRONG>, <STRONG>0</STRONG>, <STRONG>1</STRONG>, <STRONG>yes</STRONG>, or <STRONG>no</STRONG>.
+
+ Name: <STRONG>start</STRONG>
+ Class: <STRONG>Start</STRONG>
+ Command-Line Switch: <STRONG>-start</STRONG>
+
+ Specifies the amount of space to place between the left
+ or top edge of the tabnotebook and the starting edge of
+ its tabs. For horizontally positioned tabs, this is the
+ amount of space between the left edge of the notebook
+ and the left edge of the first tab. For vertically
+ positioned tabs, this is the amount of space between
+ the top of the notebook and the top of the first tab.
+ This value may change if the user performs a MButton-2
+ scroll on the tabs. This value may have any of the
+ forms acceptable to <STRONG>Tk_GetPixels</STRONG>.
+
+ Name: <STRONG>state</STRONG>
+ Class: <STRONG>State</STRONG>
+ Command-Line Switch: <STRONG>-state</STRONG>
+
+ Sets the active state of the tabnotebook. Specifying
+ <STRONG>normal</STRONG> allows all pages to be selectable. Specifying
+ <STRONG>disabled</STRONG> disables the notebook causing all page tabs to
+ be drawn in the <STRONG>disabledForeground</STRONG> color.
+
+ Name: <STRONG>tabBackground</STRONG>
+ Class: <STRONG>TabBackground</STRONG>
+ Command-Line Switch: <STRONG>-tabbackground</STRONG>
+
+ Specifies a background color to use for displaying tab
+ backgrounds when they are in their unselected state.
+ This is the background associated with tabs on all
+ pages other than the selected page.
+
+ Name: <STRONG>tabBorders</STRONG>
+ Class: <STRONG>TabBorders</STRONG>
+ Command-Line Switch: <STRONG>-tabborders</STRONG>
+
+ Specifies whether to draw the borders of tabs that are
+ not selected. Specifying <STRONG>true</STRONG> (the default) draws these
+ borders, specifying <STRONG>false</STRONG> draws only the border around
+ the selected tab. The value may have any of the forms
+ accepted by the <STRONG>Tcl_GetBoolean</STRONG>, such as <STRONG>true</STRONG>, <STRONG>false</STRONG>, <STRONG>0</STRONG>,
+ <STRONG>1</STRONG>, <STRONG>yes</STRONG>, or <STRONG>no</STRONG>.
+
+ Name: <STRONG>tabForeground</STRONG>
+ Class: <STRONG>TabForeground</STRONG>
+ Command-Line Switch: <STRONG>-tabforeground</STRONG>
+
+ Specifies a foreground color to use for displaying tab
+ labels when they are in their unselected state. This is
+ the foreground associated with tabs on all pages other
+ than the selected page.
+
+ Name: <STRONG>tabPos</STRONG>
+ Class: <STRONG>TabPos</STRONG>
+ Command-Line Switch: <STRONG>-tabpos</STRONG>
+
+ Specifies the location of the set of tabs in relation
+ to the notebook area. Must be n, s, e, or w. Defaults
+ to s.
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>tabnotebook</STRONG> command creates a new window (given by the
+ pathName argument) and makes it into a <STRONG>tabnotebook</STRONG> widget.
+ Additional options, described above may be specified on the
+ command line or in the option database to configure aspects
+ of the tabnotebook such as its colors, font, and text. The
+ tabnotebook command returns its pathName argument. At the
+ time this command is invoked, there must not exist a window
+ named pathName, but pathName's parent must exist.
+
+ A <STRONG>tabnotebook</STRONG> is a widget that contains a set of tabbed
+ pages. It displays one page from the set as the selected
+ page. A Tab displays the label for the page to which it is
+ attached and serves as a page selector. When a page's tab is
+ selected, the page's contents are displayed in the page
+ area. The selected tab has a three-dimensional effect to
+ make it appear to float above the other tabs. The tabs are
+ displayed as a group along either the left, top, right, or
+ bottom edge. When first created a tabnotebook has no pages.
+ Pages may be added or deleted using widget commands
+ described below.
+
+ A special option may be provided to the tabnotebook. The
+ <STRONG>-auto</STRONG> option specifies whether the tabnotebook will automat-
+ ically handle the unpacking and packing of pages when pages
+ are selected. A value of true signifies that the notebook
+ will automatically manage it. This is the default value. A
+ value of false signifies the notebook will not perform
+ automatic switching of pages.
+
+
+</PRE>
+<H2>NOTEBOOK PAGES</H2><PRE>
+ A tabnotebook's pages area contains a single child site
+ frame. When a new page is created it is a child of this
+ frame. The page's child site frame serves as a geometry con-
+ tainer for applications to pack widgets into. It is this
+ frame that is automatically unpacked or packed when the auto
+ option is true. This creates the effect of one page being
+ visible at a time. When a new page is selected, the previ-
+ ously selected page's child site frame is automatically
+ unpacked from the tabnotebook's child site frame and the
+ newly selected page's child site is packed into the
+ tabnotebook's child site frame.
+
+ However, sometimes it is desirable to handle page changes in
+ a different manner. By specifying the <STRONG>auto</STRONG> option as <STRONG>false</STRONG>,
+ child site packing can be disabled and done differently. For
+ example, all widgets might be packed into the first page's
+ child site <STRONG>frame</STRONG>. Then when a new page is selected, the
+ application can reconfigure the widgets and give the appear-
+ ance that the page was flipped.
+
+ In both cases the command option for a page specifies a Tcl
+ Command to execute when the page is selected. In the case of
+ <STRONG>auto</STRONG> being <STRONG>true</STRONG>, it is between the unpacking of the previ-
+ ously selected page and the packing of the newly selected
+ page.
+
+ Notebook pages can also be controlled with scroll bars or
+ other widgets that obey the <STRONG>scrollcommand</STRONG> protocol. By giv-
+ ing a scrollbar a <STRONG>-command</STRONG> to call the tabnotebook's <STRONG>select</STRONG>
+ method, the tabnotebook can be controlled with a scrollbar.
+
+ The notebook area is implemented with the notebook mega
+ widget.
+
+
+
+</PRE>
+<H2>TABS</H2><PRE>
+ Tabs appear along the edge of the notebook area. Tabs are
+ drawn to appear attached to their associated page. When a
+ tab is clicked on, the associated page is selected and the
+ tab is drawn as raised above all other tabs and as a seam-
+ less part of its notebook page. Tabs can be controlled in
+ their location along the edges, the angle tab sides are
+ drawn with, gap between tabs, starting margin of tabs,
+ internal padding around text labels in a tab, the font, and
+ its label.
+
+ The Tab area is implemented with the <STRONG>tabset</STRONG> mega widget. See
+ <STRONG>tabset(1)</STRONG>. Tabs may be oriented along either the north,
+ south, east, or west sides with the <STRONG>tabPos</STRONG> option. North and
+ south tabs may appear as angled, square, or bevelled. West
+ and east tabs may appear as square or bevelled. By changing
+ tab gaps, tab angles, bevelling, orientations, colors,
+ fonts, start locations, and margins; tabs may appear in a
+ wide variety of styles. For example, it is possible to
+ implement Microsoft-style tabs, Borland property tab styles,
+ or Borland Delphi style tabs all with the same tabnotebook.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ The <STRONG>tabnotebook</STRONG> command creates a new Tcl command whose name
+ is <EM>pathName</EM>. This command may be used to invoke various
+ operations on the widget. It has the following general form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand.
+
+ Many of the widget commands for a notebook take as one argu-
+ ment an indicator of which page of the notebook to operate
+ on. These indicators are called indexes and may be specified
+ in any of the following forms:
+
+ <EM>number</EM>
+ Specifies the page numerically, where 0 corresponds to
+ the first page in the notebook, 1 to the second, and so
+ on.
+
+ <STRONG>select</STRONG>
+ Specifies the currently selected page's index. If no
+ page is currently selected, the value -1 is returned.
+
+ <STRONG>end</STRONG> Specifes the last page in the tabnotebook's index. If
+ the notebook is empty this will return -1.
+
+ <EM>pattern</EM>
+ If the index doesn't satisfy any of the above forms,
+ then this form is used. Pattern is pattern-matched
+ against the label of each page in the notebook, in
+ order from the first to the last page, until a matching
+ entry is found. The rules of Tcl_StringMatch are used.
+ The following commands are possible for tabnotebook
+ widgets:
+
+ <EM>pathName</EM> <STRONG>add</STRONG> ?<EM>option</EM> <EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Add a new page at the end of the tabnotebook. A new
+ child site frame is created. Returns the child site
+ pathName. If additional arguments are present, they
+ specify any of the following options:
+
+ <STRONG>-angle</STRONG> <EM>value</EM>
+ Specifes the angle of slope from the inner edge to
+ the outer edge of the tab. An angle of 0 specifies
+ square tabs. Valid ranges are 0 to 45 degrees
+ inclusive. Default is 15 degrees. If this option
+ is specified as an empty string (the default),
+ then the angle option for the overall tabnotebook
+ is used. This is generally only set at the tab-
+ notebook level. Tabs normally will want to share
+ the same angle value.
+
+ <STRONG>-background</STRONG> <EM>value</EM>
+ Specifies a background color to use for displaying
+ tabs when they are selected and for displaying the
+ current page. If this option is specified as an
+ empty string (the default), then the background
+ option for the overall tabnotebook is used.
+
+ <STRONG>-bevelamount</STRONG> <EM>value</EM>
+ Specifes the size of tab corners. A value of 0
+ with angle set to 0 results in square tabs. A
+ bevelAmount of 4, means that the tab will be drawn
+ with angled corners that cut in 4 pixels from the
+ edge of the tab. The default is 0. This is gen-
+ erally only set at the tabnotebook level. Tabs
+ normally will want to share the same bevelAmount.
+
+ <STRONG>-bitmap</STRONG> <EM>value</EM>
+ If label is a non-empty string, specifies a bitmap
+ to display in this page's tab. Bitmap may be of
+ any of the forms accepted by Tk_GetPixmap.
+
+ <STRONG>-command</STRONG> <EM>value</EM>
+ Specifies a Tcl command to be executed when this
+ page is selected. This allows the programmer a
+ hook to reconfigure this page's widgets or any
+ other page's widgets.
+
+ If the tabnotebook has the auto option set to
+ true, when a page is selected this command will be
+ called immediately after the previously selected
+ page is unpacked and immediately before this page
+ is selected. The index value select is valid dur-
+ ing this Tcl command. `index select' will return
+ this page's page number.
+
+ If the auto option is set to false, when a page is
+ selected the unpack and pack calls are bypassed.
+ This Tcl command is still called.
+
+ <STRONG>-disabledforeground</STRONG> <EM>value</EM>
+ Specifies a foreground color to use for displaying
+ tab labels when tabs are in their disable state.
+ If this option is specified as an empty string
+ (the default), then the disabledforeground option
+ for the overall tabnotebook is used.
+
+ <STRONG>-font</STRONG> <EM>value</EM>
+ Specifies the font to use when drawing a text
+ label on a page tab. If this option is specified
+ as an empty string then the font option for the
+ overall tabnotebook is used..
+
+ <STRONG>-foreground</STRONG> <EM>value</EM>
+ Specifies a foreground color to use for displaying
+ tab labels when they are selected. If this option
+ is specified as an empty string (the default),
+ then the foreground option for the overall tab-
+ notebook is used.
+
+ <STRONG>-label</STRONG> <EM>value</EM>
+ Specifies a string to display as an identifying
+ label for a notebook page. This label serves as an
+ additional identifier used to reference the page.
+ This label may be used for the index value in
+ widget commands.
+
+ <STRONG>-tabbackground</STRONG> <EM>value</EM>
+ Specifies a background color to use for displaying
+ a tab when it is not elected. If this option is
+ specified as an empty string (the default), then
+ the tabBackground option for the overall tabnote-
+ book is used.
+
+ <STRONG>-tabforeground</STRONG> <EM>value</EM>
+ Specifies a foreground color to use for displaying
+ the tab's text label when it is not selected. If
+ this option is specified as an empty string (the
+ default), then the tabForeground option for the
+ overall tabnotebook is used.
+
+ <STRONG>-padx</STRONG> <EM>value</EM>
+ Specifies a non-negative value indicating how much
+ extra space to request for a tab around its label
+ in the X-direction. When computing how large a
+ window it needs, the tab will add this amount to
+ the width it would normally need The tab will end
+ up with extra internal space to the left and right
+ of its text label. This value may have any of the
+ forms acceptable to Tk_GetPixels. If this option
+ is specified as an empty string (the default),
+ then the padX option for the overall tabnotebook
+ is used
+
+ <STRONG>-pady</STRONG> <EM>value</EM>
+ Specifies a non-negative value indicating how much
+ extra space to request for a tab around its label
+ in the Y-direction. When computing how large a
+ window it needs, the tab will add this amount to
+ the height it would normally need The tab will end
+ up with extra internal space to the top and bottom
+ of its text label. This value may have any of the
+ forms acceptable to Tk_GetPixels. If this option
+ is specified as an empty string (the default),
+ then the padY option for the overall tabnotebook
+ is used
+
+ <STRONG>-state</STRONG> <EM>value</EM>
+ Specifies one of two states for the page: normal
+ or disabled. In normal state unselected tabs are
+ displayed using the tabforeground and tabback-
+ ground option from the tabnotebook or the page.
+ Selected tabs and pages are displayed using the
+ foreground and background option from the tabnote-
+ book or the page. The disabled state means that
+ the page and its tab is insensitive: it doesn't
+ respond to mouse button presses or releases. In
+ this state the entry is displayed according to its
+ disabledForeground option for the tabnotebook and
+ the background/tabbackground option from the page
+ or the tabnotebook.
+
+ <EM>pathName</EM> <STRONG>childSite</STRONG> ?<EM>index</EM>?
+ If passed no arguments, returns a list of pathNames for
+ all the pages in the tabnotebook. If the tab notebook
+ is empty, an empty list is returned
+
+ If <EM>index</EM> is passed, it returns the <EM>pathName</EM> for the
+ page's child site <STRONG>frame</STRONG> specified by <EM>index</EM>. Widgets
+ that are created with this <EM>pathName</EM> will be displayed
+ when the associated page is selected. If <EM>index</EM> is not a
+ valid index, an empty string is returned.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>pathName</EM>
+ (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the format of
+ this list). If option is specified with no value, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no option is
+ specified). If one or more option-value pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string. <EM>Option</EM> may have any of
+ the values accepted by the tabnotebook command.
+
+ <EM>pathName</EM> <STRONG>delete</STRONG> <EM>index1</EM> ?<EM>index2</EM>?
+ Delete all of the pages between <EM>index1</EM> and <EM>index2</EM>
+ inclusive. If <EM>index2</EM> is omitted then it defaults to
+ <EM>index1</EM>. Returns an empty string.
+
+ <EM>pathName</EM> <STRONG>index</STRONG> <EM>index</EM>
+ Returns the numerical index corresponding to <EM>index</EM>.
+
+ <EM>pathName</EM> <STRONG>insert</STRONG> <EM>index</EM> ?<EM>option</EM> <EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Insert a new page in the tabnotebook before the page
+ specified by <EM>index</EM>. A new child site <STRONG>frame</STRONG> is created.
+ The additional arguments are the same as for the <STRONG>add</STRONG>
+ command. Returns the child site <EM>pathName</EM>.
+
+ <EM>pathName</EM> <STRONG>next</STRONG>
+ Advances the selected page to the next page (order is
+ determined by insertion order). If the currently
+ selected page is the last page in the notebook, the
+ selection wraps around to the first page in the note-
+ book. It behaves as if the user selected the new page.
+
+ For notebooks with <STRONG>auto</STRONG> set to <STRONG>true</STRONG> the current page's
+ child site is unpacked from the notebook's child site
+ frame. Then the next page's child site is packed into
+ the notebook's child site frame. The Tcl command given
+ with the command option will be invoked between these
+ two operations.
+
+ For notebooks with <STRONG>auto</STRONG> set to <STRONG>false</STRONG> the Tcl command
+ given with the command option will be invoked.
+
+ <EM>pathName</EM> <STRONG>pageconfigure</STRONG> <EM>index</EM> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ This command is similar to the <STRONG>configure</STRONG> command,
+ except that it applies to the options for an individual
+ page, whereas configure applies to the options for the
+ tabnotebook as a whole. <EM>Options</EM> may have any of the
+ values accepted by the add widget command. If options
+ are specified, options are modified as indicated in the
+ command and the command returns an empty string. If no
+ options are specified, returns a list describing the
+ current options for page index (see <STRONG>Tk_ConfigureInfo</STRONG>
+ for information on the format of this list).
+
+ <EM>pathName</EM> <STRONG>prev</STRONG>
+ Moves the selected page to the previous page (order is
+ determined by insertion order). If the currently
+ selected page is the first page in the notebook, the
+ selection wraps around to the last page in the note-
+ book. It behaves as if the user selected the new page.
+
+ For notebooks with <STRONG>auto</STRONG> set to <STRONG>true</STRONG> the current page's
+ child site is unpacked from the notebook's child site
+ <STRONG>frame</STRONG>. Then the previous page's child site is packed
+ into the notebook's child site frame. The Tcl command
+ given with the command option will be invoked between
+ these two operations.
+
+ For notebooks with <STRONG>auto</STRONG> set to <STRONG>false</STRONG> the Tcl command
+ given with the command option will be invoked.
+
+ <EM>pathName</EM> <STRONG>select</STRONG> <EM>index</EM>
+ Selects the page specified by <EM>index</EM> as the currently
+ selected page. It behaves as if the user selected the
+ new page.
+
+ For notebooks with <STRONG>auto</STRONG> set to <STRONG>true</STRONG> the current page's
+ child site is unpacked from the notebook's child site
+ frame. Then the <EM>index</EM> page's child site is packed into
+ the notebook's child site frame. The Tcl command given
+ with the command option will be invoked between these
+ two operations.
+
+ For notebooks with <STRONG>auto</STRONG> set to <STRONG>false</STRONG> the Tcl command
+ given with the command option will be invoked.
+
+ <EM>pathName</EM> <STRONG>view</STRONG>
+ Returns the currently selected page. This command is
+ for compatibility with the <STRONG>scrollbar</STRONG> widget.
+
+ <EM>pathName</EM> <STRONG>view</STRONG> <EM>index</EM>
+ Selects the page specified by <EM>index</EM> as the currently
+ selected page. This command is for compatibility with
+ the <STRONG>scrollbar</STRONG> widget.
+
+ <EM>pathName</EM> <STRONG>view</STRONG> <STRONG>moveto</STRONG> <EM>fraction</EM>
+ Uses the <EM>fraction</EM> value to determine the corresponding
+ page to move to. This command is for compatibility with
+ the <STRONG>scrollbar</STRONG> widget.
+
+ <EM>pathName</EM> <STRONG>view</STRONG> <STRONG>scroll</STRONG> <EM>num</EM> <EM>what</EM>
+ Uses the <EM>num</EM> value to determine how many pages to move
+ forward or backward (<EM>num</EM> can be negative or positive).
+ The <EM>what</EM> argument is ignored. This command is for com-
+ patibility with the <STRONG>scrollbar</STRONG> widget.
+
+
+</PRE>
+<H2>COMPONENTS</H2><PRE>
+ Generally all behavior of the internal components, <STRONG>tabset</STRONG>
+ and <STRONG>notebook</STRONG> are controlled via the <STRONG>pageconfigure</STRONG> method.
+ The following section documents these two components.
+
+ Name: <STRONG>tabset</STRONG>
+ Class: <STRONG>Tabset</STRONG>
+
+ This is the tabset component. It implements the tabs
+ that are associated with the notebook component.
+
+ See the "<STRONG>Tabset</STRONG>" widget manual entry for details on the
+ <STRONG>tabset</STRONG> component item.
+
+ Name: <STRONG>notebook</STRONG>
+ Class: <STRONG>Notebook</STRONG>
+
+ This is the notebook component. It implements the note-
+ book that contains the pages of the tabnotebook.
+
+ See the "<STRONG>Notebook</STRONG>" widget manual entry for details on
+ the <STRONG>notebook</STRONG> component item.
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ Following is an example that creates a tabnotebook with two
+ pages.
+
+ # Create the tabnotebook widget and pack it.
+ tabnotebook .tn -width 100 -height 100
+ pack .tn \
+ -anchor nw \
+ -fill both \
+ -expand yes \
+ -side left \
+ -padx 10 \
+ -pady 10
+
+ # Add two pages to the tabnotebook,
+ # labelled "Page One" and "Page Two"
+ .tn add -label "Page One"
+ .tn add -label "Page Two"
+
+ # Get the child site frames of these two pages.
+ set page1CS [.tn childsite 0]
+ set page2CS [.tn childsite "Page Two"]
+
+ # Create buttons on each page of the tabnotebook.
+ button $page1CS.b -text "Button One"
+ pack $page1CS.b
+ button $page2CS.b -text "Button Two"
+ pack $page2CS.b
+
+ # Select the first page of the tabnotebook.
+ .tn select 0
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Bill W. Scott
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ tab tabset notebook tabnotebook page
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/tabset.n.html b/itcl/iwidgets3.0.0/demos/html/tabset.n.html
new file mode 100644
index 00000000000..2ecaf36745a
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/tabset.n.html
@@ -0,0 +1,559 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - tabset</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - tabset</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ tabset - create and manipulate tabs as as set
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>tabset</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>INHERITANCE</H2><PRE>
+ itk::Widget &lt;- tabset
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>background</STRONG> <STRONG>font</STRONG> <STRONG>selectBackgroundcursor</STRONG>
+ <STRONG>foreground</STRONG> <STRONG>selectForeground</STRONG> <STRONG>disabledForegroundheight</STRONG>
+ <STRONG>width</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>angle</STRONG>
+ Class: <STRONG>Angle</STRONG>
+ Command-Line Switch: <STRONG>-angle</STRONG>
+
+ Specifes the angle of slope from the inner edge to the
+ outer edge of the tab. An angle of 0 specifies square
+ tabs. Valid ranges are 0 to 45 degrees inclusive.
+ Default is 15 degrees. If tabPos is e or w, this option
+ is ignored.
+
+ Name: <STRONG>backdrop</STRONG>
+ Class: <STRONG>Backdrop</STRONG>
+ Command-Line Switch: <STRONG>-backdrop</STRONG>
+
+ Specifies a background color to use when filling in the
+ area behind the tabs.
+
+ Name: <STRONG>bevelAmount</STRONG>
+ Class: <STRONG>BevelAmount</STRONG>
+ Command-Line Switch: <STRONG>-bevelamount</STRONG>
+
+ Specifes the size of tab corners. A value of 0 with
+ angle set to 0 results in square tabs. A <STRONG>bevelAmount</STRONG> of
+ 4, means that the tab will be drawn with angled corners
+ that cut in 4 pixels from the edge of the tab. The
+ default is 0.
+
+ Name: <STRONG>command</STRONG>
+ Class: <STRONG>Command</STRONG>
+ Command-Line Switch: <STRONG>-command</STRONG>
+ Specifes the prefix of a Tcl command to invoke to change the view in the
+ widget associated with the tabset. When a user selects a tab, a Tcl command
+ is invoked. The actual command consists of this option followed by a space
+ and a number. The number is the numerical index of the tab that has been
+ selected.
+
+ Name: <STRONG>equalTabs</STRONG>
+ Class: <STRONG>EqualTabs</STRONG>
+ Command-Line Switch: <STRONG>-equaltabs</STRONG>
+
+ Specifies whether to force tabs to be equal sized or
+ not. A value of <STRONG>true</STRONG> means constrain tabs to be equal
+ sized. A value of <STRONG>false</STRONG> allows each tab to size based
+ on the text label size. The value may have any of the
+ forms accepted by the <STRONG>Tcl_GetBoolean</STRONG>, such as <STRONG>true</STRONG>,
+ <STRONG>false</STRONG>, <STRONG>0</STRONG>, <STRONG>1</STRONG>, <STRONG>yes</STRONG>, or <STRONG>no</STRONG>.
+
+ For horizontally positioned tabs (<STRONG>tabPos</STRONG> is either <STRONG>s</STRONG> or
+ <STRONG>n</STRONG>), <STRONG>true</STRONG> forces all tabs to be equal width (the width
+ being equal to the longest label plus any padX speci-
+ fied). Horizontal tabs are always equal in height.
+
+ For vertically positioned tabs (<STRONG>tabPos</STRONG> is either <STRONG>w</STRONG> or
+ <STRONG>e</STRONG>), <STRONG>true</STRONG> forces all tabs to be equal height (the height
+ being equal to the height of the label with the largest
+ font). Vertically oriented tabs are always equal in
+ width.
+
+ Name: <STRONG>gap</STRONG>
+ Class: <STRONG>Gap</STRONG>
+ Command-Line Switch: <STRONG>-gap</STRONG>
+
+ Specifies the amount of pixel space to place between
+ each tab. Value may be any pixel offset value. In addi-
+ tion, a special keyword <STRONG>overlap</STRONG> can be used as the
+ value to achieve a standard overlap of tabs. This value
+ may have any of the forms acceptable to <STRONG>Tk_GetPixels</STRONG>.
+
+ Name: <STRONG>margin</STRONG>
+ Class: <STRONG>Margin</STRONG>
+ Command-Line Switch: <STRONG>-margin</STRONG>
+
+ Specifies the amount of space to place between the out-
+ side edge of the tabset and the outside edge of its
+ tabs. If <STRONG>tabPos</STRONG> is <STRONG>s</STRONG>, this is the amount of space
+ between the bottom edge of the tabset and the bottom
+ edge of the set of tabs. If <STRONG>tabPos</STRONG> is <STRONG>n</STRONG>, this is the
+ amount of space between the top edge of the tabset and
+ the top edge of the set of tabs. If <STRONG>tabPos</STRONG> is <STRONG>e</STRONG>, this
+ is the amount of space between the right edge of the
+ tabset and the right edge of the set of tabs. If <STRONG>tabPos</STRONG>
+ is <STRONG>w</STRONG>, this is the amount of space between the left edge
+ of the tabset and the left edge of the set of tabs.
+ This value may have any of the forms acceptable to
+ <STRONG>Tk_GetPixels</STRONG>.
+
+ Name: <STRONG>padX</STRONG>
+ Class: <STRONG>PadX</STRONG>
+ Command-Line Switch: <STRONG>-padx</STRONG>
+
+ Specifies a non-negative value indicating how much
+ extra space to request for a tab around its label in
+ the X-direction. When computing how large a window it
+ needs, the tab will add this amount to the width it
+ would normally need The tab will end up with extra
+ internal space to the left and right of its text label.
+ This value may have any of the forms acceptable to
+ <STRONG>Tk_GetPixels</STRONG>.
+
+ Name: <STRONG>padY</STRONG>
+ Class: <STRONG>PadY</STRONG>
+ Command-Line Switch: <STRONG>-pady</STRONG>
+
+ Specifies a non-negative value indicating how much
+ extra space to request for a tab around its label in
+ the Y-direction. When computing how large a window it
+ needs, the tab will add this amount to the height it
+ would normally need The tab will end up with extra
+ internal space to the top and bottom of its text label.
+ This value may have any of the forms acceptable to
+ <STRONG>Tk_GetPixels</STRONG>.
+
+ Name: <STRONG>raiseSelect</STRONG>
+ Class: <STRONG>RaiseSelect</STRONG>
+ Command-Line Switch: <STRONG>-raiseselect</STRONG>
+
+ Specifes whether to slightly raise the selected tab
+ from the rest of the tabs. The selected tab is drawn 2
+ pixels closer to the outside edge of the tabset than
+ the unselected tabs. A value of true says to raise
+ selected tabs, a value of false turns this off. The
+ default is false. The value may have any of the forms
+ accepted by the <STRONG>Tcl_GetBoolean</STRONG>, such as <STRONG>true</STRONG>, <STRONG>false</STRONG>, <STRONG>0</STRONG>,
+ <STRONG>1</STRONG>, <STRONG>yes</STRONG>, or <STRONG>no</STRONG>.
+
+ Name: <STRONG>start</STRONG>
+ Class: <STRONG>Start</STRONG>
+ Command-Line Switch: <STRONG>-start</STRONG>
+
+ Specifies the amount of space to place between the left
+ or top edge of the tabset and the starting edge of its
+ tabs. For horizontally positioned tabs, this is the
+ amount of space between the left edge of the tabset and
+ the left edge of the first tab. For vertically posi-
+ tioned tabs, this is the amount of space between the
+ top of the tabset and the top of the first tab. This
+ value may change if the user performs a MButton-2
+ scroll on the tabs. This value may have any of the
+ forms acceptable to <STRONG>Tk_GetPixels</STRONG>.
+
+ Name: <STRONG>state</STRONG>
+ Class: <STRONG>State</STRONG>
+ Command-Line Switch: <STRONG>-state</STRONG>
+
+ Sets the active state of the tabset. Specifying <STRONG>normal</STRONG>
+ allows all tabs to be selectable. Specifying <STRONG>disabled</STRONG>
+ disables the tabset causing all tabs to be drawn in the
+ disabledForeground color.
+
+ Name: <STRONG>tabBorders</STRONG>
+ Class: <STRONG>TabBorders</STRONG>
+ Command-Line Switch: <STRONG>-tabborders</STRONG>
+
+ Specifies whether to draw the borders of tabs that are
+ not selected. Specifying true (the default) draws these
+ borders, specifying false draws only the border around
+ the selected tab. The value may have any of the forms
+ accepted by the <STRONG>Tcl_GetBoolean</STRONG>, such as <STRONG>true</STRONG>, <STRONG>false,</STRONG> <STRONG>0</STRONG>,
+ <STRONG>1</STRONG>, <STRONG>yes</STRONG>, or <STRONG>no</STRONG>.
+
+ Name: <STRONG>tabPos</STRONG>
+ Class: <STRONG>TabPos</STRONG>
+ Command-Line Switch: <STRONG>-tabpos</STRONG>
+
+ Specifies the location of the set of tabs in relation
+ to another widget. Must be <STRONG>n</STRONG>, <STRONG>s</STRONG>, <STRONG>e</STRONG>, or <STRONG>w</STRONG>. Defaults to
+ <STRONG>s</STRONG>. North tabs open downward, South tabs open upward.
+ West tabs open to the right, east tabs open to the
+ left.
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>tabset</STRONG> command creates a new window (given by the path-
+ Name argument) and makes it into a <STRONG>tabset</STRONG> widget. Additional
+ <EM>options</EM>, described above may be specified on the command
+ line or in the option database to configure aspects of the
+ tabset such as its colors, font, and text. The <STRONG>tabset</STRONG> com-
+ mand returns its <EM>pathName</EM> argument. At the time this command
+ is invoked, there must not exist a window named <EM>pathName</EM>,
+ but pathName's parent must exist.
+
+ A <STRONG>tabset</STRONG> is a widget that contains a set of Tab buttons. It
+ displays these tabs in a row or column depending on it tab-
+ pos. When a tab is clicked on, it becomes the only tab in
+ the tab set that is selected. All other tabs are deselected.
+ The Tcl command prefix associated with this tab (through the
+ command tab configure option) is invoked with the tab index
+ number appended to its argument list. This allows the tabset
+ to control another widget such as a Notebook.
+
+
+</PRE>
+<H2>TABS</H2><PRE>
+ Tabs are drawn to appear attached to another widget. The
+ tabset draws an edge boundary along one of its edges. This
+ edge is known as the attachment edge. This edge location is
+ dependent on the value of <STRONG>tabPos</STRONG>. For example, if <STRONG>tabPos</STRONG> is
+ <STRONG>s</STRONG>, the attachment edge wil be on the top side of the tabset
+ (in order to attach to the bottom or south side of its
+ attached widget). The selected tab is draw with a 3d relief
+ to appear above the other tabs. This selected tab "opens"
+ toward attachment edge.
+
+ Tabs can be controlled in their location along the edges,
+ the angle that tab sides are drawn with, gap between tabs,
+ starting margin of tabs, internal padding around labels in a
+ tab, the font, and its text or bitmap.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ The <STRONG>tabset</STRONG> command creates a new Tcl command whose name is
+ <EM>pathName</EM>. This command may be used to invoke various opera-
+ tions on the widget. It has the following general form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ <EM>option</EM> and the <EM>arg</EM>s determine the exact behavior of the com-
+ mand.
+
+ Many of the widget commands for a tabset take as one argu-
+ ment an indicator of which tab of the tabset to operate on.
+ These indicators are called indexes and may be specified in
+ any of the following forms:
+
+ <EM>number</EM>
+ Specifies the tab numerically, where 0 corresponds to
+ the first tab in the tab set, 1 to the second, and so
+ on.
+
+ <STRONG>select</STRONG>
+ Specifies the currently selected tab's index. If no tab
+ is currently selected, the value -1 is returned.
+
+ <STRONG>end</STRONG> Specifes the last tab in the tabset's index. If the
+ tabset is empty this will return -1.
+
+ <EM>pattern</EM>
+ If the index doesn't satisfy any of the above forms,
+ then this form is used. Pattern is pattern-matched
+ against the label of each tab in the tabset, in order
+ from the first to the last tab, until a matching entry
+ is found. The rules of Tcl_StringMatch are used.
+
+ The following commands are possible for tabset widgets:
+
+ <EM>pathName</EM> <STRONG>add</STRONG> ?<EM>option</EM> <EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Add a new tab at the end of the tabset. Returns
+ the child site <EM>pathName</EM>. If additional arguments
+ are present, they specify any of the following
+ options:
+
+ <STRONG>-angle</STRONG> <EM>value</EM>
+ Specifes the angle of slope from the inner
+ edge to the outer edge of the tab. An angle
+ of 0 specifies square tabs. Valid ranges are
+ 0 to 45 degrees inclusive. Default is 15
+ degrees. If this option is specified as an
+ empty string (the default), then the angle
+ option for the overall tabset is used.
+
+ <STRONG>-background</STRONG> <EM>value</EM>
+ Specifies a background color to use for
+ displaying tabs when they are in their normal
+ state (unselected). If this option is speci-
+ fied as an empty string (the default), then
+ the background option for the overall tabset
+ is used.
+
+ <STRONG>-bevelamount</STRONG> <EM>value</EM>
+ Specifes the size of tab corners. A value of
+ 0 with angle set to 0 results in square tabs.
+ A bevelAmount of 4, means that the tab will
+ be drawn with angled corners that cut in 4
+ pixels from the edge of the tab. The default
+ is 0. This is generally only set at the tab-
+ set configuration level. Tabs normally will
+ want to share the same bevelAmount.
+
+ <STRONG>-bitmap</STRONG> <EM>value</EM>
+ If label is a non-empty string, specifies a
+ bitmap to display in the tab. Bitmap may be
+ of any of the forms accepted by Tk_GetBitmap.
+
+ <STRONG>-disabledforeground</STRONG> <EM>value</EM>
+ Specifies a foreground color to use for
+ displaying tab labels when tabs are in their
+ disable state. If this option is specified as
+ an empty string (the default), then the disa-
+ bledforeground option for the overall tabset
+ is used.
+
+ <STRONG>-font</STRONG> <EM>value</EM>
+ Specifies the font to use when drawing the
+ label on a tab. If this option is specified
+ as an empty string then the font option for
+ the overall tabset is used.
+
+ <STRONG>-foreground</STRONG> <EM>value</EM>
+ Specifies a foreground color to use for
+ displaying tab labels when tabs are in their
+ normal unselected state. If this option is
+ specified as an empty string (the default),
+ then the foreground option for the overall
+ tabset is used.
+
+ <STRONG>-image</STRONG> <EM>value</EM>
+ If label is a non-empty string, specifies an
+ image to display in the tab. Image must have
+ been created with the image create command.
+ Typically, if the image option is specified
+ then it overrides other options that specify
+ a bitmap or textual value to display in the
+ widget; the image option may be reset to an
+ empty string to re-enable a bitmap or text
+ display.
+
+ <STRONG>-label</STRONG> <EM>value</EM>
+ Specifies a text string to be placed in the
+ tabs label. If this value is set, the bitmap
+ option is overridden and this option is used
+ instead. This label serves as an additional
+ identifier used to reference the tab. This
+ label may be used for the index value in
+ widget commands.
+
+ <STRONG>-selectbackground</STRONG> <EM>value</EM>
+ Specifies a background color to use for
+ displaying the selected tab. If this option
+ is specified as an empty string (the
+ default), then the selectBackground option
+ for the overall tabset is used.
+
+ <STRONG>-selectforeground</STRONG> <EM>value</EM>
+ Specifies a foreground color to use for
+ displaying the selected tab. If this option
+ is specified as an empty string (the
+ default), then the selectForeground option
+ for the overall tabset is used.
+
+ <STRONG>-padx</STRONG> <EM>value</EM>
+ Specifies a non-negative value indicating how
+ much extra space to request for a tab around
+ its label in the X-direction. When computing
+ how large a window it needs, the tab will add
+ this amount to the width it would normally
+ need The tab will end up with extra internal
+ space to the left and right of its text
+ label. This value may have any of the forms
+ acceptable to Tk_GetPixels. If this option is
+ specified as an empty string (the default),
+ then the padX option for the overall tabset
+ is used
+
+ <STRONG>-pady</STRONG> <EM>value</EM>
+ Specifies a non-negative value indicating how
+ much extra space to request for a tab around
+ its label in the Y-direction. When computing
+ how large a window it needs, the tab will add
+ this amount to the height it would normally
+ need The tab will end up with extra internal
+ space to the top and bottom of its text
+ label. This value may have any of the forms
+ acceptable to Tk_GetPixels. If this option is
+ specified as an empty string (the default),
+ then the padY option for the overall tabset
+ is used
+
+ <STRONG>-state</STRONG> <EM>value</EM>
+ Sets the state of the tab. Specifying normal
+ allows this tab to be selectable. Specifying
+ disabled disables the this tab causing its
+ tab label to be drawn in the disabledFore-
+ ground color. The tab will not respond to
+ events until the state is set back to normal.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM>? ?<EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for <EM>path-</EM>
+ <EM>Name</EM> (see <STRONG>Tk_ConfigureInfo</STRONG> for information on the
+ format of this list). If option is specified with
+ no value, then the command returns a list describ-
+ ing the one named option (this list will be ident-
+ ical to the corresponding sublist of the value
+ returned if no option is specified). If one or
+ more option-value pairs are specified, then the
+ command modifies the given widget option(s) to
+ have the given value(s); in this case the command
+ returns an empty string. <EM>Option</EM> may have any of
+ the values accepted by the tabset command.
+
+ <EM>pathName</EM> <STRONG>delete</STRONG> <EM>index1</EM> ?<EM>index2</EM>?
+ Delete all of the tabs between <EM>index1</EM> and <EM>index2</EM>
+ inclusive. If <EM>index2</EM> is omitted then it defaults
+ to <EM>index1</EM>. Returns an empty string.
+
+ <EM>pathName</EM> <STRONG>index</STRONG> <EM>index</EM>
+ Returns the numerical index corresponding to
+ <EM>index</EM>.
+
+ <EM>pathName</EM> <STRONG>insert</STRONG> <EM>index</EM> ?<EM>option</EM> <EM>value</EM> <EM>option</EM> <EM>value</EM> ...?
+ Insert a new tab in the tabset before the tab
+ specified by <EM>index</EM>. The additional arguments are
+ the same as for the <STRONG>add</STRONG> command. Returns the tab's
+ <EM>pathName</EM>.
+
+ <EM>pathName</EM> <STRONG>next</STRONG>
+ Advances the selected tab to the next tab (order
+ is determined by insertion order). If the
+ currently selected tab is the last tab in the tab-
+ set, the selection wraps around to the first tab.
+ It behaves as if the user selected the next tab.
+
+ <EM>pathName</EM> <STRONG>tabconfigure</STRONG> <EM>index</EM> ?<EM>option</EM>? ?<EM>value</EM>?
+ This command is similar to the <STRONG>configure</STRONG> command,
+ except that it applies to the options for an indi-
+ vidual tab, whereas configure applies to the
+ options for the tabset as a whole. Options may
+ have any of the values accepted by the <STRONG>add</STRONG> widget
+ command. If options are specified, options are
+ modified as indicated in the command and the com-
+ mand returns an empty string. If no options are
+ specified, returns a list describing the current
+ options for tab index (see <STRONG>Tk_ConfigureInfo</STRONG> for
+ information on the format of this list).
+
+ <EM>pathName</EM> <STRONG>prev</STRONG>
+ Moves the selected tab to the previous tab (order
+ is determined by insertion order). If the
+ currently selected tab is the first tab in the
+ tabset, the selection wraps around to the last tab
+ in the tabset. It behaves as if the user selected
+ the previous tab.
+
+ <EM>pathName</EM> <STRONG>select</STRONG> <EM>index</EM>
+ Selects the tab specified by <EM>index</EM> as the
+ currently selected tab. It behaves as if the user
+ selected the new tab.
+
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ Following is an example that creates a tabset with two tabs
+ and a list box that the tabset controls. In addition select-
+ ing an item from the list also selects the corresponding
+ tab.
+
+ # Define a proc that knows how to select an item
+ # from a list given an index from the tabset -command callback.
+ proc selectItem { item } {
+ .l selection clear [.l curselection]
+ .l selection set $item
+ .l see $item
+
+ }
+
+ # Define a proc that knows how to select a tab
+ # given a y pixel coordinate from the list..
+ proc selectTab { y } {
+ set whichItem [.l nearest $y]
+ .ts select $whichItem
+ }
+
+ # Create a listbox with two items (one and two)
+ # and bind button 1 press to the selectTab procedure.
+ listbox .l -selectmode single -exportselection false
+ .l insert end one
+ .l insert end two
+ .l selection set 0
+ pack .l
+ bind .l &lt;ButtonPress-1&gt; { selectTab %y }
+
+ # Create a tabset, set its -command to call selectItem
+ # Add two labels to the tabset (one and two).
+ tabset .ts -command selectItem
+ .ts add -label 1
+ .ts add -label 2
+ .ts select 0
+ pack .ts -fill x -expand no
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Bill W. Scott
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ tab tabset notebook tabnotebook
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/html/toolbar.n.html b/itcl/iwidgets3.0.0/demos/html/toolbar.n.html
new file mode 100644
index 00000000000..4292c0ddeef
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/html/toolbar.n.html
@@ -0,0 +1,348 @@
+<HTML>
+<HEAD>
+<TITLE>iwidgets2.2.0 User Commands - toolbar</TITLE>
+</HEAD>
+<BODY BGCOLOR="#FFFFFF">
+<H1>iwidgets2.2.0 User Commands - toolbar</H1>
+<HR>
+<PRE>
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>NAME</H2><PRE>
+ <STRONG>toolbar</STRONG> - Create and manipulate a tool bar
+
+
+</PRE>
+<H2>SYNOPSIS</H2><PRE>
+ <STRONG>toolbar</STRONG> <EM>pathName</EM> ?<EM>options</EM>?
+
+
+</PRE>
+<H2>STANDARD OPTIONS</H2><PRE>
+ <STRONG>activeBackground</STRONG> <STRONG>font</STRONG> <STRONG>insertForegroundselectForeground</STRONG>
+ <STRONG>activeForeground</STRONG> <STRONG>foreground</STRONG> <STRONG>orientstate</STRONG>
+ <STRONG>background</STRONG> <STRONG>highlightBackground</STRONG> <STRONG>relieftroughColor</STRONG>
+ <STRONG>borderWidth</STRONG> <STRONG>highlightColor</STRONG> <STRONG>selectBackgroundcursor</STRONG>
+ <STRONG>highlightThickness</STRONG> <STRONG>selectBorderWidthdisabledForegroundinsertBackground</STRONG>
+ <STRONG>selectColor</STRONG>
+
+ See the "options" manual entry for details on the standard
+ options. For widgets added to the toolbar, these options
+ will be propogated if the widget supports the option. For
+ example, all widgets that support a font option will be
+ changed if the the toolbar's font option is configured.
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC OPTIONS</H2><PRE>
+ Name: <STRONG>balloonBackground</STRONG>
+ Class: <STRONG>BalloonBackground</STRONG>
+ Command-Line Switch: <STRONG>-ballooonbackground</STRONG>
+
+ Specifies the background color of the balloon help
+ displayed at the bottom center of a widget on the tool-
+ bar that has a non empty string for its balloonStr
+ option. The default color is yellow.
+
+ Name: <STRONG>balloonDelay1</STRONG>
+ Class: <STRONG>BalloonDelay1</STRONG>
+ Command-Line Switch: <STRONG>-balloondelay1</STRONG>
+
+ Specifies the length of time (in milliseconds) to wait
+ before initially posting a balloon help hint window.
+ This delay is in effect whenever 1) the mouse leaves
+ the toolbar, or 2) a toolbar item is selected with the
+ mouse button.
+
+ Name: <STRONG>balloonDelay2</STRONG>
+ Class: <STRONG>BalloonDelay2</STRONG>
+ Command-Line Switch: <STRONG>-balloondelay2</STRONG>
+
+ Specifies the length of time (in milliseconds) to wait
+ before continuing to post balloon help hint windows.
+ This delay is in effect after the first time a balloon
+ hint window is activated. It remains in effect until 1)
+ the mouse leaves the toolbar, or 2) a toolbar item is
+ selected with the mouse button.
+
+ Name: <STRONG>balloonFont</STRONG>
+ Class: <STRONG>BalloonFont</STRONG>
+ Command-Line Switch: <STRONG>-balloonfont</STRONG>
+
+ Specifies the font of the balloon help text displayed
+ at the bottom center of a widget on the toolbar that
+ has a non empty string for its balloonStr option. The
+ default font is 6x10.
+
+ Name: <STRONG>balloonForeground</STRONG>
+ Class: <STRONG>BalloonForeground</STRONG>
+ Command-Line Switch: <STRONG>-ballooonforeground</STRONG>
+
+ Specifies the foreground color of the balloon help
+ displayed at the bottom center of a widget on the tool-
+ bar that has a non empty string for its balloonStr
+ option. The default color is black.
+
+ Name: <STRONG>helpVariable</STRONG>
+ Class: <STRONG>HelpVariable</STRONG>
+ Command-Line Switch: <STRONG>-helpvariable</STRONG>
+
+ Specifies the global variable to update whenever the
+ mouse is in motion over a toolbar widget. This global
+ variable is updated with the current value of the
+ active widget's helpStr. Other widgets can "watch" this
+ variable with the trace command, or as is the case with
+ entry or label widgets, they can set their textVariable
+ to the same global variable. This allows for a simple
+ implementation of a help status bar. Whenever the mouse
+ leaves a menu entry, the helpVariable is set to the
+ empty string {}.
+
+ Name: <STRONG>orient</STRONG>
+ Class: <STRONG>Orient</STRONG>
+ Command-Line Switch: <STRONG>-orient</STRONG>
+
+ Specifies the orientation of the toolbar. Must be
+ either horizontal or vertical.
+
+</PRE>
+<H2><HR ALIGN=LEFT WIDTH=70% SIZE=3></H2><PRE>
+
+
+</PRE>
+<H2>DESCRIPTION</H2><PRE>
+ The <STRONG>toolbar</STRONG> command creates a new window (given by the path-
+ Name argument) and makes it into a <STRONG>toolbar</STRONG> widget. Addi-
+ tional options, described above may be specified on the com-
+ mand line or in the option database to configure aspects of
+ the toolbar such as its colors, font, and orientation. The
+ <STRONG>toolbar</STRONG> command returns its pathName argument. At the time
+ this command is invoked, there must not exist a window named
+ pathName, but pathName's parent must exist.
+
+
+ A <STRONG>toolbar</STRONG> is a widget that displays a collection of widgets
+ arranged either in a row or a column (depending on the value
+ of the -orient option). This collection of widgets is usu-
+ ally for user convenience to give access to a set of com-
+ mands or settings. Any widget may be placed on a toolbar.
+ However, command or value-oriented widgets (such as button,
+ radiobutton, etc.) are usually the most useful kind of widg-
+ ets to appear on a toolbar.
+
+ In addition, the toolbar adds two new options to all widgets
+ that are added to it. These are the <STRONG>helpStr</STRONG> and <STRONG>balloonStr</STRONG>
+ options. See the discussion for the widget command add
+ below.
+
+
+
+</PRE>
+<H2>WIDGET-SPECIFIC METHODS</H2><PRE>
+ The toolbar command creates a new Tcl command whose name is
+ pathName. This command may be used to invoke various opera-
+ tions on the widget. It has the following general form:
+
+ <EM>pathName</EM> <EM>option</EM> ?<EM>arg</EM> <EM>arg</EM> ...?
+
+ Option and args determine the exact behavior of the command.
+
+ Many of the widget commands for a toolbar take as one argu-
+ ment an indicator of which widget item of the toolbar to
+ operate on. The indicator is called an <STRONG>index</STRONG> and may be
+ specified in any of the following forms:
+
+ <EM>number</EM>
+ Specifies the widget numerically, where 0 corresponds
+ to the first widget in the notebook, 1 to the second,
+ and so on. (For horizontal, 0 is the leftmost; for
+ vertical, 0 is the topmost).
+
+ <STRONG>end</STRONG> Specifes the last widget in the toolbar's index. If the
+ toolbar is empty this will return -1.
+
+ <STRONG>last</STRONG> Same as end.
+
+ <EM>pattern</EM>
+ If the index doesn't satisfy any of the above forms,
+ then this form is used. Pattern is pattern-matched
+ against the widgetName of each widget in the toolbar,
+ in order from the first to the last widget, until a
+ matching entry is found. An exact match must occur.
+
+ The following commands are possible for toolbar widgets:
+
+ <EM>pathName</EM> <STRONG>add</STRONG> <EM>widgetCommand</EM> <EM>widgetName</EM> ?<EM>option</EM> <EM>value</EM>?
+ Adds a widget with the command widgetCommand whose name
+ is widgetName to the toolbar. If widgetCommand is
+ radiobutton or checkbutton, its packing is slightly
+ padded to match the geometry of button widgets. In
+ addition, the indicatorOn option is false by default
+ and the selectColor is that of the toolbar background
+ by default. This allows Radiobutton and Checkbutton
+ widgets to be added as icons by simply setting their
+ bitmap or image options. If additional arguments are
+ present, they are the set of available options that the
+ widget type of <EM>widgetCommand</EM> supports. In addition they
+ may also be one of the following options:
+
+ <STRONG>-helpstr</STRONG> <EM>value</EM>
+ Specifes the help string to associate with the
+ widget. When the mouse moves over the widget, the
+ variable denoted by <STRONG>helpVariable</STRONG> is set to
+ <STRONG>helpStr</STRONG>. Another widget can bind to the helpVari-
+ able and thus track status help.
+
+ <STRONG>-balloonstr</STRONG> <EM>value</EM>
+ Specifes the string to display in a balloon window
+ for this widget. A balloon window is a small popup
+ window centered at the bottom of the widget. Usu-
+ ally the <STRONG>balloonStr</STRONG> value is the name of the item
+ on the toolbar. It is sometimes known as a hint
+ window.
+
+ When the mouse moves into an item on the toolbar,
+ a timer is set based on the value of <STRONG>balloonDe-</STRONG>
+ <STRONG>lay1</STRONG>. If the mouse stays inside the item for <STRONG>bal-</STRONG>
+ <STRONG>loonDelay1</STRONG>, the balloon window will pop up
+ displaying the <STRONG>balloonStr</STRONG> value. Once the balloon
+ window is posted, a new timer based on <STRONG>balloonDe-</STRONG>
+ <STRONG>lay2</STRONG> is set. This is typically a shorter timer. If
+ the mouse is moved to another item, the window is
+ unposted and a new window will be posted over the
+ item if the shorter delay time is satisfied.
+
+ While the balloon window is posted, it can also be
+ unposted if the item is selected. In this case the
+ timer is reset to <STRONG>balloonDelay1</STRONG>. Whenever the
+ mouse leaves the toolbar, the timer is also reset
+ to <STRONG>balloonDelay1</STRONG>.
+
+ This window posting/unposting model is the same
+ model used in the Windows95 environment.
+
+ <EM>pathName</EM> <STRONG>cget</STRONG> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM>.
+
+ <EM>pathName</EM> <STRONG>configure</STRONG> ?<EM>option</EM> <EM>value</EM>?
+ Query or modify the configuration options of the
+ widget. If no <EM>option</EM> is specified, returns a list
+ describing all of the available options for pathName
+ (see Tk_ConfigureInfo for information on the format of
+ this list). If <EM>option</EM> is specified with no value, then
+ the command returns a list describing the one named
+ option (this list will be identical to the correspond-
+ ing sublist of the value returned if no option is
+ specified). If one or more option-value pairs are
+ specified, then the command modifies the given widget
+ option(s) to have the given value(s); in this case the
+ command returns an empty string.
+
+ <EM>pathName</EM> <STRONG>delete</STRONG> <EM>index</EM> ?<EM>index2</EM>?
+ This command deletes all items between <EM>index</EM> and <EM>index2</EM>
+ inclusive. If <EM>index2</EM> is omitted then it defaults to
+ <EM>index</EM>. Returns an empty string.
+
+ <EM>pathName</EM> <STRONG>index</STRONG> <EM>index</EM>
+ Returns the widget's numerical index for the entry
+ corresponding to <EM>index</EM>. If <EM>index</EM> is not found, -1 is
+ returned.
+
+
+</PRE>
+<H2>value?</H2><PRE>
+ <EM>pathName</EM> <STRONG>insert</STRONG> <EM>beforeIndex</EM> <EM>widgetCommand</EM> <EM>widgetName</EM> ?<EM>option</EM>
+
+ Insert a new item named <EM>widgetName</EM> with the
+ command <EM>widgetCommand</EM> before the item specified by
+ <EM>beforeIndex</EM>. If <EM>widgetCommand</EM> is <STRONG>radiobutton</STRONG> or <STRONG>check-</STRONG>
+ <STRONG>button</STRONG>, its packing is slightly padded to match the
+ geometry of button widgets. In addition, the <STRONG>indica-</STRONG>
+ <STRONG>torOn</STRONG> option is <STRONG>false</STRONG> by default and the <STRONG>selectColor</STRONG> is
+ that of the toolbar background by default. This allows
+ <STRONG>Radiobutton</STRONG> and <STRONG>Checkbutton</STRONG> widgets to be added as
+ icons by simply setting their <STRONG>bitmap</STRONG> or <STRONG>image</STRONG> options.
+ The set of available options is the same as specified
+ in the <STRONG>ad</STRONG> command.
+
+ <EM>pathName</EM> <STRONG>itemcget</STRONG> <EM>index</EM> <EM>option</EM>
+ Returns the current value of the configuration option
+ given by <EM>option</EM> for index. The item type of <EM>index</EM>
+ determines the valid available options.
+
+ <EM>pathName</EM> <STRONG>itemconfigure</STRONG> <EM>index</EM> ?<EM>option</EM> <EM>value</EM>?
+ Query or modify the configuration options of the widget
+ of the toolbar specified by <EM>index</EM>. If no option is
+ specified, returns a list describing all of the avail-
+ able options for <EM>index</EM> (see <STRONG>Tk_ConfigureInfo</STRONG> for infor-
+ mation on the format of this list). If <EM>option</EM> is speci-
+ fied with no value, then the command returns a list
+ describing the one named option (this list will be
+ identical to the corresponding sublist of the value
+ returned if no option is specified). If one or more
+ option-value pairs are specified, then the command
+ modifies the given widget option(s) to have the given
+ value(s); in this case the command returns an empty
+ string. The item type of <EM>index</EM> determines the valid
+ available options. The set of available options is the
+ same as specified in the <STRONG>ad</STRONG> command.
+
+
+</PRE>
+<H2>EXAMPLE</H2><PRE>
+ toolbar .tb -helpvariable statusVar
+
+ .tb add button item1 \
+ -helpstr "Save It" -bitmap @./icons/Tool_32_box.xbm \
+ -balloonstr "Save" -command {puts 1}
+ .tb add button item2 \
+ -helpstr "Save It" -bitmap @./icons/Tool_32_brush.xbm \
+ -balloonstr "Save" -command {puts 1}
+ .tb add button item3 \
+ -helpstr "Save It" -bitmap @./icons/Tool_32_cut.xbm \
+ -balloonstr "Save" -command {puts 1}
+ .tb add button item4 \
+ -helpstr "Save It" -bitmap @./icons/Tool_32_draw.xbm \
+ -balloonstr "Save" -command {puts 1}
+ .tb add button item5 \
+ -bitmap @./icons/Tool_32_erase.xbm -helpstr "Play It" \
+ -command {puts 2}
+ .tb add frame filler \
+ -borderwidth 1 -width 10 -height 10
+ .tb add radiobutton item6 \
+ -bitmap @./icons/Tool_32_oval.xbm -command {puts 4} \
+ -variable result -value OPEN -helpstr "Radio Button # 1" \
+ -balloonstr "Radio"
+ .tb add radiobutton item7 \
+ -bitmap @./icons/Tool_32_line.xbm -command {puts 5} \
+ -variable result -value CLOSED
+ .tb add checkbutton item8 \
+ -bitmap @./icons/Tool_32_text.xbm -command {puts 6} \
+ -variable checkit -onvalue yes -offvalue no
+ .tb add checkbutton check2 \
+ -bitmap @./icons/Tool_32_points.xbm -command {puts 7} \
+ -variable checkit2 -onvalue yes -offvalue no
+
+ pack .tb -side top -anchor nw
+
+
+
+</PRE>
+<H2>AUTHOR</H2><PRE>
+ Bill Scott
+
+
+</PRE>
+<H2>KEYWORDS</H2><PRE>
+ toolbar, button, radiobutton, checkbutton, iwidgets, widget
+
+
+
+</PRE>
+</BODY>
+</HTML>
diff --git a/itcl/iwidgets3.0.0/demos/hyperhelp b/itcl/iwidgets3.0.0/demos/hyperhelp
new file mode 100755
index 00000000000..cd801e4f389
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/hyperhelp
@@ -0,0 +1,19 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: hyperhelp in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+
+button .push -text "Help..." -command {
+ set win [iwidgets::hyperhelp .#auto -title "Hyperhelp demo" -modality none \
+ -topics {demo} -helpdir [file join ${iwidgets::library} demos]]
+ $win showtopic demo
+ $win activate
+}
+pack .push
diff --git a/itcl/iwidgets3.0.0/demos/images/box.xbm b/itcl/iwidgets3.0.0/demos/images/box.xbm
new file mode 100644
index 00000000000..7498e15de2d
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/box.xbm
@@ -0,0 +1,14 @@
+#define Tool_32_box_width 32
+#define Tool_32_box_height 32
+static unsigned char Tool_32_box_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0xe0, 0xff, 0xff, 0x0f, 0x20, 0x00, 0x00, 0x08,
+ 0x20, 0x00, 0x00, 0x08, 0x20, 0x00, 0x00, 0x08, 0x20, 0x00, 0x00, 0x08,
+ 0x20, 0x00, 0x00, 0x08, 0x20, 0x00, 0x00, 0x08, 0x20, 0x00, 0x00, 0x08,
+ 0x20, 0x00, 0x00, 0x08, 0x20, 0x00, 0x00, 0x08, 0x20, 0x00, 0x00, 0x08,
+ 0x20, 0x00, 0x00, 0x08, 0x20, 0x00, 0x00, 0x08, 0x20, 0x00, 0x00, 0x08,
+ 0x20, 0x00, 0x00, 0x08, 0x20, 0x00, 0x00, 0x08, 0x20, 0x00, 0x00, 0x08,
+ 0xe0, 0xff, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, };
diff --git a/itcl/iwidgets3.0.0/demos/images/clear.gif b/itcl/iwidgets3.0.0/demos/images/clear.gif
new file mode 100644
index 00000000000..bd45628aa7a
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/clear.gif
Binary files differ
diff --git a/itcl/iwidgets3.0.0/demos/images/close.gif b/itcl/iwidgets3.0.0/demos/images/close.gif
new file mode 100644
index 00000000000..f91b9e9d1eb
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/close.gif
Binary files differ
diff --git a/itcl/iwidgets3.0.0/demos/images/copy.gif b/itcl/iwidgets3.0.0/demos/images/copy.gif
new file mode 100644
index 00000000000..7319f1dcb0a
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/copy.gif
Binary files differ
diff --git a/itcl/iwidgets3.0.0/demos/images/cut.gif b/itcl/iwidgets3.0.0/demos/images/cut.gif
new file mode 100644
index 00000000000..4258b175912
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/cut.gif
Binary files differ
diff --git a/itcl/iwidgets3.0.0/demos/images/exit.gif b/itcl/iwidgets3.0.0/demos/images/exit.gif
new file mode 100644
index 00000000000..e462be033f6
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/exit.gif
Binary files differ
diff --git a/itcl/iwidgets3.0.0/demos/images/find.gif b/itcl/iwidgets3.0.0/demos/images/find.gif
new file mode 100644
index 00000000000..dddcb8044b7
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/find.gif
Binary files differ
diff --git a/itcl/iwidgets3.0.0/demos/images/help.gif b/itcl/iwidgets3.0.0/demos/images/help.gif
new file mode 100644
index 00000000000..bc8f18c00dc
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/help.gif
Binary files differ
diff --git a/itcl/iwidgets3.0.0/demos/images/line.xbm b/itcl/iwidgets3.0.0/demos/images/line.xbm
new file mode 100644
index 00000000000..4622ae978b7
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/line.xbm
@@ -0,0 +1,14 @@
+#define lineOp_width 32
+#define lineOp_height 32
+static unsigned char lineOp_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x78, 0x00, 0x00, 0x00,
+ 0xf0, 0x00, 0x00, 0x00, 0xe0, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00,
+ 0x80, 0x07, 0x00, 0x00, 0x00, 0x0f, 0x00, 0x00, 0x00, 0x1e, 0x00, 0x00,
+ 0x00, 0x3c, 0x00, 0x00, 0x00, 0x78, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00,
+ 0x00, 0xe0, 0x01, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x07, 0x00,
+ 0x00, 0x00, 0x0f, 0x00, 0x00, 0x00, 0x1e, 0x00, 0x00, 0x00, 0x3c, 0x00,
+ 0x00, 0x00, 0x78, 0x00, 0x00, 0x00, 0xf0, 0x00, 0x00, 0x00, 0xe0, 0x01,
+ 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0x80, 0x07, 0x00, 0x00, 0x00, 0x0f,
+ 0x00, 0x00, 0x00, 0x1e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/itcl/iwidgets3.0.0/demos/images/mag.gif b/itcl/iwidgets3.0.0/demos/images/mag.gif
new file mode 100644
index 00000000000..4a5be66e76b
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/mag.gif
Binary files differ
diff --git a/itcl/iwidgets3.0.0/demos/images/new.gif b/itcl/iwidgets3.0.0/demos/images/new.gif
new file mode 100644
index 00000000000..9c68ad35f55
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/new.gif
Binary files differ
diff --git a/itcl/iwidgets3.0.0/demos/images/open.gif b/itcl/iwidgets3.0.0/demos/images/open.gif
new file mode 100644
index 00000000000..bed862c8c41
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/open.gif
Binary files differ
diff --git a/itcl/iwidgets3.0.0/demos/images/oval.xbm b/itcl/iwidgets3.0.0/demos/images/oval.xbm
new file mode 100644
index 00000000000..856bd43785c
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/oval.xbm
@@ -0,0 +1,14 @@
+#define ovalOp_width 32
+#define ovalOp_height 32
+static unsigned char ovalOp_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x0f, 0x00,
+ 0x00, 0x1c, 0x70, 0x00, 0x00, 0x03, 0x80, 0x01, 0x80, 0x00, 0x00, 0x02,
+ 0x40, 0x00, 0x00, 0x04, 0x20, 0x00, 0x00, 0x08, 0x10, 0x00, 0x00, 0x10,
+ 0x10, 0x00, 0x00, 0x10, 0x08, 0x00, 0x00, 0x20, 0x08, 0x00, 0x00, 0x20,
+ 0x08, 0x00, 0x00, 0x20, 0x08, 0x00, 0x00, 0x20, 0x10, 0x00, 0x00, 0x10,
+ 0x10, 0x00, 0x00, 0x10, 0x20, 0x00, 0x00, 0x08, 0x40, 0x00, 0x00, 0x04,
+ 0x80, 0x00, 0x00, 0x02, 0x00, 0x03, 0x80, 0x01, 0x00, 0x1c, 0x70, 0x00,
+ 0x00, 0xe0, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/itcl/iwidgets3.0.0/demos/images/paste.gif b/itcl/iwidgets3.0.0/demos/images/paste.gif
new file mode 100644
index 00000000000..9974f23bf57
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/paste.gif
Binary files differ
diff --git a/itcl/iwidgets3.0.0/demos/images/points.xbm b/itcl/iwidgets3.0.0/demos/images/points.xbm
new file mode 100644
index 00000000000..c50aa4c5f3d
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/points.xbm
@@ -0,0 +1,14 @@
+#define dotPencilOp_width 32
+#define dotPencilOp_height 32
+static unsigned char dotPencilOp_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x0c, 0x00, 0x00, 0x00, 0x1e, 0x00, 0x00, 0x00, 0x12, 0x00,
+ 0x00, 0x00, 0x09, 0x00, 0x00, 0x00, 0x09, 0x00, 0x00, 0x80, 0x04, 0x00,
+ 0x00, 0x80, 0x04, 0x00, 0x00, 0x40, 0x02, 0x00, 0x00, 0x40, 0x02, 0x00,
+ 0x00, 0x20, 0x01, 0x00, 0x00, 0x20, 0x01, 0x00, 0x00, 0x90, 0x00, 0x00,
+ 0x00, 0x90, 0x00, 0x00, 0x00, 0x48, 0x00, 0x00, 0x00, 0x48, 0x00, 0x00,
+ 0x00, 0x24, 0x00, 0x18, 0x00, 0x24, 0x00, 0x18, 0x00, 0x12, 0x00, 0x00,
+ 0x00, 0x12, 0x00, 0x30, 0x00, 0x0e, 0x00, 0x30, 0x00, 0x06, 0x00, 0x00,
+ 0x00, 0x06, 0x0c, 0x30, 0x00, 0x00, 0x0c, 0x30, 0x00, 0x30, 0xa0, 0x01,
+ 0x00, 0x60, 0xb0, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, };
diff --git a/itcl/iwidgets3.0.0/demos/images/poly.gif b/itcl/iwidgets3.0.0/demos/images/poly.gif
new file mode 100644
index 00000000000..2b595bb9b7f
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/poly.gif
Binary files differ
diff --git a/itcl/iwidgets3.0.0/demos/images/print.gif b/itcl/iwidgets3.0.0/demos/images/print.gif
new file mode 100644
index 00000000000..d321f17457e
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/print.gif
Binary files differ
diff --git a/itcl/iwidgets3.0.0/demos/images/ruler.gif b/itcl/iwidgets3.0.0/demos/images/ruler.gif
new file mode 100644
index 00000000000..00d26febf6a
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/ruler.gif
Binary files differ
diff --git a/itcl/iwidgets3.0.0/demos/images/save.gif b/itcl/iwidgets3.0.0/demos/images/save.gif
new file mode 100644
index 00000000000..d1ceb1a5c40
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/save.gif
Binary files differ
diff --git a/itcl/iwidgets3.0.0/demos/images/select.gif b/itcl/iwidgets3.0.0/demos/images/select.gif
new file mode 100644
index 00000000000..f885c9ca5ff
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/select.gif
Binary files differ
diff --git a/itcl/iwidgets3.0.0/demos/images/text.xbm b/itcl/iwidgets3.0.0/demos/images/text.xbm
new file mode 100644
index 00000000000..ffb06863031
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/images/text.xbm
@@ -0,0 +1,14 @@
+#define font_edit_width 32
+#define font_edit_height 32
+static unsigned char font_edit_bits[] = {
+ 0x00, 0x00, 0x00, 0x30, 0x00, 0x00, 0x00, 0x38, 0x00, 0x00, 0x00, 0x1c,
+ 0x00, 0x00, 0x00, 0x6e, 0x00, 0x00, 0x00, 0x77, 0x00, 0x00, 0x80, 0x7b,
+ 0x00, 0x00, 0x80, 0x7e, 0x00, 0x00, 0xc0, 0xfd, 0x00, 0x00, 0x60, 0xfb,
+ 0x00, 0x00, 0xb0, 0xf7, 0x00, 0x00, 0xd0, 0xef, 0x00, 0x00, 0xf8, 0xdf,
+ 0x00, 0x00, 0xd4, 0x7f, 0x00, 0x00, 0xaa, 0x1f, 0x00, 0x00, 0x15, 0x0f,
+ 0x00, 0x80, 0x82, 0x06, 0x03, 0x40, 0x01, 0x01, 0x07, 0xa0, 0x80, 0x00,
+ 0x0f, 0x10, 0x40, 0x00, 0x1f, 0x08, 0x20, 0x00, 0x3b, 0xe4, 0x1f, 0x00,
+ 0x73, 0x1a, 0x00, 0x00, 0xe3, 0x07, 0x00, 0x00, 0xc3, 0x01, 0x00, 0x00,
+ 0xe3, 0x03, 0x00, 0x00, 0x7b, 0x07, 0x00, 0x00, 0x1f, 0x06, 0x00, 0x00,
+ 0x07, 0x00, 0x00, 0x00, 0x03, 0x00, 0x00, 0x00, 0x03, 0x00, 0x00, 0x00,
+ 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, };
diff --git a/itcl/iwidgets3.0.0/demos/iwidgets.gif b/itcl/iwidgets3.0.0/demos/iwidgets.gif
new file mode 100644
index 00000000000..93864ff25f4
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/iwidgets.gif
Binary files differ
diff --git a/itcl/iwidgets3.0.0/demos/labeledframe b/itcl/iwidgets3.0.0/demos/labeledframe
new file mode 100755
index 00000000000..a9cea8bdf68
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/labeledframe
@@ -0,0 +1,53 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: labeledframe in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+#
+# Demo script for the Labeledframe class
+#
+set tk_strictMotif 1
+
+iwidgets::Labeledframe .pr -labelpos ne -labeltext "Print range"
+set cs [.pr childsite]
+
+radiobutton $cs.all \
+ -highlightthickness 0 \
+ -anchor w \
+ -justify left \
+ -text "All" \
+ -underline 0 \
+ -value 1
+
+radiobutton $cs.range \
+ -highlightthickness 0 \
+ -anchor w \
+ -justify left \
+ -text "Pages" \
+ -underline 2 \
+ -value 0
+
+iwidgets::entryfield $cs.from \
+ -highlightthickness 0 \
+ -labelpos w \
+ -labeltext "from:" \
+ -width 10
+
+[$cs.from component label] configure -justify left -underline 0
+
+iwidgets::entryfield $cs.to \
+ -highlightthickness 0 \
+ -labelpos w \
+ -labeltext "to:" \
+ -width 10
+
+[$cs.to component label] configure -justify left -underline 0
+
+pack $cs.all -side top -fill x -anchor w
+pack $cs.range -side left -fill x -anchor w
+pack $cs.from -side left -fill x -anchor w
+pack $cs.to -side left -fill x -anchor w
+pack .pr -fill both
diff --git a/itcl/iwidgets3.0.0/demos/labeledwidget b/itcl/iwidgets3.0.0/demos/labeledwidget
new file mode 100755
index 00000000000..5767e4301f1
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/labeledwidget
@@ -0,0 +1,28 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: labeledwidget in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+. configure -background white
+
+iwidgets::labeledwidget .lw -labeltext "Label Text:"
+pack .lw -padx 4 -pady 4
+
+set win [.lw childsite]
+label $win.ex -text "(put your widgets here)" \
+ -background black -foreground white \
+ -width 30 -height 3
+pack $win.ex -expand yes -fill both -padx 4 -pady 4
+
+iwidgets::optionmenu .pos -labeltext "Position:" -command {
+ .lw configure -labelpos [.pos get]
+}
+pack .pos -padx 4 -pady 4
+
+.pos insert end e n ne nw s se sw w
+.pos select w
diff --git a/itcl/iwidgets3.0.0/demos/mainwindow b/itcl/iwidgets3.0.0/demos/mainwindow
new file mode 100644
index 00000000000..b04934211a8
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/mainwindow
@@ -0,0 +1,165 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: mainwindow in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+#
+# Demo script for the Mainwindow class
+#
+iwidgets::mainwindow .mw
+
+set imagedir [file join ${iwidgets::library} demos images]
+
+#
+# Add a File menubutton
+#
+.mw menubar add menubutton file -text "File" -underline 0 -padx 8 -pady 2 \
+ -menu {options -tearoff no
+ command new -label "New" -underline 0 \
+ -helpstr "Create a new file"
+ command open -label "Open ..." -underline 0 \
+ -helpstr "Open an existing file"
+ command save -label "Save" -underline 0 \
+ -helpstr "Save the current file"
+ command saveas -label "Save As ..." -underline 5 \
+ -helpstr "Save the file as a differnet name"
+ command print -label "Print" -underline 0 \
+ -helpstr "Print the file"
+ separator sep1
+ command close -label "Close" -underline 0 \
+ -helpstr "Close the file"
+ separator sep2
+ command exit -label "Exit" -underline 1 \
+ -helpstr "Exit this application" -command ::exit
+ }
+
+#
+# Add the Edit menubutton.
+#
+.mw menubar add menubutton edit -text "Edit" -underline 0 -padx 8 -pady 2 \
+ -menu {options -tearoff no
+ command cut -label "Cut" -underline 2 \
+ -helpstr "Cut the selection into the clipboard"
+ command copy -label "Copy" -underline 0 \
+ -helpstr "Copy the selection to the clipboard"
+ command paste -label "Paste" -underline 0 \
+ -helpstr "Paste the clipboard to the current point"
+ separator sep3
+ command find -label "Find" -underline 2 \
+ -helpstr "Search the text"
+ separator sep4
+ command clear -label "Clear" -underline 2 \
+ -helpstr "Clear the selection"
+ }
+
+#
+# Add the Help menubutton.
+#
+.mw menubar add menubutton help -text "Help" -underline 0 -padx 8 -pady 2 \
+ -menu {options -tearoff no
+ command onwindow -label "On Window" -underline 3 \
+ -helpstr "Obtain help on the window"
+ command onkeys -label "On Keys" -underline 3 \
+ -helpstr "Obtain help on the keys"
+ command index -label "Index" -underline 0 \
+ -helpstr "View the help index"
+ command onhelp -label "On Help" -underline 2 \
+ -helpstr "Obtain help on help"
+ command onversion -label "On Version" -underline 2 \
+ -helpstr "View the version information"
+ }
+
+#
+# Add items to the toolbar.
+#
+.mw toolbar add frame filler1 -width 108 -relief raised -borderwidth 2
+
+.mw toolbar add button new \
+ -image [image create photo new-img -file [file join $imagedir new.gif]] \
+ -helpstr "Create a new file" \
+ -balloonstr "New"
+
+.mw toolbar add button open \
+ -image [image create photo open-img -file [file join $imagedir open.gif]] \
+ -helpstr "Open an existing file" \
+ -balloonstr "Open"
+
+.mw toolbar add button close \
+ -image [image create photo close-img -file [file join $imagedir close.gif]] \
+ -helpstr "Close the file" \
+ -balloonstr "Close"
+
+.mw toolbar add frame filler2 -width 20 -relief raised -borderwidth 2
+
+.mw toolbar add button cut \
+ -image [image create photo cut-img -file [file join $imagedir cut.gif]] \
+ -helpstr "Cut the selection into the cut buffer" \
+ -balloonstr "Cut"
+
+.mw toolbar add button copy \
+ -image [image create photo copy-img -file [file join $imagedir copy.gif]] \
+ -helpstr "Copy the selection to the cut buffer" \
+ -balloonstr "Copy"
+
+.mw toolbar add button paste \
+ -image [image create photo paste-img -file [file join $imagedir paste.gif]] \
+ -helpstr "Paste the cut buffer to the current point" \
+ -balloonstr "Paste"
+
+.mw toolbar add button clear \
+ -image [image create photo clear-img -file [file join $imagedir clear.gif]] \
+ -helpstr "Clear the selection" \
+ -balloonstr "Clear"
+
+.mw toolbar add frame filler3 -relief raised -borderwidth 2
+
+#
+# Add items to the menubar.
+#
+.mw mousebar add button save \
+ -image [image create photo save-img -file [file join $imagedir save.gif]] \
+ -helpstr "Save the current file"
+
+.mw mousebar add button print \
+ -image [image create photo print-img -file [file join $imagedir print.gif]] \
+ -helpstr "Print the file"
+
+.mw mousebar add button find \
+ -image [image create photo find-img -file [file join $imagedir find.gif]] \
+ -helpstr "Search the text"
+
+.mw mousebar add frame filler1 -height 20 -relief raised -borderwidth 2
+
+.mw mousebar add button help \
+ -image [image create photo help-img -file [file join $imagedir help.gif]] \
+ -helpstr "Obtain help for this window"
+
+.mw mousebar add frame filler2 -relief raised -borderwidth 2
+
+.mw mousebar add button exit \
+ -image [image create photo exit-img -file [file join $imagedir exit.gif]] \
+ -helpstr "Exit this application" -command ::exit
+
+.mw mousebar add frame filler3 -height 5
+
+#
+# Change the packing of the last fillers in the tool and mouse bar
+# so that it expands across and down the rest of the mainwindow.
+#
+pack [.mw toolbar component filler3] -expand yes -fill both
+pack [.mw mousebar component filler2] -expand yes -fill both
+
+
+#
+# Install a scrolledtext widget in the childsite.
+#
+iwidgets::scrolledtext [.mw childsite].st -visibleitems 40x8
+pack [.mw childsite].st -fill both -expand yes
+
+#
+# Activate the main window.
+#
+.mw activate
diff --git a/itcl/iwidgets3.0.0/demos/menubar b/itcl/iwidgets3.0.0/demos/menubar
new file mode 100755
index 00000000000..7b5718ee858
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/menubar
@@ -0,0 +1,79 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: menubar in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+iwidgets::menubar .mb -helpvariable helpVar -menubuttons {
+ menubutton file -text "File" -menu {
+ options -tearoff false
+
+ command new -label "New" \
+ -helpstr "Open new document" \
+ -command {puts "selected: New"}
+
+ command close -label "Close" \
+ -helpstr "Close current document" \
+ -command {puts "selected: Close"}
+
+ separator sep1
+
+ command exit -label "Exit" -command {exit} \
+ -helpstr "Exit application"
+ }
+
+ menubutton edit -text "Edit" -menu {
+ options -tearoff false
+
+ command undo -label "Undo" -underline 0 \
+ -helpstr "Undo last command" \
+ -command {puts "selected: Undo"}
+
+ separator sep2
+
+ command cut -label "Cut" -underline 1 \
+ -helpstr "Cut selection to clipboard" \
+ -command {puts CUT}
+
+ command copy -label "Copy" -underline 1 \
+ -helpstr "Copy selection to clipboard" \
+ -command {puts "selected: Copy"}
+
+ command paste -label "Paste" -underline 0 \
+ -helpstr "Paste clipboard contents into document" \
+ -command {puts "selected: Paste"}
+ }
+
+ menubutton options -text "Options" -menu {
+ options -tearoff false -selectcolor blue
+
+ radiobutton byName -variable viewMode \
+ -value NAME -label "by Name" \
+ -helpstr "View files by name order" \
+ -command {puts "selected: by Name"}
+
+ radiobutton byDate -variable viewMode \
+ -value DATE -label "by Date" \
+ -helpstr "View files by date order" \
+ -command {puts "selected: by Date"}
+
+ cascade prefs -label "Preferences" -menu {
+ command colors -label Colors... \
+ -helpstr "Change text colors" \
+ -command {puts "selected: Colors..."}
+
+ command fonts -label "Fonts..." \
+ -helpstr "Change text font" \
+ -command {puts "selected: Fonts..."}
+ }
+ }
+}
+pack .mb -fill x
+
+frame .fr -width 200 -height 200 -background white
+pack .fr -fill both
+
+label .help -anchor w -textvariable helpVar -width 40
+pack .help -fill x
diff --git a/itcl/iwidgets3.0.0/demos/messagebox b/itcl/iwidgets3.0.0/demos/messagebox
new file mode 100755
index 00000000000..8f88051e55f
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/messagebox
@@ -0,0 +1,35 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: messagebox in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+. configure -background white
+
+iwidgets::messagebox .mb -hscrollmode dynamic -labeltext "Messages" \
+ -labelpos n -visibleitems 50x8
+
+pack .mb -padx 5 -pady 5 -fill both -expand yes
+
+.mb type add ERROR -background red -foreground white -bell 1
+.mb type add WARNING -background yellow -foreground black
+.mb type add INFO -background white -foreground black
+
+frame .cntls -background white
+pack .cntls -padx 5 -pady 5 -fill x
+button .cntls.error -text "Error" -command {
+ .mb issue "This is an error message in red with a beep" ERROR
+}
+pack .cntls.error -side left -expand yes
+
+button .cntls.warning -text "Warning" -command {
+ .mb issue "This warning message in yellow" WARNING
+}
+pack .cntls.warning -side left -expand yes
+
+button .cntls.info -text "Info" -command {
+ .mb issue "This is an informational message" INFO
+}
+pack .cntls.info -side left -expand yes
diff --git a/itcl/iwidgets3.0.0/demos/messagedialog b/itcl/iwidgets3.0.0/demos/messagedialog
new file mode 100755
index 00000000000..ca5d81d60fc
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/messagedialog
@@ -0,0 +1,26 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: messagedialog in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+
+button .b -text "Confirm..." -command {
+ if {[.md activate]} {
+ puts "selected: Yes"
+ } else {
+ puts "selected: No"
+ }
+}
+pack .b
+
+iwidgets::messagedialog .md -title "Message Dialog" -modality application \
+ -bitmap questhead -text "Are you sure?"
+
+.md hide Help
+.md buttonconfigure OK -text "Yes"
+.md buttonconfigure Cancel -text "No"
diff --git a/itcl/iwidgets3.0.0/demos/notebook b/itcl/iwidgets3.0.0/demos/notebook
new file mode 100755
index 00000000000..a023d770145
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/notebook
@@ -0,0 +1,76 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: notebook in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+option add *Scale.width 8
+. configure -background white
+
+iwidgets::optionmenu .pages -labeltext "Page:" -command {
+ .nb view [.pages get]
+}
+pack .pages -padx 4 -pady 4
+.pages insert end "Personal Info" "Favorite Color" "Blank Page"
+
+
+iwidgets::notebook .nb -width 3i -height 2.6i
+pack .nb -padx 4 -pady 4
+
+# Page #1
+# ----------------------------------------------------------------------
+set page [.nb add -label "Personal Info"]
+
+iwidgets::entryfield $page.name -labeltext "Name:" -labelpos nw
+pack $page.name
+iwidgets::entryfield $page.addr -labeltext "Address:" -labelpos nw
+pack $page.addr
+iwidgets::entryfield $page.addr2 -labeltext "City, State:" -labelpos nw
+pack $page.addr2
+iwidgets::entryfield $page.email -labeltext "E-mail:" -labelpos nw
+pack $page.email
+
+
+# Page #2
+# ----------------------------------------------------------------------
+set page [.nb add -label "Favorite Color"]
+
+frame $page.sample -width 20 -height 20 \
+ -borderwidth 2 -relief raised
+pack $page.sample -fill both -pady 4
+scale $page.r -label "Red" -orient horizontal \
+ -from 0 -to 255 -command "set_color $page"
+pack $page.r -fill x
+scale $page.g -label "Green" -orient horizontal \
+ -from 0 -to 255 -command "set_color $page"
+pack $page.g -fill x
+scale $page.b -label "Blue" -orient horizontal \
+ -from 0 -to 255 -command "set_color $page"
+pack $page.b -fill x
+
+proc set_color {page {val 0}} {
+ set r [$page.r get]
+ set g [$page.g get]
+ set b [$page.b get]
+ set color [format "#%.2x%.2x%.2x" $r $g $b]
+ $page.sample configure -background $color
+}
+set_color $page
+
+
+# Page #3
+# ----------------------------------------------------------------------
+set page [.nb add -label "Blank Page"]
+
+label $page.title -text "(put your widgets here)" \
+ -background black -foreground white \
+ -width 25 -height 3
+pack $page.title -expand yes -fill both
+
+
+.nb view "Personal Info"
diff --git a/itcl/iwidgets3.0.0/demos/optionmenu b/itcl/iwidgets3.0.0/demos/optionmenu
new file mode 100755
index 00000000000..3c17f34a6c0
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/optionmenu
@@ -0,0 +1,18 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: optionmenu in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+
+iwidgets::optionmenu .cb -labeltext "Font:" -labelpos w -command {
+ puts "selected: [.cb get]"
+}
+pack .cb
+
+.cb insert end Ariel Courier Helvetica Knarly Lucida \
+ Rumpus Symbol Times "Zapf Dingbats"
diff --git a/itcl/iwidgets3.0.0/demos/panedwindow b/itcl/iwidgets3.0.0/demos/panedwindow
new file mode 100755
index 00000000000..b0be611692e
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/panedwindow
@@ -0,0 +1,35 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: panedwindow in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+. configure -background white
+
+iwidgets::panedwindow .pw -width 3i -height 3i
+pack .pw -padx 4 -pady 4
+
+.pw add "top"
+set pane [.pw childsite "top"]
+label $pane.l -text "(put some widgets here)" \
+ -background black -foreground white
+pack $pane.l -expand yes -fill both
+
+.pw add "bottom"
+set pane [.pw childsite "bottom"]
+label $pane.l -text "(put other widgets here)" \
+ -background black -foreground white
+pack $pane.l -expand yes -fill both
+
+.pw fraction 40 60
+
+
+iwidgets::optionmenu .orient -labeltext "Orientation:" -command {
+ .pw configure -orient [.orient get]
+}
+pack .orient -padx 4 -pady 4
+.orient insert end horizontal vertical
diff --git a/itcl/iwidgets3.0.0/demos/promptdialog b/itcl/iwidgets3.0.0/demos/promptdialog
new file mode 100755
index 00000000000..3e1720e2caf
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/promptdialog
@@ -0,0 +1,26 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: promptdialog in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+
+button .b -text "Get Password..." -command {
+ if {[.pd activate]} {
+ puts "password: [.pd get]"
+ } else {
+ puts "cancelled"
+ }
+}
+pack .b
+
+iwidgets::promptdialog .pd -title "Prompt Dialog" -modality application \
+ -labeltext "Password:" -show "*"
+
+.pd hide Apply
+.pd hide Help
diff --git a/itcl/iwidgets3.0.0/demos/pushbutton b/itcl/iwidgets3.0.0/demos/pushbutton
new file mode 100755
index 00000000000..3244a076292
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/pushbutton
@@ -0,0 +1,22 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: pushbutton in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+. configure -background white
+
+iwidgets::pushbutton .pb -text "Push Me" -defaultring yes -command {
+ puts "Hello, World!"
+}
+pack .pb -padx 4 -pady 4
+
+checkbutton .default -text "Default ring" -variable defring \
+ -command {.pb configure -defaultring $defring}
+pack .default -padx 4 -pady 4
+
+.default invoke
diff --git a/itcl/iwidgets3.0.0/demos/radiobox b/itcl/iwidgets3.0.0/demos/radiobox
new file mode 100755
index 00000000000..db5cda15f47
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/radiobox
@@ -0,0 +1,19 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: radiobox in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+iwidgets::radiobox .rb -labeltext "Size:" -labelpos nw
+pack .rb -padx 4 -pady 4 -fill both
+
+.rb add small -text "Small"
+.rb add med -text "Medium"
+.rb add large -text "Large"
+.rb add xlarge -text "Biggie"
+
+.rb select med
diff --git a/itcl/iwidgets3.0.0/demos/scrolledcanvas b/itcl/iwidgets3.0.0/demos/scrolledcanvas
new file mode 100755
index 00000000000..e48ab60a12d
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/scrolledcanvas
@@ -0,0 +1,50 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: scrolledcanvas in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+. configure -background white
+
+iwidgets::scrolledcanvas .canv -labeltext "Scrolledcanvas" \
+ -vscrollmode dynamic -hscrollmode dynamic -autoresize yes
+
+pack .canv -expand yes -fill both -padx 4 -pady 4
+.canv xview moveto 0
+.canv yview moveto 0
+
+
+button .zoomin -text "Zoom In" -command {
+ .canv scale all 0 0 2 2
+ .canv configure -scrollregion [.canv bbox all]
+}
+pack .zoomin -side left -expand yes -padx 4 -pady 4
+
+button .zoomout -text "Zoom Out" -command {
+ .canv scale all 0 0 0.5 0.5
+ .canv xview moveto 0
+ .canv yview moveto 0
+ .canv configure -scrollregion [.canv bbox all]
+}
+pack .zoomout -side left -expand yes -padx 4 -pady 4
+
+
+bind [.canv component canvas] <ButtonPress-1> {add_rectangle %W %x %y}
+bind [.canv component canvas] <B1-Motion> {add_rectangle %W %x %y}
+
+proc add_rectangle {win x y} {
+ set x [$win canvasx $x]
+ set y [$win canvasy $y]
+
+ $win create rectangle \
+ [expr $x-4] [expr $y-4] \
+ [expr $x+4] [expr $y+4] \
+ -outline "" -fill red
+
+ $win configure -scrollregion [$win bbox all]
+}
diff --git a/itcl/iwidgets3.0.0/demos/scrolledframe b/itcl/iwidgets3.0.0/demos/scrolledframe
new file mode 100755
index 00000000000..43d816c7e76
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/scrolledframe
@@ -0,0 +1,34 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: scrolledframe in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+
+iwidgets::scrolledframe .sf -width 4i -height 2i -labeltext "Scrolledframe"
+pack .sf
+
+set win [.sf childsite]
+
+set all ""
+foreach option [.sf configure] {
+ if {[llength $option] == 5} {
+ set name [lindex $option 0]
+ set val [lindex $option end]
+
+ set entry [iwidgets::entryfield $win.#auto]
+ pack $entry -fill x
+
+ $entry configure -labeltext $name \
+ -command ".sf configure $name \[$entry get\]"
+ $entry insert 0 $val
+
+ lappend all $entry
+ }
+}
+eval iwidgets::Labeledwidget::alignlabels $all
diff --git a/itcl/iwidgets3.0.0/demos/scrolledhtml b/itcl/iwidgets3.0.0/demos/scrolledhtml
new file mode 100755
index 00000000000..fd4c942988f
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/scrolledhtml
@@ -0,0 +1,19 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: scrolledhtml in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+
+iwidgets::scrolledhtml .sh -labeltext "Scrolledhtml" \
+ -width 5i -height 3i \
+ -wrap word -linkcommand ".sh import -link" -padx 10
+
+pack .sh
+
+.sh import [file join ${iwidgets::library} demos demo.html]
diff --git a/itcl/iwidgets3.0.0/demos/scrolledlistbox b/itcl/iwidgets3.0.0/demos/scrolledlistbox
new file mode 100755
index 00000000000..7ad9394f2fb
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/scrolledlistbox
@@ -0,0 +1,35 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: scrolledlistbox in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+. configure -background white
+
+iwidgets::scrolledlistbox .slb -labeltext "Scrolledlistbox" \
+ -vscrollmode dynamic -hscrollmode none \
+ -selectmode single \
+ -labelpos nw -selectioncommand {
+ puts "click: [.slb getcurselection]"
+ }
+
+pack .slb -padx 4 -pady 4
+
+.slb insert 0 Hello World! Cruel
+.slb delete "Hello"
+.slb insert 0 "Goodbye"
+
+button .add -text "Add" -command {
+ .slb insert end "Goodbye!"
+}
+pack .add -padx 4 -pady 4
+
+button .del -text "Delete" -command {
+ .slb delete 0
+}
+pack .del -padx 4 -pady 4
diff --git a/itcl/iwidgets3.0.0/demos/scrolledtext b/itcl/iwidgets3.0.0/demos/scrolledtext
new file mode 100755
index 00000000000..7c7a2fd0412
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/scrolledtext
@@ -0,0 +1,18 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: scrolledtext in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+
+iwidgets::scrolledtext .st -labeltext "Scrolledtext" -wrap none \
+ -vscrollmode static -hscrollmode dynamic \
+ -width 5i -height 2i
+pack .st
+
+.st import [file join ${iwidgets::library} demos scrolledtext]
diff --git a/itcl/iwidgets3.0.0/demos/selectionbox b/itcl/iwidgets3.0.0/demos/selectionbox
new file mode 100755
index 00000000000..ba215422e5f
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/selectionbox
@@ -0,0 +1,17 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: selectionbox in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+
+iwidgets::selectionbox .sb -selectionlabel "Font:" -height 2i
+pack .sb
+
+.sb insert items end Ariel Courier Helvetica Knarly Lucida \
+ Rumpus Symbol Times "Zapf Dingbats"
diff --git a/itcl/iwidgets3.0.0/demos/selectiondialog b/itcl/iwidgets3.0.0/demos/selectiondialog
new file mode 100755
index 00000000000..b1eceb1983e
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/selectiondialog
@@ -0,0 +1,27 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: selectiondialog in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+
+iwidgets::selectiondialog .sd -modality application
+.sd configure -selectionlabel "Font:"
+
+.sd insert items end Ariel Courier Helvetica Knarly Lucida \
+ Rumpus Symbol Times "Zapf Dingbats"
+
+button .select -text "Font..." -command {
+ if {[.sd activate]} {
+ puts "selected: [.sd get]"
+ } else {
+ puts "cancelled"
+ }
+}
+pack .select -side left
+
diff --git a/itcl/iwidgets3.0.0/demos/spindate b/itcl/iwidgets3.0.0/demos/spindate
new file mode 100755
index 00000000000..c7a7676a431
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/spindate
@@ -0,0 +1,14 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: spindate in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+
+iwidgets::spindate .sd -monthformat brief
+pack .sd
diff --git a/itcl/iwidgets3.0.0/demos/spinint b/itcl/iwidgets3.0.0/demos/spinint
new file mode 100755
index 00000000000..3d1f0991aa4
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/spinint
@@ -0,0 +1,34 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: spinint in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+. configure -background white
+
+iwidgets::spinint .times -labeltext "Countdown:" -range {0 10} -width 3
+pack .times -padx 10 -pady 10
+
+.times delete 0 end
+.times insert end "5"
+
+frame .test
+pack .test -padx 10 -pady 10
+button .test.go -text "Go" -command {
+ set count [.times get]
+ while {$count >= 0} {
+ .test.readout configure -text $count
+ update
+ after 200
+ incr count -1
+ }
+ .test.readout configure -text "blast-off!"
+}
+pack .test.go -side left
+label .test.readout -width 15 -background seashell
+pack .test.readout -side left -padx 4 -pady 4
diff --git a/itcl/iwidgets3.0.0/demos/spinner b/itcl/iwidgets3.0.0/demos/spinner
new file mode 100755
index 00000000000..60fc690524d
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/spinner
@@ -0,0 +1,33 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: spinner in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+
+proc spinMonth {win step} {
+ set months {
+ January February March April
+ May June July August September
+ October November December
+ }
+
+ set index [expr [lsearch $months [$win get]] + $step]
+
+ if {$index < 0} {set index 11}
+ if {$index > 11} {set index 0}
+
+ $win delete 0 end
+ $win insert 0 [lindex $months $index]
+}
+
+iwidgets::spinner .sm -labeltext "Month:" -width 10 -fixed 10 \
+ -decrement {spinMonth .sm -1} -increment {spinMonth .sm 1}
+
+pack .sm
+.sm insert 0 "January"
diff --git a/itcl/iwidgets3.0.0/demos/spintime b/itcl/iwidgets3.0.0/demos/spintime
new file mode 100755
index 00000000000..4c9c0059a4f
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/spintime
@@ -0,0 +1,14 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: spintime in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+
+iwidgets::spintime .st
+pack .st
diff --git a/itcl/iwidgets3.0.0/demos/tabnotebook b/itcl/iwidgets3.0.0/demos/tabnotebook
new file mode 100755
index 00000000000..501583ee6f2
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/tabnotebook
@@ -0,0 +1,77 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: tabnotebook in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+option add *textBackground seashell
+option add *Tabnotebook.backdrop DimGray
+option add *Scale.width 8
+. configure -background white
+
+iwidgets::tabnotebook .tnb -width 5i -height 3i
+pack .tnb -padx 4 -pady 4
+
+# Page #1
+# ----------------------------------------------------------------------
+set page [.tnb add -label "Personal Info"]
+
+iwidgets::entryfield $page.name -labeltext "Name:" -labelpos nw
+pack $page.name
+iwidgets::entryfield $page.addr -labeltext "Address:" -labelpos nw
+pack $page.addr
+iwidgets::entryfield $page.addr2 -labeltext "City, State:" -labelpos nw
+pack $page.addr2
+iwidgets::entryfield $page.email -labeltext "E-mail:" -labelpos nw
+pack $page.email
+
+
+# Page #2
+# ----------------------------------------------------------------------
+set page [.tnb add -label "Favorite Color"]
+
+frame $page.sample -width 20 -height 20 \
+ -borderwidth 2 -relief raised
+pack $page.sample -fill both -pady 4
+scale $page.r -label "Red" -orient horizontal \
+ -from 0 -to 255 -command "set_color $page"
+pack $page.r -fill x
+scale $page.g -label "Green" -orient horizontal \
+ -from 0 -to 255 -command "set_color $page"
+pack $page.g -fill x
+scale $page.b -label "Blue" -orient horizontal \
+ -from 0 -to 255 -command "set_color $page"
+pack $page.b -fill x
+
+proc set_color {page {val 0}} {
+ set r [$page.r get]
+ set g [$page.g get]
+ set b [$page.b get]
+ set color [format "#%.2x%.2x%.2x" $r $g $b]
+ $page.sample configure -background $color
+}
+set_color $page
+
+
+# Page #3
+# ----------------------------------------------------------------------
+set page [.tnb add -label "Blank Page"]
+
+label $page.title -text "(put your widgets here)" \
+ -background black -foreground white \
+ -width 25 -height 3
+pack $page.title -expand yes -fill both
+
+
+iwidgets::optionmenu .orient -labeltext "Tabs:" -command {
+ .tnb configure -tabpos [.orient get]
+}
+pack .orient -padx 4 -pady 4
+.orient insert end n s e w
+
+.tnb view "Personal Info"
+.tnb configure -tabpos [.orient get]
diff --git a/itcl/iwidgets3.0.0/demos/tabset b/itcl/iwidgets3.0.0/demos/tabset
new file mode 100755
index 00000000000..8b4b531dca9
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/tabset
@@ -0,0 +1,21 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: tabset in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+proc showTab {num} {
+ puts "selected: [.ts tabcget $num -label]"
+}
+
+iwidgets::tabset .ts -command showTab
+pack .ts
+
+for {set i 1} {$i <= 5} {incr i} {
+ .ts add -label "#$i"
+}
+.ts select 0
diff --git a/itcl/iwidgets3.0.0/demos/timeentry b/itcl/iwidgets3.0.0/demos/timeentry
new file mode 100755
index 00000000000..aea25ec8051
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/timeentry
@@ -0,0 +1,10 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: timeentry in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+iwidgets::timeentry .de -labeltext "Time:"
+pack .de -fill x -expand yes -padx 10 -pady 10
diff --git a/itcl/iwidgets3.0.0/demos/timefield b/itcl/iwidgets3.0.0/demos/timefield
new file mode 100755
index 00000000000..155499e1852
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/timefield
@@ -0,0 +1,15 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: timefield in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+proc returnCmd {} {
+ puts [.df get]
+}
+
+iwidgets::timefield .df -labeltext "Time:" -command returnCmd
+pack .df -fill x -expand yes -padx 10 -pady 10
+
diff --git a/itcl/iwidgets3.0.0/demos/toolbar b/itcl/iwidgets3.0.0/demos/toolbar
new file mode 100755
index 00000000000..655d5951df6
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/toolbar
@@ -0,0 +1,50 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: toolbar in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+# itkwish interprets the rest...
+# ----------------------------------------------------------------------
+label .status -textvariable statusVar -width 40 -anchor w
+pack .status -side bottom
+
+iwidgets::toolbar .tb -helpvariable statusVar -orient vertical
+pack .tb -side left -anchor nw -padx 4 -pady 4
+
+set imagedir [file join ${iwidgets::library} demos images]
+
+.tb add button select \
+ -helpstr "Select drawing elements" \
+ -image [image create photo -file [file join $imagedir select.gif]] \
+ -balloonstr "Selection tool" \
+ -command {puts "tool: select"}
+
+.tb add button magnify \
+ -helpstr "Magnify drawing area" \
+ -image [image create photo -file [file join $imagedir mag.gif]] \
+ -balloonstr "Zoom tool" \
+ -command {puts "tool: magnify"}
+
+.tb add button ruler \
+ -helpstr "Measure distances on drawing" \
+ -image [image create photo -file [file join $imagedir ruler.gif]] \
+ -balloonstr "Ruler tool" \
+ -command {puts "tool: ruler"}
+
+.tb add frame filler \
+ -borderwidth 1 \
+ -width 10 \
+ -height 10
+
+.tb add button poly \
+ -helpstr "Draw a polygon" \
+ -image [image create photo -file [file join $imagedir poly.gif]] \
+ -balloonstr "Polygon tool" \
+ -command {puts "tool: polygon"}
+
+canvas .worksp -width 2i -height 3i \
+ -borderwidth 2 -relief sunken -background white
+pack .worksp -side right -expand yes -fill both -padx 4 -pady 4
diff --git a/itcl/iwidgets3.0.0/demos/watch b/itcl/iwidgets3.0.0/demos/watch
new file mode 100644
index 00000000000..5875fda8810
--- /dev/null
+++ b/itcl/iwidgets3.0.0/demos/watch
@@ -0,0 +1,18 @@
+#!/bin/sh
+# ----------------------------------------------------------------------
+# DEMO: watch in [incr Widgets]
+# ----------------------------------------------------------------------
+#\
+exec itkwish "$0" ${1+"$@"}
+package require Iwidgets 3.0
+
+set tk_strictMotif 1
+
+iwidgets::watch .w -state disabled -showampm no -width 155 -height 155
+pack .w -padx 10 -pady 10 -fill both -expand yes
+
+proc fix_time {} {
+ .w show
+ after 1000 {catch fix_time}
+}
+fix_time
diff --git a/itcl/iwidgets3.0.0/doc/buttonbox.n b/itcl/iwidgets3.0.0/doc/buttonbox.n
new file mode 100644
index 00000000000..0cb464a8752
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/buttonbox.n
@@ -0,0 +1,188 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) buttonbox.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS buttonbox iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+buttonbox \- Create and manipulate a manager widget for buttons
+.SH SYNOPSIS
+\fBbuttonbox\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- buttonbox
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBcursor\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.ta 4c 8c 12c
+.LP
+.nf
+Name: \fBorient\fR
+Class: \fBOrient\fR
+Command-Line Switch: \fB-orient\fR
+.fi
+.IP
+Orientation of the button box: \fBhorizontal\fR or \fBvertical\fR. The default
+is horizontal.
+.LP
+.nf
+Name: \fBpadX\fR
+Class: \fBPadX\fR
+Command-Line Switch: \fB-padx\fR
+.fi
+.IP
+Specifies a non-negative padding distance to leave between the button group and
+the outer edge of the button box in the x direction. The value may be
+given in any of the forms acceptable to \fBTk_GetPixels\fR. The default
+is 5 pixels.
+.LP
+.nf
+Name: \fBpadY\fR
+Class: \fBPadY\fR
+Command-Line Switch: \fB-pady\fR
+.fi
+.IP
+Specifies a non-negative padding distance to leave between the button group and
+the outer edge of the button box in the y direction. The value may be given
+in any of the forms acceptable to \fBTk_GetPixels\fR. The default is 5 pixels.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBbuttonbox\fR command creates a manager widget for controlling
+buttons. The button box also supports the display and invocation
+of a default button. The button box can be configured either horizontally
+or vertically.
+
+.SH "METHODS"
+.PP
+The \fBbuttonbox\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command.
+.PP
+Many of the widget commands for the buttonbox take as one argument an
+indicator of which button of the button box to operate on. These
+indicators are called \fIindexes\fR and allow reference and manipulation
+of buttons regardless of their current map state. buttonbox indexes
+may be specified in any of the following forms:
+.TP 12
+\fInumber\fR
+Specifies the button numerically, where 0 corresponds to the
+left/top-most button of the button box.
+.TP 12
+\fBend\fR
+Indicates the right/bottom-most button of the button box.
+.TP 12
+\fBdefault\fR
+Indicates the current default button of the button box. This is the
+button with the default ring displayed.
+.TP 12
+\fIpattern\fR
+If the index doesn't satisfy one of the above forms then this
+form is used. \fIPattern\fR is pattern-matched against the tag of
+each button in the button box, in order from left/top to right/left,
+until a matching entry is found. The rules of \fBTcl_StringMatch\fR
+are used.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBadd\fR \fItag\fR \fIargs\fR
+Add a button distinguished by \fItag\fR to the end of the button box.
+If additional arguments are present they specify options to be applied
+to the button. See \fBPushButton\fR for information on the options
+available.
+.TP
+\fIpathName \fBbuttonconfigure\fR \fIindex\fR ?\fIoptions\fR?
+This command is similar to the \fBconfigure\fR command, except that
+it applies to the options for an individual button,
+whereas \fBconfigure\fR applies to the options for the button box as a whole.
+\fIOptions\fR may have any of the values accepted by the \fBPushButton\fR
+command. If \fIoptions\fR are specified, options are modified
+as indicated in the command and the command returns an empty string.
+If no \fIoptions\fR are specified, returns a list describing
+the current options for entry \fIindex\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list).
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBbuttonbox\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBbuttonbox\fR
+command.
+.TP
+\fIpathName \fBdefault\fR \fIindex\fR
+Sets the default button to the button given by \fIindex\fR. This causes
+the default ring to appear arround the specified button.
+.TP
+\fIpathName \fBdelete\fR \fIindex\fR
+Deletes the button given by \fIindex\fR from the button box.
+.TP
+\fIpathName \fBhide\fR \fIindex\fR
+Hides the button denoted by \fIindex\fR. This doesn't remove the button
+permanently, just inhibits its display.
+.TP
+\fIpathName \fBindex \fIindex\fR
+Returns the numerical index corresponding to \fIindex\fR.
+.TP
+\fIpathName \fBinsert \fIindex\fR \fItag\fR ?\fIoption value option value ...\fR?
+Same as the \fBadd\fR command except that it inserts the new
+button just before the one given by \fIindex\fR, instead of appending
+to the end of the button box. The \fIoption\fR, and \fIvalue\fR
+arguments have the same interpretation as for the \fBadd\fR widget
+command.
+.TP
+\fIpathName \fBinvoke\fR \fI?index?\fR
+Invoke the command associated with a button. If no arguments
+are given then the current default button is invoked, otherwise the argument
+is expected to be a button \fIindex\fR.
+.TP
+\fIpathName \fBshow\fR \fIindex\fR
+Display a previously hidden button denoted by \fIindex\fR.
+.SH EXAMPLE
+.DS
+ buttonbox .bb
+
+ .bb add Yes -text Yes -command "puts Yes"
+ .bb add No -text No -command "puts No"
+ .bb add Maybe -text Maybe -command "puts Maybe"
+ .bb default Yes
+
+ pack .bb -expand yes -fill both
+.DE
+.SH AUTHOR
+Bret A. Schuhmacher
+.DE
+Mark L. Ulferts
+.SH KEYWORDS
+buttonbox, pushbutton, button, widget
diff --git a/itcl/iwidgets3.0.0/doc/calendar.n b/itcl/iwidgets3.0.0/doc/calendar.n
new file mode 100644
index 00000000000..9b3ddc3e633
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/calendar.n
@@ -0,0 +1,322 @@
+'\"
+'\" Copyright (c) 1997 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) calendar.n 1.0 97/04/30 16:04:44
+'/"
+.so man.macros
+.HS calendar iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+calendar \- Create and manipulate a monthly calendar
+.SH SYNOPSIS
+\fBcalendar\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- calendar
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBcursor\fR \fBforeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBbackwardImage\fR
+Class: \fBImage\fR
+Command-Line Switch: \fB-backwardimage\fR
+.fi
+.IP
+Specifies a image to be displayed on the backwards calendar
+button. This image must have been created previously with
+the \fBimage create\fR command. If none is specified, a default
+is provided.
+.LP
+.nf
+Name: \fBbuttonForeground\fR
+Class: \fBForeground\fR
+Command-Line Switch: \fB-buttonforeground\fR
+.fi
+.IP
+Specifies the foreground color of the forward and backward buttons
+in any of the forms acceptable to \fBTk_GetColor\fR. The default
+color is blue.
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-command\fR
+.fi
+.IP
+Specifies a Tcl script to executed upon selection of a date in the
+calendar. If the command script contains any \fB%\fR characters,
+then the script will not be executed directly. Instead, a new
+script will be generated by replacing each \fB%\fR, and the
+character following it, with information from the calendar. The
+replacement depends on the character following the \fB%\fR, as
+defined in the list below.
+.TP
+\fB%d\fR
+Replaced with the date selected in the format mm/dd/yyyy.
+.LP
+.nf
+Name: \fBcurrentDateFont\fR
+Class: \fBFont\fR
+Command-Line Switch: \fB-currentdatefont\fR
+.fi
+.IP
+Specifies the font used for the current date text in any of the forms
+acceptable to \fBTk_GetFont\fR.
+.LP
+.nf
+Name: \fBdateFont\fR
+Class: \fBFont\fR
+Command-Line Switch: \fB-datefont\fR
+.fi
+.IP
+Specifies the font used for the days of the month text in any of the forms
+acceptable to \fBTk_GetFont\fR.
+.LP
+.nf
+Name: \fBdayFont\fR
+Class: \fBFont\fR
+Command-Line Switch: \fB-dayfont\fR
+.fi
+.IP
+Specifies the font used for the days of the week text in any of the forms
+acceptable to \fBTk_GetFont\fR.
+.LP
+.nf
+Name: \fBdays\fR
+Class: \fBdays\fR
+Command-Line Switch: \fB-days\fR
+.fi
+.IP
+Specifies a list of values to be used for the days of the week
+text to displayed above the days of the month. The default value
+is {Su Mo Tu We Th Fr Sa}.
+.LP
+.nf
+Name: \fBforewardImage\fR
+Class: \fBImage\fR
+Command-Line Switch: \fB-forewardimage\fR
+.fi
+.IP
+Specifies a image to be displayed on the forewards calendar
+button. This image must have been created previously with
+the \fBimage create\fR command. If none is specified, a default
+is provided.
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Command-Line Switch: \fB-height\fR
+.fi
+.IP
+Specifies a desired window height that the calendar widget should
+request from its geometry manager. The value may be specified in any
+of the forms acceptable to \fBTk_GetPixels\fR. The default height
+is 165 pixels.
+.LP
+.nf
+Name: \fBoutline\fR
+Class: \fBOutline\fR
+Command-Line Switch: \fB-outline\fR
+.fi
+.IP
+Specifies the outline color used to surround the days of the month text in
+any of the forms acceptable to \fBTk_GetColor\fR. The default is the
+same color as the background.
+.LP
+.nf
+Name: \fBselectColor\fR
+Class: \fBForeground\fR
+Command-Line Switch: \fB-selectcolor\fR
+.fi
+.IP
+Specifies the color of the ring displayed that distinguishes the
+currently selected date in any of the forms acceptable to
+\fBTk_GetColor\fR. The default is red.
+.LP
+.nf
+Name: \fBselectThickness\fR
+Class: \fBSelectThickness\fR
+Command-Line Switch: \fB-selectthickness\fR
+.fi
+.IP
+Specifies the thickness of the ring displayed that distinguishes
+the currently selected date. The default is 3 pixels.
+.LP
+.nf
+Name: \fBstartday\fR
+Class: \fBDay\fR
+Command-Line Switch: \fB-startday\fR
+.fi
+.IP
+Specifies the starting day for the week: \fBsunday\fR, \fBmonday\fR,
+\fBtuesday\fR, \fBwednesday\fR, \fBthursday\fR, \fBfriday\fR, or
+\fBsaturday\fR. The default is sunday.
+.LP
+.nf
+Name: \fBtitleFont\fR
+Class: \fBFont\fR
+Command-Line Switch: \fB-titlefont\fR
+.fi
+.IP
+Specifies the font used for the title text which consists of the
+month and year. The font may be given in any of the forms
+acceptable to \fBTk_GetFont\fR.
+.LP
+.nf
+Name: \fBweekdayBackground\fR
+Class: \fBBackground\fR
+Command-Line Switch: \fB-weekdaybackground\fR
+.fi
+.IP
+Specifies the background color for the weekdays which allows it to
+be visually distinguished from the weekend. The color may be given
+in any of the forms acceptable to \fBTk_GetColor\fR. The default is
+the same as the background.
+.LP
+.nf
+Name: \fBweekendBackground\fR
+Class: \fBBackground\fR
+Command-Line Switch: \fB-weekendbackground\fR
+.fi
+.IP
+Specifies the background color for the weekends which allows it to
+be visually distinguished from the weekdays. The color may be given
+in any of the forms acceptable to \fBTk_GetColor\fR. The default is
+the same as the background.
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-width\fR
+.fi
+.IP
+Specifies a desired window width that the calendar widget should
+request from its geometry manager. The value may be specified in any
+of the forms acceptable to \fBTk_GetPixels\fR. The default width
+is 200 pixels.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBcalendar\fR command creates a calendar widget for the selection
+of a date, displaying a single month at a time. Buttons exist on the
+top to change the month in effect turning the pages of a calendar. As
+a page is turned, the dates for the month are modified. Selection of
+a date visually marks that date. The selected value can be monitored
+via the -command option or just retrieved using the get command.
+
+.SH "METHODS"
+.PP
+The \fBcalendar\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for calendar widgets:
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBcalendar\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBcalendar\fR
+command.
+.TP
+\fIpathName \fBget\fR ?\fBformat\fR?
+Returns the currently selected date in a format of
+string or as an integer clock value using the \fB-string\fR and \fB-clicks\fR
+format options respectively. The default is by string. Reference the
+clock command for more information on obtaining dates and their
+formats.
+.TP
+\fIpathName \fBselect\fR \fIdate\fR
+Changes the currently selected date to the value specified which
+must be in the form of a date string, an integer clock value or as
+the keyword "now". Reference the clock
+command for more information on obtaining dates and their formats.
+Note that selecting a date does not change the
+month being shown to that of the date given. This chore is left
+to the \fBshow\R command.
+.TP
+\fIpathName \fBshow\fR \fIdate\fR
+Changes the currently displayed date to be that of the date
+argument which must be in the form of a date string, an
+integer clock value or as
+the keyword "now". Reference the clock
+command for more information on obtaining dates and their formats.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBforward\fR
+Class: \fBButton\fR
+.fi
+.IP
+The forward component provides the button on the upper right of the
+calendar that changes the month to be the next. See the "button"
+widget manual entry for details on the forward component item.
+.LP
+.nf
+Name: \fBpage\fR
+Class: \fBCanvas\fR
+.fi
+.IP
+The page component provides the canvas on which the title, days of the
+week, and days of the month appear. See the "canvas" widget manual
+entry for details on the page component item.
+.LP
+.nf
+Name: \fBbackward\fR
+Class: \fBButton\fR
+.fi
+.IP
+The backward component provides the button on the upper right of the
+calendar that changes the month to be the next. See the "button"
+widget manual entry for details on the backward component item.
+
+.SH EXAMPLE
+.DS
+ proc selectCmd {date} {
+ puts $date
+ }
+
+ calendar .c -command {selectCmd %d} -weekendbackground mistyrose \\
+ -weekdaybackground ghostwhite -outline black \\
+ -startday wednesday -days {We Th Fr Sa Su Mo Tu}
+ pack .c
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.DE
+Michael J. McLennan
+.SH KEYWORDS
+calendar, widget
diff --git a/itcl/iwidgets3.0.0/doc/canvasprintbox.n b/itcl/iwidgets3.0.0/doc/canvasprintbox.n
new file mode 100644
index 00000000000..7c9567e8545
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/canvasprintbox.n
@@ -0,0 +1,266 @@
+'\"
+'\" canvasprintbox (c) 1995 Tako Schotanus
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'/"
+.so man.macros
+.HS canvasprintbox iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+canvasprintbox \- Create and manipulate a canvas print box widget
+.SH SYNOPSIS
+\fBcanvasprintbox\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- Canvasprintbox
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBbackground\fR \fBborderWidth\fR \fBcursor\fR
+\fBforeground\fR \fBhighlightBackground\fR \fBhighlightColor\fR \fBhighlightThickness\fR
+\fBinsertBackground\fR \fBinsertBorderWidth\fR \fBinsertOffTime\fR \fBinsertOnTime\fR
+\fBinsertWidth\fR \fBrelief\fR \fBrepeatDelay\fR \fBrepeatInterval\fR
+\fBselectBackground\fR \fBselectBorderWidth\fR \fBselectForeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.IP
+.LP
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBfilename\fR
+Class: \fBFileName\fR
+Command-Line Switch: \fB-filename\fR
+.fi
+.IP
+The file to write the postscript output to (Only when output
+is set to "file"). If posterizing is turned on and \fBhpagecnt\fR
+and/or \fBvpagecnt\fR is more than 1, x.y is appended to the filename
+where x is the horizontal page number and y the vertical page number.
+.LP
+.nf
+Name: \fBhpagecnt\fR
+Class: \fBPageCnt\fR
+Command-Line Switch: \fB-hpagecnt\fR
+.fi
+.IP
+Is used in combination with \fBposterize\fR to determine over
+how many pages the output should be distributed. This
+attribute specifies how many pages should be used horizontaly.
+Any change to this attribute will automatically update the "stamp".
+Defaults to 1.
+.LP
+.nf
+Name: \fBorient\fR
+Class: \fBOrient\fR
+Command-Line Switch: \fB-orient\fR
+.fi
+.IP
+Determines the orientation of the output to the printer (or file).
+It can take the value "portrait" or "landscape" (default). Changes
+to this attribute will be reflected immediately in the "stamp".
+Defaults to "landscape" but will be changed automaticaly to the value
+deemed appropiate for the current canvas. Setting this attribute
+when the canvasprintbox is first constructed (instead of using the
+"configure" method) will turn off the auto adjustment of this attribute.
+.LP
+.nf
+Name: \fBoutput\fR
+Class: \fBOutput\fR
+Command-Line Switch: \fB-output\fR
+.fi
+.IP
+Specifies where the postscript output should go: to the printer
+or to a file. Can take on the values "printer" or "file".
+The corresponding entry-widget will reflect the contents of
+either the \fBprintcmd\fR attribute or the \fBfilename\fR attribute.
+Defaults to "printer".
+.LP
+.nf
+Name: \fBpageSize\fR
+Class: \fBPageSize\fR
+Command-Line Switch: \fB-pagesize\fR
+.fi
+.IP
+The pagesize the printer supports. Changes to this attribute
+will be reflected immediately in the "stamp".
+Defaults to "a4".
+.LP
+.nf
+Name: \fBposterize\fR
+Class: \fBPosterize\fR
+Command-Line Switch: \fB-posterize\fR
+.fi
+.IP
+Indicates if posterizing is turned on or not. Posterizing
+the output means that it is possible to distribute the
+output over more than one page. This way it is possible to
+print a canvas/region which is larger than the specified
+pagesize without stretching. If used in combination with
+stretching it can be used to "blow up" the contents of a
+canvas to as large as size as you want (See attributes:
+hpagecnt and vpagecnt). Any change to this attribute will
+automatically update the "stamp".
+Defaults to 0.
+.LP
+.nf
+Name: \fBprintCmd\fR
+Class: \fBPrintCmd\fR
+Command-Line Switch: \fB-printcmd\fR
+.fi
+.IP
+The command to execute when printing the postscript output.
+The command will get the postscript directed to its standard
+input (Only when output is set to "printer").
+Defaults to "lpr".
+.LP
+.nf
+Name: \fBprintRegion\fR
+Class: \fBPrintRegion\fR
+Command-Line Switch: \fB-printregion\fR
+.fi
+.IP
+A list of four coordinates specifying which part of the canvas to print.
+An empty list means that the canvas' entire \fBscrollregion\fR should be
+printed. Any change to this attribute will automatically update the "stamp".
+Defaults to an empty list.
+.LP
+.nf
+Name: \fBstretch\fR
+Class: \fBStretch\fR
+Command-Line Switch: \fB-stretch\fR
+.fi
+.IP
+Determines if the output should be stretched to fill the
+page (as defined by the attribute pagesize) as large as
+possible. The aspect-ratio of the output will be retained
+and the output will never fall outside of the boundaries
+of the page.
+Defaults to 0 but will be changed automaticaly to the value
+deemed appropiate for the current canvas. Setting this attribute
+when the canvasprintbox is first constructed (instead of using the
+"configure" method) will turn off the auto adjustment of this attribute.
+.LP
+.nf
+Name: \fBvPageCnt\fR
+Class: \fBPageCnt\fR
+Command-Line Switch: \fB-vpagecnt\fR
+.fi
+.IP
+Is used in combination with "posterize" to determine over
+how many pages the output should be distributed. This
+attribute specifies how many pages should be used verticaly.
+Any change to this attribute will automatically update the "stamp".
+Defaults to 1.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+Implements a print box for printing the contents of a canvas widget
+to a printer or a file. It is possible to specify page orientation, the
+number of pages to print the image on and if the output should be
+stretched to fit the page. Options exist to control the appearance and
+actions of the widget.
+
+.SH "METHODS"
+.PP
+The \fBcanvasprintbox\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for canvasprintbox widgets:
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBcanvasprintbox\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBcanvasprintbox\fR
+command.
+.TP
+\fIpathName\fR \fBgetoutput\fR
+Returns the value of the \fBprintercmd\fR or \fBfilename\fR option
+depending on the current setting of \fBoutput\fR.
+.TP
+\fIpathName\fR \fBprint\fR
+Perfrom the actual printing of the canvas using the current settings of
+all the attributes. Returns a boolean indicating wether the printing was
+successful or not.
+.TP
+\fIpathName\fR \fBrefresh\fR
+Retrieves the current value for all edit fields and updates
+the stamp accordingly. Is useful for Apply-buttons.
+.TP
+\fIpathName\fR \fBsetcanvas\fR \fIcanvas\fR
+This is used to set the \fIcanvas\fR that has to be printed.
+A stamp-sized copy will automatically be drawn to show how the
+output would look with the current settings.
+.TP
+\fIpathName \fBstop\fR
+Stops the drawing of the "stamp". I'm currently unable to detect
+when a Canvasprintbox gets destroyed or withdrawn. It's therefore
+advised that you perform a stop before you do something like that.
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBprtflentry\fR
+Class: \fBEntry\fR
+.fi
+.IP
+The prtflentry component is the entry field for user input of the
+\fBfilename\fR or \fBprinter\fR command (depending on the value of
+\fBoutput\fR).
+.LP
+.nf
+Name: \fBhpcnt\fR
+Class: \fBEntry\fR
+.fi
+.IP
+The hpcnt component is the entry field for user input of the number of
+pages to use horizontaly when \fBposterize\fR is turned on.
+.fi
+.nf
+Name: \fBvpcnt\fR
+Class: \fBEntry\fR
+.fi
+.IP
+The vpcnt component is the entry field for user input of the number of
+pages to use verticaly when \fBposterize\fR is turned on.
+.fi
+
+.SH EXAMPLE
+.DS
+canvasprintbox .fsb -orient landscape -stretch 1
+pack .fsb -padx 10 -pady 10 -fill both -expand yes
+.DE
+.SH AUTHOR
+Tako Schotanus
+.LP
+Tako.Schotanus@bouw.tno.nl
+.SH KEYWORDS
+canvasprintbox, widget
diff --git a/itcl/iwidgets3.0.0/doc/canvasprintdialog.n b/itcl/iwidgets3.0.0/doc/canvasprintdialog.n
new file mode 100644
index 00000000000..2eb125010b3
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/canvasprintdialog.n
@@ -0,0 +1,167 @@
+'\"
+'\" canvasprintdialog (c) 1995 Mark L. Ulferts
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) canvasprintdialog.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS canvasprintdialog iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+canvasprintdialog \- Create and manipulate a canvas print dialog widget
+.SH SYNOPSIS
+\fBcanvasprintdialog\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Toplevel <- Dialogshell <- Dialog <- Canvasprintdialog
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBbackground\fR \fBborderWidth\fR \fBcursor\fR
+\fBforeground\fR \fBhighlightBackground\fR \fBhighlightColor\fR \fBhighlightThickness\fR
+\fBinsertBackground\fR \fBinsertBorderWidth\fR \fBinsertOffTime\fR \fBinsertOnTime\fR
+\fBinsertWidth\fR \fBrelief\fR \fBrepeatDelay\fR \fBrepeatInterval\fR
+\fBselectBackground\fR \fBselectBorderWidth\fR \fBselectForeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBfilename\fR \fBhpagecnt\fR \fBorient\fR \fBoutput\fR
+\fBpagesize\fR \fBposterize\fR \fBprintcmd\fR \fBprintregion\fR
+\fBvpagecnt\fR
+.fi
+.LP
+See the "canvasprintbox" widget manual entry for details on the above
+associated options.
+
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbuttonBoxPadX\fR \fBbuttonBoxPadY\fR \fBbuttonBoxPos\fR \fBpadX\fR
+\fBpadY\fR \fBseparator\fR \fBthickness\fR
+.fi
+.LP
+See the "dialogshell" widget manual entry for details on the above
+inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBmaster\fR \fBmodality\fR
+.fi
+.LP
+See the "shell" widget manual entry for details on the above
+inherited options.
+.LP
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtitle\fR
+.fi
+.LP
+See the "Toplevel" widget manual entry for details on the above
+inherited options.
+.LP
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBcanvasprintdialog\fR command creates a print dialog for printing
+the contents of a canvas widget to a printer or a file. It is possible
+to specify page orientation, the number of pages to print the image on
+and if the output should be stretched to fit the page.
+
+.SH "METHODS"
+.PP
+The \fBcanvasprintdialog\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for canvasprintdialog widgets:
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBgetoutput\fR \fBsetcanvas\fR \fBrefresh\fR \fBprint\fR
+.fi
+.LP
+See the "canvasprintbox" class manual entry for details on the
+associated methods.
+.SH "INHERITED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBadd\fR \fBbuttonconfigure\fR \fBdefault\fR \fBhide\fR
+\fBinsert\fR \fBinvoke\fR \fBshow\fR
+.fi
+.LP
+See the "buttonbox" widget manual entry for details on the above
+inherited methods.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactivate\fR \fBdeactivate\fR
+.fi
+.LP
+See the "dialogshell" widget manual entry for details on the above
+inherited methods.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by
+the \fBcanvasprintdialog\fR command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by
+the \fBcanvasprintdialog\fR
+command.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBcpb\fR
+Class: \fBCanvasprintbox\fR
+.fi
+.IP
+The cpb component is the canvas print box for the canvas print dialog.
+See the "canvasprintbox" widget manual entry for details on the cpb
+component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ canvasprintdialog .cpb
+ .cpb activate
+.DE
+.SH AUTHOR
+Tako Schotanus
+.LP
+Tako.Schotanus@bouw.tno.nl
+.SH KEYWORDS
+canvasprintdialog, canvasprintbox, dialog, widget
diff --git a/itcl/iwidgets3.0.0/doc/checkbox.n b/itcl/iwidgets3.0.0/doc/checkbox.n
new file mode 100755
index 00000000000..aa1b6a01d95
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/checkbox.n
@@ -0,0 +1,167 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) checkbox.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS checkbox iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+checkbox \- Create and manipulate a checkbox widget
+.SH SYNOPSIS
+\fBcheckbox\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- labeledframe <- checkbox
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBborderWidth\fR \fBcursor\fR \fBdisabledForeground\fR
+\fBforeground\fR \fBrelief\fR \fBselectColor\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR \fBlabelMargin\fR
+\fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR
+.fi
+.LP
+See the "labeledframe" class manual entry for details on the
+inherited options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-command\fR
+.fi
+.IP
+Specifies a Tcl command procedure to be evaluated following a change in
+the current check box selection.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBcheckbox\fR command creates a check button box widget
+capable of adding, inserting, deleting, selecting, and configuring
+checkbuttons as well as obtaining the currently selected button.
+
+.SH "METHODS"
+.PP
+The \fBcheckbox\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command.
+.PP
+Many of the widget commands for the \fBcheckbox\fR take as one argument an
+indicator of which checkbutton of the checkbox to operate on. These indicators
+are called \fIindexes\fR and allow reference and manipulation of checkbuttons.
+Checkbox indexes may be specified in any of the following forms:
+.TP 12
+\fInumber\fR
+Specifies the checkbutton numerically, where 0 corresponds to the top
+checkbutton of the checkbox.
+.TP 12
+\fBend\fR
+Indicates the last checkbutton of the checkbox.
+.TP 12
+\fIpattern\fR
+If the index doesn't satisfy one of the above forms then this
+form is used. \fIPattern\fR is pattern-matched against the tag of
+each checkbutton in the checkbox, in order from top to bottom,
+until a matching entry is found. The rules of \fBTcl_StringMatch\fR
+are used.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBadd\fR \fItag\fR ?\fIoption value option value\fR?
+Adds a new checkbutton to the checkbuttond window on the bottom. The command
+takes additional options which are passed on to the checkbutton as construction
+arguments. These include the standard Tk checkbutton options. The tag is
+returned.
+.TP
+\fIpathName \fBbuttonconfigure\fR \fIindex\fR ?\fIoptions\fR?
+This command is similar to the \fBconfigure\fR command, except that
+it applies to the options for an individual checkbutton,
+whereas \fBconfigure\fRapplies to the options for the checkbox as a whole.
+\fIOptions\fR may have any of the values accepted by the \fBadd\fR
+widget command. If \fIoptions\fR are specified, options are modified
+as indicated in the command and the command returns an empty string.
+If no \fIoptions\fR are specified, returns a list describing
+the current options for entry \fIindex\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list).
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBcheckbox\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBcheckbox\fR
+command.
+.TP
+\fIpathName \fBdelete\fR \fIindex\fR
+Deletes a specified checkbutton given an \fIindex\fR.
+.TP
+\fIpathName \fBdeselect\fR \fIindex\fR
+Deselects a specified checkbutton given an \fIindex\fR.
+.TP
+\fIpathName \fBflash\fR \fIindex\fR
+Flashes a specified checkbutton given an \fIindex\fR.
+.TP
+\fIpathName \fBget\fR ?\fIindex\fR?
+Returns the tags of the currently selected checkbuttons or the
+selection status of specific checkbutton when given an index.
+.TP
+\fIpathName \fBindex\fR \fIindex\fR
+Returns the numerical index corresponding to index.
+.TP
+\fIpathName \fBinsert \fIindex\fR \fItag\fR ?\fIoption value option value ...\fR?
+Same as the \fBadd\fR command except that it inserts the new
+checkbutton just before the one given by \fIindex\fR, instead of appending
+to the end of the checkbox. The \fIoption\fR, and \fIvalue\fR
+arguments have the same interpretation as for the \fBadd\fR widget
+command.
+.TP
+\fIpathName \fBselect\fR \fIindex\fR
+Selects a specified checkbutton given an \fIindex\fR.
+
+.SH EXAMPLE
+.DS
+ checkbox .cb -labeltext Styles
+ .cb add bold -text Bold
+ .cb add italic -text Italic
+ .cb add underline -text Underline
+ .cb select underline
+
+ pack .cb -padx 10 -pady 10 -fill both -expand yes
+.DE
+
+.SH AUTHOR
+John A. Tucker
+.SH KEYWORDS
+checkbox, widget
diff --git a/itcl/iwidgets3.0.0/doc/combobox.n b/itcl/iwidgets3.0.0/doc/combobox.n
new file mode 100644
index 00000000000..e7b81dd4b18
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/combobox.n
@@ -0,0 +1,379 @@
+'\"
+'\" Copyright (c) 1995 John S. Sigler
+'\" Copyright (c) 1997 Mitch Gorman
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) Combobox.n
+'/"
+.so man.macros
+.HS combobox iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+combobox \- Create and manipulate combination box widgets
+.SH SYNOPSIS
+\fBcombobox\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- LabeledWidget <- Entryfield <- Combobox
+.SH "STANDARD OPTIONS"
+.LP
+.ta 4c 8c 12c
+.nf
+
+\fB\fR
+\fB
+background borderWidth cursor justify
+exportSelection foreground highlightColor highlightThickness
+relief width insertWidth insertBackground
+insertOffTime insertOnTime insertWidth insertBorderWidth
+selectForeground selectBackground
+selectBorderWidth textVariable
+\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBhscrollmode\fR \fBtextBackground\fR \fBtextFont\fR \fBvscrollmode\fR
+.fi
+.LP
+See the "scrolledlistbox" manual entry for details on the above inherited
+options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBshow\fR
+.fi
+.LP
+See the "entry" manual entry for details on the above inherited option.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBchildSitePos\fR \fBcommand\fR \fBfixed\fR \fBfocusCommand\fR
+\fBinvalid\fR \fBtextBackground\fR \fBtextFont\fR \fBvalidate\fR
+.fi
+.LP
+See the "entryfield" class manual entry for details on the inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR \fBlabelMargin\fR
+\fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR
+.fi
+.LP
+See the "labeledwidget" class manual entry for details on the
+inherited options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBarrowRelief\fR
+Class: \fBRelief\fR
+Command-Line Switch: \fB-arrowrelief\fR
+.fi
+.IP
+Specifies the relief style to use for a dropdown Combobox's arrow
+button in a normal (not depressed) state. Acceptable values
+are \fBraised\fR, \fBsunken\fR, \fBflat\fR, \fBridge\fR, and \fBgroove\fR.
+Sunken is discouraged as this is the relief used to indicate a depressed
+state. This option has no effect on simple Comboboxes. The default is raised.
+.LP
+.nf
+Name: \fBcompletion\fR
+Class: \fBCompletion\fR
+Command-Line Switch: \fB-completion\fR
+.fi
+.IP
+Boolean given in any of the forms acceptable to \fBTcl_GetBoolean\fR which
+determines whether insertions into the entry field, whether from the
+keyboard or programmatically via the \fBinsert\fR method, are
+automatically completed with the first matching item from the listbox. The
+default is true.
+.LP
+.nf
+Name: \fBdropdown\fR
+Class: \fBDropdown\fR
+Command-Line Switch: \fB-dropdown\fR
+.fi
+.IP
+Boolean describing the Combobox layout style given in any of the forms
+acceptable to \fBTcl_GetBoolean\fR. If true, the Combobox
+will be a dropdown style
+widget which displays an entry field and an arrow button which when activated
+will pop up a scrollable list of items. If false, a simple Combobox style
+will be used which has an entry field and a scrollable list beneath it
+which is always visible. Both styles allow an optional label for the entry
+field area. The default is true.
+.LP
+.nf
+Name: \fBeditable\fR
+Class: \fBEditable\fR
+Command-Line Switch: \fB-editable\fR
+.fi
+.IP
+Boolean describing whether or not the text entry area is editable
+by the user. If true the user can add items to the combobox by entering text
+into the entry area and then pressing Return. If false, the list of items is
+non-editable and can only be changed by calling the insert or delete
+methods. (The value in the entry field can still be modified by selecting
+from the list.) Given in any of the forms acceptable to \fBTcl_GetBoolean\fR.
+The default is true.
+.LP
+.nf
+Name: \fBgrab\fR
+Class: \fBGrab\fR
+Command-Line Switch: \fB-grab\fR
+.fi
+.IP
+This option sets the grab scope for the appearance of the listbox in
+drop-down comboboxes. It can be either global or local. The default is
+local.
+.LP
+.nf
+Name: \fBlistHeight\fR
+Class: \fBHeight\fR
+Command-Line Switch: \fB-listheight\fR
+.fi
+.IP
+Height of the listbox specified in any of the forms acceptable to
+\fBTk_GetPixels\fR. The default is 150 pixels.
+.LP
+.nf
+Name: \fBmargin\fR
+Class: \fBMargin\fR
+Command-Line Switch: \fB-margin\fR
+.fi
+.IP
+Specifies the width in pixels between the entry component and the arrow button
+for a dropdown Combobox given in any of the forms acceptable to
+\fBTk_GetPixels\fR. This option has no effect on a simple Combobox. The
+default is 1.
+.LP
+.nf
+Name: \fBpopupCursor\fR
+Class: \fBCursor\fR
+Command-Line Switch: \fB-popupcursor\fR
+.fi
+.IP
+Specifies the cursor to be used for dropdown style listboxes. The value
+may have any of the forms acceptable to \fBTk_GetCursor\fR. The default is
+arrow.
+.LP
+.nf
+Name: \fBselectionCommand\fR
+Class: \fBSelectionCommand\fR
+Command-Line Switch: \fB-selectioncommand\fR
+.fi
+.IP
+Specifies a Tcl command procedure which is called when an item in the
+listbox area is selected. The item will be selected in the list, the listbox
+will be removed if it is a dropdown Combobox, and the selected item's
+text will be inserted into the entry field before the -selectioncommand proc is
+called. The default is {}.
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Command-Line Switch: \fB-state\fR
+.fi
+.IP
+Specifies the overall state of the Combobox megawidget. Can be either
+normal or disabled. If the Combobox is disabled, no text can be entered
+into the entry field, no selection can be made in the listbox, and the
+arrowBtn component is disabled. The default is normal.
+.LP
+.nf
+Name: \fBunique\fR
+Class: \fBUnique\fR
+Command-Line Switch: \fB-unique\fR
+.fi
+.IP
+Boolean describing whether or not duplicate items are allowed in the combobox
+list. If true, then duplicates are not allowed to be inserted. If false, a
+duplicate entry causes selection of the item. Given in any of the forms
+acceptable to \fBTcl_GetBoolean\fR. The default is true.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBcombobox\fR command creates an enhanced entry field widget with an
+optional associated label and a scrollable list. When an item is selected in
+the list area of a Combobox, its value is then displayed in the entry field
+text area. Functionally similar to an Optionmenu, the Combobox adds (optional)
+list scrolling and (optional) item editing and inserting capabilities.
+.PP
+There are two basic styles of Comboboxes (determined by the -dropdown option):
+dropdown and simple. The dropdown style adds an arrow button to the right of
+the entry field which when activated will pop up (and down) the scrolled
+listbox beneath the entry field. The simple (non-dropdown) Combobox
+permanently displays the listbox beneath the entry field and has no
+arrow button. Either style allows an optional entry field label.
+.SH "METHODS"
+.PP
+The \fBcombobox\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for Combobox widgets:
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBicursor\fR \fBscan\fR
+.fi
+.LP
+See the "entry" manual entries for details on the above associated methods.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBcurselection\fR \fBindex\fR \fBsee\fR \fBsize\fR
+\fBxview\fR \fByview\fR
+.fi
+.LP
+See the "listbox" manual entries for details on the above associated methods.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBgetcurselection\fR \fBjustify\fR \fBsort\fR
+.fi
+.LP
+See the "scrolledlistbox" manual entries for details on the above associated
+methods.
+.LP
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBcombobox\fR
+command.
+.TP
+\fIpathName \fBclear\fR ?\fBcomponent\fR?
+Clears the contents from one or both components. Valid component values
+are \fBlist\fR, or \fBentry\fR. With no component specified, both are cleared.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBcombobox\fR
+command.
+.TP
+\fIpathName \fBdelete \fIcomponent\fR \fIfirst\fR ?\fIlast\fR?
+Delete one or more elements from a given component, \fBlist\fR or \fBentry\fR.
+If a list item to be removed is currently selected (displayed in the entry
+field area), the entry field will be cleared.
+.TP
+\fIpathName \fBget ?\fIindex\fR? \fR
+With no arguments, returns the contents currently in the entry
+field area. With a single argument, returns the contents of the
+listbox item at the indicated index.
+.TP
+\fIpathName \fBinsert\fR \fIcomponent\fR \fIindex\fR \fIelement\fR ?\fIelement element ...\fR?
+Insert one or more new elements into the given component, \fBlist\fR or
+\fBentry\fR, just before the element given by \fIindex\fR.
+.TP
+\fIpathName \fBselection\fR \fIoption\fR \fIfirst\fR ?\fIlast\fR?
+Adjust the selection within the listbox component and updates the contents
+of the entry field component to the value of the selected item. See the
+"listbox" manual entry for more details on parameter options.
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBentry\fR
+Class: \fBEntry\fR
+.fi
+.IP
+Text entry area where the current selection is displayed. If the
+Combobox is editable and its state is normal, the user can edit the
+contents of this item.
+.LP
+.nf
+Name: \fBlist\fR
+Class: \fBScrolledlistbox\fR
+.fi
+.IP
+Scrollable list which stores all the items which the user can select
+from. For dropdown Comboboxes, this component is hidden until the user pops it
+up by pressing on the arrow button to the right of the entry component. For
+simple Comboboxes this component is always visible just beneath the entry
+component.
+.SH "DEFAULT BINDINGS"
+.PP
+The Combobox generally has the same bindings as its primary component items -
+the Scrolledlistbox and Entryfield. However it also adds these:
+.PP
+[1] Button-1 mouse press on the arrow key of a dropdown Combobox causes the
+list to be popped up. If the combobox is non-editable, a Button-1 press on the
+entry field area will also pop up the list.
+.PP
+[2] Button-1 mouse press anywhere on the display removes a dropdown listbox
+which has been popped up, unless the keypress is upon one of the Combobox
+scrollbars which scrolls the list. If it is pressed upon an item in the list
+area, that item will be selected before the list is removed.
+.PP
+[3] Button-3 mouse press on the arrow key of a dropdown Combobox causes the
+next item to be selected. Shift-Button-3 causes the previous item to be
+selected.
+.PP
+[4] Escape keypress removes a dropdown list which has been popped up.
+.PP
+[5] The <space> and <Return> keystrokes select the current item. They also
+remove the popped up list for dropdown comboboxes.
+.PP
+[6] Up and Down arrow keypresses from the entry field and arrow button
+component cause the previous and next items in the listbox to be selected
+respectively. Ctl-P and Ctl-N are similarly mapped for emacs emulation.
+.PP
+[7] Entry field and arrow button component Shift-Up and Shift-Down arrow keys
+pop up and down the listbox of a dropdown Combobox. The arrow button component
+also maps <Return> and <space> similarly.
+
+.SH EXAMPLE
+.DS
+ proc selectCmd {} {
+ puts stdout "[.cb2 getcurselection]"
+ }
+
+ #
+ # Non-editable Dropdown Combobox
+ #
+ combobox .cb1 -labeltext Month: \\
+ -selectioncommand {puts "selected: [.cb1 getcurselection]"} \\
+ -editable false -listheight 185 -popupcursor hand1
+ .cb1 insert list end Jan Feb Mar Apr May June Jul Aug Sept Oct Nov Dec
+
+ #
+ # Editable Dropdown Combobox
+ #
+ combobox .cb2 -labeltext "Operating System:" -selectioncommand selectCmd
+ .cb2 insert list end Linux HP-UX SunOS Solaris Irix
+ .cb2 insert entry end L
+
+ pack .cb1 -padx 10 -pady 10 -fill x
+ pack .cb2 -padx 10 -pady 10 -fill x
+
+.DE
+.SH ORIGINAL AUTHOR
+John S. Sigler
+.SH CURRENT MAINTAINER
+Mitch Gorman (logain@erols.com)
+.SH KEYWORDS
+combobox, entryfield, scrolledlistbox, itk::Widget, entry, listbox, widget,
+iwidgets
diff --git a/itcl/iwidgets3.0.0/doc/dateentry.n b/itcl/iwidgets3.0.0/doc/dateentry.n
new file mode 100644
index 00000000000..36353fed0da
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/dateentry.n
@@ -0,0 +1,175 @@
+'\"
+'\" Copyright (c) 1997 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) dateentry.n 1.0 97/04/30 16:04:44
+'/"
+.so man.macros
+.HS dateentry iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+dateentry \- Create and manipulate a dateentry widget
+.SH SYNOPSIS
+\fBdateentry\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- LabeledWidget <- Datefield <- Dateentry
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBborderWidth\fR \fBcursor\fR \fBexportSelection\fR
+\fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR \fBinsertBackground\fR
+\fBjustify\fR \fBrelief\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBdisabledForeground\fR \fBlabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR
+\fBlabelMargin\fR \fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR
+\fBstate\fR
+.fi
+.LP
+See the "labeledwidget" class manual entry for details on these
+inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBcommand\fR \fBiq\fR \fBstate\fR \fBtextBackground\fR
+\fBtextFont\fR
+.fi
+.LP
+See the "datefield" class manual entry for details on these
+inherited options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackwardImage\fR \fBbuttonForeground\fR \fBcommand\fR \fBcurrentDateFont\fR
+\fBdateFont\fR \fBdayFont\fR \fBdays\fR \fBforwardImage\fR
+\fBoutline\fR \fBselectColor\fR \fBselectThickness\fR \fBstartDay\fR
+\fBtitleFont\fR \fBweekdayBackground\fR \fBweekendBackground\fR
+.fi
+.LP
+See the "calendar" manual entry for details on the associated options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBgrab\fR
+Class: \fBGrab\fR
+Command-Line Switch: \fB-grab\fR
+.fi
+.IP
+Specifies the grab level, \fBlocal\fR or \fBglobal\fR, to be obtained before
+bringing up the popup calendar. The default is global. For more information
+concerning grab levels, consult the documentation for Tk's \fBgrab\fR command.
+.LP
+.nf
+Name: \fBicon\fR
+Class: \fBIcon\fR
+Command-Line Switch: \fB-icon\fR
+.fi
+.IP
+Specifies the calendar icon image to be used in the dateentry.
+This image must have been created previously with
+the \fBimage create\fR command. Should one not be provided,
+then one will be generated, pixmap if possible, bitmap otherwise.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBdateentry\fR command creates a quicken style date entry field
+with a popup calendar by combining the datefield and calendar
+widgets together. This allows a user to enter the date via the
+keyboard or by using the mouse and selecting the calendar icon
+which brings up a popup calendar.
+.DE
+
+.SH "METHODS"
+.PP
+The \fBdateentry\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for dateentry widgets:
+.SH "INHERITED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBget\fR \fBisvalid\fR \fBshow\fR
+.fi
+.LP
+See the "datefield" manual entry for details on the associated methods.
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBdateentry\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBdateentry\fR
+command.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBlabel\fR
+Class: \fBLabel\fR
+.fi
+.IP
+The label component provides a label component to used to identify the date.
+See the "label" widget manual entry for details on the label component item.
+.LP
+.nf
+Name: \fBiconbutton\fR
+Class: \fBLabel\fR
+.fi
+.IP
+The iconbutton component provides a labelbutton component to act as a
+lightweight button
+displaying the calendar icon. Upon pressing the labelbutton, the calendar
+appears. See the "label" widget manual entry for details on the
+labelbutton component item.
+.LP
+.nf
+Name: \fBdate\fR
+Class: \fBEntry\fR
+.fi
+.IP
+The date component provides the entry field for date input and display.
+See the "entry" widget manual entry for details on the date component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ dateentry .de
+ pack .de
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.LP
+.SH KEYWORDS
+dateentry, widget
diff --git a/itcl/iwidgets3.0.0/doc/datefield.n b/itcl/iwidgets3.0.0/doc/datefield.n
new file mode 100644
index 00000000000..b17ce3bea3d
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/datefield.n
@@ -0,0 +1,192 @@
+'\"
+'\" Copyright (c) 1997 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) datefield.n 1.0 97/04/30 16:04:44
+'/"
+.so man.macros
+.HS datefield iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+datefield \- Create and manipulate a date field widget
+.SH SYNOPSIS
+\fBdatefield\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- LabeledWidget <- datefield
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBborderWidth\fR \fBcursor\fR \fBexportSelection\fR
+\fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR \fBinsertBackground\fR
+\fBjustify\fR \fBrelief\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBdisabledForeground\fR \fBlabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR
+\fBlabelMargin\fR \fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR
+\fBstate\fR
+.fi
+.LP
+See the "labeledwidget" class manual entry for details on the
+inherited options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBchildSitePos\fR
+Class: \fBPosition\fR
+Command-Line Switch: \fB-childsitepos\fR
+.fi
+.IP
+Specifies the position of the child site in the date field: \fBn\fR,
+\fBs\fR, \fBe\fR, or \fBw\fR. The default is e.
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-command\fR
+.fi
+.IP
+Specifies a Tcl command to be executed upon detection of a Return key
+press event.
+.LP
+.nf
+Name: \fBiq\fR
+Class: \fBIq\fR
+Command-Line Switch: \fB-iq\fR
+.fi
+.IP
+Specifies the level of intelligence to be shown in the actions
+taken by the datefield during the processing of keypress events.
+Valid settings include \fBhigh\fR, \fBaverage\fR, and \fBlow\fR.
+With a high iq,the date prevents the user from typing in an
+invalid date. For example, if the current date is 05/31/1997 and
+the user changes the month to 04, then the day will be instantly
+modified for them to be 30. In addition, leap years are fully
+taken into account. With average iq, the month is limited to the
+values of 01-12, but it is possible to type in an invalid day.
+A setting of low iq instructs the widget to do no validity
+checking at all during date entry. With both average and low
+iq levels, it is assumed that the validity will be determined
+at a later time using the date's \fBisvalid\fR command.
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Command-Line Switch: \fB-state\fR
+.fi
+.IP
+Specifies one of two states for the datefield: \fBnormal\fR or \fBdisabled\fR.
+If the datefield is disabled then input is not accepted. The default is
+normal.
+.LP
+.nf
+Name: \fBtextBackground\fR
+Class: \fBBackground\fR
+Command-Line Switch: \fB-textbackground\fR
+.fi
+.IP
+Background color for inside textual portion of the entry field. The value
+may be given in any of the forms acceptable to \fBTk_GetColor\fR.
+.LP
+.nf
+Name: \fBtextFont\fR
+Class: \fBFont\fR
+Command-Line Switch: \fB-textfont\fR
+.fi
+.IP
+Name of font to use for display of text in datefield. The value
+may be given in any of the forms acceptable to \fBTk_GetFont\fR.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBdatefield\fR command creates an enhanced text entry widget for
+the purpose of date entry with various degrees of built-in intelligence.
+.DE
+
+.SH "METHODS"
+.PP
+The \fBdatefield\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for datefield widgets:
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBdatefield\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBdatefield\fR
+command.
+.TP
+\fIpathName \fBget\fR ?\fBformat\fR?
+Returns the current contents of the datefield in a format of
+string or as an integer clock value using the \fB-string\fR and \fB-clicks\fR
+format options respectively. The default is by string. Reference the
+clock command for more information on obtaining dates and their
+formats.
+.TP
+\fIpathName \fBisvalid\fR
+Returns a boolean indication of the validity of the currently
+displayed date value. For example, 03/03/1960 is valid whereas
+02/29/1997 is invalid.
+.TP
+\fIpathName \fBshow\fR \fIdate\fR
+Changes the currently displayed date to be that of the date
+argument. The date may be specified either as a string, an
+integer clock value or the keyword "now". Reference the clock
+command for more information on obtaining dates and their formats.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBdate\fR
+Class: \fBEntry\fR
+.fi
+.IP
+The date component provides the entry field for date input and display.
+See the "entry" widget manual entry for details on the date component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ proc returnCmd {} {
+ puts [.df get]
+ }
+
+ datefield .df -command returnCmd
+ pack .df -fill x -expand yes -padx 10 -pady 10
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.LP
+.SH KEYWORDS
+datefield, widget
diff --git a/itcl/iwidgets3.0.0/doc/dialog.n b/itcl/iwidgets3.0.0/doc/dialog.n
new file mode 100644
index 00000000000..9bafef4765d
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/dialog.n
@@ -0,0 +1,139 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) dialog.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS dialog iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+dialog \- Create and manipulate a dialog widget
+.SH SYNOPSIS
+\fBdialog\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Toplevel <- Shell <- Dialogshell <- Dialog
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBcursor\fR \fBforeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbuttonBoxPadX\fR \fBbuttonBoxPadY\fR \fBbuttonBoxPos\fR \fBpadX\fR
+\fBpadY\fR \fBseparator\fR \fBthickness\fR
+.fi
+.LP
+See the "dialogshell" manual entry for details on the above inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBheight\fR \fBmaster\fR \fBmodality\fR \fBwidth\fR
+.fi
+.LP
+See the "shell" manual entry for details on the above inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtitle\fR
+.fi
+.LP
+See the "Toplevel" manual entry for details on the above inherited options.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBdialog\fR command creates a dialog box providing standard
+buttons and a child site for use in derived classes. The buttons
+include ok, apply, cancel, and help. Methods and Options exist to
+configure the buttons and their containing box.
+
+.SH "METHODS"
+.PP
+The \fBdialog\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for dialog widgets:
+.SH "INHERITED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBadd\fR \fBbuttonconfigure\fR \fBdefault\fR \fBhide\fR
+\fBindex\fR \fBinsert\fR \fBinvoke\fR \fBshow\fR
+.fi
+.LP
+See the "buttonbox" manual entry for details on the above inherited methods.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBchildsite\fR
+.fi
+.LP
+See the "dialogshell" manual entry for details on the above inherited methods.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactivate\fR \fBcenter\fR \fBdeactivate\fR
+.fi
+.LP
+See the "shell" manual entry for details on the above inherited methods.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBdialog\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBdialog\fR
+command.
+
+.SH EXAMPLE
+.DS
+ dialog .d -modality global
+ .d buttonconfigure OK -command {puts OK; .d deactivate 1}
+ .d buttonconfigure Apply -command {puts Apply}
+ .d buttonconfigure Cancel -command {puts Cancel; .d deactivate 0}
+ .d buttonconfigure Help -command {puts Help}
+
+ listbox [.d childsite].lb -relief sunken
+ pack [.d childsite].lb -expand yes -fill both
+
+ if {[.d activate]} {
+ puts "Exit via OK button"
+ } else {
+ puts "Exit via Cancel button"
+ }
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.DE
+Bret A. Schuhmacher
+.SH KEYWORDS
+dialog, dialogshell, shell, widget
diff --git a/itcl/iwidgets3.0.0/doc/dialogshell.n b/itcl/iwidgets3.0.0/doc/dialogshell.n
new file mode 100644
index 00000000000..673441507ae
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/dialogshell.n
@@ -0,0 +1,216 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) dialogshell.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS dialogshell iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+dialogshell \- Create and manipulate a dialog shell widget
+.SH SYNOPSIS
+\fBdialogshell\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Toplevel <- Shell <- Dialogshell
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBcursor\fR \fBforeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBheight\fR \fBmaster\fR \fBmodality\fR \fBwidth\fR
+.fi
+.LP
+See the "shell" manual entry for details on the above inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtitle\fR
+.fi
+.LP
+See the "Toplevel" manual entry for details on the above inherited options.
+
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBbuttonBoxPadX\fR
+Class: \fBPad\fR
+Command-Line Switch: \fB-buttonboxpadx\fR
+.fi
+.IP
+Specifies a non-negative padding distance to leave between the button group and
+the outer edge of the button box in the x direction. The value may be
+given in any of the forms accpetable to \fBTk_GetPixels\fR. The default
+is 5 pixels.
+.LP
+.nf
+Name: \fBbuttonBoxPadY\fR
+Class: \fBPad\fR
+Command-Line Switch: \fB-buttonboxpady\fR
+.fi
+.IP
+Specifies a non-negative padding distance to leave between the button group and
+the outer edge of the button box in the y direction. The value may be
+given in any of the forms accpetable to \fBTk_GetPixels\fR. The default
+is 5 pixels.
+.LP
+.nf
+Name: \fBbuttonBoxPos\fR
+Class: \fBPosition\fR
+Command-Line Switch: \fB-buttonboxpos\fR
+.fi
+.IP
+Attaches buttons to the given side of the dialog: \fBn\fR, \fBs\fR,
+\fBe\fR or \fBw\fR. The default is s.
+.LP
+.nf
+Name: \fBpadX\fR
+Class: \fBPad\fR
+Command-Line Switch: \fB-padx\fR
+.fi
+.IP
+Specifies a padding distance for the childsite in the X-direction in
+any of the forms acceptable to \fBTk_GetPixels\fR. The default is 10.
+.LP
+.nf
+Name: \fBpadY\fR
+Class: \fBPad\fR
+Command-Line Switch: \fB-pady\fR
+.fi
+.IP
+Specifies a padding distance for the childsite in the Y-direction in
+any of the forms acceptable to \fBTk_GetPixels\fR. The default is 10.
+.LP
+.nf
+Name: \fBseparator\fR
+Class: \fBSeparator\fR
+Command-Line Switch: \fB-separator\fR
+.fi
+.IP
+Specifies whether a line is drawn to separate the
+buttons from the dialog box contents in any of the forms
+acceptable to \fBTcl_GetBoolean\fR. The default is true.
+.LP
+.nf
+Name: \fBthickness\fR
+Class: \fBThickness\fR
+Command-Line Switch: \fB-thickness\fR
+.fi
+.IP
+Specifies the thickness of the separator in any of the forms acceptable
+to \fBTk_GetPixels\fR. The default is 3 pixels.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBdialogshell\fR command creates a dialog shell which is a top
+level widget composed of a button box, separator, and child site area.
+The class also has methods to control button construction.
+
+.SH "METHODS"
+.PP
+The \fBdialogshell\fR command create a new Tcl command whose
+name is \fIpathName\fR. This command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for dialogshell widgets:
+.SH "INHERITED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactivate\fR \fBcenter\fR \fBdeactivate\fR
+.fi
+.LP
+See the "shell" manual entry for details on the above inherited methods.
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBadd\fR \fBbuttonconfigure\fR \fBdefault\fR \fBdelete\fR
+\fBhide\fR \fBindex\fR \fBinsert\fR \fBinvoke\fR
+\fBshow\fR
+.fi
+.LP
+See the "buttonbox" manual entry for details on the associated methods.
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBdialogshell\fR
+command.
+.TP
+\fIpathName \fBchildsite\fR
+Returns the pathname of the child site widget.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBdialogshell\fR
+command.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBdschildsite\fR
+Class: \fBframe\fR
+.fi
+.IP
+The dschildsite component is the user child site for the dialog shell. See
+the "frame" widget manual entry for details on the dschildsite component item.
+.LP
+.nf
+Name: \fBseparator\fR
+Class: \fBframe\fR
+.fi
+.IP
+The separator component devides the area between the user child site and
+the button box. See the "frame" widget manual entry for details on the
+separator component item.
+.LP
+.nf
+Name: \fBbbox\fR
+Class: \fBButtonBox\fR
+.fi
+.IP
+The bbox component is the button box containing the buttons for the dialog
+shell. See the "ButtonBox" widget manual entry for details on the
+bbox component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ dialogshell .ds -modality none
+
+ .ds add OK -text "OK"
+ .ds add Cancel -text "Cancel"
+ .ds default OK
+
+ .ds activate
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.SH KEYWORDS
+dialogshell, dialog, shell, widget
diff --git a/itcl/iwidgets3.0.0/doc/disjointlistbox.n b/itcl/iwidgets3.0.0/doc/disjointlistbox.n
new file mode 100755
index 00000000000..be5c790afc9
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/disjointlistbox.n
@@ -0,0 +1,264 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) disjointlistbox.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS disjointlistbox iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+disjointlistbox \- Create and manipulate a disjointlistbox widget
+.SH SYNOPSIS
+\fBdisjointlistbox\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- Disjointlistbox
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBselectBorderWidth\fR \fBselectForeground\fR
+\fBactiveForeground\fR \fBactiveRelief\fR \fBbackground\fR
+\fBborderWidth\fR \fBbuttonPlacement\fR \fBclientData\fR
+\fBcursor\fR \fBforeground\fR \fBhighlightColor\fR
+\fBhighlightThickness\fR \fBdisabledForeground\fR \fBelementBorderWidth\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlhsButtonLabel\fR \fBrhsButtonLabel\fR
+.fi
+.LP
+See the "button" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelFont\fR \fBlhsLabelText\fR \fBrhsLabelText\fR
+.fi
+.LP
+See the "label" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBjump\fR \fBtroughColor\fR
+.fi
+.LP
+See the "scrollbar" widget class manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtextBackground\fR \fBtextFont\fR
+\fBlhsItems\fR \fBrhsItems\fR
+.fi
+.LP
+See the "scrolledlistbox" widget manual entry for details on the above
+associated options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBbuttonPlacement\fR
+Class: \fBButtonPlacement\fR
+Command-Line Switch: \fB-buttonplacement\fR
+.fi
+.IP
+Specifies the placement of the insertion and removal buttons relative to the
+scrolledlistbox widgets\fBn\fR,
+\fBbottom\fR, or \fBcenter\fR. The default is bottom.
+.LP
+.nf
+Name: \fBlhsLabelText\fR
+Class: \fBLabelText\fR
+Command-Line Switch: \fB-lhslabeltext\fR
+.fi
+.IP
+Specifies the text for the label of the lhs scrolledlistbox.
+The default is "Available".
+.LP
+.nf
+Name: \fBrhsLabelText\fR
+Class: \fBLabelText\fR
+Command-Line Switch: \fB-rhslabeltext\fR
+.fi
+.IP
+Specifies the text for the label of the rhs scrolledlistbox.
+The default is "Available".
+.LP
+.nf
+Name: \fBlhsButtonLabel\fR
+Class: \fBLabelText\fR
+Command-Line Switch: \fB-lhsbuttonlabel\fR
+.fi
+.IP
+Specifies the text for the button of the lhs scrolledlistbox.
+The default is "Insert >>".
+.LP
+.nf
+Name: \fBrhsButtonLabel\fR
+Class: \fBLabelText\fR
+Command-Line Switch: \fB-rhsbuttonlabel\fR
+.fi
+.IP
+Specifies the text for the button of the rhs scrolledlistbox.
+The default is "<< Remove".
+.LP
+.BE
+.SH DESCRIPTION
+.PP
+The \fBdisjointlistbox\fR command creates a disjoint pair of listboxs
+similar to the OSF/Motif "Book" printing dialog of the "FrameMaker"
+program. It is implementation constists of a two Scrolledlistboxs,
+2 buttons, and 2 labels.
+
+The disjoint behavior of this widget exists between the interaction of
+the two Scrolledlistboxes with one another. That is, a given instance
+of a Disjointlistbox will never exist, without the aid of a hack magician,
+which has Scrolledlistbox widgets with items in common. That means the
+relationship between the two is maintained similar to that of disjoint sets.
+
+Users may transfer items between the two Listbox widgets using the
+the two buttons.
+
+Options exists which include the ability to configure the "items" displayed by
+the 2 Scrolledlistboxes and to control the placement of the insertion and
+removal buttons.
+.SH "METHODS"
+.PP
+The \fBdisjointlistbox\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for disjointlistbox widgets:
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBdisjointlistbox\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBdisjointlistbox\fR
+command.
+.TP
+\fIpathName \fBsetlhs\fR
+Set the current contents of the left-most Scrolledlistbox with the input list
+of items. Removes all (if any) items from the right-most Scrolledlistbox
+which exist in the input list option to maintain the disjoint property
+between the two
+.TP
+\fIpathName \fBsetrhs\fR
+Set the current contents of the right-most Scrolledlistbox with the input list
+of items. Removes all (if any) items from the left-most Scrolledlistbox
+which exist in the input list option to maintain the disjoint property
+between the two
+.TP
+\fIpathName \fBgetlhs\fR
+Returns the current contents of the left-most Scrolledlistbox
+.TP
+\fIpathName \fBgetrhs\fR
+Returns the current contents of the right-most Scrolledlistbox
+.TP
+\fIpathName \fBinsertlhs\fR
+Add the input list of items to the current contents of the left-most
+Scrolledlistbox. Removes all (if any) items from the right-most Scrolledlistbox
+which exist in the input list option to maintain the disjoint property
+between the two
+.TP
+\fIpathName \fBinsertrhs\fR
+Add the input list of items to the current contents of the right-most
+Scrolledlistbox. Removes all (if any) items from the left-most Scrolledlistbox
+which exist in the input list option to maintain the disjoint property
+between the two.
+.TP
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBlhs\fR
+Class: \fBScrolledlistbox\fR
+.fi
+.IP
+The lhs component is the scrolledlistbox for the rhs button.
+See the "scrolledlistbox" widget manual entry for details on the lhs
+component item.
+.LP
+.nf
+Name: \fBrhs\fR
+Class: \fBScrolledlistbox\fR
+.fi
+.IP
+The rhs component is the scrolledlistbox for the rhs button.
+See the "scrolledlistbox" widget manual entry for details on the rhs
+component item.
+.LP
+.nf
+Name: \fBlhsbutton\fR
+Class: \fButton\fR
+.fi
+.IP
+The lhsbutton component is the button for users to remove selected items
+from the lhs Scrolledlistbox.
+See the "button" widget manual entry for details on the lhs button component.
+.LP
+.nf
+Name: \fBrhsbutton\fR
+Class: \fBButton\fR
+.fi
+.IP
+The rhsbutton component is the button for users to remove selected items
+from the rhs Scrolledlistbox.
+See the "button" widget manual entry for details on the rhs button component.
+.LP
+.nf
+Name: \fBlhsCount\fR
+Class: \fBLabel\fR
+.fi
+.IP
+The lhsCount component is the label for displaying a count of the current items in
+the Scrolledlistbox.
+See the "Label" widget manual entry for details on the lhsCount label component.
+.LP
+.nf
+Name: \fBrhsCount\fR
+Class: \fBLabel\fR
+.fi
+.IP
+The rhsCount component is the label for displaying a count of the current items in
+the Scrolledlistbox.
+See the "Label" widget manual entry for details on the rhsCount label component.
+.fi
+.IP
+.SH EXAMPLE
+.DS
+disjointlistbox .dlb
+pack .dlb -padx 10 -pady 10 -fill both -expand yes
+.DE
+.SH AUTHOR(S)
+John A. Tucker
+.DE
+Anthony Parent
+.SH KEYWORDS
+disjointlistbox, widget
diff --git a/itcl/iwidgets3.0.0/doc/entryfield.n b/itcl/iwidgets3.0.0/doc/entryfield.n
new file mode 100644
index 00000000000..6ced2148c0d
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/entryfield.n
@@ -0,0 +1,270 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) entryfield.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS entryfield iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+entryfield \- Create and manipulate a entry field widget
+.SH SYNOPSIS
+\fBentryfield\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- LabeledWidget <- entryfield
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBborderWidth\fR \fBcursor\fR \fBexportSelection\fR
+\fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR \fBinsertBackground\fR
+\fBinsertBorderWidth\fR \fBinsertOffTime\fR \fBinsertOnTime\fR \fBinsertWidth\fR
+\fBjustify\fR \fBrelief\fR \fBselectBackground\fR \fBselectBorderWidth\fR
+\fBselectForeground\fR \fBtextVariable\fR \fBwidth\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBshow\fR \fBstate\fR
+.fi
+.LP
+See the "entry" manual entry for details on the associated options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBdisabledForeground\fR \fBlabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR
+\fBlabelMargin\fR \fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR
+\fBstate\fR
+.fi
+.LP
+See the "labeledwidget" class manual entry for details on the
+inherited options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBchildSitePos\fR
+Class: \fBPosition\fR
+Command-Line Switch: \fB-childsitepos\fR
+.fi
+.IP
+Specifies the position of the child site in the entry field: \fBn\fR,
+\fBs\fR, \fBe\fR, or \fBw\fR. The default is e.
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-command\fR
+.fi
+.IP
+Specifies a Tcl command to be executed upon detection of a Return key
+press event.
+.LP
+.nf
+Name: \fBfixed\fR
+Class: \fBFixed\fR
+Command-Line Switch: \fB-fixed\fR
+.fi
+.IP
+Restrict entry to the specified number of chars. A value of 0, which is the
+default, denotes no limit. The value is the maximum number of chars the
+user may type into the field, regardles of field width. For example,
+if the field width is set to 20 and the fixed value is 10, the user will
+only be able to type 10 characters into the field which is 20 characters long.
+.LP
+.nf
+Name: \fBfocusCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-focuscommand\fR
+.fi
+.IP
+Specifies a Tcl command to be executed upon reception of focus.
+.LP
+.nf
+Name: \fBinvalid\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-invalid\fR
+.fi
+.IP
+Specifies a Tcl command to be executed upon determination of invalid input.
+The default is bell.
+.LP
+.nf
+Name: \fBtextBackground\fR
+Class: \fBBackground\fR
+Command-Line Switch: \fB-textbackground\fR
+.fi
+.IP
+Background color for inside textual portion of the entry field. The value
+may be given in any of the forms acceptable to \fBTk_GetColor\fR.
+.LP
+.nf
+Name: \fBtextFont\fR
+Class: \fBFont\fR
+Command-Line Switch: \fB-textfont\fR
+.fi
+.IP
+Name of font to use for display of text in entryfield. The value
+may be given in any of the forms acceptable to \fBTk_GetFont\fR.
+.LP
+.nf
+Name: \fBvalidate\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-validate\fR
+.fi
+.IP
+The validate option allows specification of a validation mechanism. Standard
+character validation such as \fBnumeric\fR, \fBalphabetic\fR, \fBinteger\fR,
+\fBhexidecimal\fR, \fBreal\fR, and \fBalphanumeric\fR can be handled through
+the use of keywords. Should more
+extensive validation be necessary, the value may contain the name of
+a command script. The script should return a boolean value. True for
+valid, false for invalid. If false is returned, then the procedure
+associated with the invalid option will be invoked.
+If the validation script contains
+any \fB%\fR characters, then the script will not be
+executed directly. Instead, a new script will be
+generated by replacing each \fB%\fR, and the character following
+it, with information from the entryfield. The replacement
+depends on the character following the \fB%\fR, as defined in the
+list below.
+.TP
+\fB%c\fR
+Replaced with the current input character.
+.TP
+\fB%P\fR
+Replaced with the contents of the entryfield modified to include the latest
+keystoke. This is equivalent to peeking at the future contents, enabling
+rejection prior to the update.
+.TP
+\fB%S\fR
+Replaced with the current contents of the entryfield prior to the latest
+keystroke being added.
+.TP
+\fB%W\fR
+Replaced with the entryfield widget pathname.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBentryfield\fR command creates an enhanced text entry widget with an
+optional associated label. Addtional options support validation and
+establishing a upper limit on the number of characters which may be
+entered in the field.
+.DE
+
+.SH "METHODS"
+.PP
+The \fBentryfield\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for entryfield widgets:
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBdelete\fR \fBget\fR \fBicursor\fR \fBindex\fR
+\fBinsert\fR \fBscan\fR \fBselection\fR \fBxview\fR
+.fi
+.LP
+See the "entry" manual entry for details on the associated methods.
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBentryfield\fR
+command.
+.TP
+\fIpathName \fBchildsite\fR
+Returns the path name of the child site.
+.TP
+\fIpathName \fBclear\fR
+Clear entry widget
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBentryfield\fR
+command.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBefchildsite\fR
+Class: \fBframe\fR
+.fi
+.IP
+The efchildsite component is the user child site for the entry field. See
+the "frame" widget manual entry for details on the efchildsite component item.
+.LP
+.nf
+Name: \fBentry\fR
+Class: \fBentry\fR
+.fi
+.IP
+The entry component provides the entry field for user text input and display.
+See the "entry" widget manual entry for details on the entry component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ option add *textBackground white
+
+ proc returnCmd {} {
+ puts stdout "Return Pressed"
+ }
+
+ proc invalidCmd {} {
+ puts stdout "Alphabetic contents invalid"
+ }
+
+ entryfield .ef -command returnCmd
+
+ entryfield .fef -labeltext "Fixed:" -fixed 10 -width 12
+
+ entryfield .nef -labeltext "Numeric:" -validate numeric -width 12
+
+ entryfield .aef -labeltext "Alphabetic:" \\
+ -validate alphabetic -width 12 -invalid invalidCmd
+
+ entryfield .pef -labeltext "Password:" \\
+ -show \267 -width 12 -command returnCmd
+
+ Labeledwidget::alignlabels .ef .fef .nef .aef .pef
+
+ pack .ef -fill x -expand yes -padx 10 -pady 5
+ pack .fef -fill x -expand yes -padx 10 -pady 5
+ pack .nef -fill x -expand yes -padx 10 -pady 5
+ pack .aef -fill x -expand yes -padx 10 -pady 5
+ pack .pef -fill x -expand yes -padx 10 -pady 5
+.DE
+.SH AUTHOR
+Sue Yockey
+.DE
+Mark L. Ulferts
+.LP
+.SH KEYWORDS
+entryfield, widget
diff --git a/itcl/iwidgets3.0.0/doc/extfileselectionbox.n b/itcl/iwidgets3.0.0/doc/extfileselectionbox.n
new file mode 100644
index 00000000000..2a71969d8f7
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/extfileselectionbox.n
@@ -0,0 +1,383 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) extfileselectionbox.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS extfileselectionbox iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+extfileselectionbox \- Create and manipulate a file selection box widget
+.SH SYNOPSIS
+\fBextfileselectionbox\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- Extfileselectionbox
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBbackground\fR \fBborderWidth\fR \fBcursor\fR
+\fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR \fBinsertBackground\fR
+\fBinsertBorderWidth\fR \fBinsertOffTime\fR \fBinsertOnTime\fR \fBinsertWidth\fR
+\fBselectBackground\fR \fBselectBorderWidth\fR \fBselectForeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBpopupCursor\fR \fBtextBackground\fR \fBtextFont\fR
+.fi
+.LP
+See the "combobox" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelFont\fR
+.fi
+.LP
+See the "labeledwidget" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBsashCursor\fR
+.fi
+.LP
+See the "panedwindow" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveRelief\fR \fBelementBorderWidth\fR \fBjump\fR \fBtroughColor\fR
+.fi
+.LP
+See the "scrollbar" widget class manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtextBackground\fR \fBtextFont\fR
+.fi
+.LP
+See the "scrolledlistbox" widget manual entry for details on the above
+associated options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBchildSitePos\fR
+Class: \fBPosition\fR
+Command-Line Switch: \fB-childsitepos\fR
+.fi
+.IP
+Specifies the position of the child site in the extended fileselection
+box: \fBn\fR, \fBs\fR, \fBe\fR, \fBw\fR, \fBtop\fR, or \fBbottom\fR.
+The default is s.
+.LP
+.nf
+Name: \fBdirectory\fR
+Class: \fBDirectory\fR
+Command-Line Switch: \fB-directory\fR
+.fi
+.IP
+Specifies the initial default directory. The default is the present
+working directory.
+.LP
+.nf
+Name: \fBdirSearchCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-dirsearchcommand\fR
+.fi
+.IP
+Specifies a Tcl command to be executed to perform a directory search.
+The command will receive the current working directory and filter
+mask as arguments. The command should return a list of files which
+will be placed into the directory list.
+.LP
+.nf
+Name: \fBdirsLabel\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-dirslabel\fR
+.fi
+.IP
+Specifies the text of the label for the directory list. The default is
+"Directories".
+.LP
+.nf
+Name: \fBdirsOn\fR
+Class: \fBDirsOn\fR
+Command-Line Switch: \fB-dirson\fR
+.fi
+.IP
+Specifies whether or not to display the directory list. The
+value may be given in any of the forms acceptable to \fBTcl_GetBoolean\fR.
+The default is true.
+.LP
+.nf
+Name: \fBfileSearchCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-filesearchcommand\fR
+.fi
+.IP
+Specifies a Tcl command to be executed to perform a file search.
+The command will receive the current working directory and filter
+mask as arguments. The command should return a list of files which
+will be placed into the file list.
+.LP
+.nf
+Name: \fBfilesLabel\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-fileslabel\fR
+.fi
+.IP
+Specifies the text of the label for the files list. The default is "Files".
+.LP
+.nf
+Name: \fBfilesOn\fR
+Class: \fBFilesOn\fR
+Command-Line Switch: \fB-fileson\fR
+.fi
+.IP
+Specifies whether or not to display the files list. The
+value may be given in any of the forms acceptable to \fBTcl_GetBoolean\fR.
+The default is true.
+.LP
+.nf
+Name: \fBfileType\fR
+Class: \fBFileType\fR
+Command-Line Switch: \fB-filetype\fR
+.fi
+.IP
+Specify the type of files which may appear in the file list: \fBregular\fR,
+\fBdirectory\fR, or \fBany\fR. The default is regular.
+.LP
+.nf
+Name: \fBfilterCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-filtercommand\fR
+.fi
+.IP
+Specifies a Tcl command to be executed upon hitting the Return key
+in the filter combobox widget.
+.LP
+.nf
+Name: \fBfilterLabel\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-filterlabel\fR
+.fi
+.IP
+Specifies the text of the label for the filter combobox. The default is
+"Filter".
+.LP
+.nf
+Name: \fBfilterOn\fR
+Class: \fBFilterOn\fR
+Command-Line Switch: \fB-filteron\fR
+.fi
+.IP
+Specifies whether or not to display the filter combobox. The
+value may be given in any of the forms acceptable to \fBTcl_GetBoolean\fR.
+The default is true.
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Command-Line Switch: \fB-height\fR
+.fi
+.IP
+Specifies the height of the selection box. The value may be specified in
+any of the forms acceptable to Tk_GetPixels. The default is 300 pixels.
+.LP
+.nf
+Name: \fBinvalid\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-invalid\fR
+.fi
+.IP
+Command to be executed should the filter contents be proven
+invalid. The default is {bell}.
+.LP
+.nf
+Name: \fBmask\fR
+Class: \fBMask\fR
+Command-Line Switch: \fB-mask\fR
+.fi
+.IP
+Specifies the initial file mask string. The default is "*".
+.LP
+.nf
+Name: \fBnoMatchString\fR
+Class: \fBNoMatchString\fR
+Command-Line Switch: \fB-nomatchstring\fR
+.fi
+.IP
+Specifies the string to be displayed in the files list should no files
+match the mask. The default is "".
+.LP
+.nf
+Name: \fBselectDirCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-selectdirommand\fR
+.fi
+.IP
+Specifies a Tcl command to be executed following selection of a
+directory in the directory list.
+.LP
+.nf
+Name: \fBselectFileCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-selectfileommand\fR
+.fi
+.IP
+Specifies a Tcl command to be executed following selection of a
+file in the files list.
+.LP
+.nf
+Name: \fBselectionCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-selectioncommand\fR
+.fi
+.IP
+Specifies a Tcl command to be executed upon hitting the Return key
+in the selection combobox widget.
+.LP
+.nf
+Name: \fBselectionLabel\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-selectionlabel\fR
+.fi
+.IP
+Specifies the text of the label for the selection combobox. The default
+is "Selection".
+.LP
+.nf
+Name: \fBselectionOn\fR
+Class: \fBSelectionOn\fR
+Command-Line Switch: \fB-selectionon\fR
+.fi
+.IP
+Specifies whether or not to display the selection combobox. The
+value may be given in any of the forms acceptable to \fBTcl_GetBoolean\fR.
+The default is true.
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-width\fR
+.fi
+.IP
+Specifies the width of the selection box. The value may be specified in
+any of the forms acceptable to Tk_GetPixels. The default is 350 pixels.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBextfileselectionbox\fR command creates an extended file
+selection box which is slightly different than the fileselectionbox widget.
+The differences are mostly cosmetic in that the listboxes are
+within a panedwindow and the entryfields for the filter and selection
+have been replaced by comboboxes. Other than that the interface is
+practically the same.
+
+.SH "METHODS"
+.PP
+The \fBextfileselectionbox\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for extfileselectionbox widgets:
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBextfileselectionbox\fR
+command.
+.TP
+\fIpathName \fBchildsite\fR
+Returns the child site widget path name.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBextfileselectionbox\fR
+command.
+.TP
+\fIpathName \fBfilter\fR
+Update the current contents of the extended file selection box based
+on the current filter combobox value.
+.TP
+\fIpathName \fBget\fR
+Returns the current value of the selection combobox widget.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBdirs\fR
+Class: \fBScrolledlistbox\fR
+.fi
+.IP
+The dirs component is the directory list box for the extended fileselection
+box. See the "scrolledlistbox" widget manual entry for details on the dirs
+component item.
+.LP
+.nf
+Name: \fBfiles\fR
+Class: \fBScrolledlistbox\fR
+.fi
+.IP
+The files component is the file list box for the extended fileselection box.
+See the "scrolledlistbox" widget manual entry for details on the files
+component item.
+.LP
+.nf
+Name: \fBfilter\fR
+Class: \fBCombobox\fR
+.fi
+.IP
+The filter component is the field for user input of the filter value.
+See the "combobox" widget manual entry for details on the filter
+component item.
+.LP
+.nf
+Name: \fBselection\fR
+Class: \fBCombobox\fR
+.fi
+.IP
+The selection component is the field for user input of the currently
+selected file value. See the "combobox" widget manual entry for details
+on the selection component item.
+.fi
+
+.SH EXAMPLE
+.DS
+extfileselectionbox .fsb
+pack .fsb -padx 10 -pady 10 -fill both -expand yes
+.DE
+.SH AUTHOR(S)
+Mark L. Ulferts
+.DE
+Anthony Parent
+.SH KEYWORDS
+extfileselectionbox, widget
diff --git a/itcl/iwidgets3.0.0/doc/extfileselectiondialog.n b/itcl/iwidgets3.0.0/doc/extfileselectiondialog.n
new file mode 100644
index 00000000000..4bfeeb1643d
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/extfileselectiondialog.n
@@ -0,0 +1,237 @@
+'\"
+'\" Copyright (c) 1997 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) extfileselectiondialog.n 1.21 94/12/17 16:04:44
+'\"
+.so man.macros
+.HS extfileselectiondialog iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+extfileselectiondialog \- Create and manipulate a file selection dialog widget
+.SH SYNOPSIS
+\fBextfileselectiondialog\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Toplevel <- Shell <- Dialogshell <- Dialog <- Extfileselectiondialog
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBbackground\fR \fBborderWidth\fR \fBcursor\fR
+\fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR \fBinsertBackground\fR
+\fBinsertBorderWidth\fR \fBinsertOffTime\fR \fBinsertOnTime\fR \fBinsertWidth\fR
+\fBselectBackground\fR \fBselectBorderWidth\fR \fBselectForeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBpopupCursor\fR \fBtextBackground\fR \fBtextFont\fR
+.fi
+.LP
+See the "combobox" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBchildSitePos\fR \fBdirectory\fR \fBdirsLabel\fR \fBdirSearchCommand\fR
+\fBdirsOn\fR \fBfilesLabel\fR \fBfilesLabelOn\fR \fBfileSearchCommand\fR
+\fBfilesOn\fR \fBfileType\fR \fBfilterLabel\fR \fBfilterOn\fR
+\fBinvalid\fR \fBmask\fR \fBnoMatchString\fR \fBselectionLabel\fR
+\fBselectionOn\fR
+.fi
+.LP
+See the "extfileselectionbox" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelFont\fR
+.fi
+.LP
+See the "labeledwidget" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBsashCursor\fR
+.fi
+.LP
+See the "panedwindow" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelFont\fR
+.fi
+.LP
+See the "labeledwidget" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveRelief\fR \fBelementBorderWidth\fR \fBjump\fR \fBtroughColor\fR
+.fi
+.LP
+See the "scrollbar" widget class manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtextBackground\fR \fBtextFont\fR
+.fi
+.LP
+See the "scrolledlistbox" widget manual entry for details on the above
+associated options.
+
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbuttonBoxPadX\fR \fBbuttonBoxPadY\fR \fBbuttonBoxPos\fR \fBpadX\fR
+\fBpadY\fR \fBseparator\fR \fBthickness\fR
+.fi
+.LP
+See the "dialogshell" widget manual entry for details on the above
+inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBheight\fR \fBmaster\fR \fBmodality\fR \fBwidth\fR
+.fi
+.LP
+See the "shell" widget manual entry for details on the above
+inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtitle\fR
+.fi
+.LP
+See the "Toplevel" widget manual entry for details on the above
+inherited options.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBextfileselectiondialog\fR command creates an extended file
+selection dialog which is slightly different than the
+fileselectiondialog widget.
+The differences are mostly cosmetic in that the listboxes are
+within a panedwindow and the entryfields for the filter and selection
+have been replaced by comboboxes. Other than that the interface is
+practically the same.
+
+.SH "METHODS"
+.PP
+The \fBextfileselectiondialog\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for extfileselectiondialog widgets:
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBget\fR \fBchildsite\fR \fBfilter\fR
+.fi
+.LP
+See the "fileselectionbox" class manual entry for details on the
+associated methods.
+.SH "INHERITED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBadd\fR \fBbuttonconfigure\fR \fBdefault\fR \fBhide\fR
+\fBinsert\fR \fBinvoke\fR \fBshow\fR
+.fi
+.LP
+See the "buttonbox" widget manual entry for details on the above
+inherited methods.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactivate\fR \fBcenter\fR \fBdeactivate\fR
+.fi
+.LP
+See the "shell" widget manual entry for details on the above
+inherited methods.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by
+the \fBextfileselectiondialog\fR command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by
+the \fBextfileselectiondialog\fR
+command.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBfsb\fR
+Class: \fBFileselectionbox\fR
+.fi
+.IP
+The fsb component is the extfileselectionbox for the extfileselectiondialog.
+See the "extfileselectionbox" widget manual entry for details on the fsb
+component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ #
+ # Non-modal example
+ #
+ proc okCallback {} {
+ puts "You selected [.nmfsd get]"
+ .nmfsd deactivate
+ }
+
+ extfileselectiondialog .nmfsd -title Non-Modal
+ .nmfsd buttonconfigure OK -command okCallback
+
+ .nmfsd activate
+
+ #
+ # Modal example
+ #
+ extfileselectiondialog .mfsd -modality application
+ .mfsd center
+
+ if {[.mfsd activate]} {
+ puts "You selected [.mfsd get]"
+ } else {
+ puts "You cancelled the dialog"
+ }
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.DE
+Anthony L. Parent
+.SH KEYWORDS
+extfileselectiondialog, extfileselectionbox, dialog, dialogshell, shell, widget
diff --git a/itcl/iwidgets3.0.0/doc/feedback.n b/itcl/iwidgets3.0.0/doc/feedback.n
new file mode 100644
index 00000000000..9fe9b176f39
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/feedback.n
@@ -0,0 +1,144 @@
+'\"
+'\" Copyright (c) 1996 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) feedback.n
+'/"
+.so man.macros
+.HS feedback iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+feedback \- Create and manipulate a feedback widget to display feedback on
+the current status of an ongoing operation to the user.
+.SH SYNOPSIS
+\fBfeedback\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- Labeledwidget <- Feedback
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBcursor\fR \fBforeground\fR \fBhighlightColor\fR
+\fBhighlightThickness\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR \fBlabelMargin\fR
+\fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR
+.fi
+.LP
+See the "labeledwidget" class manual entry for details on the inherited options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBbarcolor\fR
+Class: \fBBarColor\fR
+Command-Line Switch: \fB-barcolor\fR
+.fi
+.IP
+Specifies the color of the status bar, in any of the forms
+acceptable to \fBTk_GetColor\fR. The default is DodgerBlue.
+.LP
+.nf
+Name: \fBbarheight\fR
+Class: \fBBarHeight\fR
+Command-Line Switch: \fB-barheight\fR
+.fi
+.IP
+Specifies the height of the status bar, in any of the forms
+acceptable to \fBTk_GetPixels\fR. The default is 20.
+.LP
+.nf
+Name: \fBtroughColor\fR
+Class: \fBTroughColor\fR
+Command-Line Switch: \fB-troughcolor\fR
+.fi
+.IP
+Specifies the color of the frame in which the status bar sits,
+in any of the forms acceptable to \fBTk_GetColor\fR. The default is white.
+.LP
+.nf
+Name: \fBsteps\fR
+Class: \fBSteps\fR
+Command-Line Switch: \fB-steps\fR
+.fi
+.IP
+Specifies the total number of steps for the status bar. The default is 10.
+.LP
+
+.SH DESCRIPTION
+.PP
+The \fBfeedback\fR command creates a widget to display feedback on
+the current status of an ongoing operation to the user. Display is given as
+a percentage and as a thermometer type bar. Options exist for adding a label
+and controlling its position.
+
+.SH "METHODS"
+.PP
+The \fBfeedback\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for scrolledtext widgets:
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBscrolledhtml\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBfeedback\fR
+command.
+.TP
+\fIpathName\fR \fBreset\fR
+Reset the current number of steps completed to 0, and configures the
+percentage complete label text to 0%
+.TP
+\fIpathName\fR \fBstep\fR ?\fIinc\fR?
+Increase the current number of steps completed by the amount specified
+by \fIinc\fR. \fIInc\fR defaults to 1.
+
+.SH EXAMPLE
+.DS
+ feedback .fb -labeltext "Status" -steps 20
+ pack .fb -padx 10 -pady 10 -fill both -expand yes
+
+ for {set i 0} {$i < 20} {incr i} {
+ .fb step
+ after 500
+ }
+.DE
+.SH ACKNOWLEDGEMENTS
+Sam Shen
+.IP
+This code is based largely on his feedback.tcl code from tk inspect. The
+original feedback code is copyright 1995 Lawrence Berkeley Laboratory.
+.LP
+.SH AUTHOR
+Kris Raney
+.SH KEYWORDS
+feedback, widget
diff --git a/itcl/iwidgets3.0.0/doc/fileselectionbox.n b/itcl/iwidgets3.0.0/doc/fileselectionbox.n
new file mode 100644
index 00000000000..eb0cad86325
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/fileselectionbox.n
@@ -0,0 +1,379 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) fileselectionbox.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS fileselectionbox iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+fileselectionbox \- Create and manipulate a file selection box widget
+.SH SYNOPSIS
+\fBfileselectionbox\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- Fileselectionbox
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBbackground\fR \fBborderWidth\fR \fBcursor\fR
+\fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR \fBinsertBackground\fR
+\fBinsertBorderWidth\fR \fBinsertOffTime\fR \fBinsertOnTime\fR \fBinsertWidth\fR
+\fBselectBackground\fR \fBselectBorderWidth\fR \fBselectForeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtextBackground\fR \fBtextFont\fR
+.fi
+.LP
+See the "entryfield" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelFont\fR
+.fi
+.LP
+See the "labeledwidget" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveRelief\fR \fBelementBorderWidth\fR \fBjump\fR \fBtroughColor\fR
+.fi
+.LP
+See the "scrollbar" widget class manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtextBackground\fR \fBtextFont\fR
+.fi
+.LP
+See the "scrolledlistbox" widget manual entry for details on the above
+associated options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBchildSitePos\fR
+Class: \fBPosition\fR
+Command-Line Switch: \fB-childsitepos\fR
+.fi
+.IP
+Specifies the position of the child site in the selection box: \fBn\fR,
+\fBs\fR, \fBe\fR, \fBw\fR, \fBtop\fR, \fBbottom\fR, or \fBcenter\fR. The
+default is s.
+.fi
+.IP
+Specifies a Tcl command procedure which is called when an file list item is
+double clicked. Typically this occurs when mouse button 1 is double
+clicked over a file name.
+.LP
+.nf
+Name: \fBdirectory\fR
+Class: \fBDirectory\fR
+Command-Line Switch: \fB-directory\fR
+.fi
+.IP
+Specifies the initial default directory. The default is the present
+working directory.
+.LP
+.nf
+Name: \fBdirSearchCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-dirsearchcommand\fR
+.fi
+.IP
+Specifies a Tcl command to be executed to perform a directory search.
+The command will receive the current working directory and filter
+mask as arguments. The command should return a list of files which
+will be placed into the directory list.
+.LP
+.nf
+Name: \fBdirsLabel\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-dirslabel\fR
+.fi
+.IP
+Specifies the text of the label for the directory list. The default is
+"Directories".
+.LP
+.nf
+Name: \fBdirsOn\fR
+Class: \fBDirsOn\fR
+Command-Line Switch: \fB-dirson\fR
+.fi
+.IP
+Specifies whether or not to display the directory list. The
+value may be given in any of the forms acceptable to \fBTcl_GetBoolean\fR.
+The default is true.
+.LP
+.nf
+Name: \fBfileSearchCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-filesearchcommand\fR
+.fi
+.IP
+Specifies a Tcl command to be executed to perform a file search.
+The command will receive the current working directory and filter
+mask as arguments. The command should return a list of files which
+will be placed into the file list.
+.LP
+.nf
+Name: \fBfilesLabel\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-fileslabel\fR
+.fi
+.IP
+Specifies the text of the label for the files list. The default is "Files".
+.LP
+.nf
+Name: \fBfilesOn\fR
+Class: \fBFilesOn\fR
+Command-Line Switch: \fB-fileson\fR
+.fi
+.IP
+Specifies whether or not to display the files list. The
+value may be given in any of the forms acceptable to \fBTcl_GetBoolean\fR.
+The default is true.
+.LP
+.nf
+Name: \fBfileType\fR
+Class: \fBFileType\fR
+Command-Line Switch: \fB-filetype\fR
+.fi
+.IP
+Specify the type of files which may appear in the file list: \fBregular\fR,
+\fBdirectory\fR, or \fBany\fR. The default is regular.
+.LP
+.nf
+Name: \fBfilterCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-filtercommand\fR
+.fi
+.IP
+Specifies a Tcl command to be executed upon hitting the Return key
+in the filter entry widget.
+.LP
+.nf
+Name: \fBfilterLabel\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-filterlabel\fR
+.fi
+.IP
+Specifies the text of the label for the filter entry field. The default is
+"Filter".
+.LP
+.nf
+Name: \fBfilterOn\fR
+Class: \fBFilterOn\fR
+Command-Line Switch: \fB-filteron\fR
+.fi
+.IP
+Specifies whether or not to display the filter entry. The
+value may be given in any of the forms acceptable to \fBTcl_GetBoolean\fR.
+The default is true.
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Command-Line Switch: \fB-height\fR
+.fi
+.IP
+Specifies the height of the selection box. The value may be specified in
+any of the forms acceptable to Tk_GetPixels. The default is 360 pixels.
+.LP
+.nf
+Name: \fBinvalid\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-invalid\fR
+.fi
+.IP
+Command to be executed should the filter contents be proven
+invalid. The default is {bell}.
+.LP
+.nf
+Name: \fBmask\fR
+Class: \fBMask\fR
+Command-Line Switch: \fB-mask\fR
+.fi
+.IP
+Specifies the initial file mask string. The default is "*".
+.LP
+.nf
+Name: \fBnoMatchString\fR
+Class: \fBNoMatchString\fR
+Command-Line Switch: \fB-nomatchstring\fR
+.fi
+.IP
+Specifies the string to be displayed in the files list should no files
+match the mask. The default is "".
+.LP
+.nf
+Name: \fBselectDirCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-selectdirommand\fR
+.fi
+.IP
+Specifies a Tcl command to be executed following selection of a
+directory in the directory list.
+.LP
+.nf
+Name: \fBselectFileCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-selectfileommand\fR
+.fi
+.IP
+Specifies a Tcl command to be executed following selection of a
+file in the files list.
+.LP
+.nf
+Name: \fBselectionCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-selectioncommand\fR
+.fi
+.IP
+Specifies a Tcl command to be executed upon hitting the Return key
+in the selection entry widget.
+.LP
+.nf
+Name: \fBselectionLabel\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-selectionlabel\fR
+.fi
+.IP
+Specifies the text of the label for the selection entry field. The default
+is "Selection".
+.LP
+.nf
+Name: \fBselectionOn\fR
+Class: \fBSelectionOn\fR
+Command-Line Switch: \fB-selectionon\fR
+.fi
+.IP
+Specifies whether or not to display the selection entry. The
+value may be given in any of the forms acceptable to \fBTcl_GetBoolean\fR.
+The default is true.
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-width\fR
+.fi
+.IP
+Specifies the width of the selection box. The value may be specified in
+any of the forms acceptable to Tk_GetPixels. The default is 470 pixels.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBfileselectionbox\fR command creates a file selection box similar
+to the OSF/Motif standard Xmfileselectionbox composite widget. The
+fileselectionbox is composed of directory and file scrolled lists as
+well as filter and selection entry fields. Bindings are in place such that
+selection of a directory list item loads the filter entry field and
+selection of a file list item loads the selection entry field. Options
+exist to control the appearance and actions of the widget.
+
+.SH "METHODS"
+.PP
+The \fBfileselectionbox\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for fileselectionbox widgets:
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBfileselectionbox\fR
+command.
+.TP
+\fIpathName \fBchildsite\fR
+Returns the child site widget path name.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBfileselectionbox\fR
+command.
+.TP
+\fIpathName \fBfilter\fR
+Update the current contents of the file selection box based on the current
+filter entry field value.
+.TP
+\fIpathName \fBget\fR
+Returns the current value of the selection entry widget.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBdirs\fR
+Class: \fBScrolledlistbox\fR
+.fi
+.IP
+The dirs component is the directory list box for the file selection box.
+See the "scrolledlistbox" widget manual entry for details on the dirs
+component item.
+.LP
+.nf
+Name: \fBfiles\fR
+Class: \fBScrolledlistbox\fR
+.fi
+.IP
+The files component is the file list box for the file selection box.
+See the "scrolledlistbox" widget manual entry for details on the files
+component item.
+.LP
+.nf
+Name: \fBfilter\fR
+Class: \fBEntryfield\fR
+.fi
+.IP
+The filter component is the entry field for user input of the filter value.
+See the "entryfield" widget manual entry for details on the filter
+component item.
+.LP
+.nf
+Name: \fBselection\fR
+Class: \fBEntryfield\fR
+.fi
+.IP
+The selection component is the entry field for user input of the currently
+selected file value. See the "entryfield" widget manual entry for details
+on the selection component item.
+.fi
+
+.SH EXAMPLE
+.DS
+fileselectionbox .fsb
+pack .fsb -padx 10 -pady 10 -fill both -expand yes
+.DE
+.SH AUTHOR(S)
+Mark L. Ulferts
+.SH KEYWORDS
+fileselectionbox, widget
diff --git a/itcl/iwidgets3.0.0/doc/fileselectiondialog.n b/itcl/iwidgets3.0.0/doc/fileselectiondialog.n
new file mode 100644
index 00000000000..75128a8b1ed
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/fileselectiondialog.n
@@ -0,0 +1,216 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) fileselectiondialog.n 1.21 94/12/17 16:04:44
+'\"
+.so man.macros
+.HS fileselectiondialog iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+fileselectiondialog \- Create and manipulate a file selection dialog widget
+.SH SYNOPSIS
+\fBfileselectiondialog\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Toplevel <- Shell <- Dialogshell <- Dialog <- Fileselectiondialog
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBbackground\fR \fBborderWidth\fR \fBcursor\fR
+\fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR \fBinsertBackground\fR
+\fBinsertBorderWidth\fR \fBinsertOffTime\fR \fBinsertOnTime\fR \fBinsertWidth\fR
+\fBselectBackground\fR \fBselectBorderWidth\fR \fBselectForeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtextBackground\fR \fBtextFont\fR
+.fi
+.LP
+See the "entryfield" widget manual entry for details on the above associated
+options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBchildSitePos\fR \fBdirectory\fR \fBdirsLabel\fR \fBdirSearchCommand\fR
+\fBdirsOn\fR \fBfilesLabel\fR \fBfilesLabelOn\fR \fBfileSearchCommand\fR
+\fBfilesOn\fR \fBfileType\fR \fBfilterLabel\fR \fBfilterOn\fR
+\fBinvalid\fR \fBmask\fR \fBnoMatchString\fR \fBselectionLabel\fR
+\fBselectionOn\fR
+.fi
+.LP
+See the "fileselectionbox" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelFont\fR
+.fi
+.LP
+See the "labeledwidget" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtextBackground\fR \fBtextFont\fR
+.fi
+.LP
+See the "scrolledlistbox" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveRelief\fR \fBelementBorderWidth\fR \fBjump\fR \fBtroughColor\fR
+.fi
+.LP
+See the "scrollbar" widget class manual entry for details on the above
+associated options.
+
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbuttonBoxPadX\fR \fBbuttonBoxPadY\fR \fBbuttonBoxPos\fR \fBpadX\fR
+\fBpadY\fR \fBseparator\fR \fBthickness\fR
+.fi
+.LP
+See the "dialogshell" widget manual entry for details on the above
+inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBheight\fR \fBmaster\fR \fBmodality\fR \fBwidth\fR
+.fi
+.LP
+See the "shell" widget manual entry for details on the above
+inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtitle\fR
+.fi
+.LP
+See the "Toplevel" widget manual entry for details on the above
+inherited options.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBfileselectiondialog\fR command creates a file selection dialog
+similar to the OSF/Motif standard composite widget. The
+fileselectiondialog is derived from the Dialog class and is composed of
+a FileSelectionBox with attributes set to manipulate the dialog buttons.
+
+.SH "METHODS"
+.PP
+The \fBfileselectiondialog\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for fileselectiondialog widgets:
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBget\fR \fBchildsite\fR \fBfilter\fR
+.fi
+.LP
+See the "fileselectionbox" class manual entry for details on the
+associated methods.
+.SH "INHERITED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBadd\fR \fBbuttonconfigure\fR \fBdefault\fR \fBhide\fR
+\fBinsert\fR \fBinvoke\fR \fBshow\fR
+.fi
+.LP
+See the "buttonbox" widget manual entry for details on the above
+inherited methods.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactivate\fR \fBcenter\fR \fBdeactivate\fR
+.fi
+.LP
+See the "shell" widget manual entry for details on the above
+inherited methods.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by
+the \fBfileselectiondialog\fR command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by
+the \fBfileselectiondialog\fR
+command.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBfsb\fR
+Class: \fBFileselectionbox\fR
+.fi
+.IP
+The fsb component is the file selection box for the file selection dialog.
+See the "fileselectionbox" widget manual entry for details on the fsb
+component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ #
+ # Non-modal example
+ #
+ proc okCallback {} {
+ puts "You selected [.nmfsd get]"
+ .nmfsd deactivate
+ }
+
+ fileselectiondialog .nmfsd -title Non-Modal
+ .nmfsd buttonconfigure OK -command okCallback
+
+ .nmfsd activate
+
+ #
+ # Modal example
+ #
+ fileselectiondialog .mfsd -modality application
+ .mfsd center
+
+ if {[.mfsd activate]} {
+ puts "You selected [.mfsd get]"
+ } else {
+ puts "You cancelled the dialog"
+ }
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.SH KEYWORDS
+fileselectiondialog, fileselectionbox, dialog, dialogshell, shell, widget
diff --git a/itcl/iwidgets3.0.0/doc/finddialog.n b/itcl/iwidgets3.0.0/doc/finddialog.n
new file mode 100644
index 00000000000..f0aab55daeb
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/finddialog.n
@@ -0,0 +1,292 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) finddialog.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS finddialog iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+finddialog \- Create and manipulate a find dialog widget
+.SH SYNOPSIS
+\fBfinddialog\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Toplevel <- Shell <- Dialogshell <- Finddialog
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBactiveForeground\fR \fBbackground\fR \fBborderWidth\fR
+\fBcursor\fR \fBdisabledForeground\fR \fBfont\fR \fBforeground\fR
+\fBhighlightColor\fR \fBhighlightThickness\fR \fBinsertBackground\fR \fBinsertBorderWidth\fR
+\fBinsertOffTime\fR \fBinsertOnTime\fR \fBinsertWidth\fR \fBselectBackground\fR
+\fBselectBorderWidth\fR \fBselectColor\fR \fBselectForeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBselectColor\fR
+.fi
+.LP
+See the "checkbutton" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBselectColor\fR
+.fi
+.LP
+See the "entryfield" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelFont\fR
+.fi
+.LP
+See the "labeledwidget" widget manual entry for details on the above
+associated options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbuttonBoxPadX\fR \fBbuttonBoxPadY\fR \fBbuttonBoxPos\fR \fBpadX\fR
+\fBpadY\fR \fBseparator\fR \fBthickness\fR
+.fi
+.LP
+See the "dialogshell" widget manual entry for details on the above
+inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBheight\fR \fBmaster\fR \fBmodality\fR \fBwidth\fR
+.fi
+.LP
+See the "shell" widget manual entry for details on the above
+inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtitle\fR
+.fi
+.LP
+See the "Toplevel" widget manual entry for details on the above
+inherited options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBclearCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-clearcommand\fR
+.fi
+.IP
+Specifies a command to be invoked following a clear operation.
+The option is meant to be used as means of notification that the
+clear has taken place and allow other actions to take place such
+as disabling a find again menu.
+.LP
+.nf
+Name: \fBmatchCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-matchcommand\fR
+.fi
+.IP
+Specifies a command to be invoked following a find operation.
+The command is called with a match point as an argument which identifies
+where exactly where in the text or scrolledtext widget that the match
+is located. Should a match not be found the match point is {}. The
+option is meant to be used as a means of notification that the
+find operation has completed and allow other actions to take place
+such as disabling a find again menu option if the match point was {}.
+.LP
+.nf
+Name: \fBpatternBackground\fR
+Class: \fBBackground\fR
+Command-Line Switch: \fB-patternbackground\fR
+.fi
+.IP
+Specifies the background color of the text matching the search
+pattern. It may have any of the forms accepted by Tk_GetColor.
+The default is gray44.
+.LP
+.nf
+Name: \fBpatternForeground\fR
+Class: \fBBackground\fR
+Command-Line Switch: \fB-patternforeground\fR
+.fi
+.IP
+Specifies the foreground color of the text matching the search
+pattern. It may have any of the forms accepted by Tk_GetColor.
+The default is white.
+.LP
+.nf
+Name: \fBsearchBackground\fR
+Class: \fBBackground\fR
+Command-Line Switch: \fB-searchbackground\fR
+.fi
+.IP
+Specifies the background color of the line containing the matching
+the search pattern. It may have any of the forms accepted by Tk_GetColor.
+The default is gray77.
+.LP
+.nf
+Name: \fBsearchForeground\fR
+Class: \fBBackground\fR
+Command-Line Switch: \fB-searchforeground\fR
+.fi
+.IP
+Specifies the foreground color of the line containing the matching
+the search pattern. It may have any of the forms accepted by Tk_GetColor.
+The default is black.
+.LP
+.nf
+Name: \fBtextWidget\fR
+Class: \fBTextWidget\fR
+Command-Line Switch: \fB-textwidget\fR
+.fi
+.IP
+Specifies the text or scrolledtext widget to be searched.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBfinddialog\fR command creates a find dialog that works in
+conjunction with a text or scrolledtext widget to provide a means
+of performing search operations. The user is prompted for a text
+pattern to be found in the text or scrolledtext widget. The
+search can be for all occurances, by regular expression, considerate
+of the case, or backwards.
+
+.SH "METHODS"
+.PP
+The \fBfinddialog\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for finddialog widgets:
+.SH "INHERITED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBadd\fR \fBbuttonconfigure\fR \fBdefault\fR \fBhide\fR
+\fBinvoke\fR \fBshow\fR
+.fi
+.LP
+See the "buttonbox" widget manual entry for details on the above
+inherited methods.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactivate\fR \fBcenter\fR \fBdeactivate\fR
+.fi
+.LP
+See the "shell" widget manual entry for details on the above
+inherited methods.
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBfinddialog\fR
+command.
+.TP
+\fIpathName \fBclear\fR
+Clears the pattern in the entry field and the pattern matchin
+indicators in the text or scrolledtext widget.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBfinddialog\fR
+command.
+.TP
+\fIpathName \fBfind\fR
+Search for a specific text string in the text widget given by
+the -textwidget option. This method is the standard callback
+for the Find button. It is made available such that it can be
+bound to a find again action.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBall\fR
+Class: \fBCheckbutton\fR
+.fi
+.IP
+The all component specifies that all the matches of the pattern should be
+found when performing the search. See the "checkbutton" widget manual
+entry for details on the all component item.
+.LP
+.nf
+Name: \fBbackwards\fR
+Class: \fBCheckbutton\fR
+.fi
+.IP
+The backwards component specifies that the search should continue in
+a backwards direction towards the beginning of the text or scrolledtext
+widget. See the "checkbutton" widget manual entry for details on the
+backwards component item.
+.LP
+.nf
+Name: \fBcase\fR
+Class: \fBCheckbutton\fR
+.fi
+.IP
+The case component specifies that the case of the pattern should be
+taken into consideration when performing the search. See the
+"checkbutton" widget manual entry for details on the case component item.
+.LP
+.nf
+Name: \fBpattern\fR
+Class: \fBEntryfield\fR
+.fi
+.IP
+The pattern component provides the pattern entry field. See the
+"entryfield" widget manual entry for details on the pattern component item.
+.LP
+.nf
+Name: \fBregexp\fR
+Class: \fBCheckbutton\fR
+.fi
+.IP
+The regexp component specifies that the pattern is a regular expression.
+See the "checkbutton" widget manual entry for details on the regexp
+component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ scrolledtext .st
+ pack .st
+ .st insert end "Now is the time for all good men\\n"
+ .st insert end "to come to the aid of their country"
+
+ finddialog .fd -textwidget .st
+ .fd center .st
+ .fd activate
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.SH KEYWORDS
+finddialog, dialogshell, shell, widget
+
diff --git a/itcl/iwidgets3.0.0/doc/hierarchy.n b/itcl/iwidgets3.0.0/doc/hierarchy.n
new file mode 100644
index 00000000000..a03e392af47
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/hierarchy.n
@@ -0,0 +1,546 @@
+'\"
+'\" Copyright (c) 1997 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) hierarchy.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS hierarchy iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+hierarchy \- Create and manipulate a hierarchy widget
+.SH SYNOPSIS
+\fBhierarchy\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- Labeledwidget <- Scrolledwidget <- Hierarchy
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBactiveForeground\fR \fBbackground\fR \fBborderWidth\fR
+\fBcursor\fR \fBdisabledForeground\fR \fBforeground\fR \fBhighlightColor\fR
+\fBhighlightThickness\fR \fBrelief\fR \fBselectBackground\fR \fBselectForeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveRelief\fR \fBelementBorderWidth\fR \fBjump\fR \fBtroughColor\fR
+.fi
+.LP
+See the "scrollbar" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBspacing1\fR \fBspacing2\fR \fBspacing3\fR \fBtabs\fR
+.fi
+.LP
+See the "text" widget manual entry for details on the above
+associated options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR \fBlabelMargin\fR
+\fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR
+.fi
+.LP
+See the "labeledwidget" class manual entry for details on the inherited options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBalwaysQuery\fR
+Class: \fBAlwaysQuery\fR
+Command-Line Switch: \fB-alwaysquery\fR
+.fi
+.IP
+Boolean flag which tells the hierarchy widget weather or not
+each refresh of the display should be via a new query using
+the command value of the -querycommand option or use the values
+previous found the last time the query was made. The default
+is no.
+.LP
+.nf
+Name: \fBclosedIcon\fR
+Class: \fBIcon\fR
+Command-Line Switch: \fB-closedicon\fR
+.fi
+.IP
+Specifies the name of an existing closed icon image to be used in the
+hierarchy before those nodes that are collapsed. Should one not be
+provided, then a folder icon will be generated, pixmap if possible,
+bitmap otherwise.
+.LP
+.nf
+Name: \fBexpanded\fR
+Class: \fBExpanded\fR
+Command-Line Switch: \fB-expanded\fR
+.fi
+.IP
+When true, the hierarchy will be completely expanded when it
+is first displayed. A fresh display can be triggered by
+resetting the -querycommand option. The default is false.
+.LP
+.nf
+Name: \fBfilter\fR
+Class: \fBFilter\fR
+Command-Line Switch: \fB-filter\fR
+.fi
+.IP
+When true only the branch nodes and selected items are displayed.
+This gives a compact view of important items. The default is false.
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Command-Line Switch: \fB-height\fR
+.fi
+.IP
+Specifies the height of the hierarchy as an entire unit.
+The value may be specified in any of the forms acceptable to
+\fBTk_GetPixels\fR. Any additional space needed to display the other
+components such as labels, margins, and scrollbars force the hierarchy
+to be compressed. A value of zero along with the same value for
+the width causes the value given for the visibleitems option
+to be applied which administers geometry constraints in a different
+manner. The default height is zero.
+.LP
+.nf
+Name: \fBiconCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-iconcommand\fR
+.fi
+.IP
+Specifies a command to be executed upon user selection via mouse button
+one of any additional icons given in the values returned by the command
+associated with the -querycommand option. If this command contains "%n",
+it is replaced with the name of the node the icon belongs to. Should it
+contain "%i" then the icon name is substituted.
+.LP
+.nf
+Name: \fBmarkBackground\fR
+Class: \fBForeground\fR
+Command-Line Switch: \fB-markbackground\fR
+.fi
+.IP
+Specifies the background color to use when displaying marked nodes.
+.LP
+.nf
+Name: \fBmarkForeground\fR
+Class: \fBBackground\fR
+Command-Line Switch: \fB-markforeground\fR
+.fi
+.IP
+Specifies the foreground color to use when displaying marked nodes.
+.LP
+.nf
+Name: \fBmenuCursor\fR
+Class: \fBCursor\fR
+Command-Line Switch: \fB-menucursor\fR
+.fi
+.IP
+Specifies the mouse cursor to be used for the item and background
+menus. The value may have any of the forms accept able to Tk_GetCursor.
+.LP
+.nf
+Name: \fBnodeIcon\fR
+Class: \fBIcon\fR
+Command-Line Switch: \fB-nodeicon\fR
+.fi
+.IP
+Specifies the name of an existing node icon image to be used in the
+hierarchy before those nodes that are leafs. Should one not be provided,
+then a dog-eared page icon will be generated, pixmap if possible, bitmap
+otherwise.
+.LP
+.nf
+Name: \fBopenIcon\fR
+Class: \fBIcon\fR
+Command-Line Switch: \fB-openicon\fR
+.fi
+.IP
+Specifies the name of an existing open icon image to be used in the
+hierarchy before those nodes that are expanded. Should one not be provided,
+then an open folder icon will be generated, pixmap if possible, bitmap
+otherwise.
+.LP
+.nf
+Name: \fBqueryCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-querycommand\fR
+.fi
+.IP
+Specifies the command executed to query the contents of each node. If this
+command contains "%n", it is replaced with the name of the desired
+node. In its simpilest form it should return the children of the
+given node as a list which will be depicted in the display.
+Since the names of the children are used as tags in the underlying
+text widget, each child must be unique in the hierarchy. Due to
+the unique requirement, the nodes shall be reffered to as uids
+or uid in the singular sense. The format of returned list is
+.IP
+ {uid [uid ...]}
+.IP
+ where uid is a unique id and primary key for the hierarchy entry
+.IP
+Should the unique requirement pose a problem, the list returned
+can take on another more extended form which enables the
+association of text to be displayed with the uids. The uid must
+still be unique, but the text does not have to obey the unique
+rule. In addition, the format also allows the specification of
+additional tags to be used on the same entry in the hierarchy
+as the uid and additional icons to be displayed just before
+the node. The tags and icons are considered to be the property of
+the user in that the hierarchy widget will not depend on any of
+their values. The extended format is
+.IP
+ {{uid [text [tags [icons]]]} {uid [text [tags [icons]]]} ...}
+.IP
+ where uid is a unique id and primary key for the hierarchy entry
+ text is the text to be displayed for this uid
+ tags is a list of user tags to be applied to the entry
+ icons is a list of icons to be displayed in front of the text
+.IP
+The hierarchy widget does a look ahead from each node to determine
+if the node has a children. This can be cost some performace with
+large hierarchies. User's can avoid this by providing a hint in
+the user tags. A tag of "leaf" or "branch" tells the hierarchy
+widget the information it needs to know thereby avoiding the look
+ahead operation.
+.LP
+.nf
+Name: \fBhscrollMode\fR
+Class: \fBScrollMode\fR
+Command-Line Switch: \fB-hscrollmode\fR
+.fi
+.IP
+Specifies the the display mode to be used for the horizontal
+scrollbar: \fBstatic, dynamic,\fR or \fBnone\fR. In static mode, the
+scroll bar is displayed at all times. Dynamic mode displays the
+scroll bar as required, and none disables the scroll bar display. The
+default is static.
+.LP
+.nf
+Name: \fBsbWidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-sbwidth\fR
+.fi
+.IP
+Specifies the width of the scrollbar in any of the forms
+acceptable to \fBTk_GetPixels\fR.
+.LP
+.nf
+Name: \fBscrollMargin\fR
+Class: \fBMargin\fR
+Command-Line Switch: \fB-scrollmargin\fR
+.fi
+.IP
+Specifies the distance between the text portion of the hierarchy and
+the scrollbars in any of the forms acceptable to \fBTk_GetPixels\fR. The
+default is 3 pixels.
+.LP
+.nf
+Name: \fBtextBackground\fR
+Class: \fBBackground\fR
+Command-Line Switch: \fB-textbackground\fR
+.fi
+.IP
+Specifies the background color for the text portion of the hierarchy in
+any of the forms acceptable to \fBTk_GetColor\fR.
+.LP
+.nf
+Name: \fBtextFont\fR
+Class: \fBFont\fR
+Command-Line Switch: \fB-textfont\fR
+.fi
+.IP
+Specifies the font to be used in the text portion of the hierarchy.
+.LP
+.nf
+Name: \fBvisibleitems\fR
+Class: \fBVisibleItems\fR
+Command-Line Switch: \fB-visibleitems\fR
+.fi
+.IP
+Specifies the widthxheight in characters and lines for the hierarchy.
+This option is only administered if the width and height options
+are both set to zero, otherwise they take precedence. The default value
+is 80x24. With the visibleitems option engaged, geometry constraints
+are maintained only on the text portion of the hierarchy. The size of
+the other components such as
+labels, margins, and scroll bars, are additive and independent,
+effecting the overall size of the hierarchy. In contrast,
+should the width and height options have non zero values, they
+are applied to the hierarchy as a whole. The hierarchy
+is compressed or expanded to maintain the geometry constraints.
+.LP
+.nf
+Name: \fBvscrollMode\fR
+Class: \fBScrollMode\fR
+Command-Line Switch: \fB-vscrollmode\fR
+.fi
+.IP
+Specifies the the display mode to be used for the vertical
+scrollbar: \fBstatic, dynamic,\fR or \fBnone\fR. In static mode, the
+scroll bar is displayed at all times. Dynamic mode displays the
+scroll bar as required, and none disables the scroll bar display. The
+default is static.
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-width\fR
+.fi
+.IP
+Specifies the width of the hierarchy as an entire unit.
+The value may be specified in any of the forms acceptable to
+\fBTk_GetPixels\fR. Any additional space needed to display the other
+components such as labels, margins, and scrollbars force the text portion
+of the hierarchy
+to be compressed. A value of zero along with the same value for
+the height causes the value given for the visibleitems option
+to be applied which administers geometry constraints in a different
+manner. The default width is zero.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBhierarchy\fR command creates a hierarchical data view widget.
+It allows the graphical management of a a list of nodes that can be
+expanded or collapsed. Individual nodes can be highlighted.
+Clicking with the right mouse button on any item brings up a
+special item menu. Clicking on the background area brings up
+a different popup menu. Options exist to provide user control over
+the loading of the nodes and actions associated with node selection.
+Since the hierarchy is based on the scrolledtext widget, it includes
+options to control the method in which the scrollbars are displayed,
+i.e. statically or dynamically. Options also exist for adding a
+label to the hierarchy and controlling its position.
+
+.SH "METHODS"
+.PP
+The \fBhierarchy\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for hierarchy widgets:
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbbox\fR \fBcompare\fR \fBdebug\fR \fBdelete\fR
+\fBdlineinfo\fR \fBdump\fR \fBget\fR \fBindex\fR
+\fBinsert\fR \fBscan\fR \fBsearch\fR \fBsee\fR
+\fBtag\fR \fBwindow\fR \fBxview\fR \fByview\fR
+.fi
+.LP
+See the "text" manual entry for details on the standard methods.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBhierarchy\fR
+command.
+.TP
+\fIpathName \fBclear\fR
+Removes all items from the hierarchy display including all tags and icons.
+The display will remain empty until the -filter or -querycommand
+options are set.
+.TP
+\fIpathName \fBcollapse\fR \fIuid\fR
+Collapses the hierarchy beneath the node with the specified unique id by
+one level. Since this can take a moment for large hierarchies, the
+cursor will be changed to a watch during the collapse. Also, if any
+of the nodes beneath the node being collapsed are selected, their
+status is changed to unselected.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBhierarchy\fR
+command.
+.TP
+\fIpathName \fBcurrent\fR
+Returns the tags for the node that was most recently selected by the
+right mouse button when the item menu was posted. Usually used by the code
+in the item menu to figure out what item is being manipulated.
+.TP
+\fIpathName \fBdraw\fR ?\fIwhen\fR?
+Performs a complete redraw of the entire hierarchy. When may be either -now
+or -eventually where the latter means the draw can be performed after idle.
+.TP
+\fIpathName \fBexpand\fR \fIuid\fR
+Expands the hierarchy beneath the node with the specified unique id by
+one level. Since this can take a moment for large hierarchies, the cursor
+will be changed to a watch during the expansion.
+.TP
+\fIpathName \fBmark\fR \fIoption ?arg arg ...?\fR
+This command is used to manipulate marks which is quite similar to
+selection, adding a secondary means of hilighting an item in the
+hierarchy. The exact behavior of the command depends on the
+\fIoption\fR argument that follows the \fBmark\fR argument. The
+following forms of the command are currently supported:
+.RS
+.TP
+\fIpathName \fBmark clear\fR
+Clears all the currently marked nodes in the hierarchy.
+.TP
+\fIpathName \fBmark add \fIuid \fR?\fIuid uid ...\fR?
+Marks the nodes with the specified uids in the hierarchy using the
+\fB-markbackground\fR and \fB-markforeground\fR options and without
+affecting the mark state of any other nodes that were already
+marked.
+.TP
+\fIpathName \fBmark remove \fIuid \fR?\fIuid uid ...\fR?
+Unmarks the nodes with the specified uids in the hierarchy without
+affecting the mark state of any other nodes that were already
+marked.
+.TP
+\fIpathName \fBmark get\fR
+Returns a list of the unique ids that are currently marked.
+.RE
+.TP
+\fIpathName \fBrefresh\fR \fIuid\fR
+Performs a redraw of a specific node that has the given uid. If the node
+is not currently visible or in other words already drawn on the text,
+then no action is taken.
+.TP
+\fIpathName \fBprune\fR \fIuid\fR
+Removes the node specified by the given uid from the hierarchy. Should
+the node have children, then all of its children will be removed as well.
+.TP
+\fIpathName \fBselection\fR \fIoption \fR?\fIarg arg ...\fR?
+This command is used to manipulate the selection of nodes in the
+hierarchy. The exact behavior of the command depends on the
+\fIoption\fR argument that follows the \fBselection\fR argument. The
+following forms of the command are currently supported:
+.RS
+.TP
+\fIpathName \fBselection clear\fR
+Clears all the currently selected nodes in the hierarchy.
+.TP
+\fIpathName \fBselection add \fIuid \fR?\fIuid uid ...\fR?
+Selects the nodes with the specified uids in the hierarchy using the
+\fB-selectionbackground\fR and \fB-selectionforeground\fR options and without
+affecting the selection state of any other nodes that were already
+selected.
+.TP
+\fIpathName \fBselection remove \fIuid \fR?\fIuid uid ...\fR?
+Deselects the nodes with the specified uids in the hierarchy without
+affecting the selection state of any other nodes that were already
+selected.
+.TP
+\fIpathName \fBselection get\fR
+Returns a list of the unique ids that are currently selected.
+.RE
+A nodes selection status is also dependent on it being visible. If a
+node is selected and its parent is then collapsed making the selected
+node not visible, then its selection status is changed to unselected.
+.TP
+\fIpathName \fBtoggle\fR \fIuid\fR
+Toggles the hierarchy beneath the node with the specified unique id. If
+the hierarchy is currently expanded, then it is collapsed, and vice-versa.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBlist\fR
+Class: \fBText\fR
+.fi
+.IP
+The list component is the text widget in which the hierarchy is displayed.
+See the "text" widget manual entry for details on the text component item.
+.LP
+.nf
+Name: \fBbgMenu\fR
+Class: \fBMenu\fR
+.fi
+.IP
+The bgMenu component is the popup menu which is displayed upon pressing
+the right mouse button in the background, i.e. not over a specific node. Menu
+items can be added along with their commands via the component command.
+See the "menu" widget manual entry for details on the bgMenu component item.
+.LP
+.nf
+Name: \fBhorizsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The horizsb component is the horizontal scroll bar. See the "scrollbar"
+widget manual entry for details on the horizsb component item.
+.LP
+.nf
+Name: \fBitemMenu\fR
+Class: \fBMenu\fR
+.fi
+.IP
+The itemMenu component is the popup menu which is displayed upon selection
+of a hierarchy node with the right mouse button. Menu items can be
+added along with their commands via the component command. See the "menu"
+widget manual entry for details on the itemMenu component item.
+.LP
+.nf
+Name: \fBvertsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The vertsb component is the vertical scroll bar. See the "scrollbar" widget
+manual entry for details on the vertsb component item.
+.fi
+
+.SH EXAMPLE
+.DS
+proc get_files {file} {
+ global env
+
+ if {$file == ""} {
+ set dir $env(HOME)
+ } else {
+ set dir $file
+ }
+
+ if {[catch {cd $dir}] != 0} {
+ return ""
+ }
+
+ set rlist ""
+
+ foreach file [lsort [glob -nocomplain *]] {
+ lappend rlist [list [file join $dir $file] $file]
+ }
+
+ return $rlist
+}
+
+hierarchy .h -querycommand "get_files %n" -visibleitems 30x15 \
+ -labeltext $env(HOME)
+pack .h -side left -expand yes -fill both
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.DE
+Michael J. McLennan
+.SH KEYWORDS
+hierarchy, text, widget
diff --git a/itcl/iwidgets3.0.0/doc/hyperhelp.n b/itcl/iwidgets3.0.0/doc/hyperhelp.n
new file mode 100644
index 00000000000..12fe460bd12
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/hyperhelp.n
@@ -0,0 +1,195 @@
+'\"
+'\" Copyright (c) 1996 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) Hyperhelp.n
+'/"
+.so man.macros
+.HS hyperhelp iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+hyperhelp \- Create and manipulate a hyperhelp widget
+.SH SYNOPSIS
+\fBhyperhelp\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Toplevel <- shell <- hyperhelp
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 5c 10c
+\fBactiveBackground\fR \fBbackground\fR \fBborderWidth\fR
+\fBclosecmd\fR \fBcursor\fR \fBexportSelection\fR
+\fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR
+\fBinsertBackground\fR \fBinsertBorderWidth \fBinsertOffTime\fR
+\fBinsertOnTime\fR \fBinsertWidth\fR \fBpadX\fR
+\fBpadY\fR \fBrelief\fR \fBrepeatDelay\fR
+\fBrepeatInterval\fR \fBselectBackground\fR \fBselectBorderWidth\fR
+\fBselectForeground\fR \fBsetGrid\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBhscrollmode\fR \fBvscrollmode\fR \fBtextbackground\fR \fBfontname\fR
+\fBfontsize\fR \fBfixedfont\fR \fBlink\fR \fBlinkhighlight\fR
+\fBwidth\fR \fBheight\fR \fBstate\fR \fBwrap\fR
+\fBunknownimage\fR
+.fi
+.LP
+See the "scrolledhtml" widget manual entry for details on the above
+associated options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBmodality\fR \fBtitle\fR
+.fi
+.LP
+See the "shell" manual entry for details on the above inherited options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBtopics\fR
+Class: \fBTopics\fR
+Command-Line Switch: \fB-topics\fR
+.fi
+.IP
+Specifies a list of help topics in the form {?\fItopic\fR? ... }. \fITopic\fR
+may either be a topic name, in which case the
+document associated with the topic should be in the file
+\fBhelpdir\fR/\fItopic\fR.html, or it may be of the form
+{\fIname\fR \fIfile\fR}. In the latter case, \fIname\fR is displayed in the
+topic menu, and selecting the name loads \fIfile\fR. If file has a relative
+path, it is assumed to be relative to helpdir.
+.LP
+.nf
+Name: \fBhelpdir\fR
+Class: \fBDirectory\fR
+Command-Line Switch: \fB-helpdir\fR
+.fi
+.IP
+Specifies the directory where help files are located.
+.LP
+.nf
+Name: \fBcloseCmd\fR
+Class: \fBCloseCmd\fR
+Command-Line Switch: \fB-closecmd\fR
+.fi
+.IP
+Specifies the tcl command to be executed when the close option is selected
+from the topics menu.
+.LP
+.nf
+Name: \fBmaxHistory\fR
+Class: \fBMaxHistory\fR
+Command-Line Switch: \fB-maxhistory\fR
+.fi
+.IP
+Specifies the maximum number of entries stored in the history list
+.LP
+.nf
+Name: \fBbeforelink\fR
+Class: \fBBeforeLink\fR
+Command-Line Switch: \fB-beforelink\fR
+.fi
+.IP
+Specifies a command to be eval'ed before a new link is displayed. The path
+of the link to be displayed is appended before evaling the command. A suggested
+use might be to busy the widget while a new page is being displayed.
+.LP
+.nf
+Name: \fBafterlink\fR
+Class: \fBAfterLink\fR
+Command-Line Switch: \fB-afterlink\fR
+.fi
+.IP
+Specifies a command to be eval'ed after a new link is completely displayed.
+The path of the link that was displayed is appended before evaling the command.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBhyperhelp\fR command creates a shell window with a pulldown menu
+showing a list of topics. The topics are displayed by importing a HTML
+formatted file named \fBhelpdir\fR/\fItopic\fR.html. For a list of
+supported HTML tags, see \fBscrolledhtml(n)\fR.
+
+.SH "METHODS"
+.PP
+The \fBhyperhelp\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for dialog widgets:
+.SH "INHERITED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactivate\fR \fBcenter\fR \fBchildsite\fR \fBdeactivate\fR
+.fi
+.LP
+See the "shell" manual entry for details on the above inherited methods.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBhyperhelp\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBhyperhelp\fR
+command.
+.TP
+\fIpathName\fR \fBshowtopic\fR \fItopic\fR
+Display html file \fBhelpdir\fR/\fItopic\fR.html. \fITopic\fR may
+optionally be of the form \fItopicname\fR#\fIanchorname\fR. In
+this form, either \fItopicname\fR or \fIanchorname\fR or both may be empty. If
+\fItopicname\fR is empty, the current topic is assumed. If \fIanchorname\fR
+is empty, the top of the document is assumed
+.TP
+\fIpathName\fR \fBfollowlink\fR \fIhref\fR
+Display html file \fIhref\fR. \fIHref\fR may
+be optionally be of the form \fIfilename\fR#\fIanchorname\fR. In
+this form, either \fIfilename\fR or \fIanchorname\fR or both may be empty. If
+\fIfilename\fR is empty, the current document is assumed. If \fIanchorname\fR
+is empty, the top of the document is assumed.
+.TP
+\fIpathName\fR \fBforward\fR
+Display html file one forward in history list, if applicable.
+.TP
+\fIpathName\fR \fBback\fR
+Display html file one back in history list, if applicable.
+
+.SH EXAMPLE
+.DS
+ hyperhelp .h -topics { Intro Help } -helpdir ~/help
+ .h showtopic Intro
+
+.DE
+.SH AUTHOR
+Kris Raney
+.SH KEYWORDS
+hyperhelp, html, help, shell, widget
diff --git a/itcl/iwidgets3.0.0/doc/iwidgets.ps b/itcl/iwidgets3.0.0/doc/iwidgets.ps
new file mode 100644
index 00000000000..4880e2e0355
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/iwidgets.ps
@@ -0,0 +1,13149 @@
+%!PS-Adobe-3.0
+%%BoundingBox: (atend)
+%%Pages: (atend)
+%%PageOrder: (atend)
+%%DocumentFonts: (atend)
+%%Creator: Frame 4.0
+%%DocumentData: Clean7Bit
+%%EndComments
+%%BeginProlog
+%
+% Frame ps_prolog 4.0, for use with Frame 4.0 products
+% This ps_prolog file is Copyright (c) 1986-1993 Frame Technology
+% Corporation. All rights reserved. This ps_prolog file may be
+% freely copied and distributed in conjunction with documents created
+% using FrameMaker, FrameBuilder and FrameViewer as long as this
+% copyright notice is preserved.
+%
+% Frame products normally print colors as their true color on a color printer
+% or as shades of gray, based on luminance, on a black-and white printer. The
+% following flag, if set to True, forces all non-white colors to print as pure
+% black. This has no effect on bitmap images.
+/FMPrintAllColorsAsBlack true def
+%
+% Frame products can either set their own line screens or use a printer's
+% default settings. Three flags below control this separately for no
+% separations, spot separations and process separations. If a flag
+% is true, then the default printer settings will not be changed. If it is
+% false, Frame products will use their own settings from a table based on
+% the printer's resolution.
+/FMUseDefaultNoSeparationScreen true def
+/FMUseDefaultSpotSeparationScreen true def
+/FMUseDefaultProcessSeparationScreen false def
+%
+% For any given PostScript printer resolution, Frame products have two sets of
+% screen angles and frequencies for printing process separations, which are
+% recomended by Adobe. The following variable chooses the higher frequencies
+% when set to true or the lower frequencies when set to false. This is only
+% effective if the appropriate FMUseDefault...SeparationScreen flag is false.
+/FMUseHighFrequencyScreens true def
+%
+% PostScript Level 2 printers contain an "Accurate Screens" feature which can
+% improve process separation rendering at the expense of compute time. This
+% flag is ignored by PostScript Level 1 printers.
+/FMUseAcccurateScreens true def
+%
+% The following PostScript procedure defines the spot function that Frame
+% products will use for process separations. You may un-comment-out one of
+% the alternative functions below, or use your own.
+%
+% Dot function
+/FMSpotFunction {abs exch abs 2 copy add 1 gt
+ {1 sub dup mul exch 1 sub dup mul add 1 sub }
+ {dup mul exch dup mul add 1 exch sub }ifelse } def
+%
+% Line function
+% /FMSpotFunction { pop } def
+%
+% Elipse function
+% /FMSpotFunction { dup 5 mul 8 div mul exch dup mul exch add
+% sqrt 1 exch sub } def
+%
+%
+/FMversion (4.0) def
+/FMLevel1 /languagelevel where {pop languagelevel} {1} ifelse 2 lt def
+/FMPColor
+ FMLevel1 {
+ false
+ /colorimage where {pop pop true} if
+ } {
+ true
+ } ifelse
+def
+/FrameDict 400 dict def
+systemdict /errordict known not {/errordict 10 dict def
+ errordict /rangecheck {stop} put} if
+% The readline in PS 23.0 doesn't recognize cr's as nl's on AppleTalk
+FrameDict /tmprangecheck errordict /rangecheck get put
+errordict /rangecheck {FrameDict /bug true put} put
+FrameDict /bug false put
+mark
+% Some PS machines read past the CR, so keep the following 3 lines together!
+currentfile 5 string readline
+00
+0000000000
+cleartomark
+errordict /rangecheck FrameDict /tmprangecheck get put
+FrameDict /bug get {
+ /readline {
+ /gstring exch def
+ /gfile exch def
+ /gindex 0 def
+ {
+ gfile read pop
+ dup 10 eq {exit} if
+ dup 13 eq {exit} if
+ gstring exch gindex exch put
+ /gindex gindex 1 add def
+ } loop
+ pop
+ gstring 0 gindex getinterval true
+ } bind def
+ } if
+/FMshowpage /showpage load def
+/FMquit /quit load def
+/FMFAILURE {
+ dup = flush
+ FMshowpage
+ /Helvetica findfont 12 scalefont setfont
+ 72 200 moveto
+ show FMshowpage
+ FMquit
+ } def
+/FMVERSION {
+ FMversion ne {
+ (Frame product version does not match ps_prolog!) FMFAILURE
+ } if
+ } def
+/FMBADEPSF {
+ (PostScript Lang. Ref. Man., 2nd Ed., H.2.4 says EPS must not call X )
+ dup dup (X) search pop exch pop exch pop length
+ 4 -1 roll
+ putinterval
+ FMFAILURE
+ } def
+/FMLOCAL {
+ FrameDict begin
+ 0 def
+ end
+ } def
+/concatprocs
+ {
+ /proc2 exch cvlit def/proc1 exch cvlit def/newproc proc1 length proc2 length add array def
+ newproc 0 proc1 putinterval newproc proc1 length proc2 putinterval newproc cvx
+}def
+FrameDict begin
+/FMnone 0 def
+/FMcyan 1 def
+/FMmagenta 2 def
+/FMyellow 3 def
+/FMblack 4 def
+/FMcustom 5 def
+/FrameNegative false def
+/FrameSepIs FMnone def
+/FrameSepBlack 0 def
+/FrameSepYellow 0 def
+/FrameSepMagenta 0 def
+/FrameSepCyan 0 def
+/FrameSepRed 1 def
+/FrameSepGreen 1 def
+/FrameSepBlue 1 def
+/FrameCurGray 1 def
+/FrameCurPat null def
+/FrameCurColors [ 0 0 0 1 0 0 0 ] def
+/FrameColorEpsilon .001 def
+/eqepsilon {
+ sub dup 0 lt {neg} if
+ FrameColorEpsilon le
+} bind def
+/FrameCmpColorsCMYK {
+ 2 copy 0 get exch 0 get eqepsilon {
+ 2 copy 1 get exch 1 get eqepsilon {
+ 2 copy 2 get exch 2 get eqepsilon {
+ 3 get exch 3 get eqepsilon
+ } {pop pop false} ifelse
+ }{pop pop false} ifelse
+ } {pop pop false} ifelse
+} bind def
+/FrameCmpColorsRGB {
+ 2 copy 4 get exch 0 get eqepsilon {
+ 2 copy 5 get exch 1 get eqepsilon {
+ 6 get exch 2 get eqepsilon
+ }{pop pop false} ifelse
+ } {pop pop false} ifelse
+} bind def
+/RGBtoCMYK {
+ 1 exch sub
+ 3 1 roll
+ 1 exch sub
+ 3 1 roll
+ 1 exch sub
+ 3 1 roll
+ 3 copy
+ 2 copy
+ le { pop } { exch pop } ifelse
+ 2 copy
+ le { pop } { exch pop } ifelse
+ dup dup dup
+ 6 1 roll
+ 4 1 roll
+ 7 1 roll
+ sub
+ 6 1 roll
+ sub
+ 5 1 roll
+ sub
+ 4 1 roll
+} bind def
+/CMYKtoRGB {
+ dup dup 4 -1 roll add
+ 5 1 roll 3 -1 roll add
+ 4 1 roll add
+ 1 exch sub dup 0 lt {pop 0} if 3 1 roll
+ 1 exch sub dup 0 lt {pop 0} if exch
+ 1 exch sub dup 0 lt {pop 0} if exch
+} bind def
+/FrameSepInit {
+ 1.0 RealSetgray
+} bind def
+/FrameSetSepColor {
+ /FrameSepBlue exch def
+ /FrameSepGreen exch def
+ /FrameSepRed exch def
+ /FrameSepBlack exch def
+ /FrameSepYellow exch def
+ /FrameSepMagenta exch def
+ /FrameSepCyan exch def
+ /FrameSepIs FMcustom def
+ setCurrentScreen
+} bind def
+/FrameSetCyan {
+ /FrameSepBlue 1.0 def
+ /FrameSepGreen 1.0 def
+ /FrameSepRed 0.0 def
+ /FrameSepBlack 0.0 def
+ /FrameSepYellow 0.0 def
+ /FrameSepMagenta 0.0 def
+ /FrameSepCyan 1.0 def
+ /FrameSepIs FMcyan def
+ setCurrentScreen
+} bind def
+
+/FrameSetMagenta {
+ /FrameSepBlue 1.0 def
+ /FrameSepGreen 0.0 def
+ /FrameSepRed 1.0 def
+ /FrameSepBlack 0.0 def
+ /FrameSepYellow 0.0 def
+ /FrameSepMagenta 1.0 def
+ /FrameSepCyan 0.0 def
+ /FrameSepIs FMmagenta def
+ setCurrentScreen
+} bind def
+
+/FrameSetYellow {
+ /FrameSepBlue 0.0 def
+ /FrameSepGreen 1.0 def
+ /FrameSepRed 1.0 def
+ /FrameSepBlack 0.0 def
+ /FrameSepYellow 1.0 def
+ /FrameSepMagenta 0.0 def
+ /FrameSepCyan 0.0 def
+ /FrameSepIs FMyellow def
+ setCurrentScreen
+} bind def
+
+/FrameSetBlack {
+ /FrameSepBlue 0.0 def
+ /FrameSepGreen 0.0 def
+ /FrameSepRed 0.0 def
+ /FrameSepBlack 1.0 def
+ /FrameSepYellow 0.0 def
+ /FrameSepMagenta 0.0 def
+ /FrameSepCyan 0.0 def
+ /FrameSepIs FMblack def
+ setCurrentScreen
+} bind def
+
+/FrameNoSep {
+ /FrameSepIs FMnone def
+ setCurrentScreen
+} bind def
+/FrameSetSepColors {
+ FrameDict begin
+ [ exch 1 add 1 roll ]
+ /FrameSepColors
+ exch def end
+ } bind def
+/FrameColorInSepListCMYK {
+ FrameSepColors {
+ exch dup 3 -1 roll
+ FrameCmpColorsCMYK
+ { pop true exit } if
+ } forall
+ dup true ne {pop false} if
+ } bind def
+/FrameColorInSepListRGB {
+ FrameSepColors {
+ exch dup 3 -1 roll
+ FrameCmpColorsRGB
+ { pop true exit } if
+ } forall
+ dup true ne {pop false} if
+ } bind def
+/RealSetgray /setgray load def
+/RealSetrgbcolor /setrgbcolor load def
+/RealSethsbcolor /sethsbcolor load def
+end
+/setgray {
+ FrameDict begin
+ FrameSepIs FMnone eq
+ { RealSetgray }
+ {
+ FrameSepIs FMblack eq
+ { RealSetgray }
+ { FrameSepIs FMcustom eq
+ FrameSepRed 0 eq and
+ FrameSepGreen 0 eq and
+ FrameSepBlue 0 eq and {
+ RealSetgray
+ } {
+ 1 RealSetgray pop
+ } ifelse
+ } ifelse
+ } ifelse
+ end
+} bind def
+/setrgbcolor {
+ FrameDict begin
+ FrameSepIs FMnone eq
+ { RealSetrgbcolor }
+ {
+ 3 copy [ 4 1 roll ]
+ FrameColorInSepListRGB
+ {
+ FrameSepBlue eq exch
+ FrameSepGreen eq and exch
+ FrameSepRed eq and
+ { 0 } { 1 } ifelse
+ }
+ {
+ FMPColor {
+ RealSetrgbcolor
+ currentcmykcolor
+ } {
+ RGBtoCMYK
+ } ifelse
+ FrameSepIs FMblack eq
+ {1.0 exch sub 4 1 roll pop pop pop} {
+ FrameSepIs FMyellow eq
+ {pop 1.0 exch sub 3 1 roll pop pop} {
+ FrameSepIs FMmagenta eq
+ {pop pop 1.0 exch sub exch pop } {
+ FrameSepIs FMcyan eq
+ {pop pop pop 1.0 exch sub }
+ {pop pop pop pop 1} ifelse } ifelse } ifelse } ifelse
+ } ifelse
+ RealSetgray
+ }
+ ifelse
+ end
+} bind def
+/sethsbcolor {
+ FrameDict begin
+ FrameSepIs FMnone eq
+ { RealSethsbcolor }
+ {
+ RealSethsbcolor
+ currentrgbcolor
+ setrgbcolor
+ }
+ ifelse
+ end
+} bind def
+FrameDict begin
+/setcmykcolor where {
+ pop /RealSetcmykcolor /setcmykcolor load def
+} {
+ /RealSetcmykcolor {
+ 4 1 roll
+ 3 { 3 index add 0 max 1 min 1 exch sub 3 1 roll} repeat
+ setrgbcolor pop
+ } bind def
+} ifelse
+userdict /setcmykcolor {
+ FrameDict begin
+ FrameSepIs FMnone eq
+ { RealSetcmykcolor }
+ {
+ 4 copy [ 5 1 roll ]
+ FrameColorInSepListCMYK
+ {
+ FrameSepBlack eq exch
+ FrameSepYellow eq and exch
+ FrameSepMagenta eq and exch
+ FrameSepCyan eq and
+ { 0 } { 1 } ifelse
+ }
+ {
+ FrameSepIs FMblack eq
+ {1.0 exch sub 4 1 roll pop pop pop} {
+ FrameSepIs FMyellow eq
+ {pop 1.0 exch sub 3 1 roll pop pop} {
+ FrameSepIs FMmagenta eq
+ {pop pop 1.0 exch sub exch pop } {
+ FrameSepIs FMcyan eq
+ {pop pop pop 1.0 exch sub }
+ {pop pop pop pop 1} ifelse } ifelse } ifelse } ifelse
+ } ifelse
+ RealSetgray
+ }
+ ifelse
+ end
+ } bind put
+FMLevel1 not {
+
+ /patProcDict 5 dict dup begin
+ <0f1e3c78f0e1c387> { 3 setlinewidth -1 -1 moveto 9 9 lineto stroke
+ 4 -4 moveto 12 4 lineto stroke
+ -4 4 moveto 4 12 lineto stroke} bind def
+ <0f87c3e1f0783c1e> { 3 setlinewidth -1 9 moveto 9 -1 lineto stroke
+ -4 4 moveto 4 -4 lineto stroke
+ 4 12 moveto 12 4 lineto stroke} bind def
+ <8142241818244281> { 1 setlinewidth -1 9 moveto 9 -1 lineto stroke
+ -1 -1 moveto 9 9 lineto stroke } bind def
+ <03060c183060c081> { 1 setlinewidth -1 -1 moveto 9 9 lineto stroke
+ 4 -4 moveto 12 4 lineto stroke
+ -4 4 moveto 4 12 lineto stroke} bind def
+ <8040201008040201> { 1 setlinewidth -1 9 moveto 9 -1 lineto stroke
+ -4 4 moveto 4 -4 lineto stroke
+ 4 12 moveto 12 4 lineto stroke} bind def
+ end def
+ /patDict 15 dict dup begin
+ /PatternType 1 def
+ /PaintType 2 def
+ /TilingType 3 def
+ /BBox [ 0 0 8 8 ] def
+ /XStep 8 def
+ /YStep 8 def
+ /PaintProc {
+ begin
+ patProcDict bstring known {
+ patProcDict bstring get exec
+ } {
+ 8 8 true [1 0 0 -1 0 8] bstring imagemask
+ } ifelse
+ end
+ } bind def
+ end def
+} if
+/combineColor {
+ FrameSepIs FMnone eq
+ {
+ graymode FMLevel1 or not {
+
+ [/Pattern [/DeviceCMYK]] setcolorspace
+ FrameCurColors 0 4 getinterval aload pop FrameCurPat setcolor
+ } {
+ FrameCurColors 3 get 1.0 ge {
+ FrameCurGray RealSetgray
+ } {
+ FMPColor graymode and {
+ 0 1 3 {
+ FrameCurColors exch get
+ 1 FrameCurGray sub mul
+ } for
+ RealSetcmykcolor
+ } {
+ 4 1 6 {
+ FrameCurColors exch get
+ graymode {
+ 1 exch sub 1 FrameCurGray sub mul 1 exch sub
+ } {
+ 1.0 lt {FrameCurGray} {1} ifelse
+ } ifelse
+ } for
+ RealSetrgbcolor
+ } ifelse
+ } ifelse
+ } ifelse
+ } {
+ FrameCurColors 0 4 getinterval aload
+ FrameColorInSepListCMYK {
+ FrameSepBlack eq exch
+ FrameSepYellow eq and exch
+ FrameSepMagenta eq and exch
+ FrameSepCyan eq and
+ FrameSepIs FMcustom eq and
+ { FrameCurGray } { 1 } ifelse
+ } {
+ FrameSepIs FMblack eq
+ {FrameCurGray 1.0 exch sub mul 1.0 exch sub 4 1 roll pop pop pop} {
+ FrameSepIs FMyellow eq
+ {pop FrameCurGray 1.0 exch sub mul 1.0 exch sub 3 1 roll pop pop} {
+ FrameSepIs FMmagenta eq
+ {pop pop FrameCurGray 1.0 exch sub mul 1.0 exch sub exch pop } {
+ FrameSepIs FMcyan eq
+ {pop pop pop FrameCurGray 1.0 exch sub mul 1.0 exch sub }
+ {pop pop pop pop 1} ifelse } ifelse } ifelse } ifelse
+ } ifelse
+ graymode FMLevel1 or not {
+
+ [/Pattern [/DeviceGray]] setcolorspace
+ FrameCurPat setcolor
+ } {
+ graymode not FMLevel1 and {
+
+ dup 1 lt {pop FrameCurGray} if
+ } if
+ RealSetgray
+ } ifelse
+ } ifelse
+} bind def
+/savematrix {
+ orgmatrix currentmatrix pop
+ } bind def
+/restorematrix {
+ orgmatrix setmatrix
+ } bind def
+/dmatrix matrix def
+/dpi 72 0 dmatrix defaultmatrix dtransform
+ dup mul exch dup mul add sqrt def
+
+/freq dpi dup 72 div round dup 0 eq {pop 1} if 8 mul div def
+/sangle 1 0 dmatrix defaultmatrix dtransform exch atan def
+/dpiranges [ 2540 2400 1693 1270 1200 635 600 0 ] def
+/CMLowFreqs [ 100.402 94.8683 89.2289 100.402 94.8683 66.9349 63.2456 47.4342 ] def
+/YLowFreqs [ 95.25 90.0 84.65 95.25 90.0 70.5556 66.6667 50.0 ] def
+/KLowFreqs [ 89.8026 84.8528 79.8088 89.8026 84.8528 74.8355 70.7107 53.033 ] def
+/CLowAngles [ 71.5651 71.5651 71.5651 71.5651 71.5651 71.5651 71.5651 71.5651 ] def
+/MLowAngles [ 18.4349 18.4349 18.4349 18.4349 18.4349 18.4349 18.4349 18.4349 ] def
+/YLowTDot [ true true false true true false false false ] def
+/CMHighFreqs [ 133.87 126.491 133.843 108.503 102.523 100.402 94.8683 63.2456 ] def
+/YHighFreqs [ 127.0 120.0 126.975 115.455 109.091 95.25 90.0 60.0 ] def
+/KHighFreqs [ 119.737 113.137 119.713 128.289 121.218 89.8026 84.8528 63.6395 ] def
+/CHighAngles [ 71.5651 71.5651 71.5651 70.0169 70.0169 71.5651 71.5651 71.5651 ] def
+/MHighAngles [ 18.4349 18.4349 18.4349 19.9831 19.9831 18.4349 18.4349 18.4349 ] def
+/YHighTDot [ false false true false false true true false ] def
+/PatFreq [ 10.5833 10.0 9.4055 10.5833 10.0 10.5833 10.0 9.375 ] def
+/screenIndex {
+ 0 1 dpiranges length 1 sub { dup dpiranges exch get 1 sub dpi le {exit} {pop} ifelse } for
+} bind def
+/getCyanScreen {
+ FMUseHighFrequencyScreens { CHighAngles CMHighFreqs} {CLowAngles CMLowFreqs} ifelse
+ screenIndex dup 3 1 roll get 3 1 roll get /FMSpotFunction load
+} bind def
+/getMagentaScreen {
+ FMUseHighFrequencyScreens { MHighAngles CMHighFreqs } {MLowAngles CMLowFreqs} ifelse
+ screenIndex dup 3 1 roll get 3 1 roll get /FMSpotFunction load
+} bind def
+/getYellowScreen {
+ FMUseHighFrequencyScreens { YHighTDot YHighFreqs} { YLowTDot YLowFreqs } ifelse
+ screenIndex dup 3 1 roll get 3 1 roll get { 3 div
+ {2 { 1 add 2 div 3 mul dup floor sub 2 mul 1 sub exch} repeat
+ FMSpotFunction } } {/FMSpotFunction load } ifelse
+ 0.0 exch
+} bind def
+/getBlackScreen {
+ FMUseHighFrequencyScreens { KHighFreqs } { KLowFreqs } ifelse
+ screenIndex get 45.0 /FMSpotFunction load
+} bind def
+/getSpotScreen {
+ getBlackScreen
+} bind def
+/getCompositeScreen {
+ getBlackScreen
+} bind def
+/FMSetScreen
+ FMLevel1 { /setscreen load
+ }{ {
+ 8 dict begin
+ /HalftoneType 1 def
+ /SpotFunction exch def
+ /Angle exch def
+ /Frequency exch def
+ /AccurateScreens FMUseAcccurateScreens def
+ currentdict end sethalftone
+ } bind } ifelse
+def
+/setDefaultScreen {
+ FMPColor {
+ orgrxfer cvx orggxfer cvx orgbxfer cvx orgxfer cvx setcolortransfer
+ }
+ {
+ orgxfer cvx settransfer
+ } ifelse
+ orgfreq organgle orgproc cvx setscreen
+} bind def
+/setCurrentScreen {
+ FrameSepIs FMnone eq {
+ FMUseDefaultNoSeparationScreen {
+ setDefaultScreen
+ } {
+ getCompositeScreen FMSetScreen
+ } ifelse
+ } {
+ FrameSepIs FMcustom eq {
+ FMUseDefaultSpotSeparationScreen {
+ setDefaultScreen
+ } {
+ getSpotScreen FMSetScreen
+ } ifelse
+ } {
+ FMUseDefaultProcessSeparationScreen {
+ setDefaultScreen
+ } {
+ FrameSepIs FMcyan eq {
+ getCyanScreen FMSetScreen
+ } {
+ FrameSepIs FMmagenta eq {
+ getMagentaScreen FMSetScreen
+ } {
+ FrameSepIs FMyellow eq {
+ getYellowScreen FMSetScreen
+ } {
+ getBlackScreen FMSetScreen
+ } ifelse
+ } ifelse
+ } ifelse
+ } ifelse
+ } ifelse
+ } ifelse
+} bind def
+end
+ /gstring FMLOCAL
+ /gfile FMLOCAL
+ /gindex FMLOCAL
+ /orgrxfer FMLOCAL
+ /orggxfer FMLOCAL
+ /orgbxfer FMLOCAL
+ /orgxfer FMLOCAL
+ /orgproc FMLOCAL
+ /orgrproc FMLOCAL
+ /orggproc FMLOCAL
+ /orgbproc FMLOCAL
+ /organgle FMLOCAL
+ /orgrangle FMLOCAL
+ /orggangle FMLOCAL
+ /orgbangle FMLOCAL
+ /orgfreq FMLOCAL
+ /orgrfreq FMLOCAL
+ /orggfreq FMLOCAL
+ /orgbfreq FMLOCAL
+ /yscale FMLOCAL
+ /xscale FMLOCAL
+ /edown FMLOCAL
+ /manualfeed FMLOCAL
+ /paperheight FMLOCAL
+ /paperwidth FMLOCAL
+/FMDOCUMENT {
+ array /FMfonts exch def
+ /#copies exch def
+ FrameDict begin
+ 0 ne /manualfeed exch def
+ /paperheight exch def
+ /paperwidth exch def
+ 0 ne /FrameNegative exch def
+ 0 ne /edown exch def
+ /yscale exch def
+ /xscale exch def
+ FMLevel1 {
+ manualfeed {setmanualfeed} if
+ /FMdicttop countdictstack 1 add def
+ /FMoptop count def
+ setpapername
+ manualfeed {true} {papersize} ifelse
+ {manualpapersize} {false} ifelse
+ {desperatepapersize} {false} ifelse
+ { (Can't select requested paper size for Frame print job!) FMFAILURE } if
+ count -1 FMoptop {pop pop} for
+ countdictstack -1 FMdicttop {pop end} for
+ }
+ {{1 dict dup /PageSize [paperwidth paperheight]put setpagedevice}stopped
+ { (Can't select requested paper size for Frame print job!) FMFAILURE } if
+ {1 dict dup /ManualFeed manualfeed put setpagedevice } stopped pop }
+ ifelse
+
+ FMPColor {
+ currentcolorscreen
+ cvlit /orgproc exch def
+ /organgle exch def
+ /orgfreq exch def
+ cvlit /orgbproc exch def
+ /orgbangle exch def
+ /orgbfreq exch def
+ cvlit /orggproc exch def
+ /orggangle exch def
+ /orggfreq exch def
+ cvlit /orgrproc exch def
+ /orgrangle exch def
+ /orgrfreq exch def
+ currentcolortransfer
+ FrameNegative {
+ 1 1 4 {
+ pop { 1 exch sub } concatprocs 4 1 roll
+ } for
+ 4 copy
+ setcolortransfer
+ } if
+ cvlit /orgxfer exch def
+ cvlit /orgbxfer exch def
+ cvlit /orggxfer exch def
+ cvlit /orgrxfer exch def
+ } {
+ currentscreen
+ cvlit /orgproc exch def
+ /organgle exch def
+ /orgfreq exch def
+
+ currenttransfer
+ FrameNegative {
+ { 1 exch sub } concatprocs
+ dup settransfer
+ } if
+ cvlit /orgxfer exch def
+ } ifelse
+ end
+} def
+/pagesave FMLOCAL
+/orgmatrix FMLOCAL
+/landscape FMLOCAL
+/pwid FMLOCAL
+/FMBEGINPAGE {
+ FrameDict begin
+ /pagesave save def
+ 3.86 setmiterlimit
+ /landscape exch 0 ne def
+ landscape {
+ 90 rotate 0 exch dup /pwid exch def neg translate pop
+ }{
+ pop /pwid exch def
+ } ifelse
+ edown { [-1 0 0 1 pwid 0] concat } if
+ 0 0 moveto paperwidth 0 lineto paperwidth paperheight lineto
+ 0 paperheight lineto 0 0 lineto 1 setgray fill
+ xscale yscale scale
+ /orgmatrix matrix def
+ gsave
+} def
+/FMENDPAGE {
+ grestore
+ pagesave restore
+ end
+ showpage
+ } def
+/FMFONTDEFINE {
+ FrameDict begin
+ findfont
+ ReEncode
+ 1 index exch
+ definefont
+ FMfonts 3 1 roll
+ put
+ end
+ } def
+/FMFILLS {
+ FrameDict begin dup
+ array /fillvals exch def
+ dict /patCache exch def
+ end
+ } def
+/FMFILL {
+ FrameDict begin
+ fillvals 3 1 roll put
+ end
+ } def
+/FMNORMALIZEGRAPHICS {
+ newpath
+ 0.0 0.0 moveto
+ 1 setlinewidth
+ 0 setlinecap
+ 0 0 0 sethsbcolor
+ 0 setgray
+ } bind def
+ /fx FMLOCAL
+ /fy FMLOCAL
+ /fh FMLOCAL
+ /fw FMLOCAL
+ /llx FMLOCAL
+ /lly FMLOCAL
+ /urx FMLOCAL
+ /ury FMLOCAL
+/FMBEGINEPSF {
+ end
+ /FMEPSF save def
+ /showpage {} def
+% See Adobe's "PostScript Language Reference Manual, 2nd Edition", page 714.
+% "...the following operators MUST NOT be used in an EPS file:" (emphasis ours)
+ /banddevice {(banddevice) FMBADEPSF} def
+ /clear {(clear) FMBADEPSF} def
+ /cleardictstack {(cleardictstack) FMBADEPSF} def
+ /copypage {(copypage) FMBADEPSF} def
+ /erasepage {(erasepage) FMBADEPSF} def
+ /exitserver {(exitserver) FMBADEPSF} def
+ /framedevice {(framedevice) FMBADEPSF} def
+ /grestoreall {(grestoreall) FMBADEPSF} def
+ /initclip {(initclip) FMBADEPSF} def
+ /initgraphics {(initgraphics) FMBADEPSF} def
+ /initmatrix {(initmatrix) FMBADEPSF} def
+ /quit {(quit) FMBADEPSF} def
+ /renderbands {(renderbands) FMBADEPSF} def
+ /setglobal {(setglobal) FMBADEPSF} def
+ /setpagedevice {(setpagedevice) FMBADEPSF} def
+ /setshared {(setshared) FMBADEPSF} def
+ /startjob {(startjob) FMBADEPSF} def
+ /lettertray {(lettertray) FMBADEPSF} def
+ /letter {(letter) FMBADEPSF} def
+ /lettersmall {(lettersmall) FMBADEPSF} def
+ /11x17tray {(11x17tray) FMBADEPSF} def
+ /11x17 {(11x17) FMBADEPSF} def
+ /ledgertray {(ledgertray) FMBADEPSF} def
+ /ledger {(ledger) FMBADEPSF} def
+ /legaltray {(legaltray) FMBADEPSF} def
+ /legal {(legal) FMBADEPSF} def
+ /statementtray {(statementtray) FMBADEPSF} def
+ /statement {(statement) FMBADEPSF} def
+ /executivetray {(executivetray) FMBADEPSF} def
+ /executive {(executive) FMBADEPSF} def
+ /a3tray {(a3tray) FMBADEPSF} def
+ /a3 {(a3) FMBADEPSF} def
+ /a4tray {(a4tray) FMBADEPSF} def
+ /a4 {(a4) FMBADEPSF} def
+ /a4small {(a4small) FMBADEPSF} def
+ /b4tray {(b4tray) FMBADEPSF} def
+ /b4 {(b4) FMBADEPSF} def
+ /b5tray {(b5tray) FMBADEPSF} def
+ /b5 {(b5) FMBADEPSF} def
+ FMNORMALIZEGRAPHICS
+ [/fy /fx /fh /fw /ury /urx /lly /llx] {exch def} forall
+ fx fw 2 div add fy fh 2 div add translate
+ rotate
+ fw 2 div neg fh 2 div neg translate
+ fw urx llx sub div fh ury lly sub div scale
+ llx neg lly neg translate
+ /FMdicttop countdictstack 1 add def
+ /FMoptop count def
+ } bind def
+/FMENDEPSF {
+ count -1 FMoptop {pop pop} for
+ countdictstack -1 FMdicttop {pop end} for
+ FMEPSF restore
+ FrameDict begin
+ } bind def
+FrameDict begin
+/setmanualfeed {
+%%BeginFeature *ManualFeed True
+ statusdict /manualfeed true put
+%%EndFeature
+ } bind def
+/max {2 copy lt {exch} if pop} bind def
+/min {2 copy gt {exch} if pop} bind def
+/inch {72 mul} def
+/pagedimen {
+ paperheight sub abs 16 lt exch
+ paperwidth sub abs 16 lt and
+ {/papername exch def} {pop} ifelse
+ } bind def
+ /papersizedict FMLOCAL
+/setpapername {
+ /papersizedict 14 dict def
+ papersizedict begin
+ /papername /unknown def
+ /Letter 8.5 inch 11.0 inch pagedimen
+ /LetterSmall 7.68 inch 10.16 inch pagedimen
+ /Tabloid 11.0 inch 17.0 inch pagedimen
+ /Ledger 17.0 inch 11.0 inch pagedimen
+ /Legal 8.5 inch 14.0 inch pagedimen
+ /Statement 5.5 inch 8.5 inch pagedimen
+ /Executive 7.5 inch 10.0 inch pagedimen
+ /A3 11.69 inch 16.5 inch pagedimen
+ /A4 8.26 inch 11.69 inch pagedimen
+ /A4Small 7.47 inch 10.85 inch pagedimen
+ /B4 10.125 inch 14.33 inch pagedimen
+ /B5 7.16 inch 10.125 inch pagedimen
+ end
+ } bind def
+/papersize {
+ papersizedict begin
+ /Letter {lettertray letter} def
+ /LetterSmall {lettertray lettersmall} def
+ /Tabloid {11x17tray 11x17} def
+ /Ledger {ledgertray ledger} def
+ /Legal {legaltray legal} def
+ /Statement {statementtray statement} def
+ /Executive {executivetray executive} def
+ /A3 {a3tray a3} def
+ /A4 {a4tray a4} def
+ /A4Small {a4tray a4small} def
+ /B4 {b4tray b4} def
+ /B5 {b5tray b5} def
+ /unknown {unknown} def
+ papersizedict dup papername known {papername} {/unknown} ifelse get
+ end
+ statusdict begin stopped end
+ } bind def
+/manualpapersize {
+ papersizedict begin
+ /Letter {letter} def
+ /LetterSmall {lettersmall} def
+ /Tabloid {11x17} def
+ /Ledger {ledger} def
+ /Legal {legal} def
+ /Statement {statement} def
+ /Executive {executive} def
+ /A3 {a3} def
+ /A4 {a4} def
+ /A4Small {a4small} def
+ /B4 {b4} def
+ /B5 {b5} def
+ /unknown {unknown} def
+ papersizedict dup papername known {papername} {/unknown} ifelse get
+ end
+ stopped
+ } bind def
+/desperatepapersize {
+ statusdict /setpageparams known
+ {
+ paperwidth paperheight 0 1
+ statusdict begin
+ {setpageparams} stopped
+ end
+ } {true} ifelse
+ } bind def
+/DiacriticEncoding [
+/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
+/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
+/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
+/.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
+/.notdef /.notdef /.notdef /.notdef /space /exclam /quotedbl
+/numbersign /dollar /percent /ampersand /quotesingle /parenleft
+/parenright /asterisk /plus /comma /hyphen /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 /grave /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 /.notdef /Adieresis /Aring /Ccedilla /Eacute
+/Ntilde /Odieresis /Udieresis /aacute /agrave /acircumflex /adieresis
+/atilde /aring /ccedilla /eacute /egrave /ecircumflex /edieresis
+/iacute /igrave /icircumflex /idieresis /ntilde /oacute /ograve
+/ocircumflex /odieresis /otilde /uacute /ugrave /ucircumflex
+/udieresis /dagger /.notdef /cent /sterling /section /bullet
+/paragraph /germandbls /registered /copyright /trademark /acute
+/dieresis /.notdef /AE /Oslash /.notdef /.notdef /.notdef /.notdef
+/yen /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
+/ordfeminine /ordmasculine /.notdef /ae /oslash /questiondown
+/exclamdown /logicalnot /.notdef /florin /.notdef /.notdef
+/guillemotleft /guillemotright /ellipsis /.notdef /Agrave /Atilde
+/Otilde /OE /oe /endash /emdash /quotedblleft /quotedblright
+/quoteleft /quoteright /.notdef /.notdef /ydieresis /Ydieresis
+/fraction /currency /guilsinglleft /guilsinglright /fi /fl /daggerdbl
+/periodcentered /quotesinglbase /quotedblbase /perthousand
+/Acircumflex /Ecircumflex /Aacute /Edieresis /Egrave /Iacute
+/Icircumflex /Idieresis /Igrave /Oacute /Ocircumflex /.notdef /Ograve
+/Uacute /Ucircumflex /Ugrave /dotlessi /circumflex /tilde /macron
+/breve /dotaccent /ring /cedilla /hungarumlaut /ogonek /caron
+] def
+/ReEncode {
+ dup
+ length
+ dict begin
+ {
+ 1 index /FID ne
+ {def}
+ {pop pop} ifelse
+ } forall
+ 0 eq {/Encoding DiacriticEncoding def} if
+ currentdict
+ end
+ } bind def
+FMPColor
+
+ {
+ /BEGINBITMAPCOLOR {
+ BITMAPCOLOR} def
+ /BEGINBITMAPCOLORc {
+ BITMAPGRAYc} def
+ /BEGINBITMAPTRUECOLOR {
+ BITMAPTRUECOLOR } def
+ /BEGINBITMAPTRUECOLORc {
+ BITMAPTRUECOLORc } def
+ }
+
+ {
+ /BEGINBITMAPCOLOR {
+ BITMAPGRAY} def
+ /BEGINBITMAPCOLORc {
+ BITMAPGRAYc} def
+ /BEGINBITMAPTRUECOLOR {
+ BITMAPTRUEGRAY } def
+ /BEGINBITMAPTRUECOLORc {
+ BITMAPTRUEGRAYc } def
+ }
+ifelse
+/K {
+ FMPrintAllColorsAsBlack {
+ dup 1 eq 2 index 1 eq and 3 index 1 eq and not
+ {7 {pop} repeat 0 0 0 1 0 0 0} if
+ } if
+ FrameCurColors astore
+ pop combineColor
+} bind def
+/graymode true def
+ /bwidth FMLOCAL
+ /bpside FMLOCAL
+ /bstring FMLOCAL
+ /onbits FMLOCAL
+ /offbits FMLOCAL
+ /xindex FMLOCAL
+ /yindex FMLOCAL
+ /x FMLOCAL
+ /y FMLOCAL
+/setPatternMode {
+ FMLevel1 {
+ /bwidth exch def
+ /bpside exch def
+ /bstring exch def
+ /onbits 0 def /offbits 0 def
+ freq sangle landscape {90 add} if
+ {/y exch def
+ /x exch def
+ /xindex x 1 add 2 div bpside mul cvi def
+ /yindex y 1 add 2 div bpside mul cvi def
+ bstring yindex bwidth mul xindex 8 idiv add get
+ 1 7 xindex 8 mod sub bitshift and 0 ne FrameNegative {not} if
+ {/onbits onbits 1 add def 1}
+ {/offbits offbits 1 add def 0}
+ ifelse
+ }
+ setscreen
+ offbits offbits onbits add div FrameNegative {1.0 exch sub} if
+ /FrameCurGray exch def
+ } {
+ pop pop
+ dup patCache exch known {
+ patCache exch get
+ } {
+ dup
+ patDict /bstring 3 -1 roll put
+ patDict
+ 9 PatFreq screenIndex get div dup matrix scale
+ makepattern
+ dup
+ patCache 4 -1 roll 3 -1 roll put
+ } ifelse
+ /FrameCurGray 0 def
+ /FrameCurPat exch def
+ } ifelse
+ /graymode false def
+ combineColor
+} bind def
+/setGrayScaleMode {
+ graymode not {
+ /graymode true def
+ FMLevel1 {
+ setCurrentScreen
+ } if
+ } if
+ /FrameCurGray exch def
+ combineColor
+} bind def
+/normalize {
+ transform round exch round exch itransform
+ } bind def
+/dnormalize {
+ dtransform round exch round exch idtransform
+ } bind def
+/lnormalize {
+ 0 dtransform exch cvi 2 idiv 2 mul 1 add exch idtransform pop
+ } bind def
+/H {
+ lnormalize setlinewidth
+ } bind def
+/Z {
+ setlinecap
+ } bind def
+
+/PFill {
+ graymode FMLevel1 or not {
+ gsave 1 setgray eofill grestore
+ } if
+} bind def
+/PStroke {
+ graymode FMLevel1 or not {
+ gsave 1 setgray stroke grestore
+ } if
+ stroke
+} bind def
+ /fillvals FMLOCAL
+/X {
+ fillvals exch get
+ dup type /stringtype eq
+ {8 1 setPatternMode}
+ {setGrayScaleMode}
+ ifelse
+ } bind def
+/V {
+ PFill gsave eofill grestore
+ } bind def
+/Vclip {
+ clip
+ } bind def
+/Vstrk {
+ currentlinewidth exch setlinewidth PStroke setlinewidth
+ } bind def
+/N {
+ PStroke
+ } bind def
+/Nclip {
+ strokepath clip newpath
+ } bind def
+/Nstrk {
+ currentlinewidth exch setlinewidth PStroke setlinewidth
+ } bind def
+/M {newpath moveto} bind def
+/E {lineto} bind def
+/D {curveto} bind def
+/O {closepath} bind def
+ /n FMLOCAL
+/L {
+ /n exch def
+ newpath
+ normalize
+ moveto
+ 2 1 n {pop normalize lineto} for
+ } bind def
+/Y {
+ L
+ closepath
+ } bind def
+ /x1 FMLOCAL
+ /x2 FMLOCAL
+ /y1 FMLOCAL
+ /y2 FMLOCAL
+/R {
+ /y2 exch def
+ /x2 exch def
+ /y1 exch def
+ /x1 exch def
+ x1 y1
+ x2 y1
+ x2 y2
+ x1 y2
+ 4 Y
+ } bind def
+ /rad FMLOCAL
+/rarc
+ {rad
+ arcto
+ } bind def
+/RR {
+ /rad exch def
+ normalize
+ /y2 exch def
+ /x2 exch def
+ normalize
+ /y1 exch def
+ /x1 exch def
+ mark
+ newpath
+ {
+ x1 y1 rad add moveto
+ x1 y2 x2 y2 rarc
+ x2 y2 x2 y1 rarc
+ x2 y1 x1 y1 rarc
+ x1 y1 x1 y2 rarc
+ closepath
+ } stopped {x1 y1 x2 y2 R} if
+ cleartomark
+ } bind def
+/RRR {
+ /rad exch def
+ normalize /y4 exch def /x4 exch def
+ normalize /y3 exch def /x3 exch def
+ normalize /y2 exch def /x2 exch def
+ normalize /y1 exch def /x1 exch def
+ newpath
+ normalize moveto
+ mark
+ {
+ x2 y2 x3 y3 rarc
+ x3 y3 x4 y4 rarc
+ x4 y4 x1 y1 rarc
+ x1 y1 x2 y2 rarc
+ closepath
+ } stopped
+ {x1 y1 x2 y2 x3 y3 x4 y4 newpath moveto lineto lineto lineto closepath} if
+ cleartomark
+ } bind def
+/C {
+ grestore
+ gsave
+ R
+ clip
+ setCurrentScreen
+} bind def
+/CP {
+ grestore
+ gsave
+ Y
+ clip
+ setCurrentScreen
+} bind def
+ /FMpointsize FMLOCAL
+/F {
+ FMfonts exch get
+ FMpointsize scalefont
+ setfont
+ } bind def
+/Q {
+ /FMpointsize exch def
+ F
+ } bind def
+/T {
+ moveto show
+ } bind def
+/RF {
+ rotate
+ 0 ne {-1 1 scale} if
+ } bind def
+/TF {
+ gsave
+ moveto
+ RF
+ show
+ grestore
+ } bind def
+/P {
+ moveto
+ 0 32 3 2 roll widthshow
+ } bind def
+/PF {
+ gsave
+ moveto
+ RF
+ 0 32 3 2 roll widthshow
+ grestore
+ } bind def
+/S {
+ moveto
+ 0 exch ashow
+ } bind def
+/SF {
+ gsave
+ moveto
+ RF
+ 0 exch ashow
+ grestore
+ } bind def
+/B {
+ moveto
+ 0 32 4 2 roll 0 exch awidthshow
+ } bind def
+/BF {
+ gsave
+ moveto
+ RF
+ 0 32 4 2 roll 0 exch awidthshow
+ grestore
+ } bind def
+/G {
+ gsave
+ newpath
+ normalize translate 0.0 0.0 moveto
+ dnormalize scale
+ 0.0 0.0 1.0 5 3 roll arc
+ closepath
+ PFill fill
+ grestore
+ } bind def
+/Gstrk {
+ savematrix
+ newpath
+ 2 index 2 div add exch 3 index 2 div sub exch
+ normalize 2 index 2 div sub exch 3 index 2 div add exch
+ translate
+ scale
+ 0.0 0.0 1.0 5 3 roll arc
+ restorematrix
+ currentlinewidth exch setlinewidth PStroke setlinewidth
+ } bind def
+/Gclip {
+ newpath
+ savematrix
+ normalize translate 0.0 0.0 moveto
+ dnormalize scale
+ 0.0 0.0 1.0 5 3 roll arc
+ closepath
+ clip newpath
+ restorematrix
+ } bind def
+/GG {
+ gsave
+ newpath
+ normalize translate 0.0 0.0 moveto
+ rotate
+ dnormalize scale
+ 0.0 0.0 1.0 5 3 roll arc
+ closepath
+ PFill
+ fill
+ grestore
+ } bind def
+/GGclip {
+ savematrix
+ newpath
+ normalize translate 0.0 0.0 moveto
+ rotate
+ dnormalize scale
+ 0.0 0.0 1.0 5 3 roll arc
+ closepath
+ clip newpath
+ restorematrix
+ } bind def
+/GGstrk {
+ savematrix
+ newpath
+ normalize translate 0.0 0.0 moveto
+ rotate
+ dnormalize scale
+ 0.0 0.0 1.0 5 3 roll arc
+ closepath
+ restorematrix
+ currentlinewidth exch setlinewidth PStroke setlinewidth
+ } bind def
+/A {
+ gsave
+ savematrix
+ newpath
+ 2 index 2 div add exch 3 index 2 div sub exch
+ normalize 2 index 2 div sub exch 3 index 2 div add exch
+ translate
+ scale
+ 0.0 0.0 1.0 5 3 roll arc
+ restorematrix
+ PStroke
+ grestore
+ } bind def
+/Aclip {
+ newpath
+ savematrix
+ normalize translate 0.0 0.0 moveto
+ dnormalize scale
+ 0.0 0.0 1.0 5 3 roll arc
+ closepath
+ strokepath clip newpath
+ restorematrix
+} bind def
+/Astrk {
+ Gstrk
+} bind def
+/AA {
+ gsave
+ savematrix
+ newpath
+
+ 3 index 2 div add exch 4 index 2 div sub exch
+
+ normalize 3 index 2 div sub exch 4 index 2 div add exch
+ translate
+ rotate
+ scale
+ 0.0 0.0 1.0 5 3 roll arc
+ restorematrix
+ PStroke
+ grestore
+ } bind def
+/AAclip {
+ savematrix
+ newpath
+ normalize translate 0.0 0.0 moveto
+ rotate
+ dnormalize scale
+ 0.0 0.0 1.0 5 3 roll arc
+ closepath
+ strokepath clip newpath
+ restorematrix
+} bind def
+/AAstrk {
+ GGstrk
+} bind def
+ /x FMLOCAL
+ /y FMLOCAL
+ /w FMLOCAL
+ /h FMLOCAL
+ /xx FMLOCAL
+ /yy FMLOCAL
+ /ww FMLOCAL
+ /hh FMLOCAL
+ /FMsaveobject FMLOCAL
+ /FMoptop FMLOCAL
+ /FMdicttop FMLOCAL
+/BEGINPRINTCODE {
+ /FMdicttop countdictstack 1 add def
+ /FMoptop count 7 sub def
+ /FMsaveobject save def
+ userdict begin
+ /showpage {} def
+ FMNORMALIZEGRAPHICS
+ 3 index neg 3 index neg translate
+ } bind def
+/ENDPRINTCODE {
+ count -1 FMoptop {pop pop} for
+ countdictstack -1 FMdicttop {pop end} for
+ FMsaveobject restore
+ } bind def
+/gn {
+ 0
+ { 46 mul
+ cf read pop
+ 32 sub
+ dup 46 lt {exit} if
+ 46 sub add
+ } loop
+ add
+ } bind def
+ /str FMLOCAL
+/cfs {
+ /str sl string def
+ 0 1 sl 1 sub {str exch val put} for
+ str def
+ } bind def
+/ic [
+ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0223
+ 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0223
+ 0
+ {0 hx} {1 hx} {2 hx} {3 hx} {4 hx} {5 hx} {6 hx} {7 hx} {8 hx} {9 hx}
+ {10 hx} {11 hx} {12 hx} {13 hx} {14 hx} {15 hx} {16 hx} {17 hx} {18 hx}
+ {19 hx} {gn hx} {0} {1} {2} {3} {4} {5} {6} {7} {8} {9} {10} {11} {12}
+ {13} {14} {15} {16} {17} {18} {19} {gn} {0 wh} {1 wh} {2 wh} {3 wh}
+ {4 wh} {5 wh} {6 wh} {7 wh} {8 wh} {9 wh} {10 wh} {11 wh} {12 wh}
+ {13 wh} {14 wh} {gn wh} {0 bl} {1 bl} {2 bl} {3 bl} {4 bl} {5 bl} {6 bl}
+ {7 bl} {8 bl} {9 bl} {10 bl} {11 bl} {12 bl} {13 bl} {14 bl} {gn bl}
+ {0 fl} {1 fl} {2 fl} {3 fl} {4 fl} {5 fl} {6 fl} {7 fl} {8 fl} {9 fl}
+ {10 fl} {11 fl} {12 fl} {13 fl} {14 fl} {gn fl}
+ ] def
+ /sl FMLOCAL
+ /val FMLOCAL
+ /ws FMLOCAL
+ /im FMLOCAL
+ /bs FMLOCAL
+ /cs FMLOCAL
+ /len FMLOCAL
+ /pos FMLOCAL
+/ms {
+ /sl exch def
+ /val 255 def
+ /ws cfs
+ /im cfs
+ /val 0 def
+ /bs cfs
+ /cs cfs
+ } bind def
+400 ms
+/ip {
+ is
+ 0
+ cf cs readline pop
+ { ic exch get exec
+ add
+ } forall
+ pop
+
+ } bind def
+/rip {
+
+
+ bis ris copy pop
+ is
+ 0
+ cf cs readline pop
+ { ic exch get exec
+ add
+ } forall
+ pop pop
+ ris gis copy pop
+ dup is exch
+
+ cf cs readline pop
+ { ic exch get exec
+ add
+ } forall
+ pop pop
+ gis bis copy pop
+ dup add is exch
+
+ cf cs readline pop
+ { ic exch get exec
+ add
+ } forall
+ pop
+
+ } bind def
+/wh {
+ /len exch def
+ /pos exch def
+ ws 0 len getinterval im pos len getinterval copy pop
+ pos len
+ } bind def
+/bl {
+ /len exch def
+ /pos exch def
+ bs 0 len getinterval im pos len getinterval copy pop
+ pos len
+ } bind def
+/s1 1 string def
+/fl {
+ /len exch def
+ /pos exch def
+ /val cf s1 readhexstring pop 0 get def
+ pos 1 pos len add 1 sub {im exch val put} for
+ pos len
+ } bind def
+/hx {
+ 3 copy getinterval
+ cf exch readhexstring pop pop
+ } bind def
+ /h FMLOCAL
+ /w FMLOCAL
+ /d FMLOCAL
+ /lb FMLOCAL
+ /bitmapsave FMLOCAL
+ /is FMLOCAL
+ /cf FMLOCAL
+/wbytes {
+ dup dup
+ 24 eq { pop pop 3 mul }
+ { 8 eq {pop} {1 eq {7 add 8 idiv} {3 add 4 idiv} ifelse} ifelse } ifelse
+ } bind def
+/BEGINBITMAPBWc {
+ 1 {} COMMONBITMAPc
+ } bind def
+/BEGINBITMAPGRAYc {
+ 8 {} COMMONBITMAPc
+ } bind def
+/BEGINBITMAP2BITc {
+ 2 {} COMMONBITMAPc
+ } bind def
+/COMMONBITMAPc {
+
+ /r exch def
+ /d exch def
+ gsave
+
+ 3 index 2 div add exch
+ 4 index 2 div add exch
+ translate
+ rotate
+ 1 index 2 div neg
+ 1 index 2 div neg
+ translate
+ scale
+ /h exch def /w exch def
+ /lb w d wbytes def
+ sl lb lt {lb ms} if
+ /bitmapsave save def
+ r
+ /is im 0 lb getinterval def
+ ws 0 lb getinterval is copy pop
+ /cf currentfile def
+ w h d [w 0 0 h neg 0 h]
+ {ip} image
+ bitmapsave restore
+ grestore
+ } bind def
+/BEGINBITMAPBW {
+ 1 {} COMMONBITMAP
+ } bind def
+/BEGINBITMAPGRAY {
+ 8 {} COMMONBITMAP
+ } bind def
+/BEGINBITMAP2BIT {
+ 2 {} COMMONBITMAP
+ } bind def
+/COMMONBITMAP {
+ /r exch def
+ /d exch def
+ gsave
+
+ 3 index 2 div add exch
+ 4 index 2 div add exch
+ translate
+ rotate
+ 1 index 2 div neg
+ 1 index 2 div neg
+ translate
+ scale
+ /h exch def /w exch def
+ /bitmapsave save def
+ r
+ /is w d wbytes string def
+ /cf currentfile def
+ w h d [w 0 0 h neg 0 h]
+ {cf is readhexstring pop} image
+ bitmapsave restore
+ grestore
+ } bind def
+/ngrayt 256 array def
+/nredt 256 array def
+/nbluet 256 array def
+/ngreent 256 array def
+ /gryt FMLOCAL
+ /blut FMLOCAL
+ /grnt FMLOCAL
+ /redt FMLOCAL
+ /indx FMLOCAL
+ /cynu FMLOCAL
+ /magu FMLOCAL
+ /yelu FMLOCAL
+ /k FMLOCAL
+ /u FMLOCAL
+FMLevel1 {
+/colorsetup {
+ currentcolortransfer
+ /gryt exch def
+ /blut exch def
+ /grnt exch def
+ /redt exch def
+ 0 1 255 {
+ /indx exch def
+ /cynu 1 red indx get 255 div sub def
+ /magu 1 green indx get 255 div sub def
+ /yelu 1 blue indx get 255 div sub def
+ /k cynu magu min yelu min def
+ /u k currentundercolorremoval exec def
+% /u 0 def
+ nredt indx 1 0 cynu u sub max sub redt exec put
+ ngreent indx 1 0 magu u sub max sub grnt exec put
+ nbluet indx 1 0 yelu u sub max sub blut exec put
+ ngrayt indx 1 k currentblackgeneration exec sub gryt exec put
+ } for
+ {255 mul cvi nredt exch get}
+ {255 mul cvi ngreent exch get}
+ {255 mul cvi nbluet exch get}
+ {255 mul cvi ngrayt exch get}
+ setcolortransfer
+ {pop 0} setundercolorremoval
+ {} setblackgeneration
+ } bind def
+}
+{
+/colorSetup2 {
+ [ /Indexed /DeviceRGB 255
+ {dup red exch get 255 div
+ exch dup green exch get 255 div
+ exch blue exch get 255 div}
+ ] setcolorspace
+} bind def
+} ifelse
+ /tran FMLOCAL
+/fakecolorsetup {
+ /tran 256 string def
+ 0 1 255 {/indx exch def
+ tran indx
+ red indx get 77 mul
+ green indx get 151 mul
+ blue indx get 28 mul
+ add add 256 idiv put} for
+ currenttransfer
+ {255 mul cvi tran exch get 255.0 div}
+ exch concatprocs settransfer
+} bind def
+/BITMAPCOLOR {
+ /d 8 def
+ gsave
+
+ 3 index 2 div add exch
+ 4 index 2 div add exch
+ translate
+ rotate
+ 1 index 2 div neg
+ 1 index 2 div neg
+ translate
+ scale
+ /h exch def /w exch def
+ /bitmapsave save def
+ FMLevel1 {
+ colorsetup
+ /is w d wbytes string def
+ /cf currentfile def
+ w h d [w 0 0 h neg 0 h]
+ {cf is readhexstring pop} {is} {is} true 3 colorimage
+ } {
+ colorSetup2
+ /is w d wbytes string def
+ /cf currentfile def
+ 7 dict dup begin
+ /ImageType 1 def
+ /Width w def
+ /Height h def
+ /ImageMatrix [w 0 0 h neg 0 h] def
+ /DataSource {cf is readhexstring pop} bind def
+ /BitsPerComponent d def
+ /Decode [0 255] def
+ end image
+ } ifelse
+ bitmapsave restore
+ grestore
+ } bind def
+/BITMAPCOLORc {
+ /d 8 def
+ gsave
+
+ 3 index 2 div add exch
+ 4 index 2 div add exch
+ translate
+ rotate
+ 1 index 2 div neg
+ 1 index 2 div neg
+ translate
+ scale
+ /h exch def /w exch def
+ /lb w d wbytes def
+ sl lb lt {lb ms} if
+ /bitmapsave save def
+ FMLevel1 {
+ colorsetup
+ /is im 0 lb getinterval def
+ ws 0 lb getinterval is copy pop
+ /cf currentfile def
+ w h d [w 0 0 h neg 0 h]
+ {ip} {is} {is} true 3 colorimage
+ } {
+ colorSetup2
+ /is im 0 lb getinterval def
+ ws 0 lb getinterval is copy pop
+ /cf currentfile def
+ 7 dict dup begin
+ /ImageType 1 def
+ /Width w def
+ /Height h def
+ /ImageMatrix [w 0 0 h neg 0 h] def
+ /DataSource {ip} bind def
+ /BitsPerComponent d def
+ /Decode [0 255] def
+ end image
+ } ifelse
+ bitmapsave restore
+ grestore
+ } bind def
+/BITMAPTRUECOLORc {
+ /d 24 def
+ gsave
+
+ 3 index 2 div add exch
+ 4 index 2 div add exch
+ translate
+ rotate
+ 1 index 2 div neg
+ 1 index 2 div neg
+ translate
+ scale
+ /h exch def /w exch def
+ /lb w d wbytes def
+ sl lb lt {lb ms} if
+ /bitmapsave save def
+
+ /is im 0 lb getinterval def
+ /ris im 0 w getinterval def
+ /gis im w w getinterval def
+ /bis im w 2 mul w getinterval def
+
+ ws 0 lb getinterval is copy pop
+ /cf currentfile def
+ w h 8 [w 0 0 h neg 0 h]
+ {w rip pop ris} {gis} {bis} true 3 colorimage
+ bitmapsave restore
+ grestore
+ } bind def
+/BITMAPTRUECOLOR {
+ gsave
+
+ 3 index 2 div add exch
+ 4 index 2 div add exch
+ translate
+ rotate
+ 1 index 2 div neg
+ 1 index 2 div neg
+ translate
+ scale
+ /h exch def /w exch def
+ /bitmapsave save def
+ /is w string def
+ /gis w string def
+ /bis w string def
+ /cf currentfile def
+ w h 8 [w 0 0 h neg 0 h]
+ { cf is readhexstring pop }
+ { cf gis readhexstring pop }
+ { cf bis readhexstring pop }
+ true 3 colorimage
+ bitmapsave restore
+ grestore
+ } bind def
+/BITMAPTRUEGRAYc {
+ /d 24 def
+ gsave
+
+ 3 index 2 div add exch
+ 4 index 2 div add exch
+ translate
+ rotate
+ 1 index 2 div neg
+ 1 index 2 div neg
+ translate
+ scale
+ /h exch def /w exch def
+ /lb w d wbytes def
+ sl lb lt {lb ms} if
+ /bitmapsave save def
+
+ /is im 0 lb getinterval def
+ /ris im 0 w getinterval def
+ /gis im w w getinterval def
+ /bis im w 2 mul w getinterval def
+ ws 0 lb getinterval is copy pop
+ /cf currentfile def
+ w h 8 [w 0 0 h neg 0 h]
+ {w rip pop ris gis bis w gray} image
+ bitmapsave restore
+ grestore
+ } bind def
+/ww FMLOCAL
+/r FMLOCAL
+/g FMLOCAL
+/b FMLOCAL
+/i FMLOCAL
+/gray {
+ /ww exch def
+ /b exch def
+ /g exch def
+ /r exch def
+ 0 1 ww 1 sub { /i exch def r i get .299 mul g i get .587 mul
+ b i get .114 mul add add r i 3 -1 roll floor cvi put } for
+ r
+ } bind def
+/BITMAPTRUEGRAY {
+ gsave
+
+ 3 index 2 div add exch
+ 4 index 2 div add exch
+ translate
+ rotate
+ 1 index 2 div neg
+ 1 index 2 div neg
+ translate
+ scale
+ /h exch def /w exch def
+ /bitmapsave save def
+ /is w string def
+ /gis w string def
+ /bis w string def
+ /cf currentfile def
+ w h 8 [w 0 0 h neg 0 h]
+ { cf is readhexstring pop
+ cf gis readhexstring pop
+ cf bis readhexstring pop w gray} image
+ bitmapsave restore
+ grestore
+ } bind def
+/BITMAPGRAY {
+ 8 {fakecolorsetup} COMMONBITMAP
+ } bind def
+/BITMAPGRAYc {
+ 8 {fakecolorsetup} COMMONBITMAPc
+ } bind def
+/ENDBITMAP {
+ } bind def
+end
+ /ALDsave FMLOCAL
+ /ALDmatrix matrix def ALDmatrix currentmatrix pop
+/StartALD {
+ /ALDsave save def
+ savematrix
+ ALDmatrix setmatrix
+ } bind def
+/InALD {
+ restorematrix
+ } bind def
+/DoneALD {
+ ALDsave restore
+ } bind def
+/I { setdash } bind def
+/J { [] 0 setdash } bind def
+%%EndProlog
+%%BeginSetup
+(4.0) FMVERSION
+1 1 0 0 612 792 0 1 10 FMDOCUMENT
+0 0 /Times-Bold FMFONTDEFINE
+1 0 /Times-Roman FMFONTDEFINE
+2 0 /Times-BoldItalic FMFONTDEFINE
+3 0 /Times-Italic FMFONTDEFINE
+4 0 /Courier FMFONTDEFINE
+5 0 /Courier-Bold FMFONTDEFINE
+32 FMFILLS
+0 0 FMFILL
+1 0.1 FMFILL
+2 0.3 FMFILL
+3 0.5 FMFILL
+4 0.7 FMFILL
+5 0.9 FMFILL
+6 0.97 FMFILL
+7 1 FMFILL
+8 <0f1e3c78f0e1c387> FMFILL
+9 <0f87c3e1f0783c1e> FMFILL
+10 <cccccccccccccccc> FMFILL
+11 <ffff0000ffff0000> FMFILL
+12 <8142241818244281> FMFILL
+13 <03060c183060c081> FMFILL
+14 <8040201008040201> FMFILL
+16 1 FMFILL
+17 0.9 FMFILL
+18 0.7 FMFILL
+19 0.5 FMFILL
+20 0.3 FMFILL
+21 0.1 FMFILL
+22 0.03 FMFILL
+23 0 FMFILL
+24 <f0e1c3870f1e3c78> FMFILL
+25 <f0783c1e0f87c3e1> FMFILL
+26 <3333333333333333> FMFILL
+27 <0000ffff0000ffff> FMFILL
+28 <7ebddbe7e7dbbd7e> FMFILL
+29 <fcf9f3e7cf9f3f7e> FMFILL
+30 <7fbfdfeff7fbfdfe> FMFILL
+%%EndSetup
+%%Page: "1" 1
+%%BeginPaperSize: Letter
+%%EndPaperSize
+612 792 0 FMBEGINPAGE
+[0 0 0 1 0 0 0]
+[ 0 1 1 0 1 0 0]
+[ 1 0 1 0 0 1 0]
+[ 1 1 0 0 0 0 1]
+[ 1 0 0 0 0 1 1]
+[ 0 1 0 0 1 0 1]
+[ 0 0 1 0 1 1 0]
+ 7 FrameSetSepColors
+FrameNoSep
+0 0 0 1 0 0 0 K
+J
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 12 Q
+0 X
+0 0 0 1 0 0 0 K
+(Intr) 151.94 469 T
+(oduction) 172.39 469 T
+1 10 Q
+(T) 72 450.33 T
+(ypically) 77.41 450.33 T
+(, T) 108.98 450.33 T
+(cl/Tk application development leads to the) 119.39 450.33 T
+(redundant creation of widget combination patterns) 72 438.33 T
+(which can be singled out for replacement with higher) 72 426.33 T
+(level abstractions. For example, a label is usually asso-) 72 414.33 T
+(ciated with an entry widget, listboxes frequently have) 72 402.33 T
+(attached scrollbars, and dialogs require buttons and) 72 390.33 T
+(modality) 72 378.33 T
+(. This is due to the simplicity of the Tk widget) 106.91 378.33 T
+(set. Seasoned developers commonly package this code,) 72 366.33 T
+(attempting to create a composite widget in a set of pro-) 72 354.33 T
+(cedures which allows for consistent creation of the wid-) 72 342.33 T
+(get combination. This may provide centralization of) 72 330.33 T
+(logic, but the procedures lack the encapsulation of a) 72 318.33 T
+(pure widget and end up \337ooding global name space. At) 72 306.33 T
+(this point, some developers may resort to C code.) 72 294.33 T
+(What was really needed was the ability to combine Tk) 72 270.33 T
+(widgets together into abstract building blocks called) 72 258.33 T
+(\322Mega-W) 72 246.33 T
+(idgets\323 at the VHLL layer) 111.58 246.33 T
+(. The [incr T) 215.45 246.33 T
+(cl] [1]) 265.29 246.33 T
+(and [incr Tk] [2] extensions provide this capability) 72 234.33 T
+(,) 274.93 234.33 T
+(allowing mega-widget development in an object-ori-) 72 222.33 T
+(ented paradigm using T) 72 210.33 T
+(cl/Tk rather than C. The next) 166.01 210.33 T
+(step was to build a mega-widget set in these extensions) 72 198.33 T
+(which replaces the redundant widget combination pat-) 72 186.33 T
+-0.1 (terns and provides a foundation for future development.) 72 174.33 P
+([incr W) 72 162.33 T
+(idgets] is one such extension.) 102.42 162.33 T
+([incr W) 72 144.33 T
+(idgets] is an object-oriented, extensible set of) 102.42 144.33 T
+-0.6 (mega-widgets, delivering many general purpose widgets) 72 132.33 P
+(such as option menus, selection boxes, and dialogs) 72 120.33 T
+(whose counterparts are found in Motif. Since [incr W) 72 108.33 T
+(id-) 285.72 108.33 T
+(gets] is based on [incr Tk], the Tk framework of con\336g-) 72 96.33 T
+(uration options and widget commands is maintained. In) 72 84.33 T
+(other words, they look, act, and feel like Tk widgets.) 315 470.33 T
+([incr W) 315 458.33 T
+(idgets] blends with the standard Tk widgets,) 345.42 458.33 T
+-0.28 (raising the level of programming and making it easier to) 315 446.33 P
+(consistently develop well styled applications.) 315 434.33 T
+(The idea of extending the basic Tk widget set is not) 315 410.33 T
+(original. Other mega-widget extensions exist such as) 315 398.33 T
+(T) 315 386.33 T
+(ix [3] and itcl-widgets [4]. V) 320.76 386.33 T
+(isually) 435.14 386.33 T
+(, [incr W) 461.16 386.33 T
+(idgets]) 496.58 386.33 T
+-0.03 (covers some of the same ground, successfully replacing) 315 374.33 P
+(many of the same typical combinations. [incr W) 315 362.33 T
+(idgets]) 507.35 362.33 T
+(dif) 315 350.33 T
+(fers in the degree of its reusability) 325.93 350.33 T
+(, extensibility) 461.92 350.33 T
+(, \337ex-) 515.72 350.33 T
+(ibility) 315 338.33 T
+(, and adherence to the Motif style guide.) 338.25 338.33 T
+(The [incr W) 315 314.33 T
+(idgets] mega-widget set is also distin-) 363.47 314.33 T
+(guished by its consistent use of style, built-in intelli-) 315 302.33 T
+(gence, high degree of \337exibility) 315 290.33 T
+(, ease of extending base) 441.83 290.33 T
+(level functionality) 315 278.33 T
+(, and its object-oriented implementa-) 387.4 278.33 T
+(tion. Its use has resulted in increased productivity) 315 266.33 T
+(, reli-) 512.66 266.33 T
+(ability) 315 254.33 T
+(, and style guide adherence. This paper) 339.91 254.33 T
+(concentrates on these unique aspects of the widget set) 315 242.33 T
+(and the presentation of its innovative concepts. A picto-) 315 230.33 T
+(rial tour with sample code segments will be given as an) 315 218.33 T
+(appendix.) 315 206.33 T
+0 12 Q
+(Mega-W) 390.28 175 T
+(idgets) 434.72 175 T
+1 10 Q
+(Mega-widgets has been a hot topic within the T) 315 150.33 T
+(cl/Tk) 504.83 150.33 T
+(community) 315 138.33 T
+(. The discussion centers on the bene\336ts,) 359.91 138.33 T
+(frameworks, mechanisms, and implementation tech-) 315 126.33 T
+(niques. It was McLennan [1] who originally coined the) 315 114.33 T
+(term in his work with [incr T) 315 102.33 T
+(cl], expanding on the con-) 430.4 102.33 T
+(cept with [incr Tk]. He proposes that mega-widgets) 315 90.33 T
+(should seamlessly extend the Tk widget set. They) 315 78.33 T
+72 495 540 720 R
+7 X
+V
+0 14 Q
+0 X
+([incr W) 263.16 710.67 T
+(idgets]) 309.18 710.67 T
+(An Object Oriented Mega-W) 192.98 692.67 T
+(idget Set) 367.31 692.67 T
+2 9 Q
+(Revised 10/31/95 - Originally present at USENIX T) 176.36 678 T
+(cl/Tk W) 365.8 678 T
+(orkshop 95) 394.38 678 T
+1 12 Q
+(Mark L. Ulferts) 268.18 652 T
+3 10 Q
+(DSC Communications Corporation) 235.16 637.33 T
+(mulferts@spd.dsccc.com) 256.13 623.33 T
+(http://www) 242.19 609.33 T
+(.wn.com/biz/iwidgets) 285.91 609.33 T
+0 12 Q
+(Abstract) 283.67 576 T
+3 10 Q
+(The intr) 72 551.33 T
+(oduction of [incr T) 103.58 551.33 T
+(cl] and [incr Tk] allows an object oriented appr) 178.5 551.33 T
+(oach to Tk widget construction. \322Mega-) 370.91 551.33 T
+(widgets\323 developed in these extensions seamlessly expand the Tk base widget set. Each of these object-oriented wid-) 72 539.33 T
+-0.03 (gets may themselves be extended, using either inheritance or composition. This paper pr) 72 527.33 P
+-0.03 (esents one such general pur-) 425.14 527.33 P
+(pose hierar) 72 515.33 T
+(chy called [incr W) 117.46 515.33 T
+(idgets] which maintains the Motif look-and-feel and establishes several new concepts,) 191.06 515.33 T
+(including extensible child sites and \337exible lar) 72 503.33 T
+(ge scale component con\336guration.) 257.73 503.33 T
+FMENDPAGE
+%%EndPage: "1" 1
+%%Page: "2" 2
+612 792 0 FMBEGINPAGE
+[0 0 0 1 0 0 0]
+[ 0 1 1 0 1 0 0]
+[ 1 0 1 0 0 1 0]
+[ 1 1 0 0 0 0 1]
+[ 1 0 0 0 0 1 1]
+[ 0 1 0 0 1 0 1]
+[ 0 0 1 0 1 1 0]
+ 7 FrameSetSepColors
+FrameNoSep
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+(should behave like standard Tk widgets, but are com-) 72 713.33 T
+(posed of many Tk widgets and possibly other mega-) 72 701.33 T
+(widgets as components. The implementation must) 72 689.33 T
+(ensure that users notice no signi\336cant dif) 72 677.33 T
+(ferences. Stan-) 235.69 677.33 T
+(dard commands such as \324con\336gure\325 and \324cget\325 must) 72 665.33 T
+(exist and options should be propagated to all compo-) 72 653.33 T
+(nents. Thus, con\336guration of a mega-widgets \322-back-) 72 641.33 T
+(ground\323 or \322-relief\323 option should have the expected) 72 629.33 T
+(results on its components.) 72 617.33 T
+-0.15 (The [incr T) 72 593.33 P
+-0.15 (cl] and [incr Tk] extensions fully address the) 116.55 593.33 P
+(issues of framework and mechanism for mega-widget) 72 581.33 T
+(production. They have established themselves as the) 72 569.33 T
+(defacto standard object-oriented extensions and have) 72 557.33 T
+(been chosen to provide the backbone for the [incr W) 72 545.33 T
+(id-) 281.82 545.33 T
+(gets] set. Using these extensions, each mega-widget) 72 533.33 T
+(becomes a \322class\323, de\336ning a unique type of widget) 72 521.33 T
+(object in a separate namespace. This ensures that data) 72 509.33 T
+(and commands associated with an object are encapsu-) 72 497.33 T
+(lated, eliminating global name space pollution.) 72 485.33 T
+0 12 Q
+(Example) 161.83 454 T
+1 10 Q
+-0.24 (At this point, an example of mega-widget usage can pro-) 72 429.33 P
+(vide a taste of [incr W) 72 417.33 T
+(idgets] capabilities and illustrate) 160.74 417.33 T
+(the bene\336ts. The example centers around the construc-) 72 405.33 T
+-0.17 (tion of a typical login screen which prompts the user for) 72 393.33 P
+(user name and password. New requirements will be) 72 381.33 T
+-0.03 (incremental, leading to the development of a new mega-) 72 369.33 P
+(widget which is implemented as an extension of an) 72 357.33 T
+(existing one.) 72 345.33 T
+-0.3 (A primitive login screen is composed of two \336elds, each) 72 321.33 P
+(having a label and entry widget. The T) 72 309.33 T
+(cl/Tk code) 226.27 309.33 T
+(required is shown in Figure 1. [incr W) 72 297.33 T
+(idgets] provides) 224.91 297.33 T
+(an Entry\336eld class which replaces this standard widget) 72 285.33 T
+(combination. This is shown in Figure 2. At this point,) 72 273.33 T
+(mega-widget usage is mostly a matter of convenience) 72 261.33 T
+(and minor savings in code, yet with a few additional) 72 249.33 T
+(requirements the bene\336ts begin to escalate.) 72 237.33 T
+(Now let\325) 72 213.33 T
+(s add new requirements which might be) 106.72 213.33 T
+(required for a normal login screen. First, the labels) 72 201.33 T
+(should be left aligned. Next, the user \336eld width should) 72 189.33 T
+(be limited to a maximum of 10 characters with input) 72 177.33 T
+(restricted to alphabetic characters and illegal character) 72 165.33 T
+(entry ringing the bell. As for the password, input must) 72 153.33 T
+-0.05 (be masked and the return key should invoke a login pro-) 72 141.33 P
+(cedure. W) 72 129.33 T
+(e\325ll also present a more aesthetic interface by) 112.29 129.33 T
+(varying the textual background in the mega-widget.) 72 117.33 T
+(Since this last requirement applies to both Entry\336elds,) 72 105.33 T
+-0.03 (the option database will be used. Figure 3 illustrates the) 72 93.33 P
+-0.48 (code needed to implement these new requirements using) 72 81.33 P
+([incr W) 315 200.33 T
+(idgets]. Even without the presentation of com-) 345.42 200.33 T
+-0.18 (parative straight T) 315 188.33 P
+-0.18 (cl/Tk code, its safe to say that the ben-) 387.27 188.33 P
+(e\336ts have increased.) 315 176.33 T
+(This example gives just a sampling of the label control) 315 152.33 T
+(capabilities built into those classes based on the) 315 140.33 T
+(Labeledwidget class such as the Entry\336eld mega-wid-) 315 128.33 T
+-0.18 (get. The label\325) 315 116.33 P
+-0.18 (s position relative to its associated widget) 372.12 116.33 P
+-0.04 (may be speci\336ed using standard directions: nw) 315 104.33 P
+-0.04 (, n, ne, e,) 501.29 104.33 P
+-0.4 (se, s, sw) 315 92.33 P
+-0.4 (, and w) 346.88 92.33 P
+-0.4 (. The label need not be limited to text, the) 374.58 92.33 P
+(class supports both bitmaps and images as well. A mar-) 315 80.33 T
+315 207 540 720 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+315 243 540 360 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+315 396 540 720 R
+7 X
+V
+0 X
+N
+%%BeginBinary: 6824
+251 117 129.09 60.17 0 365.92 648
+/red <
+72FFFFFFFFFFFFFFFFFFFFFFFFFF66F5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+FFFFFFFFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBF80808080
+8080808080808080808080808080808080808080404040404040404040404040
+4040404040404040404040000000000000000000000000000000000039C069DD
+00FF0000003333330033CCDD9999112277005544FFCC66AABBFF33EE9999CC7A
+EFD39765E1A36FE700FF5500557FB22EB099FFFFB07AFFCC0087AFB4CD73E6A2
+4DBF88F558D7439D50D080C0C080C0808060C000FFA000FFBE8BD28BD9B3FF72
+20C0A040C040D060F0E010B499A0FF0019BF2FFF6223852F465F4770FF0000FF
+> store
+/green <
+9F0000000000000000000000000099DEFFFFFFBFBFBFBFBF8080808080404040
+40000000FFFFFFFFFFBFBFBFBF808080808040404040400000000000FFFFFFFF
+FFBFBFBFBFBF8080808040404040400000000000FFFFFFFFFFBFBFBFBFBF8080
+8080804040400000000000FFFFFFBFBFBFBFBF80808040404040400063E0B500
+996699FF00663399BBFF99DD99FF112277005544CCCC66AABB6600EE6600CC69
+E3B59765E1A36FE700FF1A006B7FB28B3099FFFFB094FFF700CEEEEE0073E6A2
+4DBF88F558D74DB38080C0C080C080808060C08000A08040BE5BB477D9B3FF77
+2070A0402040D0F0F0E010B489A0E4FF19264F00B641DE4F829E4780FF0000FF
+> store
+/blue <
+FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB3BF8040FFBF804000FFBF804000FFBF80
+00BF8040FFBF804000FF804000FFBF804000FFBF804000FFBF804000FFBF8040
+00FFBF804000FFBF4000FFBF804000FFBF804000FFBF804000FFBF804000FFBF
+804000FFBF00FFBF804000BF8040FFBF804000FFBF40FFBF8040004063E0B500
+FF3399FF88666666009966DDFFFF112277DD554499FFCCAABBCC99EE9966CC69
+E3B59765E1A36FE7BFCC8BEE2F7FB257606BFBB3B015322480FAEEB40073E6A2
+4DBF88F558D756CAD050C080C08080C08060C080FF000040BE7A8C65D9B3E085
+2070C0802040D06050E010B476A0C40070264F00FC5AE050B4A0FF9000FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+6F6F7R4F6F76F6F7J"
+S3F78z8z8z
+4F9R3F94F9
+
+;z"
+S*F7F6<z"z"z"z
+0F6F7R#F6F70F6F70F6=z8z8z8z
+/F9R"F9/F9/F9
+J%J#F'
+O<FEFEFEFE5FEFEFEFEFEFEF9FEJ"8"J'Js"
+O<F9F9FFEFEF9F9F9FEP2F6F7J#8#J"Jr
+P#FEFEF9F94F9P3F9J$:*8'?#8"9$8'8$:$8'
+OGFEFEFEFEFEFEFEF9F9FEFEFEFEFEFEF9FEFEFEFEF9FEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEF9FEFE@s"J1:"8%<"9#8)8"808%J$
+F6F7O2FEFEFEF9FEFEFEF9FEFEF9F9FEFEF9F9F9FEF9FEFEF9FEFEFEFEFEF9FEFEF9F9FEFEFEFEF9FEFEF9FEFEFEF9FEFEF9F9FEF9FEFEO.F6F6F7ArJ$H"@#9"9%:$9"<"<"J"
+F9O5F9F9F9F9F9F9FEF9F9F9F9F9F9F9FEFEF9O2F9@sJ"?'I"8#H%9%J#
+F7O1FEF9FEFEFEFEF9FEF9F9F9F9F9F9F9F9F9F9O6F7F7@tJ":$9&J">%?%9%J$
+F9O/FEFEF9FEFEF9F9F9F95FEFEF9FEFEFEF9FEFEFEF9FEFEO6F9F9F9J"8$9(8(8$8"9"<08"808"9"
+O<FEFEFEFEF9F9FEFEFEF9F9FEFEFEFEFEF9FEFEF9FEFEFEF9FEFEFEFEF9F9F9F9FEFEFEF9F9FEFEF9F9FEFEFEF9F9F9F9FEFEFEF9F9FEFEFEJs9$9";"x;':$8%:$:$8sJs
+O<F9F9F9F9F9FEF9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9O;F7J&Jt
+OMFEF9F9F9F9PLF9J(
+OMF9FEFEFEFEFEF9=z8z8z8z
+/F7R"F7/F7/F7rF"J"F"F%
+F7F7R#F7F7F7F7F7F7'z&
+F6F6F6F6F6F7S)EEF6F6F6F6F68$J%
+F9F9F9S+F9F9F9F7
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+J5
+O+QEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEJ5
+O*QGFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFFJ#z#
+O*EEFEQCEEFFEEJ#J#
+O*FEEEQCEEFFJ#J#
+O*EEFEQCFFEEJ#9#J#J#
+4FEFEFEFE=FEEEQCEEFFJ#J#
+O*EEFEQCFFEEJ%9%8)<#J#
+=FEFEFEFEFEFEFEFEFEFEEEFEFEEEFEFEFEEEQCEEFFJ.9"A#J#
+<FEFEEEEEFEFEEEFEFEEEEEFEFEFEEEFEQCFFEEJ%A&<#J#
+>FEEEEEEEEEEEEEEEEEFEEEQCEEFFJ&:#;"A#J#
+<EEEEFEFEFEFEFEEEEEFEQCFFEEJ"8"9%E#J#
+>EEFEEEEEEEEEFEEEQCEEFFJ-=#=#<#J#
+4EEFEFEEEFEFEEEEEFEFEEEEEFEFEFEFEEEFEQCFFEEJ":.E#J#
+7FEEEFEFEFEFEEEEEEEFEFEFEFEEEFEEEQCEEFFJ&9%9%8#:#<#J#
+5EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEFEQCFFEEJ#J#
+O*FEEEQCEEFFJ#J#
+O*EEFEQCFFEEJ#J#
+O*FEEEQCEEFFJ5
+O*QGEEFEEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEJ5
+O*QGFEEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFJz
+O*QGEE
+
+
+
+
+
+
+
+
+
+
+
+
+J5
+OJQ'FEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEJ5
+OIQ(FEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEFEEEJ#z"
+OIEEFEQ%EEFFJ#J#
+OIFEEEQ$FFEEJ#J#
+OIEEFEQ$EEFFJ'J#@#J#
+4FEFEFEFEFEFEO#FEFEFEEEQ$FFEEJ&J#J#
+6EEEEEEFEFEO.EEFEQ$EEFFJ%9%9%8#8#8#8%8);#<#J#
+<FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEEEFEFEEEFEFEFEFEFEEEQ$FFEEJ5B'9"8%B#J#
+;4FEFEEEEEFEFEEEFEFEEEEEFEFEEEFEFEEEEEFEFEFEFEEEEEFEFEFEFEFEEEFEEEFEQ$EEFFJ(=%9):$A#9":#<#J#
+6FEFEFEFEEEEEEEFEEEEEEEFEEEEEEEEEEEFEFEFEFEEEEEEEEEEEEEFEEEQ$FFEEJ%8$9&8&J"H#J#
+6EEEEEEEEFEFEFEEEEEFEFEFEEEEEFEFEFE6EEEEFEQ$EEFFJ%;"8"9"8"J#J#
+;FEFEEEEEEEFEEEFEHFEEEQ$FFEEJ%9%:)G":#<#J#
+BFEFEEEEEFEFEEEEEEEFEFEEEEEFEFEEEFEFEFEEEFEQ$EEFFJ5B'<%B#J#
+;4EEFEFEFEEEFEFEEEFEFEFEFEEEEEEEFEFEFEFEEEEEFEFEFEFEEEEEFEFEEEFEEEQ$FFEEJ#<v9%:#8#:%8#:&8#<#J#
+4EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEFEQ$EEFFJ#J#
+OIFEEEQ$FFEEJ#J#
+OIEEFEQ$EEFFJ#J#
+OIFEEEQ$FFEEJ5
+OIQ(EEFEEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFF&J5B%
+F7F7F7F7F7ODQ(FEEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEFFEEF7F7F7F7&JzC&
+F6F6F6F6F6ODQ'EEF6F6F6F6F68$J%
+F9F9F9S+F9F9F9F7
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+<z"z"z
+0F6F7R4F6F71F6;z8z8z
+1F9R3F91F9
+
+7z8z8z
+5F7R3F74F7"J"J"
+F76F7R4F7
+ENDBITMAP
+%%EndBinary
+324 399.57 531 639 R
+7 X
+V
+4 8 Q
+0 X
+(frame .login) 324 633.67 T
+(pack .login -padx 10 -pady 10) 324 623.67 T
+(frame .login.userFrame) 324 603.67 T
+(label .login.userFrame.userLabel \134) 324 593.67 T
+( -text \322User:\323) 324 583.67 T
+(entry .login.userFrame.userEntry) 324 573.67 T
+(pack .login.userFrame -f) 324 553.67 T
+(ill x -pady 5) 439.2 553.67 T
+(pack .login.userFrame.userLabel \134) 324 543.67 T
+( -side left) 324 533.67 T
+(pack .login.userFrame.userEntry \134) 324 523.67 T
+( -side left -expand yes -f) 324 513.67 T
+(ill x) 463.2 513.67 T
+(frame .login.passwdFrame) 324 493.67 T
+(label .login.passwdFrame.passwdLabel \134) 324 483.67 T
+( -text \322Password:\323) 324 473.67 T
+(entry .login.passwdFrame.passwdEntry) 324 463.67 T
+(pack .login.passwdFrame -f) 324 443.67 T
+(ill x -pady 5) 448.8 443.67 T
+(pack .login.passwdFrame.passwdLabel \134) 324 433.67 T
+( -side left) 324 423.67 T
+(pack .login.passwdFrame.passwdEntry \134) 324 413.67 T
+( -side left -expand yes -f) 324 403.67 T
+(ill x) 463.2 403.67 T
+324 252 531 351 R
+7 X
+V
+0 X
+(frame .login) 324 345.67 T
+(pack .login -padx 10 -pady 10) 324 335.67 T
+(entryf) 324 315.67 T
+(ield .login.user \134) 352.8 315.67 T
+( -labeltext \322User:\323) 324 305.67 T
+(pack .login.user -f) 324 295.67 T
+(ill x -pady 5) 415.2 295.67 T
+(entryf) 324 275.67 T
+(ield .login.passwd \134) 352.8 275.67 T
+( -labeltext \322Password:\323) 324 265.67 T
+(pack .login.passwd -f) 324 255.67 T
+(ill x -pady 5) 424.8 255.67 T
+0 10 Q
+(FIGURE 2) 346.21 227.18 T
+1 F
+( - [incr W) 392.6 227.18 T
+(idgets] Login screen) 431.35 227.18 T
+0 F
+(FIGURE 1) 359.33 380.18 T
+1 F
+( - T) 405.72 380.18 T
+(cl/Tk Login screen) 419.46 380.18 T
+0 -208 1000 792 C
+FMENDPAGE
+%%EndPage: "2" 2
+%%Page: "3" 3
+612 792 0 FMBEGINPAGE
+[0 0 0 1 0 0 0]
+[ 0 1 1 0 1 0 0]
+[ 1 0 1 0 0 1 0]
+[ 1 1 0 0 0 0 1]
+[ 1 0 0 0 0 1 1]
+[ 0 1 0 0 1 0 1]
+[ 0 0 1 0 1 1 0]
+ 7 FrameSetSepColors
+FrameNoSep
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+(gin between the label and its associated widget may be) 72 429.62 T
+(given. Alignment is provided by adjusting the mar) 72 417.62 T
+(gins) 273.48 417.62 T
+(of a group of Labeledwidget based mega-widgets.) 72 405.62 T
+(Currently) 72 381.62 T
+(, our login screen lacks a method of cancella-) 109.68 381.62 T
+(tion barring closure from the window manager decora-) 72 369.62 T
+(tion. Since this is not the most elegant method of) 72 357.62 T
+-0.24 (window removal, \322OK\323 and \322Cancel\323 buttons seem like) 72 345.62 P
+(worthy additions. A well styled application would also) 72 333.62 T
+-0.22 (make the buttons be of equal width and signify a default) 72 321.62 P
+(button associated with striking the return key through) 72 309.62 T
+(the appearance of an encompassing sunken ring. The) 72 297.62 T
+(Buttonbox class provides this functionality) 72 285.62 T
+(, making but-) 243.02 285.62 T
+(ton management simple. As a manager widget, the But-) 72 273.62 T
+(tonbox controls the orientation, separation, and size of) 72 261.62 T
+-0.18 (its button components. Buttons are added with the \324add\325) 72 249.62 P
+(command. The \324default\325 command allows speci\336cation) 72 237.62 T
+(of a button within a sunken ring. Figure 4 presents the) 72 225.47 T
+(improved login screen.) 72 213.47 T
+-0.01 (Expanding further) 72 189.47 P
+-0.01 (, a truly useful login screen should be) 144.63 189.47 P
+(a modal toplevel dialog widget. The [incr W) 72 177.47 T
+(idgets] Dia-) 249.35 177.47 T
+(log class supports global, application, and non-modal) 72 165.47 T
+(dialogs. The dif) 72 153.47 T
+(ference being the degree of blocking.) 134.87 153.47 T
+(Global modal dialogs block all applications, whereas) 72 141.47 T
+(application modal dialogs only block the current appli-) 72 129.47 T
+-0.24 (cation. This allows processing of the dialog contents fol-) 72 117.47 P
+(lowing user response and dialog termination. Non-) 72 105.47 T
+(modal dialogs are non-blocking, enabling the applica-) 72 93.47 T
+(tion to continue. In this case, the actions attached to the) 72 81.47 T
+72 436.29 297 720 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+72 470.14 297 720 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 7011
+254 115 130.63 59.14 0 121.37 651.86
+/red <
+72FFFFFFFFFFFFFFFFFFFFFFFFFF66F5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+FFFFFFFFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBF80808080
+8080808080808080808080808080808080808080404040404040404040404040
+4040404040404040404040000000000000000000000000000000000039C069DD
+00FF0000003333330033CCDD9999112277005544FFCC66AABBFF33EE9999CC7A
+EFD39765E1A36FE700FF5500557FB22EB099FFFFB07AFFCC0087AFB4CD73E6A2
+4DBF88F558D7439D50D080C0C080C0808060C000FFA000FFBE8BD28BD9B3FF72
+20C0A040C040D060F0E010B499A0FF0019BF2FFF6223852F465F4770FF0000FF
+> store
+/green <
+9F0000000000000000000000000099DEFFFFFFBFBFBFBFBF8080808080404040
+40000000FFFFFFFFFFBFBFBFBF808080808040404040400000000000FFFFFFFF
+FFBFBFBFBFBF8080808040404040400000000000FFFFFFFFFFBFBFBFBFBF8080
+8080804040400000000000FFFFFFBFBFBFBFBF80808040404040400063E0B500
+996699FF00663399BBFF99DD99FF112277005544CCCC66AABB6600EE6600CC69
+E3B59765E1A36FE700FF1A006B7FB28B3099FFFFB094FFF700CEEEEE0073E6A2
+4DBF88F558D74DB38080C0C080C080808060C08000A08040BE5BB477D9B3FF77
+2070A0402040D0F0F0E010B489A0E4FF19264F00B641DE4F829E4780FF0000FF
+> store
+/blue <
+FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB3BF8040FFBF804000FFBF804000FFBF80
+00BF8040FFBF804000FF804000FFBF804000FFBF804000FFBF804000FFBF8040
+00FFBF804000FFBF4000FFBF804000FFBF804000FFBF804000FFBF804000FFBF
+804000FFBF00FFBF804000BF8040FFBF804000FFBF40FFBF8040004063E0B500
+FF3399FF88666666009966DDFFFF112277DD554499FFCCAABBCC99EE9966CC69
+E3B59765E1A36FE7BFCC8BEE2F7FB257606BFBB3B015322480FAEEB40073E6A2
+4DBF88F558D756CAD050C080C08080C08060C080FF000040BE7A8C65D9B3E085
+2070C0802040D06050E010B476A0C40070264F00FC5AE050B4A0FF9000FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+6F6F7R7F6F76F6F7J"
+S6F78z8z8z
+4F9R6F94F9
+
+;z"
+S-F7F6<z"z"z"z
+0F6F7R&F6F70F6F70F6=z8z8z8z
+/F9R%F9/F9/F9
+J%J#F'
+O=FEFEFEFE5FEFEFEFEFEFEF9FEJ"8"J'Js"
+O=F9F9FFEFEF9F9F9FEP4F6F7J#8#J"Jr
+P$FEFEF9F94F9P5F9J$:*8'?#8"9$8'8$:$8'
+OHFEFEFEFEFEFEFEF9F9FEFEFEFEFEFEF9FEFEFEFEF9FEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEF9FEFE@s"J1:"8%<"9#8)8"808%J$
+F6F7O3FEFEFEF9FEFEFEF9FEFEF9F9FEFEF9F9F9FEF9FEFEF9FEFEFEFEFEF9FEFEF9F9FEFEFEFEF9FEFEF9FEFEFEF9FEFEF9F9FEF9FEFEO0F6F6F7ArJ$H"@#9"9%:$9"<"<"J"
+F9O6F9F9F9F9F9F9FEF9F9F9F9F9F9F9FEFEF9O4F9@sJ"?'I"8#H%9%J#
+F7O2FEF9FEFEFEFEF9FEF9F9F9F9F9F9F9F9F9F9O8F7F7@tJ":$9&J">%?%9%J$
+F9O0FEFEF9FEFEF9F9F9F95FEFEF9FEFEFEF9FEFEFEF9FEFEO8F9F9F9J"8$9(8(8$8"9"<08"808"9"
+O=FEFEFEFEF9F9FEFEFEF9F9FEFEFEFEFEF9FEFEF9FEFEFEF9FEFEFEFEF9F9F9F9FEFEFEF9F9FEFEF9F9FEFEFEF9F9F9F9FEFEFEF9F9FEFEFEJs9$9";"x;':$8%:$:$8sJs
+O=F9F9F9F9F9FEF9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9O=F7J&Jt
+P FEF9F9F9F9Q F9J(
+P F9FEFEFEFEFEF9=z8z8z8z
+/F7R%F7/F7/F7rF"J"F"F%
+F7F7R&F7F7F7F7F7F7'z&
+F6F6F6F6F6F7S,EEF6F6F6F6F68$J%
+F9F9F9S.F9F9F9F7
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+J5
+OKQ(C3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEJ5
+OKQ(FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3J#z"
+OKC3FEQ%C3FFJ#J#
+OKFEC3Q$FFC3J#9#J#F$<$J#
+4FEFEFEFEO0C3FEFEFEFEFEFEFEP6C3FFJ#F#<%G"J#
+OKFEC3C3C3FEC3C3C3FEP$FFC3J%9%8)J#J#
+=FEFEFEFEFEFEFEFEFEFEEEFEFEEEFEFEGC3FEQ$C3FFJ.9"J)8#8#?&9$9&8&9$J#
+<FEFEEEEEFEFEEEFEFEEEEEFEFEFELFEC3C3FEFEFEC3FEFEFEFEFEFEFEFEFEFEFEFEFEFEC3FEFEFEFEFEFEFEFEFEFEFEOIFFC3J%A&J,9"@&8&8&8&8&J#
+>FEEEEEEEEEEEEEEEEEGC3FEC3C3FEC3FEC3FEC3C3C3C3FEC3C3C3FEC3C3C3FEC3FEC3C3C3C3FEC3C3C3FEC3C3C3FEOHC3FFJ&:#;"J#J$G&J#
+<EEEEFEFEFEFEFEEELFEC3?FEFEFEC3FEFEFEC3OHFFC3J"8"9%J#J%G%J#
+>EEFEEEEEEEEEO"C3FE?C3C3C3C3C3C3C3FEOHC3FFJ-=#=#J#J"D$J#
+4EEFEFEEEFEFEEEEEFEFEEEEEFEFEFEFEGFEC3BFEFEC3FEOLFFC3J":.J%;59&8%:,J#
+7FEEEFEFEFEFEEEEEEEFEFEFEFEEEO"C3FEC3FE4FEC3C3FEFEFEC3FEC3FEFEFEFEFEFEC3FEFEFEFEC3FEFEFEC3FEFEFEFEC3FEFEFEC3C3C3FEFEFEC3OHC3FFJ&9%9%8#:#J"t8z:$9%;$9$J#
+5EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEGFEC31C3C3C3C3C3C3C3C3C3C3C3C3C3C3OIFFC3J#J#
+OKC3FEQ$C3FFJ#J#
+OKFEC3Q$FFC3J#J#
+OKC3FEQ$C3FFJ5
+OKQ(FEC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3J5
+OKQ(C3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFJz
+OKQ(EE
+
+
+
+
+
+
+
+
+
+
+Jz
+OIQ,FE
+J5
+OKQ'C3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3J5
+OKQ(FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3J#z"
+OKC3FEQ%C3FFJ#J#J#
+OKFEC3CFEFEP-FFC3J'J#B#J#
+4FEFEFEFEFEFEO#FEFEC3FEQ$C3FFJ&J#J#
+6EEEEEEFEFEO0FEC3Q$FFC3J%9%9%8#8#8#8%8);#>#J#
+<FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEEEFEFEEEFEFEFEFEC3FEQ$C3FFJ5B'9"8%D#J#
+;4FEFEEEEEFEFEEEFEFEEEEEFEFEEEFEFEEEEEFEFEFEFEEEEEFEFEFEFEFEEEFEFEC3Q$FFC3J(=%9):$A#9":#>#J#
+6FEFEFEFEEEEEEEFEEEEEEEFEEEEEEEEEEEFEFEFEFEEEEEEEEEEEEEC3FEQ$C3FFJ%8$9&8&J"J#:"<"<"<"<"J#
+6EEEEEEEEFEFEFEEEEEFEFEFEEEEEFEFEFE6EE4FEC3FEFEFEFEFEP1FFC3J%;"8"9"8"J#:"<"<"<"<"J#
+;FEFEEEEEEEFEEEFEJC3FEC3C3C3C3C3P1C3FFJ%9%:)G":#>#J#
+BFEFEEEEEFEFEEEEEEEFEFEEEEEFEFEEEFEFEFEFEC3Q$FFC3J5B'<%D#J#
+;4EEFEFEFEEEFEFEEEFEFEFEFEEEEEEEFEFEFEFEEEEEFEFEFEFEEEEEFEFEEEC3FEQ$C3FFJ#<v9%:#8#:%8#:&8#>#J#
+4EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEFEC3Q$FFC3J#J#
+OKC3FEQ$C3FFJ#J#
+OKFEC3Q$FFC3J#J#J#
+OKC3FECC3C3P-C3FFJ5
+OKQ(FEC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3&J5C%
+F7F7F7F7F7OFQ(C3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFF7F7F7F7&JzC&
+F6F6F6F6F6OFQ(FEF6F6F6F6F68$J%
+F9F9F9S.F9F9F9F7Jz
+OIQ,EE
+
+
+
+
+
+
+
+
+
+
+
+
+
+<z"z"z
+0F6F7R7F6F71F6;z8z8z
+1F9R6F91F9
+
+7z8z8z
+5F7R6F74F7"J"J"
+F76F7R7F7
+ENDBITMAP
+%%EndBinary
+81 477 288 645.14 R
+7 X
+V
+4 8 Q
+0 X
+(option add *textBackground \322GhostWhite\323) 81 639.81 T
+(frame .login) 81 619.81 T
+(entryf) 81 609.81 T
+(ield .login.user -labeltext \322User:\323 \134) 109.8 609.81 T
+( -width 10 -f) 81 599.81 T
+(ixed 10 \134) 157.8 599.81 T
+( -validate alphabetic -invalid bell) 81 589.81 T
+(entryf) 81 569.81 T
+(ield .login.passwd) 109.8 569.81 T
+( -labeltext \322Password:\323 \134) 81 559.81 T
+( -show \134267 -command LoginProc) 81 549.81 T
+(Labeledwidget::alignlabels \134) 81 529.81 T
+(.login.user .login.passwd) 100.2 519.81 T
+(pack .login -padx 10 -pady 10) 81 499.81 T
+(pack .login.user -f) 81 489.81 T
+(ill x -pady 5) 172.2 489.81 T
+(pack .login.passwd -f) 81 479.81 T
+(ill x -pady 5) 181.8 479.81 T
+0 10 Q
+(FIGURE 3) 94.3 452.18 T
+1 F
+( - Login screen with aligned labels) 140.69 452.18 T
+0 0 612 792 C
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+(buttons should perform all processing of the dialog con-) 315 326.33 T
+(tents.) 315 314.33 T
+(The Dialog mega-widget class also contains a pre-) 315 296.33 T
+(de\336ned extensible location called a \322child site\323. This is) 315 284.33 T
+(an internally packed standard Tk frame which may be) 315 272.33 T
+(used as a parent for whole combinations of user speci-) 315 260.33 T
+-0.36 (\336ed widgets. Figure 5 illustrates the position of the child) 315 248.33 P
+-0.25 (site frame in an instance of the Dialog class. In the login) 315 236.33 P
+(screen example, this frame can be \336lled with the user) 315 224.33 T
+(name and password Entry\336eld mega-widgets.) 315 212.33 T
+315 333 540 720 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+315 362.14 540 720 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 4964
+254 173 130.63 88.97 0 355.37 622.03
+/red <
+72FFFFFFFFFFFFFFFFFFFFFFFFFF66F5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+FFFFFFFFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBF80808080
+8080808080808080808080808080808080808080404040404040404040404040
+4040404040404040404040000000000000000000000000000000000039C069DD
+00FF0000003333330033CCDD9999112277005544FFCC66AABBFF33EE9999CC7A
+EFD39765E1A36FE700FF5500557FB22EB099FFFFB07AFFCC0087AFB4CD73E6A2
+4DBF88F558D7439D50D080C0C080C0808060C000FFA000FFBE8BD28BD9B3FF72
+20C0A040C040D060F0E010B499A0FF0019BF2FFF6223852F465F4770FF0000FF
+> store
+/green <
+9F0000000000000000000000000099DEFFFFFFBFBFBFBFBF8080808080404040
+40000000FFFFFFFFFFBFBFBFBF808080808040404040400000000000FFFFFFFF
+FFBFBFBFBFBF8080808040404040400000000000FFFFFFFFFFBFBFBFBFBF8080
+8080804040400000000000FFFFFFBFBFBFBFBF80808040404040400063E0B500
+996699FF00663399BBFF99DD99FF112277005544CCCC66AABB6600EE6600CC69
+E3B59765E1A36FE700FF1A006B7FB28B3099FFFFB094FFF700CEEEEE0073E6A2
+4DBF88F558D74DB38080C0C080C080808060C08000A08040BE5BB477D9B3FF77
+2070A0402040D0F0F0E010B489A0E4FF19264F00B641DE4F829E4780FF0000FF
+> store
+/blue <
+FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB3BF8040FFBF804000FFBF804000FFBF80
+00BF8040FFBF804000FF804000FFBF804000FFBF804000FFBF804000FFBF8040
+00FFBF804000FFBF4000FFBF804000FFBF804000FFBF804000FFBF804000FFBF
+804000FFBF00FFBF804000BF8040FFBF804000FFBF40FFBF8040004063E0B500
+FF3399FF88666666009966DDFFFF112277DD554499FFCCAABBCC99EE9966CC69
+E3B59765E1A36FE7BFCC8BEE2F7FB257606BFBB3B015322480FAEEB40073E6A2
+4DBF88F558D756CAD050C080C08080C08060C080FF000040BE7A8C65D9B3E085
+2070C0802040D06050E010B476A0C40070264F00FC5AE050B4A0FF9000FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+6F6F7R7F6F76F6F7J"
+S6F78z8z8z
+4F9R6F94F9
+
+;z"
+S-F7F6<z"z"z"z
+0F6F7R&F6F70F6F70F6=z8z8z8z
+/F9R%F9/F9/F9
+J%J#F'
+O=FEFEFEFE5FEFEFEFEFEFEF9FEJ"8"J'Js"
+O=F9F9FFEFEF9F9F9FEP4F6F7J#8#J"Jr
+P$FEFEF9F94F9P5F9J$:*8'?#8"9$8'8$:$8'
+OHFEFEFEFEFEFEFEF9F9FEFEFEFEFEFEF9FEFEFEFEF9FEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEF9FEFE@s"J1:"8%<"9#8)8"808%J$
+F6F7O3FEFEFEF9FEFEFEF9FEFEF9F9FEFEF9F9F9FEF9FEFEF9FEFEFEFEFEF9FEFEF9F9FEFEFEFEF9FEFEF9FEFEFEF9FEFEF9F9FEF9FEFEO0F6F6F7ArJ$H"@#9"9%:$9"<"<"J"
+F9O6F9F9F9F9F9F9FEF9F9F9F9F9F9F9FEFEF9O4F9@sJ"?'I"8#H%9%J#
+F7O2FEF9FEFEFEFEF9FEF9F9F9F9F9F9F9F9F9F9O8F7F7@tJ":$9&J">%?%9%J$
+F9O0FEFEF9FEFEF9F9F9F95FEFEF9FEFEFEF9FEFEFEF9FEFEO8F9F9F9J"8$9(8(8$8"9"<08"808"9"
+O=FEFEFEFEF9F9FEFEFEF9F9FEFEFEFEFEF9FEFEF9FEFEFEF9FEFEFEFEF9F9F9F9FEFEFEF9F9FEFEF9F9FEFEFEF9F9F9F9FEFEFEF9F9FEFEFEJs9$9";"x;':$8%:$:$8sJs
+O=F9F9F9F9F9FEF9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9O=F7J&Jt
+P FEF9F9F9F9Q F9J(
+P F9FEFEFEFEFEF9=z8z8z8z
+/F7R%F7/F7/F7rF"J"F"F%
+F7F7R&F7F7F7F7F7F7'z&
+F6F6F6F6F6F7S,EEF6F6F6F6F68$J%
+F9F9F9S.F9F9F9F7
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Jz
+OKQ(A2J"
+S$FFJz"
+OMQ$C3FF
+J#9#J$<$
+4FEFEFEFEOBFEFEFEFEFEFEJ#<%G"
+P/C3C3FEC3C3C3FEJ%9%8)
+=FEFEFEFEFEFEFEFEFEFEEEFEFEEEFEFEJ.9"J&8#8#?&9$9&8&9$
+<FEFEEEEEFEFEEEFEFEEEEEFEFEFEO!FEFEFEC3FEFEFEFEFEFEFEFEFEFEFEFEFEFEC3FEFEFEFEFEFEFEFEFEFEFEJ%A&J)9"@&8&8&8&8&
+>FEEEEEEEEEEEEEEEEEJC3FEC3FEC3FEC3C3C3C3FEC3C3C3FEC3C3C3FEC3FEC3C3C3C3FEC3C3C3FEC3C3C3FEJ&:#;"J$G&
+<EEEEFEFEFEFEFEEEO?FEFEFEC3FEFEFEC3J"8"9%J%G%
+>EEFEEEEEEEEEOCC3C3C3C3C3C3C3FEJ-=#=#J"D$
+4EEFEFEEEFEFEEEEEFEFEEEEEFEFEFEFEO=FEFEC3FEJ":.J";59&8%:,
+7FEEEFEFEFEFEEEEEEEFEFEFEFEEEO%FE4FEC3C3FEFEFEC3FEC3FEFEFEFEFEFEC3FEFEFEFEC3FEFEFEC3FEFEFEFEC3FEFEFEC3C3C3FEFEFEC3J&9%9%8#:#Jr8z:$9%;$9$
+5EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEJC31C3C3C3C3C3C3C3C3C3C3C3C3C3C3
+
+
+JZ
+OMQ$J"
+OLFFJz
+OKQ(EE
+
+
+
+
+
+
+
+
+
+
+Jz
+OIQ,FE
+Jz
+OKQ(A2J"
+S$FFJz"
+OMQ$C3FFJ#
+PBFEFEJ'J#
+4FEFEFEFEFEFEO#FEFEJ&
+6EEEEEEFEFEJ%9%9%8#8#8#8%8);#
+<FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEEEFEFEEEFEFEFEFEJ5B'9"8%
+;4FEFEEEEEFEFEEEFEFEEEEEFEFEEEFEFEEEEEFEFEFEFEEEEEFEFEFEFEFEEEFEJ(=%9):$A#9":#
+6FEFEFEFEEEEEEEFEEEEEEEFEEEEEEEEEEEFEFEFEFEEEEEEEEEEEEEJ%8$9&8&J"J"<"<"<"<"
+6EEEEEEEEFEFEFEEEEEFEFEFEEEEEFEFEFE6EE:FEFEFEFEFEJ%;"8"9"8"J"<"<"<"<"
+;FEFEEEEEEEFEEEFEO"C3C3C3C3C3J%9%:)G":#
+BFEFEEEEEFEFEEEEEEEFEFEEEEEFEFEEEFEFEFEJ5B'<%
+;4EEFEFEFEEEFEFEEEFEFEFEFEEEEEEEFEFEFEFEEEEEFEFEFEFEEEEEFEFEEEJ#<v9%:#8#:%8#:&8#
+4EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
+
+J#
+PBC3C3JZ
+OMQ$J"
+OLFFJz
+OKQ(FE
+Jz
+OIQ,EE
+
+
+
+
+
+
+
+
+
+
+
+
+Jz
+EOAECJ"
+P7FFJz"
+GO=EEFF
+
+
+JZJZ
+KO5AO5J"J"
+P1ECP'ECJz"Jz"
+MO1EEECDO1EEEC
+
+
+
+
+J%:#9#J%J#
+O7FEFEFEFEFEFEFEFEO=FEFEFEFE=FEFEJ'=$J'
+O6FEFEEEEEFEFEFEFEEEO<FEFEEEEEFEFEJ$8$;$J$8(8&9%9%
+O5FEFEEEEEFEFEFEFEEEO<FEFEEEEEEEEEFEFEFEFEFEFEEEFEFEFEFEFEFEFEFEFEFEJ$J'93
+OAFEFEEEODFEFEEEEEFEFEFEEEFEFEEEFEFEEEEEFEFEEEFEFEEEEEFEFEJ#=">#
+Q:EEEEEEEEEEJ$J$I#
+OAEEFEFEOEFEFEFEFEFEJ$J%I%
+OBEEFEFEOCFEFEEEEEEEEEEEEEJ$8$<$J$8#H#;#
+O5EEFEFEFEFEEEEEFEFEO;EEFEFEFEFEFEFEFEFEJ'>$J.=.
+O6EEFEFEFEFEEEEEFEFEO;EEFEFEFEFEEEEEFEFEFEEEFEFEEEFEFEFEFEEEEEEEFEFEFEFEEEJ%:#:#J%8s8#8%9%8#
+O7EEEEEEEEEEEEEEEEO<EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
+
+
+
+
+
+
+
+JzJz
+MO1ECEO1ECJ"J"
+LECP'ECJzJz
+KO5EEAO5EE
+
+
+JZ
+GO=J"
+FFFJz
+EOAEE&J%
+F7F7F7F7F7S-F7F7F7F7&J&
+F6F6F6F6F6S-F6F6F6F6F68$J%
+F9F9F9S.F9F9F9F7
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+<z"z"z
+0F6F7R7F6F71F6;z8z8z
+1F9R6F91F9
+
+7z8z8z
+5F7R6F74F7"J"J"
+F76F7R7F7
+ENDBITMAP
+%%EndBinary
+323.29 369 530.29 616.29 R
+7 X
+V
+4 8 Q
+0 X
+(option add *textBackground \322GhostWhite\323) 323.29 610.95 T
+(frame .login) 323.29 590.95 T
+(entryf) 323.29 580.95 T
+(ield .login.user -labeltext \322User:\323 \134) 352.09 580.95 T
+( -width 10 -f) 323.29 570.95 T
+(ixed 10 \134) 400.09 570.95 T
+( -validate alphabetic -invalid bell \134) 323.29 560.95 T
+( -command {.login.bbox invoke}) 323.29 550.95 T
+(entryf) 323.29 540.95 T
+(ield .login.passwd \134) 352.09 540.95 T
+( -labeltext \322Password:\323 -show \134267 \134) 323.29 530.95 T
+( -command {.login.bbox invoke}) 323.29 520.95 T
+(Labeledwidget::alignlabels \134) 323.29 500.95 T
+( .login.user .login.passwd) 323.29 490.95 T
+(buttonbox .login.bbox -orient horizontal) 323.29 470.95 T
+(.login.bbox add OK -text OK \134) 323.29 460.95 T
+( -command LoginProc) 323.29 450.95 T
+(.login.bbox add Cancel -text Cancel \134) 323.29 440.95 T
+( -command exit) 323.29 430.95 T
+(.login.bbox default OK) 323.29 420.95 T
+(pack .login -padx 10 -pady 10) 323.29 400.95 T
+(pack .login.user -f) 323.29 390.95 T
+(ill x -pady 5) 414.48 390.95 T
+(pack .login.passwd -f) 323.29 380.95 T
+(ill x -pady 5) 424.08 380.95 T
+(pack .login.bbox -f) 323.29 370.95 T
+(ill x) 414.48 370.95 T
+0 10 Q
+(FIGURE 4) 347.35 348.02 T
+1 F
+( - Login screen with buttons) 393.74 348.02 T
+0 0 612 792 C
+315 72 540 189 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+315 90.72 540 180 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 4028
+196 140 100.8 72 0 376.2 99
+/red <
+72FFFFFFFFFFFFFFFFFFFFFFFFFF66F5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+FFFFFFFFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBF80808080
+8080808080808080808080808080808080808080404040404040404040404040
+4040404040404040404040000000000000000000000000000000000039C069DD
+00FF0000003333330033CCDD9999112277005544FFCC66AABBFF33EE9999CC7A
+EFD39765E1A36FE700FF5500557FB22EB099FFFFB07AFFCC0087AFB4CD73E6A2
+4DBF88F558D7439D50D080C0C080C0808060C000FFA000FFBE8BD28BD9B3FF72
+20C0A040C040D060F0E010B499A0FF0019BF2FFF6223852F465F4770FF0000FF
+> store
+/green <
+9F0000000000000000000000000099DEFFFFFFBFBFBFBFBF8080808080404040
+40000000FFFFFFFFFFBFBFBFBF808080808040404040400000000000FFFFFFFF
+FFBFBFBFBFBF8080808040404040400000000000FFFFFFFFFFBFBFBFBFBF8080
+8080804040400000000000FFFFFFBFBFBFBFBF80808040404040400063E0B500
+996699FF00663399BBFF99DD99FF112277005544CCCC66AABB6600EE6600CC69
+E3B59765E1A36FE700FF1A006B7FB28B3099FFFFB094FFF700CEEEEE0073E6A2
+4DBF88F558D74DB38080C0C080C080808060C08000A08040BE5BB477D9B3FF77
+2070A0402040D0F0F0E010B489A0E4FF19264F00B641DE4F829E4780FF0000FF
+> store
+/blue <
+FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB3BF8040FFBF804000FFBF804000FFBF80
+00BF8040FFBF804000FF804000FFBF804000FFBF804000FFBF804000FFBF8040
+00FFBF804000FFBF4000FFBF804000FFBF804000FFBF804000FFBF804000FFBF
+804000FFBF00FFBF804000BF8040FFBF804000FFBF40FFBF8040004063E0B500
+FF3399FF88666666009966DDFFFF112277DD554499FFCCAABBCC99EE9966CC69
+E3B59765E1A36FE7BFCC8BEE2F7FB257606BFBB3B015322480FAEEB40073E6A2
+4DBF88F558D756CAD050C080C08080C08060C080FF000040BE7A8C65D9B3E085
+2070C0802040D06050E010B476A0C40070264F00FC5AE050B4A0FF9000FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+6F6F7Q+F6F76F6F7J"
+R*F78z8z8z
+4F9Q*F94F9
+
+;z"
+R!F7F6<z"z
+0F6F7Q<F6=z8z
+/F9Q;F9
+Jr:#@$
+OGFEFEFEFEFEFEJ"8&E"
+OGF9F9F9F9FEFEF9J$8#J#
+OMF9FEFEF9F9;FEFEJ$9%@$:&
+P#FEFEFEFEFEFEFEFEFEFEFEFEFEFEF9@s"J"<%=/
+F6F7O>F9F9F9FEFEFEFEFEF9FEFEFEF9FEFEF9F9FEFEArJ$A$
+F9OEF9FEFEF9F9F9@sJ%G'
+F7ODFEFEF9F9F9FEFEFEFEF9@tJ$?"A$9&
+F9O:FEFEF9FEFEF9FEFEF9F9F9F9J"8&8"8'8$8*8&
+OGFEFEFEFEFEF9FEFEF9F9FEFEF9FEF9FEFEF9F9F9FEFEFEF9F9FEFEFEFEFEJr9%8v9$9";"
+OGF9F9F9F9F9F9F9F9F9F9FEJ&
+P=FEF9F9F9F9J(
+P=F9FEFEFEFEFEF9=z8z
+/F7Q;F7rF"J%
+F7F7Q<F7F7F7F7'z&
+F6F6F6F6F6F7R EEF6F6F6F6F68$J%
+F9F9F9R"F9F9F9F7
+
+
+
+
+
+
+
+Jz
+CPBFE
+
+
+
+J$8"8#B$@#D#G%8";$?#
+KFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFJ(8"J#D#G)
+IFFFFFEFEFEFFFFFF9FFFFFFFFFFFFFEFEFEFEFFFFJ$9"9"J#D#F$:"
+HFFFFFEFEFE9FEFEFEFEFFFFFEFEJ"G$J"<$
+O!FEFEFEFEO$FEFEFEFEJ$<"J"
+GFFFFFEFEO8FE
+J%<%J$I"A%<$8%=$
+O(FFFFFFFFFFFFFFFF6FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFJ';#J'F"8"@#>$8%;(
+O'FFFEFEFEFFFFFEFE6FFFFFEFEFEFFFEFFFEFEFEFEFEFEFEFEFEFFFFFEFEFEFFFFJ"9$J$9"G"8$J$9$
+O'FEFEFFFF;FFFFFEFEFEFFFFFF>FFFFFEFEFFFFJ#9#J"
+P4FEFEFFFFEFFJ$J$8"J$;"
+OHFFFFFE9FEFEFEFF:FFFFFEFEJ"8"JR
+P9FEFF;J"Jt
+P:FE=FE
+
+J$<"J$J"J&
+GFEFFFFFFEFEFFFF5FFAFFFEFEFFFFJ"<$J"
+P3FFFFFFFECFFJ$9$J$9"H":$G$9#8$:$
+HFEFFFFFFFFFEFFEFFFFFFFFFFFFFEFEFFFFFFFEFEFFFFFFFFFEJ(8"8"9"8"9#8#<#8#<'8"D);#8#>':)
+IFEFEFFFFFFFEFEFFFFFFFFFFFFFFFFFFFFFFFFFEFEFFFFFFFEFFFEFEFFFFFFFFFEFEFFFFFFFFFEFFFFFFFFFEFEFEFFFFFFFFFEFEJ$:%9%9'<'>rC"8%='?%=%
+KFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFE
+
+
+
+
+Jz
+CPBEE
+
+
+
+
+
+
+
+
+<z
+R EC=z"
+QLEEFF=Z
+QL<z
+R EE
+
+
+
+
+
+
+
+Ez
+OAECJ"
+P!FFGz"
+O=EEFF
+
+
+JZJZ
+5O54O5J"J"
+OIECOHECJz"Jz"
+7O1EEEC7O1EEEC
+
+
+
+
+J%:#9#J%J#
+O!FEFEFEFEFEFEFEFEO0FEFEFEFE=FEFEJ'=$J'
+O FEFEEEEEFEFEFEFEEEO/FEFEEEEEFEFEJ$8$;$J$8(8&9%9%
+MFEFEEEEEFEFEFEFEEEO/FEFEEEEEEEEEFEFEFEFEFEFEEEFEFEFEFEFEFEFEFEFEFEJ$J'93
+O+FEFEEEO7FEFEEEEEFEFEFEEEFEFEEEFEFEEEEEFEFEEEFEFEEEEEFEFEJ#=">#
+PEEEEEEEEEEEJ$J$I#
+O+EEFEFEO8FEFEFEFEFEJ$J%I%
+O,EEFEFEO6FEFEEEEEEEEEEEEEJ$8$<$J$8#H#;#
+MEEFEFEFEFEEEEEFEFEO.EEFEFEFEFEFEFEFEFEJ'>$J.=.
+O EEFEFEFEFEEEEEFEFEO.EEFEFEFEFEEEEEFEFEFEEEFEFEEEFEFEFEFEEEEEEEFEFEFEFEEEJ%:#:#J%8s8#8%9%8#
+O!EEEEEEEEEEEEEEEEO/EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
+
+
+
+
+
+
+&J%
+F7F7F7F7F7R!F7F7F7F7&HzJzG&
+F6F6F6F6F6O1EC8O1ECF6F6F6F6F68$G"J"J%
+F9F9F9ECOHECOCF9F9F9F7JzJz
+5O5EE4O5EE
+
+
+GZ
+O=F"
+FFEz
+OAEE
+
+
+
+
+
+
+
+<z"z"z
+0F6F7Q+F6F71F6;z8z8z
+1F9Q*F91F9
+
+7z8z8z
+5F7Q*F74F7"J"J"
+F76F7Q+F7
+ENDBITMAP
+%%EndBinary
+0 10 Q
+(FIGURE 5) 369 74.89 T
+1 F
+( - Dialog child site) 415.39 74.89 T
+0 0 612 792 C
+FMENDPAGE
+%%EndPage: "3" 3
+%%Page: "4" 4
+612 792 0 FMBEGINPAGE
+[0 0 0 1 0 0 0]
+[ 0 1 1 0 1 0 0]
+[ 1 0 1 0 0 1 0]
+[ 1 1 0 0 0 0 1]
+[ 1 0 0 0 0 1 1]
+[ 0 1 0 0 1 0 1]
+[ 0 0 1 0 1 1 0]
+ 7 FrameSetSepColors
+FrameNoSep
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+-0.02 (Once a dialog is created, it is displayed based on modal-) 72 713.33 P
+(ity via the \324activate\325 command. For application and glo-) 72 701.33 T
+(bal modal dialogs, control is not immediately returned.) 72 689.33 T
+-0.06 (Instead, it is delayed until invocation of the \324deactivate\325) 72 677.33 P
+(command which accepts an optional ar) 72 665.33 T
+(gument that is) 227.62 665.33 T
+(returned as a result of the \324activate\325 command. This) 72 653.33 T
+-0.08 (allows user control of dialog unmapping, status noti\336ca-) 72 641.33 P
+(tion, and determination.) 72 629.33 T
+(For example, two buttons could be added to a global) 72 607.33 T
+-0.17 (modal dialog, each button specifying a command which) 72 595.33 P
+(executes the \324deactivate\325 command with a unique ar) 72 583.33 T
+(gu-) 279.82 583.33 T
+(ment. The application could then activate the dialog,) 72 571.33 T
+(wait for deactivation, and perform actions based on the) 72 559.33 T
+(return value. This could all be placed in an \322if\323 state-) 72 547.33 T
+(ment. The Dialog class uses this optional deactivation) 72 535.33 T
+(ar) 72 523.33 T
+(gument to provide default return values of zero and) 79.59 523.33 T
+(one for the \322OK\323 and \322Cancel\323 buttons as indicators of) 72 511.33 T
+-0.06 (the dialog exit status. This ability proves useful for stan-) 72 499.33 P
+(dard dialog management.) 72 487.33 T
+-0.34 (Figure 6 illustrates the new login screen implemented as) 72 463.33 P
+(an application modal Dialog composed of the two) 72 451.33 T
+(Entry\336elds. The need for explicit default button bind-) 72 439.33 T
+72 76 297 436 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+72 98.29 297 436 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 7633
+254 176 130.63 90.51 0 123.86 339.34
+/red <
+3EC472FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+FFFFFFFFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBF80808080
+8080808080808080808080808080808080808080404040404040404040404040
+4040404040404040404040000000000000000000000000000000000039C069DD
+00FF0000003333330033CCDD9999112277005544FFCC66AABBFF33EE9999CC7A
+EFD39765E1A36FE700FF5500B2557F2EAFB4CD73E6A24DBF008799FFFFF5B0B0
+7AFFCC88BE8BD28BD9B3FF72439D58D750D080C0C080C0808060C000FFA000FF
+20C0A040C040D060F0E010B4A099FF0019BF2FFF6223852F465F4770FF0000FF
+> store
+/green <
+57D79F00000000000000000000000000FFFFFFBFBFBFBFBF8080808080404040
+40000000FFFFFFFFFFBFBFBFBF808080808040404040400000000000FFFFFFFF
+FFBFBFBFBFBF8080808040404040400000000000FFFFFFFFFFBFBFBFBFBF8080
+8080804040400000000000FFFFFFBFBFBFBFBF80808040404040400063E0B500
+996699FF00663399BBFF99DD99FF112277005544CCCC66AABB6600EE6600CC69
+E3B59765E1A36FE700FF1A00B26B7F8BEEEE0073E6A24DBF00CE99FFFFF530B0
+94FFF788BE5BB477D9B3FF774DB358D78080C0C080C080808060C08000A08040
+2070A0402040D0F0F0E010B4A089E4FF19264F00B641DE4F829E4780FF0000FF
+> store
+/blue <
+8CFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBF8040FFBF804000FFBF804000FFBF80
+00BF8040FFBF804000FF804000FFBF804000FFBF804000FFBF804000FFBF8040
+00FFBF804000FFBF4000FFBF804000FFBF804000FFBF804000FFBF804000FFBF
+804000FFBF00FFBF804000BF8040FFBF804000FFBF40FFBF8040004063E0B500
+FF3399FF88666666009966DDFFFF112277DD554499FFCCAABBCC99EE9966CC69
+E3B59765E1A36FE7BFCC8BEEB22F7F57EEB40073E6A24DBF80FA6BFBB3F560B0
+15322488BE7A8C65D9B3E08556CA58D7D050C080C08080C08060C080FF000040
+2070C0802040D06050E010B4A076C40070264F00FC5AE050B4A0FF9000FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+6F6F7R7F6F76F6F7J"
+S6F78z8z8z
+4F9R6F94F9
+
+;z"
+S-F7F6<z"z
+0F6F7RHF6=z8z
+/F9RGF9
+J%J#F'
+P FEFEFEFE5FEFEFEFEFEFEF9FEJ"8"J'
+P F9F9FFEFEF9F9F9FEJ#8#J"
+P5FEFEF9F94F9J$:*8'?#8"9$8'8$:$8'
+P+FEFEFEFEFEFEFEF9F9FEFEFEFEFEFEF9FEFEFEFEF9FEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEF9FEFE@s"J1:"8%<"9#8)8"808%
+F6F7ODFEFEFEF9FEFEFEF9FEFEF9F9FEFEF9F9F9FEF9FEFEF9FEFEFEFEFEF9FEFEF9F9FEFEFEFEF9FEFEF9FEFEFEF9FEFEF9F9FEF9FEFEArJ$H"@#9"9%:$9"<"<"
+F9OGF9F9F9F9F9F9FEF9F9F9F9F9F9F9FEFEF9@sJ"?'I"8#H%9%
+F7OCFEF9FEFEFEFEF9FEF9F9F9F9F9F9F9F9F9F9@tJ":$9&J">%?%9%
+F9OAFEFEF9FEFEF9F9F9F95FEFEF9FEFEFEF9FEFEFEF9FEFEJ"8$9(8(8$8"9"<08"808"9"
+P FEFEFEFEF9F9FEFEFEF9F9FEFEFEFEFEF9FEFEF9FEFEFEF9FEFEFEFEF9F9F9F9FEFEFEF9F9FEFEF9F9FEFEFEF9F9F9F9FEFEFEF9F9FEFEFEJs9$9";"x;':$8%:$:$8s
+P F9F9F9F9F9FEF9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9J&
+P1FEF9F9F9F9J(
+P1F9FEFEFEFEFEF9=z8z
+/F7RGF7rF"J%
+F7F7RHF7F7F7F7'z&
+F6F6F6F6F6F7S,EEF6F6F6F6F68$J%
+F9F9F9S.F9F9F9F7
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+J5
+OKQ(BDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEJ5
+OKQ(FEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDJ#z"
+OKBDFEQ%BDFFJ#J#
+OKFEBDQ$FFBDJ#9#J#F$<$J#
+4FEFEFEFEO0BDFEFEFEFEFEFEFEP6BDFFJ#F#<%G"J#
+OKFEBDBDBDFEBDBDBDFEP$FFBDJ%9%8)J#J#
+=FEFEFEFEFEFEFEFEFEFEEEFEFEEEFEFEGBDFEQ$BDFFJ.9"J)8#8#?&9$9&8&9$J#
+<FEFEEEEEFEFEEEFEFEEEEEFEFEFELFEBDBDFEFEFEBDFEFEFEFEFEFEFEFEFEFEFEFEFEFEBDFEFEFEFEFEFEFEFEFEFEFEOIFFBDJ%A&J,9"@&8&8&8&8&J#
+>FEEEEEEEEEEEEEEEEEGBDFEBDBDFEBDFEBDFEBDBDBDBDFEBDBDBDFEBDBDBDFEBDFEBDBDBDBDFEBDBDBDFEBDBDBDFEOHBDFFJ&:#;"J#J$G&J#
+<EEEEFEFEFEFEFEEELFEBD?FEFEFEBDFEFEFEBDOHFFBDJ"8"9%J#J%G%J#
+>EEFEEEEEEEEEO"BDFE?BDBDBDBDBDBDBDFEOHBDFFJ-=#=#J#J"D$J#
+4EEFEFEEEFEFEEEEEFEFEEEEEFEFEFEFEGFEBDBFEFEBDFEOLFFBDJ":.J%;59&8%:,J#
+7FEEEFEFEFEFEEEEEEEFEFEFEFEEEO"BDFEBDFE4FEBDBDFEFEFEBDFEBDFEFEFEFEFEFEBDFEFEFEFEBDFEFEFEBDFEFEFEFEBDFEFEFEBDBDBDFEFEFEBDOHBDFFJ&9%9%8#:#J"t8z:$9%;$9$J#
+5EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEGFEBD1BDBDBDBDBDBDBDBDBDBDBDBDBDBDOIFFBDJ#J#
+OKBDFEQ$BDFFJ#J#
+OKFEBDQ$FFBDJ#J#
+OKBDFEQ$BDFFJ5
+OKQ(FEBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDJ5
+OKQ(BDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFJz
+OKQ(EE
+
+
+
+
+
+
+
+
+
+
+Jz
+OIQ,FE
+J5
+OKQ'BDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDJ5
+OKQ(FEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDJ#z"
+OKBDFEQ%BDFFJ#J#J#
+OKFEBDCFEFEP-FFBDJ'J#B#J#
+4FEFEFEFEFEFEO#FEFEBDFEQ$BDFFJ&J#J#
+6EEEEEEFEFEO0FEBDQ$FFBDJ%9%9%8#8#8#8%8);#>#J#
+<FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEEEFEFEEEFEFEFEFEBDFEQ$BDFFJ5B'9"8%D#J#
+;4FEFEEEEEFEFEEEFEFEEEEEFEFEEEFEFEEEEEFEFEFEFEEEEEFEFEFEFEFEEEFEFEBDQ$FFBDJ(=%9):$A#9":#>#J#
+6FEFEFEFEEEEEEEFEEEEEEEFEEEEEEEEEEEFEFEFEFEEEEEEEEEEEEEBDFEQ$BDFFJ%8$9&8&J"J#:"<"<"<"<"J#
+6EEEEEEEEFEFEFEEEEEFEFEFEEEEEFEFEFE6EE4FEBDFEFEFEFEFEP1FFBDJ%;"8"9"8"J#:"<"<"<"<"J#
+;FEFEEEEEEEFEEEFEJBDFEBDBDBDBDBDP1BDFFJ%9%:)G":#>#J#
+BFEFEEEEEFEFEEEEEEEFEFEEEEEFEFEEEFEFEFEFEBDQ$FFBDJ5B'<%D#J#
+;4EEFEFEFEEEFEFEEEFEFEFEFEEEEEEEFEFEFEFEEEEEFEFEFEFEEEEEFEFEEEBDFEQ$BDFFJ#<v9%:#8#:%8#:&8#>#J#
+4EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEFEBDQ$FFBDJ#J#
+OKBDFEQ$BDFFJ#J#
+OKFEBDQ$FFBDJ#J#J#
+OKBDFECBDBDP-BDFFJ5
+OKQ(FEBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDJ5
+OKQ(BDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFJz
+OKQ(FE
+Jz
+OIQ,EE
+
+
+
+
+
+
+
+
+
+
+
+
+
+<z
+S,ED=z"
+S*EEFF=Z
+S*<z
+S,EE
+
+
+
+
+
+
+
+Jz
+BOAEDJ"
+P4FFJz"
+DO=EEFF
+
+
+JZJZ
+HO5GO5J"J"
+P.EDP-EDJz"Jz"
+JO1EEEDJO1EEED
+
+
+
+
+J%:#9#J%J#
+O4FEFEFEFEFEFEFEFEOCFEFEFEFE=FEFEJ'=$J'
+O3FEFEEEEEFEFEFEFEEEOBFEFEEEEEFEFEJ$8$;$J$8(8&9%9%
+O2FEFEEEEEFEFEFEFEEEOBFEFEEEEEEEEEFEFEFEFEFEFEEEFEFEFEFEFEFEFEFEFEFEJ$J'93
+O>FEFEEEOJFEFEEEEEFEFEFEEEFEFEEEFEFEEEEEFEFEEEFEFEEEEEFEFEJ#=">#
+Q=EEEEEEEEEEJ$J$I#
+O>EEFEFEOKFEFEFEFEFEJ$J%I%
+O?EEFEFEOIFEFEEEEEEEEEEEEEJ$8$<$J$8#H#;#
+O2EEFEFEFEFEEEEEFEFEOAEEFEFEFEFEFEFEFEFEJ'>$J.=.
+O3EEFEFEFEFEEEEEFEFEOAEEFEFEFEFEEEEEFEFEFEEEFEFEEEFEFEFEFEEEEEEEFEFEFEFEEEJ%:#:#J%8s8#8%9%8#
+O4EEEEEEEEEEEEEEEEOBEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
+
+
+
+
+
+
+&J%
+F7F7F7F7F7S-F7F7F7F7&JzJzJ&
+F6F6F6F6F6EO1EDKO1EDEF6F6F6F6F68$J"J"J%
+F9F9F9DEDP-EDP)F9F9F9F7JzJz
+HO5EEGO5EE
+
+
+JZ
+DO=J"
+CFFJz
+BOAEE
+
+
+
+
+
+
+
+<z"z"z
+0F6F7R7F6F71F6;z8z8z
+1F9R6F91F9
+
+7z8z8z
+5F7R6F74F7"J"J"
+F76F7R7F7
+ENDBITMAP
+%%EndBinary
+81.71 104.71 288.71 333.71 R
+7 X
+V
+4 8 Q
+0 X
+(option add *textBackground \322GhostWhite\323) 81.71 328.38 T
+(dialog .login -modality application) 81.71 308.38 T
+(.login hide Apply) 81.71 298.38 T
+(.login hide Help) 81.71 288.38 T
+(set cs [.login childsite]) 81.71 268.38 T
+(entryf) 81.71 248.38 T
+(ield $cs.user -labeltext \322User:\323 \134) 110.51 248.38 T
+( -width 10 -f) 81.71 238.38 T
+(ixed 10 \134) 158.51 238.38 T
+( -validate alphabetic) 81.71 228.38 T
+(entryf) 81.71 218.38 T
+(ield $cs.passwd \134) 110.51 218.38 T
+( -labeltext \322Password:\323 -show \134267) 81.71 208.38 T
+(pack $cs.user -f) 81.71 188.38 T
+(ill x -pady 5) 158.51 188.38 T
+(pack $cs.passwd -f) 81.71 178.38 T
+(ill x -pady 5) 168.11 178.38 T
+(Labeledwidget::alignlabels \134) 81.71 158.38 T
+( $cs.user $cs.passwd) 81.71 148.38 T
+(if {[.login activate]} {) 81.71 128.38 T
+( LoginProc [$cs.user get] [$cs.passwd get]) 81.71 118.38 T
+(}) 81.71 108.38 T
+0 10 Q
+(FIGURE 6) 135 83.61 T
+1 F
+( - Login dialog) 181.39 83.61 T
+0 0 612 792 C
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+(ings has been left to the Dialog class, making the appli-) 315 713.33 T
+(cation even cleaner) 315 701.33 T
+(.The comparative amount of T) 391.64 701.33 T
+(cl/Tk) 512.86 701.33 T
+(code required to provide the same \337exible functionality) 315 689.33 T
+(would be quite substantial.) 315 677.33 T
+(Since [incr W) 315 653.33 T
+(idgets] was designed to be a means rather) 370.14 653.33 T
+-0.03 (than an end, each mega-widget is itself extensible. [incr) 315 641.33 P
+(Tk] provides the mechanism and framework to build) 315 629.33 T
+(new mega-widgets based upon existing ones using) 315 617.33 T
+(object-oriented techniques such as inheritance and com-) 315 605.33 T
+(position. [incr W) 315 593.33 T
+(idgets] provides \322child sites\323 which) 382.65 593.33 T
+(enable the visual aspects of a mega-widget to be aug-) 315 581.33 T
+(mented.) 315 569.33 T
+(The login screen example could bene\336t from this capa-) 315 545.33 T
+(bility) 315 533.33 T
+(. A new \322Login\323 mega-widget derived from the) 335.47 533.33 T
+(Dialog class can be created, encapsulating the combina-) 315 521.33 T
+-0.14 (tion of widgets required to implement login screen func-) 315 509.33 P
+-0.18 (tionality and enable reuse across many new projects. As) 315 497.33 P
+(a mega-widget, the Login class should maintain the) 315 485.33 T
+(standard options such as background and cursor) 315 473.33 T
+(. It) 506.08 473.33 T
+(should also provide unique options for specifying the) 315 461.33 T
+(labels of the entry widgets so they may be easily modi-) 315 449.33 T
+-0.4 (\336ed. Figure 7 shows the [incr T) 315 437.33 P
+-0.4 (cl]/[incr Tk] code needed) 437.74 437.33 P
+(to implement the \322Login\323 mega-widget class.) 315 425.33 T
+(The Login mega-widget can now be reused in new) 315 401.33 T
+-0.39 (applications. It can be used as the front end to a database) 315 389.33 P
+(or a system administration tool. Since the labels were) 315 377.33 T
+(made public, the Login class can even be international-) 315 365.33 T
+(ized. For example, the \322-userlabel\323, \322-passwdlabel\323) 315 353.33 T
+(options could be given in a foreign dialect or read from) 315 341.33 T
+(a language speci\336c con\336guration \336le. Since the Login) 315 329.33 T
+(class was derived from the Dialog class, the button) 315 317.33 T
+(labels may be modi\336ed as well. T) 315 305.33 T
+(o illustrate, Figure 8) 449.01 305.33 T
+(depicts an instance of the Login mega-widget in Span-) 315 293.33 T
+(ish.) 315 281.33 T
+(One \336nal point. It should be noted that the lack of an) 315 257.33 T
+-0.12 (option being made public does not make it inaccessible.) 315 245.33 P
+(The dilemma is that keeping all options tends to cause) 315 233.33 T
+-0.1 (option explosion, yet only providing a few limits useful-) 315 221.33 P
+(ness. As a general rule, standard options should be kept) 315 209.33 T
+(as well as frequently used options. In the Login mega-) 315 197.33 T
+(widget, standard options were kept and each label was) 315 185.33 T
+(provided a unique option due to a high degree of antici-) 315 173.33 T
+-0.36 (pated usage. Other options such as \322-foreground\323 can be) 315 161.33 P
+(accessed on an as needed basis via the [incr Tk] \324com-) 315 149.33 T
+-0.37 (ponent\325 command or using the option database. Figure 9) 315 137.33 P
+(illustrates both of these methods of component access.) 315 125.33 T
+FMENDPAGE
+%%EndPage: "4" 4
+%%Page: "5" 5
+612 792 0 FMBEGINPAGE
+[0 0 0 1 0 0 0]
+[ 0 1 1 0 1 0 0]
+[ 1 0 1 0 0 1 0]
+[ 1 1 0 0 0 0 1]
+[ 1 0 0 0 0 1 1]
+[ 0 1 0 0 1 0 1]
+[ 0 0 1 0 1 1 0]
+ 7 FrameSetSepColors
+FrameNoSep
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+72 225 540 729 R
+7 X
+0 0 0 1 0 0 0 K
+V
+4 8 Q
+0 X
+( itcl::class Login {) 72 713.67 T
+( inherit) 72 703.67 T
+5 F
+(iwidgets::Dialog) 139.2 703.67 T
+4 F
+( constructor {args} {) 72 683.67 T
+( itk_component add user {) 72 673.67 T
+( Entryf) 72 663.67 T
+(ield $itk_interior.user -labeltext \322User:\323 -width 10 \134) 168 663.67 T
+( -f) 72 653.67 T
+(ixed 10 -validate alphabetic) 268.8 653.67 T
+( } {) 72 643.67 T
+( keep -cursor -background) 72 633.67 T
+( }) 72 623.67 T
+( pack $itk_component\050user\051 -f) 72 613.67 T
+(ill x -pady 5) 254.4 613.67 T
+( itk_component add passwd {) 72 593.67 T
+( Entryf) 72 583.67 T
+(ield $itk_interior.passwd -labeltext \322Password:\323 -show \134267) 163.2 583.67 T
+( } {) 72 573.67 T
+( keep -cursor -background) 72 563.67 T
+( }) 72 553.67 T
+( pack $itk_component\050passwd\051 -f) 72 543.67 T
+(ill x -pady 5) 264 543.67 T
+( hide Help) 72 523.67 T
+( hide Apply) 72 513.67 T
+( eval itk_initialize $args) 72 493.67 T
+( }) 72 483.67 T
+( itk_option def) 72 463.67 T
+(ine -userlabel userLabel Text \322User:\323 {) 168 463.67 T
+( $itk_component\050user\051 conf) 72 453.67 T
+(igure -labeltext $itk_option\050-userlabel\051) 240 453.67 T
+( Labeledwidget::alignlabels $itk_component\050user\051 $itk_component\050passwd\051) 72 443.67 T
+( }) 72 433.67 T
+( itk_option def) 72 413.67 T
+(ine -passwdlabel passwdLabel Text \322Password:\323 {) 168 413.67 T
+( $itk_component\050passwd\051 conf) 72 403.67 T
+(igure -labeltext $itk_option\050-passwdlabel\051) 249.6 403.67 T
+( Labeledwidget::alignlabels $itk_component\050user\051 $itk_component\050passwd\051) 72 393.67 T
+( }) 72 383.67 T
+( method name {} {) 72 363.67 T
+( return [$itk_component\050user\051 get]) 72 353.67 T
+( }) 72 343.67 T
+( method passwd {} {) 72 323.67 T
+( return [$itk_component\050passwd\051 get]) 72 313.67 T
+( }) 72 303.67 T
+( }) 72 293.67 T
+( Login .login -title \322Login Screen\323 -modality application) 72 273.67 T
+( if {[.login activate]} {) 72 253.67 T
+( LoginProc [.login name] [.login passwd]) 72 243.67 T
+( }) 72 233.67 T
+72 225 540 729 R
+0.5 H
+2 Z
+N
+72 207 540 216 R
+7 X
+V
+0 10 Q
+0 X
+(FIGURE 7) 189.15 209.33 T
+1 F
+( - [incr T) 235.54 209.33 T
+(cl]/[incr Tk] Login mega-widget class) 270.66 209.33 T
+72 90 540 198 R
+7 X
+V
+4 8 Q
+0 X
+( Login .login -title \322Spanish Login Screen\323 \134) 72 182.67 T
+( -userlabel \322Nombre:\323 \134) 72 172.67 T
+( -passwdlabel \322Contrasena:\323 \134) 72 162.67 T
+( -modality application) 72 152.67 T
+( .login buttonconf) 72 142.67 T
+(igure OK -text \322Bien\323) 187.2 142.67 T
+( .login buttonconf) 72 132.67 T
+(igure Cancel -text \322Cancelar\323) 187.2 132.67 T
+( if {[.login activate]} {) 72 112.67 T
+( LoginProc [.login name] [.login passwd]) 72 102.67 T
+( }) 72 92.67 T
+72 90 540 198 R
+N
+%%BeginBinary: 8344
+280 176 144 90.51 0 360 98.49
+/red <
+72FFFFFFFFFFFFFFFFFFFFFFFFFF66F5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+FFFFFFFFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBF80808080
+8080808080808080808080808080808080808080404040404040404040404040
+4040404040404040404040000000000000000000000000000000000039C069DD
+00FF0000003333330033CCDD9999112277005544FFCC66AABBFF33EE9999CC7A
+EFD3557F9765E1A36FE700FF5500B22EB099FFFFB07AFFCC0087AFB48858D7CD
+73E6A24DBFF5439D50D080C0C080C0808060C000FFA000FF20C0A040C040D060
+F0E010B4BE8BD28BD9B3FF72A099FF00192FBFFF6223852F465F4770FF0000FF
+> store
+/green <
+9F0000000000000000000000000099DEFFFFFFBFBFBFBFBF8080808080404040
+40000000FFFFFFFFFFBFBFBFBF808080808040404040400000000000FFFFFFFF
+FFBFBFBFBFBF8080808040404040400000000000FFFFFFFFFFBFBFBFBFBF8080
+8080804040400000000000FFFFFFBFBFBFBFBF80808040404040400063E0B500
+996699FF00663399BBFF99DD99FF112277005544CCCC66AABB6600EE6600CC69
+E3B56B7F9765E1A36FE700FF1A00B28B3099FFFFB094FFF700CEEEEE8858D700
+73E6A24DBFF54DB38080C0C080C080808060C08000A080402070A0402040D0F0
+F0E010B4BE5BB477D9B3FF77A089E4FF194F2600B641DE4F829E4780FF0000FF
+> store
+/blue <
+FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB3BF8040FFBF804000FFBF804000FFBF80
+00BF8040FFBF804000FF804000FFBF804000FFBF804000FFBF804000FFBF8040
+00FFBF804000FFBF4000FFBF804000FFBF804000FFBF804000FFBF804000FFBF
+804000FFBF00FFBF804000BF8040FFBF804000FFBF40FFBF8040004063E0B500
+FF3399FF88666666009966DDFFFF112277DD554499FFCCAABBCC99EE9966CC69
+E3B52F7F9765E1A36FE7BFCC8BEEB257606BFBB3B015322480FAEEB48858D700
+73E6A24DBFF556CAD050C080C08080C08060C080FF0000402070C0802040D060
+50E010B4BE7A8C65D9B3E085A076C400704F2600FC5AE050B4A0FF9000FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+6F6F7S#F6F76F6F7J"
+T"F78z8z8z
+4F9S"F94F9
+
+;z"
+SGF7F6<z"z
+0F6F7S4F6=z8z
+/F9S3F9
+J'J#>$@%J#F'
+O@FEFEFEFEF9FE;FEFEFEFEFEFEFEFEFE5FEFEFEFEFEFEF9FEJ'J"B"8"J'
+O?FEFEF9F9F9FEFF9F9F9FFEFEF9F9F9FEJ"J#J#8#J"
+ODF9<F9F9JFEFEF9F94F9J#8(:%9'9$9%;#H$:*8'?#8"9$8'8$:$8'
+OAFEFEF9FEFEFEF9FEFEFEFEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEF9F9FEFEFEFEFEFEF9FEFEFEFEF9FEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEF9FEFE@s"J"9%8&9%8"8%8":%;%E1:"8%<"9#8)8"808%
+F6F7O,F9FEFEF9F9FEF9FEFEFEF9F9FEFEF9FEF9FEFEF9FEF9F9F9FEF9FEFEFEFEFEF9FEFEFEF9FEFEF9F9FEFEF9F9F9FEF9FEFEF9FEFEFEFEFEF9FEFEF9F9FEFEFEFEF9FEFEF9FEFEFEF9FEFEF9F9FEF9FEFEArJ#9"9$:$="A%:"J$H"@#9"9%:$9"<"<"
+F9O.F9F9FEF9F9F9F9FEFEF9FEFEFEF9F94F9F9F9F9F9F9FEF9F9F9F9F9F9F9FEFEF9@sJ"8#A%H"9"J"?'I"8#H%9%
+F7O-FEF9F9FEFEF9F9F9FE5FEF9FEFEFEFEF9FEF9F9F9F9F9F9F9F9F9F9@tJ">$<"H%J":$9&J">%?%9%
+F9O-FEFEF9FEFEFEF9F9F95FEFEF9FEFEF9F9F9F95FEFEF9FEFEFEF9FEFEFEF9FEFEJ'9+8$8"9$8"8'8"9";"8$9(8(8$8"9"<08"808"9"
+O@F9FEFEFEFEF9F9FEFEF9F9F9F9FEFEF9FEF9FEFEFEF9FEFEFEFEFEF9F9FEFEFEFEFEFEFEF9F9FEFEFEF9F9FEFEFEFEFEF9FEFEF9FEFEFEF9FEFEFEFEF9F9F9F9FEFEFEF9F9FEFEF9F9FEFEFEF9F9F9F9FEFEFEF9F9FEFEFEJ';#:z8s;s9$9";"x;':$8%:$:$8s
+O?F9F9F9F9F9F9F9F99F9F9F9F9F9F9F9FEF9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9J&
+Q-FEF9F9F9F9J"8"J(
+OFFEFEO1F9FEFEFEFEFEF9=z8z
+/F7S3F7rF"J%
+F7F7S4F7F7F7F7'z&
+F6F6F6F6F6F7SFEEF6F6F6F6F68$J%
+F9F9F9SHF9F9F9F7
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+J5
+P7Q(C5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEJ5
+P7Q(FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5J#z"
+P7C5FEQ%C5FFJ#J#
+P7FEC5Q$FFC5J#9#I#J#F$<$J#
+4FEFEFEFEFEFEO5C5FEFEFEFEFEFEFEP6C5FFJ"J#F#<%G"J#
+6FEP FEC5C5C5FEC5C5C5FEP$FFC5J%8*;#8+9#J#J#
+=FEFEFEFEFEEEFEFEFEEEFEFEFEFEFEFEFEEEFEFEEEFEFEFEFEFEFEO!C5FEQ$C5FFJ#:'8*9%9"8'J)8#8#?&9$9&8&9$J#
+6EEFEFEFEEEEEFEFEFEEEEEFEFEEEEEFEFEFEEEFEFEFEFEFEEEEEFEFEO%FEC5C5FEFEFEC5FEFEFEFEFEFEFEFEFEFEFEFEFEFEC5FEFEFEFEFEFEFEFEFEFEFEOIFFC5J"=#>#J,9"@&8&8&8&8&J#
+O"EEEEEEEEEEO!C5FEC5C5FEC5FEC5FEC5C5C5C5FEC5C5C5FEC5C5C5FEC5FEC5C5C5C5FEC5C5C5FEC5C5C5FEOHC5FFJ#J":#J#J$G&J#
+7EEFE>EEFEFEO'FEC5?FEFEFEC5FEFEFEC5OHFFC5J%J#J%G%J#
+O.EEEEEEEEO%C5FE?C5C5C5C5C5C5C5FEOHC5FFJ"J"C#8#J#J"D$J#
+8EE7FEFEFEFEFEO!FEC5BFEFEC5FEOLFFC5J'D%<'J%;59&8%:,J#
+<EEFEFEFEFEEEEEFEFEEEEEFEFEFEFEEEO%C5FEC5FE4FEC5C5FEFEFEC5FEC5FEFEFEFEFEFEC5FEFEFEFEC5FEFEFEC5FEFEFEFEC5FEFEFEC5C5C5FEFEFEC5OHC5FFJ#9#8%8#8#8s8#:%9#J"t8z:$9%;$9$J#
+4EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEO!FEC51C5C5C5C5C5C5C5C5C5C5C5C5C5C5OIFFC5J#J#
+P7C5FEQ$C5FFJ#J#
+P7FEC5Q$FFC5J#J#
+P7C5FEQ$C5FFJ5
+P7Q(FEC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5J5
+P7Q(C5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFJz
+P7Q(EE
+
+
+
+
+
+
+
+
+
+
+Jz
+P5Q,FE
+J5
+P7Q'C5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5J5
+P7Q(FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5FEC5J#z"
+P7C5FEQ%C5FFJ#J#J#
+P7FEC5CFEFEP-FFC5J%F#J#J#
+6FEFEFEFEFEFEO9C5FEQ$C5FFJ'J#J#
+5FEFEEEEEFEFEOJFEC5Q$FFC5J$8(8&8"8-9%9%8&9%9#J#J#
+4FEFEEEEEEEEEFEFEFEFEFEFEEEFEFEFEFEEEFEFEEEFEFEEEFEFEFEFEFEFEFEFEFEFEFEFEFEFEEEFEFEFEFEFEFEFEFE:C5FEQ$C5FFJ'9'8"9"859,J#J#
+;FEFEEEEEFEFEFEEEFEFEEEEEEEFE4FEFEEEEEFEFEEEFEFEEEEEFEFEEEFEFEEEEEFEFEFEEEFEFEEEFEFEEEEEFEFE>FEC5Q$FFC5J"B%=%@":#<#J#J#
+DEEEEEEEEEEFEEEEEEEEEEEEEEEEE:C5FEQ$C5FFJ"9$9&:#A$J#:"<"<"<"<"J#
+O"EEFEFEFEEEEEFEFEFEFEFEFEFEFE@FEC5FEFEFEFEFEP1FFC5J%;"8"9%>%J#:"<"<"<"<"J#
+O%FEFEEEEEEEFEEEEEEEEEFEFEEEEE@C5FEC5C5C5C5C5P1C5FFJ$8#H"B%=#F#J#J#
+4EEFEFEFEFEFEFEFEEEEEFEFEFEFE:FEC5Q$FFC5J-?%;5>(J#J#
+5EEFEFEFEFEEEEEFEFEFEFEEEEEFEFEEE4EEFEFEFEEEFEFEEEFEFEFEFEEEEEEEFEFEFEFEEEEEFEFEFEEEFEFE=C5FEQ$C5FFJ%8%8#8#9&:v9%8#8#8tJ#J#
+6EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE:FEC5Q$FFC5J#J#
+P7C5FEQ$C5FFJ#J#
+P7FEC5Q$FFC5J#J#J#
+P7C5FECC5C5P-C5FFJ5
+P7Q(FEC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5J5
+P7Q(C5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFC5FFJz
+P7Q(FE
+Jz
+P5Q,EE
+
+
+
+
+
+
+
+
+
+
+
+
+
+<z
+SFED=z"
+SDEEFF=Z
+SD<z
+SFEE
+
+
+
+
+
+
+
+Jz
+KOAEDJ"
+P=FFJz"
+MO=EEFF
+
+
+JZJZ
+O#O5O"O5J"J"
+P7EDP6EDJz"Jz"
+O%O1EEEDO%O1EEED
+
+
+
+
+J'8#J%J#
+O7FEFEFEFEFEFEFEFEP#FEFEFEFE=FEFEJ)J'
+O9EEEEEEFEFEEEEEEEP"FEFEEEEEFEFEJ#8%8&J$8(8&9%9%<%8&
+O?FEFEFEFEFEFEFEFEEEFEFEOBFEFEEEEEEEEEFEFEFEFEFEFEEEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEEEFEFEJ'9%J'93:'9"
+OBFEFEEEEEFEFEFEEEFEFEOHFEFEEEEEFEFEFEEEFEFEEEFEFEEEEEFEFEEEFEFEEEEEFEFEFEFEEEEEFEFEFEJ&C"J#=">#A#>#
+O9FEFEFEFEEEEEOKEEEEEEEEEEEEEEEEEEJ&<#J$I#=$;"
+O9EEEEEEFEFEFEFEP$FEFEFEFEFEFEFEFEEEJ%J%I%:%
+ODEEEEEEEEP!FEFEEEEEEEEEEEEEFEFEEEEEJ#J$8#H#;#
+OFFEFEOHEEFEFEFEFEFEFEFEFEJ&:'J.=.:(
+O9FEFEFEFEEEEEFEFEFEFEEEOIEEFEFEFEFEEEEEFEFEFEEEFEFEEEFEFEFEFEEEEEEEFEFEFEFEEEEEFEFEFEEEFEFEJ'8#8%8#8#J%8s8#8%9%8#8s
+O7EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEOCEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
+
+
+
+
+
+
+&J%
+F7F7F7F7F7SGF7F7F7F7&JzJzJ&
+F6F6F6F6F6O O1EDO&O1EDMF6F6F6F6F68$J"J"J%
+F9F9F9MEDP6EDP1F9F9F9F7JzJz
+O#O5EEO"O5EE
+
+
+JZ
+MO=J"
+LFFJz
+KOAEE
+
+
+
+
+
+
+
+<z"z"z
+0F6F7S#F6F71F6;z8z8z
+1F9S"F91F9
+
+7z8z8z
+5F7S"F74F7"J"J"
+F76F7S#F7
+ENDBITMAP
+%%EndBinary
+72 72 540 81 R
+7 X
+V
+0 10 Q
+0 X
+(FIGURE 8) 237.26 74.33 T
+1 F
+( - Spanish login screen) 283.64 74.33 T
+FMENDPAGE
+%%EndPage: "5" 5
+%%Page: "6" 6
+612 792 0 FMBEGINPAGE
+[0 0 0 1 0 0 0]
+[ 0 1 1 0 1 0 0]
+[ 1 0 1 0 0 1 0]
+[ 1 1 0 0 0 0 1]
+[ 1 0 0 0 0 1 1]
+[ 0 1 0 0 1 0 1]
+[ 0 0 1 0 1 1 0]
+ 7 FrameSetSepColors
+FrameNoSep
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 12 Q
+0 X
+0 0 0 1 0 0 0 K
+(Bene\336ts) 164.17 572 T
+1 10 Q
+(The bene\336ts of mega-widget usage increase proportion-) 72 547.33 T
+(ally with the complexity of the application. This was) 72 535.33 T
+(readily apparent in the login screen example. Replace-) 72 523.33 T
+-0.44 (ment of the more elemental patterns was mostly a matter) 72 511.33 P
+(of convenience. Y) 72 499.33 T
+(et as requirements were added, the) 144.03 499.33 T
+(code savings became substantial. As the example) 72 487.33 T
+(reached a medium level of complexity) 72 475.33 T
+(, the bene\336ts) 224.93 475.33 T
+-0.24 (extended to consistent usage of style. Productivity gains) 72 463.33 P
+(also became quite noticeable.) 72 451.33 T
+(As applications increase in size, invariably requiring a) 72 427.33 T
+(main window and numerous dialogs, mega-widget) 72 415.33 T
+-0.33 (usage of) 72 403.33 P
+-0.33 (fers signi\336cant productivity gains and increased) 105.09 403.33 P
+(reliability) 72 391.33 T
+(. This could also be seen in the example as) 110.24 391.33 T
+(well. A savings of a sizable amount of straight T) 72 379.33 T
+(cl/Tk) 265.72 379.33 T
+-0.46 (code was achieved and implementation of such things as) 72 367.33 P
+(modality was abstracted into the Dialog mega-widget) 72 355.33 T
+(and it\325) 72 343.33 T
+(s base classes. Since the Dialog class is encapsu-) 97.28 343.33 T
+(lated and tested, the Login mega-widget was built on a) 72 331.33 T
+-0.24 (sound foundation. Errors typical of \322cut and paste\323 built) 72 319.33 P
+(applications, such as for) 72 307.33 T
+(getting to release a grab, have) 168.47 307.33 T
+(been eliminated. Developers are free to concentrate on) 72 295.33 T
+(the application and not low level problems.) 72 283.33 T
+(T) 72 259.33 T
+(o draw an analogy to current building construction) 77.41 259.33 T
+-0.24 (techniques, Tk widgets are bricks and mega-widgets are) 72 247.33 P
+-0.19 (pre-formed walls built with bricks. It is much quicker to) 72 235.33 P
+(construct a lar) 72 223.33 T
+(ge building using walls than bricks.) 128.47 223.33 T
+(Although in the construction industry) 72 211.33 T
+(, this creates a lot) 221.35 211.33 T
+(of cookie cutter) 72 199.33 T
+(, identical, and boring buildings, appli-) 134.36 199.33 T
+-0.46 (cation users appreciate this consistency) 72 187.33 P
+-0.46 (, especially when) 226.72 187.33 P
+(it increases usability) 72 175.33 T
+(. A user shouldn\325) 153.01 175.33 T
+(t be confused dur-) 221.71 175.33 T
+(ing the operation of an application by being presented) 72 163.33 T
+(variant combinations of the same widget patterns. Each) 72 151.33 T
+(one having a unique behavior which users must learn) 72 139.33 T
+(during operation, rather than from prior experiences) 72 127.33 T
+(with other more standard interfaces.) 72 115.33 T
+(The signi\336cance of a consistent style should not be) 72 91.33 T
+(overlooked. It doesn\325) 72 79.33 T
+(t always appear in typical T) 157.08 79.33 T
+(cl/Tk) 267.19 79.33 T
+72 598 297 720 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+72 626 297 707 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+81 635 288 698 R
+7 X
+V
+4 8 Q
+0 X
+(option add *Login*user.foreground Red) 81 692.67 T
+1 10 Q
+( Or) 81 669.33 T
+4 8 Q
+(.login component user conf) 81 650.67 T
+(igure \134) 205.8 650.67 T
+( -foreground Red) 81 640.67 T
+0 10 Q
+(FIGURE 9) 109.91 610.17 T
+1 F
+( -Login component access) 156.3 610.17 T
+0 0 612 792 C
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+-0.28 (applications. This stems from Tk itself. Its greatest asset) 315 713.33 P
+-0.38 (is also a liability: a simple and easy to use widget set. Tk) 315 701.33 P
+(can make it easy for novice programmers to construct) 315 689.33 T
+(interfaces which conform to random personal styles) 315 677.33 T
+(rather than any known industry standards. Many) 315 665.33 T
+-0.34 (unusual applications have been produced with Tk which) 315 653.33 P
+(have sunken buttons, raised entries, or are packed with) 315 641.33 T
+(such a lack of padding as to create \322brick walls\323 of wid-) 315 629.33 T
+(gets. Applications which exhibit these qualities can be) 315 617.33 T
+(found at the T) 315 605.33 T
+(cl/Tk archive site. Mega-widgets can) 370.68 605.33 T
+(lessen the occurrence of these visual works of art while) 315 593.33 T
+(maintaining simplicity and ease of use. For example,) 315 581.33 T
+(use of the [incr W) 315 569.33 T
+(idgets] Buttonbox mega-widget can) 386.8 569.33 T
+(stop the button \322brick wall\323 ef) 315 557.33 T
+(fect.) 436.19 557.33 T
+0 12 Q
+(Look-and-Feel) 389.83 526 T
+1 10 Q
+(It is visually evident from the example that the look-) 315 501.33 T
+(and-feel of [incr W) 315 489.33 T
+(idgets] is Motif. Adherence to the) 391.51 489.33 T
+(style guide is close. Little ef) 315 477.33 T
+(fort has been spent attempt-) 427.59 477.33 T
+(ing to make minor improvements. This is even more) 315 465.33 T
+(clear in some of the lar) 315 453.33 T
+(ger [incr W) 406.74 453.33 T
+(idget] dialog mega-) 452.43 453.33 T
+(widget classes such as the FileSelectionDialog. The) 315 441.33 T
+(Motif likeness is also evident in the initial selection of) 315 429.33 T
+(classes which comprise the mega-widget set, including) 315 417.33 T
+(most of the Motif favorites. It even extends beyond) 315 405.33 T
+(appearance to behavior and options.) 315 393.33 T
+(The Motif look-and-feel was chosen because of its) 315 369.33 T
+-0.17 (strength in the industry and customer requirements. The) 315 357.33 P
+-0.12 (demand of the current [incr W) 315 345.33 P
+-0.12 (idgets] customer base is a) 435.35 345.33 P
+(Motif appearance and behavior) 315 333.33 T
+(, regardless of the under-) 439.28 333.33 T
+(lying implementation. Thus, very few liberties were) 315 321.33 T
+(taken in the visual style and behavioral aspects of [incr) 315 309.33 T
+(W) 315 297.33 T
+(idgets]. Instead, concepts such as extensible child) 324.04 297.33 T
+(sites and \337exible component con\336guration option sets) 315 285.33 T
+(have been implemented which allow developer diver-) 315 273.33 T
+(gence from the Motif style on an as needed basis.) 315 261.33 T
+0 12 Q
+(Extensibility) 395.16 230 T
+1 10 Q
+-0.01 (The extensibility of [incr W) 315 211.33 P
+-0.01 (idgets] is based on a similar) 426.2 211.33 P
+(concept found in Motif called \322child sites\323 which allow) 315 199.33 T
+(the basic functionality and visual appearance of an) 315 187.33 T
+(existing mega-widget to be augmented. The idea is sim-) 315 175.33 T
+(ple, yet it yields a powerful mechanism by which mega-) 315 163.33 T
+-0.1 (widgets become malleable and reusable. They allow for) 315 151.33 P
+(the possibility of unanticipated future requirements,) 315 139.33 T
+(making for a much less restrictive widget set.) 315 127.33 T
+(Consider an application which requires a icon selection) 315 103.33 T
+(dialog, visually displaying the icon as the textual name) 315 91.33 T
+-0.08 (is selected from the list. Also, suppose we would like to) 315 79.33 P
+FMENDPAGE
+%%EndPage: "6" 6
+%%Page: "7" 7
+612 792 0 FMBEGINPAGE
+[0 0 0 1 0 0 0]
+[ 0 1 1 0 1 0 0]
+[ 1 0 1 0 0 1 0]
+[ 1 1 0 0 0 0 1]
+[ 1 0 0 0 0 1 1]
+[ 0 1 0 0 1 0 1]
+[ 0 0 1 0 1 1 0]
+ 7 FrameSetSepColors
+FrameNoSep
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+(see this canvas on which the icon is presented lie) 72 713.33 T
+(between the listbox and entry widget. This could easily) 72 701.33 T
+(be implemented using the [incr W) 72 689.33 T
+(idgets] Selectiondia-) 207.97 689.33 T
+(log mega-widget which maintains a child site, as) 72 677.33 T
+(depicted in Figure 10.) 72 665.18 T
+(The advantages of child sites can be seen by examining) 72 641.18 T
+(the opposite situation. Had the SelectionDialog been) 72 629.18 T
+(designed minus a child site, the user would have been) 72 617.18 T
+72 72 297 603 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+72 90 297 594 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 12737
+222 379 114.17 194.91 0 128.83 387
+/red <
+3EC472FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+FFFFFFFFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBF80808080
+8080808080808080808080808080808080808080404040404040404040404040
+4040404040404040404040000000000000000000000000000000000039C069DD
+00FF0000003333330033CCDD9999112277005544FFCC66AABBFF33EE9999CC7A
+EFD39765E1A36FE700FF5500B2557F2EAFB4CD73E6A24DBF008799FFFFF5B0B0
+7AFFCC88BE8BD28BD9B3FF72439D58D750D080C0C080C0808060C000FFA000FF
+20C0A040C040D060F0E010B4A099FF0019BF2FFF6223852F465F4770FF0000FF
+> store
+/green <
+57D79F00000000000000000000000000FFFFFFBFBFBFBFBF8080808080404040
+40000000FFFFFFFFFFBFBFBFBF808080808040404040400000000000FFFFFFFF
+FFBFBFBFBFBF8080808040404040400000000000FFFFFFFFFFBFBFBFBFBF8080
+8080804040400000000000FFFFFFBFBFBFBFBF80808040404040400063E0B500
+996699FF00663399BBFF99DD99FF112277005544CCCC66AABB6600EE6600CC69
+E3B59765E1A36FE700FF1A00B26B7F8BEEEE0073E6A24DBF00CE99FFFFF530B0
+94FFF788BE5BB477D9B3FF774DB358D78080C0C080C080808060C08000A08040
+2070A0402040D0F0F0E010B4A089E4FF19264F00B641DE4F829E4780FF0000FF
+> store
+/blue <
+8CFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBF8040FFBF804000FFBF804000FFBF80
+00BF8040FFBF804000FF804000FFBF804000FFBF804000FFBF804000FFBF8040
+00FFBF804000FFBF4000FFBF804000FFBF804000FFBF804000FFBF804000FFBF
+804000FFBF00FFBF804000BF8040FFBF804000FFBF40FFBF8040004063E0B500
+FF3399FF88666666009966DDFFFF112277DD554499FFCCAABBCC99EE9966CC69
+E3B59765E1A36FE7BFCC8BEEB22F7F57EEB40073E6A24DBF80FA6BFBB3F560B0
+15322488BE7A8C65D9B3E08556CA58D7D050C080C08080C08060C080FF000040
+2070C0802040D06050E010B4A076C40070264F00FC5AE050B4A0FF9000FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+6F6F7QEF6F76F6F7J"
+RDF78z8z8z
+4F9QDF94F9
+
+;z"
+R;F7F6<z"z
+0F6F7R(F6=z8z
+/F9R'F9
+J%J'>$H"
+O>FEFEFEFE>FEFEFEFEF9FEFEFEFEFEJ"8"J'?"I"
+O>F9F9=FEFEF9F9F9FEF9FEJ"
+P6F9J$:$9'?#8"9$?$:$8"8#8$9'
+OEFEFEFEFEFEFEFEFEFEF9FEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEF9FEFE@s"J18%<"9#8'<08,8"
+F6F7O0FEFEFEF9FEFEF9FEFEFEF9FEFEFEF9F9FEF9FEFEF9FEFEFEFEFEF9FEFEFEFEFEF9FEFEF9FEFEFEF9FEFEF9F9F9F9FEFEFEF9FEFEFEF9F9FEArJ%9$<"@#9":"A";%>$<$
+F9O3F9F9F9F9F9F9F9F9F9F9FEFEFEF9F9F9F9F9F9F9F9F9F9@sJ"8#;%>%
+F7OMFEF9F9F9F9F9F9F9F9F9F9@tJ%9$G">%>%9%>$
+F9O2FEF9FEFEFEF9FEFEFEF9FEFEFEF9FEFEFEF9FEFEFEF9FEJ"838"9"<0808.8"
+O>FEFEF9F9F9FEFEFEF9F9F9F9FEFEFEF9F9F9FEFEFEF9FEFEFEFEF9F9F9F9FEFEFEF9F9FEFEF9F9F9FEFEFEF9F9F9F9FEFEFEF9F9FEFEF9F9F9FEFEFEF9F9F9FEFEJ%9$:$9s;':$8%9$:$:#9$9%
+O>F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9
+
+=z8z
+/F7R'F7rF"J%
+F7F7R(F7F7F7F7'z&
+F6F6F6F6F6F7R:EEF6F6F6F6F68$J%
+F9F9F9R<F9F9F9F7
+
+
+
+
+
+
+
+
+
+
+
+
+J#
+4FEFE
+J%9%8&9%
+8FEFEFEFEFEFEFEFEFEFEEEFEFEFEFEFEFEJ.9,
+7FEFEEEEEFEFEEEFEFEEEEEFEFEFEEEFEFEEEFEFEEEEEFEFEJ#@"<%
+;EEEEEEFEEEEEEEJ&
+LEEEEFEFEFEJ"8"
+O EEFEJ#E%
+;FEFEFEFEEEEEJ.>'
+7EEFEFEFEFEEEEEEEFEFEFEFEEEEEFEFEFEFEEEJ#8%9%8#8#8%
+4EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
+
+
+
+
+
+
+
+H5=z
+Q6BDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFE3EDH5J"
+Q6FEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBD9FFH#z"?r"r"
+BDFEQ3BDFFE6EDE6FFH#J#E"
+FEBDQ2FFBDFFH&I#J#G"
+BDFEBDFEFEFEFEPHBDFFEDH%J"J#D"
+FEBDBDBD4BDPIFFBDFFH#J#F$
+BDFEQ2BDFFEEEDEDH#9$:$8&:$J#C$
+FEBDFEFEFEFEFEFEFEFEFEBDFEFEFEFEPEFFBDFFFFEEH#9%8-9%J#G$
+BDFEBDBDBDFEFEBDBDBDFEBDBDFEBDFEBDFEBDBDBDFEPDBDFFEEEDEDH#J#B$
+FEBDQ2FFBDFFFFEEH#J#H$
+BDFEQ2BDFFEEEDEDH#J#A$
+FEBDQ2FFBDFFFFEEH*8(;(J#I$
+BDFEBDFEBDFEFEFEBDBDFEFEFEBDBDFEFEFEBDFEFEFEBDPDBDFFEEEDEDH"r:$8wJ#@$
+FEBDBDBDBDBDPEFFBDFFFFEEH#J#J$
+BDFEQ2BDFF4EEEDEDH#J#?#u
+FEBDQ2FFBDFFFFEDH#J#@"B"
+BDFEQ2BDFFEDEDH#J#?z
+FEBDQ2FFBD/E6H#J#?Z
+BDFEQ2BDFF/H#J#J"
+FEBDQ2FFBD7EDH#J#Av"
+BDFEQ2BDFFEEEDH#J#
+FEBDQ2FFBDH#J#
+BDFEQ2BDFFH#8$:$8&8&9&9$:$:$J#
+FEBDFEFEFEFEFEFEFEFEFEBDFEFEBDFEFEFEFEBDFEFEFEFEFEFEFEFEFEFEFEFEP*FFBDH)848&8&8&8&J#
+BDFEBDFEBDBDBDFEFEBDBDBDFEBDBDFEBDFEBDFEBDBDFEBDBDBDFEBDFEBDBDBDFEBDBDBDFEFEBDBDBDFEFEBDBDBDFEP)BDFFH#;"J$9&8&J#
+FEBDBD?FEFEFEBDFEFEFEBDBDFEFEFEBDP)FFBDH#J%9%9%J#
+BDFEEBDBDBDBDBDBDBDFEBDBDBDFEP)BDFFH#;"J"8"<"J#
+FEBDFEBFEFEFEP-FFBDH)8(;"8%8%9&8&8&J#
+BDFEBDBDFEFEFEBDBDFEFEFEBDBDFEFEFEFEFEBDFEFEFEFEBDFEFEFEBDBDFEFEFEBDBDFEFEFEBDP)BDFFH#8$:$8r8$9%:$:$:$J#
+FEBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDP*FFBDH#J#
+BDFEQ2BDFFH#J$J#
+FEBD5FEFEFEPHFFBDH#J$J#
+BDFE5BDBDBDPHBDFFH#J#
+FEBDQ2FFBDH5
+Q6BDFEE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFE6FFBDFFH$z#
+FEBDFFQ1E6FFBDH$J$
+BDFEE6Q0FEBDFFH$J$
+FEBDFFQ0E6FFBDH$J$
+BDFEE6Q0FEBDFFH(:$9&9$J$
+FEBDFFE6FEFEFEFEFEFEFEE6FEFEFEFEFEFEPEE6FFBDH)8&8&8&J$
+BDFEE6FEE6E6E6FEFEE6E6E6FEE6FEE6E6E6FEE6E6E6FEPDFEBDFFH$:"G$J$
+FEBDFFE6FEFEFEPEE6FFBDH$J%J$
+BDFEE66E6E6E6E6PDFEBDFFH$:"J"J$
+FEBDFFFE4FEPDE6FFBDH)8&8%9&J$
+BDFEE6E6FEFEFEE6E6FEFEFEE6FEFEFEFEE6FEFEFEE6PDFEBDFFH(:$9%:$J$
+FEBDFFE6E6E6E6E6E6E6E6E6E6E6E6E6E6PEE6FFBDH$J$
+BDFEE6Q0FEBDFFH$J$
+FEBDFFQ0E6FFBDH$J$
+BDFEE6Q0FEBDFFH5
+Q6FEBDFFE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FEE6FFBDH#z"
+BDFEQ3BDFFH#J#
+FEBDQ2FFBDH#:#J#
+BDFEFEFEQ,BDFFH#:"J#
+FEBDBDQ-FFBDH#J#
+BDFEQ2BDFFH#8$:$:$J#
+FEBDFEFEFEFEFEFEFEFEFEPMFFBDH(9&8&J#
+BDFEBDFEBDBDBDFEBDBDBDFEFEBDBDBDFEPLBDFFH#>&<"J#
+FEBDBDFEFEFEBDBDPLFFBDH#?%J#
+BDFEBDBDBDFEQ%BDFFH#>"@"J#
+FEBDFEFEPLFFBDH08&J#
+BDFEBDBDFEFEFEBDFEBDBDFEFEFEBDBDFEFEFEBDPLBDFFH#8&8$:$J#
+FEBDBDBDBDBDBDBDBDBDBDBDBDPMFFBDH#J#
+BDFEQ2BDFFH#J#
+FEBDQ2FFBDH#J#
+BDFEQ2BDFFH#J#
+FEBDQ2FFBDH#J#
+BDFEQ2BDFFH#J#
+FEBDQ2FFBDH#J#
+BDFEQ2BDFFH#J#
+FEBDQ2FFBDH#J#
+BDFEQ2BDFFH#8$8&9%:$:$J#
+FEBDFEFEFEFEFEFEBDFEFEFEFEFEFEFEFEFEFEFEP?FFBDH08&8&8&J#
+BDFEBDFEBDBDBDFEBDBDFEBDFEBDFEBDBDBDBDFEFEBDBDBDFEFEBDBDBDFEP>BDFFH#8$A$="8&J#
+FEBDFEFEFEFEFEFEBDBDFEFEFEBDP>FFBDH#8%?%A%J#
+BDFEBDBDBDBDFEBDBDBDBDBDBDFEP>BDFFH#;"J"8"J#
+FEBDFE4FEFEPBFFBDH+;/8&J#
+BDFEBDBDFEFEFEBDBDFEFEBDBDFEFEFEBDFEBDBDFEFEFEBDBDFEFEFEBDP>BDFFH#8$8r8&8$:$J#
+FEBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDP?FFBDH#J#
+BDFEQ2BDFFH#J#
+FEBDQ2FFBDH#J#
+BDFEQ2BDFFH#J#
+FEBDQ2FFBDH#J#
+BDFEQ2BDFFH#J#
+FEBDQ2FFBDH&I#J#J#
+BDFEBDFEFEFEFE>FEFEP(BDFFH%J"J"J#
+FEBDBDBD4BD?BDP)FFBDH#J#
+BDFEQ2BDFFH#;#9$8(8$:$9%9&9$J#
+FEBDFEFEFEFEFEFEFEFEBDFEFEFEFEFEFEFEFEFEFEFEFEFEFEBDFEFEFEFEFEFEP)FFBDH#:$8.8%8&8&8&8%J#
+BDFEFEBDBDFEBDBDBDFEBDBDFEBDBDBDFEBDBDBDBDFEFEBDBDBDFEBDBDBDBDFEBDFEBDBDBDFEBDBDBDP)BDFFH#9#;$J$J#
+FEBDFEBDFEFEFE9FEFEFEP7FFBDH#9#;%8&F%J#
+BDFEBDFEBDBDBDBDBDFEBDFEBDFEBDBDBDP7BDFFH#:#=":"J#
+FEBDBDFEFEFEPMFFBDH%9*9$8'8&8,9'J#Av
+BDFEBDFEBDFEFEBDBDFEFEFEBDBDFEBDFEBDFEFEFEBDBDFEFEFEBDBDFEFEFEBDFEBDFEFEFEFEBDFEFEFEBDFEP'BDFFEDH&9#8$?&:$:u:&J#@"
+FEBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDP'FFBDEDH#J#?z
+BDFEQ2BDFF/E6H#F$J#
+FEBDFEFEBDPMFFBDH#F#J#
+BDFEBDBDQ BDFFH#J#
+FEBDQ2FFBDH#J#
+BDFEQ2BDFFH#J#
+FEBDQ2FFBDH#E$G#J#
+BDFEFEFEFEFEFEP;BDFFH#8"B#H"J#
+FEBDFEBDBDBDP<FFBDH#J#
+BDFEQ2BDFFH)9$A$8&;#:$8&:$J#
+FEBDBDFEFEFEFEFEFEFEFEFEFEFEFEBDFEFEFEFEFEFEFEFEFEBDFEFEFEFEFEFEP#FFBDH)8&?-9%8-8&J#
+BDFEBDBDFEBDBDBDFEBDBDBDFEFEBDBDBDFEBDBDFEBDBDBDFEFEBDBDFEFEBDBDBDFEBDBDFEFEBDBDFEFEBDBDBDFEP"BDFFH#?$A$A"C"<$J#?Z
+FEBDFEFEFEFEFEFEBDBDFEFEFEP#FFBD/H#?%@%J%J#?"C"
+BDFEBDBDBDBDBDBDBDBD?BDBDBDBDP"BDFFE6EDH#<";"C"J"J#Bt$
+FEBDFEFEFEBFEP"FFBDEEEDEDE6H#8,8-959(J#@$
+BDFEBDFEFEFEBDBDBDFEFEFEBDFEFEFEFEFEFEBDBDFEFEFEBD6FEFEFEBDBDFEFEFEBDFEFEFEBDBDFEFEFEBDBDFEFEFEFEBDBDFEFEFEBDP"BDFFE6FFFFH#9$9$9'8$:$8r8$8$8#8$J#J$
+FEBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDBDP#FFBD4EDEDE6H#J#A$
+BDFEQ2BDFFE6FFFFH#J$J#I$
+FEBD<FEFEFEPAFFBDEDEDE6H#J$J#B$
+BDFE<BDBDBDPABDFFE6FFFFH#J#H$
+FEBDQ2FFBDEDEDE6H#J#C$
+BDFEQ2BDFFE6FFFFH#J#G$
+FEBDQ2FFBDEDEDE6H#J#J#D$
+BDFE<FEFEPBBDFFE6FFEDH#8"J"J#H"
+FEBDFE9BDPCFFBDE6H#J#E"
+BDFEQ2BDFFE6H)8&8%:$;#J#G"
+FEBDBDFEFEFEFEFEFEBDFEFEFEFEFEFEFEFEFEFEFEFEP?FFBDE6H5?Z
+Q6BDFEBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFF/H5>"
+Q6FEBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFHz=z
+Q6EE3EE
+
+
+
+
+HZ
+R"J"
+R3EDJz"
+4QLEEED
+
+
+
+
+
+
+
+J#
+P6FEFEJ"8"
+P5FEFEJ"
+P;FEJ&
+P8EEEEFEFEFEJ":"
+P8FEFEJ"
+P5EEJ"8":"
+P6EEFEFEJ">#:#
+P1FEEEEEFEFEJ$:"="8"
+P0FEFEFEEEFEFEJ"9"
+P7FEFEJ"<"
+P3FEFEJ";"<"9#
+P0EEFEEEEEEEJ"8"
+P>EEFEJ"?"8"
+P5FEEEFEJ"8#8#
+P0FEEEFEEEEEJ"C"
+P/FEFEJ"9#;";"
+P.FEEEFEEEFEJ#9"="
+P1EEFEEEFEJ"="
+P:EEEEJ"8"@$
+P-FEEEEEEEEEJ#?"
+P6FEFEEEJ"
+P2EEJ"8#
+P0FEEEEEJ"=$
+P-EEEEEEEEJ$
+P8FEFEFEJ$<"9"
+P.EEEEEEFEFE
+J#=$
+P5FEFEEEEEEEJ$
+P2FEFEFEJ$
+P/FEFEFEJ#
+P-FEFEJ"
+P;EEJ"
+P,FEJ"
+P:EEJ#D#
+P*FEFEFEFEJ#H"
+P(FEFEFEJ"
+P=FE
+J#
+P&FEFEJ#J$
+P$FEFE8FEFEFEJ"J"
+P#FE=FE
+
+J"
+PBFE
+J#J"
+P#EEEE=EEJz
+P%=EE
+
+
+
+
+
+Jz
+4QLEDI"
+EDHz
+R"EE
+
+
+
+
+
+
+
+
+
+
+
+
+J#
+4FEFE
+J%9%8&
+8FEFEFEFEFEFEFEFEFEFEEEFEFEJ.9%
+7FEFEEEEEFEFEEEFEFEEEEEFEFEFEEEFEFEJ#@"
+;EEEEEE
+
+J#
+;FEFEJ.
+7EEFEFEFEFEEEEEEEFEFEFEFEEEJ#8%9%8#8#
+4EEEEEEEEEEEEEEEEEEEEEEEEEEEE
+
+
+
+
+
+
+
+
+H5
+R!BDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDH5
+R!FEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFEBDFFH#z#
+BDFEQKBDFFBDH#J#
+FEBDQKBDFFH#J#
+BDFEQKFFBDH#J#
+FEBDQKBDFFH#J#
+BDFEQKFFBDH#9$:$9&9$J#
+FEBDFEFEFEFEFEFEFEBDFEFEFEFEFEFEQ0BDFFH#8&8&8&8&J#
+BDFEFEBDBDBDFEFEBDBDBDFEBDFEBDBDBDFEBDBDBDFEQ/FFBDH#<"G$J#
+FEBDBDFEFEFEQ0BDFFH#J%J#
+BDFE8BDBDBDBDQ/FFBDH#<"J"J#
+FEBDFE4FEQ/BDFFH#8&8&8%9&J#
+BDFEBDFEFEFEBDBDFEFEFEBDFEFEFEFEBDFEFEFEBDQ/FFBDH#9$:$9%:$J#
+FEBDBDBDBDBDBDBDBDBDBDBDBDBDBDQ0BDFFH#J#
+BDFEQKFFBDH#J#
+FEBDQKBDFFH#J#
+BDFEQKFFBDH5
+R!FEBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFH5
+R!BDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDFFBDHz
+R!EE
+
+
+
+
+
+
+
+
+
+
+<z
+R:ED=z"
+R8EEFF=Z
+R8<z
+R:EE
+
+
+
+
+
+
+
+Jz
+9O?EDJ"
+P)FFJz"
+;O;EEFF
+
+
+JZJZ
+?O3>O3J"J"
+P#EDP"EDJz"Jz"
+AO/EEEDAO/EEED
+
+
+
+
+J%:#9#J%J#
+O+FEFEFEFEFEFEFEFEO8FEFEFEFE=FEFEJ'=$J'
+O*FEFEEEEEFEFEFEFEEEO7FEFEEEEEFEFEJ$8$;$J$8(8&9%9%
+O)FEFEEEEEFEFEFEFEEEO7FEFEEEEEEEEEFEFEFEFEFEFEEEFEFEFEFEFEFEFEFEFEFEJ$J'93
+O5FEFEEEO?FEFEEEEEFEFEFEEEFEFEEEFEFEEEEEFEFEEEFEFEEEEEFEFEJ#=">#
+Q)EEEEEEEEEEJ$J$I#
+O5EEFEFEO@FEFEFEFEFEJ$J%I%
+O6EEFEFEO>FEFEEEEEEEEEEEEEJ$8$<$J$8#H#;#
+O)EEFEFEFEFEEEEEFEFEO6EEFEFEFEFEFEFEFEFEJ'>$J.=.
+O*EEFEFEFEFEEEEEFEFEO6EEFEFEFEFEEEEEFEFEFEEEFEFEEEFEFEFEFEEEEEEEFEFEFEFEEEJ%:#:#J%8s8#8%9%8#
+O+EEEEEEEEEEEEEEEEO7EEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEEE
+
+
+
+
+&J%
+F7F7F7F7F7R;F7F7F7F7&JzJzJ&
+F6F6F6F6F6<O/EDBO/ED;F6F6F6F6F68$J"J"J%
+F9F9F9;EDP"EDOKF9F9F9F7JzJz
+?O3EE>O3EE
+
+
+JZ
+;O;J"
+:FFJz
+9O?EE
+
+
+
+
+
+
+
+<z"z"z
+0F6F7QEF6F71F6;z8z8z
+1F9QDF91F9
+
+7z8z8z
+5F7QDF74F7"J"J"
+F76F7QEF7
+ENDBITMAP
+%%EndBinary
+81 99 288 378 R
+7 X
+V
+4 8 Q
+0 X
+(selectiondialog .iconSel \134) 81 372.67 T
+( -title \322Icon Selector\323 \134) 81 362.67 T
+( -itemslabel Icons \134) 81 352.67 T
+( -selectionlabel Icon \134) 81 342.67 T
+( -itemscommand SelectProc) 81 332.67 T
+(.iconSel hide Help) 81 322.67 T
+(.iconSel hide Apply) 81 312.67 T
+(set cs [.iconSel childsite]) 81 292.67 T
+(canvas $cs.canvas -height 70 \134) 81 282.67 T
+( -relief raised -borderwidth 2) 81 272.67 T
+(pack $cs.canvas -f) 81 262.67 T
+(ill x -expand yes) 167.4 262.67 T
+(proc SelectProc {} {) 81 242.67 T
+( .iconSel selectitem) 81 232.67 T
+( set c [.iconSel childsite].canvas) 81 222.67 T
+( $c delete all) 81 212.67 T
+( $c create bitmap \134) 81 202.67 T
+( [expr [winfo width $c] / 2] \134) 81 192.67 T
+( [expr [winfo height $c] / 2] \134) 81 182.67 T
+( -bitmap @~/xbm/[.iconSel get].xbm) 81 172.67 T
+(}) 81 162.67 T
+(.iconSel insert items end bomb compress \134) 81 142.67 T
+( core dsc emacs keyboard telephone \134) 81 132.67 T
+( trash workstation) 81 122.67 T
+(.iconSel activate) 81 102.67 T
+0 10 Q
+(FIGURE 10) 113.41 74.17 T
+1 F
+( - Icon selector dialog) 164.8 74.17 T
+0 0 612 792 C
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+(forced to create the icon selector from scratch or) 315 713.33 T
+(become aware of its internal packing and attempt to) 315 701.33 T
+(repack around the canvas. A take-it-or) 315 689.33 T
+(-leave-it design) 468.08 689.33 T
+(such as this would be limiting, sacri\336cing possibilities) 315 677.33 T
+(of reuse.) 315 665.33 T
+(The means by which a child site may be \336lled is not a) 315 641.33 T
+-0.05 (limiting factor in the [incr W) 315 629.33 P
+-0.05 (idgets] set. Either composi-) 430.16 629.33 P
+(tion or inheritance may be used. In the login screen) 315 617.33 T
+-0.11 (example, both of these mechanisms were demonstrated.) 315 605.33 P
+(First composition was used. Later) 315 593.33 T
+(, as the Login mega-) 449.87 593.33 T
+-0.47 (widget class was produced, the same child site was \336lled) 315 581.33 P
+(by means of [incr T) 315 569.33 T
+(cl]\325) 393.17 569.33 T
+(s inheritance feature. The imple-) 406.5 569.33 T
+(mentation of child sites and the means by which they) 315 557.33 T
+(may be accessed in [incr W) 315 545.33 T
+(idgets] deserves closer) 424.84 545.33 T
+(inspection.) 315 533.33 T
+([incr Tk] has several base classes from which the [incr) 315 509.33 T
+-0.44 (W) 315 497.33 P
+-0.44 (idgets] class hierarchy is derived. As base classes they) 324.04 497.33 P
+(provide option management, standard methods, and a) 315 485.33 T
+(parent for components called the \322hull\323 widget. The) 315 473.33 T
+(path to this widget is contained in a protected class vari-) 315 461.33 T
+(able named \322itk_interior\323. Many mega-widgets within) 315 449.33 T
+-0.22 ([incr W) 315 437.33 P
+-0.22 (idgets] successively maintain this variable in the) 345.2 437.33 P
+(hierarchy) 315 425.33 T
+(. As a mega-widget is constructed, new com-) 352.11 425.33 T
+-0.09 (ponents are built of) 315 413.33 P
+-0.09 (f the path stored in the \322itk_interior\323) 392.04 413.33 P
+(variable. The mega-widget may also construct a new) 315 401.33 T
+(hull and store its path in \322itk_interior\323 for a future) 315 389.33 T
+-0.47 (derived class to use. A \324childsite\325 method is provided for) 315 377.33 P
+(composition support.) 315 365.33 T
+0 12 Q
+(Flexibility) 401.5 334 T
+1 10 Q
+(Frequently) 315 309.33 T
+(, a mega-widget straight out of the box) 357.68 309.33 T
+-0.28 (doesn\325) 315 297.33 P
+-0.28 (t exactly \336t the bill. Developers need to tweak the) 341.48 297.33 P
+(visual layout here and there to meet their application) 315 285.33 T
+(requirements. [incr W) 315 273.33 T
+(idgets] provides this capability) 402.63 273.33 T
+(with the viewpoint that \337exibility yields reuse. Each) 315 261.33 T
+(mega-widget was designed to allow modi\336cation of the) 315 249.33 T
+(visual aspects of the components through a rich option) 315 237.33 T
+(suite. As with standard Tk widgets, options may be) 315 225.33 T
+(speci\336ed at construction time and subsequently there) 315 213.33 T
+(after with the \324con\336gure\325 command.) 315 201.33 T
+(This is a very useful feature. For example, all the mega-) 315 177.33 T
+-0.03 (widgets which support scrollbar attachment do so at the) 315 165.33 P
+(developer) 315 153.33 T
+(\325) 354.8 153.33 T
+(s discretion. One may choose to have each) 357.58 153.33 T
+(scrollbar independently displayed either statically) 315 141.33 T
+(,) 513.21 141.33 T
+(dynamically) 315 129.33 T
+(, or never) 363.79 129.33 T
+(. A dynamic scrollbar would) 401.28 129.33 T
+(appear as needed based on the number of elements in) 315 117.33 T
+(the widget and their ability to \336t in the allotted space,) 315 105.33 T
+(whereas a static one is always displayed. Thus, scroll-) 315 93.33 T
+(bars have built-in intelligence.) 315 81.33 T
+FMENDPAGE
+%%EndPage: "7" 7
+%%Page: "8" 8
+612 792 0 FMBEGINPAGE
+[0 0 0 1 0 0 0]
+[ 0 1 1 0 1 0 0]
+[ 1 0 1 0 0 1 0]
+[ 1 1 0 0 0 0 1]
+[ 1 0 0 0 0 1 1]
+[ 0 1 0 0 1 0 1]
+[ 0 0 1 0 1 1 0]
+ 7 FrameSetSepColors
+FrameNoSep
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+(Similarly) 72 713.33 T
+(, Buttonbox usage is not limited to horizontal) 108.58 713.33 T
+(button display management. Instead, buttons may be) 72 701.33 T
+(oriented vertically as well as horizontally) 72 689.33 T
+(. Also, each) 236.6 689.33 T
+(button may be referred to by its associated tag in com-) 72 677.33 T
+(mands which allow them to be hidden, shown, con\336g-) 72 665.33 T
+(ured, or made the default.) 72 653.33 T
+(Flexibility is built into the lar) 72 629.33 T
+(ger scale mega-widgets as) 189.34 629.33 T
+(well. The Selectionbox class allows speci\336cation of) 72 617.33 T
+(labels, their position relative to their associated widget,) 72 605.33 T
+(and control over the display of the each element. The) 72 593.33 T
+(Fileselectionbox provides this same ability) 72 581.33 T
+(. Thus, the) 242.46 581.33 T
+(\336lter or selection labeled entries can be unmanaged as) 72 569.33 T
+(well as the \336le and directory lists.) 72 557.33 T
+(Lar) 72 533.33 T
+(ge scale \337exibility presents signi\336cant advantages.) 85.7 533.33 T
+(Applications may be designed in a more interactive) 72 521.33 T
+(manner) 72 509.33 T
+(. Consider the icon selector dialog example) 101.44 509.33 T
+(again. Suppose an alternate presentation of the dialog) 72 497.33 T
+(was to be considered. One in which the icon canvas) 72 485.33 T
+(appears above the list, the selection entry widget is) 72 473.33 T
+(removed, and an apply button is added. This could be) 72 461.33 T
+(quickly examined by con\336guring the components as) 72 449.33 T
+(given in Figure 1) 72 437.33 T
+(1.) 140.24 437.33 T
+(The ability to recon\336gure components also allows pro-) 72 413.33 T
+(grams to be built which change appearance on the \337y) 72 401.33 T
+(.) 284.36 401.33 T
+(An application which demands multiple \337avors of a) 72 389.33 T
+(mega-widget with dif) 72 377.33 T
+(ferent looks can create one) 157.92 377.33 T
+(instance and change the options between uses. This can) 72 365.33 T
+-0.16 (be much more ef) 72 353.33 P
+-0.16 (\336cient, since construction time is much) 138.81 353.33 P
+-0.22 (more costly than the time required to con\336gure and map) 72 341.33 P
+(the widget.) 72 329.33 T
+72 72 297 324 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+72 90.42 297 313.99 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 12524
+260 357 133.71 183.6 0 116.86 127.83
+/red <
+3EC472FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+FFFFFFFFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBF80808080
+8080808080808080808080808080808080808080404040404040404040404040
+4040404040404040404040000000000000000000000000000000000039C069DD
+00FF0000003333330033CCDD9999112277005544FFCC66AABBFF33EE9999CC7A
+EFD3557F9765E1A36FE700FF5500B22EAFB4CD73E6A24DBF0087F599FFFFB07A
+FFCCB088439D58D750D080C0C080C0808060C000FFA000FF20C0A040C040D060
+F0E010B4BE8BD28BD9B3FF7299FFA00019BF2FFF6223852F465F4770FF0000FF
+> store
+/green <
+57D79F00000000000000000000000000FFFFFFBFBFBFBFBF8080808080404040
+40000000FFFFFFFFFFBFBFBFBF808080808040404040400000000000FFFFFFFF
+FFBFBFBFBFBF8080808040404040400000000000FFFFFFFFFFBFBFBFBFBF8080
+8080804040400000000000FFFFFFBFBFBFBFBF80808040404040400063E0B500
+996699FF00663399BBFF99DD99FF112277005544CCCC66AABB6600EE6600CC69
+E3B56B7F9765E1A36FE700FF1A00B28BEEEE0073E6A24DBF00CEF599FFFFB094
+FFF730884DB358D78080C0C080C080808060C08000A080402070A0402040D0F0
+F0E010B4BE5BB477D9B3FF7789E4A0FF19264F00B641DE4F829E4780FF0000FF
+> store
+/blue <
+8CFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBF8040FFBF804000FFBF804000FFBF80
+00BF8040FFBF804000FF804000FFBF804000FFBF804000FFBF804000FFBF8040
+00FFBF804000FFBF4000FFBF804000FFBF804000FFBF804000FFBF804000FFBF
+804000FFBF00FFBF804000BF8040FFBF804000FFBF40FFBF8040004063E0B500
+FF3399FF88666666009966DDFFFF112277DD554499FFCCAABBCC99EE9966CC69
+E3B52F7F9765E1A36FE7BFCC8BEEB257EEB40073E6A24DBF80FAF56BFBB3B015
+3224608856CA58D7D050C080C08080C08060C080FF0000402070C0802040D060
+50E010B4BE7A8C65D9B3E08576C4A00070264F00FC5AE050B4A0FF9000FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+6F6F7R=F6F76F6F7J"
+S<F78z8z8z
+4F9R<F94F9
+
+;z"
+S3F7F6<z"z
+0F6F7S F6=z8z
+/F9RMF9
+J%J'>$H"
+P#FEFEFEFE>FEFEFEFEF9FEFEFEFEFEJ"8"J'?"I"
+P#F9F9=FEFEF9F9F9FEF9FEJ"
+PIF9J$:$9'?#8"9$?$:$8"8#8$9'
+P*FEFEFEFEFEFEFEFEFEF9FEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEF9FEFE@s"J18%<"9#8'<08,8"
+F6F7OCFEFEFEF9FEFEF9FEFEFEF9FEFEFEF9F9FEF9FEFEF9FEFEFEFEFEF9FEFEFEFEFEF9FEFEF9FEFEFEF9FEFEF9F9F9F9FEFEFEF9FEFEFEF9F9FEArJ%9$<"@#9":"A";%>$<$
+F9OFF9F9F9F9F9F9F9F9F9F9FEFEFEF9F9F9F9F9F9F9F9F9F9@sJ"8#;%>%
+F7P2FEF9F9F9F9F9F9F9F9F9F9@tJ%9$G">%>%9%>$
+F9OEFEF9FEFEFEF9FEFEFEF9FEFEFEF9FEFEFEF9FEFEFEF9FEJ"838"9"<0808.8"
+P#FEFEF9F9F9FEFEFEF9F9F9F9FEFEFEF9F9F9FEFEFEF9FEFEFEFEF9F9F9F9FEFEFEF9F9FEFEF9F9F9FEFEFEF9F9F9F9FEFEFEF9F9FEFEF9F9F9FEFEFEF9F9F9FEFEJ%9$:$9s;':$8%9$:$:#9$9%
+P#F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9
+
+=z8z
+/F7RMF7rF"J%
+F7F7S F7F7F7F7'z&
+F6F6F6F6F6F7S2EDF6F6F6F6F68$J%
+F9F9F9S4F9F9F9F7
+
+
+
+
+
+
+
+
+
+HZ
+RHJ"
+S+ECJz"
+4RDEDEC
+
+
+
+
+
+
+
+J#
+PJFEFEJ"8"
+PIFEFEJ"
+Q!FEJ&
+PLEDEDFEFEFEJ":"
+PLFEFEJ"
+PIEDJ"8":"
+PJEDFEFEJ">#:#
+PEFEEDEDFEFEJ$:"="8"
+PDFEFEFEEDFEFEJ"9"
+PKFEFEJ"<"
+PGFEFEJ";"<"9#
+PDEDFEEDEDEDJ"8"
+Q$EDFEJ"?"8"
+PIFEEDFEJ"8#8#
+PDFEEDFEEDEDJ"C"
+PCFEFEJ"9#;";"
+PBFEEDFEEDFEJ#9"="
+PEEDFEEDFEJ"="
+Q EDEDJ"8"@$
+PAFEEDEDEDEDJ#?"
+PJFEFEEDJ"
+PFEDJ"8#
+PDFEEDEDJ"=$
+PAEDEDEDEDJ$
+PLFEFEFEJ$<"9"
+PBEDEDEDFEFE
+J#=$
+PIFEFEEDEDEDJ$
+PFFEFEFEJ$
+PCFEFEFEJ#
+PAFEFEJ"
+Q!EDJ"
+P@FEJ"
+Q EDJ#D#
+P>FEFEFEFEJ#H"
+P<FEFEFEJ"
+Q#FE
+J#
+P:FEFEJ#J$
+P8FEFE8FEFEFEJ"J"
+P7FE=FE
+
+J"
+Q(FE
+J#J"
+P7EDED=EDJz
+P9=ED
+
+
+
+
+
+Jz
+4RDECI"
+ECHz
+RHED
+
+
+
+
+
+J#
+4FEFE
+J%9%8&9%
+8FEFEFEFEFEFEFEFEFEFEEDFEFEFEFEFEFEJ.9,
+7FEFEEDEDFEFEEDFEFEEDEDFEFEFEEDFEFEEDFEFEEDEDFEFEJ#@"<%
+;EDEDEDFEEDEDEDJ&
+LEDEDFEFEFEJ"8"
+O EDFEJ#E%
+;FEFEFEFEEDEDJ.>'
+7EDFEFEFEFEEDEDEDFEFEFEFEEDEDFEFEFEFEEDJ#8%9%8#8#8%
+4EDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDED
+
+
+
+
+
+
+
+H5=z
+R.BAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFE3ECH5J"
+R.FEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBAFEBA9FFH#z"?r"r"
+BAFER+BAFFDEECDEFFH#J#E"
+FEBAR*FFBAFFH&I#J#G"
+BAFEBAFEFEFEFEQ@BAFFECH%J"J#D"
+FEBABABA4BAQAFFBAFFH#J#F$
+BAFER*BAFFEDECECH#9$:$8&:$J#C$
+FEBAFEFEFEFEFEFEFEFEFEBAFEFEFEFEQ=FFBAFFFFEDH#9%8-9%J#G$
+BAFEBABABAFEFEBABABAFEBABAFEBAFEBAFEBABABAFEQ<BAFFEDECECH#J#B$
+FEBAR*FFBAFFFFEDH#J#H$
+BAFER*BAFFEDECECH#J#A$
+FEBAR*FFBAFFFFEDH*8(;(J#I$
+BAFEBAFEBAFEFEFEBABAFEFEFEBABAFEFEFEBAFEFEFEBAQ<BAFFEDECECH"r:$8wJ#@$
+FEBABABABABAQ=FFBAFFFFEDH#J#J$
+BAFER*BAFF4EDECECH#J#?#u
+FEBAR*FFBAFFFFECH#J#@"B"
+BAFER*BAFFECECH#J#?z
+FEBAR*FFBA/DEH#J#?Z
+BAFER*BAFF/H#J#J"
+FEBAR*FFBA7ECH#J#Av"
+BAFER*BAFFEDECH#J#
+FEBAR*FFBAH#J#
+BAFER*BAFFH#8$:$8&8&9&9$:$:$J#
+FEBAFEFEFEFEFEFEFEFEFEBAFEFEBAFEFEFEFEBAFEFEFEFEFEFEFEFEFEFEFEFEQ"FFBAH)848&8&8&8&J#
+BAFEBAFEBABABAFEFEBABABAFEBABAFEBAFEBAFEBABAFEBABABAFEBAFEBABABAFEBABABAFEFEBABABAFEFEBABABAFEQ!BAFFH#;"J$9&8&J#
+FEBABA?FEFEFEBAFEFEFEBABAFEFEFEBAQ!FFBAH#J%9%9%J#
+BAFEEBABABABABABABAFEBABABAFEQ!BAFFH#;"J"8"<"J#
+FEBAFEBFEFEFEQ%FFBAH)8(;"8%8%9&8&8&J#
+BAFEBABAFEFEFEBABAFEFEFEBABAFEFEFEFEFEBAFEFEFEFEBAFEFEFEBABAFEFEFEBABAFEFEFEBAQ!BAFFH#8$:$8r8$9%:$:$:$J#
+FEBABABABABABABABABABABABABABABABABABABABABABABABAQ"FFBAH#J#
+BAFER*BAFFH#J$J#
+FEBA5FEFEFEQ@FFBAH#J$J#
+BAFE5BABABAQ@BAFFH#J#
+FEBAR*FFBAH5
+R.BAFEDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFBAFFH$z#
+FEBAFFR)DEFFBAH$J$
+BAFEDER(FEBAFFH$J$
+FEBAFFR(DEFFBAH$J$
+BAFEDER(FEBAFFH(:$9&9$J$
+FEBAFFDEFEFEFEFEFEFEFEDEFEFEFEFEFEFEQ=DEFFBAH)8&8&8&J$
+BAFEDEFEDEDEDEFEFEDEDEDEFEDEFEDEDEDEFEDEDEDEFEQ<FEBAFFH$:"G$J$
+FEBAFFDEFEFEFEQ=DEFFBAH$J%J$
+BAFEDE6DEDEDEDEQ<FEBAFFH$:"J"J$
+FEBAFFFE4FEQ<DEFFBAH)8&8%9&J$
+BAFEDEDEFEFEFEDEDEFEFEFEDEFEFEFEFEDEFEFEFEDEQ<FEBAFFH(:$9%:$J$
+FEBAFFDEDEDEDEDEDEDEDEDEDEDEDEDEDEQ=DEFFBAH$J$
+BAFEDER(FEBAFFH$J$
+FEBAFFR(DEFFBAH$J$
+BAFEDER(FEBAFFH5
+R.FEBAFFDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFFBAH#z"
+BAFER+BAFFH#J#
+FEBAR*FFBAH#:#J#
+BAFEFEFER$BAFFH#:"J#
+FEBABAR%FFBAH#J#
+BAFER*BAFFH#8$:$:$J#
+FEBAFEFEFEFEFEFEFEFEFEQEFFBAH(9&8&J#
+BAFEBAFEBABABAFEBABABAFEFEBABABAFEQDBAFFH#>&<"J#
+FEBABAFEFEFEBABAQDFFBAH#?%J#
+BAFEBABABAFEQKBAFFH#>"@"J#
+FEBAFEFEQDFFBAH08&J#
+BAFEBABAFEFEFEBAFEBABAFEFEFEBABAFEFEFEBAQDBAFFH#8&8$:$J#
+FEBABABABABABABABABABABABAQEFFBAH#J#
+BAFER*BAFFH#J#
+FEBAR*FFBAH#J#
+BAFER*BAFFH#J#
+FEBAR*FFBAH#J#
+BAFER*BAFFH#J#
+FEBAR*FFBAH#J#
+BAFER*BAFFH#J#
+FEBAR*FFBAH#J#
+BAFER*BAFFH#8$8&9%:$:$J#
+FEBAFEFEFEFEFEFEBAFEFEFEFEFEFEFEFEFEFEFEQ7FFBAH08&8&8&J#
+BAFEBAFEBABABAFEBABAFEBAFEBAFEBABABABAFEFEBABABAFEFEBABABAFEQ6BAFFH#8$A$="8&J#
+FEBAFEFEFEFEFEFEBABAFEFEFEBAQ6FFBAH#8%?%A%J#
+BAFEBABABABAFEBABABABABABAFEQ6BAFFH#;"J"8"J#
+FEBAFE4FEFEQ:FFBAH+;/8&J#
+BAFEBABAFEFEFEBABAFEFEBABAFEFEFEBAFEBABAFEFEFEBABAFEFEFEBAQ6BAFFH#8$8r8&8$:$J#
+FEBABABABABABABABABABABABABABABABAQ7FFBAH#J#
+BAFER*BAFFH#J#
+FEBAR*FFBAH#J#
+BAFER*BAFFH#J#
+FEBAR*FFBAH#J#
+BAFER*BAFFH#J#
+FEBAR*FFBAH&I#J#J#
+BAFEBAFEFEFEFE>FEFEQ BAFFH%J"J"J#
+FEBABABA4BA?BAQ!FFBAH#J#
+BAFER*BAFFH#;#9$8(8$:$9%9&9$J#
+FEBAFEFEFEFEFEFEFEFEBAFEFEFEFEFEFEFEFEFEFEFEFEFEFEBAFEFEFEFEFEFEQ!FFBAH#:$8.8%8&8&8&8%J#
+BAFEFEBABAFEBABABAFEBABAFEBABABAFEBABABABAFEFEBABABAFEBABABABAFEBAFEBABABAFEBABABAQ!BAFFH#9#;$J$J#
+FEBAFEBAFEFEFE9FEFEFEQ/FFBAH#9#;%8&F%J#
+BAFEBAFEBABABABABAFEBAFEBAFEBABABAQ/BAFFH#:#=":"J#
+FEBABAFEFEFEQEFFBAH%9*9$8'8&8,9'J#
+BAFEBAFEBAFEFEBABAFEFEFEBABAFEBAFEBAFEFEFEBABAFEFEFEBABAFEFEFEBAFEBAFEFEFEFEBAFEFEFEBAFEPMBAFFH&9#8$?&:$:u:&J#
+FEBABABABABABABABABABABABABABABABABABABABABABABAPMFFBAH#J#
+BAFER*BAFFH#F$J#
+FEBAFEFEBAQEFFBAH#F#J#
+BAFEBABAQFBAFFH#J#
+FEBAR*FFBAH#J#
+BAFER*BAFFH#J#
+FEBAR*FFBAH#E$G#J#
+BAFEFEFEFEFEFEQ3BAFFH#8"B#H"J#
+FEBAFEBABABAQ4FFBAH#J#
+BAFER*BAFFH)9$A$8&;#:$8&:$J#
+FEBABAFEFEFEFEFEFEFEFEFEFEFEFEBAFEFEFEFEFEFEFEFEFEBAFEFEFEFEFEFEPIFFBAH)8&?-9%8-8&J#
+BAFEBABAFEBABABAFEBABABAFEFEBABABAFEBABAFEBABABAFEFEBABAFEFEBABABAFEBABAFEFEBABAFEFEBABABAFEPHBAFFH#?$A$A"C"<$J#
+FEBAFEFEFEFEFEFEBABAFEFEFEPIFFBAH#?%@%J%J#
+BAFEBABABABABABABABA?BABABABAPHBAFFH#<";"C"J"J#
+FEBAFEFEFEBFEPHFFBAH#8,8-959(J#
+BAFEBAFEFEFEBABABAFEFEFEBAFEFEFEFEFEFEBABAFEFEFEBA6FEFEFEBABAFEFEFEBAFEFEFEBABAFEFEFEBABAFEFEFEFEBABAFEFEFEBAPHBAFFH#9$9$9'8$:$8r8$8$8#8$J#
+FEBABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAPIFFBAH#J#
+BAFER*BAFFH#J$J#
+FEBA<FEFEFEQ9FFBAH#J$J#
+BAFE<BABABAQ9BAFFH#J#
+FEBAR*FFBAH#J#
+BAFER*BAFFH#J#
+FEBAR*FFBAH#J#J#
+BAFE<FEFEQ:BAFFH#8"J"J#
+FEBAFE9BAQ;FFBAH#J#
+BAFER*BAFFH)8&8%:$;#J#
+FEBABAFEFEFEFEFEFEBAFEFEFEFEFEFEFEFEFEFEFEFEQ7FFBAH)8&8&8&9%J#
+BAFEBABAFEBABABABAFEBABABABABABABAFEFEBABABAFEFEBABAFEQ6BAFFH#F$9&9"J#
+FEBAFEFEFEBAFEFEFEBABAQ9FFBAH#E%:%J#
+BAFEFEBABABABABABAFEQ=BAFFH#<"E"J#
+FEBAFEFEQAFFBAH#8+95J#
+BAFEBAFEFEFEBABAFEFEFEFE4BAFEFEFEBAFEBABAFEFEFEBABAFEFEFEBAFEFEFEQ5BAFFH#9$8%:&8$8rJ#Av
+FEBABABABABABABABABABABABABABABABABAQ5FFBAECH#J#@"
+BAFER*BAFFECH#J#?z
+FEBAR*FFBA/DEH#J#?Z
+BAFER*BAFF/H#J#?"C"
+FEBAR*FFBADEECH#J#Bt$
+BAFER*BAFFEDECECDEH#J#@$
+FEBAR*FFBADEFFFFH#J#J"J#J$
+BAFE6FEFEDFEPIBAFF4ECECDEH#J"E"C"="J#A$
+FEBA6BAFEFEBAPIFFBADEFFFFH#J#I$
+BAFER*BAFFECECDEH+8$9&;#9$9&8%9&8$;$8&J#B$
+FEBABAFEFEFEBAFEFEFEFEFEFEFEBAFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEBAFEFEFEP:FFBADEFFFFH18&:$8&8&8&8&8#;-J#H$
+BAFEBABAFEBABABAFEBABAFEBABABAFEBAFEBABABAFEBABAFEBABABAFEBAFEBABABABABABABAFEBAFEBABABABABAFEBABABAFEBABAFEFEBABAFEP9BAFFECECDEH#:"I#:&@$J"J#C$
+FEBAFEFEBABAFEFEFEBAFEFEFE9BAP<FFBADEFFFFH#J#;%?%J#G$
+BAFE8BAFEBABABAFEFEBABABAQ(BAFFECECDEH#8&H#9"A"C"J#D$
+FEBABAFEBAFEBABAFEFEFEFEPMFFBADEFFECH#?&8%8"9*9-8,8*9"J#H"
+BAFEBAFEFEFEBAFEFEFEFEFEBAFEFEBABAFEFEFEBABAFEFEFEBABABAFEFEFEBAFEBAFEFEFEBABAFEFEFEFEFEBAFEFEFEBABAFEFEFEFEP8BAFFDEH#9$:$9%8#9#8$;$9&9$8&9$8$8#J#E"
+FEBABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABABAP8FFBADEH#J#G"
+BAFER*BAFFDEH5?Z
+R.FEBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBA/H5>"
+R.BAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFBAFFFFHz=z
+R.ED3ED
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+<z
+S2EC=z"
+S0EDFF=Z
+S0<z
+S2ED
+
+
+
+
+
+
+
+Ez
+O9ECJ"
+OGFFGz"
+O5EDFF
+
+
+JZJZJZ
+5O-4O-4O-J"J"J"
+OAECO@ECO@ECJz"Jz"Jz"
+7O)EDEC7O)EDEC7O)EDEC
+
+
+
+
+J%:#9#J#G#J%J#
+LFEFEFEFEFEFEFEFEO+FEFEFEFEO)FEFEFEFE=FEFEJ'=$J"8"J'
+KFEFEEDEDFEFEFEFEEDO*FEFEO:FEFEEDEDFEFEJ$8$;$J#9&8&;#9#J$8(8&9%9%
+JFEFEEDEDFEFEFEFEEDO,EDEDFEFEEDFEFEFEFEEDFEFEFEFEFEFEMFEFEEDEDEDEDFEFEFEFEFEFEEDFEFEFEFEFEFEFEFEFEFEJ$J":"9%9%J'93
+O(FEFEEDO+FEFEFEEDFEFEFEEDFEFEO1FEFEEDEDFEFEFEEDFEFEEDFEFEEDEDFEFEEDFEFEEDEDFEFEJ"<"=(J#=">#
+P?EDEDEDFEFEEDFEFEEDO&EDEDEDEDEDJ$J#J$I#
+O(EDFEFEO-FEFEOBFEFEFEFEFEJ$J)H&J%I%
+O)EDFEFEO)FEFEEDEDEDEDFEFEEDFEFEFEEDO'FEFEEDEDEDEDEDEDJ$8$<$J"<"J$8#H#;#
+JEDFEFEFEFEEDEDFEFEO2FEFEO-EDFEFEFEFEFEFEFEFEJ'>$J%9%<"J.=.
+KEDFEFEFEFEEDEDFEFEO1EDFEFEEDEDFEFEEDEDO$EDFEFEFEFEEDEDFEFEFEEDFEFEEDFEFEFEFEEDEDEDFEFEFEFEEDJ%:#:#J#:#9#;#8#;"J%8s8#8%9%8#
+LEDEDEDEDEDEDEDEDO'EDEDEDEDEDEDEDEDEDEDEDO#EDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDJ"
+Q"FEJ$
+Q!FEFEEDJ#;#?#
+P=EDEDEDEDEDED
+
+&J%
+F7F7F7F7F7S3F7F7F7F7&HzJzJzH&
+F6F6F6F6F6O)EC8O)EC8O)ECF6F6F6F6F68$G"J"J"J%
+F9F9F9ECO@ECO@ECO<F9F9F9F7JzJzJz
+5O-ED4O-ED4O-ED
+
+
+GZ
+O5F"
+FFEz
+O9ED
+
+
+
+
+
+
+
+<z"z"z
+0F6F7R=F6F71F6;z8z8z
+1F9R<F91F9
+
+7z8z8z
+5F7R<F74F7"J"J"
+F76F7R=F7
+ENDBITMAP
+%%EndBinary
+87.14 96.14 285.14 123.14 R
+7 X
+V
+4 8 Q
+0 X
+(.iconSel conf) 87.14 117.81 T
+(igure -childsitepos n \134) 149.54 117.81 T
+( -selectionon no) 87.14 107.81 T
+(.iconSel show Apply) 87.14 97.81 T
+0 10 Q
+(FIGURE 1) 98.29 76.02 T
+(1) 144.13 76.02 T
+1 F
+( - Alternate icon selector dialog) 149.13 76.02 T
+0 0 612 792 C
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+(For example, consider an application which must con-) 315 560.33 T
+(\336rm a user request prior to performing the operation. In) 315 548.33 T
+(addition, due to the serious nature of the operation, the) 315 536.33 T
+(user must con\336rm positively twice. The following code) 315 524.33 T
+(segment creates the initial message dialog and con\336g-) 315 512.33 T
+(ures the message to ask \322Are you sure ?\323. The dialog is) 315 500.33 T
+(then mapped with the \324activate\325 command. If the user) 315 488.33 T
+(responds positively) 315 476.33 T
+(, then the message is changed to) 391.85 476.33 T
+(\322Are you really sure ?\323 and redisplayed. Only with two) 315 464.33 T
+-0.35 (af) 315 452.33 P
+-0.35 (\336rmative replies does the script perform the operation.) 322.59 452.33 P
+-0.18 (Figure 12 depicts the dialog presentations with dif) 315 440.33 P
+-0.18 (ferent) 514.36 440.33 P
+(messages and the associated code.) 315 428.33 T
+(This same instance of the message dialog can be recon-) 315 132.33 T
+(\336gured into a error dialog. All the options can be) 315 120.33 T
+(dynamically changed. It is possible to not only change) 315 108.33 T
+-0.05 (the bitmap but its location as well. Furthermore, we can) 315 96.33 P
+(modify the text of the buttons and make the dialog non-) 315 84.33 T
+315 153 540 425 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+315 182 540 416 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+0 0 0 1 0 0 0 K
+%%BeginBinary: 4520
+217 162 86.8 64.8 0 327.2 342.2
+/red <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000008EEF9AFF2CAEB6CF71E7
+A24DF70055BE928AB2D3FF00F7557DDBB2002CFF6120822C455D4571FF0000FF
+> store
+/green <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000082D78AE78AEFEF0071E7
+A24DF70055BE827530B6FFFFDF697DDBB2004D00B641DF4D829E4582FF0000FF
+> store
+/blue <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000006DB675C755EFB60071E7
+A24DF77D55BE9265618EE300B22C7DDBB28A4D00FF59E351B6A2FF9200FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+7F6F7Q>F6F77F6F7J"
+R?F78z8z8z
+5F9Q=F95F9
+
+
+<z"
+R4F7F6=z"z
+0F6F7R!F6>z8z
+/F9R F9
+J'J'J"9#
+O<FEFEFEFEF9FE4FEFEFEF9FEFE?FEFEFEJ'J$J"
+O;FEFEF9F9F9FE4FEFEF9BFEJ$9"J%J#
+O:FEFEF9F97F9F9F9F9CF9F9J$9'9"8&8-8#:%9"8&:$9'
+OEFEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEF9FEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEF9FEFEAs"J,8%8"8$:"8"8"8):%8"8$:*8%
+F6F7O-F9F9FEFEFEF9FEFEFEF9F9FEF9FEFEF9F9F9F9F9FEF9FEF9FEFEFEF9FEFEF9F9FEFEF9F9F9F9FEFEFEF9FEFEFEF9F9FEF9FEFEBrJ$<"H$9"9"<$F$<"
+F9O2F9F9F9F9F9F9F9F9F9F9FEFEF9F9F9F9AsJ"J%
+F7O.FEO!FEFEF9F9AtJ$9":$J"F$
+F9O&F9FEFEFEFEF9FELFEFEF9FEJ28"9$8$8$8"8"8"9"9'8"8&8,8"9"
+O;F9FEFEFEFEFEF9F9F9F9FEFEFEF9F9F9FEFEFEF9FEFEF9FEFEF9FEFEFEFEFEFEF9F9FEFEF9FEF9FEFEF9FEFEF9F9F9FEFEFEF9F9F9FEFEFEJ&:$9z8w8'9r9$9s
+O<F9F9F9F9F9F9F9F97F9F9F9F9F9F9F9F9F9F9F9F9F9
+
+>z8z
+/F7R F7sF"J&
+F7F7R!F7F7F7F7F7(z'
+F6F6F6F6F6F6F7R3D9F6F6F6F6F6F68%J&
+F9F9F9F9R5F9F9F9F9F7
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Ju
+BFEJ-
+AFEFED9FED9FED9FED9FED9FEJ/
+@FEFED9FED9FED9FED9FED9FED9FEJ&r%
+?FEFED9FED9FED9FED9FEJ%=&
+@D9FED9FEFED9FED9FEJ$?%
+@FED9FEFED9FED9J$9$9%J#J%
+@D9FED9D9FED9D9FED9FEBFEFEO?FEFEFEFEJ$9$9&J"8"J'
+@FED9FEFED9FEFED9FED9FE@FEFEO=FEFED9D9FEFEJ$9$9'J#9+<#9#8%8#8#<%8#8.
+@D9FED9D9FED9D9FED9FED9FE@D9D9FEFED9FEFED9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFED9FEFED9FEFED9FEFEFEFEJ*9(J":"9"8'C'B'@"8'<'
+@FED9FED9FED9FED9FEFED9FED9FED9FE=FEFEFEFEFED9D9FEFEFEFED9D9FEFEFEFED9D9FEFEFEFEFED9D9FEFED9D9D9FEFED9J):(J#A(J%A#D$
+@D9FED9FED9FED9FED9FED9FEFEFED9GD9D9D9FEFED9FEFED95FED9D9D9D9D9FEFED9J(:(J#;":#J&A":#
+@FED9FED9FED9FED9FED9FED9D9D9@FEFED9FEFEAD9D9FEFEFED9FEFEJ(:'J)=%<&J"8"E%>#
+?D9FEFED9FED9FED9FED9FED9FE?FEFED9D9D9D9FEFED9D9D9D9D9FEFEFED96D9FED9D9D9D9D9D9J'9(J#J"=%<"B#>#
+@D9FEFED9FED9D9FED9FED9FED9O"FEFE7FEFEFED9D9FEFEFEFEFEJ&9'J'=";,=,>'
+AD9FEFED9FEFED9FED9FED9MD9FEFEFEFED9D9D9FEFEFEFED9D9D9FEFED9D9FEFEFEFED9D9D9FEFED9D9FEFEFEFED9J.J#:%:%@":%9&<%9s:%?#
+BD9FEFED9FED9FED9FED9FED9FE@D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9J,J"
+DD9FED9FED9FED9FED9FED9O,FEJ+J$
+DFED9FEFEFED9FED9D9D9O,FEFED9J#9$J#
+DD9FEFED9FEO.D9D9J#9$
+DFED9D9FED9J+
+BFEFED9FED9FED9FED9FEJ+
+CD9FED9FED9FED9FED9FEJv
+BD9
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+=z
+R3D8>z"
+R1D9FF>Z
+R1=z
+R3D9
+
+
+
+Jz
+BO1FE
+Jz
+DO-D9
+Jz
+FO)D8J"
+P FFJz"
+HO%D9FF
+
+
+JZJZ
+LKJKJ"J"
+OHD8OFD8Jz"Jz"
+O GD9D8MGD9D8
+
+
+
+
+J#:#J#9#
+O(FEFEFEFEOBFEFEFEFEJ"
+Q&FEJ$8)9%J%
+O(D9FEFEFEFED9D9FEFEFEFEFEFEFEFEO?FEFEFEFEJ.J#:'
+O0FEFED9D9FEFED9FEFED9D9FEFEO7D9FEFEFED9D9FEFEJ'@%
+O)D9FEFEFEFED9FED9D9D9J"8":#9&J#
+O*D9D9FEFED9D9FEFEFEO9D9FEJ%9"8"
+O2D9D9D9D9D9FEJ(J"
+O4FEFED9FEFED9D9O;D9J.J'
+O0D9FEFEFEFED9D9D9FEFEFEFED9O=D9FEFEFEFED9J#:%9%J#9#8%
+O+D9D9D9D9D9D9D9D9D9D9O6D9D9D9D9D9D9D9D9
+
+
+
+
+
+
+'J&
+F7F7F7F7F7F7R4F7F7F7F7F7'JzJzJ'
+F6F6F6F6F6F6HGD8O GD8HF6F6F6F6F6F68%J"J"J&
+F9F9F9F9GD8OFD8OBF9F9F9F9F7JzJz
+LKD9JKD9
+
+
+JZ
+HO%J"
+GFFJz
+FO)D9
+Jz
+DO-FE
+Jz
+BO1D9
+
+
+
+=z"z"z
+0F6F7Q>F6F71F6<z8z8z
+1F9Q=F91F9
+
+
+7z8z8z
+6F7Q=F75F7"J"J"
+F77F7Q>F7
+ENDBITMAP
+%%EndBinary
+%%BeginBinary: 4795
+254 162 101.6 64.8 0 420.4 342.2
+/red <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000008EEF9AFF2CAEB6CF71E7
+A24DF70055BE928AB2D3FF0055F7DB7DB2002CFF6120822C455D4571FF0000FF
+> store
+/green <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000082D78AE78AEFEF0071E7
+A24DF70055BE827530B6FFFF69DFDB7DB2004D00B641DF4D829E4582FF0000FF
+> store
+/blue <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000006DB675C755EFB60071E7
+A24DF77D55BE9265618EE3002CB2DB7DB28A4D00FF59E351B6A2FF9200FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+7F6F7R5F6F77F6F7J"
+S6F78z8z8z
+5F9R4F95F9
+
+
+<z"
+S+F7F6=z"z
+0F6F7RFF6>z8z
+/F9REF9
+J'J'J"9#
+P FEFEFEFEF9FE4FEFEFEF9FEFE?FEFEFEJ'J$J"
+OMFEFEF9F9F9FE4FEFEF9BFEJ$9"J%J#
+OLFEFEF9F97F9F9F9F9CF9F9J$9'9"8&8-8#:%9"8&:$9'
+P)FEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEF9FEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEF9FEFEAs"J,8%8"8$:"8"8"8):%8"8$:*8%
+F6F7O?F9F9FEFEFEF9FEFEFEF9F9FEF9FEFEF9F9F9F9F9FEF9FEF9FEFEFEF9FEFEF9F9FEFEF9F9F9F9FEFEFEF9FEFEFEF9F9FEF9FEFEBrJ$<"H$9"9"<$F$<"
+F9ODF9F9F9F9F9F9F9F9F9F9FEFEF9F9F9F9AsJ"J%
+F7O@FEO!FEFEF9F9AtJ$9":$J"F$
+F9O8F9FEFEFEFEF9FELFEFEF9FEJ28"9$8$8$8"8"8"9"9'8"8&8,8"9"
+OMF9FEFEFEFEFEF9F9F9F9FEFEFEF9F9F9FEFEFEF9FEFEF9FEFEF9FEFEFEFEFEFEF9F9FEFEF9FEF9FEFEF9FEFEF9F9F9FEFEFEF9F9F9FEFEFEJ&:$9z8w8'9r9$9s
+P F9F9F9F9F9F9F9F97F9F9F9F9F9F9F9F9F9F9F9F9F9
+
+>z8z
+/F7REF7sF"J&
+F7F7RFF7F7F7F7F7(z'
+F6F6F6F6F6F6F7S*D9F6F6F6F6F6F68%J&
+F9F9F9F9S,F9F9F9F9F7
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Ju
+BFEJ-
+AFEFED9FED9FED9FED9FED9FEJ/
+@FEFED9FED9FED9FED9FED9FED9FEJ&r%
+?FEFED9FED9FED9FED9FEJ%=&
+@D9FED9FEFED9FED9FEJ$?%
+@FED9FEFED9FED9J$9$9%J#J&J%
+@D9FED9D9FED9D9FED9FEBFEFEO2FEFED9FEFEMFEFEFEFEJ$9$9&J"8"J'
+@FED9FEFED9FEFED9FED9FE@FEFEP4FEFED9D9FEFEJ$9$9'J#9+<#9#8%8#8#;+9%>#9#<%8#8.
+@D9FED9D9FED9D9FED9FED9FE@D9D9FEFED9FEFED9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFED9FEFED9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFED9FEFED9FEFED9FEFEFEFEJ*9(J":"9"8'C'D"8.I'@"8'<'
+@FED9FED9FED9FED9FEFED9FED9FED9FE=FEFEFEFEFED9D9FEFEFEFED9D9FEFEFEFEFED9D9FEFED9FEFED9D9FEFEFEFED9D9FEFEFEFEFED9D9FEFED9D9D9FEFED9J):(J#A(J#=#A(=%A#D$
+@D9FED9FED9FED9FED9FED9FEFEFED9GD9D9D9FEFED9FEFED96D9D9D9D9D9FEFED9FEFED9FED9D9D9D9D9FEFED9J(:(J#;":#J":#:$J&A":#
+@FED9FED9FED9FED9FED9FED9D9D9@FEFED9FEFECD9FEFEFEFEFE5D9D9FEFEFED9FEFEJ(:'J)=%<&J*@&>"8"E%>#
+?D9FEFED9FED9FED9FED9FED9FE?FEFED9D9D9D9FEFED9D9D9D9D9FEFEFED9;D9D9D9D9D9FEFED9D9D9FEFEFED9D9FED9D9D9D9D9D9J'9(J#J"F#J%<"B#>#
+@D9FEFED9FED9D9FED9FED9FED9O"FEFE7FEFEFE:FEFED9D9FEFEFEFEFEJ&9'J'=";,B/>"?,>'
+AD9FEFED9FEFED9FED9FED9MD9FEFEFEFED9D9D9FEFEFEFED9D9D9FEFED9D9FEFEFEFED9D9D9FEFEFED9FEFED9D9FEFEFEFED9D9D9FEFED9D9FEFEFEFED9J.J#:%:%@":%9&;#:%9v;">%9s:%?#
+BD9FEFED9FED9FED9FED9FED9FE@D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9J,J"J"
+DD9FED9FED9FED9FED9FED9O,FEO$FEJ+J$J$
+DFED9FEFEFED9FED9D9D9O,FEFED9O"FEFED9J#9$J#J#
+DD9FEFED9FEO.D9D9O#D9D9J#9$
+DFED9D9FED9J+
+BFEFED9FED9FED9FED9FEJ+
+CD9FED9FED9FED9FED9FEJv
+BD9
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+=z
+S*D8>z"
+S(D9FF>Z
+S(=z
+S*D9
+
+
+
+Jz
+O O1FE
+Jz
+O"O-D9
+Jz
+O$O)D8J"
+P,FFJz"
+O&O%D9FF
+
+
+JZJZ
+O*KO)KJ"J"
+P&D8P%D8Jz"Jz"
+O,GD9D8O,GD9D8
+
+
+
+
+J#:#J#9#
+O4FEFEFEFEP!FEFEFEFEJ"
+Q?FEJ$8)9%J%
+O4D9FEFEFEFED9D9FEFEFEFEFEFEFEFEOLFEFEFEFEJ.J#:'
+O<FEFED9D9FEFED9FEFED9D9FEFEODD9FEFEFED9D9FEFEJ'@%
+O5D9FEFEFEFED9FED9D9D9J"8":#9&J#
+O6D9D9FEFED9D9FEFEFEOFD9FEJ%9"8"
+O>D9D9D9D9D9FEJ(J"
+O@FEFED9FEFED9D9OHD9J.J'
+O<D9FEFEFEFED9D9D9FEFEFEFED9OJD9FEFEFEFED9J#:%9%J#9#8%
+O7D9D9D9D9D9D9D9D9D9D9OCD9D9D9D9D9D9D9D9
+
+
+
+
+
+
+'J&
+F7F7F7F7F7F7S+F7F7F7F7F7'JzJzJ'
+F6F6F6F6F6F6O&GD8O-GD8O&F6F6F6F6F6F68%J"J"J&
+F9F9F9F9O%D8P%D8P F9F9F9F9F7JzJz
+O*KD9O)KD9
+
+
+JZ
+O&O%J"
+O%FFJz
+O$O)D9
+Jz
+O"O-FE
+Jz
+O O1D9
+
+
+
+=z"z"z
+0F6F7R5F6F71F6<z8z8z
+1F9R4F91F9
+
+
+7z8z8z
+6F7R4F75F7"J"J"
+F77F7R5F7
+ENDBITMAP
+%%EndBinary
+0 0 0 1 0 0 0 K
+324 191 531 335 R
+7 X
+V
+4 8 Q
+0 X
+(messagedialog .md -modality application \134) 324 329.67 T
+( -title Conf) 324 319.67 T
+(irmation -bitmap questhead \134) 391.2 319.67 T
+( -text \322Are you sure ?\323) 324 309.67 T
+(.md buttonconf) 324 299.67 T
+(igure OK -text \322Yes\323) 391.2 299.67 T
+(.md buttonconf) 324 289.67 T
+(igure Cancel -text \322No\323) 391.2 289.67 T
+(.md hide Help) 324 279.67 T
+(if {[.md activate]} {) 324 259.67 T
+( .md conf) 324 249.67 T
+(igure \134) 381.6 249.67 T
+( -text \322Are you really sure ?\323) 324 239.67 T
+( if {[.md activate]} {) 324 229.67 T
+( # Perform operation) 324 219.67 T
+( }) 324 209.67 T
+(}) 324 199.67 T
+0 10 Q
+(FIGURE 12) 354.44 166.17 T
+1 F
+( - Con\336rmation dialog) 405.83 166.17 T
+0 0 612 792 C
+315 567 540 720 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+315 585 540 720 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+0 0 0 1 0 0 0 K
+%%BeginBinary: 4792
+337 137 121.32 49.32 0 364.68 661.68
+/red <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000868EEF9AFF2CAEB6CF71E7
+A24DF70055BE928AB2D3FF00F7557DDBB2002CFF6120822C455D4571FF0000FF
+> store
+/green <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000DF82D78AE78AEFEF0071E7
+A24DF70055BE827530B6FFFFDF697DDBB2004D00B641DF4D829E4582FF0000FF
+> store
+/blue <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000E36DB675C755EFB60071E7
+A24DF77D55BE9265618EE300B22C7DDBB28A4D00FF59E351B6A2FF9200FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+7F6F7T,F6F77F6F7J"
+U-F78z8z8z
+5F9T+F95F9
+
+
+<z"
+U"F7F6=z"z
+0F6F7T=F6>z8z
+/F9T<F9
+Js
+Q5FEJ"8$
+Q5F9F9F9F9J"
+Q;F9J18$9'
+Q:FEF9F9F9FEFEFEF9FEFEFEFEFEF9FEFEFEFEFEFEFEFEF9FEFEAs"J#:"8"8"8"8*8"
+F6F7Q$FEFEF9FEF9FEFEFEFEF9FEFEFEF9F9FEBrJ#=$9$8$<$
+F9Q%F9F9F9F9F9F9F9F9F9F9F9F9F9F9AsJ$
+F7Q'F9F9FEAtJ"F$
+F9Q'FEFEF9FEJ"8$9"8"8"8"8*8"
+Q5FEFEFEFEFEFEFEFEF9F9FEFEFEF9F9F9FEFEJx8%:$9%
+Q5F9F9F9F9F9F9F9F9F9F9F9F9
+
+>z8z
+/F7T<F7sF"J&
+F7F7T=F7F7F7F7F7(z$z'
+F6F6F6F6F6F6F7S!D9D8D8D8OKD9F6F6F6F6F6F68%J#J&
+F9F9F9F9S#D9FFOLF9F9F9F9F7
+
+
+Jz
+S1O@FE
+Jz
+S3O=D9
+Jz
+S5O9D8J"
+TMFFJz"
+S7O5D9FF
+
+
+JZ
+S;O-J"
+TGD8Jz"
+S=O)D9D8
+
+
+
+
+J'@#
+SGFEFEFEFEFEFEFEFEJ&
+SID9D9D9FEFEJ%8"8*9#
+T"FEFEFEFEFEFED9FEFED9FEFEFEFEFEFEJ)8"9"
+T!FEFED9D9FEFED9D9D9FEJ&F*
+SIFEFEFEFED9D9D9D9FEFED9FEFED9J#<#@"
+SID9D9FEFED9J$9%B&
+SKD9FEFED9D9D9D9D9FEFEFED9J#;"
+T%FEFEFEJ'8%="
+T!D9FEFEFEFED9D9FEFED9D9J#9#8%:&="
+SGD9D9D9D9D9D9D9D9D9D9D9D9D9D9JsJ"
+P:FEQ@FEJ+J$
+P9FEFED9FED9FED9FED9FEQ>FEFED9J-J#
+P8FEFED9FED9FED9FED9FED9FEQ=D9D9J%r$
+P7FEFED9FED9FED9FEJ'<%
+P6FEFED9FED9FED9FED9FEJ'<%
+P7D9FED9FED9FED9FED9FEJ(=#
+P7FED9D9D9FED9FEFED9J#8%<#
+P7D9FED9FED9FED9FEJ#9%;#Jz
+P7FED9D9FED9FEFED9PDO)D8J#:%:#J"
+P7D9FED9FED9FED9FEPCD8J#;%9#Jz
+P7FED9D9FED9FEFED9PBO-D9J#<)
+P7D9FED9FED9FEFEFED9FEJ%<(
+P6D9FED9FED9FED9FED9FED9J%=%
+P7D9FED9FEFED9FED9J$r$JZ
+P8D9FED9FED9FED9P@O5J,J"
+P9D9FED9FED9FED9FED9FED9P@FFJ*Jz
+P:D9FED9FED9FED9FED9P@O9D9Jr
+P;D9Jz
+S3O=FE
+Jz
+S1O@D9
+
+
+
+
+
+J#9#E#;#C#J#F#
+O%FEFEFEFEFEFEFEFEFEFEO1FEFEFEFEJ#
+QHD9D9J&9%;#<%<"8"8%=%9%9%9%9%9%=#;%8#9&8%9%
+O-FEFED9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFED9FEFEFEFEFEFEFEFEFEFEJ,9%:';"8);5;%9'B.JZ
+O/FED9FEFED9FEFED9D9FEFEFED9FEFEFEFED9D9FEFED9D9D9FEFED9D9FEFEIFEFED9D9FEFED9FEFED9D9FEFED9FEFED9D9FEFED9FEFED9D9FEFED9FEFED9D9FEFED9FEFED9D9FEFEFEFED9FEFEFED9D9FEFEFEFED9D9FEFED9FEFED9D9FEFEO1O-J":#="J#?#;#@%9%>"@(>#J"
+O/D9D9D9D9BD9D9D9D9D9D9FED9D9D9FED9D9D9D9D9FEFED9FEFED9D9D9PDD8J$E#J$I#9&8&E#J#Jz"
+O5FEFEFEFEFE8FEFEFEFEFED9D9FEFEFED9D9FEFEFEFEFE7FEFEO5O)D9D8J%E%J%I%9"8"9"8"D%8&D%
+O4FEFED9D9D9D9D9D95FEFED9D9D9D9D9D9D9FED9FED9D9D9D9D9FEFEFED9D9D9D9D9J(G"A#?"J#;#;(9%@"=#F#;#
+O%D9FEFED9FEFED9FEFEFEFE6FEFEFEFEFEFED9FEFED9D9FEFED9D9FEFEFEFEFEFEFEJ"A(8%:'<+;5;%9'9$<.
+O(FED9FEFEFED9FEFED9FEFED9D9FEFEFEFED9D9FEFED9D9FEFEFEFED9ID9FEFEFED9FEFED9FEFEFEFED9D9D9FEFEFEFED9D9D9FEFEFEFED9D9D9FEFEFEFED9D9D9FEFEFEFED9D9FEFED9D9FEFEFEFED9D9FED9D9FEFEFEFED9D9D9FEFEFEFED9J&8#8#8v8#8%>#8%=v9%9%9%9%=&8%;":#8%9%
+O&D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9
+J%J#
+SGFEFEFEFE=FEFEJ'
+SFFEFED9D9FEFEJ$8(8&9%9%
+SEFEFED9D9D9D9FEFEFEFEFEFED9FEFEFEFEFEFEFEFEFEFEJ'93
+SLFEFED9D9FEFEFED9FEFED9FEFED9D9FEFED9FEFED9D9FEFEJ#=">#
+SLD9D9D9D9D9J$I#
+SMFEFEFEFEFEJ%I%
+SLFEFED9D9D9D9D9D9J$8#H#;#
+SED9FEFEFEFEFEFEFEFEJ.=.
+SFD9FEFEFEFED9D9FEFEFED9FEFED9FEFEFEFED9D9D9FEFEFEFED9J%8s8#8%9%8#
+SGD9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9
+
+
+
+
+
+
+'J&
+F7F7F7F7F7F7U"F7F7F7F7F7'JzF'
+F6F6F6F6F6F6S7O)D8F6F6F6F6F6F68%J"J&
+F9F9F9F9S6D8O:F9F9F9F9F7Jz
+S;O-D9
+
+
+
+
+
+
+
+
+
+
+
+
+J"
+S)FF=z"z"z
+0F6F7T,F6F71F6<z8z8z
+1F9T+F91F9
+
+
+7z8z8z
+6F7T+F75F7"J"J"
+F77F7T,F7
+ENDBITMAP
+%%EndBinary
+0 0 0 1 0 0 0 K
+324 594 531 657 R
+7 X
+V
+4 8 Q
+0 X
+(.md conf) 324 651.67 T
+(igure -bitmap error -imagepos n \134) 362.4 651.67 T
+( -text \322Unable to access device\323 \134) 324 641.67 T
+( -modality none -buttonboxpos e) 324 631.67 T
+(.md buttonconf) 324 621.67 T
+(igure OK -text \322Retry\323) 391.2 621.67 T
+(.md buttonconf) 324 611.67 T
+(igure Cancel -text \322Cancel\323) 391.2 611.67 T
+(.md activate) 324 601.67 T
+0 10 Q
+(FIGURE 13) 377.68 569.18 T
+1 F
+( - Error dialog) 429.07 569.18 T
+0 0 612 792 C
+FMENDPAGE
+%%EndPage: "8" 8
+%%Page: "9" 9
+612 792 0 FMBEGINPAGE
+[0 0 0 1 0 0 0]
+[ 0 1 1 0 1 0 0]
+[ 1 0 1 0 0 1 0]
+[ 1 1 0 0 0 0 1]
+[ 1 0 0 0 0 1 1]
+[ 0 1 0 0 1 0 1]
+[ 0 0 1 0 1 1 0]
+ 7 FrameSetSepColors
+FrameNoSep
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+-0.22 (modal. W) 72 713.33 P
+-0.22 (e\325ll also change the orientation and position of) 110.42 713.33 P
+(the buttons to be vertical along the right hand side. Fig-) 72 701.33 T
+(ure 13 shows the \336nal product. It is important to note,) 72 689.33 T
+-0.47 (that no new message dialog has been created, instead the) 72 677.33 P
+(existing one has been recon\336gured.) 72 665.33 T
+0 12 Q
+(Lessons Learned) 141.33 634 T
+1 10 Q
+(One element which is essential to any successful devel-) 72 609.33 T
+(opment ef) 72 597.33 T
+(fort is the establishment of \336rm objectives.) 112.09 597.33 T
+-0.29 ([incr W) 72 585.33 P
+-0.29 (idgets] was short on neither aggressive goals nor) 102.13 585.33 P
+(talented developers willing to contribute in a team envi-) 72 573.33 T
+(ronment. Many lessons were learned during this ef) 72 561.33 T
+(fort) 274.56 561.33 T
+(as the team achieved a truly reusable, \337exible, and) 72 549.33 T
+(extensible mega-widget set. The lessons centered on) 72 537.33 T
+(inheritance, con\336gurability) 72 525.33 T
+(, testability) 179.67 525.33 T
+(, and reusability) 223.47 525.33 T
+(.) 286.98 525.33 T
+(Inheritance proved to be a valuable tool during [incr) 72 501.33 T
+(W) 72 489.33 T
+(idgets] development. The impact of changes due to) 81.04 489.33 T
+(Tk 4.0 were signi\336cantly lessened. For example, as) 72 477.33 T
+(image support was added to Tk, a single option was) 72 465.33 T
+(added to the Labeledwidget class which was then inher-) 72 453.33 T
+-0.26 (ited by derived classes in the hierarchy) 72 441.33 P
+-0.26 (. Also, bugs \336xed) 225.28 441.33 P
+-0.45 (in base classes applied to all derived ones. This made for) 72 429.33 P
+(quick and easy maintenance. On a similar note, errors) 72 417.33 T
+(introduced in lower level classes had broader ef) 72 405.33 T
+(fects.) 262.6 405.33 T
+(Fortunately) 72 393.33 T
+(, this was rare and easily detected due to the) 117.46 393.33 T
+(magni\336ed repercussions.) 72 381.33 T
+(Maximum recon\336gurability comes at the price of) 72 357.33 T
+(quickly multiplying options in an inheritance hierarchy) 72 345.33 T
+(.) 291.89 345.33 T
+(In an ef) 72 333.33 T
+(fort to avoid the usability problems associated) 102.36 333.33 T
+-0.26 (with Motif) 72 321.33 P
+-0.26 (\325) 115.35 321.33 P
+-0.26 (s bulky resource set, [incr W) 118.13 321.33 P
+-0.26 (idgets] imposed) 231.41 321.33 P
+(an 80/20 rule. If 80% of the user community could be) 72 309.33 T
+(viewed as having no interest in an option, it was) 72 297.33 T
+(excluded. Users could always use the built-in [incr Tk]) 72 285.33 T
+(\324component\325 command to con\336gure an option.) 72 273.33 T
+-0.16 (The incorporation of a regression test suit was a de\336nite) 72 249.33 P
+(plus. The [incr W) 72 237.33 T
+(idgets] test suite is a blatant rip-of) 142.14 237.33 T
+(f of) 278.06 237.33 T
+(the work done by Ousterhout and May-Pumphrey for) 72 225.33 T
+(T) 72 213.33 T
+(cl/Tk [6]. The test suite consistently exposed \337aws) 77.41 213.33 T
+(which hand testing left hidden. Especially those bugs) 72 201.33 T
+(dealing with lar) 72 189.33 T
+(ge scale component con\336guration. The) 134.59 189.33 T
+(test suite also doubles as a good visual demo.) 72 177.33 T
+(Absolutely no reuse of any kind occurs until a widget) 72 155.33 T
+-0.41 (set becomes well documented. This includes man pages,) 72 143.33 P
+-0.41 (user) 72 131.33 P
+-0.41 (\325) 89.03 131.33 P
+-0.41 (s guides, and demos. Unless documented, reuse is a) 91.81 131.33 P
+(localized event at best. There is no such thing as self-) 72 119.33 T
+-0.03 (documenting code. Instead, the demand is for self-docu-) 72 107.33 P
+(menting engineers.) 72 95.33 T
+0 12 Q
+(Pr) 397.95 712 T
+(ospective) 410.39 712 T
+1 10 Q
+([incr W) 315 687.33 T
+(idgets] is an ongoing development ef) 345.42 687.33 T
+(fort. The) 493.28 687.33 T
+(mega-widgets presented in this paper represent those) 315 675.33 T
+(ready for release. Each has a man page, demo, and) 315 663.33 T
+(regression test script. Many other mega-widgets are) 315 651.33 T
+(under construction which have not reached release sta-) 315 639.33 T
+(tus. They include classes such as T) 315 627.33 T
+(oolbar) 454 627.33 T
+(, Combobox,) 479.15 627.33 T
+(T) 315 615.33 T
+(able, Calendar) 320.41 615.33 T
+(, Gage, Menubar) 377.77 615.33 T
+(, and Mainwindow) 444.57 615.33 T
+(.) 519.19 615.33 T
+-0.36 (Once complete, each new class will be incorporated into) 315 603.33 P
+(the [incr W) 315 591.33 T
+(idgets] distribution.) 360.14 591.33 T
+(Public contributions to the [incr W) 315 567.33 T
+(idgets] mega-widget) 453.76 567.33 T
+(set are welcome and encouraged. Those mega-widgets) 315 555.33 T
+-0.08 (which currently compose [incr W) 315 543.33 P
+-0.08 (idgets] should be used) 448.67 543.33 P
+(as a model. Contributed mega-widgets should meet or) 315 531.33 T
+(exceed the objectives set forth in this paper such as) 315 519.33 T
+(extensible child sites, \337exible component con\336gura-) 315 507.33 T
+(tions, and style consistency) 315 495.33 T
+(. The coding and comment) 423.79 495.33 T
+(style must also be maintained. Man pages, demos, and) 315 483.33 T
+(test scripts are mandatory) 315 471.33 T
+(.) 416.83 471.33 T
+0 12 Q
+(Conclusion) 398.83 440 T
+1 10 Q
+([incr W) 315 415.33 T
+(idgets] of) 345.42 415.33 T
+(fers a strong object-oriented founda-) 383.29 415.33 T
+(tion which addresses the need for a \337exible and extensi-) 315 403.33 T
+-0.1 (ble mega-widget set. Its usage replaces common widget) 315 391.33 P
+-0.51 (combinations with higher level abstractions, simplifying) 315 379.33 P
+(code, reducing errors, increasing readability) 315 367.33 T
+(, adding) 490.41 367.33 T
+(productivity) 315 355.33 T
+(, and promoting a singular look-and-feel.) 363.24 355.33 T
+(The ability to extend [incr W) 315 343.33 T
+(idgets] enables developers) 430.97 343.33 T
+(to create new mega-widgets based on previous work.) 315 331.33 T
+(In short, [incr W) 315 309.33 T
+(idgets] is a library of reusable mega-) 381.25 309.33 T
+(widgets that can be easily extended, allowing quicker) 315 297.33 T
+-0.08 (development of lar) 315 285.33 P
+-0.08 (ge scale applications. It has been suc-) 390.21 285.33 P
+(cessfully used in several projects, including mission-) 315 273.33 T
+(critical telecommunication applications delivered to) 315 261.33 T
+(Japan, Great Britain, and Australia. As development) 315 249.33 T
+(continues, existing classes are being extended and new) 315 237.33 T
+(classes are being added. Development time has been) 315 225.33 T
+(drastically reduced. New dialogs can be created in) 315 213.33 T
+(hours. Whole applications in days. Reuse is a reality) 315 201.33 T
+(.) 523.77 201.33 T
+(New projects are bene\336tting from the work of others.) 315 189.33 T
+([incr W) 315 177.33 T
+(idgets] is an [incr Tk] success story) 345.42 177.33 T
+(.) 486.41 177.33 T
+0 12 Q
+(Acknowledgments) 380.5 146 T
+1 10 Q
+([incr W) 315 123.33 T
+(idgets] was produced by a dedicated team com-) 345.42 123.33 T
+(prised of Mark Ulferts, Sue Y) 315 111.33 T
+(ockey) 433.42 111.33 T
+(, Alfredo Jahn, John) 456.65 111.33 T
+(Sigler) 315 99.33 T
+(, and Bret Schuhmacher at DSC Communications) 338.49 99.33 T
+(Corp. Signi\336cant advice and counselling was adminis-) 315 87.33 T
+(tered by Mark Harrison, also employed by DSC.) 315 75.33 T
+FMENDPAGE
+%%EndPage: "9" 9
+%%Page: "10" 10
+612 792 0 FMBEGINPAGE
+[0 0 0 1 0 0 0]
+[ 0 1 1 0 1 0 0]
+[ 1 0 1 0 0 1 0]
+[ 1 1 0 0 0 0 1]
+[ 1 0 0 0 0 1 1]
+[ 0 1 0 0 1 0 1]
+[ 0 0 1 0 1 1 0]
+ 7 FrameSetSepColors
+FrameNoSep
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+(Michael J. McLennan, A) 72 713.33 T
+(T&T Bell Labs, allowed the) 170.59 713.33 T
+(team to beta test [incr Tk] and supported the ef) 72 701.33 T
+(fort) 259.28 701.33 T
+(through the infusion of innovative ideas.) 72 689.33 T
+0 12 Q
+(Refer) 156.62 658 T
+(ences) 185.05 658 T
+1 10 Q
+([1] Michael J. McLennan, \322[incr T) 72 635.33 T
+(cl] - Object-Oriented) 209.87 635.33 T
+(Programming in T) 86 623.33 T
+(cl\323, Proceedings of the T) 159.19 623.33 T
+(cl/Tk) 258.19 623.33 T
+(W) 86 611.33 T
+(orkshop 1993, Berkeley Ca.) 94.64 611.33 T
+(http://www) 86 599.33 T
+(.wn.com/biz/itcl) 130.91 599.33 T
+([2] Michael J. McLennan, \322[incr Tk] Building Extensi-) 72 577.33 T
+(ble W) 86 565.33 T
+(idgets with [incr T) 109.76 565.33 T
+(cl]\323, Proceedings of the T) 183.22 565.33 T
+(cl/) 285.55 565.33 T
+(Tk W) 86 553.33 T
+(orkshop 1994, New Orleans La.) 108.25 553.33 T
+(http://www) 86 541.33 T
+(.wn.com/biz/itk) 130.91 541.33 T
+([3] Ioi K. Lam, T) 72 519.33 T
+(ix,) 141.08 519.33 T
+(http://www) 86.67 507.33 T
+(.cis.upenn.edu/~ioi/tix/tix.html) 131.58 507.33 T
+([4] Nat Pryce, itcl-widgets,) 72 485.33 T
+(http://www-dse.doc.ic.ac.uk:80/~np2/itcl_widgets/) 86.67 473.33 T
+-0.03 ([5] John Ousterhout, \322T) 72 451.33 P
+-0.03 (cl and the Tk T) 166.75 451.33 P
+-0.03 (oolkit\323, Addison-) 227.03 451.33 P
+(W) 86 439.33 T
+(esley) 94.64 439.33 T
+(, 1994. http://playground.sun.com/~ouster/) 114.54 439.33 T
+0 12 Q
+(Appendix) 159.49 408 T
+([incr W) 133.83 394 T
+(idgets] T) 173.27 394 T
+(our) 217.17 394 T
+1 10 Q
+-0.02 ([incr Tk] provides the base classes for all the mega-wid-) 72 371.33 P
+(get classes of [incr W) 72 359.33 T
+(idgets]. The dialog classes are) 158.24 359.33 T
+-0.41 (derived from itk::T) 72 347.33 P
+-0.41 (oplevel, all other classes are based on) 147.14 347.33 P
+(itk::W) 72 335.33 T
+(idget. The [incr Tk] classes provide for compo-) 97.16 335.33 T
+(nent, option, and method de\336nition and management.) 315 713.33 T
+(The [incr W) 315 701.33 T
+(idget] classes are the specialization of the) 363.47 701.33 T
+([incr Tk] base classes, where each level re\336nes and aug-) 315 689.33 T
+-0.25 (ments the methods and options of the base classes. Each) 315 677.18 P
+-0.29 ([incr W) 315 665.18 P
+-0.29 (idgets] class will be brie\337y discussed and a short) 345.13 665.18 P
+(example presented. Figure 14 depicts the class hierar-) 315 653.18 T
+(chy) 315 641.18 T
+(.) 328.79 641.18 T
+0 12 Q
+(Labeledwidget) 389.83 609.85 T
+1 10 Q
+(The Labeledwidget is the most primitive mega-widget) 315 591.18 T
+(in the set, providing label support in the other classes.) 315 579.18 T
+(The class contains a label, a mar) 315 567.18 T
+(gin, and a child site) 444.51 567.18 T
+(which can be \336lled with other widgets. The options pro-) 315 555.18 T
+(vide the ability to position the label around the child) 315 543.18 T
+(site, modify the font, adjust the mar) 315 531.18 T
+(gin distance, and) 457.59 531.18 T
+(enable/disable label display) 315 519.18 T
+(.) 424.89 519.18 T
+(The following example creates a Labeledwidget with a) 315 495.18 T
+(canvas widget in the child site. The label is set to \322Can-) 315 483.18 T
+(vas\323 and initially located south of the child site. Next,) 315 471.18 T
+(the label is moved around the child site and mar) 315 459.18 T
+(gin set) 506.74 459.18 T
+(to various distances.) 315 447.18 T
+0 12 Q
+(Entry\336eld) 401.5 415.85 T
+1 10 Q
+(The Entry\336eld class associates a label with an entry) 315 397.18 T
+-0.18 (widget, providing text entry) 315 385.18 P
+-0.18 (, length, validation, and edit-) 425.46 385.18 P
+(ing enhancements. Since the class is based on the) 315 373.18 T
+(Labeledwidget class, all the options and methods for) 315 361.18 T
+72 72 540 315 R
+7 X
+V
+99.66 87.38 512.34 305 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+234.66 98 505.03 297.5 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+9 X
+N
+106.88 109.75 228.38 250.75 R
+7 X
+V
+8 X
+N
+112.03 179.75 164.53 189.5 R
+7 X
+V
+0 X
+N
+1 7 Q
+(itk::Archetype) 117.63 181.01 T
+178.28 126.75 226.28 136.5 R
+7 X
+V
+0 X
+N
+(itk::T) 183.4 128.01 T
+(oplevel) 198.47 128.01 T
+176.78 232.5 224.78 242.25 R
+7 X
+V
+0 X
+N
+(itk::W) 181.9 233.76 T
+(idget) 199.51 233.76 T
+248.19 200.84 289.44 210.59 R
+7 X
+V
+0 X
+N
+(Buttonbox) 252.58 202.09 T
+248.19 265.17 299.19 274.92 R
+7 X
+V
+0 X
+N
+(Selectionbox) 253.62 266.43 T
+248.19 184.76 292.44 194.51 R
+7 X
+V
+0 X
+N
+(Pushbutton) 252.9 186.01 T
+248.19 249.09 310.14 258.84 R
+7 X
+V
+0 X
+N
+(Fileselectionbox) 254.79 250.34 T
+248.19 216.92 300.69 226.67 R
+7 X
+V
+0 X
+N
+(Panedwindow) 253.78 218.18 T
+248.19 233.01 300.69 242.76 R
+7 X
+V
+0 X
+N
+(Labeledwidget) 253.78 234.26 T
+251.28 126.75 294.03 136.5 R
+7 X
+V
+0 X
+N
+(Dialogshell) 255.84 128.01 T
+320.78 126.75 357.53 136.5 R
+7 X
+V
+0 X
+N
+(Dialog) 324.7 128.01 T
+382.78 151.25 441.28 161 R
+7 X
+V
+0 X
+N
+(Messagedialog) 389.02 152.51 T
+382.78 118.58 443.53 128.33 R
+7 X
+V
+0 X
+N
+(Selectiondialog) 389.26 119.84 T
+382.78 102.25 453.84 112 R
+7 X
+V
+0 X
+N
+(Fileselectiondialog) 390.36 103.51 T
+382.78 134.92 435.28 144.67 R
+7 X
+V
+0 X
+N
+(Promptdialog) 388.38 136.17 T
+338.07 254.84 390.57 264.59 R
+7 X
+V
+0 X
+N
+(Scrolledlistbox) 343.67 256.09 T
+338.07 239.59 390.57 249.34 R
+7 X
+V
+0 X
+N
+(Optionmenu) 343.67 240.84 T
+338.07 224.34 390.57 234.09 R
+7 X
+V
+0 X
+N
+(Entry\336eld) 343.67 225.59 T
+338.07 209.09 390.57 218.84 R
+7 X
+V
+0 X
+N
+(Scrolledtext) 343.67 210.34 T
+415.1 224.46 448.85 234.21 R
+7 X
+V
+0 X
+N
+(Spinner) 418.7 225.72 T
+458.72 224.07 497.72 233.82 R
+7 X
+V
+0 X
+N
+(Spinint) 462.88 225.32 T
+165.38 184.25 171.38 184.25 2 L
+N
+171.38 236.75 171.38 131 2 L
+N
+171.88 132 177.88 132 2 L
+N
+171.63 236.5 177.63 236.5 2 L
+N
+226.88 131 251.63 131 2 L
+N
+294.38 131.75 320.63 131.75 2 L
+N
+357.38 131 373.13 131 2 L
+N
+373.13 155.75 373.13 107 2 L
+N
+373.13 155.75 382.88 155.75 2 L
+N
+373.63 107.25 383.38 107.25 2 L
+N
+372.88 123.75 382.63 123.75 2 L
+N
+373.38 139 383.13 139 2 L
+N
+237.28 284.77 237.28 156.44 2 L
+N
+237.53 270.01 249.53 270.01 2 L
+N
+237.28 253.76 249.28 253.76 2 L
+N
+237.03 238.26 249.03 238.26 2 L
+N
+237.53 221.26 249.53 221.26 2 L
+N
+237.28 205.01 249.28 205.01 2 L
+N
+237.03 189.51 249.03 189.51 2 L
+N
+237.27 237.93 224.95 237.93 2 L
+N
+325.66 259.89 325.66 183.62 2 L
+N
+326.2 259.89 337.98 259.89 2 L
+N
+326.16 243.86 337.95 243.86 2 L
+N
+326.13 228.89 337.91 228.89 2 L
+N
+325.56 213.39 337.34 213.39 2 L
+N
+301.02 236.86 325.13 236.86 2 L
+N
+390.48 229.36 415.13 229.36 2 L
+N
+449.41 228.82 460.13 228.82 2 L
+N
+102.94 91.81 507.95 300.87 R
+N
+0 10 Q
+([incr Tk]) 111.38 114.25 T
+([incr W) 237.38 102.25 T
+(idgets]) 270.25 102.25 T
+338.78 194.14 391.28 203.89 R
+7 X
+V
+0 X
+N
+326.06 198.52 337.84 198.52 2 L
+N
+339.04 179.26 391.54 189.01 R
+7 X
+V
+0 X
+N
+1 7 Q
+(Scrolledframe) 344.64 180.52 T
+326.53 183.57 338.32 183.57 2 L
+N
+(Scrolledcanvas) 341.88 195.5 T
+248.66 168.36 287.99 178.11 R
+7 X
+V
+0 X
+N
+(Spindate) 254.09 169.61 T
+249.43 152.58 286.55 162.33 R
+7 X
+V
+0 X
+N
+(Spintime) 254.87 153.84 T
+248.54 280.7 299.54 290.45 R
+7 X
+V
+0 X
+N
+(Combobox) 253.98 281.95 T
+248.34 284.77 237.22 284.77 2 L
+N
+248.34 172.55 237.22 172.55 2 L
+N
+249.45 157 237.78 157 2 L
+N
+0 0 612 792 C
+0 10 Q
+0 X
+0 0 0 1 0 0 0 K
+(FIGURE 14) 207.44 74.18 T
+1 F
+( - [incr W) 258.83 74.18 T
+(idgets] class hierarchy) 297.58 74.18 T
+FMENDPAGE
+%%EndPage: "10" 10
+%%Page: "11" 11
+612 792 0 FMBEGINPAGE
+[0 0 0 1 0 0 0]
+[ 0 1 1 0 1 0 0]
+[ 1 0 1 0 0 1 0]
+[ 1 1 0 0 0 0 1]
+[ 1 0 0 0 0 1 1]
+[ 0 1 0 0 1 0 1]
+[ 0 0 1 0 1 1 0]
+ 7 FrameSetSepColors
+FrameNoSep
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+-0.35 (Labeledwidgets are supported in Entry\336elds. Also, most) 72 470.33 P
+(of the methods for the standard Tk entry widget are pro-) 72 458.33 T
+(vided such as insert, delete, get, and scan.) 72 446.33 T
+0 12 Q
+(Pushbutton) 154.82 118 T
+1 10 Q
+(The Pushbutton class of) 72 99.33 T
+(fers the standard Tk button wid-) 167.65 99.33 T
+(get with the ability to display as a default button with a) 72 87.33 T
+-0.35 (recessed ring. The primary use for the Pushbutton is as a) 72 75.33 P
+72 477 297 720 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+72 504 297 720 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 2913
+134 174 40.2 52.2 0 81 657
+/red <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00000000000000000000000000000000000000000069FBB29AFF2CAEB6CF71E7
+A24DF70055BE928AB2D3FF00F7557DDBB2002CFF6120822C455D4571FF0000FF
+> store
+/green <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00000000000000000000000000000000000000000086FFDF8AE78AEFEF0071E7
+A24DF70055BE827530B6FFFFDF697DDBB2004D00B641DF4D829E4582FF0000FF
+> store
+/blue <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000008EFFEF75C755EFB60071E7
+A24DF77D55BE9265618EE300B22C7DDBB28A4D00FF59E351B6A2FF9200FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+7F4F5OGF4F57F4F5J"
+PHF58z8z8z
+5F8OFF85F8
+
+
+<z"
+P=F5F4=z"z"z"z
+0F4F5O6F4F50F4F50F4>z8z8z8z
+/F8O5F8/F8/F8
+J#>$
+O)FEFEFEFEFEJ"Js"
+O3F8O"F4F5J#Jr
+O)F8F8O,F8J09%;#
+JFEFEFEF8FEFEFEFEF8FEFEFEFEFEFEFEFEFEFEFEFEAs"J"9"8':%;%J$
+F4F56F8F8F8F8F8FEF8F8FEF8F8F8FEF8FEFE<F4F4F5BrJ$9%=%:"J"
+F88F8FEFEFEF8FEF8FEFEFEF8F8@F8AsJ"9"J#
+F5HF8FEDF5F5AtJ)=%J$
+F88F8FEFEF8F8FEFEF8FEF8F8F8EF8F8F8J"8"8'8"9"
+O(FEFEFEFEFEF8F8FEFEFEJ#8#9t8sJs
+MF8F8F8F8F8F8IF5Jt
+P6F8
+>z8z8z8z
+/F5O5F5/F5/F5sF"J"F"F&
+F5F5O6F5F5F5F5F5F5F5(z'
+F4F4F4F4F4F4F5P<D9F4F4F4F4F4F48%J&
+F8F8F8F8P>F8F8F8F8F5
+
+
+
+
+
+
+
+Gz
+P(FE
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Gz
+P(D9
+
+
+
+
+
+J%
+O"FEFEFEFEJ'
+O!FEFED9D9FEFEJ$8(8&8#9#8%9%
+O FEFED9D9D9D9FEFEFEFEFEFED9FEFEFEFEFEFEFEFEFEFEFEFEFEFEJ'9%?.
+O'FEFED9D9FEFEFED9FEFEFEFED9D9FEFED9FEFED9D9FEFEJ#=":+=%
+O'D9D9D9D9FEFED9FEFED9D9D9D9FED9D9D9J$I$9&
+O(FEFEFEFEFEFED9D9FEFEFEJ%A&8%;"8"
+O'FEFED9D9D9FEFEFED9FEFED9D9D9FEJ$8#J%
+O D9FEFEFEFE=FEFED9D9'J.?$9.J&
+F5F5F5F5F5F5ID9FEFEFEFED9D9FEFEFED9FEFED9FED9D9FEFEFED9FEFED9FEFEFEFED9GF5F5F5F5F5'J%8s8#:";vJ'
+F4F4F4F4F4F4JD9D9D9D9D9D9D9D9D9HF4F4F4F4F4F48%J&
+F8F8F8F8P>F8F8F8F8F5
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+=z"z"z
+0F4F5OGF4F51F4<z8z8z
+1F8OFF81F8
+
+
+7z8z8z
+6F5OFF55F5"J"J"
+F57F5OGF5
+ENDBITMAP
+%%EndBinary
+%%BeginBinary: 2909
+189 151 56.7 45.3 0 125.83 657
+/red <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00000000000000000000000000000000000000000069FBB29AFF2CAEB6CF71E7
+A24DF70055BE928AB2D3FF00F7557DDBB2002CFF6120822C455D4571FF0000FF
+> store
+/green <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00000000000000000000000000000000000000000086FFDF8AE78AEFEF0071E7
+A24DF70055BE827530B6FFFFDF697DDBB2004D00B641DF4D829E4582FF0000FF
+> store
+/blue <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000008EFFEF75C755EFB60071E7
+A24DF77D55BE9265618EE300B22C7DDBB28A4D00FF59E351B6A2FF9200FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+7F4F5Q"F4F57F4F5J"
+R#F58z8z8z
+5F8Q!F85F8
+
+
+<z"
+QFF5F4=z"z"z"z
+0F4F5P?F4F50F4F50F4>z8z8z8z
+/F8P>F8/F8/F8
+J#>$
+ODFEFEFEFEFEJ"Js"
+P F8O>F4F5J#Jr
+ODF8F8OHF8J09%;#
+O7FEFEFEF8FEFEFEFEF8FEFEFEFEFEFEFEFEFEFEFEFEAs"J"9"8':%;%J$
+F4F5O#F8F8F8F8F8FEF8F8FEF8F8F8FEF8FEFEO*F4F4F5BrJ$9%=%:"J"
+F8O%F8FEFEFEF8FEF8FEFEFEF8F8O.F8AsJ"9"J#
+F5O5F8FEO2F5F5AtJ)=%J$
+F8O%F8FEFEF8F8FEFEF8FEF8F8F8O3F8F8F8J"8"8'8"9"
+OCFEFEFEFEFEF8F8FEFEFEJ#8#9t8sJs
+O:F8F8F8F8F8F8O7F5Jt
+Q?F8
+>z8z8z8z
+/F5P>F5/F5/F5sF"J"F"F&
+F5F5P?F5F5F5F5F5F5F5(z'
+F4F4F4F4F4F4F5QED9F4F4F4F4F4F48%J&
+F8F8F8F8QGF8F8F8F8F5
+
+
+
+
+
+
+
+Gz
+P(FE
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+J%
+PDFEFEFEFEJ'
+PCFEFED9D9FEFEJ$8(8&8#9#8%9%
+PBFEFED9D9D9D9FEFEFEFEFEFED9FEFEFEFEFEFEFEFEFEFEFEFEFEFEJ'9%?.
+PIFEFED9D9FEFEFED9FEFEFEFED9D9FEFED9FEFED9D9FEFEJ#=":+=%
+PID9D9D9D9FEFED9FEFED9D9D9D9FED9D9D9J$I$9&
+PJFEFEFEFEFEFED9D9FEFEFEJ%A&8%;"8"
+PIFEFED9D9D9FEFEFED9FEFED9D9D9FEJ$8#J%
+PBD9FEFEFEFE=FEFED9D9J.?$9.
+PCD9FEFEFEFED9D9FEFEFED9FEFED9FED9D9FEFEFED9FEFED9FEFEFEFED9J%8s8#:";v
+PDD9D9D9D9D9D9D9D9D9
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+'J&
+F5F5F5F5F5F5QFF5F5F5F5F5'J'
+F4F4F4F4F4F4QFF4F4F4F4F4F48%J&
+F8F8F8F8QGF8F8F8F8F5
+
+
+
+
+Gz
+P(D9
+
+
+
+
+
+
+
+
+=z"z"z
+0F4F5Q"F4F51F4<z8z8z
+1F8Q!F81F8
+
+
+7z8z8z
+6F5Q!F55F5"J"J"
+F57F5Q"F5
+ENDBITMAP
+%%EndBinary
+%%BeginBinary: 2925
+134 180 40.2 54 0 188.67 657
+/red <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00000000000000000000000000000000000000000069FBB29AFF2CAEB6CF71E7
+A24DF70055BE928AB2D3FF00F7557DDBB2002CFF6120822C455D4571FF0000FF
+> store
+/green <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00000000000000000000000000000000000000000086FFDF8AE78AEFEF0071E7
+A24DF70055BE827530B6FFFFDF697DDBB2004D00B641DF4D829E4582FF0000FF
+> store
+/blue <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000008EFFEF75C755EFB60071E7
+A24DF77D55BE9265618EE300B22C7DDBB28A4D00FF59E351B6A2FF9200FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+7F6F7OGF6F77F6F7J"
+PHF78z8z8z
+5F9OFF95F9
+
+
+<z"
+P=F7F6=z"z"z"z
+0F6F7O6F6F70F6F70F6>z8z8z8z
+/F9O5F9/F9/F9
+J#>$
+O)FEFEFEFEFEJ"Js"
+O3F9O"F6F7J#Jr
+O)F9F9O,F9J09%;#
+JFEFEFEF9FEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEAs"J"9"8':%;%J$
+F6F76F9F9F9F9F9FEF9F9FEF9F9F9FEF9FEFE<F6F6F7BrJ$9%=%:"J"
+F98F9FEFEFEF9FEF9FEFEFEF9F9@F9AsJ"9"J#
+F7HF9FEDF7F7AtJ)=%J$
+F98F9FEFEF9F9FEFEF9FEF9F9F9EF9F9F9J"8"8'8"9"
+O(FEFEFEFEFEF9F9FEFEFEJ#8#9t8sJs
+MF9F9F9F9F9F9IF7Jt
+P6F9
+>z8z8z8z
+/F7O5F7/F7/F7sF"J"F"F&
+F7F7O6F7F7F7F7F7F7F7(z'
+F6F6F6F6F6F6F7P<D9F6F6F6F6F6F68%J&
+F9F9F9F9P>F9F9F9F9F7
+
+
+
+
+
+
+
+
+
+
+
+
+
+J%
+O"FEFEFEFEJ'
+O!FEFED9D9FEFEJ$8(8&8#9#8%9%
+O FEFED9D9D9D9FEFEFEFEFEFED9FEFEFEFEFEFEFEFEFEFEFEFEFEFEJ'9%?.
+O'FEFED9D9FEFEFED9FEFEFEFED9D9FEFED9FEFED9D9FEFEJ#=":+=%
+O'D9D9D9D9FEFED9FEFED9D9D9D9FED9D9D9J$I$9&
+O(FEFEFEFEFEFED9D9FEFEFEJ%A&8%;"8"
+O'FEFED9D9D9FEFEFED9FEFED9D9D9FEJ$8#J%
+O D9FEFEFEFE=FEFED9D9J.?$9.
+O!D9FEFEFEFED9D9FEFEFED9FEFED9FED9D9FEFEFED9FEFED9FEFEFEFED9J%8s8#:";v
+O"D9D9D9D9D9D9D9D9D9
+
+
+
+
+
+
+
+
+
+
+
+
+Gz
+P(FE
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+'J&
+F7F7F7F7F7F7P=F7F7F7F7F7'J'
+F6F6F6F6F6F6P=F6F6F6F6F6F68%J&
+F9F9F9F9P>F9F9F9F9F7
+
+
+
+
+Gz
+P(D9
+
+
+
+
+
+
+
+
+=z"z"z
+0F6F7OGF6F71F6<z8z8z
+1F9OFF91F9
+
+
+7z8z8z
+6F7OFF75F7"J"J"
+F77F7OGF7
+ENDBITMAP
+%%EndBinary
+%%BeginBinary: 2903
+194 151 58.2 45.3 0 233.27 657
+/red <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00000000000000000000000000000000000000000069FBB29AFF2CAEB6CF71E7
+A24DF70055BE928AB2D3FF00F7557DDBB2002CFF6120822C455D4571FF0000FF
+> store
+/green <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+00000000000000000000000000000000000000000086FFDF8AE78AEFEF0071E7
+A24DF70055BE827530B6FFFFDF697DDBB2004D00B641DF4D829E4582FF0000FF
+> store
+/blue <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000008EFFEF75C755EFB60071E7
+A24DF77D55BE9265618EE300B22C7DDBB28A4D00FF59E351B6A2FF9200FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+7F4F5Q'F4F57F4F5J"
+R(F58z8z8z
+5F8Q&F85F8
+
+
+<z"
+QKF5F4=z"z"z"z
+0F4F5PDF4F50F4F50F4>z8z8z8z
+/F8PCF8/F8/F8
+J#>$
+OGFEFEFEFEFEJ"Js"
+P#F8O@F4F5J#Jr
+OGF8F8OJF8J09%;#
+O:FEFEFEF8FEFEFEFEF8FEFEFEFEFEFEFEFEFEFEFEFEAs"J"9"8':%;%J$
+F4F5O&F8F8F8F8F8FEF8F8FEF8F8F8FEF8FEFEO,F4F4F5BrJ$9%=%:"J"
+F8O(F8FEFEFEF8FEF8FEFEFEF8F8O0F8AsJ"9"J#
+F5O8F8FEO4F5F5AtJ)=%J$
+F8O(F8FEFEF8F8FEFEF8FEF8F8F8O5F8F8F8J"8"8'8"9"
+OFFEFEFEFEFEF8F8FEFEFEJ#8#9t8sJs
+O=F8F8F8F8F8F8O9F5Jt
+QDF8
+>z8z8z8z
+/F5PCF5/F5/F5sF"J"F"F&
+F5F5PDF5F5F5F5F5F5F5(z'
+F4F4F4F4F4F4F5QJD9F4F4F4F4F4F48%J&
+F8F8F8F8QLF8F8F8F8F5
+
+
+
+
+
+
+
+Jz
+O?P(FE
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+J%
+7FEFEFEFEJ'
+6FEFED9D9FEFEJ$8(8&8#9#8%9%
+5FEFED9D9D9D9FEFEFEFEFEFED9FEFEFEFEFEFEFEFEFEFEFEFEFEFEJ'9%?.
+<FEFED9D9FEFEFED9FEFEFEFED9D9FEFED9FEFED9D9FEFEJ#=":+=%
+<D9D9D9D9FEFED9FEFED9D9D9D9FED9D9D9J$I$9&
+=FEFEFEFEFEFED9D9FEFEFEJ%A&8%;"8"
+<FEFED9D9D9FEFEFED9FEFED9D9D9FEJ$8#J%
+5D9FEFEFEFE=FEFED9D9J.?$9.
+6D9FEFEFEFED9D9FEFEFED9FEFED9FED9D9FEFEFED9FEFED9FEFEFEFED9J%8s8#:";v
+7D9D9D9D9D9D9D9D9D9
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+'J&
+F5F5F5F5F5F5QKF5F5F5F5F5'J'
+F4F4F4F4F4F4QKF4F4F4F4F4F48%J&
+F8F8F8F8QLF8F8F8F8F5
+
+
+
+
+Jz
+O?P(D9
+
+
+
+
+
+
+
+
+=z"z"z
+0F4F5Q'F4F51F4<z8z8z
+1F8Q&F81F8
+
+
+7z8z8z
+6F5Q&F55F5"J"J"
+F57F5Q'F5
+ENDBITMAP
+%%EndBinary
+81 513 285.67 644.15 R
+7 X
+V
+4 8 Q
+0 X
+(labeledwidget .lw -labeltext \322Canvas\323 \134) 81 638.82 T
+( -labelpos s) 81 628.82 T
+(set childsite [.lw childsite]) 81 618.82 T
+(canvas $childsite.c -relief raised \134) 81 608.82 T
+-0.22 ( -width 100 -height 100 -background black) 81 598.82 P
+(pack $childsite.c) 81 578.82 T
+(pack .lw -f) 81 568.82 T
+(ill both -expand yes \134) 133.8 568.82 T
+( -padx 10 -pady 10) 81 558.82 T
+(.lw conf) 81 538.82 T
+(igure -labelpos w -labelmargin 10) 119.4 538.82 T
+(.lw conf) 81 528.82 T
+(igure -labelpos e -labelmargin 5) 119.4 528.82 T
+(.lw conf) 81 518.82 T
+(igure -labelpos n -labelmargin 7) 119.4 518.82 T
+0 10 Q
+(FIGURE 15) 124.93 486.1 T
+1 F
+( - Labeledwidget) 176.32 486.1 T
+0 0 612 792 C
+72 146 297 443 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+72 182 297 443 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 4942
+279 127 143.49 65.31 0 108.51 368.69
+/red <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000007DFFCF9AFFFF699A69FBB29AFF2CAEB6CF71E7
+A24DF70055BE928AB2D3FF00F7557DDBB2002CFF6120822C455D4571FF0000FF
+> store
+/green <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000006DFFB669F7AE869A86FFDF8AE78AEFEF0071E7
+A24DF70055BE827530B6FFFFDF697DDBB2004D00B641DF4D829E4582FF0000FF
+> store
+/blue <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000005DDF9E71FFBA8E9A8EFFEF75C755EFB60071E7
+A24DF77D55BE9265618EE300B22C7DDBB28A4D00FF59E351B6A2FF9200FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+7F6F7S F6F77F6F7J"
+T!F78z8z8z
+5F9RMF95F9
+
+
+<z"
+SDF7F6=z"z"z"z
+0F6F7R=F6F70F6F70F6>z8z8z8z
+/F9R<F9/F9/F9
+JsB"Es8#?$<$<%B$C$@#;$9#J"
+EFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEO#FEJ"8$C"F"8$E">">"8"B"E"I"J"Js"
+EF9F9F9F9FEF9F9F9F9F9F9F9F9F9F9F9O)FEFF6F7J"J"9#J%@#<#Jr
+KF9CF9F9F9O9FEF9FEFEF9F9FEFEOBF9J+9"80;"9$:$?#I%<#;$J$9-9'8#;$8'9"8#
+JFEF9F9F9FEFEFEF9FEFEFEFEFEFEFEFEF9FEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFE;FEFEFEFEFEFEFEF9F9FEFEFEF9FEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEF9FEFEFEFEFEAs"J#:"8%8"8$8":&9#8$:'<&I%:-B'>":)8%8"8)8)8%8"8#J$
+F6F74FEFEF9FEF9FEFEF9F9F9F9FEF9F9F9FEF9FEFEF9F9F9FEFEFEF9FEFEFEFEFEF9FEF9F9FEFEFEF9FEFEFEF9FEFEFEF9FEFEFEF9F9F9FEFEF9FEFEF9F9FEFEF9F9FEF9FEFEF9FEF9FEFEFEF9FEFEFEFEFEF9FEFEF9F9FEF9FEFEF9F9F95F6F6F7BrJ#="C*:#B"@$H$<$<"E$J">"9">"<"J"
+F95F9F9F9F9F9F9F9FEFEF9FEF9F9F9FEF9F9F9F9FEFEF9F9F9FEFEFEFE9F9F9F9FEF9@F9AsJ$J"@%J'D%A)B'J%J#
+F77F9F9FEAF9F9F9F9F9:FEF9FEFEF9F9F9F9F9F9FEF9F9F9F9F9FEFEF9FEFEFEFEF99F9F9F9F9DF7F7AtJ"J%H%>$D";">";%J&J%J$
+F97FE7F9FEFEF9FEF9FEFEFEF9FEFEFEFEFEF9FEFE?FEF9F9F9F9:FEF9FEFEDF9F9F9J"8$9"8"9"8&8"?"8";"8+8(8";"8$9%8"808";$9"8$8$8"8(8"9$8"9"9+8"9"8$
+EFEFEFEFEFEFEFEF9FEFEF9FEFEFEFEFEFEF9F9F9FEFEFEF9F9FEFEF9F9F9FEFEF9FEFEFEFEFEF9FEFEF9FEF9FEFEFEF9F9F9F9F9FEFEFEF9F9FEFEFEFEFEFEFEF9FEFEF9FEFEFEFEFEFEFEF9FEFEFEF9FEFEFEFEF9F9F9FEFEFEF9F9FEFEFEF9FEFEJz9r;"9%;%9$8%9';s8w;$8%;$9z;"z9$8s9#Js
+E1F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F90F9FE5F9F9F9F9F9F9F9DF7J%J&Jt
+O3FEFEFEF9P-FEF9F9F9F9OBF9J"J(
+O5F9P.F9FEFEFEFEFEF9>z8z8z8z
+/F7R<F7/F7/F7sF"J"F"F&
+F7F7R=F7F7F7F7F7F7F7(z'
+F6F6F6F6F6F6F7SCD9F6F6F6F6F6F68%J&
+F9F9F9F9SEF9F9F9F9F7
+
+
+
+Jz
+P7Q(D4J"
+S>FFJZ
+P9Q%
+
+J#9#
+5FEFEFEFEJ"
+7FEJ%8*9%9#
+>FEFEFEFEFED9FEFEFED9FEFEFEFEFEFEFEFEFEJ#:'81
+7D9FEFEFED9D9FEFEFED9D9FEFED9D9FEFED9FEFED9D9FEFEJ#J#
+=D9D98D9D9J#:$F#
+8D9FEFEFEFEFEFEJ%F%
+=FEFED9D9D9D9D9D9J"J#8#
+9D99FEFEFEFEJ(A'
+=D9FEFEFED9FEFED9FEFEFEFED9J#9#8s8#8#8%9#
+5D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9
+
+
+J"
+P8FFJz
+P7Q(D9
+
+
+
+
+
+
+
+
+
+
+
+Jz
+P7Q(D4J"
+S>FFJZ
+P9Q%
+
+J#=#;#
+8FEFEFEFEFEFEJ"8"
+7FEFEJ#:#;#:+9%9%9#
+8D9D9FEFEFEFEFEFED9FEFED9FEFEFEFEFEFEFEFEFEFEFEFEFEFEJ":'9%;"85
+6FEFED9FEFED9FEFEFED9FEFE4FEFED9D9FEFED9FEFED9D9FEFED9FEFED9D9FEFEJ"<"<#?%9%8#
+@D9D9D9D9FED9D9D9FED9D9D9D9D9J#I":#9&8&
+8FEFED9FEFED9D9FEFEFED9D9FEFEFEJ)J%9"8"9"8"
+5FEFED9D9D9D9FEFE5D9D9D9D9D9FED9FEJ"<"B(9%:#
+@FEFEFEFED9FEFED9D9FEFED9D9FEFEJ%9%>5
+=D9FEFED9D9FEFED94D9FEFEFEFED9D9D9FEFEFEFED9D9D9FEFEFEFED9J#:s8s:%9%9%9#
+5D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9
+
+
+J"
+P8FFJz
+P7Q(D9
+
+
+
+
+
+
+
+
+
+
+
+Jz
+P7Q(D4J"
+S>FFJZ
+P9Q%
+
+J*J#9#I#
+5FEFEFEFEFEFED9FEFE?FEFEFEFEFEFEJ&J"
+7D9D9D9FEFECFEJ#9%8&9%E#8-;#9%8)
+?FEFEFEFEFEFEFEFED9FEFEFEFEFEFEFEFEFEFED9FED9FEFEFED9FEFEFEFEFEFEFEFEFEFEFED9FEFED9FEFE'J,9,>#B*9,9"J&
+F7F7F7F7F7F78FED9FEFED9FEFED9D9FEFEFED9FEFED9FEFED9D9FEFED9FEFED9D9FEFED9D9FEFEFED9FEFED9FEFED9D9FEFEFEQ>F7F7F7F7F7'G&8"C"J"D&J'
+F6F6F6F6F6F6FEFEFEFED9D9D9LD9D9D9D9D9D9Q9F6F6F6F6F6F68%G%J#A#J#;"J&
+F9F9F9F9D9D9D9D98FEFED9FE>FEFED9Q?F9F9F9F9F7J%J%
+O%D9D9D9D9ID9D9D9D9J#@"<"F">#=#
+O'FEFED9FEFEFEFEFEFEJ'>'D%F,
+CD9FEFEFEFED9D9FEFEFEFED9D9FEFED9D9FEFED9D9D9FEFEFEFED9J#;#8#8%8#8#8%=#9#8s8#8s9%8#:#
+5D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9
+
+
+J"
+P8FFJz
+P7Q(D9
+
+
+
+
+
+=z"z"z
+0F6F7S F6F71F6<z8z8z
+1F9RMF91F9
+
+
+7z8z8z
+6F7RMF75F7"J"J"
+F77F7S F7
+ENDBITMAP
+%%EndBinary
+81 191 288 353 R
+7 X
+V
+4 8 Q
+0 X
+(entryf) 81 347.67 T
+(ield .name -validate alphabetic \134) 109.8 347.67 T
+( -labeltext Name:) 81 337.67 T
+(entryf) 81 317.67 T
+(ield .address -labeltext Address:) 109.8 317.67 T
+( -validate alphanumeric) 81 307.67 T
+(entryf) 81 287.67 T
+(ield .phone -validate numeric \134) 109.8 287.67 T
+( -labeltext \322Phone Number:\323) 81 277.67 T
+(Labeledwidget::alignlabels \134) 81 257.67 T
+( .name .address .phone) 81 247.67 T
+(foreach wid [list .name .address .phone] {) 81 227.67 T
+( pack $wid -pady 5 -padx 10 \134) 81 217.67 T
+( -f) 81 207.67 T
+(ill x -expand yes) 129 207.67 T
+(}) 81 197.67 T
+0 10 Q
+(FIGURE 16) 134.64 164.09 T
+1 F
+( - Entry\336eld) 186.03 164.09 T
+0 0 612 792 C
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+(child of the Buttonbox class. In addition to furnishing) 315 713.33 T
+(the standard methods and options for Tk button, the) 315 701.33 T
+(Pushbutton provides options for enabling/disabling the) 315 689.33 T
+(display of the default ring and geometry requirements.) 315 677.33 T
+0 12 Q
+(Optionmenu) 395.16 483 T
+1 10 Q
+-0.46 (The Optionmenu class allows selection of one item from) 315 464.33 P
+(a set of items. Only the selected item is displayed, until) 315 452.33 T
+(the user selects the option menu button and a popup) 315 440.33 T
+(menu appears with all the choices available for selec-) 315 428.33 T
+(tion. Once a new item is chosen, the currently selected) 315 416.33 T
+(item is replaced and the popup is removed from the dis-) 315 404.33 T
+(play) 315 392.33 T
+(. Commands exist for manipulating the menu list) 331.57 392.33 T
+(contents as well. These include the ability to insert,) 315 380.33 T
+(delete, select, disable, enable, and sort items.) 315 368.33 T
+0 12 Q
+(Spinner) 407.16 130 T
+1 10 Q
+(Spinners constitute a set of widgets which provide) 315 111.33 T
+(EntryField functionality combined with increment and) 315 99.33 T
+(decrement arrow buttons which may be oriented in a) 315 87.33 T
+(vertical, top and bottom, fashion or in a horizontal, side) 315 75.33 T
+315 511 540 674 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+315 531.86 540 647 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 3350
+147 103 75.6 52.97 0 396 584
+/red <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000008EEF9AFF2CAEB6CF71E7
+A24DF70055BE928AB2D3FF00F7557DDBB2002CFF6120822C455D4571FF0000FF
+> store
+/green <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000082D78AE78AEFEF0071E7
+A24DF70055BE827530B6FFFFDF697DDBB2004D00B641DF4D829E4582FF0000FF
+> store
+/blue <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000006DB675C755EFB60071E7
+A24DF77D55BE9265618EE300B22C7DDBB28A4D00FF59E351B6A2FF9200FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+7F4F5P&F4F57F4F5J"
+Q'F58z8z8z
+5F8P%F85F8
+
+
+<z"
+PJF5F4=z"z"z"z
+0F4F5OCF4F50F4F50F4>z8z8z8z
+/F8OBF8/F8/F8
+JrG$<'D":"
+:FEFEFEFEFEFEFEFEFEFEFEFEJ"8&F">"8%B":"Js"
+:F8F8F8F8FEFEF8F8F8F8FEFEFEFEKF4F5Jr
+PDF8J(9%;#B(8"8$8#8$9'
+CFEFEFEF8FEFEFEFEFEFEFEFEFEFEFEFEF8FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEF8FEFEAs"A&9":%;%;%8"9":"8$8,8%A$
+F4F5FEFEF8F8F8F8FEF8F8F8FEF8FEFEFEFEFEF8F8F8F8F8F8F8F8F8FEFEFEF8FEFEFEF8F8FEF8FEFEF4F4F5Br@%B%:">&J$<"E"
+F8FEFEFEF8FEFEFEF8F8F8F8F8FEFE6F8F8F8F8F8As@$B"9"J#
+F5F8F8F8F8FEO2F5F5AtI":%J"F$J$
+F8FEFEF8F8F88FEFEF8FE5F8F8F8J"8"<%8"8'8"9$8&8%8"8$8.8"9"
+:FEFEF8FEFEF8FEFEFEFEF8F8FEFEFEF8FEFEFEFEFEF8F8FEFEF8FEF8FEFEF8FEFEF8F8F8FEFEFEF8F8F8FEFEFEJ%=v8z:'9#9#9$9sJs
+:F8F8F8F8F80F8F8F8F8F8F8F8F8F8F8F8F8F8F8F88F5Jt
+PCF8
+>z8z8z8z
+/F5OBF5/F5/F5sF"J"F"F&
+F5F5OCF5F5F5F5F5F5F5(z'
+F4F4F4F4F4F4F5PID9F4F4F4F4F4F48%J&
+F8F8F8F8PKF8F8F8F8F5
+
+
+
+
+
+
+
+
+
+Iz
+P1FE
+Jz
+5P-D9
+Jz
+7P)D8J"
+P?FFJz"
+9P%D9FF
+
+
+JZ
+=OKJ"
+P9D8Jz"
+?OGD9D8
+
+
+
+
+J'E#<'@#9#
+GFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEJ&J&
+ID9D9D9FEFE8D9D9D9FEFEJ#8#8%;#A#8%8$8"8%8&
+O FEFEFEFEFEFEFEFEFEFEFEFEFEFED9FEFED9FEFEFEFEFEFEFEFED9FEFEJ'9%G"8$8)9%
+O'FEFED9D9FEFEFED9FEFED9D9D9D9D9D9FEFED9D9FEFEFED9FEFEJ&?%9"=&J"
+IFEFEFEFED9FED9D9D9D9FEFEFEFED9;D9J%>&B&
+ID9D9D9D9D9D9FEFEFED9D9D9FEFEJ"8"
+O)D9FEJ"9%J"=":"
+O#FEFEFED9D96FEFEFEJ%9'A+:0
+O D9FEFED9D9FEFEFEFED9FEFEFEFED9D9D9FEFED9D9FEFED9D9D9FEFED9D9FEFEFEFED9J#<&8%8#8#8'9&9#9#8%8#8#
+GD9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9
+
+
+
+
+
+
+
+Jz
+?OGD8J"
+>D8Jz
+=OKD9
+
+
+'IZH&
+F5F5F5F5F5F5P%F5F5F5F5F5'H"J'
+F4F4F4F4F4F4FFP7F4F4F4F4F4F48%GzG&
+F8F8F8F8P)D9F8F8F8F8F5
+Jz
+5P-FE
+Iz
+P1D9
+
+
+
+
+
+
+
+
+
+
+=z"z"z
+0F4F5P&F4F51F4<z8z8z
+1F8P%F81F8
+
+
+7z8z8z
+6F5P%F55F5"J"J"
+F57F5P&F5
+ENDBITMAP
+%%EndBinary
+324 539 531 575 R
+7 X
+V
+4 8 Q
+0 X
+(pushbutton .pb -text PushButton \134) 324 569.67 T
+( -defaultring yes) 324 559.67 T
+(pack .pb -padx 12 -pady 12) 324 549.67 T
+0 10 Q
+(FIGURE 17) 380.43 514.17 T
+1 F
+( - Pushbutton) 431.83 514.17 T
+0 0 612 792 C
+315 158 540 365 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+315 178.14 540 356 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 4071
+264 73 135.77 37.54 0 359.23 311
+/red <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000008EEF9AFF2CAEB6CF71E7
+A24DF70055BE928AB2D3FF00F7557DDBB2002CFF6120822C455D4571FF0000FF
+> store
+/green <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000082D78AE78AEFEF0071E7
+A24DF70055BE827530B6FFFFDF697DDBB2004D00B641DF4D829E4582FF0000FF
+> store
+/blue <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000006DB675C755EFB60071E7
+A24DF77D55BE9265618EE300B22C7DDBB28A4D00FF59E351B6A2FF9200FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+7F6F7R?F6F77F6F7J"
+S@F78z8z8z
+5F9R>F95F9
+
+
+<z"
+S5F7F6=z"z"z"z
+0F6F7R.F6F70F6F70F6>z8z8z8z
+/F9R-F9/F9/F9
+J&C"9#I%9%
+OFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEJ(A"J"?"Js"
+OEFEFEF9F9F9FEFEFE9F9F9P.F6F7J$9$E#Jr
+ODFEFEF9F9FEFEF9F9PMF9J'9"8&:$9';'<$8'9(
+OMFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEFEF9FEFEF9FEFEF9FEF9FEFEFEFEFEFEF9FEFEFEFEFEF9FEFEFEAs"J"8(8$:*8%D)8%8"9"J$
+F6F7O9F9FEF9FEFEFEF9F9F9F9F9FEFEFEF9FEFEFEF9F9FEF9FEFEFEFEFEF9FEFEF9F9FEF9FEFEF9F9O8F6F6F7BrJ$E$<"J"<"J"
+F9O=F9F9F9F9F9F9F94FEF9OCF9AsJ%=%J#
+F7P3F9FEFEF9F9F9F9F9OGF7F7AtJ$9$9$E$J%D"J$
+F9O0F9FEFEFEFEF9FEF9FEFEF9FE:FEF9FEFEFEO8F9F9F9J(:&8&8,8"9&:"8+8"9"8%8"
+OEF9FEFEFEFEFEF9F9FEFEF9F9F9FEFEF9FEFEF9F9F9FEFEFEF9F9F9FEFEFEF9FEFEFEFEFEF9F9F9FEFEFEF9F9FEFEFEF9FEFEF9FEJ&<#;r9$9z9$8s9'Js
+OFF9F9F9F9F9F9F9F9F9F9F94F9F9F9F9F9F9F9F9F9F9F9OCF7Jt
+S.F9J"8"
+OMFEFE>z8z8z8z
+/F7R-F7/F7/F7sF"J"F"F&
+F7F7R.F7F7F7F7F7F7F7(z'
+F6F6F6F6F6F6F7S4D9F6F6F6F6F6F68%J&
+F9F9F9F9S6F9F9F9F9F7
+
+
+
+
+
+
+
+JZ
+Q'P*J"
+S0D8Jz"
+Q)P&D9D8
+
+
+J%J#8#J&H#J#:#
+7FEFEFEFE>FEFEFEFE5FEFEFEFEFEFEFEO*FEFEFEFEJ'J#J(J#
+6FEFED9D9FEFEAD9D94FEFED9D9D9FEFEOCD9D9J$8*9%8+8"8+9&D#9#8%8"8"8%8*9%9#J)8#8&8#JW
+5FEFED9D9FEFED9FEFED9FEFEFEFEFEFEFEFED9FEFED9FEFEFEFEFEFED9FEFED9FEFED9FEFEFEFED9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFED9FEFEFED9FEFEFEFEFEFEFEFEFE@FEFED9FEFED9FEFEFEFEFEFED9FEFEFEFE=J,9"8)8"<*>(?)8)81J%J"
+@FED9FEFED9FEFED9D9FEFEFEFEFED9D9FEFED9D9D9FED9FEFED9FEFED9FED9FEFEFED9D9D9FEFED9D9FEFED9D9D9D9FEFED9D9FEFEFED9D9FEFED9D9FEFED9FEFED9D9FEFEIFED9FEFEO(D8J"D%E"="?&8(9%J%8#J"A'Js"
+@D9D9D9D9D9D9D9D9D9FEFEFED9FEFED9FEFED9FED9D9D9:FED9D9D9D9D9ED9D9FEFEFEFED9?D9D8J#;"9$J"8"?&?#D&J"8"
+GFEFED9FEFEFEAD9FED9D9FEFEFEFEFED9D9FEFEFEO)D9D9J%<%J#8":&:"8">%D"8"J"8"Js
+GD9D9D9D9FEFED9D9>FEFED9D9FEFEFED9D9FED9D9D9D9D9FEO(FEFE@D8J$8$9">#G"C"J%=":#B%:#J"9'J"
+5D9FEFEFEFED9FEFEFEFEFE8FEFED9D9FEFEFEFEFED9D9FEFEMFEFEFED9D9FEFE>D8'F':,<-@%>(9";'8+B'J%@%JwJ&
+F7F7F7F7F7F7D9FEFEFEFED9D9FEFED9D9D9FEFEFEFED9D9FEFEFED9FEFED9D9FEFED9D9FEFED9D9FEFEFEFEFED9D9D9FEFEFEFED9D9FEFED9D9FEFEFEFED9D9FEFEFEFED9@FEFEFEFED9FEFED9FD96F7F7F7F7F7'G%<#9%8#:'8s8#8#@&<":%:#8%8#8#8#8%9#Jv8#8s8#J'
+F6F6F6F6F6F6D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9:D9D9D9D9D9D9O1F6F6F6F6F6F68%J#J"J&
+F9F9F9F9O3FEFE4FEQ:F9F9F9F9F7J'E$
+O9D9FEFEFEFED9FEFED9J#J%F#
+>D9D9HD9D9D9D9D9D9
+Jz
+Q)P&D8J"
+Q(D8Jz
+Q'P*D9
+
+
+
+
+
+
+
+
+=z"z"z
+0F6F7R?F6F71F6<z8z8z
+1F9R>F91F9
+
+
+7z8z8z
+6F7R>F75F7"J"J"
+F77F7R?F7
+ENDBITMAP
+%%EndBinary
+324 185 531 302 R
+7 X
+V
+4 8 Q
+0 X
+(Optionmenu .om \134) 324 296.67 T
+( -labeltext \322Operating Systems:\323 \134) 324 286.67 T
+( -items {SunOS HP/UX AIX OS/2 Windows} \134) 324 276.67 T
+( -command SelectProc) 324 266.67 T
+(pack .om -padx 10 -pady 10) 324 256.67 T
+(.om insert end Linux VMS) 324 236.67 T
+(.om disable DOS) 324 226.67 T
+(.om delete 1 2) 324 216.67 T
+(.om sort ascending) 324 206.67 T
+(.om select Linux) 324 196.67 T
+(.om conf) 324 186.67 T
+(igure -cyclicon true) 362.4 186.67 T
+0 10 Q
+(FIGURE 18) 375.73 160.17 T
+1 F
+( - Optionmenu) 427.11 160.17 T
+0 0 612 792 C
+FMENDPAGE
+%%EndPage: "11" 11
+%%Page: "12" 12
+612 792 0 FMBEGINPAGE
+[0 0 0 1 0 0 0]
+[ 0 1 1 0 1 0 0]
+[ 1 0 1 0 0 1 0]
+[ 1 1 0 0 0 0 1]
+[ 1 0 0 0 0 1 1]
+[ 0 1 0 0 1 0 1]
+[ 0 0 1 0 1 1 0]
+ 7 FrameSetSepColors
+FrameNoSep
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+(by side, manner) 72 713.33 T
+(. A value may be entered into the entry) 135.05 713.33 T
+(area explicitly or the buttons may be pressed which) 72 701.33 T
+(cycle up and down through the choices. This latter) 72 689.33 T
+(behavior is one of spinning.) 72 677.33 T
+(The following code segment creates a month spinner) 72 653.33 T
+(based on the Spinner class. The months are stored in a) 72 641.33 T
+(list from which the spinMonth procedure cycles. The) 72 629.33 T
+(Spinner increment and decrement options invoke this) 72 617.33 T
+(procedure with a direction ar) 72 605.33 T
+(gument which is 1 or -1.) 187.34 605.33 T
+(The Spinner disables input by making the blockInput) 72 593.33 T
+(procedure the validation procedure which always) 72 581.33 T
+(returns invalid.) 72 569.33 T
+72 167 297 566 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+72 206 297 548 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 3312
+179 73 92.06 37.54 0 144 503
+/red <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000096FB7DFFCF9A96FB69FBB29AFF2CAEB6CF71E7
+A24DF70055BE928AB2D3FF00F7557DDBB2002CFF6120822C455D4571FF0000FF
+> store
+/green <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000096FB6DFFB66996FB86FFDF8AE78AEFEF0071E7
+A24DF70055BE827530B6FFFFDF697DDBB2004D00B641DF4D829E4582FF0000FF
+> store
+/blue <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000009AFF5DDF9E719AFF8EFFEF75C755EFB60071E7
+A24DF77D55BE9265618EE300B22C7DDBB28A4D00FF59E351B6A2FF9200FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+7F6F7PFF6F77F6F7J"
+QGF78z8z8z
+5F9PEF95F9
+
+
+<z"
+Q<F7F6=z"z"z"z
+0F6F7P5F6F70F6F70F6>z8z8z8z
+/F9P4F9/F9/F9
+J'@#
+O*FEFEFEFEF9FEFEFEJ'Js"
+O)FEFEF9F9F9FEP&F6F7J"A#Jr
+O.F9F9F9OHF9J#8(9$8'9';$8'
+O+FEFEF9FEFEFEF9FEFEFEFEFEFEFEFEF9FEFEFEFEFEF9FEFEFEFEFEFEFEFEF9FEFEAs"J"9%8(:"8%8"8%8)8"J$
+F6F7CF9FEFEF9F9FEF9FEFEFEF9F9F9FEF9FEFEF9FEF9FEFEFEFEFEF9FEFEF9F9FEHF6F6F7BrJ#9"9$A">">"<$J"
+F9EF9F9FEF9F9F9F9F9FEF9F9F9GF9AsJ"8#J%J#
+F7DFEF9F9DF9F9F9F9MF7F7AtJ">$J%J$
+F9DFEFEF9FE<FEF9FEFEMF9F9F9J'9(8$8"9$8"9+8"
+O*F9FEFEFEFEF9F9FEFEF9F9F9FEFEF9FEFEFEF9FEFEFEF9F9F9FEFEFEF9F9FEFEJ';#9z9$8%Js
+O)F9F9F9F9F9F9F9F96F9F9F9F9F9F9F9F9O(F7Jt
+Q5F9J"8"
+O0FEFE>z8z8z8z
+/F7P4F7/F7/F7sF"J"F"F&
+F7F7P5F7F7F7F7F7F7F7(z'
+F6F6F6F6F6F6F7Q;D9F6F6F6F6F6F68%J&
+F9F9F9F9Q=F9F9F9F9F7
+
+
+
+
+
+
+
+
+Jz8U
+O:O>D3J"9s"
+Q)FFD9D8Jz"="
+O<O:D4FFFEJ"
+Q1FEJ"
+Q/FEJ#;#F#8#J"J"
+5FEFEFEFEFEFEFEFE<FEO=FEJ"
+Q.FEJ"9":%8&8"8":#=#J$9%9"9"9$9&9"J"
+7FEFEFEFEFEFEFEFED9FEFEFEFEFEFEFEFE4FEFEFEFED4FEFEFEFEFEFEFEFED4FED4FEFEEFEJ'9'8"9%J&9%?&9#J'
+?FEFED9D9FEFEFED9FEFED9D9D9FED9FEFE;FED4D4D4FEFED4D4FEFED4D4D4FEFED4FD9D9D9D9D9D9J$C"A"?#I"="B"="Js
+8FED9FED9D9D9D9D4D4D4D4FD8J"9"J$H$@#JT
+7D9D9O*FEFEFEFEFEFEFED4?J"J"<%G%=#Jr#
+9FEO$FEFED4D4D4FED4D4D4D4FEBFED9D8J$J"B#J"J"
+8D9FED96FEFEFEDFEO$D9'J'?%J&8'>%9'<$J"D&
+F7F7F7F7F7F79D9FEFEFEFED9D9FEFED9:D4FEFEFED4D4FEFEFED4FED4FEFED4D4FEFEFED4FED4FED4FD9F7F7F7F7F7'E#8"8#8%8#8#9&8#<#C$:r9"9%9rJ"I'
+F6F6F6F6F6F6D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D4D4D4D4D4D4D4D4D4D4HD9F6F6F6F6F6F68%J#J"F&
+F9F9F9F9P2FED4FD9F9F9F9F9F7J#J"
+P7FED4DD9J"J"
+P7D4GD9JZ>"
+O<O:D9J"Js
+O;FFO?D8Jz8u
+O:O>D9D9
+
+
+
+
+
+
+
+
+
+=z"z"z
+0F6F7PFF6F71F6<z8z8z
+1F9PEF91F9
+
+
+7z8z8z
+6F7PEF75F7"J"J"
+F77F7PFF7
+ENDBITMAP
+%%EndBinary
+81 215 288 494 R
+7 X
+V
+4 8 Q
+0 X
+(set months {January February March April \134) 81 488.67 T
+-0.25 ( May June July August September \134) 81 478.67 P
+( October November December}) 81 468.67 T
+(proc blockInput {} {return 0}) 81 448.67 T
+(proc spinMonth {direction} {) 81 428.67 T
+( global months) 81 418.67 T
+( set index \134) 81 408.67 T
+( [expr [lsearch $months [.sm get]] + \134) 81 398.67 T
+( $direction]) 81 388.67 T
+( if {$index < 0} {set index 11}) 81 368.67 T
+( if {$index > 11} {set index 0}) 81 358.67 T
+( .sm delete 0 end) 81 338.67 T
+( .sm insert 0 [lindex $months $index]) 81 328.67 T
+(}) 81 318.67 T
+(spinner .sm \134) 81 298.67 T
+( -labeltext \322Month : \322 \134) 81 288.67 T
+( -width 10 -f) 81 278.67 T
+(ixed 10 \134) 157.8 278.67 T
+( -validate blockInput \134) 81 268.67 T
+( -decrement {spinMonth -1} \134) 81 258.67 T
+( -increment {spinMonth 1}) 81 248.67 T
+(.sm insert 0 January) 81 238.67 T
+(pack .sm -padx 10 -pady 10) 81 228.67 T
+0 10 Q
+(FIGURE 19) 143.17 181.17 T
+1 F
+( - Spinner) 194.56 181.17 T
+0 0 612 792 C
+0 12 Q
+0 X
+0 0 0 1 0 0 0 K
+(Spinint) 408.82 712 T
+1 10 Q
+(The most common data type for which spinning behav-) 315 693.33 T
+(ior is useful is that of integers. The Spinint class of) 315 681.33 T
+(fers) 518.42 681.33 T
+(this capability by specializing the Spinner class. Addi-) 315 669.33 T
+-0.07 (tional options are provided which allow speci\336cation of) 315 657.33 P
+-0.25 (a step and range values which vary and limit the cycling.) 315 645.33 P
+( The following example creates a water temperature) 315 621.33 T
+-0.54 (integer spinner widget labeled appropriately) 315 609.33 P
+-0.54 (. The widget) 488.84 609.33 P
+(options limit the range of values to between freezing) 315 597.33 T
+(and boiling, speci\336es a step value of two, enables wrap-) 315 585.33 T
+(ping, and orients the buttons in a side by side fashion.) 315 573.33 T
+0 12 Q
+(Spindate) 404.83 394.71 T
+1 10 Q
+(The spindate class creates a set of spinners for use in) 315 370.05 T
+-0.29 (date entry) 315 358.05 P
+-0.29 (. The set includes three spinners con\336gured to) 353.77 358.05 P
+(support day) 315 346.05 T
+(, month and year entry) 361.29 346.05 T
+(. Options allow con-) 450.9 346.05 T
+(trol over the display of each spinner) 315 334.05 T
+(, the format of the) 458.46 334.05 T
+(month, and the orientation.) 315 322.05 T
+315 422.71 540 570 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+315 450.43 540 561 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 4730
+255 73 131.14 37.54 0 363.14 513.86
+/red <
+3EC472FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+FFFFFFFFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBF80808080
+8080808080808080808080808080808080808080404040404040404040404040
+4040404040404040404040000000000000000000000000000000000039C069DD
+00FF0000003333330033CCDD9999112277005544FFCC66AABBFF33EE9999CC7A
+EFD39765E1A36FE700FF5500557FB22EAFB4CD73E6A24DBF99FFFFB07AFFB0CC
+F5008788439D58D750D080C0C080C0808060C000FFA000FF20C0A040C040D0BE
+8BD28BD9B3FF7260F0E010B499FFA00019BF2FFF6223852F465F4770FF0000FF
+> store
+/green <
+57D79F00000000000000000000000000FFFFFFBFBFBFBFBF8080808080404040
+40000000FFFFFFFFFFBFBFBFBF808080808040404040400000000000FFFFFFFF
+FFBFBFBFBFBF8080808040404040400000000000FFFFFFFFFFBFBFBFBFBF8080
+8080804040400000000000FFFFFFBFBFBFBFBF80808040404040400063E0B500
+996699FF00663399BBFF99DD99FF112277005544CCCC66AABB6600EE6600CC69
+E3B59765E1A36FE700FF1A006B7FB28BEEEE0073E6A24DBF99FFFFB094FF30F7
+F500CE884DB358D78080C0C080C080808060C08000A080402070A0402040D0BE
+5BB477D9B3FF77F0F0E010B489E4A0FF19264F00B641DE4F829E4780FF0000FF
+> store
+/blue <
+8CFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBF8040FFBF804000FFBF804000FFBF80
+00BF8040FFBF804000FF804000FFBF804000FFBF804000FFBF804000FFBF8040
+00FFBF804000FFBF4000FFBF804000FFBF804000FFBF804000FFBF804000FFBF
+804000FFBF00FFBF804000BF8040FFBF804000FFBF40FFBF8040004063E0B500
+FF3399FF88666666009966DDFFFF112277DD554499FFCCAABBCC99EE9966CC69
+E3B59765E1A36FE7BFCC8BEE2F7FB257EEB40073E6A24DBF6BFBB3B015326024
+F580FA8856CA58D7D050C080C08080C08060C080FF0000402070C0802040D0BE
+7A8C65D9B3E0856050E010B476C4A00070264F00FC5AE050B4A0FF9000FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+6F6F7R8F6F76F6F7J"
+S7F78z8z8z
+4F9R7F94F9
+
+;z"
+S.F7F6<z"z"z"z
+0F6F7R'F6F70F6F70F6=z8z8z8z
+/F9R&F9/F9/F9
+J'@#A%B"
+P#FEFEFEFEF9FEFEFEFEFEFEFEFEJ'J"8"A"Js"
+P"FEFEF9F9F9FE8F9F9FEP$F6F7J"A#Jr
+P'F9F9F9P@F9J#8(9$8'>'9"8#
+P$FEFEF9FEFEFEF9FEFEFEFEFEFEFEFEF9FEFEFEFEFEF9FEFEFEFEFE@s"J"9%8(:"8%="8%8"8#J$
+F6F7O=F9FEFEF9F9FEF9FEFEFEF9F9F9FEF9FEFEF9FEF9FEFEF9F9F9OAF6F6F7ArJ#9"9$A"C"J"
+F9O?F9F9FEF9F9F9F9F9OLF9@sJ"8#J#
+F7O>FEF9F9P?F7F7@tJ">$J$
+F9O>FEFEF9FEP7F9F9F9J'9(8$8"9$8$8"9"8$
+P#F9FEFEFEFEF9F9FEFEF9F9F9FEFEF9FEFEFEF9FEFEF9FEFEFEF9FEFEJ';#9z9#Js
+P"F9F9F9F9F9F9F9F9;F9F9F9P"F7Jt
+S&F9J"8"
+P)FEFE=z8z8z8z
+/F7R&F7/F7/F7rF"J"F"F%
+F7F7R'F7F7F7F7F7F7'z&
+F6F6F6F6F6F7S-EDF6F6F6F6F68$J%
+F9F9F9S/F9F9F9F7
+
+
+
+
+
+
+
+
+
+J5=4;4
+Q&IC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FFEDFFEDFFEDFFEDFFEDFFEDFFEDFFEDFFEDFFFFEDFFEDFFEDFFEDFFEDFFEDFFEDFFEDFFEDFFJ5<"r#u:"z$
+Q&IFEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FEC0FFFFEDFEFEEDFF0FEEDEDEDJ#z#<"<"A":"H"
+Q&C0FEEC0FFC0EDFEFEEDFEJ#J#<"?">":"E"8"
+Q&FEC0EC0FFFFFEEDFFEDEDJ#J#<";"B":#G"
+Q&C0FEEFFC0EDFEFEEDEDFEI#8#8#>#HsJ#J#9$:$J#<"@"=":"D"9"
+FEFEFEFEFEFEFEFEFEMFEFE@FEC0FEFEFEFEFEFE8C0FFFFFEEDFFEDEDJ$8$J#8&8&J#<":"C":$F"
+O+EDEDEDEDEDEDOAC0FEFEC0C0C0FEFEC0C0C0FE7FFC0EDFEFEEDEDEDFEJ%8"8"8%8&C%8*8&9%8+8"8%8.9#>#8"<"J#<"A"<":"C":"
+>FEFEFEFEFEFEFEFEFEFEFEFEEDFEFEFEFEFEFEFEEDFEFEFEEDFEFEFEFEFEEDFEFEFEFEFEFEFEFEEDFEFEEDFEFEFEFEFEFEEDFEFEFEFEEDFEFEEDFEFEEDFEFEFEFEFEFEFEC0C0C0;C0FFFFFEEDFFEDEDI">*8)9"D'8*9,9"8)8"@"8'B#:$;#J#<"9"D":"8"E"
+EDEDFEFEEDEDFEFEEDEDEDEDFEFEEDEDFEFEFEFEFEEDEDFEFEFEEDEDFEFEEDEDFEFEFEEDFEFEEDFEFEEDEDFEFEFEFEFEEDEDFEFEEDEDEDFEFEFEEDEDFEFEC0FEFEFEC0FEC07FFC0EDFEFEEDEDFEJ":"8#J#J"D%J#>#>#:$:#J#<"B";":"B";"
+5FEFEEDED4EDED@EDEDEDEDED4EDEDEDEDFEC0C0C0FEFEC08C0FFFFFEEDFFEDEDJ$@#;"F#J#;"9$G":#D#@#J#<"8"E":"9"D"
+>FEFEFEFEFEEDFEFE7FEFEEDFEFEFEEDFEFEC0FEFEC09FFC0EDFEFEEDEDFEJ.@%J%J%<%J%B#8"<#J#<"C":":"A"<"
+4EDFEFEEDEDFEFEEDEDFEFEEDEDEDEDEDED4EDEDEDED5EDEDEDEDFEFEEDED6EDEDEDEDFEC0FEFEC0:C0FFFFFEEDFFEDEDJ":#J#D">#G"9"B#8#>#J#<$F":":"C"
+HFEFEFE6FEFEFEFEFEFEFEFEFEFEFEC0FEEFFC0EDEDFEFEEDEDFEJ3H'D,<1>'B#8&9%J#<"D"9":"@"="
+=EDFEFEFEEDFEFEEDEDFEFEEDEDFEFEFEFEEDEDFEFEFEFEEDEDFEFEEDEDEDFEFEFEFEEDEDFEFEFEEDFEFEEDEDFEFEEDEDFEFEEDEDFEFEFEFEEDFEC0C0FEFEFEC0FEFEFEFE7C0FFFFFEEDFFEDED&F#8#9'8#8%8#@#:%8#8#8#:#9%8#:'8#8s:%9#>#9$9&J#<#G":";"B"D%
+F7F7F7F7F7EDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDC0FEC0C0C0C0C0C0C0C07FFC0EDFEFEEDEDFEF7F7F7F7&J#J#<"E"8":"?">"D&
+F6F6F6F6F6Q!FEC0EC0FFFFFEEDFFEDEDF6F6F6F6F68$J#J#<"H":"<"A"E%
+F9F9F9Q!C0FEEFFC0EDFEEDEDFEF9F9F9F7J#J#J#<"F$:">"?"
+OEEDEDO-FEC0EC0FFFFFEEDEDFFEDEDJ5<z":"="@"
+Q&IC0FEC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC03EDFEEDEDFEJ5<5:5
+Q&IFEC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FFC0FF4FFEDFEEDFEEDFEEDFEEDFEEDFEEDFEEDFEEDFEED4FFEDFEEDFEEDFEEDFEEDFEEDFEEDFEEDFEEDFEEDJz<z;z
+Q&IED3ED3ED
+
+
+
+
+
+
+
+
+
+
+<z"z"z
+0F6F7R8F6F71F6;z8z8z
+1F9R7F91F9
+
+7z8z8z
+5F7R7F74F7"J"J"
+F76F7R8F7
+ENDBITMAP
+%%EndBinary
+324.71 455.86 531.71 509.86 R
+7 X
+V
+4 8 Q
+0 X
+(spinint .temp -labelpos w \134) 324.71 504.52 T
+( -labeltext \322Water Temperature:\323 \134) 324.71 494.52 T
+( -f) 324.71 484.52 T
+(ixed 5 -width 5 -range {32 212} \134) 353.51 484.52 T
+( -step 2 -wrap yes -orient horizontal) 324.71 474.52 T
+(pack .temp -padx 10 -pady 10) 324.71 464.52 T
+0 10 Q
+(FIGURE 20) 386.68 437.46 T
+1 F
+( - Spinint) 438.07 437.46 T
+0 0 612 792 C
+315 72 540 720 C
+315.14 153.14 540 318.71 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+315.72 187.85 538.57 309.71 R
+0.5 H
+2 Z
+0 X
+0 0 0 1 0 0 0 K
+N
+349 194.57 520 221.57 R
+7 X
+V
+1 10 Q
+0 X
+(spindate .sd -monthformat string) 349 214.91 T
+(pack .sd -padx 10 -pady 10) 349 202.91 T
+%%BeginBinary: 7044
+138 123 70.97 63.26 0 387.14 237.71
+/red <
+C472FFFFFFFFFFFFFFFFFFFFFFFFFF66F5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+FFFFFFFFFFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBF808080
+8080808080808080808080808080808080808080804040404040404040404040
+4040404040404040404040400000000000000000000000002EAFB4CD73E6A2F5
+99FFFFB0B07AFFCC00878858D7439D50D080C0C080C08060C000FFA000FF20C0
+A0C0D060F0E010B499FFBE8B8BD900FFA0000000000039C069DD00FF00000033
+33330033CCDD9999112277005544FFCC66AABBFF33EE9999CC7AEFD3BF804040
+9765E1A36FE700FF55004DB2D272B36419BF2FFF6223852F465F4770FF0000FF
+> store
+/green <
+D79F0000000000000000000000000099DEFFFFFFBFBFBFBFBF80808080804040
+4040000000FFFFFFFFFFBFBFBFBF808080808040404040400000000000FFFFFF
+FFFFBFBFBFBFBF8080808040404040400000000000FFFFFFFFFFBFBFBFBFBF80
+808080804040400000000000FFFFFFBFBFBFBFBF808080408BEEEE0073E6A2F5
+99FFFF30B094FFF700CE8858D74DB38080C0C080C0808060C08000A080402070
+A020D0F0F0E010B489E4BE5B77D9FFFFA0404040400063E0B500996699FF0066
+3399BBFF99DD99FF112277005544CCCC66AABB6600EE6600CC69E3B5BF804040
+9765E1A36FE700FF1A004DB2B477B39519264F00B641DE4F829E4780FF0000FF
+> store
+/blue <
+FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB3BF8040FFBF804000FFBF804000FFBF
+8000BF8040FFBF804000FF804000FFBF804000FFBF804000FFBF804000FFBF80
+4000FFBF804000FFBF4000FFBF804000FFBF804000FFBF804000FFBF804000FF
+BF804000FFBF00FFBF804000BF8040FFBF804000FFBF40FF57EEB40073E6A2F5
+6BFBB360B015322480FA8858D756CAD050C080C08080C060C080FF0000402070
+C020D06050E010B476C4BE7A65D900E0A0BF8040004063E0B500FF3399FF8866
+6666009966DDFFFF112277DD554499FFCCAABBCC99EE9966CC69E3B5BF808040
+9765E1A36FE7BFCC8BEE4DB28C85B3ED70264F00FC5AE050B4A0FF9000FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+6F6F7OMF6F76F6F7J"
+PLF78z8z8z
+4F9OLF94F9
+
+;z"
+PCF7F6<z"z"z"z
+0F6F7O<F6F70F6F70F6=z8z8z8z
+/F9O;F9/F9/F9
+J#E$B"
+O!FEFEFEFEFEFEJ"C"Js"
+O2F9FEHF6F7J#Jr
+O!F9F9O9F9Jr$9$8';#<%9"8#8$
+AFEF9FEFEFEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEFE@s"C'8(:"8%8&<%8"8)G$
+F6F7FEF9F9F9FEF9FEF9FEFEFEF9F9F9FEF9FEFEFEFEFEF9FEF9F9FEFEF9F9F9FEFEFEF9FEFEF6F6F7ArE%9$A"=$;$B"J"
+F9FEFEFEF9F9F9F9F9F9F9F9F9FEFEFE4F9@sD"9"J%A%G#
+F7F9FE@FEFEF9F9F9F9F9F9F7F7@tC%:$I$="A%G$
+F9FEF9F9F9FEF9FEFEF9FEFEFEF9FEFEF9F9F9J%9(8$8"9(8'8"8+
+AFEFEFEF9F9FEFEF9F9F9FEFEF9FEFEFEF9F9F9FEFEF9FEF9F9FEFEF9FEF9FEFEF9F9F9FEFEFEF9J%;#9x9'8'9#9$Js
+@F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9@F7Jt
+P;F9J"8"
+EFEFE=z8z8z8z
+/F7O;F7/F7/F7rF"J"F"F%
+F7F7O<F7F7F7F7F7F7'z&
+F6F6F6F6F6F7PBADF6F6F6F6F68$J%
+F9F9F9PDF9F9F9F7
+
+
+
+
+
+
+
+J2
+P*FFADFFADFFADFFADFFADFFADFFADFFADFFJ4
+P)FFADFFADFFADFFADFFADFFADFFADFFADFFADFEJ5:#z#
+O1B7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFEADFF/ADFEADJ5:#="=#
+O1BFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFFADFEADFEJ#z":#<$<#
+O17FFE?7FFFADFFFEFEFEFEADJ#J#:#;"9";#
+O1FE7F>FF7FFFADFEFEADFEJ#J#:#:";":#
+O17FFE>7FFFADFFFEFEFEADJ#;#F#8#B#<"J#:#9"="9#
+4FEFEFEFEFEFEFEFEFE7FFE7FF7FFFADFEFEADFEJ#J#:#8"?"8#
+O17FFE>7FFFADFFFEFEFEADJ"9":%8&8"8":#?#@$9%@#:#8v8#
+6FEFEFEFEFEFEFEFEADFEFEFEFEFEFEFE7FFEFEFEFE7FFEFEFF7FFFADADADFEJ'9'8"9%>#?&9%?#:4
+>FEFEADADFEFEFEADFEFEADADADFEADFEFE7FFEFE7F7F7FFEFE7F7FFE7FFFADFFADFEADFEADFEADFEADFEADFEADFEADFEADJ$C"A"A#?"="B#:4
+7FEADFEADADFE7F7F7FFF7FFFADFEADFEADFEADFEADFEADFEADFEADFEADFEJ"9"J#@$G#:4
+6ADADD7FFEFEFEFE7FFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADJ"J#8"<%G#:4
+8FEFFE7FFEFE7F7F7FFF7FFFADFFADFFADFFADFFADFFADFFADFFADFFADFEJ$J"D#J#:#z#
+7ADFEAD6FE7FFE>7FFFADFF/ADFEADJ'?%D#8&8'E#:#8v8#
+>ADFEFEFEFEADADFEFEADFE7F7FFEFEFE7F7FFEFEFE7FFEFF7FFFADFEADFEJ#8"8#8%8#8#9&8#>#9$:r9"?#:#8"?"8#
+4ADADADADADADADADADADADADADADADADADADADAD7FFE7F7F7F7F7F7FFFADFFADADFEADJ#J#:#9"="9#
+O1FE7F>FF7FFFADADADADFEJ#J#:#:";":#
+O17FFE>7FFFADFFADADFEADJ#J#:#;"9";#
+O1FE7F>FF7FFFADADADADFEJ5:#<$<#
+O1B7FFE7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFFADFFADFEADFEADJ5:#="=#
+O1BFE7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFFADADADFEJz:4
+O1BADADFFADFEADFEADFEADFEADFEADFEADFEADFEADJ4
+P)FFADFEADFEADFEADFEADFEADFEADFEADFEADFEJz
+P)3ADJ2
+P*FFADFFADFFADFFADFFADFFADFFADFFADFFJ4
+P)FFADFFADFFADFFADFFADFFADFFADFFADFFADFEJ5:#z#
+O1B7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFEADFF/ADFEADJ5:#="=#
+O1BFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFFADFEADFEJ#z":#<$<#
+O17FFE?7FFFADFFFEFEFEFEADJ#J#:#;"9";#
+O1FE7F>FF7FFFADFEFEADFEJ#J#:#:";":#
+O17FFE>7FFFADFFFEFEFEADJ&J#:"J#:#9"="9#
+4FEFEFEFEFEFFE7FFE9FF7FFFADFEFEADFEJ%J#8#J#:#8"?"8#
+6ADADFEFEE7FFEFEFE:7FFFADFFFEFEFEADJ$8%8#9#J#8#J#:#8v8#
+8ADFEFEFEFEFEFEFEFEFEFE5FE7F7F7F:FF7FFFADADADFEJ'J#J#:4
+<FEFEADADFEFE=7FFE>7FFFADFFADFEADFEADFEADFEADFEADFEADFEADFEADJ#;(J#J#:4
+<ADADADFEFEADFEFEAD5FE7F>FF7FFFADFEADFEADFEADFEADFEADFEADFEADFEADFEJ$J#J#:4
+=FEFEFE?7FFE>7FFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADJ%:&J#J#:4
+<FEFEADADADFEFEFEAD6FE7F>FF7FFFADFFADFFADFFADFFADFFADFFADFFADFFADFEJ$J#J#:#z#
+8FEFEADD7FFE>7FFFADFF/ADFEADJ%8(8"J#J#:#8v8#
+6FEFEFEADADFEFEFEADFEFEAD9FE7F>FF7FFFADFEADFEJ&:':"J#:"J#:#8"?"8#
+4ADADADADADADADADADADADAD77FFE7F97FFFADFFADADFEADJ"J#J#:#9"="9#
+EFE9FE7F>FF7FFFADADADADFEJ$J#J#:#:";":#
+DFEFEAD87FFE>7FFFADFFADADFEADJ#J#J#:#;"9";#
+DADAD9FE7F>FF7FFFADADADADFEJ5:#<$<#
+O1B7FFE7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFFADFFADFEADFEADJ5:#="=#
+O1BFE7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFFADADADFEJz:4
+O1BADADFFADFEADFEADFEADFEADFEADFEADFEADFEADJ4
+P)FFADFEADFEADFEADFEADFEADFEADFEADFEADFEJz
+P)3ADJ2
+P*FFADFFADFFADFFADFFADFFADFFADFFADFFJ4
+P)FFADFFADFFADFFADFFADFFADFFADFFADFFADFEJ5:#z#
+O1B7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFEADFF/ADFEADJ5:#="=#
+O1BFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFFADFEADFEJ#z":#<$<#
+O17FFE?7FFFADFFFEFEFEFEADJ#J#:#;"9";#
+O1FE7F>FF7FFFADFEFEADFEJ#J#:#:";":#
+O17FFE>7FFFADFFFEFEFEADI#:#J#9$9&F#:#9"="9#
+FEFEFEFEDFE7FFEFEFEFEFEFEFEFEFF7FFFADFEFEADFEJ#8&9%F#:#8"?"8#
+O17FFEFE7F7F7FFE7F7F7F7F7FFFADFFFEFEFEADI$8)9%8&G#J#:#8v8#
+ADFEFEFEFEADADFEFEFEFEFEFEFEFEFEFEADFEFEFE7F>FF7FFFADADADFEJ.9"I#@$G#:4
+;FEFEADADFEFEADFEFEADADFEFEFE7FFEFEFEFE7FFFADFFADFEADFEADFEADFEADFEADFEADFEADFEADJ'>#>#G#8%9&F#:4
+4ADFEFEFEFEADADADADADFE7F7FFEFEFE7F7F7F7FFEFF7FFFADFEADFEADFEADFEADFEADFEADFEADFEADFEJ"8":#:$;"I#9$J#:4
+5ADADFEFEFEFEFEAD7FFE7F7F7F87FFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADJ*J#?"J#:4
+=ADADADADADFEFEADAD9FE7FFE4FF7FFFADFFADFFADFFADFFADFFADFFADFFADFFADFEJ#J#8"J#:#z#
+?FEFE>7FFEFE;7FFFADFF/ADFEADJ/J#8&8&F#:#8v8#
+;ADFEFEFEFEADADADFEFEFEADFEFE6FE7F7FFEFEFE7F7FFEFEFE7FFF7FFFADFEADFE&G#:%9sJ#9$:$G#:#8"?"8#B%
+F7F7F7F7F7ADADADADADADAD47FFE7F7F7F7F7F7F7FFFADFFADADFEADF7F7F7F7&J#J#:#9"="9#B&
+F6F6F6F6F6O,FE7F>FF7FFFADADADADFEF6F6F6F6F68$J#J#:#:";":#C%
+F9F9F9O,7FFE>7FFFADFFADADFEADF9F9F9F7J#J#:#;"9";#
+O1FE7F>FF7FFFADADADADFEJ5:#<$<#
+O1B7FFE7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFFADFFADFEADFEADJ5:#="=#
+O1BFE7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFFADADADFEJz:4
+O1BADADFFADFEADFEADFEADFEADFEADFEADFEADFEADJ4
+P)FFADFEADFEADFEADFEADFEADFEADFEADFEADFEJz
+P)3AD
+
+
+
+
+
+
+
+
+<z"z"z
+0F6F7OMF6F71F6;z8z8z
+1F9OLF91F9
+
+7z8z8z
+5F7OLF74F7"J"J"
+F76F7OMF7
+ENDBITMAP
+%%EndBinary
+0 F
+(FIGURE 21) 387.86 168.32 T
+1 F
+( - Spindate) 439.25 168.32 T
+315 72 540 720 C
+0 0 612 792 C
+FMENDPAGE
+%%EndPage: "12" 12
+%%Page: "13" 13
+612 792 0 FMBEGINPAGE
+[0 0 0 1 0 0 0]
+[ 0 1 1 0 1 0 0]
+[ 1 0 1 0 0 1 0]
+[ 1 1 0 0 0 0 1]
+[ 1 0 0 0 0 1 1]
+[ 0 1 0 0 1 0 1]
+[ 0 0 1 0 1 1 0]
+ 7 FrameSetSepColors
+FrameNoSep
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 12 Q
+0 X
+0 0 0 1 0 0 0 K
+(Spintime) 161.5 712 T
+1 10 Q
+(The spintime class is simiar to the spindate class sup-) 72 687.33 T
+(porting time entry rather than date. The three spinners) 72 675.33 T
+(are hour) 72 663.33 T
+(, minute, and second.) 104.64 663.33 T
+0 12 Q
+(Scr) 146.6 485 T
+(olledlistbox) 163.72 485 T
+1 10 Q
+(The Scrolledlistbox extends the standard Tk listbox) 72 466.33 T
+-0.51 (widget with prede\336ned vertical and horizontal scrollbars) 72 454.33 P
+-0.08 (and an associated label. The set of options available has) 72 442.33 P
+-0.06 (also been amended to include options which allow spec-) 72 430.33 P
+(i\336cation of the list items. All the usual methods exist,) 72 418.33 T
+-0.41 (plus new ones for sorting the list contents and a short cut) 72 406.33 P
+(version to acquire the current selection.) 72 394.33 T
+72 72 297 720 C
+72 513 297 660 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+72 534 297 651 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+108 543 270 570 R
+7 X
+V
+1 10 Q
+0 X
+(spintime .st) 108 563.33 T
+(pack .st -padx 10 -pady 10) 108 551.33 T
+%%BeginBinary: 6922
+138 123 70.97 63.26 0 145.03 578.74
+/red <
+C472FFFFFFFFFFFFFFFFFFFFFFFFFF66F5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+FFFFFFFFFFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBF808080
+8080808080808080808080808080808080808080804040404040404040404040
+4040404040404040404040400000000000000000000000002EAFB4CD73E6A2F5
+99FFFFB0B07AFFCC00878858D7439D50D080C0C080C08060C000FFA000FF20C0
+A0C0D060F0E010B499FFBE8B8BD900FFA0000000000039C069DD00FF00000033
+33330033CCDD9999112277005544FFCC66AABBFF33EE9999CC7AEFD3BF804040
+9765E1A36FE700FF55004DB2D272B36419BF2FFF6223852F465F4770FF0000FF
+> store
+/green <
+D79F0000000000000000000000000099DEFFFFFFBFBFBFBFBF80808080804040
+4040000000FFFFFFFFFFBFBFBFBF808080808040404040400000000000FFFFFF
+FFFFBFBFBFBFBF8080808040404040400000000000FFFFFFFFFFBFBFBFBFBF80
+808080804040400000000000FFFFFFBFBFBFBFBF808080408BEEEE0073E6A2F5
+99FFFF30B094FFF700CE8858D74DB38080C0C080C0808060C08000A080402070
+A020D0F0F0E010B489E4BE5B77D9FFFFA0404040400063E0B500996699FF0066
+3399BBFF99DD99FF112277005544CCCC66AABB6600EE6600CC69E3B5BF804040
+9765E1A36FE700FF1A004DB2B477B39519264F00B641DE4F829E4780FF0000FF
+> store
+/blue <
+FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB3BF8040FFBF804000FFBF804000FFBF
+8000BF8040FFBF804000FF804000FFBF804000FFBF804000FFBF804000FFBF80
+4000FFBF804000FFBF4000FFBF804000FFBF804000FFBF804000FFBF804000FF
+BF804000FFBF00FFBF804000BF8040FFBF804000FFBF40FF57EEB40073E6A2F5
+6BFBB360B015322480FA8858D756CAD050C080C08080C060C080FF0000402070
+C020D06050E010B476C4BE7A65D900E0A0BF8040004063E0B500FF3399FF8866
+6666009966DDFFFF112277DD554499FFCCAABBCC99EE9966CC69E3B5BF808040
+9765E1A36FE7BFCC8BEE4DB28C85B3ED70264F00FC5AE050B4A0FF9000FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+6F6F7OMF6F76F6F7J"
+PLF78z8z8z
+4F9OLF94F9
+
+;z"
+PCF7F6<z"z"z"z
+0F6F7O<F6F70F6F70F6=z8z8z8z
+/F9O;F9/F9/F9
+J#C"9#
+O FEFEFEFEFEJ"Js"
+O.FEO,F6F7J#G#Jr
+O F9F9F9F9O'F9Jr$9$8'9"8&8'8#;$
+@FEF9FEFEFEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEF9FEFEFEFEFEFEFE@s"B'8(:"8%8"8$:"8)8'G$
+F6F7FEF9F9F9FEF9FEF9FEFEFEF9F9F9FEF9FEFEF9F9F9F9F9FEF9FEFEFEF9FEFEFEFEFEF9FEFEF6F6F7ArD%9$A"H"9">"J"
+F9FEFEFEF9F9F9F9F9F9F9FE4F9@sC"9"J%G#
+F7F9FEO"F9F9F9F9F7F7@tB%:$J%G$
+F9FEF9F9F9FEF9FEJFEF9FEFEF9F9F9J%9(8$8"9"8&8$8"9"9)
+@FEFEFEF9F9FEFEF9F9F9FEFEF9FEFEFEF9FEFEF9FEFEF9FEFEFEFEF9F9F9FEFEFEF9J%;#9x9z9$Js
+?F9F9F9F9F9F9F94F9F9F9F9@F7Jt
+P;F9J"8"
+DFEFE=z8z8z8z
+/F7O;F7/F7/F7rF"J"F"F%
+F7F7O<F7F7F7F7F7F7'z&
+F6F6F6F6F6F7PBADF6F6F6F6F68$J%
+F9F9F9PDF9F9F9F7
+
+
+
+
+
+
+
+J2
+P*FFADFFADFFADFFADFFADFFADFFADFFADFFJ4
+P)FFADFFADFFADFFADFFADFFADFFADFFADFFADFEJ5:#z#
+O8;7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FADFF/ADFEADJ5:#="=#
+O8;FE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFFFFADFEADFEJ#z#:#<$<#
+O87FFE77FFF7FADFFFEFEFEFEADJ#J#:#;"9";#
+O8FE7F77FFFFFADFEFEADFEJ#J#:#:";":#
+O87FFE7FF7FADFFFEFEFEADJ#9#J#:";$@#:#9"="9#
+4FEFEFEFEKFE7FFEFEFEFE7FFFFFADFEFEADFEJ#8#;&?#:#8"?"8#
+O87FFEFEFEFE7F7F7FFEFF7FADFFFEFEFEADJ%8#8)J#8#;"C#:#8v8#
+=FEFEFEFEFEFEFEFEADFEFEADFEFE7FE7F7F7F7F7FFFFFADADADFEJ'@"J#B#?#:4
+<FEFEADADFEFEFE97FFEFE7FFF7FADFFADFEADFEADFEADFEADFEADFEADFEADFEADJ$J#J#A#@#:4
+6FEFEFE4ADAD7FE7FFE7F7FFFFFADFEADFEADFEADFEADFEADFEADFEADFEADFEJ$I"J#@#A#:4
+6ADADADAD97FFEFE7FFF7FADFFADFFADFFADFFADFFADFFADFFADFFADFFADJ#?#B#:4
+O8FE7FFE7F7FFFFFADFFADFFADFFADFFADFFADFFADFFADFFADFEJ"J#J#:#z#
+FFE?7FFE7FF7FADFF/ADFEADJ,J#@%?#:#8v8#
+<ADFEFEFEFEADADADFEFEAD?FE7FFEFEFEFE7FFFFFADFEADFEJ#9#8%9sJ#:":&?#:#8"?"8#
+4ADADADADADADADADAD:7FFE7F7F7F7F7F7FFF7FADFFADADFEADJ#J#:#9"="9#
+O8FE7F77FFFFFADADADADFEJ#J#:#:";":#
+O87FFE7FF7FADFFADADFEADJ#J#:#;"9";#
+O8FE7F77FFFFFADADADADFEJ5:#<$<#
+O8;7FFE7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FADFFADFEADFEADJ5:#="=#
+O8;FE7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFFFFADADADFEJz:4
+O8;ADADFFADFEADFEADFEADFEADFEADFEADFEADFEADJ4
+P)FFADFEADFEADFEADFEADFEADFEADFEADFEADFEJz
+P)3ADJ2
+P*FFADFFADFFADFFADFFADFFADFFADFFADFFJ4
+P)FFADFFADFFADFFADFFADFFADFFADFFADFFADFEJ5:#z#
+O8;7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FADFF/ADFEADJ5:#="=#
+O8;FE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFFFFADFEADFEJ#z#:#<$<#
+O87FFE77FFF7FADFFFEFEFEFEADJ#J#:#;"9";#
+O8FE7F77FFFFFADFEFEADFEJ#J#:#:";":#
+O87FFE7FF7FADFFFEFEFEADJ#;&F#J#9$:$@#:#9"="9#
+4FEFEFEFEADFEFEFEFE4FE7FFEFEFEFEFEFE7FFFFFADFEFEADFEJ#J#8&8&?#:#8"?"8#
+>ADADF7FFEFE7F7F7FFEFE7F7F7FFEFF7FADFFFEFEFEADJ"9"9)8#8%8"8%C#8"J#:#8v8#
+6FEFEFEFEADFEFEADFEFEFEFEFEFEADFEFEFEFEFEFEFE7F7F47FFFFFADADADFEJ%>"8)B#:$F#:4
+CFEADFEFEADADADFEFEADADFEFE7FFEFEFE7FFF7FADFFADFEADFEADFEADFEADFEADFEADFEADFEADJ$?"J#:$F#:4
+7FEADFEADBFE7F7F7FFE7FFFFFADFEADFEADFEADFEADFEADFEADFEADFEADFEJ"9"J#D#J#:4
+6ADAD;FEFE7FFE7FF7FADFFADFFADFFADFFADFFADFFADFFADFFADFFADJ"J%B#8"J#:4
+8FE=ADADADADFE7FFE47FFFFFADFFADFFADFFADFFADFFADFFADFFADFFADFEJ$G"=":#B#J#:#z#
+7ADFEADFEFEFEFE7FFE7FF7FADFF/ADFEADJ%:+B#8&8&?#:#8v8#
+HADFEFEADADFEFEADADFEFEFEFEADFE7F7FFEFEFE7F7FFEFEFE7F7FFFFFADFEADFEJ#8"8s8#8&9#8%C#9$:$@#:#8"?"8#
+4ADADADADADADADADADADADADADADADADAD7FFE7F7F7F7F7F7FFF7FADFFADADFEADJ#J#:#9"="9#
+O8FE7F77FFFFFADADADADFEJ#J#:#:";":#
+O87FFE7FF7FADFFADADFEADJ#J#:#;"9";#
+O8FE7F77FFFFFADADADADFEJ5:#<$<#
+O8;7FFE7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FADFFADFEADFEADJ5:#="=#
+O8;FE7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFFFFADADADFEJz:4
+O8;ADADFFADFEADFEADFEADFEADFEADFEADFEADFEADJ4
+P)FFADFEADFEADFEADFEADFEADFEADFEADFEADFEJz
+P)3ADJ2
+P*FFADFFADFFADFFADFFADFFADFFADFFADFFJ4
+P)FFADFFADFFADFFADFFADFFADFFADFFADFFADFEJ5:#z#
+O8;7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FADFF/ADFEADJ5:#="=#
+O8;FE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFE7FFFFFADFEADFEJ#z#:#<$<#
+O87FFE77FFF7FADFFFEFEFEFEADJ#J#:#;"9";#
+O8FE7F77FFFFFADFEFEADFEJ#J#:#:";":#
+O87FFE7FF7FADFFFEFEFEADJ&J#>#9$G#:#9"="9#
+5FEFEFEFEFEBFEFEFE7FFEFEFE7FFFFFADFEFEADFEJ(J#8&F#:#8"?"8#
+4FEFEADADADFEFEK7FFEFE7F7F7FFEFF7FADFFFEFEFEADJ%9%9%8&9#A#J#:#8v8#
+=FEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEFEFEFEFE7F77FFFFFADADADFEJ59*@#J#:4
+4<ADFEFEFEADADADADFEFEADADFEFEADFEFEADADFEFEADFEFEADADFEFEFEADFEFEADFEFEADFE7FFE7FF7FADFFADFEADFEADFEADFEADFEADFEADFEADFEADJ&C#@"="@#J#:4
+5ADADFEFEFEADADADADFE7F77FFFFFADFEADFEADFEADFEADFEADFEADFEADFEADFEJ"8"9#J#J#:4
+7ADFEFEFEF7FFE7FF7FADFFADFFADFFADFFADFFADFFADFFADFFADFFADJ#8";%J#J#:4
+4FEFEADADADADADDFE7F77FFFFFADFFADFFADFFADFFADFFADFFADFFADFFADFEJ#;#H"@#J#:#z#
+@FEFEFEFEFE7FFE7FF7FADFF/ADFEADJ5>%@#8&F#:#8v8#
+4<ADFEFEFEFEFEADADADFEFEFEFEADADADFEFEFEFEADADADFEFEFEFEADADFEFEADFE7F7FFEFEFE7F7FFFFFADFEADFE&F&9%9%9%8#8#8&>#9$G#:#8"?"8#B%
+F7F7F7F7F7ADADADADADADADADADADADADADADADADADADADADADADADADADAD7FFE7F7F7FFF7FADFFADADFEADF7F7F7F7&J#J#:#9"="9#B&
+F6F6F6F6F6O3FE7F77FFFFFADADADADFEF6F6F6F6F68$J#J#:#:";":#C%
+F9F9F9O37FFE7FF7FADFFADADFEADF9F9F9F7J#J#:#;"9";#
+O8FE7F77FFFFFADADADADFEJ5:#<$<#
+O8;7FFE7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FADFFADFEADFEADJ5:#="=#
+O8;FE7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFF7FFFFFADADADFEJz:4
+O8;ADADFFADFEADFEADFEADFEADFEADFEADFEADFEADJ4
+P)FFADFEADFEADFEADFEADFEADFEADFEADFEADFEJz
+P)3AD
+
+
+
+
+
+
+
+
+<z"z"z
+0F6F7OMF6F71F6;z8z8z
+1F9OLF91F9
+
+7z8z8z
+5F7OLF74F7"J"J"
+F76F7OMF7
+ENDBITMAP
+%%EndBinary
+0 F
+(FIGURE 22) 138.16 518.18 T
+1 F
+( - Spintime) 189.55 518.18 T
+72 72 297 720 C
+0 0 612 792 C
+72 137.14 297 391 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+71.29 159.14 296.29 381.71 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 7528
+158 221 81.26 113.66 0 149.43 262.63
+/red <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000096FB7DFFCF8AFFE79AFF2CAEB6CF71E7
+A24DF70055BE928AB2D3FF0055F7DB7DB2002CFF6120822C455D4571FF0000FF
+> store
+/green <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000096FB6DFFB67DFFCF8AE78AEFEF0071E7
+A24DF70055BE827530B6FFFF69DFDB7DB2004D00B641DF4D829E4582FF0000FF
+> store
+/blue <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000009AFF5DDF9E69FBB275C755EFB60071E7
+A24DF77D55BE9265618EE3002CB2DB7DB28A4D00FF59E351B6A2FF9200FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+7F6F7P1F6F77F6F7J"
+Q2F78z8z8z
+5F9P0F95F9
+
+
+<z"
+Q'F7F6=z"z"z"z
+0F6F7P F6F70F6F70F6>z8z8z8z
+/F9OMF9/F9/F9
+J#>$
+O5FEFEFEFEFEJ"Js"
+O?F9O.F6F7J#Jr
+O5F9F9O8F9J09%;#
+O(FEFEFEF9FEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEAs"J"9"8':%;%J$
+F6F7BF9F9F9F9F9FEF9F9FEF9F9F9FEF9FEFEHF6F6F7BrJ$9%=%:"J"
+F9DF9FEFEFEF9FEF9FEFEFEF9F9LF9AsJ"9"J#
+F7O&F9FEO"F7F7AtJ)=%J$
+F9DF9FEFEF9F9FEFEF9FEF9F9F9O#F9F9F9J"8"8'8"9"
+O4FEFEFEFEFEF9F9FEFEFEJ#8#9t8sJs
+O+F9F9F9F9F9F9O'F7Jt
+Q F9
+>z8z8z8z
+/F7OMF7/F7/F7sF"J"F"F&
+F7F7P F7F7F7F7F7F7F7(z'
+F6F6F6F6F6F6F7Q&D9F6F6F6F6F6F68%J&
+F9F9F9F9Q(F9F9F9F9F7
+
+
+
+
+
+
+
+
+
+
+
+
+J#
+OJFEFE
+J#8#8#8%9%9#;%
+O-FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEJ39'
+O8FEFED9D9FEFED9FEFED9D9FEFED9FEFED9FEFEFED9D9FEFEJ$:$H";%
+O-D9FEFEFEFED9D9FED9D9D9J#;#@&
+O:FEFEFEFED9D9FEFEFEJ%9%@"8"
+O:D9D9D9D9D9D9D9D9D9FEJ)<#;#:"9%
+O.D9FEFED9D9FEFED9FEFEFEFEFEFEFED9D9J39'
+O8D9FEFEFEFED9D9D9FEFEFEFED9D9D9FEFED9D9FEFEFEFED9J#8#:%9%9&8%
+O/D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9
+
+
+
+
+
+Gz
+P&D1
+Iz=z
+P"D03D8J"J"
+P4FF9FFJz"@r"r"
+5OLD6FFD7D8D7FFJzG"
+6OKD7FFJ#J"
+JFEFEOHD8J$F"J"
+7FEFEFED7OFFFJ&J$
+6FED7D7D7FEP*D9D8D8J&8%:$:,8%:$:$J$
+=FED7FEFEFEFEFEFEFEFEFEFEFEFEFED7FED7FED7FEFEFEFEFEFEFEFEFEFEFEFEFELFFFFD9J"8&8&9%8-8&8&8&J$
+:D7D7FED7D7D7D7D7D7D7FED7D7D7FEFED7D7D7FED7D7D7FED7D7D7D7D7D7D7FEFED7D7D7FEFED7D7D7FEO!D9D8D8J$J$9&8&J$
+EFEFEFE9FEFEFED7FEFEFED7D7FEFEFED7JFFFFD9J"?%J%:%9%J$
+:FEFED7D7D78FED7D7D7D7D7D7FED7D7D7FEO"D9D8D8J"<"J$
+O9FEFEMFFFFD9J&8%9-8%9%9-8&J$
+6D7FEFEFED7FEFEFEFED7FEFEFED7FEFED7FEFEFED7D7FEFEFEFEFEFEFED7FEFEFED7FED7D7FEFEFED7D7FEFEFED7O#D9D8D8J$9%:u:$9%:&8$:$J$
+7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7IFFFFD9J$
+PID9D8D8J%J#u
+O%FEFEFED7O5FFFFD8J$J"B"
+O%D7D7D7O7D8D8Jz
+P>/D7JZ
+P>/J"
+PLD8J$:$<"Jv"
+EFEFEFEFEFEFEFEO8D9D8J&@#;#="
+6FEFEFEFEFED7D7D7D7D7J'
+6D7FED7D7D7FEJ%G$;$:,8%:$:$
+>FEFEFEFEFEFEFEFEFEFEFEFEFED7FED7FED7FEFEFEFEFEFEFEFEFEFEFEFEFEJ&F#;&8-8&8&8&
+>D7D7D7D7FED7D7FED7D7D7FEFED7D7D7FED7D7D7FED7D7D7D7D7D7D7FEFED7D7D7FEFED7D7D7FEJ$J&G$9&8&
+?FEFEFE8D7FEFEFED7FEFEFED7FEFEFED7D7FEFEFED7J%J%F%:%9%
+>FED7D7D79D7D7D7FEFED7D7D7D7D7D7FED7D7D7FEJ"J"<"
+O,FE;FEFEJ'858&8%9%9-8&
+6FEFEFEFEFED7:D7FEFEFED7FED7FEFEFEFEFEFED7FEFEFEFEFEFED7FEFEFEFEFED7FEFEFED7D7FEFEFEFEFEFEFED7FEFEFED7FED7D7FEFEFED7D7FEFEFED7J&:z9$:$9%:&8$:$
+6D7D7D7D7D79D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7
+J%
+O4FEFEFED7J$
+O4D7D7D7Jz
+6OKD5Jz
+5OLD1
+J#>"@#J#
+<FEFEFEFEFE>FEFEJ$8"?"@"J"
+7FEFEFED1D1D1?D1J&
+6FED1D1D1FEJ#9$;$<+8$:$:$
+?FEFEFEFEFEFEFEFEFEFED1FEFEFED1FEFEFEFEFEFEFEFEFEFEFEFEJ"9%8#;&:28&8%
+:D1FED1D1FED1D1FED1D1D1FEFED1D1D1D1FED1D1D1FED1D1FED1D1D1FEFED1D1D1FEFED1D1D1J"F"9#<";$:$
+>D1D1FED1FEFEFEFEFEFEFEJ"J#B%9%
+:FE8D1FED1D1D1D1D1D1D1D1J":#9&<"<"
+O!FED1FED1FED1FED1FEFEJ48(9$>&8&8'
+6D1FEFEFED1D1FEFEFED1FEFEFED1FEFEFEFEFED1FEFEFED1D1FED1FEFED1FEFEFED1D1FEFEFED1D1FEFEFED1FEJ$8x9$8#9#8$:$:$:&
+7D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1
+
+
+
+Jz
+5OLD6Jz
+6OKD7J#
+CFEFEJ%>"
+7FEFEFEFED7J%
+7D7D7FED7J$;#8&:$:$8&:,8%:$:$
+>FEFEFEFEFEFED7FEFEFEFEFEFEFEFEFEFED7FEFEFEFEFEFED7FED7FED7FEFEFEFEFEFEFEFEFEFEFEFEFEJ&9,8&8-8-8&8&8&
+=FED7D7D7FEFED7D7FED7D7FEFED7D7FEFED7D7D7FEFED7D7D7FED7D7FEFED7D7FEFED7D7D7FED7D7D7FED7D7D7D7D7D7D7FEFED7D7D7FEFED7D7D7FEJ"<";&@"J$9&8&
+ED7D7D7FEFEFED7D74FEFEFED7FEFEFED7D7FEFEFED7J"J%J%:%9%
+6FE<D7D7D7FE>FED7D7D7D7D7D7FED7D7D7FEJ"J"<"
+O$FEIFEFEJ%919(8*9'9%9-8&
+6D7FEFED7D7FEFEFED7D7FEFEFED7FEFEFEFEFEFEFED7D7FEFEFED7D7FEFEFED7D7FEFEFEFED7D7FEFEFEFEFEFEFED7FEFEFED7FED7D7FEFEFED7D7FEFEFED7J#;$8u8#8$:$8$8#8$9%:&8$:$
+7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7D7
+J%
+O:FEFEFED7J$
+O:D7D7D7Jz
+6OKD5Jz
+5OLD1
+J"
+OCFEJ&H"J"
+6FEFEFEFEFEFECD1J'
+6D1FED1D1FEFEJ"8#8)9)8#8&9$8,9&:$
+:D1FEFEFEFED1FED1FEFEFEFEFEFEFEFED1FEFEFEFEFED1FEFEFEFEFEFEFEFEFED1FEFEFED1FEFEFEFED1FEFEFEFEFEFEJ"8"9"8'8(9"9&81:'8&
+:FED1D1D1FEFED1D1FED1FED1D1D1D1D1D1D1FED1D1D1FED1D1D1FED1D1FED1D1D1FED1D1D1D1D1FEFED1D1FEFED1D1D1FEJ%@"J$H"<$
+8FEFEFED1D1;FEFEFED1FEFEFEJ$J%8&G%
+8D1D1D1GD1D1D1D1D1FED1FED1D1D1D1D1J"I":"J"
+O#FEFEFE6FEJ%:*9"829&9$9*9(
+6FEFEFEFED1FEFEFED1FEFEFEFEFED1FEFEFED1D1D1FEFEFED1FED1FEFEFEFED1FEFEFED1D1FED1FEFEFEFEFED1FEFEFEFED1D1FEFEFED1J%;s8#9$9u:$;":t8#8$
+6D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1
+Jv
+P@D8J"
+P?D8Jz
+P>/D7
+
+J&
+O FEFED1FEFEJ%I"8"
+7FEFEFEFED1D1J%
+6FED1D1D1J"8%8&:$:$8#8#8&
+:D1FEFEFEFEFED1FEFEFEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEJ#:-8%:'9"9&
+7FEFED1D1D1D1FED1D1FEFED1D1FEFED1D1D1D1D1D1FED1D1D1D1FED1D1D1J&9$:"
+6D1D1FEFEFEFEFEFED1J#9%
+8D1D1FED1D1D1J"
+6FEJ%8*9/8,
+7FEFEFED1D1FEFEFED1FEFEFEFEFED1D1FEFEFED1FEFED1FEFEFED1D1FEFEFED1FED1FEFEFEFEJ%:s8#8u:u
+6D1D1D1D1D1D1D1D1D1
+
+
+
+
+
+JZ
+P>/J$J"C"
+7FEFEFEP$D7D8J&Jt$
+6FED1D1D1FEP&D9D8D8D7J$:$:$:$:,8%:$:$J$
+>FEFEFEFEFEFEFEFEFEFEFEFEFEFEFED1FED1FED1FEFEFEFEFEFEFEFEFEFEFEFEFEBD7FFFFJ"8&8&8&8&8-8&8&8&J$
+:D1FED1D1D1FEFED1D1D1FEFED1D1D1FEFED1D1D1FEFED1D1D1FED1D1D1FED1D1D1D1D1D1D1FEFED1D1D1FEFED1D1D1FEKD8D8D7J#F&9$H$9&8&J$
+9FEFED1FEFEFED1FEFEFEFEFEFED1FEFEFED1D1FEFEFED1BD7FFFFJ"H%9%F%:%9%J$
+9D1D1D1D1FED1D1D1D1FED1D1D1D1D1D1FED1D1D1FEJD8D8D7J"@"J"<"J$
+KFEFE7FEFEGD7FFFFJ&8&8&8&8&8%9%9-8&J$
+6D1FEFEFED1D1FEFEFED1D1FEFEFED1D1FEFEFED1D1FEFEFED1D1FEFEFEFEFEFEFED1FEFEFED1FED1D1FEFEFED1D1FEFEFED1ID8D8D7J$:$:$:$:$:$9%:&8$:$J$
+7D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1ED7FFFFJ$
+PFD8D8D7J%J$
+O,FEFEFED1O3D7FFD8J$J"
+O,D1D1D1O8D7J"
+PDD7J"
+PFD7JZAZ
+5OL/J"J"
+4FFP(FFIz=z
+P"D13D9
+Gz
+P&D9
+
+
+
+
+
+Iz
+P"D8J"
+P4FFJy#Z&x"
+5D7FFD7O*D7D7D7FFFFD7FFJ$J";#
+AFFFFD8O*D8FFFFJ%:z">#
+?FFFFFFD8O&D9D8FFFFJ#8"J#8#
+=FFFFD9O2D9D9FFFFJ#8#J#8#
+;FFFFD9D9O5D9D9FFFFJ#8#J#8#
+9FFFFD9D9O9D9D9FFFFJ#8#J#8#
+7FFFFD9D9O=D9D9FFFFJ'J&
+5D8D8D8D8D9D9OAD9D8D8D8D8J#8#J"9"
+5D7D7D8D8OAD8D7J#8#J#8#
+7D7D7D8D8O=D8D8D7D7J#8#J#8#
+9D7D7D8D8O9D8D8D7D7'J#8#J#8#J&
+F7F7F7F7F7F75D7D7D8D8O5D8D8D7D7MF7F7F7F7F7'J#8"J#8#J'
+F6F6F6F6F6F67D7D7D8O2D8D8D7D7O!F6F6F6F6F6F68%J#<z?#J&
+F9F9F9F99D7D7O&D8D7D7O$F9F9F9F9F7J#9"J$
+AD7D7D8O,D8D7D7JZ
+5OLJ"
+4FFIz
+P"D9
+
+
+
+
+
+
+
+
+
+
+=z"z"z
+0F6F7P1F6F71F6<z8z8z
+1F9P0F91F9
+
+
+7z8z8z
+6F7P0F75F7"J"J"
+F77F7P1F7
+ENDBITMAP
+%%EndBinary
+80.29 166 287.29 256 R
+7 X
+V
+4 8 Q
+0 X
+(scrolledlistbox .slb -vscrollmode static \134) 80.29 250.67 T
+( -hscrollmode dynamic -selection SelProc \134) 80.29 240.67 T
+( -items {Crabgrass Dallisgrass Nutsedge} \134) 80.29 230.67 T
+( -scrollmargin 5 -labelpos n\134) 80.29 220.67 T
+( -labeltext \322Weeds\323) 80.29 210.67 T
+(pack .slb -padx 10 -pady 10) 80.29 200.67 T
+(.slb insert 2 Sandbur Goosegrass) 80.29 180.67 T
+(.slb insert end Chickweed Johnsongrass) 80.29 170.67 T
+0 10 Q
+(FIGURE 23) 128.5 146.89 T
+1 F
+( - Scrolledlistbox) 179.89 146.89 T
+0 0 612 792 C
+0 12 Q
+0 X
+0 0 0 1 0 0 0 K
+(Scr) 396.95 712 T
+(olledtext) 414.06 712 T
+1 10 Q
+-0.28 (The Scrolledtext widget provides all the functionality of) 315 693.33 P
+(the standard Tk text widget along with scrollbar and) 315 681.33 T
+(label control. The set of methods has been extended to) 315 669.33 T
+(include import and export \336le capabilities.) 315 657.33 T
+0 12 Q
+(Scr) 391.28 395 T
+(olledframe) 408.4 395 T
+1 10 Q
+(The Scrolledframe combines the functionality of scroll-) 315 376.33 T
+(ing with that of a typical frame widget to implement a) 315 364.33 T
+-0.13 (clipable viewing area whose visible region may be mod-) 315 352.33 P
+-0.49 (i\336ed with the scrollbars. This enables the construction of) 315 340.33 P
+(visually lar) 315 328.33 T
+(ger areas than which could normally be dis-) 359.54 328.33 T
+-0.34 (played, containing a heterogenous mix of widgets. Once) 315 316.33 P
+-0.49 (created, the Scrolledframe child site can be accessed and) 315 304.33 P
+(\336lled with widgets.) 315 292.33 T
+0 12 Q
+(Scr) 389.27 261 T
+(olledcanvas) 406.39 261 T
+1 10 Q
+(The Scrolledcanvas applies scrollbars and display) 315 242.33 T
+-0.25 (options to a standard Tk canvas widget. All the standard) 315 230.33 P
+-0.17 (canvas commands and options have been maintained. A) 315 218.33 P
+-0.46 (new option, autoresize, has been added which allows the) 315 206.33 P
+(user to engage automatic resizing of the scroll region to) 315 194.33 T
+(be the bounding box covering all the items. The region) 315 182.33 T
+(is adjusted continuously as items are created and) 315 170.33 T
+(destroyed via the canvas commands, ef) 315 158.33 T
+(fecting the dis-) 471.45 158.33 T
+(play of the scrollbars.) 315 146.33 T
+315 423 540 654 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+315 447 540 636 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 17963
+503 189 201.2 75.6 0 324 546
+/red <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000096FB7DFFCF8AFFE79AFF2CAEB6CF71E7
+A24DF70055BE928AB2D3FF0055F7DB7DB2002CFF6120822C455D4571FF0000FF
+> store
+/green <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000096FB6DFFB67DFFCF8AE78AEFEF0071E7
+A24DF70055BE827530B6FFFF69DFDB7DB2004D00B641DF4D829E4582FF0000FF
+> store
+/blue <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000009AFF5DDF9E69FBB275C755EFB60071E7
+A24DF77D55BE9265618EE3002CB2DB7DB28A4D00FF59E351B6A2FF9200FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+7F6F7WHF6F77F6F7J"
+XIF78z8z8z
+5F9WGF95F9
+
+
+<z"
+X>F7F6=z"z"z"z
+0F6F7W7F6F70F6F70F6>z8z8z8z
+/F9W6F9/F9/F9
+JrJ$<s8#8$
+R,FEO%FEFEFEFEFEFEFEFEFEJ"8&J">"8$>"Js"
+R,F9F9F9F9FEFEO$F9F9F9F9F9F9R5F6F7J"9#Jr
+SGF9F9F9R9F9J%:%8r*8$9'8#D"9$?$
+R6FEFEFEFEFEFEFEFEFEF9FEFEFEFEF9FEFEFEFEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEAs"J$9%8%8'9"8/8"8&A#8$?'J$
+F6F7QKFEFEF9F9F9FEFEFEF9F9F9FEF9F9F9FEF9F9F9F9F9FEF9FEFEFEF9FEFEFEF9F9FEFEFEFEF9FEFEFEF9F9F9FEFEFEF9FEFEQKF6F6F7BrJ%9$;%8)9%9$<$8$A#G"J"
+F9QJFEFEFEF9F9FEFEFEFEFEF9FEFEFEF9F9F9FEFEFEF9FEF9F9F9F9F9F9F9F9F9F9F9F9FER F9AsJ$9%:"9$9"J"E%J#
+F7QJF9F9F9FEFEF9F9F9FEF9F9FELF9F9F9F9F9QKF7F7AtJ":%8%9):$A$J%J$
+F9R$FEFEF9F9F9FEF9F9F9F9FEFEF9F9FEFEF9FEF9FEFEF9FE=FEF9FEFEQKF9F9F9J"8";%8"8%8%B*8"8&8";"8";"8$8)
+R,FEFEF9FEFEF9FEFEFEFEF9FEFEFEF9F9F9FEFEFEF9F9F9FEFEF9F9FEFEF9FEFEFEFEFEF9FEFEF9F9F9FEFEFEF9J%<v8%:#8#;$9%:';%;t9$Js
+R,F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9R,F7Jt
+X7F9
+>z8z8z8z
+/F7W6F7/F7/F7sF"J"F"F&
+F7F7W7F7F7F7F7F7F7F7(z'
+F6F6F6F6F6F6F7X=D9F6F6F6F6F6F68%J&
+F9F9F9F9X?F9F9F9F9F7
+
+
+
+
+
+
+
+
+
+
+
+
+J#>#A#J#
+RAFEFEFEFEFEFEKFEFE
+J'8"8"8%;'9%9%9%8#8#8#8#
+RBD9D9FEFEFEFEFEFEFEFEFEFED9FEFED9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEJ"8)8)8":5B%
+R@FEFEFED9D9FEFED9D9D9D9FEFED9D9FEFEFE9FED9FEFED9FEFED9D9FEFED9FEFED9D9FEFED9FEFED9D9FEFEFEFED9FEJ#=":#=%9):$:"
+S%D9D9D9D9D9FED9D9D9FED9D9D9D9D9FEFEFEFED9D9J"9#G"?$9&8&
+RAD9FEFED9FEFEFED9D9FEFEFED9D9FEFEFEJ%J%;"8"9"8"
+RED9D9D9D98FEFED9D9D9FED9FEJ"=#;":%;"A%9%:);"
+R?FEFEFEFEFEFED9FEFEFEFED9D9FEFED9D9D9FEFED9D9FEFED9FEJ'8+=5B%
+RCD9FEFEFEFED9D9FEFED9D9FEFEFEFED99D9FEFED9D9D9FEFEFED9FEFED9FEFEFEFED9D9D9FEFEFEFED9D9FEFED9J#9%:#8%8#;#9v9%:#8#:&
+R?D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9
+
+J#
+S,D9D9
+
+
+Gz
+W=D1
+Iz=z
+W9D03D8J"J"
+WKFF9FFJz"@r"r"
+5W5D1FFD7D8D7FFJ"
+X-FFJ$J":&A"J#:"J$J"9$J":#J"E$:$J"
+9FEFEFEGFEFEFEFEFEFEFEP4FEFEFEO3FEFEFE@FEFEFEFE<FEFEFE5FEFEFEFEFEFEFEO@D8J%9"J"A#<$@#B$J(wC";"J"J$J#8%9"J#:"J#E#;#J"
+8FED1D1D1FE5FEFEFED1D1D1FEFEFEFEFEO4FEFEFEFEFEFED1FED1D1:FEEFED1D1@FED1FED1D1D1FE7FED1D15FED1D1D1D1D1O>FFJ#;"8#?#B#J&9-J$
+O3D1D1D1FED1D1D1D1D1O5D1FED1D1D1D1D1FED1D1FED1FED1D1FEFET)D9D8D8J&8,@&J$8&:$8&8-:$8#8#9$B"D"A$9$:&9$:$9&9$9.A#:#:$8&:$<#8&8,C#9$:$8(:)8#8#J$
+7FEFEFEFEFEFEFEFEFEFED1FED1FEFEFEFEFEFEFEFEMFED1FEFED1FEFEFEFEFEFEFED1FEFEFEFEFEFED1FEFEFEFEFEFED1FEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFED1FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFED1FEFEFED1FEFEFED1FEFEFEFED1FEFEFEFEFEFEFEFED1FEFEFEFEFED1FEFEFEFEFEFEFEFEFEFED1FED1FEFEFEFED1FEFEFEFEFEFEFEFEFED1FEFEFEFED1D1FED1FEFEFEFEFEFEFEOHFFFFD9J&8-:":&:"J"C"@'858(9"9&@"8$;":"@%9#;&8&8&8&8&8.9"B%8-8&?&8-:"A%9.=)9"J$
+7D1FED1D1D1D1FED1D1D1D1D1FED1D1D1FEFED1D1FED1D1FE4FEFED1FEFED1D1FE:FED1D1D1FED1D1FEFED1D1FED1D1FED1D1D1FED1D1FED1FED1FEFED1D1D1FED1D1D1FED1D1D1FEFED1D1D1D1FEFED1D1D1D1D1D1FED1D1D1FED1D1D1FEFED1D1D1FED1FED1D1D1FED1D1D1FED1FED1D1D1D1D1FED1D1D1FED1FEFED1D1FEFED1D1D1FED1D1FED1FED1FEFED1D1D1FED1FED1D1D1D1FED1D1D1D1D1FED1D1D1FEFEFED1D1D1FED1D1D1FED1D1FED1D1D1FED1D1FEFED1D1FED1D1D1OMD9D8D8J";$;"J"C":&9"C"J&@"C%J$="J"<#:"J$;#J"<#A$B#:"J$
+O D1FED1FED14D1D1FEFEFEFEFED1D1AD1FEFEFED1D1FEFEFED1?FEFEFED1@D1FED1D14FEFEFEFED1:D1FED1FEFEFEFED1D1P#FFFFD9J$I#J$J&J%A"B$J%J&J%J%8&J$
+O&D1D1D1FED19D1D1D18D1FED1FED18D1D1D1FED1D1D1D1@D1D1D1D1>D1FED1FED1FD1D1D1D1O&D1D1D1D1D1FED1FED1P4D9D8D8J"J"J"J"<"="G"B#J"9#F"F#E":";#J$
+CFEP"FE9FEO4FEFEFEFEFED1=FEFED1FEFED1FEFEFED1P(FFFFD9J%:&8%:"C":&A":&:"9+9,9"8$8";(8->%:+A-8%9&8&9,8%:$;"@0;(?%:&8%:"A-9$?$95J$
+7FEFEFEFED1FEFEFED1FEFEFED1FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFED1D1FEFEFED1D1FEFEFEFED1FED1FEFED1D1FEFEFED1D1FEFEFED1FED1D1FEFEFED1FEFEFEFEFEFEFEFEFED1FEFEFEFED1FEFEFED1FED1FEFEFEFEFEFEFEFEFED1FEFEFED1D1FEFEFED1D1FEFEFED1D1D1FEFEFED1FEFEFEFED1FED1FEFEFEFED1FEFEFED1D1FEFEFED1D1FEFED1D1FEFEFED1FEFEFEFED1FEFEFED1FEFEFED1FED1FEFEFED1FED1D1FEFEFED1D1FED1FEFEFE6FED1D1FEFEFED1FED1FEFEFEFEFEFED1FEFEFEFEFEFEO?D9D8D8J%;$9$;"C":&:"<":&:"9u8#8$8$8#=r8$:&8$?%:uBv8%:$:$;$9$9%B":#:r8$8r8$9#;%;$9$;":#<&8$;":#:$8#8zJ$
+7D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1FED1D1D1D1D1D1D1D1D1FED1D1D1D1D1D1D1D1D1D1D1D1FED1D1D1D1D1D1D1D1D1D1FED1D1D1D1D1D13D1O6FFFFD9J"J"J"J"J$
+SFD1BD1BD1;D1P3D9D8D8J$J$J$J$J#u
+DFEFEFEOKFEFED1P?FEFED1O4FEFEFEQ#FFFFD8J$J#J#J$J"B"
+DD1D1D1OKD1D1P@D1D1O5D1D1D1Q$D8D8J"J#J";$B"J"J#J":$A$<"J"C":#J"E$:$Jz
+HFE4FEFEGFEFEFEFEFE<FE4FEFEO FEFEFEFEFEFEFEFEOAFEFEFEFE5FEFEFEFEFEFEFEO8/D7J"J"J#;&?#A#9#A"J"J":#B#="B"J#B#:"J#E#;#
+HD14D1FFEFEFED1D1D1FEFEFEFEFEFEFED14D1O!D1D1D1D1D1D1FEO3FED1FED1D15FED1D1D1D1D1J#I#A(
+P(D1D1D1D1D1FEFED1FEFED1J&9%9%:$9&9$:$8&?(J%9%:$9&9$:$8&:$?&9%9$J$;$9&@$:$9.8$9&B#B#9$:$8(:)8#8#
+6FEFEFED1FEFEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEFED1FEFEFEO$FEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFED1FEFEFEFEFEFEFEFE9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFED1FEFEFED1FEFEFED1FEFEFEFEFEFEFED1FEFEFEFED1FED1FEFEFEFEFEFEFEFEFED1FEFEFEFED1D1FED1FEFEFEFEFEFEFEJ'8&8$:&8&8%9-:"9#9#9"A&:"C";$9&8$:&8&8%9-8&>'8&8#J#;&8&?&8&848&:"C"A%9.=)9"
+6D1FED1FED1FED1D1D1D1FED1D1D1FED1D1D1FED1FED1D1D1FED1D1D1FED1D1D1FED1D1FED1FED1FEFED1D1D1D1FED1FEFEFED1FEFED1FED1D1D1D1D1FED1D1D1FED1D1D1FED1FED1D1D1FED1D1D1FED1D1D1FED1D1FED1FED1FEFED1D1D1FED1FED1FED1FED1D1D1D1FED1D1:D1D1FED1D1D1FED1FED1D1D1FED1D1D1FEFED1D1D1FED1FED1D1D1D1D1FED1D1D1FED1D1FED1D1D1FED1FED1D1D1FEFEFED1D1D1FED1D1D1FED1D1FED1D1D1FED1D1FEFED1D1FED1D1D1J$J";$;"A&:"C"B$J$J&F&9$H$B"<#;"<#A$B#:"
+?FEFEFEO!D1D1FED1D1FED1D1D1FED1D1FEFEFEO5FEFEFEFD1FEFEFED1D1FEFEFED1FEFEFEFEFEFED1FED1D1FED1FEFEFEFED1D1J%J$J%J%J%G%9%?&9%J%8&
+>FED1D1D1O'FED1FEO&FED1D1D1O4FED1D1D1GD1D1D1FED1D1D1FED1D1D1D1D1FED1FED1D1D1D1D1MD1D1D1D1D1FED1FED1J&J"J"A">"@"A">"G#B#E":";#
+OHFED1D1D1FEO D1P8FEFEFEFEFEFEFED1FED1FEFEFED1J";)>&8%9/;"9"9";"9":&8&:":&:"9/>&8%9/;(>";/8'>-8&9&>&8&8%:$9&8%;"C"A-9$?$95
+6FEFED1D1FEFEFED1FED1FEFEFED1FEFEFEFED1FEFEFED1FED1D1FEFEFED1D1FEFEFEFEFEFEFEFEFEFEFED1FEFEFED1FEFEFEFEFEFEFEFEFEFED1FEFEFED1D1FEFEFED1FED1FEFEFED1FEFEFEFED1FEFEFED1FED1D1FEFEFED1D1FEFED1D1FEFEFED1FEFED1D1FEFEFED1FED1FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEFEFED1FEFEFED1D1FEFEFED1D1FEFEFED1D1FEFEFED1FEFEFEFED1FED1D1FEFEFED1FEFEFEFEFEFED1FEFEFED1FED1D1FEFEFED1D1FED1FEFEFE6FED1D1FEFEFED1FED1FEFEFEFEFEFED1FEFEFEFEFEFEJr8&?$9%:&8$8r9"9#9#9":&9$;":&:"9r8&?$9%:&8$8r8$?r8v8'>w9$;$@$:$9%;";$9%;":#=":#<&8$;":#:$8#8z
+6D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1FED1D1FED1D1D1D1D1D1D1D1D1D1FED1D1D1D1D1D13D1J"C"J"
+U"D1D1;D1J%J%
+EFEFEFED1P0FEFEFED1J$J$
+ED1D1D1P1D1D1D1J";$B"J$J"C":#J"E$:$
+O5FEFEFEFEFEO FEFEFEO,FEFEFEFE5FEFEFEFEFEFEFEJ"A#;&?#A#9#J#J#B#:"J#E#;#
+O'FEFEFEFED1D1D1FEFEFEFEFEFEFE=D1D1O,FED1FED1D15FED1D1D1D1D1J#I#A(
+O3D1D1D1D1D1FEFED1FEFED1J&9%8&@&J%8&8#8#8%F&9%:&8$:$C#B#9$:$8(:)8#8#
+6FEFEFED1FEFEFEFEFEFED1FEFEFEFEFEFEFEFEO%FEFEFEFEFED1FEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFEFED1FED1FEFEFEFEFEFEFEFEFED1FEFEFEFED1D1FED1FEFEFEFEFEFEFEJ'8-:":&:"J"C";$9/9"9&E'8&8-8&:"C"A%9.=)9"
+6D1FED1FED1FED1D1D1D1FED1D1FEFED1D1FEFED1D1FED1D1FE4FEFED1FED1D1D1D1D1FED1D1FEFED1D1FED1D1D1D1D1D1D1FED1FED1D1D1FED1D1D1D1FEFED1D1D1FED1D1FED1D1D1FEFED1D1D1FEFEFEFED1D1D1FED1D1D1FED1D1FED1D1D1FED1D1FEFED1D1FED1D1D1J$:"=";$;"A%;"C"B$:"C$J$A$9&:"<#;"<#A$B#:"
+?FEFEFED1D1FED1FED1D1FEFEFED1D1FEFEFED1FEFEFE9FEFEFEFEFEFED1FEFEFED1D1FED1D1FED1FEFEFEFED1D1J%H$H$J%G%J%A%9%J%8&
+>FED1D1D1D1D1D1D1D1D1?FED1D1D1FED1D1D18FED1D1D1D1D1D1D1D1D1D1FEFD1D1D1D1D1FED1FED1J#J"J"8"D#B#E":";#
+O=FED19D1O9FEFEFED1FED1FEFEFED1J";,9"9"C":&8%;":&:"9295?%8,9&8&:"C"A-9$?$95
+6FEFED1D1FEFEFED1FEFEFEFEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFEFEFEFED1FEFEFED1D1FEFEFED1FEFEFEFE6FED1D1FEFEFED1FED1D1FEFEFED1FED1FEFEFEFEFEFEFEFEFED1D1FEFEFED1FED1D1FEFEFED1FEFEFED1D1FEFEFED1FEFED1FEFEFED1FED1D1FEFEFED1D1FED1FEFEFE6FED1D1FEFEFED1FED1FEFEFEFEFEFED1FEFEFEFEFEFEJr8s8#9"C":&8$<":&:"9r8s8#8&8w?$:&8$:$:$;":#=":#<&8$;":#:$8#8z
+6D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1FED1D1FED1D1D1D1D1D1D1D1D1D1FED1D1D1D1D1D13D1J"C"J"
+R'D1D1;D1J$C%
+Q*FEFEFEFEFEFED1J$C$
+Q*D1D1D1D1D1D1J&9$:$A$J$J"J$>"F$I#
+O:FEFEFEFEFEFEFEFEFEFEFEFEFEFEP5FEFEFE@FEO"FEFEFEFEFEFEFEFEFEJ"J%8&8&?&J"J"F$J#J"F$?"E$J"
+O&FE4D1D1D1D1FED1D1D1FEFED1D1D1FEFED1D1D1FEFFEO)FEFED1D1@FED1>FEFED1D1D1FED1D14D1
+J(8#9$:$9&J(8#9$:$9&?%:$:$:$8#8)9&B#:#:$8&:$<#9(8#9$:$9&B#9$9$9&<#9$9%:$;#
+8FEFEFED1FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEO-FEFEFED1FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFED1FED1FEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFEFED1FEFEFEFEFED1FEFEFED1FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFED1FEFEFEFED1FEFEFEFEFEFEFEFEFEFEFEFEJ(9"9&8&8&:"<";$I"C":(9"9&8&8&?&8&8&8(9"8'8&:"B%8-8&?(9"9&8&8&:"B%8#:'@%8&8&9%
+7FED1D1D1FED1D1D1FED1D1D1FEFED1D1D1FED1FED1D1D1FEFEFEFEFEFEFEFED1D1D1FED1D1D1FED1D1D1FEFED1D1D1FED1FED1D1D1D1D1D1D1FEFED1D1D1FEFED1D1D1FEFED1D1D1FED1D1D1D1FEFED1D1FED1FED1D1D1FEFED1D1FEFED1D1D1FED1D1FED1FED1FEFED1D1D1FEFED1D1D1FED1D1D1FED1D1D1FEFED1D1D1FED1FED1D1D1FED1D1D1FED1D1D1FEFED1D1FED1D1D1FED1D1D1D1FEFED1D1D1FEFED1D1FEJ$9&A"<":&H"C"I$9&G$="<"G"D"<#:"J$;#H$9&A"<#H"=#A$9&9"
+FFEFEFED1FEFEFED1D1D1D1D1D1D1FED1D1FEFEFED1FEFEFED1FEFEFED1D1D1D1FED1D14FEFEFEFED1FEFEFED1FEFEFED1D1FED1D1FED1FEFEFED1FEFEFED1D1J%9%J%9%F%J%J%9%J%:%
+FD1D1D1D1D1D1D1FEOBD1D1D1D1D1D1D1FEFED1D1D1OCD1D1D1D18D1D1D1D1D1D1D1FEO,FED1D1D1D1D1D1FEJ"8"A"D"J"8"A"I"<"J"?#J"9#J"8"A"?#J#H"
+IFEFEFEFEO.FEFEFEFEFE<FEFED1=FEFED16FEFEFEFED1:FED1FEJ%9-8&9&9"<"9'8&8&:":&:":%9-8&9&>-8&8&8*9"8&9"@0;(?%9-8&9&9"@'8*9"='85
+7D1FEFEFED1FEFEFED1FED1D1FEFEFED1D1FEFEFED1D1FEFEFED1FEFED1FEFEFEFED1D1FEFEFED1D1FEFEFED1FED1FEFEFED1FED1FEFEFED1FEFEFED1FED1D1FEFEFED1D1FEFEFED1D1FEFEFED1D1FEFEFED1FED1D1FEFEFED1D1FEFEFED1D1FEFEFED1D1FEFEFED1FEFEFEFEFED1FEFEFED1FEFEFEFED1FEFEFED1D1FEFEFED1D1FEFED1D1FEFEFED1D1FEFEFED1FEFEFED1FED1D1FEFEFED1D1FEFEFED1D1FEFEFED1FEFED1FEFEFED1FEFEFEFEFED1FEFEFEFEFED1FEFEFED14D1FEFEFED1FED1D1FEFEFED1D1FEFEFED1FEFEFEJ$:&8$:$;$:"<":%:$:$;";$;";$:&8$:$;$@&8$:$:$:s8#9$:":#:r8$8r8$9#<$:&8$:$;$:":#:&9t8&:&:&8$8r
+8D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1FED1D1D1D1D1D1D1D1D1FED1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1FED1D1D1D1D1D1D1D1D1D1FED1D1D1D1D1D1D1D1D1D1D1D1D1D1D1J"J"J"J"
+R<D1BD1O"D1;D1J%J%J%
+8FEFEFED1OIFEFEFED1PLFEFEFED1J$J$J$JZ
+8D1D1D1OJD1D1D1PMD1D1D1R9/J#C$<$J";$:$B";$:$J$<$J$J$C$<$J$>"F$I#J"
+6FEFEFEFEFEFEFEFEO FEFEFEFEFEFEFEFEFEFEFEFEFEFEO-FEFEFEFEFEFEJFEFEFE@FEFEFEFEFEFEFEFEFEJFEFEFEFEFEFEFEFEFEO:D8J"D#<%G"J#;&8&?#;&8&>'J+<%G"J$J$D#<%G"J$?"E$J"Jv"
+6D1D1D1FED1D1D1FE:FEFEFED1D1D1FEFED1D1D1FEFEFEFED1D1D1FEFED1D1D1FEFEFEFED1FEFEDFEFEFED1FEFEFED1D1D1FED1D1D1FE7FED1D1@FED1D1D1D1FED1D1D1FE7FED1D1D1FED1D14D1O/D9D8J#J#J$8"J(
+P!D1D1:D1D19D1FED1D1DD1FED1D1D1FED1J&8#?&9$9&8&9$J#9%9&9$8&J&9$9&8&9$C#:#:$8&:$<#;&8#?&9$9&8&9$C#9$9$9&<#9$9%:$;#
+:FEFED1FEFEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFEFEFEFEFEO=FED1FEFEFEFEFED1FEFEFEFEFEFEFED1FEFEFE8FEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFEFED1FEFEFEFEFED1FEFED1FEFEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFED1FEFEFEFED1FEFEFEFEFEFEFEFEFEFEFEFEJ&9"@&8&8&8&8&:"<"J"J";#:&8&8-J&8&8&8&8&:"B%8-8&A&9"@&8&8&8&8&:"B%8#:'@%8&8&9%
+9FED1D1D1D1D1D1FED1D1D1FED1D1D1FED1FED1D1D1D1FED1D1D1FED1D1D1FEFEFE;FE;FEFED1D1D1D1D1FED1FED1D1D1FED1D1D1FED1D1FEFED1D1FE7D1FED1D1D1FED1D1D1FED1FED1D1D1D1FED1D1D1FED1D1D1FEFEFED1D1FEFED1D1D1FED1D1FED1FED1FEFED1D1D1FEFED1D1D1D1D1D1FED1D1D1FED1D1D1FED1FED1D1D1D1FED1D1D1FED1D1D1FEFED1D1D1FED1D1D1FEFED1D1FED1D1D1FED1D1D1D1FEFED1D1D1FEFED1D1FEJ#J$G&:"<"J"J"<";$A$:"J$G&:"<#:"J$;#:#J$G&:"<#H"=#A$9&9"
+8FED1:FEFEFED1FEFEFED1D1D1;D1;D1FEFEFEFEFEFEFED1BFEFEFED1FEFEFED1D1FED1D14FEFEFEFED1FED1:FEFEFED1FEFEFED1D1FED1D1FED1FEFEFED1FEFEFED1D1J#J%G%J$9%A%J%G%J%@#J%G%J%:%
+8D1FE:D1D1D1D1D1D1D1FEO;D1D1FEFED1D1D1D1D1D1D1FD1D1D1D1D1D1D1FEFD1D1D1D1D1FE:D1D1D1D1D1D1D1FEO%FED1D1D1D1D1D1FEJ#J"D$J#J"G$J"D$D#J"9#<#J"D$D#J#H"
+9D1FE<FEFED1FEOAD1FE4FEFED1FE5FEFED1FEFED1=FEFED1D1FE<FEFED1FEFED1:FED1FEJ"959&8%:,:"<":&8&8&:":&8&8&:"9$9.9*9">&8,9&8%:,:"@0;(>"959&8%:,:"@'8*9"='85
+6FE6D1FEFED1D1FEFEFED1FED1FEFEFEFEFEFED1FEFEFEFED1FEFEFED1FEFEFEFED1FEFEFED1D1D1FEFEFED1FEFEFEFEFEFEFED1FEFEFED1D1FEFEFED1FEFEFEFEFEFED1FEFEFED1D1FEFEFED1FEFEFEFEFED1D1FEFEFED1FED1FEFEFEFED1FEFEFED1D1FEFEFEFED1FEFEFED1FEFEFEFEFEFED1FEFEFEFED1FEFEFED1FEFEFEFED1FEFEFED1D1D1FEFEFED1FEFEFEFED1FEFEFED1D1FEFEFED1D1FEFED1D1FEFEFED1FE6D1FEFED1D1FEFEFED1FED1FEFEFEFEFEFED1FEFEFEFED1FEFEFED1FEFEFEFED1FEFEFED1D1D1FEFEFED1FEFED1FEFEFED1FEFEFEFEFED1FEFEFEFEFED1FEFEFED14D1FEFEFED1FED1D1FEFEFED1D1FEFEFED1FEFEFEJ#9#8z:$9%;$9$;"<":&9$:$;":&9$:$;"9$8#8u:$8$8#?$9v:$9%;$9$;":#:r8$8r8$9#:#9#8z:$9%;$9$;":#:&9t8&:&:&8$8r
+6D1D1D1D11D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1FED1D1D1D1D1D1D1D1D1FED1D1D1D1D11D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1FED1D1D1D1D1D1D1D1D1D1FED1D1D1D1D1D1D1D1D1D1D1D1D1D1D1J"J"J"J"
+S1D1BD1O7D1;D1Jv
+X)D8J"
+X(D8J$<$J";$;"C";$:$J#J$<$J$J"E$<$J$>"F$I#Jz
+EFEFEFEFEFEFEO FEFEFEFEFEFEFEFEFEFEFEFE>FEFE4FEFEFEFEFEFEJFEFEFE@FEFEFEFEFEFEFEJFEFEFEFEFEFEFEFEFEO3/D7J#<%G"J#;&8#B#;&8&>#9#D"C+<%G"J$J#E#<%G"J$?"E$J"JZ
+ED1D1FED1D1D1FE:FEFEFED1D1D1FEFEFEFEFEFED1D1D1FEFED1D1D1FEFEFEFEFED1FEFEFED1FEFEFED1D1D1FED1D1D1FE7FED1D1@FED1D1D1FED1D1D1FE7FED1D1D1FED1D14D1O4/J#B#B#J(J(J"C"
+P!D1D1D1D1D1D19D1FEFED1FEFED1<D1FED1D1D1FED1T!D7D8J&8#8#?&9$9&8&9$J%9&;#J&9$9&8&9$C#:#:$8&:$<)8#8#?&9$9&8&9$C#9$9$9&<#9$9%:$;#Jt$
+6FEFEFED1FEFEFEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFEFEFEFEFEOBFEFEFEFEFED1FEFEFEFEFE7FEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFEFED1FEFEFEFEFED1D1FEFEFED1FEFEFEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFEFEFEFEFEFED1FEFEFEFEFEFEFED1FEFEFEFED1FEFEFEFEFEFEFEFEFEFEFEFEO3D9D8D8D7J)9"@&8&8&8&8&:"<"J"J";$9&8&:$J&8&8&8&8&:"B%8-8&>)9"@&8&8&8&8&:"B%8#:'@%8&8&9%J$
+6D1FED1FED1FED1D1D1D1FED1D1D1FED1D1D1FED1FED1D1D1D1FED1D1D1FED1D1D1FEFEFE;FE;FED1FED1D1D1D1D1FED1FED1D1D1FED1D17D1FED1D1D1FED1D1D1FED1FED1D1D1D1FED1D1D1FED1D1D1FEFEFED1D1FEFED1D1D1FED1D1FED1FED1FEFED1D1D1FED1FED1FED1FED1D1D1D1FED1D1D1FED1D1D1FED1FED1D1D1D1FED1D1D1FED1D1D1FEFED1D1D1FED1D1D1FEFED1D1FED1D1D1FED1D1D1D1FEFED1D1D1FEFED1D1FEO0D7FFFFJ$G&:"<"J"J"B$A#J$G&:"<#:"J$;#J$G&:"<#H"=#A$9&9"J$
+O&FEFEFED1FEFEFED1D1D1;D1;D1FEFEFEFED1AFEFEFED1FEFEFED1D1FED1D14FEFEFEFED1@FEFEFED1FEFEFED1D1FED1D1FED1FEFEFED1FEFEFED1D1O=D8D8D7J%G%J%A#J%G%J%J%G%J%:%J$
+O&D1D1D1D1D1D1D1FEOAFED1D1D1D1FEAD1D1D1D1D1D1D1FEFD1D1D1D1FD1D1D1D1D1D1D1FEO%FED1D1D1D1D1D1FEO8D7FFFFJ"D$J"J#A$J"D$D#J"9#J"D$D#J#H"J$
+O)FEFED1FEO@D14D1FEFED1FE5FEFED1FEFED1=FEFED1DFEFED1FEFED1:FED1FEODD8D8D7J";59&8%:,:"<":&8&8&:":&8&8&:"948"9$>&8,9&8%:,:"@0;(>";59&8%:,:"@'8*9"='85J$
+6FE4FED1D1FEFEFED1FED1FEFEFEFEFEFED1FEFEFEFED1FEFEFED1FEFEFEFED1FEFEFED1D1D1FEFEFED1FEFEFEFEFEFEFED1FEFEFED1FEFEFEFEFEFEFEFEFEFEFED1FEFEFED1D1FEFEFED1FEFEFEFED1FEFEFED1D1FEFEFED1FED1FEFEFEFEFED1FEFED1FEFEFED1FEFEFEFEFEFED1FEFEFEFED1FEFEFED1FEFEFEFED1FEFEFED1D1D1FEFEFED1FEFEFEFED1FEFEFED1D1FEFEFED1D1FEFED1D1FEFEFED1FE4FED1D1FEFEFED1FED1FEFEFEFEFEFED1FEFEFEFED1FEFEFED1FEFEFEFED1FEFEFED1D1D1FEFEFED1FEFED1FEFEFED1FEFEFEFEFED1FEFEFEFEFED1FEFEFED14D1FEFEFED1FED1D1FEFEFED1D1FEFEFED1FEFEFEO1D7FFFFJr8z:$9%;$9$;"<":&9$9&:":&9$:$;"9r8u8#9#?$9v:$9%;$9$;":#:r8$8r8$9#:r8z:$9%;$9$;":#:&9t8&:&:&8$8rJ$
+6D11D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1FED1D1D1D1D1D1D1D1D1FED1D11D1D1D1D1D1D1D1D1D1D1D1D1D1D1D1FED1D1D1D1D1D1D1D1D1D1FED1D1D1D1D1D1D1D1D1D1D1D1D1D1D1O7D8D8D7J"J"J"J"J$
+S*D1BD1O7D1;D1P%D7FFFFJ$
+X/D8D8D7J$
+X,D7FFD8J"
+X0D7J"
+X-D7J"
+X/D7JZAZ
+5W5/J"J"
+4FFW?FFIz=z
+W9D13D9
+Gz
+W=D9
+
+
+
+Iz
+W9D8J"
+WKFFJy#Z$x"
+5D7FFD7VCD7FFFFD7FFJ$J"9#
+AFFFFD8VCD8FFFFJ%:z"<#
+?FFFFFFD8V?D9D8FFFFJ#8"J#8#
+=FFFFD9VID9D9FFFFJ#8#J#8#
+;FFFFD9D9VLD9D9FFFFJ#8#J#8#
+9FFFFD9D9W"D9D9FFFFJ#8#J#8#
+7FFFFD9D9W&D9D9FFFFJ'J&
+5D8D8D8D8D9D9W*D9D8D8D8D8J#8#J"9"
+5D7D7D8D8W*D8D7J#8#J#8#
+7D7D7D8D8W&D8D8D7D7J#8#J#8#
+9D7D7D8D8W"D8D8D7D7'J#8#J#8#J&
+F7F7F7F7F7F75D7D7D8D8VLD8D8D7D7MF7F7F7F7F7'J#8"J#8#J'
+F6F6F6F6F6F67D7D7D8VID8D8D7D7O!F6F6F6F6F6F68%J#<z=#J&
+F9F9F9F99D7D7V?D8D7D7O$F9F9F9F9F7J#9"J$
+AD7D7D8VCD8D7D7JZ
+5W5J"
+4FFIz
+W9D9
+
+
+
+
+
+
+
+
+
+
+=z"z"z
+0F6F7WHF6F71F6<z8z8z
+1F9WGF91F9
+
+
+7z8z8z
+6F7WGF75F7"J"J"
+F77F7WHF7
+ENDBITMAP
+%%EndBinary
+324 456 531 537 R
+7 X
+V
+4 8 Q
+0 X
+(scrolledtext .st -labelpos n \134) 324 531.67 T
+( -labeltext \322/etc/passwd\323 \134) 324 521.67 T
+( -vscrollmode static \134) 324 511.67 T
+( -hscrollmode static) 324 501.67 T
+(pack .st -padx 10 -pady 10 -f) 324 491.67 T
+(ill both \134) 463.2 491.67 T
+( -expand yes) 324 481.67 T
+(.st import /etc/passwd) 324 461.67 T
+0 10 Q
+(FIGURE 24) 376.64 431.17 T
+1 F
+( - Scrolledtext) 428.02 431.17 T
+0 0 612 792 C
+FMENDPAGE
+%%EndPage: "13" 13
+%%Page: "14" 14
+612 792 0 FMBEGINPAGE
+[0 0 0 1 0 0 0]
+[ 0 1 1 0 1 0 0]
+[ 1 0 1 0 0 1 0]
+[ 1 1 0 0 0 0 1]
+[ 1 0 0 0 0 1 1]
+[ 0 1 0 0 1 0 1]
+[ 0 0 1 0 1 1 0]
+ 7 FrameSetSepColors
+FrameNoSep
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 12 Q
+0 X
+0 0 0 1 0 0 0 K
+(Buttonbox) 157.49 272.29 T
+1 10 Q
+(The Buttonbox performs geometry management for) 72 253.62 T
+(Pushbutton instances. Public commands exist which) 72 241.62 T
+(enable the user to add new Pushbuttons, de\336ne the) 72 229.62 T
+(default, and control their display) 72 217.62 T
+(. Options enable the) 201.61 217.62 T
+(user to establish the orientation. This class is used to) 72 205.62 T
+(manage the buttons for all dialogs in the [incr W) 72 193.62 T
+(idgets]) 265.74 193.62 T
+(mega-widget set.) 72 181.62 T
+0 12 Q
+(Panedwindow) 148.49 150.29 T
+1 10 Q
+(The Panedwindow class is composed of panes, separa-) 72 125.62 T
+(tors, and sashes for adjustment of the separators. Each) 72 113.62 T
+(pane is a child site and the class provides a command) 72 101.62 T
+(which returns the paths for the sites. The user may \336ll) 72 89.62 T
+(them with further widget combinations.) 72 77.62 T
+72 298.29 297 720 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+72 324 297 715.57 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 5902
+489 391 195.6 156.4 0 85.29 548.57
+/red <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000096FB7DFFCF9AFFFF69FBB29AFF2CAEB6CF71E7
+A24DF70055BE928AB2D3FF00F7557DDBB2002CFF6120822C455D4571FF0000FF
+> store
+/green <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000096FB6DFFB669F7AE86FFDF8AE78AEFEF0071E7
+A24DF70055BE827530B6FFFFDF697DDBB2004D00B641DF4D829E4582FF0000FF
+> store
+/blue <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000009AFF5DDF9E71FFBA8EFFEF75C755EFB60071E7
+A24DF77D55BE9265618EE300B22C7DDBB28A4D00FF59E351B6A2FF9200FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+7F4F5W:F4F57F4F5J"
+X;F58z8z8z
+5F8W9F85F8
+
+
+<z"
+X0F5F4=z"z"z"z
+0F4F5W)F4F50F4F50F4>z8z8z8z
+/F8W(F8/F8/F8
+J'J$8$C$8s
+R$FEFEFEFEF8FE6FEFEFEFEFEFEFEFEFEFEJ'J":"E":"8$Js"
+R#FEFEF8F8F8FE7F8F8F8F8F8F8F8REF4F5J"J"Jr
+R(F8O)F8REF8J#8"9$8'8$E$:#@"9,9'8#;$
+R%FEFEF8FEFEFEFEFEFEF8FEFEFEFEFEFEFEFEFEFEFEFEFEFEF8FEFEF8FEFEFEFEFEFEFEF8FEFEFEFEFEFEFEAs"J"9#8)8"8(A-=#8$8":%8"8)8'J$
+F4F5Q=F8FEFEFEFEFEF8FEFEF8F8FEFEFEFEF8FEFEFEFEFEFEF8FEFEF8FEFEFEF8FEFEFEF8F8F8FEF8F8FEFEF8FEF8FEFEFEF8FEFEFEFEFEF8FEFEQAF4F4F5BrJ#9"9%:$8$F";$=#=(="9">"J"
+F8Q?F8F8FEF8F8F8F8F8F8F8F8F8F8FEF8F8F8F8F8F8F8F8F8F8FEFEF8F8FEQDF8AsJ"8#J%E"?%I%J#
+F5Q>FEF8F8DF8F8F8F8F8FEFEF8F8F8F8F8F8QAF5F5AtJ">%?$E%9$J"I%J$
+F8Q>FEFEF8FEFEFEF8FEFEF8FEFEFEF8FE6FEFEF8FEFEQAF8F8F8J08"8*8$8/8$8";"8"8%8$8"9"9)
+R$F8FEFEFEFEF8F8F8F8FEFEFEF8F8FEFEF8F8FEFEFEF8F8F8FEFEF8FEFEF8F8F8FEFEFEF8F8F8F8FEFEF8FEF8FEFEFEFEF8FEFEF8FEF8FEFEFEFEF8F8F8FEFEFEF8J':$8%:$9t9$:v;%9z9$Js
+R#F8F8F8F8F8F8F8F8F8F8F8F8F8F8F8F8F8F8F8F8F8F8F8F8F83F8F8F8F8R"F5Jt
+X)F8
+>z8z8z8z
+/F5W(F5/F5/F5sF"J"F"F&
+F5F5W)F5F5F5F5F5F5F5(z$z'
+F4F4F4F4F4F4F5WGD8D9D9D93CFF4F4F4F4F4F48%J"J(
+F8F8F8F8WGFF5D0F4F8F8F8F8F5?z"<r"r"
+WCD9FFD1D8D1D0J$
+X+FFD8D8
+J"9"
+X*FFD8J"
+X,D9J(
+X)FFFFD9D9D9D8D8J"
+X(FFJ"9$
+X*D9D9D8D8J$;$
+X'FFFFD9D9D8D8
+J$=$
+X&FFFFD9D9D8D8Ju
+X'D8J#B"
+X%FFD8D8J"X"
+X%D1D1J"
+X2D8Jz9zJz9zDt"
+8QHCD3CF>QHCD3CFD9D8J"J"J"J"
+R1FF5D0R7FF5D0Jz"<r"r"Jz"<r"r"
+:QDCEFFD1D8D1D0AQDCEFFD1D8D1D0J$J$
+R=FFD8D8RKFFD8D8
+J"9"J"9"
+R<FFD8RIFFD8J"J"
+R>D9RMD9J(J(
+R;FFFFD9D9D9D8D8RGFFFFD9D9D9D8D8J"J"
+R:FFRMFFJ"9$J"9$
+R<D9D9D8D8RGD9D9D8D8J$;$J$;$
+R9FFFFD9D9D8D8RCFFFFD9D9D8D8
+J$=$J$=$
+R8FFFFD9D9D8D8RAFFFFD9D9D8D8JuJu
+R9D8RDD8J#B"J#B"
+R7FFD8D8R?FFD8D8J"X"J"X"
+R7D1D1R?D1D1J"J"
+RDD8RMD8Jt"Jt"
+R:D9D8RDD9D8
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+JtJt
+R:D8RED8J"J"
+R9D8RMD8JZJZ
+R7/R?/J"C"J"C"Ft
+R7D1D8R?D1D8D8J#t$J#t$E"
+R8D1FFD9D8D8D1R@D1FFD9D8D8D1D8J"J"Jx
+R:FFRMFF9D1J">$J">$
+R9D1D8D8D1RBD1D8D8D1J"="J"="
+R;FFD1REFFD1J"<"J"<"
+R:D1D8RFD1D8J"9$J"9$
+R<FFD8D8D1RGFFD8D8D1J"J"
+R;D1RMD1J&J&
+R=FFD9D8D8D1RIFFD9D8D8D1J&J&
+R<D1FFD8D8D1RID1FFD8D8D1
+J$J$
+R=D1D8D1RKD1D8D1JZ=zJZ=z
+:QD/D0BQD/D0J"J"J"J"
+9FFQJD0O"FFQJD0Jz9zJz9z
+8QHD93D9>QHD93D9
+
+JzJz
+8QHCFO&QHCFJ"J"
+R1D0RMD0Jw"z#v"Jw"z#v"
+:D1FFQ*D1FFFFD1D0O)D1FFQ*D1FFFFD1D0J$Z8#J$Z8#
+DFFFFD8Q*FFFFO=FFFFD8Q*FFFFJ$J":"J$J":"
+CFFFFD8Q*D8FFO;FFFFD8Q*D8FFJ%:z"9&J%:z"9&
+AFFFFFFD9Q&D9D8D9D9FFFFFFO7FFFFFFD9Q&D9D8D9D9FFFFFFJ&J&J&J&
+?FFFFFFD9D9Q1D9D9FFFFFFO3FFFFFFD9D9Q1D9D9FFFFFFJ"8"J"8"J"8"J"8"
+>FFD9Q5D9FFO1FFD9Q5D9FFJ&J&J&J&
+<FFFFFFD9D9Q7D9D9FFFFFFO-FFFFFFD9D9Q7D9D9FFFFFFJ&J%J&J%
+:D8D8D8D9D9Q;D9D8D8D8O*D8D8D8D9D9Q;D9D8D8D8J&J"8"J&J"8"
+:D1D1D8D8D8Q;D8D1O*D1D1D8D8D8Q;D8D1J&J&J&J&
+<D1D1D8D8D8Q7D8D8D8D1D1O-D1D1D8D8D8Q7D8D8D8D1D1J"8"J"8"J"8"J"8"
+>D1D8Q5D8D1O1D1D8Q5D8D1J&J&J&J&
+?D1D1D8D8D8Q1D8D8D8D1D1O3D1D1D8D8D8Q1D8D8D8D1D1J%:z:&J%:z:&
+AD1D1D8D8Q&D8D8D8D8D1D1O7D1D1D8D8Q&D8D8D8D8D1D1J":"J"J":"J"
+CD1D8Q,D1O;D1D8Q,D1J$z%J$z%
+DD1D1D8Q*D1FFD8D1D1O=D1D1D8Q*D1FFD8D1D1JzJz
+:QDD0O*QDD0J"J"
+9D0RMD0JzJz
+8QHD9O&QHD9
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Jz9zJz9z
+8QHCD3CF>QHCD3CFJ"J"J"J"
+R1FF5D0R7FF5D0Jz"<r"r"Jz"<r"r"
+:QDCEFFD1D8D1D0AQDCEFFD1D8D1D0J$J$
+R=FFD8D8RKFFD8D8
+J"9"J"9"
+R<FFD8RIFFD8J"J"
+R>D9RMD9J(J(
+R;FFFFD9D9D9D8D8RGFFFFD9D9D9D8D8J"J"
+R:FFRMFFJ"9$J"9$
+R<D9D9D8D8RGD9D9D8D8J$;$J$;$
+R9FFFFD9D9D8D8RCFFFFD9D9D8D8
+J$=$J$=$
+R8FFFFD9D9D8D8RAFFFFD9D9D8D8JuJu
+R9D8RDD8J#B"J#B"
+R7FFD8D8R?FFD8D8J"X"J"X"
+R7D1D1R?D1D1J"J"
+RDD8RMD8Jt"Jt"
+R:D9D8RDD9D8
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+JZ
+X%/J"C"
+X%D1D8J#t$
+X&D1FFD9D8D8D1J"
+X(FFJ">$
+X'D1D8D8D1J"="
+X)FFD1J"<"
+X(D1D8J"9$
+X*FFD8D8D1J"
+X)D1J&
+X+FFD9D8D8D1J&
+X*D1FFD8D8D1
+J$
+X+D1D8D1?Z8Q8Z8Q8Z=z
+R'RD2/D0>"J"
+FFWID0=z9z
+WGD93D9
+
+=z
+WGCF'J"J&
+F5F5F5F5F5F5WGD06F5F5F5F5F5'9w"z#v"J'
+F4F4F4F4F4F4D1FFW)D1FFFFD1D07F4F4F4F4F4F48%C$ZA#J&
+F8F8F8F8FFFFD8W FFFFBF8F8F8F8F5H$J"C"
+FFFFD8W D8FFF%:z"B&
+FFFFFFD9VJD9D8D9D9FFFFFFD&J&
+FFFFFFD9D9W0D9D9FFFFFFC"8"J"8"
+FFD9W4D9FFA&J&
+FFFFFFD9D9W6D9D9FFFFFF?&J%
+D8D8D8D9D9W:D9D8D8D8?&J"8"
+D1D1D8D8D8W:D8D1A&J&
+D1D1D8D8D8W6D8D8D8D1D1C"8"J"8"
+D1D8W4D8D1D&J&
+D1D1D8D8D8W0D8D8D8D1D1F%:zC&
+D1D1D8D8VJD8D8D8D8D1D1H":"J"
+D1D8W+D1I$z@$
+D1D1D8W D1D8D1D1?z
+WCD0>"
+D0=z"z"z
+0F4F5W:F4F51F4<z8z8z
+1F8W9F81F8
+
+
+7z8z8z
+6F5W9F55F5"J"J"
+F57F5W:F5
+ENDBITMAP
+%%EndBinary
+81 333 288 531 R
+7 X
+V
+4 8 Q
+0 X
+(scrolledframe .sf -vscrollmode static \134) 81 525.67 T
+( -hscrollmode static \134) 81 515.67 T
+( -width 475 -height 360) 81 505.67 T
+(set childsite [.sf childsite]) 81 495.67 T
+(pack [frame $childsite.topframe]) 81 475.67 T
+(pack [frame $childsite.botframe]) 81 465.67 T
+(scrolledlistbox $childsite.topframe.slb1) 81 445.67 T
+(pack $childsite.topframe.slb1 -side left) 81 435.67 T
+(scrolledlistbox $childsite.topframe.slb2) 81 415.67 T
+(pack $childsite.topframe.slb2 -side left) 81 405.67 T
+(scrolledlistbox $childsite.botframe.slb3) 81 385.67 T
+(pack $childsite.botframe.slb3 -side left) 81 375.67 T
+(scrolledlistbox $childsite.botframe.slb3) 81 365.67 T
+(pack $childsite.botframe.slb3 -side left) 81 355.67 T
+(pack .sf -expand yes -f) 81 335.67 T
+(ill both) 191.4 335.67 T
+0 10 Q
+(FIGURE 25) 125.51 308.17 T
+1 F
+( - Scrolledframe) 176.9 308.17 T
+0 0 612 792 C
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+-0.17 (The Panedwindow of) 315 116.48 P
+-0.17 (fers signi\336cant control over its pre-) 400.03 116.48 P
+(sentation through a lar) 315 104.48 T
+(ge set of options. The option set) 404.53 104.48 T
+(allows speci\336cation of the distance between a pane and) 315 92.48 T
+(its contents, the minimum size a pane\325) 315 80.48 T
+(s contents may) 468.05 80.48 T
+315 527.86 540 720 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+315 558 540 718.14 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 3593
+264 89 135.77 45.77 0 369 657
+/red <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000008EEF9AFF2CAEB6CF71E7
+A24DF70055BE928AB2D3FF00F7557DDBB2002CFF6120822C455D4571FF0000FF
+> store
+/green <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000082D78AE78AEFEF0071E7
+A24DF70055BE827530B6FFFFDF697DDBB2004D00B641DF4D829E4582FF0000FF
+> store
+/blue <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+000000000000000000000000000000000000000000006DB675C755EFB60071E7
+A24DF77D55BE9265618EE300B22C7DDBB28A4D00FF59E351B6A2FF9200FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+7F6F7R?F6F77F6F7J"
+S@F78z8z8z
+5F9R>F95F9
+
+
+<z"
+S5F7F6=z"z"z"z
+0F6F7R.F6F70F6F70F6>z8z8z8z
+/F9R-F9/F9/F9
+J'D":"I'
+OJFEFEFEFEFEFEFEFEFEFEFEFEFEFEJ"8%B":"J"8%Js"
+OJF9F9F9FEFEFEFE4F9F9F9FEFEP,F6F7Jr
+S/F9J(8"8$8#8$9'D$9(
+P%FEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEF9FEFEFEFEFEFEFEFEF9FEFEFEAs"J%8"9":"8$8,8%;%8*9$J$
+F6F7O9FEFEFEF9F9F9F9F9F9F9F9F9FEFEFEF9FEFEFEF9F9FEF9FEFEFEFEFEF9FEFEFEF9FEFEFEF9F9F9FEF9O;F6F6F7BrJ&J$<">&9$:&J"
+F9O:F9F9F9FEFE6F9F9F9F9F9F9F9FEFEF9F9F9F9FEFEFEF9O=F9AsJ#
+F7R;F7F7AtJ"F$J$:&J$
+F9OCFEFEF9FE7FEF9FEFEF9F9FEFEO<F9F9F9J"8&8%8"8$8.8"9$829"
+OJFEFEFEFEFEF9F9FEFEF9FEF9FEFEF9FEFEF9F9F9FEFEFEF9F9F9FEFEFEF9FEFEFEFEFEF9F9F9F9FEFEFEF9F9F9FEFEFEFEJr:'9#9#9$9z:$9rJs
+OJF9F9F9F9F9F9F9F9F9F9F9F9F9F90F9F9F9F9F9OIF7Jt
+S.F9
+>z8z8z8z
+/F7R-F7/F7/F7sF"J"F"F&
+F7F7R.F7F7F7F7F7F7F7(z'
+F6F6F6F6F6F6F7S4D9F6F6F6F6F6F68%J&
+F9F9F9F9S6F9F9F9F9F7
+
+
+Bz
+OBFE
+Dz
+O>D9
+Fz
+O:D8J"
+OIFFHz"
+O6D9FF
+
+
+JZJZJZ
+6O.4O.4O.J"J"J"
+OCD8OAD8OAD8Jz"Jz"Jz"
+8O*D9D87O*D9D87O*D9D8
+
+
+
+
+J#:#J#9#J#;#F#
+HFEFEFEFEO>FEFEFEFEO/FEFEFEFEFEFEJ"
+PBFEJ$8)9%J%J"9":%8#9#:#9%
+HD9FEFEFEFED9D9FEFEFEFEFEFEFEFEO;FEFEFEFEO+FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEJ.J#:'J'A,
+O"FEFED9D9FEFED9FEFED9D9FEFEO3D9FEFEFED9D9FEFEO2FEFED9D9FEFEFED9FEFED9FEFED9D9FEFEJ'@%J$:#;(9"
+ID9FEFEFEFED9FED9D9D9PJFED9FED9D9D9FEFED9FEFED9D9J"8":#9&J#J"9":$J#
+JD9D9FEFED9D9FEFEFEO5D9FEO3D9D9FEFEFE4FEFEJ%9"8"J";%:&A%
+O$D9D9D9D9D9FEPKFEFEFED9D9D9FEFEFED9D9D9D9D9J(J"J$J">#
+O&FEFED9FEFED9D9O7D9O4D9FED95FEFEFEJ.J'J(8"=,
+O"D9FEFEFEFED9D9D9FEFEFEFED9O9D9FEFEFEFED9O2D9FEFEFED9FEFED9D9FEFED9D9D9FEFEFEFED9J#:%9%J#9#8%J#8"8#8':"9&9%
+KD9D9D9D9D9D9D9D9D9D9O2D9D9D9D9D9D9D9D9O)D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9D9J"
+R;FEJ$
+R:FEFED9J#
+R:D9D9
+
+
+
+'J&
+F7F7F7F7F7F7S5F7F7F7F7F7'HzJzJzG'
+F6F6F6F6F6F6O*D88O*D88O*D8F6F6F6F6F6F68%G"J"J"J&
+F9F9F9F9D8OAD8OAD8O<F9F9F9F9F7JzJzJz
+6O.D94O.D94O.D9
+
+
+HZ
+O6G"
+FFFz
+O:D9
+Dz
+O>FE
+Bz
+OBD9
+
+
+
+=z"z"z
+0F6F7R?F6F71F6<z8z8z
+1F9R>F91F9
+
+
+7z8z8z
+6F7R>F75F7"J"J"
+F77F7R?F7
+ENDBITMAP
+%%EndBinary
+351 567 513 648 R
+7 X
+V
+4 8 Q
+0 X
+(buttonbox .bb -padx 10 -pady 10) 351 642.67 T
+(.bb add Yes -text Yes) 351 622.67 T
+(.bb add No -text No) 351 612.67 T
+(.bb add Maybe -text Maybe) 351 602.67 T
+(.bb default Yes) 351 592.67 T
+(pack .bb -expand yes -f) 351 572.67 T
+(ill both) 461.4 572.67 T
+0 10 Q
+(FIGURE 26) 376.52 542.16 T
+1 F
+(- Buttonbox) 430.42 542.16 T
+0 0 612 792 C
+315 135.14 540 505.86 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+315 170.71 540 494.43 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 5963
+314 531 94.2 159.3 0 427.8 323.98
+/red <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000007D96FB7DFFCF8AFFE79AFF2CAEB6CF71E7
+A24DF70055BE928AB2D3FF00F7557DDBB2002CFF6120822C455D4571FF0000FF
+> store
+/green <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000006D96FB6DFFB67DFFCF8AE78AEFEF0071E7
+A24DF70055BE827530B6FFFFDF697DDBB2004D00B641DF4D829E4582FF0000FF
+> store
+/blue <
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000000000000000000000000000000000000000
+0000000000000000000000000000005D9AFF5DDF9E69FBB275C755EFB60071E7
+A24DF77D55BE9265618EE300B22C7DDBB28A4D00FF59E351B6A2FF9200FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+7F6F7SCF6F77F6F7J"
+TDF78z8z8z
+5F9SBF95F9
+
+
+<z"
+T9F7F6=z"z"z"z
+0F6F7S2F6F70F6F70F6>z8z8z8z
+/F9S1F9/F9/F9
+JrJ$8.8#E$
+P'FE>FEFEFEFEFEFEFEF9FEFEFEFEF9FEFEFEFEFEFEFEFEJ"8&J":"8$8&I"Js"
+P'F9F9F9F9FEFE=F9F9F9F9F9F9F9F9FEF9F9P<F6F7J#Jr
+Q2F9F9PMF9J%9';$:#<,8$8';#=$8-
+P1FEFEFEFEFEFEFEF9FEFEFEFEFEFEFEF9FEFEF9FEF9FEFEF9FEF9FEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEF9FEFEFEFEF9FEFEFEAs"J$9%8"8%8-H":"8%8&:)9"8&J$
+F6F7OFFEFEF9F9F9FEFEF9FEF9FEFEFEFEFEF9FEFEF9FEFEFEF9FEF9F9FEF9FEFEFEFEFEF9FEFEFEFEF9FEFEFEF9F9F9F9F9FEF9OEF6F6F7BrJ%9$=">";$J"=$<$9$9%J"
+F9OEFEFEFEF9F9FEFEF9FEF9F9F9:F9F9F9F9F9F9F9F9FEFEFEF9FEF9OGF9AsJ$9%E%B*J#
+F7OEF9F9F9FEFEF9F9F9F9F9F9F9FEFEF9F9F9FEFEF9PDF7F7AtJ"E%9$J$<$:)J$
+F9OMFEFEF9FEFEFEF9FEBFEF9FEFEF9FEF9FEFEF9F9FEFEF9OGF9F9F9J"8";%8$8"9/8"E"8$8"9(8*
+P'FEFEF9FEFEF9FEF9FEFEFEF9F9F9FEFEFEF9F9F9F9FEFEF9FEFEFEF9FEFEFEF9F9F9FEFEF9FEF9F9F9FEFEFEF9F9J%<z9$:':#9#:x9'9$;#8#Js
+P'F9F9F9F9/F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9P(F7Jt
+T2F9
+>z8z8z8z
+/F7S1F7/F7/F7sF"J"F"F&
+F7F7S2F7F7F7F7F7F7F7(z'
+F6F6F6F6F6F6F7T8D9F6F6F6F6F6F68%J&
+F9F9F9F9T:F9F9F9F9F7
+
+
+
+
+
+Ez
+S<D1
+Gz=z
+S8D03D8J"J"
+SHFF9FFIz"@r"r"
+S4D1FFD7D8D7FFJ"
+T*FFJ"
+T,D8J"
+T)FFJ$
+T+D9D8D8J$
+T(FFFFD9J$
+T,D9D8D8J$
+T'FFFFD9J$
+T-D9D8D8J$
+T&FFFFD9J$
+T.D9D8D8J$
+T%FFFFD9J$
+T/D9D8D8J#u
+T$FFFFD8J"B"
+T%D8D8Jz
+T$/D7JZ
+T$/J"
+T2D8Jv"
+T&D9D8
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Jv
+T&D8J"
+T%D8Jz
+T$/D7JZ
+T$/J"C"
+T$D7D8Jt$
+T'D9D8D8D7J$
+T%D7FFFFJ$
+T/D8D8D7J$
+T&D7FFFFJ$
+T.D8D8D7J$
+T'D7FFFFJ$
+T-D8D8D7J$
+T(D7FFFFJ$
+T,D8D8D7J$
+T)D7FFD8J"
+T-D7J"
+T*D7J"
+T,D7IZAZ
+S4/H"J"
+FFS>FFGz=z
+S8D13D9
+Ez
+S<D9
+
+
+
+Gz
+S8D8J"
+SHFFIy#Z$x"
+D7FFD7RBD7FFFFD7FFJ$J"9#
+?FFFFD8RBD8FFFFJ%:z"<#
+=FFFFFFD8R>D9D8FFFFJ#8"J#8#
+;FFFFD9RHD9D9FFFFJ#8#J#8#
+9FFFFD9D9RKD9D9FFFFJ#8#J#8#
+7FFFFD9D9S!D9D9FFFFJ#8#J#8#
+5FFFFD9D9S%D9D9FFFFI'J&
+D8D8D8D8D9D9S)D9D8D8D8D8I#8#J"9"
+D7D7D8D8S)D8D7J#8#J#8#
+5D7D7D8D8S%D8D8D7D7J#8#J#8#
+7D7D7D8D8S!D8D8D7D7J#8#J#8#
+9D7D7D8D8RKD8D8D7D7J#8"J#8#
+;D7D7D8RHD8D8D7D7J#<z=#
+=D7D7R>D8D7D7J#9"J$
+?D7D7D8RBD8D7D7IZ
+S4H"
+FFGz
+S8D9
+
+
+
+JU
+T+J"
+T4D8J(
+T-D9D9D9D9D9D9D8
+=z@u
+T$D8D8>z@t"
+T#D9D9FF>Z@T
+T#=z@u
+T$D9D9J'
+T-D8D8D8D8D8D8J"
+T,D8Ju
+T+D9
+
+Ez
+S<D1
+Gz=z
+S8D03D8J"J"
+SHFF9FFIz"@r"r"
+S4D1FFD7D8D7FFJ"
+T*FFJ"
+T,D8J"
+T)FFJ$
+T+D9D8D8J$
+T(FFFFD9J$
+T,D9D8D8J$
+T'FFFFD9J$
+T-D9D8D8J$
+T&FFFFD9J$
+T.D9D8D8J$
+T%FFFFD9J$
+T/D9D8D8J#u
+T$FFFFD8J"B"
+T%D8D8Jz
+T$/D7JZ
+T$/J"
+T2D8Jv"
+T&D9D8
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Jv
+T&D8J"
+T%D8Jz
+T$/D7JZ
+T$/J"C"
+T$D7D8Jt$
+T'D9D8D8D7J$
+T%D7FFFFJ$
+T/D8D8D7J$
+T&D7FFFFJ$
+T.D8D8D7J$
+T'D7FFFFJ$
+T-D8D8D7J$
+T(D7FFFFJ$
+T,D8D8D7J$
+T)D7FFD8J"
+T-D7J"
+T*D7J"
+T,D7IZAZ
+S4/H"J"
+FFS>FFGz=z
+S8D13D9
+Ez
+S<D9
+
+
+
+Gz
+S8D8J"
+SHFFIy#Z$x"
+D7FFD7RBD7FFFFD7FFJ$J"9#
+?FFFFD8RBD8FFFFJ%:z"<#
+=FFFFFFD8R>D9D8FFFFJ#8"J#8#
+;FFFFD9RHD9D9FFFFJ#8#J#8#
+9FFFFD9D9RKD9D9FFFFJ#8#J#8#
+7FFFFD9D9S!D9D9FFFFJ#8#J#8#
+5FFFFD9D9S%D9D9FFFFI'J&
+D8D8D8D8D9D9S)D9D8D8D8D8I#8#J"9"
+D7D7D8D8S)D8D7J#8#J#8#
+5D7D7D8D8S%D8D8D7D7J#8#J#8#
+7D7D7D8D8S!D8D8D7D7J#8#J#8#
+9D7D7D8D8RKD8D8D7D7J#8"J#8#
+;D7D7D8RHD8D8D7D7J#<z=#
+=D7D7R>D8D7D7J#9"J$
+?D7D7D8RBD8D7D7IZ
+S4H"
+FFGz
+S8D9
+
+
+JU
+T+J"
+T4D8J(
+T-D9D9D9D9D9D9D8
+=z@u
+T$D8D8>z@t"
+T#D9D9FF>Z@T
+T#=z@u
+T$D9D9J'
+T-D8D8D8D8D8D8J"
+T,D8Ju
+T+D9
+
+Ez
+S<D1
+Gz=z
+S8D03D8J"J"
+SHFF9FFIz"@r"r"
+S4D1FFD7D8D7FFJ"
+T*FFJ"
+T,D8J"
+T)FFJ$
+T+D9D8D8J$
+T(FFFFD9J$
+T,D9D8D8J$
+T'FFFFD9J$
+T-D9D8D8J$
+T&FFFFD9J$
+T.D9D8D8J$
+T%FFFFD9J$
+T/D9D8D8J#u
+T$FFFFD8J"B"
+T%D8D8Jz
+T$/D7JZ
+T$/J"
+T2D8Jv"
+T&D9D8
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Jv
+T&D8J"
+T%D8Jz
+T$/D7JZ
+T$/J"C"
+T$D7D8Jt$
+T'D9D8D8D7J$
+T%D7FFFFJ$
+T/D8D8D7J$
+T&D7FFFFJ$
+T.D8D8D7J$
+T'D7FFFFJ$
+T-D8D8D7J$
+T(D7FFFFJ$
+T,D8D8D7J$
+T)D7FFD8J"
+T-D7J"
+T*D7J"
+T,D7IZAZ
+S4/H"J"
+FFS>FFGz=z
+S8D13D9
+Ez
+S<D9
+
+
+
+Gz
+S8D8J"
+SHFFIy#Z$x"
+D7FFD7RBD7FFFFD7FFJ$J"9#
+?FFFFD8RBD8FFFFJ%:z"<#
+=FFFFFFD8R>D9D8FFFFJ#8"J#8#
+;FFFFD9RHD9D9FFFFJ#8#J#8#
+9FFFFD9D9RKD9D9FFFFJ#8#J#8#
+7FFFFD9D9S!D9D9FFFFJ#8#J#8#
+5FFFFD9D9S%D9D9FFFFI'J&
+D8D8D8D8D9D9S)D9D8D8D8D8I#8#J"9"
+D7D7D8D8S)D8D7'E#8#J#8#J&
+F7F7F7F7F7F7D7D7D8D8S%D8D8D7D7GF7F7F7F7F7'G#8#J#8#J'
+F6F6F6F6F6F6D7D7D8D8S!D8D8D7D7IF6F6F6F6F6F68%I#8#J#8#J&
+F9F9F9F9D7D7D8D8RKD8D8D7D7LF9F9F9F9F7J#8"J#8#
+;D7D7D8RHD8D8D7D7J#<z=#
+=D7D7R>D8D7D7J#9"J$
+?D7D7D8RBD8D7D7IZ
+S4H"
+FFGz
+S8D9
+
+
+
+
+
+
+
+
+=z"z"z
+0F6F7SCF6F71F6<z8z8z
+1F9SBF91F9
+
+
+7z8z8z
+6F7SBF75F7"J"J"
+F77F7SCF7
+ENDBITMAP
+%%EndBinary
+325.43 185.43 532.43 307.29 R
+7 X
+V
+4 8 Q
+0 X
+(panedwindow .pw -width 300 -height 500) 325.43 301.95 T
+(.pw add top) 325.43 291.95 T
+(.pw add bottom) 325.43 281.95 T
+(.pw insert 1 middle) 325.43 271.95 T
+(pack .pw -f) 325.43 261.95 T
+(ill both -expand yes) 378.23 261.95 T
+(foreach pane [.pw childsite] {) 325.43 241.95 T
+( scrolledlistbox $pane.slb \134) 325.43 231.95 T
+( -vscrollmode static \134) 325.43 221.95 T
+( -hscrollmode static) 325.43 211.95 T
+( pack $pane.slb -f) 325.43 201.95 T
+(ill both -expand yes) 426.23 201.95 T
+(}) 325.43 191.95 T
+0 10 Q
+(FIGURE 27) 368.71 146.32 T
+1 F
+( - Panedwindow) 420.1 146.32 T
+(Child Sites) 327.49 408.8 T
+447.31 453.58 459 456.29 450.52 447.79 448.91 450.68 4 Y
+V
+378 411.29 448.92 450.68 2 L
+N
+438.46 414.59 450 411.29 438.46 407.98 438.46 411.29 4 Y
+V
+378 411.29 438.46 411.29 2 L
+N
+441.97 375.2 450 366.29 438.46 369.6 440.22 372.4 4 Y
+V
+378 411.29 440.22 372.4 2 L
+N
+0 0 612 792 C
+FMENDPAGE
+%%EndPage: "14" 14
+%%Page: "15" 15
+612 792 0 FMBEGINPAGE
+[0 0 0 1 0 0 0]
+[ 0 1 1 0 1 0 0]
+[ 1 0 1 0 0 1 0]
+[ 1 1 0 0 0 0 1]
+[ 1 0 0 0 0 1 1]
+[ 0 1 0 0 1 0 1]
+[ 0 0 1 0 1 1 0]
+ 7 FrameSetSepColors
+FrameNoSep
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+(reach, the orientation of separators, the thickness of the) 72 713.33 T
+(separators, as well as the dimensions, position, and cur-) 72 701.33 T
+(sor associated with the sash.) 72 689.33 T
+0 12 Q
+(Combobox) 156.5 658 T
+1 10 Q
+(The combobox class is an enhanced entry \336eld widget) 72 633.33 T
+(with an optional associated label and a scrollable list.) 72 621.33 T
+(When an item is selected in the list area of a combobox) 72 609.33 T
+(it\325) 72 597.33 T
+(s value is then displayed in the entry \336eld text area.) 80.34 597.33 T
+(Functionally similar to an optionmenu, the combobox) 72 585.33 T
+(adds list scrolling, item editing and inserting capabili-) 72 573.33 T
+(ties.) 72 561.33 T
+(There are two basic styles of comboboxes, determined) 72 104.22 T
+(by the dropdown option, dropdown and simple. The) 72 92.22 T
+(dropdown style adds an arrow button to the right of the) 72 80.22 T
+72 124.89 297 558 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+72 146.43 297 548.57 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+81 152.57 288 341.57 R
+7 X
+V
+1 10 Q
+0 X
+(# Non-editable Dropdown Combobox) 81 334.9 T
+(combobox .cb1 -labeltext Month: \134) 81 322.9 T
+( -editable false -items {Jan Feb Mar \134) 81 310.9 T
+( Apr May June Jul Aug Sept Oct Nov Dec}) 81 298.9 T
+(# Editable Dropdown Combobox) 81 274.91 T
+(combobox .cb2 -labeltext \322Operating System:\323 \134) 81 262.91 T
+( -items {Linux HP-UX SunOS Solaris Irix}) 81 250.91 T
+(# Simple Combobox) 81 226.91 T
+(combobox .cb3 -labeltext Fonts: -labelpos nw \134) 81 214.91 T
+( -dropdown false -items [exec xlsfonts]) 81 202.91 T
+(pack .cb1 -padx 10 -pady 10 -\336ll x) 81 178.91 T
+(pack .cb2 -padx 10 -pady 10 -\336ll x) 81 166.91 T
+(pack .cb3 -padx 10 -pady 10 -\336ll x) 81 154.91 T
+%%BeginBinary: 38844
+329 407 157.92 195.36 0 108 347
+/red <
+C472FFFFFFFFFFFFFFFFFFFFFFFFFF66F5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+FFFFFFFFFFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBF808080
+8080808080808080808080808080808080808080804040404040404040404040
+4040404040404040404040400000000000000000000000002EAFB4CD73E6A2F5
+99FFFFB0B07AFFCC00878858D7439D50D080C0C080C08060C000FFA000FF20C0
+A0C0D060F0E010B499FFBE8B8BD900FFA0000000000039C069DD00FF00000033
+33330033CCDD9999112277005544FFCC66AABBFF33EE9999CC7AEFD3BF804040
+9765E1A36FE700FF55004DB2D272B36419BF2FFF6223852F465F4770FF0000FF
+> store
+/green <
+D79F0000000000000000000000000099DEFFFFFFBFBFBFBFBF80808080804040
+4040000000FFFFFFFFFFBFBFBFBF808080808040404040400000000000FFFFFF
+FFFFBFBFBFBFBF8080808040404040400000000000FFFFFFFFFFBFBFBFBFBF80
+808080804040400000000000FFFFFFBFBFBFBFBF808080408BEEEE0073E6A2F5
+99FFFF30B094FFF700CE8858D74DB38080C0C080C0808060C08000A080402070
+A020D0F0F0E010B489E4BE5B77D9FFFFA0404040400063E0B500996699FF0066
+3399BBFF99DD99FF112277005544CCCC66AABB6600EE6600CC69E3B5BF804040
+9765E1A36FE700FF1A004DB2B477B39519264F00B641DE4F829E4780FF0000FF
+> store
+/blue <
+FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFB3BF8040FFBF804000FFBF804000FFBF
+8000BF8040FFBF804000FF804000FFBF804000FFBF804000FFBF804000FFBF80
+4000FFBF804000FFBF4000FFBF804000FFBF804000FFBF804000FFBF804000FF
+BF804000FFBF00FFBF804000BF8040FFBF804000FFBF40FF57EEB40073E6A2F5
+6BFBB360B015322480FA8858D756CAD050C080C08080C060C080FF0000402070
+C020D06050E010B476C4BE7A65D900E0A0BF8040004063E0B500FF3399FF8866
+6666009966DDFFFF112277DD554499FFCCAABBCC99EE9966CC69E3B5BF808040
+9765E1A36FE7BFCC8BEE4DB28C85B3ED70264F00FC5AE050B4A0FF9000FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+6F6F7T&F6F76F6F7J"
+U%F78z8z8z
+4F9T%F94F9
+
+;z"
+TJF7F6<z"z"z"z
+0F6F7SCF6F70F6F70F6=z8z8z8z
+/F9SBF9/F9/F9
+J$C$
+Q+FEFEFEFEFEFEJ"E"Js"
+Q+F9F9Q&F6F7Jr
+TCF9J$:$9'8#<#;$<#;$9(
+P@FEFEFEFEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEF9FEFEFE@s"J18):.909$J$
+F6F7P+FEFEFEF9FEFEF9FEFEFEF9FEFEFEF9F9FEF9FEFEFEF9FEFEFEF9FEFEFEF9FEFEFEF9FEFEFEFEF9FEFEFEF9FEFEFEF9FEFEFEF9F9F9FEF9P/F6F6F7ArJ%9$<"9"=$;$;$;$:&J"
+F9P.F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9FEFEFEF9P1F9@sJ#
+F7T"F7F7@tJ%9$J";$=";$:&J$
+F9P-FEF9FEFEFEF9FE4FEFEF9FEFEFEF9FEFEF9F9FEFEP0F9F9F9J18"9"9"8/839"
+P>F9F9FEFEFEF9F9F9F9FEFEFEF9F9F9FEFEFEFEF9FEFEFEF9F9F9F9F9FEFEFEF9F9F9FEFEFEF9F9F9F9F9FEFEFEF9F9F9FEFEFEFEJ$:$9z;$9&;$9rJs
+P@F9F9F9F9F9F92F9F9F9F9F9F9F9F9F9F9F9F9F9P=F7Jt
+TBF9
+=z8z8z8z
+/F7SBF7/F7/F7rF"J"F"F%
+F7F7SCF7F7F7F7F7F7'z&
+F6F6F6F6F6F7TIADF6F6F6F6F68$J%
+F9F9F9TKF9F9F9F7
+
+
+
+
+
+
+
+
+
+J5=4
+O6RAFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEFFADFFADFFADFFADFFADFFADFFADFFADFFADFFJ5<5
+O5RBFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEAD4FFADFFADFFADFFADFFADFFADFFADFFADFFADFFADJ#z"<#z"
+O5ADFER?ADFFADFF1ADFEJ#J#<#F#
+O5FEADR>FFADFFADFEADJ#J#<#F#
+O5ADFER>ADFFADFFADFEJ#;#F#8#F#<"J#<#9u9#
+4FEFEFEFEFEFEFEFEFEADFER7FFADFFADFEFEADJ#J#<#9"B#
+O5ADFER>ADFFADFFADADFEJ"9":%8&8"8":#9#>#?"9"8%:$J#<#B"9#
+6FEFEFEFEFEFEFEFEADFEFEFEFEFEFEFEFEFEADFEFEFEADFEFEFEFEFER#FFADFFADADFEADJ'9'8"9%B#G%8&J#<#:"A#
+>FEFEADADFEFEFEADFEFEADADADFEADFEFEADFEFEADADFEFEADADADFER"ADFFADFFADADFEJ$C"A";#>#G"J#<#A":#
+7FEADFEADADADADFEADADR,FFADFFADADFEADJ"9"J#J$J#<#;"@#
+6ADADHADFE8FEFEFER#ADFFADFFADADFEJ"J#8"J%J#<#@";#
+8FEJFEADFE5ADADADADR"FFADFFADADFEADJ$J">#>#B"D"J#<#<"?#
+7ADFEAD6FEFEFEADFEFEFER"ADFFADFFADADFEJ'?%H#8&8%@&J#<#?"<#
+>ADFEFEFEFEADADFEFEADFEADADFEFEFEADADFEFEADADFEFEFEADR"FFADFFADADFEADJ#8"8#8%8#8#9&8#8#>#9$:%8"9"9$J#<#=">#
+4ADADADADADADADADADADADADADADADADADADADADADADADFEADADADADADADADADADADADADR#ADFFADFFADADFEJ#J#<#>"=#
+O5FEADR>FFADFFADADFEADJ#J#<#F#
+O5ADFER>ADFFADFFADFEJ#J#<#F#
+O5FEADR>FFADFFADFEADJ5<5
+O5RBADFEADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFF4ADFFADFEADFEADFEADFEADFEADFEADFEADFEADFEJ5<5
+O5RBFEADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFAD4FFADFEADFEADFEADFEADFEADFEADFEADFEADFEADJz=z
+O5RAAD3AD
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+J5=4
+Q"Q'FEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEFFADFFADFFADFFADFFADFFADFFADFFADFFADFFJ5<5
+Q!Q(FEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEAD4FFADFFADFFADFFADFFADFFADFFADFFADFFADFFADJ#z"<#z"
+Q!ADFEQ%ADFFADFF1ADFEJ#J#<#F#
+Q!FEADQ$FFADFFADFEADJ#J#<#F#
+Q!ADFEQ$ADFFADFFADFEJ%J#8#J&H#J#8"<"J#<#9u9#
+6FEFEFEFE>FEFEFEFE5FEFEFEFEFEFEFE?FEADFEFEPHFFADFFADFEFEADJ'J#J(J#?"J#<#9"B#
+5FEFEADADFEFEAADAD4FEFEADADADFEFEO$ADFEADPHADFFADFFADADFEJ$8*9%8+8"8+9&D#9#8%8"8"8%8*9#>#?"8%9"9$:"J#<#B"9#
+4FEFEADADFEFEADFEFEADFEFEFEFEFEFEFEFEADFEFEADFEFEFEFEFEFEADFEFEADFEFEADFEFEFEFEADFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEFEFEADFEFEFEFEFEFEADFEFEADFEFEFEFEADFEFEP3FFADFFADADFEADJ,9"8)8"<*>(?)8)8*B#C%>#8#J#<#:"A#
+?FEADFEFEADFEFEADADFEFEFEFEFEADADFEFEADADADFEADFEFEADFEFEADFEADFEFEFEADADADFEFEADADFEFEADADADADFEFEADADFEFEFEADADFEFEADADFEFEADFEFEADADFEADFEFEADP3ADFFADFFADADFEJ"D%E"="?&8(9%J#>#C"B%J#<#A":#
+?ADADADADADADADADADFEFEFEADFEFEADFEFEADFEADADAD9ADADFEADADADFEFEADP4FFADFFADADFEADJ#;"9$J"8"?&?#J#J#<#;"@#
+FFEFEADFEFEFEAADFEADADFEFEFEFEFE9ADFEQ$ADFFADFFADADFEJ%<%J#8":&:"8">%J#J%J#<#@";#
+FADADADADFEFEADAD>FEFEADADFEFEFEADADFEADADADAD7FEAD:FEADADFEP4FFADFFADADFEADJ$8$9">#G"C"J%=":#C#>#J"8#8#J#<#<"?#
+4ADFEFEFEFEADFEFEFEFEFE8FEFEADADFEFEFEFEFEADFE6FEFEADADFEP3ADFFADFFADADFEJ':,<-@%>(9";'8+J#9%B%J#<#?"<#
+5ADFEFEFEFEADADFEFEADADADFEFEFEFEADADFEFEFEADFEFEADADFEFEADADFEFEADADFEFEFEFEFEADADADFEFEFEFEADADFEFEADADFEFEFEFEAD7FEADFEFEFEFEADFEFEADP;FFADFFADADFEADJ%<#9%8#:'8s8#8#@&<":%:#8%8#8#8#8#>#8&8"8"9"9':"J#<#=">#
+6ADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADFEADADADADADADADADADADADADADADADP3ADFFADFFADADFEJ#J"J#J#<#>"=#
+O8FEFE4FEO FEADQ$FFADFFADADFEADJ'E$J#J#<#F#
+O8ADFEFEFEFEADFEFEADMADFEQ$ADFFADFFADFEJ#J%F#J#J#<#F#
+=ADADHADADADADADADO FEADQ$FFADFFADFEADJ5<5
+Q!Q(ADFEADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFF4ADFFADFEADFEADFEADFEADFEADFEADFEADFEADFEJ5<5
+Q!Q(FEADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFAD4FFADFEADFEADFEADFEADFEADFEADFEADFEADFEADJz=z
+Q!Q'AD3AD
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Js$
+4FEADFEFEJ'
+6ADADADADADADJ#;%9%9#
+:FEFEFEFEFEFEFEFEFEFEFEFEJ.
+@FEFEADADFEFEADFEFEADADFEFEJ$F%8#
+6FEFEFEFEADADADADADJ$?#9&
+6ADADADFEFEADADFEFEFEJ%9"8"
+BADADADADADFEJ(:#
+DFEFEADFEFEADADFEFEJ.
+@ADFEFEFEFEADADADFEFEFEFEADJ#:&8%9%9#
+4ADADADADADADADADADADADADADADADADAD
+
+
+
+
+
+
+
+
+I5
+T/FEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEH5
+T0FEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADH#z"
+ADFET-ADFFH#J#
+FEADT,FFADH#J#
+ADFET,ADFFH#J#
+FEADT,FFADH#J#
+ADFET,ADFFH#J#
+FEADT,FFADH#J#
+ADFET,ADFFH#J#
+FEADT,FFADH#J#
+ADFET,ADFFH#J#
+FEADT,FFADH#J#
+ADFET,ADFFH#J#
+FEADT,FFADH#J#
+ADFET,ADFFH#J#
+FEADT,FFADH#J#
+ADFET,ADFFH#J#
+FEADT,FFADH5
+T0ADFEADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFH5
+T0FEADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADHz
+T/AD
+
+
+
+
+I5?2
+SCFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEFEADFEADFEADFEADFEADFEADFEADFEADFEH5=4
+SEFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFFFEADFEADFEADFEADFEADFEADFEADFEADFEADFFH#z#=#r"r#
+ADFESAADFFADADFE98FE98FFADH#J#=#<#=#
+FEADSAADFFFEADFFADADFFH#J#=#<$<#
+ADFESAFFADADFEADFEADFFADH#J"?"J"J"C"<"J"I$B$C";$:$C"8#=#;%<#
+FEAD4FEFEO FE5FEFEFEO-FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADFFFEADADFFADFEADFFH#J"J&@&@#;&8&@#9#=#;&;#
+ADFEO?ADP=FEADADADFEFEADADADFEFEFEFEADADADFEFEADADADFEFEFEFFADADFEFFADADADFEFFADH#@$:#;$;#:$B$:$9"9"8&9$9$A#:$=#C$A%:$9(8":$J#J#9#=#:#8#;#
+FEADFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEADFEFEFEFEFEADFEFEFEFEFEFEFEFEFEFEFEFEADFEFEFEFEFEFEADFEADFEADFEFEFEFEFEO&ADAD;ADADADFFFEADFFADFEADADFFH#?&8%9&9%8&@&8&@#:&9#@%8&;%A&A%8&9#8'8&J#=#:#8$:#
+ADFEFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADADFEFEADADADFEFEADFEADADADFEFEADFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADFEADFEFEADFEFEADADADFEOGFFADADFEADFFADFEADFFADH#?"?"A"J"G"C"A"H"J"C"9"8":"J#=#9$9#:#
+FEADADADAD8ADADADADAD;ADADADADADOKADFFFEADADFFADADFEADFFH):$J$9&J$=&J&@&J$<&9&@&@&J&>#=#9#;#9#
+ADFEADFEFEFEFEFEFEFEFE9FEFEFEFEFEFEFEFE@FEFEFEFEFEFEFEFE;FEFEFEFEFEFEFEFEFEFE?FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFE8FEFEFEFEFEFFADADFEFFADADFEFFADH"r9%J%8&J%<&J&@&J%<&9&@&@&J&>#=#8#<#9#
+FEADFEADADAD9ADADADADADADADADAD@ADADADADADADADADAD;ADADADADADADADADADAD>FEADADADADADADADADADADADADADADADADADADADADADADAD8ADADADADADADFFFEADFFADFEADADFFH#I"A"?"D"B"D"E"H"J#=#8#<$8#
+ADFEFEFEFEFEFEFEFEFEQ%FFADADFEADFFADFEADFFADH#?,9&9%8&@&8&8%@&E%8&;%A&G&E'J&@&G&8&E#='=#8#
+FEADADFEFEFEADFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADFE4ADFEFEFEADADFEFEFEADADFEFEFEADADFEFEFEADADFFFEAD98ADFFADADFEADFFH#@&8%9$9%:$B$:$:%8"9"9$9"A%:$9"9%A$A"9"9$9"9"8"8"9rI$B$C";$:$C"8#=&?&
+ADFEADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADFFADADFE98FFADADFE98FFADH#J#=4
+FEADSAADFFFEADFFADFEADFEADFEADFEADFEADFEAD98ADFFH#J#=4
+ADFESAFFADADFEADFEADFEADFEADFEADFEADFEADFEADFFADH#J#=#z#
+FEADSAADFFFEAD/98ADFFH#J#=4
+ADFESAFFADADFEADFFADFFADFFADFFADFFADFFADFFADFFADH#J#=4
+FEADSAADFFFEADFFADFFADFFADFFADFFADFFADFFADFEADFFH#J#=%v%
+ADFESAFFADADFEADFFADFEADFFADH#J#=4
+FEADSAADFFFEADFFADFEADFEADFEADFEADFEADFEADFEADFFH#J"?"J"J"C"<"J"I$B$A&8&@&8(=4
+ADFE4FEFEO FE5FEFEFEO-FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFADADFEADFEADFEADFEADFEADFEADFEADFEADFFADH#J"J&@&@%:%@%:'=#z#
+FEADO?ADP=FEADADADFEFEADADADFEADADADADADADADADADADADADADADADADADFFFEAD/98ADFFH#@$:#;$;#:$B$:$9"9"8&9$9$A#:$=#C$A%:$9(8":$J#J#=#=#E#
+ADFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEADFEFEFEFEFEADFEFEFEFEFEFEFEFEFEFEFEFEADFEFEFEFEFEFEADFEADFEADFEFEFEFEFEO)FEAD4FEADFFADADFEFFADH#?&8%9&9%8&@&8&@#:&9#@%8&;%A&A%8&9#8'8&J$I'=#E#
+FEADFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADADFEFEADADADFEFEADFEADADADFEFEADFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADFEADFEFEADFEFEADADADFEO-FEFEFEFEFEFEADADFFFEADADFFH#?"?"A"J"G"C"A"H"J"C"9"8":"J#9&B#9(=#E#
+ADFEADADAD8ADADADADAD;ADADADADADO+FEADADADADADFEFEADADADADADFEFFADADFEFFADH):$J$9&J$=&J&@&J$<&9&@&@&G&E#=#E#
+FEADADFEFEFEFEFEFEFEFE9FEFEFEFEFEFEFEFE@FEFEFEFEFEFEFEFE;FEFEFEFEFEFEFEFEFEFE?FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADFFFEADADFFH)9%J%8&J%<&J&@&J%<&9&@&@&@"<&@":#=#E#
+ADFEADADADADADADFEADADAD9ADADADADADADADADAD@ADADADADADADADADAD;ADADADADADADADADADAD>FEADADADADADADADADADADADADADADADADADADADADADADADFEADADADADADFEFFADADFEFFADH#I"A"?"D"B"D"E"H"J#J#?#=#E#
+FEADFEFEFEFEFEFEFEFEP2FEAD4FEADADFFFEADADFFH#?,9&9%8&@&8&8%@&E%8&;%A&G&E'J&@&G&G(=#E#
+ADFEADFEFEFEADFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADFE4ADFEFEFEADADFEFEFEADADFEFEFEADADFEFEFEADFFADADFEFFADH#@&8%9$9%:$B$:$:%8"9"9$9"A%:$9"9%A$A"9"9$9"9"8"8"9rI$B$B"<$B"<'=#E#
+FEADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J"?"J"J"C"<"J"J";$C";$:$A&8)=#E#
+FEAD4FEFEO FE5FEFEFEO-FE4FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADADFFFEADADFFH#J"J#;&@#;&8&@%:(=#E#
+ADFEO?ADP=FEFEFEADADADFEFEFEFEADADADFEFEADADADFEADADADADADADADADADFFADADFEFFADH#@$:#;$;#:$B$:$9"9"8&9$9$A#:$=#C$A%:$9(8":$J#J#J#>#=#E#
+FEADFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEADFEFEFEFEFEADFEFEFEFEFEFEFEFEFEFEFEFEADFEFEFEFEFEFEADFEADFEADFEFEFEFEFE6ADAD4ADAD>FEADADFFFEADADFFH#?&8%9&9%8&@&8&@#:&9#@%8&;%A&A%8&9#8'8&J$8#=#E#
+ADFEFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADADFEFEADADADFEFEADFEADADADFEFEADFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADFEADFEFEADFEFEADADADFEOBFEFEFEFFADADFEFFADH#?"?"A"J"G"C"A"H"J"C"9"8":"J#9)=#E#
+FEADADADAD8ADADADADAD;ADADADADADO@FEADADADADADFEADADFFFEADADFFH):$J$9&J$=&J&@&J$<&9&G&J&F#=#E#
+ADFEADFEFEFEFEFEFEFEFE9FEFEFEFEFEFEFEFE@FEFEFEFEFEFEFEFE;FEFEFEFEFEFEFEFEFEFE?FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFE8FEFEFEFEFEFFADADFEFFADH"r9%J%8&J%<&J&@&J%<&9&G&J&@";#=#E#
+FEADFEADADAD9ADADADADADADADADAD@ADADADADADADADADAD;ADADADADADADADADADAD>FEADADADADADADADADADADADADADADADADADAD8ADADADADADFEADFFFEADADFFH#I"A"?"D"B"D"E"H"J#@#=#E#
+ADFEFEFEFEFEFEFEFEFEPGFEADFFADADFEFFADH#?,9&9%8&@&8&8%@&E%8&;%A&G&E'J&G&8&G)=#E#
+FEADADFEFEFEADFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADFE;ADFEFEFEADADFEFEFEADADFEFEFEADADFEFEFEADADADFFFEADADFFH#@&8%9$9%:$B$:$:%8"9"9$9"A%:$9"9%A$A"9"9$9"9"8"8"9rJ";$C";$:$B"<$8#=#E#
+ADFEADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADAD4ADADADADADADADADADADADADADADADFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J"?"J"J"C"<"J"J"<"C$:$C";$:$8#=#E#
+ADFE4FEFEO FE5FEFEFEO-FE4FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFADADFEFFADH#J"J#;#C&8&@#;&8)=#E#
+FEADO?ADP=FEFEFEFEFEADADADFEFEADADADFEFEFEFEADADADFEFEADADADFEADADFFFEADADFFH#@$:#;$;#:$B$:$9"9"8&9$9$A#:$=#C$A%:$9(8":$J#;#J#H#=#E#
+ADFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEADFEFEFEFEFEADFEFEFEFEFEFEFEFEFEFEFEFEADFEFEFEFEFEFEADFEADFEADFEFEFEFEFE6ADADADADCADADFFADADFEFFADH#?&8%9&9%8&@&8&@#:&9#@%8&;%A&A%8&9#8'8&J&J#=#E#
+FEADFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADADFEFEADADADFEFEADFEADADADFEFEADFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADFEADFEFEADFEFEADADADFEKADFEFEFEADEADFFFEADADFFH#?"?"A"J"G"C"A"H"J"C"9"8":"J&J#=#E#
+ADFEADADAD8ADADADADAD;ADADADADADO!FEADADADFEEFFADADFEFFADH):$J$9&J$=&J&@&J$<&9&G&G&J#=#E#
+FEADADFEFEFEFEFEFEFEFE9FEFEFEFEFEFEFEFE@FEFEFEFEFEFEFEFE;FEFEFEFEFEFEFEFEFEFE?FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFE7ADFFFEADADFFH)9%J%8&J%<&J&@&J%<&9&G&G&J#=#E#
+ADFEADADADADADADFEADADAD9ADADADADADADADADAD@ADADADADADADADADAD;ADADADADADADADADADAD>FEADADADADADADADADADADADADADADADADADADADADADADAD7FFADADFEFFADH#I"A"?"D"B"D"E"H"J#=#E#
+FEADFEFEFEFEFEFEFEFEQ%ADFFFEADADFFH#?,9&9%8&@&8&8%@&E%8&;%A&G&E'J&8&G&8)=#E#
+ADFEADFEFEFEADFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADFEJADFEFEFEADADFEFEFEADADFEFEFEADADFEFEFEADADFFADADFEFFADH#@&8%9$9%:$B$:$:%8"9"9$9"A%:$9"9%A$A"9"9$9"9"8"8"9rJ"<"C$:$C";$:$8#=#E#
+FEADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADAD4ADADADADADADADADADADADADADADADADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J"?"J"J"C"<"J"J";$C";$:$A&8)=#E#
+FEAD4FEFEO FE5FEFEFEO-FE4FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADADFFFEADADFFH#J"J#;&@#;&8&@%:(=#E#
+ADFEO?ADP=FEFEFEADADADFEFEFEFEADADADFEFEADADADFEADADADADADADADADADFFADADFEFFADH#@$:#;$;#:$B$:$9"9"8&9$9$A#:$=#C$A%:$9(8":$J#;"D#;"J#>#=#E#
+FEADFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEADFEFEFEFEFEADFEFEFEFEFEFEFEFEFEFEFEFEADFEFEFEFEFEFEADFEADFEADFEFEFEFEFE6ADADADADADAD8FEADADFFFEADADFFH#?&8%9&9%8&@&8&@#:&9#@%8&;%A&A%8&9#8'8&J#J#J$8#=#E#
+ADFEFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADADFEFEADADADFEFEADFEADADADFEFEADFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADFEADFEFEADFEFEADADADFE?FEAD4FEAD9FEFEFEFFADADFEFFADH#?"?"A"J"G"C"A"H"J"C"9"8":"J#J#J#9)=#E#
+FEADADADAD8ADADADADAD;ADADADADADBFEAD4FEAD4FEADADADADADFEADADFFFEADADFFH):$J$9&J$=&J&@&J$<&9&A#:&A#A&F#=#E#
+ADFEADFEFEFEFEFEFEFEFE9FEFEFEFEFEFEFEFE@FEFEFEFEFEFEFEFE;FEFEFEFEFEFEFEFEFEFE?FEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEFEFEFEFEFEADFEFEFEFEFEFFADADFEFFADH"r9%J%8&J%<&J&@&J%<&9&@#;&@#B&@";#=#E#
+FEADFEADADAD9ADADADADADADADADAD@ADADADADADADADADAD;ADADADADADADADADADAD>FEADADADADADADADADADADADADADFEADADADADADADFEADADADADADADFEADFFFEADADFFH#I"A"?"D"B"D"E"H"J#@#=#E#
+ADFEFEFEFEFEFEFEFEFEPGFEADFFADADFEFFADH#?,9&9%8&@&8&8%@&E%8&;%A&G&E'J%H%8&G)=#E#
+FEADADFEFEFEADFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADFE<FEFEFEFEFEFEFEFEADFEFEFEADADFEFEFEADADADFFFEADADFFH#@&8%9$9%:$B$:$:%8"9"9$9"A%:$9"9%A$A"9"9$9"9"8"8"9rJ":&B":&9$B"<$8#=#E#
+ADFEADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADAD4ADADADADADADADADADADADADADADADADADADADFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J"?"J"J"C"<"J"J"="C";$:$C";$8#=#E#
+ADFE4FEFEO FE5FEFEFEO-FE4FEFEFEFEFEFEFEFEFEFEFEFEFEFFADADFEFFADH#J"J#="B#;&8&@#;)=#E#
+FEADO?ADP=FEFEFEFEFEFEADADADFEFEADADADFEFEFEFEADADADFEADADFFFEADADFFH#@$:#;$;#:$B$:$9"9"8&9$9$A#:$=#C$A%:$9(8":$J#<#B#J#A#=#E#
+ADFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEADFEFEFEFEFEADFEFEFEFEFEFEFEFEFEFEFEFEADFEFEFEFEFEFEADFEADFEADFEFEFEFEFE6ADADFEADADAD;ADADFFADADFEFFADH#?&8%9&9%8&@&8&@#:&9#@%8&;%A&A%8&9#8'8&J#=#E#
+FEADFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADADFEFEADADADFEFEADFEADADADFEFEADFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADFEADFEFEADFEFEADADADFEOGADFFFEADADFFH#?"?"A"J"G"C"A"H"J"C"9"8":"J#J#=#E#
+ADFEADADAD8ADADADADAD;ADADADADAD@FEADO)FFADADFEFFADH):$J$9&J$=&J&@&J$<&9&?#<&J&F#=#E#
+FEADADFEFEFEFEFEFEFEFE9FEFEFEFEFEFEFEFE@FEFEFEFEFEFEFEFE;FEFEFEFEFEFEFEFEFEFE?FEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEFEFEFEFE8FEFEFEFEFEADFFFEADADFFH)9%J%8&J%<&J&@&J%<&9&@&8&J&F#=#E#
+ADFEADADADADADADFEADADAD9ADADADADADADADADAD@ADADADADADADADADAD;ADADADADADADADADADAD>FEADADADADADADADADADADADADADFEFEFEFEFEADADADADAD8ADADADADADFFADADFEFFADH#I"A"?"D"B"D"E"H"J'J#=#E#
+FEADFEFEFEFEFEFEFEFEOGADADADADFEADO&ADFFFEADADFFH#?,9&9%8&@&8&8%@&E%8&;%A&G&E'J&8&G)=#E#
+ADFEADFEFEFEADFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADFEO#ADFEFEFEADADFEFEFEADADFEFEFEADADFFADADFEFFADH#@&8%9$9%:$B$:$:%8"9"9$9"A%:$9"9%A$A"9"9$9"9"8"8"9rJ"="C";$:$C";$8#=#E#
+FEADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADAD4ADADADADADADADADADADADADADADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J"?"J"J"C"<"J"J"="C"=":$A&8)=#E#
+FEAD4FEFEO FE5FEFEFEO-FE4FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADADFFFEADADFFH#J"J#="B#=":&@%:(=#E#
+ADFEO?ADP=FEFEFEFEFEFEFEADADADFEADADADADADADADADADFFADADFEFFADH#@$:#;$;#:$B$:$9"9"8&9$9$A#:$=#C$A%:$9(8":$J#<#B#<#J#>#=#E#
+FEADFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEADFEFEFEFEFEADFEFEFEFEFEFEFEFEFEFEFEFEADFEFEFEFEFEFEADFEADFEADFEFEFEFEFE6ADADFEADADADFEAD6FEADADFFFEADADFFH#?&8%9&9%8&@&8&@#:&9#@%8&;%A&A%8&9#8'8&J$8#=#E#
+ADFEFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADADFEFEADADADFEFEADFEADADADFEFEADFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADFEADFEFEADFEFEADADADFEOBFEFEFEFFADADFEFFADH#?"?"A"J"G"C"A"H"J"C"9"8":"J#J#J#9)=#E#
+FEADADADAD8ADADADADAD;ADADADADAD@FEAD4FEAD6FEADADADADADFEADADFFFEADADFFH):$J$9&J$=&J&@&J$<&9&?#<&?#C&F#=#E#
+ADFEADFEFEFEFEFEFEFEFE9FEFEFEFEFEFEFEFE@FEFEFEFEFEFEFEFE;FEFEFEFEFEFEFEFEFEFE?FEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEFEFEFEFEFEADFEFEFEFEFEFFADADFEFFADH"r9%J%8&J%<&J&@&J%<&9&@&8&@&?&@";#=#E#
+FEADFEADADAD9ADADADADADADADADAD@ADADADADADADADADAD;ADADADADADADADADADAD>FEADADADADADADADADADADADADADFEFEFEFEFEADADADADADFEFEFEFEFEADADADADADFEADFFFEADADFFH#I"A"?"D"B"D"E"H"J'F'H#@#=#E#
+ADFEFEFEFEFEFEFEFEFEOGADADADADFEADADADADADFEADFEADFFADADFEFFADH#?,9&9%8&@&8&8%@&E%8&;%A&G&E'J&G)=#E#
+FEADADFEFEFEADFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADFEO*ADFEFEFEADADFEFEFEADADADFFFEADADFFH#@&8%9$9%:$B$:$:%8"9"9$9"A%:$9"9%A$A"9"9$9"9"8"8"9rJ"="C"=":$B"<$8#=#E#
+ADFEADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADAD4ADADADADADADADADADADADFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J"?"J"J"C"<"J"J":&B";$:$C";$8#=#E#
+ADFE4FEFEO FE5FEFEFEO-FE4FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFADADFEFFADH#J"J#;%A#;&8&@#;)=#E#
+FEADO?ADP=FEFEADADADADFEFEFEADADADFEFEADADADFEFEFEFEADADADFEADADFFFEADADFFH#@$:#;$;#:$B$:$9"9"8&9$9$A#:$=#C$A%:$9(8":$J#>#@#;"J#A#=#E#
+ADFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEADFEFEFEFEFEADFEFEFEFEFEFEFEFEFEFEFEFEADFEFEFEFEFEFEADFEADFEADFEFEFEFEFE6ADADFEADADADAD5ADADFFADADFEFFADH#?&8%9&9%8&@&8&@#:&9#@%8&;%A&A%8&9#8'8&J#J#=#E#
+FEADFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADADFEFEADADADFEFEADFEADADADFEFEADFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADFEADFEFEADFEFEADADADFEO'FEAD>ADFFFEADADFFH#?"?"A"J"G"C"A"H"J"C"9"8":"J#J#J#=#E#
+ADFEADADAD8ADADADADAD;ADADADADADBFEAD4FEAD?FFADADFEFFADH):$J$9&J$=&J&@&J$<&9&G&A#A&F#=#E#
+FEADADFEFEFEFEFEFEFEFE9FEFEFEFEFEFEFEFE@FEFEFEFEFEFEFEFE;FEFEFEFEFEFEFEFEFEFE?FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEFEFEFEFEADFFFEADADFFH)9%J%8&J%<&J&@&J%<&9&G&@#B&F#=#E#
+ADFEADADADADADADFEADADAD9ADADADADADADADADAD@ADADADADADADADADAD;ADADADADADADADADADAD>FEADADADADADADADADADADADADADADADADADADFEADADADADADADFFADADFEFFADH#I"A"?"D"B"D"E"H"J#J#=#E#
+FEADFEFEFEFEFEFEFEFEOIFEADO(ADFFFEADADFFH#?,9&9%8&@&8&8%@&E%8&;%A&G&E'J%8&G)=#E#
+ADFEADFEFEFEADFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADFEO$FEFEFEFEADFEFEFEADADFEFEFEADADFFADADFEFFADH#@&8%9$9%:$B$:$:%8"9"9$9"A%:$9"9%A$A"9"9$9"9"8"8"9rJ";"E":&9$C";$8#=#E#
+FEADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADAD4ADADADADADADADADADADADADADADADADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J"?"J"J"C"<"J"J";$C";$:$A&8)=#E#
+FEAD4FEFEO FE5FEFEFEO-FE4FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADADFFFEADADFFH#J"J#;&@#;&8&@%:(=#E#
+ADFEO?ADP=FEFEFEADADADFEFEFEFEADADADFEFEADADADFEADADADADADADADADADFFADADFEFFADH#@$:#;$;#:$B$:$9"9"8&9$9$A#:$=#C$A%:$9(8":$J#J#J#>#=#E#
+FEADFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEADFEFEFEFEFEADFEFEFEFEFEFEFEFEFEFEFEFEADFEFEFEFEFEFEADFEADFEADFEFEFEFEFE6ADAD4ADAD>FEADADFFFEADADFFH#?&8%9&9%8&@&8&@#:&9#@%8&;%A&A%8&9#8'8&J&G&J$8#=#E#
+ADFEFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADADFEFEADADADFEFEADFEADADADFEFEADFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADFEADFEFEADFEFEADADADFE<ADFEFEFEADADFEFEFEAD9FEFEFEFFADADFEFFADH#?"?"A"J"G"C"A"H"J"C"9"8":"J&G&I#9)=#E#
+FEADADADAD8ADADADADAD;ADADADADAD@FEADADADFEFEADADADFEFEADADADADADFEADADFFFEADADFFH):$J$9&J$=&J&@&J$<&9&G&J&F#=#E#
+ADFEADFEFEFEFEFEFEFEFE9FEFEFEFEFEFEFEFE@FEFEFEFEFEFEFEFE;FEFEFEFEFEFEFEFEFEFE?FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFE8FEFEFEFEFEFFADADFEFFADH"r9%J%8&J%<&J&@&J%<&9&G&J&@";#=#E#
+FEADFEADADAD9ADADADADADADADADAD@ADADADADADADADADAD;ADADADADADADADADADAD>FEADADADADADADADADADADADADADADADADADAD8ADADADADADFEADFFFEADADFFH#I"A"?"D"B"D"E"H"J#@#=#E#
+ADFEFEFEFEFEFEFEFEFEPGFEADFFADADFEFFADH#?,9&9%8&@&8&8%@&E%8&;%A&G&E'J&G&8&G)=#E#
+FEADADFEFEFEADFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADFE;ADFEFEFEADADFEFEFEADADFEFEFEADADFEFEFEADADADFFFEADADFFH#@&8%9$9%:$B$:$:%8"9"9$9"A%:$9"9%A$A"9"9$9"9"8"8"9rJ";$C";$:$B"<$8#=#E#
+ADFEADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADAD4ADADADADADADADADADADADADADADADFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J"?"J"J"C"<"J"I$:$C"=":$C";$8#=#E#
+ADFE4FEFEO FE5FEFEFEO-FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFADADFEFFADH#J"J&8&@#=":&@#;)=#E#
+FEADO?ADP=FEADADADFEFEADADADFEFEFEFEFEADADADFEFEFEFEADADADFEADADFFFEADADFFH#@$:#;$;#:$B$:$9"9"8&9$9$A#:$=#C$A%:$9(8":$J"J#<#I#A#=#E#
+ADFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEADFEFEFEFEFEADFEFEFEFEFEFEFEFEFEFEFEFEADFEFEFEFEFEFEADFEADFEADFEFEFEFEFE6AD5ADADFEADADADFFADADFEFFADH#?&8%9&9%8&@&8&@#:&9#@%8&;%A&A%8&9#8'8&J#J#=#E#
+FEADFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADADFEFEADADADFEFEADFEADADADFEFEADFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADFEADFEFEADFEFEADADADFE8FEADO-ADFFFEADADFFH#?"?"A"J"G"C"A"H"J"C"9"8":"J#J#J#=#E#
+ADFEADADAD8ADADADADAD;ADADADADAD;FEAD9FEADAFFADADFEFFADH):$J$9&J$=&J&@&J$<&9&:#A&?#C&F#=#E#
+FEADADFEFEFEFEFEFEFEFE9FEFEFEFEFEFEFEFE@FEFEFEFEFEFEFEFE;FEFEFEFEFEFEFEFEFEFE?FEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEFEFEFEFEFEADFEFEFEFEFEADFFFEADADFFH)9%J%8&J%<&J&@&J%<&9&9#B&@&?&F#=#E#
+ADFEADADADADADADFEADADAD9ADADADADADADADADAD@ADADADADADADADADAD;ADADADADADADADADADAD>FEADADADADADADADADADADADADADFEADADADADADADFEFEFEFEFEADADADADADFFADADFEFFADH#I"A"?"D"B"D"E"H"J'J#=#E#
+FEADFEFEFEFEFEFEFEFEP/ADADADADFEAD>ADFFFEADADFFH#?,9&9%8&@&8&8%@&E%8&;%A&G&E'J%8&J&G)=#E#
+ADFEADFEFEFEADFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADFE5FEFEFEFEADFEFEFEAD8ADFEFEFEADADFEFEFEADADFFADADFEFFADH#@&8%9$9%:$B$:$:%8"9"9$9"A%:$9"9%A$A"9"9$9"9"8"8"9rH&9$C"=":$C";$8#=#E#
+FEADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=#E#
+FEADSAADFFFEADADFFH#J#=#E#
+ADFESAFFADADFEFFADH#J#=4
+FEADSAADFFFEADFFADFFADFFADFFADFFADFFADFFADFFADFFH#J#=4
+ADFESAFFADADFE98FFADFFADFFADFFADFFADFFADFFADFFADH#J"?"J"J"C"<"J"I$<"B$<":$A&8)=&t&
+FEAD4FEFEO FE5FEFEFEO-FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADADFFFEAD98ADFFADFEAD98ADFFH#J"J&:"B&:":&@%:(='>&
+ADFEO?ADP=FEADADADFEFEFEADADADFEFEFEADADADFEADADADADADADADADADFFADADFE9898ADFFADFE98FFADH#@$:#;$;#:$B$:$9"9"8&9$9$A#:$=#C$A%:$9(8":$J"=#B"=#J#>#=#8#>&
+FEADFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEADFEFEFEFEFEADFEFEFEFEFEFEFEFEFEFEFEFEADFEFEFEFEFEFEADFEADFEADFEFEFEFEFE6ADFEADADFEAD6FEADADFFFEADFFADFE9898ADFFH#?&8%9&9%8&@&8&@#:&9#@%8&;%A&A%8&9#8'8&J#J#J$8#=#8#=#8#
+ADFEFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADADFEFEADADADFEFEADFEADADADFEFEADFEADADFEFEADADADFEFEADADFEFEADADADFEFEADADFEFEADADADFEFEADFEADFEFEADFEFEADADADFE8FEAD4FEAD@FEFEFEFFADADFE98FFFEADFFADH#?"?"A"J"G"C"A"H"J"C"9"8":"J#9#E#9#J#9)=#9#;$8#
+FEADADADAD8ADADADADAD;ADADADADAD;FEADFEADFEADFEAD6FEADADADADADFEADADFFFEADADFFFEAD98ADFFH):$J$9&J$=&J&@&J$<&9&:#9#<&:#9#C&F#=#9$:#9#
+ADFEADFEFEFEFEFEFEFEFE9FEFEFEFEFEFEFEFE@FEFEFEFEFEFEFEFE;FEFEFEFEFEFEFEFEFEFE?FEFEFEFEFEFEFEFEFEFEFEFEFEFEADFEADFEFEFEFEFEFEADFEADFEFEFEFEFEFFADADFE98ADFFADFEFFADH"r9%J%8&J%<&J&@&J%<&9&9#;&8&9#;&?&@";#=#:#:#9#
+FEADFEADADAD9ADADADADADADADADAD@ADADADADADADADADAD;ADADADADADADADADADAD>FEADADADADADADADADADADADADADFEADFEFEFEFEFEADADADADADFEADFEFEFEFEFEADADADADADFEADFFFEADFFADFE98ADFFH#I"A"?"D"B"D"E"H"J'F'H#@#=#:#9#:#
+ADFEFEFEFEFEFEFEFEFEOGADADADADFEADADADADADFEADFEADFFADADFE98FFFEADFFADH#?,9&9%8&@&8&8%@&E%8&;%A&G&E'J%H%?&G)=#;':#
+FEADADFEFEFEADFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEADADFEFEFEADADFEFEFEADADFEFEFEADFE5FEFEFEFEFEFEFEFEADFEFEFEADADFEFEFEADADADFFFEADADFFADFEAD98ADFFH#@&8%9$9%:$B$:$:%8"9"9$9"A%:$9"9%A$A"9"9$9"9"8"8"9rH&;"A&;":$B"<$8#=#;&;#
+ADFEADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADADFFADADFE98ADFEADFEFFADH#J#=#<%;#
+FEADSAADFFFEADFFADFE98ADFFH#J#=#<$<#
+ADFESAFFADADFE98FEADFFADH#J#=#=#<#
+FEADSAADFFFEADAD98ADFFH5=4
+SEADFEADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADADFEADFFADFFADFFADFFADFFADFFADFFADFFADH5=4
+SEFEADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFFEADFFADFFADFFADFFADFFADFFADFFADFFADFFHz=z
+SEAD3AD
+
+
+
+
+
+I5
+SCFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEH5
+SEFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFFH#y5z#x#
+ADFE98PAAD98ADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADP198ADFF98FFADH#B5J%A#
+FEADPCFFADFE98FFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFEP1FFADFFADADFFH#@)z#J'?#
+ADFEADFFADFEAD98ADFFP;ADFEADP1ADFFADFFADFFFFADH#>+J#J)=#
+FEADFFADFFADADADFE98FFADP;ADFEP1FFADADADFFADFFADADFFH#<&8&J#J#8';#
+ADFEADFFADFFADFEAD98ADFFP;FEADP1ADFFADADADFFADFFFFADH#:'9&J#J#;&9#
+FEADFFADFFADADADADFE98FFADP;ADFEP1FFADADFFADFFADADFFH#8&<&J#J#<*
+ADFEADFFADFFADFEAD98ADFFP;FEADP1ADFFADADADFFADFF98FFADH)=&J#J#?'
+FEADFEADFEADADADADFE98FFADP;ADFEP1FFADADFEADFEADFFH)=&J#J#?'
+ADFE9898ADFEADFEFEAD98ADFFP;FEADP1ADFFFEADFE98FFADH#8&<&J#J#<*
+FEAD9898FEADFEADFE98FFADP;ADFEP1FFADFEADFEAD989898ADFFH#:'9&J#J#;&9#
+ADFE9898ADFEADFEFEAD98ADFFP;FEADP1ADFFFEADFE9898FFAD&C#<&8&J#J#8';#J%
+F7F7F7F7F7FEAD9898FEADFEADFE98FFADP;ADFEP1FFADFEADFEAD9898ADFFFF7F7F7F7&C#>+J#J)=#J&
+F6F6F6F6F6ADFE9898ADFEADFEAD98ADFFP;FEADP1ADFFADFEADFE9898FFADFF6F6F6F6F68$C#@5J'?#J%
+F9F9F9FEADPE9898FEADFE98FFADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEP1FFADFEAD9898ADFFGF9F9F9F7H#B5J%A#
+ADFEPC9898AD98ADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADFEADP1ADFE9898FFADH5
+SEFEADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFH5
+SEADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADFFADIz
+SCAD
+
+
+
+
+
+
+
+
+
+
+<z"z"z
+0F6F7T&F6F71F6;z8z8z
+1F9T%F91F9
+
+7z8z8z
+5F7T%F74F7"J"J"
+F76F7T&F7
+ENDBITMAP
+%%EndBinary
+0 F
+(FIGURE 28) 133.57 131.32 T
+1 F
+(- Combobox) 187.46 131.32 T
+0 0 612 792 C
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+(entry \336eld which when activated will pop up the) 315 713.33 T
+(scrolledlistbox beneath the entry \336eld. The simple non-) 315 701.33 T
+(dropdown combobox permanently displays the listbox) 315 689.33 T
+(beneath the entry \336eld and has no arrow button. Either) 315 677.33 T
+(style allows an optional entry \336eld label.) 315 665.33 T
+0 12 Q
+(Selectionbox) 395.17 634 T
+1 10 Q
+-0.43 (The Selectionbox class combines a scrolled list of items,) 315 615.33 P
+(an editable entry \336eld for the selected item, and labels) 315 603.33 T
+(for the list and entry \336eld, allowing the user to select or) 315 591.33 T
+(enter one item from a list of alternatives. The Selection-) 315 579.33 T
+-0.32 (box also provides a child site and an option to control its) 315 567.33 P
+(position.) 315 555.33 T
+0 12 Q
+(Fileselectionbox) 386.5 291.14 T
+1 10 Q
+(The Fileselectionbox presents a \336le selector similar to) 315 266.48 T
+(that found in the Motif widget set. It consists of a \336le) 315 254.48 T
+(and directory list as well as a \336lter and selection entry) 315 242.48 T
+-0.25 (widget. A child site also exists which may be positioned) 315 230.48 P
+(at several locations via an option. An extensive option) 315 218.48 T
+(set is provided which enables speci\336cation of initial) 315 206.48 T
+(directory) 315 194.48 T
+(, search commands, \336lter mask, no match) 350.45 194.48 T
+(string, and mar) 315 182.48 T
+(gins.) 375.09 182.48 T
+0 12 Q
+(Dialogshell) 399.16 151.14 T
+1 10 Q
+(The Dialogshell class provides base class support for) 315 128.48 T
+(top level [incr W) 315 116.48 T
+(idgets] modal dialogs. This includes) 382.64 116.48 T
+(dialog mapping, button management, separator control,) 315 104.48 T
+(and a child site. The \324activate\325 command maps the dia-) 315 92.48 T
+-0.3 (log and waits based on the modality) 315 80.48 P
+-0.3 (. Non-modal dialogs) 456.45 80.48 P
+315 72 540 720 C
+315 319.14 540 552 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+315 347 540 543 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 13238
+226 306 116.23 157.37 0 369.77 381
+/red <
+7266F5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+FFFFFFFFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBF80808080
+8080808080808080808080808080808080808080404040404040404040404040
+4040404040404040404040000000000000000000000000000000000039C069DD
+00FF0000003333330033CCDD9999112277005544FFCC66AABBFF33EE9999CC7A
+EFD39765E1A36FE700557FFF5500B22E99FFFFB07AFFB0CC0087AFB4CD73E6A2
+4DBF88F5439D58D750D080C0C080C0808060C000FFA000FF20C0A040C040D060
+F0E010B499FFA0BE8BD28BD9B3FF720019BF2FFF6223852F465F4770FF0000FF
+> store
+/green <
+9F99DE00000000000000000000000000FFFFFFBFBFBFBFBF8080808080404040
+40000000FFFFFFFFFFBFBFBFBF808080808040404040400000000000FFFFFFFF
+FFBFBFBFBFBF8080808040404040400000000000FFFFFFFFFFBFBFBFBFBF8080
+8080804040400000000000FFFFFFBFBFBFBFBF80808040404040400063E0B500
+996699FF00663399BBFF99DD99FF112277005544CCCC66AABB6600EE6600CC69
+E3B59765E1A36FE7006B7FFF1A00B28B99FFFFB094FF30F700CEEEEE0073E6A2
+4DBF88F54DB358D78080C0C080C080808060C08000A080402070A0402040D0F0
+F0E010B489E4A0BE5BB477D9B3FF77FF19264F00B641DE4F829E4780FF0000FF
+> store
+/blue <
+FFFFB3FFFFFFFFFFFFFFFFFFFFFFFFFFBF8040FFBF804000FFBF804000FFBF80
+00BF8040FFBF804000FF804000FFBF804000FFBF804000FFBF804000FFBF8040
+00FFBF804000FFBF4000FFBF804000FFBF804000FFBF804000FFBF804000FFBF
+804000FFBF00FFBF804000BF8040FFBF804000FFBF40FFBF8040004063E0B500
+FF3399FF88666666009966DDFFFF112277DD554499FFCCAABBCC99EE9966CC69
+E3B59765E1A36FE7BF2F7FCC8BEEB2576BFBB3B01532602480FAEEB40073E6A2
+4DBF88F556CA58D7D050C080C08080C08060C080FF0000402070C0802040D060
+50E010B476C4A0BE7A8C65D9B3E0850070264F00FC5AE050B4A0FF9000FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+6F6F7QIF6F76F6F7J"
+RHF78z8z8z
+4F9QHF94F9
+
+;z"
+R?F7F6<z"z"z"z
+0F6F7Q8F6F70F6F70F6=z8z8z8z
+/F9Q7F9/F9/F9
+J'>$H"9#I'
+O0FEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEJ'?"I"J"8%Js"
+O/FEFEF9F9F9FEF9FE9F9F9F9FEFEO@F6F7J"J#Jr
+O4F9BF9F9P-F9J#8"9$?$:$8"8&:$9'D$9(
+O1FEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEF9FEFEFEFEFEFEFEFEF9FEFEFE@s"J"9#8'<08$:*8%;%8*9$J$
+F6F7JF9FEFEFEFEFEF9FEFEFEFEFEF9FEFEF9FEFEFEF9FEFEF9F9F9F9F9FEFEFEF9FEFEFEF9F9FEF9FEFEFEFEFEF9FEFEFEF9FEFEFEF9F9F9FEF9O!F6F6F7ArJ#9":"A";%C$<">&9$:&J"
+F9LF9F9FEFEFEF9F9F9F9F9F9F9F9F9F9F9FEFEF9F9F9F9FEFEFEF9O#F9@sJ"8#;%>%J#
+F7KFEF9F9F9F9F9F9F9F9F9F9P.F7F7@tJ">%>%9%C$J$:&J$
+F9KFEFEF9FEFEFEF9FEFEFEF9FEFEFEF9FE7FEF9FEFEF9F9FEFEO"F9F9F9J0808&8,8"9$829"
+O0F9FEFEFEFEF9F9F9F9FEFEFEF9F9FEFEF9F9F9FEFEFEF9F9F9F9FEFEFEF9F9FEFEF9FEFEF9F9F9FEFEFEF9F9F9FEFEFEF9FEFEFEFEFEF9F9F9F9FEFEFEF9F9F9FEFEFEFEJ':$8%9$:$:r9$9z:$9rJs
+O/F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F90F9F9F9F9F9O/F7Jt
+R7F9
+=z8z8z8z
+/F7Q7F7/F7/F7rF"J"F"F%
+F7F7Q8F7F7F7F7F7F7'z&
+F6F6F6F6F6F7R>E5F6F6F6F6F68$J%
+F9F9F9R@F9F9F9F7
+
+
+
+
+
+
+
+
+
+
+
+
+J#8#
+4FEFEFEFE
+J"8"8%8*9%
+7FEFEFEFEFEFEFEE5FEFEFEE5FEFEFEFEFEFEFEJ"8)81
+7E5E5E5FEFEE5E5FEFEFEE5E5FEFEE5E5FEFEE5FEFEE5E5FEFEJ%
+O"FEE5E5E5J#D&
+>FEFEE5E5FEFEFEJ%D"8"
+>E5E5E5E5E5FEJ":#B%
+;FEFEFEFEFEE5E5J+B'
+8E5FEFEE5E5FEFEFEFEE5E5FEFEFEFEE5J#9#8%8#8#8#8%
+4E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5
+
+
+
+
+
+
+
+H5>2
+Q:C3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEFEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEH5=4
+Q:FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FFH#z"=#r"r#
+C3FEQ7C3FFE5FEDEFEDEFFE5H#J#=#<#=#
+FEC3Q6FFC3FEE5FFE5E5FFH#J#=#<$<#
+C3FEQ6C3FFE5FEE5FEE5FFE5H#J#=#;%<#
+FEC3Q6FFC3FEE5E5FFE5FEE5FFH#J#=#;&;#
+C3FEQ6C3FFE5FEFFE5E5E5FEFFE5H#J#=#:#8#;#
+FEC3Q6FFC3FEE5FFE5FEE5E5FFH#J#=#:#8$:#
+C3FEQ6C3FFE5FEE5FFE5FEE5FFE5H#J#=#9$9#:#
+FEC3Q6FFC3FEE5E5FFE5E5FEE5FFH#J#=#9#;#9#
+C3FEQ6C3FFE5FEFFE5E5FEFFE5H#J#=#8#<#9#
+FEC3Q6FFC3FEE5FFE5FEE5E5FFH#J#=#8#<$8#
+C3FEQ6C3FFE5FEE5FFE5FEE5FFE5H#J#='=#8#
+FEC3Q6FFC3FEE5DEE5FFE5E5FEE5FFH#J#=&?&
+C3FEQ6C3FFE5FEDEFFE5E5FEDEFFE5H#J#=4
+FEC3Q6FFC3FEE5FFE5FEE5FEE5FEE5FEE5FEE5FEE5DEE5FFH#J#=4
+C3FEQ6C3FFE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FFE5H#J#=#z#
+FEC3Q6FFC3FEE5/DEE5FFH#J#=4
+C3FEQ6C3FFE5FEE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5H#J#=4
+FEC3Q6FFC3FEE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FEE5FFH#J#=%v%
+C3FEQ6C3FFE5FEE5FFE5FEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=%A%
+FEC3Q6FFC3FEE5FFE5E5FEE5FFH#J#=%A%
+C3FEQ6C3FFE5FEE5FFFEE5FFE5H#J#=4
+FEC3Q6FFC3FEE5FFE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FFH#J#=4
+C3FEQ6C3FFE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FFE5H#J#=#z#
+FEC3Q6FFC3FEE5/DEE5FFH#J#=4
+C3FEQ6C3FFE5FEE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5H#J#=4
+FEC3Q6FFC3FEE5DEE5FFE5FFE5FFE5FFE5FFE5FFE5FEE5FFH#J#=%v%
+C3FEQ6C3FFE5FEDEFFE5FEDEFFE5H#J#=&?&
+FEC3Q6FFC3FEE5DEDEFFFEE5DEE5FFH#J#=#8#='
+C3FEQ6C3FFE5FEE5FFFEE5DEDEFFE5H#J#=#8$<#8#
+FEC3Q6FFC3FEE5DEE5FFE5FEE5FFH#J#=#9#<#8#
+C3FEQ6C3FFE5FEFFE5FEDEFFE5H#J#=#9#;#9#
+FEC3Q6FFC3FEE5DEFFFEE5E5FFH#J#=#:#9$9#
+C3FEQ6C3FFE5FEE5FFFEE5DEFFE5H#J#=#:$8#:#
+FEC3Q6FFC3FEE5DEE5FFE5FEE5FFH#J#=#;#8#:#
+C3FEQ6C3FFE5FEFFE5FEDEFFE5H#J#=#;&;#
+FEC3Q6FFC3FEE5DEFFE5FEE5E5FFH#J#=#<%;#
+C3FEQ6C3FFE5FEE5FEE5DEFFE5H#J#=#<$<#
+FEC3Q6FFC3FEE5DEE5FEE5FFH#J#=#=#<#
+C3FEQ6C3FFE5FEFEDEFFE5H5=4
+Q:FEC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FEE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFH5=4
+Q:C3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5Hz>z
+Q:E51E5
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+J&?#F#8#
+5FEFEFEFEFEFEFEFEFEFEFEJ(J#
+4FEFEE5E5E5FEFE>E5E5J%<%9%8"8%8%8&
+=FEFEFEFEFEFEFEFEFEFEFEFEFEFEE5FEFEFEFEFEFEFEFEE5FEFEJ/:08":'9%
+4E5FEFEFEE5E5E5E5FEFEE5E5FEFEFEFEE5E5FEFEE5FEFEE5E5FEFEE5E5E5FEFEE5E5FEFEFEE5FEFEJ&J#H"
+5E5E5FEFEFE7E5E5E5J"8"9#>#
+7E5FEFEFEFEFEJ#8";%<%
+4FEFEE5E5E5E5E5E5E5E5E5J#>#;#;"
+@FEFEFEFEFEFEFEJ/:.8%9'
+4E5FEFEFEFEFEE5E5E5FEFEFEFEE5E5FEFEFEFEE5E5E5FEFEFEFEE5E5FEFEE5E5FEFEFEFEE5J&9%8#8%9%:&8%8#8#
+5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5
+
+
+
+
+
+
+
+
+H5
+R%C3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3H5
+R%FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FEC3FFH#z#
+C3FER!C3FFC3H#J#
+FEC3R!C3FFH#J#
+C3FER!FFC3H#J#
+FEC3R!C3FFH#J#
+C3FER!FFC3H#J#
+FEC3R!C3FFH#J#
+C3FER!FFC3H#J#
+FEC3R!C3FFH#J#
+C3FER!FFC3H#J#
+FEC3R!C3FFH#J#
+C3FER!FFC3&C#J#C%
+F7F7F7F7F7FEC3R!C3FFF7F7F7F7&C#J#C&
+F6F6F6F6F6C3FER!FFC3F6F6F6F6F68$C#J#D%
+F9F9F9FEC3R!C3FFF9F9F9F7H#J#
+C3FER!FFC3H5
+R%FEC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFH5
+R%C3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3FFC3Hz
+R%E5
+
+
+
+
+
+
+
+
+
+
+<z"z"z
+0F6F7QIF6F71F6;z8z8z
+1F9QHF91F9
+
+7z8z8z
+5F7QHF74F7"J"J"
+F76F7QIF7
+ENDBITMAP
+%%EndBinary
+360 354 495 372 R
+7 X
+V
+4 8 Q
+0 X
+(selectionbox .sb) 360 366.67 T
+(pack .sb -padx 10 -pady 10) 360 356.67 T
+0 10 Q
+(FIGURE 29) 371.53 329.1 T
+1 F
+( - Selectionbox) 422.92 329.1 T
+315 72 540 720 C
+0 0 612 792 C
+FMENDPAGE
+%%EndPage: "15" 15
+%%Page: "16" 16
+612 792 0 FMBEGINPAGE
+[0 0 0 1 0 0 0]
+[ 0 1 1 0 1 0 0]
+[ 1 0 1 0 0 1 0]
+[ 1 1 0 0 0 0 1]
+[ 1 0 0 0 0 1 1]
+[ 0 1 0 0 1 0 1]
+[ 0 0 1 0 1 1 0]
+ 7 FrameSetSepColors
+FrameNoSep
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+1 10 Q
+0 X
+0 0 0 1 0 0 0 K
+(return control immediately) 72 465.48 T
+(, whereas global and applica-) 178.56 465.48 T
+(tion modal dialogs wait until the \324deactivate\325 command) 72 453.48 T
+(is invoked. The \324deactivate\325 command accepts an) 72 441.48 T
+(optional ar) 72 429.48 T
+(gument which becomes the return value of) 114.87 429.48 T
+(the \324activate\325 command. This provides dialog deactiva-) 72 417.48 T
+(tion status noti\336cation.) 72 405.48 T
+0 12 Q
+(Dialog) 167.83 374.14 T
+1 10 Q
+(The Dialog class is a specialized version of the Dia-) 72 351.48 T
+(logShell with four prede\336ned buttons tagged, \322OK\323,) 72 339.48 T
+(\322Cancel\323, \322Apply\323, and \322Help\323. By default the Dialog) 72 327.48 T
+(class provides automatic deactivation and status return) 72 315.48 T
+(following selection of either the \322OK\323 or \322Cancel\323 but-) 72 303.48 T
+(ton. The status indicator is 1 for \322OK\323 and 0 for \322Can-) 72 291.48 T
+(cel\323. Automatic deactivation may be disabled, enabling) 72 279.48 T
+(more user control over deactivation and status noti\336ca-) 72 267.48 T
+(tion. In this case, the user must invoke the deactivate) 72 255.48 T
+-0.43 (method explicitly and is free to pass a status return value) 72 243.48 P
+(as needed.) 72 231.48 T
+0 12 Q
+(Messagedialog) 147.17 200.14 T
+1 10 Q
+(The Messagedialog class provides a bitmap and mes-) 72 181.48 T
+(sage text within a dialog context. Options control the) 72 169.48 T
+(position of the bitmap and message. All the standard) 72 157.48 T
+(dialog control options are also available.) 72 145.48 T
+72 472.14 297 720 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+72 501 297 718.71 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 31814
+365 317 187.71 163.03 0 90 543.43
+/red <
+7266F5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+FFFFFFFFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBF80808080
+8080808080808080808080808080808080808080404040404040404040404040
+4040404040404040404040000000000000000000000000000000000039C069DD
+00FF0000003333330033CCDD9999112277005544FFCC66AABBFF33EE9999CC7A
+EFD39765E1A36FE700557FFF5500B22E99FFFFB07AFFB0CC0087AFB4CD73E6A2
+4DBF88F5439D58D750D080C0C080C0808060C000FFA000FF20C0A040C040D060
+F0E010B499FFA0BE8BD28BD9B3FF720019BF2FFF6223852F465F4770FF0000FF
+> store
+/green <
+9F99DE00000000000000000000000000FFFFFFBFBFBFBFBF8080808080404040
+40000000FFFFFFFFFFBFBFBFBF808080808040404040400000000000FFFFFFFF
+FFBFBFBFBFBF8080808040404040400000000000FFFFFFFFFFBFBFBFBFBF8080
+8080804040400000000000FFFFFFBFBFBFBFBF80808040404040400063E0B500
+996699FF00663399BBFF99DD99FF112277005544CCCC66AABB6600EE6600CC69
+E3B59765E1A36FE7006B7FFF1A00B28B99FFFFB094FF30F700CEEEEE0073E6A2
+4DBF88F54DB358D78080C0C080C080808060C08000A080402070A0402040D0F0
+F0E010B489E4A0BE5BB477D9B3FF77FF19264F00B641DE4F829E4780FF0000FF
+> store
+/blue <
+FFFFB3FFFFFFFFFFFFFFFFFFFFFFFFFFBF8040FFBF804000FFBF804000FFBF80
+00BF8040FFBF804000FF804000FFBF804000FFBF804000FFBF804000FFBF8040
+00FFBF804000FFBF4000FFBF804000FFBF804000FFBF804000FFBF804000FFBF
+804000FFBF00FFBF804000BF8040FFBF804000FFBF40FFBF8040004063E0B500
+FF3399FF88666666009966DDFFFF112277DD554499FFCCAABBCC99EE9966CC69
+E3B59765E1A36FE7BF2F7FCC8BEEB2576BFBB3B01532602480FAEEB40073E6A2
+4DBF88F556CA58D7D050C080C08080C08060C080FF0000402070C0802040D060
+50E010B476C4A0BE7A8C65D9B3E0850070264F00FC5AE050B4A0FF9000FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+6F6F7TJF6F76F6F7J"
+UIF78z8z8z
+4F9TIF94F9
+
+;z"
+U@F7F6<z"z"z"z
+0F6F7T9F6F70F6F70F6=z8z8z8z
+/F9T8F9/F9/F9
+Js8#8$@'>$H"9#I'
+P:FEFEFEFEFEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEJ"8$>"A'?"I"J"8%Js"
+P:F9F9F9F9F9FEFEF9F9F9FEF9FE9F9F9F9FEFEPJF6F7J"9#I"J#Jr
+P@F9F9F9F9BF9F9Q7F9J"9$?$:#8"9$?$:$8"8&:$9'D$9(
+P?FEFEFEFEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEF9FEFEFEFEFEFEFEFEF9FEFEFE@s"J#8$?)9#8'<08$:*8%;%8*9$J$
+F6F7P*FEFEF9F9F9FEFEFEF9FEFEF9F9FEFEFEFEFEF9FEFEFEFEFEF9FEFEF9FEFEFEF9FEFEF9F9F9F9F9FEFEFEF9FEFEFEF9F9FEF9FEFEFEFEFEF9FEFEFEF9FEFEFEF9F9F9FEF9P+F6F6F7ArJ#G":#9":"A";%C$<">&9$:&J"
+F9P+F9F9FEF9F9FEFEFEF9F9F9F9F9F9F9F9F9F9F9FEFEF9F9F9F9FEFEFEF9P-F9@sJ"E'8#;%>%J#
+F7P-F9F9F9F9F9F9FEF9F9F9F9F9F9F9F9F9F9Q8F7F7@tJ%8">%>%9%C$J$:&J$
+F9P<FEF9FEFEFEFEF9FEFEFEF9FEFEFEF9FEFEFEF9FE7FEF9FEFEF9F9FEFEP,F9F9F9J"8";"8$8)80808&8,8"9$829"
+P:FEFEFEFEF9FEFEF9F9F9FEFEFEF9F9FEFEFEFEF9F9F9F9FEFEFEF9F9FEFEF9F9F9FEFEFEF9F9F9F9FEFEFEF9F9FEFEF9FEFEF9F9F9FEFEFEF9F9F9FEFEFEF9FEFEFEFEFEF9F9F9F9FEFEFEF9F9F9FEFEFEFEJ%;t9$8':$8%9$:$:r9$9z:$9rJs
+P:F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F90F9F9F9F9F9P9F7Jt
+U8F9
+=z8z8z8z
+/F7T8F7/F7/F7rF"J"F"F%
+F7F7T9F7F7F7F7F7F7'z&
+F6F6F6F6F6F7U?E5F6F6F6F6F68$J%
+F9F9F9UAF9F9F9F7
+
+
+
+
+
+
+
+
+
+
+
+
+Js$8#
+4FEE5FEFEFEFEJ'
+6E5E5E5E5E5E5J#:"8"8%8&
+:FEFEFEFEFEFEFEFEFEFEE5FEFEJ"8)9"
+@E5E5E5FEFEE5E5FEFEFEJ$J#
+6FEFEFE6E5E5J$D#;"
+6E5E5E5FEFEE5J%
+GE5E5E5E5J":#
+DFEFEFEJ+
+AE5FEFEE5E5FEFEFEFEE5J#:&9#8%8#
+4E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5
+
+
+
+
+
+
+
+
+H5
+U&FFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEH5
+U&FEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFH#Z
+FFFEU#H#
+FEFFH#:":&9$>"E$<$J"J"J"9"C"=#J"B$8#A":#J"
+FFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFECFEBFEO"FEFEFEFEFEGFEFEFEFEFEFEFEFEFECFEH#8#<%8&<#E#<%G"F#J#J#9"C"="H"I#B(A#:"J#9"
+FEFFFEFEFFFFFFFFFEFFFFFFFEFEFFFFFFFEFFFFFFFEFEFFAFEFFO!FEFFFFFFFFFEFEFEFEFFFFFFFEFFFFFEFFFFCFEFFFEH#8#J#
+FFFEFFFFS&FFFFH#J)8#8#?&9$9&8&9$<):$9&9$<#9$:$8&8&:$8&<#8$9,;$:&8$9&9$J$<#9$:$8&:$:$<#8&
+FEFF:FEFFFFFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFFFFFEFEFEFFFEFEFEFEFEFFFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFFFEFEFEFEFEFFFEFEFEFEFFFEFEFEFEFEFEFFFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFE@FEFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFFFEFEFEFEFEH#@$9"8#>)9"@&8&8&8&8&>'8&8&8&?&848-?#:+;%9-8&8&J%?%9-8&8&?&
+FFFEFEFEFEFFFEFFFFFEFFFEFFFEFFFFFFFFFEFFFFFFFEFFFFFFFEFFFEFFFFFFFFFEFFFFFFFEFFFFFFFEFFFEFFFEFFFEFEFFFFFFFEFFFEFFFFFFFEFFFFFFFEFEFFFFFFFEFEFFFFFFFEFFFFFEFFFEFFFEFFFFFEFFFEFFFEFEFFFFFFFEFFFFFEFEFFFFFEFFFFFFFEFFFFFFFEFFFFFFFFFEFFFFFFFEFFFFFFFEFFFFFEFFFFFFFEFFFEFFFFFFFEFFFFFFFE?FFFFFFFEFEFFFFFFFEFFFFFFFEFFFFFEFFFEFFFEFEFFFFFFFEFEFFFFFFFEFFFFFEFFFFH#?&:#;#J$G&:#A$D":#="J"=#B"J$@&8&J#A$G&:#:$
+FEFFFFFFFFFFFEFEFFFEFF@FEFEFEFFFEFEFEFFFEFFFEFEFEFFFEFFFF?FFFEFFFE:FEFEFEFFFEFEFEFFFEFEFEFEFE@FEFFFEFEFEFFFEFEFEFFFEFFFEFFFEH#G#J%G%G%J%@%8PJ%G%@$
+FFFEFEFFHFFFFFFFFFFFFFFFEFFFFFFFFP0FFFFFFFFFFFFFFFEMFFFFFFFFFFFFFFFEFFFFFFH#>"=#8"9#J"D$=#E"C"9#>"J#A&J"=$J#E"F"=#
+FEFFFEFEFFFEFEFFDFEFEFFFEFEFFFEFEFEFFFEFFEFFFFFEFFFEFF;FEFEFFFEJFEFFFEFEFEFFH#8-9$?";59&8%:,>";(8%9&?&8(;#;,9">&?&8,9&9,?&9";-?/;(8&
+FFFEFEFEFEFEFEFFFFFEFEFEFEFFFEFEFEFE4FEFFFFFEFEFEFFFEFFFEFEFEFEFEFEFFFEFEFEFEFFFEFEFEFFFEFEFEFEFFFEFEFEFFFFFFFEFEFEFFFEFEFFFFFEFEFEFFFEFEFEFEFFFEFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFEFEFEFFFFFEFEFEFFFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFFFEFFFFFEFEFEFFFEFEFEFFFFFEFEFEFFFFFFFEFEFEFFFEFEFEFEFEFEFFFEFEFEFFFFFEFFFEFEFEFFFFFEFEFEFFFEFFFFFEFEFEFFFFFEFEFFFFFEFEFEFFFFFEFEFEFFH#8P8%9P8#:R8Z:$9%;$9$9#:R8$9%:$9#<$:$8Y8$8$8&;P9$9P9P8$:$;$9$@P9"<$8P9#<P8$8R8$:$9#
+FEFFFFFFFFFFFEFF1FFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFEFFH#J"J"J"J"J"J"
+FFFE7FFO0FFBFFO"FFP%FFIFFH#J%
+FEFFR6FEFEFEFFH#J$
+FFFER6FFFFFFH#
+FEFFH"
+FFHz
+U&E5
+
+
+
+
+
+
+
+
+
+
+
+
+J&9#J#D#Js$
+4FEFEFEFEFEFEFE5FEFEFEFEP>FEE5FEFEJ%8#J#J'
+6E5E5FEFEE5E5EE5E5P@E5E5E5E5E5E5J29%8"8"8%8(8%9%J#;%9%
+8E5FEFEE5FEFEE5FEFEE5FEFEE5FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEE5FEFEFEFEFEFEFEFEFEFEFEFEP7FEFEFEFEFEFEFEFEFEFEJ"808)9";.J.
+AFEFEFEE5E5FEFEE5FEFEE5E5FEFEE5E5E5E5FEFEE5E5FEFEFEFEFEE5E5FEFEE5FEFEE5E5FEFEP<FEFEE5E5FEFEE5FEFEE5E5FEFEJ#A#F#B%J$F%
+BE5E5E5E5E5E5FEE5E5E5P2FEFEFEFEE5E5E5J":#J"=#9&J$?#9&
+AE5FEFE8E5FEFEE5E5FEFEFEP3E5E5E5FEFEE5E5FEFEFEJ%J%9"8"J%9"8"
+FE5E5E5E5>E5E5E5E5E5FEP>E5E5E5E5E5FEJ$C#;#;"I(J(
+8FEFEE5FEFEFEFEFEFEFEE5FEFEE5E5PBFEFEE5FEFEE5E5J%@.8+?.J.
+6FEFEFEE5E5FEFEFEFEE5E5E5FEFEFEFEE5E5FEFEE5E5FEFEFEFEE5E5FEFEFEFEE5E5E5FEFEFEFEE5P<E5FEFEFEFEE5E5E5FEFEFEFEE5J&9&:%9%:#8%8#9#8%9%J#:&8%9%
+4E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5P1E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5
+
+
+
+
+
+
+
+H5>2C5>2
+PIFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEPHFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEH5>4B5=4
+PHFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FFPHFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FFH5?#r"r#B#Z>#r"r#
+PGFFFEDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEE5FEDEFEDEFFE5FFFEPEE5FEDEFEDEFFE5H#z"?#<#=#B#J#<#=#
+FEFFPDDEFEFEE5FFE5E5FFFEFFPMFEE5FFE5E5FFH#J"B$8#A":#J"J"?#<$<#B#J"J#<$<#
+FFFE8FEFEFEFEFEFEFEFEFECFE>DEE5FEE5FEE5FFE5FFFE4FEP8E5FEE5FEE5FFE5H#8"I#B(A#:"J#J"?#;%<#B#I(A"<"H&J#;%<#
+FEFFFEFEFEFEDEDEDEFEDEDEFEDEDECFEDE>FEFEE5E5FFE5FEE5FFFEFFFEFFFEFEFEFEFEFEFEFEFEFEFEFEO7FEE5E5FFE5FEE5FFH#J#J"?#;&;#B#J'J'J#;&;#
+FFFE6DEDEP,DEE5FEFFE5E5E5FEFFE5FFFE5FFFEFFFFFFFEDFFFEFFFFFFFEO6E5FEFFE5E5E5FEFFE5H)9$J$<#9$:$8&:$:$<#J"?#:#8#;#B#8$:$<#>#8#8&8&9$8&A$8(J#:#8#;#
+FEFFDEFEFEFEFEFEFEFEFE@FEFEFEFEDEFEFEFEFEFEFEFEFEFEDEFEFEFEFEFEFEFEFEDE?FEFEE5FFE5FEE5E5FFFEFFFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEO'FEE5FFE5FEE5E5FFH)8&J%?%9-8&8&J"?#:#8$:#B)8&@'9"9&8&8-9%8)9#J#:#8$:#
+FFFEDEDEFEDEDEDEFEDEDEDEFE?DEDEDEFEFEDEDEDEFEDEDEDEFEDEDEFEDEFEDEFEFEDEDEDEFEFEDEDEDEFEFDEE5FEE5FFE5FEE5FFE5FFFEFFFEFFFFFFFEFEFFFFFFFEFEFEFEFFFFFFFFFFFEFFFFFFFFFEFFFFFFFEFFFFFFFEFFFFFEFEFFFFFEFEFEFEFFFEFFFFFFFEFFFFFFFFFFO'E5FEE5FFE5FEE5FFE5H#>&8&J#A$G&:#J"?#9$9#:#B#>&:#:%J"<%@$J#9$9#:#
+FEFFDEFEFEFEDEFEFEFEFEFE@FEDEFEFEFEDEFEFEFEDEFEDE@FEFEE5E5FFE5E5FEE5FFFEFFFFFEFEFEFFFEFFFFFFFFFE?FFFFFFFFFEFFFEFFO)FEE5E5FFE5E5FEE5FFH#?%8&J%G%J"?#9#;#9#B#?%J$J#9#;#9#
+FFFEDEDEDEFEDEDEDEDEDEMDEDEDEDEDEDEDEFEFDEE5FEFFE5E5FEFFE5FFFEFFFFFFFEO4FEFFFEO)E5FEFFE5E5FEFFE5H#<$J#E"F"=#J"?#8#<#9#B#>"=#J"<"J&J#8#<#9#
+FEFFFEDEFEJFEDEFEFEFEDEAFEFEE5FFE5FEE5E5FFFEFFFEFEFF7FEFE=FEFFFFFFFEO(FEE5FFE5FEE5E5FFH#8,?&9";-?/;(8&@"J"?#8#<$8#B)8&>'8'8&809(8(;"J#8#<$8#
+FFFEDEFEFEFEDEDEDEFEFEFEDEFEFEFEFEFEFEDEFEFEFEDEDEFEDEFEFEFEDEDEFEFEFEDEFEDEDEFEFEFEDEDEFEFEDEDEFEFEFEDEDEFEFEFEDEFE;DEE5FEE5FFE5FEE5FFE5FFFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFFFFFEFEFEFFFEFFFEFEFEFFFFFEFEFEFFFFFFFEFEFEFFFFFEFEFEFEFEFEFEFEFEFFFFFEFEFEFFFFFEFEO'E5FEE5FFE5FEE5FFE5H#9$9$@&9"<$8&9#<&8$8r8$:$9#<"J"?'=#8#B#8$:$9#:P:P9$:$9$8$8R:$8#9#J'=#8#
+FEFFDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEFEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEFEDEDE;FEFEE5DEE5FFE5E5FEE5FFFEFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFO'FEE5DEE5FFE5E5FEE5FFH#J"J"J"?&?&B#E"J&?&
+FFFEO$DEIDECDEE5FEDEFFE5E5FEDEFFE5FFFEFFP=E5FEDEFFE5E5FEDEFFE5H#J"?4B#J4
+FEFFPDFEFEE5FFE5FEE5FEE5FEE5FEE5FEE5FEE5DEE5FFFEFFPMFEE5FFE5FEE5FEE5FEE5FEE5FEE5FEE5DEE5FFH#J"?4B#J4
+FFFEPDDEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FFE5FFFEPME5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FFE5H5?#z#B#J#z#
+PGFEFFFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEFEE5/DEE5FFFEFFPMFEE5/DEE5FFH#Z?4B#J4
+FFFEPEE5FEE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFFEPME5FEE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5H#J4B#J4
+FEFFQ FEE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FEE5FFFEFFPMFEE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FEE5FFH#J"B$8#A":#J"J%v%B#J"@"A$J%v%
+FFFE8FEFEFEFEFEFEFEFEFECFEHE5FEE5FFE5FEE5FFE5FFFE4FEFEFEFEFEOME5FEE5FFE5FEE5FFE5H#8"I#B(A#:"J#J%A%B#I(;"A#J%A%
+FEFFFEFEFEFEFFFFFFFEFFFFFEFFFFCFEFFHFEE5FFE5E5FEE5FFFEFFFEFFFEFEFEFEFEFFFFFFP FEE5FFE5E5FEE5FFH#J#J%A%B#J'J%A%
+FFFE6FFFFP6E5FEE5FFFEE5FFE5FFFE5FFFEFFFFFFFEP2E5FEE5FFFEE5FFE5H)9$J$<#9$:$8&:$:$<#J%A%B#8$:$<#?$:%A$:&J%A%
+FEFFFFFEFEFEFEFEFEFEFE@FEFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFFIFEE5FFE5E5FEE5FFFEFFFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEO<FEE5FFE5E5FEE5FFH)8&J%?%9-8&8&J%A%B)8&F#;&?&8'J%A%
+FFFEFFFFFEFFFFFFFEFFFFFFFE?FFFFFFFEFEFFFFFFFEFFFFFFFEFFFFFEFFFEFFFEFEFFFFFFFEFEFFFFFFFEO"E5FEE5FFFEE5FFE5FFFEFFFEFFFFFFFEFEFFFFFFFEFFFFFFFFFFFFFEFEFFFFFFFEFEFFFFFFFEFFO<E5FEE5FFFEE5FFE5H#>&8&J#A$G&:#J%A%B#>&:#H$J%A%
+FEFFFFFEFEFEFFFEFEFEFEFE@FEFFFEFEFEFFFEFEFEFFFEFFJFEE5FFE5E5FEE5FFFEFFFFFEFEFEFFFEFFFEFEFEP%FEE5FFE5E5FEE5FFH#?%8PJ%G%J%A%B#?%J%J%A%
+FFFEFFFFFFFEMFFFFFFFFFFFFFFFEO"E5FEE5FFFEE5FFE5FFFEFFFFFFFE7FEFFFFFFP%E5FEE5FFFEE5FFE5H#<$J#E"F"=#J%A%B#>"=#J%A%
+FEFFFEFFFEJFEFFFEFEFEFFKFEE5FFE5E5FEE5FFFEFFFEFEFFP;FEE5FFE5E5FEE5FFH#8,?&9";-?/;(8&@"<"J%A%B)8&>'8&848%J%A%
+FFFEFFFEFEFEFFFFFFFEFEFEFFFEFEFEFEFEFEFFFEFEFEFFFFFEFFFEFEFEFFFFFEFEFEFFFEFFFFFEFEFEFFFFFEFEFFFFFEFEFEFFFFFEFEFEFFFEFE>E5FEE5FFFEE5FFE5FFFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFFFEFEFEFEFEFFFEFEFEFFFEFFFEFEFEFEFEFEFFFFFEFEFEFFFFFEFEFEO>E5FEE5FFFEE5FFE5H#9$9$@P9"<$8P9#<P8$8R8$:$9#<"<"J%A%B#8$:$9#:P9P9W8$:$J%A%
+FEFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFEFFFFFF>FEE5FFE5E5FEE5FFFEFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFO>FEE5FFE5E5FEE5FFH#J"J"J%A%B#E"J%A%
+FFFEO$FFIFFME5FEE5FFFEE5FFE5FFFEFFP=E5FEE5FFFEE5FFE5H#J%A%B#J%J%A%
+FEFFQ FEE5FFE5E5FEE5FFFEFFO,FEFEFEFFO=FEE5FFE5E5FEE5FFH#J%A%B#J$J%A%
+FFFEQ E5FEE5FFFEE5FFE5FFFEO,FFFFFFO>E5FEE5FFFEE5FFE5H#J%A%B#J%A%
+FEFFQ FEE5FFE5E5FEE5FFFEFFPMFEE5FFE5E5FEE5FFH#J%A%B#J%A%
+FFFEQ E5FEE5FFFEE5FFE5FFFEPME5FEE5FFFEE5FFE5H#J%A%B#J%A%
+FEFFQ FEE5FFE5E5FEE5FFFEFFPMFEE5FFE5E5FEE5FFH#J"B$8#A":#J"J%A%B#J"@"A$J#C$:$J%A%
+FFFE8FEFEFEFEFEFEFEFEFECFEHE5FEE5FFFEE5FFE5FFFE4FEFEFEFEFE8FEFEFEFEFEFEFEFEJE5FEE5FFFEE5FFE5H#8"I#B(A#:"J#8$8(8%J%A%B#I(;"A#J'D#;#J%A%
+FEFFFEFEFEFEFFFFFFFEFFFFFEFFFFCFEFFFEFEFEFEFEFEFFFEFEFEFEFEFEFE4FEE5FFE5E5FEE5FFFEFFFEFFFEFEFEFEFEFFFFFF4FEFEFEFEFFFFFFFFFFFFKFEE5FFE5E5FEE5FFH#J#J3J%A%B#J'J%J%A%
+FFFE6FFFFO=FEFFFFFFFEFFFFFEFFFFFFFEFFFFFEFFFFFF5E5FEE5FFFEE5FFE5FFFE5FFFEFFFFFFFEEFEFFFFFFO7E5FEE5FFFEE5FFE5H)9$J$<#9$:$8&:$:$<#J"J%A%B#8$:$<#?$:%A$:&;":#:$J%A%
+FEFFFFFEFEFEFEFEFEFEFE@FEFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFF4FF4FEE5FFE5E5FEE5FFFEFFFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFFFEFEFEFEFEO)FEE5FFE5E5FEE5FFH)8&J%?%9-8&8&C"9$:#J%A%B)8&F#;&?&8'8#;%8&J%A%
+FFFEFFFFFEFFFFFFFEFFFFFFFE?FFFFFFFEFEFFFFFFFEFFFFFFFEFFFFFEFFFEFFFEFEFFFFFFFEFEFFFFFFFEFFFEFFFEFEFE6E5FEE5FFFEE5FFE5FFFEFFFEFFFFFFFEFEFFFFFFFEFFFFFFFFFFFFFEFEFFFFFFFEFEFFFFFFFEFFFEFEFEFFFFFEFEFFFFFFFEO(E5FEE5FFFEE5FFE5H#>&8&J#A$G&:#@"9"8&J%A%B#>&:#H$J&9"<$J%A%
+FEFFFFFEFEFEFFFEFEFEFEFE@FEFFFEFEFEFFFEFEFEFFFEFFFFFFFFFFFEFEFE4FEE5FFE5E5FEE5FFFEFFFFFEFEFEFFFEFFFEFEFE8FFFFFEFEFEFFFEFEFEO)FEE5FFE5E5FEE5FFH#?%8PJ%G%C"A#J%A%B#?%J%J#A%J4
+FFFEFFFFFFFEMFFFFFFFFFFFFFFFEFEFFFF5E5FEE5FFFEE5FFE5FFFEFFFFFFFE7FEFFFFFF:FFFFFFFFFFFFO(E5FEE5FFE5FEE5FEE5FEE5FEE5FEE5FEE5FFE5H#<$J#E"F"=#C":"J%A%B#>"=#J"G"J4
+FEFFFEFFFEJFEFFFEFEFEFFFEFE8FEE5FFE5E5FEE5FFFEFFFEFEFFO FEFEO(FEE5FFE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FFH#8,?&9";-?/;(8&?&9$:%J%A%B)8&>'8&848%:38.J#z#
+FFFEFFFEFEFEFFFFFFFEFEFEFFFEFEFEFEFEFEFFFEFEFEFFFFFEFFFEFEFEFFFFFEFEFEFFFEFFFFFEFEFEFFFFFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFFFEFEFEFF4E5FEE5FFFEE5FFE5FFFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFFFEFEFEFEFEFFFEFEFEFFFEFFFEFEFEFEFEFEFFFFFEFEFEFFFFFEFEFEFEFEFEFFFFFEFEFEFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFEFFFEFEFEFEFEFEGE5FE/DEFFE5H#9$9$@P9"<$8P9#<P8$8R8$:$9#<$;":%J%A%B#8$:$9#:P9P9W8$:$9%8R8$9XJ#E#
+FEFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFF5FEE5FFE5E5FEE5FFFEFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFGFEE5E5FFH#J"J"J%A%B#E"J#E#
+FFFEO$FFIFFME5FEE5FFFEE5FFE5FFFEFFP=E5FEFFE5H#J%A%B#J%J#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFO,FEFEFEFFO=FEE5E5FFH#J%A%B#J$J#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFEO,FFFFFFO>E5FEFFE5H#J%A%B#J#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFPMFEE5E5FFH#J%A%B#J#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFEPME5FEFFE5H#J%A%B#J#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFPMFEE5E5FFH#J%A%B#J"J"A$=#J#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFE4FEMFEFEFEFEFEFEO!E5FEFFE5H#J%A%B#I)@"H':"A#>"J#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFFFFFFFFO"FEE5E5FFH#J%A%B#J&J&J#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFE5FFFEFFFFFF>FFFEFFFFFFO>E5FEFFE5H#J%A%B#8$:$<#:*9&8.9":$;$A$J#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFFEFEFEFEFEFEFEFFFEFFFFFFFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEO"FEE5E5FFH#J%A%B)8&@":'8&8#P'8"8"8#;&?%J#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFEFFFEFFFFFFFEFEFFFFFFFEFEFFFEFEFFFFFEFFFEFFFFFFFFFEFEFFFFFFFEFFFEFFFFFFFEFFFFFFFEFEFFFFFFO"E5FEFFE5H#J%A%B#>&:#:"<"J"C$J#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFFFFEFEFEFFFEFFFFFF;FFFEFEFEO0FEE5E5FFH#J%A%B#?%A"J&:"B%J#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFEFFFFFFFEFF9FFFEFFFEFFFFFFFFFFFFO/E5FEFFE5H#J%A%B#>"=#>"D"@"J"J#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFFEFEFFFEFEFE6FEO/FEE5E5FFH#J%A%B)8&>&8$9"8+:$8%:&8&8.J#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFFFFFEFEFEFEFFFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFFFEFEFEFEFEFEFFFFFEFEFEFFFEO E5FEFFE5H#J%A%B#8$:$9#:U8#9$8%?%:P9$9Q8PJ#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFO FEE5E5FFH#J%A%B#E"J#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFEFFP=E5FEFFE5H#J%A%B#J$J#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFO$FEFEFFOFFEE5E5FFH#J%A%B#J#J#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFEO$FFFFOGE5FEFFE5H#J%A%B#J#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFPMFEE5E5FFH#J%A%B5@#E#
+FFFEQ E5FEE5FFFEE5FFE5PEFFFEDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEE5FEFFE5H#J%A%B#z?#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFPDDEFEE5E5FFH#J%A%B#J"@":$J$J"J#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFE4FEFEFEFEFE9FEFEFE;FEJE5FEFFE5H#J%A%B#I):":#C%?#J"="G&J#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFFEDEFEFEFEFEFEFEDEDEDEFEFEFEFEDEDE4FEDEFEFEFEFEFE4FEE5E5FFH#J%A%B#J&J%J'I#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFE5DEFEDEDEDE8FEDEDEDEO,DEFEDEDEDEFEE5FEFFE5H#J%A%B#8$:$<#:":$B$="9$A$:$9&8$;$8&A$8#?#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFFEFEFEFEFEFEFEDEFEFEFEFEFEFEFEDEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEDEFEFEFEFEFEFEFEFEFEE5E5FFH#J%A%B)8&@"8"8#B&9#:&?&8&8&8#;-9%8)?#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFEDEFEDEDEDEFEFEDEDEDEFEFEDEDEDEFEDEDEDEFEFEFEFEDEDEDEFEFEDEDEDEFEFEDEDEDEFEDEFEDEDEDEDEDEFEDEDEDEFEDEDEFEFEDEDEFEFEFEFEDEFEDEDEDEFEDEDEDEE5FEFFE5H#J%A%B#>&:#:"J$9&9$A$="J"<%I#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFDEFEFEFEDEFEDEDE4FEFEFEDEDEFEFEFEFEFEFEFEFEFEDE8DEDEDEDEFEFEE5E5FFH#J%A%B#?%A"I%:#:%@%J#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFEDEDEDEFEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEO/E5FEFFE5H#J%A%B#>"=#J"8"@"C"<"="J"?#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFFEFEDE=FEFEFEFEFEFEDFEFEE5E5FFH#J%A%B)8&>%:&8-9%8&8-8&9,8*9(8(@#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFEDEDEFEFEFEDEDEFEFEFEDEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEDEDEFEFEFEDEFEFEFEDEDEFEFEFEDEFEFEFEFEFEFEDEDEFEFEFEDEDEFEFEFEDEDEFEFEFEDEDEFEFEFEFEFEDEFEFEFEDEDEFEFEFEFEFEFEFEFEFEDEDEFEFEFEDEDEFEE5FEFFE5H#J%A%B#8$:$9#:%:&8'8$9%:$9'8$:$;$8&9$8$8r:$8#?#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFDEDEDEDEDEDEFEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEFEE5E5FFH#J%A%B#E"J#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFEDEP=E5FEFFE5H#J%A%B#J#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFPMFEE5E5FFH#J%A%B#J#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFEPME5FEFFE5H#J%A%B5@#E#
+FEFFQ FEE5FFE5E5FEE5FFPEFEFFFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEFEE5E5FFH#J%A%B#Z?#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFEPDE5FEFFE5H#J%A%B#J#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFPMFEE5E5FFH#J%A%B#J"@":$J$J"J"D#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFE4FEFEFEFEFE9FEFEFE;FE;FEE5FEFFE5H#J%A%B#I):":#C%?#J"="G&;"D#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFFEFFFEFEFEFEFEFEFFFFFFFEFEFEFEFFFF4FEFFFEFEFEFEFEFFFEE5E5FFH#J%A%B#J&J%J'I#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFE5FFFEFFFFFF8FEFFFFFFO,FFFEFFFFFFFEE5FEFFE5H#J%A%B#8$:$<#:":$B$="9$A$:$9&8$;$8&@$:"?#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEE5E5FFH#J%A%B)8&@"8"8#B&9#:&?&8&8&8#;-?#;"?#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFEFFFEFFFFFFFEFEFFFFFFFEFEFFFFFFFEFFFFFFFEFEFEFEFFFFFFFEFEFFFFFFFEFEFFFFFFFEFFFEFFFFFFFFFFFEFFFFFFFEFFFFFEFEFFFFFEFFFFFFE5FEFFE5H#J%A%B#>&:#:"J$9&9$A$="J"J#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFFFFEFEFEFFFEFFFF4FEFEFEFFFFFEFEFEFEFEFEFEFEFEFF8FF=FEE5E5FFH#J%A%B#?%A"I%:#:%@%J"?#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFEFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFO%FEE5FEFFE5H#J%A%B#>"=#J"8"@"C"<"="J#E#
+FEFFQ FEE5FFE5E5FEE5FFFEFFFEFEFF=FEFEFEFEFEFEO FEE5E5FFH#J%A%B)8&>%:&8-9%8&8-8&9,8*9(8&8"?#E#
+FFFEQ E5FEE5FFFEE5FFE5FFFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFFFEFEFEFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFEFEFEFEFFFEFEFEFFFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFFE5FEFFE5H#J4B#8$:$9#:%:P8Q8$9%:$9Q8$:$;$8P9$8$8R9PB#E#
+FEFFQ FEE5FFE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FFFEFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEE5E5FFH#J4B#E"J#E#
+FFFEQ E5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FFE5FFFEFFP=E5FEFFE5H#J#z#B#J#E#
+FEFFQ FEE5/DEE5FFFEFFPMFEE5E5FFH#J4B#J4
+FFFEQ E5FEE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFFEPME5FEE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5H#J4B#J4
+FEFFQ FEE5DEE5FFE5FFE5FFE5FFE5FFE5FFE5FEE5FFFEFFPMFEE5DEE5FFE5FFE5FFE5FFE5FFE5FFE5FEE5FFH#J%v%B#J%v%
+FFFEQ E5FEDEFFE5FEDEFFE5FFFEPME5FEDEFFE5FEDEFFE5H#J&?&B#J&?&
+FEFFQ FEE5DEDEFFFEE5DEE5FFFEFFPMFEE5DEDEFFFEE5DEE5FFH#J#8#='B#J"D#C$D#A"=#J#8#='
+FFFEQ E5FEE5FFFEE5DEDEFFE5FFFE4FEFEFEFEFEFEFEFEFEFEFEO!E5FEE5FFFEE5DEDEFFE5H#J#8$<#8#B#I&A"D#E"8(9"="H"J#8$<#8#
+FEFFQ FEE5DEE5FFE5FEE5FFFEFFFEFFFEFEFEFFFFFFFFFEFEFEFFFEFEFEFFFFFE=FEE5DEE5FFE5FEE5FFH#J#9#<#8#B#J$J(J#9#<#8#
+FFFEQ E5FEFFE5FEDEFFE5FFFE5FFFEFFO FFFEFFFFFFFEFFO.E5FEFFE5FEDEFFE5H#J#9#;#9#B#8$:$<#?%:$:$A$:$;":$;$:&8$9&J#9#;#9#
+FEFFQ FEE5DEFFFEE5E5FFFEFFFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFE:FEE5DEFFFEE5E5FFH#J#:#9$9#B)8&F&9%8&?&8%@#;%9-8&J#:#9$9#
+FFFEQ E5FEE5FFFEE5DEFFE5FFFEFFFEFFFFFFFEFEFFFFFFFEFFFFFFFFFEFFFFFFFEFEFFFFFFFEFEFFFFFFFEFEFFFFFFFFFFFEFFFFFFFEFFFFFFFEFFFFFEFFFFFFFEFFFEFFFFFF:E5FEE5FFFEE5DEFFE5H#J#:$8#:#B#>&:#A$A$A$J$J#:$8#:#
+FEFFQ FEE5DEE5FFE5FEE5FFFEFFFFFEFEFEFFFEFFFEFEFEFEFEFEFEFEFEGFEFEFEBFEE5DEE5FFE5FEE5FFH#J#;#8#:#B#?%C"8%A%@%@$J%J#;#8#:#
+FFFEQ E5FEFFE5FEDEFFE5FFFEFFFFFFFEFEFEFFFFFFFFFFFFFFFFFFFFFFFEFFFE9FFFFFFFFAE5FEFFE5FEDEFFE5H#J#;&;#B#>"=#J"C"?"9"J"="J#;&;#
+FEFFQ FEE5DEFFE5FEE5E5FFFEFFFEFEFF=FEFEFFFF;FEFE9FEE5DEFFE5FEE5E5FFH#J#<%;#B)8&>&9-8&8-8'>&8,9&9&J#<%;#
+FFFEQ E5FEE5FEE5DEFFE5FFFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFFFEFEFEFFFEFEFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFEFFFEFEFEFFFEFFFFFEFEFEFFFEFEFEFFFFFEFEFEFF9E5FEE5FEE5DEFFE5H#J#<$<#B#8$:$9#:Q9U:$9Q8$:P8$9P9P8$:$;$J#<$<#
+FEFFQ FEE5DEE5FEE5FFFEFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF:FEE5DEE5FEE5FFH#J#=#<#B#E"J#=#<#
+FFFEQ E5FEFEDEFFE5FFFEFFP=E5FEFEDEFFE5H#J4B#J"J4
+FEFFQ FEE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFFEFFP$FFHFEE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFH"J4B"J4
+FFQ!E5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFQ E5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5Hz>zCz>z
+PIE51E5PHE51E5
+
+
+
+
+
+I5J5
+PGFEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEHPGFEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEH5J5
+PIFEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FFFPHFEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5H#y"z5x#J#y"z5x#
+E5FEDEE5O:DE=FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5DEE5FFDEFFE5FE5FEDEE5O9DE=E5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5DEDEDEDEDEDEFFE5DEE5FFH#B$J5A#J#B$J5<%A#
+FEE5FFE5FEO:?E5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FEDEFFE5FFE5E5FFFFEE5FFE5FEO95FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FEE5FFE5FFFFE5H#@&J"z*?#J#@&J#z#<'?#
+E5FEE5FFE5FEE5O:FF7E5FEE5DEE5FFE5FFE5FFFFE5FE5FEE5FFE5FEE5O9E5FF1E5FEE5FFE5FFE5FFE5E5FFH#>(J#J,=#J#>(J#G#<)=#
+FEE5FFE5FFE5E5E5FEO:E5FF6E5FEDEFFE5E5E5FFE5FFE5E5FFFFEE5FFE5FFE5E5E5FEO9FFE5E5FEE5FFE5E5E5FFE5FFFFE5H#<&8#J#J&8';#J#<&8#J#G#<#9&;#
+E5FEE5FFE5FFE5FEE5O:FFE56FEE5DEE5FFE5E5E5FFE5FFFFE5FE5FEE5FFE5FFE5FEE5O9E5FFFEE5FFE5E5FFE5FFE5E5FFH#:'9#J#J&;&9#J#:'9#J#G#<#:'9#
+FEE5FFE5FFE5E5E5E5FEO:E5FF6E5FEDEFFE5E5FFE5FFE5E5FFFFEE5FFE5FFE5E5E5E5FEO9FFE5E5FEE5FFE5E5E5FFE5FFFFE5H#8&<#J#J&<*J#8&<#J#G#<#=)
+E5FEE5FFE5FFE5FEE5O:FFE56FEE5DEE5FFE5E5E5FFE5FFDEFFE5FE5FEE5FFE5FFE5FEE5O9E5FFFEE5FFE5E5FFE5FFE5DEE5FFH)=#J#J&?'J)=#J#G#<#>(
+FEE5FEE5FEE5E5E5E5FEO:E5FF6E5FEDEFFE5E5FEE5FEE5FFFFEE5FEE5FEE5E5E5E5FEO9FFE5E5FEE5FFE5FEE5FEE5FFE5H)=#J#J&?'J)=#J#G#<#>(
+E5FEDEDEE5FEE5FEFEE5O:FFE56FEE5DEE5FFFEE5FEDEFFE5FE5FEDEDEE5FEE5FEFEE5O9E5FFFEE5FFE5FEE5FEE5DEE5FFH#8&<#J#J&<*J#8&<#J#G#<#=)
+FEE5DEDEFEE5FEE5FEO:E5FF6E5FEDEFFE5FEE5FEE5DEDEDEE5FFFFEE5DEDEFEE5FEE5FEO9FFE5E5FEE5FFFEE5FEDEDEDEFFE5H#:'9#J#J&;&9#J#:'9#J#G#<#:'9#
+E5FEDEDEE5FEE5FEFEE5O:FFE56FEE5DEE5FFFEE5FEDEDEFFE5FE5FEDEDEE5FEE5FEFEE5O9E5FFFEE5FFE5FEE5FEE5DEDEE5FFH#<&8#J#J&8';#J#<&8#J#G#<#9&;#
+FEE5DEDEFEE5FEE5FEO:E5FF6E5FEDEFFE5FEE5FEE5DEDEE5FFFFEE5DEDEFEE5FEE5FEO9FFE5E5FEE5FFFEE5FEDEDEFFE5H#>(J#J,=#J#>(J#G#<)=#
+E5FEDEDEE5FEE5FEE5O:FFE56FEE5DEE5FFE5FEE5FEDEDEFFE5FE5FEDEDEE5FEE5FEE5O9E5FFFEE5FFE5FEE5FEE5DEDEE5FFH#@&J5?#J#@&J5<'?#
+FEE5DEDEFEE5FEO:AE5FFE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEDEFFE5FEE5DEDEE5FFFFEE5DEDEFEE5FEO95FFE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FFE5FEDEDEFFE5H#B$J5A#J#B$J5<%A#
+E5FEDEDEE5O:?FFE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5DEE5FEDEDEFFE5FE5FEDEDEE5O95E5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FEE5FFE5DEDEE5FFH5J5
+PIFEE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFFPHFEE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5H5J5
+PIE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FPHE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFE5FFIzJz
+PGE5HPGE5
+
+
+
+
+
+
+
+
+
+
+
+
+J&?#F#8#
+5FEFEFEFEFEFEFEFEFEFEFEJ(J#
+4FEFEE5E5E5FEFE>E5E5J%<%9%8"8%8%8&
+=FEFEFEFEFEFEFEFEFEFEFEFEFEFEE5FEFEFEFEFEFEFEFEE5FEFEJ/:08":'9%
+4E5FEFEFEE5E5E5E5FEFEE5E5FEFEFEFEE5E5FEFEE5FEFEE5E5FEFEE5E5E5FEFEE5E5FEFEFEE5FEFEJ&J#H"
+5E5E5FEFEFE7E5E5E5J"8"9#>#
+7E5FEFEFEFEFEJ#8";%<%
+4FEFEE5E5E5E5E5E5E5E5E5J#>#;#;"
+@FEFEFEFEFEFEFEJ/:.8%9'
+4E5FEFEFEFEFEE5E5E5FEFEFEFEE5E5FEFEFEFEE5E5E5FEFEFEFEE5E5FEFEE5E5FEFEFEFEE5J&9%8#8%9%:&8%8#8#
+5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5
+
+
+
+
+
+
+Fz
+U*FE
+H5
+U%FFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFH5
+U&FEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFH#Z
+FFFEU#H#J#
+FEFFO1FEFEH#J"J"9"C"=#J"B$8#A":#J"@":$J$J"
+FFFE5FEO"FEFEFEFEFEGFEFEFEFEFEFEFEFEFECFEFEFEFEFE9FEFEFE;FEH#J#J#9"C"="H"I#B(A#:"J):":#C%?#J"="G&
+FEFF4FEFFO!FEFFFFFFFFFEFEFEFEFFFFFFFEFFFFFEFFFFCFEFFFEFEFEFEFEFEFFFFFFFEFEFEFEFFFF4FEFFFEFEFEFEFEH#J#J&J%J'
+FFFEPKFFFFO<FFFEFFFFFF8FEFFFFFFO,FFFEFFFFFFFEH#8&9$<#9$:$8&8&:$8&<#8$9,;$:&8$9&9$J$<#9$:$8&:$:$<#:":$B$="9$A$:$9&8$;$8&A$8(
+FEFFFEFFFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFFFEFEFEFEFEFFFEFEFEFEFFFEFEFEFEFEFEFFFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFE@FEFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEH#8&8&?&848-?#:+;%9-8&8&J%?%9-8&8&@"8"8#B&9#:&?&8&8&8#;-9%8)9#
+FFFEFFFEFFFFFFFEFFFFFFFEFEFFFFFFFEFEFFFFFFFEFFFFFEFFFEFFFEFFFFFEFFFEFFFEFEFFFFFFFEFFFFFEFEFFFFFEFFFFFFFEFFFFFFFEFFFFFFFFFEFFFFFFFEFFFFFFFEFFFFFEFFFFFFFEFFFEFFFFFFFEFFFFFFFE?FFFFFFFEFEFFFFFFFEFFFFFFFEFFFFFEFFFEFFFEFEFFFFFFFEFEFFFFFFFEFEFFFFFFFEFFFFFFFEFEFEFEFFFFFFFEFEFFFFFFFEFEFFFFFFFEFFFEFFFFFFFFFFFEFFFFFFFEFFFFFEFEFFFFFEFEFEFEFFFEFFFFFFFEFFFFFFFFFFH#C":#="J"=#B"J$@&8&J#A$G&:#:"J$9&9$A$="J"<%@$
+FEFFFFFEFFFF?FFFEFFFE:FEFEFEFFFEFEFEFFFEFEFEFEFE@FEFFFEFEFEFFFEFEFEFFFEFFFF4FEFEFEFFFFFEFEFEFEFEFEFEFEFEFF8FFFFFFFFFEFFFEFFH#J%@%8PJ%G%A"I%:#:%@%J$
+FFFEP0FFFFFFFFFFFFFFFEMFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFO&FEFFFEH#C"9#>"J#A&J"=$J#E"F"=#J"8"@"C"<"="J&
+FEFFFEFEFFFEFFEFFFFFEFFFEFF;FEFEFFFEJFEFFFEFEFEFF=FEFEFEFEFEFEDFEFFFFFFFEH#8%9&?&8(;#;,B&?&8,9&9,?&9";-?/;(8&>%:&8-9%8&8-8&9,8*9(8(;"
+FFFEFEFEFEFEFFFEFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFEFEFEFFFFFEFEFEFFFFFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFFFEFFFFFEFEFEFFFEFEFEFFFFFEFEFEFFFFFFFEFEFEFFFEFEFEFEFEFEFFFEFEFEFFFFFEFFFEFEFEFFFFFEFEFEFFFEFFFFFEFEFEFFFFFEFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFFFEFEFEFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFEFEFEFEFFFEFEFEFFFFFEFEFEFEFEFEFEFEFEFFFFFEFEFEFFFFFEFE&C#8%:$9#<$:$8Y8$8$8"8#;P9$9P9P8$:$;$9$@P9"<$8P9#<P8$8R8$:$9#:%:P8Q8$9%:$9Q8$:$;$8P9$8$8R:$8#9#F%
+F7F7F7F7F7FEFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF7F7F7F7&C#F"J"J"J"J&
+F6F6F6F6F6FFFEFFO"FFP%FFIFFPIF6F6F6F6F68$C#J%J%
+F9F9F9FEFFP)FEFEFEFFS%F9F9F9F7H#J#J$
+FFFEO1FFFFDFFFFFFH#
+FEFFH"
+FFHz
+U&FE
+Fz
+U*E5
+
+
+
+
+
+
+
+
+<z"z"z
+0F6F7TJF6F71F6;z8z8z
+1F9TIF91F9
+
+7z8z8z
+5F7TIF74F7"J"J"
+F76F7TJF7
+ENDBITMAP
+%%EndBinary
+117 510 261 528 R
+7 X
+V
+4 8 Q
+0 X
+(f) 117 522.67 T
+(ileselectionbox .fsb) 121.8 522.67 T
+(pack .fsb -padx 10 -pady 10) 117 512.67 T
+0 10 Q
+(FIGURE 30) 118.67 485.17 T
+1 F
+( - Fileselectionbox) 170.06 485.17 T
+0 0 612 792 C
+0 12 Q
+0 X
+0 0 0 1 0 0 0 K
+(Pr) 392.27 377.71 T
+(omptdialog) 404.72 377.71 T
+1 10 Q
+(Based on the Dialog class, the Promptdialog provides a) 315 359.05 T
+(Motif style prompt dialog.) 315 347.05 T
+315 403.71 540 720 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+315 430.57 540 716.86 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+331.57 439.43 529.57 558.71 R
+7 X
+V
+4 8 Q
+0 X
+(messagedialog .cr -title Copyright \134) 331.57 553.38 T
+( -bitmap @dsc.xbm -imagepos n \134) 331.57 543.38 T
+( -text \322Copyright 1995\134) 331.57 533.38 T
+( DSC Communications Corporation\134n\134) 331.57 523.38 T
+( All rights reserved\323) 331.57 513.38 T
+(.cr hide Apply) 331.57 503.38 T
+(.cr hide Cancel) 331.57 493.38 T
+(.cr hide Help) 331.57 483.38 T
+(.cr activate) 331.57 463.38 T
+(update) 331.57 453.38 T
+(after 10000 \322.cr deactivate\323) 331.57 443.38 T
+0 10 Q
+(FIGURE 31) 373.47 412.6 T
+1 F
+( - Messagedialog) 424.86 412.6 T
+%%BeginBinary: 11506
+368 342 147.2 136.8 0 356.8 566.43
+/red <
+3EC472FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+FFFFFFFFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBF80808080
+8080808080808080808080808080808080808080404040404040404040404040
+4040404040404040404040000000000000000000000000000000000039C069DD
+00FF0000003333330033CCDD9999112277005544FFCC66AABBFF33EE9999CC7A
+EFD3557F9765E1A36FE700FF5500B22EAFB4CD73E6A24DBF0087F599FFFFB07A
+FFCCB088439D58D750D080C0C080C0808060C000FFA000FF20C0A040C040D060
+F0E010B4BE8BD28BD9B3FF7299FFA00019BF2FFF6223852F465F4770FF0000FF
+> store
+/green <
+57D79F00000000000000000000000000FFFFFFBFBFBFBFBF8080808080404040
+40000000FFFFFFFFFFBFBFBFBF808080808040404040400000000000FFFFFFFF
+FFBFBFBFBFBF8080808040404040400000000000FFFFFFFFFFBFBFBFBFBF8080
+8080804040400000000000FFFFFFBFBFBFBFBF80808040404040400063E0B500
+996699FF00663399BBFF99DD99FF112277005544CCCC66AABB6600EE6600CC69
+E3B56B7F9765E1A36FE700FF1A00B28BEEEE0073E6A24DBF00CEF599FFFFB094
+FFF730884DB358D78080C0C080C080808060C08000A080402070A0402040D0F0
+F0E010B4BE5BB477D9B3FF7789E4A0FF19264F00B641DE4F829E4780FF0000FF
+> store
+/blue <
+8CFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFBF8040FFBF804000FFBF804000FFBF80
+00BF8040FFBF804000FF804000FFBF804000FFBF804000FFBF804000FFBF8040
+00FFBF804000FFBF4000FFBF804000FFBF804000FFBF804000FFBF804000FFBF
+804000FFBF00FFBF804000BF8040FFBF804000FFBF40FFBF8040004063E0B500
+FF3399FF88666666009966DDFFFF112277DD554499FFCCAABBCC99EE9966CC69
+E3B52F7F9765E1A36FE7BFCC8BEEB257EEB40073E6A24DBF80FAF56BFBB3B015
+3224608856CA58D7D050C080C08080C08060C080FF0000402070C0802040D060
+50E010B4BE7A8C65D9B3E08576C4A00070264F00FC5AE050B4A0FF9000FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+6F6F7TMF6F76F6F7J"
+ULF78z8z8z
+4F9TLF94F9
+
+;z"
+UCF7F6<z"z
+0F6F7U0F6=z8z
+/F9U/F9
+J'J#?$>"
+Q8FEFEFEFEF9FE?FEFEFEFEFEFEJ'J"?"
+Q7FEFEF9F9F9FEKF9FEJ$9"J#<#
+Q6FEFEF9F9@F9F9FEFEJ$8'829&;#9"8#
+QAFEFEFEFEFEFEF9FEFEFEFEFEFEF9FEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEF9FEFEFEFEFE@s"J+8'8'8"8":':%8"8#
+F6F7Q*F9F9FEFEFEF9FEFEFEF9FEF9FEFEFEF9F9F9F9FEF9F9FEF9FEFEF9F9FEFEFEF9FEFEF9F9F9ArJ$;$9':$E"
+F9Q/F9F9F9F9F9F9F9FEFEF9FEF9F9F9F9F9@sJ"J'
+F7Q+FECF9FEFEFEFEF9@tJ$9":$;$:%C&
+F9Q#F9FEFEFEFEF9FEFEF9FEF9FEFEF9FEF9F9F9F9J09&>"8"8"8"8(8"9"8$
+Q7F9FEFEFEFEFEF9F9F9F9FEFEFEF9F9F9FEFEF9F9FEFEFEFEFEFEFEFEFEF9FEFEFEF9FEFEJ&:$<#<"9%8';"s9#
+Q8F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9FEF9F9F9J%E&
+R FEFEFEF9FEF9F9F9F9J"8"<"F(
+QFFEFEF9F9FEFEFEFEFEF9=z8z
+/F7U/F7rF"J%
+F7F7U0F7F7F7F7'z&
+F6F6F6F6F6F7UBEDF6F6F6F6F68$J%
+F9F9F9UDF9F9F9F7
+
+
+
+
+
+
+
+
+
+J"9"9"9"
+R$FEFEFEFEJzJz
+R 5FEO7;FEJ"9z8"J%J%J'J'
+O'FEEFEFEOEFEFEFEFE5FEFEFEFEO-FEFEFEFEFEFE;FEFEFEFEFEFEJrJzJ$J&J$J&
+O$FEE/FEO6FEFEFE=FEFEFEFEFEO%FEFEFEGFEFEFEFEFEJ'J#J"J$J%
+P1FEFEFEFEFEFEO.FEFEEFEO!FEFEFEO!FEFEFEFEJ"J%J"J$J%
+O#FEO3FEFEFEFEO)FEOFFEFEFEO(FEFEFEFEJ%J#AwJ$HzJ"
+P;FEFEFEFEO#FEFEEDO-FEFEFE1ED:FEJ"J$J"@$B%D"J#F&G%J"
+O"FEO<FEFEFEMFEEDEDEDEDEDEDEDFEFFEFEEDEDEDEDEDEDEDEDED6EDJ#JzJ#J#?#J"J#D%J$I"
+O"EDED@2ED:FEFEIFEFEEDED4EDO#FEFEEDEDEDED:EDEDEDFEJ&J&H'J%J"@"J$J"D#J#
+O$EDEDEDEDED6EDEDEDEDEDEDEDEDEDEDED6FEFEEDFEDFEED5EDEDEDO!FEEDEDAEDEDJ#H#J%J"J"?"J#J#B$J#
+O)EDEDEDED=EDEDEDED4FEDFEED:EDEDKFEFEEDEDEDEEDEDJ"F"J$I#J"A"J#J#B#J#
+O+EDEDCEDEDEDFEFE@FEED:FEEDHFEFEEDEDJEDEDJ"J$H#J"J$>"J"C"J"
+O,EDO(EDEDEDFEFEHED<EDEDEDFE=FEEDO EDJ"H"J"?"J"J#B#J"
+P9EDFE<FEED?FEDFEFEEDEDO"EDJ%G$J"J#J"C"J"
+P8EDEDEDEDFEFEFE8FEJEDEDBFEEDO%EDJ"J"J"J"J"B#J"
+O-EDO.EDO'EDBED@FEEDEDO'EDJ#G"J"J"B"J"
+P=EDEDFE6FEO?FEEDO*EDJ#F"J"J"J"B"J"
+P?EDEDFE?EDDED=FEEDO,EDJ"F$G"J"B"J"
+PAEDFEEDFEFEO>FEEDO.EDJ"F#J"B"J"
+PBEDFEEDP!FEEDO7FEJ"F"J"J"B"J"
+PCEDFEO4ED9FEEDO1EDJ"J"J"H"B"
+Q'FE:EDLFEFEEDJ#F"D"J":"G"B"J"
+PDEDEDFEFEO$EDEDFEEDO4EDJ"F"J"
+PFEDFEOHFEJ"F"J"J"8"J"J"
+PGEDFE7FEHEDED>EDO6EDJ"J#G"B"
+PHEDOCEDEDFEEDJ"E"J"
+PIEDFEODFEJ"F"J"
+PIFEFEP"EDJ#J"B"J":"
+PIEDEDP$FEEDO:EDFEJ"E#J"J"J"
+PKEDFEFE4FEO*FEOMEDJ"J"J%
+Q.EDOLEDO<EDEDEDEDJ"E"J"
+PLEDFEO>FEJ"
+QDFEJ"E"J"J"C"
+PMEDFE5FEO&FEEDJ"
+PMFEJ#E"<"D"J"C"
+PMEDEDFEEDFEO$FEEDJ"
+QGFEJ"
+QHFEJ"E"<"F"J"
+Q!EDFEEDFEO FEJ"J"
+QJFEO-EDJ"
+QKFEJ"E"<"H$J"
+Q"EDFEEDFEFEFEHFEJ"
+Q:EDJ#J"
+R!FEFEO&EDJ"J"
+Q;ED5FEJ"J#J#J"
+Q#ED7FEED5FEFEBFEJ"J$
+Q;ED8FEEDFEJ"J"
+Q=ED7FEJ"@"J#
+Q3FEED8FEFEJ"J"
+Q?ED9FEJ"J#
+Q@ED9FEFEJ"J"J$J"
+Q$ED<ED:FEEDFE6FEJ"J"
+QBED:FEJ"J"J"
+Q$FE>ED;FEJ"J"J$
+Q$ED?ED;FEFEFEJ#
+QEEDEDJ#J"
+QGEDED:FEJ"J$
+QIED:FEEDFEJ"J#
+QKED9FEEDJ"J$J#
+Q$FEEEDEDED9FEFEJ"J#J"
+Q$EDHEDED:FEJ"J"J#
+Q$FEJED8FEEDJ#J"
+R"EDED7FEJ"J"J"@"
+Q3ED>ED7FEEDJ#J"
+R%EDED6FEJ"
+R'EDJ"J"J"
+R)ED4FE8FEJ$J"
+R(EDEDED4FEJ"J#
+Q2EDFEDEDJ"J"
+Q#FEO)EDJ"G"="
+R.EDFEEDJ"J"
+R/EDHFEJ"J"F"
+Q1EDLEDFEJ"J"
+Q"FEO.EDJ#J"E"
+R1FEED6EDFEJ"J"F"
+Q0EDO EDFEJ"
+R3EDJ"J"E"
+Q!FEOHEDFEJ"J"
+Q/EDO$EDJ"J"E"
+R4FE6EDFEJ"C"J#
+Q FEEDO%EDEDJ"
+RLEDJ"C":#J"
+PMFEEDFEFEOHFEJ"8"J"E"J"
+Q1FEFEO8EDFEO>FEJ"C">"J%
+PLFEEDFEQ7FEFEFEFEJ"C"J"E"J"
+PKFEEDOBEDFEO;FEJ"
+R6EDJ"C"A#J"E"J"
+PJFEEDFEFEO7EDFEO9FEJ"C"J"A"C"E"
+Q)EDEDLFEEDEDFEJ"B#C"J"J"E"J";"
+PIFEEDFEFELED:EDFEO6FEEDJ"D"="J"
+PHFEEDEDO$FEJ"C"F"J"E"J"
+PGFEEDFEO9EDFEO4FEJ"C"J"G"E"J"
+PFFEEDO:EDEDFEO2FEJ"C"I"J"E"J"
+PEFEEDFEO:EDFEO8EDJ"J"C"J"E"J"
+O<FEO'FEEDP"EDFEO/FEJ"C"J"J"@"J"E"J"
+PCFEED6FEHFEED5EDFEO-FEJ"C"J"J"E#J"
+PBFEED8FEO;EDFEFEO*FEJ#J"B#F"?"J"@"J"F"J"?"
+O=FEFEO"FEEDEDEDFEEFEED8EDFEO(FEEDJ"F"J#B#J#J"F"J"
+O-FEEDO FEFEEDFEO=EDFE9EDFEO&FEJ"J"C$J$J"A"J"F#J"@"
+O>FEMFEEDEDED<FEEDFEAFEED:EDFEFEO#FEEDJ"J#B#J#J"@"J#F"J#
+O?FEJFEFEEDED@FEED@FEED=EDEDFEO FEFEJ"I"J$C"J"A$J"@"J"F#J"B"
+O,FEFEFFEFEFEED7EDFEEDFE=FEED@EDFEFEKFEEDJ$J#D#J"J"@"J#F#J#
+OAFEEDFEAFEFEEDEDEFE=FEEDBEDEDFEFEGFEFEJ"J"J$D"J"D"J"@"J"G$J#
+O+FE6FE?FEFEFEED;FEFE:FEEDEEDFEFEFEBFEFEJ$J$J%E"8"J#D$J#@"J#H#J#F"
+O(FEFEFE9FEFEFE7FEFEFEFEEDED:EDEDFEFEFE5FEFEEDGEDEDFEFE>FEFEEDJ&Jr8":tG"8"J#G#A"J#H%J$
+O#FEFEFEFEFE?FEFEFEEDEDO!FEFEFEFEEDJEDEDFEFEFEFE7FEFEFEJ$JrJ&J%?%A"J#J&C&J"
+O FEFEFEKFE7EDEDEDEDEDO%FEFEFEFEFEFEFEFEEDO EDED4FEFEFEFEFEFEFEFEFEFE4EDJ#J$JtD$J$JxJ$
+P;EDEDFEDEDED4FEEDEDEDO!EDEDED6FE6EDEDEDJ"J$8"J"J#J$J$
+O EDO7EDEDEDEDHEDHEDEDO'EDEDEDO%EDEDEDJ&J%J#J$J$
+P3EDEDEDEDEDO!EDEDEDEDBEDEDO,EDEDEDMEDEDEDJ"JrJ$J$J%J&
+O!EDO*EDO*EDEDED<EDEDEDO1EDEDEDEDDEDEDEDEDEDJzJ&I%J'J'
+O"O*EDO4EDEDEDEDEDEDEDEDEDO8EDEDEDEDEDED8EDEDEDEDEDEDJzJz
+QE3EDOB8ED
+
+
+
+
+
+
+
+
+
+Jz
+O"SHFE
+
+
+Jz
+O"SHED
+
+
+
+
+
+
+
+
+
+
+J"H"J"8"J"@#J#
+O+FEFEP@FEFE=FEFEFEO4FEFEJ#9%A#8%A%>%>&=%>&<$=&=$=%B%9#C"Bw>&A#9$A&=$>(
+O&FEFEEDFEFEFEFEFEEDFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEEDFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEEDEDFEFEFEJ%:"A%9%@"9"@">"D">"9"<$="C"="D%9%A$C$9%>"9"?%9&?"C"=$8"8"
+O$FEFEFEEDEDFEFEEDEDEDEDFEFEEDFEEDEDEDEDEDEDFEEDEDEDEDFEFEEDEDEDEDFEFEFEFEFEEDEDEDEDEDEDEDEDEDFEFEEDEDEDEDFEFEFEEDEDFEFEEDEDFEJ"8"<"?$=$J"J"<"J%="J"@#I"?"8"C"J$
+O#FEEDEDFEFEEDEDFEFE4FEO0FEED6FEFEFEEDED;EDEDEDFEEDFEFE6EDFEEDJ"8">"="C"C"<"F";#8"J"9"J"J"J"J"9"J"
+O"FEEDEDFEFEFEEDFEFEEDFE?EDFEHED9EDBED5EDFE6EDJ"8"?"J"B"J"9":"J"8"J"9"J"A"8"@"9"C"8"
+OBEDFEED7EDED@EDFEFE5FEED4FEFEJFEEDFEEDFEFEFEJ"J"J"9#E"8"9#J"9"9"J"J"J"F"9#
+O!FE6ED:FEFEEDEDFEFEEDEEDFEEDO EDO!ED8EDEDFEFEJ"F"J"J"J"J$8"J"J"8"C":#
+O$EDFE:EDCFEBEDO&EDEDEDFEKFE9EDFEEDFEFEJ":"J"8"J"J"J"8"C";"
+P)EDFEO-EDFEO!FEO#ED:EDFEEDFEJ"F"J"8$;"B"8%J":"8"J$J"J"C#:"
+O$FEED;EDFEEDFEEDEDFEEDFEEDDFEEDFEO!FEFEFEO FE>FEEDEDFEJ"J"J"J"J">#J'8"J"9"D#
+O!ED6FE<FE7FEFEDFEFEKFEFEEDEDEDEDFEO8EDFEEDEDJ"8"B"9";"C"9"J"J"8"I"J"E"
+OBFEEDEDEDFEEDEDKED9EDFEEDO0EDEDJ"8">"="8"J"<"J"="<"8"J"8">"I"A"<"
+O"EDFEFEEDFEOLFEEDEFEFEEDFEGEDFEFEEDFEEDJ"I"?"8"J#H"J"8"="?"J"B"H"A";$
+O#EDEDFEEDO5FEEDED8EDFEFEEDO#EDEDEDFEFEFEEDJ%;"@%:%?";$E";$F"8";"J"J"8";$<"A"J$<$A"J"
+O$EDFEFEFEFEEDFEFEFEFEFEEDEDFEEDFEEDFEEDFEEDEDFEFE5ED8EDFEFEFEEDFEFEHEDFEFEFEFEEDFE4FEJ%8%@*@"8#9"9#9"<"8#9":"9"?+?"8"G#9"@+<"8#:":">#9#?#9"@+?#8"="?"8'
+O%EDEDFEFEFEFEFEEDEDEDFEFEFEFEFEEDEDFEFEFEEDFEFEFEFEFEFEEDFEFEEDEDFEFEFEFEFEFEEDEDFEFEFEFEFEEDEDEDFEFEEDFEFEFEEDFEFEFEFEFEFEFEFEFEFEFEFEEDEDFEFEFEFEFEFEEDEDFEFEFEEDEDFEFEFEFEEDEDJ#8$C&B&='<&>&A'A%>#='C'=&:'>r?'B'A&>#>'
+O'EDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDED
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+J%J#>#<#>#:%9%9&<&;&;%>%J#F#8#J%J#8#
+IFEFEFEFE<FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFELFEFEFEFEFEFE=FEFEFEFEHFEFEFEFEJ'J#J#;.:$>%9(9'<'J#J#J'J#
+HFEFEEDEDFEFE;EDED8FEFEFEFEEDEDFEFEEDFEFEEDEDFEFEEDEDEDEDEDFEFEFEFEEDEDEDFEFEFEFEEDEDFEFEFEFEEDEDFEFEKEDED4EDED<FEFEEDEDFEFEKEDEDJ$8(8&8#9+8&:#8"8";#I$C$A$8#;$8(8*8*8#8)8#8%9%8"8%8%8&9%=$8(8+9%8+8"8%8%8&
+GFEFEEDEDEDEDFEFEFEFEFEFEEDFEFEFEFEFEFEEDFEFEEDFEFEFEFEFEFEEDFEFEFEFEFEFEEDEDFEFEEDEDFEFEFEFEEDEDEDFEFEEDEDEDEDFEFEFEFEFEEDFEFEFEEDFEFEFEFEEDFEFEFEEDFEFEFEFEFEFEFEEDFEFEEDFEFEFEFEFEFEFEFEFEFEFEFEFEFEEDFEFEFEFEFEFEFEFEEDFEFEFEFEFEFEFEFEEDEDEDEDFEFEFEFEFEFEEDFEFEFEFEEDFEFEFEFEFEFEFEFEEDFEFEEDFEFEFEFEFEFEEDFEFEFEFEFEFEFEFEEDFEFEJ'9%A";%;'8"J$F(J'8*8*@%:08":'9,C'9":,9"8)8":'9%
+O FEFEEDEDFEFEFEEDFEFEFEFEFEEDFEFEEDFEFEEDEDED<FEFEFEEDFEFEFEEDEDED5FEFEEDEDFEFEFEEDEDFEFEEDEDFEFEFEEDEDFEFEEDEDFEFEFEEDFEFEFEFEEDEDFEFEEDFEFEEDEDFEFEEDEDEDFEFEEDEDFEFEFEEDFEFEEDFEFEEDEDFEFEFEFEEDEDFEFEFEFEEDFEFEEDFEFEEDEDFEFEFEFEFEEDEDFEFEEDEDEDFEFEEDEDFEFEFEEDFEFEJ":(:#<";"J%9%9'F&J"A&J"<%J#8"D%J"
+O)EDEDFEFEEDFEFEEDEDEDEDED4EDFEFEFEEDFEFEFEEDEDEDEDFEFEEDEDFEFEFEO.EDEDEDEDEDED6EDFEEDEDED7EDEDEDEDEDEDED6EDJ"J$:$J"8"J$J&J"H"9$
+O8EDDEDEDEDEDEDED;EDFEO=FEFEFE9EDEDFEFEFE7EDEDFEFEFEJ&J#I#8"J%J"8"J%
+O/EDFEFEFEEDO(FEFEFEFEEDO>FEFEEDED;EDFELFEFEEDEDJ$8#?"J"D"A#;#J$A$8#;$8#J"G#B"G%>$8#D"J"
+GEDFEFEFEFEFE7FEFEFEFEFEFE5FEFEEDEDFEFEFEFEEDFEFEFEFE@FEFEFEFEFEFEEDEDEDFEFEFEFEFE;FEJ-9%9"C%A%A5>%9(9'<-J%C49'>'=->,<-9'
+HEDFEFEFEFEEDEDFEFEFEFEEDEDFEFEEDEDEDFEFEEDEDFEFEED4EDFEFEFEFEEDEDEDFEFEFEFEEDEDEDFEFEFEFEEDFEFEFEEDEDFEFEFEFEFEEDEDFEFEFEFEEDEDFEFEFEFEEDEDFEFEFEFEED7EDFEFEEDEDFEFEFEFEEDEDEDFEFEFEEDFEFEEDEDFEFEEDEDFEFEFEFEEDEDFEFEFEFEEDEDFEFEFEFEEDEDFEFEFEFEEDEDFEFEEDEDEDFEFEFEFEEDEDFEFEFEEDFEFEEDEDFEFEEDEDFEFEFEFEEDJ%8%;#<"9#9#8#:#8#9#=#:%9%9%=&;&;%>%8%8#8#8&8#8#8s8&8%9'8&8%8#8#8%?%8%8#<#9%8#:'8&8%8#8#
+IEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDJ"C#
+O0FEFEFEJ$B'
+O/FEFEEDEDFEFEFEFEEDJ#<#D%J#
+O'EDEDEDEDEDEDEDEDR1EDED
+J#9&@#>#<#J#
+PJFEFEFEFEEDFEFEFEFEFEFEFEFEO1FEFEJ"8"G#
+PIFEFEEDEDJ#C(8&:#8"8"8%<+9%9%8(9#8%9#
+PJEDEDFEFEEDFEFEFEFEFEFEEDFEFEFEFEFEFEFEFEFEFEFEFEEDFEFEEDFEFEFEFEFEFEFEFEFEFEFEFEFEFEEDFEFEFEFEFEFEFEFEFEFEFEFEJ":"C";%;'8)="859"@,
+PHFEFEFEFEFEEDFEFEEDFEFEEDEDEDEDFEFEEDEDFEFEFE4FEFEEDEDFEFEEDFEFEEDEDFEFEEDFEFEEDEDFEFEFEFEFEEDEDFEFEEDFEFEEDFEJ#<";"A%>#?%A*A"
+Q.EDEDEDEDFEEDEDEDEDEDFEEDEDEDEDEDEDFEFEEDFEFEEDEDJ#E"J&>":#9&:#;"B#
+PJFEFEED8EDEDFEFEFEEDFEFEEDEDFEFEFEFEFEEDFEFEJ)J"8"B%9"8"9%=&:%
+PGFEFEEDEDEDEDFEFEGEDFEEDEDEDEDEDFEEDEDEDEDEDFEFEFEEDEDEDEDEDJ"D&F(=#H#:"
+Q6FEFEFEFEEDEDFEFEEDFEFEEDEDFEFEFEFEFEJ%A+@5>$9,
+Q3EDFEFEEDEDFEFEEDEDFEFEFEFEED4EDFEFEFEFEEDEDEDFEFEFEFEEDEDEDFEFEFEFEEDEDFEEDEDFEFEFEFEEDEDEDFEFEEDJ#:r;#9#8#:#8#9#8%<#:%9%9%8#<";%9&
+PGEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDJ#
+Q3FEFEJ'
+Q3EDFEFEFEFEEDJ%
+Q4EDEDEDED
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+<z
+UBEC=z"
+U@EDFF=Z
+U@<z
+UBED
+
+
+
+
+
+
+
+Jz
+Q0O-ECJ"
+R<FFJz"
+Q2O)EDFF
+
+
+JZ
+Q6O!J"
+R6ECJz"
+Q8KEDEC
+
+
+
+
+J%:#9#
+QFFEFEFEFEFEFEFEFEJ'=$
+QEFEFEEDEDFEFEFEFEEDJ$8$;$
+QDFEFEEDEDFEFEFEFEEDJ$
+R"FEFEED
+J$
+R"EDFEFEJ$
+R#EDFEFEJ$8$<$
+QDEDFEFEFEFEEDEDFEFEJ'>$
+QEEDFEFEFEFEEDEDFEFEJ%:#:#
+QFEDEDEDEDEDEDEDED
+
+
+
+
+
+
+&J%
+F7F7F7F7F7UCF7F7F7F7&JzJ&
+F6F6F6F6F6Q3KECQ3F6F6F6F6F68$J"J%
+F9F9F9Q2ECR1F9F9F9F7Jz
+Q6O!ED
+
+
+JZ
+Q2O)J"
+Q1FFJz
+Q0O-ED
+
+
+
+
+
+
+
+<z"z"z
+0F6F7TMF6F71F6;z8z8z
+1F9TLF91F9
+
+7z8z8z
+5F7TLF74F7"J"J"
+F76F7TMF7
+ENDBITMAP
+%%EndBinary
+0 0 612 792 C
+315 72 540 720 C
+315 183.73 540 343.71 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+315 206.57 540 334.71 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 4263
+283 155 145.54 79.71 0 351 246
+/red <
+7266F5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+FFFFFFFFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBF80808080
+8080808080808080808080808080808080808080404040404040404040404040
+4040404040404040404040000000000000000000000000000000000039C069DD
+00FF0000003333330033CCDD9999112277005544FFCC66AABBFF33EE9999CC7A
+EFD39765E1A36FE700557FFF5500B22E99FFFFB07AFFB0CC0087AFB4CD73E6A2
+4DBF88F5439D58D750D080C0C080C0808060C000FFA000FF20C0A040C040D060
+F0E010B499FFA0BE8BD28BD9B3FF720019BF2FFF6223852F465F4770FF0000FF
+> store
+/green <
+9F99DE00000000000000000000000000FFFFFFBFBFBFBFBF8080808080404040
+40000000FFFFFFFFFFBFBFBFBF808080808040404040400000000000FFFFFFFF
+FFBFBFBFBFBF8080808040404040400000000000FFFFFFFFFFBFBFBFBFBF8080
+8080804040400000000000FFFFFFBFBFBFBFBF80808040404040400063E0B500
+996699FF00663399BBFF99DD99FF112277005544CCCC66AABB6600EE6600CC69
+E3B59765E1A36FE7006B7FFF1A00B28B99FFFFB094FF30F700CEEEEE0073E6A2
+4DBF88F54DB358D78080C0C080C080808060C08000A080402070A0402040D0F0
+F0E010B489E4A0BE5BB477D9B3FF77FF19264F00B641DE4F829E4780FF0000FF
+> store
+/blue <
+FFFFB3FFFFFFFFFFFFFFFFFFFFFFFFFFBF8040FFBF804000FFBF804000FFBF80
+00BF8040FFBF804000FF804000FFBF804000FFBF804000FFBF804000FFBF8040
+00FFBF804000FFBF4000FFBF804000FFBF804000FFBF804000FFBF804000FFBF
+804000FFBF00FFBF804000BF8040FFBF804000FFBF40FFBF8040004063E0B500
+FF3399FF88666666009966DDFFFF112277DD554499FFCCAABBCC99EE9966CC69
+E3B59765E1A36FE7BF2F7FCC8BEEB2576BFBB3B01532602480FAEEB40073E6A2
+4DBF88F556CA58D7D050C080C08080C08060C080FF0000402070C0802040D060
+50E010B476C4A0BE7A8C65D9B3E0850070264F00FC5AE050B4A0FF9000FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+6F6F7S&F6F76F6F7J"
+T%F78z8z8z
+4F9S%F94F9
+
+;z"
+SJF7F6<z"z
+0F6F7S7F6=z8z
+/F9S6F9
+JrJ"<r:#@$
+P*FEGFEFEFEFEFEFEFEJ"8&J"="8&E"
+P*F9F9F9F9FEFEEFEF9F9F9F9FEFEF9J$8#J#
+Q7F9FEFEF9F9;FEFEJ'8$9'8#8'9"8#D$9%@$:&
+P3FEFEFEF9FEFEFEFEFEFEFEFEF9FEFEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEF9@s"J&8"8*8+8(8#D"<%=/
+F6F7OJFEFEF9F9F9FEFEFEFEF9FEFEFEF9F9FEF9FEFEFEF9FEFEF9F9FEF9FEFEFEF9F9F9F9F9F9F9FEFEFEFEFEF9FEFEFEF9FEFEF9F9FEFEArJ%;$8$<"9"=$J$A$
+F9OIFEFEFEF9F9F9F9F9F9F9F9F9F9F9F9<F9FEFEF9F9F9@sJ$J%G'
+F7OIF9F9F9O0FEFEF9F9F9FEFEFEFEF9@tJ$H$H$?"A$9&
+F9P(FEF9FEFEF9FEFEFEF9FEFEF9FEFEF9F9F9F9J"8";"8"8*8"9"9"9&8$;"8&8"8'8$8*8&
+P*FEFEFEFEF9F9FEFEFEF9F9F9FEFEFEFEF9FEFEF9F9F9FEFEFEFEFEFEFEF9FEFEF9F9FEFEF9FEF9FEFEF9F9F9FEFEFEF9F9FEFEFEFEFEJ%;%:$9w:#;#;r9%8v9$9";"
+P*F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9FEJ&
+R'FEF9F9F9F9J"8"J(
+PMFEFEO$F9FEFEFEFEFEF9=z8z
+/F7S6F7rF"J%
+F7F7S7F7F7F7F7'z&
+F6F6F6F6F6F7SIE5F6F6F6F6F68$J%
+F9F9F9SKF9F9F9F7
+
+
+
+
+
+
+
+
+
+
+
+
+J&?#F#8#
+5FEFEFEFEFEFEFEFEFEFEFEJ(J#
+4FEFEE5E5E5FEFE>E5E5J%<%9%8"8%8%8&
+=FEFEFEFEFEFEFEFEFEFEFEFEFEFEE5FEFEFEFEFEFEFEFEE5FEFEJ/:08":'9%
+4E5FEFEFEE5E5E5E5FEFEE5E5FEFEFEFEE5E5FEFEE5FEFEE5E5FEFEE5E5E5FEFEE5E5FEFEFEE5FEFEJ&J#H"
+5E5E5FEFEFE7E5E5E5J"8"9#>#
+7E5FEFEFEFEFEJ#8";%<%
+4FEFEE5E5E5E5E5E5E5E5E5J#>#;#;"
+@FEFEFEFEFEFEFEJ/:.8%9'
+4E5FEFEFEFEFEE5E5E5FEFEFEFEE5E5FEFEFEFEE5E5E5FEFEFEFEE5E5FEFEE5E5FEFEFEFEE5J&9%8#8%9%:&8%8#8#
+5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5
+
+
+
+
+
+
+
+
+Hz
+S0A2J"
+SAFFJZ
+4S-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+I"
+FFHz
+S0E5
+
+
+
+
+
+
+
+
+
+
+<z
+SIE4=z"
+SGE5FF=Z
+SG<z
+SIE5
+
+
+
+
+
+
+
+Ez
+OAE4J"
+P!FFGz"
+O=E5FF
+
+
+JZJZJZ
+5O54O54O5J"J"J"
+OIE4OHE4OHE4Jz"Jz"Jz"
+7O1E5E47O1E5E47O1E5E4
+
+
+
+
+J%:#9#J%J#J#9#>#
+O!FEFEFEFEFEFEFEFEO0FEFEFEFE=FEFEO*FEFEFEFEFEFEJ'=$J'
+O FEFEE5E5FEFEFEFEE5O/FEFEE5E5FEFEJ$8$;$J$8(8&9%9%J%;&
+MFEFEE5E5FEFEFEFEE5O/FEFEE5E5E5E5FEFEFEFEFEFEE5FEFEFEFEFEFEFEFEFEFEO7FEFEFEFEFEFEE5FEFEJ$J'93J'<%
+O+FEFEE5O7FEFEE5E5FEFEFEE5FEFEE5FEFEE5E5FEFEE5FEFEE5E5FEFEO5FEFEE5E5FEFEFEE5FEFEJ#=">#J$E"
+PEE5E5E5E5E5O6FEFEFEE5J$J$I#J$;#
+O+E5FEFEO8FEFEFEFEFEO1E5E5E5FEFEJ$J%I%J%
+O,E5FEFEO6FEFEE5E5E5E5E5E5O7E5E5E5E5J$8$<$J$8#H#;#J#<"
+ME5FEFEFEFEE5E5FEFEO.E5FEFEFEFEFEFEFEFEO9FEFEFEJ'>$J.=.J'<%
+O E5FEFEFEFEE5E5FEFEO.E5FEFEFEFEE5E5FEFEFEE5FEFEE5FEFEFEFEE5E5E5FEFEFEFEE5O5E5FEFEFEFEE5E5FEFEE5J%:#:#J%8s8#8%9%8#J#9#8%8#:#
+O!E5E5E5E5E5E5E5E5O/E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5O*E5E5E5E5E5E5E5E5E5E5E5E5
+
+J#
+S#E5E5
+
+
+
+&J%
+F7F7F7F7F7SJF7F7F7F7&HzJzJzG&
+F6F6F6F6F6O1E48O1E48O1E4F6F6F6F6F68$G"J"J"J%
+F9F9F9E4OHE4OHE4OCF9F9F9F7JzJzJz
+5O5E54O5E54O5E5
+
+
+GZ
+O=F"
+FFEz
+OAE5
+
+
+
+
+
+
+
+<z"z"z
+0F6F7S&F6F71F6;z8z8z
+1F9S%F91F9
+
+7z8z8z
+5F7S%F74F7"J"J"
+F76F7S&F7
+ENDBITMAP
+%%EndBinary
+378 217.71 477 235.71 R
+7 X
+V
+4 8 Q
+0 X
+(promptdialog .pd) 378 230.38 T
+(.pd activate) 378 220.38 T
+0 10 Q
+(FIGURE 32) 368.58 188.61 T
+1 F
+( - Promptdialog) 419.97 188.61 T
+315 72 540 720 C
+0 0 612 792 C
+FMENDPAGE
+%%EndPage: "16" 16
+%%Page: "17" 17
+612 792 0 FMBEGINPAGE
+[0 0 0 1 0 0 0]
+[ 0 1 1 0 1 0 0]
+[ 1 0 1 0 0 1 0]
+[ 1 1 0 0 0 0 1]
+[ 1 0 0 0 0 1 1]
+[ 0 1 0 0 1 0 1]
+[ 0 0 1 0 1 1 0]
+ 7 FrameSetSepColors
+FrameNoSep
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+0 12 Q
+0 X
+0 0 0 1 0 0 0 K
+(Selectiondialog) 145.83 712 T
+1 10 Q
+-0.19 (The Selectiondialog class provides a dialog based Selec-) 72 693.33 P
+(tionbox.) 72 681.33 T
+72 377.72 297 720 C
+72 440.98 297 678 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+72 471 297 669 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 5294
+262 379 104.8 151.6 0 135 508.4
+/red <
+7266F5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+FFFFFFFFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBF80808080
+8080808080808080808080808080808080808080404040404040404040404040
+4040404040404040404040000000000000000000000000000000000039C069DD
+00FF0000003333330033CCDD9999112277005544FFCC66AABBFF33EE9999CC7A
+EFD39765E1A36FE700557FFF5500B22E99FFFFB07AFFB0CC0087AFB4CD73E6A2
+4DBF88F5439D58D750D080C0C080C0808060C000FFA000FF20C0A040C040D060
+F0E010B499FFA0BE8BD28BD9B3FF720019BF2FFF6223852F465F4770FF0000FF
+> store
+/green <
+9F99DE00000000000000000000000000FFFFFFBFBFBFBFBF8080808080404040
+40000000FFFFFFFFFFBFBFBFBF808080808040404040400000000000FFFFFFFF
+FFBFBFBFBFBF8080808040404040400000000000FFFFFFFFFFBFBFBFBFBF8080
+8080804040400000000000FFFFFFBFBFBFBFBF80808040404040400063E0B500
+996699FF00663399BBFF99DD99FF112277005544CCCC66AABB6600EE6600CC69
+E3B59765E1A36FE7006B7FFF1A00B28B99FFFFB094FF30F700CEEEEE0073E6A2
+4DBF88F54DB358D78080C0C080C080808060C08000A080402070A0402040D0F0
+F0E010B489E4A0BE5BB477D9B3FF77FF19264F00B641DE4F829E4780FF0000FF
+> store
+/blue <
+FFFFB3FFFFFFFFFFFFFFFFFFFFFFFFFFBF8040FFBF804000FFBF804000FFBF80
+00BF8040FFBF804000FF804000FFBF804000FFBF804000FFBF804000FFBF8040
+00FFBF804000FFBF4000FFBF804000FFBF804000FFBF804000FFBF804000FFBF
+804000FFBF00FFBF804000BF8040FFBF804000FFBF40FFBF8040004063E0B500
+FF3399FF88666666009966DDFFFF112277DD554499FFCCAABBCC99EE9966CC69
+E3B59765E1A36FE7BF2F7FCC8BEEB2576BFBB3B01532602480FAEEB40073E6A2
+4DBF88F556CA58D7D050C080C08080C08060C080FF0000402070C0802040D060
+50E010B476C4A0BE7A8C65D9B3E0850070264F00FC5AE050B4A0FF9000FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+6F6F7R?F6F76F6F7J"
+S>F78z8z8z
+4F9R>F94F9
+
+;z"
+S5F7F6<z"z
+0F6F7S"F6=z8z
+/F9S!F9
+J'>$H"9#Jr:#@$
+OHFEFEFEFEF9FEFEFEFEFEFEFE7FEFEFEFEFEFEJ'?"I"J"8&E"
+OGFEFEF9F9F9FEF9FE=F9F9F9F9FEFEF9J"J#J$8#J#
+OLF9BF9F9=F9FEFEF9F9;FEFEJ#8"9$?$:$8"8&:$9'G$9%@$:&
+OIFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEF9@s"J"9#8'<08$:*8%F"<%=/
+F6F7O4F9FEFEFEFEFEF9FEFEFEFEFEF9FEFEF9FEFEFEF9FEFEF9F9F9F9F9FEFEFEF9FEFEFEF9F9FEF9FEFEF9F9F9FEFEFEFEFEF9FEFEFEF9FEFEF9F9FEFEArJ#9":"A";%C$<"J$A$
+F9O6F9F9FEFEFEF9F9F9F9F9F9F9F99F9FEFEF9F9F9@sJ"8#;%>%J%G'
+F7O5FEF9F9F9F9F9F9F9F9F9F9O(FEFEF9F9F9FEFEFEFEF9@tJ">%>%9%C$J$?"A$9&
+F9O5FEFEF9FEFEFEF9FEFEFEF9FEFEFEF9FE6FEFEF9FEFEF9FEFEF9F9F9F9J0808&8,8"9";"8&8"8'8$8*8&
+OHF9FEFEFEFEF9F9F9F9FEFEFEF9F9FEFEF9F9F9FEFEFEF9F9F9F9FEFEFEF9F9FEFEF9FEFEF9F9F9FEFEFEF9F9F9FEFEFEFEFEFEFEFEF9FEFEF9F9FEFEF9FEF9FEFEF9F9F9FEFEFEF9F9FEFEFEFEFEJ':$8%9$:$:r9$9s;r9%8v9$9";"
+OGF9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9FEJ&
+R"FEF9F9F9F9J(
+R"F9FEFEFEFEFEF9=z8z
+/F7S!F7rF"J%
+F7F7S"F7F7F7F7'z&
+F6F6F6F6F6F7S4E5F6F6F6F6F68$J%
+F9F9F9S6F9F9F9F7
+
+
+
+
+
+
+
+
+
+
+
+
+J#8#
+4FEFEFEFE
+J"8"8%8*9%
+7FEFEFEFEFEFEFEE5FEFEFEE5FEFEFEFEFEFEFEJ"8)81
+7E5E5E5FEFEE5E5FEFEFEE5E5FEFEE5E5FEFEE5FEFEE5E5FEFEJ%
+O"FEE5E5E5J#D&
+>FEFEE5E5FEFEFEJ%D"8"
+>E5E5E5E5E5FEJ":#B%
+;FEFEFEFEFEE5E5J+B'
+8E5FEFEE5E5FEFEFEFEE5E5FEFEFEFEE5J#9#8%8#8#8#8%
+4E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5
+
+
+
+
+
+
+
+Hz=z
+R0A23E4J"J"
+RAFF9FFJZ@r"r"
+4R-DEE4DEFFJ"
+S#FFJ"
+S%E4J"
+S"FFJ$
+S$E5E4E4J$
+S!FFFFE5J$
+S%E5E4E4J$
+S FFFFE5J$
+S&E5E4E4J$
+RMFFFFE5J$
+S'E5E4E4J$
+RLFFFFE5J$
+S(E5E4E4J#u
+RKFFFFE4J"B"
+RLE4E4Jz
+RK/DEJZ
+RK/J"
+S+E4Jv"
+RME5E4
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+Jv
+RME4J"
+RLE4Jz
+RK/DEJZ
+RK/J"C"
+RKDEE4Jt$
+S E5E4E4DEJ$
+RLDEFFFFJ$
+S(E4E4DEJ$
+RMDEFFFFJ$
+S'E4E4DEJ$
+S DEFFFFJ$
+S&E4E4DEJ$
+S!DEFFFFJ$
+S%E4E4DEJ$
+S"DEFFE4J"
+S&DEJ"
+S#DEJ"
+S%DEJZ
+RK/I"J"
+FFR6FFHz=z
+R0E53E5
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+J&?#F#8#
+5FEFEFEFEFEFEFEFEFEFEFEJ(J#
+4FEFEE5E5E5FEFE>E5E5J%<%9%8"8%8%8&
+=FEFEFEFEFEFEFEFEFEFEFEFEFEFEE5FEFEFEFEFEFEFEFEE5FEFEJ/:08":'9%
+4E5FEFEFEE5E5E5E5FEFEE5E5FEFEFEFEE5E5FEFEE5FEFEE5E5FEFEE5E5E5FEFEE5E5FEFEFEE5FEFEJ&J#H"
+5E5E5FEFEFE7E5E5E5J"8"9#>#
+7E5FEFEFEFEFEJ#8";%<%
+4FEFEE5E5E5E5E5E5E5E5E5J#>#;#;"
+@FEFEFEFEFEFEFEJ/:.8%9'
+4E5FEFEFEFEFEE5E5E5FEFEFEFEE5E5FEFEFEFEE5E5E5FEFEFEFEE5E5FEFEE5E5FEFEFEFEE5J&9%8#8%9%:&8%8#8#
+5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5
+
+
+
+
+
+
+
+
+Hz
+RIA2J"
+S,FFJZ
+4RF
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+I"
+FFHz
+RIE5
+
+
+
+
+
+
+
+
+
+
+<z
+S4E4=z"
+S2E5FF=Z
+S2<z
+S4E5
+
+
+
+
+
+
+
+Ez
+O:E4J"
+OHFFGz"
+O6E5FF
+
+
+JZJZJZ
+5O.4O.4O.J"J"J"
+OBE4OAE4OAE4Jz"Jz"Jz"
+7O*E5E47O*E5E47O*E5E4
+
+
+
+
+J%:#9#J%J#J#9#>#
+KFEFEFEFEFEFEFEFEO)FEFEFEFE=FEFEO$FEFEFEFEFEFEJ'=$J'
+JFEFEE5E5FEFEFEFEE5O(FEFEE5E5FEFEJ$8$;$J$8(8&9%9%J%;&
+IFEFEE5E5FEFEFEFEE5O(FEFEE5E5E5E5FEFEFEFEFEFEE5FEFEFEFEFEFEFEFEFEFEO1FEFEFEFEFEFEE5FEFEJ$J'93J'<%
+O'FEFEE5O0FEFEE5E5FEFEFEE5FEFEE5FEFEE5E5FEFEE5FEFEE5E5FEFEO/FEFEE5E5FEFEFEE5FEFEJ#=">#J$E"
+P:E5E5E5E5E5O0FEFEFEE5J$J$I#J$;#
+O'E5FEFEO1FEFEFEFEFEO+E5E5E5FEFEJ$J%I%J%
+O(E5FEFEO/FEFEE5E5E5E5E5E5O1E5E5E5E5J$8$<$J$8#H#;#J#<"
+IE5FEFEFEFEE5E5FEFEO'E5FEFEFEFEFEFEFEFEO3FEFEFEJ'>$J.=.J'<%
+JE5FEFEFEFEE5E5FEFEO'E5FEFEFEFEE5E5FEFEFEE5FEFEE5FEFEFEFEE5E5E5FEFEFEFEE5O/E5FEFEFEFEE5E5FEFEE5J%:#:#J%8s8#8%9%8#J#9#8%8#:#
+KE5E5E5E5E5E5E5E5O(E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5O$E5E5E5E5E5E5E5E5E5E5E5E5
+
+J#
+R@E5E5
+
+
+
+&J%
+F7F7F7F7F7S5F7F7F7F7&HzJzJzG&
+F6F6F6F6F6O*E48O*E48O*E4F6F6F6F6F68$G"J"J"J%
+F9F9F9E4OAE4OAE4O<F9F9F9F7JzJzJz
+5O.E54O.E54O.E5
+
+
+GZ
+O6F"
+FFEz
+O:E5
+
+
+
+
+
+
+
+<z"z"z
+0F6F7R?F6F71F6;z8z8z
+1F9R>F91F9
+
+7z8z8z
+5F7R>F74F7"J"J"
+F76F7R?F7
+ENDBITMAP
+%%EndBinary
+135 480 243 498 R
+7 X
+V
+4 8 Q
+0 X
+(selectiondialog .sd) 135 492.67 T
+(.sd activate) 135 482.67 T
+0 10 Q
+(FIGURE 33) 123.53 453.1 T
+1 F
+( - Selectiondialog) 174.92 453.1 T
+72 377.72 297 720 C
+0 0 612 792 C
+0 12 Q
+0 X
+0 0 0 1 0 0 0 K
+(Fileselectiondialog) 380.17 712 T
+1 10 Q
+(The Fileselectiondialog is a dialog based Fileselection-) 315 687.33 T
+(box.) 315 675.33 T
+315 406.97 540 672 C
+0 0 0 1 0 0 0 K
+0 0 0 1 0 0 0 K
+315 438 540 663 R
+7 X
+0 0 0 1 0 0 0 K
+V
+0.5 H
+2 Z
+0 X
+N
+%%BeginBinary: 33477
+462 429 184.8 171.6 0 337.2 482.4
+/red <
+7266F5FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+FFFFFFFFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBFBF80808080
+8080808080808080808080808080808080808080404040404040404040404040
+4040404040404040404040000000000000000000000000000000000039C069DD
+00FF0000003333330033CCDD9999112277005544FFCC66AABBFF33EE9999CC7A
+EFD39765E1A36FE700557FFF5500B22E99FFFFB07AFFB0CC0087AFB4CD73E6A2
+4DBF88F5439D58D750D080C0C080C0808060C000FFA000FF20C0A040C040D060
+F0E010B499FFA0BE8BD28BD9B3FF720019BF2FFF6223852F465F4770FF0000FF
+> store
+/green <
+9F99DE00000000000000000000000000FFFFFFBFBFBFBFBF8080808080404040
+40000000FFFFFFFFFFBFBFBFBF808080808040404040400000000000FFFFFFFF
+FFBFBFBFBFBF8080808040404040400000000000FFFFFFFFFFBFBFBFBFBF8080
+8080804040400000000000FFFFFFBFBFBFBFBF80808040404040400063E0B500
+996699FF00663399BBFF99DD99FF112277005544CCCC66AABB6600EE6600CC69
+E3B59765E1A36FE7006B7FFF1A00B28B99FFFFB094FF30F700CEEEEE0073E6A2
+4DBF88F54DB358D78080C0C080C080808060C08000A080402070A0402040D0F0
+F0E010B489E4A0BE5BB477D9B3FF77FF19264F00B641DE4F829E4780FF0000FF
+> store
+/blue <
+FFFFB3FFFFFFFFFFFFFFFFFFFFFFFFFFBF8040FFBF804000FFBF804000FFBF80
+00BF8040FFBF804000FF804000FFBF804000FFBF804000FFBF804000FFBF8040
+00FFBF804000FFBF4000FFBF804000FFBF804000FFBF804000FFBF804000FFBF
+804000FFBF00FFBF804000BF8040FFBF804000FFBF40FFBF8040004063E0B500
+FF3399FF88666666009966DDFFFF112277DD554499FFCCAABBCC99EE9966CC69
+E3B59765E1A36FE7BF2F7FCC8BEEB2576BFBB3B01532602480FAEEB40073E6A2
+4DBF88F556CA58D7D050C080C08080C08060C080FF0000402070C0802040D060
+50E010B476C4A0BE7A8C65D9B3E0850070264F00FC5AE050B4A0FF9000FF00FF
+> store
+ BEGINBITMAPCOLORc
+z"z"z"
+6F6F7W!F6F76F6F7J"
+X F78z8z8z
+4F9W F94F9
+
+;z"
+WEF7F6<z"z
+0F6F7W2F6=z8z
+/F9W1F9
+Js8#8$D'>$H"9#Jr:#@$
+Q@FEFEFEFEFEFEFEFEFEFEF9FEFEFEFEFEFEFE7FEFEFEFEFEFEJ"8$>"E'?"I"J"8&E"
+Q@F9F9F9F9F9FEFEF9F9F9FEF9FE=F9F9F9F9FEFEF9J"9#J"J#J$8#J#
+QFF9F9F97F9BF9F9=F9FEFEF9F9;FEFEJ"9$?$>#8"9$?$:$8"8&:$9'G$9%@$:&
+QEFEFEFEFEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEF9FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEF9@s"J#8$?';"9#8'<08$:*8%F"<%=/
+F6F7Q0FEFEF9F9F9FEFEFEF9FEFEF9FEFEFEFEFEF9FEFEFEFEFEF9FEFEF9FEFEFEF9FEFEF9F9F9F9F9FEFEFEF9FEFEFEF9F9FEF9FEFEF9F9F9FEFEFEFEFEF9FEFEFEF9FEFEF9F9FEFEArJ#G">#9":"A";%C$<"J$A$
+F9Q1F9F9FEF9F9FEFEFEF9F9F9F9F9F9F9F99F9FEFEF9F9F9@sJ"E%;"8#;%>%J%G'
+F7Q3F9F9F9F9F9FEF9F9F9F9F9F9F9F9F9F9O(FEFEF9F9F9FEFEFEFEF9@tJ%<">%>%9%C$J$?"A$9&
+F9QBFEF9FEFEFEFEF9FEFEFEF9FEFEFEF9FEFEFEF9FE6FEFEF9FEFEF9FEFEF9F9F9F9J"8";"8$8)<0808&8,8"9";"8&8"8'8$8*8&
+Q@FEFEFEFEF9FEFEF9F9F9FEFEFEF9F9FEFEFEFEF9F9F9F9FEFEFEF9F9FEFEF9F9F9FEFEFEF9F9F9F9FEFEFEF9F9FEFEF9FEFEF9F9F9FEFEFEF9F9F9FEFEFEFEFEFEFEFEF9FEFEF9F9FEFEF9FEF9FEFEF9F9F9FEFEFEF9F9FEFEFEFEFEJ%;t9$<':$8%9$:$:r9$9s;r9%8v9$9";"
+Q@F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9F9FEJ&
+T9FEF9F9F9F9J(
+T9F9FEFEFEFEFEF9=z8z
+/F7W1F7rF"J%
+F7F7W2F7F7F7F7'z&
+F6F6F6F6F6F7WDE5F6F6F6F6F68$J%
+F9F9F9WFF9F9F9F7
+
+
+
+
+
+
+
+
+
+
+
+
+Js$8#
+4FEE5FEFEFEFEJ'
+6E5E5E5E5E5E5J#:"8"8%8&
+:FEFEFEFEFEFEFEFEFEFEE5FEFEJ"8)9"
+@E5E5E5FEFEE5E5FEFEFEJ$J#
+6FEFEFE6E5E5J$D#;"
+6E5E5E5FEFEE5J%
+GE5E5E5E5J":#
+DFEFEFEJ+
+AE5FEFEE5E5FEFEFEFEE5J#:&9#8%8#
+4E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5
+
+
+
+
+
+
+
+
+H5
+W+FFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFH5
+W*FEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFH#Z
+FFFEW'H#
+FEFFH#J$J"J":&9$>"E$<$J"J"J"9"C"=#J"B$8#A":#J"
+FFFECFEFEFE@FE8FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFECFEBFEO"FEFEFEFEFEGFEFEFEFEFEFEFEFEFECFEH#J"?$J#J#<%8&<#E#<%G"F#J#J#9"C"="H"I#B(A#:"J#9"
+FEFF8FEFEFFFF@FEFF6FEFEFFFFFFFFFEFFFFFFFEFEFFFFFFFEFFFFFFFEFEFFAFEFFO!FEFFFFFFFFFEFEFEFEFFFFFFFEFFFFFEFFFFCFEFFFEH#J#J#
+FFFEP!FFFFS&FFFFH#>&8&9&;#:#:$8&:$<#9$8#8)J)8#8#?&9$9&8&9$<):$9&9$<#9$:$8&8&:$8&<#8$9,;$:&8$9&9$J$<#9$:$8&:$:$<#8&
+FEFFFEFEFEFFFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFFFEFEFEFEFEFFFEFEFEFEFEFEFEFFFEFFFEFEFE;FEFFFFFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFFFFFEFEFEFFFEFEFEFEFEFFFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFFFEFEFEFEFEFFFEFEFEFEFFFEFEFEFEFEFEFFFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFE@FEFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFFFEFEFEFEFEH#>.8&@%8-8&?(9"8'@$9"8#>)9"@&8&8&8&8&>'8&8&8&?&848-?#:+;%9-8&8&J%?%9-8&8&?&
+FFFEFFFEFFFEFFFEFFFFFEFEFFFFFEFFFEFFFFFFFEFFFFFEFEFFFFFFFEFFFFFEFFFEFFFEFEFFFFFFFEFEFFFFFFFEFFFFFFFFFEFEFFFFFEFEFEFEFFFEFFFFFEFFFEFFFEFFFFFFFFFEFFFFFFFEFFFFFFFEFFFEFFFFFFFFFEFFFFFFFEFFFFFFFEFFFEFFFEFFFEFEFFFFFFFEFFFEFFFFFFFEFFFFFFFEFEFFFFFFFEFEFFFFFFFEFFFFFEFFFEFFFEFFFFFEFFFEFFFEFEFFFFFFFEFFFFFEFEFFFFFEFFFFFFFEFFFFFFFEFFFFFFFFFEFFFFFFFEFFFFFFFEFFFFFEFFFFFFFEFFFEFFFFFFFEFFFFFFFE?FFFFFFFEFEFFFFFFFEFFFFFFFEFFFFFEFFFEFFFEFEFFFFFFFEFEFFFFFFFEFFFFFEFFFFH#G"D#:"J$;#9&@"B&:#;#J$G&:#A$D":#="J"=#B"J$@&8&J#A$G&:#:$
+FEFFFFFEFFFF4FEFEFEFEFFFFFEFEFEFFFFFFFFFFFFFEFEFFFEFF@FEFEFEFFFEFEFEFFFEFFFEFEFEFFFEFFFF?FFFEFFFE:FEFEFEFFFEFEFEFFFEFEFEFEFE@FEFFFEFEFEFFFEFEFEFFFEFFFEFFFEH#J%@%J#J%G%G%J%@%8PJ%G%@$
+FFFEO-FFFFFFFFFFFFFFFE?FEFFHFFFFFFFFFFFFFFFEFFFFFFFFP0FFFFFFFFFFFFFFFEMFFFFFFFFFFFFFFFEFFFFFFH#J"8#J"9#:"J"=#8"9#J"D$=#E"C"9#>"J#A&J"=$J#E"F"=#
+FEFF<FEFEFF=FEFEFFFE:FEFEFFFEFEFFDFEFEFFFEFEFFFEFEFEFFFEFFEFFFFFEFFFEFF;FEFEFFFEJFEFFFEFEFEFFH#>";%9"8&=0;(?&8*9/9$?";59&8%:,>";(8%9&?&8(;#;,9">&?&8,9&9,?&9";-?/;(8&
+FFFEFEFEFEFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFFFFFEFEFEFFFFFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFFFEFEFEFEFEFFFFFEFEFEFEFFFEFEFEFE4FEFFFFFEFEFEFFFEFFFEFEFEFEFEFEFFFEFEFEFEFFFEFEFEFFFEFEFEFEFFFEFEFEFFFFFFFEFEFEFFFEFEFFFFFEFEFEFFFEFEFEFEFFFEFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFEFEFEFFFFFEFEFEFFFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFFFEFFFFFEFEFEFFFEFEFEFFFFFEFEFEFFFFFFFEFEFEFFFEFEFEFEFEFEFFFEFEFEFFFFFEFFFEFEFEFFFFFEFEFEFFFEFFFFFEFEFEFFFFFEFEFFFFFEFEFEFFFFFEFEFEFFH#>U8#9$8#:R8$8R8$9#<$:S8S8%9P8#:R8Z:$9%;$9$9#:R8$9%:$9#<$:$8Y8$8$8&;P9$9P9P8$:$;$9$@P9"<$8P9#<P8$8R8$:$9#
+FEFFFFFFFFFFFFFEFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFEFF1FFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFEFFH#J"J"J"J"J"J"J"J"
+FFFE>FFBFFO"FFO0FFBFFO"FFP%FFIFFH$rJ%
+FEFFFFFET-FEFEFEFFH#SJ$
+FFFET-FFFFFFH#
+FEFFH"
+FFHz
+W+E5
+
+
+
+
+
+
+
+
+
+
+
+
+J&9#J#D#Js$
+4FEFEFEFEFEFEFE5FEFEFEFEQ@FEE5FEFEJ%8#J#J'
+6E5E5FEFEE5E5EE5E5QBE5E5E5E5E5E5J29%8"8"8%8(8%9%J#;%9%
+8E5FEFEE5FEFEE5FEFEE5FEFEE5FEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEE5FEFEFEFEFEFEFEFEFEFEFEFEQ9FEFEFEFEFEFEFEFEFEFEJ"808)9";.J.
+AFEFEFEE5E5FEFEE5FEFEE5E5FEFEE5E5E5E5FEFEE5E5FEFEFEFEFEE5E5FEFEE5FEFEE5E5FEFEQ>FEFEE5E5FEFEE5FEFEE5E5FEFEJ#A#F#B%J$F%
+BE5E5E5E5E5E5FEE5E5E5Q4FEFEFEFEE5E5E5J":#J"=#9&J$?#9&
+AE5FEFE8E5FEFEE5E5FEFEFEQ5E5E5E5FEFEE5E5FEFEFEJ%J%9"8"J%9"8"
+FE5E5E5E5>E5E5E5E5E5FEQ@E5E5E5E5E5FEJ$C#;#;"I(J(
+8FEFEE5FEFEFEFEFEFEFEE5FEFEE5E5QDFEFEE5FEFEE5E5J%@.8+?.J.
+6FEFEFEE5E5FEFEFEFEE5E5E5FEFEFEFEE5E5FEFEE5E5FEFEFEFEE5E5FEFEFEFEE5E5E5FEFEFEFEE5Q>E5FEFEFEFEE5E5E5FEFEFEFEE5J&9&:%9%:#8%8#9#8%9%J#:&8%9%
+4E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5Q3E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5
+
+
+
+
+
+
+
+H5=zB5=z
+QKFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFF3E4QKFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFF3E4H5J"B5J"
+QJFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFF:FFQJFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFF:FFH5Ar"r"C#ZAr"r"
+QIFFFEDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEDEE4DEFFFFFEQGDEE4DEFFH#z"G"J#J"
+FEFFQFDEFEFF6FEFFR*FFH#<"9"C"=#J"B$8#A":#J"J"I"J#J"J"
+FFFEFEFEFEFEFEGFEFEFEFEFEFEFEFEFECFE=DEE44FFFEBFEQ7E4H#;#9"C"="H"I#B(A#:"J#J"F"J#J(A"<"H&J"
+FEFFFEDEDEDEDEFEFEFEFEDEDEDEFEDEDEFEDEDECFEDE=FEFF7FEFFAFEFFFEFEFEFEFEFEFEFEFEFEFEFEP3FFH#J#J"H$I#J'J'J$
+FFFEO9DEDEP+DEE5E4E4FFFECFFFEFFFFFFFEDFFFEFFFFFFFEP4E5E4E4H#:#8$9,;$:&8$9&9$J$<#9$:$8&:$:$<#J"E$J#8$8&:$:$<#>#8#8&8&9$8&A$8(J$
+FEFFFEDEFEFEFEFEFEFEDEFEFEFEDEFEFEFEFEFEFEFEFEFEDEFEFEFEFEFEFEFEFEFEFEFEFE@FEFEFEFEDEFEFEFEFEFEFEFEFEFEDEFEFEFEFEFEFEFEFEDE>FEFFFFE56FEFFFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEP"FFFFE5H#>#:+;%9-8&8&J%?%9-8&8&J"I$H08&8&@'9"9&8&8-9%8)9#J$
+FFFEDEDEDEFEDEDEDEFEDEDEDEDEFEDEDEDEFEDEDEDEFEDEDEFEDEDEDEFEDEFEDEDEDEFEDEDEDEFE?DEDEDEFEFEDEDEDEFEDEDEDEFEDEDEFEDEFEDEFEFEDEDEDEFEFEDEDEDEFEEDEE5E4E4FFFEFFFEFFFFFFFEFFFFFEFFFEFFFEFEFFFFFFFEFEFFFFFFFEFEFEFEFFFFFFFFFFFEFFFFFFFFFEFFFFFFFEFFFFFFFEFFFFFEFEFFFFFEFEFEFEFFFEFFFFFFFEFFFFFFFFFFP&E5E4E4H#9#B"J$@&8&J#A$G&:#J"D$J#8$G&:#:%J"<%@$J$
+FEFFFEDEFE:FEFEFEDEFEFEFEDEFEFEFEFEFE@FEDEFEFEFEDEFEFEFEDEFEDE?FEFFFFE57FEFFFEFEFEFFFEFEFEFFFEFFFFFFFFFE?FFFFFFFFFEFFFEFFP#FFFFE5H#J%@%8&J%G%J"J$G#8%G%J$J$
+FFFELDEDEDEDEDEDEDEFEDEDEDEDEDEMDEDEDEDEDEDEDEFEEDE4E5E4E4FFFEFFFFFFFFFFFFFFFEO4FEFFFEP)E5E4E4H#8#A&J"=$J#E"F"=#J"C$J#;"F"=#J"<"J&J$
+FEFFFEDEDEFEDEFEDE;FEFEDEFEJFEDEFEFEFEDE@FEFFFFE58FEFFFEFEFEFF7FEFE=FEFFFFFFFEP!FFFFE5H#>&?&8,9&9,?&9";-?/;(8&@"J"J$F+;(8&>'8'8&809(8(;"J$
+FFFEFEFEFEFEFEFEFEFEFEFEDEFEFEFEDEFEDEDEFEFEFEDEFEFEFEDEDEFEFEFEDEDEDEFEFEFEDEFEFEFEFEFEFEDEFEFEFEDEDEFEDEFEFEFEDEDEFEFEFEDEFEDEDEFEFEFEDEDEFEFEDEDEFEFEFEDEDEFEFEFEDEFE:DE5E5E4E4FFFEFFFFFEFEFEFFFFFEFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFFFFFEFEFEFFFEFFFEFEFEFFFFFEFEFEFFFFFFFEFEFEFFFFFEFEFEFEFEFEFEFEFEFFFFFEFEFEFFFFFEFEP(E5E4E4H&;&9$9&9&8$:$;$9$@&9"<$8&9#<&8$8r8$:$9#<"J"B$J#8$8R8$:$9#:P:P9$:$9$8$8R:$8#9#J$
+FEFFDEFEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEFEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEFEDEDE:FEFFFFE59FEFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFOMFFFFE5H%J"J"J"J$E#J"J$
+FFFEDEDEP%DEIDEBDE6E5E4E4FFFE=FFQ?E5E4E4H#J%J"A#uG#J#u
+FEFFEFEFEFEDEPKFEFFFFE4FEFFR$FFFFE4H#J$J"B"B"D#J"B"
+FFFEEDEDEDEPLDEE4E4FFFER%E4E4H5AzD#Jz
+QIFEFFFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFE/DEFEFFR$/DEH#ZAZD#JZ
+FFFEQG/FFFER$/H#J"D#J"
+FEFFR2E4FEFFR2E4H#<"9"C"=#J"B$8#A":#J"Jv"E#J"@"A$Jv"
+FFFEFEFEFEFEFEGFEFEFEFEFEFEFEFEFECFEKE5E4FFFEBFEFEFEFEFEPFE5E4H#;#9"C"="H"I#B(A#:"J#J#J(;"A#
+FEFFFEFFFFFFFFFEFEFEFEFFFFFFFEFFFFFEFFFFCFEFFO8FEFFAFEFFFEFEFEFEFEFFFFFFH#J#J#J'
+FFFEO9FFFFQ&FFFECFFFEFFFFFFFEH#:#8$9,;$:&8$9&9$J$<#9$:$8&:$:$<#J#8$8&:$:$<#?$:%A$:&
+FEFFFEFFFEFEFEFEFEFEFFFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFE@FEFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFFO9FEFFFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEH#>#:+;%9-8&8&J%?%9-8&8&J08&8&F#;&?&8'
+FFFEFFFFFFFEFFFFFFFEFFFFFFFFFEFFFFFFFEFFFFFFFEFFFFFEFFFFFFFEFFFEFFFFFFFEFFFFFFFE?FFFFFFFEFEFFFFFFFEFFFFFFFEFFFFFEFFFEFFFEFEFFFFFFFEFEFFFFFFFEO@FFFEFFFEFFFFFFFEFFFFFEFFFEFFFEFEFFFFFFFEFEFFFFFFFEFFFFFFFFFFFFFEFEFFFFFFFEFEFFFFFFFEFFH#9#B"J$@&8&J#A$G&:#J#8$G&:#H$
+FEFFFEFFFE:FEFEFEFFFEFEFEFFFEFEFEFEFE@FEFFFEFEFEFFFEFEFEFFFEFFO:FEFFFEFEFEFFFEFEFEFFFEFFFEFEFEH#J%@%8PJ%G%J#8%G%J%
+FFFELFFFFFFFFFFFFFFFEMFFFFFFFFFFFFFFFEO@FFFEFFFFFFFFFFFFFFFE7FEFFFFFFH#8#A&J"=$J#E"F"=#J#;"F"=#
+FEFFFEFFFFFEFFFEFF;FEFEFFFEJFEFFFEFEFEFFO;FEFFFEFEFEFFH#>&?&8,9&9,?&9";-?/;(8&@"<"J+;(8&>'8&848%
+FFFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFFFEFFFFFEFEFEFFFEFEFEFFFFFEFEFEFFFFFFFEFEFEFFFEFEFEFEFEFEFFFEFEFEFFFFFEFFFEFEFEFFFFFEFEFEFFFEFFFFFEFEFEFFFFFEFEFFFFFEFEFEFFFFFEFEFEFFFEFEO.FFFEFFFFFEFEFEFFFFFEFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFFFEFEFEFEFEFFFEFEFEFFFEFFFEFEFEFEFEFEFFFFFEFEFEFFFFFEFEFEH&;P9$9P9P8$:$;$9$@P9"<$8P9#<P8$8R8$:$9#<"<"J#8$8R8$:$9#:P9P9W8$:$
+FEFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFEFFFFFFO.FEFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFH%J"J"J#J"
+FFFEFFFFP%FFIFFO=FFFE=FFH#J%J#J%
+FEFFEFEFEFEFFQFFEFFO:FEFEFEFFH#J$J#J$
+FFFEEFFFFFFQGFFFEO:FFFFFFH#J#
+FEFFRAFEFFH#J#
+FFFERAFFFEH#J#
+FEFFRAFEFFH#<"9"C"=#J"B$8#A":#J"J#J"@"A$J#C$:$
+FFFEFEFEFEFEFEGFEFEFEFEFEFEFEFEFECFEO8FFFEBFEFEFEFEFE8FEFEFEFEFEFEFEFEH#;#9"C"="H"I#B(A#:"J#8$8(8%J#J(;"A#J'D#;#
+FEFFFEFFFFFFFFFEFEFEFEFFFFFFFEFFFFFEFFFFCFEFFFEFEFEFEFEFEFFFEFEFEFEFEFEFEO$FEFFAFEFFFEFEFEFEFEFFFFFF4FEFEFEFEFFFFFFFFFFFFH#J#J3J#J'J%
+FFFEO9FFFFO=FEFFFFFFFEFFFFFEFFFFFFFEFFFFFEFFFFFFO%FFFECFFFEFFFFFFFEEFEFFFFFFH#:#8$9,;$:&8$9&9$J$<#9$:$8&:$:$<#J"J#8$8&:$:$<#?$:%A$:&;":#:$
+FEFFFEFFFEFEFEFEFEFEFFFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFE@FEFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFF4FFO$FEFFFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFFFEFEFEFEFEH#>#:+;%9-8&8&J%?%9-8&8&C"9$:#J08&8&F#;&?&8'8#;%8&
+FFFEFFFFFFFEFFFFFFFEFFFFFFFFFEFFFFFFFEFFFFFFFEFFFFFEFFFFFFFEFFFEFFFFFFFEFFFFFFFE?FFFFFFFEFEFFFFFFFEFFFFFFFEFFFFFEFFFEFFFEFEFFFFFFFEFEFFFFFFFEFFFEFFFEFEFEO&FFFEFFFEFFFFFFFEFFFFFEFFFEFFFEFEFFFFFFFEFEFFFFFFFEFFFFFFFFFFFFFEFEFFFFFFFEFEFFFFFFFEFFFEFEFEFFFFFEFEFFFFFFFEH#9#B"J$@&8&J#A$G&:#@"9"8&J#8$G&:#H$J&9"<$
+FEFFFEFFFE:FEFEFEFFFEFEFEFFFEFEFEFEFE@FEFFFEFEFEFFFEFEFEFFFEFFFFFFFFFFFEFEFEO$FEFFFEFEFEFFFEFEFEFFFEFFFEFEFE8FFFFFEFEFEFFFEFEFEH#J%@%8PJ%G%C"A#J#8%G%J%J#A%
+FFFELFFFFFFFFFFFFFFFEMFFFFFFFFFFFFFFFEFEFFFFO%FFFEFFFFFFFFFFFFFFFE7FEFFFFFF:FFFFFFFFFFFFH#8#A&J"=$J#E"F"=#C":"J#;"F"=#J"G"
+FEFFFEFFFFFEFFFEFF;FEFEFFFEJFEFFFEFEFEFFFEFEO(FEFFFEFEFEFFO FEFEH#>&?&8,9&9,?&9";-?/;(8&?&9$:%J+;(8&>'8&848%:38.
+FFFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFFFEFFFFFEFEFEFFFEFEFEFFFFFEFEFEFFFFFFFEFEFEFFFEFEFEFEFEFEFFFEFEFEFFFFFEFFFEFEFEFFFFFEFEFEFFFEFFFFFEFEFEFFFFFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFFFEFEFEFFO$FFFEFFFFFEFEFEFFFFFEFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFFFEFEFEFEFEFFFEFEFEFFFEFFFEFEFEFEFEFEFFFFFEFEFEFFFFFEFEFEFEFEFEFFFFFEFEFEFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFEFFFEFEFEFEFEFEH&;P9$9P9P8$:$;$9$@P9"<$8P9#<P8$8R8$:$9#<$;":%J#8$8R8$:$9#:P9P9W8$:$9%8R8$9X
+FEFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFO%FEFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFH%J"J"J#J"
+FFFEFFFFP%FFIFFO=FFFE=FFH#J%J#J%
+FEFFEFEFEFEFFQFFEFFO:FEFEFEFFH#J$J#J$
+FFFEEFFFFFFQGFFFEO:FFFFFFH#J#
+FEFFRAFEFFH#J#
+FFFERAFFFEH#J#
+FEFFRAFEFFH#J#J"J"A$=#
+FFFERAFFFEBFEMFEFEFEFEFEFEH#J#J)@"H':"A#>"
+FEFFRAFEFFAFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFFFFFFFFH#J#J&J&
+FFFERAFFFECFFFEFFFFFF>FFFEFFFFFFH#J#8$8&:$:$<#:*9&8.9":$;$A$
+FEFFRAFEFFFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFFFEFFFFFFFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFFFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEH#J08&8&@":'8&8#P'8"8"8#;&?%
+FFFERAFFFEFFFEFFFFFFFEFFFFFEFFFEFFFEFEFFFFFFFEFEFFFFFFFEFEFFFEFEFFFFFEFFFEFFFFFFFFFEFEFFFFFFFEFFFEFFFFFFFEFFFFFFFEFEFFFFFFH#J#8$G&:#:"<"J"C$
+FEFFRAFEFFFEFEFEFFFEFEFEFFFEFFFFFF;FFFEFEFEH#J#8%G%A"J&:"B%
+FFFERAFFFEFFFFFFFFFFFFFFFEFF9FFFEFFFEFFFFFFFFFFFFH#J#;"F"=#>"D"@"J"
+FEFFRAFEFFFEFEFEFFFEFEFE6FEH#J+;(8&>&8$9"8+:$8%:&8&8.
+FFFERAFFFEFFFFFEFEFEFFFFFEFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFFFFFEFEFEFEFFFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFFFEFEFEFEFEFEFFFFFEFEFEFFFEH#J#8$8R8$:$9#:U8#9$8%?%:P9$9Q8P
+FEFFRAFEFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFH#J#J"
+FFFERAFFFE=FFH#J#J$
+FEFFRAFEFFO2FEFEFFH#J#J#
+FFFERAFFFEO2FFFFH#J#
+FEFFRAFEFFH#J#
+FFFERAFFFEH#J#
+FEFFRAFEFFH#J#J"@":$J$J"
+FFFERAFFFEBFEFEFEFEFE9FEFEFE;FEH#J#J):":#C%?#J"="G&
+FEFFRAFEFFAFEFFFEFEFEFEFEFEFFFFFFFEFEFEFEFFFF4FEFFFEFEFEFEFEH#J#J&J%J'
+FFFERAFFFECFFFEFFFFFF8FEFFFFFFO,FFFEFFFFFFFEH#J#8$8&:$:$<#:":$B$="9$A$:$9&8$;$8&A$8(
+FEFFRAFEFFFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEH#J08&8&@"8"8#B&9#:&?&8&8&8#;-9%8)9#
+FFFERAFFFEFFFEFFFFFFFEFFFFFEFFFEFFFEFEFFFFFFFEFEFFFFFFFEFEFFFFFFFEFFFFFFFEFEFEFEFFFFFFFEFEFFFFFFFEFEFFFFFFFEFFFEFFFFFFFFFFFEFFFFFFFEFFFFFEFEFFFFFEFEFEFEFFFEFFFFFFFEFFFFFFFFFFH#J#8$G&:#:"J$9&9$A$="J"<%@$
+FEFFRAFEFFFEFEFEFFFEFEFEFFFEFFFF4FEFEFEFFFFFEFEFEFEFEFEFEFEFEFF8FFFFFFFFFEFFFEFFH#J#8%G%A"I%:#:%@%J$
+FFFERAFFFEFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFO&FEFFFEH#J#;"F"=#J"8"@"C"<"="J&
+FEFFRAFEFFFEFEFEFF=FEFEFEFEFEFEDFEFFFFFFFEH#J+;(8&>%:&8-9%8&8-8&9,8*9(8(;"
+FFFERAFFFEFFFFFEFEFEFFFFFEFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFFFEFEFEFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFEFEFEFEFFFEFEFEFFFFFEFEFEFEFEFEFEFEFEFFFFFEFEFEFFFFFEFEH#J#8$8R8$:$9#:%:P8Q8$9%:$9Q8$:$;$8P9$8$8R:$8#9#
+FEFFRAFEFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFH#J#J"
+FFFERAFFFE=FFH#J#
+FEFFRAFEFFH#J#Jv
+FFFERAFFFER&E4H#J#J"
+FEFFRAFEFFR%E4H#J5Az
+FFFERAQIFFFEDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDEFFDE/DEH#J#z"
+FEFFRAFEFFQFDEFEH#J#J"@":$J$J"J"A$J"
+FFFERAFFFEBFEFEFEFEFE9FEFEFE;FE;FEFEFEFE9DEH#J#J):":#C%?#J"="G&;"A#J"
+FEFFRAFEFFAFEDEFEFEFEFEFEFEDEDEDEFEFEFEFEDEDE4FEDEFEFEFEFEFEDEDEDE:FEH#J#J&J%J'J"
+FFFERAFFFECDEFEDEDEDE8FEDEDEDEO,DEFEDEDEDEFELDEH#J#8$8&:$:$<#:":$B$="9$A$:$9&8$;$8&@$:%A$:&>"
+FEFFRAFEFFFEFEFEFEFEFEDEFEFEFEFEFEFEFEFEDEFEFEFEFEFEFEFEDEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEDEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEDEFEFEH#J08&8&@"8"8#B&9#:&?&8&8&8#;-?#;&?&8'>"
+FFFERAFFFEDEFEDEDEDEFEDEDEFEDEFEDEFEFEDEDEDEFEFEDEDEDEFEFEDEDEDEFEDEDEDEFEFEFEFEDEDEDEFEFEDEDEDEFEFEDEDEDEFEDEFEDEDEDEDEDEFEDEDEDEFEDEDEFEFEDEDEFEDEDEDEDEDEDEFEFEDEDEDEFEFEDEDEDEFEDEDEH#J#8$G&:#:"J$9&9$A$="J"J$J"
+FEFFRAFEFFFEFEFEDEFEFEFEDEFEDEDE4FEFEFEDEDEFEFEFEFEFEFEFEFEFEDE8DE4FEFEFE?FEH#J#8%G%A"I%:#:%@%J%J"
+FFFERAFFFEDEDEDEDEDEDEDEFEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEO%FEDEDEDE?DEH#J#;"F"=#J"8"@"C"<"="J"
+FEFFRAFEFFFEFEFEDE=FEFEFEFEFEFEO9FEH#J+;(8&>%:&8-9%8&8-8&9,8*9(8&848%@"
+FFFERAFFFEDEDEFEFEFEDEDEFEFEDEDEFEFEFEDEDEFEFEFEDEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEDEDEFEFEFEDEFEFEFEDEDEFEFEFEDEFEFEFEFEFEFEDEDEFEFEFEDEDEFEFEFEDEDEFEFEFEDEDEFEFEFEFEFEDEFEFEFEDEDEFEFEFEFEFEFEFEFEFEDEFEFEFEFEFEDEFEFEFEDEFEDEFEFEFEFEFEFEDEDEFEFEFEDEDEFEFEFEDEH#J#8$8r8$:$9#:%:&8'8$9%:$9'8$:$;$8&9$8$8r9&9w8$:$@"
+FEFFRAFEFFDEDEDEDEDEDEDEDEDEDEFEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEDEFEH#J#J"J"
+FFFERAFFFE=DEQ(DEH#J#J%?"
+FEFFRAFEFFQ9FEFEFEDEFEH#J#J$@"
+FFFERAFFFEQ9DEDEDEDEH#J5
+FEFFRAQIFEFFFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEDEFEH#J#Z
+FFFERAFFFEQGH#J#
+FEFFRAFEFFH#J#J"D#C$D#A"=#
+FFFERAFFFEBFEFEFEFEFEFEFEFEFEFEFEH#J#J&A"D#E"8(9"="H"
+FEFFRAFEFFAFEFFFEFEFEFFFFFFFFFEFEFEFFFEFEFEFFFFFEH#J#J$J(
+FFFERAFFFECFFFEFFO FFFEFFFFFFFEFFH#J#8$8&:$:$<#?%:$:$A$:$;":$;$:&8$9&
+FEFFRAFEFFFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEH#J08&8&F&9%8&?&8%@#;%9-8&
+FFFERAFFFEFFFEFFFFFFFEFFFFFEFFFEFFFEFEFFFFFFFEFEFFFFFFFEFFFFFFFFFEFFFFFFFEFEFFFFFFFEFEFFFFFFFEFEFFFFFFFFFFFEFFFFFFFEFFFFFFFEFFFFFEFFFFFFFEFFFEFFFFFFH#J#8$G&:#A$A$A$J$
+FEFFRAFEFFFEFEFEFFFEFEFEFFFEFFFEFEFEFEFEFEFEFEFEGFEFEFEH#J#8%G%C"8%A%@%@$J%
+FFFERAFFFEFFFFFFFFFFFFFFFEFEFEFFFFFFFFFFFFFFFFFFFFFFFEFFFE9FFFFFFFFH#J#;"F"=#J"C"?"9"J"="
+FEFFRAFEFFFEFEFEFF=FEFEFFFF;FEFEH#J+;(8&>&9-8&8-8'>&8,9&9&
+FFFERAFFFEFFFFFEFEFEFFFFFEFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFFFEFEFEFFFEFEFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFEFFFEFEFEFFFEFFFFFEFEFEFFFEFEFEFFFFFEFEFEFFH#J#8$8R8$:$9#:Q9U:$9Q8$:P8$9P9P8$:$;$
+FEFFRAFEFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFH#J#J"
+FFFERAFFFE=FFH#J#J%
+FEFFRAFEFFP/FEFEFEFFH#J#J$
+FFFERAFFFEP/FFFFFFH#J#
+FEFFRAFEFFH#J#
+FFFERAFFFEH#J#
+FEFFRAFEFFH#J#J"J"A$
+FFFERAFFFEBFEO-FEFEFEFEH#J#J%9#J&;"A#
+FEFFRAFEFFAFEFFFEFEFEFEJFEFEFEFEFEFFFFFFH#J#J(J'
+FFFERAFFFECFFFEFEFFFEFEFFJFFFEFFFFFFFEH#J#8$8&:$:$<#@$:$:$9%:&8$@$:%A$:&
+FEFFRAFEFFFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEH#J08&8&@$9&8&8&8&8-?#;&?&8'
+FFFERAFFFEFFFEFFFFFFFEFFFFFEFFFEFFFEFEFFFFFFFEFEFFFFFFFEFFFEFFFEFFFFFFFEFEFFFFFFFEFEFFFFFFFEFFFFFFFFFEFEFFFFFFFEFFFFFEFFFFFFFEFFFFFFFFFFFFFEFEFFFFFFFEFEFFFFFFFEFFH#J#8$G&:#A$9&8&9$A$H$
+FEFFRAFEFFFEFEFEFFFEFEFEFFFEFFFEFEFEFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFEFEFEFEH#J#8%G%G%9%9%8%A%F%
+FFFERAFFFEFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFEFFFFFFFEFEFFFFFFFFFFFFFFFEFFFFFFH#J#;"F"=#<">"8"<"J"
+FEFFRAFEFFFEFEFEFFFFFEFEFE8FEH#J+;(8&>.8&8&8,9-8&848%
+FFFERAFFFEFFFFFEFEFEFFFFFEFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFFFEFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFEFEFFFEFFFFFEFEFEFFFEFEFEFFFFFEFEFEFEFEFFFEFEFEFEFEFFFEFEFEFFFEFFFEFEFEFEFEFEFFFFFEFEFEFFFFFEFEFEH#J#8$8R8$:$9#:R8$:$:$:P8$:$8P9P9W8$:$
+FEFFRAFEFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFH#J#J"
+FFFERAFFFE=FFH#J#J%J%
+FEFFRAFEFFO:FEFEFEFFMFEFEFEFFH#J#J$J$
+FFFERAFFFEO:FFFFFFO FFFFFFH#J#
+FEFFRAFEFFH#J#
+FFFERAFFFEH#J#
+FEFFRAFEFFH#J#J"J"
+FFFERAFFFEBFE8FEH#J#J#8$A"="G#9#
+FEFFRAFEFFAFEFFFEFEFEFEFFFEFEFEFEH#J#J&J(
+FFFERAFFFEDFEFFFFFFFEDFFFEFEFFFEFEFFH#J#8$8&:$:$<#>&9&8$;$8&A$8&8#8#
+FEFFRAFEFFFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFFFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEH#J08&8&E'8&8#;-9$9/9"
+FFFERAFFFEFFFEFFFFFFFEFFFFFEFFFEFFFEFEFFFFFFFEFEFFFFFFFEFFFEFFFFFFFEFFFEFFFFFFFFFFFEFFFFFFFEFFFFFEFEFFFFFEFFFEFFFEFFFFFFFEFFFFFEFEFFFFFEFFFFFFH#J#8$G&:#J"C$:"
+FEFFRAFEFFFEFEFEFFFEFEFEFFFEFFGFFFEFEFEFFH#J#8%G%J%
+FFFERAFFFEFFFFFFFFFFFFFFFEO-FFFFFFFFH#J#;"F"=#J"J">"
+FEFFRAFEFFFEFEFEFF7FE8FFFEH#J+;(8&?&9%9,8*939)
+FFFERAFFFEFFFFFEFEFEFFFFFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFFFFFEFEFEFFFFFEFEFEFEFEFFFEFEFEFFFFFEFEFEFEFEFEFEFFFEFEFEFFFFFEFEFEFFFFFEFEFEFEFFFFFEFEFEFFFEH#J#8$8R8$:$9#<$:$;$8P9$8$8T8$8$8#8P
+FEFFRAFEFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFH#J#J"
+FFFERAFFFE=FFH#J#J$
+FEFFRAFEFFJFEFEFEH#JvF#J$
+FFFER&E4FFFEJFFFFFFH#J"J#
+FEFFR%E4;FEFFH#JzD#
+FFFER$/DEFFFEH#JZD#JZ
+FEFFR$/FEFFR$/H#J"C"D#J"J#A"D#J"C"
+FFFER$DEE4FFFEBFE@FEFEFEFEFEOMDEE4H#Jt$D#J(J"8(9"D"Jt$
+FEFFR'E5E4E4DEFEFFAFEFFFEFEFEFEFE;FFFEFEFEFFFEFEFEFFFFP#E5E4E4DEH#J$J#J'J(J$
+FFFER%DEFFFF9FFFECFFFEFFFFFEFE=FFFEFFFFFFFEFFP4DEFFFFH#J$E#8$8&:$:$<#;"9%8&:$:$;":$9&:$:$8(J$
+FEFFR/E4E4DEFEFFFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFFFFFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEOIE4E4DEH#J$J08&8&B"9-8&8%@#:'8%9.J$
+FFFER&DEFFFF8FFFEFFFEFFFFFFFEFFFFFEFFFEFFFEFEFFFFFFFEFEFFFFFFFEFEFFFFFFFFFEFFFFFEFEFFFFFEFEFFFFFFFEFEFFFFFFFFFFFFFEFEFFFFFEFEFFFFFFFEFFFFFFFEFFFFFEFFFFFFFEFFO@DEFFFFH#J$F#8$G&:#:%9$:"<$J"J"J$
+FEFFR.E4E4DEFEFFFEFEFEFFFEFEFEFFFEFFFEFEFEFFFEFEFEFFFEFEFE9FF5FEOKE4E4DEH#J$J#8%G%@$9%A%@$J$
+FFFER'DEFFFF7FFFEFFFFFFFFFFFFFFFEFFFFFFFEFFFFFFFFFFFFFFFEFFFEP8DEFFFFH#J$G#;"F"=#J"?"9"J&J$
+FEFFR-E4E4DEFEFFFEFEFEFF=FEFFFF>FFFEFFFEFFOHE4E4DEH#J$J+;(8&>%:*9(8'>*9/J$
+FFFER(DEFFFF6FFFEFFFFFEFEFEFFFFFEFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFFFEFEFEFFFEFEFEFEFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFEFFFEFEFEFEFFFFFEFEFEFFFEFFFFFEFEFEFFOJDEFFFFH#J$H#8$8R8$:$9#:%;S8#8$:P8$9T8#8P8$:$J$
+FEFFR,E4E4DEFEFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFOHE4E4DEH#J$J#J"J$
+FFFER)DEFFE45FFFE=FFQ9DEFFE4H#J"I#J"
+FEFFR-DEFEFFR-DEH#J"J#J"
+FFFER*DE6FFFER*DEH#J"J#J"
+FEFFR,DE4FEFFR,DEH#JZD#JZ
+FFFER$/FFFER$/H#J"J#J"
+FEFFR#FF=FEFFR#FFHz=zBz=z
+QKE53E5QKE53E5
+
+
+
+
+
+HzJz
+QKE4FQKE4J"J"
+R.FFRBFFJy"zZ$x"Jy"zZ$x"
+4DEFFP DEO(DEFFFFDEFFIDEFFP+DEKDEFFFFDEFFJ$J"9#J$J"9#
+@FFFFE4Q'E4FFFFO3FFFFE4Q'E4FFFFJ%Jz"<#J%Jz"<#
+>FFFFFFE4P#O$E5E4FFFFO/FFFFFFE4P.GE5E4FFFFJ#8"J#8#J#8"J#8#
+<FFFFE5Q-E5E5FFFFO+FFFFE5Q-E5E5FFFFJ#8#J#8#J#8#J#8#
+:FFFFE5E5Q0E5E5FFFFO'FFFFE5E5Q0E5E5FFFFJ#8#J#8#J#8#J#8#
+8FFFFE5E5Q4E5E5FFFFO#FFFFE5E5Q4E5E5FFFFJ#8#J#8#J#8#J#8#
+6FFFFE5E5Q8E5E5FFFFMFFFFE5E5Q8E5E5FFFFJ'J&J'J&
+4E4E4E4E4E5E5Q<E5E4E4E4E4JE4E4E4E4E5E5Q<E5E4E4E4E4J#8#J"9"J#8#J"9"
+4DEDEE4E4Q<E4DEJDEDEE4E4Q<E4DEJ#8#J#8#J#8#J#8#
+6DEDEE4E4Q8E4E4DEDEMDEDEE4E4Q8E4E4DEDEJ#8#J#8#J#8#J#8#
+8DEDEE4E4Q4E4E4DEDEO#DEDEE4E4Q4E4E4DEDEJ#8#J#8#J#8#J#8#
+:DEDEE4E4Q0E4E4DEDEO'DEDEE4E4Q0E4E4DEDEJ#8"J#8#J#8"J#8#
+<DEDEE4Q-E4E4DEDEO+DEDEE4Q-E4E4DEDEJ#Jz=#J#Jz=#
+>DEDEP%O$E4DEDEO/DEDEP0GE4DEDEJ#J"J$J#J"J$
+@DEDEP"E4O(E4DEDEO3DEDEP-E4KE4DEDEJZJZ
+4QGJQGI"J"
+FFRBFFHzJz
+QKE5FQKE5
+
+
+
+
+
+
+
+
+
+
+
+
+J&?#F#8#
+5FEFEFEFEFEFEFEFEFEFEFEJ(J#
+4FEFEE5E5E5FEFE>E5E5J%<%9%8"8%8%8&
+=FEFEFEFEFEFEFEFEFEFEFEFEFEFEE5FEFEFEFEFEFEFEFEE5FEFEJ/:08":'9%
+4E5FEFEFEE5E5E5E5FEFEE5E5FEFEFEFEE5E5FEFEE5FEFEE5E5FEFEE5E5E5FEFEE5E5FEFEFEE5FEFEJ&J#H"
+5E5E5FEFEFE7E5E5E5J"8"9#>#
+7E5FEFEFEFEFEJ#8";%<%
+4FEFEE5E5E5E5E5E5E5E5E5J#>#;#;"
+@FEFEFEFEFEFEFEJ/:.8%9'
+4E5FEFEFEFEFEE5E5E5FEFEFEFEE5E5FEFEFEFEE5E5E5FEFEFEFEE5E5FEFEE5E5FEFEFEFEE5J&9%8#8%9%:&8%8#8#
+5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5
+
+
+
+
+
+
+Fz
+W/FE
+H5
+W+FFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFH5
+W*FEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFFEFFH#Z
+FFFEW'H#J#
+FEFFVMFEFEH#?$<$J"J"J"9"C"=#J"B$8#A":#J"@":$J$J"J"A$
+FFFEFEFEFEFEFEFECFEBFEO"FEFEFEFEFEGFEFEFEFEFEFEFEFEFECFEFEFEFEFE9FEFEFE;FE;FEFEFEFEH#?#<%G"F#J#J#9"C"="H"I#B(A#:"J):":#C%?#J"="G&;"A#
+FEFFFFFFFEFFFFFFFEFEFFAFEFFO!FEFFFFFFFFFEFEFEFEFFFFFFFEFFFFFEFFFFCFEFFFEFEFEFEFEFEFFFFFFFEFEFEFEFFFF4FEFFFEFEFEFEFEFFFFFFH#J#J&J%J'
+FFFER5FFFFO<FFFEFFFFFF8FEFFFFFFO,FFFEFFFFFFFEH&8#?&9$9&8&9$<):$9&9$<#9$:$8&8&:$8&<#8$9,;$:&8$9&9$J$<#9$:$8&:$:$<#:":$B$="9$A$:$9&8$;$8&@$:%A$:$
+FEFFFFFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFFFFFEFEFEFFFEFEFEFEFEFFFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFFFEFEFEFEFEFFFEFEFEFEFFFEFEFEFEFEFEFFFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFE@FEFEFEFEFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEH%9"@&8&8&8&8&>'8&8&8&?&848-?#:+;%9-8&8&J%?%9-8&8&@"8"8#B&9#:&?&8&8&8#;-?#;&?&8&
+FFFEFFFFFFFFFEFFFFFFFEFFFFFFFEFFFEFFFFFFFFFEFFFFFFFEFFFFFFFEFFFEFFFEFFFEFEFFFFFFFEFFFEFFFFFFFEFFFFFFFEFEFFFFFFFEFEFFFFFFFEFFFFFEFFFEFFFEFFFFFEFFFEFFFEFEFFFFFFFEFFFFFEFEFFFFFEFFFFFFFEFFFFFFFEFFFFFFFFFEFFFFFFFEFFFFFFFEFFFFFEFFFFFFFEFFFEFFFFFFFEFFFFFFFE?FFFFFFFEFEFFFFFFFEFFFFFFFEFFFFFEFFFEFFFEFEFFFFFFFEFEFFFFFFFEFEFFFFFFFEFFFFFFFEFEFEFEFFFFFFFEFEFFFFFFFEFEFFFFFFFEFFFEFFFFFFFFFFFEFFFFFFFEFFFFFEFEFFFFFEFFFFFFFFFFFFFEFEFFFFFFFEFEFFFFFFFEH#J$G&:#A$D":#="J"=#B"J$@&8&J#A$G&:#:"J$9&9$A$="J"J$
+FEFF8FEFEFEFFFEFEFEFFFEFFFEFEFEFFFEFFFF?FFFEFFFE:FEFEFEFFFEFEFEFFFEFEFEFEFE@FEFFFEFEFEFFFEFEFEFFFEFFFF4FEFEFEFFFFFEFEFEFEFEFEFEFEFEFF8FF4FEFEFEH#J%G%G%J%@%8PJ%G%A"I%:#:%@%J%
+FFFE8FFFFFFFFFFFFFFFEFFFFFFFFP0FFFFFFFFFFFFFFFEMFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFO%FEFFFFFFH#J"D$=#E"C"9#>"J#A&J"=$J#E"F"=#J"8"@"C"<"="
+FEFF;FEFEFFFEFEFFFEFEFEFFFEFFEFFFFFEFFFEFF;FEFEFFFEJFEFFFEFEFEFF=FEFEFEFEFEFEH#839&8%:,>";(8%9&?&8(;#;,9">&?&8,9&9,?&9";-?/;(8&>%:&8-9%8&8-8&9,8*9(8&848%
+FFFEFFFEFEFEFFFEFFFEFEFEFEFEFEFFFEFEFEFEFFFEFEFEFFFEFEFEFEFFFEFEFEFFFFFFFEFEFEFFFEFEFFFFFEFEFEFFFEFEFEFEFFFEFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFEFEFEFFFFFEFEFEFFFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFEFEFEFFFEFFFFFEFEFEFFFEFEFEFFFFFEFEFEFFFFFFFEFEFEFFFEFEFEFEFEFEFFFEFEFEFFFFFEFFFEFEFEFFFFFEFEFEFFFEFFFFFEFEFEFFFFFEFEFFFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFEFEFEFEFEFEFEFEFEFEFFFFFEFEFEFFFEFEFEFFFFFEFEFEFFFEFEFEFEFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFEFEFFFFFEFEFEFEFEFFFEFEFEFFFFFEFEFEFEFEFEFEFEFEFFFEFEFEFEFEFFFEFEFEFFFEFFFEFEFEFEFEFEFFFFFEFEFEFFFFFEFEFEH#9Z:$9%;$9$9#:R8$9%:$9#<$:$8Y8$8$8&;P9$9P9P8$:$;$9$@P9"<$8P9#<P8$8R8$:$9#:%:P8Q8$9%:$9Q8$:$;$8P9$8$8R9P9W8$:$
+FEFF1FFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFEFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFH#J"J"J"J"J"
+FFFEO%FFBFFO"FFP%FFIFFH#J%J%
+FEFFQAFEFEFEFFS$FEFEFEFFH#J$JQ
+FFFEQAFFFFFFS%H#
+FEFFH"
+FFHz
+W+FE
+Fz
+W/E5
+
+
+
+
+
+
+
+
+<z
+WDE4=z"
+WBE5FF=Z
+WB<z
+WDE5
+
+
+
+
+
+
+
+Jz
+AOAE4J"
+P3FFJz"
+CO=E5FF
+
+
+JZJZJZJZ
+GO5FO5FO5FO5J"J"J"J"
+P-E4P,E4P,E4P,E4Jz"Jz"Jz"Jz"
+IO1E5E4IO1E5E4IO1E5E4IO1E5E4
+
+
+
+
+J%:#9#Js$8#J%J#J#9#>#
+O3FEFEFEFEFEFEFEFEODFEE5FEFEFEFEOJFEFEFEFE=FEFEO<FEFEFEFEFEFEJ'=$J'J'
+O2FEFEE5E5FEFEFEFEE5OFE5E5E5E5E5E5P"FEFEE5E5FEFEJ$8$;$J#:"8"8%8&J$8(8&9%9%J%;&
+O1FEFEE5E5FEFEFEFEE5OKFEFEFEFEFEFEFEFEFEFEE5FEFEO:FEFEE5E5E5E5FEFEFEFEFEFEE5FEFEFEFEFEFEFEFEFEFEOIFEFEFEFEFEFEE5FEFEJ$J"8)9"J'93J'<%
+O=FEFEE5P$E5E5E5FEFEE5E5FEFEFEOCFEFEE5E5FEFEFEE5FEFEE5FEFEE5E5FEFEE5FEFEE5E5FEFEOGFEFEE5E5FEFEFEE5FEFEJ$J#J#=">#J$E"
+Q:FEFEFE6E5E5OAE5E5E5E5E5OHFEFEFEE5J$J$D#;"J$I#J$;#
+O=E5FEFEOHE5E5E5FEFEE5ODFEFEFEFEFEOCE5E5E5FEFEJ$J%J%I%J%
+O>E5FEFEP*E5E5E5E5OGFEFEE5E5E5E5E5E5OIE5E5E5E5J$8$<$J":#J$8#H#;#J#<"
+O1E5FEFEFEFEE5E5FEFEP&FEFEFEO@E5FEFEFEFEFEFEFEFEOKFEFEFEJ'>$J+J.=.J'<%
+O2E5FEFEFEFEE5E5FEFEP"E5FEFEE5E5FEFEFEFEE5OAE5FEFEFEFEE5E5FEFEFEE5FEFEE5FEFEFEFEE5E5E5FEFEFEFEE5OGE5FEFEFEFEE5E5FEFEE5J%:#:#J#:&9#8%8#J%8s8#8%9%8#J#9#8%8#:#
+O3E5E5E5E5E5E5E5E5OCE5E5E5E5E5E5E5E5E5E5E5E5E5E5E5O?E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5E5O<E5E5E5E5E5E5E5E5E5E5E5E5
+
+J#
+V8E5E5
+
+
+
+&J%
+F7F7F7F7F7WEF7F7F7F7&JzJzJzJzJ&
+F6F6F6F6F6DO1E4JO1E4JO1E4JO1E4EF6F6F6F6F68$J"J"J"J"J%
+F9F9F9CE4P,E4P,E4P,E4P)F9F9F9F7JzJzJzJz
+GO5E5FO5E5FO5E5FO5E5
+
+
+JZ
+CO=J"
+BFFJz
+AOAE5
+
+
+
+
+
+
+
+<z"z"z
+0F6F7W!F6F71F6;z8z8z
+1F9W F91F9
+
+7z8z8z
+5F7W F74F7"J"J"
+F76F7W!F7
+ENDBITMAP
+%%EndBinary
+369 447 495 465 R
+7 X
+V
+4 8 Q
+0 X
+(f) 369 459.67 T
+(ileselectiondialog .fsd) 373.8 459.67 T
+(.fsd activate) 369 449.67 T
+0 10 Q
+(FIGURE 34) 359.58 420.1 T
+1 F
+( - Fileselectiondialog) 410.98 420.1 T
+0 0 612 792 C
+FMENDPAGE
+%%EndPage: "17" 17
+%%Trailer
+%%BoundingBox: 0 0 612 792
+%%PageOrder: Ascend
+%%Pages: 17
+%%DocumentFonts: Times-Bold
+%%+ Times-Roman
+%%+ Times-BoldItalic
+%%+ Times-Italic
+%%+ Courier
+%%+ Courier-Bold
+%%EOF
diff --git a/itcl/iwidgets3.0.0/doc/labeledframe.n b/itcl/iwidgets3.0.0/doc/labeledframe.n
new file mode 100644
index 00000000000..63212d94658
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/labeledframe.n
@@ -0,0 +1,194 @@
+'\"
+'\" Copyright (c) 1997 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) labeledframe.n 1.21 97/1/30 16:04:44
+'/"
+.so man.macros
+.HS labeledframe iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+labeledframe \- Create and manipulate a labeled frame widget
+.SH SYNOPSIS
+\fBlabeledframe\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Archetype <- labeledframe
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBborderwidth\fR \fBcursor\fR
+\fBforeground\fR \fBrelief\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBiPadX\fR
+Class: \fBIPad\fR
+Command-Line Switch: \fB-ipadx\fR
+.fi
+.IP
+Specifies horizontal padding space between the border and the childsite.
+The value may have any of the forms acceptable to \fBTk_GetPixels\fR.
+The default is 0.
+.LP
+.nf
+Name: \fBiPadY\fR
+Class: \fBIPad\fR
+Command-Line Switch: \fB-ipady\fR
+.fi
+.IP
+Specifies vertical padding space between the border and the childsite.
+The value may have any of the forms acceptable to \fBTk_GetPixels\fR.
+The default is 0.
+.LP
+.nf
+Name: \fBlabelBitmap\fR
+Class: \fBBitmap\fR
+Command-Line Switch: \fB-labelbitmap\fR
+.fi
+.IP
+Specifies a bitmap to display in the label, in any of the forms
+acceptable to \fBTk_GetBitmap\fR. This option overrides the \fIlabeltext\fR
+option.
+.LP
+.nf
+Name: \fBlabelImage\fR
+Class: \fBImage\fR
+Command-Line Switch: \fB-labelimage\fR
+.fi
+.IP
+Specifies a image to be used as the label. The image may be any of the
+values created by the \fBimage create\fR command. This option overrides
+both the \fIlabelbitmap\fR and \fIlabeletext\fR options.
+.LP
+.nf
+Name: \fBlabelMargin\fR
+Class: \fBMargin\fR
+Command-Line Switch: \fB-labelmargin\fR
+.fi
+.IP
+Specifies the distance between the inner ede of the hull frames relief,
+and the label in any of the forms acceptable to \fBTk_GetPixels\fR.
+The default is 10 pixels.
+.LP
+.nf
+Name: \fBlabelText\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-labeltext\fR
+.fi
+.IP
+Specifies the text of the label around the childsite.
+.LP
+.nf
+Name: \fBlabelVariable\fR
+Class: \fBVariable\fR
+Command-Line Switch: \fB-labelvariable\fR
+.fi
+.IP
+Specifies the text variable of the label around the childsite.
+.LP
+.nf
+Name: \fBlabelFont\fR
+Class: \fBFont\fR
+Command-Line Switch: \fB-labelfont\fR
+.fi
+.IP
+Specifies the font of the label around the childsite.
+.LP
+.nf
+Name: \fBlabelPos\fR
+Class: \fBPosition\fR
+Command-Line Switch: \fB-labelpos\fR
+.fi
+.IP
+Specifies the position of the label within the grooved relief of the hull widget.
+\fB ne, n, nw, se, s, sw, en, e, es, wn, w, ws\fR Default is \fBn\fR.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBlabeledframe\fR command creates a hull frame with a
+grooved relief, a label positioned within the grooved relief of
+the hull frame, and a frame childsite. The frame childsite can filled with any
+widget via a derived class or though the use of the childsite method.
+This class was designed to be a general purpose base class for supporting the
+combination of labeled frame and a childsite. The options include the
+ability to position the label at configurable locations within the
+grooved relief of the hull frame, and control the display of the label.
+.SH "METHODS"
+.PP
+The \fBlabeledframe\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for labeledframe widgets:
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBchildsite\fR
+Return the path name of the child site.
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBlabeledframe\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBlabeledframe\fR
+command.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBlabel\fR
+Class: \fBlabel\fR
+.fi
+.IP
+The label component provides the label for the labeled widget. See the
+"label" widget manual entry for details on the label component item.
+.fi
+.LP
+
+.SH EXAMPLE
+.IP
+The labeledframe was primarily meant to be a base class. The
+Radiobox is a good example of a derived classe of the labeledframe class.
+In order to provide equal support for composite classes, the 'childsite' methods
+also exists. The following is an example of 'childsite' method usage.
+.LP
+.DS
+ labeledframe .lw -labeltext "Entry Frame" -labelpos n
+ pack .lw -fill both -expand yes -padx 10 -pady 10
+ set cs [.lw childsite]
+
+ pack [Entryfield $cs.entry1 -labeltext "Name:"] -side top -fill x
+ pack [Spinint $cs.entry2 -labeltext "Number:"] -side top -fill x
+ pack [Pushbutton $cs.entry3 -text "Details:"] -side top -fill x
+
+.DE
+.SH AUTHOR
+John A. Tucker
+.SH KEYWORDS
+labeledframe, widget
diff --git a/itcl/iwidgets3.0.0/doc/labeledwidget.n b/itcl/iwidgets3.0.0/doc/labeledwidget.n
new file mode 100644
index 00000000000..42bd8349ead
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/labeledwidget.n
@@ -0,0 +1,206 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) labeledwidget.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS labeledwidget iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+labeledwidget \- Create and manipulate a labeled widget
+.SH SYNOPSIS
+\fBlabeledwidget\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- labeledwidget
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBcursor\fR \fBforeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBdisabledForeground\fR
+Class: \fBDisabledForeground\fR
+Command-Line Switch: \fB-disabledforeground\fR
+.fi
+.IP
+Specifies the foreground to be used when the state is disabled.
+.LP
+.nf
+Name: \fBlabelBitmap\fR
+Class: \fBBitmap\fR
+Command-Line Switch: \fB-labelbitmap\fR
+.fi
+.IP
+Specifies a bitmap to display in the widget, in any of the forms
+acceptable to \fBTk_GetBitmap\fR. This option overrides the \fIlabeltext\fR
+option.
+.LP
+.nf
+Name: \fBlabelFont\fR
+Class: \fBFont\fR
+Command-Line Switch: \fB-labelfont\fR
+.fi
+.IP
+Specifies the font to be used for the label.
+.LP
+.nf
+Name: \fBlabelImage\fR
+Class: \fBImage\fR
+Command-Line Switch: \fB-labelimage\fR
+.fi
+.IP
+Specifies a image to be used as the label. The image may be any of the
+values created by the \fBimage create\fR command. This option overrides
+both the \fIlabelbitmap\fR and \fIlabeletext\fR options.
+.LP
+.nf
+Name: \fBlabelMargin\fR
+Class: \fBMargin\fR
+Command-Line Switch: \fB-labelmargin\fR
+.fi
+.IP
+Specifies the distance between the childsite and label in any of the forms
+acceptable to \fBTk_GetPixels\fR. The default is 2 pixel.
+.LP
+.nf
+Name: \fBlabelPos\fR
+Class: \fBPosition\fR
+Command-Line Switch: \fB-labelpos\fR
+.fi
+.IP
+Specifies the position of the label along the side of the childsite:
+\fBnw\fR, \fBn\fR, \fBne\fR, \fBsw\fR, \fBs\fR, \fBse\fR, \fBen\fR, \fBe\fR,
+\fBes\fR, \fBwn\fR, \fBw\fR, or \fBws\fR. The default is w.
+.LP
+.nf
+Name: \fBlabelText\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-labeltext\fR
+.fi
+.IP
+Specifies the text of the label around the childsite.
+.LP
+.nf
+Name: \fBlabelVariable\fR
+Class: \fBVariable\fR
+Command-Line Switch: \fB-labelvariable\fR
+.fi
+.IP
+Specifies the text variable of the label around the childsite.
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Command-Line Switch: \fB-state\fR
+.fi
+.IP
+Specifies one of two states for the label: \fBnormal\fR or \fBdisabled\fR.
+If the label is disabled then it is displayed in a disabled foreground
+color. The default is normal.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBlabeledwidget\fR command creates a labeled widget which contains
+a label and child site. The child site is a frame
+which can filled with any widget via a derived class or though the use
+of the childsite method. This class
+was designed to be a general purpose base class for supporting the
+combination of label widget and a childsite. The options include the
+ability to position the label around the childsite widget, modify the
+font and margin, and control the display of the labels.
+
+.SH "METHODS"
+.PP
+The \fBlabeledwidget\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for labeledwidget widgets:
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBchildsite\fR
+Return the path name of the child site.
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBlabeledwidget\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBlabeledwidget\fR
+command.
+
+.SH "STATIC METHODS"
+.TP
+\fBLabeledwidget::alignlabels\fR \fIwidget\fR ?\fIwidget ...\fR?
+The alignlabels procedure takes a list of widgets derived from
+the Labeledwidget class and uses the label margin to make each widget
+have the same total space for the combination of label and margin. The
+net effect is to left align the labels. Generally, this method is only
+useful with a label position of w, which is the default.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBlabel\fR
+Class: \fBlabel\fR
+.fi
+.IP
+The label component provides the label for the labeled widget. See the
+"label" widget manual entry for details on the label component item.
+.LP
+.nf
+Name: \fBlwchildsite\fR
+Class: \fBframe\fR
+.fi
+.IP
+The lwchildsite component is the user child site for the labeled widget. See
+the "frame" widget manual entry for details on the lwchildsite component item.
+.fi
+
+.SH EXAMPLE
+.IP
+The labeledwidget was primarily meant to be a base class. The
+ScrolledListBox and EntryField are good examples of derived
+classes of the labeledwidget class. In order to provide equal
+support for composite classes, the 'childsite' methods also exists.
+The following is an example of 'childsite' method usage.
+.LP
+.DS
+ labeledwidget .lw -labeltext "Canvas Widget" -labelpos s
+ pack .lw -fill both -expand yes -padx 10 -pady 10
+
+ set cw [canvas [.lw childsite].c -relief raised -width 200 -height 200]
+ pack $cw -padx 10 -pady 10
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.SH KEYWORDS
+labeledwidget, widget
diff --git a/itcl/iwidgets3.0.0/doc/mainwindow.n b/itcl/iwidgets3.0.0/doc/mainwindow.n
new file mode 100644
index 00000000000..db0cca941dc
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/mainwindow.n
@@ -0,0 +1,306 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) mainwindow.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS mainwindow iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+mainwindow \- Create and manipulate a mainwindow widget
+.SH SYNOPSIS
+\fBmainwindow\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Toplevel <- shell <- mainwindow
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBcursor\fR \fBdisabledForeground\fR \fBfont\fR
+\fBforeground\fR \fBhighlightBackground\fR \fBhighlightColor\fR \fBhighlightThickness\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBballoonBackground\fR \fBballoonDelay1\fR \fBballoonDelay2\fR \fBballonFont\fR
+\fBballoonForeground\fR
+.fi
+.LP
+See the "toolbar" manual entry for details on the above associated options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtitle\fR
+.fi
+.LP
+See the "Toplevel" manual entry for details on the above inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBheight\fR \fBmaster\fR \fBmodality\fR \fBpadX\fR
+\fBpadY\fR \fBwidth\fR
+.fi
+.LP
+See the "shell" manual entry for details on the above inherited options.
+
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBhelpLine\fR
+Class: \fBHelpLine\fR
+Command-Line Switch: \fB-helpline\fR
+.fi
+.IP
+Specifies whether or not to display the help line. The value
+may be given in any of the forms acceptable to Tk_GetBoolean.
+The default is yes.
+.LP
+.nf
+Name: \fBmenuBarBackground\fR
+Class: \fBBackground\fR
+Command-Line Switch: \fB-menubarbackground\fR
+.fi
+.IP
+Specifies the normal background color for the menubar.
+.LP
+.nf
+Name: \fBmenuBarFont\fR
+Class: \fBFont\fR
+Command-Line Switch: \fB-menubarfont\fR
+.fi
+.IP
+Specifies the font to use when drawing text inside the menubar.
+.LP
+.nf
+Name: \fBmenuBarForeround\fR
+Class: \fBForeground\fR
+Command-Line Switch: \fB-menubarforeground\fR
+.fi
+.IP
+Specifies the normal foreground color for the menubar.
+.LP
+.nf
+Name: \fBstatusLine\fR
+Class: \fBStatusLine\fR
+Command-Line Switch: \fB-statusline\fR
+.fi
+.IP
+Specifies whether or not to display the status line. The value
+may be given in any of the forms acceptable to Tk_GetBoolean.
+The default is yes.
+.LP
+.nf
+Name: \fBtoolBarBackground\fR
+Class: \fBBackground\fR
+Command-Line Switch: \fB-toolbarbackground\fR
+.fi
+.IP
+Specifies the normal background color for the toolbar.
+.LP
+.nf
+Name: \fBtoolBarFont\fR
+Class: \fBFont\fR
+Command-Line Switch: \fB-toolbarfont\fR
+.fi
+.IP
+Specifies the font to use when drawing text inside the toolbar.
+.LP
+.nf
+Name: \fBtoolBarForeround\fR
+Class: \fBForeground\fR
+Command-Line Switch: \fB-toolbarforeground\fR
+.fi
+.IP
+Specifies the normal foreground color for the toolbar.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBmainwindow\fR command creates a mainwindow shell which contains
+a menubar, toolbar, mousebar, childsite, status line, and help line.
+Each item may be filled and configured to suit individual needs.
+
+.SH "METHODS"
+.PP
+The \fBmainwindow\fR command create a new Tcl command whose
+name is \fIpathName\fR. This command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for mainwindow widgets:
+.SH "INHERITED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactivate\fR \fBcenter\fR \fBdeactivate\fR
+.fi
+.LP
+See the "shell" manual entry for details on the above inherited methods.
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBmainwindow\fR
+command.
+.TP
+\fIpathName \fBchildsite\fR
+Returns the pathname of the child site widget.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBmainwindow\fR
+command.
+.TP
+\fIpathName \fBmenubar\fR ?\fIargs\fR?
+The \fBmenubar\fR method provides access to the menubar. Invoked with
+no arguments it returns the pathname of the menubar. With arguments,
+they are evaluated against the menubar which in effect provides
+access to the entire API of the menubar. See the "menubar" manual
+entry for details on the commands available in the menubar.
+.TP
+\fIpathName \fBmousebar\fR ?\fIargs\fR?
+The \fBmousebar\fR method provides access to the mousebar which is a
+vertical toolbar. Invoked with no arguments it returns the pathname
+of the mousebar. With arguments, they are evaluated against the mousebar
+which in effect provides access to the entire API of the underlying
+toolbar. See the "toolbar" manual entry for details on the commands
+available in the mousebar.
+.TP
+\fIpathName \fBmsgd\fR ?\fIargs\fR?
+The \fBmsgd\fR method provides access to the messagedialog contained
+in the mainwindow. Invoked with no arguments it returns the pathname
+of the messagedialog. With arguments, they are evaluated against the
+messagedialog which in effect provides access to the entire API of the
+messagedialog. See the "messagedialog" manual
+entry for details on the commands available in the messagedialog.
+.TP
+\fIpathName \fBtoolbar\fR ?\fIargs\fR?
+The \fBtoolbar\fR method provides access to the toolbar. Invoked with
+no arguments it returns the pathname of the toolbar. With arguments,
+they are evaluated against the toolbar which in effect provides
+access to the entire API of the toolbar. See the "toolbar" manual
+entry for details on the commands available in the toolbar.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBhelp\fR
+Class: \fBLabel\fR
+.fi
+.IP
+The help component provides a location for displaying any help
+strings provided in the menubar, toolbar, or mousebar. See the "label"
+widget manual entry for details on the help component item.
+.LP
+.nf
+Name: \fBmenubar\fR
+Class: \fBMenubar\fR
+.fi
+.IP
+The menubar component is the menubar located at the top of the window.
+See the "menubar" widget manual entry for details on the menubar
+component item.
+.LP
+.nf
+Name: \fBmousebar\fR
+Class: \fBToolbar\fR
+.fi
+.IP
+The mousebar component is the vertical toolbar located on the right side
+of the window. See the "toolbar" widget manual entry for details on
+the mousebar component item.
+.LP
+.nf
+Name: \fBmsgd\fR
+Class: \fBMessagedialog\fR
+.fi
+.IP
+The msgd component is a messagedialog which may be reconfigured as needed
+and used repeatedly throughout the application. See the "messagedialog"
+widget manual entry for details on the messagedialog component item.
+.LP
+.nf
+Name: \fBstatus\fR
+Class: \fBLabel\fR
+.fi
+.IP
+The status component provides a location for displaying application
+status information. See the "label" widget manual entry for details
+on the status component item.
+.LP
+.nf
+Name: \fBtoolbar\fR
+Class: \fBToolbar\fR
+.fi
+.IP
+The toolbar component is the horizontal toolbar located on the top
+of the window. See the "toolbar" widget manual entry for details on
+the toolbar component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ mainwindow .mw
+
+ #
+ # Add a File menubutton
+ #
+ .mw menubar add menubutton file -text "File" -underline 0 -padx 8 -pady 2 \\
+ -menu {options -tearoff no
+ command new -label "New" -underline 0 \\
+ -helpstr "Create a new file"
+ command open -label "Open ..." -underline 0 \\
+ -helpstr "Open an existing file"
+ command save -label "Save" -underline 0 \\
+ -helpstr "Save the current file"
+ command saveas -label "Save As ..." -underline 5 \\
+ -helpstr "Save the file as a differnet name"
+ command print -label "Print" -underline 0 \\
+ -helpstr "Print the file"
+ separator sep1
+ command close -label "Close" -underline 0 \\
+ -helpstr "Close the file"
+ separator sep2
+ command exit -label "Exit" -underline 1 \\
+ -helpstr "Exit this application"
+ }
+
+ #
+ # Install a scrolledtext widget in the childsite.
+ #
+ scrolledtext [.mw childsite].st
+ pack [.mw childsite].st -fill both -expand yes
+
+ #
+ # Activate the main window.
+ #
+ .mw activate
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.DE
+John A. Tucker
+.LP
+.SH KEYWORDS
+mainwindow, shell, widget
diff --git a/itcl/iwidgets3.0.0/doc/man.macros b/itcl/iwidgets3.0.0/doc/man.macros
new file mode 100644
index 00000000000..c575ce6befa
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/man.macros
@@ -0,0 +1,186 @@
+'\" The definitions below are for supplemental macros used in Tcl/Tk
+'\" manual entries.
+'\"
+'\" .HS name section [date [version]]
+'\" Replacement for .TH in other man pages. See below for valid
+'\" section names.
+'\"
+'\" .AP type name in/out [indent]
+'\" Start paragraph describing an argument to a library procedure.
+'\" type is type of argument (int, etc.), in/out is either "in", "out",
+'\" or "in/out" to describe whether procedure reads or modifies arg,
+'\" and indent is equivalent to second arg of .IP (shouldn't ever be
+'\" needed; use .AS below instead)
+'\"
+'\" .AS [type [name]]
+'\" Give maximum sizes of arguments for setting tab stops. Type and
+'\" name are examples of largest possible arguments that will be passed
+'\" to .AP later. If args are omitted, default tab stops are used.
+'\"
+'\" .BS
+'\" Start box enclosure. From here until next .BE, everything will be
+'\" enclosed in one large box.
+'\"
+'\" .BE
+'\" End of box enclosure.
+'\"
+'\" .VS
+'\" Begin vertical sidebar, for use in marking newly-changed parts
+'\" of man pages.
+'\"
+'\" .VE
+'\" End of vertical sidebar.
+'\"
+'\" .DS
+'\" Begin an indented unfilled display.
+'\"
+'\" .DE
+'\" End of indented unfilled display.
+'\"
+'\" @(#) man.macros 1.1 94/08/09 13:07:19
+.\"
+'\" # Heading for Tcl/Tk man pages
+.de HS
+.ds ^3 \\0
+.if !"\\$3"" .ds ^3 \\$3
+.if '\\$2'cmds' .TH "\\$1" 1 "\\*(^3" "\\$4" "\\$5"
+.if '\\$2'lib' .TH "\\$1" 3 "\\*(^3" "\\$4" "\\$5"
+.if '\\$2'ncmds' .TH "\\$1" n "\\*(^3" "\\$4" "\\$5"
+.if '\\$2'tcl' .TH "\\$1" n "\\*(^3" Tcl "Tcl Built-In Commands"
+.if '\\$2'tk' .TH "\\$1" n "\\*(^3" Tk "Tk Commands"
+.if '\\$2'tclc' .TH "\\$1" 3 "\\*(^3" Tcl "Tcl Library Procedures"
+.if '\\$2'tkc' .TH "\\$1" 3 "\\*(^3" Tk "Tk Library Procedures"
+.if '\\$2'tclcmds' .TH "\\$1" 1 "\\*(^3" Tk "Tcl Applications"
+.if '\\$2'tkcmds' .TH "\\$1" 1 "\\*(^3" Tk "Tk Applications"
+.if '\\$2'iwid' .TH "\\$1" 1 "\\*(^3" Tk "[incr Widgets]"
+.if t .wh -1.3i ^B
+.nr ^l \\n(.l
+.ad b
+..
+'\" # Start an argument description
+.de AP
+.ie !"\\$4"" .TP \\$4
+.el \{\
+. ie !"\\$2"" .TP \\n()Cu
+. el .TP 15
+.\}
+.ie !"\\$3"" \{\
+.ta \\n()Au \\n()Bu
+\&\\$1 \\fI\\$2\\fP (\\$3)
+.\".b
+.\}
+.el \{\
+.br
+.ie !"\\$2"" \{\
+\&\\$1 \\fI\\$2\\fP
+.\}
+.el \{\
+\&\\fI\\$1\\fP
+.\}
+.\}
+..
+'\" # define tabbing values for .AP
+.de AS
+.nr )A 10n
+.if !"\\$1"" .nr )A \\w'\\$1'u+3n
+.nr )B \\n()Au+15n
+.\"
+.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n
+.nr )C \\n()Bu+\\w'(in/out)'u+2n
+..
+'\" # BS - start boxed text
+'\" # ^y = starting y location
+'\" # ^b = 1
+.de BS
+.br
+.mk ^y
+.nr ^b 1u
+.if n .nf
+.if n .ti 0
+.if n \l'\\n(.lu\(ul'
+.if n .fi
+..
+'\" # BE - end boxed text (draw box now)
+.de BE
+.nf
+.ti 0
+.mk ^t
+.ie n \l'\\n(^lu\(ul'
+.el \{\
+.\" Draw four-sided box normally, but don't draw top of
+.\" box if the box started on an earlier page.
+.ie !\\n(^b-1 \{\
+\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.el \}\
+\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.\}
+.fi
+.br
+.nr ^b 0
+..
+'\" # VS - start vertical sidebar
+'\" # ^Y = starting y location
+'\" # ^v = 1 (for troff; for nroff this doesn't matter)
+.de VS
+.mk ^Y
+.ie n 'mc \s12\(br\s0
+.el .nr ^v 1u
+..
+'\" # VE - end of vertical sidebar
+.de VE
+.ie n 'mc
+.el \{\
+.ev 2
+.nf
+.ti 0
+.mk ^t
+\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n'
+.sp -1
+.fi
+.ev
+.\}
+.nr ^v 0
+..
+'\" # Special macro to handle page bottom: finish off current
+'\" # box/sidebar if in box/sidebar mode, then invoked standard
+'\" # page bottom macro.
+.de ^B
+.ev 2
+'ti 0
+'nf
+.mk ^t
+.if \\n(^b \{\
+.\" Draw three-sided box if this is the box's first page,
+.\" draw two sides but no top otherwise.
+.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.\}
+.if \\n(^v \{\
+.nr ^x \\n(^tu+1v-\\n(^Yu
+\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c
+.\}
+.bp
+'fi
+.ev
+.if \\n(^b \{\
+.mk ^y
+.nr ^b 2
+.\}
+.if \\n(^v \{\
+.mk ^Y
+.\}
+..
+'\" # DS - begin display
+.de DS
+.RS
+.nf
+.sp
+..
+'\" # DE - end display
+.de DE
+.fi
+.RE
+.sp
+..
diff --git a/itcl/iwidgets3.0.0/doc/menubar.n b/itcl/iwidgets3.0.0/doc/menubar.n
new file mode 100644
index 00000000000..83f15908b0b
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/menubar.n
@@ -0,0 +1,341 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) menubar.n
+'/"
+.so man.macros
+.HS menubar iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+menubar \- Create and manipulate menubar menu widgets
+.SH SYNOPSIS
+\fBmenubar\fR \fIpathName\fR ?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- menubar
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBborderWidth\fR \fBhighlightBackground\fR \fBpadY\fR
+\fBactiveBorderWidth\fR \fBcursor\fR \fBhighligthThickness\fR \fBrelief\fR
+\fBactiveForeground\fR \fBdisabledForeground\fR \fBhighlightColor\fR \fBwrapLength\fR
+\fBanchor\fR \fBfont\fR \fBjustify\fR
+\fBbackground\fR \fBforeground\fR \fBpadX\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBhelpVariable\fR
+Class: \fBHelpVariable\fR
+Command-Line Switch: \fB-helpvariable\fR
+.fi
+.IP
+Specifies the global variable to update whenever the mouse is in motion over a menu entry. This global variable is updated with the current value of the active menu entry's \fBhelpStr\fR. Other widgets can "watch" this variable with the trace command, or as is the case with entry or label widgets, they can set their \fBtextVariable\fR to the same global variable. This allows for a simple implementation of a help status bar. Whenever the mouse leaves a menu entry, the helpVariable is set to the empty string {}. The mainwindow(1) associates its helpstatus and its menubar in this fashion.
+.LP
+.nf
+Name: \fBmenuButtons\fR
+Class: \fBMenuButtons\fR
+Command-Line Switch: \fB-menubuttons\fR
+.fi
+.IP
+The menuButton option is a string which specifies the arrangement of menubuttons on the menubar frame. Each menubutton entry is delimited by the newline character.
+.nf
+.IP
+.ta 2c 8c 12c
+menubar .mb -menubuttons {
+ menubutton file -text File
+ menubutton edit -text Edit
+ menubutton options -text Options
+}
+.fi
+.IP
+specifies that three menubuttons will be added to the menubar (file, edit, options). Each entry is translated into an add command call.
+.IP
+The \fBmenuButtons\fR option can accept embedded variables, commands, and
+backslash quoting. Embedded variables and commands must be enclosed in
+curly braces ({}) to ensure proper parsing of the substituted values.
+.BE
+.SH DESCRIPTION
+.PP
+The \fBmenubar\fR command creates a new window (given by the \fIpathName\fR argument) and makes it into a \fBmenubar\fR menu widget. Additional options, described above may be specified on the command line or in the option database to configure aspects of the menubar such as its colors and font. The \fBmenubar\fR command returns its \fIpathName\fR argument. At the time this command is invoked, there must not exist a window named pathName, but pathName's parent must exist.
+.PP
+A \fBmenubar\fR is a widget that simplifies the task of creating menu hierarchies. It encapsulates a \fBframe\fR widget, as well as \fBmenubuttons\fR, \fBmenus\fR, and menu \fBentries\fR. The menubar allows menus to be specified and referenced in a more consistent manner than using Tk to build menus directly.
+
+\fBMenubar\fR allows a menu tree to be expressed in a hierachical "language". The \fBmenubar\fR accepts a \fBmenuButtons\fR option that allows a list of menubuttons to be added to the menubar. In turn, each menubutton accepts a \fBmenu\fR option that specifies a list of menu entries to be added to the menubutton's menu. Cascade entries also accept the \fBmenu\fR option for specifying a list of menu entries to be added to the cascade's menu.
+
+Additionally, the menubar allows each component of the menubar system to be referenced by a simple \fImenuPathName\fR syntax. The menubar also extends the set of options for menu entries to include a \fBhelpStr\fR option.
+.SH "MENU PATH NAMES"
+.PP
+A \fImenuPathName\fR is a series of component names separated by the `.' character. Each menubar component can be referenced via these \fImenuPathNames\fR. \fImenuPathNames\fR are similar to widget pathNames in Tk. Some correspond directly to a widget pathName (components of type \fBmenu\fR or \fBmenubutton\fR), others correspond to a menu entry type. Every widget and entry in a menubar can be referenced with the \fImenuPathName\fR naming convention. A menubar can have four types of components:
+.IP
+\fBframe\fR. A menubar holds exactly one frame which manages menubuttons. The frame is always signified by the `.' character as the path name.
+.IP
+\fBmenubutton\fR. A menubutton corresponds directly to a Tk menubutton. See menubutton(n).
+.IP
+\fBmenu\fR. A menu is attached to a menubutton and corresponds directly to Tk's menu widget. A menu is always signified by the \fImenuPathName\fR ending with the keyword \fBmenu\fR. See menu(n).
+.IP
+\fBentry\fR. An entry corresponds directly to Tk's menu widget entries. Menus consist of a column of one line entries. Entries may be of type: \fBcommand\fR, \fBcheckbutton\fR, \fBradiobutton\fR, \fBseparator\fR, or \fBcascade\fR. For a complete description of these types see the discussion on \fBENTRIES\fR in menu(n).
+.PP
+The suffix of a \fImenuPathName\fR may have the form of:
+.TP 14
+\fItkWidgetName\fR
+Specifies the name of the component, either a \fBframe\fR, \fBmenubutton\fR, \fBmenu\fR, or an \fBentry\fR. This is the normal naming of widgets. For example, .file references a \fBmenubutton\fR named \fIfile\fR.
+.PP
+The \fImenuPathName\fR is a series of segment names, each separated by the '.' character. Segment names may be one of the following forms:
+.TP 14
+\fInumber\fR
+Specifies the index of the the component. For menubuttons, 0 corresponds to the left-most menubutton of the menu bar frame. As an example, \fI.1\fR would correspond to the second menubutton on the menu bar frame.
+.IP
+For entries, 0 corresponds to the top-most entry of the menu. For example, .file.0 would correspond to the first entry on the menu attached to the menubutton named \fIfile\fR.
+.TP 14
+\fBend\fR
+Specifes the last component. For menubuttons, it specifies the right-most entry of the menu bar frame. For menu entries, it specifies the bottom-most entry of the menu.
+.TP 14
+\fBlast\fR
+Same as end.
+.PP
+Finally, menu components always end with the \fBmenu\fR keyword. These components are automatically created via the -menu option on menubuttons and cascades or via the \fBadd\fR or \fBinsert\fR commands.
+.TP 14
+\fBmenu\fR
+Specifes the menu pane that is associated with the given menubutton prefix. For example, \fI.file.menu\fR specifies the menu pane attached to the \fI.file\fR menubutton.
+.PP
+For example, the path \fI.file.new\fR specifies the entry named new on the menu associated with the file menubutton located on the menu bar. The path \fI.file.menu\fR specifies the menu pane associated with the menubutton \fI.file\fR. The path \fI.last\fR specifies the last menu on the menu bar. The path \fI.0.last\fR would specify the first menu (file) and the last entry on that menu (quit), yielding \fI.file.quit\fR.
+
+As a restriction, the last name segment of \fImenuPathName\fR cannot be one of the keywords last, menu, end, nor may it be a numeric value (integer).
+.SH "WIDGET-SPECIFIC METHODS"
+.PP
+The \fBmenubar\fR command creates a new Tcl command whose name is \fIpathName\fR.
+This command may be used to invoke various operations on the widget. It has
+the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIoption\fR and the \fIarg\fRs
+determine the exact behavior of the command.
+.PP
+In addition, many of the widget commands for menubar take as one argument a path name to a menu component. These path names are called \fImenuPathName\fRs. See the discussion on \fBMENUBAR PATH NAMES\fR above.
+.PP
+The following commands are possible for menubar widgets:
+.TP
+\fIpathName\fR \fBadd\fR \fItype\fR \fImenuPathName\fR ?\fIoption value option value\fR?
+Adds either a menu to the menu bar or a menu entry to a menu pane.
+.IP
+If additional arguments are present, they specify \fIoption\fRs available to component type \fBentry\fR. See the man pages for \fBmenu\fR(1) in the section on \fBENTRIES\fR.
+
+If \fItype\fR is one of \fBcascade\fR, \fBcheckbutton\fR, \fBcommand\fR, \fBradiobutton\fR, or \fBseparator\fR it adds a new entry to the bottom of the menu denoted by the prefix of \fImenuPathName\fR. If additonal arguments are present, they specify options available to menu \fBentry\fR widgets. In addition, the \fBhelpStr\fR option is added by the menubar widget to all components of type entry.
+.RS
+.TP
+\fB-helpstr\fR \fIvalue\fR
+Specifes the string to associate with the entry. When the mouse moves over the associated entry, the variable denoted by \fBhelpVariable\fR is set. Another widget can bind to the helpVariable and thus display status help.
+.RE
+.IP
+If the type of the component added is \fBmenubutton\fR or \fBcascade\fR, a menubutton or cascade is added to the menubar. If additional arguments are present, they specify options available to menubutton or cascade widgets. In addition, the \fBmenu\fR option is added by the menubar widget to all menubutton and cascade widgets.
+.RS
+.TP
+\fB-menu\fR \fImenuSpec\fR
+This is only valid for \fImenuPathName\fRs of type \fBmenubutton\fR or \fBcascade\fR. Specifes an option set and/or a set of entries to place on a menu and associate with the menubutton or cascade. The \fBoption\fR keyword allows the menu widget to be configured. Each item in the \fImenuSpec\fR is treated as add commands (each with the possibility of having other -menu options). In this way a menu can be recursively built.
+.IP
+The last segment of \fImenuPathName\fR cannot be one of the keywords \fBlast\fR, \fBmenu\fR, \fBend\fR. Additionally, it may not be a \fInumber\fR. However the \fImenuPathName\fR may be referenced in this manner (see discussion of \fBCOMPONENT PATH NAMES\fR).
+.IP
+Note that the same curly brace quoting rules apply to \fB-menu\fR option strings as did to \fB-menubuttons\fR option strings. See the earlier discussion on \fBumenubuttons\fR in the "\fBWIDGET-SPECIFIC OPTIONS\fR" section.
+.RE
+.TP
+\fIpathName\fR \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given by \fIoption\fR.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoptions\fR \fIvalue\fR \fIoption\fR \fIvalue\fR?
+Query or modify the configuration options of the widget. If no \fIoption\fR is specified, returns a list describing all of the available options for \fBpathName\fR (see \fBTk_ConfigureInfo\fR for information on the format of this list). If \fIoption\fR is specified with no value, then the command returns a list describing the one named option (this list will be identical to the corresponding sublist of the value returned if no option is specified). If one or more option-value pairs are specified, then the command modifies the given widget option(s) to have the given value(s); in this case the command returns an empty string.
+.TP
+\fIpathName\fR \fBdelete\fR \fImenuPathName\fR ?\fImenuPathName2\fR?
+If \fImenuPathName\fR is of component type \fBMenubutton\fR or \fBMenu\fR, delete operates on menus. If \fImenuPathName\fR is of component type \fBEntry\fR, delete operates on menu entries.
+
+This command deletes all components between \fImenuPathName\fR and \fImenuPathName2\fR inclusive. If \fImenuPathName2\fR is omitted then it defaults to \fImenuPathName\fR. Returns an empty string.
+
+If \fImenuPathName\fR is of type menubar, then all menus and the menu bar frame will be destroyed. In this case \fImenuPathName2\fR is ignored.
+.TP
+\fIpathName\fR \fBindex\fR \fImenuPathName\fR
+If \fImenuPathName\fR is of type menubutton or menu, it returns the position of the menu/menubutton on the menubar frame.
+
+If \fImenuPathName\fR is of type \fBcommand\fR, \fBseparator\fR, \fBradiobutton\fR, \fBcheckbutton\fR, or \fBcascade\fR, it returns the menu widget's numerical index for the entry corresponding to \fImenuPathName\fR. If path is not found or the path is equal to ".", a value of -1 is returned.
+.TP
+\fIpathName\fR \fBinsert\fR \fImenuPathName\fR \fItype\fR \fIname\fR ?\fIoption\fR \fIvalue\fR?
+Insert a new component named name before the component specified by \fImenuPathName\fR.
+.IP
+If \fImenuPathName\fR is of type \fBMenubutton\fR or \fBMenu\fR, the new component inserted is of type \fBMenu\fR and given the name name. In this case valid \fIoption\fR \fIvalue\fR pairs are those accepted by menubuttons.
+.IP
+If \fImenuPathName\fR is of type \fBEntry\fR, the new component inserted is of type \fBentry\fR and given the name \fIname\fR. In this case, valid \fIoption\fR \fIvalue\fR pairs are those accepted by menu entries.
+\fIName\fR cannot be one of the keywords \fBlast\fR, \fBmenu\fR, \fBend\fR. Additionally, it may not be a number. However the \fImenuPathName\fR may be referenced in this manner (see discussion of \fBCOMPONENT PATH NAMES\fR).
+.TP
+\fIpathName\fR \fBinvoke\fR \fImenuPathName\fR
+Invoke the action of the menu entry denoted by \fImenuPathName\fR. See the sections on the individual entries in the menu(1) man pages. If the menu entry is disabled then nothing happens. If the entry has a command associated with it then the result of that command is returned as the result of the \fBinvoke\fR widget command. Otherwise the result is an empty string.
+
+If \fImenuPathName\fR is not a menu entry, an error is issued.
+.TP
+\fIpathName\fR \fBmenucget\fR \fImenuPathName\fR \fIoption\fR
+Returns the current value of the configuration option given by \fIoption\fR. The component type of \fImenuPathName\fR determines the valid available options.
+.TP
+\fIpathName\fR \fBmenuconfigure\fR \fImenuPathName\fR ?\fIoption\fR \fIvalue\fR?
+Query or modify the configuration options of the componet of the menubar specified by \fImenuPathName\fR. If no \fIoption\fR is specified, returns a list describing all of the available options for \fImenuPathName\fR (see \fBTk_ConfigureInfo\fR for information on the format of this list). If \fIoption\fR is specified with no value, then the command returns a list describing the one named option (this list will be identical to the corresponding sublist of the value returned if no option is specified). If one or more option-value pairs are specified, then the command modifies the given widget option(s) to have the given value(s); in this case the command returns an empty string. The component type of \fImenuPathName\fR determines the valid available options.
+.TP
+\fIpathName\fR \fBpath\fR ?\fImode\fR? \fIpattern\fR
+Returns a fully formed \fImenuPathName\fR that matches \fIpattern\fR. If no match is found it returns -1. The \fImode\fR argument indicates how the search is to be matched against \fIpattern\fR and it must have one of the following values:
+.RS
+.TP
+\fB-glob\fR
+Pattern is a glob-style pattern which is matched against each component path using the same rules as the string match command.
+.TP
+\fB-regexp\fR
+Pattern is treated as a regular expression and matched against each component of the \fImenuPathName\fR using the same rules as the regexp command.
+The default mode is -glob.
+.RE
+.TP
+\fIpathName\fR \fBtype\fR \fImenuPathName\fR
+Returns the type of the component specified by \fImenuPathName\fR. For menu entries, this is the type argument passed to the \fBadd\fR/\fBinsert\fR widget command when the entry was created, such as \fBcommand\fR or \fBseparator\fR. Othewise it is either a \fBmenubutton\fR or a \fBmenu\fR.
+.TP
+\fIpathName\fR \fByposition\fR \fImenuPathName\fR
+Returns a decimal string giving the y-coordinate within the menu window of the topmost pixel in the entry specified by \fImenuPathName\fR. If the \fImenuPathName\fR is not an entry, an error is issued.
+.SH "EXAMPLE ONE: USING GRAMMAR"
+.PP
+The following example creates a menubar with "File", "Edit", "Options" menubuttons. Each of these menubuttons has an associated menu.
+In turn the File menu has menu entries, as well as the Edit
+menu and the Options menu. The Options menu is a tearoff menu
+with selectColor (for radiobuttons) set to blue.
+In addition, the Options menu has a cascade titled More,
+with several menu entries attached to it as well. An entry widget is
+provided to display help status.
+.PP
+menubar .mb -helpvariable helpVar -menubuttons {
+ menubutton file -text File -menu {
+ options -tearoff false
+ command new -label New \\
+ -helpstr "Open new document" \\
+ -command {puts NEW}
+ command close -label Close \\
+ -helpstr "Close current document" \\
+ -command {puts CLOSE}
+ separator sep1
+ command exit -label Exit -command {exit} \\
+ -helpstr "Exit application"
+ }
+ menubutton edit -text Edit -menu {
+ options -tearoff false
+ command undo -label Undo -underline 0 \\
+ -helpstr "Undo last command" \\
+ -command {puts UNDO}
+ separator sep2
+ command cut -label Cut -underline 1 \\
+ -helpstr "Cut selection to clipboard" \\
+ -command {puts CUT}
+ command copy -label Copy -underline 1 \\
+ -helpstr "Copy selection to clipboard" \\
+ -command {puts COPY}
+ command paste -label Paste -underline 0 \\
+ -helpstr "Paste clipboard contents" \\
+ -command {puts PASTE}
+ }
+ menubutton options -text Options -menu {
+ options -tearoff false -selectcolor blue
+ radiobutton byName -variable viewMode \\
+ -value NAME -label "by Name" \\
+ -helpstr "View files by name order" \\
+ -command {puts NAME}
+ radiobutton byDate -variable viewMode \\
+ -value DATE -label "by Date" \\
+ -helpstr "View files by date order" \\
+ -command {puts DATE}
+ cascade prefs -label Preferences -menu {
+ command colors -label Colors... \\
+ -helpstr "Change text colors" \\
+ -command {puts COLORS}
+ command fonts -label Fonts... \\
+ -helpstr "Change text font" \\
+ -command {puts FONT}
+ }
+ }
+
+}
+.if
+.nf
+frame .fr -width 300 -height 300
+entry .ef -textvariable helpVar
+pack .mb -anchor nw -fill x -expand yes
+pack .fr -fill both -expand yes
+pack .ef -anchor sw -fill x -expand yes
+.if
+.SH "EXAMPLE TWO: USING METHODS"
+Alternatively the same menu could be created by using the add and configure methods:
+.PP
+.nf
+.ta 2c 4c 6c 8c 10c 12c 14c 16c
+ menubar .mb
+ .mb configure -menubuttons {
+ menubutton file -text File -menu {
+ command new -label New
+ command close -label Close
+ separator sep1
+ command quit -label Quit
+ }
+ menubutton edit -text Edit
+ }
+.if
+.PP
+ .mb add command .edit.undo -label Undo -underline 0
+ .mb add separator .edit.sep2
+ .mb add command .edit.cut -label Cut -underline 1
+ .mb add command .edit.copy -label Copy -underline 1
+ .mb add command .edit.paste -label Paste -underline 0
+
+ .mb add menubutton .options -text Options -menu {
+ radiobutton byName -variable viewMode \\
+ -value NAME -label "by Name"
+ radiobutton byDate -variable viewMode \\
+ -value DATE -label "by Date"
+}
+
+ .mb add cascade .options.prefs -label Preferences -menu {
+ command colors -label Colors...
+ command fonts -label Fonts...
+ }
+ pack .mb -side left -anchor nw -fill x -expand yes
+.SH CAVEATS
+The \fB-menubuttons\fR option as well as the \fB-menu\fR option is evaluated by menubar with the \fBsubst\fR command. The positive side of this is that the option string may contain variables, commands, and/or backslash substitutions. However, substitutions might expand into more than a single word. These expansions can be protected by enclosing candidate substitutions in curly braces ({}). This ensures, for example, a value for an option will still be treated as a single value and not multiple values. The following example illustrates this case:
+.nf
+.IP
+.ta 2c 4c 6c
+set fileMenuName "File Menu"
+set var {}
+menubar .mb -menubuttons {
+ menubutton file -text {$fileMenuName}
+ menubutton edit -text Edit -menu {
+ checkbutton check \\
+ -label Check \\
+ -variable {[scope var]} \\
+ -onvalue 1 \\
+ -offvalue 0
+ }
+ menubutton options -text Options
+}
+.fi
+.IP
+The variable \fIfileMenuName\fR will expand to "File Menu" when the \fBsubst\fR command is used on the menubutton specification. In addition, the [\fBscope\fR...] command will expand to @scope :: var. By enclosing these inside {} they stay as a single value. Note that only {} work for this. [list...], "" etc. will not protect these from the subst command.
+.SH ACKNOWLEDGMENTS
+.LP
+Bret Schumaker
+.IP
+1994 - Early work on a menubar widget.
+.LP
+Mark Ulferts, Mark Harrison, John Sigler
+.IP
+Invaluable feedback on grammar and usability of the menubar widget
+.LP
+.SH AUTHOR
+Bill W. Scott
+.SH KEYWORDS
+frame, menu, menubutton, entries, help
+
diff --git a/itcl/iwidgets3.0.0/doc/messagebox.n b/itcl/iwidgets3.0.0/doc/messagebox.n
new file mode 100644
index 00000000000..802551249e7
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/messagebox.n
@@ -0,0 +1,274 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) scrolledtext.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS messagebox iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+messagebox \- Create and manipulate a messagebox text widget
+.SH SYNOPSIS
+\fBmessagebox\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- Labeledwidget <- Scrolledwidget <- Messagebox
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBactiveForeground\fR \fBbackground\fR \fBborderWidth\fR
+\fBcursor\fR \fBexportSelection\fR \fBfont\fR \fBforeground\fR
+\fBhighlightColor\fR \fBhighlightThickness\fR \fBpadX\fR \fBpadY\fR
+\fBrelief\fR \fBsetGrid\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR \fBlabelMargin\fR
+\fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR
+.fi
+.LP
+See the "labeledwidget" class manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveRelief\fR \fBelementBorderWidth\fR \fBjump\fR \fBtroughColor\fR
+.fi
+.LP
+See the "scrollbar" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBheight\fR \fBhscrollMode\fR \fBsbWidth\fR \fBscrollMargin\fR
+\fBtextBackground\fR \fBvisibleItems\fR \fBvscrollMode\fR \fBwidth\fR
+.fi
+.LP
+See the "scrolledtext" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBspacing1\fR \fBspacing2\fR \fBspacing3\fR
+.fi
+.LP
+See the "text" widget manual entry for details on the above
+associated options.
+
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBfileName\fR
+Class: \fBFileName\fR
+Command-Line Switch: \fB-filename\fR
+.fi
+.IP
+Specifies the filename to be displayed in the file selection dialog when
+it pops up during a save of the messagebox contents operation.
+.LP
+.nf
+Name: \fBmaxLines\fR
+Class: \fBMaxLines\fR
+Command-Line Switch: \fB-maxlines\fR
+.fi
+.IP
+Specifies the maximum number of lines allowed in the text area of the
+messagebox. When this limit is reached, the oldest line will be deleted
+such that the total number of lines remains \fImaxlines\fR.
+.LP
+.nf
+Name: \fBsaveDir\fR
+Class: \fBSaveDir\fR
+Command-Line Switch: \fB-savedir\fR
+.fi
+.IP
+Specifies the default directory to display when the file selection dialog
+pops up during a save of the messagebox contents operation. If this
+parameter is not specified, then the files in the current working directory
+are displayed.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBmessagebox\fR command creates
+a scrolled information messages area widget.
+Message types can be user defined and configured. Their options
+include foreground, background, font, bell, and their display
+mode of on or off. This allows message types to defined as needed,
+removed when no longer so, and modified when necessary. An export
+method is provided for file I/O.
+
+.PP
+The number of lines displayed may be limited with
+the default being 1000. When this limit is reached, the oldest line
+is removed. A popup menu which appears when the right mouse button
+has been pressed in the message area has been predefined. The contents
+of the popup menu by default support clearing the area and saving its
+contents to a file. Additional operations may be defined or existing
+operations removed by using the component command to access the
+popup menu.
+
+.SH "MESSAGE TYPES"
+.PP
+The display characteristics of messages issued to the messagebox vary
+with the message type. Types are defined by the user and they may
+be added, removed, and configured. The options of the message type
+control the display include the following:
+.TP
+\fB\-background \fIcolor\fR
+\fIColor\fR specifies the background color to use for characters
+associated with the message type.
+It may have any of the forms accepted by \fBTk_GetColor\fR.
+.TP
+\fB\-bell \fIboolean\fR
+Specifies whether or not to ring the bell whenenver a message of this
+type is issued. \fIBoolean\fR may have any of the forms accepted by
+\fBTk_GetBoolean\fR. The default is 0.
+.TP
+\fB-font\ \fIfontName\fR
+\fIFontName\fR is the name of a font to use for drawing
+characters. It may have any of the forms accepted
+by Tk_GetFontStruct.
+.TP
+\fB\-foreground \fIcolor\fR
+\fIColor\fR specifies the foreground color to use for characters
+associated with the message type.
+It may have any of the forms accepted by \fBTk_GetColor\fR.
+.TP
+\fB\-show \fIboolean\fR
+Specifies whether of not to display this message type when issued.
+\fIBoolean\fR may have any of the forms accepted by
+\fBTk_GetBoolean\fR. The default is 1.
+
+.SH "METHODS"
+.PP
+The \fBmessagebox\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for messagebox widgets:
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBmessagebox\fR
+command.
+.TP
+\fIpathName \fBclear\fR
+Clear the messagebox of all messages.
+.TP
+\fIpathName \fBexport\fR \fIfilename\fR
+Write text to a file. If \fIfilename\fR exists then
+contents are replaced with text widget contents.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBmessagebox\fR
+command.
+.TP
+\fIpathName \fBtype\fR \fIoption\fR \fImsgtype\fR ?\fIarg arg ...\fR?
+This command is used to manipulate message types. The behavior of
+the command depends on the option argument that follows the type keyword.
+The following forms of the command are supported:
+.RS
+.TP
+.TP
+\fIpathName \fBtype add\fR \fImsgtype\fR ?\fIoption value ...\fR?
+Adds a new message type given by \fImsgtype\fR with the display
+properties defined by the option value pairs.
+See MESSAGE TYPES for information on the options that
+are supported.
+.TP
+\fIpathName \fBtype cget\fR \fImsgtype option\fR
+Returns the value of a configuration option for a message type.
+\fIMsgtype\fR identifies the message type, and \fIoption\fR
+specifies a particular configuration option, which must be one of
+the ones listed in the section MESSAGE TYPES.
+.TP
+\fIpathName \fBtype configure \fImsgtype\fR ?\fIoption value ...\fR?
+Query or modify the configuration options for a message type.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for the message type \fImsgtype\fR.
+If \fIoption\fR is specified with no \fIvalue\fR, then the command
+returns a list describing the one named option.
+If one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given option(s) to have the given value(s); in
+this case the command returns an empty string.
+See MESSAGE TYPES for information on the options that
+are supported.
+\fIpathName \fBtype remove\fR \fImsgtype\fR
+Removes an existing message type given by \fImsgtype\fR.
+.RE
+.TP
+\fIpathName \fBissue\fR \fIstring\fR \fI?level?\fR \fI?tags?\fR
+Print a \fIstring\fR to the text area at the given level and with
+any additional tags specified.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBitemMenu\fR
+Class: \fBMenu\fR
+.fi
+.IP
+This is the popup menu that gets displayed when you right-click in the
+text area of the messagebox. Its contents may be modified via the component
+command.
+.LP
+.nf
+Name: \fBtext\fR
+Class: \fBScrolledtext\fR
+.fi
+.IP
+The text component is the scrolledtext widget. See the "scrolledtext" widget
+manual entry for details on the text component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ messagebox .mb -hscrollmode dynamic -labeltext "Messages" -labelpos n \\
+ -height 120 -width 550 -savedir "/tmp" -textbackground #d9d9d9
+
+ pack .mb -padx 5 -pady 5 -fill both -expand yes
+
+ .mb type add ERROR -background red -foreground white -bell 1
+ .mb type add WARNING -background yellow -foreground black
+ .mb type add INFO -background white -foreground black
+
+ .mb issue "This is an error message in red with a beep" ERROR
+ .mb issue "This warning message in yellow" WARNING
+ .mb issue "This is an informational message" INFO
+.DE
+.SH AUTHOR
+Alfredo Jahn V
+.DE
+Mark L. Ulferts
+.LP
+.SH KEYWORDS
+messagebox, scrolledtext, text, widget
+
diff --git a/itcl/iwidgets3.0.0/doc/messagedialog.n b/itcl/iwidgets3.0.0/doc/messagedialog.n
new file mode 100644
index 00000000000..817f0afd7ca
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/messagedialog.n
@@ -0,0 +1,214 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) messagedialog.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS messagedialog iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+messagedialog \- Create and manipulate a message dialog widget
+.SH SYNOPSIS
+\fBmessagedialog\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Toplevel <- Shell <- Dialogshell <- Dialog <- Messagedialog
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBbitmap\fR \fBcursor\fR \fBfont\fR
+\fBforeground\fR \fBimage\fR \fBtext\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbuttonBoxPadX\fR \fBbuttonBoxPadY\fR \fBbuttonBoxPos\fR \fBpadX\fR
+\fBpadY\fR \fBseparator\fR \fBthickness\fR
+.fi
+.LP
+See the "dialogshell" widget manual entry for details on the above
+inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBmaster\fR \fBmodality\fR
+.fi
+.LP
+See the "shell" widget manual entry for details on the above
+inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtitle\fR
+.fi
+.LP
+See the "Toplevel" widget manual entry for details on the above
+inherited options.
+.LP
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBimagePos\fR
+Class: \fBPosition\fR
+Command-Line Switch: \fB-imagepos\fR
+.fi
+.IP
+Specifies the image position relative to the message text: \fBn\fR, \fBs\fR,
+\fBe\fR, or \fBw\fR. The default is w.
+.LP
+.nf
+Name: \fBtextPadX\fR
+Class: \fBPad\fR
+Command-Line Switch: \fB-textpadx\fR
+.fi
+.IP
+Specifies a non-negative value indicating how much extra space to request for
+the message text in the X direction. The value may have any of the forms
+acceptable to Tk_GetPixels.
+.LP
+.nf
+Name: \fBtextPadY\fR
+Class: \fBPad\fR
+Command-Line Switch: \fB-textpady\fR
+.fi
+.IP
+Specifies a non-negative value indicating how much extra space to request for
+the message text in the X direction. The value may have any of the forms
+acceptable to Tk_GetPixels.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBmessagedialog\fR command creates a message dialog composite widget.
+The messagedialog is derived from the Dialog class and is composed of
+an image and associated message text with commands to manipulate the
+dialog buttons.
+
+.SH "METHODS"
+.PP
+The \fBmessagedialog\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for messagedialog widgets:
+
+.SH "INHERITED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBadd\fR \fBbuttonconfigure\fR \fBdefault\fR \fBhide\fR
+\fBinsert\fR \fBinvoke\fR \fBshow\fR
+.fi
+.LP
+See the "buttonbox" widget manual entry for details on the above
+inherited methods.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBchildsite\fR
+.fi
+.LP
+See the "dialogshell" widget manual entry for details on the above
+inherited methods.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactivate\fR \fBcenter\fR \fBdeactivate\fR
+.fi
+.LP
+See the "dialogshell" widget manual entry for details on the above
+inherited methods.
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBmessagedialog\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBmessagedialog\fR
+command.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBimage\fR
+Class: \fBLabel\fR
+.fi
+.IP
+The image component is the bitmap or image of the message dialog. See
+the "label" widget manual entry for details on the image component item.
+.LP
+.nf
+Name: \fBmessage\fR
+Class: \fBLabel\fR
+.fi
+.IP
+The message component provides the textual portion of the message dialog.
+See the "label" widget manual entry for details on the message component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ #
+ # Standard question message dialog used for confirmation.
+ #
+ messagedialog .md -title "Message Dialog" -text "Are you sure ?" \\
+ -bitmap questhead -modality global
+
+ .md buttonconfigure OK -text Yes
+ .md buttonconfigure Cancel -text No
+
+ if {[.md activate]} {
+ .md configure -text "Are you really sure ?"
+ if {[.md activate]} {
+ puts stdout "Yes"
+ } else {
+ puts stdout "No"
+ }
+ } else {
+ puts stdout "No"
+ }
+
+ destroy .md
+
+ #
+ # Copyright notice with automatic deactivation.
+ #
+ messagedialog .cr -title "Copyright" -bitmap @dsc.xbm -imagepos n \\
+ -text "Copyright 1995 DSC Communications Corporation\\n \\
+ All rights reserved"
+
+ .cr hide Cancel
+
+ .cr activate
+ after 10000 ".cr deactivate"
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.SH KEYWORDS
+messagedialog, dialog, dialogshell, shell, widget
diff --git a/itcl/iwidgets3.0.0/doc/mkitclman b/itcl/iwidgets3.0.0/doc/mkitclman
new file mode 100755
index 00000000000..cbcd1dbb72e
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/mkitclman
@@ -0,0 +1,320 @@
+#!/bin/sh
+# \
+ exec itkwish "$0" ${1+"$@"}
+#
+# mkitclman "4 Dec 1995"
+# mkitclman - generate a man page from an itcl class
+#
+# SYNOPSIS
+# mkitclman classfile
+#
+# DESCRIPTION
+# Reads an [incr Tcl] or [incr Tk] class file as input, and outputs nroff.
+# mkitclman generates a standard format used for [incr Widget] classes. It
+# locates the class name, inheritance to one level, widget specific options,
+# and widget specific methods. Areas that the script cannot handle it
+# places and uppercased name delimited by leading and trailing '_' characters.
+#
+# [incr Tcl/Tk] 2.0 is the supported class format.
+#
+# CAVEATS
+# mkitlcman does not work with normal Tk or Tcl script files.
+# It expects only one class per file. In addition, it does not work on
+# namespace files.
+
+proc init { } {
+ global _className
+ global _inheritClass
+ global _publicMethod
+ global _publicVariable
+ global _protectedMethod
+ global _protectedVariable
+ global _privateMethod
+ global _privateVariable
+ global _options
+
+ set _className {}
+ set _inheritClass {}
+
+}
+proc namespace { args } {
+ global _className
+
+ set _className [lindex $args 0]
+ set classBody [lindex $args 1]
+
+ eval $classBody
+}
+proc class { args } {
+ global _className
+
+ set _className [lindex $args 0]
+ set classBody [lindex $args 1]
+
+ eval $classBody
+}
+proc itk_option { action switch args } {
+ global _options
+
+ if { $action == "define" } {
+ set _options($switch) $args
+ }
+}
+proc inherit { inheritClass } {
+ global _inheritClass
+ set _inheritClass $inheritClass
+}
+
+# default is public method
+proc method { name args } {
+ global _publicMethod
+
+ set _publicMethod($name) $args
+}
+
+# pick up arrays later...
+proc common { name args } {
+ global _commonVariable
+
+ # set to defaults
+ set _commonVariable($name) $args
+}
+
+proc public { type args } {
+ global _publicMethod
+ global _publicVariable
+
+ switch $type {
+ method {
+ set _publicMethod([lindex $args 0]) [lindex $args 1]
+ }
+ variable {
+ # _publicVariable(varName) = defaultValue
+ set _publicVariable([lindex $args 0]) [lindex $args 1]
+ }
+ }
+}
+
+proc protected { type args } {
+ global _protectedMethod
+ global _protectedVariable
+
+ switch $type {
+ method {
+ # _protectedMethod(methodName) = argList
+ set _protectedMethod([lindex $args 0]) [lrange $args 1 end]
+ }
+ variable {
+ # _protectedVariable(varName) = defaultValue
+ set _protectedVariable([lindex $args 0]) [lindex $args 1]
+ }
+ }
+}
+
+proc private { type args } {
+ global _privateMethod
+ global _privateVariable
+
+ switch $type {
+ method {
+ # _privateMethod(methodName) = argList
+ set _privateMethod([lindex $args 0]) [lrange $args 1 end]
+ }
+ variable {
+ # _privateVariable(varName) = defaultValue
+ set _privateVariable([lindex $args 0]) [lindex $args 1]
+ }
+ }
+}
+
+proc body { args } {
+}
+
+proc configbody { args } {
+}
+
+proc destructor { args } {
+}
+proc constructor { args } {
+}
+
+proc gen { } {
+ global _className
+ global _classBody
+ global _inheritClass
+ global _publicMethod
+ global _publicVariable
+ global _protectedMethod
+ global _protectedVariable
+ global _privateMethod
+ global _privateVariable
+ global _methodSection
+ global _optionSection
+ global _manpage
+ global _optionManFmt
+ global _methodManFmt
+ global _method
+ global _options
+ global _optionSwitch
+ global _optionName
+ global _optionClass
+
+ if { $_inheritClass != {} } {
+ set _inheritClass "$_inheritClass <-"
+ }
+ set _optionManFmt {}
+ set _methodManFmt {}
+ set _methodArgs {}
+ foreach pbv [lsort [array names _publicVariable]] {
+ set _optionSwitch "-$pbv"
+ set _optionName $pbv
+ set _optionClass "[string toupper [string index $pbv 0]][string range $pbv 1 end]"
+ lappend _optionManFmt [subst -nobackslash -nocommand $_optionSection]
+ }
+
+ foreach opt [lsort [array names _options]] {
+ set _optionSwitch $opt
+ set _optionName [lindex $_options($opt) 0]
+ set _optionClass [lindex $_options($opt) 1]
+ lappend _optionManFmt [subst -nobackslash -nocommand $_optionSection]
+ }
+ foreach pbm [lsort [array names _publicMethod]] {
+ set _method $pbm
+ eval set _methodArgs [list $_publicMethod($pbm)]
+ lappend _methodManFmt [subst -nobackslash -nocommand $_methodSection]
+ }
+ foreach ptm [lsort [array names _protectedMethod]] {
+ }
+ foreach ptv [lsort [array names _protectedVariable]] {
+ }
+ foreach pvm [lsort [array names _privateMethod]] {
+ }
+ foreach pvv [lsort [array names _privateVariable]] {
+ }
+
+ set _methodManFmt [join $_methodManFmt " "]
+ set _optionManFmt [join $_optionManFmt " "]
+
+ set _manpage [subst -nobackslash -nocommand $_manpage]
+
+ puts $_manpage
+}
+
+set _manpage {
+'\"
+'\" Copyright (c) _AUTHOR_
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) $_className.n
+'/"
+.so man.macros
+.HS $_className iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+'\"
+'\"
+.SH NAME
+$_className \- _NAME_DESCRIPTION_
+.SH SYNOPSIS
+\fB$_className\fI \fIpathName\fR ?\fIoptions\fR?
+.SH "INHERITANCE"
+$_inheritClass $_className
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+_STANDARD_OPTIONS_
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+_ASSOCIATED_OPTIONS_
+.fi
+.LP
+See the "_ASSOCIATED_WIDGET_" widget manual entry for details on the above
+associated options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+_INHERITED_OPTIONS_
+.fi
+.LP
+See the "_INHERITED_WIDGET_" class manual entry for details on the inherited options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+$_optionManFmt
+.BE
+.SH DESCRIPTION
+.PP
+_DESCRIPTION_
+.SH "METHODS"
+.PP
+The \fB$_className\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for $_className widgets:
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+_ASSOCIATED_METHODS_
+.fi
+.LP
+See the "_ASSOCIATED_WIDGET_" manual entry for details on the standard methods.
+.SH "WIDGET-SPECIFIC METHODS"
+$_methodManFmt
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fB_COMPONENT_NAME_\fR
+Class: \fB_COMPONENT_CLASS_\fR
+.fi
+.IP
+_COMPONENT_DESCRIPTION_
+See the "_COMPONENT_TYPE_" widget manual entry for details on the _COMPONENT_NAME_ component item.
+.fi
+.SH EXAMPLE
+.DS
+_EXAMPLE_CODE_
+.DE
+.SH AUTHOR
+_AUTHOR_
+.SH KEYWORDS
+_KEYWORDS_
+}
+
+set _optionSection {
+.nf
+Name: \fB$_optionName\fR
+Class: \fB$_optionClass\fR
+Command-Line Switch: \fB$_optionSwitch\fR
+.fi
+.IP
+_OPTION_DESCRIPTION_
+.LP
+}
+
+set _methodSection {
+.TP
+\fIpathName\fR \fB$_method\fR \fI$_methodArgs\fR
+_METHOD_DESCRIPTION_
+}
+
+# Add these two lines up into the man page above to enable
+
+init
+source [lindex $argv 0]
+gen
+exit
diff --git a/itcl/iwidgets3.0.0/doc/notebook.n b/itcl/iwidgets3.0.0/doc/notebook.n
new file mode 100644
index 00000000000..c16a543b172
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/notebook.n
@@ -0,0 +1,318 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) notebook.n
+'/"
+.so man.macros
+.HS notebook iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+'\"
+'\"
+.SH NAME
+notebook \- create and manipulate notebook widgets
+.SH SYNOPSIS
+\fBnotebook\fR \fIpathName\fR ?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- notebook
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBforeground\fR \fBscrollCommand\fR \fBwidth\fR
+\fBcursor\fR \fBheight\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBauto\fR
+Class: \fBAuto\fR
+Command-Line Switch: \fB-auto\fR
+.fi
+.IP
+Specifies whether to use the automatic packing/unpacking algorithm of the
+notebook. A value of \fBtrue\fR indicates that page frames will be unpacked
+and packed acoording to the algorithm described in the \fBselect\fR command.
+A value of \fBfalse\fR leaves the current page packed and subsequent selects,
+next, or previous commands do not switch pages automatically. In either
+case the page's associated command (see the \fBadd\fR command's description
+of the \fBcommand\fR option) is invoked. The value may have any of the
+forms accepted by the \fBTcl_GetBoolean\fR, such as true, false, 0, 1, yes,
+or no.
+.IP
+For example, if a series of pages in a notebook simply change certain display
+configurations of a graphical display, the \fB-auto\fR flag could be used.
+By setting it, the \fB-command\fR procs could do the appropriate reconfiguring
+of the page when the page is switched.
+.BE
+.SH DESCRIPTION
+.PP
+The \fBnotebook\fR command creates a new window (given by the pathName
+argument) and makes it into a notebook widget. Additional options, described
+above may be specified on the command line or in the option database to
+configure aspects of the notebook such as its colors, font, and text.
+The \fBnotebook\fR command returns its \fIpathName\fR argument. At the time
+this command is invoked, there must not exist a window named pathName, but
+pathName's parent must exist.
+
+A notebook is a widget that contains a set of pages. It displays one page from
+the set as the selected page. When a page is selected, the page's contents are
+displayed in the page area. When first created a notebook has no pages. Pages
+may be added or deleted using widget commands described below.
+
+.SH "NOTEBOOK PAGES"
+.PP
+A notebook's pages area contains a single child site \fBframe\fR. When a new
+page is created it is a child of this frame. The page's child site frame
+serves as a geometry container for applications to pack widgets into. It is
+this frame that is automatically unpacked or packed when the \fBauto\fR
+option is \fBtrue\fR. This creates the effect of one page being visible at
+a time. When a new page is selected, the previously selected page's child
+site frame is automatically unpacked from the notebook's child site frame
+and the newly selected page's child site is packed into the notebook's
+child site frame.
+
+However, sometimes it is desirable to handle page changes in a different
+manner. By specifying the \fBauto\fR option as \fBfalse\fR, child site
+packing can be disabled and done differently. For example, all widgets might
+be packed into the first page's child site frame. Then when a new page is
+selected, the application can reconfigure the widgets and give the appearance
+that the page was flipped.
+
+In both cases the \fBcommand\fR option for a page specifies a Tcl Command to
+execute when the page is selected. In the case of \fBauto\fR being \fBtrue\fR,
+it is called between the unpacking of the previously selected page and the
+packing of the newly selected page.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.PP
+The \fBnotebookfR command creates a new Tcl command whose name
+is \fIpathName\fR. This command may be used to invoke various operations
+on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIoption\fR and the \fIarg\fRs
+determine the exact behavior of the command.
+.PP
+Many of the widget commands for a notebook take as one argument an indicator
+of which page of the notebook to operate on. These indicators are called
+indexes and may be specified in any of the following forms:
+.TP
+\fInumber\fR
+Specifies the index of the the component. For menus, 0 corresponds to the
+left-most menu of the menu bar. For entries, 0 corresponds to the top-most
+entry of the menu.
+\fInumber\fR
+Specifies the page numerically, where 0 corresponds to the first page in
+the notebook, 1 to the second, and so on.
+.TP
+\fBselect\fR
+Specifies the currently selected page's index. If no page is currently
+selected, the value -1 is returned.
+.TP
+\fBend\fR
+Specifes the last page in the notebooks's index. If the notebook is empty
+this will return -1.
+.TP
+\fIpattern\fR
+If the index doesn't satisfy the form of a number, then this form is used.
+Pattern is pattern-matched against the \fBlabel\fR of each page in the
+notebook, in order from the first to the last page, until a matching entry
+is found. The rules of \fBTcl_StringMatch\fR are used.
+.PP
+'.............................................................................
+The following commands are possible for notebook widgets:
+.TP
+\fIpathName\fR \fBadd\fR ?\fIoption value\fR?
+Add a new page at the end of the notebook. A new child site frame is
+created. Returns the child site pathName. If additional arguments are
+present, they specify any of the following options:
+.RS
+.TP
+\fB-background\fR \fIvalue\fR
+Specifies a background color to use for displaying the child site frame
+of this page. If this option is specified as an empty string (the default),
+then the background option for the overall notebook is used.
+.TP
+\fB-command\fR \fIvalue\fR
+Specifies a Tcl command to be executed when this page is selected. This
+allows the programmer a hook to reconfigure this page's widgets or any other
+page's widgets.
+.IP
+If the notebook has the auto option set to true, when a page is selected
+this command will be called immediately after the previously selected page
+is unpacked and immediately before this page is selected. The index value
+select is valid during this Tcl command. `index select' will return this
+page's page number.
+.IP
+If the auto option is set to false, when a page is selected the unpack and
+pack calls are bypassed. This Tcl command is still called.
+.TP
+\fB-foreground\fR \fIvalue\fR
+Specifies a foreground color to use for displaying tab labels when tabs are
+in their normal unselected state. If this option is specified as an empty
+string (the default), then the foreground option for the overall notebook
+is used.
+.TP
+\fB-label\fR \fIvalue\fR
+Specifies a string to associate with this page. This label serves as an
+additional identifier used to reference the page. This label may be used
+for the index value in widget commands.
+.RE
+.TP
+\fIpathName\fR \fBchildSite\fR ?\fIindex\fR?
+If passed no arguments, returns a list of pathNames for all the pages in
+the notebook. If the notebook is empty, an empty list is returned
+.IP
+If index is passed, it returns the pathName for the page's child site
+frame specified by index. Widgets that are created with this pathName will
+be displayed when the associated page is selected. If index is not a valid
+index, an empty string is returned.
+.TP
+\fIpathName\fR \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given by \fIoption\fR.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue\fR \fIoption\fR \fIvalue\fR ...?
+Query or modify the configuration options of the widget. If no \fIoption\fR
+is specified, returns a list describing all of the available options
+for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for information on the
+format of this list). If \fIoption\fR is specified with no \fIvalue\fR,
+then the command returns a list describing the one named option (this
+list will be identical to the corresponding sublist of the value returned
+if no option is specified). If one or more option-value pairs are specified,
+then the command modifies the given widget option(s) to have the given
+value(s); in this case the command returns an empty string. \fIOption\fR
+may have any of the values accepted by the \fBnotebook\fR command.
+.TP
+\fIpathName\fR \fBdelete\fR \fIindex1\fR ?i\fRndex2?
+Delete all of the pages between \fIindex1\fR and \fIindex2\fR inclusive.
+If \fIindex2\fR is omitted then it defaults to \fIindex1\fR. Returns an
+empty string.
+.TP
+\fIpathName\fR \fBindex\fR \fIindex\fR
+Returns the numerical index corresponding to \fIindex\fR.
+.TP
+\fBpathName\fR \fBinsert\fR \fIindex\fR ?\fIoption\fR \fIvalue\fR?
+Insert a new page in the notebook before the page specified by \fIindex\fR.
+A new child site \fBframe\fR is created. See the \fBadd\fR command for
+valid options. Returns the child site pathName.
+.TP
+\fIpathName\fR \fBnext\fR
+Advances the selected page to the next page (order is determined by insertion
+order). If the currently selected page is the last page in the notebook,
+the selection wraps around to the first page in the notebook.
+.IP
+For notebooks with auto set to true the current page's child site is
+unpacked from the notebook's child site frame. Then the next page's child
+site is packed into the notebooks child site frame. The Tcl command given
+with the command option will be invoked between these two operations.
+.IP
+For notebooks with auto set to false the Tcl command given with the
+command option will be invoked.
+.TP
+\fIpathName\fR \fBpagecget\fR \fIindex\fR ?\fIoption\fR?
+Returns the current value of the configuration option given by \fIoption\fR
+for the page specified by \fIindex\fR. The valid available options are the
+same as available to the \fBadd\fR command.
+.TP
+\fIpathName\fR \fBpageconfigure\fR \fIindex\fR ?\fIoption\fR? ?\fIvalue\fR \fIoption\fR \fIvalue\fR ...?
+This command is similar to the configure command, except that it applies to
+the options for an individual page, whereas configure applies to the options
+for the notebook. Options may have any of the values accepted by the add
+widget command. If options are specified, options are modified as indicated
+in the command and the command returns an empty string. If no options are
+specified, returns a list describing the current options for
+page \fIindex\fR (see \fBTk_ConfigureInfo\fR for information on the
+format of this list).
+.TP
+\fIpathName\fR \fBprev\fR
+Moves the selected page to the previous page (order is determined by
+insertion order). If the currently selected page is the first page in the
+notebook, the selection wraps around to the last page in the notebook.
+.IP
+For notebooks with \fBauto\fR set to \fBtrue\fR the current page's child
+site is unpacked from the notebook's child site frame. Then the previous
+page's child site is packed into the notebooks child site frame. The Tcl
+command given with the command option will be invoked between these two
+operations.
+.IP
+For notebooks with \fBauto\fR set to \fBfalse\fR the Tcl command given with
+the command option will be invoked.
+.TP
+\fIpathName\fR \fBselect\fR \fIindex\fR
+Selects the page specified by \fIindex\fR as the currently selected page.
+.IP
+For notebooks with \fBauto\fR set to \fBtrue\fR the current page's child
+site is unpacked from the notebook's child site frame. Then the index page's
+child site is packed into the notebooks child site frame. The Tcl command
+given with the command option will be invoked between these two operations.
+.IP
+For notebooks with \fBauto\fR set to \fBfalse\fR the Tcl command given with
+the command option will be invoked.
+.TP
+\fIpathName\fR \fBview\fR
+Returns the currently selected page. This command is for compatibility
+with the scrollbar widget.
+.TP
+\fIpathName\fR \fBview\fR \fIindex\fR
+Selects the page specified by \fIindex\fR as the currently selected page.
+This command is for compatibility with the scrollbar widget.
+.TP
+\fIpathName\fR \fBview\fR \fImoveto\fR \fIfraction\fR
+Uses the fraction value to determine the corresponding page to move to.
+This command is for compatibility with the scrollbar widget.
+.TP
+\fIpathName\fR \fBview\fR \fIscroll\fR \fInum\fR \fIwhat\fR
+Uses the \fInum\fR value to determine how many pages to move forward or
+backward (num can be negative or positive). The \fIwhat\fR argument is
+ignored. This command is for compatibility with the scrollbar widget.
+
+.SH EXAMPLE
+.PP
+Following is an example that creates a notebook with two pages. In this example, we use a scrollbar widget to control the notebook widget.
+.nf
+.IP
+.ta 2c 8c 12c
+# Create the notebook widget and pack it.
+ notebook .nb -width 100 -height 100
+ pack .nb -anchor nw \\
+ -fill both \\
+ -expand yes \\
+ -side left \\
+ -padx 10 \\
+ -pady 10
+.IP
+# Add two pages to the notebook, labelled
+# "Page One" and "Page Two", respectively.
+ .nb add -label "Page One"
+ .nb add -label "Page Two"
+.IP
+# Get the child site frames of these two pages.
+ set page1CS [.nb childsite 0]
+ set page2CS [.nb childsite "Page Two"]
+.IP
+# Create buttons on each page of the notebook
+ button $page1CS.b -text "Button One"
+ pack $page1CS.b
+ button $page2CS.b -text "Button Two"
+ pack $page2CS.b
+.IP
+# Select the first page of the notebook
+ .nb select 0
+.IP
+# Create the scrollbar and associate teh scrollbar
+# and the notebook together, then pack the scrollbar
+ ScrollBar .scroll -command ".nb view"
+ .nb configure -scrollcommand ".scroll set"
+ pack .scroll -fill y -expand yes -pady 10
+.fi
+.SH AUTHOR
+Bill W. Scott
+.SH KEYWORDS
+notebook page
diff --git a/itcl/iwidgets3.0.0/doc/optionmenu.n b/itcl/iwidgets3.0.0/doc/optionmenu.n
new file mode 100644
index 00000000000..42ca4d05836
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/optionmenu.n
@@ -0,0 +1,259 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) optionmenu.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS optionmenu iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+optionmenu \- Create and manipulate a option menu widget
+.SH SYNOPSIS
+\fBoptionmenu\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- Labeledwidget <- optionmenu
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBactiveBorderWidth\fR \fBactiveForeground\fR \fBbackground\fR
+\fBborderWidth\fR \fBcursor\fR \fBdisabledForeground\fR \fBfont\fR
+\fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR \fBrelief\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBdisabledForeground\fR \fBlabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR
+\fBlabelMargin\fR \fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR
+\fBstate\fR
+.fi
+.LP
+See the "LabeledWidget" manual entry for details on the inherited options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBclickTime\fR
+Class: \fBClickTime\fR
+Command-Line Switch: \fB-clicktime\fR
+.fi
+.IP
+Interval time, in msec, used to determine that a single mouse
+click has occurred. Used to post menu on a "quick" mouse click.
+\fBNote\fR: changing this value may cause the sigle-click
+functionality to not work properly. The default is 150 msec.
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-command\fR
+.fi
+.IP
+Specifies a Tcl command procedure to be evaluated following a change in
+the current option menu selection.
+.LP
+.nf
+Name: \fBcyclicOn\fR
+Class: \fBCyclicOn\fR
+Command-Line Switch: \fB-cyclicon\fR
+.fi
+.IP
+Turns on/off the 3rd mouse button capability. The value may be specified
+in any of the forms acceptable to \fBTcl_GetBoolean\fR. This feature
+allows the right mouse button to cycle through the popup
+menu list without poping it up. The right mouse button cycles through
+the menu in reverse order. The default is true.
+.LP
+.nf
+Name: \fBpopupCursor\fR
+Class: \fBCursor\fR
+Command-Line Switch: \fB-popupcursor\fR
+.fi
+.IP
+Specifies the mouse cursor to be used for the popup menu. The value may
+have any of the forms acceptable to \fBTk_GetCursor\fR.
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Command-Line Switch: \fB-state\fR
+.fi
+.IP
+Specified one of two states for the optionmenu: \fBnormal\fR, or
+\fBdisabled\fR. If the optionmenu is disabled, then option menu
+selection is ignored.
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-width\fR
+.fi
+.IP
+Specifies a fixed size for the menu button label in any of the forms
+acceptable to \Tk_GetPixels\fR. If the text
+is too small to fit in the label, the text is clipped.
+Note: Normally, when a new list is created, or new items are
+added to an existing list, the menu button label is resized
+automatically. Setting this option overrides that functionality.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBoptionmenu\fR command creates an option menu widget with options
+to manage it. An option menu displays a frame containing a label and a button.
+A pop-up menu will allow for the value of the button to change.
+
+.SH "METHODS"
+.PP
+The \fBoptionmenu\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command.
+.PP
+Many of the widget commands for an optionmenu take as one argument an
+indicator of which entry of the option menu to operate on. These
+indicators are called \fIindex\fRes and may be specified in
+any of the following forms:
+.TP 12
+\fInumber\fR
+Specifies the entry numerically, where 0 corresponds
+to the top-most entry of the option menu, 1 to the entry below it, and
+so on.
+.TP 12
+\fBend\fR
+Indicates the bottommost entry in the menu. If there are no
+entries in the menu then zero is returned.
+.TP 12
+\fBselect\fR
+Returns the numerical index of the currently selected option menu entry.
+If no entries exist in the menu, then -1 is returned.
+.TP 12
+\fIpattern\fR
+If the index doesn't satisfy one of the above forms then this
+form is used. \fIPattern\fR is pattern-matched against the label of
+each entry in the option menu, in order from the top down, until a
+matching entry is found. The rules of \fBTcl_StringMatch\fR
+are used.
+.PP
+The following widget commands are possible for optionmenu widgets:
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBoptionmenu\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBoptionmenu\fR
+command.
+.TP
+\fIpathName \fBdelete \fIfirst\fR ?\fIlast\fR?
+Delete all of the option menu entries between \fIfirst\fR and
+\fIlast\fR inclusive. If \fIlast\fR is omitted then it defaults
+to \fIfirst\fR.
+.TP
+\fIpathName \fBdisable \fIindex\fR
+Disable the option menu entry specified by \fIindex\fR.
+Disabling a menu item will prevent the user from being able to select
+this item from the menu. This only effects the state of the item
+in the menu, in other words, should the item be the currently
+selected item, the programmer is responsible for determining this condition
+and taking appropriate action.
+.TP
+\fIpathName \fBenable \fIindex\fR
+Enable the option menu entry specified by \fIindex\fR.
+Enabling a menu item allows the user to select this item from the menu.
+.TP
+\fIpathName \fBget\fR ?\fIfirst\fR? ?\fIlast\fR?
+If no arguments are specified, this operation returns the currently
+selected option menu item. Otherwise, it returns the name of the
+option at index \fIfirst\fR, or a range of options between \fIfirst\fR
+and \fIlast\fR.
+.TP
+\fIpathName \fBindex \fIindex\fR
+Returns the numerical index corresponding to \fIindex\fR.
+.TP
+\fIpathName \fBinsert \fIindex string\fR ?\fIstring\fR?
+Insert an item, or list of items, into the menu at location \fIindex\fR.
+.TP
+\fIpathName \fBselect \fIindex\fR
+Select an item from the option menu to be displayed as the currently
+selected item.
+.TP
+\fIpathName \fBsort \fImode\fR
+Sort the current menu in either \fBascending\fR, or \fBdescending\fR order.
+The values \fBincreasing\fR, or \fBdecreasing\fR are also accepted.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBmenuBtn\fR
+Class: \fBMenubutton\fR
+.fi
+.IP
+The menuBtn component is the option menu button which displays the current
+choice from the popup menu. See the "menubutton" widget manual entry
+for details on the menuBtn component item.
+.LP
+.nf
+Name: \fBpopupMenu\fR
+Class: \fBMenu\fR
+.fi
+.IP
+The popupMenu component is menu displayed upon selection of the menu button.
+The menu contains the choices for the option menu. See the "menu" widget
+manual entry for details on the popupMenu component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ optionmenu .om -labelmargin 5 \\
+ -labelon true -labelpos w -labeltext "Operating System :"
+
+ .om insert end Unix VMS Linux OS/2 {Windows NT} DOS
+ .om sort ascending
+ .om select Linux
+
+ pack .om -padx 10 -pady 10
+.DE
+.SH ACKNOWLEDGEMENTS:
+Michael J. McLennan
+.IP
+Borrowed some ideas (next & previous) from OptionButton class.
+.LP
+Steven B. Jaggers
+.IP
+Provided an initial prototype in [incr Tcl].
+.LP
+Bret Schuhmacher
+.IP
+Helped with popup menu functionality.
+.LP
+.SH AUTHOR
+Alfredo Jahn
+.SH KEYWORDS
+optionmenu, widget
diff --git a/itcl/iwidgets3.0.0/doc/panedwindow.n b/itcl/iwidgets3.0.0/doc/panedwindow.n
new file mode 100644
index 00000000000..b5cf79554ba
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/panedwindow.n
@@ -0,0 +1,297 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) panedwindow.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS panedwindow iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+panedwindow \- Create and manipulate a paned window widget
+.SH SYNOPSIS
+\fBpanedwindow\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- panedwindow
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBcursor\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Command-Line Switch: \fB-height\fR
+.fi
+.IP
+Specifies the overall height of the paned window in any of the forms
+acceptable to \fBTk_GetPixels\fR. The default is 10 pixels.
+.LP
+.nf
+Name: \fBorient\fR
+Class: \fBOrient\fR
+Command-Line Switch: \fB-orient\fR
+.fi
+.IP
+Specifies the orientation of the separators: \fBvertical\fR or
+\fBhorizontal\fR. The default is horizontal.
+.LP
+.nf
+Name: \fBsashBorderWidth\fR
+Class: \fBBorderWidth\fR
+Command-Line Switch: \fB-sashborderwidth\fR
+.fi
+.IP
+Specifies a value indicating the width of the 3-D border to draw
+around the outside of the sash in any of the forms acceptable to
+\fBTk_GetPixels\fR. The default is 2 pixels.
+.LP
+.nf
+Name: \fBsashCursor\fR
+Class: \fBCursor\fR
+Command-Line Switch: \fB-sashcursor\fR
+.fi
+.IP
+Specifies the type of cursor to be displayed in the sash. The default
+is crosshair.
+.LP
+.nf
+Name: \fBsashHeight\fR
+Class: \fBHeight\fR
+Command-Line Switch: \fB-sashheight\fR
+.fi
+.IP
+Specifies the height of the sash in any of the forms acceptable to
+\fBTk_GetPixels\fR. The default is 10 pixels.
+.LP
+.nf
+Name: \fBsashIndent\fR
+Class: \fBSashIndent\fR
+Command-Line Switch \fBsashindent\fR
+.fi
+.IP
+Specifies the placement of the sash along the panes in any of the forms
+acceptable to \fBTk_GetPixels\fR. A positive
+value causes the sash to be offset from the near (left/top) side
+of the pane, and a negative value causes the sash to be offset from
+the far (right/bottom) side. If the offset is greater than the
+width, then the sash is placed flush against the side. The
+default is -10 pixels.
+.LP
+.nf
+Name: \fBsashWidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-sashwidth\fR
+.fi
+.IP
+Specifies the width of the sash in any of the forms acceptable to
+\fBTk_GetPixels\fR. The default is 10 pixels.
+.LP
+.nf
+Name: \fBthickness\fR
+Class: \fBThickness\fR
+Command-Line Switch: \fB-thickness\fR
+.fi
+.IP
+Specifies the thickness of the separators in any of the forms acceptable to
+\fBTk_GetPixels\fR. The default is 3 pixels.
+.LP
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-width\fR
+.fi
+.IP
+Specifies the overall width of the paned window in any of the forms
+acceptable to \fBTk_GetPixels\fR. The default is 10 pixels.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBpanedwindow\fR command creates a multiple paned window widget
+capable of orienting the panes
+either vertically or horizontally. Each pane is itself a frame acting
+as a child site for other widgets. The border separating each pane
+contains a sash which allows user positioning of the panes relative to
+one another.
+
+.SH "METHODS"
+.PP
+The \fBpanedwindow\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command.
+.PP
+Many of the widget commands for the \fBpanedwindow\fR take as one argument an
+indicator of which pane of the paned window to operate on. These indicators
+are called \fIindexes\fR and allow reference and manipulation of panes
+regardless of their current map state. Paned window indexes may be
+specified in any of the following forms:
+.TP 12
+\fInumber\fR
+Specifies the pane numerically, where 0 corresponds to the nearest
+(top/left-most) pane of the paned window.
+.TP 12
+\fBend\fR
+Indicates the farthest (bottom/right-most) pane of the paned window.
+.TP 12
+\fIpattern\fR
+If the index doesn't satisfy one of the above forms then this
+form is used. \fIPattern\fR is pattern-matched against the tag of
+each pane in the panedwindow, in order from left/top to right/left,
+until a matching entry is found. The rules of \fBTcl_StringMatch\fR
+are used.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBadd\fR \fItag\fR ?\fIoption value option value\fR?
+Adds a new pane to the paned window on the far side (right/bottom). The
+following options may be specified:
+.RS
+.TP
+\fB-margin\fR \fIvalue\fR
+Specifies the border distance between the pane and pane contents is any of
+the forms acceptable to \fBTk_GetPixels\fR. The default is 8 pixels.
+.TP
+\fB-minimum\fR \fIvalue\fR
+Specifies the minimum size that a pane's contents may reach not
+inclusive of twice the margin in any of the forms acceptable to
+\fBTk_GetPixels\fR. The default is 10 pixels.
+
+The \fBadd\fR method returns the path name of the pane.
+.RE
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBpanedwindow\fR
+command.
+.TP
+\fIpathName \fBchildsite\fR ?\fIindex\fR?
+Returns a list of the child site path names or a specific child site given
+an index. The list is constructed from the near side (left/top) to the far
+side (right/bottom).
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBpanedwindow\fR
+command.
+.TP
+\fIpathName \fBdelete\fR \fIindex\fR
+Deletes a specified pane given an \fIindex\fR.
+.TP
+\fIpathName \fBfraction\fR \fIpercentage\fR \fIpercentage\fR ?\fIpercentage percentage ...\fR?
+Sets the visible percentage of the panes. Specifies a set of
+percentages which are applied to the visible panes from the near side
+(left/top). The number of percentages must be equal to the current number
+of visible (mapped) panes and add up to 100.
+.TP
+\fIpathName \fBhide\fR \fIindex\fR
+Changes the visiblity of the specified pane, allowing a previously displayed
+pane to be visually removed rather than deleted.
+.TP
+\fIpathName \fBindex\fR \fIindex\fR
+Returns the numerical index corresponding to index.
+.TP
+\fIpathName \fBinsert \fIindex\fR \fItag\fR ?\fIoption value option value ...\fR?
+Same as the \fBadd\fR command except that it inserts the new
+pane just before the one given by \fIindex\fR, instead of appending
+to the end of the panedwindow. The \fIoption\fR, and \fIvalue\fR
+arguments have the same interpretation as for the \fBadd\fR widget
+command.
+.TP
+\fIpathName \fBpaneconfigure\fR \fIindex\fR ?\fIoptions\fR?
+This command is similar to the \fBconfigure\fR command, except that
+it applies to the options for an individual pane, whereas \fBconfigure\fR
+applies to the options for the paned window as a whole.
+\fIOptions\fR may have any of the values accepted by the \fBadd\fR
+widget command. If \fIoptions\fR are specified, options are modified
+as indicated in the command and the command returns an empty string.
+If no \fIoptions\fR are specified, returns a list describing
+the current options for entry \fIindex\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list).
+.TP
+\fIpathName \fBreset\fR
+Redisplays the pane window using default percentages.
+.TP
+\fIpathName \fBshow\fR \fIindex\fR
+Changes the visiblity of the specified pane, allowing a previously hidden
+pane to be displayed.
+
+.SH "NOTES"
+.IP
+Dynamic changing of the margin and or minimum options to values which
+make the current configuration invalid will block subsequent sash
+movement until the fractions are modified via the fraction method.
+For example a panedwindow is created with three panes and the minimum
+and margin options are at their default settings. Next the user moves
+the sashes to compact the panes to one side. Now, if the minimum is
+increased on the most compressed pane via the paneconfigure method to
+a large enough value, then sash movement is blocked
+until the fractions are adjusted. This situation is unusual and under
+normal operation of the panedwindow, this problem will never occur.
+.LP
+
+.SH EXAMPLE
+.DS
+ panedwindow .pw -width 300 -height 300
+ .pw add top
+ .pw add middle -margin 10
+ .pw add bottom -margin 10 -minimum 10
+
+ pack .pw -fill both -expand yes
+
+ foreach pane [.pw childSite] {
+ button $pane.b -text $pane -relief raised -borderwidth 2
+ pack $pane.b -fill both -expand yes
+ }
+
+ .pw fraction 50 30 20
+ .pw paneconfigure 0 -minimum 20
+ .pw paneconfigure bottom -margin 15
+.DE
+.SH ACKNOWLEDGEMENTS:
+.LP
+Jay Schmidgall
+.IP
+1994 - Base logic posted to comp.lang.tcl
+.LP
+Joe Hidebrand <hildjj@fuentez.com>
+.IP
+07/25/94 - Posted first multipane version to comp.lang.tcl
+.LP
+.IP
+07/28/94 - Added support for vertical panes
+.LP
+Ken Copeland <ken@hilco.com>
+.IP
+09/28/95 - Smoothed out the sash movement and added squeezable panes.
+.LP
+.SH AUTHOR
+Mark L. Ulferts
+.SH KEYWORDS
+panedwindow, widget
diff --git a/itcl/iwidgets3.0.0/doc/promptdialog.n b/itcl/iwidgets3.0.0/doc/promptdialog.n
new file mode 100644
index 00000000000..040cb1b44b5
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/promptdialog.n
@@ -0,0 +1,198 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) promptdialog.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS promptdialog iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+promptdialog \- Create and manipulate a prompt dialog widget
+.SH SYNOPSIS
+\fBpromptdialog\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Toplevel <- dialogshell <- dialog <- promptdialog
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBborderWidth\fR \fBcursor\fR \fBexportSelection\fR
+\fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR \fBinsertBackground\fR
+\fBinsertBorderWidth\fR \fBinsertOffTime\fR \fBinsertOnTime\fR \fBinsertWidth\fR
+\fBrelief\fR \fBselectBackground\fR \fBselectBorderWidth\fR \fBselectForeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBshow\fR
+.fi
+.LP
+See the "entry" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBinvalid\fR \fBtextBackground\fR \fBtextFont\fR \fBvalidate\fR
+.fi
+.LP
+See the "entryfield" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelFont\fR \fBlabelPos\fR \fBlabelText\fR
+.fi
+.LP
+See the "labeledwidget" widget manual entry for details on the above
+associated options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbuttonBoxPadX\fR \fBbuttonBoxPadY\fR \fBbuttonBoxPos\fR \fBpadX\fR
+\fBpadY\fR \fBseparator\fR \fBthickness\fR
+.fi
+.LP
+See the "dialogshell" widget manual entry for details on the above
+inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBheight\fR \fBmaster\fR \fBmodality\fR \fBwidth\fR
+.fi
+.LP
+See the "shell" widget manual entry for details on the above
+inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtitle\fR
+.fi
+.LP
+See the "Toplevel" widget manual entry for details on the above
+inherited options.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBpromptdialog\fR command creates a prompt dialog similar to the
+OSF/Motif standard prompt dialog composite widget. The promptdialog
+is derived from the dialog class and is composed of a EntryField
+with commands to manipulate the dialog buttons.
+
+.SH "METHODS"
+.PP
+The \fBpromptdialog\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for promptdialog widgets:
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBdelete\fR \fBget\fR \fBicursor\fR \fBindex\fR
+\fBinsert\fR \fBscan\fR \fBselection\fR \fBxview\fR
+.fi
+.LP
+See the "entry" widget manual entry for details on the above
+associated methods.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBclear\fR
+.fi
+.LP
+See the "entryfield" widget manual entry for details on the above
+associated methods.
+.SH "INHERITED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBadd\fR \fBbuttonconfigure\fR \fBdefault\fR \fBhide\fR
+\fBinvoke\fR \fBshow\fR
+.fi
+.LP
+See the "buttonbox" widget manual entry for details on the above
+inherited methods.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBchildsite\fR
+.fi
+.LP
+See the "dialogshell" widget manual entry for details on the above
+inherited methods.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactivate\fR \fBcenter\fR \fBdeactivate\fR
+.fi
+.LP
+See the "shell" widget manual entry for details on the above
+inherited methods.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBpromptdialog\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBpromptdialog\fR
+command.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBprompt\fR
+Class: \fBEntryfield\fR
+.fi
+.IP
+The prompt component is the entry field for user input in the prompt
+dialog. See the "entryfield" widget manual entry for details on
+the prompt component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ option add *textBackground white
+
+ promptdialog .pd -modality global -title Password -labeltext Password: -show *
+ .pd hide Apply
+
+ if {[.pd activate]} {
+ puts "Password entered: [.pd get]"
+ } else {
+ puts "Password prompt cancelled"
+ }
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.SH KEYWORDS
+promptdialog, dialog, dialogshell, shell, widget
diff --git a/itcl/iwidgets3.0.0/doc/pushbutton.n b/itcl/iwidgets3.0.0/doc/pushbutton.n
new file mode 100644
index 00000000000..8d46f38f466
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/pushbutton.n
@@ -0,0 +1,147 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) pushbutton.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS pushbutton iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+pushbutton \- Create and manipulate a push button widget
+.SH SYNOPSIS
+\fBpushbutton\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- pushbutton
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBactiveForeground\fR \fBbackground\fR \fBbitmap\fR
+\fBborderWidth\fR \fBcommand\fR \fBcursor\fR \fBdisabledForeground\fR
+\fBfont\fR \fBforeground\fR \fBhighlightBackground\fR \fBhighlightColor\fR
+\fBhighlightThickness\fR \fBimage\fR \fBpadX\fR \fBpadY\fR
+\fBstate\fR \fBtext\fR \fBunderline\fR \fBwrapLength\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBdefaultRing\fR
+Class: \fBDefaultRing\fR
+Command-Line Switch: \fB-defaultring\fR
+.fi
+.IP
+Boolean describing whether the button displays its default ring given in
+any of the forms acceptable to \fBTcl_GetBoolean\fR. The default is false.
+.LP
+.nf
+Name: \fBdefaultRingPad\fR
+Class: \fBPad\fR
+Command-Line Switch: \fB-defaultringpad\fR
+.fi
+.IP
+Specifies the amount of space to be allocated to the indentation of the
+default ring ring given in any of the forms acceptable to \fBTcl_GetPixels\fR.
+The option has no effect if the defaultring option is set to false. The
+default is 2 pixels.
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Command-Line Switch: \fB-height\fR
+.fi
+.IP
+Specifies the height of the button inclusive of any default ring given in
+any of the forms acceptable to \fBTk_GetPixels\fR. A value of zero lets
+the push button determine the height based on the requested height plus
+highlightring and defaultringpad.
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-width\fR
+.fi
+.IP
+Specifies the width of the button inclusive of any default ring given in
+any of the forms acceptable to \fBTk_GetPixels\fR. A value of zero lets
+the push button determine the width based on the requested width plus
+highlightring and defaultringpad.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBpushbutton\fR command creates a push button with an
+optional default ring used for default designation and traversal.
+
+.SH "METHODS"
+.PP
+The \fBpushbutton\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for pushbutton widgets:
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBflash\fR \fBinvoke\fR
+.fi
+.LP
+See the "button" manual entry for details on the associated methods.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBpushbutton\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBpushbutton\fR
+command.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBpushbutton\fR
+Class: \fBButton\fR
+.fi
+.IP
+The pushbutton component is the button surrounded by the optional default ring.
+See the "button" widget manual entry for details on the pushbutton
+component item.
+.fi
+
+.SH EXAMPLE
+.DS
+pushbutton .pb -text "Hello" -command {puts "Hello World"} -defaultring 1
+pack .pb -padx 10 -pady 10
+.DE
+.SH AUTHOR
+Bret A. Schuhmacher
+.DE
+Mark L. Ulferts
+.SH KEYWORDS
+pushbutton, widget
diff --git a/itcl/iwidgets3.0.0/doc/radiobox.n b/itcl/iwidgets3.0.0/doc/radiobox.n
new file mode 100644
index 00000000000..d6f2c4c4bb5
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/radiobox.n
@@ -0,0 +1,169 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) radiobox.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS radiobox iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+radiobox \- Create and manipulate a radiobox widget
+.SH SYNOPSIS
+\fBradiobox\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- labeledframe <- radiobox
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBborderWidth\fR \fBcursor\fR \fBdisabledForeground\fR
+\fBforeground\fR \fBrelief\fR \fBselectColor\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR \fBlabelMargin\fR
+\fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR
+.fi
+.LP
+See the "labeledframe" class manual entry for details on the
+inherited options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-command\fR
+.fi
+.IP
+Specifies a Tcl command procedure to be evaluated following a change in
+the current radio box selection.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBradiobox\fR command creates a radio button box widget
+capable of adding, inserting, deleting, selecting, and configuring
+radiobuttons as well as obtaining the currently selected button.
+
+.SH "METHODS"
+.PP
+The \fBradiobox\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command.
+.PP
+Many of the widget commands for the \fBradiobox\fR take as one argument an
+indicator of which radiobutton of the radiobox to operate on. These indicators
+are called \fIindexes\fR and allow reference and manipulation of radiobuttons.
+Radiobox indexes may be specified in any of the following forms:
+.TP 12
+\fInumber\fR
+Specifies the radiobutton numerically, where 0 corresponds to the top
+radiobutton of the radiobox.
+.TP 12
+\fBend\fR
+Indicates the last radiobutton of the radiobox.
+.TP 12
+\fIpattern\fR
+If the index doesn't satisfy one of the above forms then this
+form is used. \fIPattern\fR is pattern-matched against the tag of
+each radiobutton in the radiobox, in order from top to bottom,
+until a matching entry is found. The rules of \fBTcl_StringMatch\fR
+are used.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBadd\fR \fItag\fR ?\fIoption value option value\fR?
+Adds a new radiobutton to the radiobuttond window on the bottom. The command
+takes additional options which are passed on to the radiobutton as construction
+arguments. These include the standard Tk radiobutton options. The tag is
+returned.
+.TP
+\fIpathName \fBbuttonconfigure\fR \fIindex\fR ?\fIoptions\fR?
+This command is similar to the \fBconfigure\fR command, except that
+it applies to the options for an individual radiobutton,
+whereas \fBconfigure\fRapplies to the options for the radiobox as a whole.
+\fIOptions\fR may have any of the values accepted by the \fBadd\fR
+widget command. If \fIoptions\fR are specified, options are modified
+as indicated in the command and the command returns an empty string.
+If no \fIoptions\fR are specified, returns a list describing
+the current options for entry \fIindex\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list).
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBradiobox\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBradiobox\fR
+command.
+.TP
+\fIpathName \fBdelete\fR \fIindex\fR
+Deletes a specified radiobutton given an \fIindex\fR.
+.TP
+\fIpathName \fBdeselect\fR \fIindex\fR
+Deselects a specified radiobutton given an \fIindex\fR.
+.TP
+\fIpathName \fBflash\fR \fIindex\fR
+Flashes a specified radiobutton given an \fIindex\fR.
+.TP
+\fIpathName \fBget\fR
+Returns the tag of the currently selected radiobutton.
+.TP
+\fIpathName \fBindex\fR \fIindex\fR
+Returns the numerical index corresponding to index.
+.TP
+\fIpathName \fBinsert \fIindex\fR \fItag\fR ?\fIoption value option value ...\fR?
+Same as the \fBadd\fR command except that it inserts the new
+radiobutton just before the one given by \fIindex\fR, instead of appending
+to the end of the radiobox. The \fIoption\fR, and \fIvalue\fR
+arguments have the same interpretation as for the \fBadd\fR widget
+command.
+.TP
+\fIpathName \fBselect\fR \fIindex\fR
+Selects a specified radiobutton given an \fIindex\fR.
+
+.SH EXAMPLE
+.DS
+ radiobox .rb -labeltext Fonts
+ .rb add times -text Times
+ .rb add helvetica -text Helvetica
+ .rb add courier -text Courier
+ .rb add symbol -text Symbol
+ .rb select courier
+
+ pack .rb -padx 10 -pady 10 -fill both -expand yes
+.DE
+
+.SH AUTHOR
+Michael J. McLennan
+.DE
+Mark L. Ulferts
+.SH KEYWORDS
+radiobox, widget
diff --git a/itcl/iwidgets3.0.0/doc/scopedobject.n b/itcl/iwidgets3.0.0/doc/scopedobject.n
new file mode 100755
index 00000000000..2a586123d09
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/scopedobject.n
@@ -0,0 +1,100 @@
+'\"
+'\" Copyright (c) 1997 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) scopedobject.n 1.21 97/1/30 16:04:44
+'/"
+.so man.macros
+.HS scopedobject iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+scopedobject \- Create and manipulate a scoped \[incr Tcl\] class object.
+.SH SYNOPSIS
+\fBscopedobject\fI \fIobjName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+None
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+Name: \fBenterscopecommand:\fR
+Command-Line Switch: \fB-enterscopecommand\fR
+.fi
+.IP
+Specifies a Tcl command to invoke when an object enters scope
+(i.e. when it is created..). The default is {}.
+.LP
+.nf
+Name: \fBenterscopecommand:\fR
+Command-Line Switch: \fB-enterscopecommand\fR
+.fi
+.IP
+Specifies a Tcl command to invoke when an object exits scope
+(i.e. when it is deleted..). The default is {}.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBscopedobject\fR command creates a base class for defining
+Itcl classes which posses scoped behavior like Tcl variables.
+The objects are only accessible within the procedure in which
+they are instantiated and are deleted when the procedure returns.
+This class was designed to be a general purpose base class for
+supporting scoped incr Tcl classes. The options include the
+execute a Tcl script command when an object enters and exits its
+scope.
+.SH "METHODS"
+.PP
+The \fBscopedobject\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various operations on the object.
+It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for scopedobject objects:
+.SH "OBJECT-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBscopedobject\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the object.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR. If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given objects option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBscopedobject\fR
+command.
+
+.SH EXAMPLE
+.IP
+The scopedobject was primarily meant to be a base class. The
+following is an example of usage without inheritance:
+.LP
+.DS
+ proc scopedobject_demo {} {
+ scopedobject #auto \
+ -exitscopecommand {puts "enter scopedobject_demo"} \
+ -exitscopecommand {puts "exit scopedobject_demo"}
+ }
+
+ scopedobject_demo
+
+.DE
+.SH AUTHOR
+John A. Tucker
+.SH KEYWORDS
+scopedobject, object
diff --git a/itcl/iwidgets3.0.0/doc/scopedobject.n.backup b/itcl/iwidgets3.0.0/doc/scopedobject.n.backup
new file mode 100755
index 00000000000..84325422e67
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/scopedobject.n.backup
@@ -0,0 +1,2 @@
+Workspace created file
+Mon Oct 27 16:09:17 CST 1997
diff --git a/itcl/iwidgets3.0.0/doc/scrolledcanvas.n b/itcl/iwidgets3.0.0/doc/scrolledcanvas.n
new file mode 100644
index 00000000000..9c2545200a5
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/scrolledcanvas.n
@@ -0,0 +1,255 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) ScrolledListBox.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS scrolledcanvas iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+scrolledcanvas \- Create and manipulate scrolled canvas widgets
+.SH SYNOPSIS
+\fBscrolledcanvas\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- Labeledwidget <- Scrolledwidget <- Scrolledcanvas
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBbackground\fR \fBborderWidth\fR \fBcursor\fR
+\fBexportSelection\fR \fBfont\fR \fBforeground\fR \fBhighlightColor\fR
+\fBhighlightThickness\fR \fBinsertBorderWidth\fR \fBinsertOffTime\fR \fBinsertOnTime\fR
+\fBinsertWidth\fR \fBrelief\fR \fBselectBackground\fR \fBselectBorderWidth\fR
+\fBselectForeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBcloseEnough\fR \fBconfine\fR \fBscrollRegion\fR \fBxScrollIncrement\fR
+\fByScrollIncrement\fR
+.fi
+.LP
+See the "canvas" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveRelief\fR \fBelementBorderWidth\fR \fBjump\fR \fBtroughColor\fR
+.fi
+.LP
+See the "scrollbar" widget manual entry for details on the above
+associated options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBdisabledForeground\fR \fBlabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR
+\fBlabelMargin\fR \fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR
+\fBstate\fR
+.fi
+.LP
+See the "labeledwidget" class manual entry for details on the inherited options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBautoMargin\fR
+Class: \fBAutoMargin\fR
+Command-Line Switch: \fB-automargin\fR
+.fi
+.IP
+Specifies the autoresize extra margin to reserve. This option is only
+effective with autoresize turned on. The default is 10.
+.LP
+.nf
+Name: \fBautoResize\fR
+Class: \fBAutoResize\fR
+Command-Line Switch: \fB-autoresize\fR
+.fi
+.IP
+Automatically adjusts the scrolled region to be the bounding
+box covering all the items in the canvas following the execution
+of any method which creates or destroys items. Thus, as new
+items are added, the scrollbars adjust accordingly.
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Command-Line Switch: \fB-height\fR
+.fi
+.IP
+Specifies the height of the scrolled canvas widget in any of the forms
+acceptable to \fBTk_GetPixels\fR. The default height is 30 pixels.
+.LP
+.nf
+Name: \fBhscrollMode\fR
+Class: \fBScrollMode\fR
+Command-Line Switch: \fB-hscrollmode\fR
+.fi
+.IP
+Specifies the the display mode to be used for the horizontal
+scrollbar: \fBstatic, dynamic,\fR or \fBnone\fR. In static mode, the
+scroll bar is displayed at all times. Dynamic mode displays the
+scroll bar as required, and none disables the scroll bar display. The
+default is static.
+.LP
+.nf
+Name: \fBsbWidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-sbwidth\fR
+.fi
+.IP
+Specifies the width of the scrollbar in any of the forms acceptable
+to \fBTk_GetPixels\fR. The default width is 15 pixels..
+.LP
+.nf
+Name: \fBscrollMargin\fR
+Class: \fBScrollMargin\fR
+Command-Line Switch: \fB-scrollmargin\fR
+.fi
+.IP
+Specifies the distance between the canvas and scrollbar in any of the
+forms acceptable to \fBTk_GetPixels\fR. The default is 3 pixels.
+.LP
+.nf
+Name: \fBtextBackground\fR
+Class: \fBBackground\fR
+Command-Line Switch \fB-textbackground\fR
+.fi
+.IP
+Specifies the background color for the canvas. This allows the background
+within the canvas to be different from the normal background color.
+.LP
+.nf
+Name: \fBvscrollMode\fR
+Class: \fBScrollMode\fR
+Command-Line Switch: \fB-vscrollmode\fR
+.fi
+.IP
+Specifies the the display mode to be used for the vertical
+scrollbar: \fBstatic, dynamic,\fR or \fBnone\fR. In static mode, the
+scroll bar is displayed at all times. Dynamic mode displays the
+scroll bar as required, and none disables the scroll bar display. The
+default is static.
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-width\fR
+.fi
+.IP
+Specifies the width of the scrolled canvas widget in any of the forms
+acceptable to \fBTk_GetPixels\fR. The default height is 30 pixels.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBscrolledcanvas\fR command creates
+a scrolled canvas with additional options to manage
+horizontal and vertical scrollbars. This includes options to control
+which scrollbars are displayed and the method, i.e. statically or
+dynamically.
+
+.SH "METHODS"
+.PP
+The \fBscrolledcanvas\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for scrolledcanvas widgets:
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBaddtag\fR \fBbbox\fR \fBbind\fR \fBcanvasx\fR
+\fBcanvasy\fB \fBcoords\fR \fBcreate\fR \fBdchars\fR
+\fBdelete\fR \fBdtag\fR \fBfind\fR \fBfocus\fR
+\fBgettags\fR \fBicursor\fR \fBindex\fR \fBinsert\fR
+\fBitemconfigure\fR \fBlower\fR \fBmove\fR \fBpostscript\fR
+\fBraise\fR \fBscale\fR \fBscan\fR \fBselect\fR
+\fBtype\fR \fBxview\fR \fByview\fR
+.fi
+.LP
+See the "canvas" manual entry for details on the associated methods.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBscrolledcanvas\fR
+command.
+.TP
+\fIpathName \fBchildsite\fR
+Returns the child site widget path name.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBscrolledcanvas\fR
+command.
+.TP
+\fIpathName \fBjustify \fIdirection\fR
+Justifies the canvas contents via the scroll bars in one of four directions:
+\fBleft\fR, \fBright\fR, \fBtop\fR, or \fBbottom\fR.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBcanvas\fR
+Class: \fBCanvas\fR
+.fi
+.IP
+The canvas component is the canvas widget. See the "canvas" widget
+manual entry for details on the canvas component item.
+.LP
+.nf
+Name: \fBhorizsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The horizsb component is the horizontal scroll bar. See the "ScrollBar"
+widget manual entry for details on the horizsb component item.
+.LP
+.nf
+Name: \fBvertsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The vertsb component is the vertical scroll bar. See the "ScrollBar" widget
+manual entry for details on the vertsb component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ scrolledcanvas .sc
+
+ .sc create rectangle 100 100 400 400 -fill red
+ .sc create rectangle 300 300 600 600 -fill green
+ .sc create rectangle 200 200 500 500 -fill blue
+
+ pack .sc -padx 10 -pady 10 -fill both -expand yes
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.SH KEYWORDS
+scrolledcanvas, canvas, widget
diff --git a/itcl/iwidgets3.0.0/doc/scrolledframe.n b/itcl/iwidgets3.0.0/doc/scrolledframe.n
new file mode 100644
index 00000000000..990ad07842c
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/scrolledframe.n
@@ -0,0 +1,208 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) ScrolledListBox.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS scrolledframe iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+scrolledframe \- Create and manipulate scrolled frame widgets
+.SH SYNOPSIS
+\fBscrolledframe\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- Labeledwidget <-Scrolledwidget <- Scrolledframe
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBbackground\fR \fBborderWidth\fR \fBcursor\fR
+\fBfont\fR \fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR
+\fBrelief\fR \fBselectBackground\fR \fBselectBorderWidth\fR \fBselectForeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveRelief\fR \fBelementBorderWidth\fR \fBjump\fR \fBtroughColor\fR
+.fi
+.LP
+See the "scrollbar" manual entry for details on the associated options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBLabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR \fBlabelMargin\fR
+\fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR
+.fi
+.LP
+See the "labeledwidget" class manual entry for details on the inherited options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Command-Line Switch: \fB-height\fR
+.fi
+.IP
+Specifies the height of the scrolled frame widget in any of the forms acceptable to \fBTk_GetPixels\fR. The default height is 100 pixels.
+.LP
+.nf
+Name: \fBhscrollMode\fR
+Class: \fBScrollMode\fR
+Command-Line Switch: \fB-hscrollmode\fR
+.fi
+.IP
+Specifies the the display mode to be used for the horizontal
+scrollbar: \fBstatic\fR, \fBdynamic\fR, or \fBnone\fR. In static mode, the
+scroll bar is displayed at all times. Dynamic mode displays the
+scroll bar as required, and none disables the scroll bar display. The
+default is static.
+.LP
+.nf
+Name: \fBsbWidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-sbwidth\fR
+.fi
+.IP
+Specifies the width of the scrollbar in any of the forms acceptable
+to \fBTk_GetPixels\fR. The default width is 15 pixels.
+.LP
+.nf
+Name: \fBscrollMargin\fR
+Class: \fBMargin\fR
+Command-Line Switch: \fB-scrollmargin\fR
+.fi
+.IP
+Specifies the distance between the frame and scrollbar in any of the
+forms acceptable to \fBTk_GetPixels\fR. The default is 3 pixels.
+.LP
+.nf
+Name: \fBvscrollMode\fR
+Class: \fBScrollMode\fR
+Command-Line Switch: \fB-vscrollmode\fR
+.fi
+.IP
+Specifies the the display mode to be used for the vertical
+scrollbar: \fBstatic\fR, \fBdynamic\fR, or \fBnone\fR. In static mode, the
+scroll bar is displayed at all times. Dynamic mode displays the
+scroll bar as required, and none disables the scroll bar display. The
+default is static.
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-width\fR
+.fi
+.IP
+Specifies the width of the scrolled frame widget in any of the forms
+acceptable to \fBTk_GetPixels\fR. The default height is 100 pixels.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBscrolledframe\fR combines the functionallity of scrolling with that
+of a typical frame widget to implement a clipable viewing area whose visible
+region may be modified with the scroll bars. This enables the contruction
+of visually larger areas than which could normally be displayed, containing
+a heterogenous mix of other widgets. Options exist which allow full control
+over which scrollbars are displayed and the method, i.e. statically or
+dynamically. The frame itself may be accessed by the \fBchildsite\fR
+method and then filled with other widget combinations.
+
+.SH "METHODS"
+.PP
+The \fBscrolledframe\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for scrolledframe widgets:
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBxview\fR \fByview\fR
+.fi
+.LP
+See the "canvas" manual entry for details on the associated methods.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBscrolledframe\fR
+command.
+.TP
+\fIpathName \fBchildsite\fR
+Return the path name of the child site.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBscrolledframe\fR
+command.
+.TP
+\fIpathName \fBjustify \fIdirection\fR
+Justifies the frame contents via the scroll bars in one of four directions:
+\fBleft\fR, \fBright\fR, \fBtop\fR, or \fBbottom\fR.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBhorizsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The horizsb component is the horizontal scroll bar. See the "ScrollBar"
+widget manual entry for details on the horizsb component item.
+.LP
+.nf
+Name: \fBvertsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The vertsb component is the vertical scroll bar. See the "ScrollBar" widget
+manual entry for details on the vertsb component item.
+.fi
+
+.SH EXAMPLE
+.DS
+scrolledframe .sf -width 150 -height 180 -labelon yes -labeltext scrolledframe
+
+set cs [.sf childsite]
+pack [button $cs.b1 -text Hello] -pady 10
+pack [button $cs.b2 -text World] -pady 10
+pack [button $cs.b3 -text "This is a test"] -pady 10
+pack [button $cs.b4 -text "This is a really big button"] -pady 10
+pack [button $cs.b5 -text "This is another really big button"] -pady 10
+pack [button $cs.b6 -text "This is the last really big button"] -pady 10
+
+pack .sf -expand yes -fill both -padx 10 -pady 10
+.DE
+.SH AUTHOR
+.TP
+Mark L. Ulferts
+.TP
+Sue Yockey
+.SH KEYWORDS
+scrolledframe, frame, widget
diff --git a/itcl/iwidgets3.0.0/doc/scrolledhtml.n b/itcl/iwidgets3.0.0/doc/scrolledhtml.n
new file mode 100644
index 00000000000..2b12a0b8f7d
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/scrolledhtml.n
@@ -0,0 +1,304 @@
+'\"
+'\" Copyright (c) 1996 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) scrolledhtml.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS scrolledhtml iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+scrolledhtml \- Create and manipulate a scrolled text widget with the capability
+of displaying HTML formatted documents.
+.SH SYNOPSIS
+\fBscrolledhtml\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- Labeledwidget <- Scrolledtext <- Scrolledhtml
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBbackground\fR \fBborderWidth\fR \fBcursor\fR
+\fBexportSelection\fR \fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR
+\fBinsertBackground\fR \fBinsertBorderWidth\fR \fBinsertOffTime\fR \fBinsertOnTime\fR
+\fBinsertWidth\fR \fBpadX\fR \fBpadY\fR \fBrelief\fR
+\fBrepeatDelay\fR \fBrepeatInterval\fR \fBselectBackground\fR \fBselectBorderWidth\fR
+\fBselectForeground\fR \fBsetGrid\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveRelief\fR \fBelementBorderWidth\fR \fBjump\fR \fBtroughColor\fR
+.fi
+.LP
+See the "scrollbar" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBspacing1\fR \fBspacing2\fR \fBspacing3\fR \fBstate\fR
+\fBwrap\fR
+.fi
+.LP
+See the "text" widget manual entry for details on the above
+associated options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR \fBlabelMargin\fR
+\fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR \fBheight\fR
+\fBhscrollMode\fR \fBsbWidth\fR \fBscrollMargin\fR \fBvisibleitems\fR
+\fBvscrollMode\fR \fBwidth\fR
+.fi
+.LP
+See the "scrolledtext" class manual entry for details on the inherited options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBfeedback\fR
+Class: \fBFeedBack\fR
+Command-Line Switch: \fB-feedback\fR
+.fi
+.IP
+Specifies the callback command to use to give feedback on current
+status. The command is executed in the form \fIcommand\fR \fI<number of
+characters remaining>\fR
+.LP
+.nf
+Name: \fBfixedfont\fR
+Class: \fBFixedFont\fR
+Command-Line Switch: \fB-fixedfont\fR
+.fi
+.IP
+Specifies the name of the font to be used for fixed-width character
+text (such as <pre>...</pre> or <tt>...</tt>.) The size, style, and
+other font attributes are determined by the format tags in the
+document. The default is courier.
+.LP
+.nf
+Name: \fBfontname\fR
+Class: \fBFontName\fR
+Command-Line Switch: \fB-fontname\fR
+.fi
+.IP
+Specifies the name of the font to be used for normal-width character
+spaced text. The size, style, and other font attributes are
+determined by the format tags in the document. The default is times.
+.LP
+.nf
+Name: \fBfontsize\fR
+Class: \fBFontSize\fR
+Command-Line Switch: \fB-fontsize\fR
+.fi
+.IP
+Specifies the general size of the fonts used. One of small, medium,
+large, or huge. The default is medium.
+.LP
+.nf
+Name: \fBforeground\fR
+Class: \fBForeground\fR
+Command-Line Switch: \fB-foreground\fR
+.fi
+.IP
+Specifies the color of text other than hypertext links, in any
+of the forms acceptable to \fBTk_GetColor\fR. This value may
+be overridden in a particular document by the \fItext\fR attribute
+of the \fBBody\fR HTML tag.
+.LP
+.nf
+Name: \fBlink\fR
+Class: \fBLink\fR
+Command-Line Switch: \fB-link\fR
+.fi
+.IP
+Specifies the default color of hypertext links in any of the forms
+acceptable to \fBTk_GetColor\fR. This value may be overridden in a
+particular document by the \fIlink\fR attribute of the \fBBody\fR
+HTML tag. The default is blue.
+.LP
+.nf
+Name: \fBlinkcommand\fR
+Class: \fBLinkCommand\fR
+Command-Line Switch: \fB-linkcommand\fR
+.fi
+.IP
+Specifies the command to execute when the user clicks on a hypertext
+link. Execution is of the form \fBlinkcommand href\fR, where \fBhref\fR is
+the value given in the \fIhref\fR attribute of the \fBA\fR HTML tag.
+.LP
+.nf
+Name: \fBalink\fR
+Class: \fBalink\fR
+Command-Line Switch: \fB-alink\fR
+.fi
+.IP
+Specifies the color of hypertext links when the cursor is over the link
+in any of the forms acceptable to \fBTk_GetColor\fR. The default is red.
+.LP
+.nf
+Name: \fBtextBackground\fR
+Class: \fBBackground\fR
+Command-Line Switch: \fB-textbackground\fR
+.fi
+.IP
+Specifies the background color for the text area in any of
+the forms acceptable to \fBTk_GetColor\fR. This value may be
+overridden in a particular document by the \fIbgcolor\fR attribute
+of the \fBBody\fR HTML tag.
+.LP
+.nf
+Name: \fBunknownimage\fR
+Class: \fBUnknownImage\fR
+Command-Line Switch: \fB-unknownimage\fR
+.fi
+.IP
+Specifies the name of the image file to display when an \fBimg\fR
+specified in the html document cannot be loaded.
+.LP
+.nf
+Name: \fBupdate\fR
+Class: \fBUpdate\fR
+Command-Line Switch: \fB-alink\fR
+.fi
+.IP
+A boolean value indicating whether to call update during html rendering.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBscrolledhtml\fR command creates
+a scrolled text widget with the additional capability to display
+html formatted documents.
+An import method is provided to read an html document file, and
+a render method is provided to display a html formatted text string.
+
+.SH "METHODS"
+.PP
+The \fBscrolledhtml\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for scrolledhtml widgets:
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbbox\fR \fBcompare\fR \fBdebug\fR \fBdelete\fR
+\fBdlineinfo\fR \fBget\fR \fBindex\fR \fBinsert\fR
+\fBmark\fR \fBscan\fR \fBsearch\fR \fBsee\fR
+\fBtag\fR \fBwindow\fR \fBxview\fR \fByview\fR
+.fi
+.LP
+See the "text" manual entry for details on the standard methods.
+.SH "INHERITED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBexport\fR \fBclear\fR
+.fi
+.LP
+See the "scrolledhtml" manual entry for details on the inherited methods.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBscrolledhtml\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBscrolledhtml\fR
+command.
+.TP
+\fIpathName\fR \fBimport\fR ?\fIoption\fR? \fIhref\fR
+Load html formatted text from a file. \fIHref\fR must exist.
+If \fIoption\fR is -link, \fIhref\fR is assumed to be relative
+to the application's current working directory. Otherwise,
+\fIhref\fR is assumed to be relative to the path of the last
+page loaded. \fIHref\fR is either a filename, or a reference
+of the form \fIfilename\fR#\fIanchorname\fR. In the latter form,
+fIFilename\fR and/or \fIanchorname\fR may be empty.
+If \fIfilename\fR is empty, the current document is assumed.
+If \fIanchorname\fR is empty, the top of the document is assumed.
+.TP
+\fIpathName\fR \fBpwd\fR
+Print the current working directory of the widget, i.e. the directory of the
+last page loaded.
+.TP
+\fIpathName\fR \fBrender\fR \fIhtmltext\fR ?\fIwd\fR?
+Display HTML formatted text \fIhtmltext\fR. \fIWd\fR gives the base
+path to use for all links and images in the document. \fIWd\fR defaults
+to the application's current working directory.
+.TP
+\fIpathName\fR \fBtitle\fR
+Return the title of the current page, as given in the <title>...</title>
+field in the document.
+
+.SH "HTML COMPLIANCE"
+.LP
+This widget is compliant with HTML 3.2 with the following exceptions:
+.LP
+No features requiring a connection to an http server are supported.
+.LP
+Some image alignments aren't supported, because they are not supported by
+the text widget.
+.LP
+The <br> attributes dealing with image alignments aren't supported.
+.LP
+Automatic table sizing is not supported very well, due to limitations of the
+text widget
+.RE
+.SH EXAMPLE
+.DS
+ option add *textBackground white
+
+ scrolledhtml .sh -fontname helvetica -linkcommand "this import -link"
+
+ pack .sh -padx 10 -pady 10 -fill both -expand yes
+
+ .sh import ~/public_html/index.html
+.DE
+.SH BUGS
+.IP
+Cells in a table can be caused to overlap. ex:
+ <table border width="100%">
+ <tr><td>cell1</td><td align=right rowspan=2>cell2</td></tr>
+ <tr><td colspan=2>cell3 w/ overlap</td>
+ </table>
+It hasn't been fixed because 1) it's a pain to fix, 2) it will slow
+tables down by a significant amount, and 3) netscape has the same
+bug, as of V3.01.
+.SH ACKNOWLEDGEMENTS
+Sam Shen
+.IP
+This code is based largely on his tkhtml.tcl code from tk inspect. Tkhtml
+is copyright 1995 Lawrence Berkeley Laboratory.
+.LP
+.SH AUTHOR
+Kris Raney
+.SH KEYWORDS
+scrolledhtml, html, text, widget
diff --git a/itcl/iwidgets3.0.0/doc/scrolledlistbox.n b/itcl/iwidgets3.0.0/doc/scrolledlistbox.n
new file mode 100644
index 00000000000..24f44e0a798
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/scrolledlistbox.n
@@ -0,0 +1,354 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) scrolledlistbox.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS scrolledlistbox iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+scrolledlistbox \- Create and manipulate scrolled listbox widgets
+.SH SYNOPSIS
+\fBscrolledlistbox\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- Labeledwidget <- Scrolledwidget <- Scrolledlistbox
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBbackground\fR \fBborderWidth\fR \fBcursor\fR
+\fBexportSelection\fR \fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR
+\fBrelief\fR \fBselectBackground\fR \fBselectBorderWidth\fR \fBselectForeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBselectMode\fR
+.fi
+.LP
+See the "listbox" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveRelief\fR \fBelementBorderwidth\fR \fBjump\fR \fBtroughColor\fR
+.fi
+.LP
+See the "scrollbar" widget manual entry for details on the above
+associated options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBdisabledForeground\fR \fBlabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR
+\fBlabelMargin\fR \fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR
+\fBstate\fR
+.fi
+.LP
+See the "labeledwidget" class manual entry for details on the inherited
+options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBdblClickCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-dblclickcommand\fR
+.fi
+.IP
+Specifies a Tcl command procedure which is called when an item is
+double clicked. Typically this occurs when mouse button 1 is double
+clicked over an item. Selection policy does not matter.
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Command-Line Switch: \fB-height\fR
+.fi
+.IP
+Specifies the height of the scrolled list box as an entire unit.
+The value may be specified in any of the forms acceptable to
+\fBTk_GetPixels\fR. Any additional space needed to display the other
+components such as labels, margins, and scrollbars force the listbox
+to be compressed. A value of zero along with the same value for
+the width causes the value given for the visibleitems option
+to be applied which administers geometry constraints in a different
+manner. The default height is zero.
+.LP
+.nf
+Name: \fBhscrollMode\fR
+Class: \fBScrollMode\fR
+Command-Line Switch: \fB-hscrollmode\fR
+.fi
+.IP
+Specifies the the display mode to be used for the horizontal
+scrollbar: \fBstatic, dynamic,\fR or \fBnone\fR. In static mode, the
+scroll bar is displayed at all times. Dynamic mode displays the
+scroll bar as required, and none disables the scroll bar display. The
+default is static.
+.LP
+.nf
+Name: \fBsbWidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-sbwidth\fR
+.fi
+.IP
+Specifies the width of the scrollbar in any of the forms acceptable
+to \fBTk_GetPixels\fR. The default width is 15 pixels..
+.LP
+.nf
+Name: \fBscrollMargin\fR
+Class: \fBMargin\fR
+Command-Line Switch: \fB-scrollmargin\fR
+.fi
+.IP
+Specifies the distance between the listbox and scrollbar in any of the
+forms acceptable to \fBTk_GetPixels\fR. The default is 3 pixels.
+.LP
+.nf
+Name: \fBselectionCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-selectioncommand\fR
+.fi
+.IP
+Specifies a Tcl command procedure which is called when an item is
+selected. Selection policy does not matter.
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Command-Line Switch: \fB-state\fR
+.fi
+.IP
+Specifies one of two states for the listbox: \fBnormal\fR or \fBdisabled\fR.
+If the listbox is disabled then selection is ignored. The default is
+normal.
+.LP
+.nf
+Name: \fBtextBackground\fR
+Class: \fBBackground\fR
+Command-Line Switch \fB-textbackground\fR
+.fi
+.IP
+Specifies the background color for the listbox. This allows the background
+within the listbox to be different from the normal background color.
+.LP
+.nf
+Name: \fBtextFont\fR
+Class: \fBFont\fR
+Command-Line Switch: \fB-textfont\fR
+.fi
+.IP
+Specifies the font to be used for text in the listbox. This allows for
+the font associated with text internal to the scrolled listbox to be
+different than the font for labels.
+.LP
+.nf
+Name: \fBvisibleitems\fR
+Class: \fBVisibleItems\fR
+Command-Line Switch: \fB-visibleitems\fR
+.fi
+.IP
+Specifies the widthxheight in characters and lines for the listbox.
+This option is only administered if the width and height options
+are both set to zero, otherwise they take precedence. The default value
+is 20x10. With the visibleitems option engaged, geometry constraints
+are maintained only on the listbox. The size of the other components such as
+labels, margins, and scroll bars, are additive and independent,
+effecting the overall size of the scrolled list box. In contrast,
+should the width and height options have non zero values, they
+are applied to the scrolled list box as a whole. The listbox
+is compressed or expanded to maintain the geometry constraints.
+.LP
+.nf
+Name: \fBvscrollMode\fR
+Class: \fBScrollMode\fR
+Command-Line Switch: \fB-vscrollmode\fR
+.fi
+.IP
+Specifies the the display mode to be used for the vertical
+scrollbar: \fBstatic, dynamic,\fR or \fBnone\fR. In static mode, the
+scroll bar is displayed at all times. Dynamic mode displays the
+scroll bar as required, and none disables the scroll bar display. The
+default is static.
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-width\fR
+.fi
+.IP
+Specifies the width of the scrolled list box as an entire unit.
+The value may be specified in any of the forms acceptable to
+\fBTk_GetPixels\fR. Any additional space needed to display the other
+components such as labels, margins, and scrollbars force the listbox
+to be compressed. A value of zero along with the same value for
+the height causes the value given for the visibleitems option
+to be applied which administers geometry constraints in a different
+manner. The default width is zero.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBscrolledlistbox\fR command creates
+a scrolled listbox with additional options to manage
+horizontal and vertical scrollbars. This includes options to control
+which scrollbars are displayed and the method, i.e. statically or
+dynamically.
+
+.SH "METHODS"
+.PP
+The \fBscrolledlistbox\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command.
+.PP
+Many of the widget commands for a scrolledlistbox take as one argument an
+indicator of which entry of the list box to operate on. These
+indicators are called \fIindex\fRes and may be specified in
+any of the following forms:
+.TP 12
+\fInumber\fR
+Specifies the element as a numerical index, where 0 corresponds
+to the first element in the listbox.
+.TP 12
+\fBactive\fR
+Indicates the element that has the location cursor. This element
+will be displayed with an underline when the listbox has the
+keyboard focus, and it is specified with the \fBactivate\fR
+widget command.
+.TP 12
+\fBanchor\fR
+Indicates the anchor point for the selection, which is set with the
+\fBselection anchor\fR widget command.
+.TP 12
+\fBend\fR
+Indicates the end of the listbox.
+For some commands this means just after the last element;
+for other commands it means the last element.
+.TP 12
+\fB@\fIx\fB,\fIy\fR
+Indicates the element that covers the point in the listbox window
+specified by \fIx\fR and \fIy\fR (in pixel coordinates). If no
+element covers that point, then the closest element to that
+point is used.
+.TP 12
+\fIpattern\fR
+If the index doesn't satisfy one of the above forms then this
+form is used. \fIPattern\fR is pattern-matched against the items in
+the list box, in order from the top down, until a matching entry is found.
+The rules of \fBTcl_StringMatch\fR are used.
+.PP
+The following widget commands are possible for scrolledlistbox widgets:
+
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactivate\fR \fBbbox\fR \fBcurselection\fR \fBdelete\fR
+\fBget\fR \fBindex\fR \fBinsert\fR \fBnearest\fR
+\fBscan\fR \fBsee\fR \fBselection\fR \fBsize\fR
+\fBxview\fR \fByview\fR
+.fi
+.LP
+See the "listbox" manual entry for details on the associated methods.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBscrolledlistbox\fR
+command.
+.TP
+\fIpathName \fBclear\fR
+Clears the listbox of all items.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBscrolledlistbox\fR
+command.
+.TP
+\fIpathName \fBgetcurselection\fR
+Returns the contents of the listbox element indicated by the current
+selection indexes. Short cut version of get and curselection command
+combination.
+.TP
+\fIpathName \fBjustify \fIdirection\fR
+Justifies the list contents via teh scroll bars in one of four directions:
+\fBleft\fR, \fBright\fR, \fBtop\fR, or \fBbottom\fR.
+.TP
+\fIpathName \fBselecteditemcount\fR
+Returns the number of items currently selected in the list.
+.TP
+\fIpathName \fBsort\fR \fIorder\fR
+Sort the current list in either \fBascending\fR or \fBdescending\fR order.
+The values \fBincreasing\fR and \fBdecreasing\fR are also accepted.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBlistbox\fR
+Class: \fBlistbox\fR
+.fi
+.IP
+The listbox component is the listbox widget. See the "listbox" widget
+manual entry for details on the listbox component item.
+.LP
+.nf
+Name: \fBhorizsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The horizsb component is the horizontal scroll bar. See the "scrollbar"
+widget manual entry for details on the horizsb component item.
+.LP
+.nf
+Name: \fBvertsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The vertsb component is the vertical scroll bar. See the "scrollbar" widget
+manual entry for details on the vertsb component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ option add *textBackground white
+ proc selCmd {} {
+ puts stdout "[.slb getcurselection]"
+ }
+ proc defCmd {} {
+ puts stdout "Double Click"
+ return [selCmd]
+ }
+ scrolledlistbox .slb -selection single \\
+ -vscrollmode static -hscrollmode dynamic -labeltext "List" \\
+ -selectioncommand selCmd -dblclickcommand defCmd
+ pack .slb -padx 10 -pady 10 -fill both -expand yes
+ .slb insert end {Hello {Out There} World}
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.SH KEYWORDS
+scrolledlistbox, listbox, widget
diff --git a/itcl/iwidgets3.0.0/doc/scrolledtext.n b/itcl/iwidgets3.0.0/doc/scrolledtext.n
new file mode 100644
index 00000000000..12292363117
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/scrolledtext.n
@@ -0,0 +1,279 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) scrolledtext.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS scrolledtext iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+scrolledtext \- Create and manipulate a scrolled text widget
+.SH SYNOPSIS
+\fBscrolledtext\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- Labeledwidget <- Scrolledwidget <- Scrolledtext
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBbackground\fR \fBborderWidth\fR \fBcursor\fR
+\fBexportSelection\fR \fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR
+\fBinsertBackground\fR \fBinsertBorderWidth\fR \fBinsertOffTime\fR \fBinsertOnTime\fR
+\fBinsertWidth\fR \fBpadX\fR \fBpadY\fR \fBrelief\fR
+\fBselectBackground\fR \fBselectBorderWidth\fR \fBselectForeground\fR \fBsetGrid\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveRelief\fR \fBelementBorderWidth\fR \fBjump\fR \fBtroughColor\fR
+.fi
+.LP
+See the "scrollbar" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBspacing1\fR \fBspacing2\fR \fBspacing3\fR \fBstate\fR
+\fBwrap\fR
+.fi
+.LP
+See the "text" widget manual entry for details on the above
+associated options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBdisabledForeground\fR \fBlabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR
+\fBlabelMargin\fR \fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR
+\fBstate\fR
+.fi
+.LP
+See the "labeledwidget" class manual entry for details on the inherited options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Command-Line Switch: \fB-height\fR
+.fi
+.IP
+Specifies the height of the scrolled text as an entire unit.
+The value may be specified in any of the forms acceptable to
+\fBTk_GetPixels\fR. Any additional space needed to display the other
+components such as labels, margins, and scrollbars force the text
+to be compressed. A value of zero along with the same value for
+the width causes the value given for the visibleitems option
+to be applied which administers geometry constraints in a different
+manner. The default height is zero.
+.LP
+.nf
+Name: \fBhscrollMode\fR
+Class: \fBScrollMode\fR
+Command-Line Switch: \fB-hscrollmode\fR
+.fi
+.IP
+Specifies the the display mode to be used for the horizontal
+scrollbar: \fBstatic, dynamic,\fR or \fBnone\fR. In static mode, the
+scroll bar is displayed at all times. Dynamic mode displays the
+scroll bar as required, and none disables the scroll bar display. The
+default is static.
+.LP
+.nf
+Name: \fBsbWidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-sbwidth\fR
+.fi
+.IP
+Specifies the width of the scrollbar in any of the forms
+acceptable to \fBTk_GetPixels\fR.
+.LP
+.nf
+Name: \fBscrollMargin\fR
+Class: \fBMargin\fR
+Command-Line Switch: \fB-scrollmargin\fR
+.fi
+.IP
+Specifies the distance between the text area and scrollbar in any of the forms
+acceptable to \fBTk_GetPixels\fR. The default is 3 pixels.
+.LP
+.nf
+Name: \fBtextBackground\fR
+Class: \fBBackground\fR
+Command-Line Switch: \fB-textbackground\fR
+.fi
+.IP
+Specifies the background color for the text area in any of the forms
+acceptable to \fBTk_GetColor\fR.
+.LP
+.nf
+Name: \fBtextFont\fR
+Class: \fBFont\fR
+Command-Line Switch: \fB-textfont\fR
+.fi
+.IP
+Specifies the font to be used in the scrolled text area.
+.LP
+.nf
+Name: \fBvisibleitems\fR
+Class: \fBVisibleItems\fR
+Command-Line Switch: \fB-visibleitems\fR
+.fi
+.IP
+Specifies the widthxheight in characters and lines for the text.
+This option is only administered if the width and height options
+are both set to zero, otherwise they take precedence. The default value
+is 80x24. With the visibleitems option engaged, geometry constraints
+are maintained only on the text. The size of the other components such as
+labels, margins, and scroll bars, are additive and independent,
+effecting the overall size of the scrolled text. In contrast,
+should the width and height options have non zero values, they
+are applied to the scrolled text as a whole. The text
+is compressed or expanded to maintain the geometry constraints.
+.LP
+.nf
+Name: \fBvscrollMode\fR
+Class: \fBScrollMode\fR
+Command-Line Switch: \fB-vscrollmode\fR
+.fi
+.IP
+Specifies the the display mode to be used for the vertical
+scrollbar: \fBstatic, dynamic,\fR or \fBnone\fR. In static mode, the
+scroll bar is displayed at all times. Dynamic mode displays the
+scroll bar as required, and none disables the scroll bar display. The
+default is static.
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-width\fR
+.fi
+.IP
+Specifies the width of the scrolled text as an entire unit.
+The value may be specified in any of the forms acceptable to
+\fBTk_GetPixels\fR. Any additional space needed to display the other
+components such as labels, margins, and scrollbars force the text
+to be compressed. A value of zero along with the same value for
+the height causes the value given for the visibleitems option
+to be applied which administers geometry constraints in a different
+manner. The default width is zero.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBscrolledtext\fR command creates
+a scrolled text widget with additional options to manage
+the scrollbars. This includes options to control the method
+in which the scrollbars are displayed, i.e. statically or dynamically.
+Options also exist for adding a label to the scrolled text area and
+controlling its position. Import/export of methods are provided for
+file I/O.
+
+.SH "METHODS"
+.PP
+The \fBscrolledtext\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for scrolledtext widgets:
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbbox\fR \fBcompare\fR \fBdebug\fR \fBdelete\fR
+\fBdlineinfo\fR \fBget\fR \fBindex\fR \fBinsert\fR
+\fBmark\fR \fBscan\fR \fBsearch\fR \fBsee\fR
+\fBtag\fR \fBwindow\fR \fBxview\fR \fByview\fR
+.fi
+.LP
+See the "text" manual entry for details on the standard methods.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBscrolledtext\fR
+command.
+.TP
+\fIpathName \fBchildsite\fR
+Returns the child site widget path name.
+.TP
+\fIpathName \fBclear\fR
+Clear the text area of all characters.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBscrolledtext\fR
+command.
+.TP
+\fIpathName \fBimport\fR \fIfilename\fR ?\fIindex\fR?
+Load the text from a file into the text area at the \fIindex\fR. The
+\fIfilename\fR must exist.
+.TP
+\fIpathName \fBexport\fR \fIfilename\fR
+Write text to a file. If \fIfilename\fR exists then contents are
+replaced with text widget contents.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBtext\fR
+Class: \fBText\fR
+.fi
+.IP
+The text component is the text widget. See the "text" widget
+manual entry for details on the text component item.
+.LP
+.nf
+Name: \fBhorizsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The horizsb component is the horizontal scroll bar. See the "scrollbar"
+widget manual entry for details on the horizsb component item.
+.LP
+.nf
+Name: \fBvertsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The vertsb component is the vertical scroll bar. See the "scrollbar" widget
+manual entry for details on the vertsb component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ option add *textBackground white
+
+ scrolledtext .st -scrollmode dynamic -labeltext "Password File"
+
+ pack .st -padx 10 -pady 10 -fill both -expand yes
+
+ .st import /etc/passwd
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.SH KEYWORDS
+scrolledtext, text, widget
diff --git a/itcl/iwidgets3.0.0/doc/selectionbox.n b/itcl/iwidgets3.0.0/doc/selectionbox.n
new file mode 100644
index 00000000000..cc87ede60a7
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/selectionbox.n
@@ -0,0 +1,300 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) selectionbox.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS selectionbox iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+selectionbox \- Create and manipulate a selection box widget
+.SH SYNOPSIS
+\fBselectionbox\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- selectionbox
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBbackground\fR \fBborderWidth\fR \fBcursor\fR
+\fBexportSelection\fR \fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR
+\fBinsertBackground\fR \fBinsertBorderWidth\fR \fBinsertOffTime\fR \fBinsertOnTime\fR
+\fBinsertWidth\fR \fBrelief\fR \fBrepeatDelay\fR \fBrepeatInterval\fR
+\fBselectBackground\fR \fBselectBorderWidth\fR \fBselectForeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtextBackground\fR \fBtextFont\fR
+.fi
+.LP
+See the "entryfield" widget class manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelFont\fR \fBlabelMargin\fR
+.fi
+.LP
+See the "labeledwidget" class manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveRelief\fR \fBelementBorderWidth\fR \fBjump\fR \fBtroughColor\fR
+.fi
+.LP
+See the "scrollbar" widget class manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBdblClickCommand\fR \fBhscrollMode\fR \fBsbWidth\fR \fBscrollMargin\fR
+\fBtextBackground\fR \fBtextFont\fR \fBvscrollMode\fR
+.fi
+.LP
+See the "scrolledlistbox" widget class manual entry for details on the above
+associated options.
+
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBchildSitePos\fR
+Class: \fBPosition\fR
+Command-Line Switch: \fB-childsitepos\fR
+.fi
+.IP
+Specifies the position of the child site in the selection box: \fBn\fR,
+\fBs\fR, \fBe\fR, \fBw\fR, or \fB\fR. The default is center
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Command-Line Switch: \fB-height\fR
+.fi
+.IP
+Specifies the height of the selection box. The value may be specified in
+any of the forms acceptable to Tk_GetPixels. The default is 320 pixels.
+.LP
+.nf
+Name: \fBitemsCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-itemscommand\fR
+.fi
+.IP
+Specifies a command to be evaluated following selection of an item.
+.LP
+.nf
+Name: \fBitemsLabel\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-itemslabel\fR
+.fi
+.IP
+Specifies the text of the label for the items list. The default is "List".
+.LP
+.nf
+Name: \fBitemsLabelPos\fR
+Class: \fBPosition\fR
+Command-Line Switch: \fB-itemslabelpos\fR
+.fi
+.IP
+Specifies the position of the label along the side of the items
+list: \fBn\fR, \fBne\fR, \fBe\fR, \fBse\fR, \fBs\fR, \fBsw\fR, \fBw\fR,
+or \fBnw\fR. The default is nw.
+.LP
+.nf
+Name: \fBitemsOn\fR
+Class: \fBItemsOn\fR
+Command-Line Switch: \fB-itemson\fR
+.fi
+.IP
+Specifies whether or not to display the items list in any
+of the forms acceptable to \fBTcl_GetBoolean\fR. The default is true.
+.LP
+.nf
+Name: \fBmargin\fR
+Class: \fBMargin\fR
+Command-Line Switch: \fB-margin\fR
+.fi
+.IP
+Specifies distance between the items list and selection entry in any of
+the forms acceptable to \fBTk_GetPixels\fR. The default is 7 pixels.
+.LP
+.nf
+Name: \fBselectionCommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-selectioncommand\fR
+.fi
+.IP
+Specifies a Tcl procedure to be associated with a return key press event
+in the selection entry field.
+.LP
+.nf
+Name: \fBselectionLabel\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-selectionlabel\fR
+.fi
+.IP
+Specifies the text of the label for the selection entry field. The default
+is "Selection".
+.LP
+.nf
+Name: \fBselectionLabelPos\fR
+Class: \fBPosition\fR
+Command-Line Switch: \fB-selectionlabelpos\fR
+.fi
+.IP
+Specifies the position of the label along the side of the selection:
+\fBn\fR, \fBne\fR, \fBe\fR, \fBse\fR, \fBs\fR, \fBsw\fR, \fBw\fR,
+or \fBnw\fR. The default is nw.
+.LP
+.nf
+Name: \fBselectionOn\fR
+Class: \fBSelectionOn\fR
+Command-Line Switch: \fB-selectionon\fR
+.fi
+.IP
+Specifies whether or not to display the selection entry in any
+of the forms acceptable to \fBTcl_GetBoolean\fR. The default is true.
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-width\fR
+.fi
+.IP
+Specifies the width of the selection box. The value may be specified in
+any of the forms acceptable to Tk_GetPixels. The default is 260 pixels.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBselectionbox\fR command creates a scrolled list of items and
+a selection entry field. The user may choose any of the items displayed
+in the scrolled list of alternatives and the selection field will be
+filled with the choice. The user is also free to enter a new value in
+the selection entry field. Both the list and entry areas have labels.
+A child site is also provided in which the user may create other widgets
+to be used in conjunction with the selection box.
+
+.SH "METHODS"
+.PP
+The \fBselectionbox\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command.
+
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBcurselection\fR \fBdelete\fR \fBindex\fR \fBnearest\fR
+\fBscan\fR \fBselection\fR \fBsize\fR
+.fi
+.LP
+See the "listbox" widget class manual entry for details on the
+associated methods.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBselectionbox\fR
+command.
+.TP
+\fIpathName \fBchildsite\fR
+Returns the child site widget path name.
+.TP
+\fIpathName \fBclear\fR \fIcomponent\fR
+Delete the contents of either the selection entry widget or
+items list. The \fIcomponent\fR argument may be either \fBitems\fR
+or \fBselection\fR.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBselectionbox\fR
+command.
+.TP
+\fIpathName \fBget\fR
+Returns the current value of the selection entry widget.
+.TP
+\fIpathName \fBinsert\fR \fIcomponent\fR \fIargs\fR
+Insert element(s) into either the selection entry widget or
+items list. The \fIcomponent\fR argument may be either \fBitems\fR
+or \fBselection\fR. The \fIargs\fR follow the rules of either an entry
+or list widget depending on the \fIcomponent\fR value.
+.TP
+\fIpathName \fBselectitem\fR
+Replace the selection entry field contents with the currently
+selected items value.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBchildsite\fR
+Class: \fBFrame\fR
+.fi
+.IP
+The childsite component is the user child site for the selection box. See
+the "frame" widget manual entry for details on the childsite component item.
+.LP
+.nf
+Name: \fBitems\fR
+Class: \fBScrolledlistbox\fR
+.fi
+.IP
+The items component provides the scrolled list box of items for the selection
+box. See the "scrolledlistbox" widget manual entry for details on the
+items component item.
+.LP
+.nf
+Name: \fBselection\fR
+Class: \fBEntryfield\fR
+.fi
+.IP
+The selection component provides the entry field in the selection box for
+display of the selected item in the items component. See the "entryfield"
+widget manual entry for details on the selection component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ option add *textBackground white
+
+ selectionbox .sb -items {Hello {Out There} World}
+ pack .sb -padx 10 -pady 10 -fill both -expand yes
+
+ set cs [label [.sb childsite].label -text "Child Site"]
+ pack $cs -fill x -padx 10 -pady 10
+
+ .sb insert items 2 {Cruel Cruel}
+
+ .sb selection set 1
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.SH KEYWORDS
+selectionbox, widget
diff --git a/itcl/iwidgets3.0.0/doc/selectiondialog.n b/itcl/iwidgets3.0.0/doc/selectiondialog.n
new file mode 100644
index 00000000000..41fb3630d1c
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/selectiondialog.n
@@ -0,0 +1,197 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) selectiondialog.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS selectiondialog iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+selectiondialog \- Create and manipulate a selection dialog widget
+.SH SYNOPSIS
+\fBselectiondialog\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Toplevel <- Shell <- Dialogshell <- Dialog <- Selectiondialog
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBbackground\fR \fBborderWidth\fR \fBcursor\fR
+\fBexportSelection\fR \fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR
+\fBinsertBackground\fR \fBinsertBorderWidth\fR \fBinsertOffTime\fR \fBinsertOnTime\fR
+\fBinsertWidth\fR \fBselectBackground\fR \fBselectBorderWidth\fR \fBselectForeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtextBackground\fR \fBtextFont\fR
+.fi
+.LP
+See the "entryfield" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelFont\fR
+.fi
+.LP
+See the "labeledwidget" widget manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveRelief\fR \fBelementBorderWidth\fR \fBjump\fR \fBtroughColor\fR
+.fi
+.LP
+See the "scrollbar" widget class manual entry for details on the above
+associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtextBackground\fR \fBtextFont\fR
+.fi
+.LP
+See the "scrolledlistbox" widget class manual entry for details on the above
+associated options.
+\fBchildsitepos\fR \fBitemsCommand\fR \fBitemsLabel\fR \fBitemsOn\fR
+\fBselectionCommand\fR \fBselectionLabel\fR \fBselectionOn\fR
+.fi
+.LP
+See the "selectionbox" widget manual entry for details on the above
+associated options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbuttonBoxPadX\fR \fBbuttonBoxPadY\fR \fBbuttonBoxPos\fR \fBpadX\fR
+\fBpadY\fR \fBseparator\fR \fBthickness\fR
+.fi
+.LP
+See the "dialogshell" widget manual entry for details on the above
+inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBheight\fR \fBmaster\fR \fBmodality\fR \fBwidth\fR
+.fi
+.LP
+See the "shell" widget manual entry for details on the above
+inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtitle\fR
+.fi
+.LP
+See the "Toplevel" widget manual entry for details on the above
+inherited options.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBselectiondialog\fR command creates a selection box similar to
+the OSF/Motif standard selection
+dialog composite widget. The selectiondialog is derived from the
+Dialog class and is composed of a selectionbox with commands
+to manipulate the dialog buttons.
+
+.SH "METHODS"
+.PP
+The \fBselectiondialog\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for selectiondialog widgets:
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBchildsite\fR \fBclear\fR \fBget\fR \fBinsert\fR
+\fBselectitem\fR
+.fi
+.LP
+See the "selectionbox" widget manual entry for details on the above
+associated methods.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBcurselection\fR \fBdelete\fR \fBindex\fR \fBnearest\fR
+\fBscan\fR \fBselection\fR \fBsize\fR
+.fi
+.LP
+See the "listbox" widget manual entry for details on the above
+associated methods.
+.SH "INHERITED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBadd\fR \fBbuttonconfigure\fR \fBdefault\fR \fBhide\fR
+\fBinvoke\fR \fBshow\fR
+.fi
+.LP
+See the "buttonbox" widget manual entry for details on the above
+inherited methods.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactivate\fR \fBcenter\fR \fBdeactivate\fR
+.fi
+.LP
+See the "shell" widget manual entry for details on the above
+inherited methods.
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBselectiondialog\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBselectiondialog\fR
+command.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBselectionbox\fR
+Class: \fBSelectionbox\fR
+.fi
+.IP
+The selectionbox component is the selection box for the selection
+dialog. See the "selectionbox" widget manual entry for details on the
+selectionbox component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ selectiondialog .sd
+ .sd activate
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.SH KEYWORDS
+selectiondialog, selectionbox, dialog, dialogshell, shell, widget
+
diff --git a/itcl/iwidgets3.0.0/doc/shell.n b/itcl/iwidgets3.0.0/doc/shell.n
new file mode 100644
index 00000000000..5498a7bdafb
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/shell.n
@@ -0,0 +1,196 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) shell.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS shell iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+shell \- Create and manipulate a shell widget
+.SH SYNOPSIS
+\fBshell\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Toplevel <- shell
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBcursor\fR \fBforeground\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtitle\fR
+.fi
+.LP
+See the "Toplevel" manual entry for details on the above inherited options.
+
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Command-Line Switch: \fB-height\fR
+.fi
+.IP
+Specifies the height of the shell. The value may be specified in
+any of the forms acceptable to \fBTk_GetPixels\fR. A value of zero
+causes the height to be adjusted to the required value based on
+the size requests of the components placed in the childsite.
+Otherwise, the height is fixed. The default is zero. NOTE: This
+may cause some amount of flickering on slower machines. To prevent it
+simply set the width and height to a appropriate value.
+.LP
+.nf
+Name: \fBmaster\fR
+Class: \fBWindow\fR
+Command-Line Switch: \fB-master\fR
+.fi
+.IP
+Defines the shell as being a transient window with the master window
+given by the master option. The master window should be either another
+existing toplevel window or {} for no master. The default is {} for
+shells and "." for dialogs.
+.LP
+.nf
+Name: \fBmodality\fR
+Class: \fBModality\fR
+Command-Line Switch: \fB-modality\fR
+.fi
+.IP
+Allows the shell to grab control of the screen in one of three different ways:
+\fBapplication\fR, \fBsystem\fR, or \fBnone\fR.
+Application modal prevents any other toplevel windows within the application
+which are direct children of '.' from gaining focus. System modal locks
+the screen and prevents all windows from gaining focus regardless of
+application. A modality of none performs no grabs at all. The default
+is none.
+.LP
+.nf
+Name: \fBpadX\fR
+Class: \fBPad\fR
+Command-Line Switch: \fB-padx\fR
+.fi
+.IP
+Specifies a padding distance for the childsite in the X-direction in
+any of the forms acceptable to \fBTk_GetPixels\fR. The default is 10.
+.LP
+.nf
+Name: \fBpadY\fR
+Class: \fBPad\fR
+Command-Line Switch: \fB-pady\fR
+.fi
+.IP
+Specifies a padding distance for the childsite in the Y-direction in
+any of the forms acceptable to \fBTk_GetPixels\fR. The default is 10.
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-width\fR
+.fi
+.IP
+Specifies the width of the shell. The value may be specified in
+any of the forms acceptable to \fBTk_GetPixels\fR. A value of zero
+causes the width to be adjusted to the required value based on
+the size requests of the components placed in the childsite.
+Otherwise, the width is fixed. The default is zero. NOTE: This
+may cause some amount of flickering on slower machines. To prevent it
+simply set the width and height to a appropriate value.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBshell\fR command creates a shell which is a top
+level widget which supports modal operation.
+
+.SH "METHODS"
+.PP
+The \fBshell\fR command create a new Tcl command whose
+name is \fIpathName\fR. This command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for shell widgets:
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBactivate\fR
+Display the shell and wait based on the modality. For application
+and system modal activations, perform a grab operation, and wait
+for the result. The result may be returned via an argument to the
+\fBdeactivate\fR method.
+.TP
+\fIpathName \fBcenter\fR \fI?widget?\fR
+Centers the shell with respect to another widget. The widget argument
+is optional. If provided, it should be the path of another widget with
+to center upon. If absent, then the shell will be centered on the screen
+as a whole.
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBshell\fR
+command.
+.TP
+\fIpathName \fBchildsite\fR
+Returns the pathname of the child site widget.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBshell\fR
+command.
+.TP
+\fIpathName \fBdeactivate\fR ?\fIarg\fR?
+Deactivate the display of the shell. The method takes an optional
+argument to be passed to the \fBactivate\fR method which returns the value.
+The optional argument is only effective for application and system
+modal dialogs.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBshellchildsite\fR
+Class: \fBframe\fR
+.fi
+.IP
+The shellchildsite component is the user child site for the shell. See
+the "frame" widget manual entry for details on the shellchildsite
+component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ shell .sh -modality application -padx 20 -pady 20 -title Shell
+
+ pack [label [.sh childsite].l -text SHELL]
+
+ .sh center
+ .sh activate
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.DE
+Kris Raney
+.LP
+.SH KEYWORDS
+shell, widget
diff --git a/itcl/iwidgets3.0.0/doc/spindate.n b/itcl/iwidgets3.0.0/doc/spindate.n
new file mode 100644
index 00000000000..a87b0eed4a4
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/spindate.n
@@ -0,0 +1,274 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) spindate.n
+'\"
+.so man.macros
+.HS spindate iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+spindate \- Create and manipulate time spinner widgets
+.SH SYNOPSIS
+\fBspindate\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- Spindate
+
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBcursor\fR \fBforeground\fR \fBrelief\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtextBackground\fR \fBtextFont\fR
+.fi
+.LP
+See the "entryfield" manual entry for details on the above associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelFont\fR \fBlabelMargin\fR
+.fi
+.LP
+See the "labeledwidget" manual entry for details on the above associated
+options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBarrowOrient\fR \fBrepeatDelay\fR \fBrepeatInterval\fR
+.fi
+.LP
+See the "spinner" manual entry for details on the above associated options.
+
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBdateMargin\fR
+Class: \fBMargin\fR
+Command-Line Switch: \fB-datemargin\fR
+.fi
+.IP
+Specifies the margin space between the month, day, and year spinners is
+any of the forms accpetable to \fBTcl_GetPixels\fR. The default is 1 pixel.
+.LP
+.nf
+Name: \fBdayLabel\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-daylabel\fR
+.fi
+.IP
+Specifies the text of the label for the day spinner. The default is
+"Day".
+.LP
+.nf
+Name: \fBdayOn\fR
+Class: \fBdayOn\fR
+Command-Line Switch: \fB-dayon\fR
+.fi
+.IP
+Specifies whether or not to display the day spinner in any of the forms
+acceptable to \fBTcl_GetBoolean\fR. The default is true.
+.LP
+.nf
+Name: \fBdayWidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-daywidth\fR
+.fi
+.IP
+Specifies the width of the day spinner in any of the forms acceptable to
+\fBTcl_GetPixels\fR. The default is 3 pixels.
+.LP
+.nf
+Name: \fBlabelPos\fR
+Class: \fBPosition\fR
+Command-Line Switch: \fB-labelpos\fR
+.fi
+.IP
+Specifies the position of the label along the sides of the various
+spinners: \fBn\fR, \fBe\fR, \fBs\fR, or \fBw\fR. The default is w.
+.LP
+.nf
+Name: \fBmonthFormat\fR
+Class: \fBMonthFormat\fR
+Command-Line Switch: \fB-monthformat\fR
+.fi
+.IP
+Specifies the format of month display, \fBinteger\fR (1-12) or \fBbrief\fR
+strings (Jan - Dec), or \fBfull\fR strings (January - December).
+.LP
+.nf
+Name: \fBmonthLabel\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-monthlabel\fR
+.fi
+.IP
+Specifies the text of the label for the month spinner. The default is "Month".
+.LP
+.nf
+Name: \fBmonthOn\fR
+Class: \fBmonthOn\fR
+Command-Line Switch: \fB-monthon\fR
+.fi
+.IP
+Specifies whether or not to display the month spinner in any of the forms
+acceptable to \fBTcl_GetBoolean\fR. The default is true.
+.LP
+.nf
+Name: \fBmonthWidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-monthwidth\fR
+.fi
+.IP
+Specifies the width of the month spinner in any of the forms acceptable to
+\fBTcl_GetPixels\fR. The default is 3 pixels.
+.LP
+.nf
+Name: \fBorient\fR
+Class: \fBOrient\fR
+Command-Line Switch: \fB-orient\fR
+.fi
+.IP
+Specifies the orientation of the month, day, and year spinners: \fBvertical\fR or \fBhorizontal\fR. The default is horizontal.
+.LP
+.nf
+Name: \fByearDigits\fR
+Class: \fBYearDigits\fR
+Command-Line Switch: \fB-yeardigits\fR
+.fi
+.IP
+Specifies the number of digits to be displayed as the value for the year
+spinner. The valid values are 2 and 4. The default is 2.
+.LP
+.nf
+Name: \fByearLabel\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-yearlabel\fR
+.fi
+.IP
+Specifies the text of the label for the year spinner. The default is
+"Year"
+.LP
+.nf
+Name: \fByearOn\fR
+Class: \fByearOn\fR
+Command-Line Switch: \fB-yearon\fR
+.fi
+.IP
+Specifies whether or not to display the year spinner in any of the forms
+acceptable to \fBTcl_GetBoolean\fR. The default is true.
+.LP
+.nf
+Name: \fByearWidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-yearwidth\fR
+.fi
+.IP
+Specifies the width of the year spinner in any of the forms acceptable to
+\fBTcl_GetPixels\fR. The default is 3 pixels.
+.LP
+.nf
+.BE
+
+.SH DESCRIPTION
+.PP
+
+The \fBspindate\fR command creates a set of spinners for use in date value
+entry. The set includes an month, day, and year spinner widget.
+
+.SH "METHODS"
+.PP
+The \fBspindate\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for spindate widgets:
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBspindate\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBspindate\fR
+command.
+.TP
+\fIpathName \fBget\fR ?\fBformat\fR?
+Returns the current contents of the spindate widget in a format of
+string or as an integer clock value using the \fB-string\fR and \fB-clicks\fR
+format options respectively. The default is by string. Reference the
+clock command for more information on obtaining dates and their
+formats.
+.TP
+\fIpathName \fBshow\fR \fIdate\fR
+Changes the currently displayed date to be that of the date
+argument. The date may be specified either as a string, an
+integer clock value or the keyword "now". Reference the clock
+command for more information on obtaining dates and their formats.
+
+.ta 4c
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBmonth\fR
+Class: \fBSpinner\fR
+.fi
+.IP
+The month spinner component is the month spinner of the date spinner.
+See the Spinner widget manual entry for details on the month component item.
+.LP
+.nf
+Name: \fBday\fR
+Class: \fBSpinint\fR
+.fi
+.IP
+The day spinner component is the day spinner of the date spinner.
+See the SpinInt widget manual entry for details on the day component item.
+.LP
+.nf
+Name: \fByear\fR
+Class: \fBSpinint\fR
+.fi
+.IP
+The year spinner component is the year spinner of the date spinner.
+See the SpinInt widget manual entry for details on the year component item.
+.fi
+
+.SH EXAMPLE
+.DS
+spindate .sd
+pack .sd -padx 10 -pady 10
+.DE
+.SH AUTHOR
+Sue Yockey
+.DE
+Mark L. Ulferts
+.SH KEYWORDS
+spindate, spinint, spinner, entryfield, entry, widget
+
diff --git a/itcl/iwidgets3.0.0/doc/spinint.n b/itcl/iwidgets3.0.0/doc/spinint.n
new file mode 100644
index 00000000000..cc2b03dea02
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/spinint.n
@@ -0,0 +1,183 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) spinint.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS spinint iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+spinint \- Create and manipulate a integer spinner widget
+.SH SYNOPSIS
+\fBspinint\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- Labeledwidget <- Spinner <- Spinint
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBborderWidth\fR \fBcursor\fR \fBexportSelection\fR
+\fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR \fBinsertBackground\fR
+\fBinsertBorderWidth\fR \fBinsertOffTime\fR \fBinsertOnTime\fR \fBinsertWidth\fR
+\fBjustify\fR \fBrelief\fR \fBselectBackground\fR \fBselectBorderWidth\fR
+\fBselectForeground\fR \fBtextVariable\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBshow\fR \fBstate\fR
+.fi
+.LP
+See the "entry" manual entry for details on the associated options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBcommand\fR \fBchildSitePos\fR \fBfixed\fR \fBfocusCommand\fR
+\fBinvalid\fR \fBtextBackground\fR \fBtextFont\fR \fBvalidate\fR
+\fBwidth\fR
+.fi
+.LP
+See the "entryfield" widget manual entry for details on the above
+inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBdisabledForeground\fR \fBlabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR
+\fBlabelMargin\fR \fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR
+\fBstate\fR
+.fi
+.LP
+See the "labeledwidget" widget manual entry for details on the above
+inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBarroworient\fR \fBdecrement\fR \fBincrement\fR \fBrepeatDelay\fR
+\fBrepeatInterval\fR
+.fi
+.LP
+See the "spinner" widget manual entry for details on the above
+inherited options.
+
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBrange\fR
+Class: \fBRange\fR
+Command-Line Switch: \fB-range\fR
+.fi
+.IP
+Specifies a two element list of minimum and maximum integer values. The
+default is no range, {{} {}}.
+.LP
+.nf
+Name: \fBstep\fR
+Class: \fBStep\fR
+Command-Line Switch: \fB-step\fR
+.fi
+.IP
+Specifies the increment/decrement value. The default is 1.
+.LP
+.nf
+Name: \fBwrap\fR
+Class: \fBWrap\fR
+Command-Line Switch: \fB-wrap\fR
+.fi
+.IP
+Specifies whether to wrap the spinner value upon reaching the minimum
+or maximum value in any of the forms acceptable to \fBTcl_GetBoolean\fR.
+The default is true.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBspinint\fR command creates a spinint widget. The spinint allows
+"spinning" of integer values within a specified range with wrap support.
+The spinner arrows may be drawn horizontally or vertically.
+.DE
+
+.SH "METHODS"
+.PP
+The \fBspinint\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for spinint widgets:
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBdelete\fR \fBget\fR \fBicursor\fR \fBindex\fR
+\fBinsert\fR \fBpeek\fR \fBscan\fR \fBselection\fR
+\fBxview\fR
+.fi
+.LP
+See the "entry" manual entry for details on the associated methods.
+.SH "INHERITED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBchildsite\fR \fBclear\fR
+.fi
+.LP
+See the "entryfield" manual entry for details on the associated methods.
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBspinint\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBspinint\fR
+command.
+.TP
+\fIpathName \fBdown\fR
+Decrement the spinner value by the value given in the step option.
+.TP
+\fIpathName \fBup\fR
+Increment the spinner value by the value given in the step option.
+
+.SH "COMPONENTS"
+.IP
+See the "Spinner" widget manual entry for details on the integer spinner
+component items.
+
+.SH EXAMPLE
+.DS
+ option add *textBackground white
+
+ spinint .si -labeltext "Temperature" -labelpos w \\
+ -fixed yes -width 5 -range {32 212}
+
+ pack .si -pady 10
+.DE
+.SH AUTHOR
+Sue Yockey
+.SH KEYWORDS
+spinint, widget
diff --git a/itcl/iwidgets3.0.0/doc/spinner.n b/itcl/iwidgets3.0.0/doc/spinner.n
new file mode 100644
index 00000000000..c2d06f75395
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/spinner.n
@@ -0,0 +1,227 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) spinner.n 1.21 94/12/17 16:04:44
+'/"
+.so man.macros
+.HS spinner iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+spinner \- Create and manipulate a spinner widget
+.SH SYNOPSIS
+\fBspinner\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- Labeledwidget <- Spinner
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBborderWidth\fR \fBcursor\fR \fBexportSelection\fR
+\fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR \fBinsertBackground\fR
+\fBinsertBorderWidth\fR \fBinsertOffTime\fR \fBinsertOnTime\fR \fBinsertWidth\fR
+\fBjustify\fR \fBrelief\fR \fBselectBackground\fR \fBselectBorderWidth\fR
+\fBselectForeground\fR \fBtextVariable\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBshow\fR \fBstate\fR
+.fi
+.LP
+See the "entry" manual entry for details on the associated options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBchildSitePos\fR \fBcommand\fR \fBfixed\fR \fBfocusCommand\fR
+\fBinvalid\fR \fBtextBackground\fR \fBtextFont\fR \fBvalidate\fR
+\fBwidth\fR
+.fi
+.LP
+See the "entryfield" widget manual entry for details on the above
+inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBdisabledForeground\fR \fBlabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR
+\fBlabelMargin\fR \fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR
+\fBstate\fR
+.fi
+.LP
+See the "labeledwidget" widget manual entry for details on the above
+inherited options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBarrowOrient\fR
+Class: \fBOrient\fR
+Command-Line Switch: \fB-arroworient\fR
+.fi
+.IP
+Specifies placement of arrow buttons: \fBhorizontal\fR or \fBvertical\fR.
+The default is vertical.
+.LP
+.nf
+Name: \fBdecrement\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-decrement\fR
+.fi
+.IP
+Tcl command to be executed when down arrow is pressed.
+.LP
+.nf
+Name: \fBincrement\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-increment\fR
+.fi
+.IP
+Tcl command to be executed when up arrow is pressed.
+.LP
+.nf
+Name: \fBrepeatDelay\fR
+Class: \fBRepeatDelay\fR
+Command-Line Switch: \fB-repeatdelay\fR
+.fi
+.IP
+Specifies the initial delay in milliseconds before the spinner repeat action
+on the arrow buttons engages. The default is 300 milliseconds.
+.LP
+.nf
+Name: \fBrepeatInterval\fR
+Class: \fBRepeatInterval\fR
+Command-Line Switch: \fB-repeatinterval\fR
+.fi
+.IP
+Specifies the repeat delay in milliseconds between selections of the arrow
+buttons. A repeatinterval of 0 disables button repeat. The default is
+100 milliseconds.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBspinner\fR command creates a spinner widget. The spinner is
+comprised of an entryfield plus up and down arrow buttons.
+Arrows may be drawn horizontally or vertically.
+.DE
+
+.SH "METHODS"
+.PP
+The \fBspinner\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for spinner widgets:
+.SH "ASSOCIATED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBdelete\fR \fBget\fR \fBicursor\fR \fBindex\fR
+\fBinsert\fR \fBscan\fR \fBselection\fR \fBxview\fR
+.fi
+.LP
+See the "entry" manual entry for details on the associated methods.
+.SH "INHERITED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBchildsite\fR \fBclear\fR \fBpeek\fR
+.fi
+.LP
+See the "entryfield" manual entry for details on the associated methods.
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBspinner\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBspinner\fR
+command.
+.TP
+\fIpathName \fBdown\fR
+Derived classes may overload this method to specialize functionality.
+.TP
+\fIpathName \fBup\fR
+Derived classes may overload this method to specialize functionality.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBdownarrow\fR
+Class: \fBCanvas\fR
+.fi
+.IP
+The downarrow component is the downward pointing button of the spinner. See
+the "canvas" widget manual entry for details on the downarrow component item.
+.LP
+.nf
+Name: \fBuparrow\fR
+Class: \fBCanvas\fR
+.fi
+.IP
+The uparrow component is the upward pointing button of the spinner. See
+the "canvas" widget manual entry for details on the uparrow component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ set months {January February March April May June July \\
+ August September October November December}
+
+ proc blockInput {char} {
+ return 0
+ }
+
+ proc spinMonth {step} {
+ global months
+
+ set index [expr [lsearch $months [.sm get]] + $step]
+
+ if {$index < 0} {set index 11}
+ if {$index > 11} {set index 0}
+
+ .sm delete 0 end
+ .sm insert 0 [lindex $months $index]
+ }
+
+ spinner .sm -labeltext "Month : " -width 10 -fixed 10 -validate blockInput \\
+ -decrement {spinMonth -1} -increment {spinMonth 1}
+ .sm insert 0 January
+
+ pack .sm -padx 10 -pady 10
+.DE
+.SH ACKNOWLEDGEMENTS:
+.LP
+Ken Copeland <ken@hilco.com>
+.IP
+10/18/95 - Added auto-repeat action to spinner arrow buttons.
+.LP
+.SH AUTHOR
+Sue Yockey
+.SH KEYWORDS
+spinner, widget
diff --git a/itcl/iwidgets3.0.0/doc/spintime.n b/itcl/iwidgets3.0.0/doc/spintime.n
new file mode 100644
index 00000000000..5d37bd50037
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/spintime.n
@@ -0,0 +1,265 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) spintime.n
+'\"
+.so man.macros
+.HS spintime iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+spintime \- Create and manipulate time spinner widgets
+.SH SYNOPSIS
+\fBspintime\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- Spintime
+
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBcursor\fR \fBforeground\fR \fBrelief\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBtextBackground\fR \fBtextFont\fR
+.fi
+.LP
+See the "entryfield" manual entry for details on the above associated options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBlabelFont\fR \fBlabelMargin\fR
+.fi
+.LP
+See the "labeledwidget" manual entry for details on the above associated
+options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBarrowOrient\fR \fBrepeatDelay\fR \fBrepeatInterval\fR
+.fi
+.LP
+See the "spinner" manual entry for details on the above associated options.
+
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBlabelPos\fR
+Class: \fBPosition\fR
+Command-Line Switch: \fB-labelpos\fR
+.fi
+.IP
+Specifies the position of the label along the sides of the various
+spinners: \fBn\fR, \fBe\fR, \fBs\fR, or \fBw\fR. The default is w.
+.LP
+.nf
+Name: \fBhourLabel\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-hourlabel\fR
+.fi
+.IP
+Specifies the text of the label for the hour spinner. The default is "Hour".
+.LP
+.nf
+Name: \fBhourOn\fR
+Class: \fBhourOn\fR
+Command-Line Switch: \fB-houron\fR
+.fi
+.IP
+Specifies whether or not to display the hour spinner in any of the forms
+acceptable to \fBTcl_GetBoolean\fR. The default is true.
+.LP
+.nf
+Name: \fBhourWidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-hourwidth\fR
+.fi
+.IP
+Specifies the width of the hour spinner in any of the forms acceptable to
+\fBTcl_GetPixels\fR. The default is 3 pixels.
+.LP
+.nf
+Name: \fBmilitaryOn\fR
+Class: \fBmilitaryOn\fR
+Command-Line Switch: \fB-militaryon\fR
+.fi
+.IP
+Specifies use of a 24 hour clock for hour display in any of the forms
+acceptable to \fBTcl_GetBoolean\fR. The default is true.
+.LP
+.nf
+Name: \fBminuteLabel\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-minutelabel\fR
+.fi
+.IP
+Specifies the text of the label for the minute spinner. The default is
+"Minute".
+.LP
+.nf
+Name: \fBminuteOn\fR
+Class: \fBminuteOn\fR
+Command-Line Switch: \fB-minuteon\fR
+.fi
+.IP
+Specifies whether or not to display the minute spinner in any of the forms
+acceptable to \fBTcl_GetBoolean\fR. The default is true.
+.LP
+.nf
+Name: \fBminuteWidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-minutewidth\fR
+.fi
+.IP
+Specifies the width of the minute spinner in any of the forms acceptable to
+\fBTcl_GetPixels\fR. The default is 3 pixels.
+.LP
+.nf
+Name: \fBorient\fR
+Class: \fBOrient\fR
+Command-Line Switch: \fB-orient\fR
+.fi
+.IP
+Specifies the orientation of the hour, minute, and second spinners: \fBvertical\fR or \fBhorizontal\fR. The default is horizontal.
+.LP
+.nf
+Name: \fBsecondLabel\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-secondlabel\fR
+.fi
+.IP
+Specifies the text of the label for the second spinner. The default is
+"Second"
+.LP
+.nf
+Name: \fBsecondOn\fR
+Class: \fBsecondOn\fR
+Command-Line Switch: \fB-secondon\fR
+.fi
+.IP
+Specifies whether or not to display the second spinner in any of the forms
+acceptable to \fBTcl_GetBoolean\fR. The default is true.
+.LP
+.nf
+Name: \fBsecondWidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-secondwidth\fR
+.fi
+.IP
+Specifies the width of the second spinner in any of the forms acceptable to
+\fBTcl_GetPixels\fR. The default is 3 pixels.
+.LP
+.nf
+Name: \fBtimeMargin\fR
+Class: \fBMargin\fR
+Command-Line Switch: \fB-timemargin\fR
+.fi
+.IP
+Specifies the margin space between the hour, minute, and second spinners is
+any of the forms accpetable to \fBTcl_GetPixels\fR. The default is 1 pixel.
+.LP
+.nf
+.BE
+
+.SH DESCRIPTION
+.PP
+
+The \fBspintime\fR command creates a set of spinners for use in time value
+entry. The set includes an hour, minute, and second spinner widget.
+
+.SH "METHODS"
+.PP
+The \fBspintime\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for spintime widgets:
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBspintime\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBspintime\fR
+command.
+.TP
+\fIpathName \fBget\fR ?\fBformat\fR?
+Returns the current contents of the spintime widget in a format of
+string or as an integer clock value using the \fB-string\fR and \fB-clicks\fR
+format options respectively. The default is by string. Reference the
+clock command for more information on obtaining time and its
+formats.
+.TP
+\fIpathName \fBshow\fR \fItime\fR
+Changes the currently displayed time to be that of the time
+argument. The time may be specified either as a string, an
+integer clock value or the keyword "now". Reference the clock
+command for more information on obtaining times and its format.
+
+.ta 4c
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBhour\fR
+Class: \fBSpinint\fR
+.fi
+.IP
+The hour component is the hour spinner of the time spinner. See the
+SpinInt widget manual entry for details on the hour component item.
+.LP
+.nf
+Name: \fBminute\fR
+Class: \fBSpinint\fR
+.fi
+.IP
+The minute component is the minute spinner of the time spinner. See
+the SpinInt widget manual entry for details on the minute component item.
+.LP
+.nf
+Name: \fBsecond\fR
+Class: \fBSpinint\fR
+.fi
+.IP
+The second component is the second spinner of the time spinner. See the
+SpinInt widget manual entry for details on the second component item.
+.fi
+
+.SH EXAMPLE
+.DS
+spintime .st
+pack .st -padx 10 -pady 10
+.DE
+.SH AUTHOR
+Sue Yockey
+.DE
+Mark L. Ulferts
+.SH KEYWORDS
+spintime, spinint, spinner, entryfield, entry, widget
+
diff --git a/itcl/iwidgets3.0.0/doc/tabnotebook.n b/itcl/iwidgets3.0.0/doc/tabnotebook.n
new file mode 100644
index 00000000000..c96408ad3be
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/tabnotebook.n
@@ -0,0 +1,657 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) tabnotebook.n
+'/"
+.so man.macros
+.HS tabnotebook iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+tabnotebook \- create and manipulate tabnotebook widgets
+.SH SYNOPSIS
+\fBtabnotebook\fR \fIpathName\fR? \fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- tabnotebook
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBdisabledForeground\fR \fBforeground\fR \fBscrollCommand\fR
+\fBcursor\fR \fBfont\fR \fBheight\fR \fBwidth\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBangle\fR
+Class: \fBAngle\fR
+Command-Line Switch: \fB-angle\fR
+.fi
+.IP
+Specifes the angle of slope from the inner edge to the outer edge of the tab.
+An angle of 0 specifies square tabs. Valid ranges are 0 to 45 degrees
+inclusive. Default is 15 degrees. If \fBtabPos\fR is e or w, this option
+is ignored.
+.LP
+.nf
+Name: \fBauto\fR
+Class: \fBAuto\fR
+Command-Line Switch: \fB-auto\fR
+.fi
+.IP
+Specifies whether to use the automatic packing/unpacking algorithm of the
+notebook. A value of true indicates that page frames will be unpacked and
+packed acoording to the algorithm described in the select command. A value
+of \fBfalse\fR leaves the current page packed and
+subsequent \fBselects\fR, \fBnext\fR, or \fBprevious\fR commands do not
+switch pages automatically. In either case the page's associated
+command (see the \fBadd\fR command's description of the command option) is
+invoked. The value may have any of the forms accepted by
+the \fBTcl_GetBoolean\fR, such as \fBtrue\fR, \fBfalse\fR, \fB0\fR,
+\fB1\fR, \fByes\fR, or \fBno\fR.
+.LP
+.nf
+Name: \fBbackdrop\fR
+Class: \fBBackdrop\fR
+Command-Line Switch: \fB-backdrop\fR
+.fi
+.IP
+Specifies a background color to use when filling in the backdrop area
+behind the tabs.
+.LP
+.nf
+Name: \fBbackground\fR
+Class: \fBBackground\fR
+Command-Line Switch: \fB-background\fR
+.fi
+.IP
+Specifies a background color to use for displaying a page and its associated
+tab. This can be thought of as the selected tab background color, since the
+tab associated with the selected page is the selected tab.
+.LP
+.nf
+Name: \fBbevelAmount\fR
+Class: \fBBevelAmount\fR
+Command-Line Switch: \fB-bevelamount\fR
+.fi
+.IP
+Specifes the size of tab corners. A value of 0 with \fBangle\fR set to
+0 results in square tabs. A \fBbevelAmount\fR of 4, means that the tab will
+be drawn with angled corners that cut in 4 pixels from the edge of
+the tab. The default is 0.
+.LP
+.nf
+Name: \fBborderWidth\fR
+Class: \fBBorderWidth\fR
+Command-Line Switch: \fB-borderwidth\fR
+.fi
+.IP
+Specifies the width of shadowed border to place around the notebook area of
+the tabnotebook. The default value is 2.
+.LP
+.nf
+Name: \fBdisabledForeground\fR
+Class: \fBDisabledForeground\fR
+Command-Line Switch: \fB-disabledforeground\fR
+.fi
+.IP
+Specifies a foreground color to use for displaying a tab's label when
+its \fBstate\fR is disabled.
+.LP
+.nf
+Name: \fBequalTabs\fR
+Class: \fBEqualTabs\fR
+Command-Line Switch: \fB-equaltabs\fR
+.fi
+.IP
+Specifies whether to force tabs to be equal sized or not. A value
+of \fBtrue\fR means constrain tabs to be equal sized. A value
+of \fBfalse\fR allows each tab to size based on the text label size. The
+value may have any of the forms accepted by the \fBTcl_GetBoolean\fR, such
+as \fBtrue\fR, \fBfalse\fR, \fB0\fR, \fB1\fR, \fByes\fR, or \fBno\fR.
+.IP
+For horizontally positioned tabs (\fBtabpos\fR is either \fBs\fR or \fBn\fR),
+\fBtrue\fR forces all tabs to be equal width (the width being equal to
+the longest label plus any \fBpadX\fR specified). Horizontal tabs are
+always equal in height.
+.IP
+For vertically positioned tabs (\fBtabpos\fR is either \fBw\fR or \fBe\fR),
+\fBtrue\fR forces all tabs to be equal height (the height being equal to the
+height of the label with the largest font). Vertically oriented tabs
+are always equal in width.
+.LP
+.nf
+Name: \fBforeground\fR
+Class: \fBForeground\fR
+Command-Line Switch: \fB-foreground\fR
+.fi
+.IP
+Specifies a foreground color to use for displaying a page and its associated
+tab label. This can be thought of as the selected tab background color,
+since the tab associated with the selected page is the selected tab.
+.LP
+.nf
+Name: \fBgap\fR
+Class: \fBGap\fR
+Command-Line Switch: \fB-gap\fR
+.fi
+.IP
+Specifies the amount of pixel space to place between each tab. Value may
+be any pixel offset value. In addition, a special keyword \fBoverlap\fR
+can be used as the value to achieve a standard overlap of tabs. This value
+may have any of the forms acceptable to \fBTk_GetPixels\fR.
+.LP
+.nf
+Name: \fBmargin\fR
+Class: \fBMargin\fR
+Command-Line Switch: \fB-Bmargin\fR
+.fi
+.IP
+Specifies the amount of space to place between the outside edge of the
+tabnotebook and the outside edge of its tabs. If \fBtabPos\fR is \fBs\fR,
+this is the amount of space between the bottom edge of the tabnotebook and
+the bottom edge of the set of tabs. If \fBtabPos\fR is \fBn\fR, this is
+the amount of space between the top edge of the tabnotebook and the top
+edge of the set of tabs. If \fBtabPos\fR is \fBe\fR, this is the amount of
+space between the right edge of the tabnotebook and the right edge of the
+set of tabs. If \fBtabPos\fR is \fBw\fR, this is the amount of space
+between the left edge of the tabnotebook and the left edge of the set
+of tabs. This value may have any of the forms acceptable to \fBTk_GetPixels\fR.
+.LP
+.nf
+Name: \fBpadX\fR
+Class: \fBPadX\fR
+Command-Line Switch: \fB-padx\fR
+.fi
+.IP
+Specifies a non-negative value indicating how much extra space to request
+for a tab around its label in the X-direction. When computing how large
+a window it needs, the tab will add this amount to the width it would
+normally need The tab will end up with extra internal space to the left
+and right of its text label. This value may have any of the forms acceptable
+to \fBTk_GetPixels\fR.
+.LP
+.nf
+Name: \fBpadY\fR
+Class: \fBPadY\fR
+Command-Line Switch: \fB-pady\fR
+.fi
+.IP
+Specifies a non-negative value indicating how much extra space to request for
+a tab around its label in the Y-direction. When computing how large a
+window it needs, the tab will add this amount to the height it would normally
+need The tab will end up with extra internal space to the top and bottom of
+its text label. This value may have any of the forms acceptable
+to \fBTk_GetPixels\fR.
+.LP
+.nf
+Name: \fBraiseSelect\fR
+Class: \fBRaiseSelect\fR
+Command-Line Switch: \fB-raiseselect\fR
+.fi
+.IP
+Specifes whether to slightly raise the selected tab from the rest of the
+tabs. The selected tab is drawn 2 pixels closer to the outside of the
+tabnotebook than the unselected tabs. A value of \fBtrue\fR says to
+raise selected tabs, a value of \fBfalse\fR turns this feature off. The
+default is \fBfalse\fR. The value may have any of the forms accepted
+by the \fBTcl_GetBoolean\fR, such as \fBtrue\fR, \fBfalse\fR, \fB0\fR,
+\fB1\fR, \fByes\fR, or \fBno\fR.
+.LP
+.nf
+Name: \fBstart\fR
+Class: \fBStart\fR
+Command-Line Switch: \fB-start\fR
+.fi
+.IP
+Specifies the amount of space to place between the left or top edge of the
+tabnotebook and the starting edge of its tabs. For horizontally positioned
+tabs, this is the amount of space between the left edge of the notebook and
+the left edge of the first tab. For vertically positioned tabs, this is the
+amount of space between the top of the notebook and the top of the first
+tab. This value may change if the user performs a MButton-2 scroll on the
+tabs. This value may have any of the forms acceptable to \fBTk_GetPixels\fR.
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Command-Line Switch: \fB-state\fR
+.fi
+.IP
+Sets the active state of the tabnotebook. Specifying \fBnormal\fR allows
+all pages to be selectable. Specifying \fBdisabled\fR disables the notebook
+causing all page tabs to be drawn in the \fBdisabledForeground\fR color.
+.LP
+.nf
+Name: \fBtabBackground\fR
+Class: \fBTabBackground\fR
+Command-Line Switch: \fB-tabbackground\fR
+.fi
+.IP
+Specifies a background color to use for displaying tab backgrounds when
+they are in their unselected state. This is the background associated with
+tabs on all pages other than the selected page.
+.LP
+.nf
+Name: \fBtabBorders\fR
+Class: \fBTabBorders\fR
+Command-Line Switch: \fB-tabborders\fR
+.fi
+.IP
+Specifies whether to draw the borders of tabs that are not selected.
+Specifying \fBtrue\fR (the default) draws these borders,
+specifying \fBfalse\fR draws only the border around the selected tab. The
+value may have any of the forms accepted by the \fBTcl_GetBoolean\fR,
+such as \fBtrue\fR, \fBfalse\fR, \fB0\fR, \fB1\fR,\fB yes\fR, or \fBno\fR.
+.LP
+.nf
+Name: \fBtabForeground\fR
+Class: \fBTabForeground\fR
+Command-Line Switch: \fB-tabforeground\fR
+.fi
+.IP
+Specifies a foreground color to use for displaying tab labels when they
+are in their unselected state. This is the foreground associated with tabs
+on all pages other than the selected page.
+.LP
+.nf
+Name: \fBtabPos\fR
+Class: \fBTabPos\fR
+Command-Line Switch: \fB-tabpos\fR
+.fi
+.IP
+Specifies the location of the set of tabs in relation to the notebook
+area. Must be n, s, e, or w. Defaults to s.
+.BE
+.SH DESCRIPTION
+.PP
+The \fBtabnotebook\fR command creates a new window (given by the pathName
+argument) and makes it into a \fBtabnotebook\fR widget. Additional options,
+described above may be specified on the command line or in the option
+database to configure aspects of the tabnotebook such as its colors, font,
+and text. The tabnotebook command returns its pathName argument. At the
+time this command is invoked, there must not exist a window named
+pathName, but pathName's parent must exist.
+.PP
+A \fBtabnotebook\fR is a widget that contains a set of tabbed pages. It
+displays one page from the set as the selected page. A Tab displays the
+label for the page to which it is attached and serves as a page
+selector. When a page's tab is selected, the page's contents are displayed
+in the page area. The selected tab has a three-dimensional effect to make
+it appear to float above the other tabs. The tabs are displayed as a group
+along either the left, top, right, or bottom edge. When first created a
+tabnotebook has no pages. Pages may be added or deleted using widget
+commands described below.
+.PP
+A special option may be provided to the tabnotebook. The \fB-auto\fR
+option specifies whether the tabnotebook will automatically handle the
+unpacking and packing of pages when pages are selected. A value of
+true signifies that the notebook will automatically manage it. This is the
+default value. A value of false signifies the notebook will not perform
+automatic switching of pages.
+.SH NOTEBOOK PAGES
+A tabnotebook's pages area contains a single child site frame. When a
+new page is created it is a child of this frame. The page's child site
+frame serves as a geometry container for applications to pack widgets
+into. It is this frame that is automatically unpacked or packed when
+the auto option is true. This creates the effect of one page being visible
+at a time. When a new page is selected, the previously selected page's
+child site frame is automatically unpacked from the tabnotebook's child
+site frame and the newly selected page's child site is packed into the
+tabnotebook's child site frame.
+.PP
+However, sometimes it is desirable to handle page changes in a different
+manner. By specifying the \fBauto\fR option as \fBfalse\fR, child site
+packing can be disabled and done differently. For example, all widgets
+might be packed into the first page's child site \fBframe\fR. Then when
+a new page is selected, the application can reconfigure the widgets
+and give the appearance that the page was flipped.
+.PP
+In both cases the command option for a page specifies a Tcl Command
+to execute when the page is selected. In the case of \fBauto\fR
+being \fBtrue\fR, it is between the unpacking of the previously selected
+page and the packing of the newly selected page.
+.PP
+Notebook pages can also be controlled with scroll bars or other widgets
+that obey the \fBscrollcommand\fR protocol. By giving a scrollbar
+a \fB-command\fR to call the tabnotebook's \fBselect\fR method, the
+tabnotebook can be controlled with a scrollbar.
+.PP
+The notebook area is implemented with the notebook mega widget.
+.SH TABS
+Tabs appear along the edge of the notebook area. Tabs are drawn to appear
+attached to their associated page. When a tab is clicked on, the associated
+page is selected and the tab is drawn as raised above all other tabs and as
+a seamless part of its notebook page. Tabs can be controlled in their
+location along the edges, the angle tab sides are drawn with, gap between
+tabs, starting margin of tabs, internal padding around text labels in
+a tab, the font, and its label.
+.PP
+The Tab area is implemented with the \fBtabset\fR mega widget.
+See \fBtabset(1)\fR. Tabs may be oriented along either the north, south,
+east, or west sides with the \fBtabPos\fR option. North and south tabs
+may appear as angled, square, or bevelled. West and east tabs may appear
+as square or bevelled. By changing tab gaps, tab angles, bevelling,
+orientations, colors, fonts, start locations, and margins; tabs may appear
+in a wide variety of styles. For example, it is possible to implement
+Microsoft-style tabs, Borland property tab styles, or Borland Delphi
+style tabs all with the same tabnotebook.
+.SH "WIDGET-SPECIFIC METHODS"
+.PP
+The \fBtabnotebook\fR command creates a new Tcl command whose name
+is \fIpathName\fR. This command may be used to invoke various operations
+on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIoption\fR and the \fIarg\fRs
+determine the exact behavior of the command.
+.PP
+Many of the widget commands for a notebook take as one argument an
+indicator of which page of the notebook to operate on. These indicators are
+called indexes and may be specified in any of the following forms:
+.TP
+\fInumber\fR
+Specifies the page numerically, where 0 corresponds to the first page
+in the notebook, 1 to the second, and so on.
+.TP
+\fBselect\fR
+Specifies the currently selected page's index. If no page is currently
+selected, the value -1 is returned.
+.TP
+\fBend\fR
+Specifes the last page in the tabnotebook's index. If the notebook is empty
+this will return -1.
+.TP
+\fIpattern\fR
+If the index doesn't satisfy any of the above forms, then this form is
+used. Pattern is pattern-matched against the label of each page in the
+notebook, in order from the first to the last page, until a matching entry
+is found. The rules of Tcl_StringMatch are used.
+'.............................................................................
+The following commands are possible for tabnotebook widgets:
+.TP
+\fIpathName\fR \fBadd\fR ?\fIoption\fR \fIvalue\fR \fIoption\fR \fIvalue\fR ...?
+Add a new page at the end of the tabnotebook. A new child site frame is
+created. Returns the child site pathName. If additional arguments are
+present, they specify any of the following options:
+.RS
+.TP
+\fB-angle\fR \fIvalue\fR
+Specifes the angle of slope from the inner edge to the outer edge of the
+tab. An angle of 0 specifies square tabs. Valid ranges are 0 to 45 degrees
+inclusive. Default is 15 degrees. If this option is specified as an empty
+string (the default), then the angle option for the overall tabnotebook
+is used. This is generally only set at the tabnotebook level. Tabs normally
+will want to share the same angle value.
+.TP
+\fB-background\fR \fIvalue\fR
+Specifies a background color to use for displaying tabs when they are
+selected and for displaying the current page. If this option is specified
+as an empty string (the default), then the background option for the
+overall tabnotebook is used.
+.TP
+\fB-bevelamount\fR \fIvalue\fR
+Specifes the size of tab corners. A value of 0 with angle set to 0
+results in square tabs. A bevelAmount of 4, means that the tab will be
+drawn with angled corners that cut in 4 pixels from the edge of the tab.
+The default is 0. This is generally only set at the tabnotebook level.
+Tabs normally will want to share the same bevelAmount.
+.TP
+\fB-bitmap\fR \fIvalue\fR
+If label is a non-empty string, specifies a bitmap to display in this
+page's tab. Bitmap may be of any of the forms accepted by Tk_GetPixmap.
+.TP
+\fB-command\fR \fIvalue\fR
+Specifies a Tcl command to be executed when this page is selected. This
+allows the programmer a hook to reconfigure this page's widgets or any
+other page's widgets.
+.IP
+If the tabnotebook has the auto option set to true, when a page is
+selected this command will be called immediately after the previously
+selected page is unpacked and immediately before this page is selected. The
+index value select is valid during this Tcl command. `index select' will
+return this page's page number.
+.IP
+If the auto option is set to false, when a page is selected the unpack
+and pack calls are bypassed. This Tcl command is still called.
+.TP
+\fB-disabledforeground\fR \fIvalue\fR
+Specifies a foreground color to use for displaying tab labels when tabs
+are in their disable state. If this option is specified as an empty
+string (the default), then the disabledforeground option for the overall
+tabnotebook is used.
+.TP
+\fB-font\fR \fIvalue\fR
+Specifies the font to use when drawing a text label on a page tab. If
+this option is specified as an empty string then the font option for the
+overall tabnotebook is used..
+.TP
+\fB-foreground\fR \fIvalue\fR
+Specifies a foreground color to use for displaying tab labels when they are
+selected. If this option is specified as an empty string (the default),
+then the foreground option for the overall tabnotebook is used.
+.TP
+\fB-label\fR \fIvalue\fR
+Specifies a string to display as an identifying label for a notebook
+page. This label serves as an additional identifier used to reference the
+page. This label may be used for the index value in widget commands.
+.TP
+\fB-tabbackground\fR \fIvalue\fR
+Specifies a background color to use for displaying a tab when it is not
+elected. If this option is specified as an empty string (the default), then
+the tabBackground option for the overall tabnotebook is used.
+.TP
+\fB-tabforeground\fR \fIvalue\fR
+Specifies a foreground color to use for displaying the tab's text label
+when it is not selected. If this option is specified as an empty
+string (the default), then the tabForeground option for the overall
+tabnotebook is used.
+.TP
+\fB-padx\fR \fIvalue\fR
+Specifies a non-negative value indicating how much extra space to request
+for a tab around its label in the X-direction. When computing how large a
+window it needs, the tab will add this amount to the width it would
+normally need The tab will end up with extra internal space to the
+left and right of its text label. This value may have any of the forms
+acceptable to Tk_GetPixels. If this option is specified as an empty
+string (the default), then the padX option for the overall tabnotebook is used
+.TP
+\fB-pady\fR \fIvalue\fR
+Specifies a non-negative value indicating how much extra space to request
+for a tab around its label in the Y-direction. When computing how large
+a window it needs, the tab will add this amount to the height it would
+normally need The tab will end up with extra internal space to the top and
+bottom of its text label. This value may have any of the forms acceptable
+to Tk_GetPixels. If this option is specified as an empty string (the
+default), then the padY option for the overall tabnotebook is used
+.TP
+\fB-state\fR \fIvalue\fR
+Specifies one of two states for the page: normal or disabled. In normal state
+unselected tabs are displayed using the tabforeground and tabbackground
+option from the tabnotebook or the page. Selected tabs and pages are
+displayed using the foreground and background option from the tabnotebook or
+the page. The disabled state means that the page and its tab is
+insensitive: it doesn't respond to mouse button presses or releases. In this
+state the entry is displayed according to its disabledForeground option for
+the tabnotebook and the background/tabbackground option from the page or
+the tabnotebook.
+.RE
+.TP
+'>>>>>>>>>>
+\fIpathName\fR \fBchildSite\fR ?\fIindex\fR?
+If passed no arguments, returns a list of pathNames for all the pages
+in the tabnotebook. If the tab notebook is empty, an empty list is returned
+.IP
+If \fIindex\fR is passed, it returns the \fIpathName\fR for the page's
+child site \fBframe\fR specified by \fIindex\fR. Widgets that are created
+with this \fIpathName\fR will be displayed when the associated page is
+selected. If \fIindex\fR is not a valid index, an empty string is returned.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue\fR \fIoption\fR \fIvalue\fR ...?
+Query or modify the configuration options of the widget. If no \fIoption\fR
+is specified, returns a list describing all of the available options
+for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for information on the
+format of this list). If option is specified with no value, then the
+command returns a list describing the one named option (this list will be
+identical to the corresponding sublist of the value returned if no option
+is specified). If one or more option-value pairs are specified, then the
+command modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have any
+of the values accepted by the tabnotebook command.
+.TP
+\fIpathName\fR \fBdelete\fR \fIindex1\fR ?\fIindex2\fR?
+Delete all of the pages between \fIindex1\fR and \fIindex2\fR inclusive.
+If \fIindex2\fR is omitted then it defaults to \fIindex1\fR. Returns an
+empty string.
+.TP
+\fIpathName\fR \fBindex\fR \fIindex\fR
+Returns the numerical index corresponding to \fIindex\fR.
+.TP
+\fIpathName\fR \fBinsert\fR \fIindex\fR ?\fIoption\fR \fIvalue\fR \fIoption\fR \fIvalue\fR ...?
+Insert a new page in the tabnotebook before the page specified
+by \fIindex\fR. A new child site \fBframe\fR is created. The additional
+arguments are the same as for the \fBadd\fR command. Returns the
+child site \fIpathName\fR.
+.TP
+\fIpathName\fR \fBnext\fR
+Advances the selected page to the next page (order is determined by
+insertion order). If the currently selected page is the last page in
+the notebook, the selection wraps around to the first page in the
+notebook. It behaves as if the user selected the new page.
+.IP
+For notebooks with \fBauto\fR set to \fBtrue\fR the current page's
+child site is unpacked from the notebook's child site frame. Then the next
+page's child site is packed into the notebook's child site frame. The
+Tcl command given with the command option will be invoked between these
+two operations.
+.IP
+For notebooks with \fBauto\fR set to \fBfalse\fR the Tcl command given
+with the command option will be invoked.
+.TP
+\fIpathName\fR \fBpageconfigure\fR \fIindex\fR ?\fIoption\fR? ?\fIvalue\fR \fIoption\fR \fIvalue\fR ...?
+This command is similar to the \fBconfigure\fR command, except that it
+applies to the options for an individual page, whereas configure applies
+to the options for the tabnotebook as a whole. \fIOptions\fR may have
+any of the values accepted by the add widget command. If options are
+specified, options are modified as indicated in the command and the
+command returns an empty string. If no options are specified, returns a
+list describing the current options for page index (see \fBTk_ConfigureInfo\fR
+for information on the format of this list).
+.TP
+\fIpathName\fR \fBprev\fR
+Moves the selected page to the previous page (order is determined by
+insertion order). If the currently selected page is the first page in
+the notebook, the selection wraps around to the last page in the notebook. It
+behaves as if the user selected the new page.
+.IP
+For notebooks with \fBauto\fR set to \fBtrue\fR the current page's
+child site is unpacked from the notebook's child site \fBframe\fR. Then the
+previous page's child site is packed into the notebook's child site frame.
+The Tcl command given with the command option will be invoked between these
+two operations.
+.IP
+For notebooks with \fBauto\fR set to \fBfalse\fR the Tcl command given
+with the command option will be invoked.
+.TP
+\fIpathName\fR \fBselect\fR \fIindex\fR
+Selects the page specified by \fIindex\fR as the currently selected page.
+It behaves as if the user selected the new page.
+.IP
+For notebooks with \fBauto\fR set to \fBtrue\fR the current page's child
+site is unpacked from the notebook's child site frame. Then the \fIindex\fR
+page's child site is packed into the notebook's child site frame. The
+Tcl command given with the command option will be invoked between these two
+operations.
+.IP
+For notebooks with \fBauto\fR set to \fBfalse\fR the Tcl command given
+with the command option will be invoked.
+.TP
+\fIpathName\fR \fBview\fR
+Returns the currently selected page. This command is for compatibility with
+the \fBscrollbar\fR widget.
+.TP
+\fIpathName\fR \fBview\fR \fIindex\fR
+Selects the page specified by \fIindex\fR as the currently selected page.
+This command is for compatibility with the \fBscrollbar\fR widget.
+.TP
+\fIpathName\fR \fBview\fR \fBmoveto\fR \fIfraction\fR
+Uses the \fIfraction\fR value to determine the corresponding page to move to.
+This command is for compatibility with the \fBscrollbar\fR widget.
+.TP
+\fIpathName\fR \fBview\fR \fBscroll\fR \fInum\fR \fIwhat\fR
+Uses the \fInum\fR value to determine how many pages to move forward or
+backward (\fInum\fR can be negative or positive). The \fIwhat\fR argument
+is ignored. This command is for compatibility with the \fBscrollbar\fR widget.
+.SH "COMPONENTS"
+.LP
+Generally all behavior of the internal components, \fBtabset\fR
+and \fBnotebook\fR are controlled via the \fBpageconfigure\fR method.
+The following section documents these two components.
+.LP
+.nf
+Name: \fBtabset\fR
+Class: \fBTabset\fR
+.fi
+.IP
+This is the tabset component. It implements the tabs that are associated
+with the notebook component.
+.IP
+See the "\fBTabset\fR" widget manual entry for details on
+the \fBtabset\fR component item.
+.LP
+.nf
+Name: \fBnotebook\fR
+Class: \fBNotebook\fR
+.fi
+.IP
+This is the notebook component. It implements the notebook that contains the
+pages of the tabnotebook.
+.IP
+See the "\fBNotebook\fR" widget manual entry for details on
+the \fBnotebook\fR component item.
+.fi
+.SH EXAMPLE
+.PP
+Following is an example that creates a tabnotebook with two pages.
+.PP
+.nf
+.IP
+.ta 2c 8c 12c
+# Create the tabnotebook widget and pack it.
+ tabnotebook .tn -width 100 -height 100
+ pack .tn \\
+ -anchor nw \\
+ -fill both \\
+ -expand yes \\
+ -side left \\
+ -padx 10 \\
+ -pady 10
+.IP
+# Add two pages to the tabnotebook,
+# labelled "Page One" and "Page Two"
+ .tn add -label "Page One"
+ .tn add -label "Page Two"
+.IP
+# Get the child site frames of these two pages.
+ set page1CS [.tn childsite 0]
+ set page2CS [.tn childsite "Page Two"]
+.IP
+# Create buttons on each page of the tabnotebook.
+ button $page1CS.b -text "Button One"
+ pack $page1CS.b
+ button $page2CS.b -text "Button Two"
+ pack $page2CS.b
+.IP
+# Select the first page of the tabnotebook.
+ .tn select 0
+.fi
+.SH AUTHOR
+Bill W. Scott
+.SH KEYWORDS
+tab tabset notebook tabnotebook page
diff --git a/itcl/iwidgets3.0.0/doc/tabset.n b/itcl/iwidgets3.0.0/doc/tabset.n
new file mode 100644
index 00000000000..e60d379872b
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/tabset.n
@@ -0,0 +1,464 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) WIDGET.n
+'/"
+.so man.macros
+.HS tabset iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+'\"
+'\"
+.SH NAME
+tabset \- create and manipulate tabs as as set
+.SH SYNOPSIS
+\fBtabset\fR \fIpathName\fR ?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- tabset
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBfont\fR \fBselectBackground\fR \fBcursor\fR
+\fBforeground\fR \fBselectForeground\fR \fBdisabledForeground\fR \fBheight\fR
+\fBwidth\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBangle\fR
+Class: \fBAngle\fR
+Command-Line Switch: \fB-angle\fR
+.fi
+.IP
+Specifes the angle of slope from the inner edge to the outer edge of the
+tab. An angle of 0 specifies square tabs. Valid ranges are 0 to 45 degrees
+inclusive. Default is 15 degrees. If tabPos is e or w, this option is ignored.
+.LP
+.nf
+Name: \fBbackdrop\fR
+Class: \fBBackdrop\fR
+Command-Line Switch: \fB-backdrop\fR
+.fi
+.IP
+Specifies a background color to use when filling in the area behind the tabs.
+.LP
+.nf
+Name: \fBbevelAmount\fR
+Class: \fBBevelAmount\fR
+Command-Line Switch: \fB-bevelamount\fR
+.fi
+.IP
+Specifes the size of tab corners. A value of 0 with angle set to 0 results
+in square tabs. A \fBbevelAmount\fR of 4, means that the tab will be
+drawn with angled corners that cut in 4 pixels from the edge of the
+tab. The default is 0.
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-command\fR
+Specifes the prefix of a Tcl command to invoke to change the view in the
+widget associated with the tabset. When a user selects a tab, a Tcl command
+is invoked. The actual command consists of this option followed by a space
+and a number. The number is the numerical index of the tab that has been
+selected.
+.LP
+.nf
+Name: \fBequalTabs\fR
+Class: \fBEqualTabs\fR
+Command-Line Switch: \fB-equaltabs\fR
+.fi
+.IP
+Specifies whether to force tabs to be equal sized or not. A value
+of \fBtrue\fR means constrain tabs to be equal sized. A value
+of \fBfalse\fR allows each tab to size based on the text label size. The
+value may have any of the forms accepted by the \fBTcl_GetBoolean\fR, such
+as \fBtrue\fR, \fBfalse\fR, \fB0\fR, \fB1\fR, \fByes\fR, or \fBno\fR.
+.IP
+For horizontally positioned tabs (\fBtabPos\fR is either \fBs\fR
+or \fBn\fR), \fBtrue\fR forces all tabs to be equal width (the width being
+equal to the longest label plus any padX specified). Horizontal tabs are
+always equal in height.
+.IP
+For vertically positioned tabs (\fBtabPos\fR is either \fBw\fR or \fBe\fR),
+\fBtrue\fR forces all tabs to be equal height (the height being equal to
+the height of the label with the largest font). Vertically oriented tabs are
+always equal in width.
+.LP
+.nf
+Name: \fBgap\fR
+Class: \fBGap\fR
+Command-Line Switch: \fB-gap\fR
+.fi
+.IP
+Specifies the amount of pixel space to place between each tab. Value may
+be any pixel offset value. In addition, a special keyword \fBoverlap\fR
+can be used as the value to achieve a standard overlap of tabs. This value
+may have any of the forms acceptable to \fBTk_GetPixels\fR.
+.LP
+.nf
+Name: \fBmargin\fR
+Class: \fBMargin\fR
+Command-Line Switch: \fB-margin\fR
+.fi
+.IP
+Specifies the amount of space to place between the outside edge of the
+tabset and the outside edge of its tabs. If \fBtabPos\fR is \fBs\fR, this
+is the amount of space between the bottom edge of the tabset and the
+bottom edge of the set of tabs. If \fBtabPos\fR is \fBn\fR, this is the
+amount of space between the top edge of the tabset and the top edge of the
+set of tabs. If \fBtabPos\fR is \fBe\fR, this is the amount of space between
+the right edge of the tabset and the right edge of the set of tabs.
+If \fBtabPos\fR is \fBw\fR, this is the amount of space between the left
+edge of the tabset and the left edge of the set of tabs. This value may
+have any of the forms acceptable to \fBTk_GetPixels\fR.
+.LP
+.nf
+Name: \fBpadX\fR
+Class: \fBPadX\fR
+Command-Line Switch: \fB-padx\fR
+.fi
+.IP
+Specifies a non-negative value indicating how much extra space to request for
+a tab around its label in the X-direction. When computing how large a
+window it needs, the tab will add this amount to the width it would normally
+need The tab will end up with extra internal space to the left and right of
+its text label. This value may have any of the forms acceptable
+to \fBTk_GetPixels\fR.
+.LP
+.nf
+Name: \fBpadY\fR
+Class: \fBPadY\fR
+Command-Line Switch: \fB-pady\fR
+.fi
+.IP
+Specifies a non-negative value indicating how much extra space to request
+for a tab around its label in the Y-direction. When computing how large a
+window it needs, the tab will add this amount to the height it would
+normally need The tab will end up with extra internal space to the top and
+bottom of its text label. This value may have any of the forms acceptable
+to \fBTk_GetPixels\fR.
+.LP
+.nf
+Name: \fBraiseSelect\fR
+Class: \fBRaiseSelect\fR
+Command-Line Switch: \fB-raiseselect\fR
+.fi
+.IP
+Specifes whether to slightly raise the selected tab from the rest of the
+tabs. The selected tab is drawn 2 pixels closer to the outside edge of the
+tabset than the unselected tabs. A value of true says to raise selected
+tabs, a value of false turns this off. The default is false. The value may
+have any of the forms accepted by the \fBTcl_GetBoolean\fR, such
+as \fBtrue\fR, \fBfalse\fR, \fB0\fR, \fB1\fR, \fByes\fR, or \fBno\fR.
+.LP
+.nf
+Name: \fBstart\fR
+Class: \fBStart\fR
+Command-Line Switch: \fB-start\fR
+.fi
+.IP
+Specifies the amount of space to place between the left or top edge of the
+tabset and the starting edge of its tabs. For horizontally positioned tabs,
+this is the amount of space between the left edge of the tabset and the left
+edge of the first tab. For vertically positioned tabs, this is the amount
+of space between the top of the tabset and the top of the first tab. This
+value may change if the user performs a MButton-2 scroll on the tabs. This
+value may have any of the forms acceptable to \fBTk_GetPixels\fR.
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Command-Line Switch: \fB-state\fR
+.fi
+.IP
+Sets the active state of the tabset. Specifying \fBnormal\fR allows all
+tabs to be selectable. Specifying \fBdisabled\fR disables the tabset
+causing all tabs to be drawn in the disabledForeground color.
+.LP
+.nf
+Name: \fBtabBorders\fR
+Class: \fBTabBorders\fR
+Command-Line Switch: \fB-tabborders\fR
+.fi
+.IP
+Specifies whether to draw the borders of tabs that are not selected.
+Specifying true (the default) draws these borders, specifying false
+draws only the border around the selected tab. The value may have any
+of the forms accepted by the \fBTcl_GetBoolean\fR, such
+as \fBtrue\fR, \fBfalse,\fR \fB0\fR, \fB1\fR, \fByes\fR, or \fBno\fR.
+.LP
+.nf
+Name: \fBtabPos\fR
+Class: \fBTabPos\fR
+Command-Line Switch: \fB-tabpos\fR
+.fi
+.IP
+Specifies the location of the set of tabs in relation to another widget. Must
+be \fBn\fR, \fBs\fR, \fBe\fR, or \fBw\fR. Defaults to \fBs\fR. North tabs
+open downward, South tabs open upward. West tabs open to the right, east
+tabs open to the left.
+.BE
+.SH DESCRIPTION
+.PP
+The \fBtabset\fR command creates a new window (given by the pathName
+argument) and makes it into a \fBtabset\fR widget. Additional \fIoptions\fR,
+described above may be specified on the command line or in the option
+database to configure aspects of the tabset such as its colors, font, and
+text. The \fBtabset\fR command returns its \fIpathName\fR argument. At the
+time this command is invoked, there must not exist a window
+named \fIpathName\fR, but pathName's parent must exist.
+.PP
+A \fBtabset\fR is a widget that contains a set of Tab buttons. It displays
+these tabs in a row or column depending on it tabpos. When a tab is
+clicked on, it becomes the only tab in the tab set that is selected. All
+other tabs are deselected. The Tcl command prefix associated with this
+tab (through the command tab configure option) is invoked with the tab
+index number appended to its argument list. This allows the tabset to
+control another widget such as a Notebook.
+.SH TABS
+Tabs are drawn to appear attached to another widget. The tabset draws an
+edge boundary along one of its edges. This edge is known as the attachment
+edge. This edge location is dependent on the value of \fBtabPos\fR. For
+example, if \fBtabPos\fR is \fBs\fR, the attachment edge wil be on the
+top side of the tabset (in order to attach to the bottom or south side of
+its attached widget). The selected tab is draw with a 3d relief to appear
+above the other tabs. This selected tab "opens" toward attachment edge.
+.PP
+Tabs can be controlled in their location along the edges, the angle that
+tab sides are drawn with, gap between tabs, starting margin of tabs,
+internal padding around labels in a tab, the font, and its text or bitmap.
+.SH "WIDGET-SPECIFIC METHODS"
+.PP
+The \fBtabset\fR command creates a new Tcl command whose name
+is \fIpathName\fR. This command may be used to invoke various operations on
+the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIoption\fR and the \fIarg\fRs
+determine the exact behavior of the command.
+.PP
+Many of the widget commands for a tabset take as one argument an indicator
+of which tab of the tabset to operate on. These indicators are called indexes
+and may be specified in any of the following forms:
+.TP
+\fInumber\fR
+Specifies the tab numerically, where 0 corresponds to the first tab in
+the tab set, 1 to the second, and so on.
+.TP
+\fBselect\fR
+Specifies the currently selected tab's index. If no tab is currently
+selected, the value -1 is returned.
+.TP
+\fBend\fR
+Specifes the last tab in the tabset's index. If the tabset is empty this
+will return -1.
+.TP
+\fIpattern\fR
+If the index doesn't satisfy any of the above forms, then this form is
+used. Pattern is pattern-matched against the label of each tab in the
+tabset, in order from the first to the last tab, until a matching entry is
+found. The rules of Tcl_StringMatch are used.
+.PP
+'.............................................................................
+The following commands are possible for tabset widgets:
+.RS
+.TP
+\fIpathName\fR \fBadd\fR ?\fIoption\fR \fIvalue\fR \fIoption\fR \fIvalue\fR ...?
+Add a new tab at the end of the tabset. Returns the child
+site \fIpathName\fR. If additional arguments are present, they specify
+any of the following options:
+.RS
+.TP
+\fB-angle\fR \fIvalue\fR
+Specifes the angle of slope from the inner edge to the outer edge of
+the tab. An angle of 0 specifies square tabs. Valid ranges are 0 to
+45 degrees inclusive. Default is 15 degrees. If this option is specified as
+an empty string (the default), then the angle option for the overall tabset
+is used.
+.TP
+\fB-background\fR \fIvalue\fR
+Specifies a background color to use for displaying tabs when they are in
+their normal state (unselected). If this option is specified as an empty
+string (the default), then the background option for the overall tabset is
+used.
+.TP
+\fB-bevelamount\fR \fIvalue\fR
+Specifes the size of tab corners. A value of 0 with angle set to 0 results
+in square tabs. A bevelAmount of 4, means that the tab will be drawn with
+angled corners that cut in 4 pixels from the edge of the tab. The default is
+0. This is generally only set at the tabset configuration level. Tabs
+normally will want to share the same bevelAmount.
+.TP
+\fB-bitmap\fR \fIvalue\fR
+If label is a non-empty string, specifies a bitmap to display in the
+tab. Bitmap may be of any of the forms accepted by Tk_GetBitmap.
+.TP
+\fB-disabledforeground\fR \fIvalue\fR
+Specifies a foreground color to use for displaying tab labels when tabs are
+in their disable state. If this option is specified as an empty
+string (the default), then the disabledforeground option for the overall
+tabset is used.
+.TP
+\fB-font\fR \fIvalue\fR
+Specifies the font to use when drawing the label on a tab. If this option
+is specified as an empty string then the font option for the overall
+tabset is used.
+.TP
+\fB-foreground\fR \fIvalue\fR
+Specifies a foreground color to use for displaying tab labels when tabs
+are in their normal unselected state. If this option is specified as an
+empty string (the default), then the foreground option for the overall
+tabset is used.
+.TP
+\fB-image\fR \fIvalue\fR
+If label is a non-empty string, specifies an image to display in the
+tab. Image must have been created with the image create command. Typically,
+if the image option is specified then it overrides other options that
+specify a bitmap or textual value to display in the widget; the image
+option may be reset to an empty string to re-enable a bitmap or text display.
+.TP
+\fB-label\fR \fIvalue\fR
+Specifies a text string to be placed in the tabs label. If this value is
+set, the bitmap option is overridden and this option is used instead. This
+label serves as an additional identifier used to reference the tab. This
+label may be used for the index value in widget commands.
+.TP
+\fB-selectbackground\fR \fIvalue\fR
+Specifies a background color to use for displaying the selected tab. If
+this option is specified as an empty string (the default), then the
+selectBackground option for the overall tabset is used.
+.TP
+\fB-selectforeground\fR \fIvalue\fR
+Specifies a foreground color to use for displaying the selected tab. If
+this option is specified as an empty string (the default), then the
+selectForeground option for the overall tabset is used.
+.TP
+\fB-padx\fR \fIvalue\fR
+Specifies a non-negative value indicating how much extra space to request
+for a tab around its label in the X-direction. When computing how large
+a window it needs, the tab will add this amount to the width it would
+normally need The tab will end up with extra internal space to the left
+and right of its text label. This value may have any of the forms acceptable
+to Tk_GetPixels. If this option is specified as an empty string (the
+default), then the padX option for the overall tabset is used
+.TP
+\fB-pady\fR \fIvalue\fR
+Specifies a non-negative value indicating how much extra space to request
+for a tab around its label in the Y-direction. When computing how large
+a window it needs, the tab will add this amount to the height it would
+normally need The tab will end up with extra internal space to the top
+and bottom of its text label. This value may have any of the forms
+acceptable to Tk_GetPixels. If this option is specified as an empty
+string (the default), then the padY option for the overall tabset is used
+.TP
+\fB-state\fR \fIvalue\fR
+Sets the state of the tab. Specifying normal allows this tab to be
+selectable. Specifying disabled disables the this tab causing its tab label
+to be drawn in the disabledForeground color. The tab will not respond to
+events until the state is set back to normal.
+.RE
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue\fR \fIoption\fR \fIvalue\fR ...?
+Query or modify the configuration options of the widget. If no \fIoption\fR
+is specified, returns a list describing all of the available options
+for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for information on the
+format of this list). If option is specified with no value, then the
+command returns a list describing the one named option (this list will be
+identical to the corresponding sublist of the value returned if no option
+is specified). If one or more option-value pairs are specified, then the
+command modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have any
+of the values accepted by the tabset command.
+.TP
+\fIpathName\fR \fBdelete\fR \fIindex1\fR ?\fIindex2\fR?
+Delete all of the tabs between \fIindex1\fR and \fIindex2\fR inclusive.
+If \fIindex2\fR is omitted then it defaults to \fIindex1\fR. Returns an
+empty string.
+.TP
+\fIpathName\fR \fBindex\fR \fIindex\fR
+Returns the numerical index corresponding to \fIindex\fR.
+.TP
+\fIpathName\fR \fBinsert\fR \fIindex\fR ?\fIoption\fR \fIvalue\fR \fIoption\fR \fIvalue\fR ...?
+Insert a new tab in the tabset before the tab specified by \fIindex\fR. The
+additional arguments are the same as for the \fBadd\fR command. Returns
+the tab's \fIpathName\fR.
+.TP
+\fIpathName\fR \fBnext\fR
+Advances the selected tab to the next tab (order is determined by insertion
+order). If the currently selected tab is the last tab in the tabset, the
+selection wraps around to the first tab. It behaves as if the user
+selected the next tab.
+.TP
+\fIpathName\fR \fBtabconfigure\fR \fIindex\fR ?\fIoption\fR? ?\fIvalue\fR?
+This command is similar to the \fBconfigure\fR command, except that it
+applies to the options for an individual tab, whereas configure applies to
+the options for the tabset as a whole. Options may have any of the values
+accepted by the \fBadd\fR widget command. If options are specified, options
+are modified as indicated in the command and the command returns an empty
+string. If no options are specified, returns a list describing the current
+options for tab index (see \fBTk_ConfigureInfo\fR for information on
+the format of this list).
+.TP
+\fIpathName\fR \fBprev\fR
+Moves the selected tab to the previous tab (order is determined by insertion
+order). If the currently selected tab is the first tab in the tabset, the
+selection wraps around to the last tab in the tabset. It behaves as if
+the user selected the previous tab.
+.TP
+\fIpathName\fR \fBselect\fR \fIindex\fR
+Selects the tab specified by \fIindex\fR as the currently selected tab. It
+behaves as if the user selected the new tab.
+
+.SH EXAMPLE
+.PP
+Following is an example that creates a tabset with two tabs and a list box
+that the tabset controls. In addition selecting an item from the list
+also selects the corresponding tab.
+.PP
+.nf
+.IP
+.ta 2c 8c 12c
+# Define a proc that knows how to select an item
+# from a list given an index from the tabset -command callback.
+ proc selectItem { item } {
+ .l selection clear [.l curselection]
+ .l selection set $item
+ .l see $item
+}
+.IP
+# Define a proc that knows how to select a tab
+# given a y pixel coordinate from the list..
+ proc selectTab { y } {
+ set whichItem [.l nearest $y]
+ .ts select $whichItem
+}
+.IP
+# Create a listbox with two items (one and two)
+# and bind button 1 press to the selectTab procedure.
+ listbox .l -selectmode single -exportselection false
+ .l insert end one
+ .l insert end two
+ .l selection set 0
+ pack .l
+ bind .l <ButtonPress-1> { selectTab %y }
+.IP
+# Create a tabset, set its -command to call selectItem
+# Add two labels to the tabset (one and two).
+ tabset .ts -command selectItem
+ .ts add -label 1
+ .ts add -label 2
+ .ts select 0
+ pack .ts -fill x -expand no
+.fi
+.SH AUTHOR
+Bill W. Scott
+.SH KEYWORDS
+tab tabset notebook tabnotebook
diff --git a/itcl/iwidgets3.0.0/doc/timeentry.n b/itcl/iwidgets3.0.0/doc/timeentry.n
new file mode 100644
index 00000000000..4f570afc326
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/timeentry.n
@@ -0,0 +1,194 @@
+'\"
+'\" Copyright (c) 1997 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) timeentry.n 1.0 97/04/30 16:04:44
+'/"
+.so man.macros
+.HS timeentry iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+timeentry \- Create and manipulate a timeentry widget
+.SH SYNOPSIS
+\fBtimeentry\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- LabeledWidget <- Timefield <- Timeentry
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBborderWidth\fR \fBcursor\fR \fBexportSelection\fR
+\fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR \fBinsertBackground\fR
+\fBjustify\fR \fBrelief\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBdisabledForeground\fR \fBlabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR
+\fBlabelMargin\fR \fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR
+\fBstate\fR
+.fi
+.LP
+See the "labeledwidget" class manual entry for details on these
+inherited options.
+.LP
+.nf
+.ta 4c 8c 12c
+\fBcommand\fR \fBformat\fR \fBseconds\fR \fBtextBackground\fR
+\fBtextFont\fR
+.fi
+.LP
+See the "timefield" class manual entry for details on these
+inherited options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBhourRadius\fR \fBhourColor\fR \fBminuteRadius\fR \fBminuteColor\fR
+\fBpivotRadius\fR \fBpivotColor\fR \fBsecondRadius\fR \fBsecondColor\fR
+\fBclockColor\fR \fBclockStipple\fR \fBtickColor\fR \fBwatchHeight\fR
+\fBwatchWidth\fR
+.fi
+.LP
+See the "watch" manual entry for details on the associated options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBcloseText\fR
+Class: \fBText\fR
+Command-Line Switch: \fB-closetext\fR
+.fi
+.IP
+Specifies the text to be displayed on the close button of the watch
+popup. The default is Close.
+.LP
+.nf
+Name: \fBgrab\fR
+Class: \fBGrab\fR
+Command-Line Switch: \fB-grab\fR
+.fi
+.IP
+Specifies the grab level, \fBlocal\fR or \fBglobal\fR, to be obtained before
+bringing up the popup watch. The default is global. For more information
+concerning grab levels, consult the documentation for Tk's \fBgrab\fR command.
+.LP
+.nf
+Name: \fBicon\fR
+Class: \fBIcon\fR
+Command-Line Switch: \fB-icon\fR
+.fi
+.IP
+Specifies the watch icon image to be used in the timeentry.
+This image must have been created previously with
+the \fBimage create\fR command. Should one not be provided,
+then one will be generated, pixmap if possible, bitmap otherwise.
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Command-Line Switch: \fB-state\fR
+.fi
+.IP
+Specifies the state of the widget which may be \fBdisabled\fR or
+\fBnormal\fR. A disabled state prevents selection of the timefield
+or time icon button.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBtimeentry\fR command creates a time entry field
+with a popup watch by combining the timefield and watch
+widgets together. This allows a user to enter the time via the
+keyboard or by using the mouse and selecting the watch icon
+which brings up a popup watch.
+.DE
+
+.SH "METHODS"
+.PP
+The \fBtimeentry\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for timeentry widgets:
+.SH "INHERITED METHODS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBget\fR \fBisvalid\fR \fBshow\fR
+.fi
+.LP
+See the "timefield" manual entry for details on the associated methods.
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBtimeentry\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBtimeentry\fR
+command.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBlabel\fR
+Class: \fBLabel\fR
+.fi
+.IP
+The label component provides a label component to used to identify the time.
+See the "label" widget manual entry for details on the label component item.
+.LP
+.nf
+Name: \fBiconbutton\fR
+Class: \fBLabel\fR
+.fi
+.IP
+The iconbutton component provides a labelbutton component to act as a
+lightweight button
+displaying the watch icon. Upon pressing the labelbutton, the watch
+appears. See the "label" widget manual entry for details on the
+labelbutton component item.
+.LP
+.nf
+Name: \fBtime\fR
+Class: \fBEntry\fR
+.fi
+.IP
+The time component provides the entry field for time input and display.
+See the "entry" widget manual entry for details on the time component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ timeentry .te
+ pack .te
+.DE
+.SH AUTHOR
+Mark L. Ulferts
+.LP
+.SH KEYWORDS
+timeentry, widget
diff --git a/itcl/iwidgets3.0.0/doc/timefield.n b/itcl/iwidgets3.0.0/doc/timefield.n
new file mode 100755
index 00000000000..39227b0a04f
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/timefield.n
@@ -0,0 +1,175 @@
+'\"
+'\" Copyright (c) 1997 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) timefield.n 1.0 97/04/30 16:04:44
+'/"
+.so man.macros
+.HS timefield iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+timefield \- Create and manipulate a time field widget
+.SH SYNOPSIS
+\fBtimefield\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- LabeledWidget <- timefield
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBborderWidth\fR \fBcursor\fR \fBexportSelection\fR
+\fBforeground\fR \fBhighlightColor\fR \fBhighlightThickness\fR \fBinsertBackground\fR
+\fBjustify\fR \fBrelief\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "INHERITED OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBdisabledForeground\fR \fBlabelBitmap\fR \fBlabelFont\fR \fBlabelImage\fR
+\fBlabelMargin\fR \fBlabelPos\fR \fBlabelText\fR \fBlabelVariable\fR
+\fBstate\fR
+.fi
+.LP
+See the "labeledwidget" class manual entry for details on the
+inherited options.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBchildSitePos\fR
+Class: \fBPosition\fR
+Command-Line Switch: \fB-childsitepos\fR
+.fi
+.IP
+Specifies the position of the child site in the time field: \fBn\fR,
+\fBs\fR, \fBe\fR, or \fBw\fR. The default is e.
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Command-Line Switch: \fB-command\fR
+.fi
+.IP
+Specifies a Tcl command to be executed upon detection of a Return key
+press event.
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Command-Line Switch: \fB-state\fR
+.fi
+.IP
+Specifies one of two states for the timefield: \fBnormal\fR or \fBdisabled\fR.
+If the timefield is disabled then input is not accepted. The default is
+normal.
+.LP
+.nf
+Name: \fBtextBackground\fR
+Class: \fBBackground\fR
+Command-Line Switch: \fB-textbackground\fR
+.fi
+.IP
+Background color for inside textual portion of the entry field. The value
+may be given in any of the forms acceptable to \fBTk_GetColor\fR.
+.LP
+.nf
+Name: \fBtextFont\fR
+Class: \fBFont\fR
+Command-Line Switch: \fB-textfont\fR
+.fi
+.IP
+Name of font to use for display of text in timefield. The value
+may be given in any of the forms acceptable to \fBTk_GetFont\fR.
+.LP
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBtimefield\fR command creates an enhanced text entry widget for
+the purpose of time entry with various degrees of built-in intelligence.
+.DE
+
+.SH "METHODS"
+.PP
+The \fBtimefield\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for timefield widgets:
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBtimefield\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBtimefield\fR
+command.
+.TP
+\fIpathName \fBget\fR ?\fBformat\fR?
+Returns the current contents of the timefield in a format of
+string or as an integer clock value using the \fB-string\fR and \fB-clicks\fR
+format options respectively. The default is by string. Reference the
+clock command for more information on obtaining times and their
+formats.
+.TP
+\fIpathName \fBisvalid\fR
+Returns a boolean indication of the validity of the currently
+displayed time value. For example, 12:59:59 is valid whereas
+25:59:59 is invalid.
+.TP
+\fIpathName \fBshow\fR \fItime\fR
+Changes the currently displayed time to be that of the time
+argument. The time may be specified either as a string, an
+integer clock value or the keyword "now" (the default).
+Reference the clock command for more information on obtaining
+times and their formats.
+
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBtime\fR
+Class: \fBEntry\fR
+.fi
+.IP
+The time component provides the entry field for time input and display.
+See the "entry" widget manual entry for details on the time component item.
+.fi
+
+.SH EXAMPLE
+.DS
+ proc returnCmd {} {
+ puts [.tf get]
+ }
+
+ timefield .tf -command returnCmd
+ pack .tf -fill x -expand yes -padx 10 -pady 10
+.DE
+.SH AUTHOR
+John A. Tucker
+.DE
+Mark L. Ulferts
+.LP
+.SH KEYWORDS
+timefield, widget
diff --git a/itcl/iwidgets3.0.0/doc/tk2html b/itcl/iwidgets3.0.0/doc/tk2html
new file mode 100755
index 00000000000..089a419c24c
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/tk2html
@@ -0,0 +1,46 @@
+#!/bin/sh
+# filter to convert Tk and Tcl man pages to html equivalents
+# does not do any linking !!!!
+
+TOP=`pwd`
+if [ $# -eq 0 ] ; then
+ echo "Usage $0 filename"
+ exit
+fi
+
+cat $1 |
+ sed -e 's/\\-/-/g' \
+ -e 's/\\[0&]/ /g' \
+ -e 's/&/\&amp;/g' \
+ -e 's/</\&lt;/g' \
+ -e 's/>/\&gt;/g' \
+ -e 's/\\|//g' \
+ -e 's/\\e/\\/g' |
+ /usr/bin/nawk -f ${TOP}/tk2html.awk |
+ sed -e 's^\\fB\([^\\]*\)\\fR^<B>\1</B>^g' \
+ -e 's^\\fI\(.[^\\]*\)\\fR^<I>\1</I>^g' \
+ -e 's^\\fB^<B>^g' \
+ -e 's^\\fI^<I>^g' \
+ -e 's^\\f[RP]^</B></I>^g' \
+ -e 's/^.[LP]P/<P>/' \
+ -e 's/^.br/<BR>/' \
+ -e 's/^\.DS.*/<pre>/' \
+ -e 's$^\.DE.*$</pre>$' \
+ -e 's/^\.nf */<table>/' \
+ -e 's$^\.fi *$</table>$' \
+ -e 's$^\.BE *$</pre><HR>$' \
+ -e 's/^\.RS.*/<UL>/' \
+ -e 's$^\.RE.*$</UL>$' \
+ -e 's^\.SH *"*\([^"]*\)"*^</pre><H2>\1</H2>^' \
+ -e 's/^\.[a-zA-Z]*.*//' \
+ -e 's/^`\\\".*//' |
+ /usr/bin/nawk -f ${TOP}/tk2html2.awk
+
+# The above handling for font mapping to html works correctly in about 95% of
+# the cases, the others turn out stacking the font setting so you get the
+# font bleeding since it isn't being turned # off in the correct places.
+# To correct we would have to record the current ( non-default) font and
+# explicitly turn it off when another font change is detected.
+# Which would make multiple styles impossible concurrently which seems to
+# be the case anyway....
+
diff --git a/itcl/iwidgets3.0.0/doc/tk2html.awk b/itcl/iwidgets3.0.0/doc/tk2html.awk
new file mode 100755
index 00000000000..dd88000831a
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/tk2html.awk
@@ -0,0 +1,320 @@
+#!/bin/nawk
+
+
+$0 ~ /'[\/\\]" */ || $1 == "'" { next } # eat [nt]roff comments
+
+# defining macros - eat them
+/^\.de.*/ {
+ getline
+ while ( $0 !~ "^\.\.$" )
+ {
+ getline
+ }
+ getline
+ }
+
+$1 == ".VS" || $1 == ".VE" || $1 == ".AS" { next }
+
+
+# handle first .SH as special case - .SH NAME
+/^.SH *NAME */ {
+ getline
+ while ( $0 ~ /\.[a-zA-Z].*/ ) # eat dot-cmd following title
+ {
+ getline
+ }
+ print "<TITLE>" $0 "</TITLE>"
+ print "<H1>" $0 "</H1>\n"
+ next
+
+#-e 's/^.SH *NAME */{N;s#.*\n\(.*\)#<H1>\1</H1>#;}' \
+ }
+
+
+# Convert .IP Paragraphs upto next .cmd to hanging indents
+# using <UL></UL> pairs without intervening <LI>
+
+/^\.IP */ {
+ if ( inIP > 0 )
+ {
+ print "</UL>"
+ }
+ inIP = 1
+ print "<UL>"
+ match($0, /".*"/ )
+ if ( RSTART > 0 )
+ {
+ arg = substr( $0, RSTART+1, RLENGTH-2)
+
+ print arg " <BR>"
+ }
+ else if ( length( $2 ) > 0 )
+ {
+ print $2 " <BR>"
+ }
+ next
+ }
+
+$0 ~ /^\.[a-zA-Z]*/ && inIP > 0 {
+ inIP = 0
+ print "</UL>"
+ }
+
+# Convert
+# .TP
+# Line1
+# line 2 - n
+# .Any
+#
+# to
+# <DL>
+# <DT> Line1
+# <DD> lines 2 - n
+# <DT>
+
+/^\.TP */ {
+ if ( inTP > 0 )
+ {
+ print "</DL>"
+ }
+ inTP = 1
+ print "<DL>"
+ next
+ }
+
+inTP == 1 && $1 !~ /\.[a-zA-Z]*/ {
+ print "<DT> " $0
+ inTP = 2
+ next
+ }
+
+inTP == 2 && $1 !~ /\.[a-zA-Z]*/{
+ print "</I></B>" # Belt and suspenders
+ print "<DD> " $0
+ inTP = 3
+ next
+ }
+
+$0 ~ /^\.[a-zA-Z]*/ && inTP > 0 {
+ inTP = 0
+ print "</DL>"
+ }
+
+
+
+$1 == ".AP" {
+ $1=""
+ print "<DL >"
+ print "<DT> " $2 "\t\t" $3 "\t\t("$4")"
+ inTP = 2
+ next
+ }
+
+# make a blank line
+$1 == ".sp" {
+ print "<BR>"
+ next # print "<BR>"
+ }
+
+
+$1 == ".ta" { next }
+
+
+# try and make links ( tk )
+# "See the .* manual entry"
+
+/"options"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"options\"", "<A HREF=\"http://www.sco.com/Technology/tcl/man/tk_man/options.n.html\"> \"options\" </A>")
+ }
+
+/"entry"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"entry\"", "<A HREF=\"http://www.sco.com/Technology/tcl/man/tk_man/entry.n.html\"> \"entry\" </A>")
+ }
+
+/"button"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"button\"", "<A HREF=\"http://www.sco.com/Technology/tcl/man/tk_man/button.n.html\"> \"button\" </A>")
+ }
+
+/"scrollbar"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"scrollbar\"", "<A HREF=\"http://www.sco.com/Technology/tcl/man/tk_man/scrollbar.n.html\"> \"scrollbar\" </A>")
+ }
+
+/"listbox"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"listbox\"", "<A HREF=\"http://www.sco.com/Technology/tcl/man/tk_man/listbox.n.html\"> \"listbox\" </A>")
+ }
+
+/"canvas"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"canvas\"", "<A HREF=\"http://www.sco.com/Technology/tcl/man/tk_man/canvas.n.html\"> \"canvas\" </A>")
+ }
+
+/"text"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"text\"", "<A HREF=\"http://www.sco.com/Technology/tcl/man/tk_man/text.n.html\"> \"text\" </A>")
+ }
+
+/"license.terms"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"license\".terms", "<A HREF=\"legal.html\"> license.\"terms\" </A>")
+ }
+
+/"buttonbox"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"buttonbox\"", "<A HREF=\"buttonbox.n.html\"> \"buttonbox\" </A>")
+ }
+
+/"combobox"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"combobox\"", "<A HREF=\"combobox.n.html\"> \"combobox\" </A>")
+ }
+
+/"dialog"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"dialog\"", "<A HREF=\"dialog.n.html\"> \"dialog\" </A>")
+ }
+
+/"dialogshell"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"dialogshell\"", "<A HREF=\"dialogshell.n.html\"> \"dialogshell\" </A>")
+ }
+
+/"entryfield"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"entryfield\"", "<A HREF=\"entryfield.n.html\"> \"entryfield\" </A>")
+ }
+
+/"fileselectionbox"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"fileselectionbox\"", "<A HREF=\"fileselectionbox.n.html\"> \"fileselectionbox\" </A>")
+ }
+
+/"fileselectiondialog"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"fileselectiondialog\"", "<A HREF=\"fileselectiondialog.n.html\"> \"fileselectiondialog\" </A>")
+ }
+
+/"labeledwidget"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"labeledwidget\"", "<A HREF=\"labeledwidget.n.html\"> \"labeledwidget\" </A>")
+ }
+
+/"messagedialog"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"messagedialog\"", "<A HREF=\"messagedialog.n.html\"> \"messagedialog\" </A>")
+ }
+
+/"optionmenu"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"optionmenu\"", "<A HREF=\"optionmenu.n.html\"> \"optionmenu\" </A>")
+ }
+
+/"panedwindow"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"panedwindow\"", "<A HREF=\"panedwindow.n.html\"> \"panedwindow\" </A>")
+ }
+
+/"promptdialog"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"promptdialog\"", "<A HREF=\"promptdialog.n.html\"> \"promptdialog\" </A>")
+ }
+
+/"pushbutton"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"pushbutton\"", "<A HREF=\"pushbutton.n.html\"> \"pushbutton\" </A>")
+ }
+
+/"scrolledcanvas"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"scrolledcanvas\"", "<A HREF=\"scrolledcanvas.n.html\"> \"scrolledcanvas\" </A>")
+ }
+
+/"scrolledframe"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"scrolledframe\"", "<A HREF=\"scrolledframe.n.html\"> \"scrolledframe\" </A>")
+ }
+
+/"scrolledlistbox"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"scrolledlistbox\"", "<A HREF=\"scrolledlistbox.n.html\"> \"scrolledlistbox\" </A>")
+ }
+
+/"scrolledtext"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"scrolledtext\"", "<A HREF=\"scrolledtext.n.html\"> \"scrolledtext\" </A>")
+ }
+
+/"selectionbox"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"selectionbox\"", "<A HREF=\"selectionbox.n.html\"> \"selectionbox\" </A>")
+ }
+
+/"selectiondialog"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"selectiondialog\"", "<A HREF=\"selectiondialog.n.html\"> \"selectiondialog\" </A>")
+ }
+
+/"spindate"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"spindate\"", "<A HREF=\"spindate.n.html\"> \"spindate\" </A>")
+ }
+
+/"spinint"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"spinint\"", "<A HREF=\"spinint.n.html\"> \"spinint\" </A>")
+ }
+
+/"spinner"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"spinner\"", "<A HREF=\"spinner.n.html\"> \"spinner\" </A>")
+ }
+
+/"spintime"/ {
+ if ( $0 ~ /^See the .*/ )
+ sub("\"spintime\"", "<A HREF=\"spintime.n.html\"> \"spintime\" </A>")
+ }
+
+/^Name: */ {
+ print $1 " " $2
+ next
+ }
+
+/^Class: */ {
+ print $1 " " $2
+ next
+ }
+
+/^Bret A. Schuhmacher*/ {
+ print "<A HREF=\"mailto:bas@wn.com\">" $0 "</A>"
+ next
+ }
+
+/^John S. Sigler*/ {
+ print "<A HREF=\"mailto:jsigler@spd.dsccc.com\">" $0 "</A>"
+ next
+ }
+
+/^Mark L. Ulferts*/ {
+ print "<A HREF=\"mailto:mulferts@spd.dsccc.com\">" $0 "</A>"
+ next
+ }
+
+/^Alfredo Jahn*/ {
+ print "<A HREF=\"mailto:ajahn@spd.dsccc.com\">" $0 "</A>"
+ next
+ }
+
+/^Sue Yockey*/ {
+ print "<A HREF=\"mailto:syockey@spd.dsccc.com\">" $0 "</A>"
+ next
+ }
+
+# just pass everything else on
+
+ { print $0 }
+
+
diff --git a/itcl/iwidgets3.0.0/doc/tk2html.perl b/itcl/iwidgets3.0.0/doc/tk2html.perl
new file mode 100755
index 00000000000..c5474df5701
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/tk2html.perl
@@ -0,0 +1,337 @@
+#!/usr/local/bin/perl
+# Lightly modified man2html to make html equivs of tk/tcl man pages
+# probably a dead end soln since works on output after troff processing
+
+
+# Set the man path array to the paths to search...
+@manpath = ('/usr/share/man','/usr/gnu/man','/usr/local/man');
+#@manpath = ('/s/usr/hops/src/ftp/tcl/tk3.4/docs');
+
+# There has to be a blank line after this...
+#print "Content-type:text/html\n\n";
+
+if (!$ARGV[0]) {
+ print "<isindex>\n";
+ chop($os = `uname`);
+ chop($ver = `uname -r`);
+ print "
+<title> $os $ver Manual Pages </title>
+<h1> $os $ver Manual Pages </h1>
+
+Enter the name of the man page, optionally surrounded
+by parenthesis with the number. For example:
+<p>
+<ul>
+<li> stat to find one or more man pages for ls
+<li> stat(2) for the system call stat
+</ul>
+
+This converter is still in development. I intend to
+improve the handling of multiple matches, and add
+a interface to apropos (or man -k (or whatis...))
+<p>
+<a href=\"/users/bcutter/intro.html\">Brooks Cutter</a>
+";
+ exit(0);
+}
+
+$_ = $ARGV[0];
+$manpages[0] = $_;
+if ((/^-$/)) {
+ $manpages[0] = $_;
+} elsif ((m!^/!)) {
+ $manpages[0] = $_;
+#} elsif (($name, $sect) = /(\S+)\((\d.*)\)/) {
+# @manpages = &findman($name, $sect, @manpath);
+#} elsif (($name, $sect) = /(\S+)<(\d.*)>/) {
+# @manpages = &findman($name, $sect, @manpath);
+#} elsif (($name, $sect) = /(\S+)\[(\d.*)\]/) {
+# @manpages = &findman($name, $sect, @manpath);
+#} else {
+# @manpages = &findman($_, '', @manpath);
+}
+
+if (!scalar @manpages) {
+ print "Sorry, I was unable to find a match for <b>$_</b>\n";
+ exit(0);
+} elsif (scalar @manpages > 1) {
+ &which_manpage(@manpages);
+} else {
+ if (!-e $manpages[0]) {
+ die "man2html: Error, Can't locate file '$manpages[0]'\n";
+ }
+ chop($type=`file -L $manpages[0]`);
+ if ($type =~ /roff/i) {
+ $manpages[0] = "nroff -man $manpages[0]|col -b|";
+ } elsif ($type =~ /text/i) {
+# #$manpages[0] = $manpages[0];
+# ; # NOP (No Operation)
+ $manpages[0] = "nroff -man $manpages[0]| col -b|";
+ } else {
+ print "
+<title>Man2HTML: An Error has occurred</title>
+<h1>Man2HTML: An Error has occurred</h1>
+
+man2html found the following match for your query:</hr>
+$manpages[0]
+<p>
+When 'file -L $manpages[0]' was run
+(which should follow symbolic links)
+it returned the following value '$type'
+<p>
+
+";
+ if ($type =~ /link/i) {
+ print "
+This problem appears to be that there is a symbolic link
+for a man page that is pointing to a file that doesn't exist.
+<p>
+";
+ }
+ print "
+Please report this problem to someone who can do something about it.
+<i>(Assuming you aren't that person...)</i>
+If you don't know who that is, try emailing 'root' or 'postmaster'.
+<p>
+There was only one match for your query - and it can't currently
+be accessed.
+";
+ exit(0);
+ #die "Unknown type '$type' for manpage '$manpages[0]'";
+ }
+ &print_manpage($manpages[0]);
+}
+
+exit(0);
+
+sub findman {
+# Take a argument like 'ls' or 'vi(1)' or 'tip(1c)' and return
+# a list of one or more manpages.
+# Arguments 2- are the directories to search in
+ local($lookfor) = shift(@_);
+ local($section) = shift(@_);
+ local($file, @files, @return, $return);
+ local(%men,%man);
+ die "lookfor($lookfor) is null\n" unless($lookfor);
+ for (@_) {
+ # I'm... too lazy... for... opendir()... too lazy for readdir()...
+ # too lazy for closedir() ... I'm too lazy!
+ if (!$section) {
+ @files = `/bin/ls $_/*/$lookfor.* 2> /dev/null`;
+ } else {
+ # if the section is like '1b' then just search *1b
+ # otherwise if '1' search *1* (to catch all sub-sections)
+ # Reason for wildcards: ($_/*$section*/$lookfor.*)
+ # (given $section = '2')
+ # 1st: So it catches cat2 and man2
+ # 2nd: So it catches man2 and man2v
+ # (This should make it compatiable with HP/UX's man2.Z - not tested)
+ # 3rd: So it catches stat.2 and stat.2v
+ #
+ if (length($section) == 1) {
+ @files = `/bin/ls $_/*$section*/$lookfor.* 2> /dev/null`;
+ } else {
+ local($section_num) = substr($section, 0, 1); # Just the number...
+ @files = `/bin/ls $_/*$section_num*/$lookfor.* $_/*$section/$lookfor.* 2> /dev/null`;
+ }
+ }
+ next if (!scalar @files);
+ # This part checks the files that were found...
+ for $file (@files) {
+ chop($file);
+ local(@dirs) = split(/\//,$file);
+ local($fn) = pop(@dirs);
+ local($catman) = pop(@dirs);
+ local($dir) = join('/',@dirs);
+ local($key) = "$dir/$fn";
+ next if ($man{$key}); # forces unique
+ if (!$men{$key}) {
+ $men{$key} = $catman;
+ $man{$key} = $file;
+ } else {
+ # pre-formatted man pages always take precedence unless zero bytes...
+ next if (($men{$key} =~ /^cat/i) && (!(-z $man{$key})));
+ $men{$key} = $catman;
+ $man{$key} = $file;
+ }
+ }
+ }
+ return(values %man);
+}
+
+
+sub which_manpage {
+# Print a list of manpages...
+ print "
+There were multiple matches for the argument '$ARGV[0]'.
+Below are the fully qualified pathnames of the matches, please
+click on the appropriate one.
+
+<ul>
+";
+ for (@_) {
+ print "<li><a href=\"/htbin/man2html?$_\">$_</a>\n";
+ }
+ print "</ul>\n";
+ return;
+}
+
+sub print_manpage {
+ local($page) = @_;
+ local($label, $before, $after, $begtag, $endtag, $blanks, $begtag2, $endtag2);
+ local($pre);
+ local($standard_indent) = 0;
+
+ if ($page eq '-') {
+ open(MAN, '-');
+ } elsif (index($page,'|') == length($page)) {
+ # A Pipe
+ local($eval) =
+'open(MAN, "'.$page.'") || die "Can'."'t open pipe to '$page' for reading: ".'$!";';
+ eval($eval);
+ die "Eval error line $. : '$eval' returned '$@' : $!\n";
+ } else {
+ open(MAN, $page) || die "Can't open '$page' for reading: $!";
+ }
+ while (<MAN>) {
+ s/\|\|*[ ]*$//; # Delete trailing change bars
+
+ if (/^\s*$/) {
+ $blanks++;
+ #if ($pre) { print "</pre>\n"; $pre = 0; }
+ if (($. != 1) && ($blanks == 1)) {
+ if (($pre) || ($section_pre)) {
+ print "\n";
+ } else {
+ print "<p>\n";
+ }
+ }
+ next;
+ }
+ #next if (!/^[A-Z]{2,}\(.*\).*/);
+ if (//) { s/.//g; }
+ # Escape & < and >
+ s/&/\&amp;/g;
+ s/</\&lt;/g;
+ s/>/\&gt;/g;
+ #
+ if (/^(\w+.*)\s*$/) {
+ $label = $1;
+ $next_action = '';
+ if (/^[A-Z ]{2,}\s*$/) {
+ if (($pre) || ($section_pre)) { print "</pre>\n"; }
+ $pre = $section_pre = $section_fmt = 0;
+ if (!$standard_indent) { $next_action = 'check_indent'; }
+ }
+ if ($label eq 'NAME') {
+ $begtag = '<title>';
+ $endtag = '</title>';
+ $begtag2 = '<h1>';
+ $endtag2 = '</h1>';
+ $next_action = 'check_indent';
+ next;
+ }
+ if ($label eq 'SYNOPSIS') {
+ $section_fmt = 1;
+ }
+ if ($label eq 'SEE ALSO') {
+ $next_action = 'create_links';
+ }
+ if (($label =~ /OPTIONS$/) || ($label eq 'FILES')) {
+ $section_pre = 1;
+ print "</pre>\n";
+# print "</pre OPTION>\n";
+ } elsif (/^[A-Z ]+\s*$/) {
+ print "</pre>\n" if (($pre) || ($section_pre));
+ $section_pre = 0;
+ }
+print "..$label..\n";
+ if (/^[-A-Z ]+\s*$/) {
+ print "<h2>$label</h2>\n";
+ $blanks = 0;
+ print "<pre>\n" if ($section_pre);
+ next;
+ }
+ next;
+ }
+ if ($section_fmt) { print; $blanks = 0; next; }
+ if ($next_action eq 'create_links') {
+ # Parse see also looking for man page links. Make it
+ # call this program. use '+' notation for spaces
+ local($page);
+ local($first) = 1;
+ for $page (split(/,/)) {
+ $page =~ tr/\x00-\x20//d; # Delete all control chars, spaces
+ if ($page =~ /.+\(\d.*\).*$/) {
+ $url_page = $page;
+ $url_page =~ tr/()/[]/;
+ print "," if (!$first);
+ $first = 0;
+ print "<a href=\"/tk2html?$url_page\">$page</a>\n";
+ } else {
+ print "," if (!$first);
+ $first = 0;
+ print "$page";
+ }
+ }
+ next;
+ }
+ # This is to detect preformatted blocks. I look at the first
+ # line after header 'DESCRIPTION' and count the leading white
+ # space as the "standard indent". If I encounter a line with
+ # a indent greater than the value of standard_indent then
+ # surround it with <pre> and </pre>
+ if ($next_action eq 'check_indent') {
+ if (/^(\s+)\S+.*/) {
+ $standard_indent = length($1);
+ $next_action = '';
+ }
+ }
+ #
+ $before = length($_);
+ $saved = $_;
+ s/^[ ][ ]*//; # Delete leading whitespace
+ $after = length($_);
+ s/[ ][ ]*$//; # Delete trailing whitespace
+
+ if ($begtag) {
+ chop;
+ print "$begtag$_$endtag\n";
+ print "$begtag2$_$endtag2\n" if ($begtag2);
+ $blanks = 0;
+ $begtag2 = $endtag2 = $begtag = $endtag = '';
+ next;
+ }
+ if ((!$section_fmt) && (!$section_pre) && ($standard_indent)) {
+ if (($blanks == 1) && (!$pre) && ($after + $standard_indent) < $before) {
+ $pre = 1;
+ print "<pre>\n";
+ } elsif (($pre) && ($after + $standard_indent) >= $before) {
+ $pre = 0;
+ print "</pre>\n";
+ }
+ }
+ if (($section_pre) || ($pre)) {
+ print "$saved";
+ $blanks = 0;
+ next;
+ }
+ # Handle word cont-
+ # inuations
+ if ($prefix) {
+ print $prefix;
+ $prefix = '';
+ }
+ if (/^(.+)\s+(\w+)\-\s*$/) {
+ $prefix = $2;
+ print "$1\n";
+ $blanks = 0;
+ next;
+ }
+ print;
+ $blanks = 0;
+ }
+ close(MAN);
+}
+
+# EOF
diff --git a/itcl/iwidgets3.0.0/doc/tk2html2.awk b/itcl/iwidgets3.0.0/doc/tk2html2.awk
new file mode 100755
index 00000000000..0134df1ad3c
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/tk2html2.awk
@@ -0,0 +1,53 @@
+#!/bin/nawk
+# cleans up any leading crap before <TITLE> line in stream from tk2html
+
+/^<TITLE>/ { go = 1 }
+
+/^<table>*/ {
+ getline ln
+ numf = split (ln, spln)
+
+ if ( ln !~ "Name: *" )
+ {
+ ind = 0
+ inc = 4
+ print "<table cellpadding=5>"
+
+ while ( ln !~ "^</table>" )
+ {
+ for (i = 1; i <= numf; i++)
+ {
+ tablns[ind] = spln[i]
+ ind++
+ }
+ getline ln
+ numf = split (ln, spln)
+ }
+
+ for (i = 0; i < inc; i++)
+ {
+ print "<td valign=top>"
+ for (j = i; j < ind; j += inc)
+ print tablns[j] "<br>"
+ print "</td>"
+ }
+
+ print "</table>"
+ }
+
+ else
+ {
+ print "<pre>"
+ while ( ln !~ "^</table>" )
+ {
+ print ln
+ getline ln
+ }
+ print "</pre>"
+ }
+
+ next
+ }
+
+go == 1 { print $0 }
+
diff --git a/itcl/iwidgets3.0.0/doc/toolbar.n b/itcl/iwidgets3.0.0/doc/toolbar.n
new file mode 100644
index 00000000000..da48f16f7a2
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/toolbar.n
@@ -0,0 +1,302 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" toolbar.n
+'/"
+.so man.macros
+.HS toolbar iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+\fBtoolbar\fR \- Create and manipulate a tool bar
+.SH SYNOPSIS
+\fBtoolbar\fR \fIpathName\fR ?\fIoptions\fR?
+.SH STANDARD OPTIONS
+.LP
+.nf
+.ta 4c 8c 12c
+\fBactiveBackground\fR \fBfont\fR \fBinsertForeground\fR \fBselectForeground\fR
+\fBactiveForeground\fR \fBforeground\fR \fBorient\fR \fBstate\fR
+\fBbackground\fR \fBhighlightBackground\fR \fBrelief\fR \fBtroughColor\fR
+\fBborderWidth\fR \fBhighlightColor\fR \fBselectBackground\fR \fBcursor\fR
+\fBhighlightThickness\fR \fBselectBorderWidth\fR \fBdisabledForeground\fR \fBinsertBackground\fR
+\fBselectColor\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options. For widgets
+added to the toolbar, these options will be propogated if the widget supports
+the option. For example, all widgets that support a font option will be changed
+if the the toolbar's font option is configured.
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBballoonBackground\fR
+Class: \fBBalloonBackground\fR
+Command-Line Switch: \fB-ballooonbackground\fR
+.fi
+.IP
+Specifies the background color of the balloon help displayed at the bottom
+center of a widget on the toolbar that has a non empty string for its
+balloonStr option. The default color is yellow.
+.LP
+.nf
+Name: \fBballoonDelay1\fR
+Class: \fBBalloonDelay1\fR
+Command-Line Switch: \fB-balloondelay1\fR
+.fi
+.IP
+Specifies the length of time (in milliseconds) to wait before initially
+posting a balloon help hint window. This delay is in effect whenever 1)
+the mouse leaves the toolbar, or 2) a toolbar item is selected with the
+mouse button.
+.LP
+.nf
+Name: \fBballoonDelay2\fR
+Class: \fBBalloonDelay2\fR
+Command-Line Switch: \fB-balloondelay2\fR
+.fi
+.IP
+Specifies the length of time (in milliseconds) to wait before continuing to
+post balloon help hint windows. This delay is in effect after the first
+time a balloon hint window is activated. It remains in effect until 1) the
+mouse leaves the toolbar, or 2) a toolbar item is selected with the mouse
+button.
+.LP
+.nf
+Name: \fBballoonFont\fR
+Class: \fBBalloonFont\fR
+Command-Line Switch: \fB-balloonfont\fR
+.fi
+.IP
+Specifies the font of the balloon help text displayed at the bottom center
+of a widget on the toolbar that has a non empty string for its
+balloonStr option. The default font is 6x10.
+.LP
+.nf
+Name: \fBballoonForeground\fR
+Class: \fBBalloonForeground\fR
+Command-Line Switch: \fB-ballooonforeground\fR
+.fi
+.IP
+Specifies the foreground color of the balloon help displayed at the
+bottom center of a widget on the toolbar that has a non empty string for
+its balloonStr option. The default color is black.
+.LP
+.nf
+Name: \fBhelpVariable\fR
+Class: \fBHelpVariable\fR
+Command-Line Switch: \fB-helpvariable\fR
+.fi
+.IP
+Specifies the global variable to update whenever the mouse is in motion
+over a toolbar widget. This global variable is updated with the current
+value of the active widget's helpStr. Other widgets can "watch" this
+variable with the trace command, or as is the case with entry or label
+widgets, they can set their textVariable to the same global variable. This
+allows for a simple implementation of a help status bar. Whenever the
+mouse leaves a menu entry, the helpVariable is set to the empty string {}.
+.LP
+.nf
+Name: \fBorient\fR
+Class: \fBOrient\fR
+Command-Line Switch: \fB-orient\fR
+.fi
+.IP
+Specifies the orientation of the toolbar. Must be either horizontal or
+vertical.
+.BE
+.SH DESCRIPTION
+The \fBtoolbar\fR command creates a new window (given by the pathName
+argument) and makes it into a \fBtoolbar\fR widget. Additional options,
+described above may be specified on the command line or in the option
+database to configure aspects of the toolbar such as its colors, font,
+and orientation. The \fBtoolbar\fR command returns its pathName argument. At
+the time this command is invoked, there must not exist a window named
+pathName, but pathName's parent must exist.
+.PP
+A \fBtoolbar\fR is a widget that displays a collection of widgets arranged
+either in a row or a column (depending on the value of the -orient option).
+This collection of widgets is usually for user convenience to give access
+to a set of commands or settings. Any widget may be placed on a toolbar.
+However, command or value-oriented widgets (such as button, radiobutton,
+etc.) are usually the most useful kind of widgets to appear on a toolbar.
+.PP
+In addition, the toolbar adds two new options to all widgets that are added to
+it. These are the \fBhelpStr\fR and \fBballoonStr\fR options. See the
+discussion for the widget command add below.
+
+.SH "WIDGET-SPECIFIC METHODS"
+.PP
+The toolbar command creates a new Tcl command whose name is pathName. This
+command may be used to invoke various operations on the widget. It has the
+following general form:
+.DS C
+\fIpathName\fR \fIoption\fR \fI?arg arg ...?\fR
+.DE
+Option and args determine the exact behavior of the command.
+.PP
+Many of the widget commands for a toolbar take as one argument an indicator of
+which widget item of the toolbar to operate on. The indicator is called
+an \fBindex\fR and may be specified in any of the following forms:
+.TP
+\fInumber\fR
+Specifies the widget numerically, where 0 corresponds to the first
+widget in the notebook, 1 to the second, and so on. (For horizontal, 0 is the
+leftmost; for vertical, 0 is the topmost).
+.TP
+\fBend\fR
+Specifes the last widget in the toolbar's index. If the toolbar is
+empty this will return -1.
+.TP
+\fBlast\fR
+Same as end.
+.TP
+\fIpattern\fR
+If the index doesn't satisfy any of the above forms, then this form is
+used. Pattern is pattern-matched against the widgetName of each widget in the
+toolbar, in order from the first to the last widget, until a matching entry is
+found. An exact match must occur.
+.PP
+The following commands are possible for toolbar widgets:
+.TP
+\fIpathName\fR \fBadd\fR \fIwidgetCommand\fR \fIwidgetName\fR \fI?option value?\fR
+Adds a widget with the command widgetCommand whose name is widgetName to the
+toolbar. If widgetCommand is radiobutton or checkbutton, its packing is
+slightly padded to match the geometry of button widgets. In addition, the
+indicatorOn option is false by default and the selectColor is that of the
+toolbar background by default. This allows Radiobutton and Checkbutton widgets
+to be added as icons by simply setting their bitmap or image options. If
+additional arguments are present, they are the set of available options
+that the widget type of \fIwidgetCommand\fR supports. In addition they may
+also be one of the following options:
+.RS
+.TP
+\fB-helpstr\fR \fIvalue\fR
+Specifes the help string to associate with the widget. When the mouse moves
+over the widget, the variable denoted by \fBhelpVariable\fR is set
+to \fBhelpStr\fR. Another widget can bind to the helpVariable and thus
+track status help.
+.TP
+\fB-balloonstr\fR \fIvalue\fR
+Specifes the string to display in a balloon window for this widget. A
+balloon window is a small popup window centered at the bottom of the
+widget. Usually the \fBballoonStr\fR value is the name of the item on the
+toolbar. It is sometimes known as a hint window.
+.IP
+When the mouse moves into an item on the toolbar, a timer is set based on
+the value of \fBballoonDelay1\fR. If the mouse stays inside the item
+for \fBballoonDelay1\fR, the balloon window will pop up displaying
+the \fBballoonStr\fR value. Once the balloon window is posted, a new
+timer based on \fBballoonDelay2\fR is set. This is typically a shorter
+timer. If the mouse is moved to another item, the window is unposted and
+a new window will be posted over the item if the shorter delay time is
+satisfied.
+.IP
+While the balloon window is posted, it can also be unposted if the item
+is selected. In this case the timer is reset to \fBballoonDelay1\fR.
+Whenever the mouse leaves the toolbar, the timer is also reset
+to \fBballoonDelay1\fR.
+.IP
+This window posting/unposting model is the same model used in the
+Windows95 environment.
+.RE
+.TP
+\fIpathName\fR \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given by \fIoption\fR.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR \fIvalue\fR?
+Query or modify the configuration options of the widget. If no \fIoption\fR is
+specified, returns a list describing all of the available options for pathName
+(see Tk_ConfigureInfo for information on the format of this list). If
+\fIoption\fR is specified with no value, then the command returns a
+list describing the one
+named option (this list will be identical to the corresponding sublist of the
+value returned if no option is specified). If one or more option-value pairs
+are specified, then the command modifies the given widget option(s) to have the
+given value(s); in this case the command returns an empty string.
+.TP
+\fIpathName\fR \fBdelete\fR \fIindex\fR ?\fIindex2\fR?
+This command deletes all items between \fIindex\fR and \fIindex2\fR
+inclusive. If \fIindex2\fR is omitted then it defaults to \fIindex\fR.
+Returns an empty string.
+.TP
+\fIpathName\fR \fBindex\fR \fIindex\fR
+Returns the widget's numerical index for the entry corresponding
+to \fIindex\fR. If \fIindex\fR is not found, -1 is returned.
+.TP
+\fIpathName\fR \fBinsert\fR \fIbeforeIndex\fR \fIwidgetCommand\fR \fIwidgetName\fR \fI?option value?\fR
+.TP
+Insert a new item named \fIwidgetName\fR with the
+command \fIwidgetCommand\fR before the item specified by \fIbeforeIndex\fR.
+If \fIwidgetCommand\fR is \fBradiobutton\fR or \fBcheckbutton\fR, its
+packing is slightly padded to match the geometry of button widgets. In
+addition, the \fBindicatorOn\fR option is \fBfalse\fR by default and the
+\fBselectColor\fR is that of the toolbar background by default. This allows
+\fBRadiobutton\fR and \fBCheckbutton\fR widgets to be added as icons by
+simply setting their \fBbitmap\fR or \fBimage\fR options. The set of
+available options is the same as specified in the \fBad\fR command.
+.TP
+\fIpathName\fR \fBitemcget\fR \fIindex\fR \fIoption\fR
+Returns the current value of the configuration option given by \fIoption\fR for
+index. The item type of \fIindex\fR determines the valid available options.
+.TP
+\fIpathName\fR \fBitemconfigure\fR \fIindex\fR \fI?option value?\fR
+Query or modify the configuration options of the widget of the toolbar
+specified by \fIindex\fR. If no option is specified,
+returns a list describing all of
+the available options for \fIindex\fR
+(see \fBTk_ConfigureInfo\fR for information on the
+format of this list). If \fIoption\fR is specified with no value,
+then the command
+returns a list describing the one named option (this list will be identical to
+the corresponding sublist of the value returned if no option is specified). If
+one or more option-value pairs are specified, then the command modifies the
+given widget option(s) to have the given value(s); in this case the command
+returns an empty string. The item type of \fIindex\fR determines the valid
+available options. The set of available options is the same as specified
+in the \fBad\fR command.
+.SH EXAMPLE
+.DS
+ toolbar .tb -helpvariable statusVar
+
+ .tb add button item1 \\
+ -helpstr "Save It" -bitmap @./icons/Tool_32_box.xbm \\
+ -balloonstr "Save" -command {puts 1}
+ .tb add button item2 \\
+ -helpstr "Save It" -bitmap @./icons/Tool_32_brush.xbm \\
+ -balloonstr "Save" -command {puts 1}
+ .tb add button item3 \\
+ -helpstr "Save It" -bitmap @./icons/Tool_32_cut.xbm \\
+ -balloonstr "Save" -command {puts 1}
+ .tb add button item4 \\
+ -helpstr "Save It" -bitmap @./icons/Tool_32_draw.xbm \\
+ -balloonstr "Save" -command {puts 1}
+ .tb add button item5 \\
+ -bitmap @./icons/Tool_32_erase.xbm -helpstr "Play It" \\
+ -command {puts 2}
+ .tb add frame filler \\
+ -borderwidth 1 -width 10 -height 10
+ .tb add radiobutton item6 \\
+ -bitmap @./icons/Tool_32_oval.xbm -command {puts 4} \\
+ -variable result -value OPEN -helpstr "Radio Button # 1" \\
+ -balloonstr "Radio"
+ .tb add radiobutton item7 \\
+ -bitmap @./icons/Tool_32_line.xbm -command {puts 5} \\
+ -variable result -value CLOSED
+ .tb add checkbutton item8 \\
+ -bitmap @./icons/Tool_32_text.xbm -command {puts 6} \\
+ -variable checkit -onvalue yes -offvalue no
+ .tb add checkbutton check2 \\
+ -bitmap @./icons/Tool_32_points.xbm -command {puts 7} \\
+ -variable checkit2 -onvalue yes -offvalue no
+
+ pack .tb -side top -anchor nw
+.DE
+.SH AUTHOR
+Bill Scott
+.SH KEYWORDS
+toolbar, button, radiobutton, checkbutton, iwidgets, widget
+
diff --git a/itcl/iwidgets3.0.0/doc/watch.n b/itcl/iwidgets3.0.0/doc/watch.n
new file mode 100755
index 00000000000..7b3dc96573b
--- /dev/null
+++ b/itcl/iwidgets3.0.0/doc/watch.n
@@ -0,0 +1,285 @@
+'\"
+'\" Copyright (c) 1995 DSC Technologies Corporation
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" @(#) watch.n
+'\"
+.so man.macros
+.HS watch iwid
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+watch \- Create and manipulate time with a watch widgets
+.SH SYNOPSIS
+\fBwatch\fI \fIpathName \fR?\fIoptions\fR?
+.SH "INHERITANCE"
+itk::Widget <- Watch
+
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBcursor\fR \fBforeground\fR \fBrelief\fR
+.fi
+.LP
+See the "options" manual entry for details on the standard options.
+.SH "ASSOCIATED OPTIONS"
+.LP
+See the "Canvas" manual entry for details on the above associated options.
+
+.SH "WIDGET-SPECIFIC OPTIONS"
+.LP
+.nf
+Name: \fBclockColor\fR
+Class: \fBColorfR
+Command-Line Switch: \fB-clockcolor\fR
+.fi
+.IP
+Fill color for the main oval encapsulating the watch, in any of the forms
+acceptable to \fBTk_GetColor\fR. The default is "White".
+.nf
+.LP
+Name: \fBclockStipple\fR
+Class: \fBBitmapfR
+Command-Line Switch: \fB-clockstipple\fR
+.fi
+.IP
+Bitmap for the main oval encapsulating the watch, in any of the forms
+acceptable to \fBTk_GetBitmap\fR. The default is "".
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Command-Line Switch: \fB-height\fR
+.fi
+.IP
+Specifies the height of the watch widget in any of the forms
+acceptable to \fBTk_GetPixels\fR. The default height is 175 pixels.
+.LP
+.nf
+Name: \fBhourColor\fR
+Class: \fBColorfR
+Command-Line Switch: \fB-hourcolor\fR
+.fi
+.IP
+Fill color for the hour hand, in any of the forms acceptable to \fBTk_GetColor\fR.
+The default is "Red".
+.LP
+.nf
+Name: \fBhourRadius\fR
+Class: \fBRadius\fR
+Command-Line Switch: \fB-hourradius\fR
+.fi
+.IP
+Specifies the radius of the hour hand as a percentage of the radius
+from the center to the out perimeter of the clock.
+The value must be a fraction <= 1. The default is ".5".
+.LP
+.nf
+Name: \fBminuteColor\fR
+Class: \fBColorfR
+Command-Line Switch: \fB-minutecolor\fR
+.fi
+.IP
+Fill color for the minute hand, in any of the forms acceptable to \fBTk_GetColor\fR.
+The default is "Yellow".
+.LP
+.nf
+Name: \fBminuteRadius\fR
+Class: \fBRadius\fR
+Command-Line Switch: \fB-minuteradius\fR
+.fi
+.IP
+Specifies the radius of the minute hand as a percentage of the radius
+from the center to the out perimeter of the clock.
+The value must be a fraction <= 1. The default is ".8".
+.LP
+.nf
+Name: \fBpivotColor\fR
+Class: \fBColorfR
+Command-Line Switch: \fB-pivotcolor\fR
+.fi
+.IP
+Fill color for the circle in which the watch hands rotate
+in any of the forms acceptable to \fBTk_GetColor\fR.
+The default is "White".
+.LP
+.nf
+Name: \fBpivotRadius\fR
+Class: \fBRadius\fR
+Command-Line Switch: \fB-pivotradius\fR
+.fi
+.IP
+Specifies the radius of the circle in which the watch hands rotate
+as a percentage of the radius. The value must be a fraction <= 1.
+The default is ".1".
+.LP
+.nf
+Name: \fBsecondColor\fR
+Class: \fBColorfR
+Command-Line Switch: \fB-secondcolor\fR
+.fi
+.IP
+Fill color for the second hand, in any of the forms acceptable to \fBTk_GetColor\fR.
+The default is "Black".
+.LP
+.nf
+Name: \fBsecondRadius\fR
+Class: \fBRadius\fR
+Command-Line Switch: \fB-secondradius\fR
+.fi
+.IP
+Specifies the radius of the second hand as a percentage of the radius
+from the center to the out perimeter of the clock.
+The value must be a fraction <= 1. The default is ".9".
+.LP
+.nf
+Name: \fBshowAmPm\fR
+Class: \fBShosAmPm\fR
+Command-Line Switch: \fB-showampm\fR
+.fi
+.IP
+Specifies whether the AM/PM radiobuttons should be displayed, in any
+of the forms acceptable to \fBTcl_GetBoolean\fR. The default is yes.
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Command-Line Switch: \fB-state\fR
+.fi
+.IP
+Specifies the editable state for the hands on the watch. In a normal
+state, the user can select and move the hands via mouse button 1. The
+valid values are \fBnormal\fR, and \fBdisabled\fR. The defult is normal.
+.LP
+.nf
+Name: \fBtickColor\fR
+Class: \fBColorfR
+Command-Line Switch: \fB-tickcolor\fR
+.fi
+.IP
+Fill color for the 60 ticks around the perimeter of the watch,
+in any of the forms acceptable to \fBTk_GetColor\fR. The default is "Black".
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Command-Line Switch: \fB-width\fR
+.fi
+.IP
+Specifies the width of the watch widget in any of the forms
+acceptable to \fBTk_GetPixels\fR. The default height is 155 pixels.
+.BE
+
+.SH DESCRIPTION
+.PP
+
+The \fBwatch\fR command creates a watch with hour, minute, and
+second hands modifying the time value.
+
+.SH "METHODS"
+.PP
+The \fBwatch\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This command may be used to invoke various
+operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for watch widgets:
+
+.SH "WIDGET-SPECIFIC METHODS"
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBwatch\fR
+command.
+.TP
+\fIpathName\fR \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBwatch\fR
+command.
+.TP
+\fIpathName \fBget\fR ?\fBformat\fR?
+Returns the current time of the watch in a format of
+string or as an integer clock value using the \fB-string\fR and \fB-clicks\fR
+format options respectively. The default is by string. Reference the
+clock command for more information on obtaining time and its
+formats.
+.TP
+\fIpathName \fBshow\fR \fItime\fR
+Changes the currently displayed time to be that of the time
+argument. The time may be specified either as a string, an
+integer clock value or the keyword "now". Reference the clock
+command for more information on obtaining time and its format.
+.TP
+\fIpathName \fBwatch\fR ?\fBargs\fR?
+Evaluates the specifieds \fBargs\fR against the canvas component.
+
+.ta 4c
+.SH "COMPONENTS"
+.LP
+.nf
+Name: \fBcanvas\fR
+Class: \fBCanvas\fR
+.fi
+.IP
+The canvas component is the where the clock is drawn. See the
+Canvas widget manual entry for details.
+.LP
+.nf
+Name: \fBframe\fR
+Class: \fBFrame\fR
+.fi
+.IP
+The frame component is the where the "AM" and "PM" radiobuttons are displayed.
+See the Frame widget manual entry for details.
+.LP
+.nf
+Name: \fBam\fR
+Class: \fBRadiobutton\fR
+.fi
+.IP
+The am component indicates whether on not the time is relative to "AM".
+See the Radiobutton widget manual entry for details.
+.LP
+.nf
+Name: \fBpm\fR
+Class: \fBRadiobutton\fR
+.fi
+.IP
+The pm component indicates whether on not the time is relative to "PM".
+See the Radiobutton widget manual entry for details.
+.fi
+
+.SH EXAMPLE
+.DS
+watch .w -state disabled -showampm no -width 155 -height 155
+pack .w -padx 10 -pady 10 -fill both -expand yes
+
+while {1} {
+ after 1000
+ .w show
+ update
+}
+.DE
+.SH AUTHOR
+John Tucker
+.DE
+Mark L. Ulferts
+.SH KEYWORDS
+watch, hand, ticks, pivot, widget
+
diff --git a/itcl/iwidgets3.0.0/generic/buttonbox.itk b/itcl/iwidgets3.0.0/generic/buttonbox.itk
new file mode 100644
index 00000000000..20f8b4cb8ce
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/buttonbox.itk
@@ -0,0 +1,571 @@
+#
+# Buttonbox
+# ----------------------------------------------------------------------
+# Manages a framed area with Motif style buttons. The button box can
+# be configured either horizontally or vertically.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
+# Bret A. Schuhmacher EMAIL: bas@wn.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Buttonbox {
+ keep -background -cursor -foreground
+}
+
+# ------------------------------------------------------------------
+# BUTTONBOX
+# ------------------------------------------------------------------
+class iwidgets::Buttonbox {
+ inherit itk::Widget
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -pady padY Pad 5
+ itk_option define -padx padX Pad 5
+ itk_option define -orient orient Orient "horizontal"
+ itk_option define -foreground foreground Foreground black
+
+ public method index {args}
+ public method add {args}
+ public method insert {args}
+ public method delete {args}
+ public method default {args}
+ public method hide {args}
+ public method show {args}
+ public method invoke {args}
+ public method buttonconfigure {args}
+ public method buttoncget {index option}
+
+ private method _positionButtons {}
+ private method _setBoxSize {{when later}}
+ private method _getMaxWidth {}
+ private method _getMaxHeight {}
+
+ private variable _resizeFlag {} ;# Flag for resize needed.
+ private variable _buttonList {} ;# List of all buttons in box.
+ private variable _displayList {} ;# List of displayed buttons.
+ private variable _unique 0 ;# Counter for button widget ids.
+}
+
+namespace eval iwidgets::Buttonbox {
+ #
+ # Set up some class level bindings for map and configure events.
+ #
+ bind bbox-map <Map> [code %W _setBoxSize]
+ bind bbox-config <Configure> [code %W _positionButtons]
+}
+
+#
+# Provide a lowercased access method for the Buttonbox class.
+#
+proc ::iwidgets::buttonbox {pathName args} {
+ uplevel ::iwidgets::Buttonbox $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Buttonbox::constructor {args} {
+ #
+ # Add Configure bindings for geometry management.
+ #
+ bindtags $itk_component(hull) \
+ [linsert [bindtags $itk_component(hull)] 0 bbox-map]
+ bindtags $itk_component(hull) \
+ [linsert [bindtags $itk_component(hull)] 1 bbox-config]
+
+ pack propagate $itk_component(hull) no
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# DESTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Buttonbox::destructor {} {
+ if {$_resizeFlag != ""} {after cancel $_resizeFlag}
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -pady
+#
+# Pad the y space between the button box frame and the hull.
+# ------------------------------------------------------------------
+configbody iwidgets::Buttonbox::pady {
+ _setBoxSize
+}
+
+# ------------------------------------------------------------------
+# OPTION: -padx
+#
+# Pad the x space between the button box frame and the hull.
+# ------------------------------------------------------------------
+configbody iwidgets::Buttonbox::padx {
+ _setBoxSize
+}
+
+# ------------------------------------------------------------------
+# OPTION: -orient
+#
+# Position buttons either horizontally or vertically.
+# ------------------------------------------------------------------
+configbody iwidgets::Buttonbox::orient {
+ switch $itk_option(-orient) {
+ "horizontal" -
+ "vertical" {
+ _setBoxSize
+ }
+
+ default {
+ error "bad orientation option \"$itk_option(-orient)\",\
+ should be either horizontal or vertical"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: index index
+#
+# Searches the buttons in the box for the one with the requested tag,
+# numerical index, keyword "end" or "default". Returns the button's
+# tag if found, otherwise error.
+# ------------------------------------------------------------------
+body iwidgets::Buttonbox::index {index} {
+ if {[llength $_buttonList] > 0} {
+ if {[regexp {(^[0-9]+$)} $index]} {
+ if {$index < [llength $_buttonList]} {
+ return $index
+ } else {
+ error "Buttonbox index \"$index\" is out of range"
+ }
+
+ } elseif {$index == "end"} {
+ return [expr [llength $_buttonList] - 1]
+
+ } elseif {$index == "default"} {
+ foreach knownButton $_buttonList {
+ if {[$itk_component($knownButton) cget -defaultring]} {
+ return [lsearch -exact $_buttonList $knownButton]
+ }
+ }
+
+ error "Buttonbox \"$itk_component(hull)\" has no default"
+
+ } else {
+ if {[set idx [lsearch $_buttonList $index]] != -1} {
+ return $idx
+ }
+
+ error "bad Buttonbox index \"$index\": must be number, end,\
+ default, or pattern"
+ }
+
+ } else {
+ error "Buttonbox \"$itk_component(hull)\" has no buttons"
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: add tag ?option value option value ...?
+#
+# Add the specified button to the button box. All PushButton options
+# are allowed. New buttons are added to the list of buttons and the
+# list of displayed buttons. The PushButton path name is returned.
+# ------------------------------------------------------------------
+body iwidgets::Buttonbox::add {tag args} {
+ itk_component add $tag {
+ iwidgets::Pushbutton $itk_component(hull).[incr _unique]
+ } {
+ usual
+ rename -highlightbackground -background background Background
+ }
+
+ if {$args != ""} {
+ uplevel $itk_component($tag) configure $args
+ }
+
+ lappend _buttonList $tag
+ lappend _displayList $tag
+
+ _setBoxSize
+}
+
+# ------------------------------------------------------------------
+# METHOD: insert index tag ?option value option value ...?
+#
+# Insert the specified button in the button box just before the one
+# given by index. All PushButton options are allowed. New buttons
+# are added to the list of buttons and the list of displayed buttons.
+# The PushButton path name is returned.
+# ------------------------------------------------------------------
+body iwidgets::Buttonbox::insert {index tag args} {
+ itk_component add $tag {
+ iwidgets::Pushbutton $itk_component(hull).[incr _unique]
+ } {
+ usual
+ rename -highlightbackground -background background Background
+ }
+
+ if {$args != ""} {
+ uplevel $itk_component($tag) configure $args
+ }
+
+ set index [index $index]
+ set _buttonList [linsert $_buttonList $index $tag]
+ set _displayList [linsert $_displayList $index $tag]
+
+ _setBoxSize
+}
+
+# ------------------------------------------------------------------
+# METHOD: delete index
+#
+# Delete the specified button from the button box.
+# ------------------------------------------------------------------
+body iwidgets::Buttonbox::delete {index} {
+ set index [index $index]
+ set tag [lindex $_buttonList $index]
+
+ destroy $itk_component($tag)
+
+ set _buttonList [lreplace $_buttonList $index $index]
+
+ if {[set dind [lsearch $_displayList $tag]] != -1} {
+ set _displayList [lreplace $_displayList $dind $dind]
+ }
+
+ _setBoxSize
+ update idletasks
+}
+
+# ------------------------------------------------------------------
+# METHOD: default index
+#
+# Sets the default to the push button given by index.
+# ------------------------------------------------------------------
+body iwidgets::Buttonbox::default {index} {
+ set index [index $index]
+
+ set defbtn [lindex $_buttonList $index]
+
+ foreach knownButton $_displayList {
+ if {$knownButton == $defbtn} {
+ $itk_component($knownButton) configure -defaultring yes
+ } else {
+ $itk_component($knownButton) configure -defaultring no
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: hide index
+#
+# Hide the push button given by index. This doesn't remove the button
+# permanently from the display list, just inhibits its display.
+# ------------------------------------------------------------------
+body iwidgets::Buttonbox::hide {index} {
+ set index [index $index]
+ set tag [lindex $_buttonList $index]
+
+ if {[set dind [lsearch $_displayList $tag]] != -1} {
+ place forget $itk_component($tag)
+ set _displayList [lreplace $_displayList $dind $dind]
+
+ _setBoxSize
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: show index
+#
+# Displays a previously hidden push button given by index. Check if
+# the button is already in the display list. If not then add it back
+# at it's original location and redisplay.
+# ------------------------------------------------------------------
+body iwidgets::Buttonbox::show {index} {
+ set index [index $index]
+ set tag [lindex $_buttonList $index]
+
+ if {[lsearch $_displayList $tag] == -1} {
+ set _displayList [linsert $_displayList $index $tag]
+
+ _setBoxSize
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: invoke ?index?
+#
+# Invoke the command associated with a push button. If no arguments
+# are given then the default button is invoked, otherwise the argument
+# is expected to be a button index.
+# ------------------------------------------------------------------
+body iwidgets::Buttonbox::invoke {args} {
+ if {[llength $args] == 0} {
+ $itk_component([lindex $_buttonList [index default]]) invoke
+
+ } else {
+ $itk_component([lindex $_buttonList [index [lindex $args 0]]]) \
+ invoke
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: buttonconfigure index ?option? ?value option value ...?
+#
+# Configure a push button given by index. This method allows
+# configuration of pushbuttons from the Buttonbox level. The options
+# may have any of the values accepted by the add method.
+# ------------------------------------------------------------------
+body iwidgets::Buttonbox::buttonconfigure {index args} {
+ set tag [lindex $_buttonList [index $index]]
+
+ set retstr [uplevel $itk_component($tag) configure $args]
+
+ _setBoxSize
+
+ return $retstr
+}
+
+# ------------------------------------------------------------------
+# METHOD: buttonccget index option
+#
+# Return value of option for push button given by index. Option may
+# have any of the values accepted by the add method.
+# ------------------------------------------------------------------
+body iwidgets::Buttonbox::buttoncget {index option} {
+ set tag [lindex $_buttonList [index $index]]
+
+ set retstr [uplevel $itk_component($tag) cget [list $option]]
+
+ return $retstr
+}
+
+# -----------------------------------------------------------------
+# PRIVATE METHOD: _getMaxWidth
+#
+# Returns the required width of the largest button.
+# -----------------------------------------------------------------
+body iwidgets::Buttonbox::_getMaxWidth {} {
+ set max 0
+
+ foreach tag $_displayList {
+ set w [winfo reqwidth $itk_component($tag)]
+
+ if {$w > $max} {
+ set max $w
+ }
+ }
+
+ return $max
+}
+
+# -----------------------------------------------------------------
+# PRIVATE METHOD: _getMaxHeight
+#
+# Returns the required height of the largest button.
+# -----------------------------------------------------------------
+body iwidgets::Buttonbox::_getMaxHeight {} {
+ set max 0
+
+ foreach tag $_displayList {
+ set h [winfo reqheight $itk_component($tag)]
+
+ if {$h > $max} {
+ set max $h
+ }
+ }
+
+ return $max
+}
+
+# ------------------------------------------------------------------
+# METHOD: _setBoxSize ?when?
+#
+# Sets the proper size of the frame surrounding all the buttons.
+# If "when" is "now", the change is applied immediately. If it is
+# "later" or it is not specified, then the change is applied later,
+# when the application is idle.
+# ------------------------------------------------------------------
+body iwidgets::Buttonbox::_setBoxSize {{when later}} {
+ if {[winfo ismapped $itk_component(hull)]} {
+ if {$when == "later"} {
+ if {$_resizeFlag == ""} {
+ set _resizeFlag [after idle [code $this _setBoxSize now]]
+ }
+ return
+ } elseif {$when != "now"} {
+ error "bad option \"$when\": should be now or later"
+ }
+
+ set _resizeFlag ""
+
+ set numBtns [llength $_displayList]
+
+ if {$itk_option(-orient) == "horizontal"} {
+ set minw [expr $numBtns * [_getMaxWidth] \
+ + ($numBtns+1) * $itk_option(-padx)]
+ set minh [expr [_getMaxHeight] + 2 * $itk_option(-pady)]
+
+ } else {
+ set minw [expr [_getMaxWidth] + 2 * $itk_option(-padx)]
+ set minh [expr $numBtns * [_getMaxHeight] \
+ + ($numBtns+1) * $itk_option(-pady)]
+ }
+
+ #
+ # Remove the configure event bindings on the hull while we adjust the
+ # width/height and re-position the buttons. Once we're through, we'll
+ # update and reinstall them. This prevents double calls to position
+ # the buttons.
+ #
+ set tags [bindtags $itk_component(hull)]
+ if {[set i [lsearch $tags bbox-config]] != -1} {
+ set tags [lreplace $tags $i $i]
+ bindtags $itk_component(hull) $tags
+ }
+
+ component hull configure -width $minw -height $minh
+
+ update idletasks
+
+ _positionButtons
+
+ bindtags $itk_component(hull) [linsert $tags 0 bbox-config]
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: _positionButtons
+#
+# This method is responsible setting the width/height of all the
+# displayed buttons to the same value and for placing all the buttons
+# in equidistant locations.
+# ------------------------------------------------------------------
+body iwidgets::Buttonbox::_positionButtons {} {
+ set bf $itk_component(hull)
+ set numBtns [llength $_displayList]
+
+ #
+ # First, determine the common width and height for all the
+ # displayed buttons.
+ #
+ if {$numBtns > 0} {
+ set bfWidth [winfo width $itk_component(hull)]
+ set bfHeight [winfo height $itk_component(hull)]
+
+ if {$bfWidth >= [winfo reqwidth $itk_component(hull)]} {
+ set _btnWidth [_getMaxWidth]
+
+ } else {
+ if {$itk_option(-orient) == "horizontal"} {
+ set _btnWidth [expr $bfWidth / $numBtns]
+ } else {
+ set _btnWidth $bfWidth
+ }
+ }
+
+ if {$bfHeight >= [winfo reqheight $itk_component(hull)]} {
+ set _btnHeight [_getMaxHeight]
+
+ } else {
+ if {$itk_option(-orient) == "vertical"} {
+ set _btnHeight [expr $bfHeight / $numBtns]
+ } else {
+ set _btnHeight $bfHeight
+ }
+ }
+ }
+
+ #
+ # Place the buttons at the proper locations.
+ #
+ if {$numBtns > 0} {
+ if {$itk_option(-orient) == "horizontal"} {
+ set leftover [expr [winfo width $bf] \
+ - 2 * $itk_option(-padx) - $_btnWidth * $numBtns]
+
+ if {$numBtns > 0} {
+ set offset [expr $leftover / ($numBtns + 1)]
+ } else {
+ set offset 0
+ }
+ if {$offset < 0} {set offset 0}
+
+ set xDist [expr $itk_option(-padx) + $offset]
+ set incrAmount [expr $_btnWidth + $offset]
+
+ foreach button $_displayList {
+ place $itk_component($button) -anchor w \
+ -x $xDist -rely .5 -y 0 -relx 0 \
+ -width $_btnWidth -height $_btnHeight
+
+ set xDist [expr $xDist + $incrAmount]
+ }
+
+ } else {
+ set leftover [expr [winfo height $bf] \
+ - 2 * $itk_option(-pady) - $_btnHeight * $numBtns]
+
+ if {$numBtns > 0} {
+ set offset [expr $leftover / ($numBtns + 1)]
+ } else {
+ set offset 0
+ }
+ if {$offset < 0} {set offset 0}
+
+ set yDist [expr $itk_option(-pady) + $offset]
+ set incrAmount [expr $_btnHeight + $offset]
+
+ foreach button $_displayList {
+ place $itk_component($button) -anchor n \
+ -y $yDist -relx .5 -x 0 -rely 0 \
+ -width $_btnWidth -height $_btnHeight
+
+ set yDist [expr $yDist + $incrAmount]
+ }
+ }
+ }
+}
+
+
diff --git a/itcl/iwidgets3.0.0/generic/calendar.itk b/itcl/iwidgets3.0.0/generic/calendar.itk
new file mode 100644
index 00000000000..7c35487fbd1
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/calendar.itk
@@ -0,0 +1,938 @@
+#
+# Calendar
+# ----------------------------------------------------------------------
+# Implements a calendar widget for the selection of a date. It displays
+# a single month at a time. Buttons exist on the top to change the
+# month in effect turning th pages of a calendar. As a page is turned,
+# the dates for the month are modified. Selection of a date visually
+# marks that date. The selected value can be monitored via the
+# -command option or just retrieved using the get method. Methods also
+# exist to select a date and show a particular month. The option set
+# allows the calendars appearance to take on many forms.
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts E-mail: mulferts@austin.dsccc.com
+#
+# ACKNOWLEDGEMENTS: Michael McLennan E-mail: mmclennan@lucent.com
+#
+# This code is an [incr Tk] port of the calendar code shown in Michael
+# J. McLennan's book "Effective Tcl" from Addison Wesley. Small
+# modificiations were made to the logic here and there to make it a
+# mega-widget and the command and option interface was expanded to make
+# it even more configurable, but the underlying logic is the same.
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1997 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Calendar {
+ keep -background -cursor
+}
+
+# ------------------------------------------------------------------
+# CALENDAR
+# ------------------------------------------------------------------
+class iwidgets::Calendar {
+ inherit itk::Widget
+
+ constructor {args} {}
+
+ itk_option define -days days Days {Su Mo Tu We Th Fr Sa}
+ itk_option define -command command Command {}
+ itk_option define -forwardimage forwardImage Image {}
+ itk_option define -backwardimage backwardImage Image {}
+ itk_option define -weekdaybackground weekdayBackground Background \#d9d9d9
+ itk_option define -weekendbackground weekendBackground Background \#d9d9d9
+ itk_option define -outline outline Outline \#d9d9d9
+ itk_option define -buttonforeground buttonForeground Foreground blue
+ itk_option define -foreground foreground Foreground black
+ itk_option define -selectcolor selectColor Foreground red
+ itk_option define -selectthickness selectThickness SelectThickness 3
+ itk_option define -titlefont titleFont Font \
+ -*-helvetica-bold-r-normal--*-140-*
+ itk_option define -dayfont dayFont Font \
+ -*-helvetica-medium-r-normal--*-120-*
+ itk_option define -datefont dateFont Font \
+ -*-helvetica-medium-r-normal--*-120-*
+ itk_option define -currentdatefont currentDateFont Font \
+ -*-helvetica-bold-r-normal--*-120-*
+ itk_option define -startday startDay Day sunday
+
+ public method get {{format "-string"}} ;# Returns the selected date
+ public method select {{date_ "now"}} ;# Selects date, moving select ring
+ public method show {{date_ "now"}} ;# Displays a specific date
+
+ protected method _drawtext {canvas_ day_ date_ now_ x0_ y0_ x1_ y1_}
+
+ private method _change {delta_}
+ private method _configureHandler {}
+ private method _redraw {}
+ private method _days {{wmax {}}}
+ private method _layout {time_}
+ private method _select {date_}
+ private method _selectEvent {date_}
+ private method _adjustday {day_}
+ private method _percentSubst {pattern_ string_ subst_}
+
+ private variable _time {}
+ private variable _selected {}
+ private variable _initialized 0
+ private variable _offset 0
+}
+
+#
+# Provide a lowercased access method for the Calendar class.
+#
+proc ::iwidgets::calendar {pathName args} {
+ uplevel ::iwidgets::Calendar $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Calendar.width 200 widgetDefault
+option add *Calendar.height 165 widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Calendar::constructor {args} {
+ #
+ # Create the canvas which displays each page of the calendar.
+ #
+ itk_component add page {
+ canvas $itk_interior.page
+ } {
+ keep -background -cursor -width -height
+ }
+ pack $itk_component(page) -expand yes -fill both
+
+ #
+ # Create the forward and backward buttons. Rather than pack
+ # them directly in the hull, we'll waittill later and make
+ # them canvas window items.
+ #
+ itk_component add backward {
+ button $itk_component(page).backward \
+ -command [code $this _change -1]
+ } {
+ keep -background -cursor
+ }
+
+ itk_component add forward {
+ button $itk_component(page).forward \
+ -command [code $this _change +1]
+ } {
+ keep -background -cursor
+ }
+
+ #
+ # Set the initial time to now.
+ #
+ set _time [clock seconds]
+
+ #
+ # Bind to the configure event which will be used to redraw
+ # the calendar and display the month.
+ #
+ bind $itk_component(page) <Configure> [code $this _configureHandler]
+
+ #
+ # Evaluate the option arguments.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -command
+#
+# Sets the selection command for the calendar. When the user
+# selects a date on the calendar, the date is substituted in
+# place of "%d" in this command, and the command is executed.
+# ------------------------------------------------------------------
+configbody iwidgets::Calendar::command {}
+
+# ------------------------------------------------------------------
+# OPTION: -days
+#
+# The days option takes a list of values to set the text used to display the
+# days of the week header above the dates. The default value is
+# {Su Mo Tu We Th Fr Sa}.
+# ------------------------------------------------------------------
+configbody iwidgets::Calendar::days {
+ if {$_initialized} {
+ if {[$itk_component(page) find withtag days] != {}} {
+ $itk_component(page) delete days
+ _days
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -backwardimage
+#
+# Specifies a image to be displayed on the backwards calendar
+# button. If none is specified, a default is provided.
+# ------------------------------------------------------------------
+configbody iwidgets::Calendar::backwardimage {
+
+ #
+ # If no image is given, then we'll use the default image.
+ #
+ if {$itk_option(-backwardimage) == {}} {
+
+ #
+ # If the default image hasn't yet been created, then we
+ # need to create it.
+ #
+ if {[lsearch [image names] $this-backward] == -1} {
+ image create bitmap $this-backward \
+ -foreground $itk_option(-buttonforeground) -data {
+ #define back_width 16
+ #define back_height 16
+ static unsigned char back_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x30,
+ 0xe0, 0x38, 0xf0, 0x3c, 0xf8, 0x3e, 0xfc, 0x3f,
+ 0xfc, 0x3f, 0xf8, 0x3e, 0xf0, 0x3c, 0xe0, 0x38,
+ 0xc0, 0x30, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+ }
+ }
+
+ #
+ # Configure the button to use the default image.
+ #
+ $itk_component(backward) configure -image $this-backward
+
+ #
+ # Else, an image has been specified. First, we'll need to make sure
+ # the image really exists before configuring the button to use it.
+ # If it doesn't generate an error.
+ #
+ } else {
+ if {[lsearch [image names] $itk_option(-backwardimage)] != -1} {
+ $itk_component(backward) configure \
+ -image $itk_option(-backwardimage)
+ } else {
+ error "bad image name \"$itk_option(-backwardimage)\":\
+ image does not exist"
+ }
+
+ #
+ # If we previously created a default image, we'll just remove it.
+ #
+ if {[lsearch [image names] $this-backward] != -1} {
+ image delete $this-backward
+ }
+ }
+}
+
+
+# ------------------------------------------------------------------
+# OPTION: -forwardimage
+#
+# Specifies a image to be displayed on the forwards calendar
+# button. If none is specified, a default is provided.
+# ------------------------------------------------------------------
+configbody iwidgets::Calendar::forwardimage {
+
+ #
+ # If no image is given, then we'll use the default image.
+ #
+ if {$itk_option(-forwardimage) == {}} {
+
+ #
+ # If the default image hasn't yet been created, then we
+ # need to create it.
+ #
+ if {[lsearch [image names] $this-forward] == -1} {
+ image create bitmap $this-forward \
+ -foreground $itk_option(-buttonforeground) -data {
+ #define fwd_width 16
+ #define fwd_height 16
+ static unsigned char fwd_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x03,
+ 0x1c, 0x07, 0x3c, 0x0f, 0x7c, 0x1f, 0xfc, 0x3f,
+ 0xfc, 0x3f, 0x7c, 0x1f, 0x3c, 0x0f, 0x1c, 0x07,
+ 0x0c, 0x03, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+ }
+ }
+
+ #
+ # Configure the button to use the default image.
+ #
+ $itk_component(forward) configure -image $this-forward
+
+ #
+ # Else, an image has been specified. First, we'll need to make sure
+ # the image really exists before configuring the button to use it.
+ # If it doesn't generate an error.
+ #
+ } else {
+ if {[lsearch [image names] $itk_option(-forwardimage)] != -1} {
+ $itk_component(forward) configure \
+ -image $itk_option(-forwardimage)
+ } else {
+ error "bad image name \"$itk_option(-forwardimage)\":\
+ image does not exist"
+ }
+
+ #
+ # If we previously created a default image, we'll just remove it.
+ #
+ if {[lsearch [image names] $this-forward] != -1} {
+ image delete $this-forward
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -weekdaybackground
+#
+# Specifies the background for the weekdays which allows it to
+# be visually distinguished from the weekend.
+# ------------------------------------------------------------------
+configbody iwidgets::Calendar::weekdaybackground {
+ if {$_initialized} {
+ $itk_component(page) itemconfigure weekday \
+ -fill $itk_option(-weekdaybackground)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -weekendbackground
+#
+# Specifies the background for the weekdays which allows it to
+# be visually distinguished from the weekdays.
+# ------------------------------------------------------------------
+configbody iwidgets::Calendar::weekendbackground {
+ if {$_initialized} {
+ $itk_component(page) itemconfigure weekend \
+ -fill $itk_option(-weekendbackground)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -foreground
+#
+# Specifies the foreground color for the textual items, buttons,
+# and divider on the calendar.
+# ------------------------------------------------------------------
+configbody iwidgets::Calendar::foreground {
+ if {$_initialized} {
+ $itk_component(page) itemconfigure text \
+ -fill $itk_option(-foreground)
+ $itk_component(page) itemconfigure line \
+ -fill $itk_option(-foreground)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -outline
+#
+# Specifies the outline color used to surround the date text.
+# ------------------------------------------------------------------
+configbody iwidgets::Calendar::outline {
+ if {$_initialized} {
+ $itk_component(page) itemconfigure square \
+ -outline $itk_option(-outline)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -buttonforeground
+#
+# Specifies the foreground color of the forward and backward buttons.
+# ------------------------------------------------------------------
+configbody iwidgets::Calendar::buttonforeground {
+ if {$_initialized} {
+ if {$itk_option(-forwardimage) == {}} {
+ if {[lsearch [image names] $this-forward] != -1} {
+ $this-forward configure \
+ -foreground $itk_option(-buttonforeground)
+ }
+ } else {
+ $itk_option(-forwardimage) configure \
+ -foreground $itk_option(-buttonforeground)
+ }
+
+ if {$itk_option(-backwardimage) == {}} {
+ if {[lsearch [image names] $this-backward] != -1} {
+ $this-backward configure \
+ -foreground $itk_option(-buttonforeground)
+ }
+ } else {
+ $itk_option(-backwardimage) configure \
+ -foreground $itk_option(-buttonforeground)
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -selectcolor
+#
+# Specifies the color of the ring displayed that distinguishes the
+# currently selected date.
+# ------------------------------------------------------------------
+configbody iwidgets::Calendar::selectcolor {
+ if {$_initialized} {
+ $itk_component(page) itemconfigure $_selected-sensor \
+ -outline $itk_option(-selectcolor)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -selectthickness
+#
+# Specifies the thickness of the ring displayed that distinguishes
+# the currently selected date.
+# ------------------------------------------------------------------
+configbody iwidgets::Calendar::selectthickness {
+ if {$_initialized} {
+ $itk_component(page) itemconfigure $_selected-sensor \
+ -width $itk_option(-selectthickness)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -titlefont
+#
+# Specifies the font used for the title text that consists of the
+# month and year.
+# ------------------------------------------------------------------
+configbody iwidgets::Calendar::titlefont {
+ if {$_initialized} {
+ $itk_component(page) itemconfigure title \
+ -font $itk_option(-titlefont)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -datefont
+#
+# Specifies the font used for the date text that consists of the
+# day of the month.
+# ------------------------------------------------------------------
+configbody iwidgets::Calendar::datefont {
+ if {$_initialized} {
+ $itk_component(page) itemconfigure date \
+ -font $itk_option(-datefont)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -currentdatefont
+#
+# Specifies the font used for the current date text.
+# ------------------------------------------------------------------
+configbody iwidgets::Calendar::currentdatefont {
+ if {$_initialized} {
+ $itk_component(page) itemconfigure now \
+ -font $itk_option(-currentdatefont)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -dayfont
+#
+# Specifies the font used for the day of the week text.
+# ------------------------------------------------------------------
+configbody iwidgets::Calendar::dayfont {
+ if {$_initialized} {
+ $itk_component(page) itemconfigure days \
+ -font $itk_option(-dayfont)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -startday
+#
+# Specifies the starting day for the week. The value must be a day of the
+# week: sunday, monday, tuesday, wednesday, thursday, friday, or
+# saturday. The default is sunday.
+# ------------------------------------------------------------------
+configbody iwidgets::Calendar::startday {
+ set day [string tolower $itk_option(-startday)]
+
+ switch $day {
+ sunday {set _offset 0}
+ monday {set _offset 1}
+ tuesday {set _offset 2}
+ wednesday {set _offset 3}
+ thursday {set _offset 4}
+ friday {set _offset 5}
+ saturday {set _offset 6}
+ default {
+ error "bad startday option \"$itk_option(-startday)\":\
+ should be sunday, monday, tuesday, wednesday,\
+ thursday, friday, or saturday"
+ }
+ }
+
+ if {$_initialized} {
+ $itk_component(page) delete all-page
+ _redraw
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: get ?format?
+#
+# Returns the currently selected date in one of two formats, string
+# or as an integer clock value using the -string and -clicks
+# options respectively. The default is by string. Reference the
+# clock command for more information on obtaining dates and their
+# formats.
+# ------------------------------------------------------------------
+body iwidgets::Calendar::get {{format "-string"}} {
+ switch -- $format {
+ "-string" {
+ return $_selected
+ }
+ "-clicks" {
+ return [clock scan $_selected]
+ }
+ default {
+ error "bad format option \"$format\":\
+ should be -string or -clicks"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: select date_
+#
+# Changes the currently selected date to the value specified.
+# ------------------------------------------------------------------
+body iwidgets::Calendar::select {{date_ "now"}} {
+ if {$date_ == "now"} {
+ set time [clock seconds]
+ } else {
+ if {[catch {clock format $date_}] == 0} {
+ set time $date_
+ } elseif {[catch {set time [clock scan $date_]}] != 0} {
+ error "bad date: \"$date_\", must be a valid date string, clock clicks value or the keyword now"
+ }
+ }
+
+ _select [clock format $time -format "%m/%d/%Y"]
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: show date_
+#
+# Changes the currently display month to be that of the specified
+# date.
+# ------------------------------------------------------------------
+body iwidgets::Calendar::show {{date_ "now"}} {
+ if {$date_ == "now"} {
+ set _time [clock seconds]
+ } else {
+ if {[catch {clock format $date_}] == 0} {
+ set _time $date_
+ } elseif {[catch {set _time [clock scan $date_]}] != 0} {
+ error "bad date: \"$date_\", must be a valid date string, clock clicks value or the keyword now"
+ }
+ }
+
+ $itk_component(page) delete all-page
+ _redraw
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _drawtext canvas_ day_ date_ now_
+# x0_ y0_ x1_ y1_
+#
+# Draws the text in the date square. The method is protected such that
+# it can be overridden in derived classes that may wish to add their
+# own unique text. The method receives the day to draw along with
+# the coordinates of the square.
+# ------------------------------------------------------------------
+body iwidgets::Calendar::_drawtext {canvas_ day_ date_ now_ x0_ y0_ x1_ y1_} {
+ set item [$canvas_ create text \
+ [expr (($x1_ - $x0_) / 2) + $x0_] \
+ [expr (($y1_ -$y0_) / 2) + $y0_ + 1] \
+ -anchor center -text "$day_" \
+ -fill $itk_option(-foreground)]
+
+ if {$date_ == $now_} {
+ $canvas_ itemconfigure $item \
+ -font $itk_option(-currentdatefont) \
+ -tags [list all-page date text now]
+ } else {
+ $canvas_ itemconfigure $item \
+ -font $itk_option(-datefont) \
+ -tags [list all-page date text]
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _configureHandler
+#
+# Processes a configure event received on the canvas. The method
+# deletes all the current canvas items and forces a redraw.
+# ------------------------------------------------------------------
+body iwidgets::Calendar::_configureHandler {} {
+ set _initialized 1
+
+ $itk_component(page) delete all
+ _redraw
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _change delta_
+#
+# Changes the current month displayed in the calendar, moving
+# forward or backward by <delta_> months where <delta_> is +/-
+# some number.
+# ------------------------------------------------------------------
+body iwidgets::Calendar::_change {delta_} {
+ set dir [expr ($delta_ > 0) ? 1 : -1]
+ set month [clock format $_time -format "%m"]
+ set month [string trimleft $month 0]
+ set year [clock format $_time -format "%Y"]
+
+ for {set i 0} {$i < abs($delta_)} {incr i} {
+ incr month $dir
+ if {$month < 1} {
+ set month 12
+ incr year -1
+ } elseif {$month > 12} {
+ set month 1
+ incr year 1
+ }
+ }
+ if {[catch {set _time [clock scan "$month/1/$year"]}]} {
+ bell
+ } else {
+ _redraw
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _redraw
+#
+# Redraws the calendar. This method is invoked whenever the
+# calendar changes size or we need to effect a change such as draw
+# it with a new month.
+# ------------------------------------------------------------------
+body iwidgets::Calendar::_redraw {} {
+ #
+ # Remove all the items that typically change per redraw request
+ # such as the title and dates. Also, get the maximum width and
+ # height of the page.
+ #
+ $itk_component(page) delete all-page
+
+ set wmax [winfo width $itk_component(page)]
+ set hmax [winfo height $itk_component(page)]
+
+ #
+ # If we haven't yet created the forward and backwards buttons,
+ # then dot it; otherwise, skip it.
+ #
+ if {[$itk_component(page) find withtag button] == {}} {
+ $itk_component(page) create window 3 3 -anchor nw \
+ -window $itk_component(backward) -tags button
+ $itk_component(page) create window [expr $wmax-3] 3 -anchor ne \
+ -window $itk_component(forward) -tags button
+ }
+
+ #
+ # Create the title centered between the buttons.
+ #
+ foreach {x0 y0 x1 y1} [$itk_component(page) bbox button] {
+ set x [expr (($x1-$x0)/2)+$x0]
+ set y [expr (($y1-$y0)/2)+$y0]
+ }
+
+ set title [clock format $_time -format "%B %Y"]
+ $itk_component(page) create text $x $y -anchor center \
+ -text $title -font $itk_option(-titlefont) \
+ -fill $itk_option(-foreground) \
+ -tags [list title text all-page]
+
+ #
+ # Add the days of the week labels if they haven't yet been created.
+ #
+ if {[$itk_component(page) find withtag days] == {}} {
+ _days $wmax
+ }
+
+ #
+ # Add a line between the calendar header and the dates if needed.
+ #
+ set bottom [expr [lindex [$itk_component(page) bbox all] 3] + 3]
+
+ if {[$itk_component(page) find withtag line] == {}} {
+ $itk_component(page) create line 0 $bottom $wmax $bottom \
+ -width 2 -tags line
+ }
+
+ incr bottom 3
+
+ #
+ # Get the layout for the time value and create the date squares.
+ # This includes the surrounding date rectangle, the date text,
+ # and the sensor. Bind selection to the sensor.
+ #
+ set current ""
+ set now [clock format [clock seconds] -format "%m/%d/%Y"]
+
+ set layout [_layout $_time]
+ set weeks [expr [lindex $layout end] + 1]
+
+ foreach {day date kind dcol wrow} $layout {
+ set x0 [expr $dcol*($wmax-7)/7+3]
+ set y0 [expr $wrow*($hmax-$bottom-4)/$weeks+$bottom]
+ set x1 [expr ($dcol+1)*($wmax-7)/7+3]
+ set y1 [expr ($wrow+1)*($hmax-$bottom-4)/$weeks+$bottom]
+
+ if {$date == $_selected} {
+ set current $date
+ }
+
+ #
+ # Create the rectangle that surrounds the date and configure
+ # its background based on the wheather it is a weekday or
+ # a weekend.
+ #
+ set item [$itk_component(page) create rectangle $x0 $y0 $x1 $y1 \
+ -outline $itk_option(-outline)]
+
+ if {$kind == "weekend"} {
+ $itk_component(page) itemconfigure $item \
+ -fill $itk_option(-weekendbackground) \
+ -tags [list all-page square weekend]
+ } else {
+ $itk_component(page) itemconfigure $item \
+ -fill $itk_option(-weekdaybackground) \
+ -tags [list all-page square weekday]
+ }
+
+ #
+ # Create the date text and configure its font based on the
+ # wheather or not it is the current date.
+ #
+ _drawtext $itk_component(page) $day $date $now $x0 $y0 $x1 $y1
+
+ #
+ # Create a sensor area to detect selections. Bind the
+ # sensor and pass the date to the bind script.
+ #
+ $itk_component(page) create rectangle $x0 $y0 $x1 $y1 \
+ -outline "" -fill "" \
+ -tags [list $date-sensor all-sensor all-page]
+
+ $itk_component(page) bind $date-sensor <ButtonPress-1> \
+ [code $this _selectEvent $date]
+ }
+
+ #
+ # Highlight the selected date if it is on this page.
+ #
+ if {$current != ""} {
+ $itk_component(page) itemconfigure $current-sensor \
+ -outline $itk_option(-selectcolor) \
+ -width $itk_option(-selectthickness)
+
+ $itk_component(page) raise $current-sensor
+
+ } elseif {$_selected == ""} {
+ set date [clock format $_time -format "%m/%d/%Y"]
+ _select $date
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _days
+#
+# Used to rewite the days of the week label just below the month
+# title string. The days are given in the -days option.
+# ------------------------------------------------------------------
+body iwidgets::Calendar::_days {{wmax {}}} {
+ if {$wmax == {}} {
+ set wmax [winfo width $itk_component(page)]
+ }
+
+ set col 0
+ set bottom [expr [lindex [$itk_component(page) bbox title buttons] 3] + 7]
+
+ foreach dayoweek $itk_option(-days) {
+ set x0 [expr $col*($wmax/7)]
+ set x1 [expr ($col+1)*($wmax/7)]
+
+ $itk_component(page) create text \
+ [expr (($x1 - $x0) / 2) + $x0] $bottom \
+ -anchor n -text "$dayoweek" \
+ -fill $itk_option(-foreground) \
+ -font $itk_option(-dayfont) \
+ -tags [list days text]
+
+ incr col
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _layout time_
+#
+# Used whenever the calendar is redrawn. Finds the month containing
+# a <time_> in seconds, and returns a list for all of the days in
+# that month. The list looks like this:
+#
+# {day1 date1 kind1 c1 r1 day2 date2 kind2 c2 r2 ...}
+#
+# where dayN is a day number like 1,2,3,..., dateN is the date for
+# dayN, kindN is the day type of weekday or weekend, and cN,rN
+# are the column/row indices for the square containing that date.
+# ------------------------------------------------------------------
+body iwidgets::Calendar::_layout {time_} {
+ set month [clock format $time_ -format "%m"]
+ set year [clock format $time_ -format "%Y"]
+
+ foreach lastday {31 30 29 28} {
+ if {[catch {clock scan "$month/$lastday/$year"}] == 0} {
+ break
+ }
+ }
+ set seconds [clock scan "$month/1/$year"]
+ set firstday [_adjustday [clock format $seconds -format %w]]
+
+ set weeks [expr ceil(double($lastday+$firstday)/7)]
+
+ set rlist ""
+ for {set day 1} {$day <= $lastday} {incr day} {
+ set seconds [clock scan "$month/$day/$year"]
+ set date [clock format $seconds -format "%m/%d/%Y"]
+ set dayoweek [clock format $seconds -format %w]
+
+ if {$dayoweek == 0 || $dayoweek == 6} {
+ set kind "weekend"
+ } else {
+ set kind "weekday"
+ }
+
+ set daycol [_adjustday $dayoweek]
+
+ set weekrow [expr ($firstday+$day-1)/7]
+ lappend rlist $day $date $kind $daycol $weekrow
+ }
+ return $rlist
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _adjustday day_
+#
+# Modifies the day to be in accordance with the startday option.
+# ------------------------------------------------------------------
+body iwidgets::Calendar::_adjustday {day_} {
+ set retday [expr $day_ - $_offset]
+
+ if {$retday < 0} {
+ set retday [expr $retday + 7]
+ }
+
+ return $retday
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _select date_
+#
+# Selects the current <date_> on the calendar. Highlights the date
+# on the calendar, and executes the command associated with the
+# calendar, with the selected date substituted in place of "%d".
+# ------------------------------------------------------------------
+body iwidgets::Calendar::_select {date_} {
+ set time [clock scan $date_]
+ set date [clock format $time -format "%m/%d/%Y"]
+
+ set _selected $date
+
+ set current [clock format $_time -format "%m %Y"]
+ set selected [clock format $time -format "%m %Y"]
+
+ if {$current == $selected} {
+ $itk_component(page) itemconfigure all-sensor \
+ -outline "" -width 1
+
+ $itk_component(page) itemconfigure $date-sensor \
+ -outline $itk_option(-selectcolor) \
+ -width $itk_option(-selectthickness)
+ $itk_component(page) raise $date-sensor
+ } else {
+ set $_time $time
+ _redraw
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _selectEvent date_
+#
+# Selects the current <date_> on the calendar. Highlights the date
+# on the calendar, and executes the command associated with the
+# calendar, with the selected date substituted in place of "%d".
+# ------------------------------------------------------------------
+body iwidgets::Calendar::_selectEvent {date_} {
+ _select $date_
+
+ if {[string trim $itk_option(-command)] != ""} {
+ set cmd $itk_option(-command)
+ set cmd [_percentSubst %d $cmd [get]]
+ uplevel #0 $cmd
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _percentSubst pattern_ string_ subst_
+#
+# This command is a "safe" version of regsub, for substituting
+# each occurance of <%pattern_> in <string_> with <subst_>. The
+# usual Tcl "regsub" command does the same thing, but also
+# converts characters like "&" and "\0", "\1", etc. that may
+# be present in the <subst_> string.
+#
+# Returns <string_> with <subst_> substituted in place of each
+# <%pattern_>.
+# ------------------------------------------------------------------
+body iwidgets::Calendar::_percentSubst {pattern_ string_ subst_} {
+ if {![string match %* $pattern_]} {
+ error "bad pattern \"$pattern_\": should be %something"
+ }
+
+ set rval ""
+ while {[regexp "(.*)${pattern_}(.*)" $string_ all head tail]} {
+ set rval "$subst_$tail$rval"
+ set string_ $head
+ }
+ set rval "$string_$rval"
+}
diff --git a/itcl/iwidgets3.0.0/generic/canvasprintbox.itk b/itcl/iwidgets3.0.0/generic/canvasprintbox.itk
new file mode 100644
index 00000000000..20a566a5fab
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/canvasprintbox.itk
@@ -0,0 +1,1110 @@
+#
+# CanvasPrintBox v1.5
+# ----------------------------------------------------------------------
+# Implements a print box for printing the contents of a canvas widget
+# to a printer or a file. It is possible to specify page orientation, the
+# number of pages to print the image on and if the output should be
+# stretched to fit the page.
+#
+# CanvasPrintBox is a "super-widget" that can be used as an
+# element in ones own GUIs. It is used to print the contents
+# of a canvas (called the source hereafter) to a printer or a
+# file. Possible settings include: portrait and landscape orientation
+# of the output, stretching the output to fit the page while maintaining
+# a proper aspect-ratio and posterizing to enlarge the output to fit on
+# multiple pages. A stamp-sized copy of the source will be shown (called
+# the stamp hereafter) at all times to reflect the effect of changing
+# the settings will have on the output.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Tako Schotanus EMAIL: Tako.Schotanus@bouw.tno.nl
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 Tako Schotanus
+# ======================================================================
+# Permission is hereby granted, without written agreement and without
+# license or royalty fees, to use, copy, modify, and distribute this
+# software and its documentation for any purpose, provided that the
+# above copyright notice and the following two paragraphs appear in
+# all copies of this software.
+#
+# IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR
+# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+# ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN
+# IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+# DAMAGE.
+#
+# THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING,
+# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+# FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
+# ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO
+# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
+# ======================================================================
+
+#
+# Default resources.
+#
+option add *Canvasprintbox.filename "canvas.ps" widgetDefault
+option add *Canvasprintbox.hPageCnt 1 widgetDefault
+option add *Canvasprintbox.orient landscape widgetDefault
+option add *Canvasprintbox.output printer widgetDefault
+option add *Canvasprintbox.pageSize A4 widgetDefault
+option add *Canvasprintbox.posterize 0 widgetDefault
+option add *Canvasprintbox.printCmd lpr widgetDefault
+option add *Canvasprintbox.printRegion "" widgetDefault
+option add *Canvasprintbox.vPageCnt 1 widgetDefault
+
+#
+# Usual options.
+#
+itk::usual Canvasprintbox {
+ keep -background -cursor -textbackground -foreground
+}
+
+#<
+#
+# CanvasPrintBox is a "super-widget" that can be used as an
+# element in ones own GUIs. It is used to print the contents
+# of a canvas (called the source hereafter) to a printer or a
+# file. Possible settings include: portrait and landscape orientation
+# of the output, stretching the output to fit the page while maintaining
+# a proper aspect-ratio and posterizing to enlarge the output to fit on
+# multiple pages. A stamp-sized copy of the source will be shown (called
+# the stamp hereafter) at all times to reflect the effect of changing
+# the settings will have on the output.
+#
+#>
+class iwidgets::Canvasprintbox {
+ inherit itk::Widget
+
+ #
+ # Holds the current state for all check- and radiobuttons.
+ #
+ itk_option define -filename filename FileName "canvas.ps"
+ itk_option define -hpagecnt hPageCnt PageCnt 1
+ itk_option define -orient orient Orient "landscape"
+ itk_option define -output output Output "printer"
+ itk_option define -pagesize pageSize PageSize "A4"
+ itk_option define -posterize posterize Posterize 0
+ itk_option define -printcmd printCmd PrintCmd ""
+ itk_option define -printregion printRegion PrintRegion ""
+ itk_option define -stretch stretch Stretch 0
+ itk_option define -vpagecnt vPageCnt PageCnt 1
+
+ constructor {args} {}
+ destructor {}
+
+ # ---------------------------------------------------------------
+ # PUBLIC
+ #----------------------------------------------------------------
+ public {
+ method getoutput {}
+ method print {}
+ method refresh {}
+ method setcanvas {canv}
+ method stop {}
+ }
+
+ # ---------------------------------------------------------------
+ # PROTECTED
+ #----------------------------------------------------------------
+ protected {
+ #
+ # Just holds the names of some widgets/objects. "win" is used to
+ # determine if the object is fully constructed and initialized.
+ #
+ variable win ""
+ variable canvw ""
+
+ #
+ # The canvas we want to print.
+ #
+ variable canvas ""
+
+ #
+ # Boolean indicating if the attribute "orient" is set
+ # to landscape or not.
+ #
+ variable rotate 1
+
+ #
+ # Holds the configure options that were used to create this object.
+ #
+ variable init_opts ""
+
+ #
+ # The following attributes hold a list of lines that are
+ # currently drawn on the "stamp" to show how the page(s) is/are
+ # oriented. The first holds the vertical dividing lines and the
+ # second the horizontal ones.
+ #
+ variable hlines ""
+ variable vlines ""
+
+ #
+ # Updating is set when the thumbnail is being drawn. Settings
+ # this to 0 while drawing is still busy will terminate the
+ # proces.
+ # Restart_update can be set to 1 when the thumbnail is being
+ # drawn to force a redraw.
+ #
+ variable _reposition ""
+ variable _update_attr_id ""
+
+ method _calc_poster_size {}
+ method _calc_print_region {}
+ method _calc_print_scale {}
+ method _mapEventHandler {}
+ method _update_attr {{when later}}
+ method _update_canvas {{when later}}
+
+ common _globVar
+
+ proc ezPaperInfo {size {attr ""} \
+ {orient "portrait"} {window ""}} {}
+ }
+}
+
+#
+# Provide a lowercased access method for the Canvasprintbox class.
+#
+proc ::iwidgets::canvasprintbox {args} {
+ uplevel ::iwidgets::Canvasprintbox $args
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+#<
+# A list of four coordinates specifying which part of the canvas to print.
+# An empty list means that the canvas' entire scrollregion should be
+# printed. Any change to this attribute will automatically update the "stamp".
+# Defaults to an empty list.
+#>
+configbody iwidgets::Canvasprintbox::printregion {
+ if {$itk_option(-printregion) != ""
+ && [llength $itk_option(-printregion)] != 4} {
+ error {bad option "printregion": should contain 4 coordinates}
+ }
+ _update_canvas
+}
+
+#<
+# Specifies where the postscript output should go: to the printer
+# or to a file. Can take on the values "printer" or "file".
+# The corresponding entry-widget will reflect the contents of
+# either the printcmd attribute or the filename attribute.
+#>
+configbody iwidgets::Canvasprintbox::output {
+ switch $itk_option(-output) {
+ file - printer {
+ set _globVar($this,output) $itk_option(-output)
+ }
+ default {
+ error {bad output option \"$itk_option(-output)\":\
+ should be file or printer}
+ }
+ }
+ _update_attr
+}
+
+#<
+# The command to execute when printing the postscript output.
+# The command will get the postscript directed to its standard
+# input. (Only when output is set to "printer")
+#>
+configbody iwidgets::Canvasprintbox::printcmd {
+ set _globVar($this,printeref) $itk_option(-printcmd)
+ _update_attr
+}
+
+#<
+# The file to write the postscript output to (Only when output
+# is set to "file"). If posterizing is turned on and hpagecnt
+# and/or vpagecnt is more than 1, x.y is appended to the filename
+# where x is the horizontal page number and y the vertical page number.
+#>
+configbody iwidgets::Canvasprintbox::filename {
+ set _globVar($this,fileef) $itk_option(-filename)
+ _update_attr
+}
+
+#<
+# The pagesize the printer supports. Changes to this attribute
+# will be reflected immediately in the "stamp".
+#>
+configbody iwidgets::Canvasprintbox::pagesize {
+ set opt [string tolower $itk_option(-pagesize)]
+ set lst [string tolower [ezPaperInfo types]]
+ if {[lsearch $lst $opt] == -1} {
+ error "bad option \"pagesize\": should be one of: [ezPaperInfo types]"
+ }
+ _update_canvas
+}
+
+#<
+# Determines the orientation of the output to the printer (or file).
+# It can take the value "portrait" or "landscape" (default). Changes
+# to this attribute will be reflected immediately in the "stamp".
+#>
+configbody iwidgets::Canvasprintbox::orient {
+ switch $itk_option(-orient) {
+ "portrait" - "landscape" {
+ $itk_component(orientom) select $itk_option(-orient)
+ _update_canvas
+
+ }
+ default {
+ error "bad orient option \"$itk_option(-orient)\":\
+ should be portrait or landscape"
+ }
+ }
+}
+
+#<
+# Determines if the output should be stretched to fill the
+# page (as defined by the attribute pagesize) as large as
+# possible. The aspect-ratio of the output will be retained
+# and the output will never fall outside of the boundaries
+# of the page.
+#>
+configbody iwidgets::Canvasprintbox::stretch {
+ if {$itk_option(-stretch) != 0 && $itk_option(-stretch) != 1} {
+ error {bad option "stretch": should be a boolean}
+ }
+ set _globVar($this,stretchcb) $itk_option(-stretch)
+ _update_attr
+}
+
+#<
+# Indicates if posterizing is turned on or not. Posterizing
+# the output means that it is possible to distribute the
+# output over more than one page. This way it is possible to
+# print a canvas/region which is larger than the specified
+# pagesize without stretching. If used in combination with
+# stretching it can be used to "blow up" the contents of a
+# canvas to as large as size as you want (See attributes:
+# hpagecnt end vpagecnt). Any change to this attribute will
+# automatically update the "stamp".
+#>
+configbody iwidgets::Canvasprintbox::posterize {
+ if {$itk_option(-posterize) != "0" && $itk_option(-posterize) != "1"} {
+ error "expected boolean but got \"$itk_option(-posterize)\""
+ }
+ set _globVar($this,postercb) $itk_option(-posterize)
+ _update_canvas
+}
+
+#<
+# Is used in combination with "posterize" to determine over
+# how many pages the output should be distributed. This
+# attribute specifies how many pages should be used horizontaly.
+# Any change to this attribute will automatically update the "stamp".
+#>
+configbody iwidgets::Canvasprintbox::hpagecnt {
+ set _globVar($this,hpc) $itk_option(-hpagecnt)
+ _update_canvas
+}
+
+#<
+# Is used in combination with "posterize" to determine over
+# how many pages the output should be distributed. This
+# attribute specifies how many pages should be used verticaly.
+# Any change to this attribute will automatically update the "stamp".
+#>
+configbody iwidgets::Canvasprintbox::vpagecnt {
+ set _globVar($this,vpc) $itk_option(-vpagecnt)
+ _update_canvas
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Canvasprintbox::constructor {args} {
+ set _globVar($this,output) printer
+ set _globVar($this,printeref) ""
+ set _globVar($this,fileef) "canvas.ps"
+ set _globVar($this,hpc) 1
+ set _globVar($this,vpc) 1
+ set _globVar($this,postercb) 0
+ set _globVar($this,stretchcb) 0
+
+ itk_component add canvasframe {
+ frame $itk_interior.f18 -bd 2
+ }
+
+ itk_component add canvas {
+ canvas $itk_component(canvasframe).c1 \
+ -bd 2 -relief sunken \
+ -scrollregion {0c 0c 10c 10c} \
+ -width 250
+ }
+ pack $itk_component(canvas) -expand 1 -fill both
+
+ itk_component add outputom {
+ iwidgets::Labeledframe $itk_interior.outputom \
+ -labelpos nw \
+ -labeltext "Output to"
+ }
+ set cs [$itk_component(outputom) childsite]
+
+ itk_component add printerrb {
+ radiobutton $cs.printerrb \
+ -text Printer \
+ -variable [scope _globVar($this,output)] \
+ -anchor w \
+ -justify left \
+ -value printer \
+ -command [code $this _update_attr]
+ } {
+ usual
+ rename -font -labelfont labelFont Font
+ }
+ itk_component add printeref {
+ iwidgets::entryfield $cs.printeref \
+ -labeltext "command:" \
+ -state normal \
+ -labelpos w \
+ -textvariable [scope _globVar($this,printeref)]
+ }
+
+ itk_component add filerb {
+ radiobutton $cs.filerb \
+ -text File \
+ -justify left \
+ -anchor w \
+ -variable [scope _globVar($this,output)] \
+ -value file \
+ -command [code $this _update_attr]
+ } {
+ usual
+ rename -font -labelfont labelFont Font
+ }
+ itk_component add fileef {
+ iwidgets::entryfield $cs.fileef \
+ -labeltext "filename:" \
+ -state disabled \
+ -labelpos w \
+ -textvariable [scope _globVar($this,fileef)]
+ }
+
+ itk_component add propsframe {
+ iwidgets::Labeledframe $itk_interior.propsframe \
+ -labelpos nw \
+ -labeltext "Properties"
+ }
+ set cs [$itk_component(propsframe) childsite]
+
+ itk_component add paperom {
+ iwidgets::optionmenu $cs.paperom \
+ -labelpos w -cyclicon 1 \
+ -labeltext "Paper size:" \
+ -command [code $this refresh]
+ } {
+ usual
+ rename -font -labelfont labelFont Font
+ }
+ eval $itk_component(paperom) insert end [ezPaperInfo types]
+ $itk_component(paperom) select A4
+
+ itk_component add orientom {
+ iwidgets::radiobox $itk_interior.orientom \
+ -labeltext "Orientation" -command [code $this refresh]
+ }
+ $itk_component(orientom) add landscape -text Landscape
+ $itk_component(orientom) add portrait -text Portrait
+ $itk_component(orientom) select 0
+
+ itk_component add stretchcb {
+ checkbutton $cs.stretchcb \
+ -relief flat \
+ -text {Stretch to fit} \
+ -justify left \
+ -anchor w \
+ -variable [scope _globVar($this,stretchcb)] \
+ -command [code $this refresh]
+ } {
+ usual
+ rename -font -labelfont labelFont Font
+ }
+
+ itk_component add postercb {
+ checkbutton $cs.postercb \
+ -relief flat \
+ -text Posterize \
+ -justify left \
+ -anchor w \
+ -variable [scope _globVar($this,postercb)] \
+ -command [code $this refresh]
+ } {
+ usual
+ rename -font -labelfont labelFont Font
+ }
+
+ itk_component add hpcnt {
+ iwidgets::entryfield $cs.hpcnt \
+ -labeltext on \
+ -textvariable [scope _globVar($this,hpc)] \
+ -validate integer -width 3 \
+ -command [code $this refresh]
+ }
+
+ itk_component add vpcnt {
+ iwidgets::entryfield $cs.vpcnt \
+ -labeltext by \
+ -textvariable [scope _globVar($this,vpc)] \
+ -validate integer -width 3 \
+ -command [code $this refresh]
+ }
+
+ itk_component add pages {
+ label $cs.pages -text pages.
+ } {
+ usual
+ rename -font -labelfont labelFont Font
+ }
+
+ set init_opts $args
+
+ grid $itk_component(canvasframe) -row 0 -column 0 -rowspan 4 -sticky nsew
+ grid $itk_component(propsframe) -row 0 -column 1 -sticky nsew
+ grid $itk_component(outputom) -row 1 -column 1 -sticky nsew
+ grid $itk_component(orientom) -row 2 -column 1 -sticky nsew
+ grid columnconfigure $itk_interior 0 -weight 1
+ grid rowconfigure $itk_interior 3 -weight 1
+
+ grid $itk_component(printerrb) -row 0 -column 0 -sticky nsw
+ grid $itk_component(printeref) -row 0 -column 1 -sticky nsw
+ grid $itk_component(filerb) -row 1 -column 0 -sticky nsw
+ grid $itk_component(fileef) -row 1 -column 1 -sticky nsw
+ iwidgets::Labeledwidget::alignlabels $itk_component(printeref) $itk_component(fileef)
+ grid columnconfigure $itk_component(outputom) 1 -weight 1
+
+ grid $itk_component(paperom) -row 0 -column 0 -columnspan 2 -sticky nsw
+ grid $itk_component(stretchcb) -row 1 -column 0 -sticky nsw
+ grid $itk_component(postercb) -row 2 -column 0 -sticky nsw
+ grid $itk_component(hpcnt) -row 2 -column 1 -sticky nsw
+ grid $itk_component(vpcnt) -row 2 -column 2 -sticky nsw
+ grid $itk_component(pages) -row 2 -column 3 -sticky nsw
+ grid columnconfigure $itk_component(propsframe) 3 -weight 1
+
+ eval itk_initialize $args
+
+ bind $itk_component(pages) <Map> +[code $this _mapEventHandler]
+ bind $itk_component(canvas) <Configure> +[code $this refresh]
+}
+
+
+# ---------------------------------------------------------------
+# PUBLIC METHODS
+#----------------------------------------------------------------
+
+#<
+# This is used to set the canvas that has to be printed.
+# A stamp-sized copy will automatically be drawn to show how the
+# output would look with the current settings.
+#
+# In: canv - The canvas to be printed
+# Out: canvas (attrib) - Holds the canvas to be printed
+#>
+body iwidgets::Canvasprintbox::setcanvas {canv} {
+ set canvas $canv
+ _update_canvas
+}
+
+#<
+# Returns the value of the -printercmd or -filename option
+# depending on the current setting of -output.
+#
+# In: itk_option (attrib)
+# Out: The value of -printercmd or -filename
+#>
+body iwidgets::Canvasprintbox::getoutput {} {
+ switch $_globVar($this,output) {
+ "file" {
+ return $_globVar($this,fileef)
+ }
+ "printer" {
+ return $_globVar($this,printeref)
+ }
+ }
+ return ""
+}
+
+#<
+# Perfrom the actual printing of the canvas using the current settings of
+# all the attributes.
+#
+# In: itk_option, rotate (attrib)
+# Out: A boolean indicating wether printing was successful
+#>
+body iwidgets::Canvasprintbox::print {} {
+
+ global env tcl_platform
+
+ stop
+
+ if {$itk_option(-output) == "file"} {
+ set nm $itk_option(-filename)
+ if {[string range $nm 0 1] == "~/"} {
+ set nm "$env(HOME)/[string range $nm 2 end]"
+ }
+ } else {
+ set nm "/tmp/xge[winfo id $canvas]"
+ }
+
+ set pr [_calc_print_region]
+ set x1 [lindex $pr 0]
+ set y1 [lindex $pr 1]
+ set x2 [lindex $pr 2]
+ set y2 [lindex $pr 3]
+ set cx [expr int(($x2 + $x1) / 2)]
+ set cy [expr int(($y2 + $y1) / 2)]
+ if {!$itk_option(-stretch)} {
+ set ps [_calc_poster_size]
+ set pshw [expr int([lindex $ps 0] / 2)]
+ set pshh [expr int([lindex $ps 1] / 2)]
+ set x [expr $cx - $pshw]
+ set y [expr $cy - $pshh]
+ set w [ezPaperInfo $itk_option(-pagesize) pwidth $itk_option(-orient) $win]
+ set h [ezPaperInfo $itk_option(-pagesize) pheight $itk_option(-orient) $win]
+ } else {
+ set x $x1
+ set y $y1
+ set w [expr ($x2-$x1) / $_globVar($this,hpc)]
+ set h [expr ($y2-$y1) / $_globVar($this,vpc)]
+ }
+
+ set i 0
+ set px $x
+ while {$i < $_globVar($this,hpc)} {
+ set j 0
+ set py $y
+ while {$j < $_globVar($this,vpc)} {
+ set nm2 [expr {$_globVar($this,hpc) > 1 || $_globVar($this,vpc) > 1 ? "$nm$i.$j" : $nm}]
+
+ if {$itk_option(-stretch)} {
+ $canvas postscript \
+ -file $nm2 \
+ -rotate $rotate \
+ -x $px -y $py \
+ -width $w \
+ -height $h \
+ -pagex [ezPaperInfo $itk_option(-pagesize) centerx] \
+ -pagey [ezPaperInfo $itk_option(-pagesize) centery] \
+ -pagewidth [ezPaperInfo $itk_option(-pagesize) pwidth $itk_option(-orient)] \
+ -pageheight [ezPaperInfo $itk_option(-pagesize) pheight $itk_option(-orient)]
+ } else {
+ $canvas postscript \
+ -file $nm2 \
+ -rotate $rotate \
+ -x $px -y $py \
+ -width $w \
+ -height $h \
+ -pagex [ezPaperInfo $itk_option(-pagesize) centerx] \
+ -pagey [ezPaperInfo $itk_option(-pagesize) centery]
+ }
+
+ if {$itk_option(-output) == "printer"} {
+ set cmd "$itk_option(-printcmd) < $nm2"
+ if {[catch {eval exec $cmd &}]} {
+ return 0
+ }
+ }
+
+ set py [expr $py + $h]
+ incr j
+ }
+ set px [expr $px + $w]
+ incr i
+ }
+
+ return 1
+}
+
+#<
+# Retrieves the current value for all edit fields and updates
+# the stamp accordingly. Is useful for Apply-buttons.
+#>
+body iwidgets::Canvasprintbox::refresh {} {
+ stop
+ _update_canvas
+ return
+}
+
+#<
+# Stops the drawing of the "stamp". I'm currently unable to detect
+# when a Canvasprintbox gets withdrawn. It's therefore advised
+# that you perform a stop before you do something like that.
+#>
+body iwidgets::Canvasprintbox::stop {} {
+
+ if {$_reposition != ""} {
+ after cancel $_reposition
+ set _reposition ""
+ }
+
+ if {$_update_attr_id != ""} {
+ after cancel $_update_attr_id
+ set _update_attr_id ""
+ }
+
+ return
+}
+
+# ---------------------------------------------------------------
+# PROTECTED METHODS
+#----------------------------------------------------------------
+
+#
+# Calculate the total size the output would be with the current
+# settings for "pagesize" and "posterize" (and "hpagecnt" and
+# "vpagecnt"). This size will be the size of the printable area,
+# some space has been substracted to take into account that a
+# page should have borders because most printers can't print on
+# the very edge of the paper.
+#
+# In: posterize, hpagecnt, vpagecnt, pagesize, orient (attrib)
+# Out: A list of two numbers indicating the width and the height
+# of the total paper area which will be used for printing
+# in pixels.
+#
+body iwidgets::Canvasprintbox::_calc_poster_size {} {
+ set tpw [expr [ezPaperInfo $itk_option(-pagesize) \
+ pwidth $itk_option(-orient) $win]*$_globVar($this,hpc)]
+ set tph [expr [ezPaperInfo $itk_option(-pagesize) \
+ pheight $itk_option(-orient) $win]*$_globVar($this,vpc)]
+
+ return "$tpw $tph"
+}
+
+#
+# Determine which area of the "source" canvas will be printed.
+# If "printregion" was set by the "user" this will be used and
+# converted to pixel-coordinates. If the user didn't set it
+# the bounding box that contains all canvas-items will be used
+# instead.
+#
+# In: printregion, canvas (attrib)
+# Out: Four floats specifying the region to be printed in
+# pixel-coordinates (topleft & bottomright).
+#
+body iwidgets::Canvasprintbox::_calc_print_region {} {
+ set printreg [expr {$itk_option(-printregion) != ""
+ ? $itk_option(-printregion) : [$canvas bbox all]}]
+
+ if {$printreg != ""} {
+ set prx1 [winfo fpixels $canvas [lindex $printreg 0]]
+ set pry1 [winfo fpixels $canvas [lindex $printreg 1]]
+ set prx2 [winfo fpixels $canvas [lindex $printreg 2]]
+ set pry2 [winfo fpixels $canvas [lindex $printreg 3]]
+
+ set res "$prx1 $pry1 $prx2 $pry2"
+ } else {
+ set res "0 0 0 0"
+ }
+
+ return $res
+}
+
+#
+# Calculate the scaling factor needed if the output was
+# to be stretched to fit exactly on the page (or pages).
+# If stretching is turned off this will always return 1.0.
+#
+# In: stretch (attrib)
+# Out: A float specifying the scaling factor.
+#
+body iwidgets::Canvasprintbox::_calc_print_scale {} {
+ if {$itk_option(-stretch)} {
+ set pr [_calc_print_region]
+ set prw [expr [lindex $pr 2] - [lindex $pr 0]]
+ set prh [expr [lindex $pr 3] - [lindex $pr 1]]
+ set ps [_calc_poster_size]
+ set psw [lindex $ps 0]
+ set psh [lindex $ps 1]
+ set sfx [expr $psw / $prw]
+ set sfy [expr $psh / $prh]
+ set sf [expr {$sfx < $sfy ? $sfx : $sfy}]
+ return $sf
+ } else {
+ return 1.0
+ }
+}
+
+#
+# Schedule the thread that makes a copy of the "source"
+# canvas to the "stamp".
+#
+# In: win, canvas (attrib)
+# Out: -
+#
+body iwidgets::Canvasprintbox::_update_canvas {{when later}} {
+ if {$win == "" || $canvas == "" || [$canvas find all] == ""} {
+ return
+ }
+ if {$when == "later"} {
+ if {$_reposition == ""} {
+ set _reposition [after idle [code $this _update_canvas now]]
+ }
+ return
+ }
+
+ _update_attr now
+
+ #
+ # Make a copy of the "source" canvas to the "stamp".
+ #
+ if {$_globVar($this,hpc) == [llength $vlines] &&
+ $_globVar($this,vpc) == [llength $hlines]} {
+ stop
+ return
+ }
+
+ $canvw delete all
+
+ set width [winfo width $canvw]
+ set height [winfo height $canvw]
+ set ps [_calc_poster_size]
+
+ #
+ # Calculate the scaling factor that would be needed to fit the
+ # whole "source" into the "stamp". This takes into account the
+ # total amount of "paper" that would be needed to print the
+ # contents of the "source".
+ #
+ set xsf [expr $width/[lindex $ps 0]]
+ set ysf [expr $height/[lindex $ps 1]]
+ set sf [expr {$xsf < $ysf ? $xsf : $ysf}]
+ set w [expr [lindex $ps 0]*$sf]
+ set h [expr [lindex $ps 1]*$sf]
+ set x1 [expr ($width-$w)/2]
+ set y1 [expr ($height-$h)/2]
+ set x2 [expr $x1+$w]
+ set y2 [expr $y1+$h]
+ set cx [expr ($x2+$x1)/ 2]
+ set cy [expr ($y2+$y1)/ 2]
+
+ set printreg [_calc_print_region]
+ set prx1 [lindex $printreg 0]
+ set pry1 [lindex $printreg 1]
+ set prx2 [lindex $printreg 2]
+ set pry2 [lindex $printreg 3]
+ set prcx [expr ($prx2+$prx1)/2]
+ set prcy [expr ($pry2+$pry1)/2]
+
+ set psf [_calc_print_scale]
+
+ #
+ # Copy all items from the "real" canvas to the canvas
+ # showing what we'll send to the printer. Bitmaps and
+ # texts are not copied because they can't be scaled,
+ # a rectangle will be created instead.
+ #
+ set tsf [expr $sf * $psf]
+ set dx [expr $cx-($prcx*$tsf)]
+ set dy [expr $cy-($prcy*$tsf)]
+ $canvw create rectangle \
+ [expr $x1+0] \
+ [expr $y1+0] \
+ [expr $x2-0] \
+ [expr $y2-0] -fill white
+ set items [eval "$canvas find overlapping $printreg"]
+
+ set itemCount [llength $items]
+ for {set cnt 0} {$cnt < $itemCount} {incr cnt} {
+ #
+ # Determine the item's type and coordinates
+ #
+ set i [lindex $items $cnt]
+ set t [$canvas type $i]
+ set crds [$canvas coords $i]
+
+ #
+ # Ask for the item's configuration settings and strip
+ # it to leave only a list of option names and values.
+ #
+ set cfg [$canvas itemconfigure $i]
+ set cfg2 ""
+ foreach c $cfg {
+ if {[llength $c] == 5} {
+ lappend cfg2 [lindex $c 0] [lindex $c 4]
+ }
+ }
+
+ #
+ # Handle texts and bitmaps differently: they will
+ # be represented as rectangles.
+ #
+ if {$t == "text" || $t == "bitmap" || $t == "window"} {
+ set t "rectangle"
+ set crds [$canvas bbox $i]
+ set cfg2 "-outline {} -fill gray"
+ }
+
+ #
+ # Remove the arrows from a line item when the scale
+ # factor drops below 1/3rd of the original size.
+ # This to prevent the arrowheads from dominating the
+ # display.
+ #
+ if {$t == "line" && $tsf < 0.33} {
+ lappend cfg2 -arrow none
+ }
+
+ #
+ # Create a copy of the item on the "printing" canvas.
+ #
+ set i2 [eval "$canvw create $t $crds $cfg2"]
+ $canvw scale $i2 0 0 $tsf $tsf
+ $canvw move $i2 $dx $dy
+
+ if {[expr $cnt%25] == 0} {
+ update
+ }
+ if {$_reposition == ""} {
+ return
+ }
+ }
+
+ set p $x1
+ set i 1
+ set vlines {}
+ while {$i < $_globVar($this,hpc)} {
+ set p [expr $p + ($w/$_globVar($this,hpc))]
+ set l [$canvw create line $p $y1 $p $y2]
+ lappend vlines $l
+ incr i
+ }
+
+ set p $y1
+ set i 1
+ set vlines {}
+ while {$i < $_globVar($this,vpc)} {
+ set p [expr $p + ($h/$_globVar($this,vpc))]
+ set l [$canvw create line $x1 $p $x2 $p]
+ lappend vlines $l
+ incr i
+ }
+
+ set _reposition ""
+}
+
+#
+# Update the attributes to reflect changes made in the user-
+# interface.
+#
+# In: itk_option (attrib) - the attributes to update
+# itk_component (attrib) - the widgets
+# _globVar (common) - the global var holding the state
+# of all radiobuttons and checkboxes.
+# Out: -
+#
+body iwidgets::Canvasprintbox::_update_attr {{when "later"}} {
+ if {$when != "now"} {
+ if {$_update_attr_id == ""} {
+ set _update_attr_id [after idle [code $this _update_attr now]]
+ }
+ return
+ }
+
+ set itk_option(-printcmd) $_globVar($this,printeref)
+ set itk_option(-filename) $_globVar($this,fileef)
+ set itk_option(-output) $_globVar($this,output)
+ set itk_option(-pagesize) [string tolower [$itk_component(paperom) get]]
+ set itk_option(-stretch) $_globVar($this,stretchcb)
+ set itk_option(-posterize) $_globVar($this,postercb)
+ set itk_option(-vpagecnt) $_globVar($this,vpc)
+ set itk_option(-hpagecnt) $_globVar($this,hpc)
+ set itk_option(-orient) [$itk_component(orientom) get]
+ set rotate [expr {$itk_option(-orient) == "landscape"}]
+
+ if {$_globVar($this,output) == "file"} {
+ $itk_component(fileef) configure \
+ -state normal -foreground $itk_option(-foreground)
+ $itk_component(printeref) configure \
+ -state disabled -foreground $itk_option(-disabledforeground)
+ } else {
+ $itk_component(fileef) configure \
+ -state disabled -foreground $itk_option(-disabledforeground)
+ $itk_component(printeref) configure \
+ -state normal -foreground $itk_option(-foreground)
+ }
+
+ set fg [expr {$_globVar($this,postercb) \
+ ? $itk_option(-foreground) : $itk_option(-disabledforeground)}]
+
+ $itk_component(vpcnt) configure -foreground $fg
+ $itk_component(hpcnt) configure -foreground $fg
+ $itk_component(pages) configure -foreground $fg
+
+ #
+ # Update dependencies among widgets. (For example: disabling
+ # an entry-widget when its associated checkbox-button is used
+ # to turn of the option (the entry's value is not needed
+ # anymore and this should be reflected in the fact that it
+ # isn't possible to change it anymore).
+ #
+ # former method:_update_widgets/_update_UI
+ #
+ set state [expr {$itk_option(-posterize) ? "normal" : "disabled"}]
+ $itk_component(vpcnt) configure -state $state
+ $itk_component(hpcnt) configure -state $state
+ $itk_component(paperom) select "*[string range $itk_option(-pagesize) 1 end]"
+
+ set _update_attr_id ""
+}
+
+#
+# Gets called when the CanvasPrintBox-widget gets mapped.
+#
+body iwidgets::Canvasprintbox::_mapEventHandler {} {
+ set win $itk_interior
+ set canvw $itk_component(canvas)
+ if {$canvas != ""} {
+ setcanvas $canvas
+ }
+ _update_attr
+}
+
+#
+# Destroy this object and its associated widgets.
+#
+body iwidgets::Canvasprintbox::destructor {} {
+ stop
+}
+
+#
+# Hold the information about common paper sizes. A bit of a hack, but it
+# should be possible to add your own if you take a look at it.
+#
+body iwidgets::Canvasprintbox::ezPaperInfo {size {attr ""} \
+ {orient "portrait"} {window ""}} {
+
+ set size [string tolower $size]
+ set attr [string tolower $attr]
+ set orient [string tolower $orient]
+
+ case $size in {
+ types {
+ return "A5 A4 A3 A2 A1 Legal Letter"
+ }
+ a5 {
+ set paper(x1) "1.0c"
+ set paper(y1) "1.0c"
+ set paper(x2) "13.85c"
+ set paper(y2) "20.0c"
+ set paper(pheight) "19.0c"
+ set paper(pwidth) "12.85c"
+ set paper(height) "21.0c"
+ set paper(width) "14.85c"
+ set paper(centerx) "7.425c"
+ set paper(centery) "10.5c"
+ }
+ a4 {
+ set paper(x1) "1.0c"
+ set paper(y1) "1.0c"
+ set paper(x2) "20.0c"
+ set paper(y2) "28.7c"
+ set paper(pheight) "27.7c"
+ set paper(pwidth) "19.0c"
+ set paper(height) "29.7c"
+ set paper(width) "21.0c"
+ set paper(centerx) "10.5c"
+ set paper(centery) "14.85c"
+ }
+ a3 {
+ set paper(x1) "1.0c"
+ set paper(y1) "1.0c"
+ set paper(x2) "28.7c"
+ set paper(y2) "41.0c"
+ set paper(pheight) "40.0c"
+ set paper(pwidth) "27.7c"
+ set paper(height) "42.0c"
+ set paper(width) "29.7c"
+ set paper(centerx) "14.85c"
+ set paper(centery) "21.0c"
+ }
+ a2 {
+ set paper(x1) "1.0c"
+ set paper(y1) "1.0c"
+ set paper(x2) "41.0c"
+ set paper(y2) "58.4c"
+ set paper(pheight) "57.4c"
+ set paper(pwidth) "40.0c"
+ set paper(height) "59.4c"
+ set paper(width) "42.0c"
+ set paper(centerx) "21.0c"
+ set paper(centery) "29.7c"
+ }
+ a1 {
+ set paper(x1) "1.0c"
+ set paper(y1) "1.0c"
+ set paper(x2) "58.4c"
+ set paper(y2) "83.0c"
+ set paper(pheight) "82.0c"
+ set paper(pwidth) "57.4c"
+ set paper(height) "84.0c"
+ set paper(width) "59.4c"
+ set paper(centerx) "29.7c"
+ set paper(centery) "42.0c"
+ }
+ legal {
+ set paper(x1) "0.2i"
+ set paper(y1) "0.2i"
+ set paper(x2) "8.3i"
+ set paper(y2) "13.8i"
+ set paper(pheight) "13.6i"
+ set paper(pwidth) "8.1i"
+ set paper(height) "14.0i"
+ set paper(width) "8.5i"
+ set paper(centerx) "4.25i"
+ set paper(centery) "7.0i"
+ }
+ letter {
+ set paper(x1) "0.2i"
+ set paper(y1) "0.2i"
+ set paper(x2) "8.3i"
+ set paper(y2) "10.8i"
+ set paper(pheight) "10.6i"
+ set paper(pwidth) "8.1i"
+ set paper(height) "11.0i"
+ set paper(width) "8.5i"
+ set paper(centerx) "4.25i"
+ set paper(centery) "5.5i"
+ }
+ default {
+ error "ezPaperInfo: Unknown paper type ($type)"
+ }
+ }
+
+ set inv(x1) "y1"
+ set inv(x2) "y2"
+ set inv(y1) "x1"
+ set inv(y2) "x2"
+ set inv(pwidth) "pheight"
+ set inv(pheight) "pwidth"
+ set inv(width) "height"
+ set inv(height) "width"
+ set inv(centerx) "centery"
+ set inv(centery) "centerx"
+
+ case $orient in {
+ landscape {
+ set res $paper($inv($attr))
+ }
+ portrait {
+ set res $paper($attr)
+ }
+ default {
+ error "ezPaperInfo: orientation should be\
+ portrait or landscape (not $orient)"
+ }
+ }
+
+ if {$window != ""} {
+ set res [winfo fpixels $window $res]
+ }
+
+ return $res
+}
diff --git a/itcl/iwidgets3.0.0/generic/canvasprintdialog.itk b/itcl/iwidgets3.0.0/generic/canvasprintdialog.itk
new file mode 100644
index 00000000000..d87593947e3
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/canvasprintdialog.itk
@@ -0,0 +1,155 @@
+#
+# CanvasPrintDialog v1.5
+# ----------------------------------------------------------------------
+# Implements a print dialog for printing the contents of a canvas widget
+# to a printer or a file. It is possible to specify page orientation, the
+# number of pages to print the image on and if the output should be
+# stretched to fit the page. The CanvasPrintDialog is derived from the
+# Dialog class and is composed of a CanvasPrintBox with attributes set to
+# manipulate the dialog buttons.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Tako Schotanus EMAIL: Tako.Schotanus@bouw.tno.nl
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 Tako Schotanus
+# ======================================================================
+# Permission is hereby granted, without written agreement and without
+# license or royalty fees, to use, copy, modify, and distribute this
+# software and its documentation for any purpose, provided that the
+# above copyright notice and the following two paragraphs appear in
+# all copies of this software.
+#
+# IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR
+# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+# ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN
+# IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+# DAMAGE.
+#
+# THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING,
+# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+# FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
+# ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO
+# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
+# ======================================================================
+
+#
+# Option database default resources:
+#
+option add *Canvasprintdialog.filename "canvas.ps" widgetDefault
+option add *Canvasprintdialog.hPageCnt 1 widgetDefault
+option add *Canvasprintdialog.orient landscape widgetDefault
+option add *Canvasprintdialog.output printer widgetDefault
+option add *Canvasprintdialog.pageSize A4 widgetDefault
+option add *Canvasprintdialog.posterize 0 widgetDefault
+option add *Canvasprintdialog.printCmd lpr widgetDefault
+option add *Canvasprintdialog.printRegion "" widgetDefault
+option add *Canvasprintdialog.vPageCnt 1 widgetDefault
+option add *Canvasprintdialog.title "Canvas Print Dialog" widgetDefault
+option add *Canvasprintdialog.master "." widgetDefault
+
+#
+# Usual options.
+#
+itk::usual Canvasprintdialog {
+ keep -background -cursor -foreground -modality
+}
+
+# ------------------------------------------------------------------
+# CANVASPRINTDIALOG
+# ------------------------------------------------------------------
+class iwidgets::Canvasprintdialog {
+ inherit iwidgets::Dialog
+
+ constructor {args} {}
+ destructor {}
+
+ method deactivate {args} {}
+ method getoutput {} {}
+ method setcanvas {canv} {}
+ method refresh {} {}
+ method print {} {}
+}
+
+#
+# Provide a lowercased access method for the Canvasprintdialog class.
+#
+proc ::iwidgets::canvasprintdialog {args} {
+ uplevel ::iwidgets::Canvasprintdialog $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+#
+# Create new file selection dialog.
+# ------------------------------------------------------------------
+body iwidgets::Canvasprintdialog::constructor {args} {
+ component hull configure -borderwidth 0
+
+ #
+ # Instantiate a file selection box widget.
+ #
+ itk_component add cpb {
+ iwidgets::Canvasprintbox $itk_interior.cpb
+ } {
+ usual
+ keep -printregion -output -printcmd -filename -pagesize \
+ -orient -stretch -posterize -hpagecnt -vpagecnt
+ }
+ pack $itk_component(cpb) -fill both -expand yes
+
+ #
+ # Hide the apply and help buttons.
+ #
+ buttonconfigure OK -text Print
+ buttonconfigure Apply -command [code $this refresh] -text Refresh
+ hide Help
+
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: deactivate
+#
+# Redefines method of dialog shell class. Stops the drawing of the
+# thumbnail (when busy) upon deactivation of the dialog.
+# ------------------------------------------------------------------
+body iwidgets::Canvasprintdialog::deactivate {args} {
+ $itk_component(cpb) stop
+ return [eval Shell::deactivate $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: getoutput
+#
+# Thinwrapped method of canvas print box class.
+# ------------------------------------------------------------------
+body iwidgets::Canvasprintdialog::getoutput {} {
+ return [$itk_component(cpb) getoutput]
+}
+
+# ------------------------------------------------------------------
+# METHOD: setcanvas
+#
+# Thinwrapped method of canvas print box class.
+# ------------------------------------------------------------------
+body iwidgets::Canvasprintdialog::setcanvas {canv} {
+ return [$itk_component(cpb) setcanvas $canv]
+}
+
+# ------------------------------------------------------------------
+# METHOD: refresh
+#
+# Thinwrapped method of canvas print box class.
+# ------------------------------------------------------------------
+body iwidgets::Canvasprintdialog::refresh {} {
+ return [$itk_component(cpb) refresh]
+}
+
+# ------------------------------------------------------------------
+# METHOD: print
+#
+# Thinwrapped method of canvas print box class.
+# ------------------------------------------------------------------
+body iwidgets::Canvasprintdialog::print {} {
+ return [$itk_component(cpb) print]
+}
diff --git a/itcl/iwidgets3.0.0/generic/checkbox.itk b/itcl/iwidgets3.0.0/generic/checkbox.itk
new file mode 100755
index 00000000000..30fa700321f
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/checkbox.itk
@@ -0,0 +1,313 @@
+#
+# Checkbox
+# ----------------------------------------------------------------------
+# Implements a checkbuttonbox. Supports adding, inserting, deleting,
+# selecting, and deselecting of checkbuttons by tag and index.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: John A. Tucker EMAIL: jatucker@spd.dsccc.com
+#
+# ----------------------------------------------------------------------
+# Copyright (c) 1997 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Checkbox.labelMargin 10 widgetDefault
+option add *Checkbox.labelFont \
+ "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" widgetDefault
+option add *Checkbox.labelPos nw widgetDefault
+option add *Checkbox.borderWidth 2 widgetDefault
+option add *Checkbox.relief groove widgetDefault
+
+#
+# Usual options.
+#
+itk::usual Checkbox {
+ keep -background -borderwidth -cursor -disabledforeground \
+ -foreground -labelfont -selectcolor
+}
+
+# ------------------------------------------------------------------
+# CHECKBOX
+# ------------------------------------------------------------------
+class iwidgets::Checkbox {
+ inherit iwidgets::Labeledframe
+
+ constructor {args} {}
+
+ itk_option define -disabledforeground \
+ disabledForeground DisabledForeground {}
+ itk_option define -selectcolor selectColor Background {}
+ itk_option define -command command Command {}
+
+ public {
+ method add {tag args}
+ method insert {index tag args}
+ method delete {index}
+ method get {{index ""}}
+ method index {index}
+ method select {index}
+ method deselect {index}
+ method flash {index}
+ method toggle {index}
+ method buttonconfigure {index args}
+ }
+
+ private {
+
+ method gettag {index} ;# Get the tag of the checkbutton associated
+ ;# with a numeric index
+
+ variable _unique 0 ;# Unique id for choice creation.
+ variable _buttons {} ;# List of checkbutton tags.
+ common buttonVar ;# Array of checkbutton "-variables"
+ }
+}
+
+#
+# Provide a lowercased access method for the Checkbox class.
+#
+proc ::iwidgets::checkbox {pathName args} {
+ uplevel ::iwidgets::Checkbox $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Checkbox::constructor {args} {
+
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -command
+#
+# Specifies a command to be evaluated upon change in the checkbox
+# ------------------------------------------------------------------
+configbody iwidgets::Checkbox::command {}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: index index
+#
+# Searches the checkbutton tags in the checkbox for the one with the
+# requested tag, numerical index, or keyword "end". Returns the
+# choices's numerical index if found, otherwise error.
+# ------------------------------------------------------------------
+body iwidgets::Checkbox::index {index} {
+ if {[llength $_buttons] > 0} {
+ if {[regexp {(^[0-9]+$)} $index]} {
+ if {$index < [llength $_buttons]} {
+ return $index
+ } else {
+ error "Checkbox index \"$index\" is out of range"
+ }
+
+ } elseif {$index == "end"} {
+ return [expr [llength $_buttons] - 1]
+
+ } else {
+ if {[set idx [lsearch $_buttons $index]] != -1} {
+ return $idx
+ }
+
+ error "bad Checkbox index \"$index\": must be number, end,\
+ or pattern"
+ }
+
+ } else {
+ error "Checkbox \"$itk_component(hull)\" has no checkbuttons"
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: add tag ?option value option value ...?
+#
+# Add a new tagged checkbutton to the checkbox at the end. The method
+# takes additional options which are passed on to the checkbutton
+# constructor. These include most of the typical checkbutton
+# options. The tag is returned.
+# ------------------------------------------------------------------
+body iwidgets::Checkbox::add {tag args} {
+ itk_component add $tag {
+ eval checkbutton $itk_component(childsite).cb[incr _unique] \
+ -variable [list [scope buttonVar($this,$tag)]] \
+ -anchor w \
+ -justify left \
+ -highlightthickness 0 \
+ $args
+ } {
+ usual
+ ignore -highlightthickness -highlightcolor
+ rename -font -labelfont labelFont Font
+ }
+ pack $itk_component($tag) -anchor w -padx 4
+
+ lappend _buttons $tag
+
+ return $tag
+}
+
+# ------------------------------------------------------------------
+# METHOD: insert index tag ?option value option value ...?
+#
+# Insert the tagged checkbutton in the checkbox just before the
+# one given by index. Any additional options are passed on to the
+# checkbutton constructor. These include the typical checkbutton
+# options. The tag is returned.
+# ------------------------------------------------------------------
+body iwidgets::Checkbox::insert {index tag args} {
+ itk_component add $tag {
+ eval checkbutton $itk_component(childsite).cb[incr _unique] \
+ -variable [list [scope buttonVar($this,$tag)]] \
+ -anchor w \
+ -justify left \
+ -highlightthickness 0 \
+ $args
+ } {
+ usual
+ ignore -highlightthickness -highlightcolor
+ rename -font -labelfont labelFont Font
+ }
+
+ set index [index $index]
+ set before [lindex $_buttons $index]
+ set _buttons [linsert $_buttons $index $tag]
+
+ pack $itk_component($tag) -anchor w -padx 4 -before $itk_component($before)
+
+ return $tag
+}
+
+# ------------------------------------------------------------------
+# METHOD: delete index
+#
+# Delete the specified checkbutton.
+# ------------------------------------------------------------------
+body iwidgets::Checkbox::delete {index} {
+
+ set tag [gettag $index]
+ set index [index $index]
+ destroy $itk_component($tag)
+ set _buttons [lreplace $_buttons $index $index]
+
+ if { [info exists buttonVar($this,$tag)] == 1 } {
+ unset buttonVar($this,$tag)
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: select index
+#
+# Select the specified checkbutton.
+# ------------------------------------------------------------------
+body iwidgets::Checkbox::select {index} {
+ set tag [gettag $index]
+ $itk_component($tag) invoke
+}
+
+# ------------------------------------------------------------------
+# METHOD: toggle index
+#
+# Toggle a specified checkbutton between selected and unselected
+# ------------------------------------------------------------------
+body iwidgets::Checkbox::toggle {index} {
+ set tag [gettag $index]
+ $itk_component($tag) toggle
+}
+
+# ------------------------------------------------------------------
+# METHOD: get
+#
+# Return the value of the checkbutton with the given index, or a
+# list of all checkbutton values in increasing order by index.
+# ------------------------------------------------------------------
+body iwidgets::Checkbox::get {{index ""}} {
+ set result {}
+
+ if {$index == ""} {
+ foreach tag $_buttons {
+ if {$buttonVar($this,$tag)} {
+ lappend result $tag
+ }
+ }
+ } else {
+ set tag [gettag $index]
+ set result $buttonVar($this,$tag)
+ }
+
+ return $result
+}
+
+# ------------------------------------------------------------------
+# METHOD: deselect index
+#
+# Deselect the specified checkbutton.
+# ------------------------------------------------------------------
+body iwidgets::Checkbox::deselect {index} {
+ set tag [gettag $index]
+ $itk_component($tag) deselect
+}
+
+# ------------------------------------------------------------------
+# METHOD: flash index
+#
+# Flash the specified checkbutton.
+# ------------------------------------------------------------------
+body iwidgets::Checkbox::flash {index} {
+ set tag [gettag $index]
+ $itk_component($tag) flash
+}
+
+# ------------------------------------------------------------------
+# METHOD: buttonconfigure index ?option? ?value option value ...?
+#
+# Configure a specified checkbutton. This method allows configuration
+# of checkbuttons from the Checkbox level. The options may have any
+# of the values accepted by the add method.
+# ------------------------------------------------------------------
+body iwidgets::Checkbox::buttonconfigure {index args} {
+ set tag [gettag $index]
+ eval $itk_component($tag) configure $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: gettag index
+#
+# Return the tag of the checkbutton associated with a specified
+# numeric index
+# ------------------------------------------------------------------
+body iwidgets::Checkbox::gettag {index} {
+ return [lindex $_buttons [index $index]]
+}
+
diff --git a/itcl/iwidgets3.0.0/generic/colors.itcl b/itcl/iwidgets3.0.0/generic/colors.itcl
new file mode 100644
index 00000000000..c544c2e2da0
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/colors.itcl
@@ -0,0 +1,209 @@
+#
+# colors
+# ----------------------------------------------------------------------
+# The colors class encapsulates several color related utility functions.
+# Class level scope resolution must be used inorder to access the static
+# member functions.
+#
+# USAGE:
+# set hsb [colors::rgbToHsb [winfo rgb . bisque]]
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@spd.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 Mark L. Ulferts
+# ======================================================================
+# Permission is hereby granted, without written agreement and without
+# license or royalty fees, to use, copy, modify, and distribute this
+# software and its documentation for any purpose, provided that the
+# above copyright notice and the following two paragraphs appear in
+# all copies of this software.
+#
+# IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR
+# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+# ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN
+# IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+# DAMAGE.
+#
+# THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING,
+# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+# FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
+# ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO
+# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
+# ======================================================================
+
+namespace eval iwidgets::colors {
+
+ # ------------------------------------------------------------------
+ # PROCEDURE: rgbToNumeric
+ #
+ # Returns the numeric value for a list of red, green, and blue.
+ # ------------------------------------------------------------------
+ proc rgbToNumeric {rgb} {
+ if {[llength $rgb] != 3} {
+ error "bad arg: \"$rgb\", should be list of red, green, and blue"
+ }
+
+ return [format "#%04x%04x%04x" \
+ [lindex $rgb 0] [lindex $rgb 1] [lindex $rgb 2]]
+ }
+
+ # ------------------------------------------------------------------
+ # PROCEDURE: rgbToHsb
+ #
+ # The procedure below converts an RGB value to HSB. It takes red,
+ # green, and blue components (0-65535) as arguments, and returns a
+ # list containing HSB components (floating-point, 0-1) as result.
+ # The code here is a copy of the code on page 615 of "Fundamentals
+ # of Interactive Computer Graphics" by Foley and Van Dam.
+ # ------------------------------------------------------------------
+ proc rgbToHsb {rgb} {
+ if {[llength $rgb] != 3} {
+ error "bad arg: \"$rgb\", should be list of red, green, and blue"
+ }
+
+ set r [expr [lindex $rgb 0]/65535.0]
+ set g [expr [lindex $rgb 1]/65535.0]
+ set b [expr [lindex $rgb 2]/65535.0]
+
+ set max 0
+ if {$r > $max} {set max $r}
+ if {$g > $max} {set max $g}
+ if {$b > $max} {set max $b}
+
+ set min 65535
+ if {$r < $min} {set min $r}
+ if {$g < $min} {set min $g}
+ if {$b < $min} {set min $b}
+
+ if {$max != 0} {
+ set sat [expr ($max-$min)/$max]
+ } else {
+ set sat 0
+ }
+ if {$sat == 0} {
+ set hue 0
+ } else {
+ set rc [expr ($max-$r)/($max-$min)]
+ set gc [expr ($max-$g)/($max-$min)]
+ set bc [expr ($max-$b)/($max-$min)]
+
+ if {$r == $max} {
+ set hue [expr $bc-$gc]
+ } elseif {$g == $max} {
+ set hue [expr 2+$rc-$bc]
+ } elseif {$b == $max} {
+ set hue [expr 4+$gc-$rc]
+ }
+ set hue [expr $hue*0.1666667]
+ if {$hue < 0} {set hue [expr $hue+1.0]}
+ }
+ return [list $hue $sat $max]
+ }
+
+ # ------------------------------------------------------------------
+ # PROCEDURE: hsbToRgb
+ #
+ # The procedure below converts an HSB value to RGB. It takes hue,
+ # saturation, and value components (floating-point, 0-1.0) as
+ # arguments, and returns a list containing RGB components (integers,
+ # 0-65535) as result. The code here is a copy of the code on page
+ # 616 of "Fundamentals of Interactive Computer Graphics" by Foley
+ # and Van Dam.
+ # ------------------------------------------------------------------
+ proc hsbToRgb {hsb} {
+
+ if {[llength $hsb] != 3} {
+ error "bad arg: \"$hsb\", should be list of hue, saturation, and brightness"
+ }
+
+ set hue [lindex $hsb 0]
+ set sat [lindex $hsb 1]
+ set value [lindex $hsb 2]
+
+ set v [format %.0f [expr 65535.0*$value]]
+ if {$sat == 0} {
+ return "$v $v $v"
+ } else {
+ set hue [expr $hue*6.0]
+ if {$hue >= 6.0} {
+ set hue 0.0
+ }
+ scan $hue. %d i
+ set f [expr $hue-$i]
+ set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]]
+ set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]]
+ set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]]
+ case $i \
+ 0 {return "$v $t $p"} \
+ 1 {return "$q $v $p"} \
+ 2 {return "$p $v $t"} \
+ 3 {return "$p $q $v"} \
+ 4 {return "$t $p $v"} \
+ 5 {return "$v $p $q"}
+ error "i value $i is out of range"
+ }
+ }
+
+ # ------------------------------------------------------------------
+ #
+ # PROCEDURE: topShadow bgColor
+ #
+ # This method computes a lighter shadow variant of bgColor.
+ # It wants to decrease the saturation to 25%. But if there is
+ # no saturation (as in gray colors) it tries to turn the
+ # brightness up by 10%. It maxes the brightness at 1.0 to
+ # avoid bogus colors...
+ #
+ # bgColor is converted to HSB where the calculations are
+ # made. Then converted back to an rgb color number (hex fmt)
+ #
+ # ------------------------------------------------------------------
+ proc topShadow { bgColor } {
+
+ set hsb [rgbToHsb [winfo rgb . $bgColor]]
+
+ set saturation [lindex $hsb 1]
+ set brightness [lindex $hsb 2]
+
+ if { $brightness < 0.9 } {
+ # try turning the brightness up first.
+ set brightness [expr $brightness * 1.1]
+ } else {
+ # otherwise fiddle with saturation
+ set saturation [expr $saturation * 0.25]
+ }
+
+ set hsb [lreplace $hsb 1 1 [set saturation]]
+ set hsb [lreplace $hsb 2 2 [set brightness]]
+
+ set rgb [hsbToRgb $hsb]
+ set color [rgbToNumeric $rgb]
+ return $color
+ }
+
+
+ # ------------------------------------------------------------------
+ #
+ # PROC: bottomShadow bgColor
+ #
+ #
+ # This method computes a darker shadow variant of bg color.
+ # It takes the brightness and decreases it to 80% of its
+ # original value.
+ #
+ # bgColor is converted to HSB where the calculations are
+ # made. Then converted back to an rgb color number (hex fmt)
+ #
+ # ------------------------------------------------------------------
+ proc bottomShadow { bgColor } {
+
+ set hsb [rgbToHsb [winfo rgb . $bgColor]]
+ set hsb [lreplace $hsb 2 2 [expr [lindex $hsb 2] * 0.8]]
+ set rgb [hsbToRgb $hsb]
+ set color [rgbToNumeric $rgb]
+ return $color
+ }
+}
diff --git a/itcl/iwidgets3.0.0/generic/combobox.itk b/itcl/iwidgets3.0.0/generic/combobox.itk
new file mode 100644
index 00000000000..45b79b037b6
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/combobox.itk
@@ -0,0 +1,1339 @@
+# Combobox
+# ----------------------------------------------------------------------
+# Implements a Combobox widget. A Combobox has 2 basic styles: simple and
+# dropdown. Dropdowns display an entry field with an arrow button to the
+# right of it. When the arrow button is pressed a selectable list of
+# items is popped up. A simple Combobox displays an entry field and a listbox
+# just beneath it which is always displayed. In both types, if the user
+# selects an item in the listbox, the contents of the entry field are
+# replaced with the text from the selected item. If the Combobox is
+# editable, the user can type in the entry field and when <Return> is
+# pressed the item will be inserted into the list.
+#
+# WISH LIST:
+# This section lists possible future enhancements.
+#
+# Combobox 1.x:
+# - convert bindings to bindtags.
+#
+# ----------------------------------------------------------------------
+# ORIGINAL AUTHOR: John S. Sigler EMAIL: jsigler@spd.dsccc.com
+# sigler@onramp.net
+# ----------------------------------------------------------------------
+# CURRENT MAINTAINER: Mitch Gorman EMAIL: logain@erols.com
+# Copyright (c) 1995 John S. Sigler
+# Copyright (c) 1997 Mitch Gorman
+# ======================================================================
+# Permission is hereby granted, without written agreement and without
+# license or royalty fees, to use, copy, modify, and distribute this
+# software and its documentation for any purpose, provided that the
+# above copyright notice and the following two paragraphs appear in
+# all copies of this software.
+#
+# IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR
+# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+# ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN
+# IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+# DAMAGE.
+#
+# THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING,
+# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+# FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
+# ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO
+# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
+# ======================================================================
+
+#
+# Default resources.
+#
+option add *Combobox.borderWidth 2 widgetDefault
+option add *Combobox.labelPos wn widgetDefault
+option add *Combobox.listHeight 150 widgetDefault
+option add *Combobox.hscrollMode dynamic widgetDefault
+option add *Combobox.vscrollMode dynamic widgetDefault
+
+#
+# Usual options.
+#
+itk::usual Combobox {
+ keep -background -borderwidth -cursor -foreground -highlightcolor \
+ -highlightthickness -insertbackground -insertborderwidth \
+ -insertofftime -insertontime -insertwidth -labelfont -popupcursor \
+ -selectbackground -selectborderwidth -selectforeground \
+ -textbackground -textfont
+}
+
+# ------------------------------------------------------------------
+# COMBOBOX
+# ------------------------------------------------------------------
+class iwidgets::Combobox {
+ inherit iwidgets::Entryfield
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -arrowrelief arrowRelief Relief raised
+ itk_option define -completion completion Completion true
+ itk_option define -dropdown dropdown Dropdown true
+ itk_option define -editable editable Editable true
+ itk_option define -grab grab Grab local
+ itk_option define -listheight listHeight Height 150
+ itk_option define -margin margin Margin 1
+ itk_option define -popupcursor popupCursor Cursor arrow
+ itk_option define -selectioncommand selectionCommand SelectionCommand {}
+ itk_option define -state state State normal
+ itk_option define -unique unique Unique true
+
+ public method clear {{component all}}
+ public method curselection {}
+ public method delete {component first {last {}}}
+ public method get {{index {}}}
+ public method getcurselection {}
+ public method insert {component index args}
+ public method invoke {}
+ public method justify {direction}
+ public method see {index}
+ public method selection {option first {last {}}}
+ public method size {}
+ public method sort {{mode ascending}}
+ public method xview {args}
+ public method yview {args}
+
+ protected method _addToList {}
+ protected method _createComponents {}
+ protected method _deleteList {first {last {}}}
+ protected method _deleteText {first {last {}}}
+ protected method _doLayout {{when later}}
+ protected method _drawArrow {}
+ protected method _dropdownBtnRelease {{window {}} {x 1} {y 1}}
+ protected method _ignoreNextBtnRelease {ignore}
+ protected method _next {}
+ protected method _packComponents {{when later}}
+ protected method _positionList {}
+ protected method _postList {}
+ protected method _previous {}
+ protected method _resizeArrow {}
+ protected method _selectCmd {}
+ protected method _toggleList {}
+ protected method _unpostList {}
+ protected method _commonBindings {}
+ protected method _dropdownBindings {}
+ protected method _simpleBindings {}
+ protected method _listShowing {{val ""}}
+
+ private method _bs {}
+ private method _lookup {key}
+ private method _slbListbox {}
+ private method _stateSelect {}
+
+ private variable _doit 0;
+ private variable _inbs 0;
+ private variable _inlookup 0;
+ private variable _currItem {}; ;# current selected item.
+ private variable _ignoreRelease false ;# next button release ignored.
+ private variable _isPosted false; ;# is the dropdown popped up.
+ private variable _repacking {} ;# non-null => _packComponents pending.
+ private common _listShowing
+ private common count 0
+}
+
+#
+# Provide a lowercase access method for the Combobox class.
+#
+proc ::iwidgets::combobox {pathName args} {
+ uplevel ::iwidgets::Combobox $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Combobox::constructor {args} {
+ set _listShowing($this) 0
+
+ # combobox is different as all components are created
+ # after determining what the dropdown style is...
+
+ # configure args
+ eval itk_initialize $args
+
+ # create components that are dependent on options
+ # (Scrolledlistbox, arrow button) and pack them.
+ if {$count == 0} {
+ image create bitmap downarrow -data {
+ #define down_width 16
+ #define down_height 16
+ static unsigned char down_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0xfc, 0x7f, 0xf8, 0x3f,
+ 0xf0, 0x1f, 0xe0, 0x0f, 0xc0, 0x07, 0x80, 0x03,
+ 0x00, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
+ };
+ }
+ image create bitmap uparrow -data {
+ #define up_width 16
+ #define up_height 16
+ static unsigned char up_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0x00,
+ 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f,
+ 0xfc, 0x1f, 0xfe, 0x3f, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
+ };
+ }
+ }
+ incr count
+ _doLayout
+}
+
+# ------------------------------------------------------------------
+# DESTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Combobox::destructor {} {
+ # catch any repacking that may be waiting for idle time
+ if {$_repacking != ""} {
+ after cancel $_repacking
+ }
+ incr count -1
+ if {$count == 0} {
+ image delete uparrow
+ image delete downarrow
+ }
+}
+
+# ================================================================
+# OPTIONS
+# ================================================================
+
+# --------------------------------------------------------------------
+# OPTION: -arrowrelief
+#
+# Relief style used on the arrow button.
+# --------------------------------------------------------------------
+configbody iwidgets::Combobox::arrowrelief {}
+
+# --------------------------------------------------------------------
+# OPTION: -completion
+#
+# Relief style used on the arrow button.
+# --------------------------------------------------------------------
+configbody iwidgets::Combobox::completion {
+ switch -- $itk_option(-completion) {
+ 0 - no - false - off { }
+ 1 - yes - true - on { }
+ default {
+ error "bad completion option \"$itk_option(-completion)\":\
+ should be boolean"
+ }
+ }
+}
+
+# --------------------------------------------------------------------
+# OPTION: -dropdown
+#
+# Boolean which determines the Combobox style: dropdown or simple.
+# Because the two style's lists reside in different toplevel widgets
+# this is more complicated than it should be.
+# --------------------------------------------------------------------
+configbody iwidgets::Combobox::dropdown {
+ switch -- $itk_option(-dropdown) {
+ 1 - yes - true - on {
+ if {[winfo exists $itk_interior.list]} {
+ set vals [$itk_component(list) get 0 end]
+ destroy $itk_component(list)
+ _doLayout
+ if [llength $vals] {
+ eval insert list end $vals
+ }
+ }
+ }
+ 0 - no - false - off {
+ if {[winfo exists $itk_interior.popup.list]} {
+ set vals [$itk_component(list) get 0 end]
+ catch {destroy $itk_component(arrowBtn)}
+ destroy $itk_component(popup) ;# this deletes the list too
+ _doLayout
+ if [llength $vals] {
+ eval insert list end $vals
+ }
+ }
+ }
+ default {
+ error "bad dropdown option \"$itk_option(-dropdown)\":\
+ should be boolean"
+ }
+ }
+}
+
+# --------------------------------------------------------------------
+# OPTION: -editable
+#
+# Boolean which allows/disallows user input to the entry field area.
+# --------------------------------------------------------------------
+configbody iwidgets::Combobox::editable {
+ switch -- $itk_option(-editable) {
+ 1 - true - yes - on {
+ switch -- $itk_option(-state) {
+ normal {
+ $itk_component(entry) configure -state normal
+ }
+ }
+ }
+ 0 - false - no - off {
+ $itk_component(entry) configure -state disabled
+ }
+ default {
+ error "bad editable option \"$itk_option(-editable)\":\
+ should be boolean"
+ }
+ }
+}
+
+# --------------------------------------------------------------------
+# OPTION: -grab
+#
+# grab-state of megawidget
+# --------------------------------------------------------------------
+configbody iwidgets::Combobox::grab {
+ switch -- $itk_option(-grab) {
+ local { }
+ global { }
+ default {
+ error "bad grab value \"$itk_option(-grab)\":\
+ must be global or local"
+ }
+ }
+}
+
+# --------------------------------------------------------------------
+# OPTION: -listheight
+#
+# Listbox height in pixels. (Need to integrate the scrolledlistbox
+# -visibleitems option here - at least for simple listbox.)
+# --------------------------------------------------------------------
+configbody iwidgets::Combobox::listheight {}
+
+# --------------------------------------------------------------------
+# OPTION: -margin
+#
+# Spacer between the entry field and arrow button of dropdown style
+# Comboboxes.
+# --------------------------------------------------------------------
+configbody iwidgets::Combobox::margin {
+ grid columnconfigure $itk_interior 0 -minsize $itk_option(-margin)
+}
+
+# --------------------------------------------------------------------
+# OPTION: -popupcursor
+#
+# Set the cursor for the popup list.
+# --------------------------------------------------------------------
+configbody iwidgets::Combobox::popupcursor {}
+
+# --------------------------------------------------------------------
+# OPTION: -selectioncommand
+#
+# Defines the proc to be called when an item is selected in the list.
+# --------------------------------------------------------------------
+configbody iwidgets::Combobox::selectioncommand {}
+
+# --------------------------------------------------------------------
+# OPTION: -state
+#
+# overall state of megawidget
+# --------------------------------------------------------------------
+configbody iwidgets::Combobox::state {
+ switch -- $itk_option(-state) {
+ disabled {
+ $itk_component(entry) configure -state disabled
+ }
+ normal {
+ switch -- $itk_option(-editable) {
+ 1 - true - yes - on {
+ $itk_component(entry) configure -state normal
+ }
+ 0 - false - no - off {
+ $itk_component(entry) configure -state disabled
+ }
+ }
+ }
+ default {
+ error "bad state value \"$itk_option(-state)\":\
+ must be normal or disabled"
+ }
+ }
+ if {[info exists itk_component(arrowBtn)]} {
+ $itk_component(arrowBtn) configure -state $itk_option(-state)
+ }
+}
+
+# --------------------------------------------------------------------
+# OPTION: -unique
+#
+# Boolean which disallows/allows adding duplicate items to the listbox.
+# --------------------------------------------------------------------
+configbody iwidgets::Combobox::unique {
+ # boolean error check
+ switch -- $itk_option(-unique) {
+ 1 - true - yes - on { }
+ 0 - false - no - off { }
+ default {
+ error "bad unique value \"$itk_option(-unique)\":\
+ should be boolean"
+ }
+ }
+}
+
+# =================================================================
+# METHODS
+# =================================================================
+
+# ------------------------------------------------------
+# PUBLIC METHOD: clear ?component?
+#
+# Remove all elements from the listbox, all contents
+# from the entry component, or both (if all).
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::clear {{component all}} {
+ switch -- $component {
+ entry {
+ iwidgets::Entryfield::clear
+ }
+ list {
+ delete list 0 end
+ }
+ all {
+ delete list 0 end
+ iwidgets::Entryfield::clear
+ }
+ default {
+ error "bad Combobox component \"$component\":\
+ must be entry, list, or all."
+ }
+ }
+ return
+}
+
+# ------------------------------------------------------
+# PUBLIC METHOD: curselection
+#
+# Return the current selection index.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::curselection {} {
+ return [$itk_component(list) curselection]
+}
+
+# ------------------------------------------------------
+# PUBLIC METHOD: delete component first ?last?
+#
+# Delete an item or items from the listbox OR delete
+# text from the entry field. First argument determines
+# which component deletion occurs in - valid values are
+# entry or list.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::delete {component first {last {}}} {
+ switch -- $component {
+ entry {
+ iwidgets::Entryfield::delete $first $last
+ }
+ list {
+ _deleteList $first $last
+ }
+ default {
+ error "bad Combobox component \"$component\":\
+ must be entry or list."
+ }
+ }
+}
+
+# ------------------------------------------------------
+# PUBLIC METHOD: get ?index?
+#
+#
+# Retrieve entry contents if no args OR use args as list
+# index and retrieve list item at index .
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::get {{index {}}} {
+ # no args means to get the current text in the entry field area
+ if {$index == {}} {
+ iwidgets::Entryfield::get
+ } else {
+ eval $itk_component(list) get $index
+ }
+}
+
+# ------------------------------------------------------
+# PUBLIC METHOD: getcurselection
+#
+# Return currently selected item in the listbox. Shortcut
+# version of get curselection command combination.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::getcurselection {} {
+ return [$itk_component(list) getcurselection]
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: ivoke
+#
+# Pops up or down a dropdown combobox.
+#
+# ------------------------------------------------------------------
+body iwidgets::Combobox::invoke {} {
+ if {$itk_option(-dropdown)} {
+ return [_toggleList]
+ }
+ return
+}
+
+# ------------------------------------------------------------
+# PUBLIC METHOD: insert comonent index string ?string ...?
+#
+# Insert an item into the listbox OR text into the entry area.
+# Valid component names are entry or list.
+#
+# ------------------------------------------------------------
+body iwidgets::Combobox::insert {component index args} {
+ set nargs [llength $args]
+
+ if {$nargs == 0} {
+ error "no value given for parameter \"string\" in function\
+ \"Combobox::insert\""
+ }
+
+ switch -- $component {
+ entry {
+ if { $nargs > 1} {
+ error "called function \"Combobox::insert entry\"\
+ with too many arguments"
+ } else {
+ if {$itk_option(-state) == "normal"} {
+ eval iwidgets::Entryfield::insert $index $args
+ [code $this _lookup ""]
+ }
+ }
+ }
+ list {
+ if {$itk_option(-state) == "normal"} {
+ eval $itk_component(list) insert $index $args
+ }
+ }
+ default {
+ error "bad Combobox component \"$component\": must\
+ be entry or list."
+ }
+ }
+}
+
+# ------------------------------------------------------
+# PUBLIC METHOD: justify direction
+#
+# Wrapper for justifying the listbox items in one of
+# 4 directions: top, bottom, left, or right.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::justify {direction} {
+ return [$itk_component(list) justify $direction]
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: see index
+#
+# Adjusts the view such that the element given by index is visible.
+# ------------------------------------------------------------------
+body iwidgets::Combobox::see {index} {
+ return [$itk_component(list) see $index]
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: selection option first ?last?
+#
+# Adjusts the selection within the listbox and changes the contents
+# of the entry component to be the value of the selected list item.
+# ------------------------------------------------------------------
+body iwidgets::Combobox::selection {option first {last {}}} {
+ # thin wrap
+ if {$option == "set"} {
+ $itk_component(list) selection clear 0 end
+ $itk_component(list) selection set $first
+ set rtn ""
+ } else {
+ set rtn [eval $itk_component(list) selection $option $first $last]
+ }
+ set _currItem $first
+
+ # combobox additions
+ set theText [getcurselection]
+ if {$theText != [$itk_component(entry) get]} {
+ clear entry
+ if {$theText != ""} {
+ insert entry 0 $theText
+ }
+ }
+ return $rtn
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: size
+#
+# Returns a decimal string indicating the total number of elements
+# in the listbox.
+# ------------------------------------------------------------------
+body iwidgets::Combobox::size {} {
+ return [$itk_component(list) size]
+}
+
+# ------------------------------------------------------
+# PUBLIC METHOD: sort ?mode?
+#
+# Sort the current list in either "ascending" or "descending" order.
+#
+# jss: how should i handle selected items?
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::sort {{mode ascending}} {
+ $itk_component(list) sort $mode
+ # return [$itk_component(list) sort $mode]
+}
+
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: xview ?arg arg ...?
+#
+# Change or query the vertical position of the text in the list box.
+# ------------------------------------------------------------------
+body iwidgets::Combobox::xview {args} {
+ return [eval $itk_component(list) xview $args]
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: yview ?arg arg ...?
+#
+# Change or query the horizontal position of the text in the list box.
+# ------------------------------------------------------------------
+body iwidgets::Combobox::yview {args} {
+ return [eval $itk_component(list) yview $args]
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _addToList
+#
+# Add the current item in the entry to the listbox.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_addToList {} {
+ set input [get]
+ if {$input != ""} {
+ if {$itk_option(-unique)} {
+ # if item is already in list, select it and exit
+ set item [lsearch -exact [$itk_component(list) get 0 end] $input]
+ if {$item != -1} {
+ selection clear 0 end
+ if {$item != {}} {
+ selection set $item $item
+ set _currItem $item
+ }
+ return
+ }
+ }
+ # add the item to end of list
+ selection clear 0 end
+ insert list end $input
+ selection set end end
+ }
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _createComponents
+#
+# Create deferred combobox components and add bindings.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_createComponents {} {
+ if {$itk_option(-dropdown)} {
+ # --- build a dropdown combobox ---
+
+ # make the arrow childsite be on the right hand side
+ configure -childsitepos e -command [code $this _addToList]
+
+ # arrow button to popup the list
+ itk_component add arrowBtn {
+ button $itk_interior.arrowBtn -borderwidth 2 \
+ -width 15 -height 15 -image downarrow \
+ -command [code $this _toggleList] -state $itk_option(-state)
+ } {
+ keep -background -borderwidth -cursor -state \
+ -highlightcolor -highlightthickness
+ rename -relief -arrowrelief arrowRelief Relief
+ rename -highlightbackground -background background Background
+ }
+
+ # popup list container
+ itk_component add popup {
+ toplevel $itk_interior.popup
+ } {
+ keep -background -cursor
+ }
+ wm withdraw $itk_interior.popup
+
+ # the listbox
+ itk_component add list {
+ iwidgets::Scrolledlistbox $itk_interior.popup.list -exportselection no \
+ -vscrollmode dynamic -hscrollmode dynamic -selectmode browse
+ } {
+ keep -background -borderwidth -cursor -foreground \
+ -highlightcolor -highlightthickness \
+ -hscrollmode -selectbackground \
+ -selectborderwidth -selectforeground -textbackground \
+ -textfont -vscrollmode
+ rename -height -listheight listHeight Height
+ rename -cursor -popupcursor popupCursor Cursor
+ }
+ # mode specific bindings
+ _dropdownBindings
+
+ # Ugly hack to avoid tk buglet revealed in _dropdownBtnRelease where
+ # relief is used but not set in scrollbar.tcl.
+ global tkPriv
+ set tkPriv(relief) raise
+
+ } else {
+ # --- build a simple combobox ---
+ configure -childsitepos s
+ itk_component add list {
+ iwidgets::Scrolledlistbox $itk_interior.list -exportselection no \
+ -vscrollmode dynamic -hscrollmode dynamic
+ } {
+ keep -background -borderwidth -cursor -foreground \
+ -highlightcolor -highlightthickness \
+ -hscrollmode -selectbackground \
+ -selectborderwidth -selectforeground -textbackground \
+ -textfont -visibleitems -vscrollmode
+ rename -height -listheight listHeight Height
+ }
+ # add mode specific bindings
+ _simpleBindings
+ }
+
+ # popup cursor applies only to the list within the combobox
+ configure -popupcursor $itk_option(-popupcursor)
+
+ # add mode independent bindings
+ _commonBindings
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _deleteList first ?last?
+#
+# Delete an item or items from the listbox. Called via
+# "delete list args".
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_deleteList {first {last {}}} {
+
+ if {$last == {}} {
+ set last $first
+ }
+ $itk_component(list) delete $first $last
+
+ # remove the item if it is no longer in the list
+ set text [$this get]
+ if {$text != ""} {
+ set index [lsearch -exact [$itk_component(list) get 0 end] $text ]
+ if {$index == -1} {
+ clear entry
+ }
+ }
+ return
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _deleteText first ?last?
+#
+# Renamed Entryfield delete method. Called via "delete entry args".
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_deleteText {first {last {}}} {
+ $itk_component(entry) configure -state normal
+ set rtrn [delete $first $last]
+ switch -- $itk_option(-editable) {
+ 0 - false - no - off {
+ $itk_component(entry) configure -state disabled
+ }
+ }
+ return $rtrn
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _doLayout ?when?
+#
+# Call methods to create and pack the Combobox components.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_doLayout {{when later}} {
+ _createComponents
+ _packComponents $when
+}
+
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _drawArrow
+#
+# Draw the arrow button. Determines packing according to
+# -labelpos.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_drawArrow {} {
+ set flip false
+ set relief ""
+ set fg [cget -foreground]
+ if {$_isPosted} {
+ set flip true
+ set relief "-relief sunken"
+ } else {
+ set relief "-relief $itk_option(-arrowrelief)"
+ }
+
+ if {$flip} {
+ #
+ # draw up arrow
+ #
+ eval $itk_component(arrowBtn) configure -image uparrow $relief
+ } else {
+ #
+ # draw down arrow
+ #
+ eval $itk_component(arrowBtn) configure -image downarrow $relief
+ }
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _dropdownBtnRelease window x y
+#
+# Event handler for button releases while a dropdown list
+# is posted.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_dropdownBtnRelease {{window {}} {x 1} {y 1}} {
+
+ # if it's a scrollbar then ignore the release
+ if {($window == [$itk_component(list) component vertsb]) ||
+ ($window == [$itk_component(list) component horizsb])} {
+ return
+ }
+
+ # 1st release allows list to stay up unless we are in listbox
+ if {$_ignoreRelease} {
+ _ignoreNextBtnRelease false
+ return
+ }
+
+ # should I use just the listbox or also include the scrollbars
+ if { ($x >= 0) && ($x < [winfo width [_slbListbox]])
+ && ($y >= 0) && ($y < [winfo height [_slbListbox]])} {
+ _stateSelect
+ }
+
+ _unpostList
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _ignoreNextBtnRelease ignore
+#
+# Set private variable _ignoreRelease. If this variable
+# is true then the next button release will not remove
+# a dropdown list.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_ignoreNextBtnRelease {ignore} {
+ set _ignoreRelease $ignore
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _next
+#
+# Select the next item in the list.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_next {} {
+ if {[size] <= 1} {
+ return
+ }
+ set i [curselection]
+ if {($i == {}) || ($i == [expr [size]-1]) } {
+ set i 0
+ } else {
+ incr i
+ }
+ selection clear 0 end
+ selection set $i $i
+ see $i
+ set _currItem $i
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _packComponents ?when?
+#
+# Pack the components of the combobox and add bindings.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_packComponents {{when later}} {
+ if {$when == "later"} {
+ if {$_repacking == ""} {
+ set _repacking [after idle [code $this _packComponents now]]
+ return
+ }
+ } elseif {$when != "now"} {
+ error "bad option \"$when\": should be now or later"
+ }
+
+ if {$itk_option(-dropdown)} {
+ grid configure $itk_component(list) -row 1 -column 0 -sticky news
+ _resizeArrow
+ grid config $itk_component(arrowBtn) -row 0 -column 1 -sticky nsew
+ } else {
+ # size and pack list hack
+ grid configure $itk_component(entry) -row 0 -column 0 -sticky ew
+ grid configure $itk_component(efchildsite) -row 1 -column 0 -sticky nsew
+ grid configure $itk_component(list) -row 0 -column 0 -sticky nsew
+
+ grid rowconfigure $itk_component(efchildsite) 1 -weight 1
+ grid columnconfigure $itk_component(efchildsite) 0 -weight 1
+ }
+ set _repacking ""
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _positionList
+#
+# Determine the position (geometry) for the popped up list
+# and map it to the screen.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_positionList {} {
+
+ set x [winfo rootx $itk_component(entry) ]
+ set y [expr [winfo rooty $itk_component(entry) ] + \
+ [winfo height $itk_component(entry) ]]
+ set w [winfo width $itk_component(entry) ]
+ set h [winfo height [_slbListbox] ]
+ set sh [winfo screenheight .]
+
+ if {([expr $y+$h] > $sh) && ($y > [expr $sh/2])} {
+ set y [expr [winfo rooty $itk_component(entry) ] - $h]
+ }
+
+ $itk_component(list) configure -width $w
+ wm overrideredirect $itk_component(popup) 0
+ wm geometry $itk_component(popup) +$x+$y
+ wm overrideredirect $itk_component(popup) 1
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _postList
+#
+# Pop up the list in a dropdown style Combobox.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_postList {} {
+ if {[$itk_component(list) size] == ""} {
+ return
+ }
+
+ set _isPosted true
+ _positionList
+
+ # map window and do a grab
+ wm deiconify $itk_component(popup)
+ _listShowing -wait
+ if {$itk_option(-grab) == "global"} {
+ grab -global $itk_component(popup)
+ } else {
+ grab $itk_component(popup)
+ }
+ raise $itk_component(popup)
+ focus $itk_component(popup)
+ _drawArrow
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _previous
+#
+# Select the previous item in the list. Wraps at front
+# and end of list.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_previous {} {
+ if {[size] <= 1} {
+ return
+ }
+ set i [curselection]
+ if {$i == "" || $i == 0} {
+ set i [expr [size] - 1]
+ } else {
+ incr i -1
+ }
+ selection clear 0 end
+ selection set $i $i
+ see $i
+ set _currItem $i
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _resizeArrow
+#
+# Recalculate the arrow button size and then redraw it.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_resizeArrow {} {
+ set bw [expr [$itk_component(arrowBtn) cget -borderwidth]+ \
+ [$itk_component(arrowBtn) cget -highlightthickness]]
+ set newHeight [expr [winfo reqheight $itk_component(entry) ]-(2*$bw) - 2]
+ $itk_component(arrowBtn) configure -width $newHeight -height $newHeight
+ _drawArrow
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _selectCmd
+#
+# Called when list item is selected to insert new text
+# in entry, and call user -command callback if defined.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_selectCmd {} {
+ $itk_component(entry) configure -state normal
+
+ set _currItem [$itk_component(list) curselection]
+ set item [$itk_component(list) getcurselection]
+ clear entry
+ $itk_component(entry) insert 0 $item
+ switch -- $itk_option(-editable) {
+ 0 - false - no - off {
+ $itk_component(entry) configure -state disabled
+ }
+ }
+
+ # execute user command
+ if {$itk_option(-selectioncommand) != ""} {
+ uplevel #0 $itk_option(-selectioncommand)
+ }
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _toggleList
+#
+# Post or unpost the dropdown listbox (toggle).
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_toggleList {} {
+ if {[winfo ismapped $itk_component(popup)] } {
+ _unpostList
+ } else {
+ _postList
+ }
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _unpostList
+#
+# Unmap the listbox (pop it down).
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_unpostList {} {
+ # Determine if event occured in the scrolledlistbox and, if it did,
+ # don't unpost it. (A selection in the list unposts it correctly and
+ # in the scrollbar we don't want to unpost it.)
+ set x [winfo x $itk_component(list)]
+ set y [winfo y $itk_component(list)]
+ set w [winfo width $itk_component(list)]
+ set h [winfo height $itk_component(list)]
+
+ wm withdraw $itk_component(popup)
+ grab release $itk_component(popup)
+
+ set _isPosted false
+
+ $itk_component(list) selection clear 0 end
+ if {$_currItem != {}} {
+ $itk_component(list) selection set $_currItem $_currItem
+ $itk_component(list) activate $_currItem
+ }
+
+ switch -- $itk_option(-editable) {
+ 1 - true - yes - on {
+ $itk_component(entry) configure -state normal
+ }
+ 0 - false - no - off {
+ $itk_component(entry) configure -state disabled
+ }
+ }
+
+ _drawArrow
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _commonBindings
+#
+# Bindings that are used by both simple and dropdown
+# style Comboboxes.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_commonBindings {} {
+ bind $itk_component(entry) <KeyPress-BackSpace> [code $this _bs]
+ bind $itk_component(entry) <KeyRelease> [code $this _lookup %K]
+ bind $itk_component(entry) <Down> [code $this _next]
+ bind $itk_component(entry) <Up> [code $this _previous]
+ bind $itk_component(entry) <Control-n> [code $this _next]
+ bind $itk_component(entry) <Control-p> [code $this _previous]
+ bind [_slbListbox] <Control-n> [code $this _next]
+ bind [_slbListbox] <Control-p> [code $this _previous]
+}
+
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _dropdownBindings
+#
+# Bindings used only by the dropdown type Combobox.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_dropdownBindings {} {
+ bind $itk_component(popup) <Escape> [code $this _unpostList]
+ bind $itk_component(popup) <space> \
+ "[code $this _stateSelect]; [code $this _unpostList]"
+ bind $itk_component(popup) <Return> \
+ "[code $this _stateSelect]; [code $this _unpostList]"
+ bind $itk_component(popup) <ButtonRelease-1> \
+ [code $this _dropdownBtnRelease %W %x %y]
+
+ bind $itk_component(list) <Map> \
+ [code $this _listShowing 1]
+ bind $itk_component(list) <Unmap> \
+ [code $this _listShowing 0]
+
+ # once in the listbox, we drop on the next release (unless in scrollbar)
+ bind [_slbListbox] <Enter> \
+ [code $this _ignoreNextBtnRelease false]
+
+ bind $itk_component(arrowBtn) <3> [code $this _next]
+ bind $itk_component(arrowBtn) <Shift-3> [code $this _previous]
+ bind $itk_component(arrowBtn) <Down> [code $this _next]
+ bind $itk_component(arrowBtn) <Up> [code $this _previous]
+ bind $itk_component(arrowBtn) <Control-n> [code $this _next]
+ bind $itk_component(arrowBtn) <Control-p> [code $this _previous]
+ bind $itk_component(arrowBtn) <Shift-Down> [code $this _toggleList]
+ bind $itk_component(arrowBtn) <Shift-Up> [code $this _toggleList]
+ bind $itk_component(arrowBtn) <Return> [code $this _toggleList]
+ bind $itk_component(arrowBtn) <space> [code $this _toggleList]
+
+ bind $itk_component(entry) <Configure> [code $this _resizeArrow]
+ bind $itk_component(entry) <Shift-Down> [code $this _toggleList]
+ bind $itk_component(entry) <Shift-Up> [code $this _toggleList]
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _simpleBindings
+#
+# Bindings used only by the simple type Comboboxes.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_simpleBindings {} {
+ bind [_slbListbox] <ButtonRelease-1> [code $this _stateSelect]
+ # "[code $this _stateselect]; [code $this _selectCmd]"
+
+
+ bind [_slbListbox] <space> [code $this _stateSelect]
+ bind [_slbListbox] <Return> [code $this _stateSelect]
+ bind $itk_component(entry) <Escape> ""
+ bind $itk_component(entry) <Shift-Down> ""
+ bind $itk_component(entry) <Shift-Up> ""
+ bind $itk_component(entry) <Configure> ""
+}
+
+# ------------------------------------------------------
+# PROTECTED METHOD: _listShowing ?val?
+#
+# Used instead of "tkwait visibility" to make sure that
+# the dropdown list is visible. Whenever the list gets
+# mapped or unmapped, this method is called to keep
+# track of it. When it is called with the value "-wait",
+# it waits for the list to be mapped.
+# ------------------------------------------------------
+body iwidgets::Combobox::_listShowing {{val ""}} {
+ if {$val == ""} {
+ return $_listShowing($this)
+ } elseif {$val == "-wait"} {
+ while {!$_listShowing($this)} {
+ tkwait variable [scope _listShowing($this)]
+ }
+ return
+ }
+ set _listShowing($this) $val
+}
+
+# ------------------------------------------------------
+# PRIVATE METHOD: _slbListbox
+#
+# Access the tk listbox window out of the scrolledlistbox.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_slbListbox {} {
+ return [$itk_component(list) component listbox]
+}
+
+# ------------------------------------------------------
+# PRIVATE METHOD: _stateSelect
+#
+# only allows a B1 release in the listbox to have an effect if -state is
+# normal.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_stateSelect {} {
+ switch -- $itk_option(-state) {
+ normal {
+ [code $this _selectCmd]
+ }
+ }
+}
+
+# ------------------------------------------------------
+# PRIVATE METHOD: _bs
+#
+# A part of the auto-completion code, this function sets a flag when the
+# Backspace key is hit and there is a selection in the entry field.
+# Note that it's probably buggy to assume that a selection being present
+# means that that selection came from auto-completion.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_bs {} {
+ #
+ # exit if completion is turned off
+ #
+ switch -- $itk_option(-completion) {
+ 0 - no - false - off {
+ return
+ }
+ }
+ #
+ # critical section flag. it ain't perfect, but for most usage it'll
+ # keep us from being in this code "twice" at the same time
+ # (auto-repeated keystrokes are a pain!)
+ #
+ if {$_inbs} {
+ return
+ } else {
+ set _inbs 1
+ }
+
+ #
+ # set the _doit flag if there is a selection set in the entry field
+ #
+ set _doit 0
+ if [$itk_component(entry) selection present] {
+ set _doit 1
+ }
+
+ #
+ # clear the semaphore and return
+ #
+ set _inbs 0
+}
+
+# ------------------------------------------------------
+# PRIVATE METHOD: _lookup
+#
+# handles auto-completion of text typed (or insert'd) into the entry field.
+#
+# ------------------------------------------------------
+body iwidgets::Combobox::_lookup {key} {
+ #
+ # exit if completion is turned off
+ #
+ switch -- $itk_option(-completion) {
+ 0 - no - false - off {
+ return
+ }
+ }
+
+ #
+ # critical section flag. it ain't perfect, but for most usage it'll
+ # keep us from being in this code "twice" at the same time
+ # (auto-repeated keystrokes are a pain!)
+ #
+ if {$_inlookup} {
+ return
+ } else {
+ set _inlookup 1
+ }
+
+ #
+ # if state of megawidget is disabled, or the entry is not editable,
+ # clear the semaphore and exit
+ #
+ if {$itk_option(-state) == "disabled" \
+ || [lsearch {on 1 true yes} $itk_option(-editable)] == -1} {
+ set _inlookup 0
+ return
+ }
+
+ #
+ # okay, *now* we can get to work
+ # the _bs function is called on keyPRESS of BackSpace, and will set
+ # the _doit flag if there's a selection set in the entryfield. If
+ # there is, we're assuming that it's generated by completion itself
+ # (this is probably a Bad Assumption), so we'll want to whack the
+ # selected text, as well as the character immediately preceding the
+ # insertion cursor.
+ #
+ if {$key == "BackSpace"} {
+ if {$_doit} {
+ set first [expr [$itk_component(entry) index insert] -1]
+ $itk_component(entry) delete $first end
+ $itk_component(entry) icursor $first
+ }
+ }
+
+ #
+ # get the text left in the entry field, and its length. if
+ # zero-length, clear the selection in the listbox, clear the
+ # semaphore, and boogie.
+ #
+ set text [get]
+ set len [string length $text]
+ if {$len == 0} {
+ $itk_component(list) selection clear 0 end
+ set _inlookup 0
+ return
+ }
+
+ #
+ # okay, so we have to do a lookup. find the first match in the
+ # listbox to the text we've got in the entry field (glob).
+ # if one exists, clear the current listbox selection, and set it to
+ # the one we just found, making that one visible in the listbox.
+ # then, pick off the text from the listbox entry that hadn't yet been
+ # entered into the entry field. we need to tack that text onto the
+ # end of the entry field, select it, and then set the insertion cursor
+ # back to just before the point where we just added that text.
+ # if one didn't exist, then just clear the listbox selection
+ #
+ set item [lsearch [$itk_component(list) get 0 end] "$text*" ]
+ if {$item != -1} {
+ $itk_component(list) selection clear 0 end
+ $itk_component(list) selection set $item $item
+ see $item
+ set remainder [string range [$itk_component(list) get $item] \
+ $len end]
+ $itk_component(entry) insert end $remainder
+ $itk_component(entry) selection range $len end
+ $itk_component(entry) icursor $len
+ } else {
+ $itk_component(list) selection clear 0 end
+ }
+ #
+ # clear the semaphore and return
+ #
+ set _inlookup 0
+ return
+}
diff --git a/itcl/iwidgets3.0.0/generic/dateentry.itk b/itcl/iwidgets3.0.0/generic/dateentry.itk
new file mode 100644
index 00000000000..a6dff9eae03
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/dateentry.itk
@@ -0,0 +1,408 @@
+#
+# Dateentry
+# ----------------------------------------------------------------------
+# Implements a quicken style date entry field with a popup calendar
+# by combining the datefield and calendar widgets together. This
+# allows a user to enter the date via the keyboard or by using the
+# mouse by selecting the calendar icon which brings up a popup calendar.
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts E-mail: mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1997 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Dateentry {
+ keep -background -borderwidth -currentdatefont -cursor \
+ -datefont -dayfont -foreground -highlightcolor \
+ -highlightthickness -labelfont -textbackground -textfont \
+ -titlefont
+}
+
+# ------------------------------------------------------------------
+# DATEENTRY
+# ------------------------------------------------------------------
+class iwidgets::Dateentry {
+ inherit iwidgets::Datefield
+
+ constructor {args} {}
+
+ itk_option define -grab grab Grab "global"
+ itk_option define -icon icon Icon {}
+
+ #
+ # The calendar widget isn't created until needed, yet we need
+ # its options to be available upon creation of a dateentry widget.
+ # So, we'll define them in these class now so they can just be
+ # propagated onto the calendar later.
+ #
+ itk_option define -days days Days {Su Mo Tu We Th Fr Sa}
+ itk_option define -forwardimage forwardImage Image {}
+ itk_option define -backwardimage backwardImage Image {}
+ itk_option define -weekdaybackground weekdayBackground Background \#d9d9d9
+ itk_option define -weekendbackground weekendBackground Background \#d9d9d9
+ itk_option define -outline outline Outline \#d9d9d9
+ itk_option define -buttonforeground buttonForeground Foreground blue
+ itk_option define -foreground foreground Foreground black
+ itk_option define -selectcolor selectColor Foreground red
+ itk_option define -selectthickness selectThickness SelectThickness 3
+ itk_option define -titlefont titleFont Font \
+ -*-helvetica-bold-r-normal--*-140-*
+ itk_option define -dayfont dayFont Font \
+ -*-helvetica-medium-r-normal--*-120-*
+ itk_option define -datefont dateFont Font \
+ -*-helvetica-medium-r-normal--*-120-*
+ itk_option define -currentdatefont currentDateFont Font \
+ -*-helvetica-bold-r-normal--*-120-*
+ itk_option define -startday startDay Day sunday
+ itk_option define -height height Height 165
+ itk_option define -width width Width 200
+ itk_option define -state state State normal
+
+ protected {
+ method _getPopupDate {date}
+ method _releaseGrab {}
+ method _releaseGrabCheck {rootx rooty}
+ method _popup {}
+ method _getDefaultIcon {}
+
+ common _defaultIcon ""
+ }
+}
+
+#
+# Provide a lowercased access method for the dateentry class.
+#
+proc ::iwidgets::dateentry {pathName args} {
+ uplevel ::iwidgets::Dateentry $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Dateentry::constructor {args} {
+ #
+ # Create an icon label to act as a button to bring up the
+ # calendar popup.
+ #
+ itk_component add iconbutton {
+ label $itk_interior.iconbutton -relief raised
+ } {
+ keep -borderwidth -cursor -foreground
+ }
+ grid $itk_component(iconbutton) -row 0 -column 0 -sticky ns
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -icon
+#
+# Specifies the calendar icon image to be used in the date.
+# Should one not be provided, then a default pixmap will be used
+# if possible, bitmap otherwise.
+# ------------------------------------------------------------------
+configbody iwidgets::Dateentry::icon {
+ if {$itk_option(-icon) == {}} {
+ $itk_component(iconbutton) configure -image [_getDefaultIcon]
+ } else {
+ if {[lsearch [image names] $itk_option(-icon)] == -1} {
+ error "bad icon option \"$itk_option(-icon)\":\
+ should be an existing image"
+ } else {
+ $itk_component(iconbutton) configure -image $itk_option(-icon)
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -grab
+#
+# Specifies the grab level, local or global, to be obtained when
+# bringing up the popup calendar. The default is global.
+# ------------------------------------------------------------------
+configbody iwidgets::Dateentry::grab {
+ switch -- $itk_option(-grab) {
+ "local" - "global" {}
+ default {
+ error "bad grab option \"$itk_option(-grab)\":\
+ should be local or global"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -state
+#
+# Specifies the state of the widget which may be disabled or
+# normal. A disabled state prevents selection of the date field
+# or date icon button.
+# ------------------------------------------------------------------
+configbody iwidgets::Dateentry::state {
+ switch -- $itk_option(-state) {
+ normal {
+ bind $itk_component(iconbutton) <Button-1> [code $this _popup]
+ }
+ disabled {
+ bind $itk_component(iconbutton) <Button-1> {}
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _getDefaultIcon
+#
+# This method is invoked uto retrieve the name of the default icon
+# image displayed in the icon button.
+# ------------------------------------------------------------------
+body iwidgets::Dateentry::_getDefaultIcon {} {
+ if {[lsearch [image types] pixmap] != -1} {
+ set _defaultIcon [image create pixmap -data {
+ /* XPM */
+ static char *calendar[] = {
+ /* width height num_colors chars_per_pixel */
+ " 25 20 6 1",
+ /* colors */
+ ". c #808080",
+ "# c #040404",
+ "a c #848484",
+ "b c #fc0404",
+ "c c #fcfcfc",
+ "d c #c0c0c0",
+ /* pixels */
+ "d##########d###########dd",
+ "d#ccccccccc##ccccccccca#d",
+ "##ccccccccc.#ccccccccc..#",
+ "##cccbbcccca#cccbbbccca.#",
+ "##cccbbcccc.#ccbbbbbcc..#",
+ "##cccbbccc####ccccbbcc..#",
+ "##cccbbcccca#ccccbbbcca.#",
+ "##cccbbcccc.#cccbbbccc..#",
+ "##cccbbcccca#ccbbbcccca.#",
+ "##cccbbbccc.#ccbbbbbcc..#",
+ "##ccccccccc.#ccccccccc..#",
+ "##ccccccccca#ccccccccca.#",
+ "##cc#####c#cd#c#####cc..#",
+ "##cccccccc####cccccccca.#",
+ "##cc#####cc.#cc#####cc..#",
+ "##ccccccccc.#ccccccccc..#",
+ "##ccccccccc.#ccccccccc..#",
+ "##..........#...........#",
+ "###..........#..........#",
+ "#########################"
+ };
+ }]
+ } else {
+ set _defaultIcon [image create bitmap -data {
+ #define calendr2_width 25
+ #define calendr2_height 20
+ static char calendr2_bits[] = {
+ 0xfe,0xf7,0x7f,0xfe,0x02,0x18,0xc0,0xfe,0x03,
+ 0x18,0x80,0xff,0x63,0x10,0x47,0xff,0x43,0x98,
+ 0x8a,0xff,0x63,0x3c,0x4c,0xff,0x43,0x10,0x8a,
+ 0xff,0x63,0x18,0x47,0xff,0x23,0x90,0x81,0xff,
+ 0xe3,0x98,0x4e,0xff,0x03,0x10,0x80,0xff,0x03,
+ 0x10,0x40,0xff,0xf3,0xa5,0x8f,0xff,0x03,0x3c,
+ 0x40,0xff,0xf3,0x99,0x8f,0xff,0x03,0x10,0x40,
+ 0xff,0x03,0x18,0x80,0xff,0x57,0x55,0x55,0xff,
+ 0x57,0xb5,0xaa,0xff,0xff,0xff,0xff,0xff};
+ }]
+ }
+
+ #
+ # Since this image will only need to be created once, we redefine
+ # this method to just return the image name for subsequent calls.
+ #
+ body ::iwidgets::Dateentry::_getDefaultIcon {} {
+ return $_defaultIcon
+ }
+
+ return $_defaultIcon
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _popup
+#
+# This method is invoked upon selection of the icon button. It
+# creates a calendar widget within a toplevel popup, calculates
+# the position at which to display the calendar, performs a grab
+# and displays the calendar.
+# ------------------------------------------------------------------
+body iwidgets::Dateentry::_popup {} {
+ #
+ # First, let's nullify the icon binding so that any another
+ # selections are ignored until were done with this one. Next,
+ # change the relief of the icon.
+ #
+ bind $itk_component(iconbutton) <Button-1> {}
+ $itk_component(iconbutton) configure -relief sunken
+
+ #
+ # Create a withdrawn toplevel widget and remove the window
+ # decoration via override redirect.
+ #
+ itk_component add -private popup {
+ toplevel $itk_interior.popup
+ }
+ $itk_component(popup) configure -borderwidth 2 -background black
+ wm withdraw $itk_component(popup)
+ wm overrideredirect $itk_component(popup) 1
+
+ #
+ # Add a binding to button 1 events in order to detect mouse
+ # clicks off the calendar in which case we'll release the grab.
+ # Also add a binding for Escape to always release.
+ #
+ bind $itk_component(popup) <1> [code $this _releaseGrabCheck %X %Y]
+ bind $itk_component(popup) <KeyPress-Escape> [code $this _releaseGrab]
+
+ #
+ # Create the calendar widget and set its cursor properly.
+ #
+ itk_component add calendar {
+ iwidgets::Calendar $itk_component(popup).calendar \
+ -command [code $this _getPopupDate %d]
+ } {
+ usual
+ keep -days -forwardimage -backwardimage -weekdaybackground \
+ -weekendbackground -outline -buttonforeground -selectcolor \
+ -selectthickness -titlefont -dayfont -datefont \
+ -currentdatefont -startday -width -height
+ }
+ grid $itk_component(calendar) -row 0 -column 0
+ $itk_component(calendar) configure -cursor top_left_arrow
+
+ #
+ # The icon button will be used as the basis for the position of the
+ # popup on the screen. We'll always attempt to locate the popup
+ # off the lower right corner of the button. If that would put
+ # the popup off the screen, then we'll put above the upper left.
+ #
+ set rootx [winfo rootx $itk_component(iconbutton)]
+ set rooty [winfo rooty $itk_component(iconbutton)]
+ set popupwidth [winfo reqwidth $itk_component(popup)]
+ set popupheight [winfo reqheight $itk_component(popup)]
+
+ set popupx [expr $rootx + 3 + \
+ [winfo width $itk_component(iconbutton)]]
+ set popupy [expr $rooty + 3 + \
+ [winfo height $itk_component(iconbutton)]]
+
+ if {([expr $popupx + $popupwidth] > [winfo screenwidth .]) || \
+ ([expr $popupy + $popupheight] > [winfo screenheight .])} {
+ set popupx [expr $rootx - 3 - $popupwidth]
+ set popupy [expr $rooty - 3 - $popupheight]
+ }
+
+ #
+ # Get the current date from the datefield widget and both
+ # show and select it on the calendar.
+ #
+ $itk_component(calendar) show [get]
+ $itk_component(calendar) select [get]
+
+ #
+ # Display the popup at the calculated position.
+ #
+ wm geometry $itk_component(popup) +$popupx+$popupy
+ wm deiconify $itk_component(popup)
+ tkwait visibility $itk_component(popup)
+
+ #
+ # Perform either a local or global grab based on the -grab option.
+ #
+ if {$itk_option(-grab) == "local"} {
+ grab $itk_component(popup)
+ } else {
+ grab -global $itk_component(popup)
+ }
+
+ #
+ # Make sure the widget is above all others and give it focus.
+ #
+ raise $itk_component(popup)
+ focus $itk_component(calendar)
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _popupGetDate
+#
+# This method is the callback for selection of a date on the
+# calendar. It releases the grab and sets the date in the
+# datefield widget.
+# ------------------------------------------------------------------
+body iwidgets::Dateentry::_getPopupDate {date} {
+ _releaseGrab
+ show $date
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _releaseGrabCheck rootx rooty
+#
+# This method handles mouse button 1 events. If the selection
+# occured within the bounds of the calendar, then return normally
+# and let the calendar handle the event. Otherwise, we'll drop
+# the calendar and release the grab.
+# ------------------------------------------------------------------
+body iwidgets::Dateentry::_releaseGrabCheck {rootx rooty} {
+ set calx [winfo rootx $itk_component(calendar)]
+ set caly [winfo rooty $itk_component(calendar)]
+ set calwidth [winfo reqwidth $itk_component(calendar)]
+ set calheight [winfo reqheight $itk_component(calendar)]
+
+ if {($rootx < $calx) || ($rootx > [expr $calx + $calwidth]) || \
+ ($rooty < $caly) || ($rooty > [expr $caly + $calheight])} {
+ _releaseGrab
+ return -code break
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _releaseGrab
+#
+# This method releases the grab, destroys the popup, changes the
+# relief of the button back to raised and reapplies the binding
+# to the icon button that engages the popup action.
+# ------------------------------------------------------------------
+body iwidgets::Dateentry::_releaseGrab {} {
+ grab release $itk_component(popup)
+ $itk_component(iconbutton) configure -relief raised
+ destroy $itk_component(popup)
+ unset itk_component(popup)
+ bind $itk_component(iconbutton) <Button-1> [code $this _popup]
+}
diff --git a/itcl/iwidgets3.0.0/generic/datefield.itk b/itcl/iwidgets3.0.0/generic/datefield.itk
new file mode 100644
index 00000000000..eba7d6a8908
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/datefield.itk
@@ -0,0 +1,854 @@
+#
+# Datefield
+# ----------------------------------------------------------------------
+# Implements a date entry field with adjustable built-in intelligence
+# levels.
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts E-mail: mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1997 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Datefield {
+ keep -background -borderwidth -cursor -foreground -highlightcolor \
+ -highlightthickness -labelfont -textbackground -textfont
+}
+
+# ------------------------------------------------------------------
+# DATEFIELD
+# ------------------------------------------------------------------
+class iwidgets::Datefield {
+ inherit iwidgets::Labeledwidget
+
+ constructor {args} {}
+
+ itk_option define -childsitepos childSitePos Position e
+ itk_option define -command command Command {}
+ itk_option define -iq iq Iq high
+
+ public method get {{format "-string"}}
+ public method isvalid {}
+ public method show {{date now}}
+
+ protected method _backward {}
+ protected method _focusIn {}
+ protected method _forward {}
+ protected method _keyPress {char sym state}
+ protected method _lastDay {month year}
+ protected method _moveField {direction}
+ protected method _setField {field}
+ protected method _whichField {}
+
+ protected variable _cfield "month"
+ protected variable _fields {month day year}
+}
+
+#
+# Provide a lowercased access method for the datefield class.
+#
+proc ::iwidgets::datefield {pathName args} {
+ uplevel ::iwidgets::Datefield $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Datefield.justify center widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Datefield::constructor {args} {
+ component hull configure -borderwidth 0
+
+ #
+ # Create an entry field for entering the date.
+ #
+ itk_component add date {
+ entry $itk_interior.date -width 10
+ } {
+ keep -borderwidth -cursor -exportselection \
+ -foreground -highlightcolor -highlightthickness \
+ -insertbackground -justify -relief -state
+
+ rename -font -textfont textFont Font
+ rename -highlightbackground -background background Background
+ rename -background -textbackground textBackground Background
+ }
+
+ #
+ # Create the child site widget.
+ #
+ itk_component add -protected dfchildsite {
+ frame $itk_interior.dfchildsite
+ }
+ set itk_interior $itk_component(dfchildsite)
+
+ #
+ # Add datefield event bindings for focus in and keypress events.
+ #
+ bind $itk_component(date) <FocusIn> [code $this _focusIn]
+ bind $itk_component(date) <KeyPress> [code $this _keyPress %A %K %s]
+
+ #
+ # Disable some mouse button event bindings:
+ # Button Motion
+ # Double-Clicks
+ # Triple-Clicks
+ # Button2
+ #
+ bind $itk_component(date) <Button1-Motion> break
+ bind $itk_component(date) <Button2-Motion> break
+ bind $itk_component(date) <Double-Button> break
+ bind $itk_component(date) <Triple-Button> break
+ bind $itk_component(date) <2> break
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+
+ #
+ # Initialize the date to the current date.
+ #
+ $itk_component(date) delete 0 end
+ $itk_component(date) insert end \
+ [clock format [clock seconds] -format "%m/%d/%Y"]
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -childsitepos
+#
+# Specifies the position of the child site in the widget. Valid
+# locations are n, s, e, and w.
+# ------------------------------------------------------------------
+configbody iwidgets::Datefield::childsitepos {
+ set parent [winfo parent $itk_component(date)]
+
+ switch $itk_option(-childsitepos) {
+ n {
+ grid $itk_component(dfchildsite) -row 0 -column 0 -sticky ew
+ grid $itk_component(date) -row 1 -column 0 -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 0
+ grid rowconfigure $parent 1 -weight 1
+ grid columnconfigure $parent 0 -weight 1
+ grid columnconfigure $parent 1 -weight 0
+ }
+
+ e {
+ grid $itk_component(dfchildsite) -row 0 -column 1 -sticky ns
+ grid $itk_component(date) -row 0 -column 0 -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 1
+ grid rowconfigure $parent 1 -weight 0
+ grid columnconfigure $parent 0 -weight 1
+ grid columnconfigure $parent 1 -weight 0
+ }
+
+ s {
+ grid $itk_component(dfchildsite) -row 1 -column 0 -sticky ew
+ grid $itk_component(date) -row 0 -column 0 -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 1
+ grid rowconfigure $parent 1 -weight 0
+ grid columnconfigure $parent 0 -weight 1
+ grid columnconfigure $parent 1 -weight 0
+ }
+
+ w {
+ grid $itk_component(dfchildsite) -row 0 -column 0 -sticky ns
+ grid $itk_component(date) -row 0 -column 1 -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 1
+ grid rowconfigure $parent 1 -weight 0
+ grid columnconfigure $parent 0 -weight 0
+ grid columnconfigure $parent 1 -weight 1
+ }
+
+ default {
+ error "bad childsite option\
+ \"$itk_option(-childsitepos)\":\
+ should be n, e, s, or w"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -command
+#
+# Command invoked upon detection of return key press event.
+# ------------------------------------------------------------------
+configbody iwidgets::Datefield::command {}
+
+# ------------------------------------------------------------------
+# OPTION: -iq
+#
+# Specifies the level of intelligence to be shown in the actions
+# taken by the date field during the processing of keypress events.
+# Valid settings include high, average, and low. With a high iq,
+# the date prevents the user from typing in an invalid date. For
+# example, if the current date is 05/31/1997 and the user changes
+# the month to 04, then the day will be instantly modified for them
+# to be 30. In addition, leap years are fully taken into account.
+# With average iq, the month is limited to the values of 01-12, but
+# it is possible to type in an invalid day. A setting of low iq
+# instructs the widget to do no validity checking at all during
+# date entry. With both average and low iq levels, it is assumed
+# that the validity will be determined at a later time using the
+# date's isvalid command.
+# ------------------------------------------------------------------
+configbody iwidgets::Datefield::iq {
+ switch $itk_option(-iq) {
+ high - average - low {
+ }
+ default {
+ error "bad iq option \"$itk_option(-iq)\":\
+ should be high, average or low"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: get ?format?
+#
+# Return the current contents of the datefield in one of two formats
+# string or as an integer clock value using the -string and -clicks
+# options respectively. The default is by string. Reference the
+# clock command for more information on obtaining dates and their
+# formats.
+# ------------------------------------------------------------------
+body iwidgets::Datefield::get {{format "-string"}} {
+ set datestr [$itk_component(date) get]
+
+ switch -- $format {
+ "-string" {
+ return $datestr
+ }
+ "-clicks" {
+ return [clock scan $datestr]
+ }
+ default {
+ error "bad format option \"$format\":\
+ should be -string or -clicks"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: show date
+#
+# Changes the currently displayed date to be that of the date
+# argument. The date may be specified either as a string or an
+# integer clock value. Reference the clock command for more
+# information on obtaining dates and their formats.
+# ------------------------------------------------------------------
+body iwidgets::Datefield::show {{date "now"}} {
+ if {$date == "now"} {
+ set seconds [clock seconds]
+ } else {
+ if {[catch {clock format $date}] == 0} {
+ set seconds $date
+ } elseif {[catch {set seconds [clock scan $date]}] != 0} {
+ error "bad date: \"$date\", must be a valid date\
+ string, clock clicks value or the keyword now"
+ }
+ }
+
+ $itk_component(date) delete 0 end
+ $itk_component(date) insert end [clock format $seconds -format "%m/%d/%Y"]
+
+ _setField month
+
+ return
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: isvalid
+#
+# Returns a boolean indication of the validity of the currently
+# displayed date value. For example, 3/3/1960 is valid whereas
+# 02/29/1997 is invalid.
+# ------------------------------------------------------------------
+body iwidgets::Datefield::isvalid {} {
+ if {[catch {clock scan [$itk_component(date) get]}] != 0} {
+ return 0
+ } else {
+ return 1
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _focusIn
+#
+# This method is bound to the <FocusIn> event. It resets the
+# insert cursor and field settings to be back to their last known
+# positions.
+# ------------------------------------------------------------------
+body iwidgets::Datefield::_focusIn {} {
+ _setField $_cfield
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _keyPress
+#
+# This method is the workhorse of the class. It is bound to the
+# <KeyPress> event and controls the processing of all key strokes.
+# ------------------------------------------------------------------
+body iwidgets::Datefield::_keyPress {char sym state} {
+ #
+ # Determine which field we are in currently. This is needed
+ # since the user may have moved to this position via a mouse
+ # selection and so it would not be in the position we last
+ # knew it to be.
+ #
+ _whichField
+
+ #
+ # Set up a few basic variables we'll be needing throughout the
+ # rest of the method such as the position of the insert cursor
+ # and the currently displayed day, month, and year.
+ #
+ set icursor [$itk_component(date) index insert]
+ set splist [split [$itk_component(date) get] "/"]
+ set month [lindex $splist 0]
+ set day [lindex $splist 1]
+ set year [lindex $splist 2]
+
+ #
+ # Process numeric keystrokes. This involes a fair amount of
+ # processing with step one being to check and make sure we
+ # aren't attempting to insert more that 10 characters. If
+ # so ring the bell and break.
+ #
+ if {[regexp {[0-9]} $char]} {
+ if {[$itk_component(date) index insert] == 10} {
+ bell
+ return -code break
+ }
+
+ #
+ # If we are currently in the month field then we process the
+ # number entered based on the cursor position. If we are at
+ # at the first position and our iq is low, then accept any
+ # input.
+ #
+ if {$_cfield == "month"} {
+ if {[$itk_component(date) index insert] == 0} {
+ if {$itk_option(-iq) == "low"} {
+ $itk_component(date) delete 0
+ $itk_component(date) insert 0 $char
+
+ } else {
+
+ #
+ # Otherwise, we're slightly smarter. If the number
+ # is less than two insert it at position zero. If
+ # this makes the month greater than twelve, set the
+ # number at position one to zero which makes in
+ # effect puts the month back in range.
+ #
+ regsub {([0-9])([0-9])} $month "$char\\2" month2b
+
+ if {$char < 2} {
+ $itk_component(date) delete 0
+ $itk_component(date) insert 0 $char
+
+ if {$month2b > 12} {
+ $itk_component(date) delete 1
+ $itk_component(date) insert 1 0
+ $itk_component(date) icursor 1
+ } elseif {$month2b == "00"} {
+ $itk_component(date) delete 1
+ $itk_component(date) insert 1 1
+ $itk_component(date) icursor 1
+ }
+
+ #
+ # Finally, if the number is greater than one we'll
+ # assume that they really mean to be entering a zero
+ # followed by their number, do so for them, and
+ # proceed to skip to the next field which is the
+ # day field.
+ #
+ } else {
+ $itk_component(date) delete 0 2
+ $itk_component(date) insert 0 0$char
+ _setField day
+ }
+ }
+
+ #
+ # Else, we're at cursor position one. Again, if we aren't
+ # too smart, let them enter anything. Otherwise, if the
+ # number makes the month exceed twelve, set the month to
+ # zero followed by their number to get it back into range.
+ #
+ } else {
+ regsub {([0-9])([0-9])} $month "\\1$char" month2b
+
+ if {$itk_option(-iq) == "low"} {
+ $itk_component(date) delete 1
+ $itk_component(date) insert 1 $char
+ } else {
+ if {$month2b > 12} {
+ $itk_component(date) delete 0 2
+ $itk_component(date) insert 0 0$char
+ } elseif {$month2b == "00"} {
+ bell
+ return -code break
+ } else {
+ $itk_component(date) delete 1
+ $itk_component(date) insert 1 $char
+ }
+ }
+
+ _setField day
+ }
+
+ #
+ # Now, the month processing is complete and if we're of a
+ # high level of intelligence, then we'll make sure that the
+ # current value for the day is valid for this month. If
+ # it is beyond the last day for this month, change it to
+ # be the last day of the new month.
+ #
+ if {$itk_option(-iq) == "high"} {
+ set splist [split [$itk_component(date) get] "/"]
+ set month [lindex $splist 0]
+
+ if {$day > [set endday [_lastDay $month $year]]} {
+ set icursor [$itk_component(date) index insert]
+ $itk_component(date) delete 3 5
+ $itk_component(date) insert 3 $endday
+ $itk_component(date) icursor $icursor
+ }
+ }
+
+ #
+ # Finally, return with a code of break to stop any normal
+ # processing in that we've done all that is necessary.
+ #
+ return -code break
+ }
+
+ #
+ # This next block of code is for processing of the day field
+ # which is quite similar is strategy to that of the month.
+ #
+ if {$_cfield == "day"} {
+ if {$itk_option(-iq) == "high"} {
+ set endofMonth [_lastDay $month $year]
+ } else {
+ set endofMonth 31
+ }
+
+ #
+ # If we are at the third cursor position we are porcessing
+ # the first character of the day field. If we have an iq
+ # of low accept any input.
+ #
+ if {[$itk_component(date) index insert] == 3} {
+ if {$itk_option(-iq) == "low"} {
+ $itk_component(date) delete 3
+ $itk_component(date) insert 3 $char
+
+ } else {
+
+ #
+ # If the day to be is double zero, then make the
+ # day be the first.
+ #
+ regsub {([0-9])([0-9])} $day "$char\\2" day2b
+
+ if {$day2b == "00"} {
+ $itk_component(date) delete 3 5
+ $itk_component(date) insert 3 01
+ $itk_component(date) icursor 4
+
+ #
+ # Otherwise, if the character is less than four
+ # and the month is not Feburary, insert the number
+ # and if this makes the day be beyond the valid
+ # range for this month, than set to be back in
+ # range.
+ #
+ } elseif {($char < 4) && ($month != "02")} {
+ $itk_component(date) delete 3
+ $itk_component(date) insert 3 $char
+
+ if {$day2b > $endofMonth} {
+ $itk_component(date) delete 4
+ $itk_component(date) insert 4 0
+ $itk_component(date) icursor 4
+ }
+
+ #
+ # For Feburary with a number to be entered of
+ # less than three, make sure the number doesn't
+ # make the day be greater than the correct range
+ # and if so adjust the input.
+ #
+ } elseif {$char < 3} {
+ $itk_component(date) delete 3
+ $itk_component(date) insert 3 $char
+
+ if {$day2b > $endofMonth} {
+ $itk_component(date) delete 3 5
+ $itk_component(date) insert 3 $endofMonth
+ $itk_component(date) icursor 4
+ }
+
+ #
+ # Finally, if the number is greater than three,
+ # set the day to be zero followed by the number
+ # entered and proceed to the year field.
+ #
+ } else {
+ $itk_component(date) delete 3 5
+ $itk_component(date) insert 3 0$char
+ _setField year
+ }
+ }
+
+ #
+ # Else, we're dealing with the second number in the day
+ # field. If we're not too bright accept anything, otherwise
+ # if the day is beyond the range for this month or equal to
+ # zero then ring the bell.
+ #
+ } else {
+ regsub {([0-9])([0-9])} $day "\\1$char" day2b
+
+ if {($itk_option(-iq) != "low") && \
+ (($day2b > $endofMonth) || ($day2b == "00"))} {
+ bell
+ } else {
+ $itk_component(date) delete 4
+ $itk_component(date) insert 4 $char
+ _setField year
+ }
+ }
+
+ #
+ # Return with a code of break to prevent normal processing.
+ #
+ return -code break
+ }
+
+ #
+ # This month and day we're tough, the code for the year is
+ # comparitively simple. Accept any input and if we are really
+ # sharp, then make sure the day is correct for the month
+ # given the year. In short, handle leap years.
+ #
+ if {$_cfield == "year"} {
+ if {$itk_option(-iq) == "low"} {
+ $itk_component(date) delete $icursor
+ $itk_component(date) insert $icursor $char
+ } else {
+
+ set prevdate [get]
+
+ if {[$itk_component(date) index insert] == 6} {
+ set yrdgt [lindex [split [lindex \
+ [split $prevdate "/"] 2] ""] 0]
+ if {$char != $yrdgt} {
+ if {$char == 1} {
+ $itk_component(date) delete $icursor end
+ $itk_component(date) insert $icursor 1999
+ } elseif {$char == 2} {
+ $itk_component(date) delete $icursor end
+ $itk_component(date) insert $icursor 2000
+ } else {
+ bell
+ return -code break
+ }
+ }
+
+ $itk_component(date) icursor 7
+ return -code break
+ }
+
+ $itk_component(date) delete $icursor
+ $itk_component(date) insert $icursor $char
+
+ if {[catch {clock scan [get]}] != 0} {
+ $itk_component(date) delete 6 end
+ $itk_component(date) insert end \
+ [lindex [split $prevdate "/"] 2]
+ $itk_component(date) icursor $icursor
+
+ bell
+ return -code break
+ }
+
+ if {$itk_option(-iq) == "high"} {
+ set splist [split [$itk_component(date) get] "/"]
+ set year [lindex $splist 2]
+
+ if {$day > [set endday [_lastDay $month $year]]} {
+ set icursor [$itk_component(date) index insert]
+ $itk_component(date) delete 3 5
+ $itk_component(date) insert 3 $endday
+ $itk_component(date) icursor $icursor
+ }
+ }
+ }
+
+ return -code break
+ }
+
+ #
+ # Process the plus and the up arrow keys. They both yeild the same
+ # effect, they increment the day by one.
+ #
+ } elseif {($sym == "plus") || ($sym == "Up")} {
+ if {[catch {show [clock scan "1 day" -base [get -clicks]]}] != 0} {
+ bell
+ }
+ return -code break
+
+ #
+ # Process the minus and the down arrow keys which decrement the day.
+ #
+ } elseif {($sym == "minus") || ($sym == "Down")} {
+ if {[catch {show [clock scan "-1 day" -base [get -clicks]]}] != 0} {
+ bell
+ }
+ return -code break
+
+ #
+ # A tab key moves the day/month/year field forward by one unless
+ # the current field is the year. In that case we'll let tab
+ # do what is supposed to and pass the focus onto the next widget.
+ #
+ } elseif {($sym == "Tab") && ($state == 0)} {
+ if {$_cfield != "year"} {
+ _moveField forward
+ return -code break
+ } else {
+ _setField "month"
+ return -code continue
+ }
+
+ #
+ # A ctrl-tab key moves the day/month/year field backwards by one
+ # unless the current field is the month. In that case we'll let
+ # tab take the focus to a previous widget.
+ #
+ } elseif {($sym == "Tab") && ($state == 4)} {
+ if {$_cfield != "month"} {
+ _moveField backward
+ return -code break
+ } else {
+ set _cfield "month"
+ return -code continue
+ }
+
+ #
+ # A right arrow key moves the insert cursor to the right one.
+ #
+ } elseif {$sym == "Right"} {
+ _forward
+ return -code break
+
+ #
+ # A left arrow, backspace, or delete key moves the insert cursor
+ # to the left one. This is what you expect for the left arrow
+ # and since the whole widget always operates in overstrike mode,
+ # it makes the most sense for backspace and delete to do the same.
+ #
+ } elseif {$sym == "Left" || $sym == "BackSpace" || $sym == "Delete"} {
+ _backward
+ return -code break
+
+ } elseif {($sym == "Control_L") || ($sym == "Shift_L") || \
+ ($sym == "Control_R") || ($sym == "Shift_R")} {
+ return -code break
+
+ #
+ # A Return key invokes the optionally specified command option.
+ #
+ } elseif {$sym == "Return"} {
+ uplevel #0 $itk_option(-command)
+ return -code break
+
+ } else {
+ bell
+ return -code break
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _setField field
+#
+# Internal method which adjusts the field to be that of the
+# argument, setting the insert cursor appropriately.
+# ------------------------------------------------------------------
+body iwidgets::Datefield::_setField {field} {
+ set _cfield $field
+
+ switch $field {
+ "month" {
+ $itk_component(date) icursor 0
+ }
+ "day" {
+ $itk_component(date) icursor 3
+ }
+ "year" {
+ $itk_component(date) icursor 8
+ }
+ default {
+ error "bad field: \"$field\", must be month, day or year"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _moveField
+#
+# Internal method for moving the field forward or backward by one.
+# ------------------------------------------------------------------
+body iwidgets::Datefield::_moveField {direction} {
+ set index [lsearch $_fields $_cfield]
+
+ if {$direction == "forward"} {
+ set newIndex [expr $index + 1]
+ } else {
+ set newIndex [expr $index - 1]
+ }
+
+ if {$newIndex == [llength $_fields]} {
+ set newIndex 0
+ }
+ if {$newIndex < 0} {
+ set newIndex [expr [llength $_fields] - 1]
+ }
+
+ _setField [lindex $_fields $newIndex]
+
+ return
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _whichField
+#
+# Internal method which returns the current field that the cursor
+# is currently within.
+# ------------------------------------------------------------------
+body iwidgets::Datefield::_whichField {} {
+ set icursor [$itk_component(date) index insert]
+
+ switch $icursor {
+ 0 - 1 {
+ set _cfield "month"
+ }
+ 3 - 4 {
+ set _cfield "day"
+ }
+ 6 - 7 - 8 - 9 {
+ set _cfield "year"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _forward
+#
+# Internal method which moves the cursor forward by one character
+# jumping over the slashes and wrapping.
+# ------------------------------------------------------------------
+body iwidgets::Datefield::_forward {} {
+ set icursor [$itk_component(date) index insert]
+
+ switch $icursor {
+ 1 {
+ _setField day
+ }
+ 4 {
+ _setField year
+ }
+ 9 - 10 {
+ _setField month
+ }
+ default {
+ $itk_component(date) icursor [expr $icursor + 1]
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _backward
+#
+# Internal method which moves the cursor backward by one character
+# jumping over the slashes and wrapping.
+# ------------------------------------------------------------------
+body iwidgets::Datefield::_backward {} {
+ set icursor [$itk_component(date) index insert]
+
+ switch $icursor {
+ 6 {
+ _setField day
+ }
+ 3 {
+ _setField month
+ }
+ 0 {
+ _setField year
+ }
+ default {
+ $itk_component(date) icursor [expr $icursor -1]
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _lastDay month year
+#
+# Internal method which determines the last day of the month for
+# the given month and year. We start at 28 and go forward till
+# we fail. Crude but effective.
+# ------------------------------------------------------------------
+body iwidgets::Datefield::_lastDay {month year} {
+ set lastone 28
+
+ for {set lastone 28} {$lastone < 32} {incr lastone} {
+ if {[catch {clock scan $month/[expr $lastone + 1]/$year}] != 0} {
+ return $lastone
+ }
+ }
+}
diff --git a/itcl/iwidgets3.0.0/generic/dialog.itk b/itcl/iwidgets3.0.0/generic/dialog.itk
new file mode 100644
index 00000000000..519d57bf37f
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/dialog.itk
@@ -0,0 +1,92 @@
+#
+# Dialog
+# ----------------------------------------------------------------------
+# Implements a standard dialog box providing standard buttons and a
+# child site for use in derived classes. The buttons include ok, apply,
+# cancel, and help. Options exist to configure the buttons.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Dialog {
+ keep -background -cursor -foreground -modality
+}
+
+# ------------------------------------------------------------------
+# DIALOG
+# ------------------------------------------------------------------
+class iwidgets::Dialog {
+ inherit iwidgets::Dialogshell
+
+ constructor {args} {}
+}
+
+#
+# Provide a lowercased access method for the Dialog class.
+#
+proc ::iwidgets::dialog {pathName args} {
+ uplevel ::iwidgets::Dialog $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Dialog.master "." widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Dialog::constructor {args} {
+ #
+ # Add the standard buttons: OK, Apply, Cancel, and Help, making
+ # OK be the default button.
+ #
+ add OK -text OK -command [code $this deactivate 1]
+ add Apply -text Apply
+ add Cancel -text Cancel -command [code $this deactivate 0]
+ add Help -text Help
+
+ default OK
+
+ #
+ # Bind the window manager delete protocol to invocation of the
+ # cancel button. This can be overridden by the user via the
+ # execution of a similar command outside the class.
+ #
+ wm protocol $itk_component(hull) WM_DELETE_WINDOW \
+ [code $this invoke Cancel]
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+}
+
diff --git a/itcl/iwidgets3.0.0/generic/dialogshell.itk b/itcl/iwidgets3.0.0/generic/dialogshell.itk
new file mode 100644
index 00000000000..d4a52e998ef
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/dialogshell.itk
@@ -0,0 +1,350 @@
+# Dialogshell
+# ----------------------------------------------------------------------
+# This class is implements a dialog shell which is a top level widget
+# composed of a button box, separator, and child site area. The class
+# also has methods to control button construction.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Dialogshell {
+ keep -background -cursor -foreground -modality
+}
+
+# ------------------------------------------------------------------
+# DIALOGSHELL
+# ------------------------------------------------------------------
+class iwidgets::Dialogshell {
+ inherit iwidgets::Shell
+
+ constructor {args} {}
+
+ itk_option define -thickness thickness Thickness 3
+ itk_option define -buttonboxpos buttonBoxPos Position s
+ itk_option define -separator separator Separator on
+ itk_option define -padx padX Pad 10
+ itk_option define -pady padY Pad 10
+
+ public method childsite {}
+ public method index {args}
+ public method add {args}
+ public method insert {args}
+ public method delete {args}
+ public method hide {args}
+ public method show {args}
+ public method default {args}
+ public method invoke {args}
+ public method buttonconfigure {args}
+ public method buttoncget {index option}
+}
+
+#
+# Provide a lowercased access method for the Dialogshell class.
+#
+proc ::iwidgets::dialogshell {pathName args} {
+ uplevel ::iwidgets::Dialogshell $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Dialogshell.master "." widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Dialogshell::constructor {args} {
+ itk_option remove iwidgets::Shell::padx iwidgets::Shell::pady
+
+ #
+ # Create the user child site, separator, and button box,
+ #
+ itk_component add -protected dschildsite {
+ frame $itk_interior.dschildsite
+ }
+
+ itk_component add separator {
+ frame $itk_interior.separator -relief sunken
+ }
+
+ itk_component add bbox {
+ iwidgets::Buttonbox $itk_interior.bbox
+ } {
+ usual
+
+ rename -padx -buttonboxpadx buttonBoxPadX Pad
+ rename -pady -buttonboxpady buttonBoxPadY Pad
+ }
+
+ #
+ # Set the itk_interior variable to be the childsite for derived
+ # classes.
+ #
+ set itk_interior $itk_component(dschildsite)
+
+ #
+ # Set up the default button so that if <Return> is pressed in
+ # any widget, it will invoke the default button.
+ #
+ bind $itk_component(hull) <Return> [code $this invoke]
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -thickness
+#
+# Specifies the thickness of the separator. It sets the width and
+# height of the separator to the thickness value and the borderwidth
+# to half the thickness.
+# ------------------------------------------------------------------
+configbody iwidgets::Dialogshell::thickness {
+ $itk_component(separator) config -height $itk_option(-thickness)
+ $itk_component(separator) config -width $itk_option(-thickness)
+ $itk_component(separator) config \
+ -borderwidth [expr $itk_option(-thickness) / 2]
+}
+
+# ------------------------------------------------------------------
+# OPTION: -buttonboxpos
+#
+# Specifies the position of the button box relative to the child site.
+# The separator appears between the child site and button box.
+# ------------------------------------------------------------------
+configbody iwidgets::Dialogshell::buttonboxpos {
+ set parent [winfo parent $itk_component(bbox)]
+
+ switch $itk_option(-buttonboxpos) {
+ n {
+ $itk_component(bbox) configure -orient horizontal
+
+ grid $itk_component(bbox) -row 0 -column 0 -sticky ew
+ grid $itk_component(separator) -row 1 -column 0 -sticky ew
+ grid $itk_component(dschildsite) -row 2 -column 0 -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 0
+ grid rowconfigure $parent 1 -weight 0
+ grid rowconfigure $parent 2 -weight 1
+ grid columnconfigure $parent 0 -weight 1
+ grid columnconfigure $parent 1 -weight 0
+ grid columnconfigure $parent 2 -weight 0
+ }
+ s {
+ $itk_component(bbox) configure -orient horizontal
+
+ grid $itk_component(dschildsite) -row 0 -column 0 -sticky nsew
+ grid $itk_component(separator) -row 1 -column 0 -sticky ew
+ grid $itk_component(bbox) -row 2 -column 0 -sticky ew
+
+ grid rowconfigure $parent 0 -weight 1
+ grid rowconfigure $parent 1 -weight 0
+ grid rowconfigure $parent 2 -weight 0
+ grid columnconfigure $parent 0 -weight 1
+ grid columnconfigure $parent 1 -weight 0
+ grid columnconfigure $parent 2 -weight 0
+ }
+ w {
+ $itk_component(bbox) configure -orient vertical
+
+ grid $itk_component(bbox) -row 0 -column 0 -sticky ns
+ grid $itk_component(separator) -row 0 -column 1 -sticky ns
+ grid $itk_component(dschildsite) -row 0 -column 2 -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 1
+ grid rowconfigure $parent 1 -weight 0
+ grid rowconfigure $parent 2 -weight 0
+ grid columnconfigure $parent 0 -weight 0
+ grid columnconfigure $parent 1 -weight 0
+ grid columnconfigure $parent 2 -weight 1
+ }
+ e {
+ $itk_component(bbox) configure -orient vertical
+
+ grid $itk_component(dschildsite) -row 0 -column 0 -sticky nsew
+ grid $itk_component(separator) -row 0 -column 1 -sticky ns
+ grid $itk_component(bbox) -row 0 -column 2 -sticky ns
+
+ grid rowconfigure $parent 0 -weight 1
+ grid rowconfigure $parent 1 -weight 0
+ grid rowconfigure $parent 2 -weight 0
+ grid columnconfigure $parent 0 -weight 1
+ grid columnconfigure $parent 1 -weight 0
+ grid columnconfigure $parent 2 -weight 0
+ }
+ default {
+ error "bad buttonboxpos option\
+ \"$itk_option(-buttonboxpos)\": should be n,\
+ s, e, or w"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -separator
+#
+# Boolean option indicating wheather to display the separator.
+# ------------------------------------------------------------------
+configbody iwidgets::Dialogshell::separator {
+ if {$itk_option(-separator)} {
+ $itk_component(separator) configure -relief sunken
+ } else {
+ $itk_component(separator) configure -relief flat
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -padx
+#
+# Specifies a padding distance for the childsite in the X-direction.
+# ------------------------------------------------------------------
+configbody iwidgets::Dialogshell::padx {
+ grid configure $itk_component(dschildsite) -padx $itk_option(-padx)
+}
+
+# ------------------------------------------------------------------
+# OPTION: -pady
+#
+# Specifies a padding distance for the childsite in the Y-direction.
+# ------------------------------------------------------------------
+configbody iwidgets::Dialogshell::pady {
+ grid configure $itk_component(dschildsite) -pady $itk_option(-pady)
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: childsite
+#
+# Return the pathname of the user accessible area.
+# ------------------------------------------------------------------
+body iwidgets::Dialogshell::childsite {} {
+ return $itk_component(dschildsite)
+}
+
+# ------------------------------------------------------------------
+# METHOD: index index
+#
+# Thin wrapper of Buttonbox's index method.
+# ------------------------------------------------------------------
+body iwidgets::Dialogshell::index {args} {
+ uplevel $itk_component(bbox) index $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: add tag ?option value ...?
+#
+# Thin wrapper of Buttonbox's add method.
+# ------------------------------------------------------------------
+body iwidgets::Dialogshell::add {args} {
+ uplevel $itk_component(bbox) add $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: insert index tag ?option value ...?
+#
+# Thin wrapper of Buttonbox's insert method.
+# ------------------------------------------------------------------
+body iwidgets::Dialogshell::insert {args} {
+ uplevel $itk_component(bbox) insert $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: delete tag
+#
+# Thin wrapper of Buttonbox's delete method.
+# ------------------------------------------------------------------
+body iwidgets::Dialogshell::delete {args} {
+ uplevel $itk_component(bbox) delete $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: hide index
+#
+# Thin wrapper of Buttonbox's hide method.
+# ------------------------------------------------------------------
+body iwidgets::Dialogshell::hide {args} {
+ uplevel $itk_component(bbox) hide $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: show index
+#
+# Thin wrapper of Buttonbox's show method.
+# ------------------------------------------------------------------
+body iwidgets::Dialogshell::show {args} {
+ uplevel $itk_component(bbox) show $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: default index
+#
+# Thin wrapper of Buttonbox's default method.
+# ------------------------------------------------------------------
+body iwidgets::Dialogshell::default {args} {
+ uplevel $itk_component(bbox) default $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: invoke ?index?
+#
+# Thin wrapper of Buttonbox's invoke method.
+# ------------------------------------------------------------------
+body iwidgets::Dialogshell::invoke {args} {
+ uplevel $itk_component(bbox) invoke $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: buttonconfigure index ?option? ?value option value ...?
+#
+# Thin wrapper of Buttonbox's buttonconfigure method.
+# ------------------------------------------------------------------
+body iwidgets::Dialogshell::buttonconfigure {args} {
+ uplevel $itk_component(bbox) buttonconfigure $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: buttoncget index option
+#
+# Thin wrapper of Buttonbox's buttoncget method.
+# ------------------------------------------------------------------
+body iwidgets::Dialogshell::buttoncget {index option} {
+ uplevel $itk_component(bbox) buttoncget [list $index] \
+ [list $option]
+}
diff --git a/itcl/iwidgets3.0.0/generic/disjointlistbox.itk b/itcl/iwidgets3.0.0/generic/disjointlistbox.itk
new file mode 100755
index 00000000000..5f40399fa8e
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/disjointlistbox.itk
@@ -0,0 +1,489 @@
+#
+# ::iwidgets::Disjointlistbox
+# ----------------------------------------------------------------------
+# Implements a widget which maintains a disjoint relationship between
+# the items displayed by two listboxes. The disjointlistbox is composed
+# of 2 Scrolledlistboxes, 2 Pushbuttons, and 2 labels.
+#
+# The disjoint behavior of this widget exists between the two Listboxes,
+# That is, a given instance of a ::iwidgets::Disjointlistbox will never
+# exist which has Listbox widgets with items in common.
+#
+# Users may transfer items between the two Listbox widgets using the
+# the two Pushbuttons.
+#
+# The options include the ability to configure the "items" displayed by
+# either of the two Listboxes and to control the placement of the insertion
+# and removal buttons.
+#
+# The following depicts the allowable "-buttonplacement" option values
+# and their associated layout:
+#
+# "-buttonplacement" => center
+#
+# --------------------------
+# |listbox| |listbox|
+# | |________| |
+# | (LHS) | button | (RHS) |
+# | |========| |
+# | | button | |
+# |_______|--------|_______|
+# | count | | count |
+# --------------------------
+#
+# "-buttonplacement" => bottom
+#
+# ---------------------
+# | listbox | listbox |
+# | (LHS) | (RHS) |
+# |_________|_________|
+# | button | button |
+# |---------|---------|
+# | count | count |
+# ---------------------
+#
+# ----------------------------------------------------------------------
+# AUTHOR: John A. Tucker EMAIL: jatucker@spd.dsccc.com
+#
+# ======================================================================
+
+#
+# Default resources.
+#
+
+set tk_strictMotif 1
+
+option add *Disjointlistbox.lhsLabelText Available widgetDefault
+option add *Disjointlistbox.rhsLabelText Current widgetDefault
+option add *Disjointlistbox.lhsButtonLabel {Insert >>} widgetDefault
+option add *Disjointlistbox.rhsButtonLabel {<< Remove} widgetDefault
+option add *Disjointlistbox.vscrollMode static widgetDefault
+option add *Disjointlistbox.hscrollMode static widgetDefault
+option add *Disjointlistbox.selectMode multiple widgetDefault
+option add *Disjointlistbox.labelPos nw widgetDefault
+option add *Disjointlistbox.buttonPlacement bottom widgetDefault
+
+
+#
+# Usual options.
+#
+itk::usual Disjointlistbox {
+ keep -background -textbackground -cursor \
+ -foreground -textfont -labelfont
+}
+
+
+# ----------------------------------------------------------------------
+# ::iwidgets::Disjointlistbox
+# ----------------------------------------------------------------------
+class ::iwidgets::Disjointlistbox {
+
+ inherit itk::Widget
+
+ #
+ # options
+ #
+ itk_option define -buttonplacement buttonPlacement ButtonPlacement bottom
+ itk_option define -lhsbuttonlabel lhsButtonLabel LabelText {Insert >>}
+ itk_option define -rhsbuttonlabel rhsButtonLabel LabelText {<< Remove}
+
+ constructor {args} {}
+
+ #
+ # PUBLIC
+ #
+ public {
+ method clear {}
+ method getlhs {{first 0} {last end}}
+ method getrhs {{first 0} {last end}}
+ method lhs {args}
+ method insertlhs {items}
+ method insertrhs {items}
+ method setlhs {items}
+ method setrhs {items}
+ method rhs {args}
+ }
+
+ #
+ # PROTECTED
+ #
+ protected {
+ method insert {theListbox items}
+ method listboxClick {clickSide otherSide}
+ method listboxDblClick {clickSide otherSide}
+ method remove {theListbox items}
+ method showCount {}
+ method transfer {}
+
+ variable sourceListbox {}
+ variable destinationListbox {}
+ }
+}
+
+#
+# Provide a lowercased access method for the ::iwidgets::Disjointlistbox class.
+#
+proc ::iwidgets::disjointlistbox {pathName args} {
+ uplevel ::iwidgets::Disjointlistbox $pathName $args
+}
+
+# ------------------------------------------------------------------
+#
+# Method: Constructor
+#
+# Purpose:
+#
+body ::iwidgets::Disjointlistbox::constructor {args} {
+ #
+ # Create the left-most Listbox
+ #
+ itk_component add lhs {
+ iwidgets::Scrolledlistbox $itk_interior.lhs \
+ -selectioncommand [code $this listboxClick lhs rhs] \
+ -dblclickcommand [code $this listboxDblClick lhs rhs]
+ } {
+ usual
+ keep -selectmode -vscrollmode -hscrollmode
+ rename -labeltext -lhslabeltext lhsLabelText LabelText
+ }
+
+ #
+ # Create the right-most Listbox
+ #
+ itk_component add rhs {
+ iwidgets::Scrolledlistbox $itk_interior.rhs \
+ -selectioncommand [code $this listboxClick rhs lhs] \
+ -dblclickcommand [code $this listboxDblClick rhs lhs]
+ } {
+ usual
+ keep -selectmode -vscrollmode -hscrollmode
+ rename -labeltext -rhslabeltext rhsLabelText LabelText
+ }
+
+ #
+ # Create the left-most item count Label
+ #
+ itk_component add lhsCount {
+ label $itk_interior.lhscount
+ } {
+ usual
+ rename -font -labelfont labelFont Font
+ }
+
+ #
+ # Create the right-most item count Label
+ #
+ itk_component add rhsCount {
+ label $itk_interior.rhscount
+ } {
+ usual
+ rename -font -labelfont labelFont Font
+ }
+
+ set sourceListbox $itk_component(lhs)
+ set destinationListbox $itk_component(rhs)
+
+ #
+ # Bind the "showCount" method to the Map event of one of the labels
+ # to keep the diplayed item count current.
+ #
+ bind $itk_component(lhsCount) <Map> [code $this showCount]
+
+ grid $itk_component(lhs) -row 0 -column 0 -sticky nsew
+ grid $itk_component(rhs) -row 0 -column 2 -sticky nsew
+
+ grid rowconfigure $itk_interior 0 -weight 1
+ grid columnconfigure $itk_interior 0 -weight 1
+ grid columnconfigure $itk_interior 2 -weight 1
+
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# Method: listboxClick
+#
+# Purpose: Evaluate a single click make in the specified Listbox.
+#
+body ::iwidgets::Disjointlistbox::listboxClick {clickSide otherSide} {
+ set button "button"
+ $itk_component($clickSide$button) configure -state active
+ $itk_component($otherSide$button) configure -state disabled
+ set sourceListbox $itk_component($clickSide)
+ set destinationListbox $itk_component($otherSide)
+}
+
+# ------------------------------------------------------------------
+# Method: listboxDblClick
+#
+# Purpose: Evaluate a double click in the specified Listbox.
+#
+body ::iwidgets::Disjointlistbox::listboxDblClick {clickSide otherSide} {
+ listboxClick $clickSide $otherSide
+ transfer
+}
+
+# ------------------------------------------------------------------
+# Method: transfer
+#
+# Purpose: Transfer source Listbox items to destination Listbox
+#
+body ::iwidgets::Disjointlistbox::transfer {} {
+
+ if {[$sourceListbox selecteditemcount] == 0} {
+ return
+ }
+ set selectedindices [lsort -integer -decreasing [$sourceListbox curselection]]
+ set selecteditems [$sourceListbox getcurselection]
+
+ foreach index $selectedindices {
+ $sourceListbox delete $index
+ }
+
+ foreach item $selecteditems {
+ $destinationListbox insert end $item
+ }
+ $destinationListbox sort increasing
+
+ showCount
+}
+
+# ------------------------------------------------------------------
+# Method: getlhs
+#
+# Purpose: Retrieve the items of the left Listbox widget
+#
+body ::iwidgets::Disjointlistbox::getlhs {{first 0} {last end}} {
+ return [lhs get $first $last]
+}
+
+# ------------------------------------------------------------------
+# Method: getrhs
+#
+# Purpose: Retrieve the items of the right Listbox widget
+#
+body ::iwidgets::Disjointlistbox::getrhs {{first 0} {last end}} {
+ return [rhs get $first $last]
+}
+
+# ------------------------------------------------------------------
+# Method: insertrhs
+#
+# Purpose: Insert items into the right Listbox widget
+#
+body ::iwidgets::Disjointlistbox::insertrhs {items} {
+ remove $itk_component(lhs) $items
+ insert $itk_component(rhs) $items
+}
+
+# ------------------------------------------------------------------
+# Method: insertlhs
+#
+# Purpose: Insert items into the left Listbox widget
+#
+body ::iwidgets::Disjointlistbox::insertlhs {items} {
+ remove $itk_component(rhs) $items
+ insert $itk_component(lhs) $items
+}
+
+# ------------------------------------------------------------------
+# Method: clear
+#
+# Purpose: Remove the items from the Listbox widgets and set the item count
+# Labels text to 0
+#
+body ::iwidgets::Disjointlistbox::clear {} {
+ lhs clear
+ rhs clear
+ showCount
+}
+
+# ------------------------------------------------------------------
+# Method: insert
+#
+# Purpose: Insert the input items into the input Listbox widget while
+# maintaining the disjoint property between them.
+#
+body ::iwidgets::Disjointlistbox::insert {theListbox items} {
+
+ set curritems [$theListbox get 0 end]
+
+ foreach item $items {
+ #
+ # if the item is not already present in the Listbox then insert it
+ #
+ if {[lsearch -exact $curritems $item] == -1} {
+ $theListbox insert end $item
+ }
+ }
+ $theListbox sort increasing
+ showCount
+}
+
+# ------------------------------------------------------------------
+# Method: remove
+#
+# Purpose: Remove the input items from the input Listbox widget while
+# maintaining the disjoint property between them.
+#
+body ::iwidgets::Disjointlistbox::remove {theListbox items} {
+
+ set indexes {}
+ set curritems [$theListbox get 0 end]
+
+ foreach item $items {
+ #
+ # if the item is in the listbox then add its index to the index list
+ #
+ if {[set index [lsearch -exact $curritems $item]] != -1} {
+ lappend indexes $index
+ }
+ }
+
+ foreach index [lsort -integer -decreasing $indexes] {
+ $theListbox delete $index
+ }
+ showCount
+}
+
+# ------------------------------------------------------------------
+# Method: showCount
+#
+# Purpose: Set the text of the item count Labels.
+#
+body ::iwidgets::Disjointlistbox::showCount {} {
+ $itk_component(lhsCount) config -text "item count: [lhs size]"
+ $itk_component(rhsCount) config -text "item count: [rhs size]"
+}
+
+# ------------------------------------------------------------------
+# METHOD: setlhs
+#
+# Set the items of the left-most Listbox with the input list
+# option. Remove all (if any) items from the right-most Listbox
+# which exist in the input list option to maintain the disjoint
+# property between the two
+#
+body ::iwidgets::Disjointlistbox::setlhs {items} {
+ lhs clear
+ insertlhs $items
+}
+
+# ------------------------------------------------------------------
+# METHOD: setrhs
+#
+# Set the items of the right-most Listbox with the input list
+# option. Remove all (if any) items from the left-most Listbox
+# which exist in the input list option to maintain the disjoint
+# property between the two
+#
+body ::iwidgets::Disjointlistbox::setrhs {items} {
+ rhs clear
+ insertrhs $items
+}
+
+# ------------------------------------------------------------------
+# Method: lhs
+#
+# Purpose: Evaluates the specified arguments against the lhs Listbox
+#
+body ::iwidgets::Disjointlistbox::lhs {args} {
+ return [eval $itk_component(lhs) $args]
+}
+
+# ------------------------------------------------------------------
+# Method: rhs
+#
+# Purpose: Evaluates the specified arguments against the rhs Listbox
+#
+body ::iwidgets::Disjointlistbox::rhs {args} {
+ return [eval $itk_component(rhs) $args]
+}
+
+# ------------------------------------------------------------------
+# OPTION: buttonplacement
+#
+# Configure the placement of the buttons to be either between or below
+# the two list boxes.
+#
+configbody ::iwidgets::Disjointlistbox::buttonplacement {
+ if {$itk_option(-buttonplacement) != ""} {
+
+ if { [lsearch [component] lhsbutton] != -1 } {
+ eval destroy $itk_component(rhsbutton) $itk_component(lhsbutton)
+ }
+
+ if { [lsearch [component] bbox] != -1 } {
+ destroy $itk_component(bbox)
+ }
+
+ set where $itk_option(-buttonplacement)
+
+ switch $where {
+
+ center {
+ #
+ # Create the button box frame
+ #
+ itk_component add bbox {
+ frame $itk_interior.bbox
+ }
+
+ itk_component add lhsbutton {
+ button $itk_component(bbox).lhsbutton -command [code $this transfer]
+ } {
+ usual
+ rename -text -lhsbuttonlabel lhsButtonLabel LabelText
+ rename -font -labelfont labelFont Font
+ }
+
+ itk_component add rhsbutton {
+ button $itk_component(bbox).rhsbutton -command [code $this transfer]
+ } {
+ usual
+ rename -text -rhsbuttonlabel rhsButtonLabel LabelText
+ rename -font -labelfont labelFont Font
+ }
+
+ grid configure $itk_component(lhsCount) -row 1 -column 0 -sticky ew
+ grid configure $itk_component(rhsCount) -row 1 -column 2 -sticky ew
+
+ grid configure $itk_component(bbox) \
+ -in $itk_interior -row 0 -column 1 -columnspan 1 -sticky nsew
+
+ grid configure $itk_component(rhsbutton) \
+ -in $itk_component(bbox) -row 0 -column 0 -sticky ew
+ grid configure $itk_component(lhsbutton) \
+ -in $itk_component(bbox) -row 1 -column 0 -sticky ew
+ }
+
+ bottom {
+
+ itk_component add lhsbutton {
+ button $itk_interior.lhsbutton -command [code $this transfer]
+ } {
+ usual
+ rename -text -lhsbuttonlabel lhsButtonLabel LabelText
+ rename -font -labelfont labelFont Font
+ }
+
+ itk_component add rhsbutton {
+ button $itk_interior.rhsbutton -command [code $this transfer]
+ } {
+ usual
+ rename -text -rhsbuttonlabel rhsButtonLabel LabelText
+ rename -font -labelfont labelFont Font
+ }
+
+ grid $itk_component(lhsCount) -row 2 -column 0 -sticky ew
+ grid $itk_component(rhsCount) -row 2 -column 2 -sticky ew
+ grid $itk_component(lhsbutton) -row 1 -column 0 -sticky ew
+ grid $itk_component(rhsbutton) -row 1 -column 2 -sticky ew
+ }
+
+ default {
+ error "bad buttonplacement option\"$where\": should be center or bottom"
+ }
+ }
+ }
+}
+
diff --git a/itcl/iwidgets3.0.0/generic/entryfield.itk b/itcl/iwidgets3.0.0/generic/entryfield.itk
new file mode 100644
index 00000000000..065e6a56e16
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/entryfield.itk
@@ -0,0 +1,523 @@
+#
+# Entryfield
+# ----------------------------------------------------------------------
+# Implements an enhanced text entry widget.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Sue Yockey E-mail: yockey@acm.org
+# Mark L. Ulferts E-mail: mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Entryfield {
+ keep -background -borderwidth -cursor -foreground -highlightcolor \
+ -highlightthickness -insertbackground -insertborderwidth \
+ -insertofftime -insertontime -insertwidth -labelfont \
+ -selectbackground -selectborderwidth -selectforeground \
+ -textbackground -textfont
+}
+
+# ------------------------------------------------------------------
+# ENTRYFIELD
+# ------------------------------------------------------------------
+class iwidgets::Entryfield {
+ inherit iwidgets::Labeledwidget
+
+ constructor {args} {}
+
+ itk_option define -childsitepos childSitePos Position e
+ itk_option define -command command Command {}
+ itk_option define -fixed fixed Fixed 0
+ itk_option define -focuscommand focusCommand Command {}
+ itk_option define -invalid invalid Command {bell}
+ itk_option define -validate validate Command {}
+
+ public {
+ method childsite {}
+ method get {}
+ method delete {args}
+ method icursor {args}
+ method index {args}
+ method insert {args}
+ method scan {args}
+ method selection {args}
+ method xview {args}
+ method clear {}
+ }
+
+ proc numeric {char} {}
+ proc integer {string} {}
+ proc alphabetic {char} {}
+ proc alphanumeric {char} {}
+ proc hexidecimal {string} {}
+ proc real {string} {}
+
+ protected {
+ method _focusCommand {}
+ method _keyPress {char sym state}
+ }
+
+ private method _peek {char}
+}
+
+#
+# Provide a lowercased access method for the Entryfield class.
+#
+proc ::iwidgets::entryfield {pathName args} {
+ uplevel ::iwidgets::Entryfield $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::constructor {args} {
+ component hull configure -borderwidth 0
+
+ itk_component add entry {
+ entry $itk_interior.entry
+ } {
+ keep -borderwidth -cursor -exportselection \
+ -foreground -highlightcolor \
+ -highlightthickness -insertbackground -insertborderwidth \
+ -insertofftime -insertontime -insertwidth -justify \
+ -relief -selectbackground -selectborderwidth \
+ -selectforeground -show -state -textvariable -width
+
+ rename -font -textfont textFont Font
+ rename -highlightbackground -background background Background
+ rename -background -textbackground textBackground Background
+ }
+
+ #
+ # Create the child site widget.
+ #
+ itk_component add -protected efchildsite {
+ frame $itk_interior.efchildsite
+ }
+ set itk_interior $itk_component(efchildsite)
+
+ #
+ # Entryfield instance bindings.
+ #
+ bind $itk_component(entry) <KeyPress> [code $this _keyPress %A %K %s]
+ bind $itk_component(entry) <FocusIn> [code $this _focusCommand]
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -command
+#
+# Command associated upon detection of Return key press event
+# ------------------------------------------------------------------
+configbody iwidgets::Entryfield::command {}
+
+# ------------------------------------------------------------------
+# OPTION: -focuscommand
+#
+# Command associated upon detection of focus.
+# ------------------------------------------------------------------
+configbody iwidgets::Entryfield::focuscommand {}
+
+# ------------------------------------------------------------------
+# OPTION: -validate
+#
+# Specify a command to executed for the validation of Entryfields.
+# ------------------------------------------------------------------
+configbody iwidgets::Entryfield::validate {
+ switch $itk_option(-validate) {
+ {} {
+ set itk_option(-validate) {}
+ }
+ numeric {
+ set itk_option(-validate) "::iwidgets::Entryfield::numeric %c"
+ }
+ integer {
+ set itk_option(-validate) "::iwidgets::Entryfield::integer %P"
+ }
+ hexidecimal {
+ set itk_option(-validate) "::iwidgets::Entryfield::hexidecimal %P"
+ }
+ real {
+ set itk_option(-validate) "::iwidgets::Entryfield::real %P"
+ }
+ alphabetic {
+ set itk_option(-validate) "::iwidgets::Entryfield::alphabetic %c"
+ }
+ alphanumeric {
+ set itk_option(-validate) "::iwidgets::Entryfield::alphanumeric %c"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -invalid
+#
+# Specify a command to executed should the current Entryfield contents
+# be proven invalid.
+# ------------------------------------------------------------------
+configbody iwidgets::Entryfield::invalid {}
+
+# ------------------------------------------------------------------
+# OPTION: -fixed
+#
+# Restrict entry to 0 (unlimited) chars. The value is the maximum
+# number of chars the user may type into the field, regardles of
+# field width, i.e. the field width may be 20, but the user will
+# only be able to type -fixed number of characters into it (or
+# unlimited if -fixed = 0).
+# ------------------------------------------------------------------
+configbody iwidgets::Entryfield::fixed {
+ if {[regexp {[^0-9]} $itk_option(-fixed)] || \
+ ($itk_option(-fixed) < 0)} {
+ error "bad fixed option \"$itk_option(-fixed)\",\
+ should be positive integer"
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -childsitepos
+#
+# Specifies the position of the child site in the widget.
+# ------------------------------------------------------------------
+configbody iwidgets::Entryfield::childsitepos {
+ set parent [winfo parent $itk_component(entry)]
+
+ switch $itk_option(-childsitepos) {
+ n {
+ grid $itk_component(efchildsite) -row 0 -column 0 -sticky ew
+ grid $itk_component(entry) -row 1 -column 0 -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 0
+ grid rowconfigure $parent 1 -weight 1
+ grid columnconfigure $parent 0 -weight 1
+ grid columnconfigure $parent 1 -weight 0
+ }
+
+ e {
+ grid $itk_component(efchildsite) -row 0 -column 1 -sticky ns
+ grid $itk_component(entry) -row 0 -column 0 -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 1
+ grid rowconfigure $parent 1 -weight 0
+ grid columnconfigure $parent 0 -weight 1
+ grid columnconfigure $parent 1 -weight 0
+ }
+
+ s {
+ grid $itk_component(efchildsite) -row 1 -column 0 -sticky ew
+ grid $itk_component(entry) -row 0 -column 0 -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 1
+ grid rowconfigure $parent 1 -weight 0
+ grid columnconfigure $parent 0 -weight 1
+ grid columnconfigure $parent 1 -weight 0
+ }
+
+ w {
+ grid $itk_component(efchildsite) -row 0 -column 0 -sticky ns
+ grid $itk_component(entry) -row 0 -column 1 -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 1
+ grid rowconfigure $parent 1 -weight 0
+ grid columnconfigure $parent 0 -weight 0
+ grid columnconfigure $parent 1 -weight 1
+ }
+
+ default {
+ error "bad childsite option\
+ \"$itk_option(-childsitepos)\":\
+ should be n, e, s, or w"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: childsite
+#
+# Returns the path name of the child site widget.
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::childsite {} {
+ return $itk_component(efchildsite)
+}
+
+# ------------------------------------------------------------------
+# METHOD: get
+#
+# Thin wrap of the standard entry widget get method.
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::get {} {
+ return [$itk_component(entry) get]
+}
+
+# ------------------------------------------------------------------
+# METHOD: delete
+#
+# Thin wrap of the standard entry widget delete method.
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::delete {args} {
+ return [eval $itk_component(entry) delete $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: icursor
+#
+# Thin wrap of the standard entry widget icursor method.
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::icursor {args} {
+ return [eval $itk_component(entry) icursor $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: index
+#
+# Thin wrap of the standard entry widget index method.
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::index {args} {
+ return [eval $itk_component(entry) index $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: insert
+#
+# Thin wrap of the standard entry widget index method.
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::insert {args} {
+ return [eval $itk_component(entry) insert $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: scan
+#
+# Thin wrap of the standard entry widget scan method.
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::scan {args} {
+ return [eval $itk_component(entry) scan $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: selection
+#
+# Thin wrap of the standard entry widget selection method.
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::selection {args} {
+ return [eval $itk_component(entry) selection $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: xview
+#
+# Thin wrap of the standard entry widget xview method.
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::xview {args} {
+ return [eval $itk_component(entry) xview $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: clear
+#
+# Delete the current entry contents.
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::clear {} {
+ $itk_component(entry) delete 0 end
+ icursor 0
+}
+
+# ------------------------------------------------------------------
+# PROCEDURE: numeric char
+#
+# The numeric procedure validates character input for a given
+# Entryfield to be numeric and returns the result.
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::numeric {char} {
+ return [regexp {[0-9]} $char]
+}
+
+# ------------------------------------------------------------------
+# PROCEDURE: integer string
+#
+# The integer procedure validates character input for a given
+# Entryfield to be integer and returns the result.
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::integer {string} {
+ return [regexp {^[-+]?[0-9]*$} $string]
+}
+
+# ------------------------------------------------------------------
+# PROCEDURE: alphabetic char
+#
+# The alphabetic procedure validates character input for a given
+# Entryfield to be alphabetic and returns the result.
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::alphabetic {char} {
+ return [regexp -nocase {[a-z]} $char]
+}
+
+# ------------------------------------------------------------------
+# PROCEDURE: alphanumeric char
+#
+# The alphanumeric procedure validates character input for a given
+# Entryfield to be alphanumeric and returns the result.
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::alphanumeric {char} {
+ return [regexp -nocase {[0-9a-z]} $char]
+}
+
+# ------------------------------------------------------------------
+# PROCEDURE: hexadecimal string
+#
+# The hexidecimal procedure validates character input for a given
+# Entryfield to be hexidecimal and returns the result.
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::hexidecimal {string} {
+ return [regexp {^(0x)?[0-9a-fA-F]*$} $string]
+}
+
+# ------------------------------------------------------------------
+# PROCEDURE: real string
+#
+# The real procedure validates character input for a given Entryfield
+# to be real and returns the result.
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::real {string} {
+ return [regexp {^[-+]?[0-9]*\.?[0-9]*([0-9]\.?[eE][-+]?[0-9]*)?$} $string]
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _peek char
+#
+# The peek procedure returns the value of the Entryfield with the
+# char inserted at the insert position.
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::_peek {char} {
+ set str [get]
+
+ set insertPos [index insert]
+ set firstPart [string range $str 0 [expr $insertPos - 1]]
+ set lastPart [string range $str $insertPos end]
+
+ regsub -all {\\} "$char" {\\\\} char
+ append rtnVal $firstPart $char $lastPart
+ return $rtnVal
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _focusCommand
+#
+# Method bound to focus event which evaluates the current command
+# specified in the focuscommand option
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::_focusCommand {} {
+ uplevel #0 $itk_option(-focuscommand)
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _keyPress
+#
+# Monitor the key press event checking for return keys, fixed width
+# specification, and optional validation procedures.
+# ------------------------------------------------------------------
+body iwidgets::Entryfield::_keyPress {char sym state} {
+ #
+ # A Return key invokes the optionally specified command option.
+ #
+ if {$sym == "Return"} {
+ uplevel #0 $itk_option(-command)
+ return -code break 1
+ }
+
+ #
+ # Tabs, BackSpace, and Delete are passed on for other bindings.
+ #
+ if {($sym == "Tab") || ($sym == "BackSpace") || ($sym == "Delete")} {
+ return -code continue 1
+ }
+
+ #
+ # Character is not printable or the state is greater than one which
+ # means a modifier was used such as a control, meta key, or control
+ # or meta key with numlock down.
+ #
+ if {($char == "") || \
+ ($state == 4) || ($state == 8) || \
+ ($state == 36) || ($state == 40)} {
+ return -code continue 1
+ }
+
+ #
+ # If the fixed length option is not zero, then verify that the
+ # current length plus one will not exceed the limit. If so then
+ # invoke the invalid command procedure.
+ #
+ if {$itk_option(-fixed) != 0} {
+ if {[string length [get]] >= $itk_option(-fixed)} {
+ uplevel #0 $itk_option(-invalid)
+ return -code break 0
+ }
+ }
+
+ #
+ # The validate option may contain a keyword (numeric, alphabetic),
+ # the name of a procedure, or nothing. The numeric and alphabetic
+ # keywords engage typical base level checks. If a command procedure
+ # is specified, then invoke it with the object and character passed
+ # as arguments. If the validate procedure returns false, then the
+ # invalid procedure is called.
+ #
+ if {$itk_option(-validate) != {}} {
+ set cmd $itk_option(-validate)
+
+ regsub -all "%W" "$cmd" $itk_component(hull) cmd
+ regsub -all "%P" "$cmd" [list [_peek $char]] cmd
+ regsub -all "%S" "$cmd" [list [get]] cmd
+ regsub -all "%c" "$cmd" [list $char] cmd
+ regsub -all {\\} "$cmd" {\\\\} cmd
+
+ set valid [uplevel #0 $cmd]
+
+ if {($valid == "") || ([regexp 0|false|off|no $valid])} {
+ uplevel #0 $itk_option(-invalid)
+ return -code break 0
+ }
+ }
+
+ return -code continue 1
+}
+
diff --git a/itcl/iwidgets3.0.0/generic/extfileselectionbox.itk b/itcl/iwidgets3.0.0/generic/extfileselectionbox.itk
new file mode 100644
index 00000000000..34c9ddbaec7
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/extfileselectionbox.itk
@@ -0,0 +1,1127 @@
+#
+# Extfileselectionbox
+# ----------------------------------------------------------------------
+# Implements a file selection box that is a slightly extended version
+# of the OSF/Motif standard XmExtfileselectionbox composite widget.
+# The Extfileselectionbox differs from the Motif standard in that the
+# filter and selection fields are comboboxes and the files and directory
+# lists are in a paned window.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@spd.dsccc.com
+# Anthony L. Parent tony.parent@symbios.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1997 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Extfileselectionbox {
+ keep -activebackground -activerelief -background -borderwidth -cursor \
+ -elementborderwidth -foreground -highlightcolor -highlightthickness \
+ -insertbackground -insertborderwidth -insertofftime -insertontime \
+ -insertwidth -jump -labelfont -selectbackground -selectborderwidth \
+ -textbackground -textfont -troughcolor
+}
+
+# ------------------------------------------------------------------
+# EXTFILESELECTIONBOX
+# ------------------------------------------------------------------
+class iwidgets::Extfileselectionbox {
+ inherit itk::Widget
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -childsitepos childSitePos Position s
+ itk_option define -fileson filesOn FilesOn true
+ itk_option define -dirson dirsOn DirsOn true
+ itk_option define -selectionon selectionOn SelectionOn true
+ itk_option define -filteron filterOn FilterOn true
+ itk_option define -mask mask Mask {*}
+ itk_option define -directory directory Directory {}
+ itk_option define -nomatchstring noMatchString NoMatchString {}
+ itk_option define -dirsearchcommand dirSearchCommand Command {}
+ itk_option define -filesearchcommand fileSearchCommand Command {}
+ itk_option define -selectioncommand selectionCommand Command {}
+ itk_option define -filtercommand filterCommand Command {}
+ itk_option define -selectdircommand selectDirCommand Command {}
+ itk_option define -selectfilecommand selectFileCommand Command {}
+ itk_option define -invalid invalid Command {bell}
+ itk_option define -filetype fileType FileType {regular}
+ itk_option define -width width Width 350
+ itk_option define -height height Height 300
+
+ public {
+ method childsite {}
+ method get {}
+ method filter {}
+ }
+
+ public {
+ method _selectDir {}
+ method _dblSelectDir {}
+ method _selectFile {}
+ method _selectSelection {}
+ method _selectFilter {}
+ }
+
+ protected {
+ method _packComponents {{when later}}
+ method _updateLists {{when later}}
+ }
+
+ private {
+ method _setFilter {}
+ method _setSelection {}
+ method _setDirList {}
+ method _setFileList {}
+
+ method _nPos {}
+ method _sPos {}
+ method _ePos {}
+ method _wPos {}
+ method _topPos {}
+ method _bottomPos {}
+
+ variable _packToken "" ;# non-null => _packComponents pending
+ variable _updateToken "" ;# non-null => _updateLists pending
+ variable _pwd "." ;# present working dir
+ variable _interior ;# original interior setting
+ }
+}
+
+#
+# Provide a lowercased access method for the Extfileselectionbox class.
+#
+proc ::iwidgets::extfileselectionbox {pathName args} {
+ uplevel ::iwidgets::Extfileselectionbox $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Extfileselectionbox.borderWidth 2 widgetDefault
+
+option add *Extfileselectionbox.filterLabel Filter widgetDefault
+option add *Extfileselectionbox.dirsLabel Directories widgetDefault
+option add *Extfileselectionbox.filesLabel Files widgetDefault
+option add *Extfileselectionbox.selectionLabel Selection widgetDefault
+
+option add *Extfileselectionbox.width 350 widgetDefault
+option add *Extfileselectionbox.height 300 widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::constructor {args} {
+ #
+ # Add back to the hull width and height options and make the
+ # borderwidth zero since we don't need it.
+ #
+ itk_option add hull.width hull.height
+ component hull configure -borderwidth 0
+
+ set _interior $itk_interior
+
+ #
+ # Create the filter entry.
+ #
+ itk_component add filter {
+ iwidgets::Combobox $itk_interior.filter -unique true \
+ -command [code $this _selectFilter] -exportselection 0 \
+ -labelpos nw -completion 0
+
+ } {
+ usual
+
+ rename -labeltext -filterlabel filterLabel Text
+ }
+
+ set cmd [$itk_component(filter) cget -command]
+ set cmd "$cmd;[code $this _selectFilter]"
+ $itk_component(filter) configure -command "$cmd" -selectioncommand "$cmd";
+
+ #
+ # Create a paned window for the directory and file lists.
+ #
+ itk_component add listpane {
+ iwidgets::Panedwindow $itk_interior.listpane -orient vertical
+ }
+
+ $itk_component(listpane) add dirs -margin 5
+ $itk_component(listpane) add files -margin 5
+
+ #
+ # Create the directory list.
+ #
+ itk_component add dirs {
+ iwidgets::Scrolledlistbox [$itk_component(listpane) childsite dirs].dirs \
+ -selectioncommand [code $this _selectDir] \
+ -selectmode single -exportselection 0 \
+ -visibleitems 1x1 -labelpos nw \
+ -hscrollmode static -vscrollmode static \
+ -dblclickcommand [code $this _dblSelectDir]
+ } {
+ usual
+
+ rename -labeltext -dirslabel dirsLabel Text
+ }
+ grid $itk_component(dirs) -sticky nsew
+ grid rowconfigure [$itk_component(listpane) childsite dirs] 0 -weight 1
+ grid columnconfigure [$itk_component(listpane) childsite dirs] 0 -weight 1
+
+ #
+ # Create the files list.
+ #
+ itk_component add files {
+ iwidgets::Scrolledlistbox [$itk_component(listpane) childsite files].files \
+ -selectioncommand [code $this _selectFile] \
+ -selectmode single -exportselection 0 \
+ -visibleitems 1x1 -labelpos nw \
+ -hscrollmode static -vscrollmode static
+ } {
+ usual
+
+ rename -labeltext -fileslabel filesLabel Text
+ }
+ grid $itk_component(files) -sticky nsew
+ grid rowconfigure [$itk_component(listpane) childsite files] 0 -weight 1
+ grid columnconfigure [$itk_component(listpane) childsite files] 0 -weight 1
+
+ #
+ # Create the selection entry.
+ #
+ itk_component add selection {
+ iwidgets::Combobox $itk_interior.selection -unique true \
+ -command [code $this _selectSelection] -exportselection 0 \
+ -labelpos nw -completion 0
+ } {
+ usual
+
+ rename -labeltext -selectionlabel selectionLabel Text
+ }
+
+ #
+ # Create the child site widget.
+ #
+ itk_component add -protected childsite {
+ frame $itk_interior.fsbchildsite
+ }
+
+ #
+ # Set the interior variable to the childsite for derived classes.
+ #
+ set itk_interior $itk_component(childsite)
+
+ #
+ # Explicitly handle configs that may have been ignored earlier.
+ #
+ eval itk_initialize $args
+
+ #
+ # When idle, pack the childsite and update the lists.
+ #
+ _packComponents
+ _updateLists
+}
+
+# ------------------------------------------------------------------
+# DESTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::destructor {} {
+ if {$_packToken != ""} {after cancel $_packToken}
+ if {$_updateToken != ""} {after cancel $_updateToken}
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -childsitepos
+#
+# Specifies the position of the child site in the selection box.
+# ------------------------------------------------------------------
+configbody iwidgets::Extfileselectionbox::childsitepos {
+ _packComponents
+}
+
+# ------------------------------------------------------------------
+# OPTION: -fileson
+#
+# Specifies whether or not to display the files list.
+# ------------------------------------------------------------------
+configbody iwidgets::Extfileselectionbox::fileson {
+ if {$itk_option(-fileson)} {
+ $itk_component(listpane) show files
+
+ _updateLists
+
+ } else {
+ $itk_component(listpane) hide files
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -dirson
+#
+# Specifies whether or not to display the dirs list.
+# ------------------------------------------------------------------
+configbody iwidgets::Extfileselectionbox::dirson {
+ if {$itk_option(-dirson)} {
+ $itk_component(listpane) show dirs
+
+ _updateLists
+
+ } else {
+ $itk_component(listpane) hide dirs
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -selectionon
+#
+# Specifies whether or not to display the selection entry widget.
+# ------------------------------------------------------------------
+configbody iwidgets::Extfileselectionbox::selectionon {
+ _packComponents
+}
+
+# ------------------------------------------------------------------
+# OPTION: -filteron
+#
+# Specifies whether or not to display the filter entry widget.
+# ------------------------------------------------------------------
+configbody iwidgets::Extfileselectionbox::filteron {
+ _packComponents
+}
+
+# ------------------------------------------------------------------
+# OPTION: -mask
+#
+# Specifies the initial file mask string.
+# ------------------------------------------------------------------
+configbody iwidgets::Extfileselectionbox::mask {
+ global tcl_platform
+ set prefix $_pwd
+
+ #
+ # Remove automounter paths.
+ #
+ if {$tcl_platform(platform) == "unix"} {
+ regsub {^/(tmp_mnt|export)} $prefix {} prefix;
+ }
+
+ set curFilter $itk_option(-mask);
+ $itk_component(filter) delete entry 0 end
+ $itk_component(filter) insert entry 0 [file join $_pwd $itk_option(-mask)]
+
+ #
+ # Make sure the right most text is visable.
+ #
+ [$itk_component(filter) component entry] xview moveto 1
+}
+
+# ------------------------------------------------------------------
+# OPTION: -directory
+#
+# Specifies the initial default directory.
+# ------------------------------------------------------------------
+configbody iwidgets::Extfileselectionbox::directory {
+ if {$itk_option(-directory) != {}} {
+ if {! [file exists $itk_option(-directory)]} {
+ error "bad directory option \"$itk_option(-directory)\":\
+ directory does not exist"
+ }
+
+ set olddir [pwd]
+ cd $itk_option(-directory)
+ set _pwd [pwd]
+ cd $olddir
+
+ configure -mask $itk_option(-mask)
+ _selectFilter
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -nomatchstring
+#
+# Specifies the string to be displayed in the files list should
+# not regular files exist in the directory.
+# ------------------------------------------------------------------
+configbody iwidgets::Extfileselectionbox::nomatchstring {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -dirsearchcommand
+#
+# Specifies a command to be executed to perform a directory search.
+# The command will receive the current working directory and filter
+# mask as arguments. The command should return a list of files which
+# will be placed into the directory list.
+# ------------------------------------------------------------------
+configbody iwidgets::Extfileselectionbox::dirsearchcommand {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -filesearchcommand
+#
+# Specifies a command to be executed to perform a file search.
+# The command will receive the current working directory and filter
+# mask as arguments. The command should return a list of files which
+# will be placed into the file list.
+# ------------------------------------------------------------------
+configbody iwidgets::Extfileselectionbox::filesearchcommand {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -selectioncommand
+#
+# Specifies a command to be executed upon pressing return in the
+# selection entry widget.
+# ------------------------------------------------------------------
+configbody iwidgets::Extfileselectionbox::selectioncommand {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -filtercommand
+#
+# Specifies a command to be executed upon pressing return in the
+# filter entry widget.
+# ------------------------------------------------------------------
+configbody iwidgets::Extfileselectionbox::filtercommand {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -selectdircommand
+#
+# Specifies a command to be executed following selection of a
+# directory in the directory list.
+# ------------------------------------------------------------------
+configbody iwidgets::Extfileselectionbox::selectdircommand {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -selectfilecommand
+#
+# Specifies a command to be executed following selection of a
+# file in the files list.
+# ------------------------------------------------------------------
+configbody iwidgets::Extfileselectionbox::selectfilecommand {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -invalid
+#
+# Specify a command to executed should the filter contents be
+# proven invalid.
+# ------------------------------------------------------------------
+configbody iwidgets::Extfileselectionbox::invalid {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -filetype
+#
+# Specify the type of files which may appear in the file list.
+# ------------------------------------------------------------------
+configbody iwidgets::Extfileselectionbox::filetype {
+ switch $itk_option(-filetype) {
+ regular -
+ directory -
+ any {
+ }
+ default {
+ error "bad filetype option \"$itk_option(-filetype)\":\
+ should be regular, directory, or any"
+ }
+ }
+
+ _updateLists
+}
+
+# ------------------------------------------------------------------
+# OPTION: -width
+#
+# Specifies the width of the file selection box. The value may be
+# specified in any of the forms acceptable to Tk_GetPixels.
+# ------------------------------------------------------------------
+configbody iwidgets::Extfileselectionbox::width {
+ #
+ # The width option was added to the hull in the constructor.
+ # So, any width value given is passed automatically to the
+ # hull. All we have to do is play with the propagation.
+ #
+ if {$itk_option(-width) != 0} {
+ set propagate 0
+ } else {
+ set propagate 1
+ }
+
+ #
+ # Due to a bug in the tk4.2 grid, we have to check the
+ # propagation before setting it. Setting it to the same
+ # value it already is will cause it to toggle.
+ #
+ if {[grid propagate $itk_component(hull)] != $propagate} {
+ grid propagate $itk_component(hull) $propagate
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -height
+#
+# Specifies the height of the file selection box. The value may be
+# specified in any of the forms acceptable to Tk_GetPixels.
+# ------------------------------------------------------------------
+configbody iwidgets::Extfileselectionbox::height {
+ #
+ # The height option was added to the hull in the constructor.
+ # So, any height value given is passed automatically to the
+ # hull. All we have to do is play with the propagation.
+ #
+ if {$itk_option(-height) != 0} {
+ set propagate 0
+ } else {
+ set propagate 1
+ }
+
+ #
+ # Due to a bug in the tk4.2 grid, we have to check the
+ # propagation before setting it. Setting it to the same
+ # value it already is will cause it to toggle.
+ #
+ if {[grid propagate $itk_component(hull)] != $propagate} {
+ grid propagate $itk_component(hull) $propagate
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: childsite
+#
+# Returns the path name of the child site widget.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::childsite {} {
+ return $itk_component(childsite)
+}
+
+# ------------------------------------------------------------------
+# METHOD: get
+#
+# Returns the current selection.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::get {} {
+ return [$itk_component(selection) get]
+}
+
+# ------------------------------------------------------------------
+# METHOD: filter
+#
+# The user has pressed Return in the filter. Make sure the contents
+# contain a valid directory before setting default to directory.
+# Use the invalid option to warn the user of any problems.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::filter {} {
+ set newdir [file dirname [$itk_component(filter) get]]
+
+ if {! [file exists $newdir]} {
+ uplevel #0 "$itk_option(-invalid)"
+ return
+ }
+
+ set _pwd $newdir;
+ if {$_pwd == "."} {set _pwd [pwd]};
+
+ _updateLists
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _updateLists ?now?
+#
+# Updates the contents of both the file and directory lists, as well
+# resets the positions of the filter, and lists.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::_updateLists {{when "later"}} {
+ switch -- $when {
+ later {
+ if {$_updateToken == ""} {
+ set _updateToken [after idle [code $this _updateLists now]]
+ }
+ }
+ now {
+ if {$itk_option(-dirson)} {_setDirList}
+ if {$itk_option(-fileson)} {_setFileList}
+
+ if {$itk_option(-filteron)} {
+ _setFilter
+ }
+ if {$itk_option(-selectionon)} {
+ $itk_component(selection) icursor end
+ }
+ if {$itk_option(-dirson)} {
+ $itk_component(dirs) justify left
+ }
+ if {$itk_option(-fileson)} {
+ $itk_component(files) justify left
+ }
+ set _updateToken ""
+ }
+ default {
+ error "bad option \"$when\": should be later or now"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _setFilter
+#
+# Set the filter to the current selection in the directory list plus
+# any existing mask in the filter. Translate the two special cases
+# of '.', and '..' directory names to full path names..
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::_setFilter {} {
+ global tcl_platform
+ set prefix [$itk_component(dirs) getcurselection]
+ set curFilter [file tail [$itk_component(filter) get]]
+
+ while {[regexp {\.$} $prefix]} {
+ if {[file tail $prefix] == "."} {
+ if {$prefix == "."} {
+ if {$_pwd == "."} {
+ set _pwd [pwd]
+ } elseif {$_pwd == ".."} {
+ set _pwd [file dirname [pwd]]
+ }
+ set prefix $_pwd
+ } else {
+ set prefix [file dirname $prefix]
+ }
+ } elseif {[file tail $prefix] == ".."} {
+ if {$prefix != ".."} {
+ set prefix [file dirname [file dirname $prefix]]
+ } else {
+ if {$_pwd == "."} {
+ set _pwd [pwd]
+ } elseif {$_pwd == ".."} {
+ set _pwd [file dirname [pwd]]
+ }
+ set prefix [file dirname $_pwd]
+ }
+ } else {
+ break
+ }
+ }
+
+ if { [file pathtype $prefix] != "absolute" } {
+ set prefix [file join $_pwd $prefix]
+ }
+
+ #
+ # Remove automounter paths.
+ #
+ if {$tcl_platform(platform) == "unix"} {
+ regsub {^/(tmp_mnt|export)} $prefix {} prefix
+ }
+
+ $itk_component(filter) delete entry 0 end
+ $itk_component(filter) insert entry 0 [file join $prefix $curFilter]
+
+ if {[info level -1] != "_selectDir"} {
+ $itk_component(filter) insert list 0 [file join $prefix $curFilter]
+ }
+
+ #
+ # Make sure insertion cursor is at the end.
+ #
+ $itk_component(filter) icursor end
+
+ #
+ # Make sure the right most text is visable.
+ #
+ [$itk_component(filter) component entry] xview moveto 1
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _setSelection
+#
+# Set the contents of the selection entry to either the current
+# selection of the file or directory list dependent on which lists
+# are currently mapped. For the file list, avoid seleciton of the
+# no match string. As for the directory list, translate file names.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::_setSelection {} {
+ global tcl_platform
+ $itk_component(selection) delete entry 0 end
+
+ if {$itk_option(-fileson)} {
+ set selection [$itk_component(files) getcurselection]
+
+ if {$selection != $itk_option(-nomatchstring)} {
+ if {[file pathtype $selection] != "absolute"} {
+ set selection [file join $_pwd $selection]
+ }
+
+ #
+ # Remove automounter paths.
+ #
+ if {$tcl_platform(platform) == "unix"} {
+ regsub {^/(tmp_mnt|export)} $selection {} selection;
+ }
+
+ $itk_component(selection) insert entry 0 $selection
+ } else {
+ $itk_component(files) selection clear 0 end
+ }
+
+ } else {
+ set selection [$itk_component(dirs) getcurselection]
+
+ if {[file tail $selection] == "."} {
+ if {$selection != "."} {
+ set selection [file dirname $selection]
+ } else {
+ set selection $_pwd
+ }
+ } elseif {[file tail $selection] == ".."} {
+ if {$selection != ".."} {
+ set selection [file dirname [file dirname $selection]]
+ } else {
+ set selection [file join $_pwd ..]
+ }
+ }
+
+ #
+ # Remove automounter paths.
+ #
+ if {$tcl_platform(platform) == "unix"} {
+ regsub {^/(tmp_mnt|export)} $selection {} selection;
+ }
+
+ $itk_component(selection) insert entry 0 $selection
+ }
+
+ $itk_component(selection) insert list 0 $selection
+ $itk_component(selection) icursor end
+
+ #
+ # Make sure the right most text is visable.
+ #
+ [$itk_component(selection) component entry] xview moveto 1
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _setDirList
+#
+# Clear the directory list and dependent on whether the user has
+# defined their own search procedure or not fill the list with their
+# results or those of a glob. Select the first element if it exists.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::_setDirList {} {
+ $itk_component(dirs) clear
+
+ if {$itk_option(-dirsearchcommand) == {}} {
+ set cwd $_pwd
+
+ foreach i [lsort [glob -nocomplain \
+ [file join $cwd .*] [file join $cwd *]]] {
+ if {[file isdirectory $i]} {
+ set insert "[file tail $i]"
+ $itk_component(dirs) insert end "$insert"
+ }
+ }
+
+ } else {
+ set mask [file tail [$itk_component(filter) get]]
+
+ foreach file [uplevel #0 $itk_option(-dirsearchcommand) $_pwd $mask] {
+ $itk_component(dirs) insert end $file
+ }
+ }
+
+ if {[$itk_component(dirs) size]} {
+ $itk_component(dirs) selection clear 0 end
+ $itk_component(dirs) selection set 0
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _setFileList
+#
+# Clear the file list and dependent on whether the user has defined
+# their own search procedure or not fill the list with their results
+# or those of a 'glob'. If the files list has no contents, then set
+# the files list to the 'nomatchstring'. Clear all selections.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::_setFileList {} {
+ $itk_component(files) clear
+ set mask [file tail [$itk_component(filter) get]]
+
+ if {$itk_option(-filesearchcommand) == {}} {
+ if {$mask == "*"} {
+ set files [lsort [glob -nocomplain \
+ [file join $_pwd .*] [file join $_pwd *]]]
+ } else {
+ set files [lsort [glob -nocomplain [file join $_pwd $mask]]]
+ }
+
+ foreach i $files {
+ if {($itk_option(-filetype) == "regular" && \
+ ! [file isdirectory $i]) || \
+ ($itk_option(-filetype) == "directory" && \
+ [file isdirectory $i]) || \
+ ($itk_option(-filetype) == "any")} {
+ set insert "[file tail $i]"
+ $itk_component(files) insert end "$insert"
+ }
+ }
+
+ } else {
+ foreach file [uplevel #0 $itk_option(-filesearchcommand) $_pwd $mask] {
+ $itk_component(files) insert end $file
+ }
+ }
+
+ if {[$itk_component(files) size] == 0} {
+ if {$itk_option(-nomatchstring) != {}} {
+ $itk_component(files) insert end $itk_option(-nomatchstring)
+ }
+ }
+
+ $itk_component(files) selection clear 0 end
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _selectDir
+#
+# For a selection in the directory list, set the filter and possibly
+# the selection entry based on the fileson option.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::_selectDir {} {
+ _setFilter
+
+ if {$itk_option(-fileson)} {} {
+ _setSelection
+ }
+
+ if {$itk_option(-selectdircommand) != {}} {
+ uplevel #0 $itk_option(-selectdircommand)
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _dblSelectDir
+#
+# For a double click event in the directory list, select the
+# directory, set the default to the selection, and update both the
+# file and directory lists.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::_dblSelectDir {} {
+ filter
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _selectFile
+#
+# The user has selected a file. Put the current selection in the
+# file list in the selection entry widget.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::_selectFile {} {
+ _setSelection
+
+ if {$itk_option(-selectfilecommand) != {}} {
+ uplevel #0 $itk_option(-selectfilecommand)
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _selectSelection
+#
+# The user has pressed Return in the selection entry widget. Call
+# the defined selection command if it exists.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::_selectSelection {} {
+ if {$itk_option(-selectioncommand) != {}} {
+ uplevel #0 $itk_option(-selectioncommand)
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _selectFilter
+#
+# The user has pressed Return in the filter entry widget. Call the
+# defined selection command if it exists, otherwise just filter.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::_selectFilter {} {
+ if {$itk_option(-filtercommand) != {}} {
+ uplevel #0 $itk_option(-filtercommand)
+ } else {
+ filter
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _packComponents
+#
+# Pack the selection, items, and child site widgets based on options.
+# Using the -in option of pack, put the childsite around the frame
+# in the hull for n, s, e, and w positions. Make sure and raise
+# the child site since using the 'in' option may obscure the site.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::_packComponents {{when "later"}} {
+ if {$when == "later"} {
+ if {$_packToken == ""} {
+ set _packToken [after idle [code $this _packComponents now]]
+ }
+ return
+ } elseif {$when != "now"} {
+ error "bad option \"$when\": should be now or later"
+ }
+
+ set _packToken ""
+
+ #
+ # Forget about any previous placements via the grid and
+ # reset all the possible minsizes and weights for all
+ # the rows and columns.
+ #
+ foreach component {childsite listpane filter selection} {
+ grid forget $itk_component($component)
+ }
+
+ for {set row 0} {$row < 6} {incr row} {
+ grid rowconfigure $_interior $row -minsize 0 -weight 0
+ }
+
+ for {set col 0} {$col < 3} {incr col} {
+ grid columnconfigure $_interior $col -minsize 0 -weight 0
+ }
+
+ #
+ # Place all the components based on the childsite poisition
+ # option.
+ #
+ switch $itk_option(-childsitepos) {
+ n { _nPos }
+
+ w { _wPos }
+
+ s { _sPos }
+
+ e { _ePos }
+
+ top { _topPos }
+
+ bottom { _bottomPos }
+
+ default {
+ error "bad childsitepos option \"$itk_option(-childsitepos)\":\
+ should be n, e, s, w, top, or bottom"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _nPos
+#
+# Position the childsite to the north and all the other components
+# appropriately based on the individual "on" options.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::_nPos {} {
+ grid $itk_component(childsite) -row 0 -column 0 \
+ -columnspan 1 -rowspan 1 -sticky nsew -padx 5
+
+ if {$itk_option(-filteron)} {
+ grid $itk_component(filter) -row 1 -column 0 \
+ -columnspan 1 -sticky ew -padx 5
+ grid rowconfigure $_interior 2 -minsize 7
+ }
+
+ grid $itk_component(listpane) -row 3 -column 0 \
+ -columnspan 1 -sticky nsew
+
+ grid rowconfigure $_interior 3 -weight 1
+
+ if {$itk_option(-selectionon)} {
+ grid rowconfigure $_interior 4 -minsize 7
+ grid $itk_component(selection) -row 5 -column 0 \
+ -columnspan 1 -sticky ew -padx 5
+ }
+
+ grid columnconfigure $_interior 0 -weight 1
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _sPos
+#
+# Position the childsite to the south and all the other components
+# appropriately based on the individual "on" options.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::_sPos {} {
+ if {$itk_option(-filteron)} {
+ grid $itk_component(filter) -row 0 -column 0 \
+ -columnspan 1 -sticky ew -padx 5
+ grid rowconfigure $_interior 1 -minsize 7
+ }
+
+ grid $itk_component(listpane) -row 2 -column 0 \
+ -columnspan 1 -sticky nsew
+
+ grid rowconfigure $_interior 2 -weight 1
+
+ if {$itk_option(-selectionon)} {
+ grid rowconfigure $_interior 3 -minsize 7
+ grid $itk_component(selection) -row 4 -column 0 \
+ -columnspan 1 -sticky ew -padx 5
+ }
+
+ grid $itk_component(childsite) -row 5 -column 0 \
+ -columnspan 1 -rowspan 1 -sticky nsew -padx 5
+
+ grid columnconfigure $_interior 0 -weight 1
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _ePos
+#
+# Position the childsite to the east and all the other components
+# appropriately based on the individual "on" options.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::_ePos {} {
+ if {$itk_option(-filteron)} {
+ grid $itk_component(filter) -row 0 -column 0 \
+ -columnspan 1 -sticky ew -padx 5
+ grid rowconfigure $_interior 1 -minsize 7
+ }
+
+ grid $itk_component(listpane) -row 2 -column 0 \
+ -columnspan 1 -sticky nsew
+
+ grid rowconfigure $_interior 2 -weight 1
+
+ if {$itk_option(-selectionon)} {
+ grid rowconfigure $_interior 3 -minsize 7
+ grid $itk_component(selection) -row 4 -column 0 \
+ -columnspan 1 -sticky ew -padx 5
+ }
+
+ grid $itk_component(childsite) -row 0 -column 1 \
+ -rowspan 5 -columnspan 1 -sticky nsew
+
+ grid columnconfigure $_interior 0 -weight 1
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _wPos
+#
+# Position the childsite to the west and all the other components
+# appropriately based on the individual "on" options.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::_wPos {} {
+ grid $itk_component(childsite) -row 0 -column 0 \
+ -rowspan 5 -columnspan 1 -sticky nsew
+
+ if {$itk_option(-filteron)} {
+ grid $itk_component(filter) -row 0 -column 1 \
+ -columnspan 1 -sticky ew -padx 5
+ grid rowconfigure $_interior 1 -minsize 7
+ }
+
+ grid $itk_component(listpane) -row 2 -column 1 \
+ -columnspan 1 -sticky nsew
+
+ grid rowconfigure $_interior 2 -weight 1
+
+ if {$itk_option(-selectionon)} {
+ grid rowconfigure $_interior 3 -minsize 7
+ grid $itk_component(selection) -row 4 -column 1 \
+ -columnspan 1 -sticky ew -padx 5
+ }
+
+ grid columnconfigure $_interior 1 -weight 1
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _topPos
+#
+# Position the childsite below the filter but above the lists and
+# all the other components appropriately based on the individual
+# "on" options.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::_topPos {} {
+ if {$itk_option(-filteron)} {
+ grid $itk_component(filter) -row 0 -column 0 \
+ -columnspan 1 -sticky ew -padx 5
+ }
+
+ grid $itk_component(childsite) -row 1 -column 0 \
+ -columnspan 1 -rowspan 1 -sticky nsew -padx 5
+
+ grid $itk_component(listpane) -row 2 -column 0 -sticky nsew
+
+ grid rowconfigure $_interior 2 -weight 1
+
+ if {$itk_option(-selectionon)} {
+ grid rowconfigure $_interior 3 -minsize 7
+ grid $itk_component(selection) -row 4 -column 0 \
+ -columnspan 1 -sticky ew -padx 5
+ }
+
+ grid columnconfigure $_interior 0 -weight 1
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _bottomPos
+#
+# Position the childsite below the lists and above the selection
+# and all the other components appropriately based on the individual
+# "on" options.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectionbox::_bottomPos {} {
+ if {$itk_option(-filteron)} {
+ grid $itk_component(filter) -row 0 -column 0 \
+ -columnspan 1 -sticky ew -padx 5
+ grid rowconfigure $_interior 1 -minsize 7
+ }
+
+ grid $itk_component(listpane) -row 2 -column 0 -sticky nsew
+
+ grid rowconfigure $_interior 2 -weight 1
+
+ grid $itk_component(childsite) -row 3 -column 0 \
+ -columnspan 1 -rowspan 1 -sticky nsew -padx 5
+
+ if {$itk_option(-selectionon)} {
+ grid $itk_component(selection) -row 4 -column 0 \
+ -columnspan 1 -sticky ew -padx 5
+ }
+
+ grid columnconfigure $_interior 0 -weight 1
+}
diff --git a/itcl/iwidgets3.0.0/generic/extfileselectiondialog.itk b/itcl/iwidgets3.0.0/generic/extfileselectiondialog.itk
new file mode 100644
index 00000000000..06ec10557bf
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/extfileselectiondialog.itk
@@ -0,0 +1,182 @@
+#
+# Extfileselectiondialog
+# ----------------------------------------------------------------------
+# Implements a file selection dialog that is a slightly extended version
+# of the OSF/Motif standard composite widget. The Extfileselectionbox
+# differs from the Motif standard in that the filter and selection
+# fields are comboboxes and the files and directory lists are in a
+# paned window.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@spd.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1997 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Extfileselectiondialog {
+ keep -activebackground -activerelief -background -borderwidth -cursor \
+ -elementborderwidth -foreground -highlightcolor -highlightthickness \
+ -insertbackground -insertborderwidth -insertofftime -insertontime \
+ -insertwidth -jump -labelfont -modality -selectbackground \
+ -selectborderwidth -textbackground -textfont
+}
+
+# ------------------------------------------------------------------
+# EXTFILESELECTIONDIALOG
+# ------------------------------------------------------------------
+class iwidgets::Extfileselectiondialog {
+ inherit iwidgets::Dialog
+
+ constructor {args} {}
+
+ public {
+ method childsite {}
+ method get {}
+ method filter {}
+ }
+
+ protected method _dbldir {}
+}
+
+#
+# Provide a lowercased access method for the Extfileselectiondialog class.
+#
+proc ::iwidgets::extfileselectiondialog {pathName args} {
+ uplevel ::iwidgets::Extfileselectiondialog $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Extfileselectiondialog.borderWidth 2 widgetDefault
+
+option add *Extfileselectiondialog.title "File Selection Dialog" widgetDefault
+
+option add *Extfileselectiondialog.width 350 widgetDefault
+option add *Extfileselectiondialog.height 400 widgetDefault
+
+option add *Extfileselectiondialog.master "." widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectiondialog::constructor {args} {
+ component hull configure -borderwidth 0
+ itk_option add hull.width hull.height
+
+ #
+ # Turn off pack propagation for the hull widget so the width
+ # and height options become active.
+ #
+ pack propagate $itk_component(hull) no
+
+ #
+ # Instantiate a file selection box widget.
+ #
+ itk_component add fsb {
+ iwidgets::Extfileselectionbox $itk_interior.fsb -width 150 -height 150 \
+ -selectioncommand [code $this invoke] \
+ -selectdircommand [code $this default Apply] \
+ -selectfilecommand [code $this default OK]
+ } {
+ usual
+
+ keep -labelfont -childsitepos -directory -dirslabel \
+ -dirsearchcommand -dirson -fileslabel -fileson \
+ -filesearchcommand -filterlabel -filteron \
+ -filetype -invalid -mask -nomatchstring \
+ -selectionlabel -selectionon
+ }
+ grid $itk_component(fsb) -sticky nsew
+ grid rowconfigure $itk_interior 0 -weight 1
+ grid columnconfigure $itk_interior 0 -weight 1
+
+ $itk_component(fsb) component filter configure \
+ -focuscommand [code $this default Apply]
+ $itk_component(fsb) component selection configure \
+ -focuscommand [code $this default OK]
+ $itk_component(fsb) component dirs configure \
+ -dblclickcommand [code $this _dbldir]
+ $itk_component(fsb) component files configure \
+ -dblclickcommand [code $this invoke]
+
+ buttonconfigure Apply -text "Filter" \
+ -command [code $itk_component(fsb) filter]
+
+ set itk_interior [$itk_component(fsb) childsite]
+
+ hide Help
+
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: childsite
+#
+# Thinwrapped method of file selection box class.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectiondialog::childsite {} {
+ return [$itk_component(fsb) childsite]
+}
+
+# ------------------------------------------------------------------
+# METHOD: get
+#
+# Thinwrapped method of file selection box class.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectiondialog::get {} {
+ return [$itk_component(fsb) get]
+}
+
+# ------------------------------------------------------------------
+# METHOD: filter
+#
+# Thinwrapped method of file selection box class.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectiondialog::filter {} {
+ return [$itk_component(fsb) filter]
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _dbldir
+#
+# Double select in directory list. If the files list is on then
+# make the default button the filter and invoke. If not, just invoke.
+# ------------------------------------------------------------------
+body iwidgets::Extfileselectiondialog::_dbldir {} {
+ if {$itk_option(-fileson)} {
+ default Apply
+ }
+
+ invoke
+}
+
diff --git a/itcl/iwidgets3.0.0/generic/feedback.itk b/itcl/iwidgets3.0.0/generic/feedback.itk
new file mode 100644
index 00000000000..54c1f7b4d26
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/feedback.itk
@@ -0,0 +1,207 @@
+#
+# Feedback
+# ----------------------------------------------------------------------
+# Implements a Feedback widget, to display feedback on the status of an
+# process to the user. Display is given as a percentage and as a
+# thermometer type bar. Options exist for adding a label and controlling its
+# position.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Kris Raney EMAIL: kraney@spd.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1996 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+# Acknowledgements:
+#
+# Special thanks go to Sam Shen(SLShen@lbl.gov), as this code is based on his
+# feedback.tcl code from tk inspect. The original code is copyright 1995
+# Lawrence Berkeley Laboratory.
+#
+# This software is copyright (C) 1994 by the Lawrence Berkeley Laboratory.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that: (1) source code distributions
+# retain the above copyright notice and this paragraph in its entirety, (2)
+# distributions including binary code include the above copyright notice and
+# this paragraph in its entirety in the documentation or other materials
+# provided with the distribution, and (3) all advertising materials mentioning
+# features or use of this software display the following acknowledgement:
+# ``This product includes software developed by the University of California,
+# Lawrence Berkeley Laboratory and its contributors.'' Neither the name of
+# the University nor the names of its contributors may be used to endorse
+# or promote products derived from this software without specific prior
+# written permission.
+#
+# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
+# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+
+#
+# Default resources.
+#
+option add *Feedback.borderWidth 2 widgetDefault
+option add *Feedback.labelPos n widgetDefault
+option add *Feedback.barHeight 20 widgetDefault
+option add *Feedback.troughColor White widgetDefault
+option add *Feedback.barColor Blue widgetDefault
+
+#
+# Usual options.
+#
+itk::usual Feedback {
+ keep -background -cursor -foreground
+}
+
+# ------------------------------------------------------------------
+# FEEDBACK
+# ------------------------------------------------------------------
+class iwidgets::Feedback {
+ inherit iwidgets::Labeledwidget
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -steps steps Steps 10
+
+ public {
+ method reset {}
+ method step {{inc 1}}
+ }
+
+ private {
+ method _display
+
+ variable _barwidth 0
+ variable _stepval 0
+ }
+}
+
+#
+# Provide a lowercased access method for the Dialogshell class.
+#
+proc ::iwidgets::feedback {pathName args} {
+ uplevel ::iwidgets::Feedback $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Feedback::constructor {args} {
+ itk_component add trough {
+ frame $itk_interior.trough -relief sunken
+ } {
+ usual
+ keep -borderwidth
+ rename -background -troughcolor troughColor TroughColor
+ rename -height -barheight barHeight Height
+ }
+
+ itk_component add bar {
+ frame $itk_component(trough).bar -relief raised
+ } {
+ usual
+ keep -borderwidth
+ rename -background -barcolor barColor BarColor
+ rename -height -barheight barHeight Height
+ }
+ pack $itk_component(bar) -side left -fill y -anchor w
+
+ itk_component add percentage {
+ label $itk_interior.percentage -text "0%"
+ }
+ grid $itk_component(trough) -row 1 -column 0 -sticky sew -padx 2 -pady 2
+ grid $itk_component(percentage) -row 2 -column 0 -sticky nsew -padx 2 -pady 2
+ grid rowconfigure $itk_interior 0 -weight 1
+ grid rowconfigure $itk_interior 1 -weight 1
+ grid columnconfigure $itk_interior 0 -weight 1
+
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# DESTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Feedback::destructor {} {
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -steps
+#
+# Set the total number of steps.
+# ------------------------------------------------------------------
+configbody iwidgets::Feedback::steps {
+ step 0
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# -----------------------------------------------------------------------------
+# PROTECTED METHOD: _display
+#
+# Displays the bar in the trough with the width set using the current number
+# of steps.
+# -----------------------------------------------------------------------------
+body iwidgets::Feedback::_display {} {
+ set troughwidth [winfo width $itk_component(trough)]
+ set _barwidth [expr $troughwidth.0/$itk_option(-steps)]
+ set fraction [expr int((1.0*$_stepval)/$itk_option(-steps)*100.0)]
+
+ $itk_component(percentage) config -text "$fraction%"
+ $itk_component(bar) config -width [expr $_barwidth*$_stepval]
+
+ update
+}
+
+# ------------------------------------------------------------------
+# METHOD: reset
+#
+# Resets the status bar to 0
+# ------------------------------------------------------------------
+body iwidgets::Feedback::reset {} {
+ set _stepval 0
+ _display
+}
+
+# ------------------------------------------------------------------
+# METHOD: step ?inc?
+#
+# Increase the value of the status bar by inc. Default to 1
+# ------------------------------------------------------------------
+body iwidgets::Feedback::step {{inc 1}} {
+
+ if {$_stepval >= $itk_option(-steps)} {
+ return
+ }
+
+ incr _stepval $inc
+ _display
+}
diff --git a/itcl/iwidgets3.0.0/generic/fileselectionbox.itk b/itcl/iwidgets3.0.0/generic/fileselectionbox.itk
new file mode 100644
index 00000000000..b41b29cdcdf
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/fileselectionbox.itk
@@ -0,0 +1,1242 @@
+#
+# Fileselectionbox
+# ----------------------------------------------------------------------
+# Implements a file selection box in a style similar to the OSF/Motif
+# standard XmFileselectionbox composite widget. The Fileselectionbox
+# is composed of directory and file scrolled lists as well as filter
+# and selection entry fields.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@spd.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1997 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Fileselectionbox {
+ keep -activebackground -activerelief -background -borderwidth -cursor \
+ -elementborderwidth -foreground -highlightcolor -highlightthickness \
+ -insertbackground -insertborderwidth -insertofftime -insertontime \
+ -insertwidth -jump -labelfont -selectbackground -selectborderwidth \
+ -textbackground -textfont -troughcolor
+}
+
+# ------------------------------------------------------------------
+# FILESELECTIONBOX
+# ------------------------------------------------------------------
+class iwidgets::Fileselectionbox {
+ inherit itk::Widget
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -childsitepos childSitePos Position s
+ itk_option define -fileson filesOn FilesOn true
+ itk_option define -dirson dirsOn DirsOn true
+ itk_option define -selectionon selectionOn SelectionOn true
+ itk_option define -filteron filterOn FilterOn true
+ itk_option define -mask mask Mask {*}
+ itk_option define -directory directory Directory {}
+ itk_option define -nomatchstring noMatchString NoMatchString {}
+ itk_option define -dirsearchcommand dirSearchCommand Command {}
+ itk_option define -filesearchcommand fileSearchCommand Command {}
+ itk_option define -selectioncommand selectionCommand Command {}
+ itk_option define -filtercommand filterCommand Command {}
+ itk_option define -selectdircommand selectDirCommand Command {}
+ itk_option define -selectfilecommand selectFileCommand Command {}
+ itk_option define -invalid invalid Command {bell}
+ itk_option define -filetype fileType FileType {regular}
+ itk_option define -width width Width 350
+ itk_option define -height height Height 300
+
+ public {
+ method childsite {}
+ method get {}
+ method filter {}
+ }
+
+ public {
+ method _selectDir {}
+ method _dblSelectDir {}
+ method _selectFile {}
+ method _selectSelection {}
+ method _selectFilter {}
+ }
+
+ protected {
+ method _packComponents {{when later}}
+ method _updateLists {{when later}}
+ }
+
+ private {
+ method _setFilter {}
+ method _setSelection {}
+ method _setDirList {}
+ method _setFileList {}
+
+ method _nPos {}
+ method _sPos {}
+ method _ePos {}
+ method _wPos {}
+ method _topPos {}
+ method _centerPos {}
+ method _bottomPos {}
+
+ variable _packToken "" ;# non-null => _packComponents pending
+ variable _updateToken "" ;# non-null => _updateLists pending
+ variable _pwd "." ;# present working dir
+ variable _interior ;# original interior setting
+ }
+}
+
+#
+# Provide a lowercased access method for the Fileselectionbox class.
+#
+proc ::iwidgets::fileselectionbox {pathName args} {
+ uplevel ::iwidgets::Fileselectionbox $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Fileselectionbox.borderWidth 2 widgetDefault
+
+option add *Fileselectionbox.filterLabel Filter widgetDefault
+option add *Fileselectionbox.dirsLabel Directories widgetDefault
+option add *Fileselectionbox.filesLabel Files widgetDefault
+option add *Fileselectionbox.selectionLabel Selection widgetDefault
+
+option add *Fileselectionbox.width 350 widgetDefault
+option add *Fileselectionbox.height 300 widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::constructor {args} {
+ #
+ # Add back to the hull width and height options and make the
+ # borderwidth zero since we don't need it.
+ #
+ itk_option add hull.width hull.height
+ component hull configure -borderwidth 0
+
+ set _interior $itk_interior
+
+ #
+ # Create the filter entry.
+ #
+ itk_component add filter {
+ iwidgets::Entryfield $itk_interior.filter -labelpos nw \
+ -command [code $this _selectFilter] -exportselection 0
+ } {
+ usual
+
+ rename -labeltext -filterlabel filterLabel Text
+ }
+
+ #
+ # Create the directory list.
+ #
+ itk_component add dirs {
+ iwidgets::Scrolledlistbox $itk_interior.dirs \
+ -selectioncommand [code $this _selectDir] \
+ -selectmode single -exportselection 0 \
+ -visibleitems 1x1 -labelpos nw \
+ -hscrollmode static -vscrollmode static \
+ -dblclickcommand [code $this _dblSelectDir]
+ } {
+ usual
+
+ rename -labeltext -dirslabel dirsLabel Text
+ }
+
+ #
+ # Create the files list.
+ #
+ itk_component add files {
+ iwidgets::Scrolledlistbox $itk_interior.files \
+ -selectioncommand [code $this _selectFile] \
+ -selectmode single -exportselection 0 \
+ -visibleitems 1x1 -labelpos nw \
+ -hscrollmode static -vscrollmode static
+ } {
+ usual
+
+ rename -labeltext -fileslabel filesLabel Text
+ }
+
+ #
+ # Create the selection entry.
+ #
+ itk_component add selection {
+ iwidgets::Entryfield $itk_interior.selection -labelpos nw \
+ -command [code $this _selectSelection] -exportselection 0
+ } {
+ usual
+
+ rename -labeltext -selectionlabel selectionLabel Text
+ }
+
+ #
+ # Create the child site widget.
+ #
+ itk_component add -protected childsite {
+ frame $itk_interior.fsbchildsite
+ }
+
+ #
+ # Set the interior variable to the childsite for derived classes.
+ #
+ set itk_interior $itk_component(childsite)
+
+ #
+ # Explicitly handle configs that may have been ignored earlier.
+ #
+ eval itk_initialize $args
+
+ #
+ # When idle, pack the childsite and update the lists.
+ #
+ _packComponents
+ _updateLists
+}
+
+# ------------------------------------------------------------------
+# DESTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::destructor {} {
+ if {$_packToken != ""} {after cancel $_packToken}
+ if {$_updateToken != ""} {after cancel $_updateToken}
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -childsitepos
+#
+# Specifies the position of the child site in the selection box.
+# ------------------------------------------------------------------
+configbody iwidgets::Fileselectionbox::childsitepos {
+ _packComponents
+}
+
+# ------------------------------------------------------------------
+# OPTION: -fileson
+#
+# Specifies whether or not to display the files list.
+# ------------------------------------------------------------------
+configbody iwidgets::Fileselectionbox::fileson {
+ _packComponents
+}
+
+# ------------------------------------------------------------------
+# OPTION: -dirson
+#
+# Specifies whether or not to display the dirs list.
+# ------------------------------------------------------------------
+configbody iwidgets::Fileselectionbox::dirson {
+ _packComponents
+}
+
+# ------------------------------------------------------------------
+# OPTION: -selectionon
+#
+# Specifies whether or not to display the selection entry widget.
+# ------------------------------------------------------------------
+configbody iwidgets::Fileselectionbox::selectionon {
+ _packComponents
+}
+
+# ------------------------------------------------------------------
+# OPTION: -filteron
+#
+# Specifies whether or not to display the filter entry widget.
+# ------------------------------------------------------------------
+configbody iwidgets::Fileselectionbox::filteron {
+ _packComponents
+}
+
+# ------------------------------------------------------------------
+# OPTION: -mask
+#
+# Specifies the initial file mask string.
+# ------------------------------------------------------------------
+configbody iwidgets::Fileselectionbox::mask {
+ global tcl_platform
+ set prefix $_pwd
+
+ #
+ # Remove automounter paths.
+ #
+ if {$tcl_platform(platform) == "unix"} {
+ regsub {^/(tmp_mnt|export)} $prefix {} prefix;
+ }
+
+ set curFilter $itk_option(-mask);
+ $itk_component(filter) delete 0 end
+ $itk_component(filter) insert 0 [file join $_pwd $itk_option(-mask)]
+
+ #
+ # Make sure the right most text is visable.
+ #
+ $itk_component(filter) xview moveto 1
+}
+
+# ------------------------------------------------------------------
+# OPTION: -directory
+#
+# Specifies the initial default directory.
+# ------------------------------------------------------------------
+configbody iwidgets::Fileselectionbox::directory {
+ if {$itk_option(-directory) != {}} {
+ if {! [file exists $itk_option(-directory)]} {
+ error "bad directory option \"$itk_option(-directory)\":\
+ directory does not exist"
+ }
+
+ set olddir [pwd]
+ cd $itk_option(-directory)
+ set _pwd [pwd]
+ cd $olddir
+
+ configure -mask $itk_option(-mask)
+ _selectFilter
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -nomatchstring
+#
+# Specifies the string to be displayed in the files list should
+# not regular files exist in the directory.
+# ------------------------------------------------------------------
+configbody iwidgets::Fileselectionbox::nomatchstring {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -dirsearchcommand
+#
+# Specifies a command to be executed to perform a directory search.
+# The command will receive the current working directory and filter
+# mask as arguments. The command should return a list of files which
+# will be placed into the directory list.
+# ------------------------------------------------------------------
+configbody iwidgets::Fileselectionbox::dirsearchcommand {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -filesearchcommand
+#
+# Specifies a command to be executed to perform a file search.
+# The command will receive the current working directory and filter
+# mask as arguments. The command should return a list of files which
+# will be placed into the file list.
+# ------------------------------------------------------------------
+configbody iwidgets::Fileselectionbox::filesearchcommand {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -selectioncommand
+#
+# Specifies a command to be executed upon pressing return in the
+# selection entry widget.
+# ------------------------------------------------------------------
+configbody iwidgets::Fileselectionbox::selectioncommand {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -filtercommand
+#
+# Specifies a command to be executed upon pressing return in the
+# filter entry widget.
+# ------------------------------------------------------------------
+configbody iwidgets::Fileselectionbox::filtercommand {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -selectdircommand
+#
+# Specifies a command to be executed following selection of a
+# directory in the directory list.
+# ------------------------------------------------------------------
+configbody iwidgets::Fileselectionbox::selectdircommand {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -selectfilecommand
+#
+# Specifies a command to be executed following selection of a
+# file in the files list.
+# ------------------------------------------------------------------
+configbody iwidgets::Fileselectionbox::selectfilecommand {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -invalid
+#
+# Specify a command to executed should the filter contents be
+# proven invalid.
+# ------------------------------------------------------------------
+configbody iwidgets::Fileselectionbox::invalid {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -filetype
+#
+# Specify the type of files which may appear in the file list.
+# ------------------------------------------------------------------
+configbody iwidgets::Fileselectionbox::filetype {
+ switch $itk_option(-filetype) {
+ regular -
+ directory -
+ any {
+ }
+ default {
+ error "bad filetype option \"$itk_option(-filetype)\":\
+ should be regular, directory, or any"
+ }
+ }
+
+ _updateLists
+}
+
+# ------------------------------------------------------------------
+# OPTION: -width
+#
+# Specifies the width of the file selection box. The value may be
+# specified in any of the forms acceptable to Tk_GetPixels.
+# ------------------------------------------------------------------
+configbody iwidgets::Fileselectionbox::width {
+ #
+ # The width option was added to the hull in the constructor.
+ # So, any width value given is passed automatically to the
+ # hull. All we have to do is play with the propagation.
+ #
+ if {$itk_option(-width) != 0} {
+ set propagate 0
+ } else {
+ set propagate 1
+ }
+
+ #
+ # Due to a bug in the tk4.2 grid, we have to check the
+ # propagation before setting it. Setting it to the same
+ # value it already is will cause it to toggle.
+ #
+ if {[grid propagate $itk_component(hull)] != $propagate} {
+ grid propagate $itk_component(hull) $propagate
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -height
+#
+# Specifies the height of the file selection box. The value may be
+# specified in any of the forms acceptable to Tk_GetPixels.
+# ------------------------------------------------------------------
+configbody iwidgets::Fileselectionbox::height {
+ #
+ # The height option was added to the hull in the constructor.
+ # So, any height value given is passed automatically to the
+ # hull. All we have to do is play with the propagation.
+ #
+ if {$itk_option(-height) != 0} {
+ set propagate 0
+ } else {
+ set propagate 1
+ }
+
+ #
+ # Due to a bug in the tk4.2 grid, we have to check the
+ # propagation before setting it. Setting it to the same
+ # value it already is will cause it to toggle.
+ #
+ if {[grid propagate $itk_component(hull)] != $propagate} {
+ grid propagate $itk_component(hull) $propagate
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: childsite
+#
+# Returns the path name of the child site widget.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::childsite {} {
+ return $itk_component(childsite)
+}
+
+# ------------------------------------------------------------------
+# METHOD: get
+#
+# Returns the current selection.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::get {} {
+ return [$itk_component(selection) get]
+}
+
+# ------------------------------------------------------------------
+# METHOD: filter
+#
+# The user has pressed Return in the filter. Make sure the contents
+# contain a valid directory before setting default to directory.
+# Use the invalid option to warn the user of any problems.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::filter {} {
+ set newdir [file dirname [$itk_component(filter) get]]
+
+ if {! [file exists $newdir]} {
+ uplevel #0 "$itk_option(-invalid)"
+ return
+ }
+
+ set _pwd $newdir;
+ if {$_pwd == "."} {set _pwd [pwd]};
+
+ _updateLists
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _updateLists ?now?
+#
+# Updates the contents of both the file and directory lists, as well
+# resets the positions of the filter, and lists.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::_updateLists {{when "later"}} {
+ switch -- $when {
+ later {
+ if {$_updateToken == ""} {
+ set _updateToken [after idle [code $this _updateLists now]]
+ }
+ }
+ now {
+ if {$itk_option(-dirson)} {_setDirList}
+ if {$itk_option(-fileson)} {_setFileList}
+
+ if {$itk_option(-filteron)} {
+ _setFilter
+ }
+ if {$itk_option(-selectionon)} {
+ $itk_component(selection) icursor end
+ }
+ if {$itk_option(-dirson)} {
+ $itk_component(dirs) justify left
+ }
+ if {$itk_option(-fileson)} {
+ $itk_component(files) justify left
+ }
+ set _updateToken ""
+ }
+ default {
+ error "bad option \"$when\": should be later or now"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _setFilter
+#
+# Set the filter to the current selection in the directory list plus
+# any existing mask in the filter. Translate the two special cases
+# of '.', and '..' directory names to full path names..
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::_setFilter {} {
+ global tcl_platform
+ set prefix [$itk_component(dirs) getcurselection]
+ set curFilter [file tail [$itk_component(filter) get]]
+
+ while {[regexp {\.$} $prefix]} {
+ if {[file tail $prefix] == "."} {
+ if {$prefix == "."} {
+ if {$_pwd == "."} {
+ set _pwd [pwd]
+ } elseif {$_pwd == ".."} {
+ set _pwd [file dirname [pwd]]
+ }
+ set prefix $_pwd
+ } else {
+ set prefix [file dirname $prefix]
+ }
+ } elseif {[file tail $prefix] == ".."} {
+ if {$prefix != ".."} {
+ set prefix [file dirname [file dirname $prefix]]
+ } else {
+ if {$_pwd == "."} {
+ set _pwd [pwd]
+ } elseif {$_pwd == ".."} {
+ set _pwd [file dirname [pwd]]
+ }
+ set prefix [file dirname $_pwd]
+ }
+ } else {
+ break
+ }
+ }
+
+ if { [file pathtype $prefix] != "absolute" } {
+ set prefix [file join $_pwd $prefix]
+ }
+
+ #
+ # Remove automounter paths.
+ #
+ if {$tcl_platform(platform) == "unix"} {
+ regsub {^/(tmp_mnt|export)} $prefix {} prefix
+ }
+
+ $itk_component(filter) delete 0 end
+ $itk_component(filter) insert 0 [file join $prefix $curFilter]
+
+ #
+ # Make sure insertion cursor is at the end.
+ #
+ $itk_component(filter) icursor end
+
+ #
+ # Make sure the right most text is visable.
+ #
+ $itk_component(filter) xview moveto 1
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _setSelection
+#
+# Set the contents of the selection entry to either the current
+# selection of the file or directory list dependent on which lists
+# are currently mapped. For the file list, avoid seleciton of the
+# no match string. As for the directory list, translate file names.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::_setSelection {} {
+ global tcl_platform
+ $itk_component(selection) delete 0 end
+
+ if {$itk_option(-fileson)} {
+ set selection [$itk_component(files) getcurselection]
+
+ if {$selection != $itk_option(-nomatchstring)} {
+ if {[file pathtype $selection] != "absolute"} {
+ set selection [file join $_pwd $selection]
+ }
+
+ #
+ # Remove automounter paths.
+ #
+ if {$tcl_platform(platform) == "unix"} {
+ regsub {^/(tmp_mnt|export)} $selection {} selection;
+ }
+
+ $itk_component(selection) insert 0 $selection
+ } else {
+ $itk_component(files) selection clear 0 end
+ }
+
+ } else {
+ set selection [$itk_component(dirs) getcurselection]
+
+ if {[file tail $selection] == "."} {
+ if {$selection != "."} {
+ set selection [file dirname $selection]
+ } else {
+ set selection $_pwd
+ }
+ } elseif {[file tail $selection] == ".."} {
+ if {$selection != ".."} {
+ set selection [file dirname [file dirname $selection]]
+ } else {
+ set selection [file join $_pwd ..]
+ }
+ }
+
+ #
+ # Remove automounter paths.
+ #
+ if {$tcl_platform(platform) == "unix"} {
+ regsub {^/(tmp_mnt|export)} $selection {} selection;
+ }
+
+ $itk_component(selection) insert 0 $selection
+ }
+
+ $itk_component(selection) icursor end
+
+ #
+ # Make sure the right most text is visable.
+ #
+ $itk_component(selection) xview moveto 1
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _setDirList
+#
+# Clear the directory list and dependent on whether the user has
+# defined their own search procedure or not fill the list with their
+# results or those of a glob. Select the first element if it exists.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::_setDirList {} {
+ $itk_component(dirs) clear
+
+ if {$itk_option(-dirsearchcommand) == {}} {
+ foreach i [lsort [glob -nocomplain \
+ [file join $_pwd .*] [file join $_pwd *]]] {
+ if {[file isdirectory $i]} {
+ $itk_component(dirs) insert end [file tail "$i"]
+ }
+ }
+
+ } else {
+ set mask [file tail [$itk_component(filter) get]]
+
+ foreach file [uplevel #0 $itk_option(-dirsearchcommand) $_pwd $mask] {
+ $itk_component(dirs) insert end $file
+ }
+ }
+
+ if {[$itk_component(dirs) size]} {
+ $itk_component(dirs) selection clear 0 end
+ $itk_component(dirs) selection set 0
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _setFileList
+#
+# Clear the file list and dependent on whether the user has defined
+# their own search procedure or not fill the list with their results
+# or those of a 'glob'. If the files list has no contents, then set
+# the files list to the 'nomatchstring'. Clear all selections.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::_setFileList {} {
+ $itk_component(files) clear
+ set mask [file tail [$itk_component(filter) get]]
+
+ if {$itk_option(-filesearchcommand) == {}} {
+ if {$mask == "*"} {
+ set files [lsort [glob -nocomplain \
+ [file join $_pwd .*] [file join $_pwd *]]]
+ } else {
+ set files [lsort [glob -nocomplain [file join $_pwd $mask]]]
+ }
+
+ foreach i $files {
+ if {($itk_option(-filetype) == "regular" && \
+ ! [file isdirectory $i]) || \
+ ($itk_option(-filetype) == "directory" && \
+ [file isdirectory $i]) || \
+ ($itk_option(-filetype) == "any")} {
+ $itk_component(files) insert end [file tail "$i"]
+ }
+ }
+
+ } else {
+ foreach file [uplevel #0 $itk_option(-filesearchcommand) $_pwd $mask] {
+ $itk_component(files) insert end $file
+ }
+ }
+
+ if {[$itk_component(files) size] == 0} {
+ if {$itk_option(-nomatchstring) != {}} {
+ $itk_component(files) insert end $itk_option(-nomatchstring)
+ }
+ }
+
+ $itk_component(files) selection clear 0 end
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _selectDir
+#
+# For a selection in the directory list, set the filter and possibly
+# the selection entry based on the fileson option.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::_selectDir {} {
+ _setFilter
+
+ if {$itk_option(-fileson)} {} {
+ _setSelection
+ }
+
+ if {$itk_option(-selectdircommand) != {}} {
+ uplevel #0 $itk_option(-selectdircommand)
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _dblSelectDir
+#
+# For a double click event in the directory list, select the
+# directory, set the default to the selection, and update both the
+# file and directory lists.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::_dblSelectDir {} {
+ filter
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _selectFile
+#
+# The user has selected a file. Put the current selection in the
+# file list in the selection entry widget.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::_selectFile {} {
+ _setSelection
+
+ if {$itk_option(-selectfilecommand) != {}} {
+ uplevel #0 $itk_option(-selectfilecommand)
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _selectSelection
+#
+# The user has pressed Return in the selection entry widget. Call
+# the defined selection command if it exists.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::_selectSelection {} {
+ if {$itk_option(-selectioncommand) != {}} {
+ uplevel #0 $itk_option(-selectioncommand)
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _selectFilter
+#
+# The user has pressed Return in the filter entry widget. Call the
+# defined selection command if it exists, otherwise just filter.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::_selectFilter {} {
+ if {$itk_option(-filtercommand) != {}} {
+ uplevel #0 $itk_option(-filtercommand)
+ } else {
+ filter
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _packComponents
+#
+# Pack the selection, items, and child site widgets based on options.
+# Using the -in option of pack, put the childsite around the frame
+# in the hull for n, s, e, and w positions. Make sure and raise
+# the child site since using the 'in' option may obscure the site.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::_packComponents {{when "later"}} {
+ if {$when == "later"} {
+ if {$_packToken == ""} {
+ set _packToken [after idle [code $this _packComponents now]]
+ }
+ return
+ } elseif {$when != "now"} {
+ error "bad option \"$when\": should be now or later"
+ }
+
+ set _packToken ""
+
+ #
+ # Forget about any previous placements via the grid and
+ # reset all the possible minsizes and weights for all
+ # the rows and columns.
+ #
+ foreach component {childsite filter dirs files selection} {
+ grid forget $itk_component($component)
+ }
+
+ for {set row 0} {$row < 6} {incr row} {
+ grid rowconfigure $_interior $row -minsize 0 -weight 0
+ }
+
+ for {set col 0} {$col < 4} {incr col} {
+ grid columnconfigure $_interior $col -minsize 0 -weight 0
+ }
+
+ #
+ # Place all the components based on the childsite poisition
+ # option.
+ #
+ switch $itk_option(-childsitepos) {
+ n { _nPos }
+
+ w { _wPos }
+
+ s { _sPos }
+
+ e { _ePos }
+
+ center { _centerPos }
+
+ top { _topPos }
+
+ bottom { _bottomPos }
+
+ default {
+ error "bad childsitepos option \"$itk_option(-childsitepos)\":\
+ should be n, e, s, w, center, top, or bottom"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _nPos
+#
+# Position the childsite to the north and all the other components
+# appropriately based on the individual "on" options.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::_nPos {} {
+ grid $itk_component(childsite) -row 0 -column 0 \
+ -columnspan 3 -rowspan 1 -sticky nsew
+
+ if {$itk_option(-filteron)} {
+ grid $itk_component(filter) -row 1 -column 0 \
+ -columnspan 3 -sticky ew
+ grid rowconfigure $_interior 2 -minsize 7
+ }
+
+ if {$itk_option(-dirson)} {
+ grid $itk_component(dirs) -row 3 -column 0 \
+ -columnspan 1 -sticky nsew
+ }
+ if {$itk_option(-fileson)} {
+ grid $itk_component(files) -row 3 -column 2 \
+ -columnspan 1 -sticky nsew
+ }
+ if {$itk_option(-dirson)} {
+ if {$itk_option(-fileson)} {
+ grid columnconfigure $_interior 1 -minsize 7
+ } else {
+ grid configure $itk_component(dirs) -columnspan 3 -column 0
+ }
+ } else {
+ if {$itk_option(-fileson)} {
+ grid configure $itk_component(files) -columnspan 3 -column 0
+ }
+ }
+
+ grid rowconfigure $_interior 3 -weight 1
+
+ if {$itk_option(-selectionon)} {
+ grid rowconfigure $_interior 4 -minsize 7
+ grid $itk_component(selection) -row 5 -column 0 \
+ -columnspan 3 -sticky ew
+ }
+
+ grid columnconfigure $_interior 0 -weight 1
+ grid columnconfigure $_interior 2 -weight 1
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _sPos
+#
+# Position the childsite to the south and all the other components
+# appropriately based on the individual "on" options.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::_sPos {} {
+ if {$itk_option(-filteron)} {
+ grid $itk_component(filter) -row 0 -column 0 \
+ -columnspan 3 -sticky ew
+ grid rowconfigure $_interior 1 -minsize 7
+ }
+
+ if {$itk_option(-dirson)} {
+ grid $itk_component(dirs) -row 2 -column 0 \
+ -columnspan 1 -sticky nsew
+ }
+ if {$itk_option(-fileson)} {
+ grid $itk_component(files) -row 2 -column 2 \
+ -columnspan 1 -sticky nsew
+ }
+ if {$itk_option(-dirson)} {
+ if {$itk_option(-fileson)} {
+ grid columnconfigure $_interior 1 -minsize 7
+ } else {
+ grid configure $itk_component(dirs) -columnspan 3 -column 0
+ }
+ } else {
+ if {$itk_option(-fileson)} {
+ grid configure $itk_component(files) -columnspan 3 -column 0
+ }
+ }
+
+ grid rowconfigure $_interior 2 -weight 1
+
+ if {$itk_option(-selectionon)} {
+ grid rowconfigure $_interior 3 -minsize 7
+ grid $itk_component(selection) -row 4 -column 0 \
+ -columnspan 3 -sticky ew
+ }
+
+ grid $itk_component(childsite) -row 5 -column 0 \
+ -columnspan 3 -rowspan 1 -sticky nsew
+ grid columnconfigure $_interior 0 -weight 1
+ grid columnconfigure $_interior 2 -weight 1
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _ePos
+#
+# Position the childsite to the east and all the other components
+# appropriately based on the individual "on" options.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::_ePos {} {
+ if {$itk_option(-filteron)} {
+ grid $itk_component(filter) -row 0 -column 0 \
+ -columnspan 3 -sticky ew
+ grid rowconfigure $_interior 1 -minsize 7
+ }
+
+ if {$itk_option(-dirson)} {
+ grid $itk_component(dirs) -row 2 -column 0 \
+ -columnspan 1 -sticky nsew
+ }
+ if {$itk_option(-fileson)} {
+ grid $itk_component(files) -row 2 -column 2 \
+ -columnspan 1 -sticky nsew
+ }
+ if {$itk_option(-dirson)} {
+ if {$itk_option(-fileson)} {
+ grid columnconfigure $_interior 1 -minsize 7
+ } else {
+ grid configure $itk_component(dirs) -columnspan 3 -column 0
+ }
+ } else {
+ if {$itk_option(-fileson)} {
+ grid configure $itk_component(files) -columnspan 3 -column 0
+ }
+ }
+
+ grid rowconfigure $_interior 2 -weight 1
+
+ if {$itk_option(-selectionon)} {
+ grid rowconfigure $_interior 3 -minsize 7
+ grid $itk_component(selection) -row 4 -column 0 \
+ -columnspan 3 -sticky ew
+ }
+
+ grid $itk_component(childsite) -row 0 -column 3 \
+ -rowspan 5 -columnspan 1 -sticky nsew
+ grid columnconfigure $_interior 0 -weight 1
+ grid columnconfigure $_interior 2 -weight 1
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _wPos
+#
+# Position the childsite to the west and all the other components
+# appropriately based on the individual "on" options.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::_wPos {} {
+ grid $itk_component(childsite) -row 0 -column 0 \
+ -rowspan 5 -columnspan 1 -sticky nsew
+
+ if {$itk_option(-filteron)} {
+ grid $itk_component(filter) -row 0 -column 1 \
+ -columnspan 3 -sticky ew
+ grid rowconfigure $_interior 1 -minsize 7
+ }
+
+ if {$itk_option(-dirson)} {
+ grid $itk_component(dirs) -row 2 -column 1 \
+ -columnspan 1 -sticky nsew
+ }
+ if {$itk_option(-fileson)} {
+ grid $itk_component(files) -row 2 -column 3 \
+ -columnspan 1 -sticky nsew
+ }
+ if {$itk_option(-dirson)} {
+ if {$itk_option(-fileson)} {
+ grid columnconfigure $_interior 2 -minsize 7
+ } else {
+ grid configure $itk_component(dirs) -columnspan 3 -column 1
+ }
+ } else {
+ if {$itk_option(-fileson)} {
+ grid configure $itk_component(files) -columnspan 3 -column 1
+ }
+ }
+
+ grid rowconfigure $_interior 2 -weight 1
+
+ if {$itk_option(-selectionon)} {
+ grid rowconfigure $_interior 3 -minsize 7
+ grid $itk_component(selection) -row 4 -column 1 \
+ -columnspan 3 -sticky ew
+ }
+
+ grid columnconfigure $_interior 1 -weight 1
+ grid columnconfigure $_interior 3 -weight 1
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _topPos
+#
+# Position the childsite below the filter but above the lists and
+# all the other components appropriately based on the individual
+# "on" options.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::_topPos {} {
+ if {$itk_option(-filteron)} {
+ grid $itk_component(filter) -row 0 -column 0 \
+ -columnspan 3 -sticky ew
+ }
+
+ grid $itk_component(childsite) -row 1 -column 0 \
+ -columnspan 3 -rowspan 1 -sticky nsew
+
+ if {$itk_option(-dirson)} {
+ grid $itk_component(dirs) -row 2 -column 0 -sticky nsew
+ }
+ if {$itk_option(-fileson)} {
+ grid $itk_component(files) -row 2 -column 2 -sticky nsew
+ }
+ if {$itk_option(-dirson)} {
+ if {$itk_option(-fileson)} {
+ grid columnconfigure $_interior 1 -minsize 7
+ } else {
+ grid configure $itk_component(dirs) -columnspan 3 -column 0
+ }
+ } else {
+ if {$itk_option(-fileson)} {
+ grid configure $itk_component(files) -columnspan 3 -column 0
+ }
+ }
+
+ grid rowconfigure $_interior 2 -weight 1
+
+ if {$itk_option(-selectionon)} {
+ grid rowconfigure $_interior 3 -minsize 7
+ grid $itk_component(selection) -row 4 -column 0 \
+ -columnspan 3 -sticky ew
+ }
+
+ grid columnconfigure $_interior 0 -weight 1
+ grid columnconfigure $_interior 2 -weight 1
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _centerPos
+#
+# Position the childsite between the lists and all the other
+# components appropriately based on the individual "on" options.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::_centerPos {} {
+ if {$itk_option(-filteron)} {
+ grid $itk_component(filter) -row 0 -column 0 \
+ -columnspan 3 -sticky ew
+ grid rowconfigure $_interior 1 -minsize 7
+ }
+
+ if {$itk_option(-dirson)} {
+ grid $itk_component(dirs) -row 2 -column 0 \
+ -columnspan 1 -sticky nsew
+ }
+ if {$itk_option(-fileson)} {
+ grid $itk_component(files) -row 2 -column 2 \
+ -columnspan 1 -sticky nsew
+ }
+ grid $itk_component(childsite) -row 2 \
+ -columnspan 1 -rowspan 1 -sticky nsew
+
+ if {$itk_option(-dirson)} {
+ if {$itk_option(-fileson)} {
+ grid configure $itk_component(childsite) -column 1
+ grid columnconfigure $_interior 0 -weight 1
+ grid columnconfigure $_interior 2 -weight 1
+
+ } else {
+ grid configure $itk_component(dirs) -columnspan 2 -column 0
+ grid configure $itk_component(childsite) -column 2
+ grid columnconfigure $_interior 0 -weight 1
+ grid columnconfigure $_interior 1 -weight 1
+ }
+ } else {
+ grid configure $itk_component(childsite) -column 0
+ if {$itk_option(-fileson)} {
+ grid configure $itk_component(files) -columnspan 2 \
+ -column 1
+ grid columnconfigure $_interior 1 -weight 1
+ grid columnconfigure $_interior 2 -weight 1
+ } else {
+ grid columnconfigure $_interior 0 -weight 1
+ }
+ }
+
+ grid rowconfigure $_interior 2 -weight 1
+
+ if {$itk_option(-selectionon)} {
+ grid rowconfigure $_interior 3 -minsize 7
+ grid $itk_component(selection) -row 4 -column 0 \
+ -columnspan 3 -sticky ew
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _bottomPos
+#
+# Position the childsite below the lists and above the selection
+# and all the other components appropriately based on the individual
+# "on" options.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectionbox::_bottomPos {} {
+ if {$itk_option(-filteron)} {
+ grid $itk_component(filter) -row 0 -column 0 \
+ -columnspan 3 -sticky ew
+ grid rowconfigure $_interior 1 -minsize 7
+ }
+
+ if {$itk_option(-dirson)} {
+ grid $itk_component(dirs) -row 2 -column 0 -sticky nsew
+ }
+ if {$itk_option(-fileson)} {
+ grid $itk_component(files) -row 2 -column 2 -sticky nsew
+ }
+ if {$itk_option(-dirson)} {
+ if {$itk_option(-fileson)} {
+ grid columnconfigure $_interior 1 -minsize 7
+ } else {
+ grid configure $itk_component(dirs) -columnspan 3 -column 0
+ }
+ } else {
+ if {$itk_option(-fileson)} {
+ grid configure $itk_component(files) -columnspan 3 -column 0
+ }
+ }
+ grid rowconfigure $_interior 2 -weight 1
+
+ grid $itk_component(childsite) -row 3 -column 0 \
+ -columnspan 3 -rowspan 1 -sticky nsew
+
+ if {$itk_option(-selectionon)} {
+ grid $itk_component(selection) -row 4 -column 0 \
+ -columnspan 3 -sticky ew
+ }
+
+ grid columnconfigure $_interior 0 -weight 1
+ grid columnconfigure $_interior 2 -weight 1
+}
diff --git a/itcl/iwidgets3.0.0/generic/fileselectiondialog.itk b/itcl/iwidgets3.0.0/generic/fileselectiondialog.itk
new file mode 100644
index 00000000000..0889e4a6c5c
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/fileselectiondialog.itk
@@ -0,0 +1,181 @@
+#
+# Fileselectiondialog
+# ----------------------------------------------------------------------
+# Implements a file selection box similar to the OSF/Motif standard
+# file selection dialog composite widget. The Fileselectiondialog is
+# derived from the Dialog class and is composed of a FileSelectionBox
+# with attributes set to manipulate the dialog buttons.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@spd.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Fileselectiondialog {
+ keep -activebackground -activerelief -background -borderwidth -cursor \
+ -elementborderwidth -foreground -highlightcolor -highlightthickness \
+ -insertbackground -insertborderwidth -insertofftime -insertontime \
+ -insertwidth -jump -labelfont -modality -selectbackground \
+ -selectborderwidth -textbackground -textfont
+}
+
+# ------------------------------------------------------------------
+# FILESELECTIONDIALOG
+# ------------------------------------------------------------------
+class iwidgets::Fileselectiondialog {
+ inherit iwidgets::Dialog
+
+ constructor {args} {}
+
+ public {
+ method childsite {}
+ method get {}
+ method filter {}
+ }
+
+ protected method _dbldir {}
+}
+
+#
+# Provide a lowercased access method for the Fileselectiondialog class.
+#
+proc ::iwidgets::fileselectiondialog {pathName args} {
+ uplevel ::iwidgets::Fileselectiondialog $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Fileselectiondialog.borderWidth 2 widgetDefault
+
+option add *Fileselectiondialog.title "File Selection Dialog" widgetDefault
+
+option add *Fileselectiondialog.width 350 widgetDefault
+option add *Fileselectiondialog.height 400 widgetDefault
+
+option add *Fileselectiondialog.master "." widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Fileselectiondialog::constructor {args} {
+ component hull configure -borderwidth 0
+ itk_option add hull.width hull.height
+
+ #
+ # Turn off pack propagation for the hull widget so the width
+ # and height options become active.
+ #
+ pack propagate $itk_component(hull) no
+
+ #
+ # Instantiate a file selection box widget.
+ #
+ itk_component add fsb {
+ iwidgets::Fileselectionbox $itk_interior.fsb -width 150 -height 150 \
+ -selectioncommand [code $this invoke] \
+ -selectdircommand [code $this default Apply] \
+ -selectfilecommand [code $this default OK]
+ } {
+ usual
+
+ keep -labelfont -childsitepos -directory -dirslabel \
+ -dirsearchcommand -dirson -fileslabel -fileson \
+ -filesearchcommand -filterlabel -filteron \
+ -filetype -invalid -mask -nomatchstring \
+ -selectionlabel -selectionon
+ }
+ grid $itk_component(fsb) -sticky nsew
+ grid rowconfigure $itk_interior 0 -weight 1
+ grid columnconfigure $itk_interior 0 -weight 1
+
+ $itk_component(fsb) component filter configure \
+ -focuscommand [code $this default Apply]
+ $itk_component(fsb) component selection configure \
+ -focuscommand [code $this default OK]
+ $itk_component(fsb) component dirs configure \
+ -dblclickcommand [code $this _dbldir]
+ $itk_component(fsb) component files configure \
+ -dblclickcommand [code $this invoke]
+
+ buttonconfigure Apply -text "Filter" \
+ -command [code $itk_component(fsb) filter]
+
+ set itk_interior [$itk_component(fsb) childsite]
+
+ hide Help
+
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: childsite
+#
+# Thinwrapped method of file selection box class.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectiondialog::childsite {} {
+ return [$itk_component(fsb) childsite]
+}
+
+# ------------------------------------------------------------------
+# METHOD: get
+#
+# Thinwrapped method of file selection box class.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectiondialog::get {} {
+ return [$itk_component(fsb) get]
+}
+
+# ------------------------------------------------------------------
+# METHOD: filter
+#
+# Thinwrapped method of file selection box class.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectiondialog::filter {} {
+ return [$itk_component(fsb) filter]
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _dbldir
+#
+# Double select in directory list. If the files list is on then
+# make the default button the filter and invoke. If not, just invoke.
+# ------------------------------------------------------------------
+body iwidgets::Fileselectiondialog::_dbldir {} {
+ if {$itk_option(-fileson)} {
+ default Apply
+ }
+
+ invoke
+}
+
diff --git a/itcl/iwidgets3.0.0/generic/finddialog.itk b/itcl/iwidgets3.0.0/generic/finddialog.itk
new file mode 100755
index 00000000000..b237153ac32
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/finddialog.itk
@@ -0,0 +1,488 @@
+#
+# Finddialog
+# ----------------------------------------------------------------------
+# This class implements a dialog for searching text. It prompts the
+# user for a search string and the method of searching which includes
+# case sensitive, regular expressions, backwards, and all.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
+#
+# @(#) RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1996 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Finddialog {
+ keep -background -cursor -foreground -selectcolor
+}
+
+# ------------------------------------------------------------------
+# IPRFINDDIALOG
+# ------------------------------------------------------------------
+class ::iwidgets::Finddialog {
+ inherit iwidgets::Dialogshell
+
+ constructor {args} {}
+
+ itk_option define -selectcolor selectColor Background {}
+ itk_option define -clearcommand clearCommand Command {}
+ itk_option define -matchcommand matchCommand Command {}
+ itk_option define -patternbackground patternBackground Background \#707070
+ itk_option define -patternforeground patternForeground Foreground White
+ itk_option define -searchbackground searchBackground Background \#c4c4c4
+ itk_option define -searchforeground searchForeground Foreground Black
+ itk_option define -textwidget textWidget TextWidget {}
+
+ public {
+ method clear {}
+ method find {}
+ }
+
+ protected {
+ method _get {setting}
+ method _textExists {}
+
+ common _optionValues ;# Current settings of check buttons.
+ common _searchPoint ;# Starting location for searches
+ common _matchLen ;# Matching pattern string length
+ }
+}
+
+#
+# Provide a lowercased access method for the ::finddialog class.
+#
+proc ::iwidgets::finddialog {pathName args} {
+ uplevel ::iwidgets::Finddialog $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Finddialog.title "Find" widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body ::iwidgets::Finddialog::constructor {args} {
+ #
+ # Add the find pattern entryfield.
+ #
+ itk_component add pattern {
+ iwidgets::Entryfield $itk_interior.pattern -labeltext "Find:"
+ }
+ bind [$itk_component(pattern) component entry] \
+ <Return> "[code $this invoke]; break"
+
+ #
+ # Add the find all checkbutton.
+ #
+ itk_component add all {
+ checkbutton $itk_interior.all \
+ -variable [scope _optionValues($this-all)] \
+ -text "All"
+ }
+
+ #
+ # Add the case consideration checkbutton.
+ #
+ itk_component add case {
+ checkbutton $itk_interior.case \
+ -variable [scope _optionValues($this-case)] \
+ -text "Consider Case"
+ }
+
+ #
+ # Add the regular expression checkbutton.
+ #
+ itk_component add regexp {
+ checkbutton $itk_interior.regexp \
+ -variable [scope _optionValues($this-regexp)] \
+ -text "Use Regular Expression"
+ }
+
+ #
+ # Add the find backwards checkbutton.
+ #
+ itk_component add backwards {
+ checkbutton $itk_interior.backwards \
+ -variable [scope _optionValues($this-backwards)] \
+ -text "Find Backwards"
+ }
+
+ #
+ # Add the find, clear, and close buttons, making find be the default.
+ #
+ add Find -text Find -command [code $this find]
+ add Clear -text Clear -command [code $this clear]
+ add Close -text Close -command [code $this deactivate 0]
+
+ default Find
+
+ #
+ # Use the grid to layout the components.
+ #
+ grid $itk_component(pattern) -row 0 -column 0 \
+ -padx 10 -pady 10 -columnspan 4 -sticky ew
+ grid $itk_component(all) -row 1 -column 0
+ grid $itk_component(case) -row 1 -column 1
+ grid $itk_component(regexp) -row 1 -column 2
+ grid $itk_component(backwards) -row 1 -column 3
+
+ grid columnconfigure $itk_interior 0 -weight 1
+ grid columnconfigure $itk_interior 1 -weight 1
+ grid columnconfigure $itk_interior 2 -weight 1
+ grid columnconfigure $itk_interior 3 -weight 1
+
+ #
+ # Initialize all the configuration options.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -clearcommand
+#
+# Specifies a command to be invoked following a clear operation.
+# The command is meant to be a means of notification that the
+# clear has taken place and allow other actions to take place such
+# as disabling a find again menu.
+# ------------------------------------------------------------------
+configbody iwidgets::Finddialog::clearcommand {}
+
+# ------------------------------------------------------------------
+# OPTION: -matchcommand
+#
+# Specifies a command to be invoked following a find operation.
+# The command is called with a match point as an argument. Should
+# a match not be found the match point is {}.
+# ------------------------------------------------------------------
+configbody iwidgets::Finddialog::matchcommand {}
+
+# ------------------------------------------------------------------
+# OPTION: -patternbackground
+#
+# Specifies the background color of the text matching the search
+# pattern. It may have any of the forms accepted by Tk_GetColor.
+# ------------------------------------------------------------------
+configbody iwidgets::Finddialog::patternbackground {}
+
+# ------------------------------------------------------------------
+# OPTION: -patternforeground
+#
+# Specifies the foreground color of the pattern matching a search
+# operation. It may have any of the forms accepted by Tk_GetColor.
+# ------------------------------------------------------------------
+configbody iwidgets::Finddialog::patternforeground {}
+
+# ------------------------------------------------------------------
+# OPTION: -searchforeground
+#
+# Specifies the foreground color of the line containing the matching
+# pattern from a search operation. It may have any of the forms
+# accepted by Tk_GetColor.
+# ------------------------------------------------------------------
+configbody iwidgets::Finddialog::searchforeground {}
+
+# ------------------------------------------------------------------
+# OPTION: -searchbackground
+#
+# Specifies the background color of the line containing the matching
+# pattern from a search operation. It may have any of the forms
+# accepted by Tk_GetColor.
+# ------------------------------------------------------------------
+configbody iwidgets::Finddialog::searchbackground {}
+
+# ------------------------------------------------------------------
+# OPTION: -textwidget
+#
+# Specifies the scrolledtext or text widget to be searched.
+# ------------------------------------------------------------------
+configbody iwidgets::Finddialog::textwidget {
+ if {$itk_option(-textwidget) != {}} {
+ set _searchPoint($itk_option(-textwidget)) 1.0
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: clear
+#
+# Clear the pattern entryfield and the indicators.
+# ------------------------------------------------------------------
+body ::iwidgets::Finddialog::clear {} {
+ $itk_component(pattern) clear
+
+ if {[_textExists]} {
+ set _searchPoint($itk_option(-textwidget)) 1.0
+
+ $itk_option(-textwidget) tag remove search-line 1.0 end
+ $itk_option(-textwidget) tag remove search-pattern 1.0 end
+ }
+
+ if {$itk_option(-clearcommand) != {}} {
+ $itk_option(-clearcommand)
+ }
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: find
+#
+# Search for a specific text string in the text widget given by
+# the -textwidget option. Should this option not be set to an
+# existing widget, then a quick exit is made.
+# ------------------------------------------------------------------
+body ::iwidgets::Finddialog::find {} {
+ if {! [_textExists]} {
+ return
+ }
+
+ #
+ # Clear any existing indicators in the text widget.
+ #
+ $itk_option(-textwidget) tag remove search-line 1.0 end
+ $itk_option(-textwidget) tag remove search-pattern 1.0 end
+
+ #
+ # Make sure the search pattern isn't just blank. If so, skip this.
+ #
+ set pattern [_get pattern]
+
+ if {[string trim $pattern] == ""} {
+ return
+ }
+
+ #
+ # After clearing out any old highlight indicators from a previous
+ # search, we'll be building our search command piece-meal based on
+ # the current settings of the checkbuttons in the find dialog. The
+ # first we'll add is a variable to catch the count of the length
+ # of the string matching the pattern.
+ #
+ set precmd "$itk_option(-textwidget) search \
+ -count [list [scope _matchLen($this)]]"
+
+ if {! [_get case]} {
+ append precmd " -nocase"
+ }
+
+ if {[_get regexp]} {
+ append precmd " -regexp"
+ } else {
+ append precmd " -exact"
+ }
+
+ #
+ # If we are going to find all matches, then the start point for
+ # the search will be the beginning of the text; otherwise, we'll
+ # use the last known starting point +/- a character depending on
+ # the direction.
+ #
+ if {[_get all]} {
+ set _searchPoint($itk_option(-textwidget)) 1.0
+ } else {
+ if {[_get backwards]} {
+ append precmd " -backwards"
+ } else {
+ append precmd " -forwards"
+ }
+ }
+
+ #
+ # Get the pattern to be matched and add it to the search command.
+ # Since it may contain embedded spaces, we'll wrap it in a list.
+ #
+ append precmd " [list $pattern]"
+
+ #
+ # If the search is for all matches, then we'll be performing the
+ # search until no more matches are found; otherwise, we'll break
+ # out of the loop after one search.
+ #
+ while {1} {
+ if {[_get all]} {
+ set postcmd " $_searchPoint($itk_option(-textwidget)) end"
+
+ } else {
+ set postcmd " $_searchPoint($itk_option(-textwidget))"
+ }
+
+ #
+ # Create the final search command out of the pre and post parts
+ # and evaluate it which returns the location of the matching string.
+ #
+ set cmd {}
+ append cmd $precmd $postcmd
+
+ if {[catch {eval $cmd} matchPoint] != 0} {
+ set _searchPoint($itk_option(-textwidget)) 1.0
+ return {}
+ }
+
+ #
+ # If a match exists, then we'll make this spot be the new starting
+ # position. Then we'll tag the line and the pattern in the line.
+ # The foreground and background settings will lite these positions
+ # in the text widget up.
+ #
+ if {$matchPoint != {}} {
+ set _searchPoint($itk_option(-textwidget)) $matchPoint
+
+ $itk_option(-textwidget) tag add search-line \
+ "$_searchPoint($itk_option(-textwidget)) linestart" \
+ "$_searchPoint($itk_option(-textwidget))"
+ $itk_option(-textwidget) tag add search-line \
+ "$_searchPoint($itk_option(-textwidget)) + \
+ $_matchLen($this) chars" \
+ "$_searchPoint($itk_option(-textwidget)) lineend"
+ $itk_option(-textwidget) tag add search-pattern \
+ $_searchPoint($itk_option(-textwidget)) \
+ "$_searchPoint($itk_option(-textwidget)) + \
+ $_matchLen($this) chars"
+ }
+
+ #
+ # Set the search point for the next time through to be one
+ # character more or less from the current search point based
+ # on the direction.
+ #
+ if {[_get all] || ! [_get backwards]} {
+ set _searchPoint($itk_option(-textwidget)) \
+ [$itk_option(-textwidget) index \
+ "$_searchPoint($itk_option(-textwidget)) + 1c"]
+ } else {
+ set _searchPoint($itk_option(-textwidget)) \
+ [$itk_option(-textwidget) index \
+ "$_searchPoint($itk_option(-textwidget)) - 1c"]
+ }
+
+ #
+ # If this isn't a find all operation or we didn't get a match, exit.
+ #
+ if {(! [_get all]) || ($matchPoint == {})} {
+ break
+ }
+ }
+
+ #
+ # Configure the colors for the search-line and search-pattern.
+ #
+ $itk_option(-textwidget) tag configure search-line \
+ -foreground $itk_option(-searchforeground)
+ $itk_option(-textwidget) tag configure search-line \
+ -background $itk_option(-searchbackground)
+ $itk_option(-textwidget) tag configure search-pattern \
+ -background $itk_option(-patternbackground)
+ $itk_option(-textwidget) tag configure search-pattern \
+ -foreground $itk_option(-patternforeground)
+
+ #
+ # Adjust the view to be the last matched position.
+ #
+ if {$matchPoint != {}} {
+ $itk_option(-textwidget) see $matchPoint
+ }
+
+ #
+ # There may be multiple matches of the pattern on a single line,
+ # so we'll set the tag priorities such that the pattern tag is higher.
+ #
+ $itk_option(-textwidget) tag raise search-pattern search-line
+
+ #
+ # If a match command is defined, then call it with the match point.
+ #
+ if {$itk_option(-matchcommand) != {}} {
+ $itk_option(-matchcommand) $matchPoint
+ }
+
+ #
+ # Return the match point to the caller so they know if we found
+ # anything and if so where
+ #
+ return $matchPoint
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _get setting
+#
+# Get the current value for the pattern, case, regexp, or backwards.
+# ------------------------------------------------------------------
+body ::iwidgets::Finddialog::_get {setting} {
+ switch $setting {
+ pattern {
+ return [$itk_component(pattern) get]
+ }
+ case {
+ return $_optionValues($this-case)
+ }
+ regexp {
+ return $_optionValues($this-regexp)
+ }
+ backwards {
+ return $_optionValues($this-backwards)
+ }
+ all {
+ return $_optionValues($this-all)
+ }
+ default {
+ error "bad get setting: \"$setting\", should be pattern,\
+ case, regexp, backwards, or all"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _textExists
+#
+# Check the validity of the text widget option. Does it exist and
+# is it of the class Text or Scrolledtext.
+# ------------------------------------------------------------------
+body ::iwidgets::Finddialog::_textExists {} {
+ if {$itk_option(-textwidget) == {}} {
+ return 0
+ }
+
+ if {! [winfo exists $itk_option(-textwidget)]} {
+ error "bad finddialog text widget value: \"$itk_option(-textwidget)\",\
+ the widget doesn't exist"
+ }
+
+ if {([winfo class $itk_option(-textwidget)] != "Text") &&
+ ([itcl::find objects -isa iwidgets::Scrolledtext *::$itk_option(-textwidget)] == "")} {
+ error "bad finddialog text widget value: \"$itk_option(-textwidget)\",\
+ must be of the class Text or based on Scrolledtext"
+ }
+
+ return 1
+}
diff --git a/itcl/iwidgets3.0.0/generic/hierarchy.itk b/itcl/iwidgets3.0.0/generic/hierarchy.itk
new file mode 100644
index 00000000000..79bad190b50
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/hierarchy.itk
@@ -0,0 +1,1654 @@
+# Hierarchy
+# ----------------------------------------------------------------------
+# Hierarchical data viewer. Manages a list of nodes that can be
+# expanded or collapsed. Individual nodes can be highlighted.
+# Clicking with the right mouse button on any item brings up a
+# special item menu. Clicking on the background area brings up
+# a different popup menu.
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan
+# Bell Labs Innovations for Lucent Technologies
+# mmclennan@lucent.com
+#
+# Mark L. Ulferts
+# DSC Communications
+# mulferts@austin.dsccc.com
+#
+# RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1996 Lucent Technologies
+# ======================================================================
+# Permission to use, copy, modify, and distribute this software and its
+# documentation for any purpose and without fee is hereby granted,
+# provided that the above copyright notice appear in all copies and that
+# both that the copyright notice and warranty disclaimer appear in
+# supporting documentation, and that the names of Lucent Technologies
+# any of their entities not be used in advertising or publicity
+# pertaining to distribution of the software without specific, written
+# prior permission.
+#
+# Lucent Technologies disclaims all warranties with regard to this
+# software, including all implied warranties of merchantability and
+# fitness. In no event shall Lucent Technologies be liable for any
+# special, indirect or consequential damages or any damages whatsoever
+# resulting from loss of use, data or profits, whether in an action of
+# contract, negligence or other tortuous action, arising out of or in
+# connection with the use or performance of this software.
+#
+# ----------------------------------------------------------------------
+# Copyright (c) 1996 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Hierarchy {
+ keep -cursor -textfont -font
+ keep -background -foreground -textbackground
+ keep -selectbackground -selectforeground
+}
+
+# ------------------------------------------------------------------
+# HIERARCHY
+# ------------------------------------------------------------------
+class iwidgets::Hierarchy {
+ inherit iwidgets::Scrolledwidget
+
+ constructor {args} {}
+
+ destructor {}
+
+ itk_option define -alwaysquery alwaysQuery AlwaysQuery 0
+ itk_option define -closedicon closedIcon Icon {}
+ itk_option define -expanded expanded Expanded 0
+ itk_option define -filter filter Filter 0
+ itk_option define -font font Font \
+ -*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*
+ itk_option define -height height Height 0
+ itk_option define -iconcommand iconCommand Command {}
+ itk_option define -markbackground markBackground Foreground #a0a0a0
+ itk_option define -markforeground markForeground Background Black
+ itk_option define -nodeicon nodeIcon Icon {}
+ itk_option define -openicon openIcon Icon {}
+ itk_option define -querycommand queryCommand Command {}
+ itk_option define -selectcommand selectCommand Command {}
+ itk_option define -selectbackground selectBackground Foreground #c3c3c3
+ itk_option define -selectforeground selectForeground Background Black
+ itk_option define -visibleitems visibleItems VisibleItems 80x24
+ itk_option define -width width Width 0
+
+ public method clear {}
+ public method collapse {node}
+ public method current {}
+ public method draw {{when -now}}
+ public method expand {node}
+ public method mark {op args}
+ public method prune {node}
+ public method refresh {node}
+ public method selection {op args}
+ public method toggle {node}
+
+ public method bbox {index}
+ public method compare {index1 op index2}
+ public method debug {args} {eval $args}
+ public method delete {first {last {}}}
+ public method dlineinfo {index}
+ public method dump {args}
+ public method get {index1 {index2 {}}}
+ public method index {index}
+ public method insert {args}
+ public method scan {option args}
+ public method search {args}
+ public method see {index}
+ public method tag {op args}
+ public method window {option args}
+ public method xview {args}
+ public method yview {args}
+
+ protected method _contents {uid}
+ protected method _iconSelect {node icon}
+ protected method _post {x y}
+ protected method _drawLevel {node indent}
+ protected method _select {x y}
+ protected method _deselectSubNodes {uid}
+ protected method _deleteNodeInfo {uid}
+ protected method _getParent {uid}
+ protected method _getHeritage {uid}
+ protected method _isInternalTag {tag}
+
+ private variable _filterCode "" ;# Compact view flag.
+ private variable _hcounter 0 ;# Counter for hierarchy icons
+ private variable _icons ;# Array of user icons by uid
+ private variable _images ;# Array of our icons by uid
+ private variable _indents ;# Array of indentation by uid
+ private variable _marked ;# Array of marked nodes by uid
+ private variable _markers "" ;# List of markers for level being drawn
+ private variable _nodes ;# List of subnodes by uid
+ private variable _pending "" ;# Pending draw flag
+ private variable _posted "" ;# List of tags at posted menu position
+ private variable _selected ;# Array of selected nodes by uid
+ private variable _tags ;# Array of user tags by uid
+ private variable _text ;# Array of displayed text by uid
+ private variable _states ;# Array of selection state by uid
+ private variable _ucounter 0 ;# Counter for user icons
+}
+
+#
+# Provide a lowercased access method for the Hierarchy class.
+#
+proc ::iwidgets::hierarchy {pathName args} {
+ uplevel ::iwidgets::Hierarchy $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Hierarchy.menuCursor arrow widgetDefault
+option add *Hierarchy.labelPos n widgetDefault
+option add *Hierarchy.tabs 30 widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Hierarchy::constructor {args} {
+ itk_option remove iwidgets::Labeledwidget::state
+
+ #
+ # Our -width and -height options are slightly different than
+ # those implemented by our base class, so we're going to
+ # remove them and redefine our own.
+ #
+ itk_option remove iwidgets::Scrolledwidget::width
+ itk_option remove iwidgets::Scrolledwidget::height
+
+ #
+ # Create a clipping frame which will provide the border for
+ # relief display.
+ #
+ itk_component add clipper {
+ frame $itk_interior.clipper
+ } {
+ usual
+
+ keep -borderwidth -relief -highlightthickness -highlightcolor
+ rename -highlightbackground -background background Background
+ }
+ grid $itk_component(clipper) -row 0 -column 0 -sticky nsew
+ grid rowconfigure $_interior 0 -weight 1
+ grid columnconfigure $_interior 0 -weight 1
+
+ #
+ # Create a text widget for displaying our hierarchy.
+ #
+ itk_component add list {
+ text $itk_component(clipper).list -wrap none -cursor center_ptr \
+ -state disabled -width 1 -height 1 \
+ -xscrollcommand \
+ [code $this _scrollWidget $itk_interior.horizsb] \
+ -yscrollcommand \
+ [code $this _scrollWidget $itk_interior.vertsb] \
+ -borderwidth 0 -highlightthickness 0
+ } {
+ usual
+
+ keep -spacing1 -spacing2 -spacing3 -tabs
+ rename -font -textfont textFont Font
+ rename -background -textbackground textBackground Background
+ ignore -highlightthickness -highlightcolor
+ ignore -insertbackground -insertborderwidth
+ ignore -insertontime -insertofftime -insertwidth
+ ignore -selectborderwidth
+ ignore -borderwidth
+ }
+ grid $itk_component(list) -row 0 -column 0 -sticky nsew
+ grid rowconfigure $itk_component(clipper) 0 -weight 1
+ grid columnconfigure $itk_component(clipper) 0 -weight 1
+
+ #
+ # Configure the command on the vertical scroll bar in the base class.
+ #
+ $itk_component(vertsb) configure \
+ -command [code $itk_component(list) yview]
+
+ #
+ # Configure the command on the horizontal scroll bar in the base class.
+ #
+ $itk_component(horizsb) configure \
+ -command [code $itk_component(list) xview]
+
+ #
+ # Configure our text component's tab settings for twenty levels.
+ #
+ set tabs ""
+ for {set i 1} {$i < 20} {incr i} {
+ lappend tabs [expr $i*12+4]
+ }
+ $itk_component(list) configure -tabs $tabs
+
+ #
+ # Add popup menus that can be configured by the user to add
+ # new functionality.
+ #
+ itk_component add itemMenu {
+ menu $itk_component(list).itemmenu -tearoff 0
+ } {
+ usual
+ ignore -tearoff
+ rename -cursor -menucursor menuCursor Cursor
+ }
+
+ itk_component add bgMenu {
+ menu $itk_component(list).bgmenu -tearoff 0
+ } {
+ usual
+ ignore -tearoff
+ rename -cursor -menucursor menuCursor Cursor
+ }
+
+ #
+ # Adjust the bind tags to remove the class bindings. Also, add
+ # bindings for mouse button 1 to do selection and button 3 to
+ # display a popup.
+ #
+ bindtags $itk_component(list) [list $itk_component(list) . all]
+
+ bind $itk_component(list) <ButtonPress-1> \
+ [code $this _select %x %y]
+
+ bind $itk_component(list) <ButtonPress-3> \
+ [code $this _post %x %y]
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# DESTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Hierarchy::destructor {} {
+ if {$_pending != ""} {
+ after cancel $_pending
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -font
+#
+# Font used for text in the list.
+# ------------------------------------------------------------------
+configbody iwidgets::Hierarchy::font {
+ $itk_component(list) tag configure info \
+ -font $itk_option(-font) -spacing1 6
+}
+
+# ------------------------------------------------------------------
+# OPTION: -selectbackground
+#
+# Background color scheme for selected nodes.
+# ------------------------------------------------------------------
+configbody iwidgets::Hierarchy::selectbackground {
+ $itk_component(list) tag configure hilite \
+ -background $itk_option(-selectbackground)
+}
+
+# ------------------------------------------------------------------
+# OPTION: -selectforeground
+#
+# Foreground color scheme for selected nodes.
+# ------------------------------------------------------------------
+configbody iwidgets::Hierarchy::selectforeground {
+ $itk_component(list) tag configure hilite \
+ -foreground $itk_option(-selectforeground)
+}
+
+# ------------------------------------------------------------------
+# OPTION: -markbackground
+#
+# Background color scheme for marked nodes.
+# ------------------------------------------------------------------
+configbody iwidgets::Hierarchy::markbackground {
+ $itk_component(list) tag configure lowlite \
+ -background $itk_option(-markbackground)
+}
+
+# ------------------------------------------------------------------
+# OPTION: -markforeground
+#
+# Foreground color scheme for marked nodes.
+# ------------------------------------------------------------------
+configbody iwidgets::Hierarchy::markforeground {
+ $itk_component(list) tag configure lowlite \
+ -foreground $itk_option(-markforeground)
+}
+
+# ------------------------------------------------------------------
+# OPTION: -querycommand
+#
+# Command executed to query the contents of each node. If this
+# command contains "%n", it is replaced with the name of the desired
+# node. In its simpilest form it should return the children of the
+# given node as a list which will be depicted in the display.
+#
+# Since the names of the children are used as tags in the underlying
+# text widget, each child must be unique in the hierarchy. Due to
+# the unique requirement, the nodes shall be reffered to as uids
+# or uid in the singular sense.
+#
+# {uid [uid ...]}
+#
+# where uid is a unique id and primary key for the hierarchy entry
+#
+# Should the unique requirement pose a problem, the list returned
+# can take on another more extended form which enables the
+# association of text to be displayed with the uids. The uid must
+# still be unique, but the text does not have to obey the unique
+# rule. In addition, the format also allows the specification of
+# additional tags to be used on the same entry in the hierarchy
+# as the uid and additional icons to be displayed just before
+# the node. The tags and icons are considered to be the property of
+# the user in that the hierarchy widget will not depend on any of
+# their values.
+#
+# {{uid [text [tags [icons]]]} {uid [text [tags [icons]]]} ...}
+#
+# where uid is a unique id and primary key for the hierarchy entry
+# text is the text to be displayed for this uid
+# tags is a list of user tags to be applied to the entry
+# icons is a list of icons to be displayed in front of the text
+#
+# The hierarchy widget does a look ahead from each node to determine
+# if the node has a children. This can be cost some performace with
+# large hierarchies. User's can avoid this by providing a hint in
+# the user tags. A tag of "leaf" or "branch" tells the hierarchy
+# widget the information it needs to know thereby avoiding the look
+# ahead operation.
+# ------------------------------------------------------------------
+configbody iwidgets::Hierarchy::querycommand {
+ clear
+ draw -eventually
+}
+
+# ------------------------------------------------------------------
+# OPTION: -selectcommand
+#
+# Command executed to select an item in the list. If this command
+# contains "%n", it is replaced with the name of the selected node.
+# If it contains a "%s", it is replaced with a boolean indicator of
+# the node's current selection status, where a value of 1 denotes
+# that the node is currently selected and 0 that it is not.
+# ------------------------------------------------------------------
+configbody iwidgets::Hierarchy::selectcommand {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -iconcommand
+#
+# Command executed upon selection of user icons. If this command
+# contains "%n", it is replaced with the name of the node the icon
+# belongs to. Should it contain "%i" then the icon name is
+# substituted.
+# ------------------------------------------------------------------
+configbody iwidgets::Hierarchy::iconcommand {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -alwaysquery
+#
+# Boolean flag which tells the hierarchy widget weather or not
+# each refresh of the display should be via a new query using
+# the -querycommand option or use the values previous found the
+# last time the query was made.
+# ------------------------------------------------------------------
+configbody iwidgets::Hierarchy::alwaysquery {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -filter
+#
+# When true only the branch nodes and selected items are displayed.
+# This gives a compact view of important items.
+# ------------------------------------------------------------------
+configbody iwidgets::Hierarchy::filter {
+ switch -- $itk_option(-filter) {
+ 1 - true - yes - on {
+ set newCode {set display [info exists _selected($child)]}
+ }
+ 0 - false - no - off {
+ set newCode {set display 1}
+ }
+ default {
+ error "bad filter option \"$itk_option(-filter)\":\
+ should be boolean"
+ }
+ }
+ if {$newCode != $_filterCode} {
+ set _filterCode $newCode
+ draw -eventually
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -expanded
+#
+# When true, the hierarchy will be completely expanded when it
+# is first displayed. A fresh display can be triggered by
+# resetting the -querycommand option.
+# ------------------------------------------------------------------
+configbody iwidgets::Hierarchy::expanded {
+ switch -- $itk_option(-expanded) {
+ 1 - true - yes - on {
+ ;# okay
+ }
+ 0 - false - no - off {
+ ;# okay
+ }
+ default {
+ error "bad expanded option \"$itk_option(-expanded)\":\
+ should be boolean"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -openicon
+#
+# Specifies the open icon image to be used in the hierarchy. Should
+# one not be provided, then one will be generated, pixmap if
+# possible, bitmap otherwise.
+# ------------------------------------------------------------------
+configbody iwidgets::Hierarchy::openicon {
+ if {$itk_option(-openicon) == {}} {
+ if {[lsearch [image names] openFolder] == -1} {
+ if {[lsearch [image types] pixmap] != -1} {
+ image create pixmap openFolder -data {
+ /* XPM */
+ static char * dir_opened [] = {
+ "16 16 4 1",
+ /* colors */
+ ". c grey85 m white g4 grey90",
+ "b c black m black g4 black",
+ "y c yellow m white g4 grey80",
+ "g c grey70 m white g4 grey70",
+ /* pixels */
+ "................",
+ "................",
+ "................",
+ "..bbbb..........",
+ ".bggggb.........",
+ "bggggggbbbbbbb..",
+ "bggggggggggggb..",
+ "bgbbbbbbbbbbbbbb",
+ "bgbyyyyyyyyyyybb",
+ "bbyyyyyyyyyyyyb.",
+ "bbyyyyyyyyyyybb.",
+ "byyyyyyyyyyyyb..",
+ "bbbbbbbbbbbbbb..",
+ "................",
+ "................",
+ "................"};
+ }
+ } else {
+ image create bitmap openFolder -data {
+ #define open_width 16
+ #define open_height 16
+ static char open_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x3c, 0x00, 0x42, 0x00,
+ 0x81, 0x3f, 0x01, 0x20, 0xf9, 0xff, 0x0d, 0xc0,
+ 0x07, 0x40, 0x03, 0x60, 0x01, 0x20, 0x01, 0x30,
+ 0xff, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+ }
+ }
+
+ set itk_option(-openicon) openFolder
+ }
+
+ } else {
+ if {[lsearch [image names] $itk_option(-openicon)] == -1} {
+ error "bad openicon option \"$itk_option(-openicon)\":\
+ should be an existing image"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -closedicon
+#
+# Specifies the closed icon image to be used in the hierarchy.
+# Should one not be provided, then one will be generated, pixmap if
+# possible, bitmap otherwise.
+# ------------------------------------------------------------------
+configbody iwidgets::Hierarchy::closedicon {
+ if {$itk_option(-closedicon) == {}} {
+ if {[lsearch [image names] closedFolder] == -1} {
+ if {[lsearch [image types] pixmap] != -1} {
+ image create pixmap closedFolder -data {
+ /* XPM */
+ static char *dir_closed[] = {
+ "16 16 3 1",
+ ". c grey85 m white g4 grey90",
+ "b c black m black g4 black",
+ "y c yellow m white g4 grey80",
+ "................",
+ "................",
+ "................",
+ "..bbbb..........",
+ ".byyyyb.........",
+ "bbbbbbbbbbbbbb..",
+ "byyyyyyyyyyyyb..",
+ "byyyyyyyyyyyyb..",
+ "byyyyyyyyyyyyb..",
+ "byyyyyyyyyyyyb..",
+ "byyyyyyyyyyyyb..",
+ "byyyyyyyyyyyyb..",
+ "bbbbbbbbbbbbbb..",
+ "................",
+ "................",
+ "................"};
+ }
+ } else {
+ image create bitmap closedFolder -data {
+ #define closed_width 16
+ #define closed_height 16
+ static char closed_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x78, 0x00, 0x84, 0x00,
+ 0xfe, 0x7f, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40,
+ 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40,
+ 0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+ }
+ }
+
+ set itk_option(-closedicon) closedFolder
+ }
+
+ } else {
+ if {[lsearch [image names] $itk_option(-closedicon)] == -1} {
+ error "bad closedicon option \"$itk_option(-closedicon)\":\
+ should be an existing image"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -nodeicon
+#
+# Specifies the node icon image to be used in the hierarchy. Should
+# one not be provided, then one will be generated, pixmap if
+# possible, bitmap otherwise.
+# ------------------------------------------------------------------
+configbody iwidgets::Hierarchy::nodeicon {
+ if {$itk_option(-nodeicon) == {}} {
+ if {[lsearch [image names] nodeFolder] == -1} {
+ if {[lsearch [image types] pixmap] != -1} {
+ image create pixmap nodeFolder -data {
+ /* XPM */
+ static char *dir_node[] = {
+ "16 16 3 1",
+ ". c grey85 m white g4 grey90",
+ "b c black m black g4 black",
+ "y c yellow m white g4 grey80",
+ "................",
+ "................",
+ "................",
+ "...bbbbbbbbbbb..",
+ "..bybyyyyyyyyb..",
+ ".byybyyyyyyyyb..",
+ "byyybyyyyyyyyb..",
+ "bbbbbyyyyyyyyb..",
+ "byyyyyyyyyyyyb..",
+ "byyyyyyyyyyyyb..",
+ "byyyyyyyyyyyyb..",
+ "byyyyyyyyyyyyb..",
+ "bbbbbbbbbbbbbb..",
+ "................",
+ "................",
+ "................"};
+ }
+ } else {
+ image create bitmap nodeFolder -data {
+ #define node_width 16
+ #define node_height 16
+ static char node_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0xe0, 0x7f, 0x50, 0x40,
+ 0x48, 0x40, 0x44, 0x40, 0x42, 0x40, 0x7e, 0x40,
+ 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40,
+ 0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+ }
+ }
+
+ set itk_option(-nodeicon) nodeFolder
+ }
+
+ } else {
+ if {[lsearch [image names] $itk_option(-nodeicon)] == -1} {
+ error "bad nodeicon option \"$itk_option(-nodeicon)\":\
+ should be an existing image"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -width
+#
+# Specifies the width of the hierarchy widget as an entire unit.
+# The value may be specified in any of the forms acceptable to
+# Tk_GetPixels. Any additional space needed to display the other
+# components such as labels, margins, and scrollbars force the text
+# to be compressed. A value of zero along with the same value for
+# the height causes the value given for the visibleitems option
+# to be applied which administers geometry constraints in a different
+# manner.
+# ------------------------------------------------------------------
+configbody iwidgets::Hierarchy::width {
+ if {$itk_option(-width) != 0} {
+ set shell [lindex [grid info $itk_component(clipper)] 1]
+
+ #
+ # Due to a bug in the tk4.2 grid, we have to check the
+ # propagation before setting it. Setting it to the same
+ # value it already is will cause it to toggle.
+ #
+ if {[grid propagate $shell]} {
+ grid propagate $shell no
+ }
+
+ $itk_component(list) configure -width 1
+ $shell configure \
+ -width [winfo pixels $shell $itk_option(-width)]
+ } else {
+ configure -visibleitems $itk_option(-visibleitems)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -height
+#
+# Specifies the height of the hierarchy widget as an entire unit.
+# The value may be specified in any of the forms acceptable to
+# Tk_GetPixels. Any additional space needed to display the other
+# components such as labels, margins, and scrollbars force the text
+# to be compressed. A value of zero along with the same value for
+# the width causes the value given for the visibleitems option
+# to be applied which administers geometry constraints in a different
+# manner.
+# ------------------------------------------------------------------
+configbody iwidgets::Hierarchy::height {
+ if {$itk_option(-height) != 0} {
+ set shell [lindex [grid info $itk_component(clipper)] 1]
+
+ #
+ # Due to a bug in the tk4.2 grid, we have to check the
+ # propagation before setting it. Setting it to the same
+ # value it already is will cause it to toggle.
+ #
+ if {[grid propagate $shell]} {
+ grid propagate $shell no
+ }
+
+ $itk_component(list) configure -height 1
+ $shell configure \
+ -height [winfo pixels $shell $itk_option(-height)]
+ } else {
+ configure -visibleitems $itk_option(-visibleitems)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -visibleitems
+#
+# Specified the widthxheight in characters and lines for the text.
+# This option is only administered if the width and height options
+# are both set to zero, otherwise they take precedence. With the
+# visibleitems option engaged, geometry constraints are maintained
+# only on the text. The size of the other components such as
+# labels, margins, and scroll bars, are additive and independent,
+# effecting the overall size of the scrolled text. In contrast,
+# should the width and height options have non zero values, they
+# are applied to the scrolled text as a whole. The text is
+# compressed or expanded to maintain the geometry constraints.
+# ------------------------------------------------------------------
+configbody iwidgets::Hierarchy::visibleitems {
+ if {[regexp {^[0-9]+x[0-9]+$} $itk_option(-visibleitems)]} {
+ if {($itk_option(-width) == 0) && \
+ ($itk_option(-height) == 0)} {
+ set chars [lindex [split $itk_option(-visibleitems) x] 0]
+ set lines [lindex [split $itk_option(-visibleitems) x] 1]
+
+ set shell [lindex [grid info $itk_component(clipper)] 1]
+
+ #
+ # Due to a bug in the tk4.2 grid, we have to check the
+ # propagation before setting it. Setting it to the same
+ # value it already is will cause it to toggle.
+ #
+ if {! [grid propagate $shell]} {
+ grid propagate $shell yes
+ }
+
+ $itk_component(list) configure -width $chars -height $lines
+ }
+
+ } else {
+ error "bad visibleitems option\
+ \"$itk_option(-visibleitems)\": should be\
+ widthxheight"
+ }
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHODS
+# ------------------------------------------------------------------
+
+# ----------------------------------------------------------------------
+# PUBLIC METHOD: clear
+#
+# Removes all items from the display including all tags and icons.
+# The display will remain empty until the -filter or -querycommand
+# options are set.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::clear {} {
+ $itk_component(list) configure -state normal -cursor watch
+ $itk_component(list) delete 1.0 end
+ $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
+
+ catch {unset _nodes}
+ catch {unset _text}
+ catch {unset _tags}
+ catch {unset _icons}
+ catch {unset _states}
+ catch {unset _images}
+ catch {unset _indents}
+
+ return
+}
+
+# ----------------------------------------------------------------------
+# PUBLIC METHOD: selection option ?uid uid...?
+#
+# Handles all operations controlling selections in the hierarchy.
+# Selections may be cleared, added, removed, or queried. The add and
+# remove options accept a series of unique ids.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::selection {op args} {
+ switch -- $op {
+ clear {
+ $itk_component(list) tag remove hilite 1.0 end
+ catch {unset _selected}
+ return
+ }
+ add {
+ foreach node $args {
+ set _selected($node) 1
+ catch {
+ $itk_component(list) tag add hilite \
+ "$node.first" "$node.last"
+ }
+ }
+ }
+ remove {
+ foreach node $args {
+ catch {
+ unset _selected($node)
+ $itk_component(list) tag remove hilite \
+ "$node.first" "$node.last"
+ }
+ }
+ }
+ get {
+ return [array names _selected]
+ }
+ default {
+ error "bad selection operation \"$op\":\
+ should be add, remove, clear or get"
+ }
+ }
+}
+
+# ----------------------------------------------------------------------
+# PUBLIC METHOD: mark option ?arg arg...?
+#
+# Handles all operations controlling marks in the hierarchy. Marks may
+# be cleared, added, removed, or queried. The add and remove options
+# accept a series of unique ids.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::mark {op args} {
+ switch -- $op {
+ clear {
+ $itk_component(list) tag remove lowlite 1.0 end
+ catch {unset _marked}
+ return
+ }
+ add {
+ foreach node $args {
+ set _marked($node) 1
+ catch {
+ $itk_component(list) tag add lowlite \
+ "$node.first" "$node.last"
+ }
+ }
+ }
+ remove {
+ foreach node $args {
+ catch {
+ unset _marked($node)
+ $itk_component(list) tag remove lowlite \
+ "$node.first" "$node.last"
+ }
+ }
+ }
+ get {
+ return [array names _marked]
+ }
+ default {
+ error "bad mark operation \"$op\":\
+ should be add, remove, clear or get"
+ }
+ }
+}
+
+# ----------------------------------------------------------------------
+# PUBLIC METHOD: current
+#
+# Returns the node that was most recently selected by the right mouse
+# button when the item menu was posted. Usually used by the code
+# in the item menu to figure out what item is being manipulated.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::current {} {
+ return $_posted
+}
+
+# ----------------------------------------------------------------------
+# PUBLIC METHOD: expand node
+#
+# Expands the hierarchy beneath the specified node. Since this can take
+# a moment for large hierarchies, the cursor will be changed to a watch
+# during the expansion.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::expand {node} {
+ if {! [info exists _states($node)]} {
+ error "bad expand node argument: \"$node\", the node doesn't exist"
+ }
+
+ if {!$_states($node) && \
+ (([lsearch $_tags($node) branch] != -1) || \
+ ([llength [_contents $node]] > 0))} {
+ $itk_component(list) configure -state normal -cursor watch
+ update
+
+ #
+ # Get the indentation level for the node.
+ #
+ set indent $_indents($node)
+
+ set _markers ""
+ $itk_component(list) mark set insert "$node:start"
+ _drawLevel $node $indent
+
+ #
+ # Following the draw, all our markers need adjusting.
+ #
+ foreach {name index} $_markers {
+ $itk_component(list) mark set $name $index
+ }
+
+ #
+ # Set the image to be the open icon, denote the new state,
+ # and set the cursor back to normal along with the state.
+ #
+ $_images($node) configure -image $itk_option(-openicon)
+
+ set _states($node) 1
+
+ $itk_component(list) configure -state disabled \
+ -cursor $itk_option(-cursor)
+ }
+}
+
+# ----------------------------------------------------------------------
+# PUBLIC METHOD: collapse node
+#
+# Collapses the hierarchy beneath the specified node. Since this can
+# take a moment for large hierarchies, the cursor will be changed to a
+# watch during the expansion.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::collapse {node} {
+ if {! [info exists _states($node)]} {
+ error "bad collapse node argument: \"$node\", the node doesn't exist"
+ }
+
+ if {[info exists _states($node)] && $_states($node) && \
+ (([lsearch $_tags($node) branch] != -1) || \
+ ([llength [_contents $node]] > 0))} {
+ $itk_component(list) configure -state normal -cursor watch
+ update
+
+ _deselectSubNodes $node
+
+ $itk_component(list) delete "$node:start" "$node:end"
+
+ catch {$_images($node) configure -image $itk_option(-closedicon)}
+
+ set _states($node) 0
+
+ $itk_component(list) configure -state disabled \
+ -cursor $itk_option(-cursor)
+ }
+}
+
+# ----------------------------------------------------------------------
+# PUBLIC METHOD: toggle node
+#
+# Toggles the hierarchy beneath the specified node. If the hierarchy
+# is currently expanded, then it is collapsed, and vice-versa.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::toggle {node} {
+ if {! [info exists _states($node)]} {
+ error "bad toggle node argument: \"$node\", the node doesn't exist"
+ }
+
+ if {$_states($node)} {
+ collapse $node
+ } else {
+ expand $node
+ }
+}
+
+# ----------------------------------------------------------------------
+# PUBLIC METHOD: prune node
+#
+# Removes a particular node from the hierarchy.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::prune {node} {
+ #
+ # While we're working, change the state and cursor so we can
+ # edit the text and give a busy visual clue.
+ #
+ $itk_component(list) configure -state normal -cursor watch
+
+ #
+ # Recursively delete all the subnode information from our internal
+ # arrays and remove all the tags.
+ #
+ _deleteNodeInfo $node
+
+ #
+ # If the mark $node:end exists then the node has decendents so
+ # so we'll remove from the mark $node:start to $node:end in order
+ # to delete all the subnodes below it in the text.
+ #
+ if {[lsearch [$itk_component(list) mark names] $node:end] != -1} {
+ $itk_component(list) delete $node:start $node:end
+ $itk_component(list) mark unset $node:end
+ }
+
+ #
+ # Next we need to remove the node itself. Using the ranges for
+ # its tag we'll remove it from line start to the end plus one
+ # character which takes us to the start of the next node.
+ #
+ foreach {start end} [$itk_component(list) tag ranges $node] {
+ $itk_component(list) delete "$start linestart" "$end + 1 char"
+ }
+
+ #
+ # Delete the tag for this node.
+ #
+ $itk_component(list) tag delete $node
+
+ #
+ # The node must be removed from the list of subnodes for its parent.
+ # We don't really have a clean way to do upwards referencing, so
+ # the dirty way will have to do. We'll cycle through each node
+ # and if this node is in its list of subnodes, we'll remove it.
+ #
+ foreach uid [array names _nodes] {
+ if {[set index [lsearch $_nodes($uid) $node]] != -1} {
+ set _nodes($uid) [lreplace $_nodes($uid) $index $index]
+ }
+ }
+
+ #
+ # We're done, so change the state and cursor back to their
+ # original values.
+ #
+ $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
+}
+
+# ----------------------------------------------------------------------
+# PUBLIC METHOD: draw ?when?
+#
+# Performs a complete draw of the entire hierarchy.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::draw {{when -now}} {
+ if {$when == "-eventually"} {
+ if {$_pending == ""} {
+ set _pending [after idle [code $this draw -now]]
+ }
+ return
+ } elseif {$when != "-now"} {
+ error "bad when option \"$when\": should be -eventually or -now"
+ }
+ $itk_component(list) configure -state normal -cursor watch
+ update
+
+ $itk_component(list) delete 1.0 end
+ catch {unset _images}
+ set _markers ""
+
+ _drawLevel "" ""
+
+ foreach {name index} $_markers {
+ $itk_component(list) mark set $name $index
+ }
+
+ $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
+ set _pending ""
+}
+
+# ----------------------------------------------------------------------
+# PUBLIC METHOD: refresh node
+#
+# Performs a redraw of a specific node. If that node is currently
+# not visible, then no action is taken.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::refresh {node} {
+ if {! [info exists _nodes($node)]} {
+ error "bad refresh node argument: \"$node\", the node doesn't exist"
+ }
+
+
+ if {! $_states($node)} {return}
+
+ foreach parent [_getHeritage $node] {
+ if {! $_states($parent)} {return}
+ }
+
+ $itk_component(list) configure -state normal -cursor watch
+ $itk_component(list) delete $node:start $node:end
+
+ set _markers ""
+ $itk_component(list) mark set insert "$node:start"
+ set indent $_indents($node)
+
+ _drawLevel $node $indent
+
+ foreach {name index} $_markers {
+ $itk_component(list) mark set $name $index
+ }
+
+ $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
+}
+
+# ------------------------------------------------------------------
+# THIN WRAPPED TEXT METHODS:
+#
+# The following methods are thin wraps of standard text methods.
+# Consult the Tk text man pages for functionallity and argument
+# documentation.
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: bbox index
+#
+# Returns four element list describing the bounding box for the list
+# item at index
+# ------------------------------------------------------------------
+body iwidgets::Hierarchy::bbox {index} {
+ return [$itk_component(list) bbox $index]
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD compare index1 op index2
+#
+# Compare indices according to relational operator.
+# ------------------------------------------------------------------
+body iwidgets::Hierarchy::compare {index1 op index2} {
+ return [$itk_component(list) compare $index1 $op $index2]
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD delete first ?last?
+#
+# Delete a range of characters from the text.
+# ------------------------------------------------------------------
+body iwidgets::Hierarchy::delete {first {last {}}} {
+ $itk_component(list) configure -state normal -cursor watch
+ $itk_component(list) delete $first $last
+ $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD dump ?switches? index1 ?index2?
+#
+# Returns information about the contents of the text widget from
+# index1 to index2.
+# ------------------------------------------------------------------
+body iwidgets::Hierarchy::dump {args} {
+ return [eval $itk_component(list) dump $args]
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD dlineinfo index
+#
+# Returns a five element list describing the area occupied by the
+# display line containing index.
+# ------------------------------------------------------------------
+body iwidgets::Hierarchy::dlineinfo {index} {
+ return [$itk_component(list) dlineinfo $index]
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD get index1 ?index2?
+#
+# Return text from start index to end index.
+# ------------------------------------------------------------------
+body iwidgets::Hierarchy::get {index1 {index2 {}}} {
+ return [$itk_component(list) get $index1 $index2]
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD index index
+#
+# Return position corresponding to index.
+# ------------------------------------------------------------------
+body iwidgets::Hierarchy::index {index} {
+ return [$itk_component(list) index $index]
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD insert index chars ?tagList?
+#
+# Insert text at index.
+# ------------------------------------------------------------------
+body iwidgets::Hierarchy::insert {args} {
+ $itk_component(list) configure -state normal -cursor watch
+ eval $itk_component(list) insert $args
+ $itk_component(list) configure -state disabled -cursor $itk_option(-cursor)
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD scan option args
+#
+# Implements scanning on texts.
+# ------------------------------------------------------------------
+body iwidgets::Hierarchy::scan {option args} {
+ eval $itk_component(list) scan $option $args
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD search ?switches? pattern index ?varName?
+#
+# Searches the text for characters matching a pattern.
+# ------------------------------------------------------------------
+body iwidgets::Hierarchy::search {args} {
+ return [eval $itk_component(list) search $args]
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD see index
+#
+# Adjusts the view in the window so the character at index is
+# visible.
+# ------------------------------------------------------------------
+body iwidgets::Hierarchy::see {index} {
+ $itk_component(list) see $index
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD tag option ?arg arg ...?
+#
+# Manipulate tags dependent on options.
+# ------------------------------------------------------------------
+body iwidgets::Hierarchy::tag {op args} {
+ return [eval $itk_component(list) tag $op $args]
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD window option ?arg arg ...?
+#
+# Manipulate embedded windows.
+# ------------------------------------------------------------------
+body iwidgets::Hierarchy::window {option args} {
+ return [eval $itk_component(list) window $option $args]
+}
+
+# ----------------------------------------------------------------------
+# PUBLIC METHOD: xview args
+#
+# Thin wrap of the text widget's xview command.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::xview {args} {
+ return [eval itk_component(list) xview $args]
+}
+
+# ----------------------------------------------------------------------
+# PUBLIC METHOD: yview args
+#
+# Thin wrap of the text widget's yview command.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::yview {args} {
+ return [eval $itk_component(list) yview $args]
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHODS
+# ------------------------------------------------------------------
+
+# ----------------------------------------------------------------------
+# PROTECTED METHOD: _drawLevel node indent
+#
+# Used internally by draw to draw one level of the hierarchy.
+# Draws all of the nodes under node, using the indent string to
+# indent nodes.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::_drawLevel {node indent} {
+ lappend _markers "$node:start" [$itk_component(list) index insert]
+ set bg [$itk_component(list) cget -background]
+
+ #
+ # Obtain the list of subnodes for this node and cycle through
+ # each one displaying it in the hierarchy.
+ #
+ foreach child [_contents $node] {
+ set _images($child) "$itk_component(list).hicon[incr _hcounter]"
+
+ if {![info exists _states($child)]} {
+ set _states($child) $itk_option(-expanded)
+ }
+
+ #
+ # Check the user tags to see if they have been kind enough
+ # to tell us ahead of time what type of node we are dealing
+ # with branch or leaf. If they neglected to do so, then
+ # get the contents of the child node to see if it has children
+ # itself.
+ #
+ set display 0
+
+ if {[lsearch $_tags($child) leaf] != -1} {
+ set type leaf
+ } elseif {[lsearch $_tags($child) branch] != -1} {
+ set type branch
+ } else {
+ if {[llength [_contents $child]] == 0} {
+ set type leaf
+ } else {
+ set type branch
+ }
+ }
+
+ #
+ # Now that we know the type of node, branch or leaf, we know
+ # the type of icon to use.
+ #
+ if {$type == "leaf"} {
+ set icon $itk_option(-nodeicon)
+ eval $_filterCode
+ } else {
+ if {$_states($child)} {
+ set icon $itk_option(-openicon)
+ } else {
+ set icon $itk_option(-closedicon)
+ }
+ set display 1
+ }
+
+ #
+ # If display is set then we're going to be drawing this node.
+ # Save off the indentation level for this node and do the indent.
+ #
+ if {$display} {
+ set _indents($child) "$indent\t"
+ $itk_component(list) insert insert $indent
+
+ #
+ # Add the branch or leaf icon and setup a binding to toggle
+ # its expanded/collapsed state.
+ #
+ label $_images($child) -image $icon -background $bg
+ bind $_images($child) <ButtonPress-1> [code $this toggle $child]
+ $itk_component(list) window create insert -window $_images($child)
+
+ #
+ # If any user icons exist then draw them as well. The little
+ # regexp is just to check and see if they've passed in a
+ # command which needs to be evaluated as opposed to just
+ # a variable. Also, attach a binding to call them if their
+ # icon is selected.
+ #
+ if {[info exists _icons($child)]} {
+ foreach image $_icons($child) {
+ set wid "$itk_component(list).uicon[incr _ucounter]"
+
+ if {[regexp {\[.*\]} $image]} {
+ eval label $wid -image $image -background $bg
+ } else {
+ label $wid -image $image -background $bg
+ }
+
+ bind $wid <ButtonPress-1> \
+ [code $this _iconSelect $child $image]
+ $itk_component(list) window create insert -window $wid
+ }
+ }
+
+ #
+ # Create the list of tags to be applied to the text. Start
+ # out with a tag of "info" and append "hilite" if the node
+ # is currently selected, finally add the tags given by the
+ # user.
+ #
+ set texttags [list "info" $child]
+
+ if {[info exists _selected($child)]} {
+ lappend texttags hilite
+ }
+
+ foreach tag $_tags($child) {
+ lappend texttags $tag
+ }
+
+ #
+ # Insert the text for the node along with the tags and
+ # append to the markers the start of this node. The text
+ # has been broken at newlines into a list. We'll make sure
+ # that each line is at the same indentation position.
+ #
+ set firstline 1
+ foreach line $_text($child) {
+ if {$firstline} {
+ $itk_component(list) insert insert " "
+ } else {
+ $itk_component(list) insert insert "$indent\t"
+ }
+
+ $itk_component(list) insert insert $line $texttags "\n"
+ set firstline 0
+ }
+
+ lappend _markers "$child:start" [$itk_component(list) index insert]
+
+ #
+ # If the state of the node is open, proceed to draw the next
+ # node below it in the hierarchy.
+ #
+ if {$_states($child)} {
+ _drawLevel $child "$indent\t"
+ }
+ }
+ }
+
+ lappend _markers "$node:end" [$itk_component(list) index insert]
+}
+
+# ----------------------------------------------------------------------
+# PROTECTED METHOD: _contents uid
+#
+# Used internally to get the contents of a particular node. If this
+# is the first time the node has been seen or the -alwaysquery
+# option is set, the -querycommand code is executed to query the node
+# list, and the list is stored until the next time it is needed.
+#
+# The querycommand may return not only the list of subnodes for the
+# node but additional information on the tags and icons to be used.
+# The return value must be parsed based on the number of elements in
+# the list where the format is a list of lists:
+#
+# {{uid [text [tags [icons]]]} {uid [text [tags [icons]]]} ...}
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::_contents {uid} {
+ if {! $itk_option(-alwaysquery) && [info exists _nodes($uid)]} {
+ return $_nodes($uid)
+ }
+
+ #
+ # Substitute any %n's for the node name whose children we're
+ # interested in obtaining.
+ #
+ set cmd $itk_option(-querycommand)
+ regsub -all {%n} $cmd [list $uid] cmd
+
+ set nodeinfolist [uplevel \#0 $cmd]
+
+ #
+ # Cycle through the node information returned by the query
+ # command determining if additional information such as text,
+ # user tags, or user icons have been provided. For text,
+ # break it into a list at any newline characters.
+ #
+ set _nodes($uid) {}
+
+ foreach nodeinfo $nodeinfolist {
+ set subnodeuid [lindex $nodeinfo 0]
+ lappend _nodes($uid) $subnodeuid
+
+ set llen [llength $nodeinfo]
+
+ if {$llen == 0 || $llen > 4} {
+ error "invalid number of elements returned by query\
+ command for node: \"$uid\",\
+ should be uid \[text \[tags \[icons\]\]\]"
+ }
+
+ if {$llen == 1} {
+ set _text($subnodeuid) [split $subnodeuid \n]
+ }
+ if {$llen > 1} {
+ set _text($subnodeuid) [split [lindex $nodeinfo 1] \n]
+ }
+ if {$llen > 2} {
+ set _tags($subnodeuid) [lindex $nodeinfo 2]
+ } else {
+ set _tags($subnodeuid) unknown
+ }
+ if {$llen > 3} {
+ set _icons($subnodeuid) [lindex $nodeinfo 3]
+ }
+ }
+
+ #
+ # Return the list of nodes.
+ #
+ return $_nodes($uid)
+}
+
+# ----------------------------------------------------------------------
+# PROTECTED METHOD: _post x y
+#
+# Used internally to post the popup menu at the coordinate (x,y)
+# relative to the widget. If (x,y) is on an item, then the itemMenu
+# component is posted. Otherwise, the bgMenu is posted.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::_post {x y} {
+ set rx [expr [winfo rootx $itk_component(list)]+$x]
+ set ry [expr [winfo rooty $itk_component(list)]+$y]
+
+ set index [$itk_component(list) index @$x,$y]
+
+ #
+ # The posted variable will hold the list of tags which exist at
+ # this x,y position that will be passed back to the user. They
+ # don't need to know about our internal tags, info, hilite, and
+ # lowlite, so remove them from the list.
+ #
+ set _posted {}
+
+ foreach tag [$itk_component(list) tag names $index] {
+ if {![_isInternalTag $tag]} {
+ lappend _posted $tag
+ }
+ }
+
+ #
+ # If we have tags then do the popup at this position.
+ #
+ if {$_posted != {}} {
+ tk_popup $itk_component(itemMenu) $rx $ry
+ } else {
+ tk_popup $itk_component(bgMenu) $rx $ry
+ }
+}
+
+# ----------------------------------------------------------------------
+# PROTECTED METHOD: _select x y
+#
+# Used internally to select an item at the coordinate (x,y) relative
+# to the widget. The command associated with the -selectcommand
+# option is execute following % character substitutions. If %n
+# appears in the command, the selected node is substituted. If %s
+# appears, a boolean value representing the current selection state
+# will be substituted.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::_select {x y} {
+ if {$itk_option(-selectcommand) != {}} {
+ if {[set seltags [$itk_component(list) tag names @$x,$y]] != {}} {
+ foreach tag $seltags {
+ if {![_isInternalTag $tag]} {
+ lappend node $tag
+ }
+ }
+
+ if {[lsearch $seltags "hilite"] == -1} {
+ set selectstatus 0
+ } else {
+ set selectstatus 1
+ }
+
+ set cmd $itk_option(-selectcommand)
+ regsub -all {%n} $cmd [list $node] cmd
+ regsub -all {%s} $cmd [list $selectstatus] cmd
+
+ uplevel #0 $cmd
+ }
+ }
+
+ return
+}
+
+# ----------------------------------------------------------------------
+# PROTECTED METHOD: _iconSelect node icon
+#
+# Used internally to upon selection of user icons. The -iconcommand
+# is executed after substitution of the node for %n and icon for %i.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::_iconSelect {node icon} {
+ set cmd $itk_option(-iconcommand)
+ regsub -all {%n} $cmd [list $node] cmd
+ regsub -all {%i} $cmd [list $icon] cmd
+
+ uplevel \#0 $cmd
+
+ return {}
+}
+
+# ----------------------------------------------------------------------
+# PROTECTED METHOD: _deselectSubNodes uid
+#
+# Used internally to recursively deselect all the nodes beneath a
+# particular node.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::_deselectSubNodes {uid} {
+ foreach node $_nodes($uid) {
+ if {[array names _selected $node] != {}} {
+ unset _selected($node)
+ }
+
+ if {[array names _nodes $node] != {}} {
+ _deselectSubNodes $node
+ }
+ }
+}
+
+# ----------------------------------------------------------------------
+# PROTECTED METHOD: _deleteNodeInfo uid
+#
+# Used internally to recursively delete all the information about a
+# node and its decendents.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::_deleteNodeInfo {uid} {
+ #
+ # Recursively call ourseleves as we go down the hierarchy beneath
+ # this node.
+ #
+ if {[info exists _nodes($uid)]} {
+ foreach node $_nodes($uid) {
+ if {[array names _nodes $node] != {}} {
+ _deleteNodeInfo $node
+ }
+ }
+ }
+
+ #
+ # Unset any entries in our arrays for the node.
+ #
+ catch {unset _nodes($uid)}
+ catch {unset _text($uid)}
+ catch {unset _tags($uid)}
+ catch {unset _icons($uid)}
+ catch {unset _states($uid)}
+ catch {unset _images($uid)}
+ catch {unset _indents($uid)}
+}
+
+# ----------------------------------------------------------------------
+# PROTECTED METHOD: _getParent uid
+#
+# Used internally to determine the parent for a node.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::_getParent {uid} {
+ foreach node [array names _nodes] {
+ if {[set index [lsearch $_nodes($node) $uid]] != -1} {
+ return $node
+ }
+ }
+}
+
+# ----------------------------------------------------------------------
+# PROTECTED METHOD: _getHeritage uid
+#
+# Used internally to determine the list of parents for a node.
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::_getHeritage {uid} {
+ set parents {}
+
+ if {[set parent [_getParent $uid]] != {}} {
+ lappend parents $parent
+ }
+
+ return $parents
+}
+
+# ----------------------------------------------------------------------
+# PROTECTED METHOD (could be proc?): _isInternalTag tag
+#
+# Used internally to tags not to used for user callback commands
+# ----------------------------------------------------------------------
+body iwidgets::Hierarchy::_isInternalTag {tag} {
+ set ii [expr [lsearch -exact {info hilite lowlite unknown} $tag] != -1];
+ return $ii;
+}
diff --git a/itcl/iwidgets3.0.0/generic/hyperhelp.itk b/itcl/iwidgets3.0.0/generic/hyperhelp.itk
new file mode 100644
index 00000000000..e3f4a05bd83
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/hyperhelp.itk
@@ -0,0 +1,505 @@
+#
+# Hyperhelp
+# ----------------------------------------------------------------------
+# Implements a help facility using html formatted hypertext files.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Kris Raney EMAIL: kraney@spd.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1996 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Acknowledgements:
+#
+# Special thanks go to Sam Shen(SLShen@lbl.gov), as this code is based on his
+# help.tcl code from tk inspect.
+
+#
+# Default resources.
+#
+option add *Hyperhelp.width 575 widgetDefault
+option add *Hyperhelp.height 450 widgetDefault
+option add *Hyperhelp.modality none widgetDefault
+option add *Hyperhelp.vscrollMode static widgetDefault
+option add *Hyperhelp.hscrollMode static widgetDefault
+option add *Hyperhelp.maxHistory 20 widgetDefault
+
+#
+# Usual options.
+#
+itk::usual Hyperhelp {
+ keep -activebackground -activerelief -background -borderwidth -cursor \
+ -foreground -highlightcolor -highlightthickness \
+ -selectbackground -selectborderwidth -selectforeground \
+ -textbackground
+}
+
+# ------------------------------------------------------------------
+# HYPERHELP
+# ------------------------------------------------------------------
+class iwidgets::Hyperhelp {
+ inherit iwidgets::Shell
+
+ constructor {args} {}
+
+ itk_option define -topics topics Topics {}
+ itk_option define -helpdir helpdir Directory .
+ itk_option define -title title Title "Help"
+ itk_option define -closecmd closeCmd CloseCmd {}
+ itk_option define -maxhistory maxHistory MaxHistory 20
+
+ public variable beforelink {}
+ public variable afterlink {}
+
+ public method showtopic {topic}
+ public method followlink {link}
+ public method forward {}
+ public method back {}
+ public method updatefeedback {n}
+
+ protected method _readtopic {file {anchorpoint {}}}
+ protected method _pageforward {}
+ protected method _pageback {}
+ protected method _lineforward {}
+ protected method _lineback {}
+ protected method _fill_go_menu {}
+
+ protected variable _history {} ;# History list of viewed pages
+ protected variable _history_ndx -1 ;# current position in history list
+ protected variable _history_len 0 ;# length of history list
+ protected variable _histdir -1 ;# direction in history we just came
+ ;# from
+ protected variable _len 0 ;# length of text to be rendered
+ protected variable _file {} ;# current topic
+
+ private variable _remaining 0 ;# remaining text to be rendered
+ private variable _rendering 0 ;# flag - in process of rendering
+}
+
+#
+# Provide a lowercased access method for the Scrolledlistbox class.
+#
+proc ::iwidgets::hyperhelp {pathName args} {
+ uplevel ::iwidgets::Hyperhelp $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Hyperhelp::constructor {args} {
+ itk_option remove iwidgets::Shell::padx iwidgets::Shell::pady
+
+ #
+ # Create a pulldown menu
+ #
+ itk_component add -private menubar {
+ frame $itk_interior.menu -relief raised -bd 2
+ } {
+ keep -background -cursor
+ }
+ pack $itk_component(menubar) -side top -fill x
+
+ itk_component add -private topicmb {
+ menubutton $itk_component(menubar).topicmb -text "Topics" \
+ -menu $itk_component(menubar).topicmb.topicmenu \
+ -underline 0 -padx 8 -pady 2
+ } {
+ keep -background -cursor -font -foreground \
+ -activebackground -activeforeground
+ }
+ pack $itk_component(topicmb) -side left
+
+ itk_component add -private topicmenu {
+ menu $itk_component(topicmb).topicmenu -tearoff no
+ } {
+ keep -background -cursor -font -foreground \
+ -activebackground -activeforeground
+ }
+
+ itk_component add -private navmb {
+ menubutton $itk_component(menubar).navmb -text "Navigate" \
+ -menu $itk_component(menubar).navmb.navmenu \
+ -underline 0 -padx 8 -pady 2
+ } {
+ keep -background -cursor -font -foreground \
+ -activebackground -activeforeground
+ }
+ pack $itk_component(navmb) -side left
+
+ itk_component add -private navmenu {
+ menu $itk_component(navmb).navmenu -tearoff no
+ } {
+ keep -background -cursor -font -foreground \
+ -activebackground -activeforeground
+ }
+ set m $itk_component(navmenu)
+ $m add command -label "Forward" -underline 0 -state disabled \
+ -command [code $this forward] -accelerator f
+ $m add command -label "Back" -underline 0 -state disabled \
+ -command [code $this back] -accelerator b
+ $m add cascade -label "Go" -underline 0 -menu $m.go
+
+ itk_component add -private navgo {
+ menu $itk_component(navmenu).go -postcommand [code $this _fill_go_menu]
+ } {
+ keep -background -cursor -font -foreground \
+ -activebackground -activeforeground
+ }
+
+ #
+ # Create a scrolledhtml object to display help pages
+ #
+ itk_component add scrtxt {
+ iwidgets::scrolledhtml $itk_interior.scrtxt \
+ -linkcommand "$this followlink" -feedback "$this updatefeedback"
+ } {
+ keep -hscrollmode -vscrollmode -background -textbackground \
+ -fontname -fontsize -fixedfont -link \
+ -linkhighlight -borderwidth -cursor -sbwidth -scrollmargin \
+ -width -height -foreground -highlightcolor -visibleitems \
+ -highlightthickness -padx -pady -activerelief \
+ -relief -selectbackground -selectborderwidth \
+ -selectforeground -setgrid -wrap -unknownimage
+ }
+ pack $itk_component(scrtxt) -fill both -expand yes
+
+ #
+ # Bind shortcut keys
+ #
+ bind $itk_component(hull) <Key-f> [code $this forward]
+ bind $itk_component(hull) <Key-b> [code $this back]
+ bind $itk_component(hull) <Alt-Right> [code $this forward]
+ bind $itk_component(hull) <Alt-Left> [code $this back]
+ bind $itk_component(hull) <Key-space> [code $this _pageforward]
+ bind $itk_component(hull) <Key-Next> [code $this _pageforward]
+ bind $itk_component(hull) <Key-BackSpace> [code $this _pageback]
+ bind $itk_component(hull) <Key-Prior> [code $this _pageback]
+ bind $itk_component(hull) <Key-Delete> [code $this _pageback]
+ bind $itk_component(hull) <Key-Down> [code $this _lineforward]
+ bind $itk_component(hull) <Key-Up> [code $this _lineback]
+
+ wm title $itk_component(hull) "Help"
+
+ eval itk_initialize $args
+ if {[lsearch -exact $args -closecmd] == -1} {
+ configure -closecmd [code $this deactivate]
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -topics
+#
+# Specifies the topics to display on the menu. For each topic, there should
+# be a file named <helpdir>/<topic>.html
+# ------------------------------------------------------------------
+configbody iwidgets::Hyperhelp::topics {
+ set m $itk_component(topicmenu)
+ $m delete 0 last
+ foreach topic $itk_option(-topics) {
+ if {[lindex $topic 1] == {} } {
+ $m add radiobutton -variable topic \
+ -value $topic \
+ -label $topic \
+ -command [list $this showtopic $topic]
+ } else {
+ if {[string index [file dirname [lindex $topic 1]] 0] != "/" && \
+ [string index [file dirname [lindex $topic 1]] 0] != "~"} {
+ set link $itk_option(-helpdir)/[lindex $topic 1]
+ } else {
+ set link [lindex $topic 1]
+ }
+ $m add radiobutton -variable topic \
+ -value [lindex $topic 0] \
+ -label [lindex $topic 0] \
+ -command [list $this followlink $link]
+ }
+ }
+ $m add separator
+ $m add command -label "Close Help" -underline 0 \
+ -command $itk_option(-closecmd)
+}
+
+# ------------------------------------------------------------------
+# OPTION: -title
+#
+# Specify the window title.
+# ------------------------------------------------------------------
+configbody iwidgets::Hyperhelp::title {
+ wm title $itk_component(hull) $itk_option(-title)
+}
+
+# ------------------------------------------------------------------
+# OPTION: -helpdir
+#
+# Set location of help files
+# ------------------------------------------------------------------
+configbody iwidgets::Hyperhelp::helpdir {
+ if {[string index [file dirname $itk_option(-helpdir)] 0] != "/" && \
+ [string index [file dirname $itk_option(-helpdir)] 0] != "~"} {
+ configure -helpdir [pwd]/$itk_option(-helpdir)
+ } else {
+ set _history {}
+ set _history_len 0
+ set _history_ndx -1
+ $itk_component(navmenu) entryconfig 0 -state disabled
+ $itk_component(navmenu) entryconfig 1 -state disabled
+ configure -topics $itk_option(-topics)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -closecmd
+#
+# Specify the command to execute when close is selected from the menu
+# ------------------------------------------------------------------
+configbody iwidgets::Hyperhelp::closecmd {
+ $itk_component(topicmenu) entryconfigure last -command $itk_option(-closecmd)
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: showtopic topic
+#
+# render text of help topic <topic>. The text is expected to be found in
+# <helpdir>/<topic>.html
+# ------------------------------------------------------------------
+body iwidgets::Hyperhelp::showtopic {topic} {
+ if ![regexp {(.*)#(.*)} $topic dummy topicname anchorpart] {
+ set topicname $topic
+ set anchorpart {}
+ }
+ if {$topicname == ""} {
+ set topicname $_file
+ set filepath $_file
+ } else {
+ set filepath $itk_option(-helpdir)/$topicname.html
+ }
+ if {[incr _history_ndx] < $itk_option(-maxhistory)} {
+ set _history [lrange $_history 0 [expr $_history_ndx - 1]]
+ set _history_len [expr $_history_ndx + 1]
+ } else {
+ incr _history_ndx -1
+ set _history [lrange $_history 1 $_history_ndx]
+ set _history_len [expr $_history_ndx + 1]
+ }
+ lappend _history [list $topicname $filepath $anchorpart]
+ _readtopic $filepath $anchorpart
+}
+
+# ------------------------------------------------------------------
+# METHOD: followlink link
+#
+# Callback for click on a link. Shows new topic.
+# ------------------------------------------------------------------
+body iwidgets::Hyperhelp::followlink {link} {
+ if {[string compare $beforelink ""] != 0} {
+ eval $beforelink $link
+ }
+ if ![regexp {(.*)#(.*)} $link dummy filepart anchorpart] {
+ set filepart $link
+ set anchorpart {}
+ }
+ if {$filepart != "" && [string index [file dirname $filepart] 0] != "/" && \
+ [string index [file dirname $filepart] 0] != "~"} {
+ set filepart [$itk_component(scrtxt) pwd]/$filepart
+ set hfile $filepart
+ } else {
+ set hfile $_file
+ }
+ incr _history_ndx
+ set _history [lrange $_history 0 [expr $_history_ndx - 1]]
+ set _history_len [expr $_history_ndx + 1]
+ lappend _history [list [file rootname [file tail $hfile]] $hfile $anchorpart]
+ set ret [_readtopic $filepart $anchorpart]
+ if {[string compare $afterlink ""] != 0} {
+ eval $afterlink $link
+ }
+ return $ret
+}
+
+# ------------------------------------------------------------------
+# METHOD: forward
+#
+# Show topic one forward in history list
+# ------------------------------------------------------------------
+body iwidgets::Hyperhelp::forward {} {
+ if {$_rendering || ($_history_ndx+1) >= $_history_len} return
+ incr _history_ndx
+ eval _readtopic [lrange [lindex $_history $_history_ndx] 1 end]
+}
+
+# ------------------------------------------------------------------
+# METHOD: back
+#
+# Show topic one back in history list
+# ------------------------------------------------------------------
+body iwidgets::Hyperhelp::back {} {
+ if {$_rendering || $_history_ndx <= 0} return
+ incr _history_ndx -1
+ set _histdir 1
+ eval _readtopic [lrange [lindex $_history $_history_ndx] 1 end]
+}
+
+# ------------------------------------------------------------------
+# METHOD: updatefeedback remaining
+#
+# Callback from text to update feedback widget
+# ------------------------------------------------------------------
+body iwidgets::Hyperhelp::updatefeedback {n} {
+ if {($_remaining - $n) > .1*$_len} {
+ [$itk_interior.feedbackshell childsite].helpfeedback step [expr $_remaining - $n]
+ update idletasks
+ set _remaining $n
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _readtopic
+#
+# Read in file, render it in text area, and jump to anchorpoint
+# ------------------------------------------------------------------
+body iwidgets::Hyperhelp::_readtopic {file {anchorpoint {}}} {
+ if {$file != ""} {
+ if {[string compare $file $_file] != 0} {
+ if {[catch {set f [open $file r]} err]} {
+ incr _history_ndx $_histdir
+ set _history_len [expr $_history_ndx + 1]
+ set _histdir -1
+ set m $itk_component(navmenu)
+ if {($_history_ndx+1) < $_history_len} {
+ $m entryconfig 0 -state normal
+ } else {
+ $m entryconfig 0 -state disabled
+ }
+ if {$_history_ndx > 0} {
+ $m entryconfig 1 -state normal
+ } else {
+ $m entryconfig 1 -state disabled
+ }
+ error $err
+ }
+ set _file $file
+ set txt [read $f]
+ iwidgets::shell $itk_interior.feedbackshell -title "Rendering HTML" -padx 1 -pady 1
+ iwidgets::Feedback [$itk_interior.feedbackshell childsite].helpfeedback \
+ -steps [set _len [string length $txt]] \
+ -labeltext "Rendering HTML" -labelpos n
+ pack [$itk_interior.feedbackshell childsite].helpfeedback
+ $itk_interior.feedbackshell center $itk_interior
+ $itk_interior.feedbackshell activate
+ set _remaining $_len
+ set _rendering 1
+ if [catch {$itk_component(scrtxt) render $txt [file dirname $file]} err] {
+ if [regexp "</pre>" $err] {
+ $itk_component(scrtxt) render "<tt>$err</tt>"
+ } else {
+ $itk_component(scrtxt) render "<pre>$err</pre>"
+ }
+ }
+ wm title $itk_component(hull) "Help: $file"
+ delete object [$itk_interior.feedbackshell childsite].helpfeedback
+ delete object $itk_interior.feedbackshell
+ set _rendering 0
+ }
+ }
+ set m $itk_component(navmenu)
+ if {($_history_ndx+1) < $_history_len} {
+ $m entryconfig 0 -state normal
+ } else {
+ $m entryconfig 0 -state disabled
+ }
+ if {$_history_ndx > 0} {
+ $m entryconfig 1 -state normal
+ } else {
+ $m entryconfig 1 -state disabled
+ }
+ if {$anchorpoint != "{}"} {
+ $itk_component(scrtxt) import -link #$anchorpoint
+ } else {
+ $itk_component(scrtxt) import -link #
+ }
+ set _histdir -1
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _fill_go_menu
+#
+# update go submenu with current history
+# ------------------------------------------------------------------
+body iwidgets::Hyperhelp::_fill_go_menu {} {
+ set m $itk_component(navgo)
+ catch {$m delete 0 last}
+ for {set i [expr $_history_len - 1]} {$i >= 0} {incr i -1} {
+ set topic [lindex [lindex $_history $i] 0]
+ set filepath [lindex [lindex $_history $i] 1]
+ set anchor [lindex [lindex $_history $i] 2]
+ $m add command -label $topic \
+ -command [list $this followlink $filepath#$anchor]
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _pageforward
+#
+# Callback for page forward shortcut key
+# ------------------------------------------------------------------
+body iwidgets::Hyperhelp::_pageforward {} {
+ $itk_component(scrtxt) yview scroll 1 pages
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _pageback
+#
+# Callback for page back shortcut key
+# ------------------------------------------------------------------
+body iwidgets::Hyperhelp::_pageback {} {
+ $itk_component(scrtxt) yview scroll -1 pages
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _lineforward
+#
+# Callback for line forward shortcut key
+# ------------------------------------------------------------------
+body iwidgets::Hyperhelp::_lineforward {} {
+ $itk_component(scrtxt) yview scroll 1 units
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _lineback
+#
+# Callback for line back shortcut key
+# ------------------------------------------------------------------
+body iwidgets::Hyperhelp::_lineback {} {
+ $itk_component(scrtxt) yview scroll -1 units
+}
diff --git a/itcl/iwidgets3.0.0/generic/labeledframe.itk b/itcl/iwidgets3.0.0/generic/labeledframe.itk
new file mode 100644
index 00000000000..19b8540f70b
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/labeledframe.itk
@@ -0,0 +1,516 @@
+#
+# Labeledframe
+# ----------------------------------------------------------------------
+# Implements a hull frame with a grooved relief, a label, and a
+# frame childsite.
+#
+# The frame childsite can be filled with any widget via a derived class
+# or though the use of the childsite method. This class was designed
+# to be a general purpose base class for supporting the combination of
+# a labeled frame and a childsite. The options include the ability to
+# position the label at configurable locations within the grooved relief
+# of the hull frame, and control the display of the label.
+#
+# To following demonstrates the different values which the "-labelpos"
+# option may be set to and the resulting layout of the label when
+# one executes the following command with "-labeltext" set to "LABEL":
+#
+# example:
+# labeledframe .w -labeltext LABEL -labelpos <ne,n,nw,se,s,sw,en,e,es,wn,s,ws>
+#
+# ne n nw se s sw
+#
+# *LABEL**** **LABEL** ****LABEL* ********** ********* **********
+# * * * * * * * * * * * *
+# * * * * * * * * * * * *
+# * * * * * * * * * * * *
+# ********** ********* ********** *LABEL**** **LABEL** ****LABEL*
+#
+# en e es wn s ws
+#
+# ********** ********* ********* ********* ********* **********
+# * * * * * * * * * * * *
+# L * * * * * * L * * * *
+# A * L * * * * A * L * L
+# B * A * L * * B * A * A
+# E * B * A * * E * B * B
+# L * E * B * * L * E * E
+# * * L * E * * * * L * L
+# * * * * L * * * * * * *
+# ********** ********** ********* ********** ********* **********
+#
+# ----------------------------------------------------------------------
+# AUTHOR: John A. Tucker EMAIL: jatucker@spd.dsccc.com
+#
+# ======================================================================
+# Copyright (c) 1997 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Default resources.
+#
+option add *Labeledframe.labelMargin 10 widgetDefault
+option add *Labeledframe.labelFont \
+ "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" widgetDefault
+option add *Labeledframe.labelPos n widgetDefault
+option add *Labeledframe.labelBorderWidth 2 widgetDefault
+option add *Labeledframe.labelRelief groove widgetDefault
+
+
+#
+# Usual options.
+#
+itk::usual Labeledframe {
+ keep -background -cursor -labelfont -foreground -labelrelief -labelborderwidth
+}
+
+class iwidgets::Labeledframe {
+
+ inherit itk::Widget
+
+ itk_option define -ipadx iPadX IPad 0
+ itk_option define -ipady iPadY IPad 0
+
+ itk_option define -labelmargin labelMargin LabelMargin 10
+ itk_option define -labelpos labelPos LabelPos n
+ itk_option define -labeltext labelText LabelText ""
+
+ constructor {args} {}
+ destructor {}
+
+ #
+ # Public methods
+ #
+ public method childsite {}
+ public method clientHandlesConfigure {{yes 1}}
+
+ #
+ # Private methods
+ #
+ private {
+ method smt {value} { _setMarginThickness $value }
+ method _positionLabel {{when later}}
+ method _collapseMargin {}
+ method _setMarginThickness {value}
+
+ proc _initTable {}
+
+ variable _reposition "" ;# non-null => _positionLabel pending
+ variable dontUpdate 0
+
+ common _LAYOUT_TABLE
+ }
+}
+
+#
+# Provide a lowercased access method for the Labeledframe class.
+#
+proc ::iwidgets::labeledframe {pathName args} {
+ uplevel ::iwidgets::Labeledframe $pathName $args
+}
+
+# -----------------------------------------------------------------------------
+# CONSTRUCTOR
+# -----------------------------------------------------------------------------
+body iwidgets::Labeledframe::constructor { args } {
+ #
+ # Create a window with the same name as this object
+ #
+
+ itk_component add labelFrame {
+ frame $itk_interior.lf \
+ -relief groove \
+ -class [namespace tail [info class]]
+ } {
+ keep -background -cursor
+ rename -relief -labelrelief labelRelief LabelRelief
+ rename -borderwidth -labelborderwidth labelBorderWidth LabelBorderWidth
+ rename -highlightbackground -background background Background
+ rename -highlightcolor -background background Background
+ }
+
+ #
+ # Create the childsite frame window
+ # _______
+ # |_____|
+ # |_|X|_|
+ # |_____|
+ #
+ itk_component add childsite {
+ frame $itk_component(labelFrame).childsite -highlightthickness 0 -bd 0
+ }
+
+ #
+ # Create the label to be positioned within the grooved relief
+ # of the labelFrame frame.
+ #
+ itk_component add label {
+ label $itk_component(labelFrame).label -highlightthickness 0 -bd 0
+ } {
+ usual
+ rename -bitmap -labelbitmap labelBitmap Bitmap
+ rename -font -labelfont labelFont Font
+ rename -image -labelimage labelImage Image
+ #rename -text -labeltext labelText Text
+ rename -textvariable -labelvariable labelVariable Variable
+ ignore -highlightthickness -highlightcolor -text
+ }
+
+ grid $itk_component(childsite) -row 1 -column 1 -sticky nsew
+ grid columnconfigure $itk_component(labelFrame) 1 -weight 1
+ grid rowconfigure $itk_component(labelFrame) 1 -weight 1
+
+ lappend after_script [code $this _positionLabel]
+ bind $itk_component(label) <Configure> +[code $this _positionLabel]
+
+ pack $itk_component(labelFrame) -fill both -expand 1
+
+ #
+ # Initialize the class array of layout configuration options. Since
+ # this is a one time only thing.
+ #
+ _initTable
+
+ eval itk_initialize $args
+
+ #
+ # When idle, position the label.
+ #
+ _positionLabel
+}
+
+# -----------------------------------------------------------------------------
+# DESTRUCTOR
+# -----------------------------------------------------------------------------
+body iwidgets::Labeledframe::destructor {} {
+ debug "In Labeledframe destructor for $this, reposition is $_reposition"
+ if {$_reposition != ""} {
+ debug "Canceling reposition $_reposition for $this"
+ after cancel $_reposition
+ set _reposition DESTRUCTOR
+ }
+}
+
+# -----------------------------------------------------------------------------
+# OPTIONS
+# -----------------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -ipadx
+#
+# Specifies the width of the horizontal gap from the border to the
+# the child site.
+# ------------------------------------------------------------------
+configbody iwidgets::Labeledframe::ipadx {
+ grid configure $itk_component(childsite) -padx $itk_option(-ipadx)
+ _positionLabel
+}
+
+# ------------------------------------------------------------------
+# OPTION: -ipady
+#
+# Specifies the width of the vertical gap from the border to the
+# the child site.
+# ------------------------------------------------------------------
+configbody iwidgets::Labeledframe::ipady {
+ grid configure $itk_component(childsite) -pady $itk_option(-ipady)
+ _positionLabel
+}
+
+# -----------------------------------------------------------------------------
+# OPTION: -labelmargin
+#
+# Set the margin of the most adjacent side of the label to the labelFrame
+# relief.
+# ----------------------------------------------------------------------------
+configbody iwidgets::Labeledframe::labelmargin {
+ _positionLabel
+}
+
+# -----------------------------------------------------------------------------
+# OPTION: -labelpos
+#
+# Set the position of the label within the relief of the labelFrame frame
+# widget.
+# ----------------------------------------------------------------------------
+configbody iwidgets::Labeledframe::labelpos {
+ _positionLabel
+}
+
+# -----------------------------------------------------------------------------
+# OPTION: -labelpos
+#
+# Set the position of the label within the relief of the labelFrame frame
+# widget.
+# ----------------------------------------------------------------------------
+configbody iwidgets::Labeledframe::labeltext {
+ $itk_component(label) configure -text $itk_option(-labeltext)
+ _positionLabel
+}
+
+# -----------------------------------------------------------------------------
+# PROCS
+# -----------------------------------------------------------------------------
+
+# -----------------------------------------------------------------------------
+# PRIVATE PROC: _initTable
+#
+# Initializes the _LAYOUT_TABLE common variable of the Labeledframe
+# class. The initialization is performed in its own proc ( as opposed
+# to in the class definition ) so that the initialization occurs only
+# once.
+#
+# _LAYOUT_TABLE common array description:
+# Provides a table of the configuration option values
+# used to place the label widget within the grooved relief of the labelFrame
+# frame for each of the 12 possible "-labelpos" values.
+#
+# Each of the 12 rows is layed out as follows:
+# {"-relx" "-rely" <rowconfigure|columnconfigure> <row/column number>}
+# -----------------------------------------------------------------------------
+body iwidgets::Labeledframe::_initTable {} {
+ array set _LAYOUT_TABLE {
+ nw-relx 0.0 nw-rely 0.0 nw-wrap 0 nw-conf rowconfigure nw-num 0
+ n-relx 0.5 n-rely 0.0 n-wrap 0 n-conf rowconfigure n-num 0
+ ne-relx 1.0 ne-rely 0.0 ne-wrap 0 ne-conf rowconfigure ne-num 0
+
+ sw-relx 0.0 sw-rely 1.0 sw-wrap 0 sw-conf rowconfigure sw-num 2
+ s-relx 0.5 s-rely 1.0 s-wrap 0 s-conf rowconfigure s-num 2
+ se-relx 1.0 se-rely 1.0 se-wrap 0 se-conf rowconfigure se-num 2
+
+ en-relx 1.0 en-rely 0.0 en-wrap 1 en-conf columnconfigure en-num 2
+ e-relx 1.0 e-rely 0.5 e-wrap 1 e-conf columnconfigure e-num 2
+ es-relx 1.0 es-rely 1.0 es-wrap 1 es-conf columnconfigure es-num 2
+
+ wn-relx 0.0 wn-rely 0.0 wn-wrap 1 wn-conf columnconfigure wn-num 0
+ w-relx 0.0 w-rely 0.5 w-wrap 1 w-conf columnconfigure w-num 0
+ ws-relx 0.0 ws-rely 1.0 ws-wrap 1 ws-conf columnconfigure ws-num 0
+ }
+
+ #
+ # Since this is a one time only thing, we'll redefine the proc to be empty
+ # afterwards so it only happens once.
+ #
+ # NOTE: Be careful to use the "body" command, or the proc will get lost!
+ #
+ itcl::body ::iwidgets::Labeledframe::_initTable {} {}
+}
+
+# -----------------------------------------------------------------------------
+# METHODS
+# -----------------------------------------------------------------------------
+
+# -----------------------------------------------------------------------------
+# PUBLIC METHOD:: childsite
+#
+# -----------------------------------------------------------------------------
+body iwidgets::Labeledframe::childsite {} {
+ return $itk_component(childsite)
+}
+
+# -----------------------------------------------------------------------------
+# PUBLIC METHOD:: clientHandlesConfigure
+#
+# -----------------------------------------------------------------------------
+body iwidgets::Labeledframe::clientHandlesConfigure {{yes 1}} {
+ if {$yes} {
+ set dontUpdate 1
+ bind $itk_component(label) <Configure> { }
+ return [code $this _positionLabel now]
+ } else {
+ bind $itk_component(label) <Configure> [code $this _positionLabel]
+ set dontUpdate 0
+ }
+}
+# -----------------------------------------------------------------------------
+# PROTECTED METHOD: _positionLabel ?when?
+#
+# Places the label in the relief of the labelFrame. If "when" is "now", the
+# change is applied immediately. If it is "later" or it is not
+# specified, then the change is applied later, when the application
+# is idle.
+# -----------------------------------------------------------------------------
+body iwidgets::Labeledframe::_positionLabel {{when later}} {
+
+ if {$when == "later"} {
+ if {$_reposition != ""} {
+ after cancel $_reposition
+ }
+ set _reposition [after idle [code $this _positionLabel now]]
+ return
+ }
+
+ set pos $itk_option(-labelpos)
+
+ #
+ # If there is not an entry for the "relx" value associated with
+ # the given "-labelpos" option value, then it invalid.
+ #
+ if { [catch {set relx $_LAYOUT_TABLE($pos-relx)}] } {
+ error "bad labelpos option\"$itk_option(-labelpos)\": should be\
+ nw, n, ne, sw, s, se, en, e, es, wn, w, or ws"
+ }
+
+ if {!$dontUpdate} {
+ update idletasks
+ if {[string compare $_reposition DESTRUCTOR] == 0} {
+ # OOPS... We are in the process of being destroyed. Get out of here...
+ debug "Stuck in _postionLabel during destruction"
+ return
+ }
+ }
+
+ $itk_component(label) configure -wraplength $_LAYOUT_TABLE($pos-wrap)
+
+ # If there is no text in the label, do not add it to the computation.
+
+ if {$itk_option(-labeltext) == ""} {
+ set minsize 0
+ if {[place slaves $itk_component(labelFrame)] != ""} {
+ place forget $itk_component(label)
+ }
+ _setMarginThickness 0
+ } else {
+ set labelWidth [winfo reqwidth $itk_component(label)]
+ set labelHeight [winfo reqheight $itk_component(label)]
+ set borderwidth $itk_option(-labelborderwidth)
+ set margin $itk_option(-labelmargin)
+
+ switch $pos {
+ nw {
+ set labelThickness $labelHeight
+ set minsize [expr $labelThickness/2.0]
+ set xPos [expr $minsize+$borderwidth+$margin]
+ set yPos -$minsize
+ }
+ n {
+ set labelThickness $labelHeight
+ set minsize [expr $labelThickness/2.0]
+ set xPos [expr -$labelWidth/2.0]
+ set yPos -$minsize
+ }
+ ne {
+ set labelThickness $labelHeight
+ set minsize [expr $labelThickness/2.0]
+ set xPos [expr -($minsize+$borderwidth+$margin+$labelWidth)]
+ set yPos -$minsize
+ }
+
+ sw {
+ set labelThickness $labelHeight
+ set minsize [expr $labelThickness/2.0]
+ set xPos [expr $minsize+$borderwidth+$margin]
+ set yPos -$minsize
+ }
+ s {
+ set labelThickness $labelHeight
+ set minsize [expr $labelThickness/2.0]
+ set xPos [expr -$labelWidth/2.0]
+ set yPos [expr -$labelHeight/2.0]
+ }
+ se {
+ set labelThickness $labelHeight
+ set minsize [expr $labelThickness/2.0]
+ set xPos [expr -($minsize+$borderwidth+$margin+$labelWidth)]
+ set yPos [expr -$labelHeight/2.0]
+ }
+
+ wn {
+ set labelThickness $labelWidth
+ set minsize [expr $labelThickness/2.0]
+ set xPos -$minsize
+ set yPos [expr $minsize+$margin+$borderwidth]
+ }
+ w {
+ set labelThickness $labelWidth
+ set minsize [expr $labelThickness/2.0]
+ set xPos -$minsize
+ set yPos [expr -($labelHeight/2.0)]
+ }
+ ws {
+ set labelThickness $labelWidth
+ set minsize [expr $labelThickness/2.0]
+ set xPos -$minsize
+ set yPos [expr -($minsize+$borderwidth+$margin+$labelHeight)]
+ }
+
+ en {
+ set labelThickness $labelWidth
+ set minsize [expr $labelThickness/2.0]
+ set xPos -$minsize
+ set yPos [expr $minsize+$borderwidth+$margin]
+ }
+ e {
+ set labelThickness $labelWidth
+ set minsize [expr $labelThickness/2.0]
+ set xPos -$minsize
+ set yPos [expr -($labelHeight/2.0)]
+ }
+ es {
+ set labelThickness $labelWidth
+ set minsize [expr $labelThickness/2.0]
+ set xPos -$minsize
+ set yPos [expr -($minsize+$borderwidth+$margin+$labelHeight)]
+ }
+ }
+ _setMarginThickness $minsize
+
+ place $itk_component(label) \
+ -relx $_LAYOUT_TABLE($pos-relx) -x $xPos \
+ -rely $_LAYOUT_TABLE($pos-rely) -y $yPos \
+ -anchor nw
+ }
+
+ set what $_LAYOUT_TABLE($pos-conf)
+ set number $_LAYOUT_TABLE($pos-num)
+
+ grid $what $itk_component(labelFrame) $number -minsize $minsize
+
+ set _reposition ""
+}
+
+# -----------------------------------------------------------------------------
+# PROTECTED METHOD: _collapseMargin
+#
+# Resets the "-minsize" of all rows and columns of the labelFrame's grid
+# used to set the label margin to 0
+# -----------------------------------------------------------------------------
+body iwidgets::Labeledframe::_collapseMargin {} {
+ grid columnconfigure $itk_component(labelFrame) 0 -minsize 0
+ grid columnconfigure $itk_component(labelFrame) 2 -minsize 0
+ grid rowconfigure $itk_component(labelFrame) 0 -minsize 0
+ grid rowconfigure $itk_component(labelFrame) 2 -minsize 0
+}
+
+# -----------------------------------------------------------------------------
+# PROTECTED METHOD: _setMarginThickness
+#
+# Set the margin thickness ( i.e. the hidden "-highlightthickness"
+# of the labelFrame ) to the input value.
+#
+# -----------------------------------------------------------------------------
+body iwidgets::Labeledframe::_setMarginThickness {value} {
+ $itk_component(labelFrame) configure -highlightthickness $value
+}
+
+
diff --git a/itcl/iwidgets3.0.0/generic/labeledwidget.itk b/itcl/iwidgets3.0.0/generic/labeledwidget.itk
new file mode 100644
index 00000000000..6c20ff110ab
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/labeledwidget.itk
@@ -0,0 +1,437 @@
+#
+# Labeledwidget
+# ----------------------------------------------------------------------
+# Implements a labeled widget which contains a label and child site.
+# The child site is a frame which can filled with any widget via a
+# derived class or though the use of the childsite method. This class
+# was designed to be a general purpose base class for supporting the
+# combination of label widget and a childsite, where a label may be
+# text, bitmap or image. The options include the ability to position
+# the label around the childsite widget, modify the font and margin,
+# and control the display of the label.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Labeledwidget {
+ keep -background -cursor -foreground -labelfont
+}
+
+# ------------------------------------------------------------------
+# LABELEDWIDGET
+# ------------------------------------------------------------------
+class iwidgets::Labeledwidget {
+ inherit itk::Widget
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -disabledforeground disabledForeground \
+ DisabledForeground \#a3a3a3
+ itk_option define -labelpos labelPos Position w
+ itk_option define -labelmargin labelMargin Margin 2
+ itk_option define -labeltext labelText Text {}
+ itk_option define -labelvariable labelVariable Variable {}
+ itk_option define -labelbitmap labelBitmap Bitmap {}
+ itk_option define -labelimage labelImage Image {}
+ itk_option define -state state State normal
+
+ public method childsite
+
+ protected method _positionLabel {{when later}}
+
+ proc alignlabels {args} {}
+
+ protected variable _reposition "" ;# non-null => _positionLabel pending
+}
+
+#
+# Provide a lowercased access method for the Labeledwidget class.
+#
+proc ::iwidgets::labeledwidget {pathName args} {
+ uplevel ::iwidgets::Labeledwidget $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Labeledwidget::constructor {args} {
+ #
+ # Create a frame for the childsite widget.
+ #
+ itk_component add -protected lwchildsite {
+ frame $itk_interior.lwchildsite
+ }
+
+ #
+ # Create label.
+ #
+ itk_component add label {
+ label $itk_interior.label
+ } {
+ usual
+
+ rename -font -labelfont labelFont Font
+ ignore -highlightcolor -highlightthickness
+ }
+
+ #
+ # Set the interior to be the childsite for derived classes.
+ #
+ set itk_interior $itk_component(lwchildsite)
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+
+ #
+ # When idle, position the label.
+ #
+ _positionLabel
+}
+
+# ------------------------------------------------------------------
+# DESTURCTOR
+# ------------------------------------------------------------------
+body iwidgets::Labeledwidget::destructor {} {
+ if {$_reposition != ""} {after cancel $_reposition}
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -disabledforeground
+#
+# Specified the foreground to be used on the label when disabled.
+# ------------------------------------------------------------------
+configbody iwidgets::Labeledwidget::disabledforeground {}
+
+# ------------------------------------------------------------------
+# OPTION: -labelpos
+#
+# Set the position of the label on the labeled widget. The margin
+# between the label and childsite comes along for the ride.
+# ------------------------------------------------------------------
+configbody iwidgets::Labeledwidget::labelpos {
+ _positionLabel
+}
+
+# ------------------------------------------------------------------
+# OPTION: -labelmargin
+#
+# Specifies the distance between the widget and label.
+# ------------------------------------------------------------------
+configbody iwidgets::Labeledwidget::labelmargin {
+ _positionLabel
+}
+
+# ------------------------------------------------------------------
+# OPTION: -labeltext
+#
+# Specifies the label text.
+# ------------------------------------------------------------------
+configbody iwidgets::Labeledwidget::labeltext {
+ $itk_component(label) configure -text $itk_option(-labeltext)
+
+ _positionLabel
+}
+
+# ------------------------------------------------------------------
+# OPTION: -labelvariable
+#
+# Specifies the label text variable.
+# ------------------------------------------------------------------
+configbody iwidgets::Labeledwidget::labelvariable {
+ $itk_component(label) configure -textvariable $itk_option(-labelvariable)
+
+ uplevel [list trace variable \
+ $itk_option(-labelvariable) w [code _positionLabel]]
+
+ _positionLabel
+}
+
+# ------------------------------------------------------------------
+# OPTION: -labelbitmap
+#
+# Specifies the label bitmap.
+# ------------------------------------------------------------------
+configbody iwidgets::Labeledwidget::labelbitmap {
+ $itk_component(label) configure -bitmap $itk_option(-labelbitmap)
+
+ _positionLabel
+}
+
+# ------------------------------------------------------------------
+# OPTION: -labelimage
+#
+# Specifies the label image.
+# ------------------------------------------------------------------
+configbody iwidgets::Labeledwidget::labelimage {
+ $itk_component(label) configure -image $itk_option(-labelimage)
+
+ _positionLabel
+}
+
+# ------------------------------------------------------------------
+# OPTION: -state
+#
+# Specifies the state of the label.
+# ------------------------------------------------------------------
+configbody iwidgets::Labeledwidget::state {
+ _positionLabel
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: childsite
+#
+# Returns the path name of the child site widget.
+# ------------------------------------------------------------------
+body iwidgets::Labeledwidget::childsite {} {
+ return $itk_component(lwchildsite)
+}
+
+# ------------------------------------------------------------------
+# PROCEDURE: alignlabels widget ?widget ...?
+#
+# The alignlabels procedure takes a list of widgets derived from
+# the Labeledwidget class and adjusts the label margin to align
+# the labels.
+# ------------------------------------------------------------------
+body iwidgets::Labeledwidget::alignlabels {args} {
+ update
+ set maxLabelWidth 0
+
+ #
+ # Verify that all the widgets are of type Labeledwidget and
+ # determine the size of the maximum length label string.
+ #
+ foreach iwid $args {
+ set objcmd [itcl::find objects -isa Labeledwidget *::$iwid]
+
+ if {$objcmd == ""} {
+ error "$iwid is not a \"Labeledwidget\""
+ }
+
+ set csWidth [winfo reqwidth $iwid.lwchildsite]
+ set shellWidth [winfo reqwidth $iwid]
+
+ if {[expr $shellWidth - $csWidth] > $maxLabelWidth} {
+ set maxLabelWidth [expr $shellWidth - $csWidth]
+ }
+ }
+
+ #
+ # Adjust the margins for the labels such that the child sites and
+ # labels line up.
+ #
+ foreach iwid $args {
+ set csWidth [winfo reqwidth $iwid.lwchildsite]
+ set shellWidth [winfo reqwidth $iwid]
+
+ set labelSize [expr $shellWidth - $csWidth]
+
+ if {$maxLabelWidth > $labelSize} {
+ set objcmd [itcl::find objects -isa Labeledwidget *::$iwid]
+ set dist [expr $maxLabelWidth - \
+ ($labelSize - [$objcmd cget -labelmargin])]
+
+ $objcmd configure -labelmargin $dist
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _positionLabel ?when?
+#
+# Packs the label and label margin. If "when" is "now", the
+# change is applied immediately. If it is "later" or it is not
+# specified, then the change is applied later, when the application
+# is idle.
+# ------------------------------------------------------------------
+body iwidgets::Labeledwidget::_positionLabel {{when later}} {
+ if {$when == "later"} {
+ if {$_reposition == ""} {
+ set _reposition [after idle [code $this _positionLabel now]]
+ }
+ return
+
+ } elseif {$when != "now"} {
+ error "bad option \"$when\": should be now or later"
+ }
+
+ #
+ # If we have a label, be it text, bitmap, or image continue.
+ #
+ if {($itk_option(-labeltext) != {}) || \
+ ($itk_option(-labelbitmap) != {}) || \
+ ($itk_option(-labelimage) != {}) || \
+ ($itk_option(-labelvariable) != {})} {
+
+ #
+ # Set the foreground color based on the state.
+ #
+ if {[info exists itk_option(-state)]} {
+ switch -- $itk_option(-state) {
+ disabled {
+ $itk_component(label) configure \
+ -foreground $itk_option(-disabledforeground)
+ }
+ normal {
+ $itk_component(label) configure \
+ -foreground $itk_option(-foreground)
+ }
+ }
+ }
+
+ set parent [winfo parent $itk_component(lwchildsite)]
+
+ #
+ # Switch on the label position option. Using the grid,
+ # adjust the row/column setting of the label, margin, and
+ # and childsite. The margin height/width is adjust based
+ # on the orientation as well. Finally, set the weights such
+ # that the childsite takes the heat on expansion and shrinkage.
+ #
+ switch $itk_option(-labelpos) {
+ nw -
+ n -
+ ne {
+ grid $itk_component(label) -row 0 -column 0 \
+ -sticky $itk_option(-labelpos)
+ grid $itk_component(lwchildsite) -row 2 -column 0 \
+ -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 0 -minsize 0
+ grid rowconfigure $parent 1 -weight 0 -minsize \
+ [winfo pixels $itk_component(label) \
+ $itk_option(-labelmargin)]
+ grid rowconfigure $parent 2 -weight 1 -minsize 0
+
+ grid columnconfigure $parent 0 -weight 1 -minsize 0
+ grid columnconfigure $parent 1 -weight 0 -minsize 0
+ grid columnconfigure $parent 2 -weight 0 -minsize 0
+ }
+
+ en -
+ e -
+ es {
+ grid $itk_component(lwchildsite) -row 0 -column 0 \
+ -sticky nsew
+ grid $itk_component(label) -row 0 -column 2 \
+ -sticky $itk_option(-labelpos)
+
+ grid rowconfigure $parent 0 -weight 1 -minsize 0
+ grid rowconfigure $parent 1 -weight 0 -minsize 0
+ grid rowconfigure $parent 2 -weight 0 -minsize 0
+
+ grid columnconfigure $parent 0 -weight 1 -minsize 0
+ grid columnconfigure $parent 1 -weight 0 -minsize \
+ [winfo pixels $itk_component(label) \
+ $itk_option(-labelmargin)]
+ grid columnconfigure $parent 2 -weight 0 -minsize 0
+ }
+
+ se -
+ s -
+ sw {
+ grid $itk_component(lwchildsite) -row 0 -column 0 \
+ -sticky nsew
+ grid $itk_component(label) -row 2 -column 0 \
+ -sticky $itk_option(-labelpos)
+
+ grid rowconfigure $parent 0 -weight 1 -minsize 0
+ grid rowconfigure $parent 1 -weight 0 -minsize \
+ [winfo pixels $itk_component(label) \
+ $itk_option(-labelmargin)]
+ grid rowconfigure $parent 2 -weight 0 -minsize 0
+
+ grid columnconfigure $parent 0 -weight 1 -minsize 0
+ grid columnconfigure $parent 1 -weight 0 -minsize 0
+ grid columnconfigure $parent 2 -weight 0 -minsize 0
+ }
+
+ wn -
+ w -
+ ws {
+ grid $itk_component(lwchildsite) -row 0 -column 2 \
+ -sticky nsew
+ grid $itk_component(label) -row 0 -column 0 \
+ -sticky $itk_option(-labelpos)
+
+ grid rowconfigure $parent 0 -weight 1 -minsize 0
+ grid rowconfigure $parent 1 -weight 0 -minsize 0
+ grid rowconfigure $parent 2 -weight 0 -minsize 0
+
+ grid columnconfigure $parent 0 -weight 0 -minsize 0
+ grid columnconfigure $parent 1 -weight 0 -minsize \
+ [winfo pixels $itk_component(label) \
+ $itk_option(-labelmargin)]
+ grid columnconfigure $parent 2 -weight 1 -minsize 0
+ }
+
+ default {
+ error "bad labelpos option\
+ \"$itk_option(-labelpos)\": should be\
+ nw, n, ne, sw, s, se, en, e, es, wn, w, or ws"
+ }
+ }
+
+ #
+ # Else, neither the label text, bitmap, or image have a value, so
+ # forget them so they don't appear and manage only the childsite.
+ #
+ } else {
+ grid forget $itk_component(label)
+
+ grid $itk_component(lwchildsite) -row 0 -column 0 -sticky nsew
+
+ set parent [winfo parent $itk_component(lwchildsite)]
+
+ grid rowconfigure $parent 0 -weight 1 -minsize 0
+ grid rowconfigure $parent 1 -weight 0 -minsize 0
+ grid rowconfigure $parent 2 -weight 0 -minsize 0
+ grid columnconfigure $parent 0 -weight 1 -minsize 0
+ grid columnconfigure $parent 1 -weight 0 -minsize 0
+ grid columnconfigure $parent 2 -weight 0 -minsize 0
+ }
+
+ #
+ # Reset the resposition flag.
+ #
+ set _reposition ""
+}
diff --git a/itcl/iwidgets3.0.0/generic/mainwindow.itk b/itcl/iwidgets3.0.0/generic/mainwindow.itk
new file mode 100644
index 00000000000..b5cc895e88e
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/mainwindow.itk
@@ -0,0 +1,313 @@
+#
+# Mainwindow
+# ----------------------------------------------------------------------
+# This class implements a mainwindow containing a menubar, toolbar,
+# mousebar, childsite, status line, and help line. Each item may
+# be filled and configured to suit individual needs.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
+#
+# @(#) RCS: $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1997 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+# ------------------------------------------------------------------
+# MAINWINDOW
+# ------------------------------------------------------------------
+class iwidgets::Mainwindow {
+ inherit iwidgets::Shell
+
+ constructor {args} {}
+
+ itk_option define -helpline helpLine HelpLine 1
+ itk_option define -statusline statusLine StatusLine 1
+
+ public {
+ method childsite {}
+ method menubar {args}
+ method mousebar {args}
+ method msgd {args}
+ method toolbar {args}
+ }
+
+ protected {
+ method _exitCB {}
+
+ common _helpVar
+ common _statusVar
+ }
+}
+
+#
+# Provide a lowercased access method for the ::iwidgets::Mainwindow class.
+#
+proc iwidgets::mainwindow {pathName args} {
+ uplevel ::iwidgets::Mainwindow $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Mainwindow::constructor {args} {
+ itk_option add hull.width hull.height
+
+ pack propagate $itk_component(hull) no
+
+ wm protocol $itk_component(hull) WM_DELETE_WINDOW [code $this _exitCB]
+
+ #
+ # Create a menubar, renaming the font, foreground, and background
+ # so they may be separately set. The help variable will be setup
+ # as well.
+ #
+ itk_component add menubar {
+ iwidgets::Menubar $itk_interior.menubar \
+ -helpvariable [scope _helpVar($this)]
+ } {
+ keep -disabledforeground -cursor \
+ -highlightbackground -highlightthickness
+ rename -font \
+ -menubarfont menuBarFont Font
+ rename -foreground \
+ -menubarforeground menuBarForeground Foreground
+ rename -background \
+ -menubarbackground menuBarBackground Background
+ }
+
+ #
+ # Add a toolbar beneath the menubar.
+ #
+ itk_component add toolbar {
+ iwidgets::Toolbar $itk_interior.toolbar -orient horizontal \
+ -helpvariable [scope _helpVar($this)]
+ } {
+ keep -balloonbackground -balloondelay1 -balloondelay2 \
+ -balloonfont -balloonforeground -disabledforeground -cursor \
+ -highlightbackground -highlightthickness
+ rename -font -toolbarfont toolbarFont Font
+ rename -foreground -toolbarforeground toolbarForeground Foreground
+ rename -background -toolbarbackground toolbarBackground Background
+ }
+
+ #
+ # Add a mouse bar on the left.
+ #
+ itk_component add mousebar {
+ iwidgets::Toolbar $itk_interior.mousebar -orient vertical \
+ -helpvariable [scope _helpVar($this)]
+ } {
+ keep -balloonbackground -balloondelay1 -balloondelay2 \
+ -balloonfont -balloonforeground -disabledforeground -cursor \
+ -highlightbackground -highlightthickness
+ rename -font -toolbarfont toolbarFont Font
+ rename -foreground -toolbarforeground toolbarForeground Foreground
+ rename -background -toolbarbackground toolbarBackground Background
+ }
+
+ #
+ # Create the childsite window window.
+ #
+ itk_component add -protected mwchildsite {
+ frame $itk_interior.mwchildsite
+ }
+
+ #
+ # Add the help and system status lines
+ #
+ itk_component add -protected lineframe {
+ frame $itk_interior.lineframe
+ }
+
+ itk_component add help {
+ label $itk_component(lineframe).help \
+ -textvariable [scope _helpVar($this)] \
+ -relief sunken -borderwidth 2 -width 10
+ }
+
+ itk_component add status {
+ label $itk_component(lineframe).status \
+ -textvariable [scope _statusVar($this)] \
+ -relief sunken -borderwidth 2 -width 10
+ }
+
+ #
+ # Create the message dialog for use throughout the mainwindow.
+ #
+ itk_component add msgd {
+ iwidgets::Messagedialog $itk_interior.msgd -modality application
+ } {
+ usual
+ ignore -modality
+ }
+
+ #
+ # Use the grid to pack together the menubar, toolbar, mousebar,
+ # childsite, and status area.
+ #
+ grid $itk_component(menubar) -row 0 -column 0 -columnspan 2 -sticky ew
+ grid $itk_component(toolbar) -row 1 -column 0 -columnspan 2 -sticky ew
+ grid $itk_component(mousebar) -row 2 -column 0 -sticky ns
+ grid $itk_component(mwchildsite) -row 2 -column 1 -sticky nsew \
+ -padx 5 -pady 5
+ grid $itk_component(lineframe) -row 3 -column 0 -columnspan 2 -sticky ew
+
+ grid columnconfigure $itk_interior 1 -weight 1
+ grid rowconfigure $itk_interior 2 -weight 1
+
+ #
+ # Set the interior to be the childsite for derived classes.
+ #
+ set itk_interior $itk_component(mwchildsite)
+
+ #
+ # Initialize all the configuration options.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -helpline
+#
+# Specifies whether or not to display the help line. The value
+# may be given in any of the forms acceptable to Tk_GetBoolean.
+# ------------------------------------------------------------------
+configbody iwidgets::Mainwindow::helpline {
+ if {$itk_option(-helpline)} {
+ pack $itk_component(help) -side left -fill x -expand yes -padx 2
+ } else {
+ pack forget $itk_component(help)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -statusline
+#
+# Specifies whether or not to display the status line. The value
+# may be given in any of the forms acceptable to Tk_GetBoolean.
+# ------------------------------------------------------------------
+configbody iwidgets::Mainwindow::statusline {
+ if {$itk_option(-statusline)} {
+ pack $itk_component(status) -side right -fill x -expand yes -padx 2
+ } else {
+ pack forget $itk_component(status)
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: childsite
+#
+# Return the childsite widget.
+# ------------------------------------------------------------------
+body iwidgets::Mainwindow::childsite {} {
+ return $itk_component(mwchildsite)
+}
+
+# ------------------------------------------------------------------
+# METHOD: menubar ?args?
+#
+# Evaluate the args against the Menubar component.
+# ------------------------------------------------------------------
+body iwidgets::Mainwindow::menubar {args} {
+ if {[llength $args] == 0} {
+ return $itk_component(menubar)
+ } else {
+ return [eval $itk_component(menubar) $args]
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: toolbar ?args?
+#
+# Evaluate the args against the Toolbar component.
+# ------------------------------------------------------------------
+body iwidgets::Mainwindow::toolbar {args} {
+ if {[llength $args] == 0} {
+ return $itk_component(toolbar)
+ } else {
+ return [eval $itk_component(toolbar) $args]
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: mousebar ?args?
+#
+# Evaluate the args against the Mousebar component.
+# ------------------------------------------------------------------
+body iwidgets::Mainwindow::mousebar {args} {
+ if {[llength $args] == 0} {
+ return $itk_component(mousebar)
+ } else {
+ return [eval $itk_component(mousebar) $args]
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: msgd ?args?
+#
+# Evaluate the args against the Messagedialog component.
+# ------------------------------------------------------------------
+body iwidgets::Mainwindow::msgd {args} {
+ if {[llength $args] == 0} {
+ return $itk_component(msgd)
+ } else {
+ return [eval $itk_component(msgd) $args]
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _exitCB
+#
+# Menu callback for the exit option from the file menu. The method
+# confirms the user's request to exit the application prior to
+# taking the action.
+# ------------------------------------------------------------------
+body iwidgets::Mainwindow::_exitCB {} {
+ #
+ # Configure the message dialog for confirmation of the exit request.
+ #
+ msgd configure -title Confirmation -bitmap questhead \
+ -text "Exit confirmation\n\
+ Are you sure ?"
+ msgd buttonconfigure OK -text Yes
+ msgd buttonconfigure Cancel -text No
+ msgd default Cancel
+ msgd center $itk_component(hull)
+
+ #
+ # Activate the message dialog and given a positive response
+ # proceed to exit the application
+ #
+ if {[msgd activate]} {
+ ::exit
+ }
+}
diff --git a/itcl/iwidgets3.0.0/generic/menubar.itk b/itcl/iwidgets3.0.0/generic/menubar.itk
new file mode 100644
index 00000000000..35f1a669374
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/menubar.itk
@@ -0,0 +1,2240 @@
+#
+# Menubar widget
+# ----------------------------------------------------------------------
+# The Menubar command creates a new window (given by the pathName
+# argument) and makes it into a Pull down menu widget. Additional
+# options, described above may be specified on the command line or
+# in the option database to configure aspects of the Menubar such
+# as its colors and font. The Menubar command returns its pathName
+# argument. At the time this command is invoked, there must not exist
+# a window named pathName, but pathName's parent must exist.
+#
+# A Menubar is a widget that simplifies the task of creating
+# menu hierarchies. It encapsulates a frame widget, as well
+# as menubuttons, menus, and menu entries. The Menubar allows
+# menus to be specified and refer enced in a more consistent
+# manner than using Tk to build menus directly. First, Menubar
+# allows a menu tree to be expressed in a hierachical "language".
+# The Menubar accepts a menuButtons option that allows a list of
+# menubuttons to be added to the Menubar. In turn, each menubutton
+# accepts a menu option that spec ifies a list of menu entries
+# to be added to the menubutton's menu (as well as an option
+# set for the menu). Cascade entries in turn, accept a menu
+# option that specifies a list of menu entries to be added to
+# the cascade's menu (as well as an option set for the menu). In
+# this manner, a complete menu grammar can be expressed to the
+# Menubar. Additionally, the Menubar allows each component of
+# the Menubar system to be referenced by a simple componentPathName
+# syntax. Finally, the Menubar extends the option set of menu
+# entries to include the helpStr option used to implement status
+# bar help.
+#
+# WISH LIST:
+# This section lists possible future enhancements.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Bill W. Scott EMAIL: bscott@spd.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+
+#
+# Usual options.
+#
+itk::usual Menubar {
+ keep -activebackground -activeborderwidth -activeforeground \
+ -anchor -background -borderwidth -cursor -disabledforeground \
+ -font -foreground -highlightbackground -highlightthickness \
+ -highlightcolor -justify -padx -pady -wraplength
+}
+
+class iwidgets::Menubar {
+ inherit itk::Widget
+
+ constructor { args } {}
+
+ itk_option define -foreground foreground Foreground Black
+ itk_option define -activebackground activeBackground Foreground "#ececec"
+ itk_option define -activeborderwidth activeBorderWidth BorderWidth 2
+ itk_option define -activeforeground activeForeground Background black
+ itk_option define -anchor anchor Anchor center
+ itk_option define -borderwidth borderWidth BorderWidth 2
+ itk_option define \
+ -disabledforeground disabledForeground DisabledForeground #a3a3a3
+ itk_option define \
+ -font font Font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*"
+ itk_option define \
+ -highlightbackground highlightBackground HighlightBackground #d9d9d9
+ itk_option define -highlightcolor highlightColor HighlightColor Black
+ itk_option define \
+ -highlightthickness highlightThickness HighlightThickness 0
+ itk_option define -justify justify Justify center
+ itk_option define -padx padX Pad 4p
+ itk_option define -pady padY Pad 3p
+ itk_option define -wraplength wrapLength WrapLength 0
+ itk_option define -menubuttons menuButtons MenuButtons {}
+ itk_option define -helpvariable helpVariable HelpVariable {}
+
+ public {
+ method add { type path args } { }
+ method delete { args } { }
+ method index { path } { }
+ method insert { beforeComponent type name args }
+ method invoke { entryPath } { }
+ method menucget { args } { }
+ method menuconfigure { path args } { }
+ method path { args } { }
+ method type { path } { }
+ method yposition { entryPath } { }
+
+ method _helpHandler { menuPath } { }
+ }
+
+ private {
+ method menubutton { menuName args } { }
+ method options { args } { }
+ method command { cmdName args } { }
+ method checkbutton { chkName args } { }
+ method radiobutton { radName args } { }
+ method separator { sepName args } { }
+ method cascade { casName args } { }
+ method _addMenuButton { buttonName args} { }
+ method _insertMenuButton { beforeMenuPath buttonName args} { }
+ method _makeMenuButton {buttonName args} { }
+ method _makeMenu \
+ { componentName widgetName menuPath menuEvalStr } { }
+ method _substEvalStr { evalStr } { }
+ method _deleteMenu { menuPath {menuPath2 {}} } { }
+ method _deleteAMenu { path } { }
+ method _addEntry { type path args } { }
+ method _addCascade { tkMenuPath path args } { }
+ method _insertEntry { beforeEntryPath type name args } { }
+ method _insertCascade { bfIndex tkMenuPath path args } { }
+ method _deleteEntry { entryPath {entryPath2 {}} } { }
+ method _configureMenu { path tkPath {option {}} args } { }
+ method _configureMenuOption { type path args } { }
+ method _configureMenuEntry { path index {option {}} args } { }
+ method _unsetPaths { parent } { }
+ method _entryPathToTkMenuPath {entryPath} { }
+ method _getTkIndex { tkMenuPath tkIndex} { }
+ method _getPdIndex { tkMenuPath tkIndex } { }
+ method _getMenuList { } { }
+ method _getEntryList { menu } { }
+ method _parsePath { path } { }
+ method _getSymbolicPath { parent segment } { }
+ method _getCallerLevel { }
+
+ variable _parseLevel 0 ;# The parse level depth
+ variable _callerLevel #0 ;# abs level of caller
+ variable _pathMap ;# Array indexed by Menubar's path
+ ;# naming, yields tk menu path
+ variable _entryIndex -1 ;# current entry help is displayed
+ ;# for during help <motion> events
+
+ variable _tkMenuPath ;# last tk menu being added to
+ variable _ourMenuPath ;# our last valid path constructed.
+
+ variable _menuOption ;# The -menu option
+ variable _helpString ;# The -helpstr optio
+ }
+}
+
+#
+# Use option database to override default resources.
+#
+option add *Menubar*Menu*tearOff false widgetDefault
+option add *Menubar*Menubutton*relief flat widgetDefault
+option add *Menubar*Menu*relief raised widgetDefault
+
+#
+# Provide a lowercase access method for the menubar class
+#
+proc ::iwidgets::menubar { args } {
+ uplevel ::iwidgets::Menubar $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Menubar::constructor { args } {
+ component hull configure -borderwidth 0
+
+ #
+ # Create the Menubar Frame that will hold the menus.
+ #
+ # might want to make -relief and -bd options with defaults
+ itk_component add menubar {
+ frame $itk_interior.menubar -relief raised -bd 2
+ } {
+ keep -cursor -background -width -height
+ }
+ pack $itk_component(menubar) -fill both -expand yes
+
+ # Map our pathname to class to the actual menubar frame
+ set _pathMap(.) $itk_component(menubar)
+
+ eval itk_initialize $args
+
+ #
+ # HACK HACK HACK
+ # Tk expects some variables to be defined and due to some
+ # unknown reason we confuse its normal ordering. So, if
+ # the user creates a menubutton with no menu it will fail
+ # when clicked on with a "Error: can't read $tkPriv(oldGrab):
+ # no such element in array". So by setting it to null we
+ # avoid this error.
+ uplevel #0 "set tkPriv(oldGrab) {}"
+
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+# This first set of options are for configuring menus and/or menubuttons
+# at the menu level.
+#
+# ------------------------------------------------------------------
+# OPTION -foreground
+#
+# menu
+# menubutton
+# ------------------------------------------------------------------
+configbody iwidgets::Menubar::foreground {
+}
+
+# ------------------------------------------------------------------
+# OPTION -activebackground
+#
+# menu
+# menubutton
+# ------------------------------------------------------------------
+configbody iwidgets::Menubar::activebackground {
+}
+
+# ------------------------------------------------------------------
+# OPTION -activeborderwidth
+#
+# menu
+# ------------------------------------------------------------------
+configbody iwidgets::Menubar::activeborderwidth {
+}
+
+# ------------------------------------------------------------------
+# OPTION -activeforeground
+#
+# menu
+# menubutton
+# ------------------------------------------------------------------
+configbody iwidgets::Menubar::activeforeground {
+}
+
+# ------------------------------------------------------------------
+# OPTION -anchor
+#
+# menubutton
+# ------------------------------------------------------------------
+configbody iwidgets::Menubar::anchor {
+}
+
+# ------------------------------------------------------------------
+# OPTION -borderwidth
+#
+# menu
+# menubutton
+# ------------------------------------------------------------------
+configbody iwidgets::Menubar::borderwidth {
+}
+
+# ------------------------------------------------------------------
+# OPTION -disabledforeground
+#
+# menu
+# menubutton
+# ------------------------------------------------------------------
+configbody iwidgets::Menubar::disabledforeground {
+}
+
+# ------------------------------------------------------------------
+# OPTION -font
+#
+# menu
+# menubutton
+# ------------------------------------------------------------------
+configbody iwidgets::Menubar::font {
+}
+
+# ------------------------------------------------------------------
+# OPTION -highlightbackground
+#
+# menubutton
+# ------------------------------------------------------------------
+configbody iwidgets::Menubar::highlightbackground {
+}
+
+# ------------------------------------------------------------------
+# OPTION -highlightcolor
+#
+# menubutton
+# ------------------------------------------------------------------
+configbody iwidgets::Menubar::highlightcolor {
+}
+
+# ------------------------------------------------------------------
+# OPTION -highlightthickness
+#
+# menubutton
+# ------------------------------------------------------------------
+configbody iwidgets::Menubar::highlightthickness {
+}
+
+# ------------------------------------------------------------------
+# OPTION -justify
+#
+# menubutton
+# ------------------------------------------------------------------
+configbody iwidgets::Menubar::justify {
+}
+
+# ------------------------------------------------------------------
+# OPTION -padx
+#
+# menubutton
+# ------------------------------------------------------------------
+configbody iwidgets::Menubar::padx {
+}
+
+# ------------------------------------------------------------------
+# OPTION -pady
+#
+# menubutton
+# ------------------------------------------------------------------
+configbody iwidgets::Menubar::pady {
+}
+
+# ------------------------------------------------------------------
+# OPTION -wraplength
+#
+# menubutton
+# ------------------------------------------------------------------
+configbody iwidgets::Menubar::wraplength {
+}
+
+# ------------------------------------------------------------------
+# OPTION -menubuttons
+#
+# The menuButton option is a string which specifies the arrangement
+# of menubuttons on the Menubar frame. Each menubutton entry is
+# delimited by the newline character. Each entry is treated as
+# an add command to the Menubar.
+#
+# ------------------------------------------------------------------
+configbody iwidgets::Menubar::menubuttons {
+ if { $itk_option(-menubuttons) != {} } {
+
+ # IF one exists already, delete the old one and create
+ # a new one
+ if { ! [catch {_parsePath .0}] } {
+ delete .0 .last
+ }
+
+ #
+ # Determine the context level to evaluate the option string at
+ #
+ set _callerLevel [_getCallerLevel]
+
+ #
+ # Parse the option string in their scope, then execute it in
+ # our scope.
+ #
+ incr _parseLevel
+ _substEvalStr itk_option(-menubuttons)
+ eval $itk_option(-menubuttons)
+
+ # reset so that we know we aren't parsing in a scope currently.
+ incr _parseLevel -1
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION -helpvariable
+#
+# Specifies the global variable to update whenever the mouse is in
+# motion over a menu entry. This global variable is updated with the
+# current value of the active menu entry's helpStr. Other widgets
+# can "watch" this variable with the trace command, or as is the
+# case with entry or label widgets, they can set their textVariable
+# to the same global variable. This allows for a simple implementation
+# of a help status bar. Whenever the mouse leaves a menu entry,
+# the helpVariable is set to the empty string {}.
+# ------------------------------------------------------------------
+configbody iwidgets::Menubar::helpvariable {
+ if {"" != $itk_option(-helpvariable) &&
+ ![string match ::* $itk_option(-helpvariable)] &&
+ ![string match @itcl* $itk_option(-helpvariable)]} {
+ set itk_option(-helpvariable) "::$itk_option(-helpvariable)"
+ }
+}
+
+
+# -------------------------------------------------------------
+#
+# METHOD: add type path args
+#
+# Adds either a menu to the menu bar or a menu entry to a
+# menu pane.
+#
+# If the type is one of cascade, checkbutton, command,
+# radiobutton, or separator it adds a new entry to the bottom
+# of the menu denoted by the menuPath prefix of componentPath-
+# Name. The new entry's type is given by type. If additional
+# arguments are present, they specify options available to
+# component type Entry. See the man pages for menu(n) in the
+# section on Entries. In addition all entries accept an added
+# option, helpStr:
+#
+# -helpstr value
+#
+# Specifes the string to associate with the entry.
+# When the mouse moves over the associated entry, the variable
+# denoted by helpVariable is set. Another widget can bind to
+# the helpVariable and thus display status help.
+#
+# If the type is menubutton, it adds a new menubut-
+# ton to the menu bar. If additional arguments are present,
+# they specify options available to component type MenuButton.
+#
+# If the type is menubutton or cascade, the menu
+# option is available in addition to normal Tk options for
+# these to types.
+#
+# -menu menuSpec
+#
+# This is only valid for componentPathNames of type
+# menubutton or cascade. Specifes an option set and/or a set
+# of entries to place on a menu and associate with the menu-
+# button or cascade. The option keyword allows the menu widget
+# to be configured. Each item in the menuSpec is treated as
+# add commands (each with the possibility of having other
+# -menu options). In this way a menu can be recursively built.
+#
+# The last segment of componentPathName cannot be
+# one of the keywords last, menu, end. Additionally, it may
+# not be a number. However the componentPathName may be refer-
+# enced in this manner (see discussion of Component Path
+# Names).
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::add { type path args } {
+ if ![regexp \
+ {^(menubutton|command|cascade|separator|radiobutton|checkbutton)$} \
+ $type] {
+ error "bad type \"$type\": must be one of the following:\
+ \"command\", \"checkbutton\", \"radiobutton\",\
+ \"separator\", \"cascade\", or \"menubutton\""
+ }
+ regexp {[^.]+$} $path segName
+ if [regexp {^(menu|last|end|[0-9]+)$} $segName] {
+ error "bad name \"$segName\": user created component \
+ path names may not end with \
+ \"end\", \"last\", \"menu\", \
+ or be an integer"
+ }
+
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # OK, either add a menu
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ if { $type == "menubutton" } {
+ # grab the last component name (the menu name)
+ eval _addMenuButton $segName $args
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Or add an entry
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ } else {
+ eval _addEntry $type $path $args
+ }
+}
+
+
+# -------------------------------------------------------------
+#
+# METHOD: delete entryPath ?entryPath2?
+#
+# If componentPathName is of component type MenuButton or
+# Menu, delete operates on menus. If componentPathName is of
+# component type Entry, delete operates on menu entries.
+#
+# This command deletes all components between com-
+# ponentPathName and componentPathName2 inclusive. If com-
+# ponentPathName2 is omitted then it defaults to com-
+# ponentPathName. Returns an empty string.
+#
+# If componentPathName is of type Menubar, then all menus
+# and the menu bar frame will be destroyed. In this case com-
+# ponentPathName2 is ignored.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::delete { args } {
+
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Handle out of bounds in arg lengths
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ if { [llength $args] > 0 && [llength $args] <=2 } {
+
+ # Path Conversions
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ set path [_parsePath [lindex $args 0]]
+
+ set pathOrIndex $_pathMap($path)
+
+ # Menu Entry
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ if { [regexp {^[0-9]+$} $pathOrIndex] } {
+ eval "_deleteEntry $args"
+
+ # Menu
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ } else {
+ eval "_deleteMenu $args"
+ }
+ } else {
+ error "wrong # args: should be \
+ \"$itk_component(hull) delete pathName ?pathName2?\""
+ }
+ return ""
+}
+
+# -------------------------------------------------------------
+#
+# METHOD: index path
+#
+# If componentPathName is of type menubutton or menu, it
+# returns the position of the menu/menubutton on the Menubar
+# frame.
+#
+# If componentPathName is of type command, separator,
+# radiobutton, checkbutton, or cascade, it returns the menu
+# widget's numerical index for the entry corresponding to com-
+# ponentPathName. If path is not found or the Menubar frame is
+# passed in, -1 is returned.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::index { path } {
+
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Path conversions
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ if { [catch {set fullPath [_parsePath $path]} ] } {
+ return -1
+ }
+ if { [catch {set tkPathOrIndex $_pathMap($fullPath)} ] } {
+ return -1
+ }
+
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # If integer, return the value, otherwise look up the menu position
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ if { [regexp {^[0-9]+$} $tkPathOrIndex] } {
+ set index $tkPathOrIndex
+ } else {
+ set index [lsearch [_getMenuList] $fullPath]
+ }
+
+ return $index
+}
+
+# -------------------------------------------------------------
+#
+# METHOD: insert beforeComponent type name ?option value?
+#
+# Insert a new component named name before the component
+# specified by componentPathName.
+#
+# If componentPathName is of type MenuButton or Menu, the
+# new component inserted is of type Menu and given the name
+# name. In this case valid option value pairs are those
+# accepted by menubuttons.
+#
+# If componentPathName is of type Entry, the new com-
+# ponent inserted is of type Entry and given the name name. In
+# this case valid option value pairs are those accepted by
+# menu entries.
+#
+# name cannot be one of the keywords last, menu, end.
+# dditionally, it may not be a number. However the com-
+# ponentPathName may be referenced in this manner (see discus-
+# sion of Component Path Names).
+#
+# Returns -1 if the menubar frame is passed in.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::insert { beforeComponent type name args } {
+ if ![regexp \
+ {^(menubutton|command|cascade|separator|radiobutton|checkbutton)$} \
+ $type] {
+ error "bad type \"$type\": must be one of the following:\
+ \"command\", \"checkbutton\", \"radiobutton\",\
+ \"separator\", \"cascade\", or \"menubutton\""
+ }
+ regexp {[^.]+$} $name segName
+ if [regexp {^(menu|last|end|[0-9]+)$} $segName] {
+ error "bad name \"$name\": user created component \
+ path names may not end with \
+ \"end\", \"last\", \"menu\", \
+ or be an integer"
+ }
+
+ set beforeComponent [_parsePath $beforeComponent]
+
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Choose menu insertion or entry insertion
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ if { $type == "menubutton" } {
+ eval _insertMenuButton $beforeComponent $name $args
+ } else {
+ eval _insertEntry $beforeComponent $type $name $args
+ }
+}
+
+
+# -------------------------------------------------------------
+#
+# METHOD: invoke entryPath
+#
+# Invoke the action of the menu entry denoted by
+# entryComponentPathName. See the sections on the individual
+# entries in the menu(n) man pages. If the menu entry is dis-
+# abled then nothing happens. If the entry has a command
+# associated with it then the result of that command is
+# returned as the result of the invoke widget command. Other-
+# wise the result is an empty string.
+#
+# If componentPathName is not a menu entry, an error is
+# issued.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::invoke { entryPath } {
+
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Path Conversions
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ set entryPath [_parsePath $entryPath]
+ set index $_pathMap($entryPath)
+
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Error Processing
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ # first verify that beforeEntryPath is actually a path to
+ # an entry and not to menu, menubutton, etc.
+ if { ! [regexp {^[0-9]+$} $index] } {
+ error "bad entry path: beforeEntryPath is not an entry"
+ }
+
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Call invoke command
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ # get the tk menu path to call
+ set tkMenuPath [_entryPathToTkMenuPath $entryPath]
+
+ # call the menu's invoke command, adjusting index based on tearoff
+ $tkMenuPath invoke [_getTkIndex $tkMenuPath $index]
+}
+
+# -------------------------------------------------------------
+#
+# METHOD: menucget componentPath option
+#
+# Returns the current value of the configuration option
+# given by option. The component type of componentPathName
+# determines the valid available options.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::menucget { path opt } {
+ return [lindex [menuconfigure $path $opt] 4]
+}
+
+# -------------------------------------------------------------
+#
+# METHOD: menuconfigure componentPath ?option? ?value option value...?
+#
+# Query or modify the configuration options of the sub-
+# component of the Menubar specified by componentPathName. If
+# no option is specified, returns a list describing all of the
+# available options for componentPathName (see
+# Tk_ConfigureInfo for information on the format of this
+# list). If option is specified with no value, then the com-
+# mand returns a list describing the one named option (this
+# list will be identical to the corresponding sublist of the
+# value returned if no option is specified). If one or more
+# option-value pairs are specified, then the command modifies
+# the given widget option(s) to have the given value(s); in
+# this case the command returns an empty string. The component
+# type of componentPathName determines the valid available
+# options.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::menuconfigure { path args } {
+
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Path Conversions
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ set path [_parsePath $path]
+ set tkPathOrIndex $_pathMap($path)
+
+ # Case: Menu entry being configured
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ if { [regexp {^[0-9]+$} $tkPathOrIndex] } {
+ eval "_configureMenuEntry $path $tkPathOrIndex $args"
+
+ # Case: Menu (button and pane) being configured.
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ } else {
+ eval _configureMenu $path $tkPathOrIndex $args
+ }
+}
+
+# -------------------------------------------------------------
+#
+# METHOD: path
+#
+# SYNOPIS: path ?<mode>? <pattern>
+#
+# Returns a fully formed component path that matches pat-
+# tern. If no match is found it returns -1. The mode argument
+# indicates how the search is to be matched against pattern
+# and it must have one of the following values:
+#
+# -glob Pattern is a glob-style pattern which is
+# matched against each component path using the same rules as
+# the string match command.
+#
+# -regexp Pattern is treated as a regular expression
+# and matched against each component path using the same
+# rules as the regexp command.
+#
+# The default mode is -glob.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::path { args } {
+
+ set len [llength $args]
+ if { $len < 1 || $len > 2 } {
+ error "wrong # args: should be \
+ \"$itk_component(hull) path ?mode?> <pattern>\""
+ }
+
+ set pathList [array names _pathMap]
+
+ set len [llength $args]
+ switch -- $len {
+ 1 {
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Case: no search modes given
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ set pattern [lindex $args 0]
+ set found [lindex $pathList [lsearch -glob $pathList $pattern]]
+ }
+ 2 {
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Case: search modes present (-glob, -regexp)
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ set options [lindex $args 0]
+ set pattern [lindex $args 1]
+ set found \
+ [lindex $pathList [lsearch $options $pathList $pattern]]
+ }
+ default {
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Case: wrong # arguments
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ error "wrong # args: \
+ should be \"$itk_component(hull) path ?-glob? ?-regexp? pattern\""
+ }
+ }
+
+ return $found
+}
+
+# -------------------------------------------------------------
+#
+# METHOD: type path
+#
+# Returns the type of the component given by entryCom-
+# ponentPathName. For menu entries, this is the type argument
+# passed to the add/insert widget command when the entry was
+# created, such as command or separator. Othewise it is either
+# a menubutton or a menu.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::type { path } {
+
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Path Conversions
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ set path [_parsePath $path]
+
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Error Handling: does the path exist?
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ if { [catch {set index $_pathMap($path)} ] } {
+ error "bad path \"$path\""
+ }
+
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # ENTRY, Ask TK for type
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ if { [regexp {^[0-9]+$} $index] } {
+ # get the menu path from the entry path name
+ set tkMenuPath [_entryPathToTkMenuPath $path]
+
+ # call the menu's type command, adjusting index based on tearoff
+ set type [$tkMenuPath type [_getTkIndex $tkMenuPath $index]]
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # MENUBUTTON, MENU, or FRAME
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ } else {
+ # should not happen, but have a path that is not a valid window.
+ if { [catch {set className [winfo class $_pathMap($path)]}] } {
+ error "serious error: \"$path\" is not a valid window"
+ }
+ # get the classname, look it up, get index, us it to look up type
+ set type [ lindex \
+ {frame menubutton menu} \
+ [lsearch { Frame Menubutton Menu } $className] \
+ ]
+ }
+ return $type
+}
+
+# -------------------------------------------------------------
+#
+# METHOD: yposition entryPath
+#
+# Returns a decimal string giving the y-coordinate within
+# the menu window of the topmost pixel in the entry specified
+# by componentPathName. If the componentPathName is not an
+# entry, an error is issued.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::yposition { entryPath } {
+
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Path Conversions
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ set entryPath [_parsePath $entryPath]
+ set index $_pathMap($entryPath)
+
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Error Handling
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ # first verify that entryPath is actually a path to
+ # an entry and not to menu, menubutton, etc.
+ if { ! [regexp {^[0-9]+$} $index] } {
+ error "bad value: entryPath is not an entry"
+ }
+
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Call yposition command
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+ # get the menu path from the entry path name
+ set tkMenuPath [_entryPathToTkMenuPath $entryPath]
+
+ # call the menu's yposition command, adjusting index based on tearoff
+ return [$tkMenuPath yposition [_getTkIndex $tkMenuPath $index]]
+
+}
+
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# PARSING METHODS
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# -------------------------------------------------------------
+#
+# PARSING METHOD: menubutton
+#
+# This method is invoked via an evaluation of the -menubuttons
+# option for the Menubar.
+#
+# It adds a new menubutton and processes any -menu options
+# for creating entries on the menu pane associated with the
+# menubutton
+# -------------------------------------------------------------
+body iwidgets::Menubar::menubutton { menuName args } {
+ eval "add menubutton .$menuName $args"
+}
+
+# -------------------------------------------------------------
+#
+# PARSING METHOD: options
+#
+# This method is invoked via an evaluation of the -menu
+# option for menubutton commands.
+#
+# It configures the current menu ($_ourMenuPath) with the options
+# that follow (args)
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::options { args } {
+ eval "$_tkMenuPath configure $args"
+}
+
+
+# -------------------------------------------------------------
+#
+# PARSING METHOD: command
+#
+# This method is invoked via an evaluation of the -menu
+# option for menubutton commands.
+#
+# It adds a new command entry to the current menu, $_ourMenuPath
+# naming it $cmdName. Since this is the most common case when
+# creating menus, streamline it by duplicating some code from
+# the add{} method.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::command { cmdName args } {
+ set path $_ourMenuPath.$cmdName
+
+ # error checking
+ regsub {.*[.]} $path "" segName
+ if [regexp {^(menu|last|end|[0-9]+)$} $segName] {
+ error "bad name \"$segName\": user created component \
+ path names may not end with \
+ \"end\", \"last\", \"menu\", \
+ or be an integer"
+ }
+
+ eval _addEntry command $path $args
+}
+
+# -------------------------------------------------------------
+#
+# PARSING METHOD: checkbutton
+#
+# This method is invoked via an evaluation of the -menu
+# option for menubutton/cascade commands.
+#
+# It adds a new checkbutton entry to the current menu, $_ourMenuPath
+# naming it $chkName.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::checkbutton { chkName args } {
+ eval "add checkbutton $_ourMenuPath.$chkName $args"
+}
+
+# -------------------------------------------------------------
+#
+# PARSING METHOD: radiobutton
+#
+# This method is invoked via an evaluation of the -menu
+# option for menubutton/cascade commands.
+#
+# It adds a new radiobutton entry to the current menu, $_ourMenuPath
+# naming it $radName.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::radiobutton { radName args } {
+ eval "add radiobutton $_ourMenuPath.$radName $args"
+}
+
+# -------------------------------------------------------------
+#
+# PARSING METHOD: separator
+#
+# This method is invoked via an evaluation of the -menu
+# option for menubutton/cascade commands.
+#
+# It adds a new separator entry to the current menu, $_ourMenuPath
+# naming it $sepName.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::separator { sepName args } {
+ eval $_tkMenuPath add separator
+ set _pathMap($_ourMenuPath.$sepName) [_getPdIndex $_tkMenuPath end]
+}
+
+# -------------------------------------------------------------
+#
+# PARSING METHOD: cascade
+#
+# This method is invoked via an evaluation of the -menu
+# option for menubutton/cascade commands.
+#
+# It adds a new cascade entry to the current menu, $_ourMenuPath
+# naming it $casName. It processes the -menu option if present,
+# adding a new menu pane and its associated entries found.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::cascade { casName args } {
+
+ # Save the current menu we are adding to, cascade can change
+ # the current menu through -menu options.
+ set saveOMP $_ourMenuPath
+ set saveTKP $_tkMenuPath
+
+ eval "add cascade $_ourMenuPath.$casName $args"
+
+ # Restore the saved menu states so that the next entries of
+ # the -menu/-menubuttons we are processing will be at correct level.
+ set _ourMenuPath $saveOMP
+ set _tkMenuPath $saveTKP
+}
+
+# ... A P I S U P P O R T M E T H O D S...
+
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# MENU ADD, INSERT, DELETE
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _addMenuButton
+#
+# Makes a new menubutton & associated -menu, pack appended
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_addMenuButton { buttonName args} {
+
+ eval "_makeMenuButton $buttonName $args"
+
+ #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Pack at end, adjust for help buttonName
+ # ''''''''''''''''''''''''''''''''''
+ if { $buttonName == "help" } {
+ pack $itk_component($buttonName) -side right
+ } else {
+ pack $itk_component($buttonName) -side left
+ }
+
+ return $itk_component($buttonName)
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _insertMenuButton
+#
+# inserts a menubutton named $buttonName on a menu bar before
+# another menubutton specified by $beforeMenuPath
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_insertMenuButton { beforeMenuPath buttonName args} {
+
+ eval "_makeMenuButton $buttonName $args"
+
+ #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Pack before the $beforeMenuPath
+ # ''''''''''''''''''''''''''''''''
+ set beforeTkMenu $_pathMap($beforeMenuPath)
+ regsub {[.]menu$} $beforeTkMenu "" beforeTkMenu
+ pack $itk_component(menubar).$buttonName \
+ -side left \
+ -before $beforeTkMenu
+
+ return $itk_component($buttonName)
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _makeMenuButton
+#
+# creates a menubutton named buttonName on the menubar with args.
+# The -menu option if present will trigger attaching a menu pane.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_makeMenuButton {buttonName args} {
+
+ #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Capture the -menu option if present
+ # '''''''''''''''''''''''''''''''''''
+ array set temp $args
+ if { [::info exists temp(-menu)] } {
+ # We only keep this in case of menuconfigure or menucget
+ set _menuOption(.$buttonName) $temp(-menu)
+ set menuEvalStr $temp(-menu)
+ } else {
+ set menuEvalStr {}
+ }
+
+ # attach the actual menu widget to the menubutton's arg list
+ set temp(-menu) $itk_component(menubar).$buttonName.menu
+ set args [array get temp]
+
+ #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Create menubutton component
+ # ''''''''''''''''''''''''''''''''
+ itk_component add $buttonName {
+ eval ::menubutton \
+ $itk_component(menubar).$buttonName \
+ $args
+ } {
+ keep \
+ -activebackground \
+ -activeforeground \
+ -anchor \
+ -background \
+ -borderwidth \
+ -cursor \
+ -disabledforeground \
+ -font \
+ -foreground \
+ -highlightbackground \
+ -highlightcolor \
+ -highlightthickness \
+ -justify \
+ -padx \
+ -pady \
+ -wraplength
+ }
+
+ set _pathMap(.$buttonName) $itk_component($buttonName)
+
+ _makeMenu \
+ $buttonName-menu \
+ $itk_component($buttonName).menu \
+ .$buttonName \
+ $menuEvalStr
+
+ return $itk_component($buttonName)
+
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _makeMenu
+#
+# Creates a menu.
+# It then evaluates the $menuEvalStr to create entries on the menu.
+#
+# Assumes the existence of $itk_component($buttonName)
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_makeMenu \
+ { componentName widgetName menuPath menuEvalStr } {
+
+ #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Create menu component
+ # ''''''''''''''''''''''''''''''''
+ itk_component add $componentName {
+ ::menu $widgetName
+ } {
+ keep \
+ -activebackground \
+ -activeborderwidth \
+ -activeforeground \
+ -background \
+ -borderwidth \
+ -cursor \
+ -disabledforeground \
+ -font \
+ -foreground
+ }
+
+ set _pathMap($menuPath.menu) $itk_component($componentName)
+
+ #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Attach help handler to this menu
+ # ''''''''''''''''''''''''''''''''
+ bind $itk_component($componentName) <<MenuSelect>> \
+ [code $this _helpHandler $menuPath.menu]
+
+ #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Handle -menu
+ #'''''''''''''''''''''''''''''''''
+ set _ourMenuPath $menuPath
+ set _tkMenuPath $itk_component($componentName)
+
+ #
+ # A zero parseLevel says we are at the top of the parse tree,
+ # so get the context scope level and do a subst for the menuEvalStr.
+ #
+ if { $_parseLevel == 0 } {
+ set _callerLevel [_getCallerLevel]
+ }
+
+ #
+ # bump up the parse level, so if we get called via the 'eval $menuEvalStr'
+ # we know to skip the above steps...
+ #
+ incr _parseLevel
+ eval $menuEvalStr
+
+ #
+ # leaving, so done with this parse level, so bump it back down
+ #
+ incr _parseLevel -1
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _substEvalStr
+#
+# This performs the substitution and evaluation of $ [], \ found
+# in the -menubutton/-menus options
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_substEvalStr { evalStr } {
+ upvar $evalStr evalStrRef
+ set evalStrRef [uplevel $_callerLevel [list subst $evalStrRef]]
+}
+
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _deleteMenu
+#
+# _deleteMenu menuPath ?menuPath2?
+#
+# deletes menuPath or from menuPath to menuPath2
+#
+# Menu paths may be formed in one of two ways
+# .MENUBAR.menuName where menuName is the name of the menu
+# .MENUBAR.menuName.menu where menuName is the name of the menu
+#
+# The basic rule is '.menu' is not needed.
+# -------------------------------------------------------------
+body iwidgets::Menubar::_deleteMenu { menuPath {menuPath2 {}} } {
+
+ if { $menuPath2 == "" } {
+ # get a corrected path (subst for number, last, end)
+ set path [_parsePath $menuPath]
+
+ _deleteAMenu $path
+
+ } else {
+ # gets the list of menus in interface order
+ set menuList [_getMenuList]
+
+ # ... get the start menu and the last menu ...
+
+ # get a corrected path (subst for number, last, end)
+ set menuStartPath [_parsePath $menuPath]
+
+ regsub {[.]menu$} $menuStartPath "" menuStartPath
+
+ set menuEndPath [_parsePath $menuPath2]
+
+ regsub {[.]menu$} $menuEndPath "" menuEndPath
+
+ # get the menu position (0 based) of the start and end menus.
+ set start [lsearch -exact $menuList $menuStartPath]
+ if { $start == -1 } {
+ error "bad menu path \"$menuStartPath\": \
+ should be one of $menuList"
+ }
+ set end [lsearch -exact $menuList $menuEndPath]
+ if { $end == -1 } {
+ error "bad menu path \"$menuEndPath\": \
+ should be one of $menuList"
+ }
+
+ # now create the list from this range of menus
+ set delList [lrange $menuList $start $end]
+
+ # walk thru them deleting each menu.
+ # this list has no .menu on the end.
+ foreach m $delList {
+ _deleteAMenu $m.menu
+ }
+ }
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _deleteAMenu
+#
+# _deleteMenu menuPath
+#
+# deletes a single Menu (menubutton and menu pane with entries)
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_deleteAMenu { path } {
+
+ # We will normalize the path to not include the '.menu' if
+ # it is on the path already.
+
+ regsub {[.]menu$} $path "" menuButtonPath
+ regsub {.*[.]} $menuButtonPath "" buttonName
+
+ # Loop through and destroy any cascades, etc on menu.
+ set entryList [_getEntryList $menuButtonPath]
+ foreach entry $entryList {
+ _deleteEntry $entry
+ }
+
+ # Delete the menubutton and menu components...
+ destroy $itk_component($buttonName-menu)
+ destroy $itk_component($buttonName)
+
+ # This is because of some itcl bug that doesn't delete
+ # the component on the destroy in some cases...
+ catch {itk_component delete $buttonName-menu}
+ catch {itk_component delete $buttonName}
+
+ # unset our paths
+ _unsetPaths $menuButtonPath
+
+}
+
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# ENTRY ADD, INSERT, DELETE
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _addEntry
+#
+# Adds an entry to menu.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_addEntry { type path args } {
+
+ # Error Checking
+ # ''''''''''''''
+ # the path should not end with '.menu'
+ # Not needed -- already checked by add{}
+ # if { [regexp {[.]menu$} $path] } {
+ # error "bad entry path: \"$path\". \
+ # The name \"menu\" is reserved for menu panes"
+ # }
+
+ # get the tkMenuPath
+ set tkMenuPath [_entryPathToTkMenuPath $path]
+ if { $tkMenuPath == "" } {
+ error "bad entry path: \"$path\". The menu path prefix is not valid"
+ }
+
+ # get the -helpstr option if present
+ array set temp $args
+ if { [::info exists temp(-helpstr)] } {
+ set helpStr $temp(-helpstr)
+ unset temp(-helpstr)
+ } else {
+ set helpStr {}
+ }
+ set args [array get temp]
+
+ # Handle CASCADE
+ # ''''''''''''''
+ # if this is a cascade go ahead and add in the menu...
+ if { $type == "cascade" } {
+ eval [list _addCascade $tkMenuPath $path] $args
+ # Handle Non-CASCADE
+ # ''''''''''''''''''
+ } else {
+ # add the entry
+ eval [list $tkMenuPath add $type] $args
+ set _pathMap($path) [_getPdIndex $tkMenuPath end]
+ }
+
+ # Remember the help string
+ set _helpString($path) $helpStr
+
+ return $_pathMap($path)
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _addCascade
+#
+# Creates a cascade button. Handles the -menu option
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_addCascade { tkMenuPath path args } {
+
+ # get the cascade name from our path
+ regsub {.*[.]} $path "" cascadeName
+
+ #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Capture the -menu option if present
+ # '''''''''''''''''''''''''''''''''''
+ array set temp $args
+ if { [::info exists temp(-menu)] } {
+ set menuEvalStr $temp(-menu)
+ } else {
+ set menuEvalStr {}
+ }
+
+ # attach the menu pane
+ set temp(-menu) $tkMenuPath.$cascadeName
+ set args [array get temp]
+
+ # Create the cascade entry
+ eval $tkMenuPath add cascade $args
+
+ # Keep the -menu string in case of menuconfigure or menucget
+ if { $menuEvalStr != "" } {
+ set _menuOption($path) $menuEvalStr
+ }
+
+ # update our pathmap
+ set _pathMap($path) [_getPdIndex $tkMenuPath end]
+
+ _makeMenu \
+ $cascadeName-menu \
+ $tkMenuPath.$cascadeName \
+ $path \
+ $menuEvalStr
+
+ #return $itk_component($cascadeName)
+
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _insertEntry
+#
+# inserts an entry on a menu before entry given by beforeEntryPath.
+# The added entry is of type TYPE and its name is NAME. ARGS are
+# passed for customization of the entry.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_insertEntry { beforeEntryPath type name args } {
+
+ # convert entryPath to an index value
+ set bfIndex $_pathMap($beforeEntryPath)
+
+ # first verify that beforeEntryPath is actually a path to
+ # an entry and not to menu, menubutton, etc.
+ if { ! [regexp {^[0-9]+$} $bfIndex] } {
+ error "bad entry path: beforeEntryPath is not an entry"
+ }
+
+ # get the menu path from the entry path name
+ regsub {[.][^.]*$} $beforeEntryPath "" menuPathPrefix
+ set tkMenuPath $_pathMap($menuPathPrefix.menu)
+
+ # INDEX is zero based at this point.
+
+ # ENTRIES is a zero based list...
+ set entries [_getEntryList $menuPathPrefix]
+
+ #
+ # Adjust the entries after the inserted item, to have
+ # the correct index numbers. Note, we stay zero based
+ # even though tk flips back and forth depending on tearoffs.
+ #
+ for {set i $bfIndex} {$i < [llength $entries]} {incr i} {
+ # path==entry path in numerical order
+ set path [lindex $entries $i]
+
+ # add one to each entry after the inserted one.
+ set _pathMap($path) [expr $i + 1]
+ }
+
+ # get the -helpstr option if present
+ array set temp $args
+ if { [::info exists temp(-helpstr)] } {
+ set helpStr $temp(-helpstr)
+ unset temp(-helpstr)
+ } else {
+ set helpStr {}
+ }
+ set args [array get temp]
+
+ set path $menuPathPrefix.$name
+
+ # Handle CASCADE
+ # ''''''''''''''
+ # if this is a cascade go ahead and add in the menu...
+ if { [string match cascade $type] } {
+
+ if { [ catch {eval "_insertCascade \
+ $bfIndex $tkMenuPath $path $args"} errMsg ]} {
+ for {set i $bfIndex} {$i < [llength $entries]} {incr i} {
+ # path==entry path in numerical order
+ set path [lindex $entries $i]
+
+ # sub the one we added earlier.
+ set _pathMap($path) [expr $_pathMap($path) - 1]
+ # @@ delete $hs
+ }
+ error $errMsg
+ }
+
+ # Handle Entry
+ # ''''''''''''''
+ } else {
+
+ # give us a zero or 1-based index based on tear-off menu status
+ # invoke the menu's insert command
+ if { [catch {eval "$tkMenuPath insert \
+ [_getTkIndex $tkMenuPath $bfIndex] $type $args"} errMsg]} {
+ for {set i $bfIndex} {$i < [llength $entries]} {incr i} {
+ # path==entry path in numerical order
+ set path [lindex $entries $i]
+
+ # sub the one we added earlier.
+ set _pathMap($path) [expr $_pathMap($path) - 1]
+ # @@ delete $hs
+ }
+ error $errMsg
+ }
+
+
+ # add the helpstr option to our options list (attach to entry)
+ set _helpString($path) $helpStr
+
+ # Insert the new entry path into pathmap giving it an index value
+ set _pathMap($menuPathPrefix.$name) $bfIndex
+
+ }
+
+ return [_getTkIndex $tkMenuPath $bfIndex]
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _insertCascade
+#
+# Creates a cascade button. Handles the -menu option
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_insertCascade { bfIndex tkMenuPath path args } {
+
+ # get the cascade name from our path
+ regsub {.*[.]} $path "" cascadeName
+
+ #,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Capture the -menu option if present
+ # '''''''''''''''''''''''''''''''''''
+ array set temp $args
+ if { [::info exists temp(-menu)] } {
+ # Keep the -menu string in case of menuconfigure or menucget
+ set _menuOption($path) $temp(-menu)
+ set menuEvalStr $temp(-menu)
+ } else {
+ set menuEvalStr {}
+ }
+
+ # attach the menu pane
+ set temp(-menu) $tkMenuPath.$cascadeName
+ set args [array get temp]
+
+ # give us a zero or 1-based index based on tear-off menu status
+ # invoke the menu's insert command
+ eval "$tkMenuPath insert \
+ [_getTkIndex $tkMenuPath $bfIndex] cascade $args"
+
+ # Insert the new entry path into pathmap giving it an index value
+ set _pathMap($path) $bfIndex
+ _makeMenu \
+ $cascadeName-menu \
+ $tkMenuPath.$cascadeName \
+ $path \
+ $menuEvalStr
+
+ #return $itk_component($cascadeName)
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _deleteEntry
+#
+# _deleteEntry entryPath ?entryPath2?
+#
+# either
+# deletes the entry entryPath
+# or
+# deletes the entries from entryPath to entryPath2
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_deleteEntry { entryPath {entryPath2 {}} } {
+
+ if { $entryPath2 == "" } {
+ # get a corrected path (subst for number, last, end)
+ set path [_parsePath $entryPath]
+
+ set entryIndex $_pathMap($path)
+ if { $entryIndex == -1 } {
+ error "bad value for pathName: \
+ $entryPath in call to delet"
+ }
+
+ # get the type, if cascade, we will want to delete menu
+ set type [type $path]
+
+ # ... munge up the menu name ...
+
+ # the tkMenuPath is looked up with the .menu added to lookup
+ # strip off the entry component
+ regsub {[.][^.]*$} $path "" menuPath
+ set tkMenuPath $_pathMap($menuPath.menu)
+
+ # get the ordered entry list
+ set entries [_getEntryList $menuPath]
+
+ # ... Fix up path entry indices ...
+
+ # delete the path from the map
+ unset _pathMap([lindex $entries $entryIndex])
+
+ # Subtract off 1 for each entry below the deleted one.
+ for {set i [expr $entryIndex + 1]} \
+ {$i < [llength $entries]} \
+ {incr i} {
+ set epath [lindex $entries $i]
+ incr _pathMap($epath) -1
+ }
+
+ # ... Delete the menu entry widget ...
+
+ # delete the menu entry, ajusting index for TK
+ $tkMenuPath delete [_getTkIndex $tkMenuPath $entryIndex]
+
+ if { $type == "cascade" } {
+ regsub {.*[.]} $path "" cascadeName
+ destroy $itk_component($cascadeName-menu)
+
+ # This is because of some itcl bug that doesn't delete
+ # the component on the destroy in some cases...
+ catch {itk_component delete $cascadeName-menu}
+
+ _unsetPaths $path
+ }
+
+ } else {
+ # get a corrected path (subst for number, last, end)
+ set path1 [_parsePath $entryPath]
+ set path2 [_parsePath $entryPath2]
+
+ set fromEntryIndex $_pathMap($path1)
+ if { $fromEntryIndex == -1 } {
+ error "bad value for entryPath1: \
+ $entryPath in call to delet"
+ }
+ set toEntryIndex $_pathMap($path2)
+ if { $toEntryIndex == -1 } {
+ error "bad value for entryPath2: \
+ $entryPath2 in call to delet"
+ }
+ # ... munge up the menu name ...
+
+ # the tkMenuPath is looked up with the .menu added to lookup
+ # strip off the entry component
+ regsub {[.][^.]*$} $path1 "" menuPath
+ set tkMenuPath $_pathMap($menuPath.menu)
+
+ # get the ordered entry list
+ set entries [_getEntryList $menuPath]
+
+ # ... Fix up path entry indices ...
+
+ # delete the range from the pathMap list
+ for {set i $fromEntryIndex} {$i <= $toEntryIndex} {incr i} {
+ unset _pathMap([lindex $entries $i])
+ }
+
+ # Subtract off 1 for each entry below the deleted range.
+ # Loop from one below the bottom delete entry to end list
+ for {set i [expr $toEntryIndex + 1]} \
+ {$i < [llength $entries]} \
+ {incr i} {
+ # take this path and sets its index back by size of
+ # deleted range.
+ set path [lindex $entries $i]
+ set _pathMap($path) \
+ [expr $_pathMap($path) - \
+ (($toEntryIndex - $fromEntryIndex) + 1)]
+ }
+
+ # ... Delete the menu entry widget ...
+
+ # delete the menu entry, ajusting index for TK
+ $tkMenuPath delete \
+ [_getTkIndex $tkMenuPath $fromEntryIndex] \
+ [_getTkIndex $tkMenuPath $toEntryIndex]
+
+ }
+}
+
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# CONFIGURATION SUPPORT
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _configureMenu
+#
+# This configures a menu. A menu is a true tk widget, thus we
+# pass the tkPath variable. This path may point to either a
+# menu button (does not end with the name 'menu', or a menu
+# which ends with the name 'menu'
+#
+# path : our Menubar path name to this menu button or menu pane.
+# if we end with the name '.menu' then it is a menu pane.
+# tkPath : the path to the corresponding Tk menubutton or menu.
+# args : the args for configuration
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_configureMenu { path tkPath {option {}} args } {
+
+ set class [winfo class $tkPath]
+
+ if { $option == "" } {
+ # No arguments: return all options
+ set configList [$tkPath configure]
+
+ if { [info exists _menuOption($path)] } {
+ lappend configList [list -menu menu Menu {} $_menuOption($path)]
+ } else {
+ lappend configList [list -menu menu Menu {} {}]
+ }
+ if { [info exists _helpString($path)] } {
+ lappend configList [list -helpstr helpStr HelpStr {} \
+ $_helpString($path)]
+ } else {
+ lappend configList [list -helpstr helpStr HelpStr {} {}]
+ }
+ return $configList
+
+ } elseif {$args == "" } {
+ if { $option == "-menu" } {
+ if { [info exists _menuOption($path)] } {
+ return [list -menu menu Menu {} $_menuOption($path)]
+ } else {
+ return [list -menu menu Menu {} {}]
+ }
+ } elseif { $option == "-helpstr" } {
+ if { [info exists _helpString($path)] } {
+ return [list -helpstr helpStr HelpStr {} $_helpString($path)]
+ } else {
+ return [list -helpstr helpStr HelpStr {} {}]
+ }
+ } else {
+ # ... OTHERWISE, let Tk get it.
+ return [$tkPath configure $option]
+ }
+ } else {
+ set args [concat $option $args]
+
+ # If this is a menubutton, and has -menu option, process it
+ if { $class == "Menubutton" && [regexp -- {-menu} $args] } {
+ eval _configureMenuOption menubutton $path $args
+ } else {
+ eval $tkPath configure $args
+ }
+ return ""
+ }
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _configureMenuOption
+#
+# Allows for configuration of the -menu option on
+# menubuttons and cascades
+#
+# find out if we are the last menu, or are before one.
+# delete the old menu.
+# if we are the last, then add us back at the end
+# if we are before another menu, get the beforePath
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_configureMenuOption { type path args } {
+
+ regsub {[.][^.]*$} $path "" pathPrefix
+
+ if { $type == "menubutton" } {
+ set menuList [_getMenuList]
+ set pos [lsearch $menuList $path]
+ if { $pos == [expr [llength $menuList] - 1] } {
+ set insert false
+ } else {
+ set insert true
+ }
+ } elseif { $type == "cascade" } {
+ set lastEntryPath [_parsePath $pathPrefix.last]
+ if { $lastEntryPath == $path } {
+ set insert false
+ } else {
+ set insert true
+ }
+ set pos [index $path]
+
+ }
+
+
+ eval "delete $pathPrefix.$pos"
+ if { $insert } {
+ # get name from path...
+ regsub {.*[.]} $path "" name
+
+ eval insert $pathPrefix.$pos $type \
+ $name $args
+ } else {
+ eval add $type $path $args
+ }
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _configureMenuEntry
+#
+# This configures a menu entry. A menu entry is either a command,
+# radiobutton, separator, checkbutton, or a cascade. These have
+# a corresponding Tk index value for the corresponding tk menu
+# path.
+#
+# path : our Menubar path name to this menu entry.
+# index : the t
+# args : the args for configuration
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_configureMenuEntry { path index {option {}} args } {
+
+ set type [type $path]
+
+ # set len [llength $args]
+
+ # get the menu path from the entry path name
+ set tkMenuPath [_entryPathToTkMenuPath $path]
+
+ if { $option == "" } {
+ set configList [$tkMenuPath entryconfigure \
+ [_getTkIndex $tkMenuPath $index]]
+
+ if { $type == "cascade" } {
+ if { [info exists _menuOption($path)] } {
+ lappend configList [list -menu menu Menu {} \
+ $_menuOption($path)]
+ } else {
+ lappend configList [list -menu menu Menu {} {}]
+ }
+ }
+ if { [info exists _helpString($path)] } {
+ lappend configList [list -helpstr helpStr HelpStr {} \
+ $_helpString($path)]
+ } else {
+ lappend configList [list -helpstr helpStr HelpStr {} {}]
+ }
+ return $configList
+
+ } elseif { $args == "" } {
+ if { $option == "-menu" } {
+ if { [info exists _menuOption($path)] } {
+ return [list -menu menu Menu {} $_menuOption($path)]
+ } else {
+ return [list -menu menu Menu {} {}]
+ }
+ } elseif { $option == "-helpstr" } {
+ if { [info exists _helpString($path)] } {
+ return [list -helpstr helpStr HelpStr {} \
+ $_helpString($path)]
+ } else {
+ return [list -helpstr helpStr HelpStr {} {}]
+ }
+ } else {
+ # ... OTHERWISE, let Tk get it.
+ return [$tkMenuPath entryconfigure \
+ [_getTkIndex $tkMenuPath $index] $option]
+ }
+ } else {
+ array set temp [concat $option $args]
+
+ # ... Store -helpstr val,strip out -helpstr val from args
+ if { [::info exists temp(-helpstr)] } {
+ set _helpString($path) $temp(-helpstr)
+ unset temp(-helpstr)
+ }
+
+ set args [array get temp]
+ if { $type == "cascade" && [::info exists temp(-menu)] } {
+ eval "_configureMenuOption cascade $path $args"
+ } else {
+ # invoke the menu's entryconfigure command
+ # being careful to ajust the INDEX to be 0 or 1 based
+ # depending on the tearoff status
+ # if the stripping process brought us down to no options
+ # to set, then forget the configure of widget.
+ if { [llength $args] != 0 } {
+ eval $tkMenuPath entryconfigure \
+ [_getTkIndex $tkMenuPath $index] $args
+ }
+ }
+ return ""
+ }
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _unsetPaths
+#
+# comment
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_unsetPaths { parent } {
+
+ # first get the complete list of all menu paths
+ set pathList [array names _pathMap]
+
+ # for each path that matches parent prefix, unset it.
+ foreach path $pathList {
+ if { [regexp [subst -nocommands {^$parent}] $path] } {
+ unset _pathMap($path)
+ }
+ }
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _entryPathToTkMenuPath
+#
+# Takes an entry path like .mbar.file.new and changes it to
+# .mbar.file.menu and performs a lookup in the pathMap to
+# get the corresponding menu widget name for tk
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_entryPathToTkMenuPath {entryPath} {
+
+ # get the menu path from the entry path name
+ # by stripping off the entry component of the path
+ regsub {[.][^.]*$} $entryPath "" menuPath
+
+ # the tkMenuPath is looked up with the .menu added to lookup
+ if { [catch {set tkMenuPath $_pathMap($menuPath.menu)}] } {
+ return ""
+ } else {
+ return $_pathMap($menuPath.menu)
+ }
+}
+
+
+# -------------------------------------------------------------
+#
+# These two methods address the issue of menu entry indices being
+# zero-based when the menu is not a tearoff menu and 1-based when
+# it is a tearoff menu. Our strategy is to hide this difference.
+#
+# _getTkIndex returns the index as tk likes it: 0 based for non-tearoff
+# and 1 based for tearoff menus.
+#
+# _getPdIndex (get pulldown index) always returns it as 0 based.
+#
+# -------------------------------------------------------------
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _getTkIndex
+#
+# give us a zero or 1-based answer depending on the tearoff
+# status of the menu. If the menu denoted by tkMenuPath is a
+# tearoff menu it returns a 1-based result, otherwise a
+# zero-based result.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_getTkIndex { tkMenuPath tkIndex} {
+
+ # if there is a tear off make it 1-based index
+ if { [$tkMenuPath cget -tearoff] } {
+ incr tkIndex
+ }
+
+ return $tkIndex
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _getPdIndex
+#
+# Take a tk index and give me a zero based numerical index
+#
+# Ask the menu widget for the index of the entry denoted by
+# 'tkIndex'. Then if the menu is a tearoff adjust the value
+# to be zero based.
+#
+# This method returns the index as if tearoffs did not exist.
+# Always returns a zero-based index.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_getPdIndex { tkMenuPath tkIndex } {
+
+ # get the index from the tk menu
+ # this 0 based for non-tearoff and 1-based for tearoffs
+ set pdIndex [$tkMenuPath index $tkIndex]
+
+ # if there is a tear off make it 0-based index
+ if { [$tkMenuPath cget -tearoff] } {
+ incr pdIndex -1
+ }
+
+ return $pdIndex
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _getMenuList
+#
+# Returns the list of menus in the order they are on the interface
+# returned list is a list of our menu paths
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_getMenuList { } {
+ # get the menus that are packed
+ set tkPathList [pack slaves $itk_component(menubar)]
+
+ regsub -- {[.]} $itk_component(hull) "" mbName
+ regsub -all -- "\[.\]$mbName\[.\]menubar\[.\]" $tkPathList "." menuPathList
+
+ return $menuPathList
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _getEntryList
+#
+#
+# This method looks at a menupath and gets all the entries and
+# returns a list of all the entry path names in numerical order
+# based on their index values.
+#
+# MENU is the path to a menu, like .mbar.file.menu or .mbar.file
+# we will calculate a menuPath from this: .mbar.file
+# then we will build a list of entries in this menu excluding the
+# path .mbar.file.menu
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_getEntryList { menu } {
+
+ # if it ends with menu, clip it off
+ regsub {[.]menu$} $menu "" menuPath
+
+ # first get the complete list of all menu paths
+ set pathList [array names _pathMap]
+
+ set numEntries 0
+ # iterate over the pathList and put on menuPathList those
+ # that match the menuPattern
+ foreach path $pathList {
+ # if this path is on the menuPath's branch
+ if { [regexp [subst -nocommands {$menuPath[.][^.]*$}] $path] } {
+ # if not a menu itself
+ if { ! [regexp {[.]menu$} $path] } {
+ set orderedList($_pathMap($path)) $path
+ incr numEntries
+ }
+ }
+ }
+ set entryList {}
+
+ for {set i 0} {$i < $numEntries} {incr i} {
+ lappend entryList $orderedList($i)
+ }
+
+ return $entryList
+
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _parsePath
+#
+# given path, PATH, _parsePath splits the path name into its
+# component segments. It then puts the name back together one
+# segment at a time and calls _getSymbolicPath to replace the
+# keywords 'last' and 'end' as well as numeric digits.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_parsePath { path } {
+ set segments [split [string trimleft $path .] .]
+
+ set concatPath ""
+ foreach seg $segments {
+
+ set concatPath [_getSymbolicPath $concatPath $seg]
+
+ if { [catch {set _pathMap($concatPath)} ] } {
+ error "bad path: \"$path\" does not exist. \"$seg\" not valid"
+ }
+ }
+ return $concatPath
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _getSymbolicPath
+#
+# Given a PATH, _getSymbolicPath looks for the last segment of
+# PATH to contain: a number, the keywords last or end. If one
+# of these it figures out how to get us the actual pathname
+# to the searched widget
+#
+# Implementor's notes:
+# Surely there is a shorter way to do this. The only diff
+# for non-numeric is getting the llength of the correct list
+# It is hard to know this upfront so it seems harder to generalize.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_getSymbolicPath { parent segment } {
+
+ # if the segment is a number, then look it up positionally
+ # MATCH numeric index
+ if { [regexp {^[0-9]+$} $segment] } {
+
+ # if we have no parent, then we area menubutton
+ if { $parent == {} } {
+ set returnPath [lindex [_getMenuList] $segment]
+ } else {
+ set returnPath [lindex [_getEntryList $parent.menu] $segment]
+ }
+
+ # MATCH 'end' or 'last' keywords.
+ } elseif { $segment == "end" || $segment == "last" } {
+
+ # if we have no parent, then we are a menubutton
+ if { $parent == {} } {
+ set returnPath [lindex [_getMenuList] end]
+ } else {
+ set returnPath [lindex [_getEntryList $parent.menu] end]
+ }
+ } else {
+ set returnPath $parent.$segment
+ }
+
+ return $returnPath
+}
+
+# -------------------------------------------------------------
+#
+# PROTECTED METHOD: _helpHandler
+#
+# Bound to the <Motion> event on a menu pane. This puts the
+# help string associated with the menu entry into the
+# status widget help area. If no help exists for the current
+# entry, the status widget is cleared.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_helpHandler { menuPath } {
+
+ if { $itk_option(-helpvariable) == {} } {
+ return
+ }
+
+ set tkMenuWidget $_pathMap($menuPath)
+
+ set entryIndex [$tkMenuWidget index active]
+
+ # already on this item?
+ if { $entryIndex == $_entryIndex } {
+ return
+ }
+
+ set _entryIndex $entryIndex
+
+ if {"none" != $entryIndex} {
+ set entries [_getEntryList $menuPath]
+
+ set menuEntryHit \
+ [lindex $entries [_getPdIndex $tkMenuWidget $entryIndex]]
+
+ # blank out the old one
+ set $itk_option(-helpvariable) {}
+
+ # if there is a help string for this entry
+ if { [::info exists _helpString($menuEntryHit)] } {
+ set $itk_option(-helpvariable) $_helpString($menuEntryHit)
+ }
+ } else {
+ set $itk_option(-helpvariable) {}
+ set _entryIndex -1
+ }
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _getCallerLevel
+#
+# Starts at stack frame #0 and works down till we either hit
+# a ::Menubar stack frame or an ::itk::Archetype stack frame
+# (the latter happens when a configure is called via the 'component'
+# method
+#
+# Returns the level of the actual caller of the menubar command
+# in the form of #num where num is the level number caller stack frame.
+#
+# -------------------------------------------------------------
+body iwidgets::Menubar::_getCallerLevel { } {
+
+ set levelName {}
+ set levelsAreValid true
+ set level 0
+ set callerLevel #$level
+
+ while { $levelsAreValid } {
+ # Hit the end of the stack frame
+ if [catch {uplevel #$level {namespace current}}] {
+ set levelsAreValid false
+ set callerLevel #[expr $level - 1]
+ # still going
+ } else {
+ set newLevelName [uplevel #$level {namespace current}]
+ # See if we have run into the first ::Menubar level
+ if { $newLevelName == "::itk::Archetype" || \
+ $newLevelName == "::iwidgets::Menubar" } {
+ # If so, we are done-- set the callerLevel
+ set levelsAreValid false
+ set callerLevel #[expr $level - 1]
+ } else {
+ set levelName $newLevelName
+ }
+ }
+ incr level
+ }
+ return $callerLevel
+}
+
+
+#
+# The default tkMenuFind proc in menu.tcl only looks for menubuttons
+# in frames. Since our menubuttons are within the Menubar class, the
+# default proc won't find them during menu traversal. This proc
+# redefines the default proc to remedy the problem.
+#
+proc tkMenuFind {w char} {
+ global tkPriv
+ set char [string tolower $char]
+
+ foreach child [winfo child $w] {
+ switch [winfo class $child] {
+ Menubutton {
+ set qchild [winfo command $child]
+ set char2 [string index [$qchild cget -text] \
+ [$qchild cget -underline]]
+ if {([string compare $char [string tolower $char2]] == 0)
+ || ($char == "")} {
+ if {[$qchild cget -state] != "disabled"} {
+ return $child
+ }
+ }
+ }
+ Frame -
+ Menubar {
+ set match [tkMenuFind $child $char]
+ if {$match != ""} {
+ return $match
+ }
+ }
+ }
+ }
+ return {}
+}
+
+
diff --git a/itcl/iwidgets3.0.0/generic/messagebox.itk b/itcl/iwidgets3.0.0/generic/messagebox.itk
new file mode 100644
index 00000000000..3710ed37ee4
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/messagebox.itk
@@ -0,0 +1,403 @@
+#
+# Messagebox
+# ----------------------------------------------------------------------
+# Implements an information messages area widget with scrollbars.
+# Message types can be user defined and configured. Their options
+# include foreground, background, font, bell, and their display
+# mode of on or off. This allows message types to defined as needed,
+# removed when no longer so, and modified when necessary. An export
+# method is provided for file I/O.
+#
+# The number of lines that can be displayed may be limited with
+# the default being 1000. When this limit is reached, the oldest line
+# is removed. There is also support for saving the contents to a
+# file, using a file selection dialog.
+# ----------------------------------------------------------------------
+#
+# History:
+# 01/16/97 - Alfredo Jahn Renamed from InfoMsgBox to MessageBox
+# Initial release...
+# 01/20/97 - Alfredo Jahn Add a popup window so that 3rd mouse
+# button can be used to configure/access the message area.
+# New methods added: _post and _toggleDebug.
+# 01/30/97 - Alfredo Jahn Add -filename option
+# 05/11/97 - Mark Ulferts Added the ability to define and configure
+# new types. Changed print method to be issue.
+# 09/05/97 - John Tucker Added export method.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Alfredo Jahn V EMAIL: ajahn@spd.dsccc.com
+# Mark L. Ulferts mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1997 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Messagebox {
+ keep -activebackground -activeforeground -background -borderwidth \
+ -cursor -highlightcolor -highlightthickness \
+ -jump -labelfont -textbackground -troughcolor
+}
+
+# ------------------------------------------------------------------
+# MSGTYPE
+# ------------------------------------------------------------------
+
+class iwidgets::MsgType {
+ constructor {args} {eval configure $args}
+
+ public variable background \#d9d9d9
+ public variable bell 0
+ public variable font -*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-*
+ public variable foreground Black
+ public variable show 1
+}
+
+# ------------------------------------------------------------------
+# MESSAGEBOX
+# ------------------------------------------------------------------
+class iwidgets::Messagebox {
+ inherit itk::Widget
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -filename fileName FileName ""
+ itk_option define -maxlines maxLines MaxLines 1000
+ itk_option define -savedir saveDir SaveDir "[pwd]"
+
+ public {
+ method clear {}
+ method export {filename}
+ method find {}
+ method issue {string {type DEFAULT} args}
+ method save {}
+ method type {op tag args}
+ }
+
+ protected {
+ variable _unique 0
+ variable _types {}
+ variable _interior {}
+
+ method _post {x y}
+ }
+}
+
+#
+# Provide a lowercased access method for the Messagebox class.
+#
+proc ::iwidgets::messagebox {pathName args} {
+ uplevel ::iwidgets::Messagebox $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Messagebox.labelPos n widgetDefault
+option add *Messagebox.cursor top_left_arrow widgetDefault
+option add *Messagebox.height 0 widgetDefault
+option add *Messagebox.width 0 widgetDefault
+option add *Messagebox.visibleItems 80x24 widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Messagebox::constructor {args} {
+ set _interior $itk_interior
+
+ #
+ # Create the text area.
+ #
+ itk_component add text {
+ iwidgets::Scrolledtext $itk_interior.text -width 1 -height 1 \
+ -state disabled -wrap none
+ } {
+ keep -borderwidth -cursor -exportselection -highlightcolor \
+ -highlightthickness -padx -pady -relief -setgrid -spacing1 \
+ -spacing2 -spacing3
+
+ keep -activerelief -elementborderwidth -jump -troughcolor
+
+ keep -hscrollmode -height -sbwidth -scrollmargin -textbackground \
+ -visibleitems -vscrollmode -width
+
+ keep -labelbitmap -labelfont -labelimage -labelmargin \
+ -labelpos -labeltext -labelvariable
+ }
+ grid $itk_component(text) -row 0 -column 0 -sticky nsew
+ grid rowconfigure $_interior 0 -weight 1
+ grid columnconfigure $_interior 0 -weight 1
+
+ #
+ # Setup right mouse button binding to post a user configurable
+ # popup menu and diable the binding for left mouse clicks.
+ #
+ bind [$itk_component(text) component text] <ButtonPress-1> "break"
+ bind [$itk_component(text) component text] \
+ <ButtonPress-3> [code $this _post %x %y]
+
+ #
+ # Create the small popup menu that can be configurable by users.
+ #
+ itk_component add itemMenu {
+ menu $itk_component(hull).itemmenu -tearoff 0
+ } {
+ keep -background -font -foreground \
+ -activebackground -activeforeground
+ ignore -tearoff
+ }
+
+ #
+ # Add clear and svae options to the popup menu.
+ #
+ $itk_component(itemMenu) add command -label "Clear" \
+ -command [code $this clear]
+ $itk_component(itemMenu) add command -label "Save" \
+ -command [code $this save]
+ $itk_component(itemMenu) add command -label "Find" \
+ -command [code $this find]
+
+ #
+ # Create a standard type to be used if no others are specified.
+ #
+ type add DEFAULT
+
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# DESTURCTOR
+# ------------------------------------------------------------------
+body iwidgets::Messagebox::destructor {} {
+ foreach type $_types {
+ type remove $type
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD clear
+#
+# Clear the text area.
+# ------------------------------------------------------------------
+body iwidgets::Messagebox::clear {} {
+ $itk_component(text) configure -state normal
+
+ $itk_component(text) delete 1.0 end
+
+ $itk_component(text) configure -state disabled
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: type <op> <tag> <args>
+#
+# The type method supports several subcommands. Types can be added
+# removed and configured. All the subcommands use the MsgType class
+# to implement the functionaility.
+# ------------------------------------------------------------------
+body iwidgets::Messagebox::type {op tag args} {
+ switch $op {
+ add {
+ eval iwidgets::MsgType $this$tag $args
+
+ lappend _types $tag
+
+ $itk_component(text) tag configure $tag \
+ -font [$this$tag cget -font] \
+ -background [$this$tag cget -background] \
+ -foreground [$this$tag cget -foreground]
+
+ return $tag
+ }
+
+ remove {
+ if {[set index [lsearch $_types $tag]] != -1} {
+ delete object $this$tag
+ set _types [lreplace $_types $index $index]
+
+ return
+ } else {
+ error "bad message type: \"$tag\", does not exist"
+ }
+ }
+
+ configure {
+ if {[set index [lsearch $_types $tag]] != -1} {
+ set retVal [eval $this$tag configure $args]
+
+ $itk_component(text) tag configure $tag \
+ -font [$this$tag cget -font] \
+ -background [$this$tag cget -background] \
+ -foreground [$this$tag cget -foreground]
+
+ return $retVal
+
+ } else {
+ error "bad message type: \"$tag\", does not exist"
+ }
+ }
+
+ cget {
+ if {[set index [lsearch $_types $tag]] != -1} {
+ return [eval $this$tag cget $args]
+ } else {
+ error "bad message type: \"$tag\", does not exist"
+ }
+ }
+
+ default {
+ error "bad type operation: \"$op\", should be add,\
+ remove, configure or cget"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: issue string ?type? args
+#
+# Print the string out to the Messagebox. Check the options of the
+# message type to see if it should be displayed or if the bell
+# should be wrong.
+# ------------------------------------------------------------------
+body iwidgets::Messagebox::issue {string {type DEFAULT} args} {
+ if {[lsearch $_types $type] == -1} {
+ error "bad message type: \"$type\", use the type\
+ command to create a new types"
+ }
+
+ #
+ # If the type is currently configured to be displayed, then insert
+ # it in the text widget, add the tag to the line and move the
+ # vertical scroll bar to the bottom.
+ #
+ set tag $this$type
+
+ if {[$tag cget -show]} {
+ $itk_component(text) configure -state normal
+
+ #
+ # Find end of last message.
+ #
+ set prevend [$itk_component(text) index "end - 1 chars"]
+
+ $itk_component(text) insert end "$string\n" $args
+
+ $itk_component(text) tag add $type $prevend "end - 1 chars"
+ $itk_component(text) yview end
+
+ #
+ # Sound a beep if the message type is configured such.
+ #
+ if {[$tag cget -bell]} {
+ bell
+ }
+
+ #
+ # If we reached our max lines limit, then remove enough lines to
+ # get it back under.
+ #
+ set lineCount [lindex [split [$itk_component(text) index end] "."] 0]
+
+ if { $lineCount > $itk_option(-maxlines) } {
+ set numLines [expr $lineCount - $itk_option(-maxlines) -1]
+
+ $itk_component(text) delete 1.0 $numLines.0
+ }
+
+ $itk_component(text) configure -state disabled
+ }
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: save
+#
+# Save contents of messages area to a file using a fileselectionbox.
+# ------------------------------------------------------------------
+body iwidgets::Messagebox::save {} {
+ set saveFile ""
+ set filter ""
+
+ set saveFile [tk_getSaveFile -title "Save Messages" \
+ -initialdir $itk_option(-savedir) \
+ -initialfile $itk_option(-filename)]
+
+ if { $saveFile != "" } {
+ $itk_component(text) export $saveFile
+ issue "Contents saved to $pathname" INFO
+ }
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: find
+#
+# Search the contents of messages area for a specific string.
+# ------------------------------------------------------------------
+body iwidgets::Messagebox::find {} {
+ if {! [info exists itk_component(findd)]} {
+ itk_component add findd {
+ iwidgets::Finddialog $itk_interior.findd \
+ -textwidget $itk_component(text)
+ }
+ }
+
+ $itk_component(findd) center $itk_component(text)
+ $itk_component(findd) activate
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _post
+#
+# Used internally to post the popup menu at the coordinate (x,y)
+# relative to the widget.
+# ------------------------------------------------------------------
+body iwidgets::Messagebox::_post {x y} {
+ set rx [expr [winfo rootx $itk_component(text)]+$x]
+ set ry [expr [winfo rooty $itk_component(text)]+$y]
+
+ tk_popup $itk_component(itemMenu) $rx $ry
+}
+
+
+# ------------------------------------------------------------------
+# METHOD export filename
+#
+# write text to a file (export filename)
+# ------------------------------------------------------------------
+body iwidgets::Messagebox::export {filename} {
+ set f [open $filename w]
+
+ set txt [$itk_component(text) get 1.0 end]
+ puts $f $txt
+
+ flush $f
+ close $f
+}
+
diff --git a/itcl/iwidgets3.0.0/generic/messagedialog.itk b/itcl/iwidgets3.0.0/generic/messagedialog.itk
new file mode 100644
index 00000000000..072f4d34068
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/messagedialog.itk
@@ -0,0 +1,142 @@
+#
+# Messagedialog
+# ----------------------------------------------------------------------
+# Implements a message dialog composite widget. The Messagedialog is
+# derived from the Dialog class and is composed of an image and text
+# component. The image will accept both images as well as bitmaps.
+# The text can extend mutliple lines by embedding newlines.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Messagedialog {
+ keep -background -cursor -font -foreground -modality
+}
+
+# ------------------------------------------------------------------
+# MESSAGEDIALOG
+# ------------------------------------------------------------------
+class iwidgets::Messagedialog {
+ inherit iwidgets::Dialog
+
+ constructor {args} {}
+
+ itk_option define -imagepos imagePos Position w
+}
+
+#
+# Provide a lowercased access method for the Messagedialog class.
+#
+proc ::iwidgets::messagedialog {pathName args} {
+ uplevel ::iwidgets::Messagedialog $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Messagedialog.title "Message Dialog" widgetDefault
+option add *Messagedialog.master "." widgetDefault
+option add *Messagedialog.textPadX 20 widgetDefault
+option add *Messagedialog.textPadY 20 widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Messagedialog::constructor {args} {
+ #
+ # Create the image component which may be either a bitmap or image.
+ #
+ itk_component add image {
+ label $itk_interior.image
+ } {
+ keep -background -bitmap -cursor -foreground -image
+ }
+
+ #
+ # Create the text message component. The message may extend over
+ # several lines by embedding '\n' characters.
+ #
+ itk_component add message {
+ label $itk_interior.message
+ } {
+ keep -background -cursor -font -foreground -text
+
+ rename -padx -textpadx textPadX Pad
+ rename -pady -textpady textPadY Pad
+ }
+
+ #
+ # Hide the apply and help buttons.
+ #
+ hide Apply
+ hide Help
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -imagepos
+#
+# Specifies the image position relative to the message: n, s,
+# e, or w. The default is w.
+# ------------------------------------------------------------------
+configbody iwidgets::Messagedialog::imagepos {
+ switch $itk_option(-imagepos) {
+ n {
+ grid $itk_component(image) -row 0 -column 0
+ grid $itk_component(message) -row 1 -column 0
+ }
+ s {
+ grid $itk_component(message) -row 0 -column 0
+ grid $itk_component(image) -row 1 -column 0
+ }
+ e {
+ grid $itk_component(message) -row 0 -column 0
+ grid $itk_component(image) -row 0 -column 1
+ }
+ w {
+ grid $itk_component(image) -row 0 -column 0
+ grid $itk_component(message) -row 0 -column 1
+ }
+
+ default {
+ error "bad imagepos option \"$itk_option(-imagepos)\":\
+ should be n, e, s, or w"
+ }
+ }
+}
diff --git a/itcl/iwidgets3.0.0/generic/notebook.itk b/itcl/iwidgets3.0.0/generic/notebook.itk
new file mode 100644
index 00000000000..78a470c44e8
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/notebook.itk
@@ -0,0 +1,946 @@
+#
+# Notebook Widget
+# ----------------------------------------------------------------------
+# The Notebook command creates a new window (given by the pathName
+# argument) and makes it into a Notebook widget. Additional options,
+# described above may be specified on the command line or in the
+# option database to configure aspects of the Notebook such as its
+# colors, font, and text. The Notebook command returns its pathName
+# argument. At the time this command is invoked, there must not exist
+# a window named pathName, but path Name's parent must exist.
+#
+# A Notebook is a widget that contains a set of pages. It displays one
+# page from the set as the selected page. When a page is selected, the
+# page's contents are displayed in the page area. When first created a
+# Notebook has no pages. Pages may be added or deleted using widget commands
+# described below.
+#
+# A special option may be provided to the Notebook. The -auto option
+# specifies whether the Nptebook will automatically handle the unpacking
+# and packing of pages when pages are selected. A value of true signifies
+# that the notebook will automatically manage it. This is the default
+# value. A value of false signifies the notebook will not perform automatic
+# switching of pages.
+#
+# WISH LIST:
+# This section lists possible future enhancements.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Bill W. Scott EMAIL: bscott@spd.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Default resources.
+#
+option add *Notebook.background #d9d9d9 widgetDefault
+option add *Notebook.auto true widgetDefault
+
+#
+# Usual options.
+#
+itk::usual Notebook {
+ keep -background -cursor
+}
+
+# ------------------------------------------------------------------
+# NOTEBOOK
+# ------------------------------------------------------------------
+class iwidgets::Notebook {
+ inherit itk::Widget
+
+ constructor {args} {}
+
+ itk_option define -background background Background #d9d9d9
+ itk_option define -auto auto Auto true
+ itk_option define -scrollcommand scrollCommand ScrollCommand {}
+
+ public method add { args }
+ public method childsite { args }
+ public method delete { args }
+ public method index { args }
+ public method insert { args }
+ public method prev { }
+ public method next { }
+ public method pageconfigure { args }
+ public method pagecget { index option }
+ public method select { index }
+ public method view { args }
+
+ private method _childSites { }
+ private method _scrollCommand { }
+ private method _index { pathList index select}
+ private method _createPage { args }
+ private method _deletePages { fromPage toPage }
+ private method _configurePages { args }
+ private method _tabCommand { }
+
+ private variable _currPage -1 ;# numerical index of current page selected
+ private variable _pages {} ;# list of Page components
+ private variable _uniqueID 0 ;# one-up number for unique page numbering
+
+}
+
+#
+# Provide a lowercase access method for the Notebook class
+#
+proc ::iwidgets::notebook {pathName args} {
+ uplevel ::iwidgets::Notebook $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Notebook::constructor {args} {
+ #
+ # Create the outermost frame to maintain geometry.
+ #
+ itk_component add cs {
+ frame $itk_interior.cs
+ } {
+ keep -cursor -background -width -height
+ }
+ pack $itk_component(cs) -fill both -expand yes
+ pack propagate $itk_component(cs) no
+
+ eval itk_initialize $args
+
+ # force bg of all pages to reflect Notebook's background.
+ _configurePages -background $itk_option(-background)
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+# ------------------------------------------------------------------
+# OPTION -background
+#
+# Sets the bg color of all the pages in the Notebook.
+# ------------------------------------------------------------------
+configbody iwidgets::Notebook::background {
+ if {$itk_option(-background) != {}} {
+ _configurePages -background $itk_option(-background)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION -auto
+#
+# Determines whether pages are automatically unpacked and
+# packed when pages get selected.
+# ------------------------------------------------------------------
+configbody iwidgets::Notebook::auto {
+ if {$itk_option(-auto) != {}} {
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION -scrollcommand
+#
+# Command string to be invoked when the notebook
+# has any changes to its current page, or number of pages.
+#
+# typically for scrollbars.
+# ------------------------------------------------------------------
+configbody iwidgets::Notebook::scrollcommand {
+ if {$itk_option(-scrollcommand) != {}} {
+ _scrollCommand
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: add add ?<option> <value>...?
+#
+# Creates a page and appends it to the list of pages.
+# processes pageconfigure for the page added.
+# ------------------------------------------------------------------
+body iwidgets::Notebook::add { args } {
+ # The args list should be an even # of params, if not then
+ # prob missing value for last item in args list. Signal error.
+ set len [llength $args]
+ if { [expr $len % 2] } {
+ error "value for \"[lindex $args [expr $len - 1]]\" missing"
+ }
+
+ # add a Page component
+ set pathName [eval _createPage $args]
+ lappend _pages $pathName
+
+ # update scroller
+ _scrollCommand
+
+ # return childsite for the Page component
+ return [eval $pathName childsite]
+}
+
+# ------------------------------------------------------------------
+# METHOD: childsite ?<index>?
+#
+# If index is supplied, returns the child site widget corresponding
+# to the page index. If called with no arguments, returns a list
+# of all child sites
+# ------------------------------------------------------------------
+body iwidgets::Notebook::childsite { args } {
+ set len [llength $args]
+
+ switch $len {
+ 0 {
+ # ... called with no arguments, return a list
+ if { [llength $args] == 0 } {
+ return [_childSites]
+ }
+ }
+ 1 {
+ set index [lindex $args 0]
+ # ... otherwise, return child site for the index given
+ # empty notebook
+ if { $_pages == {} } {
+ error "can't get childsite,\
+ no pages in the notebook \"$itk_component(hull)\""
+ }
+
+ set index [_index $_pages $index $_currPage]
+
+ # index out of range
+ if { $index < 0 || $index >= [llength $_pages] } {
+ error "bad Notebook page index in childsite method:\
+ should be between 0 and [expr [llength $_pages] - 1]"
+ }
+
+ set pathName [lindex $_pages $index]
+
+ set cs [eval $pathName childsite]
+ return $cs
+ }
+ default {
+ # ... too many parameters passed
+ error "wrong # args: should be\
+ \"$itk_component(hull) childsite ?index?\""
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: delete <index1> ?<index2>?
+#
+# Deletes a page or range of pages from the notebook
+# ------------------------------------------------------------------
+body iwidgets::Notebook::delete { args } {
+ # empty notebook
+ if { $_pages == {} } {
+ error "can't delete page, no pages in the notebook\
+ \"$itk_component(hull)\""
+ }
+
+ set len [llength $args]
+ switch -- $len {
+ 1 {
+ set fromPage [_index $_pages [lindex $args 0] $_currPage]
+
+ if { $fromPage < 0 || $fromPage >= [llength $_pages] } {
+ error "bad Notebook page index in delete method:\
+ should be between 0 and [expr [llength $_pages] - 1]"
+ }
+
+ set toPage $fromPage
+ _deletePages $fromPage $toPage
+ }
+
+ 2 {
+ set fromPage [_index $_pages [lindex $args 0] $_currPage]
+
+ if { $fromPage < 0 || $fromPage >= [llength $_pages] } {
+ error "bad Notebook page index1 in delete method:\
+ should be between 0 and [expr [llength $_pages] - 1]"
+ }
+
+ set toPage [_index $_pages [lindex $args 1] $_currPage]
+
+ if { $toPage < 0 || $toPage >= [llength $_pages] } {
+ error "bad Notebook page index2 in delete method:\
+ should be between 0 and [expr [llength $_pages] - 1]"
+ error "bad Notebook page index2"
+ }
+
+ if { $fromPage > $toPage } {
+ error "bad Notebook page index1 in delete method:\
+ index1 is greater than index2"
+ }
+
+ _deletePages $fromPage $toPage
+
+ }
+
+ default {
+ # ... too few/many parameters passed
+ error "wrong # args: should be\
+ \"$itk_component(hull) delete index1 ?index2?\""
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: index <index>
+#
+# Given an index identifier returns the numeric index of the page
+# ------------------------------------------------------------------
+body iwidgets::Notebook::index { args } {
+ if { [llength $args] != 1 } {
+ error "wrong # args: should be\
+ \"$itk_component(hull) index index\""
+ }
+
+ set index $args
+
+ set number [_index $_pages $index $_currPage]
+
+ return $number
+}
+
+# ------------------------------------------------------------------
+# METHOD: insert <index> ?<option> <value>...?
+#
+# Inserts a page before a index. The before page may
+# be specified as a label or a page position.
+# ------------------------------------------------------------------
+body iwidgets::Notebook::insert { args } {
+ # ... Error: no args passed
+ set len [llength $args]
+ if { $len == 0 } {
+ error "wrong # args: should be\
+ \"$itk_component(hull) insert index ?option value?\""
+ }
+
+ # ... set up index and args
+ set index [lindex $args 0]
+ set args [lrange $args 1 $len]
+
+ # ... Error: unmatched option value pair (len is odd)
+ # The args list should be an even # of params, if not then
+ # prob missing value for last item in args list. Signal error.
+ set len [llength $args]
+ if { [expr $len % 2] } {
+ error "value for \"[lindex $args [expr $len - 1]]\" missing"
+ }
+
+ # ... Error: catch notebook empty
+ if { $_pages == {} } {
+ error "can't insert page, no pages in the notebook\
+ \"$itk_component(hull)\""
+ }
+
+ # ok, get the page
+ set page [_index $_pages $index $_currPage]
+
+ # ... Error: catch bad value for before page.
+ if { $page < 0 || $page >= [llength $_pages] } {
+ error "bad Notebook page index in insert method:\
+ should be between 0 and [expr [llength $_pages] - 1]"
+ }
+
+ # ... Start the business of inserting
+ # create the new page and get its path name...
+ set pathName [eval _createPage $args]
+
+ # grab the name of the page currently selected. (to keep in sync)
+ set currPathName [lindex $_pages $_currPage]
+
+ # insert pathName before $page
+ set _pages [linsert $_pages $page $pathName]
+
+ # keep the _currPage in sync with the insert.
+ set _currPage [lsearch -exact $_pages $currPathName]
+
+ # give scrollcommand chance to update
+ _scrollCommand
+
+ # give them child site back...
+ return [eval $pathName childsite]
+}
+
+# ------------------------------------------------------------------
+# METHOD: prev
+#
+# Selects the previous page. Wraps at first back to last page.
+# ------------------------------------------------------------------
+body iwidgets::Notebook::prev { } {
+ # catch empty notebook
+ if { $_pages == {} } {
+ error "can't move to previous page,\
+ no pages in the notebook \"$itk_component(hull)\""
+ }
+
+ # bump to the previous page and wrap if necessary
+ set prev [expr $_currPage - 1]
+ if { $prev < 0 } {
+ set prev [expr [llength $_pages] - 1]
+ }
+
+ select $prev
+
+ return $prev
+}
+
+# ------------------------------------------------------------------
+# METHOD: next
+#
+# Selects the next page. Wraps at last back to first page.
+# ------------------------------------------------------------------
+body iwidgets::Notebook::next { } {
+ # catch empty notebook
+ if { $_pages == {} } {
+ error "can't move to next page,\
+ no pages in the notebook \"$itk_component(hull)\""
+ }
+
+ # bump to the next page and wrap if necessary
+ set next [expr $_currPage + 1]
+ if { $next >= [llength $_pages] } {
+ set next 0
+ }
+
+ select $next
+
+ return $next
+}
+
+# ------------------------------------------------------------------
+# METHOD: pageconfigure <index> ?<option> <value>...?
+#
+# Performs configure on a given page denoted by index. Index may
+# be a page number or a pattern matching the label associated with
+# a page.
+# ------------------------------------------------------------------
+body iwidgets::Notebook::pageconfigure { args } {
+ # ... Error: no args passed
+ set len [llength $args]
+ if { $len == 0 } {
+ error "wrong # args: should be\
+ \"$itk_component(hull) pageconfigure index ?option value?\""
+ }
+
+ # ... set up index and args
+ set index [lindex $args 0]
+ set args [lrange $args 1 $len]
+
+ set page [_index $_pages $index $_currPage]
+
+ # ... Error: page out of range
+ if { $page < 0 || $page >= [llength $_pages] } {
+ error "bad Notebook page index in pageconfigure method:\
+ should be between 0 and [expr [llength $_pages] - 1]"
+ }
+
+ # Configure the page component
+ set pathName [lindex $_pages $page]
+ return [eval $pathName configure $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: pagecget <index> <option>
+#
+# Performs cget on a given page denoted by index. Index may
+# be a page number or a pattern matching the label associated with
+# a page.
+# ------------------------------------------------------------------
+body iwidgets::Notebook::pagecget { index option } {
+ set page [_index $_pages $index $_currPage]
+
+ # ... Error: page out of range
+ if { $page < 0 || $page >= [llength $_pages] } {
+ error "bad Notebook page index in pagecget method:\
+ should be between 0 and [expr [llength $_pages] - 1]"
+ }
+
+ # Get the page info.
+ set pathName [lindex $_pages $page]
+ return [$pathName cget $option]
+}
+
+# ------------------------------------------------------------------
+# METHOD: select <index>
+#
+# Select a page by index. Hide the last _currPage if it existed.
+# Then show the new one if it exists. Returns the currently
+# selected page or -1 if tried to do a select select when there is
+# no selection.
+# ------------------------------------------------------------------
+body iwidgets::Notebook::select { index } {
+ global page$itk_component(hull)
+
+ # ... Error: empty notebook
+ if { $_pages == {} } {
+ error "can't select page $index,\
+ no pages in the notebook \"$itk_component(hull)\""
+ }
+
+ # if there is not current selection just ignore trying this selection
+ if { $index == "select" && $_currPage == -1 } {
+ return -1
+ }
+
+ set reqPage [_index $_pages $index $_currPage]
+
+ if { $reqPage < 0 || $reqPage >= [llength $_pages] } {
+ error "bad Notebook page index in select method:\
+ should be between 0 and [expr [llength $_pages] - 1]"
+ }
+
+ # if we already have this page selected, then ignore selection.
+ if { $reqPage == $_currPage } {
+ return $_currPage
+ }
+
+ # if we are handling packing and unpacking the unpack if we can
+ if { $itk_option(-auto) } {
+ # if there is a current page packed, then unpack it
+ if { $_currPage != -1 } {
+ set currPathName [lindex $_pages $_currPage]
+ pack forget $currPathName
+ }
+ }
+
+ # set this now so that the -command cmd can do an 'index select'
+ # to operate on this page.
+ set _currPage $reqPage
+
+ # invoke the command for this page
+ set cmd [lindex [pageconfigure $index -command] 4]
+ eval $cmd
+
+ # give scrollcommand chance to update
+ _scrollCommand
+
+ # if we are handling packing and unpacking the pack if we can
+ if { $itk_option(-auto) } {
+ set reqPathName [lindex $_pages $reqPage]
+ pack $reqPathName -anchor nw -fill both -expand yes
+ }
+
+ return $_currPage
+}
+
+
+# ------------------------------------------------------------------
+# METHOD: view
+#
+# Return the current page
+#
+# view <index>
+#
+# Selects the page denoted by index to be current page
+#
+# view 'moveto' <fraction>
+#
+# Selects the page by using fraction amount
+#
+# view 'scroll' <num> <what>
+#
+# Selects the page by using num as indicator of next or previous
+# ------------------------------------------------------------------
+body iwidgets::Notebook::view { args } {
+ set len [llength $args]
+ switch -- $len {
+ 0 {
+ # Return current page
+ return $_currPage
+ }
+ 1 {
+ # Select by index
+ select [lindex $args 0]
+ }
+ 2 {
+ # Select using moveto
+ set arg [lindex $args 0]
+ if { $arg == "moveto" } {
+ set fraction [lindex $args 1]
+ if { [catch { set page \
+ [expr round($fraction/(1.0/[llength $_pages]))]}]} {
+ error "expected floating-point number \
+ but got \"$fraction\""
+ }
+ if { $page == [llength $_pages] } {
+ incr page -1
+ }
+
+ if { $page >= 0 && $page < [llength $_pages] } {
+ select $page
+ }
+ } else {
+ error "expected \"moveto\" but got $arg"
+ }
+ }
+ 3 {
+ # Select using scroll keyword
+ set arg [lindex $args 0]
+ if { $arg == "scroll" } {
+ set amount [lindex $args 1]
+ # check for integer value
+ if { ! [regexp {^[-]*[0-9]*$} $amount] } {
+ error "expected integer but got \"$amount\""
+ }
+ set page [expr $_currPage + $amount]
+ if { $page >= 0 && $page < [llength $_pages] } {
+ select $page
+ }
+
+ } else {
+ error "expected \"scroll\" but got $arg"
+ }
+ }
+ default {
+ set arg [lindex $args 0]
+ if { $arg == "moveto" } {
+ error "wrong # args: should be\
+ \"$itk_component(hull) view moveto fraction\""
+ } elseif { $arg == "scroll" } {
+ error "wrong # args: should be\
+ \"$itk_component(hull) view scroll units|pages\""
+ } else {
+ error "wrong # args: should be\
+ \"$itk_component(hull) view index\""
+ }
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _childSites
+#
+# Returns a list of child sites for all pages in the notebook.
+# ------------------------------------------------------------------
+body iwidgets::Notebook::_childSites { } {
+ # empty notebook
+ if { $_pages == {} } {
+ error "can't get childsite list,\
+ no pages in the notebook \"$itk_component(hull)\""
+ }
+
+ set csList {}
+
+ foreach pathName $_pages {
+ lappend csList [eval $pathName childsite]
+ }
+
+ return $csList
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _scrollCommand
+#
+# If there is a -scrollcommand set up, then call the tcl command
+# and suffix onto it the standard 4 numbers scrollbars get.
+#
+# Invoke the scrollcommand, this is like the y/xscrollcommand
+# it is designed to talk to scrollbars and the the
+# tabset also knows how to obey scrollbar protocol.
+# ------------------------------------------------------------------
+body iwidgets::Notebook::_scrollCommand { } {
+ if { $itk_option(-scrollcommand) != {} } {
+ if { $_currPage != -1 } {
+ set relTop [expr ($_currPage*1.0) / [llength $_pages]]
+ set relBottom [expr (($_currPage+1)*1.0) / [llength $_pages]]
+ set scrollCommand "$itk_option(-scrollcommand) $relTop $relBottom"
+ } else {
+ set scrollCommand "$itk_option(-scrollcommand) 0 1"
+ }
+ uplevel #0 $scrollCommand
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _index
+#
+# pathList : list of path names to search thru if index is a label
+# index : either number, 'select', 'end', or pattern
+# select : current selection
+#
+# _index takes takes the value $index converts it to
+# a numeric identifier. If the value is not already
+# an integer it looks it up in the $pathList array.
+# If it fails it returns -1
+# ------------------------------------------------------------------
+body iwidgets::Notebook::_index { pathList index select} {
+ switch -- $index {
+ select {
+ set number $select
+ }
+ end {
+ set number [expr [llength $pathList] -1]
+ }
+ default {
+ # is it a number already?
+ if { [regexp {^[0-9]+$} $index] } {
+ set number $index
+ if { $number < 0 || $number >= [llength $pathList] } {
+ set number -1
+ }
+
+ # otherwise it is a label
+ } else {
+ # look thru the pathList of pathNames and
+ # get each label and compare with index.
+ # if we get a match then set number to postion in $pathList
+ # and break out.
+ # otherwise number is still -1
+ set i 0
+ set number -1
+ foreach pathName $pathList {
+ set label [lindex [$pathName configure -label] 4]
+ if { [string match $label $index] } {
+ set number $i
+ break
+ }
+ incr i
+ }
+ }
+ }
+ }
+
+ return $number
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _createPage
+#
+# Creates a page, using unique page naming, propagates background
+# and keeps unique id up to date.
+# ------------------------------------------------------------------
+body iwidgets::Notebook::_createPage { args } {
+ #
+ # create an internal name for the page: .n.cs.page0, .n.cs.page1, etc.
+ #
+ set pathName $itk_component(cs).page$_uniqueID
+
+ eval iwidgets::Page $pathName -background $itk_option(-background) $args
+
+ incr _uniqueID
+ return $pathName
+
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _deletePages
+#
+# Deletes pages from $fromPage to $toPage.
+#
+# Operates in two passes, destroys all the widgets
+# Then removes the pathName from the page list
+#
+# Also keeps the current selection in bounds.
+# ------------------------------------------------------------------
+body iwidgets::Notebook::_deletePages { fromPage toPage } {
+ for { set page $fromPage } { $page <= $toPage } { incr page } {
+ # kill the widget
+ set pathName [lindex $_pages $page]
+ destroy $pathName
+ }
+
+ # physically remove the page
+ set _pages [lreplace $_pages $fromPage $toPage]
+
+ # If we deleted a selected page set our selection to none
+ if { $_currPage >= $fromPage && $_currPage <= $toPage } {
+ set $_currPage -1
+ }
+
+ # make sure _currPage stays in sync with new numbering...
+ if { $_pages == {} } {
+ # if deleted only remaining page,
+ # reset current page to undefined
+ set _currPage -1
+
+ # or if the current page was the last page, it needs come back
+ } elseif { $_currPage >= [llength $_pages] } {
+ incr _currPage -1
+ if { $_currPage < 0 } {
+ # but only to zero
+ set _currPage 0
+ }
+ }
+
+ # give scrollcommand chance to update
+ _scrollCommand
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _configurePages
+#
+# Does the pageconfigure method on each page in the notebook
+# ------------------------------------------------------------------
+body iwidgets::Notebook::_configurePages { args } {
+ # make sure we have pages
+ if { [catch {set _pages}] } {
+ return
+ }
+
+ # go thru all pages and pageconfigure them.
+ foreach pathName $_pages {
+ eval "$pathName configure $args"
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _tabCommand
+#
+# Calls the command that was passed in through the
+# $itk_option(-tabcommand) argument.
+#
+# This method is up for debate... do we need the -tabcommand option?
+# ------------------------------------------------------------------
+body iwidgets::Notebook::_tabCommand { } {
+ global page$itk_component(hull)
+
+ if { $itk_option(-tabcommand) != {} } {
+ set newTabCmdStr $itk_option(-tabcommand)
+ lappend newTabCmdStr [set page$itk_component(hull)]
+
+ #eval $newTabCmdStr
+ uplevel #0 $newTabCmdStr
+ }
+}
+
+#
+# Page widget
+# ------------------------------------------------------------------
+#
+# The Page command creates a new window (given by the pathName argument)
+# and makes it into a Page widget. Additional options, described above
+# may be specified on the com mand line or in the option database to
+# configure aspects of the Page such as its back ground, cursor, and
+# geometry. The Page command returns its pathName argument. At the time
+# this command is invoked, there must not exist a window named pathName,
+# but path Name's parent must exist.
+#
+# A Page is a frame that holds a child site. It is nothing more than a
+# frame widget with some intelligence built in. Its primary purpose is
+# to support the Notebook's concept of a page. It allows another widget
+# like the Notebook to treat a page as a single object. The Page has an
+# associated label and knows how to return its child site.
+#
+# ------------------------------------------------------------------
+# AUTHOR: Bill W. Scott EMAIL: bscott@spd.dsccc.com
+#
+# ------------------------------------------------------------------
+# Copyright (c) 1995 DSC Communications Corp.
+# ======================================================================
+# Permission is hereby granted, without written agreement and without
+# license or royalty fees, to use, copy, modify, and distribute this
+# software and its documentation for any purpose, provided that the
+# above copyright notice and the following two paragraphs appear in
+# all copies of this software.
+#
+# IN NO EVENT SHALL THE COPYRIGHT HOLDER BE LIABLE TO ANY PARTY FOR
+# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+# ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN
+# IF THE COPYRIGHT HOLDER HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
+# DAMAGE.
+#
+# THE COPYRIGHT HOLDER SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING,
+# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+# FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
+# ON AN "AS IS" BASIS, AND THE COPYRIGHT HOLDER HAS NO OBLIGATION TO
+# PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
+# ======================================================================
+#
+# Option database default resources:
+#
+option add *Page.disabledForeground #a3a3a3 widgetDefault
+option add *Page.label {} widgetDefault
+option add *Page.command {} widgetDefault
+
+class iwidgets::Page {
+ inherit itk::Widget
+
+ constructor {args} {}
+
+ itk_option define \
+ -disabledforeground disabledForeground DisabledForeground #a3a3a3
+ itk_option define -label label Label {}
+ itk_option define -command command Command {}
+
+ public method childsite { }
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Page::constructor {args} {
+ #
+ # Create the outermost frame to maintain geometry.
+ #
+ itk_component add cs {
+ frame $itk_interior.cs
+ } {
+ keep -cursor -background -width -height
+ }
+ pack $itk_component(cs) -fill both -expand yes
+ pack propagate $itk_component(cs) no
+
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+# ------------------------------------------------------------------
+# OPTION -disabledforeground
+#
+# Sets the disabledForeground color of this page
+# ------------------------------------------------------------------
+configbody iwidgets::Page::disabledforeground {
+}
+
+# ------------------------------------------------------------------
+# OPTION -label
+#
+# Sets the label of this page. The label is a string identifier
+# for this page.
+# ------------------------------------------------------------------
+configbody iwidgets::Page::label {
+}
+
+# ------------------------------------------------------------------
+# OPTION -command
+#
+# The Tcl Command to associate with this page.
+# ------------------------------------------------------------------
+configbody iwidgets::Page::command {
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: childsite
+#
+# Returns the child site widget of this page
+# ------------------------------------------------------------------
+body iwidgets::Page::childsite { } {
+ return $itk_component(cs)
+}
+
diff --git a/itcl/iwidgets3.0.0/generic/optionmenu.itk b/itcl/iwidgets3.0.0/generic/optionmenu.itk
new file mode 100644
index 00000000000..cfc700f3033
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/optionmenu.itk
@@ -0,0 +1,640 @@
+#
+# Optionmenu
+# ----------------------------------------------------------------------
+# Implements an option menu widget with options to manage it.
+# An option menu displays a frame containing a label and a button.
+# A pop-up menu will allow for the value of the button to change.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Alfredo Jahn Phone: (214) 519-3545
+# Email: ajahn@spd.dsccc.com
+# alfredo@wn.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Default resources.
+#
+
+option add *Optionmenu.highlightThickness 1 widgetDefault
+option add *Optionmenu.borderWidth 2 widgetDefault
+option add *Optionmenu.labelPos w widgetDefault
+option add *Optionmenu.labelMargin 2 widgetDefault
+option add *Optionmenu.popupCursor arrow widgetDefault
+
+#
+# Usual options.
+#
+itk::usual Optionmenu {
+ keep -activebackground -activeborderwidth -activeforeground \
+ -background -borderwidth -cursor -disabledforeground -font \
+ -foreground -highlightcolor -highlightthickness -labelfont \
+ -popupcursor
+}
+
+# ------------------------------------------------------------------
+# OPTONMENU
+# ------------------------------------------------------------------
+class iwidgets::Optionmenu {
+ inherit iwidgets::Labeledwidget
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -clicktime clickTime ClickTime 150
+ itk_option define -command command Command {}
+ itk_option define -cyclicon cyclicOn CyclicOn true
+ itk_option define -width width Width 0
+ itk_option define -font font Font -Adobe-Helvetica-Bold-R-Normal--*-120-*
+ itk_option define -borderwidth borderWidth BorderWidth 2
+ itk_option define -highlightthickness highlightThickness HighlightThickness 1
+ itk_option define -state state State normal
+
+ public {
+ method index {index}
+ method delete {first {last {}}}
+ method disable {index}
+ method enable {args}
+ method get {{first "current"} {last ""}}
+ method insert {index string args}
+ method popupMenu {args}
+ method select {index}
+ method sort {{mode "increasing"}}
+ }
+
+ protected {
+ variable _calcSize "" ;# non-null => _calcSize pending
+ }
+
+ private {
+ method _buttonRelease {time}
+ method _getNextItem {index}
+ method _next {}
+ method _postMenu {time}
+ method _previous {}
+ method _setItem {item}
+ method _setSize {{when later}}
+ method _setitems {items} ;# Set the list of menu entries
+
+ variable _postTime 0
+ variable _items {} ;# List of popup menu entries
+ variable _numitems 0 ;# List of popup menu entries
+
+ variable _currentItem "" ;# Active menu selection
+ }
+}
+
+#
+# Provide a lowercased access method for the Optionmenu class.
+#
+proc ::iwidgets::optionmenu {pathName args} {
+ uplevel ::iwidgets::Optionmenu $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::constructor {args} {
+ global tcl_platform
+
+ component hull configure -highlightthickness 0
+
+ itk_component add menuBtn {
+ menubutton $itk_interior.menuBtn -relief raised -indicator on \
+ -textvariable [scope _currentItem] -takefocus 1 \
+ -menu $itk_interior.menuBtn.menu
+ } {
+ usual
+ keep -borderwidth
+ if {$tcl_platform(platform) != "unix"} {
+ ignore -activebackground -activeforeground
+ }
+ }
+ pack $itk_interior.menuBtn -fill x
+ pack propagate $itk_interior no
+
+ itk_component add popupMenu {
+ menu $itk_interior.menuBtn.menu -tearoff no
+ } {
+ usual
+ ignore -tearoff
+ keep -activeborderwidth -borderwidth
+ rename -cursor -popupcursor popupCursor Cursor
+ }
+
+ #
+ # Bind to button release for all components.
+ #
+ bind $itk_component(menuBtn) <ButtonPress-1> \
+ "[code $this _postMenu %t]; break"
+ bind $itk_component(menuBtn) <KeyPress-space> \
+ "[code $this _postMenu %t]; break"
+ bind $itk_component(popupMenu) <ButtonRelease-1> \
+ [code $this _buttonRelease %t]
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# DESTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::destructor {} {
+ if {$_calcSize != ""} {after cancel $_calcSize}
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION -clicktime
+#
+# Interval time (in msec) used to determine that a single mouse
+# click has occurred. Used to post menu on a quick mouse click.
+# **WARNING** changing this value may cause the sigle-click
+# functionality to not work properly!
+# ------------------------------------------------------------------
+configbody iwidgets::Optionmenu::clicktime {}
+
+# ------------------------------------------------------------------
+# OPTION -command
+#
+# Specifies a command to be evaluated upon change in option menu.
+# ------------------------------------------------------------------
+configbody iwidgets::Optionmenu::command {}
+
+# ------------------------------------------------------------------
+# OPTION -cyclicon
+#
+# Turns on/off the 3rd mouse button capability. This feature
+# allows the right mouse button to cycle through the popup
+# menu list without poping it up. <shift>M3 cycles through
+# the menu in reverse order.
+# ------------------------------------------------------------------
+configbody iwidgets::Optionmenu::cyclicon {
+ if {$itk_option(-cyclicon)} {
+ bind $itk_component(menuBtn) <3> [code $this _next]
+ bind $itk_component(menuBtn) <Shift-3> [code $this _previous]
+ bind $itk_component(menuBtn) <KeyPress-Down> [code $this _next]
+ bind $itk_component(menuBtn) <KeyPress-Up> [code $this _previous]
+ } else {
+ bind $itk_component(menuBtn) <3> break
+ bind $itk_component(menuBtn) <Shift-3> break
+ bind $itk_component(menuBtn) <KeyPress-Down> break
+ bind $itk_component(menuBtn) <KeyPress-Up> break
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION -width
+#
+# Allows the menu label width to be set to a fixed size
+# ------------------------------------------------------------------
+configbody iwidgets::Optionmenu::width {
+ _setSize
+}
+
+# ------------------------------------------------------------------
+# OPTION -font
+#
+# Change all fonts for this widget. Also re-calculate height based
+# on font size (used to line up menu items over menu button label).
+# ------------------------------------------------------------------
+configbody iwidgets::Optionmenu::font {
+ _setSize
+}
+
+# ------------------------------------------------------------------
+# OPTION -borderwidth
+#
+# Change borderwidth for this widget. Also re-calculate height based
+# on font size (used to line up menu items over menu button label).
+# ------------------------------------------------------------------
+configbody iwidgets::Optionmenu::borderwidth {
+ _setSize
+}
+
+# ------------------------------------------------------------------
+# OPTION -highlightthickness
+#
+# Change highlightthickness for this widget. Also re-calculate
+# height based on font size (used to line up menu items over
+# menu button label).
+# ------------------------------------------------------------------
+configbody iwidgets::Optionmenu::highlightthickness {
+ _setSize
+}
+
+# ------------------------------------------------------------------
+# OPTION -state
+#
+# Specified one of two states for the Optionmenu: normal, or
+# disabled. If the Optionmenu is disabled, then option menu
+# selection is ignored.
+# ------------------------------------------------------------------
+configbody iwidgets::Optionmenu::state {
+ switch $itk_option(-state) {
+ normal {
+ $itk_component(menuBtn) config -state normal
+ $itk_component(label) config -fg $itk_option(-foreground)
+ }
+ disabled {
+ $itk_component(menuBtn) config -state disabled
+ $itk_component(label) config -fg $itk_option(-disabledforeground)
+ }
+ default {
+ error "bad state option \"$itk_option(-state)\":\
+ should be disabled or normal"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: index index
+#
+# Return the numerical index corresponding to index.
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::index {index} {
+
+ if {[regexp {(^[0-9]+$)} $index]} {
+ set idx [$itk_component(popupMenu) index $index]
+
+ if {$idx == "none"} {
+ return 0
+ }
+ return [expr {$index > $idx ? $_numitems : $idx}]
+
+ } elseif {$index == "end"} {
+ return $_numitems
+
+ } elseif {$index == "select"} {
+ return [lsearch $_items $_currentItem]
+
+ }
+
+ set numValue [lsearch -glob $_items $index]
+
+ if {$numValue == -1} {
+ error "bad Optionmenu index \"$index\""
+ }
+ return $numValue
+}
+
+# ------------------------------------------------------------------
+# METHOD: delete first ?last?
+#
+# Remove an item (or range of items) from the popup menu.
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::delete {first {last {}}} {
+
+ set first [index $first]
+ set last [expr {$last != {} ? [index $last] : $first}]
+ set nextAvail $_currentItem
+
+ #
+ # If current item is in delete range point to next available.
+ #
+ if {$_numitems > 1 &&
+ ([lsearch -exact [lrange $_items $first $last] [get]] != -1)} {
+ set nextAvail [_getNextItem $last]
+ }
+
+ _setitems [lreplace $_items $first $last]
+
+ #
+ # Make sure "nextAvail" is still in the list.
+ #
+ set index [lsearch -exact $_items $nextAvail]
+ _setItem [expr {$index != -1 ? $nextAvail : ""}]
+}
+
+# ------------------------------------------------------------------
+# METHOD: disable index
+#
+# Disable a menu item in the option menu. This will prevent the user
+# from being able to select this item from the menu. This only effects
+# the state of the item in the menu, in other words, should the item
+# be the currently selected item, the user is responsible for
+# determining this condition and taking appropriate action.
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::disable {index} {
+ set index [index $index]
+ $itk_component(popupMenu) entryconfigure $index -state disabled
+}
+
+# ------------------------------------------------------------------
+# METHOD: enable index
+#
+# Enable a menu item in the option menu. This will allow the user
+# to select this item from the menu.
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::enable {index} {
+ set index [index $index]
+ $itk_component(popupMenu) entryconfigure $index -state normal
+}
+
+# ------------------------------------------------------------------
+# METHOD: get
+#
+# Returns the current menu item.
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::get {{first "current"} {last ""}} {
+ if {"current" == $first} {
+ return $_currentItem
+ }
+
+ set first [index $first]
+ if {"" == $last} {
+ return [$itk_component(popupMenu) entrycget $first -label]
+ }
+
+ if {"end" == $last} {
+ set last [$itk_component(popupMenu) index end]
+ } else {
+ set last [index $last]
+ }
+ set rval ""
+ while {$first <= $last} {
+ lappend rval [$itk_component(popupMenu) entrycget $first -label]
+ incr first
+ }
+ return $rval
+}
+
+# ------------------------------------------------------------------
+# METHOD: insert index string ?string?
+#
+# Insert an item in the popup menu.
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::insert {index string args} {
+ set index [index $index]
+ set args [linsert $args 0 $string]
+ _setitems [eval linsert {$_items} $index $args]
+ return ""
+}
+
+# ------------------------------------------------------------------
+# METHOD: select index
+#
+# Select an item from the popup menu to display on the menu label
+# button.
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::select {index} {
+ set index [index $index]
+ _setItem [lindex $_items $index]
+}
+
+# ------------------------------------------------------------------
+# METHOD: popupMenu
+#
+# Evaluates the specified args against the popup menu component
+# and returns the result.
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::popupMenu {args} {
+ return [eval $itk_component(popupMenu) $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: sort mode
+#
+# Sort the current menu in either "ascending" or "descending" order.
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::sort {{mode "increasing"}} {
+ switch $mode {
+ ascending -
+ increasing {
+ _setitems [lsort -increasing $_items]
+ }
+ descending -
+ decreasing {
+ _setitems [lsort -decreasing $_items]
+ }
+ default {
+ error "bad sort argument \"$mode\": should be ascending,\
+ descending, increasing, or decreasing"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _buttonRelease
+#
+# Display the popup menu. Menu position is calculated.
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::_buttonRelease {time} {
+ if {[expr abs([expr $_postTime - $time])] <= $itk_option(-clicktime)} {
+ return -code break
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _getNextItem index
+#
+# Allows either a string or index number to be passed in, and returns
+# the next item in the list in string format. Wrap around is automatic.
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::_getNextItem {index} {
+
+ if {[incr index] >= $_numitems} {
+ set index 0 ;# wrap around
+ }
+ return [lindex $_items $index]
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _next
+#
+# Sets the current option label to next item in list if that item is
+# not disbaled.
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::_next {} {
+ if {$itk_option(-state) != "normal"} {
+ return
+ }
+ set i [lsearch -exact $_items $_currentItem]
+
+ for {set cnt 0} {$cnt < $_numitems} {incr cnt} {
+
+ if {[incr i] >= $_numitems} {
+ set i 0
+ }
+
+ if {[$itk_component(popupMenu) entrycget $i -state] != "disabled"} {
+ _setItem [lindex $_items $i]
+ break
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _previous
+#
+# Sets the current option label to previous item in list if that
+# item is not disbaled.
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::_previous {} {
+ if {$itk_option(-state) != "normal"} {
+ return
+ }
+
+ set i [lsearch -exact $_items $_currentItem]
+
+ for {set cnt 0} {$cnt < $_numitems} {incr cnt} {
+ set i [expr $i - 1]
+
+ if {$i < 0} {
+ set i [expr $_numitems - 1]
+ }
+
+ if {[$itk_component(popupMenu) entrycget $i -state] != "disabled"} {
+ _setItem [lindex $_items $i]
+ break
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _postMenu time
+#
+# Display the popup menu. Menu position is calculated.
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::_postMenu {time} {
+ #
+ # Don't bother to post if menu is empty.
+ #
+ if {[llength $_items] > 0 && $itk_option(-state) == "normal"} {
+ set _postTime $time
+ set itemIndex [lsearch -exact $_items $_currentItem]
+
+ set margin [expr $itk_option(-borderwidth) \
+ + $itk_option(-highlightthickness)]
+
+ set x [expr [winfo rootx $itk_component(menuBtn)] + $margin]
+ set y [expr [winfo rooty $itk_component(menuBtn)] \
+ - [$itk_component(popupMenu) yposition $itemIndex] + $margin]
+
+ tk_popup $itk_component(popupMenu) $x $y
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _setItem
+#
+# Set the menu button label to item, then dismiss the popup menu.
+# Also check if item has been changed. If so, also call user-supplied
+# command.
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::_setItem {item} {
+ if {$_currentItem != $item} {
+ set _currentItem $item
+ if {[winfo ismapped $itk_component(hull)]} {
+ uplevel #0 $itk_option(-command)
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _setitems items
+#
+# Create a list of items available on the menu. Used to create the
+# popup menu.
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::_setitems {items_} {
+
+ #
+ # Delete the old menu entries, and set the new list of
+ # menu entries to those specified in "items_".
+ #
+ $itk_component(popupMenu) delete 0 last
+ set _items ""
+ set _numitems [llength $items_]
+
+ #
+ # Clear the menu button label.
+ #
+ if {$_numitems == 0} {
+ _setItem ""
+ return
+ }
+
+ set savedCurrentItem $_currentItem
+
+ foreach opt $items_ {
+ lappend _items $opt
+ $itk_component(popupMenu) add command -label $opt \
+ -command [code $this _setItem $opt]
+ }
+ set first [lindex $_items 0]
+
+ #
+ # Make sure "savedCurrentItem" is still in the list.
+ #
+ if {$first != ""} {
+ set i [lsearch -exact $_items $savedCurrentItem]
+ select [expr {$i != -1 ? $savedCurrentItem : $first}]
+ } else {
+ _setItem ""
+ }
+
+ _setSize
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _setSize ?when?
+#
+# Set the size of the option menu. If "when" is "now", the change
+# is applied immediately. If it is "later" or it is not specified,
+# then the change is applied later, when the application is idle.
+# ------------------------------------------------------------------
+body iwidgets::Optionmenu::_setSize {{when later}} {
+
+ if {$when == "later"} {
+ if {$_calcSize == ""} {
+ set _calcSize [after idle [code $this _setSize now]]
+ }
+ return
+ }
+
+ set margin [expr 2*($itk_option(-borderwidth) \
+ + $itk_option(-highlightthickness))]
+
+ if {"0" != $itk_option(-width)} {
+ set width $itk_option(-width)
+ } else {
+ set width [expr [winfo reqwidth $itk_component(popupMenu)]+$margin+20]
+ }
+ set height [winfo reqheight $itk_component(menuBtn)]
+ $itk_component(lwchildsite) configure -width $width -height $height
+
+ set _calcSize ""
+}
diff --git a/itcl/iwidgets3.0.0/generic/pane.itk b/itcl/iwidgets3.0.0/generic/pane.itk
new file mode 100644
index 00000000000..dd1baa28182
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/pane.itk
@@ -0,0 +1,128 @@
+#
+# Paned
+# ----------------------------------------------------------------------
+# Implements a pane for a paned window widget. The pane is itself a
+# frame with a child site for other widgets. The pane class performs
+# basic option management.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Pane {
+ keep -background -cursor
+}
+
+# ------------------------------------------------------------------
+# PANE
+# ------------------------------------------------------------------
+class iwidgets::Pane {
+ inherit itk::Widget
+
+ constructor {args} {}
+
+ itk_option define -minimum minimum Minimum 10
+ itk_option define -margin margin Margin 8
+
+ public method childSite {} {}
+}
+
+#
+# Provide a lowercased access method for the Pane class.
+#
+proc ::iwidgets::pane {pathName args} {
+ uplevel ::iwidgets::Pane $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Pane::constructor {args} {
+ #
+ # Create the pane childsite.
+ #
+ itk_component add childsite {
+ frame $itk_interior.childsite
+ } {
+ keep -background -cursor
+ }
+ pack $itk_component(childsite) -fill both -expand yes
+
+ #
+ # Set the itk_interior variable to be the childsite for derived
+ # classes.
+ #
+ set itk_interior $itk_component(childsite)
+
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -minimum
+#
+# Specifies the minimum size that the pane may reach.
+# ------------------------------------------------------------------
+configbody iwidgets::Pane::minimum {
+ set pixels \
+ [winfo pixels $itk_component(hull) $itk_option(-minimum)]
+
+ set $itk_option(-minimum) $pixels
+}
+
+# ------------------------------------------------------------------
+# OPTION: -margin
+#
+# Specifies the border distance between the pane and pane contents.
+# This is done by setting the borderwidth of the pane to the margin.
+# ------------------------------------------------------------------
+configbody iwidgets::Pane::margin {
+ set pixels [winfo pixels $itk_component(hull) $itk_option(-margin)]
+ set itk_option(-margin) $pixels
+
+ $itk_component(childsite) configure \
+ -borderwidth $itk_option(-margin)
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: childSite
+#
+# Return the pane child site path name.
+# ------------------------------------------------------------------
+body iwidgets::Pane::childSite {} {
+ return $itk_component(childsite)
+}
diff --git a/itcl/iwidgets3.0.0/generic/panedwindow.itk b/itcl/iwidgets3.0.0/generic/panedwindow.itk
new file mode 100644
index 00000000000..6ed1165919b
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/panedwindow.itk
@@ -0,0 +1,893 @@
+#
+# Panedwindow
+# ----------------------------------------------------------------------
+# Implements a multiple paned window widget capable of orienting the panes
+# either vertically or horizontally. Each pane is itself a frame acting
+# as a child site for other widgets. The border separating each pane
+# contains a sash which allows user positioning of the panes relative to
+# one another.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Panedwindow {
+ keep -background -cursor -sashcursor
+}
+
+# ------------------------------------------------------------------
+# PANEDWINDOW
+# ------------------------------------------------------------------
+class iwidgets::Panedwindow {
+ inherit itk::Widget
+
+ constructor {args} {}
+
+ itk_option define -orient orient Orient horizontal
+ itk_option define -sashborderwidth sashBorderWidth SashBorderWidth 2
+ itk_option define -sashcursor sashCursor SashCursor crosshair
+ itk_option define -sashwidth sashWidth SashWidth 10
+ itk_option define -sashheight sashHeight SashHeight 10
+ itk_option define -thickness thickness Thickness 3
+ itk_option define -sashindent sashIndent SashIndent -10
+
+ public method index {index}
+ public method childsite {args}
+ public method fraction {percentage1 percentage2 args}
+ public method add {tag args}
+ public method insert {index tag args}
+ public method delete {index}
+ public method hide {index}
+ public method show {index}
+ public method paneconfigure {index args}
+ public method reset {}
+
+ protected method _pwConfigureEventHandler {width height}
+ protected method _startGrip {where num}
+ protected method _endGrip {where num}
+ protected method _configGrip {where num}
+ protected method _handleGrip {where num}
+ protected method _moveSash {where num}
+
+ private method _setFracArray {}
+ private method _setActivePanes {}
+ private method _calcFraction {where num}
+ private method _makeSashes {}
+ private method _placeSash {i}
+ private method _placePanes {{start 0} {end end}}
+
+ private variable _initialized 0 ;# Denotes initialized state.
+ private variable _panes {} ;# List of panes.
+ private variable _activePanes {} ;# List of active panes.
+ private variable _sashes {} ;# List of sashes.
+ private variable _separators {} ;# List of separators.
+ private variable _frac ;# Array of fraction percentages.
+ private variable _lowerlimit ;# Margin distance above/left of sash.
+ private variable _upperlimit ;# Margin distance below/right of sash.
+ private variable _dimension ;# Width/Height at start of drag.
+ private variable _sashloc ;# Array of dist of sash from above/left.
+ private variable _pixels ;# Array of dist of sash from above/left.
+ private variable _minheight ;# Array of min heights for panes.
+ private variable _minsashmoved ;# Lowest sash moved during dragging.
+ private variable _maxsashmoved ;# Highest sash moved during dragging.
+ private variable _dragging 0 ;# Boolean for dragging enabled.
+ private variable _movecount 0 ;# Kludge counter to get sashes to
+ ;# display without calling update
+ ;# idletasks too often.
+ private variable _width 0 ;# hull's width.
+ private variable _height 0 ;# hull's height.
+ private variable _unique -1 ;# Unique number for pane names.
+}
+
+#
+# Provide a lowercased access method for the Panedwindow class.
+#
+proc ::iwidgets::panedwindow {pathName args} {
+ uplevel ::iwidgets::Panedwindow $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Panedwindow.width 10 widgetDefault
+option add *Panedwindow.height 10 widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::constructor {args} {
+ itk_option add hull.width hull.height
+
+ pack propagate $itk_component(hull) no
+
+ #
+ # Add binding for the configure event.
+ #
+ bind pw-config-$this <Configure> [code $this _pwConfigureEventHandler %w %h]
+ bindtags $itk_component(hull) \
+ [linsert [bindtags $itk_component(hull)] 0 pw-config-$this]
+
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -orient
+#
+# Specifies the orientation of the sashes. Once the paned window
+# has been mapped, set the sash bindings and place the panes.
+# ------------------------------------------------------------------
+configbody iwidgets::Panedwindow::orient {
+ if {$_initialized} {
+ switch $itk_option(-orient) {
+ vertical {
+ for {set i 1} {$i < [llength $_panes]} {incr i} {
+ bind $itk_component(sash$i) <Button-1> \
+ [code $this _startGrip %x $i]
+ bind $itk_component(sash$i) <B1-Motion> \
+ [code $this _handleGrip %x $i]
+ bind $itk_component(sash$i) <B1-ButtonRelease-1> \
+ [code $this _endGrip %x $i]
+ bind $itk_component(sash$i) <Configure> \
+ [code $this _configGrip %x $i]
+ }
+
+ _setFracArray
+ _makeSashes
+ _placePanes
+ }
+
+ horizontal {
+ for {set i 1} {$i < [llength $_panes]} {incr i} {
+ bind $itk_component(sash$i) <Button-1> \
+ [code $this _startGrip %y $i]
+ bind $itk_component(sash$i) <B1-Motion> \
+ [code $this _handleGrip %y $i]
+ bind $itk_component(sash$i) <B1-ButtonRelease-1> \
+ [code $this _endGrip %y $i]
+ bind $itk_component(sash$i) <Configure> \
+ [code $this _configGrip %y $i]
+ }
+
+ _setFracArray
+ _makeSashes
+ _placePanes
+ }
+
+ default {
+ error "bad orientation option \"$itk_option(-orient)\":\
+ should be horizontal or vertical"
+ }
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -sashborderwidth
+#
+# Specifies a non-negative value indicating the width of the 3-D
+# border to draw around the outside of the sash.
+# ------------------------------------------------------------------
+configbody iwidgets::Panedwindow::sashborderwidth {
+ set pixels [winfo pixels $itk_component(hull) \
+ $itk_option(-sashborderwidth)]
+ set itk_option(-sashborderwidth) $pixels
+
+ if {$_initialized} {
+ for {set i 1} {$i < [llength $_panes]} {incr i} {
+ $itk_component(sash$i) configure \
+ -borderwidth $itk_option(-sashborderwidth)
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -sashcursor
+#
+# Specifies the type of cursor to be used when over the sash.
+# ------------------------------------------------------------------
+configbody iwidgets::Panedwindow::sashcursor {
+ if {$_initialized} {
+ for {set i 1} {$i < [llength $_panes]} {incr i} {
+ $itk_component(sash$i) configure \
+ -cursor $itk_option(-sashcursor)
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -sashwidth
+#
+# Specifies the width of the sash.
+# ------------------------------------------------------------------
+configbody iwidgets::Panedwindow::sashwidth {
+ set pixels [winfo pixels $itk_component(hull) \
+ $itk_option(-sashwidth)]
+ set itk_option(-sashwidth) $pixels
+
+ if {$_initialized} {
+ for {set i 1} {$i < [llength $_panes]} {incr i} {
+ $itk_component(sash$i) configure \
+ -width $itk_option(-sashwidth)
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -sashheight
+#
+# Specifies the height of the sash,
+# ------------------------------------------------------------------
+configbody iwidgets::Panedwindow::sashheight {
+ set pixels [winfo pixels $itk_component(hull) \
+ $itk_option(-sashheight)]
+ set itk_option(-sashheight) $pixels
+
+ if {$_initialized} {
+ for {set i 1} {$i < [llength $_panes]} {incr i} {
+ $itk_component(sash$i) configure \
+ -height $itk_option(-sashheight)
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -thickness
+#
+# Specifies the thickness of the separators. It sets the width and
+# height of the separator to the thickness value and the borderwidth
+# to half the thickness.
+# ------------------------------------------------------------------
+configbody iwidgets::Panedwindow::thickness {
+ set pixels [winfo pixels $itk_component(hull) \
+ $itk_option(-thickness)]
+ set itk_option(-thickness) $pixels
+
+ if {$_initialized} {
+ for {set i 1} {$i < [llength $_panes]} {incr i} {
+ $itk_component(separator$i) configure \
+ -height $itk_option(-thickness)
+ $itk_component(separator$i) configure \
+ -width $itk_option(-thickness)
+ $itk_component(separator$i) configure \
+ -borderwidth [expr $itk_option(-thickness) / 2]
+ }
+
+ for {set i 1} {$i < [llength $_panes]} {incr i} {
+ _placeSash $i
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -sashindent
+#
+# Specifies the placement of the sash along the panes. A positive
+# value causes the sash to be offset from the near (left/top) side
+# of the pane, and a negative value causes the sash to be offset from
+# the far (right/bottom) side. If the offset is greater than the
+# width, then the sash is placed flush against the side.
+# ------------------------------------------------------------------
+configbody iwidgets::Panedwindow::sashindent {
+ set pixels [winfo pixels $itk_component(hull) \
+ $itk_option(-sashindent)]
+ set itk_option(-sashindent) $pixels
+
+ if {$_initialized} {
+ for {set i 1} {$i < [llength $_panes]} {incr i} {
+ _placeSash $i
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: index index
+#
+# Searches the panes in the paned window for the one with the
+# requested tag, numerical index, or keyword "end". Returns the pane's
+# numerical index if found, otherwise error.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::index {index} {
+ if {[llength $_panes] > 0} {
+ if {[regexp {(^[0-9]+$)} $index]} {
+ if {$index < [llength $_panes]} {
+ return $index
+ } else {
+ error "Panedwindow index \"$index\" is out of range"
+ }
+
+ } elseif {$index == "end"} {
+ return [expr [llength $_panes] - 1]
+
+ } else {
+ if {[set idx [lsearch $_panes $index]] != -1} {
+ return $idx
+ }
+
+ error "bad Panedwindow index \"$index\": must be number, end,\
+ or pattern"
+ }
+
+ } else {
+ error "Panedwindow \"$itk_component(hull)\" has no panes"
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: childsite ?index?
+#
+# Given an index return the specifc childsite path name. Invoked
+# without an index return a list of all the child site panes. The
+# list is ordered from the near side (left/top).
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::childsite {args} {
+ if {! $_initialized} {
+ set _initialized 1
+ reset
+ }
+
+ if {[llength $args] == 0} {
+ set children {}
+
+ foreach pane $_panes {
+ lappend children [$itk_component($pane) childSite]
+ }
+
+ return $children
+
+ } else {
+ set index [index [lindex $args 0]]
+ return [$itk_component([lindex $_panes $index]) childSite]
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: fraction percentage percentage ?percentage ...?
+#
+# Sets the visible percentage of the panes. Specifies a list of
+# percentages which are applied to the currently visible panes from
+# the near side (left/top). The number of percentages must be equal
+# to the current number of visible (mapped) panes and add up to 100.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::fraction {percentage1 percentage2 args} {
+ set args [linsert $args 0 $percentage1 $percentage2]
+
+ if {[llength $args] == [llength $_activePanes]} {
+ set sum 0
+
+ for {set i 0} {$i < [llength $args]} {incr i} {
+ set sum [expr $sum + [lindex $args $i]]
+ }
+
+ if {$sum == 100} {
+ set perc 0.0
+
+ for {set i 0} {$i < [llength $_activePanes]} {incr i} {
+ set _frac($i) $perc
+ set perc [expr $perc + [expr [lindex $args $i] / 100.0]]
+ }
+
+ set _frac($i) 1.0
+
+ if {[winfo ismapped $itk_component(hull)]} {
+ _placePanes
+ }
+
+ } else {
+ error "bad fraction arguments \"$args\": they should add\
+ up to 100"
+ }
+
+ } else {
+ error "wrong # args: should be \"$itk_component(hull)\
+ fraction percentage percentage ?percentage ...?\",\
+ where the number of percentages is\
+ [llength $_activePanes] and equal 100"
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: add tag ?option value option value ...?
+#
+# Add a new pane to the paned window to the far (right/bottom) side.
+# The method takes additional options which are passed on to the
+# pane constructor. These include -margin, and -minimum. The path
+# of the pane is returned.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::add {tag args} {
+ #
+ # Create panes.
+ #
+ itk_component add $tag {
+ eval iwidgets::Pane $itk_interior.pane[incr _unique] $args
+ } {
+ keep -background -cursor
+ }
+
+ lappend _panes $tag
+ lappend _activePanes $tag
+
+ reset
+
+ return $itk_component($tag)
+}
+
+# ------------------------------------------------------------------
+# METHOD: insert index tag ?option value option value ...?
+#
+# Insert the specified pane in the paned window just before the one
+# given by index. Any additional options which are passed on to the
+# pane constructor. These include -margin, -minimum. The path of
+# the pane is returned.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::insert {index tag args} {
+ #
+ # Create panes.
+ #
+ itk_component add $tag {
+ eval iwidgets::Pane $itk_interior.pane[incr _unique] $args
+ } {
+ keep -background -cursor
+ }
+
+ set index [index $index]
+ set _panes [linsert $_panes $index $tag]
+ lappend _activePanes $tag
+
+ reset
+
+ return $itk_component($tag)
+}
+
+# ------------------------------------------------------------------
+# METHOD: delete index
+#
+# Delete the specified pane.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::delete {index} {
+ set index [index $index]
+ set tag [lindex $_panes $index]
+
+ destroy $itk_component($tag)
+
+ set _panes [lreplace $_panes $index $index]
+
+ reset
+}
+
+# ------------------------------------------------------------------
+# METHOD: hide index
+#
+# Remove the specified pane from the paned window.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::hide {index} {
+ set index [index $index]
+ set tag [lindex $_panes $index]
+
+ if {[set idx [lsearch -exact $_activePanes $tag]] != -1} {
+ set _activePanes [lreplace $_activePanes $idx $idx]
+ }
+
+ reset
+}
+
+# ------------------------------------------------------------------
+# METHOD: show index
+#
+# Display the specified pane in the paned window.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::show {index} {
+ set index [index $index]
+ set tag [lindex $_panes $index]
+
+ if {[lsearch -exact $_activePanes $tag] == -1} {
+ lappend _activePanes $tag
+ }
+
+ reset
+}
+
+# ------------------------------------------------------------------
+# METHOD: paneconfigure index ?option? ?value option value ...?
+#
+# Configure a specified pane. This method allows configuration of
+# panes from the Panedwindow level. The options may have any of the
+# values accepted by the add method.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::paneconfigure {index args} {
+ set index [index $index]
+ set tag [lindex $_panes $index]
+
+ return [uplevel $itk_component($tag) configure $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: reset
+#
+# Redisplay the panes based on the default percentages of the panes.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::reset {} {
+ if {$_initialized && [llength $_panes]} {
+ _setActivePanes
+ _setFracArray
+
+ _makeSashes
+ _placePanes
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _pwConfigureEventHandler
+#
+# Performs operations necessary following a configure event. This
+# includes placing the panes.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::_pwConfigureEventHandler {width height} {
+ set _width $width
+ set _height $height
+ if {$_initialized} {
+ _placePanes
+ } else {
+ set _initialized 1
+ reset
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _startGrip where num
+#
+# Starts the sash drag and drop operation. At the start of the drag
+# operation all the information is known as for the upper and lower
+# limits for sash movement. The calculation is made at this time and
+# stored in protected variables for later access during the drag
+# handling routines.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::_startGrip {where num} {
+ if {$itk_option(-orient) == "horizontal"} {
+ set _dimension $_height
+ } else {
+ set _dimension $_width
+ }
+
+ set _minsashmoved $num
+ set _maxsashmoved $num
+ set totMinHeight 0
+ set cnt [llength $_activePanes]
+ set _sashloc(0) 0
+ set _pixels($cnt) [expr int($_dimension)]
+ for {set i 0} {$i < $cnt} {incr i} {
+ set _pixels($i) [expr int($_frac($i) * $_dimension)]
+ set margaft [$itk_component([lindex $_activePanes $i]) cget -margin]
+ set minaft [$itk_component([lindex $_activePanes $i]) cget -minimum]
+ set _minheight($i) [expr $minaft + (2 * $margaft)]
+ incr totMinHeight $_minheight($i)
+ }
+ set _dragging [expr $_dimension > $totMinHeight]
+
+ grab $itk_component(sash$num)
+ raise $itk_component(separator$num)
+ raise $itk_component(sash$num)
+
+ $itk_component(sash$num) configure -relief sunken
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _endGrip where num
+#
+# Ends the sash drag and drop operation.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::_endGrip {where num} {
+ $itk_component(sash$num) configure -relief raised
+ grab release $itk_component(sash$num)
+ if {$_dragging} {
+ _calcFraction [expr $_sashloc($num) + $where] $num
+ _placePanes [expr $_minsashmoved - 1] $_maxsashmoved
+ set _dragging 0
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _configGrip where num
+#
+# Configure action for sash.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::_configGrip {where num} {
+ set _sashloc($num) $where
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _handleGrip where num
+#
+# Motion action for sash.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::_handleGrip {where num} {
+ if {$_dragging} {
+ _moveSash [expr $where + $_sashloc($num)] $num
+ incr _movecount
+ if {$_movecount>4} {
+ set _movecount 0
+ update idletasks
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _moveSash where num
+#
+# Move the sash to the absolute pixel location
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::_moveSash {where num} {
+ set _minsashmoved [expr ($_minsashmoved<$num)?$_minsashmoved:$num]
+ set _maxsashmoved [expr ($_maxsashmoved>$num)?$_maxsashmoved:$num]
+ set oldfrac $_frac($num)
+ _calcFraction $where $num
+ if {$_frac($num)!=$oldfrac} { _placeSash $num }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _setFracArray
+#
+# Calculates the percentages for the fraction array which lists the
+# percentages for each pane.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::_setFracArray {} {
+ set perc 0.0
+ if {[llength $_activePanes] != 0} {
+ set percIncr [expr 1.0 / [llength $_activePanes]]
+ }
+
+ for {set i 0} {$i < [llength $_activePanes]} {incr i} {
+ set _frac($i) $perc
+ set perc [expr $perc + $percIncr]
+ }
+
+ set _frac($i) 1.0
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _setActivePanes
+#
+# Resets the active pane list.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::_setActivePanes {} {
+ set _prevActivePanes $_activePanes
+
+ set _activePanes {}
+
+ foreach pane $_panes {
+ if {[lsearch -exact $_prevActivePanes $pane] != -1} {
+ lappend _activePanes $pane
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _calcFraction where num
+#
+# Determines the fraction for the sash. Make sure the fraction does
+# not go past the minimum for the pane on each side of the separator.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::_calcFraction {where num} {
+
+ set _lowerlimit \
+ [expr $_pixels([expr $num - 1]) + $_minheight([expr $num - 1])]
+ set _upperlimit \
+ [expr $_pixels([expr $num + 1]) - $_minheight($num)]
+
+ set dir [expr $where - $_pixels($num)]
+
+ if {$where < $_lowerlimit && $dir <= 0} {
+ if {$num == 1} {
+ set _pixels($num) $_lowerlimit
+ } {
+ _moveSash [expr $where - $_minheight([expr $num - 1])] [expr $num -1]
+ set _pixels($num) \
+ [expr $_pixels([expr $num - 1]) + $_minheight([expr $num - 1])]
+ }
+ } elseif {$where > $_upperlimit && $dir >= 0} {
+ if {[expr $num + 1] == [llength $_activePanes]} {
+ set _pixels($num) $_upperlimit
+ } {
+ _moveSash [expr $where + $_minheight($num)] [expr $num +1]
+ set _pixels($num) \
+ [expr $_pixels([expr $num + 1]) - $_minheight($num)]
+ }
+ } else {
+ set _pixels($num) $where
+ }
+ set _frac($num) [expr $_pixels($num).0 / $_dimension]
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _makeSashes
+#
+# Removes any previous sashes and separators and creates new one.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::_makeSashes {} {
+ #
+ # Remove any existing sashes and separators.
+ #
+ foreach sash $_sashes {
+ destroy $itk_component($sash)
+ }
+
+ foreach separator $_separators {
+ destroy $itk_component($separator)
+ }
+
+ set _sashes {}
+ set _separators {}
+
+ #
+ # Create one less separator and sash than the number of panes.
+ #
+ for {set id 1} {$id < [llength $_activePanes]} {incr id} {
+ itk_component add sash$id {
+ frame $itk_interior.sash$id -relief raised \
+ -borderwidth $itk_option(-sashborderwidth) \
+ -cursor $itk_option(-sashcursor) \
+ -width $itk_option(-sashwidth) \
+ -height $itk_option(-sashheight)
+ } {
+ keep -background
+ }
+
+ lappend _sashes sash$id
+
+ switch $itk_option(-orient) {
+ vertical {
+ bind $itk_component(sash$id) <Button-1> \
+ [code $this _startGrip %x $id]
+ bind $itk_component(sash$id) <B1-Motion> \
+ [code $this _handleGrip %x $id]
+ bind $itk_component(sash$id) <B1-ButtonRelease-1> \
+ [code $this _endGrip %x $id]
+ bind $itk_component(sash$id) <Configure> \
+ [code $this _configGrip %x $id]
+ }
+
+ horizontal {
+ bind $itk_component(sash$id) <Button-1> \
+ [code $this _startGrip %y $id]
+ bind $itk_component(sash$id) <B1-Motion> \
+ [code $this _handleGrip %y $id]
+ bind $itk_component(sash$id) <B1-ButtonRelease-1> \
+ [code $this _endGrip %y $id]
+ bind $itk_component(sash$id) <Configure> \
+ [code $this _configGrip %y $id]
+ }
+ }
+
+ itk_component add separator$id {
+ frame $itk_interior.separator$id -relief sunken \
+ -height $itk_option(-thickness) \
+ -width $itk_option(-thickness) \
+ -borderwidth [expr $itk_option(-thickness) / 2]
+ } {
+ keep -background -cursor
+ }
+
+ lappend _separators separator$id
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _placeSash i
+#
+# Places the position of the sash and separator.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::_placeSash {i} {
+ if {$itk_option(-orient) == "horizontal"} {
+ place $itk_component(separator$i) -in $itk_component(hull) \
+ -x 0 -relwidth 1 -rely $_frac($i) -anchor w \
+ -height $itk_option(-thickness)
+
+ if {$itk_option(-sashindent) < 0} {
+ set sashPos [expr $_width + $itk_option(-sashindent)]
+ set sashAnchor e
+ } else {
+ set sashPos $itk_option(-sashindent)
+ set sashAnchor w
+ }
+
+ place $itk_component(sash$i) -in $itk_component(hull) \
+ -x $sashPos -rely $_frac($i) -anchor $sashAnchor
+
+ } else {
+ place $itk_component(separator$i) -in $itk_component(hull) \
+ -y 0 -relheight 1 -relx $_frac($i) -anchor n \
+ -width $itk_option(-thickness)
+
+ if {$itk_option(-sashindent) < 0} {
+ set sashPos [expr $_height + $itk_option(-sashindent)]
+ set sashAnchor s
+ } else {
+ set sashPos $itk_option(-sashindent)
+ set sashAnchor n
+ }
+
+ place $itk_component(sash$i) -in $itk_component(hull) \
+ -y $sashPos -relx $_frac($i) -anchor $sashAnchor
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _placePanes
+#
+# Resets the panes of the window following movement of the sash.
+# ------------------------------------------------------------------
+body iwidgets::Panedwindow::_placePanes {{start 0} {end end}} {
+ if {$end=="end"} { set end [expr [llength $_activePanes] - 1] }
+ set _updatePanes [lrange $_activePanes $start $end]
+ if {$_updatePanes == $_activePanes} {
+ set _forgetPanes $_panes
+ } {
+ set _forgetPanes $_updatePanes
+ }
+ foreach pane $_forgetPanes {
+ place forget $itk_component($pane)
+ }
+
+
+ if {$itk_option(-orient) == "horizontal"} {
+ set i $start
+ foreach pane $_updatePanes {
+ place $itk_component($pane) -in $itk_component(hull) \
+ -x 0 -rely $_frac($i) -relwidth 1 \
+ -relheight [expr $_frac([expr $i + 1]) - $_frac($i)]
+ incr i
+ }
+
+ } else {
+ set i $start
+ foreach pane $_updatePanes {
+ place $itk_component($pane) -in $itk_component(hull) \
+ -y 0 -relx $_frac($i) -relheight 1 \
+ -relwidth [expr $_frac([expr $i + 1]) - $_frac($i)]
+ incr i
+ }
+
+ }
+
+ for {set i [expr $start+1]} {$i <= $end} {incr i} {
+ if {[array names itk_component separator$i] != ""} {
+ _placeSash $i
+ raise $itk_component(separator$i)
+ raise $itk_component(sash$i)
+ }
+ }
+}
diff --git a/itcl/iwidgets3.0.0/generic/promptdialog.itk b/itcl/iwidgets3.0.0/generic/promptdialog.itk
new file mode 100644
index 00000000000..0348fb958e6
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/promptdialog.itk
@@ -0,0 +1,199 @@
+#
+# Promptdialog
+# ----------------------------------------------------------------------
+# Implements a prompt dialog similar to the OSF/Motif standard prompt
+# dialog composite widget. The Promptdialog is derived from the
+# Dialog class and is composed of a EntryField with methods to
+# manipulate the dialog buttons.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Promptdialog {
+ keep -background -borderwidth -cursor -foreground -highlightcolor \
+ -highlightthickness -insertbackground -insertborderwidth \
+ -insertofftime -insertontime -insertwidth -labelfont -modality \
+ -selectbackground -selectborderwidth -selectforeground \
+ -textbackground -textfont
+}
+
+# ------------------------------------------------------------------
+# PROMPTDIALOG
+# ------------------------------------------------------------------
+class iwidgets::Promptdialog {
+ inherit iwidgets::Dialog
+
+ constructor {args} {}
+
+ public method get {}
+ public method clear {}
+ public method insert {args}
+ public method delete {args}
+ public method icursor {args}
+ public method index {args}
+ public method scan {args}
+ public method selection {args}
+ method xview {args}
+}
+
+#
+# Provide a lowercased access method for the Dialogshell class.
+#
+proc ::iwidgets::promptdialog {pathName args} {
+ uplevel ::iwidgets::Promptdialog $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Promptdialog.labelText Selection widgetDefault
+option add *Promptdialog.labelPos nw widgetDefault
+option add *Promptdialog.title "Prompt Dialog" widgetDefault
+option add *Promptdialog.master "." widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Promptdialog::constructor {args} {
+ #
+ # Set the borderwidth to zero.
+ #
+ component hull configure -borderwidth 0
+
+ #
+ # Create an entry field widget.
+ #
+ itk_component add prompt {
+ iwidgets::Entryfield $itk_interior.prompt -command [code $this invoke]
+ } {
+ usual
+
+ keep -exportselection -invalid -labelpos -labeltext -relief \
+ -show -textbackground -textfont -validate
+ }
+
+ pack $itk_component(prompt) -fill x -expand yes
+ set itk_interior [childsite]
+
+ hide Help
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: get
+#
+# Thinwrapped method of entry field class.
+# ------------------------------------------------------------------
+body iwidgets::Promptdialog::get {} {
+ return [$itk_component(prompt) get]
+}
+
+# ------------------------------------------------------------------
+# METHOD: clear
+#
+# Thinwrapped method of entry field class.
+# ------------------------------------------------------------------
+body iwidgets::Promptdialog::clear {} {
+ eval $itk_component(prompt) clear
+}
+
+# ------------------------------------------------------------------
+# METHOD: insert args
+#
+# Thinwrapped method of entry field class.
+# ------------------------------------------------------------------
+body iwidgets::Promptdialog::insert {args} {
+ eval $itk_component(prompt) insert $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: delete first ?last?
+#
+# Thinwrapped method of entry field class.
+# ------------------------------------------------------------------
+body iwidgets::Promptdialog::delete {args} {
+ eval $itk_component(prompt) delete $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: icursor
+#
+# Thinwrapped method of entry field class.
+# ------------------------------------------------------------------
+body iwidgets::Promptdialog::icursor {args} {
+ eval $itk_component(prompt) icursor $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: index
+#
+# Thinwrapped method of entry field class.
+# ------------------------------------------------------------------
+body iwidgets::Promptdialog::index {args} {
+ return [eval $itk_component(prompt) index $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: scan option args
+#
+# Thinwrapped method of entry field class.
+# ------------------------------------------------------------------
+body iwidgets::Promptdialog::scan {args} {
+ eval $itk_component(prompt) scan $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: selection args
+#
+# Thinwrapped method of entry field class.
+# ------------------------------------------------------------------
+body iwidgets::Promptdialog::selection {args} {
+ eval $itk_component(prompt) selection $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: xview args
+#
+# Thinwrapped method of entry field class.
+# ------------------------------------------------------------------
+body iwidgets::Promptdialog::xview {args} {
+ eval $itk_component(prompt) xview $args
+}
+
+
diff --git a/itcl/iwidgets3.0.0/generic/pushbutton.itk b/itcl/iwidgets3.0.0/generic/pushbutton.itk
new file mode 100644
index 00000000000..5961458a89b
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/pushbutton.itk
@@ -0,0 +1,356 @@
+#
+# Pushbutton
+# ----------------------------------------------------------------------
+# Implements a Motif-like Pushbutton with an optional default ring.
+#
+# WISH LIST:
+# 1) Allow bitmaps and text on the same button face (Tk limitation).
+# 2) provide arm and disarm bitmaps.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
+# Bret A. Schuhmacher EMAIL: bas@wn.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Pushbutton {
+ keep -activebackground -activeforeground -background -borderwidth \
+ -cursor -disabledforeground -font -foreground -highlightbackground \
+ -highlightcolor -highlightthickness
+}
+
+# ------------------------------------------------------------------
+# PUSHBUTTON
+# ------------------------------------------------------------------
+class iwidgets::Pushbutton {
+ inherit itk::Widget
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -padx padX Pad 11
+ itk_option define -pady padY Pad 4
+ itk_option define -font font Font \
+ -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*
+ itk_option define -text text Text {}
+ itk_option define -bitmap bitmap Bitmap {}
+ itk_option define -image image Image {}
+ itk_option define -highlightthickness highlightThickness \
+ HighlightThickness 2
+ itk_option define -borderwidth borderWidth BorderWidth 2
+ itk_option define -defaultring defaultRing DefaultRing 0
+ itk_option define -defaultringpad defaultRingPad Pad 4
+ itk_option define -height height Height 0
+ itk_option define -width width Width 0
+ itk_option define -takefocus takeFocus TakeFocus 0
+
+ public method flash {}
+ public method invoke {}
+
+ protected method _relayout {{when later}}
+ protected variable _reposition "" ;# non-null => _relayout pending
+}
+
+#
+# Provide a lowercased access method for the Pushbutton class.
+#
+proc ::iwidgets::pushbutton {pathName args} {
+ uplevel ::iwidgets::Pushbutton $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Pushbutton.borderWidth 2 widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Pushbutton::constructor {args} {
+ #
+ # Reconfigure the hull to act as the outer sunken ring of
+ # the pushbutton, complete with focus ring.
+ #
+ itk_option add hull.borderwidth hull.relief
+ itk_option add hull.highlightcolor
+ itk_option add hull.highlightbackground
+
+ component hull configure \
+ -borderwidth [$this cget -borderwidth]
+
+ pack propagate $itk_component(hull) no
+
+ itk_component add pushbutton {
+ button $itk_component(hull).pushbutton \
+ } {
+ usual
+ keep -underline -wraplength -state -command
+ }
+ pack $itk_component(pushbutton) -expand 1 -fill both
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+
+ #
+ # Layout the pushbutton.
+ #
+ _relayout
+}
+
+# ------------------------------------------------------------------
+# DESTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Pushbutton::destructor {} {
+ if {$_reposition != ""} {after cancel $_reposition}
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -padx
+#
+# Specifies the extra space surrounding the label in the x direction.
+# ------------------------------------------------------------------
+configbody iwidgets::Pushbutton::padx {
+ $itk_component(pushbutton) configure -padx $itk_option(-padx)
+
+ _relayout
+}
+
+# ------------------------------------------------------------------
+# OPTION: -pady
+#
+# Specifies the extra space surrounding the label in the y direction.
+# ------------------------------------------------------------------
+configbody iwidgets::Pushbutton::pady {
+ $itk_component(pushbutton) configure -pady $itk_option(-pady)
+
+ _relayout
+}
+
+# ------------------------------------------------------------------
+# OPTION: -font
+#
+# Specifies the label font.
+# ------------------------------------------------------------------
+configbody iwidgets::Pushbutton::font {
+ $itk_component(pushbutton) configure -font $itk_option(-font)
+
+ _relayout
+}
+
+# ------------------------------------------------------------------
+# OPTION: -text
+#
+# Specifies the label text.
+# ------------------------------------------------------------------
+configbody iwidgets::Pushbutton::text {
+ $itk_component(pushbutton) configure -text $itk_option(-text)
+
+ _relayout
+}
+
+# ------------------------------------------------------------------
+# OPTION: -bitmap
+#
+# Specifies the label bitmap.
+# ------------------------------------------------------------------
+configbody iwidgets::Pushbutton::bitmap {
+ $itk_component(pushbutton) configure -bitmap $itk_option(-bitmap)
+
+ _relayout
+}
+
+# ------------------------------------------------------------------
+# OPTION: -image
+#
+# Specifies the label image.
+# ------------------------------------------------------------------
+configbody iwidgets::Pushbutton::image {
+ $itk_component(pushbutton) configure -image $itk_option(-image)
+
+ _relayout
+}
+
+# ------------------------------------------------------------------
+# OPTION: -highlightthickness
+#
+# Specifies the thickness of the highlight ring.
+# ------------------------------------------------------------------
+configbody iwidgets::Pushbutton::highlightthickness {
+ $itk_component(pushbutton) configure \
+ -highlightthickness $itk_option(-highlightthickness)
+
+ _relayout
+}
+
+# ------------------------------------------------------------------
+# OPTION: -borderwidth
+#
+# Specifies the width of the relief border.
+# ------------------------------------------------------------------
+configbody iwidgets::Pushbutton::borderwidth {
+ $itk_component(pushbutton) configure -borderwidth $itk_option(-borderwidth)
+
+ _relayout
+}
+
+# ------------------------------------------------------------------
+# OPTION: -defaultring
+#
+# Boolean describing whether the button displays its default ring.
+# ------------------------------------------------------------------
+configbody iwidgets::Pushbutton::defaultring {
+ _relayout
+}
+
+# ------------------------------------------------------------------
+# OPTION: -defaultringpad
+#
+# The size of the padded default ring around the button.
+# ------------------------------------------------------------------
+configbody iwidgets::Pushbutton::defaultringpad {
+ pack $itk_component(pushbutton) \
+ -padx $itk_option(-defaultringpad) \
+ -pady $itk_option(-defaultringpad)
+}
+
+# ------------------------------------------------------------------
+# OPTION: -height
+#
+# Specifies the height of the button inclusive of any default ring.
+# A value of zero lets the push button determine the height based
+# on the requested height plus highlightring and defaultringpad.
+# ------------------------------------------------------------------
+configbody iwidgets::Pushbutton::height {
+ _relayout
+}
+
+# ------------------------------------------------------------------
+# OPTION: -width
+#
+# Specifies the width of the button inclusive of any default ring.
+# A value of zero lets the push button determine the width based
+# on the requested width plus highlightring and defaultringpad.
+# ------------------------------------------------------------------
+configbody iwidgets::Pushbutton::width {
+ _relayout
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: flash
+#
+# Thin wrap of standard button widget flash method.
+# ------------------------------------------------------------------
+body iwidgets::Pushbutton::flash {} {
+ $itk_component(pushbutton) flash
+}
+
+# ------------------------------------------------------------------
+# METHOD: invoke
+#
+# Thin wrap of standard button widget invoke method.
+# ------------------------------------------------------------------
+body iwidgets::Pushbutton::invoke {} {
+ $itk_component(pushbutton) invoke
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _relayout ?when?
+#
+# Adjust the width and height of the Pushbutton to accomadate all the
+# current options settings. Add back in the highlightthickness to
+# the button such that the correct reqwidth and reqheight are computed.
+# Set the width and height based on the reqwidth/reqheight,
+# highlightthickness, and ringpad. Finally, configure the defaultring
+# properly. If "when" is "now", the change is applied immediately. If
+# it is "later" or it is not specified, then the change is applied later,
+# when the application is idle.
+# ------------------------------------------------------------------
+body iwidgets::Pushbutton::_relayout {{when later}} {
+ if {$when == "later"} {
+ if {$_reposition == ""} {
+ set _reposition [after idle [code $this _relayout now]]
+ }
+ return
+ } elseif {$when != "now"} {
+ error "bad option \"$when\": should be now or later"
+ }
+
+ set _reposition ""
+
+ if {$itk_option(-width) == 0} {
+ set w [expr [winfo reqwidth $itk_component(pushbutton)] \
+ + 2 * $itk_option(-highlightthickness) \
+ + 2 * $itk_option(-borderwidth) \
+ + 2 * $itk_option(-defaultringpad)]
+ } else {
+ set w $itk_option(-width)
+ }
+
+ if {$itk_option(-height) == 0} {
+ set h [expr [winfo reqheight $itk_component(pushbutton)] \
+ + 2 * $itk_option(-highlightthickness) \
+ + 2 * $itk_option(-borderwidth) \
+ + 2 * $itk_option(-defaultringpad)]
+ } else {
+ set h $itk_option(-height)
+ }
+
+ component hull configure -width $w -height $h
+
+ if {$itk_option(-defaultring)} {
+ component hull configure -relief sunken \
+ -highlightthickness [$this cget -highlightthickness] \
+ -takefocus 1
+
+ configure -takefocus 1
+
+ component pushbutton configure \
+ -highlightthickness 0 -takefocus 0
+
+ } else {
+ component hull configure -relief flat \
+ -highlightthickness 0 -takefocus 0
+
+ component pushbutton configure \
+ -highlightthickness [$this cget -highlightthickness] \
+ -takefocus 1
+
+ configure -takefocus 0
+ }
+}
diff --git a/itcl/iwidgets3.0.0/generic/radiobox.itk b/itcl/iwidgets3.0.0/generic/radiobox.itk
new file mode 100644
index 00000000000..797dc5960f3
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/radiobox.itk
@@ -0,0 +1,328 @@
+#
+# Radiobox
+# ----------------------------------------------------------------------
+# Implements a radiobuttonbox. Supports adding, inserting, deleting,
+# selecting, and deselecting of radiobuttons by tag and index.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Michael J. McLennan EMAIL: mmclennan@lucent.com
+# Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Radiobox {
+ keep -background -borderwidth -cursor -disabledforeground \
+ -foreground -labelfont -selectcolor
+}
+
+# ------------------------------------------------------------------
+# RADIOBOX
+# ------------------------------------------------------------------
+class iwidgets::Radiobox {
+ inherit iwidgets::Labeledframe
+
+ constructor {args} {}
+
+ itk_option define -disabledforeground \
+ disabledForeground DisabledForeground {}
+ itk_option define -selectcolor selectColor Background {}
+ itk_option define -command command Command {}
+
+ public {
+ method add {tag args}
+ method buttonconfigure {index args}
+ method delete {index}
+ method deselect {index}
+ method flash {index}
+ method get {}
+ method index {index}
+ method insert {index tag args}
+ method select {index}
+ }
+
+ protected method _command { name1 name2 opt }
+
+ private {
+ method gettag {index} ;# Get the tag of the checkbutton associated
+ ;# with a numeric index
+
+ method _rearrange {} ;# List of radiobutton tags.
+ variable _buttons {} ;# List of radiobutton tags.
+ common _modes ;# Current selection.
+ variable _unique 0 ;# Unique id for choice creation.
+ }
+}
+
+#
+# Provide a lowercased access method for the Radiobox class.
+#
+proc ::iwidgets::radiobox {pathName args} {
+ uplevel ::iwidgets::Radiobox $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Radiobox.labelMargin 10 widgetDefault
+option add *Radiobox.labelFont \
+ "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" widgetDefault
+option add *Radiobox.labelPos nw widgetDefault
+option add *Radiobox.borderWidth 2 widgetDefault
+option add *Radiobox.relief groove widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Radiobox::constructor {args} {
+ trace variable [scope _modes($this)] w [code $this _command]
+
+ grid columnconfigure $itk_component(childsite) 0 -weight 1
+
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -command
+#
+# Specifies a command to be evaluated upon change in the radiobox
+# ------------------------------------------------------------------
+configbody iwidgets::Radiobox::command {}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: index index
+#
+# Searches the radiobutton tags in the radiobox for the one with the
+# requested tag, numerical index, or keyword "end". Returns the
+# choices's numerical index if found, otherwise error.
+# ------------------------------------------------------------------
+body iwidgets::Radiobox::index {index} {
+ if {[llength $_buttons] > 0} {
+ if {[regexp {(^[0-9]+$)} $index]} {
+ if {$index < [llength $_buttons]} {
+ return $index
+ } else {
+ error "Radiobox index \"$index\" is out of range"
+ }
+
+ } elseif {$index == "end"} {
+ return [expr [llength $_buttons] - 1]
+
+ } else {
+ if {[set idx [lsearch $_buttons $index]] != -1} {
+ return $idx
+ }
+
+ error "bad Radiobox index \"$index\": must be number, end,\
+ or pattern"
+ }
+
+ } else {
+ error "Radiobox \"$itk_component(hull)\" has no radiobuttons"
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: add tag ?option value option value ...?
+#
+# Add a new tagged radiobutton to the radiobox at the end. The method
+# takes additional options which are passed on to the radiobutton
+# constructor. These include most of the typical radiobutton
+# options. The tag is returned.
+# ------------------------------------------------------------------
+body iwidgets::Radiobox::add {tag args} {
+ itk_component add $tag {
+ eval radiobutton $itk_component(childsite).rb[incr _unique] \
+ -variable [list [scope _modes($this)]] \
+ -anchor w \
+ -justify left \
+ -highlightthickness 0 \
+ -value $tag $args
+ } {
+ usual
+ ignore -highlightthickness -highlightcolor
+ rename -font -labelfont labelFont Font
+ }
+ lappend _buttons $tag
+ grid $itk_component($tag)
+ after idle [code $this _rearrange]
+
+ return $tag
+}
+
+# ------------------------------------------------------------------
+# METHOD: insert index tag ?option value option value ...?
+#
+# Insert the tagged radiobutton in the radiobox just before the
+# one given by index. Any additional options are passed on to the
+# radiobutton constructor. These include the typical radiobutton
+# options. The tag is returned.
+# ------------------------------------------------------------------
+body iwidgets::Radiobox::insert {index tag args} {
+ itk_component add $tag {
+ eval radiobutton $itk_component(childsite).rb[incr _unique] \
+ -variable [list [scope _modes($this)]] \
+ -highlightthickness 0 \
+ -anchor w \
+ -justify left \
+ -value $tag $args
+ } {
+ usual
+ ignore -highlightthickness -highlightcolor
+ rename -font -labelfont labelFont Font
+ }
+ set index [index $index]
+ set before [lindex $_buttons $index]
+ set _buttons [linsert $_buttons $index $tag]
+ grid $itk_component($tag)
+ after idle [code $this _rearrange]
+
+ return $tag
+}
+
+# ------------------------------------------------------------------
+# METHOD: _rearrange
+#
+# Rearrange the buttons in the childsite frame using
+# the grid geometry manager.
+# ------------------------------------------------------------------
+body iwidgets::Radiobox::_rearrange {} {
+ set index 0
+ set master $itk_component(childsite)
+
+ if {[set count [llength $_buttons]] > 0} {
+ foreach tag $_buttons {
+ grid configure $itk_component($tag) -row $index -sticky nw
+ grid rowconfigure $master $index -weight 0
+ incr index
+ }
+ grid rowconfigure $master [expr $count-1] -weight 1
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: delete index
+#
+# Delete the specified radiobutton.
+# ------------------------------------------------------------------
+body iwidgets::Radiobox::delete {index} {
+
+ set tag [gettag $index]
+ set index [index $index]
+
+ destroy $itk_component($tag)
+
+ set _buttons [lreplace $_buttons $index $index]
+
+ if {$_modes($this) == $tag} {
+ set _modes($this) {}
+ }
+ after idle [code $this _rearrange]
+ return
+}
+
+# ------------------------------------------------------------------
+# METHOD: select index
+#
+# Select the specified radiobutton.
+# ------------------------------------------------------------------
+body iwidgets::Radiobox::select {index} {
+ set tag [gettag $index]
+ $itk_component($tag) invoke
+}
+
+# ------------------------------------------------------------------
+# METHOD: get
+#
+# Return the tag of the currently selected radiobutton.
+# ------------------------------------------------------------------
+body iwidgets::Radiobox::get {} {
+ return $_modes($this)
+}
+
+# ------------------------------------------------------------------
+# METHOD: deselect index
+#
+# Deselect the specified radiobutton.
+# ------------------------------------------------------------------
+body iwidgets::Radiobox::deselect {index} {
+ set tag [gettag $index]
+ $itk_component($tag) deselect
+}
+
+# ------------------------------------------------------------------
+# METHOD: flash index
+#
+# Flash the specified radiobutton.
+# ------------------------------------------------------------------
+body iwidgets::Radiobox::flash {index} {
+ set tag [gettag $index]
+ $itk_component($tag) flash
+}
+
+# ------------------------------------------------------------------
+# METHOD: buttonconfigure index ?option? ?value option value ...?
+#
+# Configure a specified radiobutton. This method allows configuration
+# of radiobuttons from the Radiobox level. The options may have any
+# of the values accepted by the add method.
+# ------------------------------------------------------------------
+body iwidgets::Radiobox::buttonconfigure {index args} {
+ set tag [gettag $index]
+ eval $itk_component($tag) configure $args
+}
+
+# ------------------------------------------------------------------
+# CALLBACK METHOD: _command name1 name2 opt
+#
+# Tied to the trace on _modes($this). Whenever our -variable for our
+# radiobuttons change, this method is invoked. It in turn calls
+# the user specified tcl script given by -command.
+# ------------------------------------------------------------------
+body iwidgets::Radiobox::_command { name1 name2 opt } {
+ uplevel #0 $itk_option(-command)
+}
+
+# ------------------------------------------------------------------
+# METHOD: gettag index
+#
+# Return the tag of the checkbutton associated with a specified
+# numeric index
+# ------------------------------------------------------------------
+body iwidgets::Radiobox::gettag {index} {
+ return [lindex $_buttons [index $index]]
+}
+
diff --git a/itcl/iwidgets3.0.0/generic/regexpfield.itk b/itcl/iwidgets3.0.0/generic/regexpfield.itk
new file mode 100755
index 00000000000..d7e2e7c50b7
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/regexpfield.itk
@@ -0,0 +1,455 @@
+#
+# Regexpfield
+# ----------------------------------------------------------------------
+# Implements a text entry widget which accepts input that matches its
+# regular expression, and invalidates input which doesn't.
+#
+#
+# ----------------------------------------------------------------------
+# AUTHOR: John A. Tucker E-mail: jatucker@austin.dsccc.com
+#
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Regexpfield {
+ keep -background -borderwidth -cursor -foreground -highlightcolor \
+ -highlightthickness -insertbackground -insertborderwidth \
+ -insertofftime -insertontime -insertwidth -labelfont \
+ -selectbackground -selectborderwidth -selectforeground \
+ -textbackground -textfont
+}
+
+# ------------------------------------------------------------------
+# ENTRYFIELD
+# ------------------------------------------------------------------
+class iwidgets::Regexpfield {
+ inherit iwidgets::Labeledwidget
+
+ constructor {args} {}
+
+ itk_option define -childsitepos childSitePos Position e
+ itk_option define -command command Command {}
+ itk_option define -fixed fixed Fixed 0
+ itk_option define -focuscommand focusCommand Command {}
+ itk_option define -invalid invalid Command bell
+ itk_option define -regexp regexp Regexp {.*}
+ itk_option define -nocase nocase Nocase 0
+
+ public {
+ method childsite {}
+ method get {}
+ method delete {args}
+ method icursor {args}
+ method index {args}
+ method insert {args}
+ method scan {args}
+ method selection {args}
+ method xview {args}
+ method clear {}
+ }
+
+ protected {
+ method _focusCommand {}
+ method _keyPress {char sym state}
+ }
+
+ private {
+ method _peek {char}
+ }
+}
+
+#
+# Provide a lowercased access method for the Regexpfield class.
+#
+proc ::iwidgets::regexpfield {pathName args} {
+ uplevel ::iwidgets::Regexpfield $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Regexpfield::constructor {args} {
+ component hull configure -borderwidth 0
+
+ itk_component add entry {
+ entry $itk_interior.entry
+ } {
+ keep -borderwidth -cursor -exportselection \
+ -foreground -highlightcolor \
+ -highlightthickness -insertbackground -insertborderwidth \
+ -insertofftime -insertontime -insertwidth -justify \
+ -relief -selectbackground -selectborderwidth \
+ -selectforeground -show -state -textvariable -width
+
+ rename -font -textfont textFont Font
+ rename -highlightbackground -background background Background
+ rename -background -textbackground textBackground Background
+ }
+
+ #
+ # Create the child site widget.
+ #
+ itk_component add -protected efchildsite {
+ frame $itk_interior.efchildsite
+ }
+ set itk_interior $itk_component(efchildsite)
+
+ #
+ # Regexpfield instance bindings.
+ #
+ bind $itk_component(entry) <KeyPress> [code $this _keyPress %A %K %s]
+ bind $itk_component(entry) <FocusIn> [code $this _focusCommand]
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -command
+#
+# Command associated upon detection of Return key press event
+# ------------------------------------------------------------------
+configbody iwidgets::Regexpfield::command {}
+
+# ------------------------------------------------------------------
+# OPTION: -focuscommand
+#
+# Command associated upon detection of focus.
+# ------------------------------------------------------------------
+configbody iwidgets::Regexpfield::focuscommand {}
+
+# ------------------------------------------------------------------
+# OPTION: -regexp
+#
+# Specify a regular expression to use in performing validation
+# of the content of the entry widget.
+# ------------------------------------------------------------------
+configbody iwidgets::Regexpfield::regexp {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -invalid
+#
+# Specify a command to executed should the current Regexpfield contents
+# be proven invalid.
+# ------------------------------------------------------------------
+configbody iwidgets::Regexpfield::invalid {}
+
+# ------------------------------------------------------------------
+# OPTION: -fixed
+#
+# Restrict entry to 0 (unlimited) chars. The value is the maximum
+# number of chars the user may type into the field, regardles of
+# field width, i.e. the field width may be 20, but the user will
+# only be able to type -fixed number of characters into it (or
+# unlimited if -fixed = 0).
+# ------------------------------------------------------------------
+configbody iwidgets::Regexpfield::fixed {
+ if {[regexp {[^0-9]} $itk_option(-fixed)] || \
+ ($itk_option(-fixed) < 0)} {
+ error "bad fixed option \"$itk_option(-fixed)\",\
+ should be positive integer"
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -childsitepos
+#
+# Specifies the position of the child site in the widget.
+# ------------------------------------------------------------------
+configbody iwidgets::Regexpfield::childsitepos {
+ set parent [winfo parent $itk_component(entry)]
+
+ switch $itk_option(-childsitepos) {
+ n {
+ grid $itk_component(efchildsite) -row 0 -column 0 -sticky ew
+ grid $itk_component(entry) -row 1 -column 0 -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 0
+ grid rowconfigure $parent 1 -weight 1
+ grid columnconfigure $parent 0 -weight 1
+ grid columnconfigure $parent 1 -weight 0
+ }
+
+ e {
+ grid $itk_component(efchildsite) -row 0 -column 1 -sticky ns
+ grid $itk_component(entry) -row 0 -column 0 -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 1
+ grid rowconfigure $parent 1 -weight 0
+ grid columnconfigure $parent 0 -weight 1
+ grid columnconfigure $parent 1 -weight 0
+ }
+
+ s {
+ grid $itk_component(efchildsite) -row 1 -column 0 -sticky ew
+ grid $itk_component(entry) -row 0 -column 0 -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 1
+ grid rowconfigure $parent 1 -weight 0
+ grid columnconfigure $parent 0 -weight 1
+ grid columnconfigure $parent 1 -weight 0
+ }
+
+ w {
+ grid $itk_component(efchildsite) -row 0 -column 0 -sticky ns
+ grid $itk_component(entry) -row 0 -column 1 -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 1
+ grid rowconfigure $parent 1 -weight 0
+ grid columnconfigure $parent 0 -weight 0
+ grid columnconfigure $parent 1 -weight 1
+ }
+
+ default {
+ error "bad childsite option\
+ \"$itk_option(-childsitepos)\":\
+ should be n, e, s, or w"
+ }
+ }
+}
+# ------------------------------------------------------------------
+# OPTION: -nocase
+#
+# Specifies whether or not lowercase characters can match either
+# lowercase or uppercase letters in string.
+# ------------------------------------------------------------------
+configbody iwidgets::Regexpfield::nocase {
+
+ switch $itk_option(-nocase) {
+ 0 - 1 {
+
+ }
+
+ default {
+ error "bad nocase option \"$itk_option(-nocase)\":\
+ should be 0 or 1"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: childsite
+#
+# Returns the path name of the child site widget.
+# ------------------------------------------------------------------
+body iwidgets::Regexpfield::childsite {} {
+ return $itk_component(efchildsite)
+}
+
+# ------------------------------------------------------------------
+# METHOD: get
+#
+# Thin wrap of the standard entry widget get method.
+# ------------------------------------------------------------------
+body iwidgets::Regexpfield::get {} {
+ return [$itk_component(entry) get]
+}
+
+# ------------------------------------------------------------------
+# METHOD: delete
+#
+# Thin wrap of the standard entry widget delete method.
+# ------------------------------------------------------------------
+body iwidgets::Regexpfield::delete {args} {
+ return [eval $itk_component(entry) delete $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: icursor
+#
+# Thin wrap of the standard entry widget icursor method.
+# ------------------------------------------------------------------
+body iwidgets::Regexpfield::icursor {args} {
+ return [eval $itk_component(entry) icursor $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: index
+#
+# Thin wrap of the standard entry widget index method.
+# ------------------------------------------------------------------
+body iwidgets::Regexpfield::index {args} {
+ return [eval $itk_component(entry) index $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: insert
+#
+# Thin wrap of the standard entry widget index method.
+# ------------------------------------------------------------------
+body iwidgets::Regexpfield::insert {args} {
+ return [eval $itk_component(entry) insert $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: scan
+#
+# Thin wrap of the standard entry widget scan method.
+# ------------------------------------------------------------------
+body iwidgets::Regexpfield::scan {args} {
+ return [eval $itk_component(entry) scan $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: selection
+#
+# Thin wrap of the standard entry widget selection method.
+# ------------------------------------------------------------------
+body iwidgets::Regexpfield::selection {args} {
+ return [eval $itk_component(entry) selection $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: xview
+#
+# Thin wrap of the standard entry widget xview method.
+# ------------------------------------------------------------------
+body iwidgets::Regexpfield::xview {args} {
+ return [eval $itk_component(entry) xview $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: clear
+#
+# Delete the current entry contents.
+# ------------------------------------------------------------------
+body iwidgets::Regexpfield::clear {} {
+ $itk_component(entry) delete 0 end
+ icursor 0
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _peek char
+#
+# The peek procedure returns the value of the Regexpfield with the
+# char inserted at the insert position.
+# ------------------------------------------------------------------
+body iwidgets::Regexpfield::_peek {char} {
+ set str [get]
+
+ set insertPos [index insert]
+ set firstPart [string range $str 0 [expr $insertPos - 1]]
+ set lastPart [string range $str $insertPos end]
+
+ append rtnVal $firstPart $char $lastPart
+ return $rtnVal
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _focusCommand
+#
+# Method bound to focus event which evaluates the current command
+# specified in the focuscommand option
+# ------------------------------------------------------------------
+body iwidgets::Regexpfield::_focusCommand {} {
+ uplevel #0 $itk_option(-focuscommand)
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _keyPress
+#
+# Monitor the key press event checking for return keys, fixed width
+# specification, and optional validation procedures.
+# ------------------------------------------------------------------
+body iwidgets::Regexpfield::_keyPress {char sym state} {
+ #
+ # A Return key invokes the optionally specified command option.
+ #
+ if {$sym == "Return"} {
+ uplevel #0 $itk_option(-command)
+ return -code break 1
+ }
+
+ #
+ # Tabs, BackSpace, and Delete are passed on for other bindings.
+ #
+ if {($sym == "Tab") || ($sym == "BackSpace") || ($sym == "Delete")} {
+ return -code continue 1
+ }
+
+ #
+ # Character is not printable or the state is greater than one which
+ # means a modifier was used such as a control, meta key, or control
+ # or meta key with numlock down.
+ #
+ if {($char == "") || \
+ ($state == 4) || ($state == 8) || \
+ ($state == 36) || ($state == 40)} {
+ return -code continue 1
+ }
+
+ #
+ # If the fixed length option is not zero, then verify that the
+ # current length plus one will not exceed the limit. If so then
+ # invoke the invalid command procedure.
+ #
+ if {$itk_option(-fixed) != 0} {
+ if {[string length [get]] >= $itk_option(-fixed)} {
+ uplevel #0 $itk_option(-invalid)
+ return -code break 0
+ }
+ }
+
+ set flags ""
+
+ #
+ # Get the new value of the Regexpfield with the char inserted at the
+ # insert position.
+ #
+ # If the new value doesn't match up with the pattern stored in the
+ # -regexp option, then the invalid procedure is called.
+ #
+ # If the value of the "-nocase" option is true, then add the
+ # "-nocase" flag to the list of flags.
+ #
+ set newVal [_peek $char]
+
+ if {$itk_option(-nocase)} {
+ set valid [::regexp -nocase -- $itk_option(-regexp) $newVal]
+ } else {
+ set valid [::regexp $itk_option(-regexp) $newVal]
+ }
+
+ if {!$valid} {
+ uplevel #0 $itk_option(-invalid)
+ return -code break 0
+ }
+
+ return -code continue 1
+}
+
diff --git a/itcl/iwidgets3.0.0/generic/roman.itcl b/itcl/iwidgets3.0.0/generic/roman.itcl
new file mode 100644
index 00000000000..2fe5164a0f3
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/roman.itcl
@@ -0,0 +1,28 @@
+namespace eval ::iwidgets {
+ set romand(val) {1000 900 500 400 100 90 50 40 10 9 5 4 1}
+ set romand(upper) { M CM D CD C XC L XL X IX V IV I}
+ set romand(lower) { m cm d cd c xc l xl x ix v iv i}
+
+ proc roman2 {n {case upper}} {
+ global romand
+ set r ""
+ foreach val $romand(val) sym $romand($case) {
+ while {$n >= $val} {
+ set r "$r$sym"
+ incr n -$val
+ }
+ }
+ return $r
+ }
+
+ proc roman {n {case upper}} {
+ global romand
+ set r ""
+ foreach val $romand(val) sym $romand($case) {
+ for {} {$n >= $val} {incr n -$val} {
+ set r "$r$sym"
+ }
+ }
+ return $r
+ }
+}
diff --git a/itcl/iwidgets3.0.0/generic/scopedobject.itcl b/itcl/iwidgets3.0.0/generic/scopedobject.itcl
new file mode 100755
index 00000000000..8a274c77777
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/scopedobject.itcl
@@ -0,0 +1,181 @@
+#
+# Scopedobject
+# -----------------------------------------------------------------------------
+# Implements a base class for defining Itcl classes which posses
+# scoped behavior like Tcl variables. The objects are only accessible
+# within the procedure in which they are instantiated and are deleted
+# when the procedure returns.
+#
+# Option(s):
+#
+# -enterscopecommand: Tcl command to invoke when a object enters scope
+# (i.e. when it is created ...).
+#
+# -exitscopecommand: Tcl command to invoke when a object exits scope
+# (i.e. when it is deleted ...).
+#
+# Note(s):
+#
+# Although a Scopedobject instance will automatically destroy itself
+# when it goes out of scope, one may explicity delete an instance
+# before it destroys itself.
+#
+# Example(s):
+#
+# Creating an instance at local scope in a procedure provides
+# an opportunity for tracing the entry and exiting of that
+# procedure. Users can register their proc/method tracing handlers
+# with the Scopedobject class via either of the following two ways:
+#
+# 1.) configure the "-exitscopecommand" on a Scopedobject instance;
+# e.g.
+# #!/usr/local/bin/wish
+#
+# proc tracedProc {} {
+# scopedobject #auto \
+# -exitscopecommand {puts "enter tracedProc"} \
+# -exitscopecommand {puts "exit tracedProc"}
+# }
+#
+# 2.) deriving from the Scopedobject and implementing the exit handling
+# in their derived classes destructor.
+# e.g.
+#
+# #!/usr/local/bin/wish
+#
+# class Proctrace {
+# inherit Scopedobject
+#
+# proc procname {} {
+# return [info level -1]
+# }
+#
+# constructor {args} {
+# puts "enter [procname]"
+# eval configure $args
+# }
+#
+# destructor {
+# puts "exit [procname]"
+# }
+# }
+#
+# proc tracedProc {} {
+# Proctrace #auto
+# }
+#
+# -----------------------------------------------------------------------------
+# AUTHOR: John Tucker
+# DSC Communications Corp
+# -----------------------------------------------------------------------------
+
+class iwidgets::Scopedobject {
+
+ #
+ # OPTIONS:
+ #
+ public {
+ variable enterscopecommand {}
+ variable exitscopecommand {}
+ }
+
+ #
+ # PUBLIC:
+ #
+ constructor {args} {}
+ destructor {}
+
+ #
+ # PRIVATE:
+ #
+ private {
+
+ # Implements the Tcl trace command callback which is responsible
+ # for destroying a Scopedobject instance when its corresponding
+ # Tcl variable goes out of scope.
+ #
+ method _traceCommand {varName varValue op}
+
+ # Stores the stack level of the invoking procedure in which
+ # a Scopedobject instance in created.
+ #
+ variable _level 0
+ }
+}
+
+#
+# Provide a lowercased access method for the Scopedobject class.
+#
+proc ::iwidgets::scopedobject {pathName args} {
+ uplevel ::iwidgets::Scopedobject $pathName $args
+}
+
+#--------------------------------------------------------------------------------
+# CONSTRUCTOR
+#--------------------------------------------------------------------------------
+body iwidgets::Scopedobject::constructor {args} {
+
+ # Create a local variable in the procedure which this instance was created,
+ # and then register out instance deletion command (i.e. _traceCommand)
+ # to be called whenever the local variable is unset.
+ #
+ # If this is a derived class, then we will need to perform the variable creation
+ # and tracing N levels up the stack frame, where:
+ # N = depth of inheritance hierarchy.
+ #
+ set depth [llength [$this info heritage]]
+ set _level "#[uplevel $depth info level]"
+ uplevel $_level set _localVar($this) $this
+ uplevel $_level trace variable _localVar($this) u \"[code $this _traceCommand]\"
+
+ eval configure $args
+
+ if {$enterscopecommand != {}} {
+ eval $enterscopecommand
+ }
+}
+
+#--------------------------------------------------------------------------------
+# DESTRUCTOR
+#--------------------------------------------------------------------------------
+body iwidgets::Scopedobject::destructor {} {
+
+ uplevel $_level trace vdelete _localVar($this) u \"[code $this _traceCommand]\"
+
+ if {$exitscopecommand != {}} {
+ eval $exitscopecommand
+ }
+}
+
+#--------------------------------------------------------------------------------#
+#
+# METHOD: _traceCommand
+#
+# PURPOSE:
+# Callback used to destroy instances when their locally created variable
+# goes out of scope.
+#
+body iwidgets::Scopedobject::_traceCommand {varName varValue op} {
+ delete object $this
+}
+
+#------------------------------------------------------------------------------
+#
+# OPTION: -enterscopecommand
+#
+# PURPOSE:
+# Specifies a Tcl command to invoke when a object enters scope.
+#
+configbody iwidgets::Scopedobject::enterscopecommand {
+}
+
+#------------------------------------------------------------------------------
+#
+# OPTION: -exitscopecommand
+#
+# PURPOSE:
+# Specifies a Tcl command to invoke when an object exits scope.
+#
+configbody iwidgets::Scopedobject::exitscopecommand {
+}
+
diff --git a/itcl/iwidgets3.0.0/generic/scrolledcanvas.itk b/itcl/iwidgets3.0.0/generic/scrolledcanvas.itk
new file mode 100644
index 00000000000..22b237dcfc8
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/scrolledcanvas.itk
@@ -0,0 +1,477 @@
+#
+# Scrolledcanvas
+# ----------------------------------------------------------------------
+# Implements horizontal and vertical scrollbars around a canvas childsite
+# Includes options to control display of scrollbars. The standard
+# canvas options and methods are supported.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark Ulferts mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Scrolledcanvas {
+ keep -activebackground -activerelief -background -borderwidth -cursor \
+ -elementborderwidth -foreground -highlightcolor -highlightthickness \
+ -insertbackground -insertborderwidth -insertofftime -insertontime \
+ -insertwidth -jump -labelfont -selectbackground -selectborderwidth \
+ -selectforeground -textbackground -troughcolor
+}
+
+# ------------------------------------------------------------------
+# SCROLLEDCANVAS
+# ------------------------------------------------------------------
+class iwidgets::Scrolledcanvas {
+ inherit iwidgets::Scrolledwidget
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -autoresize autoResize AutoResize 1
+ itk_option define -automargin autoMargin AutoMargin 0
+
+ public method childsite {}
+ public method justify {direction}
+
+ public method addtag {args}
+ public method bbox {args}
+ public method bind {args}
+ public method canvasx {args}
+ public method canvasy {args}
+ public method coords {args}
+ public method create {args}
+ public method dchars {args}
+ public method delete {args}
+ public method dtag {args}
+ public method find {args}
+ public method focus {args}
+ public method gettags {args}
+ public method icursor {args}
+ public method index {args}
+ public method insert {args}
+ public method itemconfigure {args}
+ public method itemcget {args}
+ public method lower {args}
+ public method move {args}
+ public method postscript {args}
+ public method raise {args}
+ public method scale {args}
+ public method scan {args}
+ public method select {args}
+ public method type {args}
+ public method xview {args}
+ public method yview {args}
+}
+
+#
+# Provide a lowercased access method for the Scrolledcanvas class.
+#
+proc ::iwidgets::scrolledcanvas {pathName args} {
+ uplevel ::iwidgets::Scrolledcanvas $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Scrolledcanvas.width 200 widgetDefault
+option add *Scrolledcanvas.height 230 widgetDefault
+option add *Scrolledcanvas.labelPos n widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::constructor {args} {
+ #
+ # Create a clipping frame which will provide the border for
+ # relief display.
+ #
+ itk_component add clipper {
+ frame $itk_interior.clipper
+ } {
+ usual
+
+ keep -borderwidth -relief -highlightthickness -highlightcolor
+ rename -highlightbackground -background background Background
+ }
+ grid $itk_component(clipper) -row 1 -column 1 -sticky nsew
+ grid rowconfigure $_interior 1 -weight 1
+ grid columnconfigure $_interior 1 -weight 1
+
+ #
+ # Create a canvas to scroll
+ #
+ itk_component add canvas {
+ canvas $itk_component(clipper).canvas \
+ -height 1.0 -width 1.0 \
+ -scrollregion "0 0 1 1" \
+ -xscrollcommand \
+ [code $this _scrollWidget $itk_interior.horizsb] \
+ -yscrollcommand \
+ [code $this _scrollWidget $itk_interior.vertsb]
+ } {
+ usual
+
+ ignore -highlightthickness -highlightcolor
+
+ keep -closeenough -confine -scrollregion
+ keep -xscrollincrement -yscrollincrement
+
+ rename -background -textbackground textBackground Background
+ }
+ grid $itk_component(canvas) -row 0 -column 0 -sticky nsew
+ grid rowconfigure $itk_component(clipper) 0 -weight 1
+ grid columnconfigure $itk_component(clipper) 0 -weight 1
+
+ #
+ # Configure the command on the vertical scroll bar in the base class.
+ #
+ $itk_component(vertsb) configure \
+ -command [code $itk_component(canvas) yview]
+
+ #
+ # Configure the command on the horizontal scroll bar in the base class.
+ #
+ $itk_component(horizsb) configure \
+ -command [code $itk_component(canvas) xview]
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# DESTURCTOR
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::destructor {} {
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -autoresize
+#
+# Automatically adjusts the scrolled region to be the bounding
+# box covering all the items in the canvas following the execution
+# of any method which creates or destroys items. Thus, as new
+# items are added, the scrollbars adjust accordingly.
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledcanvas::autoresize {
+ if {$itk_option(-autoresize)} {
+ set bbox [$itk_component(canvas) bbox all]
+
+ if {$bbox != {}} {
+ set marg $itk_option(-automargin)
+ set bbox [lreplace $bbox 0 0 [expr [lindex $bbox 0] - $marg]]
+ set bbox [lreplace $bbox 1 1 [expr [lindex $bbox 1] - $marg]]
+ set bbox [lreplace $bbox 2 2 [expr [lindex $bbox 2] + $marg]]
+ set bbox [lreplace $bbox 3 3 [expr [lindex $bbox 3] + $marg]]
+ }
+
+ $itk_component(canvas) configure -scrollregion $bbox
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: childsite
+#
+# Returns the path name of the child site widget.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::childsite {} {
+ return $itk_component(canvas)
+}
+
+# ------------------------------------------------------------------
+# METHOD: justify
+#
+# Justifies the canvas scrolled region in one of four directions: top,
+# bottom, left, or right.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::justify {direction} {
+ if {[winfo ismapped $itk_component(canvas)]} {
+ update idletasks
+
+ switch $direction {
+ left {
+ $itk_component(canvas) xview moveto 0
+ }
+ right {
+ $itk_component(canvas) xview moveto 1
+ }
+ top {
+ $itk_component(canvas) yview moveto 0
+ }
+ bottom {
+ $itk_component(canvas) yview moveto 1
+ }
+ default {
+ error "bad justify argument \"$direction\": should be\
+ left, right, top, or bottom"
+ }
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# CANVAS METHODS:
+#
+# The following methods are thin wraps of standard canvas methods.
+# Consult the Tk canvas man pages for functionallity and argument
+# documentation
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: addtag tag searchSpec ?arg arg ...?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::addtag {args} {
+ return [eval $itk_component(canvas) addtag $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: bbox tagOrId ?tagOrId tagOrId ...?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::bbox {args} {
+ return [eval $itk_component(canvas) bbox $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: bind tagOrId ?sequence? ?command?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::bind {args} {
+ return [eval $itk_component(canvas) bind $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: canvasx screenx ?gridspacing?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::canvasx {args} {
+ return [eval $itk_component(canvas) canvasx $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: canvasy screeny ?gridspacing?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::canvasy {args} {
+ return [eval $itk_component(canvas) canvasy $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: coords tagOrId ?x0 y0 ...?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::coords {args} {
+ return [eval $itk_component(canvas) coords $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: create type x y ?x y ...? ?option value ...?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::create {args} {
+ set retval [eval $itk_component(canvas) create $args]
+
+ configure -autoresize $itk_option(-autoresize)
+
+ return $retval
+}
+
+# ------------------------------------------------------------------
+# METHOD: dchars tagOrId first ?last?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::dchars {args} {
+ return [eval $itk_component(canvas) dchars $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: delete tagOrId ?tagOrId tagOrId ...?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::delete {args} {
+ set retval [eval $itk_component(canvas) delete $args]
+
+ configure -autoresize $itk_option(-autoresize)
+
+ return $retval
+}
+
+# ------------------------------------------------------------------
+# METHOD: dtag tagOrId ?tagToDelete?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::dtag {args} {
+ eval $itk_component(canvas) dtag $args
+
+ configure -autoresize $itk_option(-autoresize)
+}
+
+# ------------------------------------------------------------------
+# METHOD: find searchCommand ?arg arg ...?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::find {args} {
+ return [eval $itk_component(canvas) find $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: focus ?tagOrId?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::focus {args} {
+ return [eval $itk_component(canvas) focus $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: gettags tagOrId
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::gettags {args} {
+ return [eval $itk_component(canvas) gettags $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: icursor tagOrId index
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::icursor {args} {
+ eval $itk_component(canvas) icursor $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: index tagOrId index
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::index {args} {
+ return [eval $itk_component(canvas) index $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: insert tagOrId beforeThis string
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::insert {args} {
+ eval $itk_component(canvas) insert $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: itemconfigure tagOrId ?option? ?value? ?option value ...?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::itemconfigure {args} {
+ set retval [eval $itk_component(canvas) itemconfigure $args]
+
+ configure -autoresize $itk_option(-autoresize)
+
+ return $retval
+}
+
+# ------------------------------------------------------------------
+# METHOD: itemcget tagOrId ?option?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::itemcget {args} {
+ set retval [eval $itk_component(canvas) itemcget $args]
+
+ return $retval
+}
+
+# ------------------------------------------------------------------
+# METHOD: lower tagOrId ?belowThis?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::lower {args} {
+ eval $itk_component(canvas) lower $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: move tagOrId xAmount yAmount
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::move {args} {
+ eval $itk_component(canvas) move $args
+
+ configure -autoresize $itk_option(-autoresize)
+}
+
+# ------------------------------------------------------------------
+# METHOD: postscript ?option value ...?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::postscript {args} {
+ #
+ # Make sure the fontmap is in scope.
+ #
+ set fontmap ""
+ regexp -- {-fontmap +([^ ]+)} $args all fontmap
+
+ if {$fontmap != ""} {
+ global $fontmap
+ }
+
+ return [eval $itk_component(canvas) postscript $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: raise tagOrId ?aboveThis?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::raise {args} {
+ eval $itk_component(canvas) raise $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: scale tagOrId xOrigin yOrigin xScale yScale
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::scale {args} {
+ eval $itk_component(canvas) scale $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: scan option args
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::scan {args} {
+ eval $itk_component(canvas) scan $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: select option ?tagOrId arg?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::select {args} {
+ eval $itk_component(canvas) select $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: type tagOrId
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::type {args} {
+ return [eval $itk_component(canvas) type $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: xview index
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::xview {args} {
+ eval $itk_component(canvas) xview $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: yview index
+# ------------------------------------------------------------------
+body iwidgets::Scrolledcanvas::yview {args} {
+ eval $itk_component(canvas) yview $args
+}
diff --git a/itcl/iwidgets3.0.0/generic/scrolledframe.itk b/itcl/iwidgets3.0.0/generic/scrolledframe.itk
new file mode 100644
index 00000000000..ec01c37de46
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/scrolledframe.itk
@@ -0,0 +1,250 @@
+#
+# Scrolledframe
+# ----------------------------------------------------------------------
+# Implements horizontal and vertical scrollbars around a childsite
+# frame. Includes options to control display of scrollbars.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark Ulferts mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Scrolledframe {
+ keep -activebackground -activerelief -background -borderwidth -cursor \
+ -elementborderwidth -foreground -highlightcolor -highlightthickness \
+ -jump -labelfont -troughcolor
+}
+
+# ------------------------------------------------------------------
+# SCROLLEDFRAME
+# ------------------------------------------------------------------
+class iwidgets::Scrolledframe {
+ inherit iwidgets::Scrolledwidget
+
+ constructor {args} {}
+ destructor {}
+
+ public method childsite {}
+ public method justify {direction}
+ public method xview {args}
+ public method yview {args}
+
+ protected method _configureCanvas {}
+ protected method _configureFrame {}
+}
+
+#
+# Provide a lowercased access method for the Scrolledframe class.
+#
+proc ::iwidgets::scrolledframe {pathName args} {
+ uplevel ::iwidgets::Scrolledframe $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Scrolledframe.width 100 widgetDefault
+option add *Scrolledframe.height 100 widgetDefault
+option add *Scrolledframe.labelPos n widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Scrolledframe::constructor {args} {
+ itk_option remove iwidgets::Labeledwidget::state
+
+ #
+ # Create a clipping frame which will provide the border for
+ # relief display.
+ #
+ itk_component add clipper {
+ frame $itk_interior.clipper
+ } {
+ usual
+
+ keep -borderwidth -relief
+ }
+ grid $itk_component(clipper) -row 1 -column 1 -sticky nsew
+ grid rowconfigure $_interior 1 -weight 1
+ grid columnconfigure $_interior 1 -weight 1
+
+ #
+ # Create a canvas to scroll
+ #
+ itk_component add canvas {
+ canvas $itk_component(clipper).canvas \
+ -height 1.0 -width 1.0 \
+ -scrollregion "0 0 1 1" \
+ -xscrollcommand \
+ [code $this _scrollWidget $itk_interior.horizsb] \
+ -yscrollcommand \
+ [code $this _scrollWidget $itk_interior.vertsb] \
+ -highlightthickness 0 -takefocus 0
+ } {
+ ignore -highlightcolor -highlightthickness
+ keep -background -cursor
+ }
+ grid $itk_component(canvas) -row 0 -column 0 -sticky nsew
+ grid rowconfigure $itk_component(clipper) 0 -weight 1
+ grid columnconfigure $itk_component(clipper) 0 -weight 1
+
+ #
+ # Configure the command on the vertical scroll bar in the base class.
+ #
+ $itk_component(vertsb) configure \
+ -command [code $itk_component(canvas) yview]
+
+ #
+ # Configure the command on the horizontal scroll bar in the base class.
+ #
+ $itk_component(horizsb) configure \
+ -command [code $itk_component(canvas) xview]
+
+ #
+ # Handle configure events on the canvas to adjust the frame size
+ # according to the scrollregion.
+ #
+ bind $itk_component(canvas) <Configure> [code $this _configureCanvas]
+
+ #
+ # Create a Frame inside canvas to hold widgets to be scrolled
+ #
+ itk_component add -protected sfchildsite {
+ frame $itk_component(canvas).sfchildsite
+ } {
+ keep -background -cursor
+ }
+ pack $itk_component(sfchildsite) -fill both -expand yes
+ $itk_component(canvas) create window 0 0 -tags frameTag \
+ -window $itk_component(sfchildsite) -anchor nw
+ set itk_interior $itk_component(sfchildsite)
+ bind $itk_component(sfchildsite) <Configure> [code $this _configureFrame]
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# DESTURCTOR
+# ------------------------------------------------------------------
+body iwidgets::Scrolledframe::destructor {} {
+}
+
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: childsite
+#
+# Returns the path name of the child site widget.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledframe::childsite {} {
+ return $itk_component(sfchildsite)
+}
+
+# ------------------------------------------------------------------
+# METHOD: justify
+#
+# Justifies the scrolled region in one of four directions: top,
+# bottom, left, or right.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledframe::justify {direction} {
+ if {[winfo ismapped $itk_component(canvas)]} {
+ update idletasks
+
+ switch $direction {
+ left {
+ $itk_component(canvas) xview moveto 0
+ }
+ right {
+ $itk_component(canvas) xview moveto 1
+ }
+ top {
+ $itk_component(canvas) yview moveto 0
+ }
+ bottom {
+ $itk_component(canvas) yview moveto 1
+ }
+ default {
+ error "bad justify argument \"$direction\": should be\
+ left, right, top, or bottom"
+ }
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: xview index
+#
+# Adjust the view in the frame so that character position index
+# is displayed at the left edge of the widget.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledframe::xview {args} {
+ return [eval $itk_component(canvas) xview $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: yview index
+#
+# Adjust the view in the frame so that character position index
+# is displayed at the top edge of the widget.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledframe::yview {args} {
+ return [eval $itk_component(canvas) yview $args]
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _configureCanvas
+#
+# Responds to configure events on the canvas widget. When canvas
+# changes size, adjust frame size.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledframe::_configureCanvas {} {
+ set sr [$itk_component(canvas) cget -scrollregion]
+ set srw [lindex $sr 2]
+ set srh [lindex $sr 3]
+
+ $itk_component(sfchildsite) configure -height $srh -width $srw
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _configureFrame
+#
+# Responds to configure events on the frame widget. When the frame
+# changes size, adjust scrolling region size.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledframe::_configureFrame {} {
+ $itk_component(canvas) configure \
+ -scrollregion [$itk_component(canvas) bbox frameTag]
+}
+
diff --git a/itcl/iwidgets3.0.0/generic/scrolledhtml.itk b/itcl/iwidgets3.0.0/generic/scrolledhtml.itk
new file mode 100644
index 00000000000..71cee27b14f
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/scrolledhtml.itk
@@ -0,0 +1,2505 @@
+# Scrolledhtml
+# ----------------------------------------------------------------------
+# Implements a scrolled html text widget by inheritance from scrolledtext
+# Import reads from an html file, while export still writes plain text
+# Also provides a render command, to display html text passed in as an
+# argument.
+#
+# This widget is HTML3.2 compliant, with the following exceptions:
+# a) nothing requiring a connection to an HTTP server is supported
+# b) some of the image alignments aren't supported, because they're not
+# supported by the text widget
+# c) the br attributes that go with the image alignments aren't implemented
+# d) background images are not supported, because they're not supported
+# by the text widget
+# e) automatic table/table cell sizing doesn't work very well.
+#
+# WISH LIST:
+# This section lists possible future enhancements.
+#
+# 1) size tables better using dlineinfo.
+# 2) make images scroll smoothly off top like they do off bottom. (limitation
+# of text widget?)
+# 3) add ability to get non-local URLs
+# a) support forms
+# b) support imagemaps
+# 4) keep track of visited links
+# 5) add tclets support
+#
+# BUGS:
+# Cells in a table can be caused to overlap. ex:
+# <table border width="100%">
+# <tr><td>cell1</td><td align=right rowspan=2>cell2</td></tr>
+# <tr><td colspan=2>cell3 w/ overlap</td>
+# </table>
+# It hasn't been fixed because 1) it's a pain to fix, 2) the fix would slow
+# tables down by a significant amount, and 3) netscape has the same
+# bug, as of V3.01, and no one seems to care.
+#
+# In order to size tables properly, they must be visible, which causes an
+# annoying jump from table to table through the document at render time.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Kris Raney EMAIL: kraney@spd.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1996 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+# Acknowledgements:
+#
+# Special thanks go to Sam Shen(SLShen@lbl.gov), as this code is based on his
+# tkhtml.tcl code from tk inspect. The original code is copyright 1995
+# Lawrence Berkeley Laboratory.
+#
+# This software is copyright (C) 1995 by the Lawrence Berkeley Laboratory.
+#
+# Redistribution and use in source and binary forms, with or without
+# modification, are permitted provided that: (1) source code distributions
+# retain the above copyright notice and this paragraph in its entirety, (2)
+# distributions including binary code include the above copyright notice and
+# this paragraph in its entirety in the documentation or other materials
+# provided with the distribution, and (3) all advertising materials mentioning
+# features or use of this software display the following acknowledgement:
+# ``This product includes software developed by the University of California,
+# Lawrence Berkeley Laboratory and its contributors.'' Neither the name of
+# the University nor the names of its contributors may be used to endorse
+# or promote products derived from this software without specific prior
+# written permission.
+#
+# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
+# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
+# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
+#
+# This code is based on Angel Li's (angel@flipper.rsmas.miami.edu) HTML
+
+
+#
+# Default resources.
+#
+option add *Scrolledhtml.borderWidth 2 widgetDefault
+option add *Scrolledhtml.relief sunken widgetDefault
+option add *Scrolledhtml.scrollMargin 3 widgetDefault
+option add *Scrolledhtml.width 500 widgetDefault
+option add *Scrolledhtml.height 600 widgetDefault
+option add *Scrolledhtml.visibleItems 80x24 widgetDefault
+option add *Scrolledhtml.vscrollMode static widgetDefault
+option add *Scrolledhtml.hscrollMode static widgetDefault
+option add *Scrolledhtml.labelPos n widgetDefault
+option add *Scrolledhtml.wrap word widgetDefault
+
+#
+# Usual options.
+#
+itk::usual Scrolledhtml {
+ keep -fontname -fontsize -fixedfont -link -alink -linkhighlight \
+ -activebackground -activerelief -background -borderwidth -cursor \
+ -elementborderwidth -foreground -highlightcolor -highlightthickness \
+ -insertbackground -insertborderwidth -insertofftime -insertontime \
+ -insertwidth -jump -labelfont -selectbackground -selectborderwidth \
+ -selectforeground -textbackground -textfont -troughcolor -unknownimage
+}
+
+# ------------------------------------------------------------------
+# SCROLLEDHTML
+# ------------------------------------------------------------------
+class iwidgets::Scrolledhtml {
+ inherit iwidgets::Scrolledtext
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -feedback feedBack FeedBack {}
+ itk_option define -linkcommand linkCommand LinkCommand {}
+ itk_option define -fontname fontname FontName times
+ itk_option define -fixedfont fixedFont FixedFont courier
+ itk_option define -fontsize fontSize FontSize medium
+ itk_option define -link link Link blue
+ itk_option define -alink alink ALink red
+ itk_option define -linkhighlight alink ALink red
+ itk_option define -unknownimage unknownimage File {}
+ itk_option define -textbackground textBackground Background {}
+ itk_option define -update update Update 1
+
+ public method import {args}
+ public method clear {}
+ public method render {html {wd .}}
+ public method title {} {return $_title}
+ public method pwd {} {return $_cwd}
+
+ protected method _setup {}
+ protected method _set_tag {}
+ protected method _reconfig_tags {}
+ protected method _append_text {text}
+ protected method _do {text}
+ protected method _definefont {name foundry family weight slant registry}
+ protected method _peek {instack}
+ protected method _push {instack value}
+ protected method _pop {instack}
+ protected method _parse_fields {array_var string}
+ protected method _href_click {cmd href}
+ protected method _set_align {align}
+ protected method _fixtablewidth {hottext table multiplier}
+
+ protected method _header {level args}
+ protected method _/header {level}
+
+ protected method _entity_a {args}
+ protected method _entity_/a {}
+ protected method _entity_address {}
+ protected method _entity_/address {}
+ protected method _entity_b {}
+ protected method _entity_/b {}
+ protected method _entity_base {{args {}}}
+ protected method _entity_basefont {{args {}}}
+ protected method _entity_big {}
+ protected method _entity_/big {}
+ protected method _entity_blockquote {}
+ protected method _entity_/blockquote {}
+ protected method _entity_body {{args {}}}
+ protected method _entity_/body {}
+ protected method _entity_br {{args {}}}
+ protected method _entity_center {}
+ protected method _entity_/center {}
+ protected method _entity_cite {}
+ protected method _entity_/cite {}
+ protected method _entity_code {}
+ protected method _entity_/code {}
+ protected method _entity_dir {{args {}}}
+ protected method _entity_/dir {}
+ protected method _entity_div {{args {}}}
+ protected method _entity_dl {{args {}}}
+ protected method _entity_/dl {}
+ protected method _entity_dt {}
+ protected method _entity_dd {}
+ protected method _entity_dfn {}
+ protected method _entity_/dfn {}
+ protected method _entity_em {}
+ protected method _entity_/em {}
+ protected method _entity_font {{args {}}}
+ protected method _entity_/font {}
+ protected method _entity_h1 {{args {}}}
+ protected method _entity_/h1 {}
+ protected method _entity_h2 {{args {}}}
+ protected method _entity_/h2 {}
+ protected method _entity_h3 {{args {}}}
+ protected method _entity_/h3 {}
+ protected method _entity_h4 {{args {}}}
+ protected method _entity_/h4 {}
+ protected method _entity_h5 {{args {}}}
+ protected method _entity_/h5 {}
+ protected method _entity_h6 {{args {}}}
+ protected method _entity_/h6 {}
+ protected method _entity_hr {{args {}}}
+ protected method _entity_i {}
+ protected method _entity_/i {}
+ protected method _entity_img {{args {}}}
+ protected method _entity_kbd {}
+ protected method _entity_/kbd {}
+ protected method _entity_li {{args {}}}
+ protected method _entity_listing {}
+ protected method _entity_/listing {}
+ protected method _entity_menu {{args {}}}
+ protected method _entity_/menu {}
+ protected method _entity_ol {{args {}}}
+ protected method _entity_/ol {}
+ protected method _entity_p {{args {}}}
+ protected method _entity_pre {{args {}}}
+ protected method _entity_/pre {}
+ protected method _entity_samp {}
+ protected method _entity_/samp {}
+ protected method _entity_small {}
+ protected method _entity_/small {}
+ protected method _entity_sub {}
+ protected method _entity_/sub {}
+ protected method _entity_sup {}
+ protected method _entity_/sup {}
+ protected method _entity_strong {}
+ protected method _entity_/strong {}
+ protected method _entity_table {{args {}}}
+ protected method _entity_/table {}
+ protected method _entity_td {{args {}}}
+ protected method _entity_/td {}
+ protected method _entity_th {{args {}}}
+ protected method _entity_/th {}
+ protected method _entity_title {}
+ protected method _entity_/title {}
+ protected method _entity_tr {{args {}}}
+ protected method _entity_/tr {}
+ protected method _entity_tt {}
+ protected method _entity_/tt {}
+ protected method _entity_u {}
+ protected method _entity_/u {}
+ protected method _entity_ul {{args {}}}
+ protected method _entity_/ul {}
+ protected method _entity_var {}
+ protected method _entity_/var {}
+
+ protected variable _title {} ;# The title of the html document
+ protected variable _licount 1 ;# list element count
+ protected variable _listyle bullet ;# list element style
+ protected variable _lipic {} ;# picture to use as bullet
+ protected variable _color black ;# current text color
+ protected variable _bgcolor #d9d9d9 ;# current background color
+ protected variable _link blue ;# current link color
+ protected variable _alink red ;# current highlight link color
+ protected variable _smallpoints "60 80 100 120 140 180 240" ;# font point
+ protected variable _mediumpoints "80 100 120 140 180 240 360" ;# sizes for
+ protected variable _largepoints "100 120 140 180 240 360 480" ;# various
+ protected variable _hugepoints "120 140 180 240 360 480 640" ;# fontsizes
+ protected variable _font times ;# name of current font
+ protected variable _rulerheight 6 ;#
+ protected variable _indentincr 4 ;# increment to indent by
+ protected variable _counter -1 ;# counter to give unique numbers
+ protected variable _left 0 ;# initial left margin
+ protected variable _left2 0 ;# subsequent left margin
+ protected variable _right 0 ;# right margin
+ protected variable _justify L ;# text justification
+ protected variable _offset 0 ;# text offset (super/subscript)
+ protected variable _textweight 0 ;# boldness of text
+ protected variable _textslant 0 ;# whether to use italics
+ protected variable _underline 0 ;# whether to use underline
+ protected variable _verbatim 0 ;# whether to skip formatting
+ protected variable _pre 0 ;# preformatted text
+ protected variable _intitle 0 ;# in <title>...</title>
+ protected variable _anchorcount 0 ;# number of anchors
+ protected variable _stack ;# array of stacks
+ protected variable _pointsndx 2 ;#
+ protected variable _fontnames ;# list of accepted font names
+ protected variable _fontinfo ;# array of font info given font name
+ protected variable _tag ;#
+ protected variable _tagl ;#
+ protected variable _tagfont ;#
+ protected variable _cwd . ;# base directory of current page
+ protected variable _anchor ;# array of indexes by anchorname
+ protected variable _defaulttextbackground;# default text background
+ protected variable _intable 0 ;# whether we are in a table now
+ protected variable _hottext ;# widget where text currently goes
+ protected variable _basefontsize 2 ;# as named
+ protected variable _unknownimg {} ;# name of unknown image
+ protected variable _images {} ;# list of images we created
+ protected variable _prevpos {} ;# temporary used for table updates
+ protected variable _prevtext {} ;# temporary used for table updates
+
+ private variable _initialized 0
+
+ private variable _defUnknownImg [image create photo -data {
+R0lGODdhHwAgAPQAAP///wAAAMzMzC9PT76+vvnTogCR/1WRVaoAVf//qvT09OKdcWlcx19f
+X9/f339/f8vN/J2d/aq2qoKCggAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
+ACwAAAAAHwAgAAAF/iAgjqRDnmiKmqOkqsTaToDjvudTttLjOITJbTQhGI+iQE0xMvZqQIDw
+NAEiAcqRVdKAGh0NyVCkuyqZBEmwofgRrFIxSaI0JmuA9KTrthIicWMTAQ8xWHgSe15AVgcJ
+eVMjDwECOkome22Mb0cHCzEPOiQPgwGXCjomakedA0VgY1IPDZcuP3l5YkcRDwMHqDQoEzq2
+Pz8IQkK7Bw8HDg+xO26PCAgRDcpGswEK2Dh9ItUMDdirPYUKwTKMjwDV1gHlR2oCkSmcI9UE
+BabYrGnQoolgBCGckX7yWJWDYaUMAYSRFECAwMXeiU1BHpKTB4CBR4+oBOb5By1UNgUfXj0C
+8HaP079sBCCkZIAKWst/OGPOhNBNHQmXOeftJBASRVCcEiIojQDBwIOeRo+SpGXKFFGbP6Xi
+nLWxEMsmWpEOC9XDYtigYtKSwsH2xdq2cEfRmFS1rt27eE09CAEAOw==
+}]
+}
+
+#
+# Provide a lowercased access method for the Scrolledhtml class.
+#
+proc ::iwidgets::scrolledhtml {pathName args} {
+ uplevel ::iwidgets::Scrolledhtml $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::constructor {args} {
+ # define the fonts we're going to use
+ set _fontnames ""
+ _definefont helvetica adobe helvetica "medium bold" "r o" iso8859
+ _definefont courier adobe courier "medium bold" "r o" iso8859
+ _definefont times adobe times "medium bold" "r i" iso8859
+ _definefont symbol adobe symbol "medium medium" "r r" adobe
+
+ $itk_component(text) configure -state disabled
+
+ eval itk_initialize $args
+ if {[lsearch -exact $args -linkcommand] == -1} {
+ configure -linkcommand [code $this import -link]
+ }
+ set _initialized 1
+}
+
+# ------------------------------------------------------------------
+# DESTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::destructor {} {
+ foreach x $_images {
+ image delete $x
+ }
+ if {$_unknownimg != $_defUnknownImg} {
+ image delete $_unknownimg
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -fontsize
+#
+# Set the general size of the font.
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledhtml::fontsize {
+ switch $itk_option(-fontsize) {
+ small { }
+ medium { }
+ large { }
+ huge { }
+ default {
+ error "bad fontsize option\
+ \"$itk_option(-fontsize)\": should\
+ be small, medium, large, or huge"
+ }
+ }
+ _reconfig_tags
+}
+
+# ------------------------------------------------------------------
+# OPTION: -fixedfont
+#
+# Set the fixed font name
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledhtml::fixedfont {
+ if {[lsearch -exact $_fontnames $itk_option(-fixedfont)] == -1} {
+ error "Invalid font name \"$itk_option(-fixedfont)\". Must be one of \
+ $_fontnames"
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -fontname
+#
+# Set the default font name
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledhtml::fontname {
+ if {[lsearch -exact $_fontnames $itk_option(-fontname)] == -1} {
+ error "Invalid font name \"$itk_option(-fontname)\". Must be one of \
+ $_fontnames"
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -textbackground
+#
+# Set the default text background
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledhtml::textbackground {
+ set _defaulttextbackground $itk_option(-textbackground)
+}
+
+# ------------------------------------------------------------------
+# OPTION: -linkhighlight
+#
+# same as alink
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledhtml::linkhighlight {
+ configure -alink $itk_option(-linkhighlight)
+}
+
+# ------------------------------------------------------------------
+# OPTION: -unknownimage
+#
+# set image to use as substitute for images that aren't found
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledhtml::unknownimage {
+ set oldimage $_unknownimg
+ if {$itk_option(-unknownimage) != {}} {
+ set uki $itk_option(-unknownimage)
+ if [catch { set _unknownimg [image create photo -file $uki] } err] {
+ error "Couldn't create image $uki:\n$err\nUnknown image not found"
+ }
+ } else {
+ set _unknownimg $_defUnknownImg
+ }
+ if {$oldimage != {} && $oldimage != $_defUnknownImg} {
+ image delete $oldimage
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -update
+#
+# boolean indicating whether to update during rendering
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledhtml::update {
+ switch -- $itk_option(-update) {
+ 0 {}
+ 1 {}
+ true {
+ configure -update 1
+ }
+ yes {
+ configure -update 1
+ }
+ false {
+ configure -update 0
+ }
+ yes {
+ configure -update 0
+ }
+ default {
+ error "invalid -update; must be boolean"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: clear
+#
+# Clears the text out
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::clear {} {
+ $itk_component(text) config -state normal
+ $itk_component(text) delete 1.0 end
+ foreach x $_images {
+ image delete $x
+ }
+ set _images {}
+ _setup
+ $itk_component(text) config -state disabled
+}
+
+# ------------------------------------------------------------------
+# METHOD import ?-link? filename?#anchorname?
+#
+# read html text from a file (import filename) if the keyword link is present,
+# pathname is relative to last page, otherwise it is relative to current
+# directory. This allows the user to use a linkcommand of
+# "<widgetname> import -link"
+#
+# if '#anchorname' is appended to the filename, the page is displayed starting
+# at the anchor named 'anchorname' If an anchor is specified without a filename,
+# the current page is assumed.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::import {args} {
+ set len [llength $args]
+ if {$len != 1 && $len != 2} {
+ error "wrong # args: should be \
+ \"$itk_component(hull) import ?-link? filename\""
+ }
+ set linkname [lindex $args [expr $len - 1]]
+
+ #
+ # Seperate filename#anchorname
+ #
+ if ![regexp {(.*)#(.*)} $linkname dummy filename anchorname] {
+ set filename $linkname
+ }
+ if {$filename!=""} {
+ #
+ # Check for -link option
+ #
+ switch -- $len {
+ 1 {
+ #
+ # open file & set cwd to that file's directory
+ #
+ set f [open $filename r]
+ set _cwd [file dirname $filename]
+ }
+ 2 {
+ switch -- [lindex $args 0] {
+ -link {
+ #
+ # got -link, so set path relative to current locale, if path
+ # is a relative pathname
+ #
+ if {[string compare "." [file dirname $filename]] == 0} {
+ set f [open $_cwd/$filename r]
+ } else {
+ if {[string index [file dirname $filename] 0] != "/" &&\
+ [string index [file dirname $filename] 0] != "~"} {
+ set f [open $_cwd/$filename r]
+ append _cwd /
+ append _cwd [file dirname $filename]
+ } else {
+ set f [open $filename r]
+g set _cwd [file dirname $filename]
+ }
+ }
+ }
+ default {
+ # got something other than -link
+ error "invalid format: should be \
+ \"$itk_component(hull) import ?-link? filename\""
+ }
+ }
+ }
+ }
+ set txt [read $f]
+ close $f
+ render $txt $_cwd
+ }
+
+ #
+ # if an anchor was requested, move that anchor into view
+ #
+ if [ info exists anchorname] {
+ if {$anchorname!=""} {
+ if [info exists _anchor($anchorname)] {
+ $itk_component(text) see end
+ $itk_component(text) see $_anchor($anchorname)
+ }
+ } else {
+ $itk_component(text) see 0.0
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: render text ?wd?
+#
+# Clear the text, then render html formatted text. Optional wd argument
+# sets the base directory for any links or images.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::render {html {wd .}} {
+ #
+ # blank text and reset all state variables
+ #
+ clear
+ set _cwd $wd
+
+ #
+ # make text writable
+ #
+ $itk_component(text) config -state normal
+ set continuerendering 1
+ _set_tag
+ while {$continuerendering} {
+ # normal state
+ while {[set len [string length $html]]} {
+ # look for text up to the next <> element
+ if [regexp -indices "^\[^<\]+" $html match] {
+ set text [string range $html 0 [lindex $match 1]]
+ _append_text "$text"
+ set html \
+ [string range $html [expr [lindex $match 1]+1] end]
+ }
+ # we're either at a <>, or at the eot
+ if [regexp -indices "^<((\[^>\"\]+|(\"\[^\"\]*\"))*)>" $html match entity] {
+ regsub -all "\n" [string range $html [lindex $entity 0] \
+ [lindex $entity 1]] "" entity
+ set cmd [string tolower [lindex $entity 0]]
+ if {[info command _entity_$cmd]!=""} {
+ catch {eval _entity_$cmd [lrange $entity 1 end]}
+ }
+ set html \
+ [string range $html [expr [lindex $match 1]+1] end]
+ }
+ if {$itk_option(-feedback) != {} } {
+ eval $itk_option(-feedback) $len
+ }
+ if $_verbatim break
+ }
+ # we reach here if html is empty, or _verbatim is 1
+ if !$len break
+ # _verbatim must be 1
+ # append text until next tag is reached
+ if [regexp -indices "<.*>" $html match] {
+ set text [string range $html 0 [expr [lindex $match 0]-1]]
+ set html [string range $html [expr [lindex $match 0]] end]
+ } else {
+ set text $html
+ set html ""
+ }
+ _append_text "$text"
+ }
+ $itk_component(text) config -state disabled
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _setup
+#
+# Reset all state variables to prepare for a new page.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_setup {} {
+ set _font $itk_option(-fontname)
+ set _left 0
+ set _left2 0
+ set _right 0
+ set _justify L
+ set _textweight 0
+ set _textslant 0
+ set _underline 0
+ set _verbatim 0
+ set _pre 0
+ set _title {}
+ set _intitle 0
+ set _anchorcount 0
+ set _intable 0
+ set _hottext $itk_component(text)
+ set _stack(font) {}
+ set _stack(color) {}
+ set _stack(bgcolor) {}
+ set _stack(link) {}
+ set _stack(alink) {}
+ set _stack(justify) {}
+ set _stack(listyle) {}
+ set _stack(lipic) {}
+ set _stack(href) {}
+ set _stack(pointsndx) {}
+ set _stack(left) {}
+ set _stack(left2) {}
+ set _stack(offset) {}
+ set _stack(table) {}
+ set _stack(tablewidth) {}
+ set _stack(row) {}
+ set _stack(column) {}
+ set _stack(hottext) {}
+ set _stack(tableborder) {}
+ set _stack(cellpadding) {}
+ set _stack(cellspacing) {}
+ set _stack(licount) {}
+ set _basefontsize 2
+ set _pointsndx 2
+ set _counter -1
+ set _bgcolor $_defaulttextbackground
+ set _color $itk_option(-foreground)
+ set _link $itk_option(-link)
+ set _alink $itk_option(-alink)
+ config -textbackground $_bgcolor
+ foreach x [array names _anchor] { unset _anchor($x) }
+ $itk_component(text) tag config hr -relief sunken -borderwidth 2 \
+ -font -*-*-*-*-*-*-$_rulerheight-*-*-*-*-*-*-*
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _definefont name foundry family weight slant registry
+#
+# define font information used to generate font value from font name
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_definefont \
+ {name foundry family weight slant registry} {
+ if {[lsearch -exact $_fontnames $name] == -1 } {
+ lappend _fontnames $name
+ }
+ set _fontinfo($name) \
+ [list $foundry $family $weight $slant $registry]
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _append_text text
+#
+# append text in the format described by the state variables
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_append_text {text} {
+ if {!$_intable && $itk_option(-update)} {update}
+ if {[string first "&" $text] != -1} {
+ regsub -nocase -all "&amp;" $text {\&} text
+ regsub -nocase -all "&lt;" $text "<" text
+ regsub -nocase -all "&gt;" $text ">" text
+ regsub -nocase -all "&quot;" $text "\"" text
+ }
+ if !$_verbatim {
+ if !$_pre {
+ set text [string trim $text "\n\r"]
+ regsub -all "\[ \n\r\t\]+" $text " " text
+ }
+ if ![string length $text] return
+ }
+ if {!$_pre && !$_intitle} {
+ set p [$_hottext get "end - 2c"]
+ set n [string index $text 0]
+ if {$n == " " && $p == " "} {
+ set text [string range $text 1 end]
+ }
+ $_hottext insert end $text $_tag
+ return
+ }
+ if {$_pre && !$_intitle} {
+ $_hottext insert end $text $_tag
+ return
+ }
+ append _title $text
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _set_tag
+#
+# generate a tag
+# ------------------------------------------------------------------
+# a tag is constructed as: font?B?I?U?Points-LeftLeft2RightColorJustify
+body iwidgets::Scrolledhtml::_set_tag {} {
+ set i -1
+ foreach var {foundry family weight slant registry} {
+ set $var [lindex $_fontinfo($_font) \
+ [incr i]]
+ }
+ set x_font "-$foundry-$family-"
+ set _tag $_font
+ set args {}
+ if {$_textweight > 0} {
+ append _tag "B"
+ append x_font [lindex $weight 1]-
+ } else {
+ append x_font [lindex $weight 0]-
+ }
+ if {$_textslant > 0} {
+ append _tag "I"
+ append x_font [lindex $slant 1]-
+ } else {
+ append x_font [lindex $slant 0]-
+ }
+ if {$_underline > 0} {
+ append _tag "U"
+ append args " -underline 1"
+ }
+ switch $_justify {
+ L { append args " -justify left" }
+ R { append args " -justify right" }
+ C { append args " -justify center" }
+ }
+ append args " -offset $_offset"
+
+ set pts [lindex [set [format "_%spoints" $itk_option(-fontsize)]] \
+ $_pointsndx]
+ append _tag $_pointsndx - $_left \
+ $_left2 $_right \
+ $_color $_justify
+ append x_font "normal-*-*-$pts-*-*-*-*-$registry-*"
+ if $_anchorcount {
+ set href [_peek href]
+ set href_tag href[incr _counter]
+ set tags [list $_tag $href_tag]
+ if { $itk_option(-linkcommand)!= {} } {
+ $_hottext tag bind $href_tag <1> \
+ [list uplevel #0 $itk_option(-linkcommand) $href]
+ }
+ $_hottext tag bind $href_tag <Enter> \
+ [list $_hottext tag configure $href_tag \
+ -foreground $_alink]
+ $_hottext tag bind $href_tag <Leave> \
+ [list $_hottext tag configure $href_tag \
+ -foreground $_color]
+ } else {
+ set tags $_tag
+ }
+ if {![info exists _tagl($_tag)]} {
+ set _tagfont($_tag) 1
+ eval $_hottext tag configure $_tag \
+ -foreground $_color \
+ -lmargin1 ${_left}m \
+ -lmargin2 ${_left2}m $args
+ if [catch {eval $_hottext tag configure $_tag \
+ -font $x_font} err] {
+ _definefont $_font * $family $weight $slant *
+ regsub \$foundry $x_font * x_font
+ regsub \$registry $x_font * x_font
+ catch {eval $_hottext tag configure $_tag -font $x_font}
+ }
+ }
+ if [info exists href_tag] {
+ $_hottext tag raise $href_tag $_tag
+ }
+ set _tag $tags
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _reconfig_tags
+#
+# reconfigure tags following a configuration change
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_reconfig_tags {} {
+ if $_initialized {
+ foreach tag [$itk_component(text) tag names] {
+ foreach efont $_fontnames {
+ if [regexp "${efont}(B?)(I?)(U?)(\[1-9\]\[0-9\]*)-" $tag t b i u points] {
+ set j -1
+ set _font $efont
+ foreach var {foundry family weight slant registry} {
+ set $var [lindex $_fontinfo($_font) [incr j]]
+ }
+ set x_font "-$foundry-$family-"
+ if {$b == "B"} {
+ append x_font [lindex $weight 1]-
+ } else {
+ append x_font [lindex $weight 0]-
+ }
+ if {$i == "I"} {
+ append x_font [lindex $slant 1]-
+ } else {
+ append x_font [lindex $slant 0]-
+ }
+ set pts [lindex [set [format \
+ "_%spoints" $itk_option(-fontsize)]] $points]
+ append x_font "normal-*-*-$pts-*-*-*-*-$registry-*"
+ $itk_component(text) tag config $tag -font $x_font
+ break
+ }
+ }
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _push instack value
+#
+# push value onto stack(instack)
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_push {instack value} {
+ set _stack($instack) [linsert $_stack($instack) 0 $value]
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _pop instack
+#
+# pop value from stack(instack)
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_pop {instack} {
+ if {$_stack($instack) == ""} {
+ error "popping empty _stack $instack"
+ }
+ set val [lindex $_stack($instack) 0]
+ set _stack($instack) [lrange $_stack($instack) 1 end]
+ return $val
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _peek instack
+#
+# peek at top value on stack(instack)
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_peek {instack} {
+ return [lindex $_stack($instack) 0]
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _parse_fields array_var string
+#
+# parse fields from a href or image tag. At the moment, doesn't support
+# spaces in field values. (e.g. alt="not avaliable")
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_parse_fields {array_var string} {
+ upvar $array_var array
+ if {$string != "{}" } {
+ regsub -all "( *)=( *)" $string = string
+ regsub -all {\\\"} $string \" string
+ while {$string != ""} {
+ if ![regexp "^ *(\[^ \n\r=\]+)=\"(\[^\"\n\r\t\]*)(.*)" $string \
+ dummy field value newstring] {
+ if ![regexp "^ *(\[^ \n\r=\]+)=(\[^\n\r\t \]*)(.*)" $string \
+ dummy field value newstring] {
+ if ![regexp "^ *(\[^ \n\r\]+)(.*)" $string dummy field newstring] {
+ error "malformed command field; field = \"$string\""
+ continue
+ }
+ set value ""
+ }
+ }
+ set array([string tolower $field]) $value
+ set string "$newstring"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _href_click
+#
+# process a click on an href
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_href_click {cmd href} {
+ uplevel #0 $cmd $href
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _set_align
+#
+# set text alignment
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_set_align {align} {
+ switch [string tolower $align] {
+ center {
+ set _justify C
+ }
+ left {
+ set _justify L
+ }
+ right {
+ set _justify R
+ }
+ default {}
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _fixtablewidth
+#
+# fix table width & height
+# essentially, with nested tables the outer table must be configured before
+# the inner table, but the idle tasks get queued up in the opposite order,
+# so process later idle tasks before sizing yourself.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_fixtablewidth {hottext table multiplier} {
+ update idletasks
+ $hottext see $_anchor($table)
+ update idletasks
+ $table configure \
+ -width [expr $multiplier * [winfo width $hottext] - \
+ 2* [$hottext cget -padx] - \
+ 2* [$hottext cget -borderwidth] ] \
+ -height [winfo height $table]
+ grid propagate $table 0
+}
+
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _header level
+#
+# generic entity to set state for <hn> tag
+# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_header {level args} {
+ eval _parse_fields ar $args
+ _push justify $_justify
+ if [info exists ar(align)] {
+ _entity_p align=$ar(align)
+ } else {
+ _entity_p
+ }
+ if [info exists ar(src)] {
+ _entity_img src=$ar(src)
+ }
+ _push pointsndx $_pointsndx
+ set _pointsndx [expr 7-$level]
+ incr _textweight
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _/header level
+#
+# generic entity to set state for </hn> tag
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_/header {level} {
+ set _justify [_pop justify]
+ set _pointsndx [_pop pointsndx]
+ incr _textweight -1
+ _set_tag
+ _entity_p
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_a
+#
+# add an anchor. Accepts arguments of the form ?href=filename#anchorpoint?
+# ?name=anchorname?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_a {args} {
+ _parse_fields ar $args
+ _push color $_color
+ if [info exists ar(href)] {
+ _push href $ar(href)
+ incr _anchorcount
+ set _color $_link
+ _entity_u
+ } else {
+ _push href {}
+ }
+ if [info exists ar(name)] {
+ set _anchor($ar(name)) [$itk_component(text) index end]
+ }
+ if [info exists ar(id)] {
+ set _anchor($ar(id)) [$itk_component(text) index end]
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/a
+#
+# End anchor
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/a {} {
+ set href [_pop href]
+ if {$href != {}} {
+ incr _anchorcount -1
+ set _color [_pop color]
+ _entity_/u
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_address
+#
+# display an address
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_address {} {
+ _entity_br
+ _entity_i
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/address
+#
+# change state back from address display
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/address {} {
+ _entity_/i
+ _entity_br
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_b
+#
+# Change current font to bold
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_b {} {
+ incr _textweight
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/b
+#
+# change current font back from bold
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/b {} {
+ incr _textweight -1
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_base
+#
+# set the cwd of the document
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_base {{args {}}} {
+ _parse_fields ar $args
+ if [info exists ar(href)] {
+ set _cwd [file dirname $ar(href)]
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_basefont
+#
+# set base font size
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_basefont {{args {}}} {
+ _parse_fields ar $args
+ if {[info exists ar(size)]} {
+ set _basefontsize $ar(size)
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_big
+#
+# Change current font to a bigger size
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_big {} {
+ _push pointsndx $_pointsndx
+ if {[incr _pointsndx 2] > 6} {
+ set _pointsndx 6
+ }
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/big
+#
+# change current font back from bigger size
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/big {} {
+ set _pointsndx [_pop pointsndx]
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_blockquote
+#
+# display a block quote
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_blockquote {} {
+ _entity_p
+ _push left $_left
+ incr _left $_indentincr
+ _push left2 $_left2
+ set _left2 $_left
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/blockquote
+#
+# change back from blockquote
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/blockquote {} {
+ _entity_p
+ set _left [_pop left]
+ set _left2 [_pop left2]
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_body
+#
+# begin body text. Takes argument of the form ?bgcolor=<color>? ?text=<color>?
+# ?link=<color>?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_body {{args {}}} {
+ _parse_fields ar $args
+ if [info exists ar(bgcolor)] {
+ set _bgcolor $ar(bgcolor)
+ set temp $itk_option(-textbackground)
+ config -textbackground $_bgcolor
+ set _defaulttextbackground $temp
+ }
+ if [info exists ar(text)] {
+ set _color $ar(text)
+ }
+ if [info exists ar(link)] {
+ set _link $ar(link)
+ }
+ if [info exists ar(alink)] {
+ set _alink $ar(alink)
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/body
+#
+# end body text
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/body {} {
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_br
+#
+# line break
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_br {{args {}}} {
+ $_hottext insert end "\n"
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_center
+#
+# change justification to center
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_center {} {
+ _push justify $_justify
+ set _justify C
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/center
+#
+# change state back from center
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/center {} {
+ set _justify [_pop justify]
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_cite
+#
+# display citation
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_cite {} {
+ _entity_i
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/cite
+#
+# change state back from citation
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/cite {} {
+ _entity_/i
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_code
+#
+# display code listing
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_code {} {
+ _entity_pre
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/code
+#
+# end code listing
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/code {} {
+ _entity_/pre
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_dir
+#
+# display dir list
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_dir {{args {}}} {
+ _entity_ul plain $args
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/dir
+#
+# end dir list
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/dir {} {
+ _entity_/ul
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_div
+#
+# divide text. same as <p>
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_div {{args {}}} {
+ _entity_p $args
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_dl
+#
+# begin definition list
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_dl {{args {}}} {
+ if {$_left == 0} {
+ _entity_p
+ }
+ _push left $_left
+ _push left2 $_left2
+ if {$_left2 == $_left } {
+ incr _left2 [expr $_indentincr+3]
+ } else {
+ incr _left2 $_indentincr
+ }
+ incr _left $_indentincr
+ _push listyle $_listyle
+ _push licount $_licount
+ set _listyle none
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/dl
+#
+# end definition list
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/dl {} {
+ set _left [_pop left]
+ set _left2 [_pop left2]
+ set _listyle [_pop listyle]
+ set _licount [_pop licount]
+ _set_tag
+ if {$_left == 0} {
+ _entity_p
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_dt
+#
+# definition term
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_dt {} {
+ set _left [expr $_left2 - 3]
+ _set_tag
+ _entity_p
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_dd
+#
+# definition definition
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_dd {} {
+ set _left $_left2
+ _set_tag
+ _entity_br
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_dfn
+#
+# display defining instance of a term
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_dfn {} {
+ _entity_i
+ _entity_b
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/dfn
+#
+# change state back from defining instance of term
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/dfn {} {
+ _entity_/b
+ _entity_/i
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_em
+#
+# display emphasized text
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_em {} {
+ _entity_i
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/em
+#
+# change state back from emphasized text
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/em {} {
+ _entity_/i
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_font
+#
+# set font size and color
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_font {{args {}}} {
+ _parse_fields ar $args
+ _push pointsndx $_pointsndx
+ _push color $_color
+ if [info exists ar(size)] {
+ if {![regexp {^[+-].*} $ar(size)]} {
+ set _pointsndx $ar(size)
+ } else {
+ set _pointsndx [expr $_basefontsize $ar(size)]
+ }
+ if { $_pointsndx > 6 } {
+ set _pointsndx 6
+ } else {
+ if { $_pointsndx < 0 } {
+ set _pointsndx 0
+ }
+ }
+ }
+ if {[info exists ar(color)]} {
+ set _color $ar(color)
+ }
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/font
+#
+# close current font size
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/font {} {
+ set _pointsndx [_pop pointsndx]
+ set _color [_pop color]
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_h1
+#
+# display header level 1.
+# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_h1 {{args {}}} {
+ _header 1 $args
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/h1
+#
+# change state back from header 1
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/h1 {} {
+ _/header 1
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_h2
+#
+# display header level 2
+# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_h2 {{args {}}} {
+ _header 2 $args
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/h2
+#
+# change state back from header 2
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/h2 {} {
+ _/header 2
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_h3
+#
+# display header level 3
+# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_h3 {{args {}}} {
+ _header 3 $args
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/h3
+#
+# change state back from header 3
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/h3 {} {
+ _/header 3
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_h4
+#
+# display header level 4
+# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_h4 {{args {}}} {
+ _header 4 $args
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/h4
+#
+# change state back from header 4
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/h4 {} {
+ _/header 4
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_h5
+#
+# display header level 5
+# Accepts argument of the form ?align=[left,right,center]? ?src=<image pname>?
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_h5 {{args {}}} {
+ _header 5 $args
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/h5
+#
+# change state back from header 5
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/h5 {} {
+ _/header 5
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_h6
+#
+# display header level 6
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_h6 {{args {}}} {
+ _header 6 $args
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/h6
+#
+# change state back from header 6
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/h6 {} {
+ _/header 6
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_hr
+#
+# Add a horizontal rule
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_hr {{args {}}} {
+ _parse_fields ar $args
+ if [info exists ar(size)] {
+ set font "-font -*-*-*-*-*-*-$ar(size)-*-*-*-*-*-*-*"
+ } else {
+ set font "-font -*-*-*-*-*-*-2-*-*-*-*-*-*-*"
+ }
+ if [info exists ar(width)] {
+ }
+ if [info exists ar(noshade)] {
+ set relief "-relief flat"
+ set background "-background black"
+ } else {
+ set relief "-relief sunken"
+ set background ""
+ }
+# if [info exists ar(align)] {
+# $_hottext tag config hr$_counter -justify $ar(align)
+# set justify -justify $ar(align)
+# } else {
+# set justify ""
+# }
+ eval $_hottext tag config hr[incr _counter] $relief $background $font \
+ -borderwidth 2
+ _entity_p
+ $_hottext insert end " \n" hr$_counter
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_i
+#
+# display italicized text
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_i {} {
+ incr _textslant
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/i
+#
+# change state back from italicized text
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/i {} {
+ incr _textslant -1
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_img
+#
+# display an image. takes argument of the form img=<filename>
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_img {{args {}}} {
+ _parse_fields ar $args
+ set alttext "<image>"
+
+ #
+ # If proper argument exists
+ #
+ if [info exists ar(src)] {
+ set imgframe $_hottext.img[incr _counter]
+ #
+ # if this is an anchor
+ #
+ if $_anchorcount {
+ # create link colored border
+ frame $imgframe -borderwidth 2 -background $_link
+ bind $imgframe <Enter> \
+ [list $imgframe configure -background $_alink]
+ bind $imgframe <Leave> \
+ [list $imgframe configure -background $_link]
+ } else {
+ # create plain frame
+ frame $imgframe -borderwidth 0 -background $_color
+ }
+
+ #
+ # try to load image
+ #
+ if {[string index $ar(src) 0] == "/" || [string index $ar(src) 0] == "~"} {
+ set file $ar(src)
+ } else {
+ set file $_cwd/$ar(src)
+ }
+ if [catch {set img [image create photo -file $file]} err] {
+ if {[info exists ar(width)] && [info exists ar(height)] } {
+ # suggestions exist, so make frame appropriate size and add a border
+ $imgframe configure -width $ar(width) -height $ar(height) -borderwidth 2
+ pack propagate $imgframe false
+ }
+
+ #
+ # If alt text is specified, display that
+ #
+ if [info exists ar(alt)] {
+ # add a border
+ $imgframe configure -borderwidth 2
+ set win $imgframe.text
+ label $win -text "$ar(alt)" -background $_bgcolor \
+ -foreground $_color
+ } else {
+ #
+ # use 'unknown image'
+ set win $imgframe.image#auto
+ #
+ # make label containing image
+ #
+ label $win -image $_unknownimg -borderwidth 0 -background $_bgcolor
+ }
+ pack $win -fill both -expand true
+
+ } else { ;# no error loading image
+ lappend _images $img
+ set win $imgframe.$img
+
+ #
+ # make label containing image
+ #
+ label $win -image $img -borderwidth 0
+ }
+ pack $win
+
+ #
+ # set alignment
+ #
+ set align bottom
+ if [info exists ar(align)] {
+ switch $ar(align) {
+ middle {
+ set align center
+ }
+ right {
+ set align center
+ }
+ default {
+ set align [string tolower $ar(align)]
+ }
+ }
+ }
+
+ #
+ # create window in text to display image
+ #
+ $_hottext window create end -window \
+ $imgframe -align $align
+
+ #
+ # set tag for window
+ #
+ $_hottext tag add $_tag $imgframe
+ if $_anchorcount {
+ set href [_peek href]
+ set href_tag href[incr _counter]
+ set tags [list $_tag $href_tag]
+ if { $itk_option(-linkcommand)!= {} } {
+ bind $win <1> [list uplevel #0 $itk_option(-linkcommand) $href]
+ }
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_kbd
+#
+# Display keyboard input
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_kbd {} {
+ incr _textweight
+ _entity_tt
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/kbd
+#
+# change state back from displaying keyboard input
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/kbd {} {
+ _entity_/tt
+ incr _textweight -1
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_li
+#
+# begin new list entry
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_li {{args {}}} {
+ _parse_fields ar $args
+ if [info exists ar(value)] {
+ set _licount $ar(value)
+ }
+ _entity_br
+ switch -exact $_listyle {
+ bullet {
+ set old_font $_font
+ set _font symbol
+ _set_tag
+ $_hottext insert end "\xb7" $_tag
+ set _font $old_font
+ _set_tag
+ }
+ none {
+ }
+ picture {
+ _entity_img src="$_lipic" width=4 height=4 align=middle
+ }
+ A {
+ _entity_b
+ $_hottext insert end [format "%c) " [expr $_licount + 0x40]] $_tag
+ _entity_/b
+ incr _licount
+ }
+ a {
+ _entity_b
+ $_hottext insert end [format "%c) " [expr $_licount + 0x60]] $_tag
+ _entity_/b
+ incr _licount
+ }
+ I {
+ _entity_b
+ $_hottext insert end "[::iwidgets::roman $_licount]) " $_tag
+ _entity_/b
+ incr _licount
+ }
+ i {
+ _entity_b
+ $_hottext insert end "[::iwidgets::roman $_licount lower])] " $_tag
+ _entity_/b
+ incr _licount
+ }
+ default {
+ _entity_b
+ $_hottext insert end "$_licount) " $_tag
+ _entity_/b
+ incr _licount
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_listing
+#
+# diplay code listing
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_listing {} {
+ _entity_pre
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/listing
+#
+# end code listing
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/listing {} {
+ _entity_/pre
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_menu
+#
+# diplay menu list
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_menu {{args {}}} {
+ _entity_ul plain $args
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/menu
+#
+# end menu list
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/menu {} {
+ _entity_/ul
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_ol
+#
+# begin ordered list
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_ol {{args {}}} {
+ _parse_fields ar $args
+ if $_left {
+ _entity_br
+ } else {
+ _entity_p
+ }
+ if {![info exists ar(type)]} {
+ set ar(type) 1
+ }
+ _push licount $_licount
+ if [info exists ar(start)] {
+ set _licount $ar(start)
+ } else {
+ set _licount 1
+ }
+ _push left $_left
+ _push left2 $_left2
+ if {$_left2 == $_left } {
+ incr _left2 [expr $_indentincr+3]
+ } else {
+ incr _left2 $_indentincr
+ }
+ incr _left $_indentincr
+ _push listyle $_listyle
+ set _listyle $ar(type)
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/ol
+#
+# end ordered list
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/ol {} {
+ set _left [_pop left]
+ set _left2 [_pop left2]
+ set _listyle [_pop listyle]
+ set _licount [_pop licount]
+ _set_tag
+ _entity_p
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_p
+#
+# paragraph break
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_p {{args {}}} {
+ _parse_fields ar $args
+ if [info exists ar(align)] {
+ _set_align $ar(align)
+ } else {
+ set _justify L
+ }
+ _set_tag
+ if [info exists ar(id)] {
+ set _anchor($ar(id)) [$itk_component(text) index end]
+ }
+ set x [$_hottext get end-3c]
+ set y [$_hottext get end-2c]
+ if {$x == "" && $y == ""} return
+ if {$y == ""} {
+ $_hottext insert end "\n\n"
+ return
+ }
+ if {$x == "\n" && $y == "\n"} return
+ if {$y == "\n"} {
+ $_hottext insert end "\n"
+ return
+ }
+ $_hottext insert end "\n\n"
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_pre
+#
+# display preformatted text
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_pre {{args {}}} {
+ _entity_tt
+ _entity_br
+ incr _pre
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/pre
+#
+# change state back from preformatted text
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/pre {} {
+ _entity_/tt
+ set _pre 0
+ _entity_p
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_samp
+#
+# display sample text.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_samp {} {
+ _entity_kbd
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/samp
+#
+# switch back to non-sample text
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/samp {} {
+ _entity_/kbd
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_small
+#
+# Change current font to a smaller size
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_small {} {
+ _push pointsndx $_pointsndx
+ if {[incr _pointsndx -2] < 0} {
+ set _pointsndx 0
+ }
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/small
+#
+# change current font back from smaller size
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/small {} {
+ set _pointsndx [_pop pointsndx]
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_sub
+#
+# display subscript
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_sub {} {
+ _push offset $_offset
+ incr _offset -2
+ _entity_small
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/sub
+#
+# switch back to non-subscript
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/sub {} {
+ set _offset [_pop offset]
+ _entity_/small
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_sup
+#
+# display superscript
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_sup {} {
+ _push offset $_offset
+ incr _offset 4
+ _entity_small
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/sup
+#
+# switch back to non-superscript
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/sup {} {
+ set _offset [_pop offset]
+ _entity_/small
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_strong
+#
+# display strong text. (i.e. make font bold)
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_strong {} {
+ incr _textweight
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/strong
+#
+# switch back to non-strong text
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/strong {} {
+ incr _textweight -1
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_table
+#
+# display a table.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_table {{args {}}} {
+ _parse_fields ar $args
+ _entity_p
+ set _intable 1
+
+ _push row -1
+ _push column 0
+ _push hottext $_hottext
+ _push justify $_justify
+ _push justify L
+ # push color information for master of table, then push info for table
+ _push color $_color
+ _push bgcolor $_bgcolor
+ _push link $_link
+ _push alink $_alink
+ if [info exists ar(bgcolor)] {
+ set _bgcolor $ar(bgcolor)
+ }
+ if [info exists ar(text)] {
+ set _color $ar(text)
+ }
+ if [info exists ar(link)] {
+ set _link $ar(link)
+ }
+ if [info exists ar(alink)] {
+ set _alink $ar(alink)
+ }
+ _push color $_color
+ _push bgcolor $_bgcolor
+ _push link $_link
+ _push alink $_alink
+ # push fake first row to avoid using optional /tr tag
+ _push color {}
+ _push bgcolor {}
+ _push link {}
+ _push alink {}
+
+ if {[info exists ar(align)]} {
+ _set_align $ar(align)
+ _set_tag
+ _append_text " "
+ }
+ set _justify L
+
+ if [info exists ar(id)] {
+ set _anchor($ar(id)) [$itk_component(text) index end]
+ }
+ if [info exists ar(cellpadding)] {
+ _push cellpadding $ar(cellpadding)
+ } else {
+ _push cellpadding 0
+ }
+ if [info exists ar(cellspacing)] {
+ _push cellspacing $ar(cellspacing)
+ } else {
+ _push cellspacing 0
+ }
+ if {[info exists ar(border)]} {
+ _push tableborder 1
+ set relief raised
+ if {$ar(border)==""} {
+ set ar(border) 2
+ }
+ } else {
+ _push tableborder 0
+ set relief flat
+ set ar(border) 2
+ }
+ _push table [set table $_hottext.table[incr _counter]]
+ iwidgets::labeledwidget $table -foreground $_color -background $_bgcolor -labelpos n
+ if {[info exists ar(title)]} {
+ $table configure -labeltext $ar(title)
+ }
+ #
+ # create window in text to display table
+ #
+ $_hottext window create end -window $table
+
+ set table [$table childsite]
+ set _anchor($table) [$_hottext index "end - 1 line"]
+ $table configure -borderwidth $ar(border) -relief $relief
+
+ if {[info exists ar(width)]} {
+ _push tablewidth $ar(width)
+ } else {
+ _push tablewidth 0
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/table
+#
+# end table
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/table {} {
+ if $_intable {
+ _pop tableborder
+ set table [[_pop table] childsite]
+ _pop row
+ _pop column
+ _pop cellspacing
+ _pop cellpadding
+ # pop last row's defaults
+ _pop color
+ _pop bgcolor
+ _pop link
+ _pop alink
+ # pop table defaults
+ _pop color
+ _pop bgcolor
+ _pop link
+ _pop alink
+ # restore table master defaults
+ set _color [_pop color]
+ set _bgcolor [_pop bgcolor]
+ set _link [_pop link]
+ set _alink [_pop alink]
+ foreach x [grid slaves $table] {
+ if {[$x cget -height] == 1} {
+ $x configure -height [lindex [split [$x index "end - 1 chars"] "."] 0]
+ }
+ }
+ $_hottext configure -state disabled
+ set _hottext [_pop hottext]
+ $_hottext configure -state normal
+ if {[set tablewidth [_pop tablewidth]]!="0"} {
+ if {[string index $tablewidth \
+ [expr [string length $tablewidth] -1]] == "%"} {
+ set multiplier [expr [string trimright $tablewidth "%"] / 100.0]
+ set idletask [after idle [code "$this _fixtablewidth $_hottext $table $multiplier"]]
+ } else {
+ $table configure -width $tablewidth
+ grid propagate $table 0
+ }
+ }
+ _pop justify
+ set _justify [_pop justify]
+ _entity_br
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_td
+#
+# start table data cell
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_td {{args {}}} {
+ if $_intable {
+ _parse_fields ar $args
+ set table [[_peek table] childsite]
+ if {![info exists ar(colspan)]} {
+ set ar(colspan) 1
+ }
+ if {![info exists ar(rowspan)]} {
+ set ar(rowspan) 1
+ }
+ if {![info exists ar(width)]} {
+ set ar(width) 10
+ }
+ if {![info exists ar(height)]} {
+ set ar(height) 0
+ }
+ if [info exists ar(bgcolor)] {
+ set _bgcolor $ar(bgcolor)
+ } else {
+ set _bgcolor [_peek bgcolor]
+ }
+ if [info exists ar(text)] {
+ set _color $ar(text)
+ } else {
+ set _color [_peek color]
+ }
+ if [info exists ar(link)] {
+ set _link $ar(link)
+ } else {
+ set _link [_peek link]
+ }
+ if [info exists ar(alink)] {
+ set _alink $ar(alink)
+ } else {
+ set _alink [_peek alink]
+ }
+ $_hottext configure -state disabled
+ set cellpadding [_peek cellpadding]
+ set cellspacing [_peek cellspacing]
+ set _hottext $table.cell[incr _counter]
+ text $_hottext -relief flat -width $ar(width) -height $ar(height) \
+ -foreground $_color -background $_bgcolor -highlightthickness 0 \
+ -wrap word -cursor $itk_option(-cursor) \
+ -padx $cellpadding -pady $cellpadding
+ if [info exists ar(nowrap)] {
+ $_hottext configure -wrap none
+ }
+ if [_peek tableborder] {
+ $_hottext configure -relief sunken
+ }
+ set row [_peek row]
+ set column [_pop column]
+ while {[grid slaves $table -row $row -column $column] != ""} {
+ incr column
+ }
+ grid $_hottext -sticky nsew -row $row -column $column \
+ -columnspan $ar(colspan) -rowspan $ar(rowspan) \
+ -padx $cellspacing -pady $cellspacing
+ grid columnconfigure $table $column -weight 1
+ _push column [expr $column + $ar(colspan)]
+ if [info exists ar(align)] {
+ _set_align $ar(align)
+ } else {
+ set _justify [_peek justify]
+ }
+ _set_tag
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/td
+#
+# end table data cell
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/td {} {
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_th
+#
+# start table header
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_th {{args {}}} {
+ if $_intable {
+ _parse_fields ar $args
+ if [info exists ar(align)] {
+ _entity_td $args
+ } else {
+ _entity_td align=center $args
+ }
+ _entity_b
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/th
+#
+# end table data cell
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/th {} {
+ _entity_/td
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_title
+#
+# begin title of document
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_title {} {
+ set _intitle 1
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/title
+#
+# end title
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/title {} {
+ set _intitle 0
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_tr
+#
+# start table row
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_tr {{args {}}} {
+ if $_intable {
+ _parse_fields ar $args
+ _pop justify
+ if [info exists ar(align)] {
+ _set_align $ar(align)
+ _push justify $_justify
+ } else {
+ _push justify L
+ }
+ # pop last row's colors
+ _pop color
+ _pop bgcolor
+ _pop link
+ _pop alink
+ if [info exists ar(bgcolor)] {
+ set _bgcolor $ar(bgcolor)
+ } else {
+ set _bgcolor [_peek bgcolor]
+ }
+ if [info exists ar(text)] {
+ set _color $ar(text)
+ } else {
+ set _color [_peek color]
+ }
+ if [info exists ar(link)] {
+ set _link $ar(link)
+ } else {
+ set _link [_peek link]
+ }
+ if [info exists ar(alink)] {
+ set _alink $ar(alink)
+ } else {
+ set _alink [_peek alink]
+ }
+ # push this row's defaults
+ _push color $_color
+ _push bgcolor $_bgcolor
+ _push link $_link
+ _push alink $_alink
+ $_hottext configure -state disabled
+ _push row [expr [_pop row] + 1]
+ _pop column
+ _push column 0
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/tr
+#
+# end table row
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/tr {} {
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_tt
+#
+# Show typewriter text, using the font given by -fixedfont
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_tt {} {
+ _push font $_font
+ set _font $itk_option(-fixedfont)
+ set _verbatim 1
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/tt
+#
+# Change back to non-typewriter mode to display text
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/tt {} {
+ set _font [_pop font]
+ set _verbatim 0
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_u
+#
+# display underlined text
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_u {} {
+ incr _underline
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/u
+#
+# change back from underlined text
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/u {} {
+ incr _underline -1
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_ul
+#
+# begin unordered list
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_ul {{args {}}} {
+ _parse_fields ar $args
+ if $_left {
+ _entity_br
+ } else {
+ _entity_p
+ }
+ if [info exists ar(id)] {
+ set _anchor($ar(id)) [$itk_component(text) index end]
+ }
+ _push left $_left
+ _push left2 $_left2
+ if {$_left2 == $_left } {
+ incr _left2 [expr $_indentincr+3]
+ } else {
+ incr _left2 $_indentincr
+ }
+ incr _left $_indentincr
+ _push listyle $_listyle
+ _push licount $_licount
+ if [info exists ar(plain)] {
+ set _listyle none
+ } {
+ set _listyle bullet
+ }
+ if [info exists ar(dingbat)] {
+ set ar(src) $ar(dingbat)
+ }
+ _push lipic $_lipic
+ if [info exists ar(src)] {
+ set _listyle picture
+ set _lipic $ar(src)
+ }
+ _set_tag
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/ul
+#
+# end unordered list
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/ul {} {
+ set _left [_pop left]
+ set _left2 [_pop left2]
+ set _listyle [_pop listyle]
+ set _licount [_pop licount]
+ set _lipic [_pop lipic]
+ _set_tag
+ _entity_p
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_var
+#
+# Display variable
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_var {} {
+ _entity_i
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _entity_/var
+#
+# change state back from variable display
+# ------------------------------------------------------------------
+body iwidgets::Scrolledhtml::_entity_/var {} {
+ _entity_/i
+}
+
+namespace eval iwidgets {
+ variable romand
+ set romand(val) {1000 900 500 400 100 90 50 40 10 9 5 4 1}
+ set romand(upper) { M CM D CD C XC L XL X IX V IV I}
+ set romand(lower) { m cm d cd c xc l xl x ix v iv i}
+
+ proc roman2 {n {case upper}} {
+ variable romand
+ set r ""
+ foreach val $romand(val) sym $romand($case) {
+ while {$n >= $val} {
+ set r "$r$sym"
+ incr n -$val
+ }
+ }
+ return $r
+ }
+
+ proc roman {n {case upper}} {
+ variable romand
+ set r ""
+ foreach val $romand(val) sym $romand($case) {
+ for {} {$n >= $val} {incr n -$val} {
+ set r "$r$sym"
+ }
+ }
+ return $r
+ }
+}
diff --git a/itcl/iwidgets3.0.0/generic/scrolledlistbox.itk b/itcl/iwidgets3.0.0/generic/scrolledlistbox.itk
new file mode 100644
index 00000000000..c8222b96de4
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/scrolledlistbox.itk
@@ -0,0 +1,719 @@
+#
+# Scrolledlistbox
+# ----------------------------------------------------------------------
+# Implements a scrolled listbox with additional options to manage
+# horizontal and vertical scrollbars. This includes options to control
+# which scrollbars are displayed and the method, i.e. statically,
+# dynamically, or none at all.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Scrolledlistbox {
+ keep -activebackground -activerelief -background -borderwidth -cursor \
+ -elementborderwidth -foreground -highlightcolor -highlightthickness \
+ -jump -labelfont -selectbackground -selectborderwidth \
+ -selectforeground -textbackground -textfont -troughcolor
+}
+
+# ------------------------------------------------------------------
+# SCROLLEDLISTBOX
+# ------------------------------------------------------------------
+class iwidgets::Scrolledlistbox {
+ inherit iwidgets::Scrolledwidget
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -dblclickcommand dblClickCommand Command {}
+ itk_option define -selectioncommand selectionCommand Command {}
+ itk_option define -width width Width 0
+ itk_option define -height height Height 0
+ itk_option define -visibleitems visibleItems VisibleItems 20x10
+ itk_option define -state state State normal
+
+ public method curselection {}
+ public method activate {index}
+ public method bbox {index}
+ public method clear {}
+ public method see {index}
+ public method index {index}
+ public method delete {first {last {}}}
+ public method get {first {last {}}}
+ public method getcurselection {}
+ public method insert {index string args}
+ public method nearest {y}
+ public method scan {option args}
+ public method selection {option first {last {}}}
+ public method size {}
+ public method selecteditemcount {}
+ public method justify {direction}
+ public method sort {{mode ascending}}
+ public method xview {args}
+ public method yview {args}
+
+ protected method _makeSelection {}
+ protected method _dblclick {}
+ protected method _fixIndex {index}
+
+ #
+ # List the event sequences that invoke single and double selection.
+ # Should these change in the underlying Tk listbox, then they must
+ # change here too.
+ #
+ common doubleSelectSeq { \
+ <Double-1>
+ }
+
+ common singleSelectSeq { \
+ <Control-Key-backslash> \
+ <Control-Key-slash> \
+ <Key-Escape> \
+ <Shift-Key-Select> \
+ <Control-Shift-Key-space> \
+ <Key-Select> \
+ <Key-space> \
+ <Control-Shift-Key-End> \
+ <Control-Key-End> \
+ <Control-Shift-Key-Home> \
+ <Control-Key-Home> \
+ <Key-Down> \
+ <Key-Up> \
+ <Shift-Key-Down> \
+ <Shift-Key-Up> \
+ <Control-Button-1> \
+ <Shift-Button-1> \
+ <ButtonRelease-1> \
+ <B1-Motion>
+ }
+}
+
+#
+# Provide a lowercased access method for the Scrolledlistbox class.
+#
+proc ::iwidgets::scrolledlistbox {pathName args} {
+ uplevel ::iwidgets::Scrolledlistbox $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Scrolledlistbox.labelPos n widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::constructor {args} {
+ #
+ # Our -width and -height options are slightly different than
+ # those implemented by our base class, so we're going to
+ # remove them and redefine our own.
+ #
+ itk_option remove iwidgets::Scrolledwidget::width
+ itk_option remove iwidgets::Scrolledwidget::height
+
+ #
+ # Create the listbox.
+ #
+ itk_component add listbox {
+ listbox $itk_interior.listbox \
+ -width 1 -height 1 \
+ -xscrollcommand \
+ [code $this _scrollWidget $itk_interior.horizsb] \
+ -yscrollcommand \
+ [code $this _scrollWidget $itk_interior.vertsb]
+ } {
+ usual
+
+ keep -borderwidth -exportselection -relief -selectmode
+
+ rename -font -textfont textFont Font
+ rename -background -textbackground textBackground Background
+ rename -highlightbackground -background background Background
+ }
+ grid $itk_component(listbox) -row 1 -column 1 -sticky nsew
+ grid rowconfigure $_interior 1 -weight 1
+ grid columnconfigure $_interior 1 -weight 1
+
+ #
+ # Configure the command on the vertical scroll bar in the base class.
+ #
+ $itk_component(vertsb) configure \
+ -command [code $itk_component(listbox) yview]
+
+ #
+ # Configure the command on the horizontal scroll bar in the base class.
+ #
+ $itk_component(horizsb) configure \
+ -command [code $itk_component(listbox) xview]
+
+ #
+ # Create a set of bindings for monitoring the selection and install
+ # them on the listbox component.
+ #
+ foreach seq $singleSelectSeq {
+ bind SLBSelect$this $seq [code $this _makeSelection]
+ }
+
+ foreach seq $doubleSelectSeq {
+ bind SLBSelect$this $seq [code $this _dblclick]
+ }
+
+ bindtags $itk_component(listbox) \
+ [linsert [bindtags $itk_component(listbox)] end SLBSelect$this]
+
+ #
+ # Also create a set of bindings for disabling the scrolledlistbox.
+ # Since the command for it is "break", we can drop the $this since
+ # they don't need to be unique to the object level.
+ #
+ if {[bind SLBDisabled] == {}} {
+ foreach seq $singleSelectSeq {
+ bind SLBDisabled $seq break
+ }
+
+ bind SLBDisabled <Button-1> break
+
+ foreach seq $doubleSelectSeq {
+ bind SLBDisabled $seq break
+ }
+ }
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# DESTURCTOR
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::destructor {} {
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -dblclickcommand
+#
+# Specify a command to be executed upon double click of a listbox
+# item. Also, create a couple of bindings used for specific
+# selection modes
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledlistbox::dblclickcommand {}
+
+# ------------------------------------------------------------------
+# OPTION: -selectioncommand
+#
+# Specifies a command to be executed upon selection of a listbox
+# item. The command will be called upon each selection regardless
+# of selection mode..
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledlistbox::selectioncommand {}
+
+# ------------------------------------------------------------------
+# OPTION: -width
+#
+# Specifies the width of the scrolled list box as an entire unit.
+# The value may be specified in any of the forms acceptable to
+# Tk_GetPixels. Any additional space needed to display the other
+# components such as margins and scrollbars force the listbox
+# to be compressed. A value of zero along with the same value for
+# the height causes the value given for the visibleitems option
+# to be applied which administers geometry constraints in a different
+# manner.
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledlistbox::width {
+ if {$itk_option(-width) != 0} {
+ set shell [lindex [grid info $itk_component(listbox)] 1]
+
+ #
+ # Due to a bug in the tk4.2 grid, we have to check the
+ # propagation before setting it. Setting it to the same
+ # value it already is will cause it to toggle.
+ #
+ if {[grid propagate $shell]} {
+ grid propagate $shell no
+ }
+
+ $itk_component(listbox) configure -width 1
+ $shell configure \
+ -width [winfo pixels $shell $itk_option(-width)]
+ } else {
+ configure -visibleitems $itk_option(-visibleitems)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -height
+#
+# Specifies the height of the scrolled list box as an entire unit.
+# The value may be specified in any of the forms acceptable to
+# Tk_GetPixels. Any additional space needed to display the other
+# components such as margins and scrollbars force the listbox
+# to be compressed. A value of zero along with the same value for
+# the width causes the value given for the visibleitems option
+# to be applied which administers geometry constraints in a different
+# manner.
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledlistbox::height {
+ if {$itk_option(-height) != 0} {
+ set shell [lindex [grid info $itk_component(listbox)] 1]
+
+ #
+ # Due to a bug in the tk4.2 grid, we have to check the
+ # propagation before setting it. Setting it to the same
+ # value it already is will cause it to toggle.
+ #
+ if {[grid propagate $shell]} {
+ grid propagate $shell no
+ }
+
+ $itk_component(listbox) configure -height 1
+ $shell configure \
+ -height [winfo pixels $shell $itk_option(-height)]
+ } else {
+ configure -visibleitems $itk_option(-visibleitems)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -visibleitems
+#
+# Specified the widthxheight in characters and lines for the listbox.
+# This option is only administered if the width and height options
+# are both set to zero, otherwise they take precedence. With the
+# visibleitems option engaged, geometry constraints are maintained
+# only on the listbox. The size of the other components such as
+# labels, margins, and scrollbars, are additive and independent,
+# effecting the overall size of the scrolled list box. In contrast,
+# should the width and height options have non zero values, they
+# are applied to the scrolled list box as a whole. The listbox
+# is compressed or expanded to maintain the geometry constraints.
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledlistbox::visibleitems {
+ if {[regexp {^[0-9]+x[0-9]+$} $itk_option(-visibleitems)]} {
+ if {($itk_option(-width) == 0) && \
+ ($itk_option(-height) == 0)} {
+ set chars [lindex [split $itk_option(-visibleitems) x] 0]
+ set lines [lindex [split $itk_option(-visibleitems) x] 1]
+
+ set shell [lindex [grid info $itk_component(listbox)] 1]
+
+ #
+ # Due to a bug in the tk4.2 grid, we have to check the
+ # propagation before setting it. Setting it to the same
+ # value it already is will cause it to toggle.
+ #
+ if {! [grid propagate $shell]} {
+ grid propagate $shell yes
+ }
+
+ $itk_component(listbox) configure -width $chars -height $lines
+ }
+
+ } else {
+ error "bad visibleitems option\
+ \"$itk_option(-visibleitems)\": should be\
+ widthxheight"
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -state
+#
+# Specifies the state of the scrolledlistbox which may be either
+# disabled or normal. In a disabled state, the scrolledlistbox
+# does not accept user selection. The default is normal.
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledlistbox::state {
+ set tags [bindtags $itk_component(listbox)]
+
+ #
+ # If the state is normal, then we need to remove the disabled
+ # bindings if they exist. If the state is disabled, then we need
+ # to install the disabled bindings if they haven't been already.
+ #
+ switch -- $itk_option(-state) {
+ normal {
+ if {[set index [lsearch $tags SLBDisabled]] != -1} {
+ bindtags $itk_component(listbox) \
+ [lreplace $tags $index $index]
+ }
+ }
+
+ disabled {
+ if {[set index [lsearch $tags SLBDisabled]] == -1} {
+ bindtags $itk_component(listbox) \
+ [linsert $tags 1 SLBDisabled]
+ }
+ }
+ default {
+ error "bad state value \"$itk_option(-state)\":\
+ must be normal or disabled"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: curselection
+#
+# Returns a list containing the indices of all the elements in the
+# listbox that are currently selected.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::curselection {} {
+ return [$itk_component(listbox) curselection]
+}
+
+# ------------------------------------------------------------------
+# METHOD: activate index
+#
+# Sets the active element to the one indicated by index.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::activate {index} {
+ return [$itk_component(listbox) activate [_fixIndex $index]]
+}
+
+# ------------------------------------------------------------------
+# METHOD: bbox index
+#
+# Returns four element list describing the bounding box for the list
+# item at index
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::bbox {index} {
+ return [$itk_component(listbox) bbox [_fixIndex $index]]
+}
+
+# ------------------------------------------------------------------
+# METHOD clear
+#
+# Clear the listbox area of all items.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::clear {} {
+ delete 0 end
+}
+
+# ------------------------------------------------------------------
+# METHOD: see index
+#
+# Adjusts the view such that the element given by index is visible.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::see {index} {
+ $itk_component(listbox) see [_fixIndex $index]
+}
+
+# ------------------------------------------------------------------
+# METHOD: index index
+#
+# Returns the decimal string giving the integer index corresponding
+# to index. The index value may be a integer number, active,
+# anchor, end, @x,y, or a pattern.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::index {index} {
+ if {[regexp {(^[0-9]+$)|(active)|(anchor)|(end)|(^@-?[0-9]+,-?[0-9]+$)} $index]} {
+ return [$itk_component(listbox) index $index]
+
+ } else {
+ set indexValue [lsearch -glob [get 0 end] $index]
+
+ if {$indexValue == -1} {
+ error "bad Scrolledlistbox index \"$index\": must be active, anchor, end, @x,y, number, or a pattern"
+ }
+
+ return $indexValue
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: _fixIndex index
+#
+# Similar to the regular "index" method, but it only converts
+# the index to a numerical value if it is a string pattern. If
+# the index is in the proper form to be used with the listbox,
+# it is left alone. This fixes problems associated with converting
+# an index such as "end" to a numerical value.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::_fixIndex {index} {
+ if {[regexp {(^[0-9]+$)|(active)|(anchor)|(end)|(^@[0-9]+,[0-9]+$)} $index]} {
+ return $index
+
+ } else {
+ set indexValue [lsearch -glob [get 0 end] $index]
+
+ if {$indexValue == -1} {
+ error "bad Scrolledlistbox index \"$index\": must be active, anchor, end, @x,y, number, or a pattern"
+ }
+
+ return $indexValue
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: delete first ?last?
+#
+# Delete one or more elements from list box based on the first and
+# last index values. Indexes may be a number, active, anchor, end,
+# @x,y, or a pattern.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::delete {first {last {}}} {
+ set first [_fixIndex $first]
+
+ if {$last != {}} {
+ set last [_fixIndex $last]
+ } else {
+ set last $first
+ }
+
+ eval $itk_component(listbox) delete $first $last
+}
+
+# ------------------------------------------------------------------
+# METHOD: get first ?last?
+#
+# Returns the elements of the listbox indicated by the indexes.
+# Indexes may be a number, active, anchor, end, @x,y, ora pattern.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::get {first {last {}}} {
+ set first [_fixIndex $first]
+
+ if {$last != {}} {
+ set last [_fixIndex $last]
+ }
+
+ if {$last == {}} {
+ return [$itk_component(listbox) get $first]
+ } else {
+ return [$itk_component(listbox) get $first $last]
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: getcurselection
+#
+# Returns the contents of the listbox element indicated by the current
+# selection indexes. Short cut version of get and curselection
+# command combination.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::getcurselection {} {
+ set rlist {}
+
+ if {[selecteditemcount] > 0} {
+ set cursels [$itk_component(listbox) curselection]
+
+ switch $itk_option(-selectmode) {
+ single -
+ browse {
+ set rlist [$itk_component(listbox) get $cursels]
+ }
+
+ multiple -
+ extended {
+ foreach sel $cursels {
+ lappend rlist [$itk_component(listbox) get $sel]
+ }
+ }
+ }
+ }
+
+ return $rlist
+}
+
+# ------------------------------------------------------------------
+# METHOD: insert index string ?string ...?
+#
+# Insert zero or more elements in the list just before the element
+# given by index.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::insert {index string args} {
+ set index [_fixIndex $index]
+ set args [linsert $args 0 $string]
+
+ eval $itk_component(listbox) insert $index $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: nearest y
+#
+# Given a y-coordinate within the listbox, this command returns the
+# index of the visible listbox element nearest to that y-coordinate.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::nearest {y} {
+ $itk_component(listbox) nearest $y
+}
+
+# ------------------------------------------------------------------
+# METHOD: scan option args
+#
+# Implements scanning on listboxes.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::scan {option args} {
+ eval $itk_component(listbox) scan $option $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: selection option first ?last?
+#
+# Adjusts the selection within the listbox. The index value may be
+# a integer number, active, anchor, end, @x,y, or a pattern.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::selection {option first {last {}}} {
+ set first [_fixIndex $first]
+
+ if {$last != {}} {
+ set last [_fixIndex $last]
+ $itk_component(listbox) selection $option $first $last
+ } else {
+ $itk_component(listbox) selection $option $first
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: size
+#
+# Returns a decimal string indicating the total number of elements
+# in the listbox.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::size {} {
+ return [$itk_component(listbox) size]
+}
+
+# ------------------------------------------------------------------
+# METHOD: selecteditemcount
+#
+# Returns a decimal string indicating the total number of selected
+# elements in the listbox.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::selecteditemcount {} {
+ return [llength [$itk_component(listbox) curselection]]
+}
+
+# ------------------------------------------------------------------
+# METHOD: justify direction
+#
+# Justifies the list scrolled region in one of four directions: top,
+# bottom, left, or right.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::justify {direction} {
+ switch $direction {
+ left {
+ $itk_component(listbox) xview moveto 0
+ }
+ right {
+ $itk_component(listbox) xview moveto 1
+ }
+ top {
+ $itk_component(listbox) yview moveto 0
+ }
+ bottom {
+ $itk_component(listbox) yview moveto 1
+ }
+ default {
+ error "bad justify argument \"$direction\": should\
+ be left, right, top, or bottom"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: sort mode
+#
+# Sort the current list in either "ascending/increasing" or
+# "descending/decreasing" order.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::sort {{mode ascending}} {
+ switch $mode {
+ ascending -
+ increasing {
+ set vals [$itk_component(listbox) get 0 end]
+ if {[llength $vals] != 0} {
+ $itk_component(listbox) delete 0 end
+ eval $itk_component(listbox) insert end \
+ [lsort -increasing $vals]
+ }
+ }
+ descending -
+ decreasing {
+ set vals [$itk_component(listbox) get 0 end]
+ if {[llength $vals] != 0} {
+ $itk_component(listbox) delete 0 end
+ eval $itk_component(listbox) insert end \
+ [lsort -decreasing $vals]
+ }
+ }
+ default {
+ error "bad sort argument \"$mode\": should be\
+ ascending, descending, increasing, or decreasing"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: xview args
+#
+# Change or query the vertical position of the text in the list box.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::xview {args} {
+ return [eval $itk_component(listbox) xview $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: yview args
+#
+# Change or query the horizontal position of the text in the list box.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::yview {args} {
+ return [eval $itk_component(listbox) yview $args]
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _makeSelection
+#
+# Evaluate the selection command.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::_makeSelection {} {
+ uplevel #0 $itk_option(-selectioncommand)
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _dblclick
+#
+# Evaluate the double click command option if not empty.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledlistbox::_dblclick {} {
+ uplevel #0 $itk_option(-dblclickcommand)
+}
+
diff --git a/itcl/iwidgets3.0.0/generic/scrolledtext.itk b/itcl/iwidgets3.0.0/generic/scrolledtext.itk
new file mode 100644
index 00000000000..f595aa1c3bb
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/scrolledtext.itk
@@ -0,0 +1,484 @@
+#
+# Scrolledtext
+# ----------------------------------------------------------------------
+# Implements a scrolled text widget with additional options to manage
+# the vertical scrollbar. This includes options to control the method
+# in which the scrollbar is displayed, i.e. statically or dynamically.
+# Options also exist for adding a label to the scrolled text area and
+# controlling its position. Import/export of methods are provided for
+# file I/O.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Scrolledtext {
+ keep -activebackground -activerelief -background -borderwidth -cursor \
+ -elementborderwidth -foreground -highlightcolor -highlightthickness \
+ -insertbackground -insertborderwidth -insertofftime -insertontime \
+ -insertwidth -jump -labelfont -selectbackground -selectborderwidth \
+ -selectforeground -textbackground -textfont -troughcolor
+}
+
+#
+# The default case is to have no label, so we set the default spacings
+# to reflect this...
+#
+
+option add *Scrolledtext.labelMargin 0 widgetDefault
+option add *Scrolledtext.labelFont \
+ "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*" widgetDefault
+option add *Scrolledtext.labelPos n widgetDefault
+option add *Scrolledtext.labelBorderWidth 0 widgetDefault
+option add *Scrolledtext.labelRelief groove widgetDefault
+
+# ------------------------------------------------------------------
+# SCROLLEDTEXT
+# ------------------------------------------------------------------
+class iwidgets::Scrolledtext {
+ inherit iwidgets::Scrolledwidget
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -width width Width 0
+ itk_option define -height height Height 0
+ itk_option define -visibleitems visibleItems VisibleItems 80x24
+
+ public method bbox {index}
+ public method clear {}
+ public method import {filename {index end}}
+ public method export {filename}
+ public method compare {index1 op index2}
+ public method debug {args}
+ public method delete {first {last {}}}
+ public method dlineinfo {index}
+ public method get {index1 {index2 {}}}
+ public method index {index}
+ public method insert {args}
+ public method mark {option args}
+ public method scan {option args}
+ public method search {args}
+ public method see {index}
+ public method tag {option args}
+ public method window {option args}
+ public method xview {args}
+ public method yview {args}
+}
+
+#
+# Provide a lowercased access method for the Scrolledtext class.
+#
+proc ::iwidgets::scrolledtext {pathName args} {
+ uplevel ::iwidgets::Scrolledtext $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Scrolledtext.labelPos n widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::constructor {args} {
+ #
+ # Our -width and -height options are slightly different than
+ # those implemented by our base class, so we're going to
+ # remove them and redefine our own.
+ #
+ itk_option remove iwidgets::Scrolledwidget::width
+ itk_option remove iwidgets::Scrolledwidget::height
+
+ #
+ # Create a clipping frame which will provide the border for
+ # relief display.
+ #
+ itk_component add clipper {
+ frame $itk_interior.clipper
+ } {
+ usual
+
+ keep -borderwidth -relief -highlightthickness -highlightcolor
+ rename -highlightbackground -background background Background
+ }
+ grid $itk_component(clipper) -row 1 -column 1 -sticky nsew
+ grid rowconfigure $_interior 1 -weight 1
+ grid columnconfigure $_interior 1 -weight 1
+
+ #
+ # Create the text area.
+ #
+ itk_component add text {
+ text $itk_component(clipper).text \
+ -width 1 -height 1 \
+ -xscrollcommand \
+ [code $this _scrollWidget $itk_interior.horizsb] \
+ -yscrollcommand \
+ [code $this _scrollWidget $itk_interior.vertsb] \
+ -borderwidth 0 -highlightthickness 0
+ } {
+ usual
+
+ ignore -highlightthickness -highlightcolor -borderwidth
+
+ keep -exportselection -padx -pady -setgrid \
+ -spacing1 -spacing2 -spacing3 -state -wrap
+
+ rename -font -textfont textFont Font
+ rename -background -textbackground textBackground Background
+ }
+ grid $itk_component(text) -row 0 -column 0 -sticky nsew
+ grid rowconfigure $itk_component(clipper) 0 -weight 1
+ grid columnconfigure $itk_component(clipper) 0 -weight 1
+
+ #
+ # Configure the command on the vertical scroll bar in the base class.
+ #
+ $itk_component(vertsb) configure \
+ -command [code $itk_component(text) yview]
+
+ #
+ # Configure the command on the horizontal scroll bar in the base class.
+ #
+ $itk_component(horizsb) configure \
+ -command [code $itk_component(text) xview]
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# DESTURCTOR
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::destructor {} {
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -width
+#
+# Specifies the width of the scrolled text as an entire unit.
+# The value may be specified in any of the forms acceptable to
+# Tk_GetPixels. Any additional space needed to display the other
+# components such as labels, margins, and scrollbars force the text
+# to be compressed. A value of zero along with the same value for
+# the height causes the value given for the visibleitems option
+# to be applied which administers geometry constraints in a different
+# manner.
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledtext::width {
+ if {$itk_option(-width) != 0} {
+ set shell [lindex [grid info $itk_component(clipper)] 1]
+
+ #
+ # Due to a bug in the tk4.2 grid, we have to check the
+ # propagation before setting it. Setting it to the same
+ # value it already is will cause it to toggle.
+ #
+ if {[grid propagate $shell]} {
+ grid propagate $shell no
+ }
+
+ $itk_component(text) configure -width 1
+ $shell configure \
+ -width [winfo pixels $shell $itk_option(-width)]
+ } else {
+ configure -visibleitems $itk_option(-visibleitems)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -height
+#
+# Specifies the height of the scrolled text as an entire unit.
+# The value may be specified in any of the forms acceptable to
+# Tk_GetPixels. Any additional space needed to display the other
+# components such as labels, margins, and scrollbars force the text
+# to be compressed. A value of zero along with the same value for
+# the width causes the value given for the visibleitems option
+# to be applied which administers geometry constraints in a different
+# manner.
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledtext::height {
+ if {$itk_option(-height) != 0} {
+ set shell [lindex [grid info $itk_component(clipper)] 1]
+
+ #
+ # Due to a bug in the tk4.2 grid, we have to check the
+ # propagation before setting it. Setting it to the same
+ # value it already is will cause it to toggle.
+ #
+ if {[grid propagate $shell]} {
+ grid propagate $shell no
+ }
+
+ $itk_component(text) configure -height 1
+ $shell configure \
+ -height [winfo pixels $shell $itk_option(-height)]
+ } else {
+ configure -visibleitems $itk_option(-visibleitems)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -visibleitems
+#
+# Specified the widthxheight in characters and lines for the text.
+# This option is only administered if the width and height options
+# are both set to zero, otherwise they take precedence. With the
+# visibleitems option engaged, geometry constraints are maintained
+# only on the text. The size of the other components such as
+# labels, margins, and scroll bars, are additive and independent,
+# effecting the overall size of the scrolled text. In contrast,
+# should the width and height options have non zero values, they
+# are applied to the scrolled text as a whole. The text is
+# compressed or expanded to maintain the geometry constraints.
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledtext::visibleitems {
+ if {[regexp {^[0-9]+x[0-9]+$} $itk_option(-visibleitems)]} {
+ if {($itk_option(-width) == 0) && \
+ ($itk_option(-height) == 0)} {
+ set chars [lindex [split $itk_option(-visibleitems) x] 0]
+ set lines [lindex [split $itk_option(-visibleitems) x] 1]
+
+ set shell [lindex [grid info $itk_component(clipper)] 1]
+
+ #
+ # Due to a bug in the tk4.2 grid, we have to check the
+ # propagation before setting it. Setting it to the same
+ # value it already is will cause it to toggle.
+ #
+ if {! [grid propagate $shell]} {
+ grid propagate $shell yes
+ }
+
+ $itk_component(text) configure -width $chars -height $lines
+ }
+
+ } else {
+ error "bad visibleitems option\
+ \"$itk_option(-visibleitems)\": should be\
+ widthxheight"
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: bbox index
+#
+# Returns four element list describing the bounding box for the list
+# item at index
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::bbox {index} {
+ return [$itk_component(text) bbox $index]
+}
+
+# ------------------------------------------------------------------
+# METHOD clear
+#
+# Clear the text area.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::clear {} {
+ $itk_component(text) delete 1.0 end
+}
+
+# ------------------------------------------------------------------
+# METHOD import filename
+#
+# Load text from an existing file (import filename)
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::import {filename {index end}} {
+ set f [open $filename r]
+ insert $index [read $f]
+ close $f
+}
+
+# ------------------------------------------------------------------
+# METHOD export filename
+#
+# write text to a file (export filename)
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::export {filename} {
+ set f [open $filename w]
+
+ set txt [$itk_component(text) get 1.0 end]
+ puts $f $txt
+
+ flush $f
+ close $f
+}
+
+# ------------------------------------------------------------------
+# METHOD compare index1 op index2
+#
+# Compare indices according to relational operator.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::compare {index1 op index2} {
+ return [$itk_component(text) compare $index1 $op $index2]
+}
+
+# ------------------------------------------------------------------
+# METHOD debug ?boolean?
+#
+# Activates consistency checks in B-tree code associated with text
+# widgets.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::debug {args} {
+ eval $itk_component(text) debug $args
+}
+
+# ------------------------------------------------------------------
+# METHOD delete first ?last?
+#
+# Delete a range of characters from the text.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::delete {first {last {}}} {
+ $itk_component(text) delete $first $last
+}
+
+# ------------------------------------------------------------------
+# METHOD dlineinfo index
+#
+# Returns a five element list describing the area occupied by the
+# display line containing index.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::dlineinfo {index} {
+ return [$itk_component(text) dlineinfo $index]
+}
+
+# ------------------------------------------------------------------
+# METHOD get index1 ?index2?
+#
+# Return text from start index to end index.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::get {index1 {index2 {}}} {
+ return [$itk_component(text) get $index1 $index2]
+}
+
+# ------------------------------------------------------------------
+# METHOD index index
+#
+# Return position corresponding to index.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::index {index} {
+ return [$itk_component(text) index $index]
+}
+
+# ------------------------------------------------------------------
+# METHOD insert index chars ?tagList?
+#
+# Insert text at index.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::insert {args} {
+ eval $itk_component(text) insert $args
+}
+
+# ------------------------------------------------------------------
+# METHOD mark option ?arg arg ...?
+#
+# Manipulate marks dependent on options.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::mark {option args} {
+ return [eval $itk_component(text) mark $option $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD scan option args
+#
+# Implements scanning on texts.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::scan {option args} {
+ eval $itk_component(text) scan $option $args
+}
+
+# ------------------------------------------------------------------
+# METHOD search ?switches? pattern index ?varName?
+#
+# Searches the text for characters matching a pattern.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::search {args} {
+ return [eval $itk_component(text) search $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD see index
+#
+# Adjusts the view in the window so the character at index is
+# visible.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::see {index} {
+ $itk_component(text) see $index
+}
+
+# ------------------------------------------------------------------
+# METHOD tag option ?arg arg ...?
+#
+# Manipulate tags dependent on options.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::tag {option args} {
+ return [eval $itk_component(text) tag $option $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD window option ?arg arg ...?
+#
+# Manipulate embedded windows.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::window {option args} {
+ return [eval $itk_component(text) window $option $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD xview
+#
+# Changes x view in widget's window.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::xview {args} {
+ return [eval $itk_component(text) xview $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD yview
+#
+# Changes y view in widget's window.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledtext::yview {args} {
+ return [eval $itk_component(text) yview $args]
+}
+
diff --git a/itcl/iwidgets3.0.0/generic/scrolledwidget.itk b/itcl/iwidgets3.0.0/generic/scrolledwidget.itk
new file mode 100644
index 00000000000..7b685436cfe
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/scrolledwidget.itk
@@ -0,0 +1,434 @@
+#
+# Scrolledwidget
+# ----------------------------------------------------------------------
+# Implements a general purpose base class for scrolled widgets, by
+# creating the necessary horizontal and vertical scrollbars and
+# providing protected methods for controlling their display. The
+# derived class needs to take advantage of the fact that the grid
+# is used and the vertical scrollbar is in row 0, column 2 and the
+# horizontal scrollbar in row 2, column 0.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark Ulferts mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1997 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Scrolledwidget {
+ keep -background -borderwidth -cursor -highlightcolor -highlightthickness
+ keep -activebackground -activerelief -jump -troughcolor
+ keep -labelfont -foreground
+}
+
+# ------------------------------------------------------------------
+# SCROLLEDWIDGET
+# ------------------------------------------------------------------
+class iwidgets::Scrolledwidget {
+ inherit iwidgets::Labeledframe
+
+ constructor {args} {}
+ destructor {}
+ method childsite {}
+
+ itk_option define -childsitepos childSitePos Position e
+ itk_option define -sbwidth sbWidth Width ""
+ itk_option define -scrollmargin scrollMargin ScrollMargin 3
+ itk_option define -vscrollmode vscrollMode VScrollMode static
+ itk_option define -hscrollmode hscrollMode HScrollMode static
+ itk_option define -width width Width 30
+ itk_option define -height height Height 30
+
+ protected {
+ method _scrollWidget {wid first last}
+ method _vertScrollbarDisplay {mode}
+ method _horizScrollbarDisplay {mode}
+ method _configureEvent {}
+
+ variable _vmode off ;# Vertical scroll mode
+ variable _hmode off ;# Vertical scroll mode
+ variable _recheckHoriz 1 ;# Flag to check need for
+ ;# horizontal scrollbar
+ variable _recheckVert 1 ;# Flag to check need for
+ ;# vertical scrollbar
+
+ variable _interior {}
+ }
+}
+
+#
+# Provide a lowercased access method for the Scrolledwidget class.
+#
+proc ::iwidgets::scrolledwidget {pathName args} {
+ uplevel ::iwidgets::Scrolledwidget $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Scrolledwidget.labelPos n widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Scrolledwidget::constructor {args} {
+
+ #
+ # Turn off the borderwidth on the hull and save off the
+ # interior for later use.
+ #
+ component hull configure -borderwidth 0
+ set _interior [iwidgets::Labeledframe::childsite]
+ set itk_interior $_interior
+
+ #
+ # Check if the scrollbars need mapping upon a configure event.
+ #
+ bind $_interior <Configure> [code $this _configureEvent]
+
+ #
+ # Turn off propagation in the containing shell.
+ #
+ # Due to a bug in the tk4.2 grid, we have to check the
+ # propagation before setting it. Setting it to the same
+ # value it already is will cause it to toggle.
+ #
+ if {[grid propagate $_interior]} {
+ grid propagate $_interior no
+ }
+
+ #
+ # Create the vertical scroll bar
+ #
+ itk_component add vertsb {
+ scrollbar $_interior.vertsb -orient vertical
+ } {
+ usual
+ keep -elementborderwidth -jump
+ rename -highlightbackground -background background Background
+ }
+
+ #
+ # Create the horizontal scrollbar
+ #
+ itk_component add horizsb {
+ scrollbar $_interior.horizsb -orient horizontal
+ } {
+ usual
+ keep -elementborderwidth -jump
+ rename -highlightbackground -background background Background
+ }
+
+ #
+ # Create the childsite frame
+ #
+ itk_component add swchildsite {
+ frame $_interior.cs
+ }
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# DESTURCTOR
+# ------------------------------------------------------------------
+body iwidgets::Scrolledwidget::destructor {} {
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -sbwidth
+#
+# Set the width of the scrollbars.
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledwidget::sbwidth {
+ if {$itk_option(-sbwidth) != ""} {
+ $itk_component(vertsb) configure -width $itk_option(-sbwidth)
+ $itk_component(horizsb) configure -width $itk_option(-sbwidth)
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -scrollmargin
+#
+# Set the distance between the scrollbars and the list box.
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledwidget::scrollmargin {
+ set pixels [winfo pixels $_interior $itk_option(-scrollmargin)]
+
+ if {$_hmode == "on"} {
+ grid rowconfigure $_interior 2 -minsize $pixels
+ }
+
+ if {$_vmode == "on"} {
+ grid columnconfigure $_interior 2 -minsize $pixels
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -vscrollmode
+#
+# Enable/disable display and mode of veritcal scrollbars.
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledwidget::vscrollmode {
+ switch $itk_option(-vscrollmode) {
+ static {
+ _vertScrollbarDisplay on
+ }
+
+ dynamic -
+ none {
+ _vertScrollbarDisplay off
+ }
+
+ default {
+ error "bad vscrollmode option\
+ \"$itk_option(-vscrollmode)\": should be\
+ static, dynamic, or none"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -hscrollmode
+#
+# Enable/disable display and mode of horizontal scrollbars.
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledwidget::hscrollmode {
+ switch $itk_option(-hscrollmode) {
+ static {
+ _horizScrollbarDisplay on
+ }
+
+ dynamic -
+ none {
+ _horizScrollbarDisplay off
+ }
+
+ default {
+ error "bad hscrollmode option\
+ \"$itk_option(-hscrollmode)\": should be\
+ static, dynamic, or none"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -width
+#
+# Specifies the width of the scrolled widget. The value may be
+# specified in any of the forms acceptable to Tk_GetPixels.
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledwidget::width {
+ $_interior configure -width \
+ [winfo pixels $_interior $itk_option(-width)]
+}
+
+# ------------------------------------------------------------------
+# OPTION: -height
+#
+# Specifies the height of the scrolled widget. The value may be
+# specified in any of the forms acceptable to Tk_GetPixels.
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledwidget::height {
+ $_interior configure -height \
+ [winfo pixels $_interior $itk_option(-height)]
+}
+
+# ------------------------------------------------------------------
+# OPTION: -childsitepos
+#
+# Specifies the position of the child site in the widget.
+# ------------------------------------------------------------------
+configbody iwidgets::Scrolledwidget::childsitepos {
+
+ # First reset all the other child sites to weight 0 so
+ # they do not take any of the space...
+
+ switch $itk_option(-childsitepos) {
+ n {
+ grid $itk_component(swchildsite) -row 0 -column 1 -columnspan 3 -sticky nsew
+ }
+
+ s {
+ grid $itk_component(swchildsite) -row 4 -column 1 -columnspan 3 -sticky nsew
+ }
+
+ e {
+ grid $itk_component(swchildsite) -row 1 -column 4 -rowspan 3 -sticky nsew
+ }
+
+ w {
+ grid $itk_component(swchildsite) -row 1 -column 0 -rowspan 3 -sticky nsew
+ }
+
+ default {
+ error "bad childsite option\
+ \"$itk_option(-childsitepos)\":\
+ should be n, e, s, or w"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: childsite
+#
+# Returns the path name of the child site widget.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledwidget::childsite {} {
+ return $itk_component(swchildsite)
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _vertScrollbarDisplay mode
+#
+# Displays the vertical scrollbar based on the input mode.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledwidget::_vertScrollbarDisplay {mode} {
+ switch $mode {
+ on {
+ set _vmode on
+
+ grid columnconfigure $_interior 2 -minsize \
+ [winfo pixels $_interior $itk_option(-scrollmargin)]
+ grid $itk_component(vertsb) -row 1 -column 3 -sticky ns
+ }
+
+ off {
+ set _vmode off
+
+ grid columnconfigure $_interior 2 -minsize 0
+ grid forget $itk_component(vertsb)
+ }
+
+ default {
+ error "invalid argument \"$mode\": should be on or off"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _horizScrollbarDisplay mode
+#
+# Displays the horizontal scrollbar based on the input mode.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledwidget::_horizScrollbarDisplay {mode} {
+ switch $mode {
+ on {
+ set _hmode on
+
+ grid rowconfigure $_interior 2 -minsize \
+ [winfo pixels $_interior $itk_option(-scrollmargin)]
+ grid $itk_component(horizsb) -row 3 -column 1 -sticky ew
+ }
+
+ off {
+ set _hmode off
+
+ grid rowconfigure $_interior 2 -minsize 0
+ grid forget $itk_component(horizsb)
+ }
+
+ default {
+ error "invalid argument \"$mode\": should be on or off"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _scrollWidget wid first last
+#
+# Performs scrolling and display of scrollbars based on the total
+# and maximum frame size as well as the current -vscrollmode and
+# -hscrollmode settings. Parameters are automatic scroll parameters.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledwidget::_scrollWidget {wid first last} {
+ $wid set $first $last
+
+ if {$wid == $itk_component(vertsb)} {
+ if {$itk_option(-vscrollmode) == "dynamic"} {
+ if {($_recheckVert != 1) && ($_vmode == "on")} {
+ return
+ } else {
+ set _recheckVert 0
+ }
+
+ if {($first == 0) && ($last == 1)} {
+ if {$_vmode != "off"} {
+ _vertScrollbarDisplay off
+ }
+
+ } else {
+ if {$_vmode != "on"} {
+ _vertScrollbarDisplay on
+ }
+ }
+ }
+
+ } elseif {$wid == $itk_component(horizsb)} {
+ if {$itk_option(-hscrollmode) == "dynamic"} {
+ if {($_recheckHoriz != 1) && ($_hmode == "on")} {
+ return
+ } else {
+ set _recheckHoriz 0
+ }
+
+ if {($first == 0) && ($last == 1)} {
+ if {$_hmode != "off"} {
+ _horizScrollbarDisplay off
+ }
+
+ } else {
+ if {$_hmode != "on"} {
+ _horizScrollbarDisplay on
+ }
+ }
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _configureEvent
+#
+# Resets the recheck flags which determine if we'll try and map
+# the scrollbars in dynamic mode.
+# ------------------------------------------------------------------
+body iwidgets::Scrolledwidget::_configureEvent {} {
+ update idletasks
+ set _recheckVert 1
+ set _recheckHoriz 1
+}
diff --git a/itcl/iwidgets3.0.0/generic/selectionbox.itk b/itcl/iwidgets3.0.0/generic/selectionbox.itk
new file mode 100644
index 00000000000..4e6d1fe5c4f
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/selectionbox.itk
@@ -0,0 +1,560 @@
+#
+# Selectionbox
+# ----------------------------------------------------------------------
+# Implements a selection box composed of a scrolled list of items and
+# a selection entry field. The user may choose any of the items displayed
+# in the scrolled list of alternatives and the selection field will be
+# filled with the choice. The user is also free to enter a new value in
+# the selection entry field. Both the list and entry areas have labels.
+# A child site is also provided in which the user may create other widgets
+# to be used in conjunction with the selection box.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Selectionbox {
+ keep -activebackground -activerelief -background -borderwidth -cursor \
+ -elementborderwidth -foreground -highlightcolor -highlightthickness \
+ -insertbackground -insertborderwidth -insertofftime -insertontime \
+ -insertwidth -jump -labelfont -selectbackground -selectborderwidth \
+ -selectforeground -textbackground -textfont -troughcolor
+}
+
+# ------------------------------------------------------------------
+# SELECTIONBOX
+# ------------------------------------------------------------------
+class iwidgets::Selectionbox {
+ inherit itk::Widget
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -childsitepos childSitePos Position center
+ itk_option define -margin margin Margin 7
+ itk_option define -itemson itemsOn ItemsOn true
+ itk_option define -selectionon selectionOn SelectionOn true
+ itk_option define -width width Width 260
+ itk_option define -height height Height 320
+
+ public method childsite {}
+ public method get {}
+ public method curselection {}
+ public method clear {component}
+ public method insert {component index args}
+ public method delete {first {last {}}}
+ public method size {}
+ public method scan {option args}
+ public method nearest {y}
+ public method index {index}
+ public method selection {option args}
+ public method selectitem {}
+
+ private method _packComponents {{when later}}
+
+ private variable _repacking {} ;# non-null => _packComponents pending
+}
+
+#
+# Provide a lowercased access method for the Selectionbox class.
+#
+proc ::iwidgets::selectionbox {pathName args} {
+ uplevel ::iwidgets::Selectionbox $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Selectionbox.itemsLabel Items widgetDefault
+option add *Selectionbox.selectionLabel Selection widgetDefault
+option add *Selectionbox.width 260 widgetDefault
+option add *Selectionbox.height 320 widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Selectionbox::constructor {args} {
+ #
+ # Set the borderwidth to zero and add width and height options
+ # back to the hull.
+ #
+ component hull configure -borderwidth 0
+ itk_option add hull.width hull.height
+
+ #
+ # Create the child site widget.
+ #
+ itk_component add -protected sbchildsite {
+ frame $itk_interior.sbchildsite
+ }
+
+ #
+ # Create the items list.
+ #
+ itk_component add items {
+ iwidgets::Scrolledlistbox $itk_interior.items -selectmode single \
+ -visibleitems 20x10 -labelpos nw -vscrollmode static \
+ -hscrollmode none
+ } {
+ usual
+ keep -dblclickcommand -exportselection
+
+ rename -labeltext -itemslabel itemsLabel Text
+ rename -selectioncommand -itemscommand itemsCommand Command
+ }
+ configure -itemscommand [code $this selectitem]
+
+ #
+ # Create the selection entry.
+ #
+ itk_component add selection {
+ iwidgets::Entryfield $itk_interior.selection -labelpos nw
+ } {
+ usual
+
+ keep -exportselection
+
+ rename -labeltext -selectionlabel selectionLabel Text
+ rename -command -selectioncommand selectionCommand Command
+ }
+
+ #
+ # Set the interior to the childsite for derived classes.
+ #
+ set itk_interior $itk_component(sbchildsite)
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+
+ #
+ # When idle, pack the components.
+ #
+ _packComponents
+}
+
+# ------------------------------------------------------------------
+# DESTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Selectionbox::destructor {} {
+ if {$_repacking != ""} {after cancel $_repacking}
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -childsitepos
+#
+# Specifies the position of the child site in the selection box.
+# ------------------------------------------------------------------
+configbody iwidgets::Selectionbox::childsitepos {
+ _packComponents
+}
+
+# ------------------------------------------------------------------
+# OPTION: -margin
+#
+# Specifies distance between the items list and selection entry.
+# ------------------------------------------------------------------
+configbody iwidgets::Selectionbox::margin {
+ _packComponents
+}
+
+# ------------------------------------------------------------------
+# OPTION: -itemson
+#
+# Specifies whether or not to display the items list.
+# ------------------------------------------------------------------
+configbody iwidgets::Selectionbox::itemson {
+ _packComponents
+}
+
+# ------------------------------------------------------------------
+# OPTION: -selectionon
+#
+# Specifies whether or not to display the selection entry widget.
+# ------------------------------------------------------------------
+configbody iwidgets::Selectionbox::selectionon {
+ _packComponents
+}
+
+# ------------------------------------------------------------------
+# OPTION: -width
+#
+# Specifies the width of the hull. The value may be specified in
+# any of the forms acceptable to Tk_GetPixels. A value of zero
+# causes the width to be adjusted to the required value based on
+# the size requests of the components. Otherwise, the width is
+# fixed.
+# ------------------------------------------------------------------
+configbody iwidgets::Selectionbox::width {
+ #
+ # The width option was added to the hull in the constructor.
+ # So, any width value given is passed automatically to the
+ # hull. All we have to do is play with the propagation.
+ #
+ if {$itk_option(-width) != 0} {
+ set propagate 0
+ } else {
+ set propagate 1
+ }
+
+ #
+ # Due to a bug in the tk4.2 grid, we have to check the
+ # propagation before setting it. Setting it to the same
+ # value it already is will cause it to toggle.
+ #
+ if {[grid propagate $itk_component(hull)] != $propagate} {
+ grid propagate $itk_component(hull) $propagate
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -height
+#
+# Specifies the height of the hull. The value may be specified in
+# any of the forms acceptable to Tk_GetPixels. A value of zero
+# causes the height to be adjusted to the required value based on
+# the size requests of the components. Otherwise, the height is
+# fixed.
+# ------------------------------------------------------------------
+configbody iwidgets::Selectionbox::height {
+ #
+ # The height option was added to the hull in the constructor.
+ # So, any height value given is passed automatically to the
+ # hull. All we have to do is play with the propagation.
+ #
+ if {$itk_option(-height) != 0} {
+ set propagate 0
+ } else {
+ set propagate 1
+ }
+
+ #
+ # Due to a bug in the tk4.2 grid, we have to check the
+ # propagation before setting it. Setting it to the same
+ # value it already is will cause it to toggle.
+ #
+ if {[grid propagate $itk_component(hull)] != $propagate} {
+ grid propagate $itk_component(hull) $propagate
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: childsite
+#
+# Returns the path name of the child site widget.
+# ------------------------------------------------------------------
+body iwidgets::Selectionbox::childsite {} {
+ return $itk_component(sbchildsite)
+}
+
+# ------------------------------------------------------------------
+# METHOD: get
+#
+# Returns the current selection.
+# ------------------------------------------------------------------
+body iwidgets::Selectionbox::get {} {
+ return [$itk_component(selection) get]
+}
+
+# ------------------------------------------------------------------
+# METHOD: curselection
+#
+# Returns the current selection index.
+# ------------------------------------------------------------------
+body iwidgets::Selectionbox::curselection {} {
+ return [$itk_component(items) curselection]
+}
+
+# ------------------------------------------------------------------
+# METHOD: clear component
+#
+# Delete the contents of either the selection entry widget or items
+# list.
+# ------------------------------------------------------------------
+body iwidgets::Selectionbox::clear {component} {
+ switch $component {
+ selection {
+ $itk_component(selection) clear
+ }
+
+ items {
+ delete 0 end
+ }
+
+ default {
+ error "bad clear argument \"$component\": should be\
+ selection or items"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: insert component index args
+#
+# Insert element(s) into either the selection or items list widget.
+# ------------------------------------------------------------------
+body iwidgets::Selectionbox::insert {component index args} {
+ switch $component {
+ selection {
+ eval $itk_component(selection) insert $index $args
+ }
+
+ items {
+ eval $itk_component(items) insert $index $args
+ }
+
+ default {
+ error "bad insert argument \"$component\": should be\
+ selection or items"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: delete first ?last?
+#
+# Delete one or more elements from the items list box. The default
+# is to delete by indexed range. If an item is to be removed by name,
+# it must be preceeded by the keyword "item". Only index numbers can
+# be used to delete a range of items.
+# ------------------------------------------------------------------
+body iwidgets::Selectionbox::delete {first {last {}}} {
+ set first [index $first]
+
+ if {$last != {}} {
+ set last [index $last]
+ } else {
+ set last $first
+ }
+
+ if {$first <= $last} {
+ eval $itk_component(items) delete $first $last
+ } else {
+ error "first index must not be greater than second"
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: size
+#
+# Returns a decimal string indicating the total number of elements
+# in the items list.
+# ------------------------------------------------------------------
+body iwidgets::Selectionbox::size {} {
+ return [$itk_component(items) size]
+}
+
+# ------------------------------------------------------------------
+# METHOD: scan option args
+#
+# Implements scanning on items list.
+# ------------------------------------------------------------------
+body iwidgets::Selectionbox::scan {option args} {
+ eval $itk_component(items) scan $option $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: nearest y
+#
+# Returns the index to the nearest listbox item given a y coordinate.
+# ------------------------------------------------------------------
+body iwidgets::Selectionbox::nearest {y} {
+ return [$itk_component(items) nearest $y]
+}
+
+# ------------------------------------------------------------------
+# METHOD: index index
+#
+# Returns the decimal string giving the integer index corresponding
+# to index.
+# ------------------------------------------------------------------
+body iwidgets::Selectionbox::index {index} {
+ return [$itk_component(items) index $index]
+}
+
+# ------------------------------------------------------------------
+# METHOD: selection option args
+#
+# Adjusts the selection within the items list.
+# ------------------------------------------------------------------
+body iwidgets::Selectionbox::selection {option args} {
+ eval $itk_component(items) selection $option $args
+
+ selectitem
+}
+
+# ------------------------------------------------------------------
+# METHOD: selectitem
+#
+# Replace the selection entry field contents with the currently
+# selected items value.
+# ------------------------------------------------------------------
+body iwidgets::Selectionbox::selectitem {} {
+ $itk_component(selection) clear
+ set numSelected [$itk_component(items) selecteditemcount]
+
+ if {$numSelected == 1} {
+ $itk_component(selection) insert end \
+ [$itk_component(items) getcurselection]
+ } elseif {$numSelected > 1} {
+ $itk_component(selection) insert end \
+ [lindex [$itk_component(items) getcurselection] 0]
+ }
+
+ $itk_component(selection) icursor end
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _packComponents ?when?
+#
+# Pack the selection, items, and child site widgets based on options.
+# If "when" is "now", the change is applied immediately. If it is
+# "later" or it is not specified, then the change is applied later,
+# when the application is idle.
+# ------------------------------------------------------------------
+body iwidgets::Selectionbox::_packComponents {{when later}} {
+ if {$when == "later"} {
+ if {$_repacking == ""} {
+ set _repacking [after idle [code $this _packComponents now]]
+ }
+ return
+ } elseif {$when != "now"} {
+ error "bad option \"$when\": should be now or later"
+ }
+
+ set _repacking ""
+
+ set parent [winfo parent $itk_component(sbchildsite)]
+ set margin [winfo pixels $itk_component(hull) $itk_option(-margin)]
+
+ switch $itk_option(-childsitepos) {
+ n {
+ grid $itk_component(sbchildsite) -row 0 -column 0 \
+ -sticky nsew -rowspan 1
+ grid $itk_component(items) -row 1 -column 0 -sticky nsew
+ grid $itk_component(selection) -row 3 -column 0 -sticky ew
+
+ grid rowconfigure $parent 0 -weight 0 -minsize 0
+ grid rowconfigure $parent 1 -weight 1 -minsize 0
+ grid rowconfigure $parent 2 -weight 0 -minsize $margin
+ grid rowconfigure $parent 3 -weight 0 -minsize 0
+
+ grid columnconfigure $parent 0 -weight 1 -minsize 0
+ grid columnconfigure $parent 1 -weight 0 -minsize 0
+ }
+
+ w {
+ grid $itk_component(sbchildsite) -row 0 -column 0 \
+ -sticky nsew -rowspan 3
+ grid $itk_component(items) -row 0 -column 1 -sticky nsew
+ grid $itk_component(selection) -row 2 -column 1 -sticky ew
+
+ grid rowconfigure $parent 0 -weight 1 -minsize 0
+ grid rowconfigure $parent 1 -weight 0 -minsize $margin
+ grid rowconfigure $parent 2 -weight 0 -minsize 0
+ grid rowconfigure $parent 3 -weight 0 -minsize 0
+
+ grid columnconfigure $parent 0 -weight 0 -minsize 0
+ grid columnconfigure $parent 1 -weight 1 -minsize 0
+ }
+
+ s {
+ grid $itk_component(items) -row 0 -column 0 -sticky nsew
+ grid $itk_component(selection) -row 2 -column 0 -sticky ew
+ grid $itk_component(sbchildsite) -row 3 -column 0 \
+ -sticky nsew -rowspan 1
+
+ grid rowconfigure $parent 0 -weight 1 -minsize 0
+ grid rowconfigure $parent 1 -weight 0 -minsize $margin
+ grid rowconfigure $parent 2 -weight 0 -minsize 0
+ grid rowconfigure $parent 3 -weight 0 -minsize 0
+
+ grid columnconfigure $parent 0 -weight 1 -minsize 0
+ grid columnconfigure $parent 1 -weight 0 -minsize 0
+ }
+
+ e {
+ grid $itk_component(items) -row 0 -column 0 -sticky nsew
+ grid $itk_component(selection) -row 2 -column 0 -sticky ew
+ grid $itk_component(sbchildsite) -row 0 -column 1 \
+ -sticky nsew -rowspan 3
+
+ grid rowconfigure $parent 0 -weight 1 -minsize 0
+ grid rowconfigure $parent 1 -weight 0 -minsize $margin
+ grid rowconfigure $parent 2 -weight 0 -minsize 0
+ grid rowconfigure $parent 3 -weight 0 -minsize 0
+
+ grid columnconfigure $parent 0 -weight 1 -minsize 0
+ grid columnconfigure $parent 1 -weight 0 -minsize 0
+ }
+
+ center {
+ grid $itk_component(items) -row 0 -column 0 -sticky nsew
+ grid $itk_component(sbchildsite) -row 1 -column 0 \
+ -sticky nsew -rowspan 1
+ grid $itk_component(selection) -row 3 -column 0 -sticky ew
+
+ grid rowconfigure $parent 0 -weight 1 -minsize 0
+ grid rowconfigure $parent 1 -weight 0 -minsize 0
+ grid rowconfigure $parent 2 -weight 0 -minsize $margin
+ grid rowconfigure $parent 3 -weight 0 -minsize 0
+
+ grid columnconfigure $parent 0 -weight 1 -minsize 0
+ grid columnconfigure $parent 1 -weight 0 -minsize 0
+ }
+
+ default {
+ error "bad childsitepos option \"$itk_option(-childsitepos)\":\
+ should be n, e, s, w, or center"
+ }
+ }
+
+ if {$itk_option(-itemson)} {
+ } else {
+ grid forget $itk_component(items)
+ }
+
+ if {$itk_option(-selectionon)} {
+ } else {
+ grid forget $itk_component(selection)
+ }
+
+ raise $itk_component(sbchildsite)
+}
+
diff --git a/itcl/iwidgets3.0.0/generic/selectiondialog.itk b/itcl/iwidgets3.0.0/generic/selectiondialog.itk
new file mode 100644
index 00000000000..d99e801feaf
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/selectiondialog.itk
@@ -0,0 +1,233 @@
+#
+# Selectiondialog
+# ----------------------------------------------------------------------
+# Implements a selection box similar to the OSF/Motif standard selection
+# dialog composite widget. The Selectiondialog is derived from the
+# Dialog class and is composed of a SelectionBox with attributes to
+# manipulate the dialog buttons.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Selectiondialog {
+ keep -activebackground -activerelief -background -borderwidth -cursor \
+ -elementborderwidth -foreground -highlightcolor -highlightthickness \
+ -insertbackground -insertborderwidth -insertofftime -insertontime \
+ -insertwidth -jump -labelfont -modality -selectbackground \
+ -selectborderwidth -selectforeground -textbackground -textfont \
+ -troughcolor
+}
+
+# ------------------------------------------------------------------
+# SELECTIONDIALOG
+# ------------------------------------------------------------------
+class iwidgets::Selectiondialog {
+ inherit iwidgets::Dialog
+
+ constructor {args} {}
+
+ public method childsite {}
+ public method get {}
+ public method curselection {}
+ public method clear {component}
+ public method insert {component index args}
+ public method delete {first {last {}}}
+ public method size {}
+ public method scan {option args}
+ public method nearest {y}
+ public method index {index}
+ public method selection {option args}
+ public method selectitem {}
+}
+
+#
+# Provide a lowercased access method for the Selectiondialog class.
+#
+proc ::iwidgets::selectiondialog {pathName args} {
+ uplevel ::iwidgets::Selectiondialog $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Selectiondialog.title "Selection Dialog" widgetDefault
+option add *Selectiondialog.master "." widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Selectiondialog::constructor {args} {
+ #
+ # Set the borderwidth to zero.
+ #
+ component hull configure -borderwidth 0
+
+ #
+ # Instantiate a selection box widget.
+ #
+ itk_component add selectionbox {
+ iwidgets::Selectionbox $itk_interior.selectionbox \
+ -dblclickcommand [code $this invoke]
+ } {
+ usual
+
+ keep -childsitepos -exportselection -itemscommand -itemslabel \
+ -itemson -selectionlabel -selectionon -selectioncommand
+ }
+ configure -itemscommand [code $this selectitem]
+
+ pack $itk_component(selectionbox) -fill both -expand yes
+ set itk_interior [$itk_component(selectionbox) childsite]
+
+ hide Help
+
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: childsite
+#
+# Thinwrapped method of selection box class.
+# ------------------------------------------------------------------
+body iwidgets::Selectiondialog::childsite {} {
+ return [$itk_component(selectionbox) childsite]
+}
+
+# ------------------------------------------------------------------
+# METHOD: get
+#
+# Thinwrapped method of selection box class.
+# ------------------------------------------------------------------
+body iwidgets::Selectiondialog::get {} {
+ return [$itk_component(selectionbox) get]
+}
+
+# ------------------------------------------------------------------
+# METHOD: curselection
+#
+# Thinwrapped method of selection box class.
+# ------------------------------------------------------------------
+body iwidgets::Selectiondialog::curselection {} {
+ return [$itk_component(selectionbox) curselection]
+}
+
+# ------------------------------------------------------------------
+# METHOD: clear component
+#
+# Thinwrapped method of selection box class.
+# ------------------------------------------------------------------
+body iwidgets::Selectiondialog::clear {component} {
+ $itk_component(selectionbox) clear $component
+
+ return
+}
+
+# ------------------------------------------------------------------
+# METHOD: insert component index args
+#
+# Thinwrapped method of selection box class.
+# ------------------------------------------------------------------
+body iwidgets::Selectiondialog::insert {component index args} {
+ eval $itk_component(selectionbox) insert $component $index $args
+
+ return
+}
+
+# ------------------------------------------------------------------
+# METHOD: delete first ?last?
+#
+# Thinwrapped method of selection box class.
+# ------------------------------------------------------------------
+body iwidgets::Selectiondialog::delete {first {last {}}} {
+ $itk_component(selectionbox) delete $first $last
+
+ return
+}
+
+# ------------------------------------------------------------------
+# METHOD: size
+#
+# Thinwrapped method of selection box class.
+# ------------------------------------------------------------------
+body iwidgets::Selectiondialog::size {} {
+ return [$itk_component(selectionbox) size]
+}
+
+# ------------------------------------------------------------------
+# METHOD: scan option args
+#
+# Thinwrapped method of selection box class.
+# ------------------------------------------------------------------
+body iwidgets::Selectiondialog::scan {option args} {
+ return [eval $itk_component(selectionbox) scan $option $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: nearest y
+#
+# Thinwrapped method of selection box class.
+# ------------------------------------------------------------------
+body iwidgets::Selectiondialog::nearest {y} {
+ return [$itk_component(selectionbox) nearest $y]
+}
+
+# ------------------------------------------------------------------
+# METHOD: index index
+#
+# Thinwrapped method of selection box class.
+# ------------------------------------------------------------------
+body iwidgets::Selectiondialog::index {index} {
+ return [$itk_component(selectionbox) index $index]
+}
+
+# ------------------------------------------------------------------
+# METHOD: selection option args
+#
+# Thinwrapped method of selection box class.
+# ------------------------------------------------------------------
+body iwidgets::Selectiondialog::selection {option args} {
+ eval $itk_component(selectionbox) selection $option $args
+}
+
+# ------------------------------------------------------------------
+# METHOD: selectitem
+#
+# Set the default button to ok and select the item.
+# ------------------------------------------------------------------
+body iwidgets::Selectiondialog::selectitem {} {
+ default OK
+ $itk_component(selectionbox) selectitem
+}
+
diff --git a/itcl/iwidgets3.0.0/generic/shell.itk b/itcl/iwidgets3.0.0/generic/shell.itk
new file mode 100644
index 00000000000..05a91e4f079
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/shell.itk
@@ -0,0 +1,371 @@
+# Shell
+# ----------------------------------------------------------------------
+# This class is implements a shell which is a top level widget
+# giving a childsite and providing activate, deactivate, and center
+# methods.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
+# Kris Raney EMAIL: kraney@spd.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1996 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Shell {
+ keep -background -cursor -modality
+}
+
+# ------------------------------------------------------------------
+# SHELL
+# ------------------------------------------------------------------
+class iwidgets::Shell {
+ inherit itk::Toplevel
+
+ constructor {args} {}
+
+ itk_option define -master master Window ""
+ itk_option define -modality modality Modality none
+ itk_option define -padx padX Pad 0
+ itk_option define -pady padY Pad 0
+ itk_option define -width width Width 0
+ itk_option define -height height Height 0
+
+ public method childsite {}
+ public method activate {}
+ public method deactivate {args}
+ public method center {{widget {}}}
+
+ private variable _result {} ;# Resultant value for modal activation.
+ private variable _busied {} ;# List of busied top level widgets.
+
+ common grabstack {}
+ common _wait
+}
+
+#
+# Provide a lowercased access method for the Shell class.
+#
+proc ::iwidgets::shell {pathName args} {
+ uplevel ::iwidgets::Shell $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Shell::constructor {args} {
+ itk_option add hull.width hull.height
+
+ #
+ # Maintain a withdrawn state until activated.
+ #
+ wm withdraw $itk_component(hull)
+
+ #
+ # Create the user child site
+ #
+ itk_component add -protected shellchildsite {
+ frame $itk_interior.shellchildsite
+ }
+ pack $itk_component(shellchildsite) -fill both -expand yes
+
+ #
+ # Set the itk_interior variable to be the childsite for derived
+ # classes.
+ #
+ set itk_interior $itk_component(shellchildsite)
+
+ #
+ # Bind the window manager delete protocol to deactivation of the
+ # widget. This can be overridden by the user via the execution
+ # of a similar command outside the class.
+ #
+ wm protocol $itk_component(hull) WM_DELETE_WINDOW [code $this deactivate]
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -master
+#
+# Specifies the master window for the shell. The window manager is
+# informed that the shell is a transient window whose master is
+# -masterwindow.
+# ------------------------------------------------------------------
+configbody iwidgets::Shell::master {}
+
+# ------------------------------------------------------------------
+# OPTION: -modality
+#
+# Specify the modality of the dialog.
+# ------------------------------------------------------------------
+configbody iwidgets::Shell::modality {
+ switch $itk_option(-modality) {
+ none -
+ application -
+ global {
+ }
+
+ default {
+ error "bad modality option \"$itk_option(-modality)\":\
+ should be none, application, or global"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -padx
+#
+# Specifies a padding distance for the childsite in the X-direction.
+# ------------------------------------------------------------------
+configbody iwidgets::Shell::padx {
+ pack config $itk_component(shellchildsite) -padx $itk_option(-padx)
+}
+
+# ------------------------------------------------------------------
+# OPTION: -pady
+#
+# Specifies a padding distance for the childsite in the Y-direction.
+# ------------------------------------------------------------------
+configbody iwidgets::Shell::pady {
+ pack config $itk_component(shellchildsite) -pady $itk_option(-pady)
+}
+
+# ------------------------------------------------------------------
+# OPTION: -width
+#
+# Specifies the width of the shell. The value may be specified in
+# any of the forms acceptable to Tk_GetPixels. A value of zero
+# causes the width to be adjusted to the required value based on
+# the size requests of the components placed in the childsite.
+# Otherwise, the width is fixed.
+# ------------------------------------------------------------------
+configbody iwidgets::Shell::width {
+ #
+ # The width option was added to the hull in the constructor.
+ # So, any width value given is passed automatically to the
+ # hull. All we have to do is play with the propagation.
+ #
+ if {$itk_option(-width) != 0} {
+ pack propagate $itk_component(hull) no
+ } else {
+ pack propagate $itk_component(hull) yes
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -height
+#
+# Specifies the height of the shell. The value may be specified in
+# any of the forms acceptable to Tk_GetPixels. A value of zero
+# causes the height to be adjusted to the required value based on
+# the size requests of the components placed in the childsite.
+# Otherwise, the height is fixed.
+# ------------------------------------------------------------------
+configbody iwidgets::Shell::height {
+ #
+ # The height option was added to the hull in the constructor.
+ # So, any height value given is passed automatically to the
+ # hull. All we have to do is play with the propagation.
+ #
+ if {$itk_option(-height) != 0} {
+ pack propagate $itk_component(hull) no
+ } else {
+ pack propagate $itk_component(hull) yes
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: childsite
+#
+# Return the pathname of the user accessible area.
+# ------------------------------------------------------------------
+body iwidgets::Shell::childsite {} {
+ return $itk_component(shellchildsite)
+}
+
+# ------------------------------------------------------------------
+# METHOD: activate
+#
+# Display the dialog and wait based on the modality. For application
+# and global modal activations, perform a grab operation, and wait
+# for the result. The result may be returned via an argument to the
+# "deactivate" method.
+# ------------------------------------------------------------------
+body iwidgets::Shell::activate {} {
+
+ if {[winfo ismapped $itk_component(hull)]} {
+ raise $itk_component(hull)
+ return
+ }
+
+ if {($itk_option(-master) != {}) && \
+ [winfo exists $itk_option(-master)]} {
+ wm transient $itk_component(hull) $itk_option(-master)
+ }
+
+ set _wait($this) 0
+ wm deiconify $itk_component(hull)
+ raise $itk_component(hull)
+ tkwait visibility $itk_component(hull)
+
+ if {$itk_option(-modality) == "application"} {
+ if {$grabstack != {}} {
+ grab release [lindex $grabstack end]
+ }
+
+ set err 1
+ while {$err == 1} {
+ set err [catch [list grab $itk_component(hull)]]
+ if {$err == 1} {
+ after 1000
+ }
+ }
+
+ lappend grabstack [list grab $itk_component(hull)]
+
+ tkwait variable [scope _wait($this)]
+ return $_result
+
+ } elseif {$itk_option(-modality) == "global" } {
+ if {$grabstack != {}} {
+ grab release [lindex $grabstack end]
+ }
+
+ set err 1
+ while {$err == 1} {
+ set err [catch [list grab -global $itk_component(hull)]]
+ if {$err == 1} {
+ after 1000
+ }
+ }
+
+ lappend grabstack [list grab -global $itk_component(hull)]
+
+ tkwait variable [scope _wait($this)]
+ return $_result
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: deactivate
+#
+# Deactivate the display of the dialog. The method takes an optional
+# argument to passed to the "activate" method which returns the value.
+# This is only effective for application and global modal dialogs.
+# ------------------------------------------------------------------
+body iwidgets::Shell::deactivate {args} {
+
+ if {! [winfo ismapped $itk_component(hull)]} {
+ return
+ }
+
+ if {$itk_option(-modality) == "none"} {
+ wm withdraw $itk_component(hull)
+ } elseif {$itk_option(-modality) == "application"} {
+ grab release $itk_component(hull)
+ if {$grabstack != {}} {
+ if {[set grabstack [lreplace $grabstack end end]] != {}} {
+ eval [lindex $grabstack end]
+ }
+ }
+
+ wm withdraw $itk_component(hull)
+
+ } elseif {$itk_option(-modality) == "global"} {
+ grab release $itk_component(hull)
+ if {$grabstack != {}} {
+ if {[set grabstack [lreplace $grabstack end end]] != {}} {
+ eval [lindex $grabstack end]
+ }
+ }
+
+ wm withdraw $itk_component(hull)
+ }
+
+ if {[llength $args]} {
+ set _result $args
+ } else {
+ set _result {}
+ }
+
+ set _wait($this) 1
+ return
+}
+
+# ------------------------------------------------------------------
+# METHOD: center
+#
+# Centers the dialog with respect to another widget or the screen
+# as a whole.
+# ------------------------------------------------------------------
+body iwidgets::Shell::center {{widget {}}} {
+ update idletasks
+
+ set hull $itk_component(hull)
+ set w [winfo reqwidth $hull]
+ set h [winfo reqheight $hull]
+ set sh [winfo screenheight $hull] ;# display screen's height/width
+ set sw [winfo screenwidth $hull]
+
+ #
+ # User can request it centered with respect to root by passing in '{}'
+ #
+ if { $widget == "" } {
+ set reqX [expr {($sw-$w)/2}]
+ set reqY [expr {($sh-$h)/2}]
+ } else {
+ set wfudge 5 ;# wm width fudge factor
+ set hfudge 20 ;# wm height fudge factor
+ set widgetW [winfo width $widget]
+ set widgetH [winfo height $widget]
+ set reqX [expr [winfo rootx $widget]+($widgetW-($widgetW/2))-($w/2)]
+ set reqY [expr [winfo rooty $widget]+($widgetH-($widgetH/2))-($h/2)]
+
+ #
+ # Adjust for errors - if too long or too tall
+ #
+ if { [expr $reqX+$w+$wfudge] > $sw } { set reqX [expr $sw-$w-$wfudge] }
+ if { $reqX < $wfudge } { set reqX $wfudge }
+ if { [expr $reqY+$h+$hfudge] > $sh } { set reqY [expr $sh-$h-$hfudge] }
+ if { $reqY < $hfudge } { set reqY $hfudge }
+ }
+
+ wm geometry $hull +$reqX+$reqY
+}
+
diff --git a/itcl/iwidgets3.0.0/generic/spindate.itk b/itcl/iwidgets3.0.0/generic/spindate.itk
new file mode 100644
index 00000000000..0d9cda138ac
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/spindate.itk
@@ -0,0 +1,700 @@
+# Spindate
+# ----------------------------------------------------------------------
+# Implements a Date spinner widget. A date spinner contains three
+# Spinner widgets: one Spinner for months, one SpinInt for days,
+# and one SpinInt for years. Months can be specified as abbreviated
+# strings, integers or a user-defined list. Options exist to manage to
+# behavior, appearance, and format of each component spinner.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Sue Yockey EMAIL: yockey@actc.com
+# Mark L. Ulferts mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1997 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Default resources.
+#
+option add *Spindate.monthLabel "Month" widgetDefault
+option add *Spindate.dayLabel "Day" widgetDefault
+option add *Spindate.yearLabel "Year" widgetDefault
+option add *Spindate.monthWidth 4 widgetDefault
+option add *Spindate.dayWidth 4 widgetDefault
+option add *Spindate.yearWidth 4 widgetDefault
+
+#
+# Usual options.
+#
+itk::usual Spindate {
+ keep -background -cursor -foreground -labelfont -textbackground -textfont
+}
+
+# ------------------------------------------------------------------
+# SPINDATE
+# ------------------------------------------------------------------
+class iwidgets::Spindate {
+ inherit itk::Widget
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -labelpos labelPos Position w
+ itk_option define -orient orient Orient vertical
+ itk_option define -monthon monthOn MonthOn true
+ itk_option define -dayon dayOn DayOn true
+ itk_option define -yearon yearOn YearOn true
+ itk_option define -datemargin dateMargin Margin 1
+ itk_option define -yeardigits yearDigits YearDigits 4
+ itk_option define -monthformat monthFormat MonthFormat integer
+
+ public {
+ method get {{format "-string"}}
+ method show {{date now}}
+ }
+
+ protected {
+ method _packDate {{when later}}
+ variable _repack {} ;# Reconfiguration flag.
+ }
+
+ private {
+ method _lastDay {month year}
+ method _spinMonth {direction}
+ method _spinDay {direction}
+
+ variable _monthFormatStr "%m"
+ variable _yearFormatStr "%Y"
+ variable _interior
+ }
+}
+
+#
+# Provide a lowercased access method for the Spindate class.
+#
+proc ::iwidgets::spindate {pathName args} {
+ uplevel ::iwidgets::Spindate $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Spindate::constructor {args} {
+ set _interior $itk_interior
+
+ set clicks [clock seconds]
+
+ #
+ # Create Month Spinner
+ #
+ itk_component add month {
+ iwidgets::Spinner $itk_interior.month -fixed 2 -justify right \
+ -decrement [code $this _spinMonth -1] \
+ -increment [code $this _spinMonth 1]
+ } {
+ keep -background -cursor -arroworient -foreground \
+ -labelfont -labelmargin -relief -textbackground \
+ -textfont -repeatdelay -repeatinterval
+
+ rename -labeltext -monthlabel monthLabel Text
+ rename -width -monthwidth monthWidth Width
+ }
+
+ #
+ # Take off the default bindings for selction and motion.
+ #
+ bind [$itk_component(month) component entry] <1> {break}
+ bind [$itk_component(month) component entry] <Button1-Motion> {break}
+
+ #
+ # Create Day Spinner
+ #
+ itk_component add day {
+ iwidgets::Spinint $itk_interior.day -fixed 2 -justify right \
+ -decrement [code $this _spinDay -1] \
+ -increment [code $this _spinDay 1]
+ } {
+ keep -background -cursor -arroworient -foreground \
+ -labelfont -labelmargin -relief -textbackground \
+ -textfont -repeatdelay -repeatinterval
+
+ rename -labeltext -daylabel dayLabel Text
+ rename -width -daywidth dayWidth Width
+ }
+
+ #
+ # Take off the default bindings for selction and motion.
+ #
+ bind [$itk_component(day) component entry] <1> {break}
+ bind [$itk_component(day) component entry] <Button1-Motion> {break}
+
+ #
+ # Create Year Spinner
+ #
+ itk_component add year {
+ iwidgets::Spinint $itk_interior.year -fixed 2 -justify right \
+ -range {1900 3000}
+ } {
+ keep -background -cursor -arroworient -foreground \
+ -labelfont -labelmargin -relief -textbackground \
+ -textfont -repeatdelay -repeatinterval
+
+ rename -labeltext -yearlabel yearLabel Text
+ rename -width -yearwidth yearWidth Width
+ }
+
+ #
+ # Take off the default bindings for selction and motion.
+ #
+ bind [$itk_component(year) component entry] <1> {break}
+ bind [$itk_component(year) component entry] <Button1-Motion> {break}
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+
+ #
+ # Show the current date.
+ #
+ show now
+}
+
+# ------------------------------------------------------------------
+# DESTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Spindate::destructor {} {
+ if {$_repack != ""} {after cancel $_repack}
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -labelpos
+#
+# Specifies the location of all 3 spinners' labels.
+# ------------------------------------------------------------------
+configbody iwidgets::Spindate::labelpos {
+ switch $itk_option(-labelpos) {
+ n {
+ $itk_component(month) configure -labelpos n
+ $itk_component(day) configure -labelpos n
+ $itk_component(year) configure -labelpos n
+
+ #
+ # Un-align labels
+ #
+ $itk_component(month) configure -labelmargin 1
+ $itk_component(day) configure -labelmargin 1
+ $itk_component(year) configure -labelmargin 1
+ }
+
+ s {
+ $itk_component(month) configure -labelpos s
+ $itk_component(day) configure -labelpos s
+ $itk_component(year) configure -labelpos s
+
+ #
+ # Un-align labels
+ #
+ $itk_component(month) configure -labelmargin 1
+ $itk_component(day) configure -labelmargin 1
+ $itk_component(year) configure -labelmargin 1
+ }
+
+ w {
+ $itk_component(month) configure -labelpos w
+ $itk_component(day) configure -labelpos w
+ $itk_component(year) configure -labelpos w
+ }
+
+ e {
+ $itk_component(month) configure -labelpos e
+ $itk_component(day) configure -labelpos e
+ $itk_component(year) configure -labelpos e
+
+ #
+ # Un-align labels
+ #
+ $itk_component(month) configure -labelmargin 1
+ $itk_component(day) configure -labelmargin 1
+ $itk_component(year) configure -labelmargin 1
+ }
+
+ default {
+ error "bad labelpos option \"$itk_option(-labelpos)\",\
+ should be n, s, w or e"
+ }
+ }
+
+ _packDate
+}
+
+# ------------------------------------------------------------------
+# OPTION: -orient
+#
+# Specifies the orientation of the 3 spinners for Month, Day
+# and year.
+# ------------------------------------------------------------------
+configbody iwidgets::Spindate::orient {
+ _packDate
+}
+
+# ------------------------------------------------------------------
+# OPTION: -monthon
+#
+# Specifies whether or not to display the month spinner.
+# ------------------------------------------------------------------
+configbody iwidgets::Spindate::monthon {
+ _packDate
+}
+
+# ------------------------------------------------------------------
+# OPTION: -dayon
+#
+# Specifies whether or not to display the day spinner.
+# ------------------------------------------------------------------
+configbody iwidgets::Spindate::dayon {
+ _packDate
+}
+
+# ------------------------------------------------------------------
+# OPTION: -yearon
+#
+# Specifies whether or not to display the year spinner.
+# ------------------------------------------------------------------
+configbody iwidgets::Spindate::yearon {
+ _packDate
+}
+
+# ------------------------------------------------------------------
+# OPTION: -datemargin
+#
+# Specifies the margin space between the month and day spinners
+# and the day and year spinners.
+# ------------------------------------------------------------------
+configbody iwidgets::Spindate::datemargin {
+ _packDate
+}
+
+# ------------------------------------------------------------------
+# OPTION: -yeardigits
+#
+# Number of digits for year display, 2 or 4
+# ------------------------------------------------------------------
+configbody iwidgets::Spindate::yeardigits {
+ set clicks [clock seconds]
+
+ switch $itk_option(-yeardigits) {
+ "2" {
+ $itk_component(year) configure -width 2 -fixed 2
+ $itk_component(year) clear
+ $itk_component(year) insert 0 [clock format $clicks -format "%y"]
+ set _yearFormatStr "%y"
+ }
+
+ "4" {
+ $itk_component(year) configure -width 4 -fixed 4
+ $itk_component(year) clear
+ $itk_component(year) insert 0 [clock format $clicks -format "%Y"]
+ set _yearFormatStr "%Y"
+ }
+
+ default {
+ error "bad yeardigits option \"$itk_option(-yeardigits)\",\
+ should be 2 or 4"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -monthformat
+#
+# Format of month display, integers (1-12) or brief strings (Jan -
+# Dec), or full strings (January - December).
+# ------------------------------------------------------------------
+configbody iwidgets::Spindate::monthformat {
+ set clicks [clock seconds]
+
+ if {$itk_option(-monthformat) == "brief"} {
+ $itk_component(month) configure -width 3 -fixed 3
+ $itk_component(month) delete 0 end
+ $itk_component(month) insert 0 [clock format $clicks -format "%b"]
+ set _monthFormatStr "%b"
+
+ } elseif {$itk_option(-monthformat) == "full"} {
+ $itk_component(month) configure -width 9 -fixed 9
+ $itk_component(month) delete 0 end
+ $itk_component(month) insert 0 [clock format $clicks -format "%B"]
+ set _monthFormatStr "%B"
+
+ } elseif {$itk_option(-monthformat) == "integer"} {
+ $itk_component(month) configure -width 2 -fixed 2
+ $itk_component(month) delete 0 end
+ $itk_component(month) insert 0 [clock format $clicks -format "%m"]
+ set _monthFormatStr "%m"
+
+ } else {
+ error "bad monthformat option\
+ \"$itk_option(-monthformat)\", should be\
+ \"integer\", \"brief\" or \"full\""
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: get ?format?
+#
+# Return the current contents of the spindate widget in one of
+# two formats string or as an integer clock value using the -string
+# and -clicks options respectively. The default is by string.
+# Reference the clock command for more information on obtaining dates
+# and their formats.
+# ------------------------------------------------------------------
+body iwidgets::Spindate::get {{format "-string"}} {
+ set month [$itk_component(month) get]
+ set day [$itk_component(day) get]
+ set year [$itk_component(year) get]
+
+ if {[regexp {[0-9]+} $month]} {
+ set datestr "$month/$day/$year"
+ } else {
+ set datestr "$day $month $year"
+ }
+
+ switch -- $format {
+ "-string" {
+ return $datestr
+ }
+ "-clicks" {
+ return [clock scan $datestr]
+ }
+ default {
+ error "bad format option \"$format\":\
+ should be -string or -clicks"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: show date
+#
+# Changes the currently displayed date to be that of the date
+# argument. The date may be specified either as a string or an
+# integer clock value. Reference the clock command for more
+# information on obtaining dates and their formats.
+# ------------------------------------------------------------------
+body iwidgets::Spindate::show {{date "now"}} {
+ #
+ # Convert the date to a clock clicks value.
+ #
+ if {$date == "now"} {
+ set seconds [clock seconds]
+ } else {
+ if {[catch {clock format $date}] == 0} {
+ set seconds $date
+ } elseif {[catch {set seconds [clock scan $date]}] != 0} {
+ error "bad date: \"$date\", must be a valid date\
+ string, clock clicks value or the keyword now"
+ }
+ }
+
+ #
+ # Display the month based on the -monthformat option.
+ #
+ switch $itk_option(-monthformat) {
+ "brief" {
+ $itk_component(month) delete 0 end
+ $itk_component(month) insert 0 [clock format $seconds -format "%b"]
+ }
+ "full" {
+ $itk_component(month) delete 0 end
+ $itk_component(month) insert 0 [clock format $seconds -format "%B"]
+ }
+ "integer" {
+ $itk_component(month) delete 0 end
+ $itk_component(month) insert 0 [clock format $seconds -format "%m"]
+ }
+ }
+
+ #
+ # Display the day.
+ #
+ $itk_component(day) delete 0 end
+ $itk_component(day) insert end [clock format $seconds -format "%d"]
+
+ #
+ # Display the year based on the -yeardigits option.
+ #
+ switch $itk_option(-yeardigits) {
+ "2" {
+ $itk_component(year) delete 0 end
+ $itk_component(year) insert 0 [clock format $seconds -format "%y"]
+ }
+
+ "4" {
+ $itk_component(year) delete 0 end
+ $itk_component(year) insert 0 [clock format $seconds -format "%Y"]
+ }
+ }
+
+ return
+}
+
+# ----------------------------------------------------------------
+# PRIVATE METHOD: _spinMonth direction
+#
+# Increment or decrement month value. We need to get the values
+# for all three fields so we can make sure the day agrees with
+# the month. Should the current day be greater than the day for
+# the spun month, then the day is set to the last day for the
+# new month.
+# ----------------------------------------------------------------
+body iwidgets::Spindate::_spinMonth {direction} {
+ set month [$itk_component(month) get]
+ set day [$itk_component(day) get]
+ set year [$itk_component(year) get]
+
+ #
+ # There appears to be a bug in the Tcl clock command in that it
+ # can't scan a date like "12/31/1999 1 month" or any other date with
+ # a year above 2000, but it has no problem scanning "07/01/1998 1 month".
+ # So, we're going to play a game and increment by days until this
+ # is fixed in Tcl.
+ #
+ if {$direction == 1} {
+ set incrdays 32
+ set day 01
+ } else {
+ set incrdays -28
+ set day 28
+ }
+
+ if {[regexp {[0-9]+} $month]} {
+ set clicks [clock scan "$month/$day/$year $incrdays day"]
+ } else {
+ set clicks [clock scan "$day $month $year $incrdays day"]
+ }
+
+ $itk_component(month) clear
+ $itk_component(month) insert 0 \
+ [clock format $clicks -format $_monthFormatStr]
+
+ set lastday [_lastDay [$itk_component(month) get] $year]
+
+ if {$day > $lastday} {
+ $itk_component(day) clear
+ $itk_component(day) insert end $lastday
+ }
+}
+
+# ----------------------------------------------------------------
+# PRIVATE METHOD: _spinDay direction
+#
+# Increment or decrement day value. If the previous day was the
+# first, then set the new day to the last day for the current
+# month. If it was the last day of the month, change it to the
+# first. Otherwise, spin it to the next day.
+# ----------------------------------------------------------------
+body iwidgets::Spindate::_spinDay {direction} {
+ set month [$itk_component(month) get]
+ set day [$itk_component(day) get]
+ set year [$itk_component(year) get]
+ set lastday [_lastDay $month $year]
+ set currclicks [get -clicks]
+
+ $itk_component(day) delete 0 end
+
+ if {(($day == "01") || ($day == "1")) && ($direction == -1)} {
+ $itk_component(day) insert 0 $lastday
+ return
+ }
+
+ if {($day == $lastday) && ($direction == 1)} {
+ $itk_component(day) insert 0 "01"
+ return
+ }
+
+ set clicks [clock scan "$direction day" -base $currclicks]
+ $itk_component(day) insert 0 [clock format $clicks -format "%d"]
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _packDate when
+#
+# Pack the components of the date spinner. If "when" is "now", the
+# change is applied immediately. If it is "later" or it is not
+# specified, then the change is applied later, when the application
+# is idle.
+# ------------------------------------------------------------------
+body iwidgets::Spindate::_packDate {{when later}} {
+ if {$when == "later"} {
+ if {$_repack == ""} {
+ set _repack [after idle [code $this _packDate now]]
+ }
+ return
+ } elseif {$when != "now"} {
+ error "bad option \"$when\": should be now or later"
+ }
+
+ #
+ # Turn off the minsizes for all the rows and columns.
+ #
+ for {set i 0} {$i < 5} {incr i} {
+ grid rowconfigure $_interior $i -minsize 0
+ grid columnconfigure $_interior $i -minsize 0
+ }
+
+ #
+ # Get some boolean 1/0 values for the -monthon and -dayon options.
+ # We need this later so that Tcl doesn't complain about operands
+ # of || being strings.
+ #
+ set monthon [expr {$itk_option(-monthon) == "1"}]
+ set dayon [expr {$itk_option(-dayon) == "1"}]
+
+ set _repack ""
+
+ #
+ # Based on the orientation, use the grid to place the components into
+ # the proper rows and columns.
+ #
+ switch $itk_option(-orient) {
+ vertical {
+ set row -1
+
+ if {$itk_option(-monthon)} {
+ grid $itk_component(month) -row [incr row] -column 0 \
+ -sticky nsew
+ } else {
+ grid forget $itk_component(month)
+ }
+
+ if {$itk_option(-dayon)} {
+ if {$itk_option(-dayon)} {
+ grid rowconfigure $_interior [incr row] \
+ -minsize $itk_option(-datemargin)
+ }
+
+ grid $itk_component(day) -row [incr row] -column 0 \
+ -sticky nsew
+ } else {
+ grid forget $itk_component(day)
+ }
+
+ if {$itk_option(-yearon)} {
+ if {$monthon || $dayon} {
+ grid rowconfigure $_interior [incr row] \
+ -minsize $itk_option(-datemargin)
+ }
+
+ grid $itk_component(year) -row [incr row] -column 0 \
+ -sticky nsew
+ } else {
+ grid forget $itk_component(year)
+ }
+
+ if {$itk_option(-labelpos) == "w"} {
+ iwidgets::Labeledwidget::alignlabels $itk_component(month) \
+ $itk_component(day) $itk_component(year)
+ }
+ }
+
+ horizontal {
+ set column -1
+
+ if {$itk_option(-monthon)} {
+ grid $itk_component(month) -row 0 -column [incr column] \
+ -sticky nsew
+ } else {
+ grid forget $itk_component(month)
+ }
+
+ if {$itk_option(-dayon)} {
+ if {$itk_option(-monthon)} {
+ grid columnconfigure $_interior [incr column] \
+ -minsize $itk_option(-datemargin)
+ }
+
+ grid $itk_component(day) -row 0 -column [incr column] \
+ -sticky nsew
+ } else {
+ grid forget $itk_component(day)
+ }
+
+ if {$itk_option(-yearon)} {
+ if {$monthon || $dayon} {
+ grid columnconfigure $_interior [incr column] \
+ -minsize $itk_option(-datemargin)
+ }
+
+ grid $itk_component(year) -row 0 -column [incr column] \
+ -sticky nsew
+ } else {
+ grid forget $itk_component(year)
+ }
+
+ #
+ # Un-align labels.
+ #
+ $itk_component(month) configure -labelmargin 1
+ $itk_component(day) configure -labelmargin 1
+ $itk_component(year) configure -labelmargin 1
+ }
+
+ default {
+ error "bad orient option \"$itk_option(-orient)\", should\
+ be \"vertical\" or \"horizontal\""
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _lastDay month year
+#
+# Internal method which determines the last day of the month for
+# the given month and year. We start at 28 and go forward till
+# we fail. Crude but effective.
+# ------------------------------------------------------------------
+body iwidgets::Spindate::_lastDay {month year} {
+ set lastone 28
+
+ for {set lastone 28} {$lastone < 32} {incr lastone} {
+ if {[regexp {[0-9]+} $month]} {
+ if {[catch {clock scan "$month/[expr $lastone + 1]/$year"}] != 0} {
+ return $lastone
+ }
+ } else {
+ if {[catch {clock scan "[expr $lastone + 1] $month $year"}] != 0} {
+ return $lastone
+ }
+ }
+ }
+}
diff --git a/itcl/iwidgets3.0.0/generic/spinint.itk b/itcl/iwidgets3.0.0/generic/spinint.itk
new file mode 100644
index 00000000000..2c3310394da
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/spinint.itk
@@ -0,0 +1,275 @@
+# Spinint
+# ----------------------------------------------------------------------
+# Implements an integer spinner widget. It inherits basic spinner
+# functionality from Spinner and adds specific features to create
+# an integer-only spinner.
+# Arrows may be placed horizontally or vertically.
+# User may specify an integer range and step value.
+# Spinner may be configured to wrap when min or max value is reached.
+#
+# NOTE:
+# Spinint integer values should not exceed the size of a long integer.
+# For a 32 bit long the integer range is -2147483648 to 2147483647.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Sue Yockey Phone: (214) 519-2517
+# E-mail: syockey@spd.dsccc.com
+# yockey@acm.org
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Spinint {
+ keep -background -borderwidth -cursor -foreground -highlightcolor \
+ -highlightthickness -insertbackground -insertborderwidth \
+ -insertofftime -insertontime -insertwidth -labelfont \
+ -selectbackground -selectborderwidth -selectforeground \
+ -textbackground -textfont
+}
+
+# ------------------------------------------------------------------
+# SPININT
+# ------------------------------------------------------------------
+class iwidgets::Spinint {
+ inherit iwidgets::Spinner
+
+ constructor {args} {
+ Spinner::constructor -validate numeric
+ } {}
+
+ itk_option define -range range Range ""
+ itk_option define -step step Step 1
+ itk_option define -wrap wrap Wrap true
+
+ public method up {}
+ public method down {}
+}
+
+#
+# Provide a lowercased access method for the Spinint class.
+#
+proc ::iwidgets::spinint {pathName args} {
+ uplevel ::iwidgets::Spinint $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Spinint::constructor {args} {
+ eval itk_initialize $args
+
+ $itk_component(entry) delete 0 end
+
+ if {[lindex $itk_option(-range) 0] == ""} {
+ $itk_component(entry) insert 0 "0"
+ } else {
+ $itk_component(entry) insert 0 [lindex $itk_option(-range) 0]
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -range
+#
+# Set min and max values for spinner.
+# ------------------------------------------------------------------
+configbody iwidgets::Spinint::range {
+ if {$itk_option(-range) != ""} {
+ if {[llength $itk_option(-range)] != 2} {
+ error "wrong # args: should be\
+ \"$itk_component(hull) configure -range {begin end}\""
+ }
+
+ set min [lindex $itk_option(-range) 0]
+ set max [lindex $itk_option(-range) 1]
+
+ if {![regexp {^-?[0-9]+$} $min]} {
+ error "bad range option \"$min\": begin value must be\
+ an integer"
+ }
+ if {![regexp {^-?[0-9]+$} $max]} {
+ error "bad range option \"$max\": end value must be\
+ an integer"
+ }
+ if {$min > $max} {
+ error "bad option starting range \"$min\": must be less\
+ than ending: \"$max\""
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -step
+#
+# Increment spinner by step value.
+# ------------------------------------------------------------------
+configbody iwidgets::Spinint::step {
+}
+
+# ------------------------------------------------------------------
+# OPTION: -wrap
+#
+# Specify whether spinner should wrap value if at min or max.
+# ------------------------------------------------------------------
+configbody iwidgets::Spinint::wrap {
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: up
+#
+# Up arrow button press event. Increment value in entry.
+# ------------------------------------------------------------------
+body iwidgets::Spinint::up {} {
+ set min_range [lindex $itk_option(-range) 0]
+ set max_range [lindex $itk_option(-range) 1]
+
+ set val [$itk_component(entry) get]
+ if {[lindex $itk_option(-range) 0] != ""} {
+
+ #
+ # Check boundaries.
+ #
+ if {$val >= $min_range && $val < $max_range} {
+ incr val $itk_option(-step)
+
+ #
+ # Re-check boundaries.
+ #
+ if {$val >= $min_range && $val <= $max_range} {
+ $itk_component(entry) delete 0 end
+ $itk_component(entry) insert 0 $val
+ } else {
+
+ #
+ # This is wrap when -step > 1.
+ #
+ if {$itk_option(-wrap)} {
+ if {$val > $max_range} {
+ $itk_component(entry) delete 0 end
+ $itk_component(entry) insert 0 $min_range
+ } else {
+ uplevel #0 $itk_option(-invalid)
+ }
+ } else {
+ uplevel #0 $itk_option(-invalid)
+ }
+ }
+
+ } else {
+ if {$itk_option(-wrap)} {
+ if {$val == $max_range} {
+ $itk_component(entry) delete 0 end
+ $itk_component(entry) insert 0 $min_range
+ } else {
+ uplevel #0 $itk_option(-invalid)
+ }
+ } else {
+ uplevel #0 $itk_option(-invalid)
+ }
+ }
+ } else {
+
+ #
+ # No boundaries.
+ #
+ incr val $itk_option(-step)
+ $itk_component(entry) delete 0 end
+ $itk_component(entry) insert 0 $val
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: down
+#
+# Down arrow button press event. Decrement value in entry.
+# ------------------------------------------------------------------
+body iwidgets::Spinint::down {} {
+ set min_range [lindex $itk_option(-range) 0]
+ set max_range [lindex $itk_option(-range) 1]
+
+ set val [$itk_component(entry) get]
+ if {[lindex $itk_option(-range) 0] != ""} {
+
+ #
+ # Check boundaries.
+ #
+ if {$val > $min_range && $val <= $max_range} {
+ incr val -$itk_option(-step)
+
+ #
+ # Re-check boundaries.
+ #
+ if {$val >= $min_range && $val <= $max_range} {
+ $itk_component(entry) delete 0 end
+ $itk_component(entry) insert 0 $val
+ } else {
+
+ #
+ # This is wrap when -step > 1.
+ #
+ if {$itk_option(-wrap)} {
+ if {$val < $min_range} {
+ $itk_component(entry) delete 0 end
+ $itk_component(entry) insert 0 $max_range
+ } else {
+ uplevel #0 $itk_option(-invalid)
+ }
+ } else {
+ uplevel #0 $itk_option(-invalid)
+ }
+ }
+
+ } else {
+ if {$itk_option(-wrap)} {
+ if {$val == $min_range} {
+ $itk_component(entry) delete 0 end
+ $itk_component(entry) insert 0 $max_range
+ } else {
+ uplevel #0 $itk_option(-invalid)
+ }
+ } else {
+ uplevel #0 $itk_option(-invalid)
+ }
+ }
+ } else {
+
+ #
+ # No boundaries.
+ #
+ incr val -$itk_option(-step)
+ $itk_component(entry) delete 0 end
+ $itk_component(entry) insert 0 $val
+ }
+}
diff --git a/itcl/iwidgets3.0.0/generic/spinner.itk b/itcl/iwidgets3.0.0/generic/spinner.itk
new file mode 100644
index 00000000000..2072a794ca4
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/spinner.itk
@@ -0,0 +1,448 @@
+# Spinner
+# ----------------------------------------------------------------------
+# Implements a spinner widget. The Spinner is comprised of an
+# EntryField plus up and down arrow buttons.
+# Spinner is meant to be used as a base class for creating more
+# specific spinners such as SpinInt.itk
+# Arrows may be drawn horizontally or vertically.
+# User may define arrow behavior or accept the default arrow behavior.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Sue Yockey Phone: (214) 519-2517
+# E-mail: syockey@spd.dsccc.com
+# yockey@acm.org
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Spinner {
+ keep -background -borderwidth -cursor -foreground -highlightcolor \
+ -highlightthickness -insertbackground -insertborderwidth \
+ -insertofftime -insertontime -insertwidth -labelfont \
+ -selectbackground -selectborderwidth -selectforeground \
+ -textbackground -textfont
+}
+
+# ------------------------------------------------------------------
+# SPINNER
+# ------------------------------------------------------------------
+class iwidgets::Spinner {
+ inherit iwidgets::Entryfield
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -arroworient arrowOrient Orient vertical
+ itk_option define -textfont textFont \
+ Font -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*
+ itk_option define -borderwidth borderWidth BorderWidth 2
+ itk_option define -highlightthickness highlightThickness \
+ HighlightThickness 2
+ itk_option define -increment increment Command {}
+ itk_option define -decrement decrement Command {}
+ itk_option define -repeatdelay repeatDelay RepeatDelay 300
+ itk_option define -repeatinterval repeatInterval RepeatInterval 100
+ itk_option define -foreground foreground Foreground black
+
+ public method down {}
+ public method up {}
+
+ protected method _pushup {}
+ protected method _pushdown {}
+ protected method _relup {}
+ protected method _reldown {}
+ protected method _doup {rate}
+ protected method _dodown {rate}
+ protected method _up {}
+ protected method _down {}
+
+ protected method _positionArrows {{when later}}
+
+ protected variable _interior {}
+ protected variable _reposition "" ;# non-null => _positionArrows pending
+ protected variable _uptimer "" ;# non-null => _uptimer pending
+ protected variable _downtimer "" ;# non-null => _downtimer pending
+}
+
+#
+# Provide a lowercased access method for the Spinner class.
+#
+proc ::iwidgets::spinner {pathName args} {
+ uplevel ::iwidgets::Spinner $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Spinner::constructor {args} {
+ #
+ # Save off the interior for later use.
+ #
+ set _interior $itk_interior
+
+ #
+ # Create up arrow button.
+ #
+ itk_component add uparrow {
+ canvas $itk_interior.uparrow -height 10 -width 10 \
+ -relief raised -highlightthickness 0
+ } {
+ keep -background -borderwidth
+ }
+
+ #
+ # Create down arrow button.
+ #
+ itk_component add downarrow {
+ canvas $itk_interior.downarrow -height 10 -width 10 \
+ -relief raised -highlightthickness 0
+ } {
+ keep -background -borderwidth
+ }
+
+ #
+ # Add bindings for button press events on the up and down buttons.
+ #
+ bind $itk_component(uparrow) <ButtonPress-1> [code $this _pushup]
+ bind $itk_component(uparrow) <ButtonRelease-1> [code $this _relup]
+
+ bind $itk_component(downarrow) <ButtonPress-1> [code $this _pushdown]
+ bind $itk_component(downarrow) <ButtonRelease-1> [code $this _reldown]
+
+ eval itk_initialize $args
+
+ #
+ # When idle, position the arrows.
+ #
+ _positionArrows
+}
+
+# ------------------------------------------------------------------
+# DESTRUCTOR
+# ------------------------------------------------------------------
+
+body iwidgets::Spinner::destructor {} {
+ if {$_reposition != ""} {after cancel $_reposition}
+ if {$_uptimer != ""} {after cancel $_uptimer}
+ if {$_downtimer != ""} {after cancel $_downtimer}
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -arroworient
+#
+# Place arrows vertically or horizontally .
+# ------------------------------------------------------------------
+configbody iwidgets::Spinner::arroworient {
+ _positionArrows
+}
+
+# ------------------------------------------------------------------
+# OPTION: -textfont
+#
+# Change font, resize arrow buttons.
+# ------------------------------------------------------------------
+configbody iwidgets::Spinner::textfont {
+ _positionArrows
+}
+
+# ------------------------------------------------------------------
+# OPTION: -highlightthickness
+#
+# Change highlightthickness, resize arrow buttons.
+# ------------------------------------------------------------------
+configbody iwidgets::Spinner::highlightthickness {
+ _positionArrows
+}
+
+# ------------------------------------------------------------------
+# OPTION: -borderwidth
+#
+# Change borderwidth, resize arrow buttons.
+# ------------------------------------------------------------------
+configbody iwidgets::Spinner::borderwidth {
+ _positionArrows
+}
+
+# ------------------------------------------------------------------
+# OPTION: -increment
+#
+# Up arrow callback.
+# ------------------------------------------------------------------
+configbody iwidgets::Spinner::increment {
+ if {$itk_option(-increment) == {}} {
+ set itk_option(-increment) [code $this up]
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -decrement
+#
+# Down arrow callback.
+# ------------------------------------------------------------------
+configbody iwidgets::Spinner::decrement {
+ if {$itk_option(-decrement) == {}} {
+ set itk_option(-decrement) [code $this down]
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -repeatinterval
+#
+# Arrow repeat rate in milliseconds. A repeatinterval of 0 disables
+# button repeat.
+# ------------------------------------------------------------------
+configbody iwidgets::Spinner::repeatinterval {
+ if {$itk_option(-repeatinterval) < 0} {
+ set itk_option(-repeatinterval) 0
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -repeatdelay
+#
+# Arrow repeat delay in milliseconds.
+# ------------------------------------------------------------------
+configbody iwidgets::Spinner::repeatdelay {
+ if {$itk_option(-repeatdelay) < 0} {
+ set itk_option(-repeatdelay) 0
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -foreground
+#
+# Set the foreground color of the up and down arrows. Remember
+# to make sure the "tag" exists before setting them...
+# ------------------------------------------------------------------
+configbody iwidgets::Spinner::foreground {
+
+ if { [$itk_component(uparrow) gettags up] != "" } {
+ $itk_component(uparrow) itemconfigure up \
+ -fill $itk_option(-foreground)
+ }
+
+ if { [$itk_component(downarrow) gettags down] != "" } {
+ $itk_component(downarrow) itemconfigure down \
+ -fill $itk_option(-foreground)
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: up
+#
+# Up arrow command. Meant to be overloaded by derived class.
+# ------------------------------------------------------------------
+body iwidgets::Spinner::up {} {
+}
+
+# ------------------------------------------------------------------
+# METHOD: down
+#
+# Down arrow command. Meant to be overloaded by derived class.
+# ------------------------------------------------------------------
+body iwidgets::Spinner::down {} {
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _positionArrows ?when?
+#
+# Draw Arrows for spinner. If "when" is "now", the change is applied
+# immediately. If it is "later" or it is not specified, then the
+# change is applied later, when the application is idle.
+# ------------------------------------------------------------------
+body iwidgets::Spinner::_positionArrows {{when later}} {
+ if {$when == "later"} {
+ if {$_reposition == ""} {
+ set _reposition [after idle [code $this _positionArrows now]]
+ }
+ return
+ } elseif {$when != "now"} {
+ error "bad option \"$when\": should be now or later"
+ }
+
+ set _reposition ""
+
+ set bdw [cget -borderwidth]
+
+ #
+ # Based on the orientation of the arrows, pack them accordingly and
+ # determine the width and height of the spinners. For vertical
+ # orientation, it is really tight in the y direction, so we'll take
+ # advantage of the highlightthickness. Horizontal alignment has
+ # plenty of space vertically, thus we'll ignore the thickness.
+ #
+ switch $itk_option(-arroworient) {
+ vertical {
+ grid $itk_component(uparrow) -row 0 -column 0
+ grid $itk_component(downarrow) -row 1 -column 0
+
+ set totalHgt [winfo reqheight $itk_component(entry)]
+ set spinHgt [expr $totalHgt / 2]
+ set spinWid [expr round ($spinHgt * 1.6)]
+ }
+ horizontal {
+ grid $itk_component(uparrow) -row 0 -column 0
+ grid $itk_component(downarrow) -row 0 -column 1
+
+ set spinHgt [expr [winfo reqheight $itk_component(entry)] - \
+ (2 * [$itk_component(entry) cget -highlightthickness])]
+ set spinWid $spinHgt
+ }
+ default {
+ error "bad orientation option \"$itk_option(-arroworient)\",\
+ should be horizontal or vertical"
+ }
+ }
+
+ #
+ # Configure the width and height of the spinners minus the borderwidth.
+ # Next delete the previous spinner polygons and create new ones.
+ #
+ $itk_component(uparrow) config \
+ -height [expr $spinHgt - (2 * $bdw)] \
+ -width [expr $spinWid - (2 * $bdw)]
+ $itk_component(uparrow) delete up
+ $itk_component(uparrow) create polygon \
+ [expr $spinWid / 2] $bdw \
+ [expr $spinWid - $bdw - 1] [expr $spinHgt - $bdw -1] \
+ [expr $bdw + 1] [expr $spinHgt - $bdw - 1] \
+ -fill $itk_option(-foreground) -tags up
+
+ $itk_component(downarrow) config \
+ -height [expr $spinHgt - (2 * $bdw)] \
+ -width [expr $spinWid - (2 * $bdw)]
+ $itk_component(downarrow) delete down
+ $itk_component(downarrow) create polygon \
+ [expr $spinWid / 2] [expr ($spinHgt - $bdw) - 1] \
+ [expr $bdw + 2] [expr $bdw + 1] \
+ [expr $spinWid - $bdw - 2] [expr $bdw + 1] \
+ -fill $itk_option(-foreground) -tags down
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _pushup
+#
+# Up arrow button press event. Call _doup with repeatdelay.
+# ------------------------------------------------------------------
+body iwidgets::Spinner::_pushup {} {
+ $itk_component(uparrow) config -relief sunken
+ _doup $itk_option(-repeatdelay)
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _pushdown
+#
+# Down arrow button press event. Call _dodown with repeatdelay.
+# ------------------------------------------------------------------
+body iwidgets::Spinner::_pushdown {} {
+ $itk_component(downarrow) config -relief sunken
+ _dodown $itk_option(-repeatdelay)
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _doup
+#
+# Call _up and post to do another one after "rate" milliseconds if
+# repeatinterval > 0.
+# ------------------------------------------------------------------
+body iwidgets::Spinner::_doup {rate} {
+ _up
+
+ if {$itk_option(-repeatinterval) > 0} {
+ set _uptimer [after $rate [code $this _doup $itk_option(-repeatinterval)]]
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _dodown
+#
+# Call _down and post to do another one after "rate" milliseconds if
+# repeatinterval > 0.
+# ------------------------------------------------------------------
+body iwidgets::Spinner::_dodown {rate} {
+ _down
+
+ if {$itk_option(-repeatinterval) > 0} {
+ set _downtimer \
+ [after $rate [code $this _dodown $itk_option(-repeatinterval)]]
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _relup
+#
+# Up arrow button release event. Cancel pending up timer.
+# ------------------------------------------------------------------
+body iwidgets::Spinner::_relup {} {
+ $itk_component(uparrow) config -relief raised
+
+ if {$_uptimer != ""} {
+ after cancel $_uptimer
+ set _uptimer ""
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _reldown
+#
+# Up arrow button release event. Cancel pending down timer.
+# ------------------------------------------------------------------
+body iwidgets::Spinner::_reldown {} {
+ $itk_component(downarrow) config -relief raised
+
+ if {$_downtimer != ""} {
+ after cancel $_downtimer
+ set _downtimer ""
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _up
+#
+# Up arrow button press event. Call defined increment command.
+# ------------------------------------------------------------------
+body iwidgets::Spinner::_up {} {
+ uplevel #0 $itk_option(-increment)
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _down
+#
+# Down arrow button press event. Call defined decrement command.
+# ------------------------------------------------------------------
+body iwidgets::Spinner::_down {} {
+ uplevel #0 $itk_option(-decrement)
+}
diff --git a/itcl/iwidgets3.0.0/generic/spintime.itk b/itcl/iwidgets3.0.0/generic/spintime.itk
new file mode 100644
index 00000000000..5a8d325367a
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/spintime.itk
@@ -0,0 +1,527 @@
+# Spintime
+# ----------------------------------------------------------------------
+# Implements a Time spinner widget. A time spinner contains three
+# integer spinners: one for hours, one for minutes and one for
+# seconds. Options exist to manage to behavior, appearance, and
+# format of each component spinner.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Sue Yockey EMAIL: yockey@actc.com
+# Mark L. Ulferts mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1997 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Default resources.
+#
+option add *Spintime.hourLabel "Hour" widgetDefault
+option add *Spintime.minuteLabel "Minute" widgetDefault
+option add *Spintime.secondLabel "Second" widgetDefault
+option add *Spintime.hourWidth 3 widgetDefault
+option add *Spintime.minuteWidth 3 widgetDefault
+option add *Spintime.secondWidth 3 widgetDefault
+
+#
+# Usual options.
+#
+itk::usual Spintime {
+ keep -background -cursor -foreground -labelfont -textbackground -textfont
+}
+
+# ------------------------------------------------------------------
+# SPINTIME
+# ------------------------------------------------------------------
+class iwidgets::Spintime {
+ inherit itk::Widget
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -orient orient Orient vertical
+ itk_option define -labelpos labelPos Position w
+ itk_option define -houron hourOn HourOn true
+ itk_option define -minuteon minuteOn MinuteOn true
+ itk_option define -secondon secondOn SecondOn true
+ itk_option define -timemargin timeMargin Margin 1
+ itk_option define -militaryon militaryOn MilitaryOn true
+
+ public {
+ method get {{format "-string"}}
+ method show {{date now}}
+ }
+
+ protected {
+ method _packTime {{when later}}
+ method _down60 {comp}
+
+ variable _repack {} ;# Reconfiguration flag.
+ variable _interior
+ }
+}
+
+#
+# Provide a lowercased access method for the Spintime class.
+#
+proc ::iwidgets::spintime {pathName args} {
+ uplevel ::iwidgets::Spintime $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Spintime::constructor {args} {
+ set _interior $itk_interior
+ set clicks [clock seconds]
+
+ #
+ # Create Hour Spinner
+ #
+ itk_component add hour {
+ iwidgets::Spinint $itk_interior.hour -fixed 2 -range {0 23} -justify right
+ } {
+ keep -background -cursor -arroworient -foreground \
+ -labelfont -labelmargin -relief -textbackground \
+ -textfont -repeatdelay -repeatinterval
+
+ rename -labeltext -hourlabel hourLabel Text
+ rename -width -hourwidth hourWidth Width
+ }
+
+ #
+ # Take off the default bindings for selction and motion.
+ #
+ bind [$itk_component(hour) component entry] <1> {break}
+ bind [$itk_component(hour) component entry] <Button1-Motion> {break}
+
+ #
+ # Create Minute Spinner
+ #
+ itk_component add minute {
+ iwidgets::Spinint $itk_interior.minute \
+ -decrement [code $this _down60 minute] \
+ -fixed 2 -range {0 59} -justify right
+ } {
+ keep -background -cursor -arroworient -foreground \
+ -labelfont -labelmargin -relief -textbackground \
+ -textfont -repeatdelay -repeatinterval
+
+ rename -labeltext -minutelabel minuteLabel Text
+ rename -width -minutewidth minuteWidth Width
+ }
+
+ #
+ # Take off the default bindings for selction and motion.
+ #
+ bind [$itk_component(minute) component entry] <1> {break}
+ bind [$itk_component(minute) component entry] <Button1-Motion> {break}
+
+ #
+ # Create Second Spinner
+ #
+ itk_component add second {
+ iwidgets::Spinint $itk_interior.second \
+ -decrement [code $this _down60 second] \
+ -fixed 2 -range {0 59} -justify right
+ } {
+ keep -background -cursor -arroworient -foreground \
+ -labelfont -labelmargin -relief -textbackground \
+ -textfont -repeatdelay -repeatinterval
+
+ rename -labeltext -secondlabel secondLabel Text
+ rename -width -secondwidth secondWidth Width
+ }
+
+ #
+ # Take off the default bindings for selction and motion.
+ #
+ bind [$itk_component(second) component entry] <1> {break}
+ bind [$itk_component(second) component entry] <Button1-Motion> {break}
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+
+ #
+ # Show the current time.
+ #
+ show now
+}
+
+# ------------------------------------------------------------------
+# DESTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Spintime::destructor {} {
+ if {$_repack != ""} {after cancel $_repack}
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -orient
+#
+# Specifies the orientation of the 3 spinners for Hour, Minute
+# and second.
+# ------------------------------------------------------------------
+configbody iwidgets::Spintime::orient {
+ _packTime
+}
+
+# ------------------------------------------------------------------
+# OPTION: -labelpos
+#
+# Specifies the location of all 3 spinners' labels.
+# Overloaded
+# ------------------------------------------------------------------
+configbody iwidgets::Spintime::labelpos {
+ switch $itk_option(-labelpos) {
+ n {
+ $itk_component(hour) configure -labelpos n
+ $itk_component(minute) configure -labelpos n
+ $itk_component(second) configure -labelpos n
+
+ #
+ # Un-align labels
+ #
+ $itk_component(hour) configure -labelmargin 1
+ $itk_component(minute) configure -labelmargin 1
+ $itk_component(second) configure -labelmargin 1
+ }
+
+ s {
+ $itk_component(hour) configure -labelpos s
+ $itk_component(minute) configure -labelpos s
+ $itk_component(second) configure -labelpos s
+
+ #
+ # Un-align labels
+ #
+ $itk_component(hour) configure -labelmargin 1
+ $itk_component(minute) configure -labelmargin 1
+ $itk_component(second) configure -labelmargin 1
+ }
+
+ w {
+ $itk_component(hour) configure -labelpos w
+ $itk_component(minute) configure -labelpos w
+ $itk_component(second) configure -labelpos w
+ }
+
+ e {
+ $itk_component(hour) configure -labelpos e
+ $itk_component(minute) configure -labelpos e
+ $itk_component(second) configure -labelpos e
+
+ #
+ # Un-align labels
+ #
+ $itk_component(hour) configure -labelmargin 1
+ $itk_component(minute) configure -labelmargin 1
+ $itk_component(second) configure -labelmargin 1
+ }
+
+ default {
+ error "bad labelpos option \"$itk_option(-labelpos)\",\
+ should be n, s, w or e"
+ }
+ }
+
+ _packTime
+}
+
+# ------------------------------------------------------------------
+# OPTION: -houron
+#
+# Specifies whether or not to display the hour spinner.
+# ------------------------------------------------------------------
+configbody iwidgets::Spintime::houron {
+ _packTime
+}
+
+# ------------------------------------------------------------------
+# OPTION: -minuteon
+#
+# Specifies whether or not to display the minute spinner.
+# ------------------------------------------------------------------
+configbody iwidgets::Spintime::minuteon {
+ _packTime
+}
+
+# ------------------------------------------------------------------
+# OPTION: -secondon
+#
+# Specifies whether or not to display the second spinner.
+# ------------------------------------------------------------------
+configbody iwidgets::Spintime::secondon {
+ _packTime
+}
+
+
+# ------------------------------------------------------------------
+# OPTION: -timemargin
+#
+# Specifies the margin space between the hour and minute spinners
+# and the minute and second spinners.
+# ------------------------------------------------------------------
+configbody iwidgets::Spintime::timemargin {
+ _packTime
+}
+
+# ------------------------------------------------------------------
+# OPTION: -militaryon
+#
+# Specifies 24-hour clock or 12-hour.
+# ------------------------------------------------------------------
+configbody iwidgets::Spintime::militaryon {
+ set clicks [clock seconds]
+
+ if {$itk_option(-militaryon)} {
+ $itk_component(hour) configure -range {0 23}
+ $itk_component(hour) delete 0 end
+ $itk_component(hour) insert end [clock format $clicks -format "%H"]
+ } else {
+ $itk_component(hour) configure -range {1 12}
+ $itk_component(hour) delete 0 end
+ $itk_component(hour) insert end [clock format $clicks -format "%I"]
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: get ?format?
+#
+# Get the value of the time spinner in one of two formats string or
+# as an integer clock value using the -string and -clicks options
+# respectively. The default is by string. Reference the clock
+# command for more information on obtaining time and its formats.
+# ------------------------------------------------------------------
+body iwidgets::Spintime::get {{format "-string"}} {
+ set hour [$itk_component(hour) get]
+ set minute [$itk_component(minute) get]
+ set second [$itk_component(second) get]
+
+ switch -- $format {
+ "-string" {
+ return "$hour:$minute:$second"
+ }
+ "-clicks" {
+ return [clock scan "$hour:$minute:$second"]
+ }
+ default {
+ error "bad format option \"$format\":\
+ should be -string or -clicks"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: show time
+#
+# Changes the currently displayed time to be that of the time
+# argument. The time may be specified either as a string or an
+# integer clock value. Reference the clock command for more
+# information on obtaining time and its format.
+# ------------------------------------------------------------------
+body iwidgets::Spintime::show {{time "now"}} {
+ if {$time == "now"} {
+ set seconds [clock seconds]
+ } else {
+ if {[catch {clock format $time}] == 0} {
+ set seconds $time
+ } elseif {[catch {set seconds [clock scan $time]}] != 0} {
+ error "bad time: \"$time\", must be a valid time\
+ string, clock clicks value or the keyword now"
+ }
+ }
+
+ $itk_component(hour) delete 0 end
+
+ if {$itk_option(-militaryon)} {
+ scan [clock format $seconds -format "%H"] "%d" hour
+ } else {
+ scan hour [clock format $seconds -format "%I"] "%d" hour
+ }
+
+ $itk_component(hour) insert end $hour
+
+ $itk_component(minute) delete 0 end
+ scan [clock format $seconds -format "%M"] "%d" minute
+ $itk_component(minute) insert end $minute
+
+ $itk_component(second) delete 0 end
+ scan [clock format $seconds -format "%S"] "%d" seconds
+ $itk_component(second) insert end $seconds
+
+ return
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _packTime ?when?
+#
+# Pack components of time spinner. If "when" is "now", the change
+# is applied immediately. If it is "later" or it is not specified,
+# then the change is applied later, when the application is idle.
+# ------------------------------------------------------------------
+body iwidgets::Spintime::_packTime {{when later}} {
+ if {$when == "later"} {
+ if {$_repack == ""} {
+ set _repack [after idle [code $this _packTime now]]
+ }
+ return
+ } elseif {$when != "now"} {
+ error "bad option \"$when\": should be now or later"
+ }
+
+ for {set i 0} {$i < 5} {incr i} {
+ grid rowconfigure $_interior $i -minsize 0
+ grid columnconfigure $_interior $i -minsize 0
+ }
+
+ if {$itk_option(-minuteon)} {
+ set minuteon 1
+ } else {
+ set minuteon 0
+ }
+ if {$itk_option(-secondon)} {
+ set secondon 1
+ } else {
+ set secondon 0
+ }
+
+ set _repack ""
+
+ switch $itk_option(-orient) {
+ vertical {
+ set row -1
+
+ if {$itk_option(-houron)} {
+ grid $itk_component(hour) -row [incr row] -column 0 \
+ -sticky nsew
+ } else {
+ grid forget $itk_component(hour)
+ }
+
+ if {$itk_option(-minuteon)} {
+ if {$itk_option(-houron)} {
+ grid rowconfigure $_interior [incr row] \
+ -minsize $itk_option(-timemargin)
+ }
+
+ grid $itk_component(minute) -row [incr row] -column 0 \
+ -sticky nsew
+ } else {
+ grid forget $itk_component(minute)
+ }
+
+ if {$itk_option(-secondon)} {
+ if {$minuteon || $secondon} {
+ grid rowconfigure $_interior [incr row] \
+ -minsize $itk_option(-timemargin)
+ }
+
+ grid $itk_component(second) -row [incr row] -column 0 \
+ -sticky nsew
+ } else {
+ grid forget $itk_component(second)
+ }
+
+ if {$itk_option(-labelpos) == "w"} {
+ iwidgets::Labeledwidget::alignlabels $itk_component(hour) \
+ $itk_component(minute) $itk_component(second)
+ }
+ }
+
+ horizontal {
+ set column -1
+
+ if {$itk_option(-houron)} {
+ grid $itk_component(hour) -row 0 -column [incr column] \
+ -sticky nsew
+ } else {
+ grid forget $itk_component(hour)
+ }
+
+ if {$itk_option(-minuteon)} {
+ if {$itk_option(-houron)} {
+ grid columnconfigure $_interior [incr column] \
+ -minsize $itk_option(-timemargin)
+ }
+
+ grid $itk_component(minute) -row 0 -column [incr column] \
+ -sticky nsew
+ } else {
+ grid forget $itk_component(minute)
+ }
+
+ if {$itk_option(-secondon)} {
+ if {$minuteon || $secondon} {
+ grid columnconfigure $_interior [incr column] \
+ -minsize $itk_option(-timemargin)
+ }
+
+ grid $itk_component(second) -row 0 -column [incr column] \
+ -sticky nsew
+ } else {
+ grid forget $itk_component(second)
+ }
+
+ #
+ # Un-align labels
+ #
+ $itk_component(hour) configure -labelmargin 1
+ $itk_component(minute) configure -labelmargin 1
+ $itk_component(second) configure -labelmargin 1
+ }
+
+ default {
+ error "bad orient option \"$itk_option(-orient)\", should\
+ be \"vertical\" or \"horizontal\""
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: down60
+#
+# Down arrow button press event. Decrement value in the minute
+# or second entry.
+# ------------------------------------------------------------------
+body iwidgets::Spintime::_down60 {comp} {
+ set step [$itk_component($comp) cget -step]
+ set val [$itk_component($comp) get]
+
+ incr val -$step
+ if {$val < 0} {
+ set val [expr 60-$step]
+ }
+ $itk_component($comp) delete 0 end
+ $itk_component($comp) insert 0 $val
+}
diff --git a/itcl/iwidgets3.0.0/generic/tabnotebook.itk b/itcl/iwidgets3.0.0/generic/tabnotebook.itk
new file mode 100644
index 00000000000..c9d17264143
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/tabnotebook.itk
@@ -0,0 +1,1075 @@
+#
+# Tabnotebook Widget
+# ----------------------------------------------------------------------
+# The Tabnotebook command creates a new window (given by the pathName
+# argument) and makes it into a Tabnotebook widget. Additional options,
+# described above may be specified on the command line or in the option
+# database to configure aspects of the Tabnotebook such as its colors,
+# font, and text. The Tabnotebook command returns its pathName argument.
+# At the time this command is invoked, there must not exist a window
+# named pathName, but pathName's parent must exist.
+#
+# A Tabnotebook is a widget that contains a set of tabbed pages. It
+# displays one page from the set as the selected page. A Tab displays
+# the label for the page to which it is attached and serves as a page
+# selector. When a page's tab is selected, the page's contents are
+# displayed in the page area. The selected tab has a three-dimensional
+# effect to make it appear to float above the other tabs. The tabs are
+# displayed as a group along either the left, top, right, or bottom
+# edge. When first created a Tabnotebook has no pages. Pages may be
+# added or deleted using widget commands described below.
+#
+# A special option may be provided to the Tabnotebook. The -auto
+# option specifies whether the Tabnotebook will automatically handle
+# the unpacking and packing of pages when pages are selected. A value
+# of true sig nifies that the notebook will automatically manage it. This
+# is the default value. A value of false signifies the notebook will not
+# perform automatic switching of pages.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Bill W. Scott EMAIL: bscott@spd.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Default resources.
+#
+option add *Tabnotebook.borderWidth 2 widgetDefault
+option add *Tabnotebook.state normal widgetDefault
+option add *Tabnotebook.disabledForeground #a3a3a3 widgetDefault
+option add *Tabnotebook.scrollCommand {} widgetDefault
+option add *Tabnotebook.equalTabs true widgetDefault
+option add *Tabnotebook.font \
+ -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* widgetDefault
+option add *Tabnotebook.width 300 widgetDefault
+option add *Tabnotebook.height 150 widgetDefault
+option add *Tabnotebook.foreground Black widgetDefault
+option add *Tabnotebook.background #d9d9d9 widgetDefault
+option add *Tabnotebook.tabForeground Black widgetDefault
+option add *Tabnotebook.tabBackground #d9d9d9 widgetDefault
+option add *Tabnotebook.backdrop #d9d9d9 widgetDefault
+option add *Tabnotebook.margin 4 widgetDefault
+option add *Tabnotebook.tabBorders true widgetDefault
+option add *Tabnotebook.bevelAmount 0 widgetDefault
+option add *Tabnotebook.raiseSelect false widgetDefault
+option add *Tabnotebook.auto true widgetDefault
+option add *Tabnotebook.start 4 widgetDefault
+option add *Tabnotebook.padX 4 widgetDefault
+option add *Tabnotebook.padY 4 widgetDefault
+option add *Tabnotebook.gap overlap widgetDefault
+option add *Tabnotebook.angle 15 widgetDefault
+option add *Tabnotebook.tabPos s widgetDefault
+
+#
+# Usual options.
+#
+itk::usual Tabnotebook {
+ keep -backdrop -background -borderwidth -cursor -disabledforeground \
+ -font -foreground -tabbackground -tabforeground
+}
+
+# ------------------------------------------------------------------
+# TABNOTEBOOK
+# ------------------------------------------------------------------
+class iwidgets::Tabnotebook {
+ inherit itk::Widget
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -borderwidth borderWidth BorderWidth 2
+ itk_option define -state state State normal
+ itk_option define \
+ -disabledforeground disabledForeground DisabledForeground #a3a3a3
+ itk_option define -scrollcommand scrollCommand ScrollCommand {}
+ itk_option define -equaltabs equalTabs EqualTabs true
+ itk_option define -font font Font \
+ -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*
+ itk_option define -width width Width 300
+ itk_option define -height height Height 150
+ itk_option define -foreground foreground Foreground Black
+ itk_option define -background background Background #d9d9d9
+ itk_option define -tabforeground tabForeground TabForeground Black
+ itk_option define -tabbackground tabBackground TabBackground #d9d9d9
+ itk_option define -backdrop backdrop Backdrop #d9d9d9
+ itk_option define -margin margin Margin 4
+ itk_option define -tabborders tabBorders TabBorders true
+ itk_option define -bevelamount bevelAmount BevelAmount 0
+ itk_option define -raiseselect raiseSelect RaiseSelect false
+ itk_option define -auto auto Auto true
+ itk_option define -start start Start 4
+ itk_option define -padx padX PadX 4
+ itk_option define -pady padY PadY 4
+ itk_option define -gap gap Gap overlap
+ itk_option define -angle angle Angle 15
+ itk_option define -tabpos tabPos TabPos s
+
+ public method add { args }
+ public method configure { args }
+ public method childsite { args }
+ public method delete { args }
+ public method index { args }
+ public method insert { index args }
+ public method prev { }
+ public method next { }
+ public method pageconfigure { index args }
+ public method select { index }
+ public method view { args }
+
+ protected method _reconfigureTabset { }
+ protected method _canvasReconfigure { wid hgt }
+ protected method _pageReconfigure { pageName page wid hgt }
+
+ private method _getArgs { optList args }
+ private method _redrawBorder { wid hgt }
+ private method _recomputeBorder { }
+ private method _pack { tabPos }
+
+ private variable _canvasWidth 0 ;# currently tabnote canvas width
+ private variable _canvasHeight 0 ;# currently tabnote canvas height
+ private variable _nbOptList {} ;# list of notebook options available
+ private variable _tsOptList {} ;# list of tabset options available
+
+ private variable _tabPos s ;# holds -tabPos, because of ordering
+
+ private variable _borderRecompute false ;# did we dirty border after cfg?
+ private variable _tabsetReconfigure false ;# did we dirty tabsets after cfg?
+
+}
+
+# ----------------------------------------------------------------------
+# CONSTRUCTOR
+# ----------------------------------------------------------------------
+body iwidgets::Tabnotebook::constructor {args} {
+ component hull configure -borderwidth 0
+
+ #
+ # Create the outermost canvas to maintain geometry.
+ #
+ itk_component add canvas {
+ canvas $itk_interior.canvas -highlightthickness 0
+ } {
+ keep -cursor -background -width -height
+ }
+ bind $itk_component(canvas) <Configure> \
+ [code $this _canvasReconfigure %w %h]
+
+
+ # .......................
+ # Create the NOTEBOOK
+ #
+ itk_component add notebook {
+ iwidgets::Notebook $itk_interior.canvas.notebook
+ } {
+ keep -cursor -background
+ }
+
+ #
+ # Ouch, create a dummy page, go pageconfigure to get its options
+ # and munge them into a list for later doling by pageconfigure
+ #
+ $itk_component(notebook) add
+ set nbConfigList [$itk_component(notebook) pageconfigure 0]
+ foreach config $nbConfigList {
+ lappend _nbOptList [lindex $config 0]
+ }
+ $itk_component(notebook) delete 0
+
+ #
+ # Create the tabset.
+ #
+ itk_component add tabset {
+ iwidgets::Tabset $itk_interior.canvas.tabset \
+ -command [code $this component notebook select]
+ } {
+ keep -cursor
+ }
+
+ eval itk_initialize $args
+
+ #
+ # Ouch, create a dummy tab, go tabconfigure to get its options
+ # and munge them into a list for later doling by pageconfigure
+ #
+ $itk_component(tabset) add
+ set tsConfigList [$itk_component(tabset) tabconfigure 0]
+ foreach config $tsConfigList {
+ lappend _tsOptList [lindex $config 0]
+ }
+ $itk_component(tabset) delete 0
+
+ bind $itk_component(tabset) <Configure> \
+ [code $this _reconfigureTabset]
+
+ _pack $_tabPos
+
+}
+
+proc ::iwidgets::tabnotebook {pathName args} {
+ uplevel ::iwidgets::Tabnotebook $pathName $args
+}
+
+
+# -------------------------------------------------------------
+# DESTRUCTOR: destroy the Tabnotebook
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::destructor {} {
+}
+
+# ----------------------------------------------------------------------
+# OPTION -borderwidth
+#
+# Thickness of Notebook Border
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::borderwidth {
+ if {$itk_option(-borderwidth) != {}} {
+ #_recomputeBorder
+ set _borderRecompute true
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -state
+#
+# State of the tabs in the tab notebook: normal or disabled
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::state {
+ if {$itk_option(-state) != {}} {
+ $itk_component(tabset) configure -state $itk_option(-state)
+ #_reconfigureTabset
+ set _tabsetReconfigure true
+
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -disabledforeground
+#
+# Specifies a foreground color to use for displaying a
+# tab's label when its state is disabled.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::disabledforeground {
+
+ if {$itk_option(-disabledforeground) != {}} {
+ $itk_component(tabset) configure \
+ -disabledforeground $itk_option(-disabledforeground)
+ #_reconfigureTabset
+ set _tabsetReconfigure true
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -scrollcommand
+#
+# Standard option. See options man pages.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::scrollcommand {
+
+ if {$itk_option(-scrollcommand) != {}} {
+ $itk_component(notebook) \
+ configure -scrollcommand $itk_option(-scrollcommand)
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -equaltabs
+#
+# Specifies whether to force tabs to be equal sized or not.
+# A value of true means constrain tabs to be equal sized.
+# A value of false allows each tab to size based on the text
+# label size. The value may have any of the forms accepted by
+# the Tcl_GetBoolean, such as true, false, 0, 1, yes, or no.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::equaltabs {
+
+ if {$itk_option(-equaltabs) != {}} {
+ $itk_component(tabset) \
+ configure -equaltabs $itk_option(-equaltabs)
+ #_reconfigureTabset
+ set _tabsetReconfigure true
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -font
+#
+# Font for tab labels when they are set to text (-label set)
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::font {
+
+ if {$itk_option(-font) != {}} {
+ $itk_component(tabset) configure -font $itk_option(-font)
+ #_reconfigureTabset
+ set _tabsetReconfigure true
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -width
+#
+# Width of the Tabnotebook
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::width {
+ if {$itk_option(-width) != {}} {
+ $itk_component(canvas) configure -width $itk_option(-width)
+ #_recomputeBorder
+ set _borderRecompute true
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -height
+#
+# Height of the Tabnotebook
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::height {
+ if {$itk_option(-height) != {}} {
+ $itk_component(canvas) configure -height $itk_option(-height)
+ #_recomputeBorder
+ set _borderRecompute true
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -foreground
+#
+# Specifies a foreground color to use for displaying a page
+# and its associated tab label (this is the selected state).
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::foreground {
+
+ if {$itk_option(-foreground) != {}} {
+ $itk_component(tabset) configure \
+ -selectforeground $itk_option(-foreground)
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -background
+#
+# Specifies a background color to use for displaying a page
+# and its associated tab bg (this is the selected state).
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::background {
+
+ if {$itk_option(-background) != {}} {
+ $itk_component(tabset) configure \
+ -selectbackground $itk_option(-background)
+ #_recomputeBorder
+ set _borderRecompute true
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -tabforeground
+#
+# Specifies a foreground color to use for displaying tab labels
+# when they are in their unselected state.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::tabforeground {
+
+ if {$itk_option(-tabforeground) != {}} {
+ $itk_component(tabset) configure \
+ -foreground $itk_option(-tabforeground)
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -tabbackground
+#
+# Specifies a background color to use for displaying tab backgrounds
+# when they are in their unselected state.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::tabbackground {
+
+ if {$itk_option(-tabbackground) != {}} {
+ $itk_component(tabset) configure \
+ -background $itk_option(-tabbackground)
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -backdrop
+#
+# Specifies a background color to use when filling in the
+# area behind the tabs.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::backdrop {
+
+ if {$itk_option(-backdrop) != {}} {
+ $itk_component(tabset) configure \
+ -backdrop $itk_option(-backdrop)
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -margin
+#
+# Sets the backdrop margin between tab edge and backdrop edge
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::margin {
+ if {$itk_option(-margin) != {}} {
+ $itk_component(tabset) configure -margin $itk_option(-margin)
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -tabborders
+#
+# Boolean that specifies whether to draw the borders of
+# the unselected tabs (tabs in background)
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::tabborders {
+ if {$itk_option(-tabborders) != {}} {
+ $itk_component(tabset) \
+ configure -tabborders $itk_option(-tabborders)
+ #_reconfigureTabset
+ set _tabsetReconfigure true
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -bevelamount
+#
+# Specifies pixel size of tab corners. 0 means no corners.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::bevelamount {
+ if {$itk_option(-bevelamount) != {}} {
+ $itk_component(tabset) \
+ configure -bevelamount $itk_option(-bevelamount)
+ #_reconfigureTabset
+ set _tabsetReconfigure true
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -raiseselect
+#
+# Sets whether to raise selected tabs
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::raiseselect {
+ if {$itk_option(-raiseselect) != {}} {
+ $itk_component(tabset) \
+ configure -raiseselect $itk_option(-raiseselect)
+ #_reconfigureTabset
+ set _tabsetReconfigure true
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -auto
+#
+# Determines whether pages are automatically unpacked and
+# packed when pages get selected.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::auto {
+ if {$itk_option(-auto) != {}} {
+ $itk_component(notebook) configure -auto $itk_option(-auto)
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -start
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::start {
+
+ if {$itk_option(-start) != {}} {
+ $itk_component(tabset) configure \
+ -start $itk_option(-start)
+ #_reconfigureTabset
+ set _tabsetReconfigure true
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -padx
+#
+# Specifies a non-negative value indicating how much extra space
+# to request for a tab around its label in the X-direction.
+# When computing how large a window it needs, the tab will add
+# this amount to the width it would normally need The tab will
+# end up with extra internal space to the left and right of its
+# text label. This value may have any of the forms acceptable
+# to Tk_GetPixels.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::padx {
+
+ if {$itk_option(-padx) != {}} {
+ $itk_component(tabset) configure -padx $itk_option(-padx)
+ #_reconfigureTabset
+ set _tabsetReconfigure true
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -pady
+#
+# Specifies a non-negative value indicating how much extra space to
+# request for a tab around its label in the Y-direction. When computing
+# how large a window it needs, the tab will add this amount to the
+# height it would normally need The tab will end up with extra internal
+# space to the top and bot tom of its text label. This value may have
+# any of the forms acceptable to Tk_GetPixels.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::pady {
+
+ if {$itk_option(-pady) != {}} {
+ $itk_component(tabset) configure -pady $itk_option(-pady)
+ #_reconfigureTabset
+ set _tabsetReconfigure true
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -gap
+#
+# Specifies the amount of pixel space to place between each tab.
+# Value may be any pixel offset value. In addition, a special keyword
+# 'overlap' can be used as the value to achieve a standard overlap of
+# tabs. This value may have any of the forms acceptable to Tk_GetPixels.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::gap {
+
+ if {$itk_option(-gap) != {}} {
+ $itk_component(tabset) configure -gap $itk_option(-gap)
+ #_reconfigureTabset
+ set _tabsetReconfigure true
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -angle
+#
+# Specifes the angle of slope from the inner edge to the outer edge
+# of the tab. An angle of 0 specifies square tabs. Valid ranges are
+# 0 to 45 degrees inclusive. Default is 15 degrees. If tabPos is
+# e or w, this option is ignored.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::angle {
+
+ if {$itk_option(-angle) != {}} {
+ $itk_component(tabset) configure -angle $itk_option(-angle)
+ #_reconfigureTabset
+ set _tabsetReconfigure true
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -tabpos
+#
+# Specifies the location of the set of tabs in relation to the
+# Notebook area. Must be n, s, e, or w. Defaults to s.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabnotebook::tabpos {
+
+ if {$itk_option(-tabpos) != {}} {
+ set _tabPos $itk_option(-tabpos)
+ $itk_component(tabset) configure \
+ -tabpos $itk_option(-tabpos)
+ pack forget $itk_component(canvas)
+ pack forget $itk_component(tabset)
+ pack forget $itk_component(notebook)
+ _pack $_tabPos
+ }
+}
+
+# -------------------------------------------------------------
+# METHOD: configure ?<option>? ?<value> <option> <value>...?
+#
+# Acts as an addendum to the itk::Widget::configure method.
+#
+# Checks the _recomputeBorder flag and the _tabsetReconfigure to
+# determine what work has been batched to after the configure
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::configure { args } {
+ set result [eval itk::Archetype::configure $args]
+
+ # check for flags then do update...
+ if { $_borderRecompute == "true" } {
+ _recomputeBorder
+ set _borderRecompute false
+ }
+
+ if { $_tabsetReconfigure == "true" } {
+ _reconfigureTabset
+ set _tabsetReconfigure false
+ }
+
+ return $result
+
+}
+
+# -------------------------------------------------------------
+# METHOD: add ?<option> <value>...?
+#
+# Creates a page and appends it to the list of pages.
+# processes pageconfigure for the page added.
+#
+# Returns the page's childsite frame
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::add { args } {
+
+ # The args list should be an even # of params, if not then
+ # prob missing value for last item in args list. Signal error.
+ set len [llength $args]
+ if { [expr $len % 2] } {
+ error "value for \"[lindex $args [expr $len - 1]]\" missing"
+ }
+
+ # pick out the notebook args
+ set nbArgs [eval _getArgs [list $_nbOptList] $args]
+ set pageName [eval $itk_component(notebook) add $nbArgs]
+
+ # pick out the tabset args
+ set tsArgs [eval _getArgs [list $_tsOptList] $args]
+ eval $itk_component(tabset) add $tsArgs
+
+ set page [index end]
+ bind $pageName <Configure> \
+ [code $this _pageReconfigure $pageName $page %w %h]
+ return $pageName
+}
+
+# -------------------------------------------------------------
+# METHOD: childsite ?<index>?
+#
+# If index is supplied, returns the child site widget
+# corresponding to the page index. If called with no arguments,
+# returns a list of all child sites
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::childsite { args } {
+ return [eval $itk_component(notebook) childsite $args]
+}
+
+# -------------------------------------------------------------
+# METHOD: delete <index1> ?<index2>?
+#
+# Deletes a page or range of pages from the notebook
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::delete { args } {
+ eval $itk_component(notebook) delete $args
+ eval $itk_component(tabset) delete $args
+}
+
+
+# -------------------------------------------------------------
+# METHOD: index <index>
+#
+# Given an index identifier returns the numeric index of the page
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::index { args } {
+ return [eval $itk_component(notebook) index $args]
+}
+
+# -------------------------------------------------------------
+# METHOD: insert <index> ?<option> <value>...?
+#
+# Inserts a page before a index. The before page may
+# be specified as a label or a page position.
+#
+# Note that since we use eval to preserve the $args list,
+# we must use list around $index to keep it together as a unit
+#
+# Returns the name of the page's child site
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::insert { index args } {
+
+ # pick out the notebook args
+ set nbArgs [eval _getArgs [list $_nbOptList] $args]
+ set pageName [eval $itk_component(notebook) insert [list $index] $nbArgs]
+
+ # pick out the tabset args
+ set tsArgs [eval _getArgs [list $_tsOptList] $args]
+ eval $itk_component(tabset) insert [list $index] $tsArgs
+
+ return $pageName
+
+}
+
+# -------------------------------------------------------------
+# METHOD: prev
+#
+# Selects the previous page. Wraps at first back to last page.
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::prev { } {
+ eval $itk_component(notebook) prev
+ eval $itk_component(tabset) prev
+}
+
+# -------------------------------------------------------------
+# METHOD: next
+#
+# Selects the next page. Wraps at last back to first page.
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::next { } {
+ eval $itk_component(notebook) next
+ eval $itk_component(tabset) next
+}
+
+# -------------------------------------------------------------
+# METHOD: pageconfigure <index> ?<option> <value>...?
+#
+# Performs configure on a given page denoted by index.
+# Index may be a page number or a pattern matching the label
+# associated with a page.
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::pageconfigure { index args } {
+
+ set nbArgs [eval _getArgs [list $_nbOptList] $args]
+ set tsArgs [eval _getArgs [list $_tsOptList] $args]
+
+ set len [llength $args]
+ switch $len {
+ 0 {
+ # Here is the case where they just want to query options
+ set nbConfig \
+ [eval $itk_component(notebook) pageconfigure $index $nbArgs]
+ set tsConfig \
+ [eval $itk_component(tabset) tabconfigure $index $tsArgs]
+ #
+ # BUG: this currently just concatenates a page and a tab's
+ # config lists together... We should bias to the Page
+ # since this is what we are using as primary when both??
+ #
+ # a pageconfigure index -background will return something like:
+ # -background background Background #9D008FF583C1 gray70 \
+ # -background background background white gray 70
+ #
+ return [concat $nbConfig $tsConfig]
+ }
+ 1 {
+ # Here is the case where they are asking for only one
+ # one options value... need to figure out which one
+ # (page or tab) can service this. Then only return
+ # that one's result.
+
+ if { [llength $nbArgs] != 0 } {
+ return [eval $itk_component(notebook) \
+ pageconfigure $index $nbArgs]
+ } elseif { [llength $tsArgs] != 0 } {
+ return [eval $itk_component(tabset) \
+ tabconfigure $index $tsArgs]
+ } else {
+ error "unknown option \"$args\""
+ }
+
+ }
+ default {
+
+ # pick out the notebook args
+ set nbConfig \
+ [eval $itk_component(notebook) \
+ pageconfigure [list $index] $nbArgs]
+
+ # pick out the tabset args
+ set tsConfig \
+ [eval $itk_component(tabset) \
+ tabconfigure [list $index] $tsArgs]
+
+ return ""
+ #return [concat $nbConfig $tsConfig]
+
+ }
+ }
+}
+
+# -------------------------------------------------------------
+# METHOD: select index
+#
+# Select a page by index
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::select { index } {
+ $itk_component(notebook) select $index
+ $itk_component(tabset) select $index
+}
+
+# -------------------------------------------------------------
+# METHOD: view
+#
+# Return the current page
+#
+# view index
+#
+# Selects the page denoted by index to be current page
+#
+# view 'moveto' fraction
+#
+# Selects the page by using fraction amount
+#
+# view 'scroll' num what
+#
+# Selects the page by using num as indicator of next or
+# previous
+#
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::view { args } {
+ eval $itk_component(notebook) view $args
+ $itk_component(tabset) select [index select]
+}
+
+# -------------------------------------------------------------
+# PRIVATE METHOD: _getArgs
+#
+# Given an optList returned from a configure on an object and
+# given a candidate argument list, peruse throught the optList
+# and build a new argument list with only those options found
+# in optList.
+#
+# This is used by the add, insert, and pageconfigure methods.
+# It is useful for a container kind of class like Tabnotebook
+# to be smart about args it gets for its concept of a "page"
+# which is actually a Notebook Page and a Tabset Tab.
+#
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::_getArgs { optList args } {
+
+ set len [llength $args]
+
+ set retArgs {}
+
+ for {set i 0} {$i < $len} {incr i} {
+ # get the option for this pair
+ set opt [lindex $args $i]
+
+ # move ahead to the value
+ incr i
+
+ # option exists!
+ if { [lsearch -exact $optList $opt] != -1} {
+ lappend retArgs $opt
+ if {$i < [llength $args]} {
+ lappend retArgs [lindex $args $i]
+ }
+ # option does not exist
+ }
+ }
+
+ return $retArgs
+}
+
+# -------------------------------------------------------------
+# PROTECTED METHOD: _reconfigureTabset
+#
+# bound to the tabset reconfigure... We call our canvas
+# reconfigure as if the canvas resized, it then configures
+# the tabset correctly.
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::_reconfigureTabset { } {
+
+ _canvasReconfigure $_canvasWidth $_canvasHeight
+
+}
+
+# -------------------------------------------------------------
+# PROTECTED METHOD: _canvasReconfigure
+#
+# bound to window Reconfigure event of the canvas
+# keeps the tabset area stretched in its major dimension.
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::_canvasReconfigure { wid hgt } {
+
+ if { $_tabPos == "n" || $_tabPos == "s" } {
+ $itk_component(tabset) configure -width $wid
+ } else {
+ $itk_component(tabset) configure -height $hgt
+ }
+
+ set _canvasWidth $wid
+ set _canvasHeight $hgt
+
+ _redrawBorder $wid $hgt
+
+}
+
+# -------------------------------------------------------------
+# PRIVATE METHOD: _redrawBorder
+#
+# called by methods when the packing changes, borderwidths, etc.
+# and height
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::_redrawBorder { wid hgt } {
+
+ # Get the top of the Notebook area...
+
+ set nbTop [winfo y $itk_component(notebook)]
+ set canTop [expr $nbTop - $itk_option(-borderwidth)]
+
+ $itk_component(canvas) delete BORDER
+ if { $itk_option(-borderwidth) > 0 } {
+
+ # For south, east, and west -- draw the top/north edge
+ if { $_tabPos != "n" } {
+ $itk_component(canvas) create line \
+ [expr floor(0 + ($itk_option(-borderwidth)/2.0))] \
+ [expr floor(0 + ($itk_option(-borderwidth)/2.0))] \
+ $wid \
+ [expr floor(0 + ($itk_option(-borderwidth)/2.0))] \
+ -width $itk_option(-borderwidth) \
+ -fill [iwidgets::colors::topShadow $itk_option(-background)] \
+ -tags BORDER
+ }
+
+ # For north, east, and west -- draw the bottom/south edge
+ if { $_tabPos != "s" } {
+ $itk_component(canvas) create line \
+ [expr floor(0 + ($itk_option(-borderwidth)/2.0))] \
+ [expr floor($hgt - ($itk_option(-borderwidth)/2.0))] \
+ [expr floor($wid - ($itk_option(-borderwidth)/2.0))] \
+ [expr floor($hgt - ($itk_option(-borderwidth)/2.0))] \
+ -width $itk_option(-borderwidth) \
+ -fill [iwidgets::colors::bottomShadow $itk_option(-background)] \
+ -tags BORDER
+ }
+
+ # For north, south, and east -- draw the left/west edge
+ if { $_tabPos != "w" } {
+ $itk_component(canvas) create line \
+ [expr floor(0 + ($itk_option(-borderwidth)/2.0))] \
+ 0 \
+ [expr floor(0 + ($itk_option(-borderwidth)/2.0))] \
+ $hgt \
+ -width $itk_option(-borderwidth) \
+ -fill [iwidgets::colors::topShadow $itk_option(-background)] \
+ -tags BORDER
+ }
+
+ # For north, south, and west -- draw the right/east edge
+ if { $_tabPos != "e" } {
+ $itk_component(canvas) create line \
+ [expr floor($wid - ($itk_option(-borderwidth)/2.0))] \
+ [expr floor(0 + ($itk_option(-borderwidth)/2.0))] \
+ [expr floor($wid - ($itk_option(-borderwidth)/2.0))] \
+ $hgt \
+ -width $itk_option(-borderwidth) \
+ -fill [iwidgets::colors::bottomShadow $itk_option(-background)] \
+ -tags BORDER
+ }
+ }
+
+}
+
+# -------------------------------------------------------------
+# PRIVATE METHOD: _recomputeBorder
+#
+# Based on current width and height of our canvas, repacks
+# the notebook with padding for borderwidth, and calls
+# redraw border method
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::_recomputeBorder { } {
+
+ set wid [winfo width $itk_component(canvas)]
+ set hgt [winfo height $itk_component(canvas)]
+
+ _pack $_tabPos
+ _redrawBorder $wid $hgt
+}
+
+# -------------------------------------------------------------
+# PROTECTED METHOD: _pageReconfigure
+#
+# This method will eventually reconfigure the tab notebook's
+# notebook area to contain the resized child site
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::_pageReconfigure { pageName page wid hgt } {
+
+}
+
+# -------------------------------------------------------------
+# PRIVATE METHOD: _pack
+#
+# This method packs the notebook and tabset correctly according
+# to the current $tabPos
+# -------------------------------------------------------------
+body iwidgets::Tabnotebook::_pack { tabPos } {
+
+ pack $itk_component(canvas) -fill both -expand yes
+ pack propagate $itk_component(canvas) no
+
+ switch $tabPos {
+ n {
+ # north
+ pack $itk_component(tabset) \
+ -anchor nw \
+ -fill x \
+ -expand no
+ pack $itk_component(notebook) \
+ -fill both \
+ -expand yes \
+ -padx $itk_option(-borderwidth) \
+ -pady $itk_option(-borderwidth) \
+ -side bottom
+ }
+ s {
+ # south
+ pack $itk_component(notebook) \
+ -anchor nw \
+ -fill both \
+ -expand yes \
+ -padx $itk_option(-borderwidth) \
+ -pady $itk_option(-borderwidth)
+
+ pack $itk_component(tabset) \
+ -side left \
+ -fill x \
+ -expand yes
+ }
+ w {
+ # west
+ pack $itk_component(tabset) \
+ -anchor nw \
+ -side left \
+ -fill y \
+ -expand no
+ pack $itk_component(notebook) \
+ -anchor nw \
+ -side left \
+ -fill both \
+ -expand yes \
+ -padx $itk_option(-borderwidth) \
+ -pady $itk_option(-borderwidth)
+
+ }
+ e {
+ # east
+ pack $itk_component(notebook) \
+ -side left \
+ -anchor nw \
+ -fill both \
+ -expand yes \
+ -padx $itk_option(-borderwidth) \
+ -pady $itk_option(-borderwidth)
+
+ pack $itk_component(tabset) \
+ -fill y \
+ -expand yes
+ }
+ }
+
+ set wid [winfo width $itk_component(canvas)]
+ set hgt [winfo height $itk_component(canvas)]
+
+ _redrawBorder $wid $hgt
+}
diff --git a/itcl/iwidgets3.0.0/generic/tabset.itk b/itcl/iwidgets3.0.0/generic/tabset.itk
new file mode 100644
index 00000000000..f26d66a42de
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/tabset.itk
@@ -0,0 +1,2747 @@
+#
+# Tabset Widget and the Tab Class
+# ----------------------------------------------------------------------
+# A Tabset is a widget that contains a set of Tab buttons.
+# It displays these tabs in a row or column depending on it tabpos.
+# When a tab is clicked on, it becomes the only tab in the tab set that
+# is selected. All other tabs are deselected. The Tcl command prefix
+# associated with this tab (through the command tab configure option)
+# is invoked with the tab index number appended to its argument list.
+# This allows the Tabset to control another widget such as a Notebook.
+#
+# A Tab class is an [incr Tcl] class that displays either an image,
+# bitmap, or label in a graphic object on a canvas. This graphic object
+# can have a wide variety of appearances depending on the options set.
+#
+# WISH LIST:
+# This section lists possible future enhancements.
+#
+# 1) When too many tabs appear, a small scrollbar should appear to
+# move the tabs over.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Bill W. Scott EMAIL: bscott@spd.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Default resources.
+#
+option add *Tabset.width 0 widgetDefault
+option add *Tabset.height 0 widgetDefault
+option add *Tabset.equalTabs true widgetDefault
+option add *Tabset.tabPos s widgetDefault
+option add *Tabset.raiseSelect false widgetDefault
+option add *Tabset.start 4 widgetDefault
+option add *Tabset.margin 5 widgetDefault
+option add *Tabset.tabBorders true widgetDefault
+option add *Tabset.bevelAmount 0 widgetDefault
+option add *Tabset.padX 4 widgetDefault
+option add *Tabset.padY 4 widgetDefault
+option add *Tabset.gap overlap widgetDefault
+option add *Tabset.angle 20 widgetDefault
+option add *Tabset.font fixed widgetDefault
+option add *Tabset.state normal widgetDefault
+option add *Tabset.disabledForeground #a3a3a3 widgetDefault
+option add *Tabset.foreground black widgetDefault
+option add *Tabset.background #d9d9d9 widgetDefault
+option add *Tabset.selectForeground black widgetDefault
+option add *Tabset.selectBackground #ececec widgetDefault
+
+#
+# Usual options.
+#
+itk::usual Tabset {
+ keep -backdrop -background -cursor -disabledforeground -font -foreground \
+ -selectbackground -selectforeground
+}
+
+# ------------------------------------------------------------------
+# TABSET
+# ------------------------------------------------------------------
+class iwidgets::Tabset {
+ inherit itk::Widget
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -width width Width 0
+ itk_option define -equaltabs equalTabs EqualTabs true
+ itk_option define -height height Height 0
+ itk_option define -tabpos tabPos TabPos s
+ itk_option define -raiseselect raiseSelect RaiseSelect false
+ itk_option define -start start Start 4
+ itk_option define -margin margin Margin 5
+ itk_option define -tabborders tabBorders TabBorders true
+ itk_option define -bevelamount bevelAmount BevelAmount 0
+ itk_option define -padx padX PadX 4
+ itk_option define -pady padY PadY 4
+ itk_option define -gap gap Gap overlap
+ itk_option define -angle angle Angle 20
+ itk_option define -font font Font fixed
+ itk_option define -state state State normal
+ itk_option define \
+ -disabledforeground disabledForeground DisabledForeground #a3a3a3
+ itk_option define -foreground foreground Foreground black
+ itk_option define -background background Background #d9d9d9
+ itk_option define -selectforeground selectForeground Background black
+ itk_option define -backdrop backdrop Backdrop white
+ itk_option define -selectbackground selectBackground Foreground #ececec
+ itk_option define -command command Command {}
+
+ public method configure {args}
+ public method add {args}
+ public method delete {args}
+ public method index {index}
+ public method insert {index args}
+ public method prev {}
+ public method next {}
+ public method select {index}
+ public method tabcget {index args}
+ public method tabconfigure {index args}
+
+ protected method _selectName {tabName}
+
+ private method _createTab {args}
+ private method _deleteTabs {fromTab toTab}
+ private method _index {pathList index select}
+ private method _tabConfigure {args}
+ private method _relayoutTabs {}
+ private method _drawBevelBorder {}
+ private method _calcNextTabOffset {tabName}
+ private method _tabBounds {}
+ private method _recalcCanvasGeom {}
+ private method _canvasReconfigure {width height}
+ private method _startMove {x y}
+ private method _moveTabs {x y}
+ private method _endMove {x y}
+ private method _configRelayout {}
+
+ private variable _width 0 ;# Width of the canvas in screen units
+ private variable _height 0 ;# Height of the canvas in screen units
+ private variable _selectedTop 0 ;# top edge of tab + a margin
+ private variable _deselectedTop 0 ;# top edge of tab + a margin&raiseamt
+ private variable _selectedLeft 0 ;# left edge of tab + a margin
+ private variable _deselectedLeft 0 ;# left edge of tab + a margin&raiseamt
+ private variable _tabs {} ;# our internal list of tabs
+ private variable _currTab -1 ;# numerical index # of selected tab
+ private variable _uniqueID 0 ;# used to create unique names
+ private variable _cmdStr {} ;# holds value of itk_option(-command)
+ ;# do not know why I need this!
+ private variable _canvasWidth 0 ;# set by canvasReconfigure, is can wid
+ private variable _canvasHeight 0 ;# set by canvasReconfigure, is can hgt
+
+ private variable _anchorX 0 ;# used by mouse scrolling methods
+ private variable _anchorY 0 ;# used by mouse scrolling methods
+
+ private variable _margin 0 ;# -margin in screen units
+ private variable _start 0 ;# -start in screen units
+ private variable _gap overlap ;# -gap in screen units
+
+ private variable _relayout false ;# flag tripped to tell whether to
+ ;# relayout tabs after the configure
+ private variable _skipRelayout false ;# flag that tells whether to skip
+ ;# relayouting out the tabs. used by
+ ;# _endMove.
+}
+
+#
+# Provide a lowercase access method for the Tabset class
+#
+proc ::iwidgets::tabset {pathName args} {
+ uplevel ::iwidgets::Tabset $pathName $args
+}
+
+# ----------------------------------------------------------------------
+# CONSTRUCTOR
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::constructor {args} {
+ global tcl_platform
+
+ #
+ # Create the canvas that holds the tabs
+ #
+ itk_component add canvas {
+ canvas $itk_interior.canvas -highlightthickness 0
+ } {
+ keep -cursor -width -height
+ }
+ pack $itk_component(canvas) -fill both -expand yes -anchor nw
+
+ # ... This gives us a chance to redraw our bevel borders, etc when
+ # the size of our canvas changes...
+ bind $itk_component(canvas) <Configure> \
+ [code $this _canvasReconfigure %w %h]
+
+ # ... Allow button 2 scrolling as in label widget.
+ if {$tcl_platform(os) != "HP-UX"} {
+ bind $itk_component(canvas) <2> \
+ [code $this _startMove %x %y]
+ bind $itk_component(canvas) <B2-Motion> \
+ [code $this _moveTabs %x %y]
+ bind $itk_component(canvas) <ButtonRelease-2> \
+ [code $this _endMove %x %y]
+ }
+
+ # @@@
+ # @@@ Is there a better way?
+ # @@@
+ bind $itk_component(hull) <Any-Enter> "focus $itk_component(hull)"
+ bind $itk_component(hull) <Tab> [code $this next]
+ bind $itk_component(hull) <Shift-Tab> [code $this prev]
+
+ eval itk_initialize $args
+
+ _configRelayout
+
+ _recalcCanvasGeom
+
+}
+
+body iwidgets::Tabset::destructor {} {
+ foreach tab $_tabs {
+ itcl::delete object $tab
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTIONS
+# ----------------------------------------------------------------------
+
+# ----------------------------------------------------------------------
+# OPTION -width
+#
+# Sets the width explicitly for the canvas of the tabset
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::width {
+ if {$itk_option(-width) != {}} {
+ }
+ set _width [winfo pixels $itk_interior $itk_option(-width)]
+}
+
+# ----------------------------------------------------------------------
+# OPTION -equaltabs
+#
+# If set to true, causes horizontal tabs to be equal in
+# in width and vertical tabs to equal in height.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::equaltabs {
+ if {$itk_option(-equaltabs) != {}} {
+ set _relayout true
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -height
+#
+# Sets the height explicitly for the canvas of the tabset
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::height {
+ set _height [winfo pixels $itk_interior $itk_option(-height)]
+}
+
+# ----------------------------------------------------------------------
+# OPTION -tabpos
+#
+# Sets the tab position of tabs, n, s, e, w
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::tabpos {
+ if {$itk_option(-tabpos) != {}} {
+ switch $itk_option(-tabpos) {
+ n {
+ _tabConfigure -invert true -orient horizontal
+ }
+ s {
+ _tabConfigure -invert false -orient horizontal
+ }
+ w {
+ _tabConfigure -invert false -orient vertical
+ }
+ e {
+ _tabConfigure -invert true -orient vertical
+ }
+ default {
+ error "bad anchor position\
+ \"$itk_option(-tabpos)\" must be n, s, e, or w"
+ }
+ }
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -raiseselect
+#
+# Sets whether to raise selected tabs slightly
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::raiseselect {
+ if {$itk_option(-raiseselect) != {}} {
+ set _relayout true
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -start
+#
+# Sets the offset to start of tab set
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::start {
+ if {$itk_option(-start) != {}} {
+ set _start [winfo pixels $itk_interior $itk_option(-start)]
+ set _relayout true
+ } else {
+ set _start 4
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -margin
+#
+# Sets the margin used above n tabs, below s tabs, left of e
+# tabs, right of w tabs
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::margin {
+ if {$itk_option(-margin) != {}} {
+ set _margin [winfo pixels $itk_interior $itk_option(-margin)]
+ set _relayout true
+ } else {
+ set _margin 5
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -tabborders
+#
+# Boolean that specifies whether to draw the borders of
+# the unselected tabs (tabs in background)
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::tabborders {
+ if {$itk_option(-tabborders) != {}} {
+ _tabConfigure -tabborders $itk_option(-tabborders)
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -bevelamount
+#
+# Specifies pixel size of tab corners. 0 means no corners.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::bevelamount {
+ if {$itk_option(-bevelamount) != {}} {
+ _tabConfigure -bevelamount $itk_option(-bevelamount)
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -padx
+#
+# Sets the padding in each tab to the left and right of label
+# I don't convert for fpixels, since Tab does it for me.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::padx {
+ if {$itk_option(-padx) != {}} {
+ _tabConfigure -padx $itk_option(-padx)
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -pady
+#
+# Sets the padding in each tab to the left and right of label
+# I don't convert for fpixels, since Tab does it for me.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::pady {
+ if {$itk_option(-pady) != {}} {
+ _tabConfigure -pady $itk_option(-pady)
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -gap
+#
+# Sets the amount of spacing between tabs in pixels
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::gap {
+ if {$itk_option(-gap) != {}} {
+ if {$itk_option(-gap) != "overlap"} {
+ set _gap [winfo pixels $itk_interior $itk_option(-gap)]
+ } else {
+ set _gap overlap
+ }
+ set _relayout true
+ } else {
+ set _gap overlap
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -angle
+#
+# Sets the angle of the tab's sides
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::angle {
+ if {$itk_option(-angle) != {}} {
+ _tabConfigure -angle $itk_option(-angle)
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -font
+#
+# Sets the font of the tab (SELECTED and UNSELECTED)
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::font {
+ if {$itk_option(-font) != {}} {
+ _tabConfigure -font $itk_option(-font)
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -state
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::state {
+ if {$itk_option(-state) != {}} {
+ _tabConfigure -state $itk_option(-state)
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -disabledforeground
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::disabledforeground {
+ if {$itk_option(-disabledforeground) != {}} {
+ _tabConfigure \
+ -disabledforeground $itk_option(-disabledforeground)
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -foreground
+#
+# Sets the foreground label color of UNSELECTED tabs
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::foreground {
+ _tabConfigure -foreground $itk_option(-foreground)
+}
+
+# ----------------------------------------------------------------------
+# OPTION -background
+#
+# Sets the background color of UNSELECTED tabs
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::background {
+ if {$itk_option(-background) != {}} {
+ _tabConfigure -background $itk_option(-background)
+ } else {
+ _tabConfigure -background \
+ [$itk_component(canvas) cget -background]
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -selectforeground
+#
+# Sets the foreground label color of SELECTED tabs
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::selectforeground {
+ _tabConfigure -selectforeground $itk_option(-selectforeground)
+}
+
+# ----------------------------------------------------------------------
+# OPTION -backdrop
+#
+# Sets the background color of the Tabset backdrop (behind the tabs)
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::backdrop {
+ if {$itk_option(-backdrop) != {}} {
+ $itk_component(canvas) configure \
+ -background $itk_option(-backdrop)
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -selectbackground
+#
+# Sets the background color of SELECTED tabs
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::selectbackground {
+ if {$itk_option(-selectbackground) != {}} {
+ } else {
+ #set _selectBackground \
+ [$itk_component(canvas) cget -background]
+ }
+ _tabConfigure -selectbackground $itk_option(-selectbackground)
+}
+
+# ----------------------------------------------------------------------
+# OPTION -command
+#
+# The command to invoke when a tab is hit.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tabset::command {
+ if {$itk_option(-command) != {}} {
+ set _cmdStr $itk_option(-command)
+ }
+}
+
+# ----------------------------------------------------------------------
+# METHOD: add ?option value...?
+#
+# Creates a tab and appends it to the list of tabs.
+# processes tabconfigure for the tab added.
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::add {args} {
+ set tabName [eval _createTab $args]
+ lappend _tabs $tabName
+
+ _relayoutTabs
+
+ return $tabName
+}
+
+# ----------------------------------------------------------------------
+# METHOD: configure ?option? ?value option value...?
+#
+# Acts as an addendum to the itk::Widget::configure method.
+#
+# Checks the _relayout flag to see if after configures are done
+# we need to relayout the tabs.
+#
+# _skipRelayout is set in the MB2 scroll methods, to avoid constant
+# relayout of tabs while dragging the mouse.
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::configure {args} {
+ set result [eval itk::Archetype::configure $args]
+
+ _configRelayout
+
+ return $result
+}
+
+body iwidgets::Tabset::_configRelayout {} {
+ # then relayout tabs if necessary
+ if { $_relayout } {
+ if { $_skipRelayout } {
+ } else {
+ _relayoutTabs
+ }
+ set _relayout false
+ }
+}
+
+# ----------------------------------------------------------------------
+# METHOD: delete index1 ?index2?
+#
+# Deletes a tab or range of tabs from the tabset
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::delete {args} {
+ if { $_tabs == {} } {
+ error "can't delete tabs,\
+ no tabs in the tabset named $itk_component(hull)"
+ }
+
+ set len [llength $args]
+ switch $len {
+ 0 {
+ error "wrong # args: should be\
+ \"$itk_component(hull) delete index1 ?index2?\""
+ }
+
+ 1 {
+ set fromTab [index [lindex $args 0]]
+ if { $fromTab == -1 } {
+ error "bad value for index1:\
+ [lindex $args 0] in call to delete"
+ }
+ set toTab $fromTab
+ _deleteTabs $fromTab $toTab
+ }
+
+ 2 {
+ set fromTab [index [lindex $args 0]]
+ if { $fromTab == -1 } {
+ error "bad value for index1:\
+ [lindex $args 0] in call to delete"
+ }
+ set toTab [index [lindex $args 1]]
+
+ if { $toTab == -1 } {
+ error "bad value for index2:\
+ [lindex $args 1] in call to delete"
+ }
+ _deleteTabs $fromTab $toTab
+ }
+
+ default {
+ error "wrong # args: should be\
+ \"$itk_component(hull) delete index1 ?index2?\""
+ }
+ }
+}
+
+# ----------------------------------------------------------------------
+# METHOD: index index
+#
+# Given an index identifier returns the numeric index of the tab
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::index {index} {
+ return [_index $_tabs $index $_currTab]
+}
+
+# ----------------------------------------------------------------------
+# METHOD: insert index ?option value...?
+#
+# Inserts a tab before a index. The before tab may
+# be specified as a label or a tab position.
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::insert {index args} {
+ if { $_tabs == {} } {
+ error "no tab to insert before,\
+ tabset '$itk_component(hull)' is empty"
+ }
+
+ # get the tab
+ set tab [index $index]
+
+ # catch bad value for before tab.
+ if { $tab < 0 || $tab >= [llength $_tabs] } {
+ error "bad value $tab for index:\
+ should be between 0 and [expr [llength $_tabs] - 1]"
+ }
+
+ # create the new tab and get its name...
+ set tabName [eval _createTab $args]
+
+ # grab the name of the tab currently selected. (to keep in sync)
+ set currTabName [lindex $_tabs $_currTab]
+
+ # insert tabName before $tab
+ set _tabs [linsert $_tabs $tab $tabName]
+
+ # keep the _currTab in sync with the insert.
+ set _currTab [lsearch -exact $_tabs $currTabName]
+
+ _relayoutTabs
+
+ return $tabName
+}
+
+# ----------------------------------------------------------------------
+# METHOD: prev
+#
+# Selects the prev tab. Wraps at first back to last tab.
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::prev {} {
+ if { $_tabs == {} } {
+ error "can't goto previous tab,\
+ no tabs in the tabset: $itk_component(hull)"
+ }
+
+ # bump to the previous tab and wrap if necessary
+ set prev [expr $_currTab - 1]
+ if { $prev < 0 } {
+ set prev [expr [llength $_tabs] - 1]
+ }
+
+ select $prev
+
+}
+
+# ----------------------------------------------------------------------
+# METHOD: next
+#
+# Selects the next tab. Wraps at last back to first tab.
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::next {} {
+ if { $_tabs == {} } {
+ error "can't goto next tab,\
+ no tabs in the tabset: $itk_component(hull)"
+ }
+
+ # bump to the next tab and wrap if necessary
+ set next [expr $_currTab + 1]
+ if { $next >= [llength $_tabs] } {
+ set next 0
+ }
+
+ select $next
+}
+
+# ----------------------------------------------------------------------
+# METHOD: select index
+#
+# Select a tab by index
+#
+# Lowers the last _currTab if it existed.
+# Then raises the new one if it exists.
+#
+# Returns numeric index of selection, -1 if failed.
+# -------------------------------------------------------------
+body iwidgets::Tabset::select {index} {
+ if { $_tabs == {} } {
+ error "can't activate a tab,\
+ no tabs in the tabset: $itk_component(hull)"
+ }
+
+ # if there is not current selection just ignore trying this selection
+ if { $index == "select" && $_currTab == -1 } {
+ return -1
+ }
+
+ # is selection request in range ?
+ set reqTab [index $index]
+ if { $reqTab == -1 } {
+ error "bad value $index for index:\
+ should be from 0 to [expr [llength $_tabs] - 1]"
+ }
+
+ # If already selected then ignore and return...
+ if { $reqTab == $_currTab } {
+ return $reqTab
+ }
+
+ # ---- Deselect
+ if { $_currTab != -1 } {
+ set currTabName [lindex $_tabs $_currTab]
+ $currTabName deselect
+
+ # handle different orientations...
+ if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s"} {
+ $currTabName configure -top $_deselectedTop
+ } else {
+ $currTabName configure -left $_deselectedLeft
+ }
+ }
+
+ # get the stacking order correct...
+ foreach tab $_tabs {
+ $tab lower
+ }
+
+ # set this now so that the -command cmd can do an 'index select'
+ # to operate on this tab.
+ set _currTab $reqTab
+
+ # ---- Select
+ set reqTabName [lindex $_tabs $reqTab]
+ $reqTabName select
+ if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s"} {
+ $reqTabName configure -top $_selectedTop
+ } else {
+ $reqTabName configure -left $_selectedLeft
+ }
+
+ set _currTab $reqTab
+
+ # invoke any user command string, appended with tab index number
+ if { $_cmdStr != {} } {
+ set newCmd $_cmdStr
+ eval [lappend newCmd $reqTab]
+ }
+
+ return $reqTab
+}
+
+# ----------------------------------------------------------------------
+# METHOD: tabcget index ?option?
+#
+# Returns the value for the option setting of the tab at index $index.
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::tabcget {index args} {
+ return [lindex [eval tabconfigure $index $args] 2]
+}
+
+# ----------------------------------------------------------------------
+# METHOD: tabconfigure index ?option? ?value option value?
+#
+# tabconfigure index : returns configuration list
+# tabconfigure index -option : returns option values
+# tabconfigure index ?option value option value ...? sets options
+# and returns empty string.
+#
+# Performs configure on a given tab denoted by index.
+#
+# Index may be a tab number or a pattern matching the label
+# associated with a tab.
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::tabconfigure {index args} {
+ # convert index to numeric
+ set tab [index $index]
+
+ if { $tab == -1 } {
+ error "bad index value:\
+ $index for $itk_component(hull) tabconfigure"
+ }
+
+ set tabName [lindex $_tabs $tab]
+
+ set len [llength $args]
+ switch $len {
+ 0 {
+ return [eval $tabName configure]
+ }
+ 1 {
+ return [eval $tabName configure $args]
+ }
+ default {
+ eval $tabName configure $args
+ _relayoutTabs
+ select select
+ }
+ }
+ return ""
+}
+
+# ----------------------------------------------------------------------
+# PROTECTED METHOD: _selectName
+#
+# internal method to allow selection by internal tab name
+# rather than index. This is used by the bind methods
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::_selectName {tabName} {
+ # if the tab is disabled, then ignore this selection...
+ if { [$tabName cget -state] == "disabled" } {
+ return
+ }
+
+ set tab [lsearch -exact $_tabs $tabName]
+ select $tab
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _createTab
+#
+# Creates a tab, using unique tab naming, propagates background
+# and keeps unique id up to date.
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::_createTab {args} {
+ #
+ # create an internal name for the tab: tab0, tab1, etc.
+ # these are one-up numbers they do not
+ # correspond to the position the tab is located in.
+ #
+ set tabName $this-tab$_uniqueID
+
+ switch $itk_option(-tabpos) {
+ n {
+ set invert true
+ set orient horizontal
+ set x 0
+ set y [expr $_margin + 1]
+ }
+ s {
+ set invert false
+ set orient horizontal
+ set x 0
+ set y 0
+ }
+ w {
+ set invert false
+ set orient vertical
+ set x 0
+ set y 0
+ }
+ e {
+ set invert true
+ set orient vertical
+ set x [expr $_margin + 1]
+ set y 0
+ }
+ default {
+ error "bad anchor position\
+ \"$itk_option(-tabpos)\" must be n, s, e, or w"
+ }
+ }
+
+ eval iwidgets::Tab $tabName $itk_component(canvas) \
+ -left $x \
+ -top $y \
+ -font [list $itk_option(-font)] \
+ -background $itk_option(-background) \
+ -foreground $itk_option(-foreground) \
+ -selectforeground $itk_option(-selectforeground) \
+ -disabledforeground $itk_option(-disabledforeground) \
+ -selectbackground $itk_option(-selectbackground) \
+ -angle $itk_option(-angle) \
+ -padx $itk_option(-padx) \
+ -pady $itk_option(-pady) \
+ -bevelamount $itk_option(-bevelamount) \
+ -state $itk_option(-state) \
+ -tabborders $itk_option(-tabborders) \
+ -invert $invert \
+ -orient $orient \
+ $args
+
+ $tabName lower
+
+ $itk_component(canvas) \
+ bind $tabName <Button-1> [code $this _selectName $tabName]
+
+ incr _uniqueID
+
+ return $tabName
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _deleteTabs
+#
+# Deletes tabs from $fromTab to $toTab.
+#
+# Operates in two passes, destroys all the widgets
+# Then removes the pathName from the tab list
+#
+# Also keeps the current selection in bounds.
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::_deleteTabs {fromTab toTab} {
+ for { set tab $fromTab } { $tab <= $toTab } { incr tab } {
+ set tabName [lindex $_tabs $tab]
+
+ # unbind Button-1 from this window name
+ $itk_component(canvas) bind $tabName <Button-1> {}
+
+ # Destroy the Tab class...
+ itcl::delete object $tabName
+ }
+
+ # physically remove the tab
+ set _tabs [lreplace $_tabs $fromTab $toTab]
+
+ # If we deleted a selected tab set our selection to none
+ if { $_currTab >= $fromTab && $_currTab <= $toTab } {
+ set _currTab -1
+ _drawBevelBorder
+ }
+
+ # make sure _currTab stays in sync with new numbering...
+ if { $_tabs == {} } {
+ # if deleted only remaining tab,
+ # reset current tab to undefined
+ set _currTab -1
+
+ # or if the current tab was the last tab, it needs come back
+ } elseif { $_currTab >= [llength $_tabs] } {
+ incr _currTab -1
+ if { $_currTab < 0 } {
+ # but only to zero
+ set _currTab 0
+ }
+ }
+
+ _relayoutTabs
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _index
+#
+# pathList : list of path names to search thru if index is a label
+# index : either number, 'select', 'end', or pattern
+# select : current selection
+#
+# _index takes takes the value $index converts it to
+# a numeric identifier. If the value is not already
+# an integer it looks it up in the $pathList array.
+# If it fails it returns -1
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::_index {pathList index select} {
+ switch $index {
+ select {
+ set number $select
+ }
+ end {
+ set number [expr [llength $pathList] -1]
+ }
+ default {
+ # is it an number already?
+ if { [regexp {^[0-9]+$} $index] } {
+ set number $index
+ if { $number < 0 || $number >= [llength $pathList] } {
+ set number -1
+ }
+
+ # otherwise it is a label
+ } else {
+ # look thru the pathList of pathNames and
+ # get each label and compare with index.
+ # if we get a match then set number to postion in $pathList
+ # and break out.
+ # otherwise number is still -1
+ set i 0
+ set number -1
+ foreach pathName $pathList {
+ set label [$pathName cget -label]
+ if { $label == $index } {
+ set number $i
+ break
+ }
+ incr i
+ }
+ }
+ }
+ }
+
+ return $number
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _tabConfigure
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::_tabConfigure {args} {
+ foreach tab $_tabs {
+ eval $tab configure $args
+ }
+
+ set _relayout true
+
+ if { $_tabs != {} } {
+ select select
+ }
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _relayoutTabs
+#
+# relays out the tabs with correct spacing...
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::_relayoutTabs {} {
+ if { [llength $_tabs] == 0 } {
+ return
+ }
+
+ # get the max width for fixed width tabs...
+ set maxWidth 0
+ foreach tab $_tabs {
+ set width [$tab labelwidth]
+ if { $width > $maxWidth } {
+ set maxWidth $width
+ }
+ }
+
+ # get the max height for fixed height tabs...
+ set maxHeight 0
+ foreach tab $_tabs {
+ set height [$tab labelheight]
+ if { $height > $maxHeight } {
+ set maxHeight $height
+ }
+ }
+
+ # get curr tab's name
+ set currTabName [lindex $_tabs $_currTab]
+
+ # Start with our margin offset in pixels...
+ set tabStart $_start
+
+ if { $itk_option(-raiseselect) } {
+ set raiseAmt 2
+ } else {
+ set raiseAmt 0
+ }
+
+ #
+ # Depending on the tab layout: n, s, e, or w place the tabs
+ # according to orientation, raise, margins, etc.
+ #
+ switch $itk_option(-tabpos) {
+ n {
+ set _selectedTop [expr $_margin + 1]
+ set _deselectedTop [expr $_selectedTop + $raiseAmt]
+
+ if { $itk_option(-equaltabs) } {
+ set tabWidth $maxWidth
+ } else {
+ set tabWidth 0
+ }
+
+ foreach tab $_tabs {
+ if { $tab == $currTabName } {
+ $tab configure -left $tabStart -top $_selectedTop \
+ -height $maxHeight -width $tabWidth -anchor c
+ } else {
+ $tab configure -left $tabStart -top $_deselectedTop \
+ -height $maxHeight -width $tabWidth -anchor c
+ }
+ set tabStart [expr $tabStart + [_calcNextTabOffset $tab]]
+ }
+
+ }
+ s {
+ set _selectedTop 0
+ set _deselectedTop [expr $_selectedTop - $raiseAmt]
+
+ if { $itk_option(-equaltabs) } {
+ set tabWidth $maxWidth
+ } else {
+ set tabWidth 0
+ }
+
+ foreach tab $_tabs {
+ if { $tab == $currTabName } {
+ $tab configure -left $tabStart -top $_selectedTop \
+ -height $maxHeight -width $tabWidth -anchor c
+ } else {
+ $tab configure -left $tabStart -top $_deselectedTop \
+ -height $maxHeight -width $tabWidth -anchor c
+ }
+ set tabStart [expr $tabStart + [_calcNextTabOffset $tab]]
+ }
+
+ }
+ w {
+ set _selectedLeft [expr $_margin + 1]
+ set _deselectedLeft [expr $_selectedLeft + $raiseAmt]
+
+ if { $itk_option(-equaltabs) } {
+ set tabHeight $maxHeight
+ } else {
+ set tabHeight 0
+ }
+
+ foreach tab $_tabs {
+ # selected
+ if { $tab == $currTabName } {
+ $tab configure -top $tabStart -left $_selectedLeft \
+ -height $tabHeight -width $maxWidth -anchor e
+ # deselected
+ } else {
+ $tab configure -top $tabStart -left $_deselectedLeft \
+ -height $tabHeight -width $maxWidth -anchor e
+ }
+ set tabStart [expr $tabStart + [_calcNextTabOffset $tab]]
+ }
+
+ }
+ e {
+ set _selectedLeft 0
+ set _deselectedLeft [expr $_selectedLeft - $raiseAmt]
+
+ if { $itk_option(-equaltabs) } {
+ set tabHeight $maxHeight
+ } else {
+ set tabHeight 0
+ }
+
+ foreach tab $_tabs {
+ # selected
+ if { $tab == $currTabName } {
+ $tab configure -top $tabStart -left $_selectedLeft \
+ -height $tabHeight -width $maxWidth -anchor w
+ # deselected
+ } else {
+ $tab configure -top $tabStart -left $_deselectedLeft \
+ -height $tabHeight -width $maxWidth -anchor w
+ }
+ set tabStart [expr $tabStart + [_calcNextTabOffset $tab]]
+ }
+
+ }
+ default {
+ error "bad anchor position\
+ \"$itk_option(-tabpos)\" must be n, s, e, or w"
+ }
+ }
+
+ # put border on & calc our new canvas size...
+ _drawBevelBorder
+ _recalcCanvasGeom
+
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _drawBevelBorder
+#
+# draws the bevel border along tab edge (below selected tab)
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::_drawBevelBorder {} {
+ $itk_component(canvas) delete bevelBorder
+
+ switch $itk_option(-tabpos) {
+ n {
+ $itk_component(canvas) create line \
+ 0 [expr $_canvasHeight - 1] \
+ $_canvasWidth [expr $_canvasHeight - 1] \
+ -fill [iwidgets::colors::topShadow $itk_option(-selectbackground)] \
+ -tags bevelBorder
+ $itk_component(canvas) create line \
+ 0 $_canvasHeight \
+ $_canvasWidth $_canvasHeight \
+ -fill [iwidgets::colors::topShadow $itk_option(-selectbackground)] \
+ -tags bevelBorder
+ }
+ s {
+ $itk_component(canvas) create line \
+ 0 0 \
+ $_canvasWidth 0 \
+ -fill [iwidgets::colors::bottomShadow $itk_option(-selectbackground)] \
+ -tags bevelBorder
+ $itk_component(canvas) create line \
+ 0 1 \
+ $_canvasWidth 1 \
+ -fill black \
+ -tags bevelBorder
+ }
+ w {
+ $itk_component(canvas) create line \
+ $_canvasWidth 0 \
+ $_canvasWidth [expr $_canvasHeight - 1] \
+ -fill [iwidgets::colors::topShadow $itk_option(-selectbackground)] \
+ -tags bevelBorder
+ $itk_component(canvas) create line \
+ [expr $_canvasWidth - 1] 0 \
+ [expr $_canvasWidth - 1] [expr $_canvasHeight - 1] \
+ -fill [iwidgets::colors::topShadow $itk_option(-selectbackground)] \
+ -tags bevelBorder
+
+ }
+ e {
+ $itk_component(canvas) create line \
+ 0 0 \
+ 0 [expr $_canvasHeight - 1] \
+ -fill black \
+ -tags bevelBorder
+ $itk_component(canvas) create line \
+ 1 0 \
+ 1 [expr $_canvasHeight - 1] \
+ -fill [iwidgets::colors::bottomShadow $itk_option(-selectbackground)] \
+ -tags bevelBorder
+
+ }
+ }
+
+ $itk_component(canvas) raise bevelBorder
+ if { $_currTab != -1 } {
+ set currTabName [lindex $_tabs $_currTab]
+ $currTabName raise
+ }
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _calcNextTabOffset
+#
+# given $tabName, determines the offset in pixels to place
+# the next tab's start edge at.
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::_calcNextTabOffset {tabName} {
+ if { $_gap == "overlap" } {
+ return [$tabName offset]
+ } else {
+ return [expr [$tabName majordim] + $_gap]
+ }
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _tabBounds
+#
+# calculates the bounding box that will completely enclose
+# all the tabs.
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::_tabBounds {} {
+ set bbox { 100000 100000 -10000 -10000 }
+ foreach tab $_tabs {
+ set tabBBox [$tab bbox]
+ # if this left is less use it
+ if { [lindex $tabBBox 0] < [lindex $bbox 0] } {
+ set bbox [lreplace $bbox 0 0 [lindex $tabBBox 0]]
+ }
+ # if this top is greater use it
+ if { [lindex $tabBBox 1] < [lindex $bbox 1] } {
+ set bbox [lreplace $bbox 1 1 [lindex $tabBBox 1]]
+ }
+ # if this right is less use it
+ if { [lindex $tabBBox 2] > [lindex $bbox 2] } {
+ set bbox [lreplace $bbox 2 2 [lindex $tabBBox 2]]
+ }
+ # if this bottom is greater use it
+ if { [lindex $tabBBox 3] > [lindex $bbox 3] } {
+ set bbox [lreplace $bbox 3 3 [lindex $tabBBox 3]]
+ }
+
+ }
+ return $bbox
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _recalcCanvasGeom
+#
+# Based on size of tabs, recalculates the canvas geometry that
+# will hold the tabs.
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::_recalcCanvasGeom {} {
+ if { [llength $_tabs] == 0 } {
+ return
+ }
+
+ set bbox [_tabBounds]
+
+ set width [lindex [_tabBounds] 2]
+ set height [lindex [_tabBounds] 3]
+
+ # now we have the dimensions of all the tabs in the canvas.
+
+
+ switch $itk_option(-tabpos) {
+ n {
+ # height already includes margin
+ $itk_component(canvas) configure \
+ -width $width \
+ -height $height
+ }
+ s {
+ $itk_component(canvas) configure \
+ -width $width \
+ -height [expr $height + $_margin]
+ }
+ w {
+ # width already includes margin
+ $itk_component(canvas) configure \
+ -width $width \
+ -height [expr $height + 1]
+ }
+ e {
+ $itk_component(canvas) configure \
+ -width [expr $width + $_margin] \
+ -height [expr $height + 1]
+ }
+ default {
+ }
+ }
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _canvasReconfigure
+#
+# Bound to the reconfigure notify event of a canvas, this
+# method resets canvas's correct width (since we are fill x)
+# and redraws the beveled edge border.
+# will hold the tabs.
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::_canvasReconfigure {width height} {
+ set _canvasWidth $width
+ set _canvasHeight $height
+
+ if { [llength $_tabs] > 0 } {
+ _drawBevelBorder
+ }
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _startMove
+#
+# This method is bound to the MB2 down in the canvas area of the
+# tab set. This starts animated scrolling of the tabs along their
+# major axis.
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::_startMove {x y} {
+ if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s" } {
+ set _anchorX $x
+ } else {
+ set _anchorY $y
+ }
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _moveTabs
+#
+# This method is bound to the MB2 motion in the canvas area of the
+# tab set. This causes the tabset to move with the mouse.
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::_moveTabs {x y} {
+ if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s" } {
+ set startX [expr $_start + $x - $_anchorX]
+ foreach tab $_tabs {
+ $tab configure -left $startX
+ set startX [expr $startX + [_calcNextTabOffset $tab]]
+ }
+ } else {
+ set startY [expr $_start + $y - $_anchorY]
+ foreach tab $_tabs {
+ $tab configure -top $startY
+ set startY [expr $startY + [_calcNextTabOffset $tab]]
+ }
+ }
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _endMove
+#
+# This method is bound to the MB2 release in the canvas area of the
+# tab set. This causes the tabset to end moving tabs.
+# ----------------------------------------------------------------------
+body iwidgets::Tabset::_endMove {x y} {
+ if { $itk_option(-tabpos) == "n" || $itk_option(-tabpos) == "s" } {
+ set startX [expr $_start + $x - $_anchorX]
+ set _skipRelayout true
+ configure -start $startX
+ set _skipRelayout false
+ } else {
+ set startY [expr $_start + $y - $_anchorY]
+ set _skipRelayout true
+ configure -start $startY
+ set _skipRelayout false
+ }
+}
+
+
+#==============================================================
+# CLASS: Tab
+#==============================================================
+
+class iwidgets::Tab {
+ constructor {args} {}
+
+ destructor {}
+
+ public variable bevelamount 0 {}
+ public variable state normal {}
+ public variable height 0 {}
+ public variable width 0 {}
+ public variable anchor c {}
+ public variable left 0 {}
+ public variable top 0 {}
+ public variable image {} {}
+ public variable bitmap {} {}
+ public variable label {} {}
+ public variable padx 4 {}
+ public variable pady 4 {}
+ public variable selectbackground "gray70" {}
+ public variable selectforeground "black" {}
+ public variable disabledforeground "gray" {}
+ public variable background "white" {}
+ public variable foreground "black" {}
+ public variable orient vertical {}
+ public variable invert false {}
+ public variable angle 20 {}
+ public variable font \
+ "-adobe-helvetica-bold-r-normal--34-240-100-100-p-182-iso8859-1" {}
+ public variable tabborders true {}
+
+ public method configure {args}
+ public method bbox {}
+ public method deselect {}
+ public method lower {}
+ public method majordim {}
+ public method minordim {}
+ public method offset {}
+ public method raise {}
+ public method select {}
+ public method labelheight {}
+ public method labelwidth {}
+
+ private method _makeTab {}
+ private method _createLabel {canvas tagList}
+ private method _makeEastTab {canvas}
+ private method _makeWestTab {canvas}
+ private method _makeNorthTab {canvas}
+ private method _makeSouthTab {canvas}
+ private method _calcLabelDim {labelItem}
+ private method _itk_config {args} @itcl-builtin-configure
+ private method _selectNoRaise {}
+ private method _deselectNoLower {}
+
+ private variable _selected false
+ private variable _padX 0
+ private variable _padY 0
+
+ private variable _canvas
+
+ # these are in pixels
+ private variable _left 0
+ private variable _width 0
+ private variable _height 0
+ private variable _oldLeft 0
+ private variable _top 0
+ private variable _oldTop 0
+
+ private variable _right
+ private variable _bottom
+
+ private variable _offset
+ private variable _majorDim
+ private variable _minorDim
+
+ private variable _darkShadow
+ private variable _lightShadow
+
+ #
+ # graphic components that make up a tab
+ #
+ private variable _gRegion
+ private variable _gLabel
+ private variable _gLightOutline {}
+ private variable _gBlackOutline {}
+ private variable _gTopLine
+ private variable _gTopLineShadow
+ private variable _gLightShadow
+ private variable _gDarkShadow
+
+ private variable _labelWidth 0
+ private variable _labelHeight 0
+
+ private variable _labelXOrigin 0
+ private variable _labelYOrigin 0
+
+ private variable _just left
+
+ private variable _configTripped true
+
+ common _tan
+
+ set _tan(0) 0.0
+ set _tan(1) 0.0175
+ set _tan(2) 0.0349
+ set _tan(3) 0.0524
+ set _tan(4) 0.0699
+ set _tan(5) 0.0875
+ set _tan(6) 0.1051
+ set _tan(7) 0.1228
+ set _tan(8) 0.1405
+ set _tan(9) 0.1584
+ set _tan(10) 0.1763
+ set _tan(11) 0.1944
+ set _tan(12) 0.2126
+ set _tan(13) 0.2309
+ set _tan(14) 0.2493
+ set _tan(15) 0.2679
+ set _tan(16) 0.2867
+ set _tan(17) 0.3057
+ set _tan(18) 0.3249
+ set _tan(19) 0.3443
+ set _tan(20) 0.3640
+ set _tan(21) 0.3839
+ set _tan(22) 0.4040
+ set _tan(23) 0.4245
+ set _tan(24) 0.4452
+ set _tan(25) 0.4663
+ set _tan(26) 0.4877
+ set _tan(27) 0.5095
+ set _tan(28) 0.5317
+ set _tan(29) 0.5543
+ set _tan(30) 0.5774
+ set _tan(31) 0.6009
+ set _tan(32) 0.6294
+ set _tan(33) 0.6494
+ set _tan(34) 0.6745
+ set _tan(35) 0.7002
+ set _tan(36) 0.7265
+ set _tan(37) 0.7536
+ set _tan(38) 0.7813
+ set _tan(39) 0.8098
+ set _tan(40) 0.8391
+ set _tan(41) 0.8693
+ set _tan(42) 0.9004
+ set _tan(43) 0.9325
+ set _tan(44) 0.9657
+ set _tan(45) 1.0
+}
+
+# ----------------------------------------------------------------------
+# CONSTRUCTOR
+# ----------------------------------------------------------------------
+body iwidgets::Tab::constructor {args} {
+
+ set _canvas [lindex $args 0]
+ set args [lrange $args 1 [llength $args]]
+
+ set _darkShadow [iwidgets::colors::bottomShadow $selectbackground]
+ set _lightShadow [iwidgets::colors::topShadow $selectbackground]
+
+ if { $args != "" } {
+ eval configure $args
+ }
+}
+
+# ----------------------------------------------------------------------
+# DESTRUCTOR
+# ----------------------------------------------------------------------
+body iwidgets::Tab::destructor {} {
+ if { [winfo exists $_canvas] } {
+ $_canvas delete $this
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTIONS
+# ----------------------------------------------------------------------
+#
+# Note, we trip _configTripped for every option that requires the tab
+# to be remade.
+#
+# ----------------------------------------------------------------------
+# OPTION -bevelamount
+#
+# Specifies the size of tab corners. A value of 0 with angle set
+# to 0 results in square tabs. A bevelAmount of 4, means that the
+# tab will be drawn with angled corners that cut in 4 pixels from
+# the edge of the tab. The default is 0.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::bevelamount {
+}
+
+# ----------------------------------------------------------------------
+# OPTION -state
+#
+# sets the active state of the tab. specifying normal allows
+# the tab to be selectable. Specifying disabled disables the tab,
+# causing its image, bitmap, or label to be drawn with the
+# disabledForeground color.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::state {
+}
+
+# ----------------------------------------------------------------------
+# OPTION -height
+#
+# the height of the tab. if 0, uses the font label height.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::height {
+ set _height [winfo pixels $_canvas $height]
+ set _configTripped true
+}
+
+# ----------------------------------------------------------------------
+# OPTION -width
+#
+# The width of the tab. If 0, uses the font label width.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::width {
+ set _width [winfo pixels $_canvas $width]
+ set _configTripped true
+}
+
+# ----------------------------------------------------------------------
+# OPTION -anchor
+#
+# Where the text in the tab will be anchored: n,nw,ne,s,sw,se,e,w,center
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::anchor {
+}
+
+# ----------------------------------------------------------------------
+# OPTION -left
+#
+# Specifies the left edge of the tab's bounding box. This value
+# may have any of the forms acceptable to Tk_GetPixels.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::left {
+
+ # get into pixels
+ set _left [winfo pixels $_canvas $left]
+
+ # move by offset from last setting
+ $_canvas move $this [expr $_left - $_oldLeft] 0
+
+ # update old for next time
+ set _oldLeft $_left
+}
+
+# ----------------------------------------------------------------------
+# OPTION -top
+#
+# Specifies the topedge of the tab's bounding box. This value may
+# have any of the forms acceptable to Tk_GetPixels.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::top {
+
+ # get into pixels
+ set _top [winfo pixels $_canvas $top]
+
+ # move by offset from last setting
+ $_canvas move $this 0 [expr $_top - $_oldTop]
+
+ # update old for next time
+ set _oldTop $_top
+}
+
+# ----------------------------------------------------------------------
+# OPTION -image
+#
+# Specifies the imageto display in the tab.
+# Images are created with the image create command.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::image {
+ set _configTripped true
+}
+
+# ----------------------------------------------------------------------
+# OPTION -bitmap
+#
+# If bitmap is an empty string, specifies the bitmap to display in
+# the tab. Bitmap may be of any of the forms accepted by Tk_GetBitmap.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::bitmap {
+ set _configTripped true
+}
+
+# ----------------------------------------------------------------------
+# OPTION -label
+#
+# If image is an empty string and bitmap is an empty string,
+# it specifies a text string to be placed in the tab's label.
+# This label serves as an additional identifier used to reference
+# the tab. Label may be used for the index value in widget commands.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::label {
+ set _configTripped true
+}
+
+# ----------------------------------------------------------------------
+# OPTION -padx
+#
+# Horizontal padding around the label (text, image, or bitmap).
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::padx {
+ set _configTripped true
+ set _padX [winfo pixels $_canvas $padx]
+}
+
+# ----------------------------------------------------------------------
+# OPTION -pady
+#
+# Vertical padding around the label (text, image, or bitmap).
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::pady {
+ set _configTripped true
+ set _padY [winfo pixels $_canvas $pady]
+}
+
+# ----------------------------------------------------------------------
+# OPTION -selectbackground
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::selectbackground {
+ set _darkShadow [iwidgets::colors::bottomShadow $selectbackground]
+ set _lightShadow [iwidgets::colors::topShadow $selectbackground]
+
+ if { $_selected } {
+ _selectNoRaise
+ } else {
+ _deselectNoLower
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -selectforeground
+#
+# Foreground of tab when selected
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::selectforeground {
+ if { $_selected } {
+ _selectNoRaise
+ } else {
+ _deselectNoLower
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -disabledforeground
+#
+# Background of tab when -state is disabled
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::disabledforeground {
+ if { $_selected } {
+ _selectNoRaise
+ } else {
+ _deselectNoLower
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -background
+#
+# Normal background of tab.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::background {
+
+ if { $_selected } {
+ _selectNoRaise
+ } else {
+ _deselectNoLower
+ }
+
+}
+
+# ----------------------------------------------------------------------
+# OPTION -foreground
+#
+# Foreground of tabs when in normal unselected state
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::foreground {
+ if { $_selected } {
+ _selectNoRaise
+ } else {
+ _deselectNoLower
+ }
+}
+
+# ----------------------------------------------------------------------
+# OPTION -orient
+#
+# Specifies the orientation of the tab. Orient can be either
+# horizontal or vertical.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::orient {
+ set _configTripped true
+}
+
+# ----------------------------------------------------------------------
+# OPTION -invert
+#
+# Specifies the direction to draw the tab. If invert is true,
+# it draws horizontal tabs upside down and vertical tabs opening
+# to the left (pointing right). The value may have any of the
+# forms accepted by the Tcl_GetBoolean, such as true,
+# false, 0, 1, yes, or no.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::invert {
+ set _configTripped true
+}
+
+# ----------------------------------------------------------------------
+# OPTION -angle
+#
+# Specifes the angle of slope from the inner edge to the outer edge
+# of the tab. An angle of 0 specifies square tabs. Valid ranges are
+# 0 to 45 degrees inclusive. Default is 15 degrees. If this option
+# is specified as an empty string (the default), then the angle
+# option for the overall Tabset is used.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::angle {
+ if {$angle < 0 || $angle > 45 } {
+ error "bad angle: must be between 0 and 45"
+ }
+ set _configTripped true
+}
+
+# ----------------------------------------------------------------------
+# OPTION -font
+#
+# Font for tab text.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::font {
+}
+
+
+# ----------------------------------------------------------------------
+# OPTION -tabborders
+#
+# Specifies whether to draw the borders of a deselected tab.
+# Specifying true (the default) draws these borders,
+# specifying false disables this drawing. If the tab is in
+# its selected state this option has no effect.
+# The value may have any of the forms accepted by the
+# Tcl_GetBoolean, such as true, false, 0, 1, yes, or no.
+# ----------------------------------------------------------------------
+configbody iwidgets::Tab::tabborders {
+ set _configTripped true
+}
+
+# ----------------------------------------------------------------------
+# METHOD: configure ?option value?
+#
+# Configures the Tab, checks a configTripped flag to see if the tab
+# needs to be remade. We take the easy way since it is so inexpensive
+# to delete canvas items and remake them.
+# ----------------------------------------------------------------------
+body iwidgets::Tab::configure {args} {
+ set len [llength $args]
+
+ switch $len {
+ 0 {
+ set result [_itk_config]
+ return $result
+ }
+ 1 {
+ set result [eval _itk_config $args]
+ return $result
+ }
+ default {
+ eval _itk_config $args
+ if { $_configTripped } {
+ _makeTab
+ set _configTripped false
+ }
+ return ""
+ }
+ }
+}
+
+# ----------------------------------------------------------------------
+# METHOD: bbox
+#
+# Returns the bounding box of the tab
+# ----------------------------------------------------------------------
+body iwidgets::Tab::bbox {} {
+ return [lappend bbox $_left $_top $_right $_bottom]
+}
+# ----------------------------------------------------------------------
+# METHOD: deselect
+#
+# Causes the given tab to be drawn as deselected and lowered
+# ----------------------------------------------------------------------
+body iwidgets::Tab::deselect {} {
+ global tcl_platform
+ $_canvas lower $this
+
+ if {$tcl_platform(os) == "HP-UX"} {
+ update idletasks
+ }
+
+ _deselectNoLower
+}
+
+# ----------------------------------------------------------------------
+# METHOD: lower
+#
+# Lowers the tab below all others in the canvas.
+#
+# This is used as our tag name on the canvas.
+# ----------------------------------------------------------------------
+body iwidgets::Tab::lower {} {
+ $_canvas lower $this
+}
+
+# ----------------------------------------------------------------------
+# METHOD: majordim
+#
+# Returns the width for horizontal tabs and the height for
+# vertical tabs.
+# ----------------------------------------------------------------------
+body iwidgets::Tab::majordim {} {
+ return $_majorDim
+}
+
+# ----------------------------------------------------------------------
+# METHOD: minordim
+#
+# Returns the height for horizontal tabs and the width for
+# vertical tabs.
+# ----------------------------------------------------------------------
+body iwidgets::Tab::minordim {} {
+ return $_minorDim
+}
+
+# ----------------------------------------------------------------------
+# METHOD: offset
+#
+# Returns the width less the angle offset. This allows a
+# geometry manager to ask where to place a sibling tab.
+# ----------------------------------------------------------------------
+body iwidgets::Tab::offset {} {
+ return $_offset
+}
+
+# ----------------------------------------------------------------------
+# METHOD: raise
+#
+# Raises the tab above all others in the canvas.
+#
+# This is used as our tag name on the canvas.
+# ----------------------------------------------------------------------
+body iwidgets::Tab::raise {} {
+ $_canvas raise $this
+}
+
+# ----------------------------------------------------------------------
+# METHOD: select
+#
+# Causes the given tab to be drawn as selected. 3d shadows are
+# turned on and top line and top line shadow are drawn in sel
+# bg color to hide them.
+# ----------------------------------------------------------------------
+body iwidgets::Tab::select {} {
+ global tcl_platform
+ $_canvas raise $this
+
+ if {$tcl_platform(os) == "HP-UX"} {
+ update idletasks
+ }
+
+ _selectNoRaise
+}
+
+# ----------------------------------------------------------------------
+# METHOD: labelheight
+#
+# Returns the height of the tab's label in its current font.
+# ----------------------------------------------------------------------
+body iwidgets::Tab::labelheight {} {
+ if {$_gLabel != 0} {
+ set labelBBox [$_canvas bbox $_gLabel]
+ set labelHeight [expr [lindex $labelBBox 3] - [lindex $labelBBox 1]]
+ } else {
+ set labelHeight 0
+ }
+ return $labelHeight
+}
+
+# ----------------------------------------------------------------------
+# METHOD: labelwidth
+#
+# Returns the width of the tab's label in its current font.
+# ----------------------------------------------------------------------
+body iwidgets::Tab::labelwidth {} {
+ if {$_gLabel != 0} {
+ set labelBBox [$_canvas bbox $_gLabel]
+ set labelWidth [expr [lindex $labelBBox 2] - [lindex $labelBBox 0]]
+ } else {
+ set labelWidth 0
+ }
+ return $labelWidth
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _selectNoRaise
+#
+# Draws tab as selected without raising it.
+# ----------------------------------------------------------------------
+body iwidgets::Tab::_selectNoRaise {} {
+ if { ! [info exists _gRegion] } {
+ return
+ }
+
+ $_canvas itemconfigure $_gRegion -fill $selectbackground
+ $_canvas itemconfigure $_gTopLine -fill $selectbackground
+ $_canvas itemconfigure $_gTopLineShadow -fill $selectbackground
+ $_canvas itemconfigure $_gLightShadow -fill $_lightShadow
+ $_canvas itemconfigure $_gDarkShadow -fill $_darkShadow
+
+ if { $_gLightOutline != {} } {
+ $_canvas itemconfigure $_gLightOutline -fill $_lightShadow
+ }
+ if { $_gBlackOutline != {} } {
+ $_canvas itemconfigure $_gBlackOutline -fill black
+ }
+
+ if { $state == "normal" } {
+ if { $image != {}} {
+ # do nothing for now
+ } elseif { $bitmap != {}} {
+ $_canvas itemconfigure $_gLabel \
+ -foreground $selectforeground \
+ -background $selectbackground
+ } else {
+ $_canvas itemconfigure $_gLabel -fill $selectforeground
+ }
+ } else {
+ if { $image != {}} {
+ # do nothing for now
+ } elseif { $bitmap != {}} {
+ $_canvas itemconfigure $_gLabel \
+ -foreground $disabledforeground \
+ -background $selectbackground
+ } else {
+ $_canvas itemconfigure $_gLabel -fill $disabledforeground
+ }
+ }
+
+ set _selected true
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _deselectNoLower
+#
+# Causes the given tab to be drawn as deselected. 3d shadows are
+# removed and top line and top line shadow are drawn in visible
+# colors to reveal them.
+# ----------------------------------------------------------------------
+body iwidgets::Tab::_deselectNoLower {} {
+ if { ! [info exists _gRegion] } {
+ return
+ }
+
+ $_canvas itemconfigure $_gRegion -fill $background
+ $_canvas itemconfigure $_gTopLine -fill black
+ $_canvas itemconfigure $_gTopLineShadow -fill $_darkShadow
+ $_canvas itemconfigure $_gLightShadow -fill $background
+ $_canvas itemconfigure $_gDarkShadow -fill $background
+
+ if { $tabborders } {
+ if { $_gLightOutline != {} } {
+ $_canvas itemconfigure $_gLightOutline -fill $_lightShadow
+ }
+ if { $_gBlackOutline != {} } {
+ $_canvas itemconfigure $_gBlackOutline -fill black
+ }
+ } else {
+ if { $_gLightOutline != {} } {
+ $_canvas itemconfigure $_gLightOutline -fill $background
+ }
+ if { $_gBlackOutline != {} } {
+ $_canvas itemconfigure $_gBlackOutline -fill $background
+ }
+ }
+
+
+ if { $state == "normal" } {
+ if { $image != {}} {
+ # do nothing for now
+ } elseif { $bitmap != {}} {
+ $_canvas itemconfigure $_gLabel \
+ -foreground $foreground \
+ -background $background
+ } else {
+ $_canvas itemconfigure $_gLabel -fill $foreground
+ }
+ } else {
+ if { $image != {}} {
+ # do nothing for now
+ } elseif { $bitmap != {}} {
+ $_canvas itemconfigure $_gLabel \
+ -foreground $disabledforeground \
+ -background $background
+ } else {
+ $_canvas itemconfigure $_gLabel -fill $disabledforeground
+ }
+ }
+
+ set _selected false
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _makeTab
+# ----------------------------------------------------------------------
+body iwidgets::Tab::_makeTab {} {
+ if { $orient == "horizontal" } {
+ if { $invert } {
+ _makeNorthTab $_canvas
+ } else {
+ _makeSouthTab $_canvas
+ }
+ } elseif { $orient == "vertical" } {
+ if { $invert } {
+ _makeEastTab $_canvas
+ } else {
+ _makeWestTab $_canvas
+ }
+ } else {
+ error "bad value for option -orient"
+ }
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _createLabel
+#
+# Creates the label for the tab. Can be either a text label
+# or a bitmap label.
+# ----------------------------------------------------------------------
+body iwidgets::Tab::_createLabel {canvas tagList} {
+ if { $image != {}} {
+ set _gLabel [$canvas create image \
+ 0 0 \
+ -image $image \
+ -anchor nw \
+ -tags $tagList \
+ ]
+ } elseif { $bitmap != {}} {
+ set _gLabel [$canvas create bitmap \
+ 0 0 \
+ -bitmap $bitmap \
+ -anchor nw \
+ -tags $tagList \
+ ]
+ } else {
+ set _gLabel [$canvas create text \
+ 0 0 \
+ -text $label \
+ -font $font \
+ -anchor nw \
+ -tags $tagList \
+ ]
+ }
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _makeEastTab
+#
+# Makes a tab that hangs to the east and opens to the west.
+# ----------------------------------------------------------------------
+body iwidgets::Tab::_makeEastTab {canvas} {
+ $canvas delete $this
+ set _gLightOutline {}
+ set _gBlackOutline {}
+
+ lappend tagList $this TAB
+
+ _createLabel $canvas $tagList
+
+ _calcLabelDim $_gLabel
+
+
+ set right [expr $_left + $_labelWidth]
+ # now have _left, _top, right...
+
+ # Turn off calculating angle tabs on Vertical orientations
+ #set angleOffset [expr $_labelHeight * $_tan($angle)]
+ set angleOffset 0
+
+ set outerTop $_top
+ set outerBottom \
+ [expr $outerTop + $angleOffset + $_labelHeight + $angleOffset]
+ set innerTop [expr $outerTop + $angleOffset]
+ set innerBottom [expr $outerTop + $angleOffset + $_labelHeight]
+
+ # now have _left, _top, right, outerTop, innerTop,
+ # innerBottom, outerBottom, width, height
+
+ set bottom $innerBottom
+ # tab area... gets filled either white or selected
+ # done
+ set _gRegion [$canvas create polygon \
+ $_left $outerTop \
+ [expr $right - $bevelamount] $innerTop \
+ $right [expr $innerTop + $bevelamount] \
+ $right [expr $innerBottom - $bevelamount] \
+ [expr $right - $bevelamount] $innerBottom \
+ $_left $outerBottom \
+ $_left $outerTop \
+ -tags $tagList \
+ ]
+
+ # lighter shadow (left edge)
+ set _gLightShadow [$canvas create line \
+ [expr $_left - 3] [expr $outerTop + 1] \
+ [expr $right - $bevelamount] [expr $innerTop + 1] \
+ -tags $tagList \
+ ]
+
+ # darker shadow (bottom and right edges)
+ set _gDarkShadow [$canvas create line \
+ [expr $right - $bevelamount] [expr $innerTop + 1] \
+ [expr $right - 1] [expr $innerTop + $bevelamount] \
+ [expr $right - 1] [expr $innerBottom - $bevelamount] \
+ [expr $right - $bevelamount] [expr $innerBottom - 1] \
+ [expr $_left - 3] [expr $outerBottom - 1] \
+ -tags $tagList \
+ ]
+
+ # outline of tab
+ set _gLightOutline [$canvas create line \
+ $_left $outerTop \
+ [expr $right - $bevelamount] $innerTop \
+ -tags $tagList \
+ ]
+ # outline of tab
+ set _gBlackOutline [$canvas create line \
+ [expr $right - $bevelamount] $innerTop \
+ $right [expr $innerTop + $bevelamount] \
+ $right [expr $innerBottom - $bevelamount] \
+ [expr $right - $bevelamount] $innerBottom \
+ $_left $outerBottom \
+ $_left $outerTop \
+ -tags $tagList \
+ ]
+
+ # line closest to the edge
+ set _gTopLineShadow [$canvas create line \
+ $_left $outerTop \
+ $_left $outerBottom \
+ -tags $tagList \
+ ]
+
+ # next line down
+ set _gTopLine [$canvas create line \
+ [expr $_left + 1] [expr $outerTop + 2] \
+ [expr $_left + 1] [expr $outerBottom - 1] \
+ -tags $tagList \
+ ]
+
+ $canvas coords $_gLabel [expr $_left + $_labelXOrigin] \
+ [expr $innerTop + $_labelYOrigin]
+
+ if { $image != {} || $bitmap != {} } {
+ $canvas itemconfigure $_gLabel -anchor $anchor
+ } else {
+ $canvas itemconfigure $_gLabel -anchor $anchor -justify $_just
+ }
+
+ $canvas raise $_gLabel $_gRegion
+
+
+ set _offset [expr $innerBottom - $outerTop]
+ # height
+ set _majorDim [expr $outerBottom - $outerTop]
+ # width
+ set _minorDim [expr $right - $_left]
+
+ set _right $right
+ set _bottom $outerBottom
+
+ # draw in correct state...
+ if { $_selected } {
+ select
+ } else {
+ deselect
+ }
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _makeWestTab
+#
+# Makes a tab that hangs to the west and opens to the east.
+# ----------------------------------------------------------------------
+body iwidgets::Tab::_makeWestTab {canvas} {
+ $canvas delete $this
+ set _gLightOutline {}
+ set _gBlackOutline {}
+
+ lappend tagList $this TAB
+
+ _createLabel $canvas $tagList
+ _calcLabelDim $_gLabel
+
+ set right [expr $_left + $_labelWidth]
+ # now have _left, _top, right...
+
+ # Turn off calculating angle tabs on Vertical orientations
+ #set angleOffset [expr $_labelHeight * $_tan($angle)]
+ set angleOffset 0
+
+ set outerTop $_top
+ set outerBottom \
+ [expr $outerTop + $angleOffset + $_labelHeight + $angleOffset]
+ set innerTop [expr $outerTop + $angleOffset]
+ set innerBottom [expr $outerTop + $angleOffset + $_labelHeight]
+
+ # now have _left, _top, right, outerTop, innerTop,
+ # innerBottom, outerBottom, width, height
+
+ # tab area... gets filled either white or selected
+ # done
+ set _gRegion [$canvas create polygon \
+ $right $outerTop \
+ [expr $_left + $bevelamount] $innerTop \
+ $_left [expr $innerTop + $bevelamount] \
+ $_left [expr $innerBottom - $bevelamount]\
+ [expr $_left + $bevelamount] $innerBottom \
+ $right $outerBottom \
+ $right $outerTop \
+ -tags $tagList \
+ ]
+ # lighter shadow (left edge)
+ set _gLightShadow [$canvas create line \
+ $right [expr $outerTop+1] \
+ [expr $_left + $bevelamount] [expr $innerTop + 1] \
+ [expr $_left + 1] [expr $innerTop + $bevelamount] \
+ [expr $_left + 1] [expr $innerBottom - $bevelamount] \
+ -tags $tagList \
+ ]
+
+ # darker shadow (bottom and right edges)
+ set _gDarkShadow [$canvas create line \
+ [expr $_left + 1] [expr $innerBottom - $bevelamount] \
+ [expr $_left + $bevelamount] [expr $innerBottom - 1] \
+ $right [expr $outerBottom - 1] \
+ -tags $tagList \
+ ]
+
+ # outline of tab -- lighter top left sides
+ set _gLightOutline [$canvas create line \
+ $right $outerTop \
+ [expr $_left + $bevelamount] $innerTop \
+ $_left [expr $innerTop + $bevelamount] \
+ $_left [expr $innerBottom - $bevelamount]\
+ -tags $tagList \
+ ]
+ # outline of tab -- darker bottom side
+ set _gBlackOutline [$canvas create line \
+ $_left [expr $innerBottom - $bevelamount]\
+ [expr $_left + $bevelamount] $innerBottom \
+ $right $outerBottom \
+ $right $outerTop \
+ -tags $tagList \
+ ]
+
+ # top of tab
+ set _gTopLine [$canvas create line \
+ [expr $right + 1] $outerTop \
+ [expr $right + 1] $outerBottom \
+ -tags $tagList \
+ ]
+
+ # line below top of tab
+ set _gTopLineShadow [$canvas create line \
+ $right $outerTop \
+ $right $outerBottom \
+ -tags $tagList \
+ ]
+
+ $canvas coords $_gLabel [expr $_left + $_labelXOrigin] \
+ [expr $innerTop + $_labelYOrigin]
+ if { $image != {} || $bitmap != {} } {
+ $canvas itemconfigure $_gLabel -anchor $anchor
+ } else {
+ $canvas itemconfigure $_gLabel -anchor $anchor -justify $_just
+ }
+
+ $canvas raise $_gLabel $_gRegion
+
+
+ set _offset [expr $innerBottom - $outerTop]
+ # height
+ set _majorDim [expr $outerBottom - $outerTop]
+ # width
+ set _minorDim [expr $right - $_left]
+
+ set _right $right
+ set _bottom $outerBottom
+
+ # draw in correct state...
+ if { $_selected } {
+ select
+ } else {
+ deselect
+ }
+
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _makeNorthTab
+#
+# Makes a tab that hangs to the north and opens to the south.
+# ----------------------------------------------------------------------
+body iwidgets::Tab::_makeNorthTab {canvas} {
+ $canvas delete $this
+ set _gLightOutline {}
+ set _gBlackOutline {}
+
+ lappend tagList $this TAB
+
+ _createLabel $canvas $tagList
+
+ # first get the label width and height
+ _calcLabelDim $_gLabel
+
+ set bottom [expr $_top + $_labelHeight]
+
+ set angleOffset [expr $_labelHeight * $_tan($angle)]
+
+ set outerLeft $_left
+ set outerRight \
+ [expr $outerLeft + $angleOffset + $_labelWidth + $angleOffset]
+ set innerLeft [expr $outerLeft + $angleOffset]
+ set innerRight [expr $outerLeft + $angleOffset + $_labelWidth]
+
+ # tab area... gets filled either white or selected
+ set _gRegion [$canvas create polygon \
+ $outerLeft [expr $bottom + 3] \
+ $innerLeft [expr $_top + $bevelamount] \
+ [expr $innerLeft + $bevelamount] $_top \
+ [expr $innerRight - $bevelamount] $_top \
+ $innerRight [expr $_top + $bevelamount]\
+ $outerRight [expr $bottom + 3] \
+ $outerLeft [expr $bottom + 3] \
+ -tags $tagList \
+ ]
+
+ # lighter shadow (left edge)
+ set _gLightShadow [$canvas create line \
+ [expr $outerLeft + 1] [expr $bottom + 3] \
+ [expr $innerLeft + 1] [expr $_top + $bevelamount] \
+ [expr $innerLeft + $bevelamount] [expr $_top + 1]\
+ [expr $innerRight - $bevelamount] [expr $_top + 1]\
+ -tags $tagList \
+ ]
+
+ # darker shadow (bottom and right edges)
+ set _gDarkShadow [$canvas create line \
+ [expr $innerRight - $bevelamount] [expr $_top + 1]\
+ [expr $innerRight - 1] [expr $_top + $bevelamount]\
+ [expr $outerRight - 1] [expr $bottom + 3]\
+ -tags $tagList \
+ ]
+
+ set _gLightOutline [$canvas create line \
+ $outerLeft [expr $bottom + 3] \
+ $innerLeft [expr $_top + $bevelamount] \
+ [expr $innerLeft + $bevelamount] $_top \
+ [expr $innerRight - $bevelamount] $_top \
+ -tags $tagList \
+ ]
+
+ set _gBlackOutline [$canvas create line \
+ [expr $innerRight - $bevelamount] $_top \
+ $innerRight [expr $_top + $bevelamount]\
+ $outerRight [expr $bottom + 3] \
+ $outerLeft [expr $bottom + 3] \
+ -tags $tagList \
+ ]
+
+ # top of tab... to make it closed off
+ set _gTopLine [$canvas create line \
+ 0 0 0 0\
+ -tags $tagList \
+ ]
+ #[expr $outerLeft + 2] [expr $_top + 1] \
+ [expr $outerRight - 2] [expr $_top + 1]
+
+ # top of tab... to make it closed off
+ set _gTopLineShadow [$canvas create line \
+ 0 0 0 0 \
+ -tags $tagList \
+ ]
+ #$outerLeft $_top \
+ $outerRight $_top
+
+ $canvas coords $_gLabel [expr $innerLeft + $_labelXOrigin] \
+ [expr $_top + $_labelYOrigin]
+
+ if { $image != {} || $bitmap != {} } {
+ $canvas itemconfigure $_gLabel -anchor $anchor
+ } else {
+ $canvas itemconfigure $_gLabel -anchor $anchor -justify $_just
+ }
+
+ $canvas raise $_gLabel $_gRegion
+
+
+ set _offset [expr $innerRight - $outerLeft]
+ # width
+ set _majorDim [expr $outerRight - $outerLeft]
+ # height
+ set _minorDim [expr $bottom - $_top]
+
+ set _right $outerRight
+ set _bottom $bottom
+
+ # draw in correct state...
+ if { $_selected } {
+ select
+ } else {
+ deselect
+ }
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _makeSouthTab
+#
+# Makes a tab that hangs to the south and opens to the north.
+# ----------------------------------------------------------------------
+body iwidgets::Tab::_makeSouthTab {canvas} {
+ $canvas delete $this
+ set _gLightOutline {}
+ set _gBlackOutline {}
+
+ lappend tagList $this TAB
+
+ _createLabel $canvas $tagList
+
+ # first get the label width and height
+ _calcLabelDim $_gLabel
+
+ set bottom [expr $_top + $_labelHeight]
+
+ set angleOffset [expr $_labelHeight * $_tan($angle)]
+
+ set outerLeft $_left
+ set outerRight \
+ [expr $outerLeft + $angleOffset + $_labelWidth + $angleOffset]
+ set innerLeft [expr $outerLeft + $angleOffset]
+ set innerRight [expr $outerLeft + $angleOffset + $_labelWidth]
+
+ # tab area... gets filled either white or selected
+ set _gRegion [$canvas create polygon \
+ $outerLeft [expr $_top + 1] \
+ $innerLeft [expr $bottom - $bevelamount]\
+ [expr $innerLeft + $bevelamount] $bottom \
+ [expr $innerRight - $bevelamount] $bottom \
+ $innerRight [expr $bottom - $bevelamount]\
+ $outerRight [expr $_top + 1] \
+ $outerLeft [expr $_top + 1] \
+ -tags $tagList \
+ ]
+
+
+ # lighter shadow (left edge)
+ set _gLightShadow [$canvas create line \
+ [expr $outerLeft+1] $_top \
+ [expr $innerLeft+1] [expr $bottom-$bevelamount] \
+ -tags $tagList \
+ ]
+
+ # darker shadow (bottom and right edges)
+ set _gDarkShadow [$canvas create line \
+ [expr $innerLeft+1] [expr $bottom-$bevelamount] \
+ [expr $innerLeft+$bevelamount] [expr $bottom-1] \
+ [expr $innerRight-$bevelamount] [expr $bottom-1] \
+ [expr $innerRight-1] [expr $bottom-$bevelamount] \
+ [expr $outerRight-1] [expr $_top + 1] \
+ -tags $tagList \
+ ]
+ # outline of tab
+ set _gBlackOutline [$canvas create line \
+ $outerLeft [expr $_top + 1] \
+ $innerLeft [expr $bottom -$bevelamount]\
+ [expr $innerLeft + $bevelamount] $bottom \
+ [expr $innerRight - $bevelamount] $bottom \
+ $innerRight [expr $bottom - $bevelamount]\
+ $outerRight [expr $_top + 1] \
+ -tags $tagList \
+ ]
+
+ # top of tab... to make it closed off
+ set _gTopLine [$canvas create line \
+ $outerLeft [expr $_top + 1] \
+ $outerRight [expr $_top + 1] \
+ -tags $tagList \
+ ]
+
+ # top of tab... to make it closed off
+ set _gTopLineShadow [$canvas create line \
+ $outerLeft $_top \
+ $outerRight $_top \
+ -tags $tagList \
+ ]
+
+ #$canvas coords $_gLabel [expr $innerLeft + $_padX + 2] \
+ [expr $_top + $_padY]
+ $canvas coords $_gLabel [expr $innerLeft + $_labelXOrigin] \
+ [expr $_top + $_labelYOrigin]
+
+ if { $image != {} || $bitmap != {} } {
+ $canvas itemconfigure $_gLabel -anchor $anchor
+ } else {
+ $canvas itemconfigure $_gLabel -anchor $anchor -justify $_just
+ }
+ $canvas raise $_gLabel $_gRegion
+
+
+ set _offset [expr $innerRight - $outerLeft]
+
+ # width
+ set _majorDim [expr $outerRight - $outerLeft]
+
+ # height
+ set _minorDim [expr $bottom - $_top]
+
+ set _right $outerRight
+ set _bottom $bottom
+
+ # draw in correct state...
+ if { $_selected } {
+ select
+ } else {
+ deselect
+ }
+}
+
+# ----------------------------------------------------------------------
+# PRIVATE METHOD: _calcLabelDim
+#
+# Calculate the width and height of the label bbox of labelItem
+# can be either text or bitmap (in future also an image)
+#
+# There are two ways to calculate the label bbox.
+#
+# First, if the $_width and/or $_height is specified, we will use
+# it to determine that dimension(s) width and/or height. For
+# a width/height of 0 we use the labels bbox to
+# give us a base width/height.
+# Then we add in the padx/pady to determine final bounds.
+#
+# Uses the following option or option derived variables:
+# -padx ($_padX - converted to pixels)
+# -pady ($_padY - converted to pixels)
+# -anchor ($anchor)
+# -width ($_width) This is the width for inside tab (label area)
+# -height ($_height) This is the width for inside tab (label area)
+#
+# Side Effects:
+# _labelWidth will be set
+# _labelHeight will be set
+# _labelXOrigin will be set
+# _labelYOrigin will be set
+# ----------------------------------------------------------------------
+body iwidgets::Tab::_calcLabelDim {labelItem} {
+ # ... calculate the label width and height
+ set labelBBox [$_canvas bbox $labelItem]
+
+ if { $_width > 0 } {
+ set _labelWidth [expr $_width + ($_padX * 2)]
+ } else {
+ set _labelWidth [expr \
+ ([lindex $labelBBox 2] - [lindex $labelBBox 0]) + ($_padX * 2)]
+ }
+
+ if { $_height > 0 } {
+ set _labelHeight [expr $_height + ($_padY * 2)]
+ } else {
+ set _labelHeight [expr \
+ ([lindex $labelBBox 3] - [lindex $labelBBox 1]) + ($_padY * 2)]
+ }
+
+ # ... calculate the label anchor point
+ set centerX [expr $_labelWidth/2.0]
+ set centerY [expr $_labelHeight/2.0 - 1]
+
+ switch $anchor {
+ n {
+ set _labelXOrigin $centerX
+ set _labelYOrigin $_padY
+ set _just center
+ }
+ s {
+ set _labelXOrigin $centerX
+ set _labelYOrigin [expr $_labelHeight - $_padY]
+ set _just center
+ }
+ e {
+ set _labelXOrigin [expr $_labelWidth - $_padX - 1]
+ set _labelYOrigin $centerY
+ set _just right
+ }
+ w {
+ set _labelXOrigin [expr $_padX + 2]
+ set _labelYOrigin $centerY
+ set _just left
+ }
+ c {
+ set _labelXOrigin $centerX
+ set _labelYOrigin $centerY
+ set _just center
+ }
+ ne {
+ set _labelXOrigin [expr $_labelWidth - $_padX - 1]
+ set _labelYOrigin $_padY
+ set _just right
+ }
+ nw {
+ set _labelXOrigin [expr $_padX + 2]
+ set _labelYOrigin $_padY
+ set _just left
+ }
+ se {
+ set _labelXOrigin [expr $_labelWidth - $_padX - 1]
+ set _labelYOrigin [expr $_labelHeight - $_padY]
+ set _just right
+ }
+ sw {
+ set _labelXOrigin [expr $_padX + 2]
+ set _labelYOrigin [expr $_labelHeight - $_padY]
+ set _just left
+ }
+ default {
+ error "bad anchor position: \
+ \"$tabpos\" must be n, ne, nw, s, sw, se, e, w, or center"
+ }
+ }
+}
diff --git a/itcl/iwidgets3.0.0/generic/tclIndex b/itcl/iwidgets3.0.0/generic/tclIndex
new file mode 100644
index 00000000000..5c684710f11
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/tclIndex
@@ -0,0 +1,1336 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(::iwidgets::Buttonbox) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::buttonbox) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::constructor) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::destructor) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::pady) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::padx) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::orient) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::index) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::add) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::insert) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::delete) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::default) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::hide) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::show) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::invoke) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::buttonconfigure) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::buttoncget) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::_getMaxWidth) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::_getMaxHeight) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::_setBoxSize) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Buttonbox::_positionButtons) [list source [file join $dir buttonbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::ezPaperInfo) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::canvasprintbox) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::printregion) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::output) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::printcmd) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::filename) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::pagesize) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::orient) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::stretch) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::posterize) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::hpagecnt) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::vpagecnt) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::constructor) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::setcanvas) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::getoutput) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::print) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::refresh) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::stop) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::_calc_poster_size) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::_calc_print_region) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::_calc_print_scale) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::_update_canvas) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::_update_attr) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::_mapEventHandler) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::destructor) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Canvasprintbox::ezPaperInfo) [list source [file join $dir canvasprintbox.itk]]
+set auto_index(::iwidgets::Dialog) [list source [file join $dir dialog.itk]]
+set auto_index(::iwidgets::dialog) [list source [file join $dir dialog.itk]]
+set auto_index(::iwidgets::Dialog::constructor) [list source [file join $dir dialog.itk]]
+set auto_index(::iwidgets::Combobox) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::combobox) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::constructor) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::destructor) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::arrowrelief) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::completion) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::dropdown) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::editable) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::grab) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::labelpos) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::listheight) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::margin) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::popupcursor) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::selectioncommand) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::state) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::unique) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::clear) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::curselection) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::delete) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::get) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::getcurselection) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::invoke) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::insert) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::justify) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::see) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::selection) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::size) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::sort) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::xview) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::yview) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_addToList) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_createComponents) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_deleteList) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_deleteText) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_doLayout) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_drawArrow) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_dropdownBtnRelease) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_ignoreNextBtnRelease) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_next) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_packComponents) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_positionList) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_postList) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_previous) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_resizeArrow) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_selectCmd) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_toggleList) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_unpostList) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_commonBindings) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_dropdownBindings) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_simpleBindings) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_listShowing) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_slbListbox) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_stateSelect) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_bs) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Combobox::_lookup) [list source [file join $dir combobox.itk]]
+set auto_index(::iwidgets::Dialogshell) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::dialogshell) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::Dialogshell::constructor) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::Dialogshell::thickness) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::Dialogshell::buttonboxpos) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::Dialogshell::separator) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::Dialogshell::padx) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::Dialogshell::pady) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::Dialogshell::childsite) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::Dialogshell::index) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::Dialogshell::add) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::Dialogshell::insert) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::Dialogshell::delete) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::Dialogshell::hide) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::Dialogshell::show) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::Dialogshell::default) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::Dialogshell::invoke) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::Dialogshell::buttonconfigure) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::Dialogshell::buttoncget) [list source [file join $dir dialogshell.itk]]
+set auto_index(::iwidgets::Feedback) [list source [file join $dir feedback.itk]]
+set auto_index(::iwidgets::feedback) [list source [file join $dir feedback.itk]]
+set auto_index(::iwidgets::Feedback::constructor) [list source [file join $dir feedback.itk]]
+set auto_index(::iwidgets::Feedback::destructor) [list source [file join $dir feedback.itk]]
+set auto_index(::iwidgets::Feedback::steps) [list source [file join $dir feedback.itk]]
+set auto_index(::iwidgets::Feedback::_display) [list source [file join $dir feedback.itk]]
+set auto_index(::iwidgets::Feedback::reset) [list source [file join $dir feedback.itk]]
+set auto_index(::iwidgets::Feedback::step) [list source [file join $dir feedback.itk]]
+set auto_index(::iwidgets::Labeledwidget) [list source [file join $dir labeledwidget.itk]]
+set auto_index(::iwidgets::Labeledwidget::alignlabels) [list source [file join $dir labeledwidget.itk]]
+set auto_index(::iwidgets::labeledwidget) [list source [file join $dir labeledwidget.itk]]
+set auto_index(::iwidgets::Labeledwidget::constructor) [list source [file join $dir labeledwidget.itk]]
+set auto_index(::iwidgets::Labeledwidget::destructor) [list source [file join $dir labeledwidget.itk]]
+set auto_index(::iwidgets::Labeledwidget::disabledforeground) [list source [file join $dir labeledwidget.itk]]
+set auto_index(::iwidgets::Labeledwidget::labelpos) [list source [file join $dir labeledwidget.itk]]
+set auto_index(::iwidgets::Labeledwidget::labelmargin) [list source [file join $dir labeledwidget.itk]]
+set auto_index(::iwidgets::Labeledwidget::labeltext) [list source [file join $dir labeledwidget.itk]]
+set auto_index(::iwidgets::Labeledwidget::labelvariable) [list source [file join $dir labeledwidget.itk]]
+set auto_index(::iwidgets::Labeledwidget::labelbitmap) [list source [file join $dir labeledwidget.itk]]
+set auto_index(::iwidgets::Labeledwidget::labelimage) [list source [file join $dir labeledwidget.itk]]
+set auto_index(::iwidgets::Labeledwidget::state) [list source [file join $dir labeledwidget.itk]]
+set auto_index(::iwidgets::Labeledwidget::childsite) [list source [file join $dir labeledwidget.itk]]
+set auto_index(::iwidgets::Labeledwidget::alignlabels) [list source [file join $dir labeledwidget.itk]]
+set auto_index(::iwidgets::Labeledwidget::_positionLabel) [list source [file join $dir labeledwidget.itk]]
+set auto_index(::iwidgets::Menubar) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::menubar) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::constructor) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::foreground) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::activebackground) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::activeborderwidth) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::activeforeground) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::anchor) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::borderwidth) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::disabledforeground) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::font) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::highlightbackground) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::highlightcolor) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::highlightthickness) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::justify) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::padx) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::pady) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::wraplength) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::menubuttons) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::helpvariable) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::add) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::delete) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::index) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::insert) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::invoke) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::menucget) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::menuconfigure) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::path) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::type) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::yposition) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::menubutton) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::options) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::command) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::checkbutton) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::radiobutton) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::separator) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::cascade) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_addMenuButton) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_insertMenuButton) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_makeMenuButton) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_makeMenu) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_substEvalStr) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_deleteMenu) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_deleteAMenu) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_addEntry) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_addCascade) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_insertEntry) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_insertCascade) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_deleteEntry) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_configureMenu) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_configureMenuOption) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_configureMenuEntry) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_unsetPaths) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_entryPathToTkMenuPath) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_getTkIndex) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_getPdIndex) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_getMenuList) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_getEntryList) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_parsePath) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_getSymbolicPath) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_leaveHandler) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Menubar::_helpHandler) [list source [file join $dir menubar.itk]]
+set auto_index(::Menubar::_getCallerLevel) [list source [file join $dir menubar.itk]]
+set auto_index(::tkMenuFind) [list source [file join $dir menubar.itk]]
+set auto_index(::iwidgets::Messagedialog) [list source [file join $dir messagedialog.itk]]
+set auto_index(::iwidgets::messagedialog) [list source [file join $dir messagedialog.itk]]
+set auto_index(::iwidgets::Messagedialog::constructor) [list source [file join $dir messagedialog.itk]]
+set auto_index(::iwidgets::Messagedialog::imagepos) [list source [file join $dir messagedialog.itk]]
+set auto_index(::iwidgets::Notebook) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::notebook) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::constructor) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::background) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::auto) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::scrollcommand) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::add) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::childsite) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::delete) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::index) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::insert) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::prev) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::next) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::pageconfigure) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::pagecget) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::select) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::view) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::_childSites) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::_scrollCommand) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::_index) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::_createPage) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::_deletePages) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::_configurePages) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Notebook::_tabCommand) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Page) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Page::constructor) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Page::disabledforeground) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Page::label) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Page::command) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Page::childsite) [list source [file join $dir notebook.itk]]
+set auto_index(::iwidgets::Optionmenu) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::optionmenu) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::constructor) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::destructor) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::clicktime) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::command) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::cyclicon) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::width) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::font) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::state) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::index) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::delete) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::disable) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::enable) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::get) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::insert) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::select) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::popupMenu) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::sort) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::_buttonRelease) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::_getNextItem) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::_next) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::_previous) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::_postMenu) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::_setItem) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::_unpostMenu) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::_setitems) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Optionmenu::_setSize) [list source [file join $dir optionmenu.itk]]
+set auto_index(::iwidgets::Pane) [list source [file join $dir pane.itk]]
+set auto_index(::iwidgets::pane) [list source [file join $dir pane.itk]]
+set auto_index(::iwidgets::Pane::constructor) [list source [file join $dir pane.itk]]
+set auto_index(::iwidgets::Pane::minimum) [list source [file join $dir pane.itk]]
+set auto_index(::iwidgets::Pane::margin) [list source [file join $dir pane.itk]]
+set auto_index(::iwidgets::Pane::childSite) [list source [file join $dir pane.itk]]
+set auto_index(::iwidgets::Panedwindow) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::panedwindow) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::constructor) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::orient) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::sashborderwidth) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::sashcursor) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::sashwidth) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::sashheight) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::thickness) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::sashindent) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::index) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::childsite) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::fraction) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::add) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::insert) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::delete) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::hide) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::show) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::paneconfigure) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::reset) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::_pwConfigureEventHandler) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::_startGrip) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::_endGrip) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::_configGrip) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::_handleGrip) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::_moveSash) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::_setFracArray) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::_setActivePanes) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::_calcFraction) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::_makeSashes) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::_placeSash) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Panedwindow::_placePanes) [list source [file join $dir panedwindow.itk]]
+set auto_index(::iwidgets::Shell) [list source [file join $dir shell.itk]]
+set auto_index(::iwidgets::shell) [list source [file join $dir shell.itk]]
+set auto_index(::iwidgets::Shell::constructor) [list source [file join $dir shell.itk]]
+set auto_index(::iwidgets::Shell::master) [list source [file join $dir shell.itk]]
+set auto_index(::iwidgets::Shell::modality) [list source [file join $dir shell.itk]]
+set auto_index(::iwidgets::Shell::padx) [list source [file join $dir shell.itk]]
+set auto_index(::iwidgets::Shell::pady) [list source [file join $dir shell.itk]]
+set auto_index(::iwidgets::Shell::width) [list source [file join $dir shell.itk]]
+set auto_index(::iwidgets::Shell::height) [list source [file join $dir shell.itk]]
+set auto_index(::iwidgets::Shell::childsite) [list source [file join $dir shell.itk]]
+set auto_index(::iwidgets::Shell::activate) [list source [file join $dir shell.itk]]
+set auto_index(::iwidgets::Shell::deactivate) [list source [file join $dir shell.itk]]
+set auto_index(::iwidgets::Shell::center) [list source [file join $dir shell.itk]]
+set auto_index(::iwidgets::Promptdialog) [list source [file join $dir promptdialog.itk]]
+set auto_index(::iwidgets::promptdialog) [list source [file join $dir promptdialog.itk]]
+set auto_index(::iwidgets::Promptdialog::constructor) [list source [file join $dir promptdialog.itk]]
+set auto_index(::iwidgets::Promptdialog::get) [list source [file join $dir promptdialog.itk]]
+set auto_index(::iwidgets::Promptdialog::clear) [list source [file join $dir promptdialog.itk]]
+set auto_index(::iwidgets::Promptdialog::insert) [list source [file join $dir promptdialog.itk]]
+set auto_index(::iwidgets::Promptdialog::delete) [list source [file join $dir promptdialog.itk]]
+set auto_index(::iwidgets::Promptdialog::icursor) [list source [file join $dir promptdialog.itk]]
+set auto_index(::iwidgets::Promptdialog::index) [list source [file join $dir promptdialog.itk]]
+set auto_index(::iwidgets::Promptdialog::scan) [list source [file join $dir promptdialog.itk]]
+set auto_index(::iwidgets::Promptdialog::selection) [list source [file join $dir promptdialog.itk]]
+set auto_index(::iwidgets::Promptdialog::xview) [list source [file join $dir promptdialog.itk]]
+set auto_index(::iwidgets::Radiobox) [list source [file join $dir radiobox.itk]]
+set auto_index(::iwidgets::radiobox) [list source [file join $dir radiobox.itk]]
+set auto_index(::iwidgets::Radiobox::constructor) [list source [file join $dir radiobox.itk]]
+set auto_index(::iwidgets::Radiobox::command) [list source [file join $dir radiobox.itk]]
+set auto_index(::iwidgets::Radiobox::index) [list source [file join $dir radiobox.itk]]
+set auto_index(::iwidgets::Radiobox::add) [list source [file join $dir radiobox.itk]]
+set auto_index(::iwidgets::Radiobox::insert) [list source [file join $dir radiobox.itk]]
+set auto_index(::iwidgets::Radiobox::_rearrange) [list source [file join $dir radiobox.itk]]
+set auto_index(::iwidgets::Radiobox::delete) [list source [file join $dir radiobox.itk]]
+set auto_index(::iwidgets::Radiobox::select) [list source [file join $dir radiobox.itk]]
+set auto_index(::iwidgets::Radiobox::get) [list source [file join $dir radiobox.itk]]
+set auto_index(::iwidgets::Radiobox::deselect) [list source [file join $dir radiobox.itk]]
+set auto_index(::iwidgets::Radiobox::flash) [list source [file join $dir radiobox.itk]]
+set auto_index(::iwidgets::Radiobox::buttonconfigure) [list source [file join $dir radiobox.itk]]
+set auto_index(::iwidgets::Radiobox::_command) [list source [file join $dir radiobox.itk]]
+set auto_index(::iwidgets::Radiobox::gettag) [list source [file join $dir radiobox.itk]]
+set auto_index(::iwidgets::Scrolledcanvas) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::scrolledcanvas) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::constructor) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::destructor) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::autoresize) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::childsite) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::justify) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::addtag) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::bbox) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::bind) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::canvasx) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::canvasy) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::coords) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::create) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::dchars) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::delete) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::dtag) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::find) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::focus) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::gettags) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::icursor) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::index) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::insert) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::itemconfigure) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::itemcget) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::lower) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::move) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::postscript) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::raise) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::scale) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::scan) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::select) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::type) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::xview) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledcanvas::yview) [list source [file join $dir scrolledcanvas.itk]]
+set auto_index(::iwidgets::Scrolledframe) [list source [file join $dir scrolledframe.itk]]
+set auto_index(::iwidgets::scrolledframe) [list source [file join $dir scrolledframe.itk]]
+set auto_index(::iwidgets::Scrolledframe::constructor) [list source [file join $dir scrolledframe.itk]]
+set auto_index(::iwidgets::Scrolledframe::destructor) [list source [file join $dir scrolledframe.itk]]
+set auto_index(::iwidgets::Scrolledframe::childsite) [list source [file join $dir scrolledframe.itk]]
+set auto_index(::iwidgets::Scrolledframe::justify) [list source [file join $dir scrolledframe.itk]]
+set auto_index(::iwidgets::Scrolledframe::xview) [list source [file join $dir scrolledframe.itk]]
+set auto_index(::iwidgets::Scrolledframe::yview) [list source [file join $dir scrolledframe.itk]]
+set auto_index(::iwidgets::Scrolledframe::_configureCanvas) [list source [file join $dir scrolledframe.itk]]
+set auto_index(::iwidgets::Scrolledframe::_configureFrame) [list source [file join $dir scrolledframe.itk]]
+set auto_index(::iwidgets::Hyperhelp) [list source [file join $dir hyperhelp.itk]]
+set auto_index(::iwidgets::hyperhelp) [list source [file join $dir hyperhelp.itk]]
+set auto_index(::iwidgets::Hyperhelp::constructor) [list source [file join $dir hyperhelp.itk]]
+set auto_index(::iwidgets::Hyperhelp::topics) [list source [file join $dir hyperhelp.itk]]
+set auto_index(::iwidgets::Hyperhelp::title) [list source [file join $dir hyperhelp.itk]]
+set auto_index(::iwidgets::Hyperhelp::helpdir) [list source [file join $dir hyperhelp.itk]]
+set auto_index(::iwidgets::Hyperhelp::closecmd) [list source [file join $dir hyperhelp.itk]]
+set auto_index(::iwidgets::Hyperhelp::showtopic) [list source [file join $dir hyperhelp.itk]]
+set auto_index(::iwidgets::Hyperhelp::followlink) [list source [file join $dir hyperhelp.itk]]
+set auto_index(::iwidgets::Hyperhelp::forward) [list source [file join $dir hyperhelp.itk]]
+set auto_index(::iwidgets::Hyperhelp::back) [list source [file join $dir hyperhelp.itk]]
+set auto_index(::iwidgets::Hyperhelp::updatefeedback) [list source [file join $dir hyperhelp.itk]]
+set auto_index(::iwidgets::Hyperhelp::_readtopic) [list source [file join $dir hyperhelp.itk]]
+set auto_index(::iwidgets::Hyperhelp::_fill_go_menu) [list source [file join $dir hyperhelp.itk]]
+set auto_index(::iwidgets::Hyperhelp::_pageforward) [list source [file join $dir hyperhelp.itk]]
+set auto_index(::iwidgets::Hyperhelp::_pageback) [list source [file join $dir hyperhelp.itk]]
+set auto_index(::iwidgets::Hyperhelp::_lineforward) [list source [file join $dir hyperhelp.itk]]
+set auto_index(::iwidgets::Hyperhelp::_lineback) [list source [file join $dir hyperhelp.itk]]
+set auto_index(::iwidgets::Scrolledlistbox) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::scrolledlistbox) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::constructor) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::destructor) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::dblclickcommand) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::selectioncommand) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::width) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::height) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::visibleitems) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::state) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::curselection) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::activate) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::bbox) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::clear) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::see) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::index) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::delete) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::get) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::getcurselection) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::insert) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::nearest) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::scan) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::selection) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::size) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::selecteditemcount) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::justify) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::sort) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::xview) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::yview) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::_makeSelection) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledlistbox::_dblclick) [list source [file join $dir scrolledlistbox.itk]]
+set auto_index(::iwidgets::Scrolledtext) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::scrolledtext) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::constructor) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::destructor) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::width) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::height) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::visibleitems) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::childsite) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::bbox) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::clear) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::import) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::export) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::compare) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::debug) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::delete) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::dlineinfo) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::get) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::index) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::insert) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::mark) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::scan) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::search) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::see) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::tag) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::window) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::xview) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Scrolledtext::yview) [list source [file join $dir scrolledtext.itk]]
+set auto_index(::iwidgets::Selectionbox) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::selectionbox) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::constructor) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::destructor) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::childsitepos) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::margin) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::itemson) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::selectionon) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::width) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::height) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::childsite) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::get) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::curselection) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::clear) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::insert) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::delete) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::size) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::scan) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::nearest) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::index) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::selection) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::selectitem) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectionbox::_packComponents) [list source [file join $dir selectionbox.itk]]
+set auto_index(::iwidgets::Selectiondialog) [list source [file join $dir selectiondialog.itk]]
+set auto_index(::iwidgets::selectiondialog) [list source [file join $dir selectiondialog.itk]]
+set auto_index(::iwidgets::Selectiondialog::constructor) [list source [file join $dir selectiondialog.itk]]
+set auto_index(::iwidgets::Selectiondialog::childsite) [list source [file join $dir selectiondialog.itk]]
+set auto_index(::iwidgets::Selectiondialog::get) [list source [file join $dir selectiondialog.itk]]
+set auto_index(::iwidgets::Selectiondialog::curselection) [list source [file join $dir selectiondialog.itk]]
+set auto_index(::iwidgets::Selectiondialog::clear) [list source [file join $dir selectiondialog.itk]]
+set auto_index(::iwidgets::Selectiondialog::insert) [list source [file join $dir selectiondialog.itk]]
+set auto_index(::iwidgets::Selectiondialog::delete) [list source [file join $dir selectiondialog.itk]]
+set auto_index(::iwidgets::Selectiondialog::size) [list source [file join $dir selectiondialog.itk]]
+set auto_index(::iwidgets::Selectiondialog::scan) [list source [file join $dir selectiondialog.itk]]
+set auto_index(::iwidgets::Selectiondialog::nearest) [list source [file join $dir selectiondialog.itk]]
+set auto_index(::iwidgets::Selectiondialog::index) [list source [file join $dir selectiondialog.itk]]
+set auto_index(::iwidgets::Selectiondialog::selection) [list source [file join $dir selectiondialog.itk]]
+set auto_index(::iwidgets::Selectiondialog::selectitem) [list source [file join $dir selectiondialog.itk]]
+set auto_index(::iwidgets::Spindate) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::spindate) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::Spindate::constructor) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::Spindate::destructor) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::Spindate::labelpos) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::Spindate::orient) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::Spindate::monthon) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::Spindate::dayon) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::Spindate::yearon) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::Spindate::datemargin) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::Spindate::yeardigits) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::Spindate::monthformat) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::Spindate::get) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::Spindate::show) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::Spindate::_spinMonth) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::Spindate::_spinDay) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::Spindate::_spinYear) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::Spindate::_packDate) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::Spindate::_lastDay) [list source [file join $dir spindate.itk]]
+set auto_index(::iwidgets::Spinint) [list source [file join $dir spinint.itk]]
+set auto_index(::iwidgets::spinint) [list source [file join $dir spinint.itk]]
+set auto_index(::iwidgets::Spinint::constructor) [list source [file join $dir spinint.itk]]
+set auto_index(::iwidgets::Spinint::range) [list source [file join $dir spinint.itk]]
+set auto_index(::iwidgets::Spinint::step) [list source [file join $dir spinint.itk]]
+set auto_index(::iwidgets::Spinint::wrap) [list source [file join $dir spinint.itk]]
+set auto_index(::iwidgets::Spinint::up) [list source [file join $dir spinint.itk]]
+set auto_index(::iwidgets::Spinint::down) [list source [file join $dir spinint.itk]]
+set auto_index(::iwidgets::Spinner) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::spinner) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::constructor) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::destructor) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::arroworient) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::textfont) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::highlightthickness) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::borderwidth) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::increment) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::decrement) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::repeatinterval) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::repeatdelay) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::foreground) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::up) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::down) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::_positionArrows) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::_pushup) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::_pushdown) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::_doup) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::_dodown) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::_relup) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::_reldown) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::_up) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spinner::_down) [list source [file join $dir spinner.itk]]
+set auto_index(::iwidgets::Spintime) [list source [file join $dir spintime.itk]]
+set auto_index(::iwidgets::spintime) [list source [file join $dir spintime.itk]]
+set auto_index(::iwidgets::Spintime::constructor) [list source [file join $dir spintime.itk]]
+set auto_index(::iwidgets::Spintime::destructor) [list source [file join $dir spintime.itk]]
+set auto_index(::iwidgets::Spintime::orient) [list source [file join $dir spintime.itk]]
+set auto_index(::iwidgets::Spintime::labelpos) [list source [file join $dir spintime.itk]]
+set auto_index(::iwidgets::Spintime::houron) [list source [file join $dir spintime.itk]]
+set auto_index(::iwidgets::Spintime::minuteon) [list source [file join $dir spintime.itk]]
+set auto_index(::iwidgets::Spintime::secondon) [list source [file join $dir spintime.itk]]
+set auto_index(::iwidgets::Spintime::timemargin) [list source [file join $dir spintime.itk]]
+set auto_index(::iwidgets::Spintime::militaryon) [list source [file join $dir spintime.itk]]
+set auto_index(::iwidgets::Spintime::get) [list source [file join $dir spintime.itk]]
+set auto_index(::iwidgets::Spintime::show) [list source [file join $dir spintime.itk]]
+set auto_index(::iwidgets::Spintime::_packTime) [list source [file join $dir spintime.itk]]
+set auto_index(::iwidgets::Spintime::_down60) [list source [file join $dir spintime.itk]]
+set auto_index(::iwidgets::Tabnotebook) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::constructor) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::tabnotebook) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::destructor) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::borderwidth) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::state) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::disabledforeground) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::scrollcommand) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::equaltabs) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::font) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::width) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::height) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::foreground) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::background) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::tabforeground) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::tabbackground) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::backdrop) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::margin) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::tabborders) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::bevelamount) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::raiseselect) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::auto) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::start) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::padx) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::pady) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::gap) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::angle) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::tabpos) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::configure) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::add) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::childsite) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::delete) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::index) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::insert) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::prev) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::next) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::pageconfigure) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::select) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::view) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::_getArgs) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::_reconfigureTabset) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::_canvasReconfigure) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::_redrawBorder) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::_recomputeBorder) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::_pageReconfigure) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabnotebook::_pack) [list source [file join $dir tabnotebook.itk]]
+set auto_index(::iwidgets::Tabset) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::tabset) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::constructor) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::destructor) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::width) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::equaltabs) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::height) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::tabpos) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::raiseselect) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::start) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::margin) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::tabborders) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::bevelamount) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::padx) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::pady) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::gap) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::angle) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::font) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::state) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::disabledforeground) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::foreground) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::background) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::selectforeground) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::backdrop) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::selectbackground) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::command) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::add) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::configure) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::_configRelayout) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::delete) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::index) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::insert) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::prev) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::next) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::select) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::tabcget) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::tabconfigure) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::_selectName) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::_createTab) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::_deleteTabs) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::_index) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::_tabConfigure) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::_relayoutTabs) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::_drawBevelBorder) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::_calcNextTabOffset) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::_tabBounds) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::_recalcCanvasGeom) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::_canvasReconfigure) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::_startMove) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::_moveTabs) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tabset::_endMove) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::constructor) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::destructor) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::bevelamount) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::state) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::height) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::width) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::anchor) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::left) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::top) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::image) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::bitmap) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::label) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::padx) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::pady) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::selectbackground) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::selectforeground) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::disabledforeground) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::background) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::foreground) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::orient) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::invert) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::angle) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::font) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::tabborders) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::configure) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::bbox) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::deselect) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::lower) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::majordim) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::minordim) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::offset) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::raise) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::select) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::labelheight) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::labelwidth) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::_selectNoRaise) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::_deselectNoLower) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::_makeTab) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::_createLabel) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::_makeEastTab) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::_makeWestTab) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::_makeNorthTab) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::_makeSouthTab) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Tab::_calcLabelDim) [list source [file join $dir tabset.itk]]
+set auto_index(::iwidgets::Toolbar) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::constructor) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::toolbar) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::destructor) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::balloonbackground) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::balloonforeground) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::balloonfont) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::orient) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::add) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::delete) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::index) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::insert) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::itemcget) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::itemconfigure) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::_resetBalloonTimer) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::_startBalloonDelay) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::_stopBalloonDelay) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::_addWidget) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::_deleteWidgets) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::_index) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::hideHelp) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::showHelp) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::showBalloon) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::hideBalloon) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::_getAttachedOption) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::_setAttachedOption) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Toolbar::_packToolbar) [list source [file join $dir toolbar.itk]]
+set auto_index(::iwidgets::Canvasprintdialog) [list source [file join $dir canvasprintdialog.itk]]
+set auto_index(::iwidgets::canvasprintdialog) [list source [file join $dir canvasprintdialog.itk]]
+set auto_index(::iwidgets::Canvasprintdialog::constructor) [list source [file join $dir canvasprintdialog.itk]]
+set auto_index(::iwidgets::Canvasprintdialog::deactivate) [list source [file join $dir canvasprintdialog.itk]]
+set auto_index(::iwidgets::Canvasprintdialog::getoutput) [list source [file join $dir canvasprintdialog.itk]]
+set auto_index(::iwidgets::Canvasprintdialog::setcanvas) [list source [file join $dir canvasprintdialog.itk]]
+set auto_index(::iwidgets::Canvasprintdialog::refresh) [list source [file join $dir canvasprintdialog.itk]]
+set auto_index(::iwidgets::Canvasprintdialog::print) [list source [file join $dir canvasprintdialog.itk]]
+set auto_index(::iwidgets::Pushbutton) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::pushbutton) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::Pushbutton::constructor) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::Pushbutton::destructor) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::Pushbutton::padx) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::Pushbutton::pady) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::Pushbutton::font) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::Pushbutton::text) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::Pushbutton::bitmap) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::Pushbutton::image) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::Pushbutton::highlightthickness) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::Pushbutton::borderwidth) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::Pushbutton::defaultring) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::Pushbutton::defaultringpad) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::Pushbutton::height) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::Pushbutton::width) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::Pushbutton::flash) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::Pushbutton::invoke) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::Pushbutton::_relayout) [list source [file join $dir pushbutton.itk]]
+set auto_index(::iwidgets::Calendar) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::calendar) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::constructor) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::command) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::days) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::backwardimage) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::forwardimage) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::weekdaybackground) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::weekendbackground) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::foreground) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::outline) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::buttonforeground) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::selectcolor) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::selectthickness) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::titlefont) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::datefont) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::currentdatefont) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::dayfont) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::startday) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::get) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::select) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::show) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::_drawtext) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::_configureHandler) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::_change) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::_redraw) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::_days) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::_layout) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::_adjustday) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::_select) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::_selectEvent) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Calendar::_percentSubst) [list source [file join $dir calendar.itk]]
+set auto_index(::iwidgets::Scrolledhtml) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::scrolledhtml) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::constructor) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::destructor) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::fontsize) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::fixedfont) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::fontname) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::textbackground) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::linkhighlight) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::unknownimage) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::update) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::clear) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::import) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::render) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_setup) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_definefont) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_append_text) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_set_tag) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_reconfig_tags) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_push) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_pop) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_peek) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_parse_fields) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_href_click) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_set_align) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_fixtablewidth) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_header) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_/header) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_a) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/a) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_address) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/address) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_b) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/b) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_base) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_basefont) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_big) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/big) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_blockquote) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/blockquote) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_body) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/body) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_br) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_center) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/center) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_cite) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/cite) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_code) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/code) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_dir) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/dir) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_div) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_dl) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/dl) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_dt) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_dd) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_dfn) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/dfn) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_em) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/em) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_font) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/font) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_h1) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/h1) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_h2) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/h2) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_h3) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/h3) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_h4) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/h4) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_h5) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/h5) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_h6) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/h6) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_hr) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_i) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/i) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_img) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_kbd) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/kbd) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_li) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_listing) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/listing) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_menu) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/menu) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_ol) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/ol) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_p) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_pre) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/pre) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_samp) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/samp) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_small) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/small) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_sub) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/sub) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_sup) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/sup) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_strong) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/strong) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_table) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/table) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_td) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/td) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_th) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/th) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_title) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/title) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_tr) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/tr) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_tt) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/tt) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_u) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/u) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_ul) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/ul) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_var) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Scrolledhtml::_entity_/var) [list source [file join $dir scrolledhtml.itk]]
+set auto_index(::iwidgets::Entryfield) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::numeric) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::integer) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::alphabetic) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::alphanumeric) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::hexidecimal) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::real) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::entryfield) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::constructor) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::command) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::focuscommand) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::validate) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::invalid) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::fixed) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::childsitepos) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::childsite) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::get) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::delete) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::icursor) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::index) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::insert) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::scan) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::selection) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::xview) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::clear) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::numeric) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::integer) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::alphabetic) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::alphanumeric) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::hexidecimal) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::real) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::_peek) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::_focusCommand) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Entryfield::_keyPress) [list source [file join $dir entryfield.itk]]
+set auto_index(::iwidgets::Labeledframe) [list source [file join $dir labeledframe.itk]]
+set auto_index(::iwidgets::Labeledframe::_initTable) [list source [file join $dir labeledframe.itk]]
+set auto_index(::iwidgets::labeledframe) [list source [file join $dir labeledframe.itk]]
+set auto_index(::iwidgets::Labeledframe::constructor) [list source [file join $dir labeledframe.itk]]
+set auto_index(::iwidgets::Labeledframe::destructor) [list source [file join $dir labeledframe.itk]]
+set auto_index(::iwidgets::Labeledframe::ipadx) [list source [file join $dir labeledframe.itk]]
+set auto_index(::iwidgets::Labeledframe::ipady) [list source [file join $dir labeledframe.itk]]
+set auto_index(::iwidgets::Labeledframe::labelmargin) [list source [file join $dir labeledframe.itk]]
+set auto_index(::iwidgets::Labeledframe::labelpos) [list source [file join $dir labeledframe.itk]]
+set auto_index(::iwidgets::Labeledframe::_initTable) [list source [file join $dir labeledframe.itk]]
+set auto_index(::iwidgets::Labeledframe::childsite) [list source [file join $dir labeledframe.itk]]
+set auto_index(::iwidgets::Labeledframe::_positionLabel) [list source [file join $dir labeledframe.itk]]
+set auto_index(::iwidgets::Labeledframe::_collapseMargin) [list source [file join $dir labeledframe.itk]]
+set auto_index(::iwidgets::Labeledframe::_setMarginThickness) [list source [file join $dir labeledframe.itk]]
+set auto_index(::iwidgets::Scrolledwidget) [list source [file join $dir scrolledwidget.itk]]
+set auto_index(::iwidgets::scrolledwidget) [list source [file join $dir scrolledwidget.itk]]
+set auto_index(::iwidgets::Scrolledwidget::constructor) [list source [file join $dir scrolledwidget.itk]]
+set auto_index(::iwidgets::Scrolledwidget::destructor) [list source [file join $dir scrolledwidget.itk]]
+set auto_index(::iwidgets::Scrolledwidget::sbwidth) [list source [file join $dir scrolledwidget.itk]]
+set auto_index(::iwidgets::Scrolledwidget::scrollmargin) [list source [file join $dir scrolledwidget.itk]]
+set auto_index(::iwidgets::Scrolledwidget::vscrollmode) [list source [file join $dir scrolledwidget.itk]]
+set auto_index(::iwidgets::Scrolledwidget::hscrollmode) [list source [file join $dir scrolledwidget.itk]]
+set auto_index(::iwidgets::Scrolledwidget::width) [list source [file join $dir scrolledwidget.itk]]
+set auto_index(::iwidgets::Scrolledwidget::height) [list source [file join $dir scrolledwidget.itk]]
+set auto_index(::iwidgets::Scrolledwidget::_vertScrollbarDisplay) [list source [file join $dir scrolledwidget.itk]]
+set auto_index(::iwidgets::Scrolledwidget::_horizScrollbarDisplay) [list source [file join $dir scrolledwidget.itk]]
+set auto_index(::iwidgets::Scrolledwidget::_scrollWidget) [list source [file join $dir scrolledwidget.itk]]
+set auto_index(::iwidgets::Scrolledwidget::_configureEvent) [list source [file join $dir scrolledwidget.itk]]
+set auto_index(::iwidgets::Checkbox) [list source [file join $dir checkbox.itk]]
+set auto_index(::iwidgets::checkbox) [list source [file join $dir checkbox.itk]]
+set auto_index(::iwidgets::Checkbox::constructor) [list source [file join $dir checkbox.itk]]
+set auto_index(::iwidgets::Checkbox::command) [list source [file join $dir checkbox.itk]]
+set auto_index(::iwidgets::Checkbox::index) [list source [file join $dir checkbox.itk]]
+set auto_index(::iwidgets::Checkbox::add) [list source [file join $dir checkbox.itk]]
+set auto_index(::iwidgets::Checkbox::insert) [list source [file join $dir checkbox.itk]]
+set auto_index(::iwidgets::Checkbox::delete) [list source [file join $dir checkbox.itk]]
+set auto_index(::iwidgets::Checkbox::select) [list source [file join $dir checkbox.itk]]
+set auto_index(::iwidgets::Checkbox::toggle) [list source [file join $dir checkbox.itk]]
+set auto_index(::iwidgets::Checkbox::get) [list source [file join $dir checkbox.itk]]
+set auto_index(::iwidgets::Checkbox::deselect) [list source [file join $dir checkbox.itk]]
+set auto_index(::iwidgets::Checkbox::flash) [list source [file join $dir checkbox.itk]]
+set auto_index(::iwidgets::Checkbox::buttonconfigure) [list source [file join $dir checkbox.itk]]
+set auto_index(::iwidgets::Checkbox::gettag) [list source [file join $dir checkbox.itk]]
+set auto_index(::iwidgets::Disjointlistbox) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::disjointlistbox) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::Disjointlistbox::constructor) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::Disjointlistbox::listboxClick) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::Disjointlistbox::listboxDblClick) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::Disjointlistbox::transfer) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::Disjointlistbox::getlhs) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::Disjointlistbox::getrhs) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::Disjointlistbox::insertrhs) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::Disjointlistbox::insertlhs) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::Disjointlistbox::clear) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::Disjointlistbox::insert) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::Disjointlistbox::remove) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::Disjointlistbox::showCount) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::Disjointlistbox::setlhs) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::Disjointlistbox::setrhs) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::Disjointlistbox::lhs) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::Disjointlistbox::rhs) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::Disjointlistbox::buttonplacement) [list source [file join $dir disjointlistbox.itk]]
+set auto_index(::iwidgets::Hierarchy) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::hierarchy) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::constructor) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::destructor) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::font) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::selectbackground) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::selectforeground) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::markbackground) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::markforeground) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::querycommand) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::selectcommand) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::iconcommand) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::alwaysquery) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::filter) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::expanded) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::openicon) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::closedicon) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::nodeicon) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::width) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::height) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::visibleitems) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::clear) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::selection) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::mark) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::current) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::expand) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::collapse) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::toggle) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::prune) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::draw) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::refresh) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::bbox) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::compare) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::delete) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::dump) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::dlineinfo) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::get) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::index) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::insert) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::scan) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::search) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::see) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::tag) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::window) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::xview) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::yview) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::_drawLevel) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::_contents) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::_post) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::_select) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::_iconSelect) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::_deselectSubNodes) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::_deleteNodeInfo) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::_getParent) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Hierarchy::_getHeritage) [list source [file join $dir hierarchy.itk]]
+set auto_index(::iwidgets::Datefield) [list source [file join $dir datefield.itk]]
+set auto_index(::iwidgets::datefield) [list source [file join $dir datefield.itk]]
+set auto_index(::iwidgets::Datefield::constructor) [list source [file join $dir datefield.itk]]
+set auto_index(::iwidgets::Datefield::childsitepos) [list source [file join $dir datefield.itk]]
+set auto_index(::iwidgets::Datefield::command) [list source [file join $dir datefield.itk]]
+set auto_index(::iwidgets::Datefield::iq) [list source [file join $dir datefield.itk]]
+set auto_index(::iwidgets::Datefield::get) [list source [file join $dir datefield.itk]]
+set auto_index(::iwidgets::Datefield::show) [list source [file join $dir datefield.itk]]
+set auto_index(::iwidgets::Datefield::isvalid) [list source [file join $dir datefield.itk]]
+set auto_index(::iwidgets::Datefield::_focusIn) [list source [file join $dir datefield.itk]]
+set auto_index(::iwidgets::Datefield::_keyPress) [list source [file join $dir datefield.itk]]
+set auto_index(::iwidgets::Datefield::_setField) [list source [file join $dir datefield.itk]]
+set auto_index(::iwidgets::Datefield::_moveField) [list source [file join $dir datefield.itk]]
+set auto_index(::iwidgets::Datefield::_whichField) [list source [file join $dir datefield.itk]]
+set auto_index(::iwidgets::Datefield::_forward) [list source [file join $dir datefield.itk]]
+set auto_index(::iwidgets::Datefield::_backward) [list source [file join $dir datefield.itk]]
+set auto_index(::iwidgets::Datefield::_lastDay) [list source [file join $dir datefield.itk]]
+set auto_index(::iwidgets::MsgType) [list source [file join $dir messagebox.itk]]
+set auto_index(::iwidgets::Messagebox) [list source [file join $dir messagebox.itk]]
+set auto_index(::iwidgets::messagebox) [list source [file join $dir messagebox.itk]]
+set auto_index(::iwidgets::Messagebox::constructor) [list source [file join $dir messagebox.itk]]
+set auto_index(::iwidgets::Messagebox::destructor) [list source [file join $dir messagebox.itk]]
+set auto_index(::iwidgets::Messagebox::clear) [list source [file join $dir messagebox.itk]]
+set auto_index(::iwidgets::Messagebox::type) [list source [file join $dir messagebox.itk]]
+set auto_index(::iwidgets::Messagebox::issue) [list source [file join $dir messagebox.itk]]
+set auto_index(::iwidgets::Messagebox::save) [list source [file join $dir messagebox.itk]]
+set auto_index(::iwidgets::Messagebox::find) [list source [file join $dir messagebox.itk]]
+set auto_index(::iwidgets::Messagebox::_post) [list source [file join $dir messagebox.itk]]
+set auto_index(::iwidgets::Messagebox::export) [list source [file join $dir messagebox.itk]]
+set auto_index(::iwidgets::Timefield) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::timefield) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Timefield::constructor) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Timefield::childsitepos) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Timefield::command) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Timefield::iq) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Timefield::format) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Timefield::get) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Timefield::show) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Timefield::isvalid) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Timefield::_focusIn) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Timefield::_keyPress) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Timefield::_toggleAmPm) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Timefield::_setField) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Timefield::_moveField) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Timefield::_whichField) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Timefield::_forwardCivilian) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Timefield::_forwardMilitary) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Timefield::_backwardCivilian) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Timefield::_backwardMilitary) [list source [file join $dir timefield.itk]]
+set auto_index(::iwidgets::Watch) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::watch) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::constructor) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::destructor) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::_handReleaseCB) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::_handMotionCB) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::get) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::watch) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::_drawHand) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::show) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::_displayClock) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::state) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::showampm) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::pivotcolor) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::clockstipple) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::clockcolor) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::hourcolor) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::minutecolor) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::secondcolor) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::tickcolor) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::hourradius) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::minuteradius) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Watch::secondradius) [list source [file join $dir watch.itk]]
+set auto_index(::iwidgets::Extfileselectionbox) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::extfileselectionbox) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::constructor) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::destructor) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::childsitepos) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::fileson) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::dirson) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::selectionon) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::filteron) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::mask) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::directory) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::nomatchstring) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::dirsearchcommand) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::filesearchcommand) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::selectioncommand) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::filtercommand) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::selectdircommand) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::selectfilecommand) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::invalid) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::filetype) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::width) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::height) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::childsite) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::get) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::filter) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::_updateLists) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::_setFilter) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::_setSelection) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::_setDirList) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::_setFileList) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::_selectDir) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::_dblSelectDir) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::_selectFile) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::_selectSelection) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::_selectFilter) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::_packComponents) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::_nPos) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::_sPos) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::_ePos) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::_wPos) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::_topPos) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Extfileselectionbox::_bottomPos) [list source [file join $dir extfileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::fileselectionbox) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::constructor) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::destructor) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::childsitepos) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::fileson) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::dirson) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::selectionon) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::filteron) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::mask) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::directory) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::nomatchstring) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::dirsearchcommand) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::filesearchcommand) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::selectioncommand) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::filtercommand) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::selectdircommand) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::selectfilecommand) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::invalid) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::filetype) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::width) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::height) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::childsite) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::get) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::filter) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::_updateLists) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::_setFilter) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::_setSelection) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::_setDirList) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::_setFileList) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::_selectDir) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::_dblSelectDir) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::_selectFile) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::_selectSelection) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::_selectFilter) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::_packComponents) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::_nPos) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::_sPos) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::_ePos) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::_wPos) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::_topPos) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::_centerPos) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectionbox::_bottomPos) [list source [file join $dir fileselectionbox.itk]]
+set auto_index(::iwidgets::Fileselectiondialog) [list source [file join $dir fileselectiondialog.itk]]
+set auto_index(::iwidgets::fileselectiondialog) [list source [file join $dir fileselectiondialog.itk]]
+set auto_index(::iwidgets::Fileselectiondialog::constructor) [list source [file join $dir fileselectiondialog.itk]]
+set auto_index(::iwidgets::Fileselectiondialog::childsite) [list source [file join $dir fileselectiondialog.itk]]
+set auto_index(::iwidgets::Fileselectiondialog::get) [list source [file join $dir fileselectiondialog.itk]]
+set auto_index(::iwidgets::Fileselectiondialog::filter) [list source [file join $dir fileselectiondialog.itk]]
+set auto_index(::iwidgets::Fileselectiondialog::_dbldir) [list source [file join $dir fileselectiondialog.itk]]
+set auto_index(::iwidgets::Finddialog) [list source [file join $dir finddialog.itk]]
+set auto_index(::iwidgets::finddialog) [list source [file join $dir finddialog.itk]]
+set auto_index(::iwidgets::Finddialog::constructor) [list source [file join $dir finddialog.itk]]
+set auto_index(::iwidgets::Finddialog::clearcommand) [list source [file join $dir finddialog.itk]]
+set auto_index(::iwidgets::Finddialog::matchcommand) [list source [file join $dir finddialog.itk]]
+set auto_index(::iwidgets::Finddialog::patternbackground) [list source [file join $dir finddialog.itk]]
+set auto_index(::iwidgets::Finddialog::patternforeground) [list source [file join $dir finddialog.itk]]
+set auto_index(::iwidgets::Finddialog::searchforeground) [list source [file join $dir finddialog.itk]]
+set auto_index(::iwidgets::Finddialog::searchbackground) [list source [file join $dir finddialog.itk]]
+set auto_index(::iwidgets::Finddialog::textwidget) [list source [file join $dir finddialog.itk]]
+set auto_index(::iwidgets::Finddialog::clear) [list source [file join $dir finddialog.itk]]
+set auto_index(::iwidgets::Finddialog::find) [list source [file join $dir finddialog.itk]]
+set auto_index(::iwidgets::Finddialog::_get) [list source [file join $dir finddialog.itk]]
+set auto_index(::iwidgets::Finddialog::_textExists) [list source [file join $dir finddialog.itk]]
+set auto_index(::iwidgets::Mainwindow) [list source [file join $dir mainwindow.itk]]
+set auto_index(::iwidgets::mainwindow) [list source [file join $dir mainwindow.itk]]
+set auto_index(::iwidgets::Mainwindow::constructor) [list source [file join $dir mainwindow.itk]]
+set auto_index(::iwidgets::Mainwindow::helpline) [list source [file join $dir mainwindow.itk]]
+set auto_index(::iwidgets::Mainwindow::statusline) [list source [file join $dir mainwindow.itk]]
+set auto_index(::iwidgets::Mainwindow::childsite) [list source [file join $dir mainwindow.itk]]
+set auto_index(::iwidgets::Mainwindow::menubar) [list source [file join $dir mainwindow.itk]]
+set auto_index(::iwidgets::Mainwindow::toolbar) [list source [file join $dir mainwindow.itk]]
+set auto_index(::iwidgets::Mainwindow::mousebar) [list source [file join $dir mainwindow.itk]]
+set auto_index(::iwidgets::Mainwindow::msgd) [list source [file join $dir mainwindow.itk]]
+set auto_index(::iwidgets::Mainwindow::_exitCB) [list source [file join $dir mainwindow.itk]]
+set auto_index(::iwidgets::Dateentry) [list source [file join $dir dateentry.itk]]
+set auto_index(::iwidgets::dateentry) [list source [file join $dir dateentry.itk]]
+set auto_index(::iwidgets::Dateentry::constructor) [list source [file join $dir dateentry.itk]]
+set auto_index(::iwidgets::Dateentry::icon) [list source [file join $dir dateentry.itk]]
+set auto_index(::iwidgets::Dateentry::grab) [list source [file join $dir dateentry.itk]]
+set auto_index(::iwidgets::Dateentry::state) [list source [file join $dir dateentry.itk]]
+set auto_index(::iwidgets::Dateentry::_getDefaultIcon) [list source [file join $dir dateentry.itk]]
+set auto_index(::iwidgets::Dateentry::_popup) [list source [file join $dir dateentry.itk]]
+set auto_index(::iwidgets::Dateentry::_getPopupDate) [list source [file join $dir dateentry.itk]]
+set auto_index(::iwidgets::Dateentry::_releaseGrabCheck) [list source [file join $dir dateentry.itk]]
+set auto_index(::iwidgets::Dateentry::_releaseGrab) [list source [file join $dir dateentry.itk]]
+set auto_index(::iwidgets::Extfileselectiondialog) [list source [file join $dir extfileselectiondialog.itk]]
+set auto_index(::iwidgets::extfileselectiondialog) [list source [file join $dir extfileselectiondialog.itk]]
+set auto_index(::iwidgets::Extfileselectiondialog::constructor) [list source [file join $dir extfileselectiondialog.itk]]
+set auto_index(::iwidgets::Extfileselectiondialog::childsite) [list source [file join $dir extfileselectiondialog.itk]]
+set auto_index(::iwidgets::Extfileselectiondialog::get) [list source [file join $dir extfileselectiondialog.itk]]
+set auto_index(::iwidgets::Extfileselectiondialog::filter) [list source [file join $dir extfileselectiondialog.itk]]
+set auto_index(::iwidgets::Extfileselectiondialog::_dbldir) [list source [file join $dir extfileselectiondialog.itk]]
+set auto_index(::iwidgets::Timeentry) [list source [file join $dir timeentry.itk]]
+set auto_index(::iwidgets::timeentry) [list source [file join $dir timeentry.itk]]
+set auto_index(::iwidgets::Timeentry::constructor) [list source [file join $dir timeentry.itk]]
+set auto_index(::iwidgets::Timeentry::icon) [list source [file join $dir timeentry.itk]]
+set auto_index(::iwidgets::Timeentry::grab) [list source [file join $dir timeentry.itk]]
+set auto_index(::iwidgets::Timeentry::state) [list source [file join $dir timeentry.itk]]
+set auto_index(::iwidgets::Timeentry::_getDefaultIcon) [list source [file join $dir timeentry.itk]]
+set auto_index(::iwidgets::Timeentry::_popup) [list source [file join $dir timeentry.itk]]
+set auto_index(::iwidgets::Timeentry::_getPopupTime) [list source [file join $dir timeentry.itk]]
+set auto_index(::iwidgets::Timeentry::_releaseGrab) [list source [file join $dir timeentry.itk]]
+set auto_index(::iwidgets::Regexpfield) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::regexpfield) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::constructor) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::command) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::focuscommand) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::regexp) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::invalid) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::fixed) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::childsitepos) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::nocase) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::childsite) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::get) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::delete) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::icursor) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::index) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::insert) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::scan) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::selection) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::xview) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::clear) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::_peek) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::_focusCommand) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Regexpfield::_keyPress) [list source [file join $dir regexpfield.itk]]
+set auto_index(::iwidgets::Scopedobject) [list source [file join $dir scopedobject.itcl]]
+set auto_index(::iwidgets::scopedobject) [list source [file join $dir scopedobject.itcl]]
+set auto_index(::iwidgets::Scopedobject::constructor) [list source [file join $dir scopedobject.itcl]]
+set auto_index(::iwidgets::Scopedobject::destructor) [list source [file join $dir scopedobject.itcl]]
+set auto_index(::iwidgets::Scopedobject::_traceCommand) [list source [file join $dir scopedobject.itcl]]
+set auto_index(::iwidgets::Scopedobject::enterscopecommand) [list source [file join $dir scopedobject.itcl]]
+set auto_index(::iwidgets::Scopedobject::exitscopecommand) [list source [file join $dir scopedobject.itcl]]
+set auto_index(::iwidgets::colors::rgbToNumeric) [list source [file join $dir colors.itcl]]
+set auto_index(::iwidgets::colors::rgbToHsb) [list source [file join $dir colors.itcl]]
+set auto_index(::iwidgets::colors::hsbToRgb) [list source [file join $dir colors.itcl]]
+set auto_index(::iwidgets::colors::topShadow) [list source [file join $dir colors.itcl]]
+set auto_index(::iwidgets::colors::bottomShadow) [list source [file join $dir colors.itcl]]
diff --git a/itcl/iwidgets3.0.0/generic/timeentry.itk b/itcl/iwidgets3.0.0/generic/timeentry.itk
new file mode 100644
index 00000000000..20fb4c7d65f
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/timeentry.itk
@@ -0,0 +1,399 @@
+#
+# Timeentry
+# ----------------------------------------------------------------------
+# Implements a quicken style time entry field with a popup clock
+# by combining the timefield and watch widgets together. This
+# allows a user to enter the time via the keyboard or by using the
+# mouse by selecting the watch icon which brings up a popup clock.
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts E-mail: mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1997 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPTIMES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Timeentry {
+ keep -background -borderwidth -cursor -foreground -highlightcolor \
+ -highlightthickness -labelfont -textbackground -textfont
+}
+
+# ------------------------------------------------------------------
+# TIMEENTRY
+# ------------------------------------------------------------------
+class iwidgets::Timeentry {
+ inherit iwidgets::Timefield
+
+ constructor {args} {}
+
+ itk_option define -grab grab Grab "global"
+ itk_option define -icon icon Icon {}
+ itk_option define -state state State normal
+ itk_option define -closetext closeText Text Close
+
+ #
+ # The watch widget isn't created until needed, yet we need
+ # its options to be available upon creation of a timeentry widget.
+ # So, we'll define them in these class now so they can just be
+ # propagated onto the watch later.
+ #
+ itk_option define -hourradius hourRadius Radius .50
+ itk_option define -hourcolor hourColor Color red
+
+ itk_option define -minuteradius minuteRadius Radius .80
+ itk_option define -minutecolor minuteColor Color yellow
+
+ itk_option define -pivotradius pivotRadius Radius .10
+ itk_option define -pivotcolor pivotColor Color white
+
+ itk_option define -secondradius secondRadius Radius .90
+ itk_option define -secondcolor secondColor Color black
+
+ itk_option define -clockcolor clockColor Color white
+ itk_option define -clockstipple clockStipple ClockStipple {}
+
+ itk_option define -tickcolor tickColor Color black
+
+ itk_option define -watchheight watchHeight Height 175
+ itk_option define -watchwidth watchWidth Width 155
+
+ protected {
+ method _getPopupTime {}
+ method _releaseGrab {}
+ method _popup {}
+ method _getDefaultIcon {}
+
+ common _defaultIcon ""
+ }
+}
+
+#
+# Provide a lowercased access method for the timeentry class.
+#
+proc ::iwidgets::timeentry {pathName args} {
+ uplevel ::iwidgets::Timeentry $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Timeentry.watchWidth 155 widgetDefault
+option add *Timeentry.watchHeight 175 widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Timeentry::constructor {args} {
+ #
+ # Create an icon label to act as a button to bring up the
+ # watch popup.
+ #
+ itk_component add iconbutton {
+ label $itk_interior.iconbutton -relief raised
+ } {
+ keep -borderwidth -cursor -foreground
+ }
+ grid $itk_component(iconbutton) -row 0 -column 0 -sticky ns
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -icon
+#
+# Specifies the clock icon image to be used in the time entry.
+# Should one not be provided, then a default pixmap will be used
+# if possible, bitmap otherwise.
+# ------------------------------------------------------------------
+configbody iwidgets::Timeentry::icon {
+ if {$itk_option(-icon) == {}} {
+ $itk_component(iconbutton) configure -image [_getDefaultIcon]
+ } else {
+ if {[lsearch [image names] $itk_option(-icon)] == -1} {
+ error "bad icon option \"$itk_option(-icon)\":\
+ should be an existing image"
+ } else {
+ $itk_component(iconbutton) configure -image $itk_option(-icon)
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -grab
+#
+# Specifies the grab level, local or global, to be obtained when
+# bringing up the popup watch. The default is global.
+# ------------------------------------------------------------------
+configbody iwidgets::Timeentry::grab {
+ switch -- $itk_option(-grab) {
+ "local" - "global" {}
+ default {
+ error "bad grab option \"$itk_option(-grab)\":\
+ should be local or global"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -state
+#
+# Specifies the state of the widget which may be disabled or
+# normal. A disabled state prevents selection of the time field
+# or time icon button.
+# ------------------------------------------------------------------
+configbody iwidgets::Timeentry::state {
+ switch -- $itk_option(-state) {
+ normal {
+ bind $itk_component(iconbutton) <Button-1> [code $this _popup]
+ }
+ disabled {
+ bind $itk_component(iconbutton) <Button-1> {}
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _getDefaultIcon
+#
+# This method is invoked uto retrieve the name of the default icon
+# image displayed in the icon button.
+# ------------------------------------------------------------------
+body iwidgets::Timeentry::_getDefaultIcon {} {
+
+ if {[lsearch [image types] pixmap] != -1} {
+ set _defaultIcon [image create pixmap -data {
+ /* XPM */
+ static char *watch1a[] = {
+ /* width height num_colors chars_per_pixel */
+ " 20 20 8 1",
+ /* colors */
+ ". c #000000",
+ "# c #000099",
+ "a c #009999",
+ "b c #999999",
+ "c c #cccccc",
+ "d c #ffff00",
+ "e c #d9d9d9",
+ "f c #ffffff",
+ /* pixels */
+ "eeeeebbbcccccbbbeeee",
+ "eeeee...#####..beeee",
+ "eeeee#aacccccaabeeee",
+ "eeee#accccccccc##eee",
+ "eee#ccc#cc#ccdcff#ee",
+ "ee#accccccccccfcca#e",
+ "eeaccccccc.cccfcccae",
+ "eeac#cccfc.cccc##cae",
+ "e#cccccffc.cccccccc#",
+ "e#ccccfffc.cccccccc#",
+ "e#cc#ffcc......c#cc#",
+ "e#ccfffccc.cccccccc#",
+ "e#cffccfcc.cccccccc#",
+ "eeafdccfcccccccd#cae",
+ "eeafcffcccccccccccae",
+ "eee#fcc#cccccdccc#ee",
+ "eee#fcc#cc#cc#ccc#ee",
+ "eeee#accccccccc##eee",
+ "eeeee#aacccccaabeeee",
+ "eeeee...#####..beeee"
+ };
+ }]
+ } else {
+ set _defaultIcon [image create bitmap -data {
+ #define watch1a_width 20
+ #define watch1a_height 20
+ static char watch1a_bits[] = {
+ 0x40,0x40,0xf0,0xe0,0x7f,0xf0,0xe0,0xe0,0xf0,0x30,
+ 0x80,0xf1,0x88,0x04,0xf2,0x0c,0x00,0xf6,0x04,0x04,
+ 0xf4,0x94,0x84,0xf5,0x02,0x06,0xf8,0x02,0x0c,0xf8,
+ 0x12,0x7e,0xf9,0x02,0x04,0xf8,0x02,0x24,0xf8,0x04,
+ 0x00,0xf5,0x04,0x00,0xf4,0x88,0x02,0xf2,0x88,0x64,
+ 0xf2,0x30,0x80,0xf1,0xe0,0x60,0xf0,0xe0,0xff,0xf0};
+ }]
+ }
+
+ #
+ # Since this image will only need to be created once, we redefine
+ # this method to just return the image name for subsequent calls.
+ #
+ body ::iwidgets::Timeentry::_getDefaultIcon {} {
+ return $_defaultIcon
+ }
+
+ return $_defaultIcon
+}
+
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _popup
+#
+# This method is invoked upon selection of the icon button. It
+# creates a watch widget within a toplevel popup, calculates
+# the position at which to display the watch, performs a grab
+# and displays the watch.
+# ------------------------------------------------------------------
+body iwidgets::Timeentry::_popup {} {
+ #
+ # First, let's nullify the icon binding so that any another
+ # selections are ignored until were done with this one. Next,
+ # change the relief of the icon.
+ #
+ bind $itk_component(iconbutton) <Button-1> {}
+ $itk_component(iconbutton) configure -relief sunken
+
+ #
+ # Create a withdrawn toplevel widget and remove the window
+ # decoration via override redirect.
+ #
+ itk_component add -private popup {
+ toplevel $itk_interior.popup
+ }
+ $itk_component(popup) configure -borderwidth 2 -background black
+ wm withdraw $itk_component(popup)
+ wm overrideredirect $itk_component(popup) 1
+
+ #
+ # Add a binding to for Escape to always release the grab.
+ #
+ bind $itk_component(popup) <KeyPress-Escape> [code $this _releaseGrab]
+
+ #
+ # Create the watch widget.
+ #
+ itk_component add watch {
+ iwidgets::Watch $itk_component(popup).watch
+ } {
+ usual
+
+ rename -width -watchwidth watchWidth Width
+ rename -height -watchheight watchHeight Height
+
+ keep -hourradius -minuteradius -minutecolor -pivotradius -pivotcolor \
+ -secondradius -secondcolor -clockcolor -clockstipple -tickcolor
+ }
+ grid $itk_component(watch) -row 0 -column 0
+ $itk_component(watch) configure -cursor top_left_arrow
+
+ #
+ # Create a button widget so the user can say they are done.
+ #
+ itk_component add close {
+ button $itk_component(popup).close -command [code $this _getPopupTime]
+ } {
+ usual
+ rename -text -closetext closeText Text
+ }
+ grid $itk_component(close) -row 1 -column 0 -sticky ew
+ $itk_component(close) configure -cursor top_left_arrow
+
+ #
+ # The icon button will be used as the basis for the position of the
+ # popup on the screen. We'll always attempt to locate the popup
+ # off the lower right corner of the button. If that would put
+ # the popup off the screen, then we'll put above the upper left.
+ #
+ set rootx [winfo rootx $itk_component(iconbutton)]
+ set rooty [winfo rooty $itk_component(iconbutton)]
+ set popupwidth [cget -watchwidth]
+ set popupheight [expr [cget -watchheight] + \
+ [winfo reqheight $itk_component(close)]]
+
+ set popupx [expr $rootx + 3 + \
+ [winfo width $itk_component(iconbutton)]]
+ set popupy [expr $rooty + 3 + \
+ [winfo height $itk_component(iconbutton)]]
+
+ if {([expr $popupx + $popupwidth] > [winfo screenwidth .]) || \
+ ([expr $popupy + $popupheight] > [winfo screenheight .])} {
+ set popupx [expr $rootx - 3 - $popupwidth]
+ set popupy [expr $rooty - 3 - $popupheight]
+ }
+
+ #
+ # Get the current time from the timefield widget and both
+ # show and select it on the watch.
+ #
+ $itk_component(watch) show [get]
+
+ #
+ # Display the popup at the calculated position.
+ #
+ wm geometry $itk_component(popup) +$popupx+$popupy
+ wm deiconify $itk_component(popup)
+ tkwait visibility $itk_component(popup)
+
+ #
+ # Perform either a local or global grab based on the -grab option.
+ #
+ if {$itk_option(-grab) == "local"} {
+ grab $itk_component(popup)
+ } else {
+ grab -global $itk_component(popup)
+ }
+
+ #
+ # Make sure the widget is above all others and give it focus.
+ #
+ raise $itk_component(popup)
+ focus $itk_component(watch)
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _popupGetTime
+#
+# This method is the callback for selection of a time on the
+# watch. It releases the grab and sets the time in the
+# timefield widget.
+# ------------------------------------------------------------------
+body iwidgets::Timeentry::_getPopupTime {} {
+ show [$itk_component(watch) get -clicks]
+ _releaseGrab
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _releaseGrab
+#
+# This method releases the grab, destroys the popup, changes the
+# relief of the button back to raised and reapplies the binding
+# to the icon button that engages the popup action.
+# ------------------------------------------------------------------
+body iwidgets::Timeentry::_releaseGrab {} {
+ grab release $itk_component(popup)
+ $itk_component(iconbutton) configure -relief raised
+ destroy $itk_component(popup)
+ unset itk_component(popup)
+ bind $itk_component(iconbutton) <Button-1> [code $this _popup]
+}
diff --git a/itcl/iwidgets3.0.0/generic/timefield.itk b/itcl/iwidgets3.0.0/generic/timefield.itk
new file mode 100644
index 00000000000..a30ffc35385
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/timefield.itk
@@ -0,0 +1,975 @@
+#
+# Timefield
+# ----------------------------------------------------------------------
+# Implements a time entry field with adjustable built-in intelligence
+# levels.
+# ----------------------------------------------------------------------
+# AUTHOR: John A. Tucker E-mail: jatucker@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1997 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Timefield.justify center widgetDefault
+
+
+#
+# Usual options.
+#
+itk::usual Timefield {
+ keep -background -borderwidth -cursor -foreground -highlightcolor \
+ -highlightthickness -labelfont -textbackground -textfont
+}
+
+# ------------------------------------------------------------------
+# TIMEFIELD
+# ------------------------------------------------------------------
+class iwidgets::Timefield {
+
+ inherit iwidgets::Labeledwidget
+
+ constructor {args} {}
+
+ itk_option define -childsitepos childSitePos Position e
+ itk_option define -command command Command {}
+ itk_option define -seconds seconds Seconds on
+ itk_option define -format format Format civilian
+ itk_option define -iq iq Iq high
+
+ public {
+ method get {{format "-string"}}
+ method isvalid {}
+ method show {{time "now"}}
+ }
+
+ protected {
+ method _backwardCivilian {}
+ method _backwardMilitary {}
+ method _focusIn {}
+ method _forwardCivilian {}
+ method _forwardMilitary {}
+ method _keyPress {char sym state}
+ method _moveField {direction}
+ method _setField {field}
+ method _whichField {}
+ method _toggleAmPm {}
+
+ variable _cfield hour
+ variable _formatString "%r"
+ variable _fields {}
+ variable _numFields 4
+ variable _forward {}
+ variable _backward {}
+
+ common _militaryFields {hour minute second}
+ common _civilianFields {hour minute second ampm}
+
+ common _timeVar
+ }
+}
+
+#
+# Provide a lowercased access method for the timefield class.
+#
+proc iwidgets::timefield {pathName args} {
+ uplevel iwidgets::Timefield $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Timefield::constructor {args} {
+ component hull configure -borderwidth 0
+
+ set _timeVar($this) ""
+
+ #
+ # Create an entry field for entering the time.
+ #
+ itk_component add time {
+ entry $itk_interior.time \
+ -textvariable [scope _timeVar($this)]
+ } {
+ keep -borderwidth -cursor -exportselection \
+ -foreground -highlightcolor -highlightthickness \
+ -insertbackground -justify -relief
+
+ rename -font -textfont textFont Font
+ rename -highlightbackground -background background Background
+ rename -background -textbackground textBackground Background
+ }
+
+ #
+ # Create the child site widget.
+ #
+ itk_component add -protected dfchildsite {
+ frame $itk_interior.dfchildsite
+ }
+ set itk_interior $itk_component(dfchildsite)
+
+ #
+ # Add timefield event bindings for focus in and keypress events.
+ #
+ bind $itk_component(time) <FocusIn> [code $this _focusIn]
+ bind $itk_component(time) <KeyPress> [code $this _keyPress %A %K %s]
+
+ #
+ # Disable some mouse button event bindings:
+ # Button Motion
+ # Double-Clicks
+ # Triple-Clicks
+ # Button2
+ #
+ bind $itk_component(time) <Button1-Motion> break
+ bind $itk_component(time) <Button2-Motion> break
+ bind $itk_component(time) <Double-Button> break
+ bind $itk_component(time) <Triple-Button> break
+ bind $itk_component(time) <2> break
+
+ #
+ # Initialize the widget based on the command line options.
+ #
+ eval itk_initialize $args
+
+ #
+ # Initialize the time to the current time.
+ #
+ show
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -childsitepos
+#
+# Specifies the position of the child site in the widget. Valid
+# locations are n, s, e, and w.
+# ------------------------------------------------------------------
+configbody iwidgets::Timefield::childsitepos {
+ set parent [winfo parent $itk_component(time)]
+
+ switch $itk_option(-childsitepos) {
+ n {
+ grid $itk_component(dfchildsite) -row 0 -column 0 -sticky ew
+ grid $itk_component(time) -row 1 -column 0 -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 0
+ grid rowconfigure $parent 1 -weight 1
+ grid columnconfigure $parent 0 -weight 1
+ grid columnconfigure $parent 1 -weight 0
+ }
+
+ e {
+ grid $itk_component(dfchildsite) -row 0 -column 1 -sticky ns
+ grid $itk_component(time) -row 0 -column 0 -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 1
+ grid rowconfigure $parent 1 -weight 0
+ grid columnconfigure $parent 0 -weight 1
+ grid columnconfigure $parent 1 -weight 0
+ }
+
+ s {
+ grid $itk_component(dfchildsite) -row 1 -column 0 -sticky ew
+ grid $itk_component(time) -row 0 -column 0 -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 1
+ grid rowconfigure $parent 1 -weight 0
+ grid columnconfigure $parent 0 -weight 1
+ grid columnconfigure $parent 1 -weight 0
+ }
+
+ w {
+ grid $itk_component(dfchildsite) -row 0 -column 0 -sticky ns
+ grid $itk_component(time) -row 0 -column 1 -sticky nsew
+
+ grid rowconfigure $parent 0 -weight 1
+ grid rowconfigure $parent 1 -weight 0
+ grid columnconfigure $parent 0 -weight 0
+ grid columnconfigure $parent 1 -weight 1
+ }
+
+ default {
+ error "bad childsite option\
+ \"$itk_option(-childsitepos)\":\
+ should be n, e, s, or w"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -command
+#
+# Command invoked upon detection of return key press event.
+# ------------------------------------------------------------------
+configbody iwidgets::Timefield::command {}
+
+# ------------------------------------------------------------------
+# OPTION: -iq
+#
+# Specifies the level of intelligence to be shown in the actions
+# taken by the time field during the processing of keypress events.
+# Valid settings include high or low. With a high iq,
+# the time prevents the user from typing in an invalid time. For
+# example, if the current time is 05/31/1997 and the user changes
+# the hour to 04, then the minute will be instantly modified for them
+# to be 30. In addition, leap seconds are fully taken into account.
+# A setting of low iq instructs the widget to do no validity checking
+# at all during time entry. With a low iq level, it is assumed that
+# the validity will be determined at a later time using the time's
+# isvalid command.
+# ------------------------------------------------------------------
+configbody iwidgets::Timefield::iq {
+
+ switch $itk_option(-iq) {
+ high - low {
+
+ }
+ default {
+ error "bad iq option \"$itk_option(-iq)\": should be high or low"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -format
+#
+# Specifies the time format displayed in the entry widget.
+# ------------------------------------------------------------------
+configbody iwidgets::Timefield::format {
+
+ switch $itk_option(-format) {
+ civilian {
+ set _backward _backwardCivilian
+ set _forward _forwardCivilian
+ set _fields $_civilianFields
+ set _numFields 4
+ set _formatString "%r"
+ $itk_component(time) config -width 11
+ }
+ military {
+ set _backward _backwardMilitary
+ set _forward _forwardMilitary
+ set _fields $_militaryFields
+ set _numFields 3
+ set _formatString "%T"
+ $itk_component(time) config -width 8
+ }
+ default {
+ error "bad iq option \"$itk_option(-iq)\":\
+ should be civilian or military"
+ }
+ }
+
+ #
+ # Update the current contents of the entry field to reflect
+ # the configured format.
+ #
+ show $_timeVar($this)
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: get ?format?
+#
+# Return the current contents of the timefield in one of two formats
+# string or as an integer clock value using the -string and -clicks
+# options respectively. The default is by string. Reference the
+# clock command for more information on obtaining times and their
+# formats.
+# ------------------------------------------------------------------
+body iwidgets::Timefield::get {{format "-string"}} {
+
+ switch -- $format {
+ "-string" {
+ return $_timeVar($this)
+ }
+ "-clicks" {
+ return [::clock scan $_timeVar($this)]
+ }
+ default {
+ error "bad format option \"$format\":\
+ should be -string or -clicks"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: show time
+#
+# Changes the currently displayed time to be that of the time
+# argument. The time may be specified either as a string or an
+# integer clock value. Reference the clock command for more
+# information on obtaining times and their formats.
+# ------------------------------------------------------------------
+body iwidgets::Timefield::show {{time "now"}} {
+
+ if {$time == {}} {
+ set time "now"
+ }
+
+ switch -regexp -- $time {
+
+ {^now$} {
+ set seconds [::clock seconds]
+ }
+
+ {^[0-9]+$} {
+ if { [catch {::clock format $time}] } {
+ error "bad time: \"$time\", must be a valid time \
+ string, clock clicks value or the keyword now"
+ }
+ set seconds $time
+ }
+
+ default {
+ if {[catch {set seconds [::clock scan $time]}]} {
+ error "bad time: \"$time\", must be a valid time \
+ string, clock clicks value or the keyword now"
+ }
+ }
+ }
+
+ set _timeVar($this) [::clock format $seconds -format $_formatString]
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: isvalid
+#
+# Returns a boolean indication of the validity of the currently
+# displayed time value. For example, 09:59::59 is valid whereas
+# 26:59:59 is invalid.
+# ------------------------------------------------------------------
+body iwidgets::Timefield::isvalid {} {
+
+ return [expr ([catch {::clock scan $_timeVar($this)}] == 0)]
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _focusIn
+#
+# This method is bound to the <FocusIn> event. It resets the
+# insert cursor and field settings to be back to their last known
+# positions.
+# ------------------------------------------------------------------
+body iwidgets::Timefield::_focusIn {} {
+ _setField $_cfield
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _keyPress
+#
+# This method is the workhorse of the class. It is bound to the
+# <KeyPress> event and controls the processing of all key strokes.
+# ------------------------------------------------------------------
+body iwidgets::Timefield::_keyPress {char sym state} {
+
+ #
+ # Determine which field we are in currently. This is needed
+ # since the user may have moved to this position via a mouse
+ # selection and so it would not be in the position we last
+ # knew it to be.
+ #
+ set _cfield [_whichField ]
+
+ #
+ # Set up a few basic variables we'll be needing throughout the
+ # rest of the method such as the position of the insert cursor
+ # and the currently displayed minute, hour, and second.
+ #
+ set inValid 0
+ set icursor [$itk_component(time) index insert]
+ set lastField [lindex $_fields end]
+
+ set prevtime $_timeVar($this)
+ regexp {^([0-9])([0-9]):([0-9])([0-9]):([0-9])([0-9]).*$} \
+ $_timeVar($this) dummy \
+ hour1 hour2 minute1 minute2 second1 second2
+ set hour "$hour1$hour2"
+ set minute "$minute1$minute2"
+ set second "$second1$second2"
+
+ #
+ # Process numeric keystrokes. This involes a fair amount of
+ # processing with step one being to check and make sure we
+ # aren't attempting to insert more that 6 characters. If
+ # so ring the bell and break.
+ #
+ if {![catch {expr int($char)}]} {
+
+ # If we are currently in the hour field then we process the
+ # number entered based on the cursor position. If we are at
+ # at the first position and our iq is low, then accept any
+ # input.
+ #
+ # if the current format is military, then
+ # validate the hour field which can be [00 - 23]
+ #
+ switch $_cfield {
+ hour {
+ if {$itk_option(-iq) == "low"} {
+ $itk_component(time) delete $icursor
+ $itk_component(time) insert $icursor $char
+
+ } elseif {$itk_option(-format) == "military"} {
+ if {$icursor == 0} {
+ #
+ # if the digit is less than 2, then
+ # the second hour digit is valid for 0-9
+ #
+ if {$char < 2} {
+ $itk_component(time) delete 0 1
+ $itk_component(time) insert 0 $char
+
+ #
+ # if the digit is equal to 2, then
+ # the second hour digit is valid for 0-3
+ #
+ } elseif {$char == 2} {
+ $itk_component(time) delete 0 1
+ $itk_component(time) insert 0 $char
+
+ if {$hour2 > 3} {
+ $itk_component(time) delete 1 2
+ $itk_component(time) insert 1 "0"
+ $itk_component(time) icursor 1
+ }
+
+ #
+ # if the digit is greater than 2, then
+ # set the first hour digit to 0 and the
+ # second hour digit to the value.
+ #
+ } elseif {$char > 2} {
+ $itk_component(time) delete 0 2
+ $itk_component(time) insert 0 "0$char"
+ set icursor 1
+ } else {
+ set inValid 1
+ }
+
+ #
+ # if the insertion cursor is for the second hour digit, then
+ # format is military, then it can only be valid if the first
+ # hour digit is less than 2 or the new digit is less than 4
+ #
+ } else {
+ if {$hour1 < 2 || $char < 4} {
+ $itk_component(time) delete 1 2
+ $itk_component(time) insert 1 $char
+ } else {
+ set inValid 1
+ }
+ }
+
+ #
+ # The format is civilian, so we need to
+ # validate the hour field which can be [01 - 12]
+ #
+ } else {
+ if {$icursor == 0} {
+ #
+ # if the digit is 0, then
+ # the second hour digit is valid for 1-9
+ # so just insert it.
+ #
+ if {$char == 0 && $hour2 != 0} {
+ $itk_component(time) delete 0 1
+ $itk_component(time) insert 0 $char
+
+ #
+ # if the digit is equal to 1, then
+ # the second hour digit is valid for 0-2
+ #
+ } elseif {$char == 1} {
+ $itk_component(time) delete 0 1
+ $itk_component(time) insert 0 $char
+
+ if {$hour2 > 2} {
+ $itk_component(time) delete 1 2
+ $itk_component(time) insert 1 0
+ set icursor 1
+ }
+
+ #
+ # if the digit is greater than 1, then
+ # set the first hour digit to 0 and the
+ # second hour digit to the value.
+ #
+ } elseif {$char > 1} {
+ $itk_component(time) delete 0 2
+ $itk_component(time) insert 0 "0$char"
+ set icursor 1
+
+ } else {
+ set inValid 1
+ }
+
+ #
+ # The insertion cursor is at the second hour digit, so
+ # it can only be valid if the firs thour digit is 0
+ # or the new digit is less than or equal to 2
+ #
+ } else {
+ if {$hour1 == 0 || $char <= 2} {
+ $itk_component(time) delete 1 2
+ $itk_component(time) insert 1 $char
+ } else {
+ set inValid 1
+ }
+ }
+ }
+
+ if {$inValid} {
+ bell
+ } elseif {$icursor == 1} {
+ _setField minute
+ }
+ }
+
+ minute {
+ if {$itk_option(-iq) == "low" || $char < 6 || $icursor == 4} {
+ $itk_component(time) delete $icursor
+ $itk_component(time) insert $icursor $char
+ } elseif {$itk_option(-iq) == "high"} {
+ if {$char > 5} {
+ $itk_component(time) delete 3 5
+ $itk_component(time) insert 3 "0$char"
+ set icursor 4
+ }
+ }
+
+ if {$icursor == 4} {
+ _setField second
+ }
+ }
+
+ second {
+ if {$itk_option(-iq) == "low" || $char < 6 || $icursor == 7} {
+ $itk_component(time) delete $icursor
+ $itk_component(time) insert $icursor $char
+
+ } elseif {$itk_option(-iq) == "high"} {
+ if {$char > 5} {
+ $itk_component(time) delete 6 8
+ $itk_component(time) insert 6 "0$char"
+ set icursor 7
+ }
+ }
+
+ if {$icursor == 7} {
+ _moveField forward
+ }
+ }
+ }
+
+ return -code break
+ }
+
+ #
+ # Process the plus and the up arrow keys. They both yield the same
+ # effect, they increment the minute by one.
+ #
+ switch $sym {
+ p - P {
+ if {$itk_option(-format) == "civilian"} {
+ $itk_component(time) delete 9 10
+ $itk_component(time) insert 9 P
+ _setField hour
+ }
+ }
+
+ a - A {
+ if {$itk_option(-format) == "civilian"} {
+ $itk_component(time) delete 9 10
+ $itk_component(time) insert 9 A
+ _setField hour
+ }
+ }
+
+ plus - Up {
+ if {$_cfield == "ampm"} {
+ _toggleAmPm
+ } else {
+ set newclicks [::clock scan "$prevtime 1 $_cfield"]
+ set newtime [::clock format $newclicks -format $_formatString]
+ set _timeVar($this) $newtime
+ }
+ return -code continue
+ }
+
+ minus - Down {
+ #
+ # Process the minus and the down arrow keys which decrement the value
+ # of the field in which the cursor is currently positioned.
+ #
+ if {$_cfield == "ampm"} {
+ _toggleAmPm
+ } else {
+ set newclicks [::clock scan "$prevtime 1 $_cfield ago"]
+ set newtime [::clock format $newclicks -format $_formatString]
+ set _timeVar($this) $newtime
+ }
+ return -code continue
+ }
+
+ Tab {
+ #
+ # A tab key moves the "hour:minute:second" field forward by one unless
+ # the current field is the second. In that case we'll let tab
+ # do what is supposed to and pass the focus onto the next widget.
+ #
+ if {$state == 0} {
+
+ if {($itk_option(-format) == "civilian" && $_cfield == $lastField)} {
+ _setField hour
+ return -code continue
+ }
+ _moveField forward
+
+ #
+ # A ctrl-tab key moves the hour:minute:second field backwards by one
+ # unless the current field is the hour. In that case we'll let
+ # tab take the focus to a previous widget.
+ #
+ } elseif {$state == 4} {
+ if {$_cfield == "hour"} {
+ _setField hour
+ return -code continue
+ }
+ _moveField backward
+ }
+ }
+
+ Right {
+ #
+ # A right arrow key moves the insert cursor to the right one.
+ #
+ $_forward
+ }
+
+ Left - BackSpace - Delete {
+ #
+ # A left arrow, backspace, or delete key moves the insert cursor
+ # to the left one. This is what you expect for the left arrow
+ # and since the whole widget always operates in overstrike mode,
+ # it makes the most sense for backspace and delete to do the same.
+ #
+ $_backward
+ }
+
+ Return {
+ #
+ # A Return key invokes the optionally specified command option.
+ #
+ uplevel #0 $itk_option(-command)
+ }
+
+ default {
+
+ }
+ }
+
+ return -code break
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _toggleAmPm
+#
+# Internal method which toggles the displayed time
+# between "AM" and "PM" when format is "civilian".
+# ------------------------------------------------------------------
+body iwidgets::Timefield::_toggleAmPm {} {
+ set firstChar [string index $_timeVar($this) 9]
+ $itk_component(time) delete 9 10
+ $itk_component(time) insert 9 [expr {($firstChar == "A") ? "P" : "A"}]
+ $itk_component(time) icursor 9
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _setField field
+#
+# Adjusts the current field to be that of the argument, setting the
+# insert cursor appropriately.
+# ------------------------------------------------------------------
+body iwidgets::Timefield::_setField {field} {
+
+ # Move the position of the cursor to the first character of the
+ # field given by the argument:
+ #
+ # Field First Character Index
+ # ----- ---------------------
+ # hour 0
+ # minute 3
+ # second 6
+ # ampm 9
+ #
+ switch $field {
+ hour {
+ $itk_component(time) icursor 0
+ }
+ minute {
+ $itk_component(time) icursor 3
+ }
+ second {
+ $itk_component(time) icursor 6
+ }
+ ampm {
+ if {$itk_option(-format) == "military"} {
+ error "bad field: \"$field\", must be hour, minute or second"
+ }
+ $itk_component(time) icursor 9
+ }
+ default {
+ if {$itk_option(-format) == "military"} {
+ error "bad field: \"$field\", must be hour, minute or second"
+ } else {
+ error "bad field: \"$field\", must be hour, minute, second or ampm"
+ }
+ }
+ }
+
+ set _cfield $field
+
+ return $_cfield
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _moveField
+#
+# Moves the cursor one field forward or backward.
+# ------------------------------------------------------------------
+body iwidgets::Timefield::_moveField {direction} {
+
+ # Since the value "_fields" list variable is always either value:
+ # military => {hour minute second}
+ # civilian => {hour minute second ampm}
+ #
+ # the index of the previous or next field index can be determined
+ # by subtracting or adding 1 to current the index, respectively.
+ #
+ set index [lsearch $_fields $_cfield]
+ expr {($direction == "forward") ? [incr index] : [incr index -1]}
+
+ if {$index == $_numFields} {
+ set index 0
+ } elseif {$index < 0} {
+ set index [expr $_numFields-1]
+ }
+
+ _setField [lindex $_fields $index]
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _whichField
+#
+# Returns the current field that the cursor is positioned within.
+# ------------------------------------------------------------------
+body iwidgets::Timefield::_whichField {} {
+
+ # Return the current field based on the position of the cursor.
+ #
+ # Field Index
+ # ----- -----
+ # hour 0,1
+ # minute 3,4
+ # second 6,7
+ # ampm 9,10
+ #
+ set icursor [$itk_component(time) index insert]
+ switch $icursor {
+ 0 - 1 {
+ set _cfield hour
+ }
+ 3 - 4 {
+ set _cfield minute
+ }
+ 6 - 7 {
+ set _cfield second
+ }
+ 9 - 10 {
+ set _cfield ampm
+ }
+ }
+
+ return $_cfield
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _forwardCivilian
+#
+# Internal method which moves the cursor forward by one character
+# jumping over the slashes and wrapping.
+# ------------------------------------------------------------------
+body iwidgets::Timefield::_forwardCivilian {} {
+
+ #
+ # If the insertion cursor is at the second digit
+ # of either the hour, minute or second field, then
+ # move the cursor to the first digit of the right-most field.
+ #
+ # else move the insertion cursor right one character
+ #
+ set icursor [$itk_component(time) index insert]
+ switch $icursor {
+ 1 {
+ _setField minute
+ }
+ 4 {
+ _setField second
+ }
+ 7 {
+ _setField ampm
+ }
+ 9 - 10 {
+ _setField hour
+ }
+ default {
+ $itk_component(time) icursor [expr $icursor+1]
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _forwardMilitary
+#
+# Internal method which moves the cursor forward by one character
+# jumping over the slashes and wrapping.
+# ------------------------------------------------------------------
+body iwidgets::Timefield::_forwardMilitary {} {
+
+ #
+ # If the insertion cursor is at the second digit of either
+ # the hour, minute or second field, then move the cursor to
+ # the first digit of the right-most field.
+ #
+ # else move the insertion cursor right one character
+ #
+ set icursor [$itk_component(time) index insert]
+ switch $icursor {
+ 1 {
+ _setField minute
+ }
+ 4 {
+ _setField second
+ }
+ 7 {
+ _setField hour
+ }
+ default {
+ $itk_component(time) icursor [expr $icursor+1]
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _backwardCivilian
+#
+# Internal method which moves the cursor backward by one character
+# jumping over the ":" and wrapping.
+# ------------------------------------------------------------------
+body iwidgets::Timefield::_backwardCivilian {} {
+
+ #
+ # If the insertion cursor is at the first character
+ # of either the minute or second field or at the ampm
+ # field, then move the cursor to the second character
+ # of the left-most field.
+ #
+ # else if the insertion cursor is at the first digit of the
+ # hour field, then move the cursor to the first character
+ # of the ampm field.
+ #
+ # else move the insertion cursor left one character
+ #
+ set icursor [$itk_component(time) index insert]
+ switch $icursor {
+ 9 {
+ _setField second
+ $itk_component(time) icursor 7
+ }
+ 6 {
+ _setField minute
+ $itk_component(time) icursor 4
+ }
+ 3 {
+ _setField hour
+ $itk_component(time) icursor 1
+ }
+ 0 {
+ _setField ampm
+ $itk_component(time) icursor 9
+ }
+ default {
+ $itk_component(time) icursor [expr $icursor-1]
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _backwardMilitary
+#
+# Internal method which moves the cursor backward by one character
+# jumping over the slashes and wrapping.
+# ------------------------------------------------------------------
+body iwidgets::Timefield::_backwardMilitary {} {
+
+ #
+ # If the insertion cursor is at the first digit of either
+ # the minute or second field, then move the cursor to the
+ # second character of the left-most field.
+ #
+ # else if the insertion cursor is at the first digit of the
+ # hour field, then move the cursor to the second digit
+ # of the second field.
+ #
+ # else move the insertion cursor left one character
+ #
+ set icursor [$itk_component(time) index insert]
+ switch $icursor {
+ 6 {
+ _setField minute
+ $itk_component(time) icursor 4
+ }
+ 3 {
+ _setField hour
+ $itk_component(time) icursor 1
+ }
+ 0 {
+ _setField second
+ $itk_component(time) icursor 7
+ }
+ default {
+ $itk_component(time) icursor [expr $icursor-1]
+ }
+ }
+}
diff --git a/itcl/iwidgets3.0.0/generic/toolbar.itk b/itcl/iwidgets3.0.0/generic/toolbar.itk
new file mode 100644
index 00000000000..22d6cd7ec7b
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/toolbar.itk
@@ -0,0 +1,980 @@
+#
+# Toolbar
+# ----------------------------------------------------------------------
+#
+# The Toolbar command creates a new window (given by the pathName
+# argument) and makes it into a Tool Bar widget. Additional options,
+# described above may be specified on the command line or in the
+# option database to configure aspects of the Toolbar such as its
+# colors, font, and orientation. The Toolbar command returns its
+# pathName argument. At the time this command is invoked, there
+# must not exist a window named pathName, but pathName's parent
+# must exist.
+#
+# A Toolbar is a widget that displays a collection of widgets arranged
+# either in a row or a column (depending on the value of the -orient
+# option). This collection of widgets is usually for user convenience
+# to give access to a set of commands or settings. Any widget may be
+# placed on a Toolbar. However, command or value-oriented widgets (such
+# as button, radiobutton, etc.) are usually the most useful kind of
+# widgets to appear on a Toolbar.
+#
+# WISH LIST:
+# This section lists possible future enhancements.
+#
+# Toggle between text and image/bitmap so that the toolbar could
+# display either all text or all image/bitmaps.
+# Implementation of the -toolbarfile option that allows toolbar
+# add commands to be read in from a file.
+# ----------------------------------------------------------------------
+# AUTHOR: Bill W. Scott EMAIL: bscott@spd.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Default resources.
+#
+option add *Toolbar*padX 5 widgetDefault
+option add *Toolbar*padY 5 widgetDefault
+option add *Toolbar*orient horizontal widgetDefault
+option add *Toolbar*highlightThickness 0 widgetDefault
+option add *Toolbar*indicatorOn false widgetDefault
+option add *Toolbar*selectColor [. cget -bg] widgetDefault
+
+#
+# Usual options.
+#
+itk::usual Toolbar {
+ keep -activebackground -activeforeground -background -balloonbackground \
+ -balloondelay1 -balloondelay2 -balloonfont -balloonforeground \
+ -borderwidth -cursor -disabledforeground -font -foreground \
+ -highlightbackground -highlightcolor -highlightthickness \
+ -insertbackground -insertforeground -selectbackground \
+ -selectborderwidth -selectcolor -selectforeground -troughcolor
+}
+
+# ------------------------------------------------------------------
+# TOOLBAR
+# ------------------------------------------------------------------
+class iwidgets::Toolbar {
+ inherit itk::Widget
+
+ constructor {args} {}
+ destructor {}
+
+ itk_option define -balloonbackground \
+ balloonBackground BalloonBackground yellow
+ itk_option define -balloonforeground \
+ balloonForeground BalloonForeground black
+ itk_option define -balloonfont balloonFont BalloonFont 6x10
+ itk_option define -balloondelay1 \
+ balloonDelay1 BalloonDelay1 1000
+ itk_option define -balloondelay2 \
+ balloonDelay2 BalloonDelay2 200
+ itk_option define -helpvariable helpVariable HelpVariable {}
+ itk_option define -orient orient Orient "horizontal"
+
+ #
+ # The following options implement propogated configurations to
+ # any widget that might be added to us. The problem is this is
+ # not deterministic as someone might add a new kind of widget with
+ # and option like -armbackground, so we would not be aware of
+ # this kind of option. Anyway we support as many of the obvious
+ # ones that we can. They can always configure them with itemconfigures.
+ #
+ itk_option define -activebackground activeBackground Foreground #c3c3c3
+ itk_option define -activeforeground activeForeground Background Black
+ itk_option define -background background Background #d9d9d9
+ itk_option define -borderwidth borderWidth BorderWidth 2
+ itk_option define -cursor cursor Cursor {}
+ itk_option define -disabledforeground \
+ disabledForeground DisabledForeground #a3a3a3
+ itk_option define -font \
+ font Font "-Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*"
+ itk_option define -foreground foreground Foreground #000000000000
+ itk_option define -highlightbackground \
+ highlightBackground HighlightBackground #d9d9d9
+ itk_option define -highlightcolor highlightColor HighlightColor Black
+ itk_option define -highlightthickness \
+ highlightThickness HighlightThickness 0
+ itk_option define -insertforeground insertForeground Background #c3c3c3
+ itk_option define -insertbackground insertBackground Foreground Black
+ itk_option define -selectbackground selectBackground Foreground #c3c3c3
+ itk_option define -selectborderwidth selectBorderWidth BorderWidth {}
+ itk_option define -selectcolor selectColor Background #b03060
+ itk_option define -selectforeground selectForeground Background Black
+ itk_option define -state state State normal
+ itk_option define -troughcolor troughColor Background #c3c3c3
+
+ public method add {widgetCommand name args}
+ public method delete {args}
+ public method index {index}
+ public method insert {beforeIndex widgetCommand name args}
+ public method itemcget {index args}
+ public method itemconfigure {index args}
+
+ public method _resetBalloonTimer {}
+ public method _startBalloonDelay {window}
+ public method _stopBalloonDelay {window balloonClick}
+
+ private method _deleteWidgets {index1 index2}
+ private method _addWidget {widgetCommand name args}
+ private method _index {toolList index}
+ private method _getAttachedOption {optionListName widget args retValue}
+ private method _setAttachedOption {optionListName widget option args}
+ private method _packToolbar {}
+
+ public method hideHelp {}
+ public method showHelp {window}
+ public method showBalloon {window}
+ public method hideBalloon {}
+
+ private variable _balloonTimer 0
+ private variable _balloonAfterID 0
+ private variable _balloonClick false
+
+ private variable _interior {}
+ private variable _initialMapping 1 ;# Is this the first mapping?
+ private variable _toolList {} ;# List of all widgets on toolbar
+ private variable _opts ;# New options for child widgets
+ private variable _currHelpWidget {} ;# Widget currently displaying help for
+ private variable _hintWindow {} ;# Balloon help bubble.
+
+ # list of options we want to propogate to widgets added to toolbar.
+ private common _optionList {
+ -activebackground \
+ -activeforeground \
+ -background \
+ -borderwidth \
+ -cursor \
+ -disabledforeground \
+ -font \
+ -foreground \
+ -highlightbackground \
+ -highlightcolor \
+ -highlightthickness \
+ -insertbackground \
+ -insertforeground \
+ -selectbackground \
+ -selectborderwidth \
+ -selectcolor \
+ -selectforeground \
+ -state \
+ -troughcolor \
+ }
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body iwidgets::Toolbar::constructor {args} {
+ component hull configure -borderwidth 0
+ set _interior $itk_interior
+
+ #
+ # Handle configs
+ #
+ eval itk_initialize $args
+
+ # build balloon help window
+ set _hintWindow [toplevel $itk_component(hull).balloonHintWindow]
+ wm withdraw $_hintWindow
+ label $_hintWindow.label \
+ -foreground $itk_option(-balloonforeground) \
+ -background $itk_option(-balloonbackground) \
+ -font $itk_option(-balloonfont) \
+ -relief raised \
+ -borderwidth 1
+ pack $_hintWindow.label
+
+ # ... Attach help handler to this widget
+ bind toolbar-help-$itk_component(hull) \
+ <Enter> "+[code $this showHelp %W]"
+ bind toolbar-help-$itk_component(hull) \
+ <Leave> "+[code $this hideHelp]"
+
+ # ... Set up Microsoft style balloon help display.
+ set _balloonTimer $itk_option(-balloondelay1)
+ bind $_interior \
+ <Leave> "+[code $this _resetBalloonTimer]"
+ bind toolbar-balloon-$itk_component(hull) \
+ <Enter> "+[code $this _startBalloonDelay %W]"
+ bind toolbar-balloon-$itk_component(hull) \
+ <Leave> "+[code $this _stopBalloonDelay %W false]"
+ bind toolbar-balloon-$itk_component(hull) \
+ <Button-1> "+[code $this _stopBalloonDelay %W true]"
+}
+
+#
+# Provide a lowercase access method for the Toolbar class
+#
+proc ::iwidgets::toolbar {pathName args} {
+ uplevel ::iwidgets::Toolbar $pathName $args
+}
+
+# ------------------------------------------------------------------
+# DESTURCTOR
+# ------------------------------------------------------------------
+body iwidgets::Toolbar::destructor {} {
+ if {$_balloonAfterID != 0} {after cancel $_balloonAfterID}
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION -balloonbackground
+# ------------------------------------------------------------------
+configbody iwidgets::Toolbar::balloonbackground {
+ if { $_hintWindow != {} } {
+ if { $itk_option(-balloonbackground) != {} } {
+ $_hintWindow.label configure \
+ -background $itk_option(-balloonbackground)
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION -balloonforeground
+# ------------------------------------------------------------------
+configbody iwidgets::Toolbar::balloonforeground {
+ if { $_hintWindow != {} } {
+ if { $itk_option(-balloonforeground) != {} } {
+ $_hintWindow.label configure \
+ -foreground $itk_option(-balloonforeground)
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION -balloonfont
+# ------------------------------------------------------------------
+configbody iwidgets::Toolbar::balloonfont {
+ if { $_hintWindow != {} } {
+ if { $itk_option(-balloonfont) != {} } {
+ $_hintWindow.label configure \
+ -font $itk_option(-balloonfont)
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -orient
+#
+# Position buttons either horizontally or vertically.
+# ------------------------------------------------------------------
+configbody iwidgets::Toolbar::orient {
+ switch $itk_option(-orient) {
+ "horizontal" - "vertical" {
+ _packToolbar
+ }
+ default {error "Invalid orientation. Must be either \
+ horizontal or vertical"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# -------------------------------------------------------------
+# METHOD: add widgetCommand name ?option value?
+#
+# Adds a widget with the command widgetCommand whose name is
+# name to the Toolbar. If widgetCommand is radiobutton
+# or checkbutton, its packing is slightly padded to match the
+# geometry of button widgets.
+# -------------------------------------------------------------
+body iwidgets::Toolbar::add { widgetCommand name args } {
+
+ eval "_addWidget $widgetCommand $name $args"
+
+ lappend _toolList $itk_component($name)
+
+ if { $widgetCommand == "radiobutton" || \
+ $widgetCommand == "checkbutton" } {
+ set iPad 1
+ } else {
+ set iPad 0
+ }
+
+ # repack the tool bar
+ _packToolbar
+
+ return $itk_component($name)
+
+}
+
+# -------------------------------------------------------------
+#
+# METHOD: delete index ?index2?
+#
+# This command deletes all components between index and
+# index2 inclusive. If index2 is omitted then it defaults
+# to index. Returns an empty string
+#
+# -------------------------------------------------------------
+body iwidgets::Toolbar::delete { args } {
+ # empty toolbar
+ if { $_toolList == {} } {
+ error "can't delete widget, no widgets in the Toolbar \
+ \"$itk_component(hull)\""
+ }
+
+ set len [llength $args]
+ switch -- $len {
+ 1 {
+ set fromWidget [_index $_toolList [lindex $args 0]]
+
+ if { $fromWidget < 0 || $fromWidget >= [llength $_toolList] } {
+ error "bad Toolbar widget index in delete method: \
+ should be between 0 and [expr [llength $_toolList] - 1]"
+ }
+
+ set toWidget $fromWidget
+ _deleteWidgets $fromWidget $toWidget
+ }
+
+ 2 {
+ set fromWidget [_index $_toolList [lindex $args 0]]
+
+ if { $fromWidget < 0 || $fromWidget >= [llength $_toolList] } {
+ error "bad Toolbar widget index1 in delete method: \
+ should be between 0 and [expr [llength $_toolList] - 1]"
+ }
+
+ set toWidget [_index $_toolList [lindex $args 1]]
+
+ if { $toWidget < 0 || $toWidget >= [llength $_toolList] } {
+ error "bad Toolbar widget index2 in delete method: \
+ should be between 0 and [expr [llength $_toolList] - 1]"
+ }
+
+ if { $fromWidget > $toWidget } {
+ error "bad Toolbar widget index1 in delete method: \
+ index1 is greater than index2"
+ }
+
+ _deleteWidgets $fromWidget $toWidget
+ }
+
+ default {
+ # ... too few/many parameters passed
+ error "wrong # args: should be \
+ \"$itk_component(hull) delete index1 ?index2?\""
+ }
+ }
+
+ return {}
+}
+
+
+# -------------------------------------------------------------
+#
+# METHOD: index index
+#
+# Returns the widget's numerical index for the entry corresponding
+# to index. If index is not found, -1 is returned
+#
+# -------------------------------------------------------------
+body iwidgets::Toolbar::index { index } {
+
+ return [_index $_toolList $index]
+
+}
+
+# -------------------------------------------------------------
+#
+# METHOD: insert beforeIndex widgetCommand name ?option value?
+#
+# Insert a new component named name with the command
+# widgetCommand before the com ponent specified by beforeIndex.
+# If widgetCommand is radiobutton or checkbutton, its packing
+# is slightly padded to match the geometry of button widgets.
+#
+# -------------------------------------------------------------
+body iwidgets::Toolbar::insert { beforeIndex widgetCommand name args } {
+
+ set beforeIndex [_index $_toolList $beforeIndex]
+
+ if {$beforeIndex < 0 || $beforeIndex > [llength $_toolList] } {
+ error "bad toolbar entry index $beforeIndex"
+ }
+
+ eval "_addWidget $widgetCommand $name $args"
+
+ # linsert into list
+ set _toolList [linsert $_toolList $beforeIndex $itk_component($name)]
+
+ # repack the tool bar
+ _packToolbar
+
+ return $itk_component($name)
+
+}
+
+# ----------------------------------------------------------------------
+# METHOD: itemcget index ?option?
+#
+# Returns the value for the option setting of the widget at index $index.
+# index can be numeric or widget name
+#
+# ----------------------------------------------------------------------
+body iwidgets::Toolbar::itemcget { index args} {
+
+ return [lindex [eval itemconfigure $index $args] 4]
+}
+
+# -------------------------------------------------------------
+#
+# METHOD: itemconfigure index ?option? ?value? ?option value...?
+#
+# Query or modify the configuration options of the widget of
+# the Toolbar specified by index. If no option is specified,
+# returns a list describing all of the available options for
+# index (see Tk_ConfigureInfo for information on the format
+# of this list). If option is specified with no value, then
+# the command returns a list describing the one named option
+# (this list will be identical to the corresponding sublist
+# of the value returned if no option is specified). If one
+# or more option-value pairs are specified, then the command
+# modifies the given widget option(s) to have the given
+# value(s); in this case the command returns an empty string.
+# The component type of index determines the valid available options.
+#
+# -------------------------------------------------------------
+body iwidgets::Toolbar::itemconfigure { index args } {
+
+ # Get a numeric index.
+ set index [_index $_toolList $index]
+
+ # Get the tool path
+ set toolPath [lindex $_toolList $index]
+
+ set len [llength $args]
+
+ switch $len {
+ 0 {
+ # show all options
+ # ''''''''''''''''
+
+ # support display of -helpstr and -balloonstr configs
+ set optList [$toolPath configure]
+
+ ## @@@ might want to use _getAttachedOption instead...
+ if { [info exists _opts($toolPath,-helpstr)] } {
+ set value $_opts($toolPath,-helpstr)
+ } else {
+ set value {}
+ }
+ lappend optList [list -helpstr helpStr HelpStr {} $value]
+ if { [info exists _opts($toolPath,-balloonstr)] } {
+ set value $_opts($toolPath,-balloonstr)
+ } else {
+ set value {}
+ }
+ lappend optList [list -balloonstr balloonStr BalloonStr {} $value]
+ return $optList
+ }
+ 1 {
+ # show only option specified
+ # ''''''''''''''''''''''''''
+ # did we satisfy the option get request?
+
+ if { [regexp -- {-helpstr} $args] } {
+ if { [info exists _opts($toolPath,-helpstr)] } {
+ set value $_opts($toolPath,-helpstr)
+ } else {
+ set value {}
+ }
+ return [list -helpstr helpStr HelpStr {} $value]
+ } elseif { [regexp -- {-balloonstr} $args] } {
+ if { [info exists _opts($toolPath,-balloonstr)] } {
+ set value $_opts($toolPath,-balloonstr)
+ } else {
+ set value {}
+ }
+ return [list -balloonstr balloonStr BalloonStr {} $value]
+ } else {
+ return [eval $toolPath configure $args]
+ }
+
+ }
+ default {
+ # ... do a normal configure
+
+ # first screen for all our child options we are adding
+ _setAttachedOption \
+ _opts \
+ $toolPath \
+ "-helpstr" \
+ $args
+
+ _setAttachedOption \
+ _opts \
+ $toolPath \
+ "-balloonstr" \
+ $args
+
+ # with a clean args list do a configure
+
+ # if the stripping process brought us down to no options
+ # to set, then forget the configure of widget.
+ if { [llength $args] != 0 } {
+ return [eval $toolPath configure $args]
+ } else {
+ return ""
+ }
+ }
+ }
+
+}
+
+# -------------------------------------------------------------
+#
+# METHOD: _resetBalloonDelay1
+#
+# Sets the delay that will occur before a balloon could be popped
+# up to balloonDelay1
+#
+# -------------------------------------------------------------
+body iwidgets::Toolbar::_resetBalloonTimer {} {
+ set _balloonTimer $itk_option(-balloondelay1)
+
+ # reset the <1> longer delay
+ set _balloonClick false
+}
+
+# -------------------------------------------------------------
+#
+# METHOD: _startBalloonDelay
+#
+# Starts waiting to pop up a balloon id
+#
+# -------------------------------------------------------------
+body iwidgets::Toolbar::_startBalloonDelay {window} {
+ set _balloonAfterID [after $_balloonTimer [code $this showBalloon $window]]
+}
+
+# -------------------------------------------------------------
+#
+# METHOD: _stopBalloonDelay
+#
+# This method will stop the timer for a balloon popup if one is
+# in progress. If however there is already a balloon window up
+# it will hide the balloon window and set timing to delay 2 stage.
+#
+# -------------------------------------------------------------
+body iwidgets::Toolbar::_stopBalloonDelay { window balloonClick } {
+
+ # If <1> then got a click cancel
+ if { $balloonClick } {
+ set _balloonClick true
+ }
+ if { $_balloonAfterID != 0 } {
+ after cancel $_balloonAfterID
+ set _balloonAfterID 0
+ } else {
+ hideBalloon
+
+ # If this was cancelled with a <1> use longer delay.
+ if { $_balloonClick } {
+ set _balloonTimer $itk_option(-balloondelay1)
+ } else {
+ set _balloonTimer $itk_option(-balloondelay2)
+ }
+ }
+}
+
+# -------------------------------------------------------------
+# PRIVATE METHOD: _addWidget
+#
+# widgetCommand : command to invoke to create the added widget
+# name : name of the new widget to add
+# args : options for the widget create command
+#
+# Looks for -helpstr, -balloonstr and grabs them, strips from
+# args list. Then tries to add a component and keeps based
+# on known type. If it fails, it tries to clean up. Then it
+# binds handlers for helpstatus and balloon help.
+#
+# Returns the path of the widget added.
+#
+# -------------------------------------------------------------
+body iwidgets::Toolbar::_addWidget { widgetCommand name args } {
+
+ # ,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,
+ # Add the widget to the tool bar
+ # '''''''''''''''''''''''''''''''''''''''''''''''''''''
+
+ # ... Strip out and save the -helpstr, -balloonstr options from args
+ # and save it in _opts
+ _setAttachedOption \
+ _opts \
+ $_interior.$name \
+ -helpstr \
+ $args
+
+ _setAttachedOption \
+ _opts \
+ $_interior.$name \
+ -balloonstr \
+ $args
+
+
+ # ... Add the new widget as a component (catch an error if occurs)
+ set createFailed [catch {
+ itk_component add $name {
+ eval $widgetCommand $_interior.$name $args
+ } {
+ }
+ } errMsg]
+
+ # ... Clean up if the create failed, and exit.
+ # The _opts list if it has -helpstr, -balloonstr just entered for
+ # this, it must be cleaned up.
+ if { $createFailed } {
+ # clean up
+ if {![catch {set _opts($_interior.$name,-helpstr)}]} {
+ set lastIndex [\
+ expr [llength \
+ $_opts($_interior.$name,-helpstr) ]-1]
+ lreplace $_opts($_interior.$name,-helpstr) \
+ $lastIndex $lastIndex ""
+ }
+ if {![catch {set _opts($_interior.$name,-balloonstr)}]} {
+ set lastIndex [\
+ expr [llength \
+ $_opts($_interior.$name,-balloonstr) ]-1]
+ lreplace $_opts($_interior.$name,-balloonstr) \
+ $lastIndex $lastIndex ""
+ }
+ error $errMsg
+ }
+
+ # ... Add in dynamic options that apply from the _optionList
+ foreach optionSet [$itk_component($name) configure] {
+ set option [lindex $optionSet 0]
+ if { [lsearch $_optionList $option] != -1 } {
+ itk_option add $name.$option
+ }
+ }
+
+ bindtags $itk_component($name) \
+ [linsert [bindtags $itk_component($name)] end \
+ toolbar-help-$itk_component(hull)]
+ bindtags $itk_component($name) \
+ [linsert [bindtags $itk_component($name)] end \
+ toolbar-balloon-$itk_component(hull)]
+
+ return $itk_component($name)
+}
+
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _deleteWidgets
+#
+# deletes widget range by numerical index numbers.
+#
+# -------------------------------------------------------------
+body iwidgets::Toolbar::_deleteWidgets { index1 index2 } {
+
+ for { set index $index1 } { $index <= $index2 } { incr index } {
+
+ # kill the widget
+ set component [lindex $_toolList $index]
+ destroy $component
+
+ }
+
+ # physically remove the page
+ set _toolList [lreplace $_toolList $index1 $index2]
+
+}
+
+# -------------------------------------------------------------
+# PRIVATE METHOD: _index
+#
+# toolList : list of widget names to search thru if index
+# is non-numeric
+# index : either number, 'end', 'last', or pattern
+#
+# _index takes takes the value $index converts it to
+# a numeric identifier. If the value is not already
+# an integer it looks it up in the $toolList array.
+# If it fails it returns -1
+#
+# -------------------------------------------------------------
+body iwidgets::Toolbar::_index { toolList index } {
+
+ switch -- $index {
+ end - last {
+ set number [expr [llength $toolList] -1]
+ }
+ default {
+ # is it a number already? Then just use the number
+ if { [regexp {^[0-9]+$} $index] } {
+ set number $index
+ # check bounds
+ if { $number < 0 || $number >= [llength $toolList] } {
+ set number -1
+ }
+ # otherwise it is a widget name
+ } else {
+ if { [catch { set itk_component($index) } ] } {
+ set number -1
+ } else {
+ set number [lsearch -exact $toolList \
+ $itk_component($index)]
+ }
+ }
+ }
+ }
+
+ return $number
+}
+
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# STATUS HELP for linking to helpVariable
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# -------------------------------------------------------------
+#
+# PUBLIC METHOD: hideHelp
+#
+# Bound to the <Leave> event on a toolbar widget. This clears the
+# status widget help area and resets the help entry.
+#
+# -------------------------------------------------------------
+body iwidgets::Toolbar::hideHelp {} {
+ if { $itk_option(-helpvariable) != {} } {
+ upvar #0 $itk_option(-helpvariable) helpvar
+ set helpvar {}
+ }
+ set _currHelpWidget {}
+}
+
+# -------------------------------------------------------------
+#
+# PUBLIC METHOD: showHelp
+#
+# Bound to the <Motion> event on a tool bar widget. This puts the
+# help string associated with the tool bar widget into the
+# status widget help area. If no help exists for the current
+# entry, the status widget is cleared.
+#
+# -------------------------------------------------------------
+body iwidgets::Toolbar::showHelp { window } {
+
+ set widgetPath $window
+ # already on this item?
+ if { $window == $_currHelpWidget } {
+ return
+ }
+
+ set _currHelpWidget $window
+
+ # Do we have a helpvariable set on the toolbar?
+ if { $itk_option(-helpvariable) != {} } {
+ upvar #0 $itk_option(-helpvariable) helpvar
+
+ # is the -helpstr set for this widget?
+ set args "-helpstr"
+ if {[_getAttachedOption _opts \
+ $window args value]} {
+ set helpvar $value.
+ } else {
+ set helpvar {}
+ }
+ }
+}
+
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# BALLOON HELP for show/hide of hint window
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# -------------------------------------------------------------
+#
+# PUBLIC METHOD: showBalloon
+#
+# -------------------------------------------------------------
+body iwidgets::Toolbar::showBalloon {window} {
+ set _balloonClick false
+ set _balloonAfterID 0
+ # Are we still inside the window?
+ set mouseWindow \
+ [winfo containing [winfo pointerx .] [winfo pointery .]]
+
+ if { [string match $window* $mouseWindow] } {
+ # set up the balloonString
+ set args "-balloonstr"
+ if {[_getAttachedOption _opts \
+ $window args hintStr]} {
+ # configure the balloon help
+ $_hintWindow.label configure -text $hintStr
+
+ # Coordinates of the balloon
+ set balloonLeft \
+ [expr [winfo rootx $window] + round(([winfo width $window]/2.0))]
+ set balloonTop \
+ [expr [winfo rooty $window] + [winfo height $window]]
+
+ # put up balloon window
+ wm overrideredirect $_hintWindow 0
+ wm geometry $_hintWindow "+$balloonLeft+$balloonTop"
+ wm overrideredirect $_hintWindow 1
+ wm deiconify $_hintWindow
+ raise $_hintWindow
+ } else {
+ #NO BALLOON HELP AVAILABLE
+ }
+ } else {
+ #NOT IN BUTTON
+ }
+
+}
+
+# -------------------------------------------------------------
+#
+# PUBLIC METHOD: hideBalloon
+#
+# -------------------------------------------------------------
+body iwidgets::Toolbar::hideBalloon {} {
+ wm withdraw $_hintWindow
+}
+
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# OPTION MANAGEMENT for -helpstr, -balloonstr
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# -------------------------------------------------------------
+# PRIVATE METHOD: _getAttachedOption
+#
+# optionListName : the name of the array that holds all attached
+# options. It is indexed via widget,option to get
+# the value.
+# widget : the widget that the option is associated with
+# option : the option whose value we are looking for on
+# this widget.
+#
+# expects to be called only if the $option is length 1
+# -------------------------------------------------------------
+body iwidgets::Toolbar::_getAttachedOption { optionListName widget args retValue} {
+
+ # get a reference to the option, so we can change it.
+ upvar $args argsRef
+ upvar $retValue retValueRef
+
+ set success false
+
+ if { ![catch { set retValueRef \
+ [eval set [subst [set optionListName]]($widget,$argsRef)]}]} {
+
+ # remove the option argument
+ set success true
+ set argsRef ""
+ }
+
+ return $success
+}
+
+# -------------------------------------------------------------
+# PRIVATE METHOD: _setAttachedOption
+#
+# This method allows us to attach new options to a widget. It
+# catches the 'option' to be attached, strips it out of 'args'
+# attaches it to the 'widget' by stuffing the value into
+# 'optionList(widget,option)'
+#
+# optionListName: where to store the option and widget association
+# widget: is the widget we want to associate the attached option
+# option: is the attached option (unknown to this widget)
+# args: the arg list to search and remove the option from (if found)
+#
+# Modifies the args parameter.
+# Returns boolean indicating the success of the method
+#
+# -------------------------------------------------------------
+body iwidgets::Toolbar::_setAttachedOption {optionListName widget option args} {
+
+ upvar args argsRef
+
+ set success false
+
+ # check for 'option' in the 'args' list for the 'widget'
+ set optPos [eval lsearch $args $option]
+
+ # ... found it
+ if { $optPos != -1 } {
+ # grab a copy of the option from arg list
+ set [subst [set optionListName]]($widget,$option) \
+ [eval lindex $args [expr $optPos + 1]]
+
+ # remove the option argument and value from the arg list
+ set argsRef [eval lreplace $args $optPos [expr $optPos + 1]]
+ set success true
+ }
+ # ... if not found, will leave args alone
+
+ return $success
+}
+
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# GEOMETRY MANAGEMENT for tool widgets
+# ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+# -------------------------------------------------------------
+#
+# PRIVATE METHOD: _packToolbar
+#
+#
+#
+# -------------------------------------------------------------
+body iwidgets::Toolbar::_packToolbar {} {
+
+ # forget the previous locations
+ foreach tool $_toolList {
+ pack forget $tool
+ }
+
+ # pack in order of _toolList.
+ foreach tool $_toolList {
+ # adjust for radios and checks to match buttons
+ if { [winfo class $tool] == "Radiobutton" ||
+ [winfo class $tool] == "Checkbutton" } {
+ set iPad 1
+ } else {
+ set iPad 0
+ }
+
+ # pack by horizontal or vertical orientation
+ if {$itk_option(-orient) == "horizontal" } {
+ pack $tool -side left -fill y \
+ -ipadx $iPad -ipady $iPad
+ } else {
+ pack $tool -side top -fill x \
+ -ipadx $iPad -ipady $iPad
+ }
+ }
+}
diff --git a/itcl/iwidgets3.0.0/generic/unknownimage.gif b/itcl/iwidgets3.0.0/generic/unknownimage.gif
new file mode 100644
index 00000000000..d000bf70258
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/unknownimage.gif
Binary files differ
diff --git a/itcl/iwidgets3.0.0/generic/watch.itk b/itcl/iwidgets3.0.0/generic/watch.itk
new file mode 100755
index 00000000000..afd90a3ee91
--- /dev/null
+++ b/itcl/iwidgets3.0.0/generic/watch.itk
@@ -0,0 +1,626 @@
+#
+# Watch
+# ----------------------------------------------------------------------
+# Implements a a clock widget in a canvas.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: John A. Tucker EMAIL: jatucker@spd.dsccc.com
+#
+# ======================================================================
+# Copyright (c) 1997 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Default resources.
+#
+option add *Watch.labelFont \
+ -*-Courier-Medium-R-Normal--*-120-*-*-*-*-*-* widgetDefault
+
+#
+# Usual options.
+#
+itk::usual Watch {
+ keep -background -cursor -labelfont -foreground
+}
+
+class iwidgets::Watch {
+
+ inherit itk::Widget
+
+ itk_option define -hourradius hourRadius Radius .50
+ itk_option define -hourcolor hourColor Color red
+
+ itk_option define -minuteradius minuteRadius Radius .80
+ itk_option define -minutecolor minuteColor Color yellow
+
+ itk_option define -pivotradius pivotRadius Radius .10
+ itk_option define -pivotcolor pivotColor Color white
+
+ itk_option define -secondradius secondRadius Radius .90
+ itk_option define -secondcolor secondColor Color black
+
+ itk_option define -clockcolor clockColor Color white
+ itk_option define -clockstipple clockStipple ClockStipple {}
+
+ itk_option define -state state State normal
+ itk_option define -showampm showAmPm ShowAmPm true
+
+ itk_option define -tickcolor tickColor Color black
+
+ constructor {args} {}
+ destructor {}
+
+ #
+ # Public methods
+ #
+ public {
+ method get {{format "-string"}}
+ method show {{time "now"}}
+ method watch {args}
+ }
+
+ #
+ # Private methods
+ #
+ private {
+ method _handMotionCB {tag x y}
+ method _drawHand {tag}
+ method _handReleaseCB {tag x y}
+ method _displayClock {{when "later"}}
+
+ variable _interior
+ variable _radius
+ variable _theta
+ variable _extent
+ variable _reposition "" ;# non-null => _displayClock pending
+ variable _timeVar
+ variable _x0 1
+ variable _y0 1
+
+ common _ampmVar
+ common PI [expr 2*asin(1.0)]
+ }
+}
+
+#
+# Provide a lowercased access method for the Watch class.
+#
+proc ::iwidgets::watch {pathName args} {
+ uplevel ::iwidgets::Watch $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *Watch.width 155 widgetDefault
+option add *Watch.height 175 widgetDefault
+
+# -----------------------------------------------------------------------------
+# CONSTRUCTOR
+# -----------------------------------------------------------------------------
+body iwidgets::Watch::constructor { args } {
+ #
+ # Add back to the hull width and height options and make the
+ # borderwidth zero since we don't need it.
+ #
+ set _interior $itk_interior
+
+ itk_option add hull.width hull.height
+ component hull configure -borderwidth 0
+ grid propagate $itk_component(hull) no
+
+ set _ampmVar($this) "AM"
+ set _radius(outer) 1
+
+ set _radius(hour) 1
+ set _radius(minute) 1
+ set _radius(second) 1
+
+ set _theta(hour) 30
+ set _theta(minute) 6
+ set _theta(second) 6
+
+ set _extent(hour) 14
+ set _extent(minute) 14
+ set _extent(second) 2
+
+ set _timeVar(hour) 12
+ set _timeVar(minute) 0
+ set _timeVar(second) 0
+
+ #
+ # Create the frame in which the "AM" and "PM" radiobuttons will be drawn
+ #
+ itk_component add frame {
+ frame $itk_interior.frame
+ }
+
+ #
+ # Create the canvas in which the clock will be drawn
+ #
+ itk_component add canvas {
+ canvas $itk_interior.canvas
+ }
+ bind $itk_component(canvas) <Map> +[code $this _displayClock]
+ bind $itk_component(canvas) <Configure> +[code $this _displayClock]
+
+ #
+ # Create the "AM" and "PM" radiobuttons to be drawn in the canvas
+ #
+ itk_component add am {
+ radiobutton $itk_component(frame).am \
+ -text "AM" \
+ -value "AM" \
+ -variable [scope _ampmVar($this)]
+ } {
+ usual
+ rename -font -labelfont labelFont Font
+ }
+
+ itk_component add pm {
+ radiobutton $itk_component(frame).pm \
+ -text "PM" \
+ -value "PM" \
+ -variable [scope _ampmVar($this)]
+ } {
+ usual
+ rename -font -labelfont labelFont Font
+ }
+
+ #
+ # Create the canvas item for displaying the main oval which encapsulates
+ # the entire clock.
+ #
+ watch create oval 0 0 2 2 -width 5 -tags clock
+
+ #
+ # Create the canvas items for displaying the 60 ticks marks around the
+ # inner perimeter of the watch.
+ #
+ set extent 3
+ for {set i 0} {$i < 60} {incr i} {
+ set start [expr $i*6-1]
+ set tag [expr {[expr $i%5] == 0 ? "big" : "little"}]
+ watch create arc 0 0 0 0 \
+ -style arc \
+ -extent $extent \
+ -start $start \
+ -tags "tick$i tick $tag"
+ }
+
+ #
+ # Create the canvas items for displaying the hour, minute, and second hands
+ # of the watch. Add bindings to allow the mouse to move and set the
+ # clock hands.
+ #
+ watch create arc 1 1 1 1 -extent 30 -tags minute
+ watch create arc 1 1 1 1 -extent 30 -tags hour
+ watch create arc 1 1 1 1 -tags second
+
+ #
+ # Create the canvas item for displaying the center of the watch in which
+ # the hour, minute, and second hands will pivot.
+ #
+ watch create oval 0 0 1 1 -width 5 -fill black -tags pivot
+
+ #
+ # Position the "AM/PM" button frame and watch canvas.
+ #
+ grid $itk_component(frame) -row 0 -column 0 -sticky new
+ grid $itk_component(canvas) -row 1 -column 0 -sticky nsew
+
+ grid rowconfigure $itk_interior 0 -weight 0
+ grid rowconfigure $itk_interior 1 -weight 1
+ grid columnconfigure $itk_interior 0 -weight 1
+
+ eval itk_initialize $args
+}
+
+# -----------------------------------------------------------------------------
+# DESTURCTOR
+# -----------------------------------------------------------------------------
+body iwidgets::Watch::destructor {} {
+ if {$_reposition != ""} {
+ after cancel $_reposition
+ }
+}
+
+# -----------------------------------------------------------------------------
+# METHODS
+# -----------------------------------------------------------------------------
+
+# -----------------------------------------------------------------------------
+# METHOD: _handReleaseCB tag x y
+#
+# -----------------------------------------------------------------------------
+body iwidgets::Watch::_handReleaseCB {tag x y} {
+
+ set atanab [expr atan2(double($y-$_y0),double($x-$_x0))*(180/$PI)]
+ set degrees [expr {$atanab > 0 ? [expr 360-$atanab] : abs($atanab)}]
+ set ticks [expr round($degrees/$_theta($tag))]
+ set _timeVar($tag) [expr ((450-$ticks*$_theta($tag))%360)/$_theta($tag)]
+
+ if {$tag == "hour" && $_timeVar(hour) == 0} {
+ set _timeVar($tag) 12
+ }
+
+ _drawHand $tag
+}
+
+# -----------------------------------------------------------------------------
+# PROTECTED METHOD: _handMotionCB tag x y
+#
+# -----------------------------------------------------------------------------
+body iwidgets::Watch::_handMotionCB {tag x y} {
+ if {$x == $_x0 || $y == $_y0} {
+ return
+ }
+
+ set a [expr $y-$_y0]
+ set b [expr $x-$_x0]
+ set c [expr hypot($a,$b)]
+
+ set atanab [expr atan2(double($a),double($b))*(180/$PI)]
+ set degrees [expr {$atanab > 0 ? [expr 360-$atanab] : abs($atanab)}]
+
+ set x2 [expr $_x0+$_radius($tag)*($b/double($c))]
+ set y2 [expr $_y0+$_radius($tag)*($a/double($c))]
+ watch coords $tag \
+ [expr $x2-$_radius($tag)] \
+ [expr $y2-$_radius($tag)] \
+ [expr $x2+$_radius($tag)] \
+ [expr $y2+$_radius($tag)]
+ set start [expr $degrees-180-($_extent($tag)/2)]
+ watch itemconfigure $tag -start $start -extent $_extent($tag)
+}
+
+# -----------------------------------------------------------------------------
+# PROTECTED METHOD: get ?format?
+#
+# -----------------------------------------------------------------------------
+body iwidgets::Watch::get {{format "-string"}} {
+ set timestr [format "%02d:%02d:%02d %s" \
+ $_timeVar(hour) $_timeVar(minute) \
+ $_timeVar(second) $_ampmVar($this)]
+
+ switch -- $format {
+ "-string" {
+ return $timestr
+ }
+ "-clicks" {
+ return [clock scan $timestr]
+ }
+ default {
+ error "bad format option \"$format\":\
+ should be -string or -clicks"
+ }
+ }
+}
+
+# -----------------------------------------------------------------------------
+# METHOD: watch ?args?
+#
+# Evaluates the specified args against the canvas component.
+# -----------------------------------------------------------------------------
+body iwidgets::Watch::watch {args} {
+ return [eval $itk_component(canvas) $args]
+}
+
+# -----------------------------------------------------------------------------
+# METHOD: _drawHand tag
+#
+# -----------------------------------------------------------------------------
+body iwidgets::Watch::_drawHand {tag} {
+
+ set degrees [expr abs(450-($_timeVar($tag)*$_theta($tag)))%360]
+ set radians [expr $degrees*($PI/180)]
+ set x [expr $_x0+$_radius($tag)*cos($radians)]
+ set y [expr $_y0+$_radius($tag)*sin($radians)*(-1)]
+ watch coords $tag \
+ [expr $x-$_radius($tag)] \
+ [expr $y-$_radius($tag)] \
+ [expr $x+$_radius($tag)] \
+ [expr $y+$_radius($tag)]
+ set start [expr $degrees-180-($_extent($tag)/2)]
+ watch itemconfigure $tag -start $start
+}
+
+# ------------------------------------------------------------------
+# PUBLIC METHOD: show time
+#
+# Changes the currently displayed time to be that of the time
+# argument. The time may be specified either as a string or an
+# integer clock value. Reference the clock command for more
+# information on obtaining times and their formats.
+# ------------------------------------------------------------------
+body iwidgets::Watch::show {{time "now"}} {
+ if {$time == "now"} {
+ set seconds [clock seconds]
+ } elseif {![catch {clock format $time}]} {
+ set seconds $time
+ } elseif {[catch {set seconds [clock scan $time]}]} {
+ error "bad time: \"$time\", must be a valid time\
+ string, clock clicks value or the keyword now"
+ }
+
+ set timestring [clock format $seconds -format "%I %M %S %p"]
+ set _timeVar(hour) [expr int(1[lindex $timestring 0] - 100)]
+ set _timeVar(minute) [expr int(1[lindex $timestring 1] - 100)]
+ set _timeVar(second) [expr int(1[lindex $timestring 2] - 100)]
+ set _ampmVar($this) [lindex $timestring 3]
+
+ _drawHand hour
+ _drawHand minute
+ _drawHand second
+}
+
+# -----------------------------------------------------------------------------
+# PROTECTED METHOD: _displayClock ?when?
+#
+# Places the hour, minute, and second dials in the canvas. If "when" is "now",
+# the change is applied immediately. If it is "later" or it is not specified,
+# then the change is applied later, when the application is idle.
+# -----------------------------------------------------------------------------
+body iwidgets::Watch::_displayClock {{when "later"}} {
+
+ if {$when == "later"} {
+ if {$_reposition == ""} {
+ set _reposition [after idle [code $this _displayClock now]]
+ }
+ return
+ }
+
+ #
+ # Compute the center coordinates for the clock based on the
+ # with and height of the canvas.
+ #
+ set width [winfo width $itk_component(canvas)]
+ set height [winfo height $itk_component(canvas)]
+ set _x0 [expr $width/2]
+ set _y0 [expr $height/2]
+
+ #
+ # Set the radius of the watch, pivot, hour, minute and second items.
+ #
+ set _radius(outer) [expr {$_x0 < $_y0 ? $_x0 : $_y0}]
+ set _radius(pivot) [expr $itk_option(-pivotradius)*$_radius(outer)]
+ set _radius(hour) [expr $itk_option(-hourradius)*$_radius(outer)]
+ set _radius(minute) [expr $itk_option(-minuteradius)*$_radius(outer)]
+ set _radius(second) [expr $itk_option(-secondradius)*$_radius(outer)]
+ set outerWidth [watch itemcget clock -width]
+
+ #
+ # Set the coordinates of the clock item
+ #
+ set x1Outer $outerWidth
+ set y1Outer $outerWidth
+ set x2Outer [expr $width-$outerWidth]
+ set y2Outer [expr $height-$outerWidth]
+ watch coords clock $x1Outer $y1Outer $x2Outer $y2Outer
+
+ #
+ # Set the coordinates of the tick items
+ #
+ set offset [expr $outerWidth*2]
+ set x1Tick [expr $x1Outer+$offset]
+ set y1Tick [expr $y1Outer+$offset]
+ set x2Tick [expr $x2Outer-$offset]
+ set y2Tick [expr $y2Outer-$offset]
+ for {set i 0} {$i < 60} {incr i} {
+ watch coords tick$i $x1Tick $y1Tick $x2Tick $y2Tick
+ }
+ set maxTickWidth [expr $_radius(outer)-$_radius(second)+1]
+ set minTickWidth [expr round($maxTickWidth/2)]
+ watch itemconfigure big -width $maxTickWidth
+ watch itemconfigure little -width [expr round($maxTickWidth/2)]
+
+ #
+ # Set the coordinates of the pivot item
+ #
+ set x1Center [expr $_x0-$_radius(pivot)]
+ set y1Center [expr $_y0-$_radius(pivot)]
+ set x2Center [expr $_x0+$_radius(pivot)]
+ set y2Center [expr $_y0+$_radius(pivot)]
+ watch coords pivot $x1Center $y1Center $x2Center $y2Center
+
+ #
+ # Set the coordinates of the hour, minute, and second dial items
+ #
+ watch itemconfigure hour -extent $_extent(hour)
+ _drawHand hour
+
+ watch itemconfigure minute -extent $_extent(minute)
+ _drawHand minute
+
+ watch itemconfigure second -extent $_extent(second)
+ _drawHand second
+
+ set _reposition ""
+}
+
+# -----------------------------------------------------------------------------
+# OPTIONS
+# -----------------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: state
+#
+# Configure the editable state of the widget. Valid values are
+# normal and disabled. In a disabled state, the hands of the
+# watch are not selectabled.
+# ------------------------------------------------------------------
+configbody ::iwidgets::Watch::state {
+ if {$itk_option(-state) == "normal"} {
+ watch bind minute <B1-Motion> \
+ [code $this _handMotionCB minute %x %y]
+ watch bind minute <ButtonRelease-1> \
+ [code $this _handReleaseCB minute %x %y]
+
+ watch bind hour <B1-Motion> \
+ [code $this _handMotionCB hour %x %y]
+ watch bind hour <ButtonRelease-1> \
+ [code $this _handReleaseCB hour %x %y]
+
+ watch bind second <B1-Motion> \
+ [code $this _handMotionCB second %x %y]
+ watch bind second <ButtonRelease-1> \
+ [code $this _handReleaseCB second %x %y]
+
+ $itk_component(am) configure -state normal
+ $itk_component(pm) configure -state normal
+
+ } elseif {$itk_option(-state) == "disabled"} {
+ watch bind minute <B1-Motion> {}
+ watch bind minute <ButtonRelease-1> {}
+
+ watch bind hour <B1-Motion> {}
+ watch bind hour <ButtonRelease-1> {}
+
+ watch bind second <B1-Motion> {}
+ watch bind second <ButtonRelease-1> {}
+
+ $itk_component(am) configure -state disabled \
+ -disabledforeground [$itk_component(am) cget -background]
+ $itk_component(pm) configure -state normal \
+ -disabledforeground [$itk_component(am) cget -background]
+
+ } else {
+ error "bad state option \"$itk_option(-state)\":\
+ should be normal or disabled"
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: showampm
+#
+# Configure the display of the AM/PM radio buttons.
+# ------------------------------------------------------------------
+configbody ::iwidgets::Watch::showampm {
+ switch -- $itk_option(-showampm) {
+ 0 - no - false - off {
+ pack forget $itk_component(am)
+ pack forget $itk_component(pm)
+ }
+
+ 1 - yes - true - on {
+ pack $itk_component(am) -side left -fill both -expand 1
+ pack $itk_component(pm) -side right -fill both -expand 1
+ }
+
+ default {
+ error "bad showampm option \"$itk_option(-showampm)\":\
+ should be boolean"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: pivotcolor
+#
+# Configure the color of the clock pivot.
+#
+configbody ::iwidgets::Watch::pivotcolor {
+ watch itemconfigure pivot -fill $itk_option(-pivotcolor)
+}
+
+# ------------------------------------------------------------------
+# OPTION: clockstipple
+#
+# Configure the stipple pattern for the clock fill color.
+#
+configbody ::iwidgets::Watch::clockstipple {
+ watch itemconfigure clock -stipple $itk_option(-clockstipple)
+}
+
+# ------------------------------------------------------------------
+# OPTION: clockcolor
+#
+# Configure the color of the clock.
+#
+configbody ::iwidgets::Watch::clockcolor {
+ watch itemconfigure clock -fill $itk_option(-clockcolor)
+}
+
+# ------------------------------------------------------------------
+# OPTION: hourcolor
+#
+# Configure the color of the hour hand.
+#
+configbody ::iwidgets::Watch::hourcolor {
+ watch itemconfigure hour -fill $itk_option(-hourcolor)
+}
+
+# ------------------------------------------------------------------
+# OPTION: minutecolor
+#
+# Configure the color of the minute hand.
+#
+configbody ::iwidgets::Watch::minutecolor {
+ watch itemconfigure minute -fill $itk_option(-minutecolor)
+}
+
+# ------------------------------------------------------------------
+# OPTION: secondcolor
+#
+# Configure the color of the second hand.
+#
+configbody ::iwidgets::Watch::secondcolor {
+ watch itemconfigure second -fill $itk_option(-secondcolor)
+}
+
+# ------------------------------------------------------------------
+# OPTION: tickcolor
+#
+# Configure the color of the ticks.
+#
+configbody ::iwidgets::Watch::tickcolor {
+ watch itemconfigure tick -fill $itk_option(-tickcolor)
+}
+
+# ------------------------------------------------------------------
+# OPTION: hourradius
+#
+# Configure the radius of the hour hand.
+#
+configbody ::iwidgets::Watch::hourradius {
+ _displayClock
+}
+
+# ------------------------------------------------------------------
+# OPTION: minuteradius
+#
+# Configure the radius of the minute hand.
+#
+configbody ::iwidgets::Watch::minuteradius {
+ _displayClock
+}
+
+# ------------------------------------------------------------------
+# OPTION: secondradius
+#
+# Configure the radius of the second hand.
+#
+configbody ::iwidgets::Watch::secondradius {
+ _displayClock
+}
+
diff --git a/itcl/iwidgets3.0.0/incoming/README b/itcl/iwidgets3.0.0/incoming/README
new file mode 100644
index 00000000000..ed0a472a761
--- /dev/null
+++ b/itcl/iwidgets3.0.0/incoming/README
@@ -0,0 +1,21 @@
+==========================================================================
+ ------------------ [incr Widgets] Incoming Widgets ---------------------
+==========================================================================
+
+ This directory contains mega-widgets which should be considered beta
+versions at best. They will still have doc, test, and demos, but should
+be considered experimental. We're looking for positive or negative
+feedback concerning their usefullness. Should enough of a positive
+response be felt, then it shall be moved up. Otherwise, they will find
+themseleves in the outgoing directory and later in /dev/null. Please
+see the source code to respond to the correct author of any mega-widgets
+found here.
+
+NEW WIDGETS
+---------------------------------------------------------------------------
+>> Menubar Author: Bill Scott Email: bscott@spd.dsccc.com
+
+ The menubar class attempts to simplify the syntax of menubar construction
+by providing a grammar and set of commands for menubar creation. The question
+is whether its use does actually make menubars easier to produce and also
+manage.
diff --git a/itcl/iwidgets3.0.0/incoming/doc/man.macros b/itcl/iwidgets3.0.0/incoming/doc/man.macros
new file mode 100644
index 00000000000..c575ce6befa
--- /dev/null
+++ b/itcl/iwidgets3.0.0/incoming/doc/man.macros
@@ -0,0 +1,186 @@
+'\" The definitions below are for supplemental macros used in Tcl/Tk
+'\" manual entries.
+'\"
+'\" .HS name section [date [version]]
+'\" Replacement for .TH in other man pages. See below for valid
+'\" section names.
+'\"
+'\" .AP type name in/out [indent]
+'\" Start paragraph describing an argument to a library procedure.
+'\" type is type of argument (int, etc.), in/out is either "in", "out",
+'\" or "in/out" to describe whether procedure reads or modifies arg,
+'\" and indent is equivalent to second arg of .IP (shouldn't ever be
+'\" needed; use .AS below instead)
+'\"
+'\" .AS [type [name]]
+'\" Give maximum sizes of arguments for setting tab stops. Type and
+'\" name are examples of largest possible arguments that will be passed
+'\" to .AP later. If args are omitted, default tab stops are used.
+'\"
+'\" .BS
+'\" Start box enclosure. From here until next .BE, everything will be
+'\" enclosed in one large box.
+'\"
+'\" .BE
+'\" End of box enclosure.
+'\"
+'\" .VS
+'\" Begin vertical sidebar, for use in marking newly-changed parts
+'\" of man pages.
+'\"
+'\" .VE
+'\" End of vertical sidebar.
+'\"
+'\" .DS
+'\" Begin an indented unfilled display.
+'\"
+'\" .DE
+'\" End of indented unfilled display.
+'\"
+'\" @(#) man.macros 1.1 94/08/09 13:07:19
+.\"
+'\" # Heading for Tcl/Tk man pages
+.de HS
+.ds ^3 \\0
+.if !"\\$3"" .ds ^3 \\$3
+.if '\\$2'cmds' .TH "\\$1" 1 "\\*(^3" "\\$4" "\\$5"
+.if '\\$2'lib' .TH "\\$1" 3 "\\*(^3" "\\$4" "\\$5"
+.if '\\$2'ncmds' .TH "\\$1" n "\\*(^3" "\\$4" "\\$5"
+.if '\\$2'tcl' .TH "\\$1" n "\\*(^3" Tcl "Tcl Built-In Commands"
+.if '\\$2'tk' .TH "\\$1" n "\\*(^3" Tk "Tk Commands"
+.if '\\$2'tclc' .TH "\\$1" 3 "\\*(^3" Tcl "Tcl Library Procedures"
+.if '\\$2'tkc' .TH "\\$1" 3 "\\*(^3" Tk "Tk Library Procedures"
+.if '\\$2'tclcmds' .TH "\\$1" 1 "\\*(^3" Tk "Tcl Applications"
+.if '\\$2'tkcmds' .TH "\\$1" 1 "\\*(^3" Tk "Tk Applications"
+.if '\\$2'iwid' .TH "\\$1" 1 "\\*(^3" Tk "[incr Widgets]"
+.if t .wh -1.3i ^B
+.nr ^l \\n(.l
+.ad b
+..
+'\" # Start an argument description
+.de AP
+.ie !"\\$4"" .TP \\$4
+.el \{\
+. ie !"\\$2"" .TP \\n()Cu
+. el .TP 15
+.\}
+.ie !"\\$3"" \{\
+.ta \\n()Au \\n()Bu
+\&\\$1 \\fI\\$2\\fP (\\$3)
+.\".b
+.\}
+.el \{\
+.br
+.ie !"\\$2"" \{\
+\&\\$1 \\fI\\$2\\fP
+.\}
+.el \{\
+\&\\fI\\$1\\fP
+.\}
+.\}
+..
+'\" # define tabbing values for .AP
+.de AS
+.nr )A 10n
+.if !"\\$1"" .nr )A \\w'\\$1'u+3n
+.nr )B \\n()Au+15n
+.\"
+.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n
+.nr )C \\n()Bu+\\w'(in/out)'u+2n
+..
+'\" # BS - start boxed text
+'\" # ^y = starting y location
+'\" # ^b = 1
+.de BS
+.br
+.mk ^y
+.nr ^b 1u
+.if n .nf
+.if n .ti 0
+.if n \l'\\n(.lu\(ul'
+.if n .fi
+..
+'\" # BE - end boxed text (draw box now)
+.de BE
+.nf
+.ti 0
+.mk ^t
+.ie n \l'\\n(^lu\(ul'
+.el \{\
+.\" Draw four-sided box normally, but don't draw top of
+.\" box if the box started on an earlier page.
+.ie !\\n(^b-1 \{\
+\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.el \}\
+\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.\}
+.fi
+.br
+.nr ^b 0
+..
+'\" # VS - start vertical sidebar
+'\" # ^Y = starting y location
+'\" # ^v = 1 (for troff; for nroff this doesn't matter)
+.de VS
+.mk ^Y
+.ie n 'mc \s12\(br\s0
+.el .nr ^v 1u
+..
+'\" # VE - end of vertical sidebar
+.de VE
+.ie n 'mc
+.el \{\
+.ev 2
+.nf
+.ti 0
+.mk ^t
+\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n'
+.sp -1
+.fi
+.ev
+.\}
+.nr ^v 0
+..
+'\" # Special macro to handle page bottom: finish off current
+'\" # box/sidebar if in box/sidebar mode, then invoked standard
+'\" # page bottom macro.
+.de ^B
+.ev 2
+'ti 0
+'nf
+.mk ^t
+.if \\n(^b \{\
+.\" Draw three-sided box if this is the box's first page,
+.\" draw two sides but no top otherwise.
+.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.\}
+.if \\n(^v \{\
+.nr ^x \\n(^tu+1v-\\n(^Yu
+\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c
+.\}
+.bp
+'fi
+.ev
+.if \\n(^b \{\
+.mk ^y
+.nr ^b 2
+.\}
+.if \\n(^v \{\
+.mk ^Y
+.\}
+..
+'\" # DS - begin display
+.de DS
+.RS
+.nf
+.sp
+..
+'\" # DE - end display
+.de DE
+.fi
+.RE
+.sp
+..
diff --git a/itcl/iwidgets3.0.0/incoming/tests/all b/itcl/iwidgets3.0.0/incoming/tests/all
new file mode 100644
index 00000000000..44941032e90
--- /dev/null
+++ b/itcl/iwidgets3.0.0/incoming/tests/all
@@ -0,0 +1,14 @@
+# 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.
+#
+# @(#) all 1.2 94/08/10 15:52:50
+
+foreach i [lsort [glob *.test]] {
+ if [string match l.*.test $i] {
+ # This is an SCCS lock file; ignore it.
+ continue
+ }
+ puts stdout $i
+ source $i
+}
diff --git a/itcl/iwidgets3.0.0/incoming/tests/defs b/itcl/iwidgets3.0.0/incoming/tests/defs
new file mode 100644
index 00000000000..4cda24e26a7
--- /dev/null
+++ b/itcl/iwidgets3.0.0/incoming/tests/defs
@@ -0,0 +1,213 @@
+# 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 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) defs 1.7 94/12/17 15:53:52
+
+if ![info exists VERBOSE] {
+ set VERBOSE 0
+}
+if ![info exists DELAY] {
+ set DELAY 0
+}
+if ![info exists TESTS] {
+ set TESTS {}
+}
+
+# Some of the tests don't work on some system configurations due to
+# configuration quirks, not due to Tk problems; in order to prevent
+# false alarms, these tests are only run in the master development
+# directory for Tk. The presence of a file "doAllTests" in this
+# directory is used to indicate that these tests should be run.
+
+set doNonPortableTests [file exists doAllTests]
+
+proc print_verbose {test_name test_description contents_of_test code answer} {
+ puts stdout "\n"
+ puts stdout "==== $test_name $test_description"
+ puts stdout "==== Contents of test case:"
+ puts stdout "$contents_of_test"
+ 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"
+ }
+}
+
+proc test {test_name test_description contents_of_test passing_results} {
+ global VERBOSE
+ global TESTS
+ global DELAY
+ if {[string compare $TESTS ""] != 0} then {
+ set ok 0
+ foreach test $TESTS {
+ if [string match $test $test_name] then {
+ set ok 1
+ break
+ }
+ }
+ if !$ok then return
+ }
+ set code [catch {uplevel $contents_of_test} answer]
+ if {$code != 0} {
+ print_verbose $test_name $test_description $contents_of_test \
+ $code $answer
+ } elseif {[string compare $answer $passing_results] == 0} then {
+ if $VERBOSE then {
+ print_verbose $test_name $test_description $contents_of_test \
+ $code $answer
+ puts stdout "++++ $test_name PASSED"
+ }
+ } else {
+ print_verbose $test_name $test_description $contents_of_test \
+ $code $answer
+ puts stdout "---- Result should have been:"
+ puts stdout "$passing_results"
+ puts stdout "---- $test_name FAILED"
+ }
+ after $DELAY
+}
+
+#
+# Like test, but does reg expr check on the results.
+# Useful when the result must follow a pattern but some exact details
+# are not necessary, like an internal number appended to a frame, etc.
+#
+proc test_pattern {test_name test_description contents_of_test passing_results} {
+ global VERBOSE
+ global TESTS
+ if {[string compare $TESTS ""] != 0} then {
+ set ok 0
+ foreach test $TESTS {
+ if [string match $test $test_name] then {
+ set ok 1
+ break
+ }
+ }
+ if !$ok then return
+ }
+
+ set code [catch {uplevel $contents_of_test} answer]
+
+ if {$code != 0} {
+ print_verbose $test_name $test_description $contents_of_test \
+ $code $answer
+ } elseif {[regexp -- [lindex $passing_results 1] [lindex $answer 1]] == 1 } {
+ if $VERBOSE then {
+ print_verbose $test_name $test_description $contents_of_test \
+ $code $answer
+ puts stdout "++++ $test_name PASSED"
+ }
+ } else {
+ print_verbose $test_name $test_description $contents_of_test \
+ $code $answer
+ puts stdout "---- Result should have been:"
+ puts stdout "$passing_results"
+ puts stdout "**** $test_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
+global argv0
+if {0} {
+puts "file executable $argv0...[file executable $argv0]"
+if { [file executable $argv0] } {
+ if { [string index $argv0 0] == "/" } {
+ set tktest $argv0
+ } else {
+ set tktest "[pwd]/$argv0"
+ }
+} elseif { [file executable ../$argv0] } {
+ set tktest "[pwd]/../$argv0"
+} else {
+ set tktest {}
+ puts "Unable to find tktest executable, skipping multiple process tests."
+}
+} else {set tktest ../tktest}
+
+# Create background process
+proc setupbg {{args ""}} {
+ global tktest fd bgData
+ set fd [open "|$tktest -geometry +0+0 $args" r+]
+ puts $fd "puts foo; flush stdout"
+ flush $fd
+ gets $fd
+ 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 {$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
+ }
+}
diff --git a/itcl/iwidgets3.0.0/license.terms b/itcl/iwidgets3.0.0/license.terms
new file mode 100644
index 00000000000..cc56f996b93
--- /dev/null
+++ b/itcl/iwidgets3.0.0/license.terms
@@ -0,0 +1,31 @@
+This software is copyrighted by DSC Technologies and private individual
+contributors. The copyright holder is specifically listed in the header
+of each file. The following terms apply to all files associated with the
+software unless explicitly disclaimed in individual files by private
+contributors.
+
+Copyright 1997 DSC Technologies Corporation
+
+Permission to use, copy, modify, distribute and license this software and
+its documentation for any purpose, and without fee or written agreement
+with DSC, is hereby granted, provided that the above copyright notice
+appears in all copies and that both the copyright notice and warranty
+disclaimer below appear in supporting documentation, and that the names of
+DSC Technologies Corporation or DSC Communications Corporation not be used
+in advertising or publicity pertaining to the software without specific,
+written prior permission.
+
+DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL
+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-INFRINGEMENT.
+THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND
+DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES,
+ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL DSC BE LIABLE FOR ANY
+SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER
+RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
+CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION, ARISING OUT OF OR IN
+CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+
+RESTRICTED RIGHTS: Use, duplication or disclosure by the government
+is subject to the restrictions as set forth in subparagraph (c) (1) (ii)
+of the Rights in Technical Data and Computer Software Clause as DFARS
+252.227-7013 and FAR 52.227-19.
diff --git a/itcl/iwidgets3.0.0/outgoing/README b/itcl/iwidgets3.0.0/outgoing/README
new file mode 100644
index 00000000000..8440f1af876
--- /dev/null
+++ b/itcl/iwidgets3.0.0/outgoing/README
@@ -0,0 +1,14 @@
+==========================================================================
+ ----------------- [incr Widgets] Outgoing Widgets ---------------------
+==========================================================================
+
+ This directory contains mega-widgets which appear to be failing in
+public acceptance. The negative feedback has out paced the positive.
+They still have doc, test, and demos, but should be considered on their
+way out of the distribution. If you are one of the minority which feels
+differently as to the widgets usefullness, please copy it to a safe location.
+It will not be around long.
+
+LEAVING WIDGETS
+---------------------------------------------------------------------------
+None
diff --git a/itcl/iwidgets3.0.0/tests/all b/itcl/iwidgets3.0.0/tests/all
new file mode 100644
index 00000000000..44941032e90
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/all
@@ -0,0 +1,14 @@
+# 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.
+#
+# @(#) all 1.2 94/08/10 15:52:50
+
+foreach i [lsort [glob *.test]] {
+ if [string match l.*.test $i] {
+ # This is an SCCS lock file; ignore it.
+ continue
+ }
+ puts stdout $i
+ source $i
+}
diff --git a/itcl/iwidgets3.0.0/tests/buttonbox.test b/itcl/iwidgets3.0.0/tests/buttonbox.test
new file mode 100644
index 00000000000..ece1f3b41e5
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/buttonbox.test
@@ -0,0 +1,183 @@
+# This file is a Tcl script to test out [incr Widgets] Buttonbox class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Buttonbox-1.$c {Buttonbox construction} {
+ iwidgets::Buttonbox .bb
+ pack .bb
+ update
+} {}
+
+incr c
+
+#
+# Button additions
+#
+test Buttonbox-1.$c {Buttonbox construction} {
+ .bb add Yes -text Yes
+ update
+ .bb add No -text No
+ update
+ .bb default Yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Buttonbox-2.$o {configuration option} {
+ llength [.bb configure]
+} {14}
+
+incr o
+
+foreach test {
+ {-activebackground #ececec #ececec}
+ {-activeforeground Black Black}
+ {-orient vertical vertical}
+ {-background #d9d9d9 #d9d9d9}
+ {-cursor gumby gumby}
+ {-disabledforeground #a3a3a3 #a3a3a3}
+ {-foreground Black Black}
+ {-highlightcolor Black Black}
+ {-highlightthickness 2 2}
+ {-orient horizontal horizontal}
+ {-padx 10 10}
+ {-pady 10 10}} {
+ set option [lindex $test 0]
+ test Buttonbox-2.$o "configuration options, $option" {
+ .bb configure $option [lindex $test 1]
+ lindex [.bb configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-orient bogus {bad orientation option "bogus", should be either horizontal or vertical}}} {
+ set option [lindex $test 0]
+ test Buttonbox-2.$o "configuration options, $option" {
+ list [catch {.bb configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.bb index 0} {0}}
+ {{.bb index end} {1}}
+ {{.bb index default} {0}}
+ {{.bb index No} {1}}
+ {{.bb index Y*} {0}}
+ {{.bb add Maybe -text Maybe} {}}
+ {{.bb insert 0 Never -text Never} {}}
+ {{.bb default Never} {}}
+ {{.bb hide Yes} {}}
+ {{.bb show Yes } {}}
+ {{.bb hide end} {}}
+ {{.bb show end} {}}
+ {{.bb hide 1} {}}
+ {{.bb show 1} {}}
+ {{.bb hide N*} {}}
+ {{.bb show N*} {}}
+ {{.bb invoke Yes} {}}
+ {{.bb invoke} {}}
+ {{.bb invoke default} {}}
+ {{.bb delete Maybe} {}}
+ {{.bb buttonconfigure Yes -text YES} {}}
+ {{.bb buttonconfigure N* -defaultring no} {}}
+ {{.bb buttonconfigure end -defaultring true} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Buttonbox-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Method tests which fail and produce errors
+#
+foreach test {
+ {{.bb index 12} {Buttonbox index "12" is out of range}}
+ {{.bb index bogus} {bad Buttonbox index "bogus": must be number, end, default, or pattern}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Buttonbox-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Buttonbox-1.$c {Buttonbox destruction} {
+ destroy .bb
+ update
+} {}
+
+incr c
+
+test Buttonbox-1.$c {Buttonbox construction} {
+ iwidgets::buttonbox .bb
+ pack .bb
+ update
+ .bb add Hello -text Hello
+ update
+ .bb insert end GoodBye -text GoodBye
+ update
+ .bb default Hello
+ update
+ .bb default GoodBye
+ update
+} {}
+
+incr c
+
+test Buttonbox-1.$c {Buttonbox destruction} {
+ destroy .bb
+ update
+} {}
+
+incr c
+
+test Buttonbox-1.$c {Buttonbox destruction} {
+ iwidgets::buttonbox .bb
+ pack .bb
+ destroy .bb
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/calendar.test b/itcl/iwidgets3.0.0/tests/calendar.test
new file mode 100644
index 00000000000..1da4a0b2971
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/calendar.test
@@ -0,0 +1,153 @@
+# This file is a Tcl script to test out [incr Widgets] Calendar class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Calendar-1.$c {Calendar construction} {
+ iwidgets::Calendar .cal
+ pack .cal -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Calendar-2.$o {configuration option} {
+ llength [.cal configure]
+} {21}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-buttonforeground green green}
+ {-command {.cal configure -background red} {.cal configure -background red}}
+ {-currentdatefont -*-helvetica-bold-r-normal--*-120-* -*-helvetica-bold-r-normal--*-120-*}
+ {-cursor gumby gumby}
+ {-datefont -*-helvetica-medium-r-normal--*-120-* -*-helvetica-medium-r-normal--*-120-*}
+ {-dayfont -*-helvetica-medium-r-normal--*-120-* -*-helvetica-medium-r-normal--*-120-*}
+ {-days {M T W T F S S} {M T W T F S S}}
+ {-foreground black black}
+ {-height 300 300}
+ {-outline black black}
+ {-selectcolor blue blue}
+ {-selectthickness 2 2}
+ {-startday monday monday}
+ {-titlefont -*-helvetica-bold-r-normal--*-140-* -*-helvetica-bold-r-normal--*-140-*}
+ {-weekdaybackground mistyrose mistyrose}
+ {-weekendbackground white white}
+ {-width 350 350}} {
+ set option [lindex $test 0]
+ test Calendar-2.$o "configuration options, $option" {
+ .cal configure $option [lindex $test 1]
+ lindex [.cal configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-backwardimage bogus {bad image name "bogus": image does not exist}}
+ {-forwardimage bogus {bad image name "bogus": image does not exist}}
+ {-startday bogus {bad startday option "bogus": should be sunday, monday, tuesday, wednesday, thursday, friday, or saturday}}} {
+ set option [lindex $test 0]
+ test Calendar-2.$o "configuration options, $option" {
+ list [catch {.cal configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.cal select 03/03/1960} {}}
+ {{.cal get} {03/03/1960}}
+ {{.cal show 03/03/1960} {}}
+ {{.cal get -string} {03/03/1960}}
+ {{.cal select now} {}}
+ {{.cal show now} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Calendar-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+test Calendar-3.$m "object methods, clock clicks" {
+ set clicks [clock scan "06/08/1964"]
+ .cal show $clicks
+ .cal select $clicks
+ update
+ .cal get
+} {06/08/1964}
+incr m
+
+#
+# Method tests which fail and produce errors
+#
+foreach test {
+ {{.cal get bogus} {bad format option "bogus": should be -string or -clicks}}
+ {{.cal select bogus} {bad date: "bogus", must be a valid date string, clock clicks value or the keyword now}}
+ {{.cal show bogus} {bad date: "bogus", must be a valid date string, clock clicks value or the keyword now}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Calendar-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Calendar-1.$c {Calendar destruction} {
+ destroy .cal
+ update
+} {}
+
+incr c
+
+test Calendar-1.$c {Calendar construction} {
+ iwidgets::calendar .cal
+ pack .cal -padx 10 -pady 10
+ update
+} {}
+
+incr c
+
+test Calendar-1.$c {Calendar destruction} {
+ destroy .cal
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/canvasprintbox.test b/itcl/iwidgets3.0.0/tests/canvasprintbox.test
new file mode 100644
index 00000000000..f19cf952631
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/canvasprintbox.test
@@ -0,0 +1,146 @@
+# This file is a Tcl script to test out [incr Widgets] Canvasprintbox class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 Tako Schotanus
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Canvasprintbox-1.$c {Canvasprintbox construction} {
+ iwidgets::Canvasprintbox .cpb
+ pack .cpb -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Canvasprintbox-2.$o {configuration option} {
+ llength [.cpb configure]
+} {34}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-cursor gumby gumby}
+ {-hpagecnt 2 2}
+ {-orient portrait portrait}
+ {-orient landscape landscape}
+ {-output file file}
+ {-filename test.ps test.ps}
+ {-output printer printer}
+ {-pagesize a5 a5}
+ {-pagesize a4 a4}
+ {-pagesize a3 a3}
+ {-pagesize a2 a2}
+ {-pagesize a1 a1}
+ {-pagesize legal legal}
+ {-pagesize letter letter}
+ {-posterize 1 1}
+ {-posterize 0 0}
+ {-printcmd test test}
+ {-printcmd lpr lpr}
+ {-printregion {10 10 100 100} {10 10 100 100}}
+ {-printregion {} {}}
+ {-stretch 1 1}
+ {-stretch 0 0}
+ {-vpagecnt 2 2}} {
+ set option [lindex $test 0]
+ test Canvasprintbox-2.$o "configuration options, $option" {
+ .cpb configure $option [lindex $test 1]
+ lindex [.cpb configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+#foreach test {
+# {-printregion bogus {bad option "printregion": should contain 4 coordinates}}
+# {-output bogus {bad option "output": should be file or printer}}
+# {-orient bogus {bad option "orient": should be portrait or landscape}}
+# {-stretch bogus {bad option "stretch": should be a boolean}}
+# {-posterize bogus {bad option "posterize": should be a boolean}}
+# } {
+# set option [lindex $test 0]
+# test Canvasprintbox-2.$o "configuration options, $option" {
+# list [catch {.cpb configure $option [lindex $test 1]} msg] $msg
+# } [list 1 [lindex $test 2]]
+# incr o
+#}
+
+#
+# Method tests which are successful.
+#
+canvas .c
+foreach test {
+ {{.cpb getoutput} {lpr}}
+ {{.cpb refresh} {}}
+ {{.cpb setcanvas .c} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Canvasprintbox-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Canvasprintbox-1.$c {Canvasprintbox destruction} {
+ destroy .c
+ destroy .cpb
+ update
+} {}
+
+incr c
+
+test Canvasprintbox-1.$c {Canvasprintbox construction} {
+ iwidgets::canvasprintbox .cpb
+ pack .cpb -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Canvasprintbox-1.$c {Canvasprintbox destruction} {
+ destroy .cpb
+ update
+} {}
+
+incr c
+
+test Canvasprintbox-1.$c {Canvasprintbox destruction} {
+ iwidgets::canvasprintbox .cpb
+ pack .cpb
+ destroy .cpb
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/canvasprintdialog.test b/itcl/iwidgets3.0.0/tests/canvasprintdialog.test
new file mode 100644
index 00000000000..b603f9cc378
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/canvasprintdialog.test
@@ -0,0 +1,165 @@
+# This file is a Tcl script to test out [incr Widgets] Canvasprintdialog
+# class. It is organized in the standard fashion for Tcl tests with the
+# following notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+# 4.x - Other tests
+#
+# Copyright (c) 1995 Tako Schotanus
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Canvasprintdialog-1.$c {Canvasprintdialog construction} {
+ iwidgets::Canvasprintdialog .cpd
+ .cpd activate
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Canvasprintdialog-2.$o {configuration option} {
+ llength [.cpd configure]
+} {28}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-buttonboxpadx 15 15}
+ {-buttonboxpady 15 15}
+ {-buttonboxpos e e}
+ {-buttonboxpos n n}
+ {-buttonboxpos s s}
+ {-buttonboxpos w w}
+ {-cursor gumby gumby}
+ {-filename test.ps test.ps}
+ {-foreground Black Black}
+ {-hpagecnt 2 2}
+ {-modality application application}
+ {-modality global global}
+ {-modality none none}
+ {-orient portrait portrait}
+ {-orient landscape landscape}
+ {-output file file}
+ {-output printer printer}
+ {-padx 15 15}
+ {-pady 15 15}
+ {-pagesize a5 a5}
+ {-pagesize a4 a4}
+ {-pagesize a3 a3}
+ {-pagesize a2 a2}
+ {-pagesize a1 a1}
+ {-pagesize legal legal}
+ {-pagesize letter letter}
+ {-posterize 1 1}
+ {-posterize 0 0}
+ {-printcmd test test}
+ {-printcmd lpr lpr}
+ {-printregion {10 10 100 100} {10 10 100 100}}
+ {-printregion {} {}}
+ {-separator off off}
+ {-separator on on}
+ {-stretch 1 1}
+ {-stretch 0 0}
+ {-thickness 4 4}
+ {-title Test Test}
+ {-vpagecnt 2 2}} {
+ set option [lindex $test 0]
+ test Canvasprintdialog-2.$o "configuration options, $option" {
+ .cpd configure $option [lindex $test 1]
+ lindex [.cpd configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+#foreach test {
+# {-printregion bogus {bad option "printregion": should contain 4 coordinates}}
+# {-output bogus {bad option "output": should be file or printer}}
+# {-orient bogus {bad option "orient": should be portrait or landscape}}
+# {-stretch bogus {bad option "stretch": should be a boolean}}
+# {-posterize bogus {bad option "posterize": should be a boolean}}
+# } {
+# set option [lindex $test 0]
+# test Canvasprintdialog-2.$o "configuration options, $option" {
+# list [catch {.cpd configure $option [lindex $test 1]} msg] $msg
+# } [list 1 [lindex $test 2]]
+# incr o
+#}
+
+#
+# Method tests which are successful.
+#
+canvas .c
+foreach test {
+ {{.cpd getoutput} {lpr}}
+ {{.cpd refresh} {}}
+ {{.cpd setcanvas .c} {}}
+ {{.cpd hide Help} {}}
+ {{.cpd hide Cancel} {}}
+ {{.cpd default Apply} {}}
+ {{.cpd show Cancel} {}}
+ {{.cpd deactivate} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Canvasprintdialog-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Canvasprintdialog-1.$c {Canvasprintdialog destruction} {
+ destroy .c
+ destroy .cpd
+ update
+} {}
+
+incr c
+
+test Canvasprintdialog-1.$c {Canvasprintdialog construction} {
+ iwidgets::Canvasprintdialog .cpd
+ update
+} {}
+
+incr c
+
+test Canvasprintdialog-1.$c {Canvasprintdialog destruction} {
+ destroy .cpd
+ update
+} {}
+
+incr c
+
+test Canvasprintdialog-1.$c {Canvasprintdialog destruction} {
+ iwidgets::Canvasprintdialog .cpd
+ destroy .cpd
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/checkbox.test b/itcl/iwidgets3.0.0/tests/checkbox.test
new file mode 100755
index 00000000000..fcd333385e1
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/checkbox.test
@@ -0,0 +1,145 @@
+# This file is a Tcl script to test out [incr Widgets] Checkbox class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Checkbox-1.$c {Checkbox construction} {
+ iwidgets::Checkbox .cb -labeltext "Styles"
+ pack .cb -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Checkbox-2.$o {configuration option} {
+ llength [.cb configure]
+} {18}
+
+incr o
+
+test Checkbox-1.$c {Checkbox add method} {
+ .cb add foo -text "Foo Bar"
+ .cb add bar -text "Bar Foo"
+ update
+} {}
+
+incr m
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 4 4}
+ {-borderwidth 2 2}
+ {-cursor gumby gumby}
+ {-foreground Green Green}
+ {-foreground Black Black}
+ {-labelmargin 5 5}
+ {-labelpos w w}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos e e}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-labeltext Label Label}
+ {-labeltext Styles Styles}
+ {-labelpos nw nw}
+ {-relief raised raised}
+ {-relief sunken sunken}} {
+ set option [lindex $test 0]
+ test Checkbox-2.$o "configuration options, $option" {
+ .cb configure $option [lindex $test 1]
+ lindex [.cb configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.cb delete foo} {}}
+ {{.cb delete bar} {}}
+ {{.cb add bold -text Bold} bold}
+ {{.cb insert bold italic -text Italic} italic}
+ {{.cb add underline -text Underline} underline}
+ {{.cb insert underline strikethrough -text "Strike Through"} strikethrough}
+ {{.cb index b*} 1}
+ {{.cb select bold} {}}
+ {{.cb get} bold}
+ {{.cb get bold} 1}
+ {{.cb get italic} 0}
+ {{.cb delete end} {}}
+ {{.cb deselect bold} {}}
+ {{.cb get} {}}
+ {{.cb index end} 2}
+ {{.cb flash 1} {}}
+ {{.cb buttonconfigure bold -text BOLD} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Checkbox-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Checkbox-1.$c {Checkbox destruction} {
+ destroy .cb
+ update
+} {}
+
+incr c
+
+test Checkbox-1.$c {Checkbox construction} {
+ iwidgets::checkbox .cb
+ pack .cb -padx 10 -pady 10
+ update
+} {}
+
+incr c
+
+test Checkbox-1.$c {Checkbox destruction} {
+ destroy .cb
+ update
+} {}
+
+incr c
+
+test Checkbox-1.$c {Checkbox destruction} {
+ iwidgets::checkbox .cb
+ pack .cb
+ destroy .cb
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/combobox.test b/itcl/iwidgets3.0.0/tests/combobox.test
new file mode 100644
index 00000000000..273da82f5f0
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/combobox.test
@@ -0,0 +1,297 @@
+# This file is a Tcl script to test out [incr Widgets] Combobox class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 John S. Sigler
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Combobox-1.$c {Combobox construction} {
+ iwidgets::Combobox .cb
+ pack .cb -padx 10 -pady 10 -fill x -expand yes
+ image create bitmap flagup -file $tk_library/demos/images/flagup.bmp
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Combobox-2.$o {configuration option} {
+ llength [.cb configure]
+} {50}
+
+incr o
+
+foreach test {
+ {-listheight 150 150}
+ {-width 20 20}
+ {-textvariable option option}
+ {-labeltext Combobox: Combobox:}
+ {-labelpos nw nw}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos w w}
+ {-labelimage flagup flagup}
+ {-labelpos nw nw}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos w w}
+ {-labelimage {} {}}
+ {-borderwidth 10 10}
+ {-borderwidth 2 2}
+ {-background steelblue steelblue}
+ {-foreground white white}
+ {-background grey85 grey85}
+ {-foreground Black Black}
+ {-textvariable {} {}}
+ {-state disabled disabled}
+ {-state normal normal}
+ {-textvariable option option}
+ {-arrowrelief groove groove}
+ {-arrowrelief flat flat}
+ {-arrowrelief raised raised}
+ {-selectioncommand {doit} {@scope :: doit}}
+ {-selectioncommand {} {}}
+ {-cursor {} {}}
+ {-grab global global}
+ {-grab local local}
+ {-textvariable {} {} }
+ {-dropdown false false}
+ {-dropdown true true}
+ {-textvariable option option}
+ {-editable true true}
+ {-editable false false}
+ {-relief raised raised}
+ {-relief groove groove}
+ {-relief flat flat}
+ {-relief sunken sunken}
+ {-exportselection 1 1}
+ {-exportselection 0 0}
+ {-invalid {catch {blt_bell}} {catch {blt_bell}} }
+ {-labelmargin 2 2}
+ {-labelfont -Adobe-Helvetica-Bold-R-Normal--*-120-* \
+ -Adobe-Helvetica-Bold-R-Normal--*-120-*}
+ {-margin 5 5}
+ {-popupcursor hand1 hand1}
+ {-popupcursor hand2 hand2}
+ {-selectbackground \#b2dfee \#b2dfee}
+ {-selectbackground steelblue steelblue}
+ {-selectborderwidth 1 1}
+ {-selectforeground Black Black}
+ {-textbackground white white}
+ {-textfont 10x20 10x20}
+ {-textfont -Adobe-Helvetica-Medium-R-Normal--*-120-* \
+ -Adobe-Helvetica-Medium-R-Normal--*-120-*}
+ {-textvariable {} {} }
+ {-unique true true}
+ {-validate alpha alpha}
+ {-validate {} {}}
+ {-dropdown false false}
+ {-hscrollmode dynamic static}
+ {-hscrollmode dynamic dynamic}
+ {-vscrollmode dynamic static}
+ {-grab global global}
+ {-vscrollmode dynamic dynamic}
+ {-dropdown true true}} {
+ set option [lindex $test 0]
+ test Combobox-2.$o "configuration options, $option" {
+ .cb configure $option [lindex $test 2]
+ lindex [.cb configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+ }
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-borderwidth bogus {bad screen distance "bogus"}}
+ {-completion bogus {bad completion option "bogus": should be boolean}}
+ {-cursor bogus {bad cursor spec "bogus"}}
+ {-dropdown bogus {bad dropdown option "bogus": should be boolean}}
+ {-editable bogus {bad editable option "bogus": should be boolean}}
+ {-exportselection bogus {expected boolean value but got "bogus"}}
+ {-grab bogus {bad grab value "bogus": must be global or local}}
+ {-listheight bogus {bad screen distance "bogus"}}
+ {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}}
+ {-margin bogus {bad screen distance "bogus"}}
+ {-popupcursor bogus {bad cursor spec "bogus"}}
+ {-selectborderwidth bogus {bad screen distance "bogus"}}
+ {-state bogus {bad state value "bogus": must be normal or disabled}}
+ {-unique bogus {bad unique value "bogus": should be boolean}}
+ {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}}
+ {-width bogus {expected integer but got "bogus"}} } {
+ set option [lindex $test 0]
+ test Combobox-2.$o "configuration options, $option" {
+ list [catch {.cb configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.cb configure -editable 1} {}}
+ {{.cb clear all} {}}
+ {{.cb insert list 0 Test1 Test2 Test3 Test4} {}}
+ {{.cb insert list end {More Test}} {}}
+ {{.cb size} {5}}
+ {{.cb delete list 1} {}}
+ {{.cb delete list 0 2} {}}
+ {{.cb size} {1}}
+ {{.cb get 0} {More Test}}
+ {{.cb selection set end end} {}}
+ {{.cb getcurselection} {More Test}}
+ {{.cb get} {More Test}}
+ {{.cb clear entry} {}}
+ {{.cb get} {}}
+ {{.cb insert entry end "this is a test"} {} }
+ {{.cb get} {this is a test}}
+ {{.cb curselection} {}}
+ {{.cb clear} {}}
+ {{.cb size} {0}}
+ {{.cb getcurselection} {}}
+ {{.cb insert list end {Test1} {Test2} {Really Long String Test}} {}}
+ {{.cb size} {3}}
+ {{.cb get 0} {Test1}}
+ {{.cb insert entry end R} {}}
+ {{.cb getcurselection} {Really Long String Test}}
+ {{.cb get} {Really Long String Test}}
+ {{.cb config -completion off} {}}
+ {{.cb selection clear 0 end} {}}
+ {{.cb insert entry end R} {}}
+ {{.cb get} {R}}
+ {{.cb getcurselection} {}}
+ {{.cb config -completion on} {}}
+ {{.cb get [expr [.cb size]-1]} {Really Long String Test}}
+ {{.cb insert list 0 {Test3} {Test4} {Really Long String Test}} {}}
+ {{.cb size} {6}}
+ {{.cb insert list 1 {Test5} {Test6} {Really Long String Test}} {}}
+ {{.cb size} {9}}
+ {{.cb insert list 5 {Test7} {Test8} {Really Long String Test}} {}}
+ {{.cb size} {12}}
+ {{.cb config -state disabled} {}}
+ {{.cb insert list end {not gonna make it in}} {}}
+ {{.cb size} {12}}
+ {{.cb insert entry end {eally!}} {}}
+ {{.cb get} {R}}
+ {{.cb config -state normal} {}}
+ {{.cb config -dropdown 0} {}}
+ {{.cb size} {12}}
+ {{.cb config -dropdown 1} {}}
+ {{.cb size} {12}}
+ {{.cb see 0} {}}
+ {{.cb see 11} {}}
+ {{.cb get end} {Really Long String Test}}
+ {{.cb selection clear 0 end} {}}
+ {{.cb selection set 5 5} {}}
+ {{.cb curselection} {5}}
+ {{.cb justify left} {}}
+ {{.cb justify right} {}}
+ {{.cb justify top} {}}
+ {{.cb justify bottom} {}}
+ {{.cb sort ascending} {}}
+ {{.cb sort descending} {}}
+ {{.cb sort increasing} {}}
+ {{.cb sort decreasing} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Combobox-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Method tests which fail and produce errors
+#
+foreach test {
+ {{.cb clear bogus} {bad Combobox component "bogus": must be entry, list, or all.}}
+ {{.cb delete} {wrong # args: should be ".cb delete component first ?last?"}}
+ {{.cb delete bogus 0} {bad Combobox component "bogus": must be entry or list.}}
+ {{.cb delete list} {wrong # args: should be ".cb delete component first ?last?"}}
+ {{.cb delete entry} {wrong # args: should be ".cb delete component first ?last?"}}
+ {{.cb get bogus1 bogus2} {wrong # args: should be ".cb get ?index?"}}
+ {{.cb insert} {wrong # args: should be ".cb insert component index ?arg arg ...?"}}
+ {{.cb insert bogus 0 bogus0} {bad Combobox component "bogus": must be entry or list.}}
+ {{.cb insert list} {wrong # args: should be ".cb insert component index ?arg arg ...?"}}
+ {{.cb insert list 1} {no value given for parameter "string" in function "Combobox::insert"}}
+ {{.cb insert entry a b c} {called function "Combobox::insert entry" with too many arguments}}
+ {{.cb selection} {wrong # args: should be ".cb selection option first ?last?"}}
+ {{.cb selection bogus1 bogus2 bogus3 bogus4} {wrong # args: should be ".cb selection option first ?last?"}}
+ {{.cb selection bogus bogus} {bad Scrolledlistbox index "bogus": must be active, anchor, end, @x,y, number, or a pattern}}
+ {{.cb sort bogus} {bad sort argument "bogus": should be ascending, descending, increasing, or decreasing}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Combobox-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Combobox-4.1 {Combobox destruction} {
+ destroy .cb
+ update
+} {}
+
+incr c
+
+test Combobox-4.2 {Combobox construction} {
+ iwidgets::Combobox .cb3 -selectioncommand {puts "choice: [.cb get]" } \
+ -dropdown false -listheight 50 \
+ -labeltext "Numeric Simple:" -labelpos w \
+ -validate numeric -unique false
+ .cb3 insert list end 123 456 789 101112
+ pack .cb3 -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Combobox-4.3 {Combobox destruction} {
+ destroy .cb3
+ update
+} {}
+
+test Combobox-4.4 {Combobox construction} {
+ iwidgets::Combobox .cb4 -arrowrelief flat -selectioncommand {puts "choice: [.cb get]" } \
+ -editable false \
+ -listheight 200 -labeltext "DropDown:" -labelpos w \
+ -popupcursor hand1 -unique true
+ .cb4 insert list end Hello {Out There} World
+ pack .cb4 -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Combobox-4.5 {Combobox destruction} {
+ destroy .cb4
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/dateentry.test b/itcl/iwidgets3.0.0/tests/dateentry.test
new file mode 100644
index 00000000000..d071a8eaf76
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/dateentry.test
@@ -0,0 +1,183 @@
+# This file is a Tcl script to test out [incr Widgets] Dateentry class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Dateentry-1.$c {Dateentry construction} {
+ iwidgets::Dateentry .de -labeltext "Date Field"
+ pack .de -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Dateentry-2.$o {configuration option} {
+ llength [.de configure]
+} {43}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-buttonforeground green green}
+ {-borderwidth 4 4}
+ {-borderwidth 2 2}
+ {-command {.de configure -background red} {.de configure -background red}}
+ {-cursor gumby gumby}
+ {-exportselection 0 0}
+ {-foreground Green Green}
+ {-foreground Black Black}
+ {-highlightcolor Red Red}
+ {-highlightthickness 2 2}
+ {-insertbackground Yellow Yellow}
+ {-insertbackground Black Black}
+ {-iq low low}
+ {-iq average average}
+ {-iq high high}
+ {-justify right right}
+ {-justify center center}
+ {-justify left left}
+ {-labelmargin 5 5}
+ {-labelpos w w}
+ {-labelpos nw nw}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos e e}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-labeltext Label Label}
+ {-relief raised raised}
+ {-relief sunken sunken}
+ {-currentdatefont -*-helvetica-bold-r-normal--*-120-* -*-helvetica-bold-r-normal--*-120-*}
+ {-datefont -*-helvetica-medium-r-normal--*-120-* -*-helvetica-medium-r-normal--*-120-*}
+ {-dayfont -*-helvetica-medium-r-normal--*-120-* -*-helvetica-medium-r-normal--*-120-*}
+ {-days {M T W T F S S} {M T W T F S S}}
+ {-foreground black black}
+ {-height 300 300}
+ {-outline black black}
+ {-selectcolor blue blue}
+ {-selectthickness 2 2}
+ {-startday monday monday}
+ {-titlefont -*-helvetica-bold-r-normal--*-140-* -*-helvetica-bold-r-normal--*-140-*}
+ {-weekdaybackground mistyrose mistyrose}
+ {-weekendbackground white white}
+ {-width 350 350}
+ {-textbackground GhostWhite GhostWhite}
+ {-textbackground #d9d9d9 #d9d9d9}} {
+ set option [lindex $test 0]
+ test Dateentry-2.$o "configuration options, $option" {
+ .de configure $option [lindex $test 1]
+ lindex [.de configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-iq bogus {bad iq option "bogus": should be high, average or low}}
+ {-childsitepos bogus {bad childsite option "bogus": should be n, e, s, or w}}} {
+ set option [lindex $test 0]
+ test Dateentry-2.$o "configuration options, $option" {
+ list [catch {.de configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.de childsite} {.de.lwchildsite}}
+ {{.de show 03/03/1960} {}}
+ {{.de get} {03/03/1960}}
+ {{.de get -string} {03/03/1960}}
+ {{.de isvalid} {1}}
+ {{.de component date delete 0 end} {}}
+ {{.de component date insert end 03/32/1960} {}}
+ {{.de isvalid} {0}}
+ {{.de show 03/03/1960} {}}
+ {{.de show now} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Dateentry-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+test Dateentry-3.$m "object methods, clock clicks" {
+ set clicks [clock scan "06/08/1964"]
+ .de show $clicks
+ update
+ .de get
+} {06/08/1964}
+incr m
+
+#
+# Method tests which fail and produce errors
+#
+foreach test {
+ {{.de get bogus} {bad format option "bogus": should be -string or -clicks}}
+ {{.de show bogus} {bad date: "bogus", must be a valid date string, clock clicks value or the keyword now}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Dateentry-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Dateentry-1.$c {Dateentry destruction} {
+ destroy .de
+ update
+} {}
+
+incr c
+
+test Dateentry-1.$c {Dateentry construction} {
+ iwidgets::dateentry .de
+ pack .de -padx 10 -pady 10
+ update
+} {}
+
+incr c
+
+test Dateentry-1.$c {Dateentry destruction} {
+ destroy .de
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/datefield.test b/itcl/iwidgets3.0.0/tests/datefield.test
new file mode 100644
index 00000000000..890ec11a494
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/datefield.test
@@ -0,0 +1,168 @@
+# This file is a Tcl script to test out [incr Widgets] Datefield class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Datefield-1.$c {Datefield construction} {
+ iwidgets::Datefield .df -labeltext "Date Field"
+ pack .df -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Datefield-2.$o {configuration option} {
+ llength [.df configure]
+} {25}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 4 4}
+ {-borderwidth 2 2}
+ {-command {.df configure -background red} {.df configure -background red}}
+ {-cursor gumby gumby}
+ {-exportselection 0 0}
+ {-foreground Green Green}
+ {-foreground Black Black}
+ {-highlightcolor Red Red}
+ {-highlightthickness 2 2}
+ {-insertbackground Yellow Yellow}
+ {-insertbackground Black Black}
+ {-iq low low}
+ {-iq average average}
+ {-iq high high}
+ {-justify right right}
+ {-justify center center}
+ {-justify left left}
+ {-labelmargin 5 5}
+ {-labelpos w w}
+ {-labelpos nw nw}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos e e}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-labeltext Label Label}
+ {-relief raised raised}
+ {-relief sunken sunken}
+ {-textbackground GhostWhite GhostWhite}
+ {-textbackground #d9d9d9 #d9d9d9}} {
+ set option [lindex $test 0]
+ test Datefield-2.$o "configuration options, $option" {
+ .df configure $option [lindex $test 1]
+ lindex [.df configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-iq bogus {bad iq option "bogus": should be high, average or low}}
+ {-childsitepos bogus {bad childsite option "bogus": should be n, e, s, or w}}} {
+ set option [lindex $test 0]
+ test Datefield-2.$o "configuration options, $option" {
+ list [catch {.df configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.df childsite} {.df.lwchildsite}}
+ {{.df show 03/03/1960} {}}
+ {{.df get} {03/03/1960}}
+ {{.df get -string} {03/03/1960}}
+ {{.df isvalid} {1}}
+ {{.df component date delete 0 end} {}}
+ {{.df component date insert end 03/32/1960} {}}
+ {{.df isvalid} {0}}
+ {{.df show 03/03/1960} {}}
+ {{.df show now} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Datefield-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+test Datefield-3.$m "object methods, clock clicks" {
+ set clicks [clock scan "06/08/1964"]
+ .df show $clicks
+ update
+ .df get
+} {06/08/1964}
+incr m
+
+#
+# Method tests which fail and produce errors
+#
+foreach test {
+ {{.df get bogus} {bad format option "bogus": should be -string or -clicks}}
+ {{.df show bogus} {bad date: "bogus", must be a valid date string, clock clicks value or the keyword now}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Datefield-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Datefield-1.$c {Datefield destruction} {
+ destroy .df
+ update
+} {}
+
+incr c
+
+test Datefield-1.$c {Datefield construction} {
+ iwidgets::datefield .df
+ pack .df -padx 10 -pady 10
+ update
+} {}
+
+incr c
+
+test Datefield-1.$c {Datefield destruction} {
+ destroy .df
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/defs b/itcl/iwidgets3.0.0/tests/defs
new file mode 100644
index 00000000000..09dd45b6f23
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/defs
@@ -0,0 +1,215 @@
+# 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 Sun Microsystems, Inc.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) defs 1.7 94/12/17 15:53:52
+
+package require Iwidgets
+
+if ![info exists VERBOSE] {
+ set VERBOSE 0
+}
+if ![info exists DELAY] {
+ set DELAY 0
+}
+if ![info exists TESTS] {
+ set TESTS {}
+}
+
+# Some of the tests don't work on some system configurations due to
+# configuration quirks, not due to Tk problems; in order to prevent
+# false alarms, these tests are only run in the master development
+# directory for Tk. The presence of a file "doAllTests" in this
+# directory is used to indicate that these tests should be run.
+
+set doNonPortableTests [file exists doAllTests]
+
+proc print_verbose {test_name test_description contents_of_test code answer} {
+ puts stdout "\n"
+ puts stdout "==== $test_name $test_description"
+ puts stdout "==== Contents of test case:"
+ puts stdout "$contents_of_test"
+ 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"
+ }
+}
+
+proc test {test_name test_description contents_of_test passing_results} {
+ global VERBOSE
+ global TESTS
+ global DELAY
+ if {[string compare $TESTS ""] != 0} then {
+ set ok 0
+ foreach test $TESTS {
+ if [string match $test $test_name] then {
+ set ok 1
+ break
+ }
+ }
+ if !$ok then return
+ }
+ set code [catch {uplevel $contents_of_test} answer]
+ if {$code != 0} {
+ print_verbose $test_name $test_description $contents_of_test \
+ $code $answer
+ } elseif {[string compare $answer $passing_results] == 0} then {
+ if $VERBOSE then {
+ print_verbose $test_name $test_description $contents_of_test \
+ $code $answer
+ puts stdout "++++ $test_name PASSED"
+ }
+ } else {
+ print_verbose $test_name $test_description $contents_of_test \
+ $code $answer
+ puts stdout "---- Result should have been:"
+ puts stdout "$passing_results"
+ puts stdout "---- $test_name FAILED"
+ }
+ after $DELAY
+}
+
+#
+# Like test, but does reg expr check on the results.
+# Useful when the result must follow a pattern but some exact details
+# are not necessary, like an internal number appended to a frame, etc.
+#
+proc test_pattern {test_name test_description contents_of_test passing_results} {
+ global VERBOSE
+ global TESTS
+ if {[string compare $TESTS ""] != 0} then {
+ set ok 0
+ foreach test $TESTS {
+ if [string match $test $test_name] then {
+ set ok 1
+ break
+ }
+ }
+ if !$ok then return
+ }
+
+ set code [catch {uplevel $contents_of_test} answer]
+
+ if {$code != 0} {
+ print_verbose $test_name $test_description $contents_of_test \
+ $code $answer
+ } elseif {[regexp -- [lindex $passing_results 1] [lindex $answer 1]] == 1 } {
+ if $VERBOSE then {
+ print_verbose $test_name $test_description $contents_of_test \
+ $code $answer
+ puts stdout "++++ $test_name PASSED"
+ }
+ } else {
+ print_verbose $test_name $test_description $contents_of_test \
+ $code $answer
+ puts stdout "---- Result should have been:"
+ puts stdout "$passing_results"
+ puts stdout "**** $test_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
+global argv0
+if {0} {
+puts "file executable $argv0...[file executable $argv0]"
+if { [file executable $argv0] } {
+ if { [string index $argv0 0] == "/" } {
+ set tktest $argv0
+ } else {
+ set tktest "[pwd]/$argv0"
+ }
+} elseif { [file executable ../$argv0] } {
+ set tktest "[pwd]/../$argv0"
+} else {
+ set tktest {}
+ puts "Unable to find tktest executable, skipping multiple process tests."
+}
+} else {set tktest ../tktest}
+
+# Create background process
+proc setupbg {{args ""}} {
+ global tktest fd bgData
+ set fd [open "|$tktest -geometry +0+0 $args" r+]
+ puts $fd "puts foo; flush stdout"
+ flush $fd
+ gets $fd
+ 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 {$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
+ }
+}
diff --git a/itcl/iwidgets3.0.0/tests/dialog.test b/itcl/iwidgets3.0.0/tests/dialog.test
new file mode 100644
index 00000000000..0d8524c73c8
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/dialog.test
@@ -0,0 +1,131 @@
+# This file is a Tcl script to test out [incr Widgets] Dialog class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+# 4.x - Other tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Dialog-1.$c {Dialog construction} {
+ iwidgets::Dialog .dlg
+
+ listbox [.dlg childsite].lb -relief sunken
+ pack [.dlg childsite].lb -fill both -expand yes
+
+ .dlg activate
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Dialog-2.$o {configuration option} {
+ llength [.dlg configure]
+} {17}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-width 400 400}
+ {-height 400 400}
+ {-buttonboxpadx 10 10}
+ {-buttonboxpady 10 10}
+ {-buttonboxpos n n}
+ {-buttonboxpos e e}
+ {-buttonboxpos w w}
+ {-buttonboxpos s s}
+ {-cursor gumby gumby}
+ {-modality global global}
+ {-modality application application}
+ {-modality none none}
+ {-padx 15 15}
+ {-pady 15 15}
+ {-separator off off}
+ {-thickness 5 5}
+ {-width 0 0}
+ {-height 0 0}
+ {-separator on on}
+ {-title Dialog Dialog}} {
+ set option [lindex $test 0]
+ test Dialog-2.$o "configuration options, $option" {
+ .dlg configure $option [lindex $test 1]
+ lindex [.dlg configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.dlg childsite} {.dlg.shellchildsite.dschildsite}}
+ {{.dlg hide Help} {}}
+ {{.dlg hide Cancel} {}}
+ {{.dlg default Apply} {}}
+ {{.dlg buttonconfigure Help -state disabled} {}}
+ {{.dlg show Cancel} {}}
+ {{.dlg deactivate} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Dialog-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Dialog-1.$c {Dialog destruction} {
+ destroy .dlg
+ update
+} {}
+
+incr c
+
+test Dialog-1.$c {Dialog construction} {
+ iwidgets::Dialog .dlg
+ update
+} {}
+
+incr c
+
+test Dialog-1.$c {Dialog destruction} {
+ destroy .dlg
+ update
+} {}
+
+incr c
+
+test Dialog-1.$c {Dialog destruction} {
+ iwidgets::dialog .dlg
+ destroy .dlg
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/dialogshell.test b/itcl/iwidgets3.0.0/tests/dialogshell.test
new file mode 100644
index 00000000000..b1adbe25f43
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/dialogshell.test
@@ -0,0 +1,224 @@
+# This file is a Tcl script to test out [incr Widgets] Dialogshell class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+# 4.x - Other tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Dialogshell-1.$c {Dialogshell construction} {
+ iwidgets::Dialogshell .ds
+ .ds add OK -text "OK"
+ .ds add Cancel -text "Cancel"
+ .ds default OK
+
+ listbox [.ds childsite].lb -relief sunken
+ pack [.ds childsite].lb -fill both -expand yes
+
+ .ds activate
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Dialogshell-2.$o {configuration option} {
+ llength [.ds configure]
+} {17}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-width 300 300}
+ {-height 300 300}
+ {-buttonboxpadx 10 10}
+ {-buttonboxpady 10 10}
+ {-buttonboxpos n n}
+ {-buttonboxpos e e}
+ {-buttonboxpos w w}
+ {-buttonboxpos s s}
+ {-cursor gumby gumby}
+ {-modality global global}
+ {-modality application application}
+ {-modality none none}
+ {-separator off off}
+ {-padx 15 15}
+ {-pady 15 15}
+ {-thickness 5 5}
+ {-width 0 0}
+ {-height 0 0}
+ {-separator on on}
+ {-title "Dialog Shell" "Dialog Shell"}} {
+ set option [lindex $test 0]
+ test Dialogshell-2.$o "configuration options, $option" {
+ .ds configure $option [lindex $test 1]
+ lindex [.ds configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-buttonboxpos bogus {bad buttonboxpos option "bogus": should be n, s, e, or w}}
+ {-modality bogus {bad modality option "bogus": should be none, application, or global}}} {
+ set option [lindex $test 0]
+ test Dialogshell-2.$o "configuration options, $option" {
+ list [catch {.ds configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.ds childsite} {.ds.shellchildsite.dschildsite}}
+ {{.ds add Help -text Help} {}}
+ {{.ds insert 1 Apply -text Apply} {}}
+ {{.ds center .} {}}
+ {{.ds delete Help} {}}
+ {{.ds hide Apply} {}}
+ {{.ds default Cancel} {}}
+ {{.ds center} {}}
+ {{.ds show Apply} {}}
+ {{.ds invoke OK} {}}
+ {{.ds buttonconfigure OK -text Ok} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Dialogshell-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Method tests which fail and produce errors
+#
+test Dialogshell-3.$m "object methods, activate already active" {
+ list [catch {.ds activate} msg] $msg
+} [list 0 {}]
+update
+incr m
+
+test Dialogshell-3.$m "object methods, deactivate" {
+ list [catch {.ds deactivate} msg] $msg
+} [list 0 {}]
+update
+incr m
+
+#
+# Destruction test
+#
+test Dialogshell-1.$c {Dialogshell destruction} {
+ destroy .ds
+ update
+} {}
+incr c
+
+#
+# Global modality test.
+#
+test Dialogshell-4.2 "global modality, activation, and deactivation" {
+ iwidgets::dialogshell .ds -modality global
+ .ds add OK -text "OK"
+ .ds add Cancel -text "Cancel"
+ .ds default OK
+ pack [label [.ds childsite].l -text "Global Modal Dialogshell"]
+ after 2000 {.ds deactivate Test}
+ list [catch {.ds activate} msg] $msg
+} [list 0 Test]
+update
+
+#
+# Destruction test
+#
+test Dialogshell-1.$c {Dialogshell destruction} {
+ destroy .ds
+ update
+} {}
+incr c
+
+#
+# None modality test.
+#
+test Dialogshell-4.3 "no modality, activation, and deactivation" {
+ iwidgets::dialogshell .ds -modality none
+ .ds add OK -text "OK"
+ .ds add Cancel -text "Cancel"
+ .ds default OK
+ pack [label [.ds childsite].l -text "Non-Modal Dialogshell"]
+ .ds activate
+ update
+ after 2000
+ .ds deactivate
+} {}
+update
+
+#
+# Destruction test
+#
+test Dialogshell-1.$c {Dialogshell destruction} {
+ destroy .ds
+ update
+} {}
+
+incr c
+
+#
+# Application modality test.
+#
+test Dialogshell-4.4 "application modality, activation, and deactivation" {
+ iwidgets::dialogshell .ds -modality application
+ .ds add OK -text "OK"
+ .ds add Cancel -text "Cancel"
+ .ds default OK
+ pack [label [.ds childsite].l -text "Application Modal Dialogshell"]
+ after 2000 {.ds deactivate Test}
+ list [catch {.ds activate} msg] $msg
+} [list 0 Test]
+update
+
+#
+# Destruction test
+#
+test Dialogshell-1.$c {Dialogshell destruction} {
+ destroy .ds
+ update
+} {}
+
+incr c
+
+test Dialogshell-1.$c {Dialogshell destruction} {
+ iwidgets::dialogshell .ds
+ destroy .ds
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/disjointlistbox.test b/itcl/iwidgets3.0.0/tests/disjointlistbox.test
new file mode 100755
index 00000000000..2e0d8a51dc0
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/disjointlistbox.test
@@ -0,0 +1,98 @@
+# This file is a Tcl script to test out [incr Widgets] Disjointlistbox class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Disjointlistbox-1.$c {Disjointlistbox construction} {
+ iwidgets::Disjointlistbox .lf
+ pack .lf -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Disjointlistbox-2.$o {configuration option} {
+ llength [.lf configure]
+} {28}
+
+incr o
+
+foreach test {
+ {-lhslabeltext "LHS" "LHS"}
+ {-lhslabeltext "Available" "Available"}
+ {-lhslabeltext "Don't Print" "Don't Print"}
+ {-rhslabeltext "RHS" "RHS"}
+ {-rhslabeltext "Current" "Current"}
+ {-rhslabeltext "Print" "Print"}
+ {-buttonplacement bottom bottom}
+ {-buttonplacement center center}
+ } {
+ set option [lindex $test 0]
+ test Disjointlistbox-1.$o "configuration options, $option" {
+ .lf configure $option [lindex $test 1]
+ lindex [.lf configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+ }
+
+#
+# Method tests which are successful.
+#
+test Disjointlistbox-1.$c {Disjointlistbox destruction} {
+ destroy .lf
+ update
+} {}
+
+incr c
+
+test Disjointlistbox-1.$c {Disjointlistbox construction} {
+ iwidgets::disjointlistbox .lf -lhslabeltext "Don't Print" -rhslabeltext "Print"
+ pack .lf -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Disjointlistbox-1.$c {Disjointlistbox destruction} {
+ destroy .lf
+ update
+} {}
+
+incr c
+
+test Disjointlistbox-1.$c {Disjointlistbox construction} {
+ iwidgets::disjointlistbox .lf
+ pack .lf
+ destroy .lf
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/entryfield.test b/itcl/iwidgets3.0.0/tests/entryfield.test
new file mode 100644
index 00000000000..89c995f078b
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/entryfield.test
@@ -0,0 +1,172 @@
+# This file is a Tcl script to test out [incr Widgets] Entryfield class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Entryfield-1.$c {Entryfield construction} {
+ iwidgets::Entryfield .ef -labeltext "Entry Field"
+ .ef insert end test
+ pack .ef -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Entryfield-2.$o {configuration option} {
+ llength [.ef configure]
+} {38}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 4 4}
+ {-borderwidth 2 2}
+ {-childsitepos e e}
+ {-childsitepos s s}
+ {-childsitepos w w}
+ {-childsitepos n n}
+ {-command {.ef configure -background red} {.ef configure -background red}}
+ {-cursor gumby gumby}
+ {-exportselection 0 0}
+ {-fixed 10 10}
+ {-fixed 0 0}
+ {-foreground Green Green}
+ {-foreground Black Black}
+ {-highlightcolor Red Red}
+ {-highlightthickness 2 2}
+ {-insertbackground Yellow Yellow}
+ {-insertbackground Black Black}
+ {-insertborderwidth 1 1}
+ {-insertborderwidth 0 0}
+ {-insertofftime 400 400}
+ {-insertontime 700 700}
+ {-insertwidth 3 3}
+ {-invalid {.ef configure -background Green} {.ef configure -background Green}}
+ {-justify right right}
+ {-justify center center}
+ {-justify left left}
+ {-labelmargin 5 5}
+ {-labelpos w w}
+ {-labelpos nw nw}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos e e}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-labeltext Label Label}
+ {-relief raised raised}
+ {-relief sunken sunken}
+ {-state disabled disabled}
+ {-state normal normal}
+ {-textbackground GhostWhite GhostWhite}
+ {-validate numeric {::iwidgets::Entryfield::numeric %c}}
+ {-validate alphabetic {::iwidgets::Entryfield::alphabetic %c}}
+ {-width 30 30}} {
+ set option [lindex $test 0]
+ test Entryfield-2.$o "configuration options, $option" {
+ .ef configure $option [lindex $test 1]
+ lindex [.ef configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-fixed bogus {bad fixed option "bogus", should be positive integer}}
+ {-childsitepos bogus {bad childsite option "bogus": should be n, e, s, or w}}} {
+ set option [lindex $test 0]
+ test Entryfield-2.$o "configuration options, $option" {
+ list [catch {.ef configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.ef childsite} {.ef.lwchildsite.efchildsite}}
+ {{.ef clear} {}}
+ {{.ef insert end "Test String"} {}}
+ {{.ef get} {Test String}}
+ {{.ef delete 0 end} {}}
+ {{.ef insert end "Another Test"} {}}
+ {{.ef icursor end} {}}
+ {{.ef index end} 12}
+ {{.ef selection from 0} {}}
+ {{.ef selection to end} {}}
+ {{.ef xview 3} {}}
+ {{.ef clear} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Entryfield-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Entryfield-1.$c {Entryfield destruction} {
+ destroy .ef
+ update
+} {}
+
+incr c
+
+test Entryfield-1.$c {Entryfield construction} {
+ iwidgets::entryfield .ef -width 12 -validate numeric
+ pack .ef -padx 10 -pady 10
+ update
+} {}
+
+incr c
+
+test Entryfield-1.$c {Entryfield destruction} {
+ destroy .ef
+ update
+} {}
+
+incr c
+
+test Entryfield-1.$c {Entryfield destruction} {
+ iwidgets::entryfield .ef
+ pack .ef
+ destroy .ef
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/extfileselectionbox.test b/itcl/iwidgets3.0.0/tests/extfileselectionbox.test
new file mode 100644
index 00000000000..0d65d36c137
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/extfileselectionbox.test
@@ -0,0 +1,192 @@
+# This file is a Tcl script to test out [incr Widgets] Extfileselectionbox
+# class. It is organized in the standard fashion for Tcl tests with the
+# following notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Extfileselectionbox-1.$c {Extfileselectionbox construction} {
+ iwidgets::Extfileselectionbox .fsb
+ pack .fsb -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Extfileselectionbox-2.$o {configuration option} {
+ llength [.fsb configure]
+} {47}
+
+incr o
+
+foreach test {
+ {-activebackground #ececec #ececec}
+ {-activerelief raised raised}
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 2 2}
+ {-textbackground GhostWhite GhostWhite}
+ {-childsitepos n n}
+ {-childsitepos s s}
+ {-childsitepos e e}
+ {-childsitepos w w}
+ {-childsitepos top top}
+ {-childsitepos bottom bottom}
+ {-cursor gumby gumby}
+ {-directory {..} {..}}
+ {-foreground Black Black}
+ {-highlightcolor black black}
+ {-highlightthickness 2 2}
+ {-insertbackground Black Black}
+ {-insertborderwidth 1 1}
+ {-insertofftime 300 300}
+ {-insertontime 600 600}
+ {-insertwidth 3 3}
+ {-dirslabel "Dirs Label" "Dirs Label"}
+ {-dirson no no}
+ {-dirson yes yes}
+ {-fileslabel "Files Label" "Files Label"}
+ {-fileson no no}
+ {-fileson yes yes}
+ {-filetype any any}
+ {-filetype directory directory}
+ {-filetype regular regular}
+ {-filterlabel "Filter Label" "Filter Label"}
+ {-filteron no no}
+ {-filteron yes yes}
+ {-directory ../tests ../tests}
+ {-mask *.* *.*}
+ {-nomatchstring {No Files} {No Files}}
+ {-labelfont -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*}
+ {-selectbackground #e6ceb1 #e6ceb1}
+ {-selectborderwidth 1 1}
+ {-selectionlabel "Selection Label" "Selection Label"}
+ {-selectionon no no}
+ {-selectionon yes yes}
+ {-textfont -*-courier-medium-r-normal--*-120-* -*-courier-medium-r-normal--*-120-*}
+ {-troughcolor #c3c3c3 #c3c3c3}
+ {-width 400 400}
+ {-height 375 375}} {
+ set option [lindex $test 0]
+ test Extfileselectionbox-2.$o "configuration options, $option" {
+ .fsb configure $option [lindex $test 1]
+ lindex [.fsb configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-directory bogus {bad directory option "bogus": directory does not exist}}
+ {-filetype bogus {bad filetype option "bogus": should be regular, directory, or any}}} {
+ set option [lindex $test 0]
+ test Extfileselectionbox-2.$o "configuration options, $option" {
+ list [catch {.fsb configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.fsb childsite} {.fsb.fsbchildsite}}
+ {{.fsb get} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Extfileselectionbox-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Extfileselectionbox-1.$c {Extfileselectionbox destruction} {
+ destroy .fsb
+ update
+} {}
+
+
+incr c
+
+test Extfileselectionbox-1.$c {Extfileselectionbox construction} {
+ iwidgets::extfileselectionbox .fsb
+ pack .fsb -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+
+incr c
+
+test Extfileselectionbox-1.$c {Extfileselectionbox destruction} {
+ destroy .fsb
+ update
+} {}
+
+incr c
+
+
+test Extfileselectionbox-1.$c {Extfileselectionbox destruction} {
+ iwidgets::extfileselectionbox .fsb
+ pack .fsb
+ destroy .fsb
+ update
+} {}
+
+#
+# Childsite tests
+#
+incr o
+
+test Extfileselectionbox-1.$o {Extfileselectionbox -childsitepos} {
+ iwidgets::extfileselectionbox .fsb
+ pack .fsb
+ update
+ label [.fsb childsite].lb -background red -text CS
+ pack [.fsb childsite].lb -fill both -expand yes
+ update
+
+ .fsb configure -childsitepos n
+ update
+ .fsb configure -childsitepos s
+ update
+ .fsb configure -childsitepos e
+ update
+ .fsb configure -childsitepos w
+ update
+ .fsb configure -childsitepos top
+ update
+ .fsb configure -childsitepos bottom
+ update
+ destroy .fsb
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/extfileselectiondialog.test b/itcl/iwidgets3.0.0/tests/extfileselectiondialog.test
new file mode 100644
index 00000000000..f14db49e6b8
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/extfileselectiondialog.test
@@ -0,0 +1,200 @@
+# This file is a Tcl script to test out [incr Widgets] Extfileselectiondialog
+# class. It is organized in the standard fashion for Tcl tests with the
+# following notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+# 4.x - Other tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Extfileselectiondialog-1.$c {Extfileselectiondialog construction} {
+ iwidgets::Extfileselectiondialog .fsd
+ .fsd activate
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Extfileselectiondialog-2.$o {configuration option} {
+ llength [.fsd configure]
+} {51}
+
+incr o
+
+foreach test {
+ {-activebackground #ececec #ececec}
+ {-borderwidth 2 2}
+ {-childsitepos n n}
+ {-childsitepos s s}
+ {-childsitepos e e}
+ {-childsitepos w w}
+ {-childsitepos top top}
+ {-childsitepos bottom bottom}
+ {-cursor gumby gumby}
+ {-directory {..} {..}}
+ {-textbackground GhostWhite GhostWhite}
+ {-foreground Black Black}
+ {-insertbackground Black Black}
+ {-insertborderwidth 1 1}
+ {-insertofftime 200 200}
+ {-insertontime 500 500}
+ {-insertwidth 3 3}
+ {-dirslabel "Dirs Label" "Dirs Label"}
+ {-dirson no no}
+ {-dirson yes yes}
+ {-fileslabel "Files Label" "Files Label"}
+ {-fileson no no}
+ {-directory ../tests ../tests}
+ {-mask *.* *.*}
+ {-nomatchstring {No Files} {No Files}}
+ {-fileson yes yes}
+ {-filetype any any}
+ {-filetype directory directory}
+ {-filetype regular regular}
+ {-filterlabel "Filter Label" "Filter Label"}
+ {-filteron no no}
+ {-filteron yes yes}
+ {-selectbackground #c3c3c3 #c3c3c3}
+ {-selectionlabel "Selection Label" "Selection Label"}
+ {-selectionon no no}
+ {-selectionon yes yes}
+ {-textfont -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*}
+ {-background #d9d9d9 #d9d9d9}
+ {-buttonboxpos n n}
+ {-buttonboxpos e e}
+ {-buttonboxpos w w}
+ {-buttonboxpos s s}
+ {-cursor gumby gumby}
+ {-modality global global}
+ {-modality application application}
+ {-modality none none}
+ {-padx 15 15}
+ {-pady 15 15}
+ {-separator off off}
+ {-thickness 4 4}
+ {-separator on on}
+ {-title Extfileselectiondialog Extfileselectiondialog}} {
+ set option [lindex $test 0]
+ test Extfileselectiondialog-2.$o "configuration options, $option" {
+ .fsd configure $option [lindex $test 1]
+ lindex [.fsd configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-directory bogus {bad directory option "bogus": directory does not exist}}
+ {-filetype bogus {bad filetype option "bogus": should be regular, directory, or any}}} {
+ set option [lindex $test 0]
+ test FileSelectionBox-2.$o "configuration options, $option" {
+ list [catch {.fsd configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.fsd childsite} {.fsd.shellchildsite.dschildsite.fsb.fsbchildsite}}
+ {{.fsd hide Help} {}}
+ {{.fsd hide Cancel} {}}
+ {{.fsd default Apply} {}}
+ {{.fsd show Cancel} {}}
+ {{.fsd deactivate} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Extfileselectiondialog-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Extfileselectiondialog-1.$c {Extfileselectiondialog destruction} {
+ destroy .fsd
+ update
+} {}
+
+incr c
+
+test Extfileselectiondialog-1.$c {Extfileselectiondialog construction} {
+ iwidgets::extfileselectiondialog .fsd
+ update
+} {}
+
+incr c
+
+test Extfileselectiondialog-1.$c {Extfileselectiondialog destruction} {
+ destroy .fsd
+ update
+} {}
+
+incr c
+
+test Extfileselectiondialog-1.$c {Extfileselectiondialog destruction} {
+ iwidgets::extfileselectiondialog .fsd
+ destroy .fsd
+ update
+} {}
+
+#
+# Childsite tests
+#
+incr o
+
+test Extfileselectiondialog-1.$o {Extfileselectiondialog -childsitepos} {
+ iwidgets::extfileselectiondialog .fsd
+ .fsd activate
+ update
+ label [.fsd childsite].lb -background red -text CS
+ pack [.fsd childsite].lb -fill both -expand yes
+ update
+
+ .fsd configure -childsitepos n
+ update
+ .fsd configure -childsitepos s
+ update
+ .fsd configure -childsitepos e
+ update
+ .fsd configure -childsitepos w
+ update
+ .fsd configure -childsitepos top
+ update
+ .fsd configure -childsitepos bottom
+ update
+ .fsd deactivate
+ update
+ destroy .fsd
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/feedback.test b/itcl/iwidgets3.0.0/tests/feedback.test
new file mode 100644
index 00000000000..a39011a9421
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/feedback.test
@@ -0,0 +1,132 @@
+# This file is a Tcl script to test out [incr Widgets] feedback class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id: feedback.test
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Feedback-1.$c {Feedback construction} {
+ iwidgets::Feedback .f
+ pack .f -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Feedback-2.$o {configuration option} {
+ llength [.f configure]
+} {21}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-cursor gumby gumby}
+ {-foreground Black Black}
+ {-labelmargin 5 5}
+ {-labeltext Label Label}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos e e}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-labelpos w w}
+ {-labelpos nw nw}
+ {-barcolor red red}
+ {-steps 50 50}
+ {-barheight 20 20}} {
+ set option [lindex $test 0]
+ test Feedback-2.$o "configuration options, $option" {
+ .f configure $option [lindex $test 1]
+ lindex [.f configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+#foreach test {
+# {} {
+# set option [lindex $test 0]
+# test Feedback-2.$o "configuration options, $option" {
+# list [catch {.f configure $option [lindex $test 1]} msg] $msg
+# } [list 1 [lindex $test 2]]
+# incr o
+#}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.f step} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Feedback-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of construction/destruction tests
+#
+test Feedback-1.$c {Feedback destruction} {
+ destroy .f
+ update
+} {}
+
+incr c
+
+test Feedback-1.$c {Feedback construction} {
+ iwidgets::feedback .f -labeltext "Label" \
+ -labelpos n -labelmargin 5
+ pack .f -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Feedback-1.$c {Feedback destruction} {
+ destroy .f
+ update
+} {}
+
+incr c
+
+test Feedback-1.$c {Feedback destruction} {
+ iwidgets::feedback .f
+ pack .f
+ destroy .f
+ update
+} {}
+
diff --git a/itcl/iwidgets3.0.0/tests/fileselectionbox.test b/itcl/iwidgets3.0.0/tests/fileselectionbox.test
new file mode 100644
index 00000000000..59139960c43
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/fileselectionbox.test
@@ -0,0 +1,195 @@
+# This file is a Tcl script to test out [incr Widgets] Fileselectionbox class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Fileselectionbox-1.$c {Fileselectionbox construction} {
+ iwidgets::Fileselectionbox .fsb
+ pack .fsb -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Fileselectionbox-2.$o {configuration option} {
+ llength [.fsb configure]
+} {45}
+
+incr o
+
+foreach test {
+ {-activebackground #ececec #ececec}
+ {-activerelief raised raised}
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 2 2}
+ {-textbackground GhostWhite GhostWhite}
+ {-childsitepos n n}
+ {-childsitepos s s}
+ {-childsitepos e e}
+ {-childsitepos w w}
+ {-childsitepos top top}
+ {-childsitepos bottom bottom}
+ {-childsitepos center center}
+ {-cursor gumby gumby}
+ {-directory {..} {..}}
+ {-foreground Black Black}
+ {-highlightcolor black black}
+ {-highlightthickness 2 2}
+ {-insertbackground Black Black}
+ {-insertborderwidth 1 1}
+ {-insertofftime 300 300}
+ {-insertontime 600 600}
+ {-insertwidth 3 3}
+ {-dirslabel "Dirs Label" "Dirs Label"}
+ {-dirson no no}
+ {-dirson yes yes}
+ {-fileslabel "Files Label" "Files Label"}
+ {-fileson no no}
+ {-fileson yes yes}
+ {-filetype any any}
+ {-filetype directory directory}
+ {-filetype regular regular}
+ {-filterlabel "Filter Label" "Filter Label"}
+ {-filteron no no}
+ {-filteron yes yes}
+ {-directory ../tests ../tests}
+ {-mask *.* *.*}
+ {-nomatchstring {No Files} {No Files}}
+ {-labelfont -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*}
+ {-selectbackground #e6ceb1 #e6ceb1}
+ {-selectborderwidth 1 1}
+ {-selectionlabel "Selection Label" "Selection Label"}
+ {-selectionon no no}
+ {-selectionon yes yes}
+ {-textfont -*-courier-medium-r-normal--*-120-* -*-courier-medium-r-normal--*-120-*}
+ {-troughcolor #c3c3c3 #c3c3c3}
+ {-width 400 400}
+ {-height 375 375}} {
+ set option [lindex $test 0]
+ test Fileselectionbox-2.$o "configuration options, $option" {
+ .fsb configure $option [lindex $test 1]
+ lindex [.fsb configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-directory bogus {bad directory option "bogus": directory does not exist}}
+ {-filetype bogus {bad filetype option "bogus": should be regular, directory, or any}}} {
+ set option [lindex $test 0]
+ test Fileselectionbox-2.$o "configuration options, $option" {
+ list [catch {.fsb configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.fsb childsite} {.fsb.fsbchildsite}}
+ {{.fsb get} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Fileselectionbox-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Fileselectionbox-1.$c {Fileselectionbox destruction} {
+ destroy .fsb
+ update
+} {}
+
+
+incr c
+
+test Fileselectionbox-1.$c {Fileselectionbox construction} {
+ iwidgets::fileselectionbox .fsb
+ pack .fsb -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+
+incr c
+
+test Fileselectionbox-1.$c {Fileselectionbox destruction} {
+ destroy .fsb
+ update
+} {}
+
+incr c
+
+
+test Fileselectionbox-1.$c {Fileselectionbox destruction} {
+ iwidgets::fileselectionbox .fsb
+ pack .fsb
+ destroy .fsb
+ update
+} {}
+
+#
+# Childsite tests
+#
+incr o
+
+test Fileselectionbox-1.$o {Fileselectionbox -childsitepos} {
+ iwidgets::fileselectionbox .fsb
+ pack .fsb
+ update
+ label [.fsb childsite].lb -background red -text CS
+ pack [.fsb childsite].lb -fill both -expand yes
+ update
+
+ .fsb configure -childsitepos n
+ update
+ .fsb configure -childsitepos s
+ update
+ .fsb configure -childsitepos e
+ update
+ .fsb configure -childsitepos w
+ update
+ .fsb configure -childsitepos top
+ update
+ .fsb configure -childsitepos bottom
+ update
+ .fsb configure -childsitepos center
+ update
+ destroy .fsb
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/fileselectiondialog.test b/itcl/iwidgets3.0.0/tests/fileselectiondialog.test
new file mode 100644
index 00000000000..8b5766dfb67
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/fileselectiondialog.test
@@ -0,0 +1,203 @@
+# This file is a Tcl script to test out [incr Widgets] Fileselectiondialog
+# class. It is organized in the standard fashion for Tcl tests with the
+# following notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+# 4.x - Other tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Fileselectiondialog-1.$c {Fileselectiondialog construction} {
+ iwidgets::Fileselectiondialog .fsd
+ .fsd activate
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Fileselectiondialog-2.$o {configuration option} {
+ llength [.fsd configure]
+} {51}
+
+incr o
+
+foreach test {
+ {-activebackground #ececec #ececec}
+ {-borderwidth 2 2}
+ {-childsitepos n n}
+ {-childsitepos s s}
+ {-childsitepos e e}
+ {-childsitepos w w}
+ {-childsitepos top top}
+ {-childsitepos bottom bottom}
+ {-childsitepos center center}
+ {-cursor gumby gumby}
+ {-directory {..} {..}}
+ {-textbackground GhostWhite GhostWhite}
+ {-foreground Black Black}
+ {-insertbackground Black Black}
+ {-insertborderwidth 1 1}
+ {-insertofftime 200 200}
+ {-insertontime 500 500}
+ {-insertwidth 3 3}
+ {-dirslabel "Dirs Label" "Dirs Label"}
+ {-dirson no no}
+ {-dirson yes yes}
+ {-fileslabel "Files Label" "Files Label"}
+ {-fileson no no}
+ {-directory ../tests ../tests}
+ {-mask *.* *.*}
+ {-nomatchstring {No Files} {No Files}}
+ {-fileson yes yes}
+ {-filetype any any}
+ {-filetype directory directory}
+ {-filetype regular regular}
+ {-filterlabel "Filter Label" "Filter Label"}
+ {-filteron no no}
+ {-filteron yes yes}
+ {-selectbackground #c3c3c3 #c3c3c3}
+ {-selectionlabel "Selection Label" "Selection Label"}
+ {-selectionon no no}
+ {-selectionon yes yes}
+ {-textfont -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*}
+ {-background #d9d9d9 #d9d9d9}
+ {-buttonboxpos n n}
+ {-buttonboxpos e e}
+ {-buttonboxpos w w}
+ {-buttonboxpos s s}
+ {-cursor gumby gumby}
+ {-modality global global}
+ {-modality application application}
+ {-modality none none}
+ {-padx 15 15}
+ {-pady 15 15}
+ {-separator off off}
+ {-thickness 4 4}
+ {-separator on on}
+ {-title Fileselectiondialog Fileselectiondialog}} {
+ set option [lindex $test 0]
+ test Fileselectiondialog-2.$o "configuration options, $option" {
+ .fsd configure $option [lindex $test 1]
+ lindex [.fsd configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-directory bogus {bad directory option "bogus": directory does not exist}}
+ {-filetype bogus {bad filetype option "bogus": should be regular, directory, or any}}} {
+ set option [lindex $test 0]
+ test FileSelectionBox-2.$o "configuration options, $option" {
+ list [catch {.fsd configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.fsd childsite} {.fsd.shellchildsite.dschildsite.fsb.fsbchildsite}}
+ {{.fsd hide Help} {}}
+ {{.fsd hide Cancel} {}}
+ {{.fsd default Apply} {}}
+ {{.fsd show Cancel} {}}
+ {{.fsd deactivate} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Fileselectiondialog-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Fileselectiondialog-1.$c {Fileselectiondialog destruction} {
+ destroy .fsd
+ update
+} {}
+
+incr c
+
+test Fileselectiondialog-1.$c {Fileselectiondialog construction} {
+ iwidgets::fileselectiondialog .fsd
+ update
+} {}
+
+incr c
+
+test Fileselectiondialog-1.$c {Fileselectiondialog destruction} {
+ destroy .fsd
+ update
+} {}
+
+incr c
+
+test Fileselectiondialog-1.$c {Fileselectiondialog destruction} {
+ iwidgets::fileselectiondialog .fsd
+ destroy .fsd
+ update
+} {}
+
+#
+# Childsite tests
+#
+incr o
+
+test Fileselectiondialog-1.$o {Fileselectiondialog -childsitepos} {
+ iwidgets::fileselectiondialog .fsd
+ .fsd activate
+ update
+ label [.fsd childsite].lb -background red -text CS
+ pack [.fsd childsite].lb -fill both -expand yes
+ update
+
+ .fsd configure -childsitepos n
+ update
+ .fsd configure -childsitepos s
+ update
+ .fsd configure -childsitepos e
+ update
+ .fsd configure -childsitepos w
+ update
+ .fsd configure -childsitepos top
+ update
+ .fsd configure -childsitepos bottom
+ update
+ .fsd configure -childsitepos center
+ update
+ .fsd deactivate
+ update
+ destroy .fsd
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/finddialog.test b/itcl/iwidgets3.0.0/tests/finddialog.test
new file mode 100644
index 00000000000..0e2e5164e2e
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/finddialog.test
@@ -0,0 +1,152 @@
+# This file is a Tcl script to test out [incr Widgets] Finddialog class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+# 4.x - Other tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Finddialog-1.$c {Finddialog construction} {
+ iwidgets::Scrolledlistbox .slb
+ iwidgets::Scrolledtext .st
+ pack .st
+ .st insert end "Now is the time for all good men\\n"
+ .st insert end "to come to the aid of their country"
+
+ iwidgets::Finddialog .fd
+ .fd center .st
+ .fd activate
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Finddialog-2.$o {configuration option} {
+ llength [.fd configure]
+} {43}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-buttonboxpadx 10 10}
+ {-buttonboxpady 10 10}
+ {-cursor gumby gumby}
+ {-textwidget .st .st}
+ {-patternbackground blue blue}
+ {-patternforeground white white}
+ {-searchbackground skyblue skyblue}
+ {-searchforeground white white}
+ {-title "Find Dialog" "Find Dialog"}} {
+ set option [lindex $test 0]
+ test Finddialog-2.$o "configuration options, $option" {
+ .fd configure $option [lindex $test 1]
+ lindex [.fd configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-buttonboxpos bogus {bad buttonboxpos option "bogus": should be n, s, e, or w}}
+ {-modality bogus {bad modality option "bogus": should be none, application, or global}}} {
+ set option [lindex $test 0]
+ test Finddialog-2.$o "configuration options, $option" {
+ list [catch {.fd configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.fd component pattern insert end "the"} {}}
+ {{.fd find} 1.7}
+ {{.fd find} 1.45}
+ {{.fd clear} {}}
+ {{.fd invoke Find} {}}
+ {{.fd buttonconfigure Find -text Search} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Finddialog-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+.fd configure -textwidget .bogus
+
+#
+# Method tests which fail and produce errors
+#
+test Finddialog-3.$m "Non existant textwidget" {
+ list [catch {.fd find} msg] $msg
+} [list 1 {bad finddialog text widget value: ".bogus", the widget doesn't exist}]
+update
+incr m
+
+.fd configure -textwidget .slb
+
+test Finddialog-3.$m "Wrong class of textwidget" {
+ list [catch {.fd find} msg] $msg
+} [list 1 {bad finddialog text widget value: ".slb", must be of the class Text or based on Scrolledtext}]
+update
+incr m
+
+#
+# Destruction test
+#
+test Finddialog-1.$c {Finddialog destruction} {
+ destroy .slb
+ destroy .st
+ destroy .fd
+ update
+} {}
+incr c
+
+#
+# Initial construction test
+#
+test Finddialog-1.$c {Finddialog construction} {
+ iwidgets::Finddialog .fd
+} {.fd}
+
+incr c
+
+#
+# Destruction test
+#
+test Finddialog-1.$c {Finddialog destruction} {
+ destroy .fd
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/hierarchy.test b/itcl/iwidgets3.0.0/tests/hierarchy.test
new file mode 100644
index 00000000000..74fbfc19772
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/hierarchy.test
@@ -0,0 +1,281 @@
+# This file is a Tcl script to test out [incr Widgets] Hierarchy class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+set cdir [pwd]
+
+#
+# Initial construction test
+#
+test Hierarchy-1.$c {Hierarchy construction} {
+ iwidgets::Hierarchy .h
+ pack .h -padx 10 -pady 10 -fill both -expand yes
+ update
+
+ image create bitmap testicon -data {
+ #define node.xbm_width 16
+ #define node.xbm_height 16
+ static unsigned char node.xbm_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0xfe, 0x7f, 0x02, 0x40,
+ 0xfa, 0x5f, 0xfa, 0x5f, 0x82, 0x41, 0x82, 0x41,
+ 0x82, 0x41, 0x82, 0x41, 0x82, 0x41, 0x02, 0x40,
+ 0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+ }
+
+ set homelist [lsort [glob -nocomplain $env(HOME)/*]]
+
+ proc get_files {file} {
+ global env
+
+ if {$file == ""} {
+ set dir $env(HOME)
+ } else {
+ set dir $file
+ }
+
+ if {[catch {cd $dir}] != 0} {
+ return ""
+ }
+
+ set rlist ""
+
+ foreach file [lsort [glob -nocomplain *]] {
+ lappend rlist [list [file join $dir $file] $file]
+ }
+
+ return $rlist
+ }
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Hierarchy-2.$o {configuration option} {
+ llength [.h configure]
+} {51}
+
+incr o
+
+foreach test {
+ {-activebackground #ececec #ececec}
+ {-activeforeground Black Black}
+ {-activerelief raised raised}
+ {-alwaysquery 0 0}
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 2 2}
+ {-cursor gumby gumby}
+ {-disabledforeground #a3a3a3 #a3a3a3}
+ {-elementborderwidth -1 -1}
+ {-foreground Black Black}
+ {-height 300 300}
+ {-width 400 400}
+ {-highlightcolor Black Black}
+ {-highlightthickness 2 2}
+ {-hscrollmode none none}
+ {-hscrollmode static static}
+ {-hscrollmode dynamic dynamic}
+ {-jump 0 0}
+ {-textbackground GhostWhite GhostWhite}
+ {-labelmargin 5 5}
+ {-labeltext Label Label}
+ {-labelpos nw nw}
+ {-labelpos ne ne}
+ {-labelpos en en}
+ {-labelpos e e}
+ {-labelpos es es}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-labelpos wn wn}
+ {-labelpos w w}
+ {-labelpos ws ws}
+ {-labelpos n n}
+ {-markbackground #a0a0a0 #a0a0a0}
+ {-markforeground Black Black}
+ {-menucursor gumby gumby}
+ {-relief raised raised}
+ {-relief sunken sunken}
+ {-vscrollmode none none}
+ {-vscrollmode static static}
+ {-vscrollmode dynamic dynamic}
+ {-sbwidth 20 20}
+ {-scrollmargin 5 5}
+ {-textbackground #d9d9d9 #d9d9d9}
+ {-visibleitems 40x20 40x20}
+ {-height 0 0}
+ {-width 0 0}
+ {-selectbackground #c3c3c3 #c3c3c3}
+ {-selectcolor #b03060 #b03060}
+ {-selectforeground Black Black}
+ {-spacing1 0 0}
+ {-spacing2 0 0}
+ {-spacing3 0 0}
+ {-closedicon testicon testicon}
+ {-nodeicon testicon testicon}
+ {-openicon testicon testicon}
+ {-querycommand {get_files %n} {get_files %n}}
+ {-closedicon closedFolder closedFolder}
+ {-nodeicon nodeFolder nodeFolder}
+ {-openicon openFolder openFolder}
+ {-querycommand {get_files %n} {get_files %n}}
+ {-expanded 0 0}
+ {-filter 0 0}
+ {-iconcommand {} {}}
+ {-selectcommand {} {}}} {
+ set option [lindex $test 0]
+ test Hierarchy-2.$o "configuration options, $option" {
+ .h configure $option [lindex $test 1]
+ lindex [.h configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-filter bogus {bad filter option "bogus": should be boolean}}
+ {-expanded bogus {bad expanded option "bogus": should be boolean}}
+ {-openicon bogus {bad openicon option "bogus": should be an existing image}}
+ {-closedicon bogus {bad closedicon option "bogus": should be an existing image}}
+ {-nodeicon bogus {bad nodeicon option "bogus": should be an existing image}}
+ {-visibleitems bogus {bad visibleitems option "bogus": should be widthxheight}}
+ {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}}
+ {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}}} {
+ set option [lindex $test 0]
+ test Hierarchy-2.$o "configuration options, $option" {
+ list [catch {.h configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Addtional test for selection/mark get
+#
+test Hierarchy-1.$m {Hierarchy selection/mark get} {
+ .h draw -now
+ .h selection clear
+ eval .h selection add $homelist
+ update
+ if {[lsort [.h selection get]] != [lsort $homelist]} {
+ error "selection isn't right"
+ }
+ .h selection clear
+ update
+
+ .h mark clear
+ eval .h mark add $homelist
+ update
+ if {[lsort [.h mark get]] != [lsort $homelist]} {
+ error "mark isn't right"
+ }
+ update
+ .h mark clear
+} {}
+incr m
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{eval .h selection add $homelist} {}}
+ {{eval .h selection remove $homelist} {}}
+ {{.h selection clear} {}}
+ {{eval .h mark add $homelist} {}}
+ {{eval .h mark remove $homelist} {}}
+ {{.h mark clear} {}}
+ {{.h current} {}}
+ {{.h expand [lindex $homelist 0]} {}}
+ {{.h collapse [lindex $homelist 0]} {}}
+ {{.h toggle [lindex $homelist 0]} {}}
+ {{.h refresh [lindex $homelist 0]} {}}
+ {{.h prune [lindex $homelist 0]} {}}
+ {{.h draw -now} {}}
+ {{.h draw -eventually} {}}
+ {{.h clear} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Hierarchy-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Method tests which fail and produce errors
+#
+foreach test {
+ {{.h expand bogus} {bad expand node argument: "bogus", the node doesn't exist}}
+ {{.h collapse bogus} {bad collapse node argument: "bogus", the node doesn't exist}}
+ {{.h toggle bogus} {bad toggle node argument: "bogus", the node doesn't exist}}
+ {{.h draw bogus} {bad when option "bogus": should be -eventually or -now}}
+ {{.h mark bogus} {bad mark operation "bogus": should be add, remove, clear or get}}
+ {{.h selection bogus} {bad selection operation "bogus": should be add, remove, clear or get}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Hierarchy-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Hierarchy-1.$c {Hierarchy destruction} {
+ destroy .h
+ update
+} {}
+
+incr c
+
+test Hierarchy-1.$c {Hierarchy construction} {
+ iwidgets::hierarchy .h -hscrollmode dynamic -labeltext "Label" \
+ -labelpos n -labelmargin 5
+ pack .h -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Hierarchy-1.$c {Hierarchy destruction} {
+ destroy .h
+ update
+} {}
+
+incr c
+
+test Hierarchy-1.$c {Hierarchy destruction} {
+ iwidgets::hierarchy .h
+ pack .h
+ destroy .h
+ update
+} {}
+
+cd $cdir
diff --git a/itcl/iwidgets3.0.0/tests/hyperhelp.html b/itcl/iwidgets3.0.0/tests/hyperhelp.html
new file mode 100644
index 00000000000..76a6b9db367
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/hyperhelp.html
@@ -0,0 +1,157 @@
+# This file is a Tcl script to test out [incr Widgets] Hyperhelp class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id: hyperhelp.test
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Hyperhelp-1.$c {Hyperhelp construction} {
+ Hyperhelp .h
+ .h activate
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Hyperhelp-2.$o {configuration option} {
+ llength [.h configure]
+} {37}
+
+incr o
+
+foreach test [concat {
+ {-activebackground #ececec #ececec}
+ {-activeforeground Black Black}
+ {-activerelief raised raised}
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 3 3}
+ {-cursor gumby gumby}
+ {-font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* \
+ -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*}
+ {-foreground Black Black}
+ {-highlightcolor Black Black}
+ {-highlightthickness 3 3}
+ {-height 120 120}
+ {-width 500 500}
+ {-relief raised raised}
+ {-relief sunken sunken}
+ {-vscrollmode none none}
+ {-vscrollmode static static}
+ {-vscrollmode dynamic dynamic}
+ {-hscrollmode none none}
+ {-hscrollmode static static}
+ {-hscrollmode dynamic dynamic}
+ {-sbwidth 20 20}
+ {-scrollmargin 5 5}
+ {-selectborderwidth 2 2}
+ {-textbackground GhostWhite GhostWhite}
+ {-visibleitems 72x40 72x40}
+ {-height 0 0}
+ {-width 0 0}
+ {-wrap char char}
+ {-wrap none none}
+ {-unknownimage {} {}}
+ {-link blue blue}
+ {-linkhighlight red red}
+ {-fontname times times}
+ {-fixedfont courier courier}
+ {-fontsize medium medium}
+ {-topics {} {}}
+ {-title "Test" "Test"} } \
+ [list [list -helpdir . [pwd]/.]]] {
+ set option [lindex $test 0]
+ test Hyperhelp-2.$o "configuration options, $option" {
+ .h configure $option [lindex $test 1]
+ lindex [.h configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-visibleitems bogus {bad visibleitems option "bogus": should be widthxheight}}
+ {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}}
+ {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}}
+ {-fontname bogus {Invalid font name "bogus". Must be one of helvetica courier times symbol}}
+ {-fontsize bogus {bad fontsize option "bogus": should be small, medium, large, or huge}}
+ {-fixedfont bogus {Invalid font name "bogus". Must be one of helvetica courier times symbol}}} {
+ set option [lindex $test 0]
+ test Hyperhelp-2.$o "configuration options, $option" {
+ list [catch {.h configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.h showtopic hyperhelp} -1}
+ {{.h followlink scrolledhtml.test#} -1}
+ {{.h back} -1}
+ {{.h forward} -1}} {
+ set method [lindex [lindex $test 0] 1]
+ test Hyperhelp-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of construction/destruction tests
+#
+test Hyperhelp-1.$c {Hyperhelp destruction} {
+ destroy .h
+ update
+} {}
+
+incr c
+
+test Hyperhelp-1.$c {Hyperhelp construction} {
+ hyperhelp .h -topics {index} -helpdir ~/public_html
+ .h activate
+ update
+} {}
+
+incr c
+
+test Hyperhelp-1.$c {Hyperhelp destruction} {
+ destroy .h
+ update
+} {}
+
+incr c
+
+test Hyperhelp-1.$c {Hyperhelp destruction} {
+ hyperhelp .h
+ .h activate
+ .h deactivate
+ destroy .h
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/hyperhelp.test b/itcl/iwidgets3.0.0/tests/hyperhelp.test
new file mode 100644
index 00000000000..a60d2b4deca
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/hyperhelp.test
@@ -0,0 +1,162 @@
+# This file is a Tcl script to test out [incr Widgets] Hyperhelp class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id: hyperhelp.test
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Hyperhelp-1.$c {Hyperhelp construction} {
+ iwidgets::Hyperhelp .h
+ .h center
+ .h activate
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Hyperhelp-2.$o {configuration option} {
+ llength [.h configure]
+} {43}
+
+incr o
+
+foreach test [concat {
+ {-activebackground #ececec #ececec}
+ {-activeforeground Black Black}
+ {-activerelief raised raised}
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 3 3}
+ {-cursor gumby gumby}
+ {-font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* \
+ -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*}
+ {-foreground Black Black}
+ {-highlightcolor Black Black}
+ {-highlightthickness 3 3}
+ {-height 120 120}
+ {-width 500 500}
+ {-relief raised raised}
+ {-relief sunken sunken}
+ {-vscrollmode none none}
+ {-vscrollmode static static}
+ {-vscrollmode dynamic dynamic}
+ {-hscrollmode none none}
+ {-hscrollmode static static}
+ {-hscrollmode dynamic dynamic}
+ {-sbwidth 20 20}
+ {-scrollmargin 5 5}
+ {-selectborderwidth 2 2}
+ {-textbackground GhostWhite GhostWhite}
+ {-visibleitems 72x40 72x40}
+ {-height 0 0}
+ {-width 0 0}
+ {-wrap char char}
+ {-wrap none none}
+ {-unknownimage {} {}}
+ {-link blue blue}
+ {-linkhighlight red red}
+ {-fontname times times}
+ {-fixedfont courier courier}
+ {-fontsize medium medium}
+ {-topics {} {}}
+ {-title "Test" "Test"} } \
+ [list [list -helpdir . [pwd]/.]]] {
+ set option [lindex $test 0]
+ test Hyperhelp-2.$o "configuration options, $option" {
+ .h configure $option [lindex $test 1]
+ lindex [.h configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-visibleitems bogus {bad visibleitems option "bogus": should be widthxheight}}
+ {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}}
+ {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}}
+ {-fontname bogus {Invalid font name "bogus". Must be one of helvetica courier times symbol}}
+ {-fontsize bogus {bad fontsize option "bogus": should be small, medium, large, or huge}}
+ {-fixedfont bogus {Invalid font name "bogus". Must be one of helvetica courier times symbol}}} {
+ set option [lindex $test 0]
+ test Hyperhelp-2.$o "configuration options, $option" {
+ list [catch {.h configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.h showtopic hyperhelp} -1}
+ {{.h followlink scrolledhtml.test#} -1}
+ {{.h back} -1}
+ {{.h forward} -1}} {
+ set method [lindex [lindex $test 0] 1]
+ test Hyperhelp-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of construction/destruction tests
+#
+test Hyperhelp-1.$c {Hyperhelp destruction} {
+ destroy .h
+ update
+} {}
+
+incr c
+
+test Hyperhelp-1.$c {Hyperhelp construction} {
+ iwidgets::hyperhelp .h -topics {index} -helpdir ~/public_html
+ .h center
+ .h activate
+ update
+} {}
+
+incr c
+
+test Hyperhelp-1.$c {Hyperhelp destruction} {
+ destroy .h
+ update
+} {}
+
+incr c
+
+test Hyperhelp-1.$c {Hyperhelp destruction} {
+ iwidgets::hyperhelp .h
+ .h center
+ .h activate
+ .h deactivate
+ destroy .h
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/labeledframe.test b/itcl/iwidgets3.0.0/tests/labeledframe.test
new file mode 100644
index 00000000000..d64a6ee6e16
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/labeledframe.test
@@ -0,0 +1,178 @@
+# This file is a Tcl script to test out [incr Widgets] Labeledframe class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Labeledframe-1.$c {Labeledframe construction} {
+ iwidgets::Labeledframe .lf
+ set cs [.lf childsite]
+ .lf configure -background yellow
+ pack [radiobutton $cs.w1 -anchor w -text "Button1"] -anchor w -fill x
+ pack [radiobutton $cs.w2 -anchor w -text "Button2"] -anchor w -fill x
+ pack [radiobutton $cs.w3 -anchor w -text "Button3"] -anchor w -fill x
+ pack [radiobutton $cs.w4 -anchor w -text "Button4"] -anchor w -fill x
+ pack [radiobutton $cs.w5 -anchor w -text "Button5"] -anchor w -fill x
+ pack [radiobutton $cs.w6 -anchor w -text "Button6"] -anchor w -fill x
+ pack [radiobutton $cs.w7 -anchor w -text "Button7"] -anchor w -fill x
+ pack [radiobutton $cs.w8 -anchor w -text "Button8"] -anchor w -fill x
+
+ pack .lf -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Labeledframe-2.$o {configuration option} {
+ llength [.lf configure]
+} {15}
+
+incr o
+
+foreach test {
+ {-labeltext "Label" "Label"}
+ {-labelpos nw nw}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos en en}
+ {-labelpos e e}
+ {-labelpos es es}
+ {-labelpos sw sw}
+ {-labelpos s s}
+ {-labelpos se se}
+ {-labelpos wn wn}
+ {-labelpos w w}
+ {-labelpos ws ws}
+ {-labelfont 6x13 6x13}
+ {-labelpos nw nw}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos en en}
+ {-labelpos e e}
+ {-labelpos es es}
+ {-labelpos sw sw}
+ {-labelpos s s}
+ {-labelpos se se}
+ {-labelpos wn wn}
+ {-labelpos w w}
+ {-labelpos ws ws}
+ {-relief groove groove}
+ {-relief sunken sunken}
+ {-relief raised raised}
+ {-relief ridge ridge}
+ {-relief flat flat}
+ {-borderwidth 2 2}
+ {-borderwidth 4 4}
+ {-borderwidth 6 6}
+ {-borderwidth 8 8}
+ {-borderwidth 10 10}
+ {-ipadx 20 20}
+ {-ipady 20 20}
+ {-ipadx 10 10}
+ {-ipady 10 10}
+ {-ipadx 0 0}
+ {-ipady 0 0}
+ } {
+ set option [lindex $test 0]
+ test Labeledframe-1.$o "configuration options, $option" {
+ .lf configure $option [lindex $test 1]
+ lindex [.lf configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+ }
+
+#
+# Method tests which are successful.
+#
+test Labeledframe-3.$m {object method, childsite} {
+ list [catch {.lf childsite} msg] $msg
+} [list 0 .lf.childsite]
+
+incr m
+
+test Labeledframe-3.$m {object static method, initTable} {
+
+} {}
+
+incr m
+
+#
+# Method tests which fail and produce errors
+#
+test Labeledframe-3.$m {initTable static method} {
+ button .b
+
+} {.b}
+
+incr m
+
+test Labeledframe-1.$c {Labeledframe destruction} {
+ destroy .b
+ destroy .lf
+ update
+} {}
+
+incr c
+
+test Labeledframe-1.$c {Labeledframe construction} {
+ iwidgets::labeledframe .lf -labeltext "ListBox" -labelpos s
+ set cs [.lf childsite]
+ .lf configure -background yellow
+ pack [radiobutton $cs.w1 -anchor w -text "Button1"] -anchor w -fill x
+ pack [radiobutton $cs.w2 -anchor w -text "Button2"] -anchor w -fill x
+ pack [radiobutton $cs.w3 -anchor w -text "Button3"] -anchor w -fill x
+ pack [radiobutton $cs.w4 -anchor w -text "Button4"] -anchor w -fill x
+ pack [radiobutton $cs.w5 -anchor w -text "Button5"] -anchor w -fill x
+ pack [radiobutton $cs.w6 -anchor w -text "Button6"] -anchor w -fill x
+ pack [radiobutton $cs.w7 -anchor w -text "Button7"] -anchor w -fill x
+ pack [radiobutton $cs.w8 -anchor w -text "Button8"] -anchor w -fill x
+ pack .lf -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Labeledframe-1.$c {Labeledframe destruction} {
+ destroy .lf
+ update
+} {}
+
+incr c
+
+test Labeledframe-1.$c {Labeledframe construction} {
+ iwidgets::labeledframe .lf
+ pack .lf
+ destroy .lf
+ update
+} {}
+
+
diff --git a/itcl/iwidgets3.0.0/tests/labeledwidget.test b/itcl/iwidgets3.0.0/tests/labeledwidget.test
new file mode 100644
index 00000000000..fa25e58c636
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/labeledwidget.test
@@ -0,0 +1,147 @@
+# This file is a Tcl script to test out [incr Widgets] Labeledwidget class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Labeledwidget-1.$c {Labeledwidget construction} {
+ iwidgets::Labeledwidget .lw
+ pack [listbox [.lw childsite].lb -relief sunken] -padx 10 -pady 10
+ pack .lw -fill both -expand yes -padx 10 -pady 10
+ image create bitmap flagup -file $tk_library/demos/images/flagup.bmp
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Labeledwidget-2.$o {configuration option} {
+ llength [.lw configure]
+} {13}
+
+incr o
+
+foreach test {
+ {-labelvariable foo foo}
+ {-labelvariable {} {}}
+ {-labeltext "Label" "Label"}
+ {-labelpos nw nw}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos en en}
+ {-labelpos e e}
+ {-labelpos es es}
+ {-labelpos sw sw}
+ {-labelpos s s}
+ {-labelpos se se}
+ {-labelpos wn wn}
+ {-labelpos w w}
+ {-labelpos ws ws}
+ {-labelmargin 20 20}
+ {-labelfont 6x13 6x13}
+ {-labelimage flagup flagup}
+ {-labelpos nw nw}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos en en}
+ {-labelpos e e}
+ {-labelpos es es}
+ {-labelpos sw sw}
+ {-labelpos s s}
+ {-labelpos se se}
+ {-labelpos wn wn}
+ {-labelpos w w}
+ {-labelpos ws ws}
+ {-labelimage {} {}}} {
+ set option [lindex $test 0]
+ test Labeledwidget-1.$o "configuration options, $option" {
+ .lw configure $option [lindex $test 1]
+ lindex [.lw configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+ }
+
+#
+# Method tests which are successful.
+#
+test Labeledwidget-3.$m {object method, childsite} {
+ list [catch {.lw childsite} msg] $msg
+} [list 0 .lw.lwchildsite]
+
+incr m
+
+test Labeledwidget-3.$m {object static method, alignlabels} {
+ list [catch {iwidgets::Labeledwidget::alignlabels .lw} msg] $msg
+} {0 {}}
+
+incr m
+
+#
+# Method tests which fail and produce errors
+#
+test Labeledwidget-3.$m {alignlabels static method} {
+ button .b
+ list [catch {iwidgets::Labeledwidget::alignlabels .b} msg] $msg
+} {1 {.b is not a "Labeledwidget"}}
+
+incr m
+
+test Labeledwidget-1.$c {Labeledwidget destruction} {
+ destroy .b
+ destroy .lw
+ update
+ image delete flagup
+} {}
+
+incr c
+
+test Labeledwidget-1.$c {Labeledwidget construction} {
+ iwidgets::labeledwidget .lw -labeltext "ListBox" -labelpos s
+ pack [listbox [.lw childsite].lb -relief sunken] -padx 10 -pady 10
+ pack .lw -fill both -expand yes -padx 10 -pady 10
+ update
+} {}
+
+incr c
+
+test Labeledwidget-1.$c {Labeledwidget destruction} {
+ destroy .lw
+ update
+} {}
+
+incr c
+
+test Labeledwidget-1.$c {Labeledwidget construction} {
+ iwidgets::labeledwidget .lw
+ pack .lw
+ destroy .lw
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/menubar.test b/itcl/iwidgets3.0.0/tests/menubar.test
new file mode 100644
index 00000000000..aa00b191944
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/menubar.test
@@ -0,0 +1,524 @@
+# This file is a Tcl script to test out [incr Widgets] Menubar class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Menubar-1.$c {Menubar construction} {
+ iwidgets::Menubar .mb -menubuttons {
+ menubutton file -text File -menu {
+ options -tearoff no
+ command ok -label "Ok"
+ command quit -label "Quit"
+ }
+ }
+ pack .mb
+ update
+ .mb add menubutton .other -text Other -menu {
+ radiobutton r1 -label "Radio One"
+ radiobutton r2 -label "Radio Two"
+ }
+ update
+ .mb add menubutton view -text View -menu {
+ command uno -label Uno
+ command dos -label Dos
+ }
+ update
+ .mb add cascade .view.more -label More -menu {
+ command one -label One
+ command two -label Two
+ cascade extra -label Extra -menu {
+ radiobutton rad1 -label "Choice One"
+ radiobutton rad2 -label "Choice Two"
+ cascade somemore \
+ -label "Some More" \
+ -helpstr "Yet some more" \
+ -menu {
+ command triangle -label "Triangle" -command {puts TRIANGLE}
+ command square -label "Square" -command {puts SQUARE}
+ command octagon -label "Octagon" -command {puts OCTAGON}
+ }
+ }
+ }
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Menubar-2.$o {configuration option} {
+ llength [.mb configure]
+} {22}
+
+incr o
+
+foreach test {
+ {-anchor center center }
+ {-disabledforeground #a3a3a3 #a3a3a3 }
+ {-menubuttons {} {} }
+ {-highlightthickness 0 0 }
+ {-borderwidth 2 2 }
+ {-helpvariable {} {} }
+ {-highlightcolor Black Black }
+ {-font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* }
+ {-background #CDCDB7B7B5B5 #CDCDB7B7B5B5 }
+ {-highlightbackground #d9d9d9 #d9d9d9 }
+ {-activeborderwidth 2 2 }
+ {-wraplength 0 0 }
+ {-activebackground #ececec #ececec }
+ {-padx 4 4 }
+ {-pady 4 4 }
+ {-justify center center }
+ {-cursor {} {} }
+ {-activeforeground black black }
+ {-width 0 0 }
+ {-height 0 0 }
+ } {
+ set option [lindex $test 0]
+ test Menubar-2.$o "configuration options, $option" {
+ .mb configure $option [lindex $test 1]
+ .mb cget $option
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Menuconfigure Option tests which are successful.
+#
+# This happens to be for a command...
+test Menubar-3.$o {menubar menuconfiguration option} {
+ llength [.mb menuconfigure .file.quit]
+} {15}
+
+# do menuconfigure tests also...
+foreach test {
+ { .file.quit -activebackground red red }
+ { .file.quit -activeforeground red red }
+ { .file.quit -accelerator {} {} }
+ { .file.quit -background red red }
+ { .file.quit -bitmap {} {} }
+ { .file.quit -command {} {} }
+ { .file.quit -font fixed fixed }
+ { .file.quit -foreground red red }
+ { .file.quit -image {} {} }
+ { .file.quit -label hello hello }
+ { .file.quit -state normal normal }
+ { .file.quit -underline -1 -1 }
+ { .file.quit -helpstr {} {} }
+ } {
+ set index [lindex $test 0]
+ set option [lindex $test 1]
+ test Menubar-2.$o "tab configuration options, $option" {
+ .mb menuconfigure $index $option [lindex $test 2]
+ .mb menucget $index $option
+ } [lindex $test 3]
+ update
+ incr o
+}
+
+# test on cascade item
+# This happens to be for a cascade...
+test Menubar-3.$o {menubar menuconfiguration option} {
+ llength [.mb menuconfigure .view.more]
+} {17}
+
+# do menuconfigure tests also...
+foreach test {
+ { .view.more -activebackground red red }
+ { .view.more -activeforeground red red }
+ { .view.more -accelerator {} {} }
+ { .view.more -background red red}
+ { .view.more -bitmap {} {} }
+ { .view.more -command {} {} }
+ { .view.more -font }
+ { .view.more -foreground }
+ { .view.more -image {} {} }
+ { .view.more -label {} {} }
+ { .view.more -state normal normal }
+ { .view.more -underline -1 -1 }
+ { .view.more -helpstr {} {} }
+ } {
+ set index [lindex $test 0]
+ set option [lindex $test 1]
+ test Menubar-2.$o "tab configuration options, $option" {
+ .mb menuconfigure $index $option [lindex $test 2]
+ .mb menucget $index $option
+ } [lindex $test 3]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+#foreach test {
+# { -OPTION BADVALUE {ERROR_MESSAGE} }
+# } {
+# set option [lindex $test 0]
+# test Menubar-2.$o "configuration options, $option" {
+# list [catch {.bb configure $option [lindex $test 1]} msg] $msg
+# } [list 1 [lindex $test 2]]
+# incr o
+#}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.mb delete 0 end}
+ {}}
+ {{.mb add menubutton .help -text Help}
+ {}}
+ {{.mb add command .help.context -label "On Context..."}
+ {}}
+ {{.mb insert .help.context command index -label "By Index..."}
+ {}}
+ {{.mb delete .help}
+ {}}
+ {{.mb add menubutton .help -text HELP -menu {
+ command index -label "By Index..."
+ command context -label "By Context..."
+ separator sep1
+ command keyword -label "By Keyword..."
+ }}
+ {}}
+ {{.mb delete .help.sep1 .help.keyword}
+ {}}
+ {{.mb menuconfigure .help -text HeLp -menu {
+ command index -label "By Index..."
+ command context -label "By Context..."
+ separator sep1
+ command keyword -label "By Keyword..."
+ }}
+ {}}
+ {{.mb configure -menubuttons {
+ menubutton file -text File -menu {
+ options -tearoff $tearoff
+ command ok -label $okLabel
+ command quit -label $quitLabel
+ }
+ }}
+ {}}
+ {{.mb add menubutton .other -text Other -menu {
+ radiobutton r1 -label "Radio One"
+ radiobutton r2 -label "Radio Two"
+ }}
+ {}}
+ {{.mb insert .other menubutton view -text View -menu {
+ command uno -label Uno
+ command dos -label Dos
+ }}
+ {}}
+ {{.mb add cascade .view.more -label More -menu {
+ command one -label One
+ command two -label Two
+ cascade extra -label Extra -menu {
+ radiobutton rad1 -label "Choice One"
+ radiobutton rad2 -label "Choice Two"
+ cascade somemore \
+ -label "Some More" \
+ -helpstr "Yet some more" \
+ -menu {
+ command triangle -label "Triangle" -command {puts TRIANGLE}
+ command square -label "Square" -command {puts SQUARE}
+ command octagon -label "Octagon" -command {puts OCTAGON}
+ }
+ }
+ }}
+ {}}
+ {{.mb insert .view.uno cascade before -label Before -menu {
+ command red -label Red
+ command green -label Green
+ command blue -label Blue
+ }}
+ {}}
+ {{.mb add menubutton .help -text Help}
+ {}}
+ {{.mb add command .help.context -label "On Context..."}
+ {}}
+ {{.mb insert .help.context command index -label "By Index..."}
+ {}}
+ {{.mb insert .view.before.green cascade colors -label Colors -menu {
+ command orange -label Orange -command "puts ORANGE" -helpstr "orange"
+ separator sep1
+ command purple -label Purple
+ }}
+
+ {}}
+ {{.mb insert .view.before.colors.purple cascade morecolors -label "More Colors" -menu {}}
+ {}}
+ {{.mb add command .view.before.colors.morecolors.pink -label Pink}
+ {}}
+ {{.mb add command .view.before.colors.morecolors.peach -label Peach}
+ {}}
+ {{.mb add command .view.before.colors.morecolors.yellow -label Yellow}
+ {}}
+ {{.mb menuconfigure .view -text VIEW -menu {
+ command o -label OH -command {puts OH}
+ cascade negative -label Negative -menu {
+ command print -label Print
+ command save -label Save
+ }
+ # Comments are supported.
+# command dummy -label PlaceHolder
+ cascade plus -label Plus -menu {
+ command yep -label Yep
+ command nope -label Nope
+ }
+ }}
+ {}}
+ {{.mb menuconfigure .view.negative -label NEGATIVE -menu {
+ command print -label PRINT
+ command save -label SAVE
+ }}
+ {}}
+ {{.mb delete .0 .end}
+ {}}
+ } {
+ set method [lindex [lindex $test 0] 1]
+ set method_invoke [lindex $test 0]
+ test_pattern Menubar-4.$m "\[$method_invoke\]" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Method tests which fail and produce errors or results
+# Specifically, deals with method invocation on empty menubar.
+#
+foreach test {
+ {{.mb delete .0 .last}
+ {bad path:}}
+ {{.mb index .0}
+ {-1}}
+ {{.mb index .end}
+ {-1}}
+ {{.mb index .last}
+ {-1}}
+ {{.mb index .help}
+ {-1}}
+ {{.mb delete .0}
+ {bad path:}}
+ {{.mb delete .end}
+ {bad path:}}
+ {{.mb delete .last}
+ {bad path:}}
+ {{.mb delete .help}
+ {bad path:}}
+ {{.mb insert .0 menubutton file -text File}
+ {bad path:}}
+ {{.mb insert .end menubutton file -text File}
+ {bad path:}}
+ {{.mb insert .last menubutton file -text File}
+ {bad path:}}
+ {{.mb insert .help menubutton file -text File}
+ {bad path:}}
+ {{.mb invoke .0.0}
+ {bad path:}}
+ {{.mb invoke .end.0}
+ {bad path:}}
+ {{.mb invoke .last.0}
+ {bad path:}}
+ {{.mb invoke .help.0}
+ {bad path:}}
+ {{.mb menucget .0 -text}
+ {bad path:}}
+ {{.mb menucget .end -text}
+ {bad path:}}
+ {{.mb menucget .last -text}
+ {bad path:}}
+ {{.mb menucget .help -text}
+ {bad path:}}
+ {{.mb menuconfigure .0 -text}
+ {bad path:}}
+ {{.mb menuconfigure .end -text}
+ {bad path:}}
+ {{.mb menuconfigure .last -text}
+ {bad path:}}
+ {{.mb menuconfigure .help -text}
+ {bad path:}}
+ {{.mb path *quit}
+ {}}
+ {{.mb type .0.0}
+ {bad path:}}
+ {{.mb type .0.end}
+ {bad path:}}
+ {{.mb type .0.last}
+ {bad path:}}
+ {{.mb type .0.new}
+ {bad path:}}
+ {{.mb yposition .0.new}
+ {bad path:}}
+ } {
+ set method [lindex [lindex $test 0] 1]
+ set method_invoke [lindex $test 0]
+ test_pattern Menubar-5.$m "\[$method_invoke\]" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+ }
+
+#
+# Method tests which fail and produce errors or results
+# On a non-empty menubar...
+foreach test {
+ {{.mb configure -menubuttons {
+ menubutton file -text File -menu {
+ options -tearoff no
+ command ok -label "Ok"
+ command quit -label "Quit"
+ }
+ }}
+ {}}
+ {{.mb delete .file.hello}
+ {bad path}}
+ {{.mb index .0.hello}
+ {-1}}
+ {{.mb index .0.quit}
+ {1}}
+ {{.mb index 0.end}
+ {1}}
+ {{.mb index .file.last}
+ {1}}
+ {{.mb index .file.ok}
+ {0}}
+ {{.mb delete .view .file}
+ {bad path:}}
+ {{.mb delete .file .help}
+ {bad path:}}
+ {{.mb add command .file.menu}
+ {bad name}}
+ {{.mb add command .file.last}
+ {bad name}}
+ {{.mb add command .file.end}
+ {bad name}}
+ {{.mb add command .file.2}
+ {bad name}}
+ {{.mb insert .0 menu view -text View}
+ {bad type}}
+ {{.mb insert .file command view -text View}
+ {bad entry path}}
+ {{.mb insert .file menubutton view -text View}
+ {[.]mb[.]menubar[.]view}}
+ {{.mb invoke .0.quit}
+ {bad path}}
+ {{.mb menucget .0 -text}
+ {View}}
+ {{.mb menucget .end -text}
+ {File}}
+ {{.mb menucget .last -text}
+ {File}}
+ {{.mb menucget .help -text}
+ {bad path}}
+ {{.mb menuconfigure .0 -text}
+ {-text text Text {} View}}
+ {{.mb menuconfigure .end.last -label}
+ {-label {} {} {} Quit}}
+ {{.mb menuconfigure .last -text}
+ {-text text Text {} File}}
+ {{.mb menuconfigure .help -text}
+ {bad path}}
+ {{.mb path *quit}
+ {[.]file[.]quit}}
+ {{.mb type .end.0}
+ {command}}
+ {{.mb type .end.end}
+ {command}}
+ {{.mb type .end.last}
+ {command}}
+ {{.mb type .0.new}
+ {bad path}}
+ } {
+ set method [lindex [lindex $test 0] 1]
+ set method_invoke [lindex $test 0]
+ test_pattern Menubar-5.$m "\[$method_invoke\]" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+ }
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Menubar-1.$c {Menubar destruction} {
+ destroy .mb
+ update
+} {}
+
+incr c
+
+test Menubar-1.$c {Menubar construction} {
+ iwidgets::Menubar .mb -menubuttons {
+ menubutton file -text File -menu {
+ options -tearoff no
+ command ok -label "Ok"
+ command quit -label "Quit"
+ }
+ }
+ pack .mb
+ update
+ .mb add menubutton .other -text Other -menu {
+ radiobutton r1 -label "Radio One"
+ radiobutton r2 -label "Radio Two"
+ }
+ update
+ .mb add menubutton view -text View -menu {
+ command uno -label Uno
+ command dos -label Dos
+ }
+ update
+ .mb add cascade .view.more -label More -menu {
+ command one -label One
+ command two -label Two
+ cascade extra -label Extra -menu {
+ radiobutton rad1 -label "Choice One"
+ radiobutton rad2 -label "Choice Two"
+ cascade somemore \
+ -label "Some More" \
+ -helpstr "Yet some more" \
+ -menu {
+ command triangle -label "Triangle" -command {puts TRIANGLE}
+ command square -label "Square" -command {puts SQUARE}
+ command octagon -label "Octagon" -command {puts OCTAGON}
+ }
+ }
+ }
+ update
+} {}
+
+incr c
+
+test Menubar-1.$c {Menubar destruction} {
+ destroy .mb
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/messagebox.test b/itcl/iwidgets3.0.0/tests/messagebox.test
new file mode 100644
index 00000000000..b128d6a9f54
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/messagebox.test
@@ -0,0 +1,179 @@
+# This file is a Tcl script to test out [incr Widgets] Messagebox class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Messagebox-1.$c {Messagebox construction} {
+ iwidgets::Messagebox .mb
+ pack .mb -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Messagebox-2.$o {configuration option} {
+ llength [.mb configure]
+} {40}
+
+incr o
+
+foreach test {
+ {-activebackground #ececec #ececec}
+ {-activeforeground Black Black}
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 3 3}
+ {-cursor gumby gumby}
+ {-exportselection 0 0}
+ {-exportselection 1 1}
+ {-filename /tmp/foo /tmp/foo}
+ {-foreground Black Black}
+ {-height 0 0}
+ {-width 0 0}
+ {-width 550 550}
+ {-height 120 120}
+ {-highlightcolor Black Black}
+ {-highlightthickness 2 2}
+ {-labelmargin 5 5}
+ {-labeltext Label Label}
+ {-labelpos nw nw}
+ {-labelpos ne ne}
+ {-labelpos en en}
+ {-labelpos e e}
+ {-labelpos es es}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-labelpos wn wn}
+ {-labelpos w w}
+ {-labelpos ws ws}
+ {-labelpos n n}
+ {-relief raised raised}
+ {-relief sunken sunken}
+ {-vscrollmode none none}
+ {-vscrollmode static static}
+ {-vscrollmode dynamic dynamic}
+ {-hscrollmode none none}
+ {-hscrollmode static static}
+ {-hscrollmode dynamic dynamic}
+ {-maxlines 1200 1200}
+ {-sbwidth 20 20}
+ {-savedir /tmp /tmp}
+ {-scrollmargin 5 5}
+ {-textbackground GhostWhite GhostWhite}} {
+ set option [lindex $test 0]
+ test Messagebox-2.$o "configuration options, $option" {
+ .mb configure $option [lindex $test 1]
+ lindex [.mb configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-visibleitems bogus {bad visibleitems option "bogus": should be widthxheight}}
+ {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}}
+ {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}}} {
+ set option [lindex $test 0]
+ test Messagebox-2.$o "configuration options, $option" {
+ list [catch {.mb configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.mb issue "Default test"} {}}
+ {{.mb type add ERROR -background red -foreground white -bell 1} {ERROR}}
+ {{.mb issue "ERROR test" ERROR} {}}
+ {{.mb type configure ERROR -font 7x13 -show 0} {}}
+ {{.mb issue "ERROR test" ERROR} {}}
+ {{.mb type cget ERROR -background} {red}}
+ {{.mb type remove ERROR} {}}
+ {{.mb clear} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Messagebox-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Method tests which fail and produce errors
+#
+foreach test {
+ {{.mb type bogus bogus} {bad type operation: "bogus", should be add, remove, configure or cget}}
+ {{.mb issue foo bogus} {bad message type: "bogus", use the type command to create a new types}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Messagebox-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Messagebox-1.$c {Messagebox destruction} {
+ destroy .mb
+ update
+} {}
+
+incr c
+
+test Messagebox-1.$c {Messagebox construction} {
+ iwidgets::messagebox .mb -hscrollmode dynamic -labeltext "Label" \
+ -labelpos n -labelmargin 5
+ pack .mb -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Messagebox-1.$c {Messagebox destruction} {
+ destroy .mb
+ update
+} {}
+
+incr c
+
+test Messagebox-1.$c {Messagebox destruction} {
+ iwidgets::messagebox .mb
+ pack .mb
+ destroy .mb
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/messagedialog.test b/itcl/iwidgets3.0.0/tests/messagedialog.test
new file mode 100644
index 00000000000..3f99bea684e
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/messagedialog.test
@@ -0,0 +1,147 @@
+# This file is a Tcl script to test out [incr Widgets] Messagedialog class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+# 4.x - Other tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Messagedialog-1.$c {Messagedialog construction} {
+ iwidgets::Messagedialog .md -text "Are you sure ?" -bitmap questhead
+ image create bitmap flagup -file $tk_library/demos/images/flagup.bmp
+ .md activate
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Messagedialog-2.$o {configuration option} {
+ llength [.md configure]
+} {24}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-buttonboxpos n n}
+ {-buttonboxpadx 10 10}
+ {-buttonboxpos e e}
+ {-buttonboxpos w w}
+ {-buttonboxpady 10 10}
+ {-buttonboxpos s s}
+ {-imagepos n n}
+ {-bitmap warning warning}
+ {-imagepos e e}
+ {-imagepos s s}
+ {-cursor gumby gumby}
+ {-image flagup flagup}
+ {-imagepos w w}
+ {-font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*}
+ {-foreground Black Black}
+ {-modality global global}
+ {-modality application application}
+ {-modality none none}
+ {-padx 15 15}
+ {-pady 15 15}
+ {-textpadx 15 15}
+ {-textpady 15 15}
+ {-separator off off}
+ {-thickness 4 4}
+ {-separator on on}
+ {-image {} {}}
+ {-title Messagedialog Messagedialog}} {
+ set option [lindex $test 0]
+ test Messagedialog-2.$o "configuration options, $option" {
+ .md configure $option [lindex $test 1]
+ lindex [.md configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-imagepos bogus {bad imagepos option "bogus": should be n, e, s, or w}}} {
+ set option [lindex $test 0]
+ test Messagedialog-2.$o "configuration options, $option" {
+ list [catch {.md configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.md childsite} {.md.shellchildsite.dschildsite}}
+ {{.md hide Help} {}}
+ {{.md hide Cancel} {}}
+ {{.md default Apply} {}}
+ {{.md show Cancel} {}}
+ {{.md deactivate} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Messagedialog-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Messagedialog-1.$c {Messagedialog destruction} {
+ destroy .md
+ update
+} {}
+
+incr c
+
+test Messagedialog-1.$c {Messagedialog construction} {
+ iwidgets::Messagedialog .md
+ update
+} {}
+
+incr c
+
+test Messagedialog-1.$c {Messagedialog destruction} {
+ destroy .md
+ image delete flagup
+ update
+} {}
+
+incr c
+
+test Messagedialog-1.$c {Messagedialog construction} {
+ iwidgets::messagedialog .md
+ destroy .md
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/notebook.test b/itcl/iwidgets3.0.0/tests/notebook.test
new file mode 100644
index 00000000000..f19d4a488c1
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/notebook.test
@@ -0,0 +1,294 @@
+# This file is a Tcl script to test out [incr Widgets] Notebook class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Notebook-1.$c {Notebook construction} {
+ iwidgets::Notebook .nb
+ pack .nb
+ update
+ .nb add -label one
+ update
+ .nb add -label two
+ update
+ .nb add -label three
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Notebook-2.$o {configuration option} {
+ llength [.nb configure]
+} {7}
+
+incr o
+
+foreach test {
+ {-width 0 0 }
+ {-background #CDCDB7B7B5B5 #CDCDB7B7B5B5 }
+ {-auto true true }
+ {-height 0 0 }
+ {-scrollcommand }
+ {-cursor }
+ } {
+ set option [lindex $test 0]
+ test Notebook-2.$o "configuration options, $option" {
+ .nb configure $option [lindex $test 1]
+ lindex [.nb configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# PageConfigure Option tests which are successful.
+#
+test Notebook-2.$o {page configuration option} {
+ llength [.nb pageconfigure 0]
+} {8}
+
+# do pageconfigure tests also...
+foreach test {
+ {0 -label Hello Hello}
+ {end -label "Hello World" "Hello World"}
+ } {
+ set index [lindex $test 0]
+ set option [lindex $test 1]
+ test Notebook-2.$o "configuration options, $option" {
+ .nb pageconfigure $index $option [lindex $test 2]
+ lindex [.nb pageconfigure $index $option] 4
+ } [lindex $test 3]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+#foreach test {
+# { -OPTION BADVALUE {ERROR_MESSAGE} }
+# } {
+# set option [lindex $test 0]
+# test Notebook-2.$o "configuration options, $option" {
+# list [catch {.bb configure $option [lindex $test 1]} msg] $msg
+# } [list 1 [lindex $test 2]]
+# incr o
+#}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.nb add}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb add}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb add}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb add -label Never}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb add}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb add -label "Hello World" -disabledforeground gray}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb childsite Never}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb childsite 0}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb childsite end}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb index end}
+ {[0-9]+}}
+ {{.nb index Never}
+ {[0-9]+}}
+ {{.nb index 0}
+ {0}}
+ {{.nb select 0}
+ {0}}
+ {{.nb select select}
+ {0}}
+ {{.nb select end}
+ {[0-9]+}}
+ {{.nb select "Hello World"}
+ {[0-9]+}}
+ {{.nb insert 0}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb insert select -label "An Insert"}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb insert end -label "Next To Last"}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb select 0}
+ {0}}
+ {{.nb next}
+ {1}}
+ {{.nb next}
+ {2}}
+ {{.nb prev}
+ {1}}
+ {{.nb prev}
+ {0}}
+ {{.nb delete Never}
+ {}}
+ {{.nb delete 1 2}
+ {}}
+ {{.nb delete 0 "Hello World"}
+ {}}
+ {{.nb add}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb add}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb add}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb add}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb delete 0 end}
+ {}}
+ {{.nb add}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb add}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb add}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb add}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb select 2}
+ {[-]*[0-9]+}}
+ {{.nb delete select end}
+ {}}
+ {{.nb delete 0 end}
+ {}}
+ {{.nb add -label "First Page"}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb add -label "Second Page"}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb add -label "Third Page"}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb add -label "Fourth Page"}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb add -label "Fifth Page"}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb add -label "Sixth Page"}
+ {[.]nb[.]cs[.]page[0-9]+[.]cs}}
+ {{.nb select "First Page"}
+ {[-]*[0-9]+}}
+ {{.nb delete select "Second Page"}
+ {}}
+ {{.nb delete "Third Page" 1}
+ {}}
+ {{.nb delete "Fifth Page" "Sixth Page"}
+ {}}
+ } {
+ set method [lindex [lindex $test 0] 1]
+ set method_invoke [lindex $test 0]
+ test_pattern Notebook-3.$m "\[$method_invoke\]" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Method tests which fail and produce errors
+#
+foreach test {
+ {{.nb delete 0 end} {}}
+ {{.nb childsite 0} {can't get childsite, no pages}}
+ {{.nb add} {}}
+ {{.nb childsite 1} {bad Notebook page index in childsite method}}
+ {{.nb childsite -1} {bad Notebook page index in childsite method}}
+ {{.nb delete 0} {}}
+ {{.nb delete 0} {can't delete page, no pages}}
+ {{.nb add} {}}
+ {{.nb delete 1} {bad Notebook page index in delete method:}}
+ {{.nb delete select} {bad Notebook page index in delete method:}}
+ {{.nb delete 0} {}}
+ {{.nb add} {}}
+ {{.nb delete 0 1} {bad Notebook page index2 in delete method:}}
+ {{.nb delete 1 4} {bad Notebook page index1 in delete method:}}
+ {{.nb add} {}}
+ {{.nb delete 1 0} {bad Notebook page index1 in delete method: index1 is greater than index2}}
+ {{.nb delete 0 1} {}}
+ {{.nb add} {}}
+ {{.nb delete 0 1 4 5 6} {wrong # args}}
+ {{.nb delete} {wrong # args}}
+ {{.nb delete 0} {}}
+ {{.nb delete 0} {can't delete page}}
+ {{.nb delete select} {can't delete page}}
+ {{.nb insert 0} {can't insert page}}
+ {{.nb add} {}}
+ {{.nb add} {}}
+ {{.nb insert 2} {bad Notebook page index in insert method:}}
+ {{.nb insert -1} {bad Notebook page index}}
+ {{.nb delete 0 end} {}}
+ {{.nb next} {can't move to next page, no pages in the notebook}}
+ {{.nb prev} {can't move to previous page, no pages in the notebook}}
+ {{.nb select 0} {can't select page}}
+ {{.nb add} {}}
+ {{.nb select 1} {bad Notebook page index in select method:}}
+ {{.nb delete 0} {}}
+ } {
+ set method [lindex [lindex $test 0] 1]
+ set method_invoke [lindex $test 0]
+ test_pattern Notebook-3.$m "\[$method_invoke\]" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+ }
+
+
+# Conclusion of constrcution/destruction tests
+#
+test Notebook-1.$c {Notebook destruction} {
+ destroy .nb
+ update
+} {}
+
+incr c
+
+test Notebook-1.$c {Notebook construction} {
+ iwidgets::Notebook .nb -width 100 -height 100
+ pack .nb
+ update
+ .nb add -label one
+ update
+ .nb add -label two
+ update
+ .nb add -label three
+ update
+} {}
+
+incr c
+
+test Notebook-1.$c {Notebook destruction} {
+ destroy .nb
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/optionmenu.test b/itcl/iwidgets3.0.0/tests/optionmenu.test
new file mode 100644
index 00000000000..72d00d55789
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/optionmenu.test
@@ -0,0 +1,176 @@
+# This file is a Tcl script to test out [incr Widgets] Optionmenu class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Optionmenu-1.$c {Optionmenu construction} {
+ iwidgets::Optionmenu .om
+ pack .om -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Optionmenu-2.$o {configuration option} {
+ llength [.om configure]
+} {26}
+
+incr o
+
+foreach test {
+ {-activebackground #ececec #ececec}
+ {-activeborderwidth 2 2}
+ {-activeforeground Black Black}
+ {-labeltext Optionmenu Optionmenu}
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 2 2}
+ {-labelpos w w}
+ {-clicktime 100 100}
+ {-command {.om configure -background Red} {.om configure -background Red}}
+ {-cursor gumby gumby}
+ {-labelpos nw nw}
+ {-cyclicon false false}
+ {-cyclicon true true}
+ {-font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*}
+ {-labelpos n n}
+ {-foreground Black Black}
+ {-labelpos ne ne}
+ {-labelpos se se}
+ {-labelfont -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*}
+ {-labelmargin 5 5}
+ {-labelpos e e}
+ {-state disabled disabled}
+ {-labelpos s s}
+ {-state normal normal}
+ {-labelpos sw sw}
+ {-labelpos w w}
+ {-width 140 140}} {
+ set option [lindex $test 0]
+ test Optionmenu-2.$o "configuration options, $option" {
+ .om configure $option [lindex $test 1]
+ lindex [.om configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-state bogus {bad state option "bogus": should be disabled or normal}}} {
+ set option [lindex $test 0]
+ test Optionmenu-2.$o "configuration options, $option" {
+ list [catch {.om configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.om index 0} 0}
+ {{.om insert end Unix VMS Linux OS/2 {Windows NT} DOS} {}}
+ {{.om index end} 6}
+ {{.om index select} 0}
+ {{.om index OS/2} 3}
+ {{.om delete 0 1} {}}
+ {{.om delete OS/2} {}}
+ {{.om disable 0} {}}
+ {{.om enable 0} {}}
+ {{.om disable DOS} {}}
+ {{.om enable DOS} {}}
+ {{.om select Linux} {}}
+ {{.om get} Linux}
+ {{.om get 1} {Windows NT}}
+ {{.om get 0 end} {Linux {Windows NT} DOS}}
+ {{.om insert 0 Unix VMS} {}}
+ {{.om select 3} {}}
+ {{.om select end} {}}
+ {{.om sort ascending} {}}
+ {{.om sort descending} {}}
+ {{.om sort increasing} {}}
+ {{.om sort decreasing} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Optionmenu-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Method tests which fail and produce errors
+#
+foreach test {
+ {{.om index bogus} {bad Optionmenu index "bogus"}}
+ {{.om sort bogus} {bad sort argument "bogus": should be ascending, descending, increasing, or decreasing}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Optionmenu-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Optionmenu-1.$c {Optionmenu destruction} {
+ destroy .om
+ update
+} {}
+
+incr c
+
+test Optionmenu-1.$c {Optionmenu construction} {
+ iwidgets::optionmenu .om -labeltext "Label" \
+ -labelpos n
+ pack .om -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Optionmenu-1.$c {Optionmenu destruction} {
+ destroy .om
+ update
+} {}
+
+incr c
+
+test Optionmenu-1.$c {Optionmenu destruction} {
+ iwidgets::optionmenu .om
+ pack .om
+ destroy .om
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/panedwindow.test b/itcl/iwidgets3.0.0/tests/panedwindow.test
new file mode 100644
index 00000000000..3cb78bb0248
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/panedwindow.test
@@ -0,0 +1,157 @@
+# This file is a Tcl script to test out [incr Widgets] Panedwindow class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Panedwindow-1.$c {Panedwindow construction} {
+ iwidgets::Panedwindow .pw -width 200 -height 200
+ .pw add top
+ .pw add bottom
+ pack .pw -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Panedwindow-2.$o {configuration option} {
+ llength [.pw configure]
+} {12}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-cursor gumby gumby}
+ {-height 300 300}
+ {-orient vertical vertical}
+ {-sashborderwidth 3 3}
+ {-sashcursor arrow arrow}
+ {-sashheight 12 12}
+ {-sashindent -20 -20}
+ {-sashwidth 12 12}
+ {-thickness 5 5}
+ {-orient horizontal horizontal}
+ {-width 300 300}} {
+ set option [lindex $test 0]
+ test Panedwindow-2.$o "configuration options, $option" {
+ .pw configure $option [lindex $test 1]
+ lindex [.pw configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.pw index 0} {0}}
+ {{.pw index end} {1}}
+ {{.pw index top} {0}}
+ {{.pw index b*} {1}}
+ {{.pw childsite 0} {.pw.pane0.childsite}}
+ {{.pw childsite end} {.pw.pane1.childsite}}
+ {{.pw childsite 1} {.pw.pane1.childsite}}
+ {{.pw childsite} {.pw.pane0.childsite .pw.pane1.childsite}}
+ {{.pw fraction 25 75} {}}
+ {{.pw add middle -margin 10 -minimum 10} {.pw.pane2}}
+ {{.pw delete middle} {}}
+ {{.pw insert 1 middle} {.pw.pane3}}
+ {{.pw fraction 20 30 50} {}}
+ {{.pw reset} {}}
+ {{.pw hide end} {}}
+ {{.pw show bottom} {}}
+ {{.pw paneconfigure 0 -minimum} {-minimum minimum Minimum 10 10}}
+ {{.pw paneconfigure end -margin 10} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Panedwindow-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Method tests which fail and produce errors
+#
+foreach test {
+ {{.pw index 5} {Panedwindow index "5" is out of range}}
+ {{.pw index bogus} {bad Panedwindow index "bogus": must be number, end, or pattern}}
+ {{.pw fraction 10 20 30} {bad fraction arguments "10 20 30": they should add up to 100}}
+ {{.pw fraction 10 20} {wrong # args: should be ".pw fraction percentage percentage ?percentage ...?", where the number of percentages is 3 and equal 100}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Panedwindow-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Panedwindow-1.$c {Panedwindow destruction} {
+ destroy .pw
+ update
+} {}
+
+incr c
+
+test Panedwindow-1.$c {Panedwindow construction} {
+ iwidgets::panedwindow .pw -width 200 -height 300
+ .pw add pane0
+ .pw add pane1
+ .pw add pane2
+ .pw add pane3
+ foreach pane [.pw childsite] {
+ button $pane.b -text $pane -relief raised -borderwidth 3
+ pack $pane.b -fill both -expand yes
+ }
+ .pw fraction 20 20 30 30
+ pack .pw -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Panedwindow-1.$c {Panedwindow destruction} {
+ destroy .pw
+ update
+} {}
+
+incr c
+
+test Panedwindow-1.$c {Panedwindow destruction} {
+ iwidgets::panedwindow .pw
+ pack .pw
+ destroy .pw
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/promptdialog.test b/itcl/iwidgets3.0.0/tests/promptdialog.test
new file mode 100644
index 00000000000..e519dbabcef
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/promptdialog.test
@@ -0,0 +1,159 @@
+# This file is a Tcl script to test out [incr Widgets] Promptdialog class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+# 4.x - Other tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Promptdialog-1.$c {Promptdialog construction} {
+ iwidgets::Promptdialog .pd
+ .pd activate
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Promptdialog-2.$o {configuration option} {
+ llength [.pd configure]
+} {38}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-buttonboxpos n n}
+ {-buttonboxpadx 10 10}
+ {-buttonboxpos e e}
+ {-buttonboxpos w w}
+ {-buttonboxpady 10 10}
+ {-buttonboxpos s s}
+ {-cursor gumby gumby}
+ {-exportselection 1 1}
+ {-modality global global}
+ {-modality application application}
+ {-modality none none}
+ {-padx 15 15}
+ {-pady 15 15}
+ {-separator off off}
+ {-thickness 5 5}
+ {-separator on on}
+ {-title "Prompt Dialog" "Prompt Dialog"}
+ {-foreground Black Black}
+ {-textbackground GhostWhite GhostWhite}
+ {-insertbackground Black Black}
+ {-insertborderwidth 1 1}
+ {-insertborderwidth 0 0}
+ {-insertofftime 400 400}
+ {-insertontime 700 700}
+ {-insertwidth 3 3}
+ {-labelpos nw nw}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos en en}
+ {-labelpos e e}
+ {-labelpos es es}
+ {-labelpos sw sw}
+ {-labelpos s s}
+ {-labelpos se se}
+ {-labelpos wn wn}
+ {-labelpos w w}
+ {-labelpos ws ws}
+ {-labeltext Label Label}
+ {-relief sunken sunken}
+ {-textbackground GhostWhite GhostWhite}
+ {-validate numeric numeric}
+ {-validate alphabetic alphabetic}
+ {-validate alphanumeric alphanumeric}} {
+ set option [lindex $test 0]
+ test Promptdialog-2.$o "configuration options, $option" {
+ .pd configure $option [lindex $test 1]
+ lindex [.pd configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.pd childsite} {.pd.shellchildsite.dschildsite}}
+ {{.pd insert end "Test String"} {}}
+ {{.pd get} {Test String}}
+ {{.pd delete 0 end} {}}
+ {{.pd insert end "Another Test"} {}}
+ {{.pd icursor end} {}}
+ {{.pd index end} 12}
+ {{.pd selection from 0} {}}
+ {{.pd selection to end} {}}
+ {{.pd xview 3} {}}
+ {{.pd clear} {}}
+ {{.pd hide Help} {}}
+ {{.pd hide Cancel} {}}
+ {{.pd default Apply} {}}
+ {{.pd show Cancel} {}}
+ {{.pd deactivate} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Promptdialog-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Promptdialog-1.$c {Promptdialog destruction} {
+ destroy .pd
+ update
+} {}
+
+incr c
+
+test Promptdialog-1.$c {Promptdialog construction} {
+ iwidgets::promptdialog .pd
+ update
+} {}
+
+incr c
+
+test Promptdialog-1.$c {Promptdialog destruction} {
+ destroy .pd
+ update
+} {}
+
+incr c
+
+test Promptdialog-1.$c {Promptdialog destruction} {
+ iwidgets::promptdialog .pd
+ destroy .pd
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/pushbutton.test b/itcl/iwidgets3.0.0/tests/pushbutton.test
new file mode 100644
index 00000000000..4f341233ed1
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/pushbutton.test
@@ -0,0 +1,136 @@
+# This file is a Tcl script to test out [incr Widgets] Pushbutton class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Pushbutton-1.$c {Pushbutton construction} {
+ iwidgets::Pushbutton .pb
+ pack .pb -padx 10 -pady 10
+ image create bitmap flagup -file $tk_library/demos/images/flagup.bmp
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Pushbutton-2.$o {configuration option} {
+ llength [.pb configure]
+} {27}
+
+incr o
+
+foreach test {
+ {-activebackground #ececec #ececec}
+ {-activeforeground Black Black}
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 2 2}
+ {-command {.pb configure -background Red} {.pb configure -background Red}}
+ {-defaultring 1 1}
+ {-text Hello Hello}
+ {-width 100 100}
+ {-bitmap error error}
+ {-image flagup flagup}
+ {-defaultring 0 0}
+ {-padx 10 10}
+ {-padx 8 8}
+ {-pady 8 8}
+ {-pady 4 4}
+ {-image {} {}}
+ {-cursor gumby gumby}
+ {-bitmap {} {}}
+ {-font 6x13 6x13}
+ {-foreground Black Black}
+ {-height 70 70}
+ {-width 100 100}
+ {-underline 0 0}
+ {-highlightthickness 3 3}
+ {-highlightcolor blue blue}
+ {-highlightcolor black black}
+ {-highlightthickness 2 2}
+ {-state disabled disabled}
+ {-state normal normal}
+ {-defaultringpad 6 6}
+ {-width 120 120}} {
+ set option [lindex $test 0]
+ test Pushbutton-2.$o "configuration options, $option" {
+ .pb configure $option [lindex $test 1]
+ lindex [.pb configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.pb flash} {}}
+ {{.pb invoke} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Pushbutton-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Pushbutton-1.$c {Pushbutton destruction} {
+ destroy .pb
+ update
+ image delete flagup
+} {}
+
+incr c
+
+test Pushbutton-1.$c {Pushbutton construction} {
+ iwidgets::pushbutton .pb -text "Push Button" -defaultring yes
+ pack .pb -padx 10 -pady 10
+ update
+} {}
+
+incr c
+
+test Pushbutton-1.$c {Pushbutton destruction} {
+ destroy .pb
+ update
+} {}
+
+incr c
+
+test Pushbutton-1.$c {Pushbutton destruction} {
+ iwidgets::pushbutton .pb
+ pack .pb
+ destroy .pb
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/radiobox.test b/itcl/iwidgets3.0.0/tests/radiobox.test
new file mode 100644
index 00000000000..4f385c8bb2f
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/radiobox.test
@@ -0,0 +1,137 @@
+# This file is a Tcl script to test out [incr Widgets] Radiobox class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Radiobox-1.$c {Radiobox construction} {
+ iwidgets::Radiobox .rb -labeltext "Radiobox"
+ pack .rb -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Radiobox-2.$o {configuration option} {
+ llength [.rb configure]
+} {18}
+
+incr o
+
+test Radiobox-1.$c {Radiobox add method} {
+ .rb add foo -text Foo
+ .rb add bar -text Bar
+ update
+} {}
+
+incr m
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 4 4}
+ {-borderwidth 2 2}
+ {-cursor gumby gumby}
+ {-foreground Green Green}
+ {-foreground Black Black}
+ {-labelmargin 5 5}
+ {-labelpos w w}
+ {-labelpos nw nw}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos e e}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-labeltext Label Label}
+ {-relief raised raised}
+ {-relief sunken sunken}} {
+ set option [lindex $test 0]
+ test Radiobox-2.$o "configuration options, $option" {
+ .rb configure $option [lindex $test 1]
+ lindex [.rb configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.rb insert bar zoo -text Zoo} zoo}
+ {{.rb index z*} 1}
+ {{.rb select foo} {}}
+ {{.rb get} foo}
+ {{.rb delete end} {}}
+ {{.rb deselect foo} {}}
+ {{.rb get} {}}
+ {{.rb index end} 1}
+ {{.rb flash 1} {}}
+ {{.rb buttonconfigure foo -text FOO} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Radiobox-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Radiobox-1.$c {Radiobox destruction} {
+ destroy .rb
+ update
+} {}
+
+incr c
+
+test Radiobox-1.$c {Radiobox construction} {
+ iwidgets::radiobox .rb
+ pack .rb -padx 10 -pady 10
+ update
+} {}
+
+incr c
+
+test Radiobox-1.$c {Radiobox destruction} {
+ destroy .rb
+ update
+} {}
+
+incr c
+
+test Radiobox-1.$c {Radiobox destruction} {
+ iwidgets::radiobox .rb
+ pack .rb
+ destroy .rb
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/regexpfield.test b/itcl/iwidgets3.0.0/tests/regexpfield.test
new file mode 100755
index 00000000000..9a17a262535
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/regexpfield.test
@@ -0,0 +1,172 @@
+# This file is a Tcl script to test out [incr Widgets] Regexpfield class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Regexpfield-1.$c {Regexpfield construction} {
+ iwidgets::Regexpfield .ef -labeltext "Entry Field"
+ .ef insert end test
+ pack .ef -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Regexpfield-2.$o {configuration option} {
+ llength [.ef configure]
+} {39}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 4 4}
+ {-borderwidth 2 2}
+ {-childsitepos e e}
+ {-childsitepos s s}
+ {-childsitepos w w}
+ {-childsitepos n n}
+ {-command {.ef configure -background red} {.ef configure -background red}}
+ {-cursor gumby gumby}
+ {-exportselection 0 0}
+ {-fixed 10 10}
+ {-fixed 0 0}
+ {-foreground Green Green}
+ {-foreground Black Black}
+ {-highlightcolor Red Red}
+ {-highlightthickness 2 2}
+ {-insertbackground Yellow Yellow}
+ {-insertbackground Black Black}
+ {-insertborderwidth 1 1}
+ {-insertborderwidth 0 0}
+ {-insertofftime 400 400}
+ {-insertontime 700 700}
+ {-insertwidth 3 3}
+ {-invalid {.ef configure -background Green} {.ef configure -background Green}}
+ {-justify right right}
+ {-justify center center}
+ {-justify left left}
+ {-labelmargin 5 5}
+ {-labelpos w w}
+ {-labelpos nw nw}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos e e}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-labeltext Label Label}
+ {-relief raised raised}
+ {-relief sunken sunken}
+ {-state disabled disabled}
+ {-state normal normal}
+ {-textbackground GhostWhite GhostWhite}
+ {-regexp {.*} {.*}}
+ {-nocase 0 0}
+ {-width 30 30}} {
+ set option [lindex $test 0]
+ test Regexpfield-2.$o "configuration options, $option" {
+ .ef configure $option [lindex $test 1]
+ lindex [.ef configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-fixed bogus {bad fixed option "bogus", should be positive integer}}
+ {-childsitepos bogus {bad childsite option "bogus": should be n, e, s, or w}}} {
+ set option [lindex $test 0]
+ test Regexpfield-2.$o "configuration options, $option" {
+ list [catch {.ef configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.ef childsite} {.ef.lwchildsite.efchildsite}}
+ {{.ef clear} {}}
+ {{.ef insert end "Test String"} {}}
+ {{.ef get} {Test String}}
+ {{.ef delete 0 end} {}}
+ {{.ef insert end "Another Test"} {}}
+ {{.ef icursor end} {}}
+ {{.ef index end} 12}
+ {{.ef selection from 0} {}}
+ {{.ef selection to end} {}}
+ {{.ef xview 3} {}}
+ {{.ef clear} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Regexpfield-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Regexpfield-1.$c {Regexpfield destruction} {
+ destroy .ef
+ update
+} {}
+
+incr c
+
+test Regexpfield-1.$c {Regexpfield construction} {
+ iwidgets::regexpfield .ef -width 12
+ pack .ef -padx 10 -pady 10
+ update
+} {}
+
+incr c
+
+test Regexpfield-1.$c {Regexpfield destruction} {
+ destroy .ef
+ update
+} {}
+
+incr c
+
+test Regexpfield-1.$c {Regexpfield destruction} {
+ iwidgets::regexpfield .ef
+ pack .ef
+ destroy .ef
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/scrolledcanvas.test b/itcl/iwidgets3.0.0/tests/scrolledcanvas.test
new file mode 100644
index 00000000000..24d999f2061
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/scrolledcanvas.test
@@ -0,0 +1,169 @@
+# This file is a Tcl script to test out [incr Widgets] ScrolledListBox class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Scrolledcanvas-1.$c {Scrolledcanvas construction} {
+ iwidgets::Scrolledcanvas .sc
+ pack .sc -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Scrolledcanvas-2.$o {configuration option} {
+ llength [.sc configure]
+} {44}
+
+incr o
+
+foreach test {
+ {-automargin 15 15}
+ {-autoresize 0 0}
+ {-autoresize 1 1}
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 2 2}
+ {-closeenough 1.0 1.0}
+ {-confine 1 1}
+ {-cursor gumby gumby}
+ {-height 200 200}
+ {-hscrollmode none none}
+ {-hscrollmode static static}
+ {-hscrollmode dynamic dynamic}
+ {-labelfont 6x13 6x13}
+ {-labeltext scrolledcanvas scrolledcanvas}
+ {-labelmargin 3 3}
+ {-labelpos nw nw}
+ {-labelpos ne ne}
+ {-labelpos en en}
+ {-labelpos e e}
+ {-labelpos es es}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-labelpos wn wn}
+ {-labelpos w w}
+ {-labelpos ws ws}
+ {-labelpos n n}
+ {-relief raised raised}
+ {-relief sunken sunken}
+ {-sbwidth 15 15}
+ {-xscrollincrement 10 10}
+ {-yscrollincrement 10 10}
+ {-scrollmargin 3 3}
+ {-scrollregion {0 0 0 0} {0 0 0 0}}
+ {-textbackground GhostWhite GhostWhite}
+ {-vscrollmode static static}
+ {-vscrollmode none none}
+ {-vscrollmode dynamic dynamic}
+ {-width 200 200}} {
+ set option [lindex $test 0]
+ test Scrolledcanvas-2.$o "configuration options, $option" {
+ .sc configure $option [lindex $test 1]
+ lindex [.sc configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}}
+ {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}}} {
+ set option [lindex $test 0]
+ test Scrolledcanvas-2.$o "configuration options, $option" {
+ list [catch {.sc configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.sc create rectangle 100 100 400 400 -fill red} {1}}
+ {{.sc create rectangle 300 300 600 600 -fill green} {2}}
+ {{.sc create rectangle 200 200 500 500 -fill blue} {3}}
+ {{.sc bbox 1} {99 99 401 401}}
+ {{.sc coords 2} {300.0 300.0 600.0 600.0}}
+ {{.sc delete 3} {}}
+ {{.sc move 1 10 10} {}}
+ {{.sc scale 1 100 100 0.8 0.8} {}}
+ {{.sc xview moveto 0} {}}
+ {{.sc yview moveto 0} {}}
+ {{.sc childsite} {.sc.lwchildsite.clipper.canvas}}
+ {{.sc justify left} {}}
+ {{.sc justify right} {}}
+ {{.sc justify top} {}}
+ {{.sc justify bottom} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Scrolledcanvas-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Scrolledcanvas-1.$c {Scrolledcanvas destruction} {
+ destroy .sc
+ update
+} {}
+
+incr c
+
+test Scrolledcanvas-1.$c {Scrolledcanvas construction} {
+ iwidgets::Scrolledcanvas .sc -autoresize no -labelpos nw \
+ -vscrollmode static -hscrollmode dynamic -labeltext "Scrolledcanvas"
+ pack .sc -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Scrolledcanvas-1.$c {Scrolledcanvas destruction} {
+ destroy .sc
+ update
+} {}
+
+incr c
+
+test Scrolledcanvas-1.$c {Scrolledcanvas destruction} {
+ iwidgets::scrolledcanvas .sc
+ pack .sc
+ destroy .sc
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/scrolledframe.test b/itcl/iwidgets3.0.0/tests/scrolledframe.test
new file mode 100644
index 00000000000..8b0623594b6
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/scrolledframe.test
@@ -0,0 +1,198 @@
+# This file is a Tcl script to test out [incr Widgets] Scrolledframe class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Scrolledframe-1.$c {Scrolledframe construction} {
+ iwidgets::Scrolledframe .sf
+ pack .sf -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Scrolledframe-2.$o {configuration option} {
+ llength [.sf configure]
+} {27}
+
+incr o
+
+foreach test {
+ {-borderwidth 3 3}
+ {-height 180 180}
+ {-labeltext "Scrolled Frame" "Scrolled Frame"}
+ {-labelpos nw nw}
+ {-labelpos ne ne}
+ {-labelpos en en}
+ {-labelpos e e}
+ {-labelpos es es}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-labelpos wn wn}
+ {-labelpos w w}
+ {-labelpos ws ws}
+ {-labelpos n n}
+ {-hscrollmode static static}
+ {-hscrollmode none none}
+ {-hscrollmode dynamic dynamic}
+ {-relief raised raised}
+ {-sbwidth 20 20}
+ {-relief sunken sunken}
+ {-scrollmargin 10 10}
+ {-vscrollmode static static}
+ {-vscrollmode none none}
+ {-vscrollmode dynamic dynamic}
+ {-width 150 150}} {
+ set option [lindex $test 0]
+ test Scrolledframe-2.$o "configuration options, $option" {
+ .sf configure $option [lindex $test 1]
+ lindex [.sf configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}}
+ {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}}} {
+ set option [lindex $test 0]
+ test Scrolledframe-2.$o "configuration options, $option" {
+ list [catch {.sf configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.sf childsite} {.sf.lwchildsite.clipper.canvas.sfchildsite}}
+ {{.sf xview moveto .5} {}}
+ {{.sf yview moveto .5} {}}
+ {{.sf justify left} {}}
+ {{.sf justify right} {}}
+ {{.sf justify top} {}}
+ {{.sf justify bottom} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Scrolledframe-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Creation of children tests.
+#
+test Scrolledframe-1.$c {Scrolledframe children} {
+ pack [button [.sf childsite].b1 -text Hello] -pady 10
+ update
+} {}
+
+incr c
+
+test Scrolledframe-1.$c {Scrolledframe children} {
+ pack [button [.sf childsite].b2 -text World] -pady 10
+ update
+} {}
+
+incr c
+
+test Scrolledframe-1.$c {Scrolledframe children} {
+ pack [button [.sf childsite].b3 -text "This is a test"] -pady 10
+ update
+} {}
+
+incr c
+
+test Scrolledframe-1.$c {Scrolledframe children} {
+ pack [button [.sf childsite].b4 -text "This is a really big button"] -pady 10
+ update
+} {}
+
+incr c
+
+test Scrolledframe-1.$c {Scrolledframe children} {
+ pack [button [.sf childsite].b5 -text "This is another really big button"] -pady 10
+ update
+} {}
+
+incr c
+
+test Scrolledframe-1.$c {Scrolledframe children} {
+ pack [button [.sf childsite].b6 -text "This is the last really big button"] -pady 10
+ update
+} {}
+
+incr c
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Scrolledframe-1.$c {Scrolledframe destruction} {
+ foreach child [winfo children [.sf childsite]] {
+ destroy $child
+ }
+
+ destroy .sf
+ update
+} {}
+
+incr c
+
+test Scrolledframe-1.$c {Scrolledframe construction} {
+ iwidgets::scrolledframe .sf -width 150 -height 180 \
+ -labelpos nw -labeltext Scrolledframe \
+ -vscrollmode static -hscrollmode dynamic
+ pack .sf -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Scrolledframe-1.$c {Scrolledframe destruction} {
+ destroy .sf
+ update
+} {}
+
+incr c
+
+test Scrolledframe-1.$c {Scrolledframe destruction} {
+ iwidgets::scrolledframe .sf
+ pack .sf
+ destroy .sf
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/scrolledhtml.test b/itcl/iwidgets3.0.0/tests/scrolledhtml.test
new file mode 100644
index 00000000000..c4862cde725
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/scrolledhtml.test
@@ -0,0 +1,197 @@
+# This file is a Tcl script to test out [incr Widgets] Scrolledhtml class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id: scrolledhtml.test
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Scrolledhtml-1.$c {Scrolledhtml construction} {
+ iwidgets::Scrolledhtml .sh
+ pack .sh -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Scrolledhtml-2.$o {configuration option} {
+ llength [.sh configure]
+} {57}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 3 3}
+ {-cursor gumby gumby}
+ {-exportselection 0 0}
+ {-exportselection 1 1}
+ {-foreground Black Black}
+ {-height 120 120}
+ {-width 500 500}
+ {-insertbackground Black Black}
+ {-insertborderwidth 1 1}
+ {-insertofftime 200 200}
+ {-insertontime 500 500}
+ {-insertwidth 3 3}
+ {-labelmargin 5 5}
+ {-labeltext Label Label}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos e e}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-labelpos w w}
+ {-labelpos nw nw}
+ {-relief raised raised}
+ {-relief sunken sunken}
+ {-vscrollmode none none}
+ {-vscrollmode static static}
+ {-vscrollmode dynamic dynamic}
+ {-hscrollmode none none}
+ {-hscrollmode static static}
+ {-hscrollmode dynamic dynamic}
+ {-sbwidth 20 20}
+ {-scrollmargin 5 5}
+ {-selectborderwidth 2 2}
+ {-state disabled disabled}
+ {-state normal normal}
+ {-textbackground GhostWhite GhostWhite}
+ {-visibleitems 72x40 72x40}
+ {-height 0 0}
+ {-width 0 0}
+ {-wrap char char}
+ {-wrap none none}
+ {-feedback puts puts}
+ {-feedback {} {}}
+ {-linkcommand puts puts}
+ {-linkcommand {} {}}
+ {-unknownimage {} {}}
+ {-link blue blue}
+ {-linkhighlight red red}
+ {-fontname times times}
+ {-fixedfont courier courier}
+ {-fontsize medium medium}
+ {-update 1 1}} {
+ set option [lindex $test 0]
+ test Scrolledhtml-2.$o "configuration options, $option" {
+ .sh configure $option [lindex $test 1]
+ lindex [.sh configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-visibleitems bogus {bad visibleitems option "bogus": should be widthxheight}}
+ {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}}
+ {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}}
+ {-fontname bogus {Invalid font name "bogus". Must be one of helvetica courier times symbol}}
+ {-fontsize bogus {bad fontsize option "bogus": should be small, medium, large, or huge}}
+ {-fixedfont bogus {Invalid font name "bogus". Must be one of helvetica courier times symbol}}} {
+ set option [lindex $test 0]
+ test Scrolledhtml-2.$o "configuration options, $option" {
+ list [catch {.sh configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.sh import ./scrolledhtml.test} {}}
+ {{.sh pwd} {.}}
+ {{.sh export /tmp/scrolledhtml.test} {}}
+ {{.sh render {
+ <title>Test</title>
+ <body bgcolor="#000000" link="#40a0f0" text="#00d0d0" background="notyet.gif">
+ <h1>This is a test</h1>
+ <strong>of the emergency broadcast system.</strong>
+ <em>This is only a test.</em><p>
+ <tt>If this were a real html document</tt><br>
+ <pre>it would be displayed</pre><br>
+ <center>for more than an instant</center>
+ <blockquote>Four score and seven years ago</blockquote>
+ <code>int main { printf(\&quotHello World!\&quot);}</code>
+ <dl><dt>write only memory
+ <dd>the obvious antonym to read-only memory</dl>
+ <ol>reasons this is a short list:<li>it only has one entry</ol>
+ <ul>reasons this is a short list:<li>it only has one entry</ul>
+ <a name="linktome" href="./test.html#linktome">
+ <img src="invalid.filename" alt="No_image_here" width=100 height=100>
+ </a>
+ </body>
+ }} {}}
+ {{.sh title} {Test}}
+ {{.sh clear} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Scrolledhtml-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of construction/destruction tests
+#
+test Scrolledhtml-1.$c {Scrolledhtml destruction} {
+ destroy .sh
+ update
+} {}
+
+incr c
+
+test Scrolledhtml-1.$c {Scrolledhtml construction} {
+ iwidgets::scrolledhtml .sh -hscrollmode dynamic -labeltext "Label" \
+ -labelpos n -labelmargin 5
+ pack .sh -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Scrolledhtml-1.$c {Scrolledhtml destruction} {
+ destroy .sh
+ update
+} {}
+
+incr c
+
+test Scrolledhtml-1.$c {Scrolledhtml destruction} {
+ iwidgets::scrolledhtml .sh
+ pack .sh
+ destroy .sh
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/scrolledlistbox.test b/itcl/iwidgets3.0.0/tests/scrolledlistbox.test
new file mode 100644
index 00000000000..0504b1deccd
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/scrolledlistbox.test
@@ -0,0 +1,200 @@
+# This file is a Tcl script to test out [incr Widgets] Scrolledlistbox class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Scrolledlistbox-1.$c {Scrolledlistbox construction} {
+ iwidgets::Scrolledlistbox .slb -height 300 -width 300
+ pack .slb -padx 10 -pady 10 -fill both -expand yes
+ .slb insert end {Hello World} {Hello World}
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Scrolledlistbox-2.$o {configuration option} {
+ llength [.slb configure]
+} {38}
+
+incr o
+
+foreach test {
+ {-labeltext Scrolledlistbox Scrolledlistbox}
+ {-height 200 200}
+ {-width 200 200}
+ {-labelpos nw nw}
+ {-labelpos ne ne}
+ {-labelpos en en}
+ {-labelpos e e}
+ {-labelpos es es}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-labelpos wn wn}
+ {-labelpos w w}
+ {-labelpos ws ws}
+ {-labelpos n n}
+ {-borderwidth 3 3}
+ {-hscrollmode none none}
+ {-hscrollmode static static}
+ {-hscrollmode dynamic dynamic}
+ {-relief raised raised}
+ {-relief sunken sunken}
+ {-sbwidth 20 20}
+ {-sbwidth 15 15}
+ {-textbackground GhostWhite GhostWhite}
+ {-scrollmargin 10 10}
+ {-selectborderwidth 3 3}
+ {-selectforeground blue blue}
+ {-selectmode browse browse}
+ {-selectmode extended extended}
+ {-selectmode single single}
+ {-selectmode multiple multiple}
+ {-textfont 6x13 6x13}
+ {-vscrollmode none none}
+ {-vscrollmode static static}
+ {-vscrollmode dynamic dynamic}
+ {-visibleitems 30x20 30x20}
+ {-width 0 0}
+ {-height 0 0}} {
+ set option [lindex $test 0]
+ test Scrolledlistbox-2.$o "configuration options, $option" {
+ .slb configure $option [lindex $test 1]
+ lindex [.slb configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-visibleitems bogus {bad visibleitems option "bogus": should be widthxheight}}
+ {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}}
+ {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}}} {
+ set option [lindex $test 0]
+ test Scrolledlistbox-2.$o "configuration options, $option" {
+ list [catch {.slb configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.slb insert 0 Test Test Test Test} {}}
+ {{.slb insert end {More Test}} {}}
+ {{.slb delete 1} {}}
+ {{.slb delete 0 3} {}}
+ {{.slb insert end World} {}}
+ {{.slb selection set World} {}}
+ {{.slb selection set World {More Test}} {}}
+ {{.slb getcurselection} {{More Test} World}}
+ {{.slb selecteditemcount} {2}}
+ {{.slb selection clear 0 end} {}}
+ {{.slb selecteditemcount} {0}}
+ {{.slb clear} {}}
+ {{.slb size} {0}}
+ {{.slb insert end {Test} {Test} {Long String Test}} {}}
+ {{.slb size} {3}}
+ {{.slb insert 0 {Test} {Test} {Long String Test}} {}}
+ {{.slb size} {6}}
+ {{.slb insert 1 {Test} {Test} {Long String Test}} {}}
+ {{.slb size} {9}}
+ {{.slb insert 5 {Test} {Test} {XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX}} {}}
+ {{.slb size} {12}}
+ {{.slb get end} {Long String Test}}
+ {{.slb justify left} {}}
+ {{.slb justify right} {}}
+ {{.slb justify top} {}}
+ {{.slb justify bottom} {}}
+ {{.slb sort ascending} {}}
+ {{.slb sort descending} {}}
+ {{.slb sort increasing} {}}
+ {{.slb sort decreasing} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Scrolledlistbox-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Method tests which fail and produce errors
+#
+foreach test {
+ {{.slb index bogus} {bad Scrolledlistbox index "bogus": must be active, anchor, end, @x,y, number, or a pattern}}
+ {{.slb justify bogus} {bad justify argument "bogus": should be left, right, top, or bottom}}
+ {{.slb sort bogus} {bad sort argument "bogus": should be ascending, descending, increasing, or decreasing}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Scrolledlistbox-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Scrolledlistbox-1.$c {Scrolledlistbox destruction} {
+ destroy .slb
+ update
+} {}
+
+incr c
+
+test Scrolledlistbox-1.$c {Scrolledlistbox construction} {
+ iwidgets::scrolledlistbox .slb -selectmode extended \
+ -vscrollmode static -hscrollmode dynamic -labeltext "List" \
+ -labelpos nw
+ pack .slb -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Scrolledlistbox-1.$c {Scrolledlistbox destruction} {
+ destroy .slb
+ update
+} {}
+
+incr c
+
+test Scrolledlistbox-1.$c {Scrolledlistbox destruction} {
+ iwidgets::scrolledlistbox .slb
+ pack .slb
+ destroy .slb
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/scrolledtext.test b/itcl/iwidgets3.0.0/tests/scrolledtext.test
new file mode 100644
index 00000000000..761e6ccec48
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/scrolledtext.test
@@ -0,0 +1,165 @@
+# This file is a Tcl script to test out [incr Widgets] Scrolledtext class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Scrolledtext-1.$c {Scrolledtext construction} {
+ iwidgets::Scrolledtext .st
+ pack .st -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Scrolledtext-2.$o {configuration option} {
+ llength [.st configure]
+} {47}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 3 3}
+ {-cursor gumby gumby}
+ {-exportselection 0 0}
+ {-exportselection 1 1}
+ {-foreground Black Black}
+ {-height 120 120}
+ {-width 500 500}
+ {-insertbackground Black Black}
+ {-insertborderwidth 1 1}
+ {-insertofftime 200 200}
+ {-insertontime 500 500}
+ {-insertwidth 3 3}
+ {-labelmargin 5 5}
+ {-labeltext Label Label}
+ {-labelpos nw nw}
+ {-labelpos ne ne}
+ {-labelpos en en}
+ {-labelpos e e}
+ {-labelpos es es}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-labelpos wn wn}
+ {-labelpos w w}
+ {-labelpos ws ws}
+ {-labelpos n n}
+ {-relief raised raised}
+ {-relief sunken sunken}
+ {-vscrollmode none none}
+ {-vscrollmode static static}
+ {-vscrollmode dynamic dynamic}
+ {-hscrollmode none none}
+ {-hscrollmode static static}
+ {-hscrollmode dynamic dynamic}
+ {-sbwidth 20 20}
+ {-scrollmargin 5 5}
+ {-selectborderwidth 2 2}
+ {-state disabled disabled}
+ {-state normal normal}
+ {-textbackground GhostWhite GhostWhite}
+ {-visibleitems 72x40 72x40}
+ {-height 0 0}
+ {-width 0 0}
+ {-wrap char char}
+ {-wrap none none}} {
+ set option [lindex $test 0]
+ test Scrolledtext-2.$o "configuration options, $option" {
+ .st configure $option [lindex $test 1]
+ lindex [.st configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-visibleitems bogus {bad visibleitems option "bogus": should be widthxheight}}
+ {-hscrollmode bogus {bad hscrollmode option "bogus": should be static, dynamic, or none}}
+ {-vscrollmode bogus {bad vscrollmode option "bogus": should be static, dynamic, or none}}} {
+ set option [lindex $test 0]
+ test Scrolledtext-2.$o "configuration options, $option" {
+ list [catch {.st configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.st import ./scrolledtext.test} {}}
+ {{.st export /tmp/scrolledtext.test} {}}
+ {{.st clear} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Scrolledtext-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Scrolledtext-1.$c {Scrolledtext destruction} {
+ destroy .st
+ update
+} {}
+
+incr c
+
+test Scrolledtext-1.$c {Scrolledtext construction} {
+ iwidgets::scrolledtext .st -hscrollmode dynamic -labeltext "Label" \
+ -labelpos n -labelmargin 5
+ pack .st -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Scrolledtext-1.$c {Scrolledtext destruction} {
+ destroy .st
+ update
+} {}
+
+incr c
+
+test Scrolledtext-1.$c {Scrolledtext destruction} {
+ iwidgets::scrolledtext .st
+ pack .st
+ destroy .st
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/selectionbox.test b/itcl/iwidgets3.0.0/tests/selectionbox.test
new file mode 100644
index 00000000000..6c400476157
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/selectionbox.test
@@ -0,0 +1,174 @@
+# This file is a Tcl script to test out [incr Widgets] Selectionbox class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Selectionbox-1.$c {Selectionbox construction} {
+ iwidgets::Selectionbox .sb
+ .sb insert items end Hello {Out There} World
+ set cs [label [.sb childsite].label -text "Child Site"]
+ pack $cs -fill x -padx 10 -pady 10
+ pack .sb -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Selectionbox-2.$o {configuration option} {
+ llength [.sb configure]
+} {35}
+
+incr o
+
+foreach test {
+ {-width 280 280}
+ {-height 340 340}
+ {-activebackground #ececec #ececec}
+ {-activerelief raised raised}
+ {-background #d9d9d9 #d9d9d9}
+ {-textbackground GhostWhite GhostWhite}
+ {-borderwidth 2 2}
+ {-childsitepos n n}
+ {-childsitepos s s}
+ {-childsitepos e e}
+ {-childsitepos w w}
+ {-childsitepos center center}
+ {-cursor gumby gumby}
+ {-dblclickcommand {.sb configure -background blue} {.sb configure -background blue}}
+ {-exportselection 1 1}
+ {-foreground Black Black}
+ {-highlightcolor Black Black}
+ {-highlightthickness 2 2}
+ {-insertbackground Black Black}
+ {-insertborderwidth 0 0}
+ {-insertofftime 300 300}
+ {-insertontime 600 600}
+ {-insertwidth 2 2}
+ {-itemslabel "Items Label" "Items Label"}
+ {-itemson no no}
+ {-labelfont -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-*}
+ {-margin 10 10}
+ {-itemson yes yes}
+ {-selectbackground #c3c3c3 #c3c3c3}
+ {-selectborderwidth 1 1}
+ {-itemscommand {.sb selectitem} {.sb selectitem}}
+ {-selectforeground Black Black}
+ {-selectioncommand _command _command}
+ {-selectionlabel "Selection Label" "Selection Label"}
+ {-selectionon no no}
+ {-selectionon yes yes}
+ {-textfont 6x13 6x13}
+ {-width 0 0}
+ {-height 0 0}} {
+ set option [lindex $test 0]
+ test Selectionbox-2.$o "configuration options, $option" {
+ .sb configure $option [lindex $test 1]
+ lindex [.sb configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.sb childsite} {.sb.sbchildsite}}
+ {{destroy [.sb childsite]} {}}
+ {{.sb delete Hello 1} {}}
+ {{.sb delete 0} {}}
+ {{.sb insert items 0 One Two Three Four Five Six} {}}
+ {{.sb component items get 0 end} {One Two Three Four Five Six}}
+ {{.sb size} 6}
+ {{.sb clear selection} {}}
+ {{.sb insert selection 0 One} {}}
+ {{.sb get} One}
+ {{.sb index end} 6}
+ {{.sb index Six} 5}
+ {{.sb selection set 1} {}}
+ {{.sb selectitem} {}}
+ {{.sb curselection} 1}
+ {{.sb get} Two}
+ {{.sb delete Three} {}}
+ {{.sb clear items} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Selectionbox-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Method tests which fail and produce errors
+#
+foreach test {
+ {{.sb clear bogus} {bad clear argument "bogus": should be selection or items}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Selectionbox-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Selectionbox-1.$c {Selectionbox destruction} {
+ destroy .sb
+ update
+} {}
+
+incr c
+
+test Selectionbox-1.$c {Selectionbox construction} {
+ iwidgets::selectionbox .sb
+ .sb component items configure -vscrollmode none -hscrollmode none
+ pack .sb -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Selectionbox-1.$c {Selectionbox destruction} {
+ destroy .sb
+ update
+} {}
+
+incr c
+
+test Selectionbox-1.$c {Selectionbox destruction} {
+ iwidgets::selectionbox .sb
+ pack .sb
+ destroy .sb
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/selectiondialog.test b/itcl/iwidgets3.0.0/tests/selectiondialog.test
new file mode 100644
index 00000000000..6474fe54754
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/selectiondialog.test
@@ -0,0 +1,186 @@
+# This file is a Tcl script to test out [incr Widgets] Selectiondialog class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+# 4.x - Other tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Selectiondialog-1.$c {Selectiondialog construction} {
+ iwidgets::Selectiondialog .sd
+ .sd insert items end Hello {Out There} World
+ .sd activate
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Selectiondialog-2.$o {configuration option} {
+ llength [.sd configure]
+} {44}
+
+incr o
+
+foreach test {
+ {-width 340 340}
+ {-width 360 360}
+ {-activerelief raised raised}
+ {-borderwidth 2 2}
+ {-background #d9d9d9 #d9d9d9}
+ {-buttonboxpos n n}
+ {-buttonboxpadx 10 10}
+ {-buttonboxpos e e}
+ {-buttonboxpos w w}
+ {-buttonboxpady 10 10}
+ {-buttonboxpos s s}
+ {-cursor gumby gumby}
+ {-foreground Black Black}
+ {-highlightcolor Black Black}
+ {-highlightthickness 2 2}
+ {-modality global global}
+ {-modality application application}
+ {-modality none none}
+ {-padx 15 15}
+ {-pady 15 15}
+ {-textbackground GhostWhite GhostWhite}
+ {-separator off off}
+ {-thickness 4 4}
+ {-separator on on}
+ {-title Selectiondialog Selectiondialog}
+ {-childsitepos n n}
+ {-childsitepos s s}
+ {-childsitepos e e}
+ {-childsitepos w w}
+ {-childsitepos center center}
+ {-cursor gumby gumby}
+ {-exportselection 0 0}
+ {-insertbackground Blue Blue}
+ {-insertbackground Black Black}
+ {-insertborderwidth 1 1}
+ {-insertofftime 200 200}
+ {-insertontime 500 500}
+ {-insertwidth 3 3}
+ {-itemslabel "Items Label" "Items Label"}
+ {-itemson no no}
+ {-labelfont 6x13 6x13}
+ {-itemson yes yes}
+ {-selectbackground #c3c3c3 #c3c3c3}
+ {-selectborderwidth 2 2}
+ {-selectforeground Black Black}
+ {-selectionlabel "Selection Label" "Selection Label"}
+ {-selectionon no no}
+ {-selectionon yes yes}
+ {-width 0 0}
+ {-height 0 0}
+ {-textfont 6x13 6x13}} {
+ set option [lindex $test 0]
+ test Selectiondialog-2.$o "configuration options, $option" {
+ .sd configure $option [lindex $test 1]
+ lindex [.sd configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.sd childsite} {.sd.shellchildsite.dschildsite.selectionbox.sbchildsite}}
+ {{.sd clear items} {}}
+ {{.sd component selectionbox component items get 0 end} {}}
+ {{.sd insert items 0 One Two Three Four Five Six} {}}
+ {{.sd component selectionbox component items get 0 end} {One Two Three Four Five Six}}
+ {{.sd size} 6}
+ {{.sd clear selection} {}}
+ {{.sd insert selection 0 One} {}}
+ {{.sd get} One}
+ {{.sd index end} 6}
+ {{.sd index Six} 5}
+ {{.sd selection set 1} {}}
+ {{.sd selectitem} {}}
+ {{.sd curselection} 1}
+ {{.sd get} Two}
+ {{.sd delete Three} {}}
+ {{.sd clear items} {}}
+ {{.sd hide Help} {}}
+ {{.sd hide Cancel} {}}
+ {{.sd default Apply} {}}
+ {{.sd show Cancel} {}}
+ {{.sd deactivate} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Selectiondialog-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Method tests which fail and produce errors
+#
+foreach test {
+ {{.sd clear bogus} {bad clear argument "bogus": should be selection or items}}
+ {{.sd insert bogus bogus} {bad insert argument "bogus": should be selection or items}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Selectiondialog-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Selectiondialog-1.$c {Selectiondialog destruction} {
+ destroy .sd
+ update
+} {}
+
+incr c
+
+test Selectiondialog-1.$c {Selectiondialog construction} {
+ iwidgets::selectiondialog .sd
+ update
+} {}
+
+incr c
+
+test Selectiondialog-1.$c {Selectiondialog destruction} {
+ destroy .sd
+ update
+} {}
+
+incr c
+
+test Selectiondialog-1.$c {Selectiondialog destruction} {
+ iwidgets::selectiondialog .sd
+ destroy .sd
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/shell.test b/itcl/iwidgets3.0.0/tests/shell.test
new file mode 100644
index 00000000000..48a9daee785
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/shell.test
@@ -0,0 +1,196 @@
+# This file is a Tcl script to test out [incr Widgets] Shell class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+# 4.x - Other tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Shell-1.$c {Shell construction} {
+ iwidgets::Shell .sh
+
+ listbox [.sh childsite].lb -relief sunken
+ pack [.sh childsite].lb -fill both -expand yes
+
+ .sh center
+ .sh activate
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Shell-2.$o {configuration option} {
+ llength [.sh configure]
+} {11}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-width 200 200}
+ {-height 200 200}
+ {-cursor gumby gumby}
+ {-modality global global}
+ {-modality application application}
+ {-modality none none}
+ {-padx 15 15}
+ {-pady 15 15}
+ {-width 0 0}
+ {-height 0 0}
+ {-title "Shell" "Shell"}} {
+ set option [lindex $test 0]
+ test Shell-2.$o "configuration options, $option" {
+ .sh configure $option [lindex $test 1]
+ lindex [.sh configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-modality bogus {bad modality option "bogus": should be none, application, or global}}} {
+ set option [lindex $test 0]
+ test Shell-2.$o "configuration options, $option" {
+ list [catch {.sh configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.sh childsite} {.sh.shellchildsite}}
+ {{.sh activate} {}}
+ {{.sh center .} {}}
+ {{.sh center} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Shell-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Deactivate test
+#
+test Shell-3.$m "object methods, deactivate" {
+ list [catch {.sh deactivate} msg] $msg
+} [list 0 {}]
+update
+incr m
+
+#
+# Destruction test
+#
+test Shell-1.$c {Shell destruction} {
+ destroy .sh
+ update
+} {}
+incr c
+
+#
+# Global modality test.
+#
+test Shell-4.2 "global modality, activation, and deactivation" {
+ iwidgets::shell .sh -modality global
+ .sh center
+ pack [label [.sh childsite].l -text "Global Modal Shell"]
+ after 2000 {.sh deactivate Test}
+ .sh center
+ list [catch {.sh activate} msg] $msg
+} [list 0 Test]
+update
+
+#
+# Destruction test
+#
+test Shell-1.$c {Shell destruction} {
+ destroy .sh
+ update
+} {}
+incr c
+
+#
+# None modality test.
+#
+test Shell-4.3 "no modality, activation, and deactivation" {
+ iwidgets::shell .sh -modality none
+ .sh center
+ pack [label [.sh childsite].l -text "Non-Modal Shell"]
+ .sh center
+ .sh activate
+ update
+ after 2000
+ .sh deactivate
+} {}
+update
+
+#
+# Destruction test
+#
+test Shell-1.$c {Shell destruction} {
+ destroy .sh
+ update
+} {}
+
+incr c
+
+#
+# Application modality test.
+#
+test Shell-4.4 "application modality, activation, and deactivation" {
+ iwidgets::shell .sh -modality application
+ .sh center
+ pack [label [.sh childsite].l -text "Application Modal Shell"]
+ after 2000 {.sh deactivate Test}
+ .sh center
+ list [catch {.sh activate} msg] $msg
+} [list 0 Test]
+update
+
+#
+# Destruction test
+#
+test Shell-1.$c {Shell destruction} {
+ destroy .sh
+ update
+} {}
+
+incr c
+
+test Shell-1.$c {Shell destruction} {
+ iwidgets::shell .sh
+ destroy .sh
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/spindate.test b/itcl/iwidgets3.0.0/tests/spindate.test
new file mode 100644
index 00000000000..7c541a108c7
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/spindate.test
@@ -0,0 +1,156 @@
+# This file is a Tcl script to test out [incr Widgets] Spindate class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Spindate-1.$c {Spindate construction} {
+ iwidgets::Spindate .sd
+ pack .sd -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Spindate-2.$o {configuration option} {
+ llength [.sd configure]
+} {26}
+
+incr o
+
+foreach test {
+ {-arroworient horizontal horizontal}
+ {-arroworient vertical vertical}
+ {-background #d9d9d9 #d9d9d9}
+ {-cursor gumby gumby}
+ {-datemargin 3 3}
+ {-daylabel Day: Day:}
+ {-dayon false false}
+ {-dayon true true}
+ {-daywidth 4 4}
+ {-labelmargin 4 4}
+ {-labelpos n n}
+ {-labelpos s s}
+ {-labelpos e e}
+ {-labelpos w w}
+ {-monthformat integer integer}
+ {-monthformat brief brief}
+ {-monthformat full full}
+ {-monthlabel Month: Month:}
+ {-monthon false false}
+ {-monthon true true}
+ {-monthwidth 4 4}
+ {-orient horizontal horizontal}
+ {-orient vertical vertical}
+ {-textbackground GhostWhite GhostWhite}
+ {-yeardigits 2 2}
+ {-yeardigits 4 4}
+ {-yearlabel Year: Year:}
+ {-yearon false false}
+ {-yearon true true}
+ {-yearwidth 4 4}} {
+ set option [lindex $test 0]
+ test Spindate-2.$o "configuration options, $option" {
+ .sd configure $option [lindex $test 1]
+ lindex [.sd configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-yeardigits bogus {bad yeardigits option "bogus", should be 2 or 4}}
+ {-monthformat bogus {bad monthformat option "bogus", should be "integer", "brief" or "full"}}} {
+ set option [lindex $test 0]
+ test Spindate-2.$o "configuration options, $option" {
+ list [catch {.sd configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.sd show 3/3/1960} {}}
+ {{.sd get -string} "03 March 1960"}} {
+ set method [lindex [lindex $test 0] 1]
+ test Spindate-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+foreach test {
+ {{.sd show bogus} {bad date: "bogus", must be a valid date string, clock clicks value or the keyword now}}
+ {{.sd get bogus} {bad format option "bogus": should be -string or -clicks}}} {
+ set method [lindex [lindex $test 0] 1]
+ test ScrolledListBox-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Spindate-1.$c {Spindate destruction} {
+ destroy .sd
+ update
+} {}
+
+incr c
+
+test Spindate-1.$c {Spindate construction} {
+ iwidgets::spindate .sd -monthformat brief
+ pack .sd -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Spindate-1.$c {Spindate destruction} {
+ destroy .sd
+ update
+} {}
+
+incr c
+
+test Spindate-1.$c {Spindate destruction} {
+ iwidgets::spindate .sd
+ pack .sd
+ destroy .sd
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/spinint.test b/itcl/iwidgets3.0.0/tests/spinint.test
new file mode 100644
index 00000000000..a17087f589d
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/spinint.test
@@ -0,0 +1,166 @@
+# This file is a Tcl script to test out [incr Widgets] Spinint class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Spinint-1.$c {Spinint construction} {
+ iwidgets::Spinint .spi
+ pack .spi -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Spinint-2.$o {configuration option} {
+ llength [.spi configure]
+} {46}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-childsitepos e e}
+ {-childsitepos s s}
+ {-childsitepos w w}
+ {-childsitepos n n}
+ {-childsitepos e e}
+ {-borderwidth 4 4}
+ {-cursor gumby gumby}
+ {-decrement {.spi insert end Down} {.spi insert end Down}}
+ {-exportselection 0 0}
+ {-fixed 10 10}
+ {-borderwidth 2 2}
+ {-foreground Black Black}
+ {-increment {.spi insert end Up} {.spi insert end Up}}
+ {-insertbackground Black Black}
+ {-insertborderwidth 2 2}
+ {-insertofftime 200 200}
+ {-insertontime 500 500}
+ {-insertwidth 3 3}
+ {-labelfont 6x13 6x13}
+ {-labelmargin 5 5}
+ {-labeltext Label Label}
+ {-labelpos w w}
+ {-labelpos nw nw}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos e e}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-arroworient horizontal horizontal}
+ {-range {0 100} {0 100}}
+ {-relief raised raised}
+ {-selectbackground blue blue}
+ {-selectbackground #c3c3c3 #c3c3c3}
+ {-selectborderwidth 2 2}
+ {-selectforeground Blue Blue}
+ {-selectforeground Black Black}
+ {-state disabled disabled}
+ {-state normal normal}
+ {-step 2 2}
+ {-textfont 6x13 6x13}
+ {-width 30 30}
+ {-wrap 0 0}} {
+ set option [lindex $test 0]
+ test Spinint-2.$o "configuration options, $option" {
+ .spi configure $option [lindex $test 1]
+ lindex [.spi configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-range {bogus} {wrong # args: should be ".spi configure -range {begin end}"}}
+ {-range {bogus 0} {bad range option "bogus": begin value must be an integer}}
+ {-range {0 bogus} {bad range option "bogus": end value must be an integer}}
+ {-range {100 10} {bad option starting range "100": must be less than ending: "10"}}} {
+ set option [lindex $test 0]
+ test Spinint-2.$o "configuration options, $option" {
+ list [catch {.spi configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.spi clear} {}}
+ {{.spi insert end 50} {}}
+ {{.spi cget -step} 2}
+ {{.spi up} {}}
+ {{.spi down} {}}
+ {{.spi get} 50}} {
+ set method [lindex [lindex $test 0] 1]
+ test Spinint-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Spinint-1.$c {Spinint destruction} {
+ destroy .spi
+ update
+} {}
+
+incr c
+
+test Spinint-1.$c {Spinint construction} {
+ iwidgets::spinint .spi
+ pack .spi -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Spinint-1.$c {Spinint destruction} {
+ destroy .spi
+ update
+} {}
+
+incr c
+
+test Spinint-1.$c {Spinint destruction} {
+ iwidgets::spinint .spi
+ pack .spi
+ destroy .spi
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/spinner.test b/itcl/iwidgets3.0.0/tests/spinner.test
new file mode 100644
index 00000000000..f0c815433cb
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/spinner.test
@@ -0,0 +1,148 @@
+# This file is a Tcl script to test out [incr Widgets] Spinner class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Spinner-1.$c {Spinner construction} {
+ iwidgets::Spinner .sp
+ pack .sp -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Spinner-2.$o {configuration option} {
+ llength [.sp configure]
+} {43}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-foreground blue blue}
+ {-borderwidth 4 4}
+ {-childsitepos e e}
+ {-childsitepos s s}
+ {-childsitepos w w}
+ {-childsitepos n n}
+ {-childsitepos e e}
+ {-borderwidth 2 2}
+ {-cursor gumby gumby}
+ {-decrement {.sp insert end Down} {.sp insert end Down}}
+ {-exportselection 0 0}
+ {-fixed 15 15}
+ {-foreground Black Black}
+ {-increment {.sp insert end Up} {.sp insert end Up}}
+ {-insertbackground Blue Blue}
+ {-insertbackground Black Black}
+ {-insertborderwidth 2 2}
+ {-insertofftime 200 200}
+ {-insertontime 500 500}
+ {-insertwidth 3 3}
+ {-labelfont 6x13 6x13}
+ {-labelmargin 5 5}
+ {-labeltext Label Label}
+ {-labelpos w w}
+ {-labelpos nw nw}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos e e}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-arroworient horizontal horizontal}
+ {-relief raised raised}
+ {-selectbackground #c3c3c3 #c3c3c3}
+ {-selectborderwidth 2 2}
+ {-selectforeground Black Black}
+ {-state disabled disabled}
+ {-state normal normal}
+ {-textfont 6x13 6x13}
+ {-validate numeric {::iwidgets::Entryfield::numeric %c}}
+ {-repeatdelay 400 400}
+ {-repeatdelay -100 0}
+ {-repeatinterval 200 200}
+ {-repeatinterval -100 0}
+ {-width 30 30}} {
+ set option [lindex $test 0]
+ test Spinner-2.$o "configuration options, $option" {
+ .sp configure $option [lindex $test 1]
+ lindex [.sp configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.sp up} {}}
+ {{.sp down} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Spinner-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Spinner-1.$c {Spinner destruction} {
+ destroy .sp
+ update
+} {}
+
+incr c
+
+test Spinner-1.$c {Spinner construction} {
+ iwidgets::spinner .sp
+ pack .sp -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Spinner-1.$c {Spinner destruction} {
+ destroy .sp
+ update
+} {}
+
+incr c
+
+test Spinner-1.$c {Spinner destruction} {
+ iwidgets::spinner .sp
+ pack .sp
+ destroy .sp
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/spintime.test b/itcl/iwidgets3.0.0/tests/spintime.test
new file mode 100644
index 00000000000..ec1b4b34aed
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/spintime.test
@@ -0,0 +1,140 @@
+# This file is a Tcl script to test out [incr Widgets] Spintime class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Spintime-1.$c {Spintime construction} {
+ iwidgets::Spintime .st
+ pack .st -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Spintime-2.$o {configuration option} {
+ llength [.st configure]
+} {25}
+
+incr o
+
+foreach test {
+ {-arroworient horizontal horizontal}
+ {-arroworient vertical vertical}
+ {-background #d9d9d9 #d9d9d9}
+ {-cursor gumby gumby}
+ {-hourlabel Hour: Hour:}
+ {-houron false false}
+ {-houron true true}
+ {-hourwidth 4 4}
+ {-labelmargin 4 4}
+ {-labelpos n n}
+ {-labelpos s s}
+ {-labelpos e e}
+ {-labelpos w w}
+ {-militaryon no no}
+ {-militaryon yes yes}
+ {-minutelabel Minute: Minute:}
+ {-minuteon false false}
+ {-minuteon true true}
+ {-minutewidth 4 4}
+ {-orient horizontal horizontal}
+ {-orient vertical vertical}
+ {-secondlabel Second: Second:}
+ {-secondon false false}
+ {-secondon true true}
+ {-secondwidth 4 4}
+ {-textbackground GhostWhite GhostWhite}
+ {-timemargin 3 3}} {
+ set option [lindex $test 0]
+ test Spintime-2.$o "configuration options, $option" {
+ .st configure $option [lindex $test 1]
+ lindex [.st configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.st show "21:21:21"} {}}
+ {{.st get -string} "21:21:21"}} {
+ set method [lindex [lindex $test 0] 1]
+ test Spintime-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+foreach test {
+ {{.st show bogus} {bad time: "bogus", must be a valid time string, clock clicks value or the keyword now}}
+ {{.st get bogus} {bad format option "bogus": should be -string or -clicks}}} {
+ set method [lindex [lindex $test 0] 1]
+ test ScrolledListBox-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Spintime-1.$c {Spintime destruction} {
+ destroy .st
+ update
+} {}
+
+incr c
+
+test Spintime-1.$c {Spintime construction} {
+ iwidgets::spintime .st
+ pack .st -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Spintime-1.$c {Spintime destruction} {
+ destroy .st
+ update
+} {}
+
+incr c
+
+test Spintime-1.$c {Spintime destruction} {
+ iwidgets::spintime .st
+ pack .st
+ destroy .st
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/tabnotebook.test b/itcl/iwidgets3.0.0/tests/tabnotebook.test
new file mode 100644
index 00000000000..bb21c582fb3
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/tabnotebook.test
@@ -0,0 +1,313 @@
+# This file is a Tcl script to test out [incr Widgets] Tabnotebook class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Tabnotebook-1.$c {Tabnotebook construction} {
+ iwidgets::Tabnotebook .tn
+ pack .tn
+ update
+ .tn add -label one
+ update
+ .tn add -label two
+ update
+ .tn add -label three
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Tabnotebook-2.$o {configuration option} {
+ llength [.tn configure]
+} {26}
+
+incr o
+
+foreach test {
+ {-disabledforeground #a3a3a3 #a3a3a3 }
+ {-start 4 4 }
+ {-backdrop #d9d9d9 #d9d9d9 }
+ {-borderwidth 2 2 }
+ {-scrollcommand }
+ {-font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* }
+ {-gap overlap overlap }
+ {-background #CDCDB7B7B5B5 #CDCDB7B7B5B5 }
+ {-state normal normal }
+ {-bevelamount 0 0 }
+ {-equaltabs true true }
+ {-foreground #000000000000 #000000000000 }
+ {-raiseselect false false }
+ {-padx 4 4 }
+ {-pady 4 4 }
+ {-margin 4 4 }
+ {-cursor }
+ {-angle 15 15 }
+ {-tabbackground #d9d9d9 #d9d9d9 }
+ {-tabborders true true }
+ {-width 300 300 }
+ {-tabpos s s }
+ {-auto true true }
+ {-height 150 150 }
+ {-tabforeground Black Black }
+ } {
+ set option [lindex $test 0]
+ test Tabnotebook-2.$o "configuration options, $option" {
+ .tn configure $option [lindex $test 1]
+ lindex [.tn configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# PageConfigure Option tests which are successful.
+#
+test Tabnotebook-2.$o {page configuration option} {
+ llength [.tn pageconfigure 0]
+} {30}
+
+# do pageconfigure tests also...
+foreach test {
+ {0 -label Hello Hello}
+ {end -label "Hello World" "Hello World"}
+ } {
+ set index [lindex $test 0]
+ set option [lindex $test 1]
+ test Tabnotebook-2.$o "configuration options, $option" {
+ .tn pageconfigure $index $option [lindex $test 2]
+ lindex [.tn pageconfigure $index $option] 4
+ } [lindex $test 3]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+#foreach test {
+# { -OPTION BADVALUE {ERROR_MESSAGE} }
+# } {
+# set option [lindex $test 0]
+# test Tabnotebook-2.$o "configuration options, $option" {
+# list [catch {.bb configure $option [lindex $test 1]} msg] $msg
+# } [list 1 [lindex $test 2]]
+# incr o
+#}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.tn add}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn add}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn add}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn add -label Never}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn add}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn add -label "Hello World" -disabledforeground gray}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn childsite Never}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn childsite 0}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn childsite end}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn index end}
+ {[0-9]+}}
+ {{.tn index Never}
+ {[0-9]+}}
+ {{.tn index 0}
+ {0}}
+ {{.tn select 0}
+ {0}}
+ {{.tn select select}
+ {}}
+ {{.tn select end}
+ {[0-9]+}}
+ {{.tn select "Hello World"}
+ {[0-9]+}}
+ {{.tn insert 0}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn insert select -label "An Insert"}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn insert end -label "Next To Last"}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn select 0}
+ {0}}
+ {{.tn next}
+ {1}}
+ {{.tn next}
+ {2}}
+ {{.tn prev}
+ {1}}
+ {{.tn prev}
+ {0}}
+ {{.tn delete Never}
+ {}}
+ {{.tn delete 1 2}
+ {}}
+ {{.tn delete 0 "Hello World"}
+ {}}
+ {{.tn add}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn add}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn add}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn add}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn delete 0 end}
+ {}}
+ {{.tn add}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn add}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn add}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn add}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn select 2}
+ {[-]*[0-9]+}}
+ {{.tn delete select end}
+ {}}
+ {{.tn delete 0 end}
+ {}}
+ {{.tn add -label "First Page"}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn add -label "Second Page"}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn add -label "Third Page"}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn add -label "Fourth Page"}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn add -label "Fifth Page"}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn add -label "Sixth Page"}
+ {[.]tn[.]canvas[.]notebook[.]cs[.]page[0-9]+[.]cs}}
+ {{.tn select "First Page"}
+ {[-]*[0-9]+}}
+ {{.tn delete select "Second Page"}
+ {}}
+ {{.tn delete "Third Page" 1}
+ {}}
+ {{.tn delete "Fifth Page" "Sixth Page"}
+ {}}
+ } {
+ set method [lindex [lindex $test 0] 1]
+ set method_invoke [lindex $test 0]
+ test_pattern Tabnotebook-3.$m "\[$method_invoke\]" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Method tests which fail and produce errors
+#
+foreach test {
+ {{.tn delete 0 end} {}}
+ {{.tn childsite 0} {can't get childsite, no pages}}
+ {{.tn add} {}}
+ {{.tn childsite 1} {bad Notebook page index in childsite method}}
+ {{.tn childsite -1} {bad Notebook page index in childsite method}}
+ {{.tn delete 0} {}}
+ {{.tn delete 0} {can't delete page, no pages}}
+ {{.tn add} {}}
+ {{.tn delete 1} {bad Notebook page index in delete method:}}
+ {{.tn delete select} {bad Notebook page index in delete method:}}
+ {{.tn delete 0} {}}
+ {{.tn add} {}}
+ {{.tn delete 0 1} {bad Notebook page index2 in delete method:}}
+ {{.tn delete 1 4} {bad Notebook page index1 in delete method:}}
+ {{.tn add} {}}
+ {{.tn delete 1 0} {bad Notebook page index1 in delete method: index1 is greater than index2}}
+ {{.tn delete 0 1} {}}
+ {{.tn add} {}}
+ {{.tn delete 0 1 4 5 6} {wrong # args}}
+ {{.tn delete} {wrong # args}}
+ {{.tn delete 0} {}}
+ {{.tn delete 0} {can't delete page}}
+ {{.tn delete select} {can't delete page}}
+ {{.tn insert 0} {can't insert page}}
+ {{.tn add} {}}
+ {{.tn add} {}}
+ {{.tn insert 2} {bad Notebook page index in insert method:}}
+ {{.tn insert -1} {bad Notebook page index}}
+ {{.tn delete 0 end} {}}
+ {{.tn next} {can't move to next page, no pages in the notebook}}
+ {{.tn prev} {can't move to previous page, no pages in the notebook}}
+ {{.tn select 0} {can't select page}}
+ {{.tn add} {}}
+ {{.tn select 1} {bad Notebook page index in select method:}}
+ {{.tn delete 0} {}}
+ } {
+ set method [lindex [lindex $test 0] 1]
+ set method_invoke [lindex $test 0]
+ test_pattern Tabnotebook-3.$m "\[$method_invoke\]" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+ }
+
+
+# Conclusion of constrcution/destruction tests
+#
+test Tabnotebook-1.$c {Tabnotebook destruction} {
+ destroy .tn
+ update
+} {}
+
+incr c
+
+test Tabnotebook-1.$c {Tabnotebook construction} {
+ iwidgets::Tabnotebook .tn -width 100 -height 100
+ pack .tn
+ update
+ .tn add -label one
+ update
+ .tn add -label two
+ update
+ .tn add -label three
+ update
+} {}
+
+incr c
+
+test Tabnotebook-1.$c {Tabnotebook destruction} {
+ destroy .tn
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/tabset.test b/itcl/iwidgets3.0.0/tests/tabset.test
new file mode 100644
index 00000000000..425bd324ef5
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/tabset.test
@@ -0,0 +1,317 @@
+# This file is a Tcl script to test out [incr Widgets] Tabset class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Tabset-1.$c {Tabset construction} {
+ iwidgets::Tabset .ts
+ pack .ts
+ update
+ .ts add -label one
+ update
+ .ts add -label two
+ update
+ .ts add -label three
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Tabset-2.$o {configuration option} {
+ llength [.ts configure]
+} {24}
+
+incr o
+
+foreach test {
+ {-disabledforeground #a3a3a3 #a3a3a3 }
+ {-backdrop white white }
+ {-start 4 4 }
+ {-command }
+ {-font fixed fixed }
+ {-selectbackground #ececec #ececec }
+ {-gap overlap overlap }
+ {-background #CDCDB7B7B5B5 #CDCDB7B7B5B5 }
+ {-state normal normal }
+ {-equaltabs true true }
+ {-bevelamount 0 0 }
+ {-selectforeground black black }
+ {-foreground #000000000000 #000000000000 }
+ {-raiseselect false false }
+ {-padx 4 4 }
+ {-pady 4 4 }
+ {-cursor }
+ {-margin 5 5 }
+ {-angle 20 20 }
+ {-width 0 0 }
+ {-tabborders true true }
+ {-height 0 0 }
+ {-tabpos s s }
+ } {
+ set option [lindex $test 0]
+ test Tabset-2.$o "configuration options, $option" {
+ .ts configure $option [lindex $test 1]
+ lindex [.ts configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Tabconfigure Option tests which are successful.
+#
+test Tabset-2.$o {tab configuration option} {
+ llength [.ts tabconfigure 0]
+} {22}
+
+# do tabconfigure tests also...
+foreach test {
+ {0 -bevelamount 0 0}
+ {0 -state normal normal}
+ {0 -anchor c c}
+ {0 -image {} {}}
+ {0 -bitmap {} {}}
+ {0 -label Hello Hello}
+ {0 -label "Hello World" "Hello World"}
+ {0 -padx 4 4}
+ {0 -pady 4 4}
+ {0 -selectbackground gray70 gray70}
+ {0 -selectforeground black black}
+ {0 -disabledforeground gray gray}
+ {0 -background white white}
+ {0 -foreground black black}
+ {0 -orient vertical vertical}
+ {0 -invert false false}
+ {0 -angle 20 20}
+ {0 -font "-adobe-helvetica-bold-r-normal--34-240-100-100-p-182-iso8859-1" "-adobe-helvetica-bold-r-normal--34-240-100-100-p-182-iso8859-1"}
+ {0 -tabborders true true}
+ } {
+ set index [lindex $test 0]
+ set option [lindex $test 1]
+ test Tabset-2.$o "tab configuration options, $option" {
+ .ts tabconfigure $index $option [lindex $test 2]
+ .ts tabcget $index $option
+ } [lindex $test 3]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+#foreach test {
+# { -OPTION BADVALUE {ERROR_MESSAGE} }
+# } {
+# set option [lindex $test 0]
+# test Tabset-2.$o "configuration options, $option" {
+# list [catch {.bb configure $option [lindex $test 1]} msg] $msg
+# } [list 1 [lindex $test 2]]
+# incr o
+#}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.ts add}
+ {::.ts-tab[0-9]+}}
+ {{.ts add}
+ {::.ts-tab[0-9]+}}
+ {{.ts add}
+ {::.ts-tab[0-9]+}}
+ {{.ts add -label Never}
+ {::.ts-tab[0-9]+}}
+ {{.ts add}
+ {::.ts-tab[0-9]+}}
+ {{.ts add -label "Hello World" -disabledforeground gray}
+ {::.ts-tab[0-9]+}}
+ {{.ts index end}
+ {[0-9]+}}
+ {{.ts index Never}
+ {[0-9]+}}
+ {{.ts index 0}
+ {0}}
+ {{.ts select 0}
+ {0}}
+ {{.ts select select}
+ {0}}
+ {{.ts select end}
+ {[0-9]+}}
+ {{.ts select "Hello World"}
+ {[0-9]+}}
+ {{.ts insert 0}
+ {::.ts-tab[0-9]+}}
+ {{.ts insert select -label "An Insert"}
+ {::.ts-tab[0-9]+}}
+ {{.ts insert end -label "Next To Last"}
+ {::.ts-tab[0-9]+}}
+ {{.ts select 0}
+ {0}}
+ {{.ts next}
+ {1}}
+ {{.ts next}
+ {2}}
+ {{.ts prev}
+ {1}}
+ {{.ts prev}
+ {0}}
+ {{.ts delete Never}
+ {}}
+ {{.ts delete 1 2}
+ {}}
+ {{.ts delete 0 "Hello World"}
+ {}}
+ {{.ts add}
+ {::.ts-tab[0-9]+}}
+ {{.ts add}
+ {::.ts-tab[0-9]+}}
+ {{.ts add}
+ {::.ts-tab[0-9]+}}
+ {{.ts add}
+ {::.ts-tab[0-9]+}}
+ {{.ts delete 0 end}
+ {}}
+ {{.ts add}
+ {::.ts-tab[0-9]+}}
+ {{.ts add}
+ {::.ts-tab[0-9]+}}
+ {{.ts add}
+ {::.ts-tab[0-9]+}}
+ {{.ts add}
+ {::.ts-tab[0-9]+}}
+ {{.ts select 2}
+ {[-]*[0-9]+}}
+ {{.ts delete select end}
+ {}}
+ {{.ts delete 0 end}
+ {}}
+ {{.ts add -label "First Page"}
+ {::.ts-tab[0-9]+}}
+ {{.ts add -label "Second Page"}
+ {::.ts-tab[0-9]+}}
+ {{.ts add -label "Third Page"}
+ {::.ts-tab[0-9]+}}
+ {{.ts add -label "Fourth Page"}
+ {::.ts-tab[0-9]+}}
+ {{.ts add -label "Fifth Page"}
+ {::.ts-tab[0-9]+}}
+ {{.ts add -label "Sixth Page"}
+ {::.ts-tab[0-9]+}}
+ {{.ts select "First Page"}
+ {[-]*[0-9]+}}
+ {{.ts delete select "Second Page"}
+ {}}
+ {{.ts delete "Third Page" 1}
+ {}}
+ {{.ts delete "Fifth Page" "Sixth Page"}
+ {}}
+ } {
+ set method [lindex [lindex $test 0] 1]
+ set method_invoke [lindex $test 0]
+ test_pattern Tabset-3.$m "\[$method_invoke\]" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Method tests which fail and produce errors
+#
+foreach test {
+ {{.ts delete 0 end} {}}
+ {{.ts add} {}}
+ {{.ts delete 0} {}}
+ {{.ts delete 0} {can't delete tabs, no tabs}}
+ {{.ts add} {}}
+ {{.ts delete 1} {bad value for index1}}
+ {{.ts delete select} {bad value for index1}}
+ {{.ts delete 0} {}}
+ {{.ts add} {}}
+ {{.ts delete 0 1} {bad value for index2}}
+ {{.ts delete 1 4} {bad value for index1}}
+ {{.ts add} {}}
+ {{.ts delete 0 1} {}}
+ {{.ts add} {}}
+ {{.ts delete 0 1 4 5 6} {wrong # args}}
+ {{.ts delete} {wrong # args}}
+ {{.ts delete 0} {}}
+ {{.ts delete 0} {can't delete tabs}}
+ {{.ts delete select} {can't delete tabs}}
+ {{.ts insert 0} {no tab to insert before, tabset}}
+ {{.ts add} {}}
+ {{.ts add} {}}
+ {{.ts insert 2} {bad value}}
+ {{.ts insert -1} {bad option}}
+ {{.ts delete 0 end} {}}
+ {{.ts next} {can't goto next tab, no tabs in the tabset}}
+ {{.ts prev} {can't goto previous tab, no tabs in the tabset}}
+ {{.ts select 0} {can't activate a tab, no tabs in the tabset}}
+ {{.ts add} {}}
+ {{.ts select 1} {bad value}}
+ {{.ts delete 0} {}}
+ } {
+ set method [lindex [lindex $test 0] 1]
+ set method_invoke [lindex $test 0]
+ test_pattern Tabset-3.$m "\[$method_invoke\]" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+ }
+
+# Conclusion of constrcution/destruction tests
+#
+test Tabset-1.$c {Tabset destruction} {
+ destroy .ts
+ update
+} {}
+
+incr c
+
+test Tabset-1.$c {Tabset construction} {
+ iwidgets::Tabset .ts -width 100 -height 100
+ pack .ts
+ update
+ .ts add -label one
+ update
+ .ts add -label two
+ update
+ .ts add -label three
+ update
+} {}
+
+incr c
+
+test Tabset-1.$c {Tabset destruction} {
+ destroy .ts
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/timeentry.test b/itcl/iwidgets3.0.0/tests/timeentry.test
new file mode 100755
index 00000000000..752203d5351
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/timeentry.test
@@ -0,0 +1,178 @@
+# This file is a Tcl script to test out [incr Widgets] Timeentry class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Timeentry-1.$c {Timeentry construction} {
+ iwidgets::Timeentry .te -labeltext "Time Entry"
+ pack .te -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Timeentry-2.$o {configuration option} {
+ llength [.te configure]
+} {43}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 4 4}
+ {-borderwidth 2 2}
+ {-command {.te configure -background red} {.te configure -background red}}
+ {-cursor gumby gumby}
+ {-exportselection 0 0}
+ {-foreground Green Green}
+ {-foreground Black Black}
+ {-highlightcolor Red Red}
+ {-highlightthickness 2 2}
+ {-insertbackground Yellow Yellow}
+ {-insertbackground Black Black}
+ {-justify right right}
+ {-justify center center}
+ {-justify left left}
+ {-labelmargin 5 5}
+ {-labelpos w w}
+ {-labelpos nw nw}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos e e}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-labeltext Label Label}
+ {-relief raised raised}
+ {-relief sunken sunken}
+ {-foreground black black}
+ {-state disabled disabled}
+ {-state normal normal}
+ {-closetext Set Set}
+ {-watchheight 200 200}
+ {-watchwidth 200 200}
+ {-hourradius .40 .40}
+ {-hourcolor green green}
+ {-minuteradius .90 .90}
+ {-minutecolor blue blue}
+ {-secondradius .99 .99}
+ {-secondcolor red red}
+ {-clockcolor brown brown}
+ {-clockstipple error error}
+ {-tickcolor purple purple}
+ {-textbackground GhostWhite GhostWhite}
+ {-textbackground #d9d9d9 #d9d9d9}} {
+ set option [lindex $test 0]
+ test Timeentry-2.$o "configuration options, $option" {
+ .te configure $option [lindex $test 1]
+ lindex [.te configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-childsitepos bogus {bad childsite option "bogus": should be n, e, s, or w}}} {
+ set option [lindex $test 0]
+ test Timeentry-2.$o "configuration options, $option" {
+ list [catch {.te configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.te childsite} {.te.lwchildsite}}
+ {{.te show "11:11:11 PM"} {11:11:11 PM}}
+ {{.te get} {11:11:11 PM}}
+ {{.te get -string} {11:11:11 PM}}
+ {{.te isvalid} {1}}
+ {{.te component time delete 0 end} {}}
+ {{.te component time insert end 44:44:44} {}}
+ {{.te isvalid} {0}}
+ {{.te show now; list} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Timeentry-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+test Timeentry-3.$m "object methods, clock clicks" {
+ set clicks [clock scan "3:15:00 PM"]
+ .te show $clicks
+ update
+ .te get
+} {03:15:00 PM}
+incr m
+
+#
+# Method tests which fail and produce errors
+#
+foreach test {
+ {{.te get bogus} {bad format option "bogus": should be -string or -clicks}}
+ {{.te show bogus} {bad time: "bogus", must be a valid time string, clock clicks value or the keyword now}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Timeentry-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Timeentry-1.$c {Timeentry destruction} {
+ destroy .te
+ update
+} {}
+
+incr c
+
+test Timeentry-1.$c {Timeentry construction} {
+ iwidgets::timeentry .te
+ pack .te -padx 10 -pady 10
+ update
+} {}
+
+incr c
+
+test Timeentry-1.$c {Timeentry destruction} {
+ destroy .te
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/timefield.test b/itcl/iwidgets3.0.0/tests/timefield.test
new file mode 100755
index 00000000000..1dc6005813c
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/timefield.test
@@ -0,0 +1,163 @@
+# This file is a Tcl script to test out [incr Widgets] Timefield class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Timefield-1.$c {Timefield construction} {
+ iwidgets::Timefield .tf -labeltext "Date Field"
+ pack .tf -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Timefield-2.$o {configuration option} {
+ llength [.tf configure]
+} {27}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-borderwidth 4 4}
+ {-borderwidth 2 2}
+ {-command {.tf configure -background red} {.tf configure -background red}}
+ {-cursor gumby gumby}
+ {-exportselection 0 0}
+ {-foreground Green Green}
+ {-foreground Black Black}
+ {-highlightcolor Red Red}
+ {-highlightthickness 2 2}
+ {-insertbackground Yellow Yellow}
+ {-insertbackground Black Black}
+ {-justify right right}
+ {-justify center center}
+ {-justify left left}
+ {-labelmargin 5 5}
+ {-labelpos w w}
+ {-labelpos nw nw}
+ {-labelpos n n}
+ {-labelpos ne ne}
+ {-labelpos e e}
+ {-labelpos se se}
+ {-labelpos s s}
+ {-labelpos sw sw}
+ {-labeltext Label Label}
+ {-relief raised raised}
+ {-relief sunken sunken}
+ {-textbackground GhostWhite GhostWhite}
+ {-textbackground #d9d9d9 #d9d9d9}} {
+ set option [lindex $test 0]
+ test Timefield-2.$o "configuration options, $option" {
+ .tf configure $option [lindex $test 1]
+ lindex [.tf configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-childsitepos bogus {bad childsite option "bogus": should be n, e, s, or w}}} {
+ set option [lindex $test 0]
+ test Timefield-2.$o "configuration options, $option" {
+ list [catch {.tf configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.tf childsite} {.tf.lwchildsite}}
+ {{.tf show "11:45:00 AM"} {11:45:00 AM}}
+ {{.tf get} {11:45:00 AM}}
+ {{.tf get -string} {11:45:00 AM}}
+ {{.tf isvalid} {1}}
+ {{.tf component time delete 0 end} {}}
+ {{.tf component time insert end "44:44:44 PM"} {}}
+ {{.tf isvalid} {0}}
+ {{.tf show now; list} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Timefield-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+test Timefield-3.$m "object methods, clock clicks" {
+ set clicks [clock scan "3:15:00 PM"]
+ .tf show $clicks
+ update
+ .tf get
+} {03:15:00 PM}
+incr m
+
+#
+# Method tests which fail and produce errors
+#
+foreach test {
+ {{.tf get bogus} {bad format option "bogus": should be -string or -clicks}}
+ {{.tf show bogus} {bad time: "bogus", must be a valid time string, clock clicks value or the keyword now}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Timefield-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Timefield-1.$c {Timefield destruction} {
+ destroy .tf
+ update
+} {}
+
+incr c
+
+test Timefield-1.$c {Timefield construction} {
+ iwidgets::timefield .tf
+ pack .tf -padx 10 -pady 10
+ update
+} {}
+
+incr c
+
+test Timefield-1.$c {Timefield destruction} {
+ destroy .tf
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/toolbar.test b/itcl/iwidgets3.0.0/tests/toolbar.test
new file mode 100644
index 00000000000..49e0394af94
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/toolbar.test
@@ -0,0 +1,261 @@
+# This file is a Tcl script to test out [incr Widgets] Toolbar class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+#
+# Initial construction test
+#
+test Toolbar-1.$c {Toolbar construction} {
+ iwidgets::Toolbar .tb
+ pack .tb
+ update
+ .tb add button item1 -text item1
+ update
+ .tb add button item2 -text item2
+ update
+ .tb add button item3 -text item3
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Toolbar-2.$o {configuration option} {
+ llength [.tb configure]
+} {27}
+
+incr o
+
+foreach test {
+ {-disabledforeground #a3a3a3 #a3a3a3 }
+ {-highlightthickness 0 0 }
+ {-selectborderwidth 4 4 }
+ {-balloonfont 6x10 6x10 }
+ {-balloondelay1 1000 1000 }
+ {-balloondelay2 200 200 }
+ {-borderwidth 2 2 }
+ {-selectcolor #CDCDB7B7B5B5 #CDCDB7B7B5B5 }
+ {-highlightcolor Black Black }
+ {-font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* }
+ {-balloonbackground yellow yellow }
+ {-helpvariable testing testing}
+ {-troughcolor #c3c3c3 #c3c3c3 }
+ {-selectbackground #c3c3c3 #c3c3c3 }
+ {-highlightbackground #d9d9d9 #d9d9d9 }
+ {-background #CDCDB7B7B5B5 #CDCDB7B7B5B5 }
+ {-state normal normal }
+ {-balloonforeground black black }
+ {-selectforeground Black Black }
+ {-foreground #000000000000 #000000000000 }
+ {-activebackground #ececec #ececec }
+ {-insertbackground Black Black }
+ {-cursor crosshair crosshair }
+ {-activeforeground Black Black }
+ {-insertforeground Black Black }
+ {-orient horizontal horizontal }
+ } {
+ set option [lindex $test 0]
+ test Toolbar-2.$o "configuration options, $option" {
+ .tb configure $option [lindex $test 1]
+ .tb cget $option
+ } [lindex $test 2]
+ update
+ incr o
+}
+
+#
+# Itemconfigure Option tests which are successful.
+#
+# This happens to be for a button...
+set o 0
+test Toolbar-3.$o {tab configuration option} {
+ llength [.tb itemconfigure 0]
+} {33}
+
+# do itemconfigure tests also...
+foreach test {
+ {0 -activebackground #ececec #ececec }
+ {0 -activeforeground Black Black }
+ {0 -anchor center center }
+ {0 -background #d9d9d9 #d9d9d9 }
+ {0 -bd 0 0 }
+ {0 -bg #d9d9d9 #d9d9d9 }
+ {0 -bitmap {} {} }
+ {0 -borderwidth 2 2 }
+ {0 -command {} {} }
+ {0 -cursor {} {} }
+ {0 -disabledforeground #a3a3a3 #a3a3a3 }
+ {0 -fg Black Black }
+ {0 -font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-* }
+ {0 -foreground Black Black }
+ {0 -height 0 0 }
+ {0 -highlightbackground #d9d9d9 #d9d9d9 }
+ {0 -highlightcolor Black Black }
+ {0 -highlightthickness 2 2 }
+ {0 -image {} {} }
+ {0 -justify center center }
+ {0 -padx 4 4 }
+ {0 -pady 4 4 }
+ {0 -relief raised raised }
+ {0 -state normal normal }
+ {0 -takefocus false false }
+ {0 -text {} {} }
+ {0 -textvariable {} {} }
+ {0 -underline -1 -1 }
+ {0 -width 0 0 }
+ {0 -wraplength 0 0 }
+ {0 -helpstr {} {} }
+ {0 -balloonstr {} {} }
+ } {
+ set index [lindex $test 0]
+ set option [lindex $test 1]
+ test Toolbar-2.$o "tab configuration options, $option" {
+ .tb itemconfigure $index $option [lindex $test 2]
+ .tb itemcget $index $option
+ } [lindex $test 3]
+ update
+ incr o
+}
+
+#
+# Option tests which fail and produce errors.
+#
+#foreach test {
+# { -OPTION BADVALUE {ERROR_MESSAGE} }
+# } {
+# set option [lindex $test 0]
+# test Toolbar-2.$o "configuration options, $option" {
+# list [catch {.bb configure $option [lindex $test 1]} msg] $msg
+# } [list 1 [lindex $test 2]]
+# incr o
+#}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.tb delete 0 end}
+ {}}
+ {{.tb add radiobutton one}
+ {.tb.one}}
+ {{.tb index end}
+ {0}}
+ {{.tb add checkbutton two}
+ {.tb.two}}
+ {{.tb index end}
+ {1}}
+ {{.tb index one}
+ {0}}
+ {{.tb insert end button oneandhalf -text "One & half"}
+ {.tb.oneandhalf}}
+ {{.tb index oneandhalf}
+ {1}}
+ {{.tb delete oneandhalf}
+ {}}
+ {{.tb index two}
+ {1}}
+ {{.tb delete 0 end}
+ {}}
+ {{.tb index 0}
+ {-1}}
+ } {
+ set method [lindex [lindex $test 0] 1]
+ set method_invoke [lindex $test 0]
+ test_pattern Toolbar-4.$m "\[$method_invoke\]" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+}
+
+#
+# Method tests which fail and produce errors
+#
+foreach test {
+ {{.tb delete 0 end} {}}
+ {{.tb add button item1} {}}
+ {{.tb delete 0} {}}
+ {{.tb delete 0} {can't delete widget, no widgets in the Toolbar}}
+ {{.tb add button item1} {}}
+ {{.tb delete 1} {bad Toolbar widget index in delete method}}
+ {{.tb delete 0} {}}
+ {{.tb add button item1} {}}
+ {{.tb delete 0 1} {bad Toolbar widget index2 in delete method}}
+ {{.tb delete 1 4} {bad Toolbar widget index1 in delete method}}
+ {{.tb add button item2} {}}
+ {{.tb delete 1 0} {bad Toolbar widget index1 in delete method}}
+ {{.tb delete 0 1} {}}
+ {{.tb add button item1} {}}
+ {{.tb delete 0 1 4 5 6} {wrong # args}}
+ {{.tb delete} {wrong # args}}
+ {{.tb delete 0} {}}
+ {{.tb delete 0} {can't delete widget, no widgets in the Toolbar}}
+ {{.tb insert 0 button itemA} {}}
+ {{.tb add button item1} {}}
+ {{.tb add button item2} {}}
+ {{.tb insert 0 button itemAA} {}}
+ {{.tb insert -1 button bogus} {bad toolbar entry index -1}}
+ {{.tb delete 0 end} {}}
+ } {
+ set method [lindex [lindex $test 0] 1]
+ set method_invoke [lindex $test 0]
+ test_pattern Toolbar-5.$m "\[$method_invoke\]" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+ }
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Toolbar-1.$c {Toolbar destruction} {
+ destroy .tb
+ update
+} {}
+
+incr c
+
+test Toolbar-1.$c {Toolbar construction} {
+ iwidgets::Toolbar .tb
+ pack .tb
+ update
+ .tb add iwidgets::optionmenu opt
+ update
+ .tb add button b
+ update
+ .tb add frame filler
+ update
+} {}
+
+incr c
+
+test Toolbar-1.$c {Toolbar destruction} {
+ destroy .tb
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/tests/usual.test b/itcl/iwidgets3.0.0/tests/usual.test
new file mode 100644
index 00000000000..0762d1e9756
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/usual.test
@@ -0,0 +1,53 @@
+# This file is a Tcl script to test out all of the "usual" options
+# for all of the [incr Widgets]. It looks for other tests in this
+# directory, and tries to create a mega-widget with each of these
+# as a component. If there are any problems with "usual" definitions,
+# they will be found here.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+# ----------------------------------------------------------------------
+# Create a new mega-widget class that we can use to add other
+# classes as components.
+# ----------------------------------------------------------------------
+test usual-1.1 {create a mega-widget that we can add components to} {
+ itcl::class TestUsual {
+ inherit itk::Widget
+ method do {cmd} {
+ eval $cmd
+ }
+ }
+ TestUsual .testUsual
+} {.testUsual}
+
+# ----------------------------------------------------------------------
+# Now, scan through all of the tests in this directory and look
+# for mega-widgets. Add each mega-widget to the test class.
+# ----------------------------------------------------------------------
+set unique 0
+foreach file [glob *.test] {
+ set widget [file rootname [file tail $file]]
+
+ if {$widget != "usual"} {
+ set name "c[incr unique]"
+ test usual-1.2.$name "verify \"usual\" options for $widget" {
+ .testUsual do [format {
+ itk_component add %s {
+ iwidgets::%s $itk_interior.%s
+ }
+ } $name $widget $name]
+ } $name
+ }
+}
diff --git a/itcl/iwidgets3.0.0/tests/watch.test b/itcl/iwidgets3.0.0/tests/watch.test
new file mode 100755
index 00000000000..204ca988195
--- /dev/null
+++ b/itcl/iwidgets3.0.0/tests/watch.test
@@ -0,0 +1,149 @@
+# This file is a Tcl script to test out [incr Widgets] Watch class.
+# It is organized in the standard fashion for Tcl tests with the following
+# notation for test case labels:
+#
+# 1.x - Construction/Destruction tests
+# 2.x - Configuration option tests
+# 3.x - Method tests
+#
+# Copyright (c) 1995 DSC Technologies Corporation
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# @(#) $Id$
+
+package require Iwidgets 3.0
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+wm geometry . {}
+raise .
+
+set c 1
+set o 1
+set m 1
+
+catch {destroy .w}
+
+#
+# Initial construction test
+#
+test Watch-1.$c {Watch construction} {
+ iwidgets::Watch .w
+ pack .w -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+#
+# Option tests which are successful.
+#
+test Watch-2.$o {configuration option} {
+ llength [.w configure]
+} {34}
+
+incr o
+
+foreach test {
+ {-background #d9d9d9 #d9d9d9}
+ {-cursor gumby gumby}
+ {-hourcolor yellow yellow}
+ {-minutecolor blue blue}
+ {-secondcolor green green}
+ {-tickcolor red red}
+ {-clockcolor orange orange}
+ {-clockstipple error error}
+ {-state disabled disabled}
+ {-state normal normal}
+ {-showampm no no}
+ {-showampm yes yes}
+ {-hourradius .3 .3}
+ {-minuteradius .5 .5}
+ {-secondradius .7 .7}} {
+ set option [lindex $test 0]
+ test Watch-2.$o "configuration options, $option" {
+ .w configure $option [lindex $test 1]
+ lindex [.w configure $option] 4
+ } [lindex $test 2]
+ update
+ incr o
+ .w show
+ after 500
+}
+
+#
+# Option tests which fail and produce errors.
+#
+foreach test {
+ {-state bogus {bad state option "bogus": should be normal or disabled}}
+ {-showampm bogus {bad showampm option "bogus": should be boolean}}} {
+ set option [lindex $test 0]
+ test Watch-2.$o "configuration options, $option" {
+ list [catch {.w configure $option [lindex $test 1]} msg] $msg
+ } [list 1 [lindex $test 2]]
+ incr o
+}
+
+#
+# Method tests which are successful.
+#
+foreach test {
+ {{.w show "11:11:11"} {}}
+ {{.w get} "11:11:11 AM"}
+ {{.w show "now"} {}}} {
+ set method [lindex [lindex $test 0] 1]
+ test Watch-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 0 [lindex $test 1]]
+ update
+ incr m
+ after 500
+}
+
+foreach test {
+ {{.w show bogus} {bad time: "bogus", must be a valid time string, clock clicks value or the keyword now}}
+ {{.w get bogus} {bad format option "bogus": should be -string or -clicks}}} {
+ set method [lindex [lindex $test 0] 1]
+ test ScrolledListBox-3.$m "object methods, $method" {
+ list [catch {eval [lindex $test 0]} msg] $msg
+ } [list 1 [lindex $test 1]]
+ incr m
+ .w show
+ after 500
+}
+
+#
+# Conclusion of constrcution/destruction tests
+#
+test Watch-1.$c {Watch destruction} {
+ destroy .w
+ update
+} {}
+
+incr c
+
+test Watch-1.$c {Watch construction} {
+ iwidgets::watch .w
+ pack .w -padx 10 -pady 10 -fill both -expand yes
+ update
+} {}
+
+incr c
+
+test Watch-1.$c {Watch destruction} {
+ destroy .w
+ update
+} {}
+
+incr c
+
+test Watch-1.$c {Watch destruction} {
+ iwidgets::watch .w
+ pack .w
+ destroy .w
+ update
+} {}
diff --git a/itcl/iwidgets3.0.0/unix/Makefile.in b/itcl/iwidgets3.0.0/unix/Makefile.in
new file mode 100644
index 00000000000..3bd06402a99
--- /dev/null
+++ b/itcl/iwidgets3.0.0/unix/Makefile.in
@@ -0,0 +1,233 @@
+#
+# This file is a Makefile for [incr Widgets]. 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$
+
+# Current [incr Widgets] version; used in various names.
+
+ITCL_VERSION = @ITCL_VERSION@
+IWIDGETS_VERSION = @IWIDGETS_VERSION@
+VERSION = $(ITCL_VERSION).$(IWIDGETS_VERSION)
+
+#----------------------------------------------------------------
+# Things you can change to personalize the Makefile for your own
+# site (you can make these changes in either Makefile.in or
+# Makefile, but changes to Makefile will get lost if you re-run
+# the configuration script).
+#----------------------------------------------------------------
+
+# Default top-level directories in which to install architecture-
+# specific files (exec_prefix) and machine-independent files such
+# as scripts (prefix). The values specified here may be overridden
+# at configure-time with the --exec-prefix and --prefix options
+# to the "configure" script.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+
+# The following definition can be set to non-null for special systems
+# like AFS with replication. It allows the pathnames used for installation
+# to be different than those used for actually reference files at
+# run-time. INSTALL_ROOT is prepended to $prefix and $exec_prefix
+# when installing files.
+INSTALL_ROOT =
+
+ # CYGNUS LOCAL - The default library directory is the share directory...
+# Directory from which applications will reference the library of
+# [incr Widgets] scripts (note: you can set the IWIDGETS_LIBRARY environment
+# variable at run-time to override this value):
+IWIDGETS_LIBRARY = $(prefix)/share/iwidgets$(VERSION)
+# END CYGNUS LOCAL
+
+# Path name to use when installing library scripts:
+SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(IWIDGETS_LIBRARY)
+
+# Directory in which to install the archive libtcl.a:
+LIB_INSTALL_DIR = $(INSTALL_ROOT)$(exec_prefix)/lib
+
+# Directory in which to install the program tclsh:
+BIN_INSTALL_DIR = $(INSTALL_ROOT)$(exec_prefix)/bin
+
+# Directory in which to install the include file itcl.h:
+INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)$(prefix)/include
+
+# Top-level directory in which to install manual entries:
+MAN_INSTALL_DIR = $(INSTALL_ROOT)$(prefix)/man
+
+# Directory in which to install manual entry for itclsh:
+MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1
+
+# Directory in which to install manual entries for [incr Tcl]'s
+# C library procedures:
+MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3
+
+# Directory in which to install manual entries for the built-in
+# [incr Tcl] commands:
+MANN_INSTALL_DIR = $(MAN_INSTALL_DIR)/mann
+
+# Directory in which to install html version of manual entries:
+HTML_INSTALL_DIR = $(INSTALL_ROOT)$(prefix)/doc
+
+# Tcl libraries can be found here:
+TCL_LIB_DIR = @TCL_LIB_DIR@
+
+# Directory containing Tcl source code (for library used during test):
+TCL_SRC_DIR = @TCL_SRC_DIR@
+
+# Tk libraries can be found here:
+TK_LIB_DIR = @TK_LIB_DIR@
+
+# Directory containing Tk source code (for library used during test):
+TK_SRC_DIR = @TK_SRC_DIR@
+
+# Itcl libraries can be found here:
+ITCL_LIB_DIR = @ITCL_LIB_DIR@
+
+# Directory containing Itcl source code (for library used during test):
+ITCL_SRC_DIR = @ITCL_SRC_DIR@
+
+# Itk libraries can be found here:
+ITK_LIB_DIR = @ITK_LIB_DIR@
+
+# Directory containing Itk source code (for library used during test):
+ITK_SRC_DIR = @ITK_SRC_DIR@
+
+# [incr Tk] build directory containing the itkwish binary for 'make test'
+ITK_BIN_DIR = ../../itk/unix
+
+# Some versions of make, like SGI's, use the following variable to
+# determine which shell to use for executing commands:
+SHELL = /bin/sh
+
+#----------------------------------------------------------------
+# 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.
+#----------------------------------------------------------------
+
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = $(INSTALL)
+INSTALL_DATA = $(INSTALL) -m 644
+MKINSTALLDIRS = $(ITCL_SRC_DIR)/../config/mkinstalldirs
+RANLIB = @RANLIB@
+TOP_DIR = @IWIDGETS_SRC_DIR@
+GENERIC_DIR = $(TOP_DIR)/generic
+UNIX_DIR = $(TOP_DIR)/unix
+
+#----------------------------------------------------------------
+# The information below should be usable as is. The configure
+# script won't modify it and you shouldn't need to modify it
+# either.
+#----------------------------------------------------------------
+
+all: build
+
+build:
+ @for i in iwidgets.tcl pkgIndex.tcl ; do \
+ echo "Building $$i" ; \
+ rm -f $$i ; \
+ cat $(UNIX_DIR)/$$i.in \
+ | sed -e "s#%ITCL_VERSION%#$(ITCL_VERSION)#g" \
+ | sed -e "s#%IWIDGETS_VERSION%#$(IWIDGETS_VERSION)#g" \
+ > $$i ; \
+ done;
+
+test: $(ITK_BIN_DIR)/itkwish
+ LD_LIBRARY_PATH=$(TCL_LIB_DIR):$(TK_LIB_DIR):$(ITCL_LIB_DIR):$(ITK_LIB_DIR):$(LD_LIBRARY_PATH); export LD_LIBRARY_PATH ; \
+ TCL_LIBRARY=$(TCL_SRC_DIR)/library; export TCL_LIBRARY; \
+ ITCL_LIBRARY=$(ITCL_SRC_DIR)/library; export ITCL_LIBRARY; \
+ TK_LIBRARY=$(TK_SRC_DIR)/library; export TK_LIBRARY; \
+ ITK_LIBRARY=$(ITK_SRC_DIR)/library; export ITK_LIBRARY; \
+ ( echo lappend auto_path $(TOP_DIR)/generic \; package provide Iwidgets $(VERSION) \; cd $(TOP_DIR)/tests\; source all\; exit ) | $(ITK_BIN_DIR)/itkwish
+
+static:
+
+standalone:
+
+plusplus:
+
+install: install-libraries install-demos install-man
+
+install-libraries:
+ @$(MKINSTALLDIRS) $(SCRIPT_INSTALL_DIR) $(LIB_INSTALL_DIR)
+ @rm -f $(LIB_INSTALL_DIR)/iwidgets
+ @$(MKINSTALLDIRS) $(SCRIPT_INSTALL_DIR)/scripts
+ @for i in $(GENERIC_DIR)/*.itk $(GENERIC_DIR)/*.itcl $(GENERIC_DIR)/tclIndex $(GENERIC_DIR)/*.gif ; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/scripts; \
+ done;
+ @for i in iwidgets.tcl pkgIndex.tcl ; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
+ done;
+
+install-demos:
+ @$(MKINSTALLDIRS) $(SCRIPT_INSTALL_DIR)/demos/images $(SCRIPT_INSTALL_DIR)/demos/html
+ @cd $(TOP_DIR)/demos; for i in *; \
+ do \
+ if [ -f $$i ] ; then \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/demos; \
+ chmod 555 $(SCRIPT_INSTALL_DIR)/demos/$$i; \
+ fi; \
+ done;
+ @cd $(TOP_DIR)/demos; for i in images/*; \
+ do \
+ if [ -f $$i ] ; then \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/demos/images; \
+ chmod 444 $(SCRIPT_INSTALL_DIR)/demos/$$i; \
+ fi; \
+ done;
+ @cd $(TOP_DIR)/demos; for i in html/*; \
+ do \
+ if [ -f $$i ] ; then \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/demos/html; \
+ chmod 444 $(SCRIPT_INSTALL_DIR)/demos/$$i; \
+ fi; \
+ done;
+
+install-man:
+ @$(MKINSTALLDIRS) $(MANN_INSTALL_DIR)
+ @cd $(TOP_DIR)/doc; for i in *.n; \
+ do \
+ echo "Installing doc/$$i"; \
+ rm -f $(MANN_INSTALL_DIR)/$$i; \
+ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+ $$i > $(MANN_INSTALL_DIR)/$$i; \
+ chmod 444 $(MANN_INSTALL_DIR)/$$i; \
+ done;
+
+install-html:
+ @$(MKINSTALLDIRS) $(HTML_INSTALL_DIR)
+ @cd $(TOP_DIR)/doc/html; for i in *.html; \
+ do \
+ echo "Installing $(HTML_INSTALL_DIR)/$$i"; \
+ $(INSTALL_DATA) $$i $(HTML_INSTALL_DIR); \
+ chmod 444 $(HTML_INSTALL_DIR)/$$i; \
+ done;
+
+Makefile: $(UNIX_DIR)/Makefile.in
+ $(SHELL) config.status
+
+clean:
+ rm -f core errs *~ \#* TAGS *.E a.out errors
+ rm -f iwidgets.tcl pkgIndex.tcl
+
+distclean: clean
+ rm -f Makefile config.status config.cache config.log
+
+depend:
+ makedepend -- $(CC_SWITCHES) -- $(SRCS)
+
+configure: configure.in
+ autoconf
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
diff --git a/itcl/iwidgets3.0.0/unix/configure b/itcl/iwidgets3.0.0/unix/configure
new file mode 100755
index 00000000000..41e014586be
--- /dev/null
+++ b/itcl/iwidgets3.0.0/unix/configure
@@ -0,0 +1,1118 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+ac_default_prefix=/usr/local
+ac_help="$ac_help
+ --with-tcl=DIR use Tcl 8.0 binaries from DIR"
+ac_help="$ac_help
+ --with-tk=DIR use Tk 8.0 binaries from DIR"
+ac_help="$ac_help
+ --with-itcl=DIR use Itcl 3.0 binaries from DIR"
+ac_help="$ac_help
+ --with-itk=DIR use Itk 3.0 binaries from DIR"
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.13"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=iwidgets.tcl.in
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+# RCS: $Id$
+
+ITCL_VERSION=3.0
+IWIDGETS_VERSION=0
+VERSION=${ITCL_VERSION}.${IWIDGETS_VERSION}
+
+ac_aux_dir=
+for ac_dir in ../../config $srcdir/../../config; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in ../../config $srcdir/../../config" 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+
+
+# -----------------------------------------------------------------------
+# Set up a new default --prefix. If a previous installation of
+# [incr Tcl] can be found searching $PATH use that directory.
+# -----------------------------------------------------------------------
+
+
+if test "x$prefix" = xNONE; then
+echo $ac_n "checking for prefix by $ac_c" 1>&6
+# Extract the first word of "tclsh", so it can be a program name with args.
+set dummy tclsh; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:572: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_path_TCLSH'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ case "$TCLSH" in
+ /*)
+ ac_cv_path_TCLSH="$TCLSH" # Let the user override the test with a path.
+ ;;
+ ?:/*)
+ ac_cv_path_TCLSH="$TCLSH" # Let the user override the test with a dos path.
+ ;;
+ *)
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_path_TCLSH="$ac_dir/$ac_word"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ ;;
+esac
+fi
+TCLSH="$ac_cv_path_TCLSH"
+if test -n "$TCLSH"; then
+ echo "$ac_t""$TCLSH" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -n "$ac_cv_path_TCLSH"; then
+ prefix=`echo $ac_cv_path_TCLSH|sed 's%/[^/][^/]*//*[^/][^/]*$%%'`
+ fi
+fi
+
+
+if test "${prefix}" = "NONE"; then
+ prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+ exec_prefix=$prefix
+fi
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:629: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ # Account for people who put trailing slashes in PATH elements.
+ case "$ac_dir/" in
+ /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ if test -f $ac_dir/$ac_prog; then
+ if test $ac_prog = install &&
+ grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ else
+ ac_cv_path_install="$ac_dir/$ac_prog -c"
+ break 2
+ fi
+ fi
+ done
+ ;;
+ esac
+ done
+ IFS="$ac_save_IFS"
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL="$ac_cv_path_install"
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL="$ac_install_sh"
+ fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+# Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:684: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_RANLIB="ranlib"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+# -----------------------------------------------------------------------
+BUILD_DIR=`pwd`
+IWIDGETS_SRC_DIR=`cd $srcdir/..; pwd`
+cd ${BUILD_DIR}
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Tcl is; if
+# not, search for Tcl.
+# CYGNUS LOCAL: Actually, we call tcl & tk directories "tcl" & "tk", no 8.0
+#--------------------------------------------------------------------
+
+# Check whether --with-tcl or --without-tcl was given.
+if test "${with_tcl+set}" = set; then
+ withval="$with_tcl"
+ itcl_search=$withval
+else
+ itcl_search=`cd ../../..; ls -d \`pwd\`/tcl*/unix`
+fi
+
+
+TCL_LIB_DIR=""
+for dir in $exec_prefix/lib $itcl_search ; do
+ if test -r $dir/tclConfig.sh; then
+ TCL_LIB_DIR=$dir
+ break
+ fi
+done
+
+if test -z "$TCL_LIB_DIR"; then
+ { echo "configure: error: Can't find Tcl libraries. Use --with-tcl to specify the directory containing tclConfig.sh on your system." 1>&2; exit 1; }
+fi
+. $TCL_LIB_DIR/tclConfig.sh
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Tk is; if
+# not, search for Tk.
+# CYGNUS LOCAL: Actually, we call tcl & tk directories "tcl" & "tk", no 8.0
+#--------------------------------------------------------------------
+
+# Check whether --with-tk or --without-tk was given.
+if test "${with_tk+set}" = set; then
+ withval="$with_tk"
+ itcl_search=$withval
+else
+ itcl_search=`cd ../../..; ls -d \`pwd\`/tk*/unix`
+fi
+
+
+TK_LIB_DIR=""
+for dir in $exec_prefix/lib $TCL_LIB_DIR $itcl_search ; do
+ if test -r $dir/tkConfig.sh; then
+ TK_LIB_DIR=$dir
+ break
+ fi
+done
+
+if test -z "$TK_LIB_DIR"; then
+ { echo "configure: error: Can't find Tk libraries. Use --with-tk to specify the directory containing tkConfig.sh on your system." 1>&2; exit 1; }
+fi
+. $TK_LIB_DIR/tkConfig.sh
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Itcl is; if
+# not, search for Itcl.
+#--------------------------------------------------------------------
+
+# Check whether --with-itcl or --without-itcl was given.
+if test "${with_itcl+set}" = set; then
+ withval="$with_itcl"
+ itcl_search=$withval
+else
+ itcl_search=`cd ${BUILD_DIR}/../../itcl; pwd`
+fi
+
+
+ITCL_LIB_DIR=""
+for dir in $exec_prefix/lib $TCL_LIB_DIR $itcl_search ; do
+ if test -r $dir/itclConfig.sh; then
+ ITCL_LIB_DIR=$dir
+ break
+ fi
+done
+
+if test -z "$ITCL_LIB_DIR"; then
+ { echo "configure: error: Can't find Itcl libraries. Use --with-itcl to specify the directory containing itclConfig.sh on your system." 1>&2; exit 1; }
+fi
+. $ITCL_LIB_DIR/itclConfig.sh
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Itk is; if
+# not, search for Itk.
+#--------------------------------------------------------------------
+
+# Check whether --with-itk or --without-itk was given.
+if test "${with_itk+set}" = set; then
+ withval="$with_itk"
+ itcl_search=$withval
+else
+ itcl_search=`cd ${BUILD_DIR}/../../itk; pwd`
+fi
+
+
+ITK_LIB_DIR=""
+for dir in $exec_prefix/lib $TCL_LIB_DIR $itcl_search ; do
+ if test -r $dir/itkConfig.sh; then
+ ITK_LIB_DIR=$dir
+ break
+ fi
+done
+
+if test -z "$ITK_LIB_DIR"; then
+ { echo "configure: error: Can't find Itk libraries. Use --with-itk to specify the directory containing itkConfig.sh on your system." 1>&2; exit 1; }
+fi
+. $ITK_LIB_DIR/itkConfig.sh
+
+#--------------------------------------------------------------------
+# Fill in template files with the proper info.
+#--------------------------------------------------------------------
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.13"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "Makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@TCLSH@%$TCLSH%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@RANLIB@%$RANLIB%g
+s%@BUILD_DIR@%$BUILD_DIR%g
+s%@TCL_LIB_DIR@%$TCL_LIB_DIR%g
+s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
+s%@TK_LIB_DIR@%$TK_LIB_DIR%g
+s%@TK_SRC_DIR@%$TK_SRC_DIR%g
+s%@ITCL_LIB_DIR@%$ITCL_LIB_DIR%g
+s%@ITCL_SRC_DIR@%$ITCL_SRC_DIR%g
+s%@ITK_LIB_DIR@%$ITK_LIB_DIR%g
+s%@ITK_SRC_DIR@%$ITK_SRC_DIR%g
+s%@ITCL_VERSION@%$ITCL_VERSION%g
+s%@IWIDGETS_VERSION@%$IWIDGETS_VERSION%g
+s%@IWIDGETS_LIBRARY@%$IWIDGETS_LIBRARY%g
+s%@IWIDGETS_SRC_DIR@%$IWIDGETS_SRC_DIR%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+ case "$ac_given_INSTALL" in
+ [/$]*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ esac
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
diff --git a/itcl/iwidgets3.0.0/unix/configure.in b/itcl/iwidgets3.0.0/unix/configure.in
new file mode 100644
index 00000000000..43b8476eb43
--- /dev/null
+++ b/itcl/iwidgets3.0.0/unix/configure.in
@@ -0,0 +1,142 @@
+dnl This file is an input file used by the GNU "autoconf" program to
+dnl generate the file "configure", which is run during [incr Tcl]
+dnl installation to configure the system for the local environment.
+
+AC_INIT(iwidgets.tcl.in)
+# RCS: $Id$
+
+ITCL_VERSION=3.0
+IWIDGETS_VERSION=0
+VERSION=${ITCL_VERSION}.${IWIDGETS_VERSION}
+
+AC_CONFIG_AUX_DIR(../../config)
+AC_PREREQ(2.0)
+
+# -----------------------------------------------------------------------
+# Set up a new default --prefix. If a previous installation of
+# [incr Tcl] can be found searching $PATH use that directory.
+# -----------------------------------------------------------------------
+
+AC_PREFIX_DEFAULT(/usr/local)
+AC_PREFIX_PROGRAM(tclsh)
+
+if test "${prefix}" = "NONE"; then
+ prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+ exec_prefix=$prefix
+fi
+
+AC_PROG_INSTALL
+AC_PROG_RANLIB
+
+# -----------------------------------------------------------------------
+BUILD_DIR=`pwd`
+IWIDGETS_SRC_DIR=`cd $srcdir/..; pwd`
+cd ${BUILD_DIR}
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Tcl is; if
+# not, search for Tcl.
+# CYGNUS LOCAL: Actually, we call tcl & tk directories "tcl" & "tk", no 8.0
+#--------------------------------------------------------------------
+
+AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.0 binaries from DIR],
+ itcl_search=$withval, itcl_search=`cd ../../..; ls -d \`pwd\`/tcl*/unix`)
+
+TCL_LIB_DIR=""
+for dir in $exec_prefix/lib $itcl_search ; do
+ if test -r $dir/tclConfig.sh; then
+ TCL_LIB_DIR=$dir
+ break
+ fi
+done
+
+if test -z "$TCL_LIB_DIR"; then
+ AC_MSG_ERROR(Can't find Tcl libraries. Use --with-tcl to specify the directory containing tclConfig.sh on your system.)
+fi
+. $TCL_LIB_DIR/tclConfig.sh
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Tk is; if
+# not, search for Tk.
+# CYGNUS LOCAL: Actually, we call tcl & tk directories "tcl" & "tk", no 8.0
+#--------------------------------------------------------------------
+
+AC_ARG_WITH(tk, [ --with-tk=DIR use Tk 8.0 binaries from DIR],
+ itcl_search=$withval, itcl_search=`cd ../../..; ls -d \`pwd\`/tk*/unix`)
+
+TK_LIB_DIR=""
+for dir in $exec_prefix/lib $TCL_LIB_DIR $itcl_search ; do
+ if test -r $dir/tkConfig.sh; then
+ TK_LIB_DIR=$dir
+ break
+ fi
+done
+
+if test -z "$TK_LIB_DIR"; then
+ AC_MSG_ERROR(Can't find Tk libraries. Use --with-tk to specify the directory containing tkConfig.sh on your system.)
+fi
+. $TK_LIB_DIR/tkConfig.sh
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Itcl is; if
+# not, search for Itcl.
+#--------------------------------------------------------------------
+
+AC_ARG_WITH(itcl, [ --with-itcl=DIR use Itcl 3.0 binaries from DIR],
+ itcl_search=$withval, itcl_search=`cd ${BUILD_DIR}/../../itcl; pwd`)
+
+ITCL_LIB_DIR=""
+for dir in $exec_prefix/lib $TCL_LIB_DIR $itcl_search ; do
+ if test -r $dir/itclConfig.sh; then
+ ITCL_LIB_DIR=$dir
+ break
+ fi
+done
+
+if test -z "$ITCL_LIB_DIR"; then
+ AC_MSG_ERROR(Can't find Itcl libraries. Use --with-itcl to specify the directory containing itclConfig.sh on your system.)
+fi
+. $ITCL_LIB_DIR/itclConfig.sh
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Itk is; if
+# not, search for Itk.
+#--------------------------------------------------------------------
+
+AC_ARG_WITH(itk, [ --with-itk=DIR use Itk 3.0 binaries from DIR],
+ itcl_search=$withval, itcl_search=`cd ${BUILD_DIR}/../../itk; pwd`)
+
+ITK_LIB_DIR=""
+for dir in $exec_prefix/lib $TCL_LIB_DIR $itcl_search ; do
+ if test -r $dir/itkConfig.sh; then
+ ITK_LIB_DIR=$dir
+ break
+ fi
+done
+
+if test -z "$ITK_LIB_DIR"; then
+ AC_MSG_ERROR(Can't find Itk libraries. Use --with-itk to specify the directory containing itkConfig.sh on your system.)
+fi
+. $ITK_LIB_DIR/itkConfig.sh
+
+#--------------------------------------------------------------------
+# Fill in template files with the proper info.
+#--------------------------------------------------------------------
+AC_SUBST(BUILD_DIR)
+AC_SUBST(TCL_LIB_DIR)
+AC_SUBST(TCL_SRC_DIR)
+AC_SUBST(TK_LIB_DIR)
+AC_SUBST(TK_SRC_DIR)
+AC_SUBST(ITCL_LIB_DIR)
+AC_SUBST(ITCL_SRC_DIR)
+AC_SUBST(ITK_LIB_DIR)
+AC_SUBST(ITK_SRC_DIR)
+
+AC_SUBST(ITCL_VERSION)
+AC_SUBST(IWIDGETS_VERSION)
+AC_SUBST(IWIDGETS_LIBRARY)
+AC_SUBST(IWIDGETS_SRC_DIR)
+
+AC_OUTPUT(Makefile)
diff --git a/itcl/iwidgets3.0.0/unix/iwidgets.tcl.in b/itcl/iwidgets3.0.0/unix/iwidgets.tcl.in
new file mode 100644
index 00000000000..4d2487996a6
--- /dev/null
+++ b/itcl/iwidgets3.0.0/unix/iwidgets.tcl.in
@@ -0,0 +1,29 @@
+#
+# iwidgets.tcl
+# ----------------------------------------------------------------------
+# Invoked automatically by [incr Tk] upon startup to initialize
+# the [incr Widgets] package.
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@spd.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 Mark L. Ulferts
+# ======================================================================
+# See the file "license.terms" for information on usage and
+# redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+package require Tcl 8.0
+package require Tk 8.0
+package require Itcl %ITCL_VERSION%
+package require Itk %ITCL_VERSION%
+
+namespace eval ::iwidgets {
+ namespace export *
+
+ variable library [file dirname [info script]]
+ variable version %ITCL_VERSION%.%IWIDGETS_VERSION%
+}
+
+lappend auto_path [file join $iwidgets::library scripts]
+package provide Iwidgets $iwidgets::version
diff --git a/itcl/iwidgets3.0.0/unix/pkgIndex.tcl.in b/itcl/iwidgets3.0.0/unix/pkgIndex.tcl.in
new file mode 100644
index 00000000000..acb2de77392
--- /dev/null
+++ b/itcl/iwidgets3.0.0/unix/pkgIndex.tcl.in
@@ -0,0 +1,3 @@
+# Tcl package index file, version 1.0
+
+package ifneeded Iwidgets %ITCL_VERSION%.%IWIDGETS_VERSION% [list source [file join $dir iwidgets.tcl]]
diff --git a/itcl/license.terms b/itcl/license.terms
new file mode 100644
index 00000000000..5771c69e3be
--- /dev/null
+++ b/itcl/license.terms
@@ -0,0 +1,83 @@
+This software is copyrighted by Lucent Technologies, Inc., and other
+parties. The following terms apply to all files associated with the
+software unless explicitly disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
+
+-----------------------------------------------------------------------
+ Following is the original agreement for the Tcl/Tk software from
+ Sun Microsystems.
+-----------------------------------------------------------------------
+
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., and other parties. The following
+terms apply to all files associated with the software unless explicitly
+disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
diff --git a/itcl/makefile.bc b/itcl/makefile.bc
new file mode 100644
index 00000000000..12762724db9
--- /dev/null
+++ b/itcl/makefile.bc
@@ -0,0 +1,114 @@
+# Borland 5.01 Makefile for Itcl 2.2 Distribution
+#
+# This is the main Borland makefile for the Windows distribution
+# of [incr Tcl] version 2.2.
+
+#
+# TOOLS -- path to root of Borland Directory
+# TARGET_ROOT -- Target Directory for installation
+# SOURCE_ROOT -- Path to root of source tree
+
+TOOLS = c:\bc45
+TARGET_ROOT = c:\Program files\Itcl2.2
+SOURCE_ROOT = c:\Itcl2.2
+
+#
+# You should not have to modify anything further in this makefile
+#
+
+#
+# Borland C++ tools
+#
+
+BORLAND = $(TOOLS)
+IMPLIB = $(BORLAND)\bin\Implib
+BCC32 = $(BORLAND)\bin\Bcc32
+TLINK32 = $(BORLAND)\bin\tlink32
+RC = $(BORLAND)\bin\brcc32
+BCC = $(BORLAND)\bin\Bcc
+TLINK = $(BORLAND)\bin\tlink
+RC16 = $(BORLAND)\bin\brcc32 -31
+MAKE = $(BORLAND)\bin\make -fmakefile.bc
+
+#
+# System calls
+#
+
+CP = copy
+RM = del
+MKDIR = -mkdir
+
+#
+# Source and Build Paths
+#
+
+TCLDIR = $(SOURCE_ROOT)\Tcl7.6
+TKDIR = $(SOURCE_ROOT)\Tk4.2
+ITCLDIR = $(SOURCE_ROOT)\Itcl
+ITKDIR = $(SOURCE_ROOT)\Itk
+IWIDGETSDIR = $(SOURCE_ROOT)\Iwidgets2.2.0
+
+#
+# Target Paths
+#
+
+TARGET_BIN = $(TARGET_ROOT)\Bin
+TARGET_LIB_ROOT = $(TARGET_ROOT)\Lib
+TARGET_LIB = $(TARGET_LIB_ROOT)\Itcl
+TARGET_INCLUDE_ROOT = $(TARGET_ROOT)\Include
+TARGET_INCLUDE = $(TARGET_INCLUDE_ROOT)\Itcl
+TARGET_DOC = $(TARGET_ROOT)\Html
+
+#
+# Shared Target Files:
+#
+
+TCLLIB = Tcl76i.lib
+TCLDLL = Tcl76i.dll
+TKLIB = Tk42i.lib
+TKDLL = Tk42i.dll
+ITCLLIB = Itcl22.lib
+ITCLDLL = Itcl22.dll
+ITKLIB = Itk22.lib
+ITKDLL = Itk22.dll
+
+#
+# Paths to Build locations of libraries
+#
+TCLLIBDIR = $(TCLDIR)\Win
+TKLIBDIR = $(TKDIR)\Win
+ITCLLIBDIR = $(ITCLDIR)\Win
+ITKLIBDIR = $(ITKDIR)\Win
+
+
+dist:
+ cd $(TCLDIR)\Win
+ $(MAKE) all
+ cd $(TKDIR)\Win
+ $(MAKE) all
+ cd $(ITCLDIR)\Win
+ $(MAKE) all
+ cd $(ITKDIR)\Win
+ $(MAKE) all
+
+dist-install:
+ cd $(TCLDIR)\Win
+ $(MAKE) install
+ cd $(TKDIR)\Win
+ $(MAKE) install
+ cd $(ITCLDIR)\Win
+ $(MAKE) install
+ cd $(ITKDIR)\Win
+ $(MAKE) install
+ cd $(IWIDGETSDIR)\Win
+ $(MAKE) install
+
+dist-clean:
+ cd $(TCLDIR)\Win
+ $(MAKE) clean
+ cd $(TKDIR)\Win
+ $(MAKE) clean
+ cd $(ITCLDIR)\Win
+ $(MAKE) clean
+ cd $(ITKDIR)\Win
+ $(MAKE) clean
diff --git a/itcl/makefile.vc b/itcl/makefile.vc
new file mode 100644
index 00000000000..609a4a7c81a
--- /dev/null
+++ b/itcl/makefile.vc
@@ -0,0 +1,147 @@
+#
+# Visual C++ 4.1 makefile
+#
+
+# This is the main Visual C++ makefile for the Windows distribution
+# of [incr Tcl] version 2.2. To compile the distribution using Visual
+# C++, copy "makefile.vc" to "makefile". Then set the macros for the
+# location of the source tree, the target directory, and the Microsoft
+# Compilers. You may then "make dist" to build the distribution, and
+# "make dist-install" to install it to the target directory you specify
+# below.
+
+#
+# There are three primary targets for the distribution:
+#
+# dist: build the entire distribution: Tcl, Tk, Itcl, Itk
+#
+# dist-install: moves built files to target directory
+#
+# dist-clean: erases built files in source tree
+
+#
+# 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++.
+#
+# TOOLS16 = location of VC++ 1.5 16-bit tools, needed to build thunking
+# library. This information is optional; if the 16-bit compiler
+# is not available, then the 16-bit code will not be built.
+# Tcl will still run without the 16-bit code, but...
+# A. Under Windows 3.X you will any calls to the exec command
+# will return an error.
+# B. A 16-bit program to test the behavior of the exec
+# command under NT and 95 will not be built.
+#
+# TARGET_ROOT -- Target Directory for installation
+#
+# SOURCE_ROOT -- Path to root of source tree
+#
+
+TOOLS32 = c:\msdev
+TOOLS16 = c:\msvc
+TARGET_ROOT = c:\Program files\Itcl2.2
+SOURCE_ROOT = c:\itcl2.2
+
+#
+# You should not have to modify anything further in this makefile
+#
+
+#
+# Borland C++ tools
+#
+
+cc32 = $(TOOLS32)\bin\cl.exe
+link32 = $(TOOLS32)\bin\link.exe
+rc32 = $(TOOLS32)\bin\rc.exe
+include32 = -I$(TOOLS32)\include
+
+cc16 = $(TOOLS16)\bin\cl.exe
+link16 = $(TOOLS16)\bin\link.exe
+rc16 = $(TOOLS16)\bin\rc.exe
+include16 = -I$(TOOLS16)\include
+MAKE = $(TOOLS32)\bin\nmake -fmakefile.vc
+
+#
+# System calls
+#
+
+CP = copy
+RM = del
+MKDIR = -mkdir
+
+#
+# Source and Build Paths
+#
+
+TCLDIR = $(SOURCE_ROOT)\Tcl7.6
+TKDIR = $(SOURCE_ROOT)\Tk4.2
+ITCLDIR = $(SOURCE_ROOT)\Itcl
+ITKDIR = $(SOURCE_ROOT)\Itk
+IWIDGETSDIR = $(SOURCE_ROOT)\Iwidgets2.2.0
+
+#
+# Target Paths
+#
+
+TARGET_BIN = $(TARGET_ROOT)\Bin
+TARGET_LIB_ROOT = $(TARGET_ROOT)\Lib
+TARGET_LIB = $(TARGET_LIB_ROOT)\Itcl
+TARGET_INCLUDE_ROOT = $(TARGET_ROOT)\Include
+TARGET_INCLUDE = $(TARGET_INCLUDE_ROOT)\Itcl
+TARGET_DOC = $(TARGET_ROOT)\Html
+
+#
+# Shared Target Files:
+#
+
+TCLLIB = Tcl76i.lib
+TCLDLL = Tcl76i.dll
+TKLIB = Tk42i.lib
+TKDLL = Tk42i.dll
+ITCLLIB = Itcl22.lib
+ITCLDLL = Itcl22.dll
+ITKLIB = Itk22.lib
+ITKDLL = Itk22.dll
+
+#
+# Paths to Build locations of libraries
+#
+TCLLIBDIR = $(TCLDIR)\Win
+TKLIBDIR = $(TKDIR)\Win
+ITCLLIBDIR = $(ITCLDIR)\Win
+ITKLIBDIR = $(ITKDIR)\Win
+
+
+dist:
+ cd $(TCLDIR)\Win
+ $(MAKE) all
+ cd $(TKDIR)\Win
+ $(MAKE) all
+ cd $(ITCLDIR)\Win
+ $(MAKE) all
+ cd $(ITKDIR)\Win
+ $(MAKE) all
+
+dist-install:
+ cd $(TCLDIR)\Win
+ $(MAKE) install
+ cd $(TKDIR)\Win
+ $(MAKE) install
+ cd $(ITCLDIR)\Win
+ $(MAKE) install
+ cd $(ITKDIR)\Win
+ $(MAKE) install
+ cd $(IWIDGETSDIR)\Win
+ $(MAKE) install
+
+dist-clean:
+ cd $(TCLDIR)\Win
+ $(MAKE) clean
+ cd $(TKDIR)\Win
+ $(MAKE) clean
+ cd $(ITCLDIR)\Win
+ $(MAKE) clean
+ cd $(ITKDIR)\Win
+ $(MAKE) clean
diff --git a/itcl/testsuite/config/default.exp b/itcl/testsuite/config/default.exp
new file mode 100644
index 00000000000..874dc8a6ba9
--- /dev/null
+++ b/itcl/testsuite/config/default.exp
@@ -0,0 +1,20 @@
+# Dejagnu test wrapper for [incr tcl] test suite
+# Copyright 1997 Cygnus Solutions
+
+# Extract and print version number.
+proc itcl_version {} {
+ # No way to extract this in version 1.5.
+ clone_output "itcl version 1.5\n"
+}
+
+proc itcl_exit {} {
+}
+
+proc itcl_start {} {
+ global spawn_id objdir
+
+ spawn $objdir/src/itcl_sh
+}
+
+proc itcl_load {} {
+}
diff --git a/itcl/testsuite/itcl.tests/itcl-test.exp b/itcl/testsuite/itcl.tests/itcl-test.exp
new file mode 100644
index 00000000000..438834c1197
--- /dev/null
+++ b/itcl/testsuite/itcl.tests/itcl-test.exp
@@ -0,0 +1,39 @@
+# Copyright 1997 Cygnus Solutions
+
+if {$tracelevel} then {
+ strace $tracelevel
+}
+
+if {[itcl_start] == -1} then {
+ perror "Couldn't start the itcl test shell" 0
+ return -1
+}
+
+if {! [file exists ${srcdir}/../tests/all]} then {
+ perror "File \"all\" is missing" 0
+ return -1
+}
+
+# This is safe because the itcl tests don't create any temporary
+# files. If they did, we'd have to edit the test suite so that it
+# could be run from a non-srcdir, like we did for the Tcl test suite.
+expect "% "
+send "cd ${srcdir}/../tests; source all; exit\n"
+
+expect {
+ -re ">>>> PASSED TEST (\[^\r\n\]*)\[\r\n\]+" {
+ pass $expect_out(1,string)
+ exp_continue
+ }
+
+ -re ">>>> FAILED TEST (\[^\r\n\]*)\[\r\n\]+" {
+ fail $expect_out(1,string)
+ exp_continue
+ }
+
+ "== ALL TESTS SUCCESSFUL ==" {
+ # Done.
+ }
+}
+
+catch close
diff --git a/libgui/ChangeLog b/libgui/ChangeLog
new file mode 100644
index 00000000000..2a16f91ba45
--- /dev/null
+++ b/libgui/ChangeLog
@@ -0,0 +1,828 @@
+Fri Sep 17 19:14:15 1999 Andrew Cagney <cagney@b1.cygnus.com>
+
+ * src/guitcl.h (cyg_create_warp_pointer_command): Add declaration.
+
+1999-09-07 Jim Ingham <jingham@cygnus.com>
+
+ * library/tclIndex: Rebuild - this somehow got built wrong,
+ leaving out all the debug, and all the panedwindow references.
+
+1999-09-02 Syd Polk <spolk@cygnus.com>
+
+ * library/Makefile.am: Revert bad merge
+ * library/Makefile.in: Regenerate
+
+1999-08-10 James Ingham <jingham@leda.cygnus.com>
+
+ * library/balloon.tcl (BALLOON_command_withdraw): New command, use
+ to remove the balloon before it's timeout has expired.
+
+1999-08-02 James Ingham <jingham@leda.cygnus.com>
+
+ * library/combobox.tcl (::combobox::setValue): Call the combobox
+ command after idle, so the menu gets a chance to unpost itself
+ before the command is run.
+
+1999-05-26 Ian Roxborough <irox@cygnus.com>
+
+ * library/combobox.tcl: If a combobox is not editable then
+ make the background of the text box white.
+
+1999-04-29 Syd Polk <spolk@cygnus.com>
+
+ * src/paths.c: Add a scaled-down version of path initialization
+ in Visual C++ build.
+
+1999-04-28 Syd Polk <spolk@cygnus.com>
+
+ * acinclude.m4: Add from devo.
+ * aclocal.m4: Regenerate.
+ * configure: Regenerate.
+ * Makefile.in: Regenerate.
+ * library/Makefile.am: Use auto_mkindex to generate tclIndex. The
+ itcl1.5 one generates bogus entries sometimes.
+ * library/Makefile.in: Regenerate.
+ * src/Makefile.in: Regenerate.
+
+1999-04-17 Syd Polk <spolk@cygnus.com>
+
+ * Revert merge. I checked in itcl3.0 code into a itcl 1.5 branch.
+
+1999-04-22 Khamis Abuelkomboz <khamis@cygnus.com>
+
+ * library/tree.tcl (treetable_bindings): moved the default bindings
+ source code from SN into the file to build unseparated unit. The
+ bindings themself relay (compatible) on the listbox bindings.
+ -the bindings are defined when ever the file is loaded, so no
+ need to call the function extra.
+
+1999-04-07 Khamis Abuelkomboz <khamis@cygnus.com>
+
+ * library/tree.tcl (print_dialog_box): deleted reference to -leader
+ option of the print dialog.
+ (Tree): added a new public variable to specify a customer
+ post command for the right-mouse menu.
+
+ * library/toolbar.tcl (TOOLBAR_button_leave): synchronize enter/leave
+ to not mismatch a relief change.
+
+1999-03-30 Khamis Abuelkomboz <khamis@cygnus.com>
+
+ * library/tclIndex: regenerated.
+
+ * library/tree.tcl (start_motion): by changing column size use only a
+ black line.
+
+ * library/toolbar.tcl (TOOLBAR_button_up): patched toolbar procedures
+ to support buttons that interact like chechbuttons (remain flat or
+ sunken). The button keeps it's original relief after the pointer
+ leaves the widget.
+ (TOOLBAR_button_up): How the bindings are made for the toolbar buttons
+ is wrong. I patched it to work now for SN, but it must be a general
+ fix, even for gdbtk. When you bind events to the button use please
+ {+ ...} to keep existing bindings for the widget.
+ (TOOLBAR_command): new. To change the relief state of a checkbutton-
+ like widgets from the application.
+
+1999-03-29 Martin Hunt <hunt@cygnus.com>
+
+ * library/combobox.tcl (::combobox::computeGeometry): Calculate
+ geometry based on whole thing, including scrollbar. This fixes
+ the problem from the last couple of months where the popup list
+ box was not below the dropdown button unless there was a scrollbar.
+
+1999-03-29 Syd Polk <spolk@cygnus.com>
+
+ * src/paths.c: Added initialization back in for Visual C++
+ build. Pared it down so that VC++ can actually compile it.
+ Stupid MS 2048 character limit.
+
+1999-03-17 Khamis Abuelkomboz <khamis@cygnus.com>
+
+ * library/tree.tcl (create_tabs): patched the tree table to support
+ resizing a column when moving around the column line.
+ (button_motion): new function realized resizing the columns using an
+ area mode.
+
+1999-03-15 Ian T Roxborough <irox@cygnus.com>
+
+ * library/combobox.tcl(combobox::configure): On Windows draw a black
+ box around the popup for a better Windows look'n'feel.
+
+1999-03-15 Khamis Abuelkomboz <khamis@cygnus.com>
+
+ * library/tree.tcl: Placed here from SN tree to allow other parties
+ to use it for there own applications. If you want to see how it is
+ used, please refer to snavigator/gui/*.tcl.
+
+ * library/Makefile.in: added tree.tcl as part of the library.
+
+ * library/Makefile.am: likewise.
+
+Wed Mar 10 19:44:31 1999 Geoffrey Noer <noer@cygnus.com>
+
+ * src/tclgetdir.c: Need to also include shlobj.h if we're
+ using standard Win32 API headers (not the old set of Cygwin
+ headers).
+
+1999-03-09 Ian T Roxborough <irox@cygnus.com>
+
+ * library/combobox.tcl(combobox::configure): On Windows
+ if -editable is 0, use a standard background for the
+ entry widget (better windowz look'n'feel)
+
+Fri Mar 5 11:00:54 1999 Khamis Abuelkombuz <khamis@cygnus.com>
+
+ * src/tkGraphCanvas.c: fixed the hash problem. Uses a hash table that
+ is associated with the interp rather to use a static hash table.
+
+1999-03-04 Syd Polk <spolk@cygnus.com>
+
+ * src/tkTreeTable.c: Re-fixed SunOS build problem.
+
+Wed Mar 3 16:57:21 1999 Khamis Abuelkombuz <khamis@cygnus.com>
+
+ * src/tkGraphCanvas.c: fixed the hash problem. Uses a hash table that
+ is associated with the interp rather to use a static hash table.
+
+1999-03-03 James Ingham <jingham@cygnus.com>
+
+ * library/combobox.tcl (::combobox::setValue): Call the command in
+ an after idle, so that the combobox gets a chance to unpost before
+ the action is taken.
+
+1999-02-23 Martin Hunt <hunt@cygnus.com>
+
+ * src/paths.c: Change error message so that it says
+ it can't find "GUI" library instead of "IDE" library.
+
+1999-02-18 Martin Hunt <hunt@cygnus.com>
+
+ * library/hooks.tcl (run_hooks): Cleanup error message.
+
+1999-02-17 Martin Hunt <hunt@cygnus.com>
+
+ * library/internet.tcl (open_url): Change to open another
+ window for Netscape on Unix. Returns 0 on failure, 1 on
+ success.
+
+1999-02-11 Syd Polk <spolk@cygnus.com>
+
+ * configure.in: Fixed problem with comparison to xcl.
+ * configure: Regenerated.
+
+1999-02-10 Syd Polk <spolk@cygnus.com>
+
+ * configure.in: Find the correct itclsh.
+ Fixed problem with cygwin build. Should not need cygpath
+ to configure.
+ * configure: Regenerated.
+
+1999-02-10 Martin Hunt <hunt@cygnus.com>
+
+ * library/bgerror.tcl (bgerror): Do not use the old debug
+ preferences. Write errors into debug window. Keep old
+ dialog for now, although it should probably either go away
+ or be replaced by instructions on how to file a PR.
+
+1999-02-09 Martin Hunt <hunt@cygnus.com>
+
+ * library/panedwindow.tcl (cyg::PanedWindow): Add -sashcolor
+ option.
+ (cyg::PanedWindow::sashcolor): New config method.
+ (cyg::PanedWindow::_makeSashes): Set sash color.
+
+1999-02-01 James Ingham <jingham@cygnus.com>
+
+ * src/paths.c: Put in some missing \n\'s.
+
+1999-01-22 Jim Ingham <jingham@cygnus.com>
+
+ Merging changes in from gdbtk-980810-branch
+
+ 1999-01-22 Martin Hunt <hunt@cygnus.com>
+
+ * library/panedwindow.tcl (cyg::PanedWindow::delete): Fix
+ variable name so this function works again.
+ * src/tkWarpPointer.c: New file. Implements tcl function
+ warp_pointer, used by the testsuite.
+ * src/Makefile.am: Added tkWarpPointer.c.
+
+ 1998-12-17 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/panedwindow.tcl (cyg::PanedWindow::sashwidth): Change
+ borderwidth to 2.
+ (cyg::PanedWindow::_makeSashes): Ditto.
+ (cyg::PanedWindow::delete): Free up the space in the _frac
+ array when a pane is deleted.
+ (cyg::PanedWindow::hide): Ditto.
+ (cyg::PanedWindow::replace): New function. Replaces an active
+ pane with an inactive (hidden) one.
+
+ 1998-12-16 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/panedwindow.tcl: New file. Implements
+ cyg::PanedWindow which is a generic paned window supporting
+ non-resizable panes, individual max and min pane sizes. It
+ has a very different look from the iwidget panedwindow.
+
+ * library/pane.tcl: New file. Basically an extended pane.itk
+ from the iwidgets distribution.
+
+ 1998-08-10 Jim Ingham <jingham@cygnus.com>
+
+ * src/paths.c: Figure out how to run from the build tree.
+1999-01-14 Ben Elliston <bje@cygnus.com>
+
+ * src/tkTreeTable.c: Remove unnecessary #includes that collide
+ with Tcl's compat headers.
+
+1998-12-14 Ian Roxborough <irox@cygnus.com>
+
+ * src/tclwinfont.c (win_choose_font): convert all result strings
+ to utf8 format if using tcl/tk8.1.
+
+1998-12-12 Ian Roxborough <irox@cygnus.com>
+ * src/tclgetdir.c (get_directory_command): Make sure that
+ the parent is getting redrawn if the dialog box moves.
+ * src/tclwinfont.c (win_choose_font): Make sure that
+ the parent is getting redrawn if the dialog box moves.
+
+1998-12-12 Khamis Abuelkomboz <khamis@cygnus.com>
+
+ * src/tkTreeTable.c (DisplayRecursive): use metrics.descent by
+ displaying the active line.
+
+1998-12-11 Syd Polk <spolk@cygnus.com>
+
+ * src/tkgetdir.c: The arguments to this need to be
+ converted from UTF-8 and the return value needs to
+ be converted to UTF-8 in Tcl 8.1.
+
+1998-11-30 Ian Roxborough <irox@cygnus.com>
+
+ * src/tkWinPrintCanvas.c (PrintCanvasCmd): return OK
+ if the user hits cancel.
+ * src/tkGraphCanvas.c (GraphCanvasCmd): changed to free()s
+ to ckfree()s.
+
+1998-11-17 Ian Roxborough <irox@cygnus.com>
+
+ * src/tkWinPrintText.c (PrintTextCmd): Disable the print
+ selection until it is implemented properly.
+
+1998-11-17 Ben Elliston <bje@cygnus.com>
+
+ * src/tkTreeTable.h: Merge from Source-Navigator.
+
+ * src/tkTreeTable.c: Likewise.
+
+1998-11-16 Ian Roxborough <irox@cygnus.com>
+
+ * src/tkWinPrintText.c (PrintTextCmd): return OK
+ if the user hits cancel.
+
+1998-11-11 Khamis Abuelkomboz <khamis@cygnus.com>
+
+ * src/tkTreeTable.c: using tcl/memory allocation functions.
+
+ * src/tkCanvLayout.c (LayoutClearGraph): check parent/succ for
+ availiability before freeing it.
+
+1998-06-04 Jim Blandy <jimb@zwingli.cygnus.com>
+
+ * configure.in: Use AM_PROC_CC_STDC, since this directory requires
+ ANSI C in order to compile.
+ * aclocal.m4, configure: Regenerated.
+
+Thu Dec 17 11:46:04 1998 Keith Seitz <keiths@cygnus.com>
+
+ * library/combobox.tcl (::combobox::computeGeometry): Allow
+ the listbox to expand larger than the limits of the combobox.
+ (::combobox::widgetProc): Pack the scrollbar before the listbox
+ so that scroll remains visible when the combobox shrinks.
+ (::combobox::build): Ditto for the button.
+
+Sun Nov 8 23:52:31 1998 Felix Lee <flee@cygnus.com>
+
+ * configure.in (ac_win_build): quoting fix.
+ * configure: regenerated.
+
+Wed Nov 4 18:46:13 1998 Dave Brolley <brolley@cygnus.com>
+
+ * acinclude.m4: New file.
+ * Makefile.in: Regenerated.
+ * aclocal.m4: Regenerated.
+ * configure: Regenerated.
+
+1998-11-04 Ian Roxborough <irox@cygnus.com>
+
+ * src/tkWinPrintText.c (PrintTextCmd): For Tk 8.1 call
+ TkTextMakeByteIndex, otherwise call TkTextMakeIndex.
+ * src/tkWinPrintText.c: Remove some compiler warnings.
+ * src/tkWinPrintCanvas.c: Remove some compiler warnings.
+
+1998-11-02 Ben Elliston <bje@cygnus.com>
+
+ * src/xpmlib.c (LONGBITS): Take the sizeof `long', not
+ `LONG'. Most UNIX environments have no such macro.
+
+1998-10-30 Ian Roxborough <irox@cygnus.com>
+
+ * src/xpmlib.c (ImgXpmGetPixmapFromData): calculate the
+ bitmap pading the same the tk x-emulation layer does.
+
+1998-10-29 Ben Elliston <bje@cygnus.com>
+
+ * configure.in: Look for itcl_sh in the PATH.
+ * configure: Regenerate.
+ * library/Makefile.am: Use discovered path to itcl_sh.
+ * library/Makefile.in: Regenerate.
+ * Makefile.in: Likewise.
+ * src/Makefile.in: Likewise.
+
+1998-10-28 Syd Polk <spolk@cygnus.com>
+
+ * configure.in: Generate a TCL_LIBRARY for itcl_sh to use.
+ * configure: Regenerate
+ * library/Makefile.am: Use generated TCL_LIBRARY.
+ * library/Makefile.in: Regenerate.
+
+1998-10-28 Syd Polk <spolk@cygnus.com>
+
+ * configure.in: Generate correctly formatted directories for itcl_sh
+ * configure: Regenerate
+ * library/Makefile.am: Pass correctly formatted directories to itcl
+ so that it does not get confused with cygwin paths when generating
+ tclIndex.
+ * library/Makefile.in: Regenerate
+
+1998-10-27 Syd Polk <spolk@cygnus.com>
+
+ * configure.in: Add test and AM_CONDITIONAL for Windows.
+ * library/Makefile.am: On Windows, piping output straight from pwd
+ to itcl_sh.exe does not work if build is not on /. Wrap the pwd
+ in a cygpath.
+ * configure: Regenerate
+ * library/Makefile.in: Regenerate.
+
+1998-10-27 Syd Polk <spolk@cygnus.com>
+
+ * src/Makefile.am: Fix TKHDIR problems.
+ * src/Makefile.in: Regenerate.
+
+1998-10-26 Syd Polk <spolk@cygnus.com>
+
+ * configure.in: Use TCLHDIR instead of TCL_BUILD_INCLUDES and
+ TKHDIR instead of TK_BUILD_INCLUDES
+ * configure: Regenerate
+ * src/Makefile.am: Use TCLHDIR instead of TCL_BUILD_INCLUDES
+ TKHDIR instead of TK_BUILD_INCLUDES
+ * src/Makefile.in: Regenerate
+
+Mon Oct 26 09:19:34 1998 Ian Roxborough <irox@cygnus.com>
+
+ * src/Makefile.am: Add tkWinPrintText.c and tkWinPrintCanvas.c
+ * src/tkWinPrintText.c: removed a MSVC++ headerfile and
+ protected the file with pragmas (_WIN32) so it isn't
+ compiled on Unix builds.
+ * src/tkWinPrintCanvas.c: Same as tkWinPrintText.c
+ * src/tkWinPrintText.c (PrintTextCmd): Trick TkTextXviewCmd into
+ calling UpdateDisplayInfo, this means tk doesn't need patched.
+ Cleaned up/added some comments.
+
+1998-10-20 Syd Polk <spolk@cygnus.com>
+
+ * aclocal.m4: Added include for standard macros to locate tcl and tk
+ * configure.in: Use standard macros for tcl and tk
+ * configure: Regenerated
+ * Makefile.in: Regenerated with latest automake
+ * library/Makefile.in: Regenerated with latest automake
+ * src/Makefile.am: Don't use hard-coded pathnames for tcl and tk
+ directories; use variables instead
+ * src/Makefile.in: Regenerated
+
+1998-10-14 Syd Polk <spolk@cygnus.com>
+
+ * src/tclwinfont.c: Compile fix for tcl 8.1.
+
+Wed Oct 14 13:01:00 1998 Ian Roxborough <irox@cygnus.com>
+
+ *src/xpmlib.c (ImgXpmGetPixmapFromData): Fix pixmaps
+ on windows (SN problem), if pixmap mask width <= half the
+ bit padding, then things got messed up. (mayby a bug in
+ the X-emulation layer).
+ - Remove some old commented out code.
+
+Fri Oct 9 10:04:00 1998 Ian Roxborough <irox@cygnus.com>
+
+ * src/xpmlib.c (ImgXpmGetPixmapFromData): set memory allocated
+ for the mask to zero before using.
+
+1998-10-05 Syd Polk <spolk@cygnus.com>
+
+ * configure: Regenerated with new autoconf
+
+Mon Oct 5 00:53:59 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/balloon.tcl (showballoon): Add "keep" parameter
+ to tell balloon messages to not go away after 6 seconds.
+ (BALLOON_command_show): Ditto.
+
+Wed Sep 30 9:35:00 1998 Ian Roxborough <irox@cygnus.com>
+
+ *src/tkprintcanvas.c: New file, for printing a canvas under windows.
+
+Mon Sep 21 15:45:17 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/combobox.tcl (::combobox::setValue): Fix
+ instance when value has an embedded space.
+
+Thu Sep 3 19:10:00 1998 Sean Mahan <smahan@cygnus.com>
+
+ * src/tclgetdir.c: Change C++ style comments to C style.
+
+Thu Sep 3 18:45:00 1998 Sean Mahan <smahan@cygnus.com>
+
+ * src/tclhelp.c: Change C++ style comments to C style.
+
+Mon Aug 31 11:55:00 1998 Ian Roxborough <irox@cygnus.com>
+
+ *src/tclgetdir.c: Add definition for SHBrowseForFolderA.
+ (it was missing from cygwin.)
+
+Mon Aug 31 11:33:00 1998 Syd Polk <spolk@cygnus.com>
+
+ *configure.in library/Makefile.am src/Makefile.am: Tcl/Tk 8.1
+ require -fwritable strings.
+ *configure Makefile.in library/Makefile.in src/Makefile.in:
+ Regenerated.
+
+Fri Aug 28 18:15:25 1998 Ian Roxborough <irox@cygnus.com>
+
+ *src/tclgetdir.c: Added missing (from cygwin) #defines for BFFM_*.
+
+Wed Aug 26 14:01:25 1998 Ian Roxborough <irox@cygnus.com>
+
+ *src/tclgetdir.c (get_directory_command): free up
+ memory allocated with Tcl_DString.
+
+Wed Aug 26 14:01:25 1998 Ian Roxborough <irox@cygnus.com>
+
+ Added "-initialdir <dir>" to the ide_get_directory
+ command.
+
+ *src/tclgetdir.c (get_directory_command): added flag
+ handling and set callback to change selected directory.
+ (MyBrowseCallbackProc): New function, sets selected
+ directory once initialization has been completed.
+
+Tue Aug 25 18:31:16 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/combobox.tcl: Fix previous checkin.
+
+Tue Aug 25 17:22:36 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/combobox.tcl (::combobox::configure): Remove
+ scrollbar width hack. Set foreground and background colors
+ for non-editable and disabled widgets.
+
+Tue Aug 25 16:06:34 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/combobox.tcl (::combobox::doInternalWidgetCommand):
+ Add "Curselection" widget command.
+
+Fri Aug 21 12:48:09 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/combobox.tcl: Merge my changes into the
+ new 1.05 combobox code.
+ (entryset): New command that sets the contents of
+ the entry field without triggering any commands.
+
+Fri Aug 21 11:38:35 1998 Ian Roxborough <irox@cygnus.com>
+
+ Integrated changes between Source-Navigator's
+ hyper/tkCanvas.c and libgui's src/tkGraphCanvas.c.
+ Add a new option (-gridlock) to switch between
+ SN style (-gridlock 1) and the old style.
+
+ *src/tkGraphCanvas.c (graphspecs[]): add gridlock
+ option (1 = ON, 0 = OFF).
+ (setedgegeom): added a new parameter (int i) and
+ code to keep lines running a X or Y axis only.
+ (GetGraphLayoutII): new function (same as GetGraphLayout
+ but takes TkCanvas as parameter).
+ (GraphCanvasCmd): use extra parameter when calling
+ setedgegeom.
+ *src/tkCanvLayout.c (struct Layout_Graph): add int
+ gridlock.
+ (LayoutCreateGraph): initalise 'gridlock'.
+ (GetLayoutConfig): copy 'gridlock' when getting.
+ (SetLayoutConfig): copy back 'gridlock' when setting.
+ *src/tkCanvLayout.h (struct LayoutConfig): add
+ 'gridlock' member.
+
+1998-08-20 Keith Seitz <keiths@cygnus.com>
+
+ * src/tclwinprint.c (winprint_print_text_options): Intialize the "initproc"
+ for struct print_text_options.
+
+
+Tue Aug 18 15:39:53 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/Makefile.am (pkgIndex.tcl): Make this
+ require maintainer mode.
+
+Mon Aug 17 16:20:38 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/Makefile.am (ITCL_SH): Revert previous change.
+
+Mon Aug 17 14:44:31 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/Makefile.am (WISH): Run itcl_wish from the
+ proper place.
+
+Mon Aug 17 13:20:09 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/combobox.tcl (::combobox::build): Initialize
+ oldValue. Don't pack scrollbar.
+ (::combobox::widgetProc): When items are inserted or deleted
+ from the list, pack or forget the scrollbar, depending on
+ the size of the list and the max height.
+ (::combobox::setValue): Call the command callback even if
+ the value selected was the same as the previous value.
+ (::combobox::configure): Change listbox width as well
+ as entry width. This keeps the scrollbar from being
+ truncated.
+ (::combobox::configure): Replace "oldValue" with "oldval"
+ to avoid confusion with the variable that saves the
+ previous value for the entry. Fixes several bugs.
+ (::combobox::widgetProc): Unset tmpopt.
+ (::combobox::widgetProc): Pass the listbox widget to the
+ computeGeometry proc so it can use it in its computations.
+ (::combobox::computeGeometry): Compute size of popup by
+ requested size of listbox plus twice the bordersize of
+ the popup.
+
+Thu Aug 13 22:55:36 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * configure.in: Add AC_OBJEXT call.
+ * configure: Rebuilt.
+
+Thu Aug 13 00:47:08 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/combobox.tcl: Fix -editable.
+
+Wed Aug 12 10:41:45 1998 Matt Leach <mleach@cygnus.com>
+
+ * src/tclhelp.c: added !WIN32 entries for Webhelp
+
+=======
+Tue Aug 18 15:39:53 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/Makefile.am (pkgIndex.tcl): Make this
+ require maintainer mode.
+
+Mon Aug 3 01:29:05 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/combobox.tcl: New file. Windows style
+ combobox.
+ * library/pkgIndex.tcl: New file.
+ * library/Makefile.am: Added combobox.tcl.
+ * library/Makefile.in, library/tclIndex: Rebuilt.
+ * configure: Rebuilt.
+
+Mon Jul 20 13:36:33 1998 Ian Roxborough <irox@cygnus.com>
+
+ * src/tclhelp.c: include missing headerfile on Windows.
+ * src/tkCanvEdge.c: defined F_OK to be 0 on Windows.
+ * src/tclmain.c: include missing headerfile on Windows.
+ * src/tclmsgbox.c (msgbox_thread): type should be WINAPI.
+ * src/paths.c (init_script[]): Due to string length limits
+ with the MSVC compiler, the init_script we now return a
+ error message when compiled with VC++.
+ * src/Makefile.am: Change all '.o' to '.$(OBJEXT)'
+ * configure.in: Added AC_OBJEXT and changed AM_EXEEXT to
+ AC_EXEEXT.
+
+Fri Jul 10 19:17:53 1998 Jim Ingham <jingham@cygnus.com>
+
+ * src/tkTable* Upgraded tkTable to version 2.1
+
+Fri Jul 10 11:29:00 1998 Sean Mahan <smahan@cygnus.com>
+
+ * src/paths.c (constant run_app_script): Fixed to work with
+ latest version of the TclPro debugger (1.0 beta 3).
+
+1998-06-30 Ben Elliston <bje@cygnus.com>
+
+ * src/tclgetdir.c: Merged from S-N.
+
+ * src/tclwinprint.c: Merged from S-N. Includes new options for
+ PostScript printing and once-per-job initialisation.
+
+ * src/tkCanvLayout.c: Merged from S-N. Mostly cleanup.
+
+ * src/tkCanvEdge.c: Merged from S-N. Handle justified and
+ multi-line labels.
+
+Fri Jun 26 17:57:00 1998 Sean Mahan <smahan@cygnus.com>
+
+ * src/paths.c (init_script): fixed `prefix' path.
+
+Mon Jun 22 14:15:36 1998 Drew Moseley <dmoseley@cygnus.com>
+
+ * src/paths.c: Added TCLPRO_DEBUGGER code
+
+Thu Jun 4 18:00:27 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * src/tkTable*: Imported Jeffrey Hobbs tkTable 2.0
+ widget.
+ * src/Makefile.am: Add tkTable stuff.
+ * src/Makefile.in: Rebuilt.
+ * Makefile.in: Rebuilt.
+ * doc/tkTable.n: Man page for tkTable.
+
+Thu May 14 10:45:00 1998 Sean Mahan <smahan@cygnus.com>
+
+ * library/prefs.tcl (PREFS_cmd_init): Changed name of global
+ variable from "IDE" to "IDE_ENABLED".
+ * src/tclmain.c (ide_main): Setup TCL global variable based
+ on the defined value of "IDE_ENABLED".
+ * configure.in: Changed "IDE" define to "IDE_ENABLED".
+ * configure: regenerated.
+ * acconfig.h: Changed "IDE" to "IDE_ENABLED" and made sure that
+ "IDE_ENABLED" would always be defined (either as 0 or 1).
+ * config.h.in: regenerated.
+
+Wed May 13 10:05:00 1998 Sean Mahan <smahan@cygnus.com>
+
+ * library/prefs.tcl (PREFS_cmd_init): Revert change by hunt that
+ used global variable "GDBTK_IDE" instead of libgui variable "IDE".
+ * configure.in: added support for "--enable-ide" option.
+ * configure: regenerated.
+ * acconfig.h: added define for "IDE".
+ * config.h.in: regenerated.
+
+Wed May 6 14:54:47 1998 Ben Elliston <bje@cygnus.com>
+
+ * src/xpmlib.c (ImgXpmGetData): Preinitialise some local variables.
+ (GetColor): Removed an unused local variable.
+ (ImgXpmGetPixmapFromData): Likewise.
+
+Thu Apr 30 19:16:13 1998 Ian Lance Taylor <ian@cygnus.com>
+
+ * src/paths.c (run_app_script): Don't crash if Paths(appdir) or
+ Paths(idedir) was not set.
+
+Thu Apr 23 13:52:13 1998 Tom Tromey <tromey@cygnus.com>
+
+ * src/tclgetdir.c (get_directory_command): Pass -choosedir to
+ tk_getOpenFile.
+
+Wed Apr 15 16:47:00 1998 Sean Mahan <smahan@cygnus.com>
+
+ * src/tclhelp.c (help_display_file_command): new function to
+ display a specified help file.
+ (ide_subcommand_table): added `display_file' subcommand.
+
+Thu Apr 9 14:19:08 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/prefs.tcl (PREFS_cmd_init): Use global
+ variable "GDBTK_IDE" instead of "IDE".
+
+Tue Apr 7 12:41:59 1998 Ian Lance Taylor <ian@cygnus.com>
+
+ * src/Makefile.am (libgui_a_SOURCES): Add tclcursor.c.
+ (tclcursor.o): New target.
+ * src/Makefile.in: Rebuild.
+
+Tue Mar 31 14:52:31 1998 Tom Tromey <tromey@cygnus.com>
+
+ * library/Makefile.in: Rebuilt.
+ * library/Makefile.am (TCL): Added ventry.tcl.
+ * library/ventry.tcl: Moved from libide.
+
+Tue Mar 31 16:58:34 1998 Ian Lance Taylor <ian@cygnus.com>
+
+ * src/paths.c: Rewrite Tcl code to search $prefix/share/cygnus for
+ gui and ide directories. Change environment variable names to
+ CYGNUS_GUI_LIBRARY and CYGNUS_IDE_LIBRARY. Permit application
+ directory to be a sibling of the parent of the gui or ide
+ directory.
+ * library/Makefile.am (guidir): Add `cygnus' between `$(datadir)'
+ and `gui'.
+ * library/Makefile.in: Rebuild.
+ * configure: Rebuild with current autoconf.
+
+Mon Mar 30 12:28:06 1998 Tom Tromey <tromey@cygnus.com>
+
+ * library/tclIndex: Rebuilt.
+
+ * library/Makefile.in: Rebuilt.
+ * library/Makefile.am (TCL): Added new files.
+ * library/advice.tcl, library/path.tcl, library/sendpr.tcl: Moved
+ from libide.
+
+ * src/Makefile.in: Rebuilt.
+ * src/Makefile.am (tclwinmode.o): New target.
+ (libgui_a_SOURCES): Added tclwinmode.c.
+ * src/tclwinmode.c: Moved from libide.
+ * src/tclcursor.c: Likewise.
+
+Fri Mar 27 20:10:14 1998 Keith Seitz <keiths@onions.cygnus.com>
+
+ * library/looknfeel.tcl (standard_look_and_feel): windows-menu is a font
+ family, not a symbolic font.
+
+Fri Mar 27 00:19:04 1998 Keith Seitz <keiths@onions.cygnus.com>
+
+ * library/looknfeel.tcl (standard_look_and_feel): Define font global/menu
+ to allow changing the menu font on unix.
+
+Tue Mar 24 02:06:59 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * src/Makefile.am (libgui_a_SOURCES): Add tclmsgbox.c.
+ * src/Makefile.in: Rebuilt.
+ * src/tclmsgbox.c: New file.
+
+Sun Mar 22 19:29:10 1998 Elena Zannoni <ezannoni@kwikemart.cygnus.com>
+
+ * library/email.tcl: removed and replaced with internet.tcl.
+ * library/internet.tcl: added
+
+Sat Mar 21 21:18:06 1998 Elena Zannoni <ezannoni@kwikemart.cygnus.com>
+
+ Merged the files in library with the corresponding files in Foundry
+
+ - Tom Tromey <tromey@cygnus.com>
+ * library/balloon.tcl
+ (destructor): Cancel any pending after handlers.
+ (showballoon): Unshow balloon after 6 seconds.
+ (showballoon): On Windows, position balloon
+ according to cursor position. (Disabled for now.)
+ (_recent_parent): New variable.
+ (_enter): If new parent the same as old parent, eliminate delay.
+ (showballoon): Set _recent_parent.
+ * library/bgerror.tcl
+ (bgerror): Display errorCode as well.
+ * library/center.tcl
+ (center_window): Run "update idletasks" after
+ setting window geometry.
+ * library/debug.tcl
+ (debug_log): Set buffering on log file to "line".
+ (DEBUG_window): Removed.
+ (DEBUG_after_source): Changed indexing into DEBUG_state array.
+ (re_source): Likewise.
+ (debug_log): New proc.
+ (DEBUG_state): Initialize log_file, window elements.
+ (debug): Log to file if user requested it.
+ (DEBUG_state): New array.
+ (DEBUG_after_source): New proc.
+ (source): Likewise.
+ (re_source): Likewise.
+ * library/hooks.tcl
+ (define_hook): Renamed.
+ * library/looknfeel.tcl
+ (add): Define global/italic font in a way
+ that actually works on Windows.
+
+ - Martin M. Hunt <hunt@cygnus.com>
+ * library/list.tcl
+ (lrep): New function. Replace an element in a list with a
+ new one.
+ * library/prefs.tcl
+ (PREFS_cmd_getd): Rewrite to call define then get.
+ Fixes strange problem.
+
+ - Ian Lance Taylor <ian@cygnus.com>
+ * library/print.tcl
+ Expand tabs to spaces assuming there are tabstops every
+ 8 spaces.
+
+
+Tue Feb 24 19:49:12 1998 Jonathan Larmour <jlarmour@cygnus.co.uk>
+
+ * configure.in, src/Makefile.am: Add --enable-install-libgui
+ option to install libgui.a and header files if required
+
+ * Makefile.in, aclocal.m4, configure, library/Makefile.in,
+ src/Makefile.in: regenerate with latest automake
+
+Wed Jan 14 12:36:49 1998 Keith Seitz <keiths@pizza.cygnus.com>
+
+ * library/Makefile.am (SET_LIB_PATH): Macro to add Tcl's build dir
+ to host's ld search path (LD_LIBRARY_PATH or what have you) for
+ builds where Tcl was built using shared libraries. This macro is
+ empty otherwise.
+ (tclIndex): Call SET_LIB_PATH.
+
+ * library/Makefile.in: Regenerate.
+
+ * configure.in: Define TCL_SHARED if using shared library for Tcl
+
+ * configure: Regenerate.
+
+Tue Dec 16 16:50:40 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ New directory to hold GUI support code.
diff --git a/libgui/Makefile.am b/libgui/Makefile.am
new file mode 100644
index 00000000000..c2604edb75a
--- /dev/null
+++ b/libgui/Makefile.am
@@ -0,0 +1,4 @@
+## Process this file with automake to produce Makefile.in.
+
+AUTOMAKE_OPTIONS = cygnus
+SUBDIRS = library src
diff --git a/libgui/Makefile.in b/libgui/Makefile.in
new file mode 100644
index 00000000000..7a332165274
--- /dev/null
+++ b/libgui/Makefile.in
@@ -0,0 +1,430 @@
+# Makefile.in generated automatically by automake 1.4 from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 Free Software Foundation, Inc.
+# This Makefile.in is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+# PARTICULAR PURPOSE.
+
+
+SHELL = @SHELL@
+
+srcdir = @srcdir@
+top_srcdir = @top_srcdir@
+VPATH = @srcdir@
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+
+bindir = @bindir@
+sbindir = @sbindir@
+libexecdir = @libexecdir@
+datadir = @datadir@
+sysconfdir = @sysconfdir@
+sharedstatedir = @sharedstatedir@
+localstatedir = @localstatedir@
+libdir = @libdir@
+infodir = @infodir@
+mandir = @mandir@
+includedir = @includedir@
+oldincludedir = /usr/include
+
+DESTDIR =
+
+pkgdatadir = $(datadir)/@PACKAGE@
+pkglibdir = $(libdir)/@PACKAGE@
+pkgincludedir = $(includedir)/@PACKAGE@
+
+top_builddir = .
+
+ACLOCAL = @ACLOCAL@
+AUTOCONF = @AUTOCONF@
+AUTOMAKE = @AUTOMAKE@
+AUTOHEADER = @AUTOHEADER@
+
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@ $(AM_INSTALL_PROGRAM_FLAGS)
+INSTALL_DATA = @INSTALL_DATA@
+INSTALL_SCRIPT = @INSTALL_SCRIPT@
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+host_alias = @host_alias@
+host_triplet = @host@
+BFDHDIR = @BFDHDIR@
+BFDLIB = @BFDLIB@
+CC = @CC@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEJAGNUHDIR = @DEJAGNUHDIR@
+DEJAGNULIB = @DEJAGNULIB@
+DEVOHDIR = @DEVOHDIR@
+ENDIAN = @ENDIAN@
+EXEEXT = @EXEEXT@
+GUILIB = @GUILIB@
+HAVE_DEVO_SIM = @HAVE_DEVO_SIM@
+IDEHDIR = @IDEHDIR@
+IDELIB = @IDELIB@
+IDETCLLIB = @IDETCLLIB@
+ILUHDIR = @ILUHDIR@
+ILULIB = @ILULIB@
+ILUTOP = @ILUTOP@
+INTLHDIR = @INTLHDIR@
+INTLLIB = @INTLLIB@
+ITCLHDIR = @ITCLHDIR@
+ITCLLIB = @ITCLLIB@
+ITCLMKIDX = @ITCLMKIDX@
+ITCLSH = @ITCLSH@
+ITCL_BUILD_LIB_SPEC = @ITCL_BUILD_LIB_SPEC@
+ITCL_DIR = @ITCL_DIR@
+ITCL_LIB_FILE = @ITCL_LIB_FILE@
+ITCL_LIB_FULL_PATH = @ITCL_LIB_FULL_PATH@
+ITCL_SH = @ITCL_SH@
+ITK_BUILD_LIB_SPEC = @ITK_BUILD_LIB_SPEC@
+ITK_LIB_FILE = @ITK_LIB_FILE@
+ITK_LIB_FULL_PATH = @ITK_LIB_FULL_PATH@
+LIBERTY = @LIBERTY@
+LIBGCC = @LIBGCC@
+LIBGUIHDIR = @LIBGUIHDIR@
+LIBGUILIB = @LIBGUILIB@
+LIBGUI_CFLAGS = @LIBGUI_CFLAGS@
+LIBGUI_LIBRARY_DIR = @LIBGUI_LIBRARY_DIR@
+LIBIBERTY = @LIBIBERTY@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJEXT = @OBJEXT@
+OPCODESLIB = @OPCODESLIB@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+RPATH_ENVVAR = @RPATH_ENVVAR@
+RUNTESTDIR = @RUNTESTDIR@
+SIMHDIR = @SIMHDIR@
+SIMLIB = @SIMLIB@
+TCLCONFIG = @TCLCONFIG@
+TCLHDIR = @TCLHDIR@
+TCL_BUILD_LIB_SPEC = @TCL_BUILD_LIB_SPEC@
+TCL_CFLAGS = @TCL_CFLAGS@
+TCL_DEFS = @TCL_DEFS@
+TCL_LD_FLAGS = @TCL_LD_FLAGS@
+TCL_LD_SEARCH_FLAGS = @TCL_LD_SEARCH_FLAGS@
+TCL_LIBRARY = @TCL_LIBRARY@
+TCL_LIBS = @TCL_LIBS@
+TCL_LIB_FILE = @TCL_LIB_FILE@
+TCL_LIB_FULL_PATH = @TCL_LIB_FULL_PATH@
+TCL_LIB_SPEC = @TCL_LIB_SPEC@
+TCL_RANLIB = @TCL_RANLIB@
+TCL_SHLIB_CFLAGS = @TCL_SHLIB_CFLAGS@
+TCL_SHLIB_LD = @TCL_SHLIB_LD@
+TIXHDIR = @TIXHDIR@
+TIX_BUILD_LIB_SPEC = @TIX_BUILD_LIB_SPEC@
+TIX_LIB_FULL_PATH = @TIX_LIB_FULL_PATH@
+TKCONFIG = @TKCONFIG@
+TKHDIR = @TKHDIR@
+TK_BUILD_INCLUDES = @TK_BUILD_INCLUDES@
+TK_BUILD_LIB_SPEC = @TK_BUILD_LIB_SPEC@
+TK_DEFS = @TK_DEFS@
+TK_LIBS = @TK_LIBS@
+TK_LIB_FILE = @TK_LIB_FILE@
+TK_LIB_FULL_PATH = @TK_LIB_FULL_PATH@
+TK_LIB_SPEC = @TK_LIB_SPEC@
+TK_VERSION = @TK_VERSION@
+TK_XINCLUDES = @TK_XINCLUDES@
+TK_XLIBSW = @TK_XLIBSW@
+VERSION = @VERSION@
+ac_cv_c_itclsh = @ac_cv_c_itclsh@
+
+AUTOMAKE_OPTIONS = cygnus
+SUBDIRS = library src
+ACLOCAL_M4 = $(top_srcdir)/aclocal.m4
+mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs
+CONFIG_HEADER = config.h
+CONFIG_CLEAN_FILES =
+DIST_COMMON = README ./stamp-h.in ChangeLog Makefile.am Makefile.in \
+TODO acconfig.h acinclude.m4 aclocal.m4 config.h.in configure \
+configure.in
+
+
+DISTFILES = $(DIST_COMMON) $(SOURCES) $(HEADERS) $(TEXINFOS) $(EXTRA_DIST)
+
+TAR = tar
+GZIP_ENV = --best
+all: all-redirect
+.SUFFIXES:
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4)
+ cd $(top_srcdir) && $(AUTOMAKE) --cygnus Makefile
+
+Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
+ cd $(top_builddir) \
+ && CONFIG_FILES=$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+$(ACLOCAL_M4): @MAINTAINER_MODE_TRUE@ configure.in acinclude.m4
+ cd $(srcdir) && $(ACLOCAL)
+
+config.status: $(srcdir)/configure $(CONFIG_STATUS_DEPENDENCIES)
+ $(SHELL) ./config.status --recheck
+$(srcdir)/configure: @MAINTAINER_MODE_TRUE@$(srcdir)/configure.in $(ACLOCAL_M4) $(CONFIGURE_DEPENDENCIES)
+ cd $(srcdir) && $(AUTOCONF)
+
+config.h: stamp-h
+ @if test ! -f $@; then \
+ rm -f stamp-h; \
+ $(MAKE) stamp-h; \
+ else :; fi
+stamp-h: $(srcdir)/config.h.in $(top_builddir)/config.status
+ cd $(top_builddir) \
+ && CONFIG_FILES= CONFIG_HEADERS=config.h \
+ $(SHELL) ./config.status
+ @echo timestamp > stamp-h 2> /dev/null
+$(srcdir)/config.h.in: @MAINTAINER_MODE_TRUE@$(srcdir)/stamp-h.in
+ @if test ! -f $@; then \
+ rm -f $(srcdir)/stamp-h.in; \
+ $(MAKE) $(srcdir)/stamp-h.in; \
+ else :; fi
+$(srcdir)/stamp-h.in: $(top_srcdir)/configure.in $(ACLOCAL_M4) acconfig.h
+ cd $(top_srcdir) && $(AUTOHEADER)
+ @echo timestamp > $(srcdir)/stamp-h.in 2> /dev/null
+
+mostlyclean-hdr:
+
+clean-hdr:
+
+distclean-hdr:
+ -rm -f config.h
+
+maintainer-clean-hdr:
+
+# This directory's subdirectories are mostly independent; you can cd
+# into them and run `make' without going through this Makefile.
+# To change the values of `make' variables: instead of editing Makefiles,
+# (1) if the variable is set in `config.status', edit `config.status'
+# (which will cause the Makefiles to be regenerated when you run `make');
+# (2) otherwise, pass the desired values on the `make' command line.
+
+@SET_MAKE@
+
+all-recursive install-data-recursive install-exec-recursive \
+installdirs-recursive install-recursive uninstall-recursive install-info-recursive \
+check-recursive installcheck-recursive info-recursive dvi-recursive:
+ @set fnord $(MAKEFLAGS); amf=$$2; \
+ dot_seen=no; \
+ target=`echo $@ | sed s/-recursive//`; \
+ list='$(SUBDIRS)'; for subdir in $$list; do \
+ echo "Making $$target in $$subdir"; \
+ if test "$$subdir" = "."; then \
+ dot_seen=yes; \
+ local_target="$$target-am"; \
+ else \
+ local_target="$$target"; \
+ fi; \
+ (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
+ || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
+ done; \
+ if test "$$dot_seen" = "no"; then \
+ $(MAKE) $(AM_MAKEFLAGS) "$$target-am" || exit 1; \
+ fi; test -z "$$fail"
+
+mostlyclean-recursive clean-recursive distclean-recursive \
+maintainer-clean-recursive:
+ @set fnord $(MAKEFLAGS); amf=$$2; \
+ dot_seen=no; \
+ rev=''; list='$(SUBDIRS)'; for subdir in $$list; do \
+ rev="$$subdir $$rev"; \
+ test "$$subdir" = "." && dot_seen=yes; \
+ done; \
+ test "$$dot_seen" = "no" && rev=". $$rev"; \
+ target=`echo $@ | sed s/-recursive//`; \
+ for subdir in $$rev; do \
+ echo "Making $$target in $$subdir"; \
+ if test "$$subdir" = "."; then \
+ local_target="$$target-am"; \
+ else \
+ local_target="$$target"; \
+ fi; \
+ (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $$local_target) \
+ || case "$$amf" in *=*) exit 1;; *k*) fail=yes;; *) exit 1;; esac; \
+ done && test -z "$$fail"
+tags-recursive:
+ list='$(SUBDIRS)'; for subdir in $$list; do \
+ test "$$subdir" = . || (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) tags); \
+ done
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP)
+ list='$(SOURCES) $(HEADERS)'; \
+ unique=`for i in $$list; do echo $$i; done | \
+ awk ' { files[$$0] = 1; } \
+ END { for (i in files) print i; }'`; \
+ here=`pwd` && cd $(srcdir) \
+ && mkid -f$$here/ID $$unique $(LISP)
+
+TAGS: tags-recursive $(HEADERS) $(SOURCES) config.h.in $(TAGS_DEPENDENCIES) $(LISP)
+ tags=; \
+ here=`pwd`; \
+ list='$(SUBDIRS)'; for subdir in $$list; do \
+ if test "$$subdir" = .; then :; else \
+ test -f $$subdir/TAGS && tags="$$tags -i $$here/$$subdir/TAGS"; \
+ fi; \
+ done; \
+ list='$(SOURCES) $(HEADERS)'; \
+ unique=`for i in $$list; do echo $$i; done | \
+ awk ' { files[$$0] = 1; } \
+ END { for (i in files) print i; }'`; \
+ test -z "$(ETAGS_ARGS)config.h.in$$unique$(LISP)$$tags" \
+ || (cd $(srcdir) && etags $(ETAGS_ARGS) $$tags config.h.in $$unique $(LISP) -o $$here/TAGS)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+ -rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(PACKAGE)-$(VERSION)
+top_distdir = $(distdir)
+
+# This target untars the dist file and tries a VPATH configuration. Then
+# it guarantees that the distribution is self-contained by making another
+# tarfile.
+distcheck: dist
+ -rm -rf $(distdir)
+ GZIP=$(GZIP_ENV) $(TAR) zxf $(distdir).tar.gz
+ mkdir $(distdir)/=build
+ mkdir $(distdir)/=inst
+ dc_install_base=`cd $(distdir)/=inst && pwd`; \
+ cd $(distdir)/=build \
+ && ../configure --srcdir=.. --prefix=$$dc_install_base \
+ && $(MAKE) $(AM_MAKEFLAGS) \
+ && $(MAKE) $(AM_MAKEFLAGS) dvi \
+ && $(MAKE) $(AM_MAKEFLAGS) check \
+ && $(MAKE) $(AM_MAKEFLAGS) install \
+ && $(MAKE) $(AM_MAKEFLAGS) installcheck \
+ && $(MAKE) $(AM_MAKEFLAGS) dist
+ -rm -rf $(distdir)
+ @banner="$(distdir).tar.gz is ready for distribution"; \
+ dashes=`echo "$$banner" | sed s/./=/g`; \
+ echo "$$dashes"; \
+ echo "$$banner"; \
+ echo "$$dashes"
+dist: distdir
+ -chmod -R a+r $(distdir)
+ GZIP=$(GZIP_ENV) $(TAR) chozf $(distdir).tar.gz $(distdir)
+ -rm -rf $(distdir)
+dist-all: distdir
+ -chmod -R a+r $(distdir)
+ GZIP=$(GZIP_ENV) $(TAR) chozf $(distdir).tar.gz $(distdir)
+ -rm -rf $(distdir)
+distdir: $(DISTFILES)
+ -rm -rf $(distdir)
+ mkdir $(distdir)
+ -chmod 777 $(distdir)
+ @for file in $(DISTFILES); do \
+ if test -f $$file; then d=.; else d=$(srcdir); fi; \
+ if test -d $$d/$$file; then \
+ cp -pr $$d/$$file $(distdir)/$$file; \
+ else \
+ test -f $(distdir)/$$file \
+ || ln $$d/$$file $(distdir)/$$file 2> /dev/null \
+ || cp -p $$d/$$file $(distdir)/$$file || :; \
+ fi; \
+ done
+ for subdir in $(SUBDIRS); do \
+ if test "$$subdir" = .; then :; else \
+ test -d $(distdir)/$$subdir \
+ || mkdir $(distdir)/$$subdir \
+ || exit 1; \
+ chmod 777 $(distdir)/$$subdir; \
+ (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) top_distdir=../$(distdir) distdir=../$(distdir)/$$subdir distdir) \
+ || exit 1; \
+ fi; \
+ done
+info-am:
+info: info-recursive
+dvi-am:
+dvi: dvi-recursive
+check-am:
+check: check-recursive
+installcheck-am:
+installcheck: installcheck-recursive
+install-info-am:
+install-info: install-info-recursive
+all-recursive-am: config.h
+ $(MAKE) $(AM_MAKEFLAGS) all-recursive
+
+install-exec-am:
+install-exec: install-exec-recursive
+
+install-data-am:
+install-data: install-data-recursive
+
+install-am: all-am
+ @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-recursive
+uninstall-am:
+uninstall: uninstall-recursive
+all-am: Makefile config.h
+all-redirect: all-recursive-am
+install-strip:
+ $(MAKE) $(AM_MAKEFLAGS) AM_INSTALL_PROGRAM_FLAGS=-s install
+installdirs: installdirs-recursive
+installdirs-am:
+
+
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+ -rm -f Makefile $(CONFIG_CLEAN_FILES)
+ -rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+mostlyclean-am: mostlyclean-hdr mostlyclean-tags mostlyclean-generic
+
+mostlyclean: mostlyclean-recursive
+
+clean-am: clean-hdr clean-tags clean-generic mostlyclean-am
+
+clean: clean-recursive
+
+distclean-am: distclean-hdr distclean-tags distclean-generic clean-am
+
+distclean: distclean-recursive
+ -rm -f config.status
+
+maintainer-clean-am: maintainer-clean-hdr maintainer-clean-tags \
+ maintainer-clean-generic distclean-am
+ @echo "This command is intended for maintainers to use;"
+ @echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-recursive
+ -rm -f config.status
+
+.PHONY: mostlyclean-hdr distclean-hdr clean-hdr maintainer-clean-hdr \
+install-data-recursive uninstall-data-recursive install-exec-recursive \
+uninstall-exec-recursive installdirs-recursive uninstalldirs-recursive \
+all-recursive check-recursive installcheck-recursive info-recursive \
+dvi-recursive mostlyclean-recursive distclean-recursive clean-recursive \
+maintainer-clean-recursive tags tags-recursive mostlyclean-tags \
+distclean-tags clean-tags maintainer-clean-tags distdir info-am info \
+dvi-am dvi check check-am installcheck-am installcheck install-info-am \
+install-info all-recursive-am install-exec-am install-exec \
+install-data-am install-data install-am install uninstall-am uninstall \
+all-redirect all-am all installdirs-am installdirs mostlyclean-generic \
+distclean-generic clean-generic maintainer-clean-generic clean \
+mostlyclean distclean maintainer-clean
+
+
+# Tell versions [3.59,3.63) of GNU make to not export all variables.
+# Otherwise a system limit (for SysV at least) may be exceeded.
+.NOEXPORT:
diff --git a/libgui/README b/libgui/README
new file mode 100644
index 00000000000..c51eefc8f64
--- /dev/null
+++ b/libgui/README
@@ -0,0 +1,202 @@
+libgui - Handy GUI code
+
+This module has various pieces of code that are useful for a GUI. For
+the most part, they are Tcl/Tk-related.
+
+Open issues:
+- bitmaps and canvas code are duplicated in S-N; should look into
+ sharing
+- tkTreeTable taken from S-N but modified; should use the same
+ version in both places. Better yet, replace this widget with
+ one that works better
+
+Here's a brief runthrough:
+
+library/
+ Directory of Tcl code
+
+ balloon.tcl
+ Tcl code to implement balloon help (aka tooltips)
+
+ Primary interface is the "balloon" command. See last function in
+ file for details on usage
+
+ bindings.tcl
+ Provides bind_widget_after_class proc; rearranges bindtags in
+ a frequently-useful way.
+
+ canvas.tcl
+ Tcl procs relating to canvas widgets
+
+ set_scroll_region canvas
+ Set the scroll region on CANVAS to include all items in the
+ canvas. Most easily used when bound to <Configure> on the
+ canvas.
+
+ def.tcl
+ Defining words.
+
+ defarray name ?value?
+ Define a global array named NAME. VALUE, if present, is the
+ initial value. VALUE is in the format expected by "array
+ set".
+
+ defvar name ?value?
+ Define a new global variable named NAME.
+
+ gensym.tcl
+ Provides the proc "gensym", which generates new symbol names.
+
+ gettext.tcl
+ Defines the stub proc "gettext", used for looking up text in a
+ localization database.
+
+ hooks.tcl
+ Provides procs for handling hooks (lists of functions that
+ should be run when something happens).
+
+ lframe.tcl
+ Provides the Labelledframe widget -- a frame with a groove and
+ a label.
+
+ list.tcl
+ Defines useful list procs. Some of these are Tcl versions of C
+ functions in TclX.
+
+ lvarpush listvar element ?index?
+ Insert ELEMENT into list stored in LISTVAR (a variable).
+ Element is inserted at INDEXth position. INDEX defaults to
+ 0.
+
+ lvarpop listvar ?index?
+ Remove INDEXth element from list stored in LISTVAR (a
+ variable). Returns the removed element. INDEX defaults to
+ 0.
+
+ lassign list args
+ Assign successive elements from LIST to variables named in
+ ARGS. If LIST is longer than ARGS, assign a list of remaining
+ elements to last variable.
+
+ lrmdups list args
+ Remove duplicates and sort list. ARGS, if specified, are
+ arguments to lsort
+
+ lremove list element
+ Return list created by removing the first item `ELEMENT'
+
+ mono.tcl
+ Procs for handling monochrome displays or colorblind users
+
+ prefs.tcl
+ Application preference code. This will probably vanish at some
+ point, once we figure out how we really want to do this. I just
+ had this code lying around, and it was useful to me, so I included
+ it.
+
+ Defines a single interface, "preference", which has several
+ subcommands:
+
+ preference define name default docstring ?handler?
+ Define a new preference. HANDLER, if specified, is a proc
+ to run whenever the preference's value changes.
+
+ preference get name
+ Return value of preference.
+
+ preference documentation name
+ Return doc string of preference
+
+ preference varname name
+ Return name of variable representing named preference. This
+ can be used eg as the -variable of a radiobutton.
+
+ preference set name value
+ Set preference.
+
+ preference get_commands
+ Return text of commands which, when evalled, will restore
+ the current state of all defined preferences.
+
+ sendpr.tcl
+ The sendpr widget; a GUI for send-pr.
+
+ topbind.tcl
+ Code for bindings on toplevels.
+
+ bind_for_toplevel_only toplevel sequence script
+ Put a binding on window TOPLEVEL for event SEQUENCE. When the
+ event is seen, SCRIPT will run. This proc adds a new bindtag
+ to the toplevel to avoid the problems associated with putting
+ bindings directly on toplevels.
+
+ treetable.tcl
+ Code that is useful when using the treetable widget.
+ Applications should run "multix_treetable_bindings TreeTable"
+ at startup.
+
+ ulset.tcl
+ Attempt to make setting the -underline option easier. This is
+ particular good when using gettext. Unfortunately the interface
+ is hard to use; it should be changed.
+
+ extract_label_info option label
+ Extract underline and label info from descriptor string LABEL.
+ Any underline in LABEL is extracted, and the next character's
+ index is used as the -underline value. There must be only one
+ underline in LABEL. This proc returns a list of the form:
+
+ OPTION NEWLABEL -underline INDEX
+
+ Eg: extract_label_info -text _File
+ -> {-text File -underline 0}
+
+src/
+ Directory of C code. This is all put into libide.a.
+
+ paths.c
+ Useful startup code that all applications should run.
+
+ int ide_initialize (Tcl_Interp *interp, char *appname);
+
+ This function:
+ - Sets the global Tcl variable ide_application_name to APPNAME.
+ - Searches the filesystem for the libide Tcl code, and sets
+ up the auto_path appropriately. The IDE_LIBRARY environment
+ variable can override the searching.
+ - Sets up the auto_path to include the application's Tcl library
+ as well (if possible). Applications should install their Tcl
+ code in $(datadir)/APPNAME/
+ - Runs the application's startup file - $(datadir)/APPNAME/APPNAME.tcl
+ - Sets these entries in the global array Paths:
+ Paths(bitmapdir) Location of libide bitmaps
+ Paths(appdir) Location of application's scripts
+
+ This function returns TCL_OK on success, and something else on
+ error.
+
+ subcommand.c
+ Makes it easy to write commands which are split into a number of
+ subcommands (eg, like the Tcl "file" command).
+
+ int create_command_with_subcommands (Tcl_interp *interp, char *name,
+ struct subcommand_table *table)
+
+ Create a new Tcl command name NAME. TABLE describes the
+ subcommands; see subcommand.h for details. Returns TCL_OK on
+ success, TCL_ERROR on failure.
+
+ tkCanvEdge.c, tkCanvLayout.c, tkCanvLayout.h, tkCanvas.c, tkCanvas.h
+ Patched versions (ugh) of the corresponding Tk files, and some new
+ files. These files implement graph layout for canvases.
+
+ tkTreeTable.c tkTreeTable.c
+ The treetable widget. This is essentially a hierarchical listbox
+ widget. As far as I know, there is no documentation. At some
+ point, maybe I'll write some up. This widget came from S-N (but
+ they got it from somewhere else), but I've changed it somewhat.
+
+ We'll be merging our version with S-N at some point.
+
+ Your package should run create_treetable_command to make the
+ treetable widget. Only do this after running Tk_Init.
diff --git a/libgui/acconfig.h b/libgui/acconfig.h
new file mode 100644
index 00000000000..18cce437c18
--- /dev/null
+++ b/libgui/acconfig.h
@@ -0,0 +1,14 @@
+/* Name of package. */
+#undef PACKAGE
+
+/* Version of package. */
+#undef VERSION
+
+/* Set this if Tk's stdlib.h should be used. */
+#undef NO_STDLIB_H
+
+/* Define this if <string.h> declares strncasecmp(). */
+#undef HAVE_STRNCASECMP_DECL
+
+/* Define this if the IDE is enabled. */
+#define IDE_ENABLED 0
diff --git a/libgui/acinclude.m4 b/libgui/acinclude.m4
new file mode 100644
index 00000000000..035cc88d7db
--- /dev/null
+++ b/libgui/acinclude.m4
@@ -0,0 +1 @@
+"sinclude(../config/acinclude.m4)"
diff --git a/libgui/aclocal.m4 b/libgui/aclocal.m4
new file mode 100644
index 00000000000..d40897afe9a
--- /dev/null
+++ b/libgui/aclocal.m4
@@ -0,0 +1,250 @@
+dnl aclocal.m4 generated automatically by aclocal 1.4
+
+dnl Copyright (C) 1994, 1995-8, 1999 Free Software Foundation, Inc.
+dnl This file is free software; the Free Software Foundation
+dnl gives unlimited permission to copy and/or distribute it,
+dnl with or without modifications, as long as this notice is preserved.
+
+dnl This program is distributed in the hope that it will be useful,
+dnl but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+dnl even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+dnl PARTICULAR PURPOSE.
+
+"sinclude(../config/acinclude.m4)"
+
+# Do all the work for Automake. This macro actually does too much --
+# some checks are only needed if your package does certain things.
+# But this isn't really a big deal.
+
+# serial 1
+
+dnl Usage:
+dnl AM_INIT_AUTOMAKE(package,version, [no-define])
+
+AC_DEFUN(AM_INIT_AUTOMAKE,
+[AC_REQUIRE([AC_PROG_INSTALL])
+PACKAGE=[$1]
+AC_SUBST(PACKAGE)
+VERSION=[$2]
+AC_SUBST(VERSION)
+dnl test to see if srcdir already configured
+if test "`cd $srcdir && pwd`" != "`pwd`" && test -f $srcdir/config.status; then
+ AC_MSG_ERROR([source directory already configured; run "make distclean" there first])
+fi
+ifelse([$3],,
+AC_DEFINE_UNQUOTED(PACKAGE, "$PACKAGE", [Name of package])
+AC_DEFINE_UNQUOTED(VERSION, "$VERSION", [Version number of package]))
+AC_REQUIRE([AM_SANITY_CHECK])
+AC_REQUIRE([AC_ARG_PROGRAM])
+dnl FIXME This is truly gross.
+missing_dir=`cd $ac_aux_dir && pwd`
+AM_MISSING_PROG(ACLOCAL, aclocal, $missing_dir)
+AM_MISSING_PROG(AUTOCONF, autoconf, $missing_dir)
+AM_MISSING_PROG(AUTOMAKE, automake, $missing_dir)
+AM_MISSING_PROG(AUTOHEADER, autoheader, $missing_dir)
+AM_MISSING_PROG(MAKEINFO, makeinfo, $missing_dir)
+AC_REQUIRE([AC_PROG_MAKE_SET])])
+
+#
+# Check to make sure that the build environment is sane.
+#
+
+AC_DEFUN(AM_SANITY_CHECK,
+[AC_MSG_CHECKING([whether build environment is sane])
+# Just in case
+sleep 1
+echo timestamp > conftestfile
+# Do `set' in a subshell so we don't clobber the current shell's
+# arguments. Must try -L first in case configure is actually a
+# symlink; some systems play weird games with the mod time of symlinks
+# (eg FreeBSD returns the mod time of the symlink's containing
+# directory).
+if (
+ set X `ls -Lt $srcdir/configure conftestfile 2> /dev/null`
+ if test "[$]*" = "X"; then
+ # -L didn't work.
+ set X `ls -t $srcdir/configure conftestfile`
+ fi
+ if test "[$]*" != "X $srcdir/configure conftestfile" \
+ && test "[$]*" != "X conftestfile $srcdir/configure"; then
+
+ # If neither matched, then we have a broken ls. This can happen
+ # if, for instance, CONFIG_SHELL is bash and it inherits a
+ # broken ls alias from the environment. This has actually
+ # happened. Such a system could not be considered "sane".
+ AC_MSG_ERROR([ls -t appears to fail. Make sure there is not a broken
+alias in your environment])
+ fi
+
+ test "[$]2" = conftestfile
+ )
+then
+ # Ok.
+ :
+else
+ AC_MSG_ERROR([newly created file is older than distributed files!
+Check your system clock])
+fi
+rm -f conftest*
+AC_MSG_RESULT(yes)])
+
+dnl AM_MISSING_PROG(NAME, PROGRAM, DIRECTORY)
+dnl The program must properly implement --version.
+AC_DEFUN(AM_MISSING_PROG,
+[AC_MSG_CHECKING(for working $2)
+# Run test in a subshell; some versions of sh will print an error if
+# an executable is not found, even if stderr is redirected.
+# Redirect stdin to placate older versions of autoconf. Sigh.
+if ($2 --version) < /dev/null > /dev/null 2>&1; then
+ $1=$2
+ AC_MSG_RESULT(found)
+else
+ $1="$3/missing $2"
+ AC_MSG_RESULT(missing)
+fi
+AC_SUBST($1)])
+
+# Like AC_CONFIG_HEADER, but automatically create stamp file.
+
+AC_DEFUN(AM_CONFIG_HEADER,
+[AC_PREREQ([2.12])
+AC_CONFIG_HEADER([$1])
+dnl When config.status generates a header, we must update the stamp-h file.
+dnl This file resides in the same directory as the config header
+dnl that is generated. We must strip everything past the first ":",
+dnl and everything past the last "/".
+AC_OUTPUT_COMMANDS(changequote(<<,>>)dnl
+ifelse(patsubst(<<$1>>, <<[^ ]>>, <<>>), <<>>,
+<<test -z "<<$>>CONFIG_HEADERS" || echo timestamp > patsubst(<<$1>>, <<^\([^:]*/\)?.*>>, <<\1>>)stamp-h<<>>dnl>>,
+<<am_indx=1
+for am_file in <<$1>>; do
+ case " <<$>>CONFIG_HEADERS " in
+ *" <<$>>am_file "*<<)>>
+ echo timestamp > `echo <<$>>am_file | sed -e 's%:.*%%' -e 's%[^/]*$%%'`stamp-h$am_indx
+ ;;
+ esac
+ am_indx=`expr "<<$>>am_indx" + 1`
+done<<>>dnl>>)
+changequote([,]))])
+
+# Add --enable-maintainer-mode option to configure.
+# From Jim Meyering
+
+# serial 1
+
+AC_DEFUN(AM_MAINTAINER_MODE,
+[AC_MSG_CHECKING([whether to enable maintainer-specific portions of Makefiles])
+ dnl maintainer-mode is disabled by default
+ AC_ARG_ENABLE(maintainer-mode,
+[ --enable-maintainer-mode enable make rules and dependencies not useful
+ (and sometimes confusing) to the casual installer],
+ USE_MAINTAINER_MODE=$enableval,
+ USE_MAINTAINER_MODE=no)
+ AC_MSG_RESULT($USE_MAINTAINER_MODE)
+ AM_CONDITIONAL(MAINTAINER_MODE, test $USE_MAINTAINER_MODE = yes)
+ MAINT=$MAINTAINER_MODE_TRUE
+ AC_SUBST(MAINT)dnl
+]
+)
+
+# Define a conditional.
+
+AC_DEFUN(AM_CONDITIONAL,
+[AC_SUBST($1_TRUE)
+AC_SUBST($1_FALSE)
+if $2; then
+ $1_TRUE=
+ $1_FALSE='#'
+else
+ $1_TRUE='#'
+ $1_FALSE=
+fi])
+
+
+# serial 1
+
+# @defmac AC_PROG_CC_STDC
+# @maindex PROG_CC_STDC
+# @ovindex CC
+# If the C compiler in not in ANSI C mode by default, try to add an option
+# to output variable @code{CC} to make it so. This macro tries various
+# options that select ANSI C on some system or another. It considers the
+# compiler to be in ANSI C mode if it handles function prototypes correctly.
+#
+# If you use this macro, you should check after calling it whether the C
+# compiler has been set to accept ANSI C; if not, the shell variable
+# @code{am_cv_prog_cc_stdc} is set to @samp{no}. If you wrote your source
+# code in ANSI C, you can make an un-ANSIfied copy of it by using the
+# program @code{ansi2knr}, which comes with Ghostscript.
+# @end defmac
+
+AC_DEFUN(AM_PROG_CC_STDC,
+[AC_REQUIRE([AC_PROG_CC])
+AC_BEFORE([$0], [AC_C_INLINE])
+AC_BEFORE([$0], [AC_C_CONST])
+dnl Force this before AC_PROG_CPP. Some cpp's, eg on HPUX, require
+dnl a magic option to avoid problems with ANSI preprocessor commands
+dnl like #elif.
+dnl FIXME: can't do this because then AC_AIX won't work due to a
+dnl circular dependency.
+dnl AC_BEFORE([$0], [AC_PROG_CPP])
+AC_MSG_CHECKING(for ${CC-cc} option to accept ANSI C)
+AC_CACHE_VAL(am_cv_prog_cc_stdc,
+[am_cv_prog_cc_stdc=no
+ac_save_CC="$CC"
+# Don't try gcc -ansi; that turns off useful extensions and
+# breaks some systems' header files.
+# AIX -qlanglvl=ansi
+# Ultrix and OSF/1 -std1
+# HP-UX -Aa -D_HPUX_SOURCE
+# SVR4 -Xc -D__EXTENSIONS__
+for ac_arg in "" -qlanglvl=ansi -std1 "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__"
+do
+ CC="$ac_save_CC $ac_arg"
+ AC_TRY_COMPILE(
+[#include <stdarg.h>
+#include <stdio.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */
+struct buf { int x; };
+FILE * (*rcsopen) (struct buf *, struct stat *, int);
+static char *e (p, i)
+ char **p;
+ int i;
+{
+ return p[i];
+}
+static char *f (char * (*g) (char **, int), char **p, ...)
+{
+ char *s;
+ va_list v;
+ va_start (v,p);
+ s = g (p, va_arg (v,int));
+ va_end (v);
+ return s;
+}
+int test (int i, double x);
+struct s1 {int (*f) (int a);};
+struct s2 {int (*f) (double a);};
+int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int);
+int argc;
+char **argv;
+], [
+return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1];
+],
+[am_cv_prog_cc_stdc="$ac_arg"; break])
+done
+CC="$ac_save_CC"
+])
+if test -z "$am_cv_prog_cc_stdc"; then
+ AC_MSG_RESULT([none needed])
+else
+ AC_MSG_RESULT($am_cv_prog_cc_stdc)
+fi
+case "x$am_cv_prog_cc_stdc" in
+ x|xno) ;;
+ *) CC="$CC $am_cv_prog_cc_stdc" ;;
+esac
+])
+
diff --git a/libgui/config.h.in b/libgui/config.h.in
new file mode 100644
index 00000000000..3154f811749
--- /dev/null
+++ b/libgui/config.h.in
@@ -0,0 +1,77 @@
+/* config.h.in. Generated automatically from configure.in by autoheader. */
+
+/* Define if using alloca.c. */
+#undef C_ALLOCA
+
+/* Define to one of _getb67, GETB67, getb67 for Cray-2 and Cray-YMP systems.
+ This function is required for alloca.c support on those systems. */
+#undef CRAY_STACKSEG_END
+
+/* Define if you have alloca, as a function or macro. */
+#undef HAVE_ALLOCA
+
+/* Define if you have <alloca.h> and it should be used (not on Ultrix). */
+#undef HAVE_ALLOCA_H
+
+/* If using the C implementation of alloca, define if you know the
+ direction of stack growth for your system; otherwise it will be
+ automatically deduced at run-time.
+ STACK_DIRECTION > 0 => grows toward higher addresses
+ STACK_DIRECTION < 0 => grows toward lower addresses
+ STACK_DIRECTION = 0 => direction of growth unknown
+ */
+#undef STACK_DIRECTION
+
+/* Name of package. */
+#undef PACKAGE
+
+/* Version of package. */
+#undef VERSION
+
+/* Define this if <string.h> declares strncasecmp(). */
+#undef HAVE_STRNCASECMP_DECL
+
+/* Define this if the IDE is enabled. */
+#define IDE_ENABLED 0
+
+/* Define if you have the drand48 function. */
+#undef HAVE_DRAND48
+
+/* Define if you have the raise function. */
+#undef HAVE_RAISE
+
+/* Define if you have the rand function. */
+#undef HAVE_RAND
+
+/* Define if you have the random function. */
+#undef HAVE_RANDOM
+
+/* Define if you have the strdup function. */
+#undef HAVE_STRDUP
+
+/* Define if you have the <fcntl.h> header file. */
+#undef HAVE_FCNTL_H
+
+/* Define if you have the <getopt.h> header file. */
+#undef HAVE_GETOPT_H
+
+/* Define if you have the <stddef.h> header file. */
+#undef HAVE_STDDEF_H
+
+/* Define if you have the <stdlib.h> header file. */
+#undef HAVE_STDLIB_H
+
+/* Define if you have the <string.h> header file. */
+#undef HAVE_STRING_H
+
+/* Define if you have the <strings.h> header file. */
+#undef HAVE_STRINGS_H
+
+/* Define if you have the <sys/file.h> header file. */
+#undef HAVE_SYS_FILE_H
+
+/* Define if you have the <sys/wait.h> header file. */
+#undef HAVE_SYS_WAIT_H
+
+/* Define if you have the <unistd.h> header file. */
+#undef HAVE_UNISTD_H
diff --git a/libgui/configure b/libgui/configure
new file mode 100755
index 00000000000..f11edd44fc4
--- /dev/null
+++ b/libgui/configure
@@ -0,0 +1,2709 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+ac_help="$ac_help
+ --enable-maintainer-mode enable make rules and dependencies not useful
+ (and sometimes confusing) to the casual installer"
+ac_help="$ac_help
+\
+ --enable-install-libgui Install libgui.a and library header files"
+ac_help="$ac_help
+ --enable-ide Enable IDE support"
+ac_help="$ac_help
+ --with-tclconfig directory containing tcl configuration (tclConfig.sh)"
+ac_help="$ac_help
+ --with-tkconfig directory containing tk configuration (tkConfig.sh)"
+ac_help="$ac_help
+ --with-tclinclude directory where tcl headers are"
+ac_help="$ac_help
+ --with-tkinclude directory where tk headers are"
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+sitefile=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --site-file=FILE use FILE as the site file
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -site-file | --site-file | --site-fil | --site-fi | --site-f)
+ ac_prev=sitefile ;;
+ -site-file=* | --site-file=* | --site-fil=* | --site-fi=* | --site-f=*)
+ sitefile="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.13"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=src/subcommand.h
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$sitefile"; then
+ if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+ fi
+else
+ CONFIG_SITE="$sitefile"
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:583: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ # Account for people who put trailing slashes in PATH elements.
+ case "$ac_dir/" in
+ /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ if test -f $ac_dir/$ac_prog; then
+ if test $ac_prog = install &&
+ grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ else
+ ac_cv_path_install="$ac_dir/$ac_prog -c"
+ break 2
+ fi
+ fi
+ done
+ ;;
+ esac
+ done
+ IFS="$ac_save_IFS"
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL="$ac_cv_path_install"
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL="$ac_install_sh"
+ fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+echo $ac_n "checking whether build environment is sane""... $ac_c" 1>&6
+echo "configure:636: checking whether build environment is sane" >&5
+# Just in case
+sleep 1
+echo timestamp > conftestfile
+# Do `set' in a subshell so we don't clobber the current shell's
+# arguments. Must try -L first in case configure is actually a
+# symlink; some systems play weird games with the mod time of symlinks
+# (eg FreeBSD returns the mod time of the symlink's containing
+# directory).
+if (
+ set X `ls -Lt $srcdir/configure conftestfile 2> /dev/null`
+ if test "$*" = "X"; then
+ # -L didn't work.
+ set X `ls -t $srcdir/configure conftestfile`
+ fi
+ if test "$*" != "X $srcdir/configure conftestfile" \
+ && test "$*" != "X conftestfile $srcdir/configure"; then
+
+ # If neither matched, then we have a broken ls. This can happen
+ # if, for instance, CONFIG_SHELL is bash and it inherits a
+ # broken ls alias from the environment. This has actually
+ # happened. Such a system could not be considered "sane".
+ { echo "configure: error: ls -t appears to fail. Make sure there is not a broken
+alias in your environment" 1>&2; exit 1; }
+ fi
+
+ test "$2" = conftestfile
+ )
+then
+ # Ok.
+ :
+else
+ { echo "configure: error: newly created file is older than distributed files!
+Check your system clock" 1>&2; exit 1; }
+fi
+rm -f conftest*
+echo "$ac_t""yes" 1>&6
+if test "$program_transform_name" = s,x,x,; then
+ program_transform_name=
+else
+ # Double any \ or $. echo might interpret backslashes.
+ cat <<\EOF_SED > conftestsed
+s,\\,\\\\,g; s,\$,$$,g
+EOF_SED
+ program_transform_name="`echo $program_transform_name|sed -f conftestsed`"
+ rm -f conftestsed
+fi
+test "$program_prefix" != NONE &&
+ program_transform_name="s,^,${program_prefix},; $program_transform_name"
+# Use a double $ so make ignores it.
+test "$program_suffix" != NONE &&
+ program_transform_name="s,\$\$,${program_suffix},; $program_transform_name"
+
+# sed with no file args requires a program.
+test "$program_transform_name" = "" && program_transform_name="s,x,x,"
+
+echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6
+echo "configure:693: checking whether ${MAKE-make} sets \${MAKE}" >&5
+set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftestmake <<\EOF
+all:
+ @echo 'ac_maketemp="${MAKE}"'
+EOF
+# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=`
+if test -n "$ac_maketemp"; then
+ eval ac_cv_prog_make_${ac_make}_set=yes
+else
+ eval ac_cv_prog_make_${ac_make}_set=no
+fi
+rm -f conftestmake
+fi
+if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ SET_MAKE=
+else
+ echo "$ac_t""no" 1>&6
+ SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+
+PACKAGE=libgui
+
+VERSION=0.0
+
+if test "`cd $srcdir && pwd`" != "`pwd`" && test -f $srcdir/config.status; then
+ { echo "configure: error: source directory already configured; run "make distclean" there first" 1>&2; exit 1; }
+fi
+cat >> confdefs.h <<EOF
+#define PACKAGE "$PACKAGE"
+EOF
+
+cat >> confdefs.h <<EOF
+#define VERSION "$VERSION"
+EOF
+
+
+
+missing_dir=`cd $ac_aux_dir && pwd`
+echo $ac_n "checking for working aclocal""... $ac_c" 1>&6
+echo "configure:739: checking for working aclocal" >&5
+# Run test in a subshell; some versions of sh will print an error if
+# an executable is not found, even if stderr is redirected.
+# Redirect stdin to placate older versions of autoconf. Sigh.
+if (aclocal --version) < /dev/null > /dev/null 2>&1; then
+ ACLOCAL=aclocal
+ echo "$ac_t""found" 1>&6
+else
+ ACLOCAL="$missing_dir/missing aclocal"
+ echo "$ac_t""missing" 1>&6
+fi
+
+echo $ac_n "checking for working autoconf""... $ac_c" 1>&6
+echo "configure:752: checking for working autoconf" >&5
+# Run test in a subshell; some versions of sh will print an error if
+# an executable is not found, even if stderr is redirected.
+# Redirect stdin to placate older versions of autoconf. Sigh.
+if (autoconf --version) < /dev/null > /dev/null 2>&1; then
+ AUTOCONF=autoconf
+ echo "$ac_t""found" 1>&6
+else
+ AUTOCONF="$missing_dir/missing autoconf"
+ echo "$ac_t""missing" 1>&6
+fi
+
+echo $ac_n "checking for working automake""... $ac_c" 1>&6
+echo "configure:765: checking for working automake" >&5
+# Run test in a subshell; some versions of sh will print an error if
+# an executable is not found, even if stderr is redirected.
+# Redirect stdin to placate older versions of autoconf. Sigh.
+if (automake --version) < /dev/null > /dev/null 2>&1; then
+ AUTOMAKE=automake
+ echo "$ac_t""found" 1>&6
+else
+ AUTOMAKE="$missing_dir/missing automake"
+ echo "$ac_t""missing" 1>&6
+fi
+
+echo $ac_n "checking for working autoheader""... $ac_c" 1>&6
+echo "configure:778: checking for working autoheader" >&5
+# Run test in a subshell; some versions of sh will print an error if
+# an executable is not found, even if stderr is redirected.
+# Redirect stdin to placate older versions of autoconf. Sigh.
+if (autoheader --version) < /dev/null > /dev/null 2>&1; then
+ AUTOHEADER=autoheader
+ echo "$ac_t""found" 1>&6
+else
+ AUTOHEADER="$missing_dir/missing autoheader"
+ echo "$ac_t""missing" 1>&6
+fi
+
+echo $ac_n "checking for working makeinfo""... $ac_c" 1>&6
+echo "configure:791: checking for working makeinfo" >&5
+# Run test in a subshell; some versions of sh will print an error if
+# an executable is not found, even if stderr is redirected.
+# Redirect stdin to placate older versions of autoconf. Sigh.
+if (makeinfo --version) < /dev/null > /dev/null 2>&1; then
+ MAKEINFO=makeinfo
+ echo "$ac_t""found" 1>&6
+else
+ MAKEINFO="$missing_dir/missing makeinfo"
+ echo "$ac_t""missing" 1>&6
+fi
+
+
+
+
+
+echo $ac_n "checking whether to enable maintainer-specific portions of Makefiles""... $ac_c" 1>&6
+echo "configure:808: checking whether to enable maintainer-specific portions of Makefiles" >&5
+ # Check whether --enable-maintainer-mode or --disable-maintainer-mode was given.
+if test "${enable_maintainer_mode+set}" = set; then
+ enableval="$enable_maintainer_mode"
+ USE_MAINTAINER_MODE=$enableval
+else
+ USE_MAINTAINER_MODE=no
+fi
+
+ echo "$ac_t""$USE_MAINTAINER_MODE" 1>&6
+
+
+if test $USE_MAINTAINER_MODE = yes; then
+ MAINTAINER_MODE_TRUE=
+ MAINTAINER_MODE_FALSE='#'
+else
+ MAINTAINER_MODE_TRUE='#'
+ MAINTAINER_MODE_FALSE=
+fi
+ MAINT=$MAINTAINER_MODE_TRUE
+
+
+# Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:833: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:863: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_prog_rejected=no
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -z "$CC"; then
+ case "`uname -s`" in
+ *win32* | *WIN32*)
+ # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:914: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="cl"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+ ;;
+ esac
+ fi
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:946: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 957 "configure"
+#include "confdefs.h"
+
+main(){return(0);}
+EOF
+if { (eval echo configure:962: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cc_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:988: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:993: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1002: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gcc=yes
+else
+ ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+else
+ GCC=
+fi
+
+ac_test_CFLAGS="${CFLAGS+set}"
+ac_save_CFLAGS="$CFLAGS"
+CFLAGS=
+echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:1021: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+
+echo $ac_n "checking for Cygwin environment""... $ac_c" 1>&6
+echo "configure:1053: checking for Cygwin environment" >&5
+if eval "test \"`echo '$''{'ac_cv_cygwin'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1058 "configure"
+#include "confdefs.h"
+
+int main() {
+
+#ifndef __CYGWIN__
+#define __CYGWIN__ __CYGWIN32__
+#endif
+return __CYGWIN__;
+; return 0; }
+EOF
+if { (eval echo configure:1069: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_cygwin=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_cygwin=no
+fi
+rm -f conftest*
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_cygwin" 1>&6
+CYGWIN=
+test "$ac_cv_cygwin" = yes && CYGWIN=yes
+echo $ac_n "checking for mingw32 environment""... $ac_c" 1>&6
+echo "configure:1086: checking for mingw32 environment" >&5
+if eval "test \"`echo '$''{'ac_cv_mingw32'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1091 "configure"
+#include "confdefs.h"
+
+int main() {
+return __MINGW32__;
+; return 0; }
+EOF
+if { (eval echo configure:1098: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_mingw32=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_mingw32=no
+fi
+rm -f conftest*
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_mingw32" 1>&6
+MINGW32=
+test "$ac_cv_mingw32" = yes && MINGW32=yes
+
+
+echo $ac_n "checking for executable suffix""... $ac_c" 1>&6
+echo "configure:1117: checking for executable suffix" >&5
+if eval "test \"`echo '$''{'ac_cv_exeext'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test "$CYGWIN" = yes || test "$MINGW32" = yes; then
+ ac_cv_exeext=.exe
+else
+ rm -f conftest*
+ echo 'int main () { return 0; }' > conftest.$ac_ext
+ ac_cv_exeext=
+ if { (eval echo configure:1127: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; }; then
+ for file in conftest.*; do
+ case $file in
+ *.c | *.o | *.obj | *.ilk | *.pdb) ;;
+ *) ac_cv_exeext=`echo $file | sed -e s/conftest//` ;;
+ esac
+ done
+ else
+ { echo "configure: error: installation or configuration problem: compiler cannot create executables." 1>&2; exit 1; }
+ fi
+ rm -f conftest*
+ test x"${ac_cv_exeext}" = x && ac_cv_exeext=no
+fi
+fi
+
+EXEEXT=""
+test x"${ac_cv_exeext}" != xno && EXEEXT=${ac_cv_exeext}
+echo "$ac_t""${ac_cv_exeext}" 1>&6
+ac_exeext=$EXEEXT
+
+echo $ac_n "checking for object suffix""... $ac_c" 1>&6
+echo "configure:1148: checking for object suffix" >&5
+if eval "test \"`echo '$''{'ac_cv_objext'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ rm -f conftest*
+echo 'int i = 1;' > conftest.$ac_ext
+if { (eval echo configure:1154: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ for ac_file in conftest.*; do
+ case $ac_file in
+ *.c) ;;
+ *) ac_cv_objext=`echo $ac_file | sed -e s/conftest.//` ;;
+ esac
+ done
+else
+ { echo "configure: error: installation or configuration problem; compiler does not work" 1>&2; exit 1; }
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_objext" 1>&6
+OBJEXT=$ac_cv_objext
+ac_objext=$ac_cv_objext
+
+# Check whether --enable-install-libgui or --disable-install-libgui was given.
+if test "${enable_install_libgui+set}" = set; then
+ enableval="$enable_install_libgui"
+ :
+fi
+
+
+
+if test x$cross_compiling = xyes; then
+ CROSS_COMPILING_TRUE=
+ CROSS_COMPILING_FALSE='#'
+else
+ CROSS_COMPILING_TRUE='#'
+ CROSS_COMPILING_FALSE=
+fi
+
+
+if test x$enable_install_libgui = xyes; then
+ INSTALL_LIBGUI_TRUE=
+ INSTALL_LIBGUI_FALSE='#'
+else
+ INSTALL_LIBGUI_TRUE='#'
+ INSTALL_LIBGUI_FALSE=
+fi
+# Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1198: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_RANLIB="ranlib"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+# Extract the first word of "itcl_sh", so it can be a program name with args.
+set dummy itcl_sh; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1228: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_ITCL_SH'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$ITCL_SH"; then
+ ac_cv_prog_ITCL_SH="$ITCL_SH" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_ITCL_SH="itcl_sh"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_ITCL_SH" && ac_cv_prog_ITCL_SH="\$\$here/\$(top_builddir)/../itcl/itcl/unix/itcl_sh\$(EXEEXT)"
+fi
+fi
+ITCL_SH="$ac_cv_prog_ITCL_SH"
+if test -n "$ITCL_SH"; then
+ echo "$ac_t""$ITCL_SH" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:1257: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # This must be in double quotes, not single quotes, because CPP may get
+ # substituted into the Makefile and "${CC-cc}" will confuse make.
+ CPP="${CC-cc} -E"
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp.
+ cat > conftest.$ac_ext <<EOF
+#line 1272 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1278: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -E -traditional-cpp"
+ cat > conftest.$ac_ext <<EOF
+#line 1289 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1295: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -nologo -E"
+ cat > conftest.$ac_ext <<EOF
+#line 1306 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1312: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+ ac_cv_prog_CPP="$CPP"
+fi
+ CPP="$ac_cv_prog_CPP"
+else
+ ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+# The Ultrix 4.2 mips builtin alloca declared by alloca.h only works
+# for constant arguments. Useless!
+echo $ac_n "checking for working alloca.h""... $ac_c" 1>&6
+echo "configure:1339: checking for working alloca.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_alloca_h'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1344 "configure"
+#include "confdefs.h"
+#include <alloca.h>
+int main() {
+char *p = alloca(2 * sizeof(int));
+; return 0; }
+EOF
+if { (eval echo configure:1351: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ ac_cv_header_alloca_h=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_header_alloca_h=no
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_header_alloca_h" 1>&6
+if test $ac_cv_header_alloca_h = yes; then
+ cat >> confdefs.h <<\EOF
+#define HAVE_ALLOCA_H 1
+EOF
+
+fi
+
+echo $ac_n "checking for alloca""... $ac_c" 1>&6
+echo "configure:1372: checking for alloca" >&5
+if eval "test \"`echo '$''{'ac_cv_func_alloca_works'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1377 "configure"
+#include "confdefs.h"
+
+#ifdef __GNUC__
+# define alloca __builtin_alloca
+#else
+# ifdef _MSC_VER
+# include <malloc.h>
+# define alloca _alloca
+# else
+# if HAVE_ALLOCA_H
+# include <alloca.h>
+# else
+# ifdef _AIX
+ #pragma alloca
+# else
+# ifndef alloca /* predefined by HP cc +Olibcalls */
+char *alloca ();
+# endif
+# endif
+# endif
+# endif
+#endif
+
+int main() {
+char *p = (char *) alloca(1);
+; return 0; }
+EOF
+if { (eval echo configure:1405: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ ac_cv_func_alloca_works=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_func_alloca_works=no
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_func_alloca_works" 1>&6
+if test $ac_cv_func_alloca_works = yes; then
+ cat >> confdefs.h <<\EOF
+#define HAVE_ALLOCA 1
+EOF
+
+fi
+
+if test $ac_cv_func_alloca_works = no; then
+ # The SVR3 libPW and SVR4 libucb both contain incompatible functions
+ # that cause trouble. Some versions do not even contain alloca or
+ # contain a buggy version. If you still want to use their alloca,
+ # use ar to extract alloca.o from them instead of compiling alloca.c.
+ ALLOCA=alloca.${ac_objext}
+ cat >> confdefs.h <<\EOF
+#define C_ALLOCA 1
+EOF
+
+
+echo $ac_n "checking whether alloca needs Cray hooks""... $ac_c" 1>&6
+echo "configure:1437: checking whether alloca needs Cray hooks" >&5
+if eval "test \"`echo '$''{'ac_cv_os_cray'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1442 "configure"
+#include "confdefs.h"
+#if defined(CRAY) && ! defined(CRAY2)
+webecray
+#else
+wenotbecray
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "webecray" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_os_cray=yes
+else
+ rm -rf conftest*
+ ac_cv_os_cray=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_os_cray" 1>&6
+if test $ac_cv_os_cray = yes; then
+for ac_func in _getb67 GETB67 getb67; do
+ echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:1467: checking for $ac_func" >&5
+if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1472 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char $ac_func();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+$ac_func();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1495: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_$ac_func=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_$ac_func=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ cat >> confdefs.h <<EOF
+#define CRAY_STACKSEG_END $ac_func
+EOF
+
+ break
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+done
+fi
+
+echo $ac_n "checking stack direction for C alloca""... $ac_c" 1>&6
+echo "configure:1522: checking stack direction for C alloca" >&5
+if eval "test \"`echo '$''{'ac_cv_c_stack_direction'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test "$cross_compiling" = yes; then
+ ac_cv_c_stack_direction=0
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1530 "configure"
+#include "confdefs.h"
+find_stack_direction ()
+{
+ static char *addr = 0;
+ auto char dummy;
+ if (addr == 0)
+ {
+ addr = &dummy;
+ return find_stack_direction ();
+ }
+ else
+ return (&dummy > addr) ? 1 : -1;
+}
+main ()
+{
+ exit (find_stack_direction() < 0);
+}
+EOF
+if { (eval echo configure:1549: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ ac_cv_c_stack_direction=1
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_c_stack_direction=-1
+fi
+rm -fr conftest*
+fi
+
+fi
+
+echo "$ac_t""$ac_cv_c_stack_direction" 1>&6
+cat >> confdefs.h <<EOF
+#define STACK_DIRECTION $ac_cv_c_stack_direction
+EOF
+
+fi
+
+for ac_hdr in stddef.h stdlib.h getopt.h unistd.h fcntl.h sys/file.h sys/wait.h string.h strings.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:1574: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1579 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1584: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+for ac_func in raise strdup
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:1613: checking for $ac_func" >&5
+if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1618 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char $ac_func();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+$ac_func();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1641: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_$ac_func=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_$ac_func=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_func 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+
+# Check whether --enable-ide or --disable-ide was given.
+if test "${enable_ide+set}" = set; then
+ enableval="$enable_ide"
+ case "${enableval}" in
+ yes) ide=yes ;;
+ no) ide=no ;;
+ *) { echo "configure: error: bad value ${enableval} for enable-ide option" 1>&2; exit 1; } ;;
+esac
+else
+ ide=no
+fi
+
+
+
+if test x$ide = xyes; then
+ IDE_ENABLED_TRUE=
+ IDE_ENABLED_FALSE='#'
+else
+ IDE_ENABLED_TRUE='#'
+ IDE_ENABLED_FALSE=
+fi
+if test x$ide = xyes; then
+ cat >> confdefs.h <<\EOF
+#define IDE_ENABLED 1
+EOF
+
+fi
+
+# If we have random, assume we have srandom. If we have drand48,
+# assume we have srand48. If we have rand, assume we have srand.
+for ac_func in random drand48 rand
+do
+echo $ac_n "checking for $ac_func""... $ac_c" 1>&6
+echo "configure:1699: checking for $ac_func" >&5
+if eval "test \"`echo '$''{'ac_cv_func_$ac_func'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1704 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char $ac_func(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char $ac_func();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_$ac_func) || defined (__stub___$ac_func)
+choke me
+#else
+$ac_func();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1727: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_$ac_func=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_$ac_func=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'$ac_func`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_func=HAVE_`echo $ac_func | tr 'abcdefghijklmnopqrstuvwxyz' 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_func 1
+EOF
+ break
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+
+cat > conftest.$ac_ext <<EOF
+#line 1753 "configure"
+#include "confdefs.h"
+#include <string.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "strncasecmp" >/dev/null 2>&1; then
+ rm -rf conftest*
+ cat >> confdefs.h <<\EOF
+#define HAVE_STRNCASECMP_DECL 1
+EOF
+
+fi
+rm -f conftest*
+
+
+# Tcl8.1 requires writable strings for gcc
+
+if test "$GCC" = "yes"; then
+ LIBGUI_CFLAGS=-fwritable-strings
+else
+ LIBGUI_CFLAGS=
+fi
+
+
+echo $ac_n "checking for cygwin32""... $ac_c" 1>&6
+echo "configure:1778: checking for cygwin32" >&5
+if eval "test \"`echo '$''{'ide_cv_os_cygwin32'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1783 "configure"
+#include "confdefs.h"
+
+#ifdef __CYGWIN32__
+lose
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "lose" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ide_cv_os_cygwin32=yes
+else
+ rm -rf conftest*
+ ide_cv_os_cygwin32=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ide_cv_os_cygwin32" 1>&6
+ac_win_build="no"
+if test x$ide_cv_os_cygwin32 = xyes; then
+ ac_win_build="yes"
+fi
+
+tmp="`cd $srcdir/library; pwd`"
+if test x"$ac_cv_prog_CC" = xcl ; then
+ tmp2="`cygpath --windows $tmp`"
+ LIBGUI_LIBRARY_DIR="`echo $tmp2 | sed -e s#\\\\\\\\#/#g`"
+else
+ LIBGUI_LIBRARY_DIR=$tmp
+fi
+
+
+# Find the init.tcl file.
+
+echo $ac_n "checking for init.tcl""... $ac_c" 1>&6
+echo "configure:1820: checking for init.tcl" >&5
+if eval "test \"`echo '$''{'ac_cv_c_tcl_libdir'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+if test -f $srcdir/../tcl/library/init.tcl ; then
+ ac_cv_c_tcl_libdir=`cd $srcdir/../tcl/library; pwd`
+elif test -f $srcdir/../tcl8.1/library/init.tcl; then
+ ac_cv_c_tcl_libdir=`cd $srcdir/../tcl8.1/library; pwd`
+fi
+
+fi
+
+echo "$ac_t""${ac_cv_c_tcl_libdir}" 1>&6
+
+if test x"$ac_cv_prog_CC" = xcl; then
+ tmp2="`cygpath --windows $ac_cv_c_tcl_libdir`"
+ TCL_LIBRARY="`echo $tmp2 | sed -e s#\\\\\\\\#/#g`"
+else
+ TCL_LIBRARY=$ac_cv_c_tcl_libdir
+fi
+
+
+# Check for Tcl and Tk.
+
+dirlist=".. ../../ ../../../ ../../../../ ../../../../../ ../../../../../../ ../../../../../../.. ../../../../../../../.. ../../../../../../../../.. ../../../../../../../../../.."
+if test x"${no_tcl}" = x ; then
+ no_tcl=true
+ # Check whether --with-tclconfig or --without-tclconfig was given.
+if test "${with_tclconfig+set}" = set; then
+ withval="$with_tclconfig"
+ with_tclconfig=${withval}
+fi
+
+ echo $ac_n "checking for Tcl configuration script""... $ac_c" 1>&6
+echo "configure:1855: checking for Tcl configuration script" >&5
+ if eval "test \"`echo '$''{'ac_cv_c_tclconfig'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+
+ if test x"${with_tclconfig}" != x ; then
+ if test -f "${with_tclconfig}/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd ${with_tclconfig}; pwd)`
+ else
+ { echo "configure: error: ${with_tclconfig} directory doesn't contain tclConfig.sh" 1>&2; exit 1; }
+ fi
+ fi
+
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in $dirlist; do
+ if test -f $srcdir/$i/unix/tclConfig.sh ; then
+ ac_cv_c_tclconfig=`(cd $srcdir/$i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in $dirlist; do
+ if test -n "`ls -dr $i/tcl* 2>/dev/null`" ; then
+ tclconfpath=$i
+ break
+ fi
+ done
+
+ for i in `ls -dr $tclconfpath/tcl* 2>/dev/null ` ; do
+ if test -f $i/unix/tclConfig.sh ; then
+ ac_cv_c_tclconfig=`(cd $i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ ccpath=`which ${CC} | sed -e 's:/bin/.*::'`/lib
+ if test -f $ccpath/tclConfig.sh; then
+ ac_cv_c_tclconfig=$ccpath
+ fi
+ fi
+
+fi
+
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ TCLCONFIG=""
+ echo "configure: warning: Can't find Tcl configuration definitions" 1>&2
+ else
+ no_tcl=""
+ TCLCONFIG=${ac_cv_c_tclconfig}/tclConfig.sh
+ echo "$ac_t""${TCLCONFIG}" 1>&6
+ fi
+fi
+
+
+
+ . $TCLCONFIG
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+dirlist=".. ../../ ../../../ ../../../../ ../../../../../ ../../../../../../ ../../../../../../.. ../../../../../../../.. ../../../../../../../../.. ../../../../../../../../../.."
+if test x"${no_tk}" = x ; then
+ no_tk=true
+ # Check whether --with-tkconfig or --without-tkconfig was given.
+if test "${with_tkconfig+set}" = set; then
+ withval="$with_tkconfig"
+ with_tkconfig=${withval}
+fi
+
+ echo $ac_n "checking for Tk configuration script""... $ac_c" 1>&6
+echo "configure:1946: checking for Tk configuration script" >&5
+ if eval "test \"`echo '$''{'ac_cv_c_tkconfig'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+
+ if test x"${with_tkconfig}" != x ; then
+ if test -f "${with_tkconfig}/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd ${with_tkconfig}; pwd)`
+ else
+ { echo "configure: error: ${with_tkconfig} directory doesn't contain tkConfig.sh" 1>&2; exit 1; }
+ fi
+ fi
+
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ for i in $dirlist; do
+ if test -f $srcdir/$i/unix/tkConfig.sh ; then
+ ac_cv_c_tkconfig=`(cd $srcdir/$i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ for i in $dirlist; do
+ if test -n "`ls -dr $i/tk* 2>/dev/null`" ; then
+ tkconfpath=$i
+ break
+ fi
+ done
+
+ for i in `ls -dr $tkconfpath/tk* 2>/dev/null ` ; do
+ if test -f $i/unix/tkConfig.sh ; then
+ ac_cv_c_tkconfig=`(cd $i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ ccpath=`which ${CC} | sed -e 's:/bin/.*::'`/lib
+ if test -f $ccpath/tkConfig.sh; then
+ ac_cv_c_tkconfig=$ccpath
+ fi
+ fi
+
+fi
+
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ TKCONFIG=""
+ echo "configure: warning: Can't find Tk configuration definitions" 1>&2
+ else
+ no_tk=""
+ TKCONFIG=${ac_cv_c_tkconfig}/tkConfig.sh
+ echo "$ac_t""${TKCONFIG}" 1>&6
+ fi
+fi
+
+
+
+ if test -f "$TKCONFIG" ; then
+ . $TKCONFIG
+ fi
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+dirlist=".. ../../ ../../../ ../../../../ ../../../../../ ../../../../../../ ../../../../../../.. ../../../../../../../.. ../../../../../../../../.. ../../../../../../../../../.."
+no_tcl=true
+echo $ac_n "checking for Tcl headers in the source tree""... $ac_c" 1>&6
+echo "configure:2026: checking for Tcl headers in the source tree" >&5
+# Check whether --with-tclinclude or --without-tclinclude was given.
+if test "${with_tclinclude+set}" = set; then
+ withval="$with_tclinclude"
+ with_tclinclude=${withval}
+fi
+
+if eval "test \"`echo '$''{'ac_cv_c_tclh'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+if test x"${with_tclinclude}" != x ; then
+ if test -f ${with_tclinclude}/tcl.h ; then
+ ac_cv_c_tclh=`(cd ${with_tclinclude}; pwd)`
+ elif test -f ${with_tclinclude}/generic/tcl.h ; then
+ ac_cv_c_tclh=`(cd ${with_tclinclude}/generic; pwd)`
+ else
+ { echo "configure: error: ${with_tclinclude} directory doesn't contain headers" 1>&2; exit 1; }
+ fi
+fi
+
+if test x"${ac_cv_c_tclconfig}" != x ; then
+ for i in $dirlist; do
+ if test -f $ac_cv_c_tclconfig/$i/generic/tcl.h ; then
+ ac_cv_c_tclh=`(cd $ac_cv_c_tclconfig/$i/generic; pwd)`
+ break
+ fi
+ done
+fi
+
+if test x"${ac_cv_c_tclh}" = x ; then
+ for i in $dirlist; do
+ if test -n "`ls -dr $srcdir/$i/tcl* 2>/dev/null`" ; then
+ tclpath=$srcdir/$i
+ break
+ fi
+ done
+
+ for i in `ls -dr $tclpath/tcl* 2>/dev/null ` ; do
+ if test -f $i/generic/tcl.h ; then
+ ac_cv_c_tclh=`(cd $i/generic; pwd)`
+ break
+ fi
+ done
+fi
+
+if test x"${ac_cv_c_tclh}" = x ; then
+ ccpath=`which ${CC} | sed -e 's:/bin/.*::'`/include
+ if test -f $ccpath/tcl.h; then
+ ac_cv_c_tclh=$ccpath
+ fi
+fi
+
+if test x"${ac_cv_c_tclh}" = x ; then
+ echo "$ac_t""none" 1>&6
+ ac_safe=`echo "tcl.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for tcl.h""... $ac_c" 1>&6
+echo "configure:2083: checking for tcl.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2088 "configure"
+#include "confdefs.h"
+#include <tcl.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2093: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_cv_c_tclh=installed
+else
+ echo "$ac_t""no" 1>&6
+ac_cv_c_tclh=""
+fi
+
+else
+ echo "$ac_t""${ac_cv_c_tclh}" 1>&6
+fi
+
+fi
+
+ TCLHDIR=""
+if test x"${ac_cv_c_tclh}" = x ; then
+ { echo "configure: error: Can't find any Tcl headers" 1>&2; exit 1; }
+fi
+if test x"${ac_cv_c_tclh}" != x ; then
+ no_tcl=""
+ if test x"${ac_cv_c_tclh}" != x"installed" ; then
+ if test x"${CC}" = xcl ; then
+ tmp="`cygpath --windows ${ac_cv_c_tclh}`"
+ ac_cv_c_tclh="`echo $tmp | sed -e s#\\\\\\\\#/#g`"
+ fi
+ echo "$ac_t""${ac_cv_c_tclh}" 1>&6
+ TCLHDIR="-I${ac_cv_c_tclh}"
+ fi
+fi
+
+
+
+# FIXME: consider only doing this if --with-x given.
+
+#
+# Ok, lets find the tk source trees so we can use the headers
+# If the directory (presumably symlink) named "tk" exists, use that one
+# in preference to any others. Same logic is used when choosing library
+# and again with Tcl. The search order is the best place to look first, then in
+# decreasing significance. The loop breaks if the trigger file is found.
+# Note the gross little conversion here of srcdir by cd'ing to the found
+# directory. This converts the path from a relative to an absolute, so
+# recursive cache variables for the path will work right. We check all
+# the possible paths in one loop rather than many seperate loops to speed
+# things up.
+# the alternative search directory is involked by --with-tkinclude
+#
+dirlist=".. ../../ ../../../ ../../../../ ../../../../../ ../../../../../../ ../../../../../../.. ../../../../../../../.. ../../../../../../../../.. ../../../../../../../../../.."
+no_tk=true
+echo $ac_n "checking for Tk headers in the source tree""... $ac_c" 1>&6
+echo "configure:2157: checking for Tk headers in the source tree" >&5
+# Check whether --with-tkinclude or --without-tkinclude was given.
+if test "${with_tkinclude+set}" = set; then
+ withval="$with_tkinclude"
+ with_tkinclude=${withval}
+fi
+
+if eval "test \"`echo '$''{'ac_cv_c_tkh'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+if test x"${with_tkinclude}" != x ; then
+ if test -f ${with_tkinclude}/tk.h ; then
+ ac_cv_c_tkh=`(cd ${with_tkinclude}; pwd)`
+ elif test -f ${with_tkinclude}/generic/tk.h ; then
+ ac_cv_c_tkh=`(cd ${with_tkinclude}/generic; pwd)`
+ else
+ { echo "configure: error: ${with_tkinclude} directory doesn't contain headers" 1>&2; exit 1; }
+ fi
+fi
+
+if test x"${ac_cv_c_tkconfig}" != x ; then
+ for i in $dirlist; do
+ if test -f $ac_cv_c_tkconfig/$i/generic/tk.h ; then
+ ac_cv_c_tkh=`(cd $ac_cv_c_tkconfig/$i/generic; pwd)`
+ break
+ fi
+ done
+fi
+
+if test x"${ac_cv_c_tkh}" = x ; then
+ for i in $dirlist; do
+ if test -n "`ls -dr $srcdir/$i/tk* 2>/dev/null`" ; then
+ tkpath=$srcdir/$i
+ break
+ fi
+ done
+
+ for i in `ls -dr $tkpath/tk* 2>/dev/null ` ; do
+ if test -f $i/generic/tk.h ; then
+ ac_cv_c_tkh=`(cd $i/generic; pwd)`
+ break
+ fi
+ done
+fi
+
+if test x"${ac_cv_c_tkh}" = x ; then
+ echo "$ac_t""none" 1>&6
+ ccpath=`which ${CC} | sed -e 's:/bin/.*::'`/include
+ if test -f $ccpath/tk.h; then
+ ac_cv_c_tkh=$ccpath
+ fi
+else
+ echo "$ac_t""${ac_cv_c_tkh}" 1>&6
+fi
+
+fi
+
+ TKHDIR=""
+if test x"${ac_cv_c_tkh}" = x ; then
+ { echo "configure: error: Can't find any Tk headers" 1>&2; exit 1; }
+fi
+if test x"${ac_cv_c_tkh}" != x ; then
+ no_tk=""
+ if test x"${ac_cv_c_tkh}" != x"installed" ; then
+ if test x"${CC}" = xcl ; then
+ tmp="`cygpath --windows ${ac_cv_c_tkh}`"
+ ac_cv_c_tkh="`echo $tmp | sed -e s#\\\\\\\\#/#g`"
+ fi
+ echo "$ac_t""found in ${ac_cv_c_tkh}" 1>&6
+ TKHDIR="-I${ac_cv_c_tkh}"
+ fi
+fi
+
+
+
+
+
+# Make sure we can run config.sub.
+if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then :
+else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking host system type""... $ac_c" 1>&6
+echo "configure:2241: checking host system type" >&5
+
+host_alias=$host
+case "$host_alias" in
+NONE)
+ case $nonopt in
+ NONE)
+ if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then :
+ else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; }
+ fi ;;
+ *) host_alias=$nonopt ;;
+ esac ;;
+esac
+
+host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias`
+host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+echo "$ac_t""$host" 1>&6
+
+case ${host} in
+*cygwin*) ITCL_DIR=itcl/itcl/win ;;
+*) ITCL_DIR=itcl/itcl/unix ;;
+esac
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+if test x$TCL_SHARED_BUILD = x1; then
+ TCL_SHARED_TRUE=
+ TCL_SHARED_FALSE='#'
+else
+ TCL_SHARED_TRUE='#'
+ TCL_SHARED_FALSE=
+fi
+
+
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+DEFS=-DHAVE_CONFIG_H
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.13"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "Makefile library/Makefile src/Makefile config.h" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@PACKAGE@%$PACKAGE%g
+s%@VERSION@%$VERSION%g
+s%@ACLOCAL@%$ACLOCAL%g
+s%@AUTOCONF@%$AUTOCONF%g
+s%@AUTOMAKE@%$AUTOMAKE%g
+s%@AUTOHEADER@%$AUTOHEADER%g
+s%@MAKEINFO@%$MAKEINFO%g
+s%@SET_MAKE@%$SET_MAKE%g
+s%@MAINTAINER_MODE_TRUE@%$MAINTAINER_MODE_TRUE%g
+s%@MAINTAINER_MODE_FALSE@%$MAINTAINER_MODE_FALSE%g
+s%@MAINT@%$MAINT%g
+s%@CC@%$CC%g
+s%@EXEEXT@%$EXEEXT%g
+s%@OBJEXT@%$OBJEXT%g
+s%@CROSS_COMPILING_TRUE@%$CROSS_COMPILING_TRUE%g
+s%@CROSS_COMPILING_FALSE@%$CROSS_COMPILING_FALSE%g
+s%@INSTALL_LIBGUI_TRUE@%$INSTALL_LIBGUI_TRUE%g
+s%@INSTALL_LIBGUI_FALSE@%$INSTALL_LIBGUI_FALSE%g
+s%@RANLIB@%$RANLIB%g
+s%@ITCL_SH@%$ITCL_SH%g
+s%@CPP@%$CPP%g
+s%@ALLOCA@%$ALLOCA%g
+s%@IDE_ENABLED_TRUE@%$IDE_ENABLED_TRUE%g
+s%@IDE_ENABLED_FALSE@%$IDE_ENABLED_FALSE%g
+s%@LIBGUI_CFLAGS@%$LIBGUI_CFLAGS%g
+s%@LIBGUI_LIBRARY_DIR@%$LIBGUI_LIBRARY_DIR%g
+s%@TCL_LIBRARY@%$TCL_LIBRARY%g
+s%@TCLCONFIG@%$TCLCONFIG%g
+s%@TCL_DEFS@%$TCL_DEFS%g
+s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g
+s%@TCL_LIB_FULL_PATH@%$TCL_LIB_FULL_PATH%g
+s%@TCL_LIBS@%$TCL_LIBS%g
+s%@TCL_CFLAGS@%$TCL_CFLAGS%g
+s%@TCL_SHLIB_CFLAGS@%$TCL_SHLIB_CFLAGS%g
+s%@TCL_SHLIB_LD@%$TCL_SHLIB_LD%g
+s%@TCL_LD_FLAGS@%$TCL_LD_FLAGS%g
+s%@TCL_LD_SEARCH_FLAGS@%$TCL_LD_SEARCH_FLAGS%g
+s%@TCL_RANLIB@%$TCL_RANLIB%g
+s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
+s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
+s%@TKCONFIG@%$TKCONFIG%g
+s%@TK_VERSION@%$TK_VERSION%g
+s%@TK_DEFS@%$TK_DEFS%g
+s%@TK_LIB_FILE@%$TK_LIB_FILE%g
+s%@TK_LIB_FULL_PATH@%$TK_LIB_FULL_PATH%g
+s%@TK_LIBS@%$TK_LIBS%g
+s%@TK_BUILD_INCLUDES@%$TK_BUILD_INCLUDES%g
+s%@TK_XINCLUDES@%$TK_XINCLUDES%g
+s%@TK_XLIBSW@%$TK_XLIBSW%g
+s%@TK_BUILD_LIB_SPEC@%$TK_BUILD_LIB_SPEC%g
+s%@TK_LIB_SPEC@%$TK_LIB_SPEC%g
+s%@TCLHDIR@%$TCLHDIR%g
+s%@TKHDIR@%$TKHDIR%g
+s%@host@%$host%g
+s%@host_alias@%$host_alias%g
+s%@host_cpu@%$host_cpu%g
+s%@host_vendor@%$host_vendor%g
+s%@host_os@%$host_os%g
+s%@ITCL_DIR@%$ITCL_DIR%g
+s%@TCL_SHARED_TRUE@%$TCL_SHARED_TRUE%g
+s%@TCL_SHARED_FALSE@%$TCL_SHARED_FALSE%g
+s%@RPATH_ENVVAR@%$RPATH_ENVVAR%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile library/Makefile src/Makefile"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+ case "$ac_given_INSTALL" in
+ [/$]*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ esac
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+# These sed commands are passed to sed as "A NAME B NAME C VALUE D", where
+# NAME is the cpp macro being defined and VALUE is the value it is being given.
+#
+# ac_d sets the value in "#define NAME VALUE" lines.
+ac_dA='s%^\([ ]*\)#\([ ]*define[ ][ ]*\)'
+ac_dB='\([ ][ ]*\)[^ ]*%\1#\2'
+ac_dC='\3'
+ac_dD='%g'
+# ac_u turns "#undef NAME" with trailing blanks into "#define NAME VALUE".
+ac_uA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)'
+ac_uB='\([ ]\)%\1#\2define\3'
+ac_uC=' '
+ac_uD='\4%g'
+# ac_e turns "#undef NAME" without trailing blanks into "#define NAME VALUE".
+ac_eA='s%^\([ ]*\)#\([ ]*\)undef\([ ][ ]*\)'
+ac_eB='$%\1#\2define\3'
+ac_eC=' '
+ac_eD='%g'
+
+if test "${CONFIG_HEADERS+set}" != set; then
+EOF
+cat >> $CONFIG_STATUS <<EOF
+ CONFIG_HEADERS="config.h"
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+fi
+for ac_file in .. $CONFIG_HEADERS; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ echo creating $ac_file
+
+ rm -f conftest.frag conftest.in conftest.out
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ cat $ac_file_inputs > conftest.in
+
+EOF
+
+# Transform confdefs.h into a sed script conftest.vals that substitutes
+# the proper values into config.h.in to produce config.h. And first:
+# Protect against being on the right side of a sed subst in config.status.
+# Protect against being in an unquoted here document in config.status.
+rm -f conftest.vals
+cat > conftest.hdr <<\EOF
+s/[\\&%]/\\&/g
+s%[\\$`]%\\&%g
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%${ac_dA}\1${ac_dB}\1${ac_dC}\2${ac_dD}%gp
+s%ac_d%ac_u%gp
+s%ac_u%ac_e%gp
+EOF
+sed -n -f conftest.hdr confdefs.h > conftest.vals
+rm -f conftest.hdr
+
+# This sed command replaces #undef with comments. This is necessary, for
+# example, in the case of _POSIX_SOURCE, which is predefined and required
+# on some systems where configure will not decide to define it.
+cat >> conftest.vals <<\EOF
+s%^[ ]*#[ ]*undef[ ][ ]*[a-zA-Z_][a-zA-Z_0-9]*%/* & */%
+EOF
+
+# Break up conftest.vals because some shells have a limit on
+# the size of here documents, and old seds have small limits too.
+
+rm -f conftest.tail
+while :
+do
+ ac_lines=`grep -c . conftest.vals`
+ # grep -c gives empty output for an empty file on some AIX systems.
+ if test -z "$ac_lines" || test "$ac_lines" -eq 0; then break; fi
+ # Write a limited-size here document to conftest.frag.
+ echo ' cat > conftest.frag <<CEOF' >> $CONFIG_STATUS
+ sed ${ac_max_here_lines}q conftest.vals >> $CONFIG_STATUS
+ echo 'CEOF
+ sed -f conftest.frag conftest.in > conftest.out
+ rm -f conftest.in
+ mv conftest.out conftest.in
+' >> $CONFIG_STATUS
+ sed 1,${ac_max_here_lines}d conftest.vals > conftest.tail
+ rm -f conftest.vals
+ mv conftest.tail conftest.vals
+done
+rm -f conftest.vals
+
+cat >> $CONFIG_STATUS <<\EOF
+ rm -f conftest.frag conftest.h
+ echo "/* $ac_file. Generated automatically by configure. */" > conftest.h
+ cat conftest.in >> conftest.h
+ rm -f conftest.in
+ if cmp -s $ac_file conftest.h 2>/dev/null; then
+ echo "$ac_file is unchanged"
+ rm -f conftest.h
+ else
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ fi
+ rm -f $ac_file
+ mv conftest.h $ac_file
+ fi
+fi; done
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+test -z "$CONFIG_HEADERS" || echo timestamp > stamp-h
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
+
+
+
diff --git a/libgui/configure.in b/libgui/configure.in
new file mode 100644
index 00000000000..479663d6732
--- /dev/null
+++ b/libgui/configure.in
@@ -0,0 +1,127 @@
+dnl Process this file with autoconf to produce configure.
+
+AC_INIT(src/subcommand.h)
+AM_INIT_AUTOMAKE(libgui, 0.0)
+AM_CONFIG_HEADER(config.h)
+AM_MAINTAINER_MODE
+AC_PROG_CC
+AC_EXEEXT
+AC_OBJEXT
+AC_ARG_ENABLE(install-libgui, \
+ [ --enable-install-libgui Install libgui.a and library header files])
+AM_CONDITIONAL(CROSS_COMPILING, test x$cross_compiling = xyes)
+AM_CONDITIONAL(INSTALL_LIBGUI, test x$enable_install_libgui = xyes)
+AC_PROG_RANLIB
+AC_CHECK_PROG(ITCL_SH, itcl_sh, itcl_sh,
+ [\$\$here/\$(top_builddir)/../itcl/itcl/unix/itcl_sh\$(EXEEXT)])
+
+AC_FUNC_ALLOCA
+AC_HAVE_HEADERS(stddef.h stdlib.h getopt.h unistd.h fcntl.h sys/file.h sys/wait.h string.h strings.h)
+AC_CHECK_FUNCS(raise strdup)
+
+AC_ARG_ENABLE(ide, [ --enable-ide Enable IDE support],
+[case "${enableval}" in
+ yes) ide=yes ;;
+ no) ide=no ;;
+ *) AC_MSG_ERROR(bad value ${enableval} for enable-ide option) ;;
+esac],
+[ide=no])
+AM_CONDITIONAL(IDE_ENABLED, test x$ide = xyes)
+if test x$ide = xyes; then
+ AC_DEFINE(IDE_ENABLED)
+fi
+
+# If we have random, assume we have srandom. If we have drand48,
+# assume we have srand48. If we have rand, assume we have srand.
+AC_CHECK_FUNCS(random drand48 rand, break)
+
+dnl Tcl ensures that strncasecmp is provided everywhere. But in some
+dnl situations we might need to declare it. We check for that case
+dnl here.
+AC_EGREP_CPP(strncasecmp, [#include <string.h>],
+ AC_DEFINE(HAVE_STRNCASECMP_DECL))
+
+# Tcl8.1 requires writable strings for gcc
+
+if test "$GCC" = "yes"; then
+ LIBGUI_CFLAGS=-fwritable-strings
+else
+ LIBGUI_CFLAGS=
+fi
+AC_SUBST(LIBGUI_CFLAGS)
+
+AC_CACHE_CHECK([for cygwin32], ide_cv_os_cygwin32,
+[AC_EGREP_CPP(lose, [
+#ifdef __CYGWIN32__
+lose
+#endif],[ide_cv_os_cygwin32=yes],[ide_cv_os_cygwin32=no])])
+ac_win_build="no"
+if test x$ide_cv_os_cygwin32 = xyes; then
+ ac_win_build="yes"
+fi
+
+tmp="`cd $srcdir/library; pwd`"
+if test x"$ac_cv_prog_CC" = xcl ; then
+ tmp2="`cygpath --windows $tmp`"
+ LIBGUI_LIBRARY_DIR="`echo $tmp2 | sed -e s#\\\\\\\\#/#g`"
+else
+ LIBGUI_LIBRARY_DIR=$tmp
+fi
+AC_SUBST(LIBGUI_LIBRARY_DIR)
+
+# Find the init.tcl file.
+
+AC_MSG_CHECKING(for init.tcl)
+AC_CACHE_VAL(ac_cv_c_tcl_libdir,[
+dnl currently, only check the source tree
+if test -f $srcdir/../tcl/library/init.tcl ; then
+ ac_cv_c_tcl_libdir=`cd $srcdir/../tcl/library; pwd`
+elif test -f $srcdir/../tcl8.1/library/init.tcl; then
+ ac_cv_c_tcl_libdir=`cd $srcdir/../tcl8.1/library; pwd`
+fi
+])
+AC_MSG_RESULT(${ac_cv_c_tcl_libdir})
+
+if test x"$ac_cv_prog_CC" = xcl; then
+ tmp2="`cygpath --windows $ac_cv_c_tcl_libdir`"
+ TCL_LIBRARY="`echo $tmp2 | sed -e s#\\\\\\\\#/#g`"
+else
+ TCL_LIBRARY=$ac_cv_c_tcl_libdir
+fi
+AC_SUBST(TCL_LIBRARY)
+
+# Check for Tcl and Tk.
+CYG_AC_PATH_TCLCONFIG
+CYG_AC_LOAD_TCLCONFIG
+CYG_AC_PATH_TKCONFIG
+CYG_AC_LOAD_TKCONFIG
+CYG_AC_PATH_TCLH
+# FIXME: consider only doing this if --with-x given.
+CYG_AC_PATH_TKH
+
+dnl what is the path to itclsh?
+AC_CANONICAL_HOST
+case ${host} in
+*cygwin*) ITCL_DIR=itcl/itcl/win ;;
+*) ITCL_DIR=itcl/itcl/unix ;;
+esac
+
+AC_SUBST(TCL_DEFS)
+AC_SUBST(TK_DEFS)
+AC_SUBST(TCLHDIR)
+AC_SUBST(TKHDIR)
+AC_SUBST(TK_XINCLUDES)
+AC_SUBST(TCL_LIBS)
+AC_SUBST(TK_BUILD_LIB_SPEC)
+AC_SUBST(TCL_BUILD_LIB_SPEC)
+AC_SUBST(TK_LIBS)
+AC_SUBST(ITCL_DIR)
+
+AM_CONDITIONAL(TCL_SHARED, test x$TCL_SHARED_BUILD = x1)
+
+AC_SUBST(RPATH_ENVVAR)
+
+AC_OUTPUT([Makefile library/Makefile src/Makefile])
+
+
+
diff --git a/libgui/doc/tkTable.n b/libgui/doc/tkTable.n
new file mode 100644
index 00000000000..4fa4be25678
--- /dev/null
+++ b/libgui/doc/tkTable.n
@@ -0,0 +1,1223 @@
+'\" The definitions below are for supplemental macros used in Tcl/Tk
+'\" manual entries.
+'\"
+'\" .AP type name in/out ?indent?
+'\" Start paragraph describing an argument to a library procedure.
+'\" type is type of argument (int, etc.), in/out is either "in", "out",
+'\" or "in/out" to describe whether procedure reads or modifies arg,
+'\" and indent is equivalent to second arg of .IP (shouldn't ever be
+'\" needed; use .AS below instead)
+'\"
+'\" .AS ?type? ?name?
+'\" Give maximum sizes of arguments for setting tab stops. Type and
+'\" name are examples of largest possible arguments that will be passed
+'\" to .AP later. If args are omitted, default tab stops are used.
+'\"
+'\" .BS
+'\" Start box enclosure. From here until next .BE, everything will be
+'\" enclosed in one large box.
+'\"
+'\" .BE
+'\" End of box enclosure.
+'\"
+'\" .CS
+'\" Begin code excerpt.
+'\"
+'\" .CE
+'\" End code excerpt.
+'\"
+'\" .VS ?br?
+'\" Begin vertical sidebar, for use in marking newly-changed parts
+'\" of man pages. If an argument is present, then a line break is
+'\" forced before starting the sidebar.
+'\"
+'\" .VE
+'\" End of vertical sidebar.
+'\"
+'\" .DS
+'\" Begin an indented unfilled display.
+'\"
+'\" .DE
+'\" End of indented unfilled display.
+'\"
+'\" .SO
+'\" Start of list of standard options for a Tk widget. The
+'\" options follow on successive lines, in four columns separated
+'\" by tabs.
+'\"
+'\" .SE
+'\" End of list of standard options for a Tk widget.
+'\"
+'\" .OP cmdName dbName dbClass
+'\" Start of description of a specific option. cmdName gives the
+'\" option's name as specified in the class command, dbName gives
+'\" the option's name in the option database, and dbClass gives
+'\" the option's class in the option database.
+'\"
+'\" .UL arg1 arg2
+'\" Print arg1 underlined, then print arg2 normally.
+'\"
+'\" SCCS: @(#) man.macros 1.8 96/02/15 20:02:24
+'\"
+'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages.
+.if t .wh -1.3i ^B
+.nr ^l \n(.l
+.ad b
+'\" # Start an argument description
+.de AP
+.ie !"\\$4"" .TP \\$4
+.el \{\
+. ie !"\\$2"" .TP \\n()Cu
+. el .TP 15
+.\}
+.ie !"\\$3"" \{\
+.ta \\n()Au \\n()Bu
+\&\\$1 \\fI\\$2\\fP (\\$3)
+.\".b
+.\}
+.el \{\
+.br
+.ie !"\\$2"" \{\
+\&\\$1 \\fI\\$2\\fP
+.\}
+.el \{\
+\&\\fI\\$1\\fP
+.\}
+.\}
+..
+'\" # define tabbing values for .AP
+.de AS
+.nr )A 10n
+.if !"\\$1"" .nr )A \\w'\\$1'u+3n
+.nr )B \\n()Au+15n
+.\"
+.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n
+.nr )C \\n()Bu+\\w'(in/out)'u+2n
+..
+.AS Tcl_Interp Tcl_CreateInterp in/out
+'\" # BS - start boxed text
+'\" # ^y = starting y location
+'\" # ^b = 1
+.de BS
+.br
+.mk ^y
+.nr ^b 1u
+.if n .nf
+.if n .ti 0
+.if n \l'\\n(.lu\(ul'
+.if n .fi
+..
+'\" # BE - end boxed text (draw box now)
+.de BE
+.nf
+.ti 0
+.mk ^t
+.ie n \l'\\n(^lu\(ul'
+.el \{\
+.\" Draw four-sided box normally, but don't draw top of
+.\" box if the box started on an earlier page.
+.ie !\\n(^b-1 \{\
+\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.el \}\
+\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.\}
+.fi
+.br
+.nr ^b 0
+..
+'\" # VS - start vertical sidebar
+'\" # ^Y = starting y location
+'\" # ^v = 1 (for troff; for nroff this doesn't matter)
+.de VS
+.if !"\\$1"" .br
+.mk ^Y
+.ie n 'mc \s12\(br\s0
+.el .nr ^v 1u
+..
+'\" # VE - end of vertical sidebar
+.de VE
+.ie n 'mc
+.el \{\
+.ev 2
+.nf
+.ti 0
+.mk ^t
+\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n'
+.sp -1
+.fi
+.ev
+.\}
+.nr ^v 0
+..
+'\" # Special macro to handle page bottom: finish off current
+'\" # box/sidebar if in box/sidebar mode, then invoked standard
+'\" # page bottom macro.
+.de ^B
+.ev 2
+'ti 0
+'nf
+.mk ^t
+.if \\n(^b \{\
+.\" Draw three-sided box if this is the box's first page,
+.\" draw two sides but no top otherwise.
+.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.\}
+.if \\n(^v \{\
+.nr ^x \\n(^tu+1v-\\n(^Yu
+\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c
+.\}
+.bp
+'fi
+.ev
+.if \\n(^b \{\
+.mk ^y
+.nr ^b 2
+.\}
+.if \\n(^v \{\
+.mk ^Y
+.\}
+..
+'\" # DS - begin display
+.de DS
+.RS
+.nf
+.sp
+..
+'\" # DE - end display
+.de DE
+.fi
+.RE
+.sp
+..
+'\" # SO - start of list of standard options
+.de SO
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+.ft B
+..
+'\" # SE - end of list of standard options
+.de SE
+.fi
+.ft R
+.LP
+See the \\fBoptions\\fR manual entry for details on the standard options.
+..
+'\" # OP - start of full description for a single option
+.de OP
+.LP
+.nf
+.ta 4c
+Command-Line Name: \\fB\\$1\\fR
+Database Name: \\fB\\$2\\fR
+Database Class: \\fB\\$3\\fR
+.fi
+.IP
+..
+'\" # CS - begin code excerpt
+.de CS
+.RS
+.nf
+.ta .25i .5i .75i 1i
+..
+'\" # CE - end code excerpt
+.de CE
+.fi
+.RE
+..
+.de UL
+\\$1\l'|0\(ul'\\$2
+..
+.TH table n 2.00 Tk "Tk Table Extension"
+.HS table tk
+.BS
+.SH NAME
+table \- Create and manipulate tables
+.SH SYNOPSIS
+\fBtable\fI \fIpathName \fR?\fIoptions\fR?
+.SO
+\-anchor \-background \-borderwidth \-cursor
+\-exportselection \-font \-foreground
+\-highlightbackground \-highlightcolor \-highlightthickness
+\-insertbackground \-insertborderwidth \-insertofftime
+\-insertontime \-insertwidth \-invertselected \-padx
+\-pady \-relief \-takefocus \-xscrollcommand
+\-yscrollcommand
+.SE
+
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-autoclear autoClear AutoClear
+A boolean value which specifies whether the first keypress in a cell will
+delete whatever text was previously there. Defaults to 0.
+.OP \-batchmode batchMode BatchMode
+If true, updates are not forced out at any point, the widget waits for Tk to
+be idle before it repaints the screen. If false, flashes, variable updates
+and the cursor changes are forced immediately to the screen.
+Defaults to false.
+.OP \-bordercursor borderCursor Cursor
+Specifies the name of the cursor to show when over borders, a visual
+indication that interactive resizing is allowed (it is thus affect by
+the value of \-resizeborders). Defaults to \fIcrosshair\fR.
+.OP "\-browsecommand or \-browsecmd" browseCommand BrowseCommand
+Specifies a command which will be evaluated anytime the active cell changes.
+It uses the %\-substition model described in COMMAND SUBSTITUTION below.
+.OP \-cache cache Cache
+A boolean value that specifies whether an internal cache of the table
+contents should be kept. This greatly enhances speed performance when used
+with \fB\-command\fR but uses extra memory. Can maintain state when both
+\fB\-command\fR and \fB\-variable\fR are empty. The cache is automatically
+flushed whenever the value of \fB\-cache\fR or \fB\-variable\fR changes,
+otherwise you have to explicitly \fBflush\fR it. Defaults to false.
+.OP \-colorigin colOrigin Origin
+Specifies what column index to interpret as the leftmost column in the table.
+This value is used for user indices in the table. Defaults to 0.
+.OP \-cols cols Cols
+Number of cols in the table. Defaults to 10.
+.OP \-colseparator colSeparator Separator
+Specifies a separator character that will be interpreted as the column
+separator when cutting or pasting data in a table. By default, columns
+are separated as elements of a tcl list.
+.OP \-colstretchmode colStretchMode StretchMode
+Specifies one of the following stretch modes for columns to fill extra
+allocated window space:
+.RS
+.TP
+\fBnone\fR
+Columns will not stretch to fill the assigned window space. If the columns
+are too narrow, there will be a blank space at the right of the table. This
+is the default.
+.TP
+\fBunset\fR
+Only columns that do not have a specific width set will be stretched.
+.TP
+\fBall\fR
+All columns will be stretched by the same number of pixels to fill the
+window space allocated to the table. This mode can interfere with
+interactive border resizing which tries to force column width.
+.TP
+\fBlast\fR
+The last column will be stretched
+to fill the window space allocated to the table.
+.TP
+\fBfill\fR (only valid for \fB\-rowstretch\fR currently)
+The table will get more or less columns according to the window
+space allocated to the table. This mode has numerous quirks and
+may disappear in the future.
+.RE
+.OP \-coltagcommand colTagCommand TagCommand
+Provides the name of a procedure that will be evaluated by the widget to
+determine the tag to be used for a given column. When displaying a cell,
+the table widget will first check to see if a tag has been defined using the
+\fBtag col\fR widget method. If no tag is found, it will evaluate the named
+procedure passing the column number in question as the sole argument. The
+procedure is expected to return the name of a tag to use, or a null string.
+Errors occuring during the evaluation of the procedure, or the return of an
+invalid tag name are silently ignored.
+.OP \-colwidth colWidth ColWidth
+Default column width, interpreted as characters in the default font when
+the number is positive, or pixels if it is negative. Defaults to 10.
+.OP \-command command Command
+Specified a command to use as a procedural interface to cell values.
+If \fB\-usecommand\fR is true, this command will be used instead of any
+reference to the \fB\-variable\fR array. When retrieving cell values,
+the return value of the command is used as the value for the cell.
+It uses the %\-substition model described in COMMAND SUBSTITUTION below.
+.OP \-drawmode drawMode DrawMode
+Sets the table drawing mode to one of the following options:
+.RS
+.TP
+\fBslow\fR
+The table is drawn to an offscreen pixmap using the Tk bordering functions.
+This means there will be no flashing, but this mode is slow for all but
+small tables.
+.TP
+\fBcompatible\fR
+The table is drawn directly to the screen using the Tk border functions.
+It is faster, but the screen may flash on update. This is the default.
+.TP
+\fBfast\fR
+The table is drawn directly to the screen and the borders are done with
+fast X calls, so they are always one pixel wide only. As a side effect,
+it sets \fB\-borderwidth\fR to 1. This mode provides best performance for
+large tables, but can flash on redraw and is not 100% Tk compatible on the
+border mode.
+.TP
+\fBsingle\fR
+The table is drawn to the screen as in fast mode, but only single pixel
+lines are drawn (not square borders).
+.RE
+.OP \-flashmode flashMode FlashMode
+A boolean value which specifies whether cells should flash when their value
+changes. The table tag \fBflash\fR will be applied to these cells for the
+duration specified by \fB\-flashtime\fR. Defaults to 0.
+.OP \-flashtime flashTime FlashTime
+The amount of time, in 1/4 second increments, for which a cell should flash
+when it is edited. \fB\-flashmode\fR must be on. Defaults to 2.
+.OP \-height height Height
+Specifies the desired height for the window, in rows.
+If zero or less, then the desired height for the window is made just
+large enough to hold all the rows in the table. The height can be
+further limited by \fB\-maxheight\fR.
+.OP \-invertselected invertSelected InvertSelected
+Specifies whether the foreground and background of an item should simply
+have their values swapped instead of merging the \fIsel\fR tag options
+when the cell is selected. Defaults to 0 (merge).
+.OP \-maxheight maxHeight MaxHeight
+The max height in pixels that the window will request. Defaults to 600.
+.OP \-maxwidth maxWidth MaxWidth
+The max width in pixels that the window will request. Defaults to 800.
+.OP \-resizeborders resizeBorders ResizeBorders
+Specifies what kind of interactive border resizing to allow, must be one of
+row, col, both (default) or none.
+.OP \-rowheight rowHeight RowHeight
+Default row height, interpreted as lines in the default font when
+the number is positive, or pixels if it is negative. Defaults to 1.
+.OP \-roworigin rowOrigin Origin
+Specifies what row index to interpret as the topmost row in the table.
+This value is used for user indices in the table. Defaults to 0.
+.OP \-rows rows Rows
+Number of rows in the table. Defaults to 10.
+.OP \-rowseparator rowSeparator Separator
+Specifies a separator character that will be interpreted as the row
+separator when cutting or pasting data in a table. By default, rows
+are separated as tcl lists.
+.OP \-rowstretchmode rowStretchMode StretchMode
+Specifies the stretch modes for rows to fill extra
+allocated window space. See \fB\-colstretchmode\fR for valid options.
+.OP \-rowtagcommand rowTagCommand TagCommand
+Provides the name of a procedure that can evaluated by the widget to
+determine the tag to be used for a given row. The procedure must be
+defined by the user to accept a single argument (the row number), and
+return a tag name or null string. This operates in a similar manner as
+\fB\-coltagcommand\fR, except that it applies to row tags.
+.OP "\-selectioncommand or \-selcmd" selectionCommand SelectionCommand
+Specifies a command to evaluate when the selection is retrieved from a table
+via the selection mechanism (ie: evaluating "selection get"). The return
+value from this command will become the string passed on by the selection
+mechanism. It uses the %\-substition model described in COMMAND SUBSTITUTION
+below.
+.OP \-selectmode selectMode SelectMode
+Specifies one of several styles for manipulating the selection. The value
+of the option may be arbitrary, but the default bindings expect it to be
+either \fBsingle\fR, \fBbrowse\fR, \fBmultiple\fR, or \fBextended\fR; the
+default value is \fBbrowse\fR. These styles are like those for the Tk
+listbox, except expanded for 2 dimensions.
+.OP \-selecttitle selectTitles SelectTitles
+Specifies whether title cells should be allowed in the selection.
+Defaults to 0 (disallowed).
+.OP \-selecttype selectType SelectType
+Specifies one of several types of selection for the table. The value of the
+option may be one of \fBrow\fR, \fBcol\fR, \fBcell\fR, or \fBboth\fR
+(meaning \fBrow && col\fR); the default value is \fBcell\fR. These types
+define whether an entire row/col is affected when a cell's selection is
+changed (set or clear).
+.OP \-state state State
+Specifies one of two states for the entry: \fBnormal\fR or \fBdisabled\fR.
+If the table is disabled then the value may not be changed using widget
+commands and no insertion cursor will be displayed, even if the input focus
+is in the widget. Defaults to \fBnormal\fR.
+.OP \-titlecols titleCols TitleCols
+Number of columns to use as a title area. Defaults to 0.
+.OP \-titlerows titleRows TitleRows
+Number of rows to use as a title area. Defaults to 0.
+.OP \-usecommand useCommand UseCommand
+A boolean value which specifies whether to use the \fBcommand\fR option.
+This value sets itself to zero if \fBcommand\fR is used and returns an error.
+Defaults to 1 (will use \fBcommand\fR if specified).
+.OP \-validate validate Validate
+A boolean specifying whether validation should occur for the active buffer.
+Defaults to 0.
+.OP "\-validatecommand or \-vcmd" validateCommand ValidateCommand
+Specifies a command to execute when the active cell is edited. This command
+is expected to return a Tcl boolean. If it returns true, then it is assumed
+the new value is OK, otherwise the new value is rejected (the edition will
+not take place). Errors in this command are handled in the background. It
+uses the %\-substition model described in COMMAND SUBSTITUTION below.
+.OP \-variable variable Variable
+Global Tcl array variable to attach to the table's C array. It will be
+created if it doesn't already exist or is a simple variable. Keys used by
+the table in the array are of the form \fIrow\fR,\fIcol\fR for cells and
+the special key \fIactive\fR which contains the value of the active cell
+buffer. The Tcl array is managed as a sparse array (the table doesn't
+require all valid indices have values). No stored value for an index is
+equivalent to the empty string, and clearing a cell will remove that index
+from the Tcl array.
+.OP \-width width Width
+Specifies the desired width for the window, in columns.
+If zero or less, then the desired width for the window is made just
+large enough to hold all the columns in the table. The width can be
+further limited by \fB\-maxwidth\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBtable\fR command creates a 2\-dimensional grid of cells. The table
+can use a Tcl array variable or Tcl command for data storage and retrieval.
+The widget has an active cell, the contents of which can be edited (when
+the state is normal). The widget supports a default style for the cells
+and also multiple \fItags\fR, which can be used to change the style of a
+row, column or cell (see TAGS for details). A cell \fIflash\fR can be set
+up so that changed cells will change color for a specified amount of time
+("blink"). Cells can have embedded images or windows, as described in
+TAGS and "EMBEDDED WINDOWS" respectively.
+.PP
+One or more cells may be selected as described below. If a table is
+exporting its selection (see \fB\-exportselection\fR option), then it will
+observe the standard X11 protocols for handling the selection. See THE
+SELECTION for details.
+.PP
+It is not necessary for all the cells to be displayed in the table window at
+once; commands described below may be used to change the view in the window.
+Tables allow scrolling in both directions using the standard
+\fB\-xscrollcommand\fR and \fB\-yscrollcommand\fR options. They also support
+scanning, as described below.
+.PP
+In order to obtain good performance, the table widget supports three drawing
+modes, two of which are fully Tk compatible.
+
+.SH "INDICES"
+.PP
+Many of the widget commands for tables take one or more indices as arguments.
+An index specifies a particular cell of the table, in any of
+the following ways:
+.TP 12
+\fInumber,number\fR
+Specifies the cell as a numerical index of row,col which corresponds to the
+index of the associated Tcl array, where \fB\-roworigin,\-colorigin\fR
+corresponds to the first cell in the table (0,0 by default).
+.TP 12
+\fBactive\fR
+Indicates the cell that has the location cursor.
+It is specified with the \fBactivate\fR widget command.
+.TP 12
+\fBanchor\fR
+Indicates the anchor point for the selection, which is set with the
+\fBselection anchor\fR widget command.
+.TP 12
+\fBbottomright\fR
+Indicates the bottom\-rightmost cell visible in the table.
+.TP 12
+\fBend\fR
+Indicates the bottom right cell of the table.
+.TP 12
+\fBorigin\fR
+Indicates the top\-leftmost editable cell of the table, not necessarily
+in the display. This takes into account the user specified origin and
+title area.
+.TP 12
+\fBtopleft\fR
+Indicates the top\-leftmost editable cell visible in the table (this
+excludes title cells).
+.TP 12
+\fB@\fIx\fB,\fIy\fR
+Indicates the cell that covers the point in the table window
+specified by \fIx\fR and \fIy\fR (in pixel coordinates). If no
+cell covers that point, then the closest cell to that
+point is used.
+.LP
+In the widget command descriptions below, arguments named \fIindex\fR,
+\fIfirst\fR, and \fIlast\fR always contain text indices in one of
+the above forms.
+
+.SH TAGS
+.PP
+A tag is a textual string that is associated with zero or more rows, columns
+or cells in a table. Tags may contain arbitrary characters, but it is
+probably best to avoid using names which look like indices. There may be
+any number of tags associated with rows, columns or cells in a table. There
+are several permanent tags in each table that can be configured by the user
+and will determine the attributes for special cells:
+.RS
+.TP 10
+\fBactive\fR
+This tag is given to the \fIactive\fR cell
+.TP 10
+\fBflash\fR
+If flash mode is on, this tag is given to any recently
+edited cells.
+.TP 10
+\fBsel\fR
+This tag is given to any selected cells.
+.TP 10
+\fBtitle\fR
+This tag is given to any cells in the title rows and columns. This
+tag has \fB\-state\fR \fIdisabled\fR by default.
+.RE
+.PP
+Tags control the way cells are displayed on the screen.
+By default, cells are displayed as determined by the
+\fBbackground\fR, \fBfont\fR, and \fBforeground\fR options for the
+table widget.
+However, display options may be associated with individual tags
+using the ``\fIpathName \fBtag configure\fR'' widget command.
+If a cell has been tagged, then the display options associated
+with the tag override the default display style.
+The following options are currently supported for tags:
+.RS
+.TP
+\fB\-anchor \fIanchor\fR
+Anchor for item in the cell space.
+.TP
+\fB\-background\fR or \fB\-bg\fR \fIcolor\fR
+Background color of the cell
+.TP
+\fB\-font \fIfontName\fR
+Font for text in the cell.
+.TP
+\fB\-foreground\fR or \fB\-fg\fR \fIcolor\fR
+Foreground color of the cell.
+.TP
+\fB\-justify \fIjustify\fR
+How to justify multi\-line text in a cell.
+It must be one of \fBleft\fR, \fBright\fR, or \fBcenter\fR.
+.TP
+\fB\-image \fIimageName\fR
+An image to display in the cell instead of text.
+.TP
+\fB\-relief \fIrelief\fR
+The relief for the cell.
+.TP
+\fB\-showtext \fIboolean\fR
+Whether to show the text over an image.
+.TP
+\fB\-state \fIstate\fR
+The state of the cell, to allow for certain cells to be disabled.
+This prevents the cell from being edited by the \fIinsert\fR or \fIdelete\fR
+methods, but a direct \fIset\fR will not be prevented.
+.TP
+\fB\-wrap \fIboolean\fR
+Whether characters should wrap in a cell that is not wide enough.
+.RE
+.PP
+A priority order is defined among tags, and this order is used in
+implementing some of the tag\-related functions described below. When a cell
+is displayed, its properties are determined by the tags which are assigned
+to it. Including the special tags, this order is \fBflash\fR, \fBactive\fR,
+\fBsel\fR, \fBtitle\fR, \fBcelltag\fR, \fBrowtag\fR, \fBcoltag\fR, default.
+.PP
+If a cell has several tags associated with it, and if their display options
+conflict, then the options of the highest priority tag are used. If a
+particular display option hasn't been specified for a particular tag, or if
+it is specified as an empty string, then that option will never be used; the
+next\-highest\-priority tag's option will used instead. If no tag specifies a
+particular display option, then the default style for the widget will be
+used.
+.PP
+Images are used for display purposes only. Editing in that cell will still
+be enabled and any querying of the cell will show the text value of the cell,
+regardless of the value of \fB\-showtext\fR.
+
+.SH "EMBEDDED WINDOWS"
+.PP
+There may be any number of embedded windows in a table widget (one per
+cell), and any widget may be used as an embedded window (subject to the
+usual rules for geometry management, which require the table window to be
+the parent of the embedded window or a descendant of its parent). The
+embedded window's position on the screen will be updated as the table is
+modified or scrolled, and it will be mapped and unmapped as it moves into
+and out of the visible area of the table widget. Each embedded window
+occupies one cell's worth of space in the table widget, and it is referred
+to by the index of the cell in the table. Windows associated with the
+table widget are destroyed when the table widget is destroyed.
+.PP
+Windows are used for display purposes only. A value still exists for that
+cell, but will not be shown unless the window is deleted in some way.
+.PP
+When an embedded window is added to a table widget with the window
+configure widget command, several configuration options may be associated
+with it. These options may be modified with later calls to the window
+configure widget command. The following options are currently supported:
+.RS
+.TP
+\fB\-create \fIscript\fR
+NOT CURRENTLY SUPPORTED. Specifies a Tcl script that may be evaluated to
+create the window for the annotation. If no \-window option has been
+specified for this cell then this script will be evaluated when the
+cell is about to be displayed on the screen. Script must create a
+window for the cell and return the name of that window as its result.
+If the cell's window should ever be deleted, the script will be evaluated
+again the next time the cell is displayed.
+.TP
+\fB\-background\fR or \fB\-bg\fR \fIcolor\fR
+Background color of the cell. If not
+specified, it uses the table's default background.
+.TP
+\fB\-padx \fIpixels\fR
+As defined in the Tk options man page.
+.TP
+\fB\-pady \fIpixels\fR
+As defined in the Tk options man page.
+.TP
+\fB\-relief \fIrelief\fR
+The relief to use for the cell in which the window lies. If not
+specified, it uses the table's default relief.
+.TP
+\fB\-sticky \fIsticky\fR
+Stickiness of the window inside the cell, as defined by the \fBgrid\fR command.
+.TP
+\fB\-window \fIpathName\fR
+Specifies the name of a window to display in the annotation. It must
+exist before being specified here.
+.RE
+
+
+.SH "THE SELECTION"
+.PP
+Table selections are available as type STRING. By default, the value of
+the selection will be the values of the selected cells in nested Tcl list
+form where each row is a list and each column is an element of a row list.
+You can change the way this value is interpreted by setting the
+\fB\-rowseparator\fR and \fB\-colseparator\fR options. For example,
+default Excel format would be to set \fB\-rowseparator\fR to "\\n" and
+\fB\-colseparator\fR to "\\t". Changes these values affects both how the
+table sends out the selection and reads in pasted data, ensuring that the
+table should always be able to cut and paste to itself. It is possible to
+change how pastes are handled by editing the table library procedure
+\fBtk_tablePasteHandler\fR. This might be necessary if
+\fB\-selectioncommand\fR is set.
+
+.SH "COMMAND SUBSTITUTION"
+.PP
+
+The various option based commands that the table supports all support the
+familiar Tk %\-substitution model (see \fBbind\fR for more details). The
+following %\-sequences are recognized and substituted by the table widget:
+.TP 5
+\fB%c\fR
+For \fBSelectionCommand\fR, it is the maximum number of columns in any
+row in the selection. Otherwise it is the column of the triggered cell.
+.TP 5
+\fB%C\fR
+A convenience substitution for \fI%r\fR,\fI%c\fR.
+.TP 5
+\fB%i\fR
+For \fBSelectionCommand\fR, it is the total number of cells in the selection.
+For \fBCommand\fR, it is 0 for a read (get) and 1 for a write (set).
+Otherwise it is the current cursor position in the cell.
+.TP 5
+\fB%r\fR
+For \fBSelectionCommand\fR, it is the number of rows in the selection.
+Otherwise it is the row of the triggered cell.
+.TP 5
+\fB%s\fR
+For \fBValidateCommand\fR, it is the current value of the cell being validated.
+For \fBSelectionCommand\fR, it is the default value of the selection.
+For \fBBrowseCommand\fR, it is the index of the last active cell.
+For \fBCommand\fR, it is empty for reads (get) and the current value of the
+cell for writes (set).
+.TP 5
+\fB%S\fR
+For \fBValidateCommand\fR, it is the potential new value of the cell
+being validated.
+For \fBBrowseCommand\fR, it is the index of the new active cell.
+.TP 5
+\fB%W\fR
+The pathname to the window for which the command was generated.
+.LP
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBtable\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This command may be used to invoke various
+operations on the widget. It has the following general form:
+.CS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.CE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command.
+.PP
+The following commands are possible for \fBtable\fR widgets:
+.TP
+\fIpathName \fBactivate\fR \fIindex\fR
+Sets the active cell to the one indicated by \fIindex\fR.
+.TP
+\fIpathName \fBbbox\fR \fIfirst\fR ?\fIlast\fR?
+It returns the bounding box for the specified cell (range) as a 4\-tuple of
+x, y, width and height in pixels. It clips the box to the visible portion,
+if any, otherwise an empty string is returned.
+.TP
+\fIpathName \fBborder\fR \fIoption args\fR
+This command is a voodoo hack to implement border sizing for tables. Its
+options may change in the future.
+.RS
+.TP
+\fIpathName \fBborder mark\fR \fIx y\fR ?\fIrow|col\fR?
+Records \fIx\fR and \fIy\fR and the row and/or column border under that
+point in the table window, if any; used in conjunction with later \fBborder
+dragto\fR commands. Typically this command is associated with a mouse
+button press in the widget. If \fIrow\fR or \fIcol\fR is not specified, it
+returns a tuple of both border indices (an empty item means no border).
+Otherwise, just the specified item is returned.
+.TP
+\fIpathName \fBborder dragto\fR \fIx y\fR.
+This command computes the difference between its \fIx\fR and \fIy\fR
+arguments and the \fIx\fR and \fIy\fR arguments to the last \fBborder
+mark\fR command for the widget. It then adjusts the previously marked
+border by the difference. This command is typically associated with mouse
+motion events in the widget, to produce the effect of interactive border
+resizing.
+.RE
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR. \fIOption\fR may have any of the values accepted
+by the \fBtable\fR command.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBtable\fR
+command.
+.TP
+\fIpathName \fBcurselection\fR ?\fIset value\fR?
+With no arguments, it returns the sorted indices of the currently selected
+cells. Otherwise it sets all the selected cells to the given value. The
+set has no effect if there is no associated Tcl array or the state is
+disabled.
+.TP
+\fIpathName \fBcurvalue\fR ?\fIvalue\fR?
+If no value is given, the value of the cell being edited (indexed by
+\fBactive\fR) is returned, else it is set to the given value.
+.TP
+\fIpathName \fBdelete\fR \fIoption arg\fR ?\fIarg\fR?
+This command is used to delete various things in a table. It has several
+forms, depending on the \fIoption\fR:
+.RS
+.TP
+\fIpathName \fBdelete active\fR \fIindex\fR ?\fIindex\fR?
+Deletes text from the active cell. If only one index is given, it deletes
+the character after that index, otherwise it deletes from the first index to
+the second. \fIindex\fR can be a number, \fBinsert\fR or \fBend\fR.
+.TP
+\fIpathName \fBdelete cols\fR ?\fIswitches\fR? \fIindex\fR ?\fIcount\fR?
+Deletes \fBcount\fR cols starting at (and including) col \fBindex\fR. If
+\fBcount\fR is negative, it deletes cols to the left. Otherwise it deletes
+cols to the right. The selection will be cleared. The optional switches
+are:
+.RS
+.TP
+\fB\-cols\fR
+Sets an artificial maximum column boundary to use when collapsing the rest
+of the columns. By default it uses the value of the \fB\-cols\fR widget
+option. This can cause interesting side\-effects when used in conjunction
+with the other options.
+.TP
+\fB\-holddimensions\fR
+Causes the table cols to be unaffected by the deletion (empty cols may
+appear). By default the dimensions are adjusted by \fBcount\fR.
+.TP
+\fB\-holdtags\fR
+Causes the tags specified by the \fItag\fR method to not collapse along
+with the data. Also prevents specific widths set by the \fIwidth\fR method
+from being adjusted. By default, these tags are properly adjusted.
+.TP
+\fB\-keeptitles\fR
+Prevents title area cell contents from being moved. Otherwise they are
+treated just like regular cells and will move as specified.
+.TP
+\fB\-rows\fR
+Sets an artificial maximum row boundary to use when collapsing the rest of
+the rows. By default it uses the value of the \fB\-rows\fR widget option.
+This can cause interesting side\-effects when used in conjunction with the
+other options.
+.TP
+\fB\-\-\fR
+Signifies the end of the switches.
+.RE
+.TP
+\fIpathName \fBdelete rows\fR ?\fIswitches\fR? \fIindex\fR ?\fIcount\fR?
+Deletes \fBcount\fR rows starting at (and including) row \fBindex\fR. If
+\fBcount\fR is negative, it deletes rows going up. Otherwise it deletes
+rows going down. The selection will be cleared. The switches are the same
+as those for column deletion.
+.RE
+.TP
+\fIpathName \fBflush\fR ?\fIfirst\fR? ?\fIlast\fR?
+Forces the table cache to be flushed from \fIfirst\fR to \fIlast\fR. If
+neither are specified, it flushes the entire cache.
+.TP
+\fIpathName \fBget\fR \fIfirst\fR ?\fIlast\fR?
+Returns the value of the cells specified by the table indices \fIfirst\fR
+and (optionally) \fIlast\fR in a list.
+.TP
+\fIpathName \fBheight\fR ?\fIrow\fR? ?\fIvalue row value ...\fR?
+If no \fIrow\fR is specified, returns a list describing all rows for which
+a height has been set. If \fBrow\fR is specified with no value, it prints
+out the height of that row in characters (positive number) or pixels
+(negative number). If one or more \fIrow\-value\fR pairs are specified,
+then it sets each row to be that height in lines (positive number) or
+pixels (negative number). If \fIvalue\fR is \fIdefault\fR, then the row
+uses the default height, specified by \fB\-rowheight\fR.
+.TP
+\fIpathName \fBicursor\fR ?\fIarg\fR?
+With no arguments, prints out the location of the insertion cursor in the
+active cell. With one argument, sets the cursor to that point in the
+string. 0 is before the first character, you can also use \fBinsert\fR or
+\fBend\fR for the current insertion point or the end of the text.
+.TP
+\fIpathName \fBindex\fR \fIindex\fR ?\fIrow|col\fR?
+Returns the integer cell coordinate that corresponds to \fIindex\fR in the
+form row,col. If \fBrow\fR or \fBcol\fR is specified, then only the row or
+column index is returned.
+.TP
+\fIpathName \fBinsert\fR \fIoption arg arg\fR
+This command is used to into various things into a table. It has several
+forms, depending on the \fIoption\fR:
+.RS
+.TP
+\fIpathName \fBinsert active\fR \fIindex value\fR
+The \fIvalue\fR is a text string which is inserted at the \fIindex\fR
+postion of the active cell. The cursor is then positioned after the
+new text. \fIindex\fR can be a number, \fBinsert\fR or \fBend\fR.
+.TP
+\fIpathName \fBinsert cols\fR ?\fIswitches\fR? \fIindex\fR ?\fIcount\fR?
+Inserts \fBcount\fR cols starting at col \fBindex\fR. If \fBcount\fR is
+negative, it inserts before the specified col. Otherwise it inserts after
+the specified col. The selection will be cleared. The switches are the
+same as those for column deletion.
+.TP
+\fIpathName \fBinsert rows\fR ?\fIswitches\fR? \fIindex\fR ?\fIcount\fR?
+Inserts \fBcount\fR rows starting at row \fBindex\fR. If \fBcount\fR is
+negative, it inserts before the specified row. Otherwise it inserts after
+the specified row. The selection will be cleared. The switches are the
+same as those for column deletion.
+.RE
+.TP
+\fIpathName \fBreread\fR
+Rereads the old contents of the cell back into the editing buffer. Useful
+for a key binding when <Escape> is pressed to abort the edit (a default
+binding).
+.TP
+\fIpathName \fBscan\fR \fIoption args\fR
+This command is used to implement scanning on tables. It has
+two forms, depending on \fIoption\fR:
+.RS
+.TP
+\fIpathName \fBscan mark\fR \fIx y\fR
+Records \fIx\fR and \fIy\fR and the current view in the table
+window; used in conjunction with later \fBscan dragto\fR commands.
+Typically this command is associated with a mouse button press in
+the widget. It returns an empty string.
+.TP
+\fIpathName \fBscan dragto\fR \fIx y\fR.
+This command computes the difference between its \fIx\fR and \fIy\fR
+arguments and the \fIx\fR and \fIy\fR arguments to the last \fBscan mark\fR
+command for the widget. It then adjusts the view by 5 times the difference
+in coordinates. This command is typically associated with mouse motion
+events in the widget, to produce the effect of dragging the list at high
+speed through the window. The return value is an empty string.
+.RE
+.TP
+\fIpathName \fBsee\fR \fIindex\fR
+Adjust the view in the table so that the cell given by \fIindex\fR is
+positioned as the cell one off from top left (excluding title rows and
+columns) if the cell is not currently visible on the screen. The actual
+cell may be different to keep the screen full.
+.TP
+\fIpathName \fBselection\fR \fIoption arg\fR
+This command is used to adjust the selection within a table. It
+has several forms, depending on \fIoption\fR:
+.RS
+.TP
+\fIpathName \fBselection anchor\fR \fIindex\fR
+Sets the selection anchor to the cell given by \fIindex\fR. The selection
+anchor is the end of the selection that is fixed while dragging out a
+selection with the mouse. The index \fBanchor\fR may be used to refer to
+the anchor cell.
+.TP
+\fIpathName \fBselection clear\fR \fIfirst \fR?\fIlast\fR?
+If any of the cells between \fIfirst\fR and \fIlast\fR (inclusive) are
+selected, they are deselected. The selection state is not changed for cells
+outside this range. \fIfirst\fR may be specified as \fBall\fR to remove
+the selection from all cells.
+.TP
+\fIpathName \fBselection includes\fR \fIindex\fR
+Returns 1 if the cell indicated by \fIindex\fR is currently
+selected, 0 if it isn't.
+.TP
+\fIpathName \fBselection set\fR \fIfirst\fR ?\fIlast\fR?
+Selects all of the cells in the range between \fIfirst\fR and \fIlast\fR,
+inclusive, without affecting the selection state of cells outside that
+range.
+.RE
+.TP
+\fIpathName \fBset\fR \fIindex\fR ?\fIvalue\fR? ?\fIindex value ...\fR?
+Sets the specified index to the associated value. Table validation will not
+be triggered via this method.
+.TP
+\fIpathName \fBtag\fR option ?\fIarg arg ...\fR?
+This command is used to manipulate tags. The exact behavior of the command
+depends on the \fIoption\fR argument that follows the \fBtag\fR argument.
+Only \fIcget\fR complains about unknown tag names.
+The following forms of the command are currently supported:
+.RS
+.TP
+\fIpathName \fBtag cell\fR \fItagName ?index ... ?\fR
+With no arguments, prints out the list of cells that use the \fItag\fR.
+Otherwise it sets the specified cells to use the \fItag\fR. If \fItag\fR is
+{}, the cells are reset to the default \fItag\fR. Tags added during
+\-*tagcommand evaluation do not register here.
+.TP
+\fIpathName \fBtag cget\fR \fItagName option\fR
+This command returns the current value of the option named \fIoption\fR
+associated with the tag given by \fItagName\fR. \fIOption\fR may have any
+of the values accepted by the \fBtag configure\fR widget command.
+.TP
+\fIpathName \fBtag col\fR \fItagName ?col ... ?\fR
+With no arguments, prints out the list of cols that use the \fItag\fR.
+Otherwise it sets the specified cols to use the \fItag\fR. If \fItag\fR is
+{}, the cols are reset to the default \fItag\fR. Tags added during
+\-coltagcommand evaluation do not register here.
+.TP
+\fIpathName \fBtag configure \fItagName\fR ?\fIoption\fR? ?\fIvalue\fR? ?\fIoption value ...\fR?
+This command is similar to the \fBconfigure\fR widget command except that
+it modifies options associated with the tag given by \fItagName\fR instead
+of modifying options for the overall table widget. If no \fIoption\fR is
+specified, the command returns a list describing all of the available
+options for \fItagName\fR (see \fBTk_ConfigureInfo\fR for information on
+the format of this list). If \fIoption\fR is specified with no
+\fIvalue\fR, then the command returns a list describing the one named
+option (this list will be identical to the corresponding sublist of the
+value returned if no \fIoption\fR is specified). If one or more
+\fIoption\-value\fR pairs are specified, then the command modifies the
+given option(s) to have the given value(s) in \fItagName\fR; in this case
+the command returns an empty string.
+See TAGS above for details on the options available for tags.
+.TP
+\fIpathName \fBtag delete\fR \fItagName\fR
+Deletes a tag. No error if the tag does not exist.
+.TP
+\fIpathName \fBtag exists\fR \fItagName\fR
+Returns 1 if the named tag exists, 0 otherwise.
+.TP
+\fIpathName \fBtag includes\fR \fItagName index\fR
+Returns 1 if the specified index has the named tag, 0 otherwise.
+.TP
+\fIpathName \fBtag names\fR ?\fIpattern\fR?
+If no pattern is specified, shows the names of all defined tags.
+Otherwise the \fIpattern\fR is used as a glob pattern to show only
+tags matching that pattern.
+.TP
+\fIpathName \fBtag row\fR \fItagName ?row ...?\fR
+With no arguments, prints out the list of rows that use the \fItag\fR.
+Otherwise it sets the specified rows to use the tag. If tag is {}, the rows
+are reset to use the default tag. Tags added during \-rowtagcommand
+evaluation do not register here.
+.RE
+.TP
+\fIpathName \fBvalidate\fR \fIindex\fR
+Explicitly validates the specified index based on the current
+\fB\-validatecommand\fR and returns 0 or 1 based on whether the cell was
+validated.
+.TP
+\fIpathName \fBwidth\fR ?\fIcol\fR? ?\fIvalue col value ...\fR?
+If no \fIcol\fR is specified, returns a list describing all cols for which
+a width has been set. If \fBcol\fR is specified with no value, it prints
+out the width of that col in characters (positive number) or pixels
+(negative number). If one or more \fIcol\-value\fR pairs are specified,
+then it sets each col to be that width in characters (positive number) or
+pixels (negative number). If \fIvalue\fR is \fIdefault\fR, then the col
+uses the default width, specified by \fB\-colwidth\fR.
+.TP
+\fIpathName \fBwindow\fR option ?\fIarg arg ...\fR?
+This command is used to manipulate embedded windows. The exact behavior of
+the command depends on the \fIoption\fR argument that follows the
+\fBwindow\fR argument. The following forms of the command are currently
+supported:
+.RS
+.TP
+\fIpathName \fBwindow cget\fR \fIindex option\fR
+This command returns the current value of the option named \fIoption\fR
+associated with the window given by \fIindex\fR. \fIOption\fR may have any
+of the values accepted by the \fBwindow configure\fR widget command.
+.TP
+\fIpathName \fBwindow configure \fIindex\fR ?\fIoption\fR? ?\fIvalue\fR? ?\fIoption value ...\fR?
+This command is similar to the \fBconfigure\fR widget command except that
+it modifies options associated with the embedded window given by
+\fIindex\fR instead of modifying options for the overall table widget. If
+no \fIoption\fR is specified, the command returns a list describing all of
+the available options for \fIindex\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified with
+no \fIvalue\fR, then the command returns a list describing the one named
+option (this list will be identical to the corresponding sublist of the
+value returned if no \fIoption\fR is specified). If one or more
+\fIoption\-value\fR pairs are specified, then the command modifies the
+given option(s) to have the given value(s) in \fIindex\fR; in this case
+the command returns an empty string.
+See EMBEDDED WINDOWS above for details on the options available for windows.
+.TP
+\fIpathName \fBwindow delete\fR \fIindex\fR ?\fIindex ...\fR?
+Deletes an embedded window from the table. The associated window will
+also be deleted.
+.TP
+\fIpathName \fBwindow move\fR \fIindexFrom indexTo\fR
+Moves an embedded window from one cell to another. If a window already
+exists in the target cell, it will be deleted.
+.TP
+\fIpathName \fBwindow names\fR ?\fIpattern\fR?
+If no pattern is specified, shows the cells of all embedded windows.
+Otherwise the \fIpattern\fR is used as a glob pattern to show only
+cells matching that pattern.
+.RE
+.TP
+\fIpathName \fBxview \fIargs\fR
+This command is used to query and change the horizontal position of the
+information in the widget's window. It can take any of the following
+forms:
+.RS
+.TP
+\fIpathName \fBxview\fR
+Returns a list containing two elements.
+Each element is a real fraction between 0 and 1; together they describe
+the horizontal span that is visible in the window.
+For example, if the first element is .2 and the second element is .6,
+20% of the table's text is off\-screen to the left, the middle 40% is visible
+in the window, and 40% of the text is off\-screen to the right.
+These are the same values passed to scrollbars via the \fB\-xscrollcommand\fR
+option.
+.TP
+\fIpathName \fBxview\fR \fIindex\fR
+Adjusts the view in the window so that the column given by
+\fIindex\fR is displayed at the left edge of the window.
+.TP
+\fIpathName \fBxview moveto\fI fraction\fR
+Adjusts the view in the window so that \fIfraction\fR of the
+total width of the table text is off\-screen to the left.
+\fIfraction\fR must be a fraction between 0 and 1.
+.TP
+\fIpathName \fBxview scroll \fInumber what\fR
+This command shifts the view in the window left or right according to
+\fInumber\fR and \fIwhat\fR.
+\fINumber\fR must be an integer.
+\fIWhat\fR must be either \fBunits\fR or \fBpages\fR or an abbreviation
+of one of these.
+If \fIwhat\fR is \fBunits\fR, the view adjusts left or right by
+\fInumber\fR character units (the width of the \fB0\fR character)
+on the display; if it is \fBpages\fR then the view adjusts by
+\fInumber\fR screenfuls.
+If \fInumber\fR is negative then characters farther to the left
+become visible; if it is positive then characters farther to the right
+become visible.
+.RE
+.TP
+\fIpathName \fByview \fI?args\fR?
+This command is used to query and change the vertical position of the
+text in the widget's window. It can take any of the following forms:
+.RS
+.TP
+\fIpathName \fByview\fR
+Returns a list containing two elements, both of which are real fractions
+between 0 and 1. The first element gives the position of the table element
+at the top of the window, relative to the table as a whole (0.5 means it is
+halfway through the table, for example). The second element gives the
+position of the table element just after the last one in the window,
+relative to the table as a whole. These are the same values passed to
+scrollbars via the \fB\-yscrollcommand\fR option.
+.TP
+\fIpathName \fByview\fR \fIindex\fR
+Adjusts the view in the window so that the row given by
+\fIindex\fR is displayed at the top of the window.
+.TP
+\fIpathName \fByview moveto\fI fraction\fR
+Adjusts the view in the window so that the element given by \fIfraction\fR
+appears at the top of the window.
+\fIFraction\fR is a fraction between 0 and 1; 0 indicates the first
+element in the table, 0.33 indicates the element one\-third the
+way through the table, and so on.
+.TP
+\fIpathName \fByview scroll \fInumber what\fR
+This command adjusts the view in the window up or down according to
+\fInumber\fR and \fIwhat\fR. \fINumber\fR must be an integer. \fIWhat\fR
+must be either \fBunits\fR or \fBpages\fR. If \fIwhat\fR is \fBunits\fR,
+the view adjusts up or down by \fInumber\fR lines; if it is \fBpages\fR then
+the view adjusts by \fInumber\fR screenfuls. If \fInumber\fR is negative
+then earlier elements become visible; if it is positive then later elements
+become visible.
+.RE
+
+.SH "DEFAULT BINDINGS"
+.PP
+The initialization creates class bindings that give the
+following default behaviour:
+.IP [1]
+Clicking Button\-1 in a cell activates that cell. Clicking
+into an already active cell moves the insertion cursor to the
+character nearest the mouse.
+.IP [2]
+Moving the mouse while Button\-1 is pressed will stroke out a selection area.
+Exiting while Button\-1 is pressed causing scanning to occur on the table
+along with selection.
+.IP [3]
+Moving the mouse while Button\-2 is pressed causes scanning to
+occur without any selection.
+.IP [4]
+Home moves the table to have the origin in view.
+.IP [5]
+End moves the table to have the \fBend\fR cell in view.
+.IP [6]
+Control\-Home moves the table to the origin and activates that cell.
+.IP [7]
+Control\-End moves the table to the end and activates that cell.
+.IP [8]
+Shift\-Control\-Home extends the selection to the origin.
+.IP [9]
+Shift\-Control\-End extends the selection to the end.
+.IP [10]
+The left, right, up and down arrows move the active cell.
+.IP [11]
+Shift\-<arrow> extends the selection in that direction.
+.IP [12]
+Control\-leftarrow and Control\-rightarrow move the insertion
+cursor within the cell.
+.IP [13]
+Control\-slash selects all the cells.
+.IP [14]
+Control\-backslash clears selection from all the cells.
+.IP [15]
+Backspace deletes the character before the insertion cursor
+in the active cell.
+.IP [16]
+Delete deletes the character after the insertion cursor
+in the active cell.
+.IP [17]
+Escape rereads the value of the active cell from the specified data source,
+discarding any edits that have may been performed on the cell.
+.IP [18]
+Control\-a moves the insertion cursor to the beginning of the active cell.
+.IP [19]
+Control\-e moves the insertion cursor to the end of the active cell.
+.IP [20]
+Control\-minus and Control\-equals decrease and increase the
+width of the column with the active cell in it.
+.IP [21]
+Moving the mouse while Button\-3 (the right button on Windows) is pressed
+while you are over a border will cause interactive resizing of that row
+and/or column to occur, based on the value of \fB\-resizeborders\fR.
+.PP
+Some bindings may have slightly different behavior dependent on the
+\fB\-selectionmode\fR of the widget.
+.PP
+If the widget is disabled using the \fB\-state\fR option, then its
+view can still be adjusted and cells can still be selected,
+but no insertion cursor will be displayed and no cell modifications will
+take place.
+.PP
+The behavior of tables can be changed by defining new bindings for
+individual widgets or by redefining the class bindings. The default
+bindings are either compiled in or read from a file expected to
+correspond to: "[lindex $tcl_pkgPath 0]/Tktable/tkTable.tcl".
+
+.SH KEYWORDS
+table, widget, extension
diff --git a/libgui/doc/tkTable_license.terms b/libgui/doc/tkTable_license.terms
new file mode 100644
index 00000000000..a2f54083d9c
--- /dev/null
+++ b/libgui/doc/tkTable_license.terms
@@ -0,0 +1,41 @@
+ * COPYRIGHT AND LICENSE TERMS *
+
+(This file blatantly stolen from Tcl/Tk license and adapted - thus assume
+it falls under similar license terms).
+
+This software is copyrighted by Jeffrey Hobbs <jeff.hobbs@acm.org>. The
+following terms apply to all files associated with the software unless
+explicitly disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute, and
+license this software and its documentation for any purpose, provided that
+existing copyright notices are retained in all copies and that this notice
+is included verbatim in any distributions. No written agreement, license,
+or royalty fee is required for any of the authorized uses.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR
+DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
+OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF,
+EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS
+PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO
+OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+RESTRICTED RIGHTS: Use, duplication or disclosure by the U.S. government
+is subject to the restrictions as set forth in subparagraph (c) (1) (ii)
+of the Rights in Technical Data and Computer Software Clause as DFARS
+252.227-7013 and FAR 52.227-19.
+
+SPECIAL NOTES:
+
+This software also falls under the bourbon_ware clause:
+
+ Should you find this software useful in your daily work, you should
+ feel obliged to take the author out for a drink if the opportunity
+ presents itself. The user may feel exempt from this clause if they
+ are under 21 or think the author has already partaken of too many
+ drinks.
diff --git a/libgui/library/Makefile.am b/libgui/library/Makefile.am
new file mode 100644
index 00000000000..843a35d0713
--- /dev/null
+++ b/libgui/library/Makefile.am
@@ -0,0 +1,47 @@
+## Process this file with automake to produce Makefile.in.
+
+AUTOMAKE_OPTIONS = cygnus
+
+## Convenience variables.
+TCL = advice.tcl balloon.tcl bbox.tcl bgerror.tcl bindings.tcl \
+canvas.tcl cframe.tcl center.tcl debug.tcl def.tcl internet.tcl \
+font.tcl gensym.tcl gettext.tcl hooks.tcl lframe.tcl list.tcl \
+looknfeel.tcl menu.tcl mono.tcl multibox.tcl parse_args.tcl path.tcl \
+postghost.tcl prefs.tcl print.tcl sendpr.tcl topbind.tcl toolbar.tcl \
+treetable.tcl ulset.tcl wframe.tcl wingrab.tcl ventry.tcl combobox.tcl \
+pane.tcl panedwindow.tcl tree.tcl
+
+PACKAGES = combobox.tcl
+
+## This directory is also referenced in paths.c, which see.
+guidir = $(datadir)/cygnus/gui
+gui_DATA = tclIndex pkgIndex.tcl $(TCL) $(PACKAGES)
+
+if TCL_SHARED
+SET_LIB_PATH = $(RPATH_ENVVAR)=$$here/../../tcl/unix:$$here/../../itcl/itcl/unix:$$$(RPATH_ENVVAR); export $(RPATH_ENVVAR);
+else
+SET_LIB_PATH =
+endif
+
+WISH = wish
+
+if CROSS_COMPILING
+ITCL_SH = itclsh
+else
+ITCL_SH = $$here/../../itcl/itcl/unix/itclsh$(EXEEXT)
+endif
+
+tclIndex: $(TCL)
+ TCL_LIBRARY=$(srcdir)/../../tcl/library; export TCL_LIBRARY; \
+ here=`pwd`; \
+ $(SET_LIB_PATH) \
+ cd $(srcdir) && \
+ echo "auto_mkindex $(LIBGUI_LIBRARY_DIR) $(TCL)" | @ITCL_SH@
+
+pkgIndex.tcl: @MAINT@ $(PACKAGES)
+ here=`pwd`; \
+ $(SET_LIB_PATH) \
+ cd $(srcdir) && \
+ echo "pkg_mkIndex . $(PACKAGES); exit" | $(WISH)
+
+ETAGS_ARGS = --lang=none --regex='/[ \t]*\(proc\|method\|itcl_class\)[ \t]+\([^ \t]+\)/\1/' $(TCL) --lang=auto
diff --git a/libgui/library/Makefile.in b/libgui/library/Makefile.in
new file mode 100644
index 00000000000..01461dc4f73
--- /dev/null
+++ b/libgui/library/Makefile.in
@@ -0,0 +1,335 @@
+# Makefile.in generated automatically by automake 1.4 from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 Free Software Foundation, Inc.
+# This Makefile.in is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+# PARTICULAR PURPOSE.
+
+
+SHELL = @SHELL@
+
+srcdir = @srcdir@
+top_srcdir = @top_srcdir@
+VPATH = @srcdir@
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+
+bindir = @bindir@
+sbindir = @sbindir@
+libexecdir = @libexecdir@
+datadir = @datadir@
+sysconfdir = @sysconfdir@
+sharedstatedir = @sharedstatedir@
+localstatedir = @localstatedir@
+libdir = @libdir@
+infodir = @infodir@
+mandir = @mandir@
+includedir = @includedir@
+oldincludedir = /usr/include
+
+DESTDIR =
+
+pkgdatadir = $(datadir)/@PACKAGE@
+pkglibdir = $(libdir)/@PACKAGE@
+pkgincludedir = $(includedir)/@PACKAGE@
+
+top_builddir = ..
+
+ACLOCAL = @ACLOCAL@
+AUTOCONF = @AUTOCONF@
+AUTOMAKE = @AUTOMAKE@
+AUTOHEADER = @AUTOHEADER@
+
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@ $(AM_INSTALL_PROGRAM_FLAGS)
+INSTALL_DATA = @INSTALL_DATA@
+INSTALL_SCRIPT = @INSTALL_SCRIPT@
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+host_alias = @host_alias@
+host_triplet = @host@
+BFDHDIR = @BFDHDIR@
+BFDLIB = @BFDLIB@
+CC = @CC@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEJAGNUHDIR = @DEJAGNUHDIR@
+DEJAGNULIB = @DEJAGNULIB@
+DEVOHDIR = @DEVOHDIR@
+ENDIAN = @ENDIAN@
+EXEEXT = @EXEEXT@
+GUILIB = @GUILIB@
+HAVE_DEVO_SIM = @HAVE_DEVO_SIM@
+IDEHDIR = @IDEHDIR@
+IDELIB = @IDELIB@
+IDETCLLIB = @IDETCLLIB@
+ILUHDIR = @ILUHDIR@
+ILULIB = @ILULIB@
+ILUTOP = @ILUTOP@
+INTLHDIR = @INTLHDIR@
+INTLLIB = @INTLLIB@
+ITCLHDIR = @ITCLHDIR@
+ITCLLIB = @ITCLLIB@
+ITCLMKIDX = @ITCLMKIDX@
+ITCLSH = @ITCLSH@
+ITCL_BUILD_LIB_SPEC = @ITCL_BUILD_LIB_SPEC@
+ITCL_DIR = @ITCL_DIR@
+ITCL_LIB_FILE = @ITCL_LIB_FILE@
+ITCL_LIB_FULL_PATH = @ITCL_LIB_FULL_PATH@
+ITK_BUILD_LIB_SPEC = @ITK_BUILD_LIB_SPEC@
+ITK_LIB_FILE = @ITK_LIB_FILE@
+ITK_LIB_FULL_PATH = @ITK_LIB_FULL_PATH@
+LIBERTY = @LIBERTY@
+LIBGCC = @LIBGCC@
+LIBGUIHDIR = @LIBGUIHDIR@
+LIBGUILIB = @LIBGUILIB@
+LIBGUI_CFLAGS = @LIBGUI_CFLAGS@
+LIBGUI_LIBRARY_DIR = @LIBGUI_LIBRARY_DIR@
+LIBIBERTY = @LIBIBERTY@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJEXT = @OBJEXT@
+OPCODESLIB = @OPCODESLIB@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+RPATH_ENVVAR = @RPATH_ENVVAR@
+RUNTESTDIR = @RUNTESTDIR@
+SIMHDIR = @SIMHDIR@
+SIMLIB = @SIMLIB@
+TCLCONFIG = @TCLCONFIG@
+TCLHDIR = @TCLHDIR@
+TCL_BUILD_LIB_SPEC = @TCL_BUILD_LIB_SPEC@
+TCL_CFLAGS = @TCL_CFLAGS@
+TCL_DEFS = @TCL_DEFS@
+TCL_LD_FLAGS = @TCL_LD_FLAGS@
+TCL_LD_SEARCH_FLAGS = @TCL_LD_SEARCH_FLAGS@
+TCL_LIBRARY = @TCL_LIBRARY@
+TCL_LIBS = @TCL_LIBS@
+TCL_LIB_FILE = @TCL_LIB_FILE@
+TCL_LIB_FULL_PATH = @TCL_LIB_FULL_PATH@
+TCL_LIB_SPEC = @TCL_LIB_SPEC@
+TCL_RANLIB = @TCL_RANLIB@
+TCL_SHLIB_CFLAGS = @TCL_SHLIB_CFLAGS@
+TCL_SHLIB_LD = @TCL_SHLIB_LD@
+TIXHDIR = @TIXHDIR@
+TIX_BUILD_LIB_SPEC = @TIX_BUILD_LIB_SPEC@
+TIX_LIB_FULL_PATH = @TIX_LIB_FULL_PATH@
+TKCONFIG = @TKCONFIG@
+TKHDIR = @TKHDIR@
+TK_BUILD_INCLUDES = @TK_BUILD_INCLUDES@
+TK_BUILD_LIB_SPEC = @TK_BUILD_LIB_SPEC@
+TK_DEFS = @TK_DEFS@
+TK_LIBS = @TK_LIBS@
+TK_LIB_FILE = @TK_LIB_FILE@
+TK_LIB_FULL_PATH = @TK_LIB_FULL_PATH@
+TK_LIB_SPEC = @TK_LIB_SPEC@
+TK_VERSION = @TK_VERSION@
+TK_XINCLUDES = @TK_XINCLUDES@
+TK_XLIBSW = @TK_XLIBSW@
+VERSION = @VERSION@
+ac_cv_c_itclsh = @ac_cv_c_itclsh@
+
+AUTOMAKE_OPTIONS = cygnus
+
+TCL = advice.tcl balloon.tcl bbox.tcl bgerror.tcl bindings.tcl \
+canvas.tcl cframe.tcl center.tcl debug.tcl def.tcl internet.tcl \
+font.tcl gensym.tcl gettext.tcl hooks.tcl lframe.tcl list.tcl \
+looknfeel.tcl menu.tcl mono.tcl multibox.tcl parse_args.tcl path.tcl \
+postghost.tcl prefs.tcl print.tcl sendpr.tcl topbind.tcl toolbar.tcl \
+treetable.tcl ulset.tcl wframe.tcl wingrab.tcl ventry.tcl combobox.tcl \
+pane.tcl panedwindow.tcl tree.tcl
+
+
+PACKAGES = combobox.tcl
+
+guidir = $(datadir)/cygnus/gui
+gui_DATA = tclIndex pkgIndex.tcl $(TCL) $(PACKAGES)
+@TCL_SHARED_TRUE@SET_LIB_PATH = \
+@TCL_SHARED_TRUE@$(RPATH_ENVVAR)=$$here/../../tcl/unix:$$here/../../itcl/itcl/unix:$$$(RPATH_ENVVAR); export $(RPATH_ENVVAR);
+@TCL_SHARED_FALSE@SET_LIB_PATH = \
+
+WISH = wish
+@CROSS_COMPILING_TRUE@ITCL_SH = \
+@CROSS_COMPILING_TRUE@itclsh
+@CROSS_COMPILING_FALSE@ITCL_SH = \
+@CROSS_COMPILING_FALSE@$$here/../../itcl/itcl/unix/itclsh$(EXEEXT)
+
+ETAGS_ARGS = --lang=none --regex='/[ \t]*\(proc\|method\|itcl_class\)[ \t]+\([^ \t]+\)/\1/' $(TCL) --lang=auto
+mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs
+CONFIG_HEADER = ../config.h
+CONFIG_CLEAN_FILES =
+DATA = $(gui_DATA)
+
+DIST_COMMON = Makefile.am Makefile.in
+
+
+DISTFILES = $(DIST_COMMON) $(SOURCES) $(HEADERS) $(TEXINFOS) $(EXTRA_DIST)
+
+TAR = tar
+GZIP_ENV = --best
+all: all-redirect
+.SUFFIXES:
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4)
+ cd $(top_srcdir) && $(AUTOMAKE) --cygnus library/Makefile
+
+Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
+ cd $(top_builddir) \
+ && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+
+install-guiDATA: $(gui_DATA)
+ @$(NORMAL_INSTALL)
+ $(mkinstalldirs) $(DESTDIR)$(guidir)
+ @list='$(gui_DATA)'; for p in $$list; do \
+ if test -f $(srcdir)/$$p; then \
+ echo " $(INSTALL_DATA) $(srcdir)/$$p $(DESTDIR)$(guidir)/$$p"; \
+ $(INSTALL_DATA) $(srcdir)/$$p $(DESTDIR)$(guidir)/$$p; \
+ else if test -f $$p; then \
+ echo " $(INSTALL_DATA) $$p $(DESTDIR)$(guidir)/$$p"; \
+ $(INSTALL_DATA) $$p $(DESTDIR)$(guidir)/$$p; \
+ fi; fi; \
+ done
+
+uninstall-guiDATA:
+ @$(NORMAL_UNINSTALL)
+ list='$(gui_DATA)'; for p in $$list; do \
+ rm -f $(DESTDIR)$(guidir)/$$p; \
+ done
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP)
+ list='$(SOURCES) $(HEADERS)'; \
+ unique=`for i in $$list; do echo $$i; done | \
+ awk ' { files[$$0] = 1; } \
+ END { for (i in files) print i; }'`; \
+ here=`pwd` && cd $(srcdir) \
+ && mkid -f$$here/ID $$unique $(LISP)
+
+TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) $(LISP)
+ tags=; \
+ here=`pwd`; \
+ list='$(SOURCES) $(HEADERS)'; \
+ unique=`for i in $$list; do echo $$i; done | \
+ awk ' { files[$$0] = 1; } \
+ END { for (i in files) print i; }'`; \
+ test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
+ || (cd $(srcdir) && etags $(ETAGS_ARGS) $$tags $$unique $(LISP) -o $$here/TAGS)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+ -rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
+
+subdir = library
+
+distdir: $(DISTFILES)
+ @for file in $(DISTFILES); do \
+ if test -f $$file; then d=.; else d=$(srcdir); fi; \
+ if test -d $$d/$$file; then \
+ cp -pr $$d/$$file $(distdir)/$$file; \
+ else \
+ test -f $(distdir)/$$file \
+ || ln $$d/$$file $(distdir)/$$file 2> /dev/null \
+ || cp -p $$d/$$file $(distdir)/$$file || :; \
+ fi; \
+ done
+info-am:
+info: info-am
+dvi-am:
+dvi: dvi-am
+check-am:
+check: check-am
+installcheck-am:
+installcheck: installcheck-am
+install-info-am:
+install-info: install-info-am
+install-exec-am:
+install-exec: install-exec-am
+
+install-data-am: install-guiDATA
+install-data: install-data-am
+
+install-am: all-am
+ @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-am
+uninstall-am: uninstall-guiDATA
+uninstall: uninstall-am
+all-am: Makefile $(DATA)
+all-redirect: all-am
+install-strip:
+ $(MAKE) $(AM_MAKEFLAGS) AM_INSTALL_PROGRAM_FLAGS=-s install
+installdirs:
+ $(mkinstalldirs) $(DESTDIR)$(guidir)
+
+
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+ -rm -f Makefile $(CONFIG_CLEAN_FILES)
+ -rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+mostlyclean-am: mostlyclean-tags mostlyclean-generic
+
+mostlyclean: mostlyclean-am
+
+clean-am: clean-tags clean-generic mostlyclean-am
+
+clean: clean-am
+
+distclean-am: distclean-tags distclean-generic clean-am
+
+distclean: distclean-am
+
+maintainer-clean-am: maintainer-clean-tags maintainer-clean-generic \
+ distclean-am
+ @echo "This command is intended for maintainers to use;"
+ @echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-am
+
+.PHONY: uninstall-guiDATA install-guiDATA tags mostlyclean-tags \
+distclean-tags clean-tags maintainer-clean-tags distdir info-am info \
+dvi-am dvi check check-am installcheck-am installcheck install-info-am \
+install-info install-exec-am install-exec install-data-am install-data \
+install-am install uninstall-am uninstall all-redirect all-am all \
+installdirs mostlyclean-generic distclean-generic clean-generic \
+maintainer-clean-generic clean mostlyclean distclean maintainer-clean
+
+
+tclIndex: $(TCL)
+ TCL_LIBRARY=$(srcdir)/../../tcl/library; export TCL_LIBRARY; \
+ here=`pwd`; \
+ $(SET_LIB_PATH) \
+ cd $(srcdir) && \
+ echo " auto_mkindex `pwd` $(TCL)" | $(ITCL_SH)
+
+pkgIndex.tcl: @MAINT@ $(PACKAGES)
+ here=`pwd`; \
+ $(SET_LIB_PATH) \
+ cd $(srcdir) && \
+ echo "pkg_mkIndex . $(PACKAGES); exit" | $(WISH)
+
+# Tell versions [3.59,3.63) of GNU make to not export all variables.
+# Otherwise a system limit (for SysV at least) may be exceeded.
+.NOEXPORT:
diff --git a/libgui/library/advice.tcl b/libgui/library/advice.tcl
new file mode 100644
index 00000000000..45861a7e7bc
--- /dev/null
+++ b/libgui/library/advice.tcl
@@ -0,0 +1,82 @@
+# advice.tcl - Generic advice package.
+# Copyright (C) 1998 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+# Please note that I adapted this from some code I wrote elsewhere,
+# for non-Cygnus reasons. Don't complain to me if you see something
+# like it somewhere else.
+
+
+# Internal state.
+defarray ADVICE_state
+
+# This is a helper proc that does all the actual work.
+proc ADVICE_do {command argList} {
+ global ADVICE_state
+
+ # Run before advice.
+ if {[info exists ADVICE_state(before,$command)]} {
+ foreach item $ADVICE_state(before,$command) {
+ # We purposely let errors in advice go uncaught.
+ uplevel $item $argList
+ }
+ }
+
+ # Run the command itself.
+ set code [catch \
+ [list uplevel \#0 $ADVICE_state(original,$command) $argList] \
+ result]
+
+ # Run the after advice.
+ if {[info exists ADVICE_state(after,$command)]} {
+ foreach item $ADVICE_state(after,$command) {
+ # We purposely let errors in advice go uncaught.
+ uplevel $item [list $code $result] $argList
+ }
+ }
+
+ # Return just as the original command would.
+ return -code $code $result
+}
+
+# Put some advice on a proc or command.
+# WHEN says when to run the advice - `before' or `after' the
+# advisee is run.
+# WHAT is the name of the proc or command to advise.
+# ADVISOR is the advice. It is passed the arguments to the advisee
+# call as its arguments. In addition, `after' advisors are
+# passed the return code and return value of the proc as their
+# first and second arguments.
+proc advise {when what advisor} {
+ global ADVICE_state
+
+ if {! [info exists ADVICE_state(original,$what)]} {
+ set newName [gensym]
+ rename $what $newName
+ set ADVICE_state(original,$what) $newName
+
+ # Create a new proc which just runs our internal command with the
+ # correct arguments.
+ uplevel \#0 [list proc $what args \
+ [format {ADVICE_do %s $args} $what]]
+ }
+
+ lappend ADVICE_state($when,$what) $advisor
+}
+
+# Remove some previously-set advice. Note that we could undo the
+# `rename' when the last advisor is removed. This adds complexity,
+# though, and there isn't much reason to.
+proc unadvise {when what advisor} {
+ global ADVICE_state
+
+ if {[info exists ADVICE_state($when,$what)]} {
+ set newList {}
+ foreach item $ADVICE_state($when,$what) {
+ if {[string compare $advisor $item]} {
+ lappend newList $item
+ }
+ }
+ set ADVICE_state($when,$what) $newList
+ }
+}
diff --git a/libgui/library/balloon.tcl b/libgui/library/balloon.tcl
new file mode 100644
index 00000000000..b4589d65141
--- /dev/null
+++ b/libgui/library/balloon.tcl
@@ -0,0 +1,532 @@
+# balloon.tcl - Balloon help.
+# Copyright (C) 1997, 1998 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+# KNOWN BUGS:
+# * On Windows, various delays should be determined from system;
+# presently they are hard-coded.
+# * Likewise, balloon positioning on Windows is a hack.
+
+itcl_class Balloon {
+ # Name of associated global variable which should be set whenever
+ # the help is shown.
+ public variable {}
+
+ # Name of associated toplevel. Private variable.
+ protected _top {}
+
+ # This is non-empty if there is an after script pending. Private
+ # method.
+ protected _after_id {}
+
+ # This is an array mapping window name to help text.
+ protected _help_text
+
+ # This is an array mapping window name to notification proc.
+ protected _notifiers
+
+ # This is set to the name of the parent widget whenever the mouse is
+ # in a widget with balloon help.
+ protected _active {}
+
+ # This is true when we're already calling a notification proc.
+ # Private variable.
+ protected _in_notifier 0
+
+ # This holds the parent of the most recently entered widget. It is
+ # used to determine when the user is moving through a toolbar.
+ # Private variable.
+ protected _recent_parent {}
+
+ constructor {top} {
+ global tcl_platform
+
+ set _top $top
+ set class [$this info class]
+
+ # The standard widget-making trick.
+ set hull [namespace tail $this]
+ set old_name $this
+ ::rename $this $this-tmp-
+ ::toplevel $hull -class $class -borderwidth 1 -background black
+ ::rename $hull $old_name-win-
+ ::rename $this $old_name
+
+ # By default we are invisible. When we are visible, we are
+ # borderless.
+ wm withdraw [namespace tail $this]
+ wm overrideredirect [namespace tail $this] 1
+
+ # Put some bindings on the toplevel. We don't use
+ # bind_for_toplevel_only because *do* want these bindings to be
+ # run when the event happens on some child.
+ bind $_top <Enter> [list $this _enter %W]
+ bind $_top <Leave> [list $this _leave]
+ # Only run this one if we aren't already destroyed.
+ bind $_top <Destroy> [format {
+ if {[info commands %s] != ""} then {
+ %s _subdestroy %%W
+ }
+ } $this $this]
+ bind $_top <Unmap> [list $this _unmap %W]
+ # Add more here as required.
+ bind $_top <1> [format {
+ %s _cancel
+ %s _unshowballoon
+ } $this $this]
+ bind $_top <3> [format {
+ %s _cancel
+ %s _unshowballoon
+ } $this $this]
+
+ if {$tcl_platform(platform) == "windows"} then {
+ set bg SystemInfoBackground
+ set fg SystemInfoText
+ } else {
+ # This color is called `LemonChiffon' by my X installation.
+ set bg \#ffffffffcccc
+ set fg black
+ }
+
+ # Where we display stuff.
+ label [namespace tail $this].label -background $bg -foreground $fg -font global/status \
+ -anchor w -justify left
+ pack [namespace tail $this].label -expand 1 -fill both
+
+ # Clean up when the label is destroyed. This has the hidden
+ # assumption that the balloon widget is a child of the toplevel to
+ # which it is connected.
+ bind [namespace tail $this].label <Destroy> [list $this delete]
+ }
+
+ destructor {
+ catch {_cancel}
+ catch {after cancel [list $this _unshowballoon]}
+ catch {destroy $this}
+ }
+
+ method configure {config} {}
+
+ # Register a notifier for a window.
+ method notify {command window {tag {}}} {
+ if {$tag == ""} then {
+ set item $window
+ } else {
+ set item $window,$tag
+ }
+
+ if {$command == ""} then {
+ unset _notifiers($item)
+ } else {
+ set _notifiers($item) $command
+ }
+ }
+
+ # Register help for a window.
+ method register {window text {tag {}}} {
+ if {$tag == ""} then {
+ set item $window
+ } else {
+ # Switching on the window class is bad. Do something better.
+ set class [winfo class $window]
+
+ # Switching on window class is bad. Do something better.
+ switch -- $class {
+ Menu {
+ # Menus require bindings that other items do not require.
+ # So here we make sure the menu has the binding. We could
+ # speed this up by keeping a special entry in the _help_text
+ # array if we wanted. Note that we pass in the name of the
+ # window as we know it. That lets us work even when we're
+ # actually getting events for a clone window. This is less
+ # than ideal, because it means we have to hijack the
+ # MenuSelect binding, but we live with it. (The other
+ # choice is to make a new bindtag per menu -- yuck.)
+ # This is relatively nasty: we have to encode the window
+ # name as passed to the _motion method; otherwise the
+ # cloning munges it. Sigh.
+ regsub -all -- \\. $window ! munge
+ bind $window <<MenuSelect>> [list $this _motion %W $munge]
+ }
+
+ Canvas {
+ # If we need to add a binding for this tag, do so.
+ if {! [info exists _help_text($window,$tag)]} then {
+ $window bind $tag <Enter> +[list $this _enter $window $tag]
+ $window bind $tag <Leave> +[list $this _leave]
+ $window bind $tag <1> +[format {
+ %s _cancel
+ %s _unshowballoon
+ } $this $this]
+ }
+ }
+
+ Text {
+ # If we need to add a binding for this tag, do so.
+ if {! [info exists _help_text($window,$tag)]} then {
+ $window tag bind $tag <Enter> +[list $this _enter $window $tag]
+ $window tag bind $tag <Leave> +[list $this _leave]
+ $window tag bind $tag <1> +[format {
+ %s _cancel
+ %s _unshowballoon
+ } $this $this]
+ }
+ }
+ }
+
+ set item $window,$tag
+ }
+
+ set _help_text($item) $text
+ if {$_active == $item} then {
+ _set_variable $item
+ # If the label is already showing, then we re-show it. Why not
+ # just set the -text on the label? Because if the label changes
+ # size it might be offscreen, and we need to handle that.
+ if {[wm state [namespace tail $this]] == "normal"} then {
+ showballoon $window $tag
+ }
+ }
+ }
+
+ # Cancel any pending after handler. Private method.
+ method _cancel {} {
+ if {$_after_id != ""} then {
+ after cancel $_after_id
+ set _after_id {}
+ }
+ }
+
+ # This is run when the toplevel, or any child, is entered. Private
+ # method.
+ method _enter {W {tag {}}} {
+ _cancel
+
+ # Don't bother for menus, since we know we use a different
+ # mechanism for them.
+ if {[winfo class $W] == "Menu"} then {
+ return
+ }
+
+ # If we just moved into the parent of the last child, then do
+ # nothing. We want to keep the parent the same so the right thing
+ # can happen if we move into a child of this same parent.
+ set delay 1000
+ if {$W != $_recent_parent} then {
+ if {[winfo parent $W] == $_recent_parent} then {
+ # As soon as possible.
+ set delay idle
+ } else {
+ set _recent_parent ""
+ }
+ }
+
+ if {$tag == ""} then {
+ set index $W
+ } else {
+ set index $W,$tag
+ }
+ set _active $index
+ if {[info exists _help_text($index)]} then {
+ # There is some help text. So arrange to display it when the
+ # time is up. We arbitrarily set this to 1 second.
+ set _after_id [after $delay [list $this showballoon $W $tag]]
+
+ # Set variable here; that way simply entering a window will
+ # cause the text to appear.
+ _set_variable $index
+ }
+ }
+
+ # This is run when the toplevel, or any child, is left. Private
+ # method.
+ method _leave {} {
+ _cancel
+ _unshowballoon
+ _set_variable {}
+ set _active {}
+ }
+
+ # This is run to undisplay the balloon. Note that it does not
+ # change the text stored in the variable. That is handled
+ # elsewhere. Private method.
+ method _unshowballoon {} {
+ wm withdraw [namespace tail $this]
+ }
+
+ # Set the variable, if it exists. Private method.
+ method _set_variable {index} {
+ # Run the notifier.
+ if {$index == ""} then {
+ set value ""
+ } elseif {[info exists _notifiers($index)] && ! $_in_notifier} then {
+ set _in_notifier 1
+ uplevel \#0 $_notifiers($index)
+ set _in_notifier 0
+ # Get value afterwards to give notifier a chance to change it.
+ set value $_help_text($index)
+ } else {
+ set value $_help_text($index)
+ }
+
+ if {$variable != ""} then {
+ # itcl 1.5 forces us to do this in a strange way.
+ ::uplevel \#0 [list set $variable $value]
+ }
+ }
+
+ # This is run to show the balloon. Private method.
+ method showballoon {W tag {keep 0}} {
+ global tcl_platform
+
+ if {$tag == ""} then {
+ # An ordinary window. Position below the window, and right of
+ # center.
+ set _active $W
+ set help $_help_text($W)
+ set left [expr {[winfo rootx $W] + round ([winfo width $W] * .75)}]
+ set ypos [expr {[winfo rooty $W] + [winfo height $W]}]
+ set alt_ypos [winfo rooty $W]
+
+ # Balloon shown, so set parent info.
+ set _recent_parent [winfo parent $W]
+ } else {
+ set _active $W,$tag
+ set help $_help_text($W,$tag)
+
+ # Switching on class name is bad. Do something better. Can't
+ # just use the widget's bbox method, because the results differ
+ # for Text and Canvas widgets. Bummer.
+ switch -- [winfo class $W] {
+ Menu {
+ # Recognize but do nothing.
+ }
+
+ Text {
+ lassign [$W bbox $tag.first] x y width height
+ set left [expr {[winfo rootx $W] + $x + round ($width * .75)}]
+ set ypos [expr {[winfo rooty $W] + $y + $height}]
+ set alt_ypos [expr {[winfo rooty $W] - $y}]
+ }
+
+ Canvas {
+ lassign [$W bbox $tag] x1 y1 x2 y2
+ # Must subtract out coordinates of top-left corner of canvas
+ # window; otherwise this will get the wrong position when
+ # the canvas has been scrolled.
+ set tlx [$W canvasx 0]
+ set tly [$W canvasy 0]
+ # Must round results because canvas coordinates are floats.
+ set left [expr {round ([winfo rootx $W] + $x1 - $tlx
+ + ($x2 - $x1) * .75)}]
+ set ypos [expr {round ([winfo rooty $W] + $y2 - $tly)}]
+ set alt_ypos [expr {round ([winfo rooty $W] + $y1 - $tly)}]
+ }
+
+ default {
+ error "unrecognized window class for window \"$W\""
+ }
+ }
+ }
+
+ # On Windows, the popup location is always determined by the
+ # cursor. Actually, the rule seems to be somewhat more complex.
+ # Unfortunately it doesn't seem to be written down anywhere.
+ # Experiments show that the location is determined by the cursor
+ # if the text is wider than the widget; and otherwise it is
+ # centered under the widget. FIXME: we don't deal with those
+ # cases.
+ if {$tcl_platform(platform) == "windows"} then {
+ # FIXME: for now this is turned off. It isn't enough to get the
+ # cursor size; we actually have to find the bottommost "on"
+ # pixel in the cursor and use that for the height. I don't know
+ # how to do that.
+ # lassign [ide_cursor size] dummy height
+ # lassign [ide_cursor position] left ypos
+ # incr ypos $height
+ }
+
+ if {[info exists left] && $help != ""} then {
+ [namespace tail $this].label configure -text $help
+ set lw [winfo reqwidth [namespace tail $this].label]
+ set sw [winfo screenwidth [namespace tail $this]]
+ set bw [$this-win- cget -borderwidth]
+ if {$left + $lw + 2 * $bw >= $sw} then {
+ set left [expr {$sw - 2 * $bw - $lw}]
+ }
+
+ set lh [winfo reqheight [namespace tail $this].label]
+ if {$ypos + $lh >= [winfo screenheight [namespace tail $this]]} then {
+ set ypos [expr {$alt_ypos - $lh}]
+ }
+
+ wm positionfrom [namespace tail $this] user
+ wm geometry [namespace tail $this] +${left}+${ypos}
+ update
+ wm deiconify [namespace tail $this]
+ raise [namespace tail $this]
+
+ if {!$keep} {
+ # After 6 seconds, close the window. The timer is reset every
+ # time the window is shown.
+ after cancel [list $this _unshowballoon]
+ after 6000 [list $this _unshowballoon]
+ }
+ }
+ }
+
+ # This is run when a window or tag is destroyed. Private method.
+ method _subdestroy {W {tag {}}} {
+ if {$tag == ""} then {
+ # A window. Remove the window and any associated tags. Note
+ # that this is called for all Destroy events on descendents,
+ # even for windows which were never registered. Hence the use
+ # of catch.
+ catch {unset _help_text($W)}
+ foreach thing [array names _help_text($W,*)] {
+ unset _help_text($thing)
+ }
+ } else {
+ # Just a tag. This one can't be called by mistake, so this
+ # shouldn't need to be caught.
+ unset _help_text($W,$tag)
+ }
+ }
+
+ # This is run in response to a MenuSelect event on a menu.
+ method _motion {window name} {
+ # Decode window name.
+ regsub -all -- ! $name . name
+
+ if {$variable == ""} then {
+ # There's no point to doing anything.
+ return
+ }
+
+ set n [$window index active]
+ if {$n == "none"} then {
+ set index ""
+ set _active {}
+ } elseif {[info exists _help_text($name,$n)]} then {
+ # Tag specified by index number.
+ set index $name,$n
+ set _active $name,$n
+ } elseif {! [catch {$window entrycget $n -label} label]
+ && [info exists _help_text($name,$label)]} then {
+ # Tag specified by index name.
+ set index $name,$label
+ set _active $name,$label
+ } else {
+ # No help for this item.
+ set index ""
+ set _active {}
+ }
+
+ _set_variable $index
+ }
+
+ # This is run when some widget unmaps. If the widget is the current
+ # widget, then unmap the balloon help. Private method.
+ method _unmap w {
+ if {$w == $_active} then {
+ _cancel
+ _unshowballoon
+ _set_variable {}
+ set _active {}
+ }
+ }
+}
+
+
+################################################################
+
+# Find (and possibly create) balloon widget associated with window.
+proc BALLOON_find_balloon {window} {
+ # Find our associated toplevel. If it is a menu, then keep going.
+ set top [winfo toplevel $window]
+ while {[winfo class $top] == "Menu"} {
+ set top [winfo toplevel [winfo parent $top]]
+ }
+
+ if {$top == "."} {
+ set bname .__balloon
+ } else {
+ set bname $top.__balloon
+ }
+
+ # If the balloon help for this toplevel doesn't exist, then create
+ # it. Yes, this relies on a magic name for the balloon help widget.
+ if {! [winfo exists $bname]} then {
+ Balloon $bname $top
+ }
+ return $bname
+}
+
+# This implements "balloon register".
+proc BALLOON_command_register {window text {tag {}}} {
+ set b [BALLOON_find_balloon $window]
+ $b register $window $text $tag
+}
+
+# This implements "balloon notify".
+proc BALLOON_command_notify {command window {tag {}}} {
+ set b [BALLOON_find_balloon $window]
+ $b notify $command $window $tag
+}
+
+# This implements "balloon show".
+proc BALLOON_command_show {window {tag {}} {keep 0}} {
+ set b [BALLOON_find_balloon $window]
+ $b showballoon $window $tag $keep
+}
+
+proc BALLOON_command_withdraw {window} {
+ set b [BALLOON_find_balloon $window]
+ $b _unmap $window
+}
+
+# This implements "balloon variable".
+proc BALLOON_command_variable {window args} {
+ if {[llength $args] == 0} then {
+ # Fetch.
+ set b [BALLOON_find_balloon [lindex $args 0]]
+ return [lindex [$b configure -variable] 4]
+ } else {
+ # FIXME: no arg checking here.
+ # Set.
+ set b [BALLOON_find_balloon $window]
+ $b configure -variable [lindex $args 0]
+ }
+}
+
+# The primary interface to balloon help.
+# Usage:
+# balloon notify COMMAND WINDOW ?TAG?
+# Run COMMAND just before the help text for WINDOW (and TAG, if
+# given) is displayed. If COMMAND is the empty string, then
+# notification is disabled for this window.
+# balloon register WINDOW TEXT ?TAG?
+# Associate TEXT as the balloon help for WINDOW.
+# If TAG is given, the use the appropriate tag for association.
+# For menu widgets, TAG is a menu index.
+# For canvas widgets, TAG is a tagOrId.
+# For text widgets, TAG is a text index. If you want to use
+# the text tag FOO, use `FOO.last'.
+# balloon show WINDOW ?TAG?
+# Immediately pop up the balloon for the given window and tag.
+# This should be used sparingly. For instance, you might need to
+# use it if the tag you're interested in does not track the mouse,
+# but instead is added just before show-time.
+# balloon variable WINDOW ?NAME?
+# If NAME specified, set balloon help variable associated
+# with window. This variable is set to the text whenever the
+# balloon help is on. If NAME is specified but empty,
+# no variable is set. If NAME not specified, then the
+# current variable name is returned.
+proc balloon {key args} {
+ if {[info commands BALLOON_command_$key] == "" } then {
+ error "unrecognized key \"$key\""
+ }
+
+ eval BALLOON_command_$key $args
+}
diff --git a/libgui/library/bbox.tcl b/libgui/library/bbox.tcl
new file mode 100644
index 00000000000..b0e50b794e0
--- /dev/null
+++ b/libgui/library/bbox.tcl
@@ -0,0 +1,57 @@
+# bbox.tcl - Function for handling button box.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+# Pass this proc a frame whose children are all buttons. It will put
+# the children into the frame so that they look right on the current
+# platform. On Windows this means that they are all the same width
+# and have a uniform separation. (And currently on Unix it means this
+# same thing, though that might change.)
+proc standard_button_box {frame {horizontal 1}} {
+ # This is half the separation we want between the buttons. This
+ # number comes from the Windows UI "standards" manual.
+ set half_gap 2
+
+ set width 0
+ foreach button [winfo children $frame] {
+ set bw [winfo reqwidth $button]
+ if {$bw > $width} then {
+ set width $bw
+ }
+ }
+
+ incr width $half_gap
+ incr width $half_gap
+
+ if {$horizontal} then {
+ set i 1
+ } else {
+ set i 0
+ }
+ foreach button [winfo children $frame] {
+ if {$horizontal} then {
+ # We set the size via the grid, and not -width on the button.
+ # Why? Because in Tk -width has different units depending on the
+ # contents of the button. And worse, the font units don't really
+ # make sense when dealing with a proportional font.
+ grid $button -row 0 -column $i -sticky ew \
+ -padx $half_gap -pady $half_gap
+ grid columnconfigure $frame $i -weight 0 -minsize $width
+ } else {
+ grid $button -column 0 -row $i -sticky new \
+ -padx $half_gap -pady $half_gap
+ grid rowconfigure $frame $i -weight 0
+ }
+ incr i
+ }
+
+ if {$horizontal} then {
+ # Make the empty column 0 suck up all the space.
+ grid columnconfigure $frame 0 -weight 1
+ } else {
+ grid columnconfigure $frame 0 -minsize $width
+ # Make the last row suck up all the space.
+ incr i -1
+ grid rowconfigure $frame $i -weight 1
+ }
+}
diff --git a/libgui/library/bgerror.tcl b/libgui/library/bgerror.tcl
new file mode 100644
index 00000000000..b676e7bb7dd
--- /dev/null
+++ b/libgui/library/bgerror.tcl
@@ -0,0 +1,64 @@
+# bgerror.tcl - Send bug report in response to uncaught Tcl error.
+# Copyright (C) 1997, 1998, 1999 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+proc bgerror err {
+ global errorInfo errorCode
+
+ set info $errorInfo
+ set code $errorCode
+
+ # log the error to the debug window or file
+ dbug E $info
+ dbug E $code
+
+ set command [list tk_dialog .bgerrorDialog [gettext "GDB Error"] \
+ [format [gettext "Error: %s"] $err] \
+ error 0 [gettext "OK"]]
+ lappend command [gettext "Stack Trace"]
+
+
+ set value [eval $command]
+ if {$value == 0} {
+ return
+ }
+
+ 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
+ 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 "errorCode is $errorCode"
+ $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 .]
+ }
+}
diff --git a/libgui/library/bindings.tcl b/libgui/library/bindings.tcl
new file mode 100644
index 00000000000..b6299288b31
--- /dev/null
+++ b/libgui/library/bindings.tcl
@@ -0,0 +1,88 @@
+# bindings.tcl - Procs to handle bindings.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+# Reorder the bindtags so that the tag appears before the widget.
+# Tries to preserve other relative orderings as much as possible. In
+# particular, nothing changes if the widget is already after the tag.
+proc bind_widget_after_tag {w tag} {
+ set seen_tag 0
+ set seen_widget 0
+ set new_list {}
+ foreach tag [bindtags $w] {
+ if {$tag == $tag} then {
+ lappend new_list $tag
+ if {$seen_widget} then {
+ lappend new_list $w
+ }
+ set seen_tag 1
+ } elseif {$tag == $w} then {
+ if {$seen_tag} then {
+ lappend new_list $tag
+ }
+ set seen_widget 1
+ } else {
+ lappend new_list $tag
+ }
+ }
+
+ if {! $seen_widget} then {
+ lappend new_list $w
+ }
+
+ bindtags $w $new_list
+}
+
+# Reorder the bindtags so that the class appears before the widget.
+# Tries to preserve other relative orderings as much as possible. In
+# particular, nothing changes if the widget is already after the
+# class.
+proc bind_widget_after_class {w} {
+ bind_widget_after_tag $w [winfo class $w]
+}
+
+# Make the specified binding for KEY and empty bindings for common
+# modifiers for KEY. This can be used to ensure that a binding won't
+# also be triggered by (eg) Alt-KEY. This proc also makes the binding
+# case-insensitive. KEY is either the name of a key, or a key with a
+# single modifier.
+proc bind_plain_key {w key binding} {
+ set l [split $key -]
+ if {[llength $l] == 1} then {
+ set mod {}
+ set part $key
+ } else {
+ set mod "[lindex $l 0]-"
+ set part [lindex $l 1]
+ }
+
+ set modifiers {Meta- Alt- Control-}
+
+ set part_list [list $part]
+ # If we just have a single letter, then we can't look for
+ # Shift-PART; we must use the uppercase equivalent.
+ if {[string length $part] == 1} then {
+ # This is nasty: if we bind Control-L, we won't see the events we
+ # want. Instead we have to bind Shift-Control-L. Actually, we
+ # must also bind Control-L so that we'll see the event if the Caps
+ # Lock key is down.
+ if {$mod != ""} then {
+ lappend part_list "Shift-[string toupper $part]"
+ }
+ lappend part_list [string toupper $part]
+ } else {
+ lappend modifiers Shift-
+ }
+
+ foreach part $part_list {
+ # Bind the key itself (with modifier if required).
+ bind $w <${mod}${part}> $binding
+
+ # Ignore any modifiers other than the one we like.
+ foreach onemod $modifiers {
+ if {$onemod != $mod} then {
+ bind $w <${onemod}${part}> {;}
+ }
+ }
+ }
+}
diff --git a/libgui/library/canvas.tcl b/libgui/library/canvas.tcl
new file mode 100644
index 00000000000..687510fb827
--- /dev/null
+++ b/libgui/library/canvas.tcl
@@ -0,0 +1,29 @@
+# canvas.tcl - Handy canvas-related commands.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+# Set scroll region on canvas.
+proc set_scroll_region {canvas} {
+ set bbox [$canvas bbox all]
+ if {[llength $bbox]} then {
+ set sr [lreplace $bbox 0 1 0 0]
+ } else {
+ set sr {0 0 0 0}
+ }
+
+ # Don't include borders in the scrollregion.
+ set delta [expr {2 * ([$canvas cget -borderwidth]
+ + [$canvas cget -highlightthickness])}]
+
+ set ww [winfo width $canvas]
+ if {[lindex $sr 2] < $ww} then {
+ set sr [lreplace $sr 2 2 [expr {$ww - $delta}]]
+ }
+
+ set wh [winfo height $canvas]
+ if {[lindex $sr 3] < $wh} then {
+ set sr [lreplace $sr 3 3 [expr {$wh - $delta}]]
+ }
+
+ $canvas configure -scrollregion $sr
+}
diff --git a/libgui/library/center.tcl b/libgui/library/center.tcl
new file mode 100644
index 00000000000..c8f606acadf
--- /dev/null
+++ b/libgui/library/center.tcl
@@ -0,0 +1,18 @@
+# center.tcl - Center a window on the screen.
+# Copyright (C) 1997, 1998 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+# Call this after the TOPLEVEL has been filled in, but before it has
+# been mapped. This proc will center the toplevel on the screen.
+proc center_window {top} {
+ update idletasks
+ set x [expr {int (([winfo screenwidth $top] - [winfo reqwidth $top]) / 2)}]
+ set y [expr {int (([winfo screenheight $top] - [winfo reqheight $top]) / 2)}]
+ wm geometry $top +${x}+${y}
+ wm positionfrom $top user
+
+ # We run this update here because Tk updates toplevel geometry
+ # (position) info in an idle handler on Windows, but doesn't force
+ # the handler to run before mapping the window.
+ update idletasks
+}
diff --git a/libgui/library/cframe.tcl b/libgui/library/cframe.tcl
new file mode 100644
index 00000000000..47201b936e3
--- /dev/null
+++ b/libgui/library/cframe.tcl
@@ -0,0 +1,146 @@
+# cframe.tcl - Frame controlled by checkbutton.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+itcl_class Checkframe {
+ inherit Widgetframe
+
+ # The checkbutton text.
+ public text {} {
+ _set_option -text $text 0
+ }
+
+ # This holds the last value of -variable. We use it to unset our
+ # trace when the variable changes (or is deleted). Private
+ # variable.
+ protected _saved_variable {}
+
+ # The checkbutton variable.
+ public variable {} {
+ _var_changed
+ }
+
+ # The checkbutton -onvalue.
+ public onvalue 1 {
+ _set_option -onvalue $onvalue
+ }
+
+ # The checkbutton -offvalue.
+ public offvalue 0 {
+ _set_option -offvalue $offvalue
+ }
+
+ # The checkbutton -command.
+ public command {} {
+ _set_option -command $command 0
+ }
+
+ # This holds balloon help for the checkbutton.
+ public help {} {
+ if {[winfo exists [namespace tail $this].check]} then {
+ balloon register [namespace tail $this].check $help
+ }
+ }
+
+ # This holds a list of all widgets which should be immune to
+ # enabling/disabling. Private variable.
+ protected _avoid {}
+
+ constructor {config} {
+ checkbutton [namespace tail $this].check -text $text -variable $variable -padx 2 \
+ -command $command -onvalue $onvalue -offvalue $offvalue
+ balloon register [namespace tail $this].check $help
+ _add [namespace tail $this].check
+ }
+
+ # Exempt a child from state changes. Argument EXEMPT is true if the
+ # child should be exempted, false if it should be re-enabled again.
+ # Public method.
+ method exempt {child {exempt 1}} {
+ if {$exempt} then {
+ if {[lsearch -exact $_avoid $child] == -1} then {
+ lappend _avoid $child
+ }
+ } else {
+ set _avoid [lremove $_avoid $child]
+ _set_visibility $child
+ }
+ }
+
+ # This is run when the state of the frame's children should change.
+ # Private method.
+ method _set_visibility {{child {}}} {
+ if {$variable == ""} then {
+ # No variable means everything is ok. The behavior here is
+ # arbitrary; this is a losing case.
+ set state normal
+ } else {
+ upvar \#0 $variable the_var
+ if {! [string compare $the_var $onvalue]} then {
+ set state normal
+ } else {
+ set state disabled
+ }
+ }
+
+ if {$child != ""} then {
+ $child configure -state $state
+ } else {
+ # FIXME: we force our logical children to be actual children of
+ # the frame. Instead we should ask the geometry manager what's
+ # going on.
+ set avoid(_) {}
+ unset avoid(_)
+ foreach child $_avoid {
+ set avoid($child) {}
+ }
+ foreach child [winfo children [namespace tail $this].iframe.frame] {
+ if {! [info exists avoid($child)]} then {
+ catch {$child configure -state $state}
+ }
+ }
+ }
+ }
+
+ # This is run to possibly update some option on the checkbutton.
+ # Private method.
+ method _set_option {option value {set_vis 1}} {
+ if {[winfo exists [namespace tail $this].check]} then {
+ [namespace tail $this].check configure $option $value
+ if {$set_vis} then {
+ _set_visibility
+ }
+ }
+ }
+
+ # This is run when our associated variable changes. We use the
+ # resulting information to set the state of our children. Private
+ # method.
+ method _trace {name1 name2 op} {
+ if {$op == "u"} then {
+ # The variable got deleted. So we stop looking at it.
+ uplevel \#0 [list trace vdelete $_saved_variable uw [list $this _trace]]
+ set _saved_variable {}
+ set variable {}
+ } else {
+ # Got a write.
+ _set_visibility
+ }
+ }
+
+ # This is run when the -variable changes. We remove our old trace
+ # (if there was one) and add a new trace (if we need to). Private
+ # method.
+ method _var_changed {} {
+ if {$_saved_variable != ""} then {
+ # Remove the old trace.
+ uplevel \#0 [list trace vdelete $_saved_variable uw [list $this _trace]]
+ }
+ set _saved_variable $variable
+
+ if {$variable != ""} then {
+ # Set a new trace.
+ uplevel \#0 [list trace variable $variable uw [list $this _trace]]
+ }
+ }
+}
diff --git a/libgui/library/combobox.tcl b/libgui/library/combobox.tcl
new file mode 100644
index 00000000000..9811569aa44
--- /dev/null
+++ b/libgui/library/combobox.tcl
@@ -0,0 +1,1118 @@
+# Copyright (c) 1998, Bryan Oakley
+# All Rights Reservered
+#
+# Bryan Oakley
+# oakley@channelpoint.com
+#
+# combobox v1.05 August 17, 1998
+# a dropdown combobox widget
+#
+# this code is freely distributable without restriction, but is
+# provided as-is with no waranty expressed or implied.
+#
+# Standard Options:
+#
+# -background -borderwidth -font -foreground -highlightthickness
+# -highlightbackground -relief -state -textvariable
+# -selectbackground -selectborderwidth -selectforeground
+# -cursor
+#
+# Custom Options:
+# -command a command to run whenever the value is changed.
+# This command will be called with two values
+# appended to it -- the name of the widget and the
+# new value. It is run at the global scope.
+# -editable if true, user can type into edit box; false, she can't
+# -height specifies height of dropdown list, in lines
+# -image image for the button to pop down the list...
+# -maxheight specifies maximum height of dropdown list, in lines
+# -value duh
+# -width treated just like the -width option to entry widgets
+#
+#
+# widget commands:
+#
+# (see source... there's a bunch; duplicates of most of the entry
+# widget commands, plus commands to manipulate the listbox and a couple
+# unique to the combobox as a whole)
+#
+# to create a combobox:
+#
+# namespace import combobox::combobox
+# combobox .foo ?options?
+#
+#
+# thanks to the following people who provided beta test support or
+# patches to the code:
+#
+# Martin M. Hunt (hunt@cygnus.com)
+
+package require Tk 8.0
+package provide combobox 1.05
+
+namespace eval ::combobox {
+ global tcl_platform
+ # this is the public interface
+ namespace export combobox
+
+ if {$tcl_platform(platform) != "windows"} {
+ set sbtest ". "
+ radiobutton $sbtest
+ set disabledfg [$sbtest cget -disabledforeground]
+ set enabledfg [$sbtest cget -fg]
+ } else {
+ set disabledfg SystemDisabledText
+ set enabledfg SystemWindowText
+ }
+
+ # the image used for the button...
+ image create bitmap ::combobox::bimage -data {
+ #define down_arrow_width 15
+ #define down_arrow_height 15
+ static char down_arrow_bits[] = {
+ 0x00,0x80,0x00,0x80,0x00,0x80,0x00,0x80,0x00,0x80,0xf8,0x8f,0xf0,0x87,0xe0,
+ 0x83,0xc0,0x81,0x80,0x80,0x00,0x80,0x00,0x80,0x00,0x80,0x00,0x80,0x00,0x80
+ };
+ }
+}
+
+# this is the command that gets exported, and creates a new
+# combobox widget. It works like other widget commands in that
+# it takes as its first argument a widget path, and any remaining
+# arguments are option/value pairs for the widget
+proc ::combobox::combobox {w args} {
+
+ # build it...
+ eval build $w $args
+
+ # set some bindings...
+ setBindings $w
+
+ # and we are done!
+ return $w
+}
+
+# builds the combobox...
+proc ::combobox::build {w args } {
+ global tcl_platform
+ if {[winfo exists $w]} {
+ error "window name \"$w\" already exists"
+ }
+
+ # create the namespace...
+ namespace eval ::combobox::$w {
+
+ variable widgets
+ variable options
+ variable oldValue
+ variable ignoreTrace
+ variable this
+
+ array set widgets {}
+ array set options {}
+
+ set oldValue {}
+ set ignoreTrace 0
+ }
+
+ # import the widgets and options arrays into this proc
+ upvar ::combobox::${w}::widgets widgets
+ upvar ::combobox::${w}::options options
+
+ # ok, everything we create should exist in the namespace
+ # we create for this widget. This is to hide all the internal
+ # foo from prying eyes. If they really want to get at the
+ # internals, they know where they can find it...
+
+ # see... I'm pretending to be a Java programmer here...
+ set this $w
+ namespace eval ::combobox::$w "set this $this"
+
+ # the basic, always-visible parts of the combobox. We do these
+ # here, because we want to query some of them for their default
+ # values, which we want to juggle to other widgets. I suppose
+ # I could use the options database, but I choose not to...
+ set widgets(this) [frame $this -class Combobox -takefocus 0]
+ set widgets(entry) [entry $this.entry -takefocus {}]
+ set widgets(button) [label $this.button -takefocus 0]
+
+ # we will later rename the frame's widget proc to be our
+ # own custom widget proc. We need to keep track of this
+ # new name, so we'll store it here...
+ set widgets(frame) .$this
+
+ pack $widgets(button) -side right -fill y -expand n
+ pack $widgets(entry) -side left -fill both -expand y
+
+ # we need these to be defined, regardless if the user defined
+ # them for us or not...
+ array set options [list \
+ -height 0 \
+ -maxheight 10 \
+ -command {} \
+ -image {} \
+ -textvariable {} \
+ -editable 1 \
+ -state normal
+ ]
+ # now, steal some attributes from the entry widget...
+ foreach option [list -background -foreground -relief \
+ -borderwidth -highlightthickness -highlightbackground \
+ -font -width -selectbackground -selectborderwidth \
+ -selectforeground] {
+ set options($option) [$widgets(entry) cget $option]
+ }
+
+ # I should probably do this in a catch, but for now it's
+ # good enough... What it does, obviously, is put all of
+ # the option/values pairs into an array. Make them easier
+ # to handle later on...
+ array set options $args
+
+ # now, the dropdown list... the same renaming nonsense
+ # must go on here as well...
+ set widgets(popup) [toplevel $this.top]
+ set widgets(listbox) [listbox $this.top.list]
+ set widgets(vsb) [scrollbar $this.top.vsb]
+
+ pack $widgets(listbox) -side left -fill both -expand y
+
+ # fine tune the widgets based on the options (and a few
+ # arbitrary values...)
+
+ # NB: we are going to use the frame to handle the relief
+ # of the widget as a whole, so the entry widget will be
+ # flat.
+ $widgets(vsb) configure \
+ -command "$widgets(listbox) yview" \
+ -highlightthickness 0
+
+ set width [expr [winfo reqwidth $widgets(vsb)] - 2]
+ $widgets(button) configure \
+ -highlightthickness 0 \
+ -borderwidth 1 \
+ -relief raised \
+ -width $width
+
+ $widgets(entry) configure \
+ -borderwidth 0 \
+ -relief flat \
+ -highlightthickness 0
+
+ $widgets(popup) configure \
+ -borderwidth 1 \
+ -relief sunken
+ $widgets(listbox) configure \
+ -selectmode browse \
+ -background [$widgets(entry) cget -bg] \
+ -yscrollcommand "$widgets(vsb) set" \
+ -borderwidth 0
+
+ #Windows look'n'feel: black boarder around listbox
+ if {$tcl_platform(platform)=="windows"} {
+ $widgets(listbox) configure -highlightbackground black
+ }
+
+
+ # do some window management foo.
+ wm overrideredirect $widgets(popup) 1
+ wm transient $widgets(popup) [winfo toplevel $this]
+ wm group $widgets(popup) [winfo parent $this]
+ wm resizable $widgets(popup) 0 0
+ wm withdraw $widgets(popup)
+
+ # this moves the original frame widget proc into our
+ # namespace and gives it a handy name
+ rename ::$this $widgets(frame)
+
+ # now, create our widget proc. Obviously (?) it goes in
+ # the global namespace
+
+ proc ::$this {command args} \
+ "eval ::combobox::widgetProc $this \$command \$args"
+# namespace export $this
+# uplevel \#0 namespace import ::combobox::${this}::$this
+
+ # ok, the thing exists... let's do a bit more configuration:
+ foreach opt [array names options] {
+ ::combobox::configure $widgets(this) set $opt $options($opt)
+ }
+}
+
+# here's where we do most of the binding foo. I think there's probably
+# a few bindings I ought to add that I just haven't thought about...
+proc ::combobox::setBindings {w} {
+ namespace eval ::combobox::$w {
+ variable widgets
+ variable options
+
+ # make sure we clean up after ourselves...
+ bind $widgets(this) <Destroy> [list ::combobox::destroyHandler $this]
+
+ # this closes the listbox if we get hidden
+ bind $widgets(this) <Unmap> "$widgets(this) close"
+
+ # this helps (but doesn't fully solve) focus issues.
+ bind $widgets(this) <FocusIn> [list focus $widgets(entry)]
+
+ # this makes our "button" (which is actually a label)
+ # do the right thing
+ bind $widgets(button) <ButtonPress-1> [list $widgets(this) toggle]
+
+ # this lets the autoscan of the listbox work, even if they
+ # move the cursor over the entry widget.
+ bind $widgets(entry) <B1-Enter> "break"
+ bind $widgets(entry) <FocusIn> \
+ [list ::combobox::entryFocus $widgets(this) "<FocusIn>"]
+ bind $widgets(entry) <FocusOut> \
+ [list ::combobox::entryFocus $widgets(this) "<FocusOut>"]
+
+ # this will (hopefully) close (and lose the grab on) the
+ # listbox if the user clicks anywhere outside of it. Note
+ # that on Windows, you can click on some other app and
+ # the listbox will still be there, because tcl won't see
+ # that button click
+ bind $widgets(this) <Any-ButtonPress> [list $widgets(this) close]
+ bind $widgets(this) <Any-ButtonRelease> [list $widgets(this) close]
+
+ bind $widgets(listbox) <ButtonRelease-1> \
+ "::combobox::select $widgets(this) \[$widgets(listbox) nearest %y\]; break"
+
+ bind $widgets(listbox) <Any-Motion> {
+ %W selection clear 0 end
+ %W activate @%x,%y
+ %W selection anchor @%x,%y
+ %W selection set @%x,%y @%x,%y
+ # need to do a yview if the cursor goes off the top
+ # or bottom of the window... (or do we?)
+ }
+
+ # these events need to be passed from the entry
+ # widget to the listbox, or need some sort of special
+ # handling....
+ foreach event [list <Up> <Down> <Tab> <Return> <Escape> \
+ <Next> <Prior> <Double-1> <1> <Any-KeyPress> \
+ <FocusIn> <FocusOut>] {
+ bind $widgets(entry) $event \
+ "::combobox::handleEvent $widgets(this) $event"
+ }
+
+ }
+}
+
+# this proc handles events from the entry widget that we want handled
+# specially (typically, to allow navigation of the list even though
+# the focus is in the entry widget)
+proc ::combobox::handleEvent {w event} {
+ upvar ::combobox::${w}::widgets widgets
+ upvar ::combobox::${w}::options options
+ upvar ::combobox::${w}::oldValue oldValue
+
+ # for all of these events, if we have a special action we'll
+ # do that and do a "return -code break" to keep additional
+ # bindings from firing. Otherwise we'll let the event fall
+ # on through.
+ switch $event {
+ "<Any-KeyPress>" {
+ set editable [::combobox::getBoolean $options(-editable)]
+ # if the widget is editable, clear the selection.
+ # this makes it more obvious what will happen if the
+ # user presses <Return> (and helps our code know what
+ # to do if the user presses return)
+ if {$editable} {
+ $widgets(listbox) see 0
+ $widgets(listbox) selection clear 0 end
+ $widgets(listbox) selection anchor 0
+ $widgets(listbox) activate 0
+ }
+ }
+
+ "<FocusIn>" {
+ set oldValue [$widgets(entry) get]
+ }
+
+ "<FocusOut>" {
+ $widgets(entry) delete 0 end
+ $widgets(entry) insert 0 $oldValue
+ }
+
+ "<1>" {
+ set editable [::combobox::getBoolean $options(-editable)]
+ if {!$editable} {
+ if {[winfo ismapped $widgets(popup)]} {
+ $widgets(this) close
+ return -code break;
+
+ } else {
+ if {$options(-state) != "disabled"} {
+ $widgets(this) open
+ return -code break;
+ }
+ }
+ }
+ }
+
+ "<Double-1>" {
+ if {$options(-state) != "disabled"} {
+ $widgets(this) toggle
+ return -code break;
+ }
+ }
+ "<Tab>" {
+ if {[winfo ismapped $widgets(popup)]} {
+ ::combobox::find $widgets(this)
+ return -code break;
+ }
+ }
+ "<Escape>" {
+ $widgets(entry) delete 0 end
+ $widgets(entry) insert 0 $oldValue
+ if {[winfo ismapped $widgets(popup)]} {
+ $widgets(this) close
+ return -code break;
+ }
+ }
+
+ "<Return>" {
+ set editable [::combobox::getBoolean $options(-editable)]
+ if {$editable} {
+ # if there is something in the list that is selected,
+ # we'll pick it. Otherwise, use whats in the
+ # entry widget...
+ set index [$widgets(listbox) curselection]
+ if {[winfo ismapped $widgets(popup)] && \
+ [llength $index] > 0} {
+
+ ::combobox::select $widgets(this) \
+ [$widgets(listbox) curselection]
+ return -code break;
+
+ } else {
+ ::combobox::setValue $widgets(this) [$widgets(this) get]
+ $widgets(this) close
+ return -code break;
+ }
+ }
+
+ if {[winfo ismapped $widgets(popup)]} {
+ ::combobox::select $widgets(this) \
+ [$widgets(listbox) curselection]
+ return -code break;
+ }
+
+ }
+
+ "<Next>" {
+ $widgets(listbox) yview scroll 1 pages
+ set index [$widgets(listbox) index @0,0]
+ $widgets(listbox) see $index
+ $widgets(listbox) activate $index
+ $widgets(listbox) selection clear 0 end
+ $widgets(listbox) selection anchor $index
+ $widgets(listbox) selection set $index
+
+ }
+
+ "<Prior>" {
+ $widgets(listbox) yview scroll -1 pages
+ set index [$widgets(listbox) index @0,0]
+ $widgets(listbox) activate $index
+ $widgets(listbox) see $index
+ $widgets(listbox) selection clear 0 end
+ $widgets(listbox) selection anchor $index
+ $widgets(listbox) selection set $index
+ }
+
+ "<Down>" {
+ if {![winfo ismapped $widgets(popup)]} {
+ if {$options(-state) != "disabled"} {
+ $widgets(this) open
+ return -code break;
+ }
+ } else {
+ tkListboxUpDown $widgets(listbox) 1
+ return -code break;
+ }
+ }
+ "<Up>" {
+ if {![winfo ismapped $widgets(popup)]} {
+ if {$options(-state) != "disabled"} {
+ $widgets(this) open
+ return -code break;
+ }
+ } else {
+ tkListboxUpDown $widgets(listbox) -1
+ return -code break;
+ }
+ }
+ }
+}
+
+# this cleans up the mess that is left behind when the widget goes away
+proc ::combobox::destroyHandler {w} {
+
+ # kill any trace or after we may have started...
+ namespace eval ::combobox::$w {
+ variable options
+ variable widgets
+
+ if {[string length $options(-textvariable)]} {
+ trace vdelete $options(-textvariable) w \
+ [list ::combobox::vTrace $widgets(this)]
+ }
+
+ # CYGNUS LOCAL - kill any after command that may be registered.
+ if {[info exists widgets(after)]} {
+ after cancel $widgets(after)
+ unset widgets(after)
+ }
+ }
+
+# catch {rename ::combobox::${w}::$w {}}
+ # kill the namespace
+ catch {namespace delete ::combobox::$w}
+}
+
+# finds something in the listbox that matches the pattern in the
+# entry widget
+#
+# I'm not convinced this is working the way it ought to. It works,
+# but is the behavior what is expected? I've also got a gut feeling
+# that there's a better way to do this, but I'm too lazy to figure
+# it out...
+proc ::combobox::find {w {exact 0}} {
+ upvar ::combobox::${w}::widgets widgets
+ upvar ::combobox::${w}::options options
+
+ ## *sigh* this logic is rather gross and convoluted. Surely
+ ## there is a more simple, straight-forward way to implement
+ ## all this. As the saying goes, I lack the time to make it
+ ## shorter...
+
+ # use what is already in the entry widget as a pattern
+ set pattern [$widgets(entry) get]
+
+ if {[string length $pattern] == 0} {
+ # clear the current selection
+ $widgets(listbox) see 0
+ $widgets(listbox) selection clear 0 end
+ $widgets(listbox) selection anchor 0
+ $widgets(listbox) activate 0
+ return
+ }
+
+ # we're going to be searching this list...
+ set list [$widgets(listbox) get 0 end]
+
+ # if we are doing an exact match, try to find,
+ # well, an exact match
+ if {$exact} {
+ set exactMatch [lsearch -exact $list $pattern]
+ }
+
+ # search for it. We'll try to be clever and not only
+ # search for a match for what they typed, but a match for
+ # something close to what they typed. We'll keep removing one
+ # character at a time from the pattern until we find a match
+ # of some sort.
+ set index -1
+ while {$index == -1 && [string length $pattern]} {
+ set index [lsearch -glob $list "$pattern*"]
+ if {$index == -1} {
+ regsub {.$} $pattern {} pattern
+ }
+ }
+
+ # this is the item that most closely matches...
+ set thisItem [lindex $list $index]
+
+ # did we find a match? If so, do some additional munging...
+ if {$index != -1} {
+
+ # we need to find the part of the first item that is
+ # unique wrt the second... I know there's probably a
+ # simpler way to do this...
+
+ set nextIndex [expr $index + 1]
+ set nextItem [lindex $list $nextIndex]
+
+ # we don't really need to do much if the next
+ # item doesn't match our pattern...
+ if {[string match $pattern* $nextItem]} {
+ # ok, the next item matches our pattern, too
+ # now the trick is to find the first character
+ # where they *don't* match...
+ set marker [string length $pattern]
+ while {$marker <= [string length $pattern]} {
+ set a [string index $thisItem $marker]
+ set b [string index $nextItem $marker]
+ if {[string compare $a $b] == 0} {
+ append pattern $a
+ incr marker
+ } else {
+ break
+ }
+ }
+ } else {
+ set marker [string length $pattern]
+ }
+
+ } else {
+ set marker end
+ set index 0
+ }
+
+ # ok, we know the pattern and what part is unique;
+ # update the entry widget and listbox appropriately
+ if {$exact && $exactMatch == -1} {
+ $widgets(listbox) selection clear 0 end
+ $widgets(listbox) see $index
+ } else {
+ $widgets(entry) delete 0 end
+ $widgets(entry) insert end $thisItem
+ $widgets(entry) selection clear
+ $widgets(entry) selection range $marker end
+ $widgets(listbox) activate $index
+ $widgets(listbox) selection clear 0 end
+ $widgets(listbox) selection anchor $index
+ $widgets(listbox) selection set $index
+ $widgets(listbox) see $index
+ }
+}
+
+# selects an item from the list and sets the value of the combobox
+# to that value
+proc ::combobox::select {w index} {
+ upvar ::combobox::${w}::widgets widgets
+ upvar ::combobox::${w}::options options
+
+ catch {
+ set data [$widgets(listbox) get [lindex $index 0]]
+ ::combobox::setValue $widgets(this) $data
+ }
+
+ $widgets(this) close
+}
+
+# computes the geometry of the popup list based on the size of the
+# combobox. Compute size of popup by requested size of listbox
+# plus twice the bordersize of the popup.
+proc ::combobox::computeGeometry {w} {
+ upvar ::combobox::${w}::widgets widgets
+ upvar ::combobox::${w}::options options
+
+ if {$options(-height) == 0 && $options(-maxheight) != "0"} {
+ # if this is the case, count the items and see if
+ # it exceeds our maxheight. If so, set the listbox
+ # size to maxheight...
+ set nitems [$widgets(listbox) size]
+ if {$nitems > $options(-maxheight)} {
+ # tweak the height of the listbox
+ $widgets(listbox) configure -height $options(-maxheight)
+ } else {
+ # un-tweak the height of the listbox
+ $widgets(listbox) configure -height 0
+ }
+ update idletasks
+ }
+ set bd [$widgets(popup) cget -borderwidth]
+ set height [expr [winfo reqheight $widgets(listbox)] + $bd + $bd]
+ #set height [winfo reqheight $widgets(popup)]
+
+ set width [winfo reqwidth $widgets(this)]
+
+ # Compute size of listbox, allowing larger entries to expand
+ # the listbox, clipped by the screen
+ set x [winfo rootx $widgets(this)]
+ set sw [winfo screenwidth $widgets(this)]
+ if {$width > $sw - $x} {
+ # The listbox will run off the side of the screen, so clip it
+ # (and keep a 10 pixel margin).
+ set width [expr {$sw - $x - 10}]
+ }
+ set size [format "%dx%d" $width $height]
+ set y [expr {[winfo rooty $widgets(this)]+[winfo reqheight $widgets(this)] + 1}]
+ if {[expr $y + $height] >= [winfo screenheight .]} {
+ set y [expr [winfo rooty $widgets(this)] - $height]
+ }
+ set location "+[winfo rootx $widgets(this)]+$y"
+ set geometry "=${size}${location}"
+ return $geometry
+}
+
+# perform an internal widget command, then mung any error results
+# to look like it came from our megawidget. A lot of work just to
+# give the illusion that our megawidget is an atomic widget
+proc ::combobox::doInternalWidgetCommand {w subwidget command args} {
+ upvar ::combobox::${w}::widgets widgets
+ upvar ::combobox::${w}::options options
+
+ set subcommand $command
+ set command [concat $widgets($subwidget) $command $args]
+
+ if {[catch $command result]} {
+ # replace the subwidget name with the megawidget name
+ regsub $widgets($subwidget) $result $widgets($w) result
+
+ # replace specific instances of the subwidget command
+ # with out megawidget command
+ switch $subwidget,$subcommand {
+ listbox,index {regsub "index" $result "list index" result}
+ listbox,insert {regsub "insert" $result "list insert" result}
+ listbox,delete {regsub "delete" $result "list delete" result}
+ listbox,get {regsub "get" $result "list get" result}
+ listbox,size {regsub "size" $result "list size" result}
+ listbox,curselection {regsub "curselection" $result "list curselection" result}
+ }
+ error $result
+
+ } else {
+ return $result
+ }
+}
+
+
+# this is the widget proc that gets called when you do something like
+# ".checkbox configure ..."
+proc ::combobox::widgetProc {w command args} {
+ upvar ::combobox::${w}::widgets widgets
+ upvar ::combobox::${w}::options options
+
+ # this is just shorthand notation...
+ set doWidgetCommand \
+ [list ::combobox::doInternalWidgetCommand $widgets(this)]
+
+ if {$command == "list"} {
+ # ok, the next argument is a list command; we'll
+ # rip it from args and append it to command to
+ # create a unique internal command
+ #
+ # NB: because of the sloppy way we are doing this,
+ # we'll also let the user enter our secret command
+ # directly (eg: listinsert, listdelete), but we
+ # won't document that fact
+ set command "list[lindex $args 0]"
+ set args [lrange $args 1 end]
+ }
+
+ # many of these commands are just synonyms for specific
+ # commands in one of the subwidgets. We'll get them out
+ # of the way first, then do the custom commands.
+ switch $command {
+ bbox {eval $doWidgetCommand entry bbox $args}
+ delete {eval $doWidgetCommand entry delete $args}
+ get {eval $doWidgetCommand entry get $args}
+ icursor {eval $doWidgetCommand entry icursor $args}
+ index {eval $doWidgetCommand entry index $args}
+ insert {eval $doWidgetCommand entry insert $args}
+ listinsert {
+ eval $doWidgetCommand listbox insert $args
+ # pack the scrollbar if the number of items exceeds
+ # the maximum
+ if {$options(-height) == 0 && $options(-maxheight) != 0
+ && ([$widgets(listbox) size] > $options(-maxheight))} {
+ pack $widgets(vsb) -before $widgets(listbox) -side right \
+ -fill y -expand n
+ }
+ }
+ listdelete {
+ eval $doWidgetCommand listbox delete $args
+ # unpack the scrollbar if the number of items
+ # decreases under the maximum
+ if {$options(-height) == 0 && $options(-maxheight) != 0
+ && ([$widgets(listbox) size] <= $options(-maxheight))} {
+ pack forget $widgets(vsb)
+ }
+ }
+ listget {eval $doWidgetCommand listbox get $args}
+ listindex {eval $doWidgetCommand listbox index $args}
+ listsize {eval $doWidgetCommand listbox size $args}
+ listcurselection {eval $doWidgetCommand listbox curselection $args}
+
+ scan {eval $doWidgetCommand entry scan $args}
+ selection {eval $doWidgetCommand entry selection $args}
+ xview {eval $doWidgetCommand entry xview $args}
+
+ entryset {
+ # update the entry field without invoking the command
+ ::combobox::setValue $widgets(this) [lindex $args 0] 0
+ }
+
+ toggle {
+ # ignore this command if the widget is disabled...
+ if {$options(-state) == "disabled"} return
+
+ # pops down the list if it is not, hides it
+ # if it is...
+ if {[winfo ismapped $widgets(popup)]} {
+ $widgets(this) close
+ } else {
+ $widgets(this) open
+ }
+ }
+
+ open {
+ # if we are disabled, we won't allow this to happen
+ if {$options(-state) == "disabled"} {
+ return 0
+ }
+
+ # compute the geometry of the window to pop up, and set
+ # it, and force the window manager to take notice
+ # (even if it is not presently visible).
+ #
+ # this isn't strictly necessary if the window is already
+ # mapped, but we'll go ahead and set the geometry here
+ # since its harmless and *may* actually reset the geometry
+ # to something better in some weird case.
+ set geometry [::combobox::computeGeometry $widgets(this)]
+ wm geometry $widgets(popup) $geometry
+ update idletasks
+
+ # if we are already open, there's nothing else to do
+ if {[winfo ismapped $widgets(popup)]} {
+ return 0
+ }
+
+ # ok, tweak the visual appearance of things and
+ # make the list pop up
+ $widgets(button) configure -relief sunken
+ wm deiconify $widgets(popup)
+ raise $widgets(popup) [winfo parent $widgets(this)]
+ focus -force $widgets(entry)
+
+ # select something by default, but only if its an
+ # exact match...
+ ::combobox::find $widgets(this) 1
+
+ # *gasp* do a global grab!!! Mom always told not to
+ # do things like this... :-)
+ grab -global $widgets(this)
+
+ # fake the listbox into thinking it has focus
+ event generate $widgets(listbox) <B1-Enter>
+
+ return 1
+ }
+
+ close {
+ # if we are already closed, don't do anything...
+ if {![winfo ismapped $widgets(popup)]} {
+ return 0
+ }
+ # hides the listbox
+ grab release $widgets(this)
+ $widgets(button) configure -relief raised
+ wm withdraw $widgets(popup)
+
+ # select the data in the entry widget. Not sure
+ # why, other than observation seems to suggest that's
+ # what windows widgets do.
+ set editable [::combobox::getBoolean $options(-editable)]
+ if {$editable} {
+ $widgets(entry) selection range 0 end
+ $widgets(button) configure -relief raised
+ }
+
+ # magic tcl stuff (see tk.tcl in the distribution
+ # lib directory)
+ tkCancelRepeat
+
+ return 1
+ }
+
+ cget {
+ # tries to mimic the standard "cget" command
+ if {[llength $args] != 1} {
+ error "wrong # args: should be \"$widgets(this) cget option\""
+ }
+ set option [lindex $args 0]
+ return [::combobox::configure $widgets(this) cget $option]
+ }
+
+ configure {
+ # trys to mimic the standard "configure" command
+ if {[llength $args] == 0} {
+ # this isn't the same format as "real" widgets,
+ # but for now its good enough
+ foreach item [lsort [array names options]] {
+ lappend result [list $item $options($item)]
+ }
+ return $result
+
+ } elseif {[llength $args] == 1} {
+ # they are requesting configure information...
+ set option [lindex $args 0]
+ return [::combobox::configure $widgets(this) get $option]
+ } else {
+ array set tmpopt $args
+ foreach opt [array names tmpopt] {
+ ::combobox::configure $widgets(this) set $opt $tmpopt($opt)
+ }
+ }
+ }
+ default {
+ error "bad option \"$command\""
+ }
+ }
+}
+
+# handles all of the configure and cget foo
+proc ::combobox::configure {w action {option ""} {newValue ""}} {
+ upvar ::combobox::${w}::widgets widgets
+ upvar ::combobox::${w}::options options
+ set namespace "::combobox::${w}"
+
+ if {$action == "get"} {
+ # this really ought to do more than just get the value,
+ # but for the time being I don't fully support the configure
+ # command in all its glory...
+ if {$option == "-value"} {
+ return [list "-value" [$widgets(entry) get]]
+ } else {
+ return [list $option $options($option)]
+ }
+
+ } elseif {$action == "cget"} {
+ if {$option == "-value"} {
+ return [$widgets(entry) get]
+ } else {
+ return $options($option)
+ }
+
+ } else {
+
+ if {[info exists options($option)]} {
+ set oldValue $options($option)
+ set options($option) $newValue
+ } else {
+ set oldValue ""
+ set options($option) $newValue
+ }
+
+ # some (actually, most) options require us to
+ # do something, like change the attributes of
+ # a widget or two. Here's where we do that...
+ switch -- $option {
+ -background {
+ $widgets(frame) configure -background $newValue
+ $widgets(entry) configure -background $newValue
+ $widgets(listbox) configure -background $newValue
+ $widgets(vsb) configure -background $newValue
+ $widgets(vsb) configure -troughcolor $newValue
+ }
+
+ -borderwidth {
+ $widgets(frame) configure -borderwidth $newValue
+ }
+
+ -command {
+ # nothing else to do...
+ }
+
+ -cursor {
+ $widgets(frame) configure -cursor $newValue
+ $widgets(entry) configure -cursor $newValue
+ $widgets(listbox) configure -cursor $newValue
+ }
+
+ -editable {
+ if {$newValue} {
+ # it's editable...
+ $widgets(entry) configure -state normal
+ $widgets(entry) configure -bg white
+ } else {
+ global tcl_platform
+
+ $widgets(entry) configure -state disabled
+ $widgets(entry) configure -bg white
+ }
+ }
+
+ -font {
+ $widgets(entry) configure -font $newValue
+ $widgets(listbox) configure -font $newValue
+ }
+
+ -foreground {
+ $widgets(entry) configure -foreground $newValue
+ $widgets(button) configure -foreground $newValue
+ $widgets(listbox) configure -foreground $newValue
+ }
+
+ -height {
+ $widgets(listbox) configure -height $newValue
+ }
+
+ -highlightbackground {
+ $widgets(frame) configure -highlightbackground $newValue
+ }
+
+ -highlightthickness {
+ $widgets(frame) configure -highlightthickness $newValue
+ }
+
+ -image {
+ if {[string length $newValue] > 0} {
+ $widgets(button) configure -image $newValue
+ } else {
+ $widgets(button) configure -image ::combobox::bimage
+ }
+ }
+
+ -maxheight {
+ # computeGeometry may dork with the actual height
+ # of the listbox, so let's undork it
+ $widgets(listbox) configure -height $options(-height)
+ }
+
+ -relief {
+ $widgets(frame) configure -relief $newValue
+ }
+
+ -selectbackground {
+ $widgets(entry) configure -selectbackground $newValue
+ $widgets(listbox) configure -selectbackground $newValue
+ }
+
+ -selectborderwidth {
+ $widgets(entry) configure -selectborderwidth $newValue
+ $widgets(listbox) configure -selectborderwidth $newValue
+ }
+
+ -selectforeground {
+ $widgets(entry) configure -selectforeground $newValue
+ $widgets(listbox) configure -selectforeground $newValue
+ }
+
+ -state {
+ if {$newValue == "normal"} {
+ # it's enabled
+ set editable [::combobox::getBoolean \
+ $options(-editable)]
+ if {$editable} {
+ $widgets(entry) configure -state normal -takefocus 1
+ }
+ $widgets(entry) configure -fg $::combobox::enabledfg
+ } else {
+ # it's disabled
+ $widgets(entry) configure -state disabled -takefocus 0\
+ -fg $::combobox::disabledfg
+ }
+ }
+
+ -textvariable {
+ # destroy our trace on the old value, if any
+ if {[string length $oldValue] > 0} {
+ trace vdelete $oldValue w \
+ [list ::combobox::vTrace $widgets(this)]
+ }
+ # set up a trace on the new value, if any. Also, set
+ # the value of the widget to the current value of
+ # the variable
+
+ set variable ::$newValue
+ if {[string length $newValue] > 0} {
+ if {[info exists $variable]} {
+ ::combobox::setValue $widgets(this) [set $variable]
+ }
+ trace variable $variable w \
+ [list ::combobox::vTrace $widgets(this)]
+ }
+ }
+
+ -value {
+ ::combobox::setValue $widgets(this) $newValue
+ }
+
+ -width {
+ $widgets(entry) configure -width $newValue
+ $widgets(listbox) configure -width $newValue
+ }
+
+ default {
+ error "unknown option \"$option\""
+ }
+ }
+ }
+}
+
+# this proc is called whenever the user changes the value of
+# the -textvariable associated with a widget
+proc ::combobox::vTrace {w args} {
+ upvar ::combobox::${w}::widgets widgets
+ upvar ::combobox::${w}::options options
+ upvar ::combobox::${w}::ignoreTrace ignoreTrace
+
+ if {[info exists ignoreTrace]} return
+ ::combobox::setValue $widgets(this) [set ::$options(-textvariable)]
+}
+
+# sets the value of the combobox and calls the -command, if defined
+proc ::combobox::setValue {w newValue {call 1}} {
+ upvar ::combobox::${w}::widgets widgets
+ upvar ::combobox::${w}::options options
+ upvar ::combobox::${w}::ignoreTrace ignoreTrace
+ upvar ::combobox::${w}::oldValue oldValue
+
+ set editable [::combobox::getBoolean $options(-editable)]
+
+ # update the widget, no matter what. This might cause a few
+ # false triggers on a trace of the associated textvariable,
+ # but that's a chance we'll have to take.
+ $widgets(entry) configure -state normal
+ $widgets(entry) delete 0 end
+ $widgets(entry) insert 0 $newValue
+ if {!$editable || $options(-state) != "normal"} {
+ $widgets(entry) configure -state disabled
+ }
+
+ # set the associated textvariable
+ if {[string length $options(-textvariable)] > 0} {
+ set ignoreTrace 1 ;# so we don't get in a recursive loop
+ uplevel \#0 [list set $options(-textvariable) $newValue]
+ unset ignoreTrace
+ }
+
+ # Call the -command, if it exists.
+ # We could optionally check to see if oldValue == newValue
+ # first, but sometimes we want to execute the command even
+ # if the value didn't change...
+ # CYGNUS LOCAL
+ # Call it after idle, so the menu gets unposted BEFORE
+ # the command gets run... Make sure to clean up the afters
+ # so you don't try to access a dead widget...
+
+ if {$call && [string length $options(-command)] > 0} {
+ if {[info exists widgets(after)]} {
+ after cancel $widgets(after)
+ }
+ set widgets(after) [after idle $options(-command) \
+ [list $widgets(this) $newValue]\;\
+ unset ::combobox::${w}::widgets(after)]
+ }
+ set oldValue $newValue
+}
+
+# returns the value of a (presumably) boolean string (ie: it should
+# do the right thing if the string is "yes", "no", "true", 1, etc
+proc ::combobox::getBoolean {value {errorValue 1}} {
+ if {[catch {expr {([string trim $value])?1:0}} res]} {
+ return $errorValue
+ } else {
+ return $res
+ }
+}
+
+# computes the combobox widget name based on the name of one of
+# it's children widgets.. Not presently used, but might come in
+# handy...
+proc ::combobox::widgetName {w} {
+ while {$w != "."} {
+ if {[winfo class $w] == "Combobox"} {
+ return $w
+ }
+ set w [winfo parent $w]
+ }
+ error "internal error: $w is not a child of a combobox"
+}
diff --git a/libgui/library/debug.tcl b/libgui/library/debug.tcl
new file mode 100644
index 00000000000..3f3ad7c598a
--- /dev/null
+++ b/libgui/library/debug.tcl
@@ -0,0 +1,765 @@
+# -----------------------------------------------------------------------------
+# NAME:
+# ::debug
+#
+# DESC:
+# This namespace implements general-purpose debugging functions
+# to display information as a program runs. In addition, it
+# includes profiling (derived from Sage 1.1) and tracing. For
+# output it can write to files, stdout, or use a debug output
+# window.
+#
+# NOTES:
+# Output of profiler is compatible with sageview.
+#
+# -----------------------------------------------------------------------------
+
+package provide debug 1.0
+
+namespace eval ::debug {
+ namespace export debug dbug
+ variable VERSION 1.1
+ variable absolute
+ variable stack ""
+ variable outfile "trace.out"
+ variable watch 0
+ variable watchstart 0
+ variable debugwin ""
+ variable tracedVars
+ variable logfile ""
+ variable initialized 0
+ variable stoptrace 0
+ variable tracing 0
+ variable profiling 0
+ variable level 0
+
+ # here's where we'll store our collected profile data
+ namespace eval data {
+ variable entries
+ }
+
+ proc logfile {file} {
+ variable logfile
+ if {$logfile != "" && $logfile != "stdout"} {
+ catch {close $logfile}
+ }
+
+ if {$file == ""} {
+ set logfile ""
+ } elseif {$file == "stdout"} {
+ set logfile $file
+ } else {
+ set logfile [open $file w+]
+ fconfigure $logfile -buffering line
+ }
+ }
+
+# ----------------------------------------------------------------------------
+# NAME: debug::trace_var
+# SYNOPSIS: debug::trace_var {varName mode}
+# DESC: Sets up variable trace. When the trace is activated,
+# debugging messages will be displayed.
+# ARGS: varName - the variable name
+# mode - one of more of the following letters
+# r - read
+# w - write
+# u - unset
+# -----------------------------------------------------------------------------
+ proc trace_var {varName mode} {
+ variable tracedVars
+ lappend tracedVars [list $varName $mode]
+ uplevel \#0 trace variable $varName $mode ::debug::touched_by
+ }
+
+# ----------------------------------------------------------------------------
+# NAME: debug::remove_trace
+# SYNOPSIS: debug::remove_trace {var mode}
+# DESC: Removes a trace set up with "trace_var".
+# ----------------------------------------------------------------------------
+ proc remove_trace {var mode} {
+ uplevel \#0 trace vdelete $var $mode ::debug::touched_by
+ }
+
+# ----------------------------------------------------------------------------
+# NAME: debug::remove_all_traces
+# SYNOPSIS: debug::remove_all_traces
+# DESC: Removes all traces set up with "trace_var".
+# ----------------------------------------------------------------------------
+ proc remove_all_traces {} {
+ variable tracedVars
+ if {[info exists tracedVars]} {
+ foreach {elem} $tracedVars {
+ eval remove_trace $elem
+ }
+ unset tracedVars
+ }
+ }
+
+# ----------------------------------------------------------------------------
+# NAME: debug::touched_by
+# SYNOPSIS: debug::touched_by {v a m}
+# DESC: Trace function used by trace_var. Currently writes standard
+# debugging messages or priority "W".
+# ARGS: v - variable
+# a - array element or ""
+# m - mode
+# ----------------------------------------------------------------------------
+ proc touched_by {v a m} {
+ if {$a==""} {
+ upvar $v foo
+ dbug W "Variable $v touched in mode $m"
+ } else {
+ dbug W "Variable ${v}($a) touched in mode $m"
+ upvar $v($a) foo
+ }
+ dbug W "New value: $foo"
+ show_call_stack 2
+ }
+
+# ----------------------------------------------------------------------------
+# NAME: debug::show_call_stack
+# SYNOPSIS: debug::show_call_stack {{start_decr 0}}
+# DESC: Function used by trace_var to print stack trace. Currently
+# writes standard debugging messages or priority "W".
+# ARGS: start_decr - how many levels to go up to start trace
+# ----------------------------------------------------------------------------
+ proc show_call_stack {{start_decr 0}} {
+ set depth [expr {[info level] - $start_decr}]
+ if {$depth == 0} {
+ dbug W "Called at global scope"
+ } else {
+ dbug W "Stack Trace follows:"
+ for {set i $depth} {$i > 0} {incr i -1} {
+ dbug W "Level $i: [info level $i]"
+ }
+ }
+ }
+
+# ----------------------------------------------------------------------------
+# NAME: debug::createData
+# SYNOPSIS: createData { name }
+# DESC: Basically creates a data structure for storing profiling
+# information about a function.
+# ARGS: name - unique (full) function name
+# -----------------------------------------------------------------------------
+ proc createData {name} {
+ lappend data::entries $name
+
+ namespace eval data::$name {
+ variable totaltimes 0
+ variable activetime 0
+ variable proccounts 0
+ variable timers 0
+ variable timerstart 0
+ variable nest 0
+ }
+ }
+
+ proc debugwin {obj} {
+ variable debugwin
+ set debugwin $obj
+ }
+
+# -----------------------------------------------------------------------------
+# NAME: debug::debug
+#
+# SYNOPSIS: debug { {msg ""} }
+#
+# DESC: Writes a message to the proper output. The priority of the
+# message is assumed to be "I" (informational). This function
+# is provided for compatibility with the previous debug function.
+# For higher priority messages, use dbug.
+#
+# ARGS: msg - Message to be displayed.
+# -----------------------------------------------------------------------------
+
+ proc debug {{msg ""}} {
+ set cls [string trimleft [uplevel namespace current] :]
+ if {$cls == ""} {
+ set cls "global"
+ }
+
+ set i [expr {[info level] - 1}]
+ if {$i > 0} {
+ set func [lindex [info level $i] 0]
+ set i [string first "::" $func]
+ if {$i != -1} {
+ # itcl proc has class prepended to func
+ # strip it off because we already have class in $cls
+ set func [string range $func [expr {$i+2}] end]
+ }
+ } else {
+ set func ""
+ }
+
+ ::debug::_putdebug I $cls $func $msg
+ }
+
+# -----------------------------------------------------------------------------
+# NAME: debug::dbug
+#
+# SYNOPSIS: dbug { level msg }
+#
+# DESC: Writes a message to the proper output. Unlike debug, this
+# function take a priority level.
+#
+# ARGS: msg - Message to be displayed.
+# level - One of the following:
+# "I" - Informational only
+# "W" - Warning
+# "E" - Error
+# "X" - Fatal Error
+# -----------------------------------------------------------------------------
+ proc dbug {level msg} {
+ set cls [string trimleft [uplevel namespace current] :]
+ if {$cls == ""} {
+ set cls "global"
+ }
+
+ set i [expr {[info level] - 1}]
+ if {$i > 0} {
+ set func [lindex [info level $i] 0]
+ } else {
+ set func ""
+ }
+
+ ::debug::_putdebug $level $cls $func $msg
+ }
+
+# -----------------------------------------------------------------------------
+# NAME: debug::_putdebug
+#
+# SYNOPSIS: _putdebug { level cls func msg }
+#
+# DESC: Writes a message to the proper output. Will write to a debug
+# window if one is defined. Otherwise will write to stdout.
+#
+# ARGS: msg - Message to be displayed.
+# cls - name of calling itcl class or "global"
+# func - name of calling function
+# level - One of the following:
+# "I" - Informational only
+# "W" - Warning
+# "E" - Error
+# "X" - Fatal Error
+# -----------------------------------------------------------------------------
+ proc _putdebug {lev cls func msg} {
+ variable debugwin
+ variable logfile
+ if {$debugwin != ""} {
+ $debugwin puts $lev $cls $func $msg
+ }
+ if {$logfile == "stdout"} {
+ if {$func != ""} { append cls ::$func }
+ puts $logfile "$lev: ($cls) $msg"
+ } elseif {$logfile != ""} {
+ puts $logfile [concat [list $lev] [list $cls] [list $func] [list $msg]]
+ }
+ }
+
+ proc _puttrace {enter lev func {ar ""}} {
+ variable debugwin
+ variable logfile
+ variable stoptrace
+ variable tracing
+
+ if {!$tracing} { return }
+
+ set func [string trimleft $func :]
+ if {$func == "DebugWin::put_trace" || $func == "DebugWin::_buildwin"} {
+ if {$enter} {
+ incr stoptrace
+ } else {
+ incr stoptrace -1
+ }
+ }
+
+ if {$stoptrace == 0} {
+ incr stoptrace
+ # strip off leading function name
+ set ar [lrange $ar 1 end]
+ if {$debugwin != ""} {
+ $debugwin put_trace $enter $lev $func $ar
+ }
+
+ if {$logfile != ""} {
+ puts $logfile [concat {T} [list $enter] [list $lev] [list $func] \
+ [list $ar]]
+ }
+ incr stoptrace -1
+ }
+ }
+
+# -----------------------------------------------------------------------------
+# NAME: debug::init
+# SYNOPSIS: init
+# DESC: Installs hooks in all procs and methods to enable profiling
+# and tracing.
+# NOTES: Installing these hooks slows loading of the program. Running
+# with the hooks installed will cause significant slowdown of
+# program execution.
+# -----------------------------------------------------------------------------
+ proc init {} {
+ variable VERSION
+ variable absolute
+ variable initialized
+
+ # create the arrays for the .global. level
+ createData .global.
+
+ # start the absolute timer
+ set absolute [clock clicks]
+
+ # rename waits, exit, and all the ways of declaring functions
+ rename ::vwait ::original_vwait
+ interp alias {} ::vwait {} [namespace current]::sagevwait
+ createData .wait.
+
+ rename ::tkwait ::original_tkwait
+ interp alias {} ::tkwait {} [namespace current]::sagetkwait
+
+ rename ::exit ::original_exit
+ interp alias {} ::exit {} [namespace current]::sageexit
+
+ rename ::proc ::original_proc
+ interp alias {} ::proc {} [namespace current]::sageproc
+
+ rename ::itcl::parser::method ::original_method
+ interp alias {} ::itcl::parser::method {} [namespace current]::sagemethod
+
+ rename ::itcl::parser::proc ::original_itclproc
+ interp alias {} ::itcl::parser::proc {} [namespace current]::sageitclproc
+
+ rename ::body ::original_itclbody
+ interp alias {} ::body {} [namespace current]::sageitclbody
+
+ # redefine core procs
+ # foreach p [uplevel \#0 info procs] {
+ # set args ""
+ # set default ""
+ # # get the list of args (some could be defaulted)
+ # foreach arg [info args $p] {
+ # if { [info default $p $arg default] } {
+ # lappend args [list $arg $default]
+ # } else {
+ # lappend args $arg
+ # }
+ # }
+ # uplevel \#0 proc [list $p] [list $args] [list [info body $p]]
+ #}
+
+ set initialized 1
+ resetWatch 0
+ procEntry .global.
+ startWatch
+ }
+
+# -----------------------------------------------------------------------------
+# NAME: ::debug::trace_start
+# SYNOPSIS: ::debug::trace_start
+# DESC: Starts logging of function trace information.
+# -----------------------------------------------------------------------------
+ proc trace_start {} {
+ variable tracing
+ set tracing 1
+ }
+
+# -----------------------------------------------------------------------------
+# NAME: ::debug::trace_stop
+# SYNOPSIS: ::debug::trace_stop
+# DESC: Stops logging of function trace information.
+# -----------------------------------------------------------------------------
+ proc trace_stop {} {
+ variable tracing
+ set tracing 0
+ }
+
+# -----------------------------------------------------------------------------
+# NAME: debug::sagetkwait
+# SYNOPSIS: sagetkwait {args}
+# DESC: A wrapper function around tkwait so we know how much time the
+# program is spending in the wait state.
+# ARGS: args - args to pass to tkwait
+# ----------------------------------------------------------------------------
+ proc sagetkwait {args} {
+ # simulate going into the .wait. proc
+ stopWatch
+ procEntry .wait.
+ startWatch
+ uplevel ::original_tkwait $args
+ # simulate the exiting of this proc
+ stopWatch
+ procExit .wait.
+ startWatch
+ }
+
+# ----------------------------------------------------------------------------
+# NAME: debug::sagevwait
+# SYNOPSIS: sagevwait {args}
+# DESC: A wrapper function around vwait so we know how much time the
+# program is spending in the wait state.
+# ARGS: args - args to pass to vwait
+# ----------------------------------------------------------------------------
+ proc sagevwait {args} {
+ # simulate going into the .wait. proc
+ stopWatch
+ procEntry .wait.
+ startWatch
+ uplevel ::original_vwait $args
+ # simulate the exiting of this proc
+ stopWatch
+ procExit .wait.
+ startWatch
+ }
+
+# -----------------------------------------------------------------------------
+# NAME: debug::sageexit
+# SYNOPSIS: sageexit {{value 0}}
+# DESC: A wrapper function around exit so we can turn off profiling
+# and tracing before exiting.
+# ARGS: value - value to pass to exit
+# -----------------------------------------------------------------------------
+ proc sageexit {{value 0}} {
+ variable program_name GDBtk
+ variable program_args ""
+ variable absolute
+
+ # stop the stopwatch
+ stopWatch
+
+ set totaltime [getWatch]
+
+ # stop the absolute timer
+ set stop [clock clicks]
+
+ # unwind the stack and turn off everyone's timers
+ stackUnwind
+
+ # disengage the proc callbacks
+ ::original_proc procEntry {name} {}
+ ::original_proc procExit {name args} {}
+ ::original_proc methodEntry {name} {}
+ ::original_proc methodExit {name args} {}
+
+ set absolute [expr {$stop - $absolute}]
+
+ # get the sage overhead time
+ set sagetime [expr {$absolute - $totaltime}]
+
+ # save the data
+ variable outfile
+ variable VERSION
+ set f [open $outfile w]
+ puts $f "set VERSION {$VERSION}"
+ puts $f "set program_name {$program_name}"
+ puts $f "set program_args {$program_args}"
+ puts $f "set absolute $absolute"
+ puts $f "set sagetime $sagetime"
+ puts $f "set totaltime $totaltime"
+
+ foreach procname $data::entries {
+ set totaltimes($procname) [set data::${procname}::totaltimes]
+ set proccounts($procname) [set data::${procname}::proccounts]
+ set timers($procname) [set data::${procname}::timers]
+ }
+
+ puts $f "array set totaltimes {[array get totaltimes]}"
+ puts $f "array set proccounts {[array get proccounts]}"
+ puts $f "array set timers {[array get timers]}"
+ close $f
+ original_exit $value
+ }
+
+
+ proc sageproc {name args body} {
+ # stop the watch
+ stopWatch
+
+ # update the name to include the namespace if it doesn't have one already
+ if {[string range $name 0 1] != "::"} {
+ # get the namespace this proc is being defined in
+ set ns [uplevel namespace current]
+ if { $ns == "::" } {
+ set ns ""
+ }
+ set name ${ns}::$name
+ }
+
+ createData $name
+ # create the callbacks for proc entry and exit
+ set ns [namespace current]
+ set extra "${ns}::stopWatch;"
+ append extra "set __.__ {};trace variable __.__ u {${ns}::stopWatch;${ns}::procExit $name;${ns}::startWatch};"
+ append extra "[namespace current]::procEntry $name;"
+ append extra "[namespace current]::startWatch;"
+
+ set args [list $args]
+ set body [list [concat $extra $body]]
+
+ startWatch
+
+ # define the proc with our extra stuff snuck in
+ uplevel ::original_proc $name $args $body
+ }
+
+ proc sageitclbody {name args body} {
+ # stop the watch
+ stopWatch
+
+ if {$name == "iwidgets::Scrolledwidget::_scrollWidget"} {
+ # Hack. This causes too many problems for the scrolled debug window
+ # so just don't include it in the profile functions.
+ uplevel ::original_itclbody $name [list $args] [list $body]
+ return
+ }
+
+ set fullname $name
+ # update the name to include the namespace if it doesn't have one already
+ if {[string range $name 0 1] != "::"} {
+ # get the namespace this proc is being defined in
+ set ns [uplevel namespace current]
+ if { $ns == "::" } {
+ set ns ""
+ }
+ set fullname ${ns}::$name
+ }
+
+ createData $fullname
+ # create the callbacks for proc entry and exit
+ set ns [namespace current]
+ set extra "${ns}::stopWatch;"
+ append extra "set __.__ {};trace variable __.__ u {${ns}::stopWatch;${ns}::procExit $fullname;${ns}::startWatch};"
+ append extra "[namespace current]::procEntry $fullname;"
+ append extra "[namespace current]::startWatch;"
+
+ set args [list $args]
+ set body [list [concat $extra $body]]
+
+ startWatch
+
+ # define the proc with our extra stuff snuck in
+ uplevel ::original_itclbody $name $args $body
+ }
+
+ proc sageitclproc {name args} {
+ # stop the watch
+ stopWatch
+
+ set body [lindex $args 1]
+ set args [lindex $args 0]
+
+ if {$body == ""} {
+ set args [list $args]
+ set args [concat $args $body]
+ } else {
+ # create the callbacks for proc entry and exit
+ set ns [namespace current]
+ set extra "${ns}::stopWatch;"
+ append extra "set __.__ {};trace variable __.__ u {${ns}::stopWatch;${ns}::methodExit $name;${ns}::startWatch};"
+ append extra "[namespace current]::methodEntry $name;"
+ append extra "[namespace current]::startWatch;"
+
+ set args [list $args [concat $extra $body]]
+ }
+
+ startWatch
+ uplevel ::original_itclproc $name $args
+ }
+
+ proc sagemethod {name args} {
+ # stop the watch
+ stopWatch
+
+ set body [lindex $args 1]
+ set args [lindex $args 0]
+
+ if {[string index $body 0] == "@" || $body == ""} {
+ set args [list $args]
+ set args [concat $args $body]
+ } else {
+ # create the callbacks for proc entry and exit
+ set ns [namespace current]
+ set extra "${ns}::stopWatch;"
+ append extra "set __.__ {};trace variable __.__ u {${ns}::stopWatch;${ns}::methodExit $name;${ns}::startWatch};"
+ append extra "[namespace current]::methodEntry $name;"
+ append extra "[namespace current]::startWatch;"
+
+ set args [list $args [concat $extra $body]]
+ }
+
+ startWatch
+ uplevel ::original_method $name $args
+ }
+
+ proc push {v} {
+ variable stack
+ variable level
+ lappend stack $v
+ incr level
+ }
+
+ proc pop {} {
+ variable stack
+ variable level
+ set v [lindex $stack end]
+ set stack [lreplace $stack end end]
+ incr level -1
+ return $v
+ }
+
+ proc look {} {
+ variable stack
+ return [lindex $stack end]
+ }
+
+ proc stackUnwind {} {
+ # Now unwind all the stacked procs by calling procExit on each.
+ # It is OK to use procExit on methods because the full name
+ # was pushed on the stack
+ while { [set procname [look]] != "" } {
+ procExit $procname
+ }
+ }
+
+ # we need args because this is part of a trace callback
+ proc startWatch {args} {
+ variable watchstart
+ set watchstart [clock clicks]
+ }
+
+ proc resetWatch {value} {
+ variable watch
+ set watch $value
+ }
+
+ proc stopWatch {} {
+ variable watch
+ variable watchstart
+ set watch [expr {$watch + ([clock clicks] - $watchstart)}]
+ return $watch
+ }
+
+ proc getWatch {} {
+ variable watch
+ return $watch
+ }
+
+ proc startTimer {v} {
+ if { $v != "" } {
+ set data::${v}::timerstart [getWatch]
+ }
+ }
+
+ proc stopTimer {v} {
+ if { $v == "" } return
+ set stop [getWatch]
+ set data::${v}::timers [expr {[set data::${v}::timers] + ($stop - [set data::${v}::timerstart])}]
+ }
+
+ proc procEntry {procname} {
+ variable level
+ _puttrace 1 $level $procname [uplevel info level [uplevel info level]]
+
+ set time [getWatch]
+
+ # stop the timer of the caller
+ set caller [look]
+ stopTimer $caller
+
+ incr data::${procname}::proccounts
+
+ if { [set data::${procname}::nest] == 0 } {
+ set data::${procname}::activetime $time
+ }
+ incr data::${procname}::nest
+
+ # push this proc on the stack
+ push $procname
+
+ # start the timer for this
+ startTimer $procname
+ }
+
+ proc methodEntry {procname} {
+ variable level
+
+ set time [getWatch]
+
+ # stop the timer of the caller
+ set caller [look]
+ stopTimer $caller
+
+ # get the namespace this method is in
+ set ns [uplevel namespace current]
+ if { $ns == "::" } {
+ set ns ""
+ }
+ set name ${ns}::$procname
+ _puttrace 1 $level $name [uplevel info level [uplevel info level]]
+
+ if {![info exists data::${name}::proccounts]} {
+ createData $name
+ }
+
+ incr data::${name}::proccounts
+
+ if { [set data::${name}::nest] == 0 } {
+ set data::${name}::activetime $time
+ }
+ incr data::${name}::nest
+
+ # push this proc on the stack
+ push $name
+
+ # start the timer for this
+ startTimer $name
+ }
+
+ # we need the args because this is called from a vartrace handler
+ proc procExit {procname args} {
+ variable level
+
+ set time [getWatch]
+ # stop the timer of the proc
+ stopTimer [pop]
+
+ _puttrace 0 $level $procname
+
+ set r [incr data::${procname}::nest -1]
+ if { $r == 0 } {
+ set data::${procname}::totaltimes \
+ [expr {[set data::${procname}::totaltimes] \
+ + ($time - [set data::${procname}::activetime])}]
+ }
+
+ # now restart the timer of the caller
+ startTimer [look]
+ }
+
+ proc methodExit {procname args} {
+ variable level
+
+ set time [getWatch]
+ # stop the timer of the proc
+ stopTimer [pop]
+
+ # get the namespace this method is in
+ set ns [uplevel namespace current]
+ if { $ns == "::" } {
+ set ns ""
+ }
+ set procname ${ns}::$procname
+
+ _puttrace 0 $level $procname
+
+ set r [incr data::${procname}::nest -1]
+ if { $r == 0 } {
+ set data::${procname}::totaltimes \
+ [expr {[set data::${procname}::totaltimes] \
+ + ($time - [set data::${procname}::activetime])}]
+ }
+
+ # now restart the timer of the caller
+ startTimer [look]
+ }
+}
diff --git a/libgui/library/def.tcl b/libgui/library/def.tcl
new file mode 100644
index 00000000000..22c7da5e537
--- /dev/null
+++ b/libgui/library/def.tcl
@@ -0,0 +1,29 @@
+# def.tcl - Definining commands.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+# Define a global array.
+proc defarray {name {value {}}} {
+ upvar \#0 $name ary
+
+ if {! [info exists ary]} then {
+ set ary(_) {}
+ unset ary(_)
+ array set ary $value
+ }
+}
+
+# Define a global variable.
+proc defvar {name {value {}}} {
+ upvar \#0 $name var
+ if {! [info exists var]} then {
+ set var $value
+ }
+}
+
+# Define a "constant". For now this is just a pretty way to declare a
+# global variable.
+proc defconst {name value} {
+ upvar \#0 $name var
+ set var $value
+}
diff --git a/libgui/library/font.tcl b/libgui/library/font.tcl
new file mode 100644
index 00000000000..baa1b05819f
--- /dev/null
+++ b/libgui/library/font.tcl
@@ -0,0 +1,26 @@
+# font.tcl - Font handling.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+
+# This function is called whenever a font preference changes. We use
+# this information to update the appropriate symbolic font.
+proc FONT_track_change {symbolic prefname value} {
+ eval font configure [list $symbolic] $value
+}
+
+# Primary interface to font handling.
+# define_font SYMBOLIC_NAME ARGS
+# Define a new font, named SYMBOLIC_NAME. ARGS is the default font
+# specification; it is a list of options such as those passed to `font
+# create'.
+proc define_font {symbolic args} {
+ # We do a little trick with the names here, by inserting `font' in
+ # the appropriate place in the name.
+ set split [split $symbolic /]
+ set name [join [linsert $split 1 font] /]
+
+ pref define $name $args
+ eval font create [list $symbolic] [pref get $name]
+ pref add_hook $name [list FONT_track_change $symbolic]
+}
diff --git a/libgui/library/gensym.tcl b/libgui/library/gensym.tcl
new file mode 100644
index 00000000000..a2dbdd672bf
--- /dev/null
+++ b/libgui/library/gensym.tcl
@@ -0,0 +1,13 @@
+# gensym.tcl - Generate new symbols.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+# Internal counter used to provide new symbol names.
+defvar GENSYM_counter 0
+
+# Return a new "symbol". This proc hopes that nobody else decides to
+# use its prefix.
+proc gensym {} {
+ global GENSYM_counter
+ return __gensym_symbol_[incr GENSYM_counter]
+}
diff --git a/libgui/library/gettext.tcl b/libgui/library/gettext.tcl
new file mode 100644
index 00000000000..8ba8bb7450f
--- /dev/null
+++ b/libgui/library/gettext.tcl
@@ -0,0 +1,7 @@
+# gettext.tcl - some stubs
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+proc gettext {str} {
+ return $str
+}
diff --git a/libgui/library/hooks.tcl b/libgui/library/hooks.tcl
new file mode 100644
index 00000000000..fd6e9a5c1ef
--- /dev/null
+++ b/libgui/library/hooks.tcl
@@ -0,0 +1,35 @@
+# hooks.tcl - Hook functions.
+# Copyright (C) 1997, 1999 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+proc add_hook {hook command} {
+ upvar \#0 $hook var
+ lappend var $command
+}
+
+proc remove_hook {hook command} {
+ upvar \#0 $hook var
+ set var [lremove $var $command]
+}
+
+proc define_hook {hook} {
+ upvar \#0 $hook var
+
+ if {! [info exists var]} then {
+ set var {}
+ }
+}
+
+proc run_hooks {hook args} {
+ upvar \#0 $hook var
+ set mssg_list {}
+ foreach thunk $var {
+ if {[catch {uplevel \#0 $thunk $args} mssg]} {
+ set errStr "hook=$thunk args=\"$args\" $mssg\n"
+ lappend mssg_list $errStr
+ }
+ }
+ if {$mssg_list != ""} {
+ error $mssg_list
+ }
+}
diff --git a/libgui/library/internet.tcl b/libgui/library/internet.tcl
new file mode 100644
index 00000000000..963488eae71
--- /dev/null
+++ b/libgui/library/internet.tcl
@@ -0,0 +1,64 @@
+#
+# internet.tcl - tcl interface to various internet functions
+#
+# Copyright (C) 1998 Cygnus Solutions
+#
+
+# ------------------------------------------------------------------
+# send_mail - send email
+# ------------------------------------------------------------------
+
+proc send_mail {to subject body} {
+ global tcl_platform
+
+ switch -- $tcl_platform(platform) {
+ windows {
+ ide_mapi simple-send $to $subject $body
+ }
+ unix {
+ exec echo $body | mail -s $subject $to &
+ }
+ default {
+ error "platform \"$tcl_platform(platform)\" not supported"
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# open_url - open a URL in a browser
+# Netscape must be available for Unix.
+# ------------------------------------------------------------------
+
+proc open_url {url} {
+ global tcl_platform
+ switch -- $tcl_platform(platform) {
+ windows {
+ ide_shell_execute open $url
+ # FIXME. can we detect errors?
+ }
+ unix {
+ if {[catch "exec netscape -remote [list openURL($url,new-window)]" result]} {
+ if {[string match {*not running on display*} $result]} {
+ # Netscape is not running. Try to start it.
+ if {[catch "exec netscape [list $url] &" result]} {
+ tk_dialog .warn "Netscape Error" "$result" error 0 Ok
+ return 0
+ }
+ } elseif {[string match {couldn't execute *} $result]} {
+ tk_dialog .warn "Netscape Error" "Cannot locate \"netscape\" on your system.\nIt must be installed and in your path." error 0 Ok
+ return 0
+ } else {
+ tk_dialog .warn "Netscape Error" "$result" error 0 Ok
+ return 0
+ }
+ }
+ }
+ default {
+ error "platform \"$tcl_platform(platform)\" not supported"
+ return 0
+ }
+ }
+ return 1
+}
+
+
diff --git a/libgui/library/lframe.tcl b/libgui/library/lframe.tcl
new file mode 100644
index 00000000000..6432a0b5647
--- /dev/null
+++ b/libgui/library/lframe.tcl
@@ -0,0 +1,19 @@
+# lframe.tcl - Labelled frame widget.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+itcl_class Labelledframe {
+ inherit Widgetframe
+
+ # The label text.
+ public text {} {
+ if {[winfo exists [namespace tail $this].label]} then {
+ [namespace tail $this].label configure -text $text
+ }
+ }
+
+ constructor {config} {
+ label [namespace tail $this].label -text $text -padx 2
+ _add [namespace tail $this].label
+ }
+}
diff --git a/libgui/library/list.tcl b/libgui/library/list.tcl
new file mode 100644
index 00000000000..ae8cf29f469
--- /dev/null
+++ b/libgui/library/list.tcl
@@ -0,0 +1,83 @@
+# list.tcl - Some handy list procs.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+# FIXME: some are from TclX; we should probably just use the C
+# implementation that is in S-N.
+
+proc lvarpush {listVar element {index 0}} {
+ upvar $listVar var
+ if {![info exists var]} then {
+ lappend var $element
+ } else {
+ set var [linsert $var $index $element]
+ }
+}
+
+proc lvarpop {listVar {index 0}} {
+ upvar $listVar var
+ set result [lindex $var $index]
+ # NOTE lreplace can fail if list is empty.
+ if {! [catch {lreplace $var $index $index} new]} then {
+ set var $new
+ }
+ return $result
+}
+
+proc lassign {list args} {
+ set len [expr {[llength $args] - 1}]
+
+ # Special-case last element: if LIST is longer than ARGS, assign a
+ # list of leftovers to the last variable.
+ if {[llength $list] - 1 > $len} then {
+ upvar [lindex $args $len] local
+ set local [lrange $list $len end]
+ incr len -1
+ }
+
+ while {$len >= 0} {
+ upvar [lindex $args $len] local
+ set local [lindex $list $len]
+ incr len -1
+ }
+}
+
+# Remove duplicates and sort list. ARGS are arguments to lsort, eg
+# --increasing.
+proc lrmdups {list args} {
+ set slist [eval lsort $args [list $list]]
+ set last [lvarpop slist]
+ set result [list $last]
+ foreach item $slist {
+ if {$item != $last} then {
+ set last $item
+ lappend result $item
+ }
+ }
+ return $result
+}
+
+proc lremove {list element} {
+ set index [lsearch -exact $list $element]
+ if {$index == -1} then {
+ return $list
+ }
+ return [lreplace $list $index $index]
+}
+
+# replace element with new element
+proc lrep {list element new} {
+ set index [lsearch -exact $list $element]
+ if {$index == -1} {
+ return $list
+ }
+ return [lreplace $list $index $index $new]
+}
+
+# FIXME: this isn't precisely like the C lvarcat. It is slower.
+proc lvarcat {listVar args} {
+ upvar $listVar var
+ if {[join $args] != ""} then {
+ # Yuck!
+ eval eval lappend var $args
+ }
+}
diff --git a/libgui/library/looknfeel.tcl b/libgui/library/looknfeel.tcl
new file mode 100644
index 00000000000..dbffe269f6f
--- /dev/null
+++ b/libgui/library/looknfeel.tcl
@@ -0,0 +1,48 @@
+# looknfeel.tcl - Standard look and feel decisions.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+# Run this once just after Tk is initialized. It will do whatever
+# setup is required to make the application conform to our look and
+# feel.
+proc standard_look_and_feel {} {
+ global tcl_platform
+
+ # FIXME: this is really gross: we know how tk_dialog chooses its
+ # -wraplength, and we make it bigger. Instead we should make our
+ # own dialog function.
+ option add *Dialog.msg.wrapLength 0 startupFile
+
+ # We don't ever want tearoffs.
+ option add *Menu.tearOff 0 startupFile
+
+ # The default font should be used by default.
+ # The bold font is like the default font, but is bold; use it for
+ # emphasis.
+ # The fixed font is guaranteed not to be proportional.
+ # The status font should be used in status bars and tooltips.
+ if {$tcl_platform(platform) == "windows"} then {
+ define_font global/default -family windows-message
+ # FIXME: this isn't actually a bold font...
+ define_font global/bold -family windows-caption
+ define_font global/fixed -family fixedsys
+ define_font global/status -family windows-status
+ # FIXME: we'd like this font to update automatically as well. But
+ # for now we can't.
+ array set actual [font actual windows-message]
+ set actual(-slant) italic
+ eval define_font global/italic [array get actual]
+ define_font global/menu -family windows-menu
+ } else {
+ define_font global/default -family courier -size 9
+ define_font global/bold -family courier -size 9 -weight bold
+ define_font global/fixed -family courier -size 9
+ define_font global/status -family courier -size 9
+ define_font global/italic -family courier -size 9 -slant italic
+ define_font global/menu -family courier -size 9
+ }
+
+ # Make sure this font is actually used by default.
+ option add *Font global/default
+ option add *Menu.Font global/menu
+}
diff --git a/libgui/library/menu.tcl b/libgui/library/menu.tcl
new file mode 100644
index 00000000000..d178061a1ef
--- /dev/null
+++ b/libgui/library/menu.tcl
@@ -0,0 +1,39 @@
+# menu.tcl - Useful proc for dealing with menus.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+# This proc computes the "desired width" of a menu. It can be used to
+# determine the minimum width for a toplevel whose -menu option is
+# set.
+proc compute_menu_width {menu} {
+ set width 0
+ set last [$menu index end]
+ if {$last != "end"} then {
+ # Start at borderwidth, but also preserve borderwidth on the
+ # right.
+ incr width [expr {2 * [$menu cget -borderwidth]}]
+
+ set deffont [$menu cget -font]
+ set abw [expr {2 * [$menu cget -activeborderwidth]}]
+ for {set i 0} {$i <= $last} {incr i} {
+ if {[catch {$menu entrycget $i -font} font]} then {
+ continue
+ }
+ if {$font == ""} then {
+ set font $deffont
+ }
+ incr width [font measure $font [$menu entrycget $i -label]]
+ incr width $abw
+ # "10" was chosen by reading tkUnixMenu.c.
+ incr width 10
+ # This is arbitrary. Apparently I can't read tkUnixMenu.c well
+ # enough to understand why the naive calculation above doesn't
+ # work.
+ incr width 2
+ }
+ # Another hack.
+ incr width 2
+ }
+
+ return $width
+}
diff --git a/libgui/library/mono.tcl b/libgui/library/mono.tcl
new file mode 100644
index 00000000000..7b4abb25ef4
--- /dev/null
+++ b/libgui/library/mono.tcl
@@ -0,0 +1,14 @@
+# mono.tcl - Dealing with monochrome.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+# It is safe to run this any number of times, so it is ok to have it
+# here. Defined as true if the user wants monochrome display.
+pref define global/monochrome 0
+
+# Return 1 if monochrome, 0 otherwise. This should be used to make
+# the application experience more friendly for colorblind users as
+# well as those stuck on mono displays.
+proc monochrome_p {} {
+ return [expr {[pref get global/monochrome] || [winfo depth .] == 1}]
+}
diff --git a/libgui/library/multibox.tcl b/libgui/library/multibox.tcl
new file mode 100644
index 00000000000..3cd5c035639
--- /dev/null
+++ b/libgui/library/multibox.tcl
@@ -0,0 +1,251 @@
+# multibox.tcl - Multi-column listbox.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+# FIXME:
+# * Should support sashes so user can repartition widget sizes.
+# * Should support itemcget, itemconfigure.
+
+itcl_class Multibox {
+ # The selection mode.
+ public selectmode browse {
+ _apply_all configure [list -selectmode $selectmode]
+ }
+
+ # The height.
+ public height 10 {
+ _apply_all configure [list -height $height]
+ }
+
+ # This is a list of all the listbox widgets we've created. Private
+ # variable.
+ protected _listboxen {}
+
+ # Tricky: take the class bindings for the Listbox widget and turn
+ # them into Multibox bindings that directly run our bindings. That
+ # way any binding on any of our children will automatically work the
+ # right way.
+ # FIXME: this loses if any Listbox bindings are added later.
+ # To really fix we need Uhler's change to support megawidgets.
+ foreach seq [bind Listbox] {
+ regsub -all -- %W [bind Listbox $seq] {[winfo parent %W]} sub
+ bind Multibox $seq $sub
+ }
+
+ constructor {config} {
+ # The standard widget-making trick.
+ set class [$this info class]
+ set hull [namespace tail $this]
+ set old_name $this
+ ::rename $this $this-tmp-
+ ::frame $hull -class $class -relief flat -borderwidth 0
+ ::rename $hull $old_name-win-
+ ::rename $this $old_name
+
+ scrollbar [namespace tail $this].vs -orient vertical
+ bind [namespace tail $this].vs <Destroy> [list $this delete]
+
+ grid rowconfigure [namespace tail $this] 0 -weight 0
+ grid rowconfigure [namespace tail $this] 1 -weight 1
+ }
+
+ destructor {
+ destroy $this
+ }
+
+ #
+ # Our interface.
+ #
+
+ # Add a new column.
+ method add {args} {
+ # The first array set sets up the default values, and the second
+ # overwrites with what the user wants.
+ array set opts {-width 20 -fix 0 -title Zardoz}
+ array set opts $args
+
+ set num [llength $_listboxen]
+ listbox [namespace tail $this].box$num -exportselection 0 -height $height \
+ -selectmode $selectmode -width $opts(-width)
+ if {$num == 0} then {
+ [namespace tail $this].box$num configure -yscrollcommand [list [namespace tail $this].vs set]
+ [namespace tail $this].vs configure -command [list $this yview]
+ }
+ label [namespace tail $this].label$num -text $opts(-title) -anchor w
+
+ # No more class bindings.
+ set tag_list [bindtags [namespace tail $this].box$num]
+ set index [lsearch -exact $tag_list Listbox]
+ bindtags [namespace tail $this].box$num [lreplace $tag_list $index $index Multibox]
+
+ grid [namespace tail $this].label$num -row 0 -column $num -sticky new
+ grid [namespace tail $this].box$num -row 1 -column $num -sticky news
+ if {$opts(-fix)} then {
+ grid columnconfigure [namespace tail $this] $num -weight 0 \
+ -minsize [winfo reqwidth [namespace tail $this].box$num]
+ } else {
+ grid columnconfigure [namespace tail $this] $num -weight 1
+ }
+
+ lappend _listboxen [namespace tail $this].box$num
+
+ # Move the scrollbar over.
+ incr num
+ grid [namespace tail $this].vs -row 1 -column $num -sticky nsw
+ grid columnconfigure [namespace tail $this] $num -weight 0
+ }
+
+ method configure {config} {}
+
+ # FIXME: should handle automatically.
+ method cget {option} {
+ switch -- $option {
+ -selectmode {
+ return $selectmode
+ }
+ -height {
+ return $height
+ }
+
+ default {
+ error "option $option not supported"
+ }
+ }
+ }
+
+ # FIXME: this isn't ideal. But we want to support adding bindings
+ # at least. A "bind" method might be better.
+ method get_boxes {} {
+ return $_listboxen
+ }
+
+
+ #
+ # Methods that duplicate Listbox interface.
+ #
+
+ method activate index {
+ _apply_all activate [list $index]
+ }
+
+ method bbox index {
+ error "bbox method not supported"
+ }
+
+ method curselection {} {
+ return [_apply_first curselection {}]
+ }
+
+ # FIXME: In itcl 1.5, can't have a method name "delete". Sigh.
+ method delete_hack {args} {
+ _apply_all delete $args
+ }
+
+ # Return some contents. We return each item as a list of the
+ # columns.
+ method get {first {last {}}} {
+ if {$last == ""} then {
+ set r {}
+ foreach l $_listboxen {
+ lappend r [$l get $first]
+ }
+ return $r
+ } else {
+ # We do things this way so that we don't have to specially
+ # handle the index "end".
+ foreach box $_listboxen {
+ set seen(var-$box) [$box get $first $last]
+ }
+
+ # Tricky: we use the array indices as variable names and the
+ # array values as values. This lets us "easily" construct the
+ # result lists.
+ set r {}
+ eval foreach [array get seen] {{
+ set elt {}
+ foreach box $_listboxen {
+ lappend elt [set var-$box]
+ }
+ lappend r $elt
+ }}
+ return $r
+ }
+ }
+
+ method index index {
+ return [_apply_first index [list $index]]
+ }
+
+ # Insert some items. Each new item is a list of items for all
+ # columns.
+ method insert {index args} {
+ if {[llength $args]} then {
+ set seen(_) {}
+ unset seen(_)
+
+ foreach value $args {
+ foreach columnvalue $value lname $_listboxen {
+ lappend seen($lname) $columnvalue
+ }
+ }
+
+ foreach box $_listboxen {
+ eval $box insert $index $seen($box)
+ }
+ }
+ }
+
+ method nearest y {
+ return [_apply_first nearest [list $y]]
+ }
+
+ method scan {option args} {
+ _apply_all scan $option $args
+ }
+
+ method see index {
+ _apply_all see [list $index]
+ }
+
+ method selection {option args} {
+ if {$option == "includes"} then {
+ return [_apply_first selection [concat $option $args]]
+ } else {
+ return [_apply_all selection [concat $option $args]]
+ }
+ }
+
+ method size {} {
+ return [_apply_first size {}]
+ }
+
+ method xview args {
+ error "xview method not supported"
+ }
+
+ method yview args {
+ if {! [llength $args]} then {
+ return [_apply_first yview {}]
+ } else {
+ return [_apply_all yview $args]
+ }
+ }
+
+
+ #
+ # Private methods.
+ #
+
+ # This applies METHOD to every listbox.
+ method _apply_all {method argList} {
+ foreach l $_listboxen {
+ eval $l $method $argList
+ }
+ }
+
+ # This applies METHOD to the first listbox, and returns the result.
+ method _apply_first {method argList} {
+ set l [lindex $_listboxen 0]
+ return [eval $l $method $argList]
+ }
+}
diff --git a/libgui/library/pane.tcl b/libgui/library/pane.tcl
new file mode 100644
index 00000000000..1cdaa359e77
--- /dev/null
+++ b/libgui/library/pane.tcl
@@ -0,0 +1,136 @@
+#
+# Cygnus enhanced version of the iwidget Pane class
+# ----------------------------------------------------------------------
+# Implements a pane for a paned window widget. The pane is itself a
+# frame with a child site for other widgets. The pane class performs
+# basic option management.
+#
+# ----------------------------------------------------------------------
+# AUTHOR: Mark L. Ulferts EMAIL: mulferts@austin.dsccc.com
+#
+# @(#) $Id$
+# ----------------------------------------------------------------------
+# Copyright (c) 1995 DSC Technologies Corporation
+# ======================================================================
+# Permission to use, copy, modify, distribute and license this software
+# and its documentation for any purpose, and without fee or written
+# agreement with DSC, is hereby granted, provided that the above copyright
+# notice appears in all copies and that both the copyright notice and
+# warranty disclaimer below appear in supporting documentation, and that
+# the names of DSC Technologies Corporation or DSC Communications
+# Corporation not be used in advertising or publicity pertaining to the
+# software without specific, written prior permission.
+#
+# DSC DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+# ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, AND NON-
+# INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE
+# AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE,
+# SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS. IN NO EVENT SHALL
+# DSC BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+# ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+# WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTUOUS ACTION,
+# ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+# SOFTWARE.
+# ======================================================================
+
+#
+# Usual options.
+#
+itk::usual Pane {
+ keep -background -cursor
+}
+
+# ------------------------------------------------------------------
+# PANE
+# ------------------------------------------------------------------
+class cyg::Pane {
+ inherit itk::Widget
+
+ constructor {args} {}
+
+ itk_option define -maximum maximum Maximum 0
+ itk_option define -minimum minimum Minimum 10
+ itk_option define -margin margin Margin 0
+ itk_option define -resizable resizable Resizable 1
+
+ public method childSite {} {}
+}
+
+#
+# Provide a lowercased access method for the Pane class.
+#
+proc ::cyg::pane {pathName args} {
+ uplevel ::cyg::Pane $pathName $args
+}
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body cyg::Pane::constructor {args} {
+ #
+ # Create the pane childsite.
+ #
+ itk_component add childsite {
+ frame $itk_interior.childsite
+ } {
+ keep -background -cursor
+ }
+ pack $itk_component(childsite) -fill both -expand yes
+
+ #
+ # Set the itk_interior variable to be the childsite for derived
+ # classes.
+ #
+ set itk_interior $itk_component(childsite)
+
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -minimum
+#
+# Specifies the minimum size that the pane may reach.
+# ------------------------------------------------------------------
+configbody cyg::Pane::minimum {
+ set pixels [winfo pixels $itk_component(hull) $itk_option(-minimum)]
+ set $itk_option(-minimum) $pixels
+}
+
+# ------------------------------------------------------------------
+# OPTION: -maximum
+#
+# Specifies the maximum size that the pane may reach.
+# ------------------------------------------------------------------
+configbody cyg::Pane::maximum {
+ set pixels [winfo pixels $itk_component(hull) $itk_option(-maximum)]
+ set $itk_option(-maximum) $pixels
+}
+
+# ------------------------------------------------------------------
+# OPTION: -margin
+#
+# Specifies the border distance between the pane and pane contents.
+# This is done by setting the borderwidth of the pane to the margin.
+# ------------------------------------------------------------------
+configbody cyg::Pane::margin {
+ set pixels [winfo pixels $itk_component(hull) $itk_option(-margin)]
+ set itk_option(-margin) $pixels
+ $itk_component(childsite) configure -borderwidth $itk_option(-margin)
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: childSite
+#
+# Return the pane child site path name.
+# ------------------------------------------------------------------
+body cyg::Pane::childSite {} {
+ return $itk_component(childsite)
+}
diff --git a/libgui/library/panedwindow.tcl b/libgui/library/panedwindow.tcl
new file mode 100644
index 00000000000..9593432c243
--- /dev/null
+++ b/libgui/library/panedwindow.tcl
@@ -0,0 +1,851 @@
+#
+# Panedwindow
+# ----------------------------------------------------------------------
+# Implements a very general panedwindow which allows for mixing resizable
+# and non-resizable panes. It also allows limits to be set on individual
+# pane sizes, both minimum and maximum.
+#
+# The look of this widget is much like Window, instead of the Motif-like
+# iwidget panedwindow.
+# ----------------------------------------------------------------------
+
+# Portions of this code are originally from the iwidget panedwindow which
+# is Copyright (c) 1995 DSC Technologies Corporation
+
+itk::usual PanedWindow {
+ keep -background -cursor
+}
+
+# ------------------------------------------------------------------
+# PANEDWINDOW
+# ------------------------------------------------------------------
+class cyg::PanedWindow {
+ inherit itk::Widget
+
+ constructor {args} {}
+
+ itk_option define -orient orient Orient horizontal
+ itk_option define -sashwidth sashWidth SashWidth 10
+ itk_option define -sashcolor sashColor SashColor gray
+
+ public {
+ method index {index}
+ method childsite {args}
+ method fraction {percentage1 percentage2 args}
+ method add {tag args}
+ method insert {index tag args}
+ method delete {index}
+ method hide {index}
+ method replace {pane1 pane2}
+ method show {index}
+ method paneconfigure {index args}
+ method reset {}
+ }
+
+ private {
+ method _eventHandler {width height}
+ method _startDrag {num}
+ method _endDrag {where num}
+ method _configDrag {where num}
+ method _handleDrag {where num}
+ method _moveSash {where num}
+
+ method _resizeArray {}
+ method _setActivePanes {}
+ method _caclPos {where num}
+ method _makeSashes {}
+ method _placeSash {i}
+ method _placePanes {{start 0} {end end} {forget 0}}
+
+ variable _initialized 0 ;# flag set when widget is first configured
+ variable _sashes {} ;# List of sashes.
+
+ # Pane information
+ variable _panes {} ;# List of panes.
+ variable _activePanes {} ;# List of active panes.
+ variable _where ;# Array of relative positions
+ variable _ploc ;# Array of pixel positions
+ variable _frac ;# Array of relative pane sizes
+ variable _pixels ;# Array of sizes in pixels for non-resizable panes
+ variable _max ;# Array of pane maximum locations
+ variable _min ;# Array of pane minimum locations
+ variable _pmin ;# Array of pane minimum size
+ variable _pmax ;# Array of pane maximum size
+
+ variable _dimension 0 ;# width or height of window
+ variable _dir "height" ;# resizable direction, "height" or "width"
+ variable _rPixels
+
+ variable _sashloc ;# Array of dist of sash from above/left.
+
+ variable _minsashmoved ;# Lowest sash moved during dragging.
+ variable _maxsashmoved ;# Highest sash moved during dragging.
+
+ variable _width 0 ;# hull's width.
+ variable _height 0 ;# hull's height.
+ variable _unique -1 ;# Unique number for pane names.
+ }
+}
+
+#
+# Provide a lowercased access method for the PanedWindow class.
+#
+proc ::cyg::panedwindow {pathName args} {
+ uplevel ::cyg::PanedWindow $pathName $args
+}
+
+#
+# Use option database to override default resources of base classes.
+#
+option add *PanedWindow.width 10 widgetDefault
+option add *PanedWindow.height 10 widgetDefault
+
+# ------------------------------------------------------------------
+# CONSTRUCTOR
+# ------------------------------------------------------------------
+body cyg::PanedWindow::constructor {args} {
+ itk_option add hull.width hull.height
+
+ pack propagate $itk_component(hull) no
+
+ bind pw-config-$this <Configure> [code $this _eventHandler %w %h]
+ bindtags $itk_component(hull) \
+ [linsert [bindtags $itk_component(hull)] 0 pw-config-$this]
+
+ eval itk_initialize $args
+}
+
+# ------------------------------------------------------------------
+# OPTIONS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# OPTION: -orient
+#
+# Specifies the orientation of the sashes. Once the paned window
+# has been mapped, set the sash bindings and place the panes.
+# ------------------------------------------------------------------
+configbody cyg::PanedWindow::orient {
+ #puts "orient $_initialized"
+ if {$_initialized} {
+ set orient $itk_option(-orient)
+ if {$orient != "vertical" && $orient != "horizontal"} {
+ error "bad orientation option \"$itk_option(-orient)\":\
+ should be horizontal or vertical"
+ }
+ if {[string compare $orient "vertical"]} {
+ set _dimension $_height
+ set _dir "height"
+ } else {
+ set _dimension $_width
+ set _dir "width"
+ }
+ _resizeArray
+ _makeSashes
+ _placePanes 0 end 1
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -sashwidth
+#
+# Specifies the width of the sash.
+# ------------------------------------------------------------------
+configbody cyg::PanedWindow::sashwidth {
+ set pixels [winfo pixels $itk_component(hull) $itk_option(-sashwidth)]
+ set itk_option(-sashwidth) $pixels
+
+ if {$_initialized} {
+ # FIXME
+ for {set i 1} {$i < [llength $_panes]} {incr i} {
+ $itk_component(sash$i) configure \
+ -width $itk_option(-sashwidth) -height $itk_option(-sashwidth) \
+ -borderwidth 2
+ }
+ for {set i 1} {$i < [llength $_panes]} {incr i} {
+ _placeSash $i
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# OPTION: -sashcolor
+#
+# Specifies the color of the sash.
+# ------------------------------------------------------------------
+configbody cyg::PanedWindow::sashcolor {
+ if {$_initialized} {
+ for {set i 1} {$i < [llength $_panes]} {incr i} {
+ $itk_component(sash$i) configure -background $itk_option(-sashcolor)
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# METHODS
+# ------------------------------------------------------------------
+
+# ------------------------------------------------------------------
+# METHOD: index index
+#
+# Searches the panes in the paned window for the one with the
+# requested tag, numerical index, or keyword "end". Returns the pane's
+# numerical index if found, otherwise error.
+# ------------------------------------------------------------------
+body cyg::PanedWindow::index {index} {
+ if {[llength $_panes] > 0} {
+ if {[regexp {(^[0-9]+$)} $index]} {
+ if {$index < [llength $_panes]} {
+ return $index
+ } else {
+ error "PanedWindow index \"$index\" is out of range"
+ }
+ } elseif {$index == "end"} {
+ return [expr [llength $_panes] - 1]
+ } else {
+ if {[set idx [lsearch $_panes $index]] != -1} {
+ return $idx
+ }
+ error "bad PanedWindow index \"$index\": must be number, end,\
+ or pattern"
+ }
+ } else {
+ error "PanedWindow \"$itk_component(hull)\" has no panes"
+ }
+}
+
+# ------------------------------------------------------------------
+# METHOD: childsite ?index?
+#
+# Given an index return the specifc childsite path name. Invoked
+# without an index return a list of all the child site panes. The
+# list is ordered from the near side (left/top).
+# ------------------------------------------------------------------
+body cyg::PanedWindow::childsite {args} {
+ #puts "childsite $args ($_initialized)"
+
+ if {[llength $args] == 0} {
+ set children {}
+ foreach pane $_panes {
+ lappend children [$itk_component($pane) childSite]
+ }
+ return $children
+ } else {
+ set index [index [lindex $args 0]]
+ return [$itk_component([lindex $_panes $index]) childSite]
+ }
+}
+
+
+# ------------------------------------------------------------------
+# METHOD: add tag ?option value option value ...?
+#
+# Add a new pane to the paned window to the far (right/bottom) side.
+# The method takes additional options which are passed on to the
+# pane constructor. These include -margin, and -minimum. The path
+# of the pane is returned.
+# ------------------------------------------------------------------
+body cyg::PanedWindow::add {tag args} {
+ itk_component add $tag {
+ eval cyg::Pane $itk_interior.pane[incr _unique] $args
+ } {
+ keep -background -cursor
+ }
+
+ lappend _panes $tag
+ lappend _activePanes $tag
+ reset
+ return $itk_component($tag)
+}
+
+# ------------------------------------------------------------------
+# METHOD: insert index tag ?option value option value ...?
+#
+# Insert the specified pane in the paned window just before the one
+# given by index. Any additional options which are passed on to the
+# pane constructor. These include -margin, -minimum. The path of
+# the pane is returned.
+# ------------------------------------------------------------------
+body cyg::PanedWindow::insert {index tag args} {
+ itk_component add $tag {
+ eval cyg::Pane $itk_interior.pane[incr _unique] $args
+ } {
+ keep -background -cursor
+ }
+
+ set index [index $index]
+ set _panes [linsert $_panes $index $tag]
+ lappend _activePanes $tag
+ reset
+ return $itk_component($tag)
+}
+
+# ------------------------------------------------------------------
+# METHOD: delete index
+#
+# Delete the specified pane.
+# ------------------------------------------------------------------
+body cyg::PanedWindow::delete {index} {
+ set index [index $index]
+ set tag [lindex $_panes $index]
+
+ # remove the itk component
+ destroy $itk_component($tag)
+ # remove it from panes list
+ set _panes [lreplace $_panes $index $index]
+
+ # remove its _frac value
+ set ind [lsearch -exact $_activePanes $tag]
+ if {$ind != -1 && [info exists _frac($ind)]} {
+ unset _frac($ind)
+ }
+
+ # this will reset _activePane and resize things
+ reset
+}
+
+# ------------------------------------------------------------------
+# METHOD: hide index
+#
+# Remove the specified pane from the paned window.
+# ------------------------------------------------------------------
+body cyg::PanedWindow::hide {index} {
+ set index [index $index]
+ set tag [lindex $_panes $index]
+
+ if {[set idx [lsearch -exact $_activePanes $tag]] != -1} {
+ set _activePanes [lreplace $_activePanes $idx $idx]
+ if {[info exists _frac($idx)]} {unset _frac($idx)}
+ }
+
+ reset
+}
+
+body cyg::PanedWindow::replace {pane1 pane2} {
+ set ind1 [lsearch -exact $_activePanes $pane1]
+ if {$ind1 == -1} {
+ error "$pane1 is not an active pane name."
+ }
+ set ind2 [lsearch -exact $_panes $pane2]
+ if {$ind2 == -1} {
+ error "Pane $pane2 does not exist."
+ }
+ set _activePanes [lreplace $_activePanes $ind1 $ind1 $pane2]
+ _placePanes 0 $ind1 1
+}
+
+# ------------------------------------------------------------------
+# METHOD: show index
+#
+# Display the specified pane in the paned window.
+# ------------------------------------------------------------------
+body cyg::PanedWindow::show {index} {
+ set index [index $index]
+ set tag [lindex $_panes $index]
+
+ if {[lsearch -exact $_activePanes $tag] == -1} {
+ lappend _activePanes $tag
+ }
+
+ reset
+}
+
+# ------------------------------------------------------------------
+# METHOD: paneconfigure index ?option? ?value option value ...?
+#
+# Configure a specified pane. This method allows configuration of
+# panes from the PanedWindow level. The options may have any of the
+# values accepted by the add method.
+# ------------------------------------------------------------------
+body cyg::PanedWindow::paneconfigure {index args} {
+ set index [index $index]
+ set tag [lindex $_panes $index]
+ return [uplevel $itk_component($tag) configure $args]
+}
+
+# ------------------------------------------------------------------
+# METHOD: reset
+#
+# Redisplay the panes based on the default percentages of the panes.
+# ------------------------------------------------------------------
+body cyg::PanedWindow::reset {} {
+ if {$_initialized && [llength $_panes]} {
+ #puts RESET
+ _setActivePanes
+ _resizeArray
+ _makeSashes
+ _placePanes 0 end 1
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _setActivePanes
+#
+# Resets the active pane list.
+# ------------------------------------------------------------------
+body cyg::PanedWindow::_setActivePanes {} {
+ set _prevActivePanes $_activePanes
+ set _activePanes {}
+
+ foreach pane $_panes {
+ if {[lsearch -exact $_prevActivePanes $pane] != -1} {
+ lappend _activePanes $pane
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _eventHandler
+#
+# Performs operations necessary following a configure event. This
+# includes placing the panes.
+# ------------------------------------------------------------------
+body cyg::PanedWindow::_eventHandler {width height} {
+ #puts "Event $width $height"
+ set _width $width
+ set _height $height
+ if {[string compare $itk_option(-orient) "vertical"]} {
+ set _dimension $_height
+ set _dir "height"
+ } else {
+ set _dimension $_width
+ set _dir "width"
+ }
+
+ if {$_initialized} {
+ _resizeArray
+ _placePanes
+ } else {
+ set _initialized 1
+ reset
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _resizeArray
+#
+# Recalculates the sizes and positions of all the panes.
+# This is only done at startup, when the window size changes, when
+# a new pane is added, or the orientation is changed.
+#
+# _frac($i) contains:
+# % of resizable space when pane$i is resizable
+# _pixels($i) contains
+# pixels when pane$i is not resizable
+#
+# _where($i) contains the relative position of the top of pane$i
+# ------------------------------------------------------------------
+body cyg::PanedWindow::_resizeArray {} {
+ set numpanes 0
+ set _rPixels 0
+ set totalFrac 0.0
+ set numfreepanes 0
+
+ #puts "sresizeArray dim=$_dimension dir=$_dir"
+
+ # first pass. Count the number of resizable panes and
+ # the pixels reserved for non-resizable panes.
+ set i 0
+ foreach p $_activePanes {
+ set _resizable($i) [$itk_component($p) cget -resizable]
+ if {$_resizable($i)} {
+ # remember pane min and max
+ set _pmin($i) [$itk_component($p) cget -minimum]
+ set _pmax($i) [$itk_component($p) cget -maximum]
+
+ incr numpanes
+ if {[info exists _frac($i)]} {
+ # sum up all the percents
+ set totalFrac [expr $totalFrac + $_frac($i)]
+ } else {
+ # number of new windows not yet sized
+ incr numfreepanes
+ }
+ } else {
+ set _pixels($i) [winfo req$_dir $itk_component($p)]
+ set _pmin($i) $_pixels($i)
+ set _pmax($i) $_pixels($i)
+ incr _rPixels $_pixels($i)
+ }
+ incr i
+ }
+ set totalpanes $i
+
+ #puts "numpanes=$numpanes nfp=$numfreepanes _rPixels=$_rPixels totalFrac=$totalFrac"
+
+ if {$numfreepanes} {
+ # set size for the new window(s) to average size
+ if {$totalFrac > 0.0} {
+ set freepanesize [expr $totalFrac / ($numpanes - $numfreepanes)]
+ } else {
+ set freepanesize [expr 1.0 / $numpanes.0]
+ }
+ for {set i 0} {$i < $totalpanes} {incr i} {
+ if {$_resizable($i) && ![info exists _frac($i)]} {
+ set _frac($i) $freepanesize
+ set totalFrac [expr $totalFrac + $_frac($i)]
+ }
+ }
+ }
+
+ set done 0
+
+ while {!$done} {
+ # force to a reasonable value
+ if {$totalFrac <= 0.0} { set totalFrac 1.0 }
+
+ # scale the _frac array
+ if {$totalFrac > 1.01 || $totalFrac < 0.99} {
+ set cor [expr 1.0 / $totalFrac]
+ set totalFrac 0.0
+ for {set i 0} {$i < $totalpanes} {incr i} {
+ if {$_resizable($i)} {
+ set _frac($i) [expr $_frac($i) * $cor]
+ set totalFrac [expr $totalFrac + $_frac($i)]
+ }
+ }
+ }
+
+ # bounds checking; look for panes that are too small or too large
+ # if one is found, fix its size at the min or max and mark the
+ # window non-resizable. Adjust percents and try again.
+ set done 1
+ for {set i 0} {$i < $totalpanes} {incr i} {
+ if {$_resizable($i)} {
+ set _pixels($i) [expr int($_frac($i) * ($_dimension - $_rPixels.0))]
+ if {$_pixels($i) < $_pmin($i)} {
+ set _resizable($i) 0
+ set totalFrac [expr $totalFrac - $_frac($i)]
+ set _pixels($i) $_pmin($i)
+ incr _rPixels $_pixels($i)
+ set done 0
+ break
+ } elseif {$_pmax($i) && $_pixels($i) > $_pmax($i)} {
+ set _resizable($i) 0
+ set totalFrac [expr $totalFrac - $_frac($i)]
+ set _pixels($i) $_pmax($i)
+ incr _rPixels $_pixels($i)
+ set done 0
+ break
+ }
+ }
+ }
+ }
+
+ # Done adjusting. Now build pane position arrays. These are designed
+ # to minimize calculations while resizing.
+ # Note: position of sash $i = position of top of pane $i
+ # _where($i): relative (0.0 - 1.0) position of sash $i
+ # _ploc($i): position in pixels of sash $i
+ # _max($i): maximum position in pixels of sash $i (0 = no max)
+ set _where(0) 0.0
+ set _ploc(0) 0
+ set _max(0) 0
+ set _min(0) 0
+ # calculate the percentage of resizable space
+ set resizePerc [expr 1.0 - ($_rPixels.0 / $_dimension)]
+ for {set i 1; set n 0} {$i < $totalpanes} {incr i; incr n} {
+ if {$_resizable($n)} {
+ set _where($i) [expr $_where($n) + ($_frac($n) * $resizePerc)]
+ } else {
+ set _where($i) [expr $_where($n) + [expr $_pixels($n).0 / $_dimension]]
+ }
+ set _ploc($i) [expr $_ploc($n) + $_pixels($n)]
+ if {$_pmax($n)} {
+ set _max($i) [expr $_max($n) + $_pmax($n)]
+ } else {
+ set _max($i) 0
+ }
+ set _min($i) [expr $_min($n) + $_pmin($n)]
+ #puts "where($i)=$_where($i)"
+ #puts "ploc($i)=$_ploc($i)"
+ #puts "max($i)=$_max($i)"
+ #puts "min($i)=$_min($i)"
+ }
+ set _ploc($i) $_dimension
+ set _where($i) 1.0
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _startDrag num
+#
+# Starts the sash drag and drop operation. At the start of the drag
+# operation all the information is known as for the upper and lower
+# limits for sash movement. The calculation is made at this time and
+# stored in protected variables for later access during the drag
+# handling routines.
+# ------------------------------------------------------------------
+body cyg::PanedWindow::_startDrag {num} {
+ #puts "startDrag $num"
+
+ set _minsashmoved $num
+ set _maxsashmoved $num
+
+ grab $itk_component(sash$num)
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _endDrag where num
+#
+# Ends the sash drag and drop operation.
+# ------------------------------------------------------------------
+body cyg::PanedWindow::_endDrag {where num} {
+ #puts "endDrag $where $num"
+
+ grab release $itk_component(sash$num)
+
+ # set new _frac values
+ for {set i [expr $_minsashmoved-1]} {$i <= $_maxsashmoved} {incr i} {
+ set _frac($i) \
+ [expr ($_ploc([expr $i+1]).0 - $_ploc($i)) / ($_dimension - $_rPixels)]
+ }
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _configDrag where num
+#
+# Configure action for sash.
+# ------------------------------------------------------------------
+body cyg::PanedWindow::_configDrag {where num} {
+ set _sashloc($num) $where
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _handleDrag where num
+#
+# Motion action for sash.
+# ------------------------------------------------------------------
+body cyg::PanedWindow::_handleDrag {where num} {
+ #puts "handleDrag $where $num"
+ _moveSash [expr $where + $_sashloc($num)] $num
+ _placePanes [expr $_minsashmoved - 1] $_maxsashmoved
+}
+
+# ------------------------------------------------------------------
+# PROTECTED METHOD: _moveSash where num
+#
+# Move the sash to the absolute pixel location
+# ------------------------------------------------------------------
+body cyg::PanedWindow::_moveSash {where num} {
+ #puts "moveSash $where $num"
+ set _minsashmoved [expr ($_minsashmoved<$num)?$_minsashmoved:$num]
+ set _maxsashmoved [expr ($_maxsashmoved>$num)?$_maxsashmoved:$num]
+ _caclPos $where $num
+}
+
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _caclPos where num
+#
+# Determines the new position for the sash. Make sure theposition does
+# not go past the minimum for the pane on each side of the sash.
+# ------------------------------------------------------------------
+body cyg::PanedWindow::_caclPos {where num} {
+ #puts "calcPos $num $where"
+ set dir [expr $where - $_ploc($num)]
+ if {$dir == 0} { return }
+
+ # simplify expressions by computing these now
+ set m [expr $num-1]
+ set p [expr $num+1]
+
+ # we have squeezed the pane below us to the limit
+ set lower1 [expr $_ploc($m) + $_pmin($m)]
+ set lower2 0
+ if {$_pmax($num)} {
+ # we have stretched the pane above us to the limit
+ set lower2 [expr $_ploc($p) - $_pmax($num)]
+ }
+
+ set upper1 9999 ;# just a large number
+ if {$_pmax($m)} {
+ # we have stretched the pane above us to the limit
+ set upper1 [expr $_ploc($m) + $_pmax($m)]
+ }
+ # we have squeezed the pane below us to the limit
+ set upper2 [expr $_ploc($p) - $_pmin($num)]
+
+ set done 0
+
+ #puts "lower1=$lower1 lower2=$lower2 _min($num)=$_min($num)"
+ #puts "upper1=$upper1 upper2=$upper2 _max($num)=$_max($num)"
+ if {$dir < 0 && $where > $_min($num)} {
+ if {$where < $lower2} {
+ set done 1
+ if {$p == [llength $_activePanes]} {
+ set _ploc($num) $upper2
+ } else {
+ _moveSash [expr $where + $_pmax($num)] $p
+ set _ploc($num) [expr $_ploc($p) - $_pmax($num)]
+ }
+ }
+ if {$where < $lower1} {
+ set done 1
+ if {$num == 1} {
+ set _ploc($num) $lower1
+ } else {
+ _moveSash [expr $where - $_pmin($m)] $m
+ set _ploc($num) [expr $_ploc($m) + $_pmin($m)]
+ }
+ }
+ } elseif {$dir > 0 && ($_max($num) == 0 || $where < $_max($num))} {
+ if {$where > $upper1} {
+ set done 1
+ if {$num == 1} {
+ set _ploc($num) $upper1
+ } else {
+ _moveSash [expr $where - $_pmax($m)] $m
+ set _ploc($num) [expr $_ploc($m) + $_pmax($m)]
+ }
+ }
+ if {$where > $upper2} {
+ set done 1
+ if {$p == [llength $_activePanes]} {
+ set _ploc($num) $upper2
+ } else {
+ _moveSash [expr $where + $_pmin($num)] $p
+ set _ploc($num) [expr $_ploc($p) - $_pmin($num)]
+ }
+ }
+ }
+
+ if {!$done} {
+ if {!($_max($num) > 0 && $where > $_max($num)) && $where >= $_min($num)} {
+ #puts "ploc($num)=$where"
+ set _ploc($num) $where
+ }
+ }
+ set _where($num) [expr $_ploc($num).0 / $_dimension]
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _makeSashes
+#
+# Removes any previous sashes and creates new ones.
+# ------------------------------------------------------------------
+body cyg::PanedWindow::_makeSashes {} {
+ #
+ # Remove any existing sashes.
+ #
+ foreach sash $_sashes {
+ destroy $itk_component($sash)
+ }
+
+ set _sashes {}
+ set skipped_first 0
+ #
+ # Create necessary number of sashes
+ #
+ for {set id 0} {$id < [llength $_activePanes]} {incr id} {
+ set p [lindex $_activePanes $id]
+ if {[$itk_component($p) cget -resizable]} {
+ if {$skipped_first == 0} {
+ # create the first sash when we see the 2nd resizable pane
+ incr skipped_first
+ } else {
+ # create sash
+
+ itk_component add sash$id {
+ frame $itk_interior.sash$id -relief raised \
+ -height $itk_option(-sashwidth) \
+ -width $itk_option(-sashwidth) \
+ -borderwidth 2
+ } {
+ keep -background
+ }
+ lappend _sashes sash$id
+
+ set com $itk_component(sash$id)
+ $com configure -background $itk_option(-sashcolor)
+ bind $com <Button-1> [code $this _startDrag $id]
+
+ switch $itk_option(-orient) {
+ vertical {
+ bind $com <B1-Motion> \
+ [code $this _handleDrag %x $id]
+ bind $com <B1-ButtonRelease-1> \
+ [code $this _endDrag %x $id]
+ bind $com <Configure> \
+ [code $this _configDrag %x $id]
+ # FIXME Windows should have a different cirsor
+ $com configure -cursor sb_h_double_arrow
+ }
+
+ horizontal {
+ bind $com <B1-Motion> \
+ [code $this _handleDrag %y $id]
+ bind $com <B1-ButtonRelease-1> \
+ [code $this _endDrag %y $id]
+ bind $com <Configure> \
+ [code $this _configDrag %y $id]
+ # FIXME Windows should have a different cirsor
+ $com configure -cursor sb_v_double_arrow
+ }
+ }
+ }
+ }
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _placeSash i
+#
+# Places the position of the sash
+# ------------------------------------------------------------------
+body cyg::PanedWindow::_placeSash {i} {
+ if {[string compare $itk_option(-orient) "vertical"]} {
+ place $itk_component(sash$i) -in $itk_component(hull) \
+ -x 0 -relwidth 1 -rely $_where($i) -anchor w \
+ -height $itk_option(-sashwidth)
+ } else {
+ place $itk_component(sash$i) -in $itk_component(hull) \
+ -y 0 -relheight 1 -relx $_where($i) -anchor n \
+ -width $itk_option(-sashwidth)
+ }
+}
+
+# ------------------------------------------------------------------
+# PRIVATE METHOD: _placePanes
+#
+# Resets the panes of the window following movement of the sash.
+# ------------------------------------------------------------------
+body cyg::PanedWindow::_placePanes {{start 0} {end end} {forget 0}} {
+ #puts "placeplanes $start $end"
+ if {$end=="end"} { set end [expr [llength $_activePanes] - 1] }
+ set _updatePanes [lrange $_activePanes $start $end]
+
+ if {$forget} {
+ if {$_updatePanes == $_activePanes} {
+ set _forgetPanes $_panes
+ } else {
+ set _forgetPanes $_updatePanes
+ }
+ foreach pane $_forgetPanes {
+ place forget $itk_component($pane)
+ }
+ }
+
+ if {[string compare $itk_option(-orient) "vertical"]} {
+ set i $start
+ foreach pane $_updatePanes {
+ place $itk_component($pane) -in $itk_component(hull) \
+ -x 0 -rely $_where($i) -relwidth 1 \
+ -relheight [expr $_where([expr $i + 1]) - $_where($i)]
+ incr i
+ }
+ } else {
+ set i $start
+ foreach pane $_updatePanes {
+ place $itk_component($pane) -in $itk_component(hull) \
+ -y 0 -relx $_where($i) -relheight 1 \
+ -relwidth [expr $_where([expr $i + 1]) - $_where($i)]
+ incr i
+ }
+ }
+
+ for {set i [expr $start+1]} {$i <= $end} {incr i} {
+ if {[lsearch -exact $_sashes sash$i] != -1} {
+ _placeSash $i
+ }
+ }
+}
diff --git a/libgui/library/parse_args.tcl b/libgui/library/parse_args.tcl
new file mode 100644
index 00000000000..928258be9e1
--- /dev/null
+++ b/libgui/library/parse_args.tcl
@@ -0,0 +1,42 @@
+# parse_args.tcl -- procedure for pulling in arguments
+
+# parse_args takes in a set of arguments with defaults and examines
+# the 'args' in the calling procedure to see what the arguments should
+# be set to. Sets variables in the calling frame to the right values.
+
+proc parse_args { argset } {
+ upvar args args
+
+ foreach argument $argset {
+ if {[llength $argument] == 1} {
+ # No default specified, so we assume that we should set
+ # the value to 1 if the arg is present and 0 if it's not.
+ # It is assumed that no value is given with the argument.
+ set result [lsearch -exact $args "-$argument"]
+ if {$result != -1} then {
+ uplevel 1 [list set $argument 1]
+ set args [lreplace $args $result $result]
+ } else {
+ uplevel 1 [list set $argument 0]
+ }
+ } elseif {[llength $argument] == 2} {
+ # There are two items in the argument. The second is a
+ # default value to use if the item is not present.
+ # Otherwise, the variable is set to whatever is provided
+ # after the item in the args.
+ set arg [lindex $argument 0]
+ set result [lsearch -exact $args "-[lindex $arg 0]"]
+ if {$result != -1} then {
+ uplevel 1 [list set $arg [lindex $args [expr $result+1]]]
+ set args [lreplace $args $result [expr $result+1]]
+ } else {
+ uplevel 1 [list set $arg [lindex $argument 1]]
+ }
+ } else {
+ error "Badly formatted argument \"$argument\" in argument set"
+ }
+ }
+
+ # The remaining args should be checked to see that they match the
+ # number of items expected to be passed into the procedure...
+}
diff --git a/libgui/library/path.tcl b/libgui/library/path.tcl
new file mode 100644
index 00000000000..39f7f90b3a3
--- /dev/null
+++ b/libgui/library/path.tcl
@@ -0,0 +1,20 @@
+# path.tcl - Path-handling helpers.
+# Copyright (C) 1998 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+# This proc takes a possibly relative path and expands it to the
+# corresponding fully qualified path. Additionally, on Windows the
+# result is guaranteed to be in "long" form.
+proc canonical_path {path} {
+ global tcl_platform
+
+ set r [file join [pwd] $path]
+ if {$tcl_platform(platform) == "windows"} then {
+ # This will fail if the file does not already exist.
+ if {! [catch {file attributes $r -longname} long]} then {
+ set r $long
+ }
+ }
+
+ return $r
+}
diff --git a/libgui/library/pkgIndex.tcl b/libgui/library/pkgIndex.tcl
new file mode 100644
index 00000000000..322cfda212d
--- /dev/null
+++ b/libgui/library/pkgIndex.tcl
@@ -0,0 +1,11 @@
+# Tcl package index file, version 1.1
+# This file is generated by the "pkg_mkIndex" command
+# and sourced either when an application starts up or
+# by a "package unknown" script. It invokes the
+# "package ifneeded" command to set up package-related
+# information so that packages will be loaded automatically
+# in response to "package require" commands. When this
+# script is sourced, the variable $dir must contain the
+# full path name of this file's directory.
+
+package ifneeded combobox 1.05 [list tclPkgSetup $dir combobox 1.05 {{combobox.tcl source ::combobox::combobox}}]
diff --git a/libgui/library/postghost.tcl b/libgui/library/postghost.tcl
new file mode 100644
index 00000000000..713d5ce78a9
--- /dev/null
+++ b/libgui/library/postghost.tcl
@@ -0,0 +1,38 @@
+# postghost.tcl - Ghost a menu item at post time.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+
+# Helper proc.
+proc GHOST_helper {menu index predicate} {
+ if {[eval $predicate]} then {
+ set state normal
+ } else {
+ set state disabled
+ }
+ $menu entryconfigure $index -state $state
+}
+
+# Add a -postcommand to a menu. This is careful not to stomp other
+# postcommands.
+proc add_post_command {menu callback} {
+ set old [$menu cget -postcommand]
+ # We use a "\n" and not a ";" to separate so that people can put
+ # comments into their -postcommands without fear.
+ $menu configure -postcommand "$old\n$callback"
+}
+
+# Run this to make a menu item which ghosts or unghosts depending on a
+# predicate that is run at menu-post time. The NO_CACHE option
+# prevents the index from being looked up statically; this is useful
+# if you want to use an entry name as the index and you have a very
+# dynamic menu (ie one where the numeric index of a named item is not
+# constant over time). If PREDICATE returns 0 at post time, then the
+# item will be ghosted.
+proc ghosting_menu_item {menu index predicate {no_cache 0}} {
+ if {! $no_cache} then {
+ set index [$menu index $index]
+ }
+
+ add_post_command $menu [list GHOST_helper $menu $index $predicate]
+}
diff --git a/libgui/library/prefs.tcl b/libgui/library/prefs.tcl
new file mode 100644
index 00000000000..9991151766a
--- /dev/null
+++ b/libgui/library/prefs.tcl
@@ -0,0 +1,198 @@
+# prefs.tcl - Preference handling.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+# KNOWN BUGS:
+# * When we move to the next tcl/itcl, rewrite to use namespaces and
+# possibly ensembles.
+
+# Global state.
+defarray PREFS_state {
+ inhibit-event 0
+ initialized 0
+}
+
+# This is called when a trace on some option fires. It makes sure the
+# relevant handlers get run.
+proc PREFS_run_handlers {name1 name2 op} {
+ upvar $name1 state
+ set option [lindex $name2 0]
+
+ global PREFS_state
+ # Notify everybody else unless we've inhibited event generation.
+ if {! $PREFS_state(inhibit-event) && $PREFS_state(ide_running)} then {
+ ide_property set preference/$option $state([list $option value]) global
+ }
+
+ # Run local handlers.
+ run_hooks PREFS_state([list $option handler]) $option \
+ $state([list $option value])
+}
+
+# This is run when we see a property event. It updates our internal
+# state.
+proc PREFS_handle_property_event {exists property value} {
+ global PREFS_state
+
+ # If it isn't a preference property, ignore it.
+ if {! [string match preference/* $property]} then {
+ return
+ }
+ # [string length preference/] == 11.
+ set name [string range $property 11 end]
+
+ if {$exists} then {
+ incr PREFS_state(inhibit-event)
+ set PREFS_state([list $name value]) $value
+ incr PREFS_state(inhibit-event) -1
+ } elseif {$PREFS_state(ide_running)} then {
+ # It doesn't make sense to remove a property that mirrors some
+ # preference. So disallow by immediately redefining. Use
+ # initialize and not set because several clients are likely to run
+ # this at once.
+ ide_property initialize preference/$name \
+ $PREFS_state([list $name value]) global
+ }
+}
+
+# pref define NAME DEFAULT
+# Define a new option
+# NAME is the option name
+# DEFAULT is the default value of the option
+proc PREFS_cmd_define {name default} {
+ global PREFS_state
+
+ # If the option has already been defined, do nothing.
+ if {[info exists PREFS_state([list $name value])]} then {
+ return
+ }
+
+ if {$PREFS_state(ide_running)} then {
+ # We only store the value in the database.
+ ide_property initialize preference/$name $default global
+ set default [ide_property get preference/$name]
+ }
+
+ # We set our internal state no matter what. It is harmless if our
+ # definition causes a property-set event.
+ set PREFS_state([list $name value]) $default
+ set PREFS_state([list $name handler]) {}
+
+ # Set up a variable trace so that the handlers can be run.
+ trace variable PREFS_state([list $name value]) w PREFS_run_handlers
+}
+
+# pref get NAME
+# Return value of option NAME
+proc PREFS_cmd_get {name} {
+ global PREFS_state
+ return $PREFS_state([list $name value])
+}
+
+# pref getd NAME
+# Return value of option NAME
+# or define it if necessary and return ""
+proc PREFS_cmd_getd {name} {
+ global PREFS_state
+ PREFS_cmd_define $name ""
+ return [pref get $name]
+}
+
+# pref varname NAME
+# Return name of global variable that represents option NAME
+# This is suitable for (eg) a -variable option on a radiobutton
+proc PREFS_cmd_varname {name} {
+ return PREFS_state([list $name value])
+}
+
+# pref set NAME VALUE
+# Set the option NAME to VALUE
+proc PREFS_cmd_set {name value} {
+ global PREFS_state
+
+ # For debugging purposes, make sure the preference has already been
+ # defined.
+ if {! [info exists PREFS_state([list $name value])]} then {
+ error "attempt to set undefined preference $name"
+ }
+
+ set PREFS_state([list $name value]) $value
+}
+
+# pref setd NAME VALUE
+# Set the option NAME to VALUE
+# or define NAME and set the default to VALUE
+proc PREFS_cmd_setd {name value} {
+ global PREFS_state
+
+ if {[info exists PREFS_state([list $name value])]} then {
+ set PREFS_state([list $name value]) $value
+ } else {
+ PREFS_cmd_define $name $value
+ }
+}
+
+# pref add_hook NAME HOOK
+# Add a command to the hook that is run when the preference name NAME
+# changes. The command is run with the name of the changed option and
+# the new value as arguments.
+proc PREFS_cmd_add_hook {name hook} {
+ add_hook PREFS_state([list $name handler]) $hook
+}
+
+# pref remove_hook NAME HOOK
+# Remove a command from the per-preference hook.
+proc PREFS_cmd_remove_hook {name hook} {
+ remove_hook PREFS_state([list $name handler]) $hook
+}
+
+# pref init ?IDE_RUNNING?
+# Initialize the preference module. IDE_RUNNING is an optional
+# boolean argument. If 0, then the preference module will assume that
+# it is not connected to the IDE backplane. The default is based on
+# the global variable IDE_ENABLED.
+proc PREFS_cmd_init {{ide_running "unset"}} {
+ global PREFS_state IDE_ENABLED
+
+ if {! $PREFS_state(initialized)} then {
+
+ if {$ide_running == "unset"} then {
+ if {[info exists IDE_ENABLED]} then {
+ set ide_running $IDE_ENABLED
+ } else {
+ set ide_running 0
+ }
+ }
+
+ set PREFS_state(initialized) 1
+ set PREFS_state(ide_running) $ide_running
+ if {$ide_running} then {
+ property add_hook "" PREFS_handle_property_event
+ }
+ }
+}
+
+# pref list
+# Return a list of the names of all preferences defined by this
+# application.
+proc PREFS_cmd_list {} {
+ global PREFS_state
+
+ set list {}
+ foreach item [array names PREFS_state] {
+ if {[lindex $item 1] == "value"} then {
+ lappend list [lindex $item 0]
+ }
+ }
+
+ return $list
+}
+
+# The primary interface to all preference subcommands.
+proc pref {dispatch args} {
+ if {[info commands PREFS_cmd_$dispatch] == ""} then {
+ error "unrecognized key \"$dispatch\""
+ }
+
+ eval PREFS_cmd_$dispatch $args
+}
diff --git a/libgui/library/print.tcl b/libgui/library/print.tcl
new file mode 100644
index 00000000000..01cf3314b4d
--- /dev/null
+++ b/libgui/library/print.tcl
@@ -0,0 +1,334 @@
+# print.tcl -- some procedures for dealing with printing. To print
+# PostScript on Windows, tkmswin.dll will need to be present.
+
+proc send_printer { args } {
+ global tcl_platform
+
+ parse_args {
+ {printer {}}
+ {outfile {}}
+ {parent {}}
+ ascii
+ file
+ }
+
+ if {[llength $args] == 0} {
+ error "No filename or data provided."
+ }
+
+ if {$ascii == 1} {
+ if {$tcl_platform(platform) == "windows"} then {
+ PRINT_windows_ascii -file $file -parent $parent [lindex $args 0]
+ } else {
+ send_printer_ascii -printer $printer -file $file \
+ -outfile $outfile [lindex $args 0]
+ }
+ return
+ }
+
+ if {$outfile != ""} {
+ if {$file} {
+ file copy [lindex 0 $args] $outfile
+ } else {
+ set F [open $outfile w]
+ puts $F [lindex 0 $args]
+ close $F
+ }
+ return
+ }
+
+ if {$tcl_platform(platform) == "windows"} then {
+ load tkmswin.dll
+
+ set cmd {tkmswin print -postscript}
+ if {$printer != ""} {
+ lappend cmd -printer $printer
+ }
+ if {$file} {
+ lappend cmd -file
+ }
+ lappend cmd [lindex $args 0]
+ eval $cmd
+
+ } else {
+
+ # Unix box, assume lpr, but if it fails try lp.
+ foreach prog {lpr lp} {
+ set cmd [list exec $prog]
+ if {$printer != ""} {
+ if {$prog == "lpr"} {
+ lappend cmd "-P$printer"
+ } else {
+ lappend cmd "-d$printer"
+ }
+ }
+ if {$file} {
+ lappend cmd "<"
+ } else {
+ lappend cmd "<<"
+ }
+ # tack on data or filename
+ lappend cmd [lindex $args 0]
+
+ # attempt to run the command, and exit if successful
+ if ![catch {eval $cmd} ret] {
+ return
+ }
+ }
+ error "Couldn't run either `lpr' or `lp' to print"
+ }
+}
+
+proc send_printer_ascii { args } {
+ global tcl_platform
+
+ parse_args {
+ {printer {}}
+ {outfile {}}
+ {file 0}
+ {font Courier}
+ {fontsize 10}
+ {pageheight 11}
+ {pagewidth 8.5}
+ {margin .5}
+ }
+ if {[llength $args] == 0} {
+ error "No filename or data provided."
+ }
+
+ if {$tcl_platform(platform) == "windows"} then {
+ PRINT_windows_ascii -file $file [lindex $args 0]
+ return
+ }
+
+ # convert the filename or data to ascii, and then send to the printer.
+
+ set inch 72
+ set pageheight [expr $pageheight*$inch]
+ set pagewidth [expr $pagewidth*$inch]
+ set margin [expr $margin*$inch]
+
+ set output "%!PS-Adobe-1.0\n"
+ append output "%%Creator: libgui ASCII-to-PS converter\n"
+ append output "%%DocumentFonts: $font\n"
+ append output "%%Pages: (atend)\n"
+ append output "/$font findfont $fontsize scalefont setfont\n"
+ append output "/M{moveto}def\n"
+ append output "/S{show}def\n"
+
+ set pages 1
+ set y [expr $pageheight-$margin-$fontsize]
+
+ if {$file == 1} {
+ set G [open [lindex $args 0] r]
+ set strlen [gets $G str]
+ } else {
+ # make sure that we end with a newline
+ set args [lindex $args 0]
+ append args "\n"
+
+ set strlen [string first "\n" $args]
+ if {$strlen != -1} {
+ set str [string range $args 0 [expr $strlen-1]]
+ set args [string range $args [expr $strlen+1] end]
+ }
+ }
+ while {$strlen != -1} {
+ if {$y < $margin} {
+ append output "showpage\n"
+ incr pages
+ set y [expr $pageheight-$margin-$fontsize]
+ }
+ regsub -all {[()\\]} $str {\\&} str
+ append output "$margin $y M ($str) S\n"
+ set y [expr $y-($fontsize+1)]
+
+ if {$file == 1} {
+ set strlen [gets $G str]
+ } else {
+ set strlen [string first "\n" $args]
+ if {$strlen != -1} {
+ set str [string range $args 0 [expr $strlen-1]]
+ set args [string range $args [expr $strlen+1] end]
+ }
+ }
+
+ }
+ append output "showpage\n"
+ append output "%%Pages: $pages\n"
+
+ if {$file == 1} {
+ close $G
+ }
+
+ send_printer -printer $printer -outfile $outfile $output
+}
+
+# Print ASCII text on Windows.
+
+proc PRINT_windows_ascii { args } {
+ global tcl_platform errorInfo
+ global PRINT_state
+
+ parse_args {
+ {file 0}
+ {parent {}}
+ }
+ if {[llength $args] == 0} {
+ error "No filename or data provided."
+ }
+
+ if {$tcl_platform(platform) != "windows"} then {
+ error "Only works on Windows"
+ }
+
+ # Copied from tk_dialog, except that it returns.
+ catch {destroy .cancelprint}
+ toplevel .cancelprint -class Dialog
+ wm withdraw .cancelprint
+ wm title .cancelprint [gettext "Printing"]
+ frame .cancelprint.bot
+ frame .cancelprint.top
+ pack .cancelprint.bot -side bottom -fill both
+ pack .cancelprint.top -side top -fill both -expand 1
+ set PRINT_state(pageno) [format [gettext "Now printing page %d"] 0]
+ label .cancelprint.msg -justify left -textvariable PRINT_state(pageno)
+ pack .cancelprint.msg -in .cancelprint.top -side right -expand 1 \
+ -fill both -padx 1i -pady 5
+ button .cancelprint.button -text [gettext "Cancel"] \
+ -command { ide_winprint abort } -default active
+ grid .cancelprint.button -in .cancelprint.bot -column 0 -row 0 \
+ -sticky ew -padx 10
+ grid columnconfigure .cancelprint.bot 0
+
+ update idletasks
+ set x [expr [winfo screenwidth .cancelprint]/2 \
+ - [winfo reqwidth .cancelprint]/2 \
+ - [winfo vrootx [winfo parent .cancelprint]]]
+ set y [expr [winfo screenheight .cancelprint]/2 \
+ - [winfo reqheight .cancelprint]/2 \
+ - [winfo vrooty [winfo parent .cancelprint]]]
+ wm geom .cancelprint +$x+$y
+ update
+
+ # We're going to change the focus and the grab as soon as we start
+ # printing, so remember them now.
+ set oldFocus [focus]
+ set oldGrab [grab current .cancelprint]
+ if {$oldGrab != ""} then {
+ set grabStatus [grab status $oldGrab]
+ }
+
+ focus .cancelprint.button
+
+ set PRINT_state(start) 1
+ set PRINT_state(file) $file
+ if {$file == 1} then {
+ set PRINT_state(fp) [open [lindex $args 0] r]
+ } else {
+ set PRINT_state(text) [lindex $args 0]
+ }
+
+ set cmd [list ide_winprint print_text PRINT_query PRINT_text \
+ -pageproc PRINT_page]
+ if {$parent != {}} then {
+ lappend cmd -parent $parent
+ }
+
+ set code [catch $cmd errmsg]
+ set errinfo $errorInfo
+
+ catch { focus $oldFocus }
+ catch { destroy .cancelprint }
+ if {$oldGrab != ""} then {
+ if {$grabStatus == "global"} then {
+ grab -global $oldGrab
+ } else {
+ grab $oldGrab
+ }
+ }
+
+ if {$code == 1} then {
+ error $errmsg $errinfo
+ }
+}
+
+# The query procedure passed to ide_winprint print_text. This should
+# return one of "continue", "done", or "newpage".
+
+proc PRINT_query { } {
+ global PRINT_state
+
+ # Fetch the next line into PRINT_state(str).
+
+ if {$PRINT_state(file) == 1} then {
+ set strlen [gets $PRINT_state(fp) PRINT_state(str)]
+ } else {
+ set strlen [string first "\n" $PRINT_state(text)]
+ if {$strlen != -1} then {
+ set PRINT_state(str) \
+ [string range $PRINT_state(text) 0 [expr $strlen-1]]
+ set PRINT_state(text) \
+ [string range $PRINT_state(text) [expr $strlen+1] end]
+ } else {
+ if {$PRINT_state(text) != ""} then {
+ set strlen 0
+ set PRINT_state(str) $PRINT_state(text)
+ set PRINT_state(text) ""
+ }
+ }
+ }
+
+ if {$strlen != -1} then {
+
+ # Expand tabs assuming tabstops every 8 spaces and a fixed
+ # pitch font. Text written to other assumptions will have to
+ # be handled by the caller.
+
+ set str $PRINT_state(str)
+ while {[set i [string first "\t" $str]] >= 0} {
+ set c [expr 8 - ($i % 8)]
+ set spaces ""
+ while {$c > 0} {
+ set spaces "$spaces "
+ incr c -1
+ }
+ set str "[string range $str 0 [expr $i - 1]]$spaces[string range $str [expr $i + 1] end]"
+ }
+ set PRINT_state(str) $str
+
+ return "continue"
+ } else {
+ return "done"
+ }
+}
+
+# The text procedure passed to ide_winprint print_text. This should
+# return the next line to print.
+
+proc PRINT_text { } {
+ global PRINT_state
+
+ return $PRINT_state(str)
+}
+
+# This page procedure passed to ide_winprint print_text. This is
+# called at the start of each page.
+
+proc PRINT_page { pageno } {
+ global PRINT_state
+
+ set PRINT_state(pageno) [format [gettext "Now printing page %d"] $pageno]
+
+ if {$PRINT_state(start)} then {
+ wm deiconify .cancelprint
+
+ grab .cancelprint
+ focus .cancelprint.button
+
+ set PRINT_state(start) 0
+ }
+
+ update
+ return "continue"
+}
diff --git a/libgui/library/sendpr.tcl b/libgui/library/sendpr.tcl
new file mode 100644
index 00000000000..d0ed0fe1492
--- /dev/null
+++ b/libgui/library/sendpr.tcl
@@ -0,0 +1,348 @@
+# sendpr.tcl - GUI to send-pr.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+# FIXME:
+# * consider adding ability to set various options from outside,
+# eg via the configure method.
+# * Have explanatory text at the top
+# * if synopsis not set, don't allow PR to be sent
+# * at least one text field must have text in it before PR can be sent
+# * see other fixme comments in text.
+
+# FIXME: shouldn't have global variable.
+defarray SENDPR_state
+
+itcl_class Sendpr {
+ inherit Ide_window
+
+ # This array holds information about this site. It is a private
+ # common array. Once initialized it is never changed.
+ common _site
+
+ # Initialize the _site array.
+ global Paths tcl_platform
+
+ # On Windows, there is no `send-pr' program. For now, we just
+ # hard-code things there to work in the most important case.
+ if {$tcl_platform(platform) == "windows"} then {
+ set _site(header) ""
+ set _site(to) bugs@cygnus.com
+ set _site(field,Submitter-Id) cygnus
+ set _site(field,Originator) Nobody
+ set _site(field,Release) "Internal"
+ set _site(field,Organization) "Cygnus Solutions"
+ set _site(field,Environment) ""
+ foreach item {byteOrder machine os osVersion platform} {
+ append _site(field,Environment) "$item = $tcl_platform($item)\n"
+ }
+ set _site(categories) foundry
+ } else {
+ set _site(sendpr) [file join $Paths(bindir) send-pr]
+ # If it doesn't exist, try the user's path. This is a hack for
+ # developers.
+ if {! [file exists $_site(sendpr)]} then {
+ set _site(sendpr) send-pr
+ }
+
+ set _site(header) {}
+ set outList [split [exec $_site(sendpr) -P] \n]
+ set lastField {}
+ foreach line $outList {
+ if {[string match SEND-PR* $line]} then {
+ # Nothing.
+ } elseif {[regexp {^$} $line] || [regexp "^\[ \t\]" $line]} then {
+ # Empty lines and lines starting with a blank are skipped.
+ } elseif {$lastField == "" &&
+ [regexp [format {^[^>]([^:]+):[ %s]+(.+)$} \t] \
+ $line dummy field value]} then {
+ # A non-empty mail header line. This can only occur when there
+ # is no last field.
+ if {[string tolower $field] == "to"} then {
+ set _site(to) $value
+ }
+ } elseif {[regexp {^>([^:]*):(.*)$} $line dummy field value]} then {
+ # Found a field. Set it.
+ set lastField $field
+ if {$value != "" && ![string match <*> [string trim $value]]} then {
+ set _site(field,$lastField) $value
+ }
+ } elseif {$lastField == ""} then {
+ # No last field.
+ } else {
+ # Stuff into last field.
+ if {[info exists _site(field,$lastField)]} then {
+ append _site(field,$lastField) \n
+ }
+ append _site(field,$lastField) $line
+ }
+ }
+ # Now find the categories.
+ regsub -all -- {[()\"]} [exec $_site(sendpr) -CL] \
+ "" _site(categories)
+ set _site(categories) [lrmdups [concat foundry $_site(categories)]]
+ }
+
+ # Internationalize some text. We have to do this because of how
+ # Tk's optionmenu works. Indices here are the names that GNATS
+ # wants; this is important.
+ set _site(sw-bug) [gettext "Software bug"]
+ set _site(doc-bug) [gettext "Documentation bug"]
+ set _site(change-request) [gettext "Change request"]
+ set _site(support) [gettext "Support"]
+ set _site(non-critical) [gettext "Non-critical"]
+ set _site(serious) [gettext "Serious"]
+ set _site(critical) [gettext "Critical"]
+ set _site(low) [gettext "Low"]
+ set _site(medium) [gettext "Medium"]
+ set _site(high) [gettext "High"]
+
+ # Any text passed to constructor is saved and put into Description
+ # section of output.
+ constructor {{text ""}} {
+ Ide_window::constructor [gettext "Report Bug"]
+ } {
+ global SENDPR_state
+
+ # The standard widget-making trick.
+ set class [$this info class]
+ set hull [namespace tail $this]
+ set old_name $this
+ ::rename $this $this-tmp-
+ # For now always make a toplevel. Number 7 comes from Windows
+ ::rename $hull $old_name-win-
+ ::rename $this $old_name
+ ::rename $this $this-win-
+ ::rename $this-tmp- $this
+
+ wm withdraw [namespace tail $this]
+###FIXME - this constructor callout will cause the parent constructor to be called twice
+
+ ::set SENDPR_state($this,desc) $text
+
+ #
+ # The Classification frame.
+ #
+
+ Labelledframe [namespace tail $this].cframe -text [gettext "Classification"]
+ set parent [[namespace tail $this].cframe get_frame]
+
+ tixComboBox $parent.category -dropdown 1 -editable 0 \
+ -label [gettext "Category"] -variable SENDPR_state($this,category)
+ foreach item $_site(categories) {
+ $parent.category insert end $item
+ }
+ # FIXME: allow user of this class to set default category.
+ ::set SENDPR_state($this,category) foundry
+
+ ::set SENDPR_state($this,secret) no
+ checkbutton $parent.secret -text [gettext "Confidential"] \
+ -variable SENDPR_state($this,secret) -onvalue yes -offvalue no \
+ -anchor w
+
+ # FIXME: put labels on these?
+ set m1 [_make_omenu $parent.class class 0 \
+ sw-bug doc-bug change-request support]
+ set m2 [_make_omenu $parent.severity severity 1 \
+ non-critical serious critical]
+ set m3 [_make_omenu $parent.priority priority 1 \
+ low medium high]
+ if {$m1 > $m2} then {
+ set m2 $m1
+ }
+ if {$m2 > $m3} then {
+ set m3 $m2
+ }
+ $parent.class configure -width $m3
+ $parent.severity configure -width $m3
+ $parent.priority configure -width $m3
+
+ grid $parent.category $parent.severity -sticky nw -padx 2
+ grid $parent.secret $parent.class -sticky nw -padx 2
+ grid x $parent.priority -sticky nw -padx 2
+
+ #
+ # The text and entry frames.
+ #
+
+ Labelledframe [namespace tail $this].synopsis -text [gettext "Synopsis"]
+ set parent [[namespace tail $this].synopsis get_frame]
+ entry $parent.synopsis -textvariable SENDPR_state($this,synopsis)
+ pack $parent.synopsis -expand 1 -fill both
+
+ # Text fields. Each is wrapped in its own label frame.
+ # We decided to eliminate all the frames but one; the others are
+ # just confusing.
+ ::set SENDPR_state($this,repeat) [_make_text [namespace tail $this].desc \
+ [gettext "Description"]]
+
+ # Some buttons.
+ frame [namespace tail $this].buttons -borderwidth 0 -relief flat
+ button [namespace tail $this].buttons.send -text [gettext "Send"] \
+ -command [list $this _send]
+ button [namespace tail $this].buttons.cancel -text [gettext "Cancel"] \
+ -command [list destroy $this]
+ button [namespace tail $this].buttons.help -text [gettext "Help"] -state disabled
+ standard_button_box [namespace tail $this].buttons
+
+ # FIXME: we'd really like to have sashes between the text widgets.
+ # iwidgets or tix will provide that for us.
+ grid [namespace tail $this].cframe -sticky ew -padx 4 -pady 4
+ grid [namespace tail $this].synopsis -sticky ew -padx 4 -pady 4
+ grid [namespace tail $this].desc -sticky news -padx 4 -pady 4
+ grid [namespace tail $this].buttons -sticky ew -padx 4
+
+ grid rowconfigure [namespace tail $this] 0 -weight 0
+ grid rowconfigure [namespace tail $this] 1 -weight 0
+ grid rowconfigure [namespace tail $this] 2 -weight 1
+ grid rowconfigure [namespace tail $this] 3 -weight 1
+ grid columnconfigure [namespace tail $this] 0 -weight 1
+
+ bind [namespace tail $this].buttons <Destroy> [list $this delete]
+
+ wm deiconify [namespace tail $this]
+ }
+
+ destructor {
+ global SENDPR_state
+ foreach item [array names SENDPR_state $this,*] {
+ ::unset SENDPR_state($item)
+ }
+ catch {destroy $this}
+ }
+
+ method configure {config} {}
+
+ # Create an optionmenu and fill it. Also, go through all the items
+ # and find the one that makes the menubutton the widest. Return the
+ # max width. Private method.
+ method _make_omenu {name index def_index args} {
+ global SENDPR_state
+
+ set max 0
+ set values {}
+ # FIXME: we can't actually examine which one makes the menubutton
+ # widest. Why not? Because the menubutton's -width option is in
+ # characters, but we can only look at the width in pixels.
+ foreach item $args {
+ lappend values $_site($item)
+ if {[string length $_site($item)] > $max} then {
+ set max [string length $_site($item)]
+ }
+ }
+
+ eval tk_optionMenu $name SENDPR_state($this,$index) $values
+
+ ::set SENDPR_state($this,$index) $_site([lindex $args $def_index])
+
+ return $max
+ }
+
+ # Create a labelled frame and put a text widget in it. Private
+ # method.
+ method _make_text {name text} {
+ Labelledframe $name -text $text
+ set parent [$name get_frame]
+ text $parent.text -width 80 -height 15 -wrap word \
+ -yscrollcommand [list $parent.vb set]
+ scrollbar $parent.vb -orient vertical -command [list $parent.text yview]
+ grid $parent.text -sticky news
+ grid $parent.vb -row 0 -column 1 -sticky ns
+ grid rowconfigure $parent 0 -weight 1
+ grid columnconfigure $parent 0 -weight 1
+ grid columnconfigure $parent 1 -weight 0
+ return $parent.text
+ }
+
+ # This takes a text string and finds the element of site which has
+ # the same value. It returns the corresponding key. Private
+ # method.
+ method _invert {text values} {
+ foreach item $values {
+ if {$_site($item) == $text} then {
+ return $item
+ }
+ }
+ error "couldn't find \"$text\""
+ }
+
+ # Send the PR. Private method.
+ method _send {} {
+ global SENDPR_state
+
+ set email {}
+
+ if {[info exists _site(field,Submitter-Id)]} then {
+ set _site(field,Customer-Id) $_site(field,Submitter-Id)
+ unset _site(field,Submitter-Id)
+ }
+
+ foreach field {Customer-Id Originator Release} {
+ append email ">$field: $_site(field,$field)\n"
+ }
+ foreach field {Organization Environment} {
+ append email ">$field:\n$_site(field,$field)\n"
+ }
+
+ append email ">Confidential: "
+ if {$SENDPR_state($this,secret)} then {
+ append email yes\n
+ } else {
+ append email no\n
+ }
+
+ append email ">Synopsis: $SENDPR_state($this,synopsis)\n"
+
+ foreach field {Severity Priority Class} \
+ values {{non-critical serious critical} {low medium high}
+ {sw-bug doc-bug change-request support}} {
+ set name [string tolower $field]
+ set value [_invert $SENDPR_state($this,$name) $values]
+ append email ">$field: $value\n"
+ }
+
+ append email ">Category: $SENDPR_state($this,category)\n"
+
+ # Now big things.
+ append email ">How-To-Repeat:\n"
+ append email "[$SENDPR_state($this,repeat) get 1.0 end]\n"
+
+ # This isn't displayed to the user, but can be set by the caller.
+ append email ">Description:\n$SENDPR_state($this,desc)\n"
+
+ send_mail $_site(to) $SENDPR_state($this,synopsis) $email
+
+ destroy $this
+ }
+
+ # Override from Ide_window.
+ method idew_save {} {
+ global SENDPR_state
+
+ foreach name {category secret severity priority class synopsis} {
+ set result($name) $SENDPR_state($this,$name)
+ }
+ # Stop just before `end'; otherwise we add a newline each time.
+ set result(repeat) [$SENDPR_state($this,repeat) get 1.0 {end - 1c}]
+ set result(desc) $SENDPR_state($this,desc)
+
+ return [list Sendpr :: _restore [array get result]]
+ }
+
+ # This is used to restore a bug report window. Private proc.
+ proc _restore {alist x y width height visibility} {
+ global SENDPR_state
+
+ array set values $alist
+
+ set name .[gensym]
+ Sendpr $name $values(desc)
+ foreach name {category secret severity priority class synopsis} {
+ ::set $SENDPR_state($this,$name) $values($name)
+ }
+ $SENDPR_state($name,repeat) insert end $desc
+
+ $name idew_set_geometry $x $y $width $height
+ $name idew_set_visibility $visibility
+ }
+}
diff --git a/libgui/library/tclIndex b/libgui/library/tclIndex
new file mode 100644
index 00000000000..09d571503d2
--- /dev/null
+++ b/libgui/library/tclIndex
@@ -0,0 +1,199 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(ADVICE_do) [list source [file join $dir advice.tcl]]
+set auto_index(advise) [list source [file join $dir advice.tcl]]
+set auto_index(unadvise) [list source [file join $dir advice.tcl]]
+set auto_index(Balloon) [list source [file join $dir balloon.tcl]]
+set auto_index(BALLOON_find_balloon) [list source [file join $dir balloon.tcl]]
+set auto_index(BALLOON_command_register) [list source [file join $dir balloon.tcl]]
+set auto_index(BALLOON_command_notify) [list source [file join $dir balloon.tcl]]
+set auto_index(BALLOON_command_show) [list source [file join $dir balloon.tcl]]
+set auto_index(BALLOON_command_withdraw) [list source [file join $dir balloon.tcl]]
+set auto_index(BALLOON_command_variable) [list source [file join $dir balloon.tcl]]
+set auto_index(balloon) [list source [file join $dir balloon.tcl]]
+set auto_index(standard_button_box) [list source [file join $dir bbox.tcl]]
+set auto_index(bgerror) [list source [file join $dir bgerror.tcl]]
+set auto_index(bind_widget_after_tag) [list source [file join $dir bindings.tcl]]
+set auto_index(bind_widget_after_class) [list source [file join $dir bindings.tcl]]
+set auto_index(bind_plain_key) [list source [file join $dir bindings.tcl]]
+set auto_index(set_scroll_region) [list source [file join $dir canvas.tcl]]
+set auto_index(Checkframe) [list source [file join $dir cframe.tcl]]
+set auto_index(center_window) [list source [file join $dir center.tcl]]
+set auto_index(::debug::logfile) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::trace_var) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::remove_trace) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::remove_all_traces) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::touched_by) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::show_call_stack) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::createData) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::debugwin) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::debug) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::dbug) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::_putdebug) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::_puttrace) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::init) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::trace_start) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::trace_stop) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::sagetkwait) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::sagevwait) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::sageexit) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::sageproc) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::sageitclbody) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::sageitclproc) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::sagemethod) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::push) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::pop) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::look) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::stackUnwind) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::startWatch) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::resetWatch) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::stopWatch) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::getWatch) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::startTimer) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::stopTimer) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::procEntry) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::methodEntry) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::procExit) [list source [file join $dir debug.tcl]]
+set auto_index(::debug::methodExit) [list source [file join $dir debug.tcl]]
+set auto_index(defarray) [list source [file join $dir def.tcl]]
+set auto_index(defvar) [list source [file join $dir def.tcl]]
+set auto_index(defconst) [list source [file join $dir def.tcl]]
+set auto_index(send_mail) [list source [file join $dir internet.tcl]]
+set auto_index(open_url) [list source [file join $dir internet.tcl]]
+set auto_index(FONT_track_change) [list source [file join $dir font.tcl]]
+set auto_index(define_font) [list source [file join $dir font.tcl]]
+set auto_index(gensym) [list source [file join $dir gensym.tcl]]
+set auto_index(gettext) [list source [file join $dir gettext.tcl]]
+set auto_index(add_hook) [list source [file join $dir hooks.tcl]]
+set auto_index(remove_hook) [list source [file join $dir hooks.tcl]]
+set auto_index(define_hook) [list source [file join $dir hooks.tcl]]
+set auto_index(run_hooks) [list source [file join $dir hooks.tcl]]
+set auto_index(send_mail) [list source [file join $dir internet.tcl]]
+set auto_index(open_url) [list source [file join $dir internet.tcl]]
+set auto_index(Labelledframe) [list source [file join $dir lframe.tcl]]
+set auto_index(lvarpush) [list source [file join $dir list.tcl]]
+set auto_index(lvarpop) [list source [file join $dir list.tcl]]
+set auto_index(lassign) [list source [file join $dir list.tcl]]
+set auto_index(lrmdups) [list source [file join $dir list.tcl]]
+set auto_index(lremove) [list source [file join $dir list.tcl]]
+set auto_index(lrep) [list source [file join $dir list.tcl]]
+set auto_index(lvarcat) [list source [file join $dir list.tcl]]
+set auto_index(standard_look_and_feel) [list source [file join $dir looknfeel.tcl]]
+set auto_index(compute_menu_width) [list source [file join $dir menu.tcl]]
+set auto_index(monochrome_p) [list source [file join $dir mono.tcl]]
+set auto_index(Multibox) [list source [file join $dir multibox.tcl]]
+set auto_index(parse_args) [list source [file join $dir parse_args.tcl]]
+set auto_index(canonical_path) [list source [file join $dir path.tcl]]
+set auto_index(GHOST_helper) [list source [file join $dir postghost.tcl]]
+set auto_index(add_post_command) [list source [file join $dir postghost.tcl]]
+set auto_index(ghosting_menu_item) [list source [file join $dir postghost.tcl]]
+set auto_index(PREFS_run_handlers) [list source [file join $dir prefs.tcl]]
+set auto_index(PREFS_handle_property_event) [list source [file join $dir prefs.tcl]]
+set auto_index(PREFS_cmd_define) [list source [file join $dir prefs.tcl]]
+set auto_index(PREFS_cmd_get) [list source [file join $dir prefs.tcl]]
+set auto_index(PREFS_cmd_getd) [list source [file join $dir prefs.tcl]]
+set auto_index(PREFS_cmd_varname) [list source [file join $dir prefs.tcl]]
+set auto_index(PREFS_cmd_set) [list source [file join $dir prefs.tcl]]
+set auto_index(PREFS_cmd_setd) [list source [file join $dir prefs.tcl]]
+set auto_index(PREFS_cmd_add_hook) [list source [file join $dir prefs.tcl]]
+set auto_index(PREFS_cmd_remove_hook) [list source [file join $dir prefs.tcl]]
+set auto_index(PREFS_cmd_init) [list source [file join $dir prefs.tcl]]
+set auto_index(PREFS_cmd_list) [list source [file join $dir prefs.tcl]]
+set auto_index(pref) [list source [file join $dir prefs.tcl]]
+set auto_index(send_printer) [list source [file join $dir print.tcl]]
+set auto_index(send_printer_ascii) [list source [file join $dir print.tcl]]
+set auto_index(PRINT_windows_ascii) [list source [file join $dir print.tcl]]
+set auto_index(PRINT_query) [list source [file join $dir print.tcl]]
+set auto_index(PRINT_text) [list source [file join $dir print.tcl]]
+set auto_index(PRINT_page) [list source [file join $dir print.tcl]]
+set auto_index(Sendpr) [list source [file join $dir sendpr.tcl]]
+set auto_index(::Sendpr::_restore) [list source [file join $dir sendpr.tcl]]
+set auto_index(bind_for_toplevel_only) [list source [file join $dir topbind.tcl]]
+set auto_index(TOOLBAR_button_enter) [list source [file join $dir toolbar.tcl]]
+set auto_index(TOOLBAR_button_leave) [list source [file join $dir toolbar.tcl]]
+set auto_index(TOOLBAR_button_down) [list source [file join $dir toolbar.tcl]]
+set auto_index(TOOLBAR_button_up) [list source [file join $dir toolbar.tcl]]
+set auto_index(TOOLBAR_maybe_init) [list source [file join $dir toolbar.tcl]]
+set auto_index(TOOLBAR_command) [list source [file join $dir toolbar.tcl]]
+set auto_index(standard_toolbar) [list source [file join $dir toolbar.tcl]]
+set auto_index(multix_treetable_bindings) [list source [file join $dir treetable.tcl]]
+set auto_index(multix_tree_table_search_in_widget) [list source [file join $dir treetable.tcl]]
+set auto_index(multix_tree_table_search_region) [list source [file join $dir treetable.tcl]]
+set auto_index(extract_label_info) [list source [file join $dir ulset.tcl]]
+set auto_index(Widgetframe) [list source [file join $dir wframe.tcl]]
+set auto_index(WINGRAB_disable) [list source [file join $dir wingrab.tcl]]
+set auto_index(WINGRAB_disable_except) [list source [file join $dir wingrab.tcl]]
+set auto_index(WINGRAB_enable) [list source [file join $dir wingrab.tcl]]
+set auto_index(WINGRAB_enable_all) [list source [file join $dir wingrab.tcl]]
+set auto_index(ide_grab_support) [list source [file join $dir wingrab.tcl]]
+set auto_index(Validated_entry) [list source [file join $dir ventry.tcl]]
+set auto_index(::combobox::combobox) [list source [file join $dir combobox.tcl]]
+set auto_index(::combobox::build) [list source [file join $dir combobox.tcl]]
+set auto_index(::combobox::setBindings) [list source [file join $dir combobox.tcl]]
+set auto_index(::combobox::handleEvent) [list source [file join $dir combobox.tcl]]
+set auto_index(::combobox::destroyHandler) [list source [file join $dir combobox.tcl]]
+set auto_index(::combobox::find) [list source [file join $dir combobox.tcl]]
+set auto_index(::combobox::select) [list source [file join $dir combobox.tcl]]
+set auto_index(::combobox::computeGeometry) [list source [file join $dir combobox.tcl]]
+set auto_index(::combobox::doInternalWidgetCommand) [list source [file join $dir combobox.tcl]]
+set auto_index(::combobox::widgetProc) [list source [file join $dir combobox.tcl]]
+set auto_index(::combobox::configure) [list source [file join $dir combobox.tcl]]
+set auto_index(::combobox::vTrace) [list source [file join $dir combobox.tcl]]
+set auto_index(::combobox::setValue) [list source [file join $dir combobox.tcl]]
+set auto_index(::combobox::getBoolean) [list source [file join $dir combobox.tcl]]
+set auto_index(::combobox::widgetName) [list source [file join $dir combobox.tcl]]
+set auto_index(::cyg::Pane) [list source [file join $dir pane.tcl]]
+set auto_index(::cyg::pane) [list source [file join $dir pane.tcl]]
+set auto_index(::cyg::Pane::constructor) [list source [file join $dir pane.tcl]]
+set auto_index(::cyg::Pane::minimum) [list source [file join $dir pane.tcl]]
+set auto_index(::cyg::Pane::maximum) [list source [file join $dir pane.tcl]]
+set auto_index(::cyg::Pane::margin) [list source [file join $dir pane.tcl]]
+set auto_index(::cyg::Pane::childSite) [list source [file join $dir pane.tcl]]
+set auto_index(::cyg::PanedWindow) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::panedwindow) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::constructor) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::orient) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::sashwidth) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::sashcolor) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::index) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::childsite) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::add) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::insert) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::delete) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::hide) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::replace) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::show) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::paneconfigure) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::reset) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::_setActivePanes) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::_eventHandler) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::_resizeArray) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::_startDrag) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::_endDrag) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::_configDrag) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::_handleDrag) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::_moveSash) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::_caclPos) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::_makeSashes) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::_placeSash) [list source [file join $dir panedwindow.tcl]]
+set auto_index(::cyg::PanedWindow::_placePanes) [list source [file join $dir panedwindow.tcl]]
+set auto_index(Tree) [list source [file join $dir tree.tcl]]
+set auto_index(::Tree::filter) [list source [file join $dir tree.tcl]]
+set auto_index(::Tree::nocase_glob_pattern) [list source [file join $dir tree.tcl]]
+set auto_index(::Tree::rebind_config) [list source [file join $dir tree.tcl]]
+set auto_index(::Tree::exec_resize) [list source [file join $dir tree.tcl]]
+set auto_index(::Tree::resize_widget) [list source [file join $dir tree.tcl]]
+set auto_index(::Tree::font_avg_width) [list source [file join $dir tree.tcl]]
+set auto_index(::Tree::exchange) [list source [file join $dir tree.tcl]]
+set auto_index(::Tree::exchange_mark) [list source [file join $dir tree.tcl]]
+set auto_index(treetable_bindings) [list source [file join $dir tree.tcl]]
+set auto_index(tkTreeTableUpDown) [list source [file join $dir tree.tcl]]
+set auto_index(treetable_search_in_widget) [list source [file join $dir tree.tcl]]
+set auto_index(treetable_search_region) [list source [file join $dir tree.tcl]]
+set auto_index(ide_treetable) [list source [file join $dir tree.tcl]]
diff --git a/libgui/library/toolbar.tcl b/libgui/library/toolbar.tcl
new file mode 100644
index 00000000000..daa49d6bc72
--- /dev/null
+++ b/libgui/library/toolbar.tcl
@@ -0,0 +1,235 @@
+# toolbar.tcl - Handle layout for a toolbar.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+# This holds global state for this module.
+defarray TOOLBAR_state {
+ initialized 0
+ button ""
+ window ""
+ relief flat
+ last ""
+}
+
+proc TOOLBAR_button_enter {w} {
+ global TOOLBAR_state
+
+ #save older relief (it covers buttons that
+ #interacte like checkbuttons)
+ set TOOLBAR_state(relief) [$w cget -relief]
+
+ if {[$w cget -state] != "disabled"} then {
+
+ if {$TOOLBAR_state(button) == $w} then {
+ set relief sunken
+ } else {
+ set relief raised
+ }
+
+ $w configure \
+ -state active \
+ -relief $relief
+ }
+
+ #store last action to synchronize operations
+ set TOOLBAR_state(last) enter
+ set TOOLBAR_state(window) $w
+}
+
+proc TOOLBAR_button_leave {w} {
+ global TOOLBAR_state
+ if {[$w cget -state] != "disabled"} then {
+ $w configure -state normal
+ }
+
+ #restore original relief
+ if {
+ $TOOLBAR_state(window) == $w
+ && $TOOLBAR_state(last) == "enter"
+ } then {
+ $w configure -relief $TOOLBAR_state(relief)
+ } else {
+ $w configure -relief flat
+ }
+
+ set TOOLBAR_state(window) ""
+ #store last action to synch operations (enter->leave)
+ set TOOLBAR_state(last) leave
+}
+
+proc TOOLBAR_button_down {w} {
+ global TOOLBAR_state
+ if {[$w cget -state] != "disabled"} then {
+ set TOOLBAR_state(button) $w
+ $w configure -relief sunken
+ }
+}
+
+proc TOOLBAR_button_up {w} {
+ global TOOLBAR_state
+ if {$w == $TOOLBAR_state(button)} then {
+ set TOOLBAR_state(button) ""
+
+ #restore original relief
+ $w configure -relief $TOOLBAR_state(relief)
+
+ if {$TOOLBAR_state(window) == $w
+ && [$w cget -state] != "disabled"} then {
+
+#SN does the toolbar bindings using "+" so that older
+#bindings don't disapear. So no need to invoke the command.
+#other applications should do the same so that we can delete
+#this hack
+global sn_options
+if {! [array exists sn_options]} {
+ #invoke the binding
+ uplevel \#0 [list $w invoke]
+}
+ if {[winfo exists $w]} then {
+ if {[$w cget -state] != "disabled"} then {
+ $w configure -state normal
+ }
+ }
+ }
+ }
+}
+
+# Set up toolbar bindings.
+proc TOOLBAR_maybe_init {} {
+ global TOOLBAR_state
+ if {! $TOOLBAR_state(initialized)} then {
+ set TOOLBAR_state(initialized) 1
+
+ # We can't put our bindings onto the widget (and then use "break"
+ # to avoid the class bindings) because that interacts poorly with
+ # balloon help.
+ bind ToolbarButton <Enter> [list TOOLBAR_button_enter %W]
+ bind ToolbarButton <Leave> [list TOOLBAR_button_leave %W]
+ bind ToolbarButton <1> [list TOOLBAR_button_down %W]
+ bind ToolbarButton <ButtonRelease-1> [list TOOLBAR_button_up %W]
+ }
+}
+
+#Allows changing options of a toolbar button from the application
+#especially the relief value
+proc TOOLBAR_command {w args} {
+ global TOOLBAR_state
+
+ set len [llength $args]
+ for {set i 0} {$i < $len} {incr i} {
+ set cmd [lindex $args $i]
+ switch -- $cmd {
+ "relief" -
+ "-relief" {
+ incr i
+ set TOOLBAR_state(relief) [lindex $args $i]
+ $w configure $cmd [lindex $args $i]
+ }
+ "window" -
+ "-window" {
+ incr i
+ set TOOLBAR_state(window) [lindex $args $i]
+ }
+ default {
+ #normal widget options
+ incr i
+ $w configure $cmd [lindex $args $i]
+ }
+ }
+ }
+}
+
+# Pass this proc a frame and some children of the frame. It will put
+# the children into the frame so that they look like a toolbar.
+# Children are added in the order they are listed. If a child's name
+# is "-", then the appropriate type of separator is entered instead.
+# If a child's name is "--" then all remaining children will be placed
+# on the right side of the window.
+#
+# For non-flat mode, each button must display an image, and this image
+# must have a twin. The primary (raised) image's name must end in
+# "u", and the depressed image's name must end in "d". Eg the edit
+# images should be called "editu" and "editd". There's no doubt that
+# this is a hack.
+#
+# If you want to add a button that doesn't have an image (or whose
+# image doesn't have a twin), you must wrap it in a frame.
+#
+# FIXME: someday, write a `toolbar button' widget that handles the
+# image mess invisibly.
+proc standard_toolbar {frame args} {
+ global tcl_platform
+
+ # For now, there are two different layouts, depending on which kind
+ # of icons we're using. This is just a test feature and will be
+ # eliminated once we decide on an icon style.
+
+ TOOLBAR_maybe_init
+
+ # We reserve column 0 for some padding.
+ set column 1
+ if {$tcl_platform(platform) == "windows"} then {
+ # See below to understand this.
+ set row 1
+ } else {
+ set row 0
+ }
+ # This is set if we see "--" and thus the filling happens in the
+ # center.
+ set center_fill 0
+ set sticky w
+ foreach button $args {
+ grid columnconfigure $frame $column -weight 0
+
+ if {$button == "-"} then {
+ # A separator.
+ set f [frame $frame.[gensym] -borderwidth 1 -width 2 -relief sunken]
+ grid $f -row $row -column $column -sticky ns${sticky} -padx 4
+ } elseif {$button == "--"} then {
+ # Everything after this is put on the right. We do this by
+ # adding a column that sucks up all the space.
+ set center_fill 1
+ set sticky e
+ grid columnconfigure $frame $column -weight 1 -minsize 7
+ } elseif {[winfo class $button] != "Button"} then {
+ # Something other than a button. Just put it into the frame.
+ grid $button -row $row -column $column -sticky $sticky -pady 2
+ } else {
+ # A button.
+ # FIXME: does Windows allow focus traversal? For now we're
+ # just turning it off.
+ $button configure -takefocus 0 -highlightthickness 0 \
+ -relief flat -borderwidth 1
+ grid $button -row $row -column $column -sticky $sticky -pady 2
+
+ # Make sure the button acts the way we want, not the default Tk
+ # way.
+ set index [lsearch -exact [bindtags $button] Button]
+ bindtags $button [lreplace [bindtags $button] $index $index \
+ ToolbarButton]
+ }
+
+ incr column
+ }
+
+ # On Unix, it looks a little more natural to have a raised toolbar.
+ # On Windows the toolbar is flat, but there is a horizontal
+ # separator between the toolbar and the menubar. On both platforms
+ # we provide some space to the left of the leftmost widget.
+ grid columnconfigure $frame 0 -minsize 7 -weight 0
+
+ if {$tcl_platform(platform) == "windows"} then {
+ $frame configure -borderwidth 0 -relief flat
+ set name $frame.[gensym]
+ frame $name -height 2 -borderwidth 1 -relief sunken
+ grid $name -row 0 -column 0 -columnspan $column -pady 1 -sticky ew
+ } else {
+ $frame configure -borderwidth 2 -relief raised
+ }
+
+ if {! $center_fill} then {
+ # The rightmost column sucks up the extra space.
+ incr column -1
+ grid columnconfigure $frame $column -weight 1
+ }
+}
diff --git a/libgui/library/topbind.tcl b/libgui/library/topbind.tcl
new file mode 100644
index 00000000000..e31835a6246
--- /dev/null
+++ b/libgui/library/topbind.tcl
@@ -0,0 +1,29 @@
+# topbind.tcl - Put a binding on a toplevel.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+#
+# Put a binding on a toplevel. This needs a separate proc because by
+# default the toplevel's name is put into the bindtags list for all
+# its descendents. Eg Destroy bindings typically don't want to be run
+# more than once.
+#
+
+# FIXME: should catch destroy operations and remove all bindings for
+# our tag.
+
+# Make the binding. Return nothing.
+proc bind_for_toplevel_only {toplevel sequence script} {
+ set tagList [bindtags $toplevel]
+ set tag _DBind_$toplevel
+ if {[lsearch -exact $tagList $tag] == -1} then {
+ # Always put our new binding first in case the other bindings run
+ # break.
+ bindtags $toplevel [concat $tag $tagList]
+ }
+
+ # Use "+" binding in case there are multiple calls to this. FIXME
+ # should just use gensym.
+ bind $tag $sequence +$script
+
+ return {}
+}
diff --git a/libgui/library/tree.tcl b/libgui/library/tree.tcl
new file mode 100644
index 00000000000..5812436545b
--- /dev/null
+++ b/libgui/library/tree.tcl
@@ -0,0 +1,2104 @@
+# tree.tcl - A tree widget class with tab stop support.
+# Copyright (C) 1998 Cygnus Solutions.
+
+#we need to do this to make sure that other applications as
+#Source-Navigator can use this tree tool
+if {! [info exists sn_options(def,default-font)]} {
+ set sn_options(def,default-font) ansi
+ if {$tcl_platform(platform) == "windows"} {
+ set sn_options(def,select-fg) SystemHighlightText
+ set sn_options(def,select-bg) SystemHighlight
+ set sn_options(def,bold-font) global/bold
+ } else {
+ set sn_options(def,select-fg) black
+ set sn_options(def,select-bg) yellow
+ set sn_options(def,bold-font) "-*-Courier-Bold-R-Normal--*-120-*-*-*-*-iso8859-1"
+ }
+}
+
+itcl_class Tree {
+ inherit itk::Widget
+
+ global sn_options
+
+ constructor {config} {
+ global sn_options
+
+ #set up a short name for accessing real name path
+ set thisTail [namespace tail $this]
+
+ if {$withframe} {
+ set lframe $thisTail.fr
+ ::frame $lframe -bd 2 -relief sunken
+ } else {
+ set lframe $thisTail
+ }
+ set tree $lframe.tree
+
+ if {$font == ""} {
+ set font $sn_options(def,default-font)
+ }
+ if {$selectforeground == ""} {
+ set selectforeground $sn_options(def,select-fg)
+ }
+ if {$selectbackground == ""} {
+ set selectbackground $sn_options(def,select-bg)
+ }
+
+ ide_treetable $lframe\
+ -takefocus 1 \
+ -exportselection $exportselection \
+ -fillselection $fillselection \
+ -selectmode $selectmode \
+ -sortedinsertion $sortedinsertion\
+ -nocase $sortnocase \
+ -col $sortcolumn \
+ -bitmapspace $bitmapspace \
+ -bestfit $bestfit \
+ -autofit $autofit \
+ -truncate $truncate \
+ -splitlines $splitlines \
+ -tabfreespace $tabfreespace \
+ -accelerator $accelerator \
+ -truncatemethode $truncatemethode \
+ -font $font \
+ -lineforeground $lineforeground \
+ -splitlineforeground $splitlineforeground \
+ -selectforeground $selectforeground \
+ -selectbackground $selectbackground \
+ -selectborderwidth $selectborderwidth \
+ -highlightwidth $highlightwidth \
+ -highlightthickness $highlightthickness \
+ -indentwidth $indentwidth \
+ -borderwidth $borderwidth \
+ -width $width \
+ -height $height
+ # -geometry ${width}x${height}
+
+ if {$hiddenbitmap != ""} {
+ $tree config -hiddenbitmap $hiddenbitmap
+ }
+ if {$hiddenimage != ""} {
+ $tree config -hiddenimage $hiddenimage
+ }
+ if {$plusimage != ""} {
+ $tree config -plusimage $plusimage
+ }
+ if {$minusimage != ""} {
+ $tree config -minusimage $minusimage
+ }
+ if {$unknownimage != ""} {
+ $tree config -unknownimage $unknownimage
+ }
+ if {$tabs != ""} {
+ $tree config -tabs $tabs
+ }
+ if {$justify != ""} {
+ $tree config -justify $justify
+ }
+
+ #printing
+ ::bind $tree <Control-p> "$this print_dialog_box; break"
+ ::bind $tree <Control-c> "$this put_in_cutbuffer; break"
+ ::bind $tree <F16> [bind $tree <Control-c>]
+
+ #filter
+ if {$filter != ""} {
+ frame $lframe.filter
+ label $lframe.filter.label -text [get_indep String Pattern]
+ set entry $lframe.filter.entry
+ entry $entry \
+ -relief sunken \
+ -exportselection 0 \
+ -width 3 \
+ -textvariable $thisTail-filter
+ global $thisTail-filter
+ ::set $thisTail-filter $filter
+ $entry icursor 0
+
+ ::bind $entry <Return> "watch y; $this fill; watch n"
+
+ #make binding ctrl-u/l/r for filtering
+ ::bind $tree <Control-u> "
+ watch y
+ $this config -filter \"*\"
+ $this fill
+ focus %W
+ watch n
+ break
+ "
+ ::bind $tree <Control-l> [::bind $tree <Control-u>]
+ ::bind $tree <Control-r> [::bind $tree <Control-u>]
+
+ pack $lframe.filter.label -side left
+ pack $entry -side left -fill x -expand y -padx 3
+
+ if {$filter_window} {
+ pack $lframe.filter\
+ -side bottom -fill x
+ }
+ }
+
+ if {$withframe} {
+ pack $lframe -side top -fill both -expand yes
+ }
+
+ #now create the labels for columns
+ if {$tabsize > -1} {
+ create_tabs
+ view_tabs
+ pack $lframe.size -side top -fill x -anchor nw
+ resize 0 [lindex [$tree cget -tabs] 0] 0
+ }
+
+ #pack the tree _after_ the column labels have been
+ #created and packed.
+ pack $tree -side bottom -fill both -expand yes
+
+ #bind_focus_enter $tree {catch {focus %W}}
+
+ if {$tabsize > -1} {
+ ::bind $tree <B2-ButtonRelease> "Tree::resize_widget $tree"
+ ::bind $lframe.x <B1-ButtonRelease> "$this replace_buttons"
+
+ ::bind $tree <3> "$this post_commands %X %Y; break"
+ }
+ ::bind $lframe.y <B1-ButtonRelease> "Tree::resize_widget $tree"
+
+ #add contents to the list
+ contents
+
+ #propagate
+ if {! $propagate} {
+ after idle "update idletasks; pack propagate [winfo toplevel $tree] $propagate"
+ }
+ }
+
+ destructor {
+ foreach v [::info globals "$thisTail-*"] {
+ catch {uplevel #0 unset $v}
+ }
+ }
+
+ method Xview {x1 x2 {x3 ""}} {
+ if {$x3 != ""} {
+ $tree xview $x1 $x2 $x3
+ } else {
+ $tree xview $x1 $x2
+ }
+ if {$tabsize > -1} {
+ resize 0 [lindex [$tree cget -tabs] 0] 0
+ }
+ }
+
+ method tree {} {
+ return $tree
+ }
+ method insert {args} {
+ set idx [lindex $args 0]
+ set cnt [lindex $args 1]
+ set args [lrange $args 2 end]
+ ::eval $lframe.tree insert $idx list [list $cnt] $args
+ }
+
+ method remove {from {to ""}} {
+ if {$to == ""} {
+ set to $from
+ }
+ $lframe.tree delete $from $to
+ }
+
+ method search args {
+ return [::eval $lframe.tree search $args]
+ }
+
+ method resort {num {var ""}} {
+ global sn_options
+ global $thisTail-sort
+
+ $tree config -cursor watch
+ set fnt [$lframe.size.btn$num cget -font]
+
+ #restore old font for the last sort column
+ if {$oldnum != $num} {
+ if {$oldnum != -1} {
+ $lframe.size.btn$oldnum configure -font $oldfont
+ }
+ set oldnum $num
+ set oldfont $fnt
+ }
+
+ #change actual column font to bold
+ set fnt [split $fnt "-"]
+ if {[llength $fnt] > 3} {
+ set fnt [join [lreplace $fnt 3 3 "bold"] "-"]
+ } else {
+ set fnt $sn_options(def,bold-font)
+ }
+
+ $lframe.size.btn$num config -cursor watch -font $fnt
+ update idletasks
+
+ #call sort command to resort entries
+ $tree sort -nocase -col $num
+
+ $lframe.size.btn$num config -cursor {}
+ $tree config -cursor {}
+ set oldnum $num
+ set actual_sortcolumn $num
+
+ set $thisTail-sort $num
+ }
+
+ #select an entry by it's index number
+ method selectnum {num} {
+ $tree selection clear 0 end
+ $tree selection set $num
+ $tree see $num
+ }
+
+ method selection {args} {
+ return [::eval $tree selection $args]
+ }
+
+ method cget {args} {
+ return [::eval $tree cget $args]
+ }
+
+ method config {config} {
+ }
+
+ method xview {args} {
+ return [::eval $tree xview $args]
+ }
+
+ method yview {args} {
+ return [::eval $tree yview $args]
+ }
+ #an array of column filters
+ protected col_filter ""
+ protected colfilters
+ public filterextension ""
+ method edit_column_filter {w num X Y} {
+ global $thisTail-filterentry
+ if {![info exists colfilters($num)]} {
+ set colfilters($num) "*"
+ }
+ ::set $thisTail-filterentry $colfilters($num)
+
+ #if there is no label, no filter
+ if {[$w cget -text] == ""} {
+ bell; return
+ }
+
+ set x [winfo rootx $w]
+ set y [winfo rooty $w]
+ set h [expr [winfo height $w] + 1]
+ set width [winfo width $w]
+ set color white
+ set m $thisTail-filter_menu
+ catch {destroy $m}
+ menu $m -tearoff 0
+ wm overrideredirect $m 1
+ wm withdraw $m
+ wm geometry $m ${width}x${h}+$x+$y
+ pack [entry $m.l \
+ -bg $color \
+ -bd 0 \
+ -relief raised \
+ -textvariable $thisTail-filterentry] -fill both -expand y
+ ::bind $m.l <Return> "$this set_column_filter $w $num; tkMenuUnpost $m; break"
+ ::bind $m.l <Escape> "tkMenuUnpost $m; break"
+
+ raise $m
+ wm deiconify $m
+ tk_popup $m $x $y
+ focus $m.l
+ }
+
+ method set_column_filter {w num} {
+ upvar #0 $thisTail-filterentry fltentry
+
+ #store column filter
+ set colfilters($num) $fltentry
+
+ #display filter into label
+ set txt [lindex $labels $num]
+ if {$fltentry == "*" || $fltentry == ""} {
+ set colfilters($num) "*"
+ #label without filter
+ $w config -text $txt
+ } else {
+ $w config -text "${txt}($fltentry)"
+ }
+
+ calculate_column_filter
+
+ watch y $this
+ fill
+ watch n $this
+
+ resize_widget $tree
+
+ ::unset fltentry
+ }
+
+ method calculate_column_filter {} {
+ if {$tabsize == -1} {
+ return ""
+ }
+ set tabs [$tree cget -tabs]
+
+ #build tree filter
+ set col_filter ""
+ set cmp ""
+ for {set i 0} {$i <= $tabsize} {incr i} {
+
+ #if label is hidden, disable it's filter
+ if {[lindex $tabs $i] <= 0} {
+ set flt "*"
+ } else {
+ set flt $colfilters($i)
+ }
+ if {$col_filter == ""} {
+ set col_filter $flt
+ set cmp "*"
+ } else {
+ append col_filter "\t$flt"
+ append cmp "\t*"
+ }
+ }
+
+ #no column filter is specified
+ if {$cmp == $col_filter} {
+ set col_filter ""
+ } elseif {$filterextension != ""} {
+ append col_filter $filterextension
+ }
+
+ return $col_filter
+ }
+
+ method delete_column_filters {} {
+ for {set i 0} {$i <= $tabsize} {incr i} {
+ if {$colfilters($i) != "*"} {
+ set colfilters($i) "*"
+ change_label $i [lindex $labels $i]
+ }
+ }
+
+ set old_col_filter $col_filter
+
+ calculate_column_filter
+
+ if {$col_filter != $old_col_filter} {
+ watch y $this
+ fill
+ resize_widget $tree
+ watch n $this
+ }
+ }
+
+ method change_label {num txt} {
+ if {$txt != "" && $colfilters($num) != "*"} {
+ set txt "${txt}($colfilters($num))"
+ }
+ $lframe.size.btn$num config -text $txt
+ }
+
+ #modify the tabs, eventualy delete or add new tabs
+ method change_tabs {size tbs lbls} {
+ set tabsize $size
+ set tabs $tbs
+ set labels $lbls
+
+ $tree config -tabs $tabs
+ if {[winfo exists $lframe.size] && $tabsize != -1} {
+ for {set i 0} {$i <= $tabsize} {incr i} {
+ $lframe.size.btn$i configure -text [lindex $labels $i]
+ }
+ view_tabs
+ resize 0 [lindex [$tree cget -tabs] 0] 0
+ Tree :: resize_widget $tree
+ }
+ }
+
+ method toggle_column {num {var ""} {value -1}} {
+ if {$value == -1} {
+ $tree column toggle $num
+ } else {
+ if {$value} {
+ set cmd view
+ } else {
+ set cmd hide
+ }
+ $tree column $cmd $num
+ }
+ resize_widget $tree
+
+ if {$value != -1} {
+ set column_toggled($num) $value
+ } else {
+ if {![info exists column_toggled($num)] || $column_toggled($num)} {
+ set column_toggled($num) 0
+ } else {
+ set column_toggled($num) 1
+ }
+ }
+ if {$var != ""} {
+ upvar #0 $var v
+ set v $column_toggled($num)
+ }
+ }
+
+ method justify_column {num {var ""}} {
+ set aligns [$tree cget -justify]
+ if {$aligns == ""} {
+ for {set i 0} {$i <= $tabsize} {incr i} {
+ lappend aligns 0
+ }
+ }
+
+ upvar #0 $var v
+ set aligns [lreplace $aligns $num $num $v]
+ $tree config -justify $aligns
+ }
+
+ method toggle_splitlines {} {
+ if {$splitlines} {
+ set splitlines 0
+ } else {
+ set splitlines 1
+ }
+ if {[winfo exists $tree]} {
+ $tree config -splitlines $splitlines
+ }
+ }
+ method propagate {} {
+ return $propagate
+ }
+
+ method size {} {
+ if {[winfo exists $tree]} {
+ return [$tree size]
+ }
+ return 0
+ }
+
+ method curselection {} {
+ return [$tree curselection]
+ }
+
+ method get {args} {
+ return [::eval $tree get $args]
+ }
+
+ method itemcget {args} {
+ return [::eval $tree itemcget $args]
+ }
+
+ method itemconfig {args} {
+ return [::eval $tree itemconfig $args]
+ }
+
+ #we need this procedure to sort the contents by using
+ #the flags in the class to insert the contents in the list
+ method sortcontents {lst} {
+ if {$sort != ""} {
+ if {$nocase} {
+ if {$uniq} {
+ set lst [::lunique [::lsort $sort -command sn_compare $lst]]
+ } else {
+ set lst [::lsort $sort -command sn_compare $lst]
+ }
+ } elseif {$uniq} {
+ set lst [::lunique [::lsort $sort $lst]]
+ } else {
+ set lst [::lsort $sort $lst]
+ }
+ }
+ return $lst
+ }
+
+ method setcontents {cnt} {
+ set contents $cnt
+ }
+
+ method getcontents {} {
+ return $contents
+ }
+
+ method contents {} {
+ if {![winfo exists $tree]} {
+ return
+ }
+ if {$sort != ""} {
+ if {$nocase} {
+ if {$uniq} {
+ set contents [::lunique [::lsort $sort -command sn_compare $contents]]
+ } else {
+ set contents [::lsort $sort -command sn_compare $contents]
+ }
+ } elseif {$uniq} {
+ set contents [lunique [::lsort $sort $contents]]
+ } else {
+ set contents [::lsort $sort $contents]
+ }
+ }
+
+ fill
+ Tree::resize_widget $tree
+ }
+
+ method setfilter {flt} {
+ filter $contents $flt
+ }
+
+ method filter_state {state} {
+ if {![winfo exists $entry]} {
+ return
+ }
+ if {$state == "disabled"} {
+ global $thisTail-filter
+ ::set $thisTail-filter "*"
+ }
+ $entry config -state $state
+ }
+
+ #filter and sort the contents of the tree, this command is usefull
+ #to use by external 'fill' commands (See Retriever').
+ proc filter {cnt {filter_str ""} {nocase 1}} {
+
+ if {$filter_str == ""} {
+ set filter_str "*"
+ }
+
+ if {$filter_str == "*" || $cnt == ""} {
+ return $cnt
+ }
+
+ if {$nocase} {
+ set flt [nocase_glob_pattern $filter_str]
+ } else {
+ set flt $filter_str
+ }
+
+ return [lmatch $cnt $flt]
+ }
+
+ method fill {{bsy 0}} {
+
+ if {$fillcommand != ""} {
+ set res [::eval $fillcommand $this [list $contents]]
+ Tree :: resize_widget $tree
+ return $res
+ }
+
+ #set frst [$tree index @0,0]
+ #if {$frst == ""} {
+ # set frst 0
+ #}
+ #set y [lindex [$tree yview] 0]
+
+ set filter [getfilter]
+
+ #delete old entries
+ $tree delete 0 end
+
+ if {$contents == ""} {
+ return
+ }
+
+ if {$filter != "*" && $filter != ""} {
+ if {$nocase} {
+ set flt [nocase_glob_pattern $filter]
+ } else {
+ set flt $filter
+ }
+ } else {
+ set flt "*"
+ }
+
+ if {$flt != "*"} {
+ $tree insert end list [lmatch $contents $flt]
+ } else {
+ $tree insert end list $contents
+ }
+
+ $tree see -top 0
+ #$tree yview moveto $y
+ }
+
+ method getfilter {} {
+ upvar #0 $thisTail-filter flt
+
+ #calculate filter always
+ calculate_column_filter
+
+ if {$col_filter != ""} {
+ return $col_filter
+ }
+ if {[winfo exists $entry]} {
+ set filter $flt
+ } else {
+ set filter "*"
+ }
+ if {$filter == ""} {
+ set filter "*"
+
+ ::set $thisTail-filter "*"
+ $entry icursor 0
+ }
+
+ return $filter
+ }
+
+ #get selected entries or selected positions
+ method marked {{str 1}} {
+ set sel [$this curselection]
+ if {$str} {
+ set val ""
+ foreach s $sel {
+ lappend val [$lframe.tree get $s]
+ }
+ return $val
+ } else {
+ return $sel
+ }
+ }
+
+ #convert filter to usable filter for string matching
+ proc nocase_glob_pattern {flt} {
+ if {[string compare $flt "*"] == 0} {
+ return $flt
+ }
+ for {set c 0; set brace_lev 0; set m ""; set glb_pat "";\
+ set flt [string tolower $flt]} \
+ {$c < [string length $flt]} {incr c} {
+
+ set ch [string index $flt $c]
+ switch -glob -- $ch {
+ {[A-Za-z]} {
+ if {$brace_lev <= 0} {
+ append m \[ [string tolower $ch] \
+ [string toupper $ch] \]
+ } else {
+ append glb_pat $ch
+ }
+ }
+ {\[} {
+ append m \[
+ set glb_pat ""
+ incr brace_lev
+ }
+ {\]} {
+ for {set k 0} {$k < [string length $glb_pat]} \
+ {incr k} {
+ set cc [string index $glb_pat $k]
+ set nc [string index $glb_pat [expr $k + 1]]
+ append m [string tolower $cc]
+ if {[string compare $nc "-"] == 0} {
+ incr k 2
+ set nc [string index $glb_pat $k]
+ append m "-" [string tolower $nc] \
+ [string toupper $cc] "-" [string toupper $nc]
+ } else {
+ append m [string toupper $cc]
+ }
+ }
+ set glb_pat ""
+ append m \]
+ incr brace_lev -1
+ }
+ {\\} {
+ incr c
+ append m "\\" [string index $flt $c]
+ }
+ default {
+ if {$brace_lev <= 0} {
+ append m $ch
+ } else {
+ append glb_pat $ch
+ }
+ }
+ }
+ }
+ return $m
+ }
+
+ public splitwidth 1
+
+ #this brings the split lines from the tree and the lines
+ #from this class to be displayed in one line
+ protected correction_factor 3
+
+ #function is called to synchronize the widget labels with
+ #the tabulators defined in the treetable.
+ #it doesn't display the labels for hidden columns/tabs
+ method resize {num x {realy 1}} {
+ if {![winfo exists $lframe.size] || $x == ""} {
+ return
+ }
+
+ #end motion process
+ end_motion
+
+ set twidth [winfo width $tree]
+ if {$twidth <= 1} {
+ set twidth [winfo reqwidth $tree]
+ }
+ set frheight [winfo height $lframe.size]
+ if {$frheight <= 1} {
+ set frheight [winfo reqheight $lframe.size]
+ }
+ if {$frheight <= 1} {
+ set frheight [winfo reqheight $lframe.size.btn0]
+ }
+ set xoffset [expr [$tree xoffset] - $correction_factor]
+ set oldtabs $tabs
+ set tabs [$tree cget -tabs]
+ if {$realy} {
+ set x [expr $x - [winfo rootx $lframe.size] + $xoffset]
+ }
+
+ set ox 0
+ set tx 0
+ for {set i 0} {$i <= $tabsize} {incr i} {
+ if {$i < $tabsize} {
+ if {$x >= 0 && $num == $i} {
+ set mx $ox
+ if {$x < $mx} {
+ set x $mx
+ }
+ set tab [lindex $tabs $i]
+ set diff [expr $x - [expr $tx + $tab]]
+ set tab [expr $tab + $diff]
+ set tabs [lreplace $tabs $i $i $tab]
+ set tx $x
+ } else {
+ set tx [expr $tx + [lindex $tabs $i]]
+ }
+ set width [lindex $tabs $i]
+ if {$width == 0} {
+ #column hidden
+ place forget $lframe.size.col$i
+ } else {
+ place $lframe.size.col$i \
+ -y 1 \
+ -x [expr $tx - $xoffset]
+ }
+ } else {
+ #take the rest of the window size
+ set tx [expr $tx + $width]
+ set width [expr $twidth - $ox + $xoffset + 20]
+ }
+ if {$width == 0} {
+ #column hidden
+ place forget $lframe.size.btn$i
+ } else {
+ if {$i == 0} {
+ place $lframe.size.btn$i \
+ -y 1 \
+ -x [expr $ox - $xoffset - $correction_factor] \
+ -width [expr $width + $correction_factor] \
+ -height $frheight
+ } else {
+ place $lframe.size.btn$i \
+ -y 1 \
+ -x [expr $ox - $xoffset + 1] \
+ -width [expr $width - 1] \
+ -height $frheight
+ }
+ }
+ set ox $tx
+ }
+
+ if {$oldtabs != $tabs} {
+ $tree config -tabs $tabs
+ }
+
+ #set up height correctly for size frame and columns
+ set hh [winfo reqheight $lframe.size.btn0]
+ if {$frame_height != $hh} {
+ $lframe.size config -height [expr $hh + 2]
+ set frame_height $hh
+ }
+ if {$col_height != $hh} {
+ for {set i 0} {$i < $tabsize} {incr i} {
+ $lframe.size.col$i config -height $hh
+ set col_height $hh
+ }
+ }
+ }
+
+ method create_tabs {} {
+ global $thisTail-sort
+
+ #create widgets
+ ::frame $lframe.size -bd 0 -relief raised -bg black
+
+ #-height 30
+ for {set i 0} {$i <= $tabsize} {incr i} {
+ if {$labels == ""} {
+ set lbl col$i
+ } else {
+ set lbl [lindex $labels $i]
+ }
+ #label and button for columns
+ if {$justify != "" && [lindex $justify $i] == "1"} {
+ set anchor e
+ } else {
+ set anchor w
+ }
+
+ #label filter
+ set colfilters($i) "*"
+
+ ::button $lframe.size.btn$i \
+ -bd 1 \
+ -text $lbl \
+ -anchor $anchor \
+ -relief raised \
+ -command "watch y; $this resort $i; watch n"
+ ::bind $lframe.size.btn$i <B3-ButtonRelease> \
+ "$this edit_column_filter %W $i %X %Y"
+
+ #if bestfir or autofit is enabled, store the button widths
+ #as default tab size for the tab stops.
+ if {$bestfit || $autofit} {
+ set bwidth [winfo width $lframe.size.btn$i]
+ if {$bwidth <= 1} {
+ set bwidth [winfo reqwidth $lframe.size.btn$i]
+ }
+ set tabs [lreplace $tabs $i $i $bwidth]
+ }
+ balloon_bind_info $lframe.size.btn$i [get_indep String TreeButton]
+
+ ::bind $lframe.size.btn$i <Motion> "$this button_motion %W $i %x"
+ ::bind $lframe.size.btn$i <1> "
+ set $thisTail-motion \[$this button_motion %W $i %x\]
+ if {\${$thisTail-motion} <= 0} {
+ $this start_motion \[expr {$i + \${$thisTail-motion}}\] %X
+ break
+ } else {
+ catch {unset $thisTail-motion}
+ }
+ "
+ ::bind $lframe.size.btn$i <B1-Motion> "
+ if {\[info exists $thisTail-motion\]} {
+ $this motion \[expr {$i + \${$thisTail-motion}}\] %X
+ break
+ }
+ "
+ ::bind $lframe.size.btn$i <B1-ButtonRelease> "
+ if {\[info exists $thisTail-motion\]} {
+ $this resize \[expr {$i + \${$thisTail-motion}}\] %X
+ catch {unset $thisTail-motion}
+ break
+ }
+ "
+
+ if {$i < $tabsize} {
+ ::frame $lframe.size.col$i \
+ -relief raised \
+ -width $splitwidth \
+ -height 7 \
+ -cursor sb_h_double_arrow
+ balloon_bind_info $lframe.size.col$i [get_indep String TreeColumn]
+
+ #start motion process
+ ::bind $lframe.size.col$i <1> "$this start_motion $i %X"
+
+ #motion process
+ ::bind $lframe.size.col$i <B1-Motion> "$this motion $i %X"
+
+ #end motion process and place the columns correctly
+ ::bind $lframe.size.col$i <B1-ButtonRelease>\
+ "$this resize $i %X"
+
+ #enable/disable split lines displaying
+ ::bind $lframe.size.col$i <3> "$this toggle_splitlines"
+ }
+ }
+
+ if {$bestfit || $autofit} {
+ $lframe.tree config -deftabs $tabs
+ }
+ }
+ method view_tabs {} {
+ set tabs [$tree cget -tabs]
+ set cnt [llength $tabs]
+ set last [lindex $tabs end]
+ set modified 0
+
+ if {$cnt > 1} {
+ set size [lindex $tabs end]
+ } else {
+ set size [lindex $tabs 0]
+ }
+ if {$last == ""} {
+ set last [expr [font_avg_width $tree] * 8]
+ }
+
+ #expand tab list to count of columns
+ for {set i $cnt} {$i < $tabsize} {incr i} {
+ lappend tabs $last
+ set modified 1
+ }
+ for {set i 0; set x 0} {$i < $tabsize} {incr i} {
+ place config $lframe.size.col$i -x $x
+ set x [expr $x + [lindex $tabs $i]]
+ }
+ if {$modified} {
+ $tree config -tabs $tabs
+ }
+ for {set $i $tabsize} {$i < 10} {incr i} {
+ if {[winfo exists $lframe.size.col$i]} {
+ catch {place forget $lframe.size.col$i}
+ catch {place forget $lframe.size.btn[expr $i + 1]}
+ } else {
+ #no need to continue
+ break
+ }
+ }
+ }
+
+ proc rebind_config {} {
+ if {[info exists resizing]} {
+ foreach w [array names resizing] {
+ catch {
+ ::bind $w <Configure> {Tree::resize_widget %W}
+ }
+ #catch {update idletasks; ::bind $w <Configure> "Tree::resize_widget %W"}
+ }
+ catch {unset resizing}
+ }
+ }
+ proc exec_resize {} {
+ foreach W [array names resizing] {
+ if {[catch {set f [winfo parent $W]}]} {
+ catch {unset resizing($W)}
+ continue
+ }
+
+ #get the class name from widget name
+ set cls [string range $W 0 [expr [string last "." $W] - 1]]
+
+ if {[$W yview] == "0 1"} {
+ set bef $W
+ pack forget $f.y
+ } else {
+ set bef $f.y
+ pack $f.y \
+ -padx 0 \
+ -pady 0 \
+ -ipadx 0 \
+ -ipady 0 \
+ -side right \
+ -fill y -before $W
+ }
+
+ if {[$W xview] == "0 1"} {
+ pack forget $f.x
+ } else {
+ pack $f.x \
+ -padx 0 \
+ -pady 0 \
+ -ipadx 0 \
+ -ipady 0 \
+ -side bottom \
+ -fill x -before $bef
+ }
+
+ set tabs [$W cget -tabs]
+ if {$tabs != ""} {
+ catch {$cls resize 0 [lindex $tabs 0] 0}
+ }
+ }
+ after idle {Tree :: rebind_config}
+ }
+ proc resize_widget {W} {
+ if {![info exists resizing] || ![info exists resizing($W)] || !$resizing($W)} {
+ after idle "update idletasks; catch {Tree :: exec_resize}"
+ ::bind $W <Configure> { }
+ set resizing($W) 1
+ }
+ }
+
+ method toggle_bestfit {} {
+ if {$bestfit} {
+ set bestfit 0
+ } else {
+ set bestfit 1
+ }
+ if {[winfo exists $tree]} {
+ $tree config -bestfit $bestfit
+
+ if {$bestfit} {
+ Tree :: resize_widget $tree
+ }
+ }
+ }
+ method toggle_truncate {} {
+ if {$truncate} {
+ set truncate 0
+ } else {
+ set truncate 1
+ }
+ if {[winfo exists $tree]} {
+ $tree config -truncate $truncate
+ }
+ }
+
+ method Truncating_Methode {methode} {
+ set truncatemethode $methode
+ $tree config -truncatemethode $truncatemethode
+ }
+
+ #called to post the right-mose-option menu.
+ #it's realy intelegent!!
+ method tree_post_menu {m} {
+ upvar #0 $tree-bestfit bf
+ upvar #0 $tree-truncate tr
+ upvar #0 $tree-splitlines sp
+
+ set bf $bestfit
+ set tr $truncate
+ set sp $splitlines
+
+ if {$when_post_menu != ""} {
+ eval $when_post_menu $m
+ }
+
+ #menu delete all column filters
+ $m add command \
+ -label [get_indep String DeleteColumnFilters] \
+ -command "$this delete_column_filters"
+
+ #if tabulators are enabled, view those as menu buttons
+ #to sort on them or to view/hide them.
+ if {$tabsize >= 0} {
+ global $thisTail-sort
+
+ $m add separator
+
+ #Add sort submenu to sort the contents on the
+ #availiable columns
+ set mk $m.sort
+ $m add cascade -label [get_indep String Sort]\
+ -underline [get_indep Pos Sort]\
+ -menu $mk
+ menu $mk -tearoff 0
+ for {set i 0} {$i <= $tabsize} {incr i} {
+ $mk add radiobutton \
+ -label [lindex $labels $i] \
+ -variable $thisTail-sort \
+ -value $i \
+ -command "$this resort $i"
+ }
+ set mk $m.hide
+ $m add cascade -label [get_indep String Toggle]\
+ -underline [get_indep Pos Toggle]\
+ -menu $mk
+
+ #Add the submenu to view/hide the availiable columns
+ set mk $m.hide
+ menu $mk -tearoff 0
+ for {set i 0} {$i <= $tabsize} {incr i} {
+ upvar #0 $thisTail-hide-$i x
+ if {![info exists column_toggled($i)] || $column_toggled($i)} {
+ set x 1
+ } else {
+ set x 0
+ }
+ $mk add checkbutton \
+ -label [lindex $labels $i] \
+ -variable $thisTail-hide-$i \
+ -onvalue 1 -offvalue 0 \
+ -command "$this toggle_column $i $thisTail-hide-$i"
+ }
+
+ #Add the sub menu to specify the alignments (left/right)
+ #for the columns
+ #Only if there is more than two columns
+ if {$tabsize >= 2} {
+ set state normal
+ } else {
+ set state disabled
+ }
+ set mk $m.align
+ $m add cascade -label [get_indep String Justify]\
+ -underline [get_indep Pos Justify] \
+ -menu $mk \
+ -state $state
+ menu $mk -tearoff 0
+ set aligns [$tree cget -justify]
+ for {set i 0} {$i <= $tabsize} {incr i} {
+ upvar #0 $thisTail-align-$i x
+ set right [lindex $aligns $i]
+ if {$right != "" && $right == 1} {
+ set x 1
+ } else {
+ set x 0
+ }
+
+ #don't justify the first and the last column !!
+ if {$i == 0 || $i == $tabsize} {
+ set state disabled
+ } else {
+ set state normal
+ }
+ $mk add checkbutton \
+ -label [lindex $labels $i] \
+ -variable $thisTail-align-$i \
+ -onvalue 1 -offvalue 0 \
+ -command "$this justify_column $i $thisTail-align-$i" \
+ -state $state
+ }
+
+ #sub menu to choose the truncating methode (auto, prefix, suffix)
+ if {$enable_truncating_methode_submenu} {
+ if {$tr} {
+ set state normal
+ } else {
+ set state disabled
+ }
+ set mk $m.tm
+ $m add cascade \
+ -label [get_indep String TruncatingMethode]\
+ -underline [get_indep Pos TruncatingMethode] \
+ -menu $mk \
+ -state $state
+ menu $mk -tearoff 0
+
+ $mk add radiobutton \
+ -label "Auto" \
+ -variable $thisTail-truncating_methode \
+ -value "auto" \
+ -command "$this Truncating_Methode auto"
+ $mk add radiobutton \
+ -label "Prefix" \
+ -variable $thisTail-truncating_methode \
+ -value "path" \
+ -command "$this Truncating_Methode path"
+ $mk add radiobutton \
+ -label "Suffix" \
+ -variable $thisTail-truncating_methode \
+ -value "normal" \
+ -command "$this Truncating_Methode normal"
+ }
+ }
+
+ $m add separator
+
+ #best fit
+ $m add checkbutton \
+ -label [get_indep String TreeBestFit] \
+ -variable $tree-bestfit \
+ -onvalue 1 -offvalue 0 \
+ -command "$this toggle_bestfit"
+ #truncate
+ $m add checkbutton \
+ -label [get_indep String TreeTruncate] \
+ -variable $tree-truncate \
+ -onvalue 1 -offvalue 0 \
+ -command "$this toggle_truncate"
+ #split lines
+ $m add checkbutton \
+ -label [get_indep String TreeViewSplitLines] \
+ -variable $tree-splitlines \
+ -onvalue 1 -offvalue 0 \
+ -command "$this toggle_splitlines"
+
+ $m add separator
+
+ #view size and selected items at the top of the popup menu
+ set sel_size [llength [$tree curselection]]
+ $m add command \
+ -label [format [get_indep String ListSize]\
+ [$tree size] $sel_size]
+ }
+ method post_commands {x y} {
+ set m .sn_pop_menu_tree
+ # It has to be destroyed because we might have problems with "tk_popup"!
+ catch {::destroy $m}
+
+ menu $m -tearoff 0\
+ -postcommand "$this tree_post_menu $m"
+ wm overrideredirect $m 1
+
+ tk_popup $m $x $y
+ }
+
+ proc font_avg_width {w} {
+ set fnt [$w cget -font]
+ set text_avg_width [font measure $fnt "M"]
+
+ return $text_avg_width
+ }
+
+ method replace_buttons {} {
+ resize 0 [lindex [$tree cget -tabs] 0] 0
+ }
+
+ method start_motion {num x} {
+ set x [expr {$x - [winfo rootx $lframe.size]}]
+ if {$mframe == ""} {
+ set mframe $lframe.motion
+ }
+ set theight [expr {[winfo height $tree] + [winfo height $lframe.size]}]
+ frame $mframe -relief raised \
+ -bd 0 \
+ -width 1 \
+ -bg black \
+ -height $theight \
+ -cursor sb_h_double_arrow
+ place $mframe -x $x -y 0
+ }
+ method motion {num x} {
+ if {$mframe == ""} {
+ start_motion $num $x
+ }
+ set x [expr {$x - [winfo rootx $lframe.size]}]
+ place $lframe.motion -x $x -y 0
+ }
+ method end_motion {} {
+ if {$mframe != ""} {
+ catch {destroy $mframe}
+ set mframe ""
+ }
+ }
+
+ #do resizing the column width even when motion arround
+ #the line, this happens when the pointer moves over
+ #the near button where the resize-hit-button area is
+ #set to be 12 or dependent on the current column size.
+ method button_motion {btn num x} {
+ set ww [winfo width $btn]
+ set range 12
+ if {$range > [expr {$ww / 3}]} {
+ set range [expr {$ww / 3}]
+ }
+ if {$num > 0 && $x <= $range} {
+ $btn config -cursor sb_h_double_arrow
+ return -1
+ } elseif {$num < $tabsize && [expr {$ww - $x}] < $range} {
+ $btn config -cursor sb_h_double_arrow
+ return 0
+ } else {
+ $btn config -cursor {}
+ return 1
+ }
+ }
+
+ method put_in_cutbuffer {} {
+ set sel [$tree curselection]
+ foreach l $sel {
+ lappend res [$tree get $l]
+ }
+ if {![info exists res]} {
+ bell
+ return
+ }
+ #clipboard clear -displayof $tree
+ #clipboard append -displayof $tree -- $res
+ clipboard clear
+ clipboard append [join $res \n]
+ }
+
+ method print_dialog_box {{sub_tit ""}} {
+ global sn_options
+ global tcl_platform
+
+ if {[winfo exists $print_dialog]} {
+ $print_dialog raise
+ return
+ }
+ set toplw [winfo toplevel $thisTail]
+
+ set print_dialog [TopLevel $toplw.prtdlg]
+
+ $print_dialog transient $toplw
+
+ sn_motif_buttons $print_dialog bottom 0 [get_indep String ok]\
+ [get_indep String cancel]
+ $print_dialog.button_0 config -command "$this print_it"
+ $print_dialog.button_1 config -command "$print_dialog delete"
+
+ global $print_dialog-ptarget $print_dialog-cmd
+ ::set $print_dialog-ptarget "all"
+
+ set tit [wm title $toplw]
+ if {$sub_tit != ""} {
+ append tit " " $sub_tit
+ }
+ ::set $print_dialog-cmd [format $sn_options(def,ascii-print-command) $tit]
+ $print_dialog title [list [get_indep String Print] $tit]
+
+ frame $print_dialog.txt
+ frame $print_dialog.txt.lbls
+ frame $print_dialog.txt.entries
+
+ if {$tcl_platform(platform) != "windows"} {
+ label $print_dialog.txt.lbls.prompt\
+ -text [get_indep String SQLPprintercmd]
+
+ entry $print_dialog.txt.entries.cmd -width 70\
+ -textvariable $print_dialog-cmd
+
+ ::focus $print_dialog.txt.entries.cmd
+ ::bind $print_dialog.txt.entries.cmd <Any-Return> \
+ "$print_dialog.button_0 invoke"
+ }
+ label $print_dialog.txt.lbls.label \
+ -text [get_indep String Indent]
+ entry $print_dialog.txt.entries.entry -width 5\
+ -textvariable $print_dialog-indent
+ $print_dialog.txt.entries.entry insert 0 "2"
+
+ if {$tcl_platform(platform) != "windows"} {
+ pack $print_dialog.txt.lbls.prompt -side top -anchor e
+ pack $print_dialog.txt.entries.cmd -side top -padx 10 -fill x -expand y
+ }
+ pack $print_dialog.txt.lbls.label -side top -anchor e
+ pack $print_dialog.txt.entries.entry -side top -padx 10 -anchor w
+ pack $print_dialog.txt -side top -anchor w
+
+ pack $print_dialog.txt.lbls -side left -expand y
+ pack $print_dialog.txt.entries -side right -fill x -expand y
+ pack $print_dialog.txt -side top -expand y
+
+ radiobutton $print_dialog.marked -text [get_indep String Marked]\
+ -variable $print_dialog-ptarget -value marked
+
+ radiobutton $print_dialog.all -text [get_indep String All]\
+ -variable $print_dialog-ptarget -value all
+
+ pack $print_dialog.all -anchor w -padx 60 -side top
+ pack $print_dialog.marked -anchor w -padx 60 -side top
+
+ $print_dialog move_to_mouse
+ catch {$print_dialog resizable no no}
+
+ $print_dialog take_focus
+ }
+
+ method print_it {} {
+ upvar #0 $print_dialog-ptarget target
+ upvar #0 $print_dialog-cmd cmd
+ upvar #0 $print_dialog-indent indent
+ global sn_options
+
+ if {[catch {set indent [expr $indent + 0]}]} {
+ set indent 2
+ }
+
+ set spaces " "
+
+ switch -- $target {
+ "all" {
+ set i 0
+ for {set size [$tree size]} {$i < $size} {incr i} {
+ set lvl [expr [$tree levels $i] * $indent]
+ set spaces ""
+ for {set j 0} {$j <= $lvl} {incr j} {
+ set spaces " $spaces"
+ }
+ lappend lst "[string range $spaces 0 [expr $lvl - 1]][$tree get $i]"
+ }
+ }
+ "marked" -
+ default {
+ set sel [$lframe.tree curselection]
+ if {$sel != ""} {
+ foreach i $sel {
+ lappend lst "[string range $spaces 0 [expr [$tree levels $i] * $indent - 1]][$tree get $i]"
+ }
+ }
+ }
+ }
+
+ if {![info exists lst]} {
+ set lst ""
+ }
+ set lst [join $lst \n]
+
+ $print_dialog delete
+
+ set tmpf [sn_tmpFileName]
+ set fd [open $tmpf "w+"]
+ ::fconfigure $fd -encoding $sn_options(def,system-encoding)
+ puts $fd $lst
+ close $fd
+
+ sn_print_file $cmd $tmpf
+
+ file delete -- $tmpf
+
+ set print_dialog ""
+
+ catch {unset target}
+ catch {unset cmd}
+ }
+
+ ##
+ ##List_Box compatiblility
+ ##
+ # It is a 'proc' because the performance is better.
+ method see {args} {
+ return [eval $tree see $args]
+ }
+ method delete_tk {args} {
+ if {$bind_config} {
+ resize_widget $tree
+ }
+
+ return [eval $tree delete $args]
+ }
+
+ method treebind {args} {
+ return [eval ::bind $tree $args]
+ }
+
+ method bind {args} {
+ return [eval ::bind $tree $args]
+ }
+
+ method header {args} {
+ if {[winfo exists $header]} {
+ return [eval $header $args]
+ }
+ }
+ method index {args} {
+ return [eval $tree index $args]
+ }
+ method activate {args} {
+ return [eval $tree activate $args]
+ }
+
+ method nearest {args} {
+ return [eval $tree nearest $args]
+ }
+
+ proc exchange {w y} {
+ set sel [$w curselection]
+ if {$sel == "" || [string compare $exchange ""] == 0} {
+ return
+ }
+
+ set y [::$w nearest $y]
+
+ set len [expr [llength $sel] -1]
+ set first [lindex $sel 0]
+ set last [lindex $sel $len]
+
+ if {$y >= $first && $y <= $last} {
+ return
+ }
+
+ if {$first <= $y} {
+ set y [expr $y - $len]
+ }
+ if {$y < 0} {
+ return
+ }
+ ::$w delete $first $last
+ eval ::$w insert $y $exchange
+ ::$w selection clear 0 end
+ ::$w selection set $y [expr $y + $len]
+ }
+ proc exchange_mark {w} {
+ set sel [$w curselection]
+
+ set exchange ""
+ foreach s [$w curselection] {
+ lappend exchange [$w get $s]
+ }
+ }
+
+ protected thisTail ""
+ protected lframe ""
+ protected tree ""
+ protected oldnum -1
+ protected oldfont ""
+ protected actual_sortcolumn -1
+ #an array of the items
+ protected column_toggled
+ protected entry ""
+ protected widget {}
+ protected frame_height 0
+ protected col_height 0
+ protected mframe ""
+ protected print_dialog {}
+
+ common resizing
+ common exchange {}
+
+ public withframe no
+
+ public state {disabled} {
+ #$tree config -state $state
+ }
+ public tabsize -1
+ public tabs {} {
+ if {[winfo exists $tree] && $tabsize != -1} {
+ $tree config -tabs $tabs
+ }
+ }
+ public labels {""} {
+ if {[winfo exists $lframe.size] && $tabsize != -1} {
+ for {set i 0} {$i <= $tabsize} {incr i} {
+ $lframe.size.btn$i configure -text [lindex $labels $i]
+ }
+ resize 0 [lindex [$tree cget -tabs] 0] 0
+ view_tabs
+ if {[winfo ismapped $tree]} {
+ Tree :: resize_widget $tree
+ }
+ }
+ }
+ public justify {} {
+ if {[winfo exists $lframe.btn0] && $tabsize != -1} {
+ resize 0 [lindex [$tree cget -tabs] 0] 0
+ }
+ }
+ public selectmode "browse" {
+ if {[winfo exists $tree]} {
+ $tree config -selectmode $selectmode
+ }
+ }
+ public exportselection {0} {
+ if {[winfo exists $tree]} {
+ $tree config -exportselection $exportselection
+ }
+ }
+ public selectforeground "" {
+ if {$selectforeground != "" && [winfo exists $tree]} {
+ $tree config -selectforeground $selectforeground
+ }
+ }
+ public selectbackground "" {
+ if {$selectbackground != "" && [winfo exists $tree]} {
+ $tree config -selectbackground $selectbackground
+ }
+ }
+ public fillselection {1} {
+ if {[winfo exists $tree]} {
+ $tree config -fillselection $fillselection
+ }
+ }
+ public sortedinsertion {0} {
+ if {[winfo exists $tree]} {
+ $tree config -sortedinsertion $sortedinsertion
+ }
+ }
+ public nocase 1 {
+ if {[winfo exists $tree]} {
+ $tree config -sortnocase $sortnocase
+ }
+ }
+ public sortnocase {0} {
+ if {[winfo exists $tree]} {
+ $tree config -sortnocase $sortnocase
+ }
+ }
+ public sortcolumn {0} {
+ if {[winfo exists $tree]} {
+ $tree config -sortcolumn $sortcolumn
+ }
+ }
+ public info_label {""} {
+ }
+
+ public truncate 1 {
+ if {[winfo exists $tree]} {
+ eval $tree config -truncate $truncate
+ }
+ }
+
+ public splitlines 1 {
+ if {[winfo exists $tree]} {
+ eval $tree config -splitlines $splitlines
+ }
+ }
+ public tabfreespace 8 {
+ if {[winfo exists $tree]} {
+ eval $tree config -tabfreespace $tabfreespace
+ }
+ }
+
+ public hiddencolumns "" {
+ }
+
+ #darkgray = "#aaaaaa"
+ public lineforeground "#aaaaaa" {
+ if {$lineforeground != "" && [winfo exists $tree]} {
+ $tree config -lineforeground $lineforeground
+ }
+ }
+
+ public splitlineforeground gray {
+ if {[winfo exists $tree]} {
+ $tree config -splitlineforeground $splitlineforeground
+ }
+ }
+
+ public autofit 0 {
+ if {[winfo exists $tree]} {
+ $tree config -autofit $autofit
+ }
+ }
+
+ public bestfit 0 {
+ if {[winfo exists $tree]} {
+ $tree config -bestfit $bestfit
+ }
+ }
+
+ public indentwidth 15 {
+ if {$indentwidth != -1 && [winfo exists $tree]} {
+ $tree config -indentwidth $indentwidth
+ }
+ }
+ public borderwidth 1 {
+ if {$borderwidth != -1 && [winfo exists $tree]} {
+ $tree config -borderwidth $borderwidth
+ }
+ }
+ public highlightwidth 0 {
+ if {$highlightwidth > -1 && [winfo exists $tree]} {
+ $tree config -highlightthickness $highlightwidth
+ }
+ }
+ public highlightthickness 1 {
+ if {$highlightthickness > -1 && [winfo exists $tree]} {
+ $tree config -highlightthickness $highlightthickness
+ }
+ }
+ public relief "" {
+ if {$relief != "" && [winfo exists $tree]} {
+ $tree config -relief $relief
+ }
+ }
+ public takefocus "" {
+ if {$takefocus != "" && [winfo exists $tree]} {
+ $tree config -takefocus $takefocus
+ }
+ }
+ public bitmapspace 7 {
+ if {$bitmapspace != -1 && [winfo exists $tree]} {
+ $tree config -bitmapspace $bitmapspace
+ }
+ }
+
+ public bitmap "" {
+ if {$bitmap != "" && [winfo exists $tree]} {
+ set size [$tree size]
+ for {set i 0} {$i < $size} {incr i} {
+ $tree itemconfig $i -bitmap $bitmap
+ }
+ }
+ }
+
+ public selectborderwidth 1 {
+ if {$selectborderwidth != "" && [winfo exists $tree]} {
+ $tree config -selectborderwidth $selectborderwidth
+ }
+ }
+
+ public hiddenbitmap "" {
+ if {$hiddenbitmap != "" && [winfo exists $tree]} {
+ $tree config -hiddenbitmap $hiddenbitmap
+ }
+ }
+
+ public hiddenimage "" {
+ if {$hiddenimage != "" && [winfo exists $tree]} {
+ $tree config -hiddenimage $hiddenimage
+ }
+ }
+
+ public plusimage "" {
+ if {$plusimage != "" && [winfo exists $tree]} {
+ $tree config -plusimage $plusimage
+ }
+ }
+
+ public minusimage "" {
+ if {$minusimage != "" && [winfo exists $tree]} {
+ $tree config -minusimage $minusimage
+ }
+ }
+
+ public unknownimage "" {
+ if {$unknownimage != "" && [winfo exists $tree]} {
+ $tree config -unknownimage $unknownimage
+ }
+ }
+
+ public width 45 {
+ if {$width == ""} {
+ set width 45
+ }
+ if {[winfo exists $tree]} {
+ $tree config -width $width
+ }
+ }
+
+ public height 12 {
+ if {$height == ""} {
+ set height 12
+ }
+ if {[winfo exists $tree]} {
+ $tree config -height $height
+ }
+ }
+
+ public font "" {
+ if {$font != "" && [winfo exists $tree]} {
+ $tree config -font $font
+ }
+ }
+
+ public propagate 0 {
+ if {[winfo exists $tree]} {
+ pack propagate $tree $propagate
+ }
+ }
+ public accelerator 0 {
+ if {[winfo exists $tree]} {
+ $tree config -accelerator $accelerator
+ }
+ }
+
+ #it's not very important to enable choosing how to truncate
+ #columns (auto, prefix, suffix). "auto" seems to do the job
+ public enable_truncating_methode_submenu 0
+ public truncatemethode auto {
+ if {[winfo exists $tree]} {
+ $tree config -truncatemethode $truncatemethode
+ }
+ }
+ public contents {} {
+ contents
+ }
+
+ public fillcommand "" {
+ }
+
+ public sort "-increasing"
+ public advised {}
+ public filter_window 1
+
+ public uniq {0} {
+ }
+
+ public filter {*} {
+ if {[winfo exists $entry]} {
+ global $thisTail-filter
+ ::set $thisTail-filter $filter
+ $entry icursor 0
+ if {$contents != ""} {
+ $this fill
+ }
+ }
+ }
+
+ public have_filter 1 {
+ if {!$have_filter} {
+ set filter ""
+ }
+ }
+
+ public bind_config 1
+ public editable 0
+ public header {}
+
+ #can be set external to be executed when option menu
+ #is launched.
+ public when_post_menu
+}
+#############################################################################
+## END CLASS for TreeWidget with tab stop support ##
+#############################################################################
+
+##########################################################################
+## bindings for the treetable widget ##
+##########################################################################
+
+#default key bindings
+proc treetable_bindings {t} {
+ #the keybindings to the treetable are compatible to
+ #those of listbox.
+ bind $t <1> {
+ if [winfo exists %W] {
+ focus %W
+ tkListboxBeginSelect %W [%W index @%x,%y]
+ }
+ }
+
+ bind TreeTable <Double-1> {
+ }
+
+ bind $t <B1-Motion> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ catch {tkListboxMotion %W [%W index @%x,%y]}
+ }
+ bind $t <ButtonRelease-1> {
+ tkCancelRepeat
+ %W activate @%x,%y
+ }
+ bind $t <Shift-1> {
+ tkListboxBeginExtend %W [%W index @%x,%y]
+ }
+ bind $t <Control-1> {
+ tkListboxBeginToggle %W [%W index @%x,%y]
+ }
+ bind $t <B1-Leave> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ tkListboxAutoScan %W
+ }
+ bind $t <B1-Enter> {
+ tkCancelRepeat
+ }
+
+ bind $t <Up> {
+ tkTreeTableUpDown %W -1
+ }
+ bind $t <Shift-Up> {
+ tkListboxExtendUpDown %W -1
+ }
+ bind $t <Down> {
+ tkTreeTableUpDown %W 1
+ }
+ bind $t <Shift-Down> {
+ tkListboxExtendUpDown %W 1
+ }
+ bind $t <Left> {
+ %W xview scroll -1 units
+ }
+ bind $t <Control-Left> {
+ %W xview scroll -1 pages
+ }
+ bind $t <Right> {
+ %W xview scroll 1 units
+ }
+ bind $t <Control-Right> {
+ %W xview scroll 1 pages
+ }
+ bind $t <Prior> {
+ %W yview scroll -1 pages
+ %W activate @0,0
+ }
+ bind $t <Next> {
+ %W yview scroll 1 pages
+ %W activate @0,0
+ }
+ bind $t <Control-Prior> {
+ %W xview scroll -1 pages
+ }
+ bind $t <Control-Next> {
+ %W xview scroll 1 pages
+ }
+ bind $t <Home> {
+ %W xview moveto 0
+ }
+ bind $t <End> {
+ %W xview moveto 1
+ }
+ bind $t <Control-Home> {
+ %W activate 0
+ %W see 0
+ %W selection clear 0 end
+ %W selection set 0
+ }
+ bind $t <Shift-Control-Home> {
+ tkListboxDataExtend %W 0
+ }
+ bind $t <Control-End> {
+ %W activate end
+ %W see end
+ %W selection clear 0 end
+ %W selection set end
+ }
+ bind $t <Shift-Control-End> {
+ tkListboxDataExtend %W end
+ }
+ bind $t <F16> {
+ if {[selection own -displayof %W] == "%W"} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W [selection get -displayof %W]
+ }
+ }
+ bind $t <space> {
+ tkListboxBeginSelect %W [%W index active]
+ }
+ bind $t <Select> {
+ tkListboxBeginSelect %W [%W index active]
+ }
+ bind $t <Control-Shift-space> {
+ tkListboxBeginExtend %W [%W index active]
+ }
+ bind $t <Shift-Select> {
+ tkListboxBeginExtend %W [%W index active]
+ }
+ bind $t <Escape> {
+ tkListboxCancel %W
+ }
+ bind $t <Control-slash> {
+ tkListboxSelectAll %W
+ }
+ bind $t <Control-backslash> {
+ if {[%W cget -selectmode] != "browse"} {
+ %W selection clear 0 end
+ }
+ }
+
+ bind $t <2> {
+ %W scan mark %x %y
+ }
+ bind $t <B2-Motion> {
+ %W scan dragto %x %y
+ }
+
+ #other bindings added to default listbox bindings
+ bind $t <Key> {treetable_search_region %W %A %s}
+ bind $t <3> {sn_listbox_post_menu %W %X %Y}
+ bind $t <Control-3> {sn_listbox_post_menu %W %X %Y}
+ # Sun Home
+ bind $t <Any-F27> [bind $t <Home>]
+ # Sun End
+ bind $t <Any-R13> [bind $t <End>]
+ # Sun Next
+ bind $t <Any-R15> [bind $t <Next>]
+ # Sun Prior
+ bind $t <Any-R9> [bind $t <Prior>]
+
+ bind $t <Tab> {focus [tk_focusNext %W]}
+ bind $t <Shift-Tab> {focus [tk_focusPrev %W]}
+}
+
+proc tkTreeTableUpDown {w amount} {
+ global tkPriv
+ $w activate [expr [$w index active] + $amount] $amount
+ $w see active
+ switch [$w cget -selectmode] {
+ browse {
+ $w selection clear 0 end
+ }
+ extended {
+ $w selection clear 0 end
+ if {[string compare [$w index active] ""] != 0} {
+ $w selection anchor active
+ set tkPriv(listboxPrev) [$w index active]
+ }
+ set tkPriv(listboxSelection) {}
+ }
+ }
+}
+
+proc treetable_search_in_widget {w a beg {end end}} {
+ if {[$w size] > 20000} {
+ $w config -cursor watch
+ update idletasks
+ }
+ set res [$w search -nocase -begins -- $a $beg $end]
+ $w config -cursor {}
+ if {$res == ""} {
+ return -1
+ }
+ $w activate $res
+ return $res
+}
+
+proc treetable_search_region {w a state} {
+
+ #accept only ascii-characters
+ if {[string compare $a ""] == 0 || [string length $a] > 1} {
+ return -1
+ }
+ #returns if alt-key is pressed (reserved for menu)
+ if {[expr {$state & 8}] == 8} {
+ return -1
+ }
+
+ upvar #0 $w-pat pat
+
+ append pat $a
+ set srch $pat
+ set off [$w index active]
+ if {[string compare $off ""] == 0} {
+ set sel 0
+ } else {
+ set sel [expr $off + 1]
+ }
+ # Search from the selection!
+ set off [treetable_search_in_widget $w $srch $sel]
+
+ if {$off == -1 && $sel != 0} {
+ # Search until the selection!
+ set off [treetable_search_in_widget $w $srch 0 $sel]
+ }
+ if {$off == -1} {
+ if {[string length $pat] > 1} {
+ set pat $a
+ set srch $pat
+
+ # Search from the selection!
+ set off [treetable_search_in_widget $w $srch $sel]
+ if {$off == -1} {
+ # Search until the selection!
+ set off [treetable_search_in_widget $w $srch 0 $sel]
+ }
+ }
+ if {$off == -1} {
+ set pat ""
+ bell -displayof $w
+ $w selection clear 0 end
+ return 1
+ }
+ }
+ $w activate $off
+ $w activate $off
+ $w yview see $off
+
+ return 0
+}
+
+
+##############################################################
+# this procedure can be used to create a tree table.
+# Additional to the tree widget it creates scrollbars for the
+# widget. This scrollbars should be shown/hidden in relation
+# to the scrolling possibility.
+##############################################################
+proc ide_treetable args {
+ set frame [lindex $args 0]
+
+ set tree $frame.tree
+
+ scrollbar $frame.x \
+ -orient horiz \
+ -command "$tree xview"
+ scrollbar $frame.y \
+ -command "$tree yview"
+
+ set args [lreplace $args 0 0 \
+ -yscrollcommand "$frame.y set" \
+ -xscrollcommand "$frame.x set"]
+
+ eval treetable $tree $args
+
+ bind $tree <Configure> {
+ puts stdout "resize %W"
+ Tree :: resize_widget %W
+ }
+
+ return $tree
+}
+
+#immediatly define the treetabe default bindings
+treetable_bindings TreeTable
+
diff --git a/libgui/library/treetable.tcl b/libgui/library/treetable.tcl
new file mode 100644
index 00000000000..8ba9807b8a0
--- /dev/null
+++ b/libgui/library/treetable.tcl
@@ -0,0 +1,206 @@
+# treetable.tcl - some treetable bindings; from S-N.
+# Copyright (C) 1997 Cygnus Solutions.
+
+proc multix_treetable_bindings {t} {
+ # The keybindings to the treetable are compatible with those of
+ # listbox.
+ bind $t <1> {
+ if [winfo exists %W] {
+ tkListboxBeginSelect %W [%W index @%x,%y]
+ }
+ }
+
+ bind $t <B1-Motion> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ tkListboxMotion %W [%W index @%x,%y]
+ }
+ bind $t <ButtonRelease-1> {
+ tkCancelRepeat
+ %W activate @%x,%y
+ }
+ bind $t <Shift-1> {
+ tkListboxBeginExtend %W [%W index @%x,%y]
+ }
+ bind $t <Control-1> {
+ tkListboxBeginToggle %W [%W index @%x,%y]
+ }
+ bind $t <B1-Leave> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ tkListboxAutoScan %W
+ }
+ bind $t <B1-Enter> {
+ tkCancelRepeat
+ }
+
+ bind $t <Up> {
+ tkListboxUpDown %W -1
+ }
+ bind $t <Shift-Up> {
+ tkListboxExtendUpDown %W -1
+ }
+ bind $t <Down> {
+ tkListboxUpDown %W 1
+ }
+ bind $t <Shift-Down> {
+ tkListboxExtendUpDown %W 1
+ }
+ bind $t <Left> {
+ %W xview scroll -1 units
+ }
+ bind $t <Control-Left> {
+ %W xview scroll -1 pages
+ }
+ bind $t <Right> {
+ %W xview scroll 1 units
+ }
+ bind $t <Control-Right> {
+ %W xview scroll 1 pages
+ }
+ bind $t <Prior> {
+ %W yview scroll -1 pages
+ %W activate @0,0
+ }
+ bind $t <Next> {
+ %W yview scroll 1 pages
+ %W activate @0,0
+ }
+ bind $t <Control-Prior> {
+ %W xview scroll -1 pages
+ }
+ bind $t <Control-Next> {
+ %W xview scroll 1 pages
+ }
+ bind $t <Home> {
+ %W xview moveto 0
+ }
+ bind $t <End> {
+ %W xview moveto 1
+ }
+ bind $t <Control-Home> {
+ %W activate 0
+ %W see 0
+ %W selection clear 0 end
+ %W selection set 0
+ }
+ bind $t <Shift-Control-Home> {
+ tkListboxDataExtend %W 0
+ }
+ bind $t <Control-End> {
+ %W activate end
+ %W see end
+ %W selection clear 0 end
+ %W selection set end
+ }
+ bind $t <Shift-Control-End> {
+ tkListboxDataExtend %W end
+ }
+ bind $t <F16> {
+ if {[selection own -displayof %W] == "%W"} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W [selection get -displayof %W]
+ }
+ }
+ bind $t <space> {
+ tkListboxBeginSelect %W [%W index active]
+ }
+ bind $t <Select> {
+ tkListboxBeginSelect %W [%W index active]
+ }
+ bind $t <Control-Shift-space> {
+ tkListboxBeginExtend %W [%W index active]
+ }
+ bind $t <Shift-Select> {
+ tkListboxBeginExtend %W [%W index active]
+ }
+ bind $t <Escape> {
+ tkListboxCancel %W
+ }
+ bind $t <Control-slash> {
+ tkListboxSelectAll %W
+ }
+ bind $t <Control-backslash> {
+ if {[%W cget -selectmode] != "browse"} {
+ %W selection clear 0 end
+ }
+ }
+
+ bind $t <3> {
+ %W scan mark %x %y
+ }
+ bind $t <B3-Motion> {
+ %W scan dragto %x %y
+ }
+
+ # Explicitly exclude traversal keys.
+ bind $t <Tab> {;}
+ bind $t <Shift-Tab> {;}
+
+ # Other bindings added to default listbox bindings.
+ bind $t <KeyPress> {multix_tree_table_search_region %W %A}
+ bind $t <Any-F27> [bind $t <Home>]; # Sun Home
+ bind $t <Any-R13> [bind $t <End>]; # Sun End
+ bind $t <Any-R15> [bind $t <Next>]; # Sun Next
+ bind $t <Any-R9> [bind $t <Prior>]; # Sun Prior
+}
+
+proc multix_tree_table_search_in_widget {w a beg {end end}} {
+ if {[$w size] > 20000} {
+ $w config -cursor watch
+ update idletasks
+ }
+ set res [$w search -nocase -begins $a $beg $end]
+ $w config -cursor {}
+ if {$res == ""} {
+ return -1
+ }
+ $w activate $res
+ return $res
+}
+
+proc multix_tree_table_search_region {w a} {
+ if {[string compare $a ""] == 0} {
+ return
+ }
+
+ upvar #0 $w-pat pat
+
+ append pat $a
+ set srch $pat
+ set off [$w index active]
+ if {[string compare $off ""] == 0} {
+ set sel 0
+ } else {
+ set sel [expr $off + 1]
+ }
+ # Search from the selection!
+ set off [multix_tree_table_search_in_widget $w $srch $sel]
+
+ if {$off == -1 && $sel != 0} {
+ # Search until the selection!
+ set off [multix_tree_table_search_in_widget $w $srch 0 $sel]
+ }
+ if {$off == -1} {
+ if {[string length $pat] > 1} {
+ set pat $a
+ set srch $pat
+
+ # Search from the selection!
+ set off [multix_tree_table_search_in_widget $w $srch $sel]
+ if {$off == -1} {
+ # Search until the selection!
+ set off [multix_tree_table_search_in_widget $w $srch 0 $sel]
+ }
+ }
+ if {$off == -1} {
+ set pat ""
+ bell -displayof $w
+ $w selection clear 0 end
+ return
+ }
+ }
+ $w activate $off
+ $w activate $off
+ $w yview see $off
+}
diff --git a/libgui/library/ulset.tcl b/libgui/library/ulset.tcl
new file mode 100644
index 00000000000..11827c9c3fb
--- /dev/null
+++ b/libgui/library/ulset.tcl
@@ -0,0 +1,22 @@
+# ulset.tcl - Set labels based on info from gettext.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+# Extract underline and label info from a descriptor string. Any
+# underline in the descriptor is extracted, and the next character's
+# index is used as the -underline value. There can only be one _ in
+# the label.
+proc extract_label_info {option label} {
+ set uList [split $label _]
+ if {[llength $uList] > 2} then {
+ error "too many underscores in label \"$label\""
+ }
+
+ if {[llength $uList] == 1} then {
+ set ul -1
+ } else {
+ set ul [string length [lindex $uList 0]]
+ }
+
+ return [list $option [join $uList {}] -underline $ul]
+}
diff --git a/libgui/library/ventry.tcl b/libgui/library/ventry.tcl
new file mode 100644
index 00000000000..c938bd99abb
--- /dev/null
+++ b/libgui/library/ventry.tcl
@@ -0,0 +1,137 @@
+# ventry.tcl - Entry with validation
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+itcl_class Validated_entry {
+ # The validation command. It is passed the contents of the entry.
+ # It should throw an error if there is a problem; the error text
+ # will be displayed to the user.
+ public command {}
+
+ constructor {config} {
+ upvar \#0 $this state
+
+ # The standard widget-making trick.
+ set class [$this info class]
+ set hull [namespace tail $this]
+ set old_name $this
+ ::rename $this $this-tmp-
+ ::frame $hull -class $class -borderwidth 0
+ ::rename $hull $old_name-win-
+ ::rename $this $old_name
+
+ ::set ${this}(value) ""
+ ::entry [namespace tail $this].entry -textvariable ${this}(value)
+ pack [namespace tail $this].entry -expand 1 -fill both
+
+ bind [namespace tail $this].entry <Map> [list $this _map]
+ bind [namespace tail $this].entry <Unmap> [list $this _unmap]
+ bind [namespace tail $this].entry <Destroy> [list $this delete]
+ # We never want the focus on the frame.
+ bind [namespace tail $this] <FocusIn> [list focus [namespace tail $this].entry]
+
+ # This window is used when the user enters a bad name for the new
+ # executable. The color here is "plum3". We use a toplevel here
+ # both to get a nice black border and because a frame would be
+ # clipped by its parents.
+ toplevel [namespace tail $this].badname -borderwidth 1 -background black -relief flat
+ wm withdraw [namespace tail $this].badname
+ wm overrideredirect [namespace tail $this].badname 1
+
+ ::set state(message) ""
+
+ # FIXME: -textvariable didn't work; I suspect itcl.
+ ::label [namespace tail $this].badname.text -anchor w -justify left \
+ -background \#cdd29687cdd2 ;# -textvariable ${this}(message)
+ pack [namespace tail $this].badname.text -expand 1 -fill both
+
+ # Trace the entry contents.
+ uplevel \#0 [list trace variable ${this}(value) w [list $this _trace]]
+ }
+
+ destructor {
+ upvar \#0 $this state
+ catch {destroy $this}
+ uplevel \#0 [list trace vdelete ${this}(value) w [list $this _trace]]
+ unset state
+ }
+
+ method configure {config} {}
+
+ # Return 1 if we're in the error state, 0 otherwise.
+ method is_error {} {
+ upvar \#0 $this state
+ return [expr {$state(message) != ""}]
+ }
+
+ # Return error text.
+ method error_text {} {
+ upvar \#0 $this state
+ return $state(message)
+ }
+
+ # Some methods to forward messages to the entry. Add more as
+ # required.
+
+ # FIXME: itcl 1.5 won't let us have a `delete' method. Sigh.
+ method delete_hack {args} {
+ return [eval [namespace tail $this].entry delete $args]
+ }
+
+ method get {} {
+ return [[namespace tail $this].entry get]
+ }
+
+ method insert {index string} {
+ return [[namespace tail $this].entry insert $index $string]
+ }
+
+
+ # This is run to display the label. Private method.
+ method _display {} {
+ # FIXME: place above if it would go offscreen.
+ set y [expr {[winfo rooty [namespace tail $this].entry] + [winfo height [namespace tail $this].entry] + 1}]
+ set x [expr {round ([winfo rootx [namespace tail $this].entry]
+ + 0.12 * [winfo width [namespace tail $this].entry])}]
+ wm positionfrom [namespace tail $this].badname user
+ wm geometry [namespace tail $this].badname +$x+$y
+ # Workaround for Tk 8.0b2 bug on NT.
+ update
+ wm deiconify [namespace tail $this].badname
+ raise [namespace tail $this].badname
+ }
+
+ # This is run when the entry widget is mapped. If we have an error,
+ # map our error label. Private method.
+ method _map {} {
+ if {[is_error]} then {
+ _display
+ }
+ }
+
+ # This is run when the entry widget is unmapped. Private method.
+ method _unmap {} {
+ wm withdraw [namespace tail $this].badname
+ }
+
+ # This is called when the entry contents change. Private method.
+ method _trace {args} {
+ upvar \#0 $this state
+
+ if {$command != ""} then {
+ set cmd $command
+ lappend cmd $state(value)
+ set cmd [list uplevel \#0 $cmd]
+ }
+ if {[info exists cmd] && [catch $cmd msg]} then {
+ # FIXME: for some reason, the -textvariable on the label doesn't
+ # work. I suspect itcl.
+ set state(message) $msg
+ [namespace tail $this].badname.text configure -text $msg
+ _display
+ } else {
+ set state(message) ""
+ wm withdraw [namespace tail $this].badname
+ }
+ }
+}
diff --git a/libgui/library/wframe.tcl b/libgui/library/wframe.tcl
new file mode 100644
index 00000000000..2e761fb198f
--- /dev/null
+++ b/libgui/library/wframe.tcl
@@ -0,0 +1,87 @@
+# wframe.tcl - Frame with a widget on its border.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Tom Tromey <tromey@cygnus.com>.
+
+itcl_class Widgetframe {
+ # Where to put the widget. For now, we don't support many anchors.
+ # Augment as you like.
+ public anchor nw {
+ if {$anchor != "nw" && $anchor != "n"} then {
+ error "anchors nw and n are the only ones supported"
+ }
+ _layout
+ }
+
+ # The name of the widget to put on the frame. This is set by some
+ # subclass calling the _add method. Private variable.
+ protected _widget {}
+
+ constructor {config} {
+ # The standard widget-making trick.
+ set class [$this info class]
+ set hull [namespace tail $this]
+ set old_name $this
+ ::rename $this $this-tmp-
+ ::frame $hull -class $class -relief flat -borderwidth 0
+ ::rename $hull $old_name-win-
+ ::rename $this $old_name
+
+ frame [namespace tail $this].iframe -relief groove -borderwidth 2
+ grid [namespace tail $this].iframe -row 1 -sticky news
+ grid rowconfigure [namespace tail $this] 1 -weight 1
+ grid columnconfigure [namespace tail $this] 0 -weight 1
+
+ # Make an internal frame so that user stuff isn't obscured. Note
+ # that we can't use the placer, because it doesn't set the
+ # geometry of the parent.
+ frame [namespace tail $this].iframe.frame -borderwidth 4 -relief flat
+ grid [namespace tail $this].iframe.frame -row 1 -sticky news
+ grid rowconfigure [namespace tail $this].iframe 1 -weight 1
+ grid columnconfigure [namespace tail $this].iframe 0 -weight 1
+
+ bind [namespace tail $this].iframe <Destroy> [list $this delete]
+ }
+
+ destructor {
+ catch {destroy $this}
+ }
+
+ # Return name of internal frame.
+ method get_frame {} {
+ return [namespace tail $this].iframe.frame
+ }
+
+ # Name a certain widget to be put on the frame. This should be
+ # called by some subclass after making the widget. Protected
+ # method.
+ method _add {widget} {
+ set _widget $widget
+ set height [expr {int ([winfo reqheight $_widget] / 2)}]
+ grid rowconfigure [namespace tail $this] 0 -minsize $height -weight 0
+ grid rowconfigure [namespace tail $this].iframe 0 -minsize $height -weight 0
+ _layout
+ }
+
+ # Re-layout according to the anchor. Private method.
+ method _layout {} {
+ if {$_widget == "" || ! [winfo exists $_widget]} then {
+ return
+ }
+
+ switch -- $anchor {
+ n {
+ # Put the label over the border, in the center.
+ place $_widget -in [namespace tail $this].iframe -relx 0.5 -rely 0 -y -2 \
+ -anchor center
+ }
+ nw {
+ # Put the label over the border, at the top left.
+ place $_widget -in [namespace tail $this].iframe -relx 0 -x 6 -rely 0 -y -2 \
+ -anchor w
+ }
+ default {
+ error "unsupported anchor \"$anchor\""
+ }
+ }
+ }
+}
diff --git a/libgui/library/wingrab.tcl b/libgui/library/wingrab.tcl
new file mode 100644
index 00000000000..1f579f93feb
--- /dev/null
+++ b/libgui/library/wingrab.tcl
@@ -0,0 +1,59 @@
+# wingrab.tcl -- grab support for Windows.
+# Copyright (C) 1997 Cygnus Solutions.
+# Written by Ian Lance Taylor <ian@cygnus.com>.
+
+# Disable a list of windows.
+
+proc WINGRAB_disable { args } {
+ foreach w $args {
+ ide_grab_support_disable [wm frame $w]
+ }
+}
+
+# Disable all top level windows, other than the argument, which are
+# children of `.'. Note that if you do this, and then destroy the
+# frame of the only enabled window, your application will lose the
+# input focus to some other application. Make sure that you reenable
+# the windows before calling wm transient or wm withdraw or destroy on
+# the only enabled window.
+
+proc WINGRAB_disable_except { window } {
+ foreach w [winfo children .] {
+ if {$w != $window} then {
+ ide_grab_support_disable [wm frame [winfo toplevel $w]]
+ }
+ }
+}
+
+# Enable a list of windows.
+
+proc WINGRAB_enable { args } {
+ foreach w $args {
+ ide_grab_support_enable [wm frame $w]
+ }
+}
+
+# Enable all top level windows which are children of `.'.
+
+proc WINGRAB_enable_all {} {
+ foreach w [winfo children .] {
+ ide_grab_support_enable [wm frame [winfo toplevel $w]]
+ }
+}
+
+# The basic routine. All commands are subcommands of this.
+
+proc ide_grab_support {dispatch args} {
+ global tcl_platform
+
+ if {[info commands WINGRAB_$dispatch] == ""} then {
+ error "unrecognized key \"$dispatch\""
+ }
+
+ # We only need to do stuff on Windows.
+ if {$tcl_platform(platform) != "windows"} then {
+ return
+ }
+
+ eval WINGRAB_$dispatch $args
+}
diff --git a/libgui/src/Makefile.am b/libgui/src/Makefile.am
new file mode 100644
index 00000000000..bcb1335709c
--- /dev/null
+++ b/libgui/src/Makefile.am
@@ -0,0 +1,85 @@
+## Process this file with automake to produce Makefile.in.
+
+AUTOMAKE_OPTIONS = cygnus
+
+noinst_LIBRARIES = libgui.a
+
+if INSTALL_LIBGUI
+
+include_HEADERS = \
+ guitcl.h subcommand.h
+
+endif
+
+# tkTable version info
+include $(srcdir)/tkTable_version.in
+
+# This sets the name that tkTable will define for itself when loaded
+# If you change this, then the demos won't work, but it might be necessary
+# for those with another built-in "table" command
+TBL_COMMAND = table
+
+tkTabletcl.h: $(srcdir)/tkTable.tcl
+ sed -e '/^$\#/d' -e '/^$$/d' -e 's/\"/\\"/g' -e 's/^/"/' -e 's/$$/\\n"/' <$(srcdir)/tkTable.tcl >tkTabletcl.h || rm tkTabletcl.h
+
+
+
+# Defining lib_LIBRARIES conditionally doesn't do the right thing.
+install-exec-local:
+if INSTALL_LIBGUI
+ @$(NORMAL_INSTALL)
+ $(mkinstalldirs) $(libdir)
+ $(INSTALL_DATA) libgui.a $(libdir)/libgui.a
+ @$(POST_INSTALL)
+ $(RANLIB) $(libdir)/libgui.a
+endif
+
+LIBGUI_CFLAGS=@LIBGUI_CFLAGS@
+
+## Some of the files in this directory want to see Tk internals.
+## Nasty.
+INCLUDES = $(LIBGUI_CFLAGS) $(TCLHDIR) \
+$(TKHDIR) \
+$(TK_XINCLUDES) $(TCL_DEFS) $(TK_DEFS) \
+$(TKHDIR)/../unix $(TKHDIR)/../win \
+-DTBL_VERSION=\"$(TBL_VERSION)\"\
+-DTBL_COMMAND=\"$(TBL_COMMAND)\"\
+-DTCL_RUNTIME=\"tkTable.tcl\"
+
+libgui_a_SOURCES = guitcl.h paths.c subcommand.c subcommand.h \
+tkTreeTable.c tkTreeTable.h xpmlib.c tclmain.c tkGraphCanvas.c \
+tkCanvEdge.c tkCanvLayout.c tkCanvLayout.h tclhelp.c tclgetdir.c \
+tclwinprint.c tclsizebox.c tclshellexe.c tclmapi.c tclwinfont.c \
+tclwingrab.c tclwinmode.c tclwinpath.c tclmsgbox.c tclcursor.c \
+tkTable.c tkTableCmd.c tkTableCell.c tkTableTag.c tkTableWin.c \
+tkWinPrintText.c tkWinPrintCanvas.c tkWarpPointer.c
+
+## Dependencies
+
+paths.$(OBJEXT): paths.c guitcl.h
+subcommand.$(OBJEXT): subcommand.c subcommand.h
+tkCanvEdge.$(OBJEXT): tkCanvEdge.c ../config.h
+tkCanvLayout.$(OBJEXT): tkCanvLayout.c ../config.h tkCanvLayout.h
+tkGraphCanvas.$(OBJEXT): tkGraphCanvas.c tkCanvLayout.h
+tkTreeTable.$(OBJEXT): tkTreeTable.c tkTreeTable.h
+xpmlib.$(OBJEXT): xpmlib.c guitcl.h
+assertions.$(OBJEXT): assertions.c ../config.h assertions.h
+tclcursor.$(OBJEXT): tclcursor.c ../config.h guitcl.h subcommand.h
+tclhelp.$(OBJEXT): tclhelp.c ../config.h guitcl.h subcommand.h
+tclgetdir.$(OBJEXT): tclgetdir.c guitcl.h
+tclmain.$(OBJEXT): tclmain.c guitcl.h
+tclwinprint.$(OBJEXT): tclwinprint.c guitcl.h subcommand.h
+tclsizebox.$(OBJEXT): tclsizebox.c guitcl.h
+tclshellexe.$(OBJEXT): tclshellexe.c guitcl.h
+tclmapi.$(OBJEXT): tclmapi.c guitcl.h subcommand.h
+tclwinfont.$(OBJEXT): tclwinfont.c guitcl.h
+tclwingrab.$(OBJEXT): tclwingrab.c guitcl.h
+tclwinpath.$(OBJEXT): tclwinpath.c guitcl.h subcommand.h
+tclwinmode.$(OBJEXT): tclwinmode.c guitcl.h
+tkTable.$(OBJEXT): tkTable.c tkTable.h tkTableCmd.h tkTabletcl.h
+tkTableCell.$(OBJEXT): tkTableCell.c tkTable.h tkTableCmd.h
+tkTableTag.$(OBJEXT): tkTableTag.c tkTable.h tkTableCmd.h
+tkTableWin.$(OBJEXT):tkTableWin.c tkTable.h tkTableCmd.h
+tkTableCmd.$(OBJEXT): tkTableCmd.c tkTableCmd.h
+tkTabletcl.h: tkTable.tcl
+
diff --git a/libgui/src/Makefile.in b/libgui/src/Makefile.in
new file mode 100644
index 00000000000..637fa24f5d8
--- /dev/null
+++ b/libgui/src/Makefile.in
@@ -0,0 +1,442 @@
+# Makefile.in generated automatically by automake 1.4 from Makefile.am
+
+# Copyright (C) 1994, 1995-8, 1999 Free Software Foundation, Inc.
+# This Makefile.in is free software; the Free Software Foundation
+# gives unlimited permission to copy and/or distribute it,
+# with or without modifications, as long as this notice is preserved.
+
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY, to the extent permitted by law; without
+# even the implied warranty of MERCHANTABILITY or FITNESS FOR A
+# PARTICULAR PURPOSE.
+
+
+
+SHELL = @SHELL@
+
+srcdir = @srcdir@
+top_srcdir = @top_srcdir@
+VPATH = @srcdir@
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+
+bindir = @bindir@
+sbindir = @sbindir@
+libexecdir = @libexecdir@
+datadir = @datadir@
+sysconfdir = @sysconfdir@
+sharedstatedir = @sharedstatedir@
+localstatedir = @localstatedir@
+libdir = @libdir@
+infodir = @infodir@
+mandir = @mandir@
+includedir = @includedir@
+oldincludedir = /usr/include
+
+DESTDIR =
+
+pkgdatadir = $(datadir)/@PACKAGE@
+pkglibdir = $(libdir)/@PACKAGE@
+pkgincludedir = $(includedir)/@PACKAGE@
+
+top_builddir = ..
+
+ACLOCAL = @ACLOCAL@
+AUTOCONF = @AUTOCONF@
+AUTOMAKE = @AUTOMAKE@
+AUTOHEADER = @AUTOHEADER@
+
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@ $(AM_INSTALL_PROGRAM_FLAGS)
+INSTALL_DATA = @INSTALL_DATA@
+INSTALL_SCRIPT = @INSTALL_SCRIPT@
+transform = @program_transform_name@
+
+NORMAL_INSTALL = :
+PRE_INSTALL = :
+POST_INSTALL = :
+NORMAL_UNINSTALL = :
+PRE_UNINSTALL = :
+POST_UNINSTALL = :
+host_alias = @host_alias@
+host_triplet = @host@
+BFDHDIR = @BFDHDIR@
+BFDLIB = @BFDLIB@
+CC = @CC@
+CXX = @CXX@
+CXXCPP = @CXXCPP@
+DEJAGNUHDIR = @DEJAGNUHDIR@
+DEJAGNULIB = @DEJAGNULIB@
+DEVOHDIR = @DEVOHDIR@
+ENDIAN = @ENDIAN@
+EXEEXT = @EXEEXT@
+GUILIB = @GUILIB@
+HAVE_DEVO_SIM = @HAVE_DEVO_SIM@
+IDEHDIR = @IDEHDIR@
+IDELIB = @IDELIB@
+IDETCLLIB = @IDETCLLIB@
+ILUHDIR = @ILUHDIR@
+ILULIB = @ILULIB@
+ILUTOP = @ILUTOP@
+INTLHDIR = @INTLHDIR@
+INTLLIB = @INTLLIB@
+ITCLHDIR = @ITCLHDIR@
+ITCLLIB = @ITCLLIB@
+ITCLMKIDX = @ITCLMKIDX@
+ITCLSH = @ITCLSH@
+ITCL_BUILD_LIB_SPEC = @ITCL_BUILD_LIB_SPEC@
+ITCL_DIR = @ITCL_DIR@
+ITCL_LIB_FILE = @ITCL_LIB_FILE@
+ITCL_LIB_FULL_PATH = @ITCL_LIB_FULL_PATH@
+ITCL_SH = @ITCL_SH@
+ITK_BUILD_LIB_SPEC = @ITK_BUILD_LIB_SPEC@
+ITK_LIB_FILE = @ITK_LIB_FILE@
+ITK_LIB_FULL_PATH = @ITK_LIB_FULL_PATH@
+LIBERTY = @LIBERTY@
+LIBGCC = @LIBGCC@
+LIBGUIHDIR = @LIBGUIHDIR@
+LIBGUILIB = @LIBGUILIB@
+LIBGUI_LIBRARY_DIR = @LIBGUI_LIBRARY_DIR@
+LIBIBERTY = @LIBIBERTY@
+MAINT = @MAINT@
+MAKEINFO = @MAKEINFO@
+OBJEXT = @OBJEXT@
+OPCODESLIB = @OPCODESLIB@
+PACKAGE = @PACKAGE@
+RANLIB = @RANLIB@
+RPATH_ENVVAR = @RPATH_ENVVAR@
+RUNTESTDIR = @RUNTESTDIR@
+SIMHDIR = @SIMHDIR@
+SIMLIB = @SIMLIB@
+TCLCONFIG = @TCLCONFIG@
+TCLHDIR = @TCLHDIR@
+TCL_BUILD_LIB_SPEC = @TCL_BUILD_LIB_SPEC@
+TCL_CFLAGS = @TCL_CFLAGS@
+TCL_DEFS = @TCL_DEFS@
+TCL_LD_FLAGS = @TCL_LD_FLAGS@
+TCL_LD_SEARCH_FLAGS = @TCL_LD_SEARCH_FLAGS@
+TCL_LIBRARY = @TCL_LIBRARY@
+TCL_LIBS = @TCL_LIBS@
+TCL_LIB_FILE = @TCL_LIB_FILE@
+TCL_LIB_FULL_PATH = @TCL_LIB_FULL_PATH@
+TCL_LIB_SPEC = @TCL_LIB_SPEC@
+TCL_RANLIB = @TCL_RANLIB@
+TCL_SHLIB_CFLAGS = @TCL_SHLIB_CFLAGS@
+TCL_SHLIB_LD = @TCL_SHLIB_LD@
+TIXHDIR = @TIXHDIR@
+TIX_BUILD_LIB_SPEC = @TIX_BUILD_LIB_SPEC@
+TIX_LIB_FULL_PATH = @TIX_LIB_FULL_PATH@
+TKCONFIG = @TKCONFIG@
+TKHDIR = @TKHDIR@
+TK_BUILD_INCLUDES = @TK_BUILD_INCLUDES@
+TK_BUILD_LIB_SPEC = @TK_BUILD_LIB_SPEC@
+TK_DEFS = @TK_DEFS@
+TK_LIBS = @TK_LIBS@
+TK_LIB_FILE = @TK_LIB_FILE@
+TK_LIB_FULL_PATH = @TK_LIB_FULL_PATH@
+TK_LIB_SPEC = @TK_LIB_SPEC@
+TK_VERSION = @TK_VERSION@
+TK_XINCLUDES = @TK_XINCLUDES@
+TK_XLIBSW = @TK_XLIBSW@
+VERSION = @VERSION@
+ac_cv_c_itclsh = @ac_cv_c_itclsh@
+
+AUTOMAKE_OPTIONS = cygnus
+
+noinst_LIBRARIES = libgui.a
+
+@INSTALL_LIBGUI_TRUE@include_HEADERS = \
+@INSTALL_LIBGUI_TRUE@\
+@INSTALL_LIBGUI_TRUE@ guitcl.h subcommand.h
+
+TBL_VERSION = 2.1
+
+# tkTable version info
+
+# This sets the name that tkTable will define for itself when loaded
+# If you change this, then the demos won't work, but it might be necessary
+# for those with another built-in "table" command
+TBL_COMMAND = table
+
+LIBGUI_CFLAGS = @LIBGUI_CFLAGS@
+
+INCLUDES = $(LIBGUI_CFLAGS) $(TCLHDIR) \
+$(TKHDIR) \
+$(TK_XINCLUDES) $(TCL_DEFS) $(TK_DEFS) \
+$(TKHDIR)/../unix $(TKHDIR)/../win \
+-DTBL_VERSION=\"$(TBL_VERSION)\"\
+-DTBL_COMMAND=\"$(TBL_COMMAND)\"\
+-DTCL_RUNTIME=\"tkTable.tcl\"
+
+
+libgui_a_SOURCES = guitcl.h paths.c subcommand.c subcommand.h \
+tkTreeTable.c tkTreeTable.h xpmlib.c tclmain.c tkGraphCanvas.c \
+tkCanvEdge.c tkCanvLayout.c tkCanvLayout.h tclhelp.c tclgetdir.c \
+tclwinprint.c tclsizebox.c tclshellexe.c tclmapi.c tclwinfont.c \
+tclwingrab.c tclwinmode.c tclwinpath.c tclmsgbox.c tclcursor.c \
+tkTable.c tkTableCmd.c tkTableCell.c tkTableTag.c tkTableWin.c \
+tkWinPrintText.c tkWinPrintCanvas.c tkWarpPointer.c
+
+mkinstalldirs = $(SHELL) $(top_srcdir)/../mkinstalldirs
+CONFIG_HEADER = ../config.h
+CONFIG_CLEAN_FILES =
+LIBRARIES = $(noinst_LIBRARIES)
+
+
+DEFS = @DEFS@ -I. -I$(srcdir) -I..
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+LIBS = @LIBS@
+libgui_a_LIBADD =
+libgui_a_OBJECTS = paths.$(OBJEXT) subcommand.$(OBJEXT) \
+tkTreeTable.$(OBJEXT) xpmlib.$(OBJEXT) tclmain.$(OBJEXT) \
+tkGraphCanvas.$(OBJEXT) tkCanvEdge.$(OBJEXT) tkCanvLayout.$(OBJEXT) \
+tclhelp.$(OBJEXT) tclgetdir.$(OBJEXT) tclwinprint.$(OBJEXT) \
+tclsizebox.$(OBJEXT) tclshellexe.$(OBJEXT) tclmapi.$(OBJEXT) \
+tclwinfont.$(OBJEXT) tclwingrab.$(OBJEXT) tclwinmode.$(OBJEXT) \
+tclwinpath.$(OBJEXT) tclmsgbox.$(OBJEXT) tclcursor.$(OBJEXT) \
+tkTable.$(OBJEXT) tkTableCmd.$(OBJEXT) tkTableCell.$(OBJEXT) \
+tkTableTag.$(OBJEXT) tkTableWin.$(OBJEXT) tkWinPrintText.$(OBJEXT) \
+tkWinPrintCanvas.$(OBJEXT) tkWarpPointer.$(OBJEXT)
+AR = ar
+CFLAGS = @CFLAGS@
+COMPILE = $(CC) $(DEFS) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS)
+CCLD = $(CC)
+LINK = $(CCLD) $(AM_CFLAGS) $(CFLAGS) $(LDFLAGS) -o $@
+HEADERS = $(include_HEADERS)
+
+DIST_COMMON = Makefile.am Makefile.in
+
+
+DISTFILES = $(DIST_COMMON) $(SOURCES) $(HEADERS) $(TEXINFOS) $(EXTRA_DIST)
+
+TAR = tar
+GZIP_ENV = --best
+SOURCES = $(libgui_a_SOURCES)
+OBJECTS = $(libgui_a_OBJECTS)
+
+all: all-redirect
+.SUFFIXES:
+.SUFFIXES: .S .c .o .obj .s
+$(srcdir)/Makefile.in: @MAINTAINER_MODE_TRUE@ Makefile.am $(top_srcdir)/configure.in $(ACLOCAL_M4) $(srcdir)/tkTable_version.in
+ cd $(top_srcdir) && $(AUTOMAKE) --cygnus src/Makefile
+
+Makefile: $(srcdir)/Makefile.in $(top_builddir)/config.status
+ cd $(top_builddir) \
+ && CONFIG_FILES=$(subdir)/$@ CONFIG_HEADERS= $(SHELL) ./config.status
+
+
+mostlyclean-noinstLIBRARIES:
+
+clean-noinstLIBRARIES:
+ -test -z "$(noinst_LIBRARIES)" || rm -f $(noinst_LIBRARIES)
+
+distclean-noinstLIBRARIES:
+
+maintainer-clean-noinstLIBRARIES:
+
+.c.o:
+ $(COMPILE) -c $<
+
+# FIXME: We should only use cygpath when building on Windows,
+# and only if it is available.
+.c.obj:
+ $(COMPILE) -c `cygpath -w $<`
+
+.s.o:
+ $(COMPILE) -c $<
+
+.S.o:
+ $(COMPILE) -c $<
+
+mostlyclean-compile:
+ -rm -f *.o core *.core
+ -rm -f *.$(OBJEXT)
+
+clean-compile:
+
+distclean-compile:
+ -rm -f *.tab.c
+
+maintainer-clean-compile:
+
+libgui.a: $(libgui_a_OBJECTS) $(libgui_a_DEPENDENCIES)
+ -rm -f libgui.a
+ $(AR) cru libgui.a $(libgui_a_OBJECTS) $(libgui_a_LIBADD)
+ $(RANLIB) libgui.a
+
+install-includeHEADERS: $(include_HEADERS)
+ @$(NORMAL_INSTALL)
+ $(mkinstalldirs) $(DESTDIR)$(includedir)
+ @list='$(include_HEADERS)'; for p in $$list; do \
+ if test -f "$$p"; then d= ; else d="$(srcdir)/"; fi; \
+ echo " $(INSTALL_DATA) $$d$$p $(DESTDIR)$(includedir)/$$p"; \
+ $(INSTALL_DATA) $$d$$p $(DESTDIR)$(includedir)/$$p; \
+ done
+
+uninstall-includeHEADERS:
+ @$(NORMAL_UNINSTALL)
+ list='$(include_HEADERS)'; for p in $$list; do \
+ rm -f $(DESTDIR)$(includedir)/$$p; \
+ done
+
+tags: TAGS
+
+ID: $(HEADERS) $(SOURCES) $(LISP)
+ list='$(SOURCES) $(HEADERS)'; \
+ unique=`for i in $$list; do echo $$i; done | \
+ awk ' { files[$$0] = 1; } \
+ END { for (i in files) print i; }'`; \
+ here=`pwd` && cd $(srcdir) \
+ && mkid -f$$here/ID $$unique $(LISP)
+
+TAGS: $(HEADERS) $(SOURCES) $(TAGS_DEPENDENCIES) $(LISP)
+ tags=; \
+ here=`pwd`; \
+ list='$(SOURCES) $(HEADERS)'; \
+ unique=`for i in $$list; do echo $$i; done | \
+ awk ' { files[$$0] = 1; } \
+ END { for (i in files) print i; }'`; \
+ test -z "$(ETAGS_ARGS)$$unique$(LISP)$$tags" \
+ || (cd $(srcdir) && etags $(ETAGS_ARGS) $$tags $$unique $(LISP) -o $$here/TAGS)
+
+mostlyclean-tags:
+
+clean-tags:
+
+distclean-tags:
+ -rm -f TAGS ID
+
+maintainer-clean-tags:
+
+distdir = $(top_builddir)/$(PACKAGE)-$(VERSION)/$(subdir)
+
+subdir = src
+
+distdir: $(DISTFILES)
+ @for file in $(DISTFILES); do \
+ if test -f $$file; then d=.; else d=$(srcdir); fi; \
+ if test -d $$d/$$file; then \
+ cp -pr $$d/$$file $(distdir)/$$file; \
+ else \
+ test -f $(distdir)/$$file \
+ || ln $$d/$$file $(distdir)/$$file 2> /dev/null \
+ || cp -p $$d/$$file $(distdir)/$$file || :; \
+ fi; \
+ done
+info-am:
+info: info-am
+dvi-am:
+dvi: dvi-am
+check-am:
+check: check-am
+installcheck-am:
+installcheck: installcheck-am
+install-info-am:
+install-info: install-info-am
+install-exec-am: install-exec-local
+install-exec: install-exec-am
+
+install-data-am: install-includeHEADERS
+install-data: install-data-am
+
+install-am: all-am
+ @$(MAKE) $(AM_MAKEFLAGS) install-exec-am install-data-am
+install: install-am
+uninstall-am: uninstall-includeHEADERS
+uninstall: uninstall-am
+all-am: Makefile $(LIBRARIES) $(HEADERS)
+all-redirect: all-am
+install-strip:
+ $(MAKE) $(AM_MAKEFLAGS) AM_INSTALL_PROGRAM_FLAGS=-s install
+installdirs:
+ $(mkinstalldirs) $(DESTDIR)$(includedir)
+
+
+mostlyclean-generic:
+
+clean-generic:
+
+distclean-generic:
+ -rm -f Makefile $(CONFIG_CLEAN_FILES)
+ -rm -f config.cache config.log stamp-h stamp-h[0-9]*
+
+maintainer-clean-generic:
+mostlyclean-am: mostlyclean-noinstLIBRARIES mostlyclean-compile \
+ mostlyclean-tags mostlyclean-generic
+
+mostlyclean: mostlyclean-am
+
+clean-am: clean-noinstLIBRARIES clean-compile clean-tags clean-generic \
+ mostlyclean-am
+
+clean: clean-am
+
+distclean-am: distclean-noinstLIBRARIES distclean-compile \
+ distclean-tags distclean-generic clean-am
+
+distclean: distclean-am
+
+maintainer-clean-am: maintainer-clean-noinstLIBRARIES \
+ maintainer-clean-compile maintainer-clean-tags \
+ maintainer-clean-generic distclean-am
+ @echo "This command is intended for maintainers to use;"
+ @echo "it deletes files that may require special tools to rebuild."
+
+maintainer-clean: maintainer-clean-am
+
+.PHONY: mostlyclean-noinstLIBRARIES distclean-noinstLIBRARIES \
+clean-noinstLIBRARIES maintainer-clean-noinstLIBRARIES \
+mostlyclean-compile distclean-compile clean-compile \
+maintainer-clean-compile uninstall-includeHEADERS \
+install-includeHEADERS tags mostlyclean-tags distclean-tags clean-tags \
+maintainer-clean-tags distdir info-am info dvi-am dvi check check-am \
+installcheck-am installcheck install-info-am install-info \
+install-exec-local install-exec-am install-exec install-data-am \
+install-data install-am install uninstall-am uninstall all-redirect \
+all-am all installdirs mostlyclean-generic distclean-generic \
+clean-generic maintainer-clean-generic clean mostlyclean distclean \
+maintainer-clean
+
+
+tkTabletcl.h: $(srcdir)/tkTable.tcl
+ sed -e '/^$\#/d' -e '/^$$/d' -e 's/\"/\\"/g' -e 's/^/"/' -e 's/$$/\\n"/' <$(srcdir)/tkTable.tcl >tkTabletcl.h || rm tkTabletcl.h
+
+# Defining lib_LIBRARIES conditionally doesn't do the right thing.
+install-exec-local:
+@INSTALL_LIBGUI_TRUE@ @$(NORMAL_INSTALL)
+@INSTALL_LIBGUI_TRUE@ $(mkinstalldirs) $(libdir)
+@INSTALL_LIBGUI_TRUE@ $(INSTALL_DATA) libgui.a $(libdir)/libgui.a
+@INSTALL_LIBGUI_TRUE@ @$(POST_INSTALL)
+@INSTALL_LIBGUI_TRUE@ $(RANLIB) $(libdir)/libgui.a
+
+paths.$(OBJEXT): paths.c guitcl.h
+subcommand.$(OBJEXT): subcommand.c subcommand.h
+tkCanvEdge.$(OBJEXT): tkCanvEdge.c ../config.h
+tkCanvLayout.$(OBJEXT): tkCanvLayout.c ../config.h tkCanvLayout.h
+tkGraphCanvas.$(OBJEXT): tkGraphCanvas.c tkCanvLayout.h
+tkTreeTable.$(OBJEXT): tkTreeTable.c tkTreeTable.h
+xpmlib.$(OBJEXT): xpmlib.c guitcl.h
+assertions.$(OBJEXT): assertions.c ../config.h assertions.h
+tclcursor.$(OBJEXT): tclcursor.c ../config.h guitcl.h subcommand.h
+tclhelp.$(OBJEXT): tclhelp.c ../config.h guitcl.h subcommand.h
+tclgetdir.$(OBJEXT): tclgetdir.c guitcl.h
+tclmain.$(OBJEXT): tclmain.c guitcl.h
+tclwinprint.$(OBJEXT): tclwinprint.c guitcl.h subcommand.h
+tclsizebox.$(OBJEXT): tclsizebox.c guitcl.h
+tclshellexe.$(OBJEXT): tclshellexe.c guitcl.h
+tclmapi.$(OBJEXT): tclmapi.c guitcl.h subcommand.h
+tclwinfont.$(OBJEXT): tclwinfont.c guitcl.h
+tclwingrab.$(OBJEXT): tclwingrab.c guitcl.h
+tclwinpath.$(OBJEXT): tclwinpath.c guitcl.h subcommand.h
+tclwinmode.$(OBJEXT): tclwinmode.c guitcl.h
+tkTable.$(OBJEXT): tkTable.c tkTable.h tkTableCmd.h tkTabletcl.h
+tkTableCell.$(OBJEXT): tkTableCell.c tkTable.h tkTableCmd.h
+tkTableTag.$(OBJEXT): tkTableTag.c tkTable.h tkTableCmd.h
+tkTableWin.$(OBJEXT):tkTableWin.c tkTable.h tkTableCmd.h
+tkTableCmd.$(OBJEXT): tkTableCmd.c tkTableCmd.h
+tkTabletcl.h: tkTable.tcl
+
+# Tell versions [3.59,3.63) of GNU make to not export all variables.
+# Otherwise a system limit (for SysV at least) may be exceeded.
+.NOEXPORT:
diff --git a/libgui/src/guitcl.h b/libgui/src/guitcl.h
new file mode 100644
index 00000000000..8bbbb045c76
--- /dev/null
+++ b/libgui/src/guitcl.h
@@ -0,0 +1,113 @@
+/* guitcl.h - Interface to Tcl layer of GUI support code.
+ Copyright (C) 1997, 1998 Cygnus Solutions.
+ Written by Tom Tromey <tromey@cygnus.com>. */
+
+#ifndef GUITCL_H
+#define GUITCL_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* This is like Tk_Main, but it doesn't assume that the program wants
+ to act like an interactive interpreter. */
+extern void
+ide_main (int ide_argc, char *ide_argv[], Tcl_AppInitProc *);
+
+/* Set up the XPM image reader. This requires Tk to be linked in.
+ However, it does not require Tk to be initialized before calling. */
+extern void
+ide_create_xpm_image_type (void);
+
+/* This locates the libide and application-specific Tcl libraries. It
+ sets the global Tcl variable `ide_application_name' to IDE_APPNAME,
+ and initializes a global Paths array with useful path information.
+ The application-specific Tcl library is assumed to be in the
+ directory $datadir/IDE_APPNAME/.
+ Returns a standard Tcl result. */
+extern int
+ide_initialize_paths (Tcl_Interp *, char *ide_appname);
+
+/* This tries to find the application-specific startup file. If it is
+ found, it is sourced. If not, an error results. The file is
+ assumed to be named $datadir/IDE_APPNAME/IDE_APPNAME.tcl, where
+ IDE_APPNAME is the name that was previously passed to
+ ide_initialize_paths.
+ Returns a standard Tcl result. */
+extern int
+ide_run_app_script (Tcl_Interp *);
+
+/* This adds the new Tk widget `treetable' to the interpreter
+ IDE_INTERP.
+ Returns a standard Tcl result. */
+extern int
+create_treetable_command (Tcl_Interp *ide_interp);
+
+/* This adds the new graph command for manipulating graphs to the
+ interpreter IDE_INTERP.
+ Returns a standard Tcl result. */
+extern int
+create_graph_command (Tcl_Interp *ide_interp);
+
+/* This function creates the ide_help Tcl command. */
+int
+ide_create_help_command (Tcl_Interp *);
+
+/* This function creates the ide_get_directory Tcl command. */
+int
+ide_create_get_directory_command (Tcl_Interp *);
+
+/* This function creates the ide_winprint Tcl command. */
+int
+ide_create_winprint_command (Tcl_Interp *);
+
+/* This function creates the ide_sizebox Tcl command. */
+int
+ide_create_sizebox_command (Tcl_Interp *);
+
+/* This function creates the ide_shell_execute command. */
+int
+ide_create_shell_execute_command (Tcl_Interp *);
+
+/* This function creates the `ide_mapi' command. */
+int
+ide_create_mapi_command (Tcl_Interp *);
+
+/* This function creates the `ide_win_choose_font' command. */
+int
+ide_create_win_choose_font_command (Tcl_Interp *);
+
+/* This function creates internal commands used by ide_grab_support on
+ Windows. */
+int
+ide_create_win_grab_command (Tcl_Interp *);
+
+/* This function creates the `ide_cygwin_path' command. */
+int
+ide_create_cygwin_path_command (Tcl_Interp *);
+
+/* This function creates the ide_cursor command on Windows. */
+int
+ide_create_cursor_command (Tcl_Interp *);
+
+/* This function creates the ide_set_error_mode command. On Windows,
+ this translates into a call to SetErrorMode. On Unix, this command
+ is a no-op. */
+int
+ide_create_set_error_mode_command (Tcl_Interp *);
+
+/* This function creates the ide_messageBox command. */
+int
+ide_create_messagebox_command (Tcl_Interp *);
+
+/* This function creates the "warp_pointer" command. Warp_pointer
+ forces the pointer to a specific location. There is probably no
+ good reason to use this except in the testsuite! */
+int
+cyg_create_warp_pointer_command (Tcl_Interp *interp);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* GUITCL_H */
diff --git a/libgui/src/paths.c b/libgui/src/paths.c
new file mode 100644
index 00000000000..5fdd392fdfb
--- /dev/null
+++ b/libgui/src/paths.c
@@ -0,0 +1,289 @@
+/* paths.c - Find IDE and application Tcl libraries.
+ Copyright (C) 1997 Cygnus Solutions.
+ Written by Tom Tromey <tromey@cygnus.com>. */
+
+#include <tk.h>
+#include <tcl.h>
+
+#include "guitcl.h"
+
+
+
+/* This Tcl code sets up all the path information we care about.
+
+ We first look for the gui library. This can be set by the
+ CYGNUS_GUI_LIBRARY environment variable. Otherwise, it is named
+ gui, and is found in $prefix/share/cygnus, where $prefix is
+ determined by looking at the directory where the running executable
+ is installed.
+
+ We then look for the ide library. This can be set by the
+ CYGNUS_IDE_LIBRARY environment variable. Otherwise, it is named
+ ide, and is also found in $prefix/share/cygnus.
+
+ It is OK if only one of these libraries exist. If neither exists,
+ we report an error.
+
+ We also set the following elements in the global Paths array.
+
+ prefix -- as in the configure argument
+ exec_prefix -- ditto
+ bindir -- ditto
+ libexecdir -- ditto
+ guidir -- the gui directory (not set if it does not exist)
+ idedir -- the ide directory (not set if it does not exist)
+ appdir -- see below
+ bitmapdir -- see below
+
+ Paths(appdir) is set based on the ide_initialize_paths APPNAME
+ parameter. If a directory $prefix/share/cygnus/APPNAME exists, we
+ set Paths(appdir) to it. More precisely, we set Paths(appdir) if
+ an APPNAME directory exists which is a sibling directory of the gui
+ or ide directory. For convenience of some tools, we also check for
+ $prefix/share/APPNAME, or, more precisely, we check whether APPNAME
+ is a sibling directory of the parent of the gui or ide directory.
+
+ Paths(bitmapdir) is set if gui or ide have a sibling directory
+ named bitmaps. */
+
+#ifndef _MSC_VER
+static char init_script[] = "\
+proc initialize_paths {} {\n\
+ global ide_application_name auto_path env Paths\n\
+ global tcl_library\n\
+ rename initialize_paths {}\n\
+ # First find the GUI library.\n\
+ set guidirs {}\n\
+ set prefdirs {}\n\
+ if [info exists env(CYGNUS_GUI_LIBRARY)] {\n\
+ lappend guidirs $env(CYGNUS_GUI_LIBRARY)\n\
+ }\n\
+ set here [pwd]\n\
+ cd [file dirname [info nameofexecutable]]\n\
+ # Handle build with --exec-prefix and build without.\n\
+ set d [file join [file dirname [pwd]] share]\n\
+ lappend prefdirs $d\n\
+ lappend guidirs [file join $d cygnus gui]\n\
+ set d [file join [file dirname [file dirname [pwd]]] share]\n\
+ lappend prefdirs $d\n\
+ lappend guidirs [file join $d cygnus gui]\n\
+ set Paths(bindir) [pwd]\n\
+ # Base `prefix' on where the `share' dir is found\n\
+ foreach sd $prefdirs {\n\
+ if [file isdirectory $sd] {\n\
+ set Paths(prefix) [file dirname $sd]\n\
+ break\n\
+ }\n\
+ }\n\
+ if {[file isdirectory [file join [file dirname [pwd]] libexec]]} {\n\
+ set Paths(libexecdir) [file join [file dirname [pwd]] libexec]\n\
+ } else {\n\
+ set Paths(libexecdir) $Paths(bindir)\n\
+ }\n\
+ set Paths(exec_prefix) [file dirname [pwd]]\n\
+ cd $here\n\
+ # Try to handle running from the build tree:\n\
+ lappend guidirs [file join [file dirname [file dirname $tcl_library]] libgui library]\n\
+ foreach sd $guidirs {\n\
+ if {[file exists [file join $sd tclIndex]]} {\n\
+ lappend auto_path $sd\n\
+ set Paths(guidir) $sd\n\
+ break\n\
+ }\n\
+ }\n\
+ # Now find the IDE library, if it exists.\n\
+ set idedirs {}\n\
+ if [info exists env(CYGNUS_IDE_LIBRARY)] {\n\
+ lappend idedirs $env(CYGNUS_IDE_LIBRARY)\n\
+ }\n\
+ foreach d $prefdirs {\n\
+ lappend idedirs [file join $d cygnus ide]\n\
+ }\n\
+ # Try to handle running from the build tree:\n\
+ lappend idedirs [file join [file dirname [file dirname $tcl_library]] libide library]\n\
+ foreach sd $idedirs {\n\
+ if {[file exists [file join $sd tclIndex]]} {\n\
+ lappend auto_path $sd\n\
+ set Paths(idedir) $sd\n\
+ break\n\
+ }\n\
+ }\n\
+ # Now set the bitmap directory:\n\
+ foreach v [list guidir idedir] {\n\
+ if {[info exists Paths($v)]} {\n\
+ set d [file dirname $Paths($v)]\n\
+ if {[file isdirectory [file join $d bitmaps]]} {\n\
+ set Paths(bitmapdir) [file join $d bitmaps]\n\
+ }\n\
+ }\n\
+ }\n\
+ \n\
+ # We do things in a somewhat roundabout way here. This lets us\n\
+ # run from the source directory, if we're willing to be a little messy\n\
+ # in our test scripts. FIXME: find a cleaner way.\n\
+ # This routine is really meant to find the libgui & libide library directories.\n\
+ #\n\
+ # The client may not want it trying to find the application library\n\
+ # Signal that by setting ide_application_name to empty string\n\
+ if {$ide_application_name != \"\"} {\n\
+ foreach v [list guidir idedir] {\n\
+ if {[info exists Paths($v)]} {\n\
+ set d [file dirname $Paths($v)]\n\
+ if {[file isdirectory [file join $d $ide_application_name]]} {\n\
+ lappend auto_path [file join $d $ide_application_name]\n\
+ set Paths(appdir) [file join $d $ide_application_name]\n\
+ }\n\
+ }\n\
+ }\n\
+ if {! [info exists Paths(appdir)]} {\n\
+ foreach v [list guidir idedir] {\n\
+ if {[info exists Paths($v)]} {\n\
+ set d [file dirname [file dirname $Paths($v)]]\n\
+ if {[file isdirectory [file join $d $ide_application_name]]} {\n\
+ lappend auto_path [file join $d $ide_application_name]\n\
+ set Paths(appdir) [file join $d $ide_application_name]\n\
+ }\n\
+ }\n\
+ }\n\
+ }\n\
+ }\n\
+ if {[info exists Paths(guidir)] || [info exists Paths(idedir)]} {\n\
+ return\n\
+ }\n\
+ # FIXME: must run this message through gettext.\n\
+ # Can only do this once gettext is in C and not just a stub.\n\
+ set msg \"Can't find the GUI Tcl library in the following directories:\n\"\n\
+ append msg \" $guidirs $idedirs\n\"\n\
+ error $msg\n\
+}\n\
+initialize_paths";
+#else
+static char init_script[] = "\
+proc initialize_paths {} {\n\
+ global ide_application_name auto_path env Paths\n\
+ global tcl_library\n\
+ rename initialize_paths {}\n\
+ set guidirs {}\n\
+ set here [pwd]\n\
+ cd [file dirname [info nameofexecutable]]\n\
+ set d [file join [file dirname [pwd]] share]\n\
+ lappend guidirs [file join $d cygnus gui]\n\
+ set d [file join [file dirname [file dirname [pwd]]] share]\n\
+ lappend guidirs [file join $d cygnus gui]\n\
+ lappend guidirs [file join [file dirname [file dirname $tcl_library]] libgui library]\n\
+ foreach sd $guidirs {\n\
+ if {[file exists [file join $sd tclIndex]]} {\n\
+ lappend auto_path $sd\n\
+ set Paths(guidir) $sd\n\
+ break\n\
+ }\n\
+ }\n\
+ foreach v [list guidir] {\n\
+ if {[info exists Paths($v)]} {\n\
+ set d [file dirname $Paths($v)]\n\
+ if {[file isdirectory [file join $d bitmaps]]} {\n\
+ set Paths(bitmapdir) [file join $d bitmaps]\n\
+ }\n\
+ }\n\
+ }\n\
+ \n\
+ if {$ide_application_name != \"\"} {\n\
+ foreach v [list guidir ] {\n\
+ if {[info exists Paths($v)]} {\n\
+ set d [file dirname $Paths($v)]\n\
+ if {[file isdirectory [file join $d $ide_application_name]]} {\n\
+ lappend auto_path [file join $d $ide_application_name]\n\
+ set Paths(appdir) [file join $d $ide_application_name]\n\
+ }\n\
+ }\n\
+ }\n\
+ if {! [info exists Paths(appdir)]} {\n\
+ foreach v [list guidir] {\n\
+ if {[info exists Paths($v)]} {\n\
+ set d [file dirname [file dirname $Paths($v)]]\n\
+ if {[file isdirectory [file join $d $ide_application_name]]} {\n\
+ lappend auto_path [file join $d $ide_application_name]\n\
+ set Paths(appdir) [file join $d $ide_application_name]\n\
+ }\n\
+ }\n\
+ }\n\
+ }\n\
+ }\n\
+ if {[info exists Paths(guidir)]} {\n\
+ return\n\
+ }\n\
+ set msg \"Can't find the GUI Tcl library in the following directories:\n\"\n\
+ append msg \" $guidirs\n\"\n\
+ error $msg\n\
+}\n\
+initialize_paths";
+#endif
+
+/* Initialize the global Paths variable. */
+int
+ide_initialize_paths (Tcl_Interp *interp, char *appname)
+{
+ if (Tcl_SetVar (interp, "ide_application_name", appname,
+ TCL_GLOBAL_ONLY) == NULL)
+ return (TCL_ERROR);
+ return (Tcl_GlobalEval (interp, init_script));
+}
+
+#ifdef TCLPRO_DEBUGGER
+static char run_app_script[] = "\
+proc initialize_find_app_script {} {\n\
+ global Paths env ide_application_name\n\
+ rename initialize_find_app_script {}\n\
+ if {[info exists env(TCLPRO_DEBUG_DIR)]} {\n\
+ source [file join $env(TCLPRO_DEBUG_DIR) prodebug.tcl]\n\
+ debugger_init\n\
+ }\n\
+ # Look in idedir for the sake of test apps like idetrace.\n\
+ foreach v [list appdir idedir] {\n\
+ if {[info exists Paths($v)]} {\n\
+ set file [file join $Paths($v) ${ide_application_name}.tcl]\n\
+ if {[file exists $file]} {\n\
+ if {[info exists env(TCLPRO_DEBUG_DIR)]} {\n\
+ # Right now, only one process can be debugged at a time.\n\
+ # Unset the debug dir, so we won't try to debug any\n\
+ # child processes...\n\
+ unset env(TCLPRO_DEBUG_DIR)\n\
+ uplevel #0 debugger_eval [list source $file]\n\
+ } else {\n\
+ uplevel #0 [list source $file]\n\
+ }\n\
+ return\n\
+ }\n\
+ }\n\
+ }\n\
+ # FIXME: must run message through gettext.\n\
+ error \"Can't find ${ide_application_name}.tcl\"\n\
+}\n\
+initialize_find_app_script";
+#else
+static char run_app_script[] = "\
+proc initialize_find_app_script {} {\n\
+ global Paths ide_application_name\n\
+ rename initialize_find_app_script {}\n\
+ # Look in idedir for the sake of test apps like idetrace.\n\
+ foreach v [list appdir idedir] {\n\
+ if {[info exists Paths($v)]} {\n\
+ set file [file join $Paths($v) ${ide_application_name}.tcl]\n\
+ if {[file exists $file]} {\n\
+ uplevel #0 [list source $file]\n\
+ return\n\
+ }\n\
+ }\n\
+ }\n\
+ # FIXME: must run message through gettext.\n\
+ error \"Can't find ${ide_application_name}.tcl\"\n\
+}\n\
+initialize_find_app_script";
+#endif
+
+/* Run the application-specific init script. */
+int
+ide_run_app_script (Tcl_Interp *interp)
+{
+ return (Tcl_GlobalEval (interp, run_app_script));
+}
diff --git a/libgui/src/subcommand.c b/libgui/src/subcommand.c
new file mode 100644
index 00000000000..29e7ea12f18
--- /dev/null
+++ b/libgui/src/subcommand.c
@@ -0,0 +1,126 @@
+/* subcommand.c - Automate handling of subcommands in Tcl.
+ Copyright (C) 1997 Cygnus Solutions.
+ Written by Tom Tromey <tromey@cygnus.com>. */
+
+#include <string.h>
+
+#include <tcl.h>
+
+#include "subcommand.h"
+
+/* A pointer to this structure is the clientdata for
+ subcommand_implementation. */
+
+struct subcommand_clientdata
+{
+ const struct ide_subcommand_table *commands;
+ ClientData subdata;
+ Tcl_CmdDeleteProc *delete;
+};
+
+/* This is called when one of our commands is deleted. */
+static void
+subcommand_deleted (ClientData cd)
+{
+ struct subcommand_clientdata *data = (struct subcommand_clientdata *) cd;
+
+ if (data->delete)
+ (*data->delete) (data->subdata);
+ Tcl_Free ((char *) data);
+}
+
+/* This function implements any Tcl command registered as having
+ subcommands. The ClientData here must be a pointer to the command
+ table. */
+static int
+subcommand_implementation (ClientData cd, Tcl_Interp *interp,
+ int argc, char *argv[])
+{
+ struct subcommand_clientdata *data = (struct subcommand_clientdata *) cd;
+ const struct ide_subcommand_table *commands = data->commands;
+ int i;
+
+ if (argc < 2)
+ {
+ Tcl_AppendResult (interp, "wrong # args: must be \"",
+ argv[0], " key ?arg ...?\"", (char *) NULL);
+ return (TCL_ERROR);
+ }
+
+ for (i = 0; commands[i].method != NULL; ++i)
+ {
+ if (! strcmp (argv[1], commands[i].method))
+ {
+ if (argc < commands[i].min_args)
+ {
+ char buf[20];
+ Tcl_AppendResult (interp, "wrong # args: got ", (char *) NULL);
+ sprintf (buf, "%d", argc);
+ Tcl_AppendResult (interp, buf, " but expected at least ",
+ (char *) NULL);
+ sprintf (buf, "%d", commands[i].min_args);
+ Tcl_AppendResult (interp, buf, (char *) NULL);
+ return (TCL_ERROR);
+ }
+
+ if (commands[i].max_args > 0 && argc > commands[i].max_args)
+ {
+ char buf[20];
+ Tcl_AppendResult (interp, "wrong # args: got ", (char *) NULL);
+ sprintf (buf, "%d", argc);
+ Tcl_AppendResult (interp, buf, " but expected at most ",
+ (char *) NULL);
+ sprintf (buf, "%d", commands[i].max_args);
+ Tcl_AppendResult (interp, buf, (char *) NULL);
+ return (TCL_ERROR);
+ }
+
+ return (commands[i].func (data->subdata, interp, argc, argv));
+ }
+ }
+
+ Tcl_AppendResult (interp, "unrecognized key \"", argv[1],
+ "\"; must be one of ", (char *) NULL);
+ for (i = 0; commands[i].method != NULL; ++i)
+ Tcl_AppendResult (interp, "\"", commands[i].method,
+ (commands[i + 1].method == NULL) ? "\"" : "\", ",
+ (char *) NULL);
+ return (TCL_ERROR);
+}
+
+/* Define a command with subcommands. */
+int
+ide_create_command_with_subcommands (Tcl_Interp *interp, char *name,
+ const struct ide_subcommand_table *table,
+ ClientData subdata,
+ Tcl_CmdDeleteProc *delete)
+{
+ int i;
+ struct subcommand_clientdata *data;
+
+ /* Sanity check. */
+ for (i = 0; table[i].method != NULL; ++i)
+ {
+ if ((table[i].min_args > table[i].max_args && table[i].max_args != -1)
+ || table[i].min_args < 2
+ || table[i].max_args < -1)
+ {
+ Tcl_AppendResult (interp, "subcommand \"", table[i].method,
+ "\" of command \"", name,
+ "\" has bad argument count",
+ (char *) NULL);
+ return (TCL_ERROR);
+ }
+ }
+
+ data = (struct subcommand_clientdata *) Tcl_Alloc (sizeof *data);
+ data->commands = table;
+ data->subdata = subdata;
+ data->delete = delete;
+
+ if (Tcl_CreateCommand (interp, name, subcommand_implementation,
+ (ClientData) data, subcommand_deleted) == NULL)
+ return (TCL_ERROR);
+
+ return (TCL_OK);
+}
diff --git a/libgui/src/subcommand.h b/libgui/src/subcommand.h
new file mode 100644
index 00000000000..2db964bb778
--- /dev/null
+++ b/libgui/src/subcommand.h
@@ -0,0 +1,31 @@
+/* subcommand.h - Handle commands with subcommands.
+ Copyright (C) 1997 Cygnus Solutions.
+ Written by Tom Tromey <tromey@cygnus.com>. */
+
+#ifndef SUBCOMMAND_H
+#define SUBCOMMAND_H
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+struct ide_subcommand_table
+{
+ const char *method; /* Method name. If NULL, then this is
+ the last entry in the table. */
+ Tcl_CmdProc *func; /* The implementation. */
+ int min_args; /* Minimum number of args. */
+ int max_args; /* Maximum number of args. -1 means
+ no maximum. */
+};
+
+/* Define a command with subcommands. */
+int ide_create_command_with_subcommands
+ (Tcl_Interp *interp, char *name, const struct ide_subcommand_table *table,
+ ClientData, Tcl_CmdDeleteProc *);
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /* SUBCOMMAND_H */
diff --git a/libgui/src/tclcursor.c b/libgui/src/tclcursor.c
new file mode 100644
index 00000000000..8a8cd18c86c
--- /dev/null
+++ b/libgui/src/tclcursor.c
@@ -0,0 +1,77 @@
+/* tclcursor.c - Tcl function to compute the size of a cursor.
+ Copyright (C) 1997 Cygnus Solutions.
+ Written by Tom Tromey <tromey@cygnus.com>. */
+
+/* Interestingly, there is no way to get the size of a cursor in X.
+ We would have to change Tk to keep track of this information if we
+ cared about it. Luckily, we only care for Windows. */
+
+/* This makes a Tcl command with two subcommands:
+
+ ide_cursor size - Return size of cursor as list {WIDTH HEIGHT}
+
+ ide_cursor position - Return position of cursor as list {X Y}
+
+ */
+
+#ifdef _WIN32
+
+#include <windows.h>
+
+#include <tcl.h>
+#include <stdio.h>
+
+#include "guitcl.h"
+#include "subcommand.h"
+
+static int
+get_cursor_size (ClientData cd, Tcl_Interp *interp, int argc, char *argv[])
+{
+ char buf[30];
+
+ sprintf (buf, "%d", GetSystemMetrics (SM_CXCURSOR));
+ Tcl_AppendElement (interp, buf);
+ sprintf (buf, "%d", GetSystemMetrics (SM_CYCURSOR));
+ Tcl_AppendElement (interp, buf);
+
+ return TCL_OK;
+}
+
+static int
+get_cursor_position (ClientData cd, Tcl_Interp *interp, int argc, char *argv[])
+{
+ POINT where;
+ char buf[30];
+
+ if (! GetCursorPos (&where))
+ {
+ Tcl_AppendResult (interp, argv[0], ": couldn't get cursor position",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ sprintf (buf, "%ld", where.x);
+ Tcl_AppendElement (interp, buf);
+ sprintf (buf, "%ld", where.y);
+ Tcl_AppendElement (interp, buf);
+
+ return TCL_OK;
+}
+
+static const struct ide_subcommand_table cursor_commands[] =
+{
+ { "size", get_cursor_size, 2, 2 },
+ { "position", get_cursor_position, 2, 2 },
+ { NULL, NULL, 0, 0 }
+};
+
+int
+ide_create_cursor_command (Tcl_Interp *interp)
+{
+ return ide_create_command_with_subcommands (interp, "ide_cursor",
+ cursor_commands,
+ (ClientData) NULL,
+ NULL);
+}
+
+#endif /* _WIN32 */
diff --git a/libgui/src/tclgetdir.c b/libgui/src/tclgetdir.c
new file mode 100644
index 00000000000..7d70aef0012
--- /dev/null
+++ b/libgui/src/tclgetdir.c
@@ -0,0 +1,269 @@
+/* tclgetdir.c -- TCL code to browse for a directory.
+ Copyright (C) 1997, 1998 Cygnus Solutions.
+ Written by Ian Lance Taylor <ian@cygnus.com>. */
+
+#ifdef _WIN32
+#include <windows.h>
+#ifndef _GNU_H_WINDOWS_H /* if not using old Cygwin Win32 headers */
+#include <shlobj.h>
+#endif
+#endif
+
+#include <tcl.h>
+#include <tk.h>
+
+#include "guitcl.h"
+
+/* This file defines one TCL command.
+
+ ide_get_directory
+ Allows the user to select a directory. Returns the selected
+ directory as a string. */
+
+#ifdef _WIN32
+
+#include <tkWinInt.h>
+/* a call back to set the initial selected directory */
+
+/* defines currently missing from Cygwin32 */
+#ifndef BFFM_INITIALIZED
+
+
+LPITEMIDLIST WINAPI SHBrowseForFolderA(LPBROWSEINFO lpbi);
+
+/* message from browser */
+#define BFFM_INITIALIZED 1
+#define BFFM_SELCHANGED 2
+
+/* messages to browser */
+#define BFFM_SETSTATUSTEXTA (WM_USER + 100)
+#define BFFM_ENABLEOK (WM_USER + 101)
+#define BFFM_SETSELECTIONA (WM_USER + 102)
+#define BFFM_SETSELECTIONW (WM_USER + 103)
+#define BFFM_SETSTATUSTEXTW (WM_USER + 104)
+
+#ifdef UNICODE
+#define SHBrowseForFolder SHBrowseForFolderW
+#define BFFM_SETSTATUSTEXT BFFM_SETSTATUSTEXTW
+#define BFFM_SETSELECTION BFFM_SETSELECTIONW
+#else
+#define SHBrowseForFolder SHBrowseForFolderA
+#define BFFM_SETSTATUSTEXT BFFM_SETSTATUSTEXTA
+#define BFFM_SETSELECTION BFFM_SETSELECTIONA
+#endif
+
+#endif /* ! BFFM_INITIALIZED */
+
+/* FIXME: We need to dig into the Tk window implementation internals. */
+
+int CALLBACK MyBrowseCallbackProc(HWND hwnd, UINT uMsg, LPARAM lParam, LPARAM lpData)
+{
+ if (uMsg==BFFM_INITIALIZED)
+ {
+ SendMessage(hwnd,BFFM_SETSELECTION,(WPARAM)TRUE,(LPARAM)lpData);
+ }
+ return 0;
+}
+
+/* Implement the Windows version of the ide_get_directory command. */
+static int
+get_directory_command (ClientData cd, Tcl_Interp *interp, int argc,
+ char **argv)
+{
+ BROWSEINFO bi;
+ char buf[MAX_PATH + 1];
+ Tk_Window parent;
+ int i, oldMode;
+ LPITEMIDLIST idlist;
+ char *p;
+ int atts;
+ Tcl_DString tempBuffPtr;
+#if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)
+ Tcl_DString titleDString;
+ Tcl_DString initialDirDString;
+ Tcl_DString resultDString;
+
+ Tcl_DStringInit(&titleDString);
+ Tcl_DStringInit(&initialDirDString);
+#endif
+
+ Tcl_DStringInit(&tempBuffPtr);
+
+ bi.hwndOwner = NULL;
+ bi.pidlRoot = NULL;
+ bi.pszDisplayName = buf;
+ bi.lpszTitle = NULL;
+ bi.ulFlags = 0;
+ bi.lpfn = NULL;
+ bi.lParam = 0;
+ bi.iImage = 0;
+
+ parent = Tk_MainWindow (interp);
+
+ for (i = 1; i < argc; i += 2)
+ {
+ int v;
+ int len;
+
+ v = i + 1;
+ len = strlen (argv[i]);
+
+ 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;
+
+#if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)
+ Tcl_UtfToExternalDString(NULL, argv[v], -1, &titleDString);
+ bi.lpszTitle = Tcl_DStringValue(&titleDString);
+#else
+ bi.lpszTitle = argv[v];
+#endif
+ }
+ else if (strncmp (argv[i], "-initialdir", len) == 0)
+ {
+ if (v == argc)
+ goto arg_missing;
+
+ /* bi.lParam will be passed to the callback function.(save the need for globals)*/
+ bi.lParam = (LPARAM) Tcl_TranslateFileName(interp, argv[v], &tempBuffPtr);
+#if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)
+ Tcl_UtfToExternalDString(NULL, (char *) bi.lParam, -1, &initialDirDString);
+ bi.lParam = (LPARAM) Tcl_DStringValue(&initialDirDString);
+#endif
+ bi.lpfn = MyBrowseCallbackProc;
+ }
+ else
+ {
+ Tcl_AppendResult (interp, "unknown option \"", argv[i],
+ "\", must be -parent or -title", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (Tk_WindowId (parent) == None)
+ Tk_MakeWindowExist (parent);
+
+ bi.hwndOwner = Tk_GetHWND (Tk_WindowId (parent));
+
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ idlist = SHBrowseForFolder (&bi);
+ Tcl_SetServiceMode(oldMode);
+
+ if (idlist == NULL)
+ {
+ /* User pressed the cancel button. */
+ return TCL_OK;
+ }
+
+ if (! SHGetPathFromIDList (idlist, buf))
+ {
+ Tcl_SetResult (interp, "could not get path for directory", TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ /* Ensure the directory exists. */
+ atts = GetFileAttributesA (buf);
+ if (atts == -1 || ! (atts & FILE_ATTRIBUTE_DIRECTORY))
+ {
+ Tcl_AppendResult (interp, "path \"", buf, "\" is not a directory",
+ (char *) NULL);
+ /* FIXME: free IDLIST. */
+ return TCL_ERROR;
+ }
+
+ /* FIXME: We are supposed to free IDLIST using the shell task
+ allocator, but cygwin32 doesn't define the required interfaces
+ yet. */
+
+
+
+ /* Normalize the path for Tcl. */
+#if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)
+ Tcl_ExternalToUtfDString(NULL, buf, -1, &resultDString);
+ p = Tcl_DStringValue(&resultDString);
+#else
+ p = buf;
+#endif
+ for (; *p != '\0'; ++p)
+ if (*p == '\\')
+ *p = '/';
+
+ Tcl_ResetResult(interp);
+#if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)
+ Tcl_SetResult(interp, Tcl_DStringValue(&resultDString), TCL_VOLATILE);
+ Tcl_DStringFree(&resultDString);
+ Tcl_DStringFree(&titleDString);
+ Tcl_DStringFree(&initialDirDString);
+#else
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+#endif
+ Tcl_DStringFree(&tempBuffPtr);
+
+ return TCL_OK;
+
+ arg_missing:
+ Tcl_AppendResult(interp, "value for \"", argv[argc - 1], "\" missing",
+ NULL);
+ return TCL_ERROR;
+}
+
+
+#else /* ! _WIN32 */
+
+/* Use our modified file dialog, and hope the user picks a directory. */
+
+static int
+get_directory_command (ClientData cd, Tcl_Interp *interp, int argc,
+ char **argv)
+{
+ char **new_args;
+ char *merge;
+ int result, i;
+
+ /* We can't directly run Tk_GetOpenFile, because it wants some
+ ClientData that we're best off not knowing. So instead we
+ re-eval. This is a lot less efficient, but it doesn't really
+ matter. */
+
+ new_args = (char **) Tcl_Alloc ((argc + 2) * sizeof (char *));
+
+ new_args[0] = "tk_getOpenFile";
+ new_args[1] = "-choosedir";
+ new_args[2] = "1";
+
+ for (i = 1; i < argc; ++i)
+ new_args[2 + i] = argv[i];
+
+ merge = Tcl_Merge (argc + 2, new_args);
+ result = Tcl_GlobalEval (interp, merge);
+
+ Tcl_Free (merge);
+ Tcl_Free ((char *) new_args);
+
+ return result;
+}
+
+#endif /* ! _WIN32 */
+
+/* This function creates the ide_get_directory TCL command. */
+
+int
+ide_create_get_directory_command (Tcl_Interp *interp)
+{
+ if (Tcl_CreateCommand (interp, "ide_get_directory", get_directory_command,
+ NULL, NULL) == NULL)
+ return TCL_ERROR;
+ return TCL_OK;
+}
diff --git a/libgui/src/tclhelp.c b/libgui/src/tclhelp.c
new file mode 100644
index 00000000000..199cff77d2e
--- /dev/null
+++ b/libgui/src/tclhelp.c
@@ -0,0 +1,618 @@
+/* tclhelp.c -- TCL interface to help.
+ Copyright (C) 1997 Cygnus Solutions.
+ Written by Ian Lance Taylor <ian@cygnus.com>. */
+
+#include "config.h"
+
+#include <stdio.h>
+#include <ctype.h>
+
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#endif
+
+#include <errno.h>
+#ifndef errno
+extern int errno;
+#endif
+
+#ifdef HAVE_STRING_H
+#include <string.h>
+#else
+#ifdef HAVE_STRINGS_H
+#include <strings.h>
+#else
+extern char *strerror ();
+#endif
+#endif
+
+#ifdef _WIN32
+/* We avoid warnings by including this before tcl.h. */
+#include <windows.h>
+#include <winuser.h>
+#endif
+
+#include <tcl.h>
+#include <tk.h>
+
+#include "guitcl.h"
+#include "subcommand.h"
+
+/* This file defines one TCL command with subcommands. This command
+ may be used to bring up a help window.
+
+ ide_help initialize ...
+ Initialize the help system.
+
+ On Windows, this takes two arguments: the name of the help
+ file, and the name of the header file which may be used to map
+ help topics to numbers. This header files is created by the
+ help system.
+
+ The Unix help system has not yet been implemented.
+
+ ide_help topic TOPIC
+ Brings up a help window for the particular topic. The topic is
+ a string.
+
+ ide_help toc
+ Brings up a help window for the main table of contents.
+
+ ide_help display_file FILENAME TOPIC_ID
+ The "display_file" subcommand was added as a hack to get the Foundry Tour to
+ launch. The help system can't handle more than one help file and should
+ be rewritten */
+
+#ifdef _WIN32
+
+/* Windows implementation. This uses WinHelp. */
+
+/* We use an instance of this structure as the client data for the
+ ide_help command. */
+
+struct help_command_data
+{
+ /* The name of the help file. */
+ char *filename;
+ /* The name of the help header file which we use to map topic
+ strings to numbers. */
+ char *header_filename;
+ /* A hash table mapping help topic strings to numbers. */
+ Tcl_HashTable topic_hash;
+ /* Nonzero if the hash table has been initialized. */
+ int hash_initialized;
+ /* The window we are passing to WinHelp. */
+ HWND window;
+};
+
+/* This function is called as an exit handler. */
+
+static void
+help_command_atexit (ClientData cd)
+{
+ struct help_command_data *hdata = (struct help_command_data *) cd;
+
+ /* Tell Windows we don't need any more help. */
+ if (hdata->window != NULL)
+ WinHelp (hdata->window, hdata->filename, HELP_QUIT, 0);
+}
+
+/* This function is called if the ide_help command is deleted. */
+
+static void
+help_command_deleted (ClientData cd)
+{
+ struct help_command_data *hdata = (struct help_command_data *) cd;
+
+ /* Run the exit handler now, rather than when we exit. */
+ help_command_atexit (cd);
+ Tcl_DeleteExitHandler (help_command_atexit, cd);
+
+ if (hdata->filename != NULL)
+ free (hdata->filename);
+ if (hdata->header_filename != NULL)
+ free (hdata->header_filename);
+ if (hdata->hash_initialized)
+ Tcl_DeleteHashTable (&hdata->topic_hash);
+ Tcl_Free ((char *) hdata);
+}
+
+/* Initialize the help system: choose a window, and set up the topic
+ hash table. We don't set up the topic hash table when the command
+ is created, because there's no point wasting time on it at program
+ startup time if the help system is not going to be used. */
+
+static int
+help_initialize (Tcl_Interp *interp, struct help_command_data *hdata)
+{
+ if (hdata->filename == NULL || hdata->header_filename == NULL)
+ {
+ Tcl_SetResult (interp, "help system has not been initialized",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ if (hdata->window == NULL)
+ {
+ HWND window, parent;
+
+ /* We don't really care what window we use, although it should
+ probably be one that will last until the application exits. */
+ window = GetActiveWindow ();
+ if (window == NULL)
+ window = GetFocus ();
+ if (window == NULL)
+ {
+ Tcl_SetResult (interp, "can't find window to use for help",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ while ((parent = GetParent (window)) != NULL)
+ window = parent;
+
+ hdata->window = window;
+
+ Tcl_CreateExitHandler (help_command_atexit, (ClientData) hdata);
+ }
+
+ if (! hdata->hash_initialized)
+ {
+ FILE *e;
+ char buf[200];
+
+ e = fopen (hdata->header_filename, "r");
+ if (e == NULL)
+ {
+ Tcl_AppendResult (interp, "can't open help file \"",
+ hdata->header_filename, "\": ",
+ strerror (errno), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_InitHashTable (&hdata->topic_hash, TCL_STRING_KEYS);
+ hdata->hash_initialized = 1;
+
+ /* We expect the format of the header file to be tightly
+ constrained: the lines of interest will look like
+ #define TOPIC_STRING TOPIC_NUMBER
+ We ignore all other lines. We assume that topic strings have
+ a limited length, since they are created by humans, so for
+ simplicity we use fgets with a fixed size buffer. The error
+ checking is minimal, but that's OK, because this file is part
+ of the application; it is not created by the user. */
+
+ while (fgets (buf, sizeof buf, e) != NULL)
+ {
+ char *s, *topic;
+ int number;
+ Tcl_HashEntry *he;
+ int new;
+
+ if (strncmp (buf, "#define", 7) != 0)
+ continue;
+
+ s = buf + 7;
+ while (isspace ((unsigned char) *s))
+ ++s;
+ topic = s;
+ while (! isspace ((unsigned char) *s))
+ ++s;
+ *s = '\0';
+
+ number = atoi (s + 1);
+ if (number == 0)
+ continue;
+
+ he = Tcl_CreateHashEntry (&hdata->topic_hash, topic, &new);
+ Tcl_SetHashValue (he, (ClientData) number);
+ }
+
+ fclose (e);
+ }
+
+ return TCL_OK;
+}
+
+/* Implement the ide_help initialize command. We don't actually look
+ at the files now; we only do that if the user requests help. */
+
+static int
+help_initialize_command (ClientData cd, Tcl_Interp *interp, int argc,
+ char **argv)
+{
+ struct help_command_data *hdata = (struct help_command_data *) cd;
+
+ hdata->filename = strdup (argv[2]);
+ hdata->header_filename = strdup (argv[3]);
+ return TCL_OK;
+}
+
+#define INIT_MINARGS (4)
+#define INIT_MAXARGS (4)
+
+/* Implement the ide_help topic command. */
+
+static int
+help_topic_command (ClientData cd, Tcl_Interp *interp, int argc, char **argv)
+{
+ struct help_command_data *hdata = (struct help_command_data *) cd;
+ Tcl_HashEntry *he;
+
+ if (help_initialize (interp, hdata) != TCL_OK)
+ return TCL_ERROR;
+
+ he = Tcl_FindHashEntry (&hdata->topic_hash, argv[2]);
+ if (he == NULL)
+ {
+ Tcl_AppendResult (interp, "unknown help topic \"", argv[2], "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (! WinHelp (hdata->window, hdata->filename, HELP_CONTEXT,
+ (DWORD) Tcl_GetHashValue (he)))
+ {
+ char buf[200];
+
+ FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError (), 0,
+ buf, 200, NULL);
+ Tcl_AppendResult (interp, "WinHelp failed: ", buf, (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/* Implement the ide_help toc command. */
+
+static int
+help_toc_command (ClientData cd, Tcl_Interp *interp, int argc, char **argv)
+{
+ struct help_command_data *hdata = (struct help_command_data *) cd;
+
+ if (help_initialize (interp, hdata) != TCL_OK)
+ return TCL_ERROR;
+
+ if (! WinHelp (hdata->window, hdata->filename, HELP_FINDER, 0))
+ {
+ char buf[200];
+
+ FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError (), 0,
+ buf, 200, NULL);
+ Tcl_AppendResult (interp, "WinHelp failed: ", buf, (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/* Implement the ide_help display_file command. */
+/* This is a hack to display an external help file, */
+/* by 'external' I mean not part of Foundry Help. */
+/* This was added specifically to display the Foundry */
+/* Tour help file and should be made less hacky in the future */
+/* The "display_file" subcommand was added as a hack to get the Foundry Tour to */
+/* launch. The help system can't handle more than one help file and should */
+/* be rewritten */
+
+static int
+help_display_file_command (ClientData cd, Tcl_Interp *interp, int argc, char **argv)
+{
+ struct help_command_data *hdata = (struct help_command_data *) cd;
+ FILE *e;
+ DWORD topic_id = 0; /* default topic id is 0 which brings up the find dialog */
+
+ /* We call Help initialize just to make sure the window handle is setup */
+ /* We don't care about the finding the main help file and checking the */
+ /* hash table but we do it anyway because this is a hack. */
+ if (help_initialize (interp, hdata) != TCL_OK)
+ return TCL_ERROR;
+
+ /* We should check to see if the help file we want exists since function */
+ /* 'help_initialize' checked the wrong file (it checked the main help file) */
+ e = fopen (argv[2], "r");
+ if (e == NULL)
+ {
+ Tcl_AppendResult (interp, "can't open help file \"",
+ argv[2], "\": ",
+ strerror (errno), (char *) NULL);
+ return TCL_ERROR;
+ }
+ fclose (e);
+ if (argc > 3)
+ {
+ if ( Tcl_GetInt (interp, argv[3], &topic_id) != TCL_OK )
+ return TCL_ERROR;
+ }
+
+ if (! WinHelp (hdata->window, argv[2], HELP_CONTEXT, topic_id))
+ {
+ char buf[200];
+
+ FormatMessage (FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError (), 0,
+ buf, 200, NULL);
+ Tcl_AppendResult (interp, "WinHelp failed: ", buf, (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/* Initialize the help command structure. */
+
+struct help_command_data *
+hdata_initialize ()
+{
+ struct help_command_data *hdata;
+
+ hdata = (struct help_command_data *) Tcl_Alloc (sizeof *hdata);
+
+ hdata->filename = NULL;
+ hdata->header_filename = NULL;
+ hdata->hash_initialized = 0;
+ hdata->window = NULL;
+
+ return hdata;
+}
+
+#else /* ! _WIN32 */
+
+/* The Unix help implementation. */
+
+/* We use an instance of this structure as the client data for the
+ ide_help command. */
+
+struct help_command_data
+{
+ /* path to webhelp.csh file */
+ char *filename;
+ /* path to foundry.hh file */
+ char *header_filename;
+ /* path to help directory */
+ char *help_dir;
+ /* A hash table mapping help topic strings to numbers. */
+ Tcl_HashTable topic_hash;
+ /* Nonzero if the hash table has been initialized. */
+ int hash_initialized;
+ /* pointer to large block of memory used for hashing */
+ char *memory_block;
+ };
+
+/* This function is called if the ide_help command is deleted. */
+
+static void
+help_command_deleted (ClientData cd)
+{
+ struct help_command_data *hdata = (struct help_command_data *) cd;
+
+ if (hdata->filename != NULL)
+ free (hdata->filename);
+ if (hdata->header_filename != NULL)
+ free (hdata->header_filename);
+ if (hdata->hash_initialized)
+ Tcl_DeleteHashTable (&hdata->topic_hash);
+ if (hdata->memory_block != NULL)
+ free (hdata->memory_block);
+ Tcl_Free ((char *) hdata);
+}
+
+/* Implement the ide_help initialize command. */
+
+static int
+help_initialize_command (ClientData cd, Tcl_Interp *interp, int argc,
+ char **argv)
+{
+ struct help_command_data *hdata = (struct help_command_data *) cd;
+
+ hdata->filename = strdup (argv[2]);
+ hdata->header_filename = strdup (argv[3]);
+ hdata->help_dir = strdup (argv[4]);
+ return TCL_OK;
+}
+
+static int
+help_initialize (Tcl_Interp *interp, struct help_command_data *hdata)
+{
+
+ if (hdata->filename == NULL || hdata->header_filename == NULL)
+ {
+ Tcl_SetResult (interp, "help system has not been initialized",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ if (! hdata->hash_initialized)
+ {
+ FILE *e;
+ char buf[200], *block_start;
+
+ block_start = hdata->memory_block = malloc(6000);
+
+ e = fopen (hdata->header_filename, "r");
+ if (e == NULL)
+ {
+ Tcl_AppendResult (interp, "can't open help file \"",
+ hdata->header_filename, "\": ",
+ strerror (errno), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ Tcl_InitHashTable (&hdata->topic_hash, TCL_STRING_KEYS);
+ hdata->hash_initialized = 1;
+
+ /* We expect the format of the header file to be tightly
+ constrained: the lines of interest will look like
+ #define TOPIC_STRING TOPIC_FILENAME
+ We ignore all other lines. We assume that topic strings have
+ a limited length, since they are created by humans, so for
+ simplicity we use fgets with a fixed size buffer. The error
+ checking is minimal, but that's OK, because this file is part
+ of the application; it is not created by the user. */
+
+ while (fgets (buf, sizeof buf, e) != NULL)
+ {
+ char *s, *topic, *strng;
+ Tcl_HashEntry *he;
+ int new;
+
+ if (strncmp (buf, "#define", 7) != 0)
+ continue;
+
+ s = buf + 7;
+ while (isspace ((unsigned char) *s))
+ ++s;
+ topic = s;
+ while (! isspace ((unsigned char) *s))
+ ++s;
+ *s = '\0';
+
+ ++s;
+ while (isspace ((unsigned char) *s))
+ ++s;
+ strng = s;
+ while (! isspace ((unsigned char) *s))
+ ++s;
+ *s = '\0';
+ strcpy (block_start, strng);
+
+ he = Tcl_CreateHashEntry (&hdata->topic_hash, topic, &new);
+ Tcl_SetHashValue (he, (ClientData) block_start);
+ block_start += strlen(strng) + 2;
+
+ }
+ fclose (e);
+
+ }
+
+ return TCL_OK;
+
+}
+
+#define INIT_MINARGS 2
+#define INIT_MAXARGS 5
+
+/* Implement the ide_help topic command. */
+
+static int
+help_topic_command (ClientData cd, Tcl_Interp *interp, int argc, char **argv)
+{
+ struct help_command_data *hdata = (struct help_command_data *) cd;
+ Tcl_HashEntry *he;
+ char htmlFile[250], htmlFile2[250];
+
+ if (help_initialize (interp, hdata) != TCL_OK)
+ return TCL_ERROR;
+
+ he = Tcl_FindHashEntry (&hdata->topic_hash, argv[2]);
+ if (he == NULL)
+ {
+ Tcl_AppendResult (interp, "unknown help topic \"", argv[2], "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ else
+ {
+
+ strcpy (htmlFile, hdata->help_dir);
+ strcat (htmlFile, "/");
+ strcat (htmlFile, Tcl_GetHashValue (he));
+
+ ShowHelp (htmlFile, hdata->filename);
+ return TCL_OK;
+ }
+}
+
+/* Implement the ide_help toc command. */
+
+static int
+help_toc_command (ClientData cd, Tcl_Interp *interp, int argc, char **argv)
+{
+ struct help_command_data *hdata = (struct help_command_data *) cd;
+ char htmlFile[250];
+
+ strcpy (htmlFile, hdata->help_dir);
+ strcat (htmlFile, "/start.htm");
+
+ if (! ShowHelp (htmlFile, hdata->filename))
+ { Tcl_SetResult (interp, "Help not available", TCL_STATIC);
+ return TCL_ERROR;
+ }
+}
+
+/* Implement the ide_help display command. */
+
+static int
+help_display_file_command (ClientData cd, Tcl_Interp *interp, int argc, char **argv)
+{
+ struct help_command_data *hdata = (struct help_command_data *) cd;
+
+ if (! ShowHelp (argv[2], hdata->filename))
+ { Tcl_SetResult (interp, "Help not available", TCL_STATIC);
+ return TCL_ERROR;
+ }
+}
+
+/* Initialize the help command structure. */
+
+struct help_command_data *
+hdata_initialize ()
+{
+ struct help_command_data *hdata;
+
+ hdata = (struct help_command_data *) Tcl_Alloc (sizeof *hdata);
+
+ hdata->filename = NULL;
+ hdata->help_dir = NULL;
+ hdata->header_filename = NULL;
+ hdata->hash_initialized = 0;
+ hdata->memory_block = NULL;
+
+ return hdata;
+}
+
+int
+ShowHelp(const char* html_filename, const char* shellFile)
+{
+ int pidProcess = fork();
+ if (pidProcess == 0)
+ {
+ /* new child process */
+ execl("/bin/csh", "/bin/csh", shellFile, html_filename, 0);
+ /* execl only returns if error occurred */
+ _exit(-1);
+ }
+ /* fork failed, error number is why */
+ else if (pidProcess == (-1))
+ { return 0; }
+}
+
+#endif /* ! _WIN32 */
+
+/* The subcommand table. */
+/* The "display_file" subcommand was added as a hack to get the Foundry Tour to */
+/* launch. The help system can't handle more than one help file and should */
+/* be rewritten */
+static const struct ide_subcommand_table help_commands[] =
+{
+ { "initialize", help_initialize_command, INIT_MINARGS, INIT_MAXARGS },
+ { "topic", help_topic_command, 3, 3 },
+ { "toc", help_toc_command, 2, 2 },
+ { "display_file", help_display_file_command, 3, 4 },
+ { NULL, NULL, 0, 0 }
+};
+
+/* This function creates the ide_help TCL command. */
+
+int
+ide_create_help_command (Tcl_Interp *interp)
+{
+ struct help_command_data *hdata;
+
+ hdata = hdata_initialize ();
+
+ return ide_create_command_with_subcommands (interp, "ide_help",
+ help_commands,
+ (ClientData) hdata,
+ help_command_deleted);
+}
diff --git a/libgui/src/tclmain.c b/libgui/src/tclmain.c
new file mode 100644
index 00000000000..1a962544998
--- /dev/null
+++ b/libgui/src/tclmain.c
@@ -0,0 +1,100 @@
+/* tclmain.c - a simple main() for IDE programs that use Tk.
+ Copyright (C) 1997, 1998 Cygnus Solutions.
+ Written by Tom Tromey <tromey@cygnus.com>. */
+
+#include <config.h>
+
+#include <tcl.h>
+#include <tk.h>
+
+#include <stdio.h>
+
+#ifdef HAVE_STDLIB_H
+#include <stdlib.h>
+#endif
+
+#ifdef _WIN32
+#include <windows.h>
+#include <winuser.h>
+#endif
+
+#include "guitcl.h"
+
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+
+#ifndef EXIT_FAILURE
+#define EXIT_FAILURE 1
+#endif
+
+/* This is like Tk_Main, except that the resulting program doesn't try
+ to act like a script interpreter. It never reads commands from
+ stdin. */
+void
+ide_main (int argc, char *argv[], Tcl_AppInitProc *appInitProc)
+{
+ Tcl_Interp *interp;
+ char *args;
+ char buf[20];
+
+ Tcl_FindExecutable (argv[0]);
+ interp = Tcl_CreateInterp ();
+
+#ifdef TCL_MEM_DEBUG
+ Tcl_InitMemory (interp);
+#endif
+
+ args = Tcl_Merge (argc - 1, argv + 1);
+ Tcl_SetVar (interp, "argv", args, TCL_GLOBAL_ONLY);
+ Tcl_Free (args);
+
+ sprintf (buf, "%d", argc-1);
+ Tcl_SetVar (interp, "argc", buf, TCL_GLOBAL_ONLY);
+ Tcl_SetVar (interp, "argv0", argv[0], TCL_GLOBAL_ONLY);
+
+ /* We set this to "1" so that the console window will work. */
+ Tcl_SetVar (interp, "tcl_interactive", "1", TCL_GLOBAL_ONLY);
+
+#if IDE_ENABLED
+ Tcl_SetVar (interp, "IDE_ENABLED", "1", TCL_GLOBAL_ONLY);
+#else
+ Tcl_SetVar (interp, "IDE_ENABLED", "0", TCL_GLOBAL_ONLY);
+#endif
+
+ if ((*appInitProc) (interp) != TCL_OK)
+ {
+ Tcl_Channel err_channel;
+ char *msg;
+
+ /* Guarantee that errorInfo is set properly. */
+ Tcl_AddErrorInfo (interp, "");
+ msg = Tcl_GetVar (interp, "errorInfo", TCL_GLOBAL_ONLY);
+
+ /* On Windows, we are probably running as a windows app, and
+ stderr is the bit bucket, so we call a win32 function to
+ display the error. */
+
+#ifdef _WIN32
+ MessageBox (NULL, msg, NULL, MB_OK | MB_ICONERROR | MB_TASKMODAL);
+#else
+ err_channel = Tcl_GetStdChannel (TCL_STDERR);
+ if (err_channel)
+ {
+
+ Tcl_Write (err_channel, msg, -1);
+ Tcl_Write (err_channel, "\n", 1);
+ }
+#endif
+
+ Tcl_DeleteInterp (interp);
+ Tcl_Exit (EXIT_FAILURE);
+ }
+
+ Tcl_ResetResult (interp);
+
+ /* Now just go until the user decides to shut down. */
+ Tk_MainLoop ();
+ Tcl_DeleteInterp (interp);
+ Tcl_Exit (EXIT_SUCCESS);
+}
diff --git a/libgui/src/tclmapi.c b/libgui/src/tclmapi.c
new file mode 100644
index 00000000000..1b80914b332
--- /dev/null
+++ b/libgui/src/tclmapi.c
@@ -0,0 +1,79 @@
+/* tclmapi.c - Tcl interface to MAPI.
+ Copyright (C) 1997 Cygnus Solutions
+ Written by Tom Tromey <tromey@cygnus.com>. */
+
+#ifdef _WIN32
+
+#include <windows.h>
+#include <mapi.h>
+
+#include <stdio.h>
+#include <tcl.h>
+
+#include "guitcl.h"
+#include "subcommand.h"
+
+/* Usage for the mapi command:
+ mapi simple-send TO-ADDRESS SUBJECT TEXT.
+
+ This command has been deliberately kept very simple; it only does
+ what we need. However it can be extended by adding new subcommands
+ if necessary. */
+
+static int
+mapi_command (ClientData cd, Tcl_Interp *interp, int argc, char *argv[])
+{
+ MapiMessage message;
+ MapiRecipDesc to;
+ ULONG result;
+
+ message.ulReserved = 0;
+ message.lpszSubject = argv[3];
+ message.lpszNoteText = argv[4];
+ message.lpszMessageType = NULL;
+ message.lpszDateReceived = NULL;
+ message.lpszConversationID = NULL;
+ message.flFlags = 0;
+ message.lpOriginator = NULL;
+ message.nRecipCount = 1;
+ message.lpRecips = &to;
+ message.nFileCount = 0;
+ message.lpFiles = NULL;
+
+ to.ulReserved = 0;
+ to.ulRecipClass = MAPI_TO;
+ to.lpszName = "";
+ /* FIXME: smtp:address? */
+ to.lpszAddress = argv[2];
+ to.ulEIDSize = 0;
+ to.lpEntryID = NULL;
+
+ result = MAPISendMail (0, 0, &message, MAPI_LOGON_UI, 0);
+ if (result != SUCCESS_SUCCESS)
+ {
+ /* We could decode the error here. */
+ char buf[20];
+
+ sprintf (buf, "0x%lx", result);
+ Tcl_AppendResult (interp, argv[0], ": failed with status ",
+ buf, (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+static const struct ide_subcommand_table mapi_table[] =
+{
+ { "simple-send", mapi_command, 5, 5 },
+ { NULL, NULL, 0, 0 }
+};
+
+int
+ide_create_mapi_command (Tcl_Interp *interp)
+{
+ return ide_create_command_with_subcommands (interp, "ide_mapi",
+ mapi_table, NULL, NULL);
+}
+
+#endif /* _WIN32 */
diff --git a/libgui/src/tclmsgbox.c b/libgui/src/tclmsgbox.c
new file mode 100644
index 00000000000..8db081fb2a6
--- /dev/null
+++ b/libgui/src/tclmsgbox.c
@@ -0,0 +1,462 @@
+/* tclmsgbox.c -- Tcl code to handle a Windows MessageBox in the background.
+ Copyright (C) 1998 Cygnus Solutions.
+ Written by Ian Lance Taylor <ian@cygnus.com>. */
+
+#ifdef _WIN32
+
+#include <tcl.h>
+#include <tk.h>
+
+#include <windows.h>
+
+/* FIXME: We use some internal Tcl and Tk Windows stuff. */
+#include <tkWinInt.h>
+
+EXTERN HINSTANCE TclWinGetTclInstance (void);
+
+#include "guitcl.h"
+
+/* This file defines a single Tcl command.
+
+ ide_messageBox CODE [ARGUMENTS]
+
+ This is just like tk_messageBox, except that it does not return
+ a value. Instead, when the user clicks on a button closing the
+ message box, this invokes CODE, appending the selected value.
+
+ On Windows, this runs the MessageBox function in another
+ thread. This permits a program which handles IDE requests from
+ other programs to not return from the request until the
+ MessageBox completes. This is not possible without using
+ another thread, since the MessageBox function call will be
+ running its own event loop, and will be higher on the stack
+ than the IDE request.
+
+ On Unix tk_messageBox runs in the regular Tk event loop, so
+ another thread is not required.
+
+ */
+
+static LRESULT CALLBACK msgbox_wndproc (HWND, UINT, WPARAM, LPARAM);
+static int msgbox_eventproc (Tcl_Event *, int);
+
+/* The hidden message box window. */
+
+static HWND hidden_hwnd;
+
+/* The message number we use to indicate that the MessageBox call has
+ completed. */
+
+#define MSGBOX_MESSAGE (WM_USER + 1)
+
+/* We pass a pointer to this structure to the thread function. It
+ passes it back to the hidden window procedure. */
+
+struct msgbox_data
+{
+ /* Tcl interpreter. */
+ Tcl_Interp *interp;
+ /* Tcl code to execute when MessageBox completes. */
+ char *code;
+ /* Hidden window handle. */
+ HWND hidden_hwnd;
+ /* MessageBox arguments. */
+ HWND hwnd;
+ char *message;
+ char *title;
+ int flags;
+ /* Result of MessageBox call. */
+ int result;
+};
+
+/* This is the structure we pass to Tcl_QueueEvent. */
+
+struct msgbox_event
+{
+ /* The base structure for all events. */
+ Tcl_Event header;
+ /* The message box data for this event. */
+ struct msgbox_data *md;
+};
+
+/* Initialize a hidden window to handle messages from the message box
+ thread. */
+
+static int
+msgbox_init ()
+{
+ WNDCLASS class;
+
+ if (hidden_hwnd != NULL)
+ return TCL_OK;
+
+ class.style = 0;
+ class.cbClsExtra = 0;
+ class.cbWndExtra = 0;
+ class.hInstance = TclWinGetTclInstance();
+ class.hbrBackground = NULL;
+ class.lpszMenuName = NULL;
+ class.lpszClassName = "ide_messagebox";
+ class.lpfnWndProc = msgbox_wndproc;
+ class.hIcon = NULL;
+ class.hCursor = NULL;
+
+ if (! RegisterClass (&class))
+ return TCL_ERROR;
+
+ hidden_hwnd = CreateWindow ("ide_messagebox", "ide_messagebox", WS_TILED,
+ 0, 0, 0, 0, NULL, NULL, class.hInstance, NULL);
+ if (hidden_hwnd == NULL)
+ return TCL_ERROR;
+
+ return TCL_OK;
+}
+
+/* This is called as an exit handler. */
+
+static void
+msgbox_exit (ClientData cd)
+{
+ if (hidden_hwnd != NULL)
+ {
+ UnregisterClass ("ide_messagebox", TclWinGetTclInstance ());
+ DestroyWindow (hidden_hwnd);
+ hidden_hwnd = NULL;
+
+ /* FIXME: Ideally we would kill off any remaining threads and
+ somehow free up the associated data. */
+ }
+}
+
+/* This is the thread function which actually invokes the MessageBox
+ function. This function runs in a separate thread. */
+
+static DWORD WINAPI
+msgbox_thread (LPVOID arg)
+{
+ struct msgbox_data *md = (struct msgbox_data *) arg;
+
+ md->result = MessageBox (md->hwnd, md->message, md->title,
+ md->flags | MB_SETFOREGROUND);
+ PostMessage (md->hidden_hwnd, MSGBOX_MESSAGE, 0, (LPARAM) arg);
+ return 0;
+}
+
+/* This function handles Windows events for the hidden window. When
+ the MessageBox function call completes in the thread, this function
+ will be called with MSGBOX_MESSAGE. */
+
+static LRESULT CALLBACK
+msgbox_wndproc (HWND hwnd, UINT message, WPARAM wparam, LPARAM lparam)
+{
+ struct msgbox_event *me;
+
+ if (message != MSGBOX_MESSAGE)
+ return DefWindowProc (hwnd, message, wparam, lparam);
+
+ /* Queue up a Tcl event. */
+ me = (struct msgbox_event *) Tcl_Alloc (sizeof *me);
+ me->header.proc = msgbox_eventproc;
+ me->md = (struct msgbox_data *) lparam;
+ Tcl_QueueEvent ((Tcl_Event *) me, TCL_QUEUE_TAIL);
+
+ return 0;
+}
+
+/* This function handles Tcl events. It is invoked when a MessageBox
+ has completed. */
+
+static int
+msgbox_eventproc (Tcl_Event *event, int flags)
+{
+ struct msgbox_event *me = (struct msgbox_event *) event;
+ char *resstr;
+ Tcl_DString ds;
+ int ret;
+
+ /* Only execute the Tcl code if we are waiting for window events. */
+ if ((flags & TCL_WINDOW_EVENTS) == 0)
+ return 0;
+
+ /* This switch is copied from Tk_MessageBoxCmd in Tk. */
+ switch (me->md->result)
+ {
+ case IDABORT: resstr = "abort"; break;
+ case IDCANCEL: resstr = "cancel"; break;
+ case IDIGNORE: resstr = "ignore"; break;
+ case IDNO: resstr = "no"; break;
+ case IDOK: resstr = "ok"; break;
+ case IDRETRY: resstr = "retry"; break;
+ case IDYES: resstr = "yes"; break;
+ default: resstr = "";
+ }
+
+ Tcl_DStringInit (&ds);
+ Tcl_DStringAppend (&ds, me->md->code, -1);
+ Tcl_DStringAppendElement (&ds, resstr);
+
+ /* FIXME: What if the interpreter has been deleted? */
+ ret = Tcl_GlobalEval (me->md->interp, Tcl_DStringValue (&ds));
+
+ Tcl_DStringFree (&ds);
+
+ /* We are now done with the msgbox_data structure, so we can free
+ the fields and the structure itself. */
+ Tcl_Free (me->md->code);
+ Tcl_Free (me->md->message);
+ Tcl_Free (me->md->title);
+ Tcl_Free ((char *) me->md);
+
+ if (ret != TCL_OK)
+ Tcl_BackgroundError (me->md->interp);
+
+ return 1;
+}
+
+/* This is a direct steal from tkWinDialog.c, for the use of msgbox.
+ I kept the same formatting as well, to make it easier to merge
+ changes. */
+
+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"}}
+};
+
+/* This is mostly a direct steal from Tk_MessageBoxCmd in Tk. I kept
+ the same formatting as well, to make it easier to merge changes. */
+
+static int
+msgbox_internal (ClientData clientData, Tcl_Interp *interp, int argc,
+ char **argv, char *code)
+{
+ int flags;
+ Tk_Window parent = NULL;
+ HWND hWnd;
+ char *message = "";
+ char *title = "";
+ int icon = MB_ICONINFORMATION;
+ int type = MB_OK;
+ int modal = MB_SYSTEMMODAL;
+ int i, j;
+ 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 if (strncmp (argv[i], "-modal", len) == 0) {
+ if (v==argc) {goto arg_missing;}
+
+ if (strcmp(argv[v], "system") == 0) {
+ modal = MB_SYSTEMMODAL;
+ }
+ else if (strcmp(argv[v], "task") == 0) {
+ modal = MB_TASKMODAL;
+ }
+ else if (strcmp(argv[v], "owner") == 0) {
+ modal = MB_APPLMODAL;
+ }
+ else {
+ Tcl_AppendResult(interp, "invalid modality \"", argv[v],
+ "\", must be system, task or owner", 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 (parent == NULL && modal == MB_TASKMODAL) {
+ hWnd = NULL;
+ }
+ else {
+ if (parent == NULL) {
+ parent = Tk_MainWindow(interp);
+ }
+ 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;
+
+ /* At this point we diverge from Tk_MessageBoxCmd. */
+ {
+ struct msgbox_data *md;
+ HANDLE thread;
+ DWORD tid;
+
+ msgbox_init ();
+
+ md = (struct msgbox_data *) Tcl_Alloc (sizeof *md);
+ md->interp = interp;
+ md->code = Tcl_Alloc (strlen (code) + 1);
+ strcpy (md->code, code);
+ md->hidden_hwnd = hidden_hwnd;
+ md->hwnd = hWnd;
+ md->message = Tcl_Alloc (strlen (message) + 1);
+ strcpy (md->message, message);
+ md->title = Tcl_Alloc (strlen (title) + 1);
+ strcpy (md->title, title);
+ md->flags = flags | modal;
+
+ /* Start the thread. This will call MessageBox, and then start
+ the ball rolling to execute the specified code. */
+ thread = CreateThread (NULL, 0, msgbox_thread, (LPVOID) md, 0, &tid);
+ CloseHandle (thread);
+ }
+
+ return TCL_OK;
+
+ arg_missing:
+ Tcl_AppendResult(interp, "value for \"", argv[argc-1], "\" missing",
+ NULL);
+ return TCL_ERROR;
+}
+
+/* This is the ide_messageBox function. */
+
+static int
+msgbox (ClientData cd, Tcl_Interp *interp, int argc, char **argv)
+{
+ if (argc < 2)
+ {
+ char buf[10];
+
+ sprintf (buf, "%d", argc);
+ Tcl_AppendResult (interp, "wrong # args: got ", buf,
+ " but expected at least 2", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* Note that we don't bother to pass the correct value for argv[0]
+ to msgbox_internal, since it doesn't look at it anyhow. Note
+ that we will pass a NULL clientdata argument. */
+ return msgbox_internal (cd, interp, argc - 1, argv + 1, argv[1]);
+}
+
+/* Create the Tcl command. */
+
+int
+ide_create_messagebox_command (Tcl_Interp *interp)
+{
+ Tcl_CreateExitHandler (msgbox_exit, NULL);
+ if (Tcl_CreateCommand (interp, "ide_messageBox", msgbox, NULL, NULL) == NULL)
+ return TCL_ERROR;
+ return TCL_OK;
+}
+
+#endif /* _WIN32 */
diff --git a/libgui/src/tclshellexe.c b/libgui/src/tclshellexe.c
new file mode 100644
index 00000000000..b7cc9b1c07a
--- /dev/null
+++ b/libgui/src/tclshellexe.c
@@ -0,0 +1,76 @@
+/* tclshellexe.c - Interface to Windows ShellExecute function.
+ Copyright (C) 1997 Cygnus Solutions.
+ Written by Tom Tromey <tromey@cygnus.com>;
+ Code mostly taken from S-N. */
+
+#ifdef _WIN32
+
+#include <string.h>
+
+#include <windows.h>
+
+#include <tcl.h>
+#include <tk.h>
+
+#include "guitcl.h"
+
+static int
+shell_execute_command (ClientData clientData, Tcl_Interp *interp,
+ int argc, char *argv[])
+{
+ char *operation;
+ char *file;
+ char *param;
+ char *dir;
+ int ret;
+
+ if (argc < 3 || argc > 5)
+ {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " operation file ?parameters? ?directory?\"", NULL);
+
+ return TCL_ERROR;
+ }
+ operation = argv[1]; /* Mandatory */
+ if (!*operation)
+ operation = NULL;
+
+ file = argv[2]; /* Mandatory */
+
+ if (argc > 3)
+ {
+ param = argv[3];
+ if (!*param)
+ param = NULL;
+ }
+ else
+ param = NULL;
+
+ if (argc > 4)
+ {
+ dir = argv[4];
+ if (!*dir)
+ dir = NULL;
+ }
+ else
+ dir = NULL;
+
+ ret = (int)ShellExecute(NULL, operation, file, param, dir, SW_SHOWNORMAL);
+ if (ret <= 32)
+ {
+ Tcl_AppendResult(interp, strerror(ret), NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+int
+ide_create_shell_execute_command (Tcl_Interp *interp)
+{
+ if (Tcl_CreateCommand (interp, "ide_shell_execute", shell_execute_command,
+ NULL, NULL) == NULL)
+ return TCL_ERROR;
+ return TCL_OK;
+}
+
+#endif /* _WIN32 */
diff --git a/libgui/src/tclsizebox.c b/libgui/src/tclsizebox.c
new file mode 100644
index 00000000000..9a8d30559bf
--- /dev/null
+++ b/libgui/src/tclsizebox.c
@@ -0,0 +1,236 @@
+/* tclsizebox.c -- Tcl code to create a sizebox on Windows.
+ Copyright (C) 1997, 1998 Cygnus Solutions.
+ Written by Ian Lance Taylor <ian@cygnus.com>. */
+
+#ifdef _WIN32
+
+#include <windows.h>
+
+#include <tcl.h>
+#include <tk.h>
+
+#include "guitcl.h"
+
+/* We need to make some Tk internal calls. The only alternative is to
+ actually move this code into Tk. */
+
+#include <tkWinInt.h>
+
+/* These should really be defined in the cygwin32 header files. */
+
+#ifndef GetStockPen
+#define GetStockPen(p) ((HPEN) GetStockObject (p))
+#define GetStockBrush(b) ((HBRUSH) GetStockObject (b))
+#define SelectPen(dc, p) (SelectObject (dc, (HGDIOBJ) p))
+#define SelectBrush(dc, b) (SelectObject (dc, (HGDIOBJ) b))
+#define DeleteBrush(b) (DeleteObject ((HGDIOBJ) b))
+#endif
+
+/* This file defines the Tcl command sizebox.
+
+ sizebox PATHNAME [OPTIONS]
+
+ Creates a sizebox named PATHNAME. This accepts the standard window
+ options. This should be attached to the lower right corner of a
+ window in order to work as expected. */
+
+/* We use
+
+/* We use an instance of the structure as the Windows user data for
+ the window. */
+
+struct sizebox_userdata
+{
+ /* The real window procedure. */
+ WNDPROC wndproc;
+ /* The Tk window. */
+ Tk_Window tkwin;
+};
+
+/* The window procedure we use for a sizebox. The default sizebox
+ handling doesn't seem to erase the background if the sizebox is not
+ exactly the correct size, so we handle that here. */
+
+static LRESULT CALLBACK
+sizebox_wndproc (HWND hwnd, UINT msg, WPARAM wparam, LPARAM lparam)
+{
+ struct sizebox_userdata *su;
+
+ su = (struct sizebox_userdata *) GetWindowLong (hwnd, GWL_USERDATA);
+
+ switch (msg)
+ {
+ case WM_ERASEBKGND:
+ /* The default sizebox handling doesn't seem to erase the
+ background if the sizebox is not exactly the correct size, so
+ we handle that here. */
+ if (Tk_Height (su->tkwin) != GetSystemMetrics (SM_CYHSCROLL)
+ || Tk_Width (su->tkwin) != GetSystemMetrics (SM_CXVSCROLL))
+ {
+ HDC hdc = (HDC) wparam;
+ RECT r;
+ HPEN hpen;
+ HBRUSH hbrush;
+
+ GetClientRect (hwnd, &r);
+ hpen = SelectPen (hdc, GetStockPen (NULL_PEN));
+ hbrush = SelectBrush (hdc, GetSysColorBrush (COLOR_3DFACE));
+ Rectangle (hdc, r.left, r.top, r.right + 1, r.bottom + 1);
+ hbrush = SelectBrush (hdc, hbrush);
+ DeleteBrush (hbrush);
+ SelectPen (hdc, hpen);
+ return 1;
+ }
+ break;
+
+ /* We need to handle cursor handling here. We also use Tk
+ cursor handling via a call to Tk_DefineCursor, but we can't
+ rely on it, because it will only take effect if Tk sees a
+ MOUSEMOVE event which won't happen if the mouse moves
+ directly from outside any Tk window to the sizebox. */
+ case WM_SETCURSOR:
+ SetCursor (LoadCursor (NULL, IDC_SIZENWSE));
+ return 1;
+ }
+
+ return CallWindowProc (su->wndproc, hwnd, msg, wparam, lparam);
+}
+
+/* This is called by the Tk dispatcher for various events. */
+
+static void
+sizebox_event_proc (ClientData cd, XEvent *event_ptr)
+{
+ HWND hwnd = (HWND) cd;
+ struct sizebox_userdata *su;
+
+ if (! hwnd)
+ return;
+
+ if (event_ptr->type == DestroyNotify)
+ {
+ su = (struct sizebox_userdata *) GetWindowLong (hwnd, GWL_USERDATA);
+ SetWindowLong (hwnd, GWL_USERDATA, 0);
+ SetWindowLong (hwnd, GWL_WNDPROC, (LONG) su->wndproc);
+ Tcl_Free ((char *) su);
+ DestroyWindow (hwnd);
+ }
+}
+
+/* Create a sizebox window. */
+
+static Window
+sizebox_create (Tk_Window tkwin, Window parent, ClientData cd)
+{
+ POINT pt;
+ Tk_Window parwin;
+ HWND parhwnd;
+ HWND hwnd;
+ struct sizebox_userdata *su;
+ Window result;
+
+ /* We need to tell Windows that the parent of the sizebox is the
+ toplevel which holds it. Otherwise the sizebox will try to
+ resize the child window, which doesn't make much sense. */
+
+ pt.x = Tk_X (tkwin);
+ pt.y = Tk_Y (tkwin);
+ ClientToScreen (TkWinGetHWND (parent), &pt);
+
+ parwin = (Tk_Window) TkWinGetWinPtr (parent);
+ while (! Tk_IsTopLevel (parwin))
+ parwin = Tk_Parent (parwin);
+ parhwnd = TkWinGetWrapperWindow (parwin);
+
+ ScreenToClient (parhwnd, &pt);
+
+ hwnd = CreateWindow ("SCROLLBAR", NULL,
+ WS_CHILD | WS_VISIBLE | SBS_SIZEGRIP,
+ pt.x, pt.y, Tk_Width (tkwin), Tk_Height (tkwin),
+ parhwnd, NULL, Tk_GetHINSTANCE (), NULL);
+
+ su = (struct sizebox_userdata *) Tcl_Alloc (sizeof *su);
+ su->tkwin = tkwin;
+ su->wndproc = (WNDPROC) GetWindowLong (hwnd, GWL_WNDPROC);
+ SetWindowLong (hwnd, GWL_USERDATA, (LONG) su);
+ SetWindowLong (hwnd, GWL_WNDPROC, (LONG) sizebox_wndproc);
+
+ SetWindowPos(hwnd, HWND_TOP, 0, 0, 0, 0,
+ SWP_NOACTIVATE | SWP_NOMOVE | SWP_NOSIZE);
+
+ result = Tk_AttachHWND (tkwin, hwnd);
+
+ Tk_CreateEventHandler (tkwin, StructureNotifyMask, sizebox_event_proc,
+ hwnd);
+
+ return result;
+}
+
+/* The class procedure table for a sizebox widget. This is an
+ internal Tk structure. */
+
+static TkClassProcs sizebox_procs =
+{
+ sizebox_create, /* createProc */
+ NULL, /* geometryProc */
+ NULL /* modalProc */
+};
+
+/* The implementation of the sizebox command. */
+
+static int
+sizebox_command (ClientData cd, Tcl_Interp *interp, int argc, char **argv)
+{
+ Tk_Window tkmain;
+ Tk_Window new;
+ Tk_Cursor cursor;
+
+ if (argc < 2)
+ {
+ Tcl_ResetResult (interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult (interp),
+ "wrong # args: should be \"",
+ argv[0], " pathname ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ tkmain = Tk_MainWindow (interp);
+ if (tkmain == NULL)
+ return TCL_ERROR;
+
+ new = Tk_CreateWindowFromPath (interp, tkmain, argv[1], (char *) NULL);
+ if (new == NULL)
+ return TCL_ERROR;
+
+ Tk_SetClass (new, "Sizebox");
+
+ /* This is a Tk internal function. */
+ TkSetClassProcs (new, &sizebox_procs, NULL);
+
+ /* FIXME: We should handle options here, but we currently don't have
+ any. */
+
+ Tk_GeometryRequest (new, GetSystemMetrics (SM_CXVSCROLL),
+ GetSystemMetrics (SM_CYHSCROLL));
+
+ cursor = Tk_GetCursor (interp, new, Tk_GetUid ("size_nw_se"));
+ if (cursor == None)
+ return TCL_ERROR;
+ Tk_DefineCursor (new, cursor);
+
+ Tcl_SetResult (interp, Tk_PathName (new), TCL_STATIC);
+ return TCL_OK;
+}
+
+/* Create the sizebox command. */
+
+int
+ide_create_sizebox_command (Tcl_Interp *interp)
+{
+ if (Tcl_CreateCommand (interp, "ide_sizebox", sizebox_command, NULL,
+ NULL) == NULL)
+ return TCL_ERROR;
+ return TCL_OK;
+}
+
+#endif /* _WIN32 */
diff --git a/libgui/src/tclwinfont.c b/libgui/src/tclwinfont.c
new file mode 100644
index 00000000000..20ccbca8af6
--- /dev/null
+++ b/libgui/src/tclwinfont.c
@@ -0,0 +1,331 @@
+/* tclwinfont.c -- Tcl routine to let the user choose a font on Windows.
+ Copyright (C) 1997 Cygnus Solutions.
+ Written by Ian Lance Taylor <ian@cygnus.com>.
+
+ This file provides a Tcl command which may be used to let the user
+ select a font on Windows. */
+
+#ifdef _WIN32
+
+#include <windows.h>
+
+#include <tcl.h>
+#include <tk.h>
+
+#include "guitcl.h"
+
+/* FIXME: We need to dig into the Tk window implementation internals
+ to convert a Tk Windows to an HWND. */
+
+#include <tkWinInt.h>
+
+/* FIXME: We grovel around in the Tk internal font structures. */
+
+#include <tkInt.h>
+#include <tkFont.h>
+
+/* This file defines a single Tcl command.
+
+ ide_win_choose_font OPTIONS
+ Choose a font on Windows. This opens a modal dialog box to
+ permit the user to choose a font. This returns a string naming
+ the new font, or the empty string if the user did not choose a
+ font.
+
+ Supported options:
+ -default FONT
+ FONT is the name of a font to use to initialize the
+ default choice in the dialog box.
+ -parent WINDOW
+ Set the parent window of the dialog box. The dialog
+ box is modal with respect to this window. The default
+ is the main window.
+
+ FIXME: The current implementation only supports choosing a screen
+ font. To permit choosing printer fonts, we would need to have a
+ device context for the printer.
+
+ */
+
+/* Implement the ide_win_choose_font procedure. */
+
+static int
+win_choose_font (ClientData cd, Tcl_Interp *interp, int argc, char **argv)
+{
+ char *deffont;
+ Tk_Window parent;
+ int i, oldMode;
+ CHOOSEFONT cf;
+ LOGFONT lf;
+ HDC hdc;
+ HFONT hfont;
+ char facebuf[LF_FACESIZE];
+ TEXTMETRIC tm;
+ int pointsize;
+ char *s;
+ Tcl_DString resultStr; /* used to translate result in UTF8 in Tcl/Tk8.1 */
+ deffont = NULL;
+ parent = Tk_MainWindow (interp);
+
+ for (i = 1; i < argc; i += 2)
+ {
+ if (i + 1 >= argc)
+ {
+ Tcl_ResetResult (interp);
+ Tcl_AppendStringsToObj (Tcl_GetObjResult (interp),
+ "value for \"", argv[i], "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (strcmp (argv[i], "-default") == 0)
+ deffont = argv[i + 1];
+ else if (strcmp (argv[i], "-parent") == 0)
+ {
+ parent = Tk_NameToWindow (interp, argv[i + 1],
+ Tk_MainWindow (interp));
+ if (parent == NULL)
+ return TCL_ERROR;
+ }
+ else
+ {
+ Tcl_ResetResult (interp);
+ Tcl_AppendStringsToObj (Tcl_GetObjResult (interp),
+ "unknown option \"", argv[i], "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ memset (&cf, 0, sizeof (CHOOSEFONT));
+ cf.lStructSize = sizeof (CHOOSEFONT);
+
+ if (Tk_WindowId (parent) == None)
+ Tk_MakeWindowExist (parent);
+ cf.hwndOwner = Tk_GetHWND (Tk_WindowId (parent));
+
+ cf.lpLogFont = &lf;
+ cf.Flags = CF_SCREENFONTS | CF_FORCEFONTEXIST;
+
+ memset (&lf, 0, sizeof (LOGFONT));
+
+ if (deffont != NULL)
+ {
+ Tk_Font tkfont;
+ const TkFontAttributes *fa;
+
+ tkfont = Tk_GetFont (interp, parent, deffont);
+ if (tkfont == NULL)
+ return TCL_ERROR;
+
+ cf.Flags |= CF_INITTOLOGFONTSTRUCT;
+
+ /* In order to initialize LOGFONT, we need to extract the real
+ font attributes from the Tk internal font information. */
+ fa = &((TkFont *) tkfont)->fa;
+
+ /* This code is taken from TkpGetFontFromAttributes. It
+ converts a TkFontAttributes structure into a LOGFONT
+ structure. */
+#if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)
+ lf.lfHeight = - fa->size;
+#else
+ lf.lfHeight = - fa->pointsize;
+#endif
+ if (lf.lfHeight < 0)
+ lf.lfHeight = MulDiv (lf.lfHeight,
+ 254 * WidthOfScreen (Tk_Screen (parent)),
+ 720 * WidthMMOfScreen (Tk_Screen (parent)));
+ lf.lfWeight = fa->weight == TK_FW_NORMAL ? FW_NORMAL : FW_BOLD;
+ lf.lfItalic = fa->slant;
+ lf.lfUnderline = fa->underline;
+ lf.lfStrikeOut = fa->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 (fa->family == NULL)
+ lf.lfFaceName[0] = '\0';
+ else
+ strncpy (lf.lfFaceName, fa->family, sizeof (lf.lfFaceName));
+
+ Tk_FreeFont (tkfont);
+ }
+
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ if (! ChooseFont (&cf))
+ {
+ DWORD code;
+
+ code = CommDlgExtendedError ();
+ if (code == 0)
+ {
+ /* The user pressed cancel. */
+ Tcl_ResetResult (interp);
+ return TCL_OK;
+ }
+ else
+ {
+ char buf[200];
+
+ sprintf (buf, "Windows common dialog error 0x%lx", (unsigned long) code);
+ Tcl_ResetResult (interp);
+ #if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)
+ Tcl_ExternalToUtfDString(NULL, buf, -1, &resultStr);
+ #else
+ Tcl_InitDString(&resultStr);
+ Tcl_DStingAppend(&resultStr, buf, -1);
+ #endif
+ Tcl_AppendStringsToObj (Tcl_GetObjResult (interp),
+ Tcl_DStringValue(&resultStr),
+ (char *) NULL);
+ Tcl_DStringFree(&resultStr);
+ return TCL_ERROR;
+ }
+ }
+ Tcl_SetServiceMode(oldMode);
+ /* We now have a LOGFONT structure. We store it into a device
+ context, and then extract enough information to build a Tk font
+ specification. With luck, when Tk interprets the font
+ specification it will wind up with the font that the user expects
+ to see. Some of this code is taken from AllocFont. */
+
+ hfont = CreateFontIndirect (&lf);
+ if (hfont == NULL)
+ {
+ /* This should be impossible. */
+ #if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)
+ Tcl_ExternalToUtfDString(NULL, "CreateFontIndirect failed on chosen font", -1, &resultStr);
+ #else
+ Tcl_InitDString(&resultStr);
+ Tcl_DStingAppend(&resultStr, "CreateFontIndirect failed on chosen font", -1);
+ #endif
+ Tcl_SetResult (interp, Tcl_DStringValue(&resultStr), TCL_STATIC);
+ Tcl_DStringFree(&resultStr);
+ return TCL_ERROR;
+ }
+
+ hdc = GetDC (cf.hwndOwner);
+ hfont = SelectObject (hdc, hfont);
+ GetTextFace (hdc, sizeof (facebuf), facebuf);
+ GetTextMetrics (hdc, &tm);
+
+ Tcl_ResetResult (interp);
+
+#if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)
+ Tcl_ExternalToUtfDString(NULL, facebuf, -1, &resultStr);
+#else
+ Tcl_InitDString(&resultStr);
+ Tcl_DStingAppend(&resultStr,facebuf,-1);
+#endif
+
+ if (Tcl_ListObjAppendElement (interp, Tcl_GetObjResult (interp),
+ Tcl_NewStringObj (Tcl_DStringValue(&resultStr), -1)) != TCL_OK) {
+ Tcl_DStringFree(&resultStr);
+ return TCL_ERROR;
+ }
+
+ Tcl_DStringFree(&resultStr);
+
+ pointsize = MulDiv (tm.tmHeight - tm.tmInternalLeading,
+ 720 * WidthMMOfScreen (Tk_Screen (parent)),
+ 254 * WidthOfScreen (Tk_Screen (parent)));
+
+ if (Tcl_ListObjAppendElement (interp, Tcl_GetObjResult (interp),
+ Tcl_NewIntObj (pointsize)) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (tm.tmWeight > FW_MEDIUM)
+ s = "bold";
+ else
+ s = "normal";
+
+#if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)
+ Tcl_ExternalToUtfDString(NULL, s, -1, &resultStr);
+#else
+ Tcl_InitDString(&resultStr);
+ Tcl_DStingAppend(&resultStr, s, -1);
+#endif
+
+ if (Tcl_ListObjAppendElement (interp, Tcl_GetObjResult (interp),
+ Tcl_NewStringObj (Tcl_DStringValue(&resultStr), -1)) != TCL_OK) {
+ Tcl_DStringFree(&resultStr);
+ return TCL_ERROR;
+ }
+
+ Tcl_DStringFree(&resultStr);
+
+ if (tm.tmItalic)
+ s = "italic";
+ else
+ s = "roman";
+
+#if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)
+ Tcl_ExternalToUtfDString(NULL, s, -1, &resultStr);
+#else
+ Tcl_InitDString(&resultStr);
+ Tcl_DStingAppend(&resultStr, s, -1);
+#endif
+
+ if (Tcl_ListObjAppendElement (interp, Tcl_GetObjResult (interp),
+ Tcl_NewStringObj (Tcl_DStringValue(&resultStr), -1)) != TCL_OK) {
+ Tcl_DStringFree(&resultStr);
+ return TCL_ERROR;
+ }
+ Tcl_DStringFree(&resultStr);
+
+ if (tm.tmUnderlined)
+ {
+ #if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)
+ Tcl_ExternalToUtfDString(NULL, "underline", -1, &resultStr);
+ #else
+ Tcl_InitDString(&resultStr);
+ Tcl_DStingAppend(&resultStr,"underline",-1);
+ #endif
+ if (Tcl_ListObjAppendElement (interp, Tcl_GetObjResult (interp),
+ Tcl_NewStringObj (Tcl_DStringValue(&resultStr), -1))
+ != TCL_OK) {
+ Tcl_DStringFree(&resultStr);
+ return TCL_ERROR;
+ }
+ Tcl_DStringFree(&resultStr);
+ }
+
+ if (tm.tmStruckOut)
+ {
+ #if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)
+ Tcl_ExternalToUtfDString(NULL, "overstrike", -1, &resultStr);
+ #else
+ Tcl_InitDString(&resultStr);
+ Tcl_DStingAppend(&resultStr, "overstrike", -1);
+ #endif
+ if (Tcl_ListObjAppendElement (interp, Tcl_GetObjResult (interp),
+ Tcl_NewStringObj (Tcl_DStringValue(&resultStr), -1))
+ != TCL_OK) {
+ Tcl_DStringFree(&resultStr);
+ return TCL_ERROR;
+ }
+ Tcl_DStringFree(&resultStr);
+ }
+
+ hfont = SelectObject (hdc, hfont);
+ ReleaseDC (cf.hwndOwner, hdc);
+ DeleteObject (hfont);
+
+ return TCL_OK;
+}
+
+/* Create the Tcl command. */
+
+int
+ide_create_win_choose_font_command (Tcl_Interp *interp)
+{
+ if (Tcl_CreateCommand (interp, "ide_win_choose_font", win_choose_font,
+ NULL, NULL) == NULL)
+ return TCL_ERROR;
+ return TCL_OK;
+}
+
+#endif /* _WIN32 */
diff --git a/libgui/src/tclwingrab.c b/libgui/src/tclwingrab.c
new file mode 100644
index 00000000000..fde95cb1e04
--- /dev/null
+++ b/libgui/src/tclwingrab.c
@@ -0,0 +1,64 @@
+/* tclwingrab.c -- Tcl routines to enable and disable windows on Windows.
+ Copyright (C) 1997 Cygnus Solutions.
+ Written by Ian Lance Taylor <ian@cygnus.com>.
+
+ This file contains routines to enable and disable windows on
+ Windows. This is used to support grabs on Windows in Tk 8.0.
+
+ The routines in this file are expected to be invoked from
+ ide_grab_support, which is defined in libide/library/wingrab.tcl.
+ They are not expected to be invoked directly, so they are not
+ really documented. */
+
+#ifdef _WIN32
+
+#include <windows.h>
+
+#include <tcl.h>
+#include <tk.h>
+
+#include "guitcl.h"
+
+/* FIXME: We need to dig into the Tk window implementation internals
+ to convert a Tk window to an HWND. */
+
+#include <tkWinInt.h>
+
+/* Enable or disable a window. If the clientdata argument is NULL, we
+ disable the window. Otherwise we enable the window. This is just
+ a quick hack; if we ever need to do something else, we can use a
+ more serious method to distinguish the commands. */
+
+static int
+wingrab_command (ClientData cd, Tcl_Interp *interp, int objc,
+ Tcl_Obj *const *objv)
+{
+ long l;
+ HWND hwnd;
+
+ /* Note that here we understand the return value of wm frame. */
+
+ if (Tcl_GetLongFromObj (interp, objv[1], &l) != TCL_OK)
+ return TCL_ERROR;
+
+ hwnd = (HWND) l;
+ EnableWindow (hwnd, cd != NULL);
+
+ return TCL_OK;
+}
+
+/* Create the ide_grab_support_disable and ide_grab_support_enable
+ commands. */
+
+int
+ide_create_win_grab_command (Tcl_Interp *interp)
+{
+ if (Tcl_CreateObjCommand (interp, "ide_grab_support_disable",
+ wingrab_command, NULL, NULL) == NULL
+ || Tcl_CreateObjCommand (interp, "ide_grab_support_enable",
+ wingrab_command, (ClientData) 1, NULL) == NULL)
+ return TCL_ERROR;
+ return TCL_OK;
+}
+
+#endif /* _WIN32 */
diff --git a/libgui/src/tclwinmode.c b/libgui/src/tclwinmode.c
new file mode 100644
index 00000000000..958d5c9c607
--- /dev/null
+++ b/libgui/src/tclwinmode.c
@@ -0,0 +1,89 @@
+/* tclwinmode.c - Tcl access to SetErrorMode function.
+ Copyright (C) 1998 Cygnus Solutions.
+ Written by Tom Tromey <tromey@cygnus.com>. */
+
+#include <tcl.h>
+#include "guitcl.h"
+
+#ifdef __CYGWIN32__
+
+#include <windows.h>
+
+struct pair
+{
+ const char *name;
+ UINT value;
+};
+
+static struct pair values[] =
+{
+ { "failcriticalerrors", SEM_FAILCRITICALERRORS },
+ { "noalignmentfaultexcept", SEM_NOALIGNMENTFAULTEXCEPT },
+ { "nogpfaulterrorbox", SEM_NOGPFAULTERRORBOX },
+ { "noopenfileerrorbox", SEM_NOOPENFILEERRORBOX },
+ { NULL, 0 }
+};
+
+#endif
+
+static int
+seterrormode_command (ClientData cd, Tcl_Interp *interp,
+ int argc, char *argv[])
+{
+#ifdef __CYGWIN32__
+ int len, i;
+ char **list;
+ UINT val = 0;
+
+ if (argc != 2)
+ {
+ Tcl_AppendResult (interp, "wrong # args: should be \"",
+ argv[0], " modelist\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_SplitList (interp, argv[1], &len, &list) != TCL_OK)
+ return TCL_ERROR;
+
+ for (i = 0; i < len; ++i)
+ {
+ int j, found = 0;
+ for (j = 0; values[j].name; ++j)
+ {
+ if (! strcmp (values[j].name, list[i]))
+ {
+ found = 1;
+ val |= values[j].value;
+ break;
+ }
+ }
+ if (! found)
+ {
+ Tcl_AppendResult (interp, "unrecognized key \"", list[i],
+ "\"", (char *) NULL);
+ Tcl_Free ((char *) list);
+ return TCL_ERROR;
+ }
+ }
+ Tcl_Free ((char *) list);
+
+ val = SetErrorMode (val);
+
+ for (i = 0; values[i].name; ++i)
+ {
+ if (val & values[i].value)
+ Tcl_AppendElement (interp, values[i].name);
+ }
+#endif /* __CYGWIN32__ */
+
+ return TCL_OK;
+}
+
+int
+ide_create_set_error_mode_command (Tcl_Interp *interp)
+{
+ if (Tcl_CreateCommand (interp, "ide_set_error_mode",
+ seterrormode_command, NULL, NULL) == NULL)
+ return TCL_ERROR;
+ return TCL_OK;
+}
diff --git a/libgui/src/tclwinpath.c b/libgui/src/tclwinpath.c
new file mode 100644
index 00000000000..2f9d5bdb612
--- /dev/null
+++ b/libgui/src/tclwinpath.c
@@ -0,0 +1,181 @@
+/* tclwinpath.c -- Tcl routines to convert paths under cygwin32.
+ Copyright (C) 1997 Cygnus Solutions.
+ Written by Ian Lance Taylor <ian@cygnus.com>.
+
+ This file contains Tcl interface routines to do path translation
+ when using cygwin32. */
+
+#ifdef __CYGWIN32__
+
+#include <windows.h>
+
+#include <tcl.h>
+
+#include "guitcl.h"
+#include "subcommand.h"
+
+/* The path conversion routines are not declared anywhere that I know
+ of. */
+
+extern void cygwin32_conv_to_win32_path (const char *, char *);
+extern void cygwin32_conv_to_full_win32_path (const char *, char *);
+extern void cygwin32_conv_to_posix_path (const char *, char *);
+extern void cygwin32_conv_to_full_posix_path (const char *, char *);
+extern int cygwin32_posix_path_list_p (const char *);
+extern int cygwin32_win32_to_posix_path_list_buf_size (const char *);
+extern int cygwin32_posix_to_win32_path_list_buf_size (const char *);
+extern void cygwin32_win32_to_posix_path_list (char *, char *);
+extern void cygwin32_posix_to_win32_path_list (char *, char *);
+extern void cygwin32_split_path (const char *, char *, char *);
+
+/* This file declares a Tcl command with subcommands.
+
+ Each of the following subcommands returns a string based on the
+ PATH argument. If PATH is already in the desired form, these
+ commands just return it unchanged.
+
+ ide_cygwin_path to_win32 PATH
+ Return PATH converted to a win32 pathname.
+
+ ide_cygwin_path to_full_win32 PATH
+ Return PATH converted to an absolute win32 pathname.
+
+ ide_cygwin_path to_posix PATH
+ Return PATH converted to a POSIX pathname.
+
+ ide_cygwin_path to_full_posix PATH
+ Return PATH converted to an absolute POSIX pathname.
+
+ The following subcommand returns a boolean value.
+
+ ide_cygwin_path posix_path_list_p PATHLIST
+ Return whether PATHLIST is a POSIX style path list.
+
+ The following subcommands return strings.
+
+ ide_cygwin_path posix_to_win32_path_list PATHLIST
+ Return PATHLIST converted from POSIX style to win32 style.
+
+ ide_cygwin_path win32_to_posix_path_list PATHLIST
+ Return PATHLIST converted from win32 style to POSIX style.
+
+ */
+
+/* Handle ide_cygwin_path to_win32. */
+
+static int
+path_to_win32 (ClientData cd, Tcl_Interp *interp, int argc, char **argv)
+{
+ char buf[MAX_PATH];
+
+ cygwin32_conv_to_win32_path (argv[2], buf);
+ Tcl_SetResult (interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+}
+
+/* Handle ide_cygwin_path to_full_win32. */
+
+static int
+path_to_full_win32 (ClientData cd, Tcl_Interp *interp, int argc, char **argv)
+{
+ char buf[MAX_PATH];
+
+ cygwin32_conv_to_full_win32_path (argv[2], buf);
+ Tcl_SetResult (interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+}
+
+/* Handle ide_cygwin_path to_posix. */
+
+static int
+path_to_posix (ClientData cd, Tcl_Interp *interp, int argc, char **argv)
+{
+ char buf[MAX_PATH];
+
+ cygwin32_conv_to_posix_path (argv[2], buf);
+ Tcl_SetResult (interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+}
+
+/* Handle ide_cygwin_path to_full_posix. */
+
+static int
+path_to_full_posix (ClientData cd, Tcl_Interp *interp, int argc, char **argv)
+{
+ char buf[MAX_PATH];
+
+ cygwin32_conv_to_full_posix_path (argv[2], buf);
+ Tcl_SetResult (interp, buf, TCL_VOLATILE);
+ return TCL_OK;
+}
+
+/* Handle ide_cygwin_path posix_path_list_p. */
+
+static int
+path_posix_path_list_p (ClientData cd, Tcl_Interp *interp, int argc,
+ char **argv)
+{
+ int ret;
+
+ ret = cygwin32_posix_path_list_p (argv[2]);
+ Tcl_ResetResult (interp);
+ Tcl_SetBooleanObj (Tcl_GetObjResult (interp), ret);
+ return TCL_OK;
+}
+
+/* Handle ide_cygwin_path posix_to_win32_path_list. */
+
+static int
+path_posix_to_win32_path_list (ClientData cd, Tcl_Interp *interp, int argc,
+ char **argv)
+{
+ int size;
+ char *buf;
+
+ size = cygwin32_posix_to_win32_path_list_buf_size (argv[2]);
+ buf = Tcl_Alloc (size);
+ cygwin32_posix_to_win32_path_list (argv[2], buf);
+ Tcl_SetResult (interp, buf, TCL_DYNAMIC);
+ return TCL_OK;
+}
+
+/* Handle ide_cygwin_path win32_to_posix_path_list. */
+
+static int
+path_win32_to_posix_path_list (ClientData cd, Tcl_Interp *interp, int argc,
+ char **argv)
+{
+ int size;
+ char *buf;
+
+ size = cygwin32_win32_to_posix_path_list_buf_size (argv[2]);
+ buf = Tcl_Alloc (size);
+ cygwin32_win32_to_posix_path_list (argv[2], buf);
+ Tcl_SetResult (interp, buf, TCL_DYNAMIC);
+ return TCL_OK;
+}
+
+/* The subcommand table. */
+
+static const struct ide_subcommand_table path_commands[] =
+{
+ { "to_win32", path_to_win32, 3, 3 },
+ { "to_full_win32", path_to_full_win32, 3, 3 },
+ { "to_posix", path_to_posix, 3, 3 },
+ { "to_full_posix", path_to_full_posix, 3, 3 },
+ { "posix_path_list_p", path_posix_path_list_p, 3, 3 },
+ { "posix_to_win32_path_list", path_posix_to_win32_path_list, 3, 3 },
+ { "win32_to_posix_path_list", path_win32_to_posix_path_list, 3, 3 },
+ { NULL, NULL, 0, 0}
+};
+
+/* Create the ide_cygwin_path command. */
+
+int
+ide_create_cygwin_path_command (Tcl_Interp *interp)
+{
+ return ide_create_command_with_subcommands (interp, "ide_cygwin_path",
+ path_commands, NULL, NULL);
+}
+
+#endif /* __CYGWIN32__ */
diff --git a/libgui/src/tclwinprint.c b/libgui/src/tclwinprint.c
new file mode 100644
index 00000000000..221cc14bf77
--- /dev/null
+++ b/libgui/src/tclwinprint.c
@@ -0,0 +1,935 @@
+/* tclwinprint.c -- Tcl routines for printing on Windows.
+ Copyright (C) 1997 Cygnus Solutions.
+ Written by Ian Lance Taylor <ian@cygnus.com>.
+
+ This file contains routines to support printing on Windows from
+ Tcl. */
+
+#ifdef _WIN32
+
+#include <windows.h>
+
+#include <tcl.h>
+#include <tk.h>
+
+#include "subcommand.h"
+#include "guitcl.h"
+
+#include <wingdi.h>
+
+#undef PRINT_BUFSIZE
+#define PRINT_BUFSIZE 10240
+
+/* FIXME: We need to dig into the Tk window implementation internals
+ to convert a Tk Window to an HWND. */
+
+#include <tkWinInt.h>
+
+/* This implementation is minimal. It's just enough to print a text
+ file. Additional features can be added as necessary.
+
+ One interesting idea that would fit into the Windows printing
+ scheme would be to have printing generate a limited canvas widget,
+ and permit Tk scripts to use canvas commands to draw items on the
+ page.
+
+ This file defines a Tcl command with subcommands.
+
+ ide_winprint page_setup OPTIONS
+ Invoke the Windows Page Setup dialog. This will record
+ information internally that will be used for later printing.
+
+ Supported options:
+ -parent WINDOW
+ Set the parent window of the dialog box. The dialog
+ box is modal with respect to this window. The default
+ is the main window.
+
+ ide_winprint print_text QUERYPROC TEXTPROC OPTIONS
+ Print text. This will start formatting the print job. The
+ user will still be able to interact with Tk. Typically, a
+ dialog box would be put up with a cancel button to permit the
+ user to cancel the print job by calling ide_winprint abort.
+
+ The QUERYPROC argument is a Tcl procedure which tells the print
+ job what to do next. This is invoked alternately with the text
+ procedure until the print job is finished. QUERYPROC is called
+ first. This should return one of the following strings:
+ continue
+ Just invoke the text procedure and continue
+ printing.
+ done
+ The print job is finished.
+ newpage
+ Skip to a new page and continue printing.
+
+ The TEXTPROC argument is a Tcl procedure which returns a single
+ line of text to print. This procedure will be invoked
+ alternately with the query procedure until the query procedure
+ indicates that the print job is complete. Page breaks are
+ handled automatically.
+
+ Supported options:
+ -dialog BOOLEAN
+ Whether to display the Windows Print dialog. The
+ default is true. If false, this will use the default
+ printer.
+ -parent WINDOW
+ Set the parent window of the dialog box. The dialog
+ box is modal with respect to this window. The default
+ is the main window.
+ -name STRING
+ Set the name of the document. The default name is the
+ empty string.
+ -pageproc PAGEPROC
+ PAGEPROC is executed at the start of each new page. It
+ will be called with one argument, which is the page
+ number. It will be called before either QUERYPROC or
+ TEXTPROC is called on this page. If QUERYPROC never
+ returns newpage, then PAGEPROC will always be invoked
+ after a call to TEXTPROC. PAGEPROC should return one
+ of the following strings:
+ continue
+ Keep going.
+ done
+ Stop printing.
+ -postscript
+ Use PostScript output.
+ -initproc INITPROC
+ INITPROC is called at the start of the print job.
+
+ ide_winprint abort
+ Abort a print job in process. If there is no current print
+ job, this does nothing.
+
+ */
+
+/* An instance of this structure is the client data for the
+ ide_winprint command. */
+
+struct winprint_data
+{
+ /* Information from the Page Setup dialog. */
+ PAGESETUPDLG *page_setup;
+ /* This is set non-zero if the print job is aborted. */
+ int aborted;
+};
+
+/* Delete the ide_winprint command. */
+
+static void
+winprint_command_deleted (ClientData cd)
+{
+ struct winprint_data *wd = (struct winprint_data *) cd;
+
+ if (wd->page_setup != NULL)
+ {
+ /* FIXME: I don't know if we are supposed to free the hDevMode
+ and hDevNames fields. */
+ Tcl_Free ((char *) wd->page_setup);
+ }
+
+ Tcl_Free ((char *) wd);
+}
+
+/* Implement ide_winprint page_setup. */
+
+static int
+winprint_page_setup_command (ClientData cd, Tcl_Interp *interp, int argc,
+ char **argv)
+{
+ struct winprint_data *wd = (struct winprint_data *) cd;
+ Tk_Window parent;
+ int i, mode, ret;
+ PAGESETUPDLG psd;
+
+ parent = Tk_MainWindow (interp);
+
+ for (i = 2; i < argc; i += 2)
+ {
+ if (i + 1 >= argc)
+ {
+ Tcl_ResetResult (interp);
+ Tcl_AppendStringsToObj (Tcl_GetObjResult (interp),
+ "value for \"", argv[i], "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (strcmp (argv[i], "-parent") == 0)
+ {
+ parent = Tk_NameToWindow (interp, argv[i + 1],
+ Tk_MainWindow (interp));
+ if (parent == NULL)
+ return TCL_ERROR;
+ }
+ else
+ {
+ Tcl_ResetResult (interp);
+ Tcl_AppendStringsToObj (Tcl_GetObjResult (interp),
+ "unknown option \"", argv[i], "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (wd->page_setup != NULL)
+ psd = *wd->page_setup;
+ else
+ {
+ memset (&psd, 0, sizeof (PAGESETUPDLG));
+ psd.lStructSize = sizeof (PAGESETUPDLG);
+ psd.Flags = PSD_DEFAULTMINMARGINS;
+ }
+
+ if (Tk_WindowId (parent) == None)
+ Tk_MakeWindowExist (parent);
+ psd.hwndOwner = Tk_GetHWND (Tk_WindowId (parent));
+
+ mode = Tcl_SetServiceMode (TCL_SERVICE_ALL);
+
+ ret = PageSetupDlg (&psd);
+
+ (void) Tcl_SetServiceMode (mode);
+
+ if (! ret)
+ {
+ DWORD code;
+
+ code = CommDlgExtendedError ();
+ if (code == 0)
+ {
+ /* The user pressed cancel. */
+ return TCL_OK;
+ }
+ else
+ {
+ char buf[20];
+
+ sprintf (buf, "0x%lx", (unsigned long) code);
+ Tcl_ResetResult (interp);
+ Tcl_AppendStringsToObj (Tcl_GetObjResult (interp),
+ "Windows common dialog error ", buf,
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (wd->page_setup == NULL)
+ wd->page_setup = (PAGESETUPDLG *) Tcl_Alloc (sizeof (PAGESETUPDLG));
+
+ *wd->page_setup = psd;
+
+ return TCL_OK;
+}
+
+/* The abort function needs a static variable (ewww). */
+
+static struct winprint_data *abort_wd;
+
+/* This is the abort function we pass to the Windows print routine. */
+
+static BOOL CALLBACK
+abort_function (HDC hdc, int code)
+{
+ while (Tcl_DoOneEvent (TCL_DONT_WAIT))
+ ;
+ return ! abort_wd->aborted;
+}
+
+/* Handle an error in a Windows system call. */
+
+static void
+windows_error (Tcl_Interp *interp, const char *fn)
+{
+ char buf[20];
+
+ sprintf (buf, "%lu", (unsigned long) GetLastError ());
+ Tcl_ResetResult (interp);
+ Tcl_AppendStringsToObj (Tcl_GetObjResult (interp),
+ "Windows error in ", fn, ": ", buf, (char *) NULL);
+}
+
+/* This structure holds the options for the ide_winprint print_text
+ command. */
+
+struct print_text_options
+{
+ /* Whether to use the print dialog. */
+ int dialog;
+ /* The parent window. */
+ char *parent;
+ /* The document name. */
+ char *name;
+ /* The page procedure. */
+ char *pageproc;
+ /* The init procedure. This is called once before printing. */
+ char *initproc;
+ /* Print using PostScript? */
+ int postscript;
+};
+
+/* Handle options for the ide_winprint print_text command. */
+
+static int
+winprint_print_text_options (struct winprint_data *wd, Tcl_Interp *interp,
+ int argc, char **argv,
+ struct print_text_options *pto)
+{
+ int i;
+
+ pto->dialog = 1;
+ pto->parent = NULL;
+ pto->name = "";
+ pto->pageproc = NULL;
+ pto->postscript = 0;
+ pto->initproc = NULL;
+
+ for (i = 4; i < argc; i += 2)
+ {
+ if (i + 1 >= argc)
+ {
+ Tcl_ResetResult (interp);
+ Tcl_AppendStringsToObj (Tcl_GetObjResult (interp),
+ "value for \"", argv[i], "\" missing",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (strcmp (argv[i], "-dialog") == 0)
+ {
+ if (Tcl_GetBoolean (interp, argv[i + 1], &pto->dialog) != TCL_OK)
+ return TCL_ERROR;
+ }
+ else if (strcmp (argv[i], "-parent") == 0)
+ pto->parent = argv[i + 1];
+ else if (strcmp (argv[i], "-name") == 0)
+ pto->name = argv[i + 1];
+ else if (strcmp (argv[i], "-pageproc") == 0)
+ pto->pageproc = argv[i + 1];
+ else if (strcmp (argv[i], "-initproc") == 0)
+ pto->initproc = argv[i + 1];
+ else if (strcmp (argv[i], "-postscript") == 0)
+ pto->postscript = 1;
+ else
+ {
+ Tcl_ResetResult (interp);
+ Tcl_AppendStringsToObj (Tcl_GetObjResult (interp),
+ "unknown option \"", argv[i], "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/* Invoke the print dialog for the ide_winprint print_text command.
+ We always call PrintDlg, even if the -dialog false option was used,
+ because it returns the device context we use for printing. */
+
+static int
+winprint_print_text_dialog (struct winprint_data *wd, Tcl_Interp *interp,
+ const struct print_text_options *pto,
+ PRINTDLG *pd, int *cancelled)
+{
+ int mode, ret;
+
+ *cancelled = 0;
+
+ memset (pd, 0, sizeof (PRINTDLG));
+ pd->lStructSize = sizeof (PRINTDLG);
+
+ if (! pto->dialog)
+ pd->Flags = PD_RETURNDEFAULT | PD_RETURNDC;
+ else
+ {
+ Tk_Window parent;
+
+ if (pto->parent == NULL)
+ parent = Tk_MainWindow (interp);
+ else
+ {
+ parent = Tk_NameToWindow (interp, pto->parent,
+ Tk_MainWindow (interp));
+ if (parent == NULL)
+ return TCL_ERROR;
+ }
+ if (Tk_WindowId (parent) == None)
+ Tk_MakeWindowExist (parent);
+ pd->hwndOwner = Tk_GetHWND (Tk_WindowId (parent));
+
+ if (wd->page_setup != NULL)
+ {
+ pd->hDevMode = wd->page_setup->hDevMode;
+ pd->hDevNames = wd->page_setup->hDevNames;
+ }
+
+ pd->Flags = PD_NOSELECTION | PD_RETURNDC | PD_USEDEVMODECOPIES;
+
+ pd->nCopies = 1;
+ pd->nFromPage = 1;
+ pd->nToPage = 1;
+ pd->nMinPage = 1;
+ pd->nMaxPage = 0xffff;
+ }
+
+ mode = Tcl_SetServiceMode (TCL_SERVICE_ALL);
+
+ ret = PrintDlg (pd);
+
+ (void) Tcl_SetServiceMode (mode);
+
+ if (! ret)
+ {
+ DWORD code;
+
+ code = CommDlgExtendedError ();
+
+ /* For some errors, the print dialog will already have reported
+ an error. We treat those as though the user pressed cancel.
+ Unfortunately, I do not know just which errors those are. */
+
+ if (code == 0 || code == PDERR_NODEFAULTPRN)
+ {
+ *cancelled = 1;
+ return TCL_OK;
+ }
+ else
+ {
+ char buf[20];
+
+ sprintf (buf, "0x%lx", (unsigned long) code);
+ Tcl_ResetResult (interp);
+ Tcl_AppendStringsToObj (Tcl_GetObjResult (interp),
+ "Windows common dialog error ", buf,
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/* Get the margins in device units. */
+
+static void
+winprint_get_margins (struct winprint_data *wd, const PRINTDLG *pd,
+ int *top_ptr, int *left_ptr, int *bottom_ptr)
+{
+ int topmargin, leftmargin, bottommargin;
+ int logx, logy;
+
+ if (wd->page_setup == NULL)
+ {
+ /* Use 1 inch margins. */
+ topmargin = 1000;
+ leftmargin = 1000;
+ bottommargin = 1000;
+ }
+ else
+ {
+ topmargin = wd->page_setup->rtMargin.top;
+ leftmargin = wd->page_setup->rtMargin.left;
+ bottommargin = wd->page_setup->rtMargin.bottom;
+ if ((wd->page_setup->Flags & PSD_INHUNDREDTHSOFMILLIMETERS) != 0)
+ {
+ topmargin = (topmargin * 1000) / 2540;
+ leftmargin = (leftmargin * 1000) / 2540;
+ bottommargin = (bottommargin * 1000) / 2540;
+ }
+ }
+
+ logx = GetDeviceCaps (pd->hDC, LOGPIXELSX);
+ logy = GetDeviceCaps (pd->hDC, LOGPIXELSY);
+
+ topmargin = (topmargin * logy) / 1000;
+ leftmargin = (leftmargin * logx) / 1000;
+ bottommargin = (bottommargin * logy) / 1000;
+
+ *top_ptr = topmargin;
+ *left_ptr = leftmargin;
+ *bottom_ptr = GetDeviceCaps (pd->hDC, VERTRES) - bottommargin;
+}
+
+/* Prepare to start printing. */
+
+static int
+winprint_start (struct winprint_data *wd, Tcl_Interp *interp, PRINTDLG *pd,
+ const struct print_text_options *pto, int *cancelled)
+{
+ DOCINFO di;
+
+ *cancelled = 0;
+
+ wd->aborted = 0;
+
+ /* We have no way to pass information to the abort function, so we
+ need to use a global variable. */
+ abort_wd = wd;
+ if (! SetAbortProc (pd->hDC, abort_function))
+ {
+ windows_error (interp, "SetAbortFunc");
+ return TCL_ERROR;
+ }
+
+ di.cbSize = sizeof (DOCINFO);
+ di.lpszDocName = pto->name;
+ di.lpszOutput = NULL;
+ di.lpszDatatype = NULL;
+ di.fwType = 0;
+
+ if (StartDoc (pd->hDC, &di) <= 0)
+ {
+ if (GetLastError () == ERROR_CANCELLED)
+ *cancelled = 1;
+ else
+ {
+ windows_error (interp, "StartDoc");
+ return TCL_ERROR;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/* Finish printing. */
+
+static int
+winprint_finish (struct winprint_data *wd, Tcl_Interp *interp,
+ PRINTDLG *pd, int error)
+{
+ int ret;
+
+ ret = TCL_OK;
+
+ if (error || wd->aborted)
+ AbortDoc (pd->hDC);
+ else
+ {
+ if (EndDoc (pd->hDC) <= 0)
+ {
+ windows_error (interp, "EndDoc");
+ ret = TCL_ERROR;
+ }
+ }
+
+ DeleteDC (pd->hDC);
+
+ return ret;
+}
+
+/* Values the ide_winprint print_text query or page procedure can
+ return. */
+
+enum winprint_query { Q_CONTINUE, Q_NEWPAGE, Q_DONE };
+
+/* Invoke the query or page procedure for ide_winprint print_text. */
+
+static int
+winprint_print_text_invoke (Tcl_Interp *interp, char *proc, const char *name,
+ enum winprint_query *result)
+{
+ char *q;
+
+ if (Tcl_Eval (interp, proc) == TCL_ERROR)
+ return TCL_ERROR;
+
+ q = Tcl_GetStringFromObj (Tcl_GetObjResult (interp), (int *) NULL);
+ if (strcmp (q, "continue") == 0)
+ *result = Q_CONTINUE;
+ else if (strcmp (q, "newpage") == 0)
+ *result = Q_NEWPAGE;
+ else if (strcmp (q, "done") == 0)
+ *result = Q_DONE;
+ else
+ {
+ Tcl_ResetResult (interp);
+ Tcl_AppendStringsToObj (Tcl_GetObjResult (interp),
+ "bad return from ", name, " procedure: \"",
+ q, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/* Implement ide_winprint print_text. */
+static int
+winprint_print_command (ClientData cd, Tcl_Interp *interp, int argc,
+ char **argv)
+{
+ struct winprint_data *wd = (struct winprint_data *) cd;
+ char *queryproc;
+ char *textproc;
+ struct print_text_options pto;
+ PRINTDLG pd;
+ int cancelled;
+ int top, bottom, left;
+ TEXTMETRIC tm;
+ POINT pt;
+ int lineheight;
+ int pageno;
+ int error=0, done, needquery;
+ struct {
+ short len; /* Defined to be 16 bits.... */
+ char buffer[PRINT_BUFSIZE+1];
+ } indata;
+
+ queryproc = argv[2];
+ textproc = argv[3];
+
+ if (winprint_print_text_options (wd, interp, argc, argv, &pto) != TCL_OK)
+ return TCL_ERROR;
+
+ if (winprint_print_text_dialog (wd, interp, &pto, &pd, &cancelled) != TCL_OK)
+ return TCL_ERROR;
+ if (cancelled)
+ return TCL_OK;
+
+ if (pto.postscript)
+ {
+ int eps_printing = 33;
+ int result;
+ short bresult = 1; /* EPS printing download suppressed */
+ result = Escape (pd.hDC, eps_printing, sizeof (BOOL), (LPCSTR)&bresult, NULL);
+ if ( result < 0 )
+ {
+ /* The EPSPRINTING escape failed! */
+ Tcl_AppendElement(interp,
+ "ide_winprint: EPSPRINTING escape implemented but failed");
+ DeleteDC (pd.hDC);
+ return TCL_ERROR;
+ }
+ }
+ else
+ {
+ winprint_get_margins(wd, &pd, &top, &left, &bottom);
+ }
+
+ if (winprint_start (wd, interp, &pd, &pto, &cancelled) != TCL_OK)
+ {
+ DeleteDC (pd.hDC);
+ return TCL_ERROR;
+ }
+ if (cancelled)
+ {
+ DeleteDC (pd.hDC);
+ return TCL_OK;
+ }
+
+ /* init and start init-procedure if available */
+ if (pto.initproc != NULL)
+ {
+ Tcl_DString initStr;
+ char buf[64];
+ Tcl_DStringInit (&initStr);
+ Tcl_DStringAppend (&initStr, pto.initproc, -1);
+
+ /* Here we must pass the customer selection from the PrintDialog
+ * as parameters for the init command, */
+ /* From page */
+ Tcl_DStringAppendElement (&initStr, "-frompage");
+ sprintf (buf, "%i", pd.nFromPage);
+ Tcl_DStringAppendElement (&initStr, buf);
+ /* To Page */
+ Tcl_DStringAppendElement (&initStr, "-topage");
+ sprintf (buf, "%i", pd.nToPage);
+ Tcl_DStringAppendElement (&initStr, buf);
+ /* # Copies */
+ Tcl_DStringAppendElement (&initStr, "-copies");
+ sprintf (buf, "%i", pd.nCopies);
+ Tcl_DStringAppendElement (&initStr, buf);
+ /* Print Selection? */
+ Tcl_DStringAppendElement (&initStr, "-selection");
+ Tcl_DStringAppendElement (&initStr, (pd.Flags&PD_SELECTION) ? "1" : "0");
+
+ /* Execute tcl/command */
+ if (Tcl_Eval (interp, Tcl_DStringValue(&initStr)) != TCL_OK)
+ {
+ Tcl_DStringFree (&initStr);
+ return TCL_ERROR;
+ }
+ Tcl_DStringFree (&initStr);
+ }
+
+ if (pto.postscript)
+ {
+ Tcl_DString pageStr;
+ int status, retval, len, i;
+ char *l, msgbuf[128];
+ enum winprint_query q = 0;
+
+ /* Note: NT 4.0 seems to leave the default CTM quite tiny! */
+ strcpy (indata.buffer, "\r\nsave\r\ninitmatrix\r\n");
+ indata.len = strlen(indata.buffer);
+ Escape(pd.hDC, PASSTHROUGH, 0, (LPCSTR)&indata, NULL);
+
+ /* Init command for page-procedure */
+ if (pto.pageproc != NULL)
+ {
+ Tcl_DStringInit (&pageStr);
+ Tcl_DStringAppend (&pageStr, pto.pageproc, -1);
+ Tcl_DStringAppendElement (&pageStr, "-1");
+ }
+
+ /* Start printing */
+ while (1)
+ {
+ /* Run page-procedure to update the display */
+ status = winprint_print_text_invoke (interp, Tcl_DStringValue(&pageStr), "page", &q);
+ if (status != TCL_OK || q == Q_DONE)
+ {
+ error = 1;
+ break;
+ }
+
+ /* query next characters to send to printer */
+ if (winprint_print_text_invoke (interp, queryproc, "query", &q) != TCL_OK)
+ {
+ error = 1;
+ break;
+ }
+ if (q != Q_CONTINUE)
+ {
+ done = 1;
+ break;
+ }
+ if (Tcl_Eval (interp, textproc) == TCL_ERROR)
+ {
+ error = 1;
+ break;
+ }
+ l = Tcl_GetStringFromObj (Tcl_GetObjResult (interp), &len);
+ for (i=0; i<len; i+=PRINT_BUFSIZE)
+ {
+ int lpos = min (PRINT_BUFSIZE, len-i);
+ strncpy (indata.buffer, l+i, lpos);
+ indata.buffer[lpos] = 0;
+ indata.len = lpos;
+
+ retval = Escape (pd.hDC, PASSTHROUGH, 0, (LPCSTR)&indata, NULL);
+ if (retval < 0)
+ {
+ Tcl_AppendElement(interp, "ide_winprint: PASSTHROUGH Escape failed");
+ error = 1;
+ break;
+ }
+ else if (retval != indata.len)
+ {
+ sprintf(msgbuf, "ide_winprint: Short write (%d vs. %d)", retval, indata.len);
+ Tcl_AppendElement(interp, msgbuf);
+ error = 1;
+ break;
+ }
+ }
+ }
+
+ strcpy (indata.buffer, "\r\nrestore\r\n");
+ indata.len = strlen(indata.buffer);
+ Escape(pd.hDC, PASSTHROUGH, 0, (LPCSTR)&indata, NULL);
+ }
+ else
+ {
+ GetTextMetrics (pd.hDC, &tm);
+ pt.x = 0;
+ pt.y = tm.tmHeight + tm.tmExternalLeading;
+ LPtoDP (pd.hDC, &pt, 1);
+ lineheight = pt.y;
+
+ pageno = 1;
+
+ /* The main print loop. */
+ done = 0;
+ error = 0;
+ needquery = 1;
+ while (1)
+ {
+ int y;
+
+ if (wd->aborted)
+ break;
+
+ /* Start a new page. */
+ if (pto.pageproc != NULL)
+ {
+ Tcl_DString ds;
+ char buf[20];
+ enum winprint_query q;
+ int status;
+
+ Tcl_DStringInit (&ds);
+ Tcl_DStringAppend (&ds, pto.pageproc, -1);
+ sprintf (buf, "%d", pageno);
+ Tcl_DStringAppendElement (&ds, buf);
+
+ status = winprint_print_text_invoke (interp, Tcl_DStringValue (&ds),
+ "page", &q);
+
+ Tcl_DStringFree (&ds);
+
+ if (status != TCL_OK)
+ {
+ error = 1;
+ break;
+ }
+
+ if (q == Q_DONE)
+ {
+ done = 1;
+ break;
+ }
+ }
+
+ if (needquery)
+ {
+ enum winprint_query q;
+
+ if (winprint_print_text_invoke (interp, queryproc, "query", &q)
+ != TCL_OK)
+ {
+ error = 1;
+ break;
+ }
+
+ if (q == Q_DONE)
+ {
+ done = 1;
+ break;
+ }
+
+ /* Ignore Q_NEWPAGE, since we're about to start a new page
+ anyhow. */
+
+ needquery = 0;
+ }
+
+ if (StartPage (pd.hDC) <= 0)
+ {
+ windows_error (interp, "StartPage");
+ error = 1;
+ break;
+ }
+
+ y = top;
+
+ /* Print a page. */
+
+ while (1)
+ {
+ char *l;
+ int len;
+ enum winprint_query q;
+
+ if (Tcl_Eval (interp, textproc) == TCL_ERROR)
+ {
+ error = 1;
+ break;
+ }
+
+ l = Tcl_GetStringFromObj (Tcl_GetObjResult (interp), &len);
+
+ TextOut (pd.hDC, left, y, l, len);
+ y += lineheight;
+
+ if (y >= bottom)
+ {
+ needquery = 1;
+ break;
+ }
+
+ if (winprint_print_text_invoke (interp, queryproc, "query", &q)
+ != TCL_OK)
+ {
+ error = 1;
+ break;
+ }
+
+ if (q == Q_DONE)
+ {
+ done = 1;
+ break;
+ }
+ else if (q == Q_NEWPAGE)
+ break;
+ }
+
+ if (error)
+ break;
+
+ if (EndPage (pd.hDC) <= 0)
+ {
+ /* It's OK for EndPage to return an error if the print job
+ was cancelled. */
+ if (! wd->aborted)
+ {
+ windows_error (interp, "EndPage");
+ error = 1;
+ }
+ break;
+ }
+
+ if (done)
+ break;
+
+ ++pageno;
+ }
+ }
+
+ if (winprint_finish (wd, interp, &pd, error) != TCL_OK)
+ error = 1;
+
+ if (error)
+ return TCL_ERROR;
+
+ Tcl_ResetResult (interp);
+ return TCL_OK;
+}
+
+/* Implement ide_winprint abort. */
+
+static int
+winprint_abort_command (ClientData cd, Tcl_Interp *interp, int argc,
+ char **argv)
+{
+ struct winprint_data *wd = (struct winprint_data *) cd;
+
+ wd->aborted = 1;
+ return TCL_OK;
+}
+
+/* The subcommand table. */
+
+static const struct ide_subcommand_table winprint_commands[] =
+{
+ { "page_setup", winprint_page_setup_command, 2, -1 },
+ { "print_text", winprint_print_command, 4, -1 },
+ { "print", winprint_print_command, 6, -1 },
+ { "abort", winprint_abort_command, 2, 2 },
+ { NULL, NULL, 0, 0 }
+};
+
+/* This function creates the ide_winprint Tcl command. */
+
+int
+ide_create_winprint_command (Tcl_Interp *interp)
+{
+ struct winprint_data *wd;
+
+ wd = (struct winprint_data *) Tcl_Alloc (sizeof *wd);
+ wd->page_setup = NULL;
+ wd->aborted = 0;
+
+ return ide_create_command_with_subcommands (interp, "ide_winprint",
+ winprint_commands,
+ (ClientData) wd,
+ winprint_command_deleted);
+}
+
+#endif /* _WIN32 */
+
+
+
+
+
+
diff --git a/libgui/src/tkCanvEdge.c b/libgui/src/tkCanvEdge.c
new file mode 100644
index 00000000000..aa66702d768
--- /dev/null
+++ b/libgui/src/tkCanvEdge.c
@@ -0,0 +1,2095 @@
+/*
+ * tkCanvEdge.c --
+ *
+ * This file implements edge items for canvas widgets.
+ *
+ * Copyright (c) 1993 by Sven Delmas
+ * All rights reserved.
+ * See the file COPYRIGHT for the copyright notes.
+ *
+ *
+ * This source is based upon the file tkCanvLine.c from:
+ *
+ * John Ousterhout
+ *
+ * Copyright (c) 1992-1993 The Regents of the University of California.
+ * All rights reserved.
+ *
+ * Permission is hereby granted, without written agreement and without
+ * license or royalty fees, to use, copy, modify, and distribute this
+ * software and its documentation for any purpose, provided that the
+ * above copyright notice and the following two paragraphs appear in
+ * all copies of this software.
+ *
+ * IN NO EVENT SHALL THE UNIVERSITY OF CALIFORNIA BE LIABLE TO ANY PARTY FOR
+ * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT
+ * OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF THE UNIVERSITY OF
+ * CALIFORNIA HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * THE UNIVERSITY OF CALIFORNIA SPECIFICALLY DISCLAIMS ANY WARRANTIES,
+ * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY
+ * AND FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS
+ * ON AN "AS IS" BASIS, AND THE UNIVERSITY OF CALIFORNIA HAS NO OBLIGATION TO
+ * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
+ */
+
+/* 05may96 wmt: converted to tk4.1 */
+
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+#include <stdio.h>
+#include <math.h>
+#include "tkInt.h"
+#include "tkCanvas.h"
+/* #include "tkConfig.h" 05nov95 wmt */
+#include "tkPort.h"
+
+#ifdef _MSC_VER
+#define F_OK 0
+#endif
+
+/*
+ * The structure below defines the record for each edge item.
+ */
+typedef struct EdgeItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_Canvas canvas; /* Canvas containing item. Needed for
+ * parsing arrow shapes. a register variable */
+ int numPoints; /* Number of points in edge (always >= 2). */
+ double *coordPtr; /* Pointer to malloc-ed array containing
+ * x- and y-coords of all points in edge.
+ * X-coords are even-valued indices, y-coords
+ * are corresponding odd-valued indices. If
+ * the edge has arrowheads then the first
+ * and last points have been adjusted to refer
+ * to the necks of the arrowheads rather than
+ * their tips. The actual endpoints are
+ * stored in the *firstArrowPtr and
+ * *lastArrowPtr, if they exist. */
+
+ char *label; /* Label to display. */
+ char *menu1; /* Standard menu for item, usually
+ * activated with button-3. */
+ char *menu2; /* Alternative menu for item, usually
+ * activated with meta-button-3. */
+ char *menu3; /* Alternative menu for item, usually
+ * activated with control-button-3. */
+ char *name; /* Name for item. */
+ char *state; /* State of item, this value is used
+ * to represent the selection status
+ * (normal, selected). */
+ char *graphName; /* Name of the Graph. */
+ char *from; /* From icon id. */
+ char *to; /* To icon id. */
+ Tk_Font tkfont; /* Font for drawing text. */
+ Tk_TextLayout textLayout; /* Cached text layout information. */
+ Tk_Justify justify; /* Justification to use for text within
+ * window. */
+
+ int width; /* Width of edge. */
+ int textHeight; /* Height of text label in points. */
+ int textWidth; /* Width of text label in points. */
+ XColor *fgColor; /* Foreground color for edge. */
+ XColor *bgColor; /* Background color to use for icon. */
+ Pixmap fillStipple; /* Stipple bitmap for filling edge. */
+ int capStyle; /* Cap style for edge. */
+ int joinStyle; /* Join style for edge. */
+
+ GC invertedGc; /* Graphics context to use for drawing
+ * the edge label on screen. */
+ GC gc; /* Graphics context for filling edge. */
+ Tk_Uid arrow; /* Indicates whether or not to draw arrowheads:
+ * "none", "first", "last", or "both". */
+ float arrowShapeA; /* Distance from tip of arrowhead to center. */
+ float arrowShapeB; /* Distance from tip of arrowhead to trailing
+ * point, measured along shaft. */
+ float arrowShapeC; /* Distance of trailing points from outside
+ * edge of shaft. */
+ double *firstArrowPtr; /* Points to array of PTS_IN_ARROW points
+ * describing polygon for arrowhead at first
+ * point in edge. First point of arrowhead
+ * is tip. Malloc'ed. NULL means no arrowhead
+ * at first point. */
+ double *lastArrowPtr; /* Points to polygon for arrowhead at last
+ * point in edge (PTS_IN_ARROW points, first
+ * of which is tip). Malloc'ed. NULL means
+ * no arrowhead at last point. */
+ int smooth; /* Non-zero means draw edge smoothed (i.e.
+ * with Bezier splines). */
+ int splineSteps; /* Number of steps in each spline segment. */
+} EdgeItem;
+
+/*
+ * Number of points in an arrowHead:
+ */
+#define PTS_IN_ARROW 6
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+static int ArrowheadPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, EdgeItem *edgePtr,
+ double *arrowPtr));
+static void ComputeEdgeBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ EdgeItem *edgePtr));
+static int ConfigureEdge _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+static int ConfigureArrows _ANSI_ARGS_((Tk_Canvas canvas,
+ EdgeItem *edgePtr));
+static int CreateEdge _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, char **argv));
+static void DeleteEdge _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayEdge _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static int EdgeCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ int argc, char **argv));
+static int EdgeToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double EdgeToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *coordPtr));
+static int EdgeToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static int ParseArrowShape _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin, char *value,
+ char *recordPtr, int offset));
+static char * PrintArrowShape _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *recordPtr, int offset,
+ Tcl_FreeProc **freeProcPtr));
+static void ScaleEdge _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslateEdge _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+
+/*
+ * Information used for parsing configuration specs. If you change any
+ * of the default strings, be sure to change the corresponding default
+ * values in CreateEdge.
+ */
+static Tk_CustomOption arrowShapeOption =
+{ ParseArrowShape, PrintArrowShape, (ClientData) NULL};
+
+static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_UID, "-arrow", (char *) NULL, (char *) NULL,
+ "none", Tk_Offset(EdgeItem, arrow), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-arrowshape", (char *) NULL, (char *) NULL,
+ "8 10 3", Tk_Offset(EdgeItem, arrowShapeA),
+ TK_CONFIG_DONT_SET_DEFAULT, &arrowShapeOption},
+ {TK_CONFIG_COLOR, "-background", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(EdgeItem, bgColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CAP_STYLE, "-capstyle", (char *) NULL, (char *) NULL,
+ "butt", Tk_Offset(EdgeItem, capStyle), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(EdgeItem, fgColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL,
+ "Helvetica 12 bold", Tk_Offset(EdgeItem, tkfont), 0},
+ {TK_CONFIG_STRING, "-from", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(EdgeItem, from), 0},
+ {TK_CONFIG_STRING, "-graphname", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(EdgeItem, graphName), 0},
+ {TK_CONFIG_JOIN_STYLE, "-joinstyle", (char *) NULL, (char *) NULL,
+ "round", Tk_Offset(EdgeItem, joinStyle), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_STRING, "-label", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(EdgeItem, label), 0},
+ {TK_CONFIG_STRING, "-menu1", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(EdgeItem, menu1), 0},
+ {TK_CONFIG_STRING, "-menu2", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(EdgeItem, menu2), 0},
+ {TK_CONFIG_STRING, "-menu3", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(EdgeItem, menu3), 0},
+ {TK_CONFIG_STRING, "-name", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(EdgeItem, name), 0},
+ {TK_CONFIG_BOOLEAN, "-smooth", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(EdgeItem, smooth), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_INT, "-splinesteps", (char *) NULL, (char *) NULL,
+ "12", Tk_Offset(EdgeItem, splineSteps), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_STRING, "-state", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(EdgeItem, state), 0},
+ {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(EdgeItem, fillStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_PIXELS, "-textheight", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(EdgeItem, textHeight), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_PIXELS, "-textwidth", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(EdgeItem, textWidth), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_STRING, "-to", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(EdgeItem, to), 0},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "1", Tk_Offset(EdgeItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify",
+ "left", Tk_Offset(EdgeItem, justify), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * The structures below defines the edge item type by means
+ * of procedures that can be invoked by generic item code.
+ */
+Tk_ItemType tkEdgeType = {
+ "edge", /* name */
+ sizeof(EdgeItem), /* itemSize */
+ CreateEdge, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureEdge, /* configureProc */
+ EdgeCoords, /* coordProc */
+ DeleteEdge, /* deleteProc */
+ DisplayEdge, /* displayProc */
+ 0, /* alwaysRedraw */
+ EdgeToPoint, /* pointProc */
+ EdgeToArea, /* areaProc */
+ EdgeToPostscript, /* postscriptProc */
+ ScaleEdge, /* scaleProc */
+ TranslateEdge, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (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
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateEdge --
+ *
+ * This procedure is invoked to create a new edge 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 edge item is created.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateEdge(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 edge. */
+{
+ EdgeItem *edgePtr = (EdgeItem *) itemPtr;
+ int i;
+
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tk_PathName(Tk_CanvasTkwin(canvas)), "\" create ",
+ itemPtr->typePtr->name,
+ " x1 y1 x2 y2 ?x3 y3 ...? ?options?",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Carry out initialization that is needed to set defaults and to
+ * allow proper cleanup after errors during the the remainder of
+ * this procedure.
+ */
+ edgePtr->bgColor = None;
+ edgePtr->canvas = canvas;
+ edgePtr->capStyle = CapButt;
+ edgePtr->coordPtr = NULL;
+ edgePtr->fgColor = None;
+ edgePtr->fillStipple = None;
+ edgePtr->tkfont = NULL;
+ edgePtr->from = NULL;
+ edgePtr->graphName = NULL;
+ edgePtr->joinStyle = JoinRound;
+ edgePtr->label = NULL;
+ edgePtr->menu1 = NULL;
+ edgePtr->menu2 = NULL;
+ edgePtr->menu3 = NULL;
+ edgePtr->name = NULL;
+ edgePtr->numPoints = 0;
+ edgePtr->smooth = 0;
+ edgePtr->splineSteps = 12;
+ edgePtr->state = NULL;
+ edgePtr->textWidth = 0;
+ edgePtr->to = NULL;
+ edgePtr->width = 1;
+ edgePtr->textLayout = NULL;
+ edgePtr->justify = TK_JUSTIFY_LEFT;
+
+ edgePtr->invertedGc = None;
+ edgePtr->gc = None;
+ if (noneUid == NULL) {
+ noneUid = Tk_GetUid("none");
+ firstUid = Tk_GetUid("first");
+ lastUid = Tk_GetUid("last");
+ bothUid = Tk_GetUid("both");
+ }
+ edgePtr->arrow = noneUid;
+ edgePtr->arrowShapeA = 8.0;
+ edgePtr->arrowShapeB = 10.0;
+ edgePtr->arrowShapeC = 3.0;
+ edgePtr->firstArrowPtr = NULL;
+ edgePtr->lastArrowPtr = NULL;
+
+ /*
+ * Count the number of points and then parse them into a point
+ * array. Leading arguments are assumed to be points if they
+ * start with a digit or a minus sign followed by a digit.
+ */
+
+ for (i = 4; i < (argc-1); i+=2) {
+ if ((!isdigit(UCHAR(argv[i][0]))) &&
+ ((argv[i][0] != '-') || (!isdigit(UCHAR(argv[i][1]))))) {
+ break;
+ }
+ }
+ if (EdgeCoords(interp, canvas, itemPtr, i, argv) != TCL_OK) {
+ goto error;
+ }
+ if (ConfigureEdge(interp, canvas, itemPtr, argc-i, argv+i, 0) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteEdge(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EdgeCoords --
+ *
+ * This procedure is invoked to process the "coords" widget
+ * command on edges. 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
+EdgeCoords(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, ... */
+{
+ EdgeItem *edgePtr = (EdgeItem *) itemPtr;
+ char buffer[TCL_DOUBLE_SPACE];
+ int i, numPoints;
+
+ if (argc == 0) {
+ double *coordPtr;
+ int numCoords;
+
+ numCoords = 2*edgePtr->numPoints;
+ if (edgePtr->firstArrowPtr != NULL) {
+ coordPtr = edgePtr->firstArrowPtr;
+ } else {
+ coordPtr = edgePtr->coordPtr;
+ }
+ for (i = 0; i < numCoords; i++, coordPtr++) {
+ if (i == 2) {
+ coordPtr = edgePtr->coordPtr+2;
+ }
+ if ((edgePtr->lastArrowPtr != NULL) && (i == (numCoords-2))) {
+ coordPtr = edgePtr->lastArrowPtr;
+ }
+ Tcl_PrintDouble(interp, *coordPtr, buffer);
+ Tcl_AppendElement(interp, buffer);
+ }
+ } else if (argc < 4) {
+ Tcl_AppendResult(interp,
+ "too few coordinates for edge: must have at least 4",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else if (argc & 1) {
+ Tcl_AppendResult(interp,
+ "odd number of coordinates specified for edge",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ numPoints = argc/2;
+ if (edgePtr->numPoints != numPoints) {
+ if (edgePtr->coordPtr != NULL) {
+ ckfree((char *) edgePtr->coordPtr);
+ }
+ edgePtr->coordPtr = (double *) ckalloc((unsigned)
+ (sizeof(double) * argc));
+ edgePtr->numPoints = numPoints;
+ }
+ for (i = argc-1; i >= 0; i--) {
+ if (Tk_CanvasGetCoord(interp, canvas, argv[i], &edgePtr->coordPtr[i])
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Update arrowheads by throwing away any existing arrow-head
+ * information and calling ConfigureArrows to recompute it.
+ */
+
+ if (edgePtr->firstArrowPtr != NULL) {
+ ckfree((char *) edgePtr->firstArrowPtr);
+ edgePtr->firstArrowPtr = NULL;
+ }
+ if (edgePtr->lastArrowPtr != NULL) {
+ ckfree((char *) edgePtr->lastArrowPtr);
+ edgePtr->lastArrowPtr = NULL;
+ }
+ if (edgePtr->arrow != noneUid) {
+ ConfigureArrows(canvas, edgePtr);
+ }
+ ComputeEdgeBbox(canvas, edgePtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureEdge --
+ *
+ * This procedure is invoked to configure various aspects
+ * of a edge 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureEdge(interp, canvas, itemPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Edge item to reconfigure. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ EdgeItem *edgePtr = (EdgeItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+ char *value, *fullName, **list;
+ int counter, listCounter = 0;
+ Tcl_DString varName, fileName, buffer;
+ Tk_Window tkwin;
+ Tk_3DBorder bgBorder;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ bgBorder = ((TkCanvas *) canvas)->bgBorder;
+
+ if (Tk_ConfigureWidget(interp, tkwin,
+ configSpecs, argc, argv,
+ (char *) edgePtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as
+ * graphics contexts.
+ */
+
+ /* the normal gc */
+ if (edgePtr->fgColor == NULL) {
+ newGC = None;
+ } else {
+ mask = GCBackground|GCForeground|GCJoinStyle|GCLineWidth;
+ if (edgePtr->bgColor != NULL) {
+ gcValues.background = edgePtr->bgColor->pixel;
+ } else {
+ gcValues.background = Tk_3DBorderColor(bgBorder)->pixel;
+ }
+ gcValues.foreground = edgePtr->fgColor->pixel;
+ gcValues.join_style = edgePtr->joinStyle;
+ if (edgePtr->width < 0) {
+ edgePtr->width = 1;
+ }
+ gcValues.line_width = edgePtr->width;
+ if (edgePtr->fillStipple != None) {
+ gcValues.stipple = edgePtr->fillStipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ if (edgePtr->arrow == noneUid) {
+ gcValues.cap_style = edgePtr->capStyle;
+ mask |= GCCapStyle;
+ }
+ if (edgePtr->tkfont != NULL) {
+ gcValues.font = Tk_FontId(edgePtr->tkfont);
+ mask |= GCFont;
+ }
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ if (edgePtr->gc != None) {
+ Tk_FreeGC(((TkCanvas *) canvas)->display, edgePtr->gc);
+ }
+ edgePtr->gc = newGC;
+
+ /* the inverted gc */
+ if (edgePtr->fgColor == NULL) {
+ newGC = None;
+ } else {
+ mask = GCForeground | GCBackground;
+ gcValues.background = edgePtr->fgColor->pixel;
+ if (edgePtr->bgColor != NULL) {
+ gcValues.foreground = edgePtr->bgColor->pixel;
+ } else {
+ gcValues.foreground = Tk_3DBorderColor(bgBorder)->pixel;
+ }
+ if (edgePtr->tkfont != NULL) {
+ gcValues.font = Tk_FontId(edgePtr->tkfont);
+ mask |= GCFont;
+ }
+ newGC = Tk_GetGC(tkwin, mask, &gcValues);
+ }
+ if (edgePtr->invertedGc != None) {
+ Tk_FreeGC(((TkCanvas *) canvas)->display, edgePtr->invertedGc);
+ }
+ edgePtr->invertedGc = newGC;
+
+ /*
+ * Keep spline parameters within reasonable limits.
+ */
+ if (edgePtr->splineSteps < 1) {
+ edgePtr->splineSteps = 1;
+ } else if (edgePtr->splineSteps > 100) {
+ edgePtr->splineSteps = 100;
+ }
+
+ /*
+ * Setup arrowheads, if needed. If arrowheads are turned off,
+ * restore the edge's endpoints (they were shortened when the
+ * arrowheads were added).
+ */
+ if ((edgePtr->firstArrowPtr != NULL) && (edgePtr->arrow != firstUid)
+ && (edgePtr->arrow != bothUid)) {
+ edgePtr->coordPtr[0] = edgePtr->firstArrowPtr[0];
+ edgePtr->coordPtr[1] = edgePtr->firstArrowPtr[1];
+ ckfree((char *) edgePtr->firstArrowPtr);
+ edgePtr->firstArrowPtr = NULL;
+ }
+ if ((edgePtr->lastArrowPtr != NULL) && (edgePtr->arrow != lastUid)
+ && (edgePtr->arrow != bothUid)) {
+ int index;
+
+ index = 2*(edgePtr->numPoints-1);
+ edgePtr->coordPtr[index] = edgePtr->lastArrowPtr[0];
+ edgePtr->coordPtr[index+1] = edgePtr->lastArrowPtr[1];
+ ckfree((char *) edgePtr->lastArrowPtr);
+ edgePtr->lastArrowPtr = NULL;
+ }
+ if (edgePtr->arrow != noneUid) {
+ if ((edgePtr->arrow != firstUid) && (edgePtr->arrow != lastUid)
+ && (edgePtr->arrow != bothUid)) {
+ Tcl_AppendResult(interp, "bad arrow spec \"",
+ edgePtr->arrow,
+ "\": must be none, first, last, or both",
+ (char *) NULL);
+ edgePtr->arrow = noneUid;
+ return TCL_ERROR;
+ }
+ ConfigureArrows(canvas, edgePtr);
+ }
+
+ /* Calculate the text width & height in points. */
+ Tk_FreeTextLayout(edgePtr->textLayout);
+ edgePtr->textLayout = Tk_ComputeTextLayout(edgePtr->tkfont,
+ edgePtr->label,
+ strlen (edgePtr->label),
+ edgePtr->width,
+ edgePtr->justify,
+ 0, &edgePtr->textWidth, &edgePtr->textHeight);
+
+ /* do we have a menu ? */
+ if (edgePtr->menu1 != NULL && strlen(edgePtr->menu1) > (size_t) 0 &&
+ edgePtr->menu1[0] != '.') {
+ /* do we have to load the new menu definition ? */
+ (void) Tcl_VarEval(interp, "info commands .emenu-",
+ edgePtr->menu1, (char *) NULL);
+ if (strlen(interp->result) == 0) {
+ /* the following code retrieves the path list for the menus. This */
+ /* is done because I don't want to attatch the pathname list to */
+ /* each icon. */
+ Tcl_DStringInit(&varName);
+ Tcl_DStringAppend(&varName, "ip_priv(", -1);
+ Tcl_DStringAppend(&varName, Tk_PathName(tkwin), -1);
+ Tcl_DStringAppend(&varName, ",edgemenupath)", -1);
+ if ((value = Tcl_GetVar(interp, varName.string,
+ TCL_GLOBAL_ONLY)) != NULL) {
+ if (Tcl_SplitList(interp, value, &listCounter,
+ &list) == TCL_OK) {
+ /* walk through list of pathnames. */
+ for (counter = 0; counter < listCounter; counter++) {
+ /* create the filename to load. */
+ Tcl_DStringInit(&fileName);
+ Tcl_DStringAppend(&fileName, list[counter], -1);
+ Tcl_DStringAppend(&fileName, "/", -1);
+ Tcl_DStringAppend(&fileName, edgePtr->menu1, -1);
+ Tcl_DStringAppend(&fileName, ".emenu", -1);
+ Tcl_DStringInit(&buffer);
+ fullName = Tcl_TildeSubst(interp,
+ fileName.string, &buffer);
+ if (access(fullName, F_OK) != -1) {
+ /* load new menu. */
+ Tcl_VarEval(interp, "source ", fullName,
+ (char *) NULL);
+ }
+ Tcl_DStringFree(&fileName);
+ Tcl_DStringFree(&buffer);
+ }
+ ckfree((char *) list);
+ }
+ }
+ Tcl_DStringFree(&varName);
+ }
+ }
+
+ /* do we have a menu ? */
+ if (edgePtr->menu2 != NULL && strlen(edgePtr->menu2) > (size_t) 0 &&
+ edgePtr->menu2[0] != '.') {
+ /* do we have to load the new menu definition ? */
+ (void) Tcl_VarEval(interp, "info commands .emenu-",
+ edgePtr->menu2, (char *) NULL);
+ if (strlen(interp->result) == 0) {
+ /* the following code retrieves the path list for the menus. This */
+ /* is done because I don't want to attatch the pathname list to */
+ /* each icon. */
+ Tcl_DStringInit(&varName);
+ Tcl_DStringAppend(&varName, "ip_priv(", -1);
+ Tcl_DStringAppend(&varName, Tk_PathName(tkwin), -1);
+ Tcl_DStringAppend(&varName, ",edgemenupath)", -1);
+ if ((value = Tcl_GetVar(interp, varName.string,
+ TCL_GLOBAL_ONLY)) != NULL) {
+ if (Tcl_SplitList(interp, value, &listCounter,
+ &list) == TCL_OK) {
+ /* walk through list of pathnames. */
+ for (counter = 0; counter < listCounter; counter++) {
+ /* create the filename to load. */
+ Tcl_DStringInit(&fileName);
+ Tcl_DStringAppend(&fileName, list[counter], -1);
+ Tcl_DStringAppend(&fileName, "/", -1);
+ Tcl_DStringAppend(&fileName, edgePtr->menu2, -1);
+ Tcl_DStringAppend(&fileName, ".emenu", -1);
+ Tcl_DStringInit(&buffer);
+ fullName = Tcl_TildeSubst(interp,
+ fileName.string, &buffer);
+ if (access(fullName, F_OK) != -1) {
+ /* load new menu. */
+ Tcl_VarEval(interp, "source ", fullName,
+ (char *) NULL);
+ }
+ Tcl_DStringFree(&fileName);
+ Tcl_DStringFree(&buffer);
+ }
+ ckfree((char *) list);
+ }
+ }
+ Tcl_DStringFree(&varName);
+ }
+ }
+
+ /* do we have a menu ? */
+ if (edgePtr->menu3 != NULL && strlen(edgePtr->menu3) > (size_t) 0 &&
+ edgePtr->menu3[0] != '.') {
+ /* do we have to load the new menu definition ? */
+ (void) Tcl_VarEval(interp, "info commands .emenu-",
+ edgePtr->menu3, (char *) NULL);
+ if (strlen(interp->result) == 0) {
+ /* the following code retrieves the path list for the menus. This */
+ /* is done because I don't want to attatch the pathname list to */
+ /* each icon. */
+ Tcl_DStringInit(&varName);
+ Tcl_DStringAppend(&varName, "ip_priv(", -1);
+ Tcl_DStringAppend(&varName, Tk_PathName(tkwin), -1);
+ Tcl_DStringAppend(&varName, ",edgemenupath)", -1);
+ if ((value = Tcl_GetVar(interp, varName.string,
+ TCL_GLOBAL_ONLY)) != NULL) {
+ if (Tcl_SplitList(interp, value, &listCounter,
+ &list) == TCL_OK) {
+ /* walk through list of pathnames. */
+ for (counter = 0; counter < listCounter; counter++) {
+ /* create the filename to load. */
+ Tcl_DStringInit(&fileName);
+ Tcl_DStringAppend(&fileName, list[counter], -1);
+ Tcl_DStringAppend(&fileName, "/", -1);
+ Tcl_DStringAppend(&fileName, edgePtr->menu3, -1);
+ Tcl_DStringAppend(&fileName, ".emenu", -1);
+ Tcl_DStringInit(&buffer);
+ fullName = Tcl_TildeSubst(interp,
+ fileName.string, &buffer);
+ if (access(fullName, F_OK) != -1) {
+ /* load new menu. */
+ Tcl_VarEval(interp, "source ", fullName,
+ (char *) NULL);
+ }
+ Tcl_DStringFree(&fileName);
+ Tcl_DStringFree(&buffer);
+ }
+ ckfree((char *) list);
+ }
+ }
+ Tcl_DStringFree(&varName);
+ }
+ }
+
+ /*
+ * Recompute bounding box for edge.
+ */
+
+ ComputeEdgeBbox(canvas, edgePtr);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteEdge --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a edge item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteEdge(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. */
+{
+ EdgeItem *edgePtr = (EdgeItem *) itemPtr;
+
+ if (edgePtr->bgColor != NULL) {
+ Tk_FreeColor(edgePtr->bgColor);
+ }
+ if (edgePtr->coordPtr != NULL) {
+ ckfree((char *) edgePtr->coordPtr);
+ }
+ if (edgePtr->fgColor != NULL) {
+ Tk_FreeColor(edgePtr->fgColor);
+ }
+ if (edgePtr->fillStipple != None) {
+ Tk_FreeBitmap(display, edgePtr->fillStipple);
+ }
+ if (edgePtr->tkfont != NULL) {
+ Tk_FreeFont(edgePtr->tkfont);
+ }
+ if (edgePtr->from != NULL) {
+ ckfree(edgePtr->from);
+ }
+ if (edgePtr->graphName != NULL) {
+ ckfree(edgePtr->graphName);
+ }
+ if (edgePtr->label != NULL) {
+ ckfree(edgePtr->label);
+ }
+ if (edgePtr->menu1 != NULL) {
+ ckfree(edgePtr->menu1);
+ }
+ if (edgePtr->menu2 != NULL) {
+ ckfree(edgePtr->menu2);
+ }
+ if (edgePtr->menu3 != NULL) {
+ ckfree(edgePtr->menu3);
+ }
+ if (edgePtr->name != NULL) {
+ ckfree(edgePtr->name);
+ }
+ if (edgePtr->state != NULL) {
+ ckfree(edgePtr->state);
+ }
+ if (edgePtr->to != NULL) {
+ ckfree(edgePtr->to);
+ }
+
+ if (edgePtr->invertedGc != None) {
+ Tk_FreeGC(display, edgePtr->invertedGc);
+ }
+ if (edgePtr->gc != None) {
+ Tk_FreeGC(display, edgePtr->gc);
+ }
+ if (edgePtr->firstArrowPtr != NULL) {
+ ckfree((char *) edgePtr->firstArrowPtr);
+ }
+ if (edgePtr->lastArrowPtr != NULL) {
+ ckfree((char *) edgePtr->lastArrowPtr);
+ }
+ if (edgePtr->textLayout != NULL) {
+ ckfree((char *) edgePtr->textLayout);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeEdgeBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a edge.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeEdgeBbox(canvas, edgePtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ EdgeItem *edgePtr; /* Item whose bbos is to be
+ * recomputed. */
+{
+ double *coordPtr;
+ int i, lineWidth, lineHeight;
+
+ coordPtr = edgePtr->coordPtr;
+ edgePtr->header.x1 = edgePtr->header.x2 = *coordPtr;
+ edgePtr->header.y1 = edgePtr->header.y2 = coordPtr[1];
+
+ /*
+ * Compute the bounding box of all the points in the edge,
+ * then expand in all directions by the edge's width to take
+ * care of butting or rounded corners and projecting or
+ * rounded caps. This expansion is an overestimate (worst-case
+ * is square root of two over two) but it's simple. Don't do
+ * anything special for curves. This causes an additional
+ * overestimate in the bounding box, but is faster.
+ */
+
+ for (i = 1, coordPtr = edgePtr->coordPtr+2; i < edgePtr->numPoints;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) edgePtr, coordPtr);
+ }
+ edgePtr->header.x1 -= edgePtr->width;
+ edgePtr->header.x2 += edgePtr->width;
+ edgePtr->header.y1 -= edgePtr->width;
+ edgePtr->header.y2 += edgePtr->width;
+
+ /*
+ * For mitered edges, make a second pass through all the points.
+ * Compute the locations of the two miter vertex points and add
+ * those into the bounding box.
+ */
+
+ if (edgePtr->joinStyle == JoinMiter) {
+ for (i = edgePtr->numPoints, coordPtr = edgePtr->coordPtr; i >= 3;
+ i--, coordPtr += 2) {
+ double miter[4];
+ int j;
+
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ (double) edgePtr->width, miter, miter+2)) {
+ for (j = 0; j < 4; j += 2) {
+ TkIncludePoint((Tk_Item *) edgePtr, miter+j);
+ }
+ }
+ }
+ }
+
+ /*
+ * Add in the sizes of arrowheads, if any.
+ */
+
+ if (edgePtr->arrow != noneUid) {
+ if (edgePtr->arrow != lastUid) {
+ for (i = 0, coordPtr = edgePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) edgePtr, coordPtr);
+ }
+ }
+ if (edgePtr->arrow != firstUid) {
+ for (i = 0, coordPtr = edgePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) edgePtr, coordPtr);
+ }
+ }
+ }
+
+ /*
+ * Add one more pixel of fudge factor just to be safe (e.g.
+ * X may round differently than we do).
+ */
+
+ edgePtr->header.x1 -= 1;
+ edgePtr->header.x2 += 1;
+ edgePtr->header.y1 -= 1;
+ edgePtr->header.y2 += 1;
+
+ /* maybe we have a label that is wider than the line */
+ if (edgePtr->tkfont != NULL && edgePtr->label != NULL) {
+ Tk_FreeTextLayout(edgePtr->textLayout);
+ edgePtr->textLayout = Tk_ComputeTextLayout(edgePtr->tkfont,
+ edgePtr->label,
+ strlen (edgePtr->label),
+ edgePtr->width,
+ edgePtr->justify,
+ 0, &lineWidth, &lineHeight);
+ lineWidth = strlen(edgePtr->label);
+ if (lineWidth > (edgePtr->header.x2 - edgePtr->header.x2)) {
+ edgePtr->header.x1 -=
+ (lineWidth - (edgePtr->header.x2 - edgePtr->header.x2)) / 2;
+ edgePtr->header.x2 +=
+ (lineWidth - (edgePtr->header.x2 - edgePtr->header.x2)) / 2;
+ }
+ if (lineHeight >
+ (edgePtr->header.y2 - edgePtr->header.y2)) {
+ edgePtr->header.y1 -=
+ (lineHeight - (edgePtr->header.y2 - edgePtr->header.y2))
+ / 2;
+ edgePtr->header.y2 +=
+ (lineHeight - (edgePtr->header.y2 - edgePtr->header.y2)) / 2;
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayEdge --
+ *
+ * This procedure is invoked to draw a edge item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayEdge(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). */
+{
+ EdgeItem *edgePtr = (EdgeItem *) itemPtr;
+ XPoint staticPoints[MAX_STATIC_POINTS];
+ XPoint *pointPtr;
+ XPoint *pPtr;
+ register double *coordPtr;
+ int i, numPoints, lineHeight;
+ int centerX, centerY, lineWidth;
+ short drawableX, drawableY;
+
+ if (edgePtr->gc == None) {
+ return;
+ }
+
+ /*
+ * Build up an array of points in screen coordinates. Use a
+ * static array unless the edge has an enormous number of points;
+ * in this case, dynamically allocate an array. For smoothed edges,
+ * generate the curve points on each redisplay.
+ */
+
+ if ((edgePtr->smooth) && (edgePtr->numPoints > 2)) {
+ numPoints = 1 + edgePtr->numPoints*edgePtr->splineSteps;
+ } else {
+ numPoints = edgePtr->numPoints;
+ }
+
+ if (numPoints <= MAX_STATIC_POINTS) {
+ pointPtr = staticPoints;
+ } else {
+ pointPtr = (XPoint *) ckalloc((unsigned) (numPoints * sizeof(XPoint)));
+ }
+
+ if (edgePtr->smooth) {
+ numPoints = TkMakeBezierCurve(canvas, edgePtr->coordPtr,
+ edgePtr->numPoints,
+ edgePtr->splineSteps, pointPtr,
+ (double *) NULL);
+ } else {
+ for (i = 0, coordPtr = edgePtr->coordPtr, pPtr = pointPtr;
+ i < edgePtr->numPoints; i += 1, coordPtr += 2, pPtr++) {
+ Tk_CanvasDrawableCoords(canvas, coordPtr[0], coordPtr[1],
+ &pPtr->x, &pPtr->y);
+ }
+ }
+
+ /*
+ * Display edge, the free up edge storage if it was dynamically
+ * allocated. 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 (edgePtr->fillStipple != None) {
+ XSetTSOrigin(display, edgePtr->gc,
+ -((TkCanvas *) canvas)->drawableXOrigin,
+ -((TkCanvas *) canvas)->drawableYOrigin);
+ }
+ XDrawLines(display, drawable, edgePtr->gc,
+ pointPtr, numPoints, CoordModeOrigin);
+ if (pointPtr[numPoints-1].x > pointPtr[numPoints-2].x) {
+ centerX = ((pointPtr[numPoints-1].x - pointPtr[numPoints-2].x) / 2) +
+ pointPtr[numPoints-2].x;
+ } else {
+ centerX = ((pointPtr[numPoints-2].x - pointPtr[numPoints-1].x) / 2) +
+ pointPtr[numPoints-1].x;
+ }
+ if (pointPtr[numPoints-1].y > pointPtr[numPoints-2].y) {
+ centerY = ((pointPtr[numPoints-1].y - pointPtr[numPoints-2].y) / 2) +
+ pointPtr[numPoints-2].y;
+ } else {
+ centerY = ((pointPtr[numPoints-2].y - pointPtr[numPoints-1].y) / 2) +
+ pointPtr[numPoints-1].y;
+ }
+ if (pointPtr != staticPoints) {
+ ckfree((char *) pointPtr);
+ }
+
+ /*
+ * Display arrowheads, if they are wanted.
+ */
+
+ if (edgePtr->arrow != noneUid) {
+ if (edgePtr->arrow != lastUid) {
+ TkFillPolygon(canvas, edgePtr->firstArrowPtr, PTS_IN_ARROW,
+ display, drawable, edgePtr->gc, NULL);
+ }
+ if (edgePtr->arrow != firstUid) {
+ TkFillPolygon(canvas, edgePtr->lastArrowPtr, PTS_IN_ARROW,
+ display, drawable, edgePtr->gc, NULL);
+ }
+ }
+ if (edgePtr->fillStipple != None) {
+ XSetTSOrigin(display, edgePtr->gc, 0, 0);
+ }
+
+ /* display the label */
+ if (edgePtr->label != NULL && (size_t) strlen(edgePtr->label) > 0) {
+ Tk_FreeTextLayout(edgePtr->textLayout);
+ edgePtr->textLayout = Tk_ComputeTextLayout(edgePtr->tkfont,
+ edgePtr->label,
+ strlen (edgePtr->label),
+ edgePtr->width,
+ edgePtr->justify,
+ 0, &lineWidth, &lineHeight);
+ lineWidth = strlen(edgePtr->label);
+ if (strcmp(edgePtr->state, "selected") == 0) {
+ XFillRectangle(display, drawable,
+ edgePtr->gc,
+ centerX - (lineWidth / 2) - 1,
+ centerY - (lineHeight / 2) - 1,
+ lineWidth + 2, lineHeight + 2);
+ Tk_CanvasDrawableCoords(canvas,
+ (double) (edgePtr->header.x1 + x),
+ (double) (edgePtr->header.y1 + y),
+ &drawableX, &drawableY);
+ Tk_DrawTextLayout(display, drawable, edgePtr->gc,
+ edgePtr->textLayout,
+ drawableX, drawableY,
+ 0, -1);
+ } else {
+ XFillRectangle(display, drawable,
+ edgePtr->invertedGc,
+ centerX - (lineWidth / 2) - 1,
+ centerY - (lineHeight / 2) - 1,
+ lineWidth + 2, lineHeight + 2);
+ Tk_CanvasDrawableCoords(canvas,
+ (double) (edgePtr->header.x1 + x),
+ (double) (edgePtr->header.y1 + y),
+ &drawableX, &drawableY);
+ Tk_DrawTextLayout(display, drawable, edgePtr->gc,
+ edgePtr->textLayout,
+ drawableX, drawableY,
+ 0, -1);
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EdgeToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * edge, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are pointPtr[0] and pointPtr[1] is inside the edge. If the
+ * point isn't inside the edge then the return value is the
+ * distance from the point to the edge.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+EdgeToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ EdgeItem *edgePtr = (EdgeItem *) itemPtr;
+ register double *coordPtr, *edgePoints;
+ 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.0e40;
+
+ /*
+ * Handle smoothed edges by generating an expanded set of points
+ * against which to do the check.
+ */
+
+ if ((edgePtr->smooth) && (edgePtr->numPoints > 2)) {
+ numPoints = 1 + edgePtr->numPoints*edgePtr->splineSteps;
+ if (numPoints <= MAX_STATIC_POINTS) {
+ edgePoints = staticSpace;
+ } else {
+ edgePoints = (double *) ckalloc((unsigned)
+ (2*numPoints*sizeof(double)));
+ }
+ numPoints = TkMakeBezierCurve(canvas, edgePtr->coordPtr,
+ edgePtr->numPoints,
+ edgePtr->splineSteps, (XPoint *) NULL,
+ edgePoints);
+ } else {
+ numPoints = edgePtr->numPoints;
+ edgePoints = edgePtr->coordPtr;
+ }
+
+ /*
+ * The overall idea is to iterate through all of the edges of
+ * the edge, 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.
+ */
+
+ changedMiterToBevel = 0;
+ for (count = numPoints, coordPtr = edgePoints; count >= 2;
+ count--, coordPtr += 2) {
+
+ /*
+ * If rounding is done around the first point then compute
+ * the distance between the point and the point.
+ */
+
+ if (((edgePtr->capStyle == CapRound) && (count == numPoints))
+ || ((edgePtr->joinStyle == JoinRound)
+ && (count != numPoints))) {
+ dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1])
+ - edgePtr->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) edgePtr->width,
+ edgePtr->capStyle == CapProjecting, poly, poly+2);
+ } else if ((edgePtr->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) edgePtr->width, 0,
+ poly, poly+2);
+
+ /*
+ * If this edge 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.
+ */
+
+ if ((edgePtr->joinStyle == JoinBevel) || changedMiterToBevel) {
+ 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;
+ }
+ changedMiterToBevel = 0;
+ }
+ }
+ if (count == 2) {
+ TkGetButtPoints(coordPtr, coordPtr+2, (double) edgePtr->width,
+ edgePtr->capStyle == CapProjecting, poly+4, poly+6);
+ } else if (edgePtr->joinStyle == JoinMiter) {
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ (double) edgePtr->width, poly+4, poly+6) == 0) {
+ changedMiterToBevel = 1;
+ TkGetButtPoints(coordPtr, coordPtr+2, (double) edgePtr->width,
+ 0, poly+4, poly+6);
+ }
+ } else {
+ TkGetButtPoints(coordPtr, coordPtr+2, (double) edgePtr->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 edge.
+ */
+
+ if (edgePtr->capStyle == CapRound) {
+ dist = hypot(coordPtr[0] - pointPtr[0], coordPtr[1] - pointPtr[1])
+ - edgePtr->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 (edgePtr->arrow != noneUid) {
+ if (edgePtr->arrow != lastUid) {
+ dist = TkPolygonToPoint(edgePtr->firstArrowPtr, PTS_IN_ARROW,
+ pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+ if (edgePtr->arrow != firstUid) {
+ dist = TkPolygonToPoint(edgePtr->lastArrowPtr, PTS_IN_ARROW,
+ pointPtr);
+ if (dist <= 0.0) {
+ bestDist = 0.0;
+ goto done;
+ } else if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+ }
+
+ done:
+ if ((edgePoints != staticSpace) && (edgePoints != edgePtr->coordPtr)) {
+ ckfree((char *) edgePoints);
+ }
+ return bestDist;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EdgeToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the
+ * area, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+EdgeToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against edge. */
+ double *rectPtr;
+{
+ EdgeItem *edgePtr = (EdgeItem *) itemPtr;
+ register double *coordPtr;
+ double staticSpace[2*MAX_STATIC_POINTS];
+ double *edgePoints, poly[10];
+ double radius;
+ 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. */
+ int inside; /* Tentative guess about what to return,
+ * based on all points seen so far: one
+ * means everything seen so far was
+ * inside the area; -1 means everything
+ * was outside the area. 0 means overlap
+ * has been found. */
+
+ radius = edgePtr->width/2.0;
+ inside = -1;
+
+ /*
+ * Handle smoothed edges by generating an expanded set of points
+ * against which to do the check.
+ */
+
+ if ((edgePtr->smooth) && (edgePtr->numPoints > 2)) {
+ numPoints = 1 + edgePtr->numPoints*edgePtr->splineSteps;
+ if (numPoints <= MAX_STATIC_POINTS) {
+ edgePoints = staticSpace;
+ } else {
+ edgePoints = (double *) ckalloc((unsigned)
+ (2*numPoints*sizeof(double)));
+ }
+ numPoints = TkMakeBezierCurve(canvas, edgePtr->coordPtr,
+ edgePtr->numPoints,
+ edgePtr->splineSteps, (XPoint *) NULL,
+ edgePoints);
+ } else {
+ numPoints = edgePtr->numPoints;
+ edgePoints = edgePtr->coordPtr;
+ }
+
+ coordPtr = edgePoints;
+ if ((coordPtr[0] >= rectPtr[0]) && (coordPtr[0] <= rectPtr[2])
+ && (coordPtr[1] >= rectPtr[1]) && (coordPtr[1] <= rectPtr[3])) {
+ inside = 1;
+ }
+
+ /*
+ * Iterate through all of the edges of the edge, computing a polygon
+ * for each edge and testing the area against that polygon. In
+ * addition, there are additional tests to deal with rounded joints
+ * and caps.
+ */
+
+ changedMiterToBevel = 0;
+ for (count = numPoints; count >= 2; count--, coordPtr += 2) {
+
+ /*
+ * If rounding is done around the first point of the edge
+ * then test a circular region around the point with the
+ * area.
+ */
+
+ if (((edgePtr->capStyle == CapRound) && (count == numPoints))
+ || ((edgePtr->joinStyle == JoinRound)
+ && (count != numPoints))) {
+ poly[0] = coordPtr[0] - radius;
+ poly[1] = coordPtr[1] - radius;
+ poly[2] = coordPtr[0] + radius;
+ poly[3] = coordPtr[1] + radius;
+ if (TkOvalToArea(poly, rectPtr) != inside) {
+ inside = 0;
+ goto done;
+ }
+ }
+
+ /*
+ * 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) edgePtr->width,
+ edgePtr->capStyle == CapProjecting, poly, poly+2);
+ } else if ((edgePtr->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) edgePtr->width, 0,
+ poly, poly+2);
+
+ /*
+ * If the last joint was beveled, then also check 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 beveled joint.
+ */
+
+ if ((edgePtr->joinStyle == JoinBevel) || changedMiterToBevel) {
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ if (TkPolygonToArea(poly, 5, rectPtr) != inside) {
+ inside = 0;
+ goto done;
+ }
+ changedMiterToBevel = 0;
+ }
+ }
+ if (count == 2) {
+ TkGetButtPoints(coordPtr, coordPtr+2, (double) edgePtr->width,
+ edgePtr->capStyle == CapProjecting, poly+4, poly+6);
+ } else if (edgePtr->joinStyle == JoinMiter) {
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ (double) edgePtr->width, poly+4, poly+6) == 0) {
+ changedMiterToBevel = 1;
+ TkGetButtPoints(coordPtr, coordPtr+2, (double) edgePtr->width,
+ 0, poly+4, poly+6);
+ }
+ } else {
+ TkGetButtPoints(coordPtr, coordPtr+2, (double) edgePtr->width, 0,
+ poly+4, poly+6);
+ }
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ if (TkPolygonToArea(poly, 5, rectPtr) != inside) {
+ inside = 0;
+ goto done;
+ }
+ }
+
+ /*
+ * If caps are rounded, check the cap around the final point
+ * of the edge.
+ */
+
+ if (edgePtr->capStyle == CapRound) {
+ poly[0] = coordPtr[0] - radius;
+ poly[1] = coordPtr[1] - radius;
+ poly[2] = coordPtr[0] + radius;
+ poly[3] = coordPtr[1] + radius;
+ if (TkOvalToArea(poly, rectPtr) != inside) {
+ inside = 0;
+ goto done;
+ }
+ }
+
+ /*
+ * Check arrowheads, if any.
+ */
+
+ if (edgePtr->arrow != noneUid) {
+ if (edgePtr->arrow != lastUid) {
+ if (TkPolygonToArea(edgePtr->firstArrowPtr, PTS_IN_ARROW,
+ rectPtr) != inside) {
+ inside = 0;
+ goto done;
+ }
+ }
+ if (edgePtr->arrow != firstUid) {
+ if (TkPolygonToArea(edgePtr->lastArrowPtr, PTS_IN_ARROW,
+ rectPtr) != inside) {
+ inside = 0;
+ goto done;
+ }
+ }
+ }
+
+ done:
+ if ((edgePoints != staticSpace) && (edgePoints != edgePtr->coordPtr)) {
+ ckfree((char *) edgePoints);
+ }
+ return inside;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleEdge --
+ *
+ * This procedure is invoked to rescale a edge item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The edge referred to by itemPtr is rescaled so that the
+ * following transformation is applied to all point
+ * coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleEdge(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing edge. */
+ Tk_Item *itemPtr; /* Edge 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. */
+{
+ EdgeItem *edgePtr = (EdgeItem *) itemPtr;
+ double *coordPtr;
+ int i;
+
+ for (i = 0, coordPtr = edgePtr->coordPtr; i < edgePtr->numPoints;
+ i++, coordPtr += 2) {
+ coordPtr[0] = originX + scaleX*(*coordPtr - originX);
+ coordPtr[1] = originY + scaleY*(coordPtr[1] - originY);
+ }
+ if (edgePtr->firstArrowPtr != NULL) {
+ for (i = 0, coordPtr = edgePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ coordPtr[0] = originX + scaleX*(coordPtr[0] - originX);
+ coordPtr[1] = originY + scaleY*(coordPtr[1] - originY);
+ }
+ }
+ if (edgePtr->lastArrowPtr != NULL) {
+ for (i = 0, coordPtr = edgePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ coordPtr[0] = originX + scaleX*(coordPtr[0] - originX);
+ coordPtr[1] = originY + scaleY*(coordPtr[1] - originY);
+ }
+ }
+ ComputeEdgeBbox(canvas, edgePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateEdge --
+ *
+ * This procedure is called to move a edge by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the edge is offset by (xDelta, yDelta), and
+ * the bounding box is updated in the generic part of the item
+ * structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateEdge(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. */
+{
+ EdgeItem *edgePtr = (EdgeItem *) itemPtr;
+ double *coordPtr;
+ int i;
+
+ for (i = 0, coordPtr = edgePtr->coordPtr; i < edgePtr->numPoints;
+ i++, coordPtr += 2) {
+ coordPtr[0] += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ if (edgePtr->firstArrowPtr != NULL) {
+ for (i = 0, coordPtr = edgePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ coordPtr[0] += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ }
+ if (edgePtr->lastArrowPtr != NULL) {
+ for (i = 0, coordPtr = edgePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ coordPtr[0] += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ }
+ ComputeEdgeBbox(canvas, edgePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ParseArrowShape --
+ *
+ * This procedure is called back during option parsing to
+ * parse arrow shape information.
+ *
+ * Results:
+ * The return value is a standard Tcl result: TCL_OK means
+ * that the arrow shape information was parsed ok, and
+ * TCL_ERROR means it couldn't be parsed.
+ *
+ * Side effects:
+ * Arrow information in recordPtr is updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ParseArrowShape(clientData, interp, tkwin, value, recordPtr, offset)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Window tkwin; /* Not used. */
+ char *value; /* Textual specification of arrow shape. */
+ char *recordPtr; /* Pointer to item record in which to
+ * store arrow information. */
+ int offset; /* Offset of shape information in widget
+ * record. */
+{
+ EdgeItem *edgePtr = (EdgeItem *) recordPtr;
+ double a, b, c;
+ int argc;
+ char **argv = NULL;
+
+ if (offset != Tk_Offset(EdgeItem, arrowShapeA)) {
+ panic("ParseArrowShape received bogus offset");
+ }
+
+ if (Tcl_SplitList(interp, value, &argc, &argv) != TCL_OK) {
+ syntaxError:
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad arrow shape \"", value,
+ "\": must be list with three numbers", (char *) NULL);
+ if (argv != NULL) {
+ ckfree((char *) argv);
+ }
+ return TCL_ERROR;
+ }
+ if (argc != 3) {
+ goto syntaxError;
+ }
+ if ((Tk_CanvasGetCoord(interp, edgePtr->canvas, argv[0], &a) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, edgePtr->canvas, argv[1], &b) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, edgePtr->canvas, argv[2], &c) != TCL_OK)) {
+ goto syntaxError;
+ }
+ edgePtr->arrowShapeA = a;
+ edgePtr->arrowShapeB = b;
+ edgePtr->arrowShapeC = c;
+ ckfree((char *) argv);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PrintArrowShape --
+ *
+ * This procedure is a callback invoked by the configuration
+ * code to return a printable value describing an arrow shape.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+PrintArrowShape(clientData, tkwin, recordPtr, offset, freeProcPtr)
+ ClientData clientData; /* Not used. */
+ Tk_Window tkwin; /* Window associated with edgePtr's widget. */
+ char *recordPtr; /* Pointer to item record containing current
+ * shape information. */
+ int offset; /* Offset of arrow information in record. */
+ Tcl_FreeProc **freeProcPtr;/* Store address of procedure to call to
+ * free string here. */
+{
+ EdgeItem *edgePtr = (EdgeItem *) recordPtr;
+ char *buffer;
+
+ buffer = ckalloc(120);
+ sprintf(buffer, "%.5g %.5g %.5g", edgePtr->arrowShapeA,
+ edgePtr->arrowShapeB, edgePtr->arrowShapeC);
+ *freeProcPtr = (Tcl_FreeProc *) free;
+ return buffer;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureArrows --
+ *
+ * If arrowheads have been requested for a edge, this
+ * procedure makes arrangements for the arrowheads.
+ *
+ * Results:
+ * A standard Tcl return value. If an error occurs, then
+ * an error message is left in interp->result.
+ *
+ * Side effects:
+ * Information in edgePtr is set up for one or two arrowheads.
+ * the firstArrowPtr and lastArrowPtr polygons are allocated
+ * and initialized, if need be, and the end points of the edge
+ * are adjusted so that a thick edge doesn't stick out past
+ * the arrowheads.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConfigureArrows(canvas, edgePtr)
+ Tk_Canvas canvas; /* Canvas in which arrows will be
+ * displayed (interp and tkwin
+ * fields are needed). */
+ EdgeItem *edgePtr; /* Item to configure for arrows. */
+{
+ double *poly, *coordPtr;
+ double dx, dy, length, sinTheta, cosTheta, temp, shapeC;
+ double fracHeight; /* Edge width as fraction of
+ * arrowhead width. */
+ double backup; /* Distance to backup end points
+ * so the edge ends in the middle
+ * of the arrowhead. */
+ double vertX, vertY; /* Position of arrowhead vertex. */
+
+ /*
+ * If there's an arrowhead on the first point of the edge, compute
+ * its polygon and adjust the first point of the edge so that the
+ * edge doesn't stick out past the leading edge of the arrowhead.
+ */
+
+ shapeC = edgePtr->arrowShapeC + edgePtr->width/2.0;
+ fracHeight = (edgePtr->width/2.0)/shapeC;
+ backup = fracHeight*edgePtr->arrowShapeB
+ + edgePtr->arrowShapeA*(1.0 - fracHeight)/2.0;
+ if (edgePtr->arrow != lastUid) {
+ poly = edgePtr->firstArrowPtr;
+ if (poly == NULL) {
+ poly = (double *) ckalloc((unsigned)
+ (2*PTS_IN_ARROW*sizeof(double)));
+ poly[0] = poly[10] = edgePtr->coordPtr[0];
+ poly[1] = poly[11] = edgePtr->coordPtr[1];
+ edgePtr->firstArrowPtr = poly;
+ }
+ dx = poly[0] - edgePtr->coordPtr[2];
+ dy = poly[1] - edgePtr->coordPtr[3];
+ length = hypot(dx, dy);
+ if (length == 0) {
+ sinTheta = cosTheta = 0.0;
+ } else {
+ sinTheta = dy/length;
+ cosTheta = dx/length;
+ }
+ vertX = poly[0] - edgePtr->arrowShapeA*cosTheta;
+ vertY = poly[1] - edgePtr->arrowShapeA*sinTheta;
+ temp = shapeC*sinTheta;
+ poly[2] = poly[0] - edgePtr->arrowShapeB*cosTheta + temp;
+ poly[8] = poly[2] - 2*temp;
+ temp = shapeC*cosTheta;
+ poly[3] = poly[1] - edgePtr->arrowShapeB*sinTheta - temp;
+ poly[9] = poly[3] + 2*temp;
+ poly[4] = poly[2]*fracHeight + vertX*(1.0-fracHeight);
+ poly[5] = poly[3]*fracHeight + vertY*(1.0-fracHeight);
+ poly[6] = poly[8]*fracHeight + vertX*(1.0-fracHeight);
+ poly[7] = poly[9]*fracHeight + vertY*(1.0-fracHeight);
+
+ /*
+ * Polygon done. Now move the first point towards the second so
+ * that the corners at the end of the edge are inside the
+ * arrowhead.
+ */
+
+ edgePtr->coordPtr[0] = poly[0] - backup*cosTheta;
+ edgePtr->coordPtr[1] = poly[1] - backup*sinTheta;
+ }
+
+ /*
+ * Similar arrowhead calculation for the last point of the edge.
+ */
+
+ if (edgePtr->arrow != firstUid) {
+ coordPtr = edgePtr->coordPtr + 2*(edgePtr->numPoints-2);
+ poly = edgePtr->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];
+ edgePtr->lastArrowPtr = poly;
+ }
+ dx = poly[0] - coordPtr[0];
+ dy = poly[1] - coordPtr[1];
+ length = hypot(dx, dy);
+ if (length == 0) {
+ sinTheta = cosTheta = 0.0;
+ } else {
+ sinTheta = dy/length;
+ cosTheta = dx/length;
+ }
+ vertX = poly[0] - edgePtr->arrowShapeA*cosTheta;
+ vertY = poly[1] - edgePtr->arrowShapeA*sinTheta;
+ temp = shapeC*sinTheta;
+ poly[2] = poly[0] - edgePtr->arrowShapeB*cosTheta + temp;
+ poly[8] = poly[2] - 2*temp;
+ temp = shapeC*cosTheta;
+ poly[3] = poly[1] - edgePtr->arrowShapeB*sinTheta - temp;
+ poly[9] = poly[3] + 2*temp;
+ poly[4] = poly[2]*fracHeight + vertX*(1.0-fracHeight);
+ poly[5] = poly[3]*fracHeight + vertY*(1.0-fracHeight);
+ poly[6] = poly[8]*fracHeight + vertX*(1.0-fracHeight);
+ poly[7] = poly[9]*fracHeight + vertY*(1.0-fracHeight);
+ coordPtr[2] = poly[0] - backup*cosTheta;
+ coordPtr[3] = poly[1] - backup*sinTheta;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EdgeToPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * edge 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
+EdgeToPostscript(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. */
+{
+ register EdgeItem *edgePtr = (EdgeItem *) itemPtr;
+ char buffer[200];
+ char *style;
+
+ if (edgePtr->fgColor == NULL) {
+ return TCL_OK;
+ }
+
+ /*
+ * Generate a path for the edge's center-edge (do this differently
+ * for straight edges and smoothed edges).
+ */
+
+ if (!edgePtr->smooth) {
+ Tk_CanvasPsPath(interp, canvas, edgePtr->coordPtr, edgePtr->numPoints);
+ } else {
+ if (edgePtr->fillStipple == None) {
+ TkMakeBezierPostscript(interp, canvas, edgePtr->coordPtr, edgePtr->numPoints);
+ } else {
+ /*
+ * Special hack: Postscript printers don't appear to be able
+ * to turn a path drawn with "curveto"s into a clipping path
+ * without exceeding resource limits, so TkMakeBezierPostscript
+ * won't work for stippled curves. Instead, generate all of
+ * the intermediate points here and output them into the
+ * Postscript file with "edgeto"s instead.
+ */
+
+ double staticPoints[2*MAX_STATIC_POINTS];
+ double *pointPtr;
+ int numPoints;
+
+ numPoints = 1 + edgePtr->numPoints*edgePtr->splineSteps;
+ pointPtr = staticPoints;
+ if (numPoints > MAX_STATIC_POINTS) {
+ pointPtr = (double *) ckalloc((unsigned)
+ (numPoints * 2 * sizeof(double)));
+ }
+ numPoints = TkMakeBezierCurve(canvas, edgePtr->coordPtr,
+ edgePtr->numPoints,
+ edgePtr->splineSteps, (XPoint *) NULL,
+ pointPtr);
+ Tk_CanvasPsPath(interp, canvas, pointPtr, numPoints);
+ if (pointPtr != staticPoints) {
+ ckfree((char *) pointPtr);
+ }
+ }
+ }
+
+ /*
+ * Set other edge-drawing parameters and stroke out the edge.
+ */
+
+ sprintf(buffer, "%d setlinewidth\n", edgePtr->width);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ style = "0 setlinecap\n";
+ if (edgePtr->capStyle == CapRound) {
+ style = "1 setlinecap\n";
+ } else if (edgePtr->capStyle == CapProjecting) {
+ style = "2 setlinecap\n";
+ }
+ Tcl_AppendResult(interp, style, (char *) NULL);
+ style = "0 setlinejoin\n";
+ if (edgePtr->joinStyle == JoinRound) {
+ style = "1 setlinejoin\n";
+ } else if (edgePtr->joinStyle == JoinBevel) {
+ style = "2 setlinejoin\n";
+ }
+ Tcl_AppendResult(interp, style, (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, edgePtr->fgColor) != TCL_OK) {
+ return TCL_ERROR;
+ };
+ if (edgePtr->fillStipple != None) {
+ if (Tk_CanvasPsStipple(interp, canvas, edgePtr->fillStipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "stroke\n", (char *) NULL);
+ }
+
+ /*
+ * Output polygons for the arrowheads, if there are any.
+ */
+
+ if (edgePtr->firstArrowPtr != NULL) {
+ if (ArrowheadPostscript(interp, canvas, edgePtr, edgePtr->firstArrowPtr) !=
+ TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (edgePtr->lastArrowPtr != NULL) {
+ if (ArrowheadPostscript(interp, canvas, edgePtr, edgePtr->lastArrowPtr) !=
+ TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArrowheadPostscript --
+ *
+ * This procedure is called to generate Postscript for
+ * an arrowhead for a edge 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ArrowheadPostscript(interp, canvas, edgePtr, arrowPtr)
+ Tcl_Interp *interp; /* Leave Postscript or error message
+ * here. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ EdgeItem *edgePtr; /* Edge item for which Postscript is
+ * being generated. */
+ double *arrowPtr; /* Pointer to first of five points
+ * describing arrowhead polygon. */
+{
+ Tk_CanvasPsPath(interp, canvas, arrowPtr, PTS_IN_ARROW);
+ if (edgePtr->fillStipple != None) {
+ if (Tk_CanvasPsStipple(interp, canvas, edgePtr->fillStipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ return TCL_OK;
+}
diff --git a/libgui/src/tkCanvLayout.c b/libgui/src/tkCanvLayout.c
new file mode 100644
index 00000000000..27af59d08bf
--- /dev/null
+++ b/libgui/src/tkCanvLayout.c
@@ -0,0 +1,2680 @@
+/*
+ * Copyright (c) 1993 by Sven Delmas
+ * All rights reserved.
+ * See the file COPYRIGHT for the copyright notes.
+ *
+ */
+
+/* renamed from layout.c to tkCanvLayout.c by Will Taylor 09nov95 */
+/* converted to Tk4.1 by Will Taylor 05may96 */
+
+#ifdef HAVE_CONFIG_H
+#include <config.h>
+#endif
+#ifdef HAVE_UNISTD_H
+#include <unistd.h>
+#endif
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <time.h>
+#include <string.h>
+#include <tcl.h>
+#include "tkCanvLayout.h"
+
+#if defined (__MSVC__) && ! defined (HAVE_RAND)
+#define HAVE_RAND
+#endif
+
+/*
+ * Functions to compute random numbers. These don't have to be
+ * particular good random number generators.
+ */
+#ifdef HAVE_RANDOM
+#define RANDOM random ()
+#define SRANDOM srandom
+#else /* HAVE_RANDOM */
+#ifdef HAVE_DRAND48
+#define MY_RAND_MAX 65536
+#define RANDOM ((long) (drand48 () * MY_RAND_MAX))
+#define SRANDOM srand48
+#else /* HAVE_DRAND48 */
+#ifdef HAVE_RAND
+#define RANDOM rand ()
+#define SRANDOM srand
+#else
+#warning no random number generator specified, default: random, srandom
+#define HAVE_RANDOM
+#define RANDOM random ()
+#define SRANDOM srandom
+#endif /* HAVE_RAND */
+#endif /* HAVE_DRAND48 */
+#endif /* HAVE_RANDOM */
+
+#define LAYOUT_OK TCL_OK
+#define LAYOUT_ERROR TCL_ERROR
+
+/*
+ * This value is added to the line length in pixels, so the distance
+ * between two nodes can be calculated correctly.
+ */
+#define LINE_INCREMENT 10
+
+/*
+ * Turn on/off debugging.
+ */
+#define DEBUGGING 1
+#define DEBUG_LAYOUT 0
+#define DEBUG_PLACE 0
+#define TESTING 0
+
+/*
+ * the datastructures used for layouting.
+ */
+
+/*
+ * these datas/variables are used by the tree layouter.
+ */
+
+struct TreeData {
+ double tmpX; /* A temporary x position. */
+ double tmpY; /* A temporary y position. */
+};
+typedef struct TreeData TreeData;
+
+#define TREE_TMP_X_POS(node) (node)->treeData.tmpX
+#define SET_TREE_TMP_X_POS(node,pos) (node)->treeData.tmpX = (pos)
+#define TREE_TMP_Y_POS(node) (node)->treeData.tmpY
+#define SET_TREE_TMP_Y_POS(node,pos) (node)->treeData.tmpY = (pos)
+
+#if DEBUGGING
+#define DEBUG_PRINT_TREE_NODE_POS(node, s) TkCanvLayoutDebugging(node, s, 1)
+#else
+#define DEBUG_PRINT_TREE_NODE_POS(node, s)
+#endif
+
+
+/*
+ * A topologically ordered node. stored in the global array toplist
+ * (0 to toplistnum).
+ */
+struct Topology {
+ struct Nodes *nodePtr;
+};
+typedef struct Topology Topology;
+
+/*
+Define edge information
+*/
+
+struct Edge {
+ pItem edgeid; /* edge identifier */
+ ItemGeom info;
+ struct Nodes* fromNode; /* A pointer to the ``from'' node struct. */
+ struct Nodes* toNode; /* A pointer to the ``to'' node struct. */
+ int ignore; /* Ignore this edge. */
+ int visited; /* This edge was visited. */
+};
+typedef struct Edge Edge;
+
+/*
+ * A graph node. stored in a global array named nodes
+ * (0 to nodenum).
+ */
+struct Nodes {
+ pItem itemPtr; /* Pointer to the Node dual. */
+ ItemGeom info; /* bounding box of the dual */
+ int ignore; /* Ignore this node. */
+ int visited; /* This node was already */
+ /* visited/layouted. */
+ double x; /* The calculated x position. */
+ double y; /* The calculated y position. */
+ int parentNum; /* The number of parent nodes. */
+ Edge** parent; /* The array of parent nodes. */
+ int succNum; /* The number of successor nodes. */
+ Edge** succ; /* The array of successor nodes. */
+ struct TreeData treeData; /* temporary tree layout nodes */
+#if 0
+ char *data; /* Special data attached to */
+ /* this node. The contents */
+ /* depend from the layouting */
+ /* algorithms. */
+#endif
+};
+typedef struct Nodes Nodes;
+typedef struct Nodes Node;
+
+/*
+ * Defines that hide internal functionality.
+ */
+
+/*
+ * Get and set the edge ignore flag. Edges which are ignored will not
+ * be traversed. The first parameter is the edge, and the second
+ * parameter (if you call the setting) is the new value of the
+ * ignore flag.
+ */
+#define IGNORE_EDGE(edge) (edge)->ignore
+#define SET_IGNORE_EDGE(edge,mode) (edge)->ignore=mode
+
+/*
+ * Get and set the edge visited flag. This flag is usually set to true
+ * when the edge was visited. The first parameter is the edge, and the
+ * second parameter (if you call the setting) is the new value of the
+ * visited flag.
+ */
+#define VISITED_EDGE(edge) (edge)->visited
+#define SET_VISITED_EDGE(edge,mode) (edge)->visited=mode
+
+/*
+ * Get and set the node ignore flag. Nodes which are ignored will not
+ * be traversed, and they are not placed/layouted. The first parameter
+ * is the node, and the second parameter (if you call the setting) is
+ * the new value of the ignore flag.
+ */
+#define IGNORE_NODE(node) (node)->ignore
+#define SET_IGNORE_NODE(node,mode) (node)->ignore=mode
+#define RESET_IGNORE_NODE(i) for (i = 0; i < THIS(nodeNum); i++) nodes[i]->ignore=0;
+
+/*
+ * Get and set the node visited flag. This flag is usually set to true
+ * when the node was visited. Currently this flag is mainly used for the
+ * topological sorting. The first parameter is the node, and the
+ * second parameter (if you call the setting) is the new value of the
+ * visited flag.
+ */
+#define VISITED_NODE(node) (node)->visited
+#define SET_VISITED_NODE(node,mode) (node)->visited=mode
+#define RESET_VISITED_NODE(i) for (i = 0; i < THIS(nodeNum); i++) THIS(nodes)[i]->visited=0;
+
+/*
+ * Get and set the number of parent nodes. The first parameter is the
+ * node, and the second parameter (if you call the setting) is the new
+ * number of parents.
+ */
+#define PARENT_NUM(node) (node)->parentNum
+#define SET_PARENT_NUM(node,num) (node)->parentNum=num
+
+/*
+ * Get and set the number of successor nodes. The first parameter is
+ * the node, and the second parameter (if you call the setting) is the
+ * new number of successors.
+ */
+#define SUCC_NUM(node) (node)->succNum
+#define SET_SUCC_NUM(node,num) (node)->succNum=num
+
+/*
+ * Get and set the node item. This item is the corresponding dual
+ * item for this node. The first parameter is the node, and the second
+ * parameter (if you call the setting) is the new dual item pointer.
+ */
+#define NODE_ITEM(node) (node)->itemPtr
+#define SET_NODE_ITEM(node,item) (node)->itemPtr=item
+
+/* Get and set the node x1,x2,y1, and y2 positions. */
+#define NODE_X1_POS(node) (node)->info.x1
+#define NODE_Y1_POS(node) (node)->info.y1
+#define NODE_X2_POS(node) (node)->info.x2
+#define NODE_Y2_POS(node) (node)->info.y2
+
+#define SET_NODE_X1_POS(node,v) (node)->info.x1 = (v)
+#define SET_NODE_Y1_POS(node,v) (node)->info.y1 = (v)
+#define SET_NODE_X2_POS(node,v) (node)->info.x2 = (v)
+#define SET_NODE_Y2_POS(node,v) (node)->info.y2 = (v)
+
+/* Get, by calculation, the node's width and height */
+#define CALC_NODE_HEIGHT(n) (NODE_Y2_POS(n) - NODE_Y1_POS(n))
+#define CALC_NODE_WIDTH(n) (NODE_X2_POS(n) - NODE_X1_POS(n))
+
+/* Get/Set the node dual geom */
+#define NODE_GEOM(node) (node)->info
+#define SET_NODE_GEOM(node,inf) (node)->info = (inf)
+
+/*
+ * Get and set the node x position. This is the value for the final
+ * placing of the node. The first parameter is the node, and the
+ * second parameter (if you call the setting) is the new x position.
+ */
+#define NODE_X_POS(node) (node)->x
+#define SET_NODE_X_POS(node,pos) (node)->x=pos
+
+/*
+ * Get and set the node y position. This is the value for the final
+ * placing of the node. The first parameter is the node, and the
+ * second parameter (if you call the setting) is the new y position.
+ */
+#define NODE_Y_POS(node) (node)->y
+#define SET_NODE_Y_POS(node,pos) (node)->y=pos
+
+/*
+ * Get and set the nodes width. The parameter specifies the node
+ * whose width and height will be returned.
+ */
+#define NODE_WIDTH(node) (node)->info.width
+#define SET_NODE_WIDTH(node,size) (node)->info.width=size
+
+/*
+ * Get and set the nodes height. The parameter specifies the node
+ * whose width and height will be returned.
+ */
+#define NODE_HEIGHT(node) (node)->info.height
+#define SET_NODE_HEIGHT(node,size) (node)->info.height=size
+
+#define EDGE_ITEM(edge) (edge)->edgeid
+#define SET_EDGE_ITEM(edge,item) (edge)->edgeid=item
+
+/*
+ * Return the parent/successor edge/node for the specified node. The
+ * second parameter is a integer counter that is used as index for the
+ * parent/successor array. Usually this index is generated by a
+ * FOR_ALL_* macro.
+ */
+#define PARENT_EDGE(node, i) (node)->parent[i]
+#define PARENT_NODE(node, i) (node)->parent[i]->fromNode
+#define PARENT_ID(node, i) (node)->parent[i]->edgeid
+#define SUCC_EDGE(node, i) (node)->succ[i]
+#define SUCC_NODE(node, i) (node)->succ[i]->toNode
+#define SUCC_ID(node, i) (node)->succ[i]->edgeid
+#define DUMMY_NODE(node) ((node)->itemPtr == (pItem) NULL)
+
+/* Get and set the edge x1,x2,y1, and y2 positions. */
+#define EDGE_X1_POS(edge) (edge)->info.x1
+#define EDGE_X2_POS(edge) (edge)->info.x2
+#define EDGE_Y1_POS(edge) (edge)->info.y1
+#define EDGE_Y2_POS(edge) (edge)->info.y2
+
+/* Get/Set the edge dual geom */
+#define EDGE_GEOM(edge) (edge)->info
+#define SET_EDGE_GEOM(edge,inf) (edge)->info = inf
+
+/*
+ * Return the node specified by the integer counter passed to this
+ * macro. The nodes in the array are topologically ordered (beginning
+ * with the index 0. The index is usually created by the macro
+ * FOR_ALL_TOP_NODES.
+ */
+#define TOP_NODE(i) THIS(topList)[i]->nodePtr
+
+/*
+ * Walk through all nodes that are currently defined. The only
+ * parameter is the integer counter that is used to index the array.
+ */
+#define FOR_ALL_NODES(i) for (i = 0; i < THIS(nodeNum); i++)
+
+/*
+ * Walk through all edges that are currently defined. The only
+ * parameter is the integer counter that is used to index the array.
+ */
+#define FOR_ALL_EDGES(i) for (i = 0; i < THIS(edgeNum); i++)
+
+/*
+ * Walk through all parents/successors of the specified node. The
+ * second parameter is the integer counter that is used to index the
+ * array.
+ */
+#define FOR_ALL_PARENTS(node, i) for (i = 0; i < (node)->parentNum; i++)
+#define FOR_ALL_SUCCS(node, i) for (i = 0; i < (node)->succNum; i++)
+
+/*
+ * Walk through all nodes in topological order. The only parameter is
+ * the integer counter that is used to index the array. This call
+ * requires a call of the topological order function, before it can be
+ * used.
+ */
+#define FOR_ALL_TOP_NODES(i) for (i = 0; i < THIS(topListNum); i++)
+
+/*
+ * DEBUGGING MACROS.
+ */
+#if DEBUGGING
+#define DEBUG_PRINT_NODE_POS(GRAPH, NODE, S) LayoutDebugging(GRAPH, NODE, S, 0)
+#define DEBUG_PRINT_STRING(S1, S2) fprintf(stderr, "%s %s<\n", S2, S1);
+#else
+#define DEBUG_PRINT_NODE_POS(GRAPH, NODE, S)
+#define DEBUG_PRINT_STRING(S1, S2)
+#endif
+
+
+#define THIS(x) This->x
+
+struct Layout_Graph {
+ /* Start with user settable configuration items */
+ long iconSpaceV; /* The vertical space between icons. */
+ long iconSpaceH; /*The horizontal space between icons.*/
+ int graphOrder; /* Ordering... 0 = LR, 1 = TD. */
+ Node *rootNode; /* The root node. */
+ long xOffset; /* The x offset for the placing. */
+ long yOffset; /* The y offset for the placing. */
+
+ /*
+ * These datas/variables are used by the random layouter.
+ */
+ int keepRandomPositions; /* Don't change the position of */
+ /* already placed icons when */
+ /* layouting with the random */
+ /* placer. */
+ long maxX, maxY; /* Maximal X and Y coordinates */
+ /* for the random placer. */
+ /*
+ * Misc. variables used for layouting.
+ */
+
+ int nodeNum; /* The number of graph nodes. */
+ Node** nodes; /* The list of graph nodes. */
+ int edgeNum; /* The number of graph edges. */
+ Edge** edges; /* The list of graph edges. */
+ int topListNum; /* The current node number. */
+ Topology **topList; /* The sorted nodes. */
+ int computeiconsize; /* Use the biggest icon size. */
+ int elementsPerLine; /* How many elements per line. */
+ int hideEdges; /* make edges zero length (Matrix)*/
+ int edgeHeight; /* The standard height of an edge. */
+ int edgeOrder; /* Set the edges to the layout order.*/
+ int edgeWidth; /* The standard width of an edge. */
+ int iconHeight, iconWidth; /* The standard icon size. */
+ double posX1, posY1, posX2, posY2; /* Coordinates */
+ double maxXPosition; /* Maximal X and Y coordinates */
+ double maxYPosition; /* for the random placer. */
+ int layoutTypesNum; /* The number of layout types. */
+ char **layoutTypes; /* The types of items that will
+ be layouted. */
+ int gridlock; /* avoid using diagnal lines */
+ char* errmsg;
+
+#ifdef ignore
+ char* graphName
+ char *idlist; /* The list of ids to layout. */
+ char *sortcommand; /* The Tcl procedure called for */
+ long rootId;
+ char convertBuffer[100]; /* Convert numbers to strings.*/
+#endif
+};
+
+typedef struct Layout_Graph Layout_Graph;
+
+static int deleteedge _ANSI_ARGS_((Layout_Graph*,Edge*,int));
+static int deletenode _ANSI_ARGS_((Layout_Graph*,Node*,int));
+static void compress_succ _ANSI_ARGS_((Layout_Graph*,Node*));
+static void compress_parent _ANSI_ARGS_((Layout_Graph*,Node*));
+
+static void LayoutISISetX _ANSI_ARGS_((Layout_Graph*, Node*));
+static void LayoutISISetY _ANSI_ARGS_((Layout_Graph*, Node*/*, int type*/));
+static void LayoutTreeSetX _ANSI_ARGS_((Layout_Graph*, Node*));
+static void LayoutTreeSetY _ANSI_ARGS_((Layout_Graph*, Node*));
+static int LayoutBuildGraph _ANSI_ARGS_((Layout_Graph*));
+static Node* LayoutGraphRoot _ANSI_ARGS_((Layout_Graph*));
+static void LayoutGraphSortTopological _ANSI_ARGS_((Layout_Graph*, Node*));
+static int LayoutGraphPlaceNodes _ANSI_ARGS_((Layout_Graph*));
+static int LayoutGraphPlaceEdges _ANSI_ARGS_((Layout_Graph*));
+static int LayoutEdgeWidth _ANSI_ARGS_((Layout_Graph*));
+static int LayoutEdge _ANSI_ARGS_((Layout_Graph*, Edge*, Node*, Node*));
+
+#if(defined(__cplusplus) || defined(c_plusplus))
+#define AC1(t1,a1) (t1 a1)
+#define AC2(t1,a1,t2,a2) (t1 a1, t2 a2)
+#define AC3(t1,a1,t2,a2,t3,a3) (t1 a1, t2 a2, t3 a3)
+#define AC4(t1,a1,t2,a2,t3,a3,t4,a4) (t1 a1, t2 a2, t3 a3, t4 a4)
+#define AC5(t1,a1,t2,a2,t3,a3,t4,a4,t5,a5) (t1 a1, t2 a2, t3 a3, t4 a4, t5 a5)
+#else
+#define AC1(t1,a1) (a1) t1 a1;
+#define AC2(t1,a1,t2,a2) (a1,a2) t1 a1; t2 a2;
+#define AC3(t1,a1,t2,a2,t3,a3) (a1,a2,a3) t1 a1; t2 a2; t3 a3;
+#define AC4(t1,a1,t2,a2,t3,a3,t4,a4) (a1,a2,a3,a4) t1 a1; t2 a2; t3 a3; t4 a4;
+#define AC5(t1,a1,t2,a2,t3,a3,t4,a4,t5,a5) (a1,a2,a3,a4,a5) t1 a1; t2 a2; t3 a3; t4 a4; t5 a5;
+#endif
+
+static
+void
+MY_LayoutISISetY _ANSI_ARGS_((Layout_Graph*, Node*, double));
+
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LayoutDebugging --
+ *
+ * This procedure is invoked to print debugging informations.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+#if DEBUGGING
+void
+LayoutDebugging(
+ Layout_Graph* This,
+ Node *currentNode, /* This is the current node. */
+ char *string,
+ int type)
+{
+ double tmpX, tmpY;
+
+ if(THIS(graphOrder)) {
+ /* Place nodes top down. */
+ tmpX = THIS(xOffset) - NODE_HEIGHT(THIS(rootNode));
+ tmpY = THIS(yOffset) - NODE_WIDTH(THIS(rootNode));
+ } else {
+ /* Place nodes left to right. */
+ tmpX = THIS(xOffset) - NODE_WIDTH(THIS(rootNode));
+ tmpY = THIS(yOffset) - NODE_HEIGHT(THIS(rootNode));
+ }
+
+ if(!DUMMY_NODE(currentNode)) {
+ fprintf(stderr, "%-6s Node %-3ld: x=%-g y=%-g x=%-g y=%-g\n",
+ /* string, CANVAS_ITEM_ID(NODE_ITEM(currentNode)), 08nov95 wmt */
+ string, 0L,
+ NODE_X_POS(currentNode) + tmpX,
+ NODE_Y_POS(currentNode) + tmpY,
+ NODE_X_POS(currentNode),
+ NODE_Y_POS(currentNode));
+ } else {
+ fprintf(stderr, "%-6s Node dummy: x=%-g y=%-g x=%-g y=%-g\n",
+ string, NODE_X_POS(currentNode) + tmpX,
+ NODE_Y_POS(currentNode) + tmpY,
+ NODE_X_POS(currentNode),
+ NODE_Y_POS(currentNode));
+ }
+ switch (type) {
+ case 1:
+ fprintf(stderr,
+ " x=%-g y=%-g x=%-g y=%-g\n",
+ TREE_TMP_X_POS(currentNode) + tmpX,
+ TREE_TMP_Y_POS(currentNode) + tmpY,
+ TREE_TMP_X_POS(currentNode),
+ TREE_TMP_Y_POS(currentNode));
+ break;
+ default:
+ break;
+ }
+}
+#endif
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LayoutISISetX --
+ *
+ * This procedure is invoked to calculate the x ISI position.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+#ifndef max
+#define max(a,b) ((a) > (b) ? (a) : (b))
+#define min(a,b) ((a) > (b) ? (b) : (a))
+#endif
+static
+void
+LayoutISISetX AC2(Layout_Graph*,This, Node*,currentNode) /* This is the current node. */
+{
+ int counter, visitedAllChilds = 1;
+
+ if(IGNORE_NODE(currentNode)) {
+ return;
+ }
+ if(VISITED_NODE(currentNode)) {
+ return;
+ }
+
+ FOR_ALL_SUCCS(currentNode, counter) {
+ /* Are there un layouted children ? */
+ if(IGNORE_EDGE(SUCC_EDGE(currentNode, counter))) {
+ continue;
+ }
+ if(IGNORE_NODE(SUCC_NODE(currentNode, counter))) {
+ continue;
+ }
+ if(!VISITED_NODE(SUCC_NODE(currentNode, counter))) {
+ visitedAllChilds = 0;
+ }
+ }
+
+/* SET_VISITED_NODE(currentNode, 1);*/
+ if(!visitedAllChilds) {
+ FOR_ALL_SUCCS(currentNode, counter) {
+ /* Layout the children of this node. */
+ if(IGNORE_EDGE(SUCC_EDGE(currentNode, counter))) {
+ continue;
+ }
+ if(IGNORE_NODE(SUCC_NODE(currentNode, counter))) {
+ continue;
+ }
+ if(!VISITED_NODE(SUCC_NODE(currentNode, counter))) {
+ LayoutISISetX(This,SUCC_NODE(currentNode, counter));
+ }
+ }
+ if(SUCC_NUM(currentNode) == 1) {
+ SET_NODE_X_POS(currentNode,
+ NODE_X_POS(SUCC_NODE(currentNode, 0)));
+ }
+ else
+ {
+
+ /* Khamis 8:30 23 Oct 1996 */
+ int i, pingo = 0;
+ double x1 = 0.0, x2 = 0.0;
+ FOR_ALL_SUCCS (currentNode, i)
+ {
+ if(IGNORE_NODE(SUCC_NODE(currentNode, i)))
+ continue;
+ /*
+ if(! VISITED_NODE(SUCC_NODE(currentNode, i)))
+ continue;
+ */
+ if (PARENT_NODE(SUCC_NODE(currentNode, i), 0) !=
+ currentNode)
+ continue;
+ if (! pingo)
+ {
+ x1 = NODE_X_POS(SUCC_NODE(currentNode, i));
+ pingo = 1;
+ }
+ x1 = min (x1, NODE_X_POS(SUCC_NODE(currentNode, i)));
+ x2 = max (x2, NODE_X_POS(SUCC_NODE(currentNode, i)));
+ }
+ if (! pingo)
+ {
+ x1 = x2 = NODE_X_POS (SUCC_NODE(currentNode, 0));
+ }
+
+#if 1 /* Khamis 8:30 23 Oct 1996 */
+ SET_NODE_X_POS(currentNode, x1 + (x2 - x1) / 2.0);
+#else /* original */
+ SET_NODE_X_POS(currentNode,
+ NODE_X_POS(SUCC_NODE(currentNode, 0)) +
+ ((NODE_X_POS(SUCC_NODE(currentNode,
+ SUCC_NUM(currentNode)-1)) -
+ NODE_X_POS(SUCC_NODE(currentNode, 0))) / 2));
+#endif
+ }
+ }
+ else
+ {
+ /* Set the x position of the current node. */
+ if(THIS(graphOrder)) {
+ /* Place nodes top down. */
+ SET_NODE_X_POS(currentNode, THIS(maxXPosition));
+ THIS(maxXPosition) = NODE_X_POS(currentNode) + THIS(iconSpaceH) +
+ THIS(edgeWidth) + NODE_WIDTH(currentNode);
+ } else {
+ /* Place nodes left to right. */
+ SET_NODE_X_POS(currentNode, THIS(maxXPosition));
+ THIS(maxXPosition) = NODE_X_POS(currentNode) + THIS(iconSpaceV) +
+ THIS(edgeHeight) + NODE_HEIGHT(currentNode);
+ }
+ }
+ SET_VISITED_NODE(currentNode, 1);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LayoutISISetY --
+ *
+ * This procedure is invoked to calculate the y ISI position.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static
+void
+LayoutISISetY AC2(Layout_Graph*,This, Node*,currentNode) /* This is the current node. */
+{
+ int counter;
+ double tmpMaxY;
+
+ /* Was this node already layouted ? */
+ if(IGNORE_NODE(currentNode)) {
+ return;
+ }
+ if(VISITED_NODE(currentNode)) {
+ return;
+ }
+
+ SET_VISITED_NODE(currentNode, 1);
+
+ if(PARENT_NUM(currentNode) != 0) {
+ FOR_ALL_PARENTS(currentNode, counter) {
+ /* Are there un layouted parents ? */
+ if(IGNORE_EDGE(PARENT_EDGE(currentNode, counter))) {
+ /*continue;*/
+ break;
+ }
+ if(IGNORE_NODE(PARENT_NODE(currentNode, counter))) {
+ /*continue;*/
+ break;
+ }
+ if(!VISITED_NODE(PARENT_NODE(currentNode, counter))) {
+ LayoutISISetY(This,PARENT_NODE(currentNode, counter));
+ }
+ break;
+ }
+ tmpMaxY = 0;
+ FOR_ALL_PARENTS(currentNode, counter) {
+ if(THIS(graphOrder)) {
+ if(NODE_Y_POS(PARENT_NODE(currentNode, counter)) +
+ NODE_HEIGHT(PARENT_NODE(currentNode, counter)) > tmpMaxY) {
+ tmpMaxY = NODE_Y_POS(PARENT_NODE(currentNode, counter)) +
+ NODE_HEIGHT(PARENT_NODE(currentNode, counter));
+ }
+ } else {
+ if(NODE_Y_POS(PARENT_NODE(currentNode, counter)) +
+ NODE_WIDTH
+ (PARENT_NODE(currentNode, counter)) > tmpMaxY) {
+ tmpMaxY = NODE_Y_POS(PARENT_NODE(currentNode, counter)) +
+ NODE_WIDTH(PARENT_NODE(currentNode, counter));
+ }
+ }
+ break;
+ }
+ if(THIS(graphOrder)) {
+ /* Place nodes top down. */
+ SET_NODE_Y_POS(currentNode, tmpMaxY + THIS(edgeHeight) + THIS(iconSpaceV));
+ } else {
+ /* Place nodes left to right. */
+ SET_NODE_Y_POS(currentNode, tmpMaxY + THIS(edgeWidth) + THIS(iconSpaceH));
+ }
+ } else {
+ if(THIS(graphOrder)) {
+ /* Place nodes top down. */
+ SET_NODE_Y_POS(currentNode, 0);
+ } else {
+ /* Place nodes left to right. */
+ SET_NODE_Y_POS(currentNode, 0);
+ }
+ }
+
+ /*SET_VISITED_NODE(currentNode, 1);*/
+}
+
+/*********************************************************/
+static
+void
+MY_LayoutISISetY AC3(Layout_Graph*,This, Node*,currentNode, double, y)
+{
+ int counter;
+ double tmpMaxY;
+
+ /* Was this node already layouted ? */
+ if(IGNORE_NODE(currentNode)) {
+ return;
+ }
+ if(VISITED_NODE(currentNode)) {
+ return;
+ }
+
+ SET_VISITED_NODE(currentNode, 1);
+
+ SET_NODE_Y_POS(currentNode, y);
+
+ FOR_ALL_SUCCS (currentNode, counter) {
+ /* Are there un layouted parents ? */
+ if(IGNORE_EDGE(PARENT_EDGE(currentNode, counter))) {
+ /*continue;*/
+ break;
+ }
+ if(IGNORE_NODE(PARENT_NODE(currentNode, counter))) {
+ /*continue;*/
+ break;
+ }
+
+ if (PARENT_NODE(SUCC_NODE(currentNode, counter), 0) !=
+ currentNode)
+ continue;
+
+ if(THIS(graphOrder)) {
+ tmpMaxY = NODE_Y_POS (currentNode) + NODE_HEIGHT (currentNode);
+ /*+ THIS(edgeHeight) + THIS(iconSpaceV); */
+ } else {
+ tmpMaxY = NODE_Y_POS(currentNode) +
+ NODE_WIDTH(currentNode) +
+ THIS(edgeWidth) + THIS(iconSpaceH);
+ }
+
+ MY_LayoutISISetY(This, PARENT_NODE(currentNode, counter),
+ tmpMaxY);
+ }
+}
+/*********************************************************/
+
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LayoutTreeSetX --
+ *
+ * This procedure is invoked to calculate the x tree position.
+ * The procedure is called for all icons in the topological
+ * order.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static
+void
+LayoutTreeSetX AC2(Layout_Graph*,This, Node*,currentNode) /* This is the current node */
+{
+ int counter;
+
+ /* Was this node already layouted ? */
+ if(TREE_TMP_X_POS(currentNode) != -1 || IGNORE_NODE(currentNode)) {
+ return;
+ }
+ if(DUMMY_NODE(currentNode)) {
+ return;
+ }
+
+ SET_VISITED_NODE(currentNode, 1);
+ if(PARENT_NUM(currentNode) > 0 &&
+ VISITED_NODE(PARENT_NODE(currentNode, 0))) {
+ /* There are parents, and the parent was already visited. This */
+ /* means that this node is the first child we layout at this */
+ /* level. That means it occurs at the same level as the parent. */
+ SET_VISITED_NODE(PARENT_NODE(currentNode, 0), 0);
+ SET_TREE_TMP_X_POS(currentNode,
+ TREE_TMP_X_POS(PARENT_NODE(currentNode, 0)));
+ } else {
+ /* Append the icon to the current maximal x position. It is not */
+ /* the first child of the parent. */
+ SET_TREE_TMP_X_POS(currentNode, THIS(maxXPosition));
+ }
+
+ /* Set the x position of the current node. If the order is top down, */
+ /* we use the maximum edge width. */
+ if(THIS(graphOrder)) {
+ /* Place nodes top down. */
+ SET_NODE_X_POS(currentNode, TREE_TMP_X_POS(currentNode));
+ /* Do we have a new maximal x position ? */
+ if(NODE_X_POS(currentNode) + THIS(iconSpaceH) + THIS(edgeWidth) +
+ NODE_WIDTH(currentNode) > THIS(maxXPosition)) {
+ THIS(maxXPosition) = NODE_X_POS(currentNode) + THIS(iconSpaceH) +
+ THIS(edgeWidth) + NODE_WIDTH(currentNode);
+ }
+ } else {
+ /* Place nodes left to right. */
+ SET_NODE_X_POS(currentNode, TREE_TMP_X_POS(currentNode));
+ /* Do we have a new maximal x position ? */
+ if((NODE_X_POS(currentNode) + THIS(iconSpaceV) + THIS(edgeHeight) +
+ NODE_HEIGHT(currentNode)) > THIS(maxXPosition)) {
+ THIS(maxXPosition) = NODE_X_POS(currentNode) + THIS(iconSpaceV) +
+ THIS(edgeHeight) + NODE_HEIGHT(currentNode);
+ }
+ }
+
+ /* Walk through all successors. */
+ FOR_ALL_SUCCS(currentNode, counter) {
+ /* Layout the children of this node. */
+ if(IGNORE_NODE(SUCC_EDGE(currentNode, counter))) {
+ continue;
+ }
+ LayoutTreeSetX(This,SUCC_NODE(currentNode, counter));
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LayoutTreeSetY --
+ *
+ * This procedure is invoked to calculate the y tree position.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static
+void
+LayoutTreeSetY AC2(Layout_Graph*,This, Node*,currentNode) /* This is the current node. */
+{
+ int counter;
+ double tmpMaxY;
+
+ if(IGNORE_NODE(currentNode)) {
+ return;
+ }
+ if(DUMMY_NODE(currentNode)) {
+ return;
+ }
+ if(VISITED_NODE(currentNode)) {
+ return;
+ }
+
+ SET_VISITED_NODE(currentNode, 1);
+ tmpMaxY = 0;
+ /* Walk through all parents. */
+ FOR_ALL_PARENTS(currentNode, counter) {
+ /* Find the parent of this node that has the greatest Y. This way */
+ /* the graph is always growing to the Y direction. */
+ if(IGNORE_NODE(PARENT_EDGE(currentNode, counter)) ||
+ IGNORE_NODE(PARENT_NODE(currentNode, counter))) {
+ continue;
+ }
+ if(THIS(graphOrder)) {
+ /* Place nodes top down. */
+ if(TREE_TMP_Y_POS(PARENT_NODE(currentNode, counter)) +
+ NODE_HEIGHT(PARENT_NODE(currentNode, counter)) +
+ THIS(edgeHeight) + THIS(iconSpaceV) > tmpMaxY) {
+ tmpMaxY = TREE_TMP_Y_POS(PARENT_NODE(currentNode, counter)) +
+ NODE_HEIGHT(PARENT_NODE(currentNode, counter)) + THIS(edgeHeight) +
+ THIS(iconSpaceV);
+ }
+ } else {
+ if(TREE_TMP_Y_POS(PARENT_NODE(currentNode, counter)) +
+ NODE_WIDTH(PARENT_NODE(currentNode, counter)) +
+ THIS(edgeWidth) + THIS(iconSpaceH) > tmpMaxY) {
+ tmpMaxY = TREE_TMP_Y_POS(PARENT_NODE(currentNode, counter)) +
+ NODE_WIDTH(PARENT_NODE(currentNode, counter)) + THIS(edgeWidth) +
+ THIS(iconSpaceH);
+ }
+ }
+ }
+
+ /* Set the y position of the current node. */
+ if(THIS(graphOrder)) {
+ /* Place nodes top down. */
+ SET_NODE_Y_POS(currentNode, tmpMaxY);
+ /* Keep the maximal y position, this way we can later calculate the */
+ /* correct Y position for children of this widget. */
+ SET_TREE_TMP_Y_POS(currentNode, NODE_Y_POS(currentNode));
+ } else {
+ /* Place nodes left to right. */
+ SET_NODE_Y_POS(currentNode, tmpMaxY);
+ /* Keep the maximal y position, this way we can later calculate the */
+ /* correct Y position for children of this widget. */
+ SET_TREE_TMP_Y_POS(currentNode, NODE_Y_POS(currentNode));
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * createnode --
+ *
+ * This procedure is invoked to create a new node. Optionally the
+ * procedure can be used to create dummy nodes. In that case the
+ * fromNode and toNode parameters are specified.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+LayoutCreateNode AC4(Layout_Graph*,This,pItem,itemPtr, pItem,fromNode, pItem, toNode)
+{
+ int counter1 = 0, counter2 = 0, counter3 = 0, counter4 = 0, found = 0;
+ Node *tmpNode;
+ Edge *tmpEdge;
+ ItemGeom bbox;
+
+ /* see if this item was already added */
+ FOR_ALL_NODES(counter1) {
+ if(NODE_ITEM(THIS(nodes)[counter1]) == itemPtr) {
+ THIS(errmsg) = "attempt to insert duplicate graph node";
+ return LAYOUT_ERROR;
+ }
+ }
+ THIS(nodeNum)++;
+ if(THIS(nodes) == NULL) {
+ THIS(nodes) = (Node **) ckalloc(THIS(nodeNum) * sizeof(Node *));
+ } else {
+ THIS(nodes) = (Node **) ckrealloc((char *) THIS(nodes),
+ THIS(nodeNum) * sizeof(Node *));
+ }
+ tmpNode = (Node *) ckalloc(sizeof(Node));
+ SET_NODE_ITEM(tmpNode, itemPtr);
+ SET_IGNORE_NODE(tmpNode, 0);
+ SET_VISITED_NODE(tmpNode, 0);
+ SET_NODE_X_POS(tmpNode, 0);
+ SET_NODE_Y_POS(tmpNode, 0);
+ SET_TREE_TMP_X_POS(tmpNode, -1);
+ SET_TREE_TMP_Y_POS(tmpNode, -1);
+ bbox.x1 = bbox.y1 = bbox.x2 = bbox.y2 = bbox.width = bbox.height = 0;
+ SET_NODE_GEOM(tmpNode,bbox);
+ SET_PARENT_NUM(tmpNode, 0);
+ tmpNode->parent = (Edge**) NULL;
+ SET_SUCC_NUM(tmpNode, 0);
+ tmpNode->succ = (Edge**) NULL;
+ THIS(nodes)[THIS(nodeNum)-1] = tmpNode;
+
+#if 0
+ /* create the specific data slot. */
+ if(createdatanode != NULL) {
+ (*createdatanode)(THIS(nodes)[THIS(nodeNum)-1]);
+ }
+#endif
+
+ /* insert the dummy node. */
+ if(fromNode != (Node*) NULL && toNode != (Node*) NULL) {
+ FOR_ALL_NODES(counter1) {
+ if(THIS(nodes)[counter1] == fromNode) {
+ FOR_ALL_SUCCS(THIS(nodes)[counter1], counter2) {
+ if(SUCC_NODE(THIS(nodes)[counter1], counter2) == toNode) {
+ found++;
+ break;
+ }
+ }
+ break;
+ }
+ }
+ FOR_ALL_NODES(counter3) {
+ if(THIS(nodes)[counter3] == toNode) {
+ FOR_ALL_PARENTS(THIS(nodes)[counter3], counter4) {
+ if(PARENT_NODE(THIS(nodes)[counter3], counter4) == fromNode) {
+ found++;
+ break;
+ }
+ }
+ break;
+ }
+ }
+ if(found == 2) {
+ DEBUG_PRINT_NODE_POS(This, THIS(nodes)[counter1], "dummy insert from");
+ DEBUG_PRINT_NODE_POS(This, THIS(nodes)[counter3], "dummy insert to");
+ SET_PARENT_NUM(tmpNode, 1);
+ SET_SUCC_NUM(tmpNode, 1);
+ SET_NODE_X_POS(tmpNode, 10);
+ SET_NODE_Y_POS(tmpNode, 10);
+ THIS(nodes)[THIS(nodeNum)-1]->parent = (Edge**)
+ ckalloc(THIS(nodes)[THIS(nodeNum)-1]->parentNum * sizeof(Edge*));
+ tmpEdge = (Edge* ) ckalloc(sizeof(Edge));
+ SET_IGNORE_EDGE(tmpEdge, 0);
+ SET_VISITED_EDGE(tmpEdge, 0);
+ tmpEdge->fromNode = THIS(nodes)[counter1];
+ tmpEdge->toNode = THIS(nodes)[counter3];
+ THIS(nodes)[THIS(nodeNum)-1]->parent[0] = tmpEdge;
+ THIS(nodes)[THIS(nodeNum)-1]->succ = (Edge**)
+ ckalloc(THIS(nodes)[THIS(nodeNum)-1]->succNum * sizeof(Edge* ));
+ THIS(nodes)[THIS(nodeNum)-1]->succ[0] = tmpEdge;
+ THIS(nodes)[counter3]->parent[counter4]->toNode = tmpNode;
+ THIS(nodes)[counter1]->succ[counter2]->fromNode = tmpNode;
+ }
+ }
+ return LAYOUT_OK;
+}
+
+int
+LayoutDeleteNode AC2(Layout_Graph*,This, pItem,nodeid)
+{
+ register int i;
+
+ /* find the matching node*/
+ FOR_ALL_NODES(i) {
+ if(NODE_ITEM(THIS(nodes)[i]) == nodeid) {
+ return deletenode(This,THIS(nodes)[i],i);
+ }
+ }
+ THIS(errmsg) = "node delete: no such node";
+ return LAYOUT_ERROR;
+}
+
+static
+int
+deletenode AC3(Layout_Graph*,This, Node*,thisnode, int,index)
+{
+ register int i;
+ /* remove all attached edges */
+ FOR_ALL_EDGES(i) {
+ register Edge* e = THIS(edges)[i];
+ if(e->toNode == thisnode
+ || e->fromNode == thisnode) {
+ deleteedge(This,e,i);
+ }
+ }
+
+ /* clean up node */
+ if(thisnode->parent) ckfree((char*)thisnode->parent);
+ if(thisnode->succ) ckfree((char*)thisnode->succ);
+
+ /* free and clear node */
+ THIS(nodeNum)--;
+ if(THIS(nodeNum) > 0) {
+ THIS(nodes)[index] = THIS(nodes)[THIS(nodeNum)];
+ }
+ ckfree((char*)thisnode);
+ return LAYOUT_OK;
+}
+
+
+int
+LayoutCreateEdge AC4(Layout_Graph*,This, pItem,edgeid, pItem,fromid, pItem,toid)
+{
+ register int i;
+ register Node* n;
+ Node* fromnode = NULL;
+ Node* tonode = NULL;
+ Edge* tmpEdge;
+
+ /* see if this item was already added */
+ FOR_ALL_EDGES(i) {
+ if(EDGE_ITEM(THIS(edges)[i]) == edgeid) {
+ THIS(errmsg) = "attempt to insert duplicate graph edge";
+ return LAYOUT_ERROR;
+ }
+ }
+ /* locate the actual from and to nodes */
+ FOR_ALL_NODES(i) {
+ n = THIS(nodes)[i];
+ if(NODE_ITEM(n) == fromid) {
+ fromnode = n;
+ } else if(NODE_ITEM(n) == toid) {
+ tonode = n;
+ }
+ }
+ if(!fromnode || !tonode) {
+ THIS(errmsg) = "edge was missing from or to node";
+ return LAYOUT_ERROR;
+ }
+
+ /* create Edge */
+ tmpEdge = (Edge* ) ckalloc(sizeof(Edge));
+ if(!tmpEdge) {
+ THIS(errmsg) = "malloc failure";
+ return LAYOUT_ERROR;
+ }
+ SET_IGNORE_EDGE(tmpEdge, 0);
+ SET_VISITED_EDGE(tmpEdge, 0);
+ tmpEdge->edgeid = edgeid;
+ tmpEdge->fromNode = fromnode;
+ tmpEdge->toNode = tonode;
+
+ THIS(edgeNum)++;
+ if(THIS(edges) == NULL) {
+ THIS(edges) = (Edge* *) ckalloc(THIS(edgeNum) * sizeof(Edge* ));
+ } else {
+ THIS(edges) = (Edge* *) ckrealloc((char *) THIS(edges),
+ THIS(edgeNum) * sizeof(Edge* ));
+ }
+ THIS(edges)[THIS(edgeNum)-1] = tmpEdge;
+
+ /* insert the succ and parent edge structs */
+ tonode->parentNum++;
+ if(tonode->parent == NULL) {
+ tonode->parent = (Edge**)
+ ckalloc(tonode->parentNum * sizeof(Edge*));
+ } else {
+ tonode->parent = (Edge**)
+ ckrealloc((char *) tonode->parent,
+ tonode->parentNum * sizeof(Edge*));
+ }
+ tonode->parent[tonode->parentNum - 1] = tmpEdge;
+
+ fromnode->succNum++;
+ if(fromnode->succ == NULL) {
+ fromnode->succ = (Edge**)
+ ckalloc(fromnode->succNum * sizeof(Edge*));
+ } else {
+ fromnode->succ = (Edge**)
+ ckrealloc((char *) fromnode->succ,
+ fromnode->succNum * sizeof(Edge*));
+ }
+ fromnode->succ[fromnode->succNum-1] = tmpEdge;
+
+ return LAYOUT_OK;
+}
+
+static
+void
+compress_succ AC2(Layout_Graph*,This, Node*,n)
+{
+ register Edge** p;
+ register Edge** q;
+
+ for(p=n->succ,q=p+(n->succNum);p < q;p++) {
+ if(*p != NULL) continue;
+ /* found a null entry earlier than where q is pointing */
+ /* move q down to look for a non-null entry */
+ do { --q; } while(q > p && *q == NULL);
+ if(q <= p) break; /* p points to last non-null entry */
+ *p = *q;
+ }
+ n->succNum = p - n->succ;
+}
+
+static
+void
+compress_parent AC2(Layout_Graph*,This, Node*,n)
+{
+ register Edge** p;
+ register Edge** q;
+
+ for(p=n->parent,q=p+(n->parentNum);p < q;p++) {
+ if(*p != NULL) continue;
+ /* found a null entry earlier than where q is pointing */
+ /* move q down to look for a non-null entry */
+ do { --q; } while(q > p && *q == NULL);
+ if(q <= p) break; /* p points to last non-null entry */
+ *p = *q;
+ }
+ n->parentNum = p - n->parent;
+}
+
+static
+int
+deleteedge AC3(Layout_Graph*,This, Edge*,e, int,index)
+{
+ register int i;
+ register int j;
+ register int found;
+
+ /* remove all references to this Edge */
+ FOR_ALL_NODES(i) {
+ register Node* n = THIS(nodes)[i];
+ found = 0;
+ FOR_ALL_SUCCS(n,j) {
+ if(SUCC_EDGE(n,j) == e) {
+ SUCC_EDGE(n,j) = NULL;
+ found = 1;
+ }
+ }
+ if(found) {compress_succ(This,n);}
+ found = 0;
+ FOR_ALL_PARENTS(n,j) {
+ if(PARENT_EDGE(n,j) == e) {
+ PARENT_EDGE(n,j) = NULL;
+ found = 1;
+ }
+ }
+ if(found) {compress_parent(This,n);}
+ }
+ /* free and clear Edge*/
+ THIS(edgeNum)--;
+ if(THIS(edgeNum) > 0) {
+ THIS(edges)[index] = THIS(edges)[THIS(edgeNum)];
+ }
+ ckfree((char*)e);
+ return LAYOUT_OK;
+}
+
+int
+LayoutDeleteEdge AC2(Layout_Graph*,This, pItem,eid)
+{
+ register int i;
+
+ /* find matching edge object */
+ FOR_ALL_EDGES(i) {
+ register Edge* e = THIS(edges)[i];
+ if(e->edgeid == eid) {
+ return deleteedge(This,e,i);
+ }
+ }
+ THIS(errmsg) = "edge delete: no such edge";
+ return LAYOUT_ERROR;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LayoutBuildGraph --
+ *
+ * This procedure is invoked to create the internal
+ * graph structure used for layouting.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static
+int
+LayoutBuildGraph AC1(Layout_Graph*,This)
+{
+ register int counter;
+
+ /* Walk through all nodes to compute various things */
+ FOR_ALL_NODES(counter) {
+ register Node* n = THIS(nodes)[counter];
+ /* Find the greatest icon dimensions. */
+ if(NODE_WIDTH(n) > THIS(iconWidth)) {
+ THIS(iconWidth) = (int)NODE_WIDTH(n);
+ }
+ if(NODE_HEIGHT(n) > THIS(iconHeight)) {
+ THIS(iconHeight) = (int)NODE_HEIGHT(n);
+ }
+ }
+
+ return LAYOUT_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LayoutClearGraph --
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+LayoutClearGraph AC1(Layout_Graph*,This)
+{
+ register int counter;
+ register Node* n;
+
+ /* Free allocated memory. */
+ FOR_ALL_EDGES(counter) {
+ ckfree((char *) THIS(edges)[counter]);
+ }
+ THIS(edgeNum) = 0;
+ FOR_ALL_NODES(counter) {
+ n = THIS(nodes)[counter];
+ if (n->parent != NULL)
+ ckfree((char*)n->parent);
+ if (n->succ != NULL)
+ ckfree((char*)n->succ);
+ if (n != NULL)
+ ckfree((char *)n);
+ }
+ THIS(nodeNum) = 0;
+ FOR_ALL_TOP_NODES(counter) {
+ ckfree((char *) THIS(topList)[counter]);
+ }
+ THIS(topListNum) = 0;
+ if (THIS(topList) != NULL)
+ {
+ ckfree ((char *) (THIS(topList)));
+ THIS(topList) = NULL;
+ }
+ if (THIS(nodes) != NULL)
+ {
+ ckfree ((char *) (THIS(nodes)));
+ THIS(nodes) = NULL;
+ }
+ THIS(rootNode) = NULL;
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LayoutFreeGraph --
+ *
+ * This procedure is invoked to free the graph structures
+ * used for layouting.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+LayoutFreeGraph AC1(Layout_Graph*,This)
+{
+ LayoutClearGraph(This);
+
+ /* now cleanup the Layout Graph structure */
+ if (THIS(edges) != NULL)
+ {
+ ckfree((char *) THIS(edges));
+ THIS(edges) = NULL;
+ }
+ if (THIS(nodes) != NULL)
+ {
+ ckfree((char *) THIS(nodes));
+ THIS(nodes) = NULL;
+ }
+ if (THIS(topList) != NULL)
+ {
+ ckfree((char *) THIS(topList));
+ THIS(topList) = NULL;
+ }
+
+ /* free graph layout structure */
+ ckfree ((char *) This);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LayoutGraphRoot --
+ *
+ * This procedure is invoked to find the root of a graph.
+ *
+ * Results:
+ * The root node.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static
+Node*
+LayoutGraphRoot AC1(Layout_Graph*,This)
+{
+ int optimalRootNum = -10000, minParentNum = -1, maxSuccNum = -1,
+ counter, counter1, counter2, counter3, lidx;
+ Node *tmprootNode, *node;
+
+ /* Khamis 27-mar-97
+ * reorder nodes, so that nodes with not empty subtree displayed
+ * first
+ */
+ lidx = 0;
+ FOR_ALL_NODES(counter)
+ {
+ if (counter == 0 || IGNORE_NODE(THIS(nodes)[counter]))
+ continue;
+
+ if (SUCC_NUM(THIS(nodes)[counter]) > SUCC_NUM(THIS(nodes)[lidx]))
+ {
+ node = THIS(nodes)[counter];
+ THIS(nodes)[counter] = THIS(nodes)[lidx];
+ THIS(nodes)[lidx] = node;
+
+ /* search for next node with no subtree */
+ while (SUCC_NUM(THIS(nodes)[lidx]) > 0 && lidx < counter)
+ {
+ lidx ++;
+ }
+ }
+ }
+
+ tmprootNode = THIS(rootNode);
+
+ /* Find a root node. This node has no parents. In case we do not */
+ /* have such a node... find the node with the smallest number of */
+ /* parents. */
+
+#if 0 /* Zsolt Koppany */
+ tmprootNode = THIS(nodes)[0];
+ return tmprootNode;
+#endif
+ if(!tmprootNode) {
+ /* We try to find the node with the most children and the least */
+ /* parents. This node will become root. */
+ FOR_ALL_NODES(counter) {
+ if(IGNORE_NODE(THIS(nodes)[counter])) {
+ continue;
+ }
+ if((SUCC_NUM(THIS(nodes)[counter]) > 0 &&
+ optimalRootNum <= (SUCC_NUM(THIS(nodes)[counter]) -
+ PARENT_NUM(THIS(nodes)[counter])) &&
+ (minParentNum > PARENT_NUM(THIS(nodes)[counter]) ||
+ (minParentNum == PARENT_NUM(THIS(nodes)[counter]) &&
+ maxSuccNum < SUCC_NUM(THIS(nodes)[counter])))) ||
+ optimalRootNum == -10000 ||
+
+ /* khamis: 17-mars-97, root with no parents have more priority */
+ PARENT_NUM(THIS(nodes)[counter]) < PARENT_NUM(tmprootNode)) {
+ tmprootNode = THIS(nodes)[counter];
+
+ minParentNum = PARENT_NUM(THIS(nodes)[counter]);
+ maxSuccNum = SUCC_NUM(THIS(nodes)[counter]);
+ if(SUCC_NUM(THIS(nodes)[counter]) > 0) {
+ optimalRootNum =
+ (SUCC_NUM(THIS(nodes)[counter]) - PARENT_NUM(THIS(nodes)[counter]));
+ }
+ }
+ }
+ }
+
+ /* No nodes... so abort the search. */
+ if(tmprootNode == NULL) {
+ return NULL;
+ }
+
+ /* There is no node with no parents. So use the node with the */
+ /* smallest number of parents, and ignore the edges leading to this */
+ /* node. */
+ if(PARENT_NUM(tmprootNode) != 0) {
+ for (counter1 = 0; counter1 < PARENT_NUM(tmprootNode); counter1++) {
+ SET_IGNORE_NODE(PARENT_EDGE(tmprootNode, counter1), 1);
+ FOR_ALL_NODES(counter2) {
+ /* Ignore dummy nodes. */
+ if(DUMMY_NODE(THIS(nodes)[counter2])) {
+ continue;
+ }
+ if(NODE_ITEM(THIS(nodes)[counter2]) ==
+ NODE_ITEM(PARENT_NODE(tmprootNode, counter1))) {
+ FOR_ALL_SUCCS(THIS(nodes)[counter2], counter3) {
+ if(NODE_ITEM(SUCC_NODE(THIS(nodes)[counter2], counter3)) ==
+ NODE_ITEM(tmprootNode)) {
+ SET_IGNORE_NODE(SUCC_EDGE(THIS(nodes)[counter2], counter3), 1);
+ }
+ }
+ }
+ }
+ }
+ }
+ return tmprootNode;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LayoutGraphSortTopological --
+ *
+ * This procedure is invoked to sort a graph topological.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static
+void
+LayoutGraphSortTopological AC2(Layout_Graph*,This, Node*,currentNode) /* This is the current node. */
+{
+ int counter;
+ Topology *tmpTopology;
+
+ if(VISITED_NODE(currentNode) || IGNORE_NODE(currentNode)) {
+ return;
+ }
+
+ /* Append the current node to the list of topologically sorted */
+ /* nodes. */
+ THIS(topListNum)++;
+ if(THIS(topList) == NULL) {
+ THIS(topList) = (Topology **) ckalloc(THIS(topListNum) * sizeof(Topology *));
+ } else {
+ THIS(topList) = (Topology **) ckrealloc((char *) THIS(topList),
+ THIS(topListNum) * sizeof(Topology *));
+ }
+ tmpTopology = (Topology *) ckalloc(sizeof(Topology));
+ tmpTopology->nodePtr = currentNode;
+ THIS(topList)[THIS(topListNum)-1] = tmpTopology;
+
+ SET_VISITED_NODE(currentNode, 1);
+ /* Walk through all successors. */
+ FOR_ALL_SUCCS(currentNode, counter) {
+ if(IGNORE_EDGE(SUCC_EDGE(currentNode, counter))) {
+ continue;
+ }
+ if(IGNORE_NODE(SUCC_NODE(currentNode, counter))) {
+ continue;
+ }
+ if(VISITED_NODE(SUCC_NODE(currentNode, counter))) {
+ SET_IGNORE_EDGE(SUCC_EDGE(currentNode, counter), 1);
+ continue;
+ }
+ LayoutGraphSortTopological(This,SUCC_NODE(currentNode, counter));
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LayoutGraphPlaceNodes --
+ *
+ * This procedure is invoked to actually place the graph nodes.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static
+int
+LayoutGraphPlaceNodes AC1(Layout_Graph*,This)
+{
+ int counter;
+ double tmpX, tmpY;
+
+ SRANDOM(getpid() + time((time_t *) NULL));
+
+ FOR_ALL_NODES(counter) {
+ register Node* n = THIS(nodes)[counter];
+ if(IGNORE_NODE(n)) {
+ continue;
+ }
+ if(NODE_X_POS(n) != -1 &&
+ NODE_Y_POS(n) != -1) {
+ if(THIS(graphOrder)) {
+ /* Place nodes top down. */
+ tmpX = NODE_X_POS(n);
+ tmpY = NODE_Y_POS(n);
+ } else {
+ /* Place nodes left to right. */
+ tmpX = NODE_Y_POS(n);
+ tmpY = NODE_X_POS(n);
+ }
+ } else {
+ /* are we allowed to place the icon ? */
+ if(THIS(keepRandomPositions) &&
+ NODE_X_POS(n) > 0 &&
+ NODE_Y_POS(n) > 0) {
+ continue;
+ }
+ tmpX = (long) (RANDOM % THIS(maxX)) - NODE_WIDTH(n);
+ tmpY = (long) (RANDOM % THIS(maxY)) - NODE_HEIGHT(n);
+ }
+ if(tmpX < 0) {
+ tmpX = 0;
+ }
+ if(tmpY < 0) {
+ tmpY = 0;
+ }
+ if(!DUMMY_NODE(n)) {
+ ItemGeom g;
+ g = NODE_GEOM(n);
+ /* recalc Item Geom based on our layout */
+ g.x1 = tmpX+THIS(xOffset);
+ g.y1 = tmpY+THIS(yOffset);
+ g.x2 = g.x1 + g.width;
+ g.y2 = g.y1 + g.height;
+ SET_NODE_GEOM(n,g);
+ }
+ }
+ return LAYOUT_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LayoutGraphPlaceEdges --
+ *
+ * This procedure is invoked to relayout all edges.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static
+int
+LayoutGraphPlaceEdges AC1(Layout_Graph*,This)
+{
+ register int i;
+
+ /* scan through all edges */
+ FOR_ALL_EDGES(i) {
+ /* layout edges. */
+ LayoutEdge(This,THIS(edges)[i], NULL, NULL);
+ }
+ return LAYOUT_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LayoutEdgeWidth --
+ *
+ * This procedure is invoked to find the widest edge. Widest
+ * means the edge with the maximal x expansion.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static
+int
+LayoutEdgeWidth AC1(Layout_Graph*,This)
+{
+#if 1 /* Khamis, 19:00 20 Okt 1996 */
+ THIS(edgeHeight) = 0;
+ THIS(edgeWidth) = 0;
+#else
+ register int i;
+ if(THIS(edgeWidth) == 0) {
+ /* Walk through all edges. */
+ FOR_ALL_EDGES(i) {
+ if(THIS(edges)[i]->info.height + LINE_INCREMENT > THIS(edgeHeight)) {
+ THIS(edgeHeight) = THIS(edges)[i]->info.height + LINE_INCREMENT;
+ }
+ if(THIS(edges)[i]->info.width + LINE_INCREMENT > THIS(edgeWidth)) {
+ THIS(edgeWidth) = THIS(edges)[i]->info.width + LINE_INCREMENT;
+ }
+ }
+ }
+
+#endif
+
+ return LAYOUT_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LayoutEdge --
+ *
+ * This procedure is invoked to adjust the edge to the new
+ * locations of the connected nodes. This algorithm only works
+ * for simple edges.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static
+int
+LayoutEdge AC4(Layout_Graph*,This,
+ Edge*,e, /* Current edge. */
+ Node*,fromNode, /* Source node. */
+ Node*,toNode) /* Target node. */
+{
+ int result = LAYOUT_OK;
+#if 0
+ Node *currentNode;
+#endif
+ ItemGeom geom;
+
+ if(fromNode == (Node*) NULL && toNode == (Node*) NULL)
+ {
+ fromNode = e->fromNode;
+ toNode = e->toNode;
+ }
+#if 0
+ else
+ {
+ /* Place one specific edge... */
+ /* WARNING !!! this code is old and not adapted to the new Edge*/
+ /* placing. The code is not tested. This stuff will be used to */
+ /* display multi point edges.... */
+ fromPtr = NODE_ITEM(fromNode);
+ while (DUMMY_NODE(toNode) && SUCC_NUM(toNode) > 0) {
+ toNode = SUCC_NODE(toNode, 0);
+ }
+ toPtr = NODE_ITEM(toNode);
+ if(itemPtr == (pItem ) NULL) {
+ /* Match the numeric id value to a concrete item pointer. */
+ FOR_ALL_CANVAS_ITEMS(canvasPtr, itemPtr) {
+ if(strcmp(CANVAS_ITEM_TYPE(itemPtr), "edge") == 0) {
+ /* Get "from" id */
+ Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin,
+ itemPtr->typePtr->configSpecs,
+ (char *) itemPtr, "-from", 0);
+ if(Tcl_SplitList(canvasPtr->interp,
+ canvasPtr->interp->result,
+ &argc2, &argv2) != LAYOUT_OK) {
+ return LAYOUT_ERROR;
+ }
+ fromId = atol(argv2[4]);
+ ckfree((char *) argv2);
+
+ /* Get "to" id */
+ Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin,
+ itemPtr->typePtr->configSpecs,
+ (char *) itemPtr, "-to", 0);
+ if(Tcl_SplitList(canvasPtr->interp,
+ canvasPtr->interp->result,
+ &argc2, &argv2) != LAYOUT_OK) {
+ return LAYOUT_ERROR;
+ }
+ toId = atol(argv2[4]);
+ ckfree((char *) argv2);
+
+ if(fromId == CANVAS_ITEM_ID(fromPtr) &&
+ toId == CANVAS_ITEM_ID(toPtr)) {
+ curPtr = itemPtr;
+ FOR_ALL_SUCCS(fromNode, counter1) {
+ Tcl_DStringInit(&positionString);
+ if(fromPtr->x1 > fromPtr->x2) {
+ THIS(posX1) = fromPtr->x1 + ((fromPtr->x2 - fromPtr->x1) / 2);
+ } else {
+ THIS(posX1) = fromPtr->x2 + ((fromPtr->x1 - fromPtr->x2) / 2);
+ }
+ if(fromPtr->y1 > fromPtr->y2) {
+ THIS(posY1) = fromPtr->y1 + ((fromPtr->y2 - fromPtr->y1) / 2);
+ } else {
+ THIS(posY1) = fromPtr->y2 + ((fromPtr->y1 - fromPtr->y2) / 2);
+ }
+ if(toPtr->x1 > toPtr->x2) {
+ THIS(posX2) = toPtr->x1 + ((toPtr->x2 - toPtr->x1) / 2);
+ } else {
+ THIS(posX2) = toPtr->x2 + ((toPtr->x1 - toPtr->x2) / 2);
+ }
+ if(toPtr->y1 > toPtr->y2) {
+ THIS(posY2) = toPtr->y1 + ((toPtr->y2 - toPtr->y1) / 2);
+ } else {
+ THIS(posY2) = toPtr->y2 + ((toPtr->y1 - toPtr->y2) / 2);
+ }
+
+ if(fromPtr->y2 <= toPtr->y1) {
+ sprintf(convertBuffer, "%d %d ", THIS(posX1), fromPtr->y2);
+ } else {
+ if(fromPtr->y1 >= toPtr->y2) {
+ sprintf(convertBuffer, "%d %d ", THIS(posX1), fromPtr->y1);
+ } else {
+ if(fromPtr->x2 < toPtr->x1) {
+ sprintf(convertBuffer, "%d %d ", fromPtr->x2, THIS(posY1));
+ } else {
+ sprintf(convertBuffer, "%d %d ", fromPtr->x1, THIS(posY1));
+ }
+ }
+ }
+
+ Tcl_DStringAppend(&positionString, convertBuffer, -1);
+ currentNode = SUCC_NODE(fromNode, counter1);
+ while (DUMMY_NODE(currentNode) && SUCC_NUM(currentNode) > 0) {
+ currentNode = SUCC_NODE(currentNode, 0);
+ sprintf(convertBuffer, "%g %g ", /*300.0, 300.0*/
+ NODE_X_POS(currentNode), NODE_Y_POS(currentNode));
+ Tcl_DStringAppend(&positionString, convertBuffer, -1);
+ }
+ if(NODE_ITEM(currentNode) != toPtr) {
+ Tcl_DStringFree(&positionString);
+ continue;
+ }
+ if(fromPtr->y2 <= toPtr->y1) {
+ sprintf(convertBuffer, "%d %d ", THIS(posX2), toPtr->y1);
+ } else {
+ if(fromPtr->y1 >= toPtr->y2) {
+ sprintf(convertBuffer, "%d %d ", THIS(posX2), toPtr->y2);
+ } else {
+ if(fromPtr->x2 < toPtr->x1) {
+ sprintf(convertBuffer, "%d %d ", toPtr->x1, THIS(posY2));
+ } else {
+ sprintf(convertBuffer, "%d %d ", toPtr->x2, THIS(posY2));
+ }
+ }
+ }
+ Tcl_DStringAppend(&positionString, convertBuffer, -1);
+
+ /* Set new coordinates */
+ if(Tcl_SplitList(canvasPtr->interp, positionString.string,
+ &argc2, &argv2) != LAYOUT_OK) {
+ return LAYOUT_ERROR;
+ }
+ Tcl_ResetResult(canvasPtr->interp);
+ result = (*curPtr->typePtr->coordProc)
+ (canvasPtr, curPtr, argc2, argv2);
+ ckfree((char *) argv2);
+ Tcl_DStringFree(&positionString);
+ }
+ return result;
+ }
+ }
+ }
+ }
+ }
+#endif /* #if 0 */
+
+ /* Is this a regular edge ? */
+ if(fromNode != NULL && toNode != NULL) {
+ /* calculate the various node anchors. */
+ /* calc center of the from node */
+ if(fromNode->info.x1 > fromNode->info.x2) {
+ THIS(posX1) = fromNode->info.x1 + ((fromNode->info.x2 - fromNode->info.x1) / 2);
+ } else {
+ THIS(posX1) = fromNode->info.x2 + ((fromNode->info.x1 - fromNode->info.x2) / 2);
+ }
+ if(fromNode->info.y1 > fromNode->info.y2) {
+ THIS(posY1) = fromNode->info.y1 + ((fromNode->info.y2 - fromNode->info.y1) / 2);
+ } else {
+ THIS(posY1) = fromNode->info.y2 + ((fromNode->info.y1 - fromNode->info.y2) / 2);
+ }
+ /* calc center of the to node */
+ if(toNode->info.x1 > toNode->info.x2) {
+ THIS(posX2) = toNode->info.x1 + ((toNode->info.x2 - toNode->info.x1) / 2);
+ } else {
+ THIS(posX2) = toNode->info.x2 + ((toNode->info.x1 - toNode->info.x2) / 2);
+ }
+ if(toNode->info.y1 > toNode->info.y2) {
+ THIS(posY2) = toNode->info.y1 + ((toNode->info.y2 - toNode->info.y1) / 2);
+ } else {
+ THIS(posY2) = toNode->info.y2 + ((toNode->info.y1 - toNode->info.y2) / 2);
+ }
+
+ if(THIS(edgeOrder)) {
+ /* Place the edges according to the graph order... only along
+ * the generale layout direction. */
+ if(THIS(graphOrder)) {
+ /* Place nodes top down. */
+ if(fromNode->info.y2 <= toNode->info.y1) {
+ geom.x1 = THIS(posX1);
+ geom.y1 = fromNode->info.y2;
+ geom.x2 = THIS(posX2);
+ geom.y2 = toNode->info.y1;
+ } else {
+ geom.x1 = THIS(posX1);
+ geom.y1 = fromNode->info.y1;
+ geom.x2 = THIS(posX2);
+ geom.y2 = toNode->info.y2;
+ }
+ } else {
+ /* Place nodes left to right. */
+ if(fromNode->info.x2 < toNode->info.x1) {
+ geom.x1 = fromNode->info.x2;
+ geom.y1 = THIS(posY1);
+ geom.x2 = toNode->info.x1;
+ geom.y2 = THIS(posY2);
+ } else {
+ geom.x1 = fromNode->info.x1;
+ geom.y1 = THIS(posY1);
+ geom.x2 = toNode->info.x2;
+ geom.y2 = THIS(posY2);
+ }
+ }
+ } else {
+ /* Place the edges so that they use the shortest distance. */
+ if(fromNode->info.y2 <= toNode->info.y1) {
+ /* from is above to */
+ if(fromNode->info.x2 <= toNode->info.x1) {
+ /* from is left from to */
+ if(THIS(graphOrder)) {
+ /* Place nodes top down. */
+ geom.x1 = THIS(posX1);
+ geom.y1 = fromNode->info.y2;
+ geom.x2 = THIS(posX2);
+ geom.y2 = toNode->info.y1;
+ } else {
+ geom.x1 = fromNode->info.x2;
+ geom.y1 = THIS(posY1);
+ geom.x2 = toNode->info.x1;
+ geom.y2 = THIS(posY2);
+ }
+ } else {
+ if(fromNode->info.x1 >= toNode->info.x2) {
+ /* from is right from to */
+ if(THIS(graphOrder)) {
+ /* Place nodes top down. */
+ geom.x1 = THIS(posX1);
+ geom.y1 = fromNode->info.y2;
+ geom.x2 = THIS(posX2);
+ geom.y2 = toNode->info.y1;
+ } else {
+ geom.x1 = fromNode->info.x1;
+ geom.y1 = THIS(posY1);
+ geom.x2 = toNode->info.x2;
+ geom.y2 = THIS(posY2);
+ }
+ } else {
+ /* from is at same level as to */
+ geom.x1 = THIS(posX1);
+ geom.y1 = fromNode->info.y2;
+ geom.x2 = THIS(posX2);
+ geom.y2 = toNode->info.y1;
+ }
+ }
+ } else {
+ if(fromNode->info.y1 >= toNode->info.y2) {
+ /* from is below to */
+ if(fromNode->info.x2 <= toNode->info.x1) {
+ /* from is left from to */
+ if(THIS(graphOrder)) {
+ /* Place nodes top down. */
+ geom.x1 = THIS(posX1);
+ geom.y1 = fromNode->info.y1;
+ geom.x2 = THIS(posX2);
+ geom.y2 = toNode->info.y2;
+ } else {
+ geom.x1 = fromNode->info.x2;
+ geom.y1 = THIS(posY1);
+ geom.x2 = toNode->info.x1;
+ geom.y2 = THIS(posY2);
+ }
+ } else {
+ if(fromNode->info.x1 >= toNode->info.x2) {
+ /* from is right from to */
+ if(THIS(graphOrder)) {
+ /* Place nodes top down. */
+ geom.x1 = THIS(posX1);
+ geom.y1 = fromNode->info.y1;
+ geom.x2 = THIS(posX2);
+ geom.y2 = toNode->info.y2;
+ } else {
+ geom.x1 = fromNode->info.x1;
+ geom.y1 = THIS(posY1);
+ geom.x2 = toNode->info.x2;
+ geom.y2 = THIS(posY2);
+ }
+ } else {
+ /* from is at same level as to */
+ geom.x1 = THIS(posX1);
+ geom.y1 = fromNode->info.y1;
+ geom.x2 = THIS(posX2);
+ geom.y2 = toNode->info.y2;
+ }
+ }
+ } else {
+ /* from is at same level as to */
+ if(fromNode->info.x2 <= toNode->info.x1) {
+ /* from is left from to */
+ geom.x1 = fromNode->info.x2;
+ geom.y1 = THIS(posY1);
+ geom.x2 = toNode->info.x1;
+ geom.y2 = THIS(posY2);
+ } else {
+ if(fromNode->info.x1 > toNode->info.x2) {
+ /* from is right from to */
+ geom.x1 = fromNode->info.x1;
+ geom.y1 = THIS(posY1);
+ geom.x2 = toNode->info.x2;
+ geom.y2 = THIS(posY2);
+ } else {
+ if(fromNode->info.x1 <= toNode->info.x1) {
+ /* from is partially left from to */
+ geom.x1 = fromNode->info.x2;
+ geom.y1 = THIS(posY1);
+ geom.x2 = toNode->info.x1;
+ geom.y2 = THIS(posY2);
+ } else {
+ /* from is partially right from to */
+ geom.x1 = fromNode->info.x1;
+ geom.y1 = THIS(posY1);
+ geom.x2 = toNode->info.x2;
+ geom.y2 = THIS(posY2);
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+
+ /* Set new coordinates on Edge*/
+ SET_EDGE_GEOM(e,geom);
+
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LayoutISI --
+ *
+ * This procedure is invoked to place icons with ISI.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+LayoutISI AC1(Layout_Graph*,This)
+{
+ int counter, result = LAYOUT_OK;
+
+ THIS(maxXPosition) = 0;
+ THIS(maxYPosition) = 0;
+ if(THIS(topList)) {
+ /* free layout specific data slots. */
+ for (counter = 0; counter < THIS(topListNum); counter++) {
+ ckfree((char *) THIS(topList)[counter]);
+ }
+ ckfree((char*)THIS(topList));
+ THIS(topList) = NULL;
+ }
+ THIS(topListNum) = 0;
+ THIS(topList) = (Topology **) NULL;
+
+ /* find the widest/highest edge. */
+ LayoutEdgeWidth(This);
+
+ /* build the internal graph structure. */
+ if(LayoutBuildGraph(This) != LAYOUT_OK) {
+ return LAYOUT_ERROR;
+ }
+
+ /* find root of the graph. */
+ if((THIS(rootNode) = LayoutGraphRoot(This)) == NULL) {
+ THIS(errmsg) = "no root node";
+ return LAYOUT_ERROR;
+ }
+
+ /* sort the graph topological. */
+ LayoutGraphSortTopological(This,THIS(rootNode));
+ FOR_ALL_NODES(counter) {
+ if(PARENT_NUM(THIS(nodes)[counter]) == 0) {
+ LayoutGraphSortTopological(This,THIS(nodes)[counter]);
+ }
+ }
+
+ /* Calculate the x position values. */
+ RESET_VISITED_NODE(counter);
+ FOR_ALL_NODES(counter) {
+ if(PARENT_NUM(THIS(nodes)[counter]) == 0) {
+ LayoutISISetX(This,THIS(nodes)[counter]);
+ }
+ }
+
+#if 0
+ RESET_VISITED_NODE(counter);
+ FOR_ALL_NODES(counter) {
+ if(PARENT_NUM(THIS(nodes)[counter]) == 0) {
+ MY_LayoutISISetY(This,THIS(nodes)[counter], 0);
+ }
+ }
+#else
+ RESET_VISITED_NODE(counter);
+ FOR_ALL_NODES(counter) {
+ if(SUCC_NUM(THIS(nodes)[counter]) == 0) {
+ LayoutISISetY(This,THIS(nodes)[counter]);
+ }
+ }
+#endif
+
+#if 1
+ if (! THIS(graphOrder)) {
+ while (1) {
+ int found;
+ found = 0;
+ FOR_ALL_NODES(counter) {
+ if(PARENT_NUM (THIS(nodes)[counter]) > 0 &&
+ NODE_Y_POS (THIS(nodes)[counter]) <
+ NODE_Y_POS (PARENT_NODE(THIS(nodes)[counter], 0)) +
+ NODE_WIDTH (PARENT_NODE(THIS(nodes)[counter], 0)) +
+ THIS(edgeWidth) + THIS(iconSpaceH)) {
+ SET_NODE_Y_POS(THIS(nodes)[counter],
+
+ NODE_Y_POS (PARENT_NODE(THIS(nodes)[counter], 0)) +
+ NODE_WIDTH (PARENT_NODE(THIS(nodes)[counter], 0)) +
+ THIS(edgeWidth) + THIS(iconSpaceH));
+ found = 1;
+ }
+
+ if (SUCC_NUM (THIS(nodes)[counter]) == 1 &&
+ PARENT_NODE (SUCC_NODE (THIS(nodes)[counter], 0), 0) == THIS(nodes)[counter]) {
+ SET_NODE_X_POS(SUCC_NODE (THIS(nodes)[counter], 0),
+ NODE_X_POS(THIS(nodes)[counter]));
+ }
+ }
+ if (! found)
+ break;
+ }
+ }
+#endif
+
+ /* Place the graph items. */
+ if(LayoutGraphPlaceNodes(This) != LAYOUT_OK) {
+ result = LAYOUT_ERROR;
+ } else if(LayoutGraphPlaceEdges(This) != LAYOUT_OK) {
+ result = LAYOUT_ERROR;
+ }
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LayoutMatrix --
+ *
+ * This procedure is invoked to place icons as matrix.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+LayoutMatrix AC1(Layout_Graph*,This)
+{
+ int result = LAYOUT_OK, greatestX = 10,
+ greatestY = 10, greatestHeight = 0, columnCounter = 0,
+ tmpIconWidth = 0, offset = 0, counter;
+ ItemGeom geom;
+
+ /* Scan through all canvas items. */
+ FOR_ALL_NODES(counter) {
+ register Node* n = THIS(nodes)[counter];
+ /* Find the greatest icon dimensions. */
+ if(THIS(computeiconsize)) {
+ if(NODE_WIDTH(n) > THIS(iconWidth)) {
+ THIS(iconWidth) = (int)NODE_WIDTH(n);
+ }
+ if(NODE_HEIGHT(n) > THIS(iconHeight)) {
+ THIS(iconHeight) = (int)NODE_HEIGHT(n);
+ }
+ }
+ }
+
+ /* Walk through the list of NODES */
+ FOR_ALL_NODES(counter) {
+ register Node* n = THIS(nodes)[counter];
+ geom = NODE_GEOM(n);
+ if(THIS(iconWidth) == 0) {
+ tmpIconWidth = (int)NODE_WIDTH(n);
+ offset = (int) ((NODE_WIDTH(n) / 2.0) - (NODE_WIDTH(n) / 2.0));
+ } else {
+ tmpIconWidth = THIS(iconWidth);
+ offset = (int) ((THIS(iconWidth) / 2.0) - (NODE_WIDTH(n) / 2.0));
+ }
+ /* Is this the highest icon so far ? */
+ if(NODE_HEIGHT(n) > greatestHeight) {
+ greatestHeight = (int) NODE_HEIGHT(n);
+ }
+
+ /* Place icon on the current line. */
+ if(greatestX + tmpIconWidth < THIS(maxX) &&
+ (THIS(elementsPerLine) == 0 ||
+ columnCounter < THIS(elementsPerLine))) {
+ geom.x1 = offset + greatestX + THIS(xOffset);
+ geom.y1 = greatestY + THIS(yOffset);
+ geom.x2 = geom.x1 + geom.width;
+ geom.y2 = geom.y1 + geom.height;
+ greatestX += (tmpIconWidth + THIS(iconSpaceH));
+ columnCounter++;
+ SET_NODE_GEOM(n,geom);
+ } else {
+ /* Place icon on the next line. */
+ if(THIS(iconHeight) > 0) {
+ greatestY += (THIS(iconHeight) + THIS(iconSpaceV));
+ } else {
+ greatestY += (greatestHeight + THIS(iconSpaceV));
+ }
+ geom.x1 = 10 + offset + greatestX + THIS(xOffset);
+ geom.y1 = greatestY + THIS(yOffset);
+ geom.x2 = geom.x1 + geom.width;
+ geom.y2 = geom.y1 + geom.height;
+ greatestHeight = (int) geom.height;
+ greatestX = 10 + (tmpIconWidth + THIS(iconSpaceH));
+ columnCounter = 1;
+ SET_NODE_GEOM(n,geom);
+ }
+ }
+
+ if(THIS(hideEdges)) {
+ /* make all edges zero length, and place at maxX,MaxY
+ to get them out of the way
+ */
+ FOR_ALL_EDGES(counter) {
+ geom.x2 = (geom.x1 = THIS(maxX));
+ geom.y2 = (geom.y1 = THIS(maxY));
+ geom.width = (geom.height = 0);
+ SET_EDGE_GEOM(THIS(edges)[counter],geom);
+ }
+ } else if(LayoutGraphPlaceEdges(This) != LAYOUT_OK) {
+ result = LAYOUT_ERROR;
+ }
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LayoutRandom --
+ *
+ * This procedure is invoked to place icons randomly.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+LayoutRandom AC1(Layout_Graph*,This)
+{
+ int result = LAYOUT_OK;
+ int counter;
+
+ SRANDOM(getpid() + time((time_t *) NULL));
+ /* walk through all nodes */
+ FOR_ALL_NODES(counter) {
+ register Node* itemptr = THIS(nodes)[counter];
+ long tmpx, tmpy;
+ ItemGeom geom;
+
+ /* randomly place icons. */
+ /* are we allowed to place the icon ? */
+ if(THIS(keepRandomPositions) &&
+ NODE_X_POS(itemptr) > 0 &&
+ NODE_Y_POS(itemptr) > 0) {
+ continue;
+ }
+ tmpx = (long) (RANDOM % THIS(maxX)) - (long) NODE_WIDTH(itemptr);
+ tmpy = (long) (RANDOM % THIS(maxY)) - (long) NODE_HEIGHT(itemptr);
+ if(tmpx <= 0) {
+ tmpx = 1;
+ }
+ if(tmpy <= 0) {
+ tmpy = 1;
+ }
+ geom = NODE_GEOM(itemptr);
+ geom.x1 = tmpx + THIS(xOffset);
+ geom.y1 = tmpy + THIS(yOffset);
+ geom.x2 = geom.x1 + NODE_WIDTH(itemptr);
+ geom.y2 = geom.y1 + NODE_HEIGHT(itemptr);
+ SET_NODE_GEOM(itemptr,geom);
+ }
+
+ if(LayoutGraphPlaceEdges(This) != LAYOUT_OK) {
+ result = LAYOUT_ERROR;
+ }
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LayoutTree --
+ *
+ * this procedure is invoked to place icons as tree.
+ *
+ * results:
+ * a standard tcl result.
+ *
+ * side effects:
+ * see the user documentation.
+ *
+ * 09nov95 wmt: add handling of -hideedges
+ *--------------------------------------------------------------
+ */
+
+int
+LayoutTree AC1(Layout_Graph*,This)
+{
+ int result = LAYOUT_OK, counter;
+ ItemGeom geom;
+
+ THIS(maxXPosition) = 0;
+ THIS(maxYPosition) = 0;
+ if(THIS(topList)) {
+ /* free layout specific data slots. */
+ for (counter = 0; counter < THIS(topListNum); counter++) {
+ ckfree((char *) THIS(topList)[counter]);
+ }
+ ckfree((char*)THIS(topList));
+ }
+ THIS(topListNum) = 0;
+ THIS(topList) = (Topology **) NULL;
+
+ /* find the widest/highest edge. */
+ LayoutEdgeWidth(This);
+
+ /* build the internal graph structure. */
+ if(LayoutBuildGraph(This) != LAYOUT_OK) {
+ return LAYOUT_ERROR;
+ }
+
+ /* find root of the graph. */
+ if((THIS(rootNode) = LayoutGraphRoot(This)) == NULL) {
+ THIS(errmsg) = "no root node";
+ return LAYOUT_ERROR;
+ }
+
+ /* sort the graph topological. */
+ LayoutGraphSortTopological(This,THIS(rootNode));
+ FOR_ALL_NODES(counter) {
+ if(PARENT_NUM(THIS(nodes)[counter]) == 0) {
+ LayoutGraphSortTopological(This,THIS(nodes)[counter]);
+ }
+ }
+
+ /* calculate the position values. */
+ RESET_VISITED_NODE(counter);
+ LayoutTreeSetX(This,THIS(rootNode));
+ FOR_ALL_NODES(counter) {
+ if(PARENT_NUM(THIS(nodes)[counter]) == 0) {
+ LayoutTreeSetX(This,THIS(nodes)[counter]);
+ }
+ }
+ RESET_VISITED_NODE(counter);
+ FOR_ALL_TOP_NODES(counter) {
+ LayoutTreeSetY(This,TOP_NODE(counter));
+ }
+
+ /* place the graph items. */
+ if(LayoutGraphPlaceNodes(This) != LAYOUT_OK) {
+ result = LAYOUT_ERROR;
+ }
+ if(THIS(hideEdges)) {
+ /* make all edges zero length, and place at maxX,MaxY
+ to get them out of the way
+ */
+ FOR_ALL_EDGES(counter) {
+ geom.x2 = (geom.x1 = THIS(maxX));
+ geom.y2 = (geom.y1 = THIS(maxY));
+ geom.width = (geom.height = 0);
+ SET_EDGE_GEOM(THIS(edges)[counter],geom);
+ }
+ } else if(LayoutGraphPlaceEdges(This) != LAYOUT_OK) {
+ result = LAYOUT_ERROR;
+ }
+ return result;
+}
+
+Layout_Graph*
+LayoutCreateGraph()
+{
+ register Layout_Graph* This;
+
+ This = (Layout_Graph*)ckalloc(sizeof(Layout_Graph));
+ if(!This) return This;
+#if 1 /* multiX */
+ memset((char *)This,0,sizeof(Layout_Graph));
+#endif
+ /* Initialize global data. */
+ THIS(graphOrder) = 0;
+ THIS(iconSpaceH) = 5;
+ THIS(iconSpaceV) = 5;
+ THIS(xOffset) = 4;
+ THIS(yOffset) = 4;
+ THIS(maxX) = 0;
+ THIS(maxY) = 0;
+ THIS(rootNode) = NULL;
+
+ THIS(keepRandomPositions) = 0;
+ THIS(nodeNum) = 0;
+ THIS(nodes) = NULL;
+ THIS(edgeNum) = 0;
+ THIS(edges) = NULL;
+ THIS(topListNum) = 0;
+ THIS(topList) = NULL;
+ THIS(computeiconsize) = 0;
+ THIS(elementsPerLine) = 0;
+ THIS(hideEdges) = 0;
+ THIS(edgeHeight) = 2;
+ THIS(edgeOrder) = 0;
+ THIS(edgeWidth) = 0;
+ THIS(iconWidth) = 0;
+ THIS(iconHeight) = 0;
+ THIS(posX1) = 0;
+ THIS(posY1) = 0;
+ THIS(posX2) = 0;
+ THIS(posY2) = 0;
+ THIS(gridlock) = 0;
+#if 0
+ THIS(idlist) = NULL;
+#endif
+ THIS(maxXPosition) = 0.0;
+ THIS(maxYPosition) = 0.0;
+#if 1
+ THIS(layoutTypesNum) = 0;
+#else
+ THIS(layoutTypesNum) = 1;
+ THIS(layoutTypes) = (char **) ckalloc(2);
+ THIS(layoutTypes) = (char **) ckalloc(10);
+ *THIS(layoutTypes) = '\0';
+ *(1+THIS(layoutTypes))) = '\0';
+ *THIS(layoutTypes) = (char *) ckalloc(10);
+ strcpy(*THIS(layoutTypes), "icon");
+#endif
+ THIS(errmsg) = (char*)NULL;
+ return This;
+}
+
+LayoutConfig
+GetLayoutConfig(This)
+ struct Layout_Graph* This;
+{
+ LayoutConfig c;
+ c.rootnode = THIS(rootNode)?NODE_ITEM(THIS(rootNode)):NULL;
+ c.graphorder = THIS(graphOrder);
+ c.nodespaceH = (long)THIS(iconSpaceH);
+ c.nodespaceV = (long)THIS(iconSpaceV);
+ c.xoffset = THIS(xOffset);
+ c.yoffset = THIS(yOffset);
+ c.computenodesize = THIS(computeiconsize);
+ c.elementsperline = THIS(elementsPerLine);
+ c.hideedges = THIS(hideEdges);
+ c.keeprandompositions = THIS(keepRandomPositions);
+ c.maxx = THIS(maxX);
+ c.maxy = THIS(maxY);
+ c.gridlock = THIS(gridlock);
+ return c;
+}
+
+void
+SetLayoutConfig(This,c)
+ struct Layout_Graph* This;
+ LayoutConfig c;
+{
+ register int i;
+ THIS(graphOrder) = c.graphorder;
+ THIS(iconSpaceH) = c.nodespaceH;
+ THIS(iconSpaceV) = c.nodespaceV;
+ THIS(xOffset) = c.xoffset;
+ THIS(yOffset) = c.yoffset;
+ THIS(computeiconsize) = c.computenodesize;
+ THIS(elementsPerLine) = c.elementsperline;
+ THIS(hideEdges) = c.hideedges;
+ THIS(keepRandomPositions) = c.keeprandompositions;
+ THIS(maxX) = c.maxx;
+ THIS(maxY) = c.maxy;
+ THIS(gridlock) = c.gridlock;
+
+ /* rootNode needs special work */
+ if(c.rootnode) {
+ FOR_ALL_NODES(i) {
+ if(NODE_ITEM(THIS(nodes)[i]) == c.rootnode) {
+ THIS(rootNode) = THIS(nodes)[i];
+ }
+ }
+ }
+}
+
+int
+LayoutGetIthNode(This,index,idp)
+ struct Layout_Graph* This;
+ long index;
+ pItem* idp;
+{
+ if(index < 0 || index >= THIS(nodeNum)) return LAYOUT_ERROR;
+ *idp = NODE_ITEM(THIS(nodes)[index]);
+ return LAYOUT_OK;
+}
+
+int
+LayoutGetNodeBBox(This,id,geomp)
+ struct Layout_Graph* This;
+ pItem id;
+ ItemGeom* geomp;
+{
+ register Node* ip = NULL;
+ register int i;
+
+ /* find matching node */
+ FOR_ALL_NODES(i) {
+ if(NODE_ITEM(THIS(nodes)[i]) == id) {
+ ip = THIS(nodes)[i];
+ break; /* Khamis 11-oct-96 */
+ }
+ }
+ if(!ip) return LAYOUT_ERROR;
+ *geomp = NODE_GEOM(ip);
+ return LAYOUT_OK;
+}
+
+int
+LayoutSetNodeBBox(This,id,geom)
+ struct Layout_Graph* This;
+ pItem id;
+ ItemGeom geom;
+{
+ register Node* ip = NULL;
+ register int i;
+
+ /* find matching node */
+ FOR_ALL_NODES(i) {
+ if(NODE_ITEM(THIS(nodes)[i]) == id) {
+ ip = THIS(nodes)[i];
+ break; /* Khamis 11-oct-96 */
+ }
+ }
+ if(!ip) return LAYOUT_ERROR;
+ if(!DUMMY_NODE(ip)) {
+ SET_NODE_GEOM(ip,geom);
+ SET_NODE_HEIGHT(ip, CALC_NODE_HEIGHT(ip));
+ SET_NODE_WIDTH(ip, CALC_NODE_WIDTH(ip));
+ } else {
+ SET_NODE_HEIGHT(ip, 1);
+ SET_NODE_WIDTH(ip, 1);
+ }
+ return LAYOUT_OK;
+}
+
+int
+LayoutGetIthEdge(This,index,idp)
+ struct Layout_Graph* This;
+ long index;
+ pItem* idp;
+{
+ if(index < 0 || index >= THIS(edgeNum)) return LAYOUT_ERROR;
+ *idp = EDGE_ITEM(THIS(edges)[index]);
+ return LAYOUT_OK;
+}
+
+int
+LayoutGetEdgeEndPoints(This,id,geomp)
+ struct Layout_Graph* This;
+ pItem id;
+ ItemGeom* geomp;
+{
+ register Edge* ip = NULL;
+ register int i;
+
+ /* find matching edge */
+ FOR_ALL_EDGES(i) {
+ if(EDGE_ITEM(THIS(edges)[i]) == id) {
+ ip = THIS(edges)[i];
+ break; /* Khamis 11-oct-96 */
+ }
+ }
+ if(!ip) return LAYOUT_ERROR;
+ *geomp = EDGE_GEOM(ip);
+ return LAYOUT_OK;
+}
+
+int
+LayoutSetEdgeDim(This,id,geom)
+ struct Layout_Graph* This;
+ pItem id;
+ ItemGeom geom;
+{
+ register Edge* ip = NULL;
+ register int i;
+
+ /* find matching edge */
+ FOR_ALL_EDGES(i) {
+ if(EDGE_ITEM(THIS(edges)[i]) == id) {
+ ip = THIS(edges)[i];
+ break; /* Khamis 11-oct-96 */
+ }
+ }
+ if(!ip) return LAYOUT_ERROR;
+ SET_EDGE_GEOM(ip,geom);
+ return LAYOUT_OK;
+}
+
+char*
+LayoutGetError(This)
+ struct Layout_Graph* This;
+{
+ register char* msg = THIS(errmsg);
+ THIS(errmsg) = (char*)0;
+ return msg;
+}
+
+
+/* KHAMIS */
+
+void * MY_EdgeFromNode (This, i)
+ struct Layout_Graph* This;
+ int i;
+{
+ return THIS(edges)[i]->fromNode;
+}
+
+void * MY_EdgeToNode (This, i)
+ struct Layout_Graph* This;
+ int i;
+{
+ return THIS(edges)[i]->toNode;
+}
+
+int MY_EdgeParentNum (This, i)
+ struct Layout_Graph* This;
+ int i;
+{
+ return THIS(edges)[i]->toNode->parentNum;
+}
+
+void * MY_EdgeParent (This, i, num)
+ struct Layout_Graph* This;
+ int i;
+ int num;
+{
+ return THIS(edges)[i]->toNode->parent[num]->fromNode;
+}
+
+int MY_EdgeSuccNum (This, i)
+ struct Layout_Graph* This;
+ int i;
+{
+ return THIS(edges)[i]->fromNode->succNum;
+}
+
+void * MY_EdgeSucc (This, i, num)
+ struct Layout_Graph* This;
+ int i;
+{
+ return THIS(edges)[i]->fromNode->succ[num]->toNode;
+}
+
+int MY_graphOrder (This)
+ struct Layout_Graph* This;
+{
+ return THIS(graphOrder);
+}
+
+/* KHAMIS END */
+
diff --git a/libgui/src/tkCanvLayout.h b/libgui/src/tkCanvLayout.h
new file mode 100644
index 00000000000..35f02a8f001
--- /dev/null
+++ b/libgui/src/tkCanvLayout.h
@@ -0,0 +1,117 @@
+#ifndef LAYOUT_H
+#define LAYOUT_H 1
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/*
+Unlike the original code, we assume that the set of nodes
+known to this layout graph is always kept 1-1 with the set
+of dual nodes. Similarly with respect to edges.
+This implies that every time a dual is created/deleted,
+that the corresponding create/delete methods must be
+called in the layout graph class.
+Additionally, we assume the existence of two ``update''
+methods that propagate the correct location and size info
+between the layout graph nodes and their duals.
+*/
+
+struct Layout_Graph; /* hidden */
+
+/* ptr to user's node info */
+typedef void* pItem;
+
+/*
+As inputs, we need the following:
+
+For nodes: bbox that just surrounds the node.
+For edges: width and height of the text (if any)
+ associated with the edge.
+
+As outputs, we provide the following:
+
+For nodes: new absolute position of the northwest corner
+ of the bbox for the node.
+For edges: (x,y) coordinates of the endpoints of the edge.
+
+To avoid proliferation of types,
+we define a single struct (ItemGeom)
+that is used to carry all the input and output info.
+
+Item type Direction ItemGeom Fields Used
+--------- --------- --------------------
+Node In x1,y1,x2,y2
+ Out x1,y1
+Edge In width,height
+ Out x1,y1,x2,y2
+
+*/
+
+/* All values are in pixels */
+struct ItemGeom {
+ double x1,y1;
+ double x2,y2;
+ double width,height;
+};
+typedef struct ItemGeom ItemGeom;
+
+struct LayoutConfig {
+ pItem rootnode;
+ int graphorder;
+ int nodespaceH;
+ int nodespaceV;
+ int xoffset;
+ int yoffset;
+ int computenodesize;
+ int elementsperline;
+ int hideedges;
+ int keeprandompositions;
+ int maxx;
+ int maxy;
+ int gridlock;
+};
+typedef struct LayoutConfig LayoutConfig;
+
+extern LayoutConfig GetLayoutConfig _ANSI_ARGS_((struct Layout_Graph*));
+extern void SetLayoutConfig _ANSI_ARGS_((struct Layout_Graph*, LayoutConfig));
+
+extern int LayoutISI _ANSI_ARGS_((struct Layout_Graph*));
+extern int LayoutTree _ANSI_ARGS_((struct Layout_Graph*));
+extern int LayoutMatrix _ANSI_ARGS_((struct Layout_Graph*));
+extern int LayoutRandom _ANSI_ARGS_((struct Layout_Graph*));
+
+#if DEBUGGING
+extern void LayoutDebugging _ANSI_ARGS_((struct Layout_Graph*, struct Node *currentnode, char *string, int type));
+#endif
+
+extern struct Layout_Graph* LayoutCreateGraph _ANSI_ARGS_(());
+extern void LayoutFreeGraph _ANSI_ARGS_((struct Layout_Graph*));
+extern void LayoutClearGraph _ANSI_ARGS_((struct Layout_Graph*));
+
+extern int LayoutCreateNode _ANSI_ARGS_((struct Layout_Graph*,
+ pItem nodeid,
+ pItem from, pItem to));
+extern int LayoutDeleteNode _ANSI_ARGS_((struct Layout_Graph*, pItem nodeid));
+extern int LayoutCreateEdge _ANSI_ARGS_((struct Layout_Graph*,
+ pItem edgeid,
+ pItem from, pItem to));
+extern int LayoutDeleteEdge _ANSI_ARGS_((struct Layout_Graph*, pItem edgeid));
+
+extern int LayoutGetIthNode _ANSI_ARGS_((struct Layout_Graph*, long, pItem*));
+
+extern int LayoutGetIthEdge _ANSI_ARGS_((struct Layout_Graph*, long, pItem*));
+
+extern int LayoutGetNodeBBox _ANSI_ARGS_((struct Layout_Graph*, pItem, ItemGeom*));
+extern int LayoutSetNodeBBox _ANSI_ARGS_((struct Layout_Graph*, pItem, ItemGeom));
+
+extern int LayoutGetEdgeEndPoints _ANSI_ARGS_((struct Layout_Graph*, pItem, ItemGeom*));
+extern int LayoutSetEdgeDim _ANSI_ARGS_((struct Layout_Graph*, pItem, ItemGeom));
+
+extern char* LayoutGetError _ANSI_ARGS_((struct Layout_Graph*));
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif /*LAYOUT_H*/
diff --git a/libgui/src/tkGraphCanvas.c b/libgui/src/tkGraphCanvas.c
new file mode 100644
index 00000000000..c6ed1e71eef
--- /dev/null
+++ b/libgui/src/tkGraphCanvas.c
@@ -0,0 +1,893 @@
+#include "default.h"
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.h"
+#include "tkCanvLayout.h"
+
+extern Tk_ItemType tkEdgeType;
+
+static Tk_Uid allUid = NULL;
+
+typedef struct Layout_Graph Layout_Graph;
+
+static
+char* layableitems[] = {
+ "bitmap",
+ "edge",
+ "oval",
+ "polygon",
+ "rectangle",
+ "text",
+ "window",
+ (char*)0
+};
+
+/* Define a config set for graph command */
+static Tk_ConfigSpec graphspecs[] = {
+ {TK_CONFIG_BOOLEAN, "-computenodesize", (char*)NULL, (char*)NULL,
+ "0", Tk_Offset(LayoutConfig,computenodesize), 0, (Tk_CustomOption*)NULL},
+ {TK_CONFIG_INT, "-gridlock", (char*)NULL, (char*)NULL,
+ "0", Tk_Offset(LayoutConfig,gridlock), 0, (Tk_CustomOption*)NULL},
+ {TK_CONFIG_INT, "-elementsperline", (char*)NULL, (char*)NULL,
+ "0", Tk_Offset(LayoutConfig,elementsperline), 0, (Tk_CustomOption*)NULL},
+ {TK_CONFIG_BOOLEAN, "-hideedges", (char*)NULL, (char*)NULL,
+ "0", Tk_Offset(LayoutConfig,hideedges), 0, (Tk_CustomOption*)NULL},
+ {TK_CONFIG_BOOLEAN, "-keeprandompositions", (char*)NULL, (char*)NULL,
+ "0", Tk_Offset(LayoutConfig,keeprandompositions), 0, (Tk_CustomOption*)NULL},
+ {TK_CONFIG_PIXELS, "-nodespaceh", (char*)NULL, (char*)NULL,
+ "5", Tk_Offset(LayoutConfig,nodespaceH), 0, (Tk_CustomOption*)NULL},
+ {TK_CONFIG_PIXELS, "-nodespacev", (char*)NULL, (char*)NULL,
+ "5", Tk_Offset(LayoutConfig,nodespaceV), 0, (Tk_CustomOption*)NULL},
+ {TK_CONFIG_PIXELS, "-maxx", (char*)NULL, (char*)NULL,
+ (char*)NULL, Tk_Offset(LayoutConfig,maxx),
+ TK_CONFIG_DONT_SET_DEFAULT, (Tk_CustomOption*)NULL},
+ {TK_CONFIG_PIXELS, "-maxy", (char*)NULL, (char*)NULL,
+ (char*)NULL, Tk_Offset(LayoutConfig,maxy),
+ TK_CONFIG_DONT_SET_DEFAULT, (Tk_CustomOption*)NULL},
+ {TK_CONFIG_INT, "-order", (char*)NULL, (char*)NULL,
+ "0", Tk_Offset(LayoutConfig,graphorder), 0, (Tk_CustomOption*)NULL},
+ {TK_CONFIG_PIXELS, "-xoffset", (char*)NULL, (char*)NULL,
+ "4", Tk_Offset(LayoutConfig,xoffset), 0, (Tk_CustomOption*)NULL},
+ {TK_CONFIG_PIXELS, "-yoffset", (char*)NULL, (char*)NULL,
+ "4", Tk_Offset(LayoutConfig,yoffset), 0, (Tk_CustomOption*)NULL},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * 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;
+
+static Tk_Item * NextItem _ANSI_ARGS_((TagSearch *searchPtr));
+static Tk_Item * StartTagSearch _ANSI_ARGS_((TkCanvas *canvasPtr,
+ char *tag, TagSearch *searchPtr));
+static Tcl_HashTable * graph_table _ANSI_ARGS_((Tcl_Interp *interp));
+
+int MY_graphOrder (struct Layout_Graph* This);
+void * MY_EdgeParent (struct Layout_Graph* This, int i, int num);
+void * MY_EdgeFromNode (struct Layout_Graph* This, int i);
+
+
+static
+int
+getnodebbox(interp,canvasPtr, iPtr, bbox)
+ Tcl_Interp* interp;
+ TkCanvas* canvasPtr;
+ Tk_Item* iPtr;
+ ItemGeom* bbox;
+{
+ bbox->x1 = iPtr->x1;
+ bbox->y1 = iPtr->y1;
+ bbox->x2 = iPtr->x2;
+ bbox->y2 = iPtr->y2;
+ return TCL_OK;
+}
+
+static
+int
+getedgedim(canvasPtr, e, dim)
+ TkCanvas* canvasPtr;
+ Tk_Item* e;
+ ItemGeom* dim;
+{
+ int argc2;
+ char **argv2;
+
+ /* Read the text height of this edge. */
+ Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin,
+ e->typePtr->configSpecs,
+ (char *) e, "-textheight", 0);
+ if(Tcl_SplitList(canvasPtr->interp, canvasPtr->interp->result,
+ &argc2, &argv2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ dim->height = atol(argv2[4]);
+ ckfree((char *) argv2);
+ /* Read the text width of this edge. */
+ Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin,
+ e->typePtr->configSpecs,
+ (char *) e, "-textwidth", 0);
+ if(Tcl_SplitList(canvasPtr->interp, canvasPtr->interp->result,
+ &argc2, &argv2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ dim->width = atol(argv2[4]);
+ ckfree((char *) argv2);
+ Tcl_ResetResult(canvasPtr->interp);
+ return TCL_OK;
+}
+
+static
+int
+setnodegeom(interp,canvasPtr,iPtr,geom)
+ Tcl_Interp* interp;
+ TkCanvas* canvasPtr;
+ Tk_Item* iPtr;
+ ItemGeom geom;
+{
+ double deltax, deltay;
+
+ if(iPtr->typePtr->translateProc == NULL) {
+ Tcl_AppendResult(interp,"item has no translation proc",(char*)0);
+ return TCL_ERROR;
+ }
+
+ /* get the delta x,y of the item */
+ deltax = geom.x1 - iPtr->x1;
+ deltay = geom.y1 - iPtr->y1;
+
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, iPtr->x1, iPtr->y1, iPtr->x2, iPtr->y2);
+ (void)(*iPtr->typePtr->translateProc)((Tk_Canvas) canvasPtr, iPtr, deltax, deltay);
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, iPtr->x1, iPtr->y1, iPtr->x2, iPtr->y2);
+ return TCL_OK;
+}
+
+static Layout_Graph *
+GetGraphLayoutII(TkCanvas *canvasPtr, Tcl_Interp *interp);
+static
+int
+setedgegeom(interp,canvasPtr,iPtr,geom,i)
+ Tcl_Interp* interp;
+ TkCanvas* canvasPtr;
+ Tk_Item* iPtr;
+ ItemGeom geom;
+ int i;
+{
+ /* register char* nm;
+ register int c; */
+ int argc = 4;
+ char x1[TCL_DOUBLE_SPACE];
+ char y1[TCL_DOUBLE_SPACE];
+ char x2[TCL_DOUBLE_SPACE];
+ char y2[TCL_DOUBLE_SPACE];
+ char x3[TCL_DOUBLE_SPACE];
+ char y3[TCL_DOUBLE_SPACE];
+ char x4[TCL_DOUBLE_SPACE];
+ char y4[TCL_DOUBLE_SPACE];
+ char* argv[8];
+ Layout_Graph *graph=GetGraphLayoutII(canvasPtr, interp);
+
+ LayoutConfig cnf = GetLayoutConfig (/*canvasPtr->*/graph);
+ double xd = geom.x1 - geom.x2 /*- 10.0*/ , xdiff;
+
+ if (xd < 0.0) xd = geom.x2 - geom.x1 /*- 10.0*/;
+
+ if(iPtr->typePtr->coordProc == NULL) {
+ Tcl_AppendResult(interp,"could not set edge item coordinates",(char*)0);
+ return TCL_ERROR;
+ }
+ argv[0] = x1;
+ argv[1] = y1;
+ argv[2] = x2;
+ argv[3] = y2;
+ argv[4] = x3;
+ argv[5] = y3;
+ argv[6] = x4;
+ argv[7] = y4;
+
+ sprintf(x1,"%g",geom.x1);
+ sprintf(y1,"%g",geom.y1);
+ sprintf(x2,"%g",geom.x2);
+ sprintf(y2,"%g",geom.y2);
+
+ if (cnf.gridlock!=0)
+ {
+ /* changing lines, only when right to left */
+ if (! MY_graphOrder (/*canvasPtr->*/graph))
+ {
+ xdiff = (double) cnf.nodespaceH - xd;
+ if (xdiff < 0.0) xdiff = xd - (double) cnf.nodespaceH;
+
+ if (xdiff < 2.0 &&
+ MY_EdgeParent(/*canvasPtr->*/graph, i, 0) ==
+ MY_EdgeFromNode (/*canvasPtr->*/graph, i))
+ {
+ sprintf (x4, "%g", geom.x2);
+ sprintf (y4, "%g", geom.y2);
+
+ sprintf (x2, "%g", geom.x1 + (geom.x2 - geom.x1) / 2);
+ sprintf (y2, "%g", geom.y1);
+ sprintf (x3, "%g", geom.x1 + (geom.x2 - geom.x1) / 2);
+ sprintf (y3, "%g", geom.y2);
+ argc = 8;
+ }
+ }
+ }
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, iPtr->x1, iPtr->y1, iPtr->x2, iPtr->y2);
+ (void)(*iPtr->typePtr->coordProc)(interp, (Tk_Canvas) canvasPtr, iPtr,
+ /* argc-3, argv+3); 08nov95 wmt */
+ argc, argv);
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, iPtr->x1, iPtr->y1, iPtr->x2, iPtr->y2);
+ return TCL_OK;
+}
+
+static
+int
+GetEdgeNodes(interp,canvasPtr,i,fp,tp)
+ Tcl_Interp* interp;
+ TkCanvas* canvasPtr;
+ Tk_Item* i;
+ char** fp;
+ char** tp;
+{
+ int argc;
+ char** argv;
+
+ /* Read the from node id of this edge. */
+ Tk_ConfigureInfo(interp, canvasPtr->tkwin,
+ i->typePtr->configSpecs,
+ (char *) i, "-from", 0);
+ if(Tcl_SplitList(interp, interp->result,
+ &argc, &argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *fp = strdup(argv[4]);
+ ckfree((char*)argv);
+ /* Read the to node id of this edge. */
+ Tk_ConfigureInfo(interp, canvasPtr->tkwin,
+ i->typePtr->configSpecs,
+ (char *) i, "-to", 0);
+ if(Tcl_SplitList(interp, interp->result,
+ &argc, &argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *tp = strdup(argv[4]);
+ ckfree((char*)argv);
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+
+
+int
+createcanvasgraph(interp,canvCmd,graph)
+ Tcl_Interp* interp;
+ Tcl_CmdInfo *canvCmd;
+ Layout_Graph **graph;
+{
+ LayoutConfig cfg;
+ int argc1; char* argv1[3];
+
+ *graph = LayoutCreateGraph();
+ if(!*graph) {
+ Tcl_AppendResult(interp,"cannot create graph for canvas",(char*)0);
+ return TCL_ERROR;
+ }
+ cfg = GetLayoutConfig(*graph);
+ /* Establish max x and max y based on canvas height/width */
+ argv1[0] = "<graph-canvas>";
+ argv1[1] = "cget";
+ argv1[2] = "-width";
+ argc1 = 3;
+ if ((canvCmd->proc)(canvCmd->clientData, interp, argc1, argv1)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ cfg.maxx = atol(Tcl_GetStringResult(interp));
+
+ argv1[2] = "-height";
+ if ((canvCmd->proc) (canvCmd->clientData, interp, argc1, argv1)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ cfg.maxy = atol(Tcl_GetStringResult(interp));
+ Tcl_ResetResult(interp);
+ SetLayoutConfig(*graph,cfg);
+ return TCL_OK;
+}
+
+static Tcl_HashTable *
+graph_table (Tcl_Interp *interp)
+{
+ return (Tcl_HashTable *) Tcl_GetAssocData (interp, "canvasgraph", NULL);
+}
+
+/*
+ *-------------------------------------------------------------
+ *
+ * GetGraphLayout --
+ * Gets graph info for canvas. Adds a new entry if needed.
+ *
+ * Results:
+ * Standard Tcl Error
+ *-------------------------------------------------------------
+ */
+
+static Layout_Graph *
+GetGraphLayout(canvCmd, interp)
+ Tcl_CmdInfo *canvCmd;
+ Tcl_Interp *interp;
+{
+ Tcl_HashEntry *entry;
+
+ entry = Tcl_FindHashEntry(graph_table(interp), (char *)canvCmd->clientData);
+ if (entry)
+ return (Layout_Graph *)Tcl_GetHashValue(entry);
+
+ return NULL;
+}
+
+static Layout_Graph *
+GetGraphLayoutII(canvasPtr, interp)
+ TkCanvas *canvasPtr;
+ Tcl_Interp *interp;
+{
+ Tcl_HashEntry *entry;
+ entry = Tcl_FindHashEntry(graph_table(interp), (char *)canvasPtr);
+ if (entry)
+ return (Layout_Graph *)Tcl_GetHashValue(entry);
+
+ return NULL;
+}
+
+static int
+GetCreatedGraphLayout(interp, canvCmd, graph)
+ Tcl_Interp *interp;
+ Tcl_CmdInfo *canvCmd;
+ Layout_Graph **graph;
+{
+ *graph = GetGraphLayout(canvCmd, interp);
+ if (*graph == NULL) {
+ Tcl_HashEntry *newitem;
+ int new;
+
+ /* No item, let's make one and add it to the table. */
+ if (createcanvasgraph(interp, canvCmd, graph) != TCL_OK)
+ return TCL_ERROR;
+ newitem = Tcl_CreateHashEntry(graph_table(interp),
+ (char *)(canvCmd->clientData), &new);
+ Tcl_SetHashValue(newitem, (ClientData) *graph);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GraphCanvasCmd --
+ * This procedure is invoked to process the new "graph"
+ * command. This command takes a canvas and uses it to layout
+ * the canvas items with a pretty graph structure.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+GraphCanvasCmd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int argc;
+ char **argv;
+{
+ Tcl_CmdInfo canvCmd;
+ size_t length;
+ int c, i;
+ Layout_Graph *graph;
+ TkCanvas *canvasPtr;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " canvas option ?arg arg ...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* The second arg is the canvas widget */
+ if (!Tcl_GetCommandInfo(interp, argv[1], &canvCmd)) {
+ Tcl_AppendResult(interp, "couldn't get canvas information for \"",
+ argv[1], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ canvasPtr = (TkCanvas *)(canvCmd.clientData);
+
+ c = argv[2][0];
+ length = strlen(argv[2]);
+ if ((c == 'a') && (strncmp(argv[2], "add", length) == 0)) {
+ char* newargv[4];
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " ", argv[1], " add tagOrId ?tagOrId ...?\"",
+ (char *) NULL);
+ goto error;
+ }
+
+ if (GetCreatedGraphLayout(interp, &canvCmd, &graph) != TCL_OK)
+ goto error;
+
+ for (i = 3; i < argc; i++) {
+ Tk_Item *itemPtr;
+ TagSearch search;
+ /* Loop through all the items */
+ for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ char* nm = itemPtr->typePtr->name;
+ /* create a new edge or node */
+ if(strcmp(nm,"edge") == 0) {
+ char* fname;
+ char* tname;
+ Tk_Item* f;
+ Tk_Item* t;
+ /* find the from and to node pItems */
+ if(GetEdgeNodes(interp,canvasPtr,itemPtr,&fname,&tname) != TCL_OK)
+ goto error;
+ /* find the from and to node pItems */
+ f = StartTagSearch(canvasPtr, fname, &search);
+ t = StartTagSearch(canvasPtr, tname, &search);
+ ckfree(fname); ckfree(tname);
+ if(LayoutCreateEdge(graph,
+ (pItem)itemPtr,
+ (pItem)f, (pItem)t) != TCL_OK) {
+ char* msg = LayoutGetError(graph);
+ if(!msg)
+ msg = "could not record edge in graph";
+ Tcl_AppendResult(interp,msg,(char*)0);
+ goto error;
+ }
+ } else { /* not an edge; assume a node */
+ /* verify that we can handle this */
+ char** p;
+ for(p=layableitems;*p;p++) {
+ if(strcmp(*p,nm)==0) break;
+ }
+ if(!*p) {
+ Tcl_AppendResult(interp,"cannot yet handle ",nm,(char*)0);
+ goto error;
+ }
+ if(LayoutCreateNode(graph,
+ (pItem)itemPtr,NULL,NULL) !=TCL_OK) {
+ char* msg = LayoutGetError(graph);
+ if(!msg)
+ msg = "could not record node in graph";
+ Tcl_AppendResult(interp,msg,(char*)0);
+ goto error;
+ }
+ }
+ }
+ }
+
+ } else if ((c == 'c') && (strncmp(argv[2], "configure", length) == 0)) {
+ register int ok;
+ LayoutConfig cfg;
+ if (GetCreatedGraphLayout(interp, &canvCmd, &graph) != TCL_OK)
+ goto error;
+ cfg = GetLayoutConfig(graph);
+
+ if(argc == 3) {
+ /* get all options */
+ ok = Tk_ConfigureInfo(interp,
+ Tk_CanvasTkwin(*(Tk_Canvas *)canvasPtr),
+ graphspecs,(char*)&cfg, (char*)NULL, 0);
+ } else if(argc == 4) {
+ /* get one option */
+ ok = Tk_ConfigureInfo(interp,
+ Tk_CanvasTkwin(*(Tk_Canvas *)canvasPtr),
+ graphspecs,(char*)&cfg, argv[3], 0);
+ } else { /* setting one or more options */
+ ok = Tk_ConfigureWidget(interp,
+ Tk_CanvasTkwin(*(Tk_Canvas *)canvasPtr),
+ graphspecs, argc-3, argv+3,
+ (char*)&cfg, TK_CONFIG_ARGV_ONLY);
+ if(ok == TCL_OK) {
+ SetLayoutConfig(graph,cfg);
+ }
+ }
+ if(ok != TCL_OK) goto error;
+ } else if ((c == 'c') && (strncmp(argv[2], "clear", length) == 0)) {
+ /* clear graph; ignore if no graph */
+ Layout_Graph *graph = GetGraphLayout(&canvCmd, interp);
+ if (graph)
+ LayoutClearGraph(graph);
+ } else if ((c == 'd') && (strncmp(argv[2], "destroy", length) == 0)) {
+ /* destroy any graph info connected to the canvas,
+ but without destroying the canvas
+ */
+ Layout_Graph *graph = GetGraphLayout(&canvCmd, interp);
+ if (graph) {
+ Tcl_HashEntry *entry;
+ entry = Tcl_FindHashEntry(graph_table(interp),
+ (char *)(canvCmd.clientData));
+
+ LayoutFreeGraph(graph);
+ /* Remove hash table entry */
+ Tcl_DeleteHashEntry(entry);
+ }
+ } else if ((c == 'e') && (strncmp(argv[2], "edges", length) == 0)) {
+ Tk_Item* ip;
+ Layout_Graph *graph = GetGraphLayout(&canvCmd, interp);
+ /* return list of edges associated with graph, if any */
+ if(!graph) goto done;
+ for(i=0;LayoutGetIthEdge(graph,i,(pItem*)&ip)==TCL_OK;i++) {
+ char convertbuffer[20];
+ sprintf(convertbuffer, "%d", ip->id);
+ Tcl_AppendElement(interp,convertbuffer);
+ }
+ } else if ((c == 'l') && (strncmp(argv[2], "layout", length) == 0)) {
+ char* which;
+ Tk_Item* ip;
+ Layout_Graph *graph = GetGraphLayout(&canvCmd, interp);
+
+ if(!graph) goto done;
+
+ /* get the geometries of the items attached to the graph */
+ for(i=0;LayoutGetIthNode(graph,i,(pItem*)&ip)==TCL_OK;i++) {
+ ItemGeom geom;
+ if(getnodebbox(interp,canvasPtr,ip,&geom) != TCL_OK
+ || LayoutSetNodeBBox(graph,ip,geom) != TCL_OK) {
+ Tcl_AppendResult(interp, "could not get node location", (char *) NULL);
+ goto error;
+ }
+ }
+ for(i=0;LayoutGetIthEdge(graph,i,(pItem*)&ip)==TCL_OK;i++) {
+ ItemGeom geom;
+ if(getedgedim(canvasPtr,ip,&geom) != TCL_OK
+ || LayoutSetEdgeDim(graph,ip,geom) != TCL_OK) {
+ Tcl_AppendResult(interp, "could not get edge location", (char *) NULL);
+ goto error;
+ }
+ }
+
+ if(argc > 3) which = argv[3]; else which = "isi";
+ if(strcmp(which,"tree")==0) {
+ if(LayoutTree(graph) == TCL_ERROR) {
+ Tcl_AppendResult(interp, "layout failed",(char *) NULL);
+ goto error;
+ }
+ } else if(strcmp(which,"isi")==0) {
+ if(LayoutISI(graph) == TCL_ERROR) {
+ Tcl_AppendResult(interp, "layout failed",(char *) NULL);
+ goto error;
+ }
+ } else if(strcmp(which,"matrix")==0) {
+ if(LayoutMatrix(graph) == TCL_ERROR) {
+ Tcl_AppendResult(interp, "layout failed",(char *) NULL);
+ goto error;
+ }
+ } else if(strcmp(which,"random")==0) {
+ if(LayoutRandom(graph) == TCL_ERROR) {
+ Tcl_AppendResult(interp, "layout failed",(char *) NULL);
+ goto error;
+ }
+ } else {
+ Tcl_AppendResult(interp, "unknown layout algorithm", which, (char *) NULL);
+ goto error;
+ }
+ /* move the various items into place after layout */
+ for(i=0;LayoutGetIthNode(graph,i,(pItem*)&ip)==TCL_OK;i++) {
+ ItemGeom geom;
+ if(LayoutGetNodeBBox(graph,ip,&geom) != TCL_OK
+ || setnodegeom(interp,canvasPtr,ip,geom) != TCL_OK) {
+ Tcl_AppendResult(interp, "could not set node location", (char *) NULL);
+ goto error;
+ }
+ }
+ for(i=0;LayoutGetIthEdge(graph,i,(pItem*)&ip)==TCL_OK;i++) {
+ ItemGeom geom;
+ if(LayoutGetEdgeEndPoints(graph,ip,&geom) != TCL_OK
+ || setedgegeom(interp,canvasPtr,ip,geom,i) != TCL_OK) {
+ Tcl_AppendResult(interp, "could not set edge location", (char *) NULL);
+ goto error;
+ }
+ }
+ } else if ((c == 'n') && (strncmp(argv[2], "nodes", length) == 0)) {
+ Tk_Item* ip;
+ Layout_Graph *graph = GetGraphLayout(&canvCmd, interp);
+
+ /* return list of nodes associated with graph */
+ if(!graph) goto done;
+ for(i=0;LayoutGetIthNode(graph,i,(pItem*)&ip)==TCL_OK;i++) {
+ char convertbuffer[20];
+ sprintf(convertbuffer, "%d", ip->id);
+ Tcl_AppendElement(interp,convertbuffer);
+ }
+ } else if ((c == 'r') && (strncmp(argv[2], "remove", length) == 0)) {
+ char* nm;
+ Tk_Item *itemPtr;
+ TagSearch search;
+ Layout_Graph *graph = GetGraphLayout(&canvCmd, interp);
+
+ if(!graph) goto done;
+ for (i = 3; i < argc; i++) {
+ for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ nm = itemPtr->typePtr->name;
+ /* delete a new edge or node */
+ if(strcmp(nm,"edge") == 0) {
+ (void)LayoutDeleteEdge(graph,itemPtr);
+ } else { /* not an edge; assume a node */
+ (void)LayoutDeleteNode(graph,itemPtr);
+ }
+ }
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[2],
+ "\": must be add, configure, clear, ",
+ "destroy, edges, layout, nodes, remove",
+ (char *) NULL);
+ goto error;
+ }
+ done:
+ return TCL_OK;
+ error:
+ return TCL_ERROR;
+}
+
+/* If graph is deleted, make it go away */
+static void
+delete_graph_command(ClientData clientData, Tcl_Interp *interp)
+{
+ Tcl_DeleteHashTable((Tcl_HashTable *) clientData);
+
+ ckfree ((char*) clientData);
+}
+
+/*
+ *-------------------------------------------------------------
+ * GraphLayoutInit()
+ * Adds appropriate commands to Tcl interpreter, and
+ * inits necessary tables.
+ *-------------------------------------------------------------
+ */
+int
+create_graph_command(Tcl_Interp *interp)
+{
+ Tcl_HashTable *graphTable= (Tcl_HashTable*)ckalloc (sizeof (Tcl_HashTable));
+
+ Tcl_InitHashTable(graphTable, TCL_ONE_WORD_KEYS);
+
+ /*
+ * Create an associated data that stores the
+ * hash table
+ */
+ Tcl_SetAssocData (interp, "canvasgraph",
+ delete_graph_command,
+ (void*) graphTable);
+
+ allUid = Tk_GetUid("all");
+
+ if (Tcl_CreateCommand(interp, "graph", GraphCanvasCmd,
+ NULL, NULL /*delete_graph_command*/ ) == NULL)
+ return TCL_ERROR;
+
+ Tk_CreateItemType(&tkEdgeType);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * StartTagSearch --
+ *
+ * This procedure is called to initiate an enumeration of
+ * all items in a given canvas that contain a given tag.
+ *
+ * Results:
+ * The return value is a pointer to the first item in
+ * canvasPtr that matches tag, or NULL if there is no
+ * such item. The information at *searchPtr is initialized
+ * such that successive calls to NextItem will return
+ * successive items that match tag.
+ *
+ * Side effects:
+ * SearchPtr is linked into a list of searches in progress
+ * on canvasPtr, so that elements can safely be deleted
+ * while the search is in progress. EndTagSearch must be
+ * called at the end of the search to unlink searchPtr from
+ * this list.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tk_Item *
+StartTagSearch(canvasPtr, tag, searchPtr)
+ 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;
+
+ 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)) {
+ 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * NextItem --
+ *
+ * This procedure returns successive items that match a given
+ * tag; it should be called only after StartTagSearch has been
+ * used to begin a search.
+ *
+ * Results:
+ * The return value is a pointer to the next item that matches
+ * the tag specified to StartTagSearch, or NULL if no such
+ * item exists. *SearchPtr is updated so that the next call
+ * to this procedure will return the next item.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+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;
+}
diff --git a/libgui/src/tkTable.c b/libgui/src/tkTable.c
new file mode 100644
index 00000000000..b6f0d7a3430
--- /dev/null
+++ b/libgui/src/tkTable.c
@@ -0,0 +1,4898 @@
+/*
+ * tkTable.c --
+ *
+ * This module implements table widgets for the Tk
+ * toolkit. An table displays a 2D array of strings
+ * and allows the strings to be edited.
+ *
+ * Based on Tk3 table widget written by Roland King
+ *
+ * Updates 1996 by:
+ * Jeffrey Hobbs jeff.hobbs@acm.org
+ * John Ellson ellson@lucent.com
+ * Peter Bruecker peter@bj-ig.de
+ * Tom Moore tmoore@spatial.ca
+ * Sebastian Wangnick wangnick@orthogon.de
+ *
+ * Copyright (c) 1997-1998 Jeffrey Hobbs
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include "tkTable.h"
+#ifdef DEBUG
+#include "../../dprint.h"
+#endif
+
+INLINE static void TableFlushCache _ANSI_ARGS_((Table *tablePtr));
+static int TableClear _ANSI_ARGS_((register Table *tablePtr, int mode,
+ char *first, char *last));
+INLINE static void TableGetGc _ANSI_ARGS_((Display *display, Drawable d,
+ TableTag *tagPtr, GC *tagGc));
+static void TableRedrawHighlight _ANSI_ARGS_((Table *tablePtr));
+static void TableDisplay _ANSI_ARGS_((ClientData clientdata));
+static void TableFlashEvent _ANSI_ARGS_((ClientData clientdata));
+static void TableAddFlash _ANSI_ARGS_((Table *tablePtr, int row, int col));
+static void TableSetActiveIndex _ANSI_ARGS_((register Table *tablePtr));
+static void TableGetActiveBuf _ANSI_ARGS_((register Table *tablePtr));
+static char * TableVarProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, char *name, char *index,
+ int flags));
+static void TableGeometryRequest _ANSI_ARGS_((Table *tablePtr));
+static void TableAdjustActive _ANSI_ARGS_((register Table *tablePtr));
+static void TableAdjustParams _ANSI_ARGS_((register Table *tablePtr));
+static void TableCursorEvent _ANSI_ARGS_((ClientData clientData));
+static void TableConfigCursor _ANSI_ARGS_((register Table *tablePtr));
+static int TableFetchSelection _ANSI_ARGS_((ClientData clientData,
+ int offset, char *buffer, int maxBytes));
+static void TableLostSelection _ANSI_ARGS_((ClientData clientData));
+static Tk_RestrictAction TableRestrictProc _ANSI_ARGS_((ClientData arg,
+ XEvent *eventPtr));
+static int TableValidateChange _ANSI_ARGS_((Table *tablePtr, int r,
+ int c, char *old, char *new, int index));
+static void TableDeleteChars _ANSI_ARGS_((register Table *tablePtr,
+ int index, int count));
+static void TableInsertChars _ANSI_ARGS_((register Table *tablePtr,
+ int index, char *string));
+static int TableWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void TableDestroy _ANSI_ARGS_((ClientData clientdata));
+static void TableEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int TableConfigure _ANSI_ARGS_((Tcl_Interp *interp,
+ Table *tablePtr, int argc, char **argv,
+ int flags, int forceUpdate));
+static void TableCmdDeletedProc _ANSI_ARGS_((ClientData clientData));
+static int TableCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+/*
+ * The list of command values for all the widget commands
+ * We could use enum for many of these #defines, but it adds
+ * just that much more code size...
+ */
+#define CMD_ACTIVATE 1 /* activate command a la listbox */
+#define CMD_BBOX 3 /* bounding box of cell <index> */
+#define CMD_BORDER 5 /* border movement function */
+#define CMD_CGET 7 /* basic cget widget command */
+#define CMD_CLEAR 8 /* clear state command */
+#define CMD_CONFIGURE 9 /* general configure command */
+#define CMD_CURSELECTION 11 /* get current selected cell(s) */
+#define CMD_CURVALUE 13 /* get current selection buffer */
+#define CMD_DELETE 15 /* delete text in the selection */
+#define CMD_FLUSH 17 /* flush the table cache */
+#define CMD_GET 19 /* get mode a la listbox */
+#define CMD_HEIGHT 21 /* (re)set row heights */
+#define CMD_ICURSOR 23 /* set the insertion cursor */
+#define CMD_INDEX 25 /* get an index */
+#define CMD_INSERT 27 /* insert text at any position */
+#define CMD_REREAD 31 /* reread the current selection */
+#define CMD_SCAN 33 /* scan command a la listbox */
+#define CMD_SEE 35 /* see command a la listbox */
+#define CMD_SELECTION 37 /* selection command a la listbox */
+#define CMD_SET 39 /* set command, to set multiple items */
+#define CMD_TAG 41 /* tag command menu */
+#define CMD_VALIDATE 43 /* validate contents of active cell */
+#define CMD_VERSION 45 /* hidden command to return version */
+#define CMD_WIDTH 47 /* (re)set column widths */
+#define CMD_WINDOW 49 /* manage embedded windows */
+#define CMD_XVIEW 51 /* change x view of widget (for scrollbars) */
+#define CMD_YVIEW 53 /* change y view of widget (for scrollbars) */
+
+/* The list of commands for the command parser */
+
+static Cmd_Struct main_cmds[] = {
+ {"activate", CMD_ACTIVATE},
+ {"bbox", CMD_BBOX},
+ {"border", CMD_BORDER},
+ {"cget", CMD_CGET},
+ {"clear", CMD_CLEAR},
+ {"configure", CMD_CONFIGURE},
+ {"curselection", CMD_CURSELECTION},
+ {"curvalue", CMD_CURVALUE},
+ {"delete", CMD_DELETE},
+ {"flush", CMD_FLUSH},
+ {"get", CMD_GET},
+ {"height", CMD_HEIGHT},
+ {"icursor", CMD_ICURSOR},
+ {"index", CMD_INDEX},
+ {"insert", CMD_INSERT},
+ {"reread", CMD_REREAD},
+ {"scan", CMD_SCAN},
+ {"see", CMD_SEE},
+ {"selection", CMD_SELECTION},
+ {"set", CMD_SET},
+ {"tag", CMD_TAG},
+ {"validate", CMD_VALIDATE},
+ {"version", CMD_VERSION},
+ {"window", CMD_WINDOW},
+ {"width", CMD_WIDTH},
+ {"xview", CMD_XVIEW},
+ {"yview", CMD_YVIEW},
+ {"", 0}
+};
+
+/* selection subcommands */
+#define SEL_ANCHOR 1 /* set selection anchor */
+#define SEL_CLEAR 2 /* clear list from selection */
+#define SEL_INCLUDES 3 /* query items inclusion in selection */
+#define SEL_SET 4 /* include items in selection */
+
+static Cmd_Struct sel_cmds[]= {
+ {"anchor", SEL_ANCHOR},
+ {"clear", SEL_CLEAR},
+ {"includes", SEL_INCLUDES},
+ {"set", SEL_SET},
+ {"", 0 }
+};
+
+/* -selecttype selection type options */
+/* These alter how the selection set/clear commands behave */
+#define SEL_ROW (1<<0)
+#define SEL_COL (1<<1)
+#define SEL_BOTH (1<<2)
+#define SEL_CELL (1<<3)
+#define SEL_NONE (1<<4)
+
+static Cmd_Struct sel_vals[]= {
+ {"row", SEL_ROW},
+ {"col", SEL_COL},
+ {"both", SEL_BOTH},
+ {"cell", SEL_CELL},
+ {"", 0 }
+};
+
+/* clear subcommands */
+#define CLEAR_TAGS (1<<0)
+#define CLEAR_SIZES (1<<1)
+#define CLEAR_CACHE (1<<2)
+static Cmd_Struct clear_cmds[] = {
+ {"tags", CLEAR_TAGS},
+ {"sizes", CLEAR_SIZES},
+ {"cache", CLEAR_CACHE},
+ {"all", CLEAR_TAGS | CLEAR_SIZES | CLEAR_CACHE},
+ {"", 0}
+};
+
+/* -resizeborders options */
+static Cmd_Struct resize_vals[]= {
+ {"row", SEL_ROW}, /* allow rows to be dragged */
+ {"col", SEL_COL}, /* allow cols to be dragged */
+ {"both", SEL_ROW|SEL_COL}, /* allow either to be dragged */
+ {"none", SEL_NONE}, /* allow nothing to be dragged */
+ {"", 0 }
+};
+
+/* insert/delete subcommands */
+#define MOD_ACTIVE 1
+#define MOD_COLS 2
+#define MOD_ROWS 3
+static Cmd_Struct mod_cmds[] = {
+ {"active", MOD_ACTIVE},
+ {"cols", MOD_COLS},
+ {"rows", MOD_ROWS},
+ {"", 0}
+};
+
+/* border subcommands */
+#define BD_MARK 1
+#define BD_DRAGTO 2
+static Cmd_Struct bd_cmds[] = {
+ {"mark", BD_MARK},
+ {"dragto", BD_DRAGTO},
+ {"", 0}
+};
+
+/* drawmode values */
+/* The display redraws with a pixmap using TK function calls */
+#define DRAW_MODE_SLOW (1<<0)
+/* The redisplay is direct to the screen, but TK function calls are still
+ * used to give correct 3-d border appearance and thus remain compatible
+ * with other TK apps */
+#define DRAW_MODE_TK_COMPAT (1<<1)
+/* the redisplay goes straight to the screen and the 3d borders are rendered
+ * with a single pixel wide line only. It cheats and uses the internal
+ * border structure to do the borders */
+#define DRAW_MODE_FAST (1<<2)
+#define DRAW_MODE_SINGLE (1<<3)
+
+static Cmd_Struct drawmode_vals[] = {
+ {"fast", DRAW_MODE_FAST},
+ {"compatible", DRAW_MODE_TK_COMPAT},
+ {"slow", DRAW_MODE_SLOW},
+ {"single", DRAW_MODE_SINGLE},
+ {"", 0}
+};
+
+/* stretchmode values */
+#define STRETCH_MODE_NONE (1<<0) /* No additional pixels will be
+ added to rows or cols */
+#define STRETCH_MODE_UNSET (1<<1) /* All default rows or columns will
+ be stretched to fill the screen */
+#define STRETCH_MODE_ALL (1<<2) /* All rows/columns will be padded
+ to fill the window */
+#define STRETCH_MODE_LAST (1<<3) /* Stretch last elememt to fill
+ window */
+#define STRETCH_MODE_FILL (1<<4) /* More ROWS in Window */
+
+static Cmd_Struct stretch_vals[] = {
+ {"none", STRETCH_MODE_NONE},
+ {"unset", STRETCH_MODE_UNSET},
+ {"all", STRETCH_MODE_ALL},
+ {"last", STRETCH_MODE_LAST},
+ {"fill", STRETCH_MODE_FILL},
+ {"", 0}
+};
+
+static Cmd_Struct state_vals[]= {
+ {"normal", STATE_NORMAL},
+ {"disabled", STATE_DISABLED},
+ {"", 0 }
+};
+
+/* The widget configuration table */
+static Tk_CustomOption drawOpt = { Cmd_OptionSet, Cmd_OptionGet,
+ (ClientData)(&drawmode_vals) };
+static Tk_CustomOption resizeTypeOpt = { Cmd_OptionSet, Cmd_OptionGet,
+ (ClientData)(&resize_vals) };
+static Tk_CustomOption stretchOpt = { Cmd_OptionSet, Cmd_OptionGet,
+ (ClientData)(&stretch_vals) };
+static Tk_CustomOption selTypeOpt = { Cmd_OptionSet, Cmd_OptionGet,
+ (ClientData)(&sel_vals) };
+static Tk_CustomOption stateTypeOpt = { Cmd_OptionSet, Cmd_OptionGet,
+ (ClientData)(&state_vals) };
+
+static Tk_ConfigSpec TableConfig[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor", "center",
+ Tk_Offset(Table, defaultTag.anchor), 0 },
+ {TK_CONFIG_BOOLEAN, "-autoclear", "autoClear", "AutoClear", "0",
+ Tk_Offset(Table, autoClear), 0 },
+ {TK_CONFIG_BORDER, "-background", "background", "Background", NORMAL_BG,
+ Tk_Offset(Table, defaultTag.bg), 0 },
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL, (char *) NULL, 0, 0},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *)NULL, (char *) NULL, 0, 0},
+ {TK_CONFIG_CURSOR, "-bordercursor", "borderCursor", "Cursor", "crosshair",
+ Tk_Offset(Table, bdcursor), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth", "1",
+ Tk_Offset(Table, borderWidth), 0 },
+ {TK_CONFIG_STRING, "-browsecommand", "browseCommand", "BrowseCommand", "",
+ Tk_Offset(Table, browseCmd), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_SYNONYM, "-browsecmd", "browseCommand", (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-cache", "cache", "Cache", "0",
+ Tk_Offset(Table, caching), 0},
+ {TK_CONFIG_INT, "-colorigin", "colOrigin", "Origin", "0",
+ Tk_Offset(Table, colOffset), 0 },
+ {TK_CONFIG_INT, "-cols", "cols", "Cols", "10",
+ Tk_Offset(Table, cols), 0 },
+ {TK_CONFIG_STRING, "-colseparator", "colSeparator", "Separator", NULL,
+ Tk_Offset(Table, colSep), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_CUSTOM, "-colstretchmode", "colStretch", "StretchMode", "none",
+ Tk_Offset (Table, colStretch), 0 , &stretchOpt },
+ {TK_CONFIG_STRING, "-coltagcommand", "colTagCommand", "TagCommand", NULL,
+ Tk_Offset(Table, colTagCmd), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_INT, "-colwidth", "colWidth", "ColWidth", "10",
+ Tk_Offset(Table, defColWidth), 0 },
+ {TK_CONFIG_STRING, "-command", "command", "Command", "",
+ Tk_Offset(Table, command), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor", "xterm",
+ Tk_Offset(Table, cursor), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_CUSTOM, "-drawmode", "drawMode", "DrawMode", "compatible",
+ Tk_Offset(Table, drawMode), 0, &drawOpt },
+ {TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", "1", Tk_Offset(Table, exportSelection), 0},
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL, (char *) NULL, 0, 0},
+ {TK_CONFIG_BOOLEAN, "-flashmode", "flashMode", "FlashMode", "0",
+ Tk_Offset(Table, flashMode), 0 },
+ {TK_CONFIG_INT, "-flashtime", "flashTime", "FlashTime", "2",
+ Tk_Offset(Table, flashTime), 0 },
+ {TK_CONFIG_FONT, "-font", "font", "Font", DEF_TABLE_FONT,
+ Tk_Offset(Table, defaultTag.tkfont), 0 },
+ {TK_CONFIG_BORDER, "-foreground", "foreground", "Foreground", "black",
+ Tk_Offset(Table, defaultTag.fg), 0 },
+ {TK_CONFIG_INT, "-height", "height", "Height", "0",
+ Tk_Offset(Table, maxReqRows), 0 },
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", NORMAL_BG, Tk_Offset(Table, highlightBgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ HIGHLIGHT, Tk_Offset(Table, highlightColorPtr), 0 },
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness", "2", Tk_Offset(Table, highlightWidth), 0 },
+ {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground",
+ "Black", Tk_Offset(Table, insertBg), 0 },
+ {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
+ "0", Tk_Offset(Table, insertBorderWidth), TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
+ "0", Tk_Offset(Table, insertBorderWidth), TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime", "300",
+ Tk_Offset(Table, insertOffTime), 0},
+ {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime", "600",
+ Tk_Offset(Table, insertOnTime), 0},
+ {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth", "2",
+ Tk_Offset(Table, insertWidth), 0},
+ {TK_CONFIG_BOOLEAN, "-invertselected", "invertSelected", "InvertSelected",
+ "0", Tk_Offset(Table, invertSelected), 0},
+ {TK_CONFIG_PIXELS, "-maxheight", "maxHeight", "MaxHeight", "600",
+ Tk_Offset(Table, maxReqHeight), 0 },
+ {TK_CONFIG_PIXELS, "-maxwidth", "maxWidth", "MaxWidth", "800",
+ Tk_Offset(Table, maxReqWidth), 0 },
+ {TK_CONFIG_BOOLEAN, "-multiline", "multiline", "Multiline", "1",
+ Tk_Offset(Table, defaultTag.multiline), 0 },
+ {TK_CONFIG_PIXELS, "-padx", "padX", "Pad", "2", Tk_Offset(Table, padX), 0},
+ {TK_CONFIG_PIXELS, "-pady", "padY", "Pad", "1", Tk_Offset(Table, padY), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", "sunken",
+ Tk_Offset(Table, defaultTag.relief), 0 },
+ {TK_CONFIG_CUSTOM, "-resizeborders", "resizeBorders", "ResizeBorders",
+ "both", Tk_Offset(Table, resize), 0, &resizeTypeOpt },
+ {TK_CONFIG_PIXELS, "-rowheight", "rowHeight", "RowHeight", "1",
+ Tk_Offset(Table, defRowHeight), 0 },
+ {TK_CONFIG_INT, "-roworigin", "rowOrigin", "Origin", "0",
+ Tk_Offset(Table, rowOffset), 0 },
+ {TK_CONFIG_INT, "-rows", "rows", "Rows", "10", Tk_Offset(Table, rows), 0 },
+ {TK_CONFIG_STRING, "-rowseparator", "rowSeparator", "Separator", NULL,
+ Tk_Offset(Table, rowSep), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_CUSTOM, "-rowstretchmode", "rowStretch", "StretchMode", "none",
+ Tk_Offset(Table, rowStretch), 0 , &stretchOpt },
+ {TK_CONFIG_STRING, "-rowtagcommand", "rowTagCommand", "TagCommand", NULL,
+ Tk_Offset(Table, rowTagCmd), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_SYNONYM, "-selcmd", "selectionCommand", (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-selectioncommand", "selectionCommand",
+ "SelectionCommand", NULL, Tk_Offset(Table, selCmd), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_STRING, "-selectmode", "selectMode", "SelectMode", "browse",
+ Tk_Offset(Table, selectMode), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_BOOLEAN, "-selecttitles", "selectTitles", "SelectTitles", "0",
+ Tk_Offset(Table, selectTitles), 0 },
+ {TK_CONFIG_CUSTOM, "-selecttype", "selectType", "SelectType", "cell",
+ Tk_Offset(Table, selectType), 0, &selTypeOpt },
+ {TK_CONFIG_CUSTOM, "-state", "state", "State", "normal",
+ Tk_Offset(Table, state), 0, &stateTypeOpt},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus", (char *) NULL,
+ Tk_Offset(Table, takeFocus), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_INT, "-titlecols", "titleCols", "TitleCols", "0",
+ Tk_Offset(Table, titleCols), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_INT, "-titlerows", "titleRows", "TitleRows", "0",
+ Tk_Offset(Table, titleRows), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_BOOLEAN, "-usecommand", "useCommand", "UseCommand", "1",
+ Tk_Offset(Table, useCmd), 0},
+ {TK_CONFIG_STRING, "-variable", "variable", "Variable", (char *) NULL,
+ Tk_Offset(Table, arrayVar), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_BOOLEAN, "-validate", "validate", "Validate", "0",
+ Tk_Offset(Table, validate), 0 },
+ {TK_CONFIG_STRING, "-validatecommand", "validateCommand", "ValidateCommand",
+ "", Tk_Offset(Table, valCmd), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_SYNONYM, "-vcmd", "validateCommand", (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK},
+ {TK_CONFIG_INT, "-width", "width", "Width", "0",
+ Tk_Offset(Table, maxReqCols), 0 },
+ {TK_CONFIG_BOOLEAN, "-wrap", "wrap", "Wrap", "0",
+ Tk_Offset(Table, defaultTag.wrap), 0 },
+ {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ NULL, Tk_Offset(Table, xScrollCmd), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ NULL, Tk_Offset(Table, yScrollCmd), TK_CONFIG_NULL_OK },
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0 }
+};
+
+/*
+ * This specifies the configure options that will cause an update to
+ * occur, so we should have a quick lookup table for them.
+ * Keep this in sync with the above values.
+ */
+static Cmd_Struct update_config[] = {
+ {"-anchor", 1}, {"-background", 1},
+ {"-bg", 1}, {"-bd", 1},
+ {"-borderwidth", 1}, {"-cache", 1},
+ {"-command", 1}, {"-colorigin", 1},
+ {"-cols", 1}, {"-colstretchmode", 1},
+ {"-coltagcommand", 1}, {"-drawmode", 1},
+ {"-fg", 1}, {"-font", 1},
+ {"-foreground", 1},
+ {"-height", 1}, {"-highlightbackground", 1},
+ {"-highlightcolor", 1}, {"-highlightthickness", 1},
+ {"-insertbackground", 1}, {"-insertborderwidth", 1},
+ {"-insertwidth", 1}, {"-invertselected", 1},
+ {"-maxheight", 1}, {"-maxwidth", 1},
+ {"-multiline", 1},
+ {"-padx", 1}, {"-pady", 1},
+ {"-relief", 1}, {"-roworigin", 1},
+ {"-rows", 1}, {"-rowstretchmode", 1},
+ {"-rowtagcommand", 1}, {"-state", 1},
+ {"-titlecols", 1}, {"-titlerows", 1},
+ {"-usecommand", 1}, {"-variable", 1},
+ {"-width", 1}, {"-wrap", 1},
+ {"-xscrollcommand", 1}, {"-yscrollcommand", 1},
+ {"", 0},
+};
+
+/*
+ * END HEADER INFORMATION
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableFlushCache --
+ * Flushes the internal cache of the table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+INLINE static void
+TableFlushCache(register Table *tablePtr)
+{
+ /* Just get rid of it and reinit it */
+ Tcl_DeleteHashTable(tablePtr->cache);
+ ckfree((char *) (tablePtr->cache));
+ tablePtr->cache = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->cache, TCL_STRING_KEYS);
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableRefresh --
+ * Refreshes an area of the table based on the mode.
+ * row,col in real coords (0-based)
+ *
+ * Results:
+ * Will cause redraw for visible cells
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableRefresh(register Table *tablePtr, int row, int col, int mode)
+{
+ int x, y, w, h;
+
+ if (mode & CELL) {
+ if (TableCellVCoords(tablePtr, row, col, &x, &y, &w, &h, 0)) {
+ TableInvalidate(tablePtr, x, y, w, h, mode);
+ }
+ } else if (mode & ROW) {
+ /* get the position of the leftmost cell in the row */
+ if ((mode & INV_FILL) && row < tablePtr->topRow) {
+ /* Invalidate whole table */
+ TableInvalidateAll(tablePtr, mode);
+ } else if (TableCellVCoords(tablePtr, row, tablePtr->leftCol,
+ &x, &y, &w, &h, 0)) {
+ /* Invalidate from this row, maybe to end */
+ TableInvalidate(tablePtr, 0, y, Tk_Width(tablePtr->tkwin),
+ (mode&INV_FILL)?Tk_Height(tablePtr->tkwin):h, mode);
+ }
+ } else if (mode & COL) {
+ /* get the position of the topmost cell on the column */
+ if ((mode & INV_FILL) && col < tablePtr->leftCol) {
+ /* Invalidate whole table */
+ TableInvalidateAll(tablePtr, mode);
+ } else if (TableCellVCoords(tablePtr, tablePtr->topRow, col,
+ &x, &y, &w, &h, 0)) {
+ /* Invalidate from this column, maybe to end */
+ TableInvalidate(tablePtr, x, 0,
+ (mode&INV_FILL)?Tk_Width(tablePtr->tkwin):w,
+ Tk_Height(tablePtr->tkwin), mode);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableClear --
+ * Clears state information about the table.
+ *
+ * Results:
+ * Cached info can be lost. Returns valid Tcl result.
+ *
+ * Side effects:
+ * Can cause redraw.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+TableClear(register Table *tablePtr, int mode, char *first, char *last)
+{
+ int redraw = 0;
+
+ if (mode == 0) return TCL_ERROR;
+
+ if (first == NULL) {
+ if (mode & CLEAR_TAGS) {
+ Tcl_DeleteHashTable(tablePtr->rowStyles);
+ Tcl_DeleteHashTable(tablePtr->colStyles);
+ Tcl_DeleteHashTable(tablePtr->cellStyles);
+ Tcl_DeleteHashTable(tablePtr->flashCells);
+ Tcl_DeleteHashTable(tablePtr->selCells);
+
+ /* style hash tables */
+ Tcl_InitHashTable(tablePtr->rowStyles, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(tablePtr->colStyles, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(tablePtr->cellStyles, TCL_STRING_KEYS);
+
+ /* special style hash tables */
+ Tcl_InitHashTable(tablePtr->flashCells, TCL_STRING_KEYS);
+ Tcl_InitHashTable(tablePtr->selCells, TCL_STRING_KEYS);
+ }
+
+ if (mode & CLEAR_SIZES) {
+ Tcl_DeleteHashTable(tablePtr->colWidths);
+ Tcl_DeleteHashTable(tablePtr->rowHeights);
+
+ /* style hash tables */
+ Tcl_InitHashTable(tablePtr->colWidths, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(tablePtr->rowHeights, TCL_ONE_WORD_KEYS);
+ }
+
+ if (mode & CLEAR_CACHE) {
+ TableFlushCache(tablePtr);
+ /* If we were caching and we have no other data source,
+ * invalidate all the cells */
+ if (tablePtr->dataSource == DATA_CACHE) {
+ TableGetActiveBuf(tablePtr);
+ }
+ }
+ redraw = 1;
+ } else {
+ int row, col, r1, r2, c1, c2;
+ Tcl_HashEntry *entryPtr;
+ char buf[INDEX_BUFSIZE];
+
+ if (TableGetIndex(tablePtr, first, &row, &col) == TCL_ERROR ||
+ (last != NULL && TableGetIndex(tablePtr, last, &r2, &c2)==TCL_ERROR)) {
+ return TCL_ERROR;
+ }
+ if (last == NULL) {
+ r1 = r2 = row;
+ c1 = c2 = col;
+ } else {
+ r1 = MIN(row,r2); r2 = MAX(row,r2);
+ c1 = MIN(col,c2); c2 = MAX(col,c2);
+ }
+ for (row = r1; row <= r2; row++) {
+ /* Note that *Styles entries are user based (no offset)
+ * while size entries are 0-based (real) */
+ if ((mode & CLEAR_TAGS) &&
+ (entryPtr = Tcl_FindHashEntry(tablePtr->rowStyles, (char *) row))) {
+ Tcl_DeleteHashEntry(entryPtr);
+ redraw = 1;
+ }
+
+ if ((mode & CLEAR_SIZES) &&
+ (entryPtr = Tcl_FindHashEntry(tablePtr->rowHeights,
+ (char *) row-tablePtr->rowOffset))) {
+ Tcl_DeleteHashEntry(entryPtr);
+ redraw = 1;
+ }
+
+ for (col = c1; col <= c2; col++) {
+ TableMakeArrayIndex(row, col, buf);
+
+ if (mode & CLEAR_TAGS) {
+ if ((row == r1) && (entryPtr = Tcl_FindHashEntry(tablePtr->colStyles,
+ (char *) col))) {
+ Tcl_DeleteHashEntry(entryPtr);
+ redraw = 1;
+ }
+ if ((entryPtr = Tcl_FindHashEntry(tablePtr->cellStyles, buf))) {
+ Tcl_DeleteHashEntry(entryPtr);
+ redraw = 1;
+ }
+ if ((entryPtr = Tcl_FindHashEntry(tablePtr->flashCells, buf))) {
+ Tcl_DeleteHashEntry(entryPtr);
+ redraw = 1;
+ }
+ if ((entryPtr = Tcl_FindHashEntry(tablePtr->selCells, buf))) {
+ Tcl_DeleteHashEntry(entryPtr);
+ redraw = 1;
+ }
+ }
+
+ if ((mode & CLEAR_SIZES) && row == r1 &&
+ (entryPtr = Tcl_FindHashEntry(tablePtr->colWidths, (char *)
+ col-tablePtr->colOffset))) {
+ Tcl_DeleteHashEntry(entryPtr);
+ redraw = 1;
+ }
+
+ if ((mode & CLEAR_CACHE) &&
+ (entryPtr = Tcl_FindHashEntry(tablePtr->cache, buf))) {
+ Tcl_DeleteHashEntry(entryPtr);
+ /* if the cache is our data source,
+ * we need to invalidate the cells changed */
+ if ((tablePtr->dataSource == DATA_CACHE) &&
+ (row-tablePtr->rowOffset == tablePtr->activeRow &&
+ col-tablePtr->colOffset == tablePtr->activeCol))
+ TableGetActiveBuf(tablePtr);
+ redraw = 1;
+ }
+ }
+ }
+ }
+ /* This could be more sensitive about what it updates,
+ * but that can actually be a lot more costly in some cases */
+ if (redraw) {
+ if (mode & CLEAR_SIZES) {
+ TableAdjustParams(tablePtr);
+ /* rerequest geometry */
+ TableGeometryRequest(tablePtr);
+ }
+ TableInvalidateAll(tablePtr, 0);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableGetGc --
+ * Gets a GC corresponding to the tag structure passed.
+ *
+ * Results:
+ * Returns usable GC.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+INLINE static void
+TableGetGc(Display *display, Drawable d, TableTag *tagPtr, GC *tagGc)
+{
+ XGCValues gcValues;
+ gcValues.foreground = Tk_3DBorderColor(tagPtr->fg)->pixel;
+ gcValues.background = Tk_3DBorderColor(tagPtr->bg)->pixel;
+ gcValues.font = Tk_FontId(tagPtr->tkfont);
+ if (*tagGc == NULL) {
+ gcValues.graphics_exposures = False;
+ *tagGc = XCreateGC(display, d,
+ GCForeground|GCBackground|GCFont|GCGraphicsExposures,
+ &gcValues);
+ } else {
+ XChangeGC(display, *tagGc, GCForeground|GCBackground|GCFont, &gcValues);
+ }
+}
+
+#define TableFreeGc XFreeGC
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableRedrawHighlight --
+ * Redraws just the highlight for the window
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+INLINE static void
+TableRedrawHighlight(Table *tablePtr)
+{
+ if ((tablePtr->flags & REDRAW_BORDER) && tablePtr->highlightWidth > 0) {
+ GC gc = Tk_GCForColor((tablePtr->flags & HAS_FOCUS)
+ ?(tablePtr->highlightColorPtr)
+ :(tablePtr->highlightBgColorPtr),
+ Tk_WindowId(tablePtr->tkwin));
+ Tk_DrawFocusHighlight(tablePtr->tkwin, gc, tablePtr->highlightWidth,
+ Tk_WindowId(tablePtr->tkwin));
+ }
+ tablePtr->flags &= ~REDRAW_BORDER;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TableUndisplay --
+ * This procedure removes the contents of a table window
+ * that have been moved offscreen.
+ *
+ * Results:
+ * Embedded windows can be unmapped.
+ *
+ * Side effects:
+ * Information disappears from the screen.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+TableUndisplay(register Table *tablePtr)
+{
+ register int *seen = tablePtr->seen;
+ int row, col;
+
+ TableGetLastCell(tablePtr, &row, &col);
+ if (seen[0] != -1) {
+ if (seen[0] < tablePtr->topRow) {
+ /* Remove now hidden rows */
+ EmbWinUnmap(tablePtr, seen[0], tablePtr->topRow-1, 0, seen[3]);
+ }
+ if (seen[1] < tablePtr->leftCol) {
+ /* Remove now hidden cols */
+ EmbWinUnmap(tablePtr, 0, seen[2], seen[1], tablePtr->leftCol-1);
+ }
+ if (seen[2] > row) {
+ /* Remove now off-screen rows */
+ EmbWinUnmap(tablePtr, row+1, seen[2], 0, seen[3]);
+ }
+ if (seen[3] > col) {
+ /* Remove now off-screen cols */
+ EmbWinUnmap(tablePtr, 0, seen[2], col+1, seen[3]);
+ }
+ }
+ seen[0] = tablePtr->topRow;
+ seen[1] = tablePtr->leftCol;
+ seen[2] = row;
+ seen[3] = col;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TableDisplay --
+ * This procedure redraws the contents of a table window.
+ * The conditional code in this function is due to these factors:
+ * o Lack of XSetClipRectangles on Windows
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+TableDisplay(ClientData clientdata)
+{
+ register Table *tablePtr = (Table *) clientdata;
+ Tk_Window tkwin = tablePtr->tkwin;
+ Display *display = tablePtr->display;
+ Drawable window;
+#ifdef _WIN32
+ Drawable clipWind;
+#else
+ XRectangle clipRect;
+#endif
+ int rowFrom, rowTo, colFrom, colTo,
+ invalidX, invalidY, invalidWidth, invalidHeight,
+ x, y, width, height, itemX, itemY, itemW, itemH,
+ row, col, urow, ucol, cx, cy, cw, ch, bd,
+ numBytes, new, boundW, boundH, maxW, maxH,
+ originX, originY, activeCell, clipRectSet, shouldInvert;
+ GC tagGc = NULL, topGc, bottomGc;
+ char *string = NULL;
+ char buf[INDEX_BUFSIZE];
+ TableTag *tagPtr = NULL, *titlePtr, *selPtr, *activePtr, *flashPtr,
+ *rowPtr, *colPtr;
+ Tcl_HashEntry *entryPtr;
+ static XPoint rect[3] = { {0, 0}, {0, 0}, {0, 0} };
+ Tcl_HashTable *colTagsCache = NULL;
+ Tk_TextLayout textLayout = NULL;
+ TableEmbWindow *ewPtr;
+
+ if ((tablePtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+ tablePtr->flags &= ~REDRAW_PENDING;
+
+ bd = tablePtr->borderWidth;
+ boundW = Tk_Width(tkwin)-tablePtr->highlightWidth;
+ boundH = Tk_Height(tkwin)-tablePtr->highlightWidth;
+
+ /* Constrain drawable to not include highlight borders */
+ invalidX = MAX(tablePtr->highlightWidth, tablePtr->invalidX);
+ invalidY = MAX(tablePtr->highlightWidth, tablePtr->invalidY);
+ invalidWidth = MIN(tablePtr->invalidWidth, MAX(1, boundW-invalidX));
+ invalidHeight = MIN(tablePtr->invalidHeight, MAX(1, boundH-invalidY));
+
+ /*
+ * if we are using the slow drawing mode with a pixmap
+ * create the pixmap and adjust x && y for offset in pixmap
+ */
+ if (tablePtr->drawMode == DRAW_MODE_SLOW) {
+ window = Tk_GetPixmap(display, Tk_WindowId(tkwin),
+ invalidWidth, invalidHeight, Tk_Depth(tkwin));
+ } else {
+ window = Tk_WindowId(tkwin);
+ }
+#ifdef _WIN32
+ clipWind = Tk_GetPixmap(display, window,
+ invalidWidth, invalidHeight, Tk_Depth(tkwin));
+#endif
+
+ /* set up the permanent tag styles */
+ entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, "title");
+ titlePtr = (TableTag *) Tcl_GetHashValue(entryPtr);
+ entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, "sel");
+ selPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
+ entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, "active");
+ activePtr= (TableTag *) Tcl_GetHashValue(entryPtr);
+ entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, "flash");
+ flashPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
+
+ /* find out the cells represented by the invalid region */
+ TableWhatCell(tablePtr, invalidX, invalidY, &rowFrom, &colFrom);
+ TableWhatCell(tablePtr, invalidX+invalidWidth-1,
+ invalidY+invalidHeight-1, &rowTo, &colTo);
+
+#ifdef DEBUG
+ tcl_dprintf(tablePtr->interp, "display %d,%d => %d,%d",
+ rowFrom+tablePtr->rowOffset, colFrom+tablePtr->colOffset,
+ rowTo+tablePtr->rowOffset, colTo+tablePtr->colOffset);
+#endif
+
+ /*
+ * Initialize colTagsCache hash table to cache column tag names.
+ */
+ colTagsCache = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(colTagsCache, TCL_ONE_WORD_KEYS);
+
+ /* Cycle through the cells and display them */
+ for (row = rowFrom; row <= rowTo; row++) {
+ /*
+ * are we in the 'dead zone' between the
+ * title rows and the first displayed row
+ */
+ if (row < tablePtr->topRow && row >= tablePtr->titleRows) {
+ row = tablePtr->topRow;
+ }
+
+ /* Cache the row in user terms */
+ urow = row+tablePtr->rowOffset;
+
+ /* Get the row tag once for all iterations of col */
+ rowPtr = FindRowColTag(tablePtr, urow, ROW);
+
+ for (col = colFrom; col <= colTo; col++) {
+ activeCell = 0;
+ /*
+ * are we in the 'dead zone' between the
+ * title cols and the first displayed col
+ */
+ if (col < tablePtr->leftCol && col >= tablePtr->titleCols) {
+ col = tablePtr->leftCol;
+ }
+
+ /* Cache the col in user terms */
+ ucol = col+tablePtr->colOffset;
+
+ /* put the use cell ref into a buffer for the hash lookups */
+ TableMakeArrayIndex(urow, ucol, buf);
+
+ /* get the coordinates for the cell */
+ TableCellCoords(tablePtr, row, col, &x, &y, &width, &height);
+
+ /* Constrain drawn size to the visual boundaries */
+ if (width > boundW-x) {
+ width = boundW-x;
+ }
+ if (height > boundH-y) {
+ height = boundH-y;
+ }
+
+ /* Create the tag here */
+ tagPtr = TableNewTag();
+ /* First, merge in the default tag */
+ TableMergeTag(tagPtr, &(tablePtr->defaultTag));
+
+ if ((entryPtr = Tcl_FindHashEntry(tablePtr->winTable, buf)) != NULL) {
+ ewPtr = (TableEmbWindow *) Tcl_GetHashValue(entryPtr);
+
+ if (ewPtr->tkwin != NULL) {
+ /* Display embedded window instead of text */
+
+ /* if active, make it disabled to avoid unnecessary editing */
+ if ((tablePtr->flags & HAS_ACTIVE)
+ && row == tablePtr->activeRow && col == tablePtr->activeCol) {
+ tablePtr->flags |= ACTIVE_DISABLED;
+ }
+
+ EmbWinDisplay(tablePtr, window, ewPtr, tagPtr,
+ x, y, width, height);
+
+ if (tablePtr->drawMode == DRAW_MODE_SLOW) {
+ /* Correctly adjust x && y with the offset */
+ x -= invalidX;
+ y -= invalidY;
+ }
+ Tk_Fill3DRectangle(tkwin, window, tagPtr->bg,
+ x, y, width, height, bd, TK_RELIEF_FLAT);
+
+ goto ImageUsed;
+ }
+ }
+
+ if (tablePtr->drawMode == DRAW_MODE_SLOW) {
+ /* Correctly adjust x && y with the offset */
+ x -= invalidX;
+ y -= invalidY;
+ }
+
+ shouldInvert = 0;
+ /*
+ * get the combined tag structure for the cell
+ * first clear out a new tag structure that we will build in
+ * then add tags as we realize they belong.
+ * Tags with the highest priority are added first
+ */
+
+ /*
+ * Merge colPtr if it exists
+ * let's see if we have the value cached already
+ * if not, run the findColTag routine and cache the value
+ */
+ entryPtr = Tcl_CreateHashEntry(colTagsCache, (char *)ucol, &new);
+ if (new) {
+ colPtr = FindRowColTag(tablePtr, ucol, COL);
+ Tcl_SetHashValue(entryPtr, colPtr);
+ } else {
+ colPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
+ }
+ if (colPtr != (TableTag *) NULL)
+ TableMergeTag(tagPtr, colPtr);
+ /* Merge rowPtr if it exists */
+ if (rowPtr != (TableTag *) NULL)
+ TableMergeTag(tagPtr, rowPtr);
+ /* Am I in the titles */
+ if (row < tablePtr->topRow || col < tablePtr->leftCol)
+ TableMergeTag(tagPtr, titlePtr);
+ /* Does this have a cell tag */
+ if ((entryPtr = Tcl_FindHashEntry(tablePtr->cellStyles, buf)) != NULL)
+ TableMergeTag(tagPtr, (TableTag *) Tcl_GetHashValue(entryPtr));
+ /* is this cell selected? */
+ if (Tcl_FindHashEntry(tablePtr->selCells, buf) != NULL) {
+ if (tablePtr->invertSelected && !activeCell) {
+ shouldInvert = 1;
+ } else {
+ TableMergeTag(tagPtr, selPtr);
+ }
+ }
+ /* is this cell active? */
+ if ((tablePtr->flags & HAS_ACTIVE) && tablePtr->state == STATE_NORMAL
+ && row == tablePtr->activeRow && col == tablePtr->activeCol) {
+ if (tagPtr->state == STATE_DISABLED) {
+ tablePtr->flags |= ACTIVE_DISABLED;
+ } else {
+ TableMergeTag(tagPtr, activePtr);
+ activeCell = 1;
+ tablePtr->flags &= ~ACTIVE_DISABLED;
+ }
+ }
+ /* if flash mode is on, is this cell flashing */
+ if (tablePtr->flashMode &&
+ Tcl_FindHashEntry(tablePtr->flashCells, buf) != NULL)
+ TableMergeTag(tagPtr, flashPtr);
+
+ if (shouldInvert) TableInvertTag(tagPtr);
+
+ /*
+ * first fill in a blank rectangle. This is left as a Tk call instead
+ * of a direct X call for Tk compatibilty. The TK_RELIEF_FLAT ensures
+ * that only XFillRectangle is called anyway so the speed is the same
+ */
+ Tk_Fill3DRectangle(tkwin, window, tagPtr->bg,
+ x, y, width, height, bd, TK_RELIEF_FLAT);
+
+ /*
+ * If an image is in the tag, draw it
+ */
+ if (tagPtr->image != NULL) {
+ Tk_SizeOfImage(tagPtr->image, &itemW, &itemH);
+ /* Handle anchoring of image in cell space */
+ switch (tagPtr->anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_SW: /* western position */
+ originX = itemX = 0;
+ break;
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_S:
+ case TK_ANCHOR_CENTER: /* centered position */
+ itemX = MAX(0, (itemW-width)/2-bd);
+ originX = MAX(0, (width-itemW)/2);
+ break;
+ default: /* eastern position */
+ itemX = MAX(0, itemW-width-2*bd);
+ originX = MAX(0, width-itemW);
+ }
+ switch (tagPtr->anchor) {
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_NW: /* northern position */
+ originY = itemY = 0;
+ break;
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_E:
+ case TK_ANCHOR_CENTER: /* centered position */
+ itemY = MAX(0, (itemH-height)/2-bd);
+ originY = MAX(0, (height-itemH)/2);
+ break;
+ default: /* southern position */
+ itemY = MAX(0, itemH-height-2*bd);
+ originY = MAX(0, height-itemH);
+ }
+ Tk_RedrawImage(tagPtr->image, itemX, itemY,
+ MIN(itemW, width-originX-2*bd),
+ MIN(itemH, height-originY-2*bd), window,
+ x+originX+bd, y+originY+bd);
+ /* Jump to avoid display of the text value */
+ if (tagPtr->showtext == 0)
+ goto ImageUsed;
+ }
+
+ /* get the GC for this particular blend of tags
+ * this creates the GC if it never existed, otherwise it
+ * modifies the one we have */
+ TableGetGc(display, window, tagPtr, &tagGc);
+
+ /* if this is the active cell, use the buffer */
+ if (activeCell) {
+ string = tablePtr->activeBuf;
+ } else {
+ /* Is there a value in the cell? If so, draw it */
+ string = TableGetCellValue(tablePtr, urow, ucol);
+ }
+
+ numBytes = strlen(string);
+ /* If there is a string, show it */
+ if (activeCell || numBytes) {
+ /* get the dimensions of the string */
+ textLayout = Tk_ComputeTextLayout(tagPtr->tkfont, string, numBytes,
+ (tagPtr->wrap>0) ? width : 0,
+ tagPtr->justify,
+ (tagPtr->multiline>0) ? 0 :
+ TK_IGNORE_NEWLINES,
+ &itemW, &itemH);
+
+ /*
+ * Set the origin coordinates of the string to draw using the anchor.
+ * origin represents the (x,y) coordinate of the lower left corner of
+ * the text box, relative to the internal (inside the border) window
+ */
+
+ /* set the X origin first */
+ switch (tagPtr->anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_SW: /* western position */
+ originX = tablePtr->padX;
+ break;
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_S:
+ case TK_ANCHOR_CENTER: /* centered position */
+ originX = (width-itemW)/2 - bd;
+ break;
+ default: /* eastern position */
+ originX = width-itemW-2*bd-tablePtr->padX;
+ }
+
+ /* then set the Y origin */
+ switch (tagPtr->anchor) {
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_NW: /* northern position */
+ originY = tablePtr->padY;
+ break;
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_E:
+ case TK_ANCHOR_CENTER: /* centered position */
+ originY = (height-itemH)/2 - bd;
+ break;
+ default: /* southern position */
+ originY = height-itemH-2*bd-tablePtr->padY;
+ }
+
+ /*
+ * if this is the selected cell and we are editing
+ * ensure that the cursor will be displayed
+ */
+ if (activeCell) {
+#if (TK_MINOR_VERSION > 0)
+ int insertByte;
+
+ insertByte = Tcl_UtfAtIndex(string, tablePtr->icursor) - string;
+ Tk_CharBbox(textLayout, MIN(numBytes, insertByte),
+ &cx, &cy, &cw, &ch);
+#else
+ Tk_CharBbox(textLayout, MIN(numBytes, tablePtr->icursor),
+ &cx, &cy, &cw, &ch);
+#endif
+ /* we have to fudge with maxW because of odd width
+ * determination for newlines at the end of a line */
+ maxW = width-bd-tablePtr->padX-tablePtr->insertWidth
+ -(cx+MIN(tablePtr->charWidth, cw));
+ maxH = height-bd-tablePtr->padY-(cy+ch);
+ if (originX < tablePtr->padX+bd-cx) {
+ /* cursor off cell to the left */
+ /* use western positioning to cet cursor at left edge
+ * with slight variation to show some text */
+ originX = tablePtr->padX+bd-cx
+ +MIN(cx, width-2*bd-tablePtr->padX-tablePtr->insertWidth);
+ } else if (originX > maxW) {
+ /* cursor off cell to the right */
+ /* use eastern positioning to cet cursor at right edge */
+ originX = maxW;
+ }
+ if (originY < tablePtr->padY+bd-cy) {
+ /* cursor before top of cell */
+ /* use northern positioning to cet cursor at top edge */
+ originY = tablePtr->padY+bd-cy;
+ } else if (originY > maxH) {
+ /* cursor beyond bottom of cell */
+ /* use southern positioning to cet cursor at bottom edge */
+ originY = maxH;
+ }
+ tablePtr->activeLayout = textLayout;
+ tablePtr->activeX = originX;
+ tablePtr->activeY = originY;
+ }
+ /*
+ * use a clip rectangle only if necessary as it means
+ * updating the GC in the server which slows everything down.
+ * The bd offsets allow us to fudge a little more since the
+ * borders are drawn after drawing the string.
+ */
+ if ((clipRectSet = ((originX < bd) || (originY < bd)
+ || (originX+itemW > width-bd)
+ || (originY+itemH > height-bd)))) {
+#ifdef _WIN32
+ /* We always draw in the upper-left corner of the clipWind */
+ Tk_Fill3DRectangle(tkwin, clipWind, tagPtr->bg, 0, 0,
+ width, height, bd, TK_RELIEF_FLAT);
+ Tk_DrawTextLayout(display, clipWind, tagGc, textLayout,
+ originX+bd, originY+bd, 0, -1);
+ XCopyArea(display, clipWind, window, tagGc, 0, 0,
+ width, height, x, y);
+#else
+ /* set the clipping rectangle */
+ clipRect.x = x;
+ clipRect.y = y;
+ clipRect.width = width;
+ clipRect.height = height;
+ XSetClipRectangles(display, tagGc, 0, 0, &clipRect, 1, Unsorted);
+#endif
+ }
+
+#ifdef _WIN32 /* no cliprect on windows */
+ if (!clipRectSet)
+#endif
+ Tk_DrawTextLayout(display, window, tagGc, textLayout,
+ x+originX+bd, y+originY+bd, 0, -1);
+
+#ifndef _WIN32 /* no cliprect on windows */
+ /* reset the clip mask */
+ if (clipRectSet) {
+ XSetClipMask(display, tagGc, None);
+ }
+#endif
+
+ /* if this is the active cell draw the cursor if it's on.
+ * this ignores clip rectangles. */
+ if (activeCell && (tablePtr->flags & CURSOR_ON) &&
+ (originY+bd+cy < height) &&
+ (originX+cx+bd-(tablePtr->insertWidth/2) >= 0)) {
+ /* make sure it will fit in the box */
+ maxW = MAX(0, originY+bd+cy);
+ maxH = MIN(ch, height-maxW);
+ Tk_Fill3DRectangle(tkwin, window, tablePtr->insertBg,
+ x+originX+cx+bd-(tablePtr->insertWidth/2),
+ y+maxW, tablePtr->insertWidth,
+ maxH, 0, TK_RELIEF_FLAT);
+ }
+ }
+
+ ImageUsed:
+ /* Draw the 3d border on the pixmap correctly offset */
+ if (tablePtr->borderWidth) {
+ switch (tablePtr->drawMode) {
+ case DRAW_MODE_SLOW:
+ case DRAW_MODE_TK_COMPAT:
+ Tk_Draw3DRectangle(tkwin, window, tagPtr->bg,
+ x, y, width, height, bd, tagPtr->relief);
+ break;
+ case DRAW_MODE_FAST:
+ /*
+ ** choose the GCs to get the best approximation
+ ** to the desired drawing style
+ */
+ switch(tagPtr->relief) {
+ case TK_RELIEF_FLAT:
+ topGc = bottomGc = Tk_3DBorderGC(tkwin, tagPtr->bg, TK_3D_FLAT_GC);
+ break;
+ case TK_RELIEF_RAISED:
+ case TK_RELIEF_RIDGE:
+ topGc = Tk_3DBorderGC(tkwin, tagPtr->bg, TK_3D_LIGHT_GC);
+ bottomGc = Tk_3DBorderGC(tkwin, tagPtr->bg, TK_3D_DARK_GC);
+ break;
+ default: /* TK_RELIEF_SUNKEN TK_RELIEF_GROOVE */
+ bottomGc = Tk_3DBorderGC(tkwin, tagPtr->bg, TK_3D_LIGHT_GC);
+ topGc = Tk_3DBorderGC(tkwin, tagPtr->bg, TK_3D_DARK_GC);
+ break;
+ }
+
+ /* draw a line with single pixel width */
+ rect[0].x = x + width - 1;
+ rect[0].y = y;
+ rect[1].y = height - 1;
+ rect[2].x = -width + 1;
+ XDrawLines(display, window, bottomGc, rect, 3, CoordModePrevious);
+ rect[0].x = x;
+ rect[0].y = y + height - 1;
+ rect[1].y = -height + 1;
+ rect[2].x = width - 1;
+ XDrawLines(display, window, topGc, rect, 3, CoordModePrevious);
+ break;
+ case DRAW_MODE_SINGLE:
+ topGc = Tk_3DBorderGC(tkwin, tagPtr->bg, TK_3D_DARK_GC);
+ /* draw a line with single pixel width */
+ rect[0].x = x;
+ rect[0].y = y + height - 1;
+ rect[1].y = -height + 1;
+ rect[2].x = width - 1;
+ XDrawLines(display, window, topGc, rect, 3, CoordModePrevious);
+ break;
+ }
+ }
+
+ /* delete the tag structure */
+ ckfree((char *) (tagPtr));
+ if (textLayout && !activeCell) {
+ Tk_FreeTextLayout(textLayout);
+ textLayout = NULL;
+ }
+ }
+ }
+#ifdef _WIN32
+ Tk_FreePixmap(display, clipWind);
+#endif
+
+ /* Take care of removing embedded windows that are no longer in view */
+ TableUndisplay(tablePtr);
+
+ /* copy over and delete the pixmap if we are in slow mode */
+ if (tablePtr->drawMode == DRAW_MODE_SLOW) {
+ /* Get a default valued GC */
+ TableGetGc(display, window, &(tablePtr->defaultTag), &tagGc);
+ XCopyArea(display, window, Tk_WindowId(tkwin), tagGc, 0, 0,
+ invalidWidth, invalidHeight, invalidX, invalidY);
+ Tk_FreePixmap(display, window);
+ window = Tk_WindowId(tkwin);
+ }
+
+ /*
+ * if we have got to the end of the table,
+ * clear the area after the last row/col
+ */
+ TableCellCoords(tablePtr, tablePtr->rows-1, tablePtr->cols-1,
+ &x, &y, &width, &height);
+
+ /* This should occur before moving pixmap, but this simplifies things
+ *
+ * Could use Tk_Fill3DRectangle instead of XFillRectangle
+ * for best compatibility, and XClearArea could be used on Unix
+ * for best speed, so this is the compromise w/o #ifdef's
+ */
+ if (x+width < invalidX+invalidWidth) {
+ XFillRectangle(display, window,
+ Tk_3DBorderGC(tkwin, tablePtr->defaultTag.bg,
+ TK_3D_FLAT_GC), x+width, invalidY,
+ invalidX+invalidWidth-x-width, invalidHeight);
+ }
+
+ if (y+height < invalidY+invalidHeight) {
+ XFillRectangle(display, window,
+ Tk_3DBorderGC(tkwin, tablePtr->defaultTag.bg,
+ TK_3D_FLAT_GC), invalidX, y+height,
+ invalidWidth, invalidY+invalidHeight-y-height);
+ }
+
+ if (tagGc != NULL) {
+ TableFreeGc(display, tagGc);
+ }
+ TableRedrawHighlight(tablePtr);
+ /*
+ * Free the hash table used to cache evaluations.
+ */
+ Tcl_DeleteHashTable(colTagsCache);
+ ckfree((char *) (colTagsCache));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableInvalidate --
+ * Invalidates a rectangle and adds it to the total invalid rectangle
+ * waiting to be redrawn. If the INV_FORCE flag bit is set,
+ * it does an update instantly else waits until Tk is idle.
+ *
+ * Results:
+ * Will schedule table (re)display.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableInvalidate(Table * tablePtr, int x, int y,
+ int width, int height, int flags)
+{
+ register int hl = tablePtr->highlightWidth;
+ register Tk_Window tkwin = tablePtr->tkwin;
+
+ /* make sure that the window hasn't been destroyed already */
+ /* avoid allocating 0 sized pixmaps which would be fatal */
+ /* and check if rectangle is even on the screen */
+ if ((tkwin == NULL) || (width <= 0) || (height <= 0)
+ || (x > Tk_Width(tkwin)) || (y > Tk_Height(tkwin))) return;
+
+ /* If not even mapped, wait for the remap to redraw all */
+ if (!Tk_IsMapped(tkwin)) {
+ tablePtr->flags |= REDRAW_ON_MAP;
+ return;
+ }
+
+ /* if no pending updates then replace the rectangle,
+ * otherwise find the bounding rectangle */
+ if ((flags & INV_HIGHLIGHT) &&
+ (x < hl || y < hl || x+width >= Tk_Width(tkwin)-hl ||
+ y+height >= Tk_Height(tkwin)-hl)) {
+ tablePtr->flags |= REDRAW_BORDER;
+ }
+
+ if (tablePtr->flags & REDRAW_PENDING) {
+ tablePtr->invalidWidth = MAX(tablePtr->invalidX+tablePtr->invalidWidth,
+ x + width);
+ tablePtr->invalidHeight = MAX(tablePtr->invalidY+tablePtr->invalidHeight,
+ y + height);
+ if (tablePtr->invalidX > x) tablePtr->invalidX = x;
+ if (tablePtr->invalidY > y) tablePtr->invalidY = y;
+ tablePtr->invalidWidth -= tablePtr->invalidX;
+ tablePtr->invalidHeight -= tablePtr->invalidY;
+ /* are we forcing this update out */
+ if (flags & INV_FORCE) {
+ Tcl_CancelIdleCall(TableDisplay, (ClientData) tablePtr);
+ TableDisplay((ClientData) tablePtr);
+ }
+ } else {
+ tablePtr->invalidX = x;
+ tablePtr->invalidY = y;
+ tablePtr->invalidWidth = width;
+ tablePtr->invalidHeight = height;
+ if (flags & INV_FORCE) {
+ TableDisplay((ClientData) tablePtr);
+ } else {
+ tablePtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(TableDisplay, (ClientData) tablePtr);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableFlashEvent --
+ * Called when the flash timer goes off.
+ *
+ * Results:
+ * Decrements all the entries in the hash table and invalidates
+ * any cells that expire, deleting them from the table. If the
+ * table is now empty, stops the timer, else reenables it.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableFlashEvent(ClientData clientdata)
+{
+ Table *tablePtr = (Table *) clientdata;
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ int entries, count, row, col;
+
+ entries = 0;
+ for (entryPtr = Tcl_FirstHashEntry(tablePtr->flashCells, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ count = (int) Tcl_GetHashValue(entryPtr);
+ if (--count <= 0) {
+ /* get the cell address and invalidate that region only */
+ TableParseArrayIndex(&row, &col,
+ Tcl_GetHashKey(tablePtr->flashCells, entryPtr));
+
+ /* delete the entry from the table */
+ Tcl_DeleteHashEntry(entryPtr);
+
+ TableRefresh(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset, CELL|INV_FORCE);
+ } else {
+ Tcl_SetHashValue(entryPtr, (ClientData) count);
+ entries++;
+ }
+ }
+
+ /* do I need to restart the timer */
+ if (entries && tablePtr->flashMode)
+ tablePtr->flashTimer = Tcl_CreateTimerHandler(250, TableFlashEvent,
+ (ClientData) tablePtr);
+ else
+ tablePtr->flashTimer = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableAddFlash --
+ * Adds a flash on cell row,col (real coords) with the default timeout
+ * if flashing is enabled and flashtime > 0.
+ *
+ * Results:
+ * Cell will flash.
+ *
+ * Side effects:
+ * Will start flash timer if it didn't exist.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableAddFlash(Table *tablePtr, int row, int col)
+{
+ char buf[INDEX_BUFSIZE];
+ int dummy;
+ Tcl_HashEntry *entryPtr;
+
+ if (!tablePtr->flashMode || tablePtr->flashTime < 1)
+ return;
+
+ /* create the array index in user coords */
+ TableMakeArrayIndex(row+tablePtr->rowOffset, col+tablePtr->colOffset, buf);
+
+ /* add the flash to the hash table */
+ entryPtr = Tcl_CreateHashEntry(tablePtr->flashCells, buf, &dummy);
+ Tcl_SetHashValue(entryPtr, tablePtr->flashTime);
+
+ /* now set the timer if it's not already going and invalidate the area */
+ if (tablePtr->flashTimer == NULL)
+ tablePtr->flashTimer = Tcl_CreateTimerHandler(250, TableFlashEvent,
+ (ClientData) tablePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableSetActiveIndex --
+ * Sets the "active" index of the associated array to the current
+ * value of the active buffer.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Traces on the array can cause side effects.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableSetActiveIndex(register Table *tablePtr)
+{
+ if (tablePtr->arrayVar) {
+ tablePtr->flags |= SET_ACTIVE;
+ Tcl_SetVar2(tablePtr->interp, tablePtr->arrayVar, "active",
+ tablePtr->activeBuf, TCL_GLOBAL_ONLY);
+ tablePtr->flags &= ~SET_ACTIVE;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableGetActiveBuf --
+ * Get the current selection into the buffer and mark it as unedited.
+ * Set the position to the end of the string.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * tablePtr->activeBuf will change.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableGetActiveBuf(register Table *tablePtr)
+{
+ char *data = "";
+
+ if (tablePtr->flags & HAS_ACTIVE)
+ data = TableGetCellValue(tablePtr, tablePtr->activeRow+tablePtr->rowOffset,
+ tablePtr->activeCol+tablePtr->colOffset);
+
+ if (strcmp(tablePtr->activeBuf, data) == 0) {
+ /* this forced SetActiveIndex is necessary if we change array vars and
+ * they happen to have these cells equal, we won't properly set the
+ * active index for the new array var unless we do this here */
+ TableSetActiveIndex(tablePtr);
+ return;
+ }
+ /* is the buffer long enough */
+ tablePtr->activeBuf = (char *)ckrealloc(tablePtr->activeBuf, strlen(data)+1);
+ strcpy(tablePtr->activeBuf, data);
+ TableGetIcursor(tablePtr, "end", (int *)0);
+ tablePtr->flags &= ~TEXT_CHANGED;
+ TableSetActiveIndex(tablePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableVarProc --
+ * This is the trace procedure associated with the Tcl array. No
+ * validation will occur here because this only triggers when the
+ * array value is directly set, and we can't maintain the old value.
+ *
+ * Results:
+ * Invalidates changed cell.
+ *
+ * Side effects:
+ * Creates/Updates entry in the cache if we are caching.
+ *
+ *----------------------------------------------------------------------
+ */
+static char *
+TableVarProc(clientData, interp, name, index, flags)
+ ClientData clientData; /* Information about table. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ char *name; /* Not used. */
+ char *index; /* Not used. */
+ int flags; /* Information about what happened. */
+{
+ Table *tablePtr = (Table *) clientData;
+ int dummy, row, col, update = 1;
+
+ /* This is redundant, as the name should always == arrayVar */
+ name = tablePtr->arrayVar;
+
+ /* is this the whole var being destroyed or just one cell being deleted */
+ if ((flags & TCL_TRACE_UNSETS) && index == NULL) {
+ /* if this isn't the interpreter being destroyed reinstate the trace */
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_SetVar2(interp, name, TEST_KEY, "", TCL_GLOBAL_ONLY);
+ Tcl_UnsetVar2(interp, name, TEST_KEY, TCL_GLOBAL_ONLY);
+ Tcl_ResetResult(interp);
+
+ /* set a trace on the variable */
+ Tcl_TraceVar(interp, name,
+ TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_GLOBAL_ONLY,
+ (Tcl_VarTraceProc *)TableVarProc, (ClientData) tablePtr);
+
+ /* only do the following if arrayVar is our data source */
+ if (tablePtr->dataSource & DATA_ARRAY) {
+ /* clear the selection buffer */
+ TableGetActiveBuf(tablePtr);
+ /* flush any cache */
+ TableFlushCache(tablePtr);
+ /* and invalidate the table */
+ TableInvalidateAll(tablePtr, 0);
+ }
+ }
+ return (char *) NULL;
+ }
+ /* only continue if arrayVar is our data source */
+ if (!(tablePtr->dataSource & DATA_ARRAY)) {
+ return (char *) NULL;
+ }
+ /* get the cell address and invalidate that region only.
+ * Make sure that it is a valid cell address. */
+ if (strcmp("active", index) == 0) {
+ if (tablePtr->flags & SET_ACTIVE) {
+ /* If we are already setting the active cell, the update
+ * will occur in other code */
+ update = 0;
+ } else {
+ /* modified TableGetActiveBuf */
+ char *data = "";
+
+ row = tablePtr->activeRow;
+ col = tablePtr->activeCol;
+ if (tablePtr->flags & HAS_ACTIVE)
+ data = Tcl_GetVar2(interp, name, index, TCL_GLOBAL_ONLY);
+ if (!data) data = "";
+
+ if (strcmp(tablePtr->activeBuf, data) == 0) {
+ return (char *) NULL;
+ }
+ tablePtr->activeBuf = (char *)ckrealloc(tablePtr->activeBuf,
+ strlen(data)+1);
+ strcpy(tablePtr->activeBuf, data);
+ /* set cursor to the last char */
+ TableGetIcursor(tablePtr, "end", (int *)0);
+ tablePtr->flags |= TEXT_CHANGED;
+ }
+ } else if (TableParseArrayIndex(&row, &col, index) == 2) {
+ char buf[INDEX_BUFSIZE];
+ /* Make sure it won't trigger on array(2,3extrastuff) */
+ TableMakeArrayIndex(row, col, buf);
+ if (strcmp(buf, index)) {
+ return (char *) NULL;
+ }
+ if (tablePtr->caching) {
+ Tcl_HashEntry *entryPtr;
+ char *val, *data = NULL;
+
+ data = Tcl_GetVar2(interp, name, index, TCL_GLOBAL_ONLY);
+ if (!data) data = "";
+ val = (char *)ckalloc(strlen(data)+1);
+ strcpy(val, data);
+ entryPtr = Tcl_CreateHashEntry(tablePtr->cache, buf, &dummy);
+ Tcl_SetHashValue(entryPtr, val);
+ }
+ /* convert index to real coords */
+ row -= tablePtr->rowOffset;
+ col -= tablePtr->colOffset;
+ /* did the active cell just update */
+ if (row == tablePtr->activeRow && col == tablePtr->activeCol)
+ TableGetActiveBuf(tablePtr);
+ /* Flash the cell */
+ TableAddFlash(tablePtr, row, col);
+ } else {
+ return (char *) NULL;
+ }
+
+ if (update) TableRefresh(tablePtr, row, col, CELL);
+
+ return (char *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableGeometryRequest --
+ * This procedure is invoked to request a new geometry from Tk.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Geometry information is updated and a new requested size is
+ * registered for the widget. Internal border info is also set.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableGeometryRequest(tablePtr)
+ register Table *tablePtr;
+{
+ int x, y;
+
+ /* Do the geometry request
+ * If -width #cols was not specified or it is greater than the real
+ * number of cols, use maxWidth as a lower bound, with the other lower
+ * bound being the upper bound of the window's user-set width and the
+ * value of -maxwidth set by the programmer
+ * Vice versa for rows/height
+ */
+ x = MIN((tablePtr->maxReqCols==0 || tablePtr->maxReqCols > tablePtr->cols) ?
+ tablePtr->maxWidth : tablePtr->colStarts[tablePtr->maxReqCols],
+ tablePtr->maxReqWidth) + 2*tablePtr->highlightWidth;
+ y = MIN((tablePtr->maxReqRows==0 || tablePtr->maxReqRows > tablePtr->rows) ?
+ tablePtr->maxHeight : tablePtr->rowStarts[tablePtr->maxReqRows],
+ tablePtr->maxReqHeight) + 2*tablePtr->highlightWidth;
+ Tk_GeometryRequest(tablePtr->tkwin, x, y);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableAdjustActive --
+ * This procedure is called by AdjustParams and CMD_ACTIVATE to
+ * move the active cell.
+ *
+ * Results:
+ * Old and new active cell indices will be invalidated.
+ *
+ * Side effects:
+ * If the old active cell index was edited, it will be saved.
+ * The active buffer will be updated.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableAdjustActive(tablePtr)
+ register Table *tablePtr; /* Widget record for table */
+{
+ if (tablePtr->flags & HAS_ACTIVE) {
+ /* make sure the active cell has a reasonable real index */
+ tablePtr->activeRow = MAX(0, MIN(tablePtr->activeRow, tablePtr->rows-1));
+ tablePtr->activeCol = MAX(0, MIN(tablePtr->activeCol, tablePtr->cols-1));
+ }
+
+ /*
+ * now check the new value of active cell against the original,
+ * If it changed, invalidate the area, else leave it alone
+ */
+ if (tablePtr->oldActRow != tablePtr->activeRow ||
+ tablePtr->oldActCol != tablePtr->activeCol) {
+ int x, y, width, height;
+ /* put the value back in the cell */
+ if (tablePtr->oldActRow >= 0 && tablePtr->oldActCol >= 0) {
+ /*
+ * Set the value of the old active cell to the active buffer
+ * SetCellValue will check if the value actually changed
+ */
+ if (tablePtr->flags & TEXT_CHANGED) {
+ /* WARNING an outside trace will be triggered here and if it
+ * calls something that causes TableAdjustParams to be called
+ * again, we are in data consistency trouble */
+ /* HACK - turn TEXT_CHANGED off now to possibly avoid the
+ * above data inconsistency problem. */
+ tablePtr->flags &= ~TEXT_CHANGED;
+ TableSetCellValue(tablePtr, tablePtr->oldActRow+tablePtr->rowOffset,
+ tablePtr->oldActCol+tablePtr->colOffset,
+ tablePtr->activeBuf);
+ }
+ /* invalidate the old active cell */
+ TableCellCoords(tablePtr, tablePtr->oldActRow, tablePtr->oldActCol,
+ &x, &y, &width, &height);
+ TableInvalidate(tablePtr, x, y, width, height, 0);
+ }
+
+ /* get the new value of the active cell into buffer */
+ TableGetActiveBuf(tablePtr);
+
+ /* invalidate the new active cell */
+ TableCellCoords(tablePtr, tablePtr->activeRow, tablePtr->activeCol,
+ &x, &y, &width, &height);
+ TableInvalidate(tablePtr, x, y, width, height, 0);
+ /* set the old active row/col for the next time this function is called */
+ tablePtr->oldActRow = tablePtr->activeRow;
+ tablePtr->oldActCol = tablePtr->activeCol;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableAdjustParams --
+ * Calculate the row and column starts. Adjusts the topleft corner
+ * variable to keep it within the screen range, out of the titles
+ * and keep the screen full make sure the selected cell is in the
+ * visible area checks to see if the top left cell has changed at
+ * all and invalidates the table if it has.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * Number of rows can change if -rowstretchmode == fill.
+ * topRow && leftCol can change to fit display.
+ * activeRow/Col can change to ensure it is a valid cell.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableAdjustParams(register Table *tablePtr)
+{
+ int topRow, leftCol, row, col, total, i, value, x, y, width, height;
+ int w, h, bd, hl, recalc = 0;
+ int diff, unpreset, lastUnpreset, pad, lastPad, numPixels;
+ int defColWidth, defRowHeight;
+ Tcl_HashEntry *entryPtr;
+
+ /* cache the borderwidth (doubled) for many upcoming calculations */
+ bd = 2*tablePtr->borderWidth;
+ hl = tablePtr->highlightWidth;
+ w = Tk_Width(tablePtr->tkwin)-2*hl;
+ h = Tk_Height(tablePtr->tkwin)-2*hl;
+
+ /* account for whether defColWidth is in chars (>=0) or pixels (<0) */
+ /* bd is added in here for convenience */
+ if (tablePtr->defColWidth > 0)
+ defColWidth = tablePtr->charWidth * tablePtr->defColWidth + bd;
+ else
+ defColWidth = -(tablePtr->defColWidth) + bd;
+ if (tablePtr->defRowHeight > 0)
+ defRowHeight = tablePtr->charHeight * tablePtr->defRowHeight + bd;
+ else
+ defRowHeight = -(tablePtr->defRowHeight) + bd;
+
+ /* Set up the arrays to hold the col pixels and starts */
+ if (tablePtr->colPixels) ckfree((char *) tablePtr->colPixels);
+ tablePtr->colPixels = (int *) ckalloc(tablePtr->cols * sizeof(int));
+ if (tablePtr->colStarts) ckfree((char *) tablePtr->colStarts);
+ tablePtr->colStarts = (int *) ckalloc((tablePtr->cols+1) * sizeof(int));
+
+ /* get all the preset columns and set their widths */
+ lastUnpreset = 0;
+ numPixels = 0;
+ unpreset = 0;
+ for (i = 0; i < tablePtr->cols; i++) {
+ if ((entryPtr = Tcl_FindHashEntry(tablePtr->colWidths,
+ (char *) i)) == NULL) {
+ tablePtr->colPixels[i] = -1;
+ unpreset++;
+ lastUnpreset = i;
+ } else {
+ value = (int) Tcl_GetHashValue(entryPtr);
+ if (value <= 0) {
+ tablePtr->colPixels[i] = -value + bd;
+ } else {
+ tablePtr->colPixels[i] = value * tablePtr->charWidth + bd;
+ }
+ numPixels += tablePtr->colPixels[i];
+ }
+ }
+
+ /* work out how much to pad each col depending on the mode */
+ diff = w-numPixels-(unpreset*defColWidth);
+ total = 0;
+ /* now do the padding and calculate the column starts */
+ /* diff lower than 0 means we can't see the entire set of columns,
+ * thus no special stretching will occur & we optimize the calculation */
+ if (diff <= 0) {
+ for (i = 0; i < tablePtr->cols; i++) {
+ if (tablePtr->colPixels[i] == -1)
+ tablePtr->colPixels[i] = defColWidth;
+ tablePtr->colStarts[i] = total;
+ total += tablePtr->colPixels[i];
+ }
+ } else {
+ switch(tablePtr->colStretch) {
+ case STRETCH_MODE_NONE:
+ pad = 0;
+ lastPad = 0;
+ break;
+ case STRETCH_MODE_UNSET:
+ if (unpreset == 0) {
+ pad = 0;
+ lastPad = 0;
+ } else {
+ pad = diff / unpreset;
+ lastPad = diff - pad * (unpreset - 1);
+ }
+ break;
+ case STRETCH_MODE_LAST:
+ pad = 0;
+ lastPad = diff;
+ lastUnpreset = tablePtr->cols - 1;
+ break;
+ default: /* STRETCH_MODE_ALL, but also FILL for cols */
+ pad = diff / tablePtr->cols;
+ /* force it to be applied to the last column too */
+ lastUnpreset = tablePtr->cols - 1;
+ lastPad = diff - pad * lastUnpreset;
+ }
+
+ for (i = 0; i < tablePtr->cols; i++) {
+ if (tablePtr->colPixels[i] == -1) {
+ tablePtr->colPixels[i] = defColWidth
+ + ((i==lastUnpreset)?lastPad:pad);
+ } else if (tablePtr->colStretch == STRETCH_MODE_ALL) {
+ tablePtr->colPixels[i] += (i==lastUnpreset)?lastPad:pad;
+ }
+ tablePtr->colStarts[i] = total;
+ total += tablePtr->colPixels[i];
+ }
+ }
+ tablePtr->colStarts[i] = tablePtr->maxWidth = total;
+
+ /*
+ * The 'do' loop is only necessary for rows because of FILL mode
+ */
+ do {
+ /* Set up the arrays to hold the row pixels and starts */
+ /* FIX - this can be moved outside 'do' if you check >row size */
+ if (tablePtr->rowPixels) ckfree((char *) tablePtr->rowPixels);
+ tablePtr->rowPixels = (int *) ckalloc(tablePtr->rows * sizeof(int));
+
+ /* get all the preset rows and set their heights */
+ lastUnpreset = 0;
+ numPixels = 0;
+ unpreset = 0;
+ for (i = 0; i < tablePtr->rows; i++) {
+ if ((entryPtr = Tcl_FindHashEntry(tablePtr->rowHeights,
+ (char *) i)) == NULL) {
+ tablePtr->rowPixels[i] = -1;
+ unpreset++;
+ lastUnpreset = i;
+ } else {
+ value = (int) Tcl_GetHashValue(entryPtr);
+ if (value <= 0) {
+ tablePtr->rowPixels[i] = -value + bd;
+ } else {
+ tablePtr->rowPixels[i] = value * tablePtr->charHeight + bd;
+ }
+ numPixels += tablePtr->rowPixels[i];
+ }
+ }
+
+ /* work out how much to pad each row depending on the mode */
+ diff = h-numPixels-(unpreset*defRowHeight);
+ switch(tablePtr->rowStretch) {
+ case STRETCH_MODE_NONE:
+ pad = 0;
+ lastPad = 0;
+ break;
+ case STRETCH_MODE_UNSET:
+ if (unpreset == 0) {
+ pad = 0;
+ lastPad = 0;
+ } else {
+ pad = MAX(0,diff) / unpreset;
+ lastPad = MAX(0,diff) - pad * (unpreset - 1);
+ }
+ break;
+ case STRETCH_MODE_LAST:
+ pad = 0;
+ lastPad = MAX(0,diff);
+ /* force it to be applied to the last column too */
+ lastUnpreset = tablePtr->rows - 1;
+ break;
+ case STRETCH_MODE_FILL:
+ pad = 0;
+ lastPad = diff;
+ if (diff && !recalc) {
+ tablePtr->rows += (diff/defRowHeight);
+ if (diff < 0 && tablePtr->rows < 0)
+ tablePtr->rows = 0;
+ lastUnpreset = tablePtr->rows - 1;
+ recalc = 1;
+ continue;
+ } else {
+ lastUnpreset = tablePtr->rows - 1;
+ recalc = 0;
+ }
+ break;
+ default: /* STRETCH_MODE_ALL */
+ pad = MAX(0,diff) / tablePtr->rows;
+ /* force it to be applied to the last column too */
+ lastUnpreset = tablePtr->rows - 1;
+ lastPad = MAX(0,diff) - pad * lastUnpreset;
+ }
+ } while (recalc);
+
+ if (tablePtr->rowStarts) ckfree((char *) tablePtr->rowStarts);
+ tablePtr->rowStarts = (int *) ckalloc((tablePtr->rows+1)*sizeof(int));
+ /* now do the padding and calculate the row starts */
+ total = 0;
+ for (i = 0; i < tablePtr->rows; i++) {
+ if (tablePtr->rowPixels[i] == -1) {
+ tablePtr->rowPixels[i] = defRowHeight
+ + ((i==lastUnpreset)?lastPad:pad);
+ } else if (tablePtr->rowStretch == STRETCH_MODE_ALL) {
+ tablePtr->rowPixels[i] += (i==lastUnpreset)?lastPad:pad;
+ }
+ /* calculate the start of each row */
+ tablePtr->rowStarts[i] = total;
+ total += tablePtr->rowPixels[i];
+ }
+ tablePtr->rowStarts[i] = tablePtr->maxHeight = total;
+
+ /* make sure the top row and col have reasonable real indices */
+ tablePtr->topRow = topRow =
+ MAX(tablePtr->titleRows, MIN(tablePtr->topRow, tablePtr->rows-1));
+ tablePtr->leftCol = leftCol =
+ MAX(tablePtr->titleCols, MIN(tablePtr->leftCol, tablePtr->cols-1));
+
+ /* If we dont have the info, dont bother to fix up the other parameters */
+ if (Tk_WindowId(tablePtr->tkwin) == None) {
+ tablePtr->oldTopRow = tablePtr->oldLeftCol = -1;
+ return;
+ }
+
+ w += hl;
+ h += hl;
+ /*
+ * If we use this value of topRow, will we fill the window?
+ * if not, decrease it until we will, or until it gets to titleRows
+ * make sure we don't cut off the bottom row
+ */
+ for (; topRow > tablePtr->titleRows; topRow--)
+ if ((tablePtr->maxHeight-(tablePtr->rowStarts[topRow-1] -
+ tablePtr->rowStarts[tablePtr->titleRows])) > h)
+ break;
+ /*
+ * If we use this value of topCol, will we fill the window?
+ * if not, decrease it until we will, or until it gets to titleCols
+ * make sure we don't cut off the left column
+ */
+ for (; leftCol > tablePtr->titleCols; leftCol--)
+ if ((tablePtr->maxWidth-(tablePtr->colStarts[leftCol-1] -
+ tablePtr->colStarts[tablePtr->titleCols])) > w)
+ break;
+
+ tablePtr->topRow = topRow;
+ tablePtr->leftCol = leftCol;
+
+ /* Now work out where the bottom right for scrollbar update
+ * and testing for one last stretch */
+ TableGetLastCell(tablePtr, &row, &col);
+ TableCellVCoords(tablePtr, row, col, &x, &y, &width, &height, 0);
+
+ /*
+ * Do we have scrollbars, if so, calculate and call the TCL functions In
+ * order to get the scrollbar to be completely full when the whole screen
+ * is shown and there are titles, we have to arrange for the scrollbar
+ * range to be 0 -> rows-titleRows etc. This leads to the position
+ * setting methods, toprow and leftcol, being relative to the titles, not
+ * absolute row and column numbers.
+ */
+ if (tablePtr->yScrollCmd != NULL || tablePtr->xScrollCmd != NULL) {
+ Tcl_Interp *interp = tablePtr->interp;
+ char buf[INDEX_BUFSIZE];
+ double first, last;
+
+ /*
+ * We must hold onto the interpreter because the data referred to at
+ * tablePtr might be freed as a result of the call to Tcl_VarEval.
+ */
+ Tcl_Preserve((ClientData) interp);
+
+ /* Do we have a Y-scrollbar and rows to scroll? */
+ if (tablePtr->yScrollCmd != NULL) {
+ if (row < tablePtr->titleRows) {
+ first = 0;
+ last = 1;
+ } else {
+ diff = tablePtr->rowStarts[tablePtr->titleRows];
+ last = (double) (tablePtr->rowStarts[tablePtr->rows]-diff);
+ first = (tablePtr->rowStarts[topRow]-diff) / last;
+ last = (height+tablePtr->rowStarts[row]-diff) / last;
+ }
+ sprintf(buf, " %g %g", first, last);
+ if (Tcl_VarEval(interp, tablePtr->yScrollCmd,
+ buf, (char *) NULL) != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (vertical scrolling command executed by table)");
+ Tcl_BackgroundError(interp);
+ }
+ }
+ /* Do we have a X-scrollbar and cols to scroll? */
+ if (tablePtr->xScrollCmd != NULL) {
+ if (col < tablePtr->titleCols) {
+ first = 0;
+ last = 1;
+ } else {
+ diff = tablePtr->colStarts[tablePtr->titleCols];
+ last = (double) (tablePtr->colStarts[tablePtr->cols]-diff);
+ first = (tablePtr->colStarts[leftCol]-diff) / last;
+ last = (width+tablePtr->colStarts[col]-diff) / last;
+ }
+ sprintf(buf, " %g %g", first, last);
+ if (Tcl_VarEval(interp, tablePtr->xScrollCmd,
+ buf, (char *) NULL) != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (horizontal scrolling command executed by table)");
+ Tcl_BackgroundError(interp);
+ }
+ }
+
+ Tcl_Release((ClientData) interp);
+ }
+
+ /* Adjust the last row/col to fill empty space if it is visible */
+ /* do this after setting the scrollbars to not upset its calculations */
+ if (row == tablePtr->rows-1 && tablePtr->rowStretch != STRETCH_MODE_NONE) {
+ diff = h-(y+height);
+ if (diff > 0) {
+ tablePtr->rowPixels[tablePtr->rows-1] += diff;
+ tablePtr->rowStarts[tablePtr->rows] += diff;
+ }
+ }
+ if (col == tablePtr->cols-1 && tablePtr->colStretch != STRETCH_MODE_NONE) {
+ diff = w-(x+width);
+ if (diff > 0) {
+ tablePtr->colPixels[tablePtr->cols-1] += diff;
+ tablePtr->colStarts[tablePtr->cols] += diff;
+ }
+ }
+
+ TableAdjustActive(tablePtr);
+
+ /*
+ * now check the new value of topleft cell against the originals,
+ * If they changed, invalidate the area, else leave it alone
+ */
+ if (tablePtr->topRow != tablePtr->oldTopRow ||
+ tablePtr->leftCol != tablePtr->oldLeftCol) {
+ /* set the old top row/col for the next time this function is called */
+ tablePtr->oldTopRow = tablePtr->topRow;
+ tablePtr->oldLeftCol = tablePtr->leftCol;
+ /* only the upper corner title cells wouldn't change */
+ TableInvalidateAll(tablePtr, 0);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableCursorEvent --
+ * Toggle the cursor status. Equivalent to EntryBlinkProc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor will be switched off/on.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableCursorEvent(ClientData clientData)
+{
+ register Table *tablePtr = (Table *) clientData;
+
+ if (!(tablePtr->flags & HAS_FOCUS) || (tablePtr->insertOffTime == 0)) {
+ return;
+ }
+
+ if (tablePtr->cursorTimer != NULL)
+ Tcl_DeleteTimerHandler(tablePtr->cursorTimer);
+
+ tablePtr->cursorTimer =
+ Tcl_CreateTimerHandler((tablePtr->flags & CURSOR_ON) ?
+ tablePtr->insertOffTime : tablePtr->insertOnTime,
+ TableCursorEvent, (ClientData) tablePtr);
+ /* Toggle the cursor */
+ tablePtr->flags ^= CURSOR_ON;
+
+ /* invalidate the cell */
+ TableRefresh(tablePtr, tablePtr->activeRow, tablePtr->activeCol,
+ CELL|INV_FORCE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableConfigCursor --
+ * Configures the timer depending on the state of the table.
+ * Equivalent to EntryFocusProc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor will be switched off/on.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableConfigCursor(register Table *tablePtr)
+{
+ /* to get a cursor, we have to have focus and allow edits */
+ if ((tablePtr->flags & HAS_FOCUS) && !(tablePtr->flags & ACTIVE_DISABLED) &&
+ (tablePtr->state == STATE_NORMAL)) {
+ /* turn the cursor on */
+ if (!(tablePtr->flags & CURSOR_ON)) {
+ tablePtr->flags |= CURSOR_ON;
+ }
+
+ /* set up the first timer */
+ if (tablePtr->insertOffTime != 0) {
+ /* make sure nothing existed */
+ Tcl_DeleteTimerHandler(tablePtr->cursorTimer);
+ tablePtr->cursorTimer = Tcl_CreateTimerHandler(tablePtr->insertOnTime,
+ TableCursorEvent,
+ (ClientData) tablePtr);
+ }
+
+ } else {
+ /* turn the cursor off */
+ if ((tablePtr->flags & CURSOR_ON)) {
+ tablePtr->flags &= ~CURSOR_ON;
+ }
+
+ /* and disable the timer */
+ if (tablePtr->cursorTimer != NULL)
+ Tcl_DeleteTimerHandler(tablePtr->cursorTimer);
+ tablePtr->cursorTimer = NULL;
+ }
+
+ /* Invalidate the selection window to show or hide the cursor */
+ TableRefresh(tablePtr, tablePtr->activeRow, tablePtr->activeCol,
+ CELL|INV_FORCE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableFetchSelection --
+ * This procedure is called back by Tk when the selection is
+ * requested by someone. It returns part or all of the selection
+ * in a buffer provided by the caller.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored
+ * at buffer. Buffer is filled (or partially filled) with a
+ * NULL-terminated string containing part or all of the selection,
+ * as given by offset and maxBytes.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+TableFetchSelection(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Information about table 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. */
+{
+ register Table *tablePtr = (Table *) clientData;
+ Tcl_Interp *interp = tablePtr->interp;
+ char *value, *data, *rowsep = tablePtr->rowSep, *colsep = tablePtr->colSep;
+ Tcl_DString selection;
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ int length, count, lastrow=0, needcs=0, r, c, listArgc, rslen=0, cslen=0;
+ int numcols, numrows;
+ char **listArgv;
+
+ /* if we are not exporting the selection || we have no data source, return */
+ if (!tablePtr->exportSelection ||
+ (tablePtr->dataSource == DATA_NONE)) {
+ return -1;
+ }
+
+ /* First get a sorted list of the selected elements */
+ Tcl_DStringInit(&selection);
+ for (entryPtr = Tcl_FirstHashEntry(tablePtr->selCells, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_DStringAppendElement(&selection,
+ Tcl_GetHashKey(tablePtr->selCells, entryPtr));
+ }
+ value = TableCellSort(tablePtr, Tcl_DStringValue(&selection));
+ Tcl_DStringFree(&selection);
+
+ if (value == NULL ||
+ Tcl_SplitList(interp, value, &listArgc, &listArgv) != TCL_OK) {
+ return -1;
+ }
+ ckfree(value);
+
+ Tcl_DStringInit(&selection);
+ rslen = (rowsep?(strlen(rowsep)):0);
+ cslen = (colsep?(strlen(colsep)):0);
+ numrows = numcols = 0;
+ for (count = 0; count < listArgc; count++) {
+ TableParseArrayIndex(&r, &c, listArgv[count]);
+ if (count) {
+ if (lastrow != r) {
+ lastrow = r;
+ needcs = 0;
+ if (rslen) {
+ Tcl_DStringAppend(&selection, rowsep, rslen);
+ } else {
+ Tcl_DStringEndSublist(&selection);
+ Tcl_DStringStartSublist(&selection);
+ }
+ ++numrows;
+ } else {
+ if (++needcs > numcols)
+ numcols = needcs;
+ }
+ } else {
+ lastrow = r;
+ needcs = 0;
+ if (!rslen)
+ Tcl_DStringStartSublist(&selection);
+ }
+ data = TableGetCellValue(tablePtr, r, c);
+ if (cslen) {
+ if (needcs)
+ Tcl_DStringAppend(&selection, colsep, cslen);
+ Tcl_DStringAppend(&selection, data, -1);
+ } else {
+ Tcl_DStringAppendElement(&selection, data);
+ }
+ }
+ if (!rslen && count)
+ Tcl_DStringEndSublist(&selection);
+ ckfree((char *) listArgv);
+
+ if (tablePtr->selCmd != NULL) {
+ Tcl_DString script;
+ Tcl_DStringInit(&script);
+ ExpandPercents(tablePtr, tablePtr->selCmd, numrows+1, numcols+1,
+ Tcl_DStringValue(&selection), (char *) NULL,
+ listArgc, &script, CMD_ACTIVATE);
+ if (Tcl_GlobalEval(interp, Tcl_DStringValue(&script)) == TCL_ERROR) {
+ Tcl_AddErrorInfo(interp,
+ "\n (error in table selection command)");
+ Tcl_BackgroundError(interp);
+ Tcl_DStringFree(&script);
+ Tcl_DStringFree(&selection);
+ return -1;
+ } else {
+ Tcl_DStringGetResult(interp, &selection);
+ }
+ Tcl_DStringFree(&script);
+ }
+
+ length = Tcl_DStringLength(&selection);
+
+ if (length == 0)
+ return -1;
+
+ /* Copy the requested portion of the selection to the buffer. */
+ count = length - offset;
+ if (count <= 0) {
+ count = 0;
+ } else {
+ if (count > maxBytes) {
+ count = maxBytes;
+ }
+ memcpy((VOID *) buffer, (VOID *) (Tcl_DStringValue(&selection) + offset),
+ (size_t) count);
+ }
+ buffer[count] = '\0';
+ Tcl_DStringFree(&selection);
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableLostSelection --
+ * This procedure is called back by Tk when the selection is
+ * grabbed away from a table widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The existing selection is unhighlighted, and the window is
+ * marked as not containing a selection.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableLostSelection(clientData)
+ ClientData clientData; /* Information about table widget. */
+{
+ register Table *tablePtr = (Table *) clientData;
+
+ if (tablePtr->exportSelection) {
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ int row, col;
+
+ /* Same as SEL CLEAR ALL */
+ for (entryPtr = Tcl_FirstHashEntry(tablePtr->selCells, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ TableParseArrayIndex(&row, &col,
+ Tcl_GetHashKey(tablePtr->selCells,entryPtr));
+ Tcl_DeleteHashEntry(entryPtr);
+ TableRefresh(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset, CELL);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableRestrictProc --
+ * A Tk_RestrictProc used by TableValidateChange to eliminate any
+ * extra key input events in the event queue that
+ * have a serial number no less than a given value.
+ *
+ * Results:
+ * Returns either TK_DISCARD_EVENT or TK_DEFER_EVENT.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static Tk_RestrictAction
+TableRestrictProc(serial, eventPtr)
+ ClientData serial;
+ XEvent *eventPtr;
+{
+ if ((eventPtr->type == KeyRelease || eventPtr->type == KeyPress) &&
+ ((eventPtr->xany.serial-(unsigned int)serial) > 0)) {
+ return TK_DEFER_EVENT;
+ } else {
+ return TK_PROCESS_EVENT;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TableValidateChange --
+ * This procedure is invoked when any character is added or
+ * removed from the table widget, or a set has triggered validation.
+ *
+ * Results:
+ * TCL_OK if the validatecommand accepts the new string,
+ * TCL_BREAK if the validatecommand rejects the new string,
+ * TCL_ERROR if any problems occured with validatecommand.
+ *
+ * Side effects:
+ * The insertion/deletion may be aborted, and the
+ * validatecommand might turn itself off (if an error
+ * or loop condition arises).
+ *
+ *--------------------------------------------------------------
+ */
+static int
+TableValidateChange(tablePtr, r, c, old, new, index)
+ register Table *tablePtr; /* Table that needs validation. */
+ int r, c; /* row,col index of cell in user coords */
+ char *old; /* current value of cell */
+ char *new; /* potential new value of cell */
+ int index; /* index of insert/delete, -1 otherwise */
+{
+ register Tcl_Interp *interp = tablePtr->interp;
+ int code, bool;
+ Tk_RestrictProc *restrict;
+ ClientData cdata;
+ Tcl_DString script;
+
+ if (tablePtr->valCmd == NULL || tablePtr->validate == 0) {
+ return TCL_OK;
+ }
+
+ /* Magic code to make this bit of code synchronous in the face of
+ * possible new key events */
+ XSync(tablePtr->display, False);
+ restrict = Tk_RestrictEvents(TableRestrictProc, (ClientData)
+ NextRequest(tablePtr->display), &cdata);
+
+ /*
+ * If we're already validating, then we're hitting a loop condition
+ * Return and set validate to 0 to disallow further validations
+ * and prevent current validation from finishing
+ */
+ if (tablePtr->flags & VALIDATING) {
+ tablePtr->validate = 0;
+ return TCL_OK;
+ }
+ tablePtr->flags |= VALIDATING;
+
+ /* Now form command string and run through the -validatecommand */
+ Tcl_DStringInit(&script);
+ ExpandPercents(tablePtr, tablePtr->valCmd, r, c, old, new, index, &script,
+ CMD_VALIDATE);
+ code = Tcl_GlobalEval(tablePtr->interp, Tcl_DStringValue(&script));
+ Tcl_DStringFree(&script);
+
+ if (code != TCL_OK && code != TCL_RETURN) {
+ Tcl_AddErrorInfo(interp, "\n\t(in validation command executed by table)");
+ Tk_BackgroundError(interp);
+ code = TCL_ERROR;
+ } else if (Tcl_GetBoolean(interp, Tcl_GetStringResult(interp),
+ &bool) != TCL_OK) {
+ Tcl_AddErrorInfo(interp, "\n\tboolean not returned by validation command");
+ Tk_BackgroundError(interp);
+ code = TCL_ERROR;
+ } else {
+ if (bool)
+ code = TCL_OK;
+ else
+ code = TCL_BREAK;
+ }
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+
+ /*
+ * If ->validate has become VALIDATE_NONE during the validation,
+ * it means that a loop condition almost occured. Do not allow
+ * this validation result to finish.
+ */
+ if (tablePtr->validate == 0) {
+ code = TCL_ERROR;
+ }
+
+ /* If validate will return ERROR, then disallow further validations */
+ if (code == TCL_ERROR) {
+ tablePtr->validate = 0;
+ }
+
+ Tk_RestrictEvents(restrict, cdata, &cdata);
+ tablePtr->flags &= ~VALIDATING;
+
+ return code;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ExpandPercents --
+ * Given a command and an event, produce a new command
+ * by replacing % constructs in the original command
+ * with information from the X event.
+ *
+ * Results:
+ * The new expanded command is appended to the dynamic string
+ * given by dsPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+void
+ExpandPercents(tablePtr, before, r, c, old, new, index, dsPtr, cmdType)
+ Table *tablePtr; /* Table that needs validation. */
+ char *before; /* Command containing percent
+ * expressions to be replaced. */
+ int r, c; /* row,col index of cell */
+ char *old; /* current value of cell */
+ char *new; /* potential new value of cell */
+ int index; /* index of insert/delete */
+ Tcl_DString *dsPtr; /* Dynamic string in which to append
+ * new command. */
+ int cmdType; /* type of command to make %-subs for */
+{
+ int spaceNeeded, cvtFlags; /* Used to substitute string as proper Tcl
+ * list element. */
+ int number, length;
+ char *string;
+ char buf[INDEX_BUFSIZE];
+
+ /* This returns the static value of the string as set in the array */
+ if (old == NULL && cmdType == CMD_VALIDATE) {
+ old = TableGetCellValue(tablePtr, r, c);
+ }
+
+ while (1) {
+ /*
+ * Find everything up to the next % character and append it
+ * to the result string.
+ */
+ for (string = before; (*string != 0) && (*string != '%'); string++) {
+ /* Empty loop body. */
+ }
+ if (string != before) {
+ Tcl_DStringAppend(dsPtr, before, string-before);
+ before = string;
+ }
+ if (*before == 0) break;
+
+ /* There's a percent sequence here. Process it. */
+ number = 0;
+ string = "??";
+ /* cmdType independent substitutions */
+ switch (before[1]) {
+ case 'c':
+ number = c;
+ goto doNumber;
+ case 'C': /* index of cell */
+ TableMakeArrayIndex(r, c, buf);
+ string = buf;
+ goto doString;
+ case 'r':
+ number = r;
+ goto doNumber;
+ case 'i': /* index of cursor OR |number| of cells selected */
+ number = index;
+ goto doNumber;
+ case 's': /* Current cell value */
+ string = old;
+ goto doString;
+ case 'S': /* Potential new value of cell */
+ string = (new?new:old);
+ goto doString;
+ case 'W': /* widget name */
+ string = Tk_PathName(tablePtr->tkwin);
+ goto doString;
+ default:
+ buf[0] = before[1];
+ buf[1] = '\0';
+ string = buf;
+ goto doString;
+ }
+
+ doNumber:
+ sprintf(buf, "%d", number);
+ string = buf;
+
+ doString:
+ spaceNeeded = Tcl_ScanElement(string, &cvtFlags);
+ length = Tcl_DStringLength(dsPtr);
+ 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_DStringAppend(dsPtr, "", 1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableDeleteChars --
+ * Remove one or more characters from an table widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory gets freed, the table gets modified and (eventually)
+ * redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableDeleteChars(tablePtr, index, count)
+ register Table *tablePtr; /* Table widget to modify. */
+ int index; /* Index of first character to delete. */
+ int count; /* How many characters to delete. */
+{
+ int x, y, width, height;
+#if (TK_MINOR_VERSION > 0)
+ int byteIndex, byteCount, newByteCount, numBytes, numChars;
+ char *new, *string;
+
+ string = tablePtr->activeBuf;
+ numBytes = strlen(string);
+ numChars = Tcl_NumUtfChars(string, numBytes);
+ if ((index + count) > numChars) {
+ count = numChars - index;
+ }
+ if (count <= 0) {
+ return;
+ }
+
+ byteIndex = Tcl_UtfAtIndex(string, index) - string;
+ byteCount = Tcl_UtfAtIndex(string + byteIndex, count) - (string + byteIndex);
+
+ newByteCount = numBytes + 1 - byteCount;
+ new = (char *) ckalloc((unsigned) newByteCount);
+ memcpy(new, string, (size_t) byteIndex);
+ strcpy(new + byteIndex, string + byteIndex + byteCount);
+#else
+ int oldlen;
+ char *new;
+
+ /* this gets the length of the string, as well as ensuring that
+ * the cursor isn't beyond the end char */
+ TableGetIcursor(tablePtr, "end", &oldlen);
+
+ if ((index+count) > oldlen)
+ count = oldlen-index;
+ if (count <= 0)
+ return;
+
+ new = (char *) ckalloc((unsigned)(oldlen-count+1));
+ strncpy(new, tablePtr->activeBuf, (size_t) index);
+ strcpy(new+index, tablePtr->activeBuf+index+count);
+ /* make sure this string is null terminated */
+ new[oldlen-count] = '\0';
+#endif
+ /* This prevents deletes on BREAK or validation error. */
+ if (tablePtr->validate &&
+ TableValidateChange(tablePtr, tablePtr->activeRow+tablePtr->rowOffset,
+ tablePtr->activeCol+tablePtr->colOffset,
+ tablePtr->activeBuf, new, index) != TCL_OK) {
+ ckfree(new);
+ return;
+ }
+
+ ckfree(tablePtr->activeBuf);
+ tablePtr->activeBuf = new;
+
+ /* mark the text as changed */
+ tablePtr->flags |= TEXT_CHANGED;
+
+ if (tablePtr->icursor >= index) {
+ if (tablePtr->icursor >= (index+count)) {
+ tablePtr->icursor -= count;
+ } else {
+ tablePtr->icursor = index;
+ }
+ }
+
+ TableSetActiveIndex(tablePtr);
+
+ TableCellCoords(tablePtr, tablePtr->activeRow, tablePtr->activeCol,
+ &x, &y, &width, &height);
+ TableInvalidate(tablePtr, x, y, width, height, INV_FORCE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableInsertChars --
+ * Add new characters to the active cell of a table widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * New information gets added to tablePtr; it will be redisplayed
+ * soon, but not necessarily immediately.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableInsertChars(tablePtr, index, value)
+ register Table *tablePtr; /* Table that is to get the new elements. */
+ int index; /* Add the new elements before this element. */
+ char *value; /* New characters to add (NULL-terminated
+ * string). */
+{
+#if (TK_MINOR_VERSION > 0)
+ int x, y, width, height, oldlen;
+ int byteIndex, byteCount;
+ char *new, *string;
+
+ string = tablePtr->activeBuf;
+ byteIndex = Tcl_UtfAtIndex(string, index) - string;
+ byteCount = strlen(value);
+ if (byteCount == 0) {
+ return;
+ }
+
+ /* Is this an autoclear and this is the first update */
+ /* Note that this clears without validating */
+ if (tablePtr->autoClear && !(tablePtr->flags & TEXT_CHANGED)) {
+ /* set the buffer to be empty */
+ tablePtr->activeBuf = (char *)ckrealloc(tablePtr->activeBuf, 1);
+ tablePtr->activeBuf[0] = '\0';
+ /* the insert position now has to be 0 */
+ index = 0;
+ }
+
+ oldlen = strlen(string);
+ new = (char *) ckalloc((unsigned)(oldlen + byteCount + 1));
+ memcpy(new, string, (size_t) byteIndex);
+ strcpy(new + byteIndex, value);
+ strcpy(new + byteIndex + byteCount, string + byteIndex);
+
+ /* validate potential new active buffer */
+ /* This prevents inserts on either BREAK or validation error. */
+ if (tablePtr->validate &&
+ TableValidateChange(tablePtr, tablePtr->activeRow+tablePtr->rowOffset,
+ tablePtr->activeCol+tablePtr->colOffset,
+ tablePtr->activeBuf, new, byteIndex) != TCL_OK) {
+ ckfree(new);
+ return;
+ }
+
+ /*
+ * 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 were are in the string now minus the number that
+ * used to be there.
+ */
+
+ if (tablePtr->icursor >= index) {
+ tablePtr->icursor += Tcl_NumUtfChars(new, oldlen+byteCount)
+ - Tcl_NumUtfChars(tablePtr->activeBuf, oldlen);
+ }
+
+ ckfree(string);
+ tablePtr->activeBuf = new;
+
+#else
+ int x, y, width, height, oldlen, newlen;
+ char *new;
+
+ newlen = strlen(value);
+ if (newlen == 0) return;
+
+ /* Is this an autoclear and this is the first update */
+ /* Note that this clears without validating */
+ if (tablePtr->autoClear && !(tablePtr->flags & TEXT_CHANGED)) {
+ /* set the buffer to be empty */
+ tablePtr->activeBuf = (char *)ckrealloc(tablePtr->activeBuf, 1);
+ tablePtr->activeBuf[0] = '\0';
+ /* the insert position now has to be 0 */
+ index = 0;
+ }
+ oldlen = strlen(tablePtr->activeBuf);
+ /* get the buffer to at least the right length */
+ new = (char *) ckalloc((unsigned)(oldlen+newlen+1));
+ strncpy(new, tablePtr->activeBuf, (size_t) index);
+ strcpy(new+index, value);
+ strcpy(new+index+newlen, (tablePtr->activeBuf)+index);
+ /* make sure this string is null terminated */
+ new[oldlen+newlen] = '\0';
+
+ /* validate potential new active buffer */
+ /* This prevents inserts on either BREAK or validation error. */
+ if (tablePtr->validate &&
+ TableValidateChange(tablePtr, tablePtr->activeRow+tablePtr->rowOffset,
+ tablePtr->activeCol+tablePtr->colOffset,
+ tablePtr->activeBuf, new, index) != TCL_OK) {
+ ckfree(new);
+ return;
+ }
+ ckfree(tablePtr->activeBuf);
+ tablePtr->activeBuf = new;
+
+ if (tablePtr->icursor >= index) {
+ tablePtr->icursor += newlen;
+ }
+#endif
+
+ /* mark the text as changed */
+ tablePtr->flags |= TEXT_CHANGED;
+
+ TableSetActiveIndex(tablePtr);
+
+ TableCellCoords(tablePtr, tablePtr->activeRow, tablePtr->activeCol,
+ &x, &y, &width, &height);
+ TableInvalidate(tablePtr, x, y, width, height, INV_FORCE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableModifyRCaux --
+ * Helper function that does the core work of moving rows/cols
+ * and associated tags.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Moves cell data and possibly tag data
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableModifyRCaux(tablePtr, type, which, movetag, tagTblPtr, dimTblPtr,
+ offset, from, to, lo, hi, check)
+ Table *tablePtr; /* Information about text widget. */
+ int type; /* insert (CMD_INSERT) | delete (CMD_DELETE) */
+ int which; /* rows (MOD_ROWS) or cols (MOD_COLS) */
+ int movetag; /* whether tags are supposed to be moved */
+ Tcl_HashTable *tagTblPtr, *dimTblPtr; /* Pointers to the row/col tags
+ * and width/height tags */
+ int offset; /* appropriate offset */
+ int from, to; /* the from and to row/col */
+ int lo, hi; /* the lo and hi col/row */
+ int check; /* the boundary check for shifting items */
+{
+ int j, dummy;
+ char buf[INDEX_BUFSIZE], buf1[INDEX_BUFSIZE];
+ Tcl_HashEntry *entryPtr, *newPtr;
+
+ /* move row/col style && width/height here */
+ if (movetag) {
+ if ((entryPtr=Tcl_FindHashEntry(tagTblPtr, (char *)from)) != NULL) {
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ if ((entryPtr=Tcl_FindHashEntry(dimTblPtr, (char *)from-offset)) != NULL) {
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ if (!check) {
+ if ((entryPtr=Tcl_FindHashEntry(tagTblPtr, (char *)to)) != NULL) {
+ newPtr = Tcl_CreateHashEntry(tagTblPtr, (char *)from, &dummy);
+ Tcl_SetHashValue(newPtr, Tcl_GetHashValue(entryPtr));
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ if ((entryPtr=Tcl_FindHashEntry(dimTblPtr, (char *)to-offset)) != NULL) {
+ newPtr = Tcl_CreateHashEntry(dimTblPtr, (char *)from-offset, &dummy);
+ Tcl_SetHashValue(newPtr, Tcl_GetHashValue(entryPtr));
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ }
+ }
+ for (j = lo; j <= hi; j++) {
+ if (which == MOD_COLS) {
+ TableMakeArrayIndex(j, from, buf);
+ TableMakeArrayIndex(j, to, buf1);
+ TableSetCellValue(tablePtr, j, from, check ? "" :
+ TableGetCellValue(tablePtr, j, to));
+ } else {
+ TableMakeArrayIndex(from, j, buf);
+ TableMakeArrayIndex(to, j, buf1);
+ TableSetCellValue(tablePtr, from, j, check ? "" :
+ TableGetCellValue(tablePtr, to, j));
+ }
+ /* move cell style here */
+ if (movetag) {
+ if ((entryPtr=Tcl_FindHashEntry(tablePtr->cellStyles,buf)) != NULL) {
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ if (!check &&
+ (entryPtr=Tcl_FindHashEntry(tablePtr->cellStyles,buf1))!=NULL) {
+ newPtr = Tcl_CreateHashEntry(tablePtr->cellStyles, buf, &dummy);
+ Tcl_SetHashValue(newPtr, Tcl_GetHashValue(entryPtr));
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableModifyRC --
+ * Modify rows/cols of the table (insert or delete)
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Modifies associated row/col data
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+TableModifyRC(tablePtr, interp, type, which, argc, argv)
+ Table *tablePtr; /* Information about text widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int type; /* insert (CMD_INSERT) | delete (CMD_DELETE) */
+ int which; /* rows (MOD_ROWS) or cols (MOD_COLS) */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int i, first, lo, hi, idx, c, argsLeft, x, y, offset;
+ int maxrow, maxcol, maxkey, minkey, movetitle, movetag, movedim;
+ size_t length;
+ char *arg;
+ Tcl_HashTable *tagTblPtr, *dimTblPtr;
+ Tcl_HashSearch search;
+ int *dimPtr;
+
+ movetitle = 1;
+ movetag = 1;
+ movedim = 1;
+ maxcol = tablePtr->cols-1+tablePtr->colOffset;
+ maxrow = tablePtr->rows-1+tablePtr->rowOffset;
+ for (i = 3; i < argc; i++) {
+ arg = argv[i];
+ if (arg[0] != '-') {
+ break;
+ }
+ length = strlen(arg);
+ if (length < 2) {
+ badSwitch:
+ Tcl_AppendResult(interp, "bad switch \"", arg,
+ "\": must be -cols, -keeptitles, -holddimensions, ",
+ "-holdtags, -rows, or --",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = arg[1];
+ if ((c == 'h') && (length > 5) &&
+ (strncmp(argv[i], "-holddimensions", length) == 0)) {
+ movedim = 0;
+ } else if ((c == 'h') && (length > 5) &&
+ (strncmp(argv[i], "-holdtags", length) == 0)) {
+ movetag = 0;
+ } else if ((c == 'k') && (strncmp(argv[i], "-keeptitles", length) == 0)) {
+ movetitle = 0;
+ } else if ((c == 'c') && (strncmp(argv[i], "-cols", length) == 0)) {
+ if (i >= (argc-1)) {
+ Tcl_SetResult(interp, "no value given for \"-cols\" option",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[++i], &maxcol) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ maxcol = MAX(maxcol, tablePtr->titleCols+tablePtr->colOffset);
+ } else if ((c == 'r') && (strncmp(argv[i], "-rows", length) == 0)) {
+ if (i >= (argc-1)) {
+ Tcl_SetResult(interp, "no value given for \"-rows\" option",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[++i], &maxrow) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ maxrow = MAX(maxrow, tablePtr->titleRows+tablePtr->rowOffset);
+ } else if ((c == '-') && (strncmp(argv[i], "--", length) == 0)) {
+ i++;
+ break;
+ } else {
+ goto badSwitch;
+ }
+ }
+ argsLeft = argc - i;
+ if (argsLeft != 1 && argsLeft != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ (type == CMD_DELETE) ? " delete" : " insert",
+ (which == MOD_COLS) ? " cols" : " rows",
+ " ?switches? index ?count?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ c = 1;
+ if (strcmp(argv[i], "end") == 0) {
+ /* allow "end" to be specified as an index */
+ idx = (which == MOD_COLS) ? maxcol : maxrow;
+ } else if (Tcl_GetInt(interp, argv[i], &idx) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (argsLeft == 2 && Tcl_GetInt(interp, argv[++i], &c) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (tablePtr->state == STATE_DISABLED || c == 0)
+ return TCL_OK;
+
+ if (which == MOD_COLS) {
+ maxkey = maxcol;
+ minkey = tablePtr->colOffset+tablePtr->titleCols;
+ lo = tablePtr->rowOffset+(movetitle?0:tablePtr->titleRows);
+ hi = maxrow;
+ offset = tablePtr->colOffset;
+ tagTblPtr = tablePtr->colStyles;
+ dimTblPtr = tablePtr->colWidths;
+ dimPtr = &(tablePtr->cols);
+ } else {
+ maxkey = maxrow;
+ minkey = tablePtr->rowOffset+tablePtr->titleRows;
+ lo = tablePtr->colOffset+(movetitle?0:tablePtr->titleCols);
+ hi = maxcol;
+ offset = tablePtr->rowOffset;
+ tagTblPtr = tablePtr->rowStyles;
+ dimTblPtr = tablePtr->rowHeights;
+ dimPtr = &(tablePtr->rows);
+ }
+
+ if (type == CMD_DELETE) {
+ /* Handle row/col deletion */
+ first = MAX(MIN(idx,idx+c), minkey);
+ /* (index = i && count = 1) == (index = i && count = -1) */
+ if (c < 0) {
+ /* if the count is negative, make sure that the col count will delete
+ * no greater than the original index */
+ c = idx-first;
+ first++;
+ }
+ if (movedim) {
+ *dimPtr -= c;
+ }
+ for (i = first; i <= maxkey; i++) {
+ TableModifyRCaux(tablePtr, type, which, movetag, tagTblPtr,
+ dimTblPtr, offset, i, i+c, lo, hi, ((i+c)>maxkey));
+ }
+ } else {
+ /* Handle row/col insertion */
+ first = MAX(MIN(idx, maxkey), minkey);
+ /* +count means insert after index, -count means insert before index */
+ if (c < 0) {
+ c = -c;
+ } else {
+ first++;
+ }
+ if (movedim) {
+ maxkey += c;
+ *dimPtr += c;
+ }
+ for (i = maxkey; i >= first; i--) {
+ /* move row/col style && width/height here */
+ TableModifyRCaux(tablePtr, type, which, movetag, tagTblPtr,
+ dimTblPtr, offset, i, i-c, lo, hi, ((i-c)<first));
+ }
+ }
+ if (Tcl_FirstHashEntry(tablePtr->selCells, &search) != NULL) {
+ /* clear selection - forceful, but effective */
+ Tcl_DeleteHashTable(tablePtr->selCells);
+ ckfree((char *) (tablePtr->selCells));
+ tablePtr->selCells = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->selCells, TCL_STRING_KEYS);
+ }
+
+ TableAdjustParams(tablePtr);
+ if (which == MOD_COLS) {
+ TableCellCoords(tablePtr, 0, first, &x, &y, &offset, &offset);
+ TableInvalidate(tablePtr, x, y,
+ Tk_Width(tablePtr->tkwin)-x,
+ Tk_Height(tablePtr->tkwin), 0);
+ } else {
+ TableCellCoords(tablePtr, first, 0, &x, &y, &offset, &offset);
+ TableInvalidate(tablePtr, x, y,
+ Tk_Width(tablePtr->tkwin),
+ Tk_Height(tablePtr->tkwin)-y, 0);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TableWidgetCmd --
+ * 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
+TableWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about listbox widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ Tcl_HashTable *hashTablePtr;
+ int result, retval, sub_retval, row, col, x, y;
+ int i, width, height, dummy, key, value, posn, offset;
+ char buf1[INDEX_BUFSIZE], buf2[INDEX_BUFSIZE];
+
+ Table *tablePtr = (Table *) clientData;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_Preserve(clientData);
+
+ result = TCL_OK;
+ /* parse the first parameter */
+ retval = Cmd_Parse(interp, main_cmds, argv[1]);
+
+ /* Switch on the parameter value */
+ switch (retval) {
+ case 0:
+ /* error, the return string is already set up */
+ result = TCL_ERROR;
+ break;
+
+ case CMD_ACTIVATE:
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " activate index\"", (char *)NULL);
+ result = TCL_ERROR;
+ } else if (TableGetIndex(tablePtr, argv[2], &row, &col) == TCL_ERROR) {
+ result = TCL_ERROR;
+ } else {
+ /* convert to valid active index in real coords */
+ row -= tablePtr->rowOffset;
+ col -= tablePtr->colOffset;
+ /* we do this regardless, to avoid cell commit problems */
+ if ((tablePtr->flags & HAS_ACTIVE) &&
+ (tablePtr->flags & TEXT_CHANGED)) {
+ tablePtr->flags &= ~TEXT_CHANGED;
+ TableSetCellValue(tablePtr, tablePtr->activeRow+tablePtr->rowOffset,
+ tablePtr->activeCol+tablePtr->colOffset,
+ tablePtr->activeBuf);
+ }
+ if (row != tablePtr->activeRow || col != tablePtr->activeCol) {
+ if (tablePtr->flags & HAS_ACTIVE) {
+ TableMakeArrayIndex(tablePtr->activeRow+tablePtr->rowOffset,
+ tablePtr->activeCol+tablePtr->colOffset, buf1);
+ } else {
+ buf1[0] = '\0';
+ }
+ tablePtr->flags |= HAS_ACTIVE;
+ tablePtr->flags &= ~ACTIVE_DISABLED;
+ tablePtr->activeRow = row;
+ tablePtr->activeCol = col;
+ if (tablePtr->activeLayout) {
+ Tk_FreeTextLayout(tablePtr->activeLayout);
+ tablePtr->activeLayout = NULL;
+ }
+ TableAdjustActive(tablePtr);
+ TableConfigCursor(tablePtr);
+ if (!(tablePtr->flags & BROWSE_CMD) && tablePtr->browseCmd != NULL) {
+ Tcl_DString script;
+ tablePtr->flags |= BROWSE_CMD;
+ row = tablePtr->activeRow+tablePtr->rowOffset;
+ col = tablePtr->activeCol+tablePtr->colOffset;
+ TableMakeArrayIndex(row, col, buf2);
+ Tcl_DStringInit(&script);
+ ExpandPercents(tablePtr, tablePtr->browseCmd, row, col, buf1, buf2,
+ tablePtr->icursor, &script, CMD_ACTIVATE);
+ result = Tcl_GlobalEval(interp, Tcl_DStringValue(&script));
+ if (result == TCL_OK || result == TCL_RETURN)
+ Tcl_ResetResult(interp);
+ Tcl_DStringFree(&script);
+ tablePtr->flags &= ~BROWSE_CMD;
+ }
+ } else if ((tablePtr->activeLayout != NULL) &&
+ !(tablePtr->flags & ACTIVE_DISABLED) && argv[2][0] == '@' &&
+ TableCellVCoords(tablePtr, row, col, &x, &y,
+ &dummy, &dummy, 0)) {
+ /* we are clicking into the same cell */
+ /* If it was activated with @x,y indexing, find the closest char */
+ char *p;
+
+ /* no error checking because GetIndex did it for us */
+ p = argv[2]+1;
+ x = strtol(p, &p, 0) - x - tablePtr->activeX;
+ y = strtol(++p, &p, 0) - y - tablePtr->activeY;
+
+ tablePtr->icursor = Tk_PointToChar(tablePtr->activeLayout, x, y);
+ TableConfigCursor(tablePtr);
+ }
+ tablePtr->flags |= HAS_ACTIVE;
+ }
+ break; /* ACTIVATE */
+
+ case CMD_BBOX: {
+ /* bounding box of cell(s) */
+ if (argc < 3 || argc > 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " bbox first ?last?\"", (char *) NULL);
+ result = TCL_ERROR;
+ } else if (TableGetIndex(tablePtr, argv[2], &row, &col) == TCL_ERROR) {
+ result = TCL_ERROR;
+ } else if (argc == 3) {
+ row -= tablePtr->rowOffset; col -= tablePtr->colOffset;
+ if (TableCellVCoords(tablePtr, row, col, &x, &y, &width, &height, 0)) {
+ sprintf(buf1, "%d %d %d %d", x, y, width, height);
+ Tcl_SetResult(interp, buf1, TCL_VOLATILE);
+ }
+ } else if (TableGetIndex(tablePtr, argv[3], &x, &y) == TCL_ERROR) {
+ result = TCL_ERROR;
+ } else {
+ int r1, c1, r2, c2, minX = 99999, minY = 99999, maxX = 0, maxY = 0;
+ row -= tablePtr->rowOffset; col -= tablePtr->colOffset;
+ x -= tablePtr->rowOffset; y -= tablePtr->colOffset;
+ r1 = MIN(row,x); r2 = MAX(row,x);
+ c1 = MIN(col,y); c2 = MAX(col,y);
+ key = 0;
+ for (row = r1; row <= r2; row++) {
+ for (col = c1; col <= c2; col++) {
+ if (TableCellVCoords(tablePtr, row, col, &x, &y,
+ &width, &height, 0)) {
+ /* Get max bounding box */
+ if (x < minX) minX = x;
+ if (y < minY) minY = y;
+ if (x+width > maxX) maxX = x+width;
+ if (y+height > maxY) maxY = y+height;
+ key++;
+ }
+ /* FIX - This could break on else for speed */
+ }
+ }
+ if (key) {
+ sprintf(buf1, "%d %d %d %d", minX, minY, maxX-minX, maxY-minY);
+ Tcl_SetResult(interp, buf1, TCL_VOLATILE);
+ }
+ }
+ }
+ break; /* BBOX */
+
+ case CMD_BORDER:
+ if (argc > 6) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " border mark|dragto x y ?r|c?\"", (char *) NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ sub_retval = Cmd_Parse(interp, bd_cmds, argv[2]);
+ if (sub_retval == 0 || Tcl_GetInt(interp, argv[3], &x) != TCL_OK ||
+ Tcl_GetInt(interp, argv[4], &y) != TCL_OK) {
+ result = TCL_ERROR;
+ break;
+ }
+ switch (sub_retval) {
+ case BD_MARK:
+ /* Use x && y to determine if we are over a border */
+ value = TableAtBorder(tablePtr, x, y, &row, &col);
+ /* Cache the row && col for use in DRAGTO */
+ tablePtr->scanMarkRow = row;
+ tablePtr->scanMarkCol = col;
+ if (!value) break;
+ TableCellCoords(tablePtr, row, col, &x, &y, &dummy, &dummy);
+ tablePtr->scanMarkX = x;
+ tablePtr->scanMarkY = y;
+ if (argc == 5 || argv[5][0] == 'r') {
+ if (row < 0)
+ buf1[0] = '\0';
+ else
+ sprintf(buf1, "%d", row+tablePtr->rowOffset);
+ Tcl_AppendElement(interp, buf1);
+ }
+ if (argc == 5 || argv[5][0] == 'c') {
+ if (col < 0)
+ buf1[0] = '\0';
+ else
+ sprintf(buf1, "%d", col+tablePtr->colOffset);
+ Tcl_AppendElement(interp, buf1);
+ }
+ break; /* BORDER MARK */
+ case BD_DRAGTO:
+ /* check to see if we want to resize any borders */
+ if (tablePtr->resize == SEL_NONE) break;
+ row = tablePtr->scanMarkRow;
+ col = tablePtr->scanMarkCol;
+ TableCellCoords(tablePtr, row, col, &width, &height, &dummy, &dummy);
+ key = 0;
+ if (row >= 0 && (tablePtr->resize & SEL_ROW)) {
+ /* row border was active, move it */
+ /* FIX should this be 1 or 2 bds off? */
+ value = y-height-tablePtr->borderWidth;
+ if (value < -1) value = -1;
+ if (value != tablePtr->scanMarkY) {
+ entryPtr = Tcl_CreateHashEntry(tablePtr->rowHeights,
+ (char *) row, &dummy);
+ /* -value means rowHeight will be interp'd as pixels, not lines */
+ Tcl_SetHashValue(entryPtr, (ClientData) MIN(0,-value));
+ tablePtr->scanMarkY = value;
+ key++;
+ }
+ }
+ if (col >= 0 && (tablePtr->resize & SEL_COL)) {
+ /* col border was active, move it */
+ value = x-width-tablePtr->borderWidth;
+ if (value < -1) value = -1;
+ if (value != tablePtr->scanMarkX) {
+ entryPtr = Tcl_CreateHashEntry(tablePtr->colWidths,
+ (char *) col, &dummy);
+ /* -value means colWidth will be interp'd as pixels, not chars */
+ Tcl_SetHashValue(entryPtr, (ClientData) MIN(0,-value));
+ tablePtr->scanMarkX = value;
+ key++;
+ }
+ }
+ /* Only if something changed do we want to update */
+ if (key) {
+ TableAdjustParams(tablePtr);
+ /* Only rerequest geometry if the basis is the #rows &| #cols */
+ if (tablePtr->maxReqCols || tablePtr->maxReqRows)
+ TableGeometryRequest(tablePtr);
+ TableInvalidateAll(tablePtr, 0);
+ }
+ break; /* BORDER DRAGTO */
+ }
+ break; /* BORDER */
+
+ case CMD_CGET:
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " cget option\"", (char *) NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ result = Tk_ConfigureValue(interp, tablePtr->tkwin, TableConfig,
+ (char *) tablePtr, argv[2], 0);
+ break; /* CGET */
+
+ case CMD_CLEAR:
+ if (argc < 3 || argc > 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " clear option ?first? ?last?\"", (char *) NULL);
+ result = TCL_ERROR;
+ break;
+ }
+
+ sub_retval = Cmd_Parse(interp, clear_cmds, argv[2]);
+ result = TableClear(tablePtr, sub_retval,
+ (argc>3)?argv[3]:NULL, (argc>4)?argv[4]:NULL);
+ break; /* CLEAR */
+
+ case CMD_CONFIGURE:
+ switch (argc) {
+ case 2:
+ result = Tk_ConfigureInfo(interp, tablePtr->tkwin, TableConfig,
+ (char *) tablePtr, (char *) NULL, 0);
+ break;
+ case 3:
+ result = Tk_ConfigureInfo(interp, tablePtr->tkwin, TableConfig,
+ (char *) tablePtr, argv[2], 0);
+ break;
+ default:
+ result = TableConfigure(interp, tablePtr, argc - 2, argv + 2,
+ TK_CONFIG_ARGV_ONLY, 0);
+ }
+ break; /* CONFIGURE */
+
+ case CMD_CURVALUE:
+ /* Get current active cell buffer */
+ if (argc > 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " curvalue ?<value>?\"", (char *)NULL);
+ result = TCL_ERROR;
+ } else if (tablePtr->flags & HAS_ACTIVE) {
+ if (argc == 3 && strcmp(argv[2], tablePtr->activeBuf)) {
+ key = TCL_OK;
+ /* validate potential new active buffer contents
+ * only accept if validation returns acceptance. */
+ if (tablePtr->validate &&
+ TableValidateChange(tablePtr,
+ tablePtr->activeRow+tablePtr->rowOffset,
+ tablePtr->activeCol+tablePtr->colOffset,
+ tablePtr->activeBuf,
+ argv[2], tablePtr->icursor) != TCL_OK) {
+ break;
+ }
+ tablePtr->activeBuf = (char *)ckrealloc(tablePtr->activeBuf,
+ strlen(argv[2])+1);
+ strcpy(tablePtr->activeBuf, argv[2]);
+ /* mark the text as changed */
+ tablePtr->flags |= TEXT_CHANGED;
+ TableSetActiveIndex(tablePtr);
+ /* check for possible adjustment of icursor */
+ TableGetIcursor(tablePtr, "insert", (int *)0);
+ TableRefresh(tablePtr, tablePtr->activeRow, tablePtr->activeCol,
+ CELL|INV_FORCE);
+ if (key == TCL_ERROR) {
+ result = TCL_ERROR;
+ break;
+ }
+ }
+ Tcl_AppendResult(interp, tablePtr->activeBuf, (char *)NULL);
+ }
+ break; /* CURVALUE */
+
+ case CMD_CURSELECTION:
+ if ((argc != 2 && argc != 4) ||
+ (argc == 4 && (argv[2][0] == '\0' ||
+ strncmp(argv[2], "set", strlen(argv[2]))))) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " curselection ?set <value>?\"", (char *)NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ /* make sure there is a data source to accept set */
+ if (argc == 4 && (tablePtr->state == STATE_DISABLED ||
+ (tablePtr->dataSource == DATA_NONE)))
+ break;
+ for (entryPtr = Tcl_FirstHashEntry(tablePtr->selCells, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ if (argc == 2) {
+ Tcl_AppendElement(interp,
+ Tcl_GetHashKey(tablePtr->selCells, entryPtr));
+ } else {
+ TableParseArrayIndex(&row, &col,
+ Tcl_GetHashKey(tablePtr->selCells, entryPtr));
+ TableSetCellValue(tablePtr, row, col, argv[3]);
+ row -= tablePtr->rowOffset;
+ col -= tablePtr->colOffset;
+ if (row == tablePtr->activeRow && col == tablePtr->activeCol) {
+ TableGetActiveBuf(tablePtr);
+ }
+ TableCellCoords(tablePtr, row, col, &x, &y, &width, &height);
+ TableInvalidate(tablePtr, x, y, width, height, 0);
+ }
+ }
+ if (argc == 2) {
+ Tcl_SetResult(interp,
+ TableCellSort(tablePtr, Tcl_GetStringResult(interp)),
+ TCL_DYNAMIC);
+ }
+ break; /* CURSELECTION */
+
+ case CMD_DELETE:
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " delete option ?switches? arg ?arg?\"",
+ (char *) NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ sub_retval = Cmd_Parse (interp, mod_cmds, argv[2]);
+ switch (sub_retval) {
+ case 0:
+ result = TCL_ERROR;
+ break;
+ case MOD_ACTIVE:
+ if (argc > 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " delete active first ?last?\"", (char *) NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ if (TableGetIcursor(tablePtr, argv[3], &posn) == TCL_ERROR) {
+ result = TCL_ERROR;
+ break;
+ }
+ if (argc == 4) {
+ value = posn+1;
+ } else if (TableGetIcursor(tablePtr, argv[4], &value) == TCL_ERROR) {
+ result = TCL_ERROR;
+ break;
+ }
+ if (value >= posn && (tablePtr->flags & HAS_ACTIVE) &&
+ !(tablePtr->flags & ACTIVE_DISABLED) &&
+ tablePtr->state == STATE_NORMAL)
+ TableDeleteChars(tablePtr, posn, value-posn);
+ break; /* DELETE ACTIVE */
+ case MOD_COLS:
+ case MOD_ROWS:
+ result = TableModifyRC(tablePtr, interp, CMD_DELETE, sub_retval,
+ argc, argv);
+ break; /* DELETE ROWS */
+ }
+ break; /* DELETE */
+
+ case CMD_GET: {
+ int r1, c1, r2, c2;
+
+ if (argc < 3 || argc > 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " get first ?last?\"", (char *)NULL);
+ result = TCL_ERROR;
+ } else if (TableGetIndex(tablePtr, argv[2], &row, &col) == TCL_ERROR) {
+ result = TCL_ERROR;
+ } else if (argc == 3) {
+ Tcl_SetResult(interp, TableGetCellValue(tablePtr, row, col), TCL_STATIC);
+ } else if (TableGetIndex(tablePtr, argv[3], &r2, &c2) == TCL_ERROR) {
+ result = TCL_ERROR;
+ } else {
+ r1 = MIN(row,r2); r2 = MAX(row,r2);
+ c1 = MIN(col,c2); c2 = MAX(col,c2);
+ for ( row = r1; row <= r2; row++ ) {
+ for ( col = c1; col <= c2; col++ ) {
+ Tcl_AppendElement(interp, TableGetCellValue(tablePtr, row, col));
+ }
+ }
+ }
+ }
+ break; /* GET */
+
+ case CMD_FLUSH: /* FIX - DEPRECATED */
+ if (argc > 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " flush ?first? ?last?\"", (char *) NULL);
+ result = TCL_ERROR;
+ } else {
+ result = TableClear(tablePtr, CLEAR_CACHE,
+ (argc>2)?argv[2]:NULL, (argc>3)?argv[3]:NULL);
+ }
+ break; /* FLUSH */
+
+ case CMD_HEIGHT:
+ case CMD_WIDTH:
+ /* changes the width/height of certain selected columns */
+ if (argc != 3 && (argc & 1)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ (retval == CMD_WIDTH) ?
+ " width ?col? ?width col width ...?\"" :
+ " height ?row? ?height row height ...?\"",
+ (char *) NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ if (retval == CMD_WIDTH) {
+ hashTablePtr = tablePtr->colWidths;
+ offset = tablePtr->colOffset;
+ } else {
+ hashTablePtr = tablePtr->rowHeights;
+ offset = tablePtr->rowOffset;
+ }
+
+ if (argc == 2) {
+ /* print out all the preset column widths or row heights */
+ entryPtr = Tcl_FirstHashEntry(hashTablePtr, &search);
+ while (entryPtr != NULL) {
+ posn = ((int) Tcl_GetHashKey(hashTablePtr, entryPtr)) + offset;
+ value = (int) Tcl_GetHashValue(entryPtr);
+ sprintf(buf1, "%d %d", posn, value);
+ Tcl_AppendElement(interp, buf1);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ } else if (argc == 3) {
+ /* get the width/height of a particular row/col */
+ if (Tcl_GetInt(interp, argv[2], &posn) != TCL_OK) {
+ result = TCL_ERROR;
+ break;
+ }
+ /* no range check is done, why bother? */
+ posn -= offset;
+ entryPtr = Tcl_FindHashEntry(hashTablePtr, (char *) posn);
+ if (entryPtr != NULL) {
+ sprintf(buf1, "%d", (int) Tcl_GetHashValue(entryPtr));
+ Tcl_SetResult(interp, buf1, TCL_VOLATILE);
+ } else {
+ sprintf(buf1, "%d", (retval == CMD_WIDTH) ?
+ tablePtr->defColWidth : tablePtr->defRowHeight);
+ Tcl_SetResult(interp, buf1, TCL_VOLATILE);
+ }
+ } else {
+ for (i=2; i<argc; i++) {
+ /* set new width|height here */
+ value = -999999;
+ if (Tcl_GetInt(interp, argv[i++], &posn) != TCL_OK ||
+ (strncmp(argv[i], "default", strlen(argv[i])) &&
+ Tcl_GetInt(interp, argv[i], &value) != TCL_OK)) {
+ result = TCL_ERROR;
+ break;
+ }
+ posn -= offset;
+ if (value == -999999) {
+ /* reset that field */
+ if ((entryPtr = Tcl_FindHashEntry(hashTablePtr, (char *) posn)))
+ Tcl_DeleteHashEntry(entryPtr);
+ } else {
+ entryPtr = Tcl_CreateHashEntry(hashTablePtr, (char *) posn, &dummy);
+ Tcl_SetHashValue(entryPtr, (ClientData) value);
+ }
+ }
+ TableAdjustParams(tablePtr);
+ /* rerequest geometry */
+ TableGeometryRequest(tablePtr);
+ /*
+ * Invalidate the whole window as TableAdjustParams
+ * will only check to see if the top left cell has moved
+ * FIX: should just move from lowest order visible cell to edge of window
+ */
+ TableInvalidateAll(tablePtr, 0);
+ }
+ break; /* HEIGHT && WIDTH */
+
+ case CMD_ICURSOR:
+ /* set the insertion cursor */
+ if (!(tablePtr->flags & HAS_ACTIVE) ||
+ (tablePtr->flags & ACTIVE_DISABLED) ||
+ tablePtr->state == STATE_DISABLED)
+ break;
+ switch (argc) {
+ case 2:
+ sprintf(buf1, "%d", tablePtr->icursor);
+ Tcl_SetResult(interp, buf1, TCL_VOLATILE);
+ break;
+ case 3:
+ if (TableGetIcursor(tablePtr, argv[2], (int *)0) != TCL_OK) {
+ result = TCL_ERROR;
+ break;
+ }
+ TableRefresh(tablePtr, tablePtr->activeRow, tablePtr->activeCol, CELL);
+ break;
+ default:
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " icursor arg\"", (char *) NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ break; /* ICURSOR */
+
+ case CMD_INDEX:
+ if (argc < 3 || argc > 4 ||
+ TableGetIndex(tablePtr, argv[2], &row, &col) == TCL_ERROR ||
+ (argc == 4 && (strcmp(argv[3], "row") && strcmp(argv[3], "col")))) {
+ if (!strlen(Tcl_GetStringResult(interp))) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " index index ?row|col?\"", (char *)NULL);
+ }
+ result = TCL_ERROR;
+ break;
+ }
+ if (argc == 3) {
+ TableMakeArrayIndex(row, col, buf1);
+ } else if (argv[3][0] == 'r') { /* INDEX row */
+ sprintf(buf1, "%d", row);
+ } else { /* INDEX col */
+ sprintf(buf1, "%d", col);
+ }
+ Tcl_SetResult(interp, buf1, TCL_VOLATILE);
+ break; /* INDEX */
+
+ case CMD_INSERT:
+ /* are edits enabled */
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " insert option ?switches? arg ?arg?\"", (char *)NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ sub_retval = Cmd_Parse(interp, mod_cmds, argv[2]);
+ switch (sub_retval) {
+ case 0:
+ result = TCL_ERROR;
+ break;
+ case MOD_ACTIVE:
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " insert active index string\"", (char *)NULL);
+ result = TCL_ERROR;
+ } else if (TableGetIcursor(tablePtr, argv[3], &posn) != TCL_OK) {
+ result = TCL_ERROR;
+ } else if ((tablePtr->flags & HAS_ACTIVE) &&
+ !(tablePtr->flags & ACTIVE_DISABLED) &&
+ tablePtr->state == STATE_NORMAL) {
+ TableInsertChars(tablePtr, posn, argv[4]);
+ }
+ break; /* INSERT ACTIVE */
+ case MOD_COLS:
+ case MOD_ROWS:
+ result = TableModifyRC(tablePtr, interp, CMD_INSERT, sub_retval,
+ argc, argv);
+ break;
+ }
+ break; /* INSERT */
+
+ case CMD_REREAD:
+ /* this rereads the selection from the array */
+ if (!(tablePtr->flags & HAS_ACTIVE) ||
+ (tablePtr->flags & ACTIVE_DISABLED) ||
+ tablePtr->state == STATE_DISABLED)
+ break;
+ TableGetActiveBuf(tablePtr);
+ TableRefresh(tablePtr, tablePtr->activeRow, tablePtr->activeCol,
+ CELL|INV_FORCE);
+ break; /* REREAD */
+
+ case CMD_SCAN:
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " scan mark|dragto x y\"", (char *) NULL);
+ result = TCL_ERROR;
+ break;
+ } else if (Tcl_GetInt(interp, argv[3], &x) == TCL_ERROR ||
+ Tcl_GetInt(interp, argv[4], &y) == TCL_ERROR) {
+ result = TCL_ERROR;
+ break;
+ }
+ if ((argv[2][0] == 'm')
+ && (strncmp(argv[2], "mark", strlen(argv[2])) == 0)) {
+ TableWhatCell(tablePtr, x, y, &row, &col);
+ tablePtr->scanMarkRow = row-tablePtr->topRow;
+ tablePtr->scanMarkCol = col-tablePtr->leftCol;
+ tablePtr->scanMarkX = x;
+ tablePtr->scanMarkY = y;
+ } else if ((argv[2][0] == 'd')
+ && (strncmp(argv[2], "dragto", strlen(argv[2])) == 0)) {
+ int oldTop = tablePtr->topRow, oldLeft = tablePtr->leftCol;
+ y += (5*(y-tablePtr->scanMarkY));
+ x += (5*(x-tablePtr->scanMarkX));
+
+ TableWhatCell(tablePtr, x, y, &row, &col);
+
+ /* maintain appropriate real index */
+ tablePtr->topRow = MAX(MIN(row-tablePtr->scanMarkRow,
+ tablePtr->rows-1), tablePtr->titleRows);
+ tablePtr->leftCol = MAX(MIN(col-tablePtr->scanMarkCol,
+ tablePtr->cols-1), tablePtr->titleCols);
+
+ /* Adjust the table if new top left */
+ if (oldTop != tablePtr->topRow || oldLeft != tablePtr->leftCol)
+ TableAdjustParams(tablePtr);
+ } else {
+ Tcl_AppendResult(interp, "bad scan option \"", argv[2],
+ "\": must be mark or dragto", (char *) NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ break; /* SCAN */
+
+ case CMD_SEE:
+ if (argc!=3 || TableGetIndex(tablePtr,argv[2],&row,&col)==TCL_ERROR) {
+ if (!strlen(Tcl_GetStringResult(interp))) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " see index\"", (char *)NULL);
+ }
+ result = TCL_ERROR;
+ break;
+ }
+ /* Adjust from user to master coords */
+ row -= tablePtr->rowOffset;
+ col -= tablePtr->colOffset;
+ if (!TableCellVCoords(tablePtr, row, col, &x, &x, &x, &x, 1)) {
+ tablePtr->topRow = row-1;
+ tablePtr->leftCol = col-1;
+ TableAdjustParams(tablePtr);
+ }
+ break; /* SEE */
+
+ case CMD_SELECTION:
+ if (argc<3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " selection option args\"", (char *)NULL);
+ result=TCL_ERROR;
+ break;
+ }
+ retval = Cmd_Parse(interp, sel_cmds, argv[2]);
+ switch(retval) {
+ case 0: /* failed to parse the argument, error */
+ return TCL_ERROR;
+ case SEL_ANCHOR:
+ if (argc != 4 || TableGetIndex(tablePtr,argv[3],&row,&col) != TCL_OK) {
+ if (!strlen(Tcl_GetStringResult(interp)))
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " selection anchor index\"", (char *)NULL);
+ result=TCL_ERROR;
+ break;
+ }
+ tablePtr->flags |= HAS_ANCHOR;
+ /* maintain appropriate real index */
+ if (tablePtr->selectTitles) {
+ tablePtr->anchorRow = MIN(MAX(0,row-tablePtr->rowOffset),
+ tablePtr->rows-1);
+ tablePtr->anchorCol = MIN(MAX(0,col-tablePtr->colOffset),
+ tablePtr->cols-1);
+ } else {
+ tablePtr->anchorRow = MIN(MAX(tablePtr->titleRows,
+ row-tablePtr->rowOffset),
+ tablePtr->rows-1);
+ tablePtr->anchorCol = MIN(MAX(tablePtr->titleCols,
+ col-tablePtr->colOffset),
+ tablePtr->cols-1);
+ }
+ break;
+ case SEL_CLEAR:
+ if ( argc != 4 && argc != 5 ) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " selection clear all|<first> ?<last>?\"",
+ (char *)NULL);
+ result=TCL_ERROR;
+ break;
+ }
+ if (strcmp(argv[3],"all") == 0) {
+ for(entryPtr = Tcl_FirstHashEntry(tablePtr->selCells, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ TableParseArrayIndex(&row, &col,
+ Tcl_GetHashKey(tablePtr->selCells,entryPtr));
+ Tcl_DeleteHashEntry(entryPtr);
+ TableCellCoords(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset, &x, &y, &width, &height);
+ TableInvalidate(tablePtr, x, y, width, height, 0);
+ }
+ } else {
+ int clo=0,chi=0,r1,c1,r2,c2;
+ if (TableGetIndex(tablePtr,argv[3],&row,&col) == TCL_ERROR ||
+ (argc==5 && TableGetIndex(tablePtr,argv[4],&r2,&c2)==TCL_ERROR)) {
+ result = TCL_ERROR;
+ break;
+ }
+ key = 0;
+ if (argc == 4) {
+ r1 = r2 = row;
+ c1 = c2 = col;
+ } else {
+ r1 = MIN(row,r2); r2 = MAX(row,r2);
+ c1 = MIN(col,c2); c2 = MAX(col,c2);
+ }
+ switch (tablePtr->selectType) {
+ case SEL_BOTH:
+ clo = c1; chi = c2;
+ c1 = tablePtr->colOffset;
+ c2 = tablePtr->cols-1+c1;
+ key = 1;
+ goto CLEAR_CELLS;
+ CLEAR_BOTH:
+ key = 0;
+ c1 = clo; c2 = chi;
+ case SEL_COL:
+ r1 = tablePtr->rowOffset;
+ r2 = tablePtr->rows-1+r1;
+ break;
+ case SEL_ROW:
+ c1 = tablePtr->colOffset;
+ c2 = tablePtr->cols-1+c1;
+ break;
+ }
+ /* row/col are in user index coords */
+ CLEAR_CELLS:
+ for ( row = r1; row <= r2; row++ ) {
+ for ( col = c1; col <= c2; col++ ) {
+ TableMakeArrayIndex(row, col, buf1);
+ if ((entryPtr=Tcl_FindHashEntry(tablePtr->selCells, buf1))!=NULL) {
+ Tcl_DeleteHashEntry(entryPtr);
+ TableCellCoords(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset,&x,&y,&width,&height);
+ TableInvalidate(tablePtr, x, y, width, height, 0);
+ }
+ }
+ }
+ if (key) goto CLEAR_BOTH;
+ }
+ break; /* SELECTION CLEAR */
+ case SEL_INCLUDES:
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " selection includes index\"", (char *)NULL);
+ result = TCL_ERROR;
+ } else if (TableGetIndex(tablePtr, argv[3], &row, &col) == TCL_ERROR) {
+ result = TCL_ERROR;
+ } else {
+ TableMakeArrayIndex(row, col, buf1);
+ if (Tcl_FindHashEntry(tablePtr->selCells, buf1)) {
+ Tcl_SetResult(interp, "1", TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp, "0", TCL_STATIC);
+ }
+ }
+ break; /* SELECTION INCLUDES */
+ case SEL_SET: {
+ int clo=0, chi=0, r1, c1, r2, c2, titleRows, titleCols;
+ if (argc < 4 || argc > 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " selection set first ?last?\"", (char *)NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ if (TableGetIndex(tablePtr,argv[3],&row,&col) == TCL_ERROR ||
+ (argc==5 && TableGetIndex(tablePtr,argv[4],&r2,&c2)==TCL_ERROR)) {
+ result = TCL_ERROR;
+ break;
+ }
+ key = 0;
+ if (tablePtr->selectTitles) {
+ titleRows = 0;
+ titleCols = 0;
+ } else {
+ titleRows = tablePtr->titleRows;
+ titleCols = tablePtr->titleCols;
+ }
+ /* maintain appropriate user index */
+ row = MIN(MAX(titleRows+tablePtr->rowOffset, row),
+ tablePtr->rows-1+tablePtr->rowOffset);
+ col = MIN(MAX(titleCols+tablePtr->colOffset, col),
+ tablePtr->cols-1+tablePtr->colOffset);
+ if (argc == 4) {
+ r1 = r2 = row;
+ c1 = c2 = col;
+ } else {
+ r2 = MIN(MAX(titleRows+tablePtr->rowOffset, r2),
+ tablePtr->rows-1+tablePtr->rowOffset);
+ c2 = MIN(MAX(titleCols+tablePtr->colOffset, c2),
+ tablePtr->cols-1+tablePtr->colOffset);
+ r1 = MIN(row,r2); r2 = MAX(row,r2);
+ c1 = MIN(col,c2); c2 = MAX(col,c2);
+ }
+ switch (tablePtr->selectType) {
+ case SEL_BOTH:
+ clo = c1; chi = c2;
+ c1 = titleCols+tablePtr->colOffset;
+ c2 = tablePtr->cols-1+tablePtr->colOffset;
+ key = 1;
+ goto SET_CELLS;
+ SET_BOTH:
+ key = 0;
+ c1 = clo; c2 = chi;
+ case SEL_COL:
+ r1 = titleRows+tablePtr->rowOffset;
+ r2 = tablePtr->rows-1+tablePtr->rowOffset;
+ break;
+ case SEL_ROW:
+ c1 = titleCols+tablePtr->colOffset;
+ c2 = tablePtr->cols-1+tablePtr->colOffset;
+ break;
+ }
+ SET_CELLS:
+ entryPtr = Tcl_FirstHashEntry(tablePtr->selCells, &search);
+ for ( row = r1; row <= r2; row++ ) {
+ for ( col = c1; col <= c2; col++ ) {
+ TableMakeArrayIndex(row, col, buf1);
+ if (Tcl_FindHashEntry(tablePtr->selCells, buf1) == NULL) {
+ Tcl_CreateHashEntry(tablePtr->selCells, buf1, &dummy);
+ TableCellCoords(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset, &x, &y, &width, &height);
+ TableInvalidate(tablePtr, x, y, width, height, 0);
+ }
+ }
+ }
+ if (key) goto SET_BOTH;
+
+ /* Adjust the table for top left, selection on screen etc */
+ TableAdjustParams(tablePtr);
+
+ /* If the table was previously empty and we want to export the
+ * selection, we should grab it now */
+ if (entryPtr==NULL && tablePtr->exportSelection) {
+ Tk_OwnSelection(tablePtr->tkwin, XA_PRIMARY, TableLostSelection,
+ (ClientData) tablePtr);
+ }
+ }
+ break; /* SELECTION SET */
+ }
+ break; /* SELECTION */
+
+ case CMD_SET:
+ /* sets any number of tags/indices to a given value */
+ if (argc < 3 || (argc > 3 && (argc & 1))) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " set index ?value? ?index value ...?\"",
+ (char *) NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ /* make sure there is a data source to accept set */
+ if (tablePtr->dataSource == DATA_NONE)
+ break;
+ if (argc == 3) {
+ if (TableGetIndex(tablePtr, argv[2], &row, &col) != TCL_OK) {
+ result = TCL_ERROR;
+ break;
+ }
+ Tcl_SetResult(interp, TableGetCellValue(tablePtr, row, col),
+ TCL_STATIC);
+ } else if (tablePtr->state == STATE_NORMAL) {
+ for (i=2; i<argc; i++) {
+ if (TableGetIndex(tablePtr, argv[i], &row, &col) != TCL_OK) {
+ result = TCL_ERROR;
+ break;
+ }
+ if (TableSetCellValue(tablePtr, row, col, argv[++i]) == TCL_ERROR) {
+ result = TCL_ERROR;
+ break;
+ }
+ row -= tablePtr->rowOffset;
+ col -= tablePtr->colOffset;
+ if (row == tablePtr->activeRow && col == tablePtr->activeCol) {
+ TableGetActiveBuf(tablePtr);
+ }
+ TableCellCoords(tablePtr, row, col, &x, &y, &width, &height);
+ TableInvalidate(tablePtr, x, y, width, height, 0);
+ }
+ }
+ break;
+
+ case CMD_TAG:
+ /* a veritable plethora of tag commands */
+ /* do we have another argument */
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " tag option ?arg arg ...?\"", (char *) NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ /* all the rest is now done in a separate function */
+ result = TableTagCmd(tablePtr, interp, argc, argv);
+ break; /* TAG */
+
+ case CMD_VALIDATE:
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " validate index\"", (char *) NULL);
+ result = TCL_ERROR;
+ } else if (TableGetIndex(tablePtr, argv[2], &row, &col) == TCL_ERROR) {
+ result = TCL_ERROR;
+ } else {
+ value = tablePtr->validate;
+ tablePtr->validate = 1;
+ key = TableValidateChange(tablePtr, row, col, (char *) NULL,
+ (char *) NULL, -1);
+ tablePtr->validate = value;
+ sprintf(buf1, "%d", (key == TCL_OK) ? 1 : 0);
+ Tcl_SetResult(interp, buf1, TCL_VOLATILE);
+ }
+ break;
+
+ case CMD_VERSION:
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " version\"", (char *) NULL);
+ result = TCL_ERROR;
+ } else {
+ Tcl_SetResult(interp, TBL_VERSION, TCL_VOLATILE);
+ }
+ break;
+
+ case CMD_WINDOW:
+ /* a veritable plethora of window commands */
+ /* do we have another argument */
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " window option ?arg arg ...?\"", (char *) NULL);
+ result = TCL_ERROR;
+ break;
+ }
+ /* all the rest is now done in a separate function */
+ result = TableWindowCmd(tablePtr, interp, argc, argv);
+ break;
+
+ case CMD_XVIEW:
+ case CMD_YVIEW:
+ if (argc == 2) {
+ int diff;
+ double first, last;
+ TableGetLastCell(tablePtr, &row, &col);
+ TableCellVCoords(tablePtr, row, col, &x, &y, &width, &height, 0);
+ if (retval == CMD_YVIEW) {
+ if (row < tablePtr->titleRows) {
+ first = 0;
+ last = 1;
+ } else {
+ diff = tablePtr->rowStarts[tablePtr->titleRows];
+ last = (double) (tablePtr->rowStarts[tablePtr->rows]-diff);
+ first = (tablePtr->rowStarts[tablePtr->topRow]-diff) / last;
+ last = (height+tablePtr->rowStarts[row]-diff) / last;
+ }
+ } else {
+ if (col < tablePtr->titleCols) {
+ first = 0;
+ last = 1;
+ } else {
+ diff = tablePtr->colStarts[tablePtr->titleCols];
+ last = (double) (tablePtr->colStarts[tablePtr->cols]-diff);
+ first = (tablePtr->colStarts[tablePtr->leftCol]-diff) / last;
+ last = (width+tablePtr->colStarts[col]-diff) / last;
+ }
+ }
+ sprintf(buf1, "%g %g", first, last);
+ Tcl_SetResult(interp, buf1, TCL_VOLATILE);
+ } else {
+ /* cache old topleft to see if it changes */
+ int oldTop = tablePtr->topRow, oldLeft = tablePtr->leftCol;
+ if (argc == 3) {
+ if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
+ result = TCL_ERROR;
+ break;
+ }
+ if (retval == CMD_YVIEW) {
+ tablePtr->topRow = value + tablePtr->titleRows;
+ } else {
+ tablePtr->leftCol = value + tablePtr->titleCols;
+ }
+ } else {
+ double frac;
+ sub_retval = Tk_GetScrollInfo(interp, argc, argv, &frac, &value);
+ switch (sub_retval) {
+ case TK_SCROLL_ERROR:
+ result = TCL_ERROR;
+ break;
+ case TK_SCROLL_MOVETO:
+ if (frac < 0) frac = 0;
+ if (retval == CMD_YVIEW) {
+ tablePtr->topRow = (int)(frac*tablePtr->rows)+tablePtr->titleRows;
+ } else {
+ tablePtr->leftCol = (int)(frac*tablePtr->cols)+tablePtr->titleCols;
+ }
+ break;
+ case TK_SCROLL_PAGES:
+ TableGetLastCell(tablePtr, &row, &col);
+ if (retval == CMD_YVIEW) {
+ tablePtr->topRow += value * (row-tablePtr->topRow+1);
+ } else {
+ tablePtr->leftCol += value * (col-tablePtr->leftCol+1);
+ }
+ break;
+ case TK_SCROLL_UNITS:
+ if (retval == CMD_YVIEW) {
+ tablePtr->topRow += value;
+ } else {
+ tablePtr->leftCol += value;
+ }
+ break;
+ }
+ }
+ /* maintain appropriate real index */
+ tablePtr->topRow = MAX(tablePtr->titleRows,
+ MIN(tablePtr->topRow, tablePtr->rows-1));
+ tablePtr->leftCol = MAX(tablePtr->titleCols,
+ MIN(tablePtr->leftCol, tablePtr->cols-1));
+ /* Do the table adjustment if topRow || leftCol changed */
+ if (oldTop != tablePtr->topRow || oldLeft != tablePtr->leftCol)
+ TableAdjustParams(tablePtr);
+ }
+ break; /* XVIEW/YVIEW */
+ }
+ Tcl_Release(clientData);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableDestroy --
+ * This procedure is invoked by Tcl_EventuallyFree
+ * to clean up the internal structure of a table at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the table is freed up (hopefully).
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableDestroy(ClientData clientdata)
+{
+ register Table *tablePtr = (Table *) clientdata;
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+
+ /* These may be repetitive from DestroyNotify, but it doesn't hurt */
+ /* cancel any pending update or timer */
+ if (tablePtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(TableDisplay, (ClientData) tablePtr);
+ tablePtr->flags &= ~REDRAW_PENDING;
+ }
+ Tcl_DeleteTimerHandler(tablePtr->cursorTimer);
+ Tcl_DeleteTimerHandler(tablePtr->flashTimer);
+
+ /* delete the variable trace */
+ if (tablePtr->arrayVar != NULL) {
+ Tcl_UntraceVar(tablePtr->interp, tablePtr->arrayVar,
+ TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_GLOBAL_ONLY,
+ (Tcl_VarTraceProc *)TableVarProc, (ClientData) tablePtr);
+ }
+
+ /* delete cached activeLayout */
+ if (tablePtr->activeLayout != NULL) {
+ Tk_FreeTextLayout(tablePtr->activeLayout);
+ tablePtr->activeLayout = NULL;
+ }
+ /* free the arrays with row/column pixel sizes */
+ if (tablePtr->colPixels) ckfree((char *) tablePtr->colPixels);
+ if (tablePtr->rowPixels) ckfree((char *) tablePtr->rowPixels);
+ if (tablePtr->colStarts) ckfree((char *) tablePtr->colStarts);
+ if (tablePtr->rowStarts) ckfree((char *) tablePtr->rowStarts);
+
+ /* free the selection buffer */
+ if (tablePtr->activeBuf != NULL) ckfree(tablePtr->activeBuf);
+
+ /* delete the cache, row, column and cell style hash tables */
+ Tcl_DeleteHashTable(tablePtr->cache);
+ ckfree((char *) (tablePtr->cache));
+ Tcl_DeleteHashTable(tablePtr->rowStyles);
+ ckfree((char *) (tablePtr->rowStyles));
+ Tcl_DeleteHashTable(tablePtr->colStyles);
+ ckfree((char *) (tablePtr->colStyles));
+ Tcl_DeleteHashTable(tablePtr->cellStyles);
+ ckfree((char *) (tablePtr->cellStyles));
+ Tcl_DeleteHashTable(tablePtr->flashCells);
+ ckfree((char *) (tablePtr->flashCells));
+ Tcl_DeleteHashTable(tablePtr->selCells);
+ ckfree((char *) (tablePtr->selCells));
+ Tcl_DeleteHashTable(tablePtr->colWidths);
+ ckfree((char *) (tablePtr->colWidths));
+ Tcl_DeleteHashTable(tablePtr->rowHeights);
+ ckfree((char *) (tablePtr->rowHeights));
+
+ /* Now free up all the tag information */
+ for (entryPtr = Tcl_FirstHashEntry(tablePtr->tagTable, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ TableCleanupTag(tablePtr, (TableTag *) Tcl_GetHashValue(entryPtr));
+ ckfree((char *) Tcl_GetHashValue(entryPtr));
+ }
+ /* free up the stuff in the default tag */
+ TableCleanupTag(tablePtr, &(tablePtr->defaultTag));
+ /* And delete the actual hash table */
+ Tcl_DeleteHashTable(tablePtr->tagTable);
+ ckfree((char *) (tablePtr->tagTable));
+
+ /* Now free up all the embedded window info */
+ for (entryPtr = Tcl_FirstHashEntry(tablePtr->winTable, &search);
+ entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
+ EmbWinDelete(tablePtr, (TableEmbWindow *) Tcl_GetHashValue(entryPtr));
+ }
+ /* And delete the actual hash table */
+ Tcl_DeleteHashTable(tablePtr->winTable);
+ ckfree((char *) (tablePtr->winTable));
+
+ /* free the configuration options in the widget */
+ Tk_FreeOptions(TableConfig, (char *) tablePtr, tablePtr->display, 0);
+
+ /* and free the widget memory at last! */
+ ckfree((char *) (tablePtr));
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TableEventProc --
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on tables.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+TableEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ Table *tablePtr = (Table *) clientData;
+ int row, col;
+
+ switch (eventPtr->type) {
+
+ case MotionNotify:
+ if (!(tablePtr->resize & SEL_NONE) && (tablePtr->bdcursor != None) &&
+ TableAtBorder(tablePtr, eventPtr->xmotion.x, eventPtr->xmotion.y,
+ &row, &col) &&
+ ((row>=0 && (tablePtr->resize & SEL_ROW)) ||
+ (col>=0 && (tablePtr->resize & SEL_COL)))) {
+ /* The bordercursor is defined and we meet the criteria for being
+ * over a border. Set the cursor to border if not already so */
+ if (!(tablePtr->flags & OVER_BORDER)) {
+ tablePtr->flags |= OVER_BORDER;
+ Tk_DefineCursor(tablePtr->tkwin, tablePtr->bdcursor);
+ }
+ } else if (tablePtr->flags & OVER_BORDER) {
+ tablePtr->flags &= ~OVER_BORDER;
+ if (tablePtr->cursor != None) {
+ Tk_DefineCursor(tablePtr->tkwin, tablePtr->cursor);
+ } else {
+ Tk_UndefineCursor(tablePtr->tkwin);
+ }
+ }
+ break;
+
+ case Expose:
+ TableInvalidate(tablePtr, eventPtr->xexpose.x, eventPtr->xexpose.y,
+ eventPtr->xexpose.width, eventPtr->xexpose.height,
+ INV_HIGHLIGHT);
+ break;
+
+ case DestroyNotify:
+ /* remove the command from the interpreter */
+ if (tablePtr->tkwin != NULL) {
+ tablePtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(tablePtr->interp, tablePtr->widgetCmd);
+ }
+
+ /* cancel any pending update or timer */
+ if (tablePtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(TableDisplay, (ClientData) tablePtr);
+ tablePtr->flags &= ~REDRAW_PENDING;
+ }
+ Tcl_DeleteTimerHandler(tablePtr->cursorTimer);
+ Tcl_DeleteTimerHandler(tablePtr->flashTimer);
+
+ Tcl_EventuallyFree((ClientData) tablePtr, (Tcl_FreeProc *) TableDestroy);
+ break;
+
+ case MapNotify: /* redraw table when remapped if it changed */
+ if (tablePtr->flags & REDRAW_ON_MAP) {
+ tablePtr->flags &= ~REDRAW_ON_MAP;
+ Tcl_Preserve((ClientData) tablePtr);
+ TableAdjustParams(tablePtr);
+ TableInvalidateAll(tablePtr, INV_FORCE|INV_HIGHLIGHT);
+ Tcl_Release((ClientData) tablePtr);
+ }
+ break;
+
+ case ConfigureNotify:
+ Tcl_Preserve((ClientData) tablePtr);
+ TableAdjustParams(tablePtr);
+ TableInvalidateAll(tablePtr, INV_FORCE|INV_HIGHLIGHT);
+ Tcl_Release((ClientData) tablePtr);
+ break;
+
+ case FocusIn:
+ case FocusOut:
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ tablePtr->flags |= REDRAW_BORDER;
+ if (eventPtr->type == FocusOut) {
+ tablePtr->flags &= ~HAS_FOCUS;
+ } else {
+ tablePtr->flags |= HAS_FOCUS;
+ }
+ TableRedrawHighlight(tablePtr);
+ /* cancel the timer */
+ TableConfigCursor(tablePtr);
+ }
+ break;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableConfigure --
+ * This procedure is called to process an argv/argc list, plus
+ * the Tk option database, in order to configure (or reconfigure)
+ * a table 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 tablePtr; old resources get freed, if there were any.
+ * Certain values might be constrained.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+TableConfigure(interp, tablePtr, argc, argv, flags, forceUpdate)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register Table *tablePtr; /* 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 forceUpdate; /* Whether to force an update - required
+ * for initial configuration */
+{
+ Tcl_HashSearch search;
+ int oldUse, oldCaching, oldExport, result = TCL_OK;
+ char *oldVar;
+ Tcl_DString error;
+ Tk_FontMetrics fm;
+
+ oldExport = tablePtr->exportSelection;
+ oldCaching = tablePtr->caching;
+ oldUse = tablePtr->useCmd;
+ oldVar = tablePtr->arrayVar;
+
+ /* Do the configuration */
+ if (Tk_ConfigureWidget(interp, tablePtr->tkwin, TableConfig, argc, argv,
+ (char *) tablePtr, flags) != TCL_OK)
+ return TCL_ERROR;
+
+ Tcl_DStringInit(&error);
+
+ /* Any time we configure, reevaluate what our data source is */
+ tablePtr->dataSource = DATA_NONE;
+ if (tablePtr->caching) {
+ tablePtr->dataSource |= DATA_CACHE;
+ }
+ if (tablePtr->command && tablePtr->useCmd) {
+ tablePtr->dataSource |= DATA_COMMAND;
+ } else if (tablePtr->arrayVar) {
+ tablePtr->dataSource |= DATA_ARRAY;
+ }
+
+ /* Check to see if the array variable was changed */
+ if (strcmp((tablePtr->arrayVar?tablePtr->arrayVar:""),(oldVar?oldVar:""))) {
+ /* only do the following if arrayVar is our data source */
+ if (tablePtr->dataSource & DATA_ARRAY) {
+ /* ensure that the cache will flush later so it gets the new values */
+ oldCaching = !(tablePtr->caching);
+ }
+ /* remove the trace on the old array variable if there was one */
+ if (oldVar != NULL)
+ Tcl_UntraceVar(interp, oldVar,
+ TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_GLOBAL_ONLY,
+ (Tcl_VarTraceProc *)TableVarProc, (ClientData)tablePtr);
+ /* Check whether variable is an array and trace it if it is */
+ if (tablePtr->arrayVar != NULL) {
+ /* does the variable exist as an array? */
+ if (Tcl_SetVar2(interp, tablePtr->arrayVar, TEST_KEY, "",
+ TCL_GLOBAL_ONLY) == NULL) {
+ Tcl_DStringAppend(&error, "invalid variable value \"", -1);
+ Tcl_DStringAppend(&error, tablePtr->arrayVar, -1);
+ Tcl_DStringAppend(&error, "\": could not be made an array", -1);
+ ckfree(tablePtr->arrayVar);
+ tablePtr->arrayVar = NULL;
+ tablePtr->dataSource &= ~DATA_ARRAY;
+ result = TCL_ERROR;
+ } else {
+ Tcl_UnsetVar2(interp, tablePtr->arrayVar, TEST_KEY, TCL_GLOBAL_ONLY);
+ /* remove the effect of the evaluation */
+ /* set a trace on the variable */
+ Tcl_TraceVar(interp, tablePtr->arrayVar,
+ TCL_TRACE_WRITES | TCL_TRACE_UNSETS | TCL_GLOBAL_ONLY,
+ (Tcl_VarTraceProc *)TableVarProc, (ClientData) tablePtr);
+
+ /* only do the following if arrayVar is our data source */
+ if (tablePtr->dataSource & DATA_ARRAY) {
+ /* get the current value of the selection */
+ TableGetActiveBuf(tablePtr);
+ }
+ }
+ }
+ }
+ if ((tablePtr->command && tablePtr->useCmd && !oldUse) ||
+ (tablePtr->arrayVar && !(tablePtr->useCmd) && oldUse)) {
+ /* our effective data source changed, so flush and
+ * retrieve new active buffer */
+ TableFlushCache(tablePtr);
+ TableGetActiveBuf(tablePtr);
+ forceUpdate = 1;
+ } else if (oldCaching != tablePtr->caching) {
+ /* caching changed, so just clear the cache for safety */
+ TableFlushCache(tablePtr);
+ forceUpdate = 1;
+ }
+
+ /* set up the default column width and row height */
+ Tk_GetFontMetrics(tablePtr->defaultTag.tkfont, &fm);
+ tablePtr->charWidth = Tk_TextWidth(tablePtr->defaultTag.tkfont, "0", 1);
+ tablePtr->charHeight = fm.linespace + 2;
+
+ if (tablePtr->insertWidth <= 0) {
+ tablePtr->insertWidth = 2;
+ }
+ if (tablePtr->insertBorderWidth > tablePtr->insertWidth/2) {
+ tablePtr->insertBorderWidth = tablePtr->insertWidth/2;
+ }
+ tablePtr->highlightWidth = MAX(0,tablePtr->highlightWidth);
+ /* the border must be >= 0 */
+ tablePtr->borderWidth = MAX(0,tablePtr->borderWidth);
+ /* when drawing fast or single, the border must be <= 1 */
+ if (tablePtr->drawMode & (DRAW_MODE_SINGLE|DRAW_MODE_FAST)) {
+ tablePtr->borderWidth = MIN(1,tablePtr->borderWidth);
+ }
+
+ /* Ensure that certain values are within proper constraints */
+ tablePtr->rows = MAX(1,tablePtr->rows);
+ tablePtr->cols = MAX(1,tablePtr->cols);
+ tablePtr->titleRows = MIN(MAX(0,tablePtr->titleRows),tablePtr->rows);
+ tablePtr->titleCols = MIN(MAX(0,tablePtr->titleCols),tablePtr->cols);
+ tablePtr->padX = MAX(0,tablePtr->padX);
+ tablePtr->padY = MAX(0,tablePtr->padY);
+ tablePtr->maxReqCols = MAX(0,tablePtr->maxReqCols);
+ tablePtr->maxReqRows = MAX(0,tablePtr->maxReqRows);
+
+ /*
+ * Claim the selection if we've suddenly started exporting it and
+ * there is a selection to export.
+ */
+ if (tablePtr->exportSelection && !oldExport &&
+ (Tcl_FirstHashEntry(tablePtr->selCells, &search) != NULL)) {
+ Tk_OwnSelection(tablePtr->tkwin, XA_PRIMARY, TableLostSelection,
+ (ClientData) tablePtr);
+ }
+
+ /* only do the full reconfigure if absolutely necessary */
+ if (!forceUpdate) {
+ int i;
+ for (i = 0; i < argc-1; i += 2) {
+ if (Cmd_GetValue(update_config, argv[i])) {
+ forceUpdate = 1;
+ break;
+ }
+ }
+ }
+ if (forceUpdate) {
+ /*
+ * Calculate the row and column starts
+ * Adjust the top left corner of the internal display
+ */
+ TableAdjustParams(tablePtr);
+ /* reset the cursor */
+ TableConfigCursor(tablePtr);
+ /* set up the background colour in the window */
+ Tk_SetBackgroundFromBorder(tablePtr->tkwin, tablePtr->defaultTag.bg);
+ /* set the geometry and border */
+ TableGeometryRequest(tablePtr);
+ Tk_SetInternalBorder(tablePtr->tkwin, tablePtr->highlightWidth);
+ /* invalidate the whole table */
+ TableInvalidateAll(tablePtr, INV_HIGHLIGHT);
+ }
+ /* FIX this is goofy because the result could be munged by other
+ * functions. Needs to be improved */
+ Tcl_ResetResult(interp);
+ if (result == TCL_ERROR) {
+ Tcl_AddErrorInfo(interp, "\t(configuring table widget)");
+ Tcl_DStringResult(interp, &error);
+ }
+ Tcl_DStringFree(&error);
+ return result;
+}
+
+#ifndef CLASSPATCH
+/*
+ * As long as we wait for the Function in general
+ *
+ * This parses the "-class" option for the table.
+ */
+static void
+Tk_ClassOption(Tk_Window tkwin, char *defaultclass, int *argcp, char ***argvp)
+{
+ char *classname = (((*argcp)<3) || (strcmp((*argvp)[2],"-class"))) ?
+ defaultclass : ((*argcp)-=2,(*argcp)+=2,(*argvp)[1]);
+ Tk_SetClass(tkwin,classname);
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableCmdDeletedProc --
+ *
+ * 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
+TableCmdDeletedProc(ClientData clientData)
+{
+ Table *tablePtr = (Table *) clientData;
+ Tk_Window 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.
+ */
+
+ /* This is needed to avoid bug where the DLL is unloaded before
+ * the table is properly destroyed */
+ Tcl_DeleteExitHandler((Tcl_ExitProc *) TableCmdDeletedProc,
+ (ClientData) tablePtr);
+ if (tablePtr->tkwin != NULL) {
+ tkwin = tablePtr->tkwin;
+ tablePtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TableCmd --
+ * This procedure is invoked to process the "table" 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
+TableCmd(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 Table *tablePtr;
+ 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;
+ }
+
+ new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], (char *) NULL);
+ if (new == NULL) {
+ return TCL_ERROR;
+ }
+
+ tablePtr = (Table *) ckalloc(sizeof(Table));
+ tablePtr->tkwin = new;
+ tablePtr->display = Tk_Display(new);
+ tablePtr->interp = interp;
+
+ tablePtr->topRow = 0;
+ tablePtr->leftCol = 0;
+ tablePtr->anchorRow = -1;
+ tablePtr->anchorCol = -1;
+ tablePtr->activeRow = -1;
+ tablePtr->activeCol = -1;
+ tablePtr->oldTopRow = -1;
+ tablePtr->oldLeftCol = -1;
+ tablePtr->oldActRow = -1;
+ tablePtr->oldActCol = -1;
+ tablePtr->seen[0] = -1;
+ tablePtr->icursor = 0;
+ tablePtr->flags = 0;
+
+ tablePtr->colPixels = (int *) 0;
+ tablePtr->rowPixels = (int *) 0;
+ tablePtr->colStarts = (int *) 0;
+ tablePtr->rowStarts = (int *) 0;
+ tablePtr->cursorTimer = (Tcl_TimerToken)0;
+ tablePtr->flashTimer = (Tcl_TimerToken)0;
+ tablePtr->dataSource = DATA_NONE;
+ tablePtr->activeBuf = ckalloc(1);
+ *(tablePtr->activeBuf) = '\0';
+ tablePtr->activeLayout = NULL;
+
+ /* misc tables */
+ tablePtr->tagTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->tagTable, TCL_STRING_KEYS);
+ tablePtr->winTable = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->winTable, TCL_STRING_KEYS);
+
+ /* internal value cache */
+ tablePtr->cache = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->cache, TCL_STRING_KEYS);
+
+ /* style hash tables */
+ tablePtr->colWidths = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->colWidths, TCL_ONE_WORD_KEYS);
+ tablePtr->rowHeights = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->rowHeights, TCL_ONE_WORD_KEYS);
+
+ /* style hash tables */
+ tablePtr->rowStyles = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->rowStyles, TCL_ONE_WORD_KEYS);
+ tablePtr->colStyles = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->colStyles, TCL_ONE_WORD_KEYS);
+ tablePtr->cellStyles = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->cellStyles, TCL_STRING_KEYS);
+
+ /* special style hash tables */
+ tablePtr->flashCells = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->flashCells, TCL_STRING_KEYS);
+ tablePtr->selCells = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(tablePtr->selCells, TCL_STRING_KEYS);
+
+ tablePtr->rows = 0;
+ tablePtr->cols = 0;
+ tablePtr->selectMode = NULL;
+ tablePtr->selectTitles = 0;
+ tablePtr->defRowHeight = 0;
+ tablePtr->defColWidth = 0;
+ tablePtr->arrayVar = NULL;
+ tablePtr->borderWidth = 0;
+ tablePtr->defaultTag.anchor = TK_ANCHOR_CENTER;
+ tablePtr->defaultTag.bg = NULL;
+ tablePtr->defaultTag.fg = NULL;
+ tablePtr->defaultTag.tkfont = NULL;
+ tablePtr->defaultTag.image = NULL;
+ tablePtr->defaultTag.imageStr = NULL;
+ tablePtr->defaultTag.justify = TK_JUSTIFY_LEFT;
+ tablePtr->defaultTag.multiline = 1;
+ tablePtr->defaultTag.relief = TK_RELIEF_FLAT;
+ tablePtr->defaultTag.showtext = 0;
+ tablePtr->defaultTag.state = STATE_UNKNOWN;
+ tablePtr->defaultTag.wrap = 0;
+ tablePtr->yScrollCmd = NULL;
+ tablePtr->xScrollCmd = NULL;
+ tablePtr->insertBg = NULL;
+ tablePtr->cursor = None;
+ tablePtr->bdcursor = None;
+ tablePtr->titleRows = 0;
+ tablePtr->titleCols = 0;
+ tablePtr->drawMode = DRAW_MODE_TK_COMPAT;
+ tablePtr->colStretch = STRETCH_MODE_NONE;
+ tablePtr->rowStretch = STRETCH_MODE_NONE;
+ tablePtr->maxWidth = 0;
+ tablePtr->maxHeight = 0;
+ tablePtr->charWidth = 0;
+ tablePtr->charHeight = 0;
+ tablePtr->colOffset = 0;
+ tablePtr->rowOffset = 0;
+ tablePtr->flashTime = 2;
+ tablePtr->rowTagCmd = NULL;
+ tablePtr->colTagCmd = NULL;
+ tablePtr->highlightWidth = 0;
+ tablePtr->highlightBgColorPtr = NULL;
+ tablePtr->highlightColorPtr = NULL;
+ tablePtr->takeFocus = NULL;
+ tablePtr->state = STATE_NORMAL;
+ tablePtr->insertWidth = 0;
+ tablePtr->insertBorderWidth = 0;
+ tablePtr->insertOnTime = 0;
+ tablePtr->insertOffTime = 0;
+ tablePtr->invertSelected = 0;
+ tablePtr->autoClear = 0;
+ tablePtr->flashMode = 0;
+ tablePtr->exportSelection = 1;
+ tablePtr->rowSep = NULL;
+ tablePtr->colSep = NULL;
+ tablePtr->browseCmd = NULL;
+ tablePtr->command = NULL;
+ tablePtr->selCmd = NULL;
+ tablePtr->valCmd = NULL;
+ tablePtr->validate = 0;
+ tablePtr->useCmd = 1;
+ tablePtr->caching = 0;
+ tablePtr->padX = 0;
+ tablePtr->padY = 0;
+ tablePtr->maxReqCols = 0;
+ tablePtr->maxReqRows = 0;
+ tablePtr->maxReqWidth = 800;
+ tablePtr->maxReqHeight = 600;
+
+ /* selection handlers needed here */
+
+ Tk_ClassOption(new, "Table", &argc, &argv);
+ Tk_CreateEventHandler(tablePtr->tkwin,
+ PointerMotionMask|ExposureMask|StructureNotifyMask|FocusChangeMask|VisibilityChangeMask,
+ TableEventProc, (ClientData) tablePtr);
+ Tk_CreateSelHandler(tablePtr->tkwin, XA_PRIMARY, XA_STRING,
+ TableFetchSelection, (ClientData) tablePtr, XA_STRING);
+
+ tablePtr->widgetCmd = Tcl_CreateCommand(interp, Tk_PathName(tablePtr->tkwin),
+ TableWidgetCmd, (ClientData) tablePtr,
+ (Tcl_CmdDeleteProc *) TableCmdDeletedProc);
+ if (TableConfigure(interp, tablePtr, argc - 2, argv + 2, 0, 1) != TCL_OK) {
+ Tk_DestroyWindow(new);
+ return TCL_ERROR;
+ }
+ TableInitTags(tablePtr);
+ /* This is needed to avoid bug where the DLL is unloaded before
+ * the table is properly destroyed */
+ Tcl_CreateExitHandler((Tcl_ExitProc *) TableCmdDeletedProc,
+ (ClientData) tablePtr);
+ Tcl_SetResult(interp, Tk_PathName(tablePtr->tkwin), TCL_STATIC);
+ return TCL_OK;
+}
+
+/* Function to call on loading the Table module */
+
+EXPORT(int,Tktable_Init)(interp)
+ Tcl_Interp *interp;
+{
+ static char init_script[] =
+ "if {[catch {source \"" TCL_RUNTIME "\"}]} {\n"
+#include "tkTabletcl.h"
+ "}\n";
+ if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 0) == NULL ||
+ Tcl_PkgRequire(interp, "Tk", TK_VERSION, 0) == NULL ||
+ Tcl_PkgProvide(interp, "Tktable", TBL_VERSION) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_CreateCommand(interp, TBL_COMMAND, TableCmd,
+ (ClientData) Tk_MainWindow(interp),
+ (Tcl_CmdDeleteProc *) NULL);
+
+ return Tcl_Eval(interp, init_script);
+}
+
+EXPORT(int,Tktable_SafeInit)(interp)
+ Tcl_Interp *interp;
+{
+ return Tktable_Init(interp);
+}
+
+#ifdef _WIN32
+/*
+ *----------------------------------------------------------------------
+ *
+ * DllEntryPoint --
+ *
+ * This wrapper function is used by Windows to invoke the
+ * initialization code for the DLL. If we are compiling
+ * with Visual C++, this routine will be renamed to DllMain.
+ * routine.
+ *
+ * Results:
+ * Returns TRUE;
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+BOOL APIENTRY
+DllEntryPoint(hInst, reason, reserved)
+ HINSTANCE hInst; /* Library instance handle. */
+ DWORD reason; /* Reason this function is being called. */
+ LPVOID reserved; /* Not used. */
+{
+ return TRUE;
+}
+#endif
diff --git a/libgui/src/tkTable.h b/libgui/src/tkTable.h
new file mode 100644
index 00000000000..360b1de0c1c
--- /dev/null
+++ b/libgui/src/tkTable.h
@@ -0,0 +1,418 @@
+/*
+ * tkTable.h --
+ *
+ * This is the header file for the module that implements
+ * table widgets for the Tk toolkit.
+ *
+ * Copyright (c) 1997,1998 Jeffrey Hobbs
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#ifndef _TKTABLE_H_
+#define _TKTABLE_H_
+
+#include <string.h>
+#include <stdlib.h>
+#include <tk.h>
+#include <X11/Xatom.h>
+
+#include "tkTableCmd.h"
+
+#ifdef _WIN32
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+# undef WIN32_LEAN_AND_MEAN
+
+/*
+ * VC++ has an alternate entry point called DllMain, so we need to rename
+ * our entry point.
+ */
+
+# if defined(_MSC_VER)
+# define EXPORT(a,b) __declspec(dllexport) a b
+# define DllEntryPoint DllMain
+# else
+# if defined(__BORLANDC__)
+# define EXPORT(a,b) a _export b
+# else
+# define EXPORT(a,b) a b
+# endif
+# endif
+
+/* Necessary to get XSync call defined */
+# include <tkInt.h>
+
+#else /* ! WIN32 */
+# define EXPORT(a,b) a b
+#endif /* WIN32 */
+
+#ifdef INLINE
+#undef INLINE
+#endif
+#ifdef __GNUC__
+# define INLINE inline
+#else
+# if defined(_MSC_VER)
+# define INLINE __inline
+# else
+# define INLINE
+# endif
+#endif
+
+#ifndef NORMAL_BG
+# ifdef _WIN32
+# define NORMAL_BG "SystemButtonFace"
+# define ACTIVE_BG NORMAL_BG
+# define SELECT_BG "SystemHighlight"
+# define DISABLED "SystemDisabledText"
+# define HIGHLIGHT "SystemWindowFrame"
+# define DEF_TABLE_FONT "{MS Sans Serif} 8"
+# else
+# define NORMAL_BG "#d9d9d9"
+# define ACTIVE_BG "#fcfcfc"
+# define SELECT_BG "#c3c3c3"
+# define DISABLED "#a3a3a3"
+# define HIGHLIGHT "Black"
+# define DEF_TABLE_FONT "Helvetica -12"
+# endif
+#endif
+
+#define MAX(A,B) (((A)>(B))?(A):(B))
+#define MIN(A,B) (((A)>(B))?(B):(A))
+#define ARSIZE(A) (sizeof(A)/sizeof(*A))
+#define INDEX_BUFSIZE 64 /* max size of buffer for indices */
+#define TEST_KEY "#TEST KEY#" /* index for testing array existence */
+
+/*
+ * Assigned bits of "flags" fields of Table structures, and what those
+ * bits mean:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler has
+ * already been queued to redisplay the table.
+ * REDRAW_BORDER: Non-zero means 3-D border must be redrawn
+ * around window during redisplay. Normally
+ * only text portion needs to be redrawn.
+ * CURSOR_ON: Non-zero means insert cursor is displayed at
+ * present. 0 means it isn't displayed.
+ * TEXT_CHANGED: Non-zero means the active cell text is being edited.
+ * HAS_FOCUS: Non-zero means this window has the input focus.
+ * HAS_ACTIVE: Non-zero means the active cell is set.
+ * HAS_ANCHOR: Non-zero means the anchor cell is set.
+ * BROWSE_CMD: Non-zero means we're evaluating the -browsecommand.
+ * VALIDATING: Non-zero means we are in a valCmd
+ * SET_ACTIVE: About to set the active array element internally
+ * ACTIVE_DISABLED: Non-zero means the active cell is -state disabled
+ * OVER_BORDER: Non-zero means we are over a table cell border
+ * REDRAW_ON_MAP: Forces a redraw on the unmap
+ *
+ * FIX - consider adding UPDATE_SCROLLBAR a la entry
+ */
+#define REDRAW_PENDING (1L<<0)
+#define CURSOR_ON (1L<<1)
+#define HAS_FOCUS (1L<<2)
+#define TEXT_CHANGED (1L<<3)
+#define HAS_ACTIVE (1L<<4)
+#define HAS_ANCHOR (1L<<5)
+#define BROWSE_CMD (1L<<6)
+#define REDRAW_BORDER (1L<<7)
+#define VALIDATING (1L<<8)
+#define SET_ACTIVE (1L<<9)
+#define ACTIVE_DISABLED (1L<<10)
+#define OVER_BORDER (1L<<11)
+#define REDRAW_ON_MAP (1L<<12)
+
+/* Flags for TableInvalidate && TableRedraw */
+#define ROW (1L<<0)
+#define COL (1L<<1)
+#define CELL (ROW|COL)
+#define INV_FILL (1L<<3) /* use for Redraw when the affected
+ * row/col will affect neighbors */
+#define INV_FORCE (1L<<4)
+#define INV_HIGHLIGHT (1L<<5)
+
+/*
+ * Definitions for tablePtr->dataSource, by bit
+ */
+#define DATA_NONE 0
+#define DATA_CACHE (1<<1)
+#define DATA_ARRAY (1<<2)
+#define DATA_COMMAND (1<<3)
+
+typedef enum {
+ STATE_UNUSED, STATE_UNKNOWN, STATE_HIDDEN,
+ STATE_NORMAL, STATE_DISABLED, STATE_ACTIVE,
+ STATE_LAST
+} TableState;
+
+/* The tag structure */
+typedef struct {
+ Tk_3DBorder bg; /* background color */
+ Tk_3DBorder fg; /* foreground color */
+ int relief; /* relief type */
+ Tk_Font tkfont; /* Information about text font, or NULL. */
+ Tk_Anchor anchor; /* default anchor point */
+ char * imageStr; /* name of image */
+ Tk_Image image; /* actual pointer to image, if any */
+ TableState state; /* state of the cell */
+ Tk_Justify justify; /* justification of text in the cell */
+ int multiline; /* wrapping style of multiline text */
+ int wrap; /* wrapping style of multiline text */
+ int showtext; /* whether to display text over image */
+} TableTag;
+
+/* The widget structure for the table Widget */
+
+typedef struct {
+ /* basic information about the window and the interpreter */
+ Tk_Window tkwin;
+ Display *display;
+ Tcl_Interp *interp;
+ Tcl_Command widgetCmd; /* Token for entry's widget command. */
+ /* Configurable Options */
+ int autoClear;
+ char *selectMode; /* single, browse, multiple, or extended */
+ int selectType; /* row, col, both, or cell */
+ int selectTitles; /* whether to do automatic title selection */
+ int rows, cols; /* number of rows and columns */
+ int defRowHeight; /* default row height in chars (positive)
+ * or pixels (negative) */
+ int defColWidth; /* default column width in chars (positive)
+ * or pixels (negative) */
+ int maxReqCols; /* the requested # cols to display */
+ int maxReqRows; /* the requested # rows to display */
+ int maxReqWidth; /* the maximum requested width in pixels */
+ int maxReqHeight; /* the maximum requested height in pixels */
+ char *arrayVar; /* name of traced array variable */
+ char *rowSep; /* separator string to place between
+ * rows when getting selection */
+ char *colSep; /* separator string to place between
+ * cols when getting selection */
+ int borderWidth; /* internal borderwidth */
+ TableTag defaultTag; /* the default tag colors/fonts etc */
+ char *yScrollCmd; /* the y-scroll command */
+ char *xScrollCmd; /* the x-scroll command */
+ char *browseCmd; /* the command that is called when the
+ * active cell changes */
+ int caching; /* whether to cache values of table */
+ char *command; /* A command to eval when get/set occurs
+ * for table values */
+ int useCmd; /* Signals whether to use command or the
+ * array variable, will be 0 if command errs */
+ char *selCmd; /* the command that is called to when a
+ * [selection get] call occurs for a table */
+ char *valCmd; /* Command prefix to use when invoking
+ * validate command. NULL means don't
+ * invoke commands. Malloc'ed. */
+ int validate; /* Non-zero means try to validate */
+ Tk_3DBorder insertBg; /* the cursor color */
+ Tk_Cursor cursor; /* the regular mouse pointer */
+ Tk_Cursor bdcursor; /* the mouse pointer when over borders */
+ int exportSelection; /* Non-zero means tie internal table
+ * to X selection. */
+ TableState state; /* Normal or disabled. Table is read-only
+ * when disabled. */
+ int insertWidth; /* Total width of insert cursor. */
+ int insertBorderWidth; /* Width of 3-D border around insert cursor. */
+ int insertOnTime; /* Number of milliseconds cursor should spend
+ * in "on" state for each blink. */
+ int insertOffTime; /* Number of milliseconds cursor should spend
+ * in "off" state for each blink. */
+ int invertSelected; /* Whether to draw selected cells swapping
+ foreground and background */
+ int colStretch; /* The way to stretch columns if the window
+ is too large */
+ int rowStretch; /* The way to stretch rows if the window is
+ too large */
+ int colOffset; /* X index of leftmost col in the display */
+ int rowOffset; /* Y index of topmost row in the display */
+ int drawMode; /* The mode to use when redrawing */
+ int flashMode; /* Specifies whether flashing is enabled */
+ int flashTime; /* The number of ms to flash a cell for */
+ int resize; /* -resizeborders option for interactive
+ * resizing of borders */
+ char *rowTagCmd, *colTagCmd; /* script to eval for getting row/tag cmd */
+ 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. */
+ char *takeFocus; /* Used only in Tcl to check if this
+ * widget will accept focus */
+ int padX, padY; /* Extra space around text (pixels to leave
+ * on each side). Ignored for bitmaps and
+ * images. */
+
+ /* Cached Information */
+ int titleRows, titleCols; /* the number of rows|cols to use as a title */
+ /* these are kept in real coords */
+ int topRow, leftCol; /* The topleft cell to display excluding the
+ * fixed title rows. This is just the
+ * config request. The actual cell used may
+ * be different to keep the screen full */
+ int anchorRow, anchorCol; /* the row,col of the anchor cell */
+ int activeRow, activeCol; /* the row,col of the active cell */
+ int oldTopRow, oldLeftCol; /* cached by TableAdjustParams */
+ int oldActRow, oldActCol; /* cached by TableAdjustParams */
+ int icursor; /* The index of the insertion cursor in the
+ active cell */
+ int flags; /* An or'ed combination of flags concerning
+ redraw/cursor etc. */
+ int dataSource; /* where our data comes from:
+ * DATA_{NONE,CACHE,ARRAY,COMMAND} */
+ int maxWidth, maxHeight; /* max width|height required in pixels */
+ int charWidth, charHeight; /* size of a character in the default font */
+ int *colPixels; /* Array of the pixel width of each column */
+ int *rowPixels; /* Array of the pixel height of each row */
+ int *colStarts, *rowStarts; /* Array of start pixels for rows|columns */
+ int scanMarkX, scanMarkY; /* Used by "scan" and "border" to mark */
+ int scanMarkRow, scanMarkCol; /* necessary information for dragto */
+ /* values in these are kept in user coords */
+ Tcl_HashTable *cache; /* value cache */
+ /* colWidths and rowHeights are indexed from 0, so always adjust numbers
+ by the appropriate *Offset factor */
+ Tcl_HashTable *colWidths; /* hash table of non default column widths */
+ Tcl_HashTable *rowHeights; /* hash table of non default row heights */
+ Tcl_HashTable *tagTable; /* table for style tags */
+ Tcl_HashTable *winTable; /* table for embedded windows */
+ Tcl_HashTable *rowStyles; /* table for row styles */
+ Tcl_HashTable *colStyles; /* table for col styles */
+ Tcl_HashTable *cellStyles; /* table for cell styles */
+ Tcl_HashTable *flashCells; /* table of flashing cells */
+ Tcl_HashTable *selCells; /* table of selected cells */
+ Tcl_TimerToken cursorTimer; /* timer token for the cursor blinking */
+ Tcl_TimerToken flashTimer; /* timer token for the cell flashing */
+ char *activeBuf; /* buffer where the selection is kept
+ for editing the active cell */
+ Tk_TextLayout activeLayout; /* cache of active layout */
+ int activeX, activeY; /* cache offset of active layout in cell */
+ /* The invalid rectangle if there is an update pending */
+ int invalidX, invalidY, invalidWidth, invalidHeight;
+ int seen[4]; /* see TableUndisplay */
+} Table;
+
+/*
+ * HEADERS FOR EMBEDDED WINDOWS
+ */
+
+/*
+ * A structure of the following type holds information for each window
+ * embedded in a table widget.
+ */
+
+typedef struct TableEmbWindow {
+ Table *tablePtr; /* Information about the overall table
+ * widget. */
+ Tk_Window tkwin; /* Window for this segment. NULL
+ * means that the window hasn't
+ * been created yet. */
+ Tcl_HashEntry *hPtr; /* entry into winTable */
+ Tk_3DBorder bg; /* background color */
+ char *create; /* Script to create window on-demand.
+ * NULL means no such script.
+ * Malloc-ed. */
+ int relief; /* relief type */
+ int sticky; /* How to align window in space */
+ int padX, padY; /* Padding to leave around each side
+ * of window, in pixels. */
+ int displayed; /* Non-zero means that the window
+ * has been displayed on the screen
+ * recently. */
+} TableEmbWindow;
+
+extern void EmbWinDisplay _ANSI_ARGS_((Table *tablePtr, Drawable window,
+ TableEmbWindow *ewPtr,
+ TableTag *tagPtr, int x, int y,
+ int width, int height));
+extern void EmbWinUnmap _ANSI_ARGS_((register Table *tablePtr,
+ int rlo, int rhi,
+ int clo, int chi));
+extern void EmbWinDelete _ANSI_ARGS_((register Table *tablePtr,
+ TableEmbWindow *ewPtr));
+extern int TableWindowCmd _ANSI_ARGS_((Table *tablePtr,
+ Tcl_Interp *interp,
+ int argc, char *argv[]));
+
+/*
+ * HEADERS IN TKTABLETAG
+ */
+
+extern TableTag *TableNewTag _ANSI_ARGS_((void));
+extern void TableMergeTag _ANSI_ARGS_((TableTag *baseTag,
+ TableTag *addTag));
+extern void TableInvertTag _ANSI_ARGS_((TableTag *baseTag));
+extern void TableInitTags _ANSI_ARGS_((Table *tablePtr));
+extern TableTag *FindRowColTag _ANSI_ARGS_((Table *tablePtr,
+ int cell, int type));
+extern void TableCleanupTag _ANSI_ARGS_((Table *tablePtr,
+ TableTag *tagPtr));
+extern int TableTagCmd _ANSI_ARGS_((Table *tablePtr, Tcl_Interp *interp,
+ int argc, char *argv[]));
+
+/*
+ * HEADERS IN TKTABLECELL
+ */
+
+extern void TableCellCoords _ANSI_ARGS_((Table *tablePtr, int row,
+ int col, int *rx, int *ry,
+ int *rw, int *rh));
+extern int TableCellVCoords _ANSI_ARGS_((Table *tablePtr, int row,
+ int col, int *rx, int *ry,
+ int *rw, int *rh, int full));
+extern void TableWhatCell _ANSI_ARGS_((register Table *tablePtr,
+ int x, int y, int *row, int *col));
+extern int TableAtBorder _ANSI_ARGS_((Table *tablePtr, int x, int y,
+ int *row, int *col));
+extern char * TableGetCellValue _ANSI_ARGS_((Table *tablePtr, int r, int c));
+extern int TableSetCellValue _ANSI_ARGS_((Table *tablePtr, int r, int c,
+ char *value));
+extern char * TableCellSort _ANSI_ARGS_((Table *tablePtr, char *str));
+extern int TableGetIcursor _ANSI_ARGS_((Table *tablePtr, char *arg,
+ int *posn));
+extern int TableGetIndex _ANSI_ARGS_((register Table *tablePtr, char *str,
+ int *row_p, int *col_p));
+
+/*
+ * HEADERS IN TKTABLE
+ */
+
+EXTERN EXPORT(int,Example_Init) _ANSI_ARGS_((Tcl_Interp *interp));
+
+extern void ExpandPercents _ANSI_ARGS_((Table *tablePtr, char *before,
+ int r, int c, char *old, char *new, int index,
+ Tcl_DString *dsPtr, int cmdType));
+extern void TableInvalidate _ANSI_ARGS_((Table *tablePtr, int x, int y,
+ int width, int height,
+ int force));
+extern void TableRefresh _ANSI_ARGS_((register Table *tablePtr,
+ int arg1, int arg2, int mode));
+
+#define TableInvalidateAll(tablePtr, flags) \
+ TableInvalidate((tablePtr), 0, 0, Tk_Width((tablePtr)->tkwin),\
+ Tk_Height((tablePtr)->tkwin), (flags))
+
+ /*
+ * Turn row/col into an index into the table
+ */
+#define TableMakeArrayIndex(r, c, i) sprintf((i), "%d,%d", (r), (c))
+
+ /*
+ * Turn array index back into row/col
+ * return the number of args parsed (should be two)
+ */
+#define TableParseArrayIndex(r, c, i) sscanf((i), "%d,%d", (r), (c))
+
+ /*
+ * Macro for finding the last cell of the table
+ */
+#define TableGetLastCell(tablePtr, rowPtr, colPtr) \
+ TableWhatCell((tablePtr),\
+ Tk_Width((tablePtr)->tkwin)-(tablePtr)->highlightWidth,\
+ Tk_Height((tablePtr)->tkwin)-(tablePtr)->highlightWidth,\
+ (rowPtr), (colPtr))
+
+#endif /* _TKTABLE_H_ */
+
diff --git a/libgui/src/tkTable.tcl b/libgui/src/tkTable.tcl
new file mode 100644
index 00000000000..f10f0351959
--- /dev/null
+++ b/libgui/src/tkTable.tcl
@@ -0,0 +1,560 @@
+# table.tcl --
+#
+# version 1.8, jeff.hobbs@acm.org
+# This file defines the default bindings for Tk table widgets
+# and provides procedures that help in implementing those bindings.
+#
+
+#--------------------------------------------------------------------------
+# tkPriv elements used in this file:
+#
+# afterId - Token returned by "after" for autoscanning.
+# tablePrev - The last element to be selected or deselected
+# during a selection operation.
+#--------------------------------------------------------------------------
+
+# tkTableClipboardKeysyms --
+# This procedure is invoked to identify the keys that correspond to
+# the "copy", "cut", and "paste" functions for the clipboard.
+#
+# Arguments:
+# copy - Name of the key (keysym name plus modifiers, if any,
+# such as "Meta-y") used for the copy operation.
+# cut - Name of the key used for the cut operation.
+# paste - Name of the key used for the paste operation.
+
+proc tkTableClipboardKeysyms {copy cut paste} {
+ bind Table <$copy> {tk_tableCopy %W}
+ bind Table <$cut> {tk_tableCut %W}
+ bind Table <$paste> {tk_tablePaste %W}
+}
+
+## Interactive row resizing, affected by -resizeborders option
+##
+bind Table <3> {
+ ## You might want to check for row returned if you want to
+ ## restrict the resizing of certain rows
+ %W border mark %x %y
+}
+bind Table <B3-Motion> { %W border dragto %x %y }
+
+## Button events
+
+bind Table <1> {
+ if {[winfo exists %W]} {
+ tkTableBeginSelect %W [%W index @%x,%y]
+ focus %W
+ }
+}
+bind Table <B1-Motion> {
+ array set tkPriv {x %x y %y}
+ tkTableMotion %W [%W index @%x,%y]
+}
+bind Table <Double-1> {
+ # empty
+}
+bind Table <ButtonRelease-1> {
+ if {[winfo exists %W]} {
+ tkCancelRepeat
+ %W activate @%x,%y
+ }
+}
+
+bind Table <Shift-1> {tkTableBeginExtend %W [%W index @%x,%y]}
+bind Table <Control-1> {tkTableBeginToggle %W [%W index @%x,%y]}
+bind Table <B1-Enter> {tkCancelRepeat}
+bind Table <B1-Leave> {
+ array set tkPriv {x %x y %y}
+ tkTableAutoScan %W
+}
+bind Table <2> {
+ %W scan mark %x %y
+ array set tkPriv {x %x y %y}
+ set tkPriv(mouseMoved) 0
+}
+bind Table <B2-Motion> {
+ if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} { set tkPriv(mouseMoved) 1 }
+ if $tkPriv(mouseMoved) { %W scan dragto %x %y }
+}
+bind Table <ButtonRelease-2> {
+ if {!$tkPriv(mouseMoved)} { tk_tablePaste %W [%W index @%x,%y] }
+}
+
+## Key events
+
+if {[string comp {} [info command event]]} {
+ tkTableClipboardKeysyms <Copy> <Cut> <Paste>
+} else {
+ tkTableClipboardKeysyms Control-c Control-x Control-v
+}
+
+bind Table <Any-Tab> {
+ # empty to allow Tk focus movement
+}
+# This forces a cell commit if an active cell exists
+# Remove this if you don't want cell commit to occur
+# on every FocusOut
+bind Table <FocusOut> {
+ catch {%W activate active}
+}
+bind Table <Shift-Up> {tkTableExtendSelect %W -1 0}
+bind Table <Shift-Down> {tkTableExtendSelect %W 1 0}
+bind Table <Shift-Left> {tkTableExtendSelect %W 0 -1}
+bind Table <Shift-Right> {tkTableExtendSelect %W 0 1}
+bind Table <Prior> {%W yview scroll -1 pages; %W activate @0,0}
+bind Table <Next> {%W yview scroll 1 pages; %W activate @0,0}
+bind Table <Control-Prior> {%W xview scroll -1 pages}
+bind Table <Control-Next> {%W xview scroll 1 pages}
+bind Table <Home> {%W see origin}
+bind Table <End> {%W see end}
+bind Table <Control-Home> {
+ %W selection clear all
+ %W activate origin
+ %W selection set active
+ %W see active
+}
+bind Table <Control-End> {
+ %W selection clear all
+ %W activate end
+ %W selection set active
+ %W see active
+}
+bind Table <Shift-Control-Home> {tkTableDataExtend %W origin}
+bind Table <Shift-Control-End> {tkTableDataExtend %W end}
+bind Table <Select> {tkTableBeginSelect %W [%W index active]}
+bind Table <Shift-Select> {tkTableBeginExtend %W [%W index active]}
+bind Table <Control-slash> {tkTableSelectAll %W}
+bind Table <Control-backslash> {
+ if {[string match browse [%W cget -selectmode]]} {%W selection clear all}
+}
+bind Table <Up> {tkTableMoveCell %W -1 0}
+bind Table <Down> {tkTableMoveCell %W 1 0}
+bind Table <Left> {tkTableMoveCell %W 0 -1}
+bind Table <Right> {tkTableMoveCell %W 0 1}
+bind Table <Any-KeyPress> {
+ if {[string compare {} %A]} { %W insert active insert %A }
+}
+bind Table <BackSpace> {
+ set tkPriv(junk) [%W icursor]
+ if {[string compare {} $tkPriv(junk)] && $tkPriv(junk)} {
+ %W delete active [expr {$tkPriv(junk)-1}]
+ }
+}
+bind Table <Delete> {%W delete active insert}
+bind Table <Escape> {%W reread}
+
+#bind Table <Return> {tkTableMoveCell %W 1 0}
+bind Table <Return> {
+ %W insert active insert "\n"
+}
+
+bind Table <Control-Left> {%W icursor [expr {[%W icursor]-1}]}
+bind Table <Control-Right> {%W icursor [expr {[%W icursor]+1}]}
+bind Table <Control-e> {%W icursor end}
+bind Table <Control-a> {%W icursor 0}
+bind Table <Control-k> {%W delete active insert end}
+bind Table <Control-equal> {tkTableChangeWidth %W active 1}
+bind Table <Control-minus> {tkTableChangeWidth %W active -1}
+
+# tkTableBeginSelect --
+#
+# This procedure is typically invoked on button-1 presses. It begins
+# the process of making a selection in the table. Its exact behavior
+# depends on the selection mode currently in effect for the table;
+# see the Motif documentation for details.
+#
+# Arguments:
+# w - The table widget.
+# el - The element for the selection operation (typically the
+# one under the pointer). Must be in row,col form.
+
+proc tkTableBeginSelect {w el} {
+ global tkPriv
+ if {[scan $el %d,%d r c] != 2} return
+ switch [$w cget -selectmode] {
+ multiple {
+ if {[$w tag includes title $el]} {
+ ## in the title area
+ if {$r < [$w cget -titlerows]+[$w cget -roworigin]} {
+ ## We're in a column header
+ if {$c < [$w cget -titlecols]+[$w cget -colorigin]} {
+ ## We're in the topleft title area
+ set inc topleft
+ set el2 end
+ } else {
+ set inc [$w index topleft row],$c
+ set el2 [$w index end row],$c
+ }
+ } else {
+ ## We're in a row header
+ set inc $r,[$w index topleft col]
+ set el2 $r,[$w index end col]
+ }
+ } else {
+ set inc $el
+ set el2 $el
+ }
+ if [$w selection includes $inc] {
+ $w selection clear $el $el2
+ } else {
+ $w selection set $el $el2
+ }
+ }
+ extended {
+ $w selection clear all
+ if {[$w tag includes title $el]} {
+ if {$r < [$w cget -titlerows]+[$w cget -roworigin]} {
+ ## We're in a column header
+ if {$c < [$w cget -titlecols]+[$w cget -colorigin]} {
+ $w selection set origin end
+ } else {
+ $w selection set $el [$w index end row],$c
+ }
+ } else {
+ ## We're in a row header
+ $w selection set $el $r,[$w index end col]
+ }
+ } else {
+ $w selection set $el
+ }
+ $w selection anchor $el
+ set tkPriv(tablePrev) $el
+ }
+ default {
+ if {![$w tag includes title $el]} {
+ $w selection clear all
+ $w selection set $el
+ set tkPriv(tablePrev) $el
+ }
+ $w selection anchor $el
+ }
+ }
+}
+
+# tkTableMotion --
+#
+# This procedure is called to process mouse motion events while
+# button 1 is down. It may move or extend the selection, depending
+# on the table's selection mode.
+#
+# Arguments:
+# w - The table widget.
+# el - The element under the pointer (must be in row,col form).
+
+proc tkTableMotion {w el} {
+ global tkPriv
+ if {![info exists tkPriv(tablePrev)]} {
+ set tkPriv(tablePrev) $el
+ return
+ }
+ if {[string match $tkPriv(tablePrev) $el]} return
+ switch [$w cget -selectmode] {
+ browse {
+ $w selection clear all
+ $w selection set $el
+ set tkPriv(tablePrev) $el
+ }
+ extended {
+ scan $tkPriv(tablePrev) %d,%d r c
+ scan $el %d,%d elr elc
+ if {[$w tag includes title $el]} {
+ if {$r < [$w cget -titlerows]+[$w cget -roworigin]} {
+ ## We're in a column header
+ if {$c < [$w cget -titlecols]+[$w cget -colorigin]} {
+ ## We're in the topleft title area
+ $w selection clear anchor end
+ } else {
+ $w selection clear anchor [$w index end row],$c
+ }
+ $w selection set anchor [$w index end row],$elc
+ } else {
+ ## We're in a row header
+ $w selection clear anchor $r,[$w index end col]
+ $w selection set anchor $elr,[$w index end col]
+ }
+ } else {
+ $w selection clear anchor $tkPriv(tablePrev)
+ $w selection set anchor $el
+ }
+ set tkPriv(tablePrev) $el
+ }
+ }
+}
+
+# tkTableBeginExtend --
+#
+# This procedure is typically invoked on shift-button-1 presses. It
+# begins the process of extending a selection in the table. Its
+# exact behavior depends on the selection mode currently in effect
+# for the table; see the Motif documentation for details.
+#
+# Arguments:
+# w - The table widget.
+# el - The element for the selection operation (typically the
+# one under the pointer). Must be in numerical form.
+
+proc tkTableBeginExtend {w el} {
+ if {[string match extended [$w cget -selectmode]] &&
+ [$w selection includes anchor]} {
+ tkTableMotion $w $el
+ }
+}
+
+# tkTableBeginToggle --
+#
+# This procedure is typically invoked on control-button-1 presses. It
+# begins the process of toggling a selection in the table. Its
+# exact behavior depends on the selection mode currently in effect
+# for the table; see the Motif documentation for details.
+#
+# Arguments:
+# w - The table widget.
+# el - The element for the selection operation (typically the
+# one under the pointer). Must be in numerical form.
+
+proc tkTableBeginToggle {w el} {
+ global tkPriv
+ if {[string match extended [$w cget -selectmode]]} {
+ set tkPriv(tablePrev) $el
+ $w selection anchor $el
+ if [$w selection includes $el] {
+ $w selection clear $el
+ } else {
+ $w selection set $el
+ }
+ }
+}
+
+# tkTableAutoScan --
+# 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
+# itself as an "after" command so that the window continues to scroll until
+# the mouse moves back into the window or the mouse button is released.
+#
+# Arguments:
+# w - The entry window.
+
+proc tkTableAutoScan {w} {
+ global tkPriv
+ if {![winfo exists $w]} return
+ set x $tkPriv(x)
+ set y $tkPriv(y)
+ if {$y >= [winfo height $w]} {
+ $w yview scroll 1 units
+ } elseif {$y < 0} {
+ $w yview scroll -1 units
+ } elseif {$x >= [winfo width $w]} {
+ $w xview scroll 1 units
+ } elseif {$x < 0} {
+ $w xview scroll -1 units
+ } else {
+ return
+ }
+ tkTableMotion $w [$w index @$x,$y]
+ set tkPriv(afterId) [after 50 tkTableAutoScan $w]
+}
+
+# tkTableMoveCell --
+#
+# Moves the location cursor (active element) by the specified number
+# of cells and changes the selection if we're in browse or extended
+# selection mode.
+#
+# Arguments:
+# w - The table widget.
+# x - +1 to move down one cell, -1 to move up one cell.
+# y - +1 to move right one cell, -1 to move left one cell.
+
+proc tkTableMoveCell {w x y} {
+ global tkPriv
+ if {[catch {$w index active row} r]} return
+ set c [$w index active col]
+ $w activate [incr r $x],[incr c $y]
+ $w see active
+ switch [$w cget -selectmode] {
+ browse {
+ $w selection clear all
+ $w selection set active
+ }
+ extended {
+ $w selection clear all
+ $w selection set active
+ $w selection anchor active
+ set tkPriv(tablePrev) [$w index active]
+ }
+ }
+}
+
+# tkTableExtendSelect --
+#
+# Does nothing unless we're in extended selection mode; in this
+# case it moves the location cursor (active element) by the specified
+# number of cells, and extends the selection to that point.
+#
+# Arguments:
+# w - The table widget.
+# x - +1 to move down one cell, -1 to move up one cell.
+# y - +1 to move right one cell, -1 to move left one cell.
+
+proc tkTableExtendSelect {w x y} {
+ if {[string compare extended [$w cget -selectmode]] ||
+ [catch {$w index active row} r]} return
+ set c [$w index active col]
+ $w activate [incr r $x],[incr c $y]
+ $w see active
+ tkTableMotion $w [$w index active]
+}
+
+# tkTableDataExtend
+#
+# This procedure is called for key-presses such as Shift-KEndData.
+# If the selection mode isnt 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 table widget.
+# el - An integer cell number.
+
+proc tkTableDataExtend {w el} {
+ set mode [$w cget -selectmode]
+ if {[string match extended $mode]} {
+ $w activate $el
+ $w see $el
+ if [$w selection includes anchor] {tkTableMotion $w $el}
+ } elseif {[string match multiple $mode]} {
+ $w activate $el
+ $w see $el
+ }
+}
+
+# tkTableSelectAll
+#
+# 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 table widget.
+
+proc tkTableSelectAll {w} {
+ if {[regexp {^(single|browse)$} [$w cget -selectmode]]} {
+ $w selection clear all
+ $w selection set active
+ tkTableHandleType $w [$w index active]
+ } else {
+ $w selection set origin end
+ }
+}
+
+# tkTableChangeWidth --
+# Adjust the widget of the specified cell by $a.
+#
+# Arguments:
+# w - The table widget.
+# i - cell index
+# a - amount to adjust by
+
+proc tkTableChangeWidth {w i a} {
+ set tmp [$w index $i col]
+ if {[set width [$w width $tmp]] >= 0} {
+ $w width $tmp [incr width $a]
+ } else {
+ $w width $tmp [incr width -$a]
+ }
+}
+
+# tk_tableCopy --
+# This procedure copies the selection from a table widget into the
+# clipboard.
+#
+# Arguments:
+# w - Name of a table widget.
+
+proc tk_tableCopy w {
+ if {[selection own -displayof $w] == "$w"} {
+ clipboard clear -displayof $w
+ catch {clipboard append -displayof $w [selection get -displayof $w]}
+ }
+}
+
+# tk_tableCut --
+# This procedure copies the selection from a table widget into the
+# clipboard, then deletes the selection (if it exists in the given
+# widget).
+#
+# Arguments:
+# w - Name of a table widget.
+
+proc tk_tableCut w {
+ if {[selection own -displayof $w] == "$w"} {
+ clipboard clear -displayof $w
+ catch {
+ clipboard append -displayof $w [selection get -displayof $w]
+ $w cursel set {}
+ $w selection clear all
+ }
+ }
+}
+
+# tk_tablePaste --
+# This procedure pastes the contents of the clipboard to the specified
+# cell (active by default) in a table widget.
+#
+# Arguments:
+# w - Name of a table widget.
+# cell - Cell to start pasting in.
+
+proc tk_tablePaste {w {cell {}}} {
+ if {[string compare {} $cell]} {
+ if {[catch {selection get -displayof $w} data]} return
+ } else {
+ if {[catch {selection get -displayof $w -selection CLIPBOARD} data]} {
+ return
+ }
+ set cell active
+ }
+ tk_tablePasteHandler $w [$w index $cell] $data
+ if {[$w cget -state] == "normal"} {focus $w}
+}
+
+# tk_tablePasteHandler --
+# This procedure handles how data is pasted into the table widget.
+# This handles data in the default table selection form.
+# NOTE: this allows pasting into all cells, even those with -state disabled
+#
+# Arguments:
+# w - Name of a table widget.
+# cell - Cell to start pasting in.
+
+proc tk_tablePasteHandler {w cell data} {
+ set rows [expr {[$w cget -rows]-[$w cget -roworigin]}]
+ set cols [expr {[$w cget -cols]-[$w cget -colorigin]}]
+ set r [$w index $cell row]
+ set c [$w index $cell col]
+ set rsep [$w cget -rowseparator]
+ set csep [$w cget -colseparator]
+ ## Assume separate rows are split by row separator if specified
+ ## If you were to want multi-character row separators, you would need:
+ # regsub -all $rsep $data <newline> data
+ # set data [join $data <newline>]
+ if {[string comp {} $rsep]} { set data [split $data $rsep] }
+ set row $r
+ foreach line $data {
+ if {$row > $rows} break
+ set col $c
+ ## Assume separate cols are split by col separator if specified
+ ## Unless a -separator was specified
+ if {[string comp {} $csep]} { set line [split $line $csep] }
+ ## If you were to want multi-character col separators, you would need:
+ # regsub -all $csep $line <newline> line
+ # set line [join $line <newline>]
+ foreach item $line {
+ if {$col > $cols} break
+ $w set $row,$col $item
+ incr col
+ }
+ incr row
+ }
+}
diff --git a/libgui/src/tkTableCell.c b/libgui/src/tkTableCell.c
new file mode 100644
index 00000000000..9d307b7c03e
--- /dev/null
+++ b/libgui/src/tkTableCell.c
@@ -0,0 +1,563 @@
+/*
+ * tkTableCell.c --
+ *
+ * This module implements cell oriented functions for table
+ * widgets.
+ *
+ * Copyright (c) 1998 Jeffrey Hobbs
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include "tkTable.h"
+
+static int TableSortCompareProc _ANSI_ARGS_((CONST VOID *first,
+ CONST VOID *second));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableCellCoords --
+ * Takes a row,col pair in real coords and finds it position
+ * on the virtual screen.
+ *
+ * Results:
+ * The virtual x, y, width, and height of the cell
+ * are placed in the pointers.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableCellCoords(Table *tablePtr, int row, int col,
+ int *x, int *y, int *width, int *height)
+{
+ if (tablePtr->rows <= 0 || tablePtr->cols <= 0) {
+ *width = *height = *x = *y = 0;
+ return;
+ }
+ /* real coords required, always should be passed acceptable values,
+ * but this is a possible seg fault otherwise */
+ row = MIN(tablePtr->rows-1, MAX(0, row));
+ col = MIN(tablePtr->cols-1, MAX(0, col));
+ *width = tablePtr->colPixels[col];
+ *height = tablePtr->rowPixels[row];
+ *x = tablePtr->highlightWidth + tablePtr->colStarts[col] -
+ ((col < tablePtr->titleCols) ? 0 : tablePtr->colStarts[tablePtr->leftCol]
+ - tablePtr->colStarts[tablePtr->titleCols]);
+ *y = tablePtr->highlightWidth + tablePtr->rowStarts[row] -
+ ((row < tablePtr->titleRows) ? 0 : tablePtr->rowStarts[tablePtr->topRow]
+ - tablePtr->rowStarts[tablePtr->titleRows]);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableCellVCoords --
+ * Takes a row,col pair in real coords and finds it position
+ * on the actual screen. The full arg specifies whether
+ * only 100% visible cells should be considered visible.
+ *
+ * Results:
+ * The x, y, width, and height of the cell are placed in the pointers,
+ * depending upon visibility of the cell.
+ * Returns 0 for hidden and 1 for visible cells.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TableCellVCoords(Table *tablePtr, int row, int col,
+ int *rx, int *ry, int *rw, int *rh, int full)
+{
+ if (tablePtr->tkwin == NULL) return 0;
+
+ if ((row < tablePtr->topRow && row >= tablePtr->titleRows) ||
+ (col < tablePtr->leftCol && col >= tablePtr->titleCols)) {
+ /* hiding in "dead" space between title areas and visible cells */
+ *rx = 0; *ry = 0; *rw = 0; *rh = 0;
+ return 0;
+ } else {
+ int x, y, w, h, w0, h0, hl = tablePtr->highlightWidth;
+ /* Necessary to use separate vars in case dummies are passed in */
+ TableCellCoords(tablePtr, row, col, &x, &y, &w, &h);
+ *rx = x; *ry = y;
+ if (full) {
+ w0 = w; h0 = h;
+ } else {
+ /* if we don't care about seeing the whole thing, then
+ * make sure we at least see a pixel worth */
+ w0 = h0 = 1;
+ }
+ /* Is the cell visible? */
+ if (x<hl || y<hl || (x+w0)>(Tk_Width(tablePtr->tkwin)-hl)
+ || (y+h0)>(Tk_Height(tablePtr->tkwin)-hl)) {
+ /* definitely off the screen */
+ *rw = *rh = 0;
+ return 0;
+ } else {
+ if (full) {
+ *rw = w; *rh = h;
+ } else {
+ *rw = MIN(w, Tk_Width(tablePtr->tkwin)-hl-x);
+ *rh = MIN(h, Tk_Height(tablePtr->tkwin)-hl-y);
+ }
+ return 1;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableWhatCell --
+ * Takes a x,y screen coordinate and determines what cell contains.
+ * that point. This will return cells that are beyond the right/bottom
+ * edge of the viewable screen.
+ *
+ * Results:
+ * The row,col of the cell are placed in the pointers.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableWhatCell(register Table *tablePtr, int x, int y, int *row, int *col)
+{
+ int i;
+ x = MAX(0, x); y = MAX(0, y);
+ /* Adjust for table's global highlightthickness border */
+ x -= tablePtr->highlightWidth;
+ y -= tablePtr->highlightWidth;
+ /* Adjust the x coord if not in the column titles to change display coords
+ * into internal coords */
+ x += (x < tablePtr->colStarts[tablePtr->titleCols]) ? 0 :
+ tablePtr->colStarts[tablePtr->leftCol] -
+ tablePtr->colStarts[tablePtr->titleCols];
+ y += (y < tablePtr->rowStarts[tablePtr->titleRows]) ? 0 :
+ tablePtr->rowStarts[tablePtr->topRow] -
+ tablePtr->rowStarts[tablePtr->titleRows];
+ x = MIN(x, tablePtr->maxWidth-1);
+ y = MIN(y, tablePtr->maxHeight-1);
+ for (i = 1; x >= tablePtr->colStarts[i]; i++);
+ *col = i - 1;
+ for (i = 1; y >= tablePtr->rowStarts[i]; i++);
+ *row = i - 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableAtBorder --
+ * Takes a x,y screen coordinate and determines if that point is
+ * over a border.
+ *
+ * Results:
+ * The left/top row,col corresponding to that point are placed in
+ * the pointers. The number of borders (+1 for row, +1 for col)
+ * hit is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TableAtBorder(Table * tablePtr, int x, int y, int *row, int *col)
+{
+ int i, borders = 2, bd = tablePtr->borderWidth;
+ int dbd = 2*bd;
+ x = MAX(0, x); y = MAX(0, y);
+ x -= tablePtr->highlightWidth; y -= tablePtr->highlightWidth;
+ /* Adjust the x coord if not in the column titles to change display coords
+ * into internal coords */
+ x += (x < tablePtr->colStarts[tablePtr->titleCols]) ? 0 :
+ tablePtr->colStarts[tablePtr->leftCol] -
+ tablePtr->colStarts[tablePtr->titleCols];
+ y += (y < tablePtr->rowStarts[tablePtr->titleRows]) ? 0 :
+ tablePtr->rowStarts[tablePtr->topRow] -
+ tablePtr->rowStarts[tablePtr->titleRows];
+ x = MIN(x, tablePtr->maxWidth - 1);
+ y = MIN(y, tablePtr->maxHeight - 1);
+ for (i = 1; i <= tablePtr->cols && x+dbd >= tablePtr->colStarts[i]; i++);
+ if (x > tablePtr->colStarts[--i]+bd) {
+ borders--;
+ *col = -1;
+ } else {
+ *col = (--i < tablePtr->leftCol && i >= tablePtr->titleCols) ?
+ tablePtr->titleCols-1 : i;
+ }
+ for (i = 1; i <= tablePtr->rows && y+dbd >= tablePtr->rowStarts[i]; i++);
+ if (y > tablePtr->rowStarts[--i]+bd) {
+ borders--;
+ *row = -1;
+ } else {
+ *row = (--i < tablePtr->topRow && i >= tablePtr->titleRows) ?
+ tablePtr->titleRows-1 : i;
+ }
+ return borders;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableGetCellValue --
+ * Takes a row,col pair in user coords and returns the value for
+ * that cell. This varies depending on what data source the
+ * user has selected.
+ *
+ * Results:
+ * The value of the cell is returned. The return value is VOLATILE
+ * (do not free).
+ *
+ * Side effects:
+ * The value will be cached if caching is turned on.
+ *
+ *----------------------------------------------------------------------
+ */
+char *
+TableGetCellValue(Table *tablePtr, int r, int c)
+{
+ register Tcl_Interp *interp = tablePtr->interp;
+ char *result = NULL;
+ char buf[INDEX_BUFSIZE];
+ Tcl_HashEntry *entryPtr = NULL;
+ int new = 1;
+
+ TableMakeArrayIndex(r, c, buf);
+
+ if (tablePtr->caching) {
+ /* if we are caching, let's see if we have the value cached */
+ entryPtr = Tcl_CreateHashEntry(tablePtr->cache, buf, &new);
+ if (!new) {
+ result = (char *) Tcl_GetHashValue(entryPtr);
+ return result?result:"";
+ }
+ }
+ if (tablePtr->command && tablePtr->useCmd) {
+ Tcl_DString script;
+ Tcl_DStringInit(&script);
+ ExpandPercents(tablePtr, tablePtr->command, r, c, "", (char *)NULL,
+ 0, &script, 0);
+ if (Tcl_GlobalEval(interp, Tcl_DStringValue(&script)) == TCL_ERROR) {
+ tablePtr->useCmd = 0;
+ tablePtr->dataSource &= ~DATA_COMMAND;
+ if (tablePtr->arrayVar)
+ tablePtr->dataSource |= DATA_ARRAY;
+ Tcl_AddErrorInfo(interp, "\n\t(in command executed by table)");
+ Tcl_AddErrorInfo(interp, Tcl_DStringValue(&script));
+ Tk_BackgroundError(interp);
+ TableInvalidateAll(tablePtr, 0);
+ } else {
+ result = Tcl_GetStringResult(interp);
+ }
+ Tcl_FreeResult(interp);
+ Tcl_DStringFree(&script);
+ } else if (tablePtr->arrayVar) {
+ result = Tcl_GetVar2(interp, tablePtr->arrayVar, buf, TCL_GLOBAL_ONLY);
+ }
+ if (result == NULL)
+ result = "";
+ if (tablePtr->caching && entryPtr != NULL) {
+ /* if we are caching, make sure we cache the returned value */
+ /* entryPtr will have been set from above, but check to make sure
+ * someone didn't change caching during -command evaluation */
+ char *val;
+ val = (char *)ckalloc(strlen(result)+1);
+ strcpy(val, result);
+ Tcl_SetHashValue(entryPtr, val);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableSetCellValue --
+ * Takes a row,col pair in user coords and saves the given value for
+ * that cell. This varies depending on what data source the
+ * user has selected.
+ *
+ * Results:
+ * Returns TCL_ERROR or TCL_OK, depending on whether an error
+ * occured during set (ie: during evaluation of -command).
+ *
+ * Side effects:
+ * If the value is NULL (empty string), it will be unset from
+ * an array rather than set to the empty string.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TableSetCellValue(Table *tablePtr, int r, int c, char *value)
+{
+ register Tcl_Interp *interp = tablePtr->interp;
+ char buf[INDEX_BUFSIZE];
+ int code = TCL_OK;
+
+ TableMakeArrayIndex(r, c, buf);
+
+ if (tablePtr->state == STATE_DISABLED)
+ return code;
+ if (tablePtr->command && tablePtr->useCmd) {
+ Tcl_DString script;
+
+ Tcl_DStringInit(&script);
+ ExpandPercents(tablePtr, tablePtr->command, r, c, value, (char *)NULL,
+ 1, &script, 0);
+ if (Tcl_GlobalEval(interp, Tcl_DStringValue(&script)) == TCL_ERROR) {
+ /* An error resulted. Prevent further triggering of the command
+ * and set up the error message. */
+ tablePtr->useCmd = 0;
+ tablePtr->dataSource &= ~DATA_COMMAND;
+ if (tablePtr->arrayVar)
+ tablePtr->dataSource |= DATA_ARRAY;
+ Tcl_AddErrorInfo(interp, "\n\t(in command executed by table)");
+ Tk_BackgroundError(interp);
+ code = TCL_ERROR;
+ }
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ Tcl_DStringFree(&script);
+ } else if (tablePtr->arrayVar) {
+ if (value == NULL || *value == '\0') {
+ Tcl_UnsetVar2(interp, tablePtr->arrayVar, buf, TCL_GLOBAL_ONLY);
+ } else if (Tcl_SetVar2(interp, tablePtr->arrayVar, buf, value,
+ TCL_GLOBAL_ONLY|TCL_LEAVE_ERR_MSG) == NULL) {
+ code = TCL_ERROR;
+ }
+ }
+ if (tablePtr->caching && code == TCL_OK) {
+ Tcl_HashEntry *entryPtr;
+ int new;
+ char *val;
+
+ val = (char *)ckalloc(strlen(value)+1);
+ strcpy(val, value);
+ entryPtr = Tcl_CreateHashEntry(tablePtr->cache, buf, &new);
+ Tcl_SetHashValue(entryPtr, val);
+ }
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableSortCompareProc --
+ * This procedure is invoked by qsort to determine the proper
+ * ordering between two elements.
+ *
+ * Results:
+ * < 0 means first is "smaller" than "second", > 0 means "first"
+ * is larger than "second", and 0 means they should be treated
+ * as equal.
+ *
+ * Side effects:
+ * None, unless a user-defined comparison command does something
+ * weird.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+TableSortCompareProc(first, second)
+ CONST VOID *first, *second; /* Elements to be compared. */
+{
+ int r1, c1, r2, c2;
+ char *firstString = *((char **) first);
+ char *secondString = *((char **) second);
+
+ /* This doesn't account for badly formed indices */
+ sscanf(firstString, "%d,%d", &r1, &c1);
+ sscanf(secondString, "%d,%d", &r2, &c2);
+ if (r1 > r2)
+ return 1;
+ else if (r1 < r2)
+ return -1;
+ else if (c1 > c2)
+ return 1;
+ else if (c1 < c2)
+ return -1;
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableCellSort --
+ * Sort a list of table cell elements (of form row,col)
+ *
+ * Results:
+ * Returns the sorted list of elements. Because Tcl_Merge allocs
+ * the space for result, it must later be ckfree'd by caller.
+ *
+ * Side effects:
+ * Behaviour undefined for ill-formed input list of elements.
+ *
+ *----------------------------------------------------------------------
+ */
+char *
+TableCellSort(Table *tablePtr, char *str)
+{
+ int listArgc;
+ char **listArgv;
+ char *result;
+
+ if (Tcl_SplitList(tablePtr->interp, str, &listArgc, &listArgv) != TCL_OK)
+ return str;
+ qsort((VOID *) listArgv, (size_t) listArgc, sizeof (char *),
+ TableSortCompareProc);
+ result = Tcl_Merge(listArgc, listArgv);
+ ckfree((char *) listArgv);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableGetIcursor --
+ * Parses the argument as an index into the active cell string.
+ * Recognises 'end', 'insert' or an integer. Constrains it to the
+ * size of the buffer. This acts like a "SetIcursor" when *posn is NULL.
+ *
+ * Results:
+ * If (posn != NULL), then it gets the cursor position.
+ *
+ * Side effects:
+ * Can move cursor position.
+ *
+ *----------------------------------------------------------------------
+ */
+int
+TableGetIcursor(Table *tablePtr, char *arg, int *posn)
+{
+ int tmp, len;
+#if (TK_MINOR_VERSION > 0)
+ len = Tcl_NumUtfChars(tablePtr->activeBuf, strlen(tablePtr->activeBuf));
+#else
+ len = strlen(tablePtr->activeBuf);
+#endif
+ /* ensure icursor didn't get out of sync */
+ if (tablePtr->icursor > len) tablePtr->icursor = len;
+ /* is this end */
+ if (strcmp(arg, "end") == 0) {
+ tmp = len;
+ } else if (strcmp(arg, "insert") == 0) {
+ tmp = tablePtr->icursor;
+ } else {
+ if (Tcl_GetInt(tablePtr->interp, arg, &tmp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ tmp = MIN(MAX(0, tmp), len);
+ }
+ if (posn)
+ *posn = tmp;
+ else
+ tablePtr->icursor = tmp;
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TableGetIndex --
+ * Parse an index into a table and return either its value
+ * or an error.
+ *
+ * Results:
+ * A standard Tcl result. If all went well, then *row,*col is
+ * filled in with the index corresponding to string. If an
+ * error occurs then an error message is left in interp result.
+ * The index returned is in user coords.
+ *
+ * Side effects:
+ * Sets row,col index to an appropriately constrained user index.
+ *
+ *--------------------------------------------------------------
+ */
+int
+TableGetIndex(tablePtr, str, row_p, col_p)
+ register Table *tablePtr; /* Table for which the index is being
+ * specified. */
+ char *str; /* Symbolic specification of cell in table. */
+ int *row_p; /* Where to store converted row. */
+ int *col_p; /* Where to store converted col. */
+{
+ int r, c, len = strlen(str);
+
+ /*
+ * Note that all of these values will be adjusted by row/ColOffset
+ */
+ if (str[0] == '@') { /* @x,y coordinate */
+ int x, y;
+ char *p, *end;
+
+ p = str+1;
+ x = strtol(p, &end, 0);
+ if ((end == p) || (*end != ','))
+ goto IndexError;
+ p = end+1;
+ y = strtol(p, &end, 0);
+ if ((end == p) || (*end != '\0'))
+ goto IndexError;
+ TableWhatCell(tablePtr, x, y, &r, &c);
+ r += tablePtr->rowOffset;
+ c += tablePtr->colOffset;
+ } else if (sscanf(str, "%d,%d", &r,&c) == 2) {
+ char buf[INDEX_BUFSIZE];
+ TableMakeArrayIndex(r, c, buf);
+ /* Make sure it won't work for "2,3extrastuff" */
+ if (strcmp(buf, str))
+ goto IndexError;
+ /* ensure appropriate user index */
+ r = MIN(MAX(tablePtr->rowOffset,r),tablePtr->rows-1+tablePtr->rowOffset);
+ c = MIN(MAX(tablePtr->colOffset,c),tablePtr->cols-1+tablePtr->colOffset);
+ } else if (len > 1 && strncmp(str, "active", len) == 0 ) { /* active */
+ if (tablePtr->flags & HAS_ACTIVE) {
+ r = tablePtr->activeRow+tablePtr->rowOffset;
+ c = tablePtr->activeCol+tablePtr->colOffset;
+ } else {
+ Tcl_AppendResult(tablePtr->interp, "no \"active\" cell in table", NULL);
+ return TCL_ERROR;
+ }
+ } else if (len > 1 && strncmp(str, "anchor", len) == 0) { /* anchor */
+ if (tablePtr->flags & HAS_ANCHOR) {
+ r = tablePtr->anchorRow+tablePtr->rowOffset;
+ c = tablePtr->anchorCol+tablePtr->colOffset;
+ } else {
+ Tcl_AppendResult(tablePtr->interp, "no \"anchor\" cell in table", NULL);
+ return TCL_ERROR;
+ }
+ } else if (strncmp(str, "end", len) == 0) { /* end */
+ r = tablePtr->rows-1+tablePtr->rowOffset;
+ c = tablePtr->cols-1+tablePtr->colOffset;
+ } else if (strncmp(str, "origin", len) == 0) { /* origin */
+ r = tablePtr->titleRows+tablePtr->rowOffset;
+ c = tablePtr->titleCols+tablePtr->colOffset;
+ } else if (strncmp(str, "topleft", len) == 0) { /* topleft */
+ r = tablePtr->topRow+tablePtr->rowOffset;
+ c = tablePtr->leftCol+tablePtr->colOffset;
+ } else if (strncmp(str, "bottomright", len) == 0) { /* bottomright */
+ TableGetLastCell(tablePtr, &r, &c);
+ r += tablePtr->rowOffset;
+ c += tablePtr->colOffset;
+ } else {
+ IndexError:
+ Tcl_AppendResult(tablePtr->interp, "bad table index \"",
+ str, "\"", (char *)NULL);
+ return TCL_ERROR;
+ }
+
+ /* Note: values are expected to be properly constrained
+ * as a user index by this point */
+ if (row_p) *row_p = r;
+ if (col_p) *col_p = c;
+ return TCL_OK;
+}
+
diff --git a/libgui/src/tkTableCmd.c b/libgui/src/tkTableCmd.c
new file mode 100644
index 00000000000..aaca860bdb8
--- /dev/null
+++ b/libgui/src/tkTableCmd.c
@@ -0,0 +1,158 @@
+/*
+ * tkTableCmd.c --
+ *
+ * This module implements command structure lookups.
+ *
+ * Copyright (c) 1997,1998 Jeffrey Hobbs
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include "tkTableCmd.h"
+
+/*
+ * Functions for handling custom options that use Cmd_Structs
+ */
+
+int
+Cmd_OptionSet(ClientData clientData, Tcl_Interp *interp,
+ Tk_Window unused, char *value, char *widgRec, int offset)
+{
+ Cmd_Struct *p = (Cmd_Struct *)clientData;
+ int mode = Cmd_GetValue(p,value);
+ if (!mode) {
+ Cmd_GetError(interp,p,value);
+ return TCL_ERROR;
+ }
+ *((int*)(widgRec+offset)) = mode;
+ return TCL_OK;
+}
+
+char *
+Cmd_OptionGet(ClientData clientData, Tk_Window unused,
+ char *widgRec, int offset, Tcl_FreeProc **freeProcPtr)
+{
+ Cmd_Struct *p = (Cmd_Struct *)clientData;
+ int mode = *((int*)(widgRec+offset));
+ return Cmd_GetName(p,mode);
+}
+
+/*
+ * Options for bits in an int
+ * This will set/clear one bit in an int, the specific bit
+ * being passed in clientData
+ */
+int
+Cmd_BitSet(ClientData clientData, Tcl_Interp *interp,
+ Tk_Window unused, char *value, char *widgRec, int offset)
+{
+ int mode;
+ if (Tcl_GetBoolean(interp, value, &mode) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (mode) {
+ *((int*)(widgRec+offset)) |= (int)clientData;
+ } else {
+ *((int*)(widgRec+offset)) &= ~((int)clientData);
+ }
+ return TCL_OK;
+}
+
+char *
+Cmd_BitGet(ClientData clientData, Tk_Window unused,
+ char *widgRec, int offset, Tcl_FreeProc **freeProcPtr)
+{
+ return (*((int*)(widgRec+offset)) & (int) clientData)?"1":"0";
+}
+
+/*
+ * simple Cmd_Struct lookup functions
+ */
+
+char *
+Cmd_GetName(const Cmd_Struct *cmds, int val)
+{
+ for(;cmds->name && cmds->name[0];cmds++) {
+ if (cmds->value==val) return cmds->name;
+ }
+ return NULL;
+}
+
+int
+Cmd_GetValue(const Cmd_Struct *cmds, const char *arg)
+{
+ int len=strlen(arg);
+ for(;cmds->name && cmds->name[0];cmds++) {
+ if (!strncmp(cmds->name,arg,len)) return cmds->value;
+ }
+ return 0;
+}
+
+void
+Cmd_GetError(Tcl_Interp *interp, const Cmd_Struct *cmds, const char *arg)
+{
+ int i;
+ Tcl_AppendResult(interp, "bad option \"", arg, "\" must be ", (char *) 0);
+ for(i=0;cmds->name && cmds->name[0];cmds++,i++) {
+ Tcl_AppendResult(interp, (i?", ":""), cmds->name, (char *) 0);
+ }
+}
+
+/*
+ * Parses a command string passed in an arg comparing it with all the
+ * command strings in the command array. If it finds a string which is a
+ * unique identifier of one of the commands, returns the index . If none of
+ * the commands match, or the abbreviation is not unique, then it sets up
+ * the message accordingly and returns 0
+ */
+
+int
+Cmd_Parse (Tcl_Interp *interp, Cmd_Struct *cmds, const char *arg)
+{
+ int len = (int)strlen(arg);
+ Cmd_Struct *matched = (Cmd_Struct *) 0;
+ int err = 0;
+ Cmd_Struct *next = cmds;
+ while (*(next->name)) {
+ if (strncmp (next->name, arg, len) == 0) {
+ /* have we already matched this one if so make up an error message */
+ if (matched) {
+ if (!err) {
+ Tcl_AppendResult(interp, "ambiguous option \"", arg,
+ "\" could be ", matched->name, (char *) 0);
+ matched = next;
+ err = 1;
+ }
+ Tcl_AppendResult(interp, ", ", next->name, (char *) 0);
+ } else {
+ matched = next;
+ /* return on an exact match */
+ if (len == (int)strlen(next->name))
+ return matched->value;
+ }
+ }
+ next++;
+ }
+ /* did we get multiple possibilities */
+ if (err) return 0;
+ /* did we match any at all */
+ if (matched) {
+ return matched->value;
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", arg, "\" must be ",
+ (char *) NULL);
+ next = cmds;
+ while (1) {
+ Tcl_AppendResult(interp, next->name, (char *) NULL);
+ /* the end of them all ? */
+ if (!*((++next)->name)) return 0;
+ /* or the last one at least */
+ if (*((next + 1)->name))
+ Tcl_AppendResult(interp, ", ", (char *) NULL);
+ else
+ Tcl_AppendResult(interp, " or ", (char *) NULL);
+ }
+ }
+}
diff --git a/libgui/src/tkTableCmd.h b/libgui/src/tkTableCmd.h
new file mode 100644
index 00000000000..974db1a9ad1
--- /dev/null
+++ b/libgui/src/tkTableCmd.h
@@ -0,0 +1,52 @@
+/*
+ * tkTableCmd.h --
+ *
+ * This is the header file for the module that implements
+ * command structure lookups.
+ *
+ * Copyright (c) 1997,1998 Jeffrey Hobbs
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#ifndef _CMD_H_
+#define _CMD_H_
+
+#include <string.h>
+#include <stdlib.h>
+#include <tk.h>
+
+/* structure for use in parsing table commands/values */
+typedef struct {
+ char *name; /* name of the command/value */
+ int value; /* >0 because 0 represents an error */
+} Cmd_Struct;
+
+extern char * Cmd_GetName _ANSI_ARGS_((const Cmd_Struct *cmds, int val));
+extern int Cmd_GetValue _ANSI_ARGS_((const Cmd_Struct *cmds,
+ const char *arg));
+extern void Cmd_GetError _ANSI_ARGS_((Tcl_Interp *interp,
+ const Cmd_Struct *cmds,
+ const char *arg));
+extern int Cmd_Parse _ANSI_ARGS_((Tcl_Interp *interp, Cmd_Struct *cmds,
+ const char *arg));
+extern int Cmd_OptionSet _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp,
+ Tk_Window unused, char *value,
+ char *widgRec, int offset));
+extern char * Cmd_OptionGet _ANSI_ARGS_((ClientData clientData,
+ Tk_Window unused, char *widgRec,
+ int offset,
+ Tcl_FreeProc **freeProcPtr));
+extern int Cmd_BitSet _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp,
+ Tk_Window unused, char *value,
+ char *widgRec, int offset));
+extern char * Cmd_BitGet _ANSI_ARGS_((ClientData clientData,
+ Tk_Window unused, char *widgRec,
+ int offset,
+ Tcl_FreeProc **freeProcPtr));
+
+#endif /* _CMD_H_ */
diff --git a/libgui/src/tkTableTag.c b/libgui/src/tkTableTag.c
new file mode 100644
index 00000000000..4ba5413d615
--- /dev/null
+++ b/libgui/src/tkTableTag.c
@@ -0,0 +1,756 @@
+/*
+ * tkTableTag.c --
+ *
+ * This module implements tags for table widgets.
+ *
+ * Copyright (c) 1998 Jeffrey Hobbs
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include "tkTable.h"
+
+static void CreateTagEntry _ANSI_ARGS_((Table *tablePtr, char *name,
+ int argc, char **argv));
+static void TableImageProc _ANSI_ARGS_((ClientData clientData, int x,
+ int y, int width, int height,
+ int imageWidth, int imageHeight));
+
+/* tag subcommands */
+#define TAG_CELLTAG 1 /* tag a cell */
+#define TAG_CGET 2 /* get a config value */
+#define TAG_COLTAG 3 /* tag a column */
+#define TAG_CONFIGURE 4 /* config/create a new tag */
+#define TAG_DELETE 5 /* delete a tag */
+#define TAG_EXISTS 6 /* does a tag exist? */
+#define TAG_NAMES 7 /* print the tag names */
+#define TAG_ROWTAG 8 /* tag a row */
+#define TAG_INCLUDES 9 /* does an index have a particular tag */
+
+static Cmd_Struct tag_cmds[] = {
+ {"celltag", TAG_CELLTAG},
+ {"coltag", TAG_COLTAG},
+ {"configure", TAG_CONFIGURE},
+ {"cget", TAG_CGET},
+ {"delete", TAG_DELETE},
+ {"exists", TAG_EXISTS},
+ {"names", TAG_NAMES},
+ {"rowtag", TAG_ROWTAG},
+ {"includes", TAG_INCLUDES},
+ {"", 0}
+};
+
+static Cmd_Struct tagState_vals[]= {
+ {"unknown", STATE_UNKNOWN},
+ {"normal", STATE_NORMAL},
+ {"disabled", STATE_DISABLED},
+ {"", 0 }
+};
+
+static Tk_CustomOption tagStateOpt = { Cmd_OptionSet, Cmd_OptionGet,
+ (ClientData)(&tagState_vals) };
+
+/*
+ * The default specification for configuring tags
+ * Done like this to make the command line parsing easy
+ */
+
+static Tk_ConfigSpec tagConfig[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor", "center",
+ Tk_Offset(TableTag, anchor), TK_CONFIG_DONT_SET_DEFAULT },
+ {TK_CONFIG_BORDER, "-background", "background", "Background", NULL,
+ Tk_Offset(TableTag, bg),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0 },
+ {TK_CONFIG_BORDER, "-foreground", "foreground", "Foreground", NULL,
+ Tk_Offset(TableTag, fg),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0 },
+ {TK_CONFIG_FONT, "-font", "font", "Font", NULL,
+ Tk_Offset(TableTag, tkfont),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
+ {TK_CONFIG_STRING, "-image", "image", "Image", NULL,
+ Tk_Offset(TableTag, imageStr),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
+ {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify", "left",
+ Tk_Offset(TableTag, justify), TK_CONFIG_DONT_SET_DEFAULT },
+ {TK_CONFIG_INT, "-multiline", "multiline", "Multiline", "1",
+ Tk_Offset(TableTag, multiline), TK_CONFIG_DONT_SET_DEFAULT },
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", "flat",
+ Tk_Offset(TableTag, relief),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
+ {TK_CONFIG_INT, "-showtext", "showText", "ShowText", "0",
+ Tk_Offset(TableTag, showtext), TK_CONFIG_DONT_SET_DEFAULT },
+ {TK_CONFIG_CUSTOM, "-state", "state", "State", "unknown",
+ Tk_Offset(TableTag, state), TK_CONFIG_DONT_SET_DEFAULT, &tagStateOpt },
+ {TK_CONFIG_INT, "-wrap", "wrap", "Wrap", "0",
+ Tk_Offset(TableTag, wrap), TK_CONFIG_DONT_SET_DEFAULT },
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0 }
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableImageProc --
+ * Called when an image associated with a tag is changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Invalidates the whole table.
+ * FIX - should only invalidate affected cells.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TableImageProc(ClientData clientData, int x, int y, int width, int height,
+ int imageWidth, int imageHeight)
+{
+ TableInvalidateAll((Table *)clientData, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableNewTag --
+ * ckallocs space for a new tag structure and inits the structure.
+ *
+ * Results:
+ * Returns a pointer to the new structure. Must be freed later.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+TableTag *
+TableNewTag(void)
+{
+ TableTag *tagPtr = (TableTag *) ckalloc(sizeof(TableTag));
+ tagPtr->anchor = (Tk_Anchor)-1;
+ tagPtr->bg = NULL;
+ tagPtr->fg = NULL;
+ tagPtr->tkfont = NULL;
+ tagPtr->image = NULL;
+ tagPtr->imageStr = NULL;
+ tagPtr->justify = (Tk_Justify)-1;
+ tagPtr->multiline = -1;
+ tagPtr->relief = -1;
+ tagPtr->showtext = -1;
+ tagPtr->state = STATE_UNKNOWN;
+ tagPtr->wrap = -1;
+ return tagPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableMergeTag --
+ * This routine merges two tags by adding any fields from the addTag
+ * that are set to the baseTag.
+ *
+ * Results:
+ * baseTag will inherit all set characteristics of addTag
+ * (addTag thus has the priority).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableMergeTag(TableTag *baseTag, TableTag *addTag)
+{
+ if (addTag->anchor != (Tk_Anchor)-1) baseTag->anchor = addTag->anchor;
+ if (addTag->bg != NULL) baseTag->bg = addTag->bg;
+ if (addTag->fg != NULL) baseTag->fg = addTag->fg;
+ if (addTag->tkfont != NULL) baseTag->tkfont = addTag->tkfont;
+ if (addTag->imageStr != NULL) {
+ baseTag->imageStr = addTag->imageStr;
+ baseTag->image = addTag->image;
+ }
+ if (addTag->multiline >= 0) baseTag->multiline = addTag->multiline;
+ if (addTag->relief != -1) baseTag->relief = addTag->relief;
+ if (addTag->showtext >= 0) baseTag->showtext = addTag->showtext;
+ if (addTag->state != STATE_UNKNOWN) baseTag->state = addTag->state;
+ if (addTag->justify != (Tk_Justify)-1) baseTag->justify = addTag->justify;
+ if (addTag->wrap >= 0) baseTag->wrap = addTag->wrap;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableInvertTag --
+ * This routine swaps background and foreground for the selected tag.
+ *
+ * Results:
+ * Inverts fg and bg of tag.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableInvertTag(TableTag *baseTag)
+{
+ Tk_3DBorder tmpBg;
+
+ tmpBg = baseTag->fg;
+ baseTag->fg = baseTag->bg;
+ baseTag->bg = tmpBg;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateTagEntry --
+ * Takes a name and optional args and create a tag entry in the
+ * table's tag table.
+ *
+ * Results:
+ * A new tag entry will be created.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+CreateTagEntry(Table *tablePtr, char *name, int argc, char **argv)
+{
+ Tcl_HashEntry *entryPtr;
+ TableTag *tagPtr = TableNewTag();
+ int dummy;
+ Tk_ConfigureWidget(tablePtr->interp, tablePtr->tkwin, tagConfig,
+ argc, argv, (char *)tagPtr, TK_CONFIG_ARGV_ONLY);
+ entryPtr = Tcl_CreateHashEntry(tablePtr->tagTable, name, &dummy);
+ Tcl_SetHashValue(entryPtr, (ClientData) tagPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableInitTags --
+ * Creates the static table tags.
+ *
+ * Results:
+ * active, sel, title and flash are created as tags.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableInitTags(Table *tablePtr)
+{
+ static char *activeArgs[] = {"-bg", ACTIVE_BG, "-relief", "flat" };
+ static char *selArgs[] = {"-bg", SELECT_BG, "-relief", "sunken" };
+ static char *titleArgs[] = {"-bg", DISABLED, "-relief", "flat",
+ "-fg", "white", "-state", "disabled" };
+ static char *flashArgs[] = {"-bg", "red" };
+ CreateTagEntry(tablePtr, "active", ARSIZE(activeArgs), activeArgs);
+ CreateTagEntry(tablePtr, "sel", ARSIZE(selArgs), selArgs);
+ CreateTagEntry(tablePtr, "title", ARSIZE(titleArgs), titleArgs);
+ CreateTagEntry(tablePtr, "flash", ARSIZE(flashArgs), flashArgs);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindRowColTag --
+ * Finds a row/col tag based on the row/col styles and tagCommand.
+ *
+ * Results:
+ * Returns tag associated with row/col cell, if any.
+ *
+ * Side effects:
+ * Possible side effects from eval of tagCommand.
+ *
+ *----------------------------------------------------------------------
+ */
+TableTag *
+FindRowColTag(Table *tablePtr, int cell, int mode)
+{
+ Tcl_HashTable *hash;
+ Tcl_HashEntry *entryPtr;
+
+ hash = (mode == ROW) ? tablePtr->rowStyles : tablePtr->colStyles;
+ if ((entryPtr = Tcl_FindHashEntry(hash, (char *)cell)) == NULL) {
+ char *cmd = (mode == ROW) ? tablePtr->rowTagCmd : tablePtr->colTagCmd;
+ if (cmd) {
+ register Tcl_Interp *interp = tablePtr->interp;
+ char buf[INDEX_BUFSIZE];
+ /* Since it does not exist, eval command with row/col appended */
+ sprintf(buf, " %d", cell);
+ Tcl_Preserve((ClientData) interp);
+ if (Tcl_VarEval(interp, cmd, buf, (char *)NULL) == TCL_OK) {
+ char *name = Tcl_GetStringResult(interp);
+ if (name && *name) {
+ /* If a result was returned, check to see if it is a known tag */
+ entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, name);
+ }
+ }
+ Tcl_Release((ClientData) interp);
+ Tcl_ResetResult(interp);
+ }
+ }
+ return (TableTag *) (entryPtr ? Tcl_GetHashValue(entryPtr) : NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TableCleanupTag --
+ * Releases the resources used by a tag before it is freed up.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The tag is no longer valid.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TableCleanupTag(Table *tablePtr, TableTag *tagPtr)
+{
+ if (tagPtr->image)
+ Tk_FreeImage(tagPtr->image);
+ /* free the options in the widget */
+ Tk_FreeOptions(tagConfig, (char *) tagPtr, tablePtr->display, 0);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TableTagCmd --
+ * This procedure is invoked to process the tag method
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+int
+TableTagCmd(Table * tablePtr, register Tcl_Interp *interp,
+ int argc, char *argv[])
+{
+ int result = TCL_OK, retval, i, newEntry, value;
+ int row, col;
+ TableTag *tagPtr;
+ Tcl_HashEntry *entryPtr, *scanPtr, *newEntryPtr, *oldEntryPtr;
+ Tcl_HashTable *hashTblPtr;
+ Tcl_HashSearch search;
+ Tk_Image image;
+ char buf[INDEX_BUFSIZE], *keybuf, *yes = "1", *no = "0";
+
+ /* parse the next argument */
+ retval = Cmd_Parse(interp, tag_cmds, argv[2]);
+ switch (retval) {
+ /* failed to parse the argument, error */
+ case 0:
+ return TCL_ERROR;
+
+ case TAG_CELLTAG:
+ /* tag a (group of) cell(s) */
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " tag cell tag ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ /* are we deleting */
+ if (!(*argv[3]))
+ tagPtr = NULL;
+ else {
+ /* check to see if the tag actually exists */
+ if ((entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, argv[3]))==NULL) {
+ /* Unknown tag, just return empty string */
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ return TCL_OK;
+ }
+ /* get the pointer to the tag structure */
+ tagPtr = (TableTag *) Tcl_GetHashValue (entryPtr);
+ }
+
+ /* No more args -> display only */
+ if (argc == 4) {
+ /* Added special handling for tags: active, flash, sel, title */
+
+ if ((tablePtr->flags & HAS_ACTIVE) && strcmp(argv[3], "active") == 0) {
+ TableMakeArrayIndex(tablePtr->activeRow+tablePtr->rowOffset,
+ tablePtr->activeCol+tablePtr->colOffset, buf);
+ Tcl_AppendElement(interp, buf);
+ } else if (tablePtr->flashMode && strcmp(argv[3], "flash") == 0) {
+ for (scanPtr = Tcl_FirstHashEntry(tablePtr->flashCells, &search);
+ scanPtr != NULL; scanPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendElement(interp,
+ Tcl_GetHashKey(tablePtr->flashCells, scanPtr));
+ }
+ } else if (strcmp(argv[3], "sel") == 0) {
+ for (scanPtr = Tcl_FirstHashEntry(tablePtr->selCells, &search);
+ scanPtr != NULL; scanPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendElement(interp,
+ Tcl_GetHashKey(tablePtr->selCells, scanPtr));
+ }
+ } else if (strcmp(argv[3], "title") == 0 &&
+ (tablePtr->titleRows || tablePtr->titleCols)) {
+ for (row = tablePtr->rowOffset;
+ row < tablePtr->rowOffset+tablePtr->rows; row++) {
+ for (col = tablePtr->colOffset;
+ col < tablePtr->colOffset+tablePtr->titleCols; col++) {
+ TableMakeArrayIndex(row, col, buf);
+ Tcl_AppendElement(interp, buf);
+ }
+ }
+ for (row = tablePtr->rowOffset;
+ row < tablePtr->rowOffset+tablePtr->titleRows; row++) {
+ for (col = tablePtr->colOffset+tablePtr->titleCols;
+ col < tablePtr->colOffset+tablePtr->cols; col++) {
+ TableMakeArrayIndex(row, col, buf);
+ Tcl_AppendElement(interp, buf);
+ }
+ }
+ } else {
+ for (scanPtr = Tcl_FirstHashEntry(tablePtr->cellStyles, &search);
+ scanPtr != NULL; scanPtr = Tcl_NextHashEntry(&search)) {
+ /* is this the tag pointer for this cell */
+ if ((TableTag *) Tcl_GetHashValue(scanPtr) == tagPtr) {
+ Tcl_AppendElement(interp,
+ Tcl_GetHashKey(tablePtr->cellStyles, scanPtr));
+ }
+ }
+ }
+ return TCL_OK;
+ }
+ /* Now loop through the arguments and fill in the hash table */
+ for (i = 4; i < argc; i++) {
+ /* can I parse this argument */
+ if (TableGetIndex(tablePtr, argv[i], &row, &col) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ /* get the hash key ready */
+ TableMakeArrayIndex(row, col, buf);
+
+ /* is this a deletion */
+ if (tagPtr == NULL) {
+ oldEntryPtr = Tcl_FindHashEntry(tablePtr->cellStyles, buf);
+ if (oldEntryPtr != NULL)
+ Tcl_DeleteHashEntry(oldEntryPtr);
+ } else {
+ /* add a key to the hash table */
+ newEntryPtr = Tcl_CreateHashEntry(tablePtr->cellStyles, buf,
+ &newEntry);
+
+ /* and set it to point to the Tag structure */
+ Tcl_SetHashValue (newEntryPtr, (ClientData) tagPtr);
+ }
+ /* now invalidate the area */
+ TableRefresh(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset, CELL);
+ }
+ return TCL_OK;
+
+ case TAG_COLTAG:
+ case TAG_ROWTAG:
+ /* tag a row or a column */
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag ", (retval == TAG_ROWTAG) ? "row" :
+ "col", " tag ?arg arg ..?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ /* if the tag is null, we are deleting */
+ if (!(*argv[3]))
+ tagPtr = NULL;
+ else { /* check to see if the tag actually exists */
+ if ((entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, argv[3]))==NULL) {
+ /* Unknown tag, just return empty string */
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ return TCL_OK;
+ }
+ /* get the pointer to the tag structure */
+ tagPtr = (TableTag *) Tcl_GetHashValue (entryPtr);
+ }
+
+ /* and choose the correct hash table */
+ hashTblPtr = (retval == TAG_ROWTAG) ?
+ tablePtr->rowStyles : tablePtr->colStyles;
+
+ /* No more args -> display only */
+ if (argc == 4) {
+ for (scanPtr = Tcl_FirstHashEntry(hashTblPtr, &search);
+ scanPtr != NULL; scanPtr = Tcl_NextHashEntry(&search)) {
+ /* is this the tag pointer on this row */
+ if ((TableTag *) Tcl_GetHashValue (scanPtr) == tagPtr) {
+ sprintf(buf, "%d", (int) Tcl_GetHashKey (hashTblPtr, scanPtr));
+ Tcl_AppendElement(interp, buf);
+ }
+ }
+ return TCL_OK;
+ }
+ /* Now loop through the arguments and fill in the hash table */
+ for (i = 4; i < argc; i++) {
+ /* can I parse this argument */
+ if (Tcl_GetInt(interp, argv[i], &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ /* deleting or adding */
+ if (tagPtr == NULL) {
+ oldEntryPtr = Tcl_FindHashEntry(hashTblPtr, (char *) value);
+ if (oldEntryPtr != NULL)
+ Tcl_DeleteHashEntry(oldEntryPtr);
+ } else {
+ /* add a key to the hash table */
+ newEntryPtr = Tcl_CreateHashEntry(hashTblPtr, (char *) value,
+ &newEntry);
+
+ /* and set it to point to the Tag structure */
+ Tcl_SetHashValue (newEntryPtr, (ClientData) tagPtr);
+ }
+ /* and invalidate the row or column affected */
+ if (retval == TAG_ROWTAG) {
+ TableRefresh(tablePtr, value-tablePtr->rowOffset, 0, ROW);
+ } else {
+ TableRefresh(tablePtr, 0, value-tablePtr->colOffset, COL);
+ }
+ }
+ return TCL_OK; /* COLTAG && ROWTAG */
+
+ case TAG_CGET:
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag cget tagName option\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((entryPtr=Tcl_FindHashEntry(tablePtr->tagTable, argv[3])) == NULL) {
+ Tcl_AppendResult(interp, "invalid tag name \"", argv[3],
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ tagPtr = (TableTag *) Tcl_GetHashValue (entryPtr);
+ result = Tk_ConfigureValue(interp, tablePtr->tkwin, tagConfig,
+ (char *) tagPtr, argv[4], 0);
+ }
+ return result; /* CGET */
+
+ case TAG_CONFIGURE:
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag configure tagName ?arg arg ...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ /* first see if this is a reconfiguration */
+ entryPtr = Tcl_CreateHashEntry(tablePtr->tagTable, argv[3], &newEntry);
+ if (newEntry) {
+ /* create the structure */
+ tagPtr = TableNewTag();
+
+ /* insert it into the table */
+ Tcl_SetHashValue(entryPtr, (ClientData) tagPtr);
+
+ /* configure the tag structure */
+ result = Tk_ConfigureWidget(interp, tablePtr->tkwin, tagConfig,
+ argc - 4, argv + 4, (char *) tagPtr, 0);
+ if (result == TCL_ERROR)
+ return TCL_ERROR;
+ } else {
+ /* pointer wasn't null, do a reconfig if we have enough arguments */
+ /* get the tag pointer from the table */
+ tagPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
+
+ /* 5 args means that there are values to replace */
+ if (argc > 5) {
+ /* and do a reconfigure */
+ result = Tk_ConfigureWidget(interp, tablePtr->tkwin,
+ tagConfig, argc - 4, argv + 4,
+ (char *) tagPtr, TK_CONFIG_ARGV_ONLY);
+ if (result == TCL_ERROR)
+ return TCL_ERROR;
+ }
+ }
+
+ /* handle change of image name */
+ if (tagPtr->imageStr) {
+ image = Tk_GetImage(interp, tablePtr->tkwin, tagPtr->imageStr,
+ TableImageProc, (ClientData)tablePtr);
+ if (image == NULL)
+ result = TCL_ERROR;
+ } else {
+ image = NULL;
+ }
+ if (tagPtr->image) {
+ Tk_FreeImage(tagPtr->image);
+ }
+ tagPtr->image = image;
+
+ /*
+ * If there were less than 6 args, we need
+ * to do a printout of the config, even for new tags
+ */
+ if (argc < 6) {
+ result = Tk_ConfigureInfo(interp, tablePtr->tkwin, tagConfig,
+ (char *) tagPtr, (argc == 5)?argv[4]:0, 0);
+ } else {
+ /* Otherwise we reconfigured so invalidate the table for a redraw */
+ TableInvalidateAll(tablePtr, 0);
+ }
+ return result;
+
+ case TAG_DELETE:
+ /* delete a tag */
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag delete tagName ?tagName ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ /* run through the remaining arguments */
+ for (i = 3; i < argc; i++) {
+ /* cannot delete the title tag */
+ if (strcmp(argv[i], "title") == 0 || strcmp (argv[i], "sel") == 0 ||
+ strcmp(argv[i], "flash") == 0 || strcmp (argv[i], "active") == 0) {
+ Tcl_AppendResult(interp, "cannot delete ", argv[i],
+ " tag", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, argv[i]))!=NULL) {
+ /* get the tag pointer */
+ tagPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
+
+ /* delete all references to this tag in rows */
+ scanPtr = Tcl_FirstHashEntry(tablePtr->rowStyles, &search);
+ for (; scanPtr != NULL; scanPtr = Tcl_NextHashEntry(&search))
+ if ((TableTag *)Tcl_GetHashValue(scanPtr) == tagPtr)
+ Tcl_DeleteHashEntry(scanPtr);
+
+ /* delete all references to this tag in cols */
+ scanPtr = Tcl_FirstHashEntry(tablePtr->colStyles, &search);
+ for (; scanPtr != NULL; scanPtr = Tcl_NextHashEntry(&search))
+ if ((TableTag *)Tcl_GetHashValue(scanPtr) == tagPtr)
+ Tcl_DeleteHashEntry(scanPtr);
+
+ /* delete all references to this tag in cells */
+ scanPtr = Tcl_FirstHashEntry(tablePtr->cellStyles, &search);
+ for (; scanPtr != NULL; scanPtr = Tcl_NextHashEntry(&search))
+ if ((TableTag *)Tcl_GetHashValue(scanPtr) == tagPtr)
+ Tcl_DeleteHashEntry(scanPtr);
+
+ /* release the structure */
+ TableCleanupTag(tablePtr, tagPtr);
+ ckfree((char *) tagPtr);
+
+ /* and free the hash table entry */
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ }
+ /* since we deleted a tag, redraw the screen */
+ TableInvalidateAll(tablePtr, 0);
+ return result;
+
+ case TAG_EXISTS:
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag exists tagName\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_FindHashEntry(tablePtr->tagTable, argv[3]) != NULL) {
+ Tcl_SetResult(interp, yes, TCL_VOLATILE);
+ } else {
+ Tcl_SetResult(interp, no, TCL_VOLATILE);
+ }
+ return TCL_OK;
+
+ case TAG_INCLUDES:
+ /* does a tag contain a index ? */
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " tag includes tag index\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ /* check to see if the tag actually exists */
+ if ((entryPtr = Tcl_FindHashEntry(tablePtr->tagTable, argv[3])) == NULL) {
+ /* Unknown tag, just return no */
+ Tcl_SetResult(interp, no, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ /* parse index */
+ if (TableGetIndex (tablePtr, argv[4], &row, &col) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ /* create hash key */
+ TableMakeArrayIndex(row, col, buf);
+
+ if (strcmp(argv[3], "active") == 0) {
+ if (tablePtr->activeRow+tablePtr->rowOffset == row &&
+ tablePtr->activeCol+tablePtr->colOffset == col)
+ Tcl_SetResult(interp, yes, TCL_VOLATILE);
+ else
+ Tcl_SetResult(interp, no, TCL_VOLATILE);
+ return TCL_OK;
+ } else if (strcmp(argv[3], "flash") == 0) {
+ if (tablePtr->flashMode && Tcl_FindHashEntry(tablePtr->flashCells, buf))
+ Tcl_SetResult(interp, yes, TCL_VOLATILE);
+ else
+ Tcl_SetResult(interp, no, TCL_VOLATILE);
+ return TCL_OK;
+ } else if (strcmp(argv[3], "sel") == 0) {
+ if (Tcl_FindHashEntry(tablePtr->selCells, buf))
+ Tcl_SetResult(interp, yes, TCL_VOLATILE);
+ else
+ Tcl_SetResult(interp, no, TCL_VOLATILE);
+ return TCL_OK;
+ } else if (strcmp(argv[3], "title") == 0) {
+ if (row < tablePtr->titleRows+tablePtr->rowOffset ||
+ col < tablePtr->titleCols+tablePtr->colOffset)
+ Tcl_SetResult(interp, yes, TCL_VOLATILE);
+ else
+ Tcl_SetResult(interp, no, TCL_VOLATILE);
+ return TCL_OK;
+ }
+
+ /* get the pointer to the tag structure */
+ tagPtr = (TableTag *) Tcl_GetHashValue(entryPtr);
+ scanPtr = Tcl_FindHashEntry(tablePtr->cellStyles, buf);
+ /* look to see if there is a cell, row, or col tag for this cell */
+ if ((scanPtr && ((TableTag *) Tcl_GetHashValue(scanPtr) == tagPtr)) ||
+ (tagPtr == FindRowColTag(tablePtr, row, ROW)) ||
+ (tagPtr == FindRowColTag(tablePtr, col, COL))) {
+ /* yes there is - return true */
+ Tcl_SetResult(interp, yes, TCL_VOLATILE);
+ return TCL_OK;
+ }
+ Tcl_SetResult(interp, no, TCL_VOLATILE);
+ return TCL_OK;
+
+ case TAG_NAMES:
+ /* just print out the tag names */
+ if (argc != 3 && argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " tag names ?pattern?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ entryPtr = Tcl_FirstHashEntry(tablePtr->tagTable, &search);
+ while (entryPtr != NULL) {
+ keybuf = Tcl_GetHashKey(tablePtr->tagTable, entryPtr);
+ if (argc == 3 || Tcl_StringMatch(keybuf, argv[3]))
+ Tcl_AppendElement(interp, keybuf);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ return TCL_OK;
+ }
+ return TCL_OK;
+}
+
diff --git a/libgui/src/tkTableWin.c b/libgui/src/tkTableWin.c
new file mode 100644
index 00000000000..b5f337cf1d8
--- /dev/null
+++ b/libgui/src/tkTableWin.c
@@ -0,0 +1,856 @@
+/*
+ * tkTableWin.c --
+ *
+ * This module implements embedded windows for table widgets.
+ * Much of this code is adapted from tkGrid.c and tkTextWind.c.
+ *
+ * Copyright (c) 1998 Jeffrey Hobbs
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include "tkTable.h"
+
+static int StickyParseProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin, char *value,
+ char *widgRec, int offset));
+static char * StickyPrintProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+
+static void EmbWinLostSlaveProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void EmbWinRequestProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+
+static void EmbWinCleanup _ANSI_ARGS_((Table *tablePtr,
+ TableEmbWindow *ewPtr));
+static int EmbWinConfigure _ANSI_ARGS_((Table *tablePtr,
+ TableEmbWindow *ewPtr,
+ int argc, char **argv));
+static void EmbWinStructureProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void EmbWinUnmapNow _ANSI_ARGS_((Tk_Window ewTkwin,
+ Tk_Window tkwin));
+
+static Tk_GeomMgr tableGeomType = {
+ "table", /* name */
+ EmbWinRequestProc, /* requestProc */
+ EmbWinLostSlaveProc, /* lostSlaveProc */
+};
+
+/* windows subcommands */
+#define WIN_CGET 1 /* get config item of embedded window */
+#define WIN_CONFIGURE 2 /* configure an embedded window */
+#define WIN_DELETE 3 /* delete an embedded window */
+#define WIN_MOVE 4 /* moves a window index */
+#define WIN_NAMES 5 /* print the embedded window names */
+static Cmd_Struct win_cmds[] = {
+ {"configure", WIN_CONFIGURE},
+ {"cget", WIN_CGET},
+ {"delete", WIN_DELETE},
+ {"move", WIN_MOVE},
+ {"names", WIN_NAMES},
+ {"", 0}
+};
+
+/* Flag values for "sticky"ness The 16 combinations subsume the packer's
+ * notion of anchor and fill.
+ *
+ * STICK_NORTH This window sticks to the top of its cavity.
+ * STICK_EAST This window sticks to the right edge of its cavity.
+ * STICK_SOUTH This window sticks to the bottom of its cavity.
+ * STICK_WEST This window sticks to the left edge of its cavity.
+ */
+
+#define STICK_NORTH (1<<0)
+#define STICK_EAST (1<<1)
+#define STICK_SOUTH (1<<2)
+#define STICK_WEST (1<<3)
+
+/*
+ * The default specification for configuring embedded windows
+ * Done like this to make the command line parsing easy
+ */
+
+static Tk_CustomOption stickyOption = {StickyParseProc, StickyPrintProc,
+ (ClientData) NULL};
+
+static Tk_ConfigSpec winConfigSpecs[] = {
+ {TK_CONFIG_BORDER, "-background", "background", "Background", NULL,
+ Tk_Offset(TableEmbWindow, bg),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0 },
+ {TK_CONFIG_STRING, "-create", (char *) NULL, (char *) NULL, (char *) NULL,
+ Tk_Offset(TableEmbWindow, create),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
+ {TK_CONFIG_PIXELS, "-padx", (char *) NULL, (char *) NULL, (char *) NULL,
+ Tk_Offset(TableEmbWindow, padX), TK_CONFIG_DONT_SET_DEFAULT },
+ {TK_CONFIG_PIXELS, "-pady", (char *) NULL, (char *) NULL, (char *) NULL,
+ Tk_Offset(TableEmbWindow, padY), TK_CONFIG_DONT_SET_DEFAULT },
+ {TK_CONFIG_CUSTOM, "-sticky", (char *) NULL, (char *) NULL, (char *) NULL,
+ Tk_Offset(TableEmbWindow, sticky), TK_CONFIG_DONT_SET_DEFAULT,
+ &stickyOption},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief", NULL,
+ Tk_Offset(TableEmbWindow, relief), 0 },
+ {TK_CONFIG_WINDOW, "-window", (char *) NULL, (char *) NULL, (char *) NULL,
+ Tk_Offset(TableEmbWindow, tkwin),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK },
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0 }
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StickyPrintProc --
+ * Converts the internal boolean combination of "sticky" bits onto
+ * a TCL string element containing zero or more of n, s, e, or w.
+ *
+ * Results:
+ * A string is placed into the "result" pointer.
+ *
+ * Side effects:
+ * none.
+ *
+ *----------------------------------------------------------------------
+ */
+static char *
+StickyPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Window for text widget. */
+ char *widgRec; /* Pointer to TkTextEmbWindow
+ * structure. */
+ int offset; /* Ignored. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ int flags = ((TableEmbWindow *) widgRec)->sticky;
+ int count = 0;
+ char *result = (char *) ckalloc(5*sizeof(char));
+
+ if (flags&STICK_NORTH) result[count++] = 'n';
+ if (flags&STICK_EAST) result[count++] = 'e';
+ if (flags&STICK_SOUTH) result[count++] = 's';
+ if (flags&STICK_WEST) result[count++] = 'w';
+
+ *freeProcPtr = TCL_DYNAMIC;
+ result[count] = '\0';
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringParseProc --
+ * Converts an ascii string representing a widgets stickyness
+ * into the boolean result.
+ *
+ * Results:
+ * The boolean combination of the "sticky" bits is retuned. If an
+ * error occurs, such as an invalid character, -1 is returned instead.
+ *
+ * Side effects:
+ * none
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+StickyParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* Not used.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window for text widget. */
+ char *value; /* Value of option. */
+ char *widgRec; /* Pointer to TkTextEmbWindow
+ * structure. */
+ int offset; /* Offset into item (ignored). */
+{
+ register TableEmbWindow *ewPtr = (TableEmbWindow *) widgRec;
+ int sticky = 0;
+ char c;
+
+ while ((c = *value++) != '\0') {
+ switch (c) {
+ case 'n': case 'N': sticky |= STICK_NORTH; break;
+ case 'e': case 'E': sticky |= STICK_EAST; break;
+ case 's': case 'S': sticky |= STICK_SOUTH; break;
+ case 'w': case 'W': sticky |= STICK_WEST; break;
+ case ' ': case ',': case '\t': case '\r': case '\n': break;
+ default:
+ Tcl_AppendResult(interp, "bad sticky value \"", --value,
+ "\": must contain n, s, e or w",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ ewPtr->sticky = sticky;
+ return TCL_OK;
+}
+
+/*
+ * ckallocs space for a new embedded window structure and clears the structure
+ * returns the pointer to the new structure
+ */
+static TableEmbWindow *
+TableNewEmbWindow(Table *tablePtr)
+{
+ TableEmbWindow *ewPtr = (TableEmbWindow *) ckalloc(sizeof(TableEmbWindow));
+ ewPtr->tablePtr = tablePtr;
+ ewPtr->tkwin = NULL;
+ ewPtr->hPtr = NULL;
+ ewPtr->bg = NULL;
+ ewPtr->create = NULL;
+ ewPtr->relief = -1;
+ ewPtr->sticky = 0;
+ ewPtr->padX = 0;
+ ewPtr->padY = 0;
+ ewPtr->displayed = 0;
+ return ewPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbWinCleanup --
+ * Releases resources used by an embedded window before it is freed up.
+ *
+ * Results:
+ * Window will no longer be valid.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+EmbWinCleanup(Table *tablePtr, TableEmbWindow *ewPtr)
+{
+ /* free the options in the widget */
+ Tk_FreeOptions(winConfigSpecs, (char *) ewPtr, tablePtr->display, 0);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinDisplay --
+ *
+ * This procedure is invoked by TableDisplay for
+ * mapping windows into cells.
+ *
+ * Results:
+ * Displays or moves window on table screen.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+void
+EmbWinDisplay(Table *tablePtr, Drawable window, TableEmbWindow *ewPtr,
+ TableTag *tagPtr, int x, int y, int width, int height)
+{
+ Tk_Window tkwin = tablePtr->tkwin;
+ Tk_Window ewTkwin = ewPtr->tkwin;
+ int diffx=0; /* Cavity width - slave width. */
+ int diffy=0; /* Cavity hight - slave height. */
+ int sticky = ewPtr->sticky;
+
+
+ if (ewPtr->bg)
+ tagPtr->bg = ewPtr->bg;
+ if (ewPtr->relief != -1)
+ tagPtr->relief = ewPtr->relief;
+
+ x += ewPtr->padX/2;
+ width -= ewPtr->padX;
+ y += ewPtr->padY/2;
+ height -= ewPtr->padY;
+
+ if (width > Tk_ReqWidth(ewPtr->tkwin)) {
+ diffx = width - Tk_ReqWidth(ewPtr->tkwin);
+ width = Tk_ReqWidth(ewPtr->tkwin);
+ }
+ if (height > Tk_ReqHeight(ewPtr->tkwin)) {
+ diffy = height - Tk_ReqHeight(ewPtr->tkwin);
+ height = Tk_ReqHeight(ewPtr->tkwin);
+ }
+ if (sticky&STICK_EAST && sticky&STICK_WEST) {
+ width += diffx;
+ }
+ if (sticky&STICK_NORTH && sticky&STICK_SOUTH) {
+ height += diffy;
+ }
+ if (!(sticky&STICK_WEST)) {
+ x += (sticky&STICK_EAST) ? diffx : diffx/2;
+ }
+ if (!(sticky&STICK_NORTH)) {
+ y += (sticky&STICK_SOUTH) ? diffy : diffy/2;
+ }
+
+ /* If we fall below a specific minimum width/height requirement,
+ * we just unmap the window */
+ if (width < 4 || height < 4) {
+ if (ewPtr->displayed) {
+ EmbWinUnmapNow(ewTkwin, tkwin);
+ }
+ return;
+ }
+
+ if (tkwin == Tk_Parent(ewTkwin)) {
+ if ((x != Tk_X(ewTkwin)) || (y != Tk_Y(ewTkwin))
+ || (width != Tk_Width(ewTkwin)) || (height != Tk_Height(ewTkwin))) {
+ Tk_MoveResizeWindow(ewTkwin, x, y, width, height);
+ }
+ Tk_MapWindow(ewTkwin);
+ } else {
+ Tk_MaintainGeometry(ewTkwin, tkwin, x, y, width, height);
+ }
+ ewPtr->displayed = 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinUnmapNow --
+ * Handles unmapping the window depending on parent.
+ * tkwin should be tablePtr->tkwin.
+ * ewTkwin should be ewPtr->tkwin.
+ *
+ * Results:
+ * Removes the window.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+EmbWinUnmapNow(Tk_Window ewTkwin, Tk_Window tkwin)
+{
+ if (tkwin != Tk_Parent(ewTkwin)) {
+ Tk_UnmaintainGeometry(ewTkwin, tkwin);
+ } else {
+ Tk_UnmapWindow(ewTkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinUnmap --
+ * This procedure is invoked by TableAdjustParams for
+ * unmapping windows managed moved offscreen.
+ * rlo, ... should be in real coords.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Unmaps embedded windows.
+ *
+ *--------------------------------------------------------------
+ */
+void
+EmbWinUnmap(Table *tablePtr, int rlo, int rhi, int clo, int chi)
+{
+ register TableEmbWindow *ewPtr;
+ Tcl_HashEntry *entryPtr;
+ int row, col;
+ char buf[INDEX_BUFSIZE];
+
+ /* we need to deal with things user coords */
+ rlo += tablePtr->rowOffset;
+ rhi += tablePtr->rowOffset;
+ clo += tablePtr->colOffset;
+ chi += tablePtr->colOffset;
+ for (row = rlo; row <= rhi; row++) {
+ for (col = clo; col <= chi; col++) {
+ TableMakeArrayIndex(row, col, buf);
+ if ((entryPtr = Tcl_FindHashEntry(tablePtr->winTable, buf)) != NULL) {
+ ewPtr = (TableEmbWindow *) Tcl_GetHashValue(entryPtr);
+ if (ewPtr->displayed) {
+ ewPtr->displayed = 0;
+ if (ewPtr->tkwin != NULL && tablePtr->tkwin != NULL) {
+ EmbWinUnmapNow(ewPtr->tkwin, tablePtr->tkwin);
+ }
+ }
+ }
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinRequestProc --
+ * This procedure is invoked by Tk_GeometryRequest for
+ * windows managed by the Table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for tkwin, and all its managed siblings, to
+ * be re-arranged at the next idle point.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+EmbWinRequestProc(clientData, tkwin)
+ ClientData clientData; /* Table's information about
+ * window that got new preferred
+ * geometry. */
+ Tk_Window tkwin; /* Other Tk-related information
+ * about the window. */
+{
+ register TableEmbWindow *ewPtr = (TableEmbWindow *) clientData;
+
+ /* resize depends on the sticky */
+ if (ewPtr->displayed && ewPtr->hPtr != NULL) {
+ Table *tablePtr = ewPtr->tablePtr;
+ int row, col, x, y, width, height;
+
+ TableParseArrayIndex(&row, &col,
+ Tcl_GetHashKey(tablePtr->winTable, ewPtr->hPtr));
+ if (TableCellVCoords(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset, &x, &y, &width, &height, 0)) {
+ TableInvalidate(tablePtr, x, y, width, height, 0);
+ }
+ }
+}
+
+static void
+EmbWinRemove(TableEmbWindow *ewPtr)
+{
+ Table *tablePtr = ewPtr->tablePtr;
+
+ ewPtr->tkwin = NULL;
+ ewPtr->displayed = 0;
+ if (tablePtr->tkwin != NULL) {
+ int row, col, x, y, width, height;
+
+ TableParseArrayIndex(&row, &col,
+ Tcl_GetHashKey(tablePtr->winTable, ewPtr->hPtr));
+ if (TableCellVCoords(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset, &x, &y, &width, &height, 0))
+ TableInvalidate(tablePtr, x, y, width, height, 1);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinLostSlaveProc --
+ * This procedure is invoked by Tk whenever some other geometry
+ * claims control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all table-related information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinLostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* Table structure for slave window that
+ * was stolen away. */
+ Tk_Window tkwin; /* Tk's handle for the slave window. */
+{
+ register TableEmbWindow *ewPtr = (TableEmbWindow *) clientData;
+
+ Tk_DeleteEventHandler(ewPtr->tkwin, StructureNotifyMask,
+ EmbWinStructureProc, (ClientData) ewPtr);
+#if 0
+ Tcl_CancelIdleCall(EmbWinDelayedUnmap, (ClientData) ewPtr);
+#endif
+ EmbWinUnmapNow(tkwin, ewPtr->tablePtr->tkwin);
+ EmbWinRemove(ewPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinStructureProc --
+ * This procedure is invoked by the Tk event loop whenever
+ * StructureNotify events occur for a window that's embedded
+ * in a table widget. This procedure's only purpose is to
+ * clean up when windows are deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is disassociated from the window segment, and
+ * the portion of the table is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+EmbWinStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to record describing window item. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ register TableEmbWindow *ewPtr = (TableEmbWindow *) clientData;
+
+ if (eventPtr->type != DestroyNotify) {
+ return;
+ }
+
+ EmbWinRemove(ewPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinDelete --
+ * This procedure is invoked by ... whenever
+ * an embedded window is being deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The embedded window is deleted, if it exists, and any resources
+ * associated with it are released.
+ *
+ *--------------------------------------------------------------
+ */
+void
+EmbWinDelete(register Table *tablePtr, TableEmbWindow *ewPtr)
+{
+ Tcl_HashEntry *entryPtr;
+
+ if (ewPtr->tkwin != NULL) {
+ int row, col, x, y, width, height;
+ entryPtr = ewPtr->hPtr;
+
+ /*
+ * Delete the event handler for the window before destroying
+ * the window, so that EmbWinStructureProc doesn't get called
+ * (we'll already do everything that it would have done, and
+ * it will just get confused).
+ */
+
+ Tk_DeleteEventHandler(ewPtr->tkwin, StructureNotifyMask,
+ EmbWinStructureProc, (ClientData) ewPtr);
+ Tk_DestroyWindow(ewPtr->tkwin);
+
+ if (tablePtr->tkwin != NULL && entryPtr != NULL) {
+ TableParseArrayIndex(&row, &col,
+ Tcl_GetHashKey(tablePtr->winTable, entryPtr));
+ Tcl_DeleteHashEntry(entryPtr);
+
+ if (TableCellVCoords(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset,
+ &x, &y, &width, &height, 0))
+ TableInvalidate(tablePtr, x, y, width, height, 0);
+ }
+ }
+#if 0
+ Tcl_CancelIdleCall(EmbWinDelayedUnmap, (ClientData) ewPtr);
+#endif
+ EmbWinCleanup(tablePtr, ewPtr);
+ ckfree((char *) ewPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+static int
+EmbWinConfigure(tablePtr, ewPtr, argc, argv)
+ Table *tablePtr; /* Information about table widget that
+ * contains embedded window. */
+ TableEmbWindow *ewPtr; /* Embedded window to be configured. */
+ int argc; /* Number of strings in argv. */
+ char **argv; /* Array of strings describing configuration
+ * options. */
+{
+ Tk_Window oldWindow;
+
+ oldWindow = ewPtr->tkwin;
+ if (Tk_ConfigureWidget(tablePtr->interp, tablePtr->tkwin, winConfigSpecs,
+ argc, argv, (char *) ewPtr, TK_CONFIG_ARGV_ONLY)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (oldWindow != ewPtr->tkwin) {
+ ewPtr->displayed = 0;
+ if (oldWindow != NULL) {
+ Tk_DeleteEventHandler(oldWindow, StructureNotifyMask,
+ EmbWinStructureProc, (ClientData) ewPtr);
+ Tk_ManageGeometry(oldWindow, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ EmbWinUnmapNow(oldWindow, tablePtr->tkwin);
+ }
+ if (ewPtr->tkwin != NULL) {
+ Tk_Window ancestor, parent;
+
+ /*
+ * Make sure that the table is either the parent of the
+ * embedded window or a descendant of that parent. Also,
+ * don't allow a top-level window to be managed inside
+ * a table.
+ */
+
+ parent = Tk_Parent(ewPtr->tkwin);
+ for (ancestor = tablePtr->tkwin; ;
+ ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (Tk_IsTopLevel(ancestor)) {
+ badMaster:
+ Tcl_AppendResult(tablePtr->interp, "can't embed ",
+ Tk_PathName(ewPtr->tkwin), " in ",
+ Tk_PathName(tablePtr->tkwin), (char *) NULL);
+ ewPtr->tkwin = NULL;
+ return TCL_ERROR;
+ }
+ }
+ if (Tk_IsTopLevel(ewPtr->tkwin) || (ewPtr->tkwin == tablePtr->tkwin)) {
+ goto badMaster;
+ }
+
+ /*
+ * Take over geometry management for the window, plus create
+ * an event handler to find out when it is deleted.
+ */
+
+ Tk_ManageGeometry(ewPtr->tkwin, &tableGeomType, (ClientData) ewPtr);
+ Tk_CreateEventHandler(ewPtr->tkwin, StructureNotifyMask,
+ EmbWinStructureProc, (ClientData) ewPtr);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TableWindowCmd --
+ * This procedure is invoked to process the window method
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+int
+TableWindowCmd(Table * tablePtr, register Tcl_Interp *interp,
+ int argc, char *argv[])
+{
+ int result = TCL_OK, retval;
+ int row, col, x, y, width, height, i, new;
+ TableEmbWindow *ewPtr;
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ char buf[INDEX_BUFSIZE], *keybuf;
+
+ /* parse the next argument */
+ retval = Cmd_Parse(interp, win_cmds, argv[2]);
+ switch (retval) {
+ /* failed to parse the argument, error */
+ case 0:
+ return TCL_ERROR;
+
+ case WIN_CGET:
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " window cget index option\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((entryPtr=Tcl_FindHashEntry(tablePtr->winTable, argv[3])) == NULL) {
+ Tcl_AppendResult(interp, "no window at index \"", argv[3],
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ ewPtr = (TableEmbWindow *) Tcl_GetHashValue(entryPtr);
+ result = Tk_ConfigureValue(interp, tablePtr->tkwin, winConfigSpecs,
+ (char *) ewPtr, argv[4], 0);
+ }
+ return result; /* CGET */
+
+ case WIN_CONFIGURE:
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " window configure index ?arg arg ...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TableGetIndex(tablePtr, argv[3], &row, &col) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ TableMakeArrayIndex(row, col, buf);
+ entryPtr = Tcl_CreateHashEntry(tablePtr->winTable, buf, &new);
+ if (new) {
+ /* create the structure */
+ ewPtr = TableNewEmbWindow(tablePtr);
+
+ /* insert it into the table */
+ Tcl_SetHashValue(entryPtr, (ClientData) ewPtr);
+ ewPtr->hPtr = entryPtr;
+
+ /* configure the window structure */
+ result = EmbWinConfigure(tablePtr, ewPtr, argc-4, argv+4);
+ if (result == TCL_ERROR) {
+ /* release the structure */
+ EmbWinCleanup(tablePtr, ewPtr);
+ ckfree((char *) ewPtr);
+
+ /* and free the hash table entry */
+ Tcl_DeleteHashEntry(entryPtr);
+ return TCL_ERROR;
+ }
+
+ /* if a window was specified, make sure it exists */
+ } else {
+ /* pointer wasn't null, do a reconfig if we have enough arguments */
+ /* get the window pointer from the table */
+ ewPtr = (TableEmbWindow *) Tcl_GetHashValue(entryPtr);
+
+ /* 5 args means that there are values to replace */
+ if (argc > 5) {
+ /* and do a reconfigure */
+ result = EmbWinConfigure(tablePtr, ewPtr, argc-4, argv+4);
+ if (result == TCL_ERROR)
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * If there were less than 6 args, we need
+ * to do a printout of the config, even for new windows
+ */
+ if (argc < 6) {
+ result = Tk_ConfigureInfo(interp, tablePtr->tkwin, winConfigSpecs,
+ (char *) ewPtr, (argc == 5)?argv[4]:0, 0);
+ } else {
+ /* Otherwise we reconfigured so invalidate the table for a redraw */
+ if (TableCellVCoords(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset,
+ &x, &y, &width, &height, 0)) {
+ TableInvalidate(tablePtr, x, y, width, height, 1);
+ }
+ }
+ return result; /* CONFIGURE */
+
+ case WIN_DELETE:
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " window delete index ?index ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (i = 3; i < argc; i++) {
+ if ((entryPtr = Tcl_FindHashEntry(tablePtr->winTable, argv[i]))!=NULL) {
+ /* get the window pointer */
+ ewPtr = (TableEmbWindow *) Tcl_GetHashValue(entryPtr);
+
+ EmbWinDelete(tablePtr, ewPtr);
+ }
+ }
+ /* clear up anything that might have been placed in the result string */
+ Tcl_SetResult(interp, "", TCL_STATIC);
+ return result;
+
+ case WIN_MOVE:
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " window move oldIndex newIndex\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TableGetIndex(tablePtr, argv[3], &x, &y) == TCL_ERROR ||
+ TableGetIndex(tablePtr, argv[4], &row, &col) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ TableMakeArrayIndex(x, y, buf);
+ if ((entryPtr = Tcl_FindHashEntry(tablePtr->winTable, buf)) == NULL) {
+ Tcl_AppendResult(interp, "no window at index \"", argv[3],
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ /* avoid moving it to the same location */
+ if (x == row && y == col) {
+ return TCL_OK;
+ }
+ /* get the window pointer */
+ ewPtr = (TableEmbWindow *) Tcl_GetHashValue(entryPtr);
+ /* and free the old hash table entry */
+ Tcl_DeleteHashEntry(entryPtr);
+
+ TableMakeArrayIndex(row, col, buf);
+ entryPtr = Tcl_CreateHashEntry(tablePtr->winTable, buf, &new);
+ if (!new) {
+ /* window already there - just delete it */
+ TableEmbWindow *ewPtrDel;
+
+ ewPtrDel = (TableEmbWindow *) Tcl_GetHashValue(entryPtr);
+ /* This prevents the deletion of it's own entry, since we need it */
+ ewPtrDel->hPtr = NULL;
+ EmbWinDelete(tablePtr, ewPtrDel);
+ }
+ /* set the new entry's value */
+ Tcl_SetHashValue(entryPtr, (ClientData) ewPtr);
+ ewPtr->hPtr = entryPtr;
+
+ /* Invalidate old cell */
+ if (TableCellVCoords(tablePtr, x-tablePtr->rowOffset,
+ y-tablePtr->colOffset,
+ &x, &y, &width, &height, 0)) {
+ TableInvalidate(tablePtr, x, y, width, height, 0);
+ }
+ /* Invalidate new cell */
+ if (TableCellVCoords(tablePtr, row-tablePtr->rowOffset,
+ col-tablePtr->colOffset,
+ &x, &y, &width, &height, 0)) {
+ TableInvalidate(tablePtr, x, y, width, height, 0);
+ }
+ break;
+
+ case WIN_NAMES:
+ /* just print out the image names */
+ if (argc != 3 && argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " window names ?pattern?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ entryPtr = Tcl_FirstHashEntry(tablePtr->winTable, &search);
+ while (entryPtr != NULL) {
+ keybuf = Tcl_GetHashKey(tablePtr->winTable, entryPtr);
+ if (argc == 3 || Tcl_StringMatch(keybuf, argv[3]))
+ Tcl_AppendElement(interp, keybuf);
+ entryPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_SetResult(interp,
+ TableCellSort(tablePtr, Tcl_GetStringResult(interp)),
+ TCL_DYNAMIC);
+ break;
+ }
+ return TCL_OK;
+}
diff --git a/libgui/src/tkTable_version.in b/libgui/src/tkTable_version.in
new file mode 100644
index 00000000000..1f035319e59
--- /dev/null
+++ b/libgui/src/tkTable_version.in
@@ -0,0 +1 @@
+TBL_VERSION = 2.1
diff --git a/libgui/src/tkTabletcl.h b/libgui/src/tkTabletcl.h
new file mode 100644
index 00000000000..614106e98b5
--- /dev/null
+++ b/libgui/src/tkTabletcl.h
@@ -0,0 +1,366 @@
+"proc tkTableClipboardKeysyms {copy cut paste} {\n"
+" bind Table <$copy> {tk_tableCopy %W}\n"
+" bind Table <$cut> {tk_tableCut %W}\n"
+" bind Table <$paste> {tk_tablePaste %W}\n"
+"}\n"
+"bind Table <3> {\n"
+" ## You might want to check for row returned if you want to\n"
+" ## restrict the resizing of certain rows\n"
+" %W border mark %x %y\n"
+"}\n"
+"bind Table <B3-Motion> { %W border dragto %x %y }\n"
+"bind Table <1> {\n"
+" if {[winfo exists %W]} {\n"
+" tkTableBeginSelect %W [%W index @%x,%y]\n"
+" focus %W\n"
+" }\n"
+"}\n"
+"bind Table <B1-Motion> {\n"
+" array set tkPriv {x %x y %y}\n"
+" tkTableMotion %W [%W index @%x,%y]\n"
+"}\n"
+"bind Table <Double-1> {\n"
+" # empty\n"
+"}\n"
+"bind Table <ButtonRelease-1> {\n"
+" if {[winfo exists %W]} {\n"
+" tkCancelRepeat\n"
+" %W activate @%x,%y\n"
+" }\n"
+"}\n"
+"bind Table <Shift-1> {tkTableBeginExtend %W [%W index @%x,%y]}\n"
+"bind Table <Control-1> {tkTableBeginToggle %W [%W index @%x,%y]}\n"
+"bind Table <B1-Enter> {tkCancelRepeat}\n"
+"bind Table <B1-Leave> {\n"
+" array set tkPriv {x %x y %y}\n"
+" tkTableAutoScan %W\n"
+"}\n"
+"bind Table <2> {\n"
+" %W scan mark %x %y\n"
+" array set tkPriv {x %x y %y}\n"
+" set tkPriv(mouseMoved) 0\n"
+"}\n"
+"bind Table <B2-Motion> {\n"
+" if {(%x != $tkPriv(x)) || (%y != $tkPriv(y))} { set tkPriv(mouseMoved) 1 }\n"
+" if $tkPriv(mouseMoved) { %W scan dragto %x %y }\n"
+"}\n"
+"bind Table <ButtonRelease-2> {\n"
+" if {!$tkPriv(mouseMoved)} { tk_tablePaste %W [%W index @%x,%y] }\n"
+"}\n"
+"if {[string comp {} [info command event]]} {\n"
+" tkTableClipboardKeysyms <Copy> <Cut> <Paste>\n"
+"} else {\n"
+" tkTableClipboardKeysyms Control-c Control-x Control-v\n"
+"}\n"
+"bind Table <Any-Tab> {\n"
+" # empty to allow Tk focus movement\n"
+"}\n"
+"bind Table <FocusOut> {\n"
+" catch {%W activate active}\n"
+"}\n"
+"bind Table <Shift-Up> {tkTableExtendSelect %W -1 0}\n"
+"bind Table <Shift-Down> {tkTableExtendSelect %W 1 0}\n"
+"bind Table <Shift-Left> {tkTableExtendSelect %W 0 -1}\n"
+"bind Table <Shift-Right> {tkTableExtendSelect %W 0 1}\n"
+"bind Table <Prior> {%W yview scroll -1 pages; %W activate @0,0}\n"
+"bind Table <Next> {%W yview scroll 1 pages; %W activate @0,0}\n"
+"bind Table <Control-Prior> {%W xview scroll -1 pages}\n"
+"bind Table <Control-Next> {%W xview scroll 1 pages}\n"
+"bind Table <Home> {%W see origin}\n"
+"bind Table <End> {%W see end}\n"
+"bind Table <Control-Home> {\n"
+" %W selection clear all\n"
+" %W activate origin\n"
+" %W selection set active\n"
+" %W see active\n"
+"}\n"
+"bind Table <Control-End> {\n"
+" %W selection clear all\n"
+" %W activate end\n"
+" %W selection set active\n"
+" %W see active\n"
+"}\n"
+"bind Table <Shift-Control-Home> {tkTableDataExtend %W origin}\n"
+"bind Table <Shift-Control-End> {tkTableDataExtend %W end}\n"
+"bind Table <Select> {tkTableBeginSelect %W [%W index active]}\n"
+"bind Table <Shift-Select> {tkTableBeginExtend %W [%W index active]}\n"
+"bind Table <Control-slash> {tkTableSelectAll %W}\n"
+"bind Table <Control-backslash> {\n"
+" if {[string match browse [%W cget -selectmode]]} {%W selection clear all}\n"
+"}\n"
+"bind Table <Up> {tkTableMoveCell %W -1 0}\n"
+"bind Table <Down> {tkTableMoveCell %W 1 0}\n"
+"bind Table <Left> {tkTableMoveCell %W 0 -1}\n"
+"bind Table <Right> {tkTableMoveCell %W 0 1}\n"
+"bind Table <Any-KeyPress> {\n"
+" if {[string compare {} %A]} { %W insert active insert %A }\n"
+"}\n"
+"bind Table <BackSpace> {\n"
+" set tkPriv(junk) [%W icursor]\n"
+" if {[string compare {} $tkPriv(junk)] && $tkPriv(junk)} {\n"
+" %W delete active [expr {$tkPriv(junk)-1}]\n"
+" }\n"
+"}\n"
+"bind Table <Delete> {%W delete active insert}\n"
+"bind Table <Escape> {%W reread}\n"
+"bind Table <Return> {\n"
+" %W insert active insert \"\n\"\n"
+"}\n"
+"bind Table <Control-Left> {%W icursor [expr {[%W icursor]-1}]}\n"
+"bind Table <Control-Right> {%W icursor [expr {[%W icursor]+1}]}\n"
+"bind Table <Control-e> {%W icursor end}\n"
+"bind Table <Control-a> {%W icursor 0}\n"
+"bind Table <Control-k> {%W delete active insert end}\n"
+"bind Table <Control-equal> {tkTableChangeWidth %W active 1}\n"
+"bind Table <Control-minus> {tkTableChangeWidth %W active -1}\n"
+"proc tkTableBeginSelect {w el} {\n"
+" global tkPriv\n"
+" if {[scan $el %d,%d r c] != 2} return\n"
+" switch [$w cget -selectmode] {\n"
+" multiple {\n"
+" if {[$w tag includes title $el]} {\n"
+" ## in the title area\n"
+" if {$r < [$w cget -titlerows]+[$w cget -roworigin]} {\n"
+" ## We're in a column header\n"
+" if {$c < [$w cget -titlecols]+[$w cget -colorigin]} {\n"
+" ## We're in the topleft title area\n"
+" set inc topleft\n"
+" set el2 end\n"
+" } else {\n"
+" set inc [$w index topleft row],$c\n"
+" set el2 [$w index end row],$c\n"
+" }\n"
+" } else {\n"
+" ## We're in a row header\n"
+" set inc $r,[$w index topleft col]\n"
+" set el2 $r,[$w index end col]\n"
+" }\n"
+" } else {\n"
+" set inc $el\n"
+" set el2 $el\n"
+" }\n"
+" if [$w selection includes $inc] {\n"
+" $w selection clear $el $el2\n"
+" } else {\n"
+" $w selection set $el $el2\n"
+" }\n"
+" }\n"
+" extended {\n"
+" $w selection clear all\n"
+" if {[$w tag includes title $el]} {\n"
+" if {$r < [$w cget -titlerows]+[$w cget -roworigin]} {\n"
+" ## We're in a column header\n"
+" if {$c < [$w cget -titlecols]+[$w cget -colorigin]} {\n"
+" $w selection set origin end\n"
+" } else {\n"
+" $w selection set $el [$w index end row],$c\n"
+" }\n"
+" } else {\n"
+" ## We're in a row header\n"
+" $w selection set $el $r,[$w index end col]\n"
+" }\n"
+" } else {\n"
+" $w selection set $el\n"
+" }\n"
+" $w selection anchor $el\n"
+" set tkPriv(tablePrev) $el\n"
+" }\n"
+" default {\n"
+" if {![$w tag includes title $el]} {\n"
+" $w selection clear all\n"
+" $w selection set $el\n"
+" set tkPriv(tablePrev) $el\n"
+" }\n"
+" $w selection anchor $el\n"
+" }\n"
+" }\n"
+"}\n"
+"proc tkTableMotion {w el} {\n"
+" global tkPriv\n"
+" if {![info exists tkPriv(tablePrev)]} {\n"
+" set tkPriv(tablePrev) $el\n"
+" return\n"
+" }\n"
+" if {[string match $tkPriv(tablePrev) $el]} return\n"
+" switch [$w cget -selectmode] {\n"
+" browse {\n"
+" $w selection clear all\n"
+" $w selection set $el\n"
+" set tkPriv(tablePrev) $el\n"
+" }\n"
+" extended {\n"
+" scan $tkPriv(tablePrev) %d,%d r c\n"
+" scan $el %d,%d elr elc\n"
+" if {[$w tag includes title $el]} {\n"
+" if {$r < [$w cget -titlerows]+[$w cget -roworigin]} {\n"
+" ## We're in a column header\n"
+" if {$c < [$w cget -titlecols]+[$w cget -colorigin]} {\n"
+" ## We're in the topleft title area\n"
+" $w selection clear anchor end\n"
+" } else {\n"
+" $w selection clear anchor [$w index end row],$c\n"
+" }\n"
+" $w selection set anchor [$w index end row],$elc\n"
+" } else {\n"
+" ## We're in a row header\n"
+" $w selection clear anchor $r,[$w index end col]\n"
+" $w selection set anchor $elr,[$w index end col]\n"
+" }\n"
+" } else {\n"
+" $w selection clear anchor $tkPriv(tablePrev)\n"
+" $w selection set anchor $el\n"
+" }\n"
+" set tkPriv(tablePrev) $el\n"
+" }\n"
+" }\n"
+"}\n"
+"proc tkTableBeginExtend {w el} {\n"
+" if {[string match extended [$w cget -selectmode]] &&\n"
+" [$w selection includes anchor]} {\n"
+" tkTableMotion $w $el\n"
+" }\n"
+"}\n"
+"proc tkTableBeginToggle {w el} {\n"
+" global tkPriv\n"
+" if {[string match extended [$w cget -selectmode]]} {\n"
+" set tkPriv(tablePrev) $el\n"
+" $w selection anchor $el\n"
+" if [$w selection includes $el] {\n"
+" $w selection clear $el\n"
+" } else {\n"
+" $w selection set $el\n"
+" }\n"
+" }\n"
+"}\n"
+"proc tkTableAutoScan {w} {\n"
+" global tkPriv\n"
+" if {![winfo exists $w]} return\n"
+" set x $tkPriv(x)\n"
+" set y $tkPriv(y)\n"
+" if {$y >= [winfo height $w]} {\n"
+" $w yview scroll 1 units\n"
+" } elseif {$y < 0} {\n"
+" $w yview scroll -1 units\n"
+" } elseif {$x >= [winfo width $w]} {\n"
+" $w xview scroll 1 units\n"
+" } elseif {$x < 0} {\n"
+" $w xview scroll -1 units\n"
+" } else {\n"
+" return\n"
+" }\n"
+" tkTableMotion $w [$w index @$x,$y]\n"
+" set tkPriv(afterId) [after 50 tkTableAutoScan $w]\n"
+"}\n"
+"proc tkTableMoveCell {w x y} {\n"
+" global tkPriv\n"
+" if {[catch {$w index active row} r]} return\n"
+" set c [$w index active col]\n"
+" $w activate [incr r $x],[incr c $y]\n"
+" $w see active\n"
+" switch [$w cget -selectmode] {\n"
+" browse {\n"
+" $w selection clear all\n"
+" $w selection set active\n"
+" }\n"
+" extended {\n"
+" $w selection clear all\n"
+" $w selection set active\n"
+" $w selection anchor active\n"
+" set tkPriv(tablePrev) [$w index active]\n"
+" }\n"
+" }\n"
+"}\n"
+"proc tkTableExtendSelect {w x y} {\n"
+" if {[string compare extended [$w cget -selectmode]] ||\n"
+" [catch {$w index active row} r]} return\n"
+" set c [$w index active col]\n"
+" $w activate [incr r $x],[incr c $y]\n"
+" $w see active\n"
+" tkTableMotion $w [$w index active]\n"
+"}\n"
+"proc tkTableDataExtend {w el} {\n"
+" set mode [$w cget -selectmode]\n"
+" if {[string match extended $mode]} {\n"
+" $w activate $el\n"
+" $w see $el\n"
+" if [$w selection includes anchor] {tkTableMotion $w $el}\n"
+" } elseif {[string match multiple $mode]} {\n"
+" $w activate $el\n"
+" $w see $el\n"
+" }\n"
+"}\n"
+"proc tkTableSelectAll {w} {\n"
+" if {[regexp {^(single|browse)$} [$w cget -selectmode]]} {\n"
+" $w selection clear all\n"
+" $w selection set active\n"
+" tkTableHandleType $w [$w index active]\n"
+" } else {\n"
+" $w selection set origin end\n"
+" }\n"
+"}\n"
+"proc tkTableChangeWidth {w i a} {\n"
+" set tmp [$w index $i col]\n"
+" if {[set width [$w width $tmp]] >= 0} {\n"
+" $w width $tmp [incr width $a]\n"
+" } else {\n"
+" $w width $tmp [incr width -$a]\n"
+" }\n"
+"}\n"
+"proc tk_tableCopy w {\n"
+" if {[selection own -displayof $w] == \"$w\"} {\n"
+" clipboard clear -displayof $w\n"
+" catch {clipboard append -displayof $w [selection get -displayof $w]}\n"
+" }\n"
+"}\n"
+"proc tk_tableCut w {\n"
+" if {[selection own -displayof $w] == \"$w\"} {\n"
+" clipboard clear -displayof $w\n"
+" catch {\n"
+" clipboard append -displayof $w [selection get -displayof $w]\n"
+" $w cursel set {}\n"
+" $w selection clear all\n"
+" }\n"
+" }\n"
+"}\n"
+"proc tk_tablePaste {w {cell {}}} {\n"
+" if {[string compare {} $cell]} {\n"
+" if {[catch {selection get -displayof $w} data]} return\n"
+" } else {\n"
+" if {[catch {selection get -displayof $w -selection CLIPBOARD} data]} {\n"
+" return\n"
+" }\n"
+" set cell active\n"
+" }\n"
+" tk_tablePasteHandler $w [$w index $cell] $data\n"
+" if {[$w cget -state] == \"normal\"} {focus $w}\n"
+"}\n"
+"proc tk_tablePasteHandler {w cell data} {\n"
+" set rows [expr {[$w cget -rows]-[$w cget -roworigin]}]\n"
+" set cols [expr {[$w cget -cols]-[$w cget -colorigin]}]\n"
+" set r [$w index $cell row]\n"
+" set c [$w index $cell col]\n"
+" set rsep [$w cget -rowseparator]\n"
+" set csep [$w cget -colseparator]\n"
+" ## Assume separate rows are split by row separator if specified\n"
+" ## If you were to want multi-character row separators, you would need:\n"
+" # regsub -all $rsep $data <newline> data\n"
+" # set data [join $data <newline>]\n"
+" if {[string comp {} $rsep]} { set data [split $data $rsep] }\n"
+" set row $r\n"
+" foreach line $data {\n"
+" if {$row > $rows} break\n"
+" set col $c\n"
+" ## Assume separate cols are split by col separator if specified\n"
+" ## Unless a -separator was specified\n"
+" if {[string comp {} $csep]} { set line [split $line $csep] }\n"
+" ## If you were to want multi-character col separators, you would need:\n"
+" # regsub -all $csep $line <newline> line\n"
+" # set line [join $line <newline>]\n"
+" foreach item $line {\n"
+" if {$col > $cols} break\n"
+" $w set $row,$col $item\n"
+" incr col\n"
+" }\n"
+" incr row\n"
+" }\n"
+"}\n"
diff --git a/libgui/src/tkTreeTable.c b/libgui/src/tkTreeTable.c
new file mode 100644
index 00000000000..1b10608c024
--- /dev/null
+++ b/libgui/src/tkTreeTable.c
@@ -0,0 +1,8070 @@
+/*
+ * tkTreeTable.c
+ *
+ * =====================================================================
+ * Copyright (c) 1997
+ * Cygnus Multix Software GmbH
+ * Autor: Khamis Abuelkomboz
+ *
+ * This tool is modified to mirror a realy full tree. The procedures are
+ * modified for quickly viewing, selecting, scrolling etc.
+ * This tool is faster than the standard list of Tcl/Tk and is still
+ * fast, when more items added to the tree table (100 000 and more),
+ * when at least not a linear list is mirrored (without using accelerator)
+ * and the cache is used.
+ * Supported Feautures:
+ * Selection:
+ * Fully compatible to the listbox widget, with "see", "activate", ...
+ * Movement:
+ * Fully compatible to the listbox.
+ * Toggle:
+ * A sub tree can be toggled to view/hide it.
+ * Images: -image
+ * This is modified to support images too.
+ * Tab positions:
+ * With the flag "-tabs" or "-columns" you can add tab stops to
+ * place text on this tab stops. You must give the tab size and
+ * not the x-position like text widget. I think it's better so.
+ * Search:
+ * compatible to the text widget and supports extra flag "-begins" to
+ * search only a number of characters.
+ * Sort:
+ * This is a usefull method to resort the tree. you can give the
+ * column number to sort items on this. The good thing here, that
+ * every sub tree is sorted as local list and the tree will be not
+ * damaged after sorting, only indeces are changed.
+ * Fullname:
+ * with the method 'fullname' you can get the full tree name from
+ * the item back to it's latest root.
+ * Truncate:
+ * With this flag you can let the widget cut the rest of string
+ * in a tab stop, if the string is too long for it.
+ * Fit States:
+ * -bestfit:
+ * Change tab stop sizes so that all texts fit in there tab stops.
+ * -autofit
+ * Change tab stop sizes so that the current displayed texts fit
+ * in there tab stops.
+ * Toggle viewing a column:
+ * column toggle/view/hide column#:
+ * it's possible to hide a column in the tab stop list.
+ * when a cloumn is hidden, there is no text displayed
+ * on it's position and the tab stop size is changed to the value
+ * in 'tabsMinSpace'
+ * Accelerator (Pathfinder):
+ * Now the treetable is perfect in it's performance. It uses an accelerator
+ * to speed up the display and finding an item, especialy when the treetable
+ * contains some thouthends or some hundert thouthend of entries. It will
+ * still be fast (too fast) like a russan atom roket.
+ *
+ * The treetable as 'a tree' is fast without this accelerator. But when we
+ * use this treetable as list, the entries are localized by linear searching,
+ * this is exactly the problem because the display and selection manipulating
+ * (without accelerator) will be too slow for alot of entries.
+ * That's meen this accelerator works only for the items on the first level
+ * (root).
+ *
+ * This accelerator is disabled by default and must be enabled with
+ * '-accelerator 1'
+ *
+ * It is different as the built in cache. The used cache is only the latest
+ * handled items in the treetable.
+ *
+ * Color managment:
+ * Supports a wide level of selection/fore-, background and bitmap colors.
+ *
+ * Speed of Treetable:
+ * n = number of all items in the tree
+ * depth = depth of the longest sub tree
+ * nr = number of root items (without parents)
+ * ni = max. number items of sons in a sub tree (only one level)
+ * ns = max. number of all items in a sub tree
+ *
+ * TreeTable without CACHE and without Accel. Regular linear list
+ * One Item All items: One Item: All items
+ * Search: O(nr + ni) O(n * (nr + ni)) O(n) O(n^2)
+ * Insert: O(nr + ni) O(n * (nr + ni)) O(n) O(n^2)
+ * Delete: O(nr + ni + ns) O(n * (nr + ni)) O(n) O(n^2)
+ 0-end: - O(n) - O(n)
+ * Display: O(nr + ni) O(n) O(n) O(n)
+ * Select: O(nr + ni) O(n) O(n) O(n)
+ * Toggle: O(nr + ni) - - -
+ * Sort: - O(n^2) - -
+ *
+ * Speed of Treetable with accelerator:
+ * a = accelerator step
+ * Search/Insert/Delete/Display/Select/Toggle: O(nr / a + ni)
+ *
+ * As example a = 1000, nr = 300,000, ni = 0 (a list):
+ * O(300,000/1000 + 0) = 300
+ *
+ **************************************************************************/
+
+#include <config.h>
+
+#include "tclInt.h"
+#include "tkInt.h"
+
+#include <ctype.h>
+
+#ifndef HAVE_STRNCASECMP_DECL
+extern int strncasecmp ();
+#endif
+
+/*#include "tkConfig.h"*/
+#include <X11/Xatom.h>
+#include <X11/Xlib.h>
+#include <X11/Xutil.h>
+
+#include "default.h"
+#include "tkTreeTable.h"
+
+#ifndef IS_ROOT
+#if _WINDOWS
+#define IS_ROOT(c) ((c) == '/' || (c) == '\\')
+#else
+#define IS_ROOT(c) ((c) == '/')
+#endif
+#endif
+
+#define SPACE_PROBLEM
+
+#define CONFIG_OPTIONS_ONLY 0x4000
+
+#define ITEM_HIDDEN -1
+#define ITEM_VIEWED -2
+#define ITEM_UNKNOWN -3
+#define ITEM_TEXT -4
+#define ITEM_NOT_FOUND -5
+
+#define ACTIVE_LINE_HEIGHT 1
+
+enum {
+ TRUNCATE_AUTO,
+ TRUNCATE_PATH,
+ TRUNCATE_NORMAL
+};
+
+#define Min(a,b) (a<b ? a : b)
+#define Max(a,b) (a>b ? a : b)
+
+/*
+ * search for a char. in a string and return it's pointer, otherwise NULL
+ */
+#define NextChar(q, p, c, idx) \
+ q = p; idx = 0; \
+ while (*q != c && *q) \
+ q++, idx++; \
+ if (*q == 0) \
+ q = NULL
+
+#ifdef USE_CACHE
+#define RET_CACHED_INDEX(itemPtr) \
+{ \
+ int i = 0; \
+ while (i<MAX_CACHED) \
+ { \
+ if (tablePtr->cachedItem[i] == itemPtr) \
+ { \
+ return tablePtr->cachedPos[i]; \
+ } \
+ i++; \
+ } \
+}
+
+#define VIEW_CACHE() \
+{ \
+ int i = 0; \
+ while (i<MAX_CACHED) \
+ { \
+ fprintf (stderr, "cache[%i]=(%i, %s)\n", i, \
+ tablePtr->cachedPos[i], \
+ tablePtr->cachedItem[i] ? tablePtr->cachedItem[i]->text : "NULL"); \
+ i++; \
+ } \
+}
+
+#define SET_CACHED(item, pos) \
+{ \
+ if (pos >= 0) \
+ { \
+ if ( \
+ tablePtr->cachedItem [0] != item && \
+ tablePtr->cachedItem [1] != item && \
+ tablePtr->cachedItem [2] != item && \
+ tablePtr->cachedItem [3] != item && \
+ tablePtr->cachedItem [4] != item && \
+ tablePtr->cachedItem [5] != item && \
+ tablePtr->cachedItem [6] != item && \
+ tablePtr->cachedItem [7] != item \
+ ) \
+ { \
+ tablePtr->cachedPos [tablePtr->cacheIndex] = pos; \
+ tablePtr->cachedItem[tablePtr->cacheIndex] = item; \
+ tablePtr->cacheIndex = (tablePtr->cacheIndex+1) % MAX_CACHED; \
+ } \
+ } \
+}
+
+#define RET_CACHED_ITEM(index) \
+{ \
+ int i = 0; \
+ while (i<MAX_CACHED) \
+ { \
+ if (tablePtr->cachedItem[i] != NULL && tablePtr->cachedPos[i] == index) \
+ { \
+ return tablePtr->cachedItem[i]; \
+ } \
+ i++; \
+ } \
+}
+
+#define GET_CACHED_ITEM(item, index) \
+{ \
+ int ii=0; \
+ while (ii<MAX_CACHED) \
+ { \
+ if (tablePtr->cachedItem[ii] != NULL && tablePtr->cachedPos[ii] == index) \
+ { \
+ item = tablePtr->cachedItem[ii]; \
+ } \
+ ii++; \
+ } \
+}
+
+#define FREE_CACHE() \
+{ \
+ int i=0; \
+ while (i<MAX_CACHED) \
+ { \
+ tablePtr->cachedItem[i] = NULL; \
+ tablePtr->cachedPos [i] = -1; \
+ i++; \
+ } \
+ tablePtr->cacheIndex = 0; \
+}
+
+#define FREE_RONG_CACHE(index) \
+{ \
+ int i=0; \
+ while (i<MAX_CACHED) \
+ { \
+ if (tablePtr->cachedPos [i] >= index) \
+ { \
+ tablePtr->cachedItem[i] = NULL; \
+ tablePtr->cachedPos [i] = -1; \
+ } \
+ i++; \
+ } \
+}
+#else
+#define RET_CACHED_INDEX(itemPtr)
+#define SET_CACHED(itemPtr, pos)
+#define RET_CACHED_ITEM(index)
+#define GET_CACHED_ITEM(itemPtr, index)
+#define FREE_RONG_CACHE(index)
+#define FREE_CACHE()
+#endif
+
+#ifdef USE_PARENT_CACHE
+#define FREE_PARENT_CACHE() \
+ tablePtr->cachedParent = -5; \
+ tablePtr->cachedParentPtr = NULL
+#define FREE_RONG_PARENT_CACHE(num) \
+ if (tablePtr->cachedParent >= num) \
+ {\
+ tablePtr->cachedParent = -5; \
+ tablePtr->cachedParentPtr = NULL; \
+ }
+#define GET_CACHED_PARENT(tablePtr, index) \
+ ((tablePtr->cachedParentPtr != NULL && tablePtr->cachedParent == index) \
+ ? tablePtr->cachedParentPtr \
+ : TreeTableFindItem (tablePtr, index))
+#define SET_PARENT_CACHE(Ptr, num) \
+ tablePtr->cachedParentPtr = Ptr, \
+ tablePtr->cachedParent = num
+#else
+#define GET_CACHED_PARENT(tablePtr, index)
+#define FREE_PARENT_CACHE()
+#define FREE_RONG_PARENT_CACHE(num)
+#define SET_PARENT_CACHE(Ptr, num)
+#endif
+
+
+#define TREETABLE_WIDTH(tablePtr) (Tk_Width(tablePtr->tkwin) \
+ - 2*(tablePtr->inset+tablePtr->selBorderWidth))
+#define TREETABLE_NUM_LINES(tablePtr) \
+ ((Tk_Height(tablePtr->tkwin)-2*(tablePtr->borderWidth))) \
+ / tablePtr->lineHeight;
+
+/*
+ * Treetable item coordinates
+ */
+#define ITEM_X(Ptr) (tablePtr->inset \
+ - tablePtr->xOffset \
+ + Ptr->indent*tablePtr->indentWidth)
+/* the index in the following command is the virtual position and not the
+ * realy position
+ */
+#define ITEM_Y(Ptr, vindex) (((vindex - tablePtr->topIndex) * tablePtr->lineHeight) \
+ + tablePtr->inset \
+ + (tablePtr->lineHeight-Ptr->bitmapHeight)/2)
+
+#define ITEM_HEIGHT() tablePtr->lineHeight
+#define ITEM_BITMAP_WIDTH(Ptr) (Ptr->bitmapWidth + tablePtr->bitmapSpace)
+#define ITEM_TEXT_WIDTH(Ptr) tk_TextWidth (((Ptr->fontPtr != NULL) \
+ ? Ptr->fontPtr : tablePtr->defFontPtr, \
+ Ptr->text, Ptr->textLength)
+#define ITEM_WIDTH(Ptr) Ptr->lineWidth
+
+#define ITEM_TEXT_INDENT(itemPtr) (tablePtr->inset \
+ + itemPtr->bitmapWidth \
+ + tablePtr->bitmapSpace \
+ + itemPtr->indent*tablePtr->indentWidth)
+#define ITEM_TEXT_X(itemPtr) (ITEM_TEXT_INDENT(itemPtr)-tablePtr->xOffset)
+
+#ifdef USE_PATHFINDER
+#define FIND_IN_PATHFINDER(pos, retPtr, retPos) \
+ if (tablePtr->pathFinder) \
+ { \
+ PathFinder_t *pf; \
+ for (pf=tablePtr->pathFinder->next; pf; pf=pf->next) \
+ { \
+ if (pf->itemPos < pos) \
+ { \
+ retPos = pf->itemPos; \
+ retPtr = pf->itemPtr; \
+ } \
+ } \
+ }
+#define DELETE_FROM_PATHFINDER(pos) \
+ if (tablePtr->pathFinder) \
+ { \
+ PathFinder_t *pf, *pf1=tablePtr->pathFinder; \
+ for (pf=pf1->next; pf; pf=pf->next) \
+ { \
+ if (pf->itemPos >= pos) \
+ { \
+ pf1->next = NULL; \
+ for (pf1=pf; pf1; ) \
+ { \
+ pf = pf1; \
+ pf1=pf1->next; \
+ ckfree ((char*)pf); \
+ } \
+ break; \
+ } \
+ pf1 = pf; \
+ } \
+ }
+#else
+#define FIND_IN_PATHFINDER(pos, retPtr, retPos)
+#define DELETE_FROM_PATHFINDER(pos)
+#endif
+
+#define TreeTableRedrawRange(tablePtr) \
+ if ((tablePtr->tkwin != NULL) && Tk_IsMapped(tablePtr->tkwin) \
+ && ! (tablePtr->flags & REDRAW_PENDING)) \
+ { \
+ Tk_DoWhenIdle(DisplayTreeTable, (ClientData) tablePtr); \
+ tablePtr->flags |= REDRAW_PENDING; \
+ }
+
+#define Have_PlusMinus(tablePtr) (tablePtr->plusImage != NULL && tablePtr->minusImage != NULL)
+#define Have_Unknown(itemPtr) (itemPtr->unknownFlag)
+
+/*
+ * This is the data kept for each line in the treetable.
+ */
+typedef struct TableItem
+{
+ short bitmapHeight; /* Height of the bitmap */
+ short bitmapWidth; /* Width of the bitmap */
+
+ short indent; /* Indentation level for the line */
+ short lineWidth; /* Width of the line joining this item to
+ * it's ancestor, measured in pixels. */
+ short flags;
+ short fontHeight; /* Height of the font -- includes ascent
+ * and descent */
+
+ Pixmap bitmap; /* Bitmap to display for the line */
+
+ int textLength; /* number of chars in text label */
+ int parent; /* This is the index for the parent
+ * of this node. */
+ int succNum; /* Number of all sons, in sub trees too */
+ int seenNum; /* seen item number of sub tree */
+
+ int unknownFlag; /* Marks that the item COULD have sons in the future */
+
+ GC textGC; /* Graphics context to use for drawing the
+ * text to the screen */
+ GC bitmapGC; /* Graphics context to use for draing the
+ * bitmap to the screen */
+
+ char *text; /* Pointer to the text label string. If
+ * NULL, then there is no label for
+ * the line */
+ char *data; /* Pointer to client data to store
+ * private informations, like flags */
+
+ Tk_Image image; /* we can load images */
+ char *imageString; /* image name */
+
+ Tk_Font fontPtr; /* Font pointer to use for text */
+ XColor *textFgColor; /* Color to write text in */
+
+#ifdef USE_BITMAP_COLORS
+ GC bitmapSelectGC; /* GC to use for bitmap when item selected */
+ GC lineGC; /* Graphics context for the line */
+ XColor *bitmapFgColor; /* foreground color for bitmap */
+ XColor *bitmapBgColor; /* background color for the bitmap */
+ XColor *bitmapSelectFgColor; /* Bitmap Fg color when item selected */
+ XColor *bitmapSelectBgColor; /* Bitmap Bg color when item is selected */
+ XColor *lineFgColor; /* line color */
+#endif
+
+ struct TableItem *succPtr; /* Sons of the tree */
+ struct TableItem *parentPtr; /* Pointer to the TableItem which is our
+ * ancestor, or NULL if we don't have a
+ * parent. */
+ struct TableItem *nextPtr; /* Pointer to the next item in the table */
+} TableItem;
+
+#ifdef USE_PATHFINDER
+/*
+ * This pathfinder is used to accelerate the display routine,
+ * exactly when a single list has too many entries (> 20t).
+ * The Pathfinder saves 'stop stations' every a number of
+ * items in the root list (every 1t as example).
+ * So, when an item is searched, numbered 25t) we will find
+ * an previous item on the position 20t (in 20 Steps ansted of 20t steps)
+ * and we continue normal searching in the left 500 entries, this costs
+ * only time of 20+500 = 520 ansted of 20t.
+ *
+ * The path is built by the treetable routines, as example
+ * display procedure, insertion, deleting ans so on.
+ * The Path is usually refreshed by deleting or adding an item.
+ */
+typedef struct PathFinder_t
+{
+ TableItem* itemPtr;
+ int itemPos;
+ int seenPos;
+ struct PathFinder_t * next;
+} PathFinder_t;
+#endif
+
+/*
+ * Tk has problem with alot of references to the same file
+ * and it take a long time to delete the references of the
+ * image (exponential)
+ *
+ * Here is the solution for this problem, every accessed
+ * image is added to the tree.
+ */
+typedef struct ImageList_t {
+ char *name; /* Image name */
+ Tk_Image image; /* Image object */
+ int width, height;
+ struct ImageList_t *next;
+} ImageList_t;
+
+/*
+ * Data structure used for each widget of type TreeTable in
+ * the interpreter. (This a bastardization of tkListbox.c)
+ */
+typedef struct
+{
+ Tk_Window tkwin; /* Window that embodies the TreeTable. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up. */
+ Display *display; /* Display containing the widget. Used, among
+ * other things, so that resources can be freed
+ * even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with this widget */
+ Tcl_Command widgetCmd; /* Token for listbox's widget command. */
+ int numItems; /* Size of table for the widget */
+ int numViewed; /* number of viewed items, not hidden sub trees */
+ TableItem *itemPtr; /* Pointer to table items -- NULL if there
+ * are none. */
+ int UseAccelerator; /* use pathfinder */
+#ifdef USE_PATHFINDER
+ PathFinder_t *pathFinder; /* To find elements in the middle of the
+ * item list of the treetable, when we
+ * have alot of items (more than 5000) as
+ * root elements
+ * This is requiered for fast displaying the
+ * list.
+ */
+#endif
+
+ ImageList_t *Images; /* list of all used images */
+ int ImagesCount;
+
+#ifdef USE_CACHE
+ TableItem *cachedItem[MAX_CACHED]; /* Heuristec cache */
+ int cachedPos[MAX_CACHED];
+ int cacheIndex; /* points to latest cache position */
+#endif
+#ifdef USE_PARENT_CACHE
+ int cachedParent;
+ TableItem *cachedParentPtr;
+#endif
+
+ /*
+ * Information used when displaying the widget :
+ */
+
+ Tk_3DBorder normalBorder; /* Used for drawing border around the whole
+ * window, plus used for background */
+ int borderWidth; /* Width of 3-D border around window */
+ 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 */
+ XColor *highlightBgColor;
+ /* Color for drawing traversal highlight
+ * area when highlight is off. */
+ XColor *highlightColor; /* 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 defFontPtr; /* Information about text font, or NULL. */
+ int defFontHeight; /* Height of the default font -- includes
+ * ascent and descent */
+ Tk_3DBorder selBorder; /* Borders and backgrounds for selected
+ * items. */
+ int selBorderWidth; /* Width of border around selection */
+ int defLineWidth; /* Default width of child-parent lines */
+ XColor *defTextFgColor; /* Default foreground color for text */
+ XColor *defBitmapFgColor; /* Default foreground for bitmaps */
+ XColor *defBitmapBgColor; /* Default background for bitmaps */
+ XColor *defBitmapSelectFgColor;
+ XColor *defBitmapSelectBgColor;
+ XColor *defLineFgColor; /* Default foreground color for lines */
+ XColor *selFgColorPtr; /* Foreground color for select items */
+ GC selectGC; /* For drawing selected items */
+ GC defTextGC; /* Default graphics context for text */
+ GC defBitmapGC; /* Default graphics context for bitmaps */
+ GC defBitmapSelectGC; /* Default graphics context for bitmaps when
+ * selection is active for the line */
+ GC defLineGC; /* Default graphics context for lines */
+ char *geometry; /* Desired geometry for window. Malloc'ed */
+ int width, height; /* another possibility to configure treetable size */
+ int lineHeight; /* Number of pixels allocated for each line
+ * in the display (tallest out of fonts
+ * or bitmaps */
+ int bitmapSpace; /* Width of empty space between the bitmap
+ * of a line and the text associated with it,
+ * measured in pixels. */
+ int indentWidth; /* Indentation level expressed as number
+ * of pixels from the left side of the
+ * widget. */
+ int topIndex; /* Index of topmost item in the window */
+ int numLines; /* Number of lines(items) that fit
+ * in window at one time */
+ int setGrid; /* Non-zero means pass gridding information
+ * to window manager */
+
+ /*
+ * Image to display when sub tree is hidden
+ */
+ Tk_Image plusImage;
+ char *plusImageString;
+ int plusWidth;
+ int plusHeight;
+
+ /*
+ * Image to display when sub tree is explored
+ */
+ Tk_Image minusImage;
+ char *minusImageString;
+ int minusWidth;
+ int minusHeight;
+
+ /*
+ * Image to display when the state is unknown
+ */
+ Tk_Image unknownImage;
+ char *unknownImageString;
+ int unknownWidth;
+ int unknownHeight;
+
+ Pixmap hiddenBitmap; /* Bitmap to display when sub tree is hidden */
+ Tk_Image hiddenImage; /* Image to display when sub tree is hidden */
+ char *hiddenImageString;
+ int hiddenWidth; /* Bitmap to display when sub tree is hidden */
+ int hiddenHeight; /* Bitmap to display when sub tree is hidden */
+#if 0
+ char * hiddencommand; /* command to execute when a sub tree is toggled */
+#endif
+ char * idlecommand; /* command to execute */
+
+ /*
+ * Information to support horizontal scrolling
+ */
+ int maxWidth; /* Width (in pixels) of widest line in the
+ * widget. */
+ int xScrollUnit; /* Number of pixels in one "unit" for
+ * horizontal scrolling (window scrolls
+ * horizontally in increments of this size).
+ * This is an average character size. */
+ int xOffset; /* The left edge of each line in the treetable
+ * is offset to the left by this many
+ * pixels (0 means no offset, positive
+ * means there is an offset). */
+
+ /*
+ * Information for scanning:
+ */
+
+ int scanMarkX; /* X-position at which scan started (e.g.
+ * button was pressed here). */
+ int scanMarkY; /* Y-position at which scan started (e.g.
+ * button was pressed here). */
+ int scanMarkXOffset; /* Value of "xOffset" field when scan
+ * started. */
+ int scanMarkYIndex; /* Index of line that was at top of window
+ * when scan started. */
+
+
+
+ /*
+ * Information about what's selected, if any
+ */
+ TableItem *lastSelected;
+ int numSelected; /* selected number of items */
+ int selectFirst; /* Index of first selected item (-1 means
+ * nothing selected). */
+ int selectAnchor; /* Line to which the selection is anchored */
+ int exportSelection; /* Non-zero means tie internal value
+ * to X selection. */
+ int fillSelection; /* Non-zero means the selection box will
+ * expand to max. width of window and not
+ * only text region */
+ int active; /* Index of "active" element (the one that
+ * has been selected by keyboard traversal)
+ * -1 means none. */
+ int selectMode; /* MULTI or SINGLE */
+ char* selectModeStr; /* multi or single */
+
+ /*
+ * we support tabs too
+ */
+ int * defTabs; /* converted defualt tab stop list */
+ char *defTabsList; /* Tcl List with defualt tab stops */
+
+ char *tabsList; /* Tcl List with tab stops */
+ int * tabs; /* converted tab list */
+ int tabsNum; /* number of tabs */
+ int tabsMinSpace; /* Min. Space between tow tab stops */
+ int *tabsHidden; /* tabs that are hidden */
+
+ /*
+ * We support right-justify too
+ */
+ char *justify;
+ int *tabsJustify;
+
+ /*
+ * Miscellaneous information ;
+ */
+ Cursor cursor; /* X cursor for the 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 *yScrollCmd; /* Command prefix for communicating with
+ * vertical scrollbar. NULL means no
+ * command to issue. Malloc'ed. */
+ char *xScrollCmd; /* Command prefix for communicating with
+ * horizontal scrollbar. NULL means no
+ * command to issue. Malloc'ed */
+ int flags; /* Various flag bits: see below for
+ * definitions. */
+ int sortedInsertion; /* if this flag is seted, the items will be inserted
+ * on the correct place */
+ int sortNoCase; /* to ignore upper and lower case by comparing
+ * to place items correctly */
+ int sortColumn; /* insert items sorted using the strin in the
+ * tab stop of the given number, default "-1" */
+ int pressX, pressY;
+
+ int BestFit; /* Best fit for tab stops */
+ int AutoFit; /* Change Tab Stop Size of the current
+ * displayed items so that we have best
+ * fit, this flag overrites 'BestFit' */
+ int Truncate; /* Truncate the rest of string */
+ int SplitLines;
+
+ XColor *defSplitLineFgColor; /* Default foreground color for split lines */
+ GC defSplitLineGC; /* Default graphics context for split lines */
+
+ int nativeWindowsMode; /* Convert "/" to "\\" on windows */
+ int TruncateMethode; /* How to truncate column strings */
+ char *TruncateMethodeStr;
+} TreeTable;
+
+static int TreeTableCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp,
+ int argc, Tcl_Obj*argv[]));
+static int TreeTableWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp,
+ int argc, Tcl_Obj *argv[]));
+static void DestroyTreeTable _ANSI_ARGS_((char *memPtr));
+static int ConfigureTreeTable _ANSI_ARGS_((TreeTable *tablePtr,
+ int argc, Tcl_Obj *objv[],
+ int flags));
+static void DisplayTreeTable _ANSI_ARGS_((ClientData clientData));
+static int TreeTableFindIndex _ANSI_ARGS_((TreeTable *tablePtr,
+ TableItem *itemPtr));
+static TableItem * TreeTableFindItem _ANSI_ARGS_((TreeTable *tablePtr, int index));
+static int ConfigureTreeTableItem _ANSI_ARGS_((TreeTable *tablePtr,
+ TableItem *itemPtr,
+ int argc, char **argv,
+ int flags,
+ int mode));
+static TableItem* TreeTableInsertItem _ANSI_ARGS_((TreeTable *tablePtr,
+ int index,
+ TableItem* prevPtr,
+ int argc,
+ char **argv));
+static int TreeTableInsertItems (TreeTable* tablePtr,
+ int index, Tcl_Obj *itemlist,
+ int argc, Tcl_Obj *argv[]);
+static void TreeTableDeleteRange _ANSI_ARGS_((TreeTable *tablePtr,
+ int start, int end));
+static int TreeTableRemoveItem _ANSI_ARGS_((TreeTable *tablePtr,
+ TableItem *itemPtr,
+ int lineNum,
+ int* width,
+ int original_item,
+ int children));
+static void TreeTableFreeItem _ANSI_ARGS_((TreeTable *tablePtr,
+ TableItem *itemPtr));
+static void TreeTableEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int GetTreeTableIndex _ANSI_ARGS_((TreeTable *tablePtr,
+ char *string, int endAfter,
+ int *indexPtr));
+static void ChangeTreeTableView _ANSI_ARGS_((TreeTable *tablePtr,
+ int index, int redraw));
+static void ChangeTreeTableOffset _ANSI_ARGS_((TreeTable *tablePtr,
+ int offset));
+static void TreeTableScanTo _ANSI_ARGS_((TreeTable *tablePtr,
+ int x, int y));
+static int NearestTreeTableItem _ANSI_ARGS_((TreeTable *tablePtr,
+ int y));
+static void TreeTableComputeLineHeight _ANSI_ARGS_((TreeTable *tablePtr, TableItem*thisPtr, int cnt));
+static void TreeTableComputeWidths _ANSI_ARGS_((TreeTable *tablePtr,
+ TableItem *itemPtr,
+ int checkAll));
+
+static int TreeTableFetchSelection _ANSI_ARGS_((ClientData clientData,
+ int offset, char *buffer,
+ int maxBytes));
+static void TreeTableLostSelection _ANSI_ARGS_((ClientData clientData));
+static void TreeTableUpdateVScrollbar (TreeTable *tablePtr);
+static void TreeTableUpdateHScrollbar (TreeTable *tablePtr);
+
+static int TreeTableIndex (TableItem *itemPtr, int index, int pos, TableItem **itemRet);
+static int TreeTableInsertListItem (TreeTable* tablePtr,
+ TableItem*newPtr,
+ TableItem*prevPtr,
+ int index, int *newIndex);
+static int TreeTableFindIndex_x (TableItem *itemPtr, TableItem *srcPtr, int index, int* pos);
+static int TreeTableCountNotHidden (TreeTable*tablePtr, int flag);
+static int TreeTableLostSel (TreeTable* tablePtr, int first, int last);
+static int TreeTableLostSel_x (register TreeTable *tablePtr, TableItem* itemPtr,
+ int *pos, int first, int last);
+static int TreeTableRealyIndex (register TreeTable *tablePtr, int index);
+static int DisplayRecursive (register TreeTable *tablePtr,
+ register TableItem * itemPPtr,
+ register int* pos,
+ register int* realpos,
+ register int limit,
+ register Pixmap pixmap,
+ int calc);
+static int TreeTableCountNotHidden_x (TableItem*itemPtr);
+static void TreeTableImageProc(ClientData clientData,
+ int x, int y,
+ int width, int height,
+ int imgWidth, int imgHeight);
+static void TreeTableGetItems (TreeTable *tablePtr, int from, int to);
+static int TreeTableSearchCmd (TreeTable *tablePtr, int argc,
+ char **argv);
+static int TreeTableFindNotHiddenItem_x (TableItem *itemPtr,
+ int index, int pos,
+ TableItem **itemRet, int next);
+static int TreeTableViewedIndex (register TreeTable *tablePtr, int index);
+static int TreeTableSort(TreeTable *tablePtr, int argc, char **argv);
+static int TreeTableSelectFromTo (TreeTable*tablePtr, TableItem *itemPtr,
+ int pos,
+ int start, int end);
+static int TreeTableGetBBox (TreeTable *tablePtr, int index, int *x, int *y, int *w, int *h);
+static TableItem * TreeTableFindNotHiddenItem (TreeTable *tablePtr, int index, int next);
+static TableItem * TreeTableSortFindPrev(TableItem *listPtr, TableItem *itemPtr,
+ int col, int noCase, int *index);
+static void ComputeTabStops (TreeTable*tablePtr, TableItem *itemPtr);
+
+static int TreeTableToggle (TreeTable* tablePtr, int xx, int yy, int testonly);
+static int TreeTableToggleSubTree (TreeTable* tablePtr, TableItem* itemPtr, int* realpos, int* pos, int xx, int yy, int testonly);
+static int TreeTableToggleItem (TreeTable* tablePtr, TableItem *itemPtr, int hide);
+static void TreeTableToggleIt (TreeTable* tablePtr, TableItem*Ptr);
+
+void ViewArgs (char *reason, int argc, char *argv[], int mode);
+
+#undef TEST_TREE
+#ifdef TEST_TREE
+#ifdef USE_CACHE
+void ViewCache(TreeTable*tablePtr);
+#endif
+#endif
+
+static int InsertedNewPosition = 0;
+
+/*
+ * Information used for argv parsing:
+ */
+static Tk_ConfigSpec itemConfigSpecs[] =
+{
+{TK_CONFIG_PIXELS, "-linewidth", "lineWidth", "LineWidth",
+ NO_TABLEITEM_LINEWIDTH, Tk_Offset(TableItem, lineWidth), 0},
+
+{TK_CONFIG_STRING, "-text", "text", "Text",
+ DEF_TABLEITEM_TEXT, Tk_Offset(TableItem, text),
+ TK_CONFIG_NULL_OK},
+{TK_CONFIG_BITMAP, "-bitmap", "bitmap", "Bitmap",
+ DEF_TABLEITEM_BITMAP, Tk_Offset(TableItem, bitmap),
+ TK_CONFIG_NULL_OK},
+
+ /* image */
+{TK_CONFIG_STRING, "-image", (char *) NULL, (char *) NULL,
+ DEF_TABLEITEM_IMAGE, Tk_Offset(TableItem, imageString),
+ TK_CONFIG_NULL_OK},
+
+
+{TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_TABLEITEM_FONT, Tk_Offset(TableItem, fontPtr),
+ TK_CONFIG_NULL_OK},
+{TK_CONFIG_COLOR, "-textforeground", "textForeground", "Background",
+ DEF_TABLEITEM_TEXTFOREGROUND, Tk_Offset(TableItem, textFgColor),
+ TK_CONFIG_NULL_OK},
+
+#if USE_BITMAP_COLORS
+{TK_CONFIG_COLOR, "-bitmapforeground", "bitmapForeground", "Background",
+ DEF_TABLEITEM_BITMAPFOREGROUND, Tk_Offset(TableItem, bitmapFgColor),
+ TK_CONFIG_NULL_OK},
+{TK_CONFIG_COLOR, "-bitmapbackground", "bitmapBackground", "Background",
+ DEF_TABLEITEM_BITMAPBACKGROUND, Tk_Offset(TableItem, bitmapBgColor),
+ TK_CONFIG_NULL_OK},
+{TK_CONFIG_COLOR, "-bitmapselectfg", "bitmapSelectFg", "Background",
+ DEF_TABLEITEM_BITMAPSELECTFOREGROUND,
+ Tk_Offset(TableItem, bitmapSelectFgColor), TK_CONFIG_NULL_OK},
+{TK_CONFIG_COLOR, "-bitmapselectbg", "bitmapSelectBg", "Background",
+ DEF_TABLEITEM_BITMAPSELECTBACKGROUND,
+ Tk_Offset(TableItem, bitmapSelectBgColor), TK_CONFIG_NULL_OK},
+{TK_CONFIG_COLOR, "-lineforeground", "lineForeground", "Background",
+ DEF_TABLEITEM_LINEFOREGROUND, Tk_Offset(TableItem, lineFgColor),
+ TK_CONFIG_NULL_OK},
+#endif
+{TK_CONFIG_INT, "-indent", "indent", "Indent",
+ DEF_TABLEITEM_INDENT, Tk_Offset(TableItem, indent), 0},
+
+{TK_CONFIG_INT, "-parent", "parent", "Parent",
+ DEF_TABLEITEM_PARENT, Tk_Offset(TableItem, parent), 0},
+
+{TK_CONFIG_INT, "-succnum", "succnum", "SuccNum",
+ DEF_TABLEITEM_SUCCNUM, Tk_Offset(TableItem, succNum), 0},
+{TK_CONFIG_SYNONYM, "-children", "succnum", (char *) NULL,
+ (char *) NULL, 0, 0},
+
+{TK_CONFIG_INT, "-seennum", "seennum", "SeenNum",
+ DEF_TABLEITEM_SEENNUM, Tk_Offset(TableItem, seenNum), 0},
+ /*
+ * Client data
+ */
+{TK_CONFIG_STRING, "-data", "data", "data",
+ DEF_TABLEITEM_DATA, Tk_Offset(TableItem, data),
+ TK_CONFIG_NULL_OK},
+
+{TK_CONFIG_BOOLEAN, "-unknown", "image",
+ "Image",
+ DEF_TREETABLE_UNKNOWN_FLAG,
+ Tk_Offset(TableItem, unknownFlag),
+ 0},
+#if 0
+{TK_CONFIG_INT, "-flags", "flags", "Flags",
+ DEF_TABLEITEM_FLAGS, Tk_Offset(TableItem, flags), 0},
+#endif
+
+{TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+static Tk_ConfigSpec configSpecs[] =
+{
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_TREETABLE_BG_COLOR,
+ Tk_Offset(TreeTable, normalBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_TREETABLE_BG_MONO,
+ Tk_Offset(TreeTable, normalBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0},
+
+ {TK_CONFIG_COLOR, "-bitmapforeground", "bitmapForeground",
+ "Foreground",
+ DEF_TREETABLE_BITMAPFG,
+ Tk_Offset(TreeTable, defBitmapFgColor),
+ 0},
+ {TK_CONFIG_COLOR, "-bitmapbackground", "bitmapBackground",
+ "Foreground",
+ DEF_TREETABLE_BITMAPBG,
+ Tk_Offset(TreeTable, defBitmapBgColor),
+ 0},
+{TK_CONFIG_COLOR, "-bitmapselectfg", "bitmapSelectFg", "Foreground",
+ DEF_TREETABLE_BITMAPSELECTFOREGROUND,
+ Tk_Offset(TreeTable, defBitmapSelectFgColor),
+ TK_CONFIG_NULL_OK},
+{TK_CONFIG_COLOR, "-bitmapselectbg", "bitmapSelectBg", "Background",
+ DEF_TREETABLE_BITMAPSELECTBACKGROUND,
+ Tk_Offset(TreeTable, defBitmapSelectBgColor),
+ TK_CONFIG_NULL_OK},
+{TK_CONFIG_PIXELS, "-bitmapspace", "bitmapSpace", "BitmapSpace",
+ DEF_TREETABLE_BITMAPSPACE,
+ Tk_Offset(TreeTable, bitmapSpace),
+ 0},
+
+{TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_TREETABLE_BORDER_WIDTH,
+ Tk_Offset(TreeTable, borderWidth),
+ 0},
+{TK_CONFIG_SYNONYM, "-bw", "borderWidth", (char *) NULL,
+ (char *) NULL, 0, 0},
+
+{TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_TREETABLE_CURSOR,
+ Tk_Offset(TreeTable, cursor),
+ TK_CONFIG_NULL_OK},
+
+{TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection",
+ DEF_TREETABLE_EXPORT_SELECTION,
+ Tk_Offset(TreeTable, exportSelection),
+ 0},
+
+{TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+{TK_CONFIG_BOOLEAN, "-fillselection", "fillSelection",
+ "FillSelection",
+ DEF_TREETABLE_FILL_SELECTION,
+ Tk_Offset(TreeTable, fillSelection),
+ 0},
+
+{TK_CONFIG_BOOLEAN, "-sortedinsertion", "sortedInsertion",
+ "SortedInsertion",
+ DEF_TREETABLE_SORTED_INSERTION,
+ Tk_Offset(TreeTable, sortedInsertion),
+ 0},
+{TK_CONFIG_BOOLEAN, "-sortnocase", "sortNoCase", "SortNoCase",
+ DEF_TREETABLE_SORT_NOCASE,
+ Tk_Offset(TreeTable, sortNoCase),
+ 0},
+{TK_CONFIG_SYNONYM, "-nocase", "sortNoCase", (char *) NULL,
+ (char *) NULL, 0, 0},
+{TK_CONFIG_BOOLEAN, "-sortcolumn", "sortColumn", "SortColumn",
+ DEF_TREETABLE_SORT_NOCASE,
+ Tk_Offset(TreeTable, sortColumn),
+ 0},
+{TK_CONFIG_SYNONYM, "-col", "sortColumn", (char *) NULL,
+ (char *) NULL, 0, 0},
+
+{TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_TREETABLE_FONT,
+ Tk_Offset(TreeTable, defFontPtr),
+ 0},
+{TK_CONFIG_STRING, "-geometry", "geometry", "Geometry",
+ DEF_TREETABLE_GEOMETRY,
+ Tk_Offset(TreeTable, geometry),
+ 0},
+{TK_CONFIG_INT, "-width", "width", "Width",
+ DEF_TREETABLE_WIDTH,
+ Tk_Offset(TreeTable, width), 0},
+{TK_CONFIG_INT, "-height", "height", "Height",
+ DEF_TREETABLE_HEIGHT,
+ Tk_Offset(TreeTable, height), 0},
+
+ /*
+ * hidden bitmap
+ */
+{TK_CONFIG_BITMAP, "-hiddenbitmap", "hiddenbitmap", "HiddenBitmap",
+ DEF_TABLEITEM_BITMAP,
+ Tk_Offset(TreeTable, hiddenBitmap),
+ TK_CONFIG_NULL_OK},
+
+ /* plus image */
+{TK_CONFIG_STRING, "-plusimage", (char *) NULL, (char *) NULL,
+ DEF_TABLEITEM_IMAGE,
+ Tk_Offset(TreeTable, plusImageString),
+ TK_CONFIG_NULL_OK},
+
+ /* minus image */
+{TK_CONFIG_STRING, "-minusimage", (char *) NULL, (char *) NULL,
+ DEF_TABLEITEM_IMAGE,
+ Tk_Offset(TreeTable, minusImageString),
+ TK_CONFIG_NULL_OK},
+
+ /* unknown image */
+{TK_CONFIG_STRING, "-unknownimage", (char *) NULL, (char *) NULL,
+ DEF_TABLEITEM_IMAGE,
+ Tk_Offset(TreeTable, unknownImageString),
+ TK_CONFIG_NULL_OK},
+
+ /* hidden image */
+{TK_CONFIG_STRING, "-hiddenimage", (char *) NULL, (char *) NULL,
+ DEF_TABLEITEM_IMAGE,
+ Tk_Offset(TreeTable, hiddenImageString),
+ TK_CONFIG_NULL_OK},
+
+{TK_CONFIG_STRING, "-idlecommand", "idleCommand", "IdleCommand",
+ DEF_TABLEITEM_IDLECOMMAND,
+ Tk_Offset(TreeTable, idlecommand),
+ TK_CONFIG_NULL_OK},
+
+#if 0
+{TK_CONFIG_STRING, "-hiddencommand", "hiddencommand", "HiddenCommand",
+ DEF_HIDDEN_COMMAND,
+ Tk_Offset(TreeTable, hiddencommand),
+ TK_CONFIG_NULL_OK},
+#endif
+
+{TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", NORMAL_BG,
+ Tk_Offset(TreeTable, highlightBgColor),
+ 0},
+{TK_CONFIG_COLOR, "-highlightColor", "highlightcolor",
+ "HighlightColor", BLACK,
+ Tk_Offset(TreeTable, highlightColor),
+ 0},
+{TK_CONFIG_PIXELS, "-highlightwidth", "highlightWidth", "HighlightWidth",
+ DEF_TREETABLE_HIGHLIGHT_WIDTH,
+ Tk_Offset(TreeTable, highlightWidth),
+ 0},
+{TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness", "HighlightThickness",
+ DEF_TREETABLE_HIGHLIGHT_WIDTH,
+ Tk_Offset(TreeTable, highlightWidth),
+ 0},
+
+{TK_CONFIG_PIXELS, "-indentwidth", "indentWidth", "BorderWidth",
+ DEF_TREETABLE_INDENTWIDTH,
+ Tk_Offset(TreeTable, indentWidth),
+ 0},
+{TK_CONFIG_COLOR, "-lineforeground", "lineForeground",
+ "Foreground",
+ DEF_TREETABLE_LINEFG,
+ Tk_Offset(TreeTable, defLineFgColor),
+ 0},
+{TK_CONFIG_PIXELS, "-linewidth", "lineWidth", "LineWidth",
+ NO_TREETABLE_LINEWIDTH,
+ Tk_Offset(TreeTable, defLineWidth),
+ 0},
+
+{TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_TREETABLE_RELIEF,
+ Tk_Offset(TreeTable, relief),
+ 0},
+ /* Color for multi colors */
+{TK_CONFIG_BORDER, "-selectbackground", "selectBackground",
+ "Foreground",
+ DEF_TREETABLE_SELECT_COLOR,
+ Tk_Offset(TreeTable, selBorder),
+ TK_CONFIG_COLOR_ONLY},
+ /* color for black/white option */
+{TK_CONFIG_BORDER, "-selectbackground", "selectBackground",
+ "Foreground", DEF_TREETABLE_SELECT_MONO,
+ Tk_Offset(TreeTable, selBorder),
+ TK_CONFIG_MONO_ONLY},
+{TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth",
+ "BorderWidth",
+ DEF_TREETABLE_SELECT_BD,
+ Tk_Offset(TreeTable, selBorderWidth),
+ 0},
+
+ /* Color for multi colors */
+{TK_CONFIG_COLOR, "-selectforeground", "selectForeground",
+ "Background",
+ DEF_TREETABLE_SELECT_FG_COLOR,
+ Tk_Offset(TreeTable, selFgColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+ /* color for black/white option */
+{TK_CONFIG_COLOR, "-selectforeground", "selectForeground",
+ "Background",
+ DEF_TREETABLE_SELECT_FG_MONO,
+ Tk_Offset(TreeTable, selFgColorPtr),
+ TK_CONFIG_MONO_ONLY},
+{TK_CONFIG_BOOLEAN, "-setgrid", "setGrid", "SetGrid",
+ DEF_TREETABLE_SET_GRID,
+ Tk_Offset(TreeTable, setGrid),
+ 0},
+{TK_CONFIG_STRING, "-selectmode", "selectMode", "SelectMode",
+ DEF_TREETABLE_SELECTMODE,
+ Tk_Offset(TreeTable, selectMode),
+ TK_CONFIG_NULL_OK},
+
+{TK_CONFIG_STRING, "-tabs", "tabs", "Tabs",
+ DEF_TREETABLE_TABS,
+ Tk_Offset(TreeTable, tabsList),
+ TK_CONFIG_NULL_OK},
+{TK_CONFIG_STRING, "-deftabs", "defTabs", "DefTabs",
+ DEF_TREETABLE_DEFTABS,
+ Tk_Offset(TreeTable, defTabsList),
+ TK_CONFIG_NULL_OK},
+{TK_CONFIG_STRING, "-justify", "justify", "Justify",
+ DEF_TREETABLE_JUSTIFY,
+ Tk_Offset(TreeTable, justify),
+ TK_CONFIG_NULL_OK},
+{TK_CONFIG_BOOLEAN, "-bestfit", "bestFit", "BestFit",
+ DEF_TREETABLE_BESTFIT,
+ Tk_Offset(TreeTable, BestFit),
+ 0},
+{TK_CONFIG_BOOLEAN, "-autofit", "autoFit", "AutoFit",
+ DEF_TREETABLE_AUTOFIT,
+ Tk_Offset(TreeTable, AutoFit),
+ 0},
+{TK_CONFIG_BOOLEAN, "-truncate", "truncate", "Truncate",
+ DEF_TREETABLE_SPLITLINES,
+ Tk_Offset(TreeTable, Truncate),
+ 0},
+{TK_CONFIG_COLOR, "-splitlineforeground", "splitLineForeground",
+ "Foreground",
+ DEF_TREETABLE_SPLITLINEFG,
+ Tk_Offset(TreeTable, defSplitLineFgColor),
+ 0},
+{TK_CONFIG_BOOLEAN, "-splitlines", "splitLines", "SplitLines",
+ DEF_TREETABLE_TRUNCATE,
+ Tk_Offset(TreeTable, SplitLines),
+ 0},
+{TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_TREETABLE_TAKE_FOCUS,
+ Tk_Offset(TreeTable, takeFocus),
+ TK_CONFIG_NULL_OK},
+{TK_CONFIG_COLOR, "-textforeground", "textForeground",
+ "Foreground",
+ DEF_TREETABLE_TEXTFG,
+ Tk_Offset(TreeTable, defTextFgColor),
+ 0},
+{TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_TREETABLE_SCROLL_COMMAND,
+ Tk_Offset(TreeTable, xScrollCmd),
+ TK_CONFIG_NULL_OK},
+{TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ DEF_TREETABLE_SCROLL_COMMAND,
+ Tk_Offset(TreeTable, yScrollCmd),
+ TK_CONFIG_NULL_OK},
+
+{TK_CONFIG_PIXELS, "-tabfreespace",
+ "tabFreeSpace", "TabFreeSpace",
+ DEF_TABLEITEM_TABFREESPACE, Tk_Offset(TreeTable, tabsMinSpace), 0},
+
+{TK_CONFIG_BOOLEAN, "-accelerator", "accelerator", "Accelerator",
+ DEF_TREETABLE_USE_ACCELERATOR,
+ Tk_Offset(TreeTable, UseAccelerator),
+ 0},
+
+{TK_CONFIG_BOOLEAN, "-windowsmode", "windowsMode", "WindowsMode",
+ DEF_TREETABLE_WINDOWSMODE,
+ Tk_Offset(TreeTable, nativeWindowsMode),
+ 0},
+
+{TK_CONFIG_STRING, "-truncatemethode", "truncateMethode", "TruncateMethode",
+ DEF_TREETABLE_TRUNCATEMETHODE,
+ Tk_Offset(TreeTable, TruncateMethodeStr),
+ 0},
+
+#ifdef USE_PATHFINDER
+#endif
+
+{TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/******************************************************************************/
+#define O_STR(i) Tcl_GetStringFromObj(objv[i], NULL)
+#define ONAME_STR(obj, i) Tcl_GetStringFromObj(obj, [i], NULL)
+
+static char ** Construct_Argv (int argc, Tcl_Obj**objv)
+{
+ char **argv;
+ int i;
+ argv = (char**)ckalloc(sizeof(char**)*argc);
+ for (i=0; i<argc; i++)
+ {
+ argv[i] = O_STR(i);
+ }
+ return argv;
+}
+#define Free_Argv(x) ckfree((char *)x)
+/******************************************************************************/
+
+
+static void
+TreeTableDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ register TreeTable *tablePtr = (TreeTable *) clientData;
+ Tk_Window tkwin = tablePtr->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)
+ {
+ if (tablePtr->setGrid)
+ {
+ Tk_UnsetGrid(tablePtr->tkwin);
+ }
+ tablePtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *-------------------------------------------------------------------
+ *
+ * TreeTableCmd --
+ *
+ * This procedure is invoked to process the "treetable" Tcl
+ * command. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side Effects:
+ * See the user documentation
+ *
+ *-------------------------------------------------------------------
+ TreeTableCmd
+ */
+
+static int
+TreeTableCmd(ClientData clientData, /* Main window associated with interpreter */
+ Tcl_Interp *interp, /* Current interpreter */
+ int argc, /* number of arguments */
+ Tcl_Obj *objv[]) /* argument strings */
+{
+ register TreeTable *tablePtr;
+ Tk_Window nnew;
+ Tk_Window tkwin = (Tk_Window) clientData;
+
+ if (argc < 2)
+ {
+ Tcl_WrongNumArgs (interp, 1, objv, "pathName ?options?");
+ return TCL_ERROR;
+ }
+
+ nnew = Tk_CreateWindowFromPath(interp, tkwin, O_STR(1), (char *) NULL);
+ if (nnew == (Tk_Window) NULL)
+ {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Initialize the fields of the structure that won't be initialized
+ * by ConfigureTreeTable, or that ConfigureTreeTable requires to be
+ * initialized already (e.g. resource pointers).
+ */
+ tablePtr = (TreeTable *) ckalloc(sizeof(TreeTable));
+ memset (tablePtr, 0, sizeof (TreeTable));
+ if (tablePtr==NULL)
+ {
+ Tcl_SetResult (interp, "can't allocate memory for treetable\n", TCL_STATIC);
+ return TCL_ERROR;
+ }
+ tablePtr->tkwin = nnew;
+ tablePtr->display = Tk_Display(nnew);
+ tablePtr->interp = interp;
+
+ tablePtr->relief = TK_RELIEF_RAISED;
+ tablePtr->defLineWidth = -1;
+ tablePtr->maxWidth = 10;
+ tablePtr->selectFirst = -1;
+ tablePtr->active=-1;
+ tablePtr->TruncateMethodeStr = NULL;
+ tablePtr->TruncateMethode = TRUNCATE_AUTO;
+
+ FREE_CACHE();
+ FREE_PARENT_CACHE();
+
+#if 0
+ Tk_CreateEventHandler(tablePtr->tkwin,
+ ButtonPressMask,
+ TreeTablePressProc, (ClientData) tablePtr);
+ Tk_CreateEventHandler(tablePtr->tkwin,
+ ButtonReleaseMask,
+ TreeTableReleaseProc, (ClientData) tablePtr);
+#endif
+
+ Tk_SetClass(tablePtr->tkwin, "TreeTable");
+ Tk_CreateEventHandler(tablePtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ TreeTableEventProc, (ClientData) tablePtr);
+ Tk_CreateSelHandler(tablePtr->tkwin, XA_PRIMARY, XA_STRING,
+ TreeTableFetchSelection, (ClientData) tablePtr,
+ XA_STRING);
+ tablePtr->widgetCmd = Tcl_CreateObjCommand(interp, Tk_PathName(tablePtr->tkwin),
+ (Tcl_ObjCmdProc *)TreeTableWidgetCmd,
+ (ClientData) tablePtr,
+ (Tcl_CmdDeleteProc *)TreeTableDeletedProc);
+ if (ConfigureTreeTable(tablePtr, argc-2, objv+2, 0) != TCL_OK)
+ {
+ Tk_DestroyWindow(tablePtr->tkwin);
+ return TCL_ERROR;
+ }
+ interp->result = Tk_PathName(tablePtr->tkwin);
+ return TCL_OK;
+}
+
+/* This is how the treetable widget is created. This returns a
+ standard Tcl result. */
+
+int
+create_treetable_command (Tcl_Interp *interp)
+{
+ if (Tcl_CreateObjCommand (interp, "treetable",
+ (Tcl_ObjCmdProc *)TreeTableCmd,
+ (ClientData)Tk_MainWindow (interp),
+ NULL) == NULL)
+ {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+static int
+TreeTableBuildSelection (Tcl_Interp *interp, TableItem*itemPtr, int pos)
+{
+ TableItem* Ptr;
+ int i = pos;
+ char index[20];
+ for (Ptr=itemPtr; Ptr != NULL; Ptr=Ptr->nextPtr)
+ {
+ if (Ptr->flags&ITEM_SELECTED)
+ {
+ sprintf (index, "%d", i);
+ Tcl_AppendElement(interp, index);
+ }
+ i++;
+ if (Ptr->succPtr != NULL)
+ {
+ i = TreeTableBuildSelection (interp, Ptr->succPtr, i);
+ }
+ }
+ return i;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TreeTableWidgetCmd --
+ *
+ * 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
+TreeTableWidgetCmd(
+ ClientData clientData, /* Information about the treetable
+ * widget */
+ Tcl_Interp *interp, /* Current interpreter */
+ int argc, /* Number of arguments. */
+ Tcl_Obj *objv[]) /* Argument strings */
+{
+ register TreeTable *tablePtr = (TreeTable *) clientData;
+ register TableItem *itemPtr, *Ptr;
+ register char c, *cmd, *cmd2;
+ char **strv;
+ register int result = TCL_OK;
+ register int length;
+ int index;
+ char tmp [256];
+ Tcl_Obj *errm;
+
+ errm = Tcl_NewObj();
+
+ Tcl_Preserve((ClientData) tablePtr);
+
+ if (argc < 2)
+ {
+ Tcl_AppendStringsToObj (errm, "option ?arg arg ...?", (char *) NULL);
+ Tcl_WrongNumArgs(interp, 1, objv, Tcl_GetStringFromObj(errm, NULL));
+ goto error;
+ }
+
+ cmd = Tcl_GetStringFromObj(objv[1], NULL);
+ c = cmd[0];
+ length = strlen(cmd);
+ if ((c == 'a') && (strncmp(cmd, "activate", length) == 0))
+ {
+ int next = 1;
+ if (argc < 3 || argc > 4)
+ {
+ Tcl_WrongNumArgs(interp, 2, objv, "index ?next|prev|1|-1?");
+ goto error;
+ }
+ if (GetTreeTableIndex(tablePtr, O_STR(2), 0, &index) != TCL_OK)
+ {
+ goto error;
+ }
+ if (argc == 4 && Tcl_GetInt(interp, O_STR(3), &next) != TCL_OK)
+ {
+ goto error;
+ }
+
+ /* an item in a hidden sub tree can't be activeted */
+ Ptr = TreeTableFindNotHiddenItem (tablePtr, index, next);
+ if (Ptr == NULL)
+ {
+ Ptr = TreeTableFindItem (tablePtr, index);
+ if (Ptr) for (Ptr=Ptr->parentPtr; Ptr; Ptr=Ptr->parentPtr)
+ {
+ if (Ptr->flags & ITEM_HIDDEN_SUBTREE)
+ {
+ index = TreeTableFindIndex (tablePtr, Ptr);
+ if (Ptr->nextPtr != NULL)
+ index ++;
+ break;
+ }
+ }
+ }
+ else
+ {
+ index = TreeTableFindIndex (tablePtr, Ptr);
+ }
+ tablePtr->active = index;
+ TreeTableRedrawRange(tablePtr);
+ }
+ else if ((c == 'c') && (strncmp(cmd, "cget", length) == 0) && (length >= 2))
+ {
+ char *p;
+ int i;
+ int tw;
+
+ if (argc != 3)
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "option");
+ goto error;
+ }
+
+ /* the tab stops are changed
+ * immediatly and we must reset the tab stop
+ * string before returning the values
+ */
+ if (tablePtr->tabsList != NULL)
+ {
+ if (tablePtr->tabsList != NULL)
+ {
+ ckfree ((char*)tablePtr->tabsList);
+ }
+ tablePtr->tabsList = (char*)ckalloc (sizeof (char) * tablePtr->tabsNum * 32);
+ p = tablePtr->tabsList;
+ p[0] = 0;
+ for (i=0; i<tablePtr->tabsNum; i++)
+ {
+ if (tablePtr->tabsHidden[i])
+ {
+ if (i==0 && tablePtr->itemPtr!=NULL)
+ {
+ tw = Max (0, ITEM_TEXT_X(tablePtr->itemPtr));
+ }
+ else
+ {
+#ifdef SPACE_PROBLEM
+ tw = 0;
+#else
+ tw = tablePtr->tabsMinSpace;
+#endif
+ }
+ }
+ else
+ {
+ tw = tablePtr->tabs[i];
+ }
+ sprintf (p+strlen(p), *p ? " %i" : "%i", tw);
+ }
+ }
+
+ result = Tk_ConfigureValue(interp, tablePtr->tkwin, configSpecs,
+ (char *) tablePtr, O_STR(2), 0);
+ }
+ else if ((c == 'c') && (strncmp(cmd, "configure", length) == 0)
+ && (length > 2))
+ {
+
+ if (argc == 2)
+ {
+ result = Tk_ConfigureInfo(interp, tablePtr->tkwin, configSpecs,
+ (char *) tablePtr, (char *) NULL, 0);
+ }
+ else if (argc == 3)
+ {
+ result = Tk_ConfigureInfo(interp, tablePtr->tkwin, configSpecs,
+ (char *) tablePtr, O_STR(2), 0);
+ }
+ else
+ {
+ result = ConfigureTreeTable(tablePtr, argc-2, objv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ }
+ else if ((c == 'c') && (strncmp(cmd, "curselection", length) == 0)
+ && length >= 2)
+ {
+ if (argc != 2)
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "");
+ goto error;
+ }
+
+ /* build and return selection list */
+ TreeTableBuildSelection (interp, tablePtr->itemPtr, 0);
+
+ }
+ else if ((c == 'r') && (strncmp(cmd, "remove", length) == 0))
+ {
+ int i, lineWidth=0;
+ int deleteChildren = 0, cnt = 0;
+ TableItem*Ptr;
+
+ if (argc < 3 || argc > 4)
+ {
+ RemoveError:
+ Tcl_WrongNumArgs (interp, 2, objv, "?children? index");
+ goto error;
+ }
+ if (GetTreeTableIndex(tablePtr, O_STR(argc-1), 0, &i) != TCL_OK)
+ {
+ goto error;
+ }
+
+ /* verify if delete children only */
+ if (argc == 4)
+ {
+ if (strncmp(O_STR(2), "children", strlen (O_STR(2))) == 0)
+ {
+ deleteChildren = 1;
+ }
+ else
+ {
+ goto RemoveError;
+ }
+ }
+ itemPtr = TreeTableFindItem(tablePtr, i);
+ if (itemPtr == (TableItem *) NULL)
+ {
+ Tcl_AppendResult (interp, "Error obtaining item of index : ",
+ O_STR(argc-1), (char *) NULL);
+ goto error;
+ }
+ if (!deleteChildren)
+ {
+ TreeTableRemoveItem(tablePtr, itemPtr, i, &lineWidth, 1, 0);
+ cnt = 1;
+ }
+ /* delete all children, but don't delete the item */
+ else
+ {
+ int start = i+1, end = i;
+ for (Ptr=itemPtr->succPtr; Ptr; Ptr=Ptr->nextPtr)
+ {
+ end += 1 + Ptr->succNum;
+ }
+ if (end >= start)
+ {
+ TreeTableDeleteRange(tablePtr, start, end);
+ cnt = end - start + 1;
+ }
+ }
+
+ sprintf (tmp, "%i", cnt);
+ Tcl_ResetResult (interp);
+ Tcl_AppendResult (interp, tmp, NULL);
+ }
+ else if ((c == 'd') && (strncmp(cmd, "delete", length) == 0))
+ {
+ int start,end;
+
+ if (argc < 3 || argc > 4)
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "start ?end?");
+ goto error;
+ }
+ if (GetTreeTableIndex(tablePtr, O_STR(2), 0, &start) != TCL_OK)
+ {
+ Tcl_AppendResult (interp, "Bad starting index.", (char *) NULL);
+ goto error;
+ }
+ if (argc > 3)
+ {
+ if (GetTreeTableIndex(tablePtr, O_STR(3), 0, &end) != TCL_OK)
+ {
+ Tcl_AppendResult (interp, "Bad ending index.", (char *) NULL);
+ goto error;
+ }
+ }
+ else
+ {
+ end = start;
+ }
+ if (end < start)
+ {
+ end = start;
+ }
+ TreeTableDeleteRange(tablePtr, start, end);
+ }
+ else if ((c == 'g') && (strncmp(cmd, "get", length) == 0))
+ {
+ int to;
+
+ if (argc < 3 || argc > 4)
+ {
+ get_invalid_args:
+ Tcl_WrongNumArgs (interp, 2, objv, "index ?to?");
+ goto error;
+ }
+ if (GetTreeTableIndex(tablePtr, O_STR(2), 0, &index) != TCL_OK)
+ {
+ goto get_invalid_args;
+ }
+ to = index;
+ if (argc == 4 && GetTreeTableIndex(tablePtr, O_STR(3), 0, &to) != TCL_OK)
+ {
+ goto get_invalid_args;
+ }
+ if (index < 0)
+ {
+ index = 0;
+ }
+ if (index >= tablePtr->numItems)
+ {
+ index = tablePtr->numItems-1;
+ }
+ /* find item */
+ if (argc == 3)
+ {
+ itemPtr = TreeTableFindItem (tablePtr, index);
+ if (itemPtr != NULL)
+ {
+ interp->result = itemPtr->text; /*CHG*/
+ }
+ }
+ /* find a couple of items */
+ else
+ {
+ TreeTableGetItems (tablePtr, index, to);
+ }
+ }
+ else if ((c == 'i') && (strncmp(cmd, "insert", length) == 0))
+ {
+ TableItem* newPtr;
+ if (argc < 3)
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "index ?list <list>? ?option1 option2 ...?");
+ goto error;
+ }
+ if (GetTreeTableIndex(tablePtr, O_STR(2), 1, &index) != TCL_OK)
+ {
+ goto error;
+ }
+
+ /* add a copple of items with same options */
+ if (strcmp (O_STR(3), "list") == 0)
+ {
+ int ret = TreeTableInsertItems (tablePtr, index, objv[4], argc-5, objv+5);
+ if (ret != TCL_OK)
+ goto error;
+ else
+ goto done;
+ }
+ InsertedNewPosition = index;
+
+ /*
+ * Add only one item
+ */
+ strv = Construct_Argv(argc-3, objv+3);
+ newPtr = TreeTableInsertItem(tablePtr, index, NULL, argc-3, strv);
+ Free_Argv(strv);
+
+ if (newPtr == NULL)
+ {
+ Tcl_AppendResult (interp, "can not add item", NULL);
+ goto error;
+ }
+ sprintf (tmp, "%i", InsertedNewPosition);
+ Tcl_ResetResult (interp);
+ Tcl_AppendResult (interp, tmp, (char*) NULL);
+ }
+ else if ((c == 'd') && (strncmp(cmd, "display", length) == 0))
+ {
+ if (argc != 2)
+ {
+ Tcl_WrongNumArgs (interp, 1, objv, "display");
+ goto error;
+ }
+ DisplayTreeTable ((ClientData)tablePtr);
+ }
+ else if ((c == 'i') && (strncmp(cmd, "itemconfigure", length) == 0))
+ {
+ if (argc < 3)
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "index ?option val ...?");
+ goto error;
+ }
+ if (GetTreeTableIndex (tablePtr, O_STR(2), 0, &index) != TCL_OK)
+ {
+ goto error;
+ }
+ itemPtr = (TableItem *) TreeTableFindItem(tablePtr, index);
+ if (itemPtr == (TableItem *) NULL)
+ {
+ char s[20];
+
+ sprintf(s, "%d", index);
+ Tcl_AppendResult(interp, "Unable to locate item with index: \"",
+ s, "\"", (char *) NULL);
+ goto error;
+ }
+
+ /* set realy parent */
+ itemPtr->parent = TreeTableFindIndex (tablePtr, itemPtr->parentPtr);
+
+ if (argc == 3)
+ {
+ result = Tk_ConfigureInfo(interp, tablePtr->tkwin, itemConfigSpecs,
+ (char *)itemPtr, (char *) NULL, 0);
+ }
+ else if (argc == 4)
+ {
+ result = Tk_ConfigureInfo(interp,
+ tablePtr->tkwin, itemConfigSpecs,
+ (char *) itemPtr, O_STR(3), 0);
+ }
+ else
+ {
+ strv = Construct_Argv(argc-3, objv+3);
+ result = ConfigureTreeTableItem(tablePtr, itemPtr, argc-3,
+ strv, TK_CONFIG_ARGV_ONLY, 0);
+ Free_Argv (strv);
+ }
+ }
+ else if ((c == 'i') && (strncmp(cmd, "itemcget", length) == 0))
+ {
+ if (argc != 4)
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "index ?option?");
+ goto error;
+ }
+ if (GetTreeTableIndex(tablePtr, O_STR(2), 0, &index) != TCL_OK)
+ {
+ goto error;
+ }
+ itemPtr = (TableItem *) TreeTableFindItem(tablePtr, index);
+ if (itemPtr == (TableItem *) NULL)
+ {
+ char s[20];
+
+ sprintf(s, "%d", index);
+ Tcl_AppendResult(interp, "Unable to locate item with index: \"",
+ s, "\"", (char *) NULL);
+ goto error;
+ }
+
+ /* set realy parent */
+ itemPtr->parent = TreeTableFindIndex (tablePtr, itemPtr->parentPtr);
+ result = Tk_ConfigureValue (interp, tablePtr->tkwin, itemConfigSpecs,
+ (char *) itemPtr, O_STR(3), 0);
+ }
+ else if ((c == 'n') && (strncmp(cmd, "nearest", length) == 0))
+ {
+ int y;
+
+ if (argc != 3)
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "y");
+ goto error;
+ }
+ if (Tcl_GetInt(interp, O_STR(2), &y) != TCL_OK)
+ {
+ goto error;
+ }
+ index = NearestTreeTableItem(tablePtr, y);
+ sprintf(interp->result, "%d", index);
+ } else if ((c == 'i') && (strncmp(cmd, "index", length) == 0)) {
+ if (argc != 3)
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "index");
+ goto error;
+ }
+ if (GetTreeTableIndex (tablePtr, O_STR(2), 0, &index) != TCL_OK)
+ {
+ goto error;
+ }
+ sprintf(interp->result, "%d", index);
+ }
+ else if ((c == 'p') && (length >= 2) && (strncmp(cmd, "parent", length) == 0))
+ {
+ int parent;
+
+ if (argc != 3)
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "index");
+ goto error;
+ }
+ if (GetTreeTableIndex(tablePtr, O_STR(2), 0, &index)
+ != TCL_OK)
+ {
+ goto error;
+ }
+ itemPtr = (TableItem *) TreeTableFindItem(tablePtr, index);
+ if (itemPtr == (TableItem *) NULL)
+ {
+ Tcl_AppendResult (interp, "invalid treetable index: \"",
+ O_STR(2), "\"", (char *) NULL);
+ goto error;
+ }
+ if (itemPtr->parentPtr == (TableItem *) NULL)
+ {
+ interp->result[0] = (char) NULL;
+ }
+ else
+ {
+ parent = TreeTableFindIndex(tablePtr, itemPtr->parentPtr);
+ if (parent == -1)
+ {
+ Tcl_AppendResult(interp, "invalid treetable index: \"",
+ O_STR(2), "\"", (char *) NULL);
+ goto error;
+ }
+ sprintf(interp->result, "%d", parent);
+ }
+ }
+ else if ((c == 's') && (length >= 2)
+ && (strncmp(cmd, "scan", length) == 0))
+ {
+ int x,y;
+
+ if (argc != 5)
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "mark|dragto x y");
+ goto error;
+ }
+ if ((Tcl_GetInt(interp, O_STR(3), &x) != TCL_OK) ||
+ (Tcl_GetInt(interp, O_STR(4), &y) != TCL_OK))
+ {
+ goto error;
+ }
+ if (strncmp(O_STR(2), "mark", strlen(O_STR(2))) == 0)
+ {
+ tablePtr->scanMarkX = x;
+ tablePtr->scanMarkY = y;
+ tablePtr->scanMarkXOffset = tablePtr->xOffset;
+ tablePtr->scanMarkYIndex = tablePtr->topIndex;
+ }
+ else if (strncmp(O_STR(2), "dragto", strlen(O_STR(2))) == 0)
+ {
+ TreeTableScanTo(tablePtr, x, y);
+ }
+ else
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "mark|dragto");
+ goto error;
+ }
+ }
+ else if ((c == 's') && (length >= 2) && (strncmp(cmd, "selection", length) == 0))
+ {
+ if (argc < 3)
+ {
+ goto selection_invalid_args;
+ }
+
+ cmd2 = O_STR(2);
+ length = strlen(cmd2);
+ c = cmd2[0];
+
+ /* Only require information */
+ if (argc == 4 && (c == 'i') && (strncmp(cmd2, "includes", length) == 0))
+ {
+ if (GetTreeTableIndex(tablePtr, O_STR(3), 0, &index) != TCL_OK)
+ {
+ goto selection_invalid_args;
+ }
+ itemPtr = TreeTableFindItem (tablePtr, index);
+ if (itemPtr != NULL && (itemPtr->flags&ITEM_SELECTED))
+ {
+ sprintf (interp->result, "1");
+ }
+ else
+ {
+ sprintf (interp->result, "0");
+ }
+
+ goto done;
+ }
+ else if (argc >= 4 && c == 'c' && (strncmp(cmd2, "clear", length) == 0))
+ {
+ int last;
+ if (argc > 5)
+ {
+ goto selection_invalid_args;
+ }
+ if (GetTreeTableIndex (tablePtr, O_STR(3), 0, &index) != TCL_OK)
+ {
+ goto error;
+ }
+ last = index;
+ if (argc == 5 && GetTreeTableIndex (tablePtr, O_STR(4), 0, &last) != TCL_OK)
+ {
+ goto error;
+ }
+ if (TreeTableLostSel (tablePtr, Min (index, last), Max (index, last)))
+ {
+ TreeTableRedrawRange(tablePtr);
+ }
+ goto done;
+ }
+ if (argc > 5)
+ {
+ goto selection_invalid_args;
+ }
+
+ if ((c == 'a') && (strncmp(cmd2, "anchor", length) == 0))
+ {
+ if (argc != 4 || GetTreeTableIndex(tablePtr, O_STR(3), 0, &index)
+ != TCL_OK)
+ {
+ goto selection_invalid_args;
+ }
+ tablePtr->selectAnchor = index;
+ }
+ else if ((c == 's') && (strncmp(cmd2, "set", length) == 0))
+ {
+ int to;
+ if (GetTreeTableIndex(tablePtr, O_STR(3), 0, &index) != TCL_OK)
+ {
+ goto selection_invalid_args;
+ }
+ to = index;
+ if (argc == 5 &&
+ GetTreeTableIndex(tablePtr, O_STR(4), 0, &to) != TCL_OK)
+ {
+ goto selection_invalid_args;
+ }
+ TreeTableSelectFromTo
+ (tablePtr, tablePtr->itemPtr, 0, Min (index, to), Max (index, to));
+ TreeTableRedrawRange(tablePtr);
+ }
+ else
+ {
+ selection_invalid_args:
+ Tcl_WrongNumArgs (interp, 2, objv, "anchor index, clear index ?last?, includes index, set index ?last?");
+ goto error;
+ }
+ }
+ else if ((c == 's') && (length > 2)
+ && (strncmp(cmd, "size", length) == 0))
+ {
+ sprintf(interp->result, "%d", tablePtr->numItems);
+ }
+ else if ((c == 'x') && (strncmp(cmd, "xview", length) == 0))
+ {
+ if (argc > 2)
+ cmd2 = O_STR(2);
+ if (argc == 2)
+ {
+ if (tablePtr->maxWidth == 0)
+ {
+ interp->result = "0 1";
+ }
+ else
+ {
+ double fraction,fraction2;
+ double windowWidth;
+
+ windowWidth = (double) TREETABLE_WIDTH(tablePtr);
+
+ fraction = tablePtr->xOffset/((double) tablePtr->maxWidth);
+ fraction2 = (tablePtr->xOffset + windowWidth)
+ /((double) tablePtr->maxWidth);
+
+ if (fraction2 > 1.0)
+ {
+ fraction2 = 1.0;
+ }
+ sprintf(interp->result, "%g %g", fraction, fraction2);
+ }
+ goto done;
+ }
+ else if (argc == 3)
+ {
+ if (Tcl_GetInt (interp, cmd2, &index) != TCL_OK)
+ {
+ goto xview_invalid_num;
+ }
+ ChangeTreeTableOffset(tablePtr, index*tablePtr->xScrollUnit);
+ goto done;
+ }
+ else if (argc == 4 && cmd2[0] == 's' && strcmp (cmd2, "see") == 0)
+ {
+ if (Tcl_GetInt (interp, O_STR(3), &index) != TCL_OK)
+ {
+ goto xview_invalid_num;
+ }
+ index = index * tablePtr->xScrollUnit - Tk_Width(tablePtr->tkwin) / 2;
+ ChangeTreeTableOffset(tablePtr, index);
+ goto done;
+ }
+ else
+ {
+ int number, units = 1, ret;
+ double pos;
+
+ strv = Construct_Argv (argc, objv);
+ ret = Tk_GetScrollInfo(interp, argc, strv, &pos, &number);
+ Free_Argv(strv);
+
+ switch (ret)
+ {
+ case TK_SCROLL_MOVETO:
+ pos = pos * (double) tablePtr->maxWidth + 0.5;
+ index = (int) pos;
+ break;
+ case TK_SCROLL_PAGES:
+ units = Tk_Width(tablePtr->tkwin) / tablePtr->xScrollUnit;
+ index = tablePtr->xOffset + number * units * tablePtr->xScrollUnit;
+ break;
+ case TK_SCROLL_UNITS:
+ index = tablePtr->xOffset + number * units * tablePtr->xScrollUnit;
+ break;
+ case TK_SCROLL_ERROR:
+ goto error;
+ break;
+ }
+ if (index < 0) index = 0;
+ if (index > tablePtr->maxWidth) index = tablePtr->maxWidth;
+ ChangeTreeTableOffset (tablePtr, index);
+ goto done;
+ }
+ xview_invalid_num:
+ Tcl_AppendResult(interp, "xview: invalid number", (char *) NULL);
+ goto error;
+ }
+ else if ((c == 'y') && (strncmp(cmd, "yview", length) == 0))
+ {
+ if (argc > 2)
+ cmd2 = O_STR(2);
+ if (argc == 2)
+ {
+ if (tablePtr->numItems == 0)
+ {
+ interp->result = "0 1";
+ }
+ else
+ {
+ double count;
+ double fraction, fraction2;
+
+ count = (double)TreeTableCountNotHidden (tablePtr, 0);
+ fraction = tablePtr->topIndex/count;
+ fraction2 = (tablePtr->topIndex + tablePtr->numLines) /
+ ((double) count);
+ if (fraction2 > 1.0)
+ {
+ fraction2 = 1.0;
+ }
+ sprintf(interp->result, "%g %g", fraction, fraction2);
+ }
+ goto done;
+ }
+ else if (argc == 3)
+ {
+ if (GetTreeTableIndex(tablePtr, cmd2, 0, &index)
+ != TCL_OK)
+ {
+ goto yview_invalid_num;
+ }
+ ChangeTreeTableView(tablePtr, index, 0);
+ goto done;
+ }
+ else if (argc == 4 && cmd2[0] == 's' && strcmp (cmd2, "see") == 0)
+ {
+ if (GetTreeTableIndex(tablePtr, O_STR(3), 0, &index) != TCL_OK)
+ {
+ goto yview_invalid_num;
+ }
+ if (index < 0)
+ {
+ index = 0;
+ }
+ else if (index >= tablePtr->numItems)
+ {
+ index = tablePtr->numItems-1;
+ }
+ tablePtr->active = index;
+
+ /* convert realy index to index relative to viewed items */
+ index = TreeTableViewedIndex (tablePtr, index);
+
+ if (index < 0)
+ {
+ index = 0;
+ }
+ else if (index >= TreeTableCountNotHidden (tablePtr, 0))
+ {
+ index = TreeTableCountNotHidden (tablePtr, 0) - 1;
+ }
+ index -= tablePtr->numLines/2;
+ ChangeTreeTableView(tablePtr, index, 1);
+ goto done;
+ }
+ else
+ {
+ int number, ret;
+ double pos;
+ strv = Construct_Argv(argc, objv);
+ ret = Tk_GetScrollInfo(interp, argc, strv, &pos, &number);
+ Free_Argv(strv);
+
+ switch (ret)
+ {
+ case TK_SCROLL_MOVETO:
+ /*pos = pos * (double) tablePtr->maxWidth + 0.5;*/
+ pos = pos * (double) tablePtr->numViewed + 0.5;
+ index = (int) pos;
+ break;
+ case TK_SCROLL_PAGES:
+ index = tablePtr->topIndex + number * tablePtr->numLines;
+ break;
+ case TK_SCROLL_UNITS:
+ index = tablePtr->topIndex + number;
+ break;
+ case TK_SCROLL_ERROR:
+ goto error;
+ break;
+ }
+ ChangeTreeTableView (tablePtr, index, 1);
+ goto done;
+ }
+
+ yview_invalid_num:
+ Tcl_AppendResult(interp, "yview: invalid number", (char *) NULL);
+ goto error;
+ }
+ else if (argc >= 3 && (c == 's') && strncmp (cmd, "see", length) == 0)
+ {
+ int i = 2, top = 0;
+
+ /* see the item on the top of the widget */
+ if (strcmp (O_STR(2), "-top") == 0)
+ {
+ top = 1;
+ i = 3;
+ }
+ if (GetTreeTableIndex(tablePtr, O_STR(i), 0, &index) != TCL_OK)
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "?-top? index");
+ goto error;
+ }
+
+ /* convert realy index to index relative to viewed items */
+ index = TreeTableViewedIndex (tablePtr, index);
+
+ if (index < tablePtr->topIndex || top)
+ {
+ ChangeTreeTableView(tablePtr, index, 0);
+ }
+ else if (index > tablePtr->topIndex+tablePtr->numLines-1)
+ {
+ ChangeTreeTableView(tablePtr, index-tablePtr->numLines+1, 0);
+ }
+ }
+ else if ((c == 'i') && (strncmp(cmd, "identify", length) == 0))
+ {
+ int x, y, ret;
+ char*p;
+
+ if (argc != 4)
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "x y");
+ goto error;
+ }
+ if (Tcl_GetInt (interp, O_STR(2), &x) != TCL_OK)
+ {
+ goto error;
+ }
+ if (Tcl_GetInt (interp, O_STR(3), &y) != TCL_OK)
+ {
+ goto error;
+ }
+
+ ret = TreeTableToggle (tablePtr, x, y, 1);
+ switch (ret)
+ {
+ case ITEM_VIEWED:
+ p = "view";
+ break;
+ case ITEM_HIDDEN:
+ p = "hide";
+ break;
+ case ITEM_TEXT:
+ p = "text";
+ break;
+ case ITEM_UNKNOWN:
+ p = "noroot";
+ break;
+ case ITEM_NOT_FOUND:
+ p = "";
+ break;
+ default:
+ p = "";
+ break;
+ }
+ strcpy (interp->result, p);
+ }
+ else if ((c == 't') && (strncmp(cmd, "toggle", length) == 0))
+ {
+ int hide = 0, real_index=0;
+
+ if (argc < 3 || argc > 5)
+ {
+ ToggleError:
+ Tcl_WrongNumArgs (interp, 2, objv, "index ?hide|view? ?virtual|real?");
+ goto error;
+ }
+ if (GetTreeTableIndex(tablePtr, O_STR(2), 0, &index) != TCL_OK)
+ {
+ goto error;
+ }
+ if (argc == 5) /* verify if we want to toggle a virtual/real position*/
+ {
+ if (O_STR(4)[0] == 'v')
+ real_index = 0;
+ else if (O_STR(4)[0] == 'r')
+ real_index = 1;
+ else
+ goto ToggleError;
+ }
+ if (real_index)
+ {
+ itemPtr = TreeTableFindItem (tablePtr, index);
+ }
+ else
+ {
+ itemPtr = TreeTableFindNotHiddenItem (tablePtr, index, 0);
+ }
+ if (itemPtr == NULL)
+ {
+ goto error;
+ }
+ if (argc >= 4)
+ {
+ if (O_STR(3)[0] == 'v')
+ hide = 0;
+ else if (O_STR(3)[0] == 'h')
+ hide = 1;
+ else
+ goto ToggleError;
+ }
+ else
+ {
+ hide = (itemPtr->flags&ITEM_HIDDEN_SUBTREE) ? 0 : 1;
+ }
+ DELETE_FROM_PATHFINDER(index);
+ TreeTableToggleItem (tablePtr, itemPtr, hide);
+ }
+ else if ((c == 'f') && (strncmp(cmd, "fullname", length) == 0))
+ {
+ int len, alen;
+ char *cchar = " ";
+
+ if (argc < 3 || argc > 4)
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "index ?join string?");
+ goto error;
+ }
+ if (GetTreeTableIndex(tablePtr, O_STR(2), 0, &index) != TCL_OK)
+ {
+ goto error;
+ }
+ if (argc == 4)
+ {
+ cchar = O_STR(3);
+ }
+ if (index < 0)
+ {
+ index = 0;
+ }
+ if (index >= tablePtr->numItems)
+ {
+ index = tablePtr->numItems-1;
+ }
+ /* find item */
+ itemPtr = TreeTableFindItem (tablePtr, index);
+ if (itemPtr != NULL)
+ {
+ char *buf;
+ /** calculate length of used buffer */
+ alen = strlen (cchar);
+ len = strlen(itemPtr->text) + alen + 1;
+ for (Ptr=itemPtr->parentPtr; Ptr != NULL; Ptr=Ptr->parentPtr)
+ {
+ len += Ptr->textLength + alen;
+ }
+ buf = (char*) ckalloc (len);
+ if (buf == NULL)
+ {
+ goto error;
+ }
+ /* build full path name and join it with join string */
+ strcpy (buf, itemPtr->text);
+ for (Ptr=itemPtr->parentPtr; Ptr != NULL; Ptr=Ptr->parentPtr)
+ {
+ if (*buf)
+ {
+ memmove (buf + alen, buf, strlen (buf) + 1);
+ strncpy (buf, cchar, alen);
+ }
+ memmove(buf + Ptr->textLength, buf, strlen (buf) + 1);
+ strncpy (buf, Ptr->text, Ptr->textLength);
+ }
+
+ /* We can use TCL_DYNAMIC, because we used ckalloc */
+ Tcl_SetResult(interp, buf, TCL_DYNAMIC);
+ }
+ }
+ else if (c == 's' && strncmp (cmd, "search", length) == 0)
+ {
+ int ret;
+
+ strv = Construct_Argv (argc, objv);
+ ret = TreeTableSearchCmd(tablePtr, argc, strv);
+ Free_Argv (strv);
+
+ if (ret != TCL_OK)
+ goto error;
+ }
+ else if ((c == 's') && (length > 5)
+ && (strncmp(cmd, "seenall", length) == 0))
+ {
+ sprintf(tmp, "%d", tablePtr->numViewed);
+ Tcl_SetResult(interp, tmp, TCL_VOLATILE);
+ }
+ else if ((c == 'd') && (strncmp(cmd, "data", length) == 0))
+ {
+ if (argc != 3)
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "index");
+ goto error;
+ }
+ if (Tcl_GetInt(interp, O_STR(2), &index) != TCL_OK)
+ {
+ goto error;
+ }
+ itemPtr = TreeTableFindItem(tablePtr, index);
+ if (itemPtr == NULL)
+ {
+ Tcl_AppendResult(interp, "wrong item #", (char *) NULL);
+ goto error;
+ }
+ Tcl_SetResult (interp,
+ (itemPtr->data) ? itemPtr->data : "",
+ TCL_STATIC);
+ }
+ else if ((c == 's') && (strncmp(cmd, "sort", length) == 0))
+ {
+ int ret;
+
+ strv = Construct_Argv (argc-2, objv+2);
+ ret = TreeTableSort (tablePtr, argc-2, strv);
+ Free_Argv (strv);
+
+ if (ret != TCL_OK)
+ goto error;
+ }
+ else if ((c == 'x') && (strncmp(cmd, "xoffset", length) == 0))
+ {
+ sprintf(interp->result, "%d", tablePtr->xOffset);
+ }
+ else if ((c == 'b') && (strncmp(cmd, "bbox", length) == 0))
+ {
+ int x, y, x2, y2;
+ if (argc != 3)
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "index");
+ goto error;
+ }
+ if (GetTreeTableIndex(tablePtr, O_STR(2), 0, &index) != TCL_OK)
+ {
+ goto error;
+ }
+ if (TreeTableGetBBox (tablePtr, index, &x, &y, &x2, &y2) != TCL_OK)
+ {
+ goto error;
+ }
+ sprintf (tmp, "%i %i %i %i", x, y, x2, y2);
+ Tcl_ResetResult (interp);
+ Tcl_AppendResult (interp, tmp, NULL);
+ }
+ else if ((c == 'c') && (strncmp(cmd, "column", length) == 0))
+ {
+ int num, hide;
+ if (argc != 4)
+ {
+ column_error:
+ Tcl_WrongNumArgs (interp, 2, objv, "hide|view|toggle column#");
+ goto error;
+ }
+ if (Tcl_GetInt(interp, O_STR(3), &num) != TCL_OK)
+ {
+ goto column_error;
+ }
+ if (tablePtr->tabs == NULL)
+ {
+ Tcl_AppendResult(interp,
+ "wrong usage of \"",
+ O_STR(0),
+ "\": no tab stops availiable",
+ (char*) NULL);
+ goto error;
+ }
+ if (num < 0)
+ {
+ num = 0;
+ }
+ if (num > tablePtr->tabsNum)
+ {
+ num = tablePtr->tabsNum;
+ }
+ if (strcmp (O_STR(2), "hide") == 0)
+ {
+ hide = 1;
+ }
+ else if (strcmp (O_STR(2), "view") == 0)
+ {
+ hide = 0;
+ }
+ else if (strcmp (O_STR(2), "toggle") == 0)
+ {
+ if (tablePtr->tabsHidden[num])
+ {
+ hide = 0;
+ }
+ else
+ {
+ hide = 1;
+ }
+ }
+ else
+ {
+ goto column_error;
+ }
+ tablePtr->tabsHidden[num] = hide;
+
+ TreeTableRedrawRange (tablePtr);
+ }
+ /*
+ * Calculate how many parents does an item have
+ */
+ else if ((c == 'l') && (strncmp(cmd, "levels", length) == 0))
+ {
+ int level = 0;
+ if (argc != 3)
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "index");
+ goto error;
+ }
+ if (GetTreeTableIndex(tablePtr, O_STR(2), 0, &index) != TCL_OK)
+ {
+ goto error;
+ }
+
+ itemPtr = TreeTableFindItem (tablePtr, index);
+ if (itemPtr != NULL)
+ {
+ while (itemPtr->parentPtr != NULL)
+ {
+ level++;
+ itemPtr = itemPtr->parentPtr;
+ }
+ }
+
+ sprintf (tmp, "%i", level);
+ Tcl_ResetResult (interp);
+ Tcl_AppendResult (interp, tmp, NULL);
+ }
+ else if ((c == 'c') && (strncmp(cmd, "children", length) == 0))
+ {
+ if (argc != 3)
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "index");
+ goto error;
+ }
+ if (GetTreeTableIndex(tablePtr, O_STR(2), 0, &index) != TCL_OK)
+ {
+ goto error;
+ }
+
+ itemPtr = TreeTableFindItem (tablePtr, index);
+ if (itemPtr == NULL)
+ {
+ goto error;
+ }
+ Tcl_ResetResult (interp);
+ for (index += 1, Ptr=itemPtr->succPtr; Ptr; Ptr=Ptr->nextPtr)
+ {
+ sprintf (tmp, "%i", index);
+ Tcl_AppendElement (interp, tmp);
+ index += 1 + Ptr->succNum;
+ }
+ }
+ else if ((c == 'r') &&
+ (strncmp(cmd, "root", length) == 0 ||
+ strncmp(cmd, "rootname", length) == 0))
+ {
+ if (argc != 3)
+ {
+ Tcl_WrongNumArgs (interp, 2, objv, "index");
+ goto error;
+ }
+ if (GetTreeTableIndex(tablePtr, O_STR(2), 0, &index) != TCL_OK)
+ {
+ goto error;
+ }
+ itemPtr = TreeTableFindItem (tablePtr, index);
+ if (itemPtr == NULL)
+ {
+ goto error;
+ }
+ /* get base root of item */
+ for (Ptr=itemPtr; Ptr->parentPtr; Ptr=Ptr->parentPtr)
+ {
+ }
+ if (strcmp(cmd, "root") != 0) /* return root name */
+ {
+ Tcl_SetResult (interp, Ptr->text, TCL_STATIC);
+ }
+ else /* return root index */
+ {
+ sprintf (tmp, "%i", TreeTableFindIndex (tablePtr, Ptr));
+ Tcl_SetResult (interp, tmp, TCL_VOLATILE);
+ }
+ }
+#if defined (TEST_TREE) && defined (USE_CACHE)
+ else if ((c == 't') && (strncmp(cmd, "test", length) == 0))
+ {
+ ViewCache (tablePtr);
+ }
+#endif
+ else
+ {
+ Tcl_AppendResult(interp, "bad option \"", cmd,
+ "\": must be "
+ "activate, "
+ "bbox, "
+ "cget, "
+ "configure, "
+ "curselection, "
+ "delete, "
+ "fullname, "
+ "get, "
+ "hidecolumn, "
+ "identify, "
+ "index, "
+ "insert, "
+ "itemcget, "
+ "levels, "
+ "nearest, "
+ "remove, "
+ "root, "
+ "rootname, "
+ "scan, "
+ "search, "
+ "see, "
+ "seenall, "
+ "select, "
+ "selection, "
+ "size, "
+ "sort, "
+ "toggle, "
+ "xview, "
+ "or "
+ "yview", (char *) NULL);
+ goto error;
+ }
+
+ /*
+ if (tabsAccess)
+ {
+ fprintf (stderr, "\ttabs now <%s>\n", tablePtr->tabsList?tablePtr->tabsList:"");
+ }
+ */
+
+ done:
+ Tcl_Release((ClientData) tablePtr);
+
+#if 0
+ if (cmd[0] != 'i' || strcmp (cmd, "insert") != 0)
+ {
+ fprintf (stderr, ">%i\n", clock());
+ }
+#endif
+
+ return result;
+
+ error:
+ Tcl_DecrRefCount(errm);
+ Tcl_Release((ClientData) tablePtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyTreeTable --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a treetable at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the treetable is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+DestroyTreeTable(memPtr)
+ char *memPtr; /* Info about widget. */
+{
+ register TreeTable *tablePtr = (TreeTable *) memPtr;
+ ImageList_t *img, *nextImg;
+
+ /*
+ * Free up all of the list elements.
+ */
+ TreeTableDeleteRange (tablePtr, 0, tablePtr->numItems-1);
+
+ /*
+ * Free up all the stuff that requires special handling,
+ * then let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ if (tablePtr->defTextGC != None)
+ {
+ Tk_FreeGC(tablePtr->display, tablePtr->defTextGC);
+ }
+ if (tablePtr->defBitmapGC != None)
+ {
+ Tk_FreeGC(tablePtr->display, tablePtr->defBitmapGC);
+ }
+ if (tablePtr->defBitmapSelectGC != None)
+ {
+ Tk_FreeGC(tablePtr->display, tablePtr->defBitmapSelectGC);
+ }
+ if (tablePtr->defLineGC != None)
+ {
+ Tk_FreeGC(tablePtr->display, tablePtr->defLineGC);
+ }
+ if (tablePtr->selectGC != None)
+ {
+ Tk_FreeGC(tablePtr->display, tablePtr->selectGC);
+ }
+ /* this function doesn't delete the image icons */
+ Tk_FreeOptions(configSpecs, (char *) tablePtr, tablePtr->display, 0);
+
+ /* also free image if availiable */
+ if (tablePtr->hiddenImage != NULL)
+ {
+ Tk_FreeImage (tablePtr->hiddenImage);
+ }
+ /* free tab stops, if availiable */
+ if (tablePtr->tabs != NULL)
+ {
+ ckfree ((char *)tablePtr->tabs);
+ }
+ if (tablePtr->defTabs != NULL)
+ {
+ ckfree ((char *)tablePtr->defTabs);
+ }
+ if (tablePtr->tabsJustify != NULL)
+ {
+ ckfree ((char *)tablePtr->tabsJustify);
+ }
+ if (tablePtr->idlecommand != NULL)
+ {
+ ckfree ((char *)tablePtr->idlecommand);
+ }
+ if (tablePtr->tabsHidden != NULL)
+ {
+ ckfree ((char *)tablePtr->tabsHidden);
+ }
+
+ /* free declared images */
+ for (img=tablePtr->Images; img; )
+ {
+ nextImg=img->next;
+ Tk_FreeImage (img->image);
+ ckfree ((char*)img->name);
+ ckfree ((char*)img);
+ img = nextImg;
+ }
+
+ ckfree ((char *) tablePtr);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureTreeTable --
+ *
+ * This procedure is called to process an argv/argc list, plus
+ * the Tk option database, in order to configure (or reconfigure)
+ * a treetable 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 tablePtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureTreeTable(register TreeTable *tablePtr, /* Information about widget; may
+ * or may not already have values
+ * for some fields. */
+ int argc, /* Number of valid entries in argv */
+ Tcl_Obj *objv[], /* Arguments */
+ int flags) /* Flags to pass to Tk_ConfigureWidget */
+{
+ XGCValues gcValues;
+ GC new;
+ int i, width, height, oldExport;
+ Tk_FontMetrics metrics;
+ int pixelWidth, pixelHeight;
+ Tk_Font oldfont;
+ Pixmap oldhiddenBitmap;
+ static char **argv = NULL;
+ char
+ *oldhiddenImageString,
+ *oldplusImageString,
+ *oldminusImageString,
+ *oldunknownImageString,
+ *oldTabsList,
+ *oldJustify,
+ *oldDefTabsList,
+ *oldSelectModeStr;
+ int oldBestFit;
+ int compute_width = 0;
+#ifdef USE_PATHFINDER
+ int oldUseAccel = tablePtr->UseAccelerator;
+#endif
+ int oldWidth, oldHeight;
+ char * oldTruncateMethodeStr;
+
+ oldExport = tablePtr->exportSelection;
+ oldfont = tablePtr->defFontPtr;
+ oldhiddenBitmap = tablePtr->hiddenBitmap;
+ oldhiddenImageString= tablePtr->hiddenImageString;
+ oldplusImageString = tablePtr->plusImageString;
+ oldminusImageString = tablePtr->minusImageString;
+ oldunknownImageString= tablePtr->unknownImageString;
+ oldTabsList = tablePtr->tabsList;
+ oldJustify = tablePtr->justify;
+ oldDefTabsList = tablePtr->defTabsList;
+ oldSelectModeStr = tablePtr->selectModeStr;
+ oldBestFit = tablePtr->BestFit;
+ oldHeight = tablePtr->height;
+ oldWidth = tablePtr->width;
+ oldTruncateMethodeStr = tablePtr->TruncateMethodeStr;
+
+ /*
+ * translate the list to a string list
+ */
+ if (argv != NULL)
+ {
+ Free_Argv(argv);
+ }
+ argv = Construct_Argv (argc, objv);
+
+ if (Tk_ConfigureWidget(tablePtr->interp, tablePtr->tkwin, configSpecs,
+ argc, argv, (char *) tablePtr, flags) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Geometry for the plus image
+ */
+ if (tablePtr->plusImageString != NULL && oldplusImageString != tablePtr->plusImageString)
+ {
+ Tk_Image image;
+ image = Tk_GetImage (tablePtr->interp, tablePtr->tkwin,
+ tablePtr->plusImageString,
+ TreeTableImageProc, (ClientData) NULL);
+ if (image == NULL)
+ {
+ Tcl_AppendResult(tablePtr->interp, "bad image name \"", tablePtr->plusImageString,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (tablePtr->plusImage != NULL)
+ {
+ Tk_FreeImage (tablePtr->plusImage);
+ }
+ tablePtr->plusImage = image;
+ Tk_SizeOfImage (tablePtr->plusImage,
+ &tablePtr->plusWidth,
+ &tablePtr->plusHeight);
+ compute_width = 1;
+ }
+
+ /*
+ * Geometry for the minus image
+ */
+ if (tablePtr->minusImageString != NULL && oldminusImageString != tablePtr->minusImageString)
+ {
+ Tk_Image image;
+ image = Tk_GetImage (tablePtr->interp, tablePtr->tkwin,
+ tablePtr->minusImageString,
+ TreeTableImageProc, (ClientData) NULL);
+ if (image == NULL)
+ {
+ Tcl_AppendResult(tablePtr->interp, "bad image name \"", tablePtr->minusImageString,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (tablePtr->minusImage != NULL)
+ {
+ Tk_FreeImage (tablePtr->minusImage);
+ }
+ tablePtr->minusImage = image;
+ Tk_SizeOfImage (tablePtr->minusImage,
+ &tablePtr->minusWidth,
+ &tablePtr->minusHeight);
+ compute_width = 1;
+ }
+
+ /*
+ * Geometry for the unknown image
+ */
+ if (tablePtr->unknownImageString != NULL && oldunknownImageString != tablePtr->unknownImageString)
+ {
+ Tk_Image image;
+ image = Tk_GetImage (tablePtr->interp, tablePtr->tkwin,
+ tablePtr->unknownImageString,
+ TreeTableImageProc, (ClientData) NULL);
+ if (image == NULL)
+ {
+ Tcl_AppendResult(tablePtr->interp, "bad image name \"", tablePtr->unknownImageString,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (tablePtr->unknownImage != NULL)
+ {
+ Tk_FreeImage (tablePtr->unknownImage);
+ }
+ tablePtr->unknownImage = image;
+ Tk_SizeOfImage (tablePtr->unknownImage,
+ &tablePtr->unknownWidth,
+ &tablePtr->unknownHeight);
+ compute_width = 1;
+ }
+
+ /* Geometry for the hidden bitmap/image **/
+ if (tablePtr->hiddenImageString != NULL && oldhiddenImageString != tablePtr->hiddenImageString)
+ {
+ Tk_Image image;
+ image = Tk_GetImage (tablePtr->interp, tablePtr->tkwin,
+ tablePtr->hiddenImageString,
+ TreeTableImageProc, (ClientData) NULL);
+ if (image == NULL)
+ {
+ Tcl_AppendResult(tablePtr->interp, "bad image name \"", tablePtr->hiddenImageString,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (tablePtr->hiddenImage != NULL)
+ {
+ Tk_FreeImage (tablePtr->hiddenImage);
+ }
+ tablePtr->hiddenImage = image;
+ Tk_SizeOfImage (tablePtr->hiddenImage,
+ &tablePtr->hiddenWidth,
+ &tablePtr->hiddenHeight);
+ compute_width = 1;
+ }
+ else if (oldhiddenBitmap != tablePtr->hiddenBitmap)
+ {
+ Tk_SizeOfBitmap(tablePtr->display, tablePtr->hiddenBitmap,
+ &tablePtr->hiddenWidth, &tablePtr->hiddenHeight);
+ compute_width = 1;
+ }
+
+ /*
+ * Some options need special processing, such as parsing the
+ * geometry and setting the background from a 3-D border.
+ */
+ Tk_SetBackgroundFromBorder(tablePtr->tkwin, tablePtr->normalBorder);
+
+ if (tablePtr->highlightWidth < 0)
+ {
+ tablePtr->highlightWidth = 0;
+ }
+ tablePtr->inset = tablePtr->highlightWidth + tablePtr->borderWidth;
+ gcValues.foreground = tablePtr->defTextFgColor->pixel;
+ gcValues.font = Tk_FontId (tablePtr->defFontPtr);
+ gcValues.graphics_exposures = False;
+ new = Tk_GetGC(tablePtr->tkwin, GCForeground|GCFont|GCGraphicsExposures,
+ &gcValues);
+ if (tablePtr->defTextGC != None)
+ {
+ Tk_FreeGC(tablePtr->display, tablePtr->defTextGC);
+ }
+ tablePtr->defTextGC = new;
+ gcValues.foreground = tablePtr->selFgColorPtr->pixel;
+ gcValues.background = Tk_3DBorderColor(tablePtr->selBorder)->pixel;
+ gcValues.font = Tk_FontId (tablePtr->defFontPtr);
+
+ new = Tk_GetGC(tablePtr->tkwin, GCForeground|GCBackground|GCFont,
+ &gcValues);
+ if (tablePtr->selectGC != None)
+ {
+ Tk_FreeGC(tablePtr->display, tablePtr->selectGC);
+ }
+ tablePtr->selectGC = new;
+
+ gcValues.foreground = tablePtr->defBitmapFgColor->pixel;
+ gcValues.background = tablePtr->defBitmapBgColor->pixel;
+ gcValues.graphics_exposures = False;
+ if (tablePtr->defBitmapGC != None)
+ {
+ Tk_FreeGC(tablePtr->display, tablePtr->defBitmapGC);
+ }
+ tablePtr->defBitmapGC = Tk_GetGC(tablePtr->tkwin,
+ GCForeground|GCBackground|
+ GCGraphicsExposures, &gcValues);
+
+ if ((tablePtr->defBitmapSelectFgColor != None) ||
+ (tablePtr->defBitmapSelectBgColor != None))
+ {
+ if (tablePtr->defBitmapSelectFgColor != None) {
+ gcValues.foreground = tablePtr->defBitmapSelectFgColor->pixel;
+ } else {
+ gcValues.foreground = tablePtr->selFgColorPtr->pixel;
+ }
+ if (tablePtr->defBitmapSelectBgColor != None) {
+ gcValues.background = tablePtr->defBitmapSelectBgColor->pixel;
+ } else {
+ gcValues.background = Tk_3DBorderColor(tablePtr->selBorder)->pixel;
+ }
+ gcValues.graphics_exposures = False;
+ if (tablePtr->defBitmapSelectGC != None) {
+ Tk_FreeGC(tablePtr->display, tablePtr->defBitmapSelectGC);
+ }
+ tablePtr->defBitmapSelectGC = Tk_GetGC(tablePtr->tkwin,
+ GCForeground|GCBackground|
+ GCGraphicsExposures, &gcValues);
+ }
+ if (tablePtr->defLineWidth == atoi(NO_TREETABLE_LINEWIDTH))
+ {
+ tablePtr->defLineWidth = atoi(DEF_TREETABLE_LINEWIDTH);
+ }
+ gcValues.foreground = tablePtr->defLineFgColor->pixel;
+ gcValues.graphics_exposures = False;
+ gcValues.line_width = tablePtr->defLineWidth;
+ if (tablePtr->defLineGC != None)
+ {
+ Tk_FreeGC(tablePtr->display, tablePtr->defLineGC);
+ }
+ tablePtr->defLineGC = Tk_GetGC(tablePtr->tkwin,
+ GCForeground|GCGraphicsExposures|GCLineWidth,
+ &gcValues);
+
+ /* Split line color */
+ gcValues.foreground = tablePtr->defSplitLineFgColor->pixel;
+ if (tablePtr->defSplitLineGC != None)
+ {
+ Tk_FreeGC(tablePtr->display, tablePtr->defSplitLineGC);
+ }
+ tablePtr->defSplitLineGC = Tk_GetGC(tablePtr->tkwin,
+ GCForeground|GCGraphicsExposures|GCLineWidth,
+ &gcValues);
+
+ /*
+ * Claim the selection if we've suddenly started exporting it.
+ */
+ if (tablePtr->exportSelection && (!oldExport) && (tablePtr->selectFirst != -1))
+ {
+ Tk_OwnSelection(tablePtr->tkwin, XA_PRIMARY, TreeTableLostSelection,
+ (ClientData) tablePtr);
+ }
+
+ /*
+ * Register the desired geometry for the window, and arrange for
+ * the window to be redisplayed.
+ */
+ if ((sscanf(tablePtr->geometry, "%dx%d", &width, &height) != 2) ||
+ (width <= 0) || (height <= 0))
+ {
+ Tcl_AppendResult(tablePtr->interp, "bad geometry \"", tablePtr->geometry,
+ "\", should be \"widthxheight\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * width or height is modified
+ */
+ if (oldHeight != tablePtr->height)
+ {
+ height = tablePtr->height;
+ }
+ if (oldWidth != tablePtr->width)
+ {
+ width = tablePtr->width;
+ }
+ if ((oldWidth != tablePtr->width) || (oldHeight != tablePtr->height))
+ {
+ ckfree ((char*)tablePtr->geometry);
+ tablePtr->geometry = (char*) ckalloc (32);
+ sprintf (tablePtr->geometry, "%dx%d", width, height);
+ }
+ tablePtr->height = height;
+ tablePtr->width = width;
+
+ if (oldfont != tablePtr->defFontPtr)
+ {
+ Tk_GetFontMetrics (tablePtr->defFontPtr, &metrics);
+
+ tablePtr->defFontHeight = metrics.linespace;
+ TreeTableComputeLineHeight(tablePtr, NULL, 0);
+ if (metrics.linespace + 1 + 2 * tablePtr->selBorderWidth
+ > tablePtr->lineHeight)
+ {
+ tablePtr->lineHeight = (metrics.linespace + 1
+ + 2 * tablePtr->selBorderWidth);
+ }
+ tablePtr->flags |= UPDATE_H_SCROLLBAR;
+ compute_width = 1;
+ }
+
+ /*
+ * actual tab stop list
+ */
+ if (oldTabsList != tablePtr->tabsList && tablePtr->tabsList != NULL)
+ {
+ char **tabs, *p;
+ int num, oldnum, *oldtabs;
+ if (Tcl_SplitList (tablePtr->interp, tablePtr->tabsList, &num, &tabs) != TCL_OK)
+ return TCL_ERROR;
+ if (num == 0)
+ {
+ ckfree ((char*)tabs);
+ return TCL_ERROR;
+ }
+ oldtabs = tablePtr->tabs;
+ oldnum = tablePtr->tabsNum;
+
+ tablePtr->tabs = (int*) ckalloc (sizeof (int*) * num);
+ if (tablePtr->tabs == NULL)
+ {
+ ckfree ((char*)tabs);
+ return TCL_ERROR;
+ }
+ tablePtr->tabsNum = num;
+ for (i=0, p=tabs[i]; i<num; i++, p=tabs[i])
+ {
+ /* don't change value of a column if it usually hidden */
+ if (tablePtr->tabsHidden == NULL || !tablePtr->tabsHidden[i])
+ {
+#ifdef SPACE_PROBLEM
+ tablePtr->tabs[i] = Max (0, atoi (p));
+#else
+ tablePtr->tabs[i] = Max (tablePtr->tabsMinSpace, atoi (p));
+#endif
+ }
+ else if (oldtabs != NULL && i < oldnum) /* calculated value */
+ {
+ tablePtr->tabs[i] = oldtabs[i];
+ }
+ else if (tablePtr->defTabs != NULL)
+ {
+ tablePtr->tabs[i] = tablePtr->defTabs [i];
+ }
+ else
+ {
+#ifdef SPACE_PROBLEM
+ tablePtr->tabs[i] = 0;
+#else
+ tablePtr->tabs[i] = tablePtr->tabsMinSpace;
+#endif
+ }
+ }
+ if (oldtabs != NULL)
+ {
+ ckfree ((char*)oldtabs);
+ }
+ /*
+ * save tab stops as default. this is usefull by bestfit and
+ * autofit
+ */
+ if (tablePtr->defTabs == NULL)
+ {
+ tablePtr->defTabs = (int*)ckalloc (sizeof (int*) * num);
+ if (tablePtr->defTabs == NULL)
+ {
+ ckfree ((char*)tabs);
+ return TCL_ERROR;
+ }
+ for (i=0, p=tabs[i]; i<num; i++, p=tabs[i])
+ {
+ tablePtr->defTabs[i] = tablePtr->tabs[i];
+ }
+ }
+ ckfree ((char*)tabs);
+
+ }
+
+ /*
+ * actual default tab stop list
+ */
+ if (oldDefTabsList != tablePtr->defTabsList && tablePtr->defTabsList != NULL)
+ {
+ char **tabs, *p;
+ int num;
+ if (Tcl_SplitList (tablePtr->interp, tablePtr->defTabsList, &num, &tabs) != TCL_OK)
+ return TCL_ERROR;
+ if (num == 0)
+ {
+ ckfree ((char*)tabs);
+ return TCL_ERROR;
+ }
+ if (tablePtr->defTabs != NULL)
+ {
+ ckfree ((char*)tablePtr->defTabs);
+ }
+
+ tablePtr->defTabs = (int*)ckalloc (sizeof (int*) * num);
+ if (tablePtr->defTabs == NULL)
+ {
+ ckfree ((char*)tabs);
+ return TCL_ERROR;
+ }
+ for (i=0, p=tabs[i]; i<num; i++, p=tabs[i])
+ {
+ tablePtr->defTabs[i] = Max (0, atoi (p));
+ }
+ /*
+ * if tab stop list isn't given set this tab stop to it
+ */
+ if (tablePtr->tabs == NULL)
+ {
+ tablePtr->tabs = (int*)ckalloc (sizeof (int*) * num);
+ if (tablePtr->tabs == NULL)
+ {
+ ckfree ((char*)tabs);
+ return TCL_ERROR;
+ }
+ }
+ /*
+ * the tab stop number must be equevalent
+ * take minimun, else we get a 'core dump'
+ */
+ if (tablePtr->tabsNum != num)
+ {
+ tablePtr->tabsNum = Min (tablePtr->tabsNum, num);
+ }
+ /* set the tabs and deftabs as equevalent for now */
+ for (i=0, p=tabs[i]; i<num; i++, p=tabs[i])
+ {
+ tablePtr->tabs[i] = tablePtr->defTabs[i];
+ }
+ ckfree ((char*)tabs);
+
+ }
+
+ /*
+ * if justify is changed
+ */
+ if (oldJustify != tablePtr->justify)
+ {
+ char **jj, *p;
+ int num;
+ if (Tcl_SplitList (tablePtr->interp, tablePtr->justify, &num, &jj) != TCL_OK)
+ return TCL_ERROR;
+ if (num != tablePtr->tabsNum)
+ {
+ ckfree ((char*)jj);
+ return TCL_ERROR;
+ }
+ if (tablePtr->tabsJustify)
+ {
+ ckfree ((char*)tablePtr->tabsJustify);
+ }
+ tablePtr->tabsJustify = (int*)ckalloc (sizeof (int*) * tablePtr->tabsNum);
+ for (i=0, p=jj[i]; i<num; i++, p=jj[i])
+ {
+ if (Tcl_GetInt(tablePtr->interp, jj[i], &tablePtr->tabsJustify[i]) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+ }
+ ckfree ((char*)jj);
+ }
+
+ /* allocate memory for tabs state (hidden/viewed) */
+ if (tablePtr->tabsHidden == NULL && tablePtr->tabs && tablePtr->tabsNum > 0)
+ {
+ tablePtr->tabsHidden = (int*)ckalloc (sizeof (int*) * tablePtr->tabsNum);
+ memset (tablePtr->tabsHidden, 0, sizeof (int*) * tablePtr->tabsNum);
+ }
+
+ if (oldSelectModeStr != tablePtr->selectModeStr && tablePtr->selectModeStr != NULL)
+ {
+ tablePtr->selectMode =
+ (strcmp (tablePtr->selectModeStr, "single") == 0 ||
+ strcmp (tablePtr->selectModeStr, "browse") == 0
+ ? SINGLE
+ : MULTI);
+ }
+
+ /* only on this position we can look for bestfit */
+ if (oldBestFit != tablePtr->BestFit && tablePtr->tabs && tablePtr->BestFit)
+ {
+ TreeTableComputeWidths (tablePtr, NULL, 3);
+ }
+
+#ifdef USE_PATHFINDER
+ if (oldUseAccel != tablePtr->UseAccelerator)
+ {
+ if (tablePtr->UseAccelerator)
+ {
+ if (tablePtr->pathFinder == NULL)
+ {
+ tablePtr->pathFinder = (PathFinder_t*)ckalloc (sizeof (PathFinder_t));
+ memset (tablePtr->pathFinder, 0, sizeof (PathFinder_t));
+ }
+ }
+ else
+ {
+ /* delete path finder */
+ PathFinder_t *pf, *pf1;
+ for (pf1=tablePtr->pathFinder; pf1; )
+ {
+ pf = pf1;
+ pf1 = pf1->next;
+ ckfree ((char*)pf);
+ }
+ tablePtr->pathFinder = NULL;
+ }
+ }
+#endif
+
+ /*
+ * verify witch truncating methode we should use
+ */
+ if (strcmp (tablePtr->TruncateMethodeStr, "path") == 0)
+ {
+ tablePtr->TruncateMethode = TRUNCATE_PATH;
+ }
+ else if (strcmp (tablePtr->TruncateMethodeStr, "auto") == 0)
+ {
+ tablePtr->TruncateMethode = TRUNCATE_AUTO;
+ }
+ else
+ {
+ tablePtr->TruncateMethode = TRUNCATE_NORMAL;
+ }
+
+ tablePtr->numLines = TREETABLE_NUM_LINES(tablePtr);
+
+ if (tablePtr->numLines <0)
+ {
+ tablePtr->numLines = 0;
+ }
+
+ /* compute width newely if needed, else it take long time */
+ if (compute_width)
+ {
+ TreeTableComputeWidths(tablePtr, (TableItem *) NULL, 2);
+ tablePtr->flags |= UPDATE_V_SCROLLBAR;
+ }
+
+ pixelWidth = width*tablePtr->xScrollUnit
+ + 2*tablePtr->inset
+ + 2*tablePtr->selBorderWidth;
+ pixelHeight = height*tablePtr->lineHeight
+ + 2*tablePtr->borderWidth;
+
+ if (((TkWindow *)tablePtr->tkwin)->reqWidth != pixelWidth ||
+ ((TkWindow *)tablePtr->tkwin)->reqHeight != pixelHeight)
+ {
+ Tk_GeometryRequest (tablePtr->tkwin, pixelWidth, pixelHeight);
+ }
+ Tk_SetInternalBorder (tablePtr->tkwin, tablePtr->borderWidth);
+ if (tablePtr->setGrid)
+ {
+ Tk_SetGrid(tablePtr->tkwin, width, height, tablePtr->xScrollUnit,
+ tablePtr->lineHeight);
+ }
+ tablePtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR;
+ TreeTableRedrawRange(tablePtr);
+ return TCL_OK;
+}
+
+#if _WINDOWS
+static char * my_WindowsNativePath (char *str, int len)
+{
+ static char *newp=NULL, *q;
+ static int newplen = 0;
+ if (len > newplen)
+ {
+ newplen = len+1;
+ if (newp)
+ {
+ newp = (char*)ckrealloc (newp, newplen);
+ }
+ else
+ {
+ newp = (char*)ckalloc (newplen);
+ }
+ }
+
+ if (strchr (str, '/') == NULL)
+ {
+ return str;
+ }
+
+ strcpy (newp, str);
+ for (q=newp; *q; q++)
+ {
+ if (*q == '/')
+ {
+ *q = '\\';
+ }
+ }
+ return newp;
+}
+#endif
+
+int
+Hase_Root (char * str, int len)
+{
+ int i;
+ for (i=0; i<len; i++)
+ {
+ if (IS_ROOT (str[i]))
+ {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static char *
+TreeTable_truncate_string (TreeTable* tablePtr, char *buf, int column_len, int len)
+{
+ static char tmp[1024];
+ int truncate_methode;
+
+ /*
+ * by AUTO-truncating, it looks if the string is a path
+ * True: cut the prefix
+ * False: cut the suffix
+ */
+ if (tablePtr->TruncateMethode == TRUNCATE_AUTO)
+ {
+ if (Hase_Root (buf, column_len))
+ {
+ truncate_methode = TRUNCATE_PATH;
+ }
+ else
+ {
+ truncate_methode = TRUNCATE_NORMAL;
+ }
+ }
+ else
+ {
+ truncate_methode = tablePtr->TruncateMethode;
+ }
+
+ /*
+ * truncate
+ *
+ * /home/user/foo.c ==> /..user/foo.c
+ * relative/path ==> ..ative/path
+ * C:\Bad\Windows ==> C:\..dows
+ */
+ if (truncate_methode == TRUNCATE_PATH)
+ {
+ int beg_trunc = 0;
+
+#if _WINDOWS
+ /*
+ * On Windows a full path begins with "C:\" or "C:/"
+ */
+ if (IS_ROOT(buf[0]) || (column_len > 1 && buf[1] == ':' && IS_ROOT(buf[2])))
+ {
+ beg_trunc ++;
+ }
+#else
+ if (IS_ROOT(buf[0]))
+ {
+ beg_trunc ++;
+ }
+#endif
+
+#if _WINDOWS
+ if (buf[1] == ':')
+ {
+ beg_trunc ++;
+ if (IS_ROOT (buf[2]))
+ {
+ beg_trunc ++;
+ }
+ }
+#endif
+ if (len < beg_trunc)
+ {
+ beg_trunc = 0;
+ }
+ strncpy (tmp, buf, beg_trunc);
+ if (beg_trunc < len)
+ {
+ tmp[beg_trunc ++] = '.';
+ }
+ if (beg_trunc < len)
+ {
+ tmp[beg_trunc ++] = '.';
+ }
+
+ strncpy (tmp+beg_trunc, buf + Max (0, beg_trunc+column_len-len), len);
+ tmp[len] = 0;
+ }
+ else
+ {
+ char *p;
+ strncpy (tmp, buf, len);
+
+ if (len > 2)
+ {
+ p = tmp + len - 2;
+ *p ++ = '.';
+ *p ++ = '.';
+ }
+ else if (len == 2)
+ {
+ p = tmp + len - 1;
+ *p ++ = '.';
+ }
+ else
+ {
+ p = tmp + 1;
+ }
+ p[0] = 0;
+ }
+ return tmp;
+}
+
+#define ItemIndent(itemPtr) tablePtr->indentWidth
+
+static int
+DisplayRecursive (register TreeTable *tablePtr,
+ register TableItem * itemPPtr,
+ register int* seenpos,
+ register int* realpos,
+ int limit,
+ Pixmap pixmap,
+ int disp)
+{
+ GC gc=0;
+ Tk_Font font, oldFont=NULL;
+ Tk_FontMetrics metrics;
+ TableItem *parentPtr;
+ TableItem * itemPtr;
+ int real_x, real_text_x, real_bitm_x, real_plus_x, horiz_x, horiz_x2, vert_x, vert_x2;
+ int real_y, real_text_y, real_bitm_y, real_plus_y, horiz_y, horiz_y2, vert_y, vert_y2;
+ int draw_text_y;
+ int hidden;
+ int redisplay = 0, windowWidth = -1;
+ int lineHeight = tablePtr->lineHeight;
+#ifdef USE_PATHFINDER
+ PathFinder_t *Pf=tablePtr->pathFinder;
+#endif
+
+ real_x = tablePtr->inset - tablePtr->xOffset;
+
+ itemPtr = itemPPtr;
+
+#ifdef USE_PATHFINDER
+ if (Pf)
+ {
+ /* we only use the Pathfinder on the first level
+ * of the tree (root) ***/
+ if (itemPtr->parentPtr) /* parent availiable */
+ {
+ Pf = NULL;
+ }
+ else
+ {
+ PathFinder_t *pf=Pf;
+ for (pf=Pf->next; pf; pf=pf->next)
+ {
+ if (pf->itemPos < tablePtr->topIndex)
+ {
+ *realpos = pf->itemPos;
+ *seenpos = pf->seenPos;
+ itemPtr = pf->itemPtr;
+ }
+ }
+ /* find last path finder */
+ for (;Pf->next; Pf=Pf->next);
+ }
+ }
+#endif
+
+ while (*seenpos < tablePtr->topIndex && itemPtr != NULL)
+ {
+#ifdef USE_PATHFINDER
+ if (Pf && Pf->itemPos < *realpos && (*realpos%PATHFINDER_STEP)==0)
+ {
+ Pf->next = (PathFinder_t*)ckalloc (sizeof (PathFinder_t));
+ memset (Pf->next, 0, sizeof (PathFinder_t));
+ Pf=Pf->next;
+ Pf->itemPos = *realpos;
+ Pf->seenPos = *seenpos;
+ Pf->itemPtr = itemPtr;
+ }
+#endif
+
+ *seenpos += 1;
+ *realpos += 1;
+
+ if (itemPtr->succPtr != NULL && ! (itemPtr->flags&ITEM_HIDDEN_SUBTREE))
+ {
+ if (*seenpos+itemPtr->seenNum < tablePtr->topIndex)
+ {
+ *realpos += itemPtr->succNum;
+ *seenpos += itemPtr->seenNum;
+ }
+ else
+ {
+ redisplay += DisplayRecursive
+ (tablePtr, itemPtr->succPtr, seenpos, realpos, limit, pixmap,
+ disp);
+ }
+ }
+ else
+ {
+ *realpos += itemPtr->succNum;
+ *seenpos += itemPtr->seenNum;
+ }
+ itemPtr = itemPtr->nextPtr;
+ }
+ while ((itemPtr != NULL) && (*seenpos <= limit))
+ {
+#ifdef USE_PATHFINDER
+ /* Add only the root items in the pathfinder */
+ if (Pf && Pf->itemPos < *realpos && (*realpos%PATHFINDER_STEP)==0)
+ {
+ Pf->next = (PathFinder_t*)ckalloc (sizeof (PathFinder_t));
+ memset (Pf->next, 0, sizeof (PathFinder_t));
+ Pf=Pf->next;
+ Pf->itemPos = *realpos;
+ Pf->seenPos = *seenpos;
+ Pf->itemPtr = itemPtr;
+ }
+#endif
+ hidden = itemPtr->flags&ITEM_HIDDEN_SUBTREE;
+
+ /* we must know witch font we are playing with */
+ font = ((itemPtr->fontPtr != NULL) ? itemPtr->fontPtr
+ : tablePtr->defFontPtr);
+ if (oldFont != font)
+ {
+ Tk_GetFontMetrics (font, &metrics);
+ oldFont = font;
+ }
+ itemPtr->fontHeight = metrics.linespace;
+
+ /*
+ * Compute starting coordinates for every thing before starting
+ * drawing
+ */
+ real_plus_x = real_x + itemPtr->indent*tablePtr->indentWidth;
+ real_bitm_x = real_plus_x;
+ if (Have_PlusMinus(tablePtr))
+ {
+ real_bitm_x += tablePtr->plusWidth + tablePtr->bitmapSpace;
+ }
+
+ /*
+ * Increment x position by separator space.
+ */
+ real_text_x = real_bitm_x;
+ if (itemPtr->bitmap != None || itemPtr->image)
+ {
+ real_text_x += itemPtr->bitmapWidth + tablePtr->bitmapSpace;
+ }
+
+ /* y-coordinate for bitmap */
+ real_y = ((*seenpos - tablePtr->topIndex) * lineHeight)
+ + tablePtr->inset;
+ /*
+ * Compute y coordinate to center the text vertically on the line.
+ */
+ real_text_y = real_y + (lineHeight-itemPtr->fontHeight)/2;
+ draw_text_y = real_text_y + lineHeight - 2 * metrics.descent;
+ real_bitm_y = real_y + (lineHeight-itemPtr->bitmapHeight)/2;
+ real_plus_y = real_y + (lineHeight-tablePtr->plusHeight)/2;
+
+ /*
+ * If this line is part of the selection, draw the higlight now
+ */
+ if (disp && (itemPtr->flags&ITEM_SELECTED))
+ {
+ if (tablePtr->fillSelection && windowWidth < 0)
+ {
+ windowWidth = TREETABLE_WIDTH(tablePtr);
+ }
+ Tk_Fill3DRectangle(tablePtr->tkwin, pixmap,
+ tablePtr->selBorder,
+ real_text_x - tablePtr->selBorderWidth,
+ real_text_y - tablePtr->selBorderWidth,
+ (tablePtr->fillSelection)
+ ? Max (windowWidth, itemPtr->lineWidth) /*+ tablePtr->selBorderWidth*2*/
+ : itemPtr->lineWidth - real_bitm_x - tablePtr->xOffset,
+ lineHeight,
+ tablePtr->selBorderWidth,
+ TK_RELIEF_RAISED);
+ }
+
+ /*
+ * Lines must be drawn before text and images
+ */
+
+ /*
+ * Draw the line back to the parent if necessary
+ */
+ if (disp && Have_PlusMinus(tablePtr))
+ {
+ /* compute coordinates for horizontal line */
+ horiz_y = real_plus_y + tablePtr->plusHeight/2;
+ horiz_x2 = real_bitm_x+itemPtr->bitmapWidth/2;
+ horiz_x = horiz_x2 - tablePtr->indentWidth;
+ horiz_y2 = horiz_y;
+
+ /* draw horizontal line */
+ XDrawLine(tablePtr->display, pixmap,
+#ifdef USE_BITMAP_COLOR
+ itemPtr->lineGC != None ? itemPtr->lineGC : tablePtr->defLineGC,
+#else
+ tablePtr->defLineGC,
+#endif
+ horiz_x, horiz_y, horiz_x2, horiz_y);
+
+ /* Condition:
+ * -item has succ's
+ * Action:
+ * -draw a line from the bitmap
+ */
+ if (!hidden && itemPtr->succPtr)
+ {
+ int succ_x, succ_y, succ_x2, succ_y2;
+ succ_x = real_bitm_x+itemPtr->bitmapWidth/2;
+ succ_x2 = succ_x;
+ succ_y = real_bitm_y+itemPtr->bitmapHeight/2;
+ succ_y2 = real_y + tablePtr->lineHeight;
+
+ XDrawLine(tablePtr->display, pixmap,
+#ifdef USE_BITMAP_COLOR
+ itemPtr->lineGC != None ? itemPtr->lineGC : tablePtr->defLineGC,
+#else
+ tablePtr->defLineGC,
+#endif
+ succ_x, succ_y, succ_x2, succ_y2);
+ }
+ }
+ else if (disp)
+ /* The tree uses the older mode (without plus/minus) */
+ {
+ /*
+ * if there is a parent, draw a horizontal line back to the parent */
+ if (itemPtr->parentPtr != NULL)
+ {
+ horiz_y = real_bitm_y + itemPtr->bitmapHeight/2;
+ horiz_x = real_bitm_x - ItemIndent(itemPtr) + itemPtr->bitmapWidth/2;
+ horiz_x2 = real_bitm_x;
+ horiz_y2 = horiz_y;
+ XDrawLine(tablePtr->display, pixmap,
+#ifdef USE_BITMAP_COLOR
+ itemPtr->lineGC != None ? itemPtr->lineGC : tablePtr->defLineGC,
+#else
+ tablePtr->defLineGC,
+#endif
+ horiz_x, horiz_y, horiz_x2, horiz_y2);
+ }
+
+ /*
+ * if the item has sons, draw a line to the first succ */
+ if (itemPtr->succPtr != NULL && ! hidden)
+ {
+ vert_x = real_bitm_x + itemPtr->bitmapWidth/2;
+ vert_x2 = vert_x;
+ vert_y = real_y + tablePtr->lineHeight/2;
+ vert_y2 = real_y + tablePtr->lineHeight;
+ XDrawLine(tablePtr->display, pixmap,
+#ifdef USE_BITMAP_COLOR
+ itemPtr->lineGC != None ? itemPtr->lineGC : tablePtr->defLineGC,
+#else
+ tablePtr->defLineGC,
+#endif
+ vert_x, vert_y, vert_x2, vert_y2);
+ }
+ }
+
+ /* parse the parents back to the first level (not first level)
+ * and draw the lines if a next item of a parent is availiable
+ */
+ if (disp /*&& Have_PlusMinus(tablePtr)*/ )
+ {
+ int i;
+ int diff = ItemIndent(itemPtr);
+ TableItem * Ptr;
+ for (i=1, Ptr=itemPtr, parentPtr = itemPtr->parentPtr;
+ parentPtr != NULL;
+ Ptr=parentPtr, parentPtr = parentPtr->parentPtr, i++)
+ {
+ int left_x, left_x2, left_y, left_y2;
+
+ if (Ptr->nextPtr == NULL && Ptr != itemPtr)
+ {
+ continue;
+ }
+
+ left_x = real_bitm_x+itemPtr->bitmapWidth/2 - i*diff;
+ left_x2 = left_x;
+ left_y = real_y;
+ if (Ptr->nextPtr != NULL)
+ {
+ left_y2 = real_y+tablePtr->lineHeight;
+ }
+ else
+ {
+ left_y2 = real_y+tablePtr->lineHeight/2;
+ }
+
+ /* draw line */
+ XDrawLine(tablePtr->display, pixmap,
+#ifdef USE_BITMAP_COLOR
+ parentPtr->lineGC != None ? parentPtr->lineGC : tablePtr->defLineGC,
+#else
+ tablePtr->defLineGC,
+#endif
+ left_x, left_y, left_x2, left_y2);
+ }
+ }
+
+ /*
+ * Draw +/-, if the item contains sons
+ */
+ if (disp && Have_PlusMinus(tablePtr) && (itemPtr->succPtr != NULL || itemPtr->unknownFlag))
+ {
+ Tk_Image image;
+ if (itemPtr->unknownFlag && tablePtr->unknownImage)
+ {
+ image = tablePtr->unknownImage;
+ }
+ else
+ {
+ image = hidden ? tablePtr->plusImage : tablePtr->minusImage;
+ }
+ Tk_RedrawImage(image,
+ 0, 0,
+ tablePtr->plusWidth, tablePtr->plusHeight,
+ pixmap,
+ real_plus_x, real_plus_y);
+ }
+
+ if (disp && tablePtr->hiddenImage == NULL)
+ {
+ /*
+ * If line in selection, use bitmapSelectGC
+ */
+ if (itemPtr->flags&ITEM_SELECTED)
+ {
+#ifdef USE_BITMCAP_COLOR
+ gc = tablePtr->selectGC;
+ if (itemPtr->bitmapSelectGC != None)
+ {
+ gc = itemPtr->bitmapSelectGC;
+ }
+ else
+ {
+ if (tablePtr->defBitmapSelectGC != None)
+ {
+ gc = tablePtr->defBitmapSelectGC;
+ }
+ else
+ {
+ gc = tablePtr->selectGC;
+ }
+ }
+#else
+ if (tablePtr->defBitmapSelectGC != None)
+ {
+ gc = tablePtr->defBitmapSelectGC;
+ }
+ else if (tablePtr->selectGC != None)
+ {
+ gc = tablePtr->selectGC;
+ }
+ else
+ {
+ gc = tablePtr->defBitmapGC;
+ }
+#endif
+ } else {
+ if (itemPtr->bitmapGC != None)
+ {
+ gc = itemPtr->bitmapGC;
+ }
+ else
+ {
+ gc = tablePtr->defBitmapGC;
+ }
+ }
+ }
+
+ /*
+ * Draw hidden image/bitmap, if sub tree is closed (older style).
+ */
+ if (disp && ! Have_PlusMinus(tablePtr) &&
+ hidden &&
+ (tablePtr->hiddenBitmap != None || tablePtr->hiddenImage != NULL))
+ {
+ /* draw image if available and no hidden image/bitmap availiable */
+ if (tablePtr->hiddenImage)
+ {
+ Tk_RedrawImage(tablePtr->hiddenImage,
+ 0, 0,
+ tablePtr->hiddenWidth, tablePtr->hiddenHeight,
+ pixmap,
+ real_bitm_x, real_bitm_y);
+ }
+ else
+ {
+ XCopyPlane(tablePtr->display, tablePtr->hiddenBitmap,
+ pixmap,
+ gc,
+ 0, 0,
+ tablePtr->hiddenWidth, tablePtr->hiddenHeight,
+ real_bitm_x, real_bitm_y,
+ 1);
+ }
+ }
+
+ /*
+ * Draw the bitmap if an image/bitmap availiable
+ */
+ else if (disp && (itemPtr->bitmap != None || itemPtr->image != NULL))
+ {
+
+ /* draw image if available and no hidden image/bitmap availiable */
+ if (itemPtr->image)
+ {
+ Tk_RedrawImage(itemPtr->image,
+ 0, 0,
+ itemPtr->bitmapWidth, itemPtr->bitmapHeight,
+ pixmap,
+ real_bitm_x, real_bitm_y);
+ }
+ else
+ {
+ XCopyPlane(tablePtr->display, itemPtr->bitmap,
+ pixmap,
+ gc,
+ 0, 0,
+ itemPtr->bitmapWidth, itemPtr->bitmapHeight,
+ real_bitm_x, real_bitm_y,
+ 1);
+ }
+ }
+
+ if (disp)
+ {
+ if (itemPtr->flags&ITEM_SELECTED)
+ {
+ gc = tablePtr->selectGC;
+ }
+ else if (itemPtr->textGC != None)
+ {
+ gc = itemPtr->textGC;
+ }
+ else
+ {
+ gc = tablePtr->defTextGC;
+ }
+ }
+
+ /*
+ * we support tab stops too
+ */
+ if (tablePtr->tabsNum > 0 && tablePtr->tabs != NULL)
+ {
+ char *nextTab, *p = itemPtr->text;
+ int len;
+ int tab_x = real_text_x, tab_text_x = real_text_x;
+ int i = 0, tab_width;
+ int column_len;
+
+#if _WINDOWS
+ /*
+ * Convert paths to windows native paths
+ */
+ if (tablePtr->nativeWindowsMode)
+ {
+ p = my_WindowsNativePath(itemPtr->text, itemPtr->textLength);
+ }
+#endif
+
+ while (p != NULL)
+ {
+ NextChar (nextTab, p, '\t', column_len);
+ /*
+ * len is variable and could be changed to shrink the
+ * displayed string in a column
+ */
+ len = column_len;
+
+ /*
+ * We need to now the width for every column
+ */
+ tab_width = Tk_TextWidth (font, p, column_len);
+
+ /* Calculate tab stops if auto fit is enabled*/
+ if (!disp && tablePtr->AutoFit)
+ {
+ int xx = tab_width+tablePtr->tabsMinSpace;
+ if (p == itemPtr->text)
+ {
+ xx += real_text_x + tablePtr->xOffset; /* contains previous image spaces */
+ }
+ if (tablePtr->tabs[i] < xx)
+ {
+ tablePtr->tabs[i] = xx;
+ }
+ }
+
+ /* calculate max. width, if tab stops availiable */
+ if (nextTab == NULL)
+ {
+ if (itemPtr->lineWidth != tab_text_x + tab_width + tablePtr->xOffset)
+ {
+ itemPtr->lineWidth = tab_text_x + tab_width + tablePtr->xOffset;
+ }
+ if (tablePtr->maxWidth < itemPtr->lineWidth)
+ {
+ tablePtr->maxWidth = itemPtr->lineWidth;
+ }
+ }
+
+ /* if truncate is enabled, truncate the rest of the
+ * text if it overrides the next tab stop.
+ * It uses a binary search O(log n)
+ */
+ if (tablePtr->Truncate && i<tablePtr->tabsNum-1)
+ {
+ int tmp_tab_offset;
+ int tmp_tab_width, calc_tab_width;
+
+ if (i == 0)
+ {
+ tmp_tab_offset = tab_text_x + tablePtr->xOffset;
+ calc_tab_width = tmp_tab_offset+tab_width;
+ }
+ else
+ {
+ calc_tab_width = tab_width;
+ tmp_tab_offset=0;
+ }
+
+ if (tablePtr->tabsHidden[i])
+ {
+#ifdef SPACE_PROBLEM
+ tmp_tab_width = 0;
+#else
+ tmp_tab_width = tablePtr->tabsMinSpace;
+#endif
+ }
+ else
+ {
+ tmp_tab_width = tablePtr->tabs[i];
+ }
+ if (calc_tab_width > tmp_tab_width-tablePtr->tabsMinSpace)
+ {
+ char *q = p;
+ int step;
+ /*
+ * use binary algorithm O(log n) to truncate the text
+ */
+ len += 2;
+ step = len;
+ do
+ {
+ step /= 2;
+ if (calc_tab_width > tmp_tab_width-tablePtr->tabsMinSpace)
+ {
+ len -= step;
+ }
+ else
+ {
+ len += step;
+ }
+ p = TreeTable_truncate_string (tablePtr, q, column_len, len);
+
+ tab_width = Tk_TextWidth (font, p, len);
+ if (i == 0)
+ {
+ calc_tab_width = tmp_tab_offset+tab_width;
+ }
+ else
+ {
+ calc_tab_width = tab_width;
+ }
+
+ } while (step > 1);
+
+ /*
+ * After the binary algorithm to truncate the text
+ * The text can be one or two characters larger than it
+ * fit in the tab column. Truncate it linear.
+ */
+ while (len > 0 && calc_tab_width > tmp_tab_width-tablePtr->tabsMinSpace)
+ {
+ len --;
+ p = TreeTable_truncate_string (tablePtr, q, column_len, len);
+
+ tab_width = Tk_TextWidth (font, p, len);
+ if (i == 0)
+ {
+ calc_tab_width = tmp_tab_offset+tab_width;
+ }
+ else
+ {
+ calc_tab_width = tab_width;
+ }
+ }
+ }
+ }
+
+ if (disp && ! tablePtr->tabsHidden[i])
+ {
+ /* right-justify */
+ if (tablePtr->tabsJustify && tablePtr->tabsJustify[i])
+ {
+ int tmp_tab_width, ww = Tk_TextWidth(font, p, len);
+ if (tablePtr->tabsHidden[i])
+ {
+#ifdef SPACE_PROBLEM
+ tmp_tab_width = 0;
+#else
+ tmp_tab_width = tablePtr->tabsMinSpace;
+#endif
+ }
+ else
+ {
+ tmp_tab_width = tablePtr->tabs[i];
+ }
+ Tk_DrawChars (tablePtr->display, pixmap, gc, font,
+ p, len,
+ tab_text_x + tmp_tab_width-ww-tablePtr->tabsMinSpace/2, draw_text_y);
+ }
+ else
+ {
+ Tk_DrawChars (tablePtr->display, pixmap, gc, font,
+ p, len,
+ tab_text_x + (i==0 ? 0 : tablePtr->tabsMinSpace/2),
+ draw_text_y);
+ }
+ }
+
+ /* calculate the next tab stop position */
+ if (nextTab)
+ {
+ p = nextTab + 1;
+ }
+ else
+ {
+ p = nextTab;
+ }
+
+ if (tablePtr->tabsHidden[i])
+ {
+ if (i == 0)
+ {
+ tab_x += ITEM_TEXT_X(itemPtr);
+ }
+ else
+ {
+#ifdef SPACE_PROBLEM
+ tab_x += 0;
+#else
+ tab_x += tablePtr->tabsMinSpace;
+#endif
+ }
+ }
+ else
+ {
+ tab_x += tablePtr->tabs[i];
+ }
+
+ /* if truncate is seted, we cut the rest of the string */
+ if (!tablePtr->Truncate)
+ {
+ tab_text_x = Max (tab_text_x+tab_width+tablePtr->tabsMinSpace, tab_x)
+ - (real_text_x + tablePtr->xOffset);
+ }
+ else
+ {
+ tab_text_x = tab_x-(real_text_x + tablePtr->xOffset);
+ }
+
+ if (i<tablePtr->tabsNum-1)
+ {
+ i++;
+ }
+ }
+ }
+ else
+ {
+ if (disp)
+ {
+ char*p=itemPtr->text;
+#if _WINDOWS
+ /*
+ * Convert paths to windows native paths
+ */
+ if (tablePtr->nativeWindowsMode)
+ {
+ p = my_WindowsNativePath(itemPtr->text, itemPtr->textLength);
+ }
+#endif
+ Tk_DrawChars (tablePtr->display, pixmap, gc, font,
+ p, itemPtr->textLength,
+ real_text_x, draw_text_y);
+ }
+ if (itemPtr->lineWidth > tablePtr->maxWidth)
+ {
+ tablePtr->maxWidth = itemPtr->lineWidth;
+ }
+ }
+
+ /* draw line if have keyboard focus */
+ if (disp && (*realpos == tablePtr->active) && (tablePtr->flags & GOT_FOCUS))
+ {
+ XFillRectangle(tablePtr->display, pixmap,
+ (itemPtr->textGC != None)
+ ? itemPtr->textGC
+ : tablePtr->defTextGC,
+ real_text_x,
+ real_y + lineHeight - metrics.descent,
+ (tablePtr->fillSelection)
+ ? Max (windowWidth, itemPtr->lineWidth)
+ : itemPtr->lineWidth - real_bitm_x - tablePtr->xOffset - 2,
+ ACTIVE_LINE_HEIGHT);
+ }
+
+ *seenpos += 1;
+ *realpos += 1;
+ if (itemPtr->succPtr != NULL && !hidden)
+ {
+ redisplay += DisplayRecursive
+ (tablePtr, itemPtr->succPtr, seenpos, realpos, limit, pixmap,
+ disp);
+ }
+ else
+ {
+ *realpos += itemPtr->succNum;
+ }
+ itemPtr = itemPtr->nextPtr;
+ }
+ return redisplay;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayTreeTable --
+ *
+ * This procedure redraws the contents of a treetable window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+#define USE_PIXMAP
+static void
+DisplayTreeTable(clientData)
+ ClientData clientData; /* Information about window. */
+{
+ register TreeTable *tablePtr = (TreeTable *) clientData;
+ register Tk_Window tkwin = tablePtr->tkwin;
+ int limit, pos, realpos, oldMaxWidth;
+ Pixmap pixmap=0;
+ int redisplay;
+ int i;
+
+ /*
+ * Iterate through all of the items in the treetable,
+ * displaying each in turn.
+ */
+ limit = tablePtr->topIndex + tablePtr->numLines + 1;
+ if (limit >= tablePtr->numItems)
+ {
+ limit = tablePtr->numItems-1;
+ }
+
+ /* calculate best auto fit for tab stops */
+ if (tablePtr->AutoFit && tablePtr->tabsNum > 0)
+ {
+ for (i=0; i<tablePtr->tabsNum; i++)
+ {
+ tablePtr->tabs[i] = tablePtr->defTabs[i];
+ }
+ pos = realpos = 0;
+ tablePtr->maxWidth = 0;
+ DisplayRecursive(tablePtr, tablePtr->itemPtr,
+ &pos, &realpos,
+ limit, pixmap,
+ 0);
+ }
+
+ tablePtr->flags &= ~REDRAW_PENDING;
+ if (tablePtr->flags & UPDATE_V_SCROLLBAR)
+ {
+ TreeTableUpdateVScrollbar(tablePtr);
+ }
+ tablePtr->flags &= ~(REDRAW_PENDING|UPDATE_V_SCROLLBAR);
+ if ((tablePtr->tkwin == NULL) || !Tk_IsMapped(tkwin))
+ {
+ return;
+ }
+
+ /*
+ * Redrawing is done in a temporary pixmap that is allocated here and freed
+ * at the end of the procedure. All drawing is done to the pixmap,
+ * and the pixmap is copied to the screen at the end of the procedure.
+ * This provides the smoothest possible visual effects (no flashing
+ * on the screen).
+ */
+#ifndef USE_PIXMAP
+ pixmap = Tk_WindowId(tablePtr->tkwin);
+ Tcl_Preserve((ClientData) tablePtr->interp);
+#else
+ pixmap = Tk_GetPixmap(tablePtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin),
+ Tk_Depth(tkwin));
+#endif
+
+ Tk_Fill3DRectangle(tkwin, pixmap, tablePtr->normalBorder,
+ 0, 0, Tk_Width(tkwin), Tk_Height(tkwin),
+ tablePtr->borderWidth, tablePtr->relief);
+
+ oldMaxWidth = tablePtr->maxWidth;
+ tablePtr->maxWidth = 0;
+ pos = 0;
+ realpos = 0;
+ redisplay = DisplayRecursive (tablePtr, tablePtr->itemPtr,
+ &pos, &realpos,
+ limit, pixmap,
+ 1);
+
+ /* if drawing lines is enabled */
+ if (tablePtr->SplitLines && tablePtr->tabsNum > 0)
+ {
+ int px = tablePtr->tabsMinSpace/2 - tablePtr->xOffset - 1;
+ int hight = Tk_Height (tablePtr->tkwin);
+ for (i=0; i<tablePtr->tabsNum-1; i++)
+ {
+ if (tablePtr->tabsHidden[i])
+ {
+ if (i==0 && tablePtr->itemPtr!=NULL)
+ {
+ px += ITEM_TEXT_X(tablePtr->itemPtr);
+ }
+ else
+ {
+#ifdef SPACE_PROBLEM
+ px += 0;
+#else
+ px += tablePtr->tabsMinSpace;
+#endif
+ }
+ }
+ else
+ {
+ px += tablePtr->tabs[i];
+ }
+ if (px > 0)
+ {
+ XDrawLine (tablePtr->display, pixmap, tablePtr->defSplitLineGC,
+ px,
+ 0,
+ px, hight);
+ }
+ }
+ }
+ if ((tablePtr->flags & UPDATE_H_SCROLLBAR) || oldMaxWidth != tablePtr->maxWidth)
+ {
+ TreeTableUpdateHScrollbar(tablePtr);
+ tablePtr->flags &= ~UPDATE_H_SCROLLBAR;
+ }
+
+ /*
+ * Redraw the border to ensure it convers the text items of
+ * the lines in the treetable.
+ */
+ Tk_Draw3DRectangle(tkwin, pixmap,
+ tablePtr->normalBorder, 0, 0,
+ Tk_Width(tkwin), Tk_Height(tkwin),
+ tablePtr->borderWidth,
+ tablePtr->relief);
+
+ if (tablePtr->highlightWidth > 0 && tablePtr->highlightBgColor)
+ {
+ GC gc;
+
+ if (tablePtr->flags & GOT_FOCUS)
+ {
+ gc = Tk_GCForColor(tablePtr->highlightColor, pixmap);
+ } else
+ {
+ gc = Tk_GCForColor(tablePtr->highlightBgColor, pixmap);
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, tablePtr->highlightWidth, pixmap);
+ }
+
+ /* if idle command is seted, execute it */
+ if (tablePtr->idlecommand != NULL)
+ {
+ Tcl_Eval (tablePtr->interp, tablePtr->idlecommand);
+ }
+
+#ifdef USE_PIXMAP
+ XCopyArea(tablePtr->display, pixmap, Tk_WindowId(tkwin),
+ tablePtr->defTextGC, 0, 0, Tk_Width(tkwin),
+ Tk_Height(tkwin), 0, 0);
+ Tk_FreePixmap(tablePtr->display, pixmap);
+#else
+ Tcl_Release((ClientData) tablePtr->interp);
+#endif
+}
+
+/*
+ * This procedure is called, when an item is added or deleted and
+ * the flag 'bestfit' is enabled
+ */
+static void
+ComputeTabStops (TreeTable*tablePtr, TableItem *itemPtr)
+{
+ char *nextTab, *p = itemPtr->text;
+ int len;
+ int tx, px;
+ int i = 0, width;
+ int real_x, x, x1;
+
+ if (tablePtr->tabs == NULL)
+ {
+ return;
+ }
+
+ /* first x position fot text displaying */
+ real_x = tablePtr->inset - tablePtr->xOffset;
+ x = real_x + itemPtr->indent*tablePtr->indentWidth;
+ x1 = x + tablePtr->bitmapSpace;
+ if (itemPtr->bitmap != None || itemPtr->image)
+ {
+ x1 += itemPtr->bitmapWidth;
+ }
+ tx = real_x;
+ px = x1;
+
+ while (p != NULL)
+ {
+ NextChar (nextTab, p, '\t', len);
+
+ /*
+ * there is no tab stops availiable, so we don't need to
+ * recalc the list width
+ */
+ width = Tk_TextWidth ((itemPtr->fontPtr != NULL)
+ ? itemPtr->fontPtr : tablePtr->defFontPtr,
+ p, len);
+
+
+ /* Calculate best fit */
+ if (tablePtr->BestFit)
+ {
+ int xx = width+tablePtr->tabsMinSpace;
+ if (p == itemPtr->text)
+ {
+ int x11;
+ x11 = itemPtr->indent*tablePtr->indentWidth
+ + tablePtr->bitmapSpace
+ + itemPtr->bitmapWidth
+ + tablePtr->inset;
+ xx += x11;
+ }
+ if (tablePtr->tabs[i] < xx)
+ {
+ tablePtr->tabs[i] = xx;
+ }
+ }
+
+ /* calculate max. width */
+ if (nextTab == NULL)
+ {
+ if (itemPtr->lineWidth != px + width)
+ {
+ itemPtr->lineWidth = px + width + tablePtr->xOffset;
+ }
+ if (tablePtr->maxWidth < itemPtr->lineWidth)
+ {
+ tablePtr->maxWidth = itemPtr->lineWidth;
+ }
+ }
+
+ /* calculate the next tab stop position */
+ if (nextTab)
+ {
+ p = nextTab + 1;
+ }
+ else
+ {
+ p = nextTab;
+ }
+ tx += tablePtr->tabs[i];
+
+ px = tx;
+
+ if (i<tablePtr->tabsNum-1)
+ {
+ i++;
+ }
+ }
+}
+
+static int
+TreeTableFindIndex_x (TableItem *itemPtr, TableItem *srcPtr,
+ int index, int* pos)
+{
+ TableItem *Ptr;
+ int i = index;
+ for (Ptr=itemPtr; i>=0 && Ptr; Ptr=Ptr->nextPtr)
+ {
+ if (Ptr == srcPtr)
+ {
+ *pos = i;
+ return -1;
+ }
+ i++;
+ if (Ptr->succPtr != NULL)
+ {
+ i = TreeTableFindIndex_x (Ptr->succPtr, srcPtr, i, pos);
+ }
+ }
+ return i;
+}
+
+static int
+TreeTableFindIndex(tablePtr, itemPtr)
+ TreeTable *tablePtr; /* treetable to search in */
+TableItem *itemPtr; /* the item we're looking for */
+{
+ int pos = -1;
+
+ RET_CACHED_INDEX (itemPtr);
+
+ TreeTableFindIndex_x (tablePtr->itemPtr, itemPtr, 0, &pos);
+
+ /*SET_CACHED(itemPtr, pos);*/
+
+ return pos;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TreeTableSelectImageProc --
+ *
+ * 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 tree table when it is selected.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May arrange for the button to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TreeTableImageProc(clientData, x, y, width, height, imgWidth, imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureTreeTableItem --
+ *
+ * Add a new item to the tree table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * New information gets added to tablePtr; it will be redisplayed
+ * soon, but not immediately.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ConfigureTreeTableItem(tablePtr, itemPtr, argc, argv, flags, mode)
+ TreeTable *tablePtr; /* table the item is located in */
+ TableItem *itemPtr; /* Item to configure */
+ int argc; /* number of arguments */
+ char **argv; /* argument strings */
+ int flags; /* Flags to pass to Tk_ConfigureWidget */
+ int mode;
+{
+ XGCValues gcValues;
+ XColor *oldtextfg;
+#if USE_BITMAP_COLORS
+ XColor *oldbitselfg, *oldbitselbg, *oldbitbg, *oldlinefg, *oldbitfg;
+#endif
+ Pixmap oldbitmap;
+ Tk_Font oldfont;
+ Tk_FontMetrics metrics;
+ char *oldtext;
+ int oldparent;
+ int oldmaxwidth;
+ int oldlinewidth;
+ int oldindent;
+ int recompute_height = 0;
+ int recompute_width = 0, oldSuccNum, oldSeenNum;
+ char *oldImageString = NULL;
+
+ oldbitmap = itemPtr->bitmap;
+ oldtext = itemPtr->text;
+ oldtextfg = itemPtr->textFgColor;
+#if USE_BITMAP_COLORS
+ oldbitfg = itemPtr->bitmapFgColor;
+ oldbitbg = itemPtr->bitmapBgColor;
+ oldbitselfg = itemPtr->bitmapSelectFgColor;
+ oldbitselbg = itemPtr->bitmapSelectBgColor;
+ oldlinefg = itemPtr->lineFgColor;
+#endif
+ oldfont = itemPtr->fontPtr;
+ oldmaxwidth = tablePtr->maxWidth;
+ oldparent = itemPtr->parent;
+ oldindent = itemPtr->indent;
+ oldlinewidth = itemPtr->lineWidth;
+ oldImageString = itemPtr->imageString;
+ oldSuccNum = itemPtr->succNum;
+ oldSeenNum = itemPtr->seenNum;
+
+ if (Tk_ConfigureWidget(tablePtr->interp, tablePtr->tkwin, itemConfigSpecs,
+ argc, argv, (char *) itemPtr, flags) != TCL_OK) {
+
+ return TCL_ERROR;
+}
+
+ /** succnum field is read only */
+ if (oldSuccNum != itemPtr->succNum)
+ {
+ itemPtr->succNum = oldSuccNum;
+ Tcl_AppendResult (tablePtr->interp,
+ "children number is readonly field and can't be changed",
+ NULL);
+ return TCL_ERROR;
+ }
+ /** seennum field is read only */
+ if (oldSeenNum != itemPtr->seenNum)
+ {
+ itemPtr->seenNum = oldSeenNum;
+ Tcl_AppendResult (tablePtr->interp,
+ "seen number of children is readonly and can't be changed",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ if (itemPtr->indent != oldindent)
+ {
+ recompute_width = 1;
+ }
+ if ((oldtextfg != itemPtr->textFgColor) || (oldfont != itemPtr->fontPtr))
+ {
+ if (itemPtr->textFgColor != None)
+ {
+ gcValues.foreground = itemPtr->textFgColor->pixel;
+ }
+ else
+ {
+ gcValues.foreground = tablePtr->defTextFgColor->pixel;
+ }
+ if (itemPtr->fontPtr != None)
+ {
+ gcValues.font = Tk_FontId (itemPtr->fontPtr);
+ }
+ else
+ {
+ gcValues.font = Tk_FontId (tablePtr->defFontPtr);
+ }
+ gcValues.graphics_exposures = False;
+ if (itemPtr->textGC != None)
+ {
+ Tk_FreeGC(tablePtr->display, itemPtr->textGC);
+ }
+ if (oldfont != itemPtr->fontPtr)
+ {
+ Tk_GetFontMetrics (itemPtr->fontPtr, &metrics);
+ itemPtr->fontHeight = metrics.linespace;
+ recompute_height = 1;
+ }
+ itemPtr->textGC = Tk_GetGC(tablePtr->tkwin,
+ GCForeground|GCFont|GCGraphicsExposures,
+ &gcValues);
+ }
+#if USE_BITMAP_COLORS
+ if ((oldbitfg != itemPtr->bitmapFgColor) ||
+ (oldbitbg != itemPtr->bitmapBgColor))
+ {
+ if (itemPtr->bitmapFgColor != None)
+ {
+ gcValues.foreground = itemPtr->bitmapFgColor->pixel;
+ }
+ else
+ {
+ gcValues.foreground = tablePtr->defBitmapFgColor->pixel;
+ }
+ if (itemPtr->bitmapBgColor != None)
+ {
+ gcValues.background = itemPtr->bitmapBgColor->pixel;
+ }
+ else
+ {
+ gcValues.background = tablePtr->defBitmapBgColor->pixel;
+ }
+ gcValues.graphics_exposures = False;
+ if (itemPtr->bitmapGC != None)
+ {
+ Tk_FreeGC(tablePtr->display, itemPtr->bitmapGC);
+ }
+ itemPtr->bitmapGC = Tk_GetGC(tablePtr->tkwin,
+ GCForeground|GCBackground|
+ GCGraphicsExposures, &gcValues);
+ }
+
+ if ((oldbitselfg != itemPtr->bitmapSelectFgColor) ||
+ (oldbitselbg != itemPtr->bitmapSelectBgColor))
+ {
+ if (itemPtr->bitmapSelectFgColor != None)
+ {
+ gcValues.foreground = itemPtr->bitmapSelectFgColor->pixel;
+ }
+ else
+ {
+ gcValues.foreground = tablePtr->defBitmapSelectFgColor->pixel;
+ }
+ if (itemPtr->bitmapSelectBgColor != None)
+ {
+ gcValues.background = itemPtr->bitmapSelectBgColor->pixel;
+ }
+ else
+ {
+ /* Zsolt Koppany 5-jul-96 */
+ if (!tablePtr->defBitmapSelectBgColor)
+ gcValues.background = tablePtr->defBitmapFgColor->pixel;
+ else
+ gcValues.background = tablePtr->defBitmapSelectBgColor->pixel;
+ }
+ gcValues.graphics_exposures = False;
+ if (itemPtr->bitmapSelectGC != None)
+ {
+ Tk_FreeGC(tablePtr->display, itemPtr->bitmapSelectGC);
+ }
+ itemPtr->bitmapSelectGC = Tk_GetGC(tablePtr->tkwin,
+ GCForeground|GCBackground|
+ GCGraphicsExposures, &gcValues);
+ }
+#endif
+
+ if (itemPtr->lineWidth == atoi(NO_TABLEITEM_LINEWIDTH))
+ {
+ itemPtr->lineWidth = tablePtr->defLineWidth;
+ }
+#ifdef USE_BITMAP_COLOR
+ if ((oldlinefg != itemPtr->lineFgColor) ||
+ (oldlinewidth != itemPtr->lineWidth))
+ {
+ if (itemPtr->lineFgColor != None)
+ {
+ gcValues.foreground = itemPtr->lineFgColor->pixel;
+ }
+ else
+ {
+ gcValues.foreground = tablePtr->defLineFgColor->pixel;
+ }
+ gcValues.line_width = itemPtr->lineWidth;
+ gcValues.graphics_exposures = False;
+ if (itemPtr->lineGC != None)
+ {
+ Tk_FreeGC(tablePtr->display, itemPtr->lineGC);
+ }
+ itemPtr->lineGC = Tk_GetGC(tablePtr->tkwin,
+ GCForeground|GCGraphicsExposures|GCLineWidth,
+ &gcValues);
+ }
+#endif
+ if ((oldtext != itemPtr->text) || (oldfont != itemPtr->fontPtr))
+ {
+ if (itemPtr->text != (char *) NULL)
+ {
+ itemPtr->textLength = strlen(itemPtr->text);
+ }
+ else
+ {
+ itemPtr->textLength = 0;
+ }
+ recompute_width = 1;
+ }
+
+ if (oldbitmap != itemPtr->bitmap)
+ {
+ if (itemPtr->bitmap != None)
+ {
+ int width, height;
+ Tk_SizeOfBitmap(tablePtr->display, itemPtr->bitmap,
+ &width, &height);
+ itemPtr->bitmapWidth = (short) width;
+ itemPtr->bitmapHeight = (short) height;
+ }
+ recompute_height = recompute_width = 1;
+ }
+ /* load image **/
+ else if (oldImageString != itemPtr->imageString)
+ {
+ /* find the image in the list */
+ ImageList_t *img, *prevImg;
+ for (img=prevImg=tablePtr->Images; img; prevImg=img, img = img->next)
+ {
+ if (strcmp (img->name, itemPtr->imageString) == 0)
+ {
+ break;
+ }
+ }
+ /*
+ * Image not found, create it
+ */
+ if (img == NULL)
+ {
+ img = (ImageList_t*)ckalloc (sizeof (ImageList_t));
+ memset(img, 0, sizeof (ImageList_t));
+ if (img == NULL)
+ {
+ return TCL_ERROR;
+ }
+ img->name = (char*)ckalloc (strlen (itemPtr->imageString)+1);
+ strcpy (img->name, itemPtr->imageString);
+ img->image = Tk_GetImage(tablePtr->interp, tablePtr->tkwin,
+ itemPtr->imageString,
+ TreeTableImageProc,
+ (ClientData) NULL);
+ if (img->image == NULL)
+ {
+ return TCL_ERROR;
+ }
+ Tk_SizeOfImage(img->image, &img->width, &img->height);
+ /* add the created image to the list */
+ if (prevImg)
+ {
+ prevImg->next = img; /* add at the end of list (Sorting?) */
+ }
+ else
+ {
+ tablePtr->Images = img; /* first item */
+ }
+ }
+ itemPtr->image = img->image;
+ itemPtr->bitmapWidth = (short)img->width;
+ itemPtr->bitmapHeight = (short)img->height;
+ recompute_height = recompute_width = 1;
+ }
+
+ if (! (mode & CONFIG_OPTIONS_ONLY) && recompute_height)
+ {
+ int oldlh;
+
+ oldlh = tablePtr->lineHeight;
+ TreeTableComputeLineHeight(tablePtr, itemPtr, 0);
+ if (oldlh != tablePtr->lineHeight)
+ {
+ tablePtr->flags |= UPDATE_V_SCROLLBAR;
+ }
+ }
+ if ((mode & CONFIG_OPTIONS_ONLY) == 0 && recompute_width)
+ {
+ TreeTableComputeWidths(tablePtr, itemPtr, 0);
+ if (oldmaxwidth != tablePtr->maxWidth)
+ {
+ tablePtr->flags |= UPDATE_H_SCROLLBAR;
+ }
+ }
+ if (! (mode & CONFIG_OPTIONS_ONLY))
+ {
+ TreeTableRedrawRange(tablePtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ * find items in a given range and append result to
+ * the Tcl iterpreter result string
+ */
+/*{*/
+static int
+TreeTableGetItems_x (TreeTable *tablePtr, TableItem *itemPtr,
+ int index, int from, int to)
+{
+ TableItem *item = itemPtr;
+ int i;
+
+ for (i=index; i<=to && item != NULL; item = item->nextPtr)
+ {
+ if (i >= from && i<= to)
+ {
+ Tcl_AppendElement (tablePtr->interp, item->text);
+ }
+ i++;
+ if (item->succPtr != NULL)
+ {
+ /* we don't need to seach in sub trees, when succ number does't
+ * succeed
+ */
+ if (i+item->succNum < from)
+ {
+ i += item->succNum;
+ }
+ else
+ {
+ i = TreeTableGetItems_x (tablePtr, item->succPtr, i, from, to);
+ }
+ }
+ }
+
+ return i;
+}
+
+static void
+TreeTableGetItems (TreeTable *tablePtr, int from, int to)
+{
+ TreeTableGetItems_x (tablePtr, tablePtr->itemPtr, 0,
+ Min (from, to), Max(from, to));
+}
+/*}*/
+
+/*{*/
+static int
+TreeTableIndex (TableItem *itemPtr, int index, int pos, TableItem **itemRet)
+{
+ TableItem *item = itemPtr;
+ int i;
+
+ for (i=pos; i<=index && item != NULL; item = item->nextPtr)
+ {
+ if (i == index)
+ {
+ *itemRet = item;
+ return -1;
+ }
+ i++;
+ if (item->succPtr != NULL)
+ {
+ /* we don't need to seach in sub trees, when succ number does't
+ * succeed
+ */
+ if (i+item->succNum < index)
+ {
+ i += item->succNum;
+ }
+ else
+ {
+ i = TreeTableIndex (item->succPtr, index, i, itemRet);
+ if (i < 0)
+ {
+ return i;
+ }
+ }
+ }
+ }
+
+ return i;
+}
+static TableItem * TreeTableFindItem (TreeTable *tablePtr, int index)
+{
+ int pos = 0;
+ TableItem* itemRet = NULL;
+ TableItem* itemPtr = tablePtr->itemPtr;
+
+ if (index < 0)
+ return itemRet;
+
+ RET_CACHED_ITEM(index);
+
+ /* we can use the accelerator to speed up the location of
+ * the item
+ */
+ FIND_IN_PATHFINDER(index, itemPtr, pos);
+
+ TreeTableIndex (itemPtr, index, pos, &itemRet);
+
+ if (itemRet)
+ {
+ SET_CACHED(itemRet, index);
+ }
+
+ return itemRet;
+}
+/*}*/
+
+/*{*/
+/* find not hidden element
+ * next == 0 : return parent, if the element is hidden
+ * next == 1 : return next not hidden item
+ */
+static int
+TreeTableFindNotHiddenItem_x (TableItem *itemPtr, int index,
+ int pos, TableItem **itemRet, int next)
+{
+ TableItem *item = itemPtr;
+ int i;
+
+ for (i=pos; item != NULL; item = item->nextPtr)
+ {
+ if (i >= index)
+ {
+ *itemRet = item;
+ return -1;
+ }
+ i++;
+ if (item->succPtr != NULL)
+ {
+ /* don't look for hidden sub trees */
+ if ((item->flags & ITEM_HIDDEN_SUBTREE) || i+item->succNum < index)
+ {
+ i += item->succNum;
+ }
+ else
+ {
+ i = TreeTableFindNotHiddenItem_x (item->succPtr, index, i, itemRet, next);
+ if (i < 0)
+ {
+ return i;
+ }
+ }
+ }
+ if (i > index && next <= 0)
+ {
+ *itemRet = item;
+ return -1;
+ }
+ }
+
+ return i;
+}
+static TableItem * TreeTableFindNotHiddenItem (TreeTable *tablePtr, int index, int next)
+{
+ TableItem* itemRet = NULL;
+ TableItem* Ptr = tablePtr->itemPtr;
+ int pos = 0;
+
+ if (index < 0)
+ return itemRet;
+
+ /*FIND_IN_PATHFINDER(index, Ptr, pos);*/
+
+ /*RET_CACHED_ITEM(index);*/
+
+ TreeTableFindNotHiddenItem_x (Ptr, index, pos, &itemRet, next);
+
+ /*SET_CACHED (itemRet, index);*/
+
+ return itemRet;
+}
+/*}*/
+
+/*
+ * function return a boolean value if the item is inserted in a hidden
+ * sub tree (not viewed)
+ */
+static int
+TreeTableInsertListItem (register TreeTable* tablePtr,
+ register TableItem*newPtr,
+ register TableItem*prevPtr,
+ register int index,
+ register int *newIndex)
+{
+ register TableItem* parentPtr = NULL, *posPtr = NULL;
+ register TableItem* thisPtr = NULL;
+ register int hidden;
+
+ /* add item after given position */
+ if (prevPtr != NULL)
+ {
+ newPtr->parentPtr = prevPtr->parentPtr;
+ newPtr->parent = prevPtr->parent;
+ newPtr->indent = prevPtr->indent;
+ newPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = newPtr;
+ }
+ /* find position to add new item */
+ else
+ {
+ /*
+ * find parent
+ */
+ if (newPtr->parent >= 0)
+ {
+#ifdef USE_PARENT_CACHE
+ parentPtr = GET_CACHED_PARENT(tablePtr, newPtr->parent);
+#else
+ parentPtr = TreeTableFindItem (tablePtr, newPtr->parent);
+#endif
+ if (parentPtr != NULL)
+ {
+ newPtr->parentPtr = parentPtr;
+ newPtr->indent = parentPtr->indent + 1;
+ SET_PARENT_CACHE (parentPtr, newPtr->parent);
+ }
+ else
+ {
+ fprintf (stderr, "TreeTableInsertListItem: parent %i not availiable\n",
+ newPtr->parent);
+ }
+ }
+
+ if (parentPtr != NULL)
+ {
+ /* calculate the correct position of the new item */
+ *newIndex = newPtr->parent+1;
+
+ /* first item on the list */
+ if (parentPtr->succPtr == NULL)
+ {
+ parentPtr->succPtr = newPtr;
+ }
+ else
+ {
+ /* find the previos item in the succ list */
+ posPtr = NULL;
+ if (parentPtr->succPtr != NULL)
+ {
+ int i;
+ /* if sorted insertion is enabled, search for the correct position
+ * in the children list
+ */
+ if (tablePtr->sortedInsertion)
+ {
+ posPtr = TreeTableSortFindPrev
+ (parentPtr->succPtr,
+ newPtr,
+ tablePtr->sortColumn,
+ tablePtr->sortNoCase,
+ newIndex);
+ }
+ else
+ {
+ GET_CACHED_ITEM(posPtr, index-1);
+ if (posPtr == NULL || posPtr->parentPtr != parentPtr)
+ {
+ i = index - newPtr->parent - 1;
+ thisPtr = parentPtr->succPtr;
+ for (; thisPtr != NULL && i>0; thisPtr = thisPtr->nextPtr, i--)
+ {
+ *newIndex += 1 + thisPtr->succNum;
+ posPtr = thisPtr;
+ }
+ }
+ else
+ {
+ *newIndex = index;
+ }
+ }
+ }
+
+ /* add item as first element in the list */
+ if (posPtr == NULL)
+ {
+ newPtr->nextPtr = parentPtr->succPtr;
+ parentPtr->succPtr = newPtr;
+ }
+ /* insert item in the middle or at end of list */
+ else
+ {
+ newPtr->nextPtr = posPtr->nextPtr;
+ posPtr->nextPtr = newPtr;
+ }
+ }
+ }
+ else
+ {
+ /* first position */
+ *newIndex = 0;
+
+ /* insert at begin of list */
+ if (index <= 0 || tablePtr->itemPtr == NULL)
+ {
+ newPtr->nextPtr = tablePtr->itemPtr;
+ tablePtr->itemPtr = newPtr;
+
+ }
+ else
+ {
+ /* if sorted insertion is enabled, search for the correct position
+ * in the children list
+ */
+ if (tablePtr->sortedInsertion)
+ {
+ posPtr = TreeTableSortFindPrev
+ (tablePtr->itemPtr,
+ newPtr,
+ tablePtr->sortColumn,
+ tablePtr->sortNoCase,
+ newIndex);
+ }
+ else
+ {
+ /* find item before the insertion position */
+ posPtr = TreeTableFindItem (tablePtr, index - 1);
+ if (posPtr)
+ {
+ *newIndex = index;
+ }
+ }
+
+ /*
+ * insert the new item after found position
+ */
+ if (posPtr != (TableItem *) NULL)
+ {
+ /* we must be sure, that the item is added at root
+ * without any parent
+ */
+ for (; posPtr->parentPtr != NULL; posPtr=posPtr->parentPtr)
+ ;
+
+ newPtr->parentPtr = posPtr->parentPtr;
+ newPtr->indent = posPtr->indent;
+
+ newPtr->nextPtr = posPtr->nextPtr;
+ posPtr->nextPtr = newPtr;
+
+ }
+ /* insert item on top of list */
+ else
+ {
+ newPtr->nextPtr = tablePtr->itemPtr;
+ tablePtr->itemPtr = newPtr;
+ }
+ }
+ }
+ }
+
+ /* increment item number of parents to quicke searching */
+ hidden = 0;
+ for (parentPtr=newPtr->parentPtr; parentPtr; parentPtr=parentPtr->parentPtr)
+ {
+ if (parentPtr->flags&ITEM_HIDDEN_SUBTREE)
+ {
+ hidden = 1;
+ }
+ parentPtr->succNum ++;
+ if (!hidden)
+ {
+ parentPtr->seenNum ++;
+ }
+ }
+
+ FREE_RONG_CACHE (*newIndex);
+ FREE_RONG_PARENT_CACHE(*newIndex);
+ SET_CACHED (newPtr, *newIndex);
+
+ /* Delete entries from Pathfinder after this position */
+ DELETE_FROM_PATHFINDER(*newIndex);
+
+ return hidden;
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TreeTableInsertItem --
+ *
+ * Add a new item to the tree table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * New information gets added to tablePtr; it will be redisplayed
+ * soon, but not immediately.
+ *
+ *----------------------------------------------------------------------
+ */
+static TableItem*
+TreeTableInsertItem(register TreeTable *tablePtr, /* TreeTable that is to get the new
+ * items. */
+ register int index, /* Add the new items before this
+ * line */
+ register TableItem* prevPtr,
+ register int argc, /* argument count for argv */
+ register char **argv) /* argument strings */
+{
+ register TableItem *newPtr;
+ int hidden;
+ int oldmaxwidth, newIndex = -1;
+
+ /*
+ * Find the item before which the new ones will be inserted.
+ */
+ if (index <= 0)
+ {
+ index = 0;
+ }
+ if (index > tablePtr->numItems)
+ {
+ index = tablePtr->numItems;
+ }
+
+ newPtr = (TableItem *) ckalloc(sizeof(TableItem));
+ memset (newPtr, 0, sizeof(TableItem));
+ if (newPtr==NULL)
+ {
+ fprintf (stderr, "TreeTableInsertItem: FATAL ERROR: Can't allocate memory\n");
+ return NULL;
+ }
+
+ /*
+ * initialize new item
+ */
+ newPtr->lineWidth = tablePtr->defLineWidth;
+ newPtr->parent = -1;
+
+ newPtr->fontHeight = tablePtr->defFontHeight;
+
+ /*
+ * Call lineconfigure for creation options
+ */
+ if (ConfigureTreeTableItem(tablePtr, newPtr, argc,
+ argv,
+ TK_CONFIG_ARGV_ONLY,
+ CONFIG_OPTIONS_ONLY)
+ != TCL_OK)
+ {
+ ViewArgs ("couldn't add item", argc, argv, 0);
+
+ TreeTableRemoveItem (tablePtr, newPtr, -1, NULL, 0, 0);
+ return NULL;
+ }
+#if 0
+ if (newPtr->text == NULL)
+ {
+ ViewArgs ("FATAL ERROR: item->text == NULL", argc, argv);
+ TreeTableRemoveItem (tablePtr, newPtr, -1, NULL, 0, 0);
+ return NULL;
+ }
+#endif
+
+ /*
+ * Khamis: 26-03-97
+ * Add item to the list structure
+ */
+ hidden = TreeTableInsertListItem (tablePtr, newPtr, prevPtr, index, &newIndex);
+ InsertedNewPosition = newIndex;
+
+ /*
+ * Update item count, adjust selection.
+ */
+ tablePtr->numItems++;
+
+ /* correct anchor and active */
+ if (tablePtr->selectAnchor >= index)
+ {
+ tablePtr->selectAnchor ++;
+ }
+ if (tablePtr->active >= index)
+ {
+ tablePtr->active ++;
+ }
+
+ /* recompute width and height if item is viewed and not in the
+ * hidden sub tree
+ */
+ if (!hidden)
+ {
+ TreeTableComputeLineHeight(tablePtr, newPtr, 1);
+ tablePtr->flags |= UPDATE_V_SCROLLBAR;
+
+ oldmaxwidth = tablePtr->maxWidth;
+ TreeTableComputeWidths(tablePtr, newPtr, 0);
+ if (oldmaxwidth != tablePtr->maxWidth)
+ {
+ tablePtr->flags |= UPDATE_H_SCROLLBAR;
+ }
+
+ TreeTableRedrawRange(tablePtr);
+ }
+ if (tablePtr->BestFit)
+ {
+ ComputeTabStops (tablePtr, newPtr);
+ }
+ return newPtr;
+}
+
+/*
+ * add many items on the same position with same options **
+ */
+static int
+TreeTableInsertItems (TreeTable* tablePtr,
+ int index, Tcl_Obj *itemlist,
+ int argc, Tcl_Obj *objv[])
+{
+ TableItem*newPtr=NULL;
+ int i, oldmaxwidth, size;
+ int nargc = argc + 2, targpos;
+ static char **nargv = NULL;
+ int ret = TCL_OK;
+ int itemnum;
+ Tcl_Obj *next = NULL;
+
+ /*
+ * free older allocations
+ */
+ if (nargv != NULL)
+ {
+ ckfree ((char*)nargv);
+ }
+ nargv = (char**)ckalloc (sizeof(char**)*nargc);
+ for (targpos=0; targpos<argc; targpos++)
+ {
+ nargv[targpos] = O_STR(targpos);
+ }
+ nargv[targpos++] = "-text";
+
+ if (Tcl_ListObjLength (tablePtr->interp, itemlist, &itemnum) != TCL_OK)
+ return TCL_ERROR;
+
+ for (i = 0; i<itemnum; i++)
+ {
+ if (Tcl_ListObjIndex (tablePtr->interp, itemlist, i, &next) != TCL_OK)
+ {
+ break;
+ }
+
+ nargv[targpos] = Tcl_GetStringFromObj (next, &size);
+ if (size == 0)
+ {
+ continue; /* don't add empty strings (core dump) */
+ }
+
+ newPtr = TreeTableInsertItem(tablePtr, index, newPtr, nargc, nargv);
+ if (newPtr == NULL)
+ {
+ ret = TCL_ERROR;
+ break;
+ }
+ if (!tablePtr->tabs)
+ {
+ oldmaxwidth = tablePtr->maxWidth;
+ TreeTableComputeWidths(tablePtr, newPtr, 0);
+ if (oldmaxwidth != tablePtr->maxWidth)
+ {
+ tablePtr->flags |= UPDATE_H_SCROLLBAR;
+ }
+ }
+ }
+ return ret;
+}
+
+/*
+ * Delete only the line indicated, which requires us to remove all
+ * references to this node as a parent.
+ */
+static void
+TreeTableDeleteRange(tablePtr, start, end)
+ TreeTable *tablePtr; /* table in which target item resides */
+ int start,end; /* range of items to delete */
+{
+ TableItem *posPtr,*Ptr;
+ int i;
+ int oldmaxwidth, width = 0, children = 0;
+
+ /* First check to make sure there any items to delete. If there
+ * are not, simply return TCL_OK */
+ if (!tablePtr->numItems || start > end)
+ {
+ return;
+ }
+
+ /* delete all */
+ if (start <= 0 && end >= tablePtr->numItems-1)
+ {
+ int j;
+ children = 1;
+ i = j = 0;
+ for (posPtr=tablePtr->itemPtr; posPtr != NULL;)
+ {
+ Ptr=posPtr->nextPtr;
+ j = i + 1 + posPtr->succNum;
+ TreeTableRemoveItem (tablePtr, posPtr, i, &width, 0, children);
+ i = j;
+ posPtr=Ptr;
+ }
+ FREE_RONG_CACHE(0);
+ FREE_RONG_PARENT_CACHE(0);
+ tablePtr->itemPtr = NULL;
+ }
+ else for (i=end; i>=start; i--)
+ {
+ posPtr = TreeTableFindItem(tablePtr,i);
+ if (posPtr == NULL)
+ {
+ continue;
+ }
+ TreeTableRemoveItem (tablePtr, posPtr, i, &width, 0, children);
+ }
+
+ /* if BestFit is enabled and no items are availiable
+ * then set the tab stops to the default value
+ */
+ if (tablePtr->BestFit && tablePtr->numItems == 0)
+ {
+ for (i=0; i<tablePtr->tabsNum; i++)
+ {
+ if (tablePtr->tabsHidden[i])
+ {
+ tablePtr->tabs[i] = tablePtr->tabsMinSpace;
+ }
+ else
+ {
+ tablePtr->tabs[i] = tablePtr->defTabs[i];
+ }
+ }
+ }
+
+ /* if width is changed */
+ if (width >= tablePtr->maxWidth)
+ {
+ oldmaxwidth = tablePtr->maxWidth;
+ TreeTableComputeWidths (tablePtr, (TableItem *) NULL, 1);
+ if (oldmaxwidth != tablePtr->maxWidth)
+ {
+ tablePtr->flags |= UPDATE_H_SCROLLBAR;
+ }
+ }
+ TreeTableComputeLineHeight (tablePtr, NULL, 0);
+ tablePtr->flags |= UPDATE_V_SCROLLBAR;
+
+ /* correct top index */
+ if (tablePtr->topIndex > tablePtr->numViewed - tablePtr->numLines)
+ tablePtr->topIndex = Max (0, tablePtr->numViewed - tablePtr->numLines);
+
+ TreeTableRedrawRange(tablePtr);
+}
+
+/*
+ * Delete the indicated item and all of its descendants.
+ *
+ * return count of deleted items
+ */
+static int
+TreeTableRemoveItem(TreeTable *tablePtr, /* table in which the target item resides */
+ TableItem *itemPtr, /* item to delete */
+ int lineNum,
+ int* lineWidth,
+ int original_item,
+ int children /* only true if this is the original item
+ * marked for deletion. Children of the
+ * target item will be deleted, but this
+ * flag will not be set for them. */
+ )
+{
+ TableItem *Ptr, *tmpPtr, *prevPtr, *topPtr;
+ int i, index;
+ int deleted = 1, hidden, width;
+
+ /*
+ * go through and mark references to parents after us as being
+ * one line less, and delete any children we have. Have to use
+ * indexes instead of following the linked list because the
+ * list itself will be modified as we travel through the loop.
+ */
+ if (itemPtr == (TableItem *) NULL)
+ {
+ fprintf(stderr, "TreeTableRemoveItem: Attempt to delete NULL item.\n");
+ return 0;
+ }
+
+ /* correct selection range */
+ if (lineNum == -1)
+ {
+ index = TreeTableFindIndex(tablePtr, itemPtr);
+ }
+ else
+ {
+ index = lineNum;
+ }
+
+ /*
+ * no such node in tree anymore -- should not happen
+ */
+ if (index == -1)
+ {
+ fprintf(stderr, "Fatal Error: TreeTableRemoveItem: could not find index.\n");
+ fprintf(stderr, "line: %s, image: %s\n",
+ itemPtr->text ? itemPtr->text : "NULL",
+ itemPtr->imageString ? itemPtr->imageString : "NULL");
+ TreeTableFreeItem(tablePtr, itemPtr);
+ return 0;
+ }
+ if (tablePtr->active > index)
+ {
+ tablePtr->active --;
+ }
+
+ /* delete sub tree of this item */
+ for (tmpPtr=itemPtr->succPtr, i=index+1; tmpPtr != NULL; )
+ {
+ int r;
+ Ptr = tmpPtr->nextPtr;
+ r = TreeTableRemoveItem (tablePtr, tmpPtr, i, lineWidth, 0, 1);
+ i += r;
+ deleted += r;
+ tmpPtr = Ptr;
+ }
+
+ /* decrement succ number of parents */
+ hidden = 0;
+ for (Ptr=itemPtr->parentPtr; Ptr != NULL; Ptr=Ptr->parentPtr)
+ {
+ Ptr->succNum --;
+ if (Ptr->flags & ITEM_HIDDEN_SUBTREE)
+ {
+ hidden = 1;
+ }
+ if (!hidden)
+ {
+ Ptr->seenNum --;
+ }
+ }
+
+ if (!children)
+ {
+ FREE_RONG_CACHE(index);
+ FREE_RONG_PARENT_CACHE(index);
+
+ /*
+ * Now remove this item from the list of items.
+ */
+ if (itemPtr->parentPtr != NULL)
+ {
+ topPtr = itemPtr->parentPtr->succPtr;
+ }
+ else
+ {
+ topPtr = tablePtr->itemPtr;
+ }
+ if (topPtr != NULL)
+ {
+ /* first item in the list */
+ if (topPtr == itemPtr)
+ {
+ if (itemPtr->parentPtr != NULL)
+ {
+ itemPtr->parentPtr->succPtr = itemPtr->nextPtr;
+ }
+ else
+ {
+ tablePtr->itemPtr = itemPtr->nextPtr;
+ }
+ }
+ else
+ {
+ /* concat the tow parts */
+ for (prevPtr=topPtr; prevPtr != NULL; prevPtr=prevPtr->nextPtr)
+ {
+ if (prevPtr->nextPtr != NULL && prevPtr->nextPtr == itemPtr)
+ {
+ prevPtr->nextPtr = itemPtr->nextPtr;
+ break;
+ }
+ }
+ if (prevPtr == NULL)
+ {
+ fprintf(stderr, "Fatal Error: TreeTableRemoveItem: previos list element not found");
+ exit (1);
+ }
+ }
+ }
+ else
+ {
+ fprintf(stderr, "fatal error: TreeTableRemoveItem: couldn't find root to delete item (%s)\n",
+ itemPtr->text);
+ }
+ }
+
+ width = itemPtr->lineWidth;
+ if (lineWidth && *lineWidth < width)
+ {
+ *lineWidth = width;
+ }
+
+ /* decrement number of items */
+ tablePtr->numItems --;
+
+ /* decrement number of selected items, if item is selected */
+ if (itemPtr->flags&ITEM_SELECTED)
+ {
+ tablePtr->numSelected --;
+ }
+
+ /* Delete the entries of the Pathfinder after this index */
+ DELETE_FROM_PATHFINDER(index);
+
+ /* now we can destroy item */
+ TreeTableFreeItem(tablePtr, itemPtr);
+
+ /* correct anchor and active */
+ if (tablePtr->selectAnchor > index)
+ {
+ tablePtr->selectAnchor --;
+ }
+ if (tablePtr->active > index)
+ {
+ tablePtr->active --;
+ }
+
+ if (original_item && !hidden)
+ {
+ int oldmaxwidth;
+ if (width >= tablePtr->maxWidth)
+ {
+ oldmaxwidth = tablePtr->maxWidth;
+ TreeTableComputeWidths(tablePtr, (TableItem *) NULL, 1);
+ if (oldmaxwidth != tablePtr->maxWidth) {
+ tablePtr->flags |= UPDATE_H_SCROLLBAR;
+ }
+ }
+ TreeTableComputeLineHeight(tablePtr, NULL, - deleted);
+ tablePtr->flags |= UPDATE_V_SCROLLBAR;
+ TreeTableRedrawRange(tablePtr);
+ }
+
+ return deleted;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TreeTableFreeItem --
+ *
+ * Free up the resources used by the item, then free the item itself.
+ * Note that this does nothing more than free the structure -- it
+ * does not adjust the item list or anything else.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory gets freed.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TreeTableFreeItem(tablePtr, itemPtr)
+ register TreeTable *tablePtr; /* Treetable widget to modify. */
+ TableItem *itemPtr; /* Item to free */
+{
+ Tk_FreeOptions(itemConfigSpecs, (char *) itemPtr, tablePtr->display, 0);
+ if (itemPtr->textGC != None)
+ {
+ Tk_FreeGC(tablePtr->display, itemPtr->textGC);
+ }
+ if (itemPtr->bitmapGC != None)
+ {
+ Tk_FreeGC(tablePtr->display, itemPtr->bitmapGC);
+ }
+#ifdef USE_BITMAP_COLOR
+ if (itemPtr->bitmapSelectGC != None)
+ {
+ Tk_FreeGC(tablePtr->display, itemPtr->bitmapSelectGC);
+ }
+ if (itemPtr->lineGC != None)
+ {
+ Tk_FreeGC(tablePtr->display, itemPtr->lineGC);
+ }
+#endif
+ if (itemPtr->bitmap != None)
+ {
+ Tk_FreeBitmap(tablePtr->display, itemPtr->bitmap);
+ }
+ ckfree ((char *) itemPtr);
+}
+
+static int
+TreeTableToggle (TreeTable* tablePtr, int xx, int yy, int testonly)
+{
+ int ret;
+ int pos = 0, realpos = 0;
+
+ if (xx < 0 || yy < 0)
+ {
+ return ITEM_TEXT;
+ }
+
+ /* try to toggle or test if we can toggle */
+ ret = TreeTableToggleSubTree (tablePtr, tablePtr->itemPtr, &realpos, &pos, xx, yy, testonly);
+
+ /* index not found */
+ if (ret >= 0)
+ return ITEM_NOT_FOUND;
+
+ /* bitmap clicked or text selection*/
+ return ret;
+}
+
+static void
+TreeTableToggleIt (TreeTable* tablePtr, TableItem*Ptr)
+{
+ TableItem *pPtr;
+ int j, seen = 0, hidden = 0;
+ if (Ptr->flags&ITEM_HIDDEN_SUBTREE)
+ {
+ Ptr->flags &= ~ITEM_HIDDEN_SUBTREE;
+
+ /* recalculate seen items in sub tree and in parents too */
+ Ptr->seenNum = TreeTableCountNotHidden_x (Ptr->succPtr);
+ for (pPtr=Ptr->parentPtr; pPtr != NULL; pPtr=pPtr->parentPtr)
+ {
+ if (pPtr->flags&ITEM_HIDDEN_SUBTREE)
+ {
+ hidden = 1;
+ break;
+ }
+ pPtr->seenNum += Ptr->seenNum;
+ }
+ seen = Ptr->seenNum;
+ }
+ else
+ {
+ Ptr->flags |= ITEM_HIDDEN_SUBTREE;
+
+ /* no seen items in it's sub tree and in parents too */
+ for (pPtr=Ptr->parentPtr; pPtr != NULL; pPtr=pPtr->parentPtr)
+ {
+ if (pPtr->flags&ITEM_HIDDEN_SUBTREE)
+ {
+ hidden = 1;
+ break;
+ }
+ pPtr->seenNum -= Ptr->seenNum;
+ }
+ seen = - Ptr->seenNum;
+ Ptr->seenNum = 0;
+ }
+
+ /* lost selected items in the sub tree */
+ j = 0;
+ TreeTableLostSel_x (tablePtr, Ptr->succPtr, &j, 0, tablePtr->numItems-1);
+
+ /* recompute vertical */
+ if (hidden)
+ {
+ return;
+ }
+ tablePtr->numViewed += seen;
+
+ /* recompute horizontal */
+ TreeTableComputeWidths (tablePtr, NULL, 1);
+
+ tablePtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR;
+ TreeTableRedrawRange (tablePtr);
+}
+
+static int
+TreeTableToggleSubTree (TreeTable* tablePtr, TableItem* itemPtr,
+ int* realpos, int* pos, int xx, int yy, int testonly)
+{
+ TableItem *Ptr;
+
+ char indexStr[64];
+
+ sprintf (indexStr, "@%i,%i", xx, yy);
+
+ if (GetTreeTableIndex (tablePtr, indexStr, 0, realpos) != TCL_OK)
+ {
+ return ITEM_UNKNOWN;
+ }
+ Ptr = TreeTableFindItem (tablePtr, *realpos);
+ if (Ptr == NULL)
+ {
+ return ITEM_NOT_FOUND;
+ }
+
+ if (xx >= ITEM_X(Ptr) && xx <= ITEM_X(Ptr)+Ptr->bitmapWidth+2)
+ {
+ if (Ptr->succPtr != NULL)
+ {
+ if (testonly)
+ {
+ if (Ptr->flags&ITEM_HIDDEN_SUBTREE)
+ return ITEM_HIDDEN;
+ else
+ return ITEM_VIEWED;
+ }
+
+ TreeTableToggleIt (tablePtr, Ptr);
+
+ /* we don't need to force forward */
+ if (Ptr->flags&ITEM_HIDDEN_SUBTREE)
+ {
+ return ITEM_HIDDEN;
+ }
+ else
+ {
+ return ITEM_VIEWED;
+ }
+ }
+ /* item bitmap without sub tree is clicked */
+ else
+ {
+ return ITEM_UNKNOWN;
+ }
+ }
+ else if (xx > ITEM_X(Ptr)+Ptr->bitmapWidth) /* text is clicked */
+ {
+ return ITEM_TEXT;
+ }
+ else
+ {
+ return ITEM_NOT_FOUND;
+ }
+}
+
+static int
+TreeTableToggleItem (TreeTable* tablePtr, TableItem *itemPtr, int hide)
+{
+ int ret = TCL_OK;
+
+ /* have no children */
+ if (itemPtr->succNum == 0)
+ {
+ return ret;
+ }
+
+ /* already hidden or viewed */
+ if (((itemPtr->flags&ITEM_HIDDEN_SUBTREE) && hide) ||
+ (!(itemPtr->flags&ITEM_HIDDEN_SUBTREE) && !hide))
+ {
+ return ret;
+ }
+ TreeTableToggleIt (tablePtr, itemPtr);
+ return ret;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TreeTableEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on treetables.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+TreeTableEventProc(
+ ClientData clientData, /* Information about window. */
+ XEvent *eventPtr) /* Information about event. */
+{
+ TreeTable *tablePtr = (TreeTable *) clientData;
+
+ if (eventPtr->type == Expose)
+ {
+ TreeTableRedrawRange(tablePtr);
+ }
+ else if (eventPtr->type == DestroyNotify)
+ {
+ /* Zsolt Koppany, 3-jan-97 */
+ if (tablePtr->tkwin != NULL)
+ {
+ if (tablePtr->setGrid) {
+ Tk_UnsetGrid(tablePtr->tkwin);
+ }
+ tablePtr->tkwin = NULL;
+ Tcl_DeleteCommand(tablePtr->interp,
+ Tcl_GetCommandName(tablePtr->interp,tablePtr->widgetCmd));
+ }
+
+ if (tablePtr->flags & REDRAW_PENDING)
+ {
+ Tcl_CancelIdleCall(DisplayTreeTable, (ClientData) tablePtr);
+ }
+ Tcl_EventuallyFree((ClientData) tablePtr, DestroyTreeTable);
+ }
+ else if (eventPtr->type == ConfigureNotify)
+ {
+ Tcl_Preserve((ClientData) tablePtr);
+
+ tablePtr->numLines = TREETABLE_NUM_LINES(tablePtr);
+
+ tablePtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR;
+ TreeTableRedrawRange(tablePtr);
+ Tcl_Release((ClientData) tablePtr);
+ }
+ else if (eventPtr->type == FocusIn)
+ {
+ if (eventPtr->xfocus.detail != NotifyInferior)
+ {
+ tablePtr->flags |= GOT_FOCUS;
+ TreeTableRedrawRange(tablePtr);
+ }
+ }
+ else if (eventPtr->type == FocusOut)
+ {
+ if (eventPtr->xfocus.detail != NotifyInferior)
+ {
+ tablePtr->flags &= ~GOT_FOCUS;
+ TreeTableRedrawRange(tablePtr);
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetTreeTableIndex --
+ *
+ * Parse an index into a treetable 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 corresponding to
+ * string. Otherwise an error message is left in interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetTreeTableIndex(
+ TreeTable *tablePtr, /* TreeTable for which the index is being
+ * specified. */
+ char *string, /* Numerical index into tablePtr's item
+ * list, or "end" to refer to last item. */
+ int endAfter, /* 0 means "end" refers to the index of the
+ * last item, 1 means it refers to the
+ * item after the last one. */
+ int *indexPtr) /* Where to store converted index. */
+{
+ int length = strlen (string);
+ if (string[0] == 'e' && strncmp(string, "end", length) == 0)
+ {
+ *indexPtr = tablePtr->numItems;
+ }
+ else if (string[0] == 'a' && strncmp(string, "active", length) == 0)
+ {
+ *indexPtr = tablePtr->active;
+ }
+ else if (string[0] == '@')
+ {
+ int x, y;
+ char *p, *end;
+
+ p = string+1;
+ x = strtol(p, &end, 0);
+ if ((end == p) || (*end != ','))
+ {
+ goto badIndex;
+ }
+ p = end+1;
+ y = strtol(p, &end, 0);
+ if ((end == p) || (*end != 0))
+ {
+ goto badIndex;
+ }
+ *indexPtr = NearestTreeTableItem(tablePtr, y);
+ }
+ else if ((string[0] == 'a') && (strncmp(string, "anchor", length) == 0) && (length >= 2))
+ {
+ *indexPtr = tablePtr->selectAnchor;
+ }
+ else
+ {
+ if (Tcl_GetInt(tablePtr->interp, string, indexPtr) != TCL_OK)
+ {
+ Tcl_ResetResult(tablePtr->interp);
+ goto badIndex;
+ }
+ }
+
+ if (endAfter)
+ {
+ if (*indexPtr > tablePtr->numItems)
+ {
+ *indexPtr = tablePtr->numItems;
+ }
+ }
+ else if (*indexPtr >= tablePtr->numItems)
+ {
+ *indexPtr = tablePtr->numItems-1;
+ }
+ if (tablePtr->numItems <= 0)
+ {
+ *indexPtr = 0;
+ }
+ else if (*indexPtr < 0)
+ {
+ *indexPtr = 0;
+ }
+ return TCL_OK;
+
+badIndex:
+ Tcl_AppendResult(tablePtr->interp, "bad treetable index \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangeTreeTableView --
+ *
+ * Change the view on a treetable widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * What's displayed on the screen is changed. If there is a
+ * scrollbar associated with this widget, then the scrollbar
+ * is instructed to change its display too.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChangeTreeTableView(register TreeTable *tablePtr, /* Information about widget. */
+ int index, /* Index of item in tablePtr */
+ int redraw)
+{
+ int count;
+
+ count = TreeTableCountNotHidden (tablePtr, 0);
+
+ if (index >= (count - tablePtr->numLines))
+ {
+ index = count - tablePtr->numLines;
+ }
+
+ if (index < 0) {
+ index = 0;
+}
+
+ if (tablePtr->topIndex != index || redraw)
+ {
+ tablePtr->topIndex = index;
+ if (!(tablePtr->flags & REDRAW_PENDING))
+ {
+ Tk_DoWhenIdle(DisplayTreeTable, (ClientData) tablePtr);
+ tablePtr->flags |= REDRAW_PENDING;
+ }
+ tablePtr->flags |= UPDATE_V_SCROLLBAR;
+ }
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangeTreeTableOffset --
+ *
+ * Change the horizontal offset for a treetable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The treetable may be redrawn to reflect its new horizontal
+ * offset.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ChangeTreeTableOffset(tablePtr, offset)
+ register TreeTable *tablePtr; /* Information about widget. */
+ int offset; /* Desired new "xOffset" for
+ * treetable. */
+{
+ int maxOffset;
+
+ /*
+ * Make sure that the new offset is within the allowable range, and
+ * round it off to an even multiple of xScrollUnit.
+ */
+ maxOffset = tablePtr->maxWidth
+ + (tablePtr->xScrollUnit-1)
+ - (Tk_Width(tablePtr->tkwin)
+ - 2 * (tablePtr->selBorderWidth+tablePtr->inset)
+ - tablePtr->xScrollUnit);
+ if (offset > maxOffset)
+ {
+ offset = maxOffset;
+ }
+ if (offset < 0)
+ {
+ offset = 0;
+ }
+ offset -= offset%tablePtr->xScrollUnit;
+ if (offset != tablePtr->xOffset)
+ {
+ tablePtr->xOffset = offset;
+ tablePtr->flags |= UPDATE_H_SCROLLBAR;
+ TreeTableRedrawRange(tablePtr);
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TreeTableScanTo --
+ *
+ * Given a point (presumably of the curent mouse location)
+ * drag the view in the window to implement the scan operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The view in the window may change.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TreeTableScanTo(tablePtr, x, y)
+ register TreeTable *tablePtr; /* Information about widget. */
+ int x; /* X-coordinate to use for scan
+ * operation. */
+ int y; /* Y-coordinate to use for scan
+ * operation. */
+{
+ int newTopIndex, newOffset;
+
+ /*
+ * Compute new top line for screen by amplifying the difference
+ * between the current position and the place where the scan
+ * started (the "mark" position). If we run off the top or bottom
+ * of the list, 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).
+ */
+ int count = TreeTableCountNotHidden (tablePtr, 0);
+
+ newTopIndex = tablePtr->scanMarkYIndex
+ - (10*(y - tablePtr->scanMarkY))/tablePtr->lineHeight;
+ if (newTopIndex >= count)
+ {
+ newTopIndex = tablePtr->scanMarkYIndex = count-1;
+ tablePtr->scanMarkY = y;
+ }
+ else if (newTopIndex < 0)
+ {
+ newTopIndex = tablePtr->scanMarkYIndex = 0;
+ tablePtr->scanMarkY = y;
+ }
+ ChangeTreeTableView(tablePtr, newTopIndex, 0);
+
+ /*
+ * Compute new left edge for display in a similar fashion by amplifying
+ * the difference between the current position and the place where the
+ * scan started.
+ */
+
+ newOffset = tablePtr->scanMarkXOffset - (10*(x - tablePtr->scanMarkX));
+ if (newOffset >= tablePtr->maxWidth)
+ {
+ newOffset = tablePtr->scanMarkXOffset = tablePtr->maxWidth;
+ tablePtr->scanMarkX = x;
+ }
+ else if (newOffset < 0)
+ {
+ newOffset = tablePtr->scanMarkXOffset = 0;
+ tablePtr->scanMarkX = x;
+ }
+ ChangeTreeTableOffset(tablePtr, newOffset);
+}
+
+/*{*/
+/*
+ * Caluclate the realy index of a view index
+ */
+static int
+TreeTableRealyIndex_x (register TableItem *itemPtr, int*pos, int* rindex, int index)
+{
+ TableItem*Ptr;
+ for (Ptr=itemPtr; *pos <= index && Ptr; Ptr=Ptr->nextPtr)
+ {
+ /* found realy position */
+ if (*pos == index)
+ {
+ return -1;
+ }
+ *pos += 1;
+ *rindex += 1;
+ if (!(Ptr->flags&ITEM_HIDDEN_SUBTREE) && Ptr->succPtr != NULL)
+ {
+ int ret;
+
+ if (*pos+Ptr->seenNum < index)
+ {
+ *pos += Ptr->seenNum;
+ *rindex += Ptr->succNum;
+ }
+ else
+ {
+ ret = TreeTableRealyIndex_x (Ptr->succPtr, pos, rindex, index);
+ if (ret < 0)
+ return ret;
+ }
+ }
+ else
+ {
+ *rindex += Ptr->succNum;
+ }
+ }
+ return *rindex;
+}
+
+static int
+TreeTableRealyIndex (register TreeTable *tablePtr, int index)
+{
+ TableItem*Ptr=tablePtr->itemPtr;
+ int rindex, pos, ret;
+
+ /* there is nothing hidden, so the realy index is eq. viewed index */
+ if (tablePtr->numViewed == tablePtr->numItems)
+ {
+ return index;
+ }
+
+ FIND_IN_PATHFINDER(index, Ptr, pos);
+
+ /* calculate the realy index */
+ rindex = pos = 0;
+ ret = TreeTableRealyIndex_x(Ptr, &pos, &rindex, index);
+
+ if (ret < 0)
+ return rindex;
+
+ return -1;
+}
+/*}*/
+
+/*{*/
+/*
+ * calculate the viewed index of a realy index
+ */
+static int
+TreeTableViewedIndex_x (register TableItem *itemPtr, int*realpos, int* vindex, int index)
+{
+ TableItem*Ptr;
+ for (Ptr=itemPtr; *realpos <= index && Ptr; Ptr=Ptr->nextPtr)
+ {
+ /* found viewed position */
+ if (*realpos == index)
+ {
+ return -1;
+ }
+ *realpos += 1;
+ *vindex += 1;
+ if (Ptr->succPtr != NULL)
+ {
+ if (!(Ptr->flags&ITEM_HIDDEN_SUBTREE))
+ {
+ int ret;
+
+ if (*realpos+Ptr->succNum < index)
+ {
+ *realpos += Ptr->succNum;
+ *vindex += Ptr->seenNum;
+ }
+ else
+ {
+ ret = TreeTableViewedIndex_x (Ptr->succPtr, realpos, vindex, index);
+ if (ret < 0)
+ return ret;
+ }
+ }
+ /* if item is in a hidden sub tree, then return his first viewed parent */
+ else if (*realpos+Ptr->succNum >= index)
+ {
+ *vindex -= 1;
+ return -1;
+ }
+ else
+ {
+ *realpos += Ptr->succNum;
+ *vindex += Ptr->seenNum;
+ }
+ }
+ }
+ return *vindex;
+}
+static int
+TreeTableViewedIndex (register TreeTable *tablePtr, int index)
+{
+ int vindex, realpos, ret;
+
+ /* there is nothing hidden */
+ if (tablePtr->numViewed == tablePtr->numItems)
+ {
+ return index;
+ }
+
+ /* calculate the viewed index of a realy index */
+ vindex = realpos = 0;
+ ret = TreeTableViewedIndex_x(tablePtr->itemPtr, &realpos, &vindex, index);
+
+ if (ret < 0)
+ return vindex;
+
+ return -1;
+}
+/*}*/
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NearestTreeTableItem --
+ *
+ * Given a y-coordinate inside a treetable, compute the index of
+ * the item under that y-coordinate (or closest to that
+ * y-coordinate).
+ *
+ * Results:
+ * The return value is an index of an element of itemPtr. If
+ * itemPtr has no elements, then 0 is always returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+NearestTreeTableItem(tablePtr, y)
+ register TreeTable *tablePtr; /* Information about widget. */
+ int y; /* Y-coordinate in tablePtr's window. */
+{
+ int index;
+ int count;
+
+ count = TreeTableCountNotHidden (tablePtr, 0);
+
+ if (y < 0) y = 0;
+ index = (y - tablePtr->borderWidth)/tablePtr->lineHeight;
+
+ /* correct the index in usable range */
+ if (index < 0)
+ {
+ index = 0;
+ }
+ if (index > tablePtr->numLines)
+ {
+ index = tablePtr->numLines - 1;
+ }
+ index += tablePtr->topIndex;
+ if (index >= count)
+ {
+ index = count - 1;
+ }
+
+ /* return realy index in the tree */
+ return TreeTableRealyIndex (tablePtr, index);
+}
+
+
+/*
+ * TreeTableComputeLineHeight
+ *
+ * Cycles through all of the items in the table and computes
+ * the maximum line height.
+ *
+ *
+ */
+static int
+TreeTableComputeLineHeight_x (TableItem* itemPPtr, TableItem* thisPtr, int maxHeight)
+{
+ TableItem* itemPtr = itemPPtr;
+ int height = maxHeight;
+
+ while (itemPtr != (TableItem *) NULL)
+ {
+ if (itemPtr->fontHeight > height)
+ {
+ height = itemPtr->fontHeight;
+ }
+ if (itemPtr->bitmapHeight > height)
+ {
+ height = itemPtr->bitmapHeight;
+ }
+
+ /* force only the first item */
+ if (thisPtr != NULL)
+ break;
+
+ if (itemPtr->succPtr != NULL)
+ {
+ height =
+ TreeTableComputeLineHeight_x
+ (itemPtr->succPtr, thisPtr, height);
+ }
+ itemPtr = itemPtr->nextPtr;
+ }
+ return height;
+}
+static void
+TreeTableComputeLineHeight(TreeTable *tablePtr, TableItem* thisPtr, int cnt)
+{
+ register TableItem *itemPtr;
+ register int maxHeight;
+
+
+ if (cnt == 0)
+ {
+ if (thisPtr != NULL)
+ {
+ itemPtr = thisPtr;
+ }
+ else
+ {
+ itemPtr = tablePtr->itemPtr;
+ }
+ maxHeight =
+ TreeTableComputeLineHeight_x
+ (itemPtr, thisPtr, tablePtr->defFontHeight);
+ tablePtr->lineHeight = maxHeight + 1 + 2*tablePtr->selBorderWidth;
+ TreeTableCountNotHidden(tablePtr, 1);
+ }
+ else
+ {
+ tablePtr->numViewed += cnt;
+ }
+}
+
+
+static void
+TreeTableComputeWidths_x (TreeTable* tablePtr, TableItem* itemPtr,
+ TableItem* thisPtr, int checkall)
+{
+ TableItem* travPtr;
+
+ if (thisPtr != NULL)
+ {
+ travPtr = thisPtr;
+ }
+ else
+ {
+ travPtr = itemPtr;
+ }
+
+ for (; travPtr != (TableItem *) NULL;
+ travPtr = travPtr->nextPtr)
+ {
+ if (tablePtr->BestFit && tablePtr->tabs != NULL)
+ {
+ ComputeTabStops (tablePtr, travPtr);
+ }
+ else
+ {
+ /* find max. width only */
+ if (thisPtr != NULL || checkall == 2)
+ travPtr->lineWidth =
+ Tk_TextWidth (travPtr->fontPtr != NULL ? travPtr->fontPtr : tablePtr->defFontPtr,
+ travPtr->text,
+ travPtr->textLength)
+ + (travPtr->indent*tablePtr->indentWidth)
+ + travPtr->bitmapWidth
+ + tablePtr->bitmapSpace
+ + tablePtr->inset
+ - tablePtr->xOffset;
+ if (travPtr->lineWidth > tablePtr->maxWidth)
+ {
+ tablePtr->maxWidth = travPtr->lineWidth;
+ }
+ }
+
+ /*
+ * calulate the max. width relative to only one given item
+ */
+ if (thisPtr != NULL)
+ {
+ return;
+ }
+
+ if (!(travPtr->flags&ITEM_HIDDEN_SUBTREE) && travPtr->succPtr != NULL)
+ {
+ TreeTableComputeWidths_x (tablePtr, travPtr->succPtr, NULL, checkall);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TreeTableComputeWidths --
+ *
+ * This procedure is invoked to recompute the width of either
+ * a single item (if itemPtr != NULL), or the entire table
+ * (fontChanged = 1).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * tablePtr->maxWidth may be modified
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TreeTableComputeWidths(tablePtr, itemPtr, checkAll)
+ TreeTable *tablePtr; /* TreeTable whos geometry is to be
+ * recomputed. */
+ TableItem *itemPtr; /* Item in the table which has changed
+ * or NULL if none has. */
+ int checkAll; /* Non-zero means to check the entire
+ * list of table items in order to
+ * recompute the max width.
+ *
+ * 0: compute only the width only for
+ * given 'itemPtr'
+ * 1: find maximum width of lines
+ * 2: recompute line width
+ * 3: If BestFit enabled, recompute the
+ * best fit for tab stops
+ */
+{
+ tablePtr->xScrollUnit = Tk_TextWidth (tablePtr->defFontPtr, "0", 1);
+
+ if (checkAll == 3 && tablePtr->BestFit && tablePtr->tabs != NULL)
+ {
+ int i;
+ for (i=0; i<tablePtr->tabsNum; i++)
+ {
+ if (tablePtr->tabsHidden[i])
+ {
+#ifdef SPACE_PROBLEM
+ tablePtr->tabs[i] = 0;
+#else
+ tablePtr->tabs[i] = tablePtr->tabsMinSpace;
+#endif
+ }
+ else
+ {
+ tablePtr->tabs[i] = tablePtr->defTabs[i];
+ }
+ }
+ }
+ /* we don't need to compute width if tab stops availiable */
+ else if (tablePtr->tabs != NULL)
+ {
+ return;
+ }
+
+ if (itemPtr == (TableItem *) NULL)
+ {
+ tablePtr->maxWidth = 10;
+ }
+
+ TreeTableComputeWidths_x (tablePtr, tablePtr->itemPtr, itemPtr, checkAll);
+}
+
+
+static int
+TreeTableSelectFromTo (
+ TreeTable*tablePtr,
+ TableItem *itemPtr,
+ int pos,
+ int start,
+ int end)
+{
+ TableItem*Ptr=itemPtr;
+ int i = pos;
+
+ /* Accelerate the location of the fist item
+ */
+ FIND_IN_PATHFINDER (start, Ptr, i);
+
+ for (; i <= end && Ptr; Ptr=Ptr->nextPtr)
+ {
+ if (i >= start && ! (Ptr->flags&ITEM_SELECTED))
+ {
+ Ptr->flags |= ITEM_SELECTED;
+
+ if (tablePtr->selectFirst > i)
+ {
+ tablePtr->selectFirst = i;
+ }
+ if (tablePtr->numSelected == 0)
+ {
+ tablePtr->lastSelected = Ptr;
+ }
+ tablePtr->numSelected ++;
+ }
+
+ i++;
+ if (Ptr->succPtr != NULL)
+ {
+ if (!(Ptr->flags&ITEM_HIDDEN_SUBTREE))
+ {
+ i = TreeTableSelectFromTo
+ (tablePtr, Ptr->succPtr,
+ i,
+ start, end);
+ }
+ else
+ {
+ i += Ptr->succNum;
+ }
+ }
+ }
+ return i;
+}
+
+static int
+TreeTableCountSelected (TableItem* itemPtr, int cnt)
+{
+ TableItem* Ptr;
+ int i = cnt;
+ for (Ptr=itemPtr; Ptr!=NULL; Ptr=Ptr->nextPtr)
+ {
+ if (Ptr->flags&ITEM_SELECTED)
+ i++;
+ if (Ptr->succPtr != NULL && !(Ptr->flags&ITEM_HIDDEN_SUBTREE))
+ {
+ i = TreeTableCountSelected (Ptr->succPtr, i);
+ }
+ }
+ return i;
+}
+
+static int
+TreeTableSetText (TableItem* itemPtr, char*argv[], int cnt)
+{
+ TableItem* Ptr;
+ int i = cnt;
+ for (Ptr=itemPtr; Ptr!=NULL; Ptr=Ptr->nextPtr)
+ {
+ if (Ptr->flags&ITEM_SELECTED)
+ {
+ argv[i++] = Ptr->text;
+ }
+ if (Ptr->succPtr != NULL)
+ {
+ i = TreeTableSetText (Ptr->succPtr, argv, i);
+ }
+ }
+ return i;
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * TreeTableFetchSelection --
+ *
+ * This procedure is called back by Tk when the selection is
+ * requested by someone. It returns part or all of the selection
+ * in a buffer provided by the caller.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored
+ * at buffer. Buffer is filled (or partially filled) with a
+ * NULL-terminated string containing part or all of the selection,
+ * as given by offset and maxBytes. The selection is returned
+ * as a Tcl list with one list element for each item in the
+ * treetable.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+TreeTableFetchSelection(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Information about treetable
+ * widget. */
+ int offset; /* Offset within selection of first
+ * byte 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. */
+{
+ register TreeTable *tablePtr = (TreeTable *) clientData;
+ char **argv, *selection;
+ int length, count, argc;
+
+ if (!tablePtr->exportSelection)
+ {
+ return -1;
+ }
+
+ /*
+ * Use Tcl_Merge to format the treetable items into a suitable
+ * Tcl list.
+ */
+ argc = TreeTableCountSelected (tablePtr->itemPtr, 0);
+ if (argc == 0)
+ {
+ return -1;
+ }
+ argv = (char **)ckalloc((unsigned) (argc*sizeof(char *)));
+ TreeTableSetText (tablePtr->itemPtr, argv, 0);
+
+ selection = Tcl_Merge(argc, argv);
+
+ /*
+ * Copy the requested portion of the selection to the buffer.
+ */
+
+ length = strlen(selection);
+ count = length - offset;
+ if (count <= 0)
+ {
+ count = 0;
+ goto done;
+ }
+ if (count > maxBytes)
+ {
+ count = maxBytes;
+ }
+ memcpy((VOID *) buffer, (VOID *) (selection + offset), count);
+
+done:
+ buffer[count] = '\0';
+ ckfree ((char*)selection);
+ ckfree ((char *) argv);
+ return count;
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TreeTableLostSelection --
+ *
+ * This procedure is called back by Tk when the selection is
+ * grabbed away from a treetable widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The existing selection is unhighlighted, and the window is
+ * marked as not containing a selection.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+TreeTableLostSel_x (register TreeTable *tablePtr,
+ register TableItem* itemPtr,
+ int *pos, int first, int last)
+{
+ register TableItem* Ptr;
+ int j = 0;
+
+ for (Ptr=itemPtr; tablePtr->numSelected > 0 && *pos<=last && Ptr != NULL;
+ Ptr=Ptr->nextPtr)
+ {
+ if (*pos >= first && *pos<=last && (Ptr->flags&ITEM_SELECTED))
+ {
+ Ptr->flags &= ~ITEM_SELECTED;
+ tablePtr->numSelected --;
+ j++;
+ }
+ *pos += 1;
+ if (Ptr->succPtr != NULL)
+ {
+ j += TreeTableLostSel_x (tablePtr, Ptr->succPtr, pos, first, last);
+ }
+ }
+ return j;
+}
+
+static int
+TreeTableLostSel (register TreeTable *tablePtr, int first, int last)
+{
+ TableItem* Ptr=tablePtr->itemPtr;
+ int i=0, ret;
+
+ if (tablePtr->numSelected == 1 && tablePtr->lastSelected != NULL)
+ {
+ tablePtr->lastSelected->flags &= ~ITEM_SELECTED;
+ tablePtr->lastSelected = NULL;
+
+ tablePtr->numSelected = 0;
+ ret = 1;
+ }
+ else
+ {
+ FIND_IN_PATHFINDER(first, Ptr, i);
+ return TreeTableLostSel_x(tablePtr, Ptr, &i, first, last);
+ }
+ tablePtr->numSelected = 0;
+
+ return ret;
+}
+
+static void
+TreeTableLostSelection(clientData)
+ ClientData clientData; /* Information about listbox widget. */
+{
+ register TreeTable *tablePtr = (TreeTable *) clientData;
+
+ /* set items as not selected */
+ if (tablePtr->exportSelection &&
+ TreeTableLostSel (tablePtr, 0, tablePtr->numItems-1) > 0)
+ {
+ TreeTableRedrawRange(tablePtr);
+ }
+}
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TreeTableRedrawRange --
+ *
+ * Ensure that a given range of elements is eventually redrawn on
+ * the display (if those elements in fact appear on the display).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+/*
+ * Calculate the seen number in a sub tree
+ */
+static int
+TreeTableCountNotHidden_x (register TableItem*itemPtr)
+{
+ register TableItem*Ptr;
+ register int i = 0;
+
+ for (Ptr=itemPtr; Ptr != NULL; Ptr=Ptr->nextPtr)
+ {
+ i += 1 + Ptr->seenNum;
+ }
+ return i;
+}
+
+/*
+ * Calculate the number of seen items on the tree
+ */
+static int
+TreeTableCountNotHidden (register TreeTable*tablePtr, int flag)
+{
+ if (flag || tablePtr->numViewed == -1)
+ {
+ register TableItem*Ptr;
+ register int i = 0;
+ for (Ptr=tablePtr->itemPtr; Ptr != NULL; Ptr=Ptr->nextPtr)
+ {
+ i += 1 + Ptr->seenNum;
+ }
+ tablePtr->numViewed = i;
+ }
+ return tablePtr->numViewed;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TreeTableUpdateVScrollbar --
+ *
+ * This procedure is invoked whenever information has changed in
+ * a treetable in a way that would invalidate a vertical scrollbar
+ * display. If there is an associated scrollbar, then this command
+ * updates it by invoking a Tcl command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Tcl command is invoked, and an additional command may be
+ * invoked to process errors in the command.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TreeTableUpdateVScrollbar(
+ register TreeTable *tablePtr /* Information about widget. */
+ )
+{
+ char string[60];
+ int result, last;
+ int count;
+
+ if (tablePtr->yScrollCmd == NULL)
+ {
+ return;
+ }
+ count = TreeTableCountNotHidden (tablePtr, 0);
+
+ last = tablePtr->topIndex + tablePtr->numLines - 1;
+ if (last >= count)
+ {
+ last = count-1;
+ }
+ if (last < tablePtr->topIndex)
+ {
+ last = tablePtr->topIndex;
+ }
+ sprintf(string, " %d %d %d %d",
+ count,
+ tablePtr->numLines,
+ tablePtr->topIndex,
+ last);
+
+ Tcl_Preserve((ClientData) tablePtr->interp);
+ result = Tcl_VarEval(tablePtr->interp, tablePtr->yScrollCmd, string,
+ (char *) NULL);
+ if (result != TCL_OK)
+ {
+ Tcl_AddErrorInfo(tablePtr->interp,
+ "\n (vertical scrolling command executed by listbox)");
+ Tk_BackgroundError(tablePtr->interp);
+ }
+ Tcl_Release((ClientData) tablePtr->interp);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TreeTableUpdateHScrollbar --
+ *
+ * This procedure is invoked whenever information has changed in
+ * a treetable in a way that would invalidate a horizontal scrollbar
+ * display. If there is an associated horizontal scrollbar, then
+ * this command updates it by invoking a Tcl command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Tcl command is invoked, and an additional command may be
+ * invoked to process errors in the command.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+TreeTableUpdateHScrollbar(
+ register TreeTable *tablePtr /* Information about widget. */
+ )
+{
+ char string[60];
+ Tcl_Interp *interp;
+ int result, windowWidth;
+ double first, last;
+
+ if (tablePtr->xScrollCmd == NULL)
+ {
+ return;
+ }
+ windowWidth = TREETABLE_WIDTH(tablePtr);
+ if (tablePtr->maxWidth == 0)
+ {
+ first = 0;
+ last = 1.0;
+ }
+ else
+ {
+ first = ((double)tablePtr->xOffset)/((double) tablePtr->maxWidth);
+ last = (tablePtr->xOffset + windowWidth)
+ /((double) tablePtr->maxWidth);
+ if (last > 1.0)
+ {
+ last = 1.0;
+ }
+ }
+
+ sprintf(string, " %g %g", first, last);
+
+ /*
+ * We must hold onto the interpreter because the data referred to at
+ * tablePtr might be freed as a result of the call to Tcl_VarEval.
+ */
+
+ interp = tablePtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ result = Tcl_VarEval(interp, tablePtr->xScrollCmd, string,
+ (char *) NULL);
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (horizontal scrolling command executed by listbox)");
+ Tcl_BackgroundError(interp);
+}
+ Tcl_Release((ClientData) interp);
+}
+
+enum
+{
+ SRCH_EXACT = 1,
+ SRCH_GLOB,
+ SRCH_REGEXP,
+ SRCH_BEGINS
+};
+
+typedef struct
+{
+ char *pattern, *varName;
+ Tcl_DString line;
+ int backwards, exact, noCase;
+ int matchLength;
+ int patLength;
+ int index, stopIndex;
+ int lineNum;
+ Tcl_RegExp regexp;
+ int (* cmpProc) (char*, char*, int);
+ int code;
+ int realindex;
+} searchParam_t;
+
+static int
+TreeTableSearchCmd_x (TreeTable* tablePtr, TableItem* linePtr,
+ searchParam_t* prm)
+{
+ int found = 0;
+ char *p;
+
+ if (prm->exact != SRCH_EXACT && prm->exact != SRCH_BEGINS)
+ {
+ Tcl_DStringInit(&prm->line);
+ }
+
+ for (;linePtr;)
+ {
+ /* only by searching forwards */
+ if (! prm->backwards)
+ {
+ if (prm->lineNum < prm->index || prm->lineNum > prm->stopIndex)
+ {
+ goto nextLine;
+ }
+ }
+ else
+ {
+ if (prm->lineNum >= tablePtr->numItems) {
+ /*
+ * Don't search the dummy last line of the text.
+ */
+ goto nextLine;
+ }
+ if (prm->realindex) /* find real items */
+ {
+ linePtr = TreeTableFindItem (tablePtr, prm->lineNum);
+ }
+ else /* find virtual items */
+ {
+ linePtr = TreeTableFindNotHiddenItem(tablePtr, prm->lineNum, 0);
+ }
+ if (linePtr == NULL)
+ {
+ goto nextLine;
+ }
+ }
+
+ if (prm->exact != SRCH_EXACT && prm->exact != SRCH_BEGINS)
+ {
+ Tcl_DStringAppend(&prm->line, linePtr->text, linePtr->textLength);
+ }
+ if (prm->exact == SRCH_REGEXP)
+ {
+ Tcl_DStringSetLength(&prm->line, Tcl_DStringLength(&prm->line)-1);
+ }
+
+ /*
+ * If we're ignoring case, convert the line to lower case.
+ */
+ if (prm->noCase && prm->exact != SRCH_EXACT && prm->exact != SRCH_BEGINS)
+ {
+ for (p = Tcl_DStringValue(&prm->line); *p != 0; p++)
+ {
+ if (isupper(UCHAR(*p)))
+ {
+ *p = tolower(UCHAR(*p));
+ }
+ }
+ }
+
+ if (prm->exact == SRCH_EXACT)
+ {
+ if (prm->patLength == linePtr->textLength && prm->cmpProc (linePtr->text, prm->pattern, prm->patLength) == 0)
+ {
+ found = 1; /* string found */
+ goto done;
+ }
+ }
+ else if (prm->exact == SRCH_BEGINS)
+ {
+ if (prm->cmpProc (linePtr->text, prm->pattern, prm->patLength) == 0)
+ {
+ found = 1; /* string found */
+ goto done;
+ }
+ }
+ else if (prm->exact == SRCH_REGEXP)
+ {
+ switch (prm->matchLength = Tcl_RegExpExec(tablePtr->interp, prm->regexp,
+ Tcl_DStringValue(&prm->line),
+ Tcl_DStringValue(&prm->line)))
+ {
+ case -1:
+ prm->code = TCL_ERROR;
+ goto done;
+ break;
+ case 0: /* Not found ! */
+ break;
+ default: /* found */
+ found = 1;
+ goto done;
+ break;
+
+ }
+ }
+ else if (prm->exact == SRCH_GLOB)
+ {
+ if (Tcl_StringMatch(Tcl_DStringValue(&prm->line), prm->pattern))
+ {
+ found = 1;
+ goto done;
+ }
+ }
+
+ /*
+ * Go to the next (or previous) line;
+ */
+ nextLine:
+ if (prm->backwards)
+ {
+ prm->lineNum--;
+ if (prm->lineNum < prm->stopIndex)
+ {
+ prm->code = TCL_OK;
+ return -1;
+ }
+ else if (prm->lineNum < 0)
+ {
+ prm->lineNum = tablePtr->numItems-1;
+ }
+ }
+ else
+ {
+ prm->lineNum++;
+ if (linePtr->succPtr != NULL && !(linePtr->flags&ITEM_HIDDEN_SUBTREE))
+ {
+ int ret;
+ ret = TreeTableSearchCmd_x (tablePtr, linePtr->succPtr, prm);
+ if (ret < 0)
+ {
+ return ret;
+ }
+ }
+ else
+ {
+ prm->lineNum += linePtr->succNum;
+ }
+ linePtr = linePtr->nextPtr;
+ if (linePtr == NULL)
+ {
+ return 0;
+ }
+
+ if (prm->lineNum > prm->stopIndex)
+ {
+ return -1;
+ }
+ else if (prm->lineNum >= tablePtr->numItems)
+ {
+ prm->lineNum = 0;
+ }
+ }
+
+ if (prm->exact != SRCH_EXACT && prm->exact != SRCH_BEGINS)
+ {
+ Tcl_DStringSetLength(&prm->line, 0);
+ }
+ }
+done:
+
+ if (found)
+ {
+ char tmp[20];
+ sprintf (tmp, "%i", prm->lineNum);
+ if (prm->varName != NULL)
+ {
+ sprintf(tmp, "%d", prm->matchLength);
+ if (Tcl_SetVar(tablePtr->interp, prm->varName, tmp, TCL_LEAVE_ERR_MSG) == NULL)
+ {
+ prm->code = TCL_ERROR;
+ return -1;
+ }
+ }
+ Tcl_AppendElement (tablePtr->interp, tmp);
+ return -1;
+ }
+ return 0;
+}
+
+static int
+TreeTableSearchCmd(TreeTable *tablePtr, int argc, char **argv)
+{
+ searchParam_t prm;
+ int i, argsLeft;
+ size_t length;
+ int c;
+ char *arg, *p;
+ Tcl_DString patDString;
+
+ /*
+ * Parse switches and other arguments.
+ */
+ memset (&prm, 0, sizeof (prm));
+ prm.exact = SRCH_EXACT;
+ prm.backwards = 0;
+ prm.noCase = 0;
+ prm.varName = NULL;
+ prm.realindex = 0; /* default, look for a not hidden item */
+ for (i = 2; i < argc; i++)
+ {
+ arg = argv[i];
+ if (arg[0] != '-')
+ {
+ break;
+ }
+ length = strlen(arg);
+ if (length < 2)
+ {
+ badSwitch:
+ Tcl_AppendResult(tablePtr->interp, "bad switch \"", arg,
+ "\": must be -forward, -backward, -exact, -begins, -glob, -regexp, ",
+ "-nocase, -count, -realindex or --", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = arg[1];
+ if ((c == 'b') && (strncmp(argv[i], "-backwards", length) == 0))
+ {
+ prm.backwards = 1;
+ }
+ else if ((c == 'c') && (strncmp(argv[i], "-count", length) == 0))
+ {
+ if (i >= (argc-1))
+ {
+ tablePtr->interp->result = "no value given for \"-count\" option";
+ return TCL_ERROR;
+ }
+ i++;
+ prm.varName = argv[i];
+ }
+ else if ((c == 'e') && (strncmp(argv[i], "-exact", length) == 0))
+ {
+ prm.exact = SRCH_EXACT;
+ }
+ else if ((c == 'b') && (strncmp(argv[i], "-begins", length) == 0))
+ {
+ prm.exact = SRCH_BEGINS;
+ }
+ else if ((c == 'f') && (strncmp(argv[i], "-forwards", length) == 0))
+ {
+ prm.backwards = 0;
+ }
+ else if ((c == 'n') && (strncmp(argv[i], "-nocase", length) == 0))
+ {
+ prm.noCase = 1;
+ }
+ else if ((c == 'r') && (strncmp(argv[i], "-regexp", length) == 0))
+ {
+ prm.exact = SRCH_REGEXP;
+ }
+ else if ((c == 'g') && (strncmp(argv[i], "-glob", length) == 0))
+ {
+ prm.exact = SRCH_GLOB;
+ }
+ else if ((c == 'r') && (strncmp(argv[i], "-realindex", length) == 0))
+ {
+ prm.realindex = 1;
+ }
+ else if ((c == '-') && (strncmp(argv[i], "--", length) == 0))
+ {
+ i++;
+ break;
+ }
+ else
+ {
+ goto badSwitch;
+ }
+ }
+ argsLeft = argc - (i+2);
+ if ((argsLeft != 0) && (argsLeft != 1))
+ {
+ Tcl_AppendResult(tablePtr->interp, "wrong # args: should be \"",
+ argv[0], " search ?switches? pattern index ?stopIndex?",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ prm.pattern = argv[i];
+
+ /*
+ * Convert the pattern to lower-case if we're supposed to ignore case.
+ */
+ if (prm.noCase && prm.exact != SRCH_EXACT && prm.exact != SRCH_BEGINS)
+ {
+ Tcl_DStringInit(&patDString);
+ Tcl_DStringAppend(&patDString, prm.pattern, -1);
+ prm.pattern = Tcl_DStringValue(&patDString);
+ for (p = prm.pattern; *p != 0; p++)
+ {
+ if (isupper(UCHAR(*p)))
+ {
+ *p = tolower(UCHAR(*p));
+ }
+ }
+ }
+
+ /* verify if the list isn't empty */
+ if (tablePtr->itemPtr == NULL)
+ {
+ return TCL_OK;
+ }
+
+ if (GetTreeTableIndex(tablePtr, argv[i+1], 0, &prm.index) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+ if (argsLeft == 1)
+ {
+ if (GetTreeTableIndex(tablePtr, argv[i+2], 0, &prm.stopIndex) != TCL_OK)
+ {
+ return TCL_ERROR;
+ }
+ if (prm.stopIndex >= tablePtr->numItems)
+ {
+ prm.stopIndex = tablePtr->numItems-1;
+ }
+ }
+ else
+ {
+ prm.stopIndex = tablePtr->numItems-1;
+ }
+
+ if (prm.index >= tablePtr->numItems)
+ {
+ prm.index = tablePtr->numItems-1;
+ }
+
+ /*
+ * Scan through all of the lines of the text circularly, starting
+ * at the given index.
+ */
+ prm.matchLength = prm.patLength = 0; /* Only needed to prevent compiler
+ * warnings. */
+ if (prm.exact != SRCH_REGEXP)
+ {
+ prm.patLength = strlen(prm.pattern);
+ }
+ else
+ {
+ prm.regexp = Tcl_RegExpCompile(tablePtr->interp, prm.pattern);
+ if (prm.regexp == NULL)
+ {
+ return TCL_ERROR;
+ }
+ }
+
+ prm.lineNum = 0;
+ prm.cmpProc = (int(*)(char*,char*,int)) ((prm.noCase) ? strncasecmp : strncmp);
+ TreeTableSearchCmd_x (tablePtr, tablePtr->itemPtr, &prm);
+
+ if (prm.exact != SRCH_EXACT && prm.exact != SRCH_BEGINS)
+ {
+ Tcl_DStringFree(&prm.line);
+ if (prm.noCase)
+ {
+ Tcl_DStringFree(&patDString);
+ }
+ }
+ return prm.code;
+}
+
+/*
+ * Sort items on a column number, options:
+ * -column <num>: column number to sort items on it
+ * -nocase: ignore lower/upper case
+ */
+#define PosTabStr(s, p, n) i=0; p=s; while(i < n && *p) {\
+ if (*p == '\t') i++; \
+ p++; \
+ if (n == i) \
+ break; \
+}
+
+static int sortColNum;
+static int sortNoCase;
+
+static int
+TreeTableSortCmp(TableItem **Ptr11, TableItem **Ptr22)
+{
+ TableItem *Ptr1=*Ptr11;
+ TableItem *Ptr2=*Ptr22;
+ register char *p, *q;
+ int ret, i;
+
+ if (sortColNum <= 0)
+ {
+ p = Ptr1->text;
+ q = Ptr2->text;
+ }
+ else
+ {
+ PosTabStr (Ptr1->text, p, sortColNum);
+ PosTabStr (Ptr2->text, q, sortColNum);
+ }
+ if (*p == '~') p ++;
+ if (*q == '~') q ++;
+
+ if (sortNoCase)
+ {
+ /* Check first the only first characters! */
+ if ((ret = (tolower(*p) - tolower(*q))) || *p == '\0')
+ {
+ return ret;
+ }
+ else
+ {
+ ret = strcasecmp (p + 1, q + 1);
+ }
+ /* collapse the string comparision, if the text
+ * is identical
+ */
+ if (ret == 0 && sortColNum > 0)
+ {
+ ret = strcasecmp (Ptr1->text, Ptr2->text);
+ }
+ }
+ else
+ {
+ /* Check first the only first characters! */
+ if (*p != *q || *p == '\0')
+ {
+ return *p - *q;
+ }
+ else
+ ret = strcmp (q + 1, q + 1);
+
+ /* collapse the string comparision, if the text
+ * is identical
+ */
+ if (ret == 0 && sortColNum > 0)
+ {
+ ret = strcmp (Ptr1->text, Ptr2->text);
+ }
+ }
+ return ret;
+}
+
+static TableItem *
+TreeTableSortFindPrev(TableItem *listPtr, TableItem *itemPtr, int col, int noCase, int *index)
+{
+ TableItem *Ptr, *posPtr=NULL;
+ char *p, *q;
+ int ret, i;
+ for (Ptr=listPtr; Ptr; Ptr=Ptr->nextPtr)
+ {
+ if (col <= 0)
+ {
+ p = itemPtr->text;
+ q = Ptr->text;
+ }
+ else
+ {
+ PosTabStr (itemPtr->text, p, col);
+ PosTabStr (Ptr->text, q, col);
+ }
+ if (noCase)
+ {
+ ret = strcasecmp (p, q);
+ /* collapse the string comparision, if the text
+ * is identicale
+ */
+ if (ret == 0 && col > 0)
+ {
+ ret = strcasecmp (itemPtr->text, Ptr->text);
+ }
+ }
+ else
+ {
+ if (*p != *q)
+ ret = *p - *q;
+ else
+ ret = strcmp (q, q);
+ /* collapse the string comparision, if the text
+ * is identicale
+ */
+ if (ret == 0 && col > 0)
+ {
+ ret = strcmp (itemPtr->text, Ptr->text);
+ }
+ }
+ if (ret <= 0)
+ {
+ break;
+ }
+ if (index)
+ {
+ *index += 1 + Ptr->succNum;
+ }
+ posPtr = Ptr;
+ }
+ return posPtr;
+}
+
+void qqsort(char *base, int n, int size, int (*compar) (const void*,const void*));
+
+static int
+TreeTableSort_x(TreeTable *tablePtr, TableItem* parentPtr, int col, int noCase)
+{
+ TableItem *Ptr, *cutPtr, **list;
+ int ret, size, i;
+
+ /* sort children of parent children items recursively */
+ if (parentPtr)
+ Ptr=parentPtr->succPtr;
+ else
+ Ptr=tablePtr->itemPtr;
+ for (; Ptr; Ptr=Ptr->nextPtr)
+ {
+ if (Ptr->succPtr != NULL)
+ {
+ ret = TreeTableSort_x (tablePtr, Ptr, col, noCase);
+ if (ret != TCL_OK)
+ return ret;
+ }
+ }
+
+ if (parentPtr == NULL)
+ {
+ cutPtr = tablePtr->itemPtr;
+ }
+ else
+ {
+ cutPtr = parentPtr->succPtr;
+ }
+
+ /*
+ * Make list to use qsort for sorting the list, this is
+ * more faster as to insert an item on sorted list
+ */
+ for (size=0, Ptr=cutPtr; Ptr; Ptr = Ptr->nextPtr, size++)
+ {
+ /* Empty Loop */
+ }
+ /*
+ * No Items or One Item
+ */
+ if (size<=1)
+ {
+ return TCL_OK;
+ }
+
+ /* cut list from tree table */
+ if (parentPtr == NULL)
+ {
+ tablePtr->itemPtr = NULL;
+ }
+ else
+ {
+ parentPtr->succPtr = NULL;
+ }
+
+ list = (TableItem**)ckalloc (size * sizeof (TableItem*));
+ for (i=0, Ptr=cutPtr; Ptr; Ptr = Ptr->nextPtr, i++)
+ {
+ list [i] = Ptr;
+ }
+ sortColNum = col;
+ sortNoCase = noCase;
+ qqsort ((char*) list, size, sizeof (TableItem*), (int (*)(const void*,const void*)) TreeTableSortCmp);
+
+ /*
+ * now add the sorted list to the tree
+ */
+ if (parentPtr == NULL)
+ {
+ tablePtr->itemPtr = list[0];
+ }
+ else
+ {
+ parentPtr->succPtr = list[0];
+ }
+ for (i=1; i<size; i++)
+ {
+ list[i-1]->nextPtr = list[i];
+ }
+ list[i-1]->nextPtr = NULL;
+
+ /* get allocated memory free */
+ ckfree ((char*)list);
+ return TCL_OK;
+}
+static int
+TreeTableSort(TreeTable *tablePtr, int argc, char **argv)
+{
+ int col = -1, noCase = 0;
+ char * arg, c;
+ int i, length, ret;
+ for (i=0; i<argc; i++)
+ {
+ arg = argv[i];
+ c = arg[1];
+ length = strlen (arg);
+ if (((c == 'c') && (strncmp(argv[i], "-column", length) == 0))
+ || ((c == 't') && (strncmp(argv[i], "-tab", length) == 0)))
+ {
+
+ if (i >= (argc-1))
+ {
+ Tcl_AppendResult(tablePtr->interp, "no value given for \"", arg,
+ "\" option",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ i++;
+ col = atoi (argv[i]);
+ /* if sortedInsertion flag is enabled, then
+ * save the column number to sort new inserted items
+ * at the same column
+ */
+ if (tablePtr->sortedInsertion)
+ {
+ tablePtr->sortColumn = col;
+ }
+ }
+ else if ((c == 'n') && (strncmp(argv[i], "-nocase", length) == 0))
+ {
+ noCase = 1;
+ }
+ else
+ {
+ Tcl_AppendResult(tablePtr->interp, "bad switch \"", arg,
+ "\": must be -column <num>, -tab <num> or -nocase ",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /* free cached items */
+ FREE_CACHE();
+ FREE_PARENT_CACHE();
+
+ ret = TreeTableSort_x (tablePtr, NULL, col, noCase);
+ TreeTableRedrawRange (tablePtr);
+
+ return ret;
+}
+
+/*
+ * Get the BBox of a treetable item. The important thing here is
+ * that the coordinates are returned as the coordinates of the
+ * virtual position, that meens the hidden items haven't bbox coordinates
+ * and coordinates requierment of an hidden item produces an ERROR.
+ */
+static int
+TreeTableGetBBox (TreeTable *tablePtr, int index, int *x, int *y, int *w, int *h)
+{
+ TableItem *Ptr;
+ *x = *y = *w = *h = 0;
+ Ptr = TreeTableFindItem (tablePtr, index);
+ if (Ptr == NULL)
+ {
+ Tcl_AppendResult (tablePtr->interp, "bad treetable index for BBox", NULL);
+ return TCL_ERROR;
+ }
+ Ptr = TreeTableFindNotHiddenItem (tablePtr, index, 0);
+ if (Ptr == NULL)
+ {
+ Tcl_AppendResult (tablePtr->interp,
+ "Can't get BBox of item, "
+ "the item is in a hidden sub tree", NULL);
+ return TCL_ERROR;
+ }
+
+ *x = ITEM_X(Ptr);
+ *y = ITEM_Y(Ptr, index);
+ *w = *x + ITEM_WIDTH(Ptr);
+ *h = *y + ITEM_HEIGHT();
+
+ return TCL_OK;
+}
+/*******************************************************************/
+/** QUICKSORT ******************************************************/
+/** It can be added to another separate file !!!!! **/
+/*******************************************************************/
+static void qst(char *base, char *max);
+/*
+ * qsort.c: Our own version of the system qsort routine which is faster by an
+ * average of 25%, with lows and highs of 10% and 50%. The THRESHold below is
+ * the insertion sort threshold, and has been adjusted for records of size 48
+ * bytes. The MTHREShold is where we stop finding a better median.
+ */
+
+#define THRESH 4 /* threshold for insertion */
+#define MTHRESH 6 /* threshold for median */
+
+static int qsz; /* size of each record */
+static int thresh; /* THRESHold in chars */
+static int mthresh; /* MTHRESHold in chars */
+
+static int (*qcmp) (const void*,const void*); /* the comparison routine */
+static void qst (char *base, char *max);
+/*
+ * qqsort: First, set up some global parameters for qst to share. Then,
+ * quicksort with qst(), and then a cleanup insertion sort ourselves. Sound
+ * simple? It's not...
+ */
+
+void
+qqsort(char *base, int n, int size, int (*compar) (const void*,const void*))
+{
+ register char *i;
+ register char *j;
+ register char *lo;
+ register char *hi;
+ register char *min;
+ register char c;
+ char *max;
+
+ if (n <= 1)
+ return;
+ qsz = size;
+ qcmp = compar;
+ thresh = qsz * THRESH;
+ mthresh = qsz * MTHRESH;
+ max = base + n * qsz;
+ if (n >= THRESH)
+ {
+ qst(base, max);
+ hi = base + thresh;
+ }
+ else
+ {
+ hi = max;
+ }
+ /*
+ * First put smallest element, which must be in the first THRESH, in the
+ * first position as a sentinel. This is done just by searching the
+ * first THRESH elements (or the first n if n < THRESH), finding the min,
+ * and swapping it into the first position.
+ */
+ for (j = lo = base; (lo += qsz) < hi;)
+ {
+ if ((*qcmp) (j, lo) > 0)
+ j = lo;
+ }
+ if (j != base)
+ { /* swap j into place */
+ for (i = base, hi = base + qsz; i < hi;)
+ {
+ c = *j;
+ *j++ = *i;
+ *i++ = c;
+ }
+ }
+ /*
+ * With our sentinel in place, we now run the following hyper-fast
+ * insertion sort. For each remaining element, min, from [1] to [n-1],
+ * set hi to the index of the element AFTER which this one goes. Then, do
+ * the standard insertion sort shift on a character at a time basis for
+ * each element in the frob.
+ */
+ for (min = base; (hi = min += qsz) < max;)
+ {
+ while ((*qcmp) (hi -= qsz, min) > 0);
+ if ((hi += qsz) != min)
+ {
+ for (lo = min + qsz; --lo >= min;)
+ {
+ c = *lo;
+ for (i = j = lo; (j -= qsz) >= hi; i = j)
+ *i = *j;
+ *i = c;
+ }
+ }
+ }
+}
+
+/*
+ * qst: Do a quicksort. First, find the median element, and put that one in
+ * the first place as the discriminator. (This "median" is just the median
+ * of the first, last and middle elements). (Using this median instead of
+ * the first element is a big win). Then, the usual partitioning/swapping,
+ * followed by moving the discriminator into the right place. Then, figure
+ * out the sizes of the two partions, do the smaller one recursively and the
+ * larger one via a repeat of this code. Stopping when there are less than
+ * THRESH elements in a partition and cleaning up with an insertion sort (in
+ * our caller) is a huge win. All data swaps are done in-line, which is
+ * space-losing but time-saving. (And there are only three places where this
+ * is done).
+ */
+static void qst(char *base, char *max)
+{
+ register char *i;
+ register char *j;
+ register char *jj;
+ register char *mid;
+ register int ii;
+ register char c;
+ char *tmp;
+ int lo;
+ int hi;
+
+ lo = (int)(max - base); /* number of elements as chars */
+ do
+ {
+ /*
+ * At the top here, lo is the number of characters of elements in the
+ * current partition. (Which should be max - base). Find the median
+ * of the first, last, and middle element and make that the middle
+ * element. Set j to largest of first and middle. If max is larger
+ * than that guy, then it's that guy, else compare max with loser of
+ * first and take larger. Things are set up to prefer the middle,
+ * then the first in case of ties.
+ */
+ mid = i = base + qsz * ((unsigned) (lo / qsz) >> 1);
+ if (lo >= mthresh)
+ {
+ j = ((*qcmp) ((jj = base), i) > 0 ? jj : i);
+ if ((*qcmp) (j, (tmp = max - qsz)) > 0)
+ {
+ /* switch to first loser */
+ j = (j == jj ? i : jj);
+ if ((*qcmp) (j, tmp) < 0)
+ j = tmp;
+ }
+ if (j != i)
+ {
+ ii = qsz;
+ do
+ {
+ c = *i;
+ *i++ = *j;
+ *j++ = c;
+ } while (--ii);
+ }
+ }
+ /* Semi-standard quicksort partitioning/swapping */
+ for (i = base, j = max - qsz;;)
+ {
+ while (i < mid && (*qcmp) (i, mid) <= 0)
+ i += qsz;
+ while (j > mid)
+ {
+ if ((*qcmp) (mid, j) <= 0)
+ {
+ j -= qsz;
+ continue;
+ }
+ tmp = i + qsz; /* value of i after swap */
+ if (i == mid)
+ { /* j <-> mid, new mid is j */
+ mid = jj = j;
+ }
+ else
+ { /* i <-> j */
+ jj = j;
+ j -= qsz;
+ }
+ goto swap;
+ }
+ if (i == mid)
+ {
+ break;
+ }
+ else
+ { /* i <-> mid, new mid is i */
+ jj = mid;
+ tmp = mid = i; /* value of i after swap */
+ j -= qsz;
+ }
+ swap:
+ ii = qsz;
+ do
+ {
+ c = *i;
+ *i++ = *jj;
+ *jj++ = c;
+ } while (--ii);
+ i = tmp;
+ }
+ /*
+ * Look at sizes of the two partitions, do the smaller one first by
+ * recursion, then do the larger one by making sure lo is its size,
+ * base and max are update correctly, and branching back. But only
+ * repeat (recursively or by branching) if the partition is of at
+ * least size THRESH.
+ */
+ i = (j = mid) + qsz;
+ if ((lo = (int)(j - base)) <= (hi = (int)(max - i)))
+ {
+ if (lo >= thresh)
+ qst(base, j);
+ base = i;
+ lo = hi;
+ }
+ else
+ {
+ if (hi >= thresh)
+ qst(i, max);
+ max = j;
+ }
+ } while (lo >= thresh);
+}
+
+void
+ViewArgs (char *reason, int argc, char *argv[], int mode)
+{
+ int i;
+ if (reason)
+ {
+ fprintf (stderr, "%s\nused arguments:\n", reason);
+ }
+ for (i=0; i<argc; i++)
+ {
+ if (mode)
+ {
+ fprintf (stderr, "%s ", argv[i]);
+ }
+ else
+ {
+ fprintf (stderr, "argv[%i] = [%s]\n", i, argv[i]);
+ }
+ }
+ if (mode && mode != 2)
+ {
+ fprintf (stderr, "\n");
+ }
+}
+#ifdef TEST_TREE
+
+#ifdef USE_CACHE
+static void
+ViewCache(TreeTable*tablePtr)
+{
+ int i;
+ for (i=0; i<MAX_CACHED; i++)
+ {
+ fprintf (stderr, "cache(%i)=[%i, %s]\n",
+ i,
+ tablePtr->cachedPos [i],
+ tablePtr->cachedItem[i] != NULL
+ ? tablePtr->cachedItem[i]->text
+ : "NULL");
+ }
+ printf ("parentcache[%i, %s]\n",
+ tablePtr->cachedParent,
+ tablePtr->cachedParentPtr
+ ? tablePtr->cachedParentPtr->text
+ : "NULL");
+}
+#endif /* USE_CACHE */
+#endif /* TEST_TREE */
diff --git a/libgui/src/tkTreeTable.h b/libgui/src/tkTreeTable.h
new file mode 100644
index 00000000000..59f568e584e
--- /dev/null
+++ b/libgui/src/tkTreeTable.h
@@ -0,0 +1,172 @@
+/*======================================================================
+ * Copyright (c) 1994
+ * The Ohio State University
+ * Computer & Information Science Department
+ * Interactive Instructional Computing Facilities (IICF)
+ * ======================================================================
+ * Permission to use, copy, modify, and distribute this software and its
+ * documentation for any purpose and without fee is hereby granted,
+ * provided that the above copyright notice appear in all copies and that
+ * both that the copyright notice and warranty disclaimer appear in
+ * supporting documentation, and that the names of The Ohio State
+ * University and Interactive Instructional Computing Facilities as well
+ * as any of their entities not be used in advertising or publicity
+ * pertaining to distribution of the software without specific, written
+ * prior permission.
+ *
+ * The Ohio State University disclaims all warranties with regard to this
+ * software, including all implied warranties of merchantability and
+ * fitness. In no event shall The Ohio State University be liable for
+ * any special, indirect or consequential damages or any damages
+ * whatsoever resulting from of use, data or profits, whether in an
+ * action of contract, negligence or other tortuous action, arising out
+ * of or in connection with the use or performance of this software.
+ * =====================================================================
+ */
+#ifndef TKTREETABLEH
+#define TKTREETABLEH
+
+#include <tk.h>
+#include <tcl.h>
+#include <X11/Xlib.h>
+#include <X11/Xutil.h>
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+/* tkWinDefault.h defines this, but tkUnixDefault.h doesn't. */
+#ifndef CTL_FONT
+#define CTL_FONT "Helvetica -12"
+#endif
+
+/*
+ * TableItem defaults
+ */
+
+#define NO_TABLEITEM_LINEWIDTH "-1"
+#define DEF_TABLEITEM_LINEWIDTH "1"
+#define DEF_TABLEITEM_TEXT ""
+#define DEF_TABLEITEM_DATA (char *) NULL /*""*/
+#define DEF_TABLEITEM_BITMAP (char *) NULL
+#define DEF_TABLEITEM_IMAGE (char *) NULL
+#define DEF_TABLEITEM_IDLECOMMAND (char *) NULL
+#define DEF_HIDDEN_COMMAND ""
+#define DEF_TABLEITEM_FONT ""
+#define DEF_TABLEITEM_TEXTFOREGROUND ""
+#define DEF_TABLEITEM_BITMAPFOREGROUND ""
+#define DEF_TABLEITEM_BITMAPBACKGROUND NORMAL_BG
+#define DEF_TABLEITEM_BITMAPSELECTFOREGROUND ""
+#define DEF_TABLEITEM_BITMAPSELECTBACKGROUND ""
+#define DEF_TABLEITEM_LINEFOREGROUND ""
+#define DEF_TABLEITEM_INDENT "0"
+#define DEF_TABLEITEM_PARENT "-1"
+#define DEF_TABLEITEM_SUCCNUM "0"
+#define DEF_TABLEITEM_SEENNUM "0"
+#define DEF_TABLEITEM_TABFREESPACE "6"
+#define DEF_TABLEITEM_FLAGS "0"
+
+/*
+ * TreeTable defaults
+ */
+
+#define NO_TREETABLE_LINEWIDTH "-1"
+#define DEF_TREETABLE_LINEWIDTH "1"
+#define DEF_TREETABLE_BG_COLOR NORMAL_BG
+#define DEF_TREETABLE_BG_MONO WHITE
+#define DEF_TREETABLE_BORDER_WIDTH "2"
+#define DEF_TREETABLE_HIGHLIGHT_WIDTH "2"
+#define DEF_TREETABLE_CURSOR ""
+#define DEF_TREETABLE_EXPORT_SELECTION "0"
+#define DEF_TREETABLE_TEXTFG BLACK
+#define DEF_TREETABLE_BITMAPFG BLACK
+#define DEF_TREETABLE_BITMAPBG NORMAL_BG
+#define DEF_TREETABLE_LINEFG BLACK
+#define DEF_TREETABLE_SPLITLINEFG "#c0c0c0"
+#define DEF_TREETABLE_FONT CTL_FONT
+#define DEF_TREETABLE_FG BLACK
+#define DEF_TREETABLE_GEOMETRY "20x10"
+#define DEF_TREETABLE_WIDTH "20"
+#define DEF_TREETABLE_HEIGHT "10"
+#define DEF_TREETABLE_RELIEF "flat"
+#define DEF_TREETABLE_SELECT_COLOR SELECT_BG
+#define DEF_TREETABLE_SELECT_MONO BLACK
+#define DEF_TREETABLE_INDENTWIDTH "10"
+#define DEF_TREETABLE_BITMAPSPACE "7"
+#define DEF_TREETABLE_SELECT_BD "1"
+#ifdef _TKWINDEFAULT
+#define DEF_TREETABLE_SELECT_FG_COLOR SELECT_FG
+#else
+#define DEF_TREETABLE_SELECT_FG_COLOR BLACK
+#endif /* _TKWINDEFAULT */
+#define DEF_TREETABLE_SELECT_FG_MONO WHITE
+#define DEF_TREETABLE_BITMAPSELECTBACKGROUND ""
+#define DEF_TREETABLE_BITMAPSELECTFOREGROUND ""
+
+#define DEF_TREETABLE_SET_GRID "0"
+#define DEF_TREETABLE_BESTFIT "0"
+#define DEF_TREETABLE_AUTOFIT "0"
+#define DEF_TREETABLE_SPLITLINES "1"
+#define DEF_TREETABLE_TRUNCATE "1"
+#define DEF_TREETABLE_TAKE_FOCUS (char *) NULL
+#define DEF_TREETABLE_SCROLL_COMMAND ""
+#define DEF_TREETABLE_TABS (char *) NULL
+#define DEF_TREETABLE_JUSTIFY (char *) NULL
+#define DEF_TREETABLE_DEFTABS (char *) NULL
+#define DEF_TREETABLE_SELECTMODE "browse"
+#define DEF_TREETABLE_FILL_SELECTION "0"
+#define DEF_TREETABLE_SORTED_INSERTION "0"
+#define DEF_TREETABLE_SORT_NOCASE "0"
+#define DEF_TREETABLE_SORT_COLNUM "-1"
+#define DEF_TREETABLE_USE_ACCELERATOR "0"
+#if _WINDOWS
+#define DEF_TREETABLE_WINDOWSMODE "1"
+#else
+#define DEF_TREETABLE_WINDOWSMODE "0"
+#endif
+#define DEF_TREETABLE_TRUNCATEMETHODE "auto"
+#define DEF_TREETABLE_UNKNOWN_FLAG "0"
+
+#define ITEM_HIDDEN_SUBTREE 0x0001
+#define ITEM_SELECTED 0x0002
+
+#define MULTI 0
+#define SINGLE 1
+
+#define USE_PARENT_CACHE
+#define USE_CACHE
+#define MAX_CACHED 5
+
+#undef USE_BITMAP_COLORS
+#define USE_PATHFINDER
+#define PATHFINDER_STEP 1024
+
+/*
+ * Flag bits for TreeTable
+ * REDRAW_PENDING : Non-zero means a DoWhenIdle handler
+ * has already been queued to redraw
+ * this window.
+ * UPDATE_V_SCROLLBAR : Non-zero means verticle scrollbar needs
+ * to be updated.
+ * UPDATE_H_SCROLLBAR: Non-zero means horizontal scrollbar needs
+ * to be updated.
+ * GOT_FOCUS: Non-zero means this widget currently
+ * has the input focus.
+ */
+
+#define REDRAW_PENDING 1
+#define UPDATE_V_SCROLLBAR 2
+#define UPDATE_H_SCROLLBAR 4
+#define GOT_FOCUS 8
+
+/*
+ * Function declaration
+ */
+
+int create_treetable_command _ANSI_ARGS_((Tcl_Interp *interp));
+
+#ifdef __cplusplus
+}
+#endif
+
+#endif
diff --git a/libgui/src/tkWarpPointer.c b/libgui/src/tkWarpPointer.c
new file mode 100644
index 00000000000..e1fb84a135a
--- /dev/null
+++ b/libgui/src/tkWarpPointer.c
@@ -0,0 +1,70 @@
+
+/* -----------------------------------------------------------------------------
+* NAME:
+* WarpPointer
+*
+* SYNOPSIS: int WarpPointer (clientData, interp, objc, objv)
+* Implements tcl function:
+* warp_pointer win x y
+*
+* DESC:
+* Forces the pointer to a specific location. There is probably
+* no good reason to use this except in the testsuite!
+*
+* ARGS:
+* win (objv[1]) - tk window name that coordinates are relative to.
+* Use "." for absolute coordinates
+*
+* x (obvj[2]) - X coordinate
+* y (objv[3]) - Y coordinate
+* RETURNS:
+*
+*
+* NOTES:
+*
+*
+* ---------------------------------------------------------------------------*/
+#ifndef _WIN32
+
+#include "tk.h"
+
+int
+WarpPointer (clientData, interp, objc, objv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int objc;
+ Tcl_Obj *CONST objv[];
+{
+ Tk_Window tkwin;
+ Window win;
+ int x, y;
+ char *str;
+
+ if (objc != 4) {
+ Tcl_WrongNumArgs(interp, 1, objv, "x y widgetId");
+ return TCL_ERROR;
+ }
+
+ if ((Tcl_GetIntFromObj (interp, objv[2], &x) == TCL_ERROR) ||
+ (Tcl_GetIntFromObj (interp, objv[3], &y) == TCL_ERROR))
+ return TCL_ERROR;
+
+ tkwin = Tk_NameToWindow(interp, Tcl_GetStringFromObj(objv[1], NULL), \
+ Tk_MainWindow (interp));
+ if (tkwin == NULL)
+ return TCL_ERROR;
+
+ win = Tk_WindowId(tkwin);
+ XWarpPointer(Tk_Display(tkwin), None, win, 0, 0, 0, 0, x, y);
+ return TCL_OK;
+}
+
+int
+cyg_create_warp_pointer_command (Tcl_Interp *interp)
+{
+ if (!Tcl_CreateObjCommand (interp, "warp_pointer", WarpPointer, NULL, NULL))
+ return TCL_ERROR;
+ return TCL_OK;
+}
+
+#endif /* !_WIN32 */
diff --git a/libgui/src/tkWinPrintCanvas.c b/libgui/src/tkWinPrintCanvas.c
new file mode 100644
index 00000000000..5b7bc41830a
--- /dev/null
+++ b/libgui/src/tkWinPrintCanvas.c
@@ -0,0 +1,193 @@
+
+#ifdef _WIN32
+
+#include <windows.h>
+
+#include "tkWinInt.h"
+#include "tkCanvas.h"
+
+#include <tcl.h>
+#include <tk.h>
+
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PrintCanvasCmd --
+ * When invoked with the correct args this will bring up a
+ * standard Windows print dialog box and then print the
+ * contence of the canvas.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ *--------------------------------------------------------------
+ */
+
+
+int
+PrintCanvasCmd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int argc;
+ char **argv;
+{
+ PRINTDLG pd;
+ Tcl_CmdInfo canvCmd;
+ TkCanvas *canvasPtr;
+ TkWinDrawable *PrinterDrawable;
+ Tk_Window tkwin;/* = canvasPtr->tkwin;*/
+ Tk_Item *itemPtr;
+ Pixmap pixmap;
+ HDC hDCpixmap;
+ TkWinDCState pixmapState;
+ DEVMODE dm;
+ float Ptr_pixX,Ptr_pixY,Ptr_mmX,Ptr_mmY;
+ float canv_pixX,canv_pixY,canv_mmX,canv_mmY;
+
+ int widget_X_size = 0;
+ int widget_Y_size = 0;
+ int page_Y_size, page_X_size;
+ int tiles_wide,tiles_high;
+ int tile_y, tile_x;
+ int screenX1, screenX2, screenY1, screenY2, width, height;
+ DOCINFO *lpdi = malloc(sizeof(DOCINFO));
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " canvas \"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* The second arg is the canvas widget */
+ if (!Tcl_GetCommandInfo(interp, argv[1], &canvCmd)) {
+ Tcl_AppendResult(interp, "couldn't get canvas information for \"",
+ argv[1], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ memset(&dm,0,sizeof(DEVMODE));
+ dm.dmSize = sizeof(DEVMODE);
+ dm.dmScale = 500;
+
+ memset(lpdi,0,sizeof(DOCINFO));
+ lpdi->cbSize=sizeof(DOCINFO);
+ lpdi->lpszDocName=malloc(255);
+ sprintf((char*)lpdi->lpszDocName,"SN - Printing\0");
+ lpdi->lpszOutput=NULL;
+
+ canvasPtr = (TkCanvas *)(canvCmd.clientData);
+ tkwin = canvasPtr->tkwin;
+ memset(&pd,0,sizeof( PRINTDLG ));
+ pd.lStructSize = sizeof( PRINTDLG );
+ pd.hwndOwner = NULL;
+ pd.hDevMode = NULL;
+ pd.hDevNames = NULL;
+ /* pd.hDC = */
+ pd.Flags = PD_RETURNDC;
+
+ /* Get printer details. */
+ if (!PrintDlg(&pd)) {
+ goto done;
+ }
+
+ PrinterDrawable = (TkWinDrawable *) ckalloc(sizeof(TkWinDrawable));
+ PrinterDrawable->type = TWD_WINDC;
+ PrinterDrawable->winDC.hdc = pd.hDC;
+
+ Ptr_pixX=(float)GetDeviceCaps(PrinterDrawable->winDC.hdc,HORZRES);
+ Ptr_pixY=(float)GetDeviceCaps(PrinterDrawable->winDC.hdc,VERTRES);
+ Ptr_mmX=(float)GetDeviceCaps(PrinterDrawable->winDC.hdc,HORZSIZE);
+ Ptr_mmY=(float)GetDeviceCaps(PrinterDrawable->winDC.hdc,VERTSIZE);
+
+ screenX1=0; screenY1=0;
+ screenX2=canvasPtr->width; screenY2=canvasPtr->height;
+ canvasPtr->drawableXOrigin = screenX1 - 30;
+ canvasPtr->drawableYOrigin = screenY1 - 30;
+ pixmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ (screenX2 + 30 - canvasPtr->drawableXOrigin),
+ (screenY2 + 30 - canvasPtr->drawableYOrigin),
+ Tk_Depth(tkwin));
+ width = screenX2 - screenX1;
+ height = screenY2 - screenY1;
+
+ hDCpixmap = TkWinGetDrawableDC(Tk_Display(tkwin), pixmap, &pixmapState);
+ canv_pixX=(float)GetDeviceCaps(hDCpixmap,HORZRES);
+ canv_pixY=(float)GetDeviceCaps(hDCpixmap,VERTRES);
+ canv_mmX=(float)GetDeviceCaps(hDCpixmap,HORZSIZE);
+ canv_mmY=(float)GetDeviceCaps(hDCpixmap,VERTSIZE);
+
+
+ SetMapMode(PrinterDrawable->winDC.hdc,MM_ISOTROPIC);
+ SetWindowExtEx(PrinterDrawable->winDC.hdc,(int)((float)canv_pixX),(int)((float)canv_pixY),NULL);
+ SetViewportExtEx(PrinterDrawable->winDC.hdc,(int)((float)Ptr_pixX),
+ (int)((float)Ptr_pixY),
+ NULL);
+
+ /* max X and Y for canvas */
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if (itemPtr->x1 > widget_X_size) {
+ widget_X_size = itemPtr->x1;
+ }
+ if (itemPtr->y1 > widget_Y_size) {
+ widget_Y_size = itemPtr->y1;
+ }
+ }
+
+ /* Calculate the number of tiles high */
+ page_Y_size = GetDeviceCaps(hDCpixmap,LOGPIXELSY)*(Ptr_mmY/22);
+ page_X_size = GetDeviceCaps(hDCpixmap,LOGPIXELSX)*(Ptr_mmX/22);
+
+ tiles_high = ( widget_Y_size / page_Y_size ); /* start at zero */
+ tiles_wide = ( widget_X_size / page_X_size ); /* start at zero */
+
+ StartDoc(pd.hDC,lpdi);
+
+ for (tile_x = 0; tile_x <= tiles_wide;tile_x++) {
+ for (tile_y = 0; tile_y <= tiles_high;tile_y++) {
+ SetViewportOrgEx(pd.hDC,-(tile_x*Ptr_pixX),-(tile_y*Ptr_pixY),NULL);
+ StartPage(pd.hDC);
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr, itemPtr,
+ canvasPtr->display, (unsigned long) PrinterDrawable/*pixmap*/, screenX1, screenY1, width,
+ height);
+ }
+
+ EndPage(pd.hDC);
+ }
+ }
+ EndDoc(pd.hDC);
+
+done:
+ return TCL_OK;
+ error:
+ return TCL_ERROR;
+}
+
+
+
+static void
+ide_delete_print_canvas_command(ClientData clientData)
+{
+ /* destructor code here.*/
+}
+
+int
+ide_create_printcanvas_command (Tcl_Interp *interp)
+{
+
+ /* initialization code here */
+
+ if (Tcl_CreateCommand(interp, "ide_print_canvas", PrintCanvasCmd,
+ NULL, ide_delete_print_canvas_command) == NULL)
+ return TCL_ERROR;
+
+ return TCL_OK;
+}
+
+#endif /* _WIN32 */
diff --git a/libgui/src/tkWinPrintText.c b/libgui/src/tkWinPrintText.c
new file mode 100644
index 00000000000..a9ffd36bfb9
--- /dev/null
+++ b/libgui/src/tkWinPrintText.c
@@ -0,0 +1,533 @@
+
+#ifdef _WIN32
+
+#include <windows.h>
+
+#include "tkInt.h"
+#include "tkWinInt.h"
+#include "tkPort.h"
+#include "tkText.h"
+
+#define MAXINT 32000000
+
+#define HAS_3D_BORDER 1
+#define NEW_LAYOUT 2
+#define TOP_LINE 4
+#define BOTTOM_LINE 8
+
+
+#define DINFO_OUT_OF_DATE 1
+#define REDRAW_PENDING 2
+#define REDRAW_BORDERS 4
+#define REPICK_NEEDED 8
+
+
+
+/*
+ * 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
+ * currently visible on display and must be
+ * redrawn. This is used to move lines by
+ * scrolling rather than re-drawing. */
+ int height; /* Height of line, in pixels. */
+ int baseline; /* Offset of text baseline from y, in
+ * pixels. */
+ int spaceAbove; /* How much extra space was added to the
+ * top of the line because of spacing
+ * options. This is included in height
+ * and baseline. */
+ int spaceBelow; /* How much extra space was added to the
+ * bottom of the line because of spacing
+ * options. This is included in height. */
+ int length; /* Total length of line, in pixels. */
+ TkTextDispChunk *chunkPtr; /* Pointer to first chunk in list of all
+ * of those that are displayed on this
+ * line of the screen. */
+ struct DLine *nextPtr; /* Next in list of all display lines for
+ * this window. The list is sorted in
+ * order from top to bottom. Note: the
+ * next DLine doesn't always correspond
+ * to the next line of text: (a) can have
+ * multiple DLines for one text line, and
+ * (b) can have gaps where DLine's have been
+ * deleted because they're out of date. */
+ int flags; /* Various flag bits: see below for values. */
+} DLine;
+
+
+typedef struct TextDInfo {
+ Tcl_HashTable styleTable; /* Hash table that maps from StyleValues
+ * to TextStyles for this widget. */
+ DLine *dLinePtr; /* First in list of all display lines for
+ * this widget, in order from top to bottom. */
+ GC copyGC; /* Graphics context for copying from off-
+ * screen pixmaps onto screen. */
+ GC scrollGC; /* Graphics context for copying from one place
+ * in the window to another (scrolling):
+ * differs from copyGC in that we need to get
+ * GraphicsExpose events. */
+ int x; /* First x-coordinate that may be used for
+ * actually displaying line information.
+ * Leaves space for border, etc. */
+ int y; /* First y-coordinate that may be used for
+ * actually displaying line information.
+ * Leaves space for border, etc. */
+ int maxX; /* First x-coordinate to right of available
+ * space for displaying lines. */
+ int maxY; /* First y-coordinate below available
+ * space for displaying lines. */
+ int topOfEof; /* Top-most pixel (lowest y-value) that has
+ * been drawn in the appropriate fashion for
+ * the portion of the window after the last
+ * line of the text. This field is used to
+ * 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
+ * size). If there's no wrapping, this will
+ * be zero. */
+ double xScrollFirst, xScrollLast;
+ /* Most recent values reported to horizontal
+ * scrollbar; used to eliminate unnecessary
+ * reports. */
+ double yScrollFirst, yScrollLast;
+ /* Most recent values reported to vertical
+ * 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:
+ */
+
+ int dLinesInvalidated; /* This value is set to 1 whenever something
+ * happens that invalidates information in
+ * DLine structures; if a redisplay
+ * is in progress, it will see this and
+ * abort the redisplay. This is needed
+ * because, for example, an embedded window
+ * could change its size when it is first
+ * displayed, invalidating the DLine that
+ * is currently being displayed. If redisplay
+ * continues, it will use freed memory and
+ * could dump core. */
+ int flags; /* Various flag values: see below for
+ * definitions. */
+} TextDInfo;
+
+/*
+ * 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.
+ */
+
+typedef struct StyleValues {
+ Tk_3DBorder border; /* Used for drawing background under text.
+ * NULL means use widget background. */
+ int borderWidth; /* Width of 3-D border for background. */
+ int relief; /* 3-D relief for background. */
+ Pixmap bgStipple; /* Stipple bitmap for background. None
+ * means draw solid. */
+ XColor *fgColor; /* Foreground color for text. */
+ Tk_Font tkfont; /* Font for displaying text. */
+ Pixmap fgStipple; /* Stipple bitmap for text and other
+ * foreground stuff. None means draw
+ * solid.*/
+ int justify; /* Justification style for text. */
+ int lMargin1; /* Left margin, in pixels, for first display
+ * line of each text line. */
+ int lMargin2; /* Left margin, in pixels, for second and
+ * later display lines of each text line. */
+ int offset; /* Offset in pixels of baseline, relative to
+ * baseline of line. */
+ int overstrike; /* Non-zero means draw overstrike through
+ * text. */
+ int rMargin; /* Right margin, in pixels. */
+ int spacing1; /* Spacing above first dline in text line. */
+ 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.
+ */
+
+typedef struct TextStyle {
+ int refCount; /* Number of times this structure is
+ * referenced in Chunks. */
+ GC bgGC; /* Graphics context for background. None
+ * means use widget background. */
+ GC fgGC; /* Graphics context for foreground. */
+ StyleValues *sValuePtr; /* Raw information from which GCs were
+ * derived. */
+ Tcl_HashEntry *hPtr; /* Pointer to entry in styleTable. Used
+ * to delete entry. */
+} TextStyle;
+
+
+
+
+void DisplayDLineToDrawable(TkText *textPtr, DLine *dlPtr, DLine *prevPtr, TkWinDrawable *drawable);
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PrintTextCmd --
+ * When invoked with the correct args this will bring up a
+ * standard Windows print dialog box and then print the
+ * contence of the text wiget.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+PrintTextCmd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int argc;
+ char **argv;
+{
+ PRINTDLG pd;
+ Tcl_CmdInfo textCmd;
+ TkText *textPtr;
+ TextDInfo *dInfoPtr;
+ DLine *dlPtr;
+ TkWinDrawable *PrinterDrawable;
+ Tk_Window tkwin;
+ Tk_Item *itemPtr;
+ int maxHeight;
+ DLine *prevPtr;
+ Pixmap pixmap;
+ int bottomY = 0; /* Initialization needed only to stop
+ * compiler warnings. */
+ DOCINFO *lpdi = malloc(sizeof(DOCINFO));
+ TkTextIndex first, last;
+ int numLines;
+ HDC hDCpixmap;
+ TkWinDCState pixmapState;
+ DEVMODE dm;
+ float Ptr_pixX,Ptr_pixY,Ptr_mmX,Ptr_mmY;
+ float canv_pixX,canv_pixY,canv_mmX,canv_mmY;
+ int page_Y_size,tiles_high,tile_y;
+ int screenX1, screenX2, screenY1, screenY2, width, height;
+
+ int saved_x;
+ int saved_y;
+ int saved_w;
+ int saved_h;
+ int saved_maxX;
+ int saved_maxY;
+ int saved_eof;
+
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " text \"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * The second arg is the canvas widget.
+ */
+ if (!Tcl_GetCommandInfo(interp, argv[1], &textCmd)) {
+ Tcl_AppendResult(interp, "couldn't get text information for \"",
+ argv[1], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ memset(&dm,0,sizeof(DEVMODE));
+ dm.dmSize = sizeof(DEVMODE);
+ dm.dmScale = 500;
+
+ memset(lpdi,0,sizeof(DOCINFO));
+ lpdi->cbSize=sizeof(DOCINFO);
+ lpdi->lpszDocName=malloc(255);
+ sprintf((char*)lpdi->lpszDocName,"SN - Printing\0");
+ lpdi->lpszOutput=NULL;
+
+ textPtr = (TkText *)(textCmd.clientData);
+
+ tkwin = textPtr->tkwin;
+ dInfoPtr = textPtr->dInfoPtr;
+ dlPtr=dInfoPtr->dLinePtr;
+ memset(&pd,0,sizeof( PRINTDLG ));
+ pd.lStructSize = sizeof( PRINTDLG );
+ pd.hwndOwner = NULL;
+ pd.hDevMode = NULL;
+ pd.hDevNames = NULL;
+ pd.Flags = PD_RETURNDC|PD_NOSELECTION;
+
+ /*
+ * Get printer details.
+ */
+ if (!PrintDlg(&pd)) {
+ goto done;
+ }
+
+ PrinterDrawable = (TkWinDrawable *) ckalloc(sizeof(TkWinDrawable));
+ PrinterDrawable->type = TWD_WINDC;
+ PrinterDrawable->winDC.hdc = pd.hDC;
+
+ Ptr_pixX=(float)GetDeviceCaps(PrinterDrawable->winDC.hdc,HORZRES);
+ Ptr_pixY=(float)GetDeviceCaps(PrinterDrawable->winDC.hdc,VERTRES);
+ Ptr_mmX=(float)GetDeviceCaps(PrinterDrawable->winDC.hdc,HORZSIZE);
+ Ptr_mmY=(float)GetDeviceCaps(PrinterDrawable->winDC.hdc,VERTSIZE);
+
+ screenX1=0; screenY1=0;
+ screenX2=dInfoPtr->maxX; screenY2=dInfoPtr->maxY;
+ pixmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ (screenX2 + 30),
+ (screenY2 + 30),
+ Tk_Depth(tkwin));
+ width = screenX2 - screenX1;
+ height = screenY2 - screenY1;
+
+ hDCpixmap = TkWinGetDrawableDC(Tk_Display(tkwin), pixmap, &pixmapState);
+ canv_pixX=(float)GetDeviceCaps(hDCpixmap,HORZRES);
+ canv_pixY=(float)GetDeviceCaps(hDCpixmap,VERTRES);
+ canv_mmX=(float)GetDeviceCaps(hDCpixmap,HORZSIZE);
+ canv_mmY=(float)GetDeviceCaps(hDCpixmap,VERTSIZE);
+
+ /*
+ * Save text widget data.
+ */
+ dInfoPtr = textPtr->dInfoPtr;
+ saved_x = dInfoPtr->x;
+ saved_y = dInfoPtr->y;
+ saved_w = Tk_Width(textPtr->tkwin);
+ saved_h = Tk_Height(textPtr->tkwin);
+ saved_maxX = dInfoPtr->maxX;
+ saved_maxY = dInfoPtr->maxY;
+ saved_eof = dInfoPtr->topOfEof;
+ dInfoPtr->maxX = MAXINT;
+ Tk_Width(textPtr->tkwin) = MAXINT;
+
+ dInfoPtr->maxY = MAXINT;
+ Tk_Height(textPtr->tkwin) = MAXINT;
+
+ /* Make the text widget big enough for all the
+ text to be seen. */
+
+ numLines = TkBTreeNumLines(textPtr->tree);
+#if (TCL_MAJOR_VERSION >= 8) && (TCL_MINOR_VERSION >= 1)
+ TkTextMakeByteIndex(textPtr->tree, 0, 0, &first);
+ TkTextMakeByteIndex(textPtr->tree, numLines, 100, &last);
+#else
+ TkTextMakeIndex(textPtr->tree, 0, 0, &first);
+ TkTextMakeIndex(textPtr->tree, numLines, 100, &last);
+#endif
+ TkTextChanged(textPtr, &first, &last);
+
+ /*
+ * Set the display info flag to out-of-date.
+ */
+
+ textPtr->dInfoPtr->flags|=DINFO_OUT_OF_DATE;
+
+ /*
+ *TkTextXviewCmd will call UpdateDisplayInfo.
+ */
+
+ TkTextXviewCmd(textPtr, interp, 2, NULL);
+ dInfoPtr = textPtr->dInfoPtr;
+
+ SetMapMode(PrinterDrawable->winDC.hdc,MM_ISOTROPIC);
+ SetWindowExtEx(PrinterDrawable->winDC.hdc,(int)((float)canv_pixX),(int)((float)canv_pixY),NULL);
+ SetViewportExtEx(PrinterDrawable->winDC.hdc,(int)((float)Ptr_pixX),
+ (int)((float)Ptr_pixY),
+ NULL);
+
+ /*
+ * Get max Y for text widget.
+ */
+ maxHeight = -1;
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
+ dlPtr = dlPtr->nextPtr) {
+ maxHeight = dlPtr->y + dlPtr->height;
+ }
+
+ /*
+ * Calculate the number of tiles high.
+ */
+ page_Y_size = GetDeviceCaps(hDCpixmap,LOGPIXELSY)*(Ptr_mmY/22);
+
+ tiles_high = ( maxHeight / page_Y_size ); /* start at page zero */
+
+ StartDoc(pd.hDC,lpdi);
+ for (tile_y = 0; tile_y <= tiles_high;tile_y++) {
+ SetViewportOrgEx(pd.hDC,0,-(tile_y*Ptr_pixY),NULL);
+
+ StartPage(pd.hDC);
+
+ if (maxHeight > 0) {
+ for (prevPtr = NULL, dlPtr = textPtr->dInfoPtr->dLinePtr;
+ (dlPtr != NULL) && (dlPtr->y < dInfoPtr->maxY);
+ prevPtr = dlPtr, dlPtr = dlPtr->nextPtr) {
+ DisplayDLineToDrawable(textPtr, dlPtr, prevPtr, PrinterDrawable);
+
+ }
+ }
+
+
+ EndPage(pd.hDC);
+ }
+ EndDoc(pd.hDC);
+
+ /*
+ * Restore text widget data.
+ */
+
+ dInfoPtr->x = saved_x;
+ dInfoPtr->y = saved_y;
+ Tk_Width(textPtr->tkwin) = saved_w;
+ Tk_Height(textPtr->tkwin) = saved_h;
+ dInfoPtr->maxY = saved_maxY;
+ dInfoPtr->maxX = saved_maxX;
+ dInfoPtr->topOfEof = saved_eof;
+ /*
+ * Pitch the info again.
+ */
+ TkTextChanged(textPtr, &first, &last);
+
+ /*
+ * Display info not valid anymore.
+ */
+
+ textPtr->dInfoPtr->flags|=DINFO_OUT_OF_DATE;
+
+done:
+ return TCL_OK;
+ error:
+ return TCL_ERROR;
+}
+
+
+
+static void
+ide_delete_print_text_command(ClientData clientData)
+{
+ /* destructor code here.*/
+}
+
+int
+ide_create_print_text_command (Tcl_Interp *interp)
+{
+
+ if (Tcl_CreateCommand(interp, "ide_print_text",
+ PrintTextCmd,
+ NULL, NULL) == NULL)
+ return TCL_ERROR;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayDLineToDrawable --
+ *
+ * This procedure is invoked to draw a single line to a HDC
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayDLineToDrawable(textPtr, dlPtr, prevPtr, drawable)
+ TkText *textPtr; /* Text widget in which to draw line. */
+ register DLine *dlPtr; /* Information about line to draw. */
+ DLine *prevPtr; /* Line just before one to draw, or NULL
+ * if dlPtr is the top line. */
+ TkWinDrawable *drawable; /* drawable to use for displaying.
+ * Caller must make sure it's large enough
+ * to hold line. */
+{
+ register TkTextDispChunk *chunkPtr;
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ Display *display;
+ int height, x;
+
+ /*
+ * First, clear the area of the line to the background color for the
+ * text widget.
+ */
+
+ display = Tk_Display(textPtr->tkwin);
+
+ for (chunkPtr = dlPtr->chunkPtr; (chunkPtr != NULL);
+ chunkPtr = chunkPtr->nextPtr) {
+ if (chunkPtr->displayProc == TkTextInsertDisplayProc) {
+ /*
+ * Already displayed the insertion cursor above. Don't
+ * do it again here.
+ */
+
+ continue;
+ } else {
+ x = chunkPtr->x + dInfoPtr->x - dInfoPtr->curPixelOffset;
+ if ((x + chunkPtr->width <= 0) || (x >= dInfoPtr->maxX)) {
+ (*chunkPtr->displayProc)(chunkPtr, -chunkPtr->width,
+ dlPtr->y,
+ dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
+ dlPtr->baseline - dlPtr->spaceAbove, display, (unsigned long)drawable,
+ dlPtr->y + dlPtr->spaceAbove);
+ } else {
+ (*chunkPtr->displayProc)(chunkPtr, x, dlPtr->y,
+ dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
+ dlPtr->baseline - dlPtr->spaceAbove, display, (unsigned long)drawable,
+ dlPtr->y + dlPtr->spaceAbove);
+ }
+ }
+ }
+
+}
+
+#endif /* _WIN */
diff --git a/libgui/src/xpmlib.c b/libgui/src/xpmlib.c
new file mode 100644
index 00000000000..16a36229cb5
--- /dev/null
+++ b/libgui/src/xpmlib.c
@@ -0,0 +1,1592 @@
+/**
+ * tixImgXpm.c --
+ *
+ * This file implements images of type "pixmap" for Tix.
+ * ______________________________________________________________________
+ *
+ * Copyright statement for tixImgXpm.c
+ * Copyright 1996, Expert Interface Technologies
+ *
+ * The following terms apply only to this file and no other parts of the
+ * Tix library.
+ *
+ * Permission is hereby granted, without written agreement and
+ * without license or royalty fees, to use, copy, modify, and
+ * distribute this file, for any purpose, provided that existing
+ * copyright notices are retained in all copies and that this
+ * notice is included verbatim in any distributions.
+ *
+ * DISCLAIMER OF ALL WARRANTIES
+ *
+ * IN NO EVENT SHALL THE AUTHOR OF THIS SOFTWARE BE LIABLE TO ANY
+ * PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR
+ * CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE
+ * AND ITS DOCUMENTATION, EVEN IF THE AUTHOR OF THIS SOFTWARE HAS
+ * BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ *
+ * THE AUTHOR OF THIS SOFTWARE SPECIFICALLY DISCLAIMS ANY
+ * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+ * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS ON AN "AS IS"
+ * BASIS, AND THE AUTHOR OF THIS SOFTWARE HAS NO OBLIGATION TO
+ * PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+ * MODIFICATIONS.
+ * ___________________________________________________________________
+ *
+ * This file is adapted from the Tk 4.0 source file tkImgBmap.c
+ * Original tkImgBmap.c copyright information:
+ *
+ * Copyright (c) 1994 The Regents of the University of California.
+ * Copyright (c) 1994-1995 Sun Microsystems, Inc.
+ *
+ * See the file "license.terms.tcltk" for information on usage
+ * and redistribution of the original tkImgBmap.c file, and for a
+ * DISCLAIMER OF ALL WARRANTIES from the authors of tkImgBmap.c.
+ */
+#include "tkInt.h"
+#include "tkPort.h"
+
+#include "guitcl.h"
+
+/* constants used only in this file */
+
+#define XPM_MONO 1
+#define XPM_GRAY_4 2
+#define XPM_GRAY 3
+#define XPM_COLOR 4
+#define XPM_SYMBOLIC 5
+#define XPM_UNKNOWN 6
+
+/*
+ * The following data structure represents the master for a pixmap
+ * image:
+ */
+
+typedef struct PixmapMaster {
+ Tk_ImageMaster tkMaster; /* Tk's token for image master. NULL means
+ * the image is being deleted. */
+ Tcl_Interp *interp; /* Interpreter for application that is
+ * using image. */
+ Tcl_Command imageCmd; /* Token for image command (used to delete
+ * it when the image goes away). NULL means
+ * the image command has already been
+ * deleted. */
+ char *fileString; /* Value of -file option (malloc'ed).
+ * valid only if the -file option is specified
+ */
+ char *dataString; /* Value of -data option (malloc'ed).
+ * valid only if the -data option is specified
+ */
+ /* First in list of all instances associated
+ * with this master. */
+ Tk_Uid id; /* ID's for XPM data already compiled
+ * into the tixwish binary */
+ int size[2]; /* width and height */
+ int ncolors; /* number of colors */
+ int cpp; /* characters per pixel */
+ char ** data; /* The data that defines this pixmap
+ * image (array of strings). It is
+ * converted into an X Pixmap when this
+ * image is instanciated
+ */
+ int isDataAlloced; /* False iff the data is got from
+ * the -id switch */
+ struct PixmapInstance *instancePtr;
+} PixmapMaster;
+
+/* Make this more portable */
+
+typedef struct ColorStruct {
+ char c; /* This is used if CPP is one */
+ char * cstring; /* This is used if CPP is bigger than one */
+ XColor * colorPtr;
+} ColorStruct;
+
+/*
+ * The following data structure represents all of the instances of an
+ * image that lie within a particular window:
+ *
+ * %% ToDo
+ * Currently one instance is created for each window that uses this pixmap.
+ * This is usually OK because pixmaps are usually not shared or only shared by
+ * a small number of windows. To improve resource allocation, we can
+ * create an instance for each (Display x Visual x Depth) combo. This will
+ * usually reduce the number of instances to one.
+ */
+typedef struct PixmapInstance {
+ int refCount; /* Number of instances that share this
+ * data structure. */
+ PixmapMaster *masterPtr; /* Pointer to master for image. */
+ Tk_Window tkwin; /* Window in which the instances will be
+ * displayed. */
+ Pixmap pixmap; /* The pixmap to display. */
+ Pixmap mask; /* Mask: only display pixmap pixels where
+ * there are 1's here. */
+ GC gc; /* Graphics context for displaying pixmap.
+ * None means there was an error while
+ * setting up the instance, so it cannot
+ * be displayed. */
+ struct PixmapInstance *nextPtr;
+ /* Next in list of all instance structures
+ * associated with masterPtr (NULL means
+ * end of list).
+ */
+ ColorStruct * colors;
+} PixmapInstance;
+
+/*
+ * The type record for pixmap images:
+ */
+
+static int ImgXpmCreate _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, int argc, Tcl_Obj *CONST objv[],
+ Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *clientDataPtr));
+static ClientData ImgXpmGet _ANSI_ARGS_((Tk_Window tkwin,
+ ClientData clientData));
+static void ImgXpmDisplay _ANSI_ARGS_((ClientData clientData,
+ Display *display, Drawable drawable,
+ int imageX, int imageY, int width, int height,
+ int drawableX, int drawableY));
+static void ImgXpmFree _ANSI_ARGS_((ClientData clientData,
+ Display *display));
+static void ImgXpmDelete _ANSI_ARGS_((ClientData clientData));
+
+static Tk_ImageType tixPixmapImageType = {
+ "pixmap", /* name */
+ ImgXpmCreate, /* createProc */
+ ImgXpmGet, /* getProc */
+ ImgXpmDisplay, /* displayProc */
+ ImgXpmFree, /* freeProc */
+ ImgXpmDelete, /* deleteProc */
+ (Tk_ImageType *) NULL /* nextPtr */
+};
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_STRING, "-data", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PixmapMaster, dataString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PixmapMaster, fileString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_UID, "-id", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PixmapMaster, id), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures used only locally in this file:
+ */
+static int ImgXpmCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void ImgXpmCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void ImgXpmConfigureInstance _ANSI_ARGS_((
+ PixmapInstance *instancePtr));
+static int ImgXpmConfigureMaster _ANSI_ARGS_((
+ PixmapMaster *masterPtr, int argc, char **argv,
+ int flags));
+static int ImgXpmGetData _ANSI_ARGS_((Tcl_Interp *interp,
+ PixmapMaster *masterPtr));
+static char ** ImgXpmGetDataFromFile _ANSI_ARGS_((Tcl_Interp * interp,
+ char * string, int * numLines_return));
+static char ** ImgXpmGetDataFromId _ANSI_ARGS_((Tcl_Interp * interp,
+ char * id));
+static char ** ImgXpmGetDataFromString _ANSI_ARGS_((Tcl_Interp*interp,
+ char * string, int * numLines_return));
+static void ImgXpmGetPixmapFromData _ANSI_ARGS_((
+ Tcl_Interp * interp,
+ PixmapMaster *masterPtr,
+ PixmapInstance *instancePtr));
+
+/* Local data, used only in this file */
+static Tcl_HashTable xpmTable;
+static int xpmTableInited = 0;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgXpmCreate --
+ *
+ * This procedure is called by the Tk image code to create "pixmap"
+ * images.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The data structure for a new image is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ImgXpmCreate(interp, name, argc, objv, typePtr, master, clientDataPtr)
+ Tcl_Interp *interp; /* Interpreter for application containing
+ * image. */
+ char *name; /* Name to use for image. */
+ int argc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings for options (doesn't
+ * include image name or type). */
+ Tk_ImageType *typePtr; /* Pointer to our type record (not used). */
+ Tk_ImageMaster master; /* Token for image, to be used by us in
+ * later callbacks. */
+ ClientData *clientDataPtr; /* Store manager's token for image here;
+ * it will be returned in later callbacks. */
+{
+ PixmapMaster *masterPtr;
+ char **argv;
+ int i;
+
+ masterPtr = (PixmapMaster *) ckalloc(sizeof(PixmapMaster));
+ masterPtr->tkMaster = master;
+ masterPtr->interp = interp;
+ masterPtr->imageCmd = Tcl_CreateCommand(interp, name, ImgXpmCmd,
+ (ClientData) masterPtr, ImgXpmCmdDeletedProc);
+
+ masterPtr->fileString = NULL;
+ masterPtr->dataString = NULL;
+ masterPtr->id = NULL;
+ masterPtr->data = NULL;
+ masterPtr->isDataAlloced = 0;
+ masterPtr->instancePtr = NULL;
+
+ argv = (char **) ckalloc (argc * sizeof (char *));
+ for (i = 0; i < argc; i++) {
+ argv[i] = Tcl_GetStringFromObj(objv[i], (int *) NULL);
+ }
+
+ if (ImgXpmConfigureMaster(masterPtr, argc, argv, 0) != TCL_OK) {
+ ImgXpmDelete((ClientData) masterPtr);
+ ckfree ((char *) argv);
+ return TCL_ERROR;
+ }
+ ckfree ((char *) argv);
+ *clientDataPtr = (ClientData) masterPtr;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgXpmConfigureMaster --
+ *
+ * This procedure is called when a pixmap 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.
+ *
+ * If any error occurs, the state of *masterPtr is restored to
+ * previous state.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ImgXpmConfigureMaster(masterPtr, argc, argv, flags)
+ PixmapMaster *masterPtr; /* Pointer to data structure describing
+ * overall pixmap image to (reconfigure). */
+ int argc; /* Number of entries in argv. */
+ char **argv; /* Pairs of configuration options for image. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget,
+ * such as TK_CONFIG_ARGV_ONLY. */
+{
+ PixmapInstance *instancePtr;
+ char * oldData, * oldFile;
+ Tk_Uid oldId;
+
+ oldData = masterPtr->dataString;
+ oldFile = masterPtr->fileString;
+ oldId = masterPtr->id;
+
+ if (Tk_ConfigureWidget(masterPtr->interp, Tk_MainWindow(masterPtr->interp),
+ configSpecs, argc, argv, (char *) masterPtr, flags)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (masterPtr->id != NULL ||
+ masterPtr->dataString != NULL ||
+ masterPtr->fileString != NULL) {
+ if (ImgXpmGetData(masterPtr->interp, masterPtr) != TCL_OK) {
+ goto error;
+ }
+ } else {
+ Tcl_AppendResult(masterPtr->interp,
+ "must specify one of -data, -file or -id", NULL);
+ goto error;
+ }
+
+ /*
+ * Cycle through all of the instances of this image, regenerating
+ * the information for each instance. Then force the image to be
+ * redisplayed everywhere that it is used.
+ */
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ ImgXpmConfigureInstance(instancePtr);
+ }
+
+ if (masterPtr->data) {
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0,
+ masterPtr->size[0], masterPtr->size[1],
+ masterPtr->size[0], masterPtr->size[1]);
+ } else {
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0, 0, 0);
+ }
+
+ done:
+ return TCL_OK;
+
+ error:
+ /* Restore it to the original (possible valid) mode */
+ masterPtr->dataString = oldData;
+ masterPtr->fileString = oldFile;
+ masterPtr->id = oldId;
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgXpmGetData --
+ *
+ * Given a file name or ASCII string, this procedure parses the
+ * file or string contents to produce binary data for a pixmap.
+ *
+ * Results:
+ * If the pixmap description was parsed successfully then the data
+ * is read into an array of strings. This array will later be used
+ * to create X Pixmaps for each instance.
+ *
+ * Side effects:
+ * The masterPtr->data array is allocated when successful. Contents of
+ * *masterPtr is changed only when successful.
+ *----------------------------------------------------------------------
+ */
+static int
+ImgXpmGetData(interp, masterPtr)
+ Tcl_Interp *interp; /* For reporting errors. */
+ PixmapMaster *masterPtr;
+{
+ char ** data = NULL;
+ int isAllocated = 0; /* do we need to free "data"? */
+ int listArgc;
+ char ** listArgv = NULL;
+ int numLines;
+ int size[2];
+ int cpp;
+ int ncolors;
+
+ if (masterPtr->id != NULL) {
+ data = ImgXpmGetDataFromId(interp, masterPtr->id);
+ isAllocated = 0;
+ }
+ else if (masterPtr->fileString != NULL) {
+ data = ImgXpmGetDataFromFile(interp, masterPtr->fileString, &numLines);
+ isAllocated = 1;
+ }
+ else if (masterPtr->dataString != NULL) {
+ data = ImgXpmGetDataFromString(interp,masterPtr->dataString,&numLines);
+ isAllocated = 1;
+ }
+ else {
+ /* Should have been enforced by ImgXpmConfigureMaster() */
+ panic("ImgXpmGetData(): -data, -file and -id are all NULL");
+ }
+
+ if (data == NULL) {
+ return TCL_ERROR;
+ }
+
+ /* Parse the first line of the data and get info about this pixmap */
+ if (Tcl_SplitList(interp, data[0], &listArgc, &listArgv) != TCL_OK) {
+ goto error;
+ }
+
+ if (listArgc < 4) {
+ Tcl_AppendResult(interp, "File format error", NULL);
+ goto error;
+ }
+
+ if (Tcl_GetInt(interp, listArgv[0], &size[0]) != TCL_OK) {
+ goto error;
+ }
+ if (Tcl_GetInt(interp, listArgv[1], &size[1]) != TCL_OK) {
+ goto error;
+ }
+ if (Tcl_GetInt(interp, listArgv[2], &ncolors) != TCL_OK) {
+ goto error;
+ }
+ if (Tcl_GetInt(interp, listArgv[3], &cpp) != TCL_OK) {
+ goto error;
+ }
+
+ if (isAllocated) {
+ if (numLines != size[1] + ncolors + 1) {
+ /* the number of lines read from the file/data
+ * is not the same as specified in the data
+ */
+ goto error;
+ }
+ }
+
+ done:
+ if (masterPtr->isDataAlloced && masterPtr->data) {
+ ckfree((char*)masterPtr->data);
+ }
+ masterPtr->isDataAlloced = isAllocated;
+ masterPtr->data = data;
+ masterPtr->size[0] = size[0];
+ masterPtr->size[1] = size[1];
+ masterPtr->cpp = cpp;
+ masterPtr->ncolors = ncolors;
+
+#if 1 /* Zsolt Koppany 17-sep-96 */
+ if (listArgv) {
+ ckfree((char*)listArgv);
+ }
+#endif /* 1 */
+ return TCL_OK;
+
+ error:
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "File format error", NULL);
+
+ if (isAllocated && data) {
+ ckfree((char*)data);
+ }
+ if (listArgv) {
+ ckfree((char*)listArgv);
+ }
+
+ return TCL_ERROR;
+}
+
+static char ** ImgXpmGetDataFromId(interp, id)
+ Tcl_Interp * interp;
+ char * id;
+{
+ Tcl_HashEntry * hashPtr;
+
+ if (xpmTableInited == 0) {
+ hashPtr = NULL;
+ } else {
+ hashPtr = Tcl_FindHashEntry(&xpmTable, id);
+ }
+
+ if (hashPtr == NULL) {
+ Tcl_AppendResult(interp, "unknown pixmap ID \"", id,
+ "\"", NULL);
+ return (char**)NULL;
+ } else {
+ return (char**)Tcl_GetHashValue(hashPtr);
+ }
+}
+
+static char ** ImgXpmGetDataFromString(interp, string, numLines_return)
+ Tcl_Interp * interp;
+ char * string;
+ int * numLines_return;
+{
+ int quoted;
+ char * p, * list;
+ int numLines;
+ char ** data = NULL;
+
+ /* skip the leading blanks (leading blanks are not defined in the
+ * the XPM definition, but skipping them shouldn't hurt. Also, the ability
+ * to skip the leading blanks is good for using in-line XPM data in TCL
+ * scripts
+ */
+ while (isspace(*string)) {
+ ++ string;
+ }
+
+ /* parse the header */
+ if (strncmp("/* XPM", string, 6) != 0) {
+ goto error;
+ }
+
+ /* strip the comments */
+ for (quoted = 0, p=string; *p;) {
+ if (!quoted) {
+ if (*p == '"') {
+ quoted = 1;
+ ++ p;
+ continue;
+ }
+
+ if (*p == '/' && *(p+1) == '*') {
+ *p++ = ' ';
+ *p++ = ' ';
+ while (1) {
+ if (*p == 0) {
+ break;
+ }
+ if (*p == '*' && *(p+1) == '/') {
+ *p++ = ' ';
+ *p++ = ' ';
+ break;
+ }
+ *p++ = ' ';
+ }
+ continue;
+ }
+ ++ p;
+ } else {
+ if (*p == '"') {
+ quoted = 0;
+ }
+ ++ p;
+ }
+ }
+
+ /* Search for the opening brace */
+ for (p=string; *p;) {
+ if (*p != '{') {
+ ++ p;
+ } else {
+ ++p;
+ break;
+ }
+ }
+
+ /* Change the buffer in to a proper TCL list */
+ quoted = 0;
+ list = p;
+
+ while (*p) {
+ if (!quoted) {
+ if (*p == '"') {
+ quoted = 1;
+ ++ p;
+ continue;
+ }
+
+ if (isspace(*p)) {
+ *p = ' ';
+ }
+ else if (*p == ',') {
+ *p = ' ';
+ }
+ else if (*p == '}') {
+ *p = 0;
+ break;
+ }
+ ++p;
+ }
+ else {
+ if (*p == '"') {
+ quoted = 0;
+ }
+ ++ p;
+ }
+ }
+
+ /* The following code depends on the fact that Tcl_SplitList
+ * strips away double quoates inside a list: ie:
+ * if string == "\"1\" \"2\"" then
+ * list[0] = "1"
+ * list[1] = "2"
+ * and NOT
+ *
+ * list[0] = "\"1\""
+ * list[1] = "\"2\""
+ */
+ if (Tcl_SplitList(interp, list, &numLines, &data) != TCL_OK) {
+ goto error;
+ } else {
+ if (numLines == 0) {
+ /* error: empty data? */
+ if (data != NULL) {
+ ckfree((char*)data);
+ goto error;
+ }
+ }
+ * numLines_return = numLines;
+ return data;
+ }
+
+ error:
+ Tcl_AppendResult(interp, "File format error", NULL);
+ return (char**) NULL;
+}
+
+static char ** ImgXpmGetDataFromFile(interp, fileName, numLines_return)
+ Tcl_Interp * interp;
+ char * fileName;
+ int * numLines_return;
+{
+ int fileId, size;
+ char ** data;
+ struct stat statBuf;
+ char *cmdBuffer = NULL;
+ Tcl_DString buffer; /* initialized by Tcl_TildeSubst */
+
+#if 1
+ fileId = -1; /* Zsolt Koppany 23-mar-96 */
+#endif
+
+ fileName = Tcl_TildeSubst(interp, fileName, &buffer);
+ if (fileName == NULL) {
+ goto error;
+ }
+
+ fileId = open(fileName, O_RDONLY, 0);
+ if (fileId < 0) {
+ Tcl_AppendResult(interp, "couldn't read file \"", fileName,
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
+ goto error;
+ }
+ if (fstat(fileId, &statBuf) == -1) {
+ Tcl_AppendResult(interp, "couldn't stat file \"", fileName,
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
+ close(fileId);
+ goto error;
+ }
+ cmdBuffer = (char *) ckalloc((unsigned) statBuf.st_size+1);
+ size = read(fileId, cmdBuffer, (size_t) statBuf.st_size);
+ if (size < 0) {
+ Tcl_AppendResult(interp, "error in reading file \"", fileName,
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
+ close(fileId);
+ goto error;
+ }
+ if (close(fileId) != 0) {
+ Tcl_AppendResult(interp, "error closing file \"", fileName,
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
+ goto error;
+ }
+ cmdBuffer[size] = 0;
+
+ done:
+ data = ImgXpmGetDataFromString(interp, cmdBuffer, numLines_return);
+#if 1 /* Zsolt Koppany 23-mar-96 */
+ if (fileId != -1)
+ close(fileId);
+#endif
+
+ ckfree(cmdBuffer);
+ Tcl_DStringFree(&buffer);
+ return data;
+
+ error:
+#if 1 /* Zsolt Koppany 23-mar-96 */
+ if (fileId != -1)
+ close(fileId);
+#endif
+ if (cmdBuffer != NULL) {
+ ckfree(cmdBuffer);
+ }
+ Tcl_DStringFree(&buffer);
+ return (char**)NULL;
+}
+
+
+static char * GetType(colorDefn, type_ret)
+ char * colorDefn;
+ int * type_ret;
+{
+ char * p = colorDefn;
+
+ /* skip white spaces */
+ while (*p && isspace(*p)) {
+ p ++;
+ }
+
+ /* parse the type */
+ if (p[0] != '\0' && p[0] == 'm' &&
+ p[1] != '\0' && isspace(p[1])) {
+ *type_ret = XPM_MONO;
+ p += 2;
+ }
+ else if (p[0] != '\0' && p[0] == 'g' &&
+ p[1] != '\0' && p[1] == '4' &&
+ p[2] != '\0' && isspace(p[2])) {
+ *type_ret = XPM_GRAY_4;
+ p += 3;
+ }
+ else if (p[0] != '\0' && p[0] == 'g' &&
+ p[1] != '\0' && isspace(p[1])) {
+ *type_ret = XPM_GRAY;
+ p += 2;
+ }
+ else if (p[0] != '\0' && p[0] == 'c' &&
+ p[1] != '\0' && isspace(p[1])) {
+ *type_ret = XPM_COLOR;
+ p += 2;
+ }
+ else if (p[0] != '\0' && p[0] == 's' &&
+ p[1] != '\0' && isspace(p[1])) {
+ *type_ret = XPM_SYMBOLIC;
+ p += 2;
+ }
+ else {
+ *type_ret = XPM_UNKNOWN;
+ return NULL;
+ }
+
+ return p;
+}
+
+/* colorName is guaranteed to be big enough */
+static char * GetColor(colorDefn, colorName, type_ret)
+ char * colorDefn;
+ char * colorName; /* if found, name is copied to this array */
+ int * type_ret;
+{
+ int type;
+ char * p;
+
+ if (!colorDefn) {
+ return NULL;
+ }
+
+ if ((colorDefn = GetType(colorDefn, &type)) == NULL) {
+ /* unknown type */
+ return NULL;
+ }
+ else {
+ *type_ret = type;
+ }
+
+ /* skip white spaces */
+ while (*colorDefn && isspace(*colorDefn)) {
+ colorDefn ++;
+ }
+
+ p = colorName;
+
+ while (1) {
+ int dummy;
+
+ while (*colorDefn && !isspace(*colorDefn)) {
+ *p++ = *colorDefn++;
+ }
+
+ if (!*colorDefn) {
+ break;
+ }
+
+ if (GetType(colorDefn, &dummy) == NULL) {
+ /* the next string should also be considered as a part of a color
+ * name */
+
+ while (*colorDefn && isspace(*colorDefn)) {
+ *p++ = *colorDefn++;
+ }
+ } else {
+ break;
+ }
+ if (!*colorDefn) {
+ break;
+ }
+ }
+
+ /* Mark the end of the colorName */
+ *p = '\0';
+
+ return colorDefn;
+}
+
+/*----------------------------------------------------------------------
+ * ImgXpmGetPixmapFromData --
+ *
+ * Creates a pixmap for an image instance.
+ *----------------------------------------------------------------------
+ */
+static void ImgXpmGetPixmapFromData(interp, masterPtr, instancePtr)
+ Tcl_Interp * interp;
+ PixmapMaster *masterPtr;
+ PixmapInstance *instancePtr;
+{
+ XImage * image = NULL, * mask = NULL;
+ int pad, bitmap_pad, depth, i, j, k, lOffset, isTransp = 0, isMono, bpl;
+ ColorStruct * colors;
+ GC gc;
+ Display *display = Tk_Display(instancePtr->tkwin);
+
+ depth = Tk_Depth(instancePtr->tkwin);
+ if (depth > 16) {
+ pad = 32;
+ }
+ else if (depth > 8) {
+ pad = 16;
+ }
+ else {
+ pad = 8;
+ }
+
+ switch ((Tk_Visual(instancePtr->tkwin))->class) {
+ case StaticGray:
+ case GrayScale:
+ isMono = 1;
+ break;
+ default:
+ isMono = 0;
+ }
+
+ /*
+ * Create the XImage structures to store the temporary image
+ */
+#ifdef _WIN32
+ /* On Windows, we always create the bitmap using 24 bits, because
+ that lets us just store the RGB value, and not worry about
+ building a color palette. */
+ image = XCreateImage(display,
+ Tk_Visual(instancePtr->tkwin),
+ 24, ZPixmap, 0, 0,
+ masterPtr->size[0], masterPtr->size[1], pad, 0);
+#else
+ image = XCreateImage(display,
+ Tk_Visual(instancePtr->tkwin),
+ depth, ZPixmap, 0, 0,
+ masterPtr->size[0], masterPtr->size[1], pad, 0);
+#endif
+ image->data =
+ (char *)ckalloc(image->bytes_per_line * masterPtr->size[1]);
+#ifdef _WIN32
+ /* On Windows, we don't use a clip pixmap, so it's important to
+ clear the data. */
+ memset (image->data, 0, image->bytes_per_line * masterPtr->size[1]);
+#endif
+
+/* If the width of the mask is half or less than the size of
+ the padding used, then the pixmap mask might be drawn twice as
+ high as it should. Adding one to the width seems to fix this problem.
+ [irox: 10/14/98 ] */
+#define LONGBITS (sizeof(long) * 8)
+ bitmap_pad = (pad + LONGBITS - 1) / LONGBITS * LONGBITS;
+
+ if (masterPtr->size[0]<=(bitmap_pad/2)) {
+ mask = XCreateImage(display,
+ Tk_Visual(instancePtr->tkwin),
+ 1, ZPixmap, 0, 0,
+ masterPtr->size[0]+1, masterPtr->size[1], pad, 0);
+ } else {
+ mask = XCreateImage(display,
+ Tk_Visual(instancePtr->tkwin),
+ 1, ZPixmap, 0, 0,
+ masterPtr->size[0], masterPtr->size[1], pad, 0);
+ }
+
+ mask->data =
+ (char *)ckalloc(mask->bytes_per_line * masterPtr->size[1]);
+#ifdef _WIN32
+ /* On Windows, we don't use a clip pixmap, so it's important to
+ clear the data. */
+ memset (mask->data, 0, mask->bytes_per_line * masterPtr->size[1]);
+#endif
+
+ /*
+ * Parse the colors
+ */
+ lOffset = 1;
+ colors = (ColorStruct*)ckalloc(sizeof(ColorStruct)*masterPtr->ncolors);
+
+ /* Initialize the color structures */
+ for (i=0; i<masterPtr->ncolors; i++) {
+ colors[i].colorPtr = NULL;
+ if (masterPtr->cpp == 1) {
+ colors[i].c = 0;
+ } else {
+ colors[i].cstring = (char*)ckalloc(masterPtr->cpp);
+ colors[i].cstring[0] = 0;
+ }
+ }
+
+ for (i=0; i<masterPtr->ncolors; i++) {
+ char * colorDefn; /* the color definition line */
+ char * colorName; /* temp place to hold the color name
+ * defined for one type of visual */
+ char * useName; /* the color name used for this
+ * color. If there are many names
+ * defined, choose the name that is
+ * "best" for the target visual
+ */
+ int found;
+
+ colorDefn = masterPtr->data[i+lOffset]+masterPtr->cpp;
+ colorName = (char*)ckalloc(strlen(colorDefn));
+ useName = (char*)ckalloc(strlen(colorDefn));
+ found = 0;
+
+ while (colorDefn && *colorDefn) {
+ int type;
+
+ if ((colorDefn=GetColor(colorDefn, colorName, &type)) == NULL) {
+ break;
+ }
+ if (colorName[0] == '\0') {
+ continue;
+ }
+
+ switch (type) {
+ case XPM_MONO:
+ if (isMono && depth == 1) {
+ strcpy(useName, colorName);
+ found = 1; goto gotcolor;
+ }
+ break;
+ case XPM_GRAY_4:
+ if (isMono && depth == 4) {
+ strcpy(useName, colorName);
+ found = 1; goto gotcolor;
+ }
+ break;
+ case XPM_GRAY:
+ if (isMono && depth > 4) {
+ strcpy(useName, colorName);
+ found = 1; goto gotcolor;
+ }
+ break;
+ case XPM_COLOR:
+ if (!isMono) {
+ strcpy(useName, colorName);
+ found = 1; goto gotcolor;
+ }
+ break;
+ }
+ if (type != XPM_SYMBOLIC && type != XPM_UNKNOWN) {
+ if (!found) { /* use this color as default */
+ strcpy(useName, colorName);
+ found = 1;
+ }
+ }
+ }
+
+ gotcolor:
+ if (masterPtr->cpp == 1) {
+ colors[i].c = masterPtr->data[i+lOffset][0];
+ } else {
+ strncpy(colors[i].cstring, masterPtr->data[i+lOffset],
+ (size_t)masterPtr->cpp);
+ }
+
+ if (found) {
+ if (strncasecmp(useName, "none",4) != 0) {
+ colors[i].colorPtr = Tk_GetColor(interp,
+ instancePtr->tkwin, Tk_GetUid(useName));
+ if (colors[i].colorPtr == NULL) {
+ colors[i].colorPtr = Tk_GetColor(interp,
+ instancePtr->tkwin, Tk_GetUid("black"));
+ }
+ }
+ } else {
+ colors[i].colorPtr = Tk_GetColor(interp,
+ instancePtr->tkwin, Tk_GetUid("black"));
+ }
+
+ ckfree(colorName);
+ ckfree(useName);
+ }
+
+ lOffset += masterPtr->ncolors;
+
+ /*
+ * Parse the main body of the image
+ */
+ for (i=0; i<masterPtr->size[1]; i++) {
+ char * p = masterPtr->data[i+lOffset];
+
+ for (j=0; j<masterPtr->size[0]; j++) {
+ if (masterPtr->cpp == 1) {
+ for (k=0; k<masterPtr->ncolors; k++) {
+ if (*p == colors[k].c) {
+ if (colors[k].colorPtr != NULL) {
+ XPutPixel(image, j, i, colors[k].colorPtr->pixel);
+ XPutPixel(mask, j, i, 1);
+ } else {
+ XPutPixel(mask, j, i, 0);
+ isTransp = 1;
+ }
+ break;
+ }
+ }
+ if (*p) {
+ p++;
+ }
+ } else {
+ for (k=0; k<masterPtr->ncolors; k++) {
+ if (strncmp(p, colors[k].cstring,
+ (size_t)masterPtr->cpp) == 0) {
+ if (colors[k].colorPtr != NULL) {
+ XPutPixel(image, j, i, colors[k].colorPtr->pixel);
+ XPutPixel(mask, j, i, 1);
+ } else {
+ XPutPixel(mask, j, i, 0);
+ isTransp = 1;
+ }
+ break;
+ }
+ }
+ for (k=0; *p && k<masterPtr->cpp; k++) {
+ p++;
+ }
+ }
+ }
+ }
+
+ /*
+ * Create the pixmap(s) from the XImage structure. The mask is created
+ * only if needed (i.e., there is at least one transparent pixel)
+ */
+ instancePtr->colors = colors;
+
+ /* main image */
+ instancePtr->pixmap = Tk_GetPixmap(display,
+ Tk_WindowId(instancePtr->tkwin),
+ masterPtr->size[0], masterPtr->size[1], depth);
+
+ gc = Tk_GetGC(instancePtr->tkwin, 0, NULL);
+
+ TkPutImage(NULL, 0, display, instancePtr->pixmap,
+ gc, image, 0, 0, 0, 0, masterPtr->size[0], masterPtr->size[1]);
+
+ Tk_FreeGC(display, gc);
+
+ /* mask, if necessary */
+ if (isTransp) {
+ instancePtr->mask = Tk_GetPixmap(display,
+ Tk_WindowId(instancePtr->tkwin),
+ masterPtr->size[0], masterPtr->size[1], 1);
+ gc = XCreateGC(display, instancePtr->mask, 0, NULL);
+
+ TkPutImage(NULL, 0, display, instancePtr->mask,
+ gc, mask, 0, 0, 0, 0, masterPtr->size[0], masterPtr->size[1]);
+ XFreeGC(display, gc);
+ } else {
+ instancePtr->mask = None;
+ }
+
+ /* Done */
+ if (image) {
+ ckfree((char*)image->data);
+ image->data = NULL;
+#ifndef _WIN32
+ XDestroyImage(image);
+#else
+ ckfree((char *)image);
+#endif
+ }
+ if (mask) {
+ ckfree((char*)mask->data);
+ mask->data = NULL;
+#ifndef _WIN32
+ XDestroyImage(mask);
+#else
+ ckfree((char *)mask);
+#endif
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgXpmConfigureInstance --
+ *
+ * This procedure is called to create displaying information for
+ * a pixmap image instance based on the configuration information
+ * in the master. It is invoked both when new instances are
+ * created and when the master is reconfigured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates errors via Tk_BackgroundError if there are problems
+ * in setting up the instance.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ImgXpmConfigureInstance(instancePtr)
+ PixmapInstance *instancePtr; /* Instance to reconfigure. */
+{
+ PixmapMaster *masterPtr = instancePtr->masterPtr;
+ XGCValues gcValues;
+ GC gc;
+ unsigned int gcMask;
+
+ if (instancePtr->pixmap != None) {
+ Tk_FreePixmap(Tk_Display(instancePtr->tkwin), instancePtr->pixmap);
+ }
+ if (instancePtr->mask != None) {
+ Tk_FreePixmap(Tk_Display(instancePtr->tkwin), instancePtr->mask);
+ }
+
+ if (instancePtr->colors != NULL) {
+ int i;
+ for (i=0; i<masterPtr->ncolors; i++) {
+ if (instancePtr->colors[i].colorPtr != NULL) {
+ Tk_FreeColor(instancePtr->colors[i].colorPtr);
+ }
+ if (masterPtr->cpp != 1) {
+ ckfree(instancePtr->colors[i].cstring);
+ }
+ }
+ ckfree((char*)instancePtr->colors);
+ }
+
+ if (Tk_WindowId(instancePtr->tkwin) == None) {
+ Tk_MakeWindowExist(instancePtr->tkwin);
+ }
+
+ /* Assumption: masterPtr->data is always non NULL (enfored by
+ * ImgXpmConfigureMaster()). Also, the data must be in a valid
+ * format (partially enforced by ImgXpmConfigureMaster(), see comments
+ * inside that function).
+ */
+ ImgXpmGetPixmapFromData(masterPtr->interp, masterPtr, instancePtr);
+
+ /* Allocate a GC for drawing this instance (mask is not used if there
+ * is no transparent pixels inside the image).*/
+ if (instancePtr->mask != None) {
+ gcMask = GCGraphicsExposures|GCClipMask;
+ } else {
+ gcMask = GCGraphicsExposures;
+ }
+
+#ifdef _WIN32
+ if (instancePtr->mask != None) {
+ /* See ImgXpmDisplay. If we have a mask, we set the GC
+ function to merge the source onto the destination. In
+ ImgXpmDisplay we use the mask to clear the destination
+ first. */
+ gcMask |= GCFunction;
+ gcValues.function = GXor;
+ }
+#endif
+
+ gcValues.graphics_exposures = False;
+ gcValues.clip_mask = instancePtr->mask;
+
+ gc = Tk_GetGC(instancePtr->tkwin, gcMask, &gcValues);
+
+ if (instancePtr->gc != None) {
+ Tk_FreeGC(Tk_Display(instancePtr->tkwin), instancePtr->gc);
+ }
+ instancePtr->gc = gc;
+ return;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ImgXpmCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to an image 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
+ImgXpmCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about button widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ PixmapMaster *masterPtr = (PixmapMaster *) 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) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
+ (char *) masterPtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc == 2) {
+ code = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ code = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, argv[2], 0);
+ } else {
+ code = ImgXpmConfigureMaster(masterPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ return code;
+ }
+
+ error:
+
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be cget or configure", (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgXpmGet --
+ *
+ * This procedure is called for each use of a pixmap image in a
+ * widget.
+ *
+ * Results:
+ * The return value is a token for the instance, which is passed
+ * back to us in calls to ImgXpmDisplay and ImgXpmFre.
+ *
+ * Side effects:
+ * A data structure is set up for the instance (or, an existing
+ * instance is re-used for the new one).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+ImgXpmGet(tkwin, masterData)
+ Tk_Window tkwin; /* Window in which the instance will be
+ * used. */
+ ClientData masterData; /* Pointer to our master structure for the
+ * image. */
+{
+ PixmapMaster *masterPtr = (PixmapMaster *) masterData;
+ PixmapInstance *instancePtr;
+
+ /*
+ * See if there is already an instance for this window. If so
+ * then just re-use it.
+ */
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ if (instancePtr->tkwin == tkwin) {
+ instancePtr->refCount++;
+ return (ClientData) instancePtr;
+ }
+ }
+
+ /*
+ * The image isn't already in use in this window. Make a new
+ * instance of the image.
+ */
+ instancePtr = (PixmapInstance *) ckalloc(sizeof(PixmapInstance));
+ instancePtr->refCount = 1;
+ instancePtr->masterPtr = masterPtr;
+ instancePtr->tkwin = tkwin;
+ instancePtr->pixmap = None;
+ instancePtr->mask = None;
+ instancePtr->gc = None;
+ instancePtr->nextPtr = masterPtr->instancePtr;
+ instancePtr->colors = NULL;
+ masterPtr->instancePtr = instancePtr;
+ ImgXpmConfigureInstance(instancePtr);
+
+ /*
+ * If this is the first instance, must set the size of the image.
+ */
+ if (instancePtr->nextPtr == NULL) {
+ if (masterPtr->data) {
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0,
+ masterPtr->size[0], masterPtr->size[1],
+ masterPtr->size[0], masterPtr->size[1]);
+ } else {
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0, 0, 0);
+ }
+ }
+
+ return (ClientData) instancePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgXpmDisplay --
+ *
+ * This procedure is invoked to draw a pixmap image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A portion of the image gets rendered in a pixmap or window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgXpmDisplay(clientData, display, drawable, imageX, imageY, width,
+ height, drawableX, drawableY)
+ ClientData clientData; /* Pointer to PixmapInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display on which to draw image. */
+ Drawable drawable; /* Pixmap or window in which to draw image. */
+ int imageX, imageY; /* Upper-left corner of region within image
+ * to draw. */
+ int width, height; /* Dimensions of region within image to draw.*/
+ int drawableX, drawableY; /* Coordinates within drawable that
+ * correspond to imageX and imageY. */
+{
+ PixmapInstance *instancePtr = (PixmapInstance *) clientData;
+
+ /*
+ * If there's no graphics context, it means that an error occurred
+ * while creating the image instance so it can't be displayed.
+ */
+
+ if (instancePtr->gc == None) {
+ return;
+ }
+
+ /*
+ * We always use masking: modify the mask origin within
+ * the graphics context to line up with the image's origin.
+ * Then draw the image and reset the clip origin, if there's
+ * a mask.
+ */
+
+#ifdef _WIN32
+ /* The Tk 7.6 XCopyArea implementation on Windows does not support
+ a pixmap as a clip region, so we use the mask to first clear
+ out everything in the destination that we want to paint. */
+ if (instancePtr->mask != None) {
+ XGCValues gcValues;
+ GC gc;
+
+ gcValues.function = GXandInverted;
+ gcValues.graphics_exposures = False;
+ gc = Tk_GetGC(instancePtr->tkwin, GCFunction|GCGraphicsExposures,
+ &gcValues);
+ XCopyArea(display, instancePtr->mask, drawable, gc, imageX,
+ imageY, (unsigned) width, (unsigned) height, drawableX,
+ drawableY);
+ Tk_FreeGC(display, gc);
+ }
+#endif
+
+ XSetClipOrigin(display, instancePtr->gc, drawableX - imageX,
+ drawableY - imageY);
+ XCopyArea(display, instancePtr->pixmap, drawable, instancePtr->gc,
+ imageX, imageY, (unsigned) width, (unsigned) height,
+ drawableX, drawableY);
+ XSetClipOrigin(display, instancePtr->gc, 0, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgXpmFree --
+ *
+ * This procedure is called when a widget ceases to use a
+ * particular instance of an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Internal data structures get cleaned up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgXpmFree(clientData, display)
+ ClientData clientData; /* Pointer to PixmapInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display containing window that used image.*/
+{
+ PixmapInstance *instancePtr = (PixmapInstance *) clientData;
+ PixmapInstance *prevPtr;
+
+ instancePtr->refCount--;
+ if (instancePtr->refCount > 0) {
+ return;
+ }
+
+ /*
+ * There are no more uses of the image within this widget. Free
+ * the instance structure.
+ */
+ if (instancePtr->pixmap != None) {
+ Tk_FreePixmap(display, instancePtr->pixmap);
+ }
+ if (instancePtr->mask != None) {
+ Tk_FreePixmap(display, instancePtr->mask);
+ }
+ if (instancePtr->gc != None) {
+ Tk_FreeGC(display, instancePtr->gc);
+ }
+ if (instancePtr->colors != NULL) {
+ int i;
+ for (i=0; i<instancePtr->masterPtr->ncolors; i++) {
+ if (instancePtr->colors[i].colorPtr != NULL) {
+ Tk_FreeColor(instancePtr->colors[i].colorPtr);
+ }
+ if (instancePtr->masterPtr->cpp != 1) {
+ ckfree(instancePtr->colors[i].cstring);
+ }
+ }
+ ckfree((char*)instancePtr->colors);
+ }
+
+ if (instancePtr->masterPtr->instancePtr == instancePtr) {
+ instancePtr->masterPtr->instancePtr = instancePtr->nextPtr;
+ } else {
+ for (prevPtr = instancePtr->masterPtr->instancePtr;
+ prevPtr->nextPtr != instancePtr; prevPtr = prevPtr->nextPtr) {
+ /* Empty loop body */
+ }
+ prevPtr->nextPtr = instancePtr->nextPtr;
+ }
+ ckfree((char *) instancePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgXpmDelete --
+ *
+ * This procedure is called by the image code to delete the
+ * master structure for an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with the image get freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgXpmDelete(masterData)
+ ClientData masterData; /* Pointer to PixmapMaster structure for
+ * image. Must not have any more instances. */
+{
+ PixmapMaster *masterPtr = (PixmapMaster *) masterData;
+
+ if (masterPtr->instancePtr != NULL) {
+ panic("tried to delete pixmap image when instances still exist");
+ }
+ masterPtr->tkMaster = NULL;
+ if (masterPtr->imageCmd != NULL) {
+ Tcl_DeleteCommand(masterPtr->interp,
+ Tcl_GetCommandName(masterPtr->interp, masterPtr->imageCmd));
+ }
+ if (masterPtr->isDataAlloced && masterPtr->data != NULL) {
+ ckfree((char*)masterPtr->data);
+ }
+ Tk_FreeOptions(configSpecs, (char *) masterPtr, (Display *) NULL, 0);
+ ckfree((char *) masterPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgXpmCmdDeletedProc --
+ *
+ * This procedure is invoked when the image command for an image
+ * is deleted. It deletes the image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ImgXpmCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to PixmapMaster structure for
+ * image. */
+{
+ PixmapMaster *masterPtr = (PixmapMaster *) clientData;
+
+ masterPtr->imageCmd = NULL;
+ if (masterPtr->tkMaster != NULL) {
+ Tk_DeleteImage(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster));
+ }
+}
+
+
+
+#if 0
+
+/* We currently don't need this code for the IDE.
+ If we ever do, uncomment it and change its name so that it starts
+ with the "ide_" prefix. */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tix_DefinePixmap
+ *
+ * Define an XPM data structure with an unique name, so that you can
+ * later refer to this pixmap using the -id switch in [image create
+ * pixmap].
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The data is stored in a HashTable.
+ *----------------------------------------------------------------------
+ */
+int
+Tix_DefinePixmap(interp, name, data)
+ Tcl_Interp * interp;
+ Tk_Uid name; /* Name to use for bitmap. Must not already
+ * be defined as a bitmap. */
+ char **data;
+{
+ int new;
+ Tcl_HashEntry *hshPtr;
+
+ if (!xpmTableInited) {
+ xpmTableInited = 1;
+ Tcl_InitHashTable(&xpmTable, TCL_ONE_WORD_KEYS);
+ }
+
+ hshPtr = Tcl_CreateHashEntry(&xpmTable, name, &new);
+ if (!new) {
+ Tcl_AppendResult(interp, "pixmap \"", name,
+ "\" is already defined", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetHashValue(hshPtr, (char*)data);
+ return TCL_OK;
+}
+
+#endif
+
+void
+ide_create_xpm_image_type ()
+{
+ Tk_CreateImageType(&tixPixmapImageType);
+}
diff --git a/libgui/stamp-h.in b/libgui/stamp-h.in
new file mode 100644
index 00000000000..9788f70238c
--- /dev/null
+++ b/libgui/stamp-h.in
@@ -0,0 +1 @@
+timestamp
diff --git a/tix/ABOUT.html b/tix/ABOUT.html
new file mode 100644
index 00000000000..7ca8df44cdc
--- /dev/null
+++ b/tix/ABOUT.html
@@ -0,0 +1,119 @@
+<Center><H1>About the Tix Programming Library</H1></Center>
+<TITLE>About the Tix Programming Library</TITLE>
+
+ The Tix library is an extension to the Tk toolkit that contains
+ over 40 new widgets for Tk. Features include:
+
+ <DL>
+ <DT><b>A LOT of new widgets:</b>
+ <DD>
+
+ The Tix library has by far the greatest collection of
+ widgets for programming with Tcl/Tk. Highlights include:
+ Hierarchical Listbox, Directory List/Tree View, SpreadSheet,
+ Tabular Listbox, ComboBox, Motif style FileSelectBox, MS
+ Windows style FileSelectBox, PanedWindow, NoteBook, Spin
+ Control widget .... and many more. With these new widgets,
+ your applications will look great and interact with your
+ users in intuitive ways.
+
+ <DT><b>Rapid Prototyping New Widgets:</b>
+ <DD>
+
+ Tix comes with a complete Object-Oriented framework for
+ building new customed widgets using TCL exclusively. It
+ typically reduces the efforts of developing a new widget by
+ a factor of ten or more.<p>
+
+ <DT> <b>XPM image suport:</b>
+ <DD>
+
+ This allows you to display color icons in XPM
+ format. Supports transparent background. <p>
+
+ <DT><b>Compound images:</b>
+ <DD>
+
+ A new image type called "compound" allows youto glue
+ together a bunch of bitmaps, images and text strings
+ together to form a bigger image. Then you can use this image
+ with widgets that support the -image option. For example,
+ you can display a text string string together with a bitmap,
+ at the same time, inside a TK button widget.<p>
+
+ <DT><b> Display Items and Display Styles:</b>
+ <DD>
+
+ Display items and display styles make it possible to display
+ visual information in many formats.<p>
+
+ <DT><b>Form geometry manager:</b>
+ <DD>
+
+ Works similarly to the Motif Form widget. You can specify
+ geometry constraints using attachment rules. <p>
+
+ <DT><b> Mwm window mamager support:</b>
+ <DD>
+
+ With the <code>tixMwm</code> command, you can communicate
+ with the Motif window manager "mwm"; you can add new items
+ to the Motif system menu and change the window manager
+ decorations.<p>
+
+
+ </DL>
+
+ <hr>
+
+<h3>Getting more information about Tix</h3>
+
+ <DL>
+ <DT><b>Tix Home Page:</b>
+ <DD>
+
+ The Tix Home Page at <a href= "http://www.xpi.com/tix/">
+ http://www.xpi.com/tix/</a> provides more detailed and
+ up-to-date information about Tix.<p>
+
+ <DT><b>The Tix Mailing List</b>
+ <DD>
+
+ There is a mailing list for the discussion of the
+ development of both the Tix library and Tix-based
+ applications. To subscribe, send me a mail to <a
+ href="mailto:majordomo@xpi.com">majordomo@xpi.com </a> with
+ the line "<code>subscribe tix-info [your_address]</code>" in
+ the body of the mail.
+
+ To send a message to the Tix mailing list, please use the
+ address <a href="mailto:tix-info@xpi.com">
+ tix-info@xpi.com</a>. <p>
+
+ The Tix mailing list has been archived. You can find useful
+ information at the Tix mailing list archives at: <a href=
+ "http://www.xpi.com/archives/archives.html">
+ http://www.xpi.com/archives/archives.html</a>.<p>
+ </DL>
+
+<h3>Getting Techical Support for Tix</h3>
+
+ If you have a question about using the Tix library, feel free to
+ contact the Tix support team at the address <a
+ href="tix-support@xpi.com">tix-support@xpi.com</a>. Please notice
+ that this support service is currently provided only on a good-will
+ basis with no implied obligations or guaranty. <p>
+
+<h3>Bug Reports</h3>
+
+ Tix is a large product and as such will certainly contain bugs. If
+ you have encountered a bug while using Tix, please send a bug
+ report to the address <a href="tix-bugs@xpi.com"> tix-bugs@xpi.com
+ </a>. We'll appreciate it if you can send along a small,
+ self-contained program that demonstrates the behavior of the
+ bug.<p>
+
+
+<!Serial 851750010>
+<hr><i>Last modified Fri Jan 17 22:49:53 EST 1997 </i> ---
+<i>Serial 853731291</i>
diff --git a/tix/ABOUT.txt b/tix/ABOUT.txt
new file mode 100644
index 00000000000..5ac3b65c2ae
--- /dev/null
+++ b/tix/ABOUT.txt
@@ -0,0 +1,86 @@
+
+ ABOUT THE TIX PROGRAMMING LIBRARY
+
+ The Tix library is an extension to the Tk toolkit that contains over
+ 40 new widgets for Tk. Features include:
+
+ A LOT of new widgets:
+ The Tix library has by far the greatest collection of widgets
+ for programming with Tcl/Tk. Highlights include: Hierarchical
+ Listbox, Directory List/Tree View, SpreadSheet, Tabular
+ Listbox, ComboBox, Motif style FileSelectBox, MS Windows style
+ FileSelectBox, PanedWindow, NoteBook, Spin Control widget ....
+ and many more. With these new widgets, your applications will
+ look great and interact with your users in intuitive ways.
+
+ Rapid Prototyping New Widgets:
+ Tix comes with a complete Object-Oriented framework for
+ building new customed widgets using TCL exclusively. It
+ typically reduces the efforts of developing a new widget by a
+ factor of ten or more.
+
+ XPM image suport:
+ This allows you to display color icons in XPM format. Supports
+ transparent background.
+
+ Compound images:
+ A new image type called "compound" allows youto glue together a
+ bunch of bitmaps, images and text strings together to form a
+ bigger image. Then you can use this image with widgets that
+ support the -image option. For example, you can display a text
+ string string together with a bitmap, at the same time, inside
+ a TK button widget.
+
+ Display Items and Display Styles:
+ Display items and display styles make it possible to display
+ visual information in many formats.
+
+ Form geometry manager:
+ Works similarly to the Motif Form widget. You can specify
+ geometry constraints using attachment rules.
+
+ Mwm window mamager support:
+ With the tixMwm command, you can communicate with the Motif
+ window manager "mwm"; you can add new items to the Motif system
+ menu and change the window manager decorations.
+
+
+ _________________________________________________________________
+
+ GETTING MORE INFORMATION ABOUT TIX
+
+ Tix Home Page:
+ The Tix Home Page at http://www.xpi.com/tix/ provides more
+ detailed and up-to-date information about Tix.
+
+ The Tix Mailing List
+ There is a mailing list for the discussion of the development
+ of both the Tix library and Tix-based applications. To
+ subscribe, send me a mail to majordomo@xpi.com with the line
+ "subscribe tix-info [your_address]" in the body of the mail. To
+ send a message to the Tix mailing list, please use the address
+ tix-info@xpi.com.
+
+ The Tix mailing list has been archived. You can find useful
+ information at the Tix mailing list archives at:
+ http://www.xpi.com/archives/archives.html.
+
+ GETTING TECHICAL SUPPORT FOR TIX
+
+ If you have a question about using the Tix library, feel free to
+ contact the Tix support team at the address tix-support@xpi.com.
+ Please notice that this support service is currently provided only on
+ a good-will basis with no implied obligations or guaranty.
+
+ BUG REPORTS
+
+ Tix is a large product and as such will certainly contain bugs. If you
+ have encountered a bug while using Tix, please send a bug report to
+ the address tix-bugs@xpi.com . We'll appreciate it if you can send
+ along a small, self-contained program that demonstrates the behavior
+ of the bug.
+
+
+ _________________________________________________________________
+
+ Last modified Fri Jan 17 22:49:53 EST 1997 --- Serial 853731291
diff --git a/tix/ChangeLog b/tix/ChangeLog
new file mode 100644
index 00000000000..6da6ad6f998
--- /dev/null
+++ b/tix/ChangeLog
@@ -0,0 +1,623 @@
+2000-01-26 DJ Delorie <dj@cygnus.com>
+
+ * win/tixWCmpt.c (DllMain): Use _imp__ instead of __imp_
+
+1999-12-06 Mo DeJong <mdejong@cygnus.com>
+
+ * win/Makefile.in: removed export of symbols that start with _real@.
+ this is needed for VC++ 6.0
+
+1999-09-22 DJ Delorie <dj@cygnus.com>
+
+ * win/Makefile.in (LIB_DIR etc): change to @dir@ form
+
+Thu Aug 26 18:44:04 1999 Geoffrey Noer <noer@cygnus.com>
+
+ Changes necessary to avoid Windows install-time conflicts
+ with similarly named files in itcl/iwidgets docs:
+ * man/ComboBox.n: delete
+ * man/TixComboBox.n: newly renamed
+ * man/ComboBox.html: delete
+ * man/TixComboBox.html: newly renamed
+
+1999-05-28 Syd Polk <spolk@cygnus.com>
+
+ * win/tkConsole81.c: Added. Initialized tcl correctly for 8.1.
+
+ * win/Makefile.in: Use correct console obj for tcl8.1.
+
+1999-04-22 Syd Polk <spolk@cygnus.com>
+
+ * unix/Makefile.in: Don't create lib directory for install-libraries.
+
+1999-03-26 Martin Hunt <hunt@cygnus.com>
+
+ * library/pref/TkWin.csc: Don't set scrollbar default
+ widths. The scrollbar widget is native and Windows knows
+ how big it should be.
+
+1999-03-15 Ian Roxborough <irox@cygnus.com>
+
+ * library/NoteBook.tcl: reduce notebook tab hight, looks
+ better on Unix and Windows.
+
+Fri Feb 26 15:38:56 1999 Geoffrey Noer <noer@cygnus.com>
+
+ * configure.in: Change "cygwin32*" to "cygwin*"
+ * configure: Regenerate.
+
+1999-02-22 Syd Polk <spolk@cygnus.com>
+
+ * win/configure.in: Fixed TIX_LIB_FULL_PATH for Visual C++.
+ * win/configure: Regenerate.
+
+1999-02-09 Syd Polk <spolk@cygnus.com>
+
+ * tixConfig.sh.in: Added TIX_LIB_FULL_PATH.
+ * unix/tk8.0/configure.in: Added TIX_LIB_FULL_PATH. Exported
+ TCL_LIB_FULL_PATH, TK_LIB_FULL_PATH and ITCL_LIB_FULL_PATH
+ for dependencies.
+ * unix/tk8.1/configure.in: Likewise.
+ * unix/tk8.0/configure: Regenerated.
+ * unix/tk8.1/oonfigure: Regenerated.
+ * unix/tk8.0/Makefile.in: Use TCL_LIB_FULL_PATH, TK_LIB_FULL_PATH,
+ and ITCL_LIB_FULL_PATH for dependencies.
+ * unix/tk8.1/Makefile.in: Likewise.
+
+1999-02-04 James Ingham <jingham@cygnus.com>
+
+ * generic/tixInit.c: Use tcl_findLibrary for Tk 8.1b1 and beyond.
+
+ * generic/tixInit.c (Tix_Init_Internal): make sure tix_library is
+ actually set before trying to fprintf it.
+
+ * {unix,win}/tk{8.0,8.1}configure.in: Add TIX_BUILD_LOCATION
+ as a convenience, so you don't have to construct it from tcl
+ version... * tixConfigure.sh.in: Add TIX_BUILD_LOCATION and
+ TIX_LIB_FILE.
+ * {unix,win}/tk{8.0,8.1}configure: regenerated.
+
+1999-02-02 James Ingham <jingham@cygnus.com>
+
+ * library/Control.tcl: Calling doAdjustValue with the wrong
+ arguments. Remove serial from the call.
+
+1998-01-26 Jim Ingham jingham@cygnus.com
+
+ Merging changes from gdbtk-980810-branch onto trunk to support
+ Itcl3.0.
+
+ * generic/tixItcl.c, generic/tixItcl.h: Added code to support
+ Namespaces in Tcl8.0. This should be used BOTH with Itcl3.0 & Tcl8.0.
+ * generic/tixMethod.c: Use the Tix_ItclSetGlobalNameSp function
+ everywhere, rather than doing it inline, which did not work with
+ Tcl 8.0.3.
+
+ * generic/tixInit.c: If we are in Tcl8.0.3, use tcl_findLibrary.
+
+Tue Jan 26 08:48:06 1999 Keith Seitz <keiths@cygnus.com>
+
+ * library/Control.tcl (tixControl:SetBindings): Force the
+ non-autorepeat case to be a normal button with a -command.
+
+Wed Jan 13 12:22:04 1999 Keith Seitz <keiths@cygnus.com>
+
+ * library/Control.tcl (tixControl:SetBindings): Pass the amount
+ of the change (-1 or +1) to StopRepeat, too.
+ (tixControl:config-state): When the state is set to normal,
+ call tixControl:SetBindings to reinstall the normal bindings.
+ If setting the state to disabled, also disable the button bindings.
+ (tixControl:StartRepeat): If autorepeat is disabled, do not set
+ the value of the widget with the buttonpress event. Let StopRepeat
+ do it.
+ (tixControl:doAdjustValue): New proc.
+ (tixControl:StopRepeat): Add "amount" argument. When autorepeat
+ is off, call doAdjustValue to set the value.
+
+1999-01-15 Syd Polk <spolk@cygnus.com>
+
+ * Fix header files to work with tcl8.1b1.
+
+1999-01-01 Michael Meissner <meissner@cygnus.com>
+
+ * unix/tk8.{0,1}/Makefile.in (_install_): Use $(INSTALL_PROGRAM)
+ instead of $(INSTALL_DATA) to install $(TIX_EXE_FILE).
+
+1998-11-06 Syd Polk <spolk@cygnus.com>
+
+ * generic/tixCompat.c: strdup does not mix with the allocator that
+ Tcl uses on Windows. Always use tixStrDup.
+ * unix/tk4.2/configure.in: Get rid of test for strdup
+ * unix/tk4.2/configure: Regenerated.
+ * unix/tk8.0/configure.in: Get rid of test for strdup
+ * unix/tk8.0/configure: Regenerated
+ * unix/tk8.1/configure.in: Get rid of test for strdup
+ * unix/tk8.1/configure: Regenerated
+ * win/Makefile.in: Get rid of define of strdup
+
+Mon Nov 2 15:05:33 1998 Geoffrey Noer <noer@cygnus.com>
+
+ * configure.in: detect cygwin* instead of cygwin32*
+ * configure: regenerate
+
+1998-10-28 Syd Polk <spolk@cygnus.com>
+
+ * win/Makefile.in: install-libraries needs to install the
+ tix dll.
+
+1998-10-27 Syd Polk <spolk@cygnus.com>
+
+ * win/Makefile.in: Fix paths for the 8.1 build to point to
+ tcl8.1 and tk8.1.
+
+1998-10-26 Syd Polk <spolk@cygnus.com>
+
+ * win/aclocal.m4: Added so that the macros to find tcl and tk are
+ standardized.
+ * win/configure.in: Use standard macros for finding tcl and tk
+ * win/configure: Regenerated.
+
+1998-10-20 Syd Polk <spolk@cygnus.com>
+
+ * unix/aclocal.m4: Added so that the macros to find tcl and tk are
+ standardized.
+ * unix/configure.in: Use standard macros for finding tcl and tk.
+ * unix/configure: Regenerated
+ * unix/tk8.1/aclocal.m4: Likewise
+ * unix/tk8.1/configure.in: Likewise
+ * unix/tk8.1/configure: Regenerated
+
+1998-10-14 Syd Polk <spolk@cygnus.com>
+
+ * win/Makefile.in: Fixed hard-wired library name.
+
+1998-10-05 Syd Polk <spolk@cygnus.com>
+
+ * unix/configure: Regenerated with updated autoconf
+ * win/Makefile.in: Fixed link command lines to work with
+ MSVC build. Fixed to work with different tcl and tk DLL
+ names. Other misc. cleanup.
+ * win/configure.in: Generated TIX_BUILD_LIB_SPEC correctly
+ for Windows.
+ * win/configure: Regenerated.
+
+1998-09-29 Syd Polk <spolk@cygnus.com>
+
+ * win/Makefile.in: Fixed to work with tcl 8.1.
+
+1998-09-28 Syd Polk <spolk@cygnus.com>
+
+ * win/configure.in: Initial changes for Windows and Tcl8.1
+ * win/configure: Regenerated
+ * tcl8.1/dummy.dir: Added for tcl8.1
+
+Sun Sep 13 17:28:50 1998 Geoffrey Noer <noer@cygnus.com>
+
+ * unix/Makefile.in: correct typo in echoed install text
+ * win/Makefile.in: ditto
+
+1998-09-08 Syd Polk <spolk@cygnus.com>
+
+ * tixConfig.sh.in: Added so that the location and name of the tix
+ library can be figured out by the clients the link them.
+ * unix/tk8.0/configure.in: Output tixConfig.sh.in
+ * unix/tk8.0/configure: Regenerate
+ * unix/tk8.1/configure.in: Output tixConfig.sh.in
+ * unix/tk8.1/configure: Regnerate
+
+Mon Aug 31 11:26:54 1998 Syd Polk <spolk@cygnus.com>
+
+ * Makefile.in unix/Makefile.in: Updated to work with either
+ Tcl/Tk 8.0 or Tcl/Tk 8.1. 8.1 requires -fwritable-strings.
+ * unix/tk8.1/Makefile.in configure configure.in pkgIndex.tcl.in
+ tixAppInit.c: Added for Tcl/Tk 8.1 support.
+
+Sun Jul 12 22:30:13 1998 Michael Tiemann <michael@impact.tiemann.org>
+
+ * unix/tk8.0/Makefile.in: Changed INSTALL_PROGRAM to INSTALL_DATA
+ where we're installing libraries, not programs. INSTALL_PROGRAM
+ is used when we might strip things; INSTALL_DATA is when we want
+ to intall something w/o stripping it.
+
+Mon Jul 6 18:44:56 1998 Ian T Roxborough <irox@cygnus.com>
+
+ * win/Makefile.in: Corrected a typo [($OBJEXT) should have been $(OBJEXT)],
+ to fix none MSVC builds.
+
+1998-07-03 Ben Elliston <bje@cygnus.com>
+
+ Patches from Ian T. Roxborough <irox@cygnus.com>.
+ * configure.in: Add AC_OBJEXT macro invocation.
+
+ * configure: Regenerate.
+
+ * src/Makefile.in: Support compiling on Win32 systems.
+
+ * win/tkConsole80b1.c: Add prototype for TkConsolePrint.
+
+Sun Jun 28 20:33:36 1998 Khamis Abuelkomboz <khamis@cygnus.com>
+
+ * library/NoteBook.tcl (tixNoteBook:MouseUp): In some cases it
+ happens that the widget gets a mouse/release without a
+ mouse/pressed event, this cause an error
+ "data(w:down) invalid variable".
+
+1998-06-18 Ben Elliston <bje@cygnus.com>
+
+ * win/Makefile.gvc: Remove.
+
+Tue Jun 9 01:33:08 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/Control.tcl (tixControl:SetBindings): Incr
+ and decr commands may take too long so bind the buttons
+ to an "after idle" command.
+
+Mon Jun 8 12:19:18 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/Control.tcl (tixControl:incr): Don't call SetValue
+ just before we change it.
+ (tixControl:decr): Don't call SetValue just before we change it.
+ (tixControl:StartRepeat): Set a local variable with the
+ value of data(serial) so a buttonrelease event doesn't
+ change it while in this function. This fixes autorepeat problems.
+ (tixControl:Repeat): Use local variable "serial" instead of
+ data(serial) to eliminate race conditions.
+
+Thu Apr 30 18:10:15 1998 Geoffrey Noer <noer@cygnus.com>
+
+ * win/Makefile.in: invoke gcc instead of ld when producing
+ dlls. Pass the linker options down via args to -Wl options.
+
+Thu Apr 16 11:47:47 1998 Ian T. Roxborough (irox@cygnus.com)
+
+ * win/Makefile.gvc: Changed absolute paths relative.
+
+Wed Apr 15 16:46:18 1998 Ian T. Roxborough (irox@cygnus.com)
+
+ * win/Makefile.gvc: Hacked make script to compile tix with MSVC.
+
+Tue Mar 24 23:10:41 1998 Jeffrey A Law (law@cygnus.com)
+
+ * generic/tixUtils.c (tix_strdup): Use "CONST", not "const" to avoid
+ losing with non-ANSI compilers.
+
+Tue Mar 24 17:30:22 1998 Stu Grossman <grossman@bhuna.cygnus.co.uk>
+
+ * win/configure: Regenerate with autoconf 2.12.1 to fix shell
+ issues for NT native builds.
+
+Wed Mar 11 14:51:59 1998 Tom Tromey <tromey@cygnus.com>
+
+ * library/pref/tixmkpref (tixInitOptionDatabase): Set .background
+ for TixScrolledText, TixScrolledWindow, TixScrolledListBox,
+ TixTree.
+ * library/pref/TkWin.csc: Rebuilt.
+
+Sat Mar 21 21:18:06 1998 Elena Zannoni <ezannoni@kwikemart.cygnus.com>
+
+ Merged changes from Foundry:
+
+ - Martin M. Hunt <hunt@cygnus.com>
+ * library/ComboBox.tcl (tixComboBox:Popup): Make sure
+ popups are always in the correct place for Windows and Unix.
+
+ - Tom Tromey <tromey@cygnus.com>
+ * library/SText.tcl (tixScrolledText:ConstructWidget): Create
+ sizebox if requested.
+ * library/SListBox.tcl (tixScrolledListBox:ConstructWidget):
+ Create sizebox if requested.
+ * library/SHList.tcl (tixScrolledHList:ConstructWidget): Create
+ sizebox if requested.
+ * library/SWindow.tcl (tixScrolledWindow:ConstructWidget): Create
+ sizebox if requested.
+ * library/SWidget.tcl (tixScrolledWidget): New config option
+ -sizebox.
+ (tixScrolledWidget:config-scrollbar): If -sizebox set, then ignore
+ -scrollbar option.
+ (tixScrolledWidget:RepackHook): Place sizebox if requested.
+ (tixScrolledWidget:config-sizebox): New proc.
+ * library/pref/TkWin.csc: Rebuilt.
+ * library/pref/tixmkpref (tixInitOptionDatabase): Typo fix.
+ * library/ComboBox.tcl (tixComboBox:ConstructListShell): Set
+ -scrollbarspace here, not in class record.
+ * library/ComboBox.tcl: Set -scrollbarspace on scrolled listbox
+ subwidget.
+
+ - Ian Lance Taylor <ian@cygnus.com>
+ * win/Makefile.in ($(TIXDLL)): Don't generate relocs for debugging
+ information.
+ * generic/tixUtils.c (tix_strdup): New function.
+ * win/Makefile.in (.c.o): Add -Dstrdup=tix_strdup.
+ ($(TMPDIR)/%.o): Likewise.
+ * library/ComboBox.tcl (tixComboBoxBind): In <FocusIn> binding,
+ don't set the entry selection if there is no text in the entry.
+
+Fri Feb 13 12:56:19 1998 Ian Lance Taylor <ian@cygnus.com>
+
+ * unix/tk8.0/configure.in: Define and substitute TIX_RANLIB.
+ * unix/tk8.0/Makefile.in (TIX_RANLIB): New variable.
+ ($(TIX_LIB_FILE)): Use $(TIX_RANLIB) rather than $(RANLIB).
+ ($(TCL_SAM_FILE), $(TK_SAM_FILE), $(TIX_SAM_FILE)): Likewise.
+ * unix/tk8.0/configure: Rebuild.
+
+Tue Dec 23 16:35:29 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/Makefile.in ($(TIXDLL)): Don't generate relocs for debugging
+ information.
+
+Wed Nov 12 11:31:06 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * library/PanedWin.tcl (tixPanedWindow:AddSeparator): On Windows,
+ make the separator a 4 pixel ridge.
+ (tixPanedWindow:UpdateSizes): On Windows, make the separator 4
+ pixels thick.
+
+Tue Nov 11 15:59:43 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * library/PanedWin.tcl (tixPanedWindow:PlotHandles): Don't
+ separator buttons on Windows.
+
+Sun Nov 9 22:17:03 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * library/Event.tcl (tixBuiltInCmdErrorHandler): On Windows, use
+ bgerror rather than puts.
+
+Sun Nov 9 16:00:14 1997 Tom Tromey <tromey@cygnus.com>
+
+ * library/pref/TkWin.csc: Rebuilt.
+ * library/pref/tixmkpref (tixInitOptionDatabase): Changed
+ background for HList and friends.
+
+Wed Nov 5 13:24:06 1997 Tom Tromey <tromey@cygnus.com>
+
+ * library/PanedWin.tcl (tixPanedWindow:setsize): Correctly
+ vertical orientation.
+
+Tue Nov 4 12:04:01 1997 Tom Tromey <tromey@cygnus.com>
+
+ * library/fs.tcl (tixFSIsNorm) [Windows version]: Accept C:\.
+
+Wed Oct 29 11:37:18 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * generic/tixInit.c: Fix some backslashes with following spaces.
+
+Tue Oct 28 17:05:41 1997 Martin M. Hunt <hunt@cygnus.com>
+
+ * generic/tixInit.c: Fix tix initscript to allow
+ embedded whitespace in pathnames.
+
+Tue Oct 28 16:41:56 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (install-minimal): New target.
+ * unix/Makefile.in (install-minimal): New target.
+ * win/Makefile.in (install-minimal): New target.
+
+Thu Oct 23 12:44:48 1997 Tom Tromey <tromey@cygnus.com>
+
+ * library/pref/TkWin.csc: Rebuilt.
+ * library/pref/TkWin.fsc: Rebuilt.
+ * library/pref/TkWin.fs: Use correct font names.
+
+Tue Oct 21 13:11:51 1997 Tom Tromey <tromey@cygnus.com>
+
+ * library/pref/tixmkpref (tixInitOptionDatabase): Choose better
+ colors for the combobox on Windows.
+
+Thu Oct 16 13:42:27 1997 Tom Tromey <tromey@cygnus.com>
+
+ * library/pref/TkWin.csc: Rebuilt.
+ * library/pref/tixmkpref (tixInitOptionDatabase): Set handle
+ background to bg color.
+
+Sat Oct 11 18:09:33 1997 Tom Tromey <tromey@cygnus.com>
+
+ * library/pref/TkWin.fs (tixSetFontset): Use windows-* fonts.
+
+Wed Oct 1 16:32:13 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ (tixUnixSam.o): Pass -I. to compile.
+
+ * unix/tk8.0/Makefile.in (tixUnixSam.o): Depend upon tixSamLib.c,
+ not $(UNIX_DIR)/tixSamLib.c.
+ (tixSamLib.c): Build in build directory, not source directory.
+ (sam_clean): Remove tixSamLib.c in build directory, not source
+ directory.
+
+ * unix/tk8.0/Makefile.in (TIX_LIBRARY): Change lib to share.
+
+ * generic/tixImgCmp.c (ImgCmpCreate): Take Tcl objects, rather
+ than strings, to match patch made to Tk.
+
+Tue Sep 23 16:02:04 1997 Michael Meissner <meissner@cygnus.com>
+
+ * unix/tk8.0/configure.in: Disable broken code to automatically
+ rerun configure if config.cache was run on a different system.
+
+Tue Aug 26 15:30:11 1997 Tom Tromey <tromey@cygnus.com>
+
+ * unix/Makefile.in (install-binaries): Write "fi;" for bash.
+
+Mon Aug 25 03:41:57 1997 Martin M. Hunt <hunt@pern.cygnus.com>
+
+ * library/pref/TkWin.fs: Set fixed_font to "fixedsys" so
+ TK can understand it. DO NOT USE SystemFixed!
+
+Sun Aug 24 21:42:40 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/Makefile.in ($(TIXDLL)): Set base address to 0x66600000.
+
+Sat Aug 23 20:14:45 1997 Tom Tromey <tromey@cygnus.com>
+
+ * library/pref/TkWin.cs (tixSetScheme-color): Set input1_bg to
+ SystemWindow.
+ (tixSetScheme-mono): Set input1_bg to white.
+ * library/pref/TkWin.csc: Rebuilt.
+
+Sat Aug 23 17:43:21 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * library/pref/TkWin.fs (tixSetFontset): Set fixed_font to
+ "systemfixed".
+ * library/pref/TkWin.fsc: Rebuild.
+
+Sat Aug 23 14:00:17 1997 Tom Tromey <tromey@cygnus.com>
+
+ * library/ComboBox.tcl (tixComboBox:config-state): Correctly set
+ -selectforeground and -selectbackground on listbox and entry.
+
+ * library/pref/tixmkpref (tixInitOptionDatabase): Changed argument
+ to `isWin'; use it.
+ * library/pref/TkWin.csc, library/pref/TkWin.fsc: Rebuilt.
+
+Fri Aug 22 23:50:07 1997 Martin M. Hunt <hunt@pern.cygnus.com>
+
+ * library/ComboBox.tcl (tixComboBox:Popup): Workaround to
+ fix problem where ComboBox popups are drawn in the wrong
+ place under NT.
+
+Fri Aug 22 12:23:56 1997 Tom Tromey <tromey@cygnus.com>
+
+ * generic/tixInit.c (TIX_DEF_SCHEME): Define as "TkWin" on Windows.
+ (TIX_DEF_FONTSET): Likewise.
+ * library/SText.tcl: Reverted earlier change.
+ * library/NoteBook.tcl: Reverted most of change of Aug 20;
+ inactive background on nbframe still unset.
+ * library/pref/TkWin.cs: New file.
+ * library/pref/TkWin.csc: New file.
+ * library/pref/TkWin.fsc: New file.
+ * library/pref/TkWin.fs: New file.
+ * library/pref/tixmkpref (tixInitOptionDatabase): Fixed typos.
+
+ * library/SText.tcl: Don't set colors by default.
+
+ * generic/tixInit.c (TIX_DEF_FONTSET): Default to "TK".
+ (TIX_DEF_SCHEME): Likewise.
+
+ * library/Tix.tcl (tixAppContext:config-fontset): Set fontset.
+ Reverts change of Aug 18.
+ (tixAppContext:config-scheme): Likewise.
+
+Wed Aug 20 12:00:04 1997 Tom Tromey <tromey@sanguine.cygnus.com>
+
+ * library/NoteBook.tcl (tixNoteBook): Don't define default colors
+ or fonts.
+
+ * generic/tixDef.h (DEF_NOTEBOOKFRAME_INACTIVE_BG_COLOR): Define
+ as NORMAL_BG.
+ (DEF_NOTEBOOKFRAME_ACTIVE_BG_MONO): Define as WHITE.
+
+ * unix/tk8.0/Makefile.in (RUN_TCLSH): Find tclsh directly in
+ TCL_BIN_DIR.
+ (tixUnixSam.o): Pass -I. to compile.
+
+ * unix/tk8.0/configure: Rebuilt.
+ * unix/tk8.0/configure.in: Removed space in "not supported".
+
+Mon Aug 18 12:37:47 1997 Tom Tromey <tromey@sanguine.cygnus.com>
+
+ * generic/tixGrid.h (DEF_GRID_FONT): Use Tk default font.
+ * generic/tixDiText.c (DEF_TEXTSTYLE_FONT): Use Tk default font.
+ * generic/tixDiITxt.c (DEF_IMAGETEXTSTYLE_FONT): Use Tk default
+ font.
+ * generic/tixDef.h (DEF_CMPIMAGE_FONT): Use Tk default font.
+ (DEF_HLIST_FONT): Likewise.
+ (DEF_NOTEBOOKFRAME_FONT): Likewise.
+ (DEF_TLIST_FONT): Likewise.
+ (CTL_FONT): Define if not deifned by default.h.
+
+Mon Aug 18 01:11:23 1997 Tom Tromey <tromey@sanguine.cygnus.com>
+
+ * library/Tix.tcl (tixAppContext:CheckFontSets): Fonts never fail
+ on any Tk 8 platform.
+ (tixAppContext:config-fontset): Don't override Tk's defaults.
+ (tixAppContext:config-scheme): Likewise.
+
+Fri Aug 15 20:02:29 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * library/fs.tcl (tixFSIsNorm) [Windows version]: Handle UNC
+ (\\host\directory) paths.
+ (tixFSIsAbsPath) [Windows version]: Likewise.
+ (_tixNormalize) [Windows version]: Likewise.
+ (tixFSIsVPath) [Windows version]: Likewise.
+
+ * unix/tk8.0/Makefile.in (tixUnixSam.o): Depend upon tixSamLib.c,
+ not $(UNIX_DIR)/tixSamLib.c.
+ (tixSamLib.c): Build in build directory, not source directory.
+ (sam_clean): Remove tixSamLib.c in build directory, not source
+ directory.
+
+Thu Aug 14 13:19:07 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * unix/tk8.0/Makefile.in (TIX_LIBRARY): Change lib to share.
+
+Wed Aug 13 16:29:33 1997 Tom Tromey <tromey@sanguine.cygnus.com>
+
+ * generic/tixInit.c (Tix_Init_Internal): Turn off xpm handling.
+
+Fri Aug 8 15:16:46 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * unix/Makefile.in (TIX_LIBRARY): Change lib to share.
+ * win/Makefile.in (TIX_LIBRARY): Likewise.
+
+ * win/Makefile.in: Add TCL_VER == 8.0 cases for the various name
+ definitions.
+
+Wed Aug 6 16:56:37 1997 Tom Tromey <tromey@cygnus.com>
+
+ * unix/tk8.0/Makefile.in (VPATH, srcdir): Define.
+ (TCL_BIN_DIR): Define.
+ (RUN_TCLSH): Use $(TCL_BIN_DIR), not $(TCL_SRC_DIR).
+ (tixAppInit.o): Get tixAppInit.c from $(srcdir).
+ (Makefile): Depend upon config.status.
+
+ * unix/tk8.0/configure.in: Look in plain tcl for TCL_SRC_DIR.
+ Look in plain tk for TK_SRC_DIR. Set TCL_BIN_DIR to object
+ directory, not using $(TCL_SRC_DIR). Likewise for TK_BIN_DIR.
+ Set TIX_SRC_DIR based on ${srcdir}.
+
+Fri Aug 1 13:48:18 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/Makefile.in: Copy install handling from unix/Makefile.in.
+ * win/configure.in: Don't create the subdirectory if it exists.
+ Define and substitute SRC_DIR and TIX_VERSION.
+ * win/configure: Rebuild.
+
+ * win/Makefile.in (TIXDLLNAME): Define, in several variants.
+ ($(TIXDLL)): Build into $(TIXDLLNAME), and then copy.
+ ($(TIXLIB)): Use $(TIXDLLNAME) as the DLL name.
+ (clean): Remove $(TIXDLLNAME).
+
+Thu Jul 17 21:49:03 1997 Geoffrey Noer <noer@cygnus.com>
+
+ * win/Makefile.in: add install install-info info installcheck rules
+
+Mon Jun 30 15:44:10 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/configure.in, win/Makefile.in: New files.
+ * win/configure: Build.
+ * generic/tix.h: If RC_INVOKED, just define a few macros.
+ * win/tixWCmpt.c (_impure_ptr, __imp_reent_data): Declare.
+ (DllMain): Initialize _impure_ptr.
+
+ * unix/tk4.2/Makefile.in (VPATH, srcdir): Define.
+ (TCL_BIN_DIR): Define.
+ (RUN_TCLSH): Use $(TCL_BIN_DIR), not $(TCL_SRC_DIR).
+ (tixAppInit.o): Get tixAppInit.c from $(srcdir).
+ (Makefile): Depend upon config.status.
+ (config.status): New target.
+ * unix/tk4.2/configure.in: Look in plain tcl for TCL_SRC_DIR.
+ Look in plain tk for TK_SRC_DIR. Set TCL_BIN_DIR to object
+ directory, not using $(TCL_SRC_DIR). Likewise for TK_BIN_DIR.
+ Set TIX_SRC_DIR based on ${srcdir}.
+
+ * unix/Makefile.in: Define standard targets.
+ (VPATH): Set to @SRC_DIR@/unix, not just @SRC_DIR@.
+ (SUBDIR): Define.
+ (Makefile): Depend upon config.status.
+ * unix/configure.in: Set SRC_DIR to `${srcdir}/..', not `..'.
+ Define and substitute SUBDIR. Call AC_CONFIG_SUBDIRS.
+ * unix/configure: Rebuild.
+
+ * configure.in, Makefile.in: New files.
+ * configure: Build.
+
+ * ChangeLog: New file for Cygnus changes.
diff --git a/tix/Makefile.in b/tix/Makefile.in
new file mode 100644
index 00000000000..f332805e0f7
--- /dev/null
+++ b/tix/Makefile.in
@@ -0,0 +1,46 @@
+# This entire file is CYGNUS LOCAL.
+# Minimal top-level Makefile. Just pass everything to the $(CONFIGDIR)
+# subdir.
+# From tcl/Makefile.in, by Tom Tromey <tromey@cygnus.com>
+
+CONFIGDIR=@CONFIGDIR@
+
+VPATH = @srcdir@
+SHELL = @SHELL@
+SRC_DIR = @srcdir@
+
+CFLAGS = @CFLAGS@
+
+@SET_MAKE@
+
+all install test install-binaries install-libraries install-minimal:
+ @cd $(CONFIGDIR) && $(MAKE) $@
+
+mostlyclean-recursive clean-recursive distclean-recursive \
+maintainer-clean-recursive:
+ @cd $(CONFIGDIR) && $(MAKE) `echo $@ | sed 's/-recursive//'`
+
+configure:
+ cd $(SRC_DIR) && autoconf
+
+mostlyclean: mostlyclean-recursive
+
+clean: clean-recursive
+
+distclean-local:
+ rm -f Makefile config.status config.cache config.log
+
+distclean: distclean-recursive distclean-local
+
+maintainer-clean: distclean-local maintainer-clean-recursive
+
+check:
+ cd $(CONFIGDIR) && $(MAKE) tests
+
+install-info info installcheck:
+
+Makefile: Makefile.in config.status
+ CONFIG_FILES=Makefile CONFIG_HEADERS= $(SHELL) ./config.status
+
+config.status: configure
+ $(SHELL) config.status --recheck
diff --git a/tix/README.html b/tix/README.html
new file mode 100644
index 00000000000..edb555210bb
--- /dev/null
+++ b/tix/README.html
@@ -0,0 +1,59 @@
+<TITLE>Tix Documentation Master Index</TITLE>
+<Center><H1>Tix Documentation Master Index</H1></Center>
+
+ This file is the master index of all the documentation included in
+ this package. For additional information about Tix, please visit the
+ Tix Home Page at <a href="http://www.xpi.com/tix/">
+ http://www.xpi.com/tix/ </a>.<p>
+
+ The documentation in this package is available in both HTML and
+ plain text formats.
+
+<ul>
+
+ <li> <tixtext ABOUT.txt:> <a href="ABOUT.html">A brief descriptions
+ of Tix</a>. <p>
+
+ <li> <tixtext docs/Release.txt:> <a href="docs/Release.html"> Release
+ notes on this version of Tix</a>.<p>
+
+ <li> <tixtext docs/Install.txt:> <a href="docs/Install.html">
+ Compiling and installing Tix </a>.<p>
+
+ <li> Programming with Tix:
+ <ul>
+ <li> <a href="http://www.xpi.com/tix/doc/tix-4.0/tix.book.html">
+ Tix Programmer's Guide</a>.
+ <li> <a href="docs/Pkg.txt">Loading Tix with the
+ "package require" command</a>.
+ <li> <a href="docs/SAModule.txt">
+ Using Tix Stand Alone Modules (SAM)</a>.
+ </ul>
+ <p>
+
+ <li> <tixtext docs/FAQ.txt:> <a href="docs/FAQ.html">The Tix
+ Frequent Asked Questions</a>.<p>
+
+ <li> <tixtext docs/Changes.txt:> <a href="docs/Changes.html">
+ Changes made to Tix since the previous release</a>. <p>
+
+ <li> <tixtext tools/README.txt:> <a href="tools/README.html"> Useful
+ development tools included in this package</a>. <p>
+
+ <li> <tixtext man/index.html:> <a href="man/index.html">
+ Programmer's Reference Manual</a>. <p>
+
+ <li> <tixtext docs/Porting.txt:> <a href="docs/Porting.html">
+ Information about porting Tix to various platforms </a>. <p>
+
+ <li> <tixtext docs/ET.txt:> <a href="docs/ET.txt"> Documentation
+ about Embedded TK (ET) by Richard Hipp. </a> ET provides an easy way
+ to compile your Tcl script and C source code into a single
+ executable binary. <p>
+
+</ul>
+
+
+<!Serial 851729139>
+<hr><i>Last modified Sat Feb 15 13:36:14 EST 1997 </i> ---
+<i>Serial 856069647</i>
diff --git a/tix/README.txt b/tix/README.txt
new file mode 100644
index 00000000000..860d896b630
--- /dev/null
+++ b/tix/README.txt
@@ -0,0 +1,39 @@
+
+ TIX DOCUMENTATION MASTER INDEX
+
+ This file is the master index of all the documentation included in
+ this package. For additional information about Tix, please visit the
+ Tix Home Page at http://www.xpi.com/tix/ .
+
+ The documentation in this package is available in both HTML and plain
+ text formats.
+ * A brief descriptions of Tix.
+
+ * Release notes on this version of Tix.
+
+ * Compiling and installing Tix .
+
+ * Programming with Tix:
+ + Tix Programmer's Guide.
+ + Loading Tix with the "package require" command.
+ + Using Tix Stand Alone Modules (SAM).
+
+
+ * The Tix Frequent Asked Questions.
+
+ * Changes made to Tix since the previous release.
+
+ * Useful development tools included in this package.
+
+ * Programmer's Reference Manual.
+
+ * Information about porting Tix to various platforms .
+
+ * Documentation about Embedded TK (ET) by Richard Hipp. ET provides
+ an easy way to compile your Tcl script and C source code into a
+ single executable binary.
+
+
+ _________________________________________________________________
+
+ Last modified Sat Feb 15 13:36:14 EST 1997 --- Serial 856069647
diff --git a/tix/Version b/tix/Version
new file mode 100644
index 00000000000..5f278dc88e7
--- /dev/null
+++ b/tix/Version
@@ -0,0 +1,2 @@
+tix_version=4.1
+tix_patchLevel=4.1.0
diff --git a/tix/configure b/tix/configure
new file mode 100755
index 00000000000..f40e582fcf2
--- /dev/null
+++ b/tix/configure
@@ -0,0 +1,960 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.13"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=generic/tix.h
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+ac_aux_dir=
+for ac_dir in .. $srcdir/..; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in .. $srcdir/.." 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+
+# Make sure we can run config.sub.
+if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then :
+else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking host system type""... $ac_c" 1>&6
+echo "configure:551: checking host system type" >&5
+
+host_alias=$host
+case "$host_alias" in
+NONE)
+ case $nonopt in
+ NONE)
+ if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then :
+ else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; }
+ fi ;;
+ *) host_alias=$nonopt ;;
+ esac ;;
+esac
+
+host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias`
+host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+echo "$ac_t""$host" 1>&6
+
+
+case "${host}" in
+*-*-cygwin*)
+ CONFIGDIR="win" ;;
+*)
+ CONFIGDIR="unix" ;;
+esac
+
+
+echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6
+echo "configure:581: checking whether ${MAKE-make} sets \${MAKE}" >&5
+set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftestmake <<\EOF
+all:
+ @echo 'ac_maketemp="${MAKE}"'
+EOF
+# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=`
+if test -n "$ac_maketemp"; then
+ eval ac_cv_prog_make_${ac_make}_set=yes
+else
+ eval ac_cv_prog_make_${ac_make}_set=no
+fi
+rm -f conftestmake
+fi
+if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ SET_MAKE=
+else
+ echo "$ac_t""no" 1>&6
+ SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+
+subdirs="$CONFIGDIR"
+
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set) 2>&1 | grep ac_space` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.13"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+
+trap 'rm -fr `echo "Makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@host@%$host%g
+s%@host_alias@%$host_alias%g
+s%@host_cpu@%$host_cpu%g
+s%@host_vendor@%$host_vendor%g
+s%@host_os@%$host_os%g
+s%@CONFIGDIR@%$CONFIGDIR%g
+s%@SET_MAKE@%$SET_MAKE%g
+s%@subdirs@%$subdirs%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
+if test "$no_recursion" != yes; then
+
+ # Remove --cache-file and --srcdir arguments so they do not pile up.
+ ac_sub_configure_args=
+ ac_prev=
+ for ac_arg in $ac_configure_args; do
+ if test -n "$ac_prev"; then
+ ac_prev=
+ continue
+ fi
+ case "$ac_arg" in
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ ;;
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ ;;
+ *) ac_sub_configure_args="$ac_sub_configure_args $ac_arg" ;;
+ esac
+ done
+
+ for ac_config_dir in $CONFIGDIR; do
+
+ # Do not complain, so a configure script can configure whichever
+ # parts of a large source tree are present.
+ if test ! -d $srcdir/$ac_config_dir; then
+ continue
+ fi
+
+ echo configuring in $ac_config_dir
+
+ case "$srcdir" in
+ .) ;;
+ *)
+ if test -d ./$ac_config_dir || mkdir ./$ac_config_dir; then :;
+ else
+ { echo "configure: error: can not create `pwd`/$ac_config_dir" 1>&2; exit 1; }
+ fi
+ ;;
+ esac
+
+ ac_popdir=`pwd`
+ cd $ac_config_dir
+
+ # A "../" for each directory in /$ac_config_dir.
+ ac_dots=`echo $ac_config_dir|sed -e 's%^\./%%' -e 's%[^/]$%&/%' -e 's%[^/]*/%../%g'`
+
+ case "$srcdir" in
+ .) # No --srcdir option. We are building in place.
+ ac_sub_srcdir=$srcdir ;;
+ /*) # Absolute path.
+ ac_sub_srcdir=$srcdir/$ac_config_dir ;;
+ *) # Relative path.
+ ac_sub_srcdir=$ac_dots$srcdir/$ac_config_dir ;;
+ esac
+
+ # Check for guested configure; otherwise get Cygnus style configure.
+ if test -f $ac_sub_srcdir/configure; then
+ ac_sub_configure=$ac_sub_srcdir/configure
+ elif test -f $ac_sub_srcdir/configure.in; then
+ ac_sub_configure=$ac_configure
+ else
+ echo "configure: warning: no configuration information is in $ac_config_dir" 1>&2
+ ac_sub_configure=
+ fi
+
+ # The recursion is here.
+ if test -n "$ac_sub_configure"; then
+
+ # Make the cache file name correct relative to the subdirectory.
+ case "$cache_file" in
+ /*) ac_sub_cache_file=$cache_file ;;
+ *) # Relative path.
+ ac_sub_cache_file="$ac_dots$cache_file" ;;
+ esac
+
+ echo "running ${CONFIG_SHELL-/bin/sh} $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_sub_srcdir"
+ # The eval makes quoting arguments work.
+ if eval ${CONFIG_SHELL-/bin/sh} $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_sub_srcdir
+ then :
+ else
+ { echo "configure: error: $ac_sub_configure failed for $ac_config_dir" 1>&2; exit 1; }
+ fi
+ fi
+
+ cd $ac_popdir
+ done
+fi
+
diff --git a/tix/configure.in b/tix/configure.in
new file mode 100644
index 00000000000..a7680a451a2
--- /dev/null
+++ b/tix/configure.in
@@ -0,0 +1,20 @@
+dnl This entire file is CYGNUS LOCAL.
+dnl Tix configure file.
+
+AC_INIT(generic/tix.h)
+AC_CONFIG_AUX_DIR(..)
+AC_CANONICAL_HOST
+
+case "${host}" in
+*-*-cygwin*)
+ CONFIGDIR="win" ;;
+*)
+ CONFIGDIR="unix" ;;
+esac
+AC_SUBST(CONFIGDIR)
+
+AC_PROG_MAKE_SET
+
+AC_CONFIG_SUBDIRS($CONFIGDIR)
+
+AC_OUTPUT(Makefile)
diff --git a/tix/demos/MkChoose.tcl b/tix/demos/MkChoose.tcl
new file mode 100644
index 00000000000..edb8e7a9b95
--- /dev/null
+++ b/tix/demos/MkChoose.tcl
@@ -0,0 +1,279 @@
+# MkChoose.tcl --
+#
+# This file implements the "Choosers" page in the widget demo
+#
+# This file has not been properly documented. It is NOT intended
+# to be used as an introductory demo program about Tix
+# programming. For such demos, please see the files in the
+# demos/samples directory or go to the "Samples" page in the
+# "widget demo"
+#
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+
+proc MkChoosers {nb page} {
+ set w [$nb subwidget $page]
+
+ set name [tixOptionName $w]
+ option add *$name*TixLabelFrame*label.padX 4
+
+ tixLabelFrame $w.til -label "Chooser Widgets"
+ tixLabelFrame $w.cbx -label "tixComboBox"
+ tixLabelFrame $w.ctl -label "tixControl"
+ tixLabelFrame $w.sel -label "tixSelect"
+ tixLabelFrame $w.opt -label "tixOptionMenu"
+ tixLabelFrame $w.fil -label "tixFileEntry"
+ tixLabelFrame $w.fbx -label "tixFileSelectBox"
+ tixLabelFrame $w.tbr -label "Tool Bar"
+
+ MkTitle [$w.til subwidget frame]
+ MkCombo [$w.cbx subwidget frame]
+ MkControl [$w.ctl subwidget frame]
+ MkSelect [$w.sel subwidget frame]
+ MkOptMenu [$w.opt subwidget frame]
+ MkFileBox [$w.fbx subwidget frame]
+ MkFileEnt [$w.fil subwidget frame]
+ MkToolBar [$w.tbr subwidget frame]
+
+ #
+ # First column: comBox and selector
+ tixForm $w.cbx -top 0 -left 0 -right %33
+ tixForm $w.sel -left 0 -right &$w.cbx -top $w.cbx
+ tixForm $w.opt -left 0 -right &$w.cbx -top $w.sel -bottom -1
+
+ #
+ # Second column: title .. etc
+ tixForm $w.til -left $w.cbx -right %66 -top 0
+ tixForm $w.ctl -left $w.cbx -right &$w.til -top $w.til
+ tixForm $w.fil -left $w.cbx -right &$w.til -top $w.ctl
+ tixForm $w.tbr -left $w.cbx -right &$w.til -top $w.fil -bottom -1
+
+ #
+ # Third column: file selection
+ tixForm $w.fbx -left %66 -right -1 -top 0
+}
+
+#----------------------------------------------------------------------
+# ComboBox
+#----------------------------------------------------------------------
+proc MkCombo {w} {
+ set name [tixOptionName $w]
+ option add *$name*TixComboBox*label.width 10
+ option add *$name*TixComboBox*label.anchor e
+ option add *$name*TixComboBox*entry.width 14
+
+ tixComboBox $w.static -label "Static" \
+ -editable false
+ tixComboBox $w.editable -label "Editable" \
+ -editable true
+ tixComboBox $w.history -label "History" \
+ -editable true -history true -anchor e
+
+ $w.static insert end January
+ $w.static insert end February
+ $w.static insert end March
+ $w.static insert end April
+ $w.static insert end May
+ $w.static insert end June
+ $w.static insert end July
+ $w.static insert end August
+ $w.static insert end September
+ $w.static insert end October
+ $w.static insert end November
+ $w.static insert end December
+
+ $w.editable insert end "America"
+ $w.editable insert end "Britain"
+ $w.editable insert end "China"
+ $w.editable insert end "Denmark"
+ $w.editable insert end "Egypt"
+
+ $w.history insert end "/usr/bin/mail"
+ $w.history insert end "/etc/profile"
+ $w.history insert end "/home/d/doe/Mail/letter"
+
+ pack $w.static $w.editable $w.history -side top -padx 5 -pady 3
+}
+
+#----------------------------------------------------------------------
+# The Control widgets
+#----------------------------------------------------------------------
+set states {Alabama "New York" Pennsylvania Washington}
+
+proc stCmd {w by value} {
+ global states
+
+ set index [lsearch $states $value]
+ set len [llength $states]
+ set index [expr $index + $by]
+
+ if {$index < 0} {
+ set index [expr $len -1]
+ }
+ if {$index >= $len} {
+ set index 0
+ }
+
+ return [lindex $states $index]
+}
+
+proc stValidate {w value} {
+ global states
+
+ if {[lsearch $states $value] == -1} {
+ return [lindex $states 0]
+ } else {
+ return $value
+ }
+}
+
+proc MkControl {w} {
+ set name [tixOptionName $w]
+ option add *$name*TixControl*label.width 10
+ option add *$name*TixControl*label.anchor e
+ option add *$name*TixControl*entry.width 13
+
+
+ tixControl $w.simple -label Numbers
+
+ tixControl $w.spintext -label States \
+ -incrcmd "stCmd $w.spintext 1" \
+ -decrcmd "stCmd $w.spintext -1" \
+ -validatecmd "stValidate .d" \
+ -value "Alabama"
+
+ pack $w.simple $w.spintext -side top -padx 5 -pady 3
+}
+
+#----------------------------------------------------------------------
+# The Select Widgets
+#----------------------------------------------------------------------
+proc MkSelect {w} {
+ set name [tixOptionName $w]
+ option add *$name*TixSelect*label.anchor c
+ option add *$name*TixSelect*orientation vertical
+ option add *$name*TixSelect*labelSide top
+
+ tixSelect $w.sel1 -label "Mere Mortals" -allowzero true -radio true
+ tixSelect $w.sel2 -label "Geeks" -allowzero true -radio false
+
+ $w.sel1 add eat -text Eat
+ $w.sel1 add work -text Work
+ $w.sel1 add play -text Play
+ $w.sel1 add party -text Party
+ $w.sel1 add sleep -text Sleep
+
+ $w.sel2 add eat -text Eat
+ $w.sel2 add prog1 -text Program
+ $w.sel2 add prog2 -text Program
+ $w.sel2 add prog3 -text Program
+ $w.sel2 add sleep -text Sleep
+
+ pack $w.sel1 $w.sel2 -side left -padx 5 -pady 3 -fill x
+}
+#----------------------------------------------------------------------
+# The OptMenu Widget
+#----------------------------------------------------------------------
+proc MkOptMenu {w} {
+ set name [tixOptionName $w]
+
+ option add *$name*TixOptionMenu*label.anchor e
+
+ tixOptionMenu $w.menu -label "File Format : " \
+ -options {
+ menubutton.width 15
+ }
+
+ $w.menu add command text -label "Plain Text"
+ $w.menu add command post -label "PostScript"
+ $w.menu add command format -label "Formatted Text"
+ $w.menu add command html -label "HTML"
+ $w.menu add separator sep
+ $w.menu add command tex -label "LaTeX"
+ $w.menu add command rtf -label "Rich Text Format"
+
+ pack $w.menu -padx 5 -pady 3 -fill x
+}
+
+#----------------------------------------------------------------------
+# FileEntry
+#----------------------------------------------------------------------
+proc MkFileEnt {w} {
+ set name [tixOptionName $w]
+
+ message $w.msg -font -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*\
+ -relief flat -width 240 -anchor n\
+ -text {Press the "open file" icon button and a\
+TixFileSelectDialog will popup.}
+
+ tixFileEntry $w.ent -label "Select a file : "
+
+ pack $w.msg -side top -expand yes -fill both -padx 3 -pady 3
+ pack $w.ent -side top -fill x -padx 3 -pady 3
+}
+
+proc MkFileBox {w} {
+ set name [tixOptionName $w]
+
+ message $w.msg -font -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*\
+ -relief flat -width 240 -anchor n\
+ -text {The TixFileSelectBox is Motif-style file selection\
+box with various enhancements. For example, you can adjust the\
+size of the two listboxes and your past selections are recorded.}
+
+ tixFileSelectBox $w.box
+
+ pack $w.msg -side top -expand yes -fill both -padx 3 -pady 3
+ pack $w.box -side top -fill x -padx 3 -pady 3
+}
+
+#----------------------------------------------------------------------
+# Tool Bar
+#----------------------------------------------------------------------
+proc MkToolBar {w} {
+ set name [tixOptionName $w]
+
+ option add $name*TixSelect*frame.borderWidth 1
+ message $w.msg -font -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*\
+ -relief flat -width 240 -anchor n\
+ -text {The Select widget is also good for arranging buttons\
+in a tool bar.}
+
+ frame $w.bar -bd 2 -relief raised
+ tixSelect $w.font -allowzero true -radio false -label {}
+ tixSelect $w.para -allowzero false -radio true -label {}
+
+ $w.font add bold -bitmap [tix getbitmap bold]
+ $w.font add italic -bitmap [tix getbitmap italic]
+ $w.font add underline -bitmap [tix getbitmap underlin]
+ $w.font add capital -bitmap [tix getbitmap capital]
+
+ $w.para add left -bitmap [tix getbitmap leftj]
+ $w.para add right -bitmap [tix getbitmap rightj]
+ $w.para add center -bitmap [tix getbitmap centerj]
+ $w.para add justify -bitmap [tix getbitmap justify]
+
+ pack $w.msg -side top -expand yes -fill both -padx 3 -pady 3
+ pack $w.bar -side top -fill x -padx 3 -pady 3
+ pack $w.para $w.font -in $w.bar -side left -padx 4 -pady 3
+}
+#----------------------------------------------------------------------
+# Title
+#----------------------------------------------------------------------
+proc MkTitle {w} {
+ set name [tixOptionName $w]
+
+ option add $name*TixSelect*frame.borderWidth 1
+ message $w.msg -font -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*\
+ -relief flat -width 240 -anchor n\
+ -text {There are many types of "choose" widgets that allow\
+the user to input different type of information.}
+
+ pack $w.msg -side top -expand yes -fill both -padx 3 -pady 3
+}
diff --git a/tix/demos/MkDirLis.tcl b/tix/demos/MkDirLis.tcl
new file mode 100644
index 00000000000..89b0edae5a7
--- /dev/null
+++ b/tix/demos/MkDirLis.tcl
@@ -0,0 +1,65 @@
+# MkDirLis.tcl --
+#
+# This file implements the "Directory List" page in the widget demo
+#
+# This file has not been properly documented. It is NOT intended
+# to be used as an introductory demo program about Tix
+# programming. For such demos, please see the files in the
+# demos/samples directory or go to the "Samples" page in the
+# "widget demo"
+#
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc MkDirList {nb page} {
+ set w [$nb subwidget $page]
+
+ set name [tixOptionName $w]
+ option add *$name*TixLabelFrame*label.padX 4
+
+ tixLabelFrame $w.dir -label "tixDirList"
+ tixLabelFrame $w.fsbox -label "tixExFileSelectBox"
+ MkDirListWidget [$w.dir subwidget frame]
+ MkExFileWidget [$w.fsbox subwidget frame]
+
+ tixForm $w.dir -top 0 -left 0 -right %40 -bottom -1
+ tixForm $w.fsbox -top 0 -left %40 -right -1 -bottom -1
+}
+
+proc MkDirListWidget {w} {
+ set name [tixOptionName $w]
+
+ message $w.msg -font -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*\
+ -relief flat -width 240 -anchor n\
+ -text {The TixDirList widget gives a graphical representation of \
+the file system directory and makes it easy for the user to choose and \
+access directories.}
+
+ tixDirList $w.dirlist -options {
+ hlist.padY 1
+ hlist.width 25
+ hlist.height 16
+ }
+
+ pack $w.msg -side top -expand yes -fill both -padx 3 -pady 3
+ pack $w.dirlist -side top -padx 3 -pady 3
+}
+
+proc MkExFileWidget {w} {
+ set name [tixOptionName $w]
+
+ message $w.msg -font -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*\
+ -relief flat -width 240 -anchor n\
+ -text {The TixExFileSelectBox widget is more user friendly \
+than the Motif style FileSelectBox.}
+
+ tixExFileSelectBox $w.exfsbox -bd 2 -relief raised
+
+ pack $w.msg -side top -expand yes -fill both -padx 3 -pady 3
+ pack $w.exfsbox -side top -padx 3 -pady 3
+}
+
diff --git a/tix/demos/MkManag.tcl b/tix/demos/MkManag.tcl
new file mode 100644
index 00000000000..045aacbdebc
--- /dev/null
+++ b/tix/demos/MkManag.tcl
@@ -0,0 +1,171 @@
+# MkManag.tcl --
+#
+# This file implements the "Manager" page in the widget demo
+#
+# This file has not been properly documented. It is NOT intended
+# to be used as an introductory demo program about Tix
+# programming. For such demos, please see the files in the
+# demos/samples directory or go to the "Samples" page in the
+# "widget demo"
+#
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc MkManager {nb page} {
+ set w [$nb subwidget $page]
+
+ set name [tixOptionName $w]
+ option add *$name*TixLabelFrame*label.padX 4
+
+ tixLabelFrame $w.pane -label "tixPanedWindow"
+ tixLabelFrame $w.note -label "tixNoteBook"
+
+ MkPanedWindow [$w.pane subwidget frame]
+ MkNoteBook [$w.note subwidget frame]
+
+ tixForm $w.pane -top 0 -left 0 -right $w.note -bottom -1
+ tixForm $w.note -top 0 -right -1 -bottom -1
+}
+
+proc MkPanedWindow {w} {
+ set name [tixOptionName $w]
+
+ message $w.msg -font -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*\
+ -relief flat -width 240 -anchor n\
+ -text {The PanedWindow widget allows the user to interactively\
+manipulate the\
+sizes of several panes. The panes can be arranged either vertically or\
+horizontally.}
+
+ label $w.group -text "Newsgroup: comp.lang.tcl"
+
+ tixPanedWindow $w.pane
+
+ set p1 [$w.pane add list -min 70 -size 100]
+ set p2 [$w.pane add text -min 70]
+
+ tixScrolledListBox $p1.list
+ $p1.list subwidget listbox config -font [tix option get fixed_font]
+
+ tixScrolledText $p2.text
+ $p2.text subwidget text config -font [tix option get fixed_font]
+
+ $p1.list subwidget listbox insert end \
+ " 12324 Re: TK is good for your health" \
+ "+ 12325 Re: TK is good for your health" \
+ "+ 12326 Re: Tix is even better for your health (Was: TK is good...)" \
+ " 12327 Re: Tix is even better for your health (Was: TK is good...)" \
+ "+ 12328 Re: Tix is even better for your health (Was: TK is good...)" \
+ " 12329 Re: Tix is even better for your health (Was: TK is good...)" \
+ "+ 12330 Re: Tix is even better for your health (Was: TK is good...)"
+
+ $p2.text subwidget text config -wrap none -bg \
+ [$p1.list subwidget listbox cget -bg]
+ $p2.text subwidget text insert end {
+Mon, 19 Jun 1995 11:39:52 comp.lang.tcl Thread 34 of 220
+Lines 353 A new way to put text and bitmaps together iNo responses
+ioi@xpi.com Ioi K. Lam at Expert Interface Technologies
+
+Hi,
+
+I have implemented a new image type called "compound". It allows you
+to glue together a bunch of bitmaps, images and text strings together
+to form a bigger image. Then you can use this image with widgets that
+support the -image option. This way you can display very fancy stuffs
+in your GUI. For example, you can display a text string string
+together with a bitmap, at the same time, inside a TK button widget. A
+screenshot of compound images can be found at the bottom of this page:
+
+ http://www.xpi.com/tix/screenshot.html
+
+You can also you is in other places such as putting fancy bitmap+text
+in menus, tabs of tixNoteBook widgets, etc. This feature will be
+included in the next release of Tix (4.0b1). Count on it to make jazzy
+interfaces!}
+
+ pack $p1.list -expand yes -fill both -padx 4 -pady 6
+ pack $p2.text -expand yes -fill both -padx 4 -pady 6
+
+ pack $w.msg -side top -padx 3 -pady 3 -fill both
+ pack $w.group -side top -padx 3 -pady 3 -fill both
+ pack $w.pane -side top -padx 3 -pady 3 -expand yes -fill both
+}
+
+proc MkNoteBook {w} {
+
+ message $w.msg -font -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*\
+ -relief flat -width 240 -anchor n\
+ -text {The NoteBook widget allows you to lay out a complex\
+interface into individual pages.}
+
+ # We use these options to set the sizes of the subwidgets inside the
+ # notebook, so that they are well-aligned on the screen.
+ #
+ set name [tixOptionName $w]
+ option add *$name*TixControl*entry.width 10
+ option add *$name*TixControl*label.width 18
+ option add *$name*TixControl*label.anchor e
+ option add *$name*TixNoteBook*tagPadX 8
+
+
+ tixNoteBook $w.nb -ipadx 6 -ipady 6
+
+ # Create the two tabs on the notebook. The -underline option
+ # puts a underline on the first character of the labels of the tabs.
+ # Keyboard accelerators will be defined automatically according
+ # to the underlined character.
+ #
+ $w.nb add hard_disk -label "Hard Disk" -underline 8
+ $w.nb add network -label "Network" -underline 0
+
+ # Create the first page
+ #
+ set f [$w.nb subwidget hard_disk]
+
+ # the frame for the buttons that are present in all the pages
+ #
+ frame $f.common
+ pack $f.common -side right -padx 2 -pady 2 -fill y
+ CreateCommonButtons $w $f.common
+
+
+ # Create the controls that only belong to this page
+ #
+ tixControl $f.a -value 12 -label "Access Time: "
+ tixControl $f.w -value 400 -label "Write Throughput: "
+ tixControl $f.r -value 400 -label "Read Throughput: "
+ tixControl $f.c -value 1021 -label "Capacity: "
+ pack $f.a $f.w $f.r $f.c -side top -padx 20 -pady 2
+
+ # Create the second page
+ #
+ set f [$w.nb subwidget network]
+
+ # the frame for the buttons that are present in all the pages
+ #
+ frame $f.common
+ pack $f.common -side right -padx 2 -pady 2 -fill y
+
+ tixControl $f.a -value 12 -label "Access Time: "
+ tixControl $f.w -value 400 -label "Write Throughput: "
+ tixControl $f.r -value 400 -label "Read Throughput: "
+ tixControl $f.c -value 1021 -label "Capacity: "
+ tixControl $f.u -value 10 -label "Users: "
+
+ CreateCommonButtons $w $f.common
+
+ pack $f.a $f.w $f.r $f.c $f.u -side top -padx 20 -pady 2
+ pack $w.msg -side top -padx 3 -pady 3 -fill both
+ pack $w.nb -expand yes -fill both -padx 5 -pady 5 -side top
+ }
+
+proc CreateCommonButtons {w f} {
+ button $f.ok -text OK -width 6
+ button $f.cancel -text Cancel -width 6
+
+ pack $f.ok $f.cancel -side top -padx 2 -pady 2
+}
diff --git a/tix/demos/MkSample.tcl b/tix/demos/MkSample.tcl
new file mode 100644
index 00000000000..20ca11753db
--- /dev/null
+++ b/tix/demos/MkSample.tcl
@@ -0,0 +1,269 @@
+# MkSample.tcl --
+#
+# This file implements the "Sample" page in the widget demo
+#
+# This file has not been properly documented. It is NOT intended
+# to be used as an introductory demo program about Tix
+# programming. For such demos, please see the files in the
+# demos/samples directory or go to the "Samples" page in the
+# "widget demo"
+#
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+#
+#
+
+set tix_demo_running 1
+set samples_dir [tixNSubFolder $demo_dir samples]
+set sample_filename {}
+
+uplevel #0 source [list [tixNSubFolder $samples_dir AllSampl.tcl]]
+
+
+proc MkSample {nb page} {
+ global tixOption
+
+ #----------------------------------------------------------------------
+ set w [$nb subwidget $page]
+
+ set pane [tixPanedWindow $w.pane -orient horizontal]
+ pack $pane -expand yes -fill both
+
+ set f1 [$pane add 1 -expand 1]
+ set f2 [$pane add 2 -expand 3]
+ $f1 config -relief flat
+ $f2 config -relief flat
+
+ # Left pane: the Tree:
+ #
+ set lab [label $f1.lab -text "Select a sample program:" -anchor w]
+ set tree [tixTree $f1.slb \
+ -options {
+ hlist.selectMode single
+ hlist.width 40
+ }]
+ $tree config \
+ -command "Sample:Action $w $tree run" \
+ -browsecmd "Sample:Action $w $tree browse"
+
+ pack $lab -side top -fill x -padx 5 -pady 5
+ pack $tree -side top -fill both -expand yes -padx 5
+
+ # Right pane: the Text
+ #
+ set labe [tixLabelEntry $f2.lab -label "Source:" -options {
+ label.anchor w
+ }]
+
+ $labe subwidget entry config -state disabled
+
+ set stext [tixScrolledText $f2.stext]
+ set f3 [frame $f2.f3]
+
+ set run [button $f3.run -text "Run ..." \
+ -command "Sample:Action $w $tree run"]
+ set view [button $f3.view -text "View Source in Browser ..." \
+ -command "Sample:Action $w $tree view"]
+
+ pack $run $view -side left -fill y -pady 2
+
+ pack $labe -side top -fill x -padx 7 -pady 2
+ pack $f3 -side bottom -fill x -padx 7
+ pack $stext -side top -fill both -expand yes -padx 7
+
+ #
+ # Set up the text subwidget
+
+ set text [$stext subwidget text]
+ bind $text <1> "focus %W"
+ bind $text <Up> "%W yview scroll -1 unit"
+ bind $text <Down> "%W yview scroll 1 unit"
+ bind $text <Left> "%W xview scroll -1 unit"
+ bind $text <Right> "%W xview scroll 1 unit"
+ bind $text <Tab> {focus [tk_focusNext %W]; break}
+
+ bindtags $text "$text Text [winfo toplevel $text] all"
+
+ $text config -bg [$tree subwidget hlist cget -bg] \
+ -state disabled -font $tixOption(fixed_font) -wrap none
+
+ $run config -state disabled
+ $view config -state disabled
+
+ global demo
+ set demo(w:run) $run
+ set demo(w:view) $view
+ set demo(w:tree) $tree
+ set demo(w:lab1) $labe
+ set demo(w:stext) $stext
+
+ set hlist [$tree subwidget hlist]
+ $hlist config -separator "." -width 30 -drawbranch 0 \
+ -wideselect false
+
+ set style [tixDisplayStyle imagetext -refwindow $hlist \
+ -fg #202060 -padx 4]
+
+ uplevel #0 set TRANSPARENT_GIF_COLOR [$hlist cget -bg]
+
+ set file [tix getimage textfile]
+ set folder [tix getimage openfold]
+
+ ForAllSamples root "" \
+ [list AddSampleToHList $tree $hlist $style $file $folder]
+}
+
+# AddSampleToHList --
+#
+# A callback from ForAllSamples. Add all the possible sample files
+# into the Tree widget.
+#
+proc AddSampleToHList {tree hlist style file folder token type text dest} {
+ case $type {
+ d {
+ return [$hlist addchild $token -itemtype imagetext -style $style \
+ -image $folder -text $text]
+ }
+ done {
+ if {![tixStrEq $token ""]} {
+ $tree setmode $token close
+ $tree close $token
+ }
+ }
+ f {
+ return [$hlist addchild $token -itemtype imagetext \
+ -image $file -text $text -data [list $text $dest]]
+ }
+ }
+}
+
+proc Sample:Action {w slb action args} {
+ global samples demo_dir demo samples_dir
+
+ set hlist [$slb subwidget hlist]
+ set ent [$hlist info anchor]
+
+ if {$ent == ""} {
+ $demo(w:run) config -state disabled
+ $demo(w:view) config -state disabled
+ return
+ }
+ if {[$hlist info data $ent] == {}} {
+ # This is just a comment
+ $demo(w:run) config -state disabled
+ $demo(w:view) config -state disabled
+ return
+ } else {
+ $demo(w:run) config -state normal
+ $demo(w:view) config -state normal
+ }
+
+ set theSample [$hlist info data $ent]
+ set title [lindex $theSample 0]
+ set prog [lindex $theSample 1]
+
+ case $action {
+ "run" {
+ RunProg $title $prog
+ }
+ "view" {
+ LoadFile [tixNSubFolder $samples_dir $prog]
+ }
+ "browse" {
+ # Bring up a short description of the sample program
+ # in the scrolled text about
+
+ set text [$demo(w:stext) subwidget text]
+ uplevel #0 set sample_filename [list [tixNSubFolder $samples_dir $prog]]
+ tixWidgetDoWhenIdle ReadFileWhenIdle $text
+
+ $demo(w:lab1) subwidget entry config -state normal
+ $demo(w:lab1) subwidget entry delete 0 end
+ $demo(w:lab1) subwidget entry insert end [tixNSubFolder $samples_dir $prog]
+ $demo(w:lab1) subwidget entry xview end
+ $demo(w:lab1) subwidget entry config -state disabled
+ }
+ }
+}
+
+proc RunProg {title prog} {
+ global samples demo_dir demo samples_dir
+
+ set w .[lindex [split $prog .] 0]
+ set w [string tolower $w]
+
+ if [winfo exists $w] {
+ wm deiconify $w
+ raise $w
+ return
+ }
+
+ uplevel #0 source [list [tixNSubFolder $samples_dir $prog]]
+
+ toplevel $w
+ wm title $w $title
+ RunSample $w
+}
+
+
+proc LoadFile {filename} {
+ global tixOption
+
+ set tmp $filename
+ regsub -all . $filename _ tmp
+ set w [string tolower .$tmp]
+
+ if [winfo exists $w] {
+ wm deiconify $w
+ raise $w
+ return
+ }
+
+ toplevel $w
+ wm title $w "Source View: $filename"
+
+ button $w.b -text Close -command "destroy $w"
+ set t [tixScrolledText $w.text]
+ tixForm $w.b -left 0 -bottom -0 -padx 4 -pady 4
+ tixForm $w.text -left 0 -right -0 -top 0 -bottom $w.b
+
+ $t subwidget text config -highlightcolor [$t cget -bg] -bd 2 \
+ -bg [$t cget -bg] -font $tixOption(fixed_font)
+ if {$filename == {}} {
+ return
+ }
+
+ set text [$w.text subwidget text]
+ $text config -wrap none
+
+ ReadFile $text $filename
+}
+
+proc ReadFileWhenIdle {text} {
+ global sample_filename
+
+ if ![file isdir $sample_filename] {
+ ReadFile $text $sample_filename
+ }
+}
+
+proc ReadFile {text filename} {
+ set oldState [$text cget -state]
+ $text config -state normal
+ $text delete 0.0 end
+
+ set fd [open $filename {RDONLY}]
+ $text delete 1.0 end
+
+ while {![eof $fd]} {
+ $text insert end [gets $fd]\n
+ }
+ close $fd
+
+ $text see 1.0
+ $text config -state $oldState
+}
diff --git a/tix/demos/MkScroll.tcl b/tix/demos/MkScroll.tcl
new file mode 100644
index 00000000000..cd4850cee34
--- /dev/null
+++ b/tix/demos/MkScroll.tcl
@@ -0,0 +1,156 @@
+# MkScroll.tcl --
+#
+# This file implements the "Scrolled Widgets" page in the widget demo
+#
+# This file has not been properly documented. It is NOT intended
+# to be used as an introductory demo program about Tix
+# programming. For such demos, please see the files in the
+# demos/samples directory or go to the "Samples" page in the
+# "widget demo"
+#
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc MkScroll {nb page} {
+ set w [$nb subwidget $page]
+
+ set name [tixOptionName $w]
+ option add *$name*TixLabelFrame*label.padX 4
+
+ tixLabelFrame $w.sls -label "tixScrolledListBox"
+ tixLabelFrame $w.swn -label "tixScrolledWindow"
+ tixLabelFrame $w.stx -label "tixScrolledText"
+ MkSList [$w.sls subwidget frame]
+
+ MkSText [$w.stx subwidget frame]
+ MkSWindow [$w.swn subwidget frame]
+
+ tixForm $w.sls -top 0 -left 0 -right %33 -bottom -1
+ tixForm $w.swn -top 0 -left $w.sls -right %66 -bottom -1
+ tixForm $w.stx -top 0 -left $w.swn -right -1 -bottom -1
+}
+
+#----------------------------------------------------------------------
+# ScrolledListBox
+#----------------------------------------------------------------------
+proc MkSList {w} {
+ frame $w.top -width 300 -height 330
+ frame $w.bot
+
+ message $w.top.msg -font -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*\
+ -relief flat -width 200 -anchor n\
+ -text {This TixScrolledListBox is configured so that it uses\
+scrollbars only when it is necessary. Use the handles to\
+resize the listbox and watch the scrollbars automatically\
+appear and disappear.}
+
+ set list [tixScrolledListBox $w.top.list -scrollbar auto]
+ place $list -x 50 -y 150 -width 120 -height 80
+ $list subwidget listbox insert end Alabama
+ $list subwidget listbox insert end California
+ $list subwidget listbox insert end Montana
+ $list subwidget listbox insert end "New Jersy"
+ $list subwidget listbox insert end "New York"
+ $list subwidget listbox insert end Pennsylvania
+ $list subwidget listbox insert end Washington
+
+ set rh [tixResizeHandle $w.top.r -bg #202060 -relief raised \
+ -handlesize 8 -gridded true -minwidth 50 -minheight 30]
+
+ button $w.bot.btn -text Reset -command "SList:Reset $rh $list"
+ pack propagate $w.top 0
+ pack $w.top.msg -fill x
+ pack $w.bot.btn -anchor c
+ pack $w.top -expand yes -fill both
+ pack $w.bot -fill both
+
+ bind $list <Map> "tixDoWhenIdle $rh attachwidget $list"
+}
+
+proc SList:Reset {rh list} {
+ place $list -x 50 -y 150 -width 120 -height 80
+ update
+ $rh attachwidget $list
+}
+
+#----------------------------------------------------------------------
+# ScrolledWindow
+#----------------------------------------------------------------------
+proc MkSWindow {w} {
+ global demo_dir
+ frame $w.top -width 330 -height 330
+ frame $w.bot
+
+ message $w.top.msg -font -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*\
+ -relief flat -width 200 -anchor n\
+ -text {The TixScrolledWindow widget allows you\
+to scroll any kind of TK widget. It is more versatile\
+than a scrolled canvas widget}
+
+ set win [tixScrolledWindow $w.top.win -scrollbar auto]
+ set f [$win subwidget window]
+ set image [image create photo -file $demo_dir/bitmaps/tix.gif]
+
+ label $f.b1 -image $image
+
+ pack $f.b1 -expand yes -fill both
+
+ place $win -x 30 -y 150 -width 190 -height 120
+ set rh [tixResizeHandle $w.top.r -bg #202060 -relief raised \
+ -handlesize 8 -gridded true -minwidth 50 -minheight 30]
+
+ button $w.bot.btn -text Reset -command "SWindow:Reset $rh $win"
+ pack propagate $w.top 0
+ pack $w.top.msg -fill x
+ pack $w.bot.btn -anchor c
+ pack $w.top -expand yes -fill both
+ pack $w.bot -fill both
+
+ bind $win <Map> "tixDoWhenIdle $rh attachwidget $win"
+}
+
+proc SWindow:Reset {rh win} {
+ place $win -x 30 -y 150 -width 190 -height 120
+ update
+ $rh attachwidget $win
+}
+
+#----------------------------------------------------------------------
+# ScrolledText
+#----------------------------------------------------------------------
+proc MkSText {w} {
+ frame $w.top -width 330 -height 330
+ frame $w.bot
+
+ message $w.top.msg -font -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*\
+ -relief flat -width 200 -anchor n\
+ -text {The TixScrolledWindow widget allows you\
+to scroll any kind of TK widget. It is more versatile\
+than a scrolled canvas widget}
+
+ set win [tixScrolledText $w.top.win -scrollbar both]
+ $win subwidget text config -wrap none
+
+ place $win -x 30 -y 150 -width 190 -height 100
+ set rh [tixResizeHandle $w.top.r -bg #202060 -relief raised \
+ -handlesize 8 -gridded true -minwidth 50 -minheight 30]
+
+ button $w.bot.btn -text Reset -command "SText:Reset $rh $win"
+ pack propagate $w.top 0
+ pack $w.top.msg -fill x
+ pack $w.bot.btn -anchor c
+ pack $w.top -expand yes -fill both
+ pack $w.bot -fill both
+
+ bind $win <Map> "tixDoWhenIdle $rh attachwidget $win"
+}
+
+proc SText:Reset {rh win} {
+ place $win -x 30 -y 150 -width 190 -height 100
+ update
+ $rh attachwidget $win
+}
diff --git a/tix/demos/README b/tix/demos/README
new file mode 100644
index 00000000000..aff0bbbaed1
--- /dev/null
+++ b/tix/demos/README
@@ -0,0 +1,24 @@
+Files in this directory
+----------------------------------------------------------------------
+widget Demonstrates the widgets in Tix. This is not
+ intended to be an introductory sample program.
+ For sample programs, please see the files
+ under the samples/ directory.
+
+MkChoose.tcl Part of the "widget" demo.
+MkDirLis.tcl Part of the "widget" demo.
+MkManag.tcl Part of the "widget" demo.
+MkSample.tcl Part of the "widget" demo.
+MkScroll.tcl Part of the "widget" demo.
+tclIndex index file for the "widget" demo.
+bitmaps/ Contains bitmaps used by "widget".
+
+c-code/ Demonstrates how to link Tix with applications
+ written in C.
+
+et/ Currently empty.
+
+samples/ Sample Tix programs.
+
+
+
diff --git a/tix/demos/bitmaps/about.xpm b/tix/demos/bitmaps/about.xpm
new file mode 100644
index 00000000000..33ffcc06ef5
--- /dev/null
+++ b/tix/demos/bitmaps/about.xpm
@@ -0,0 +1,50 @@
+/* XPM */
+static char * about_xpm[] = {
+"50 40 7 1",
+" s None c None",
+". c black",
+"X c white",
+"o c gray70",
+"O c navy",
+"+ c red",
+"@ c yellow",
+" ",
+" ",
+" ",
+" ................................. ",
+" ..XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXoo. ",
+" .XooooooooooooooooooooooooooooooXo. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXooXo. ",
+" ..oooooooooooooooooooooooooooooooXo. ",
+" ...............................XoXo. ",
+" .OOOOOOOOOOOOOOOOOOOOOOOOOOOOO.XoXo. ",
+" .OOOOOOOOOOOOOOOOOOOOOOOOOOOOO.XoXo. ",
+" .OOOOOOOOOOOOOOOOOOOOOOOOOOOOO.XoXo. ",
+" .OOOOOOOOOOOOOOOOOOOOOOOOOOOOO.XoXo. ",
+" .OOOOOOOOOOOOOOOOOOOOOOOOOOOOO.XoXo.++++ ",
+" .OOOOOOOOOOOOOOOOOOOOOOOOOOOOO.XoXo+++ ",
+" .OOOOOOOOOOOOOOOOOOOOOOOOOOOOO.Xo+++++ ",
+" .OOOOOOOOOOOOOOOOOOOOOOOOOOOOO.Xo++++++ ",
+" .OOOOOOOOOOOOOOOOOOOOOOOOOOOOO.Xo+++ + ",
+" .OOOOO@@@@@OOOOOOOOOOOOOOOOOOO.Xo++. ",
+" .OOOOOOO@OOOOO@OOOOOOOOOOOOOOO.XoXo. ",
+" .OOOOOOO@OOOOOOOOOOOOOOOOOOOOO.XoXo. ",
+" .OOOOOOO@OOOO@@OOO@OOO@OOOOOOO.XoXo. ",
+" .OOOOOOO@OOOOO@OOOO@O@OOOOOOOO.XoXo. ",
+" .OOOOOOO@OOOOO@OOOOO@OOOOOOOOO.XoXo. ",
+" .OOOOOOO@OOOOO@OOOOO@OOOOOOOOO.XoXo. ",
+" .OOOOOOO@OOOOO@OOOO@O@OOOOOOOO.XoXo. ",
+" .OOOOOOO@OOOO@@@OO@OOO@OOOOOOO.XoXo. ",
+" .OOOOOOOOOOOOOOOOOOOOOOOOOOOOO.XoXo. ",
+" .OOOOOOOOOOOOOOOOOOOOOOOOOOOOO.XoXo. ",
+" .OOOOOOOOOOOOOOOOOOOOOOOOOOOOO.XoXo. ",
+" .OOOOOOOOOOOOOOOOOOOOOOOOOOOOO.XoXo. ",
+" .OOOOOOOOOOOOOOOOOOOOOOOOOOOOO.XoXo. ",
+" .OOOOOOOOOOOOOOOOOOOOOOOOOOOOO.XoXo. ",
+" .OOOOOOOOOOOOOOOOOOOOOOOOOOOOO.Xo.. ",
+" .OOOOOOOOOOOOOOOOOOOOOOOOOOOOO.Xo ",
+" OOOOOOOOOOOOOOOOOOOOOOOOOOOOO.X. ",
+" ............................. ",
+" ",
+" ",
+" "};
diff --git a/tix/demos/bitmaps/bold.xbm b/tix/demos/bitmaps/bold.xbm
new file mode 100644
index 00000000000..ebff8d11781
--- /dev/null
+++ b/tix/demos/bitmaps/bold.xbm
@@ -0,0 +1,6 @@
+#define bold_width 16
+#define bold_height 16
+static unsigned char bold_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0xfc, 0x07, 0xfc, 0x0f, 0x18, 0x1c, 0x18, 0x18,
+ 0x18, 0x18, 0x18, 0x1c, 0xf8, 0x0f, 0xf8, 0x0f, 0x18, 0x18, 0x18, 0x30,
+ 0x18, 0x30, 0x18, 0x38, 0xfc, 0x3f, 0xfc, 0x1f};
diff --git a/tix/demos/bitmaps/capital.xbm b/tix/demos/bitmaps/capital.xbm
new file mode 100644
index 00000000000..fb4e0703b11
--- /dev/null
+++ b/tix/demos/bitmaps/capital.xbm
@@ -0,0 +1,6 @@
+#define capital_width 16
+#define capital_height 16
+static unsigned char capital_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x30, 0x08, 0x30, 0x0c, 0x30, 0x06,
+ 0x30, 0x03, 0xb0, 0x01, 0xf0, 0x00, 0xf0, 0x00, 0xf0, 0x01, 0xb0, 0x03,
+ 0x30, 0x07, 0x30, 0x0e, 0x30, 0x1c, 0x00, 0x00};
diff --git a/tix/demos/bitmaps/centerj.xbm b/tix/demos/bitmaps/centerj.xbm
new file mode 100644
index 00000000000..9d2c0648343
--- /dev/null
+++ b/tix/demos/bitmaps/centerj.xbm
@@ -0,0 +1,6 @@
+#define centerj_width 16
+#define centerj_height 16
+static unsigned char centerj_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x3e, 0x00, 0x00, 0xc0, 0x0d,
+ 0x00, 0x00, 0x58, 0x77, 0x00, 0x00, 0xb0, 0x3b, 0x00, 0x00, 0xdc, 0xf7,
+ 0x00, 0x00, 0xf0, 0x3e, 0x00, 0x00, 0xd8, 0x7e};
diff --git a/tix/demos/bitmaps/combobox.xbm b/tix/demos/bitmaps/combobox.xbm
new file mode 100644
index 00000000000..f5947f57b4a
--- /dev/null
+++ b/tix/demos/bitmaps/combobox.xbm
@@ -0,0 +1,14 @@
+#define combobox_width 32
+#define combobox_height 32
+static unsigned char combobox_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0xfc, 0xff, 0xff, 0x3e, 0x04, 0x00, 0x80, 0x2a, 0x04, 0x00, 0x80, 0x2a,
+ 0x04, 0x00, 0x80, 0x2a, 0x04, 0x00, 0x80, 0x2b, 0xfc, 0xff, 0xff, 0x3e,
+ 0x08, 0x00, 0x00, 0x20, 0x08, 0x00, 0x00, 0x3e, 0x08, 0x00, 0x00, 0x2a,
+ 0x28, 0x49, 0x00, 0x2a, 0x08, 0x00, 0x00, 0x3e, 0x08, 0x00, 0x00, 0x22,
+ 0x08, 0x00, 0x00, 0x22, 0x28, 0x49, 0x12, 0x22, 0x08, 0x00, 0x00, 0x22,
+ 0x08, 0x00, 0x00, 0x22, 0x08, 0x00, 0x00, 0x22, 0x28, 0x49, 0x02, 0x22,
+ 0x08, 0x00, 0x00, 0x3e, 0x08, 0x00, 0x00, 0x2a, 0x08, 0x00, 0x00, 0x2a,
+ 0xf8, 0xff, 0xff, 0x3f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/tix/demos/bitmaps/combobox.xpm b/tix/demos/bitmaps/combobox.xpm
new file mode 100644
index 00000000000..d0234ab8e2d
--- /dev/null
+++ b/tix/demos/bitmaps/combobox.xpm
@@ -0,0 +1,49 @@
+/* XPM */
+static char * combobox_xpm[] = {
+"50 40 6 1",
+" s None c None",
+". c black",
+"X c white",
+"o c #FFFF80808080",
+"O c gray70",
+"+ c #808000008080",
+" ",
+" ",
+" ",
+" .................................... XXXXXXX ",
+" .ooooooooooooooooooooooooooooooooooX X . . ",
+" .ooooooooooooooooooooooooooooooooooX X . . ",
+" .oooo.oooooooooooooooooooooooooooooX X . . ",
+" .oo.o..oo.o.oo.o.ooooooooooooooooooX X . . ",
+" .o..o.o.o.oo.oo.oo.ooooooooooooooooX X ... . ",
+" .oo.oo.oo.o.oo.ooo.ooooooooooooooooX X . . ",
+" .ooooooooooooooooooooooooooooooooooX X . ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX X...... ",
+" ",
+" ",
+" ",
+" XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX ",
+" X............................................ ",
+" X.OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOX.OOOOX. ",
+" X.O+OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOX.OX OX. ",
+" X.O++OOO+OO+++OOOOOOOOOOOOOOOOOOOOOOOX.X ..X. ",
+" X.O+O+O+OOO+O+OOOOOOOOOOOOOOOOOOOOOOOX.OOOOX. ",
+" X.O++OOO+OO+++OOOOOOOOOOOOOOOOOOOOOOOX.OOOOX. ",
+" X.OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOX.XXXXX. ",
+" X.O.....X..........................OOX.X .X. ",
+" X.OX...XXX.X.XX.XX.................OOX.X .X. ",
+" X.OX.X..X..X.XX..XX.X..............OOX.X .X. ",
+" X.O.X...X..X.X...X..X..............OOX.X .X. ",
+" X.OOOOOOOOOOOOOOOOOOOOOOOO+OOOOOOOOOOX.X .X. ",
+" X.OOOOOOOOO+OOO+OOOOO+OOOO+OOOOOOOOOOX.X .X. ",
+" X.O+++OO+OO+O+OO++O++OO+OO+OOOOOOOOOOX.X...X. ",
+" X.OO+OO++OO+O+OO+OOO+OO+O++OOOOOOOOOOX.OOOOX. ",
+" X.OOOOOOOO+OOOOO++OO+OOOOOOOOOOOOOOOOX.OOOOX. ",
+" X.OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOX.X .X. ",
+" X.OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOX.O .OX. ",
+" X.OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOX.OOOOX. ",
+" X.XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX.XXXXX. ",
+" X............................................ ",
+" ",
+" ",
+" "};
diff --git a/tix/demos/bitmaps/drivea.xbm b/tix/demos/bitmaps/drivea.xbm
new file mode 100644
index 00000000000..83c636c6707
--- /dev/null
+++ b/tix/demos/bitmaps/drivea.xbm
@@ -0,0 +1,14 @@
+#define drivea_width 32
+#define drivea_height 32
+static unsigned char drivea_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0xf8, 0xff, 0xff, 0x1f, 0x08, 0x00, 0x00, 0x18, 0xa8, 0xaa, 0xaa, 0x1a,
+ 0x48, 0x55, 0xd5, 0x1d, 0xa8, 0xaa, 0xaa, 0x1b, 0x48, 0x55, 0x55, 0x1d,
+ 0xa8, 0xfa, 0xaf, 0x1a, 0xc8, 0xff, 0xff, 0x1d, 0xa8, 0xfa, 0xaf, 0x1a,
+ 0x48, 0x55, 0x55, 0x1d, 0xa8, 0xaa, 0xaa, 0x1a, 0x48, 0x55, 0x55, 0x1d,
+ 0xa8, 0xaa, 0xaa, 0x1a, 0xf8, 0xff, 0xff, 0x1f, 0xf8, 0xff, 0xff, 0x1f,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/tix/demos/bitmaps/drivea.xpm b/tix/demos/bitmaps/drivea.xpm
new file mode 100644
index 00000000000..4d274b995f1
--- /dev/null
+++ b/tix/demos/bitmaps/drivea.xpm
@@ -0,0 +1,43 @@
+/* XPM */
+static char * drivea_xpm[] = {
+/* width height ncolors chars_per_pixel */
+"32 32 5 1",
+/* colors */
+" s None c None",
+". c #000000000000",
+"X c white",
+"o c #c000c000c000",
+"O c #800080008000",
+/* pixels */
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" .......................... ",
+" .XXXXXXXXXXXXXXXXXXXXXXXo. ",
+" .XooooooooooooooooooooooO. ",
+" .Xooooooooooooooooo..oooO. ",
+" .Xooooooooooooooooo..oooO. ",
+" .XooooooooooooooooooooooO. ",
+" .Xoooooooo.......oooooooO. ",
+" .Xoo...................oO. ",
+" .Xoooooooo.......oooooooO. ",
+" .XooooooooooooooooooooooO. ",
+" .XooooooooooooooooooooooO. ",
+" .XooooooooooooooooooooooO. ",
+" .XooooooooooooooooooooooO. ",
+" .oOOOOOOOOOOOOOOOOOOOOOOO. ",
+" .......................... ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" "};
diff --git a/tix/demos/bitmaps/exit.xpm b/tix/demos/bitmaps/exit.xpm
new file mode 100644
index 00000000000..505a07bdf69
--- /dev/null
+++ b/tix/demos/bitmaps/exit.xpm
@@ -0,0 +1,48 @@
+/* XPM */
+static char * exit_xpm[] = {
+"50 40 5 1",
+" s None c None",
+". c black",
+"X c white",
+"o c #000080800000",
+"O c yellow",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ....................................... ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XoooooooooooooooooooooooooooooooooooX. ",
+" .XoooooooooooooooooooooooooooooooooooX. ",
+" .XoooooooooooooooooooooooOoooooooooooX. ",
+" .XoooooooooooooooooooooooOOooooooooooX. ",
+" .XoooooooooooooooooooooooOOOoooooooooX. ",
+" .XoooooOOOOOOOOOOOOOOOOOOOOOOooooooooX. ",
+" .XoooooOOOOOOOOOOOOOOOOOOOOOOOoooooooX. ",
+" .XoooooOOOOOOOOOOOOOOOOOOOOOOOOooooooX. ",
+" .XoooooOOOOOOOOOOOOOOOOOOOOOOOOOoooooX. ",
+" .XoooooOOOOOOOOOOOOOOOOOOOOOOOOooooooX. ",
+" .XoooooOOOOOOOOOOOOOOOOOOOOOOOoooooooX. ",
+" .XoooooOOOOOOOOOOOOOOOOOOOOOOooooooooX. ",
+" .XoooooooooooooooooooooooOOOoooooooooX. ",
+" .XoooooooooooooooooooooooOOooooooooooX. ",
+" .XoooooooooooooooooooooooOoooooooooooX. ",
+" .XoooooooooooooooooooooooooooooooooooX. ",
+" .XoooooooooooooooooooooooooooooooooooX. ",
+" .XoooooooooooooooooooooooooooooooooooX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+" ....................................... ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" "};
diff --git a/tix/demos/bitmaps/filebox.xbm b/tix/demos/bitmaps/filebox.xbm
new file mode 100644
index 00000000000..c8f7ac255bb
--- /dev/null
+++ b/tix/demos/bitmaps/filebox.xbm
@@ -0,0 +1,14 @@
+#define filebox_width 32
+#define filebox_height 32
+static unsigned char filebox_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0x3f, 0x04, 0x00, 0x00, 0x20,
+ 0xe4, 0xff, 0xff, 0x27, 0x24, 0x00, 0x00, 0x24, 0x24, 0x00, 0x00, 0x24,
+ 0xe4, 0xff, 0xff, 0x27, 0x04, 0x00, 0x00, 0x20, 0xe4, 0x7f, 0xfe, 0x27,
+ 0x24, 0x50, 0x02, 0x25, 0x24, 0x40, 0x02, 0x24, 0x24, 0x50, 0x02, 0x25,
+ 0x24, 0x40, 0x02, 0x24, 0x24, 0x50, 0x02, 0x25, 0x24, 0x40, 0x02, 0x24,
+ 0x24, 0x50, 0x02, 0x25, 0xe4, 0x7f, 0xfe, 0x27, 0x04, 0x00, 0x00, 0x20,
+ 0xe4, 0xff, 0xff, 0x27, 0x24, 0x00, 0x00, 0x24, 0x24, 0x00, 0x00, 0x24,
+ 0xe4, 0xff, 0xff, 0x27, 0x04, 0x00, 0x00, 0x20, 0xfc, 0xff, 0xff, 0x3f,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/tix/demos/bitmaps/filebox.xpm b/tix/demos/bitmaps/filebox.xpm
new file mode 100644
index 00000000000..7377ee60e68
--- /dev/null
+++ b/tix/demos/bitmaps/filebox.xpm
@@ -0,0 +1,49 @@
+/* XPM */
+static char * filebox_xpm[] = {
+"50 40 6 1",
+" s None c None",
+". c white",
+"X c gray80",
+"o c black",
+"O c #FFFF80808080",
+"+ c gray70",
+" ",
+" ",
+" ",
+" ............................................ ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .XXooXooXoXooXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .XXooXooXoXooXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .XXooooooooooooooooooooooooooooooooooooo.XXo ",
+" .XXoOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO.XXo ",
+" .XXoOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO.XXo ",
+" .XX......................................XXo ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .XXoooooooooooooooo.XXXXoooooooooooooooo.XXo ",
+" .XXo+++++++++++++++.XXXXo+++++++++++++++.XXo ",
+" .XXo+++++++++++++++.XXXXo+++++++++++++++.XXo ",
+" .XXo+++++++++++++++.XXXXo+++++++++++++++.XXo ",
+" .XXo+++++++++++++++.XXXXo+++++++++++++++.XXo ",
+" .XXo+++++++++++++++.XXXXo+++++++++++++++.XXo ",
+" .XXo+++++++++++++++.XXXXo+++++++++++++++.XXo ",
+" .XXo+++++++++++++++.XXXXo+++++++++++++++.XXo ",
+" .XXo+++++++++++++++.XXXXo+++++++++++++++.XXo ",
+" .XXo+++++++++++++++.XXXXo+++++++++++++++.XXo ",
+" .XXo+++++++++++++++.XXXXo+++++++++++++++.XXo ",
+" .XXo+++++++++++++++.XXXXo+++++++++++++++.XXo ",
+" .XX.................XXXX.................XXo ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .XXooXooXoXooXoXXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .XXooXooXoXooXoXooXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .XXoooooooooooooooooooooooooooooooooooooo.Xo ",
+" .XXoOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO.Xo ",
+" .XXoOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO.Xo ",
+" .XX.......................................Xo ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .ooooooooooooooooooooooooooooooooooooooooooo ",
+" ",
+" ",
+" "};
diff --git a/tix/demos/bitmaps/harddisk.xbm b/tix/demos/bitmaps/harddisk.xbm
new file mode 100644
index 00000000000..83c636c6707
--- /dev/null
+++ b/tix/demos/bitmaps/harddisk.xbm
@@ -0,0 +1,14 @@
+#define drivea_width 32
+#define drivea_height 32
+static unsigned char drivea_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0xf8, 0xff, 0xff, 0x1f, 0x08, 0x00, 0x00, 0x18, 0xa8, 0xaa, 0xaa, 0x1a,
+ 0x48, 0x55, 0xd5, 0x1d, 0xa8, 0xaa, 0xaa, 0x1b, 0x48, 0x55, 0x55, 0x1d,
+ 0xa8, 0xfa, 0xaf, 0x1a, 0xc8, 0xff, 0xff, 0x1d, 0xa8, 0xfa, 0xaf, 0x1a,
+ 0x48, 0x55, 0x55, 0x1d, 0xa8, 0xaa, 0xaa, 0x1a, 0x48, 0x55, 0x55, 0x1d,
+ 0xa8, 0xaa, 0xaa, 0x1a, 0xf8, 0xff, 0xff, 0x1f, 0xf8, 0xff, 0xff, 0x1f,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/tix/demos/bitmaps/harddisk.xpm b/tix/demos/bitmaps/harddisk.xpm
new file mode 100644
index 00000000000..4d274b995f1
--- /dev/null
+++ b/tix/demos/bitmaps/harddisk.xpm
@@ -0,0 +1,43 @@
+/* XPM */
+static char * drivea_xpm[] = {
+/* width height ncolors chars_per_pixel */
+"32 32 5 1",
+/* colors */
+" s None c None",
+". c #000000000000",
+"X c white",
+"o c #c000c000c000",
+"O c #800080008000",
+/* pixels */
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" .......................... ",
+" .XXXXXXXXXXXXXXXXXXXXXXXo. ",
+" .XooooooooooooooooooooooO. ",
+" .Xooooooooooooooooo..oooO. ",
+" .Xooooooooooooooooo..oooO. ",
+" .XooooooooooooooooooooooO. ",
+" .Xoooooooo.......oooooooO. ",
+" .Xoo...................oO. ",
+" .Xoooooooo.......oooooooO. ",
+" .XooooooooooooooooooooooO. ",
+" .XooooooooooooooooooooooO. ",
+" .XooooooooooooooooooooooO. ",
+" .XooooooooooooooooooooooO. ",
+" .oOOOOOOOOOOOOOOOOOOOOOOO. ",
+" .......................... ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" "};
diff --git a/tix/demos/bitmaps/italic.xbm b/tix/demos/bitmaps/italic.xbm
new file mode 100644
index 00000000000..169c3cb75f6
--- /dev/null
+++ b/tix/demos/bitmaps/italic.xbm
@@ -0,0 +1,6 @@
+#define italic_width 16
+#define italic_height 16
+static unsigned char italic_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x80, 0x3f, 0x80, 0x3f, 0x00, 0x06, 0x00, 0x06,
+ 0x00, 0x03, 0x00, 0x03, 0x80, 0x01, 0x80, 0x01, 0xc0, 0x00, 0xc0, 0x00,
+ 0x60, 0x00, 0x60, 0x00, 0xfc, 0x01, 0xfc, 0x01};
diff --git a/tix/demos/bitmaps/justify.xbm b/tix/demos/bitmaps/justify.xbm
new file mode 100644
index 00000000000..bba660acec2
--- /dev/null
+++ b/tix/demos/bitmaps/justify.xbm
@@ -0,0 +1,6 @@
+#define justify_width 16
+#define justify_height 16
+static unsigned char justify_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xec, 0xdb, 0x00, 0x00, 0x7c, 0xdb,
+ 0x00, 0x00, 0xbc, 0xf7, 0x00, 0x00, 0xdc, 0xde, 0x00, 0x00, 0x6c, 0xdf,
+ 0x00, 0x00, 0x6c, 0xef, 0x00, 0x00, 0xdc, 0xdf};
diff --git a/tix/demos/bitmaps/leftj.xbm b/tix/demos/bitmaps/leftj.xbm
new file mode 100644
index 00000000000..5f8e006f4ec
--- /dev/null
+++ b/tix/demos/bitmaps/leftj.xbm
@@ -0,0 +1,6 @@
+#define leftj_width 16
+#define leftj_height 16
+static unsigned char leftj_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xcc, 0x6d, 0x00, 0x00, 0xdc, 0x01,
+ 0x00, 0x00, 0xec, 0x0e, 0x00, 0x00, 0xfc, 0x7e, 0x00, 0x00, 0xdc, 0x03,
+ 0x00, 0x00, 0x6c, 0x3b, 0x00, 0x00, 0x6c, 0x1f};
diff --git a/tix/demos/bitmaps/netw.xbm b/tix/demos/bitmaps/netw.xbm
new file mode 100644
index 00000000000..a684d65d4b7
--- /dev/null
+++ b/tix/demos/bitmaps/netw.xbm
@@ -0,0 +1,14 @@
+#define netw_width 32
+#define netw_height 32
+static unsigned char netw_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x7f, 0x00, 0x00, 0x02, 0x40,
+ 0x00, 0x00, 0xfa, 0x5f, 0x00, 0x00, 0x0a, 0x50, 0x00, 0x00, 0x0a, 0x52,
+ 0x00, 0x00, 0x0a, 0x52, 0x00, 0x00, 0x8a, 0x51, 0x00, 0x00, 0x0a, 0x50,
+ 0x00, 0x00, 0x4a, 0x50, 0x00, 0x00, 0x0a, 0x50, 0x00, 0x00, 0x0a, 0x50,
+ 0x00, 0x00, 0xfa, 0x5f, 0x00, 0x00, 0x02, 0x40, 0xfe, 0x7f, 0x52, 0x55,
+ 0x02, 0x40, 0xaa, 0x6a, 0xfa, 0x5f, 0xfe, 0x7f, 0x0a, 0x50, 0xfe, 0x7f,
+ 0x0a, 0x52, 0x80, 0x00, 0x0a, 0x52, 0x80, 0x00, 0x8a, 0x51, 0x80, 0x00,
+ 0x0a, 0x50, 0x80, 0x00, 0x4a, 0x50, 0x80, 0x00, 0x0a, 0x50, 0xe0, 0x03,
+ 0x0a, 0x50, 0x20, 0x02, 0xfa, 0xdf, 0x3f, 0x03, 0x02, 0x40, 0xa0, 0x02,
+ 0x52, 0x55, 0xe0, 0x03, 0xaa, 0x6a, 0x00, 0x00, 0xfe, 0x7f, 0x00, 0x00,
+ 0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/tix/demos/bitmaps/netw.xpm b/tix/demos/bitmaps/netw.xpm
new file mode 100644
index 00000000000..fff6593bca3
--- /dev/null
+++ b/tix/demos/bitmaps/netw.xpm
@@ -0,0 +1,45 @@
+/* XPM */
+static char * netw_xpm[] = {
+/* width height ncolors chars_per_pixel */
+"32 32 7 1",
+/* colors */
+" s None c None",
+". c #000000000000",
+"X c white",
+"o c #c000c000c000",
+"O c #404040",
+"+ c blue",
+"@ c red",
+/* pixels */
+" ",
+" .............. ",
+" .XXXXXXXXXXXX. ",
+" .XooooooooooO. ",
+" .Xo.......XoO. ",
+" .Xo.++++o+XoO. ",
+" .Xo.++++o+XoO. ",
+" .Xo.++oo++XoO. ",
+" .Xo.++++++XoO. ",
+" .Xo.+o++++XoO. ",
+" .Xo.++++++XoO. ",
+" .Xo.XXXXXXXoO. ",
+" .XooooooooooO. ",
+" .Xo@ooo....oO. ",
+" .............. .XooooooooooO. ",
+" .XXXXXXXXXXXX. .XooooooooooO. ",
+" .XooooooooooO. .OOOOOOOOOOOO. ",
+" .Xo.......XoO. .............. ",
+" .Xo.++++o+XoO. @ ",
+" .Xo.++++o+XoO. @ ",
+" .Xo.++oo++XoO. @ ",
+" .Xo.++++++XoO. @ ",
+" .Xo.+o++++XoO. @ ",
+" .Xo.++++++XoO. ..... ",
+" .Xo.XXXXXXXoO. .XXX. ",
+" .XooooooooooO.@@@@@@.X O. ",
+" .Xo@ooo....oO. .OOO. ",
+" .XooooooooooO. ..... ",
+" .XooooooooooO. ",
+" .OOOOOOOOOOOO. ",
+" .............. ",
+" "};
diff --git a/tix/demos/bitmaps/network.xbm b/tix/demos/bitmaps/network.xbm
new file mode 100644
index 00000000000..a684d65d4b7
--- /dev/null
+++ b/tix/demos/bitmaps/network.xbm
@@ -0,0 +1,14 @@
+#define netw_width 32
+#define netw_height 32
+static unsigned char netw_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x7f, 0x00, 0x00, 0x02, 0x40,
+ 0x00, 0x00, 0xfa, 0x5f, 0x00, 0x00, 0x0a, 0x50, 0x00, 0x00, 0x0a, 0x52,
+ 0x00, 0x00, 0x0a, 0x52, 0x00, 0x00, 0x8a, 0x51, 0x00, 0x00, 0x0a, 0x50,
+ 0x00, 0x00, 0x4a, 0x50, 0x00, 0x00, 0x0a, 0x50, 0x00, 0x00, 0x0a, 0x50,
+ 0x00, 0x00, 0xfa, 0x5f, 0x00, 0x00, 0x02, 0x40, 0xfe, 0x7f, 0x52, 0x55,
+ 0x02, 0x40, 0xaa, 0x6a, 0xfa, 0x5f, 0xfe, 0x7f, 0x0a, 0x50, 0xfe, 0x7f,
+ 0x0a, 0x52, 0x80, 0x00, 0x0a, 0x52, 0x80, 0x00, 0x8a, 0x51, 0x80, 0x00,
+ 0x0a, 0x50, 0x80, 0x00, 0x4a, 0x50, 0x80, 0x00, 0x0a, 0x50, 0xe0, 0x03,
+ 0x0a, 0x50, 0x20, 0x02, 0xfa, 0xdf, 0x3f, 0x03, 0x02, 0x40, 0xa0, 0x02,
+ 0x52, 0x55, 0xe0, 0x03, 0xaa, 0x6a, 0x00, 0x00, 0xfe, 0x7f, 0x00, 0x00,
+ 0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/tix/demos/bitmaps/network.xpm b/tix/demos/bitmaps/network.xpm
new file mode 100644
index 00000000000..fff6593bca3
--- /dev/null
+++ b/tix/demos/bitmaps/network.xpm
@@ -0,0 +1,45 @@
+/* XPM */
+static char * netw_xpm[] = {
+/* width height ncolors chars_per_pixel */
+"32 32 7 1",
+/* colors */
+" s None c None",
+". c #000000000000",
+"X c white",
+"o c #c000c000c000",
+"O c #404040",
+"+ c blue",
+"@ c red",
+/* pixels */
+" ",
+" .............. ",
+" .XXXXXXXXXXXX. ",
+" .XooooooooooO. ",
+" .Xo.......XoO. ",
+" .Xo.++++o+XoO. ",
+" .Xo.++++o+XoO. ",
+" .Xo.++oo++XoO. ",
+" .Xo.++++++XoO. ",
+" .Xo.+o++++XoO. ",
+" .Xo.++++++XoO. ",
+" .Xo.XXXXXXXoO. ",
+" .XooooooooooO. ",
+" .Xo@ooo....oO. ",
+" .............. .XooooooooooO. ",
+" .XXXXXXXXXXXX. .XooooooooooO. ",
+" .XooooooooooO. .OOOOOOOOOOOO. ",
+" .Xo.......XoO. .............. ",
+" .Xo.++++o+XoO. @ ",
+" .Xo.++++o+XoO. @ ",
+" .Xo.++oo++XoO. @ ",
+" .Xo.++++++XoO. @ ",
+" .Xo.+o++++XoO. @ ",
+" .Xo.++++++XoO. ..... ",
+" .Xo.XXXXXXXoO. .XXX. ",
+" .XooooooooooO.@@@@@@.X O. ",
+" .Xo@ooo....oO. .OOO. ",
+" .XooooooooooO. ..... ",
+" .XooooooooooO. ",
+" .OOOOOOOOOOOO. ",
+" .............. ",
+" "};
diff --git a/tix/demos/bitmaps/optmenu.xpm b/tix/demos/bitmaps/optmenu.xpm
new file mode 100644
index 00000000000..63bab812996
--- /dev/null
+++ b/tix/demos/bitmaps/optmenu.xpm
@@ -0,0 +1,48 @@
+/* XPM */
+static char * optmenu_xpm[] = {
+"50 40 5 1",
+" s None c None",
+". c white",
+"X c gray80",
+"o c gray50",
+"O c black",
+" ",
+" ",
+" .............................. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .XXXOXOXXOXXOXXXXOOXXXXXXXXXXo ",
+" .XXXOXOXXOXOXXXOXXOXXXXXXXXXXo ",
+" .XXXXOXXOXXOXXXOXXXOXXXXXXXXXo ",
+" .XXXXOXXXOXXOOXXOXOXXXXXXXXXXo ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXo.............o ",
+" .............................o o ",
+" ..XXXOXXXXXOXXXXXXXXOXXXXXXXOo o ",
+" ..XXOXOXOXXOXOXXXOXXOXXXXXXXOo ...... o ",
+" ..XXXOXXXOXXOXXXOXXXOXXXXXXXOo . o o ",
+" ..XXOXXXOXXXOXOXXOXXOXXXXXXXOo . o o ",
+" ..XXXXXXXXXXXXXXXXXXXXXXXXXXOo .ooooo o ",
+" .OOOOOOOOOOOOOOOOOOOOOOOOOOOOo o ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXo o ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXooooooooooooooo ",
+" .XXXXOXXXXXOXXXXXXXXXXXXXXXXXo ",
+" .XXXOXXXXXXXXXOXXXXXXXXXXXXXXo ",
+" .XXXXOXXOXXOXOXOXXXXXXXXXXXXXo ",
+" .XXXXXOXXOXOXXXXXXXXXXXXXXXXXo ",
+" .XXXXXXXXXXXXXOXXXXXXXXXXXXXXo ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .XXXOXOXXXXXXXOXOXXXXXOXXXXXXo ",
+" .XXXXXOXOXOXXOXXXXXOXXOXXXXXXo ",
+" .XXXXOXXOXOXOXXXOXOXOXXOXXXXXo ",
+" .XXXOXXXXOXXOXXXOXXOXXXXOXXXXo ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXXXo ",
+" oooooooooooooooooooooooooooooo ",
+" ",
+" ",
+" ",
+" "};
diff --git a/tix/demos/bitmaps/rightj.xbm b/tix/demos/bitmaps/rightj.xbm
new file mode 100644
index 00000000000..1d438e00902
--- /dev/null
+++ b/tix/demos/bitmaps/rightj.xbm
@@ -0,0 +1,6 @@
+#define rightj_width 16
+#define rightj_height 16
+static unsigned char rightj_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0xdb, 0x00, 0x00, 0x70, 0xdb,
+ 0x00, 0x00, 0x00, 0xef, 0x00, 0x00, 0xd8, 0xde, 0x00, 0x00, 0xc0, 0xdd,
+ 0x00, 0x00, 0xa0, 0xef, 0x00, 0x00, 0xd8, 0xde};
diff --git a/tix/demos/bitmaps/select.xpm b/tix/demos/bitmaps/select.xpm
new file mode 100644
index 00000000000..392e5a08345
--- /dev/null
+++ b/tix/demos/bitmaps/select.xpm
@@ -0,0 +1,52 @@
+/* XPM */
+static char * select_xpm[] = {
+"50 40 9 1",
+" s None c None",
+". c black",
+"X c gray95",
+"o c gray50",
+"O c gray70",
+"+ c navy",
+"@ c #000080800000",
+"# c #808000000000",
+"$ c white",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" .............................................. ",
+" .XXXXXXXXXXooooooooooooXXXXXXXXXXXoXXXXXXXXXX. ",
+" .X ooOOOOOOOOOOXX oX o. ",
+" .X ooOOOOOOOOOOXX oX o. ",
+" .X ++++ ooOOOOOOOOOOXX ... oX @ o. ",
+" .X +++++ ooOOOOOOOOOOXX . . oX @@@ o. ",
+" .X +++ + ooOOOOOOOOOOXX . . oX @ @ o. ",
+" .X + + ooOO#####OOOXX . . oX @ @ o. ",
+" .X + + ooOO#OOO##OOXX . oX @ @ o. ",
+" .X + + ooO##OOOO##OXX . oX @ @ o. ",
+" .X ++ ++ ooO###OOO#OOXX . oX @ @ o. ",
+" .X +++++++ ooO#######OOXX . oX @ @ o. ",
+" .X + + ooO##O#OO#OOXX . oX @ @ o. ",
+" .X + ++ ooO##OOOOO#OXX . . oX @ @ o. ",
+" .X + + ooOO#OOOOO#OXX . . oX @ @@ o. ",
+" .X + ++ ooOO#OOOOO#OXX .... oX @@@@@ o. ",
+" .X ooOO######OOXX oX o. ",
+" .X ooOOOOOOOOOOXX $oX o. ",
+" .XoooooooooooXXXXXXXXXXXoooooooooooXooooooooo. ",
+" .............................................. ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" "};
diff --git a/tix/demos/bitmaps/tix.gif b/tix/demos/bitmaps/tix.gif
new file mode 100644
index 00000000000..e7d51a086cc
--- /dev/null
+++ b/tix/demos/bitmaps/tix.gif
Binary files differ
diff --git a/tix/demos/bitmaps/underlin.xbm b/tix/demos/bitmaps/underlin.xbm
new file mode 100644
index 00000000000..f07bb460546
--- /dev/null
+++ b/tix/demos/bitmaps/underlin.xbm
@@ -0,0 +1,6 @@
+#define underline_width 16
+#define underline_height 16
+static unsigned char underline_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x38, 0x1c, 0x38, 0x1c,
+ 0x30, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x70, 0x0e,
+ 0xf0, 0x0f, 0xe0, 0x07, 0x00, 0x00, 0xf8, 0x1f};
diff --git a/tix/demos/c-code/Makefile.in b/tix/demos/c-code/Makefile.in
new file mode 100644
index 00000000000..62be8c89837
--- /dev/null
+++ b/tix/demos/c-code/Makefile.in
@@ -0,0 +1,147 @@
+#
+# 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.
+#
+# @(#) Makefile.in 1.19 95/01/08 16:55:30
+
+#----------------------------------------------------------------
+# Things you can change to personalize the Makefile for your own
+# site (you can make these changes in either Makefile.in or
+# Makefile, but changes to Makefile will get lost if you re-run
+# the configuration script).
+#----------------------------------------------------------------
+
+# Default top-level directories in which to install architecture-
+# specific files (exec_prefix) and machine-independent files such
+# as scripts (prefix). The values specified here may be overridden
+# at configure-time with the --exec-prefix and --prefix options
+# to the "configure" script.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+
+@SET_MAKE@
+
+# Directory in which to install the library of Tix scripts and demos
+# (note: you can set the TIX_LIBRARY environment variable at run-time to
+# override the compiled-in location):
+TIX_LIBRARY = $(prefix)/lib/tix
+
+# Directory in which to install the archive libtix.a:
+LIB_DIR = $(exec_prefix)/lib
+
+# Directory in which to install the program wish:
+BIN_DIR = $(exec_prefix)/bin
+
+# Directory in which to install the include file tix.h:
+INCLUDE_DIR = $(prefix)/include
+
+# Top-level directory for manual entries:
+MAN_DIR = $(prefix)/man
+
+# Directory in which to install manual entry for wish:
+MAN1_DIR = $(MAN_DIR)/man1
+
+# Directory in which to install manual entries for Tix's C library
+# procedures:
+MAN3_DIR = $(MAN_DIR)/man3
+
+# Directory in which to install manual entries for the built-in
+# Tcl commands implemented by Tix:
+MANN_DIR = $(MAN_DIR)/mann
+
+
+# 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: must include at least Tix, Tcl, Xlib,
+# and the math library (in that order). The "@LIBS@" part will be
+# replaced (or has already been replaced) with relevant libraries as
+# determined by the configure script.
+LIBS = ../../unix-tk4.0/libtix.a @TK40_LIB@ @TCL74_LIB@ \
+ $(X11_LIB_SWITCHES) @LIBS@ @MATH_LIBS@
+
+# To change the compiler switches, for example to change from -O
+# to -g, change the following line:
+CFLAGS = @TIX_DEBUG_FLAG@
+
+# To disable ANSI-C procedure prototypes reverse the comment characters
+# on the following lines:
+PROTO_FLAGS =
+#PROTO_FLAGS = -DNO_PROTOTYPE
+
+# To enable memory debugging reverse the comment characters on the following
+# lines. Warning: if you enable memory debugging, you must do it
+# *everywhere*, including all the code that calls Tcl, and you must use
+# ckalloc and ckfree everywhere instead of malloc and free.
+MEM_DEBUG_FLAGS =
+#MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG
+
+# Some versions of make, like SGI's, use the following variable to
+# determine which shell to use for executing commands:
+SHELL = /bin/sh
+
+#----------------------------------------------------------------
+# 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@
+SRC_DIR = @SRC_DIR@
+INC_DIR = @SRC_DIR@/include
+VPATH = @SRC_DIR@
+
+#----------------------------------------------------------------
+# 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} -I${INC_DIR} -I@TCL74_SRC_DIR@ -I@TK40_SRC_DIR@ \
+${X11_INCLUDES} ${AC_FLAGS} ${PROTO_FLAGS} ${MEM_DEBUG_FLAGS} \
+-DTIX_LIBRARY=\"${TIX_LIBRARY}\" @TIX_EXTRA_CFLAGS@
+
+OBJS = tixAppInit.o myInit.o myCmds.o
+
+HDRS =
+
+all: mytixwish
+
+mytixwish: $(OBJS)
+ $(CC) $(CC_SWITCHES) $(OBJS) @TIX_EXTRA_LDFLAGS@ $(LIBS) -o mytixwish
+
+Makefile: Makefile.in
+ cd $(SRC_DIR); $(SHELL) config.status
+
+clean:
+ - rm -f *.a *.o core errs *~ \#* TAGS *.E a.out errors \
+ config.info mytixwish
+
+distclean: clean
+ - rm -f Makefile config.status config.log config.cache
+
+depend:
+ makedepend -- $(CC_SWITCHES) -- $(SRCS)
+
+install:
+ @echo nothing to be done.
+
+.c.o:
+ $(CC) -c $(CC_SWITCHES) $<
+
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
diff --git a/tix/demos/c-code/library/Init.tcl b/tix/demos/c-code/library/Init.tcl
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/tix/demos/c-code/library/Init.tcl
diff --git a/tix/demos/c-code/library/tclIndex b/tix/demos/c-code/library/tclIndex
new file mode 100644
index 00000000000..4d9f691e728
--- /dev/null
+++ b/tix/demos/c-code/library/tclIndex
@@ -0,0 +1,9 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "tixindex" program,
+# *NOT* by the "auto_mkindex" command,
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
diff --git a/tix/demos/c-code/myCmds.c b/tix/demos/c-code/myCmds.c
new file mode 100644
index 00000000000..23643d465d4
--- /dev/null
+++ b/tix/demos/c-code/myCmds.c
@@ -0,0 +1,48 @@
+#include <tk.h>
+#include <tix.h>
+
+int
+My_AddTwoCmd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int num;
+ char buf[30];
+
+ if (argc != 2) {
+ return Tix_ArgcError(interp, 1, argv, 1, "integer");
+ }
+
+ if (Tcl_GetInt(interp, argv[1], &num) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ sprintf(buf, "%d", num+2);
+ Tcl_AppendResult(interp, buf, NULL);
+ return TCL_OK;
+}
+
+int
+My_SubTwoCmd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int num;
+ char buf[30];
+
+ if (argc != 2) {
+ return Tix_ArgcError(interp, 1, argv, 1, "integer");
+ }
+
+ if (Tcl_GetInt(interp, argv[1], &num) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ sprintf(buf, "%d", num-2);
+ Tcl_AppendResult(interp, buf, NULL);
+ return TCL_OK;
+}
diff --git a/tix/demos/c-code/myInit.c b/tix/demos/c-code/myInit.c
new file mode 100644
index 00000000000..b82b79c3c3a
--- /dev/null
+++ b/tix/demos/c-code/myInit.c
@@ -0,0 +1,60 @@
+/*
+ * myInit.c --
+ *
+ * Initialze the Tix demo application.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tk.h>
+#include <tix.h>
+
+#ifndef _Windows
+# ifndef _export
+# define _export
+# endif
+#endif
+
+extern TIX_DECLARE_CMD(My_AddTwoCmd);
+extern TIX_DECLARE_CMD(My_SubTwoCmd);
+
+#ifndef MY_LIBRARY
+#define MY_LIBRARY "/usr/local/myapp"
+#endif
+
+
+static Tix_TclCmd commands[] = {
+ {"myAddTwo", My_AddTwoCmd},
+ {"mySubTwo", My_SubTwoCmd},
+
+ /*
+ * Make sure this list is terminated by a NULL element
+ */
+ {(char *) NULL, (int (*)()) NULL}
+};
+
+/* My_Init --
+ *
+ * This is the function to call in your Tcl_AppInit() function. It
+ * creates the commands of this application that are defined by
+ * C functions.
+ */
+int _export
+My_Init(interp)
+ Tcl_Interp * interp;
+{
+ /* Initialize the Tix commands */
+ Tix_CreateCommands(interp, commands, (ClientData) NULL,
+ (void (*)()) NULL);
+
+ if (Tix_LoadTclLibrary(interp, "MY_LIBRARY", "my_library",
+ "Init.tcl", MY_LIBRARY, "myapp") != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
diff --git a/tix/demos/c-code/tixAppInit.c b/tix/demos/c-code/tixAppInit.c
new file mode 100644
index 00000000000..eb2f7983403
--- /dev/null
+++ b/tix/demos/c-code/tixAppInit.c
@@ -0,0 +1,122 @@
+/*
+ * myAppInit.c --
+ *
+ * This is a demo program that shows how to link your C programs
+ * with Tcl/Tk/Tix.
+ *
+ * The program created in this directory is a demo program
+ * called "myapp". You can modify the files in this directory
+ * to use in your applications.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tk.h>
+#include <tix.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;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ * This is the main program for the application.
+ *
+ * Results:
+ * None: Tk_Main never returns here, so this procedure never
+ * returns either.
+ *
+ * Side effects:
+ * Whatever the application does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+main(argc, argv)
+ int argc; /* Number of command-line arguments. */
+ char **argv; /* Values of command-line arguments. */
+{
+ Tk_Main(argc, argv, Tcl_AppInit);
+ return 0; /* Needed only to prevent compiler warning. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppInit(interp)
+ Tcl_Interp *interp; /* Interpreter for application. */
+{
+ /* Initialize the Tcl, Tk and Tix packages (in this order) */
+
+ if (Tcl_Init(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tk_Init(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tix_Init(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If you want to use other packages, call their initialization
+ * procedures here. Each call should look like this:
+ *
+ * if (Mod_Init(interp) != TCL_OK) {
+ * return TCL_ERROR;
+ * }
+ *
+ * where "Mod" is the name of the module.
+ *
+ * For example, the intialization procedure for the BLT package is
+ * BLT_Init().
+ */
+
+
+
+ /*
+ * Call My_Init() to do application specific initialization.
+ */
+
+ if (My_Init(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Specify a user-specific startup file to invoke
+ */
+
+ Tix_SetRcFileName(interp, "my");
+
+ return TCL_OK;
+}
diff --git a/tix/demos/et/Makefile.demo b/tix/demos/et/Makefile.demo
new file mode 100644
index 00000000000..18745ab52a3
--- /dev/null
+++ b/tix/demos/et/Makefile.demo
@@ -0,0 +1,16 @@
+# This is an example Makefile that demonstrates how to link Tix into
+# an ET-enabled wish. You need to modify this file to suit the
+# configuration on your system
+#
+
+# etwish+tix: an ET-enabled wish executable that includes Tix
+#
+# etdemo.et an ET initialization file that includes Tix
+# It should be translated into C code by et2c
+# and then compiled into etdemo.o
+#
+# et42.o compiled from et42.c that came with ET.
+#
+
+etwish+tix:
+ ld etdemo.o libtixsam4.1.7.6.so et42.o -ltcl -ltk -o etwish+tix
diff --git a/tix/demos/et/README b/tix/demos/et/README
new file mode 100644
index 00000000000..5f5d921f9df
--- /dev/null
+++ b/tix/demos/et/README
@@ -0,0 +1,9 @@
+This directory is intended only for those who are already using ET and
+would like to use Tix in their ET-enabled applications.
+
+The file etdemo.et demonstrates how the stand-alone module of Tix can
+be used in an ET application. You should have et2c installed in your
+system and should know how to compile ET-enabled applications.
+
+For more information on ET, please see docs/ET.txt.
+For more information on stand-alone modules, see unix-sam/README.
diff --git a/tix/demos/et/etdemo.et b/tix/demos/et/etdemo.et
new file mode 100644
index 00000000000..b46eaca6003
--- /dev/null
+++ b/tix/demos/et/etdemo.et
@@ -0,0 +1,52 @@
+/*
+ * etdemo.et --
+ *
+ * This file demonstrates how the stand-alone module of Tix can be
+ * used in an ET application.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <stdio.h>
+
+int main(int argc, char **argv)
+{
+ /*
+ * Initialize ET, this will load the TCL and TK libraries and call
+ * Tcl_Init() and Tk_Init() for you.
+ */
+
+ Et_Init(&argc,argv);
+
+ /*
+ * Initialize the stand-alone version of Tix.
+ */
+
+ if (Tixsam_Init(Et_Interp) != ET_OK ){
+ fprintf(stderr,"Can't initialize the Tix extension.\n");
+ exit(1);
+ }
+
+
+ /*
+ * Now put your code here. As an example, I just "source" in the file
+ * test.tcl in the curent directory. Notice this file is loaded in
+ * dynamically. If you want to load in test.tcl statically, you should
+ * use ET_INCLUDE(test.tcl) instead. Please consult your ET manual
+ * for more details.
+ */
+
+ /* ET(source test.tcl); */
+
+ /*
+ * Go into the ET mainloop. This won't return until the application
+ * exits.
+ */
+
+ Et_MainLoop();
+ return 0;
+}
diff --git a/tix/demos/samples/AllSampl.tcl b/tix/demos/samples/AllSampl.tcl
new file mode 100644
index 00000000000..55c7d5a46de
--- /dev/null
+++ b/tix/demos/samples/AllSampl.tcl
@@ -0,0 +1,193 @@
+# AllSampl.tcl --
+#
+# This file is a directory of all the sample programs in the
+# demos/samples subdirectory.
+#
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+#
+
+# The following data structures contains information about the requirements
+# of the sample programs, as well as the relationship/grouping of the sample
+# programs.
+#
+# Each element in an info list has four parts: type, name, group/filename, and
+# condition. A group or a file is loaded only if the conditions are met.
+#
+# types: "d" directory "f" file
+# conditions:
+# "i": an image type must exist
+# "c": a command must exist
+# "v": a variable must exist
+
+set root {
+ {d "File Selectors" file }
+ {d "Hierachical ListBox" hlist }
+ {d "Tabular ListBox" tlist {c tixTList}}
+ {d "Grid Widget" grid {c tixGrid}}
+ {d "Manager Widgets" manager }
+ {d "Scrolled Widgets" scroll }
+ {d "Miscellaneous Widgets" misc }
+ {d "Image Types" image }
+}
+
+set image {
+ {d "Compound Image" cmpimg }
+ {d "XPM Image" xpm {i pixmap}}
+}
+
+set cmpimg {
+ {f "In Buttons" CmpImg.tcl }
+ {f "In NoteBook" CmpImg2.tcl }
+ {f "Notebook Color Tabs" CmpImg4.tcl }
+ {f "Icons" CmpImg3.tcl }
+}
+
+set xpm {
+ {f "In Button" Xpm.tcl {i pixmap}}
+ {f "In Menu" Xpm1.tcl {i pixmap}}
+}
+
+set file {
+ {f DirList DirList.tcl }
+ {f DirTree DirTree.tcl }
+ {f DirSelectDialog DirDlg.tcl }
+ {f ExFileSelectDialog EFileDlg.tcl }
+ {f FileSelectDialog FileDlg.tcl }
+ {f FileEntry FileEnt.tcl }
+}
+
+set hlist {
+ {f HList HList1.tcl }
+ {f CheckList ChkList.tcl {c tixCheckList}}
+ {f "ScrolledHList (1)" SHList.tcl }
+ {f "ScrolledHList (2)" SHList2.tcl }
+ {f Tree Tree.tcl }
+ {f "Tree (Dynamic)" DynTree.tcl {v win}}
+}
+
+set tlist {
+ {f "ScrolledTList (1)" STList1.tcl {c tixTList}}
+ {f "ScrolledTList (2)" STList2.tcl {c tixTList}}
+ {f "TList File Viewer" STList3.tcl {c tixTList}}
+}
+
+set grid {
+ {f "Simple Grid" SGrid0.tcl {c tixGrid}}
+ {f "ScrolledGrid" SGrid1.tcl {c tixGrid}}
+ {f "Editable Grid" EditGrid.tcl {c tixGrid}}
+}
+
+set scroll {
+ {f ScrolledListBox SListBox.tcl }
+ {f ScrolledText SText.tcl }
+ {f ScrolledWindow SWindow.tcl }
+ {f "Canvas Object View" CObjView.tcl {c tixCObjView}}
+}
+
+set manager {
+ {f ListNoteBook ListNBK.tcl }
+ {f NoteBook NoteBook.tcl }
+ {f PanedWindow PanedWin.tcl }
+}
+
+set misc {
+ {f Balloon Balloon.tcl }
+ {f ButtonBox BtnBox.tcl }
+ {f ComboBox ComboBox.tcl }
+ {f Control Control.tcl }
+ {f LabelEntry LabEntry.tcl }
+ {f LabelFrame LabFrame.tcl }
+ {f Meter Meter.tcl {c tixMeter}}
+ {f OptionMenu OptMenu.tcl }
+ {f PopupMenu PopMenu.tcl }
+ {f Select Select.tcl }
+ {f StdButtonBox StdBBox.tcl }
+}
+
+# ForAllSamples --
+#
+# Iterates over all the samples that can be run on this platform.
+#
+# Arguments:
+# name: For outside callers, it must be "root"
+# token: An arbtrary string passed in by the caller.
+# command: Command prefix to be executed for each node
+# in the samples hierarchy. It should return the
+# token of the node that it has just created, if any.
+#
+proc ForAllSamples {name token command} {
+ global $name win
+
+ if {[tix platform] == "windows"} {
+ set win 1
+ }
+
+ foreach line [set $name] {
+ set type [lindex $line 0]
+ set text [lindex $line 1]
+ set dest [lindex $line 2]
+ set cond [lindex $line 3]
+
+ case [lindex $cond 0] {
+ c {
+ set cmd [lindex $cond 1]
+ if {[info command $cmd] != $cmd} {
+ if ![auto_load $cmd] {
+ continue
+ }
+ }
+ }
+ i {
+ if {[lsearch [image types] [lindex $cond 1]] == -1} {
+ continue
+ }
+ }
+ v {
+ set doit 1
+ foreach var [lrange $cond 1 end] {
+ if [uplevel #0 info exists [list $var]] {
+ set doit 0
+ break
+ }
+ }
+ if !$doit {
+ continue
+ }
+ }
+ }
+
+
+ if {$type == "d"} {
+ set tok [eval $command [list $token] $type [list $text] \
+ [list $dest]]
+ ForAllSamples $dest $tok $command
+ eval $command [list $tok] done xx xx
+ } else {
+ set tok [eval $command [list $token] $type [list $text] \
+ [list $dest]]
+ }
+ }
+}
+
+
+proc DoAll {hlist {path ""}} {
+ catch {
+ set theSample [$hlist info data $path]
+ if {$theSample != {}} {
+ set title [lindex $theSample 0]
+ set prog [lindex $theSample 1]
+
+ RunProg $title $prog
+ update
+ }
+ }
+
+ foreach p [$hlist info children $path] {
+ DoAll $hlist $p
+ }
+}
diff --git a/tix/demos/samples/ArrowBtn.tcl b/tix/demos/samples/ArrowBtn.tcl
new file mode 100644
index 00000000000..4fa7692f33d
--- /dev/null
+++ b/tix/demos/samples/ArrowBtn.tcl
@@ -0,0 +1,183 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates how to write a new Tix widget class.
+#
+
+# ArrowBtn.tcl --
+#
+# Arrow Button: a sample Tix widget.
+#
+set arrow(n) [image create bitmap -data {
+ #define up_width 15
+ #define up_height 15
+ static unsigned char up_bits[] = {
+ 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
+ 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
+ 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
+}]
+set arrow(w) [image create bitmap -data {
+ #define left_width 15
+ #define left_height 15
+ static unsigned char left_bits[] = {
+ 0x00, 0x00, 0x40, 0x00, 0x60, 0x00, 0x70, 0x00, 0x78, 0x00, 0x7c, 0x00,
+ 0xfe, 0x3f, 0xff, 0x3f, 0xfe, 0x3f, 0x7c, 0x00, 0x78, 0x00, 0x70, 0x00,
+ 0x60, 0x00, 0x40, 0x00, 0x00, 0x00};
+}]
+set arrow(s) [image create bitmap -data {
+ #define down_width 15
+ #define down_height 15
+ static unsigned char down_bits[] = {
+ 0x00, 0x00, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
+ 0xc0, 0x01, 0xc0, 0x01, 0xfe, 0x3f, 0xfc, 0x1f, 0xf8, 0x0f, 0xf0, 0x07,
+ 0xe0, 0x03, 0xc0, 0x01, 0x80, 0x00};
+}]
+set arrow(e) [image create bitmap -data {
+ #define right_width 15
+ #define right_height 15
+ static unsigned char right_bits[] = {
+ 0x00, 0x00, 0x00, 0x01, 0x00, 0x03, 0x00, 0x07, 0x00, 0x0f, 0x00, 0x1f,
+ 0xfe, 0x3f, 0xfe, 0x7f, 0xfe, 0x3f, 0x00, 0x1f, 0x00, 0x0f, 0x00, 0x07,
+ 0x00, 0x03, 0x00, 0x01, 0x00, 0x00};
+}]
+
+tixWidgetClass tixArrowButton {
+ -classname TixArrowButton
+ -superclass tixPrimitive
+ -method {
+ flash invoke invert
+ }
+ -flag {
+ -direction -state
+ }
+ -configspec {
+ {-direction direction Direction e tixArrowButton:CheckDirection}
+ {-state state State normal}
+ }
+ -alias {
+ {-dir -direction}
+ }
+}
+
+proc tixArrowButton:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+ set data(count) 0
+}
+
+proc tixArrowButton:ConstructWidget {w} {
+ upvar #0 $w data
+ global arrow
+
+ tixChainMethod $w ConstructWidget
+
+ set data(w:button) [button $w.button -image $arrow($data(-direction))]
+ pack $data(w:button) -expand yes -fill both
+}
+
+proc tixArrowButton:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ bind $data(w:button) <1> "tixArrowButton:IncrCount $w"
+}
+
+proc tixArrowButton:IncrCount {w} {
+ upvar #0 $w data
+
+ incr data(count)
+}
+
+proc tixArrowButton:CheckDirection {dir} {
+ if {[lsearch {n w s e} $dir] != -1} {
+ return $dir
+ } else {
+ error "wrong direction value \"$dir\""
+ }
+}
+
+proc tixArrowButton:flash {w} {
+ upvar #0 $w data
+
+ $data(w:button) flash
+}
+
+proc tixArrowButton:invoke {w} {
+ upvar #0 $w data
+
+ $data(w:button) invoke
+}
+
+proc tixArrowButton:invert {w} {
+ upvar #0 $w data
+
+ set curDirection $data(-direction)
+ case $curDirection {
+ n {
+ set newDirection s
+ }
+ s {
+ set newDirection n
+ }
+ e {
+ set newDirection w
+ }
+ w {
+ set newDirection e
+ }
+ }
+ $w config -direction $newDirection
+}
+
+proc tixArrowButton:config-direction {w value} {
+ upvar #0 $w data
+ global arrow
+
+ $data(w:button) configure -image $arrow($value)
+}
+
+proc tixArrowButton:config-state {w value} {
+ upvar #0 $w data
+ global arrow
+
+ $data(w:button) configure -state $value
+}
+
+#----------------------------------------------------------------------
+#
+# Instantiate several widgets of the tixArrowButton class
+#
+#----------------------------------------------------------------------
+
+proc RunSample {w} {
+ set top [frame $w.top -border 1 -relief raised]
+ tixArrowButton $top.a -dir w
+ tixArrowButton $top.b -dir e
+
+ pack $top.a $top.b -side left -expand yes -fill both -padx 50 -pady 10
+
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind .demo <Destroy> "exit"
+}
diff --git a/tix/demos/samples/Balloon.tcl b/tix/demos/samples/Balloon.tcl
new file mode 100644
index 00000000000..63ea7a24f20
--- /dev/null
+++ b/tix/demos/samples/Balloon.tcl
@@ -0,0 +1,44 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixBalloon widget, which provides
+# a interesting way to give help tips about elements in your user interface.
+# Your can display the help message in a "balloon" and a status bar widget.
+#
+proc RunSample {w} {
+
+ # Create the status bar widget
+ #
+ label $w.status -width 40 -relief sunken -bd 1
+ pack $w.status -side bottom -fill y -padx 2 -pady 1
+
+ # These are two a mysterious widgets that need some explanation
+ #
+ button $w.button1 -text " Something Unexpected " \
+ -command "destroy $w"
+ button $w.button2 -text " Something Else Unexpected " \
+ -command "destroy $w.button2"
+ pack $w.button1 $w.button2 -side top -expand yes
+
+ # Create the balloon widget and associate it with the widgets that we want
+ # to provide tips for:
+ tixBalloon $w.b -statusbar $w.status
+
+ $w.b bind $w.button1 -balloonmsg "Close window" \
+ -statusmsg "Press this button to close this window"
+ $w.b bind $w.button2 -balloonmsg "Self-destruct\nButton" \
+ -statusmsg "Press this button and it will get rid of itself"
+}
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> {if {"%W" == ".demo"} exit}
+}
diff --git a/tix/demos/samples/BtnBox.tcl b/tix/demos/samples/BtnBox.tcl
new file mode 100644
index 00000000000..2b8f8103205
--- /dev/null
+++ b/tix/demos/samples/BtnBox.tcl
@@ -0,0 +1,53 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixButtonBox widget, which is a
+# group of TK buttons. You can use it to manage the buttons in a dialog box,
+# for example.
+#
+proc RunSample {w} {
+
+ # Create the label on the top of the dialog box
+ #
+ label $w.top -padx 20 -pady 10 -border 1 -relief raised -anchor c -text \
+ "This dialog box is\n a demostration of the\n tixButtonBox widget"
+
+ # Create the button box and add a few buttons in it. Set the
+ # -width of all the buttons to the same value so that they
+ # appear in the same size.
+ #
+ # Note that the -text, -underline, -command and -width options are all
+ # standard options of the button widgets.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text OK -underline 0 -command "destroy $w" -width 5
+ $w.box add close -text Close -underline 0 -command "destroy $w" -width 5
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+
+ # "after 0" is used so that the key bindings won't interfere with
+ # tkTraverseMenu
+ #
+ bind [winfo toplevel $w] <Alt-o> \
+ "after 0 tkButtonInvoke [$w.box subwidget ok]"
+ bind [winfo toplevel $w] <Alt-c> \
+ "after 0 tkButtonInvoke [$w.box subwidget close]"
+ bind [winfo toplevel $w] <Escape> \
+ "after 0 tkButtonInvoke [$w.box subwidget close]"
+
+ focus [$w.box subwidget ok]
+}
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/CObjView.tcl b/tix/demos/samples/CObjView.tcl
new file mode 100644
index 00000000000..891d6cf5fb7
--- /dev/null
+++ b/tix/demos/samples/CObjView.tcl
@@ -0,0 +1,85 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This program demonstrates the use of the CObjView (Canvas Object
+# View) class.
+#
+
+
+proc RunSample {w} {
+ label $w.lab -justify left -text \
+"Click on the buttons to add or delete canvas
+objects randomally. Notice the scrollbars automatically
+adjust to include all objects in the scroll-region."
+
+ pack $w.lab -anchor c -padx 10 -pady 6
+ tixCObjView $w.c
+ pack $w.c -expand yes -fill both -padx 4 -pady 2
+ button $w.add -command "CVDemo_Add $w.c" -text Add -width 6
+ button $w.del -command "CVDemo_Delete $w.c" -text Delete -width 6
+ pack $w.add $w.del -side left -padx 20 -pady 10 -anchor c -expand yes
+}
+
+set cvdemo_counter 0
+proc CVDemo_Add {cov} {
+ global cvdemo_counter
+
+ # Generate four pseudo random numbers (x,y,w,h) to define the coordinates
+ # of a rectangle object in the canvas.
+ #
+ set colors {red green blue white black gray yellow}
+
+ set px [expr [lindex [time update] 0] + $cvdemo_counter]
+ set py [expr [lindex [time update] 0] + $cvdemo_counter]
+ set pw [expr [lindex [time update] 0] + $cvdemo_counter]
+ set ph [expr [lindex [time update] 0] + $cvdemo_counter]
+ set pc [expr [lindex [time update] 0] + $cvdemo_counter]
+
+ set x [expr (20 - ($px % 37)) * 10]
+ set y [expr (10 - ($py % 23)) * 10]
+ set w [expr ($pw % 17) * 10]
+ set h [expr ($ph % 17) * 10]
+
+ # Create the canvas object
+ #
+ $cov subwidget canvas create rectangle $x $y [expr $x+$w] [expr $y+$h] \
+ -fill [lindex $colors [expr $pc % [llength $colors]]]
+
+ # Call the adjustscrollregion command to set the scroll bars so that all
+ # objects are included in the scroll-region
+ #
+ $cov adjustscrollregion
+
+ # This number acts as the seed for the next round of randomization.
+ #
+ set cvdemo_counter [expr ($px % 37)]
+}
+
+proc CVDemo_Delete {cov} {
+ set px [lindex [time update] 0]
+ set w [$cov subwidget canvas]
+ set items [$w find withtag all]
+
+ if [string compare $items ""] {
+ # There are items in the canvas, randomally delete one of them
+ # and re-adjust the scroll-region
+ #
+ set toDelete [expr $px % [llength $items]]
+ $w delete [lindex $items $toDelete]
+
+ $cov adjustscrollregion
+ }
+}
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/ChkList.tcl b/tix/demos/samples/ChkList.tcl
new file mode 100644
index 00000000000..44603b4db3f
--- /dev/null
+++ b/tix/demos/samples/ChkList.tcl
@@ -0,0 +1,175 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This program demonstrates the use of the tixCheckList widget.
+#
+
+proc RunSample {w} {
+ set top [frame $w.f -bd 1 -relief raised]
+ set box [tixButtonBox $w.b -bd 1 -relief raised]
+
+ pack $box -side bottom -fill both
+ pack $top -side top -fill both -expand yes
+
+ #------------------------------------------------------------
+ # Create the 1st CheckList (Multiple Selection)
+ #
+ set f [frame $top.f1]
+ pack $f -side left -expand yes -fill both -padx 4
+
+ set l [label $f.l -text "Choose languages: "]
+ pack $l -side top -fill x -padx 4 -pady 4
+
+ set c1 [tixCheckList $f.c -scrollbar auto]
+ pack $c1 -expand yes -fill both -padx 4 -pady 4
+
+ set b1 [button $f.btn -text "Results >>" -command "ChkList_Result $c1"]
+ pack $b1 -anchor c
+ #------------------------------------------------------------
+ # Create the 2nd CheckList (Single Selection, using the -radio option)
+ #
+ set f [frame $top.f2]
+ pack $f -side left -expand yes -fill both -padx 4
+
+ set l [label $f.l -text "Choose one language: "]
+ pack $l -side top -fill x -padx 4 -pady 4
+
+ set c2 [tixCheckList $f.c -scrollbar auto -radio true]
+ pack $c2 -expand yes -fill both -padx 4 -pady 4
+
+ # Fill up the two checklists with languages
+ #
+ set names(1) "Ada"
+ set names(2) "BCPL"
+ set names(3) "C"
+ set names(4) "Dylan"
+ set names(5) "Eiffle"
+ set names(6) "Fortran"
+ set names(7) "Incr Tcl"
+ set names(8) "Matlab"
+ set names(9) "Scheme"
+ set names(0) "TCL"
+
+ set h1 [$c1 subwidget hlist]
+ set h2 [$c2 subwidget hlist]
+
+ foreach ent {1 2 3 4 5 6 7 8 9 0} {
+ $h1 add $ent -itemtype imagetext -text $names($ent)
+ }
+
+ foreach ent {1 2 3 4 5 6 7 8 9 0} {
+ $h2 add $ent -itemtype imagetext -text $names($ent)
+ $c2 setstatus $ent off
+ }
+
+ $c1 setstatus 1 on
+ $c1 setstatus 2 on
+ $c1 setstatus 3 default
+ $c1 setstatus 4 off
+ $c1 setstatus 5 off
+ $c1 setstatus 6 on
+ $c1 setstatus 7 off
+ $c1 setstatus 8 off
+ $c1 setstatus 9 on
+ $c1 setstatus 0 default
+
+
+ #------------------------------------------------------------
+ # Create the 3nd CheckList (a tree). Also, we disable some
+ # sub-selections if the top-level selections are not selected.
+ # i.e., if the user doesn't like any functional languages,
+ # make sure he doesn't select Lisp.
+ #
+ set f [frame $top.f3]
+ pack $f -side left -expand yes -fill both -padx 4
+
+ set l [label $f.l -text "Choose languages: "]
+ pack $l -side top -fill x -padx 4 -pady 4
+
+ set c3 [tixCheckList $f.c -scrollbar auto -options {
+ hlist.indicator 1
+ hlist.indent 20
+ }]
+ pack $c3 -expand yes -fill both -padx 4 -pady 4
+
+ set h3 [$c3 subwidget hlist]
+
+ $h3 add 0 -itemtype imagetext -text "Functional Languages"
+ $h3 add 1 -itemtype imagetext -text "Imperative Languages"
+
+ $h3 add 0.0 -itemtype imagetext -text Lisp
+ $h3 add 0.1 -itemtype imagetext -text Scheme
+ $h3 add 1.0 -itemtype imagetext -text C
+ $h3 add 1.1 -itemtype imagetext -text Pascal
+
+ $c3 setstatus 0 on
+ $c3 setstatus 1 on
+ $c3 setstatus 0.0 off
+ $c3 setstatus 0.1 off
+ $c3 setstatus 1.0 on
+ $c3 setstatus 1.1 off
+
+ $c3 config -browsecmd "ChkList:Monitor $c3"
+ $c3 config -command "ChkList:Monitor $c3"
+
+ $c3 autosetmode
+
+ global chklist
+ set chklist(disabled) [tixDisplayStyle imagetext -fg gray48 \
+ -refwindow [$c3 subwidget hlist]]
+ set chklist(normal) [tixDisplayStyle imagetext -fg black \
+ -refwindow [$c3 subwidget hlist]]
+
+ # Create the buttons
+ #
+ $box add ok -text Ok -command "destroy $w" -width 6
+ $box add cancel -text Cancel -command "destroy $w" -width 6
+}
+
+proc ChkList_Result {clist} {
+ puts "Selected items: [$clist getselection on]"
+ puts "Unselected items: [$clist getselection off]"
+ puts "Default items: [$clist getselection default]"
+}
+
+# This function monitors if any of the two "general groups"
+# (functional and imperative languages) are de-selected. If so, it
+# sets all the sub-selections to non-selectable by setting their -state
+# to disabled.
+#
+proc ChkList:Monitor {c3 ent} {
+ global chklist
+
+ set h [$c3 subwidget hlist]
+
+ if {[$c3 getstatus 0] == "on"} {
+ set state normal
+ } else {
+ set state disabled
+ }
+
+ $h entryconfig 0.0 -state $state -style $chklist($state)
+ $h entryconfig 0.1 -state $state -style $chklist($state)
+
+ if {[$c3 getstatus 1] == "on"} {
+ set state normal
+ } else {
+ set state disabled
+ }
+
+ $h entryconfig 1.0 -state $state -style $chklist($state)
+ $h entryconfig 1.1 -state $state -style $chklist($state)
+}
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/CmpImg.tcl b/tix/demos/samples/CmpImg.tcl
new file mode 100644
index 00000000000..54ee60fcabd
--- /dev/null
+++ b/tix/demos/samples/CmpImg.tcl
@@ -0,0 +1,60 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the compound images: it uses compound
+# images to display a text string together with a pixmap inside
+# buttons
+#
+proc RunSample {w} {
+
+ set img0 [tix getimage network]
+ set img1 [tix getimage harddisk]
+
+ button $w.hdd -padx 4 -pady 1 -width 120
+ button $w.net -padx 4 -pady 1 -width 120
+
+ # Create the first image: we create a line, then put a string,
+ # a space and a image into this line, from left to right.
+ # The result: we have a one-line image that consists of three
+ # individual items
+ #
+ set hdd_img [image create compound -window $w.hdd]
+ $hdd_img add line
+ $hdd_img add text -text "Hard Disk" -underline 0
+ $hdd_img add space -width 7
+ $hdd_img add image -image $img1
+
+ # Put this image into the first button
+ #
+ $w.hdd config -image $hdd_img
+
+ # Create the second compound image. Very similar to what we did above
+ #
+ set net_img [image create compound -window $w.net]
+ $net_img add line
+ $net_img add text -text "Network" -underline 0
+ $net_img add space -width 7
+ $net_img add image -image $img0
+
+ $w.net config -image $net_img
+
+ # The button to close the window
+ #
+
+ button $w.clo -pady 1 -text Close -command "destroy $w"
+
+ pack $w.hdd $w.net $w.clo -side left -padx 10 -pady 10 -fill y -expand yes
+}
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind .demo <Destroy> exit
+}
diff --git a/tix/demos/samples/CmpImg1.tcl b/tix/demos/samples/CmpImg1.tcl
new file mode 100644
index 00000000000..59109dca6c4
--- /dev/null
+++ b/tix/demos/samples/CmpImg1.tcl
@@ -0,0 +1,178 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixNoteBook widget, which allows
+# you to lay out your interface using a "notebook" metaphore
+#
+
+proc RunSample {w} {
+
+ # We use these options to set the sizes of the subwidgets inside the
+ # notebook, so that they are well-aligned on the screen.
+ #
+ set name [tixOptionName $w]
+ option add *$name*TixControl*entry.width 10
+ option add *$name*TixControl*label.width 18
+ option add *$name*TixControl*label.anchor e
+ option add *$name*TixNoteBook*tabPadX 8
+
+ # Create the notebook widget and set its backpagecolor to gray.
+ # Note that the -backpagecolor option belongs to the "nbframe"
+ # subwidget.
+ tixNoteBook $w.nb -ipadx 6 -ipady 6
+ $w config -bg gray
+ $w.nb subwidget nbframe config -backpagecolor gray -tabpady 0
+
+ # Create the two tabs on the notebook. The -underline option
+ # puts a underline on the first character of the labels of the tabs.
+ # Keyboard accelerators will be defined automatically according
+ # to the underlined character.
+ #
+ global network_pixmap hard_disk_pixmap
+ set img0 [image create pixmap -data $network_pixmap]
+ set img1 [image create pixmap -data $hard_disk_pixmap]
+
+ set hd_img [image create compound -window [$w.nb subwidget nbframe]]
+ $hd_img add line
+ $hd_img add text -text "Hard Disk" -underline 0
+ $hd_img add space -width 7
+ $hd_img add image -image $img1
+
+ $w.nb add hard_disk -image $hd_img
+
+ set net_img [image create compound -window [$w.nb subwidget nbframe]]
+ $net_img add line
+ $net_img add text -text "Network" -underline 0
+ $net_img add space -width 7
+ $net_img add image -image $img0
+
+ $w.nb add network -image $net_img
+ # Create the first page
+ #
+ set f [$w.nb subwidget hard_disk]
+
+ tixControl $f.a -value 12 -label "Access Time: "
+ tixControl $f.w -value 400 -label "Write Throughput: "
+ tixControl $f.r -value 400 -label "Read Throughput: "
+ tixControl $f.c -value 1021 -label "Capacity: "
+ pack $f.a $f.w $f.r $f.c -side top -padx 20 -pady 2
+
+ # Create the second page
+ #
+ set f [$w.nb subwidget network]
+
+ tixControl $f.a -value 12 -label "Access Time: "
+ tixControl $f.w -value 400 -label "Write Throughput: "
+ tixControl $f.r -value 400 -label "Read Throughput: "
+ tixControl $f.c -value 1021 -label "Capacity: "
+ tixControl $f.u -value 10 -label "Users: "
+
+ pack $f.a $f.w $f.r $f.c $f.u -side top -padx 20 -pady 2
+ pack $w.nb -expand yes -fill both -padx 5 -pady 5
+
+}
+
+set network_pixmap {/* XPM */
+static char * netw_xpm[] = {
+/* width height ncolors chars_per_pixel */
+"32 32 7 1",
+/* colors */
+" s None c None",
+". c #000000000000",
+"X c white",
+"o c #c000c000c000",
+"O c #404040",
+"+ c blue",
+"@ c red",
+/* pixels */
+" ",
+" .............. ",
+" .XXXXXXXXXXXX. ",
+" .XooooooooooO. ",
+" .Xo.......XoO. ",
+" .Xo.++++o+XoO. ",
+" .Xo.++++o+XoO. ",
+" .Xo.++oo++XoO. ",
+" .Xo.++++++XoO. ",
+" .Xo.+o++++XoO. ",
+" .Xo.++++++XoO. ",
+" .Xo.XXXXXXXoO. ",
+" .XooooooooooO. ",
+" .Xo@ooo....oO. ",
+" .............. .XooooooooooO. ",
+" .XXXXXXXXXXXX. .XooooooooooO. ",
+" .XooooooooooO. .OOOOOOOOOOOO. ",
+" .Xo.......XoO. .............. ",
+" .Xo.++++o+XoO. @ ",
+" .Xo.++++o+XoO. @ ",
+" .Xo.++oo++XoO. @ ",
+" .Xo.++++++XoO. @ ",
+" .Xo.+o++++XoO. @ ",
+" .Xo.++++++XoO. ..... ",
+" .Xo.XXXXXXXoO. .XXX. ",
+" .XooooooooooO.@@@@@@.X O. ",
+" .Xo@ooo....oO. .OOO. ",
+" .XooooooooooO. ..... ",
+" .XooooooooooO. ",
+" .OOOOOOOOOOOO. ",
+" .............. ",
+" "};}
+
+set hard_disk_pixmap {/* XPM */
+static char * drivea_xpm[] = {
+/* width height ncolors chars_per_pixel */
+"32 32 5 1",
+/* colors */
+" s None c None",
+". c #000000000000",
+"X c white",
+"o c #c000c000c000",
+"O c #800080008000",
+/* pixels */
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" .......................... ",
+" .XXXXXXXXXXXXXXXXXXXXXXXo. ",
+" .XooooooooooooooooooooooO. ",
+" .Xooooooooooooooooo..oooO. ",
+" .Xooooooooooooooooo..oooO. ",
+" .XooooooooooooooooooooooO. ",
+" .Xoooooooo.......oooooooO. ",
+" .Xoo...................oO. ",
+" .Xoooooooo.......oooooooO. ",
+" .XooooooooooooooooooooooO. ",
+" .XooooooooooooooooooooooO. ",
+" .XooooooooooooooooooooooO. ",
+" .XooooooooooooooooooooooO. ",
+" .oOOOOOOOOOOOOOOOOOOOOOOO. ",
+" .......................... ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" ",
+" "};}
+
+
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind .demo <Destroy> exit
+}
diff --git a/tix/demos/samples/CmpImg2.tcl b/tix/demos/samples/CmpImg2.tcl
new file mode 100644
index 00000000000..90f79432a84
--- /dev/null
+++ b/tix/demos/samples/CmpImg2.tcl
@@ -0,0 +1,132 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates how to use the compound image inside NoteBook
+# widgets. This file is basically a cross-over of NoteBook.tcl and CmpImg.tcl
+#
+proc RunSample {w} {
+
+ # Create the notebook widget and set its backpagecolor to gray.
+ # Note that the -backpagecolor option belongs to the "nbframe"
+ # subwidget.
+ tixNoteBook $w.nb -ipadx 6 -ipady 6
+ $w config -bg gray
+ $w.nb subwidget nbframe config -backpagecolor gray -tabpady 0
+
+ # Create the two compound images
+ #
+ #
+
+ # these are two Tix built-in images
+ #
+ set img0 [tix getimage network]
+ set img1 [tix getimage harddisk]
+
+ # Create the first image:
+ #
+ # Notice that the -window option must be set to the nbframe
+ # subwidget of the notebook because the image will be displayed
+ # in that widget.
+ #
+ set hdd_img [image create compound -window [$w.nb subwidget nbframe] \
+ -pady 0]
+ $hdd_img add line
+ $hdd_img add image -image $img1
+ $hdd_img add space -width 7
+ $hdd_img add text -text "Hard Disk" -underline 0
+
+ # Create the second compound image. Very similar to what we did above
+ #
+ set net_img [image create compound -window [$w.nb subwidget nbframe] \
+ -pady 0]
+ $net_img add line
+ $net_img add image -image $img0
+ $net_img add space -width 7
+ $net_img add text -text "Network" -underline 0
+
+ #
+ # Now create the pages
+ #
+
+ # We use these options to set the sizes of the subwidgets inside the
+ # notebook, so that they are well-aligned on the screen.
+ #
+ set name [tixOptionName $w]
+ option add *$name*TixControl*entry.width 10
+ option add *$name*TixControl*label.width 18
+ option add *$name*TixControl*label.anchor e
+
+ # Create the two tabs on the notebook. The -underline option
+ # puts a underline on the first character of the labels of the tabs.
+ # Keyboard accelerators will be defined automatically according
+ # to the underlined character.
+ #
+ $w.nb add hard_disk -image $hdd_img
+ $w.nb add network -image $net_img
+ pack $w.nb -expand yes -fill both -padx 5 -pady 5 -side top
+
+ #----------------------------------------
+ # Create the first page
+ #----------------------------------------
+ set f [$w.nb subwidget hard_disk]
+
+ # Create two frames: one for the common buttons, one for the
+ # other widgets
+ #
+ frame $f.f
+ frame $f.common
+ pack $f.f -side left -padx 2 -pady 2 -fill both -expand yes
+ pack $f.common -side right -padx 2 -pady 2 -fill y
+
+ # Create the controls that only belong to this page
+ #
+ tixControl $f.f.a -value 12 -label "Access Time: "
+ tixControl $f.f.w -value 400 -label "Write Throughput: "
+ tixControl $f.f.r -value 400 -label "Read Throughput: "
+ tixControl $f.f.c -value 1021 -label "Capacity: "
+ pack $f.f.a $f.f.w $f.f.r $f.f.c -side top -padx 20 -pady 2
+
+ # Create the common buttons
+ #
+ CreateCommonButtons $w $f.common
+
+ #----------------------------------------
+ # Create the second page
+ #----------------------------------------
+ set f [$w.nb subwidget network]
+
+ frame $f.f
+ frame $f.common
+ pack $f.f -side left -padx 2 -pady 2 -fill both -expand yes
+ pack $f.common -side right -padx 2 -pady 2 -fill y
+
+ tixControl $f.f.a -value 12 -label "Access Time: "
+ tixControl $f.f.w -value 400 -label "Write Throughput: "
+ tixControl $f.f.r -value 400 -label "Read Throughput: "
+ tixControl $f.f.c -value 1021 -label "Capacity: "
+ tixControl $f.f.u -value 10 -label "Users: "
+
+ pack $f.f.a $f.f.w $f.f.r $f.f.c $f.f.u -side top -padx 20 -pady 2
+
+ CreateCommonButtons $w $f.common
+}
+
+proc CreateCommonButtons {w f} {
+ button $f.ok -text OK -width 6 -command "destroy $w"
+ button $f.cancel -text Cancel -width 6 -command "destroy $w"
+
+ pack $f.ok $f.cancel -side top -padx 2 -pady 2
+}
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind .demo <Destroy> exit
+}
diff --git a/tix/demos/samples/CmpImg3.tcl b/tix/demos/samples/CmpImg3.tcl
new file mode 100644
index 00000000000..26c08032030
--- /dev/null
+++ b/tix/demos/samples/CmpImg3.tcl
@@ -0,0 +1,86 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# Demonstrates how to use compound images to display icons in a canvas widget.
+#
+
+proc RunSample {w} {
+ set top [frame $w.f -bd 1 -relief raised]
+ set box [tixButtonBox $w.b -bd 1 -relief raised]
+
+ pack $box -side bottom -fill both
+ pack $top -side top -fill both -expand yes
+
+ label $top.lab -text "Drag the icons"
+ pack $top.lab -anchor c -side top -pady 4
+
+ # Create the canvas to display the icons
+ #
+ set c [canvas $top.c -relief sunken -bd 1]
+ pack $c -side top -expand yes -fill both -padx 4 -pady 4
+
+ # create several compound images in the canvas
+ #
+ set network [tix getimage network]
+ set harddisk [tix getimage harddisk]
+
+ set cmp_1 [image create compound -window $c -bd 1]
+ $cmp_1 add image -image $network
+ $cmp_1 add line
+ $cmp_1 add text -text " Network "
+
+ set cmp_2 [image create compound -window $c -bd 1]
+ $cmp_2 add image -image $harddisk
+ $cmp_2 add line
+ $cmp_2 add text -text " Hard disk "
+
+ set cmp_3 [image create compound -window $c -bd 1 \
+ -background #c0c0ff -relief raised \
+ -showbackground 1]
+ $cmp_3 add image -image $network
+ $cmp_3 add line
+ $cmp_3 add text -text " Network 2 "
+
+ $c create image 50 50 -image $cmp_1
+ $c create image 150 50 -image $cmp_2
+ $c create image 250 50 -image $cmp_3
+
+ bind $c <1> "itemStartDrag $c %x %y"
+ bind $c <B1-Motion> "itemDrag $c %x %y"
+
+ # Create the buttons
+ #
+ $box add ok -text Ok -command "destroy $w" -width 6
+ $box add cancel -text Cancel -command "destroy $w" -width 6
+}
+
+
+proc itemStartDrag {c x y} {
+ global lastX lastY
+ $c raise current
+
+ set lastX [$c canvasx $x]
+ set lastY [$c canvasy $y]
+}
+
+proc itemDrag {c x y} {
+ global lastX lastY
+ set x [$c canvasx $x]
+ set y [$c canvasy $y]
+ $c move current [expr $x-$lastX] [expr $y-$lastY]
+ set lastX $x
+ set lastY $y
+}
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/CmpImg4.tcl b/tix/demos/samples/CmpImg4.tcl
new file mode 100644
index 00000000000..95a9e461345
--- /dev/null
+++ b/tix/demos/samples/CmpImg4.tcl
@@ -0,0 +1,121 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates how to use the compound image to add
+# colors in Notebook tabs.
+#
+proc RunSample {w} {
+
+ # Create the notebook widget and set its backpagecolor to gray.
+ # Note that the -backpagecolor option belongs to the "nbframe"
+ # subwidget.
+ tixNoteBook $w.nb -ipadx 6 -ipady 6
+ $w config -bg gray
+ $w.nb subwidget nbframe config -backpagecolor gray -tabpady 0
+
+ # Create the two compound images --
+ #
+ # Create the first image:
+ #
+ # Notice that the -window option must be set to the nbframe
+ # subwidget of the notebook because the image will be displayed
+ # in that widget.
+ #
+ set hdd_img [image create compound -window [$w.nb subwidget nbframe] \
+ -pady 4 -padx 4 -bg #f09090 -showbackground 1]
+ $hdd_img add line
+ $hdd_img add text -text "Hard Disk" -underline 0 -padx 6 -pady 4
+
+ # Create the second compound image. Very similar to what we did above
+ #
+ set net_img [image create compound -window [$w.nb subwidget nbframe] \
+ -pady 4 -pady 4 -bg #9090f0 -showbackground 1]
+ $net_img add line
+ $net_img add text -text "Network" -underline 0 -padx 6 -pady 4
+
+ #
+ # Now create the pages
+ #
+
+ # We use these options to set the sizes of the subwidgets inside the
+ # notebook, so that they are well-aligned on the screen.
+ #
+ set name [tixOptionName $w]
+ option add *$name*TixControl*entry.width 10
+ option add *$name*TixControl*label.width 18
+ option add *$name*TixControl*label.anchor e
+
+ # Create the two tabs on the notebook. The -underline option
+ # puts a underline on the first character of the labels of the tabs.
+ # Keyboard accelerators will be defined automatically according
+ # to the underlined character.
+ #
+ $w.nb add hard_disk -image $hdd_img
+ $w.nb add network -image $net_img
+ pack $w.nb -expand yes -fill both -padx 5 -pady 5 -side top
+
+ #----------------------------------------
+ # Create the first page
+ #----------------------------------------
+ set f [$w.nb subwidget hard_disk]
+
+ # Create two frames: one for the common buttons, one for the
+ # other widgets
+ #
+ frame $f.f
+ frame $f.common
+ pack $f.f -side left -padx 2 -pady 2 -fill both -expand yes
+ pack $f.common -side right -padx 2 -pady 2 -fill y
+
+ # Create the controls that only belong to this page
+ #
+ tixControl $f.f.a -value 12 -label "Access Time: "
+ tixControl $f.f.w -value 400 -label "Write Throughput: "
+ tixControl $f.f.r -value 400 -label "Read Throughput: "
+ tixControl $f.f.c -value 1021 -label "Capacity: "
+ pack $f.f.a $f.f.w $f.f.r $f.f.c -side top -padx 20 -pady 2
+
+ # Create the common buttons
+ #
+ CreateCommonButtons $w $f.common
+
+ #----------------------------------------
+ # Create the second page
+ #----------------------------------------
+ set f [$w.nb subwidget network]
+
+ frame $f.f
+ frame $f.common
+ pack $f.f -side left -padx 2 -pady 2 -fill both -expand yes
+ pack $f.common -side right -padx 2 -pady 2 -fill y
+
+ tixControl $f.f.a -value 12 -label "Access Time: "
+ tixControl $f.f.w -value 400 -label "Write Throughput: "
+ tixControl $f.f.r -value 400 -label "Read Throughput: "
+ tixControl $f.f.c -value 1021 -label "Capacity: "
+ tixControl $f.f.u -value 10 -label "Users: "
+
+ pack $f.f.a $f.f.w $f.f.r $f.f.c $f.f.u -side top -padx 20 -pady 2
+
+ CreateCommonButtons $w $f.common
+}
+
+proc CreateCommonButtons {w f} {
+ button $f.ok -text OK -width 6 -command "destroy $w"
+ button $f.cancel -text Cancel -width 6 -command "destroy $w"
+
+ pack $f.ok $f.cancel -side top -padx 2 -pady 2
+}
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind .demo <Destroy> exit
+}
diff --git a/tix/demos/samples/ComboBox.tcl b/tix/demos/samples/ComboBox.tcl
new file mode 100644
index 00000000000..fb639ed9bcc
--- /dev/null
+++ b/tix/demos/samples/ComboBox.tcl
@@ -0,0 +1,115 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixComboBox widget, which is close
+# to the MS Window Combo Box control.
+#
+proc RunSample {w} {
+
+ # Create the comboboxes on the top of the dialog box
+ #
+ frame $w.top -border 1 -relief raised
+
+ # $w.top.a is a drop-down combo box. It is not editable -- who wants
+ # to invent new months?
+ #
+ # [Hint] The -options switch sets the options of the subwidgets.
+ # [Hint] We set the label.width subwidget option of both comboboxes to
+ # be 10 so that their labels appear to be aligned.
+ #
+ tixComboBox $w.top.a -label "Month: " -dropdown true \
+ -command cbx:select_month -editable false -variable demo_month \
+ -options {
+ listbox.height 6
+ label.width 10
+ label.anchor e
+ }
+
+
+ # $w.top.b is a non-drop-down combo box. It is not editable: we provide
+ # four choices for the user, but he can enter an alternative year if he
+ # wants to.
+ #
+ # [Hint] Use the padY and anchor options of the label subwidget to
+ # aligh the label with the entry subwidget.
+ # [Hint] Notice that you should use padY (the NAME of the option) and not
+ # pady (the SWITCH of the option).
+ #
+ tixComboBox $w.top.b -label "Year: " -dropdown false \
+ -command cbx:select_year -editable true -variable demo_year \
+ -options {
+ listbox.height 4
+ label.padY 5
+ label.width 10
+ label.anchor ne
+ }
+
+ pack $w.top.a -side top -anchor w
+ pack $w.top.b -side top -anchor w
+
+ # Insert the choices into the combo boxes
+ #
+ $w.top.a insert end January
+ $w.top.a insert end February
+ $w.top.a insert end March
+ $w.top.a insert end April
+ $w.top.a insert end May
+ $w.top.a insert end June
+ $w.top.a insert end July
+ $w.top.a insert end August
+ $w.top.a insert end September
+ $w.top.a insert end October
+ $w.top.a insert end November
+ $w.top.a insert end December
+
+ $w.top.b insert end 1992
+ $w.top.b insert end 1993
+ $w.top.b insert end 1994
+ $w.top.b insert end 1995
+
+ # Use "tixSetSilent" to set the values of the combo box if you
+ # don't want your -command procedures (cbx:select_month and
+ # cbx:select_year) to be called.
+ #
+ tixSetSilent $w.top.a January
+ tixSetSilent $w.top.b 1995
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "cbx:okcmd $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+proc cbx:select_year {args} {
+ puts "you have selected \"$args\""
+}
+
+proc cbx:select_month {s} {
+ puts "you have selected \"$s\""
+}
+
+proc cbx:okcmd {w} {
+ global demo_month demo_year
+
+ puts "The month selected is $demo_month of $demo_year"
+ destroy $w
+}
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/Control.tcl b/tix/demos/samples/Control.tcl
new file mode 100644
index 00000000000..d0b09017d33
--- /dev/null
+++ b/tix/demos/samples/Control.tcl
@@ -0,0 +1,129 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixControl widget -- it is an
+# entry widget with up/down arrow buttons. You can use the arrow buttons
+# to adjust the value inside the entry widget.
+#
+# This example program uses three Control widgets. One lets you select
+# integer values; one lets you select floating point values and the last
+# one lets you select a few names.
+#
+proc RunSample {w} {
+
+ # Create the tixControls on the top of the dialog box
+ #
+ frame $w.top -border 1 -relief raised
+
+ # $w.top.a allows only integer values
+ #
+ # [Hint] The -options switch sets the options of the subwidgets.
+ # [Hint] We set the label.width subwidget option of the Controls to
+ # be 16 so that their labels appear to be aligned.
+ #
+ global demo_maker demo_thrust demo_num_engins
+ set demo_maker P&W
+ set demo_thrust 20000.0
+ set demo_num_engins 2
+
+
+ tixControl $w.top.a -label "Number of Engines: " -integer true \
+ -variable demo_num_engins -min 1 -max 4\
+ -options {
+ entry.width 10
+ label.width 20
+ label.anchor e
+ }
+
+ tixControl $w.top.b -label "Thrust: " -integer false \
+ -min 10000.0 -max 60000.0 -step 500\
+ -variable demo_thrust \
+ -options {
+ entry.width 10
+ label.width 20
+ label.anchor e
+ }
+
+ tixControl $w.top.c -label "Engin Maker: " \
+ -incrcmd "ctl:adjust_maker $w.top.c +1" \
+ -decrcmd "ctl:adjust_maker $w.top.c -1" \
+ -validatecmd "ctl:validate_maker $w.top.c" \
+ -value "P&W" \
+ -options {
+ entry.width 10
+ label.width 20
+ label.anchor e
+ }
+
+ pack $w.top.a $w.top.b $w.top.c -side top -anchor w
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "ctl:okcmd $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+set ctl_makers {GE P&W "Rolls Royce"}
+
+# This procedure gets called when the user presses the up/down arrow buttons.
+# We return the "previous" or "next" engin maker according to the "$by"
+# argument
+#
+proc ctl:adjust_maker {w by value} {
+ global ctl_makers
+
+ set index [lsearch $ctl_makers $value]
+ set len [llength $ctl_makers]
+ set index [expr $index $by]
+
+ if {$index < 0} {
+ set index [expr $len -1]
+ }
+ if {$index >= $len} {
+ set index 0
+ }
+
+ return [lindex $ctl_makers $index]
+}
+
+proc ctl:validate_maker {w value} {
+ global ctl_makers
+
+ if {[lsearch $ctl_makers $value] == -1} {
+ return [lindex $ctl_makers 0]
+ } else {
+ return $value
+ }
+}
+
+proc ctl:okcmd {w} {
+ global demo_maker demo_thrust demo_num_engins
+
+ puts "You selected $demo_num_engins engin(s) of thrust $demo_thrust made \
+by $demo_maker"
+
+ destroy $w
+}
+
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/DirDlg.tcl b/tix/demos/samples/DirDlg.tcl
new file mode 100644
index 00000000000..ca0cb34ccdc
--- /dev/null
+++ b/tix/demos/samples/DirDlg.tcl
@@ -0,0 +1,86 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixDirSelectDialog widget:
+# it allows the user to select a directory.
+#
+proc RunSample {w} {
+
+ # Create an entry for the user to input a directory. If he can't
+ # bother to type in the name, he can press the "Browse ..." button
+ # and call up the diretcory dialog
+ #
+ frame $w.top -border 1 -relief raised
+
+ tixLabelEntry $w.top.ent -label "Select A Directory:" -labelside top \
+ -options {
+ entry.width 25
+ entry.textVariable demo_ddlg_dirname
+ label.anchor w
+ }
+ bind [$w.top.ent subwidget entry] <Return> "ddlg:okcmd $w"
+
+ uplevel #0 set demo_ddlg_dirname {}
+
+ button $w.top.btn -text "Browse ..." -command "ddlg:browse"
+
+ pack $w.top.ent -side left -expand yes -fill x -anchor s -padx 4 -pady 4
+ pack $w.top.btn -side left -anchor s -padx 4 -pady 4
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "ddlg:okcmd $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+# Pop up a directory selection dialog
+#
+proc ddlg:browse {} {
+ set dialog .dirdlg_popup
+ if ![winfo exists $dialog] {
+ tixDirSelectDialog $dialog
+ }
+ $dialog config -command ddlg:select_dir
+
+ $dialog popup
+}
+
+proc ddlg:select_dir {dir} {
+ global demo_ddlg_dirname
+
+ set demo_ddlg_dirname $dir
+}
+
+proc ddlg:okcmd {w} {
+ global demo_ddlg_dirname
+
+ if {$demo_ddlg_dirname != {}} {
+ puts "You have selected the directory $demo_ddlg_dirname"
+ } else {
+ puts "You haven't selected any directory"
+ }
+
+ destroy $w
+}
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind .demo <Destroy> exit
+}
diff --git a/tix/demos/samples/DirList.tcl b/tix/demos/samples/DirList.tcl
new file mode 100644
index 00000000000..f1a358a20cd
--- /dev/null
+++ b/tix/demos/samples/DirList.tcl
@@ -0,0 +1,87 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixDirList widget -- you can
+# use it for the user to select a directory. For example, an installation
+# program can use the tixDirList widget to ask the user to select the
+# installation directory for an application.
+#
+proc RunSample {w} {
+
+ # Create the tixDirList and the tixLabelEntry widgets on the on the top
+ # of the dialog box
+ #
+ frame $w.top -border 1 -relief raised
+
+ # Create the DirList widget. By default it will show the current
+ # directory (returned by [pwd])
+ #
+ #
+ tixDirList $w.top.dir
+
+ # When the user presses the ".." button, the selected directory
+ # is "transferred" into the entry widget
+ #
+ button $w.top.btn -text " >> " -pady 0 \
+ -command "dlist:copy_name $w.top.dir"
+
+ # We use a LabelEntry to hold the installation directory. The user
+ # can choose from the DirList widget, or he can type in the directory
+ # manually
+ #
+ tixLabelEntry $w.top.ent -label "Installation Directory:" -labelside top \
+ -options {
+ entry.width 25
+ entry.textVariable demo_dlist_dir
+ label.anchor w
+ }
+ bind [$w.top.ent subwidget entry] <Return> "dlist:okcmd $w"
+
+ uplevel #0 set demo_dlist_dir [list [pwd]]
+
+ pack $w.top.dir -side left -expand yes -fill both -padx 4 -pady 4
+ pack $w.top.btn -side left -anchor s -padx 4 -pady 4
+ pack $w.top.ent -side left -fill x -anchor s -padx 4 -pady 4
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "dlist:okcmd $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+
+proc dlist:copy_name {w} {
+ global demo_dlist_dir
+
+ set demo_dlist_dir [$w cget -value]
+}
+
+proc dlist:okcmd {w} {
+ global demo_dlist_dir
+
+ puts "You have selected the directory $demo_dlist_dir"
+
+ destroy $w
+}
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind .demo <Destroy> "exit"
+}
diff --git a/tix/demos/samples/DirTree.tcl b/tix/demos/samples/DirTree.tcl
new file mode 100644
index 00000000000..08da543f860
--- /dev/null
+++ b/tix/demos/samples/DirTree.tcl
@@ -0,0 +1,88 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixDirList widget -- you can
+# use it for the user to select a directory. For example, an installation
+# program can use the tixDirList widget to ask the user to select the
+# installation directory for an application.
+#
+proc RunSample {w} {
+
+ # Create the tixDirTree and the tixLabelEntry widgets on the on the top
+ # of the dialog box
+ #
+ frame $w.top -border 1 -relief raised
+
+ # Create the DirTree widget. By default it will show the current
+ # directory (returned by [pwd])
+ #
+ #
+ tixDirTree $w.top.dir -browsecmd "dtree:browse $w.top.ent"
+
+ # When the user presses the ".." button, the selected directory
+ # is "transferred" into the entry widget
+ #
+
+ # We use a LabelEntry to hold the installation directory. The user
+ # can choose from the DirTree widget, or he can type in the directory
+ # manually
+ #
+ tixLabelEntry $w.top.ent -label "Installation Directory:" -labelside top \
+ -options {
+ entry.width 25
+ entry.textVariable demo_dtree_dir
+ label.anchor w
+ }
+ bind [$w.top.ent subwidget entry] <Return> "dtree:okcmd $w"
+
+ uplevel #0 set demo_dtree_dir [list [pwd]]
+
+ pack $w.top.dir -side left -expand yes -fill both -padx 4 -pady 4
+ pack $w.top.ent -side left -fill x -anchor c -padx 4 -pady 4
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "dtree:okcmd $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+proc dtree:browse {ent filename} {
+ uplevel #0 set demo_dtree_dir $filename
+
+}
+
+proc dtree:copy_name {w} {
+ global demo_dtree_dir
+
+ set demo_dtree_dir [$w cget -value]
+}
+
+proc dtree:okcmd {w} {
+ global demo_dtree_dir
+
+ puts "You have selected the directory $demo_dtree_dir"
+
+ destroy $w
+}
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind .demo <Destroy> "exit"
+}
diff --git a/tix/demos/samples/DragDrop.tcl b/tix/demos/samples/DragDrop.tcl
new file mode 100644
index 00000000000..1feb61fa271
--- /dev/null
+++ b/tix/demos/samples/DragDrop.tcl
@@ -0,0 +1,46 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the Drag+Drop features in Tix. Drag+Drop is still
+# experimental in Tix. Please don't use. For your eyes only.
+#
+#
+proc RunSample {w} {
+
+ text $w.d -height 5
+ $w.d insert end {Quick and dirty example:
+click on any node on on the directory lists and drag. You can see the
+cursor change its shape. The "dropsite" of the directory lists will be
+highlighted when you drag the cursor accorss the directory nodes.
+Nothing will happen when you drop. }
+
+ pack $w.d -padx 10 -pady 5
+
+ tixDirList $w.d1; pack $w.d1 -fill both -padx 10 -pady 5 \
+ -side left
+ tixDirList $w.d2; pack $w.d2 -fill both -padx 10 -pady 5 \
+ -side left
+
+ button $w.b -text "Close" -command "destroy $w"
+ pack $w.b -side left -anchor c -expand yes
+
+ $w.d1 subwidget hlist config -selectmode dragdrop
+ $w.d2 subwidget hlist config -selectmode dragdrop
+}
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> "exit"
+}
+
diff --git a/tix/demos/samples/DynTree.tcl b/tix/demos/samples/DynTree.tcl
new file mode 100644
index 00000000000..dd63abff77b
--- /dev/null
+++ b/tix/demos/samples/DynTree.tcl
@@ -0,0 +1,145 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates how to use the TixTree widget to display
+# dynamic hierachical data (the files in the Unix file system)
+#
+
+proc RunSample {w} {
+
+ # We create the frame and the ScrolledHList widget
+ # at the top of the dialog box
+ #
+ frame $w.top -relief raised -bd 1
+
+ # Create a TixTree widget to display the hypothetical DOS disk drive
+ #
+ #
+ tixTree $w.top.a -options {
+ hlist.separator "/"
+ hlist.width 35
+ hlist.height 25
+ }
+
+ pack $w.top.a -expand yes -fill both -padx 10 -pady 10 -side left
+
+ set tree $w.top.a
+ set hlist [$tree subwidget hlist]
+
+ $tree config -opencmd "DynTree:OpenDir $tree"
+
+ # Add the root directory the TixTree widget
+ DynTree:AddDir $tree /
+
+ # The / directory is added in the "open" mode. The user can open it
+ # and then browse its subdirectories ...
+
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "destroy $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+proc DynTree:AddDir {tree dir} {
+ set hlist [$tree subwidget hlist]
+
+ if {$dir == "/"} {
+ set text /
+ } else {
+ set text [file tail $dir]
+ }
+
+ $hlist add $dir -itemtype imagetext \
+ -text $text -image [tix getimage folder]
+
+ catch {
+ # We need a catch here because the directory may not be readable by us
+ #
+ $tree setmode $dir none
+ if {[glob -nocomplain $dir/*] != {}} {
+ $tree setmode $dir open
+ }
+ }
+}
+
+
+# This command is called whenever the user presses the (+) indicator or
+# double clicks on a directory whose mode is "open". It loads the files
+# inside that directory into the Tree widget.
+#
+# Note we didn't specify the -closecmd option for the Tree widget, so it
+# performs the default action when the user presses the (-) indicator or
+# double clicks on a directory whose mode is "close": hide all of its child
+# entries
+#
+proc DynTree:OpenDir {tree dir} {
+ set PWD [pwd]
+ set hlist [$tree subwidget hlist]
+
+ if {[$hlist info children $dir] != {}} {
+ # We have already loaded this directory. Let's just
+ # show all the child entries
+ #
+ # Note: since we load the directory only once, it will not be
+ # refreshed if the you add or remove files from this
+ # directory.
+ #
+ foreach kid [$hlist info children $dir] {
+ $hlist show entry $kid
+ }
+ return
+ }
+
+ if [catch {cd $dir}] {
+ # We can't read that directory, better not do anything
+ cd $PWD
+ return
+ }
+
+ set files [lsort [glob -nocomplain *]]
+ foreach f $files {
+ if [file isdirectory $f] {
+ if {$dir == "/"} {
+ set subdir /$f
+ } else {
+ set subdir $dir/$f
+ }
+ DynTree:AddDir $tree $subdir
+ } else {
+ if {$dir == "/"} {
+ set file /$f
+ } else {
+ set file $dir/$f
+ }
+
+ $hlist add $file -itemtype imagetext \
+ -text $f -image [tix getimage file]
+ }
+ }
+
+ cd $PWD
+}
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind .demo <Destroy> exit
+}
+
diff --git a/tix/demos/samples/EFileDlg.tcl b/tix/demos/samples/EFileDlg.tcl
new file mode 100644
index 00000000000..512e71aed59
--- /dev/null
+++ b/tix/demos/samples/EFileDlg.tcl
@@ -0,0 +1,99 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixExFileSelectDialog widget --
+# This is a neat file selection dialog that will make your apps look
+# real good!
+#
+proc RunSample {w} {
+
+ # Create an entry for the user to input a filename. If he can't
+ # bother to type in the name, he can press the "Browse ..." button
+ # and call up the file dialog
+ #
+ frame $w.top -border 1 -relief raised
+
+ tixLabelEntry $w.top.ent -label "Select A File:" -labelside top \
+ -options {
+ entry.width 25
+ entry.textVariable demo_efdlg_filename
+ label.anchor w
+ }
+ bind [$w.top.ent subwidget entry] <Return> "efdlg:okcmd $w"
+
+ uplevel #0 set demo_efdlg_filename {}
+
+
+ button $w.top.btn -text "Browse ..." -command "efdlg:browse"
+
+ pack $w.top.ent -side left -expand yes -fill x -anchor s -padx 4 -pady 4
+ pack $w.top.btn -side left -anchor s -padx 4 -pady 4
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "efdlg:okcmd $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+# Pop up a file selection dialog
+#
+proc efdlg:browse {} {
+ # [Hint]
+ # The best way to use an ExFileSelectDialog is not to create one yourself
+ # but to call the command "tix filedialog". This command creates one file
+ # dialog box that is shared by different parts of the application.
+ # This way, your application can save resources because it doesn't
+ # need to create a lot of file dialog boxes even if it needs to input
+ # file names at a lot of different occasions.
+ #
+ set dialog [tix filedialog tixExFileSelectDialog]
+ $dialog config -command efdlg:select_file
+
+ $dialog subwidget fsbox config -filetypes {
+ {{*} {* -- All files}}
+ {{*.txt} {*.txt -- Text files}}
+ {{*.c} {*.c -- C source files}}
+ }
+
+ $dialog popup
+}
+
+proc efdlg:select_file {file} {
+ global demo_efdlg_filename
+
+ set demo_efdlg_filename $file
+}
+
+proc efdlg:okcmd {w} {
+ global demo_efdlg_filename
+
+ if {$demo_efdlg_filename != {}} {
+ puts "You have selected the file $demo_efdlg_filename"
+ } else {
+ puts "You haven't selected any file"
+ }
+
+ destroy $w
+}
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind .demo <Destroy> exit
+}
diff --git a/tix/demos/samples/EditGrid.tcl b/tix/demos/samples/EditGrid.tcl
new file mode 100644
index 00000000000..615d6fde6b9
--- /dev/null
+++ b/tix/demos/samples/EditGrid.tcl
@@ -0,0 +1,277 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# Demonstrates the use of editable entries in a Grid widget.
+#
+
+proc RunSample {w} {
+ global editgrid
+
+ wm title $w "Doe Inc. Performance"
+ wm geometry $w 640x300
+
+ label $w.lab -justify left -text \
+"The left column is calculated automatically. To calculate the right column,
+press the \"Calculate\" button"
+ pack $w.lab -side top -anchor c -padx 3 -pady 3
+
+ # Create the buttons
+ #
+ set f [frame $w.f -relief flat]
+ pack $f -side right -fill y
+ set add [button $f.add -text "Add Row" -width 9 \
+ -command "EditGrid_addRow"]
+ set edit [button $f.edit -text "Edit" -width 9 \
+ -command "EditGrid_edit"]
+ set cal [button $f.cal -text "Calculate" -width 9 \
+ -command "EditGrid_calculate"]
+ set close [button $f.close -text "Close" -width 9 \
+ -command "destroy $w"]
+ pack $add -side top -padx 10
+ pack $edit -side top -padx 10
+ pack $cal -side top -padx 10 -pady 2
+ pack $close -side bottom -padx 10
+
+ # Create the grid and set options to make it editable.
+ #
+ tixScrolledGrid $w.g -bd 0
+ pack $w.g -expand yes -fill both -padx 3 -pady 3
+
+ set grid [$w.g subwidget grid]
+ $grid config \
+ -formatcmd "EditGrid_format $grid" \
+ -editnotifycmd "EditGrid_editNotify" \
+ -editdonecmd "EditGrid_editDone" \
+ -selectunit cell \
+ -selectmode single
+
+ # Insert some initial data
+ #
+ $grid set 0 1 -text "City #1"
+ $grid set 0 2 -text "City #2"
+ $grid set 0 3 -text "City #3"
+ $grid set 0 5 -text "Combined"
+
+ $grid set 2 0 -text "Population"
+ $grid set 4 0 -text "Avg. Income"
+
+ $grid set 2 1 -text 125
+ $grid set 2 2 -text 81
+ $grid set 2 3 -text 724
+
+ $grid set 4 1 -text 24432.12
+ $grid set 4 2 -text 18290.24
+ $grid set 4 3 -text 18906.34
+
+ # Global data used by other EditGrid_ procedures.
+ #
+ set editgrid(g) $grid
+ set editgrid(top) 1
+ set editgrid(bot) 3
+ set editgrid(result) 5
+
+ EditGrid_calPop
+ EditGrid_calIncome
+}
+
+# EditGrid_edit --
+#
+# Prompts the user to edit a cell.
+#
+proc EditGrid_edit {} {
+ global editgrid
+ set grid $editgrid(g)
+
+ set ent [$grid anchor get]
+ if [string comp $ent ""] {
+ $grid edit set [lindex $ent 0] [lindex $ent 1]
+ }
+}
+
+# EditGrid_addRow --
+#
+# Adds a new row to the table.
+#
+proc EditGrid_addRow {} {
+ global editgrid
+ set grid $editgrid(g)
+
+ $grid edit apply
+
+ $grid move row $editgrid(result) $editgrid(result) 1
+
+ incr editgrid(bot)
+ set editgrid(result) [expr $editgrid(bot) + 2]
+ $grid set 0 $editgrid(bot) -text "City #$editgrid(bot)"
+ $grid set 2 $editgrid(bot) -text 0
+ $grid set 4 $editgrid(bot) -text 0.0
+
+ EditGrid_calPop
+ EditGrid_calIncome
+}
+
+# EditGrid_calPop --
+#
+# Calculates the total population
+#
+proc EditGrid_calPop {} {
+ global editgrid
+ set grid $editgrid(g)
+
+ set pop 0
+
+ for {set i $editgrid(top)} {$i <= $editgrid(bot)} {incr i} {
+ incr pop [$grid entrycget 2 $i -text]
+ }
+
+ $grid set 2 $editgrid(result) -text $pop
+}
+
+# EditGrid_calIncome --
+#
+# Calculates the average income.
+#
+proc EditGrid_calIncome {} {
+ global editgrid
+ set grid $editgrid(g)
+
+ set income 0
+ set total_pop 0
+ for {set i $editgrid(top)} {$i <= $editgrid(bot)} {incr i} {
+ set pop [$grid entrycget 2 $i -text]
+ set inc [$grid entrycget 4 $i -text]
+ set income [expr $income + $pop.0 * $inc]
+ incr total_pop $pop
+ }
+
+ $grid set 4 $editgrid(result) -text [expr $income/$total_pop]
+
+}
+
+# EditGrid_calculate --
+#
+# Recalculates both columns.
+#
+proc EditGrid_calculate {} {
+ global editgrid
+ set grid $editgrid(g)
+
+ $grid edit apply
+ EditGrid_calIncome
+}
+
+# EditGrid_editNotify --
+#
+# Returns true if an entry can be edited.
+#
+proc EditGrid_editNotify {x y} {
+ global editgrid
+ set grid $editgrid(g)
+
+ if {$x == 2 || $x == 4} {
+ if {$y >= $editgrid(top) && $y <= $editgrid(bot)} {
+ set editgrid(oldValue) [$grid entrycget $x $y -text]
+ return 1
+ }
+ }
+ return 0
+}
+
+# EditGrid_editDone --
+#
+# Gets called when the user is done editing an entry.
+#
+proc EditGrid_editDone {x y} {
+ global editgrid
+ set grid $editgrid(g)
+
+ if {$x == 2} {
+ set pop [$grid entrycget $x $y -text]
+ if [catch {
+ format %d $pop
+ }] {
+ $grid entryconfig $x $y -text $editgrid(oldValue)
+ tk_dialog .editGridWarn "" \
+ "$pop is not an valid integer. Try again" \
+ warning 0 Ok
+ } else {
+ $grid entryconfig 4 $editgrid(result) -text "-"
+ EditGrid_calPop
+ }
+ } else {
+ set income [$grid entrycget $x $y -text]
+ if [catch {
+ format %f $income
+ }] {
+ $grid entryconfig $x $y -text $editgrid(oldValue)
+ tk_dialog .editGridWarn "" \
+ "$income is not an valid floating number. Try again" \
+ warning 0 Ok
+ } else {
+ $grid entryconfig 4 $editgrid(result) -text "-"
+ }
+ }
+}
+
+# EditGrid_format --
+#
+# This command is called whenever the background of the grid
+# needs to be reformatted. The x1, y1, x2, y2 sprcifies the four
+# corners of the area that needs to be reformatted.
+#
+proc EditGrid_format {w area x1 y1 x2 y2} {
+ global editgrid
+
+ set bg(s-margin) gray65
+ set bg(x-margin) gray65
+ set bg(y-margin) gray65
+ set bg(main) gray20
+
+ case $area {
+ main {
+ foreach col {2 4} {
+ $w format border $col 1 $col $editgrid(bot) \
+ -relief flat -filled 1 -yon 1 -yoff 1\
+ -bd 0 -bg #b0b0f0 -selectbackground #a0b0ff
+ $w format border $col 2 $col $editgrid(bot) \
+ -relief flat -filled 1 -yon 1 -yoff 1\
+ -bd 0 -bg #80b080 -selectbackground #80b0ff
+ }
+
+ $w format grid $x1 $y1 $x2 $y2 \
+ -relief raised -bd 1 -bordercolor $bg($area) -filled 0 -bg red\
+ -xon 1 -yon 1 -xoff 0 -yoff 0 -anchor se
+ }
+ y-margin {
+ $w format border $x1 $y1 $x2 $y2 \
+ -fill 1 -relief raised -bd 1 -bg $bg($area) \
+ -selectbackground gray80
+ }
+ default {
+ $w format border $x1 $y1 $x2 $y2 \
+ -filled 1 \
+ -relief raised -bd 1 -bg $bg($area) \
+ -selectbackground gray80
+ }
+ }
+
+# case $area {
+# {main y-margin} {
+# set y [expr $editgrid(bot) + 1]
+# $w format border 0 $y 100 $y -bg black -filled 1 -bd 0
+# }
+# }
+}
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/FileDlg.tcl b/tix/demos/samples/FileDlg.tcl
new file mode 100644
index 00000000000..0a80b08b0fd
--- /dev/null
+++ b/tix/demos/samples/FileDlg.tcl
@@ -0,0 +1,94 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixFileSelectDialog widget --
+# This is a neat file selection dialog that looks like the Motif
+# file-selection dialog widget. I know that Motif sucks, but
+# tixFileSelectDialog looks neat nevertheless.
+#
+proc RunSample {w} {
+
+ # Create an entry for the user to input a filename. If he can't
+ # bother to type in the name, he can press the "Browse ..." button
+ # and call up the file dialog
+ #
+ frame $w.top -border 1 -relief raised
+
+ tixLabelEntry $w.top.ent -label "Select A File:" -labelside top \
+ -options {
+ entry.width 25
+ entry.textVariable demo_fdlg_filename
+ label.anchor w
+ }
+ bind [$w.top.ent subwidget entry] <Return> "fdlg:okcmd $w"
+
+ uplevel #0 set demo_fdlg_filename {}
+
+
+ button $w.top.btn -text "Browse ..." -command "fdlg:browse"
+
+ pack $w.top.ent -side left -expand yes -fill x -anchor s -padx 4 -pady 4
+ pack $w.top.btn -side left -anchor s -padx 4 -pady 4
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "fdlg:okcmd $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+# Pop up a file selection dialog
+#
+proc fdlg:browse {} {
+ # [Hint]
+ # The best way to use an FileSelectDialog is not to create one yourself
+ # but to call the command "tix filedialog". This command creates one file
+ # dialog box that is shared by different parts of the application.
+ # This way, your application can save resources because it doesn't
+ # need to create a lot of file dialog boxes even if it needs to input
+ # file names at a lot of different occasions.
+ #
+ set dialog [tix filedialog tixFileSelectDialog]
+ $dialog config -command fdlg:select_file
+
+ $dialog popup
+}
+
+proc fdlg:select_file {file} {
+ global demo_fdlg_filename
+
+ set demo_fdlg_filename $file
+}
+
+proc fdlg:okcmd {w} {
+ global demo_fdlg_filename
+
+ if {$demo_fdlg_filename != {}} {
+ puts "You have selected the file $demo_fdlg_filename"
+ } else {
+ puts "You haven't selected any file"
+ }
+
+ destroy $w
+}
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind .demo <Destroy> exit
+}
diff --git a/tix/demos/samples/FileEnt.tcl b/tix/demos/samples/FileEnt.tcl
new file mode 100644
index 00000000000..c70c0827973
--- /dev/null
+++ b/tix/demos/samples/FileEnt.tcl
@@ -0,0 +1,77 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixFileEntry widget -- an
+# easy of letting the user select a filename
+#
+proc RunSample {w} {
+
+ # Create the tixFileEntry's on the top of the dialog box
+ #
+ frame $w.top -border 1 -relief raised
+
+ global demo_fent_from demo_fent_to
+
+ tixFileEntry $w.top.a -label "Move File From: " \
+ -variable demo_fent_from \
+ -options {
+ entry.width 25
+ label.width 16
+ label.underline 10
+ label.anchor e
+ }
+
+ tixFileEntry $w.top.b -label "To: " \
+ -variable demo_fent_to \
+ -options {
+ entry.width 25
+ label.underline 0
+ label.width 16
+ label.anchor e
+ }
+
+ pack $w.top.a $w.top.b -side top -anchor w -pady 3
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "fent:okcmd $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+
+ # Let's set some nice bindings for keyboard accelerators
+ #
+ bind $w <Alt-f> "focus $w.top.a"
+ bind $w <Alt-t> "focus $w.top.b"
+ bind $w <Alt-o> "[$w.box subwidget ok] invoke; break"
+ bind $w <Alt-c> "[$w.box subwidget cancel] invoke; break"
+}
+
+proc fent:okcmd {w} {
+ global demo_fent_from demo_fent_to
+
+ puts "You wanted to move file from $demo_fent_from to $demo_fent_to"
+
+ destroy $w
+}
+
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/HList1.tcl b/tix/demos/samples/HList1.tcl
new file mode 100644
index 00000000000..eb3150a03e8
--- /dev/null
+++ b/tix/demos/samples/HList1.tcl
@@ -0,0 +1,155 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixHList widget -- you can
+# use to display data in a tree structure. For example, your family tree
+#
+#
+proc RunSample {w} {
+
+ # Create the tixHList and the tixLabelEntry widgets on the on the top
+ # of the dialog box
+ #
+ # [Hint] We create the tixHList and and the scrollbar by ourself,
+ # but it is more convenient to use the tixScrolledHlist widget
+ # which does all the chores for us.
+ #
+ # [Hint] Use of the -browsecmd and -command options:
+ # We want to set the tixLabelEntry accordingly whenever the user
+ # single-clicks on an entry in the HList box. Also, when the user
+ # double-clicks, we want to print out the selection and close
+ # the dialog box
+ #
+ frame $w.top -border 1 -relief raised
+
+ tixHList $w.top.h -yscrollcommand "$w.top.s set" -separator / \
+ -browsecmd "hlist1:browse $w.top.h" \
+ -command "hlist1:activate $w.top.h"\
+ -wideselection false \
+ -indent 15
+ scrollbar $w.top.s -command "$w.top.h yview" -takefocus 0
+
+ # Some icons for our list entries
+ #
+ global folder1 folder2
+ set img1 [image create bitmap -data $folder1]
+ set img2 [image create bitmap -data $folder2]
+
+ # Put our directories into the HList entry
+ #
+ set h $w.top.h
+ set dirs {
+ /
+ /lib
+ /pkg
+ /usr
+ /usr/lib
+ /usr/local
+ /usr/local/lib
+ /pkg/lib
+ }
+ foreach d $dirs {
+ $h add $d -itemtype imagetext -text $d -image $img2 -data $d
+
+ # We only want the user to select the directories that
+ # ends by "lib"
+ if {![string match "*lib" $d]} {
+ $h entryconfig $d -state disabled -image $img1
+ }
+ }
+
+ # We use a LabelEntry to hold the installation directory. The user
+ # can choose from the DirList widget, or he can type in the directory
+ # manually
+ #
+ tixLabelEntry $w.top.e -label "Installation Directory:" -labelside top \
+ -options {
+ entry.width 25
+ entry.textVariable demo_hlist_dir
+ label.anchor w
+ }
+ bind [$w.top.e subwidget entry] <Return> "hlist:okcmd $w"
+
+ # Set the default value
+ #
+ uplevel #0 set demo_hlist_dir /usr/local/lib
+ $h anchor set /usr/local/lib
+ $h select set /usr/local/lib
+
+ pack $w.top.h -side left -expand yes -fill both -padx 2 -pady 2
+ pack $w.top.s -side left -fill y -pady 2
+ pack $w.top.e -side left -expand yes -fill x -anchor s -padx 4 -pady 2
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "hlist:okcmd $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+# In an actual program, you may want to tell the user how much space he has
+# left in this directory
+#
+#
+proc hlist1:browse {w dir} {
+ global demo_hlist_dir
+
+ set demo_hlist_dir [$w entrycget $dir -data]
+}
+
+# In an actual program, you will install your favorit application
+# in the selected directory
+#
+proc hlist1:activate {w dir} {
+ global demo_hlist_dir
+
+ set demo_hlist_dir [$w entrycget $dir -data]
+ puts "You have selected the directory $demo_hlist_dir"
+
+ destroy [winfo toplevel $w]
+}
+
+proc hlist:okcmd {w} {
+ global demo_hlist_dir
+
+ puts "You have selected the directory $demo_hlist_dir"
+
+ destroy $w
+}
+
+set folder1 {
+#define foo_width 16
+#define foo_height 12
+static unsigned char foo_bits[] = {
+ 0x00, 0x00, 0x00, 0x3e, 0xfe, 0x41, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40,
+ 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0x02, 0x40, 0xfe, 0x7f, 0x00, 0x00};}
+
+set folder2 {
+#define foo_width 16
+#define foo_height 12
+static unsigned char foo_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0xfe, 0x7f, 0x02, 0x40, 0x02, 0x44, 0xf2, 0x4f,
+ 0xf2, 0x5f, 0xf2, 0x4f, 0x02, 0x44, 0x02, 0x40, 0xfe, 0x7f, 0x00, 0x00};
+}
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind .demo <Destroy> exit
+}
+
diff --git a/tix/demos/samples/LabEntry.tcl b/tix/demos/samples/LabEntry.tcl
new file mode 100644
index 00000000000..62a52087da8
--- /dev/null
+++ b/tix/demos/samples/LabEntry.tcl
@@ -0,0 +1,90 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixLabelEntry widget -- an entry that
+# come with a label at its side, so you don't need to create
+# extra frames on your own and do the messy hierarchical packing. This
+# example is adapted from the tixControl example, except now you don't
+# have arrow buttons to adjust the values for you ...
+#
+
+proc RunSample {w} {
+
+ # Create the tixLabelEntrys on the top of the dialog box
+ #
+ frame $w.top -border 1 -relief raised
+
+ # $w.top.a allows only integer values
+ #
+ # [Hint] The -options switch sets the options of the subwidgets.
+ # [Hint] We set the label.width subwidget option of the Controls to
+ # be 16 so that their labels appear to be aligned.
+ #
+ global lent_demo_maker lent_demo_thrust lent_demo_num_engins
+ set lent_demo_maker P&W
+ set lent_demo_thrust 20000.0
+ set lent_demo_num_engins 2
+
+ tixLabelEntry $w.top.a -label "Number of Engines: " \
+ -options {
+ entry.width 10
+ label.width 20
+ label.anchor e
+ entry.textVariable lent_demo_num_engins
+ }
+
+ tixLabelEntry $w.top.b -label "Thrust: "\
+ -options {
+ entry.width 10
+ label.width 20
+ label.anchor e
+ entry.textVariable lent_demo_thrust
+ }
+
+ tixLabelEntry $w.top.c -label "Engin Maker: " \
+ -options {
+ entry.width 10
+ label.width 20
+ label.anchor e
+ entry.textVariable lent_demo_maker
+ }
+
+ pack $w.top.a $w.top.b $w.top.c -side top -anchor w
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "labe:okcmd $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+proc labe:okcmd {w} {
+ global lent_demo_maker lent_demo_thrust lent_demo_num_engins
+
+ puts "You selected $lent_demo_num_engins engin(s) of thrust $lent_demo_thrust made \
+by $lent_demo_maker"
+
+ destroy $w
+}
+
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/LabFrame.tcl b/tix/demos/samples/LabFrame.tcl
new file mode 100644
index 00000000000..3bae9e9e1d1
--- /dev/null
+++ b/tix/demos/samples/LabFrame.tcl
@@ -0,0 +1,81 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixLabelFrame widget -- a frame that
+# come with a label at its side. It looks nifty when you use the set the
+# -labelside option to "acrosstop". Note that a lot of Tix widgets, such
+# as tixComboBox or tixControl, have the -labelside and -label options. So
+# you can use these options to achieve the same effect as in this file
+#
+
+proc RunSample {w} {
+
+ # Create the radiobuttons at the top of the dialog box, put them
+ # inside two tixLabelFrames:
+ #
+ frame $w.top -border 1 -relief raised
+
+ tixLabelFrame $w.top.a -label Font: -labelside acrosstop -options {
+ label.padX 5
+ }
+ tixLabelFrame $w.top.b -label Size: -labelside acrosstop -options {
+ label.padX 5
+ }
+
+ pack $w.top.a $w.top.b -side left -expand yes -fill both
+
+ # Create the radiobuttons inside the left frame.
+ #
+ # [Hint] You *must* create the new widgets inside the "frame"
+ # subwidget, *not* as immediate children of $w.top.a!
+ #
+ set f [$w.top.a subwidget frame]
+ foreach color {Red Green Blue Yellow Orange Purple} {
+ set lower [string tolower $color]
+ radiobutton $f.$lower -text $color -variable demo_color \
+ -relief flat -value $lower -bd 2 -pady 0 -width 7 -anchor w
+ pack $f.$lower -side top -pady 0 -anchor w -padx 6
+ }
+
+ # Create the radiobuttons inside the right frame.
+ #
+ set f [$w.top.b subwidget frame]
+ foreach point {8 10 12 14 18 24} {
+ set lower [string tolower $point]
+ radiobutton $f.$lower -text $point -variable demo_point \
+ -relief flat -value $lower -bd 2 -pady 0 -width 4 -anchor w
+ pack $f.$lower -side top -pady 0 -anchor w -padx 8
+ }
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "labf:okcmd $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+proc labf:okcmd {w} {
+ destroy $w
+}
+
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/ListNBK.tcl b/tix/demos/samples/ListNBK.tcl
new file mode 100644
index 00000000000..c975dea7e52
--- /dev/null
+++ b/tix/demos/samples/ListNBK.tcl
@@ -0,0 +1,83 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This program demonstrates the ListBoteBook widget, which is very similar
+# to a NoteBook widget but uses an HList instead of page tabs to list the
+# pages.
+
+proc RunSample {w} {
+ set top [frame $w.f -bd 1 -relief raised]
+ set box [tixButtonBox $w.b -bd 1 -relief raised]
+
+ pack $box -side bottom -fill both
+ pack $top -side top -fill both -expand yes
+
+ #----------------------------------------------------------------------
+ # Create the ListNoteBook with nice icons
+ #----------------------------------------------------------------------
+ tixListNoteBook $top.n -ipadx 6 -ipady 6
+
+ set img0 [tix getimage harddisk]
+ set img1 [tix getimage network]
+
+ $top.n subwidget hlist add hard_disk -itemtype imagetext \
+ -image $img0 -text "Hard Disk" -under 0
+ $top.n subwidget hlist add network -itemtype imagetext \
+ -image $img1 -text "Network" -under 0
+
+ $top.n add hard_disk
+ $top.n add network
+
+ #
+ # Create the widgets inside the two pages
+
+ # We use these options to set the sizes of the subwidgets inside the
+ # notebook, so that they are well-aligned on the screen.
+ #
+ set name [tixOptionName $w]
+ option add *$name*TixControl*entry.width 10
+ option add *$name*TixControl*label.width 18
+ option add *$name*TixControl*label.anchor e
+
+ set f [$top.n subwidget hard_disk]
+
+ tixControl $f.a -value 12 -label "Access Time: "
+ tixControl $f.w -value 400 -label "Write Throughput: "
+ tixControl $f.r -value 400 -label "Read Throughput: "
+ tixControl $f.c -value 1021 -label "Capacity: "
+ pack $f.a $f.w $f.r $f.c -side top -padx 20 -pady 2
+
+ set f [$top.n subwidget network]
+
+ tixControl $f.a -value 12 -label "Access Time: "
+ tixControl $f.w -value 400 -label "Write Throughput: "
+ tixControl $f.r -value 400 -label "Read Throughput: "
+ tixControl $f.c -value 1021 -label "Capacity: "
+ tixControl $f.u -value 10 -label "Users: "
+
+ pack $f.a $f.w $f.r $f.c $f.u -side top -padx 20 -pady 2
+
+ pack $top.n -expand yes -fill both -padx 5 -pady 5
+
+ # Create the buttons
+ #
+ $box add ok -text Ok -command "destroy $w" -width 6
+ $box add cancel -text Cancel -command "destroy $w" -width 6
+}
+
+#----------------------------------------------------------------------
+# Start-up code
+#----------------------------------------------------------------------
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/Meter.tcl b/tix/demos/samples/Meter.tcl
new file mode 100644
index 00000000000..aa60c39169c
--- /dev/null
+++ b/tix/demos/samples/Meter.tcl
@@ -0,0 +1,73 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This program demonstrates the use of the tixMeter widget -- it is
+# used to display the progress of a background job
+#
+
+proc RunSample {w} {
+ set top [frame $w.f -bd 1 -relief raised]
+ set box [tixButtonBox $w.b -bd 1 -relief raised]
+
+ pack $box -side bottom -fill both
+ pack $top -side top -fill both -expand yes
+
+ # Create the Meter and the Label
+ #
+ label $top.lab -text "Work in progress ...."
+ tixMeter $top.met -value 0 -text 0%
+
+ pack $top.lab -side top -padx 50 -pady 10 -anchor c
+ pack $top.met -side top -padx 50 -pady 10 -anchor c
+
+
+ # Create the buttons
+ #
+ $box add cancel -text Cancel -command "destroy $w" \
+ -width 6 -under 0
+ $box add restart -text Restart -width 6 -under 0
+
+ $box subwidget restart config -command \
+ "Meter:Start $top.met [$box subwidget cancel] [$box subwidget restart]"
+
+ $box subwidget restart invoke
+}
+
+proc Meter:Start {meter cancel restart} {
+ $restart config -state disabled
+ $cancel config -text Cancel
+ after 40 Meter:BackgroundJob $meter 0 $cancel $restart
+}
+
+proc Meter:BackgroundJob {meter progress cancel restart} {
+ if ![winfo exists $meter] {
+ # the window has already been destroyed
+ #
+ return
+ }
+
+ set progress [expr $progress + 0.02]
+ set text [expr int($progress*100.0)]%
+
+ $meter config -value $progress -text $text
+
+ if {$progress < 1.0} {
+ after 40 Meter:BackgroundJob $meter $progress $cancel $restart
+ } else {
+ $cancel config -text OK -under 0
+ $restart config -state normal
+ }
+}
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/NoteBook.tcl b/tix/demos/samples/NoteBook.tcl
new file mode 100644
index 00000000000..3db07202e1a
--- /dev/null
+++ b/tix/demos/samples/NoteBook.tcl
@@ -0,0 +1,98 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixNoteBook widget, which allows
+# you to lay out your interface using a "notebook" metaphore
+#
+
+proc RunSample {w} {
+
+ # We use these options to set the sizes of the subwidgets inside the
+ # notebook, so that they are well-aligned on the screen.
+ #
+ set name [tixOptionName $w]
+ option add *$name*TixControl*entry.width 10
+ option add *$name*TixControl*label.width 18
+ option add *$name*TixControl*label.anchor e
+
+ # Create the notebook widget and set its backpagecolor to gray.
+ # Note that the -backpagecolor option belongs to the "nbframe"
+ # subwidget.
+ tixNoteBook $w.nb -ipadx 6 -ipady 6
+ $w config -bg gray
+ $w.nb subwidget nbframe config -backpagecolor gray
+
+ # Create the two tabs on the notebook. The -underline option
+ # puts a underline on the first character of the labels of the tabs.
+ # Keyboard accelerators will be defined automatically according
+ # to the underlined character.
+ #
+ $w.nb add hard_disk -label "Hard Disk" -underline 0
+ $w.nb add network -label "Network" -underline 0
+ pack $w.nb -expand yes -fill both -padx 5 -pady 5 -side top
+
+ #----------------------------------------
+ # Create the first page
+ #----------------------------------------
+ set f [$w.nb subwidget hard_disk]
+
+ # Create two frames: one for the common buttons, one for the
+ # other widgets
+ #
+ frame $f.f
+ frame $f.common
+ pack $f.f -side left -padx 2 -pady 2 -fill both -expand yes
+ pack $f.common -side right -padx 2 -pady 2 -fill y
+
+ # Create the controls that only belong to this page
+ #
+ tixControl $f.f.a -value 12 -label "Access Time: "
+ tixControl $f.f.w -value 400 -label "Write Throughput: "
+ tixControl $f.f.r -value 400 -label "Read Throughput: "
+ tixControl $f.f.c -value 1021 -label "Capacity: "
+ pack $f.f.a $f.f.w $f.f.r $f.f.c -side top -padx 20 -pady 2
+
+ # Create the common buttons
+ #
+ CreateCommonButtons $w $f.common
+
+ #----------------------------------------
+ # Create the second page
+ #----------------------------------------
+ set f [$w.nb subwidget network]
+
+ frame $f.f
+ frame $f.common
+ pack $f.f -side left -padx 2 -pady 2 -fill both -expand yes
+ pack $f.common -side right -padx 2 -pady 2 -fill y
+
+ tixControl $f.f.a -value 12 -label "Access Time: "
+ tixControl $f.f.w -value 400 -label "Write Throughput: "
+ tixControl $f.f.r -value 400 -label "Read Throughput: "
+ tixControl $f.f.c -value 1021 -label "Capacity: "
+ tixControl $f.f.u -value 10 -label "Users: "
+
+ pack $f.f.a $f.f.w $f.f.r $f.f.c $f.f.u -side top -padx 20 -pady 2
+
+ CreateCommonButtons $w $f.common
+}
+
+proc CreateCommonButtons {w f} {
+ button $f.ok -text OK -width 6 -command "destroy $w"
+ button $f.cancel -text Cancel -width 6 -command "destroy $w"
+
+ pack $f.ok $f.cancel -side top -padx 2 -pady 2
+}
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> {if {"%W" == ".demo"} exit}
+}
diff --git a/tix/demos/samples/OptMenu.tcl b/tix/demos/samples/OptMenu.tcl
new file mode 100644
index 00000000000..fea64799a29
--- /dev/null
+++ b/tix/demos/samples/OptMenu.tcl
@@ -0,0 +1,99 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixOptionMenu widget -- you can
+# use it for the user to choose from a fixed set of options
+#
+set opt_options {text formatted post html tex rtf}
+
+set opt_labels(text) "Plain Text"
+set opt_labels(formatted) "Formatted Text"
+set opt_labels(post) "PostScript"
+set opt_labels(html) "HTML"
+set opt_labels(tex) "LaTeX"
+set opt_labels(rtf) "Rich Text Format"
+
+proc RunSample {w} {
+ catch {uplevel #0 unset demo_opt_from}
+ catch {uplevel #0 unset demo_opt_to }
+
+ # Create the tixOptionMenu's on the top of the dialog box
+ #
+ frame $w.top -border 1 -relief raised
+
+ tixOptionMenu $w.top.from -label "From File Format : " \
+ -variable demo_opt_from \
+ -options {
+ label.width 19
+ label.anchor e
+ menubutton.width 15
+ }
+
+ tixOptionMenu $w.top.to -label "To File Format : " \
+ -variable demo_opt_to \
+ -options {
+ label.width 19
+ label.anchor e
+ menubutton.width 15
+ }
+
+ # Add the available options to the two OptionMenu widgets
+ #
+ # [Hint] You have to add the options first before you set the
+ # global variables "demo_opt_from" and "demo_opt_to". Otherwise
+ # the OptionMenu widget will complain about "unknown options"!
+ #
+ global opt_options opt_labels
+ foreach opt $opt_options {
+ $w.top.from add command $opt -label $opt_labels($opt)
+ $w.top.to add command $opt -label $opt_labels($opt)
+ }
+
+ uplevel #0 set demo_opt_from html
+ uplevel #0 set demo_opt_to post
+
+ pack $w.top.from $w.top.to -side top -anchor w -pady 3 -padx 6
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "opt:okcmd $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+
+ # Let's set some nice bindings for keyboard accelerators
+ #
+ bind $w <Alt-f> "focus $w.top.from"
+ bind $w <Alt-t> "focus $w.top.to"
+ bind $w <Alt-o> "[$w.box subwidget ok] invoke; break"
+ bind $w <Alt-c> "[$w.box subwidget cancel] invoke; break"
+}
+
+proc opt:okcmd {w} {
+ global demo_opt_from demo_opt_to opt_labels
+
+ puts "You wanted to convert file from $opt_labels($demo_opt_from) to $opt_labels($demo_opt_to)"
+
+ destroy $w
+}
+
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> {if {"%W" == ".demo"} exit}
+}
diff --git a/tix/demos/samples/PanedWin.tcl b/tix/demos/samples/PanedWin.tcl
new file mode 100644
index 00000000000..180e89e0459
--- /dev/null
+++ b/tix/demos/samples/PanedWin.tcl
@@ -0,0 +1,108 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixPanedWindow widget. This program
+# is a dummy news reader: the user can adjust the sizes of the list
+# of artical names and the size of the text widget that shows the body
+# of the artical
+#
+
+proc RunSample {w} {
+
+ # We create the frame at the top of the dialog box
+ #
+ frame $w.top -relief raised -bd 1
+
+ # Use a LabelEntry widget to show the name of the newsgroup
+ # [Hint] We disable the entry widget so that the user can't
+ # mess up with the name of the newsgroup
+ #
+ tixLabelEntry $w.top.name -label "Newsgroup: " -options {
+ entry.width 25
+ }
+ $w.top.name subwidget entry insert 0 "comp.lang.tcl"
+ $w.top.name subwidget entry config -state disabled
+
+ pack $w.top.name -side top -anchor c -fill x -padx 14 -pady 6
+ # Now use a PanedWindow to contain the list and text widgets
+ #
+ tixPanedWindow $w.top.pane -paneborderwidth 0 -separatorbg gray50
+ pack $w.top.pane -side top -expand yes -fill both -padx 10 -pady 10
+
+ set p1 [$w.top.pane add list -min 70 -size 100]
+ set p2 [$w.top.pane add text -min 70]
+
+ tixScrolledListBox $p1.list
+ $p1.list subwidget listbox config -font [tix option get fixed_font]
+
+ tixScrolledText $p2.text
+ $p2.text subwidget text config -font [tix option get fixed_font]
+
+ pack $p1.list -expand yes -fill both -padx 4 -pady 6
+ pack $p2.text -expand yes -fill both -padx 4 -pady 6
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "destroy $w" \
+ -width 8
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 8
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+
+ # Put the junk inside the listbox and the tetx widget
+ #
+ $p1.list subwidget listbox insert end \
+ " 12324 Re: TK is good for your health" \
+ "+ 12325 Re: TK is good for your health" \
+ "+ 12326 Re: Tix is even better for your health (Was: TK is good...)" \
+ " 12327 Re: Tix is even better for your health (Was: TK is good...)" \
+ "+ 12328 Re: Tix is even better for your health (Was: TK is good...)" \
+ " 12329 Re: Tix is even better for your health (Was: TK is good...)" \
+ "+ 12330 Re: Tix is even better for your health (Was: TK is good...)"
+
+ $p2.text subwidget text config -wrap none -bg \
+ [$p1.list subwidget listbox cget -bg]
+ $p2.text subwidget text insert end {
+Mon, 19 Jun 1995 11:39:52 comp.lang.tcl Thread 34 of 220
+Lines 353 A new way to put text and bitmaps together iNo responses
+ioi@blue.seas.upenn.edu Ioi K. Lam at University of Pennsylvania
+
+Hi,
+
+I have implemented a new image type called "compound". It allows you
+to glue together a bunch of bitmaps, images and text strings together
+to form a bigger image. Then you can use this image with widgets that
+support the -image option. This way you can display very fancy stuffs
+in your GUI. For example, you can display a text string string
+together with a bitmap, at the same time, inside a TK button widget. A
+screenshot of compound images can be found at the bottom of this page:
+
+ http://www.cis.upenn.edu/~ioi/tix/screenshot.html
+
+You can also you is in other places such as putting fancy bitmap+text
+in menus, tabs of tixNoteBook widgets, etc. This feature will be
+included in the next release of Tix (4.0b1). Count on it to make jazzy
+interfaces!}
+
+}
+
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> {if {"%W" == ".demo"} exit}
+}
+
diff --git a/tix/demos/samples/PopMenu.tcl b/tix/demos/samples/PopMenu.tcl
new file mode 100644
index 00000000000..aa4f9d2c7a6
--- /dev/null
+++ b/tix/demos/samples/PopMenu.tcl
@@ -0,0 +1,69 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixPopupMenu widget.
+#
+
+proc RunSample {w} {
+
+ # We create the frame and the button, then we'll bind the PopupMenu
+ # to both widgets. The result is, when you press the right mouse
+ # button over $w.top or $w.top.but, the PopupMenu will come up.
+ #
+
+ frame $w.top -relief raised -bd 1
+
+ button $w.top.but -text {Press the right mouse button over
+this button or its surrounding area}
+
+ pack $w.top.but -expand yes -fill both -padx 50 -pady 50
+
+ tixPopupMenu $w.top.p -title "Popup Test"
+ $w.top.p bind $w.top
+ $w.top.p bind $w.top.but
+
+ # Set the entries inside the PopupMenu widget.
+ # [Hint] You have to manipulate the "menu" subwidget.
+ # $w.top.p itself is NOT a menu widget.
+ # [Hint] Watch carefully how the sub-menu is created
+ #
+ set menu [$w.top.p subwidget menu]
+ $menu add command -label Desktop -under 0
+ $menu add command -label Select -under 0
+ $menu add command -label Find -under 0
+ $menu add command -label System -under 1
+ $menu add command -label Help -under 0
+ $menu add cascade -label More -menu $menu.m1
+ menu $menu.m1
+ $menu.m1 add command -label Hello
+
+ pack $w.top.but -side top -padx 40 -pady 50
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "destroy $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> {if {"%W" == ".demo"} exit}
+}
diff --git a/tix/demos/samples/SGrid0.tcl b/tix/demos/samples/SGrid0.tcl
new file mode 100644
index 00000000000..e3d5149981a
--- /dev/null
+++ b/tix/demos/samples/SGrid0.tcl
@@ -0,0 +1,131 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# A very simple demonstration of the tixGrid widget
+#
+
+proc RunSample {w} {
+ wm title $w "The First Grid Example"
+ wm geometry $w 480x300
+
+ set top [frame $w.f -bd 1 -relief raised]
+ set box [tixButtonBox $w.b -bd 1 -relief raised]
+
+ pack $box -side bottom -fill both
+ pack $top -side top -fill both -expand yes
+
+ label $top.lab -text "This widget is still under alpha
+Please ignore the debug messages
+Not all features have been implemented" -justify left
+ pack $top.lab -side top -anchor c -padx 3 -pady 3
+
+ MakeGrid $top
+
+ # Create the buttons
+ #
+ $box add ok -text Ok -command "destroy $w" -width 6
+ $box add cancel -text Cancel -command "destroy $w" -width 6
+}
+
+# This command is called whenever the background of the grid needs to
+# be reformatted. The x1, y1, x2, y2 specifies the four corners of the area
+# that needs to be reformatted.
+#
+# area:
+# x-margin: the horizontal margin
+# y-margin: the vertical margin
+# s-margin: the overlap area of the x- and y-margins
+# main: The rest
+#
+proc SimpleFormat {w area x1 y1 x2 y2} {
+
+ global margin
+ set bg(s-margin) gray65
+ set bg(x-margin) gray65
+ set bg(y-margin) gray65
+ set bg(main) gray20
+
+ case $area {
+ main {
+ # The "grid" format is consecutive boxes without 3d borders
+ #
+ $w format grid $x1 $y1 $x2 $y2 \
+ -relief raised -bd 1 -bordercolor $bg($area) -filled 0 -bg red\
+ -xon 1 -yon 1 -xoff 0 -yoff 0 -anchor se
+ }
+ {x-margin y-margin s-margin} {
+ # border specifies consecutive 3d borders
+ #
+ $w format border $x1 $y1 $x2 $y2 \
+ -fill 1 -relief raised -bd 1 -bg $bg($area) \
+ -selectbackground gray80
+ }
+ }
+}
+
+# Print a number in $ format
+#
+#
+proc Dollar {s} {
+ set n [string len $s]
+ set start [expr $n % 3]
+ if {$start == 0} {
+ set start 3
+ }
+
+ set str ""
+ for {set i 0} {$i < $n} {incr i} {
+ if {$start == 0} {
+ append str ","
+ set start 3
+ }
+ incr start -1
+ append str [string index $s $i]
+ }
+ return $str
+}
+
+proc MakeGrid {w} {
+ # Create the grid
+ #
+ tixScrolledGrid $w.g -bd 0
+ pack $w.g -expand yes -fill both -padx 3 -pady 3
+
+ set grid [$w.g subwidget grid]
+ $grid config -formatcmd "SimpleFormat $grid"
+
+
+ # Set the size of the columns
+ #
+ $grid size col 0 -size 10char
+ $grid size col 1 -size auto
+ $grid size col 2 -size auto
+ $grid size col 3 -size auto
+ $grid size col 4 -size auto
+
+ # set the default size of the column and rows. these sizes will be used
+ # if the size of a row or column has not be set via the "size col ?"
+ # command
+ $grid size col default -size 5char
+ $grid size row default -size 1.1char -pad0 3
+
+ for {set x 0} {$x < 10} {incr x} {
+ for {set y 0} {$y < 10} {incr y} {
+ $grid set $x $y -itemtype text -text ($x,$y)
+ }
+ }
+}
+
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/SGrid1.tcl b/tix/demos/samples/SGrid1.tcl
new file mode 100644
index 00000000000..1b94860f493
--- /dev/null
+++ b/tix/demos/samples/SGrid1.tcl
@@ -0,0 +1,211 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# Demonstrates the tixGrid widget
+#
+
+proc RunSample {w} {
+ wm title $w "Doe Inc. Performance"
+ wm geometry $w 640x300
+
+ set top [frame $w.f -bd 1 -relief raised]
+ set box [tixButtonBox $w.b -bd 1 -relief raised]
+
+ pack $box -side bottom -fill both
+ pack $top -side top -fill both -expand yes
+
+ label $top.lab -text "This widget is still under alpha
+Please ignore the debug messages
+Not all features have been implemented" -justify left
+ pack $top.lab -side top -anchor c -padx 3 -pady 3
+
+ MakeGrid $top
+
+ # Create the buttons
+ #
+ $box add ok -text Ok -command "destroy $w" -width 6
+ $box add cancel -text Cancel -command "destroy $w" -width 6
+}
+
+# This command is called whenever the background of the grid needs to
+# be reformatted. The x1, y1, x2, y2 sprcifies the four corners of the area
+# that needs to be reformatted.
+#
+proc gformat {w area x1 y1 x2 y2} {
+ set bg(s-margin) gray65
+ set bg(x-margin) gray65
+ set bg(y-margin) gray65
+ set bg(main) gray20
+
+ case $area {
+ main {
+ for {set y [expr ($y1/2) * 2]} {$y <= $y2} {incr y 2} {
+ $w format border $x1 $y $x2 $y \
+ -relief flat -filled 1\
+ -bd 0 -bg #80b080 -selectbackground #80b0ff
+ }
+ $w format grid $x1 $y1 $x2 $y2 \
+ -relief raised -bd 1 -bordercolor $bg($area) -filled 0 -bg red\
+ -xon 1 -yon 1 -xoff 0 -yoff 0 -anchor se
+ }
+ y-margin {
+ $w format border $x1 $y1 $x2 $y2 \
+ -fill 1 -relief raised -bd 1 -bg $bg($area) \
+ -selectbackground gray80
+ }
+
+ default {
+ $w format border $x1 $y1 $x2 $y2 \
+ -filled 1 \
+ -relief raised -bd 1 -bg $bg($area) \
+ -selectbackground gray80
+ }
+ }
+}
+
+# Print a number in $ format
+#
+#
+proc Dollar {s} {
+ set n [string len $s]
+ set start [expr $n % 3]
+ if {$start == 0} {
+ set start 3
+ }
+
+ set str ""
+ for {set i 0} {$i < $n} {incr i} {
+ if {$start == 0} {
+ append str ","
+ set start 3
+ }
+ incr start -1
+ append str [string index $s $i]
+ }
+ return $str
+}
+
+proc MakeGrid {w} {
+
+ # data format {year revenue profit}
+ #
+ set data {
+ {1970 1000000000 1000000}
+ {1971 1100000000 2000000}
+ {1972 1200000000 3000000}
+ {1973 1300000000 4000000}
+ {1974 1400000000 5000000}
+ {1975 1500000000 6000000}
+ {1976 1600000000 7000000}
+ {1977 1700000000 8000000}
+ {1978 1800000000 9000000}
+ {1979 1900000000 10000000}
+ {1980 2000000000 11000000}
+ {1981 2100000000 22000000}
+ {1982 2200000000 33000000}
+ {1983 2300000000 44000000}
+ {1984 2400000000 55000000}
+ {1985 3500000000 36000000}
+ {1986 4600000000 57000000}
+ {1987 5700000000 68000000}
+ {1988 6800000000 79000000}
+ {1989 7900000000 90000000}
+ {1990 13000000000 111000000}
+ {1991 14100000000 122000000}
+ {1992 16200000000 233000000}
+ {1993 28300000000 344000000}
+ {1994 29400000000 455000000}
+ {1995 38500000000 536000000}
+ }
+
+ set headers {
+ "Revenue ($)"
+ "Rev. Growth (%)"
+ "Profit ($)"
+ "Profit Growth (%)"
+ }
+
+ # Create the grid
+ #
+ tixScrolledGrid $w.g -bd 0
+ pack $w.g -expand yes -fill both -padx 3 -pady 3
+
+ set grid [$w.g subwidget grid]
+ $grid config -formatcmd "gformat $grid"
+
+ # Set the size of the columns
+ #
+ $grid size col 0 -size 10char
+ $grid size col 1 -size auto
+ $grid size col 2 -size auto
+ $grid size col 3 -size auto
+ $grid size col 4 -size auto
+
+ # set the default size of the column and rows. these sizes will be used
+ # if the size of a row or column has not be set via the "size col ?"
+ # command
+ $grid size col default -size 5char
+ $grid size row default -size 1.1char -pad0 3
+
+ set margin [tixDisplayStyle text -refwindow $grid \
+ -anchor c -padx 3 -font [tix option get bold_font]]
+ set dollar [tixDisplayStyle text -refwindow $grid \
+ -anchor e]
+
+ # Create the headers
+ #
+ set x 1
+ foreach h $headers {
+ $grid set $x 0 -itemtype text -text $h -style $margin
+ incr x
+ }
+
+ # Insert the data, year by year
+ #
+ set lastRevn {}
+ set lastProf {}
+ set i 1
+ foreach line $data {
+ set year [lindex $line 0]
+ set revn [lindex $line 1]
+ set prof [lindex $line 2]
+
+ if {$lastRevn != {}} {
+ set rgrowth \
+ [format %4.2f [expr ($revn.0-$lastRevn)/$lastRevn*100.0]]
+ } else {
+ set rgrowth "-"
+ }
+ if {$lastProf != {}} {
+ set pgrowth \
+ [format %4.2f [expr ($prof.0-$lastProf)/$lastProf*100.0]]
+ } else {
+ set pgrowth "-"
+ }
+
+ $grid set 0 $i -itemtype text -style $margin -text $year
+ $grid set 1 $i -itemtype text -style $dollar -text [Dollar $revn]
+ $grid set 2 $i -itemtype text -style $dollar -text $rgrowth
+ $grid set 3 $i -itemtype text -style $dollar -text [Dollar $prof]
+ $grid set 4 $i -itemtype text -style $dollar -text $pgrowth
+
+ set lastRevn $revn.0
+ set lastProf $prof.0
+
+ incr i
+ }
+}
+
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/SHList.tcl b/tix/demos/samples/SHList.tcl
new file mode 100644
index 00000000000..d416071ee28
--- /dev/null
+++ b/tix/demos/samples/SHList.tcl
@@ -0,0 +1,107 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixScrolledHList widget.
+#
+
+proc RunSample {w} {
+
+ # We create the frame and the ScrolledHList widget
+ # at the top of the dialog box
+ #
+ frame $w.top -relief raised -bd 1
+
+ # Put a simple hierachy into the HList (two levels). Use colors and
+ # separator widgets (frames) to make the list look fancy
+ #
+ tixScrolledHList $w.top.a
+ pack $w.top.a -expand yes -fill both -padx 10 -pady 10 -side left
+
+
+ # This is our little relational database
+ #
+ set bosses {
+ {jeff "Jeff Waxman"}
+ {john "John Lee"}
+ {peter "Peter Kenson"}
+ }
+
+ set employees {
+ {alex john "Alex Kellman"}
+ {alan john "Alan Adams"}
+ {andy peter "Andreas Crawford"}
+ {doug jeff "Douglas Bloom"}
+ {jon peter "Jon Baraki"}
+ {chris jeff "Chris Geoffrey"}
+ {chuck jeff "Chuck McLean"}
+ }
+
+ set hlist [$w.top.a subwidget hlist]
+
+ # Let configure the appearance of the HList subwidget
+ #
+ $hlist config -separator "." -width 25 -drawbranch 0 -indent 10
+
+ set index 0
+ foreach line $bosses {
+ if {$index != 0} {
+ frame $hlist.sep$index -bd 2 -height 2 -width 150 -relief sunken \
+ -bg [$hlist cget -bg]
+
+ $hlist addchild {} -itemtype window \
+ -window $hlist.sep$index -state disabled
+ }
+ $hlist add [lindex $line 0] -itemtype text \
+ -text [lindex $line 1]
+ incr index
+ }
+
+ foreach line $employees {
+ # "." is the separator character we chose above
+ #
+ set entrypath [lindex $line 1].[lindex $line 0]
+ # ^^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^^
+ # parent entryPath / child's name
+
+ $hlist add $entrypath -text [lindex $line 2]
+
+ # [Hint] Make sure the [lindex $line 1].[lindex $line 0] you choose
+ # are unique names. If you cannot be sure of this (because of
+ # the structure of your database, e.g.) you can use the
+ # "addchild" widget command instead:
+ #
+ # $hlist addchild [lindex $line 1] -text [lindex $line 2]
+ # ^^^^^^^^^^^^^^^^
+ # parent entryPath
+
+ }
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "destroy $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind .demo <Destroy> exit
+}
+
diff --git a/tix/demos/samples/SHList2.tcl b/tix/demos/samples/SHList2.tcl
new file mode 100644
index 00000000000..0a3de00a4c5
--- /dev/null
+++ b/tix/demos/samples/SHList2.tcl
@@ -0,0 +1,161 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates how to use multiple columns and multiple styles
+# in the tixHList widget
+#
+# In a tixHList widget, you can have one ore more columns.
+#
+
+proc RunSample {w} {
+
+ # We create the frame and the ScrolledHList widget
+ # at the top of the dialog box
+ #
+ frame $w.top -relief raised -bd 1
+
+ # Put a simple hierachy into the HList (two levels). Use colors and
+ # separator widgets (frames) to make the list look fancy
+ #
+ tixScrolledHList $w.top.a -options {
+ hlist.columns 3
+ hlist.header true
+ }
+ pack $w.top.a -expand yes -fill both -padx 10 -pady 10 -side left
+
+ set hlist [$w.top.a subwidget hlist]
+
+ # Create the title for the HList widget
+ # >> Notice that we have set the hlist.header subwidget option to true
+ # so that the header is displayed
+ #
+
+ # First some styles for the headers
+ set style(header) [tixDisplayStyle text -refwindow $hlist \
+ -fg black -anchor c \
+ -padx 8 -pady 2\
+ -font [tix option get bold_font ]]
+
+ $hlist header create 0 -itemtype text -text Name \
+ -style $style(header)
+ $hlist header create 1 -itemtype text -text Position \
+ -style $style(header)
+
+ # Notice that we use 3 columns in the hlist widget. This way when the user
+ # expands the windows wide, the right side of the header doesn't look
+ # chopped off. The following line ensures that the 3 column header is
+ # not shown unless the hlist window is wider than its contents.
+ #
+ $hlist column width 2 0
+
+ # This is our little relational database
+ #
+ set boss {doe "John Doe" Director}
+
+ set managers {
+ {jeff "Jeff Waxman" Manager}
+ {john "John Lee" Manager}
+ {peter "Peter Kenson" Manager}
+ }
+
+ set employees {
+ {alex john "Alex Kellman" Clerk}
+ {alan john "Alan Adams" Clerk}
+ {andy peter "Andreas Crawford" Salesman}
+ {doug jeff "Douglas Bloom" Clerk}
+ {jon peter "Jon Baraki" Salesman}
+ {chris jeff "Chris Geoffrey" Clerk}
+ {chuck jeff "Chuck McLean" Cleaner}
+ }
+
+ set style(mgr_name) [tixDisplayStyle text -refwindow $hlist \
+ -fg #202060 \
+ -selectforeground #202060 \
+ -font [tix option get bold_font ]]
+ set style(mgr_posn) [tixDisplayStyle text -refwindow $hlist \
+ -fg #202060 -padx 8 \
+ -selectforeground #202060]
+
+ set style(empl_name) [tixDisplayStyle text -refwindow $hlist \
+ -fg #602020 \
+ -selectforeground #602020 \
+ -font [tix option get bold_font ]]
+ set style(empl_posn) [tixDisplayStyle text -refwindow $hlist \
+ -fg #602020 -padx 8 \
+ -selectforeground #602020 ]
+
+ # Let configure the appearance of the HList subwidget
+ #
+ $hlist config -separator "." -width 25 -drawbranch 0 -indent 10
+ $hlist column width 0 -char 20
+
+ # Create the boss
+ #
+ $hlist add . -itemtype text -text [lindex $boss 1] \
+ -style $style(mgr_name)
+ $hlist item create . 1 -itemtype text -text [lindex $boss 2] \
+ -style $style(mgr_posn)
+
+ # Create the managers
+ #
+ set index 0
+ foreach line $managers {
+ set row [$hlist add .[lindex $line 0] -itemtype text \
+ -text [lindex $line 1] -style $style(mgr_name)]
+ $hlist item create $row 1 -itemtype text -text [lindex $line 2] \
+ -style $style(mgr_posn)
+ incr index
+ }
+
+ foreach line $employees {
+ # "." is the separator character we chose above
+ #
+ set entrypath .[lindex $line 1].[lindex $line 0]
+ # ^^^^^^^^^^^^^^^ ^^^^^^^^^^^^^^^
+ # parent entryPath / child's name
+
+ set row [$hlist add $entrypath -text [lindex $line 2] \
+ -style $style(empl_name)]
+ $hlist item create $row 1 -itemtype text -text [lindex $line 3] \
+ -style $style(empl_posn)
+
+ # [Hint] Make sure the .[lindex $line 1].[lindex $line 0] you choose
+ # are unique names. If you cannot be sure of this (because of
+ # the structure of your database, e.g.) you can use the
+ # "addchild" widget command instead:
+ #
+ # $hlist addchild [lindex $line 1] -text [lindex $line 2]
+ # ^^^^^^^^^^^^^^^^
+ # parent entryPath
+
+ }
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "destroy $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind .demo <Destroy> exit
+}
+
diff --git a/tix/demos/samples/SListBox.tcl b/tix/demos/samples/SListBox.tcl
new file mode 100644
index 00000000000..9638341678f
--- /dev/null
+++ b/tix/demos/samples/SListBox.tcl
@@ -0,0 +1,81 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixScrolledListBox widget.
+#
+
+proc RunSample {w} {
+
+ # We create the frame and the two ScrolledListBox widgets
+ # at the top of the dialog box
+ #
+ frame $w.top -relief raised -bd 1
+
+ # The first ScrolledListBox widget always shows both scrollbars
+ #
+ tixScrolledListBox $w.top.a -scrollbar both
+ pack $w.top.a -expand yes -fill both -padx 10 -pady 10 -side left
+
+ # The second ScrolledListBox widget shows the scrollbars only when
+ # needed.
+ #
+ # [Hint] See how you can use the -options switch to set the options
+ # for the subwidgets
+ #
+ tixScrolledListBox $w.top.b -scrollbar auto -options {
+ listbox.font 8x13
+ }
+ pack $w.top.b -expand yes -fill both -padx 10 -pady 10 -side left
+
+ # Put the elements inside the two listboxes: notice that you need
+ # to insert inside the "listbox" subwidget of the ScrolledListBox.
+ # $w.top.a itself does NOT have an "insert" command.
+ #
+ $w.top.a subwidget listbox insert 0 \
+ Alabama Alaska Arizona Arkansas California \
+ Colorado Connecticut Delaware Florida Georgia Hawaii Idaho Illinois \
+ Indiana Iowa Kansas Kentucky Louisiana Maine Maryland \
+ Massachusetts Michigan Minnesota Mississippi Missouri \
+ Montana Nebraska Nevada "New Hampshire" "New Jersey" "New Mexico" \
+ "New York" "North Carolina" "North Dakota" \
+ Ohio Oklahoma Oregon Pennsylvania "Rhode Island" \
+ "South Carolina" "South Dakota" \
+ Tennessee Texas Utah Vermont Virginia Washington \
+ "West Virginia" Wisconsin Wyoming
+
+ $w.top.a subwidget listbox config -cursor left_ptr
+ raise [$w.top.a subwidget listbox ]
+ $w.top.b subwidget listbox insert 0 \
+ Alabama Alaska Arizona Arkansas California \
+ Colorado Connecticut Delaware Florida Georgia Hawaii Idaho Illinois \
+ Indiana Iowa Kansas Kentucky
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "destroy $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
+
diff --git a/tix/demos/samples/STList1.tcl b/tix/demos/samples/STList1.tcl
new file mode 100644
index 00000000000..215c8ac1601
--- /dev/null
+++ b/tix/demos/samples/STList1.tcl
@@ -0,0 +1,53 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# Demonstrates the scrolled tlist widget
+#
+
+proc RunSample {w} {
+ set top [frame $w.f -bd 1 -relief raised]
+ set box [tixButtonBox $w.b -bd 1 -relief raised]
+
+ pack $box -side bottom -fill both
+ pack $top -side top -fill both -expand yes
+
+ # Create the scrolled tlist
+ #
+ tixScrolledTList $top.st -options {
+ tlist.orient vertical
+ tlist.selectMode single
+ }
+ pack $top.st -expand yes -fill both -padx 10 -pady 10
+
+ # Insert a list of numbers into the tlist subwidget
+ #
+ set tlist [$top.st subwidget tlist]
+
+ set numbers {
+ one two three fours five six seven eight nine ten eleven
+ twelve thirdteen fourteen
+ }
+
+ foreach num $numbers {
+ $tlist insert end -itemtype imagetext -text $num \
+ -image [tix getimage openfold]
+ }
+
+ # Create the buttons
+ #
+ $box add ok -text Ok -command "destroy $w" -width 6
+ $box add cancel -text Cancel -command "destroy $w" -width 6
+}
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/STList2.tcl b/tix/demos/samples/STList2.tcl
new file mode 100644
index 00000000000..c5997cfd309
--- /dev/null
+++ b/tix/demos/samples/STList2.tcl
@@ -0,0 +1,81 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# Demonstrates the scrolled tlist widget
+#
+
+proc RunSample {w} {
+ set top [frame $w.f -bd 1 -relief raised]
+ set box [tixButtonBox $w.b -bd 1 -relief raised]
+
+ pack $box -side bottom -fill both
+ pack $top -side top -fill both -expand yes
+
+ # Create the Paned Window to contain two scrolled tlist's
+ #
+ set p [tixPanedWindow $top.p -orient horizontal]
+ pack $p -expand yes -fill both -padx 4 -pady 4
+
+ set p1 [$p add pane1 -expand 1]
+ set p2 [$p add pane2 -expand 1]
+
+ $p1 config -relief flat
+ $p2 config -relief flat
+
+ # Create a TList with vertical orientation
+ #
+ tixScrolledTList $p1.st -options {
+ tlist.orient vertical
+ tlist.selectMode single
+ }
+ label $p1.lab -text "Vertical Orientation"
+
+ pack $p1.lab -anchor c -side top -pady 2
+ pack $p1.st -expand yes -fill both -padx 10 -pady 10
+
+ # Create a TList with horizontal orientation
+ #
+ tixScrolledTList $p2.st -options {
+ tlist.orient horizontal
+ tlist.selectMode single
+ }
+ label $p2.lab -text "Horizontal Orientation"
+
+ pack $p2.lab -anchor c -side top -pady 2
+ pack $p2.st -expand yes -fill both -padx 10 -pady 10
+
+ # Insert a list of numbers into the two tlist subwidget's
+ #
+ set vt [$p1.st subwidget tlist]
+ set ht [$p2.st subwidget tlist]
+
+ set numbers {
+ one two three fours five six seven eight nine ten eleven
+ twelve thirdteen fourteen
+ }
+
+ foreach num $numbers {
+ $vt insert end -itemtype imagetext -text $num \
+ -image [tix getimage openfold]
+ $ht insert end -itemtype imagetext -text $num \
+ -image [tix getimage openfold]
+ }
+
+ # Create the buttons
+ #
+ $box add ok -text Ok -command "destroy $w" -width 6
+ $box add cancel -text Cancel -command "destroy $w" -width 6
+}
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/STList3.tcl b/tix/demos/samples/STList3.tcl
new file mode 100644
index 00000000000..eef41137ca0
--- /dev/null
+++ b/tix/demos/samples/STList3.tcl
@@ -0,0 +1,121 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# Demonstrates the use of DirTree with the TList
+#
+
+proc RunSample {w} {
+ set top [frame $w.f -bd 1 -relief raised]
+ set box [tixButtonBox $w.b -bd 1 -relief raised]
+
+ pack $box -side bottom -fill both
+ pack $top -side top -fill both -expand yes
+
+ # Create the Paned Window to contain the dirtree and scrolled tlist
+ #
+ set p [tixPanedWindow $top.p -orient horizontal]
+ pack $p -expand yes -fill both -padx 4 -pady 4
+
+ set p1 [$p add pane1 -expand 1]
+ set p2 [$p add pane2 -expand 4]
+
+ $p1 config -relief flat
+ $p2 config -relief flat
+
+ # Create a DirTree
+ #
+ tixDirTree $p1.dirtree -options {
+ hlist.width 28
+ }
+
+ pack $p1.dirtree -expand yes -fill both -padx 4 -pady 4
+
+
+ # Create a TList
+ # NOTE: we set the width of the tlist to 60 characters, since we'll have
+ # quite a few files to display
+ #
+ tixScrolledTList $p2.st -options {
+ tlist.orient vertical
+ tlist.selectMode single
+ tlist.width 60
+ tlist.height 25
+ }
+ pack $p2.st -expand yes -fill both -padx 4 -pady 4
+
+ set tlist [$p2.st subwidget tlist]
+
+ # setup the callbacks: when the user selects a directory, we'll display
+ # its content in the tlist widget
+ $p1.dirtree config \
+ -browsecmd "TList:listdir $tlist" \
+ -command "TList:listdir $tlist"
+
+ # List the directory now
+ #
+ TList:listdir $tlist [pwd]
+
+ # Create the buttons
+ #
+ $box add ok -text Ok -command "destroy $w" -width 6
+ $box add cancel -text Cancel -command "destroy $w" -width 6
+}
+
+proc TList:listdir {w dir} {
+ $w delete 0 end
+
+ set appPWD [pwd]
+
+ if [catch {cd $dir} err] {
+ # The user has entered an invalid directory
+ # %% todo: prompt error, go back to last succeed directory
+ cd $appPWD
+ return
+ }
+
+ foreach fname [lsort [glob -nocomplain *]] {
+ if [file isdirectory $fname] {
+ set image [tix getimage folder]
+ } else {
+ continue
+ }
+
+ $w insert end -itemtype imagetext \
+ -text $fname -image $image
+ }
+
+ foreach fname [lsort [glob -nocomplain *]] {
+ if [file isdirectory $fname] {
+ continue
+ } elseif [string match *.c $fname] {
+ set image [tix getimage srcfile]
+ } elseif [string match *.h $fname] {
+ set image [tix getimage srcfile]
+ } elseif [string match *.tcl $fname] {
+ set image [tix getimage file]
+ } elseif [string match *.o $fname] {
+ set image [tix getimage file]
+ } else {
+ set image [tix getimage textfile]
+ }
+
+ $w insert end -itemtype imagetext \
+ -text $fname -image $image
+ }
+
+ cd $appPWD
+}
+
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/SText.tcl b/tix/demos/samples/SText.tcl
new file mode 100644
index 00000000000..6dea90ad6dd
--- /dev/null
+++ b/tix/demos/samples/SText.tcl
@@ -0,0 +1,71 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixScrolledText widget.
+#
+
+proc RunSample {w} {
+
+ # We create the frame and the ScrolledText widget
+ # at the top of the dialog box
+ #
+ frame $w.top -relief raised -bd 1
+
+ # Create a Scrolled Text widget.
+ #
+ tixScrolledText $w.top.a
+ pack $w.top.a -expand yes -fill both -padx 10 -pady 10 -side left
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "destroy $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+
+ # Put the junk inside the text subwidget of the ScrolledText widget
+ #
+ $w.top.a subwidget text insert end {
+Mon, 19 Jun 1995 11:39:52 comp.lang.tcl Thread 34 of 220
+Lines 353 A new way to put text and bitmaps together
+ioi@xpi.com Ioi K. Lam at Expert Interface Technologies
+
+Hi,
+
+I have implemented a new image type called "compound". It allows you
+to glue together a bunch of bitmaps, images and text strings together
+to form a bigger image. Then you can use this image with widgets that
+support the -image option. This way you can display very fancy stuffs
+in your GUI. For example, you can display a text string string
+together with a bitmap, at the same time, inside a TK button widget. A
+screenshot of compound images can be found at the bottom of this page:
+
+ http://www.xpi.com/tix/screenshot.html
+
+You can also you is in other places such as putting fancy bitmap+text
+in menus, tabs of tixNoteBook widgets, etc. This feature will be
+included in the next release of Tix (4.0b1). Count on it to make jazzy
+interfaces!}
+}
+
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
+
diff --git a/tix/demos/samples/SWindow.tcl b/tix/demos/samples/SWindow.tcl
new file mode 100644
index 00000000000..59d29b367f6
--- /dev/null
+++ b/tix/demos/samples/SWindow.tcl
@@ -0,0 +1,85 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixScrolledWindow widget.
+#
+
+proc RunSample {w} {
+
+ # We create the frame and the ScrolledWindow widget
+ # at the top of the dialog box
+ #
+ frame $w.top -relief raised -bd 1
+
+ # Create a complex window inside the ScrolledWindow widget.
+ # ScrolledWindow are very convenient: unlink the canvas widget,
+ # you don't need to specify the scroll-redions for the
+ # ScrolledWindow. It will automatically adjust itself to fit
+ # size of the "window" subwidget
+ #
+ # [Hint] Be sure you create and pack new widgets inside the
+ # "window" subwidget and NOT inside $w.top.a itself!
+ #
+ tixScrolledWindow $w.top.a
+ pack $w.top.a -expand yes -fill both -padx 10 -pady 10 -side left
+
+ set f [$w.top.a subwidget window]
+ tixNoteBook $f.nb
+ pack $f.nb -expand yes -fill both -padx 20 -pady 20
+
+
+ $f.nb add image -label "Image" -underline 0
+ $f.nb add buttons -label "Buttons" -underline 0
+
+ # The first page: an image
+ #
+ global demo_dir
+ set p [$f.nb subwidget image]
+ set im [image create photo -file $demo_dir/bitmaps/tix.gif]
+ label $p.lab -image $im
+ pack $p.lab -padx 20 -pady 20
+
+ # The second page: buttons
+ #
+ set p [$f.nb subwidget buttons]
+ button $p.b1 -text "Welcome" -width 8
+ button $p.b2 -text "to" -width 8
+ button $p.b3 -text "the" -width 8
+ button $p.b4 -text "World" -width 8
+ button $p.b5 -text "of" -width 8
+ button $p.b6 -text "Tix" -width 8
+
+ pack $p.b1 $p.b2 $p.b3 $p.b4 $p.b5 $p.b6 -anchor c -side top
+
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "destroy $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+
+ wm geometry $w 240x220
+}
+
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
+
diff --git a/tix/demos/samples/Sample.tcl b/tix/demos/samples/Sample.tcl
new file mode 100644
index 00000000000..063f9b0d8f7
--- /dev/null
+++ b/tix/demos/samples/Sample.tcl
@@ -0,0 +1,32 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# REPLACE WITH DESCRIPTION OF THIS DEMO.
+#
+
+proc RunSample {w} {
+ set top [frame $w.f -bd 1 -relief raised]
+ set box [tixButtonBox $w.b -bd 1 -relief raised]
+
+ pack $box -side bottom -fill both
+ pack $top -side top -fill both -expand yes
+
+
+ # Create the buttons
+ #
+ $box add ok -text Ok -command "destroy $w" -width 6
+ $box add cancel -text Cancel -command "destroy $w" -width 6
+}
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/Select.tcl b/tix/demos/samples/Select.tcl
new file mode 100644
index 00000000000..80e6c5a690b
--- /dev/null
+++ b/tix/demos/samples/Select.tcl
@@ -0,0 +1,110 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixSelect widget.
+#
+proc RunSample {w} {
+ global demo_dir
+
+ # Create the frame on the top of the dialog box with two tixSelect
+ # widgets inside.
+ #
+ frame $w.top
+
+ # There can be one and only type of justification for any piece of text.
+ # So we set -radio to be true. Also, -allowzero is set to false: the user
+ # cannot select a "none" justification
+ #
+ tixSelect $w.top.just -allowzero false -radio true \
+ -label "Justification: "\
+ -options {
+ label.width 15
+ label.padx 4
+ label.anchor e
+ }
+
+ # The user can select one or many or none of the font attributes in
+ # the font Select widget, so we set -radio to false (can select one or
+ # many) and -allowzero to true (can select none)
+ #
+ tixSelect $w.top.font -allowzero true -radio false \
+ -label "Font: " \
+ -options {
+ label.width 15
+ label.padx 4
+ label.anchor e
+ }
+
+ pack $w.top.just $w.top.font -side top -expand yes -anchor c \
+ -padx 4 -pady 4
+
+ # Add the choices of available font attributes
+ #
+ #
+ $w.top.font add bold -bitmap @$demo_dir/bitmaps/bold.xbm
+ $w.top.font add italic -bitmap @$demo_dir/bitmaps/italic.xbm
+ $w.top.font add underline -bitmap @$demo_dir/bitmaps/underlin.xbm
+ $w.top.font add capital -bitmap @$demo_dir/bitmaps/capital.xbm
+
+ # Add the choices of available justification types
+ #
+ #
+ $w.top.just add left -bitmap @$demo_dir/bitmaps/leftj.xbm
+ $w.top.just add right -bitmap @$demo_dir/bitmaps/rightj.xbm
+ $w.top.just add center -bitmap @$demo_dir/bitmaps/centerj.xbm
+ $w.top.just add justified -bitmap @$demo_dir/bitmaps/justify.xbm
+
+ $w.top.font config -variable sel_font
+ $w.top.just config -variable sel_just
+
+ # Set the default value of the two Select widgets
+ #
+ #
+ global sel_just sel_font
+ set sel_just justified
+ set sel_font {bold underline}
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -width 6\
+ -command "sel:cmd $w; destroy $w"
+
+ $w.box add apply -text Apply -underline 0 -width 6\
+ -command "sel:cmd $w"
+
+ $w.box add cancel -text Cancel -underline 0 -width 6\
+ -command "destroy $w"
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+# This procedure is called whenever the user pressed the OK or the Apply button
+#
+#
+proc sel:cmd {w} {
+ global sel_font sel_just
+
+ puts "The justification is $sel_just"
+
+ if {$sel_font == {}} {
+ puts "The font is normal"
+ } else {
+ puts "The font is $sel_font"
+ }
+
+}
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind .demo <Destroy> exit
+}
diff --git a/tix/demos/samples/StdBBox.tcl b/tix/demos/samples/StdBBox.tcl
new file mode 100644
index 00000000000..af5c4f9c9ab
--- /dev/null
+++ b/tix/demos/samples/StdBBox.tcl
@@ -0,0 +1,61 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of the tixStdButtonBox widget, which is a
+# group of "Standard" buttons for Motif-like dialog boxes.
+#
+proc RunSample {w} {
+
+ # Create the label on the top of the dialog box
+ #
+ label $w.top -padx 20 -pady 10 -border 1 -relief raised -text \
+ "This dialog box is\n a demostration of the\n tixStdButtonBox widget" \
+ -justify center -anchor c
+
+ # Create the button box. We also do some manipulation of the
+ # button widgets inside: we disable the help button and change
+ # the label string of the "apply" button to "Filter"
+ #
+ # Note that the -text, -underline, -command and -width options are all
+ # standard options of the button widgets.
+ #
+ tixStdButtonBox $w.box
+ $w.box subwidget ok config \
+ -command "puts {OK pressed}; destroy $w"
+ $w.box subwidget apply config -text "Filter" -underline 0 \
+ -command "puts {Filter pressed}"
+ $w.box subwidget cancel config \
+ -command "puts {Cancel pressed}; destroy $w"
+ $w.box subwidget help config -state disabled
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes -anchor c
+
+
+ # "after 0" is used so that the key bindings won't interfere with
+ # tkTraverseMenu
+ #
+ bind [winfo toplevel $w] <Alt-o> \
+ "after 0 tkButtonInvoke [$w.box subwidget ok]"
+ bind [winfo toplevel $w] <Alt-f> \
+ "after 0 tkButtonInvoke [$w.box subwidget apply]"
+ bind [winfo toplevel $w] <Alt-c> \
+ "after 0 tkButtonInvoke [$w.box subwidget cancel]"
+ bind [winfo toplevel $w] <Escape> \
+ "after 0 tkButtonInvoke [$w.box subwidget cancel]"
+
+ focus [$w.box subwidget apply]
+}
+
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
diff --git a/tix/demos/samples/Tree.tcl b/tix/demos/samples/Tree.tcl
new file mode 100644
index 00000000000..b32a63d572c
--- /dev/null
+++ b/tix/demos/samples/Tree.tcl
@@ -0,0 +1,87 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates how to use the TixTree widget to display
+# hierachical data (A hypothetical DOS disk drive).
+#
+
+proc RunSample {w} {
+
+ # We create the frame and the ScrolledHList widget
+ # at the top of the dialog box
+ #
+ frame $w.top -relief raised -bd 1
+
+ # Create a TixTree widget to display the hypothetical DOS disk drive
+ #
+ #
+ tixTree $w.top.a -options {
+ separator "\\"
+ }
+
+ pack $w.top.a -expand yes -fill both -padx 10 -pady 10 -side left
+
+ set tree $w.top.a
+ set hlist [$w.top.a subwidget hlist]
+
+ # STEP (1) Add the directories into the TixTree widget (using the
+ # hlist subwidget)
+
+ set directories {
+ C:
+ C:\\Dos
+ C:\\Windows
+ C:\\Windows\\System
+ }
+
+ foreach d $directories {
+ set text [lindex [split $d \\] end]
+ $hlist add $d -itemtype imagetext \
+ -text $text -image [tix getimage folder]
+ }
+
+ # STEP (2) Use the "autosetmode" method of TixTree to indicate
+ # which entries can be opened or closed. The
+ # "autosetmode" command will call the "setmode" method
+ # to set the mode of each entry to the following:
+ #
+ # "open" : the entry has some children and the children are
+ # currently visible
+ # "close": the entry has some children and the children are
+ # currently INvisible
+ # "none": the entry does not have children.
+ #
+ # If you don't like the "autosetmode" method, you can always call
+ # "setmode" yourself, but that takes more work.
+
+ $tree autosetmode
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "destroy $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> {if {"%W" == ".demo"} exit}
+}
+
diff --git a/tix/demos/samples/Xpm.tcl b/tix/demos/samples/Xpm.tcl
new file mode 100644
index 00000000000..a2f33999947
--- /dev/null
+++ b/tix/demos/samples/Xpm.tcl
@@ -0,0 +1,85 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of XPM images.
+#
+
+proc RunSample {w} {
+
+ set hard_disk_pixmap {/* XPM */
+ static char * drivea_xpm[] = {
+ /* width height ncolors chars_per_pixel */
+ "32 32 5 1",
+ /* colors */
+ " s None c None",
+ ". c #000000000000",
+ "X c white",
+ "o c #c000c000c000",
+ "O c #800080008000",
+ /* pixels */
+ " ",
+ " ",
+ " ",
+ " ",
+ " ",
+ " ",
+ " ",
+ " ",
+ " ",
+ " .......................... ",
+ " .XXXXXXXXXXXXXXXXXXXXXXXo. ",
+ " .XooooooooooooooooooooooO. ",
+ " .Xooooooooooooooooo..oooO. ",
+ " .Xooooooooooooooooo..oooO. ",
+ " .XooooooooooooooooooooooO. ",
+ " .Xoooooooo.......oooooooO. ",
+ " .Xoo...................oO. ",
+ " .Xoooooooo.......oooooooO. ",
+ " .XooooooooooooooooooooooO. ",
+ " .XooooooooooooooooooooooO. ",
+ " .XooooooooooooooooooooooO. ",
+ " .XooooooooooooooooooooooO. ",
+ " .oOOOOOOOOOOOOOOOOOOOOOOO. ",
+ " .......................... ",
+ " ",
+ " ",
+ " ",
+ " ",
+ " ",
+ " ",
+ " ",
+ " "};
+ }
+
+ frame $w.top -relief raised -bd 1
+ button $w.top.b -image [image create pixmap -data $hard_disk_pixmap]
+ pack $w.top -expand yes -fill both
+ pack $w.top.b -expand yes -padx 20 -pady 20
+
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "destroy $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+}
+
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind $w <Destroy> exit
+}
+
diff --git a/tix/demos/samples/Xpm1.tcl b/tix/demos/samples/Xpm1.tcl
new file mode 100644
index 00000000000..8ad88784f95
--- /dev/null
+++ b/tix/demos/samples/Xpm1.tcl
@@ -0,0 +1,104 @@
+# Tix Demostration Program
+#
+# This sample program is structured in such a way so that it can be
+# executed from the Tix demo program "widget": it must have a
+# procedure called "RunSample". It should also have the "if" statment
+# at the end of this file so that it can be run as a standalone
+# program using tixwish.
+
+# This file demonstrates the use of XPM images in the menu.
+#
+
+proc RunSample {w} {
+
+ set hard_disk_pixmap {/* XPM */
+ static char * drivea_xpm[] = {
+ /* width height ncolors chars_per_pixel */
+ "32 32 5 1",
+ /* colors */
+ " s None c None",
+ ". c #000000000000",
+ "X c white",
+ "o c #c000c000c000",
+ "O c #800080008000",
+ /* pixels */
+ " ",
+ " ",
+ " ",
+ " ",
+ " ",
+ " ",
+ " ",
+ " ",
+ " ",
+ " .......................... ",
+ " .XXXXXXXXXXXXXXXXXXXXXXXo. ",
+ " .XooooooooooooooooooooooO. ",
+ " .Xooooooooooooooooo..oooO. ",
+ " .Xooooooooooooooooo..oooO. ",
+ " .XooooooooooooooooooooooO. ",
+ " .Xoooooooo.......oooooooO. ",
+ " .Xoo...................oO. ",
+ " .Xoooooooo.......oooooooO. ",
+ " .XooooooooooooooooooooooO. ",
+ " .XooooooooooooooooooooooO. ",
+ " .XooooooooooooooooooooooO. ",
+ " .XooooooooooooooooooooooO. ",
+ " .oOOOOOOOOOOOOOOOOOOOOOOO. ",
+ " .......................... ",
+ " ",
+ " ",
+ " ",
+ " ",
+ " ",
+ " ",
+ " ",
+ " "};
+ }
+ # We create the frame and the ScrolledText widget
+ # at the top of the dialog box
+ #
+ frame $w.top -relief raised -bd 1
+
+ set m [frame $w.top.menu -relief raised -bd 2]
+ set mb [menubutton $m.mb -text Options -menu $m.mb.m]
+ set menu [menu $mb.m]
+
+ pack $m -side top -fill x
+ pack $mb -side left -fill y
+
+ # Put the label there
+ #
+ set lab [label $w.top.label -text "Go to the \"Options\" menu" -anchor c]
+ pack $lab -padx 40 -pady 40 -fill both -expand yes
+
+ set image [image create pixmap -data $hard_disk_pixmap]
+ $menu add command -image $image \
+ -command "$lab config -image $image"
+
+ # Use a ButtonBox to hold the buttons.
+ #
+ tixButtonBox $w.box -orientation horizontal
+ $w.box add ok -text Ok -underline 0 -command "destroy $w" \
+ -width 6
+ $w.box add cancel -text Cancel -underline 0 -command "destroy $w" \
+ -width 6
+
+ pack $w.box -side bottom -fill x
+ pack $w.top -side top -fill both -expand yes
+
+ wm geometry $w 300x300
+}
+
+
+# This "if" statement makes it possible to run this script file inside or
+# outside of the main demo program "widget".
+#
+if {![info exists tix_demo_running]} {
+ wm withdraw .
+ set w .demo
+ toplevel $w
+ RunSample $w
+ bind .demo <Destroy> exit
+}
+
diff --git a/tix/demos/tclIndex b/tix/demos/tclIndex
new file mode 100644
index 00000000000..1d1a5700b29
--- /dev/null
+++ b/tix/demos/tclIndex
@@ -0,0 +1,54 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "tixindex" program,
+# *NOT* by the "auto_mkindex" command,
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(MkChoosers) "source {$dir/MkChoose.tcl}"
+set auto_index(MkCombo) "source {$dir/MkChoose.tcl}"
+set auto_index(stCmd) "source {$dir/MkChoose.tcl}"
+set auto_index(stValidate) "source {$dir/MkChoose.tcl}"
+set auto_index(MkControl) "source {$dir/MkChoose.tcl}"
+set auto_index(MkSelect) "source {$dir/MkChoose.tcl}"
+set auto_index(MkOptMenu) "source {$dir/MkChoose.tcl}"
+set auto_index(MkFileEnt) "source {$dir/MkChoose.tcl}"
+set auto_index(MkFileBox) "source {$dir/MkChoose.tcl}"
+set auto_index(MkToolBar) "source {$dir/MkChoose.tcl}"
+set auto_index(MkTitle) "source {$dir/MkChoose.tcl}"
+set auto_index(MkDirList) "source {$dir/MkDirLis.tcl}"
+set auto_index(MkDirListWidget) "source {$dir/MkDirLis.tcl}"
+set auto_index(MkExFileWidget) "source {$dir/MkDirLis.tcl}"
+set auto_index(MkManager) "source {$dir/MkManag.tcl}"
+set auto_index(MkPanedWindow) "source {$dir/MkManag.tcl}"
+set auto_index(MkNoteBook) "source {$dir/MkManag.tcl}"
+set auto_index(CreateCommonButtons) "source {$dir/MkManag.tcl}"
+set auto_index(MkSample) "source {$dir/MkSample.tcl}"
+set auto_index(AddSampleToHList) "source {$dir/MkSample.tcl}"
+set auto_index(Sample:Action) "source {$dir/MkSample.tcl}"
+set auto_index(RunProg) "source {$dir/MkSample.tcl}"
+set auto_index(LoadFile) "source {$dir/MkSample.tcl}"
+set auto_index(ReadFileWhenIdle) "source {$dir/MkSample.tcl}"
+set auto_index(ReadFile) "source {$dir/MkSample.tcl}"
+set auto_index(MkScroll) "source {$dir/MkScroll.tcl}"
+set auto_index(MkSList) "source {$dir/MkScroll.tcl}"
+set auto_index(SList:Reset) "source {$dir/MkScroll.tcl}"
+set auto_index(MkSWindow) "source {$dir/MkScroll.tcl}"
+set auto_index(SWindow:Reset) "source {$dir/MkScroll.tcl}"
+set auto_index(MkSText) "source {$dir/MkScroll.tcl}"
+set auto_index(SText:Reset) "source {$dir/MkScroll.tcl}"
+set auto_index(MkMainWindow) "source {$dir/widget}"
+set auto_index(MkMainMenu) "source {$dir/widget}"
+set auto_index(MkMainNoteBook) "source {$dir/widget}"
+set auto_index(CreatePage) "source {$dir/widget}"
+set auto_index(MkMainStatus) "source {$dir/widget}"
+set auto_index(MkWelcome) "source {$dir/widget}"
+set auto_index(MkWelcomeBar) "source {$dir/widget}"
+set auto_index(MkWelcomeText) "source {$dir/widget}"
+set auto_index(MainTextFont) "source {$dir/widget}"
+set auto_index(FileOpen) "source {$dir/widget}"
+set auto_index(FileOpen:Doit) "source {$dir/widget}"
+set auto_index(BalloonHelp) "source {$dir/widget}"
+set auto_index(Widget:SelfTest) "source {$dir/widget}"
diff --git a/tix/demos/widget b/tix/demos/widget
new file mode 100755
index 00000000000..e0841d7e21b
--- /dev/null
+++ b/tix/demos/widget
@@ -0,0 +1,367 @@
+#!/bin/sh
+# the next line restarts using tixwish \
+exec tixwish "$0" "$@"
+
+# widget --
+#
+# This is a demo program of all the available Tix widgets. If
+# have installed Tix properly, you can execute this program
+# directly:
+#
+# % widget
+#
+# Otherwise try the following in csh
+#
+# % env TIX_LIBRARY=../library tixwish widget
+#
+# Or this in sh
+#
+# $ TIX_LIBRARY=../library tixwish widget
+#
+#
+#
+#----------------------------------------------------------------------
+#
+#
+# This file has not been properly documented. It is NOT intended
+# to be used as an introductory demo program about Tix
+# programming. For such demos, please see the files in the
+# demos/samples directory or go to the "Samples" page in the
+# "widget demo"
+#
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+proc MkMainWindow {w} {
+ global demo auto_path demo_dir
+
+ if ![info exists demo_dir] {
+ # Initialize the auto_path and the bitmap directory. The demo_dir
+ # variable would be already set by the test program, if we are
+ # running in the self test more
+ #
+ set script [info script]
+ if {$script != {}} {
+ set demo_dir [file dirname $script]
+ } else {
+ set demo_dir [pwd]
+ }
+
+ set demo_dir [tixFSAbsPath $demo_dir]
+ }
+
+ lappend auto_path $demo_dir
+ tix addbitmapdir [tixFSJoin $demo_dir bitmaps]
+
+ toplevel $w
+ wm title $w "Tix Widget Demonstration"
+ wm geometry $w 830x566+100+100
+
+ set demo(balloon) [tixBalloon .demos_balloon]
+
+ set frame1 [MkMainMenu $w]
+ set frame2 [MkMainNoteBook $w]
+ set frame3 [MkMainStatus $w]
+
+ pack $frame1 -side top -fill x
+ pack $frame3 -side bottom -fill x
+ pack $frame2 -side top -expand yes -fill both -padx 4 -pady 4
+
+ $demo(balloon) config -statusbar $demo(statusbar)
+ set demo(notebook) $frame2
+}
+
+proc MkMainMenu {top} {
+ global demo usebal
+
+ set w [frame $top.f1 -bd 2 -relief raised]
+
+ menubutton $w.file -menu $w.file.m -text File -underline 0 \
+ -takefocus 0
+ menubutton $w.help -menu $w.help.m -text Help -underline 0 \
+ -takefocus 0
+
+ menu $w.file.m
+ $w.file.m add command -label "Open ... " -command FileOpen -underline 1 \
+ -accelerator "Ctrl+O"
+ $w.file.m add sep
+ $w.file.m add command -label "Exit " -command exit -underline 1 \
+ -accelerator "Ctrl+X"
+
+ menu $w.help.m
+
+ $w.help.m add checkbutton -under 0 -label "Balloon Help " \
+ -variable usebal -onvalue 1 -offvalue 0
+
+ tixForm $w.file
+ tixForm $w.help -right -0
+
+ trace variable usebal w BalloonHelp
+
+ set usebal 1
+
+ # Accelerator bindings
+
+ bind all <Control-x> "exit"
+ bind all <Control-o> "FileOpen"
+
+ return $w
+}
+
+# Create the main display area of the widget programm. This area should
+# utilize the "tixNoteBook" widget once it is available. But now
+# we use the cheap substitute "tixStackWindow"
+#
+proc MkMainNoteBook {top} {
+ global demo
+ set hasGL 0
+
+ option add *TixNoteBook.tagPadX 6
+ option add *TixNoteBook.tagPadY 4
+ option add *TixNoteBook.borderWidth 2
+ option add *TixNoteBook.font\
+ -*-helvetica-bold-o-normal-*-14-*-*-*-*-*-*-*
+
+ set w [tixNoteBook $top.f2 -ipadx 5 -ipady 5]
+
+
+ $w add wel -createcmd "CreatePage MkWelcome $w wel" \
+ -label "Welcome" \
+ -under 0
+ $w add cho -createcmd "CreatePage MkChoosers $w cho" \
+ -label "Choosers" \
+ -under 0
+ $w add scr -createcmd "CreatePage MkScroll $w scr" \
+ -label "Scrolled Widgets" \
+ -under 0
+ $w add mgr -createcmd "CreatePage MkManager $w mgr" \
+ -label "Manager Widgets" \
+ -under 0
+ $w add dir -createcmd "CreatePage MkDirList $w dir" \
+ -label "Directory List" \
+ -under 0
+ $w add exp -createcmd "CreatePage MkSample $w exp" \
+ -label "Run Sample Programs" \
+ -under 0
+
+ if {$hasGL} {
+ $w add glw -createcmd "MkGL $w glw" -tag "GL Widgets"
+ }
+
+ return $w
+}
+
+proc CreatePage {command w name} {
+ tixBusy $w on
+ set id [after 10000 tixBusy $w off]
+ $command $w $name
+ after cancel $id
+ after 0 tixBusy $w off
+}
+
+proc MkMainStatus {top} {
+ global demo
+
+ set w [frame $top.f3 -relief raised -bd 1]
+ set demo(statusbar) \
+ [label $w.status -font -*-helvetica-medium-r-normal-*-14-*-*-*-*-*-*-*\
+ -relief sunken -bd 1]
+
+ tixForm $demo(statusbar) -padx 3 -pady 3 -left 0 -right %70
+
+ return $w
+}
+
+proc MkWelcome {nb page} {
+ set w [$nb subwidget $page]
+
+ set bar [MkWelcomeBar $w]
+ set text [MkWelcomeText $w]
+
+ pack $bar -side top -fill x -padx 2 -pady 2
+ pack $text -side top -fill both -expand yes
+}
+
+proc MkWelcomeBar {top} {
+ global demo
+
+ set w [frame $top.bar -bd 2 -relief groove]
+
+ # Create and configure comboBox 1
+ #
+ tixComboBox $w.cbx1 -command "MainTextFont $top" \
+ -options {
+ entry.width 15
+ listbox.height 3
+ }
+ tixComboBox $w.cbx2 -command "MainTextFont $top" \
+ -options {
+ entry.width 4
+ listbox.height 3
+ }
+ set demo(welfont) $w.cbx1
+ set demo(welsize) $w.cbx2
+
+ $w.cbx1 insert end "Courier"
+ $w.cbx1 insert end "Helvetica"
+ $w.cbx1 insert end "Lucida"
+ $w.cbx1 insert end "Times Roman"
+
+ $w.cbx2 insert end 8
+ $w.cbx2 insert end 10
+ $w.cbx2 insert end 12
+ $w.cbx2 insert end 14
+ $w.cbx2 insert end 18
+
+ $w.cbx1 pick 1
+ $w.cbx2 pick 3
+
+ # Pack the comboboxes together
+ #
+ pack $w.cbx1 $w.cbx2 -side left -padx 4 -pady 4
+
+ $demo(balloon) bind $w.cbx1\
+ -msg "Choose\na font" -statusmsg "Choose a font for this page"
+ $demo(balloon) bind $w.cbx2\
+ -msg "Point size" -statusmsg "Choose the font size for this page"
+
+
+ tixDoWhenIdle MainTextFont $top
+ return $w
+}
+
+proc MkWelcomeText {top} {
+ global demo tix_version
+
+ set w [tixScrolledWindow $top.f3 -scrollbar auto]
+ set win [$w subwidget window]
+
+ label $win.title -font -*-times-bold-r-normal-*-18-*-*-*-*-*-*-*\
+ -bd 0 -width 30 -anchor n\
+ -text "Welcome to TIX version $tix_version"
+
+ message $win.msg -font -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*\
+ -bd 0 -width 400 -anchor n\
+ -text "\
+Tix $tix_version is a library of mega-widgets based on TK. This program \
+demonstrates the widgets in the Tix widget. You can choose the pages \
+in this window to look at the corresponding widgets. \
+To quit this program, choose the \"File | Exit\" command."
+
+
+ pack $win.title -expand yes -fill both -padx 10 -pady 10
+ pack $win.msg -expand yes -fill both -padx 10 -pady 10
+ set demo(welmsg) $win.msg
+ return $w
+}
+
+proc MainTextFont {w args} {
+ global demo
+
+ if {![info exists demo(welmsg)]} {
+ return
+ }
+
+ set font [$demo(welfont) cget -value]
+ set point [$demo(welsize) cget -value]
+
+ case $font {
+ "Courier" {
+ set f courier
+ }
+ "Helvetica" {
+ set f helvetica
+ }
+ "Lucida" {
+ set f lucida
+ }
+ default {
+ set f times
+ }
+ }
+
+ set xfont [format "-*-%s-bold-r-normal-*-%s-*-*-*-*-*-*-*" $f $point]
+ if [catch {$demo(welmsg) config -font $xfont} err] {
+ puts \a$err
+ }
+}
+
+proc FileOpen {} {
+ global demo demo_dir
+ set filedlg [tix filedialog tixExFileSelectDialog]
+ if {![info exists demo(filedialog)]} {
+ $filedlg subwidget fsbox config -pattern *.tcl
+ $filedlg subwidget fsbox config -directory $demo_dir/samples
+ $filedlg config -command FileOpen:Doit
+ set demo(filedialog) $filedlg
+ }
+ $filedlg config -title "Open Tix Sample Programs"
+ $filedlg popup
+ tixPushGrab $filedlg
+}
+
+proc FileOpen:Doit {filename} {
+ global demo
+
+ LoadFile $filename
+ tixPopGrab
+ $demo(filedialog) popdown
+}
+
+#----------------------------------------------------------------------
+# Balloon Help
+#----------------------------------------------------------------------
+proc BalloonHelp {args} {
+ global demo usebal
+
+ if {$usebal} {
+ $demo(balloon) config -state "both"
+ } else {
+ $demo(balloon) config -state "none"
+ }
+}
+
+#----------------------------------------------------------------------
+# Self-testing
+#
+# The following code are called by the Tix test suite. It opens
+# every page in the demo program.
+#----------------------------------------------------------------------
+proc Widget:SelfTest {} {
+ global demo testConfig
+
+ if ![info exists testConfig] {
+ return
+ }
+
+ MkMainWindow .widget
+
+ update
+ foreach p [$demo(notebook) pages] {
+ $demo(notebook) raise $p
+ update
+ }
+
+ destroy .widget
+}
+
+
+#----------------------------------------------------------------------
+# Start!
+#----------------------------------------------------------------------
+if ![info exists testConfig] {
+ #
+ # If the testConfig variable exists, we are driven by the regression
+ # test. In that case, don't open the main window. The test program will
+ # call Widget:SelfTest
+ #
+ wm withdraw .
+ MkMainWindow .widget
+ bind .widget <Destroy> "exit"
+}
+
diff --git a/tix/docs/BinInst.html b/tix/docs/BinInst.html
new file mode 100644
index 00000000000..75fd7e5a87b
--- /dev/null
+++ b/tix/docs/BinInst.html
@@ -0,0 +1,12 @@
+<TITLE>Tix Binary Distribution</TITLE>
+<Center><H1>Tix Binary Distribution</H1></Center>
+
+ You can download Tix binaries from <a
+ href="http://www.xpi.com/download/binaries.html">
+ http://www.xpi.com/download/binaries.html</a>. There is instruction
+ on this page for install the Tix binaries on each supported
+ platform. <p>
+
+<!Serial 851729139>
+<hr><i>Last modified Wed Feb 12 15:13:27 EST 1997 </i> ---
+<i>Serial 856069648</i>
diff --git a/tix/docs/BinInst.txt b/tix/docs/BinInst.txt
new file mode 100644
index 00000000000..7979c5ec065
--- /dev/null
+++ b/tix/docs/BinInst.txt
@@ -0,0 +1,11 @@
+
+ TIX BINARY DISTRIBUTION
+
+ You can download Tix binaries from
+ http://www.xpi.com/download/binaries.html. There is instruction on
+ this page for install the Tix binaries on each supported platform.
+
+ _________________________________________________________________
+
+ Last modified Wed Feb 12 15:13:27 EST 1997 --- Serial 856069648
+
diff --git a/tix/docs/Changes.html b/tix/docs/Changes.html
new file mode 100644
index 00000000000..16defcc84ff
--- /dev/null
+++ b/tix/docs/Changes.html
@@ -0,0 +1,333 @@
+<TITLE>Changes Made to Tix</TITLE>
+<Center><H1>Changes Made to Tix</H1></Center>
+
+<ul>
+<!---------------------------------------------------------------------->
+<hr>
+</ul><h3><a name=4.0.4+>Changes Since Tix 4.0.4</h3><ul>
+
+<h4>5/5/96</h4>
+
+ <li><b>New feature:</b> New tool unix-et-tk4.0/makescript.tcl. It
+ includes the Tix script library into a ET application in the correct
+ order. If A.tcl depends on B.tcl, then B.tcl is loaded first.<p>
+
+<h4>5/6/96</h4>
+
+ <li><b>New feature:</b> Now the -default option of the Tix mega widget
+ classes are inherited from their superclasses.<p>
+
+ <li><b>New feature:</b> New option -expand for the panes in PanedWindow<p>
+
+ <li><b>Bug Fixed:</b> ScrolledHList didn't calculate the size of the
+ hlist subwidget correctly, resulting in scrollbars not appearing
+ even if the hlist widget is not big enough to display all of its
+ contents.<p>
+
+<h4>5/8/96</h4>
+
+ <li><b>New feature:</b> New method setsize for PanedWindow.<p>
+
+<h4>5/10/96</h4>
+
+ <li><b>New feature:</b> New widget tixMeter, can be used to display the
+ progress of work.<p>
+
+ <li><b>Bug Fixed:</b> HList multiple and extended selectMode now work
+ with TixTree.<p>
+
+<h4>5/11/96</h4>
+
+ <li><b>Bug Fixed:</b> HList "see" method sometimes doesn't display the
+ specified element correctly.<p>
+
+ <li><b>New widgets:</b> New widgets CheckList, Grid, ScrolledGrid, TList
+ and ScrolledTList added to the Tix 4.1 distribution.<p>
+
+ <li><b>New feature:</b> New option -postcmd for PopupMenu widget.<p>
+
+<!---------------------------------------------------------------------->
+<hr>
+</ul><h3><a name=4.1a3+>Changes Since Tix 4.1a3<ul></h3>
+
+<h4>7/14/96</h4>
+
+ <li><b>New feature:</b> Supports ET+TK4.1. --enable-tk41_et flag for
+ configure script.<p>
+
+ <li><b>New feature:</b> Supports ITCL 2.1. --enable-itcl21 flag for
+ configure script.<p>
+
+ <li><b>New feature:</b> Default color schemes and fontset can be set
+ when Tix is compiled: --with-fontset= and --with-scheme= flags for
+ configure script.<p>
+
+ <li><b>Incompatibility:</b> All the "::" qualifiers in Tix class methods
+ have been replaced by ":", so that the Tix classes can be loaded
+ into Itcl without patching Itcl. If you have written your own Tix
+ classes, you need to modify the source files to use the ":"
+ qualifier instead. <p>
+
+ The program tools/setcolon.sh helps you port your code from the "::"
+ convention to the ":" convention. Execute the program without
+ argument for usage syntax. It may modify your code in unexpected
+ ways. Use with caution. <p>
+
+<h4>7/15/96</h4>
+
+ <li><b>New feature:</b> New function Tix_SetRcFileName() and new macros
+ TCL_7_5_OR_LATER, TK_4_1_OR_LATER to provide better support for both
+ Tcl7.4/Tk4.0 and Tcl7.5+/Tk4.1+. <p>
+
+ <li><b>Bug Fixed:</b> <code>entrycget</code> method of OptionMenu didn't
+ work as expected. <p>
+
+<h4>7/17/96</h4>
+
+ The demos-c subdirectory has been moved to demos/c-code. <p>
+
+<h4>7/24/96</h4>
+
+ <li><b>Bug Fixed:</b> tixMwm now deletes information about a toplevel
+ when the toplevel is destroyed.<p>
+
+<h4>8/22/96</h4>
+
+ <li><b>New feature:</b> New command "tixConsoleInit" available with Tcl
+ 7.5/Tk 4.1. Create console window that runs in a separate
+ interpreter. <p>
+
+ <li><b>New feature:</b> Now Tix works under multiple interpreters. <p>
+
+<h4>8/23/96</h4>
+
+ <li><b>New feature:</b> Now ListNoteBook uses a PanedWindow to manage
+ the HList and the pages.<p>
+
+ <li><b>New feature:</b> New option -dynamicgeometry for PanedWindow.<p>
+
+<h4>8/24/96</h4>
+
+ <li><b>New feature:</b> New command "tixStrEq" compares the equality of
+ two strings.<p>
+
+<h4>9/12/96</h4>
+
+ <li><b>New feature:</b> Tix provides emulation for strcasecmp() for
+ platforms that do not support this function.<p>
+
+<h4>9/14/96</h4>
+
+ <li><b>New feature:</b> New widget command <code>selection get</code>
+ for HList. This is just an alias for <code>info
+ selection</code>. It's added so that the API is similar to the TK
+ API.<p>
+
+ <li><b>New feature:</b> New widget command <code>info bbox</code>
+ for HList. Used mainly in regression tests. <p>
+
+<h4>9/17/96</h4>
+
+ <li><b>New feature:</b> Orientation of the <b>pane</b> subwidget in
+ <li><b>TixListNoteBook</b> now configureable via the <b>-options</b>
+ switch during creation. <p>
+
+<h4>9/22/96</h4>
+
+ <li><b>New feature:</b> Now the default fontset and color scheme are
+ configurable in the setup.tcl program as well as in the configure
+ script. <p>
+
+<!---------------------------------------------------------------------->
+<hr>
+</ul><h3><a name=4.1b1+>Changes Since Tix 4.1b1<ul></h3>
+
+<h4>10/13/96</h4>
+
+ <li><b>New feature:</b> Now XPM image works on Windows. <p>
+
+<h4>10/18/96</h4>
+
+ <li><b>New feature:</b> New options -editablecmd and -editcmd for the
+ Grid widget to support editing of the entries. <p>
+
+ <li><b>New feature:</b> New options -editablecmd and -editcmd for the
+ Grid widget to support editing of the entries. <p>
+
+ <li><b>New feature:</b> New widget <b>TixFloatEntry</b> to support
+ editing of DItems. <p>
+
+<h4>10/27/96</h4>
+
+ <li><b>Feature Change:</b> The following changes are made to the
+ configuration and installation of Tix:
+ <ul>
+
+ <li> <b>Naming convention of binaries</b>: The binaries for the
+ Tk 4.0 target are called tixwish and libtix.a. For Tk 4.1 and
+ later, the executable is be called tixwish[Tix version].[Tk version]
+ and the library is called libtix[Tix version].[Tk
+ version].[lib extension]. For example, tixwish4.1.4.1 and
+ libtix4.1.4.2.so. On platforms that do not allow the dot
+ character in the names of shared libraries, the dot character
+ will be omitted. E.g., libtix4142.so.
+
+ <li> <b>Shared vs static linking</b>: The static binary will be
+ created only if the -enable-[tkversion]-shared flag is
+ disabled. If you want to create both shared and static
+ binaries, configure and compile Tix twice.
+
+ <li> ET support is replaced by SAM (stand-alone module)
+ support.
+
+ <li> The following options are removed from configure:
+ <ul>
+ <li> -enable-tk40_et
+ <li> -enable-tk41_et
+ <li> -enable-tk41_shared
+ </ul>
+
+ <li> The new options are added to configure:
+ <ul>
+ <li> -enable-tk40-sam
+ <li> -enable-tk41-sam
+ <li> -enable-tk42-sam
+ <li> -enable-tk41-shared
+ <li> -enable-tk42-shared
+ </ul>
+ </ul>
+
+
+<h4>11/1/96</h4>
+
+ <li><b>New feature:</b> XPM code has been rewritten. The code is now cleanly
+ separated into three modules: generic, windows specific and Unix specific.
+ <p>
+
+
+<h4>11/17/96</h4>
+
+ <li><b>New feature:</b> Tix classes can be defined before their
+ superclasses are defined. However, a class <b>cannot</b> be
+ instantiated before all of its superclasses are defined. This
+ feature makes it possible to load the Tix scripts into the SAM in
+ any order, without having to worry about loading the superclasses
+ before the subclasses. <p>
+
+ <li><b>New feature:</b> Tix is initialized by calling the command
+ <li><b>__tixInit</b>, not by sourcing <b>Init.tcl</b>. <p>
+
+<h4>11/29/96</h4>
+
+ <li><b>Bug Fixed:</b> tixTmpLine now correctly works on multiple X
+ displays. <p>
+
+<h4>11/30/96</h4>
+
+ <li><b>Feature Change</b>: DisplayStyle now uses a hash table to store
+ the items associated with it (previously a link list was used). This
+ speeds up the delete operations when a lot (1000 or more) of items
+ are associated with the same style. <b>Possible Incompatibility:</b>
+ widgets that use DItems must be recompiled. <p>
+
+ <li><b>Bug Fixed:</b> Tix no longer tempers with the way Tk handles
+ errors, unless the environment variable TIX_DEBUG_INTERACTIVE is
+ set. If this variable is set, all error messages will be printed to
+ the standard output. This may be convenient for debugging
+ purposes. Use this feature with discretion, and during program
+ development only. <p>
+
+<!---------------------------------------------------------------------->
+<hr>
+</ul><h3><a name=4.1b1+>Changes Since Tix 4.1b2<ul></h3>
+
+<h4>12/2/96</h4>
+
+ <li><b>Bug Fixed:</b>Dotted anchor lines (HList, TList, Grid) and
+ rubber-band lines (PanedWindow, ResizeHandle) are implemented on Windows.<p>
+
+ <li><b>New feature:</b> Tcl 7.6 support is complete for the Windows
+ platform. makefile.vc and makefile.bc have been modified such that
+ the Tcl version can be chosen at compile time by, e.g., "<b>make
+ TCL_VER=7.5 -f makefile.bc</b>". <p>
+
+<h4>12/2/96</h4>
+
+ <li><b>Bug Fixed:</b> Display items are correctly clipped. E.g., if a
+ text item is wider than the width of a column in an HList, the item
+ will be clipped.<p>
+
+<h4>12/20/96</h4>
+
+ <li><b>New feature:</b> New sample file demos/samples/EditGrid.tcl that
+ demonstrates the use of an editable grid widget. <p>
+
+<h4>12/21/96</h4>
+
+ <li><b>Bug Fixed:</b> Tix works with multiple interpreters under tk4.1
+ and 4.2 (see test/general/minterp.tcl). However, minterp.tcl still
+ core dumps under Itcl 2.1. It is not clear to me whether this is a
+ problem of Tix or Itcl. <p>
+
+ <li><b>Bug Fixed:</b> Now when an interpreter is deleted, all Tix class
+ informations associated with this interpreter are freed. (No memory
+ leak is recorded by purify when running Tix against the complete
+ test suite.) <p>
+
+<h4>1/17/96</h4>
+
+ <li><b>Feature Change:</b> The old monolithic configure script is now
+ split into one script per version of Tk/Itcl (tk 4.0, 4.1, 4.2, 4.3,
+ 8.0 and itcl 2.0, 2.1, 2.1). This makes the maintainence of the
+ configure scripts easier. The eight configure scripts and theisr
+ associated Makefile.in are generated by the programs
+ tools/doconfig.tcl and tools/domakefile.tcl. <p>
+
+ <li><b>Feature Change:</b> The Unix binary build directories have been
+ moved from <b>unix-tk4.x</b> into <b>unix/tk4.x</b>. The test
+ directory has been renamed into <b>tests</b>.<p>
+
+<!---------------------------------------------------------------------->
+<hr>
+</ul><h3><a name=4.1b1+>Changes Since Tix 4.1b3<ul></h3>
+
+<h4>2/14/96</h4>
+
+ <li><b>Feature Change:</b> Tix can be loaded using the "package
+ require" command. The "binary version" associated with Tix binaries
+ has been changed from 4.1.${TK_VERSION} to 4.1.${TCL_VERSION} (or
+ 4.1.${TCL_VERSION}.1 for Itcl). See <a
+ href="Pkg.txt">docs/Pkg.txt</a> for details.
+
+<!---------------------------------------------------------------------->
+<hr>
+</ul><h3><a name=4.1.0+>Changes Since Tix 4.1.0<ul></h3>
+
+<h4>4/7/97</h4>
+
+ <li>New global Tcl variable tix_release that indicates a "release"
+ of Tix. This makes it possible to identify frequent patch release of
+ Tix without modifying the tix_version and tix_patchLevel variables. <p>
+
+ <li> The missing "info selection" command is added to TList. Thanks
+ to David Sundstrom for the patch. <p>
+
+ <li> New "index" command for TList. <p>
+
+ <li> The Itcl-enabled tixwish is installed as tixwish4.1.x.x.1 on Unix --
+ with a .1 suffix similar to the shared library. <p>
+
+<i>New patch release 4.1.0.001 uploaded to
+ftp.xpi.com/pub/Tix4.1.0.tar.gz </i> <p>
+
+<h4>6/17/97</h4>
+
+ <li> New "info size" command for TList. <p>
+
+<h4>6/27/97</h4>
+
+ <li> New "see" command for TList. <p>
+
+ <li> SAM works with Tk 8.0 and Itcl 2.2. (Only tixsam?.so is
+ supported, no satixwish support.) <p>
+
diff --git a/tix/docs/ET.txt b/tix/docs/ET.txt
new file mode 100644
index 00000000000..21a3d35d72c
--- /dev/null
+++ b/tix/docs/ET.txt
@@ -0,0 +1,1325 @@
+Tcl/Tk has proven to be an excellent language for building small
+programs that require a Graphical User Interface (GUI). However, it is
+often inadequate for use in large commercial applications for a number
+of reasons:
+
+ * Execution speed is usually too slow for serious computation.
+ * Complex data structures are difficult to construct.
+ * The lack of structure and typing in the Tcl language complicates
+ the development of large codes.
+ * Tcl/Tk source code is easily read by the end user, making it hard
+ for developers to protect proprietary algorithms.
+ * Large Tcl/Tk programs typically consist of many separate files
+ that must be correctly positioned within the target computer's
+ file system. This can make the programs difficult to install,
+ maintain and administer.
+
+To circumvent these problems, we have constructed a system that makes
+it easy for a C or C++ program to invoke and interact with Tcl/Tk.
+This allows data structures and compute-intensive algorithms to be
+coded in C or C++ while the GUI is coded in Tcl/Tk. It also allows the
+entire application to be compiled into a single stand-alone
+executable, which is not easily readable by the end user and which can
+be run on computers that do not have Tcl/Tk installed. We call our
+system "ET" for "Embedded Tk".
+
+
+1. A Simple Example: ``Hello, World!''
+
+The following is an ET implementation of the classic "Hello, World!"
+program:
+
+
+ void main(int argc, char **argv){
+ Et_Init(&argc,argv);
+ ET( button .b -text {Hello, World!} -command exit; pack .b );
+ Et_MainLoop();
+ }
+
+This example is short, but is serves to illustrate the basic structure
+of any ET application. The first line of the main() procedure is a
+call to the function Et_Init(). This function initializes the ET
+system by creating a Tcl/Tk interpreter, connecting to the X11 server,
+and creating a main window. The last line of main() implements the
+event loop. Everything in between constitutes setup code. In this
+example, the setup code is a short Tcl/Tk script contained within the
+special macro ET(). The et2c macro preprocessor will replace this ET()
+macro with C code that causes the enclosed Tcl/Tk script to be
+executed.
+
+Of course, there is nothing in this example that could not also be
+done by calling Tcl/Tk library routines directly, without the
+intervening ET abstraction. The advantage of using ET is that it
+makes the interface between C and Tcl/Tk considerably less cumbersome
+and error-prone, allowing the programmer to focus more mental energy
+on the algorithm and less on the syntax of the programming language.
+
+1.1 Compiling ``Hello, World!''
+
+To compile the hello world example, we must first process the source
+file using the et2c macro preprocessor, then link the results with the
+et.o library. Suppose the example code is contained in the file
+hello.c. Then to compile the example (on most systems) requires the
+following steps:
+
+
+
+ et2c hello.c >hello_.c
+ cc -o hello hello_.c et.o -ltk -ltcl -lX11 -lm
+
+
+Assuming it is statically linked, the resulting executable file hello
+contains everything needed to run the program: the Tcl/Tk interpreter,
+the startup scripts and the application code. The program can be
+moved to other binary-compatible computers and executed there even if
+the other computers do not have Tcl/Tk installed.
+
+Additional information is provided below.
+
+1.2 How to obtain sources and documentation
+
+Complete sources to the et2c macro preprocessor and et.o library
+comprise less than 2000 lines of code, including comments. These
+sources, together with source code to all example programs discussed
+below, are available for anonymous FTP from ftp.vnet.net in the
+directory /pub/users/drh.
+
+A copy of this documentation is also available from the same FTP site.
+The documentation is available in either PostScript, HTML, or an ASCII
+text file.
+
+
+2. A Summary Of Services Provided By ET
+
+The overall goal of ET is to simplify the interface between C and an
+embedded Tcl/Tk-based GUI. To this end, the ET system provides a
+number of services that aid in initializing the Tcl/Tk interpreter and
+in transferring data and control between Tcl/Tk and C. The services
+provided by ET are summarized here and described in more detail in
+subsequent sections.
+
+2.1 Routines to initialization the Tcl/Tk interpreter
+
+The et.o library includes routines Et_Init() and Et_MainLoop() that
+initialize the ET package and implement the X11 event loop. A third
+routine Et_ReadStdin() allows standard input to be read and
+interpreted by the Tcl/Tk interpreter at run-time.
+
+2.2 Macros to invoking Tcl/Tk from within C
+
+The ET() macro looks and works just like a function in C, except that
+its argument is a Tcl/Tk script instead of C code. ET() returns
+either ET_OK or ET_ERROR depending upon the success or failure of the
+script. Similar routines ET_STR(), ET_INT() and ET_DBL() also take a
+Tcl/Tk script as their argument, but return a string, an integer, or a
+double-precision floating point number instead of the status code.
+
+2.3 A method to pass variable contents from C to Tcl/Tk
+
+Wherever the string %d(x) occurs inside an ET() macro, the integer C
+expression x is converted to ASCII and substituted in place of the
+%d(x). Similarly, %s(x) can be used to substitute a character string,
+and %f(x) will substitute a floating point value. The string %q(x)
+works like %s(x) except that a backslash is inserted before each
+character that has special meaning to Tcl/Tk.
+
+2.4 Macros for creating new Tcl/Tk commands in C
+
+The macro "ET_PROC( newcmd ){ ... }" defines a C function that is
+invoked whenever the newcmd command is executed by the Tcl/Tk
+interpreter. Parameters argc and argv describe the arguments to the
+command. If a file named xyzzy.c contains one or more ET_PROC macros,
+then the commands associated with those macros are registered with the
+Tcl/Tk interpreter by invoking "ET_INSTALL_COMMANDS( xyzzy.c )" after
+the Et_Init() in the main procedure.
+
+2.5 Macros for linking external Tcl/Tk scripts into a C program
+
+The macro "ET_INCLUDE( script.tcl )" causes the Tcl/Tk script in the
+file script.tcl to be made a part of the C program and executed at the
+point in the C program where the ET_INCLUDE macro is found. The
+external Tcl/Tk script is normally read into the C program at
+compile-time and thus becomes part of the executable. However, if the
+-dynamic option is given to the et2c macro preprocessor, loading of
+the external Tcl/Tk script is deferred to run-time.
+
+2.6 Tcl/Tk return status macros
+
+The macros ET_OK and ET_ERROR are set equal to TCL_OK and TCL_ERROR.
+This often eliminates the need to put "#include " at the beginning of
+files that use ET.
+
+2.7 Convenience variables
+
+ET defines three global C variables as a convenience to the
+programmer. Et_Interp is a pointer to the Tcl/Tk interpreter used by
+ET. Et_MainWindow is the main window of the ET application.
+Et_Display is the Display pointer required as the first argument to
+many XLib routines. ET also provides two global Tcl variables,
+cmd_name and cmd_dir. These contain the name of the executable and
+the directory where the executable is found.
+
+
+3. Example 2: A Decimal Clock
+
+The preceding "Hello, World!" example program demonstrated the basic
+structure of an ET application including the use of the Et_Init()
+function to initialize the Tcl/Tk interpreter and the Et_MainLoop()
+function for implementing the X11 event loop. The following program
+will demonstrate additional aspects of the the ET system.
+
+3.1 Source code for the decimal clock example
+
+
+ /* This file implements a clock that shows the hour as
+ ** fixed-point number X, such that
+ **
+ ** 0.000 <= X < 24.000
+ **
+ ** X represents a fractional hour, not hours and minutes.
+ ** Thus the time "8.500" means half past 8 o'clock, not
+ ** ten minutes till 9.
+ */
+ #include <time.h>
+
+ void main(int argc, char **argv){
+ Et_Init(&argc,argv);
+ ET_INSTALL_COMMANDS;
+ ET(
+ label .x -width 6 -text 00.000 -relief raised -bd 2
+ pack .x
+ UpdateTime
+ );
+ Et_MainLoop();
+ }
+
+ /* Update the time displayed in the text widget named ".x".
+ ** Reschedule this routine to be called again after 3.6
+ ** seconds.
+ */
+ ET_PROC( UpdateTime ){
+ struct tm *pTime; /* The time of day, decoded */
+ time_t t; /* Number of seconds since the epoch */
+ char buf[40]; /* The time value is written here */
+
+ t = time(0);
+ pTime = localtime(&t);
+ sprintf(buf,"%2d.%03d",pTime->tm_hour,
+ (pTime->tm_sec + 60*pTime->tm_min)*10/36);
+ ET( .x config -text %s(buf); after 3600 UpdateTime );
+ return ET_OK;
+ }
+
+ **Image**
+ 3.1 Typical appearance of the decimal clock
+
+3.2 Discussion of the decimal clock example
+
+This example implements a clock program that displays the time in
+thousandths of the hour, rather than the more usual hours, minutes and
+seconds. (Such a display might be useful, for instance, to a
+consultant who bills time in tenth hour increments.) The code for this
+example is contained in the file named dclock.c.
+
+3.2.1 Initialization and event loop routines. As in the first example
+, the main() function to dclock begins with a call to Et_Init() and
+ends with a call to Et_MainLoop(), with setup code in between. If you
+didn't see it before, note here that the Et_Init() function takes two
+arguments -- a pointer to an integer that is the number of parameters
+to the program, and a pointer to an array of pointers to strings that
+are the program parameters. Note especially that the first argument
+is passed by reference, not by value. The Et_Init() function requires
+these arguments so that it can detect and act upon command line
+arguments related to the initialization of Tcl/Tk. Any such arguments
+detected are removed from the argc and argv variables before Et_Init()
+returns, so the rest of the program need not be aware of their
+existence. The arguments currently understood by Et_Init() are
+-geometry, -display, -name and -sync. The use and meaning of these
+arguments is exactly the same as in the standard Tcl/Tk interpreter
+program "wish".
+
+3.2.2 The ET_PROC macro. The main difference between dclock and the
+first example is that the setup code for dclock has an "
+ET_INSTALL_COMMANDS" macro and there is an "ET_PROC" function defined
+after main(). Let's begin by describing the ET_PROC macro.
+
+The ET_PROC macro is nothing more than a convenient shorthand for
+creating new Tcl/Tk commands in C. To create a new Tcl/Tk command, one
+writes ET_PROC followed by the name of the new command in parentheses
+and the C code corresponding to the new command in curly braces.
+Within a single ET source file there can be any number of ET_PROC
+macros, as long as the command names defined are all unique. The et2c
+macro preprocessor translates the ET_PROC macro into a C function
+definition that implements the command, so ET_PROC macros should only
+be used in places where it is legal to write C function definitions.
+
+3.2.2.1 Parameters to an ET_PROC function. The function created by an
+ET_PROC macro has four parameters, though only two are commonly used.
+The two useful parameters are argc and argv, which are the number of
+arguments to the Tcl/Tk command and the value of each argument. (The
+command name itself counts as an argument here.) Hence, the argc and
+argv parameters work just like the first two parameters to main() in a
+typical C program. Another parameter to every ET_PROC function is the
+pointer to the Tcl/Tk interpreter, interp. This variable is exactly
+equal to the global variable Et_Interp. The last parameter is called
+clientData and is defined to be a pointer to anything. It actually
+points to the structure that defines the main window of the
+application, and is therefore the same as the global variable
+Et_MainWindow.
+
+ **Image**
+ 3.2 Summary of the parameters to each ET_PROC command
+
+3.2.3 The ET_INSTALL_COMMANDS macro. The ET_PROC macro will create a
+C function that can be used as a Tcl/Tk command, but that function and
+the corresponding command name must still be registered with the
+Tcl/Tk interpreter before the command can be used. This is the job of
+the ET_INSTALL_COMMANDS macro. Thus, in the dclock example, we must
+invoke the ET_INSTALL_COMMANDS macro to register the UpdateTime
+command prior to using the the UpdateTime command in any Tcl script.
+Because new Tcl/Tk commands must be registered before they are used,
+the ET_INSTALL_COMMANDS macros are usually the first setup code to
+follow the Et_Init() function call.
+
+Each instance of an ET_INSTALL_COMMANDS macro registers all ET_PROC
+commands defined in a single source file. The dclock example has only
+a single ET_PROC command, but even if it had had 50, a single
+ET_INSTALL_COMMANDS macro within the main() function would have been
+sufficient to install them all.
+
+The name of the source file containing the ET_PROC commands that are
+to be registered is given as an argument to the ET_INSTALL_COMMANDS
+macro. If no argument is given, then the name of the file containing
+the ET_INSTALL_COMMANDS macro is used. Hence, the line in the dclock
+example that registers the UpdateTime command can be written in either
+of the following ways:
+
+
+ ET_INSTALL_COMMANDS;
+
+ ET_INSTALL_COMMANDS( dclock.c );
+
+Note that the ET_INSTALL_COMMANDS macro does not actually open or read
+the file named in its argument. The macro just mangles the file name
+in order to generate a unique procedure name for its own internal use.
+The file itself is never accessed. For this reason, the file name
+specified as an argument to the ET_INSTALL_COMMANDS macro should not
+contain a path, even if the named file is in a different directory.
+
+3.2.4 The ET() macro. We have already considered the ET() macro once,
+in connection with the setup code for the "Hello, World!" example, and
+we also observe that the ET() macro reappears in the setup code for
+dclock and in the UpdateTime function. Let's look at this macro in
+more detail.
+
+An ET() macro works just like a function, except that its argument is
+a Tcl/Tk script instead of a C expression. When an ET() macro is
+executed, its argument is evaluated by the Tcl/Tk interpreter and an
+integer status code is returned. The status code will be either ET_OK
+if the script was successful, or ET_ERROR if the script encountered an
+error. (An ET() macro might also return TCL_RETURN, TCL_BREAK, or
+TCL_CONTINUE under rare circumstances.)
+
+In the dclock example, a single ET() macro is used to initialize the
+display of the decimal clock. Three Tcl/Tk commands are contained
+within the macro. The first command creates a label widget for use as
+the clock face, the second packs this label, and the third calls the
+ET_PROC command named UpdateTime to cause the time on the clock face
+to be updated. (The UpdateTime command will arrange to call itself
+again after a fixed interval, in order to update the time to the next
+thousandth of an hour.)
+
+The Tcl/Tk script contained in an ET() macro executes at the global
+context level. This means that the Tcl/Tk code within an ET() macro
+can create and access only global Tcl/Tk variables.
+
+3.2.4.1 The %s() phrase within an ET() macro. Now consider the ET()
+macro contained in the UpdateTime function. The role of this macro is
+to first change the label on the .x label widget to be the current
+time and then reschedule the UpdateTime command to run again in 3.6
+seconds. The time value is stored in the character string buf[].
+Within the argument to the ET() macro, the special phrase %s(buf)
+causes the contents of the character string stored in buf[] to be
+substituted in placed of the %s(buf) phrase itself. The effect is
+similar to a %s substitution in the format string of a printf
+function. In fact, the statement
+
+
+
+ ET( .x config -text %s(buf); after 3600 UpdateTime );
+
+
+is logical equivalent to
+
+
+
+ char buf2[1000];
+ sprintf(buf2," .x config -text %s; after 3600 UpdateTime ",buf);
+ Tcl_GlobalEval(Et_Interp,buf2);
+
+
+except that with the ET() macro there is never a danger of overflowing
+the temporary buffer buf2[].
+
+3.2.4.2 Other substitution phrases within ET() macros. The phrase
+%s(...) is replaced by the string contents of its argument within an
+ET() macro. Similarly, the phrases %d(...) and %f(...) are replaced
+by ASCII representations of the integer and floating point number
+given by the expression in their arguments. The names of the
+substitution phrases are taken from similar substitution tokens in the
+format string of the printf function. Note, however, that option
+flags, precision and field widths are not allowed in an ET() macro
+substitution phrase, as they are in printf. The phrase %3.7f is
+understood by printf but is is not understood by ET(). In an ET()
+macro the only allowed form of a substitution phrase is where the
+format letter immediately follows the percent symbol.
+
+The ET() macro supports an additional substitution phrase not found in
+standard printf: the %q(...). substitution. The %q() works just like
+%s() with the addition that it inserts extra backslash characters into
+the substituted string in order to escape characters of the string
+that would otherwise have special meaning to Tcl/Tk. Consider an
+example.
+
+
+
+ char *s = "The price is $1.45";
+ ET( puts "%q(s)" );
+
+
+Because the %q(...) macro was used instead of %s(...), an extra
+backslash is inserted immediately before the "$". The command string
+passed to the Tcl/Tk interpreter is therefore:
+
+
+
+ puts "The price is \$1.45"
+
+
+This gives the expected result. Without the extra backslash, Tcl/Tk
+would have tried to expand "$1" as a variable, resulting in an error
+message like this:
+
+
+
+ can't read "1": no such variable
+
+
+In general, it is always a good idea to use %q(...) instead of %s(...)
+around strings that originate from outside the program -- you never
+know when such strings may contain a character that needs to be
+escaped.
+
+ **Image**
+ 3.3 Summary of substitution phrases understood by ET() macros
+
+3.2.5 Variations on the ET() macro. The ET() macro used in all
+examples so far returns a status code indicating success or failure of
+the enclosed Tcl script. Sometimes, though, it is useful to have
+access to the string returned by the Tcl script, instead of the status
+code. For these cases one can use the ET_STR() macro in place of ET()
+
+The ET_STR() macro works just like ET() in most respects. The sole
+argument to ET_STR() is a Tcl/Tk script to which the usual %s(), %d(),
+%f() and %q() substitutions are applied. The difference between
+ET_STR() and ET() is that ET_STR() returns a pointer to a
+null-terminated string that is the result of the Tcl/Tk script if the
+script was successful. If the script failed, then ET_STR() returns a
+NULL pointer.
+
+It is very important to note that the string returned by ET_STR() is
+ephemeral -- it will likely be deallocated, overwritten or otherwise
+corrupted as soon as the next Tcl/Tk command is executed. Therefore,
+if you need to use this string for any length of time, it is a good
+idea to make a copy. In the following code fragment, the C string
+variable entryText is made to point to a copy of the contents of an
+entry widget named .entry.
+
+
+
+ char *entryText = strdup( ET_STR(.entry get) );
+
+
+It is not necessary to make a copy of the string returned by ET_STR()
+if the string is used immediately and then discarded. The following
+two examples show uses of the ET_STR() macro where the result does not
+need to be copied. The first example shows a quick way to find the
+width, height and location of the main window for an application:
+
+
+
+ int width, height, x, y;
+ sscanf(ET_STR(wm geometry .),"%dx%d+%d+%d",&width,&height,&x,&y);
+
+
+The next example shows a convenient way to tell if a given widget is a
+button:
+
+
+
+ char *widget_name = ".xyz";
+ if( strcmp(ET_STR(winfo class %s(widget_name)),"Button")==0 ){
+ /* The widget is a button */
+ }else{
+ /* The widget is not a button */
+ }
+
+
+There also exist versions of the ET() macro that return an integer and
+a floating point number: ET_INT() and ET_DBL(). These work much like
+ET_STR() except that the returned string is converted to an integer or
+to a double using the functions atoi() or atof(). The values 0 and
+0.0 are returned if the Tcl/Tk script given in the argument fails or
+if the returned string is not a valid number.
+
+The ET_INT() and ET_DBL() macros are often used to read the values of
+integer and floating point Tcl/Tk variables. For instance, if Width
+is a global Tcl/Tk variable containing an integer value, then we can
+load that value into the integer C variable iWidth using the following
+statement:
+
+
+
+ iWidth = ET_INT( set Width );
+
+
+The ET_INT() is also useful for recording the integer id number of an
+object created on a Tcl/Tk canvas widget. In the following example, a
+line is created on the canvas widget .c and its id is recorded in the
+integer C variable id. Later, this id is used to delete the line.
+
+
+
+ id = ET_INT( .c create line 100 100 200 200 -width 2 );
+ /* ... intervening code omitted ... */
+ ET( .c delete %d(id) );
+
+
+The last example of the ET_INT() macro shows a convenient way to tell
+if the X11 server is color or monochrome:
+
+
+
+ if( ET_INT(winfo screendepth .)==1 ){
+ /* The display is monochrome */
+ }else{
+ /* The display is color */
+ }
+
+
+ **Image**
+ 3.4 Summary of variations on the ET() macro
+
+
+4. Example 3: fontchooser
+
+As its name implies, the next example is a small utility program that
+can be used to select X11 fonts. The source code is contained in two
+files, fontchooser.c and fontchooser.tcl. We will look at the C code
+first.
+
+4.1 Source code to the font chooser
+
+
+ /*
+ ** This program allows the user to view the various fonts
+ ** available on the X server.
+ **
+ ** Preprocess this file using "et2c" then link with "et.o".
+ */
+ #include "tk.h" /* This automatically loads Xlib.h */
+
+ void main(int argc, char **argv){
+ Et_Init(&argc,argv);
+ ET_INSTALL_COMMANDS;
+ ET_INCLUDE( fontchooser.tcl );
+ Et_MainLoop();
+ }
+
+ /* This function parses up font names as follows:
+ **
+ ** Font Family Font size
+ ** __________________________ ________________
+ ** / \/ \
+ ** -misc-fixed-medium-r-normal--10-100-75-75-c-60-iso8859-1
+ ** | | \___/ | \_______/
+ ** | | | | |
+ ** | | | | `-- Always as shown
+ ** | | | |
+ ** The point size ----' | | `--- 10x average width
+ ** | |
+ ** This field ignored----' `--- Resolution in dots per inch
+ **
+ **
+ ** If $name is a font name (the first 6 fields of the X11 font name)
+ ** then this procedure defines the global variable $Font($name), giving
+ ** it as a value a list of available font sizes in ascending order.
+ ** Only fonts of a particular resolution are included. By default, the
+ ** resolution selected is 75dpi, but this can be changed by the
+ ** argument to the command.
+ **
+ ** This command also creates global variable FontCount that holds the
+ ** number of entries in the Font() array.
+ */
+ ET_PROC( FindFonts ){
+ char **fontnames; /* The names of all fonts in the selected resolution */
+ int count; /* Number of fonts */
+ int i; /* Loop counter */
+ char pattern[400]; /* Buffer to hold a pattern used to select fonts. */
+
+ if( argc==1 ){
+ strcpy(pattern,"*-75-75-*-*-iso8859-1");
+ }else if( argc==2 ){
+ extern int atoi();
+ int resolution = atoi(argv[1]);
+ sprintf(pattern,"*-%d-%d-*-*-iso8859-1",resolution,resolution);
+ }
+ fontnames = XListFonts(Et_Display,pattern,1000,&count);
+ ET(
+ catch {unset Font}
+ set FontCount 0
+ );
+ for(i=0; iresult = "Wrong # args";
+ return ET_ERROR;
+ }
+ if( sscanf(argv[1],"%d-%*d-%*d-%*d-%*c-%d",&leftHeight,&leftWidth)!=2 ){
+ interp->result = "First argument is not a font size";
+ return ET_ERROR;
+ }
+ if( sscanf(argv[2],"%d-%*d-%*d-%*d-%*c-%d",&rightHeight,&rightWidth)!=2 ){
+ interp->result = "Second argument is not a font size";
+ return ET_ERROR;
+ }
+ result = leftHeight - rightHeight;
+ if( result==0 ) result = leftWidth - rightWidth;
+ sprintf(interp->result,"%d",result);
+ return ET_OK;
+ }
+
+ **Image**
+ 4.1 Typical appearance of the fontchooser program
+
+4.2 Analysis of the fontchooser source code
+
+As is the prior examples, the main() function for the fontchooser
+begins and ends with calls to Et_Init() and Et_MainLoop().
+Immediately following the Et_Init() call is an ET_INSTALL_COMMANDS
+macro that registers the two commands FindFonts and FontSizeCompare
+with the Tcl/Tk interpreter.
+
+4.2.1 Using the argc and argv parameters to an ET_PROC function. The
+FindFonts routine is used to query the X server for the names of all
+available fonts at a particular resolution specified by the argument
+to the FindFonts routine. If no resolution is specified (if the
+FindFonts command is not given an argument in the Tcl/Tk script) then
+the resolution defaults to 75 dots per inch. The argc and argv
+parameters are used to determine the number and value of arguments to
+the FindFonts command. The specified resolution is then used to
+construct a search pattern for the fonts.
+
+
+
+ if( argc==1 ){
+ strcpy(pattern,"*-75-75-*-*-iso8859-1");
+ }else if( argc==2 ){
+ extern int atoi();
+ int resolution = atoi(argv[1]);
+ sprintf(pattern,"*-%d-%d-*-*-iso8859-1",resolution,resolution);
+ }
+
+
+4.2.2 Global variables defined by ET. After creating a search
+pattern, the The Xlib function XListFonts() is used find all fonts
+that match that pattern.
+
+
+
+ fontnames = XListFonts(Et_Display,pattern,1000,&count);
+
+
+The first argument to XListFonts(), as in many Xlib functions, is a
+pointer to a Display structure that defines the connection to the X
+server. The fontchooser program uses the convenience variable
+Et_Display to fill this argument. Et_Display is a global variable
+defined in the et.o library and initialized to the active X connection
+by the Et_Init() function. The Et_Display variable is available for
+use by any function that needs a Display pointer.
+
+The ET system defines two global C variables besides Et_Display:
+Et_Interp and Et_MainWindow. The Et_Interp variable is a pointer to
+the Tcl/Tk interpreter used by ET. This variable is very handy since
+many routines in the Tcl/Tk library require a pointer to the
+interpreter as their first argument. The Et_MainWindow variable
+defines the main window of the application, the window named "."
+within Tcl/Tk scripts. The main window is needed by a few Tcl/Tk
+library routines, but is not as widely used as the other global
+variables in ET.
+
+All three global C variables in ET are initialized by the Et_Init()
+routine and never change after initialization.
+
+ **Image**
+ 4.2 Summary of global variables
+
+4.2.3 Other actions of the FindFonts command. After calling
+XListFonts(), the FindFonts command splits each name into a "font
+family" and a "font size". For each font family, it creates an entry
+in the global Tcl/Tk array variable Font with the font family name as
+the index and a list of sizes for that font as the value. A new entry
+in the Font array is created, or else a new size is added to the list
+of font sizes in that entry, by the following ET() macro:
+
+
+
+ ET(
+ if {![info exists {Font(%s(nameStart))}]} {
+ set {Font(%s(nameStart))} {}
+ incr FontCount
+ }
+ lappend {Font(%s(nameStart))} {%s(cp)}
+ );
+
+
+After all fonts returned by XListFonts have been processed, the list
+of sizes on each entry in the Font array variable is sorted by the
+final ET() macro in the FindFonts command:
+
+
+
+ ET(
+ foreach i [array names Font] {
+ set Font($i) [lsort -command FontSizeCompare $Font($i)]
+ }
+ );
+
+
+4.2.4 Operation of the FontSizeCompare command. The FontSizeCompare
+command is used to sort into ascending order the font sizes listed in
+a single entry of the Font array. The only place it is used is on the
+lsort command contained in the final ET() macro of the FindFonts
+routine.
+
+Unlike any previously described ET_PROC command, FontSizeCompare makes
+use of the interp parameter. Recall that the interp parameter is a
+pointer to the Tcl/Tk interpreter, and is therefore always equal to
+the global C variable Et_Interp. Hence, one could have used the
+Et_Interp variable in place of the interp parameter throughout the
+FindSizeCompare function and obtained the same result.
+
+4.2.5 Constructing the GUI for the fontchooser. The Tcl/Tk code that
+defines the GUI for the fontchooser is contained in a separate file
+fontchooser.tcl. A small portion of this file follows:
+
+
+
+ # This code accompanies the "fontchooser.c" file. It does most of the
+ # work of setting up and operating the font chooser.
+
+ # Title the font chooser and make it resizeable.
+ #
+ wm title . "Font Chooser"
+ wm iconname . "FontChooser"
+ wm minsize . 1 1
+
+ # Construct a panel for selecting the font family.
+ #
+ frame .name -bd 0 -relief raised
+
+
+... 136 lines omitted ...
+
+
+ # Begin by displaying the 75 dot-per-inch fonts
+ #
+ update
+ LoadFontInfo 75
+
+
+When the script in the file fontchooser.tcl executes, it constructs
+the listboxes, scrollbars, menu and menu buttons of the fontchooser,
+and finally calls the LoadFontInfo function. The LoadFontInfo command
+is defined by a proc statement in the part of the fontchooser.tcl file
+that was omitted from the listing. The LoadFontInfo function calls
+FindFonts and then populates the listboxes accordingly.
+
+The interesting thing about this example is how the script in
+fontchooser.tcl is invoked. In the prior examples ("Hello, World!"
+and dclock) the Tcl/Tk script that setup the application was very
+short and fit into an ET() macro in the main() function. This same
+approach could have been taken with the fontchooser. We could have
+put the entire text of the Tcl/Tk script into a 152 line ET() macro.
+But that is inconvenient. It is much easier to use an ET_INCLUDE
+macro.
+
+4.2.6 The ET_INCLUDE macro. An ET_INCLUDE macro is similar to a
+#include in the standard C preprocessor. A #include reads in an
+external C file as if it were part of the original C code. ET_INCLUDE
+does much the same thing for Tcl/Tk code. It copies an external
+Tcl/Tk script into the original C program, and causes that script to
+be executed when control reaches the macro.
+
+An important characteristic of the ET_INCLUDE macro is that it loads
+the external Tcl/Tk script into the C program at compile time, not at
+run time. This means that a copy of the Tcl/Tk script actually
+becomes part of the resulting executable. To clarify this point,
+consider the difference between the following two statements:
+
+
+
+ ET( source fontchooser.tcl );
+
+ ET_INCLUDE( fontchooser.tcl );
+
+
+Both statements causes the file named fontchooser.tcl to be read and
+executed by the Tcl/Tk interpreter. The difference is that in the
+first statement, the file is opened and read in at run-time,
+immediately before the contained script is executed. This means that
+the file fontchooser.tcl must be available for reading by the program
+in order for the program to work correctly. In the second case, the
+file is opened and read when the program is compiled. The only work
+left to do at run-time is to pass the contained script to the Tcl/Tk
+interpreter. In the second statement, then, the file fontchooser.tcl
+does not have to be available to the program for correct operation.
+
+4.2.7 How the ET_INCLUDE macro locates files. The external script
+file specified by an ET_INCLUDE macro need not be in the same
+directory as the C program containing the ET_INCLUDE for the include
+operation to work. If the external script is in a different
+directory, however, the name of that directory must be specified to
+the et2c macro preprocessor using one or more "-Idirectory" command
+line switches.
+
+The algorithm used by et2c to locate a file is to first check the
+working directory. If the file is not there, then look in the
+directory specified by the first -I option. If the file is still not
+found, then search the directory specified by the second -I option.
+And so forth. An error is reported only when the file mamed in the
+ET_INCLUDE macro is missing from the working directory and from every
+directory specified by -I options. Note that this is essentially the
+same algorithm used by the C compiler to find files named in #include
+preprocessor directives.
+
+4.2.8 The -dynamic option to et2c. In a deliverable program, it is
+usually best to load external Tcl/Tk scripts at compile time so that
+the scripts will be bound into a single executable. However, during
+development it is sometimes advantageous to load external Tcl/Tk
+scripts at run-time. To do so allows these scripts to be modified
+without having to recompile the C code.
+
+The -dynamic option on the command line of the et2c preprocessor will
+causes ET_INCLUDE macros to read their files at run-time instead of at
+compile-time. In effect, the -dynamic option causes macros of the
+form ET_INCLUDE(X) to be converted into ET(source X). Generally
+speaking, it is a good idea to use the -dynamic option on et2c
+whenever the -g option (for symbolic debugging information) is being
+used on the C compiler.
+
+4.2.9 Use of ET_INCLUDE inside the et.o library. When Tcl/Tk first
+starts up, it must normally read a list of a dozen or so Tcl scripts
+that contain definitions of widget bindings and related support
+procedures. In the standard interactive Tcl/Tk interpreter wish,
+these files are read a run-time from a standard directory. In an ET
+application, however, these startup files are loaded into the
+executable at compile time using ET_INCLUDE macros.
+
+Startup files are loaded into the Et_Init() function that is part of
+the et.o library. The relevant source code followings:
+
+
+
+ /*
+ * Execute the start-up Tcl/Tk scripts. In the standard version of
+ * wish, these are read from the library at run-time. In this version
+ * the scripts are compiled in.
+ *
+ * Some startup scripts contain "source" commands. (Ex: tk.tcl in
+ * Tk4.0). This won't do for a stand-alone program. For that reason,
+ * the "source" command is disabled while the startup scripts are
+ * being read.
+ */
+ ET( rename source __source__; proc source {args} {} );
+ ET_INCLUDE( init.tcl );
+ ET_INCLUDE( tk.tcl );
+ ET_INCLUDE( button.tcl );
+ ET_INCLUDE( dialog.tcl );
+ ET_INCLUDE( entry.tcl );
+ ET_INCLUDE( focus.tcl );
+ ET_INCLUDE( listbox.tcl );
+ ET_INCLUDE( menu.tcl );
+ ET_INCLUDE( obsolete.tcl );
+ ET_INCLUDE( optionMenu.tcl );
+ ET_INCLUDE( palette.tcl );
+ ET_INCLUDE( parray.tcl );
+ ET_INCLUDE( text.tcl );
+ ET_INCLUDE( scale.tcl );
+ ET_INCLUDE( scrollbar.tcl );
+ ET_INCLUDE( tearoff.tcl );
+ ET_INCLUDE( tkerror.tcl );
+ ET( rename source {}; rename __source__ source );
+
+
+It is because of these 17 ET_INCLUDE macros that the et.c file must be
+preprocessed by et2c before being compiled into et.o.
+
+
+5. Example 4: etwish
+
+The short code that follows implements the interactive Tcl/Tk shell "
+wish" using ET:
+
+
+
+ main(int argc, char **argv){
+ Et_Init(&argc,argv);
+ Et_ReadStdin();
+ Et_MainLoop();
+ }
+
+
+This program illustrates the use of Et_ReadStdin() routine. The
+Et_ReadStdin() routine causes ET to monitor standard input, and to
+interpret all characters received as Tcl/Tk commands. This is, of
+course, the essential function of the interactive Tcl/Tk shell.
+
+The program generated by this code example differs from the standard
+wish program in two important ways.
+
+ * In the example here, the Tcl/Tk startup scripts are bound to the
+ executable at compile-time, but in the standard wish they are
+ read into the executable at run-time.
+ * This example does not support the -f command line switch that
+ will cause wish to take its input from a file instead of from
+ standard input.
+
+
+6. Example 5: runscript
+
+The next example implements a version of wish that takes its input
+from a file instead of from standard input. The file that is read
+must reside in the same directory as the executable and must have the
+same name as the executable but with the addition of a .tcl suffix.
+For instance, if the executable that results from compiling the
+following program is named fuzzy, then the result of executing fuzzy
+is that the Tcl/Tk script found in the same directory as fuzzy and
+named fuzzy.tcl is read and executed.
+
+
+
+ void
+ main(int argc, char **argv){
+ Et_Init(&argc,argv);
+ ET( source $cmd_dir/$cmd_name.tcl );
+ Et_MainLoop();
+ }
+
+
+6.1 The $cmd_dir and $cmd_name variables
+
+The operation of the runscript program depends on the existence of two
+Tcl/Tk variables computed by Et_Init() and named cmd_dir and cmd_name.
+The cmd_dir variable stores the name of the directory that holds the
+currently running executable. The cmd_name variables stores the base
+name of the executable. The cmd_name and especially the cmd_dir
+variables are included as a standard part of ET in order to encourage
+people to write programs that do not use hard-coded absolute
+pathnames.
+
+In most modern operating systems, a file can have two kinds of names:
+absolute and relative. An absolute pathname means the name of a file
+relative to the root directory of the filesystem. A relative
+pathname, on the other hand, describes a file relative to some other
+reference directory, usually the working directory. Experience has
+shown that it is generally bad style to hard-code absolute pathnames
+into a program.
+
+The cmd_dir variable helps programmers to avoid hard-coded absolute
+pathnames by allowing them to locate auxiliary files relative to the
+executable. For example, if a program named acctrec needs to access a
+data file named acctrec.db then it can do so be look for acctrec.db in
+a directory relative to the directory that contains acctrec. The
+programmer might write:
+
+
+
+ char *fullName = ET_STR( return $cmd_dir/../data/$cmd_name.db );
+ FILE *fp = fopen(fullName,"r");
+
+
+Using this scheme, both the executable and the datafile can be placed
+anywhere in the filesystem, so long as they are in the same position
+relative to one another.
+
+The runscript example demonstrates the use relative pathnames in this
+way. The executable for runscript locates and executes a Tcl/Tk
+script contained in a file in the same directory as itself. The name
+of the script is the name of the executable with a ".tcl" suffix
+appended. Using this scheme, the executable and script can be renamed
+and moved to different directories at will, and they will still run
+correctly so long as they remain together and keep the same name
+prefix. Such flexibility makes a program much easier to install and
+administer.
+
+
+7. Example 6: bltgraph
+
+The next program will demonstrate how to use ET with an extension
+package to Tcl/Tk, in this case the BLT extension. The example is
+very simple. All it does is turn the graph2 demo which comes with the
+BLT package into a stand-alone C program. A real program would, of
+course, want to do more, but this example serves to illustrate the
+essential concepts.
+
+
+
+ /*
+ ** This program demonstrates how to use ET with
+ ** extensions packages for Tcl/Tk, such as BLT.
+ */
+ #include
+
+ int main(int argc, char **argv){
+ Et_Init(&argc,argv);
+ if( Blt_Init(Et_Interp)!=ET_OK ){
+ fprintf(stderr,"Can't initialize the BLT extension.\n");
+ exit(1);
+ }
+ ET_INCLUDE( graph2 );
+ Et_MainLoop();
+ return 0;
+ }
+
+
+The bltgraph program starts like every other ET program with a call to
+Et_Init(). This call creates the Tcl/Tk interpreter and activates the
+standard Tk widget commands. The second line of the program is a call
+to Blt_Init(). The Blt_Init() function is the entry point in the BLT
+library that initializes the BLT extension widgets and registers the
+extra BLT commands with the Tcl/Tk interpreter. Other extension
+packages will have a similar initialization functions whose name is
+the name of the extension package followed by an underscore and the
+suffix Init. The example program shows the initialization of a single
+extension package, though we could just as easily have inserted calls
+to the initialization routines for 10 different extensions, if our
+application had the need.
+
+After the BLT package has been initialized, the only other code before
+the call to Et_MainLoop() is an ET_INCLUDE macro which reads in a
+Tcl/Tk script named graph2. This script is one of the demonstrations
+that is included with the BLT distribution and contained in the demos
+subdirectory. In order for the et2c preprocessor to locate this
+script, you will either have to copy it into the working directory, or
+else put a -I option on the command line to tell et2c where the script
+is found.
+
+This example is included with the ET distribution, but the Makefile
+does not build it by default. If you want to compile this example,
+first edit the Makefile to define the BLT_DIR macro appropriately,
+then type make bltgraph.
+
+
+8. Other example programs
+
+The standard ET distribution includes several more example programs
+that are described briefly in the following paragraphs.
+
+8.1 The bell program
+
+The first additional example program is called bell. This is a small
+utility that can be used to change the pitch, duration and volume of
+the console "beep". Complete source code is contained in the single
+file bell.c.
+
+When run, the bell utility displays three horizontal sliders, one each
+for pitch, duration and volume, and three buttons. The user selects
+the desired parameters for the "beep" on the sliders. Pressing the "
+test" button causes a beep to sound with the chosen parameters.
+Pressing the "set" button tells the X server to use the chosen
+parameters for all subsequent beeps. The "quit" button is used to
+exit the utility.
+
+The bell program consists of the main() function and a single ET_PROC
+function named bell. The main() function creates the GUI for the
+utility using 21 lines of Tcl/Tk code contained within a single ET()
+macro. The bell function is responsible for sounding the bell and
+change the parameters of the bell tone using the XBell() and
+XChangeKeyboardControl() Xlib functions.
+
+8.2 The color program
+
+The color utility is intended to aid the user in selected named
+colors. The sources code is contained in two files color.c and
+color.tcl.
+
+Upon startup, the color utility displays a wide color swatch across
+the top of its main window. On the lower left side of the window are
+six sliders representing both the RGB and HSV color components of the
+swatch. The user can change the color of the swatch by moving these
+sliders. On the lower right are six smaller color labels showing the
+named colors that are "closest" to the color shown in the main color
+swatch.
+
+The implementation of this utility is roughly four parts C to one part
+Tcl. This is because several of the key algorithms, including the RGB
+to HSV conversion routines and the procedures for finding the nearby
+colors, are all implemented in C for speed.
+
+ **Image**
+ 8.1 Screen shot of the color program
+
+8.3 The perfmon program
+
+The next example is a graphical CPU performance monitoring tool for
+the Linux operating system called perfmon. The source code for
+perfmon is contained in two files called perfmon.c and perfmon.tcl.
+
+When invoked, the perfmon utility displays a small window containing
+three bar graphs labeled "Core", "Swap" and "CPU". Each bar graph is
+continually updated to show the amount of usage of the corresponding
+hardware resource.
+
+8.3.1 Explanation of the perfmon display. The "Core" graph shows how
+much of main memory is in use. The red part of the graph is that
+portion of memory that contains the text, heap and stack of executing
+programs. The blue part of the graph shows main memory that is
+currently being used as disk cache. The green part of the graph
+represents the amount of unused memory.
+
+The "Swap" graph works like the "Core" graph except that it shows the
+amount of swap space used instead of main memory. There is no blue
+line on the "Swap" graph since swap space is never used as disk cache.
+
+The "CPU" graph shows in red the amount of time the CPU spent doing
+actual work. The blue part of the CPU graph is the amount of time the
+CPU spend executing the operating system kernel. The green part of
+the graph represents the time the CPU was idle.
+
+Double-clicking over any part of the perfmon utility brings up an
+auxiliary window in which the user can change the frequency with which
+the graphs are updated, and the time interval over which the values on
+the graph are averaged. By default, the update interval is about 10
+times per second, which is barely noticeable on a Pentium, but tends
+to overwhelm a 486. Users of slower hardware may wish to change the
+update interval to minimize the impact of this utility on system
+performance.
+
+The implementation of this utility pays careful attention to speed, so
+as not to impose an unacceptable load on the system. If nothing else,
+the perfmon program demonstrates that it is possible to use Tcl/Tk in
+a high-speed, performance critical application.
+
+ **Image**
+ 8.2 Screen shot of the perfmon program
+
+8.4 The tkedit program
+
+The two files tkedit.c and tkedit.tcl together implement an ASCII text
+editor based on the Tcl/Tk text widget. This editor features menu
+options to dynamically change the width, height and font and for
+cutting, copying, deleting and pasting text. Within the editor, the
+cursor can be moved by clicking with the mouse, pressing the arrow
+keys on the keyboard, or by using the EMACS cursor movement control
+sequences.
+
+8.5 The tkterm program
+
+The files getpty.c, tkterm.c and tkterm.tcl contain source code for a
+vt100 terminal emulator. You can use tkterm whereever you are now
+using xterm.
+
+The main window for tkterm is implemented using a Tcl/Tk text widget.
+The main window, its associated scrollbar and a menu bar across the
+top of the application are all coded by the Tcl/Tk script contained in
+the file tkterm.tcl. The C code in getpty.c handles the messy details
+of opening a pseudo-TTY and attaching a shell on the other side.
+(Most of this code was copied from the sources for the "rxvt" terminal
+emulator program.) The bulk of the code for tkterm is contained in the
+C file tkterm.c and is concerned with translating VT100 escape codes
+into commands for manipulating the text widget.
+
+The sources to tkterm are an example of a moderately complex
+application using ET. The tkterm.c file contains 7 ET_PROC macros, 33
+ET macros and numerious uses of other ET features.
+
+
+9. Compiling an ET application
+
+The first step in compiling an application that uses ET is to compile
+ET itself. This is relatively easy as there are only two source code
+files: et2c.c and et40.c. (All other C source files in the ET
+distribution are example programs.) The et2c.c file is the source code
+for the et2c preprocessor and the et40.c is the source code for the
+et.o library.
+
+Compile the et2c macro preprocessor using any ANSI or K&R C compiler.
+The code makes minimal demands of the language, and should be very
+portable. Some systems my require a -I option on the compiler command
+line, however, to tell the compiler where to find the include file
+tcl.h. The following command assumes the source code to tcl is found
+in /usr/local/src/tcl7.4
+
+
+
+ cc -O -o et2c -I/usr/local/src/tcl7.4 et2c.c
+
+
+The et.o library is generated from et40.c in two steps. First you
+must filter the source file et40.c using the et2c preprocessor. The
+output of et2c is then sent through the C compiler to generate et.o.
+The et2c command will normally need two -I options to tell the
+preprocessor where to look for the Tcl/Tk startup scripts. If you are
+not sure where the Tcl/Tk startup files are found on your system, you
+can find out using the following command:
+
+
+
+ echo 'puts $auto_path; destroy .' | wish
+
+
+The default locations are /usr/local/lib/tcl and /usr/local/lib/tk.
+Assuming this is where the startup files are on your system, then the
+command to preprocess the et.c source file is the following:
+
+
+
+ et2c -I/usr/local/lib/tcl -I/usr/local/lib/tk et40.c >et_.c
+
+
+The output of the preprocessor now needs to be compiled using an ANSI
+C compiler. The et40.c source code makes use of the tk.h and tcl.h
+include files, so it may be necessary to put -I options on the
+compiler command line to tell the compiler where these files are
+located. The following command is typical:
+
+
+
+ cc -c -o et.o -I/usr/local/src/tcl7.4 -I/usr/local/src/tk4.0 et_.c
+
+
+Having compiled the et2c preprocessor and et.o library, compiling the
+rest of the application is simple. Just run each file through the
+preprocessor and then compile the output as you normally would. For
+example, the source file main.c would be compiled as follows:
+
+
+
+ et2c main.c >main_.c
+ cc -c -o main.o main_.c
+ rm main_.c
+
+
+The final rm command is just to clean up the intermediate file and is
+not strictly necessary.
+
+After all C source files have been compiled into .o files, they can be
+linked together, and with the Tcl/Tk library using a command such as
+the following:
+
+
+
+ cc -o myapp main.o file1.o file2.o et.o -ltk -ltcl -lX11 -lm
+
+
+This example links together the files main.o, file1.o and file2.o into
+an executable named myapp. All ET applications must be linked with
+et.o and the Tcl/Tk libraries. The Tcl/Tk libraries require, in turn,
+the X11 library and the math library. On some systems it may be
+necessary to include one or more -L options on the command line to
+tell the linker were to find these libraries. Applications that use
+other libraries or Tcl/Tk extension packages will probably need
+addition -l switches.
+
+The default action of the linker is usually to bind to shared
+libraries for Tcl/Tk and X11 if shared libraries are available. If
+the executable is to be moved to other sites, where these libraries
+may not be installed, it is best to force the use of static libraries
+in the link. The command-line option to achieve this is usually
+-static or -Bstatic, though it varies from system to system.
+
+9.1 Source file suffix conventions
+
+We like to use the suffix .c for ET application source files even
+though the files do not contain pure C code. The reason is that ET
+source code looks like C even if it isn't. To files output from the
+et2c preprocessor we give the suffix _.c.
+
+Other users have reported that they don't like to use the .c suffix on
+ET source files since it implies that the file can be directly
+compiled using the C compiler. They prefer a different suffix for the
+ET source, and reserve the .c suffix for the output of the et2c
+preprocessor. Like this:
+
+
+
+ et2c main.et >main.c
+ cc -c -o main.o main.c
+ rm main.c
+
+
+The method you use is purely a matter of personal preference. The
+et2c preprocessor makes no assumptions about file names. Most C
+compilers, however, require that their input files end with .c so be
+sure the output of et2c is written to a file with that suffix.
+
+9.2 Compiling using an older K&R C compiler
+
+If it is your misfortune not to have an ANSI C compiler, you can still
+use ET. The source code to et2c is pure K&R C and should work fine
+under older compilers. The source code to et.o is another matter. To
+compile the library using an older compiler you will need to first
+give a -K+R option to et2c and then give a -DK_AND_R option to the C
+compiler. Like this:
+
+
+
+ et2c -K+R -I/usr/lib/tcl -I/usr/lib/tk et.c >et_.c
+ cc -DK_AND_R -I/usr/src/tcl7.4 -I/usr/src/tk4.0 -c -o et.o et_.c
+
+
+When compiling application code using an older compiler, just give the
+-K+R option to et2c. It is not necessary to give the -DK_AND_R option
+to the C compiler when compiling objects other than et.c.
+
+9.3 Where to store the ET files
+
+The source code to the et2c preprocessor and the et.o library is small
+-- less than 2100 lines total, including comments. For that reason,
+we find it convenient to include a copy of the sources in the source
+tree for projects that use ET. The makefiles for these projects
+includes steps to build the preprocessor and library as a precondition
+to compiling the application code. In this way, we never have to "
+install" ET in order to use it. This also allows the source tree to
+be shipped to another site and compiled there without having to ship
+ET separately.
+
+
+10. Summary and conclusion
+
+The ET system provides a simple and convenient mechanism for combining
+a Tcl/Tk based graphical user interface and a C program into a single
+executable. The system gives a simple method for calling Tcl/Tk from
+C, for generating new Tcl/Tk commands written in C, and for including
+external Tcl/Tk scripts as part of a C program.
+
+ET is currently in use in several large-scale (more than 100000 lines
+of code) development efforts, and is proving that it is capable of
+providing an easy-to-use yet robust interface between Tcl/Tk and C.
+
+
+11. Acknowledgments
+
+The original implementation of ET grew out of a programming contract
+from AT&T. AT&T was in turn funded under a contract from the United
+States Navy. Many thanks go to Richard Blanchard at AT&T and to Dave
+Toms and Clair Guthrie at PMO-428 for allowing ET to be released to
+the public domain.
+
+
+12. Author's Name and Address
+
+D. Richard Hipp, Ph.D.
+Hipp, Wyrick & Company, Inc.
+6200 Maple Cove Lane
+Charlotte, NC 28269
+704-948-4565
+drh@vnet.net
diff --git a/tix/docs/FAQ.html b/tix/docs/FAQ.html
new file mode 100644
index 00000000000..b954e74b48c
--- /dev/null
+++ b/tix/docs/FAQ.html
@@ -0,0 +1,700 @@
+
+ <center><h1>Tix Frequently Asked Questions</h1></center>
+
+
+ <h3>Table of Contents</h3>
+
+<DL>
+<DT><i><b>
+ Legal Issues
+</b></i><DD><ul>
+<li> <a href=#legal.1> [L.1] </a>
+ Is Tix free software?
+</ul><p>
+<DT><i><b>
+ General Questions About Using The Tix Library
+</b></i><DD><ul>
+<li> <a href=#general.1> [G.1] </a>
+ What does the "<code>-disablecallback</code>"
+ option do?
+<li> <a href=#general.2> [G.2] </a>
+ How do I set the width of the entry subwidget inside the tixControl widget?
+<li> <a href=#general.3> [G.3] </a>
+ What is the "<code>setslient</code>" method?
+<li> <a href=#general.4> [G.4] </a>
+ Is there a Tix interface builder in the works?
+<li> <a href=#general.5> [G.5] </a>
+ Can you tell me about the syntax of tixForm
+<li> <a href=#general.6> [G.6] </a>
+
+ I am not using the tixForm geometry manager, but it is giving me
+errors about TixForm. What happened?
+<li> <a href=#general.7> [G.7] </a>
+ How do I generate the <code>tclIndex</code> file for Tix?
+<li> <a href=#general.8> [G.8] </a>
+ Can I ignore the default arguments passed by the various
+ <code>-command</code> and <code>-broeswcmd</code> options?
+<li> <a href=#general.9> [G.9] </a>
+ What does <code>tixWidgetDoWhenIdle</code> do?
+<li> <a href=#general.feature_req> [G.10] </a>
+ Why isn't such a feature in Tix? Will it be implemented?
+<li> <a href=#general.softwares> [G.11] </a>
+ Who are using Tix in their software?
+<li> <a href=#general.twice> [G.12] </a>
+
+ I am using a DirList widget. When the user clicks on an item, the
+ procedure of my <code>-browsecmd</code> gets called
+ twice. However, I just want it to be called once.
+<li> <a href=#general.destroy> [G.13] </a>
+
+ I get an error <i>"can't read data(-value): no such element in
+ array</i>" when I use the tixExFileSelectDialog.
+</ul><p>
+<DT><i><b>
+ Question About Porting to Specific Platforms/Software
+</b></i><DD><ul>
+<li> <a href=#port.1> [P.1] </a>
+ The configure script gave me strange errors.
+<li> <a href=#port.tk41> [P.2] </a>
+
+ Does Tix 4.1 work with <b>Tk 4.1</b>
+<li> <a href=#port.itcl> [P.3] </a>
+ Does Tix work with <b>Incr Tcl 2.0</b>?
+<li> <a href=#port.expect> [P.4] </a>
+
+ How do I get Tix to work with <b>Expect</b>?
+<li> <a href=#port.6> [P.5] </a>
+ <b>Solaris 2.4:</b>
+ Filenames in FileSelectBox are chopped off.
+<li> <a href=#port.7> [P.6] </a>
+ Do I still need libXpm?
+<li> <a href=#port.8> [P.7] </a>
+ <a name=coredump1>I get a coredump as soon as tixwish starts up.
+</ul><p>
+<DT><i><b>
+ Porting from Tix 3.6 to Tix 4.x
+</b></i><DD><ul>
+<li> <a href=#tix36to40.1> [X.1] </a>
+ What happened to the <code>tixInit</code> command?
+<li> <a href=#tix36to40.2> [X.2] </a>
+ How do I set the schemes and fontsets in Tix 4.x?
+<li> <a href=#tix36to40.3> [X.3] </a>
+ How do I choose the default TK color schemes and fontsets? Tix is
+ messing up the colors of my existing programs.
+<li> <a href=#tix36to40.4> [X.4] </a>
+ I want the old bisque look of Tk 3.6. tk_bisque doesn't work.
+</ul><p>
+</DL>
+<hr>
+<h3>
+ Legal Issues
+</h3>
+<DL>
+<DT> <b><a name=legal.1> [L.1] </a>
+ Is Tix free software?
+</b><p>
+<DD>
+<b> ANSWER: </b>
+
+ Tix is distributed under the same license as Tcl/Tk (a.k.a. BSD
+ style license). Application developers can freely redistribute
+ Tix along with their products. <p>
+
+ We will continue to provide free technical support and
+ maintainence for Tix. However, to recover the development costs,
+ we would appreciate financial supports for the Tix user
+ community. If you like Tix and would like to make a donation to
+ the Tix Project, please send mail to <a
+ href="mailto:xpi@xpi.com">xpi@xpi.com</a>. <p>
+
+
+<p>
+</DL>
+<hr>
+<h3>
+ General Questions About Using The Tix Library
+</h3>
+<DL>
+<DT> <b><a name=general.1> [G.1] </a>
+ What does the "<code>-disablecallback</code>"
+ option do?
+</b><p>
+<DD>
+<b> ANSWER: </b>
+
+ Many Tix widgets have both a <code>-value</code> option and a
+ <code>-command</code> option. Any modification of the
+ <code>-value</code> will cause the <code>-command</code> callback
+ to be executed. Sometimes this is undesirable. For example,
+ calling "<code>config -value</code>" inside the callback procedure
+ will cause the callback to be re-entered and thus an infinite
+ recursion. <p>
+
+ The <code>-disablecallback</code> can be used to advoid this
+ problem. When this option is set, the <code>-command</code>
+ callback will not be executed even if the -value of a widget is
+ changed. Therefore, if you need to modify the -value of a widget
+ inside its callback, do this:
+
+ <blockquote><pre>
+ proc my_callback {w} {
+ $w config -disablecallback true
+ $w config value blah
+ $w config -disablecallback false
+ }
+ </pre></blockquote>
+
+ If you find this too troublesome, you can call the command tixSetSilent:
+
+ <blockquote><pre>
+ proc my_callback {w} {
+ tixSetSilent $w blah
+ }
+ </pre></blockquote>
+
+<p>
+<DT> <b><a name=general.2> [G.2] </a>
+ How do I set the width of the entry subwidget inside the tixControl widget?
+</b><p>
+<DD>
+<b> ANSWER: </b>
+
+ You can use the option database or the -options flag to set the
+ configuration options of the subwidgets. E.g: <pre>
+
+option add *TixControl*entry.width 10
+</pre>
+
+ OR
+
+<pre>
+tixControl .c -options {
+ entry.width 10
+}
+</pre>
+
+<p>
+<DT> <b><a name=general.3> [G.3] </a>
+ What is the "<code>setslient</code>" method?
+</b><p>
+<DD>
+<b> ANSWER: </b>
+ This is an obsolete method. You could use it to achieve the same
+ effect as the <code>-disablecallback</code> option.
+ <code>selsilent</code> used to be a widget command for the
+ ComboBox, Control, etc. It has been removed since Tix 4.0a4 and
+ replaced by the <code>tixSetSilent</code> command. Please note
+ that <code>tixSetSilent</code> is not a widget command but an
+ external procedure.
+
+<p>
+<DT> <b><a name=general.4> [G.4] </a>
+ Is there a Tix interface builder in the works?
+</b><p>
+<DD>
+<b> ANSWER: </b>
+ Yes. But I don't know when it will be finished. (probably in 96).
+
+<p>
+<DT> <b><a name=general.5> [G.5] </a>
+ Can you tell me about the syntax of tixForm
+</b><p>
+<DD>
+<b> ANSWER: </b>
+ Please see the file <a href="../man/Form.html">man/Form.html</a>
+ or <a href="../man/Form.n">man/Form.n</a>.
+
+<p>
+<DT> <b><a name=general.6> [G.6] </a>
+
+ I am not using the tixForm geometry manager, but it is giving me
+errors about TixForm. What happened?
+</b><p>
+<DD>
+<b> ANSWER: </b>
+
+ When you get error messages like this:
+
+<pre> (TixForm) Error:Trying to use more than one geometry
+ manager for the same master window.
+ Giving up after 50 iterations.</pre>
+
+ Most likely, the problem is when using tixLabelFrame widgets, you
+ packed to the wrong frame: <p>
+
+ This is WRONG:
+
+<pre> tixLabelFrame .d
+ button .d.b
+ pack .d.b </pre>
+
+This is the correct way:
+
+<pre> tixLabelFrame .d
+ set f [.d subwidget frame]
+ button $f.b
+ pack $f.b
+ pack .d </pre>
+
+ Remember you don't pack directly into a TixLabelFrame
+ widget. Instead, you should pack into its <code>frame</code>
+ subwidget.
+
+<p>
+<DT> <b><a name=general.7> [G.7] </a>
+ How do I generate the <code>tclIndex</code> file for Tix?
+</b><p>
+<DD>
+<b> ANSWER: </b>
+
+ Tix <code>tclIndex</code> files cannot be generated using the
+ standard auto_mkindex procedure. You must use the tixindex program
+ in the <code>tools/</code> subdirectory in the Tix
+ distribution. The syntax is
+ <pre> tixindex *.tcl
+ </pre>
+
+<p>
+<DT> <b><a name=general.8> [G.8] </a>
+ Can I ignore the default arguments passed by the various
+ <code>-command</code> and <code>-broeswcmd</code> options?
+</b><p>
+<DD>
+<b> ANSWER: </b>
+ You can use the <code>tixBreak</code> command. For example:
+<pre> tixFileSelectDialog .c -command "puts foo; tixBreak" </pre>
+
+<p>
+<DT> <b><a name=general.9> [G.9] </a>
+ What does <code>tixWidgetDoWhenIdle</code> do?
+</b><p>
+<DD>
+<b> ANSWER: </b>
+
+ It does the same thing as tixDoWhileIdle (and "after -idle"). The
+ difference is it takes its second argument as the name of a widget
+ and executes this command only if the widget exists: i.e.:
+
+
+<pre> tixWidgetDoWhenIdle tixComboBox::Update $w blah blah ..</pre>
+
+ will execute tixComboBox::Update only if $w exists. $w may be
+ destroyed after tixWidgetDoWhenIdle is called but before an idle
+ event happens.
+
+<p>
+<DT> <b><a name=general.feature_req> [G.10] </a>
+ Why isn't such a feature in Tix? Will it be implemented?
+</b><p>
+<DD>
+<b> ANSWER: </b>
+
+ Generally requests for new features are welcomed. You can send
+ your requests to <a href=mailto:tix@xpi.com> tix@xpi.com </a> and
+ we'll be happy to hear from you. <p>
+
+ We can't guarantee to implement the requested features
+ immediately. Usually it depends on how important the features. If
+ the feature is requested by more people, it will usually get done
+ faster.
+
+ However, some frequently requested features probably won't be
+ imlemented. Usually these features are cosmetic changes and:
+
+ <ul>
+ <li> they do not add new capability to the widgets
+ <li> they are not universally liked
+ <li> they confuse the user.
+ </ul>
+
+ <p>
+ Some examples are:
+
+ <ul>
+
+ <li> <b>Different foreground and background colors for the
+ NoteBook tabs</b>: having a lot of colors may antagonize the users
+ that are "color haters"; also, the different colors don't make it
+ easier for the user to locate the desired tab.
+
+ <li> <b>Ring-binder metaphore for the NoteBook widget</b>: a waste
+ of screen real estate.
+
+ <li> <b>Rows of tabs for the NoteBook widget</b>: the user may be
+ confused when the rows of tabs are switched. If you need to have a
+ lot of tabs for the notebook, use the ListNoteBook widget instead.
+
+ </ul>
+
+
+<p>
+<DT> <b><a name=general.softwares> [G.11] </a>
+ Who are using Tix in their software?
+</b><p>
+<DD>
+<b> ANSWER: </b>
+
+ I have compiled a list of softwares that use Tix. See <a
+ href=http://www.xpi.com/tix/software.html>
+ http://www.xpi.com/tix/software.html</a>. (These are only the ones
+ that I have heard of, either from the authors themselves or from
+ the TCL FAQ. There should be more of them).
+
+
+
+<p>
+<DT> <b><a name=general.twice> [G.12] </a>
+
+ I am using a DirList widget. When the user clicks on an item, the
+ procedure of my <code>-browsecmd</code> gets called
+ twice. However, I just want it to be called once.
+</b><p>
+<DD>
+<b> ANSWER: </b>
+
+ The <code>-browsecmd</code> procedure is triggered by three types
+ of events: <code>&lt;1&gt;</code>,
+ <code>&lt;ButtonRelease-1&gt;</code>, and
+ <code>&lt;B1-Motion&gt;</code>. When the user clicks on an entry,
+ a <code>&lt;1&gt;</code> and a
+ <code>&lt;ButtonRelease-1&gt;</code> event will happen in rapid
+ session, which causes your <code>-browsecmd</code> procedure to be
+ called twice. <p>
+
+ A crude fix for this problem is to ignore all the
+ <code>&lt;ButtonRelease-1&gt;</code> events. You can find out the
+ event that triggers the <code>-browsecmd</code> procedure by the
+ <code>tixEvent</code> command. Here is an example:
+
+ <blockquote><pre>
+ tixDirList .c -browsecmd Browse
+
+ proc Browse {args} {
+ if {[tixEvent type] == "<code>&lt;ButtonRelease-1&gt;</code>"} {
+ return
+ }
+ # ....
+ }
+ </pre></blockquote>
+
+ However, the above solution is not perfect. For example, if the
+ user clicks down the button at entry one, drags it over entries
+ two and three and release it on top of entry three, the following
+ events may be caused: <p>
+
+ <ol>
+ <li> <code>&lt;1&gt;</code> on entry one.
+ <li> <code>&lt;B1-Motion&gt;</code> on entry two.
+ <li> <code>&lt;ButtonRelease-1&gt;</code> on entry three.
+ </ol> <p>
+
+ Therefore, if you use the above method, the browse event on entry
+ three will be lost! <p>
+
+ To devise a better solution, it's better to understand the basic
+ design conventions of a Tix-based GUI. Suppose we have a list of
+ entries displayed in a listbox (or DirList, or HList). When the
+ user clicks on an entry, the GUI usually responds by displaying a
+ "<b>detailed view</b>" of the entry. For example, if we put a list
+ of file names in a listbox, when the user clicks on a file name,
+ we display the contents of the file in a text window. If the user
+ then clicks on another file name, the text window will load in the
+ contents of the new file. <p>
+
+ Now what happens if the user clicks on the same entry twice? Do we
+ reload the contents of the file into the text window? This is
+ usually unnecessary, inefficient and probably not what the user
+ wants to do. The Tix convention is, when the user clicks on the
+ same entry again, the detail view is not updated. If the user
+ wants to force an update (e.g, the user knows the file's contents
+ has been changed and wants to see the new version), he or she can
+ double-click on the entry and the application will respond by
+ redisplaying the detail view (reloading the file). <p>
+
+ To implement this policy, the Browse procedure should be modified
+ as the following:
+
+ <blockquote><pre>
+ proc Browse {args} {
+ global currentView
+
+ set ent [tixEvent value]
+ if {$ent == $currentView} {
+ # We have already displayed the detailed view of $ent.
+ #
+ return
+ } else {
+ set currentView $ent
+ DisplayDetail $ent
+ }
+ }
+ </pre></blockquote> <p>
+
+<p>
+<DT> <b><a name=general.destroy> [G.13] </a>
+
+ I get an error <i>"can't read data(-value): no such element in
+ array</i>" when I use the tixExFileSelectDialog.
+</b><p>
+<DD>
+<b> ANSWER: </b>
+
+ If you use tixExFileSelectDialog like this:
+
+<pre>
+ tixExFileSelectDialog .f -command foo
+
+ foo {filename} {
+ destroy .f
+ do some other stuff ...
+ }
+</pre>
+
+ it will cause a Tcl error because the dialog assumes that it still
+ exists after calling your command. This usually result in errors like
+ this:
+
+<pre>
+ can't read "data(-value)": no such element in array
+ while executing
+ "set data(-selection) $data(-value)..."
+ (procedure "tixComboBox::SetValue" line 30)
+</pre>
+
+
+ This "feature" is built into many Tix widgets and can't be fixed
+ easily. To work around the problem, never destroy widgets inside
+ -command calls. Usually you should unmap toplevel windows
+ instead. If you must destroy widgets, do it with an "after"
+ command. For example, the foo procedure should be rewritten as:
+
+<pre>
+ foo {filename} {
+ wm withdraw .f
+ do some other stuff ...
+
+ after idle {if [winfo exists .f] {destroy .f}}
+ }
+</pre>
+
+ Execute the "after" command at the very end of the
+ -command. Otherwise the idle handler may be activated by some
+ "update" calls.
+
+<p>
+</DL>
+<hr>
+<h3>
+ Question About Porting to Specific Platforms/Software
+</h3>
+<DL>
+<DT> <b><a name=port.1> [P.1] </a>
+ The configure script gave me strange errors.
+</b><p>
+<DD>
+<b> ANSWER: </b>
+ The problem may be you have several operating systems sharing the
+ same file system. Some people encounter error messages like this:
+
+<blockquote><pre>
+# ./configure --prefix=/usr/vendor/tcl
+loading cache ./config.cache
+checking for a BSD compatible install... /usr/bin/installbsd -c
+checking for ranlib... ranlib
+checking how to run the C preprocessor... cc -E
+checking for unistd.h... ./configure[603]: "${ac_cv_header_$ac_safe+set}": bad
+substitution
+</pre></blockquote>
+
+ The problem is at line 2, configure loaded in ./config.cache,
+ which may have been created by a different operating system, with
+ settings only usuable for that operating system. To get around
+ this, you should type
+
+<blockquote><pre>
+make distclean
+./configure
+make all
+</pre></blockquote>
+
+<p>
+<DT> <b><a name=port.tk41> [P.2] </a>
+
+ Does Tix 4.1 work with <b>Tk 4.1</b>
+</b><p>
+<DD>
+<b> ANSWER: </b>
+
+ Yes, just enable the "Tk 4.1 ..." option in the setup program. It
+ will also compile Tix in a dynamic lobrary.
+
+
+<p>
+<DT> <b><a name=port.itcl> [P.3] </a>
+ Does Tix work with <b>Incr Tcl 2.0</b>?
+</b><p>
+<DD>
+<b> ANSWER: </b>
+
+ Yes just enable the "Itcl 2.0 ..." option in the setup
+ program. Make sure you have ITcl 2.0 installed. Beta versions will
+ *NOT* work. Also make sure you have installed the source tree of
+ ITcl 2.0 in the same directory where you install the Tix source
+ tree.
+
+<p>
+<DT> <b><a name=port.expect> [P.4] </a>
+
+ How do I get Tix to work with <b>Expect</b>?
+</b><p>
+<DD>
+<b> ANSWER: </b>
+ From Paul Schmidt (kuato@netcom.com):
+
+ <blockquote>
+
+ I have integrated Tcl7.4, Tk4.0, Expect-5.19 and Tix4.0 on Linux
+ 1.2.13 (ELF) and Solaris 2.4. It isn't too hard. For an
+ expectk+Tix binary you need to add a call to Tix_Init in
+ exp_main_tk.c. If you can find the call to Tk_Init then just
+ cut&paste and replace it with Tix_Init. Do the same if you want a
+ Tk+Tix window shell in TkAppInit.c. Worked like a charm. If you
+ have any problems just holler.
+
+ </blockquote>
+
+
+<p>
+<DT> <b><a name=port.6> [P.5] </a>
+ <b>Solaris 2.4:</b>
+ Filenames in FileSelectBox are chopped off.
+</b><p>
+<DD>
+<b> ANSWER: </b>
+ <b>Problem:</b>
+ <blockquote>
+
+ With Tix4.0a7 (and also with Tix4.0a6) on Solaris 2.4, when
+ running the widget demo, in tixFileSelectBox, in the two scolling
+ lists (for Files an Directories), some of the file and directory
+ names have their first 2 letters chopped off. And some files are
+ repeated.
+
+ </blockquote>
+
+ <b>Solution:</b> tixwish has some conflicts with /usr/ucblib/libucb.so.1
+ and you should not linke it tixwish (you don't need it). Here is
+ a solution provided by Charles L Ditzel
+ (<i>charles@hanami.cyberspace.com</i>):
+
+ <blockquote>
+ To fix the problem I was having, all I did was:
+
+ <pre>
+ unsetenv LD_LIBRARY_PATH
+ set my PATH to something basic like:
+ /usr/bin:/usr/ccs/bin:/bin:/usr/openwin/bin:/opt/SUNWspro/bin
+ removed config.cache
+ ./configure
+ make clean
+ make
+ </pre>
+
+ and now it works!! Must have been something in my old
+ <code>PATH</code> or <code>LD_LIBRARY_PATH</code> that was
+ causing it to pick up <code>/usr/ucblib/libucb.so</code>.
+
+ </blockquote>
+
+<p>
+<DT> <b><a name=port.7> [P.6] </a>
+ Do I still need libXpm?
+</b><p>
+<DD>
+<b> ANSWER: </b>
+
+ No, now Tix has its own XPM file reader. You no longer need libXpm.
+
+
+<p>
+<DT> <b><a name=port.8> [P.7] </a>
+ <a name=coredump1>I get a coredump as soon as tixwish starts up.
+</b><p>
+<DD>
+<b> ANSWER: </b>
+
+
+ Try to get a backtrace of the stack when the core dump happens
+ (with a debugger, for example). If the core dump happens right
+ inside the call to <code>Tk_ConfigureWidget()</code> inside the
+ file <code>tixInit.c</code>, then the problem is because you
+ compiled <code>libtk.a</code> and <code>libtix.a</code> with
+ different versions of the Th header file
+ <code>tk.h</code>. Delete all the <code>.o</code> files from the
+ src directory of Tix, fix the Makefile so that now you can
+ compile <code>libtix.a</code> with the same tk.h that you used to
+ compile <code>libtk.a</code>.
+
+
+<p>
+</DL>
+<hr>
+<h3>
+ Porting from Tix 3.6 to Tix 4.x
+</h3>
+<DL>
+<DT> <b><a name=tix36to40.1> [X.1] </a>
+ What happened to the <code>tixInit</code> command?
+</b><p>
+<DD>
+<b> ANSWER: </b>
+ You don't need to use it anymore. It is provided in Tix 4.x only for
+ backward compatibility.
+
+<p>
+<DT> <b><a name=tix36to40.2> [X.2] </a>
+ How do I set the schemes and fontsets in Tix 4.x?
+</b><p>
+<DD>
+<b> ANSWER: </b>
+ You can set the color schemes and fontsets using the standard X
+ resource database (.Xdefaults file). You can add these two lines
+ in the user's .Xdefaults file: <pre>
+
+ *TixScheme: Gray
+ *TixFontSet: 14Point </pre>
+
+ If you want to switch color schemes and fontsets during run time,
+ you can issue the following commands: <pre>
+ tix config -scheme Gray -fontset 14Point
+ </pre>
+
+ Please read the <a href=../man/tix.html>tix</a> manual page for
+ more details
+
+<p>
+<DT> <b><a name=tix36to40.3> [X.3] </a>
+ How do I choose the default TK color schemes and fontsets? Tix is
+ messing up the colors of my existing programs.
+</b><p>
+<DD>
+<b> ANSWER: </b>
+ Add these two lines in your .Xdefaults:<pre>
+
+ *TixScheme: TK
+ *TixFontSet: TK </pre>
+
+<p>
+<DT> <b><a name=tix36to40.4> [X.4] </a>
+ I want the old bisque look of Tk 3.6. tk_bisque doesn't work.
+</b><p>
+<DD>
+<b> ANSWER: </b>
+
+ The Tix widgets are not compatible with tk_bisque. If you want a
+ bisque-ish look you can add to your .Xdefaults file the following
+ line:<pre>
+ *TixScheme: Bisque</pre>
+
+<p>
+</DL>
diff --git a/tix/docs/FAQ.txt b/tix/docs/FAQ.txt
new file mode 100644
index 00000000000..dbb9da3010b
--- /dev/null
+++ b/tix/docs/FAQ.txt
@@ -0,0 +1,476 @@
+
+ TIX FREQUENTLY ASKED QUESTIONS
+
+ TABLE OF CONTENTS
+
+ Legal Issues
+
+ + [L.1] Is Tix free software?
+
+ General Questions About Using The Tix Library
+
+ + [G.1] What does the "-disablecallback" option do?
+ + [G.2] How do I set the width of the entry subwidget inside
+ the tixControl widget?
+ + [G.3] What is the "setslient" method?
+ + [G.4] Is there a Tix interface builder in the works?
+ + [G.5] Can you tell me about the syntax of tixForm
+ + [G.6] I am not using the tixForm geometry manager, but it is
+ giving me errors about TixForm. What happened?
+ + [G.7] How do I generate the tclIndex file for Tix?
+ + [G.8] Can I ignore the default arguments passed by the
+ various -command and -broeswcmd options?
+ + [G.9] What does tixWidgetDoWhenIdle do?
+ + [G.10] Why isn't such a feature in Tix? Will it be
+ implemented?
+ + [G.11] Who are using Tix in their software?
+ + [G.12] I am using a DirList widget. When the user clicks on
+ an item, the procedure of my -browsecmd gets called twice.
+ However, I just want it to be called once.
+ + [G.13] I get an error "can't read data(-value): no such
+ element in array" when I use the tixExFileSelectDialog.
+
+ Question About Porting to Specific Platforms/Software
+
+ + [P.1] The configure script gave me strange errors.
+ + [P.2] Does Tix 4.1 work with Tk 4.1
+ + [P.3] Does Tix work with Incr Tcl 2.0?
+ + [P.4] How do I get Tix to work with Expect?
+ + [P.5] Solaris 2.4: Filenames in FileSelectBox are chopped
+ off.
+ + [P.6] Do I still need libXpm?
+ + [P.7] I get a coredump as soon as tixwish starts up.
+
+ Porting from Tix 3.6 to Tix 4.x
+
+ + [X.1] What happened to the tixInit command?
+ + [X.2] How do I set the schemes and fontsets in Tix 4.x?
+ + [X.3] How do I choose the default TK color schemes and
+ fontsets? Tix is messing up the colors of my existing
+ programs.
+ + [X.4] I want the old bisque look of Tk 3.6. tk_bisque doesn't
+ work.
+
+ _________________________________________________________________
+
+ LEGAL ISSUES
+
+ [L.1] Is Tix free software?
+
+ ANSWER: Tix is distributed under the same license as Tcl/Tk
+ (a.k.a. BSD style license). Application developers can freely
+ redistribute Tix along with their products.
+
+ We will continue to provide free technical support and
+ maintainence for Tix. However, to recover the development
+ costs, we would appreciate financial supports for the Tix user
+ community. If you like Tix and would like to make a donation to
+ the Tix Project, please send mail to xpi@xpi.com.
+
+ _________________________________________________________________
+
+ GENERAL QUESTIONS ABOUT USING THE TIX LIBRARY
+
+ [G.1] What does the "-disablecallback" option do?
+
+ ANSWER: Many Tix widgets have both a -value option and a
+ -command option. Any modification of the -value will cause the
+ -command callback to be executed. Sometimes this is
+ undesirable. For example, calling "config -value" inside the
+ callback procedure will cause the callback to be re-entered and
+ thus an infinite recursion.
+
+ The -disablecallback can be used to advoid this problem. When
+ this option is set, the -command callback will not be executed
+ even if the -value of a widget is changed. Therefore, if you
+ need to modify the -value of a widget inside its callback, do
+ this:
+
+ proc my_callback {w} {
+ $w config -disablecallback true
+ $w config value blah
+ $w config -disablecallback false
+ }
+
+ If you find this too troublesome, you can call the command
+ tixSetSilent:
+
+ proc my_callback {w} {
+ tixSetSilent $w blah
+ }
+
+ [G.2] How do I set the width of the entry subwidget inside the
+ tixControl widget?
+
+ ANSWER: You can use the option database or the -options flag to
+ set the configuration options of the subwidgets. E.g:
+
+option add *TixControl*entry.width 10
+
+ OR
+
+tixControl .c -options {
+ entry.width 10
+}
+
+ [G.3] What is the "setslient" method?
+
+ ANSWER: This is an obsolete method. You could use it to achieve
+ the same effect as the -disablecallback option. selsilent used
+ to be a widget command for the ComboBox, Control, etc. It has
+ been removed since Tix 4.0a4 and replaced by the tixSetSilent
+ command. Please note that tixSetSilent is not a widget command
+ but an external procedure.
+
+ [G.4] Is there a Tix interface builder in the works?
+
+ ANSWER: Yes. But I don't know when it will be finished.
+ (probably in 96).
+
+ [G.5] Can you tell me about the syntax of tixForm
+
+ ANSWER: Please see the file man/Form.html or man/Form.n.
+
+ [G.6] I am not using the tixForm geometry manager, but it is giving me
+ errors about TixForm. What happened?
+
+ ANSWER: When you get error messages like this:
+
+ (TixForm) Error:Trying to use more than one geometry
+ manager for the same master window.
+ Giving up after 50 iterations.
+
+ Most likely, the problem is when using tixLabelFrame widgets, you
+ packed to the wrong frame:
+
+ This is WRONG:
+
+ tixLabelFrame .d
+ button .d.b
+ pack .d.b
+
+ This is the correct way:
+
+ tixLabelFrame .d
+ set f [.d subwidget frame]
+ button $f.b
+ pack $f.b
+ pack .d
+
+ Remember you don't pack directly into a TixLabelFrame widget. Instead,
+ you should pack into its frame subwidget.
+
+ [G.7] How do I generate the tclIndex file for Tix?
+
+ ANSWER: Tix tclIndex files cannot be generated using the
+ standard auto_mkindex procedure. You must use the tixindex
+ program in the tools/ subdirectory in the Tix distribution. The
+ syntax is
+
+ tixindex *.tcl
+
+ [G.8] Can I ignore the default arguments passed by the various
+ -command and -broeswcmd options?
+
+ ANSWER: You can use the tixBreak command. For example:
+
+ tixFileSelectDialog .c -command "puts foo; tixBreak"
+
+ [G.9] What does tixWidgetDoWhenIdle do?
+
+ ANSWER: It does the same thing as tixDoWhileIdle (and "after
+ -idle"). The difference is it takes its second argument as the
+ name of a widget and executes this command only if the widget
+ exists: i.e.:
+
+ tixWidgetDoWhenIdle tixComboBox::Update $w blah blah ..
+
+ will execute tixComboBox::Update only if $w exists. $w may be
+ destroyed after tixWidgetDoWhenIdle is called but before an
+ idle event happens.
+
+ [G.10] Why isn't such a feature in Tix? Will it be implemented?
+
+ ANSWER: Generally requests for new features are welcomed. You
+ can send your requests to tix@xpi.com and we'll be happy to
+ hear from you.
+
+ We can't guarantee to implement the requested features
+ immediately. Usually it depends on how important the features.
+ If the feature is requested by more people, it will usually get
+ done faster. However, some frequently requested features
+ probably won't be imlemented. Usually these features are
+ cosmetic changes and:
+
+ + they do not add new capability to the widgets
+ + they are not universally liked
+ + they confuse the user.
+
+ Some examples are:
+
+ + Different foreground and background colors for the NoteBook
+ tabs: having a lot of colors may antagonize the users that
+ are "color haters"; also, the different colors don't make it
+ easier for the user to locate the desired tab.
+ + Ring-binder metaphore for the NoteBook widget: a waste of
+ screen real estate.
+ + Rows of tabs for the NoteBook widget: the user may be
+ confused when the rows of tabs are switched. If you need to
+ have a lot of tabs for the notebook, use the ListNoteBook
+ widget instead.
+
+ [G.11] Who are using Tix in their software?
+
+ ANSWER: I have compiled a list of softwares that use Tix. See
+ http://www.xpi.com/tix/software.html. (These are only the
+ ones that I have heard of, either from the authors themselves
+ or from the TCL FAQ. There should be more of them).
+
+ [G.12] I am using a DirList widget. When the user clicks on an item,
+ the procedure of my -browsecmd gets called twice. However, I
+ just want it to be called once.
+
+ ANSWER: The -browsecmd procedure is triggered by three types of
+ events: <1>, <ButtonRelease-1>, and <B1-Motion>. When the user
+ clicks on an entry, a <1> and a <ButtonRelease-1> event will
+ happen in rapid session, which causes your -browsecmd procedure
+ to be called twice.
+
+ A crude fix for this problem is to ignore all the
+ <ButtonRelease-1> events. You can find out the event that
+ triggers the -browsecmd procedure by the tixEvent command. Here
+ is an example:
+
+ tixDirList .c -browsecmd Browse
+
+ proc Browse {args} {
+ if {[tixEvent type] == "<ButtonRelease-1>"} {
+ return
+ }
+ # ....
+ }
+
+ However, the above solution is not perfect. For example, if the user
+ clicks down the button at entry one, drags it over entries two
+ and three and release it on top of entry three, the following
+ events may be caused:
+
+ 1. <1> on entry one.
+ 2. <B1-Motion> on entry two.
+ 3. <ButtonRelease-1> on entry three.
+
+ Therefore, if you use the above method, the browse event on
+ entry three will be lost!
+
+ To devise a better solution, it's better to understand the
+ basic design conventions of a Tix-based GUI. Suppose we have a
+ list of entries displayed in a listbox (or DirList, or HList).
+ When the user clicks on an entry, the GUI usually responds by
+ displaying a "detailed view" of the entry. For example, if we
+ put a list of file names in a listbox, when the user clicks on
+ a file name, we display the contents of the file in a text
+ window. If the user then clicks on another file name, the text
+ window will load in the contents of the new file.
+
+ Now what happens if the user clicks on the same entry twice? Do
+ we reload the contents of the file into the text window? This
+ is usually unnecessary, inefficient and probably not what the
+ user wants to do. The Tix convention is, when the user clicks
+ on the same entry again, the detail view is not updated. If the
+ user wants to force an update (e.g, the user knows the file's
+ contents has been changed and wants to see the new version), he
+ or she can double-click on the entry and the application will
+ respond by redisplaying the detail view (reloading the file).
+
+ To implement this policy, the Browse procedure should be
+ modified as the following:
+
+ proc Browse {args} {
+ global currentView
+
+ set ent [tixEvent value]
+ if {$ent == $currentView} {
+ # We have already displayed the detailed view of $ent.
+ #
+ return
+ } else {
+ set currentView $ent
+ DisplayDetail $ent
+ }
+ }
+
+ [G.13] I get an error "can't read data(-value): no such element in
+ array" when I use the tixExFileSelectDialog.
+
+ ANSWER: If you use tixExFileSelectDialog like this:
+
+ tixExFileSelectDialog .f -command foo
+
+ foo {filename} {
+ destroy .f
+ do some other stuff ...
+ }
+
+ it will cause a Tcl error because the dialog assumes that it still
+ exists after calling your command. This usually result in
+ errors like this:
+
+ can't read "data(-value)": no such element in array
+ while executing
+ "set data(-selection) $data(-value)..."
+ (procedure "tixComboBox::SetValue" line 30)
+
+ This "feature" is built into many Tix widgets and can't be fixed
+ easily. To work around the problem, never destroy widgets
+ inside -command calls. Usually you should unmap toplevel
+ windows instead. If you must destroy widgets, do it with an
+ "after" command. For example, the foo procedure should be
+ rewritten as:
+
+ foo {filename} {
+ wm withdraw .f
+ do some other stuff ...
+
+ after idle {if [winfo exists .f] {destroy .f}}
+ }
+
+ Execute the "after" command at the very end of the -command. Otherwise
+ the idle handler may be activated by some "update" calls.
+
+ _________________________________________________________________
+
+ QUESTION ABOUT PORTING TO SPECIFIC PLATFORMS/SOFTWARE
+
+ [P.1] The configure script gave me strange errors.
+
+ ANSWER: The problem may be you have several operating systems
+ sharing the same file system. Some people encounter error
+ messages like this:
+
+# ./configure --prefix=/usr/vendor/tcl
+loading cache ./config.cache
+checking for a BSD compatible install... /usr/bin/installbsd -c
+checking for ranlib... ranlib
+checking how to run the C preprocessor... cc -E
+checking for unistd.h... ./configure[603]: "${ac_cv_header_$ac_safe+set}": bad
+substitution
+
+ The problem is at line 2, configure loaded in ./config.cache, which
+ may have been created by a different operating system, with
+ settings only usuable for that operating system. To get around
+ this, you should type
+
+make distclean
+./configure
+make all
+
+ [P.2] Does Tix 4.1 work with Tk 4.1
+
+ ANSWER: Yes, just enable the "Tk 4.1 ..." option in the setup
+ program. It will also compile Tix in a dynamic lobrary.
+
+ [P.3] Does Tix work with Incr Tcl 2.0?
+
+ ANSWER: Yes just enable the "Itcl 2.0 ..." option in the setup
+ program. Make sure you have ITcl 2.0 installed. Beta versions
+ will *NOT* work. Also make sure you have installed the source
+ tree of ITcl 2.0 in the same directory where you install the
+ Tix source tree.
+
+ [P.4] How do I get Tix to work with Expect?
+
+ ANSWER: From Paul Schmidt (kuato@netcom.com):
+
+ I have integrated Tcl7.4, Tk4.0, Expect-5.19 and Tix4.0 on Linux
+ 1.2.13 (ELF) and Solaris 2.4. It isn't too hard. For an expectk+Tix
+ binary you need to add a call to Tix_Init in exp_main_tk.c. If you
+ can find the call to Tk_Init then just cut&paste and replace it with
+ Tix_Init. Do the same if you want a Tk+Tix window shell in
+ TkAppInit.c. Worked like a charm. If you have any problems just
+ holler.
+
+ [P.5] Solaris 2.4: Filenames in FileSelectBox are chopped off.
+
+ ANSWER: Problem:
+
+ With Tix4.0a7 (and also with Tix4.0a6) on Solaris 2.4, when running
+ the widget demo, in tixFileSelectBox, in the two scolling lists (for
+ Files an Directories), some of the file and directory names have
+ their first 2 letters chopped off. And some files are repeated.
+
+ Solution: tixwish has some conflicts with /usr/ucblib/libucb.so.1 and
+ you should not linke it tixwish (you don't need it). Here is a
+ solution provided by Charles L Ditzel
+ (charles@hanami.cyberspace.com):
+
+ To fix the problem I was having, all I did was:
+
+ unsetenv LD_LIBRARY_PATH
+ set my PATH to something basic like:
+ /usr/bin:/usr/ccs/bin:/bin:/usr/openwin/bin:/opt/SUNWspro/bin
+ removed config.cache
+ ./configure
+ make clean
+ make
+
+ and now it works!! Must have been something in my old PATH or
+ LD_LIBRARY_PATH that was causing it to pick up
+ /usr/ucblib/libucb.so.
+
+ [P.6] Do I still need libXpm?
+
+ ANSWER: No, now Tix has its own XPM file reader. You no longer
+ need libXpm.
+
+ [P.7] I get a coredump as soon as tixwish starts up.
+
+ ANSWER: Try to get a backtrace of the stack when the core dump
+ happens (with a debugger, for example). If the core dump
+ happens right inside the call to Tk_ConfigureWidget() inside
+ the file tixInit.c, then the problem is because you compiled
+ libtk.a and libtix.a with different versions of the Th header
+ file tk.h. Delete all the .o files from the src directory of
+ Tix, fix the Makefile so that now you can compile libtix.a with
+ the same tk.h that you used to compile libtk.a.
+
+ _________________________________________________________________
+
+ PORTING FROM TIX 3.6 TO TIX 4.X
+
+ [X.1] What happened to the tixInit command?
+
+ ANSWER: You don't need to use it anymore. It is provided in Tix
+ 4.x only for backward compatibility.
+
+ [X.2] How do I set the schemes and fontsets in Tix 4.x?
+
+ ANSWER: You can set the color schemes and fontsets using the
+ standard X resource database (.Xdefaults file). You can add
+ these two lines in the user's .Xdefaults file:
+
+ *TixScheme: Gray
+ *TixFontSet: 14Point
+
+ If you want to switch color schemes and fontsets during run time, you
+ can issue the following commands:
+
+ tix config -scheme Gray -fontset 14Point
+
+ Please read the tix manual page for more details
+
+ [X.3] How do I choose the default TK color schemes and fontsets? Tix
+ is messing up the colors of my existing programs.
+
+ ANSWER: Add these two lines in your .Xdefaults:
+
+ *TixScheme: TK
+ *TixFontSet: TK
+
+ [X.4] I want the old bisque look of Tk 3.6. tk_bisque doesn't work.
+
+ ANSWER: The Tix widgets are not compatible with tk_bisque. If
+ you want a bisque-ish look you can add to your .Xdefaults file
+ the following line:
+
+ *TixScheme: Bisque
+
diff --git a/tix/docs/Files.txt b/tix/docs/Files.txt
new file mode 100644
index 00000000000..e450f6befcc
--- /dev/null
+++ b/tix/docs/Files.txt
@@ -0,0 +1,187 @@
+This document describes the operating system independent file handling
+capability in Tix.
+
+1. The problem:
+
+ (A) Handling user inputs. In various Tix widgets, the user may enter
+ a text string to refer to a file, a directory or a file pattern.
+
+ File:
+ tixFileEntry
+ tixFileSelectBox, the Selection part
+
+ Directory:
+ tixDirBox
+ tixExFileSelectBox, the "Directory" part
+
+ Pattern:
+ tixFileSelectBox, the "Pattern" part
+ tixExFileSelectBox, the "File" part
+
+ (B) Interfacing with application
+
+ These widgets support a -directory option
+
+ tixDirList
+ tixDirTree
+ tixFileSelectBox
+ tixExFileSelectBox
+
+ These widgets support a -pattern option
+ tixFileSelectBox
+ tixExFileSelectBox
+
+ (C) Displaying the file system in a single hierarchy
+
+ tixDirList
+ tixDirTree
+
+2. Issues:
+
+ (A) Unix:
+ Tilde expansion
+
+ (B) Windows:
+ No single file system hierarchy.
+
+ (C) Both:
+ Need to translate relative pathnames, "." and ".."
+
+3. Reusuability:
+
+ Many widgets need to list directory, glob, display hierarchy. We
+ don't want to rewrite the same code again and again.
+
+
+4. API.
+
+ (A) Types of API
+
+ External interface: Takes an input from the user or from the
+ application and translate it to a canonical form.
+
+ Internal interface: operate on filenames that are in canonical
+ forms. There are run-time checking whether the filenames arein
+ canonical forms.
+
+ We have the two types of interfaces so that we don't need to
+ perform needless translations from "user form" to "canonical
+ form".
+
+
+ (B) API Consistency
+
+ External API always takes a filename in the native format and
+ return file names in the native format.
+
+
+ (C) Errors
+
+ User errors are reported in an error dialog. Application errors
+ triggers a TCL error return code.
+
+ There should be in-line comments stating whether an input is from
+ user or application.
+
+5. VPATH: virtual hierarchical path
+
+ Unix:
+
+ In Unix, a VPATH is the same as a file pathname.
+
+ Windows:
+
+ In Windows 3.1, a VPATH is "xx\" followed by a normalized DOS
+ file pathname. "xx" by itself is "My computer" and refers to the
+ root directory of the C: drive.
+
+ In Windows 95, a VPATH is "xx\xx\" followed by a normalized DOS
+ file pathname. "xx" by itself is "Desktop" and refers to
+ "C:\Windows\Desktop". "xx\xx" by itself is "My computer" and
+ refers to the root directory of the C: drive.
+
+ Normalization do not go into the virtual prefix. E.g.: the VPATH for
+ "C:\Windows\..\..\" is "xx\xx\C:", not "xx\xx".
+
+
+6. Normalization:
+
+ tixFSNorm context text defFile flagsVar errorMsgVar
+
+ This is the main function that translate a user input to
+ normalized (canonical) form.
+
+ Parameters:
+ context:VPATH
+ The "current directory" under which the translation
+ occurs. It is used only if text refers to a relative
+ pathname.
+
+ if context is the empty string, then text must refer to an
+ absolute path.
+
+ text:string
+ The (user/application) input that needs to be
+ normalized. The exact mode of translation depends on the
+ flags
+
+ defFile:string
+ If the input is a directory, append this to the directory.
+
+ flagsVar: ref to array
+ flag(noPattern): we don't want patterns. Treat all wild
+ card characters as normal file names
+
+ Return value:
+ No error occurs: errorMsg is not set and a list of three
+ elements is returned:
+
+ index 0: the normalized path of the input
+ index 1: the VPATH of the directory.
+ index 2: file(s) in the directory.
+ index 3: pattern(s) in the directory.
+
+ Either index 1 or 2, or both, are empty strings. They cannot
+ be both non-empty.
+
+ A Normalized path:
+
+ 1) is absolute
+ 2) has no double slashes
+ 3) has no trailing slashes
+ 4) has no relative pathnames
+ 5) has no tildes
+
+
+ tixFSNormDir directory
+
+ This is mainly used to check the validity of -directory option
+ of the widgets.
+
+ Parameter:
+ directory:
+ Must be an existing absolute path.
+
+ Return value:
+ Returns normalized path. Error given when directory is not an
+ existing absolute path
+
+
+7. VPATH translation:
+
+ tixFSVPath pathname: returns the VPATH of pathname
+ tixFSPath VPATH: returns the pathname of VPATH
+
+
+8. Valid file names:
+
+ Should prompt to user about invalid filenames (E.g. In Windows,
+ names cannot contain "*")
+
+9. Creation prompt:
+
+ If user enters a file or directory that doesn't exist, promt to ask
+ whether he wants to create it.
+
+
+10.
diff --git a/tix/docs/Install.html b/tix/docs/Install.html
new file mode 100644
index 00000000000..4f5285b3bc7
--- /dev/null
+++ b/tix/docs/Install.html
@@ -0,0 +1,28 @@
+<TITLE>Tix Installation Guide</TITLE>
+<Center><H1>Tix Installation Guide</H1></Center>
+
+ This version of Tix supports both Unix and Windows platforms. We
+ provide binary distribution for Windows and popular Unix platforms
+ (SunOS 4.x, Solaris 2.x and Linux) for hassle-free
+ installation. <p>
+
+ If you use other platforms, you have to download the Tix source and
+ build it yourself. The following documents guide you through the
+ process of building Tix step by step. There are automatic
+ configuration tools to aid you in building Tix. If you have built
+ Tcl/Tk or Tcl extensions before, building Tix should be straight
+ forward. <p>
+
+<ul>
+ <li> <a href="BinInst.html"> Installing Tix from the binary distribution</a>.
+ <li> <a href="UnixInst.html"> Building Tix for Unix platforms</a>.
+ <li> <a href="WinInst.html"> Building Tix for Windows platforms</a>.
+</ul>
+
+<hr>
+<i><p>
+<a href="../README.html">Back to the Tix Documentation Master Index</a>
+</i>
+<!Serial 851729139>
+<hr><i>Last modified Wed Feb 12 15:12:59 EST 1997 </i> ---
+<i>Serial 856069649</i>
diff --git a/tix/docs/Install.txt b/tix/docs/Install.txt
new file mode 100644
index 00000000000..c3787f0b126
--- /dev/null
+++ b/tix/docs/Install.txt
@@ -0,0 +1,25 @@
+
+ TIX INSTALLATION GUIDE
+
+ This version of Tix supports both Unix and Windows platforms. We
+ provide binary distribution for Windows and popular Unix platforms
+ (SunOS 4.x, Solaris 2.x and Linux) for hassle-free installation.
+
+ If you use other platforms, you have to download the Tix source and
+ build it yourself. The following documents guide you through the
+ process of building Tix step by step. There are automatic
+ configuration tools to aid you in building Tix. If you have built
+ Tcl/Tk or Tcl extensions before, building Tix should be straight
+ forward.
+
+ * Installing Tix from the binary distribution.
+ * Building Tix for Unix platforms.
+ * Building Tix for Windows platforms.
+
+ _________________________________________________________________
+
+ Back to the Tix Documentation Master Index
+ _________________________________________________________________
+
+ Last modified Wed Feb 12 15:12:59 EST 1997 --- Serial 856069649
+
diff --git a/tix/docs/Pkg.txt b/tix/docs/Pkg.txt
new file mode 100644
index 00000000000..a6972021ba0
--- /dev/null
+++ b/tix/docs/Pkg.txt
@@ -0,0 +1,127 @@
+ -------------------
+ Dynamic Loading Tix
+ -------------------
+
+ In this text, the phrase "a version of Tcl" stands for a version of
+ Tcl from the standard Sun distribution or the ITcl distribution.
+
+BINARY VERSION
+==============
+
+ Tix can be built to work with different versions of Tcl. A Tix
+ dynamic library built for a particular version of Tcl works only
+ with that version. To make it possible to install Tix binaries
+ that support multiple versions of Tcl, and prevent the loading of
+ Tix binaries into incompatible versions of Tcl, Tix uses a special
+ "binary versioning" system:
+
+
+ BINARY VERSION FOR STANDARD TCL DISTRIBUTION
+
+ If you use Tix version a.b and build a Tix binary file for Tcl
+ version x.y, the "binary version" of this Tix binary file will
+ be a.b.x.y. For example, if you build the Tix 4.1 shared
+ library for Tcl 7.6, the binary version is 4.1.7.6.
+
+ BINARY VERSION FOR ITCL DISTRIBUTION
+
+ If you use Tix version a.b and build a Tix binary file for an
+ ITcl distribution which contains Tcl version x.y., the "binary
+ version" of this Tix binary file will be a.b.x.y.1. For
+ example, if you build the Tix 4.1 shared library for Itcl 2.2
+ (which contains Tcl 7.6), the binary version is 4.1.7.6.1.
+
+ In short, the extra ".1" version number indicates whether a Tix
+ binary is compile for standard Tcl or Itcl.
+
+ Naming of shared libraries
+ ==========================
+
+ A Tix shared library compiled for a standard Tcl distribution
+ is named libtix${BIN_VERSION}${SHLIB_SUFFIX}. For example,
+ with Tix version 4.1 and Tcl version 7.6:
+
+ libtix4.1.7.6.so
+
+ With Tix version 4.1 and ITcl version 2.1 (which includes Tcl
+ version 7.5):
+
+ libtix4.1.7.5.1.so
+
+ Naming of executable files
+ ==========================
+
+ The Tix executable (which contains Tcl, Tk and Tix) is called
+ "tixwish${BIN_VERSION}". For example, the executables for the shared
+ libraries mentioned above are
+
+ tixwish4.1.7.6
+ tixwish4.1.7.5.1
+
+GENERATING A TIX BINARY VERSION
+===============================
+
+ The following Tcl procedure can be used to generate a Tix binary
+ version for a particular version combination of Tix and Tcl:
+
+ proc tixBinVer {tixVer} {
+ global tcl_version
+
+ if {[string compare [info command @scope] ""]} {
+ # We are running inside Itcl
+ return $tixVer.$tcl_version.1
+ } else {
+ return $tixVer.$tcl_version
+ }
+ }
+
+LOADING TIX WITH THE "load" COMMAND
+===================================
+
+ To dynamic load Tix with the "load" command, you can use the
+ tixBinVer procedure to generate a Tix binary version number. If
+ the Tix 4.1 shared library is located in the directory $dir, it
+ can be loaded by
+
+ load [file join $dir libtix[tixBinVer 4.1][info sharedlibextension]] Tix
+
+ The above command may not work on platforms that do not support
+ the "." character inside shared library names. For example, on
+ SunOS, the command must be modified as:
+
+ set ver [tixBinVer 4.1]
+ regsub -all {[.]} $ver "" ver
+ load [file join $dir libtix$ver[info sharedlibextension].1] Tix
+
+ To avoid the need of platform specific code and having to hard
+ code the location of the shared into your scripts, it's
+ recommended you use instead the "package require" command to load
+ a Tix dynamic library, as outlined below.
+
+LOADING TIX WITH THE "package require" COMMAND
+==============================================
+
+ If you have properly installed Tix in your system, you can
+ dynamically load Tix with the following command:
+
+ package require -exact Tix [tixBinVer 4.1]
+
+ Note that the "-exact" switch must be used so that only a
+ Tix shared library compatible with the given version of Tcl is
+ loaded. (If you omit the -exact switch, "package require" may load
+ in Tix 4.1.7.6 even the correct version should be 4.1.7.5.1.)
+
+LOADING TIX SAM WITH THE "package require" COMMAND
+==================================================
+
+ The Tix StandAlone Module (SAM), when properly installed, can also
+ be loaded using the "package require" command:
+
+ package require -exact Tixsam [tixBinVer 4.1]
+
+ Note: when you load it the "Tixsam" package, the Tix package will
+ be loaded automatically. You need not, and must not, "package
+ require" the Tix package at the same time.
+
+ Read the file docs/SAModules.txt for more details on StandAlone
+ Modules.
diff --git a/tix/docs/Plugin.txt b/tix/docs/Plugin.txt
new file mode 100644
index 00000000000..b23826bd0b5
--- /dev/null
+++ b/tix/docs/Plugin.txt
@@ -0,0 +1,17 @@
+Building Tix plugin for Tcl plugin 1.1 on Unix.
+
+mkdir tcl7.7
+taz ~/wdev/linux/tcl7.7> mkdir generic
+taz ~/wdev/linux/tcl7.7> mkdir unix
+taz ~/wdev/linux/tcl7.7> cp ../tcl7.6/generic/*.h generic/
+taz ~/wdev/linux/tcl7.7> cp ../tcl7.6/unix/*.h unix/
+taz ~/wdev/linux/tcl7.7> cp ../tcl7.6/unix/*.sh unix/
+taz ~/wdev/linux/tcl7.7> emacs unix/*.sh &
+[3] 694
+taz ~/wdev/linux/tcl7.7> cd ..
+taz ~/wdev/linux> mkdir tk4.2
+mkdir: cannot make directory `tk4.2': File exists
+taz ~/wdev/linux> mkdir tk4.3
+taz ~/wdev/linux> cd tk4.3
+taz ~/wdev/linux/tk4.3> mkdir generic
+taz ~/wdev/linux/tk4.3> mkdir unix
diff --git a/tix/docs/Porting.html b/tix/docs/Porting.html
new file mode 100644
index 00000000000..5371c7f2f0c
--- /dev/null
+++ b/tix/docs/Porting.html
@@ -0,0 +1,46 @@
+<i> The following notes are contributed from Tix users on various
+platforms. I have no access to these platforms and cannot verify that
+their settings are correct. Also, the settings may only work with a
+specific versions of Tix on a specific version of the O/S.
+</i>
+
+<pre>
+<b>From:</b> Andrew Fitzhugh (fitz@hplaef.hpl.hp.com) about
+<b>Version:</b> Tix 4.0a5
+<b>Platform:</b> HPUX 9.05
+
+1. Throw ANSI flag on the compiler (I set PROTO_FLAGS = -Ae)
+2. Change the X11 directories to -I/usr/include/X11R5 and -L/usr/lib/X11R5
+3. This might affect other systems: the Makefile included -lX11 before
+ -ltk and -ltcl, so I switched the order. (Obviously a bug, since
+ there is a comment right above it that told me what to do :-).
+</pre>
+
+<pre>
+<b>From:</b> mohan kannapareddy <mokannap@grail.cba.csuohio.edu>
+<b>Version:</b> Tix 4.0a7
+<b>Platform:</b> Solaris2.4
+
+
+> With Tix4.0a7 (and also with Tix4.0a6) on Solaris 2.4, when running
+> the widget demo, in tixFileSelectBox, in the two scolling lists (for
+> Files and Directories), some of the file and directory names have
+> their first 2 letters chopped off. And some files are repeated.
+> Anyone else seeing this?
+
+ The above is a very common problem with Solaris2.4, I am pretty
+ sure when you are creating your _tixwish_, its picking up the UCB
+ library, that is you must be having /usr/ucblib/ or whatever in
+ your LD_LIBRARY_PATH or LD_RUN_PATH, REMOVE it OR make sure that
+ the standard libraries or before the ucblibs.. Now, its strange
+ that it shows up, because I don't think the tix fileselect box has
+ been implemented in "C", so it should not have shown up??
+
+ You might have to recompile your tcl/tk libraries with the
+ offending libraries out of the way..because I use a Solaris2.4
+ machine and I have no problem at all!!.. Cheers, Mohan
+</pre>
+
+<!Serial 851729140>
+<hr><i>Last modified Fri Jan 17 22:52:54 EST 1997 </i> ---
+<i>Serial 853731293</i>
diff --git a/tix/docs/Release-4.1.0.html b/tix/docs/Release-4.1.0.html
new file mode 100644
index 00000000000..f2c4b10ac16
--- /dev/null
+++ b/tix/docs/Release-4.1.0.html
@@ -0,0 +1,24 @@
+<h3>Tix 4.1.0 Final release</h3>
+<i> Released on Feb 15, 1997</i> <p>
+
+<h3> What's New </h3>
+
+<ul>
+
+ <li> Works with all major releases of Tcl (7.4 throught 8.0) and
+ Itcl (2.0, 2.1 and 2.2). <p>
+
+ <li> Easy configuration. See docs/UnixInst.html and docs/WinInst.html. <p>
+
+ <li> Works on both Windows and Unix platforms. <p>
+
+ <li> Stand-alone module support (SAM): compile scripts into shared
+ libraries for easy redistribution. SAM also supports ET (See
+ docs/SAModule.txt). <p>
+
+ <li> Supports the "package require" command (see docs/Pkg.txt). <p>
+
+</ul>
+
+<hr><i>Last modified Sun Feb 16 00:05:06 EST 1997 </i> ---
+<i>Serial 856069650</i>
diff --git a/tix/docs/Release-4.1.0.txt b/tix/docs/Release-4.1.0.txt
new file mode 100644
index 00000000000..4ddd84e33e8
--- /dev/null
+++ b/tix/docs/Release-4.1.0.txt
@@ -0,0 +1,23 @@
+
+ TIX 4.1.0 FINAL RELEASE
+
+ Released on Feb 15, 1997
+
+ WHAT'S NEW
+ * Works with all major releases of Tcl (7.4 throught 8.0) and Itcl
+ (2.0, 2.1 and 2.2).
+
+ * Easy configuration. See docs/UnixInst.html and docs/WinInst.html.
+
+ * Works on both Windows and Unix platforms.
+
+ * Stand-alone module support (SAM): compile scripts into shared
+ libraries for easy redistribution. SAM also supports ET (See
+ docs/SAModule.txt).
+
+ * Supports the "package require" command (see docs/Pkg.txt).
+
+ _________________________________________________________________
+
+ Last modified Sun Feb 16 00:05:06 EST 1997 --- Serial 856069650
+
diff --git a/tix/docs/Release-4.1a2.html b/tix/docs/Release-4.1a2.html
new file mode 100644
index 00000000000..31e0005a302
--- /dev/null
+++ b/tix/docs/Release-4.1a2.html
@@ -0,0 +1,40 @@
+<h3>Tix 4.1a2</h3>
+<i> Released on April 23, 1996</i> <p>
+
+<pre>
+
+Subject: [Announce] Tix version 4.1a2 is available
+
+</pre>
+
+ I am pleased to announce the availability of Tix version 4.1a2, the
+ second alpha release. This version of Tix supports the Microsoft
+ Windows platforms.
+
+<h3>Requirement</h3>
+
+<h4>Unix Platforms</h4>
+
+ Tix 4.1a2 works with the following combinations of Tcl/Tk/ITcl/ET:
+ <ul>
+ <li> Tcl 7.4 + Tk 4.0
+ <li> Tcl 7.4 + Tk 4.0 + ITcl 2.0
+ <li> Tcl 7.4 + Tk 4.0 + ET 1.5
+ <li> Tcl 7.5 + Tk 4.1 (final release only)
+ </ul>
+
+<h4>Windows Platforms</h4>
+
+ Tix 4.1a2 requires the final release of Tcl 7.5 and Tk 4.1 (no
+ alpha or beta versions).
+
+<h3>Getting The Tix Package</h3>
+
+ You can obtain Tix from the following ftp site:
+
+<pre> ftp://ftp.xpi.com/pub/Tix4.1a2.tar.gz </pre>
+
+
+<!Serial 851729140>
+<hr><i>Last modified Fri Jan 17 22:52:55 EST 1997 </i> ---
+<i>Serial 853731292</i>
diff --git a/tix/docs/Release-4.1a2.txt b/tix/docs/Release-4.1a2.txt
new file mode 100644
index 00000000000..2aa348b6a70
--- /dev/null
+++ b/tix/docs/Release-4.1a2.txt
@@ -0,0 +1,35 @@
+
+ TIX 4.1A2
+
+ Released on April 23, 1996
+
+Subject: [Announce] Tix version 4.1a2 is available
+
+ I am pleased to announce the availability of Tix version 4.1a2, the
+ second alpha release. This version of Tix supports the Microsoft
+ Windows platforms.
+
+ REQUIREMENT
+
+ Unix Platforms
+
+ Tix 4.1a2 works with the following combinations of Tcl/Tk/ITcl/ET:
+ * Tcl 7.4 + Tk 4.0
+ * Tcl 7.4 + Tk 4.0 + ITcl 2.0
+ * Tcl 7.4 + Tk 4.0 + ET 1.5
+ * Tcl 7.5 + Tk 4.1 (final release only)
+
+ Windows Platforms
+
+ Tix 4.1a2 requires the final release of Tcl 7.5 and Tk 4.1 (no alpha
+ or beta versions).
+
+ GETTING THE TIX PACKAGE
+
+ You can obtain Tix from the following ftp site:
+ ftp://ftp.xpi.com/pub/Tix4.1a2.tar.gz
+
+ _________________________________________________________________
+
+ Last modified Fri Jan 17 22:52:55 EST 1997 --- Serial 853731292
+
diff --git a/tix/docs/Release-4.1a3.html b/tix/docs/Release-4.1a3.html
new file mode 100644
index 00000000000..8f58d08560a
--- /dev/null
+++ b/tix/docs/Release-4.1a3.html
@@ -0,0 +1,104 @@
+<h3>Tix 4.1a3</h3>
+<i> Released on April 23, 1996</i> <p>
+
+<pre>
+
+Subject: [Announce] Tix version 4.1a3 is available
+
+</pre>
+
+ I am pleased to announce the availability of Tix version 4.1a3, the
+ third alpha release. This version of Tix supports the Unix and
+ Microsoft Windows platforms. <p>
+
+ Tix 4.1 is the commercial version of Tix 4.0. It contains more
+ widgets and works under MS Windows. Please read the file
+ license.terms first inside the distribution tar file or from the
+ WWW at <a href="http://www.xpi.com/tix/license.terms.41a3.txt">
+ http://www.xpi.com/tix/license.terms.41a3.txt </a> <p>
+
+<h3>Requirement</h3>
+
+<h4>Unix Platforms</h4>
+
+ Tix 4.1a3 works with the following combinations of Tcl/Tk/ITcl/ET:
+ <ul>
+ <li> Tcl 7.4 + Tk 4.0
+ <li> Tcl 7.4 + Tk 4.0 + ITcl 2.0
+ <li> Tcl 7.4 + Tk 4.0 + ET 1.5
+ <li> Tcl 7.5 + Tk 4.1 (final release only)
+ </ul>
+
+<h4>Windows Platforms</h4>
+
+ Tix 4.1a3 requires the final release of Tcl 7.5 and Tk 4.1 (no
+ alpha or beta versions). Many things currently does not work under
+ Windows, including:
+ <ul>
+ <li> FileSelectDialog (ExFileSelectDialog does work, though)
+ <li> The top-left corner of the Grid (aka spreadsheet) widget
+ <li> XPM images
+ </ul>
+
+<h3>Getting The Tix Package</h3>
+
+ Tix 4.1a3 is available at
+ <ul>
+ <li> <a href="ftp://ftp.xpi.com/pub/Tix4.1a3.tar.gz">
+ ftp://ftp.xpi.com/pub/Tix4.1a3.tar.gz</a>: Unix source tar file.
+
+ <li> <a href="ftp://ftp.xpi.com/pub/windows/tix41a3.zip">
+ ftp://ftp.xpi.com/pub/windows/tix41a3.zip</a>: Same as
+ Tix4.1a3.tar.gz, but in Windows/DOS ZIP format.
+
+ <li> <a href="ftp://ftp.xpi.com/pub/windows/tix41bin.zip">
+ ftp://ftp.xpi.com/pub/windows/tix41bin.zip</a>: Windows binaries.
+ </ul>
+
+
+
+<h3>What's New Since Tix 4.1a2 (the last release)</h3>
+
+<h4>5/5/96</h4>
+
+ <b>New feature:</b> New tool unix-et-tk4.0/makescript.tcl. It
+ includes the Tix script library into a ET application in the correct
+ order. If A.tcl depends on B.tcl, then B.tcl is loaded first.<p>
+
+<h4>5/6/96</h4>
+
+ <b>New feature:</b> Now the -default option of the Tix mega widget
+ classes are inherited from their superclasses.<p>
+
+ <b>New feature:</b> New option -expand for the panes in PanedWindow<p>
+
+ <b>Bug Fixed:</b> ScrolledHList didn't calculate the size of the
+ hlist subwidget correctly, resulting in scrollbars not appearing
+ even if the hlist widget is not big enough to display all of its
+ contents.<p>
+
+<h4>5/8/96</h4>
+
+ <b>New feature:</b> New method setsize for PanedWindow.<p>
+
+<h4>5/10/96</h4>
+
+ <b>New feature:</b> New widget tixMeter, can be used to display the
+ progress of work.<p>
+
+ <b>Bug Fixed:</b> HList multiple and extended selectMode now work
+ with TixTree.<p>
+
+<h4>5/11/96</h4>
+
+ <b>Bug Fixed:</b> HList "see" method sometimes doesn't display the
+ specified element correctly.<p>
+
+ <b>New widgets:</b> New widgets CheckList, Grid, ScrolledGrid, TList
+ and ScrolledTList added to the Tix 4.1 distribution.<p>
+
+ <b>New feature:</b> New option -postcmd for PopupMenu widget.<p>
+
+<!Serial 851729140>
+<hr><i>Last modified Fri Jan 17 22:52:55 EST 1997 </i> ---
+<i>Serial 853731293</i>
diff --git a/tix/docs/Release-4.1a3.txt b/tix/docs/Release-4.1a3.txt
new file mode 100644
index 00000000000..7f72979d227
--- /dev/null
+++ b/tix/docs/Release-4.1a3.txt
@@ -0,0 +1,88 @@
+
+ TIX 4.1A3
+
+ Released on April 23, 1996
+
+Subject: [Announce] Tix version 4.1a3 is available
+
+ I am pleased to announce the availability of Tix version 4.1a3, the
+ third alpha release. This version of Tix supports the Unix and
+ Microsoft Windows platforms.
+
+ Tix 4.1 is the commercial version of Tix 4.0. It contains more widgets
+ and works under MS Windows. Please read the file license.terms first
+ inside the distribution tar file or from the WWW at
+ http://www.xpi.com/tix/license.terms.41a3.txt
+
+ REQUIREMENT
+
+ Unix Platforms
+
+ Tix 4.1a3 works with the following combinations of Tcl/Tk/ITcl/ET:
+ * Tcl 7.4 + Tk 4.0
+ * Tcl 7.4 + Tk 4.0 + ITcl 2.0
+ * Tcl 7.4 + Tk 4.0 + ET 1.5
+ * Tcl 7.5 + Tk 4.1 (final release only)
+
+ Windows Platforms
+
+ Tix 4.1a3 requires the final release of Tcl 7.5 and Tk 4.1 (no alpha
+ or beta versions). Many things currently does not work under Windows,
+ including:
+ * FileSelectDialog (ExFileSelectDialog does work, though)
+ * The top-left corner of the Grid (aka spreadsheet) widget
+ * XPM images
+
+ GETTING THE TIX PACKAGE
+
+ Tix 4.1a3 is available at
+ * ftp://ftp.xpi.com/pub/Tix4.1a3.tar.gz: Unix source tar file.
+ * ftp://ftp.xpi.com/pub/windows/tix41a3.zip: Same as
+ Tix4.1a3.tar.gz, but in Windows/DOS ZIP format.
+ * ftp://ftp.xpi.com/pub/windows/tix41bin.zip: Windows binaries.
+
+ WHAT'S NEW SINCE TIX 4.1A2 (THE LAST RELEASE)
+
+ 5/5/96
+
+ New feature: New tool unix-et-tk4.0/makescript.tcl. It includes the
+ Tix script library into a ET application in the correct order. If
+ A.tcl depends on B.tcl, then B.tcl is loaded first.
+
+ 5/6/96
+
+ New feature: Now the -default option of the Tix mega widget classes
+ are inherited from their superclasses.
+
+ New feature: New option -expand for the panes in PanedWindow
+
+ Bug Fixed: ScrolledHList didn't calculate the size of the hlist
+ subwidget correctly, resulting in scrollbars not appearing even if the
+ hlist widget is not big enough to display all of its contents.
+
+ 5/8/96
+
+ New feature: New method setsize for PanedWindow.
+
+ 5/10/96
+
+ New feature: New widget tixMeter, can be used to display the progress
+ of work.
+
+ Bug Fixed: HList multiple and extended selectMode now work with
+ TixTree.
+
+ 5/11/96
+
+ Bug Fixed: HList "see" method sometimes doesn't display the specified
+ element correctly.
+
+ New widgets: New widgets CheckList, Grid, ScrolledGrid, TList and
+ ScrolledTList added to the Tix 4.1 distribution.
+
+ New feature: New option -postcmd for PopupMenu widget.
+
+ _________________________________________________________________
+
+ Last modified Fri Jan 17 22:52:55 EST 1997 --- Serial 853731293
+
diff --git a/tix/docs/Release-4.1b1.html b/tix/docs/Release-4.1b1.html
new file mode 100644
index 00000000000..f4c3d96c1fa
--- /dev/null
+++ b/tix/docs/Release-4.1b1.html
@@ -0,0 +1,152 @@
+<h3>Tix 4.1b1</h3>
+<i> Released on September 30, 1996</i> <p>
+
+<pre>
+
+Subject: [Announce] Tix version 4.1b1 is available
+
+</pre>
+
+ I am pleased to announce the availability of Tix version 4.1b1, the
+ first beta release. This version of Tix supports the Unix and
+ Microsoft Windows platforms. <p>
+
+ This version of Tix is released under licensing terms similar to
+ those of Tcl/Tk. Please read the file license.terms carefully
+ before proceeding. <p>
+
+<h3>Requirement</h3>
+
+<h4>Unix Platforms</h4>
+
+ Tix 4.1b1 works with the following combinations of Tcl/Tk/ITcl/ET:
+ <ul>
+ <li> Tcl 7.4 + Tk 4.0
+ <li> Tcl 7.4 + Tk 4.0 + ITcl 2.0
+ <li> Tcl 7.4 + Tk 4.0 + ET 1.5
+ <li> Tcl 7.5 + Tk 4.1 (final release only)
+ <li> Tcl 7.5 + Tk 4.1 + ITcl 2.1
+ <li> Tcl 7.5 + Tk 4.1 + ET 1.6
+ </ul>
+
+<h4>Windows Platforms</h4>
+
+ Tix 4.1b1 requires the final release of Tcl 7.5 and Tk 4.1 (no
+ alpha or beta versions). Many things currently does not work under
+ Windows, including:
+ <ul>
+ <li> FileSelectDialog (ExFileSelectDialog does work, though)
+ <li> XPM images
+ </ul>
+
+<h3>Getting The Tix Package</h3>
+
+ Tix 4.1b1 sources are available at
+ <ul>
+ <li> <a href="ftp://ftp.xpi.com/pub/Tix4.1b1.tar.gz">
+ ftp://ftp.xpi.com/pub/Tix4.1b1.tar.gz</a>: Unix source tar file.
+
+ <li> <a href="ftp://ftp.xpi.com/pub/windows/tix41b1.zip">
+ ftp://ftp.xpi.com/pub/windows/tix41b1.zip</a>: Same as
+ Tix4.1b1.tar.gz, but in Windows/DOS ZIP format.
+ </ul>
+
+
+ We'll also release binary distributions of Tix. They will be
+ available in a few days for all Windows 32 bit platforms (Win32s,
+ Win95, WinNT 3.5 and 4.0) as well as the following Unix platforms:
+ Solaris 2.5, SunOs 4.1, HPUX 9.x, IRIX 5.x and Linux. <p>
+
+<h3>What's New Since Tix 4.1a3 (the last release)</h3>
+
+<h4>7/14/96</h4>
+
+ <b>New feature:</b> Supports ET+TK4.1. --enable-tk41_et flag for
+ configure script.<p>
+
+ <b>New feature:</b> Supports ITCL 2.1. --enable-itcl21 flag for
+ configure script.<p>
+
+ <b>New feature:</b> Default color schemes and fontset can be set
+ when Tix is compiled: --with-fontset= and --with-scheme= flags for
+ configure script.<p>
+
+ <b>Incompatibility:</b> All the "::" qualifiers in Tix class methods
+ have been replaced by ":", so that the Tix classes can be loaded
+ into Itcl without patching Itcl. If you have written your own Tix
+ classes, you need to modify the source files to use the ":"
+ qualifier instead. <p>
+
+ The program tools/setcolon.sh helps you port your code from the "::"
+ convention to the ":" convention. Execute the program without
+ argument for usage syntax. It may modify your code in unexpected
+ ways. Use with caution. <p>
+
+<h4>7/15/96</h4>
+
+ <b>New feature:</b> New function Tix_SetRcFileName() and new macros
+ TCL_7_5_OR_LATER, TK_4_1_OR_LATER to provide better support for both
+ Tcl7.4/Tk4.0 and Tcl7.5+/Tk4.1+. <p>
+
+ <b>Bug Fixed:</b> <code>entrycget</code> method of OptionMenu didn't
+ work as expected. <p>
+
+<h4>7/17/96</h4>
+
+ The demos-c subdirectory has been moved to demos/c-code. <p>
+
+<h4>7/24/96</h4>
+
+ <b>Bug Fixed:</b> tixMwm now deletes information about a toplevel
+ when the toplevel is destroyed.<p>
+
+<h4>8/22/96</h4>
+
+ <b>New feature:</b> New command "tixConsoleInit" available with Tcl
+ 7.5/Tk 4.1. Create console window that runs in a separate
+ interpreter. <p>
+
+ <b>New feature:</b> Now Tix works under multiple interpreters. <p>
+
+<h4>8/23/96</h4>
+
+ <b>New feature:</b> Now ListNoteBook uses a PanedWindow to manage
+ the HList and the pages.<p>
+
+ <b>New feature:</b> New option -dynamicgeometry for PanedWindow.<p>
+
+<h4>8/24/96</h4>
+
+ <b>New feature:</b> New command "tixStrEq" compares the equality of
+ two strings.<p>
+
+<h4>9/12/96</h4>
+
+ <b>New feature:</b> Tix provides emulation for strcasecmp() for
+ platforms that do not support this function.<p>
+
+<h4>9/14/96</h4>
+
+ <b>New feature:</b> New widget command <code>selection get</code>
+ for HList. This is just an alias for <code>info
+ selection</code>. It's added so that the API is similar to the TK
+ API.<p>
+
+ <b>New feature:</b> New widget command <code>info bbox</code>
+ for HList. Used mainly in regression tests. <p>
+
+<h4>9/17/96</h4>
+
+ <b>New feature:</b> Orientation of the <b>pane</b> subwidget in
+ <b>TixListNoteBook</b> now configureable via the <b>-options</b>
+ switch during creation. <p>
+
+<h4>9/22/96</h4>
+
+ <b>New feature:</b> Now the default fontset and color scheme are
+ configurable in the setup.tcl program as well as in the configure
+ script. <p>
+
+<!Serial 851729141>
+<hr><i>Last modified Fri Jan 17 22:52:57 EST 1997 </i> ---
+<i>Serial 853731293</i>
diff --git a/tix/docs/Release-4.1b1.txt b/tix/docs/Release-4.1b1.txt
new file mode 100644
index 00000000000..b07fbe8cbde
--- /dev/null
+++ b/tix/docs/Release-4.1b1.txt
@@ -0,0 +1,136 @@
+
+ TIX 4.1B1
+
+ Released on September 30, 1996
+
+Subject: [Announce] Tix version 4.1b1 is available
+
+ I am pleased to announce the availability of Tix version 4.1b1, the
+ first beta release. This version of Tix supports the Unix and
+ Microsoft Windows platforms.
+
+ This version of Tix is released under licensing terms similar to those
+ of Tcl/Tk. Please read the file license.terms carefully before
+ proceeding.
+
+ REQUIREMENT
+
+ Unix Platforms
+
+ Tix 4.1b1 works with the following combinations of Tcl/Tk/ITcl/ET:
+ * Tcl 7.4 + Tk 4.0
+ * Tcl 7.4 + Tk 4.0 + ITcl 2.0
+ * Tcl 7.4 + Tk 4.0 + ET 1.5
+ * Tcl 7.5 + Tk 4.1 (final release only)
+ * Tcl 7.5 + Tk 4.1 + ITcl 2.1
+ * Tcl 7.5 + Tk 4.1 + ET 1.6
+
+ Windows Platforms
+
+ Tix 4.1b1 requires the final release of Tcl 7.5 and Tk 4.1 (no alpha
+ or beta versions). Many things currently does not work under Windows,
+ including:
+ * FileSelectDialog (ExFileSelectDialog does work, though)
+ * XPM images
+
+ GETTING THE TIX PACKAGE
+
+ Tix 4.1b1 sources are available at
+ * ftp://ftp.xpi.com/pub/Tix4.1b1.tar.gz: Unix source tar file.
+ * ftp://ftp.xpi.com/pub/windows/tix41b1.zip: Same as
+ Tix4.1b1.tar.gz, but in Windows/DOS ZIP format.
+
+ We'll also release binary distributions of Tix. They will be available
+ in a few days for all Windows 32 bit platforms (Win32s, Win95, WinNT
+ 3.5 and 4.0) as well as the following Unix platforms: Solaris 2.5,
+ SunOs 4.1, HPUX 9.x, IRIX 5.x and Linux.
+
+ WHAT'S NEW SINCE TIX 4.1A3 (THE LAST RELEASE)
+
+ 7/14/96
+
+ New feature: Supports ET+TK4.1. --enable-tk41_et flag for configure
+ script.
+
+ New feature: Supports ITCL 2.1. --enable-itcl21 flag for configure
+ script.
+
+ New feature: Default color schemes and fontset can be set when Tix is
+ compiled: --with-fontset= and --with-scheme= flags for configure
+ script.
+
+ Incompatibility: All the "::" qualifiers in Tix class methods have
+ been replaced by ":", so that the Tix classes can be loaded into Itcl
+ without patching Itcl. If you have written your own Tix classes, you
+ need to modify the source files to use the ":" qualifier instead.
+
+ The program tools/setcolon.sh helps you port your code from the "::"
+ convention to the ":" convention. Execute the program without argument
+ for usage syntax. It may modify your code in unexpected ways. Use with
+ caution.
+
+ 7/15/96
+
+ New feature: New function Tix_SetRcFileName() and new macros
+ TCL_7_5_OR_LATER, TK_4_1_OR_LATER to provide better support for both
+ Tcl7.4/Tk4.0 and Tcl7.5+/Tk4.1+.
+
+ Bug Fixed: entrycget method of OptionMenu didn't work as expected.
+
+ 7/17/96
+
+ The demos-c subdirectory has been moved to demos/c-code.
+
+ 7/24/96
+
+ Bug Fixed: tixMwm now deletes information about a toplevel when the
+ toplevel is destroyed.
+
+ 8/22/96
+
+ New feature: New command "tixConsoleInit" available with Tcl 7.5/Tk
+ 4.1. Create console window that runs in a separate interpreter.
+
+ New feature: Now Tix works under multiple interpreters.
+
+ 8/23/96
+
+ New feature: Now ListNoteBook uses a PanedWindow to manage the HList
+ and the pages.
+
+ New feature: New option -dynamicgeometry for PanedWindow.
+
+ 8/24/96
+
+ New feature: New command "tixStrEq" compares the equality of two
+ strings.
+
+ 9/12/96
+
+ New feature: Tix provides emulation for strcasecmp() for platforms
+ that do not support this function.
+
+ 9/14/96
+
+ New feature: New widget command selection get for HList. This is just
+ an alias for info selection. It's added so that the API is similar to
+ the TK API.
+
+ New feature: New widget command info bbox for HList. Used mainly in
+ regression tests.
+
+ 9/17/96
+
+ New feature: Orientation of the pane subwidget in TixListNoteBook now
+ configureable via the -options switch during creation.
+
+ 9/22/96
+
+ New feature: Now the default fontset and color scheme are
+ configurable in the setup.tcl program as well as in the configure
+ script.
+
+ _________________________________________________________________
+
+ Last modified Fri Jan 17 22:52:57 EST 1997 --- Serial 853731293
+
diff --git a/tix/docs/Release-4.1b2.html b/tix/docs/Release-4.1b2.html
new file mode 100644
index 00000000000..79bfd4fcb0f
--- /dev/null
+++ b/tix/docs/Release-4.1b2.html
@@ -0,0 +1,187 @@
+<h3>Tix 4.1b2</h3>
+<i> Released on December 28, 1996</i> <p>
+
+<pre>
+
+Subject: [Announce] Tix version 4.1b2 is available
+
+</pre>
+
+ I am pleased to announce the availability of Tix version 4.1b2, the
+ first beta release. This version of Tix supports the Unix and
+ Microsoft Windows platforms. <p>
+
+ The Tix library has by far the greatest collection of widgets for
+ programming with Tcl/Tk. Highlights include: Hierarchical Listbox,
+ Directory List/Tree View, SpreadSheet, Tabular Listbox, ComboBox,
+ Motif style FileSelectBox, MS Windows style FileSelectBox,
+ PanedWindow, NoteBook, Spin Control widget .... and many more. With
+ these new widgets, your Tcl/Tk applications will look great and
+ interact with your users in intuitive ways. <p>
+
+ For more info about Tix, visit the Tix home page at <a
+ href="http://www.xpi.com/tix/"> http://www.xpi.com/tix/ </a>. <p>
+
+ This version of Tix is released under licensing terms similar to
+ those of Tcl/Tk. Please read the file license.terms carefully
+ before proceeding. <p>
+
+<h3>Requirement</h3>
+
+<h4>Unix Platforms</h4>
+
+ Tix 4.1b2 works with the following combinations of Tcl/Tk/ITcl:
+ <ul>
+ <li> Tcl 7.4 + Tk 4.0
+ <li> Tcl 7.4 + Tk 4.0 + ITcl 2.0
+ <li> Tcl 7.5 + Tk 4.1
+ <li> Tcl 7.5 + Tk 4.1 + ITcl 2.1
+ <li> Tcl 7.6 + Tk 4.2
+ </ul>
+
+<h4>Windows Platforms</h4>
+
+ Tix 4.1b2 requires the final release of Tcl 7.5 or Tcl 7.6.
+
+<h3>Getting The Tix Package</h3>
+
+ Tix 4.1b2 sources are available at
+ <ul>
+ <li> <a href="ftp://ftp.xpi.com/pub/Tix4.1b2.tar.gz">
+ ftp://ftp.xpi.com/pub/Tix4.1b2.tar.gz</a>: Unix source tar file.
+
+ <li> <a href="ftp://ftp.xpi.com/pub/windows/tix41b2.zip">
+ ftp://ftp.xpi.com/pub/windows/tix41b2.zip</a>: Same as
+ Tix4.1b2.tar.gz, but in Windows/DOS ZIP format.
+ </ul>
+
+<h3>What's New Since Tix 4.1a3 (the last release)</h3>
+
+
+<h4>10/13/96</h4>
+
+ <b>New feature:</b> Now XPM image works on Windows. <p>
+
+<h4>10/18/96</h4>
+
+ <b>New feature:</b> New options -editnotifycmd and -editdonecmd for
+ the Grid widget to support editing of the entries. <p>
+
+ <b>New feature:</b> New widget <b>TixFloatEntry</b> to support
+ editing of DItems. <p>
+
+<h4>10/27/96</h4>
+
+ <b>Feature Change:</b> The following changes are made to the
+ configuration and installation of Tix:
+ <ul>
+
+ <li> <b>Naming convention of binaries</b>: The binaries for the
+ Tk 4.0 target are called tixwish and libtix.a. For Tk 4.1 and
+ later, the executable is be called tixwish[Tix version].[Tk version]
+ and the library is called libtix[Tix version].[Tk
+ version].[lib extension]. For example, tixwish4.1.4.1 and
+ libtix4.1.4.2.so. On platforms that do not allow the dot
+ character in the names of shared libraries, the dot character
+ will be omitted. E.g., libtix4142.so.
+
+ <li> <b>Shared vs static linking</b>: The static binary will be
+ created only if the -enable-[tkversion]-shared flag is
+ disabled. If you want to create both shared and static
+ binaries, configure and compile Tix twice.
+
+ <li> ET support is replaced by SAM (stand-alone module)
+ support.
+
+ <li> The following options are removed from configure:
+ <ul>
+ <li> -enable-tk40_et
+ <li> -enable-tk41_et
+ <li> -enable-tk41_shared
+ </ul>
+
+ <li> The new options are added to configure:
+ <ul>
+ <li> -enable-tk40-sam
+ <li> -enable-tk41-sam
+ <li> -enable-tk42-sam
+ <li> -enable-tk41-shared
+ <li> -enable-tk42-shared
+ </ul>
+ </ul>
+
+
+<h4>11/1/96</h4>
+
+ <b>New feature:</b> XPM code has been rewritten. The code is now cleanly
+ separated into three modules: generic, windows specific and Unix specific.
+ <p>
+
+
+<h4>11/17/96</h4>
+
+ <b>New feature:</b> Tix classes can be defined before their
+ superclasses are defined. However, a class <b>cannot</b> be
+ instantiated before all of its superclasses are defined. This
+ feature makes it possible to load the Tix scripts into the SAM in
+ any order, without having to worry about loading the superclasses
+ before the subclasses. <p>
+
+ <b>New feature:</b> Tix is initialized by calling the command
+ <b>__tixInit</b>, not by sourcing <b>Init.tcl</b>. <p>
+
+<h4>11/29/96</h4>
+
+ <b>Bug Fixed:</b> tixTmpLine now correctly works on multiple X
+ displays. <p>
+
+<h4>11/30/96</h4>
+
+ <b>Feature Change</b>: DisplayStyle now uses a hash table to store
+ the items associated with it (previously a link list was used). This
+ speeds up the delete operations when a lot (1000 or more) of items
+ are associated with the same style. <b>Possible Incompatibility:</b>
+ widgets that use DItems must be recompiled. <p>
+
+ <b>Bug Fixed:</b> Tix no longer tempers with the way Tk handles
+ errors, unless the environment variable TIX_DEBUG_INTERACTIVE is
+ set. If this variable is set, all error messages will be printed to
+ the standard output. This may be convenient for debugging
+ purposes. Use this feature with discretion, and during program
+ development only. <p>
+
+<h4>12/2/96</h4>
+
+ <b>Bug Fixed:</b>Dotted anchor lines (HList, TList, Grid) and
+ rubber-band lines (PanedWindow, ResizeHandle) are implemented on Windows.<p>
+
+ <b>New feature:</b> Tcl 7.6 support is complete for the Windows
+ platform. makefile.vc and makefile.bc have been modified such that
+ the Tcl version can be chosen at compile time by, e.g., "<b>make
+ TCL_VER=7.5 -f makefile.bc</b>". <p>
+
+<h4>12/2/96</h4>
+
+ <b>Bug Fixed:</b> Display items are correctly clipped. E.g., if a
+ text item is wider than the width of a column in an HList, the item
+ will be clipped.<p>
+
+<h4>12/20/96</h4>
+
+ <b>New feature:</b> New sample file demos/samples/EditGrid.tcl that
+ demonstrates the use of an editable grid widget. <p>
+
+<h4>12/21/96</h4>
+
+ <b>Bug Fixed:</b> Tix works with multiple interpreters under tk4.1
+ and 4.2 (see test/general/minterp.tcl). However, minterp.tcl still
+ core dumps under Itcl 2.1. It is not clear to me whether this is a
+ problem of Tix or Itcl. <p>
+
+ <b>Bug Fixed:</b> Now when an interpreter is deleted, all Tix class
+ informations associated with this interpreter are freed. (No memory
+ leak is recorded by purify when running Tix against the complete
+ test suite.) <p>
+<!Serial 851749997>
+<hr><i>Last modified Fri Jan 17 22:52:59 EST 1997 </i> ---
+<i>Serial 853731294</i>
diff --git a/tix/docs/Release-4.1b2.txt b/tix/docs/Release-4.1b2.txt
new file mode 100644
index 00000000000..bcc176804c3
--- /dev/null
+++ b/tix/docs/Release-4.1b2.txt
@@ -0,0 +1,161 @@
+
+ TIX 4.1B2
+
+ Released on December 28, 1996
+
+Subject: [Announce] Tix version 4.1b2 is available
+
+ I am pleased to announce the availability of Tix version 4.1b2, the
+ first beta release. This version of Tix supports the Unix and
+ Microsoft Windows platforms.
+
+ The Tix library has by far the greatest collection of widgets for
+ programming with Tcl/Tk. Highlights include: Hierarchical Listbox,
+ Directory List/Tree View, SpreadSheet, Tabular Listbox, ComboBox,
+ Motif style FileSelectBox, MS Windows style FileSelectBox,
+ PanedWindow, NoteBook, Spin Control widget .... and many more. With
+ these new widgets, your Tcl/Tk applications will look great and
+ interact with your users in intuitive ways.
+
+ For more info about Tix, visit the Tix home page at
+ http://www.xpi.com/tix/ .
+
+ This version of Tix is released under licensing terms similar to those
+ of Tcl/Tk. Please read the file license.terms carefully before
+ proceeding.
+
+ REQUIREMENT
+
+ Unix Platforms
+
+ Tix 4.1b2 works with the following combinations of Tcl/Tk/ITcl:
+ * Tcl 7.4 + Tk 4.0
+ * Tcl 7.4 + Tk 4.0 + ITcl 2.0
+ * Tcl 7.5 + Tk 4.1
+ * Tcl 7.5 + Tk 4.1 + ITcl 2.1
+ * Tcl 7.6 + Tk 4.2
+
+ Windows Platforms
+
+ Tix 4.1b2 requires the final release of Tcl 7.5 or Tcl 7.6.
+
+ GETTING THE TIX PACKAGE
+
+ Tix 4.1b2 sources are available at
+ * ftp://ftp.xpi.com/pub/Tix4.1b2.tar.gz: Unix source tar file.
+ * ftp://ftp.xpi.com/pub/windows/tix41b2.zip: Same as
+ Tix4.1b2.tar.gz, but in Windows/DOS ZIP format.
+
+ WHAT'S NEW SINCE TIX 4.1A3 (THE LAST RELEASE)
+
+ 10/13/96
+
+ New feature: Now XPM image works on Windows.
+
+ 10/18/96
+
+ New feature: New options -editnotifycmd and -editdonecmd for the Grid
+ widget to support editing of the entries.
+
+ New feature: New widget TixFloatEntry to support editing of DItems.
+
+ 10/27/96
+
+ Feature Change: The following changes are made to the configuration
+ and installation of Tix:
+ * Naming convention of binaries: The binaries for the Tk 4.0 target
+ are called tixwish and libtix.a. For Tk 4.1 and later, the
+ executable is be called tixwish[Tix version].[Tk version] and the
+ library is called libtix[Tix version].[Tk version].[lib
+ extension]. For example, tixwish4.1.4.1 and libtix4.1.4.2.so. On
+ platforms that do not allow the dot character in the names of
+ shared libraries, the dot character will be omitted. E.g.,
+ libtix4142.so.
+ * Shared vs static linking: The static binary will be created only
+ if the -enable-[tkversion]-shared flag is disabled. If you want to
+ create both shared and static binaries, configure and compile Tix
+ twice.
+ * ET support is replaced by SAM (stand-alone module) support.
+ * The following options are removed from configure:
+ + -enable-tk40_et
+ + -enable-tk41_et
+ + -enable-tk41_shared
+ * The new options are added to configure:
+ + -enable-tk40-sam
+ + -enable-tk41-sam
+ + -enable-tk42-sam
+ + -enable-tk41-shared
+ + -enable-tk42-shared
+
+ 11/1/96
+
+ New feature: XPM code has been rewritten. The code is now cleanly
+ separated into three modules: generic, windows specific and Unix
+ specific.
+
+ 11/17/96
+
+ New feature: Tix classes can be defined before their superclasses are
+ defined. However, a class cannot be instantiated before all of its
+ superclasses are defined. This feature makes it possible to load the
+ Tix scripts into the SAM in any order, without having to worry about
+ loading the superclasses before the subclasses.
+
+ New feature: Tix is initialized by calling the command __tixInit, not
+ by sourcing Init.tcl.
+
+ 11/29/96
+
+ Bug Fixed: tixTmpLine now correctly works on multiple X displays.
+
+ 11/30/96
+
+ Feature Change: DisplayStyle now uses a hash table to store the items
+ associated with it (previously a link list was used). This speeds up
+ the delete operations when a lot (1000 or more) of items are
+ associated with the same style. Possible Incompatibility: widgets that
+ use DItems must be recompiled.
+
+ Bug Fixed: Tix no longer tempers with the way Tk handles errors,
+ unless the environment variable TIX_DEBUG_INTERACTIVE is set. If this
+ variable is set, all error messages will be printed to the standard
+ output. This may be convenient for debugging purposes. Use this
+ feature with discretion, and during program development only.
+
+ 12/2/96
+
+ Bug Fixed:Dotted anchor lines (HList, TList, Grid) and rubber-band
+ lines (PanedWindow, ResizeHandle) are implemented on Windows.
+
+ New feature: Tcl 7.6 support is complete for the Windows platform.
+ makefile.vc and makefile.bc have been modified such that the Tcl
+ version can be chosen at compile time by, e.g., "make TCL_VER=7.5 -f
+ makefile.bc".
+
+ 12/2/96
+
+ Bug Fixed: Display items are correctly clipped. E.g., if a text item
+ is wider than the width of a column in an HList, the item will be
+ clipped.
+
+ 12/20/96
+
+ New feature: New sample file demos/samples/EditGrid.tcl that
+ demonstrates the use of an editable grid widget.
+
+ 12/21/96
+
+ Bug Fixed: Tix works with multiple interpreters under tk4.1 and 4.2
+ (see test/general/minterp.tcl). However, minterp.tcl still core dumps
+ under Itcl 2.1. It is not clear to me whether this is a problem of Tix
+ or Itcl.
+
+ Bug Fixed: Now when an interpreter is deleted, all Tix class
+ informations associated with this interpreter are freed. (No memory
+ leak is recorded by purify when running Tix against the complete test
+ suite.)
+
+ _________________________________________________________________
+
+ Last modified Fri Jan 17 22:52:59 EST 1997 --- Serial 853731294
+
diff --git a/tix/docs/Release.html b/tix/docs/Release.html
new file mode 100644
index 00000000000..3ddb461ea96
--- /dev/null
+++ b/tix/docs/Release.html
@@ -0,0 +1,20 @@
+<TITLE>Tix 4.1 Release Notes</TITLE>
+<Center><H1>Tix 4.1 Release Notes</H1></Center>
+
+ This is a list of all the release notes of the Tix library for
+ version 4.1.
+
+<H3>Contents</H3>
+<ul>
+ <li> <a href=Release-4.1.0.html>Release-4.1.0.html : Final Release 4.1</a>
+ <p>
+ <li> <a href=Release-4.1b2.html>Release-4.1b2.html : Beta Release 1</a>
+ <li> <a href=Release-4.1b1.html>Release-4.1b1.html : Beta Release 1</a>
+ <li> <a href=Release-4.1a3.html>Release-4.1a3.html : Alpha Release 3</a>
+ <li> <a href=Release-4.1a2.html>Release-4.1a2.html : Alpha Release 2</a>
+</ul>
+
+
+<!Serial 851749996>
+<hr><i>Last modified Sun Feb 16 00:03:12 EST 1997 </i> ---
+<i>Serial 856069650</i>
diff --git a/tix/docs/Release.txt b/tix/docs/Release.txt
new file mode 100644
index 00000000000..05d8f0ece3c
--- /dev/null
+++ b/tix/docs/Release.txt
@@ -0,0 +1,18 @@
+
+ TIX 4.1 RELEASE NOTES
+
+ This is a list of all the release notes of the Tix library for version
+ 4.1.
+
+ CONTENTS
+ * Release-4.1.0.html : Final Release 4.1
+
+ * Release-4.1b2.html : Beta Release 1
+ * Release-4.1b1.html : Beta Release 1
+ * Release-4.1a3.html : Alpha Release 3
+ * Release-4.1a2.html : Alpha Release 2
+
+ _________________________________________________________________
+
+ Last modified Sun Feb 16 00:03:12 EST 1997 --- Serial 856069650
+
diff --git a/tix/docs/SAModule.txt b/tix/docs/SAModule.txt
new file mode 100644
index 00000000000..f1cb50b93c7
--- /dev/null
+++ b/tix/docs/SAModule.txt
@@ -0,0 +1,89 @@
+ ===============================
+ Stand-alone Tix Applications
+ ================================
+
+INTRODUCTION
+
+ Traditionally, Tcl/Tk and its extensions require an extensive set of
+ run-time scripts. These scripts are usually stored as
+ /usr/local/lib/<package>/*.tcl. When a Tcl/Tk executable starts up,
+ it looks for the scripts in the /usr/local directory, or as defined
+ by enviornment variables such as TCL_LIBRARY or TIX_LIBRARY.
+
+ The need of an external script library sometimes causes problems
+ because users may need to keep track of their TCL_LIBRARY environment
+ variables. Also, it is quite difficult to distribute a Tcl
+ executable to a customer's site if the customer's machines don't
+ already have Tcl installed.
+
+ One solution of this problem is to compile stand-alone versions
+ Tcl/Tk application. The scripts can be compiled into into the
+ application executable, or into shared libraries which are linked
+ into the executable. The distrution of a monolithic executable, or
+ one executable with several shared libraries, is substantially
+ easier than the distribution of many Tcl scripts scattered around in
+ differenr directories.
+
+COMPILING STAND-ALONE TIX
+
+ Currently Tix supports standalone modules only for Tcl version 7.5
+ and 7.6 on Unix. Read the file docs/UnixInst.html first before
+ reading the rest of this section.
+
+ To exable Tix stand-alone module, change into a Unix build directory
+ and run the configure script with the --enable-sam option. Then, run
+ "make". When "make" finishes, you will get several libraries and
+ executables (the names may vary depending on the version of Tcl and
+ the Unix platform):
+
+ libtix4.1.7.6.so Standard Tix shared library.
+ tixwish Standard Tix shell.
+
+ libtixsam4.1.7.6.so Tix SAM library.
+ libtksam4.2.so Tk Sam library.
+ libtclsam7.6.so Tcl Sam library.
+ satixwish Stand-alone Tix shell
+ sawish Stand-alone Tk shell
+ satclsh Stand-alone Tcl shell
+
+
+DISTRIBUTING satixwish
+
+ satixwish is linked to the following libraries
+ libtixsam Tix c code and scripts
+ libtksam Tk scripts.
+ libtk Tk c code
+ libtclsam Tcl scripts
+ libtcl Tcl c code.
+
+ If you would like to distribute satixwish, you should include the
+ satixwish executable, the five shared libraries and your
+ application's Tcl scripts. There is no need to include the Tcl, Tk
+ and Tix script libraries.
+
+DYNAMICALLY LOADING TIX SAM
+
+ You can also dynamically load libtixsam into a running wish. If you
+ have properly installed Tix, you can execute the command
+
+ package require -exact Tixsam [tixBinVer 4.1]
+
+ If Tix has not been installed in your system, you can still use the
+ "load" command to dynamically load Tixsam:
+
+ load [file join $dir \
+ libtixsam[tixBinVer 4.1][info sharedlibextension]] \
+ Tixsam
+
+ See the file docs/Pkg.txt for discussions on the tixBinVer
+ procedure and dynamic loading of Tix.
+
+USING TIX WITH EMBEDDED TK
+
+ Embedded Tk (ET) is another popular package for creating stand-alone
+ Tcl/Tk applications. Older versions of Tix used to support
+ ET. However, the scripts of this version of Tix cannot be compiled
+ by the et2c program. If you want to use Tix in an ET-enabled
+ application, you should link libtixsam with your application and
+ call Tixsam_Init() to initialize the stand-alone Tix module. See the
+ directory demos/et for an example.
diff --git a/tix/docs/UnixInst.html b/tix/docs/UnixInst.html
new file mode 100644
index 00000000000..a9052c51a88
--- /dev/null
+++ b/tix/docs/UnixInst.html
@@ -0,0 +1,211 @@
+<TITLE>Building the Unix Binaries</TITLE>
+<Center><H1>Building the Unix Binaries</H1></Center>
+
+ There are several versions of Tcl/Tk being used today. The newer
+ <b>Tcl 7.5, 7.6 and 8.0</b> releases are becoming popular
+ because they can run on Windows, Unix and Macintosh. However, many
+ people are still using <b>Tcl 7.4</b>. Another popular variant of
+ Tcl is <a href="http"//www.tcltk.com/"> <b>Itcl</b> </a>, which adds
+ object-oriented functionality to the Tcl language. Version <b>Itcl
+ 2.0, 2.1 and 2.2</b> are being widely used now. <p>
+
+ Tix supports all of these versions of Tcl and Itcl so you can freely
+ choose a version of Tcl or Itcl that works best for you. The
+ following steps guide you through the process of building the Tix
+ binary for your choice of the version(s) of Tcl or Itcl on Unix
+ platforms.
+
+<h3> 1. Download the Tcl, Tk and/or Itcl sources </h3>
+
+ You may have already installed Tcl, Tk and Itcl on your system. The
+ installed binaries usually reside in the <b>/usr/local/</b>
+ directory. However, the build process of Tix doesn't use the
+ installed binaries because doing that may result in subtle version
+ conflects. Instead, Tix uses only the binaries from the Tcl, Tk and
+ Itcl source directories. Install sources of these packages if they
+ are not already in your system. <p>
+
+ <ul>
+
+ <li> <b>Tcl 7.4, 7.5, 7.6 and 8.0</b>: The source code of these
+ Tcl releases can be found at <a href="ftp://ftp.sunlabs.com/pub">
+ ftp://ftp.sunlabs.com/pub </a>. Remember to download the source
+ code of the corresponding versions of Tk as well. <p>
+
+
+ <li> <b>Itcl 2.0</b>: The source code can be found at <a
+ href="ftp://ftp.neosoft.com/pub/tcl/alcatel/extensions/itcl2.0.tar.gz">
+ ftp://ftp.neosoft.com/pub/tcl/alcatel/extensions/itcl2.0.tar.gz
+ </a>. <p>
+
+ <li> <b>Itcl 2.1 and 2.2</b>: Download the source code from <a
+ href="ftp://www.tcltk.com/pub/itcl">ftp://www.tcltk.com/pub/itcl</a><p>
+
+ </ul>
+
+ Make sure that the source directory of these package reside in the
+ same directory as Tix. For example, to compile Tix 4.1.0 for Tcl 7.6
+ and Itcl 2.1, a typical source directory would look like this:<p>
+
+ <blockquote><pre><b>
+ /home/src/tcl7.6/
+ /home/src/tk4.2/
+ /home/src/itcl2.1/
+ /home/src/Tix4.1.0/
+ </b></pre></blockquote>
+
+ <b> IMPORTANT: </b> <i>Do not arrange your source directory in any
+ other way. Do not change the names for these directories. Otherwise
+ Tix will not be configured properly.</i><p>
+
+<h3> 2. Configure and compile the desired version(s) of Tcl and/or Itcl</h3>
+
+ Tcl, Tk and Itcl comes with installation guides and should be easy
+ to build. In case you have any problems building these packages, you
+ can send your questions to the comp.lang.tcl newsgroup or to the
+ respective authors of these packages. You may also send mail to
+ <a href="mailto:tix-support@xpi.com">tix-support@xpi.com</a>. <p>
+
+ For example, assuming your source directory is structured as above,
+ you can build Tcl 7.6 and Tk 4.2 by issuing the following Unix commands:
+
+ <blockquote><pre><b>
+ cd /home/src/tcl7.6/unix
+ ./configure --enable-shared
+ make
+ cd /home/src/tk4.2/unix
+ ./configure --enable-shared
+ make
+ </b></pre></blockquote>
+ <p>
+
+<h3> 3. Configure and compile Tix </h3>
+
+ <ol>
+
+ <li> Make sure you have configured and build the desired
+ version(s) of Tcl and/or Itcl. <p>
+
+
+ <li> Change into the <code><b>Tix4.1.0/unix</b></code>
+ directory and execute the configure script:
+
+ <blockquote><pre><b>
+ cd /home/src/Tix4.1.0/unix
+ ./configure
+ </b></pre></blockquote>
+
+ <li> Inside the <code><b>Tix4.1.0/unix</b></code> directory, you
+ will see several subdirectories for building Tix for specific
+ version of Tcl/Tk or Itcl. Change into the appropriate
+ subdirectory. For example, if you want to build Tix for
+ Tcl7.6/Tk4.2, execute the following commands:
+
+
+ <blockquote><pre><b>
+ cd tk4.2
+ ./configure --enable-shared
+ make
+ </b></pre></blockquote>
+
+ Before you run the <code><b>configure</b></code> script, you can type:
+
+ <blockquote><pre><b>
+ ./configure --help
+ </b></pre></blockquote>
+
+ to find out the available options.
+
+ <li> Repeat step 3 for any other versions of Tcl/Tk or
+ Itcl that you want to build Tix for. <p>
+
+ </ol>
+
+<h3> 4. Experimenting with Tix</h3>
+
+ When you finish building Tix, you will find the
+ <code><b>tixwish</b></code> program inside the build directories
+ (e.g., <code><b>Tix4.1.0/unix/tk4.2/tixwish</b></code>). Or, if you
+ build Tix for Itcl, the program will be called
+ <code><b>itixwish</b></code>. <p>
+
+ Tix comes with a number of demo programs. You can run these
+ program by running the <b>demos/widget</b> script with
+ <b>tixwish</b> or <b>itixwish</b>. Make sure that you have set the
+ <b>TIX_LIBRARY</b> variable accordingly (see below). If you haven't
+ installed Tcl and/or Tk then you'll need to set your
+ <b>TCL_LIBRARY</b> and <b>TK_LIBRARY</b> environment variable as
+ well (see the Tcl and Tk README files for information on this). <p>
+
+ You can type the following command in your shell:<p>
+
+ <blockquote><pre><b>
+ cd /home/src/Tix4.1.0/demos
+ env TIX_LIBRARY=/home/src/Tix4.1.0/library ../unix/tk4.2/tixwish widget
+ </b></pre></blockquote>
+
+ This will open up the Tix demo window. You can click on the "<b>Run
+ Sample Programs</b>" tab and execute the sample programs: <p>
+
+ <center><IMG SRC="img/demo1.gif"> <p> <b>(Screen 4.1 Tix widget
+ demostration program)</b></center> <p>
+
+<h3> 5. Installing Tix</h3>
+
+ If you are sufficiently convinced that Tix works properly, you can
+ install the Tix binaries and scripts on your system. If you are
+ paranoid, these is a small set of test scripts that tests the
+ behavior of Tix under various configurations. You can do this by
+ typing "<b>make tests</b>" inside the build-subdirectories, e.g.:
+
+ <blockquote><pre><b>
+ cd /home/src/Tix4.1.0/unix/tk4.2
+ make tests
+ </b></pre></blockquote>
+
+ Hopefully it will report "<b>0 error(s) found</b>". <p>
+
+ Type "<b>make install</b>" to install Tix's binaries and script
+ files in standard places: <p>
+
+ <blockquote><pre><b>
+ cd /home/src/Tix4.1.0/unix
+ make install
+ </b></pre></blockquote>
+
+ In the default configuration information will be installed in
+ <b>/usr/local</b> so you'll need write permission on this
+ directory. If you'd like to use a different installation directory,
+ you can specify the "<b>--exec-prefix</b>" and "<b>--prefix</b>"
+ options for the configure script in step <b>3</b> and then rebuild
+ Tix.<p>
+
+
+<h3> 6. Trouble Shooting</h3>
+
+ If <b>make</b> fails then you'll have to personalize the
+ <b>Makefile</b>'s for your site or possibly modify the distribution
+ in other ways. First check the files <a href="FAQ.html">
+ docs/FAQ.html </a> and <a href="Porting.html">docs/Porting.html</a>
+ to see if there are hints for compiling on your system. If you need
+ to modify <b>Makefile</b>'s, there are comments at the beginning of
+ it that describe the things you might want to change and how to
+ change them.<p>
+
+ If you have trouble compiling Tix, I'd suggest looking at the files
+ <a href="FAQ.html">docs/FAQ.html</a> and <a
+ href="Porting.html">docs/Porting.html</a>. It contains information
+ that people have sent me about changes they had to make to compile
+ Tix in various environments.<p>
+
+ I make no guarantees that this information is accurate, complete, or
+ up-to-date, but you may find it useful. If you get Tix running on a
+ new configuration and had to make non-trivial changes to do it, I'd
+ be happy to receive new information to add to <a
+ href="Porting.html">docs/Porting.html</a>. I'm also interested in
+ hearing how to change the configuration setup so that Tix compiles
+ on additional platforms "out of the box". <p>
+
+<!Serial 851729141>
+<hr><i>Last modified Wed Feb 12 16:01:33 EST 1997 </i> ---
+<i>Serial 856069650</i>
diff --git a/tix/docs/UnixInst.txt b/tix/docs/UnixInst.txt
new file mode 100644
index 00000000000..3c5358a1884
--- /dev/null
+++ b/tix/docs/UnixInst.txt
@@ -0,0 +1,171 @@
+
+ BUILDING THE UNIX BINARIES
+
+ There are several versions of Tcl/Tk being used today. The newer Tcl
+ 7.5, 7.6 and 8.0 releases are becoming popular because they can run
+ on Windows, Unix and Macintosh. However, many people are still using
+ Tcl 7.4. Another popular variant of Tcl is Itcl , which adds
+ object-oriented functionality to the Tcl language. Version Itcl 2.0,
+ 2.1 and 2.2 are being widely used now.
+
+ Tix supports all of these versions of Tcl and Itcl so you can freely
+ choose a version of Tcl or Itcl that works best for you. The following
+ steps guide you through the process of building the Tix binary for
+ your choice of the version(s) of Tcl or Itcl on Unix platforms.
+
+ 1. DOWNLOAD THE TCL, TK AND/OR ITCL SOURCES
+
+ You may have already installed Tcl, Tk and Itcl on your system. The
+ installed binaries usually reside in the /usr/local/ directory.
+ However, the build process of Tix doesn't use the installed binaries
+ because doing that may result in subtle version conflects. Instead,
+ Tix uses only the binaries from the Tcl, Tk and Itcl source
+ directories. Install sources of these packages if they are not already
+ in your system.
+
+ * Tcl 7.4, 7.5, 7.6 and 8.0: The source code of these Tcl releases
+ can be found at ftp://ftp.sunlabs.com/pub . Remember to download
+ the source code of the corresponding versions of Tk as well.
+
+ * Itcl 2.0: The source code can be found at
+ ftp://ftp.neosoft.com/pub/tcl/alcatel/extensions/itcl2.0.tar.gz
+ .
+
+ * Itcl 2.1 and 2.2: Download the source code from
+ ftp://www.tcltk.com/pub/itcl
+
+ Make sure that the source directory of these package reside in the
+ same directory as Tix. For example, to compile Tix 4.1.0 for Tcl 7.6
+ and Itcl 2.1, a typical source directory would look like this:
+
+ /home/src/tcl7.6/
+ /home/src/tk4.2/
+ /home/src/itcl2.1/
+ /home/src/Tix4.1.0/
+
+ IMPORTANT: Do not arrange your source directory in any other way. Do
+ not change the names for these directories. Otherwise Tix will not be
+ configured properly.
+
+ 2. CONFIGURE AND COMPILE THE DESIRED VERSION(S) OF TCL AND/OR ITCL
+
+ Tcl, Tk and Itcl comes with installation guides and should be easy to
+ build. In case you have any problems building these packages, you can
+ send your questions to the comp.lang.tcl newsgroup or to the
+ respective authors of these packages. You may also send mail to
+ tix-support@xpi.com.
+
+ For example, assuming your source directory is structured as above,
+ you can build Tcl 7.6 and Tk 4.2 by issuing the following Unix
+ commands:
+
+ cd /home/src/tcl7.6/unix
+ ./configure --enable-shared
+ make
+ cd /home/src/tk4.2/unix
+ ./configure --enable-shared
+ make
+
+ 3. CONFIGURE AND COMPILE TIX
+ 1. Make sure you have configured and build the desired version(s) of
+ Tcl and/or Itcl.
+
+ 2. Change into the Tix4.1.0/unix directory and execute the configure
+ script:
+
+ cd /home/src/Tix4.1.0/unix
+ ./configure
+
+ 3. Inside the Tix4.1.0/unix directory, you will see several
+ subdirectories for building Tix for specific version of Tcl/Tk or
+ Itcl. Change into the appropriate subdirectory. For example, if
+ you want to build Tix for Tcl7.6/Tk4.2, execute the following
+ commands:
+
+ cd tk4.2
+ ./configure --enable-shared
+ make
+
+ Before you run the configure script, you can type:
+
+ ./configure --help
+
+ to find out the available options.
+ 4. Repeat step 3 for any other versions of Tcl/Tk or Itcl that you
+ want to build Tix for.
+
+ 4. EXPERIMENTING WITH TIX
+
+ When you finish building Tix, you will find the tixwish program inside
+ the build directories (e.g., Tix4.1.0/unix/tk4.2/tixwish). Or, if you
+ build Tix for Itcl, the program will be called itixwish.
+
+ Tix comes with a number of demo programs. You can run these program by
+ running the demos/widget script with tixwish or itixwish. Make sure
+ that you have set the TIX_LIBRARY variable accordingly (see below). If
+ you haven't installed Tcl and/or Tk then you'll need to set your
+ TCL_LIBRARY and TK_LIBRARY environment variable as well (see the Tcl
+ and Tk README files for information on this).
+
+ You can type the following command in your shell:
+
+ cd /home/src/Tix4.1.0/demos
+ env TIX_LIBRARY=/home/src/Tix4.1.0/library ../unix/tk4.2/tixwish widget
+
+ This will open up the Tix demo window. You can click on the "Run
+ Sample Programs" tab and execute the sample programs:
+
+ [IMAGE]
+
+ (Screen 4.1 Tix widget demostration program)
+
+ 5. INSTALLING TIX
+
+ If you are sufficiently convinced that Tix works properly, you can
+ install the Tix binaries and scripts on your system. If you are
+ paranoid, these is a small set of test scripts that tests the behavior
+ of Tix under various configurations. You can do this by typing "make
+ tests" inside the build-subdirectories, e.g.:
+
+ cd /home/src/Tix4.1.0/unix/tk4.2
+ make tests
+
+ Hopefully it will report "0 error(s) found".
+
+ Type "make install" to install Tix's binaries and script files in
+ standard places:
+
+ cd /home/src/Tix4.1.0/unix
+ make install
+
+ In the default configuration information will be installed in
+ /usr/local so you'll need write permission on this directory. If
+ you'd like to use a different installation directory, you can specify
+ the "--exec-prefix" and "--prefix" options for the configure script in
+ step 3 and then rebuild Tix.
+
+ 6. TROUBLE SHOOTING
+
+ If make fails then you'll have to personalize the Makefile's for your
+ site or possibly modify the distribution in other ways. First check
+ the files docs/FAQ.html and docs/Porting.html to see if there are
+ hints for compiling on your system. If you need to modify Makefile's,
+ there are comments at the beginning of it that describe the things you
+ might want to change and how to change them.
+
+ If you have trouble compiling Tix, I'd suggest looking at the files
+ docs/FAQ.html and docs/Porting.html. It contains information that
+ people have sent me about changes they had to make to compile Tix in
+ various environments.
+
+ I make no guarantees that this information is accurate, complete, or
+ up-to-date, but you may find it useful. If you get Tix running on a
+ new configuration and had to make non-trivial changes to do it, I'd be
+ happy to receive new information to add to docs/Porting.html. I'm also
+ interested in hearing how to change the configuration setup so that
+ Tix compiles on additional platforms "out of the box".
+
+ _________________________________________________________________
+
+ Last modified Wed Feb 12 16:01:33 EST 1997 --- Serial 856069650
+
diff --git a/tix/docs/WinInst.html b/tix/docs/WinInst.html
new file mode 100644
index 00000000000..ab921b1ccc1
--- /dev/null
+++ b/tix/docs/WinInst.html
@@ -0,0 +1,177 @@
+<TITLE>Building the Windows Binaries</TITLE>
+<Center><H1>Building the Windows Binaries</H1></Center>
+
+ To build Tix on Windows, you must have the following:<p>
+
+ <ul>
+
+ <li> Visual C++ 4.0 or later; or Borland C++ 4.5 or later. There
+ is not yet built-in support for Tix to work with other compilers.
+
+ <li> The sources of Tcl/Tk for Windows.
+
+ <li> The sources of Tix for Windows.
+
+ </ul>
+
+<h3> 1. Download the Tcl, Tk and Tix sources </h3>
+
+ You can download latest version of the Tcl7.5, 7.6 or 8.0 from <a
+ href="ftp://ftp.sunlabs.com/pub"> ftp://ftp.sunlabs.com/pub
+ </a>. There are detailed instructions that comes with these packages
+ about compiling them on Windows. Hopefully that will give you a good
+ exercise on setting up the environment for compiling Tcl-based
+ programs on the Windows platforms.<p>
+
+ You can then get the Tix source distribution at <a
+ href="ftp://ftp.xpi.com/pub/Tix41.zip">
+ ftp://ftp.xpi.com/pub/Tix41.zip </a>. This ZIP file contains files
+ with long file names and must be unzipped by an UNZIP program that
+ knows long filenames, such as <b>winzip.exe</b>. <p>
+
+ You should put the Tcl, Tk and Tix source packages in the same
+ directory. For example, my directories look like this: <p>
+
+ <blockquote><code><b>
+ C:\tcl7.6<br>
+ C:\tk4.2<br>
+ C:\Tix4.1<br>
+ </b></code></blockquote>
+
+<h3> 2. Compile Tcl and Tk </h3>
+
+ Follow the instructions that come with Tcl and Tk. If you can
+ compile successfully, you would get the following files: <p>
+
+ <blockquote><b><code>
+ C:\tcl7.6\win\tcl76.dll<br>
+ C:\tcl7.6\win\tclpip76.dll<br>
+ C:\tk4.2\win\tk42.dll<br>
+ </code></b></blockquote>
+
+ These are the files you need to run Tix on Windows.
+
+<h3> 3. Compile Tix </h3>
+
+ Change to the Tix4.1\Win subdirectory. Tix supports several versions
+ of Tcl. You choose the version of Tcl to compile Tix with by using
+ the <b>TCL_VER</b> variable:
+
+ <ul>
+ <li> Tcl 7.5: <b><code>nmake -f makefile.vc TCL_VER=7.5</code></b>
+ <li> Tcl 7.6: <b><code>nmake -f makefile.vc TCL_VER=7.6</code></b>
+ <li> Tcl 8.0: <b><code>nmake -f makefile.vc TCL_VER=8.0</code></b>
+ <li> Itcl 2.2: <b><code>nmake -f makefile.vc TCL_VER=2.2i</code></b>
+ </ul>
+
+ If you have BC++, use <b>make -f makefile.bc</b> instead. <p>
+
+ When <b>make</b> or <b>nmake</b> finishes, you will get Tix binaries
+ inside the build directories. For example, if you compile Tix for
+ Tcl 7.6, you will be the following files:
+
+ <blockquote><b><code>
+ C:\Tix4.1\win\tcl7.6\tix4176.dll<br>
+ C:\Tix4.1\win\tcl7.6\tix4176.exe<br>
+ </code></b></blockquote>
+
+ The executable file <b>tix4176.exe</b> contains Tcl, Tk and Tix. You
+ can use it to run an Tix script by:
+
+ <blockquote><b><code>
+ set TIX_LIBRARY=C:\Tix4.1\library
+ C:\Tix4.1\win\tcl7.6\tix4176.exe foo.tcl<br>
+ </code></b></blockquote>
+
+<h3> 4. Fixing DLL problems</h3>
+
+ You may run into certain problems related to DLL's when you execute
+ <b>tix4176.exe</b>. For example:
+ <ul>
+ <li> Windows complains that a DLL, usually tcl76.dll, is not found.
+ <li> Windows complains that a symbol is missing.
+ <li> Some weird things happen.
+ </ul>
+
+ When <b>tix4176.exe</b> starts up, it will load in the following DLL's
+ <ul>
+ <li><code><b>tcl76.dll</b></code>
+ <li><code><b>tclpip76.dll</b></code>
+ <li><code><b>tk42.dll</b></code>
+ <li><code><b>tix4176.dll</b></code>
+ </ul>
+
+ Windows searches for a DLL file by the following order:
+ <ol>
+ <li>Same directory as executable.
+ <li>Windows system directory.
+ <li>directories in the PATH environment variable.
+ </ol>
+
+ To ensure that the correct DLLs are loaded, you can copy all the
+ DLL's used by tix4176.exe into the directory where tix4176.exe is. <p>
+
+<h3> 5. Installing Tix</h3>
+
+ You can install Tix into the Tcl installation directory so that you
+ can load Tix with the "package require" command and no longer need
+ to set the TIX_LIBRARY variable: <p>
+ <ol>
+
+ <li> Create a directory <b>tix4.1</b> under the Tcl installation
+ directory, usually in <b>C:\Program Files\Tcl7.6\lib</b>. <p>
+
+ <li> Copy all the files under <b>Tix4.1b1\library</b> into the
+ <b>C:\Program Files\Tcl7.6\lib\tix4.1</b> directory. <p>
+
+ <li> Copy the file <b>Tix4.1\win\pkgIndex.tcl</b> into the
+ <b>C:\Program Files\Tcl7.6\lib\tix4.1</b> directory. <p>
+
+ </ol>
+
+ Now you should be able to start up wish42.exe and execute the
+ following command to load in Tix.
+ <blockquote><b><code>
+ package require -exact Tix [tixBinVer 4.1]
+ </code></b></blockquote>
+
+
+ Read the file <a href="Pkg.txt">Tix4.1\docs\Pkg.txt</a> for more
+ info about dynamically loading Tix.<p>
+
+<!---------------------------------------------------------------------->
+<hr>
+
+<h3> FAQ's for running Tix on Windows</h3>
+
+<DL>
+ <DT> <b>How do I set an environment variable.</b><p>
+ <DD>
+
+ You can set it in your DOS window by typing something like
+ "<b>set TIX_LIBRARY=C:\Tix4.1\win</b>". This will affect that
+ particular DOS window only. If you want the change to affect
+ the whole Windows environment (for example, you want launch
+ <b>txwish41.exe</b> by double-clicking on its icon), you must
+ put the commands in your <b>AUTOEXEC.BAT</b> file and then
+ reboot your machine. <p>
+
+ <DT> <b>I get an "out of environment space" error from DOS.</b><p>
+ <DD>
+
+ Edit your <b>CONFIG.SYS</b> file and add the switch
+ "<b>/E:1024</b>" to the <b>SHELL=COMMAND.COM</b>
+ line. Reboot. This should give you enough env space.<p>
+
+ <DT> <b>My C compiler says "unrecognized file format tk42.lib" or
+ something like that.</b><p>
+
+ <DD>
+ You compiled <b>tk42.lib</b> with VC++ and are compiling Tix
+ with Borland C++, or vice verse. Use the same compiler to
+ compile all binaries.<p>
+</DL>
+
+<!Serial 851729141>
+<hr><i>Last modified Sat Feb 15 21:52:36 EST 1997 </i> ---
+<i>Serial 856069650</i>
diff --git a/tix/docs/WinInst.txt b/tix/docs/WinInst.txt
new file mode 100644
index 00000000000..2c094acf8cd
--- /dev/null
+++ b/tix/docs/WinInst.txt
@@ -0,0 +1,141 @@
+
+ BUILDING THE WINDOWS BINARIES
+
+ To build Tix on Windows, you must have the following:
+
+ * Visual C++ 4.0 or later; or Borland C++ 4.5 or later. There is not
+ yet built-in support for Tix to work with other compilers.
+ * The sources of Tcl/Tk for Windows.
+ * The sources of Tix for Windows.
+
+ 1. DOWNLOAD THE TCL, TK AND TIX SOURCES
+
+ You can download latest version of the Tcl7.5, 7.6 or 8.0 from
+ ftp://ftp.sunlabs.com/pub . There are detailed instructions that
+ comes with these packages about compiling them on Windows. Hopefully
+ that will give you a good exercise on setting up the environment for
+ compiling Tcl-based programs on the Windows platforms.
+
+ You can then get the Tix source distribution at
+ ftp://ftp.xpi.com/pub/Tix41.zip . This ZIP file contains files with
+ long file names and must be unzipped by an UNZIP program that knows
+ long filenames, such as winzip.exe.
+
+ You should put the Tcl, Tk and Tix source packages in the same
+ directory. For example, my directories look like this:
+
+ C:\tcl7.6
+ C:\tk4.2
+ C:\Tix4.1
+
+ 2. COMPILE TCL AND TK
+
+ Follow the instructions that come with Tcl and Tk. If you can compile
+ successfully, you would get the following files:
+
+ C:\tcl7.6\win\tcl76.dll
+ C:\tcl7.6\win\tclpip76.dll
+ C:\tk4.2\win\tk42.dll
+
+ These are the files you need to run Tix on Windows.
+
+ 3. COMPILE TIX
+
+ Change to the Tix4.1\Win subdirectory. Tix supports several versions
+ of Tcl. You choose the version of Tcl to compile Tix with by using the
+ TCL_VER variable:
+ * Tcl 7.5: nmake -f makefile.vc TCL_VER=7.5
+ * Tcl 7.6: nmake -f makefile.vc TCL_VER=7.6
+ * Tcl 8.0: nmake -f makefile.vc TCL_VER=8.0
+ * Itcl 2.2: nmake -f makefile.vc TCL_VER=2.2i
+
+ If you have BC++, use make -f makefile.bc instead.
+
+ When make or nmake finishes, you will get Tix binaries inside the
+ build directories. For example, if you compile Tix for Tcl 7.6, you
+ will be the following files:
+
+ C:\Tix4.1\win\tcl7.6\tix4176.dll
+ C:\Tix4.1\win\tcl7.6\tix4176.exe
+
+ The executable file tix4176.exe contains Tcl, Tk and Tix. You can use
+ it to run an Tix script by:
+
+ set TIX_LIBRARY=C:\Tix4.1\library C:\Tix4.1\win\tcl7.6\tix4176.exe
+ foo.tcl
+
+ 4. FIXING DLL PROBLEMS
+
+ You may run into certain problems related to DLL's when you execute
+ tix4176.exe. For example:
+ * Windows complains that a DLL, usually tcl76.dll, is not found.
+ * Windows complains that a symbol is missing.
+ * Some weird things happen.
+
+ When tix4176.exe starts up, it will load in the following DLL's
+ * tcl76.dll
+ * tclpip76.dll
+ * tk42.dll
+ * tix4176.dll
+
+ Windows searches for a DLL file by the following order:
+ 1. Same directory as executable.
+ 2. Windows system directory.
+ 3. directories in the PATH environment variable.
+
+ To ensure that the correct DLLs are loaded, you can copy all the DLL's
+ used by tix4176.exe into the directory where tix4176.exe is.
+
+ 5. INSTALLING TIX
+
+ You can install Tix into the Tcl installation directory so that you
+ can load Tix with the "package require" command and no longer need to
+ set the TIX_LIBRARY variable:
+
+ 1. Create a directory tix4.1 under the Tcl installation directory,
+ usually in C:\Program Files\Tcl7.6\lib.
+
+ 2. Copy all the files under Tix4.1b1\library into the C:\Program
+ Files\Tcl7.6\lib\tix4.1 directory.
+
+ 3. Copy the file Tix4.1\win\pkgIndex.tcl into the C:\Program
+ Files\Tcl7.6\lib\tix4.1 directory.
+
+ Now you should be able to start up wish42.exe and execute the
+ following command to load in Tix.
+
+ package require -exact Tix [tixBinVer 4.1]
+
+ Read the file Tix4.1\docs\Pkg.txt for more info about dynamically
+ loading Tix.
+
+ _________________________________________________________________
+
+ FAQ'S FOR RUNNING TIX ON WINDOWS
+
+ How do I set an environment variable.
+
+ You can set it in your DOS window by typing something like "set
+ TIX_LIBRARY=C:\Tix4.1\win". This will affect that particular
+ DOS window only. If you want the change to affect the whole
+ Windows environment (for example, you want launch txwish41.exe
+ by double-clicking on its icon), you must put the commands in
+ your AUTOEXEC.BAT file and then reboot your machine.
+
+ I get an "out of environment space" error from DOS.
+
+ Edit your CONFIG.SYS file and add the switch "/E:1024" to the
+ SHELL=COMMAND.COM line. Reboot. This should give you enough
+ env space.
+
+ My C compiler says "unrecognized file format tk42.lib" or something
+ like that.
+
+ You compiled tk42.lib with VC++ and are compiling Tix with
+ Borland C++, or vice verse. Use the same compiler to compile
+ all binaries.
+
+ _________________________________________________________________
+
+ Last modified Sat Feb 15 21:52:36 EST 1997 --- Serial 856069650
+
diff --git a/tix/docs/img/demo1.gif b/tix/docs/img/demo1.gif
new file mode 100644
index 00000000000..f2d9c863651
--- /dev/null
+++ b/tix/docs/img/demo1.gif
Binary files differ
diff --git a/tix/docs/img/setup0.gif b/tix/docs/img/setup0.gif
new file mode 100644
index 00000000000..ca7914e9ad4
--- /dev/null
+++ b/tix/docs/img/setup0.gif
Binary files differ
diff --git a/tix/docs/img/setup1.gif b/tix/docs/img/setup1.gif
new file mode 100644
index 00000000000..bf4260f1ec1
--- /dev/null
+++ b/tix/docs/img/setup1.gif
Binary files differ
diff --git a/tix/docs/img/setup2.gif b/tix/docs/img/setup2.gif
new file mode 100644
index 00000000000..630225074db
--- /dev/null
+++ b/tix/docs/img/setup2.gif
Binary files differ
diff --git a/tix/docs/img/setup3.gif b/tix/docs/img/setup3.gif
new file mode 100644
index 00000000000..8d8dc4025ec
--- /dev/null
+++ b/tix/docs/img/setup3.gif
Binary files differ
diff --git a/tix/docs/img/setup5.gif b/tix/docs/img/setup5.gif
new file mode 100644
index 00000000000..971e692dcb4
--- /dev/null
+++ b/tix/docs/img/setup5.gif
Binary files differ
diff --git a/tix/docs/img/setup6.gif b/tix/docs/img/setup6.gif
new file mode 100644
index 00000000000..5eb04bf515b
--- /dev/null
+++ b/tix/docs/img/setup6.gif
Binary files differ
diff --git a/tix/docs/img/tk42a.gif b/tix/docs/img/tk42a.gif
new file mode 100644
index 00000000000..75a3ec46653
--- /dev/null
+++ b/tix/docs/img/tk42a.gif
Binary files differ
diff --git a/tix/docs/img/tk42b.gif b/tix/docs/img/tk42b.gif
new file mode 100644
index 00000000000..aff76562e11
--- /dev/null
+++ b/tix/docs/img/tk42b.gif
Binary files differ
diff --git a/tix/docs/license.html_lib b/tix/docs/license.html_lib
new file mode 100644
index 00000000000..50e8a812370
--- /dev/null
+++ b/tix/docs/license.html_lib
@@ -0,0 +1,38 @@
+----------------------------------------------------------------------
+COPYRIGHT NOTICE OF THE HTML_LIBRARY SOFTWARE. THE TERM "SOFTWARE"
+SHALL MEAN THE HTML_LIBRARY SOFTWARE ONLY. THIS NOTICE DOES NOT COVER
+THE TIX LIBRARY. SEE THE FILE "license.terms" FOR COPYRIGHT NOTICE AND
+LICENSE TERMS OF THE TIX LIBRARY.
+----------------------------------------------------------------------
+
+Sun Microsystems, Inc. The following terms apply to all files
+associated with the software unless explicitly disclaimed in individual
+files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+RESTRICTED RIGHTS: Use, duplication or disclosure by the government
+is subject to the restrictions as set forth in subparagraph (c) (1) (ii)
+of the Rights in Technical Data and Computer Software Clause as DFARS
+252.227-7013 and FAR 52.227-19.
diff --git a/tix/docs/license.tcltk b/tix/docs/license.tcltk
new file mode 100644
index 00000000000..70ff2d68497
--- /dev/null
+++ b/tix/docs/license.tcltk
@@ -0,0 +1,39 @@
+----------------------------------------------------------------------
+COPYRIGHT NOTICE OF THE TCL/TK SOFTWARE. THE TERM "SOFTWARE" SHALL
+MEAN THE TCL/TK SOFTWARE ONLY. THIS NOTICE DOES NOT COVER THE TIX
+LIBRARY. SEE THE FILE "license.terms" FOR COPYRIGHT NOTICE AND LICENSE
+TERMS OF THE TIX LIBRARY.
+----------------------------------------------------------------------
+
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., and other parties. The following
+terms apply to all files associated with the software unless explicitly
+disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+RESTRICTED RIGHTS: Use, duplication or disclosure by the government
+is subject to the restrictions as set forth in subparagraph (c) (1) (ii)
+of the Rights in Technical Data and Computer Software Clause as DFARS
+252.227-7013 and FAR 52.227-19.
diff --git a/tix/generic/tix.h b/tix/generic/tix.h
new file mode 100644
index 00000000000..31c9f7f4e47
--- /dev/null
+++ b/tix/generic/tix.h
@@ -0,0 +1,467 @@
+/*
+ * tix.h --
+ *
+ * This is the standard header file for all tix C code. It
+ * defines many macros and utility functions to make it easier to
+ * write TCL commands and TK widgets in C. No more needs to write
+ * 2000 line functions!
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#ifndef _TIX_H_
+#define _TIX_H_
+
+#ifndef TIX_VERSION
+#define TIX_VERSION "4.1"
+#endif
+#define TIX_PATCHLEVEL "4.1.0"
+#define TIX_PATCH_LEVEL TIX_PATCHLEVEL
+
+#define TIX_RELEASE "4.1.0.005"
+
+#ifndef RC_INVOKED
+
+#ifndef _TCL
+#include <tcl.h>
+#endif
+
+#ifndef _TK
+#include <tk.h>
+#endif
+
+
+#if defined(__WIN32__) || defined(_WIN32) || defined (__BORLAND) || defined(_Windows)
+#ifndef _WINDOWS
+#define _WINDOWS
+#endif
+#endif
+
+#ifdef BUILD_tix
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+#if (TCL_MAJOR_VERSION > 7)
+# define TCL_7_5_OR_LATER
+#else
+# if ((TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION >= 5))
+# define TCL_7_5_OR_LATER
+# endif
+#endif
+
+
+#if (TK_MAJOR_VERSION > 4)
+# define TK_4_1_OR_LATER
+#else
+# if ((TK_MAJOR_VERSION == 4) && (TK_MINOR_VERSION >= 1))
+# define TK_4_1_OR_LATER
+# endif
+#endif /* TK_MAJOR_VERSION ... */
+
+#if (TK_MAJOR_VERSION >= 8)
+# define TK_8_0_OR_LATER
+#endif
+
+#ifdef TK_4_1_OR_LATER
+ /* TK 4.1 or later */
+# define Tix_FreeProc Tcl_FreeProc
+
+#else
+ /* TK 4.0 */
+# define Tix_FreeProc Tk_FreeProc
+
+ /* These portable features were not defined in previous versions of
+ * TK but are used in Tix. Let's define them here.
+ */
+# define TkPutImage(a, b, c, d, e, f, g, h, i, j, k, l) \
+ XPutImage(c, d, e, f, g, h, i, j, k, l)
+
+# define TkStringToKeysym XStringToKeysym
+
+#endif /* TK_4_1_OR_LATER */
+
+
+#define TIX_STDIN_ALWAYS 0
+#define TIX_STDIN_OPTIONAL 1
+#define TIX_STDIN_NONE 2
+
+typedef struct {
+ char *name; /* Name of command. */
+ int (*cmdProc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp,
+ int argc, char **argv));
+ /* Command procedure. */
+} Tix_TclCmd;
+
+
+/*----------------------------------------------------------------------
+ *
+ *
+ * SUB-COMMAND HANDLING
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+typedef int (*Tix_CmdProc) _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char ** argv));
+typedef int (*Tix_SubCmdProc) _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char ** argv));
+typedef int (*Tix_CheckArgvProc) _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char ** argv));
+
+typedef struct _Tix_CmdInfo {
+ int numSubCmds;
+ int minargc;
+ int maxargc;
+ char * info;
+} Tix_CmdInfo;
+
+typedef struct _Tix_SubCmdInfo {
+ int namelen;
+ char * name;
+ int minargc;
+ int maxargc;
+ Tix_SubCmdProc proc;
+ char * info;
+ Tix_CheckArgvProc checkArgvProc;
+} Tix_SubCmdInfo;
+
+/*
+ * Tix_ArraySize --
+ *
+ * Find out the number of elements inside a C array. The argument "x"
+ * must be a valid C array. Pointers don't work.
+ */
+#define Tix_ArraySize(x) (sizeof(x) / sizeof(x[0]))
+
+/*
+ * This is used for Tix_CmdInfo.maxargc and Tix_SubCmdInfo.maxargc,
+ * indicating that this command takes a variable number of arguments.
+ */
+#define TIX_VAR_ARGS -1
+
+/*
+ * TIX_DEFAULT_LEN --
+ *
+ * Use this for Tix_SubCmdInfo.namelen and Tix_ExecSubCmds() will try to
+ * determine the length of the subcommand name for you.
+ */
+#define TIX_DEFAULT_LEN -1
+
+/*
+ * TIX_DEFAULT_SUB_CMD --
+ *
+ * Use this for Tix_SubCmdInfo.name. This will match any subcommand name,
+ * including the empty string, when Tix_ExecSubCmds() finds a subcommand
+ * to execute.
+ */
+#define TIX_DEFAULT_SUBCMD 0
+
+/*
+ * TIX_DECLARE_CMD --
+ *
+ * This is just a handy macro to declare a C function to use as a
+ * command function.
+ */
+#define TIX_DECLARE_CMD(func) \
+ int func _ANSI_ARGS_((ClientData clientData,\
+ Tcl_Interp *interp, int argc, char ** argv))
+
+/*
+ * TIX_DECLARE_SUBCMD --
+ *
+ * This is just a handy macro to declare a C function to use as a
+ * sub command function.
+ */
+#define TIX_DECLARE_SUBCMD(func) \
+ int func _ANSI_ARGS_((ClientData clientData,\
+ Tcl_Interp *interp, int argc, char ** argv))
+
+/*
+ * TIX_DEFINE_CMD --
+ *
+ * This is just a handy macro to define a C function to use as a
+ * command function.
+ */
+#define TIX_DEFINE_CMD(func) \
+int func(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. */
+
+
+/*----------------------------------------------------------------------
+ * Link-list functions --
+ *
+ * These functions makes it easy to use link lists in C code.
+ *
+ *----------------------------------------------------------------------
+ */
+typedef struct Tix_ListInfo {
+ int nextOffset; /* offset of the "next" pointer in a list
+ * item */
+ int prevOffset; /* offset of the "next" pointer in a list
+ * item */
+} Tix_ListInfo;
+
+
+/* Singly-linked list */
+typedef struct Tix_LinkList {
+ int numItems; /* number of items in this list */
+ char * head; /* (general pointer) head of the list */
+ char * tail; /* (general pointer) tail of the list */
+} Tix_LinkList;
+
+typedef struct Tix_ListIterator {
+ char * last;
+ char * curr;
+ unsigned int started : 1; /* True if the search operation has
+ * already started for this list */
+ unsigned int deleted : 1; /* True if a delete operation has been
+ * performed on the current item (in this
+ * case the curr pointer has already been
+ * adjusted
+ */
+} Tix_ListIterator;
+
+#define Tix_IsLinkListEmpty(list) ((list.numItems) == 0)
+#define TIX_UNIQUE 1
+#define TIX_UNDEFINED -1
+
+/*----------------------------------------------------------------------
+ * General Single Link List --
+ *
+ * The next pointer can be anywhere inside a link.
+ *----------------------------------------------------------------------
+ */
+
+EXTERN void Tix_LinkListInit _ANSI_ARGS_((Tix_LinkList * lPtr));
+EXTERN void Tix_LinkListAppend _ANSI_ARGS_((Tix_ListInfo * infoPtr,
+ Tix_LinkList * lPtr, char * itemPtr, int flags));
+EXTERN void Tix_LinkListStart _ANSI_ARGS_((Tix_ListInfo * infoPtr,
+ Tix_LinkList * lPtr, Tix_ListIterator * liPtr));
+EXTERN void Tix_LinkListNext _ANSI_ARGS_((Tix_ListInfo * infoPtr,
+ Tix_LinkList * lPtr, Tix_ListIterator * liPtr));
+EXTERN void Tix_LinkListDelete _ANSI_ARGS_((Tix_ListInfo * infoPtr,
+ Tix_LinkList * lPtr, Tix_ListIterator * liPtr));
+EXTERN int Tix_LinkListDeleteRange _ANSI_ARGS_((
+ Tix_ListInfo * infoPtr, Tix_LinkList * lPtr,
+ char * fromPtr, char * toPtr,
+ Tix_ListIterator * liPtr));
+EXTERN int Tix_LinkListFind _ANSI_ARGS_((
+ Tix_ListInfo * infoPtr, Tix_LinkList * lPtr,
+ char * itemPtr, Tix_ListIterator * liPtr));
+EXTERN int Tix_LinkListFindAndDelete _ANSI_ARGS_((
+ Tix_ListInfo * infoPtr, Tix_LinkList * lPtr,
+ char * itemPtr, Tix_ListIterator * liPtr));
+EXTERN void Tix_LinkListInsert _ANSI_ARGS_((
+ Tix_ListInfo * infoPtr,
+ Tix_LinkList * lPtr, char * itemPtr,
+ Tix_ListIterator * liPtr));
+EXTERN void Tix_LinkListIteratorInit _ANSI_ARGS_((
+ Tix_ListIterator * liPtr));
+
+#define Tix_LinkListDone(liPtr) ((liPtr)->curr == NULL)
+
+
+/*----------------------------------------------------------------------
+ * Simple Single Link List --
+ *
+ * The next pointer is always offset 0 in the link structure.
+ *----------------------------------------------------------------------
+ */
+
+EXTERN void Tix_SimpleListInit _ANSI_ARGS_((Tix_LinkList * lPtr));
+EXTERN void Tix_SimpleListAppend _ANSI_ARGS_((
+ Tix_LinkList * lPtr, char * itemPtr, int flags));
+EXTERN void Tix_SimpleListStart _ANSI_ARGS_((
+ Tix_LinkList * lPtr, Tix_ListIterator * liPtr));
+EXTERN void Tix_SimpleListNext _ANSI_ARGS_((
+ Tix_LinkList * lPtr, Tix_ListIterator * liPtr));
+EXTERN void Tix_SimpleListDelete _ANSI_ARGS_((
+ Tix_LinkList * lPtr, Tix_ListIterator * liPtr));
+EXTERN int Tix_SimpleListDeleteRange _ANSI_ARGS_((
+ Tix_LinkList * lPtr,
+ char * fromPtr, char * toPtr,
+ Tix_ListIterator * liPtr));
+EXTERN int Tix_SimpleListFind _ANSI_ARGS_((
+ Tix_LinkList * lPtr,
+ char * itemPtr, Tix_ListIterator * liPtr));
+EXTERN int Tix_SimpleListFindAndDelete _ANSI_ARGS_((
+ Tix_LinkList * lPtr, char * itemPtr,
+ Tix_ListIterator * liPtr));
+EXTERN void Tix_SimpleListInsert _ANSI_ARGS_((
+ Tix_LinkList * lPtr, char * itemPtr,
+ Tix_ListIterator * liPtr));
+EXTERN void Tix_SimpleListIteratorInit _ANSI_ARGS_((
+ Tix_ListIterator * liPtr));
+
+#define Tix_SimpleListDone(liPtr) ((liPtr)->curr == NULL)
+
+/*----------------------------------------------------------------------
+ *
+ *
+ *
+ * CUSTOM CONFIG OPTIONS
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+#define TIX_RELIEF_RAISED 1
+#define TIX_RELIEF_FLAT 2
+#define TIX_RELIEF_SUNKEN 4
+#define TIX_RELIEF_GROOVE 8
+#define TIX_RELIEF_RIDGE 16
+#define TIX_RELIEF_SOLID 32
+
+typedef int Tix_Relief;
+
+extern Tk_CustomOption tixConfigItemType;
+extern Tk_CustomOption tixConfigItemStyle;
+extern Tk_CustomOption tixConfigRelief;
+
+/*
+ * C functions exported by Tix
+ */
+
+EXTERN int Tix_ArgcError _ANSI_ARGS_((Tcl_Interp *interp,
+ int argc, char ** argv, int prefixCount,
+ char *message));
+EXTERN void Tix_CreateCommands _ANSI_ARGS_((
+ Tcl_Interp *interp, Tix_TclCmd *commands,
+ ClientData clientData,
+ Tcl_CmdDeleteProc *deleteProc));
+EXTERN Tk_Window Tix_CreateSubWindow _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Window tkwin,
+ char * subPath));
+EXTERN int Tix_DefinePixmap _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Uid name, char **data));
+EXTERN void Tix_DrawAnchorLines _ANSI_ARGS_((
+ Display *display, Drawable drawable,
+ GC gc, int x, int y, int w, int h));
+EXTERN int Tix_EvalArgv _ANSI_ARGS_((
+ Tcl_Interp * interp, int argc, char ** argv));
+EXTERN int Tix_ExistMethod _ANSI_ARGS_((Tcl_Interp *interp,
+ char *context, char *method));
+EXTERN void Tix_Exit _ANSI_ARGS_((Tcl_Interp * interp, int code));
+EXTERN Pixmap Tix_GetRenderBuffer _ANSI_ARGS_((Display *display,
+ Drawable d, int width, int height, int depth));
+
+#ifdef TCL_VARARGS
+/*
+ * The TCL_VARARGS macro is only defined in Tcl 7.5 or later
+ */
+EXTERN int Tix_GlobalVarEval _ANSI_ARGS_(
+ TCL_VARARGS(Tcl_Interp *,interp));
+#else
+EXTERN int Tix_GlobalVarEval _ANSI_ARGS_(
+ VARARGS(Tcl_Interp *interp));
+#endif
+
+EXTERN int Tix_HandleSubCmds _ANSI_ARGS_((
+ Tix_CmdInfo * cmdInfo,
+ Tix_SubCmdInfo * subCmdInfo,
+ ClientData clientData, Tcl_Interp *interp,
+ int argc, char **argv));
+EXTERN int Tix_Init _ANSI_ARGS_((Tcl_Interp *interp));
+
+EXTERN int Tix_LoadTclLibrary _ANSI_ARGS_((
+ Tcl_Interp *interp, char *envName,
+ char *tclName, char *initFile,
+ char *defDir, char * appName));
+EXTERN void Tix_OpenStdin _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void Tix_SetArgv _ANSI_ARGS_((Tcl_Interp *interp,
+ int argc, char **argv));
+EXTERN void Tix_SetRcFileName _ANSI_ARGS_((
+ Tcl_Interp * interp, char * rcFileName));
+
+
+/*
+ * Commands exported by Tix
+ *
+ */
+
+extern TIX_DECLARE_CMD(Tix_CallMethodCmd);
+extern TIX_DECLARE_CMD(Tix_ChainMethodCmd);
+extern TIX_DECLARE_CMD(Tix_ClassCmd);
+extern TIX_DECLARE_CMD(Tix_DoWhenIdleCmd);
+extern TIX_DECLARE_CMD(Tix_DoWhenMappedCmd);
+extern TIX_DECLARE_CMD(Tix_FalseCmd);
+extern TIX_DECLARE_CMD(Tix_FileCmd);
+extern TIX_DECLARE_CMD(Tix_FlushXCmd);
+extern TIX_DECLARE_CMD(Tix_FormCmd);
+extern TIX_DECLARE_CMD(Tix_GridCmd);
+extern TIX_DECLARE_CMD(Tix_GeometryRequestCmd);
+extern TIX_DECLARE_CMD(Tix_Get3DBorderCmd);
+extern TIX_DECLARE_CMD(Tix_GetBooleanCmd);
+extern TIX_DECLARE_CMD(Tix_GetIntCmd);
+extern TIX_DECLARE_CMD(Tix_GetMethodCmd);
+extern TIX_DECLARE_CMD(Tix_HListCmd);
+extern TIX_DECLARE_CMD(Tix_HandleOptionsCmd);
+extern TIX_DECLARE_CMD(Tix_InputOnlyCmd);
+extern TIX_DECLARE_CMD(Tix_ItemStyleCmd);
+extern TIX_DECLARE_CMD(Tix_ManageGeometryCmd);
+extern TIX_DECLARE_CMD(Tix_MapWindowCmd);
+extern TIX_DECLARE_CMD(Tix_MoveResizeWindowCmd);
+extern TIX_DECLARE_CMD(Tix_NoteBookFrameCmd);
+extern TIX_DECLARE_CMD(Tix_RaiseWindowCmd);
+extern TIX_DECLARE_CMD(Tix_ShellInputCmd);
+extern TIX_DECLARE_CMD(Tix_StringSubCmd);
+extern TIX_DECLARE_CMD(Tix_StrEqCmd);
+extern TIX_DECLARE_CMD(Tix_TListCmd);
+extern TIX_DECLARE_CMD(Tix_TmpLineCmd);
+extern TIX_DECLARE_CMD(Tix_TrueCmd);
+extern TIX_DECLARE_CMD(Tix_UnmapWindowCmd);
+extern TIX_DECLARE_CMD(Tix_MwmCmd);
+extern TIX_DECLARE_CMD(Tix_CreateWidgetCmd);
+
+#define SET_RECORD(interp, record, var, value) \
+ Tcl_SetVar2(interp, record, var, value, TCL_GLOBAL_ONLY)
+
+#define GET_RECORD(interp, record, var) \
+ Tcl_GetVar2(interp, record, var, TCL_GLOBAL_ONLY)
+
+
+#define TIX_HASHKEY(k) ((sizeof(k)>sizeof(int))?((char*)&(k)):((char*)(k)))
+
+/*----------------------------------------------------------------------
+ * Compatibility section
+ *---------------------------------------------------------------------- */
+
+EXTERN char * tixStrDup _ANSI_ARGS_((
+ CONST char * s));
+
+#ifdef _WINDOWS
+#ifndef NO_STRCASECMP
+#define NO_STRCASECMP 1
+#endif
+#endif
+
+#if defined(NO_STRCASECMP)
+# ifndef strcasecmp
+# define strcasecmp tixStrCaseCmp
+# endif
+extern int tixStrCaseCmp _ANSI_ARGS_((CONST char *s1,
+ CONST char *s2));
+#endif
+
+
+#ifdef __cplusplus
+}
+#endif
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* RC_INVOKED */
+#endif /* _TIX_H_ */
diff --git a/tix/generic/tixBitmaps.h b/tix/generic/tixBitmaps.h
new file mode 100644
index 00000000000..4a69e9ab936
--- /dev/null
+++ b/tix/generic/tixBitmaps.h
@@ -0,0 +1,615 @@
+{
+#define maximize_width 15
+#define maximize_height 15
+static UNSIGNED_CHAR maximize_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0xfc, 0x1f, 0x04, 0x10, 0x04, 0x70, 0x04, 0x70,
+ 0x04, 0x70, 0x04, 0x70, 0x04, 0x70, 0x04, 0x70, 0x04, 0x70, 0x04, 0x70,
+ 0xfc, 0x7f, 0xf0, 0x7f, 0xf0, 0x7f};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("maximize"), (char*)maximize_bits, maximize_width, maximize_height);
+}
+{
+#define act_fold_width 16
+#define act_fold_height 10
+static UNSIGNED_CHAR act_fold_bits[] = {
+ 0xfc, 0x00, 0xaa, 0x0f, 0x55, 0x15, 0xeb, 0xff, 0x15, 0x80, 0x0b, 0x40,
+ 0x05, 0x20, 0x03, 0x10, 0x01, 0x08, 0xff, 0x07};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("act_fold"), (char*)act_fold_bits, act_fold_width, act_fold_height);
+}
+{
+/* XPM */
+static char * act_fold_xpm[] = {
+/* width height num_colors chars_per_pixel */
+"16 12 4 1",
+/* colors */
+" s None c None",
+". c black",
+"X c yellow",
+"o c #5B5B57574646",
+/* pixels */
+" .... ",
+" .XXXX. ",
+" .XXXXXX. ",
+"............. ",
+".oXoXoXoXoXo. ",
+".XoX............",
+".oX.XXXXXXXXXXX.",
+".Xo.XXXXXXXXXX. ",
+".o.XXXXXXXXXXX. ",
+".X.XXXXXXXXXXX. ",
+"..XXXXXXXXXX.. ",
+"............. "};
+Tix_DefinePixmap(Et_Interp, Tk_GetUid("act_fold"), act_fold_xpm);
+}
+{
+#define balarrow_width 6
+#define balarrow_height 6
+static UNSIGNED_CHAR balarrow_bits[] = {
+ 0x1f, 0x07, 0x07, 0x09, 0x11, 0x20};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("balarrow"), (char*)balarrow_bits, balarrow_width, balarrow_height);
+}
+{
+#define cbxarrow_width 11
+#define cbxarrow_height 14
+static UNSIGNED_CHAR cbxarrow_bits[] = {
+ 0x00, 0x00, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00,
+ 0xfe, 0x03, 0xfc, 0x01, 0xf8, 0x00, 0x70, 0x00, 0x20, 0x00, 0x00, 0x00,
+ 0xfe, 0x03, 0xfe, 0x03};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("cbxarrow"), (char*)cbxarrow_bits, cbxarrow_width, cbxarrow_height);
+}
+{
+#define ck_def_width 13
+#define ck_def_height 13
+static UNSIGNED_CHAR ck_def_bits[] = {
+ 0xff, 0x1f, 0x01, 0x10, 0x55, 0x15, 0x01, 0x10, 0x55, 0x15, 0x01, 0x10,
+ 0x55, 0x15, 0x01, 0x10, 0x55, 0x15, 0x01, 0x10, 0x55, 0x15, 0x01, 0x10,
+ 0xff, 0x1f};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("ck_def"), (char*)ck_def_bits, ck_def_width, ck_def_height);
+}
+{
+#define ck_off_width 13
+#define ck_off_height 13
+static UNSIGNED_CHAR ck_off_bits[] = {
+ 0xff, 0x1f, 0x01, 0x10, 0x01, 0x10, 0x01, 0x10, 0x01, 0x10, 0x01, 0x10,
+ 0x01, 0x10, 0x01, 0x10, 0x01, 0x10, 0x01, 0x10, 0x01, 0x10, 0x01, 0x10,
+ 0xff, 0x1f};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("ck_off"), (char*)ck_off_bits, ck_off_width, ck_off_height);
+}
+{
+#define ck_on_width 13
+#define ck_on_height 13
+static UNSIGNED_CHAR ck_on_bits[] = {
+ 0xff, 0x1f, 0x01, 0x10, 0x01, 0x10, 0x01, 0x14, 0x01, 0x16, 0x01, 0x17,
+ 0x89, 0x13, 0xdd, 0x11, 0xf9, 0x10, 0x71, 0x10, 0x21, 0x10, 0x01, 0x10,
+ 0xff, 0x1f};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("ck_on"), (char*)ck_on_bits, ck_on_width, ck_on_height);
+}
+{
+#define cross_width 14
+#define cross_height 14
+static UNSIGNED_CHAR cross_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x06, 0x18, 0x0e, 0x1c, 0x1c, 0x0e, 0x38, 0x07,
+ 0xf0, 0x03, 0xe0, 0x01, 0xe0, 0x01, 0xf0, 0x03, 0x38, 0x07, 0x1c, 0x0e,
+ 0x0e, 0x1c, 0x06, 0x18};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("cross"), (char*)cross_bits, cross_width, cross_height);
+}
+{
+#define decr_width 7
+#define decr_height 4
+static UNSIGNED_CHAR decr_bits[] = {
+ 0x7f, 0x3e, 0x1c, 0x08};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("decr"), (char*)decr_bits, decr_width, decr_height);
+}
+{
+#define drop_width 16
+#define drop_height 16
+#define drop_x_hot 6
+#define drop_y_hot 4
+static UNSIGNED_CHAR drop_bits[] = {
+ 0x00, 0x00, 0xfe, 0x07, 0x02, 0x04, 0x02, 0x04, 0x42, 0x04, 0xc2, 0x04,
+ 0xc2, 0x05, 0xc2, 0x07, 0xc2, 0x07, 0xc2, 0x0f, 0xfe, 0x1f, 0xc0, 0x07,
+ 0xc0, 0x06, 0x00, 0x0c, 0x00, 0x1c, 0x00, 0x08};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("drop"), (char*)drop_bits, drop_width, drop_height);
+}
+{
+#define file_width 12
+#define file_height 12
+static UNSIGNED_CHAR file_bits[] = {
+ 0xfe, 0x00, 0x02, 0x03, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02,
+ 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0xfe, 0x03};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("file"), (char*)file_bits, file_width, file_height);
+}
+{
+/* XPM */
+static char * file_xpm[] = {
+"12 12 3 1",
+" s None c None",
+". c black",
+"X c #FFFFFFFFF3CE",
+" ........ ",
+" .XXXXXX. ",
+" .XXXXXX... ",
+" .XXXXXXXX. ",
+" .XXXXXXXX. ",
+" .XXXXXXXX. ",
+" .XXXXXXXX. ",
+" .XXXXXXXX. ",
+" .XXXXXXXX. ",
+" .XXXXXXXX. ",
+" .XXXXXXXX. ",
+" .......... "};
+Tix_DefinePixmap(Et_Interp, Tk_GetUid("file"), file_xpm);
+}
+{
+#define folder_width 16
+#define folder_height 10
+static UNSIGNED_CHAR folder_bits[] = {
+ 0xfc, 0x00, 0x02, 0x07, 0x01, 0x08, 0x01, 0x08, 0x01, 0x08, 0x01, 0x08,
+ 0x01, 0x08, 0x01, 0x08, 0x01, 0x08, 0xff, 0x07};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("folder"), (char*)folder_bits, folder_width, folder_height);
+}
+{
+/* XPM */
+static char * folder_foo_xpm[] = {
+/* width height num_colors chars_per_pixel */
+"16 12 3 1",
+/* colors */
+" s None c None",
+". c black",
+"X c #f0ff80",
+/* pixels */
+" .... ",
+" .XXXX. ",
+" .XXXXXX. ",
+"............. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+"............. "};
+Tix_DefinePixmap(Et_Interp, Tk_GetUid("folder"), folder_foo_xpm);
+}
+{
+#define harddisk_width 32
+#define harddisk_height 32
+static UNSIGNED_CHAR harddisk_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0xf8, 0xff, 0xff, 0x1f, 0x08, 0x00, 0x00, 0x18, 0xa8, 0xaa, 0xaa, 0x1a,
+ 0x48, 0x55, 0xd5, 0x1d, 0xa8, 0xaa, 0xaa, 0x1b, 0x48, 0x55, 0x55, 0x1d,
+ 0xa8, 0xfa, 0xaf, 0x1a, 0xc8, 0xff, 0xff, 0x1d, 0xa8, 0xfa, 0xaf, 0x1a,
+ 0x48, 0x55, 0x55, 0x1d, 0xa8, 0xaa, 0xaa, 0x1a, 0x48, 0x55, 0x55, 0x1d,
+ 0xa8, 0xaa, 0xaa, 0x1a, 0xf8, 0xff, 0xff, 0x1f, 0xf8, 0xff, 0xff, 0x1f,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("harddisk"), (char*)harddisk_bits, harddisk_width, harddisk_height);
+}
+{
+#define hourglass_width 32
+#define hourglas_height 32
+#define hourglas_x_hot 16
+#define hourglas_y_hot 15
+static UNSIGNED_CHAR hourglas_bits[] = {
+ 0xfe, 0xff, 0xff, 0xff, 0xfe, 0xff, 0xff, 0xff, 0xfe, 0xff, 0xff, 0xff,
+ 0x7c, 0x00, 0x00, 0x7c, 0x7c, 0x00, 0x00, 0x7c, 0x7c, 0x00, 0x00, 0x7c,
+ 0xfc, 0x00, 0x00, 0x7e, 0xfc, 0x00, 0x00, 0x7e, 0xfc, 0x00, 0x00, 0x7e,
+ 0xbc, 0x01, 0x00, 0x7b, 0xbc, 0xfd, 0x7e, 0x7b, 0x3c, 0xfb, 0xbf, 0x79,
+ 0x3c, 0xe6, 0xcf, 0x78, 0x3c, 0xdc, 0x77, 0x78, 0x3c, 0x38, 0x39, 0x78,
+ 0x3c, 0x60, 0x0d, 0x78, 0x3c, 0x38, 0x38, 0x78, 0x3c, 0x1c, 0x71, 0x78,
+ 0x3c, 0x06, 0xc1, 0x78, 0x3c, 0x03, 0x80, 0x79, 0xbc, 0x01, 0x00, 0x7b,
+ 0xbc, 0x01, 0x00, 0x7b, 0xfc, 0x00, 0x01, 0x7e, 0xfc, 0x00, 0x01, 0x7e,
+ 0xfc, 0x80, 0x03, 0x7e, 0x7c, 0xc0, 0x07, 0x7c, 0x7c, 0xf0, 0x1f, 0x7c,
+ 0x7c, 0xfe, 0xff, 0x7c, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0xff,
+ 0xfe, 0xff, 0xff, 0xff, 0xfe, 0xff, 0xff, 0xff};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("hourglas"), (char*)hourglas_bits, hourglass_width, hourglas_height);
+}
+{
+#define incr_width 7
+#define incr_height 4
+static UNSIGNED_CHAR incr_bits[] = {
+ 0x08, 0x1c, 0x3e, 0x7f};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("incr"), (char*)incr_bits, incr_width, incr_height);
+}
+{
+/* XPM */
+static char * info_xpm[] = {
+"32 32 3 1",
+" s None c None",
+". c #000000000000",
+"X c white",
+" ",
+" ......... ",
+" ...XXXXXXXXX... ",
+" .XXXXXXXXXXXXXXX. ",
+" ..XXXXXXXXXXXXXXXXX.. ",
+" .XXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXX...XXXXXXXXXX. ",
+" .XXXXXXXXX.....XXXXXXXXX. ",
+" .XXXXXXXXX.......XXXXXXXXX. ",
+" .XXXXXXXXXX.......XXXXXXXXXX. ",
+" .XXXXXXXXXX.......XXXXXXXXXX. ",
+" .XXXXXXXXXXX.....XXXXXXXXXXX. ",
+".XXXXXXXXXXXXX...XXXXXXXXXXXXX. ",
+".XXXXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+".XXXXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+" .XXXXXXXXXX.......XXXXXXXXXX. ",
+" .XXXXXXXXXX.......XXXXXXXXXX. ",
+" .XXXXXXXXXX.......XXXXXXXXXX. ",
+" .XXXXXXXXX.......XXXXXXXXX. ",
+" .XXXXXXXX.......XXXXXXXX. ",
+" .XXXXXXXX.......XXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXX. ",
+" ..XXXXXXXXXXXXXXXXX.. ",
+" .XXXXXXXXXXXXXXX. ",
+" ...XXXXXXXXX... ",
+" ......... "};
+Tix_DefinePixmap(Et_Interp, Tk_GetUid("info"), info_xpm);
+}
+{
+#define minimize_width 15
+#define minimize_height 15
+static UNSIGNED_CHAR minimize_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x01,
+ 0x20, 0x03, 0x20, 0x03, 0xe0, 0x03, 0xc0, 0x03, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("minimize"), (char*)minimize_bits, minimize_width, minimize_height);
+}
+{
+#define minus_width 9
+#define minus_height 9
+static UNSIGNED_CHAR minus_bits[] = {
+ 0xff, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x7d, 0x01, 0x01, 0x01,
+ 0x01, 0x01, 0x01, 0x01, 0xff, 0x01};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("minus"), (char*)minus_bits, minus_width, minus_height);
+}
+{
+/* XPM */
+static char * minus_xpm[] = {
+"9 9 2 1",
+". s None c None",
+" c black",
+" ",
+" ....... ",
+" ....... ",
+" ....... ",
+" . . ",
+" ....... ",
+" ....... ",
+" ....... ",
+" "};
+Tix_DefinePixmap(Et_Interp, Tk_GetUid("minus"), minus_xpm);
+}
+{
+#define minusarm_width 9
+#define minusarm_height 9
+static UNSIGNED_CHAR minusarm_bits[] = {
+ 0xff, 0x01, 0x01, 0x01, 0x7d, 0x01, 0x7d, 0x01, 0x01, 0x01, 0x7d, 0x01,
+ 0x7d, 0x01, 0x01, 0x01, 0xff, 0x01};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("minusarm"), (char*)minusarm_bits, minusarm_width, minusarm_height);
+}
+{
+/* XPM */
+static char * minusarm_xpm[] = {
+"9 9 3 1",
+" c black",
+". c yellow",
+"X c #808080808080",
+" ",
+" ....... ",
+" ....... ",
+" .XXXXX. ",
+" .X X. ",
+" .XXXXX. ",
+" ....... ",
+" ....... ",
+" "};
+Tix_DefinePixmap(Et_Interp, Tk_GetUid("minusarm"), minusarm_xpm);
+}
+{
+#define network_width 32
+#define network_height 32
+static UNSIGNED_CHAR network_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x7f, 0x00, 0x00, 0x02, 0x40,
+ 0x00, 0x00, 0xfa, 0x5f, 0x00, 0x00, 0x0a, 0x50, 0x00, 0x00, 0x0a, 0x52,
+ 0x00, 0x00, 0x0a, 0x52, 0x00, 0x00, 0x8a, 0x51, 0x00, 0x00, 0x0a, 0x50,
+ 0x00, 0x00, 0x4a, 0x50, 0x00, 0x00, 0x0a, 0x50, 0x00, 0x00, 0x0a, 0x50,
+ 0x00, 0x00, 0xfa, 0x5f, 0x00, 0x00, 0x02, 0x40, 0xfe, 0x7f, 0x52, 0x55,
+ 0x02, 0x40, 0xaa, 0x6a, 0xfa, 0x5f, 0xfe, 0x7f, 0x0a, 0x50, 0xfe, 0x7f,
+ 0x0a, 0x52, 0x80, 0x00, 0x0a, 0x52, 0x80, 0x00, 0x8a, 0x51, 0x80, 0x00,
+ 0x0a, 0x50, 0x80, 0x00, 0x4a, 0x50, 0x80, 0x00, 0x0a, 0x50, 0xe0, 0x03,
+ 0x0a, 0x50, 0x20, 0x02, 0xfa, 0xdf, 0x3f, 0x03, 0x02, 0x40, 0xa0, 0x02,
+ 0x52, 0x55, 0xe0, 0x03, 0xaa, 0x6a, 0x00, 0x00, 0xfe, 0x7f, 0x00, 0x00,
+ 0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("network"), (char*)network_bits, network_width, network_height);
+}
+{
+/* XPM */
+static char * no_entry_xpm[] = {
+"32 32 4 1",
+" s None c None",
+". c #000000000000",
+"X c red",
+"o c yellow",
+" ",
+" ......... ",
+" ...XXXXXXXXX... ",
+" .XXXXXXXXXXXXXXX. ",
+" ..XXXXXXXXXXXXXXXXX.. ",
+" .XXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+".XXXXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+".XXX.......................XXX. ",
+".XXX.ooooooooooooooooooooo.XXX. ",
+".XXX.ooooooooooooooooooooo.XXX. ",
+".XXX.ooooooooooooooooooooo.XXX. ",
+".XXX.ooooooooooooooooooooo.XXX. ",
+".XXX.ooooooooooooooooooooo.XXX. ",
+".XXX.ooooooooooooooooooooo.XXX. ",
+".XXX.......................XXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXX. ",
+" ..XXXXXXXXXXXXXXXXX.. ",
+" .XXXXXXXXXXXXXXX. ",
+" ...XXXXXXXXX... ",
+" ......... "};
+Tix_DefinePixmap(Et_Interp, Tk_GetUid("no_entry"), no_entry_xpm);
+}
+{
+#define openfile_width 16
+#define openfile_height 10
+static UNSIGNED_CHAR openfile_bits[] = {
+ 0xf8, 0x01, 0x04, 0x06, 0x02, 0x08, 0x02, 0x10, 0xe2, 0xff, 0x52, 0x55,
+ 0xaa, 0x2a, 0x56, 0x15, 0xaa, 0x0a, 0xfe, 0x07};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("openfile"), (char*)openfile_bits, openfile_width, openfile_height);
+}
+{
+#define openfold_width 16
+#define openfold_height 10
+static UNSIGNED_CHAR openfold_bits[] = {
+ 0xfc, 0x00, 0x02, 0x07, 0x01, 0x08, 0xc1, 0xff, 0x21, 0x80, 0x11, 0x40,
+ 0x09, 0x20, 0x05, 0x10, 0x03, 0x08, 0xff, 0x07};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("openfold"), (char*)openfold_bits, openfold_width, openfold_height);
+}
+{
+/* XPM */
+static char * openfolder_xpm[] = {
+/* width height num_colors chars_per_pixel */
+"16 12 3 1",
+/* colors */
+" s None c None",
+". c black",
+"X c #f0ff80",
+/* pixels */
+" .... ",
+" .XXXX. ",
+" .XXXXXX. ",
+"............. ",
+".XXXXXXXXXXX. ",
+".XXX............",
+".XX.XXXXXXXXXXX.",
+".XX.XXXXXXXXXX. ",
+".X.XXXXXXXXXXX. ",
+".X.XXXXXXXXXXX. ",
+"..XXXXXXXXXX.. ",
+"............. "};
+Tix_DefinePixmap(Et_Interp, Tk_GetUid("openfold"), openfolder_xpm);
+}
+{
+#define plus_width 9
+#define plus_height 9
+static UNSIGNED_CHAR plus_bits[] = {
+ 0xff, 0x01, 0x01, 0x01, 0x11, 0x01, 0x11, 0x01, 0x7d, 0x01, 0x11, 0x01,
+ 0x11, 0x01, 0x01, 0x01, 0xff, 0x01};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("plus"), (char*)plus_bits, plus_width, plus_height);
+}
+{
+/* XPM */
+static char * plus_xpm[] = {
+"9 9 2 1",
+". s None c None",
+" c black",
+" ",
+" ....... ",
+" ... ... ",
+" ... ... ",
+" . . ",
+" ... ... ",
+" ... ... ",
+" ....... ",
+" "};
+Tix_DefinePixmap(Et_Interp, Tk_GetUid("plus"), plus_xpm);
+}
+{
+#define plusarm_width 9
+#define plusarm_height 9
+static UNSIGNED_CHAR plusarm_bits[] = {
+ 0xff, 0x01, 0x01, 0x01, 0x6d, 0x01, 0x6d, 0x01, 0x01, 0x01, 0x6d, 0x01,
+ 0x6d, 0x01, 0x01, 0x01, 0xff, 0x01};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("plusarm"), (char*)plusarm_bits, plusarm_width, plusarm_height);
+}
+{
+/* XPM */
+static char * plusarm_xpm[] = {
+"9 9 3 1",
+" c black",
+". c yellow",
+"X c gray40",
+" ",
+" ....... ",
+" ... ... ",
+" ..X X.. ",
+" . X . ",
+" ..X X.. ",
+" ... ... ",
+" ....... ",
+" "};
+Tix_DefinePixmap(Et_Interp, Tk_GetUid("plusarm"), plusarm_xpm);
+}
+{
+#define resize1_width 13
+#define resize1_height 13
+#define resize1_x_hot 6
+#define resize1_y_hot 6
+static UNSIGNED_CHAR resize1_bits[] = {
+ 0x7f, 0x00, 0x21, 0x00, 0x11, 0x00, 0x31, 0x00, 0x6d, 0x00, 0xdb, 0x00,
+ 0xb1, 0x11, 0x60, 0x1b, 0xc0, 0x16, 0x80, 0x11, 0x00, 0x11, 0x80, 0x10,
+ 0xc0, 0x1f};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("resize1"),(char*) resize1_bits, resize1_width, resize1_height);
+}
+{
+#define resize2_width 13
+#define resize2_height 13
+#define resize2_x_hot 6
+#define resize2_y_hot 6
+static UNSIGNED_CHAR resize2_bits[] = {
+ 0xc0, 0x1f, 0x80, 0x10, 0x00, 0x11, 0x80, 0x11, 0xc0, 0x16, 0x60, 0x1b,
+ 0xb1, 0x11, 0xdb, 0x00, 0x6d, 0x00, 0x31, 0x00, 0x11, 0x00, 0x21, 0x00,
+ 0x7f, 0x00};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("resize2"), (char*)resize2_bits, resize2_width, resize2_height);
+}
+{
+#define restore_width 15
+#define restore_height 15
+static UNSIGNED_CHAR restore_bits[] = {
+ 0x00, 0x00, 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f,
+ 0xfc, 0x1f, 0x00, 0x00, 0xfc, 0x1f, 0xf8, 0x0f, 0xf0, 0x07, 0xe0, 0x03,
+ 0xc0, 0x01, 0x80, 0x00, 0x00, 0x00};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("restore"), (char*)restore_bits, restore_width, restore_height);
+}
+{
+#define srcfile_width 12
+#define srcfile_height 12
+static UNSIGNED_CHAR srcfile_bits[] = {
+ 0xfe, 0x01, 0x02, 0x01, 0x02, 0x07, 0x02, 0x04, 0x72, 0x04, 0x8a, 0x04,
+ 0x0a, 0x04, 0x0a, 0x04, 0x8a, 0x04, 0x72, 0x04, 0x02, 0x04, 0xfe, 0x07};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("srcfile"), (char*)srcfile_bits, srcfile_width, srcfile_height);
+}
+{
+/* XPM */
+static char * srcfile_xpm[] = {
+"12 12 3 1",
+" s None c None",
+". c black",
+"X c gray91",
+" ........ ",
+" .XXXXXX. ",
+" .XXXXXX... ",
+" .XXXXXXXX. ",
+" .XX...XXX. ",
+" .X.XXX.XX. ",
+" .X.XXXXXX. ",
+" .X.XXXXXX. ",
+" .X.XXX.XX. ",
+" .XX...XXX. ",
+" .XXXXXXXX. ",
+" .......... "};
+Tix_DefinePixmap(Et_Interp, Tk_GetUid("srcfile"), srcfile_xpm);
+}
+{
+#define system_width 15
+#define system_height 15
+static UNSIGNED_CHAR system_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x3f,
+ 0x02, 0x20, 0x02, 0x20, 0xfe, 0x3f, 0xfe, 0x3f, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("system"), (char*)system_bits, system_width, system_height);
+}
+{
+#define textfile_width 12
+#define textfile_height 12
+static UNSIGNED_CHAR textfile_bits[] = {
+ 0xfe, 0x01, 0x02, 0x01, 0x02, 0x07, 0x7a, 0x04, 0x02, 0x04, 0x3a, 0x04,
+ 0x02, 0x04, 0xfa, 0x04, 0x02, 0x04, 0xfa, 0x04, 0x02, 0x04, 0xfe, 0x07};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("textfile"), (char*)textfile_bits, textfile_width, textfile_height);
+}
+{
+/* XPM */
+static char * textfile_xpm[] = {
+"12 12 3 1",
+" s None c None",
+". c black",
+"X c #FFFFFFFFF3CE",
+" ........ ",
+" .XXXXXX. ",
+" .XXXXXX... ",
+" .X....XXX. ",
+" .XXXXXXXX. ",
+" .X...XXXX. ",
+" .XXXXXXXX. ",
+" .X.....XX. ",
+" .XXXXXXXX. ",
+" .X.....XX. ",
+" .XXXXXXXX. ",
+" .......... "};
+Tix_DefinePixmap(Et_Interp, Tk_GetUid("textfile"), textfile_xpm);
+}
+{
+#define tick_width 14
+#define tick_height 14
+static UNSIGNED_CHAR tick_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x38, 0x00, 0x1c, 0x00, 0x0e,
+ 0x00, 0x07, 0x80, 0x03, 0xc2, 0x01, 0xe7, 0x00, 0x7f, 0x00, 0x3e, 0x00,
+ 0x1c, 0x00, 0x08, 0x00};
+Tk_DefineBitmap(Et_Interp, Tk_GetUid("tick"), (char*)tick_bits, tick_width, tick_height);
+}
+{
+/* XPM */
+static char * warning_xpm[] = {
+"32 32 3 1",
+" s None c None",
+". c #000000000000",
+"X c yellow",
+" ",
+" ......... ",
+" ...XXXXXXXXX... ",
+" .XXXXXXXXXXXXXXX. ",
+" ..XXXXXXXXXXXXXXXXX.. ",
+" .XXXXXXXXX...XXXXXXXXX. ",
+" .XXXXXXXXX.....XXXXXXXXX. ",
+" .XXXXXXXXX.....XXXXXXXXX. ",
+" .XXXXXXXXX.......XXXXXXXXX. ",
+" .XXXXXXXXXX.......XXXXXXXXXX. ",
+" .XXXXXXXXXX.......XXXXXXXXXX. ",
+" .XXXXXXXXXX.......XXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXXX.....XXXXXXXXXXXX. ",
+".XXXXXXXXXXXX.....XXXXXXXXXXXX. ",
+".XXXXXXXXXXXX.....XXXXXXXXXXXX. ",
+".XXXXXXXXXXXXX...XXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXX...XXXXXXXXXXXX. ",
+" .XXXXXXXXXXX.....XXXXXXXXXXX. ",
+" .XXXXXXXXX.......XXXXXXXXX. ",
+" .XXXXXXXX.......XXXXXXXX. ",
+" .XXXXXXXX.......XXXXXXXX. ",
+" .XXXXXXXX.....XXXXXXXX. ",
+" ..XXXXXXX...XXXXXXX.. ",
+" .XXXXXXXXXXXXXXX. ",
+" ...XXXXXXXXX... ",
+" ......... "};
+Tix_DefinePixmap(Et_Interp, Tk_GetUid("warning"), warning_xpm);
+}
diff --git a/tix/generic/tixClass.c b/tix/generic/tixClass.c
new file mode 100644
index 00000000000..54a5904a4dd
--- /dev/null
+++ b/tix/generic/tixClass.c
@@ -0,0 +1,1971 @@
+/*
+ * tixClass.c --
+ *
+ * Implements the basic OOP class mechanism for the Tix Intrinsics.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and
+ * redistribution of this file, and for a DISCLAIMER OF ALL
+ * WARRANTIES.
+ *
+ */
+
+/*
+ *
+ * Todo:
+ *
+ * (1) Problems: now a class shares some configspecs with the parent class.
+ * If an option is declared as -static in the child class but not
+ * in the parent class, the parent class will still see this
+ * option as static.
+ *
+ */
+
+
+#include <tk.h>
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixItcl.h>
+
+/*
+ * Access control is not enabled yet.
+ */
+#define USE_ACCESS_CONTROL 0
+
+
+static void ClassTableDeleteProc _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp));
+static TixConfigSpec * CopySpec _ANSI_ARGS_((TixConfigSpec *spec));
+static TixClassRecord * CreateClassByName _ANSI_ARGS_((Tcl_Interp * interp,
+ char * classRec));
+static TixClassRecord * CreateClassRecord _ANSI_ARGS_((Tcl_Interp *interp,
+ char * classRec, Tk_Window mainWindow,
+ int isWidget));
+static void FreeClassRecord _ANSI_ARGS_((
+ TixClassRecord *cPtr));
+static void FreeParseOptions _ANSI_ARGS_((
+ TixClassParseStruct * parsePtr));
+static void FreeSpec _ANSI_ARGS_((TixConfigSpec *spec));
+static TixClassRecord * GetClassByName _ANSI_ARGS_((Tcl_Interp * interp,
+ char * classRec));
+static TixConfigSpec * InitAlias _ANSI_ARGS_((Tcl_Interp *interp,
+ TixClassRecord * cPtr, char *s));
+static int InitHashEntries _ANSI_ARGS_((
+ Tcl_Interp *interp,TixClassRecord * cPtr));
+static int InitClass _ANSI_ARGS_((Tcl_Interp * interp,
+ char * classRec, TixClassRecord * cPtr,
+ TixClassRecord * scPtr,
+ TixClassParseStruct * parsePtr));
+static TixConfigSpec * InitSpec _ANSI_ARGS_((Tcl_Interp * interp,
+ char * s, int isWidget));
+static int ParseClassOptions _ANSI_ARGS_((
+ Tcl_Interp * interp, char * opts,
+ TixClassParseStruct * rec));
+static int ParseInstanceOptions _ANSI_ARGS_((
+ Tcl_Interp * interp,TixClassRecord * cPtr,
+ char *widRec, int argc, char** argv));
+static int SetupAlias _ANSI_ARGS_((Tcl_Interp *interp,
+ TixClassRecord * cPtr, char *s));
+static int SetupAttribute _ANSI_ARGS_((Tcl_Interp *interp,
+ TixClassRecord * cPtr, char *s,
+ int which));
+static int SetupMethod _ANSI_ARGS_((Tcl_Interp *interp,
+ TixClassRecord * cPtr, char *s));
+static int SetupDefault _ANSI_ARGS_((Tcl_Interp *interp,
+ TixClassRecord * cPtr, char *s));
+#if USE_ACCESS_CONTROL
+static int SetupSubWidget _ANSI_ARGS_((Tcl_Interp *interp,
+ TixClassRecord * cPtr, char *s));
+#endif
+static int SetupSpec _ANSI_ARGS_((Tcl_Interp *interp,
+ TixClassRecord * cPtr, char *s,
+ int isWidget));
+
+TIX_DECLARE_CMD(Tix_CreateWidgetCmd);
+TIX_DECLARE_CMD(Tix_CreateInstanceCmd);
+TIX_DECLARE_CMD(Tix_InstanceCmd);
+TIX_DECLARE_CMD(Tix_UninitializedClassCmd);
+
+/*
+ * Hash tables used to store the classes and class specs.
+ */
+
+#define GetClassTable(interp) _TixGetHashTable(interp, "tixClassTab", ClassTableDeleteProc)
+#define GetSpecTable(interp) _TixGetHashTable(interp, "tixSpecTab", NULL)
+
+static char * TIX_EMPTY_STRING = "";
+
+
+/*----------------------------------------------------------------------
+ * GetClassByName --
+ *
+ * Return a class struct if it has been created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TixClassRecord *
+GetClassByName(interp, classRec)
+ Tcl_Interp * interp;
+ char * classRec;
+{
+ Tcl_HashEntry *hashPtr;
+
+ hashPtr = Tcl_FindHashEntry(GetClassTable(interp), classRec);
+ if (hashPtr) {
+ return (TixClassRecord *)Tcl_GetHashValue(hashPtr);
+ } else {
+ return NULL;
+ }
+}
+
+static TixClassRecord *
+CreateClassByName(interp, classRec)
+ Tcl_Interp * interp;
+ char * classRec;
+{
+ TixClassRecord * cPtr;
+ TixInterpState state;
+
+ TixSaveInterpState(interp, &state);
+ cPtr = GetClassByName(interp, classRec);
+ if (cPtr == NULL) {
+ if (Tix_GlobalVarEval(interp, classRec, ":AutoLoad", (char*)NULL)
+ == TCL_ERROR){
+ cPtr = NULL;
+ } else {
+ cPtr = GetClassByName(interp, classRec);
+ }
+ }
+ TixRestoreInterpState(interp, &state);
+
+ return cPtr;
+}
+
+/*----------------------------------------------------------------------
+ * CreateClassRecord --
+ *
+ * Create a class record for the definiton of a new class, or return
+ * error if the class already exists.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TixClassRecord *
+CreateClassRecord(interp, classRec, mainWindow, isWidget)
+ Tcl_Interp * interp;
+ char * classRec;
+ Tk_Window mainWindow;
+ int isWidget;
+{
+ Tcl_HashEntry *hashPtr;
+ int isNew;
+ TixClassRecord * cPtr;
+
+ hashPtr = Tcl_CreateHashEntry(GetClassTable(interp), classRec, &isNew);
+
+ if (isNew) {
+ cPtr = (TixClassRecord *)ckalloc(sizeof(TixClassRecord));
+#if USE_ACCESS_CONTROL
+ cPtr->next = NULL;
+#endif
+ cPtr->superClass = NULL;
+ cPtr->isWidget = isWidget;
+ cPtr->className = (char*)tixStrDup(classRec);
+ cPtr->ClassName = NULL;
+ cPtr->nSpecs = 0;
+ cPtr->specs = 0;
+ cPtr->nMethods = 0;
+ cPtr->methods = 0;
+ cPtr->mainWindow = mainWindow;
+ cPtr->parsePtr = NULL;
+ cPtr->initialized= 0;
+ Tix_SimpleListInit(&cPtr->unInitSubCls);
+ Tix_SimpleListInit(&cPtr->subWDefs);
+
+#if USE_ACCESS_CONTROL
+ Tix_SimpleListInit(&cPtr->subWidgets);
+#endif
+
+ Tcl_SetHashValue(hashPtr, (char*)cPtr);
+ return cPtr;
+ } else {
+
+ /*
+ * We don't allow redefinition of classes
+ */
+
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "Class \"", classRec, "\" redefined", NULL);
+ return NULL;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * Tix_ClassCmd
+ *
+ * Create a class record for a Tix class.
+ *
+ * argv[0] = "tixClass" or "tixWidgetClass"
+ * argv[1] = class
+ * argv[2] = arglist
+ *----------------------------------------------------------------------
+ */
+
+TIX_DEFINE_CMD(Tix_ClassCmd)
+{
+ int isWidget, code = TCL_OK;
+ TixClassParseStruct * parsePtr;
+ TixClassRecord * cPtr, * scPtr;
+ char * classRec = argv[1];
+ Tk_Window mainWindow = (Tk_Window)clientData;
+ DECLARE_ITCL_NAMESP(nameSp, interp);
+
+ if (strcmp(argv[0], "tixClass")==0) {
+ isWidget = 0;
+ } else {
+ isWidget = 1;
+ }
+
+ if (argc != 3) {
+ return Tix_ArgcError(interp, argc, argv, 1, "className {...}");
+ }
+ if (!TixItclSetGlobalNameSp(&nameSp, interp)) {
+ parsePtr = NULL;
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ parsePtr = (TixClassParseStruct *)ckalloc(sizeof(TixClassParseStruct));
+ if (ParseClassOptions(interp, argv[2], parsePtr) != TCL_OK) {
+ ckfree((char*)parsePtr);
+ parsePtr = NULL;
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ cPtr = GetClassByName(interp, classRec);
+ if (cPtr == NULL) {
+ cPtr = CreateClassRecord(interp, classRec, mainWindow, isWidget);
+ if (cPtr == NULL) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+ if (cPtr->initialized) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "Class \"", classRec, "\" redefined", NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * (2) Set up the superclass
+ */
+
+ if (!parsePtr->superClass || strlen(parsePtr->superClass) == 0) {
+ scPtr = NULL;
+ }
+ else {
+ /*
+ * Create the superclass's record if it does not exist yet.
+ */
+ scPtr = GetClassByName(interp, parsePtr->superClass);
+ if (scPtr == NULL) {
+ scPtr = CreateClassByName(interp, parsePtr->superClass);
+ if (scPtr == NULL) {
+ /*
+ * The superclass cannot be autoloaded. We create a
+ * empty class record. This record may later be filled
+ * by a tixClass call (which may be initiated by a
+ * "source" call by the the application, or by SAM).
+ */
+ scPtr = CreateClassRecord(interp, parsePtr->superClass,
+ mainWindow, isWidget);
+ if (scPtr == NULL) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+ }
+ }
+ cPtr->superClass = scPtr;
+
+ if (scPtr == NULL || scPtr->initialized == 1) {
+ /*
+ * It is safe to initialized the class now.
+ */
+ code = InitClass(interp, classRec, cPtr, scPtr, parsePtr);
+ FreeParseOptions(parsePtr);
+ cPtr->parsePtr = NULL;
+ } else {
+ /*
+ * This class has an uninitialized superclass. We wait until the
+ * superclass is initialized before we initialize this class.
+ */
+ Tix_SimpleListAppend(&scPtr->unInitSubCls, (char*)cPtr, 0);
+ Tcl_CreateCommand(interp, cPtr->className,
+ Tix_UninitializedClassCmd, (ClientData)cPtr, NULL);
+ cPtr->parsePtr = parsePtr;
+ }
+
+done:
+ TixItclRestoreGlobalNameSp(&nameSp, interp);
+ if (code == TCL_ERROR) {
+ if (parsePtr != NULL) {
+ FreeParseOptions(parsePtr);
+ }
+ }
+ return code;
+}
+
+static int
+ParseClassOptions(interp, opts, parsePtr)
+ Tcl_Interp * interp;
+ char * opts;
+ TixClassParseStruct * parsePtr;
+{
+ int i;
+ char * buff, *s, *p;
+ int code = TCL_OK;
+
+ parsePtr->alias = TIX_EMPTY_STRING;
+ parsePtr->configSpec = TIX_EMPTY_STRING;
+ parsePtr->ClassName = TIX_EMPTY_STRING;
+ parsePtr->def = TIX_EMPTY_STRING;
+ parsePtr->flag = TIX_EMPTY_STRING;
+ parsePtr->forceCall = TIX_EMPTY_STRING;
+ parsePtr->isStatic = TIX_EMPTY_STRING;
+ parsePtr->method = TIX_EMPTY_STRING;
+ parsePtr->readOnly = TIX_EMPTY_STRING;
+ parsePtr->subWidget = TIX_EMPTY_STRING;
+ parsePtr->superClass = TIX_EMPTY_STRING;
+ parsePtr->isVirtual = TIX_EMPTY_STRING;
+
+ parsePtr->optArgv = NULL;
+
+ /*
+ * Get rid of the comments
+ */
+ buff = (char*)ckalloc((strlen(opts)+1) * sizeof(char));
+ for (s=opts,p=buff; *s;) {
+ /* Skip starting spaces */
+ while (isspace(*s)) {
+ s++;
+ }
+ if (*s == '#') {
+ while (*s && *s != '\n') {
+ s++;
+ }
+ if (*s) {
+ s++;
+ }
+ continue;
+ }
+ while (*s && *s != '\n') {
+ *p++ = *s++;
+ }
+ if (*s) {
+ *p++ = *s++;
+ }
+ }
+ *p = '\0';
+
+ if (Tcl_SplitList(interp, buff, &parsePtr->optArgc, &parsePtr->optArgv)
+ != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ if ((parsePtr->optArgc %2) == 1) {
+ Tcl_AppendResult(interp, "value for \"",
+ parsePtr->optArgv[parsePtr->optArgc-1],
+ "\" missing", (char*)NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+ for (i=0; i<parsePtr->optArgc; i+=2) {
+ if (strcmp(parsePtr->optArgv[i], "-alias") == 0) {
+ parsePtr->alias = parsePtr->optArgv[i+1];
+ }
+ else if (strcmp(parsePtr->optArgv[i], "-configspec") == 0) {
+ parsePtr->configSpec = parsePtr->optArgv[i+1];
+ }
+ else if (strcmp(parsePtr->optArgv[i], "-classname") == 0) {
+ parsePtr->ClassName = parsePtr->optArgv[i+1];
+ }
+ else if (strcmp(parsePtr->optArgv[i], "-default") == 0) {
+ parsePtr->def = parsePtr->optArgv[i+1];
+ }
+ else if (strcmp(parsePtr->optArgv[i], "-flag") == 0) {
+ parsePtr->flag = parsePtr->optArgv[i+1];
+ }
+ else if (strcmp(parsePtr->optArgv[i], "-forcecall") == 0) {
+ parsePtr->forceCall = parsePtr->optArgv[i+1];
+ }
+ else if (strcmp(parsePtr->optArgv[i], "-method") == 0) {
+ parsePtr->method = parsePtr->optArgv[i+1];
+ }
+ else if (strcmp(parsePtr->optArgv[i], "-readonly") == 0) {
+ parsePtr->readOnly = parsePtr->optArgv[i+1];
+ }
+ else if (strcmp(parsePtr->optArgv[i], "-static") == 0) {
+ parsePtr->isStatic = parsePtr->optArgv[i+1];
+ }
+#if USE_ACCESS_CONTROL
+ else if (strcmp(parsePtr->optArgv[i], "-subwidget") == 0) {
+ parsePtr->subWidget = parsePtr->optArgv[i+1];
+ }
+#endif
+ else if (strcmp(parsePtr->optArgv[i], "-superclass") == 0) {
+ parsePtr->superClass = parsePtr->optArgv[i+1];
+ }
+ else if (strcmp(parsePtr->optArgv[i], "-virtual") == 0) {
+ parsePtr->isVirtual = parsePtr->optArgv[i+1];
+ }
+ else {
+ Tcl_AppendResult(interp, "unknown parsePtr->option \"",
+ parsePtr->optArgv[i], "\"", (char*)NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+
+ done:
+ if (code != TCL_OK) {
+ if (parsePtr->optArgv != NULL) {
+ ckfree((char*)parsePtr->optArgv);
+ parsePtr->optArgv = NULL;
+ }
+ }
+ ckfree((char*)buff);
+ return code;
+}
+
+static void
+FreeParseOptions(parsePtr)
+ TixClassParseStruct * parsePtr;
+{
+ if (parsePtr->optArgv) {
+ ckfree((char*)parsePtr->optArgv);
+ }
+ ckfree((char*)parsePtr);
+}
+
+/*----------------------------------------------------------------------
+ * InitClass --
+ *
+ * Initialize the class record using the arguments supplied by the
+ * tixClass and tixWidgetClass commands.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * The given class is initialized.
+ *----------------------------------------------------------------------
+ */
+
+static int
+InitClass(interp, classRec, cPtr, scPtr, parsePtr)
+ Tcl_Interp * interp;
+ char * classRec;
+ TixClassRecord * cPtr;
+ TixClassRecord * scPtr;
+ TixClassParseStruct * parsePtr;
+{
+ int code = TCL_OK;
+ int i, flag;
+ int isWidget = cPtr->isWidget;
+ Tix_ListIterator li;
+ TixClassRecord * subPtr;
+
+ cPtr->ClassName = (char*)tixStrDup(parsePtr->ClassName);
+
+ /*
+ * (3) Set up the methods.
+ */
+ if (SetupMethod(interp, cPtr, parsePtr->method) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ /* (4) Set up the major configspecs */
+ if (SetupSpec(interp, cPtr, parsePtr->configSpec, isWidget) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * (5) Set up the aliases
+ */
+
+ /* (5.1)Create the alias configSpec's */
+ if (parsePtr->alias && *parsePtr->alias) {
+ if (SetupAlias(interp, cPtr, parsePtr->alias) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+
+ /*
+ * We are done with the class record. Now let's put the flags into
+ * a hash table so then they can be retrived quickly whenever we call
+ * the "$widget config" method
+ */
+
+ if (InitHashEntries(interp, cPtr)!=TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * (5.2) Initialize the alias configSpec's
+ */
+ for (i=0; i<cPtr->nSpecs; i++) {
+ if (cPtr->specs[i]->isAlias) {
+ cPtr->specs[i]->realPtr =
+ Tix_FindConfigSpecByName(interp, cPtr, cPtr->specs[i]->dbName);
+ }
+ }
+
+ /*
+ * (6) Set up the attributes of the specs
+ */
+ if (parsePtr->isStatic && *parsePtr->isStatic) {
+ if (SetupAttribute(interp, cPtr, parsePtr->isStatic, FLAG_STATIC)
+ != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+ if (parsePtr->readOnly && *parsePtr->readOnly) {
+ if (SetupAttribute(interp,cPtr,parsePtr->readOnly, FLAG_READONLY)
+ !=TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+ if (parsePtr->forceCall && *parsePtr->forceCall) {
+ if (SetupAttribute(interp,cPtr,parsePtr->forceCall,FLAG_FORCECALL)
+ !=TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+
+ /* (7) Record the default options */
+ if (SetupDefault(interp, cPtr, parsePtr->def) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+#if USE_ACCESS_CONTROL
+ /* (8) Set up the SubWidget specs */
+ if (isWidget) {
+ if (SetupSubWidget(interp, cPtr, parsePtr->subWidget) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+#endif
+
+ /*
+ * Set up the TCL array variable to store some information about the
+ * class. This is compatible with the old Tix and it also speeds up
+ * some operations because the look-up of these variables are done
+ * by hash tables.
+ */
+ flag = TCL_GLOBAL_ONLY;
+ if (parsePtr->superClass) {
+ Tcl_SetVar2(interp, classRec, "superClass", parsePtr->superClass,flag);
+ } else {
+ Tcl_SetVar2(interp, classRec, "superClass", "", flag);
+ }
+
+ Tcl_SetVar2(interp, classRec, "className", classRec, flag);
+ Tcl_SetVar2(interp, classRec, "ClassName", parsePtr->ClassName, flag);
+ Tcl_SetVar2(interp, classRec, "options", parsePtr->flag, flag);
+ Tcl_SetVar2(interp, classRec, "forceCall", parsePtr->forceCall, flag);
+ Tcl_SetVar2(interp, classRec, "defaults", parsePtr->def , flag);
+ Tcl_SetVar2(interp, classRec, "methods", parsePtr->method, flag);
+ Tcl_SetVar2(interp, classRec, "staticOptions", parsePtr->isStatic, flag);
+
+ if (parsePtr->isVirtual) {
+ Tcl_SetVar2(interp, classRec, "virtual", "1", flag);
+ } else {
+ Tcl_SetVar2(interp, classRec, "virtual", "0", flag);
+ }
+
+ if (isWidget) {
+ Tcl_SetVar2(interp, classRec, "isWidget", "1", flag);
+ } else {
+ Tcl_SetVar2(interp, classRec, "isWidget", "0", flag);
+ }
+
+ /*
+ * Now create the instantiation command.
+ */
+ if (isWidget) {
+ Tcl_CreateCommand(interp, cPtr->className, Tix_CreateWidgetCmd,
+ (ClientData)cPtr, NULL);
+ } else {
+ Tcl_CreateCommand(interp, cPtr->className, Tix_CreateInstanceCmd,
+ (ClientData)cPtr, NULL);
+ }
+
+ /*
+ * Create an "AutoLoad" command. This is needed so that class
+ * definitions can be auto-loaded properly
+ */
+ if (Tix_GlobalVarEval(interp, "proc ", cPtr->className, ":AutoLoad {} {}",
+ (char *) NULL) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ cPtr->initialized = 1;
+
+ /*
+ * Complete the initialization of all the partially initialized
+ * sub-classes.
+ */
+
+ Tix_SimpleListIteratorInit(&li);
+ for (Tix_SimpleListStart(&cPtr->unInitSubCls, &li);
+ !Tix_SimpleListDone(&li);
+ Tix_SimpleListNext(&cPtr->unInitSubCls, &li)) {
+
+ subPtr = (TixClassRecord*)li.curr;
+ code = InitClass(interp, subPtr->className, subPtr, cPtr,
+ subPtr->parsePtr);
+
+ if (code == TCL_OK) {
+ if (subPtr->parsePtr) {
+ FreeParseOptions(subPtr->parsePtr);
+ }
+ subPtr->parsePtr = NULL;
+ Tix_SimpleListDelete(&cPtr->unInitSubCls, &li);
+ } else {
+ /*
+ * (ToDo) Tix is not in a stable state. Some variables
+ * have not been freed.
+ */
+ goto done;
+ }
+ }
+
+ done:
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ * FreeClassRecord --
+ *
+ * Frees the data associated with a class.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The Tix_InstanceCmd cannot be called afterwards.
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeClassRecord(cPtr)
+ TixClassRecord *cPtr;
+{
+ int i;
+ Tix_ListIterator li;
+
+ if (cPtr->className) {
+ ckfree(cPtr->className);
+ }
+ if (cPtr->ClassName) {
+ ckfree(cPtr->ClassName);
+ }
+ for (i=0; i<cPtr->nSpecs; i++) {
+ FreeSpec(cPtr->specs[i]);
+ }
+ if (cPtr->specs) {
+ ckfree((char*)cPtr->specs);
+ }
+ for (i=0; i<cPtr->nMethods; i++) {
+ ckfree(cPtr->methods[i]);
+ }
+ if (cPtr->methods) {
+ ckfree((char*)cPtr->methods);
+ }
+
+ Tix_SimpleListIteratorInit(&li);
+ for (Tix_SimpleListStart(&cPtr->unInitSubCls, &li);
+ !Tix_SimpleListDone(&li);
+ Tix_SimpleListNext(&cPtr->unInitSubCls, &li)) {
+ Tix_SimpleListDelete(&cPtr->unInitSubCls, &li);
+ }
+ Tix_SimpleListIteratorInit(&li);
+ for (Tix_SimpleListStart(&cPtr->subWDefs, &li);
+ !Tix_SimpleListDone(&li);
+ Tix_SimpleListNext(&cPtr->subWDefs, &li)) {
+
+ Tix_SubwidgetDef * defPtr = (Tix_SubwidgetDef*)li.curr;
+ Tix_SimpleListDelete(&cPtr->subWDefs, &li);
+
+ ckfree((char*)defPtr->spec);
+ ckfree((char*)defPtr->value);
+ ckfree((char*)defPtr);
+ }
+
+ if (cPtr->parsePtr) {
+ FreeParseOptions(cPtr->parsePtr);
+ }
+
+ ckfree((char*)cPtr);
+}
+
+TIX_DEFINE_CMD(Tix_UninitializedClassCmd)
+{
+ TixClassRecord * cPtr, *scPtr;
+
+ cPtr = (TixClassRecord *)clientData;
+ for (scPtr = cPtr->superClass; scPtr != NULL && scPtr->superClass != NULL;
+ scPtr = scPtr->superClass) {
+ ;
+ }
+ if (scPtr != NULL) {
+ Tcl_AppendResult(interp, "Superclass \"", scPtr->className,
+ "\" not defined", NULL);
+ } else {
+ Tcl_AppendResult(interp, "Unknown Tix internal error", NULL);
+ }
+
+ return TCL_ERROR;
+}
+
+
+/*----------------------------------------------------------------------
+ * Tix_CreateInstanceCmd --
+ *
+ * Create an instance object of a normal Tix class.
+ *
+ * argv[0] = object name.
+ * argv[1+] = args
+ *----------------------------------------------------------------------
+ */
+
+TIX_DEFINE_CMD(Tix_CreateInstanceCmd)
+{
+ TixClassRecord * cPtr;
+ char * widRec;
+ int i, code = TCL_OK;
+ TixConfigSpec * spec;
+ char * value;
+ DECLARE_ITCL_NAMESP(nameSp, interp);
+
+ if (argc <= 1) {
+ return Tix_ArgcError(interp, argc, argv, 1, "name ?arg? ...");
+ }
+
+ cPtr = (TixClassRecord *)clientData;
+ widRec = argv[1];
+
+ if (!TixItclSetGlobalNameSp(&nameSp, interp)) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ Tcl_SetVar2(interp, widRec, "className", cPtr->className, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, widRec, "ClassName", cPtr->ClassName, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, widRec, "context", cPtr->className, TCL_GLOBAL_ONLY);
+
+ /* This is the command that access the widget */
+ Tcl_CreateCommand(interp, widRec, Tix_InstanceCmd,
+ (ClientData)cPtr, NULL);
+
+ /* Set up the widget record according to defaults and arguments */
+ ParseInstanceOptions(interp, cPtr, widRec, argc-2, argv+2);
+
+ /* Call the constructor method */
+ if (Tix_CallMethod(interp, cPtr->className, widRec, "Constructor",
+ 0, 0) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * %% warning. configuration methods for -forcecall options must
+ * *not* assume that the value in the widget record has been
+ * validated!
+ *
+ * todo: please explain the above in the programming guide.
+ */
+ for (i=0; i<cPtr->nSpecs; i++) {
+ spec = cPtr->specs[i];
+ if (spec->forceCall) {
+ value = Tcl_GetVar2(interp, widRec, spec->argvName,
+ TCL_GLOBAL_ONLY);
+ if (Tix_CallConfigMethod(interp, cPtr, widRec, spec, value)!=TCL_OK){
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+ }
+
+ Tcl_SetResult(interp, widRec, TCL_VOLATILE);
+
+ done:
+ TixItclRestoreGlobalNameSp(&nameSp, interp);
+ return code;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_InstanceCmd
+ *
+ * Redirect the method calls to the class methods
+ *
+ * argv[0] = widget name
+ * argv[1] = method name
+ * argv[2+] = arglist
+ */
+TIX_DEFINE_CMD(Tix_InstanceCmd)
+{
+ TixClassRecord * cPtr;
+ char * widRec = argv[0];
+ char * method = argv[1];
+ char * classRec;
+ char * methodName; /* full name of the method -- method may be
+ * abbreviated */
+ int len;
+ int code;
+ DECLARE_ITCL_NAMESP(nameSp, interp);
+
+ cPtr = (TixClassRecord *)clientData;
+ classRec = cPtr->className;
+
+ if (argc <= 1) {
+ return Tix_ArgcError(interp, argc, argv, 1, "option ...");
+ }
+
+ Tk_Preserve((ClientData) cPtr);
+ if (!TixItclSetGlobalNameSp(&nameSp, interp)) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ len = strlen(method);
+
+ if ((methodName = Tix_FindPublicMethod(interp, cPtr, method)) == NULL) {
+ code = Tix_UnknownPublicMethodError(interp, cPtr, widRec, method);
+ goto done;
+ }
+
+ if (Tix_CallMethod(interp, classRec, widRec, methodName,
+ argc-2, argv+2) == TCL_OK) {
+ code = TCL_OK;
+ goto done;
+ }
+ /*
+ * We will have an "unknown error" return value here, now
+ * try to execute the command as a "Intrinsics" command
+ * configure, cget, subwidget or subwidgets
+ */
+ else if (strncmp(method, "configure", len) == 0) {
+ Tcl_ResetResult(interp);
+
+ if (argc==2) {
+ code = Tix_QueryAllOptions(interp, cPtr, widRec);
+ goto done;
+ }
+ else if (argc == 3) {
+ code = Tix_QueryOneOption(interp, cPtr, widRec, argv[2]);
+ goto done;
+ } else {
+ code = Tix_ChangeOptions(interp, cPtr, widRec, argc-2, argv+2);
+ goto done;
+ }
+ }
+ else if (strncmp(method, "cget", len) == 0) {
+ Tcl_ResetResult(interp);
+
+ if (argc == 3) {
+ code = Tix_GetVar(interp, cPtr, widRec, argv[2]);
+ goto done;
+ } else {
+ code = Tix_ArgcError(interp, argc, argv, 2, "-flag");
+ goto done;
+ }
+ }
+ else if (cPtr->isWidget && strncmp(method, "subwidget", len) == 0) {
+
+#if 0
+ /* Subwidget protection is not yet implemented */
+ Tix_SubWidgetSpec * ssPtr;
+ ssPtr = GetSubWidgetSpec(cPtr, argv[2]);
+#endif
+ char * swName, buff[40];
+
+ Tcl_ResetResult(interp);
+ if (argc >= 3) {
+ sprintf(buff, "w:%s", argv[2]);
+ swName = Tcl_GetVar2(interp, widRec, buff, TCL_GLOBAL_ONLY);
+
+ if (swName) {
+ if (argc == 3) {
+ Tcl_SetResult(interp, swName, TCL_VOLATILE);
+ code = TCL_OK;
+ goto done;
+ } else {
+ argv[2] = swName;
+ code = Tix_EvalArgv(interp, argc-2, argv+2);
+ goto done;
+ }
+ }
+ Tcl_AppendResult(interp, "unknown subwidget \"", argv[2],
+ "\"", NULL);
+ code = TCL_ERROR;
+ goto done;
+ } else {
+ code = Tix_ArgcError(interp, argc, argv, 2, "name ?args ...?");
+ goto done;
+ }
+ }
+ else if (cPtr->isWidget && strncmp(method, "subwidgets", len) == 0) {
+ Tcl_ResetResult(interp);
+
+ code = Tix_CallMethod(interp, classRec, widRec, "subwidgets",
+ argc-2, argv+2);
+ goto done;
+ } else {
+ /*
+ * error message already append by Tix_CallMethod()
+ */
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ done:
+ TixItclRestoreGlobalNameSp(&nameSp, interp);
+ Tk_Release((ClientData) cPtr);
+ return code;
+}
+
+/*----------------------------------------------------------------------
+ * Subroutines for Class definition
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static int SetupMethod(interp, cPtr, s)
+ Tcl_Interp * interp;
+ TixClassRecord * cPtr;
+ char * s;
+{
+ TixClassRecord * scPtr = cPtr->superClass;
+ char ** listArgv;
+ int listArgc, i;
+ int nMethods;
+
+
+ if (s && *s) {
+ if (Tcl_SplitList(interp, s, &listArgc, &listArgv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ listArgc = 0;
+ listArgv = 0;
+ }
+
+ nMethods = listArgc;
+
+ if (scPtr) {
+ nMethods += scPtr->nMethods;
+ }
+ cPtr->nMethods = nMethods;
+ cPtr->methods = (char**)ckalloc(nMethods*sizeof(char*));
+ /* Copy the methods of this class */
+ for (i=0; i<listArgc; i++) {
+ cPtr->methods[i] = (char*)tixStrDup(listArgv[i]);
+ }
+ /* Copy the methods of the super class */
+ for (; i<nMethods; i++) {
+ cPtr->methods[i] = (char*)tixStrDup(scPtr->methods[i-listArgc]);
+ }
+
+ if (listArgv) {
+ ckfree((char*)listArgv);
+ }
+
+ return TCL_OK;
+}
+
+static int
+SetupDefault(interp, cPtr, s)
+ Tcl_Interp * interp;
+ TixClassRecord * cPtr;
+ char * s;
+{
+ char ** listArgv;
+ int listArgc, i;
+ TixClassRecord * scPtr = cPtr->superClass;
+ Tix_ListIterator li;
+ Tix_SubwidgetDef *defPtr;
+
+ if (s && *s) {
+ if (Tcl_SplitList(interp, s, &listArgc, &listArgv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ return TCL_OK;
+ }
+
+ if (scPtr) {
+ /*
+ * Copy the subwidget default specs from the super-class
+ */
+ Tix_SimpleListIteratorInit(&li);
+ for (Tix_SimpleListStart(&scPtr->subWDefs, &li);
+ !Tix_SimpleListDone(&li);
+ Tix_SimpleListNext (&scPtr->subWDefs, &li)) {
+
+ Tix_SubwidgetDef * p = (Tix_SubwidgetDef*)li.curr;
+
+ defPtr = (Tix_SubwidgetDef*)ckalloc(sizeof(Tix_SubwidgetDef));
+ defPtr->spec = (char*)tixStrDup(p->spec);
+ defPtr->value = (char*)tixStrDup(p->value);
+
+ Tix_SimpleListAppend(&cPtr->subWDefs, (char*)defPtr, 0);
+ }
+ }
+
+ /*
+ * Merge with the new default specs
+ */
+ for (i=0; i<listArgc; i++) {
+ char **list;
+ int n;
+
+ if (Tcl_SplitList(interp, listArgv[i], &n, &list) != TCL_OK) {
+ goto error;
+ }
+ if (n != 2) {
+ Tcl_AppendResult(interp, "bad subwidget default format \"",
+ listArgv[i], "\"", NULL);
+ ckfree((char*)list);
+ goto error;
+ }
+
+ Tix_SimpleListIteratorInit(&li);
+ for (Tix_SimpleListStart(&cPtr->subWDefs, &li);
+ !Tix_SimpleListDone(&li);
+ Tix_SimpleListNext (&cPtr->subWDefs, &li)) {
+
+ Tix_SubwidgetDef * p = (Tix_SubwidgetDef*)li.curr;
+
+ if (strcmp(list[0], p->spec) == 0) {
+ Tix_SimpleListDelete(&cPtr->subWDefs, &li);
+ ckfree((char*)p->value);
+ ckfree((char*)p->spec);
+ ckfree((char*)p);
+ break;
+ }
+ }
+ /* Append this spec to the end
+ */
+ defPtr = (Tix_SubwidgetDef*)ckalloc(sizeof(Tix_SubwidgetDef));
+ defPtr->spec = (char*)tixStrDup(list[0]);
+ defPtr->value = (char*)tixStrDup(list[1]);
+
+ Tix_SimpleListAppend(&cPtr->subWDefs, (char*)defPtr, 0);
+
+ ckfree((char*)list);
+ }
+
+ /*
+ * Add the defaults into the options database.
+ */
+ Tix_SimpleListIteratorInit(&li);
+ for (Tix_SimpleListStart(&cPtr->subWDefs, &li);
+ !Tix_SimpleListDone(&li);
+ Tix_SimpleListNext (&cPtr->subWDefs, &li)) {
+
+ Tix_SubwidgetDef * p = (Tix_SubwidgetDef*)li.curr;
+
+ if (Tix_GlobalVarEval(interp, "option add *", cPtr->ClassName,
+ p->spec, " [list ", p->value, "] widgetDefault",
+ NULL) != TCL_OK) {
+ goto error;
+ }
+ }
+
+ if (listArgv) {
+ ckfree((char*)listArgv);
+ }
+ return TCL_OK;
+
+ error:
+ if (listArgv) {
+ ckfree((char*)listArgv);
+ }
+ return TCL_ERROR;
+}
+
+static int
+SetupSpec(interp, cPtr, s, isWidget)
+ Tcl_Interp * interp;
+ TixClassRecord * cPtr;
+ char * s;
+ int isWidget;
+{
+ TixClassRecord * scPtr = cPtr->superClass;
+ char ** listArgv;
+ int listArgc, i;
+ TixConfigSpec * dupSpec;
+ int nSpecs;
+ int j;
+ int nAlloc;
+ int code = TCL_OK;
+
+ if (s && *s) {
+ if (Tcl_SplitList(interp, s, &listArgc, &listArgv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ listArgc = 0;
+ listArgv = 0;
+ }
+
+ nSpecs = listArgc;
+
+ if (scPtr != NULL) {
+ nAlloc = nSpecs+scPtr->nSpecs;
+ } else {
+ nAlloc = nSpecs;
+ }
+
+ cPtr->nSpecs = nSpecs;
+ cPtr->specs = (TixConfigSpec**)ckalloc(nAlloc*sizeof(TixConfigSpec*));
+
+ /*
+ * Initialize the specs of this class
+ */
+ for (i=0; i<listArgc; i++) {
+ if ((cPtr->specs[i] = InitSpec(interp, listArgv[i], isWidget))==NULL){
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+ /*
+ * Copy the specs of the super class
+ */
+ if (scPtr != NULL) {
+ for (i=0; i<scPtr->nSpecs; i++) {
+ /* See if we have re-defined this configspec */
+ for (dupSpec = 0, j=0; j<listArgc; j++) {
+ char * pName = scPtr->specs[i]->argvName;
+ if (strcmp(cPtr->specs[j]->argvName, pName)==0) {
+ dupSpec = cPtr->specs[j];
+ break;
+ }
+ }
+
+ if (dupSpec) {
+ /*
+ * If we have not redefined the dbclass or dbname of
+ * this duplicated configSpec, then simply
+ * copy the parent's attributes to the new configSpec
+ *
+ * Otherwise we don't copy the parent's attributes (do nothing)
+ */
+ if ((strcmp(dupSpec->dbClass, scPtr->specs[i]->dbClass) == 0)
+ &&(strcmp(dupSpec->dbName, scPtr->specs[i]->dbName) == 0)){
+ dupSpec->readOnly = scPtr->specs[i]->readOnly;
+ dupSpec->isStatic = scPtr->specs[i]->isStatic;
+ dupSpec->forceCall = scPtr->specs[i]->forceCall;
+ }
+ } else {
+ /*
+ *Let's copy the parent's configSpec
+ */
+ cPtr->specs[cPtr->nSpecs] = CopySpec(scPtr->specs[i]);
+ cPtr->nSpecs ++;
+ }
+ }
+ }
+
+ if (cPtr->nSpecs != nAlloc) {
+ cPtr->specs = (TixConfigSpec**)
+ ckrealloc((char*)cPtr->specs, cPtr->nSpecs*sizeof(TixConfigSpec*));
+ }
+
+ done:
+ if (listArgv) {
+ ckfree((char*)listArgv);
+ }
+ return code;
+}
+
+static TixConfigSpec *
+InitSpec(interp, s, isWidget)
+ Tcl_Interp * interp;
+ char * s;
+ int isWidget;
+{
+ char ** listArgv = NULL;
+ int listArgc;
+ TixConfigSpec * sPtr = NULL;
+ char * specList = NULL;
+ char * cmdArgv[2];
+
+ /* KLUDGE
+ *
+ * The following call will try to substitute the contents inside
+ * the string s. Since s was originally in curly brackets,
+ * setting s to {-bitmap bitmap Bitmap [tix getbitmap mybitmap]}
+ * will cause the defValue to be "[tix" because the nested
+ * expression is never evaluated.
+ *
+ */
+ cmdArgv[0] = "subst";
+ cmdArgv[1] = s;
+
+ if (Tix_EvalArgv(interp, 2, cmdArgv)!= TCL_OK) {
+ goto done;
+ }
+
+ specList = (char*)tixStrDup(interp->result);
+
+ if (Tcl_SplitList(interp, specList, &listArgc, &listArgv)!= TCL_OK) {
+ goto done;
+ }
+ if (( isWidget && (listArgc < 4 || listArgc > 5)) ||
+ (!isWidget && (listArgc < 2 || listArgc > 3))) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "Wrong number of elements in ",
+ "config spec list \"", specList, "\"", NULL);
+ goto done;
+ }
+
+ sPtr = (TixConfigSpec * )ckalloc(sizeof(TixConfigSpec));
+
+ sPtr->isAlias = 0;
+ sPtr->readOnly = 0;
+ sPtr->isStatic = 0;
+ sPtr->forceCall = 0;
+ sPtr->realPtr = NULL;
+
+ if (isWidget) {
+ sPtr->argvName = (char*)tixStrDup(listArgv[0]);
+ sPtr->dbName = (char*)tixStrDup(listArgv[1]);
+ sPtr->dbClass = (char*)tixStrDup(listArgv[2]);
+ sPtr->defValue = (char*)tixStrDup(listArgv[3]);
+ }
+ else {
+ sPtr->argvName = (char*)tixStrDup(listArgv[0]);
+ sPtr->dbClass = TIX_EMPTY_STRING;
+ sPtr->dbName = TIX_EMPTY_STRING;
+ sPtr->defValue = (char*)tixStrDup(listArgv[1]);
+ }
+
+ /* Set up the verifyCmd */
+ if ((isWidget && listArgc == 5) || (!isWidget && listArgc == 3)) {
+ int n;
+
+ if (isWidget) {
+ n = 4;
+ } else {
+ n = 2;
+ }
+
+ sPtr->verifyCmd = (char*)tixStrDup(listArgv[n]);
+ } else {
+ sPtr->verifyCmd = NULL;
+ }
+
+ done:
+ if (listArgv) {
+ ckfree((char *) listArgv);
+ }
+ if (specList) {
+ ckfree(specList);
+ }
+ return sPtr;
+}
+
+static TixConfigSpec *
+CopySpec(sPtr)
+ TixConfigSpec *sPtr; /* The spec record from the super class. */
+{
+ TixConfigSpec *nPtr = (TixConfigSpec *)ckalloc(sizeof(TixConfigSpec));
+
+ nPtr->isAlias = sPtr->isAlias;
+ nPtr->readOnly = sPtr->readOnly;
+ nPtr->isStatic = sPtr->isStatic;
+ nPtr->forceCall = sPtr->forceCall;
+
+ if (sPtr->argvName != NULL && sPtr->argvName != TIX_EMPTY_STRING) {
+ nPtr->argvName = (char*)tixStrDup(sPtr->argvName);
+ } else {
+ nPtr->argvName = TIX_EMPTY_STRING;
+ }
+ if (sPtr->defValue != NULL && sPtr->defValue != TIX_EMPTY_STRING) {
+ nPtr->defValue = (char*)tixStrDup(sPtr->defValue);
+ } else {
+ nPtr->defValue = TIX_EMPTY_STRING;
+ }
+ if (sPtr->dbName != NULL && sPtr->dbName != TIX_EMPTY_STRING) {
+ nPtr->dbName = (char*)tixStrDup(sPtr->dbName);
+ } else {
+ nPtr->dbName = TIX_EMPTY_STRING;
+ }
+ if (sPtr->dbClass != NULL && sPtr->dbClass != TIX_EMPTY_STRING) {
+ nPtr->dbClass = (char*)tixStrDup(sPtr->dbClass);
+ } else {
+ nPtr->dbClass = TIX_EMPTY_STRING;
+ }
+ if (sPtr->verifyCmd != NULL) {
+ nPtr->verifyCmd = (char*)tixStrDup(sPtr->verifyCmd);
+ } else {
+ nPtr->verifyCmd = NULL;
+ }
+
+ nPtr->realPtr = NULL;
+
+ return nPtr;
+}
+
+static void
+FreeSpec(sPtr)
+ TixConfigSpec *sPtr; /* The spec record to free. */
+{
+ if (sPtr->argvName != NULL && sPtr->argvName != TIX_EMPTY_STRING) {
+ ckfree(sPtr->argvName);
+ }
+ if (sPtr->defValue != NULL && sPtr->defValue != TIX_EMPTY_STRING) {
+ ckfree(sPtr->defValue);
+ }
+ if (sPtr->dbName != NULL && sPtr->dbName != TIX_EMPTY_STRING) {
+ ckfree(sPtr->dbName);
+ }
+ if (sPtr->dbClass != NULL && sPtr->dbClass != TIX_EMPTY_STRING) {
+ ckfree(sPtr->dbClass);
+ }
+ if (sPtr->verifyCmd != NULL) {
+ ckfree(sPtr->verifyCmd);
+ }
+ ckfree((char*)sPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ * SetupAttribute --
+ *
+ * Marks the spec's with the given attribute (-readonly, -forcecall,
+ * and -static).
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * The attributes of the specs are updated.
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetupAttribute(interp, cPtr, s, which)
+ Tcl_Interp * interp;
+ TixClassRecord * cPtr;
+ char * s;
+ int which;
+{
+ char ** listArgv;
+ int listArgc, i;
+ TixConfigSpec * spec;
+
+ if (Tcl_SplitList(interp, s, &listArgc, &listArgv) != TCL_OK) {
+ return TCL_ERROR;
+ } else {
+ for (i=0; i<listArgc; i++) {
+ spec = Tix_FindConfigSpecByName(interp, cPtr, listArgv[i]);
+ if (spec == NULL) {
+ ckfree((char*)listArgv);
+ return TCL_ERROR;
+ }
+ switch(which) {
+ case FLAG_READONLY:
+ spec->readOnly = 1;
+ break;
+ case FLAG_STATIC:
+ spec->isStatic = 1;
+ break;
+ case FLAG_FORCECALL:
+ spec->forceCall = 1;
+ break;
+ }
+ }
+ }
+
+ ckfree((char*)listArgv);
+ return TCL_OK;
+}
+
+static int
+SetupAlias(interp, cPtr, s)
+ Tcl_Interp * interp;
+ TixClassRecord * cPtr;
+ char * s;
+{
+ char ** listArgv;
+ int listArgc, i;
+
+ if (Tcl_SplitList(interp, s, &listArgc, &listArgv) != TCL_OK) {
+ return TCL_ERROR;
+ } else {
+ int nAliases = listArgc;
+ int nAlloc = cPtr->nSpecs + nAliases;
+
+ cPtr->specs = (TixConfigSpec**)
+ ckrealloc((char*)cPtr->specs, nAlloc*sizeof(TixConfigSpec*));
+
+ /* Initialize the aliases of this class */
+ for (i=cPtr->nSpecs; i<nAlloc; i++) {
+ cPtr->specs[i] = InitAlias(interp, cPtr, listArgv[i-cPtr->nSpecs]);
+ if (cPtr->specs[i] == NULL) {
+ ckfree((char*)listArgv);
+ return TCL_ERROR;
+ }
+ }
+
+ cPtr->nSpecs = nAlloc;
+ }
+ ckfree((char*)listArgv);
+ return TCL_OK;
+}
+
+static TixConfigSpec *
+InitAlias(interp, cPtr, s)
+ Tcl_Interp * interp;
+ TixClassRecord * cPtr;
+ char * s;
+{
+ char ** listArgv;
+ int listArgc;
+ TixConfigSpec * sPtr;
+
+ if (Tcl_SplitList(interp, s, &listArgc, &listArgv) != TCL_OK) {
+ return NULL;
+ } else {
+ sPtr = (TixConfigSpec*) ckalloc(sizeof(TixConfigSpec));
+ sPtr->isAlias = 1;
+ sPtr->isStatic = 0;
+ sPtr->forceCall = 0;
+ sPtr->readOnly = 0;
+ sPtr->argvName = (char*)tixStrDup(listArgv[0]);
+ sPtr->dbName = (char*)tixStrDup(listArgv[1]);
+ sPtr->dbClass = TIX_EMPTY_STRING;
+ sPtr->defValue = TIX_EMPTY_STRING;
+ sPtr->verifyCmd = NULL;
+ sPtr->realPtr = NULL;
+
+ ckfree((char*)listArgv);
+ return sPtr;
+ }
+}
+
+static int
+InitHashEntries(interp, cPtr)
+ Tcl_Interp * interp;
+ TixClassRecord *cPtr;
+{
+ Tcl_HashEntry * hashPtr;
+ int isNew;
+ char * key;
+ int i;
+ TixConfigSpec * sPtr;
+
+ for (i=0; i<cPtr->nSpecs; i++) {
+ sPtr = cPtr->specs[i];
+ key = Tix_GetConfigSpecFullName(cPtr->className, sPtr->argvName);
+
+ hashPtr = Tcl_CreateHashEntry(GetSpecTable(interp), key, &isNew);
+ Tcl_SetHashValue(hashPtr, (char*)sPtr);
+
+ ckfree(key);
+ }
+
+ return TCL_OK;
+}
+/*----------------------------------------------------------------------
+ * Subroutines for object instantiation.
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ParseInstanceOptions(interp, cPtr, widRec, argc, argv)
+ Tcl_Interp * interp;
+ TixClassRecord * cPtr;
+ char *widRec;
+ int argc;
+ char** argv;
+{
+ int i;
+ TixConfigSpec *spec;
+
+ if ((argc %2) != 0) {
+ Tcl_AppendResult(interp, "missing argument for \"", argv[argc-1],
+ "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ /* Set all specs by their default values */
+ for (i=0; i<cPtr->nSpecs; i++) {
+ spec = cPtr->specs[i];
+ if (!spec->isAlias) {
+ if (Tix_ChangeOneOption(interp, cPtr, widRec, spec,
+ spec->defValue, 1, 0)!=TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ /* Set specs according to argument line values */
+ for (i=0; i<argc; i+=2) {
+ spec = Tix_FindConfigSpecByName(interp, cPtr, argv[i]);
+
+ if (spec == NULL) { /* this is an invalid flag */
+ return TCL_ERROR;
+ }
+
+ if (Tix_ChangeOneOption(interp, cPtr, widRec, spec,
+ argv[i+1], 0, 1)!=TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ * ClassTableDeleteProc --
+ *
+ * This procedure is called when the interp is about to be
+ * deleted. It cleans up the hash entries and destroys the hash
+ * table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All class definitions are deleted.
+ *----------------------------------------------------------------------
+ */
+
+static void
+ClassTableDeleteProc(clientData, interp)
+ ClientData clientData;
+ Tcl_Interp *interp;
+{
+ Tcl_HashTable * classTablePtr = (Tcl_HashTable*)clientData;
+ Tcl_HashSearch hashSearch;
+ Tcl_HashEntry * hashPtr;
+ TixClassRecord * cPtr;
+
+ for (hashPtr = Tcl_FirstHashEntry(classTablePtr, &hashSearch);
+ hashPtr;
+ hashPtr = Tcl_NextHashEntry(&hashSearch)) {
+ cPtr = (TixClassRecord*)Tcl_GetHashValue(hashPtr);
+ FreeClassRecord(cPtr);
+ Tcl_DeleteHashEntry(hashPtr);
+ }
+ Tcl_DeleteHashTable(classTablePtr);
+ ckfree((char*)classTablePtr);
+}
+
+#if USE_ACCESS_CONTROL
+
+/*
+ * Everything after this line are not used at this moment.
+ *
+ */
+
+/*----------------------------------------------------------------------
+ *
+ *
+ * ACCESS CONTROL
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static void InitExportSpec(exPtr)
+ Tix_ExportSpec * exPtr;
+{
+ Tix_SimpleListInit(&exPtr->exportCmds);
+ Tix_SimpleListInit(&exPtr->restrictCmds);
+ Tix_SimpleListInit(&exPtr->exportOpts);
+ Tix_SimpleListInit(&exPtr->restrictOpts);
+}
+
+static Tix_LinkList * CopyStringList(list, newList)
+ Tix_LinkList * list;
+ Tix_LinkList * newList;
+{
+ Tix_StringLink * ptr, * newLink;
+
+ for (ptr=(Tix_StringLink*)list->head; ptr; ptr=ptr->next) {
+ newLink = (Tix_StringLink*)ckalloc(sizeof(Tix_StringLink));
+
+ newLink->string = (char*)tixStrDup(ptr->string);
+ Tix_SimpleListAppend(newList, (char*)newLink, 0);
+ }
+}
+
+static void
+CopyExportSpec(src, dst)
+ Tix_ExportSpec * src;
+ Tix_ExportSpec * dst;
+{
+ CopyStringList(&src->exportCmds, &dst->exportCmds);
+ CopyStringList(&src->restrictCmds, &dst->restrictCmds);
+
+ CopyStringList(&src->exportOpts, &dst->exportOpts);
+ CopyStringList(&src->restrictOpts, &dst->restrictOpts);
+}
+
+/*
+ * (1) All items that appear in list1 must not appear in list 2
+ * (2) If either list have the item "all" -- an item whose string pointer is
+ * NULL -- the other list must be empty.
+ */
+static int CheckMutualExclusion(list1, list2)
+ Tix_LinkList * list1;
+ Tix_LinkList * list2;
+{
+ Tix_StringLink * ptr, *ptr2;
+
+ if (list1->numItems == 0) {
+ return TCL_OK;
+ }
+ if (list2->numItems == 0) {
+ return TCL_OK;
+ }
+
+ for (ptr=(Tix_StringLink *)(list1->head); ptr; ptr=ptr->next) {
+ if (ptr->string == NULL) {
+ goto error;
+ }
+
+ for (ptr2=(Tix_StringLink *)(list2->head); ptr2; ptr2=ptr2->next) {
+ if (strcmp(ptr->string, ptr2->string) == 0) {
+
+ /* Violates requirement (1) above :
+ * Some items in list 1 also appear in list 2.
+ */
+ goto error;
+ }
+ }
+ }
+
+ return TCL_OK;
+
+ error:
+
+ return TCL_ERROR;
+}
+
+static int AppendStrings(interp, list, string)
+ Tcl_Interp * interp;
+ Tix_LinkList * list;
+ char * string;
+{
+ char ** listArgv = NULL;
+ int listArgc, i;
+ Tix_StringLink * ptr;
+
+ if (string && *string) {
+ if (Tcl_SplitList(interp, string, &listArgc, &listArgv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ /* Nothing to be done */
+ return TCL_OK;
+ }
+
+ for (i=0; i<listArgc; i++) {
+ ptr = (Tix_StringLink *)ckalloc(sizeof(Tix_StringLink));
+
+ if (strcmp(listArgv[i], "all")==0) {
+ ptr->string = NULL;
+ } else {
+ ptr->string=(char*)tixStrDup(listArgv[i]);
+ }
+ Tix_SimpleListAppend(list, (char*)ptr, 0);
+ }
+
+ if (listArgv) {
+ ckfree((char*)listArgv);
+ }
+
+ return TCL_OK;
+}
+
+
+static int ConflictingSpec(interp, which, eList, rList)
+ Tcl_Interp * interp;
+ char * which;
+ Tix_LinkList * eList;
+ Tix_LinkList * rList;
+{
+ Tix_LinkList *lists[2];
+ Tix_StringLink * ptr;
+ int i;
+ char * specs[2] = {"export :", "restrict :"};
+
+ lists[0] = eList;
+ lists[1] = rList;
+
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "conflicting export and restrictions ",
+ "for ", which, "\n", NULL);
+
+ for (i=0; i<2; i++) {
+ Tcl_AppendResult(interp, specs[i], NULL);
+
+ for (ptr=(Tix_StringLink *)(lists[i]->head); ptr; ptr=ptr->next) {
+ if (ptr->string == 0) {
+ Tcl_AppendResult(interp, "all ", NULL);
+ } else {
+ Tcl_AppendResult(interp, ptr->string, " ", NULL);
+ }
+ }
+ Tcl_AppendResult(interp, "\n", NULL);
+ }
+
+ return TCL_ERROR;
+}
+
+/*
+ * Define or redefine the export control
+ */
+static int DefineExport(interp, exPtr, name, spec)
+ Tcl_Interp * interp;
+ Tix_ExportSpec * exPtr;
+ char * name;
+ char * spec;
+{
+ char ** listArgv = NULL;
+ int listArgc, i;
+
+ if (spec && *spec) {
+ if (Tcl_SplitList(interp, spec, &listArgc, &listArgv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ /* Nothing to be done */
+ return TCL_OK;
+ }
+
+ if (listArgc %2 != 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "wrong # of argument in subwidget spec: \"",
+ spec, "\"", NULL);
+ goto error;
+ }
+
+ for (i=0; i<listArgc; i+=2) {
+ if (strcmp(listArgv[i], "-exportcmd") == 0) {
+ if (AppendStrings(interp, &exPtr->exportCmds,
+ listArgv[i+1])==TCL_ERROR) {
+ goto error;
+ }
+ }
+ else if (strcmp(listArgv[i], "-restrictcmd") == 0) {
+ if (AppendStrings(interp, &exPtr->restrictCmds,
+ listArgv[i+1])==TCL_ERROR){
+ goto error;
+ }
+ }
+ else if (strcmp(listArgv[i], "-exportopt") == 0) {
+ if (AppendStrings(interp, &exPtr->exportOpts,
+ listArgv[i+1])==TCL_ERROR) {
+ goto error;
+ }
+ }
+ else if (strcmp(listArgv[i], "-restrictopt") == 0) {
+ if (AppendStrings(interp, &exPtr->restrictOpts,
+ listArgv[i+1])==TCL_ERROR){
+ goto error;
+ }
+ }
+ }
+
+ if (CheckMutualExclusion(&exPtr->exportCmds, &exPtr->restrictCmds)
+ ==TCL_ERROR) {
+ ConflictingSpec(interp, "commands",
+ &exPtr->exportCmds, &exPtr->restrictCmds);
+ goto error;
+ }
+ if (CheckMutualExclusion(&exPtr->restrictCmds, &exPtr->exportCmds)
+ ==TCL_ERROR) {
+ ConflictingSpec(interp, "commands",
+ &exPtr->exportCmds, &exPtr->restrictCmds);
+ goto error;
+ }
+ if (CheckMutualExclusion(&exPtr->exportOpts, &exPtr->restrictOpts)
+ ==TCL_ERROR) {
+ ConflictingSpec(interp, "options",
+ &exPtr->exportOpts, &exPtr->restrictOpts);
+ goto error;
+ }
+ if (CheckMutualExclusion(&exPtr->restrictOpts, &exPtr->exportOpts)
+ ==TCL_ERROR) {
+ ConflictingSpec(interp, "options",
+ &exPtr->exportOpts, &exPtr->restrictOpts);
+ goto error;
+ }
+
+ done:
+ if (listArgv) {
+ ckfree((char*)listArgv);
+ }
+ return TCL_OK;
+
+ error:
+ if (listArgv) {
+ ckfree((char*)listArgv);
+ }
+ return TCL_ERROR;
+}
+/*----------------------------------------------------------------------
+ *
+ *
+ * SUBWIDGET SETUP
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static Tix_SubWidgetSpec *
+GetSubWidgetSpec(cPtr, name)
+ TixClassRecord * cPtr;
+ char * name;
+{
+ Tix_SubWidgetSpec *ptr;
+
+ for (ptr=(Tix_SubWidgetSpec *)cPtr->subWidgets.head; ptr; ptr=ptr->next) {
+ if (strcmp(ptr->name, name) == 0) {
+ return ptr;
+ }
+ }
+
+ return NULL;
+}
+
+static Tix_SubWidgetSpec *
+AllocSubWidgetSpec()
+{
+ Tix_SubWidgetSpec * newPtr =
+ (Tix_SubWidgetSpec *)ckalloc(sizeof(Tix_SubWidgetSpec));
+
+ newPtr->next = NULL;
+ newPtr->name = NULL;
+ InitExportSpec(&newPtr->exportSpec);
+ return newPtr;
+}
+
+static void
+CopySubWidgetSpecs(scPtr, cPtr)
+ TixClassRecord * scPtr;
+ TixClassRecord * cPtr;
+{
+ Tix_SubWidgetSpec *ssPtr;
+
+ for (ssPtr=(Tix_SubWidgetSpec *)scPtr->subWidgets.head;
+ ssPtr;
+ ssPtr=ssPtr->next) {
+
+ Tix_SubWidgetSpec *newPtr;
+ newPtr = AllocSubWidgetSpec();
+
+ newPtr->name = (char*)tixStrDup(ssPtr->name);
+ CopyExportSpec(&ssPtr->exportSpec, & newPtr->exportSpec);
+
+ Tix_SimpleListAppend(&cPtr->subWidgets, (char*)newPtr, 0);
+ }
+}
+
+static int
+SetupSubWidget(interp, cPtr, s)
+ Tcl_Interp * interp;
+ TixClassRecord * cPtr;
+ char * s;
+{
+ char ** listArgv;
+ TixClassRecord * scPtr = cPtr->superClass;
+ int listArgc, i;
+
+ if (s && *s) {
+ if (Tcl_SplitList(interp, s, &listArgc, &listArgv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ return TCL_OK;
+ }
+
+ if (listArgc %2 != 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "wrong # of argument in subwidget spec: \"",
+ s, "\"", NULL);
+ goto error;
+ }
+
+ /* Copy all the subwidgets of the superclass to this class */
+ if (scPtr) {
+ CopySubWidgetSpecs(scPtr, cPtr);
+ }
+
+ /* Iterate over all the newly defined or re-defined subwidgets */
+ for (i=0; i<listArgc; i+=2) {
+ char * name, *spec;
+ Tix_SubWidgetSpec * oldSpec;
+ Tix_SubWidgetSpec * newSpec;
+
+ name = listArgv[i];
+ spec = listArgv[i+1];
+
+ if (scPtr && ((oldSpec = GetSubWidgetSpec(cPtr, name)) != NULL)) {
+ if (DefineExport(interp, &oldSpec->exportSpec, name, spec)
+ != TCL_OK) {
+ goto error;
+ }
+ }
+ else {
+ newSpec = AllocSubWidgetSpec();
+ newSpec->name = (char*)tixStrDup(name);
+
+ Tix_SimpleListAppend(&cPtr->subWidgets, (char*)newSpec, 0);
+
+ if (DefineExport(interp, &newSpec->exportSpec, name, spec)
+ != TCL_OK) {
+ goto error;
+ }
+ }
+ }
+
+ if (listArgv) {
+ ckfree((char*)listArgv);
+ }
+ return TCL_OK;
+
+
+ error:
+ if (listArgv) {
+ ckfree((char*)listArgv);
+ }
+ return TCL_ERROR;
+}
+
+#endif
+
diff --git a/tix/generic/tixCmds.c b/tix/generic/tixCmds.c
new file mode 100644
index 00000000000..184fad03a63
--- /dev/null
+++ b/tix/generic/tixCmds.c
@@ -0,0 +1,935 @@
+/*
+ * tixCmds.c --
+ *
+ * Implements various TCL commands for Tix.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+#include <math.h>
+
+TIX_DECLARE_CMD(Tix_ParentWindow);
+
+/*
+ * Maximum intensity for a color:
+ */
+
+#define MAX_INTENSITY 65535
+
+/*
+ * Data structure used by the tixDoWhenIdle command.
+ */
+typedef struct {
+ Tcl_Interp * interp;
+ char * command;
+ Tk_Window tkwin;
+} IdleStruct;
+
+/*
+ * Data structures used by the tixDoWhenMapped command.
+ */
+typedef struct _MapCmdLink {
+ char * command;
+ struct _MapCmdLink * next;
+} MapCmdLink;
+
+typedef struct {
+ Tcl_Interp * interp;
+ Tk_Window tkwin;
+ MapCmdLink * cmds;
+} MapEventStruct;
+
+/*
+ * Global vars
+ */
+static Tcl_HashTable idleTable; /* hash table for TixDoWhenIdle */
+static Tcl_HashTable mapEventTable; /* hash table for TixDoWhenMapped */
+
+
+/*
+ * Functions used only in this file.
+ */
+static void IdleHandler _ANSI_ARGS_((ClientData clientData));
+static void EventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void MapEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int IsOption _ANSI_ARGS_((char *option,
+ int optArgc, char **optArgv));
+static XColor * ScaleColor _ANSI_ARGS_((Tk_Window tkwin,
+ XColor * color, double scale));
+static char * NameOfColor _ANSI_ARGS_((XColor * colorPtr));
+
+
+/*----------------------------------------------------------------------
+ * Tix_DoWhenIdle --
+ *
+ * The difference between "tixDoWhenIdle" and "after" is: the
+ * "after" handler is called after all other TK Idel Event
+ * Handler are called. Sometimes this will cause some toplevel
+ * windows to be mapped before the Idle Event Handler is
+ * executed.
+ *
+ * This behavior of "after" is not suitable for implementing
+ * geometry managers. Therefore I wrote "tixDoWhenIdle" which is
+ * an exact TCL interface for Tk_DoWhenIdle()
+ *----------------------------------------------------------------------
+ */
+
+TIX_DEFINE_CMD(Tix_DoWhenIdleCmd)
+{
+ int isNew;
+ char * command;
+ static int inited = 0;
+ IdleStruct * iPtr;
+ Tk_Window tkwin;
+ Tcl_HashEntry * hashPtr;
+
+ if (!inited) {
+ Tcl_InitHashTable(&idleTable, TCL_STRING_KEYS);
+ inited = 1;
+ }
+
+ /*
+ * parse the arguments
+ */
+ if (strncmp(argv[0], "tixWidgetDoWhenIdle", strlen(argv[0]))== 0) {
+ if (argc<3) {
+ return Tix_ArgcError(interp, argc, argv, 1,
+ "command window ?arg arg ...?");
+ }
+ /* tixWidgetDoWhenIdle reqires that the second argument must
+ * be the name of a mega widget
+ */
+ tkwin=Tk_NameToWindow(interp, argv[2], Tk_MainWindow(interp));
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ if (argc<2) {
+ return Tix_ArgcError(interp, argc, argv, 1,
+ "command ?arg arg ...?");
+ }
+ tkwin = NULL;
+ }
+
+ command = Tcl_Merge(argc-1, argv+1);
+
+ hashPtr = Tcl_CreateHashEntry(&idleTable, command, &isNew);
+
+ if (!isNew) {
+ ckfree(command);
+ } else {
+ iPtr = (IdleStruct *) ckalloc(sizeof(IdleStruct));
+ iPtr->interp = interp;
+ iPtr->command = command;
+ iPtr->tkwin = tkwin;
+
+ Tcl_SetHashValue(hashPtr, (char*)iPtr);
+
+ if (tkwin) {
+ /* we just want one event handler for all idle events
+ * associated with a window. This is done by first calling
+ * Delete and then Create EventHandler.
+ */
+ Tk_DeleteEventHandler(tkwin, StructureNotifyMask, EventProc,
+ (ClientData)tkwin);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask, EventProc,
+ (ClientData)tkwin);
+ }
+
+ Tk_DoWhenIdle(IdleHandler, (ClientData) iPtr);
+ }
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_DoWhenMapped
+ *
+ * Arranges a command to be called when the window received an
+ * <Map> event.
+ *
+ * argv[1..] = command argvs
+ *
+ *----------------------------------------------------------------------
+ */
+TIX_DEFINE_CMD(Tix_DoWhenMappedCmd)
+{
+ Tcl_HashEntry * hashPtr;
+ int isNew;
+ MapEventStruct * mPtr;
+ MapCmdLink * cmd;
+ Tk_Window tkwin;
+ static int inited = 0;
+
+ if (argc!=3) {
+ return Tix_ArgcError(interp, argc, argv, 1, " pathname command");
+ }
+
+ tkwin = Tk_NameToWindow(interp, argv[1], Tk_MainWindow(interp));
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (!inited) {
+ Tcl_InitHashTable(&mapEventTable, TCL_ONE_WORD_KEYS);
+ inited = 1;
+ }
+
+ hashPtr = Tcl_CreateHashEntry(&mapEventTable, (char*)tkwin, &isNew);
+
+ if (!isNew) {
+ mPtr = (MapEventStruct*) Tcl_GetHashValue(hashPtr);
+ } else {
+ mPtr = (MapEventStruct*) ckalloc(sizeof(MapEventStruct));
+ mPtr->interp = interp;
+ mPtr->tkwin = tkwin;
+ mPtr->cmds = 0;
+
+ Tcl_SetHashValue(hashPtr, (char*)mPtr);
+
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ MapEventProc, (ClientData)mPtr);
+ }
+
+ /*
+ * Add this into a link list
+ */
+ cmd = (MapCmdLink*) ckalloc(sizeof(MapCmdLink));
+ cmd->command = (char*)tixStrDup(argv[2]);
+
+ cmd->next = mPtr->cmds;
+ mPtr->cmds = cmd;
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_FalseCmd --
+ *
+ * Returns a false value regardless of the arguments. This is used to
+ * skip run-time debugging
+ *----------------------------------------------------------------------
+ */
+
+TIX_DEFINE_CMD(Tix_FalseCmd)
+{
+ Tcl_SetResult(interp, "0",TCL_STATIC);
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_FileCmd --
+ *
+ * (obsolete)
+ *----------------------------------------------------------------------
+ */
+
+TIX_DEFINE_CMD(Tix_FileCmd)
+{
+ char *expandedFileName;
+ Tcl_DString buffer;
+ size_t len;
+
+ if (argc!=3) {
+ return Tix_ArgcError(interp, argc, argv, 1, "option filename");
+ }
+ len = strlen(argv[1]);
+ if (argv[1][0]=='t' && strncmp(argv[1], "tildesubst", len)==0) {
+
+ expandedFileName = Tcl_TildeSubst(interp, argv[2], &buffer);
+ Tcl_ResetResult(interp);
+ if (expandedFileName == NULL) {
+ Tcl_AppendResult(interp, argv[2], NULL);
+ } else {
+ Tcl_AppendResult(interp, expandedFileName, NULL);
+ Tcl_DStringFree(&buffer); /* Was initialized by Tcl_TildeSubst */
+ }
+
+ return TCL_OK;
+ }
+ else if (argv[1][0]=='t' && strncmp(argv[1], "trimslash", len)==0) {
+ /*
+ * Compress the extra "/"
+ */
+ char *src, *dst, *p;
+ int isSlash = 0;
+
+ p = (char*)tixStrDup(argv[2]);
+
+ for (src=dst=p; *src; src++) {
+ if (*src == '/') {
+ if (!isSlash) {
+ *dst++ = *src;
+ isSlash = 1;
+ }
+ } else {
+ *dst++ = *src;
+ isSlash = 0;
+ }
+ }
+ * dst = '\0';
+
+ if (dst > p) {
+ /*
+ * Trim the tariling "/", but only if this filename is not "/"
+ */
+ -- dst;
+ if (*dst == '/') {
+ if (dst != p) {
+ * dst = '\0';
+ }
+ }
+ }
+ Tcl_SetResult(interp, p, TCL_DYNAMIC);
+ return TCL_OK;
+ }
+
+ Tcl_AppendResult(interp, "unknown option \"", argv[1],
+ "\", must be tildesubst or trimslash", NULL);
+ return TCL_ERROR;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_Get3DBorderCmd
+ *
+ * Returns the upper and lower border shades of a color. Returns then
+ * in a list of two X color names.
+ *
+ * The color is not very useful if the display is a mono display:
+ * it will just return black and white. So a clever program may
+ * want to check the [tk colormodel] and if it is mono, then
+ * dither using a bitmap.
+ *----------------------------------------------------------------------
+ */
+TIX_DEFINE_CMD(Tix_Get3DBorderCmd)
+{
+ XColor * color, * light, * dark;
+ Tk_Window tkwin;
+ Tk_Uid colorUID;
+
+ if (argc != 2) {
+ return Tix_ArgcError(interp, argc, argv, 0, "colorName");
+ }
+
+ tkwin = Tk_MainWindow(interp);
+
+ colorUID = Tk_GetUid(argv[1]);
+ color = Tk_GetColor(interp, tkwin, colorUID);
+ if (color == NULL) {
+ return TCL_ERROR;
+ }
+
+ if ((light = ScaleColor(tkwin, color, 1.4)) == NULL) {
+ return TCL_ERROR;
+ }
+ if ((dark = ScaleColor(tkwin, color, 0.6)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ Tcl_ResetResult(interp);
+ Tcl_AppendElement(interp, NameOfColor(light));
+ Tcl_AppendElement(interp, NameOfColor(dark));
+
+ Tk_FreeColor(color);
+ Tk_FreeColor(light);
+ Tk_FreeColor(dark);
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_GetBooleanCmd
+ *
+ * Return "1" if is a true boolean number. "0" otherwise
+ *
+ * argv[1] = string to test
+ *----------------------------------------------------------------------
+ */
+TIX_DEFINE_CMD(Tix_GetBooleanCmd)
+{
+ int value;
+ int nocomplain = 0;
+ char *string;
+ static char *results[2] = {"0", "1"};
+
+ if (argc == 3) {
+ if (strcmp(argv[1], "-nocomplain") != 0) {
+ goto error;
+ }
+ nocomplain = 1;
+ string = argv[2];
+ }
+ else if (argc != 2) {
+ goto error;
+ }
+ else {
+ string = argv[1];
+ }
+
+ if (Tcl_GetBoolean(interp, string, &value) != TCL_OK) {
+ if (nocomplain) {
+ value = 0;
+ }
+ else {
+ return TCL_ERROR;
+ }
+ }
+
+ Tcl_SetResult(interp, results[value], TCL_STATIC);
+ return TCL_OK;
+
+ error:
+ return Tix_ArgcError(interp, argc, argv, 1, "?-nocomplain? string");
+}
+
+/*----------------------------------------------------------------------
+ * Tix_GetIntCmd
+ *
+ * Return "1" if is a true boolean number. "0" otherwise
+ *
+ * argv[1] = string to test
+ *----------------------------------------------------------------------
+ */
+TIX_DEFINE_CMD(Tix_GetIntCmd)
+{
+ int i;
+ int opTrunc = 0;
+ int opNocomplain = 0;
+ int i_value;
+ double f_value;
+ char * string = 0;
+ char buff[20];
+
+ for (i=1; i<argc; i++) {
+ if (strcmp(argv[i], "-nocomplain") == 0) {
+ opNocomplain = 1;
+ }
+ else if (strcmp(argv[i], "-trunc") == 0) {
+ opTrunc = 1;
+ }
+ else {
+ string = argv[i];
+ break;
+ }
+ }
+ if (i != argc-1) {
+ return Tix_ArgcError(interp, argc, argv, 1,
+ "?-nocomplain? ?-trunc? string");
+ }
+
+ if (Tcl_GetInt(interp, string, &i_value) == TCL_OK) {
+ ;
+ }
+ else if (Tcl_GetDouble(interp, string, &f_value) == TCL_OK) {
+#if 0
+ /* Some machines don't have the "trunc" function */
+ if (opTrunc) {
+ i_value = (int) trunc(f_value);
+ }
+ else {
+ i_value = (int) f_value;
+ }
+#else
+ i_value = (int) f_value;
+#endif
+ }
+ else if (opNocomplain) {
+ i_value = 0;
+ }
+ else {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "\"", string,
+ "\" is not a valid numerical value", NULL);
+ return TCL_ERROR;
+ }
+
+ sprintf(buff, "%d", i_value);
+ Tcl_SetResult(interp, buff, TCL_VOLATILE);
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_HandleOptionsCmd
+ *
+ *
+ * argv[1] = recordName
+ * argv[2] = validOptions
+ * argv[3] = argList
+ * if (argv[3][0] == "-nounknown") then
+ * don't complain about unknown options
+ *----------------------------------------------------------------------
+ */
+TIX_DEFINE_CMD(Tix_HandleOptionsCmd)
+{
+ int listArgc;
+ int optArgc;
+ char ** listArgv = 0;
+ char ** optArgv = 0;
+ int i, code = TCL_OK;
+ int noUnknown = 0;
+
+ if (argc >= 2 && (strcmp(argv[1], "-nounknown") == 0)) {
+ noUnknown = 1;
+ argv[1] = argv[0];
+ argc --;
+ argv ++;
+ }
+
+ if (argc!=4) {
+ return Tix_ArgcError(interp, argc, argv, 2, "w validOptions argList");
+ }
+
+ if (Tcl_SplitList(interp, argv[2], &optArgc, &optArgv ) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ if (Tcl_SplitList(interp, argv[3], &listArgc, &listArgv) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ if ((listArgc %2) == 1) {
+ if (noUnknown || IsOption(listArgv[listArgc-1], optArgc, optArgv)) {
+ Tcl_AppendResult(interp, "value for \"", listArgv[listArgc-1],
+ "\" missing", (char*)NULL);
+ } else {
+ Tcl_AppendResult(interp, "unknown option \"", listArgv[listArgc-1],
+ "\"", (char*)NULL);
+ }
+ code = TCL_ERROR;
+ goto done;
+ }
+ for (i=0; i<listArgc; i+=2) {
+ if (IsOption(listArgv[i], optArgc, optArgv)) {
+ Tcl_SetVar2(interp, argv[1], listArgv[i], listArgv[i+1], 0);
+ }
+ else if (!noUnknown) {
+ Tcl_AppendResult(interp, "unknown option \"", listArgv[i],
+ "\"; must be one of \"", argv[2], "\".", NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+
+ done:
+
+ if (listArgv) {
+ ckfree((char *) listArgv);
+ }
+ if (optArgv) {
+ ckfree((char *) optArgv);
+ }
+
+ return code;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_SetWindowParent --
+ *
+ * Sets the parent of a window. This is normally to change the
+ * state of toolbar and MDI windows between docking and free
+ * modes.
+ *
+ * Results:
+ * Standard Tcl results.
+ *
+ * Side effects:
+ * Windows may be re-parented. See user documentation.
+ *----------------------------------------------------------------------
+ */
+
+TIX_DEFINE_CMD(Tix_ParentWindow)
+{
+ Tk_Window mainWin, tkwin, newParent;
+ int parentId;
+
+ if (argc != 3) {
+ return Tix_ArgcError(interp, argc, argv, 1, "window parent");
+ }
+ mainWin = Tk_MainWindow(interp);
+ if (mainWin == NULL) {
+ Tcl_SetResult(interp, "interpreter does not have a main window",
+ TCL_STATIC);
+ return TCL_ERROR;
+ }
+
+ tkwin = Tk_NameToWindow(interp, argv[1], mainWin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ newParent = Tk_NameToWindow(interp, argv[2], mainWin);
+ if (newParent == NULL) {
+ if (Tcl_GetInt(interp, argv[2], &parentId) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "\"", argv[2],
+ "\" must be a window pathname or ID", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ return TixpSetWindowParent(interp, tkwin, newParent, parentId);
+}
+
+/*----------------------------------------------------------------------
+ * Tix_StrEqCmd --
+ *
+ * To test string equality. It is more readable to write
+ * if [tixStrEq $var1 $var2]
+ * than
+ * if ![string comp $var1 $var2]
+ *
+ *----------------------------------------------------------------------
+ */
+
+TIX_DEFINE_CMD(Tix_StrEqCmd)
+{
+ if (argc != 3) {
+ return Tix_ArgcError(interp, argc, argv, 1, "string1 string2");
+ }
+ if (strcmp(argv[1], argv[2]) == 0) {
+ Tcl_SetResult(interp, "1", TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp, "0", TCL_STATIC);
+ }
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_StringSubCmd --
+ *
+ * What does this do??
+ *----------------------------------------------------------------------
+ */
+
+TIX_DEFINE_CMD(Tix_StringSubCmd)
+{
+ Tcl_DString buffer;
+ char * str, *from, *to, *s, *e, *f;
+ int n, m, l, k;
+ int inited = 0;
+
+ if (argc!=4) {
+ return Tix_ArgcError(interp, argc, argv, 1, "strVar from to");
+ }
+ if ((str = Tcl_GetVar(interp, argv[1], 0)) == NULL) {
+ Tcl_AppendResult(interp, "variable ", argv[1]," does not exist", NULL);
+ return TCL_ERROR;
+ }
+ from = argv[2];
+ to = argv[3];
+
+ n = strlen(from);
+ l = strlen(to);
+
+ while (1) {
+ s = str;
+ k = 0;
+
+ while (*s && *s != *from) {
+ /* Find the beginning of token */
+ s++; k++;
+ }
+
+ if (*s && *s == *from) {
+ for (m=0,e=s,f=from; *e && *f && *e==*f && m<n; e++,f++,m++) {
+ ;
+ }
+ if (!inited) {
+ Tcl_DStringInit(&buffer);
+ inited = 1;
+ }
+ if (m == n) {
+ /* We found a match */
+ if (s > str) {
+ /* copy the unmatched prefix */
+ Tcl_DStringAppend(&buffer, str, k);
+ }
+ Tcl_DStringAppend(&buffer, to, l);
+ str = e;
+ } else {
+ Tcl_DStringAppend(&buffer, str, k+m);
+ str += k+m;
+ }
+ continue;
+ }
+
+ /* No match at all */
+ if (*str) {
+ if (inited) {
+ Tcl_DStringAppend(&buffer, str, k);
+ }
+ }
+ break;
+ }
+
+ if (inited) {
+ Tcl_SetVar(interp, argv[1], buffer.string, 0);
+ Tcl_DStringFree(&buffer);
+ }
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_TmpLineCmd
+ *
+ * Draw a temporary line on the root window
+ *
+ * argv[1..] = x1 y1 x2 y2
+ *----------------------------------------------------------------------
+ */
+TIX_DEFINE_CMD(Tix_TmpLineCmd)
+{
+ Tk_Window mainWin = (Tk_Window)clientData;
+ Tk_Window tkwin;
+ int x1, y1, x2, y2;
+
+ if (argc != 5 && argc != 6) {
+ return Tix_ArgcError(interp, argc, argv, 0,
+ "tixTmpLine x1 y1 x2 y2 ?window?");
+ }
+ if (Tcl_GetInt(interp, argv[1], &x1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[2], &y1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[3], &x2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[4], &y2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (argc == 6) {
+ /*
+ * argv[5] tells which display to draw the tmp lines on, in
+ * case the application has opened more than one displays. If
+ * this argv[5] is omitted, draws to the display where the
+ * main window is on.
+ */
+ tkwin = Tk_NameToWindow(interp, argv[5], mainWin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ tkwin = Tk_MainWindow(interp);
+ }
+
+ TixpDrawTmpLine(x1, y1, x2, y2, tkwin);
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_TrueCmd
+ *
+ * Returns a true value regardless of the arguments. This is used to
+ * skip run-time debugging
+ *----------------------------------------------------------------------
+ */
+
+TIX_DEFINE_CMD(Tix_TrueCmd)
+{
+ Tcl_SetResult(interp, "1",TCL_STATIC);
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * EventProc --
+ *
+ * Monitors events sent to a window associated with a
+ * tixWidgetDoWhenIdle command. If this window is destroyed,
+ * remove the idle handlers associated with this window.
+ *----------------------------------------------------------------------
+ */
+
+static void EventProc(clientData, eventPtr)
+ ClientData clientData;
+ XEvent *eventPtr;
+{
+ Tk_Window tkwin = (Tk_Window)clientData;
+ Tcl_HashSearch hSearch;
+ Tcl_HashEntry * hashPtr;
+ IdleStruct * iPtr;
+
+ if (eventPtr->type != DestroyNotify) {
+ return;
+ }
+
+ /* Iterate over all the entries in the hash table */
+ for (hashPtr = Tcl_FirstHashEntry(&idleTable, &hSearch);
+ hashPtr;
+ hashPtr = Tcl_NextHashEntry(&hSearch)) {
+
+ iPtr = (IdleStruct *)Tcl_GetHashValue(hashPtr);
+
+ if (iPtr->tkwin == tkwin) {
+ Tcl_DeleteHashEntry(hashPtr);
+ Tk_CancelIdleCall(IdleHandler, (ClientData) iPtr);
+ ckfree((char*)iPtr->command);
+ ckfree((char*)iPtr);
+ }
+ }
+}
+/*----------------------------------------------------------------------
+ * IdleHandler --
+ *
+ * Called when Tk is idle. Dispatches all commands registered by
+ * tixDoWhenIdle and tixWidgetDoWhenIdle.
+ *----------------------------------------------------------------------
+ */
+
+static void IdleHandler(clientData)
+ ClientData clientData; /* TCL command to evaluate */
+{
+ Tcl_HashEntry * hashPtr;
+ IdleStruct * iPtr;
+
+ iPtr = (IdleStruct *) clientData;
+
+ /*
+ * Clean up the hash table. Note that we have to do this BEFORE
+ * calling the TCL command. Otherwise if the TCL command tries
+ * to register itself again, it will fail in Tix_DoWhenIdleCmd()
+ * because the command is still in the hashtable
+ */
+ hashPtr = Tcl_FindHashEntry(&idleTable, iPtr->command);
+ if (hashPtr) {
+ Tcl_DeleteHashEntry(hashPtr);
+ } else {
+ /* Probably some kind of error */
+ return;
+ }
+
+ if (Tcl_GlobalEval(iPtr->interp, iPtr->command) != TCL_OK) {
+ if (iPtr->tkwin != NULL) {
+ Tcl_AddErrorInfo(iPtr->interp,
+ "\n (idle event handler executed by tixWidgetDoWhenIdle)");
+ } else {
+ Tcl_AddErrorInfo(iPtr->interp,
+ "\n (idle event handler executed by tixDoWhenIdle)");
+ }
+ Tk_BackgroundError(iPtr->interp);
+ }
+
+ ckfree((char*)iPtr->command);
+ ckfree((char*)iPtr);
+}
+
+/*----------------------------------------------------------------------
+ * IsOption --
+ *
+ * Checks whether the string pointed by "option" is one of the
+ * options given by the "optArgv" array.
+ *----------------------------------------------------------------------
+ */
+static int IsOption(option, optArgc, optArgv)
+ char *option; /* Number of arguments. */
+ int optArgc; /* Number of arguments. */
+ char **optArgv; /* Argument strings. */
+{
+ int i;
+
+ for (i=0; i<optArgc; i++) {
+ if (strcmp(option, optArgv[i]) == 0) {
+ return 1;
+ }
+ }
+ return 0;
+}
+
+
+static void MapEventProc(clientData, eventPtr)
+ ClientData clientData; /* TCL command to evaluate */
+ XEvent *eventPtr; /* Information about event. */
+{
+ Tcl_HashEntry * hashPtr;
+ MapEventStruct * mPtr;
+ MapCmdLink * cmd;
+
+ if (eventPtr->type != MapNotify) {
+ return;
+ }
+
+ mPtr = (MapEventStruct *) clientData;
+
+ Tk_DeleteEventHandler(mPtr->tkwin, StructureNotifyMask,
+ MapEventProc, (ClientData)mPtr);
+
+ /* Clean up the hash table.
+ */
+ if ((hashPtr = Tcl_FindHashEntry(&mapEventTable, (char*)mPtr->tkwin))) {
+ Tcl_DeleteHashEntry(hashPtr);
+ }
+
+ for (cmd = mPtr->cmds; cmd; ) {
+ MapCmdLink * old;
+
+ /* Execute the event handler */
+ if (Tcl_GlobalEval(mPtr->interp, cmd->command) != TCL_OK) {
+ Tcl_AddErrorInfo(mPtr->interp,
+ "\n (event handler executed by tixDoWhenMapped)");
+ Tk_BackgroundError(mPtr->interp);
+ }
+
+ /* Delete the link */
+ old = cmd;
+ cmd = cmd->next;
+
+ ckfree(old->command);
+ ckfree((char*)old);
+ }
+
+ /* deallocate the mapEventStruct */
+ ckfree((char*)mPtr);
+}
+
+static char *
+NameOfColor(colorPtr)
+ XColor * colorPtr;
+{
+ static char string[20];
+ char *ptr;
+
+ sprintf(string, "#%4x%4x%4x", colorPtr->red, colorPtr->green,
+ colorPtr->blue);
+
+ for (ptr = string; *ptr; ptr++) {
+ if (*ptr == ' ') {
+ *ptr = '0';
+ }
+ }
+ return string;
+}
+
+
+static XColor *
+ScaleColor(tkwin, color, scale)
+ Tk_Window tkwin;
+ XColor * color;
+ double scale;
+{
+ XColor test;
+
+ test.red = (int)((float)(color->red) * scale);
+ test.green = (int)((float)(color->green) * scale);
+ test.blue = (int)((float)(color->blue) * scale);
+ if (test.red > MAX_INTENSITY) {
+ test.red = MAX_INTENSITY;
+ }
+ if (test.green > MAX_INTENSITY) {
+ test.green = MAX_INTENSITY;
+ }
+ if (test.blue > MAX_INTENSITY) {
+ test.blue = MAX_INTENSITY;
+ }
+
+ return Tk_GetColorByValue(tkwin, &test);
+}
diff --git a/tix/generic/tixCompat.c b/tix/generic/tixCompat.c
new file mode 100644
index 00000000000..efb6930c1b0
--- /dev/null
+++ b/tix/generic/tixCompat.c
@@ -0,0 +1,60 @@
+/*
+ * tixCompat.c --
+ *
+ * Some compatibility functions for Tix.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+
+/*
+ * strdup is not a POSIX call and is not supported on many platforms.
+ */
+
+char * tixStrDup(s)
+ CONST char * s;
+{
+ size_t len = strlen(s)+1;
+ char * new_string;
+
+ new_string = (char*)ckalloc(len);
+ strcpy(new_string, s);
+
+ return new_string;
+}
+
+#ifdef NO_STRCASECMP
+
+int tixStrCaseCmp _ANSI_ARGS_((CONST char * a, CONST char * b));
+
+int tixStrCaseCmp(a, b)
+ CONST char * a;
+ CONST char * b;
+{
+ while (1) {
+ if (*a== 0 && *b==0) {
+ return 0;
+ }
+ if (*a==0) {
+ return (1);
+ }
+ if (*b==0) {
+ return (-1);
+ }
+ if (tolower(*a)>tolower(*b)) {
+ return (-1);
+ }
+ if (tolower(*b)>tolower(*a)) {
+ return (1);
+ }
+ a++; b++;
+ }
+}
+
+#endif /* NO_STRCASECMP */
diff --git a/tix/generic/tixDItem.c b/tix/generic/tixDItem.c
new file mode 100644
index 00000000000..b57493e73ce
--- /dev/null
+++ b/tix/generic/tixDItem.c
@@ -0,0 +1,677 @@
+/*
+ * tixDItem.c --
+ *
+ * This file implements the "Display Items" in the Tix library.
+ *
+ * Since many Tix widgets use the same type of display items, for
+ * example, text items, image items, or text-image items (used in
+ * HList, TList and Table), it makes sense to provide a set of
+ * common routines to support these display items. Code re-use is
+ * the major issue: we don't want to re-define almost the same
+ * configSpecs again and again in different widgets. Therefore,
+ * all display items provide common methods to configure,
+ * display, calculate geometry, etc.
+ *
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+
+
+static int DItemParseProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin, char *value,
+ char *widRec, int offset));
+
+static char *DItemPrintProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin, char *widRec,
+ int offset, Tcl_FreeProc **freeProcPtr));
+
+/*----------------------------------------------------------------------
+ *
+ *
+ * PUBLIC INTERFACE
+ *
+ *
+ * The following functions are called by widget implementors
+ *
+ *----------------------------------------------------------------------
+ */
+/* Tix_AddDItemType, Tix_GetDItemType --
+ *
+ *
+ * Maintain a list of item types, each identifies by a unique string
+ * name;
+ */
+static Tix_DItemInfo * diTypes = NULL;
+
+void Tix_AddDItemType(diTypePtr)
+ Tix_DItemInfo * diTypePtr;
+{
+ diTypePtr->next = diTypes;
+ diTypes = diTypePtr;
+}
+
+Tix_DItemInfo * Tix_GetDItemType(interp, type)
+ Tcl_Interp * interp;
+ char * type;
+{
+ Tix_DItemInfo * diTypePtr;
+
+ for (diTypePtr = diTypes; diTypePtr; diTypePtr = diTypePtr->next) {
+ if (strcmp(type,diTypePtr->name)==0) {
+ return diTypePtr;
+ }
+ }
+
+ if (interp) {
+ Tcl_AppendResult(interp, "unknown display type \"", type, "\"", NULL);
+ }
+ return NULL;
+}
+
+
+/*----------------------------------------------------------------------
+ * Tix_DItemCreate --
+ *
+ * Create a display item according to the "type" string.
+ *
+ *----------------------------------------------------------------------
+ */
+Tix_DItem * Tix_DItemCreate(ddPtr, type)
+ Tix_DispData * ddPtr;
+ char * type;
+{
+ Tix_DItemInfo * diTypePtr;
+
+ if ((diTypePtr = Tix_GetDItemType(ddPtr->interp, type)) == NULL) {
+ return NULL;
+ }
+
+ return diTypePtr->createProc(ddPtr, diTypePtr);
+}
+
+/*----------------------------------------------------------------------
+ * Tix_DItemConfigure --
+ *
+ * Configures a display item.
+ *
+ *----------------------------------------------------------------------
+ */
+int Tix_DItemConfigure(iPtr, argc, argv, flags)
+ Tix_DItem * iPtr;
+ int argc;
+ char ** argv;
+ int flags;
+{
+ return iPtr->base.diTypePtr->configureProc(iPtr, argc, argv, flags);
+}
+
+
+void Tix_DItemDisplay(pixmap, gc, iPtr, x, y, width, height, flags)
+ Pixmap pixmap;
+ GC gc;
+ Tix_DItem * iPtr;
+ int x;
+ int y;
+ int width;
+ int height;
+ int flags;
+{
+ iPtr->base.diTypePtr->displayProc(pixmap, gc, iPtr, x, y,
+ width, height, flags);
+}
+
+void Tix_DItemFree(iPtr)
+ Tix_DItem * iPtr;
+{
+ iPtr->base.diTypePtr->freeProc(iPtr);
+
+ /*
+ * When it comes to here, iPtr is no longer a valid pointer!
+ */
+}
+
+void Tix_DItemCalculateSize(iPtr)
+ Tix_DItem * iPtr;
+{
+ iPtr->base.diTypePtr->calculateSizeProc(iPtr);
+}
+
+char * Tix_DItemComponent(iPtr, x, y)
+ Tix_DItem * iPtr;
+ int x;
+ int y;
+{
+ return (iPtr->base.diTypePtr->componentProc(iPtr, x, y));
+}
+
+
+/*----------------------------------------------------------------------
+ * Tix_FreeArgumentList --
+ *
+ * Free the argument lists allocated by Tix_SplitConfig;
+ *----------------------------------------------------------------------
+ */
+void
+Tix_FreeArgumentList(argListPtr)
+ Tix_ArgumentList *argListPtr;
+{
+ int i;
+
+ for (i=0; i<argListPtr->numLists; i++) {
+ ckfree((char*)argListPtr->arg[i].argv);
+ }
+ if (argListPtr->arg != argListPtr->preAlloc) {
+ ckfree((char*)argListPtr->arg);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * Tix_SplitConfig --
+ *
+ * Split the command line arguments according for several configurable
+ * objects.
+ *----------------------------------------------------------------------
+ */
+int
+Tix_SplitConfig(interp, tkwin, specsList, numLists, argc, argv, argListPtr)
+ Tcl_Interp * interp;
+ Tk_Window tkwin;
+ Tk_ConfigSpec ** specsList; /* a list of two or more config spec
+ * arrays */
+ int numLists;
+ int argc;
+ char ** argv;
+ Tix_ArgumentList * argListPtr;
+{
+ Tix_Argument *arg;
+ int i, n, code = TCL_OK;
+ Tk_ConfigSpec *specPtr;
+ size_t len;
+ int found;
+
+ if (argc % 2) {
+ Tcl_AppendResult(interp, "value for \"", argv[argc-1],
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (numLists > FIXED_SIZE) {
+ arg = (Tix_Argument*)ckalloc(numLists * sizeof(Tix_Argument));
+ } else {
+ arg = argListPtr->preAlloc;
+ }
+ argListPtr->arg = arg;
+ argListPtr->numLists = numLists;
+ for (i=0; i<numLists; i++) {
+ arg[i].argc = 0;
+ arg[i].argv = (char**)ckalloc(argc * sizeof(char*));
+ }
+
+ /* Split the arguments for the appropriate objects */
+ for (n=0; n<argc; n+=2) {
+ len = strlen(argv[n]);
+ found = 0;
+
+ for (i=0; i<numLists; i++) {
+ for (specPtr=specsList[i];
+ specPtr->type != TK_CONFIG_END;
+ specPtr++) {
+
+ if (specPtr->argvName == NULL) {
+ continue;
+ }
+
+ if (strncmp(argv[n], specPtr->argvName, len) == 0) {
+ arg[i].argv[arg[i].argc++] = argv[n ];
+ arg[i].argv[arg[i].argc++] = argv[n+1];
+ found = 1;
+ break;
+ }
+ }
+ }
+ if (found == 0) {
+ Tcl_AppendResult(interp, "unknown option \"", argv[n],
+ "\"", (char *) NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+
+ done:
+ if (code == TCL_ERROR) {
+ Tix_FreeArgumentList(argListPtr);
+ }
+ return code;
+}
+
+int
+Tix_MultiConfigureInfo(interp, tkwin, specsList, numLists, widgRecList,
+ argvName, flags, request)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Window corresponding to widgRec. */
+ Tk_ConfigSpec **specsList; /* Describes legal options. */
+ int numLists;
+ char **widgRecList; /* 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. */
+ int request;
+{
+ int i, found;
+ Tk_ConfigSpec *specPtr;
+ Tcl_DString dString;
+ size_t len;
+
+ if (argvName != NULL) {
+ len = strlen(argvName);
+ for (found=0,i=0; i<numLists; i++) {
+ for (specPtr=specsList[i];
+ specPtr->type != TK_CONFIG_END;
+ specPtr++) {
+
+ if (specPtr->argvName == NULL) {
+ continue;
+ }
+
+ if (strncmp(argvName, specPtr->argvName, len) == 0) {
+ found = 1;
+ goto done;
+ }
+ }
+ }
+ done:
+ if (!found) {
+ Tcl_AppendResult(interp, "unknown option \"", argvName,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (request == TIX_CONFIG_INFO) {
+ if (widgRecList[i] != NULL) {
+ return Tk_ConfigureInfo(interp, tkwin, specsList[i],
+ widgRecList[i], argvName, flags);
+ } else {
+ return TCL_OK;
+ }
+ } else {
+ if (widgRecList[i] != NULL) {
+ return Tk_ConfigureValue(interp, tkwin, specsList[i],
+ widgRecList[i], argvName, flags);
+ } else {
+ return TCL_OK;
+ }
+ }
+ }
+
+ Tcl_DStringInit(&dString);
+ for (i=0; i<numLists; i++) {
+ if (i != 0) {
+ Tcl_DStringAppend(&dString, " ", 1);
+ }
+ if (widgRecList[i] != NULL) {
+ Tk_ConfigureInfo(interp, tkwin, specsList[i], widgRecList[i],
+ NULL, flags);
+ }
+ Tcl_DStringAppend(&dString, interp->result, strlen(interp->result));
+ }
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, dString.string, NULL);
+ Tcl_DStringFree(&dString);
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_ConfigureValue2 --
+ *
+ *
+ * Returns the config information of a entry element (of an HList,
+ * for example) and its display item.
+ *----------------------------------------------------------------------
+ */
+int
+Tix_ConfigureValue2(interp, tkwin, entRec, entConfigSpecs, iPtr,
+ argvName, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Window corresponding to widgRec. */
+ char * entRec;
+ Tk_ConfigSpec *entConfigSpecs; /* Describes legal options of the entry */
+ Tix_DItem * iPtr; /* points to the entry's data record */
+ 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. */
+{
+ Tk_ConfigSpec *specsList[2];
+ char *widgRecList[2];
+
+ specsList[0] = entConfigSpecs;
+ specsList[1] = Tix_DItemConfigSpecs(iPtr);
+ widgRecList[1] = (char*)iPtr;
+ widgRecList[0] = (char*)entRec;
+
+ return Tix_MultiConfigureInfo(interp, tkwin, specsList, 2, widgRecList,
+ argvName, flags, TIX_CONFIG_VALUE);
+}
+
+/*----------------------------------------------------------------------
+ * Tix_ConfigureInfo2 --
+ *
+ *
+ * Returns the config information of a entry element (of an HList,
+ * for example) and its display item.
+ *----------------------------------------------------------------------
+ */
+int
+Tix_ConfigureInfo2(interp, tkwin, entRec, entConfigSpecs, iPtr,
+ argvName, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Window corresponding to widgRec. */
+ char * entRec;
+ Tk_ConfigSpec *entConfigSpecs; /* Describes legal options of the entry */
+ Tix_DItem * iPtr; /* points to the entry's data record */
+ 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. */
+{
+ Tk_ConfigSpec *specsList[2];
+ char *widgRecList[2];
+
+ specsList[0] = entConfigSpecs;
+ specsList[1] = Tix_DItemConfigSpecs(iPtr);
+ widgRecList[1] = (char*)iPtr;
+ widgRecList[0] = (char*)entRec;
+
+ return Tix_MultiConfigureInfo(interp, tkwin, specsList, 2, widgRecList,
+ argvName, flags, TIX_CONFIG_INFO);
+}
+
+int
+Tix_WidgetConfigure2(interp, tkwin, entRec, entConfigSpecs, iPtr,
+ argc, argv, flags, forced, sizeChanged_ret)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Window corresponding to widgRec. */
+ char * entRec;
+ Tk_ConfigSpec *entConfigSpecs; /* Describes legal options of the entry */
+ Tix_DItem * iPtr; /* points to the entry's data record */
+ int argc;
+ char ** argv;
+ int flags;
+ int forced; /* forced configure of DItem? */
+ int * sizeChanged_ret;
+{
+ Tix_ArgumentList argList;
+ Tk_ConfigSpec *specsList[2];
+ char *widgRecList[2];
+ int code = TCL_OK;
+ int dummy;
+
+ if (sizeChanged_ret == NULL) {
+ sizeChanged_ret = &dummy;
+ }
+
+ specsList[0] = entConfigSpecs;
+ specsList[1] = Tix_DItemConfigSpecs(iPtr);
+ widgRecList[0] = (char*)entRec;
+ widgRecList[1] = (char*)iPtr;
+
+ if (Tix_SplitConfig(interp, tkwin, specsList,
+ 2, argc, argv, &argList) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* Handle the info specific to the entry */
+ if (argList.arg[0].argc > 0) {
+ if (Tk_ConfigureWidget(interp, tkwin,
+ entConfigSpecs, argList.arg[0].argc, argList.arg[0].argv,
+ (char*)entRec, flags) != TCL_OK) {
+
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+
+ if (iPtr == NULL) {
+ goto done;
+ }
+ if (argList.arg[1].argc > 0 || forced) {
+ int oldSize[2];
+ oldSize[0] = iPtr->base.size[0];
+ oldSize[1] = iPtr->base.size[1];
+ if (Tix_DItemConfigure(iPtr, argList.arg[1].argc,
+ argList.arg[1].argv, flags) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ if (oldSize[0] != iPtr->base.size[0] ||
+ oldSize[1] != iPtr->base.size[1]) {
+ * sizeChanged_ret = 1;
+ } else {
+ * sizeChanged_ret = 0;
+ }
+ }
+
+ done:
+
+ Tix_FreeArgumentList(&argList);
+ return code;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * The Tix Customed Config Options
+ *
+ *----------------------------------------------------------------------
+ */
+/*
+ * The global data structures to use in widget configSpecs arrays
+ *
+ * These are declared in <tixConfig.h>
+ */
+
+Tk_CustomOption tixConfigItemType = {
+ DItemParseProc, DItemPrintProc, 0,
+};
+
+/*----------------------------------------------------------------------
+ * DItemParseProc --
+ *
+ * Parse the text string and store the Tix_DItemType information
+ * inside the widget record.
+ *----------------------------------------------------------------------
+ */
+static int DItemParseProc(clientData, interp, tkwin, value, widRec,offset)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ Tk_Window tkwin;
+ char *value;
+ char *widRec;
+ int offset;
+{
+ Tix_DItemInfo *newPtr;
+ Tix_DItemInfo **ptr = (Tix_DItemInfo **)(widRec + offset);
+
+ if (value == NULL) {
+ newPtr = NULL;
+ } else {
+ newPtr = Tix_GetDItemType(interp, value);
+ if (newPtr == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ *ptr = newPtr;
+
+ return TCL_OK;
+}
+
+static char *DItemPrintProc(clientData, tkwin, widRec,offset, freeProcPtr)
+ ClientData clientData;
+ Tk_Window tkwin;
+ char *widRec;
+ int offset;
+ Tcl_FreeProc **freeProcPtr;
+{
+ Tix_DItemInfo *diTypePtr = *((Tix_DItemInfo**)(widRec+offset));
+
+ if (diTypePtr != NULL) {
+ return diTypePtr->name;
+ } else {
+ return 0;
+ }
+}
+/*----------------------------------------------------------------------
+ *
+ *
+ * PRIVATE INTERFACE
+ *
+ *
+ * The following functions are called by display type implementors
+ *
+ *----------------------------------------------------------------------
+ */
+
+/* The priority is selected > disabled > active > normal */
+
+void TixGetColorDItemGC(iPtr, backGC_ret, foreGC_ret, flags)
+ Tix_DItem * iPtr;
+ GC * backGC_ret;
+ GC * foreGC_ret;
+ int flags;
+{
+ TixColorStyle * stylePtr = (TixColorStyle *) iPtr->base.stylePtr;
+
+ if (flags & TIX_DITEM_SELECTED_FG) {
+ *foreGC_ret = stylePtr->colors[TIX_DITEM_SELECTED].foreGC;
+ }
+ else if (flags & TIX_DITEM_DISABLED_FG) {
+ *foreGC_ret = stylePtr->colors[TIX_DITEM_DISABLED].foreGC;
+ }
+ else if (flags & TIX_DITEM_ACTIVE_FG) {
+ *foreGC_ret = stylePtr->colors[TIX_DITEM_ACTIVE].foreGC;
+ }
+ else if (flags & TIX_DITEM_NORMAL_FG) {
+ *foreGC_ret = stylePtr->colors[TIX_DITEM_NORMAL].foreGC;
+ }
+ else {
+ *foreGC_ret = None;
+ }
+
+ if (flags & TIX_DITEM_SELECTED_BG) {
+ *backGC_ret = stylePtr->colors[TIX_DITEM_SELECTED].backGC;
+ }
+ else if (flags & TIX_DITEM_DISABLED_BG) {
+ *backGC_ret = stylePtr->colors[TIX_DITEM_DISABLED].backGC;
+ }
+ else if (flags & TIX_DITEM_ACTIVE_BG) {
+ *backGC_ret = stylePtr->colors[TIX_DITEM_ACTIVE].backGC;
+ }
+ else if (flags & TIX_DITEM_NORMAL_BG) {
+ *backGC_ret = stylePtr->colors[TIX_DITEM_NORMAL].backGC;
+ }
+ else {
+ *backGC_ret = None;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * TixDItemGetAnchor --
+ *
+ * Calculate the position of the element according to its anchor
+ *----------------------------------------------------------------------
+ */
+void
+TixDItemGetAnchor(anchor, x, y, cav_w, cav_h, width, height, x_ret, y_ret)
+ Tk_Anchor anchor;
+ int x;
+ int y;
+ int cav_w;
+ int cav_h;
+ int width;
+ int height;
+ int * x_ret;
+ int * y_ret;
+{
+ if (width > cav_w) {
+ * x_ret = x;
+ } else {
+ int rem = cav_w - width;
+
+ switch (anchor) {
+ case TK_ANCHOR_NW: case TK_ANCHOR_W: case TK_ANCHOR_SW:
+ * x_ret = x;
+ break;
+ case TK_ANCHOR_N: case TK_ANCHOR_CENTER: case TK_ANCHOR_S:
+ * x_ret = x + rem/2;
+ break;
+ default:
+ * x_ret = x + rem;
+ }
+ }
+ if (height > cav_h) {
+ * y_ret = y;
+ }
+ else {
+ int rem = cav_h - height;
+ switch (anchor) {
+ case TK_ANCHOR_NW: case TK_ANCHOR_N: case TK_ANCHOR_NE:
+ * y_ret = y;
+ break;
+ case TK_ANCHOR_W: case TK_ANCHOR_CENTER: case TK_ANCHOR_E:
+ * y_ret = y + rem/2;
+ if ((rem % 2) == 1) {
+ /* Usually it looks better if we shift down one pixel
+ * if the hight of the region is an odd number of pixels
+ */
+ * y_ret += 1;
+ }
+ break;
+ default:
+ * y_ret = y + rem;
+ }
+ }
+}
+
+void Tix_DItemDrawBackground(pixmap, gc, iPtr, x, y, width, height, flags)
+ Pixmap pixmap;
+ GC gc;
+ Tix_DItem * iPtr;
+ int x;
+ int y;
+ int width;
+ int height;
+ int flags;
+{
+ GC foreGC, backGC;
+
+ switch Tix_DItemType(iPtr) {
+ case TIX_DITEM_WINDOW:
+ case TIX_DITEM_NONE:
+ /* not a colored item */
+ return;
+ }
+
+ TixGetColorDItemGC(iPtr, &backGC, &foreGC, flags);
+
+ if (backGC != None) {
+ /* Draw the background */
+ XFillRectangle(iPtr->base.ddPtr->display, pixmap,
+ backGC,
+ x, y, width, height);
+ }
+}
diff --git a/tix/generic/tixDef.h b/tix/generic/tixDef.h
new file mode 100644
index 00000000000..9677435383f
--- /dev/null
+++ b/tix/generic/tixDef.h
@@ -0,0 +1,169 @@
+/*
+ * tixdef.h --
+ *
+ * This file defines the defaults for all options for all of
+ * the Tix widgets.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#ifndef TIX_DEFAULT
+#define TIX_DEFAULT
+
+/*
+ * Include the defaults of the TK distriburion
+ */
+#ifndef _DEFAULT
+#include <default.h>
+#endif
+
+#ifndef CTL_FONT
+#define CTL_FONT "Helvetica -12 bold"
+#endif
+
+#define BORDER_COLOR "gray"
+
+/*
+ * Compound widget
+ */
+#define DEF_CMPIMAGE_BG_COLOR NORMAL_BG
+#define DEF_CMPIMAGE_BG_MONO WHITE
+#define DEF_CMPIMAGE_FG_COLOR BLACK
+#define DEF_CMPIMAGE_FG_MONO BLACK
+#define DEF_CMPIMAGE_FONT CTL_FONT
+
+/*
+ * tixHList widget
+ */
+#define DEF_HLIST_BG_COLOR NORMAL_BG
+#define DEF_HLIST_BG_MONO WHITE
+#define DEF_HLIST_BORDER_WIDTH "2"
+#define DEF_HLIST_BROWSE_COMMAND ""
+#define DEF_HLIST_COMMAND ""
+#define DEF_HLIST_COLUMNS "1"
+#define DEF_HLIST_CURSOR ""
+#define DEF_HLIST_DISPLAY_MODE "tree"
+#define DEF_HLIST_DRAG_COMMAND ""
+#define DEF_HLIST_DRAW_BRANCH "true"
+#define DEF_HLIST_DROP_COMMAND ""
+#define DEF_HLIST_FONT CTL_FONT
+#define DEF_HLIST_FG_COLOR BLACK
+#define DEF_HLIST_FG_MONO BLACK
+#define DEF_HLIST_HEADER "0"
+#define DEF_HLIST_HEIGHT "10"
+#define DEF_HLIST_HIGHLIGHT_COLOR BLACK
+#define DEF_HLIST_HIGHLIGHT_MONO BLACK
+#define DEF_HLIST_HIGHLIGHT_WIDTH "2"
+#define DEF_HLIST_RELIEF "sunken"
+#define DEF_HLIST_ORIENT "vertical"
+#define DEF_HLIST_PADX "2"
+#define DEF_HLIST_PADY "2"
+#define DEF_HLIST_GAP "5"
+#define DEF_HLIST_INDENT "10"
+#define DEF_HLIST_INDICATOR "0"
+#define DEF_HLIST_INDICATOR_CMD ""
+#define DEF_HLIST_ITEM_TYPE "text"
+#define DEF_HLIST_SELECT_BG_COLOR ACTIVE_BG
+#define DEF_HLIST_SELECT_FG_COLOR BLACK
+#define DEF_HLIST_SELECT_BG_MONO BLACK
+#define DEF_HLIST_SELECT_FG_MONO WHITE
+#define DEF_HLIST_SELECT_MODE "browse"
+#define DEF_HLIST_SELECT_BORDERWIDTH "1"
+#define DEF_HLIST_SEPARATOR "."
+#define DEF_HLIST_SIZE_COMMAND ""
+#define DEF_HLIST_TAKE_FOCUS "1"
+#define DEF_HLIST_WIDTH "20"
+#define DEF_HLIST_WIDE_SELECT "true"
+#define DEF_HLIST_Y_SCROLL_COMMAND ""
+#define DEF_HLIST_X_SCROLL_COMMAND ""
+
+/*
+ * HList Entry
+ */
+#define DEF_HLISTENTRY_BITMAP ""
+#define DEF_HLISTENTRY_DATA ""
+#define DEF_HLISTENTRY_GAP "4"
+#define DEF_HLISTENTRY_IMAGE ""
+#define DEF_HLISTENTRY_JUSTIFY "left"
+#define DEF_HLISTENTRY_NAME ""
+#define DEF_HLISTENTRY_PADX "2"
+#define DEF_HLISTENTRY_PADY "2"
+#define DEF_HLISTENTRY_STATE "normal"
+#define DEF_HLISTENTRY_TEXT ""
+#define DEF_HLISTENTRY_UNDERLINE "-1"
+#define DEF_HLISTENTRY_WIDGET ""
+#define DEF_HLISTENTRY_WLENGTH "0"
+
+/*
+ * HList Entry
+ */
+#define DEF_HLISTHEADER_BG_COLOR NORMAL_BG
+#define DEF_HLISTHEADER_BG_MONO WHITE
+#define DEF_HLISTHEADER_BORDER_WIDTH "2"
+#define DEF_HLISTHEADER_RELIEF "raised"
+
+/*
+ * tixNBFrame widget
+ */
+#define DEF_NOTEBOOKFRAME_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_NOTEBOOKFRAME_ACTIVE_BG_MONO WHITE
+#define DEF_NOTEBOOKFRAME_INACTIVE_BG_COLOR NORMAL_BG
+#define DEF_NOTEBOOKFRAME_INACTIVE_BG_MONO WHITE
+#define DEF_NOTEBOOKFRAME_BACKPAGE_COLOR NORMAL_BG
+#define DEF_NOTEBOOKFRAME_BACKPAGE_MONO WHITE
+#define DEF_NOTEBOOKFRAME_BG_COLOR NORMAL_BG
+#define DEF_NOTEBOOKFRAME_BG_MONO WHITE
+#define DEF_NOTEBOOKFRAME_DISABLED_FG_COLOR DISABLED
+#define DEF_NOTEBOOKFRAME_DISABLED_FG_MONO ""
+#define DEF_NOTEBOOKFRAME_FOCUS_COLOR BLACK
+#define DEF_NOTEBOOKFRAME_FOCUS_MONO BLACK
+#define DEF_NOTEBOOKFRAME_BORDER_WIDTH "2"
+#define DEF_NOTEBOOKFRAME_CURSOR ""
+#define DEF_NOTEBOOKFRAME_FONT CTL_FONT
+#define DEF_NOTEBOOKFRAME_FG_COLOR BLACK
+#define DEF_NOTEBOOKFRAME_FG_MONO BLACK
+#define DEF_NOTEBOOKFRAME_RELIEF "sunken"
+#define DEF_NOTEBOOKFRAME_SLAVE "1"
+#define DEF_NOTEBOOKFRAME_TAKE_FOCUS "1"
+#define DEF_NOTEBOOKFRAME_WIDTH "10"
+#define DEF_NOTEBOOKFRAME_TABPADX "6"
+#define DEF_NOTEBOOKFRAME_TABPADY "5"
+
+/*
+ * tixTList.h
+ */
+#define DEF_TLIST_BG_COLOR NORMAL_BG
+#define DEF_TLIST_BG_MONO WHITE
+#define DEF_TLIST_BORDER_WIDTH "2"
+#define DEF_TLIST_BROWSE_COMMAND ""
+#define DEF_TLIST_COMMAND ""
+#define DEF_TLIST_CURSOR ""
+#define DEF_TLIST_FONT CTL_FONT
+#define DEF_TLIST_FG_COLOR BLACK
+#define DEF_TLIST_FG_MONO BLACK
+#define DEF_TLIST_HEIGHT "10"
+#define DEF_TLIST_HIGHLIGHT_COLOR BLACK
+#define DEF_TLIST_HIGHLIGHT_MONO BLACK
+#define DEF_TLIST_HIGHLIGHT_WIDTH "2"
+#define DEF_TLIST_ITEM_TYPE "text"
+#define DEF_TLIST_RELIEF "sunken"
+#define DEF_TLIST_ORIENT "vertical"
+#define DEF_TLIST_PADX "2"
+#define DEF_TLIST_PADY "2"
+#define DEF_TLIST_SELECT_BG_COLOR ACTIVE_BG
+#define DEF_TLIST_SELECT_FG_COLOR BLACK
+#define DEF_TLIST_SELECT_BG_MONO BLACK
+#define DEF_TLIST_SELECT_FG_MONO WHITE
+#define DEF_TLIST_SELECT_MODE "browse"
+#define DEF_TLIST_SELECT_BORDERWIDTH "1"
+#define DEF_TLIST_STATE "normal"
+#define DEF_TLIST_SIZE_COMMAND ""
+#define DEF_TLIST_TAKE_FOCUS "1"
+#define DEF_TLIST_WIDTH "20"
+#define DEF_TLIST_Y_SCROLL_COMMAND ""
+#define DEF_TLIST_X_SCROLL_COMMAND ""
+
+#endif /* TIX_DEFAULT */
diff --git a/tix/generic/tixDiITxt.c b/tix/generic/tixDiITxt.c
new file mode 100644
index 00000000000..67785f0ef65
--- /dev/null
+++ b/tix/generic/tixDiITxt.c
@@ -0,0 +1,758 @@
+/*
+ * tixDiImgTxt.c --
+ *
+ * This file implements one of the "Display Items" in the Tix library :
+ * Image-text display items.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tk.h>
+#include <tixInt.h>
+#include <tixDef.h>
+
+#define DEF_IMAGETEXTITEM_BITMAP ""
+#define DEF_IMAGETEXTITEM_IMAGE ""
+#define DEF_IMAGETEXTITEM_TYPE "imagetext"
+#define DEF_IMAGETEXTITEM_SHOWIMAGE "1"
+#define DEF_IMAGETEXTITEM_SHOWTEXT "1"
+#define DEF_IMAGETEXTITEM_STYLE ""
+#define DEF_IMAGETEXTITEM_TEXT ""
+#define DEF_IMAGETEXTITEM_UNDERLINE "-1"
+
+static Tk_ConfigSpec imageTextItemConfigSpecs[] = {
+
+ {TK_CONFIG_BITMAP, "-bitmap", "bitmap", "Bitmap",
+ DEF_IMAGETEXTITEM_BITMAP, Tk_Offset(TixImageTextItem, bitmap),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_STRING, "-image", "image", "Image",
+ DEF_IMAGETEXTITEM_IMAGE, Tk_Offset(TixImageTextItem, imageString),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_CUSTOM, "-itemtype", "itemType", "ItemType",
+ DEF_IMAGETEXTITEM_TYPE, Tk_Offset(TixImageTextItem, diTypePtr),
+ 0, &tixConfigItemType},
+
+ {TK_CONFIG_INT, "-showimage", "showImage", "ShowImage",
+ DEF_IMAGETEXTITEM_SHOWIMAGE, Tk_Offset(TixImageTextItem, showImage), 0},
+
+ {TK_CONFIG_INT, "-showtext", "showText", "ShowText",
+ DEF_IMAGETEXTITEM_SHOWTEXT, Tk_Offset(TixImageTextItem, showText), 0},
+
+ {TK_CONFIG_CUSTOM, "-style", "imageTextStyle", "ImageTextStyle",
+ DEF_IMAGETEXTITEM_STYLE, Tk_Offset(TixImageTextItem, stylePtr),
+ TK_CONFIG_NULL_OK, &tixConfigItemStyle},
+
+ {TK_CONFIG_STRING, "-text", "text", "Text",
+ DEF_IMAGETEXTITEM_TEXT, Tk_Offset(TixImageTextItem, text),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_INT, "-underline", "underline", "Underline",
+ DEF_IMAGETEXTITEM_UNDERLINE, Tk_Offset(TixImageTextItem, underline), 0},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*----------------------------------------------------------------------
+ *
+ * Configuration options for Text Styles
+ *
+ *----------------------------------------------------------------------
+ */
+
+
+#define SELECTED_BG SELECT_BG
+#define DISABLED_BG DISABLED
+
+#define DEF_IMAGETEXTSTYLE_NORMAL_FG_COLOR BLACK
+#define DEF_IMAGETEXTSTYLE_NORMAL_FG_MONO BLACK
+#define DEF_IMAGETEXTSTYLE_NORMAL_BG_COLOR NORMAL_BG
+#define DEF_IMAGETEXTSTYLE_NORMAL_BG_MONO WHITE
+
+#define DEF_IMAGETEXTSTYLE_ACTIVE_FG_COLOR BLACK
+#define DEF_IMAGETEXTSTYLE_ACTIVE_FG_MONO WHITE
+#define DEF_IMAGETEXTSTYLE_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_IMAGETEXTSTYLE_ACTIVE_BG_MONO BLACK
+
+#define DEF_IMAGETEXTSTYLE_SELECTED_FG_COLOR BLACK
+#define DEF_IMAGETEXTSTYLE_SELECTED_FG_MONO WHITE
+#define DEF_IMAGETEXTSTYLE_SELECTED_BG_COLOR SELECTED_BG
+#define DEF_IMAGETEXTSTYLE_SELECTED_BG_MONO BLACK
+
+#define DEF_IMAGETEXTSTYLE_DISABLED_FG_COLOR BLACK
+#define DEF_IMAGETEXTSTYLE_DISABLED_FG_MONO BLACK
+#define DEF_IMAGETEXTSTYLE_DISABLED_BG_COLOR DISABLED_BG
+#define DEF_IMAGETEXTSTYLE_DISABLED_BG_MONO WHITE
+
+#define DEF_IMAGETEXTSTYLE_FONT CTL_FONT
+#define DEF_IMAGETEXTSTYLE_GAP "4"
+#define DEF_IMAGETEXTSTYLE_PADX "2"
+#define DEF_IMAGETEXTSTYLE_PADY "2"
+#define DEF_IMAGETEXTSTYLE_JUSTIFY "left"
+#define DEF_IMAGETEXTSTYLE_WLENGTH "0"
+#define DEF_IMAGETEXTSTYLE_ANCHOR "w"
+
+
+static Tk_ConfigSpec imageTextStyleConfigSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_IMAGETEXTSTYLE_ANCHOR, Tk_Offset(TixImageTextStyle, anchor), 0},
+
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+
+ {TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_IMAGETEXTSTYLE_FONT, Tk_Offset(TixImageTextStyle, font), 0},
+
+ {TK_CONFIG_PIXELS, "-gap", "gap", "Gap",
+ DEF_IMAGETEXTSTYLE_GAP, Tk_Offset(TixImageTextStyle, gap), 0},
+
+ {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justyfy",
+ DEF_IMAGETEXTSTYLE_JUSTIFY, Tk_Offset(TixImageTextStyle, justify),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
+ DEF_IMAGETEXTSTYLE_PADX, Tk_Offset(TixImageTextStyle, pad[0]), 0},
+
+ {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
+ DEF_IMAGETEXTSTYLE_PADY, Tk_Offset(TixImageTextStyle, pad[1]), 0},
+
+ {TK_CONFIG_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+ DEF_IMAGETEXTSTYLE_WLENGTH, Tk_Offset(TixImageTextStyle, wrapLength),
+ 0},
+
+/* The following is automatically generated */
+ {TK_CONFIG_COLOR,"-background","background","Background",
+ DEF_IMAGETEXTSTYLE_NORMAL_BG_COLOR,
+ Tk_Offset(TixImageTextStyle,colors[TIX_DITEM_NORMAL].bg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-background","background","Background",
+ DEF_IMAGETEXTSTYLE_NORMAL_BG_MONO,
+ Tk_Offset(TixImageTextStyle,colors[TIX_DITEM_NORMAL].bg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-foreground","foreground","Foreground",
+ DEF_IMAGETEXTSTYLE_NORMAL_FG_COLOR,
+ Tk_Offset(TixImageTextStyle,colors[TIX_DITEM_NORMAL].fg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-foreground","foreground","Foreground",
+ DEF_IMAGETEXTSTYLE_NORMAL_FG_MONO,
+ Tk_Offset(TixImageTextStyle,colors[TIX_DITEM_NORMAL].fg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-activebackground","activeBackground","ActiveBackground",
+ DEF_IMAGETEXTSTYLE_ACTIVE_BG_COLOR,
+ Tk_Offset(TixImageTextStyle,colors[TIX_DITEM_ACTIVE].bg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-activebackground","activeBackground","ActiveBackground",
+ DEF_IMAGETEXTSTYLE_ACTIVE_BG_MONO,
+ Tk_Offset(TixImageTextStyle,colors[TIX_DITEM_ACTIVE].bg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-activeforeground","activeForeground","ActiveForeground",
+ DEF_IMAGETEXTSTYLE_ACTIVE_FG_COLOR,
+ Tk_Offset(TixImageTextStyle,colors[TIX_DITEM_ACTIVE].fg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-activeforeground","activeForeground","ActiveForeground",
+ DEF_IMAGETEXTSTYLE_ACTIVE_FG_MONO,
+ Tk_Offset(TixImageTextStyle,colors[TIX_DITEM_ACTIVE].fg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-selectbackground","selectBackground","SelectBackground",
+ DEF_IMAGETEXTSTYLE_SELECTED_BG_COLOR,
+ Tk_Offset(TixImageTextStyle,colors[TIX_DITEM_SELECTED].bg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-selectbackground","selectBackground","SelectBackground",
+ DEF_IMAGETEXTSTYLE_SELECTED_BG_MONO,
+ Tk_Offset(TixImageTextStyle,colors[TIX_DITEM_SELECTED].bg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-selectforeground","selectForeground","SelectForeground",
+ DEF_IMAGETEXTSTYLE_SELECTED_FG_COLOR,
+ Tk_Offset(TixImageTextStyle,colors[TIX_DITEM_SELECTED].fg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-selectforeground","selectForeground","SelectForeground",
+ DEF_IMAGETEXTSTYLE_SELECTED_FG_MONO,
+ Tk_Offset(TixImageTextStyle,colors[TIX_DITEM_SELECTED].fg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-disabledbackground","disabledBackground","DisabledBackground",
+ DEF_IMAGETEXTSTYLE_DISABLED_BG_COLOR,
+ Tk_Offset(TixImageTextStyle,colors[TIX_DITEM_DISABLED].bg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-disabledbackground","disabledBackground","DisabledBackground",
+ DEF_IMAGETEXTSTYLE_DISABLED_BG_MONO,
+ Tk_Offset(TixImageTextStyle,colors[TIX_DITEM_DISABLED].bg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-disabledforeground","disabledForeground","DisabledForeground",
+ DEF_IMAGETEXTSTYLE_DISABLED_FG_COLOR,
+ Tk_Offset(TixImageTextStyle,colors[TIX_DITEM_DISABLED].fg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-disabledforeground","disabledForeground","DisabledForeground",
+ DEF_IMAGETEXTSTYLE_DISABLED_FG_MONO,
+ Tk_Offset(TixImageTextStyle,colors[TIX_DITEM_DISABLED].fg),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*----------------------------------------------------------------------
+ * Forward declarations for procedures defined later in this file:
+ *----------------------------------------------------------------------
+ */
+static void ImageProc _ANSI_ARGS_((ClientData clientData,
+ int x, int y, int width, int height,
+ int imgWidth, int imgHeight));
+static void Tix_ImageTextItemCalculateSize _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+static char * Tix_ImageTextItemComponent _ANSI_ARGS_((
+ Tix_DItem * iPtr, int x, int y));
+static int Tix_ImageTextItemConfigure _ANSI_ARGS_((
+ Tix_DItem * iPtr, int argc, char ** argv,
+ int flags));
+static Tix_DItem * Tix_ImageTextItemCreate _ANSI_ARGS_((
+ Tix_DispData * ddPtr, Tix_DItemInfo * diTypePtr));
+static void Tix_ImageTextItemDisplay _ANSI_ARGS_((
+ Pixmap pixmap, GC gc, Tix_DItem * iPtr,
+ int x, int y, int width, int height, int flag));
+static void Tix_ImageTextItemFree _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+static void Tix_ImageTextItemLostStyle _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+static void Tix_ImageTextItemStyleChanged _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+static int Tix_ImageTextStyleConfigure _ANSI_ARGS_((
+ Tix_DItemStyle* style, int argc, char ** argv,
+ int flags));
+static Tix_DItemStyle * Tix_ImageTextStyleCreate _ANSI_ARGS_((
+ Tcl_Interp *interp, Tk_Window tkwin,
+ Tix_DItemInfo * diTypePtr, char * name));
+static void Tix_ImageTextStyleFree _ANSI_ARGS_((
+ Tix_DItemStyle* style));
+static void Tix_ImageTextStyleSetTemplate _ANSI_ARGS_((
+ Tix_DItemStyle* style,
+ Tix_StyleTemplate * tmplPtr));
+
+Tix_DItemInfo tix_ImageTextItemType = {
+ "imagetext", /* type */
+ TIX_DITEM_IMAGETEXT,
+ Tix_ImageTextItemCreate, /* createProc */
+ Tix_ImageTextItemConfigure,
+ Tix_ImageTextItemCalculateSize,
+ Tix_ImageTextItemComponent,
+ Tix_ImageTextItemDisplay,
+ Tix_ImageTextItemFree,
+ Tix_ImageTextItemStyleChanged,
+ Tix_ImageTextItemLostStyle,
+
+ Tix_ImageTextStyleCreate,
+ Tix_ImageTextStyleConfigure,
+ Tix_ImageTextStyleFree,
+ Tix_ImageTextStyleSetTemplate,
+
+ imageTextItemConfigSpecs,
+ imageTextStyleConfigSpecs,
+ NULL, /*next */
+};
+
+
+/*----------------------------------------------------------------------
+ * Tix_ImageText --
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static Tix_DItem * Tix_ImageTextItemCreate(ddPtr, diTypePtr)
+ Tix_DispData * ddPtr;
+ Tix_DItemInfo * diTypePtr;
+{
+ TixImageTextItem * itPtr;
+
+ itPtr = (TixImageTextItem*) ckalloc(sizeof(TixImageTextItem));
+
+ itPtr->diTypePtr = diTypePtr;
+ itPtr->ddPtr = ddPtr;
+ itPtr->stylePtr = NULL;
+ itPtr->clientData = 0;
+ itPtr->size[0] = 0;
+ itPtr->size[1] = 0;
+
+ itPtr->bitmap = None;
+ itPtr->bitmapW = 0;
+ itPtr->bitmapH = 0;
+
+ itPtr->imageString = NULL;
+ itPtr->image = NULL;
+ itPtr->imageW = 0;
+ itPtr->imageH = 0;
+
+ itPtr->numChars = 0;
+ itPtr->text = NULL;
+ itPtr->textW = 0;
+ itPtr->textH = 0;
+ itPtr->underline = -1;
+
+ itPtr->showImage = 1;
+ itPtr->showText = 1;
+
+ return (Tix_DItem *)itPtr;
+}
+
+static void Tix_ImageTextItemFree(iPtr)
+ Tix_DItem * iPtr;
+{
+ TixImageTextItem * itPtr = (TixImageTextItem *) iPtr;
+
+ if (itPtr->image) {
+ Tk_FreeImage(itPtr->image);
+ }
+ if (itPtr->stylePtr) {
+ TixDItemStyleFree(iPtr, (Tix_DItemStyle*)itPtr->stylePtr);
+ }
+
+ Tk_FreeOptions(imageTextItemConfigSpecs, (char *)itPtr,
+ itPtr->ddPtr->display, 0);
+ ckfree((char*)itPtr);
+}
+
+static int Tix_ImageTextItemConfigure(iPtr, argc, argv, flags)
+ Tix_DItem * iPtr;
+ int argc;
+ char ** argv;
+ int flags;
+{
+ TixImageTextItem * itPtr = (TixImageTextItem *) iPtr;
+ TixImageTextStyle * oldStyle = itPtr->stylePtr;
+
+ if (Tk_ConfigureWidget(itPtr->ddPtr->interp, itPtr->ddPtr->tkwin,
+ imageTextItemConfigSpecs,
+ argc, argv, (char *)itPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (itPtr->stylePtr == NULL) {
+ itPtr->stylePtr = (TixImageTextStyle*)TixGetDefaultDItemStyle(
+ itPtr->ddPtr, &tix_ImageTextItemType, iPtr, NULL);
+ }
+
+ /*
+ * Free the old images for the widget, if there were any.
+ */
+ if (itPtr->image != NULL) {
+ Tk_FreeImage(itPtr->image);
+ itPtr->image = NULL;
+ }
+
+ if (itPtr->imageString != NULL) {
+ itPtr->image = Tk_GetImage(itPtr->ddPtr->interp, itPtr->ddPtr->tkwin,
+ itPtr->imageString, ImageProc, (ClientData) itPtr);
+ if (itPtr->image == NULL) {
+ return TCL_ERROR;
+ }
+ }
+
+ if (oldStyle != NULL && itPtr->stylePtr != oldStyle) {
+ Tix_ImageTextItemStyleChanged(iPtr);
+ }
+ else {
+ Tix_ImageTextItemCalculateSize((Tix_DItem*)itPtr);
+ }
+
+ return TCL_OK;
+}
+
+static void Tix_ImageTextItemDisplay(pixmap, gc, iPtr, x, y,
+ width, height, flags)
+ Pixmap pixmap;
+ GC gc;
+ Tix_DItem * iPtr;
+ int x;
+ int y;
+ int width;
+ int height;
+ int flags;
+{
+ TixImageTextItem *itPtr = (TixImageTextItem *)iPtr;
+ GC foreGC, backGC;
+ TixpSubRegion subReg;
+
+ if ((width <= 0) || (height <= 0)) {
+ return;
+ }
+
+ TixGetColorDItemGC(iPtr, &backGC, &foreGC, flags);
+ TixpStartSubRegionDraw(itPtr->ddPtr->display, pixmap, foreGC,
+ &subReg, 0, 0, x, y, width, height,
+ itPtr->size[0], itPtr->size[1]);
+ TixDItemGetAnchor(itPtr->stylePtr->anchor, x, y, width, height,
+ itPtr->size[0], itPtr->size[1], &x, &y);
+
+ if (backGC != None) {
+ TixpSubRegFillRectangle(itPtr->ddPtr->display, pixmap,
+ backGC, &subReg, x, y, width, height);
+ }
+
+ if (itPtr->image != NULL) {
+ int bitY;
+
+ bitY = itPtr->size[1] - itPtr->imageH - 2*itPtr->stylePtr->pad[1];
+
+ if (bitY > 0) {
+ bitY = bitY / 2 + (bitY %2);
+ } else {
+ bitY = 0;
+ }
+ if (itPtr->showImage) {
+ TixpSubRegDrawImage(&subReg, itPtr->image, 0, 0,
+ itPtr->imageW, itPtr->imageH, pixmap,
+ x + itPtr->stylePtr->pad[0],
+ y + itPtr->stylePtr->pad[1] + bitY);
+ }
+ x += itPtr->imageW + itPtr->stylePtr->gap;
+ }
+ else if (itPtr->bitmap != None && foreGC != None) {
+ int bitY;
+
+ bitY = itPtr->size[1] - itPtr->bitmapH - 2*itPtr->stylePtr->pad[1];
+ if (bitY > 0) {
+ bitY = bitY / 2 + (bitY %2);
+ } else {
+ bitY = 0;
+ }
+
+ if (itPtr->showImage) {
+ TixpSubRegDrawBitmap(itPtr->ddPtr->display, pixmap, foreGC,
+ &subReg, itPtr->bitmap, 0, 0,
+ itPtr->bitmapW, itPtr->bitmapH,
+ x + itPtr->stylePtr->pad[0],
+ y + itPtr->stylePtr->pad[1] + bitY,
+ 1);
+ }
+ x += itPtr->bitmapW + itPtr->stylePtr->gap;
+ }
+
+ if (itPtr->text && itPtr->showText && foreGC != None) {
+ int textY;
+
+ textY = itPtr->size[1] - itPtr->textH - 2*itPtr->stylePtr->pad[1];
+ if (textY > 0) {
+ textY = textY / 2 + (textY %2);
+ } else {
+ textY = 0;
+ }
+
+ TixpSubRegDisplayText(itPtr->ddPtr->display, pixmap, foreGC, &subReg,
+ itPtr->stylePtr->font, itPtr->text, itPtr->numChars,
+ x + itPtr->stylePtr->pad[0],
+ y + itPtr->stylePtr->pad[1] + textY,
+ itPtr->textW,
+ itPtr->stylePtr->justify,
+ itPtr->underline);
+ }
+
+ TixpEndSubRegionDraw(itPtr->ddPtr->display, pixmap, foreGC,
+ &subReg);
+}
+
+static void Tix_ImageTextItemCalculateSize(iPtr)
+ Tix_DItem * iPtr;
+{
+ TixImageTextItem *itPtr = (TixImageTextItem *)iPtr;
+
+ itPtr->size[0] = 0;
+ itPtr->size[1] = 0;
+
+ /* Note: the size of the image or the text are used even when
+ * the showImage or showText options are off. These two options are
+ * used to "blank" the respective components temporarily without
+ * affecting the geometry of the ditem. The main is to indicate
+ * transfer during drag+drop.
+ *
+ * If you want the image or text to completely disappear, config them
+ * to NULL
+ */
+ if (itPtr->image != NULL) {
+ Tk_SizeOfImage(itPtr->image, &itPtr->imageW, &itPtr->imageH);
+
+ itPtr->size[0] = itPtr->imageW + itPtr->stylePtr->gap;
+ itPtr->size[1] = itPtr->imageH;
+ }
+ else if (itPtr->bitmap != None) {
+ Tk_SizeOfBitmap(itPtr->ddPtr->display, itPtr->bitmap, &itPtr->bitmapW,
+ &itPtr->bitmapH);
+
+ itPtr->size[0] = itPtr->bitmapW + itPtr->stylePtr->gap;
+ itPtr->size[1] = itPtr->bitmapH;
+ }
+
+ if (itPtr->text) {
+ itPtr->numChars = strlen(itPtr->text);
+ TixComputeTextGeometry(itPtr->stylePtr->font, itPtr->text,
+ itPtr->numChars, itPtr->stylePtr->wrapLength,
+ &itPtr->textW, &itPtr->textH);
+
+ itPtr->size[0] += itPtr->textW;
+
+ if (itPtr->textH > itPtr->size[1]) {
+ itPtr->size[1] = itPtr->textH;
+ }
+ }
+
+ itPtr->size[0] += 2*itPtr->stylePtr->pad[0];
+ itPtr->size[1] += 2*itPtr->stylePtr->pad[1];
+}
+
+static char * Tix_ImageTextItemComponent(iPtr, x, y)
+ Tix_DItem * iPtr;
+ int x;
+ int y;
+{
+ /* Unimplemented */
+#if 0
+ TixImageTextItem *itPtr = (TixImageTextItem *)iPtr;
+#endif
+
+ static char * body = "body";
+
+ return body;
+}
+
+
+static void Tix_ImageTextItemStyleChanged(iPtr)
+ Tix_DItem * iPtr;
+{
+ TixImageTextItem *itPtr = (TixImageTextItem *)iPtr;
+
+ if (itPtr->stylePtr == NULL) {
+ /* Maybe we haven't set the style to default style yet */
+ return;
+ }
+ Tix_ImageTextItemCalculateSize(iPtr);
+ if (itPtr->ddPtr->sizeChangedProc != NULL) {
+ itPtr->ddPtr->sizeChangedProc(iPtr);
+ }
+}
+static void Tix_ImageTextItemLostStyle(iPtr)
+ Tix_DItem * iPtr;
+{
+ TixImageTextItem *itPtr = (TixImageTextItem *)iPtr;
+
+ itPtr->stylePtr = (TixImageTextStyle*)TixGetDefaultDItemStyle(
+ itPtr->ddPtr, &tix_ImageTextItemType, iPtr, NULL);
+
+ Tix_ImageTextItemStyleChanged(iPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageProc --
+ *
+ * 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 this widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the HList to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ImageProc(clientData, x, y, width, height, imgWidth, imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ TixImageTextItem *itPtr = (TixImageTextItem *)clientData;
+
+ Tix_ImageTextItemCalculateSize((Tix_DItem *)itPtr);
+ if (itPtr->ddPtr->sizeChangedProc != NULL) {
+ itPtr->ddPtr->sizeChangedProc((Tix_DItem *)itPtr);
+ }
+}
+
+/*----------------------------------------------------------------------
+ *
+ *
+ * Display styles
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static Tix_DItemStyle *
+Tix_ImageTextStyleCreate(interp, tkwin, diTypePtr, name)
+ Tcl_Interp * interp;
+ Tk_Window tkwin;
+ char * name;
+ Tix_DItemInfo * diTypePtr;
+{
+ int i;
+ TixImageTextStyle * stylePtr =
+ (TixImageTextStyle *)ckalloc(sizeof(TixImageTextStyle));
+
+ stylePtr->font = NULL;
+ stylePtr->gap = 0;
+ stylePtr->justify = TK_JUSTIFY_LEFT;
+ stylePtr->wrapLength = 0;
+ stylePtr->pad[0] = 0;
+ stylePtr->pad[1] = 0;
+ stylePtr->anchor = TK_ANCHOR_CENTER;
+
+ for (i=0; i<4; i++) {
+ stylePtr->colors[i].bg = NULL;
+ stylePtr->colors[i].fg = NULL;
+ stylePtr->colors[i].backGC = None;
+ stylePtr->colors[i].foreGC = NULL;
+ }
+
+ return (Tix_DItemStyle *)stylePtr;
+}
+
+static int
+Tix_ImageTextStyleConfigure(style, argc, argv, flags)
+ Tix_DItemStyle *style;
+ int argc;
+ char ** argv;
+ int flags;
+{
+ TixImageTextStyle * stylePtr = (TixImageTextStyle *)style;
+ XGCValues gcValues;
+ GC newGC;
+ int i, isNew;
+
+ if (stylePtr->font == NULL) {
+ isNew = 1;
+ } else {
+ isNew = 0;
+ }
+
+ if (!(flags &TIX_DONT_CALL_CONFIG)) {
+ if (Tk_ConfigureWidget(stylePtr->interp, stylePtr->tkwin,
+ imageTextStyleConfigSpecs,
+ argc, argv, (char *)stylePtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ gcValues.font = TixFontId(stylePtr->font);
+ gcValues.graphics_exposures = False;
+
+ for (i=0; i<4; i++) {
+ /* Foreground */
+ gcValues.background = stylePtr->colors[i].bg->pixel;
+ gcValues.foreground = stylePtr->colors[i].fg->pixel;
+ newGC = Tk_GetGC(stylePtr->tkwin,
+ GCFont|GCForeground|GCBackground|GCGraphicsExposures, &gcValues);
+
+ if (stylePtr->colors[i].foreGC != None) {
+ Tk_FreeGC(Tk_Display(stylePtr->tkwin),
+ stylePtr->colors[i].foreGC);
+ }
+ stylePtr->colors[i].foreGC = newGC;
+
+ /* Background */
+ gcValues.foreground = stylePtr->colors[i].bg->pixel;
+ newGC = Tk_GetGC(stylePtr->tkwin,
+ GCFont|GCForeground|GCGraphicsExposures, &gcValues);
+
+ if (stylePtr->colors[i].backGC != None) {
+ Tk_FreeGC(Tk_Display(stylePtr->tkwin),
+ stylePtr->colors[i].backGC);
+ }
+ stylePtr->colors[i].backGC = newGC;
+ }
+
+ if (!isNew) {
+ TixDItemStyleChanged(stylePtr->diTypePtr, (Tix_DItemStyle *)stylePtr);
+ }
+
+ return TCL_OK;
+}
+
+static void Tix_ImageTextStyleFree(style)
+ Tix_DItemStyle *style;
+{
+ TixImageTextStyle * stylePtr = (TixImageTextStyle *)style;
+ int i;
+
+ for (i=0; i<4; i++) {
+ if (stylePtr->colors[i].backGC != None) {
+ Tk_FreeGC(Tk_Display(stylePtr->tkwin), stylePtr->colors[i].backGC);
+ }
+ if (stylePtr->colors[i].foreGC != None) {
+ Tk_FreeGC(Tk_Display(stylePtr->tkwin), stylePtr->colors[i].foreGC);
+ }
+ }
+
+ Tk_FreeOptions(imageTextStyleConfigSpecs, (char *)stylePtr,
+ Tk_Display(stylePtr->tkwin), 0);
+ ckfree((char *)stylePtr);
+}
+
+static int bg_flags [4] = {
+ TIX_DITEM_NORMAL_BG,
+ TIX_DITEM_ACTIVE_BG,
+ TIX_DITEM_SELECTED_BG,
+ TIX_DITEM_DISABLED_BG
+};
+static int fg_flags [4] = {
+ TIX_DITEM_NORMAL_FG,
+ TIX_DITEM_ACTIVE_FG,
+ TIX_DITEM_SELECTED_FG,
+ TIX_DITEM_DISABLED_FG
+};
+
+static void
+Tix_ImageTextStyleSetTemplate(style, tmplPtr)
+ Tix_DItemStyle* style;
+ Tix_StyleTemplate * tmplPtr;
+{
+ TixImageTextStyle * stylePtr = (TixImageTextStyle *)style;
+ int i;
+
+ if (tmplPtr->flags & TIX_DITEM_FONT) {
+ if (stylePtr->font != NULL) {
+ TixFreeFont(stylePtr->font);
+ }
+ stylePtr->font = TixGetFont(
+ stylePtr->interp, stylePtr->tkwin,
+ TixNameOfFont(tmplPtr->font));
+ }
+ if (tmplPtr->flags & TIX_DITEM_PADX) {
+ stylePtr->pad[0] = tmplPtr->pad[0];
+ }
+ if (tmplPtr->flags & TIX_DITEM_PADY) {
+ stylePtr->pad[1] = tmplPtr->pad[1];
+ }
+
+ for (i=0; i<4; i++) {
+ if (tmplPtr->flags & bg_flags[i]) {
+ if (stylePtr->colors[i].bg != NULL) {
+ Tk_FreeColor(stylePtr->colors[i].bg);
+ }
+ stylePtr->colors[i].bg = Tk_GetColor(
+ stylePtr->interp, stylePtr->tkwin,
+ Tk_NameOfColor(tmplPtr->colors[i].bg));
+ }
+ }
+ for (i=0; i<4; i++) {
+ if (tmplPtr->flags & fg_flags[i]) {
+ if (stylePtr->colors[i].fg != NULL) {
+ Tk_FreeColor(stylePtr->colors[i].fg);
+ }
+ stylePtr->colors[i].fg = Tk_GetColor(
+ stylePtr->interp, stylePtr->tkwin,
+ Tk_NameOfColor(tmplPtr->colors[i].fg));
+ }
+ }
+
+ Tix_ImageTextStyleConfigure(style, 0, 0, TIX_DONT_CALL_CONFIG);
+}
diff --git a/tix/generic/tixDiImg.c b/tix/generic/tixDiImg.c
new file mode 100644
index 00000000000..bd44f1830b7
--- /dev/null
+++ b/tix/generic/tixDiImg.c
@@ -0,0 +1,611 @@
+/*
+ * tixDiImgTxt.c --
+ *
+ * This file implements one of the "Display Items" in the Tix library :
+ * Image-text display items.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixDef.h>
+
+#define DEF_IMAGEITEM_BITMAP ""
+#define DEF_IMAGEITEM_IMAGE ""
+#define DEF_IMAGEITEM_TYPE "image"
+#define DEF_IMAGEITEM_SHOWIMAGE "1"
+#define DEF_IMAGEITEM_SHOWTEXT "1"
+#define DEF_IMAGEITEM_STYLE ""
+#define DEF_IMAGEITEM_TEXT ""
+#define DEF_IMAGEITEM_UNDERLINE "-1"
+
+static Tk_ConfigSpec imageItemConfigSpecs[] = {
+
+ {TK_CONFIG_STRING, "-image", "image", "Image",
+ DEF_IMAGEITEM_IMAGE, Tk_Offset(TixImageItem, imageString),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_CUSTOM, "-itemtype", "itemType", "ItemType",
+ DEF_IMAGEITEM_TYPE, Tk_Offset(TixImageItem, diTypePtr),
+ 0, &tixConfigItemType},
+
+ {TK_CONFIG_CUSTOM, "-style", "imageStyle", "ImageStyle",
+ DEF_IMAGEITEM_STYLE, Tk_Offset(TixImageItem, stylePtr),
+ TK_CONFIG_NULL_OK, &tixConfigItemStyle},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*----------------------------------------------------------------------
+ *
+ * Configuration options for Text Styles
+ *
+ *----------------------------------------------------------------------
+ */
+
+
+#define SELECTED_BG SELECT_BG
+#define DISABLED_BG DISABLED
+
+#define DEF_IMAGESTYLE_NORMAL_FG_COLOR BLACK
+#define DEF_IMAGESTYLE_NORMAL_FG_MONO BLACK
+#define DEF_IMAGESTYLE_NORMAL_BG_COLOR NORMAL_BG
+#define DEF_IMAGESTYLE_NORMAL_BG_MONO WHITE
+
+#define DEF_IMAGESTYLE_ACTIVE_FG_COLOR BLACK
+#define DEF_IMAGESTYLE_ACTIVE_FG_MONO WHITE
+#define DEF_IMAGESTYLE_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_IMAGESTYLE_ACTIVE_BG_MONO BLACK
+
+#define DEF_IMAGESTYLE_SELECTED_FG_COLOR BLACK
+#define DEF_IMAGESTYLE_SELECTED_FG_MONO WHITE
+#define DEF_IMAGESTYLE_SELECTED_BG_COLOR SELECTED_BG
+#define DEF_IMAGESTYLE_SELECTED_BG_MONO BLACK
+
+#define DEF_IMAGESTYLE_DISABLED_FG_COLOR BLACK
+#define DEF_IMAGESTYLE_DISABLED_FG_MONO BLACK
+#define DEF_IMAGESTYLE_DISABLED_BG_COLOR DISABLED_BG
+#define DEF_IMAGESTYLE_DISABLED_BG_MONO WHITE
+
+#define DEF_IMAGESTYLE_PADX "0"
+#define DEF_IMAGESTYLE_PADY "0"
+#define DEF_IMAGESTYLE_ANCHOR "w"
+
+
+static Tk_ConfigSpec imageStyleConfigSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_IMAGESTYLE_ANCHOR, Tk_Offset(TixImageStyle, anchor), 0},
+
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+
+ {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
+ DEF_IMAGESTYLE_PADX, Tk_Offset(TixImageStyle, pad[0]), 0},
+
+ {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
+ DEF_IMAGESTYLE_PADY, Tk_Offset(TixImageStyle, pad[1]), 0},
+
+/* The following is automatically generated */
+ {TK_CONFIG_COLOR,"-background","background","Background",
+ DEF_IMAGESTYLE_NORMAL_BG_COLOR,
+ Tk_Offset(TixImageStyle,colors[TIX_DITEM_NORMAL].bg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-background","background","Background",
+ DEF_IMAGESTYLE_NORMAL_BG_MONO,
+ Tk_Offset(TixImageStyle,colors[TIX_DITEM_NORMAL].bg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-foreground","foreground","Foreground",
+ DEF_IMAGESTYLE_NORMAL_FG_COLOR,
+ Tk_Offset(TixImageStyle,colors[TIX_DITEM_NORMAL].fg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-foreground","foreground","Foreground",
+ DEF_IMAGESTYLE_NORMAL_FG_MONO,
+ Tk_Offset(TixImageStyle,colors[TIX_DITEM_NORMAL].fg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-activebackground","activeBackground","ActiveBackground",
+ DEF_IMAGESTYLE_ACTIVE_BG_COLOR,
+ Tk_Offset(TixImageStyle,colors[TIX_DITEM_ACTIVE].bg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-activebackground","activeBackground","ActiveBackground",
+ DEF_IMAGESTYLE_ACTIVE_BG_MONO,
+ Tk_Offset(TixImageStyle,colors[TIX_DITEM_ACTIVE].bg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-activeforeground","activeForeground","ActiveForeground",
+ DEF_IMAGESTYLE_ACTIVE_FG_COLOR,
+ Tk_Offset(TixImageStyle,colors[TIX_DITEM_ACTIVE].fg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-activeforeground","activeForeground","ActiveForeground",
+ DEF_IMAGESTYLE_ACTIVE_FG_MONO,
+ Tk_Offset(TixImageStyle,colors[TIX_DITEM_ACTIVE].fg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-selectbackground","selectBackground","SelectBackground",
+ DEF_IMAGESTYLE_SELECTED_BG_COLOR,
+ Tk_Offset(TixImageStyle,colors[TIX_DITEM_SELECTED].bg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-selectbackground","selectBackground","SelectBackground",
+ DEF_IMAGESTYLE_SELECTED_BG_MONO,
+ Tk_Offset(TixImageStyle,colors[TIX_DITEM_SELECTED].bg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-selectforeground","selectForeground","SelectForeground",
+ DEF_IMAGESTYLE_SELECTED_FG_COLOR,
+ Tk_Offset(TixImageStyle,colors[TIX_DITEM_SELECTED].fg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-selectforeground","selectForeground","SelectForeground",
+ DEF_IMAGESTYLE_SELECTED_FG_MONO,
+ Tk_Offset(TixImageStyle,colors[TIX_DITEM_SELECTED].fg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-disabledbackground","disabledBackground","DisabledBackground",
+ DEF_IMAGESTYLE_DISABLED_BG_COLOR,
+ Tk_Offset(TixImageStyle,colors[TIX_DITEM_DISABLED].bg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-disabledbackground","disabledBackground","DisabledBackground",
+ DEF_IMAGESTYLE_DISABLED_BG_MONO,
+ Tk_Offset(TixImageStyle,colors[TIX_DITEM_DISABLED].bg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-disabledforeground","disabledForeground","DisabledForeground",
+ DEF_IMAGESTYLE_DISABLED_FG_COLOR,
+ Tk_Offset(TixImageStyle,colors[TIX_DITEM_DISABLED].fg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-disabledforeground","disabledForeground","DisabledForeground",
+ DEF_IMAGESTYLE_DISABLED_FG_MONO,
+ Tk_Offset(TixImageStyle,colors[TIX_DITEM_DISABLED].fg),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*----------------------------------------------------------------------
+ * Forward declarations for procedures defined later in this file:
+ *----------------------------------------------------------------------
+ */
+static void ImageProc _ANSI_ARGS_((ClientData clientData,
+ int x, int y, int width, int height,
+ int imgWidth, int imgHeight));
+static void Tix_ImageItemCalculateSize _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+static char * Tix_ImageItemComponent _ANSI_ARGS_((
+ Tix_DItem * iPtr, int x, int y));
+static int Tix_ImageItemConfigure _ANSI_ARGS_((
+ Tix_DItem * iPtr, int argc, char ** argv,
+ int flags));
+static Tix_DItem * Tix_ImageItemCreate _ANSI_ARGS_((
+ Tix_DispData * ddPtr, Tix_DItemInfo * diTypePtr));
+static void Tix_ImageItemDisplay _ANSI_ARGS_((
+ Pixmap pixmap, GC gc, Tix_DItem * iPtr,
+ int x, int y, int width, int height, int flag));
+static void Tix_ImageItemFree _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+static void Tix_ImageItemLostStyle _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+static void Tix_ImageItemStyleChanged _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+static int Tix_ImageStyleConfigure _ANSI_ARGS_((
+ Tix_DItemStyle* style, int argc, char ** argv,
+ int flags));
+static Tix_DItemStyle * Tix_ImageStyleCreate _ANSI_ARGS_((
+ Tcl_Interp *interp, Tk_Window tkwin,
+ Tix_DItemInfo * diTypePtr, char * name));
+static void Tix_ImageStyleFree _ANSI_ARGS_((
+ Tix_DItemStyle* style));
+static void Tix_ImageStyleSetTemplate _ANSI_ARGS_((
+ Tix_DItemStyle* style,
+ Tix_StyleTemplate * tmplPtr));
+
+Tix_DItemInfo tix_ImageItemType = {
+ "image", /* type */
+ TIX_DITEM_IMAGE,
+ Tix_ImageItemCreate, /* createProc */
+ Tix_ImageItemConfigure,
+ Tix_ImageItemCalculateSize,
+ Tix_ImageItemComponent,
+ Tix_ImageItemDisplay,
+ Tix_ImageItemFree,
+ Tix_ImageItemStyleChanged,
+ Tix_ImageItemLostStyle,
+
+ Tix_ImageStyleCreate,
+ Tix_ImageStyleConfigure,
+ Tix_ImageStyleFree,
+ Tix_ImageStyleSetTemplate,
+
+ imageItemConfigSpecs,
+ imageStyleConfigSpecs,
+ NULL, /*next */
+};
+
+
+/*----------------------------------------------------------------------
+ * Tix_Image --
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static Tix_DItem * Tix_ImageItemCreate(ddPtr, diTypePtr)
+ Tix_DispData * ddPtr;
+ Tix_DItemInfo * diTypePtr;
+{
+ TixImageItem * itPtr;
+
+ itPtr = (TixImageItem*) ckalloc(sizeof(TixImageItem));
+
+ itPtr->diTypePtr = diTypePtr;
+ itPtr->ddPtr = ddPtr;
+ itPtr->stylePtr = NULL;
+ itPtr->clientData = 0;
+ itPtr->size[0] = 0;
+ itPtr->size[1] = 0;
+
+ itPtr->imageString = NULL;
+ itPtr->image = NULL;
+ itPtr->imageW = 0;
+ itPtr->imageH = 0;
+
+ return (Tix_DItem *)itPtr;
+}
+
+static void Tix_ImageItemFree(iPtr)
+ Tix_DItem * iPtr;
+{
+ TixImageItem * itPtr = (TixImageItem *) iPtr;
+
+ if (itPtr->image) {
+ Tk_FreeImage(itPtr->image);
+ }
+ if (itPtr->stylePtr) {
+ TixDItemStyleFree(iPtr, (Tix_DItemStyle*)itPtr->stylePtr);
+ }
+
+ Tk_FreeOptions(imageItemConfigSpecs, (char *)itPtr,
+ itPtr->ddPtr->display, 0);
+ ckfree((char*)itPtr);
+}
+
+static int Tix_ImageItemConfigure(iPtr, argc, argv, flags)
+ Tix_DItem * iPtr;
+ int argc;
+ char ** argv;
+ int flags;
+{
+ TixImageItem * itPtr = (TixImageItem *) iPtr;
+ TixImageStyle * oldStyle = itPtr->stylePtr;
+
+ if (Tk_ConfigureWidget(itPtr->ddPtr->interp, itPtr->ddPtr->tkwin,
+ imageItemConfigSpecs,
+ argc, argv, (char *)itPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (itPtr->stylePtr == NULL) {
+ itPtr->stylePtr = (TixImageStyle*)TixGetDefaultDItemStyle(
+ itPtr->ddPtr, &tix_ImageItemType, iPtr, NULL);
+ }
+
+ /*
+ * Free the old images for the widget, if there were any.
+ */
+ if (itPtr->image != NULL) {
+ Tk_FreeImage(itPtr->image);
+ itPtr->image = NULL;
+ }
+
+ if (itPtr->imageString != NULL) {
+ itPtr->image = Tk_GetImage(itPtr->ddPtr->interp, itPtr->ddPtr->tkwin,
+ itPtr->imageString, ImageProc, (ClientData) itPtr);
+ if (itPtr->image == NULL) {
+ return TCL_ERROR;
+ }
+ }
+
+ if (oldStyle != NULL && itPtr->stylePtr != oldStyle) {
+ Tix_ImageItemStyleChanged(iPtr);
+ }
+ else {
+ Tix_ImageItemCalculateSize((Tix_DItem*)itPtr);
+ }
+
+ return TCL_OK;
+}
+
+static void Tix_ImageItemDisplay(pixmap, gc, iPtr, x, y, width, height, flags)
+ Pixmap pixmap;
+ GC gc;
+ Tix_DItem * iPtr;
+ int x;
+ int y;
+ int width;
+ int height;
+ int flags;
+{
+ TixImageItem *itPtr = (TixImageItem *)iPtr;
+ GC foreGC, backGC;
+ TixpSubRegion subReg;
+
+ if ((width <= 0) || (height <= 0)) {
+ return;
+ }
+
+ TixGetColorDItemGC(iPtr, &backGC, &foreGC, flags);
+ TixpStartSubRegionDraw(itPtr->ddPtr->display, pixmap, foreGC,
+ &subReg, 0, 0, x, y, width, height,
+ itPtr->size[0], itPtr->size[1]);
+ TixDItemGetAnchor(itPtr->stylePtr->anchor, x, y, width, height,
+ itPtr->size[0], itPtr->size[1], &x, &y);
+
+ if (backGC != None) {
+ TixpSubRegFillRectangle(itPtr->ddPtr->display, pixmap,
+ backGC, &subReg, x, y, width, height);
+ }
+
+ if (itPtr->image != NULL) {
+ int bitY;
+
+ bitY = itPtr->size[1] - itPtr->imageH - 2*itPtr->stylePtr->pad[1];
+
+ if (bitY > 0) {
+ bitY = bitY / 2;
+ } else {
+ bitY = 0;
+ }
+ TixpSubRegDrawImage(&subReg, itPtr->image, 0, 0, itPtr->imageW,
+ itPtr->imageH, pixmap,
+ x + itPtr->stylePtr->pad[0],
+ y + itPtr->stylePtr->pad[1] + bitY);
+ }
+
+ TixpEndSubRegionDraw(itPtr->ddPtr->display, pixmap, foreGC,
+ &subReg);
+}
+
+static void Tix_ImageItemCalculateSize(iPtr)
+ Tix_DItem * iPtr;
+{
+ TixImageItem *itPtr = (TixImageItem *)iPtr;
+
+ itPtr->size[0] = 0;
+ itPtr->size[1] = 0;
+
+ if (itPtr->image != NULL) {
+ Tk_SizeOfImage(itPtr->image, &itPtr->imageW, &itPtr->imageH);
+
+ itPtr->size[0] = itPtr->imageW;
+ itPtr->size[1] = itPtr->imageH;
+ }
+
+ itPtr->size[0] += 2*itPtr->stylePtr->pad[0];
+ itPtr->size[1] += 2*itPtr->stylePtr->pad[1];
+}
+
+static char * Tix_ImageItemComponent(iPtr, x, y)
+ Tix_DItem * iPtr;
+ int x;
+ int y;
+{
+#if 0
+ TixImageItem *itPtr = (TixImageItem *)iPtr;
+#endif
+ static char * body = "body";
+
+ return body;
+}
+
+
+static void Tix_ImageItemStyleChanged(iPtr)
+ Tix_DItem * iPtr;
+{
+ TixImageItem *itPtr = (TixImageItem *)iPtr;
+
+ if (itPtr->stylePtr == NULL) {
+ /* Maybe we haven't set the style to default style yet */
+ return;
+ }
+ Tix_ImageItemCalculateSize(iPtr);
+ if (itPtr->ddPtr->sizeChangedProc != NULL) {
+ itPtr->ddPtr->sizeChangedProc(iPtr);
+ }
+}
+static void Tix_ImageItemLostStyle(iPtr)
+ Tix_DItem * iPtr;
+{
+ TixImageItem *itPtr = (TixImageItem *)iPtr;
+
+ itPtr->stylePtr = (TixImageStyle*)TixGetDefaultDItemStyle(
+ itPtr->ddPtr, &tix_ImageItemType, iPtr, NULL);
+
+ Tix_ImageItemStyleChanged(iPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageProc --
+ *
+ * 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 this widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the HList to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ImageProc(clientData, x, y, width, height, imgWidth, imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ TixImageItem *itPtr = (TixImageItem *)clientData;
+
+ Tix_ImageItemCalculateSize((Tix_DItem *)itPtr);
+ if (itPtr->ddPtr->sizeChangedProc != NULL) {
+ itPtr->ddPtr->sizeChangedProc((Tix_DItem *)itPtr);
+ }
+}
+
+/*----------------------------------------------------------------------
+ *
+ *
+ * Display styles
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static Tix_DItemStyle *
+Tix_ImageStyleCreate(interp, tkwin, diTypePtr, name)
+ Tcl_Interp * interp;
+ Tk_Window tkwin;
+ char * name;
+ Tix_DItemInfo * diTypePtr;
+{
+ int i;
+ TixImageStyle * stylePtr =
+ (TixImageStyle *)ckalloc(sizeof(TixImageStyle));
+
+ stylePtr->pad[0] = 0;
+ stylePtr->pad[1] = 0;
+ stylePtr->anchor = TK_ANCHOR_CENTER;
+
+ for (i=0; i<4; i++) {
+ stylePtr->colors[i].bg = NULL;
+ stylePtr->colors[i].fg = NULL;
+ stylePtr->colors[i].backGC = None;
+ stylePtr->colors[i].foreGC = NULL;
+ }
+
+ return (Tix_DItemStyle *)stylePtr;
+}
+
+static int
+Tix_ImageStyleConfigure(style, argc, argv, flags)
+ Tix_DItemStyle *style;
+ int argc;
+ char ** argv;
+ int flags;
+{
+ TixImageStyle * stylePtr = (TixImageStyle *)style;
+ XGCValues gcValues;
+ GC newGC;
+ int i;
+
+ if (!(flags &TIX_DONT_CALL_CONFIG)) {
+ if (Tk_ConfigureWidget(stylePtr->interp, stylePtr->tkwin,
+ imageStyleConfigSpecs,
+ argc, argv, (char *)stylePtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ gcValues.graphics_exposures = False;
+ for (i=0; i<4; i++) {
+ /* Foreground */
+ gcValues.background = stylePtr->colors[i].bg->pixel;
+ gcValues.foreground = stylePtr->colors[i].fg->pixel;
+ newGC = Tk_GetGC(stylePtr->tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures, &gcValues);
+
+ if (stylePtr->colors[i].foreGC != None) {
+ Tk_FreeGC(Tk_Display(stylePtr->tkwin),
+ stylePtr->colors[i].foreGC);
+ }
+ stylePtr->colors[i].foreGC = newGC;
+
+ /* Background */
+ gcValues.foreground = stylePtr->colors[i].bg->pixel;
+ newGC = Tk_GetGC(stylePtr->tkwin,
+ GCForeground|GCGraphicsExposures, &gcValues);
+
+ if (stylePtr->colors[i].backGC != None) {
+ Tk_FreeGC(Tk_Display(stylePtr->tkwin),
+ stylePtr->colors[i].backGC);
+ }
+ stylePtr->colors[i].backGC = newGC;
+ }
+
+ return TCL_OK;
+}
+
+static void Tix_ImageStyleFree(style)
+ Tix_DItemStyle *style;
+{
+ TixImageStyle * stylePtr = (TixImageStyle *)style;
+ int i;
+
+ for (i=0; i<4; i++) {
+ if (stylePtr->colors[i].backGC != None) {
+ Tk_FreeGC(Tk_Display(stylePtr->tkwin), stylePtr->colors[i].backGC);
+ }
+ if (stylePtr->colors[i].foreGC != None) {
+ Tk_FreeGC(Tk_Display(stylePtr->tkwin), stylePtr->colors[i].foreGC);
+ }
+ }
+
+ Tk_FreeOptions(imageStyleConfigSpecs, (char *)stylePtr,
+ Tk_Display(stylePtr->tkwin), 0);
+ ckfree((char *)stylePtr);
+}
+
+static int bg_flags [4] = {
+ TIX_DITEM_NORMAL_BG,
+ TIX_DITEM_ACTIVE_BG,
+ TIX_DITEM_SELECTED_BG,
+ TIX_DITEM_DISABLED_BG
+};
+static int fg_flags [4] = {
+ TIX_DITEM_NORMAL_FG,
+ TIX_DITEM_ACTIVE_FG,
+ TIX_DITEM_SELECTED_FG,
+ TIX_DITEM_DISABLED_FG
+};
+
+static void
+Tix_ImageStyleSetTemplate(style, tmplPtr)
+ Tix_DItemStyle* style;
+ Tix_StyleTemplate * tmplPtr;
+{
+ TixImageStyle * stylePtr = (TixImageStyle *)style;
+ int i;
+
+ if (tmplPtr->flags & TIX_DITEM_PADX) {
+ stylePtr->pad[0] = tmplPtr->pad[0];
+ }
+ if (tmplPtr->flags & TIX_DITEM_PADY) {
+ stylePtr->pad[1] = tmplPtr->pad[1];
+ }
+
+ for (i=0; i<4; i++) {
+ if (tmplPtr->flags & bg_flags[i]) {
+ if (stylePtr->colors[i].bg != NULL) {
+ Tk_FreeColor(stylePtr->colors[i].bg);
+ }
+ stylePtr->colors[i].bg = Tk_GetColor(
+ stylePtr->interp, stylePtr->tkwin,
+ Tk_NameOfColor(tmplPtr->colors[i].bg));
+ }
+ }
+ for (i=0; i<4; i++) {
+ if (tmplPtr->flags & fg_flags[i]) {
+ if (stylePtr->colors[i].fg != NULL) {
+ Tk_FreeColor(stylePtr->colors[i].fg);
+ }
+ stylePtr->colors[i].fg = Tk_GetColor(
+ stylePtr->interp, stylePtr->tkwin,
+ Tk_NameOfColor(tmplPtr->colors[i].fg));
+ }
+ }
+
+ Tix_ImageStyleConfigure(style, 0, 0, TIX_DONT_CALL_CONFIG);
+}
diff --git a/tix/generic/tixDiStyle.c b/tix/generic/tixDiStyle.c
new file mode 100644
index 00000000000..a12cce708a1
--- /dev/null
+++ b/tix/generic/tixDiStyle.c
@@ -0,0 +1,952 @@
+/*
+ * tixDiStyle.c --
+ *
+ * This file implements the "Display Item Styles" in the Tix library.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+
+typedef struct StyleLink {
+ Tix_DItemInfo * diTypePtr;
+ Tix_DItemStyle* stylePtr;
+ struct StyleLink * next;
+} StyleLink;
+
+typedef struct StyleInfo {
+ Tix_StyleTemplate * tmplPtr;
+ Tix_StyleTemplate tmpl;
+ StyleLink * linkHead;
+} StyleInfo;
+
+
+static int DItemStyleParseProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin,
+ char *value,char *widRec, int offset));
+static char * DItemStylePrintProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin,
+ char *widRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+static Tix_DItemStyle* FindDefaultStyle _ANSI_ARGS_((
+ Tix_DItemInfo * diTypePtr, Tk_Window tkwin));
+static Tix_DItemStyle* FindStyle _ANSI_ARGS_((
+ char *styleName));
+static Tix_DItemStyle* GetDItemStyle _ANSI_ARGS_((
+ Tix_DispData * ddPtr, Tix_DItemInfo * diTypePtr,
+ char * styleName, int *isNew_ret));
+static void InitHashTables _ANSI_ARGS_((void));
+static void ListAdd _ANSI_ARGS_((Tix_DItemStyle * stylePtr,
+ Tix_DItem *iPtr));
+static void ListDelete _ANSI_ARGS_((Tix_DItemStyle * stylePtr,
+ Tix_DItem *iPtr));
+static void ListDeleteAll _ANSI_ARGS_((Tix_DItemStyle * stylePtr));
+static void StyleCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int StyleCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static int StyleConfigure _ANSI_ARGS_((Tcl_Interp *interp,
+ Tix_DItemStyle* stylePtr, int argc,
+ char **argv, int flags));
+static void StyleDestroy _ANSI_ARGS_((ClientData clientData));
+static void DeleteStyle _ANSI_ARGS_((Tix_DItemStyle * stylePtr));
+static void DefWindowStructureProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static void RefWindowStructureProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static void SetDefaultStyle _ANSI_ARGS_((Tix_DItemInfo *diTypePtr,
+ Tk_Window tkwin, Tix_DItemStyle * stylePtr));
+
+static TIX_DECLARE_SUBCMD(StyleConfigCmd);
+static TIX_DECLARE_SUBCMD(StyleCGetCmd);
+static TIX_DECLARE_SUBCMD(StyleDeleteCmd);
+
+static Tcl_HashTable styleTable;
+static Tcl_HashTable defaultTable;
+static int tableInited = 0;
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TixDItemStyleFree --
+ *
+ * When an item does not need a style anymore (when the item
+ * is destroyed, e.g.), it must call this procedute to free the
+ * style).
+ *
+ * Results:
+ * Nothing
+ *
+ * Side effects:
+ * The item is freed from the list of attached items in the style.
+ * Also, the style will be freed if it was already destroyed and
+ * it has no more items attached to it.
+ *
+ *--------------------------------------------------------------
+ */
+void TixDItemStyleFree(iPtr, stylePtr)
+ Tix_DItem *iPtr;
+ Tix_DItemStyle * stylePtr;
+{
+ ListDelete(stylePtr, iPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tix_ItemStyleCmd --
+ *
+ * This procedure is invoked to process the "tixItemStyle" Tcl
+ * command.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * A new widget is created and configured.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Tix_ItemStyleCmd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tix_DItemInfo * diTypePtr;
+ Tk_Window tkwin = (Tk_Window)clientData;
+ char * styleName = NULL;
+ Tix_DispData dispData;
+ char buff[100];
+ int i, n;
+ static int counter = 0;
+ Tix_DItemStyle * stylePtr;
+
+ if (tableInited == 0) {
+ InitHashTables();
+ }
+
+ if (argc < 2) {
+ return Tix_ArgcError(interp, argc, argv, 1,
+ "itemtype ?option value ...");
+ }
+
+ if ((diTypePtr=Tix_GetDItemType(interp, argv[1])) == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the -refwindow option: this tells the style to use this
+ * window to query the default values for background, foreground
+ * etc. Usually, you should set the -refwindow to the window that
+ * holds the display items which are controlled by this style.
+ */
+ if (argc > 2) {
+ size_t len;
+ if (argc %2 != 0) {
+ Tcl_AppendResult(interp, "value for \"", argv[argc-1],
+ "\" missing", NULL);
+ return TCL_ERROR;
+ }
+ for (n=i=2; i<argc; i+=2) {
+ len = strlen(argv[i]);
+ if (strncmp(argv[i], "-refwindow", len) == 0) {
+ if ((tkwin=Tk_NameToWindow(interp,argv[i+1],tkwin)) == NULL) {
+ return TCL_ERROR;
+ }
+ continue;
+ }
+ if (strncmp(argv[i], "-stylename", len) == 0) {
+ styleName = argv[i+1];
+ if (FindStyle(styleName) != NULL) {
+ Tcl_AppendResult(interp, "style \"", argv[i+1],
+ "\" already exist", NULL);
+ return TCL_ERROR;
+ }
+ continue;
+ }
+
+ if (n!=i) {
+ argv[n] = argv[i];
+ argv[n+1] = argv[i+1];
+ }
+ n+=2;
+ }
+ argc = n;
+ }
+
+ if (styleName == NULL) {
+ /*
+ * No name is given, we'll make a unique name by default
+ * (ToDo: check if the name has already been used)
+ */
+ sprintf(buff, "tixStyle%d", counter++);
+ styleName = buff;
+ }
+
+ dispData.interp = interp;
+ dispData.display = Tk_Display(tkwin);
+ dispData.tkwin = tkwin;
+
+ if ((stylePtr = GetDItemStyle(&dispData, diTypePtr,
+ styleName, NULL)) == NULL) {
+ return TCL_ERROR;
+ }
+ if (StyleConfigure(interp, stylePtr, argc-2, argv+2, 0) != TCL_OK) {
+ DeleteStyle(stylePtr);
+ return TCL_ERROR;
+ }
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ RefWindowStructureProc, (ClientData)stylePtr);
+
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, styleName, NULL);
+ return TCL_OK;
+}
+
+static int
+StyleCmd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int argc;
+ char **argv;
+{
+ int code;
+
+ static Tix_SubCmdInfo subCmdInfo[] = {
+ {TIX_DEFAULT_LEN, "cget", 1, 1, StyleCGetCmd,
+ "option"},
+ {TIX_DEFAULT_LEN, "configure", 0, TIX_VAR_ARGS, StyleConfigCmd,
+ "?option? ?value? ?option value ... ?"},
+ {TIX_DEFAULT_LEN, "delete", 0, 0, StyleDeleteCmd,
+ ""},
+ };
+
+ static Tix_CmdInfo cmdInfo = {
+ Tix_ArraySize(subCmdInfo), 1, TIX_VAR_ARGS, "?option? arg ?arg ...?",
+ };
+
+ Tk_Preserve(clientData);
+ code = Tix_HandleSubCmds(&cmdInfo, subCmdInfo, clientData,
+ interp, argc, argv);
+ Tk_Release(clientData);
+
+ return code;
+}
+
+/*----------------------------------------------------------------------
+ * "cget" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+StyleCGetCmd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tix_DItemStyle* stylePtr= (Tix_DItemStyle*) clientData;
+
+ return Tk_ConfigureValue(interp, stylePtr->base.tkwin,
+ stylePtr->base.diTypePtr->styleConfigSpecs,
+ (char *)stylePtr, argv[0], 0);
+}
+
+/*----------------------------------------------------------------------
+ * "configure" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+StyleConfigCmd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tix_DItemStyle* stylePtr= (Tix_DItemStyle*) clientData;
+
+ if (argc == 0) {
+ return Tk_ConfigureInfo(interp, stylePtr->base.tkwin,
+ stylePtr->base.diTypePtr->styleConfigSpecs,
+ (char *)stylePtr, (char *) NULL, 0);
+ } else if (argc == 1) {
+ return Tk_ConfigureInfo(interp, stylePtr->base.tkwin,
+ stylePtr->base.diTypePtr->styleConfigSpecs,
+ (char *)stylePtr, argv[0], 0);
+ } else {
+ return StyleConfigure(interp, stylePtr, argc, argv,
+ TK_CONFIG_ARGV_ONLY);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * "delete" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+StyleDeleteCmd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tix_DItemStyle* stylePtr= (Tix_DItemStyle*) clientData;
+
+ if (stylePtr->base.flags & TIX_STYLE_DEFAULT) {
+ Tcl_AppendResult(interp, "Cannot delete default item style",
+ NULL);
+ return TCL_ERROR;
+ }
+
+ DeleteStyle(stylePtr);
+ return TCL_OK;
+}
+
+static int
+StyleConfigure(interp, stylePtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tix_DItemStyle* stylePtr; /* Information about the style; 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. */
+{
+ Tix_DItemInfo * diTypePtr = stylePtr->base.diTypePtr;
+
+ if (diTypePtr->styleConfigureProc(stylePtr, argc, argv, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * StyleDestroy --
+ *
+ * Destroy a display style.
+ *----------------------------------------------------------------------
+ */
+static void
+StyleDestroy(clientData)
+ ClientData clientData;
+{
+ Tix_DItemStyle* stylePtr= (Tix_DItemStyle*) clientData;
+
+ if ((stylePtr->base.flags & TIX_STYLE_DEFAULT)) {
+ /*
+ * If this is the default style for the display items, we
+ * can't tell the display items that it has lost its style,
+ * otherwise the ditem will just attempt to create the default
+ * style again, and we will go into an infinite loop
+ */
+ if (stylePtr->base.refCount != 0) {
+ /*
+ * If the refcount is not zero, this style will NOT be
+ * destroyed. The real destroy will be triggered if all
+ * DItems associated with this style is destroyed (in the
+ * ListDelete() function).
+ *
+ * If a widget is destroyed, it is the responsibility of the
+ * widget writer to delete all DItems associated with this
+ * widget. We can discover memory leak if the widget is
+ * destroyed but some default styles associated with it still
+ * exist
+ */
+ return;
+ }
+ } else {
+ stylePtr->base.refCount = 0;
+ }
+
+ Tcl_DeleteHashTable(&stylePtr->base.items);
+ ckfree((char*)stylePtr->base.name);
+ stylePtr->base.diTypePtr->styleFreeProc(stylePtr);
+}
+
+static void
+StyleCmdDeletedProc(clientData)
+ ClientData clientData;
+{
+ Tix_DItemStyle * stylePtr = (Tix_DItemStyle *)clientData;
+
+ stylePtr->base.styleCmd = NULL;
+ if (stylePtr->base.flags & TIX_STYLE_DEFAULT) {
+ /*
+ * Don't do anything
+ * ToDo: maybe should give a background warning:
+ */
+ } else {
+ DeleteStyle(stylePtr);
+ }
+}
+
+static void
+DeleteStyle(stylePtr)
+ Tix_DItemStyle * stylePtr;
+{
+ Tcl_HashEntry * hashPtr;
+
+ if (!(stylePtr->base.flags & TIX_STYLE_DELETED)) {
+ stylePtr->base.flags |= TIX_STYLE_DELETED;
+
+ if (stylePtr->base.styleCmd != NULL) {
+ Tcl_DeleteCommand(stylePtr->base.interp,
+ Tcl_GetCommandName(stylePtr->base.interp,
+ stylePtr->base.styleCmd));
+ }
+ hashPtr=Tcl_FindHashEntry(&styleTable, stylePtr->base.name);
+ if (hashPtr != NULL) {
+ Tcl_DeleteHashEntry(hashPtr);
+ }
+ ListDeleteAll(stylePtr);
+
+ Tk_EventuallyFree((ClientData)stylePtr, (Tix_FreeProc *)StyleDestroy);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * FindDefaultStyle --
+ *
+ * Return the default style of the given type of ditem for the
+ * given tkwin, if such a default style exists.
+ *
+ * Results:
+ * Pointer to the default style or NULL.
+ *
+ * Side effects:
+ * None.
+ *----------------------------------------------------------------------
+ */
+
+static Tix_DItemStyle*
+FindDefaultStyle(diTypePtr, tkwin)
+ Tix_DItemInfo * diTypePtr;
+ Tk_Window tkwin;
+{
+ Tcl_HashEntry *hashPtr;
+ StyleInfo * infoPtr;
+ StyleLink * linkPtr;
+
+ if (tableInited == 0) {
+ InitHashTables();
+ }
+ if ((hashPtr=Tcl_FindHashEntry(&defaultTable, (char*)tkwin)) == NULL) {
+ return NULL;
+ }
+ infoPtr = (StyleInfo *)Tcl_GetHashValue(hashPtr);
+ for (linkPtr = infoPtr->linkHead; linkPtr; linkPtr=linkPtr->next) {
+ if (linkPtr->diTypePtr == diTypePtr) {
+ return linkPtr->stylePtr;
+ }
+ }
+ return NULL;
+}
+
+static void SetDefaultStyle(diTypePtr, tkwin, stylePtr)
+ Tix_DItemInfo * diTypePtr;
+ Tk_Window tkwin;
+ Tix_DItemStyle * stylePtr;
+{
+ Tcl_HashEntry *hashPtr;
+ StyleInfo * infoPtr;
+ StyleLink * newPtr;
+ int isNew;
+
+ if (tableInited == 0) {
+ InitHashTables();
+ }
+
+ newPtr = (StyleLink *)ckalloc(sizeof(StyleLink));
+ newPtr->diTypePtr = diTypePtr;
+ newPtr->stylePtr = stylePtr;
+
+ hashPtr = Tcl_CreateHashEntry(&defaultTable, (char*)tkwin, &isNew);
+
+ if (!isNew) {
+ infoPtr = (StyleInfo *)Tcl_GetHashValue(hashPtr);
+ if (infoPtr->tmplPtr) {
+ if (diTypePtr->styleSetTemplateProc != NULL) {
+ diTypePtr->styleSetTemplateProc(stylePtr,
+ infoPtr->tmplPtr);
+ }
+ }
+ } else {
+ infoPtr = (StyleInfo *)ckalloc(sizeof(StyleInfo));
+ infoPtr->linkHead = NULL;
+ infoPtr->tmplPtr = NULL;
+
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ DefWindowStructureProc, (ClientData)tkwin);
+ Tcl_SetHashValue(hashPtr, (char*)infoPtr);
+ }
+ newPtr->next = infoPtr->linkHead;
+ infoPtr->linkHead = newPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ * TixGetDefaultDItemStyle --
+ *
+ * Gets the default style for an item if the application doesn't
+ * explicitly give it an style with the -style switch.
+ *
+ * Results:
+ * The default style.
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tix_DItemStyle*
+TixGetDefaultDItemStyle(ddPtr, diTypePtr, iPtr, oldStylePtr)
+ Tix_DispData * ddPtr; /* Info about the display. */
+ Tix_DItemInfo * diTypePtr; /* Info about the DItem type. */
+ Tix_DItem *iPtr; /* Get default style for this DItem. */
+ Tix_DItemStyle* oldStylePtr; /* ?? */
+{
+ Tcl_DString dString;
+ Tix_DItemStyle* stylePtr;
+ int isNew;
+
+ if (tableInited == 0) {
+ InitHashTables();
+ }
+
+ stylePtr = FindDefaultStyle(diTypePtr, ddPtr->tkwin);
+ if (stylePtr == NULL) {
+ /*
+ * Format default name for this style+window
+ */
+ Tcl_DStringInit(&dString);
+ Tcl_DStringAppend(&dString, "style", 5);
+ Tcl_DStringAppend(&dString, Tk_PathName(ddPtr->tkwin),
+ strlen(Tk_PathName(ddPtr->tkwin)));
+ Tcl_DStringAppend(&dString, ":", 1);
+ Tcl_DStringAppend(&dString, diTypePtr->name, strlen(diTypePtr->name));
+
+ /*
+ * Create the new style
+ */
+ stylePtr = GetDItemStyle(ddPtr, diTypePtr, dString.string, &isNew);
+ if (isNew) {
+ diTypePtr->styleConfigureProc(stylePtr, 0, NULL, 0);
+ stylePtr->base.flags |= TIX_STYLE_DEFAULT;
+ }
+
+ SetDefaultStyle(diTypePtr, ddPtr->tkwin, stylePtr);
+ Tcl_DStringFree(&dString);
+ }
+
+ if (oldStylePtr) {
+ ListDelete(oldStylePtr, iPtr);
+ }
+ ListAdd(stylePtr, iPtr);
+
+ return stylePtr;
+}
+
+void Tix_SetDefaultStyleTemplate(tkwin, tmplPtr)
+ Tk_Window tkwin;
+ Tix_StyleTemplate * tmplPtr;
+{
+ Tcl_HashEntry * hashPtr;
+ StyleInfo * infoPtr;
+ StyleLink * linkPtr;
+ int isNew;
+
+ if (tableInited == 0) {
+ InitHashTables();
+ }
+
+ hashPtr=Tcl_CreateHashEntry(&defaultTable, (char*)tkwin, &isNew);
+ if (!isNew) {
+ infoPtr = (StyleInfo *)Tcl_GetHashValue(hashPtr);
+ infoPtr->tmplPtr = &infoPtr->tmpl;
+ infoPtr->tmpl = *tmplPtr;
+
+ for (linkPtr = infoPtr->linkHead; linkPtr; linkPtr=linkPtr->next) {
+ if (linkPtr->diTypePtr->styleSetTemplateProc != NULL) {
+ linkPtr->diTypePtr->styleSetTemplateProc(linkPtr->stylePtr,
+ tmplPtr);
+ }
+ }
+ } else {
+ infoPtr = (StyleInfo *)ckalloc(sizeof(StyleInfo));
+ infoPtr->linkHead = NULL;
+ infoPtr->tmplPtr = &infoPtr->tmpl;
+ infoPtr->tmpl = *tmplPtr;
+
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ DefWindowStructureProc, (ClientData)tkwin);
+ Tcl_SetHashValue(hashPtr, (char*)infoPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * GetDItemStyle --
+ *
+ * Returns an ItemStyle with the given name.
+ *
+ * Results:
+ * Pointer to the given Tix_DItsmStyle.
+ *
+ * Side effects:
+ * If the style doesn't already exist, it is allocated.
+ *----------------------------------------------------------------------
+ */
+
+static Tix_DItemStyle*
+GetDItemStyle(ddPtr, diTypePtr, styleName, isNew_ret)
+ Tix_DispData * ddPtr;
+ Tix_DItemInfo * diTypePtr;
+ char * styleName;
+ int * isNew_ret;
+{
+ Tcl_HashEntry *hashPtr;
+ int isNew;
+ Tix_DItemStyle * stylePtr;
+
+ if (tableInited == 0) {
+ InitHashTables();
+ }
+
+ hashPtr = Tcl_CreateHashEntry(&styleTable, styleName, &isNew);
+ if (!isNew) {
+ stylePtr = (Tix_DItemStyle *)Tcl_GetHashValue(hashPtr);
+ }
+ else {
+ stylePtr = diTypePtr->styleCreateProc(ddPtr->interp,
+ ddPtr->tkwin, diTypePtr, styleName);
+ stylePtr->base.styleCmd = Tcl_CreateCommand(ddPtr->interp,
+ styleName, StyleCmd, (ClientData)stylePtr, StyleCmdDeletedProc);
+ stylePtr->base.interp = ddPtr->interp;
+ stylePtr->base.tkwin = ddPtr->tkwin;
+ stylePtr->base.diTypePtr = diTypePtr;
+ stylePtr->base.name = (char*)tixStrDup(styleName);
+ stylePtr->base.pad[0] = 0;
+ stylePtr->base.pad[1] = 0;
+ stylePtr->base.anchor = TK_ANCHOR_CENTER;
+ stylePtr->base.refCount = 0;
+ stylePtr->base.flags = 0;
+ Tcl_InitHashTable(&stylePtr->base.items, TCL_ONE_WORD_KEYS);
+
+ Tcl_SetHashValue(hashPtr, (char*)stylePtr);
+ }
+
+ if (isNew_ret != NULL) {
+ * isNew_ret = isNew;
+ }
+ return stylePtr;
+}
+
+static Tix_DItemStyle* FindStyle(styleName)
+ char *styleName;
+{
+ Tcl_HashEntry *hashPtr;
+
+ if (tableInited == 0) {
+ InitHashTables();
+ }
+ if ((hashPtr=Tcl_FindHashEntry(&styleTable, styleName)) == NULL) {
+ return NULL;
+ }
+
+ return (Tix_DItemStyle *)Tcl_GetHashValue(hashPtr);
+}
+
+/*----------------------------------------------------------------------
+ * TixDItemStyleChanged --
+ *
+ * Tell each Ditem that are affected by this style that the style
+ * has changed. The Ditems will respond by updating their
+ * attributes according to the new values of the style.
+ *----------------------------------------------------------------------
+ */
+
+void TixDItemStyleChanged(diTypePtr, stylePtr)
+ Tix_DItemInfo * diTypePtr;
+ Tix_DItemStyle * stylePtr;
+{
+ Tcl_HashSearch hashSearch;
+ Tcl_HashEntry *hashPtr;
+ Tix_DItem * iPtr;
+
+ for (hashPtr = Tcl_FirstHashEntry(&stylePtr->base.items, &hashSearch);
+ hashPtr;
+ hashPtr = Tcl_NextHashEntry(&hashSearch)) {
+
+ iPtr = (Tix_DItem *)Tcl_GetHashValue(hashPtr);
+ diTypePtr->styleChangedProc(iPtr);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * ListAdd --
+ *
+ * Add an item to the list of items affected by a style.
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListAdd(stylePtr, iPtr)
+ Tix_DItemStyle * stylePtr;
+ Tix_DItem *iPtr;
+{
+ Tcl_HashEntry *hashPtr;
+ int isNew;
+
+ hashPtr = Tcl_CreateHashEntry(&stylePtr->base.items, (char*)iPtr, &isNew);
+ if (!isNew) {
+ panic("DItem is already associated with style");
+ } else {
+ Tcl_SetHashValue(hashPtr, (char*)iPtr);
+ }
+ ++ stylePtr->base.refCount;
+}
+
+static void
+ListDelete(stylePtr, iPtr)
+ Tix_DItemStyle * stylePtr;
+ Tix_DItem *iPtr;
+{
+ Tcl_HashEntry *hashPtr;
+
+ hashPtr = Tcl_FindHashEntry(&stylePtr->base.items, (char*)iPtr);
+ if (hashPtr == NULL) {
+ panic("DItem is not associated with style");
+ }
+ Tcl_DeleteHashEntry(hashPtr);
+ stylePtr->base.refCount--;
+
+ if ((stylePtr->base.refCount == 0) &&
+ (stylePtr->base.flags & TIX_STYLE_DELETED) &&
+ (stylePtr->base.flags & TIX_STYLE_DEFAULT)) {
+ Tk_EventuallyFree((ClientData)stylePtr, (Tix_FreeProc *)StyleDestroy);
+ }
+}
+
+static void
+ListDeleteAll(stylePtr)
+ Tix_DItemStyle * stylePtr;
+{
+ Tcl_HashSearch hashSearch;
+ Tcl_HashEntry *hashPtr;
+ Tix_DItem * iPtr;
+
+ for (hashPtr = Tcl_FirstHashEntry(&stylePtr->base.items, &hashSearch);
+ hashPtr;
+ hashPtr = Tcl_NextHashEntry(&hashSearch)) {
+
+ iPtr = (Tix_DItem *)Tcl_GetHashValue(hashPtr);
+ if (stylePtr->base.diTypePtr->lostStyleProc != NULL) {
+ stylePtr->base.diTypePtr->lostStyleProc(iPtr);
+ }
+ Tcl_DeleteHashEntry(hashPtr);
+ }
+}
+
+static void
+InitHashTables()
+{
+ if (tableInited == 0) {
+ Tcl_InitHashTable(&styleTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&defaultTable, TCL_ONE_WORD_KEYS);
+ tableInited = 1;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DefWindowStructureProc --
+ *
+ * This procedure is invoked whenever StructureNotify events
+ * occur for a window that has some default style(s) associated with it
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The style(s) associated with this window will all be deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DefWindowStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to record describing window item. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ Tk_Window tkwin = (Tk_Window)clientData;
+ Tcl_HashEntry *hashPtr;
+ StyleInfo * infoPtr;
+ StyleLink * linkPtr, *toFree;
+
+ if (eventPtr->type != DestroyNotify) {
+ return;
+ }
+ if (tableInited == 0) {
+ InitHashTables();
+ }
+ if ((hashPtr=Tcl_FindHashEntry(&defaultTable, (char*)tkwin)) == NULL) {
+ return;
+ }
+ infoPtr = (StyleInfo *)Tcl_GetHashValue(hashPtr);
+ for (linkPtr = infoPtr->linkHead; linkPtr; ) {
+ toFree = linkPtr;
+ linkPtr=linkPtr->next;
+
+ DeleteStyle(toFree->stylePtr);
+ ckfree((char*)toFree);
+ }
+
+ ckfree((char*)infoPtr);
+ Tcl_DeleteHashEntry(hashPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RefWindowStructureProc --
+ *
+ * This procedure is invoked when the refwindow of a non-default
+ * style is deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The style is deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+RefWindowStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to record describing window item. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ Tix_DItemStyle * stylePtr = (Tix_DItemStyle *)clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ /*
+ * If some DItems are still associated with this window, they
+ * will receive a "LostStyle" notification.
+ */
+ DeleteStyle(stylePtr);
+ }
+}
+
+/*----------------------------------------------------------------------
+ *
+ * The Tix Customed Config Options
+ *
+ *----------------------------------------------------------------------
+ */
+
+/*
+ * The global data structures to use in widget configSpecs arrays
+ *
+ * These are declared in <tix.h>
+ */
+
+Tk_CustomOption tixConfigItemStyle = {
+ DItemStyleParseProc, DItemStylePrintProc, 0,
+};
+
+/*----------------------------------------------------------------------
+ * DItemStyleParseProc --
+ *
+ * Parse the text string and store the Tix_DItemStyleType information
+ * inside the widget record.
+ *----------------------------------------------------------------------
+ */
+static int DItemStyleParseProc(clientData, interp, tkwin, value, widRec,offset)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ Tk_Window tkwin;
+ char *value;
+ char *widRec; /* Must point to a valid Tix_DItem struct */
+ int offset;
+{
+ Tix_DItem * iPtr = (Tix_DItem *)widRec;
+ Tix_DItemStyle ** ptr = (Tix_DItemStyle **)(widRec + offset);
+ Tix_DItemStyle * oldPtr = *ptr;
+ Tix_DItemStyle * newPtr;
+
+ if (tableInited == 0) {
+ InitHashTables();
+ }
+
+ if (value == NULL || strlen(value) == 0) {
+ /*
+ * User gives a NULL string -- meaning he wants the default
+ * style
+ */
+ if (oldPtr && oldPtr->base.flags & TIX_STYLE_DEFAULT) {
+ /*
+ * This ditem is already associated with a default style. Let's
+ * keep it.
+ */
+ newPtr = oldPtr;
+ } else {
+ if (oldPtr) {
+ ListDelete(oldPtr, iPtr);
+ }
+ newPtr = NULL;
+ }
+ } else {
+ if ((newPtr = FindStyle(value)) == NULL) {
+ goto not_found;
+ }
+ if (newPtr->base.flags & TIX_STYLE_DELETED) {
+ goto not_found;
+ }
+ if (newPtr->base.diTypePtr != iPtr->base.diTypePtr) {
+ Tcl_AppendResult(interp, "Style type mismatch ",
+ "Needed ", iPtr->base.diTypePtr->name, " style but got ",
+ newPtr->base.diTypePtr->name, " style", NULL);
+ return TCL_ERROR;
+ }
+ if (oldPtr != newPtr) {
+ if (oldPtr != NULL) {
+ ListDelete(oldPtr, iPtr);
+ }
+ ListAdd(newPtr, iPtr);
+ }
+ }
+
+ *ptr = newPtr;
+ return TCL_OK;
+
+not_found:
+ Tcl_AppendResult(interp, "Display style \"", value,
+ "\" not found", NULL);
+ return TCL_ERROR;
+}
+
+static char *DItemStylePrintProc(clientData, tkwin, widRec,offset, freeProcPtr)
+ ClientData clientData;
+ Tk_Window tkwin;
+ char *widRec;
+ int offset;
+ Tcl_FreeProc **freeProcPtr;
+{
+ Tix_DItemStyle *stylePtr = *((Tix_DItemStyle**)(widRec+offset));
+
+ if (stylePtr != NULL) {
+ return stylePtr->base.name;
+ } else {
+ return 0;
+ }
+}
diff --git a/tix/generic/tixDiText.c b/tix/generic/tixDiText.c
new file mode 100644
index 00000000000..ccd0c94adbc
--- /dev/null
+++ b/tix/generic/tixDiText.c
@@ -0,0 +1,667 @@
+/*
+ * tixDiText.c --
+ *
+ * This file implements one of the "Display Items" in the Tix library :
+ * Text display items.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixDef.h>
+
+/*----------------------------------------------------------------------
+ *
+ * Configuration options for Text Items
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define DEF_TEXTITEM_STYLE ""
+#define DEF_TEXTITEM_TEXT ""
+#define DEF_TEXTITEM_UNDERLINE "-1"
+#define DEF_TEXTITEM_TYPE "text"
+
+static Tk_ConfigSpec textItemConfigSpecs[] = {
+ {TK_CONFIG_CUSTOM, "-itemtype", "itemType", "ItemType",
+ DEF_TEXTITEM_TYPE, Tk_Offset(TixTextItem, diTypePtr),
+ 0, &tixConfigItemType},
+ {TK_CONFIG_CUSTOM, "-style", "textStyle", "TextStyle",
+ DEF_TEXTITEM_STYLE, Tk_Offset(TixTextItem, stylePtr),
+ TK_CONFIG_NULL_OK, &tixConfigItemStyle},
+ {TK_CONFIG_STRING, "-text", "text", "Text",
+ DEF_TEXTITEM_TEXT, Tk_Offset(TixTextItem, text),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_INT, "-underline", "underline", "Underline",
+ DEF_TEXTITEM_UNDERLINE, Tk_Offset(TixTextItem, underline), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*----------------------------------------------------------------------
+ *
+ * Configuration options for Text Styles
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define SELECTED_BG SELECT_BG
+#define DISABLED_BG DISABLED
+
+#define DEF_TEXTSTYLE_NORMAL_FG_COLOR BLACK
+#define DEF_TEXTSTYLE_NORMAL_FG_MONO BLACK
+#define DEF_TEXTSTYLE_NORMAL_BG_COLOR NORMAL_BG
+#define DEF_TEXTSTYLE_NORMAL_BG_MONO WHITE
+
+#define DEF_TEXTSTYLE_ACTIVE_FG_COLOR BLACK
+#define DEF_TEXTSTYLE_ACTIVE_FG_MONO WHITE
+#define DEF_TEXTSTYLE_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_TEXTSTYLE_ACTIVE_BG_MONO BLACK
+
+#define DEF_TEXTSTYLE_SELECTED_FG_COLOR BLACK
+#define DEF_TEXTSTYLE_SELECTED_FG_MONO WHITE
+#define DEF_TEXTSTYLE_SELECTED_BG_COLOR SELECTED_BG
+#define DEF_TEXTSTYLE_SELECTED_BG_MONO BLACK
+
+#define DEF_TEXTSTYLE_DISABLED_FG_COLOR BLACK
+#define DEF_TEXTSTYLE_DISABLED_FG_MONO BLACK
+#define DEF_TEXTSTYLE_DISABLED_BG_COLOR DISABLED_BG
+#define DEF_TEXTSTYLE_DISABLED_BG_MONO WHITE
+
+#define DEF_TEXTSTYLE_PADX "2"
+#define DEF_TEXTSTYLE_PADY "2"
+#define DEF_TEXTSTYLE_FONT CTL_FONT
+#define DEF_TEXTSTYLE_JUSTIFY "left"
+#define DEF_TEXTSTYLE_WLENGTH "0"
+#define DEF_TEXTSTYLE_ANCHOR "w"
+
+#if 0
+ /* %bordercolor not used */
+#define DEF_TEXTSTYLE_BORDER_COLOR_COLOR BORDER_COLOR
+#define DEF_TEXTSTYLE_BORDER_COLOR_MONO BLACK
+#endif
+
+static Tk_ConfigSpec textStyleConfigSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_TEXTSTYLE_ANCHOR, Tk_Offset(TixTextStyle, anchor), 0},
+
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0},
+
+#if 0
+ /* %bordercolor not used */
+ {TK_CONFIG_COLOR,"-bordercolor","borderColor","BorderColor",
+ DEF_TEXTSTYLE_BORDER_COLOR_COLOR, Tk_Offset(TixTextStyle, borderColor),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_COLOR,"-bordercolor","borderColor","BorderColor",
+ DEF_TEXTSTYLE_BORDER_COLOR_MONO, Tk_Offset(TixTextStyle, borderColor),
+ TK_CONFIG_MONO_ONLY},
+#endif
+
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+
+ {TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_TEXTSTYLE_FONT, Tk_Offset(TixTextStyle, font), 0},
+
+ {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justyfy",
+ DEF_TEXTSTYLE_JUSTIFY, Tk_Offset(TixTextStyle, justify),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
+ DEF_TEXTSTYLE_PADX, Tk_Offset(TixTextStyle, pad[0]), 0},
+
+ {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
+ DEF_TEXTSTYLE_PADY, Tk_Offset(TixTextStyle, pad[1]), 0},
+
+ {TK_CONFIG_PIXELS, "-wraplength", "wrapLength", "WrapLength",
+ DEF_TEXTSTYLE_WLENGTH, Tk_Offset(TixTextStyle, wrapLength), 0},
+
+/* The following is automatically generated */
+ {TK_CONFIG_COLOR,"-background","background","Background",
+ DEF_TEXTSTYLE_NORMAL_BG_COLOR,
+ Tk_Offset(TixTextStyle,colors[TIX_DITEM_NORMAL].bg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-background","background","Background",
+ DEF_TEXTSTYLE_NORMAL_BG_MONO,
+ Tk_Offset(TixTextStyle,colors[TIX_DITEM_NORMAL].bg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-foreground","foreground","Foreground",
+ DEF_TEXTSTYLE_NORMAL_FG_COLOR,
+ Tk_Offset(TixTextStyle,colors[TIX_DITEM_NORMAL].fg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-foreground","foreground","Foreground",
+ DEF_TEXTSTYLE_NORMAL_FG_MONO,
+ Tk_Offset(TixTextStyle,colors[TIX_DITEM_NORMAL].fg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-activebackground","activeBackground","ActiveBackground",
+ DEF_TEXTSTYLE_ACTIVE_BG_COLOR,
+ Tk_Offset(TixTextStyle,colors[TIX_DITEM_ACTIVE].bg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-activebackground","activeBackground","ActiveBackground",
+ DEF_TEXTSTYLE_ACTIVE_BG_MONO,
+ Tk_Offset(TixTextStyle,colors[TIX_DITEM_ACTIVE].bg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-activeforeground","activeForeground","ActiveForeground",
+ DEF_TEXTSTYLE_ACTIVE_FG_COLOR,
+ Tk_Offset(TixTextStyle,colors[TIX_DITEM_ACTIVE].fg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-activeforeground","activeForeground","ActiveForeground",
+ DEF_TEXTSTYLE_ACTIVE_FG_MONO,
+ Tk_Offset(TixTextStyle,colors[TIX_DITEM_ACTIVE].fg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-selectbackground","selectBackground","SelectBackground",
+ DEF_TEXTSTYLE_SELECTED_BG_COLOR,
+ Tk_Offset(TixTextStyle,colors[TIX_DITEM_SELECTED].bg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-selectbackground","selectBackground","SelectBackground",
+ DEF_TEXTSTYLE_SELECTED_BG_MONO,
+ Tk_Offset(TixTextStyle,colors[TIX_DITEM_SELECTED].bg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-selectforeground","selectForeground","SelectForeground",
+ DEF_TEXTSTYLE_SELECTED_FG_COLOR,
+ Tk_Offset(TixTextStyle,colors[TIX_DITEM_SELECTED].fg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-selectforeground","selectForeground","SelectForeground",
+ DEF_TEXTSTYLE_SELECTED_FG_MONO,
+ Tk_Offset(TixTextStyle,colors[TIX_DITEM_SELECTED].fg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-disabledbackground","disabledBackground","DisabledBackground",
+ DEF_TEXTSTYLE_DISABLED_BG_COLOR,
+ Tk_Offset(TixTextStyle,colors[TIX_DITEM_DISABLED].bg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-disabledbackground","disabledBackground","DisabledBackground",
+ DEF_TEXTSTYLE_DISABLED_BG_MONO,
+ Tk_Offset(TixTextStyle,colors[TIX_DITEM_DISABLED].bg),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR,"-disabledforeground","disabledForeground","DisabledForeground",
+ DEF_TEXTSTYLE_DISABLED_FG_COLOR,
+ Tk_Offset(TixTextStyle,colors[TIX_DITEM_DISABLED].fg),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR,"-disabledforeground","disabledForeground","DisabledForeground",
+ DEF_TEXTSTYLE_DISABLED_FG_MONO,
+ Tk_Offset(TixTextStyle,colors[TIX_DITEM_DISABLED].fg),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+
+/*----------------------------------------------------------------------
+ * Forward declarations for procedures defined later in this file:
+ *----------------------------------------------------------------------
+ */
+static void Tix_TextItemCalculateSize _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+static char * Tix_TextItemComponent _ANSI_ARGS_((
+ Tix_DItem * iPtr, int x, int y));
+static int Tix_TextItemConfigure _ANSI_ARGS_((
+ Tix_DItem * iPtr, int argc, char ** argv,
+ int flags));
+static Tix_DItem * Tix_TextItemCreate _ANSI_ARGS_((
+ Tix_DispData * ddPtr, Tix_DItemInfo * diTypePtr));
+static void Tix_TextItemDisplay _ANSI_ARGS_((
+ Pixmap pixmap, GC gc, Tix_DItem * iPtr,
+ int x, int y, int width, int height, int flags));
+static void Tix_TextItemFree _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+static void Tix_TextItemLostStyle _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+static void Tix_TextItemStyleChanged _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+static int Tix_TextStyleConfigure _ANSI_ARGS_((
+ Tix_DItemStyle* style, int argc, char ** argv,
+ int flags));
+static Tix_DItemStyle * Tix_TextStyleCreate _ANSI_ARGS_((
+ Tcl_Interp *interp, Tk_Window tkwin,
+ Tix_DItemInfo * diTypePtr, char * name));
+static void Tix_TextStyleFree _ANSI_ARGS_((
+ Tix_DItemStyle* style));
+static void Tix_TextStyleSetTemplate _ANSI_ARGS_((
+ Tix_DItemStyle* style,
+ Tix_StyleTemplate * tmplPtr));
+
+Tix_DItemInfo tix_TextItemType = {
+ "text", /* type */
+ TIX_DITEM_TEXT,
+ Tix_TextItemCreate, /* createProc */
+ Tix_TextItemConfigure,
+ Tix_TextItemCalculateSize,
+ Tix_TextItemComponent,
+ Tix_TextItemDisplay,
+ Tix_TextItemFree,
+ Tix_TextItemStyleChanged,
+ Tix_TextItemLostStyle,
+
+ Tix_TextStyleCreate,
+ Tix_TextStyleConfigure,
+ Tix_TextStyleFree,
+ Tix_TextStyleSetTemplate,
+
+ textItemConfigSpecs,
+ textStyleConfigSpecs,
+ NULL, /*next */
+};
+
+/*----------------------------------------------------------------------
+ * Tix_TextItemCreate --
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static Tix_DItem * Tix_TextItemCreate(ddPtr, diTypePtr)
+ Tix_DispData * ddPtr;
+ Tix_DItemInfo * diTypePtr;
+{
+ TixTextItem * itPtr;
+
+ itPtr = (TixTextItem*) ckalloc(sizeof(TixTextItem));
+
+ itPtr->diTypePtr = &tix_TextItemType;
+ itPtr->ddPtr = ddPtr;
+#if 1
+ itPtr->stylePtr = (TixTextStyle*)TixGetDefaultDItemStyle(
+ itPtr->ddPtr, &tix_TextItemType, (Tix_DItem*)itPtr, NULL);
+#else
+ itPtr->stylePtr = NULL;
+#endif
+ itPtr->clientData = 0;
+ itPtr->size[0] = 0;
+ itPtr->size[1] = 0;
+
+ itPtr->numChars = 0;
+ itPtr->text = NULL;
+ itPtr->textW = 0;
+ itPtr->textH = 0;
+ itPtr->underline = -1;
+
+ return (Tix_DItem *)itPtr;
+}
+
+static void Tix_TextItemFree(iPtr)
+ Tix_DItem * iPtr;
+{
+ TixTextItem * itPtr = (TixTextItem *) iPtr;
+
+ if (itPtr->stylePtr) {
+ TixDItemStyleFree(iPtr, (Tix_DItemStyle*)itPtr->stylePtr);
+ }
+
+ Tk_FreeOptions(textItemConfigSpecs, (char *)itPtr,
+ itPtr->ddPtr->display, 0);
+ ckfree((char*)itPtr);
+}
+
+static int Tix_TextItemConfigure(iPtr, argc, argv, flags)
+ Tix_DItem * iPtr;
+ int argc;
+ char ** argv;
+ int flags;
+{
+ TixTextItem * itPtr = (TixTextItem *) iPtr;
+ TixTextStyle * oldStyle = itPtr->stylePtr;
+
+ if (Tk_ConfigureWidget(itPtr->ddPtr->interp, itPtr->ddPtr->tkwin,
+ textItemConfigSpecs,
+ argc, argv, (char *)itPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (itPtr->stylePtr == NULL) {
+ itPtr->stylePtr = (TixTextStyle*)TixGetDefaultDItemStyle(
+ itPtr->ddPtr, &tix_TextItemType, iPtr, NULL);
+ }
+
+ if (oldStyle != NULL && itPtr->stylePtr != oldStyle) {
+ Tix_TextItemStyleChanged(iPtr);
+ }
+ else {
+ Tix_TextItemCalculateSize((Tix_DItem*)itPtr);
+ }
+
+ return TCL_OK;
+}
+
+static void Tix_TextItemDisplay(pixmap, gc, iPtr, x, y, width, height, flags)
+ Pixmap pixmap;
+ GC gc;
+ Tix_DItem * iPtr;
+ int x;
+ int y;
+ int width;
+ int height;
+ int flags;
+{
+ TixTextItem *itPtr = (TixTextItem *)iPtr;
+ GC foreGC, backGC;
+ TixpSubRegion subReg;
+
+ if ((width <= 0) || (height <= 0)) {
+ return;
+ }
+
+ TixGetColorDItemGC(iPtr, &backGC, &foreGC, flags);
+
+ TixpStartSubRegionDraw(itPtr->ddPtr->display, pixmap, foreGC,
+ &subReg, 0, 0, x, y, width, height,
+ itPtr->size[0], itPtr->size[1]);
+
+ if (backGC != None) {
+ TixpSubRegFillRectangle(itPtr->ddPtr->display, pixmap, backGC,
+ &subReg, x, y, width, height);
+ }
+
+ TixDItemGetAnchor(itPtr->stylePtr->anchor, x, y, width, height,
+ itPtr->size[0], itPtr->size[1], &x, &y);
+
+ if (foreGC != None && itPtr->text != NULL) {
+ x += itPtr->stylePtr->pad[0];
+ y += itPtr->stylePtr->pad[1];
+
+ TixpSubRegDisplayText(itPtr->ddPtr->display, pixmap, foreGC,
+ &subReg, itPtr->stylePtr->font, itPtr->text,
+ itPtr->numChars, x, y, itPtr->textW, itPtr->stylePtr->justify,
+ itPtr->underline);
+ }
+
+ TixpEndSubRegionDraw(itPtr->ddPtr->display, pixmap, foreGC,
+ &subReg);
+}
+
+static char * Tix_TextItemComponent(iPtr, x, y)
+ Tix_DItem * iPtr;
+ int x;
+ int y;
+{
+#if 0
+ TixTextItem *itPtr = (TixTextItem *)iPtr;
+#endif
+ static char * body = "body";
+
+ return body;
+}
+
+
+static void Tix_TextItemCalculateSize(iPtr)
+ Tix_DItem * iPtr;
+{
+ TixTextItem *itPtr = (TixTextItem *)iPtr;
+
+
+ if (itPtr->text) {
+ itPtr->numChars = strlen(itPtr->text);
+ TixComputeTextGeometry(itPtr->stylePtr->font, itPtr->text,
+ itPtr->numChars,
+ itPtr->stylePtr->wrapLength, &itPtr->textW, &itPtr->textH);
+
+ itPtr->size[0] = itPtr->textW;
+ itPtr->size[1] = itPtr->textH;
+ } else {
+ itPtr->size[0] = 0;
+ itPtr->size[1] = 0;
+ }
+
+ itPtr->size[0] += 2*itPtr->stylePtr->pad[0];
+ itPtr->size[1] += 2*itPtr->stylePtr->pad[1];
+
+#if 0
+ /* %bordercolor not used */
+ if (itPtr->stylePtr->relief == TIX_RELIEF_SOLID) {
+ itPtr->size[0] += itPtr->stylePtr->borderWidth;
+ itPtr->size[1] += itPtr->stylePtr->borderWidth;
+ } else {
+ itPtr->size[0] += 2*itPtr->stylePtr->borderWidth;
+ itPtr->size[1] += 2*itPtr->stylePtr->borderWidth;
+ }
+#endif
+}
+
+static void
+Tix_TextItemStyleChanged(iPtr)
+ Tix_DItem * iPtr;
+{
+ TixTextItem *itPtr = (TixTextItem *)iPtr;
+
+ if (itPtr->stylePtr == NULL) {
+ /* Maybe we haven't set the style to default style yet */
+ return;
+ }
+ Tix_TextItemCalculateSize(iPtr);
+ if (itPtr->ddPtr->sizeChangedProc != NULL) {
+ itPtr->ddPtr->sizeChangedProc(iPtr);
+ }
+}
+
+static void
+Tix_TextItemLostStyle(iPtr)
+ Tix_DItem * iPtr;
+{
+ TixTextItem *itPtr = (TixTextItem *)iPtr;
+
+ itPtr->stylePtr = (TixTextStyle*)TixGetDefaultDItemStyle(
+ itPtr->ddPtr, &tix_TextItemType, iPtr, NULL);
+
+ Tix_TextItemStyleChanged(iPtr);
+}
+/*----------------------------------------------------------------------
+ *
+ *
+ * Display styles
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static Tix_DItemStyle *
+Tix_TextStyleCreate(interp, tkwin, diTypePtr, name)
+ Tcl_Interp * interp;
+ Tk_Window tkwin;
+ char * name;
+ Tix_DItemInfo * diTypePtr;
+{
+ TixTextStyle * stylePtr = (TixTextStyle *)ckalloc(sizeof(TixTextStyle));
+ int i;
+
+ stylePtr->font = NULL;
+ stylePtr->justify = TK_JUSTIFY_LEFT;
+ stylePtr->wrapLength = 0;
+ stylePtr->pad[0] = 0;
+ stylePtr->pad[1] = 0;
+ stylePtr->anchor = TK_ANCHOR_CENTER;
+
+ for (i=0; i<4; i++) {
+ stylePtr->colors[i].bg = NULL;
+ stylePtr->colors[i].fg = NULL;
+ stylePtr->colors[i].backGC = None;
+ stylePtr->colors[i].foreGC = NULL;
+ }
+#if 0
+ /* %bordercolor not used */
+ stylePtr->borderColor = NULL;
+ stylePtr->borderGC = None;
+ stylePtr->borderWidth = 0;
+ stylePtr->relief = TIX_RELIEF_NONE;
+#endif
+ stylePtr->pad[0] = 0;
+ stylePtr->pad[1] = 0;
+
+ return (Tix_DItemStyle *)stylePtr;
+}
+
+static int
+Tix_TextStyleConfigure(style, argc, argv, flags)
+ Tix_DItemStyle *style;
+ int argc;
+ char ** argv;
+ int flags;
+{
+ TixTextStyle * stylePtr = (TixTextStyle *)style;
+ XGCValues gcValues;
+ GC newGC;
+ int i, isNew;
+
+ if (stylePtr->font == NULL) {
+ isNew = 1;
+ } else {
+ isNew = 0;
+ }
+
+ if (!(flags &TIX_DONT_CALL_CONFIG)) {
+ if (Tk_ConfigureWidget(stylePtr->interp, stylePtr->tkwin,
+ textStyleConfigSpecs,
+ argc, argv, (char *)stylePtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ gcValues.font = TixFontId(stylePtr->font);
+ gcValues.graphics_exposures = False;
+
+ for (i=0; i<4; i++) {
+ /* Foreground */
+ gcValues.background = stylePtr->colors[i].bg->pixel;
+ gcValues.foreground = stylePtr->colors[i].fg->pixel;
+ newGC = Tk_GetGC(stylePtr->tkwin,
+ GCFont|GCForeground|GCBackground|GCGraphicsExposures, &gcValues);
+
+ if (stylePtr->colors[i].foreGC != None) {
+ Tk_FreeGC(Tk_Display(stylePtr->tkwin),
+ stylePtr->colors[i].foreGC);
+ }
+ stylePtr->colors[i].foreGC = newGC;
+
+ /* Background */
+ gcValues.foreground = stylePtr->colors[i].bg->pixel;
+ newGC = Tk_GetGC(stylePtr->tkwin,
+ GCFont|GCForeground|GCGraphicsExposures, &gcValues);
+
+ if (stylePtr->colors[i].backGC != None) {
+ Tk_FreeGC(Tk_Display(stylePtr->tkwin),
+ stylePtr->colors[i].backGC);
+ }
+ stylePtr->colors[i].backGC = newGC;
+ }
+
+#if 0
+ /* %bordercolor not used */
+ /* Border Color */
+ gcValues.foreground = stylePtr->borderColor->pixel;
+ newGC = Tk_GetGC(stylePtr->tkwin, GCForeground, &gcValues);
+
+ if (stylePtr->borderGC != None) {
+ Tk_FreeGC(Tk_Display(stylePtr->tkwin), stylePtr->borderGC);
+ }
+ stylePtr->borderGC = newGC;
+#endif
+
+ if (!isNew) {
+ TixDItemStyleChanged(stylePtr->diTypePtr, (Tix_DItemStyle *)stylePtr);
+ }
+
+ return TCL_OK;
+}
+
+static void
+Tix_TextStyleFree(style)
+ Tix_DItemStyle *style;
+{
+ TixTextStyle * stylePtr = (TixTextStyle *)style;
+ int i;
+
+ for (i=0; i<4; i++) {
+ if (stylePtr->colors[i].backGC != None) {
+ Tk_FreeGC(Tk_Display(stylePtr->tkwin), stylePtr->colors[i].backGC);
+ }
+ if (stylePtr->colors[i].foreGC != None) {
+ Tk_FreeGC(Tk_Display(stylePtr->tkwin), stylePtr->colors[i].foreGC);
+ }
+ }
+
+ Tk_FreeOptions(textStyleConfigSpecs, (char *)stylePtr,
+ Tk_Display(stylePtr->tkwin), 0);
+ ckfree((char *)stylePtr);
+}
+
+static int bg_flags [4] = {
+ TIX_DITEM_NORMAL_BG,
+ TIX_DITEM_ACTIVE_BG,
+ TIX_DITEM_SELECTED_BG,
+ TIX_DITEM_DISABLED_BG
+};
+static int fg_flags [4] = {
+ TIX_DITEM_NORMAL_FG,
+ TIX_DITEM_ACTIVE_FG,
+ TIX_DITEM_SELECTED_FG,
+ TIX_DITEM_DISABLED_FG
+};
+
+
+static void
+Tix_TextStyleSetTemplate(style, tmplPtr)
+ Tix_DItemStyle* style;
+ Tix_StyleTemplate * tmplPtr;
+{
+ TixTextStyle * stylePtr = (TixTextStyle *)style;
+ int i;
+
+ if (tmplPtr->flags & TIX_DITEM_FONT) {
+ if (stylePtr->font != NULL) {
+ TixFreeFont(stylePtr->font);
+ }
+ stylePtr->font = TixGetFont(
+ stylePtr->interp, stylePtr->tkwin,
+ TixNameOfFont(tmplPtr->font));
+ }
+ if (tmplPtr->flags & TIX_DITEM_PADX) {
+ stylePtr->pad[0] = tmplPtr->pad[0];
+ }
+ if (tmplPtr->flags & TIX_DITEM_PADY) {
+ stylePtr->pad[1] = tmplPtr->pad[1];
+ }
+
+ for (i=0; i<4; i++) {
+ if (tmplPtr->flags & bg_flags[i]) {
+ if (stylePtr->colors[i].bg != NULL) {
+ Tk_FreeColor(stylePtr->colors[i].bg);
+ }
+ stylePtr->colors[i].bg = Tk_GetColor(
+ stylePtr->interp, stylePtr->tkwin,
+ Tk_NameOfColor(tmplPtr->colors[i].bg));
+ }
+ }
+ for (i=0; i<4; i++) {
+ if (tmplPtr->flags & fg_flags[i]) {
+ if (stylePtr->colors[i].fg != NULL) {
+ Tk_FreeColor(stylePtr->colors[i].fg);
+ }
+ stylePtr->colors[i].fg = Tk_GetColor(
+ stylePtr->interp, stylePtr->tkwin,
+ Tk_NameOfColor(tmplPtr->colors[i].fg));
+ }
+ }
+#if 0
+ /* %bordercolor not used */
+ if (tmplPtr->flags & TIX_DITEM_BORDER_COLOR) {
+ if (stylePtr->borderColor != NULL) {
+ Tk_FreeColor(stylePtr->borderColor);
+ }
+ stylePtr->borderColor = Tk_GetColor(
+ stylePtr->interp, stylePtr->tkwin,
+ Tk_NameOfColor(tmplPtr->borderColor));
+ }
+ if (tmplPtr->flags & TIX_DITEM_BORDER_WIDTH) {
+ stylePtr->borderWidth = tmplPtr->borderWidth;
+ }
+ if (tmplPtr->flags & TIX_DITEM_RELIEF) {
+ stylePtr->relief = tmplPtr->relief;
+ }
+#endif
+
+ Tix_TextStyleConfigure(style, 0, 0, TIX_DONT_CALL_CONFIG);
+}
diff --git a/tix/generic/tixDiWin.c b/tix/generic/tixDiWin.c
new file mode 100644
index 00000000000..357601944c2
--- /dev/null
+++ b/tix/generic/tixDiWin.c
@@ -0,0 +1,739 @@
+/*
+ * tixDiWin.c --
+ *
+ * This file implements one of the "Display Items" in the Tix library :
+ * WindowItem display items.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixDef.h>
+
+/*----------------------------------------------------------------------
+ *
+ * Data structures used by this file
+ *
+ *----------------------------------------------------------------------
+ */
+
+/*----------------------------------------------------------------------
+ *
+ * Private data definition
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tix_ListInfo mapWinListInfo = {
+ Tk_Offset(TixWindowItem, next),
+ TIX_UNDEFINED,
+};
+
+#define DEF_WINDOWITEM_WINDOW ""
+#define DEF_WINDOWITEM_STYLE ""
+#define DEF_WINDOWITEM_TYPE "window"
+
+static Tk_ConfigSpec windowItemConfigSpecs[] = {
+ {TK_CONFIG_CUSTOM, "-itemtype", "itemType", "ItemType",
+ DEF_WINDOWITEM_TYPE, Tk_Offset(TixWindowItem, diTypePtr),
+ 0, &tixConfigItemType},
+
+ {TK_CONFIG_CUSTOM, "-style", "windowStyle", "WindowStyle",
+ DEF_WINDOWITEM_STYLE, Tk_Offset(TixWindowItem, stylePtr),
+ TK_CONFIG_NULL_OK, &tixConfigItemStyle},
+
+ {TK_CONFIG_SYNONYM, "-widget", (char *) NULL, (char *) NULL,
+ (char *)NULL, 0, 0},
+
+ {TK_CONFIG_WINDOW, "-window", "window", "Window",
+ DEF_WINDOWITEM_WINDOW, Tk_Offset(TixWindowItem, tkwin), 0},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+/*----------------------------------------------------------------------
+ *
+ * Configuration options for Window Styles
+ *
+ *----------------------------------------------------------------------
+ */
+#define DEF_WINDOWSTYLE_PADX "0"
+#define DEF_WINDOWSTYLE_PADY "0"
+#define DEF_WINDOWSTYLE_ANCHOR "w"
+
+static Tk_ConfigSpec windowStyleConfigSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_WINDOWSTYLE_ANCHOR, Tk_Offset(TixWindowStyle, anchor), 0},
+
+ {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
+ DEF_WINDOWSTYLE_PADX, Tk_Offset(TixWindowStyle, pad[0]), 0},
+
+ {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
+ DEF_WINDOWSTYLE_PADY, Tk_Offset(TixWindowStyle, pad[1]), 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 SubWindowLostSlaveProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin));
+static void SubWindowRequestProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin));
+static void SubWindowStructureProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static char * Tix_WindowItemComponent _ANSI_ARGS_((
+ Tix_DItem * iPtr, int x, int y));
+static void Tix_WindowItemCalculateSize _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+static int Tix_WindowItemConfigure _ANSI_ARGS_((
+ Tix_DItem * iPtr, int argc, char ** argv,
+ int flags));
+static Tix_DItem * Tix_WindowItemCreate _ANSI_ARGS_((
+ Tix_DispData * ddPtr, Tix_DItemInfo * diTypePtr));
+static void Tix_WindowItemDisplay _ANSI_ARGS_((
+ Pixmap pixmap, GC gc, Tix_DItem * iPtr,
+ int x, int y, int width, int height, int flags));
+static void Tix_WindowItemFree _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+static void Tix_WindowItemLostStyle _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+static void Tix_WindowItemStyleChanged _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+static void Tix_WindowItemUnmap _ANSI_ARGS_((
+ TixWindowItem *itPtr));
+static int Tix_WindowStyleConfigure _ANSI_ARGS_((
+ Tix_DItemStyle* style, int argc, char ** argv,
+ int flags));
+static Tix_DItemStyle * Tix_WindowStyleCreate _ANSI_ARGS_((
+ Tcl_Interp *interp, Tk_Window tkwin,
+ Tix_DItemInfo * diTypePtr, char * name));
+static void Tix_WindowStyleFree _ANSI_ARGS_((
+ Tix_DItemStyle* style));
+static void Tix_WindowStyleSetTemplate _ANSI_ARGS_((
+ Tix_DItemStyle* style,
+ Tix_StyleTemplate * tmplPtr));
+static void UnmanageWindow _ANSI_ARGS_((Tix_DItem * iPtr,
+ Tk_Window tkwin));
+static void ManageWindow _ANSI_ARGS_((Tix_DItem * iPtr,
+ Tk_Window tkwin));
+
+Tix_DItemInfo tix_WindowItemType = {
+ "window", /* type */
+ TIX_DITEM_WINDOW,
+ Tix_WindowItemCreate, /* createProc */
+ Tix_WindowItemConfigure,
+ Tix_WindowItemCalculateSize,
+ Tix_WindowItemComponent,
+ Tix_WindowItemDisplay,
+ Tix_WindowItemFree,
+ Tix_WindowItemStyleChanged,
+ Tix_WindowItemLostStyle,
+
+ Tix_WindowStyleCreate,
+ Tix_WindowStyleConfigure,
+ Tix_WindowStyleFree,
+ Tix_WindowStyleSetTemplate,
+
+ windowItemConfigSpecs,
+ windowStyleConfigSpecs,
+
+ NULL, /*next */
+};
+
+/*
+ * The structure below defines the official type record for the
+ * placer:
+ */
+static Tk_GeomMgr windowItemGeomType = {
+ "tixWindowItem", /* name */
+ SubWindowRequestProc, /* requestProc */
+ SubWindowLostSlaveProc, /* lostSlaveProc */
+};
+
+/*----------------------------------------------------------------------
+ * Tix_WindowItemCreate --
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static Tix_DItem * Tix_WindowItemCreate(ddPtr, diTypePtr)
+ Tix_DispData * ddPtr;
+ Tix_DItemInfo * diTypePtr;
+{
+ TixWindowItem * itPtr;
+
+ itPtr = (TixWindowItem*) ckalloc(sizeof(TixWindowItem));
+
+ itPtr->diTypePtr = diTypePtr;
+ itPtr->ddPtr = ddPtr;
+ itPtr->stylePtr = NULL;
+ itPtr->clientData = 0;
+ itPtr->size[0] = 0;
+ itPtr->size[1] = 0;
+
+ itPtr->tkwin = NULL;
+
+ return (Tix_DItem *)itPtr;
+}
+
+/* %% */
+static void Tix_WindowItemFree(iPtr)
+ Tix_DItem * iPtr;
+{
+ TixWindowItem * itPtr = (TixWindowItem *) iPtr;
+
+ if (itPtr->tkwin) {
+ Tk_DeleteEventHandler(itPtr->tkwin, StructureNotifyMask,
+ SubWindowStructureProc, (ClientData) itPtr);
+ Tk_ManageGeometry(itPtr->tkwin, (Tk_GeomMgr *)NULL,
+ (ClientData) NULL);
+ Tk_UnmapWindow(itPtr->tkwin);
+ }
+ if (itPtr->stylePtr) {
+ TixDItemStyleFree(iPtr, (Tix_DItemStyle*)itPtr->stylePtr);
+ }
+
+ Tk_FreeOptions(windowItemConfigSpecs, (char *)itPtr,
+ itPtr->ddPtr->display, 0);
+
+ ckfree((char*)itPtr);
+}
+
+/*----------------------------------------------------------------------
+ * ManageWindow --
+ *
+ * Associate this sub-window with the window item.
+ *
+ * Side effect:
+ * itPtr->tkwin is changed.
+ *----------------------------------------------------------------------
+ */
+
+static void
+ManageWindow(iPtr, tkwin)
+ Tix_DItem * iPtr;
+ Tk_Window tkwin;
+{
+ TixWindowItem * itPtr = (TixWindowItem *) iPtr;
+
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ SubWindowStructureProc, (ClientData) itPtr);
+ Tk_ManageGeometry(tkwin, &windowItemGeomType,
+ (ClientData) itPtr);
+
+ itPtr->tkwin = tkwin;
+}
+
+/*----------------------------------------------------------------------
+ * UnmanageWindow --
+ *
+ * Disassociate this sub-window from the window item.
+ *
+ * Note:
+ * the tkwin parameter may not equal to itPtr->tkwin.
+ *----------------------------------------------------------------------
+ */
+
+static void
+UnmanageWindow(iPtr, tkwin)
+ Tix_DItem * iPtr;
+ Tk_Window tkwin;
+{
+ TixWindowItem * itPtr = (TixWindowItem *) iPtr;
+
+ Tk_DeleteEventHandler(tkwin, StructureNotifyMask,
+ SubWindowStructureProc, (ClientData) itPtr);
+ Tk_ManageGeometry(tkwin, (Tk_GeomMgr *)NULL,
+ (ClientData) NULL);
+ Tk_UnmapWindow(tkwin);
+}
+
+static int Tix_WindowItemConfigure(iPtr, argc, argv, flags)
+ Tix_DItem * iPtr;
+ int argc;
+ char ** argv;
+ int flags;
+{
+ TixWindowItem * itPtr = (TixWindowItem *) iPtr;
+ TixWindowStyle * oldStyle = itPtr->stylePtr;
+ Tk_Window oldWindow;
+
+ oldWindow = itPtr->tkwin;
+
+ if (Tk_ConfigureWidget(itPtr->ddPtr->interp, itPtr->ddPtr->tkwin,
+ windowItemConfigSpecs,
+ argc, argv, (char *)itPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (itPtr->stylePtr == NULL) {
+ itPtr->stylePtr = (TixWindowStyle*)TixGetDefaultDItemStyle(
+ itPtr->ddPtr, &tix_WindowItemType, iPtr, NULL);
+ }
+
+ if (oldWindow != itPtr->tkwin) {
+ if (oldWindow != NULL) {
+ UnmanageWindow(iPtr, oldWindow);
+ }
+ if (itPtr->tkwin != NULL) {
+ /*
+ * Make sure that the master window is the parent of the
+ * window associated with the item.
+ * Also, don't allow a top-level window to be
+ * managed inside a master window.
+ */
+ if (Tk_Parent(itPtr->tkwin) != itPtr->ddPtr->tkwin) {
+ Tcl_AppendResult(itPtr->ddPtr->interp, "can't use ",
+ Tk_PathName(itPtr->tkwin),
+ " in a window item of the master widget: must be a child",
+ " of ", Tk_PathName(itPtr->ddPtr->tkwin), (char *) NULL);
+ goto badWindow;
+ }
+ if (((Tk_FakeWin *) (itPtr->tkwin))->flags & TK_TOP_LEVEL) {
+ Tcl_AppendResult(itPtr->ddPtr->interp,
+ "can't manage toplevel window",
+ Tk_PathName(itPtr->tkwin),
+ " as a window item of ", Tk_PathName(itPtr->ddPtr->tkwin),
+ (char *) NULL);
+ goto badWindow;
+ }
+ ManageWindow(iPtr, itPtr->tkwin);
+ }
+ }
+
+ if (oldStyle != NULL && itPtr->stylePtr != oldStyle) {
+ Tix_WindowItemStyleChanged(iPtr);
+ }
+ else {
+ Tix_WindowItemCalculateSize((Tix_DItem*)itPtr);
+ }
+
+ return TCL_OK;
+
+badWindow:
+
+ itPtr->tkwin = NULL;
+ return TCL_ERROR;
+}
+
+static void Tix_WindowItemDisplay(pixmap, gc, iPtr, x, y, width, height, flag)
+ Pixmap pixmap;
+ GC gc;
+ Tix_DItem * iPtr;
+ int x;
+ int y;
+ int width;
+ int height;
+ int flag;
+{
+ TixWindowItem *itPtr = (TixWindowItem *)iPtr;
+
+ if (itPtr->tkwin == NULL) {
+ return;
+ }
+
+ TixDItemGetAnchor(itPtr->stylePtr->anchor, x, y, width, height,
+ itPtr->size[0], itPtr->size[1], &x, &y);
+
+ x += itPtr->stylePtr->pad[0];
+ y += itPtr->stylePtr->pad[1];
+ width -= 2*itPtr->stylePtr->pad[0];
+ height -= 2*itPtr->stylePtr->pad[1];
+
+ if (width < 1 || height < 1) {
+ if (itPtr->ddPtr->tkwin != Tk_Parent(itPtr->tkwin)) {
+ Tk_UnmaintainGeometry(itPtr->tkwin, itPtr->ddPtr->tkwin);
+ }
+ Tk_UnmapWindow(itPtr->tkwin);
+ return;
+ }
+
+ if (itPtr->ddPtr->tkwin == Tk_Parent(itPtr->tkwin)) {
+ Tk_MapWindow(itPtr->tkwin);
+ Tk_MoveResizeWindow(itPtr->tkwin, x, y, width, height);
+ }
+ else {
+ Tk_MaintainGeometry(itPtr->tkwin, itPtr->ddPtr->tkwin,
+ x, y, width, height);
+ }
+}
+
+static void Tix_WindowItemCalculateSize(iPtr)
+ Tix_DItem * iPtr;
+{
+ TixWindowItem *itPtr = (TixWindowItem*)iPtr;
+
+ if (itPtr->tkwin != NULL) {
+ itPtr->size[0] = Tk_ReqWidth (itPtr->tkwin);
+ itPtr->size[1] = Tk_ReqHeight(itPtr->tkwin);
+ } else {
+ itPtr->size[0] = 0;
+ itPtr->size[1] = 0;
+ }
+
+ itPtr->size[0] += 2*itPtr->stylePtr->pad[0];
+ itPtr->size[1] += 2*itPtr->stylePtr->pad[1];
+}
+
+static char * Tix_WindowItemComponent(iPtr, x, y)
+ Tix_DItem * iPtr;
+ int x;
+ int y;
+{
+#if 0
+ TixWindowItem *itPtr = (TixWindowItem *)iPtr;
+#endif
+ static char * body = "body";
+
+ return body;
+}
+
+
+static void Tix_WindowItemStyleChanged(iPtr)
+ Tix_DItem * iPtr;
+{
+ TixWindowItem *itPtr = (TixWindowItem *)iPtr;
+
+ if (itPtr->stylePtr == NULL) {
+ /* Maybe we haven't set the style to default style yet */
+ return;
+ }
+ Tix_WindowItemCalculateSize(iPtr);
+ if (itPtr->ddPtr->sizeChangedProc != NULL) {
+ itPtr->ddPtr->sizeChangedProc(iPtr);
+ }
+}
+static void Tix_WindowItemLostStyle(iPtr)
+ Tix_DItem * iPtr;
+{
+ TixWindowItem *itPtr = (TixWindowItem *)iPtr;
+
+ itPtr->stylePtr = (TixWindowStyle*)TixGetDefaultDItemStyle(
+ itPtr->ddPtr, &tix_WindowItemType, iPtr, NULL);
+
+ Tix_WindowItemStyleChanged(iPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SubWindowStructureProc --
+ *
+ * This procedure is invoked whenever StructureNotify events
+ * occur for a window that's managed as part of a display
+ * item. This procudure's only purpose is to clean up when
+ * windows are deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is disassociated from the window item when it is
+ * deleted.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+SubWindowStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to record describing window item. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ TixWindowItem * itPtr = (TixWindowItem *)clientData;
+ int oldWidth, oldHeight;
+
+ if (eventPtr->type == DestroyNotify) {
+ itPtr->tkwin = NULL;
+ }
+ oldWidth = itPtr->size[0];
+ oldHeight = itPtr->size[1];
+ Tix_WindowItemCalculateSize((Tix_DItem*)itPtr);
+
+ if (oldWidth != itPtr->size[0] || oldHeight != itPtr->size[1]) {
+ if (itPtr->ddPtr->sizeChangedProc != NULL) {
+ itPtr->ddPtr->sizeChangedProc((Tix_DItem*)itPtr);
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SubWindowRequestProc --
+ *
+ * This procedure is invoked whenever a window that's associated
+
+ * with a display item changes its requested dimensions.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size and location on the screen of the window may change,
+ * depending on the options specified for the window item.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+SubWindowRequestProc(clientData, tkwin)
+ ClientData clientData; /* Pointer to record for window item.*/
+ Tk_Window tkwin; /* Window that changed its desired
+ * size. */
+{
+ TixWindowItem *itPtr = (TixWindowItem *) clientData;
+
+ Tix_WindowItemCalculateSize((Tix_DItem*)itPtr);
+ if (itPtr->ddPtr->sizeChangedProc != NULL) {
+ itPtr->ddPtr->sizeChangedProc((Tix_DItem*)itPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SubWindowLostSlaveProc --
+ *
+ * This procedure is invoked by Tk whenever some other geometry
+ * claims control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+ /* ARGSUSED */
+static void
+SubWindowLostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* TixWindowItem structure for slave
+ * window that was stolen away. */
+ Tk_Window tkwin; /* Tk's handle for the slave window. */
+{
+ TixWindowItem *itPtr = (TixWindowItem *) clientData;
+
+ if (itPtr->tkwin == NULL) {
+ return;
+ } else {
+ itPtr->tkwin = NULL;
+ }
+
+ Tk_DeleteEventHandler(tkwin, StructureNotifyMask,
+ SubWindowStructureProc, (ClientData) itPtr);
+ Tk_ManageGeometry(tkwin, (Tk_GeomMgr *)NULL,
+ (ClientData) NULL);
+ if (itPtr->ddPtr->tkwin != Tk_Parent(tkwin)) {
+ Tk_UnmaintainGeometry(tkwin, itPtr->ddPtr->tkwin);
+ }
+ Tk_UnmapWindow(tkwin);
+
+ /*
+ * Inform the owner that the size has changed
+ */
+ Tix_WindowItemCalculateSize((Tix_DItem*)itPtr);
+ if (itPtr->ddPtr->sizeChangedProc != NULL) {
+ itPtr->ddPtr->sizeChangedProc((Tix_DItem*)itPtr);
+ }
+}
+/*----------------------------------------------------------------------
+ * Tix_WindowItemUnmap --
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+Tix_WindowItemUnmap(itPtr)
+ TixWindowItem *itPtr;
+{
+ Tk_Window tkwin = itPtr->tkwin;
+
+ if (tkwin == NULL) {
+ return;
+ }
+
+ if (itPtr->ddPtr->tkwin != Tk_Parent(tkwin)) {
+ Tk_UnmaintainGeometry(tkwin, itPtr->ddPtr->tkwin);
+ }
+ Tk_UnmapWindow(tkwin);
+}
+
+/*----------------------------------------------------------------------
+ *
+ *
+ * Display styles
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static Tix_DItemStyle *
+Tix_WindowStyleCreate(interp, tkwin, diTypePtr, name)
+ Tcl_Interp * interp;
+ Tk_Window tkwin;
+ char * name;
+ Tix_DItemInfo * diTypePtr;
+{
+ TixWindowStyle * stylePtr =
+ (TixWindowStyle *)ckalloc(sizeof(TixWindowStyle));
+
+ stylePtr->pad[0] = 0;
+ stylePtr->pad[1] = 0;
+ stylePtr->anchor = TK_ANCHOR_CENTER;
+
+ return (Tix_DItemStyle *)stylePtr;
+}
+
+static int
+Tix_WindowStyleConfigure(style, argc, argv, flags)
+ Tix_DItemStyle *style;
+ int argc;
+ char ** argv;
+ int flags;
+{
+ TixWindowStyle * stylePtr = (TixWindowStyle *)style;
+ int oldPadX;
+ int oldPadY;
+
+ oldPadX = stylePtr->pad[0];
+ oldPadY = stylePtr->pad[1];
+
+ if (!(flags &TIX_DONT_CALL_CONFIG)) {
+ if (Tk_ConfigureWidget(stylePtr->interp, stylePtr->tkwin,
+ windowStyleConfigSpecs,
+ argc, argv, (char *)stylePtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ if (oldPadX != stylePtr->pad[0] || oldPadY != stylePtr->pad[1]) {
+ TixDItemStyleChanged(stylePtr->diTypePtr, (Tix_DItemStyle *)stylePtr);
+ }
+
+ return TCL_OK;
+}
+
+static void Tix_WindowStyleFree(style)
+ Tix_DItemStyle *style;
+{
+ TixWindowStyle * stylePtr = (TixWindowStyle *)style;
+
+ Tk_FreeOptions(windowStyleConfigSpecs, (char *)stylePtr,
+ Tk_Display(stylePtr->tkwin), 0);
+ ckfree((char *)stylePtr);
+}
+
+static void
+Tix_WindowStyleSetTemplate(style, tmplPtr)
+ Tix_DItemStyle* style;
+ Tix_StyleTemplate * tmplPtr;
+{
+ TixWindowStyle * stylePtr = (TixWindowStyle *)style;
+
+
+ if (tmplPtr->flags & TIX_DITEM_PADX) {
+ stylePtr->pad[0] = tmplPtr->pad[0];
+ }
+ if (tmplPtr->flags & TIX_DITEM_PADY) {
+ stylePtr->pad[1] = tmplPtr->pad[1];
+ }
+
+ Tix_WindowStyleConfigure(style, 0, 0, TIX_DONT_CALL_CONFIG);
+}
+
+/*----------------------------------------------------------------------
+ *
+ *
+ * Mapped Window List Handling
+ *
+ *
+ * Maintaining a list of mapped window items. Every host widgets should
+ * call these functions so that unwanted window items will not appear
+ * on the screen.
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+
+void Tix_SetWindowItemSerial(lPtr, iPtr, serial)
+ Tix_LinkList * lPtr;
+ Tix_DItem * iPtr;
+ int serial;
+{
+ TixWindowItem * itPtr = (TixWindowItem *)iPtr;
+ TixWindowItem * curr;
+ Tix_ListIterator li;
+ Tix_LinkListIteratorInit(&li);
+
+ itPtr->serial = serial;
+
+ for (Tix_LinkListStart(&mapWinListInfo, lPtr, &li);
+ !Tix_LinkListDone(&li);
+ Tix_LinkListNext (&mapWinListInfo, lPtr, &li)) {
+
+ curr = (TixWindowItem*)li.curr;
+
+ if (curr == itPtr) {
+ /* Don't want any duplication */
+ return;
+ }
+ }
+ Tix_LinkListAppend(&mapWinListInfo, lPtr, (char*)itPtr, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ * UnmapWindows --
+ *
+ * We need to unmap all those windows that were displayed last time
+ * but should be now invisible.
+ * Otherwise we will have some unwanted child windows floating
+ * around.
+ *----------------------------------------------------------------------
+ */
+void Tix_UnmapInvisibleWindowItems(lPtr, serial)
+ Tix_LinkList * lPtr;
+ int serial;
+{
+ TixWindowItem * curr;
+ Tix_ListIterator li;
+ Tix_LinkListIteratorInit(&li);
+
+ for (Tix_LinkListStart(&mapWinListInfo, lPtr, &li);
+ !Tix_LinkListDone(&li);
+ Tix_LinkListNext (&mapWinListInfo, lPtr, &li)) {
+
+ curr = (TixWindowItem*)li.curr;
+ if (curr->serial != serial) {
+ Tix_WindowItemUnmap(curr);
+ Tix_LinkListDelete(&mapWinListInfo, lPtr, &li);
+ }
+ }
+}
+
+void
+Tix_WindowItemListRemove(lPtr, iPtr)
+ Tix_LinkList * lPtr;
+ Tix_DItem * iPtr;
+{
+ TixWindowItem * curr;
+ Tix_ListIterator li;
+ Tix_LinkListIteratorInit(&li);
+
+ for (Tix_LinkListStart(&mapWinListInfo, lPtr, &li);
+ !Tix_LinkListDone(&li);
+ Tix_LinkListNext (&mapWinListInfo, lPtr, &li)) {
+
+ curr = (TixWindowItem*)li.curr;
+ if (curr == (TixWindowItem*)iPtr) {
+ Tix_WindowItemUnmap(curr);
+ Tix_LinkListDelete(&mapWinListInfo, lPtr, &li);
+ return;
+ }
+ }
+}
diff --git a/tix/generic/tixError.c b/tix/generic/tixError.c
new file mode 100644
index 00000000000..bef643bc34b
--- /dev/null
+++ b/tix/generic/tixError.c
@@ -0,0 +1,77 @@
+/*
+ * tixError.c --
+ *
+ * Implements error handlers for Tix.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+
+int Tix_ArgcError(interp, argc, argv, prefixCount, message)
+ Tcl_Interp * interp;
+ int argc;
+ char ** argv;
+ int prefixCount;
+ char * message;
+{
+ int i;
+
+ Tcl_AppendResult(interp, "wrong # of arguments, should be \"",(char*)NULL);
+
+ for (i=0; i<prefixCount && i<argc; i++) {
+ Tcl_AppendResult(interp, argv[i], " ", (char*)NULL);
+ }
+
+ Tcl_AppendResult(interp, message, "\".", (char*)NULL);
+
+ return TCL_ERROR;
+}
+
+int Tix_ValueMissingError(interp, spec)
+ Tcl_Interp * interp;
+ char * spec;
+{
+ Tcl_AppendResult(interp, "value for \"", spec,
+ "\" missing", (char*)NULL);
+ return TCL_ERROR;
+}
+
+
+/*----------------------------------------------------------------------
+ * Tix_UnknownPublicMethodError --
+ *
+ *
+ * ToDo: sort the list of commands.
+ *----------------------------------------------------------------------
+ */
+int Tix_UnknownPublicMethodError(interp, cPtr, widRec, method)
+ Tcl_Interp * interp;
+ TixClassRecord * cPtr;
+ char * widRec;
+ char * method;
+{
+ int i;
+ char * lead = "";
+
+ Tcl_AppendResult(interp, "unknown option \"", method,
+ "\": must be ",
+ (char*)NULL);
+
+ for (i=0; i<cPtr->nMethods-1; i++) {
+ Tcl_AppendResult(interp, lead, cPtr->methods[i], (char*)NULL);
+ lead = ", ";
+ }
+ if (cPtr->nMethods>1) {
+ Tcl_AppendResult(interp, " or ", (char*)NULL);
+ }
+ if (cPtr->nMethods>0) {
+ Tcl_AppendResult(interp, cPtr->methods[i], (char*)NULL);
+ }
+ return TCL_ERROR;
+}
diff --git a/tix/generic/tixForm.c b/tix/generic/tixForm.c
new file mode 100644
index 00000000000..bd298fab077
--- /dev/null
+++ b/tix/generic/tixForm.c
@@ -0,0 +1,2114 @@
+/*
+ * tixForm.c --
+ *
+ * Implements the tixForm geometry manager, which has similar
+ * capability as the Motif Form geometry manager. Please
+ * refer to the documentation for the use of tixForm.
+ *
+ * This file implements the basic algorithm of tixForm.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+/*
+ *
+ * ToDo:
+ *
+ * (1) Delete the master structure when there is no more client to manage
+ *
+ * Possible bugs:
+ * (1) a client is deleted but the master doesn't know
+ * (clientPtr->tkwin == NULL)
+ * (2) Whan a client S is deleted or detached from the master, all other
+ * clients attached to S must delete their reference to S
+ */
+
+#include <tkInt.h>
+#include <tixPort.h>
+#include <tix.h>
+#include <tixForm.h>
+#define DEBUG 0
+
+
+typedef struct SpringLink {
+ struct SpringLink * next;
+ FormInfo *clientPtr;
+} SpringLink;
+
+
+typedef struct SpringList {
+ SpringLink * head, * tail;
+ int num;
+} SpringList;
+
+
+/*
+ * SubCommands of the tixForm command.
+ */
+static TIX_DECLARE_SUBCMD(TixFm_SetGrid);
+static TIX_DECLARE_SUBCMD(TixFm_SetClient);
+static TIX_DECLARE_SUBCMD(TixFm_Check);
+static TIX_DECLARE_SUBCMD(TixFm_Forget);
+EXTERN TIX_DECLARE_SUBCMD(TixFm_Info);
+static TIX_DECLARE_SUBCMD(TixFm_Slaves);
+static TIX_DECLARE_SUBCMD(TixFm_Spring);
+
+static void ArrangeGeometry _ANSI_ARGS_((ClientData clientData));
+static void ArrangeWhenIdle _ANSI_ARGS_((MasterInfo * masterPtr));
+static void CancelArrangeWhenIdle _ANSI_ARGS_((
+ MasterInfo * masterPtr));
+static void CalculateMasterSize _ANSI_ARGS_((MasterInfo *master));
+static void CheckIntergrity _ANSI_ARGS_((FormInfo * clientPtr));
+static MasterInfo * GetMasterInfo _ANSI_ARGS_((Tk_Window tkwin,
+ int create));
+static void MasterStructureProc _ANSI_ARGS_((ClientData clientData,
+ XEvent * eventPtr));
+static int PinnClient _ANSI_ARGS_((FormInfo *clientPtr));
+static int PinnClientSide _ANSI_ARGS_((FormInfo *clientPtr,
+ int axis, int which, int isSelf));
+static int PlaceClientSide _ANSI_ARGS_((FormInfo *clientPtr,
+ int axis, int which, int isSelf));
+static int TestAndArrange _ANSI_ARGS_((MasterInfo *masterPtr));
+static int TixFm_CheckArgv _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char ** argv));
+static void TixFm_LostSlaveProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin));
+static void TixFm_ReqProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static int PlaceAllClients _ANSI_ARGS_((MasterInfo *masterPtr));
+static int PlaceClient _ANSI_ARGS_((FormInfo *clientPtr));
+static int PlaceSide_AttOpposite _ANSI_ARGS_((
+ FormInfo *clientPtr, int axis, int which));
+static int PlaceSide_AttAbsolute _ANSI_ARGS_((
+ FormInfo *clientPtr, int axis, int which));
+static int PlaceSide_AttNone _ANSI_ARGS_((
+ FormInfo *clientPtr, int axis, int which));
+static int PlaceSide_AttParallel _ANSI_ARGS_((FormInfo *clientPtr,
+ int axis, int which));
+static int PlaceSimpleCase _ANSI_ARGS_((
+ FormInfo *clientPtr, int axis, int which));
+static int PlaceWithSpring _ANSI_ARGS_((
+ FormInfo *clientPtr, int axis, int which));
+static int ReqSize _ANSI_ARGS_((Tk_Window tkwin,
+ int axis));
+static void UnmapClient _ANSI_ARGS_((FormInfo *clientPtr));
+static void MapClient _ANSI_ARGS_((FormInfo *clientPtr,
+ int x, int y, int width, int height));
+static int PinnSide_AttNone _ANSI_ARGS_((FormInfo *clientPtr,
+ int axis, int which));
+static int PinnSide_AttPercent _ANSI_ARGS_((FormInfo *clientPtr,
+ int axis, int which));
+static int PinnSide_AttOpposite _ANSI_ARGS_((FormInfo *clientPtr,
+ int axis, int which));
+static int PinnSide_AttParallel _ANSI_ARGS_((FormInfo *clientPtr,
+ int axis, int which));
+static SpringLink * AllocSpringLink _ANSI_ARGS_((void));
+static void FreeSpringLink _ANSI_ARGS_((SpringLink * link));
+static void FreeSpringList _ANSI_ARGS_((SpringList * listPtr));
+static void AddRightSprings _ANSI_ARGS_((SpringList * listPtr,
+ FormInfo *clientPtr));
+static void AddLeftSprings _ANSI_ARGS_((SpringList * listPtr,
+ FormInfo *clientPtr));
+
+/*
+ * A macro used to simplify the "pinn client" code
+ */
+#define PINN_CLIENT_SIDE(client, axis, which, isSelf) \
+ if (PinnClientSide(client, axis, which, isSelf) == TCL_ERROR) { \
+ return TCL_ERROR; \
+ }
+/*
+ * A macro used to simplify the "place client" code
+ */
+#define PLACE_CLIENT_SIDE(client, axis, which, isSelf) \
+ if (PlaceClientSide(client, axis, which, isSelf) == TCL_ERROR) { \
+ return TCL_ERROR; \
+ }
+
+/*
+ * Information about the Form geometry manager.
+ */
+static Tk_GeomMgr formType = {
+ "tixForm", /* name */
+ TixFm_ReqProc, /* requestProc */
+ TixFm_LostSlaveProc, /* lostSlaveProc */
+};
+
+/*
+ * Hash table used to map from Tk_Window tokens to corresponding
+ * FormInfo structures:
+ */
+static Tcl_HashTable formInfoHashTable;
+static Tcl_HashTable masterInfoHashTable;
+
+/*
+ * Have static variables in this module been initialized?
+ */
+static initialized = 0;
+
+static int ReqSize(tkwin, axis)
+ Tk_Window tkwin;
+ int axis;
+{
+ if (axis == AXIS_X) {
+ return Tk_ReqWidth(tkwin);
+ } else {
+ return Tk_ReqHeight(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tix_FormCmd --
+ *
+ * This procedure is invoked to process the "tixForm" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Tix_FormCmd(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. */
+{
+ static Tix_SubCmdInfo subCmdInfo[] = {
+ {TIX_DEFAULT_LEN, "check", 1, 1, TixFm_Check,
+ "master",},
+ {TIX_DEFAULT_LEN, "configure", 1, TIX_VAR_ARGS, TixFm_SetClient,
+ "slave ?-flag value ...?",},
+ {TIX_DEFAULT_LEN, "forget", 1, TIX_VAR_ARGS, TixFm_Forget,
+ "slave ?slave ...?",},
+ {TIX_DEFAULT_LEN, "grid", 1, TIX_VAR_ARGS, TixFm_SetGrid,
+ "master ?x_grids y_grids?"},
+ {TIX_DEFAULT_LEN, "info", 1, 2, TixFm_Info,
+ "slave ?-flag?",},
+ {TIX_DEFAULT_LEN, "slaves", 1, 1, TixFm_Slaves,
+ "master",},
+ {TIX_DEFAULT_LEN, "spring", 3, 3, TixFm_Spring,
+ "slave side strength",},
+ {TIX_DEFAULT_LEN, TIX_DEFAULT_SUBCMD, 0, 0, TixFm_SetClient, 0,
+ TixFm_CheckArgv,}
+ };
+
+ static Tix_CmdInfo cmdInfo = {
+ Tix_ArraySize(subCmdInfo), 1, TIX_VAR_ARGS, "?option? arg ?arg ...?",
+ };
+
+ return Tix_HandleSubCmds(&cmdInfo, subCmdInfo, clientData,
+ interp, argc, argv);
+}
+
+/*----------------------------------------------------------------------
+ *
+ * TixFm_SetGrid --
+ *
+ * Sets some defaults for the master window
+ *
+ *----------------------------------------------------------------------
+ */
+static int TixFm_SetGrid(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. */
+{
+ char buff[100];
+ Tk_Window topLevel = (Tk_Window) clientData;
+ Tk_Window master;
+ MasterInfo* masterPtr;
+
+ master = Tk_NameToWindow(interp, argv[0], topLevel);
+
+ if (master == NULL) {
+ return TCL_ERROR;
+ } else {
+ masterPtr = GetMasterInfo(master, 1);
+ }
+
+ if (argc != 1 && argc != 3) {
+ Tcl_AppendResult(interp, "Wrong # of arguments, should be ",
+ "tixForm grid master ?x_grids y_grids?", NULL);
+ return TCL_ERROR;
+ }
+
+ if (argc == 1) {
+ sprintf(buff, "%d %d", masterPtr->grids[0], masterPtr->grids[1]);
+ Tcl_AppendResult(interp, buff, NULL);
+ }
+ else {
+ int x, y;
+ if (Tcl_GetInt(interp, argv[1], &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[2], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (x <=0 || y <=0) {
+ Tcl_AppendResult(interp, "Grid sizes must be positive integers",
+ NULL);
+ return TCL_ERROR;
+ }
+ masterPtr->grids[0] = x;
+ masterPtr->grids[1] = y;
+
+ ArrangeWhenIdle(masterPtr);
+ }
+
+ return TCL_OK;
+}
+/*----------------------------------------------------------------------
+ *
+ * TixFm_Forget --
+ *
+ * Sets some defaults for the master window
+ *
+ *----------------------------------------------------------------------
+ */
+static int TixFm_Forget(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. */
+{
+ FormInfo * clientPtr;
+ Tk_Window topLevel = (Tk_Window) clientData;
+ int i;
+
+ for (i=0; i<argc; i++) {
+ clientPtr = TixFm_FindClientPtrByName(interp, argv[i], topLevel);
+ if (clientPtr == NULL) {
+ return TCL_ERROR;
+ }
+ else {
+ TixFm_ForgetOneClient(clientPtr);
+ }
+ }
+
+ return TCL_OK;
+}
+
+void TixFm_ForgetOneClient(clientPtr)
+ FormInfo * clientPtr;
+{
+ if (clientPtr != NULL) {
+ Tk_DeleteEventHandler(clientPtr->tkwin, StructureNotifyMask,
+ TixFm_StructureProc, (ClientData) clientPtr);
+ Tk_ManageGeometry(clientPtr->tkwin, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ if (clientPtr->master->tkwin != Tk_Parent(clientPtr->tkwin)) {
+ Tk_UnmaintainGeometry(clientPtr->tkwin,
+ clientPtr->master->tkwin);
+ }
+ Tk_UnmapWindow(clientPtr->tkwin);
+ TixFm_Unlink(clientPtr);
+ }
+}
+
+/*----------------------------------------------------------------------
+ *
+ * TixFm_Slaves --
+ *
+ * retuen the pathnames of the clients of a master window
+ *
+ *----------------------------------------------------------------------
+ */
+static int TixFm_Slaves(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 topLevel = (Tk_Window) clientData;
+ Tk_Window master;
+ MasterInfo* masterPtr;
+ FormInfo * clientPtr;
+
+ master = Tk_NameToWindow(interp, argv[0], topLevel);
+
+ if (master == NULL) {
+ return TCL_ERROR;
+ } else {
+ masterPtr = GetMasterInfo(master, 0);
+ }
+
+ if (masterPtr == 0) {
+ Tcl_AppendResult(interp, "Window \"", argv[0],
+ "\" is not a tixForm master window", NULL);
+ return TCL_ERROR;
+ }
+
+ for (clientPtr = masterPtr->client; clientPtr; clientPtr=clientPtr->next) {
+ Tcl_AppendElement(interp, Tk_PathName(clientPtr->tkwin));
+ }
+ return TCL_OK;
+}
+/*----------------------------------------------------------------------
+ *
+ * TixFm_Spring --
+ *
+ * Sets the spring strength of a slave's attachment sides
+ *
+ *----------------------------------------------------------------------
+ */
+static int TixFm_Spring(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 topLevel = (Tk_Window) clientData;
+ Tk_Window tkwin;
+ FormInfo * clientPtr;
+ int strength;
+ int i, j;
+ size_t len;
+
+ if ((tkwin = Tk_NameToWindow(interp, argv[0], topLevel)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if ((clientPtr = TixFm_GetFormInfo(tkwin, 0)) == NULL) {
+ Tcl_AppendResult(interp, "Window \"", argv[0],
+ "\" is not managed by the tixForm manager", NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetInt(interp, argv[2], &strength) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ len = strlen(argv[1]);
+ if (strncmp(argv[1], "-top", len) == 0) {
+ i = 1; j = 0;
+ }
+ else if (strncmp(argv[1], "-bottom", len) == 0) {
+ i = 1; j = 1;
+ }
+ else if (strncmp(argv[1], "-left", len) == 0) {
+ i = 0; j = 0;
+ }
+ else if (strncmp(argv[1], "-right", len) == 0) {
+ i = 0; j = 1;
+ }
+ else {
+ Tcl_AppendResult(interp, "Unknown option \"", argv[1],
+ "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ clientPtr->spring[i][j] = strength;
+
+ if (clientPtr->attType[i][j] == ATT_OPPOSITE) {
+ FormInfo * oppo;
+
+ oppo = clientPtr->att[i][j].widget;
+ oppo->spring[i][!j] = strength;
+
+ if (strength != 0 && clientPtr->strWidget[i][j] == NULL) {
+ clientPtr->strWidget[i][j] = oppo;
+
+ if (oppo->strWidget[i][!j] != clientPtr) {
+ if (oppo->strWidget[i][!j] != NULL) {
+ oppo->strWidget[i][!j]->strWidget[i][j] = NULL;
+ oppo->strWidget[i][!j]->spring[i][j] = 0;
+ }
+ }
+ oppo->strWidget[i][!j] = clientPtr;
+ }
+ }
+
+ ArrangeWhenIdle(clientPtr->master);
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * TixFm_Check --
+ *
+ * Tests whether the master has circular reference.
+ *
+ *----------------------------------------------------------------------
+ */
+static int TixFm_Check(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. */
+{
+ MasterInfo * masterPtr;
+ Tk_Window topLevel = (Tk_Window) clientData;
+ Tk_Window master;
+
+ master = Tk_NameToWindow(interp, argv[0], topLevel);
+ if (master == NULL) {
+ return TCL_ERROR;
+ }
+
+ masterPtr = GetMasterInfo(master, 1);
+
+ if (TestAndArrange(masterPtr) == TCL_OK) {
+ /* OK: no circular dependency */
+ Tcl_AppendResult(interp, "0", NULL);
+ } else {
+ /* Bad: circular dependency */
+ Tcl_AppendResult(interp, "1", NULL);
+ }
+ return TCL_OK;
+}
+
+/* Check the arguments to the default subcommand: TixFm_SetClient()
+ */
+static int TixFm_CheckArgv(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. */
+{
+ if ((argc >=1) && (argv[0][0] != '.')) {
+ return 0; /* sorry, we expect a window name */
+ } else {
+ return 1;
+ }
+}
+
+
+static int TixFm_SetClient(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 topLevel = (Tk_Window) clientData;
+ Tk_Window client, master;
+ FormInfo * clientPtr;
+ MasterInfo * masterPtr;
+ char *pathName; /* path name of the client window */
+
+ if (argc < 1 || (((argc-1) %2) != 0)) {
+ Tcl_AppendResult(interp, "Wrong # of arguments, should be ",
+ "tixForm configure slave ?-flag value ...?", NULL);
+ return TCL_ERROR;
+ }
+ pathName = argv[0];
+ argc -=1;
+ argv +=1;
+
+ client = Tk_NameToWindow(interp, pathName, topLevel);
+
+ if (client == NULL) {
+ return TCL_ERROR;
+ } else if (Tk_IsTopLevel(client)) {
+ Tcl_AppendResult(interp, "can't put \"", pathName,
+ "\"in a form: it's a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ clientPtr = TixFm_GetFormInfo(client, 1);
+ }
+
+ /* Check if the first argument is "-in". If so,
+ * reset the master of this client
+ */
+ if (argc >= 2 && strcmp(argv[0], "-in")==0) {
+ if ((master=Tk_NameToWindow(interp, argv[1], topLevel)) == NULL) {
+ return TCL_ERROR;
+ }
+ argc -= 2;
+ argv += 2;
+ masterPtr = GetMasterInfo(master, 1);
+ }
+ else if (clientPtr->master == NULL) {
+ if ((master = Tk_Parent(client))==NULL) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetMasterInfo(master, 1);
+ }
+ else {
+ masterPtr =clientPtr->master;
+ }
+
+ if (clientPtr->master != masterPtr) {
+ if (clientPtr->master != NULL) {
+ /* Take clientPtr from old master */
+ Tk_ManageGeometry(clientPtr->tkwin, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ if (clientPtr->master->tkwin != Tk_Parent(clientPtr->tkwin)) {
+ Tk_UnmaintainGeometry(clientPtr->tkwin,
+ clientPtr->master->tkwin);
+ }
+ TixFm_UnlinkFromMaster(clientPtr);
+ }
+
+ /* attach the client to the master */
+ TixFm_AddToMaster(masterPtr, clientPtr);
+ }
+
+ if (argc > 0) {
+ if (TixFm_Configure(clientPtr, topLevel, interp, argc,
+ argv)==TCL_ERROR){
+ return TCL_ERROR;
+ }
+ }
+
+ ArrangeWhenIdle(clientPtr->master);
+
+ return TCL_OK;
+}
+
+
+/* The caller of this function needs to find out a pointer to a client
+ * that is already managed by tixForm.
+ */
+FormInfo * TixFm_FindClientPtrByName(interp, name, topLevel)
+ Tcl_Interp * interp;
+ char * name;
+ Tk_Window topLevel;
+{
+ Tk_Window tkwin;
+ FormInfo * clientPtr;
+
+ if ((tkwin = Tk_NameToWindow(interp, name, topLevel)) == NULL) {
+ return NULL;
+ }
+
+ if ((clientPtr = TixFm_GetFormInfo(tkwin, 0)) == NULL) {
+ Tcl_AppendResult(interp, "Window \"", name,
+ "\" is not managed by the tixForm manager", NULL);
+ return NULL;
+ }
+ return clientPtr;
+}
+
+
+static int TestAndArrange(masterPtr)
+ MasterInfo *masterPtr;
+{
+ FormInfo *clientPtr;
+ int i,j;
+
+ /*
+ * First mark all clients as unpinned, and clean the opposite flags,
+ * Check the attachment intergrity
+ */
+ for (clientPtr = masterPtr->client; clientPtr; clientPtr=clientPtr->next) {
+ if (clientPtr->tkwin != NULL) {
+ for (i=0; i<2; i++) {
+ for (j=0; j<2; j++) {
+ clientPtr->side[i][j].pcnt = 0;
+ clientPtr->side[i][j].disp = 0;
+ }
+ /* clear all flags */
+ clientPtr->sideFlags[i] = 0;
+ }
+ clientPtr->depend = 0;
+ CheckIntergrity(clientPtr);
+ }
+ }
+
+ /*
+ * Try to determine all the client's geometry
+ */
+ for (clientPtr = masterPtr->client; clientPtr; clientPtr=clientPtr->next) {
+ if (clientPtr->tkwin == NULL) { /* it was deleted */
+ continue;
+ }
+ for (i=0; i<2; i++) {
+ if ((clientPtr->sideFlags[i] & PINNED_ALL) != PINNED_ALL) {
+ if (PinnClient(clientPtr) == TCL_ERROR) {
+ /*
+ * Detected circular dependency
+ */
+ return TCL_ERROR;
+ }
+ break;
+ }
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * UnmapClient
+ *
+ * Unmap the client from the screen, using different methods according to
+ * the relationship between the client and slave.
+ */
+static void UnmapClient(clientPtr)
+ FormInfo *clientPtr;
+{
+ if (clientPtr->master->tkwin == Tk_Parent(clientPtr->tkwin)) {
+ Tk_UnmapWindow(clientPtr->tkwin);
+ }
+ else {
+ Tk_UnmaintainGeometry(clientPtr->tkwin, clientPtr->master->tkwin);
+ Tk_UnmapWindow(clientPtr->tkwin);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * MapClient
+ *
+ * Map the client to the screen, using different methods according to
+ * the relationship between the client and slave.
+ */
+static void MapClient(clientPtr, x, y, width, height)
+ FormInfo *clientPtr;
+ int x;
+ int y;
+ int width;
+ int height;
+{
+ if (clientPtr->master->tkwin == Tk_Parent(clientPtr->tkwin)) {
+ Tk_MoveResizeWindow(clientPtr->tkwin, x, y, width, height);
+ Tk_MapWindow(clientPtr->tkwin);
+ }
+ else {
+ Tk_MaintainGeometry(clientPtr->tkwin, clientPtr->master->tkwin,
+ x, y, width, height);
+ Tk_MapWindow(clientPtr->tkwin);
+ }
+}
+
+static void ArrangeWhenIdle(masterPtr)
+ MasterInfo * masterPtr;
+{
+ if (!(masterPtr->flags.repackPending || masterPtr->flags.isDeleted)) {
+ masterPtr->flags.repackPending = 1;
+ Tk_DoWhenIdle(ArrangeGeometry, (ClientData) masterPtr);
+ }
+}
+
+static void
+CancelArrangeWhenIdle(masterPtr)
+ MasterInfo * masterPtr;
+{
+ if (masterPtr->flags.repackPending) {
+ Tk_CancelIdleCall(ArrangeGeometry, (ClientData) masterPtr);
+ masterPtr->flags.repackPending = 0;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * ArrangeGeometry --
+ *
+ * The heart of the Form geometry manager: calculates the sizes of
+ * the clients and the master, then arrange the clients inside the
+ * master according to their attachments.
+ */
+static void ArrangeGeometry(clientData)
+ ClientData clientData; /* Structure describing parent whose clients
+ * are to be re-layed out. */
+{
+ MasterInfo *masterPtr;
+ FormInfo *clientPtr;
+ int i, j, coord[2][2];
+ int mSize[2]; /* Size of master */
+ int cSize[2]; /* Size of client */
+ int intBWidth; /* internal borderWidth of master */
+
+ TkWindow* winPtr;
+ masterPtr = (MasterInfo *) clientData;
+ winPtr = (TkWindow*)masterPtr->tkwin;
+
+ if (winPtr->flags & TK_ALREADY_DEAD) {
+ masterPtr->flags.repackPending = 0;
+ return;
+ }
+
+ if (masterPtr->flags.isDeleted) {
+ return;
+ }
+
+ if (masterPtr->numClients == 0) {
+ masterPtr->flags.repackPending = 0;
+ return;
+ }
+
+ if (TestAndArrange(masterPtr)) { /* Detected circular dependency */
+ fprintf(stderr, "circular dependency.\n");
+ masterPtr->flags.repackPending = 0;
+ return;
+ }
+
+ /*
+ * Try to determine the required size of the master
+ */
+ CalculateMasterSize(masterPtr);
+
+ /*
+ * If the requested size is not equal to the actual size of the master,
+ * we might have to ask TK to change the master's geometry
+ */
+
+ if ((masterPtr->reqSize[0] != Tk_ReqWidth(masterPtr->tkwin))
+ || (masterPtr->reqSize[1] != Tk_ReqHeight(masterPtr->tkwin))) {
+
+ if (masterPtr->numRequests++ > 50) {
+ fprintf(stderr,
+ "(TixForm) Error:Trying to use more than one geometry\n\
+ manager for the same master window.\n\
+ Giving up after 50 iterations.\n");
+ } else {
+ masterPtr->flags.repackPending = 0;
+ Tk_GeometryRequest(masterPtr->tkwin,
+ masterPtr->reqSize[0], masterPtr->reqSize[1]);
+
+ ArrangeWhenIdle(masterPtr);
+ return;
+ }
+ }
+
+ masterPtr->numRequests = 0;
+
+ if (!Tk_IsMapped(masterPtr->tkwin)) {
+ goto done;
+ }
+
+ intBWidth = Tk_InternalBorderWidth(masterPtr->tkwin);
+ mSize[0] = Tk_Width(masterPtr->tkwin) - 2*intBWidth;
+ mSize[1] = Tk_Height(masterPtr->tkwin) - 2*intBWidth;
+
+ if (mSize[0] < 1 || mSize[1] <1) {
+ /* Master is not visible. Don't bother to place the clients
+ */
+ masterPtr->flags.repackPending = 0;
+ return;
+ }
+
+ /*
+ * Now set all the client's geometry
+ */
+ if (PlaceAllClients(masterPtr) != TCL_OK) {
+ panic("circular dependency");
+ }
+
+ for (clientPtr = masterPtr->client; clientPtr; clientPtr=clientPtr->next) {
+ if (clientPtr->tkwin == NULL) {
+ continue;
+ }
+ for (i=0; i<2; i++) {
+ for (j=0; j<2; j++) {
+ coord[i][j] = clientPtr->posn[i][j];
+ if (j == 1) {
+ coord[i][j] -= 1;
+ }
+ }
+ cSize[i] = coord[i][1] - coord[i][0]
+ - clientPtr->pad[i][0] - clientPtr->pad[i][1] + 1;
+ }
+
+ if ((cSize[0] <= 0) || (cSize[1] <= 0)) {
+ /*
+ * Window is too small, don't even bother to map
+ */
+ UnmapClient(clientPtr);
+ } else if ((coord[0][1] < 0) || (coord[1][1] < 0)) {
+ /*
+ * Window is outside of the master (left or top)
+ */
+ UnmapClient(clientPtr);
+ } else if ((coord[0][0] > mSize[0]) || (coord[1][0] > mSize[1])) {
+ /*
+ * Window is outside of the master (bottom or right)
+ */
+ UnmapClient(clientPtr);
+ } else {
+ /*
+ * Window is visible, then map it
+ */
+ MapClient(clientPtr,
+ coord[0][0] + clientPtr->pad[0][0] + intBWidth,
+ coord[1][0] + clientPtr->pad[1][0] + intBWidth,
+ cSize[0], cSize[1]);
+ }
+ }
+
+ done:
+ masterPtr->flags.repackPending = 0;
+}
+
+static int
+PinnSide_AttNone(clientPtr, axis, which)
+ FormInfo *clientPtr; /* The client to pinn down */
+ int axis; /* 0 = x axis, 1 = yaxis */
+ int which; /* 0 = min side, 1= max side */
+{
+ int reqSize;
+
+ if (clientPtr->attType[axis][NEXT_SIDE(which)] == ATT_NONE) {
+ if (which == SIDE0) {
+ clientPtr->side[axis][which].pcnt = 0;
+ clientPtr->side[axis][which].disp = 0;
+ return TCL_OK;
+ }
+ }
+
+ reqSize = ReqSize(clientPtr->tkwin, axis) +
+ clientPtr->pad[axis][0] + clientPtr->pad[axis][1];
+
+ PINN_CLIENT_SIDE(clientPtr, axis, NEXT_SIDE(which), 1);
+
+ clientPtr->side[axis][which].pcnt =
+ clientPtr->side[axis][NEXT_SIDE(which)].pcnt;
+
+ switch (which) {
+ case SIDE0:
+ clientPtr->side[axis][which].disp =
+ clientPtr->side[axis][NEXT_SIDE(which)].disp - reqSize;
+ break;
+
+ case SIDE1:
+ clientPtr->side[axis][which].disp =
+ clientPtr->side[axis][NEXT_SIDE(which)].disp + reqSize;
+ break;
+ }
+
+ return TCL_OK;
+}
+
+static int
+PinnSide_AttPercent(clientPtr, axis, which)
+ FormInfo *clientPtr; /* The client to pinn down */
+ int axis; /* 0 = x axis, 1 = yaxis */
+ int which; /* 0 = min side, 1= max side */
+{
+ clientPtr->side[axis][which].pcnt = clientPtr->att[axis][which].grid;
+ clientPtr->side[axis][which].disp = clientPtr->off[axis][which];
+
+ return TCL_OK;
+}
+
+static int
+PinnSide_AttOpposite(clientPtr, axis, which)
+ FormInfo *clientPtr; /* The client to pinn down */
+ int axis; /* 0 = x axis, 1 = yaxis */
+ int which; /* 0 = min side, 1= max side */
+{
+ FormInfo * attachPtr;
+
+ attachPtr = clientPtr->att[axis][which].widget;
+
+ PINN_CLIENT_SIDE(attachPtr, axis, NEXT_SIDE(which), 0);
+
+ clientPtr->side[axis][which].pcnt =
+ attachPtr->side[axis][NEXT_SIDE(which)].pcnt;
+ clientPtr->side[axis][which].disp =
+ attachPtr->side[axis][NEXT_SIDE(which)].disp +
+ clientPtr->off[axis][which];
+
+ return TCL_OK;
+}
+
+static int
+PinnSide_AttParallel(clientPtr, axis, which)
+ FormInfo *clientPtr; /* The client to pinn down */
+ int axis; /* 0 = x axis, 1 = yaxis */
+ int which; /* 0 = min side, 1= max side */
+{
+ FormInfo * attachPtr;
+
+ attachPtr = clientPtr->att[axis][which].widget;
+
+ PINN_CLIENT_SIDE(attachPtr, axis, which, 0);
+
+ clientPtr->side[axis][which].pcnt =
+ attachPtr->side[axis][which].pcnt;
+ clientPtr->side[axis][which].disp =
+ attachPtr->side[axis][which].disp +
+ clientPtr->off[axis][which];
+
+ return TCL_OK;
+}
+
+
+static int PinnClientSide(clientPtr, axis, which, isSelf)
+ FormInfo *clientPtr; /* The client to pinn down */
+ int axis; /* 0 = x axis, 1 = yaxis */
+ int which; /* 0 = min side, 1= max side */
+ int isSelf;
+{
+ if ((which == SIDE0) && (clientPtr->sideFlags[axis] & PINNED_SIDE0)) {
+ /* already pinned */
+ return TCL_OK;
+ }
+ if ((which == SIDE1) && (clientPtr->sideFlags[axis] & PINNED_SIDE1)) {
+ /* already pinned */
+ return TCL_OK;
+ }
+
+ if ((clientPtr->depend > 0) && !isSelf) {
+ /*
+ * circular dependency detected
+ */
+ return TCL_ERROR;
+ }
+ clientPtr->depend ++;
+
+ switch (clientPtr->attType[axis][which]) {
+ case ATT_NONE:
+ if (PinnSide_AttNone(clientPtr, axis, which) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ break;
+
+ case ATT_OPPOSITE:
+ if (PinnSide_AttOpposite(clientPtr, axis, which) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ break;
+
+ case ATT_PARALLEL:
+ if (PinnSide_AttParallel(clientPtr, axis, which) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ break;
+
+ case ATT_GRID:
+ if (PinnSide_AttPercent(clientPtr, axis, which) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ break;
+ }
+
+ if (which == SIDE0) {
+ clientPtr->sideFlags[axis] |= PINNED_SIDE0;
+ } else {
+ clientPtr->sideFlags[axis] |= PINNED_SIDE1;
+ }
+ clientPtr->depend --;
+
+ return TCL_OK;
+}
+
+static int PinnClient(clientPtr)
+ FormInfo *clientPtr;
+{
+ int i;
+
+ for (i=0; i<2; i++) {
+ if (!(clientPtr->sideFlags[i] & PINNED_SIDE0)) {
+ PINN_CLIENT_SIDE(clientPtr, i, SIDE0, 0);
+ }
+ if (!(clientPtr->sideFlags[i] & PINNED_SIDE1)) {
+ PINN_CLIENT_SIDE(clientPtr, i, SIDE1, 0);
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CalculateMasterSize --
+ *
+ * This internal procedure is used to find out the required
+ * size of a master window.
+ *
+ * Results:
+ * The return value is a pointer to the FormInfo structure
+ * corresponding to tkwin.
+ *
+ * Side effects:
+ * the reqSize[2] values in masterPtr is updated.
+ *
+ *--------------------------------------------------------------
+ */
+static void CalculateMasterSize(masterPtr)
+ MasterInfo *masterPtr;
+{
+ FormInfo *clientPtr;
+ int i, cSize[2];
+ int req[2];
+ int intBWidth;
+
+ /* Information about the master window */
+ intBWidth = Tk_InternalBorderWidth(masterPtr->tkwin);
+ req[0] = req[1] = 2*intBWidth;
+
+ for (clientPtr = masterPtr->client; clientPtr; clientPtr=clientPtr->next) {
+ if (clientPtr->tkwin == NULL) {
+ continue;
+ }
+ cSize[0] = Tk_ReqWidth(clientPtr->tkwin);
+ cSize[1] = Tk_ReqHeight(clientPtr->tkwin);
+ cSize[0] += clientPtr->pad[0][0]+clientPtr->pad[0][1];
+ cSize[1] += clientPtr->pad[1][0]+clientPtr->pad[1][1];
+
+ for (i=0; i<2; i++) {
+ /* The required size of the master depends on
+ * (1) natural sizes of the clients
+ * (2) perc anchor points of the clients
+ * Ideally, the master must include as much visible parts
+ * of the clients as possible. It should also have a size
+ * big enough so that all the clients' requested (natural)
+ * sizes are satisfied. The algorithm is fairly simple, but
+ * it took me quite a while to figure out and it quite difficult
+ * to explain here. Please look at the following in-line
+ * examples.
+ */
+ int p0 = clientPtr->side[i][0].pcnt;
+ int p1 = clientPtr->side[i][1].pcnt;
+ int d0 = clientPtr->side[i][0].disp;
+ int d1 = clientPtr->side[i][1].disp;
+
+ int req0 = 0;
+ int req1 = 0;
+ int reqx = 0;
+
+ if (d0 < 0 && p0 != 0) {
+ req0 = -d0 * masterPtr->grids[i] / p0;
+ }
+ if (d1 > 0 && p1 != masterPtr->grids[i]) {
+ req1 = d1 * masterPtr->grids[i] / (masterPtr->grids[i] - p1);
+ }
+
+ if (p0 == p1) {
+ /* case 1 */
+ /* Example: p0 = p1 = 10%; d0 = -10, d1 = 10
+ * then mSize should at least be 100 pixels so that
+ * side 0 can be visible. They are calculated in the
+ * previous two if statements
+ * result:
+ * size = 100
+ * side0 = 0;
+ * side1 = 20;
+ */
+
+ /* Two sides are attached to the same perc anchor point */
+ if (d0 >= d1) {
+ /* widget invisible */
+ req0 = req1 = 0;
+ }
+ }
+ else if (p0 < p1) {
+ /* case 2 */
+ /* Example: p0 10%, p2 = 20%; cSize = 35, d0 = -5, d1 = 0
+ * then mSize should at least be 300 pixels so that
+ * cSize can be satisfied.
+ * result:
+ * size = 300
+ * side0 = 25;
+ * side1 = 60;
+ */
+ int x = cSize[i];
+ if (p0 != 0 || d0 > 0) {
+ x += d0;
+ }
+ if (p1 != masterPtr->grids[i] || d1 < 0) {
+ x += -d1;
+ }
+ if (x > 0) {
+ reqx = x * masterPtr->grids[i] / (p1 - p0);
+ }
+ }
+ else {
+ /* case 2 */
+ /* This is very similar to case 1, except there are more cases
+ * in which the widget becomes invisible
+ */
+ if (d0 >=0 || d1 <=0) {
+ /* widget invisible */
+ req0 = req1 = 0;
+ }
+ }
+
+ if (req[i] < req0) {
+ req[i] = req0;
+ }
+ if (req[i] < req1) {
+ req[i] = req1;
+ }
+ if (req[i] < reqx) {
+ req[i] = reqx;
+ }
+ }
+ }
+
+ req[0] += 2*intBWidth;
+ req[1] += 2*intBWidth;
+
+ masterPtr->reqSize[0] = (req[0] > 0) ? req[0] : 1;
+ masterPtr->reqSize[1] = (req[1] > 0) ? req[1] : 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TixFm_StructureProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher in response
+ * to StructureNotify events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a window was just deleted, clean up all its packer-related
+ * information. If it was just resized, repack its clients, if
+ * any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TixFm_StructureProc(clientData, eventPtr)
+ ClientData clientData; /* Our information about window
+ * referred to by eventPtr. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ FormInfo *clientPtr = (FormInfo *) clientData;
+
+ switch (eventPtr->type) {
+ case ConfigureNotify:
+ ArrangeWhenIdle(clientPtr->master);
+ break;
+
+ case DestroyNotify:
+ if (clientPtr->master) {
+ TixFm_Unlink(clientPtr);
+ }
+ break;
+
+ case MapNotify:
+ break;
+
+ case UnmapNotify:
+ break;
+ }
+}
+
+static void
+TixFm_ReqProc(clientData, tkwin)
+ ClientData clientData; /* TixForm's information about
+ * window that got new preferred
+ * geometry. */
+ Tk_Window tkwin; /* Other Tk-related information
+ * about the window. */
+{
+ FormInfo *clientPtr = (FormInfo *) clientData;
+
+ if (clientPtr) {
+ ArrangeWhenIdle(clientPtr->master);
+ }
+}
+
+static void
+MasterStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Our information about window
+ * referred to by eventPtr. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ MasterInfo *masterPtr = (MasterInfo *) clientData;
+
+ switch (eventPtr->type) {
+ case ConfigureNotify:
+ if (masterPtr->numClients > 0) {
+ ArrangeWhenIdle(masterPtr);
+ }
+ break;
+
+ case DestroyNotify:
+ TixFm_DeleteMaster(masterPtr);
+ break;
+
+ case MapNotify:
+ break;
+
+ case UnmapNotify:
+ break;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TixFm_LostSlaveProc --
+ *
+ * This procedure is invoked by Tk whenever some other geometry
+ * claims control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all packer-related information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+TixFm_LostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* Form structure for slave window that
+ * was stolen away. */
+ Tk_Window tkwin; /* Tk's handle for the slave window. */
+{
+ FormInfo *clientPtr = (FormInfo *) clientData;
+
+ Tk_DeleteEventHandler(clientPtr->tkwin, StructureNotifyMask,
+ TixFm_StructureProc, (ClientData) clientPtr);
+ if (clientPtr->master->tkwin != Tk_Parent(clientPtr->tkwin)) {
+ Tk_UnmaintainGeometry(clientPtr->tkwin, clientPtr->master->tkwin);
+ }
+ Tk_UnmapWindow(clientPtr->tkwin);
+ TixFm_Unlink(clientPtr);
+}
+
+/*
+ * Do some basic integrity checking
+ * --> right, left cannot both attach to none
+ * --> top, bottom cannot both attach to none.
+ * Otherwise, top or left is always set to attach at {pixel 0}
+ */
+static void CheckIntergrity(clientPtr)
+ FormInfo * clientPtr;
+{
+#if 0
+ /* Check the X axis */
+ if ((clientPtr->attType[0][0] == ATT_NONE)
+ &&(clientPtr->attType[0][1] == ATT_NONE)) {
+ clientPtr->attType[0][0] = ATT_DEFAULT_PIXEL;
+ clientPtr->att[0][0].grid = 0;
+ }
+
+ /* Check the Y axis */
+ if ((clientPtr->attType[1][0] == ATT_NONE)
+ &&(clientPtr->attType[1][1] == ATT_NONE)) {
+ clientPtr->attType[1][0] = ATT_DEFAULT_PIXEL;
+ clientPtr->att[1][0].grid = 0;
+ }
+#endif
+}
+
+/*----------------------------------------------------------------------
+ * Memory management routines
+ *
+ *----------------------------------------------------------------------
+ */
+void TixFm_AddToMaster(masterPtr, clientPtr)
+ MasterInfo *masterPtr;
+ FormInfo *clientPtr;
+{
+ if (clientPtr->master == masterPtr) {
+ /* already in master */
+ return;
+ }
+
+ if (clientPtr->master != NULL) {
+ /* We have to migrate the widget to a different parent*/
+ }
+
+ clientPtr->master = masterPtr;
+
+ if (masterPtr->client == NULL) {
+ masterPtr->client = clientPtr;
+ masterPtr->client_tail = clientPtr;
+ } else {
+ masterPtr->client_tail->next = clientPtr;
+ }
+ clientPtr->next = NULL;
+ masterPtr->client_tail = clientPtr;
+
+ ++ masterPtr->numClients;
+
+ /* Manage its geometry using my proc */
+ Tk_ManageGeometry(clientPtr->tkwin, &formType, (ClientData)clientPtr);
+}
+
+void TixFm_UnlinkFromMaster(clientPtr)
+ FormInfo *clientPtr;
+{
+ MasterInfo *masterPtr;
+ FormInfo *ptr, *prev;
+
+#if DEBUG
+ fprintf(stderr, "unlinking %s\n", Tk_PathName(clientPtr->tkwin));
+#endif
+
+ masterPtr = clientPtr->master;
+
+ /* First: get rid of the reference of this widget from other clients */
+ for (ptr=masterPtr->client; ptr; ptr=ptr->next) {
+ if (ptr != clientPtr) {
+ int i, j;
+ for (i=0; i<2; i++) {
+ for (j=0; j<2; j++) {
+ switch (ptr->attType[i][j]) {
+ case ATT_OPPOSITE:
+ case ATT_PARALLEL:
+ if (ptr->att[i][j].widget == clientPtr) {
+ ptr->attType[i][j] = ATT_GRID;
+ ptr->att[i][j].grid = 0;
+ ptr->off[i][j] = ptr->posn[i][j];
+ }
+ break;
+ }
+ }
+ if (ptr->strWidget[i][j] == clientPtr) {
+ ptr->strWidget[i][j] = 0;
+ }
+ }
+ }
+ }
+
+ /* Second: delete this client from the list */
+ for (prev=ptr=masterPtr->client; ptr; prev=ptr,ptr=ptr->next) {
+ if (ptr == clientPtr) {
+ if (prev==ptr) {
+ if (masterPtr->numClients == 1) {
+ masterPtr->client_tail = NULL;
+ }
+ masterPtr->client = ptr->next;
+ }
+ else {
+ if (ptr->next == NULL) {
+ masterPtr->client_tail = prev;
+ }
+ prev->next = ptr->next;
+ }
+ break;
+ }
+ }
+ -- masterPtr->numClients;
+}
+
+void TixFm_FreeMasterInfo(clientData)
+ ClientData clientData;
+{
+ MasterInfo *masterPtr = (MasterInfo *)clientData;
+ ckfree((char*)masterPtr);
+}
+
+void TixFm_DeleteMaster(masterPtr)
+ MasterInfo *masterPtr;
+{
+ Tcl_HashEntry *hPtr;
+ FormInfo *clientPtr, * toFree;
+
+ if (masterPtr->flags.isDeleted) {
+ return;
+ }
+
+ Tk_DeleteEventHandler(masterPtr->tkwin, StructureNotifyMask,
+ MasterStructureProc, (ClientData) masterPtr);
+
+ clientPtr=masterPtr->client;
+ while(clientPtr) {
+ toFree = clientPtr;
+ clientPtr = clientPtr->next;
+ TixFm_ForgetOneClient(toFree);
+ }
+
+ hPtr = Tcl_FindHashEntry(&masterInfoHashTable,(char*)masterPtr->tkwin);
+ if (hPtr) {
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ CancelArrangeWhenIdle(masterPtr);
+ masterPtr->flags.isDeleted = 1;
+ Tk_EventuallyFree((ClientData)masterPtr,
+ (Tix_FreeProc*)TixFm_FreeMasterInfo);
+}
+
+
+void TixFm_Unlink(clientPtr)
+ FormInfo *clientPtr;
+{
+ Tcl_HashEntry *hPtr;
+ MasterInfo *masterPtr;
+
+ /* Delete this clientPtr from the master's list */
+ TixFm_UnlinkFromMaster(clientPtr);
+
+ /* Eventually free this clientPtr structure */
+ hPtr = Tcl_FindHashEntry(&formInfoHashTable,(char*)clientPtr->tkwin);
+ if (hPtr != NULL) {
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ clientPtr->tkwin = NULL;
+ masterPtr = clientPtr->master;
+ ckfree((char*)clientPtr);
+
+ ArrangeWhenIdle(masterPtr);
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TixFm_GetFormInfo --
+ *
+ * This internal procedure is used to locate a FormInfo
+ * structure for a given window, creating one if one
+ * doesn't exist already.
+ *
+ * Results:
+ * The return value is a pointer to the FormInfo structure
+ * corresponding to tkwin.
+ *
+ * Side effects:
+ * A new FormInfo structure may be created. If so, then
+ * a callback is set up to clean things up when the
+ * window is deleted.
+ *
+ *--------------------------------------------------------------
+ */
+FormInfo *
+TixFm_GetFormInfo(tkwin, create)
+ Tk_Window tkwin; /* Token for window for which
+ * FormInfo structure is desired. */
+ int create;
+{
+ FormInfo *clientPtr;
+ Tcl_HashEntry *hPtr;
+ int isNew;
+ int i,j;
+
+ if (!initialized) {
+ initialized = 1;
+ Tcl_InitHashTable(&formInfoHashTable, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(&masterInfoHashTable, TCL_ONE_WORD_KEYS);
+ }
+
+ /*
+ * See if there's already FormInfo for this window. If not,
+ * then create a new one.
+ */
+ if (!create) {
+ hPtr = Tcl_FindHashEntry(&formInfoHashTable, (char *)tkwin);
+ if (!hPtr) {
+ return NULL;
+ } else {
+ return (FormInfo *) Tcl_GetHashValue(hPtr);
+ }
+ } else {
+ hPtr = Tcl_CreateHashEntry(&formInfoHashTable, (char *) tkwin, &isNew);
+ if (!isNew) {
+ return (FormInfo *) Tcl_GetHashValue(hPtr);
+ } else {
+ clientPtr = (FormInfo *) ckalloc(sizeof(FormInfo));
+ clientPtr->tkwin = tkwin;
+ clientPtr->master = NULL;
+ clientPtr->next = NULL;
+
+ for (i=0; i< 2; i++) {
+ for (j=0; j< 2; j++) {
+ clientPtr->attType[i][j] = ATT_NONE;
+ clientPtr->att[i][j].grid = 0;
+ clientPtr->att[i][j].widget = NULL;
+ clientPtr->off[i][j] = 0;
+
+ clientPtr->pad[i][j] = 0;
+ clientPtr->side[i][j].pcnt = 0;
+ clientPtr->side[i][j].disp = 0;
+
+ clientPtr->spring[i][j] = -1;
+ clientPtr->strWidget[i][j] = 0;
+ }
+ clientPtr->springFail[i] = 0;
+ clientPtr->fill[i] = 0;
+ }
+
+ Tcl_SetHashValue(hPtr, clientPtr);
+
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ TixFm_StructureProc, (ClientData) clientPtr);
+
+ return clientPtr;
+ }
+ }
+}
+
+static MasterInfo *
+GetMasterInfo(tkwin, create)
+ Tk_Window tkwin; /* Token for window for which
+ * FormInfo structure is desired. */
+ int create; /* Should I create the MasterInfo if it
+ * does not exist? */
+{
+ MasterInfo *masterPtr;
+ Tcl_HashEntry *hPtr;
+ int isNew;
+
+ if (!initialized) {
+ initialized = 1;
+ Tcl_InitHashTable(&formInfoHashTable, TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(&masterInfoHashTable, TCL_ONE_WORD_KEYS);
+ }
+
+ /*
+ * See if there's already FormInfo for this window. If not,
+ * then create a new one.
+ */
+ if (!create) {
+ hPtr = Tcl_FindHashEntry(&masterInfoHashTable, (char *)tkwin);
+ if (!hPtr) {
+ return NULL;
+ } else {
+ return (MasterInfo *) Tcl_GetHashValue(hPtr);
+ }
+ } else {
+ hPtr = Tcl_CreateHashEntry(&masterInfoHashTable, (char *)tkwin,
+ &isNew);
+ if (!isNew) {
+ masterPtr = (MasterInfo *) Tcl_GetHashValue(hPtr);
+ }
+ else {
+ masterPtr = (MasterInfo *) ckalloc(sizeof(MasterInfo));
+ masterPtr->tkwin = tkwin;
+ masterPtr->client = NULL;
+ masterPtr->client_tail = NULL;
+ masterPtr->flags.repackPending = 0;
+ masterPtr->flags.isDeleted = 0;
+ masterPtr->numClients = 0;
+ masterPtr->numRequests = 0;
+ masterPtr->grids[0] = 100;
+ masterPtr->grids[1] = 100;
+
+ Tcl_SetHashValue(hPtr, masterPtr);
+ }
+ }
+
+ /* TK BUG:
+ *
+ * It seems like if you destroy some slaves TK will delete the event
+ * handler. So for sure we just create it every time a slave is created.
+ *
+ * Note: calling Tk_CreateEventHandler with same arguments twice won't
+ * create two instances of the same event handler: Thus safe to call
+ * blindly.
+ */
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ MasterStructureProc, (ClientData) masterPtr);
+#if 0
+ Tk_ManageGeometry(tkwin, (Tk_GeomMgr *)&masterType,
+ (ClientData) masterPtr);
+#endif
+ return masterPtr;
+}
+
+/*----------------------------------------------------------------------
+ * PLace the clients
+ *----------------------------------------------------------------------
+ */
+static int PlaceSide_AttNone(clientPtr, axis, which)
+ FormInfo *clientPtr; /* The client to Place down */
+ int axis; /* 0 = x axis, 1 = yaxis */
+ int which; /* 0 = min side, 1= max side */
+{
+ int reqSize;
+
+ if (clientPtr->attType[axis][NEXT_SIDE(which)] == ATT_NONE) {
+ if (which == SIDE0) {
+ clientPtr->posn[axis][which] = 0;
+ return TCL_OK;
+ }
+ }
+
+ reqSize = ReqSize(clientPtr->tkwin, axis) +
+ clientPtr->pad[axis][0] + clientPtr->pad[axis][1];
+
+
+ PLACE_CLIENT_SIDE(clientPtr, axis, NEXT_SIDE(which), 1);
+
+ switch (which) {
+ case SIDE0:
+ clientPtr->posn[axis][which] =
+ clientPtr->posn[axis][NEXT_SIDE(which)] - reqSize;
+ break;
+
+ case SIDE1:
+ clientPtr->posn[axis][which] =
+ clientPtr->posn[axis][NEXT_SIDE(which)] + reqSize;
+ break;
+ }
+
+ return TCL_OK;
+}
+
+static int PlaceSide_AttAbsolute(clientPtr, axis, which)
+ FormInfo *clientPtr; /* The client to Place down */
+ int axis; /* 0 = x axis, 1 = yaxis */
+ int which; /* 0 = min side, 1= max side */
+{
+ int mSize[2];
+ MasterInfo * masterPtr = clientPtr->master;
+ int intBWidth = Tk_InternalBorderWidth(masterPtr->tkwin);
+ mSize[0] = Tk_Width(masterPtr->tkwin) - 2*intBWidth;
+ mSize[1] = Tk_Height(masterPtr->tkwin) - 2*intBWidth;
+
+ clientPtr->posn[axis][which] =
+ mSize[axis] * clientPtr->side[axis][which].pcnt/masterPtr->grids[axis] +
+ clientPtr->side[axis][which].disp;
+
+ return TCL_OK;
+}
+
+static int PlaceSide_AttOpposite(clientPtr, axis, which)
+ FormInfo *clientPtr; /* The client to Place down */
+ int axis; /* 0 = x axis, 1 = yaxis */
+ int which; /* 0 = min side, 1= max side */
+{
+ FormInfo * attachPtr;
+
+ attachPtr = clientPtr->att[axis][which].widget;
+
+ PLACE_CLIENT_SIDE(attachPtr, axis, NEXT_SIDE(which), 0);
+
+ clientPtr->posn[axis][which] = attachPtr->posn[axis][NEXT_SIDE(which)];
+ clientPtr->posn[axis][which] += clientPtr->off[axis][which];
+ return TCL_OK;
+}
+
+static int PlaceSide_AttParallel(clientPtr, axis, which)
+ FormInfo *clientPtr; /* The client to Place down */
+ int axis; /* 0 = x axis, 1 = yaxis */
+ int which; /* 0 = min side, 1= max side */
+{
+ FormInfo * attachPtr;
+
+ attachPtr = clientPtr->att[axis][which].widget;
+
+ PLACE_CLIENT_SIDE(attachPtr, axis, NEXT_SIDE(which), 0);
+
+ clientPtr->posn[axis][which] = attachPtr->posn[axis][which];
+ clientPtr->posn[axis][which] += clientPtr->off[axis][which];
+
+ return TCL_OK;
+}
+
+
+static int PlaceSimpleCase(clientPtr, axis, which)
+ FormInfo *clientPtr; /* The client to Place down */
+ int axis; /* 0 = x axis, 1 = yaxis */
+ int which; /* 0 = min side, 1= max side */
+{
+ clientPtr->depend ++;
+
+ switch (clientPtr->attType[axis][which]) {
+ case ATT_NONE:
+ if (PlaceSide_AttNone(clientPtr, axis, which) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ break;
+
+ case ATT_GRID:
+ if (PlaceSide_AttAbsolute(clientPtr, axis, which) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ break;
+
+ case ATT_OPPOSITE:
+ if (PlaceSide_AttOpposite(clientPtr, axis, which) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ break;
+ case ATT_PARALLEL:
+ if (PlaceSide_AttParallel(clientPtr, axis, which) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ break;
+ }
+
+ if (which == SIDE0) {
+ clientPtr->sideFlags[axis] |= PINNED_SIDE0;
+ } else {
+ clientPtr->sideFlags[axis] |= PINNED_SIDE1;
+ }
+ clientPtr->depend --;
+
+ return TCL_OK;
+}
+
+/* ToDo: I'll make this more efficient by pre-allocating some links */
+static SpringLink *
+AllocSpringLink()
+{
+ return (SpringLink *) ckalloc(sizeof(SpringLink));
+}
+
+static void
+FreeSpringLink(link)
+ SpringLink * link;
+{
+ ckfree((char*)link);
+}
+
+static void FreeSpringList(listPtr)
+ SpringList * listPtr;
+{
+ SpringLink * link, * toFree;
+
+ for (link=listPtr->head; link; ) {
+ toFree = link;
+ link=link->next;
+ FreeSpringLink(toFree);
+ }
+}
+
+static void
+AddRightSprings(listPtr, clientPtr)
+ SpringList * listPtr;
+ FormInfo *clientPtr;
+{
+ SpringLink * link = AllocSpringLink();
+
+ link->next = NULL;
+ link->clientPtr = clientPtr;
+
+ if (listPtr->head == NULL) {
+ listPtr->head = listPtr->tail = link;
+ } else {
+ listPtr->tail->next = link;
+ listPtr->tail = link;
+ }
+ ++ listPtr->num;
+}
+
+static void
+AddLeftSprings(listPtr,clientPtr)
+ SpringList * listPtr;
+ FormInfo *clientPtr;
+{
+ SpringLink * link = AllocSpringLink();
+
+ link->next = listPtr->head;
+ link->clientPtr = clientPtr;
+
+ listPtr->head = link;
+ ++ listPtr->num;
+}
+
+static int
+PlaceWithSpring(clientPtr, axis, which)
+ FormInfo *clientPtr; /* The client to Place down */
+ int axis; /* 0 = x axis, 1 = yaxis */
+ int which; /* 0 = min side, 1= max side */
+{
+ SpringList springs;
+ SpringLink * link;
+ FormInfo *ptr;
+ float boundary[2];
+ float totalSize, totalStrength;
+ int mSize[2];
+ float gap, disp;
+ MasterInfo * masterPtr = clientPtr->master;
+ int intBWidth = Tk_InternalBorderWidth(masterPtr->tkwin);
+
+ springs.head = (SpringLink *)0;
+ springs.tail = (SpringLink *)0;
+ springs.num = 0;
+
+ mSize[0] = Tk_Width(masterPtr->tkwin) - 2*intBWidth;
+ mSize[1] = Tk_Height(masterPtr->tkwin) - 2*intBWidth;
+
+ /* Expand the right side of the spring list */
+ ptr = clientPtr;
+ while (1) {
+ switch (ptr->attType[axis][1]) {
+ case ATT_OPPOSITE:
+ case ATT_NONE:
+ /* Some attachments */
+ AddRightSprings(&springs, ptr);
+
+ if ((ptr = ptr->strWidget[axis][1]) == 0) {
+ goto done1;
+ }
+
+ switch (ptr->attType[axis][0]) {
+ case ATT_GRID:
+ case ATT_PARALLEL:
+ goto done1;
+ }
+ break;
+
+ case ATT_GRID:
+ case ATT_PARALLEL:
+ AddRightSprings(&springs, ptr);
+ goto done1;
+ }
+ }
+
+ done1:
+ /* Expand the left side of the spring list */
+
+ ptr = clientPtr;
+ while (2) {
+ switch (ptr->attType[axis][0]) {
+ case ATT_OPPOSITE:
+ case ATT_NONE:
+ /* Some attachments */
+ if (ptr != clientPtr) {
+ AddLeftSprings(&springs, ptr);
+ }
+
+ if ((ptr = ptr->strWidget[axis][0]) == 0) {
+ goto done2;
+ }
+
+ switch (ptr->attType[axis][1]) {
+ case ATT_PARALLEL:
+ goto done2;
+ }
+ break;
+
+ case ATT_GRID:
+ case ATT_PARALLEL:
+ if (ptr != clientPtr) {
+ AddLeftSprings(&springs, ptr);
+ }
+
+ goto done2;
+ }
+ }
+
+ done2:
+
+ /* Make sure this is a good list (neither ends are none) */
+ if (springs.head == NULL) {
+ /* this should never happen, just to make sure */
+ goto fail;
+ }
+ if (springs.head->clientPtr->attType[axis][0] == ATT_NONE) {
+ goto fail;
+ }
+ if (springs.tail->clientPtr->attType[axis][1] == ATT_NONE) {
+ goto fail;
+ }
+
+ /*
+ * Now calculate the total requested sizes of the spring group
+ */
+ totalSize = (float)(0.0);
+ totalStrength = (float)(0.0);
+ for (link=springs.head; link; link=link->next) {
+ int size = ReqSize(link->clientPtr->tkwin, axis);
+
+ totalSize += size + link->clientPtr->pad[axis][0] +
+ link->clientPtr->pad[axis][1];
+
+ if (link->clientPtr->spring[axis][0] > 0) {
+ totalStrength += link->clientPtr->spring[axis][0];
+ }
+ }
+ if (springs.tail->clientPtr->spring[axis][1] > 0) {
+ totalStrength += springs.tail->clientPtr->spring[axis][1];
+ }
+
+ boundary[0] = (float) mSize[axis] *
+ (float) springs.head->clientPtr->side[axis][0].pcnt /
+ (float) masterPtr->grids[axis] +
+ (float) springs.head->clientPtr->side[axis][0].disp;
+ boundary[1] = (float) mSize[axis] *
+ (float) springs.tail->clientPtr->side[axis][1].pcnt /
+ (float) masterPtr->grids[axis] +
+ (float) springs.tail->clientPtr->side[axis][1].disp;
+
+ /* (4) Now spread the sizes to the members of this list */
+ gap = (float)(boundary[1] - boundary[0]) - totalSize;
+ if (gap < 0) {
+ goto fail;
+ }
+
+ disp = boundary[0];
+ if (totalStrength <= 0.0) {
+ totalStrength = (float)(1.0);
+ }
+ for (link=springs.head; link; link=link->next) {
+ float spring0, spring1;
+ int gap0, gap1;
+ int adjust; /* to overcome round-off errors */
+
+ spring0 = (float)link->clientPtr->spring[axis][0];
+ spring1 = (float)link->clientPtr->spring[axis][1];
+
+ if (spring0 < (float)(0.0)) {
+ spring0 = (float)(0.0);
+ }
+ if (spring1 < (float)(0.0)) {
+ spring1 = (float)(0.0);
+ }
+
+ /* Divide by two: because two consecutive clients share the same
+ * spring; so each of them get a half.
+ */
+ adjust = 0;
+ if (link !=springs.head) {
+ if (spring0 > 0 && link->clientPtr->spring[axis][0] % 2 == 1) {
+ adjust = 1;
+ }
+ spring0 /= (float)(2.0);
+ }
+ if (link !=springs.tail) {
+ spring1 /= (float)(2.0);
+ }
+
+ gap0 = (int)(gap * spring0 / totalStrength) + adjust;
+ gap1 = (int)(gap * spring1 / totalStrength);
+
+ if (link->clientPtr->fill[axis]) {
+ link->clientPtr->posn[axis][0] = (int)disp;
+ disp += gap0;
+ disp += gap1;
+ disp += ReqSize(link->clientPtr->tkwin, axis);
+
+ /* Somehow there may be a round-off right at the end of the
+ * list --> kludge*/
+ if (link->next == NULL) {
+ disp = boundary[1];
+ }
+ link->clientPtr->posn[axis][1] = (int)disp;
+ } else {
+ disp += gap0;
+ link->clientPtr->posn[axis][0] = (int)disp;
+ disp += ReqSize(link->clientPtr->tkwin, axis);
+ link->clientPtr->posn[axis][1] = (int)disp;
+ disp += gap1;
+
+ /*
+ * Somehow there may be a round-off right at the end of the
+ * list --> kludge
+ */
+ if (link->next == NULL && gap1 < 0.001) {
+ link->clientPtr->posn[axis][1] = (int)boundary[1];
+ }
+ }
+
+ link->clientPtr->sideFlags[axis] |= PINNED_SIDE0;
+ link->clientPtr->sideFlags[axis] |= PINNED_SIDE1;
+ }
+
+ FreeSpringList(&springs);
+ return TCL_OK;
+
+ fail:
+ for (link=springs.head; link; link=link->next) {
+ link->clientPtr->springFail[axis] = 1;
+ }
+ FreeSpringList(&springs);
+ return TCL_ERROR;
+}
+
+static int PlaceClientSide(clientPtr, axis, which, isSelf)
+ FormInfo *clientPtr; /* The client to Place down */
+ int axis; /* 0 = x axis, 1 = yaxis */
+ int which; /* 0 = min side, 1= max side */
+ int isSelf;
+{
+ if ((which == SIDE0) && (clientPtr->sideFlags[axis] & PINNED_SIDE0)) {
+ /* already Placeed */
+ return TCL_OK;
+ }
+ if ((which == SIDE1) && (clientPtr->sideFlags[axis] & PINNED_SIDE1)) {
+ /* already Placeed */
+ return TCL_OK;
+ }
+
+ if ((clientPtr->depend > 0) && !isSelf) {
+ /*
+ * circular dependency detected
+ */
+ return TCL_ERROR;
+ }
+
+ /* No spring : we just do a "simple case"
+ * The condition is ( (x || x) && (x || x) )
+ */
+ if ((clientPtr->spring[axis][0] < 0 ||
+ (clientPtr->sideFlags[axis] & PINNED_SIDE0)) &&
+ (clientPtr->spring[axis][1] < 0 ||
+ (clientPtr->sideFlags[axis] & PINNED_SIDE1))) {
+ return PlaceSimpleCase(clientPtr, axis, which);
+ }
+ if (clientPtr->springFail[axis]) {
+ return PlaceSimpleCase(clientPtr, axis, which);
+ }
+
+ if (PlaceWithSpring(clientPtr, axis, which) != TCL_OK) {
+ /* if comes to here : (1) Not enough space for the spring expansion
+ * (2) Not both end-sides are spring-attached */
+ return PlaceSimpleCase(clientPtr, axis, which);
+ } else {
+ return TCL_OK;
+ }
+}
+
+static int PlaceClient(clientPtr)
+ FormInfo *clientPtr;
+{
+ int i;
+
+ for (i=0; i<2; i++) {
+ if (!(clientPtr->sideFlags[i] & PINNED_SIDE0)) {
+ PLACE_CLIENT_SIDE(clientPtr, i, SIDE0, 0);
+ }
+ if (!(clientPtr->sideFlags[i] & PINNED_SIDE1)) {
+ PLACE_CLIENT_SIDE(clientPtr, i, SIDE1, 0);
+ }
+ }
+
+ return TCL_OK;
+}
+
+static int PlaceAllClients(masterPtr)
+ MasterInfo * masterPtr;
+{
+ FormInfo *clientPtr;
+ int i;
+
+ /*
+ * First mark all clients as unpinned, and clean the opposite flags,
+ */
+ for (clientPtr = masterPtr->client; clientPtr; clientPtr=clientPtr->next) {
+ if (clientPtr->tkwin != NULL) {
+ for (i=0; i<2; i++) {
+ /* clear all flags */
+ clientPtr->sideFlags[i] = 0;
+ clientPtr->springFail[i] = 0;
+ }
+ clientPtr->depend = 0;
+ }
+ }
+
+ /*
+ * Now calculate their actual positions on the master
+ */
+ for (clientPtr = masterPtr->client; clientPtr; clientPtr=clientPtr->next) {
+ if (clientPtr->tkwin == NULL) { /* it was deleted */
+ continue;
+ }
+ for (i=0; i<2; i++) {
+ if ((clientPtr->sideFlags[i] & PINNED_ALL) != PINNED_ALL) {
+ if (PlaceClient(clientPtr) == TCL_ERROR) {
+ /*
+ * Detected circular dependency
+ */
+ return TCL_ERROR;
+ }
+ break;
+ }
+ }
+ }
+ return TCL_OK;
+}
diff --git a/tix/generic/tixForm.h b/tix/generic/tixForm.h
new file mode 100644
index 00000000000..1573612f123
--- /dev/null
+++ b/tix/generic/tixForm.h
@@ -0,0 +1,149 @@
+/*
+ * tixForm.h --
+ *
+ * Declares the internal functions and data types for the Tix Form
+ * geometry manager.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#ifndef _TIX_FORM_H
+#define _TIX_FORM_H
+
+#define SIDE0 0
+#define SIDE1 1
+
+#define NEXT_SIDE(x) (!x)
+
+#define SIDEX 0
+#define SIDEY 1
+
+#define AXIS_X 0
+#define AXIS_Y 1
+
+#define OPPO_SIDE0 1
+#define OPPO_SIDE1 2
+#define OPPO_ALL 3
+
+#define PINNED_SIDE0 4
+#define PINNED_SIDE1 8
+#define PINNED_ALL 12
+
+#define ATT_NONE 0
+#define ATT_GRID 1
+#define ATT_OPPOSITE 2
+#define ATT_PARALLEL 3
+
+#ifdef BUILD_tix
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * The following structures carry information about the client windows
+ */
+typedef union {
+ int grid;
+ struct _FormInfo * widget;
+} Attachment;
+
+typedef struct {
+ int pcnt; /* percentage anchor point */
+ int disp; /* displacement from the percentage anchor point*/
+} Side;
+
+typedef struct _FormInfo {
+ Tk_Window tkwin;
+ struct _MasterInfo* master; /* The master of this window */
+ struct _FormInfo * next;
+
+ int depend; /* used to detect circular dependency*/
+
+ /* These are specified by the user and set by the "tixForm" command
+ */
+ Attachment att[2][2]; /* anchor of attachment */
+ int off[2][2]; /* offset of attachment */
+ char isDefault[2][2];/* Is this side a default attachment*/
+
+ char attType[2][2]; /* type of attachment
+ GRID or PIXEL*/
+ int pad[2][2]; /* value of padding */
+
+ /* These values are calculated by the PinnClient() functions
+ * and are used to calculated the required size of the master
+ * inside CalculateMasterGeometry(), as well as the positions
+ * of the clients inside ArrangeGeometry()
+ */
+ Side side[2][2];
+ int sideFlags[2];
+
+ /* These values are used to place the clients into the clients
+ */
+ int posn[2][2];
+
+ /* These things are for Spring'ing */
+ int spring[2][2];
+ struct _FormInfo * strWidget[2][2];
+ int springFail[2];
+ int fill[2];
+} FormInfo;
+
+
+/*
+ * The following structures carry information about the master windows
+ */
+typedef struct {
+ unsigned int isDeleted : 1;
+ unsigned int repackPending : 1;
+} MasterFlags;
+
+typedef struct _MasterInfo {
+ Tk_Window tkwin;
+ struct _FormInfo * client;
+ struct _FormInfo * client_tail;
+ int numClients;
+ int reqSize[2];
+ int numRequests; /* This is used to detect
+ * whether two geometry managers
+ * are used to manage the same
+ * master window
+ */
+ int grids[2];
+ MasterFlags flags;
+} MasterInfo;
+
+/* tixFormMisc.c */
+
+
+EXTERN int TixFm_Configure _ANSI_ARGS_((FormInfo *clientPtr,
+ Tk_Window topLevel,
+ Tcl_Interp* interp, int argc, char **argv));
+
+/* tixForm.c */
+EXTERN FormInfo * TixFm_GetFormInfo _ANSI_ARGS_((Tk_Window tkwin,
+ int create));
+EXTERN void TixFm_StructureProc _ANSI_ARGS_((ClientData clientData,
+ XEvent * eventPtr));
+EXTERN void TixFm_AddToMaster _ANSI_ARGS_((MasterInfo *masterPtr,
+ FormInfo *clientPtr));
+EXTERN void TixFm_DeleteMaster _ANSI_ARGS_((
+ MasterInfo *masterPtr));
+EXTERN void TixFm_FreeMasterInfo _ANSI_ARGS_((
+ ClientData clientData));
+EXTERN FormInfo * TixFm_FindClientPtrByName _ANSI_ARGS_((
+ Tcl_Interp * interp, char * name,
+ Tk_Window topLevel));
+EXTERN void TixFm_ForgetOneClient _ANSI_ARGS_((
+ FormInfo *clientPtr));
+EXTERN void TixFm_Unlink _ANSI_ARGS_((FormInfo *clientPtr));
+EXTERN void TixFm_UnlinkFromMaster _ANSI_ARGS_((
+ FormInfo *clientPtr));
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TIX_FORM_H */
diff --git a/tix/generic/tixFormMisc.c b/tix/generic/tixFormMisc.c
new file mode 100644
index 00000000000..cd71e917b7f
--- /dev/null
+++ b/tix/generic/tixFormMisc.c
@@ -0,0 +1,597 @@
+/*
+ * tixFormMisc.c --
+ *
+ * Implements the tixForm geometry manager, which has similar
+ * capability as the Motif Form geometry manager. Please
+ * refer to the documentation for the use of tixForm.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tix.h>
+#include <tixForm.h>
+
+/*
+ * SubCommands of the tixForm command.
+ */
+TIX_DECLARE_SUBCMD(TixFm_Info);
+
+static void AttachInfo _ANSI_ARGS_((Tcl_Interp * interp,
+ FormInfo * clientPtr, int axis, int which));
+static int ConfigureAttachment _ANSI_ARGS_((FormInfo *clientPtr,
+ Tk_Window topLevel, Tcl_Interp* interp,
+ int axis, int which, char *value));
+static int ConfigureFill _ANSI_ARGS_((
+ FormInfo *clientPtr, Tk_Window tkwin,
+ Tcl_Interp* interp, char *value));
+static int ConfigurePadding _ANSI_ARGS_((
+ FormInfo *clientPtr, Tk_Window tkwin,
+ Tcl_Interp* interp, int axis, int which,
+ char *value));
+static int ConfigureSpring _ANSI_ARGS_((FormInfo *clientPtr,
+ Tk_Window topLevel, Tcl_Interp* interp,
+ int axis, int which, char *value));
+
+
+/*----------------------------------------------------------------------
+ * TixFm_Info --
+ *
+ * Return the information about the attachment of a client window
+ *----------------------------------------------------------------------
+ */
+int TixFm_Info(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 topLevel = (Tk_Window) clientData;
+ FormInfo * clientPtr;
+ char buff[256];
+ int i,j;
+ static char *sideNames[2][2] = {
+ {"-left", "-right"},
+ {"-top", "-bottom"}
+ };
+ static char *padNames[2][2] = {
+ {"-padleft", "-padright"},
+ {"-padtop", "-padbottom"}
+ };
+
+ clientPtr = TixFm_FindClientPtrByName(interp, argv[0], topLevel);
+ if (clientPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (argc == 2) {
+ /* user wants some specific info
+ */
+
+ for (i=0; i<2; i++) {
+ for (j=0; j<2; j++) {
+ /* Do you want to know attachment? */
+ if (strcmp(argv[1], sideNames[i][j]) == 0) {
+ AttachInfo(interp, clientPtr, i, j);
+ return TCL_OK;
+ }
+
+ /* Do you want to know padding? */
+ if (strcmp(argv[1], padNames[i][j]) == 0) {
+ sprintf(buff, "%d", clientPtr->pad[i][j]);
+ Tcl_AppendResult(interp, buff, NULL);
+ return TCL_OK;
+ }
+ }
+ }
+ Tcl_AppendResult(interp, "Unknown option \"", argv[1], "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ /* Otherwise, give full info */
+
+ for (i=0; i<2; i++) {
+ for (j=0; j<2; j++) {
+ /* The information about attachment */
+ Tcl_AppendResult(interp, sideNames[i][j], " ", NULL);
+ AttachInfo(interp, clientPtr, i, j);
+
+ /* The information about padding */
+ Tcl_AppendResult(interp, padNames[i][j], " ", NULL);
+ sprintf(buff, "%d", clientPtr->pad[i][j]);
+ Tcl_AppendResult(interp, buff, " ", NULL);
+ }
+ }
+ return TCL_OK;
+}
+
+static void AttachInfo(interp, clientPtr, axis, which)
+ Tcl_Interp * interp;
+ FormInfo * clientPtr;
+ int axis;
+ int which;
+{
+ char buff[256];
+
+ switch(clientPtr->attType[axis][which]) {
+ case ATT_NONE:
+ Tcl_AppendElement(interp, "none");
+ break;
+
+ case ATT_GRID:
+ sprintf(buff, "{%%%d %d}", clientPtr->att[axis][which].grid,
+ clientPtr->off[axis][which]);
+ Tcl_AppendResult(interp, buff, " ", NULL);
+ break;
+
+ case ATT_OPPOSITE:
+ sprintf(buff, "%d", clientPtr->off[axis][which]);
+ Tcl_AppendResult(interp, "{",
+ Tk_PathName(clientPtr->att[axis][which].widget->tkwin),
+ " ", buff, "} ", NULL);
+ break;
+
+ case ATT_PARALLEL:
+ sprintf(buff, "%d", clientPtr->off[axis][which]);
+ Tcl_AppendResult(interp, "{&",
+ Tk_PathName(clientPtr->att[axis][which].widget->tkwin),
+ " ", buff, "} ", NULL);
+ break;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * Form Parameter Configuration
+ *
+ *----------------------------------------------------------------------
+ */
+static int ConfigureAttachment(clientPtr, topLevel, interp, axis, which, value)
+ FormInfo *clientPtr;
+ Tk_Window topLevel;
+ Tcl_Interp* interp;
+ int axis, which;
+ char *value;
+{
+ Tk_Window tkwin;
+ FormInfo * attWidget;
+ int code = TCL_OK;
+ int offset;
+ int grid;
+ int argc;
+ char ** argv;
+
+ if (Tcl_SplitList(interp, value, &argc, &argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (argc < 1 || argc > 2) {
+ Tcl_AppendResult(interp, "Malformed attachment value \"", value,
+ "\"", NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ switch (argv[0][0]) {
+ case '#': /* Attached to grid */
+ case '%': /* Attached to percent (aka grid) */
+ if (Tcl_GetInt(interp, argv[0]+1, &grid) == TCL_ERROR) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ clientPtr->attType[axis][which] = ATT_GRID;
+ clientPtr->att[axis][which].grid = grid;
+ break;
+
+ case '&': /* Attached to parallel widget */
+ tkwin = Tk_NameToWindow(interp, argv[0]+1, topLevel);
+
+ if (tkwin != NULL) {
+ if (Tk_IsTopLevel(tkwin)) {
+ Tcl_AppendResult(interp, "can't attach to \"", value,
+ "\": it's a top-level window", (char *) NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+ attWidget = TixFm_GetFormInfo(tkwin, 1);
+ TixFm_AddToMaster(clientPtr->master, attWidget);
+
+ clientPtr->attType[axis][which] = ATT_PARALLEL;
+ clientPtr->att[axis][which].widget = attWidget;
+ } else {
+ code = TCL_ERROR;
+ goto done;
+ }
+ break;
+
+ case '.': /* Attach to opposite widget */
+ tkwin = Tk_NameToWindow(interp, argv[0], topLevel);
+
+ if (tkwin != NULL) {
+ if (Tk_IsTopLevel(tkwin)) {
+ Tcl_AppendResult(interp, "can't attach to \"", value,
+ "\": it's a top-level window", (char *) NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+ attWidget = TixFm_GetFormInfo(tkwin, 1);
+ TixFm_AddToMaster(clientPtr->master, attWidget);
+
+ clientPtr->attType[axis][which] = ATT_OPPOSITE;
+ clientPtr->att[axis][which].widget = attWidget;
+ } else {
+ code = TCL_ERROR;
+ goto done;
+ }
+ break;
+
+ case 'n': /* none */
+ if (argc == 1 && strcmp(argv[0], "none") == 0) {
+ clientPtr->attType[axis][which] = ATT_NONE;
+ goto done;
+ } else {
+ Tcl_AppendResult(interp, "Malformed attachment value \"", value,
+ "\"", NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+ break;
+
+ default: /* Check if is attached to pixel */
+ /* If there is only one value, this can be the offset with implicit
+ * anchor point 0% or max_grid%
+ */
+ if (argc != 1) {
+ Tcl_AppendResult(interp, "Malformed attachment value \"", value,
+ "\"", NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+#if 1
+ if (Tk_GetPixels(interp, topLevel, argv[0], &offset) != TCL_OK) {
+#else
+ if (Tcl_GetInt(interp, argv[0], &offset) == TCL_ERROR) {
+#endif
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ clientPtr->attType[axis][which] = ATT_GRID;
+ clientPtr->off [axis][which] = offset;
+ if (offset < 0 || (offset == 0 && strcmp(argv[0], "-0") ==0)) {
+ clientPtr->att[axis][which].grid = clientPtr->master->grids[axis];
+ } else {
+ clientPtr->att[axis][which].grid = 0;
+ }
+
+ goto done; /* We have already gotten both anchor and offset */
+ }
+
+ if (argc == 2) {
+#if 1
+ if (Tk_GetPixels(interp, topLevel, argv[1], &offset) != TCL_OK) {
+#else
+ if (Tcl_GetInt(interp, argv[1], &offset) == TCL_ERROR) {
+#endif
+ code = TCL_ERROR;
+ goto done;
+ }
+ clientPtr->off[axis][which] = offset;
+ } else {
+ clientPtr->off[axis][which] = 0;
+ }
+
+ done:
+ if (argv) {
+ ckfree((char*) argv);
+ }
+ if (code == TCL_ERROR) {
+ clientPtr->attType[axis][which] = ATT_NONE;
+ clientPtr->off[axis][which] = 0;
+ }
+ return code;
+}
+
+static int ConfigurePadding(clientPtr, tkwin, interp, axis, which, value)
+ FormInfo *clientPtr;
+ Tk_Window tkwin;
+ Tcl_Interp* interp;
+ int axis, which;
+ char *value;
+{
+ int p_value;
+
+ if (Tk_GetPixels(interp, tkwin, value, &p_value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ else {
+ clientPtr->pad[axis][which] = p_value;
+ return TCL_OK;
+ }
+}
+
+static int ConfigureFill(clientPtr, tkwin, interp, value)
+ FormInfo *clientPtr;
+ Tk_Window tkwin;
+ Tcl_Interp* interp;
+ char *value;
+{
+ size_t len = strlen(value);
+
+ if (strncmp(value, "x", len) == 0) {
+ clientPtr->fill[AXIS_X] = 1;
+ clientPtr->fill[AXIS_Y] = 0;
+ }
+ else if (strncmp(value, "y", len) == 0) {
+ clientPtr->fill[AXIS_X] = 0;
+ clientPtr->fill[AXIS_Y] = 1;
+ }
+ else if (strncmp(value, "both", len) == 0) {
+ clientPtr->fill[AXIS_X] = 1;
+ clientPtr->fill[AXIS_Y] = 1;
+ }
+ else if (strncmp(value, "none", len) == 0) {
+ clientPtr->fill[AXIS_X] = 0;
+ clientPtr->fill[AXIS_Y] = 0;
+ }
+ else {
+ Tcl_AppendResult(interp, "bad fill style \"", value,
+ "\": must be none, x, y, or both", NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+static int ConfigureSpring(clientPtr, topLevel, interp, axis, which, value)
+ FormInfo *clientPtr;
+ Tk_Window topLevel;
+ Tcl_Interp* interp;
+ int axis, which;
+ char *value;
+{
+ int strength;
+ int i = axis, j = which;
+
+ if (Tcl_GetInt(interp, value, &strength) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ clientPtr->spring[i][j] = strength;
+
+ if (clientPtr->attType[i][j] == ATT_OPPOSITE) {
+ FormInfo * oppo;
+
+ oppo = clientPtr->att[i][j].widget;
+ oppo->spring[i][!j] = strength;
+
+ if (strength != 0 && clientPtr->strWidget[i][j] == NULL) {
+ clientPtr->strWidget[i][j] = oppo;
+
+ if (oppo->strWidget[i][!j] != clientPtr) {
+ if (oppo->strWidget[i][!j] != NULL) {
+ oppo->strWidget[i][!j]->strWidget[i][j] = NULL;
+ oppo->strWidget[i][!j]->spring[i][j] = 0;
+ }
+ }
+ oppo->strWidget[i][!j] = clientPtr;
+ }
+ }
+
+ return TCL_OK;
+}
+
+int TixFm_Configure(clientPtr, topLevel, interp, argc, argv)
+ FormInfo *clientPtr;
+ Tk_Window topLevel;
+ Tcl_Interp* interp;
+ int argc;
+ char **argv;
+{
+ int i, flag, value;
+
+ for (i=0; i< argc; i+=2) {
+ flag = i;
+ value = i+1;
+
+ if (strcmp(argv[flag], "-in") == 0) {
+ /* Reset the parent of the widget
+ */
+ Tcl_AppendResult(interp,
+ "\"-in \" must be the first option given to tixForm", NULL);
+ return TCL_ERROR;
+ } else if (strcmp(argv[flag], "-l") == 0) {
+ if (ConfigureAttachment(clientPtr, topLevel, interp,
+ 0, 0, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-left") == 0) {
+ if (ConfigureAttachment(clientPtr, topLevel, interp,
+ 0, 0, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-r") == 0) {
+ if (ConfigureAttachment(clientPtr, topLevel, interp,
+ 0, 1, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-right") == 0) {
+ if (ConfigureAttachment(clientPtr, topLevel, interp,
+ 0, 1, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-top") == 0) {
+ if (ConfigureAttachment(clientPtr, topLevel, interp,
+ 1, 0, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-t") == 0) {
+ if (ConfigureAttachment(clientPtr, topLevel, interp,
+ 1, 0, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-bottom") == 0) {
+ if (ConfigureAttachment(clientPtr, topLevel, interp,
+ 1, 1, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-b") == 0) {
+ if (ConfigureAttachment(clientPtr, topLevel, interp,
+ 1, 1, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-padx") == 0) {
+ if (ConfigurePadding(clientPtr, topLevel, interp,
+ 0, 0, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ if (ConfigurePadding(clientPtr, topLevel, interp,
+ 0, 1, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-pady") == 0) {
+ if (ConfigurePadding(clientPtr,topLevel,interp,
+ 1, 0, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ if (ConfigurePadding(clientPtr, topLevel, interp,
+ 1, 1, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-padleft") == 0) {
+ if (ConfigurePadding(clientPtr, topLevel, interp,
+ 0, 0, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-lp") == 0) {
+ if (ConfigurePadding(clientPtr, topLevel, interp,
+ 0, 0, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-padright")== 0){
+ if (ConfigurePadding(clientPtr, topLevel, interp,
+ 0, 1, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-rp")== 0){
+ if (ConfigurePadding(clientPtr, topLevel, interp,
+ 0, 1, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-padtop")== 0) {
+ if (ConfigurePadding(clientPtr, topLevel, interp,
+ 1, 0, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-tp")== 0) {
+ if (ConfigurePadding(clientPtr, topLevel, interp,
+ 1, 0, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag],"-padbottom")== 0){
+ if (ConfigurePadding(clientPtr, topLevel, interp,
+ 1, 1, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag],"-bp")== 0){
+ if (ConfigurePadding(clientPtr, topLevel, interp,
+ 1, 1, argv[value]) == TCL_ERROR) {
+
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-leftspring") == 0) {
+ if (ConfigureSpring(clientPtr, topLevel, interp,
+ 0, 0, argv[value]) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-ls") == 0) {
+ if (ConfigureSpring(clientPtr, topLevel, interp,
+ 0, 0, argv[value]) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-rightspring") == 0) {
+ if (ConfigureSpring(clientPtr, topLevel, interp,
+ 0, 1, argv[value]) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-rs") == 0) {
+ if (ConfigureSpring(clientPtr, topLevel, interp,
+ 0, 1, argv[value]) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-topspring") == 0) {
+ if (ConfigureSpring(clientPtr, topLevel, interp,
+ 1, 0, argv[value]) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-ts") == 0) {
+ if (ConfigureSpring(clientPtr, topLevel, interp,
+ 1, 0, argv[value]) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-bottomspring") == 0) {
+ if (ConfigureSpring(clientPtr, topLevel, interp,
+ 1, 1, argv[value]) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-bs") == 0) {
+ if (ConfigureSpring(clientPtr, topLevel, interp,
+ 1, 1, argv[value]) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ } else if (strcmp(argv[flag], "-fill") == 0) {
+ if (ConfigureFill(clientPtr, topLevel, interp,
+ argv[value]) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "Wrong option \"",
+ argv[i], "\".", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Clear the previously set default attachment if the opposide
+ * edge is attached.
+ */
+
+#if 0
+ /* (1) The X axis */
+ if ((clientPtr->attType[0][0] == ATT_DEFAULT_PIXEL)
+ &&(clientPtr->attType[0][1] != ATT_NONE)) {
+ clientPtr->attType[0][0] = ATT_NONE;
+ }
+
+ /* (2) The Y axis */
+ if ((clientPtr->attType[1][0] == ATT_DEFAULT_PIXEL)
+ &&(clientPtr->attType[1][1] != ATT_NONE)) {
+ clientPtr->attType[1][0] = ATT_NONE;
+ }
+#endif
+
+ return TCL_OK;
+}
+
diff --git a/tix/generic/tixGeometry.c b/tix/generic/tixGeometry.c
new file mode 100644
index 00000000000..b6cc69a1f7e
--- /dev/null
+++ b/tix/generic/tixGeometry.c
@@ -0,0 +1,379 @@
+/*
+ * tixGeometry.c --
+ *
+ * TCL bindings of TK Geometry Management functions.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tix.h>
+
+static Tcl_HashTable clientTable; /* hash table for geometry managers */
+
+static void StructureProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void GeoReqProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void GeoLostSlaveProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+
+typedef struct ClientStruct {
+ Tcl_Interp * interp;
+ Tk_Window tkwin;
+ char * command;
+ unsigned isDeleted : 1;
+} ClientStruct;
+
+static Tk_GeomMgr geoType = {
+ "tixGeometry", /* name */
+ GeoReqProc, /* requestProc */
+ GeoLostSlaveProc, /* lostSlaveProc */
+};
+
+/*----------------------------------------------------------------------
+ *
+ * Geometry Management Hooks
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+/*----------------------------------------------------------------------
+ *
+ * The following functions handles the geometry requests of the clients
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void FreeClientStruct(clientData)
+ ClientData clientData;
+{
+ ClientStruct * cnPtr = (ClientStruct *) clientData;
+
+ ckfree((char*)cnPtr->command);
+ ckfree((char*)cnPtr);
+}
+
+/* This function is called when the clients initiates a geometry
+ * request i.e., a button changes its text and now needs a larger
+ * width
+ *
+ */
+static void
+GeoReqProc(clientData, tkwin)
+ ClientData clientData; /* Information about
+ * window that got new preferred
+ * geometry. */
+ Tk_Window tkwin; /* Other Tk-related information
+ * about the window. */
+{
+ ClientStruct * cnPtr = (ClientStruct *) clientData;
+ int result;
+
+ if (cnPtr->isDeleted) {
+ return;
+ }
+
+ result = Tix_GlobalVarEval(cnPtr->interp, cnPtr->command, " -request ",
+ Tk_PathName(cnPtr->tkwin), (char*)NULL);
+
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(cnPtr->interp,
+ "\n (geometry request command executed by tixManageGeometry)");
+ Tk_BackgroundError(cnPtr->interp);
+ }
+}
+
+/*
+ * This function is called when the clients is grabbed by another
+ * geometry manager. %% Should inform with a -lost call
+ */
+static void
+GeoLostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* Information about
+ * window that got new preferred
+ * geometry. */
+ Tk_Window tkwin; /* Other Tk-related information
+ * about the window. */
+{
+ ClientStruct * cnPtr = (ClientStruct *) clientData;
+ Tcl_HashEntry * hashPtr;
+ int result;
+
+ if (cnPtr->isDeleted) {
+ return;
+ }
+
+ result = Tix_GlobalVarEval(cnPtr->interp, cnPtr->command, " -lostslave ",
+ Tk_PathName(cnPtr->tkwin), (char*)NULL);
+
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(cnPtr->interp,
+ "\n (geometry request command executed by tixManageGeometry)");
+ Tk_BackgroundError(cnPtr->interp);
+ }
+
+ hashPtr = Tcl_FindHashEntry(&clientTable, (char *)tkwin);
+ if (hashPtr) {
+ Tcl_DeleteHashEntry(hashPtr);
+ }
+ cnPtr->isDeleted = 1;
+ Tk_EventuallyFree((ClientData) cnPtr, (Tix_FreeProc*)FreeClientStruct);
+}
+
+
+static void StructureProc(clientData, eventPtr)
+ ClientData clientData;
+ XEvent *eventPtr;
+{
+ ClientStruct * cnPtr = (ClientStruct *) clientData;
+ Tcl_HashEntry * hashPtr;
+
+ if (eventPtr->type == DestroyNotify) {
+ if (cnPtr->isDeleted) {
+ return;
+ }
+
+ hashPtr = Tcl_FindHashEntry(&clientTable, (char *)cnPtr->tkwin);
+ if (hashPtr) {
+ Tcl_DeleteHashEntry(hashPtr);
+ }
+ cnPtr->isDeleted = 1;
+ Tk_EventuallyFree((ClientData) cnPtr, (Tix_FreeProc*)FreeClientStruct);
+ }
+}
+
+
+/*
+ *
+ * argv[1] = clientPathName
+ * argv[2] = managerCommand <-- can have arguments
+ *
+ * %% add possibility to delete a manager
+ *
+ */
+TIX_DEFINE_CMD(Tix_ManageGeometryCmd)
+{
+ Tk_Window topLevel = (Tk_Window)clientData;
+ Tk_Window tkwin;
+ ClientStruct * cnPtr;
+ Tcl_HashEntry * hashPtr;
+ int isNew;
+ static int inited = 0;
+
+ if (argc!=3) {
+ return Tix_ArgcError(interp, argc, argv, 1, "pathname command");
+ }
+
+ if ((tkwin = Tk_NameToWindow(interp, argv[1], topLevel)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (!inited) {
+ Tcl_InitHashTable(&clientTable, TCL_ONE_WORD_KEYS);
+ inited = 1;
+ }
+
+ hashPtr = Tcl_CreateHashEntry(&clientTable, (char *)tkwin, &isNew);
+
+ if (!isNew) {
+ cnPtr = (ClientStruct *) Tcl_GetHashValue(hashPtr);
+ ckfree(cnPtr->command);
+ cnPtr->command = (char*)tixStrDup(argv[2]);
+ } else {
+ cnPtr = (ClientStruct *) ckalloc(sizeof(ClientStruct));
+ cnPtr->tkwin = tkwin;
+ cnPtr->interp = interp;
+ cnPtr->command = (char*)tixStrDup(argv[2]);
+ cnPtr->isDeleted = 0;
+ Tcl_SetHashValue(hashPtr, cnPtr);
+
+ Tk_ManageGeometry(tkwin, &geoType, (ClientData)cnPtr);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ StructureProc, (ClientData)cnPtr);
+ }
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * The following are TCL bindings for the TK geometry functions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+/*
+ *
+ * argv[1] = clientPathName
+ * argv[2] = req width
+ * argv[3] = req height
+ *
+ */
+TIX_DEFINE_CMD(Tix_GeometryRequestCmd)
+{
+ Tk_Window topLevel = (Tk_Window)clientData;
+ Tk_Window tkwin;
+ int reqWidth;
+ int reqHeight;
+
+ if (argc != 4) {
+ return Tix_ArgcError(interp, argc, argv, 1,
+ "pathname reqwidth reqheight");
+ }
+
+ if ((tkwin = Tk_NameToWindow(interp, argv[1], topLevel)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (Tk_GetPixels(interp, tkwin, argv[2], &reqWidth) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tk_GetPixels(interp, tkwin, argv[3], &reqHeight) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tk_GeometryRequest(tkwin, reqWidth, reqHeight);
+ return TCL_OK;
+}
+
+/*
+ *
+ * argv[1] = clientPathName
+ * argv[2] = width
+ * argv[3] = height
+ * argv[4] = width
+ * argv[5] = height
+ *
+ */
+TIX_DEFINE_CMD(Tix_MoveResizeWindowCmd)
+{
+ Tk_Window topLevel = (Tk_Window)clientData;
+ Tk_Window tkwin;
+ int x, y;
+ int width;
+ int height;
+
+ if (argc != 6) {
+ return Tix_ArgcError(interp, argc, argv, 1,
+ "pathname x y width height");
+ }
+
+ if ((tkwin = Tk_NameToWindow(interp, argv[1], topLevel)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (Tk_GetPixels(interp, tkwin, argv[2], &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tk_GetPixels(interp, tkwin, argv[3], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tk_GetPixels(interp, tkwin, argv[4], &width) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (Tk_GetPixels(interp, tkwin, argv[5], &height) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tk_MoveResizeWindow(tkwin, x, y, width, height);
+ return TCL_OK;
+}
+
+/*
+ *
+ * argv[1] = clientPathName
+ *
+ */
+TIX_DEFINE_CMD(Tix_MapWindowCmd)
+{
+ Tk_Window topLevel = (Tk_Window)clientData;
+ Tk_Window tkwin;
+
+ if (argc != 2) {
+ return Tix_ArgcError(interp, argc, argv, 1, "pathname");
+ }
+
+ if ((tkwin = Tk_NameToWindow(interp, argv[1], topLevel)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ Tk_MapWindow(tkwin);
+ return TCL_OK;
+}
+
+/*
+ * Tix_FlushXCmd -- calls XFlush()
+ * argv[1] = pathName
+ *
+ */
+TIX_DEFINE_CMD(Tix_FlushXCmd)
+{
+ Tk_Window topLevel = (Tk_Window)clientData;
+ Tk_Window tkwin;
+
+ if (argc != 2) {
+ return Tix_ArgcError(interp, argc, argv, 1, "pathname");
+ }
+
+ if ((tkwin = Tk_NameToWindow(interp, argv[1], topLevel)) == NULL) {
+ return TCL_ERROR;
+ }
+
+#ifndef _WINDOWS
+ XFlush(Tk_Display(tkwin));
+#endif
+ return TCL_OK;
+}
+
+/*
+ *
+ * argv[1] = clientPathName
+ *
+ */
+TIX_DEFINE_CMD(Tix_UnmapWindowCmd)
+{
+ Tk_Window topLevel = (Tk_Window)clientData;
+ Tk_Window tkwin;
+
+ if (argc != 2) {
+ return Tix_ArgcError(interp, argc, argv, 1, "pathname");
+ }
+
+ if ((tkwin = Tk_NameToWindow(interp, argv[1], topLevel)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ Tk_UnmapWindow(tkwin);
+ return TCL_OK;
+}
+
+/*
+ *
+ * argv[1] = clientPathName
+ *
+ */
+TIX_DEFINE_CMD(Tix_RaiseWindowCmd)
+{
+ Tk_Window topLevel = (Tk_Window)clientData;
+ Tk_Window tkwin;
+
+ if (argc != 2) {
+ return Tix_ArgcError(interp, argc, argv, 1, "pathname");
+ }
+
+ if ((tkwin = Tk_NameToWindow(interp, argv[1], topLevel)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ XRaiseWindow(Tk_Display(tkwin), Tk_WindowId(tkwin));
+ return TCL_OK;
+}
diff --git a/tix/generic/tixGrData.c b/tix/generic/tixGrData.c
new file mode 100644
index 00000000000..d69f6a41615
--- /dev/null
+++ b/tix/generic/tixGrData.c
@@ -0,0 +1,923 @@
+/*
+ * tixGrData.c --
+ *
+ * This module manipulates the data structure for a Grid widget.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixGrid.h>
+
+static int FindRowCol _ANSI_ARGS_((TixGridDataSet * dataSet,
+ int x, int y, TixGridRowCol * rowcol[2],
+ Tcl_HashEntry * hashPtrs[2]));
+static TixGridRowCol * InitRowCol _ANSI_ARGS_((int index));
+static int RowColMaxSize _ANSI_ARGS_((WidgetPtr wPtr,
+ int which, TixGridRowCol *rowCol,
+ TixGridSize * defSize));
+
+static TixGridRowCol *
+InitRowCol(index)
+ int index;
+{
+ TixGridRowCol * rowCol = (TixGridRowCol *)ckalloc(sizeof(TixGridRowCol));
+
+ rowCol->dispIndex = index;
+ rowCol->size.sizeType = TIX_GR_DEFAULT;
+ rowCol->size.sizeValue = 0;
+ rowCol->size.charValue = 0;
+ rowCol->size.pad0 = 2;
+ rowCol->size.pad1 = 2;
+ rowCol->size.pixels = 0;
+
+ Tcl_InitHashTable(&rowCol->table, TCL_ONE_WORD_KEYS);
+
+ return rowCol;
+}
+
+/*----------------------------------------------------------------------
+ * TixGridDataSetInit --
+ *
+ * Create an instance of the TixGridDataSet data structure.
+ *
+ *----------------------------------------------------------------------
+ */
+TixGridDataSet *
+TixGridDataSetInit()
+{
+ TixGridDataSet * dataSet =(TixGridDataSet*)ckalloc(sizeof(TixGridDataSet));
+
+ Tcl_InitHashTable(&dataSet->index[0], TCL_ONE_WORD_KEYS);
+ Tcl_InitHashTable(&dataSet->index[1], TCL_ONE_WORD_KEYS);
+
+ dataSet->maxIdx[0] = -1;
+ dataSet->maxIdx[1] = -1;
+
+ return dataSet;
+}
+
+/*----------------------------------------------------------------------
+ * TixGridDataSetFree --
+ *
+ * Frees an instance of the TixGridDataSet data structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TixGridDataSetFree(dataSet)
+ TixGridDataSet* dataSet;
+{
+ Tcl_HashSearch hashSearch;
+ Tcl_HashEntry *hashPtr;
+ TixGridRowCol *rcPtr;
+ int i;
+
+ for (i=0; i<2; i++) {
+ for (hashPtr = Tcl_FirstHashEntry(&dataSet->index[i], &hashSearch);
+ hashPtr;
+ hashPtr = Tcl_NextHashEntry(&hashSearch)) {
+ rcPtr = (TixGridRowCol *)Tcl_GetHashValue(hashPtr);
+ if (rcPtr->table.numEntries > 0) {
+ fprintf(stderr, "Grid hash entry leaked: %d : %d\n", i,
+ rcPtr->dispIndex);
+ }
+
+ Tcl_DeleteHashTable(&rcPtr->table);
+ ckfree((char*)rcPtr);
+ }
+ }
+
+ Tcl_DeleteHashTable(&dataSet->index[0]);
+ Tcl_DeleteHashTable(&dataSet->index[1]);
+ ckfree((char*)dataSet);
+}
+
+/*----------------------------------------------------------------------
+ * TixGridDataFindEntry --
+ *
+ * Results:
+ * Return the element if it exists. Otherwise returns NULL.
+ *
+ * Side effects:
+ * None.
+ *----------------------------------------------------------------------
+ */
+
+char *
+TixGridDataFindEntry(dataSet, x, y)
+ TixGridDataSet * dataSet;
+ int x;
+ int y;
+{
+ TixGridRowCol *col, *row;
+ Tcl_HashEntry *hashPtr;
+
+ /* (1) Find the row and column */
+ if (!(hashPtr = Tcl_FindHashEntry(&dataSet->index[0], (char*)x))) {
+ return NULL;
+ }
+ col = (TixGridRowCol *)Tcl_GetHashValue(hashPtr);
+
+ if (!(hashPtr = Tcl_FindHashEntry(&dataSet->index[1], (char*)y))) {
+ return NULL;
+ }
+ row = (TixGridRowCol *)Tcl_GetHashValue(hashPtr);
+
+ /* (2) Find the entry */
+ if (row->table.numEntries < col->table.numEntries) {
+ if (!(hashPtr = Tcl_FindHashEntry(&row->table, (char*)col))) {
+ return NULL;
+ }
+ }
+ else {
+ if (!(hashPtr = Tcl_FindHashEntry(&col->table, (char*)row))) {
+ return NULL;
+ }
+ }
+
+ return (char *)Tcl_GetHashValue(hashPtr);
+}
+
+/*----------------------------------------------------------------------
+ * FindRowCol --
+ *
+ * Internal function: finds row and column info an entry.
+ *
+ * Results:
+ * Returns true if BOTH row and column exist. If so, the row and
+ * column info is returned in the rowcol.
+ *
+ * Side effects:
+ * None.
+ *----------------------------------------------------------------------
+ */
+
+static int
+FindRowCol(dataSet, x, y, rowcol, hashPtrs)
+ TixGridDataSet * dataSet; /* The Grid dataset. */
+ int x, y; /* Location of the cell. */
+ TixGridRowCol * rowcol[2]; /* Returns information about the row/col. */
+ Tcl_HashEntry * hashPtrs[2];/* Returns hash table info about the row/col.*/
+{
+ hashPtrs[0] = Tcl_FindHashEntry(&dataSet->index[0], (char*)x);
+ if (hashPtrs[0] != NULL) {
+ rowcol[0] = (TixGridRowCol *)Tcl_GetHashValue(hashPtrs[0]);
+ } else {
+ return 0;
+ }
+
+ hashPtrs[1] = Tcl_FindHashEntry(&dataSet->index[1], (char*)y);
+ if (hashPtrs[1] != NULL) {
+ rowcol[1] = (TixGridRowCol *)Tcl_GetHashValue(hashPtrs[1]);
+ } else {
+ return 0;
+ }
+
+ return 1;
+}
+
+/*----------------------------------------------------------------------
+ * TixGridDataCreateEntry --
+ *
+ * Find or create the entry at the specified index.
+ *
+ * Results:
+ * A handle to the entry.
+ *
+ * Side effects:
+ * A new entry is created if it is not already in the dataset.
+ *----------------------------------------------------------------------
+ */
+
+char *
+TixGridDataCreateEntry(dataSet, x, y, defaultEntry)
+ TixGridDataSet * dataSet;
+ int x;
+ int y;
+ char * defaultEntry;
+{
+ TixGridRowCol *rowcol[2];
+ Tcl_HashEntry *hashPtr;
+ int isNew, i, dispIndex[2];
+
+ dispIndex[0] = x;
+ dispIndex[1] = y;
+
+ for (i=0; i<2; i++) {
+ hashPtr = Tcl_CreateHashEntry(&dataSet->index[i],
+ (char*)dispIndex[i], &isNew);
+
+ if (!isNew) {
+ rowcol[i] = (TixGridRowCol *)Tcl_GetHashValue(hashPtr);
+ } else {
+ rowcol[i] = InitRowCol(dispIndex[i]);
+ Tcl_SetHashValue(hashPtr, (char*)rowcol[i]);
+
+ if (dataSet->maxIdx[i] < dispIndex[i]) {
+ dataSet->maxIdx[i] = dispIndex[i];
+ }
+ }
+ }
+
+ hashPtr = Tcl_CreateHashEntry(&rowcol[0]->table,
+ (char*)rowcol[1], &isNew);
+
+ if (!isNew) {
+ return (char *) Tcl_GetHashValue(hashPtr);
+ }
+ else {
+ TixGrEntry *chPtr = (TixGrEntry *)defaultEntry;
+
+ Tcl_SetHashValue(hashPtr, (char*)chPtr);
+ chPtr->entryPtr[0] = hashPtr;
+
+ hashPtr = Tcl_CreateHashEntry(&rowcol[1]->table,
+ (char*)rowcol[0], &isNew);
+ Tcl_SetHashValue(hashPtr, (char*)defaultEntry);
+ chPtr->entryPtr[1] = hashPtr;
+
+ return defaultEntry;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * TixGridDataDeleteEntry --
+ *
+ * Deletes the entry at the specified index.
+ *
+ * Results:
+ * True iff the entry existed and was deleted.
+ *
+ * Side effects:
+ * If there is an entry at the index, it is deleted.
+ *----------------------------------------------------------------------
+ */
+
+int
+TixGridDataDeleteEntry(dataSet, x, y)
+ TixGridDataSet * dataSet; /* The Grid dataset. */
+ int x; /* Column number of the entry. */
+ int y; /* Row number of the entry. */
+{
+ TixGridRowCol *rowcol[2];
+ Tcl_HashEntry *hashPtrs[2]; /* Hash entries of the row/col. */
+ Tcl_HashEntry *cx, *cy; /* Hash entries of the cell in the row/col. */
+ int i;
+
+ if (!FindRowCol(dataSet, x, y, rowcol, hashPtrs)) {
+ /*
+ * The row and/or the column do not exist.
+ */
+ return 0;
+ }
+
+ cx = Tcl_FindHashEntry(&rowcol[0]->table, (char*)rowcol[1]);
+ cy = Tcl_FindHashEntry(&rowcol[1]->table, (char*)rowcol[0]);
+
+ if (cx == NULL && cy == NULL) {
+ return 0;
+ }
+ else if (cx != NULL && cy != NULL) {
+ Tcl_DeleteHashEntry(cx);
+ Tcl_DeleteHashEntry(cy);
+ }
+ else {
+ panic("Inconsistent grid dataset: (%d,%d) : %x %x", x, y, cx, cy);
+ }
+
+#if 0
+ /*
+ * Can't do this, otherwise the size info of this row/col is lost.
+ */
+ for (i=0; i<2; i++) {
+ if (rowcol[i]->table.numEntries == 0) {
+ Tcl_DeleteHashEntry(hashPtrs[i]);
+
+ Tcl_DeleteHashTable(&rowcol[i]->table);
+ ckfree((char*)rowcol[i]);
+ }
+ }
+#endif
+
+#if 0
+ printf("%d %d\n", dataSet->index[0].numEntries,
+ dataSet->index[1].numEntries);
+#endif
+
+ return 1;
+
+ /*
+ * ToDo: trim down the hash table.
+ */
+}
+
+/* return value: has the size of the grid changed as a result of sorting */
+int
+TixGridDataUpdateSort(dataSet, axis, start, end, items)
+ TixGridDataSet * dataSet;
+ int axis;
+ int start;
+ int end;
+ Tix_GrSortItem *items;
+{
+ TixGridRowCol **ptr;
+ Tcl_HashEntry *hashPtr;
+ int numItems = end - start + 1;
+ int i, k, max;
+
+ if (numItems <= 0) {
+ return 0;
+ }
+
+ ptr = (TixGridRowCol **)ckalloc(numItems * sizeof(TixGridRowCol *));
+
+ for (k=0,i=start; i<=end; i++,k++) {
+ if (!(hashPtr = Tcl_FindHashEntry(&dataSet->index[axis], (char*)i))) {
+ /*
+ * This row/col doesn't exist
+ */
+ ptr[k] = NULL;
+ } else {
+ ptr[k] = (TixGridRowCol *)Tcl_GetHashValue(hashPtr);
+ Tcl_DeleteHashEntry(hashPtr);
+ }
+ }
+
+ for (k=0,i=start; i<=end; i++,k++) {
+ int pos, isNew;
+ pos = items[k].index - start;
+
+ if (ptr[pos] != NULL) {
+ hashPtr = Tcl_CreateHashEntry(&dataSet->index[axis], (char*)i,
+ &isNew);
+ Tcl_SetHashValue(hashPtr, (char*)ptr[pos]);
+ ptr[pos]->dispIndex = i;
+ max = i;
+ }
+ }
+
+ ckfree((char*)ptr);
+
+ if (end+1 >= dataSet->maxIdx[axis]) {
+ if (dataSet->maxIdx[axis] != max+1) {
+ dataSet->maxIdx[axis] = max+1;
+ return 1; /* size changed */
+ }
+ }
+ return 0; /* size not changed */
+}
+
+
+static int
+RowColMaxSize(wPtr, which, rowCol, defSize)
+ WidgetPtr wPtr;
+ int which; /* 0=cols, 1=rows */
+ TixGridRowCol *rowCol;
+ TixGridSize * defSize;
+{
+ Tcl_HashSearch hashSearch;
+ Tcl_HashEntry *hashPtr;
+ TixGrEntry * chPtr;
+ int maxSize = 1;
+
+ if (rowCol->table.numEntries == 0) {
+ return defSize->pixels;
+ }
+
+ for (hashPtr = Tcl_FirstHashEntry(&rowCol->table, &hashSearch);
+ hashPtr;
+ hashPtr = Tcl_NextHashEntry(&hashSearch)) {
+
+ chPtr = (TixGrEntry *)Tcl_GetHashValue(hashPtr);
+ if (maxSize < chPtr->iPtr->base.size[which]) {
+ maxSize = chPtr->iPtr->base.size[which];
+ }
+ }
+
+ return maxSize;
+}
+
+/*
+ *----------------------------------------------------------------------
+ * TixGridDataGetRowColSize --
+ *
+ * Returns width of a column or height of a row.
+ *
+ * Results:
+ * The width or height.
+ *
+ * Side effects:
+ * None.
+ *----------------------------------------------------------------------
+ */
+
+int
+TixGridDataGetRowColSize(wPtr, dataSet, which, index, defSize, pad0, pad1)
+ WidgetPtr wPtr; /* Info about Grid widget */
+ TixGridDataSet * dataSet; /* Dataset of the Grid */
+ int which; /* 0=cols, 1=rows */
+ int index; /* Column or row number */
+ TixGridSize * defSize; /* The default size for the grid cells */
+ int *pad0; /* Holds return value of horizontal padding. */
+ int *pad1; /* Holds return value of vertical padding. */
+{
+ TixGridRowCol *rowCol;
+ Tcl_HashEntry *hashPtr;
+ int size;
+
+ if (!(hashPtr = Tcl_FindHashEntry(&dataSet->index[which], (char*)index))) {
+ size = defSize->pixels;
+ *pad0 = defSize->pad0;
+ *pad1 = defSize->pad1;
+ }
+ else {
+ rowCol = (TixGridRowCol *)Tcl_GetHashValue(hashPtr);
+
+ switch (rowCol->size.sizeType) {
+ case TIX_GR_AUTO:
+ size = RowColMaxSize(wPtr, which, rowCol, defSize);
+ *pad0 = rowCol->size.pad0;
+ *pad1 = rowCol->size.pad1;
+ break;
+
+ case TIX_GR_DEFINED_PIXEL:
+ size = rowCol->size.sizeValue;
+ *pad0 = rowCol->size.pad0;
+ *pad1 = rowCol->size.pad1;
+ break;
+
+ case TIX_GR_DEFINED_CHAR:
+ size = (int)(rowCol->size.charValue * wPtr->fontSize[which]);
+ *pad0 = rowCol->size.pad0;
+ *pad1 = rowCol->size.pad1;
+ break;
+
+ case TIX_GR_DEFAULT:
+ default: /* some error ?? */
+ if (defSize->sizeType == TIX_GR_AUTO) {
+ size = RowColMaxSize(wPtr, which, rowCol, defSize);
+ } else {
+ size = defSize->pixels;
+ }
+ *pad0 = defSize->pad0;
+ *pad1 = defSize->pad1;
+ }
+ }
+
+ return size;
+}
+
+int
+TixGridDataGetIndex(interp, wPtr, xStr, yStr, xPtr, yPtr)
+ Tcl_Interp * interp;
+ WidgetPtr wPtr;
+ char * xStr;
+ char * yStr;
+ int * xPtr;
+ int * yPtr;
+{
+ char * str[2];
+ int * ptr[2];
+ int i;
+
+ str[0] = xStr;
+ str[1] = yStr;
+ ptr[0] = xPtr;
+ ptr[1] = yPtr;
+
+ for (i=0; i<2; i++) {
+ if (str[i] == NULL) { /* ignore this index */
+ continue;
+ }
+
+ if (strcmp(str[i], "max") == 0) {
+ *ptr[i] = wPtr->dataSet->maxIdx[i];
+ if (*ptr[i] < wPtr->hdrSize[i]) {
+ *ptr[i] = wPtr->hdrSize[i];
+ }
+ }
+ else if (strcmp(str[i], "end") == 0) {
+ *ptr[i] = wPtr->dataSet->maxIdx[i] + 1;
+ if (*ptr[i] < wPtr->hdrSize[i]) {
+ *ptr[i] = wPtr->hdrSize[i];
+ }
+ } else {
+ if (Tcl_GetInt(interp, str[i], ptr[i]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (*ptr[i] < 0) {
+ *ptr[i] = 0;
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ * TixGridDataConfigRowColSize --
+ *
+ * Configure width of column or height of rows.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * The column/rows size will be changed in an idle event.
+ *----------------------------------------------------------------------
+ */
+
+int
+TixGridDataConfigRowColSize(interp, wPtr, dataSet, which, index, argc, argv,
+ argcErrorMsg, changed_ret)
+ Tcl_Interp * interp;
+ WidgetPtr wPtr;
+ TixGridDataSet * dataSet;
+ int which; /* 0=cols, 1=rows */
+ int index;
+ int argc;
+ char ** argv;
+ char * argcErrorMsg;
+ int *changed_ret; /* Returns whether size has been changed. */
+{
+ TixGridRowCol *rowCol;
+ Tcl_HashEntry *hashPtr;
+ int isNew, code;
+
+ hashPtr = Tcl_CreateHashEntry(&dataSet->index[which],(char*)index, &isNew);
+
+ if (!isNew) {
+ rowCol = (TixGridRowCol *)Tcl_GetHashValue(hashPtr);
+ } else {
+ rowCol = InitRowCol(index);
+ Tcl_SetHashValue(hashPtr, (char*)rowCol);
+
+ if (dataSet->maxIdx[which] < index) {
+ dataSet->maxIdx[which] = index;
+ }
+ }
+
+ code = Tix_GrConfigSize(interp, wPtr, argc, argv, &rowCol->size,
+ argcErrorMsg, changed_ret);
+
+ if (changed_ret) {
+ *changed_ret |= isNew;
+ }
+
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ * TixGridDataGetGridSize --
+ *
+ * Returns the number of rows and columns of the grid.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *----------------------------------------------------------------------
+ */
+
+/*
+ * ToDo: maintain numCol and numRow info while adding entries.
+ */
+
+void
+TixGridDataGetGridSize(dataSet, numCol_ret, numRow_ret)
+ TixGridDataSet * dataSet;
+ int *numCol_ret;
+ int *numRow_ret;
+{
+ int maxSize[2], i;
+ Tcl_HashEntry *hashPtr;
+ Tcl_HashSearch hashSearch;
+ TixGridRowCol * rowCol;
+
+ maxSize[0] = 1;
+ maxSize[1] = 1;
+
+ if (dataSet->index[0].numEntries == 0 || dataSet->index[1].numEntries==0) {
+ goto done;
+ }
+
+ for (i=0; i<2; i++) {
+
+ for (hashPtr = Tcl_FirstHashEntry(&dataSet->index[i], &hashSearch);
+ hashPtr;
+ hashPtr = Tcl_NextHashEntry(&hashSearch)) {
+
+ rowCol = (TixGridRowCol *)Tcl_GetHashValue(hashPtr);
+ if (maxSize[i] < rowCol->dispIndex+1) {
+ maxSize[i] = rowCol->dispIndex+1;
+ }
+ }
+ }
+
+ done:
+ if (numCol_ret) {
+ *numCol_ret = maxSize[0];
+ }
+ if (numRow_ret) {
+ *numRow_ret = maxSize[1];
+ }
+}
+
+
+/*
+ * the following four functions return true if done -- no more rows or cells
+ * are left to traverse
+ */
+
+int
+TixGrDataFirstRow(dataSet, rowSearchPtr)
+ TixGridDataSet* dataSet;
+ Tix_GrDataRowSearch * rowSearchPtr;
+{
+ rowSearchPtr->hashPtr = Tcl_FirstHashEntry(&dataSet->index[0],
+ &rowSearchPtr->hashSearch);
+
+ if (rowSearchPtr->hashPtr != NULL) {
+ rowSearchPtr->row = (TixGridRowCol *)Tcl_GetHashValue(
+ rowSearchPtr->hashPtr);
+ return 0;
+ } else {
+ rowSearchPtr->row = NULL;
+ return 1;
+ }
+}
+
+int
+TixGrDataNextRow(rowSearchPtr)
+ Tix_GrDataRowSearch * rowSearchPtr;
+{
+ rowSearchPtr->hashPtr = Tcl_NextHashEntry(&rowSearchPtr->hashSearch);
+
+ if (rowSearchPtr->hashPtr != NULL) {
+ rowSearchPtr->row = (TixGridRowCol *)Tcl_GetHashValue(
+ rowSearchPtr->hashPtr);
+ return 0;
+ } else {
+ rowSearchPtr->row = NULL;
+ return 1;
+ }
+}
+
+int
+TixGrDataFirstCell(rowSearchPtr, cellSearchPtr)
+ Tix_GrDataRowSearch * rowSearchPtr;
+ Tix_GrDataCellSearch * cellSearchPtr;
+{
+ cellSearchPtr->hashPtr = Tcl_FirstHashEntry(&rowSearchPtr->row->table,
+ &cellSearchPtr->hashSearch);
+
+ if (cellSearchPtr->hashPtr != NULL) {
+ cellSearchPtr->data = (char *)Tcl_GetHashValue(
+ cellSearchPtr->hashPtr);
+ return 0;
+ } else {
+ cellSearchPtr->data = NULL;
+ return 1;
+ }
+}
+
+int
+TixGrDataNextCell(cellSearchPtr)
+ Tix_GrDataCellSearch * cellSearchPtr;
+{
+ cellSearchPtr->hashPtr = Tcl_NextHashEntry(&cellSearchPtr->hashSearch);
+
+ if (cellSearchPtr->hashPtr != NULL) {
+ cellSearchPtr->data = (char *)Tcl_GetHashValue(
+ cellSearchPtr->hashPtr);
+ return 0;
+ } else {
+ cellSearchPtr->data = NULL;
+ return 1;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * TixGridDataDeleteSearchedEntry --
+ *
+ * Deletes an entry returned by one of the search functions.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there is an entry at the index, it is deleted.
+ *----------------------------------------------------------------------
+ */
+
+void
+TixGridDataDeleteSearchedEntry(cellSearchPtr)
+ Tix_GrDataCellSearch * cellSearchPtr;
+{
+ TixGrEntry * chPtr = (TixGrEntry *)cellSearchPtr->data;
+
+ Tcl_DeleteHashEntry(chPtr->entryPtr[0]);
+ Tcl_DeleteHashEntry(chPtr->entryPtr[1]);
+}
+
+/*
+ *----------------------------------------------------------------------
+ * TixGridDataDeleteRange --
+ *
+ * Deletes the rows (columns) at the given range.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The given rows (columns) are deleted.
+ *----------------------------------------------------------------------
+ */
+
+void
+TixGridDataDeleteRange(wPtr, dataSet, which, from, to)
+ WidgetPtr wPtr; /* Info about the grid widget. */
+ TixGridDataSet * dataSet; /* Dataset of the Grid */
+ int which; /* 0=cols, 1=rows */
+ int from; /* Starting column/row. */
+ int to; /* Ending column/row (inclusive). */
+{
+ int tmp, i, other, deleted = 0;
+
+ if (from < 0 ) {
+ from = 0;
+ }
+ if (to < 0 ) {
+ to = 0;
+ }
+ if (from > to) {
+ tmp = to;
+ to = from;
+ from = tmp;
+ }
+ if (which == 0) {
+ other = 1;
+ } else {
+ other = 0;
+ }
+
+ for (i=from; i<=to; i++) {
+ Tcl_HashEntry *hashPtr, *hp, *toDel;
+ TixGridRowCol *rcPtr, *rcp;
+ Tcl_HashSearch hashSearch;
+
+ hashPtr = Tcl_FindHashEntry(&dataSet->index[which], (char*)i);
+ if (hashPtr != NULL) {
+ rcPtr = (TixGridRowCol *)Tcl_GetHashValue(hashPtr);
+
+ for (hp = Tcl_FirstHashEntry(&dataSet->index[other], &hashSearch);
+ hp;
+ hp = Tcl_NextHashEntry(&hashSearch)) {
+
+ rcp = (TixGridRowCol *)Tcl_GetHashValue(hp);
+ toDel = Tcl_FindHashEntry(&rcp->table, (char*)rcPtr);
+ if (toDel != NULL) {
+ TixGrEntry * chPtr;
+
+ chPtr = (TixGrEntry *)Tcl_GetHashValue(toDel);
+ if (chPtr) {
+ deleted = 1;
+ Tix_GrFreeElem(chPtr);
+ }
+
+ Tcl_DeleteHashEntry(toDel);
+ }
+ }
+
+ Tcl_DeleteHashEntry(hashPtr);
+ Tcl_DeleteHashTable(&rcPtr->table);
+ ckfree((char*)rcPtr);
+ }
+ }
+
+ if (deleted) {
+ Tix_GrDoWhenIdle(wPtr, TIX_GR_RESIZE);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * TixGridDataMoveRange --
+ *
+ * Moves a range of row (columns) by a given offset. E.g. move 2-4 by 2
+ * changes the rows 2,3,4 to 4,5,6.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Rows (columns) at locations where the given rows will be moved
+ * to are deleted.
+ *----------------------------------------------------------------------
+ */
+
+void
+TixGridDataMoveRange(wPtr, dataSet, which, from, to, by)
+ WidgetPtr wPtr; /* Info about the grid widget. */
+ TixGridDataSet * dataSet; /* Dataset of the Grid */
+ int which; /* 0=cols, 1=rows */
+ int from; /* Starting column/row. */
+ int to; /* Ending column/row (inclusive). */
+ int by; /* The distance of the move. */
+{
+ int tmp, i, s, e, incr;
+ int df, dt; /* Rows inside this range will be deleted
+ * before the given rows are moved. */
+
+ if (by == 0) {
+ return;
+ }
+ if (from < 0 ) {
+ from = 0;
+ }
+ if (to < 0 ) {
+ to = 0;
+ }
+ if (from > to) {
+ tmp = to;
+ to = from;
+ from = tmp;
+ }
+
+ if ((from + by) < 0) {
+ /*
+ * Delete the leading rows that will be moved beyond the top of grid.
+ */
+ int n; /* Number of rows to delete. */
+
+ n = - (from + by);
+ if (n > (to - from + 1)) {
+ n = to - from + 1;
+ }
+ TixGridDataDeleteRange(wPtr, dataSet, which, from, (from+n-1));
+ from = from + n;
+
+ if (from > to) {
+ /*
+ * All the rows have been deleted.
+ */
+ return;
+ }
+ }
+
+ /*
+ * Delete rows at locations where the given rows will be moved to.
+ */
+ df = from + by;
+ dt = to + by;
+
+ if (by > 0) {
+ if (df <= to) {
+ df = to + 1;
+ }
+ } else {
+ if (dt >= from) {
+ dt = from - 1;
+ }
+ }
+ TixGridDataDeleteRange(wPtr, dataSet, which, df, dt);
+
+ /*
+ * Rename the rows.
+ */
+ if (by > 0) {
+ s = to;
+ e = from-1;
+ incr = -1;
+ } else {
+ s = from;
+ e = to+1;
+ incr = 1;
+ }
+
+ for (i=s; i!=e; i+=incr) {
+ Tcl_HashEntry *hashPtr;
+ TixGridRowCol *rcPtr;
+ int isNew;
+
+ hashPtr = Tcl_FindHashEntry(&dataSet->index[which], (char*)i);
+ if (hashPtr != NULL) {
+ rcPtr = (TixGridRowCol *)Tcl_GetHashValue(hashPtr);
+ rcPtr->dispIndex = i+by;
+ Tcl_DeleteHashEntry(hashPtr);
+ hashPtr = Tcl_CreateHashEntry(&dataSet->index[which],(char*)(i+by),
+ &isNew);
+ Tcl_SetHashValue(hashPtr, (char*)rcPtr);
+ }
+ }
+}
diff --git a/tix/generic/tixGrData.h b/tix/generic/tixGrData.h
new file mode 100644
index 00000000000..89ed4f2722d
--- /dev/null
+++ b/tix/generic/tixGrData.h
@@ -0,0 +1,85 @@
+/*
+ * tixGData.h --
+ *
+ * Defines portable data structure for tixGrid.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#ifndef _TIX_GRID_DATA_H_
+#define _TIX_GRID_DATA_H_
+
+/*
+ * Data structure that stored the cells in a Grid widget. It is optimized
+ * for column/row insertion and deletion.
+ *
+ * - A grid is divideded into a set of rows and columns. Each row and column
+ * is divided into a set of cells.
+ *
+ * - The following discusses the structure of a row. The structure of a
+ * column is the reverse of a row.
+ *
+ * Row y is stored in the hash table TixGridDataSet.index[1] with
+ * the index y. Hence, to search for row y, we use the FindHashEntry
+ * operation:
+ *
+ * row_y = TixGridDataSet.index[1].FindHashEntry(y);
+ *
+ * To locate a cell (x,y), we can first find the row y, and then
+ * locate the cell at column x of this row. Note that the cell is
+ * *not* indexed by its column position (y), but rather by the hash
+ * table of the column y. The following example illustrates how cell
+ * (x,y) can be searched:
+ *
+ * row_y = TixGridDataSet.index[1].FindHashEntry(y);
+ * col_x = TixGridDataSet.index[0].FindHashEntry(x);
+ *
+ * cell_xy = row_x.list.FindHashEntry(&col_x);
+ *
+ * The advantage of this arrangement is it is very efficient to
+ * insert a row into into the grid -- we just have to fix the
+ * indices of the rows table. For example, if, after the insertion,
+ * row_y is now moved to the row y1, we change its index from y to
+ * y1. In general, an insertion operation takes log(n) time in a
+ * grid that contains n items.
+ *
+ */
+typedef struct TixGridDataSet {
+ Tcl_HashTable index[2]; /* the row and column indices */
+ /* index[0] holds the columns
+ * (horizontal index)
+ */
+ int maxIdx[2]; /* the max row/col, or {-1,-1}
+ * if there are no rows/col
+ */
+} TixGridDataSet;
+
+#define TIX_GR_AUTO 0
+#define TIX_GR_DEFAULT 1
+#define TIX_GR_DEFINED_PIXEL 2
+#define TIX_GR_DEFINED_CHAR 3
+
+typedef struct TixGridSize {
+ int sizeType;
+ int sizeValue; /* width or height */
+ int pixels;
+ int pad0, pad1;
+ double charValue;
+} TixGridSize;
+
+typedef struct TixGridRowCol {
+ /* private: */
+ Tcl_HashTable table;
+
+ /* public: */
+ int dispIndex; /* the row or column in which
+ * this TixGridRowCol is displayed */
+ TixGridSize size;
+} TixGridRowCol;
+
+
+#endif
diff --git a/tix/generic/tixGrFmt.c b/tix/generic/tixGrFmt.c
new file mode 100644
index 00000000000..16ba8b647f5
--- /dev/null
+++ b/tix/generic/tixGrFmt.c
@@ -0,0 +1,806 @@
+/*
+ * tixGrFmt.c --
+ *
+ * This module handles the formatting of the elements inside a Grid
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixDef.h>
+#include <tixGrid.h>
+
+typedef struct FormatStruct {
+ int x1, y1, x2, y2;
+} FormatStruct;
+
+typedef struct BorderFmtStruct {
+ int x1, y1, x2, y2;
+ Tk_3DBorder border;
+ Tk_3DBorder selectBorder; /* the border color color */
+ int borderWidth; /* Width of 3-D borders. */
+ int relief; /* Indicates whether window as a whole is
+ * raised, sunken, or flat. */
+ int xon, xoff;
+ int yon, yoff;
+ int filled;
+} BorderFmtStruct;
+
+typedef struct GridFmtStruct {
+ int x1, y1, x2, y2;
+ Tk_3DBorder border; /* the border color color */
+ Tk_3DBorder selectBorder; /* the border color color */
+ Tk_3DBorder bgBorder; /* the background color */
+ int borderWidth; /* Width of 3-D borders. */
+ int relief; /* Indicates whether window as a whole is
+ * raised, sunken, or flat. */
+ int xon, xoff;
+ int yon, yoff;
+ Tk_Anchor anchor;
+ int filled;
+} GridFmtStruct;
+
+static TIX_DECLARE_SUBCMD(Tix_GrFormatBorder);
+static TIX_DECLARE_SUBCMD(Tix_GrFormatGrid);
+EXTERN TIX_DECLARE_SUBCMD(Tix_GrFormat);
+
+#ifdef ITCL_21
+
+/*
+ * ITcl 2.1 changed the definition of the constants for Tk configuration,
+ * e.g., TK_CONFIG_COLOR, etc. This problem doesn't appear in itcl 2.2.
+ */
+typedef Tk_ConfigProc * CFG_TYPE;
+
+#else
+
+typedef int CFG_TYPE;
+
+#endif
+
+static int Tix_GrSaveColor _ANSI_ARGS_((WidgetPtr wPtr,
+ CFG_TYPE type, void * ptr));
+static void GetBlockPosn _ANSI_ARGS_((WidgetPtr wPtr, int x1,
+ int y1, int x2, int y2, int * bx1, int * by1,
+ int * bx2, int * by2));
+static void GetRenderPosn _ANSI_ARGS_((WidgetPtr wPtr,
+ int bx1, int by1, int bx2, int by2, int * rx1,
+ int * ry1, int * rx2, int * ry2));
+static void Tix_GrFillCells _ANSI_ARGS_((WidgetPtr wPtr,
+ Tk_3DBorder border, Tk_3DBorder selectBorder,
+ int bx1, int by1, int bx2, int by2,
+ int borderWidth, int relief, int filled,
+ int bw[2][2]));
+static int GetInfo _ANSI_ARGS_((WidgetPtr wPtr,
+ Tcl_Interp *interp, int argc, char **argv,
+ FormatStruct * infoPtr,
+ Tk_ConfigSpec * configSpecs));
+
+#define DEF_GRID_ANCHOR "se"
+#define DEF_GRID_BORDER_XOFF "0"
+#define DEF_GRID_BORDER_XON "1"
+#define DEF_GRID_BORDER_YOFF "0"
+#define DEF_GRID_BORDER_YON "1"
+#define DEF_GRID_GRIDLINE_XOFF "0"
+#define DEF_GRID_GRIDLINE_XON "1"
+#define DEF_GRID_GRIDLINE_YOFF "0"
+#define DEF_GRID_GRIDLINE_YON "1"
+#define DEF_GRID_FILLED "0"
+#define DEF_GRID_BORDER_COLOR NORMAL_BG
+#define DEF_GRID_BORDER_MONO WHITE
+#define DEF_GRID_GRIDLINE_COLOR BLACK
+#define DEF_GRID_GRIDLINE_MONO BLACK
+
+static Tk_ConfigSpec borderConfigSpecs[] = {
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_GRID_BG_COLOR, Tk_Offset(BorderFmtStruct, border),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_GRID_BG_MONO, Tk_Offset(BorderFmtStruct, 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_GRID_BORDER_WIDTH, Tk_Offset(BorderFmtStruct, borderWidth), 0},
+ {TK_CONFIG_BOOLEAN, "-filled", "filled", "Filled",
+ DEF_GRID_FILLED, Tk_Offset(BorderFmtStruct, filled), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_GRID_RELIEF, Tk_Offset(BorderFmtStruct, relief), 0},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_GRID_SELECT_BG_COLOR, Tk_Offset(BorderFmtStruct, selectBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_GRID_SELECT_BG_MONO, Tk_Offset(BorderFmtStruct, selectBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_INT, "-xoff", "xoff", "Xoff",
+ DEF_GRID_BORDER_XOFF, Tk_Offset(BorderFmtStruct, xoff), 0},
+ {TK_CONFIG_INT, "-xon", "xon", "Xon",
+ DEF_GRID_BORDER_XON, Tk_Offset(BorderFmtStruct, xon), 0},
+ {TK_CONFIG_INT, "-yoff", "yoff", "Yoff",
+ DEF_GRID_BORDER_YOFF, Tk_Offset(BorderFmtStruct, yoff), 0},
+ {TK_CONFIG_INT, "-yon", "yon", "Yon",
+ DEF_GRID_BORDER_YON, Tk_Offset(BorderFmtStruct, yon), 0},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+static Tk_ConfigSpec gridConfigSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_GRID_ANCHOR, Tk_Offset(GridFmtStruct, anchor), 0},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_GRID_BG_COLOR, Tk_Offset(GridFmtStruct, bgBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_GRID_BG_COLOR, Tk_Offset(GridFmtStruct, bgBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_BORDER, "-bordercolor", "borderColor", "BorderColor",
+ DEF_GRID_GRIDLINE_COLOR, Tk_Offset(GridFmtStruct, border),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-bordercolor", "borderColor", "BorderColor",
+ DEF_GRID_GRIDLINE_MONO, Tk_Offset(GridFmtStruct, 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_GRID_BORDER_WIDTH, Tk_Offset(GridFmtStruct, borderWidth), 0},
+ {TK_CONFIG_BOOLEAN, "-filled", "filled", "Filled",
+ DEF_GRID_FILLED, Tk_Offset(GridFmtStruct, filled), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_GRID_RELIEF, Tk_Offset(GridFmtStruct, relief), 0},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_GRID_SELECT_BG_COLOR, Tk_Offset(GridFmtStruct, selectBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_GRID_SELECT_BG_MONO, Tk_Offset(GridFmtStruct, selectBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_INT, "-xoff", "xoff", "Xoff",
+ DEF_GRID_GRIDLINE_XOFF, Tk_Offset(GridFmtStruct, xoff), 0},
+ {TK_CONFIG_INT, "-xon", "xon", "Xon",
+ DEF_GRID_GRIDLINE_XON, Tk_Offset(GridFmtStruct, xon), 0},
+ {TK_CONFIG_INT, "-yoff", "yoff", "Yoff",
+ DEF_GRID_GRIDLINE_YOFF, Tk_Offset(GridFmtStruct, yoff), 0},
+ {TK_CONFIG_INT, "-yon", "yon", "Yon",
+ DEF_GRID_GRIDLINE_YON, Tk_Offset(GridFmtStruct, yon), 0},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+int
+Tix_GrFormat(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ static Tix_SubCmdInfo subCmdInfo[] = {
+ {TIX_DEFAULT_LEN, "border", 4, TIX_VAR_ARGS, Tix_GrFormatBorder,
+ "x1 y1 x2 y2 ?option value ...?"},
+ {TIX_DEFAULT_LEN, "grid", 4, TIX_VAR_ARGS, Tix_GrFormatGrid,
+ "x1 y1 x2 y2 ?option value ...?"},
+ };
+ static Tix_CmdInfo cmdInfo = {
+ Tix_ArraySize(subCmdInfo), 1, TIX_VAR_ARGS, "?option? ?arg ...?",
+ };
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+
+ if (wPtr->renderInfo == NULL) {
+ Tcl_AppendResult(interp, "the \"format\" command can only be called ",
+ "by the -formatcmd handler of the tixGrid widget", NULL);
+ return TCL_ERROR;
+ }
+
+ return Tix_HandleSubCmds(&cmdInfo, subCmdInfo, clientData,
+ interp, argc+1, argv-1);
+}
+
+
+
+static int
+GetInfo(wPtr, interp, argc, argv, infoPtr, configSpecs)
+ WidgetPtr wPtr;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+ FormatStruct * infoPtr;
+ Tk_ConfigSpec * configSpecs;
+{
+ int temp;
+
+ if (argc < 4) {
+ return Tix_ArgcError(interp, argc+2, argv-2, 2, "x1 y1 x2 y2 ...");
+ }
+ if (Tcl_GetInt(interp, argv[0], &infoPtr->x1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[1], &infoPtr->y1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[2], &infoPtr->x2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[3], &infoPtr->y2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tk_ConfigureWidget(interp, wPtr->dispData.tkwin, configSpecs,
+ argc-4, argv+4, (char *)infoPtr, 0) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (infoPtr->x1 > infoPtr->x2) {
+ temp = infoPtr->x1;
+ infoPtr->x1 = infoPtr->x2;
+ infoPtr->x2 = temp;
+ }
+ if (infoPtr->y1 > infoPtr->y2) {
+ temp = infoPtr->y1;
+ infoPtr->y1 = infoPtr->y2;
+ infoPtr->y2 = temp;
+ }
+
+ /* trivial rejects */
+ if (infoPtr->x1 > wPtr->renderInfo->fmt.x2) {
+ return TCL_BREAK;
+ }
+ if (infoPtr->x2 < wPtr->renderInfo->fmt.x1) {
+ return TCL_BREAK;
+ }
+ if (infoPtr->y1 > wPtr->renderInfo->fmt.y2) {
+ return TCL_BREAK;
+ }
+ if (infoPtr->y2 < wPtr->renderInfo->fmt.y1) {
+ return TCL_BREAK;
+ }
+
+ /* the area is indeed visible, do some clipping */
+ if (infoPtr->x1 < wPtr->renderInfo->fmt.x1) {
+ infoPtr->x1 = wPtr->renderInfo->fmt.x1;
+ }
+ if (infoPtr->x2 > wPtr->renderInfo->fmt.x2) {
+ infoPtr->x2 = wPtr->renderInfo->fmt.x2;
+ }
+ if (infoPtr->y1 < wPtr->renderInfo->fmt.y1) {
+ infoPtr->y1 = wPtr->renderInfo->fmt.y1;
+ }
+ if (infoPtr->y2 > wPtr->renderInfo->fmt.y2) {
+ infoPtr->y2 = wPtr->renderInfo->fmt.y2;
+ }
+
+ return TCL_OK;
+}
+
+static void
+GetBlockPosn(wPtr, x1, y1, x2, y2, bx1, by1, bx2, by2)
+ WidgetPtr wPtr;
+ int x1; /* cell index */
+ int x2;
+ int y1;
+ int y2;
+ int * bx1; /* block index */
+ int * by1;
+ int * bx2;
+ int * by2;
+{
+ *bx1 = x1;
+ *bx2 = x2;
+ *by1 = y1;
+ *by2 = y2;
+
+ switch (wPtr->renderInfo->fmt.whichArea) {
+ case TIX_S_MARGIN:
+ break;
+ case TIX_X_MARGIN:
+ *bx1 -= wPtr->scrollInfo[0].offset;
+ *bx2 -= wPtr->scrollInfo[0].offset;
+ break;
+ case TIX_Y_MARGIN:
+ *by1 -= wPtr->scrollInfo[1].offset;
+ *by2 -= wPtr->scrollInfo[1].offset;
+ break;
+ case TIX_MAIN:
+ *bx1 -= wPtr->scrollInfo[0].offset;
+ *bx2 -= wPtr->scrollInfo[0].offset;
+ *by1 -= wPtr->scrollInfo[1].offset;
+ *by2 -= wPtr->scrollInfo[1].offset;
+ break;
+ }
+}
+
+static void
+GetRenderPosn(wPtr, bx1, by1, bx2, by2, rx1, ry1, rx2, ry2)
+ WidgetPtr wPtr;
+ int bx1; /* block index */
+ int by1;
+ int bx2;
+ int by2;
+ int * rx1; /* render buffer position */
+ int * ry1;
+ int * rx2;
+ int * ry2;
+{
+ int x, y, i;
+
+
+ for (x=0,i=0; i<=bx2; i++) {
+ if (i == bx1) {
+ *rx1 = x;
+ }
+ if (i == bx2) {
+ *rx2 = x + wPtr->mainRB->dispSize[0][i].total - 1;
+ break;
+
+ }
+ x += wPtr->mainRB->dispSize[0][i].total;
+ }
+
+
+ for (y=0,i=0; i<=by2; i++) {
+ if (i == by1) {
+ *ry1 = y;
+ }
+ if (i == by2) {
+ *ry2 = y + wPtr->mainRB->dispSize[1][i].total - 1;
+ break;
+ }
+ y += wPtr->mainRB->dispSize[1][i].total;
+ }
+
+ *rx1 += wPtr->renderInfo->origin[0];
+ *rx2 += wPtr->renderInfo->origin[0];
+ *ry1 += wPtr->renderInfo->origin[1];
+ *ry2 += wPtr->renderInfo->origin[1];
+}
+
+static void
+Tix_GrFillCells(wPtr, border, selectBorder, bx1, by1, bx2, by2,
+ borderWidth, relief, filled, bw)
+ WidgetPtr wPtr;
+ Tk_3DBorder border;
+ Tk_3DBorder selectBorder;
+ int bx1;
+ int by1;
+ int bx2;
+ int by2;
+ int borderWidth;
+ int relief;
+ int filled;
+ int bw[2][2];
+{
+ int rx1, ry1, rx2, ry2;
+ int i, j;
+ Tk_3DBorder targetBorder;
+
+ for (i=bx1; i<=bx2; i++) {
+ for (j=by1; j<=by2; j++) {
+
+ if (filled) {
+ GetRenderPosn(wPtr, i, j, i, j, &rx1,&ry1, &rx2,&ry2);
+
+ if (wPtr->mainRB->elms[i][j].selected) {
+ targetBorder = selectBorder;
+ } else {
+ targetBorder = border;
+ }
+
+ Tk_Fill3DRectangle(wPtr->dispData.tkwin,
+ wPtr->renderInfo->drawable,
+ targetBorder, rx1, ry1, rx2-rx1+1, ry2-ry1+1,
+ 0, TK_RELIEF_FLAT);
+
+ wPtr->mainRB->elms[i][j].filled = 1;
+ } else {
+ if (!wPtr->mainRB->elms[i][j].filled) {
+ if (i == bx1) {
+ if (wPtr->mainRB->elms[i][j].borderW[0][0] < bw[0][0]){
+ wPtr->mainRB->elms[i][j].borderW[0][0] = bw[0][0];
+ }
+ }
+ if (i == bx2) {
+ if (wPtr->mainRB->elms[i][j].borderW[0][1] < bw[0][1]){
+ wPtr->mainRB->elms[i][j].borderW[0][1] = bw[0][1];
+ }
+ }
+ if (j == by1) {
+ if (wPtr->mainRB->elms[i][j].borderW[1][0] < bw[1][0]){
+ wPtr->mainRB->elms[i][j].borderW[1][0] = bw[1][0];
+ }
+ }
+ if (j == by2) {
+ if (wPtr->mainRB->elms[i][j].borderW[1][1] < bw[1][1]){
+ wPtr->mainRB->elms[i][j].borderW[1][1] = bw[1][1];
+ }
+ }
+ }
+ }
+ }
+ }
+ if (borderWidth > 0) {
+ GetRenderPosn(wPtr, bx1, by1, bx2, by2, &rx1,&ry1, &rx2,&ry2);
+
+ if (bx1 == bx2 && by1 == by2) {
+ /* special case: if a single cell is selected, we invert the
+ * border */
+
+ if (wPtr->mainRB->elms[bx1][by1].selected) {
+ if (relief == TK_RELIEF_RAISED) {
+ relief = TK_RELIEF_SUNKEN;
+ }
+ else if (relief == TK_RELIEF_SUNKEN) {
+ relief = TK_RELIEF_RAISED;
+ }
+ }
+ }
+
+ Tk_Draw3DRectangle(wPtr->dispData.tkwin,
+ wPtr->renderInfo->drawable,
+ border, rx1, ry1, rx2-rx1+1, ry2-ry1+1,
+ borderWidth, relief);
+ }
+}
+
+static int
+Tix_GrFormatBorder(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ BorderFmtStruct info;
+ int code = TCL_OK;
+ int bx1, bx2, by1, by2;
+ int i, j;
+
+ info.x1 = 0;
+ info.y1 = 0;
+ info.x2 = 0;
+ info.y2 = 0;
+ info.border = NULL;
+ info.borderWidth = 0;
+ info.selectBorder = NULL;
+ info.relief = TK_RELIEF_FLAT;
+ info.xon = 0;
+ info.xoff = 0;
+ info.yon = 0;
+ info.yoff = 0;
+ info.filled = 0;
+
+ if ((code = GetInfo(wPtr, interp, argc, argv, (FormatStruct*)&info,
+ borderConfigSpecs))!= TCL_OK) {
+ goto done;
+ }
+
+ /*
+ * If the xon is not specified, then by default the xon is encloses the
+ * whole region. Same for yon.
+ */
+ if (info.xon == 0) {
+ info.xon = info.x2 - info.x1 + 1;
+ info.xoff = 0;
+ }
+ if (info.yon == 0) {
+ info.yon = info.y2 - info.y1 + 1;
+ info.yoff = 0;
+ }
+
+ GetBlockPosn(wPtr, info.x1, info.y1, info.x2, info.y2,
+ &bx1, &by1, &bx2, &by2);
+
+#if 0
+ /* now it works */
+#ifdef _WINDOWS
+ if (bx1 == 0 && bx2 == 0 && by1 == 0 && by2 == 0) {
+ /* some how this doesn't work in BC++ 4.5 */
+ goto done;
+ }
+#endif
+#endif
+
+ for (i=bx1; i<=bx2; i+=(info.xon+info.xoff)) {
+ for (j=by1; j<=by2; j+=(info.yon+info.yoff)) {
+ int _bx1, _by1, _bx2, _by2;
+ int borderWidths[2][2];
+
+ _bx1 = i;
+ _bx2 = i+info.xon-1;
+ _by1 = j;
+ _by2 = j+info.yon-1;
+
+ if (_bx2 > bx2) {
+ _bx2 = bx2;
+ }
+ if (_by2 > by2) {
+ _by2 = by2;
+ }
+
+ borderWidths[0][0] = info.borderWidth;
+ borderWidths[0][1] = info.borderWidth;
+ borderWidths[1][0] = info.borderWidth;
+ borderWidths[1][1] = info.borderWidth;
+
+ Tix_GrFillCells(wPtr, info.border, info.selectBorder,
+ _bx1, _by1, _bx2, _by2,
+ info.borderWidth, info.relief, info.filled, borderWidths);
+ }
+ }
+
+ done:
+ if (code == TCL_BREAK) {
+ code = TCL_OK;
+ }
+ if (code == TCL_OK) {
+ if (Tix_GrSaveColor(wPtr, TK_CONFIG_BORDER, (void*)info.border) == 0) {
+ info.border = (Tk_3DBorder)NULL;
+ }
+ if (Tix_GrSaveColor(wPtr, TK_CONFIG_BORDER, (void*)info.selectBorder)
+ == 0) {
+ info.selectBorder = (Tk_3DBorder)NULL;
+ }
+ Tk_FreeOptions(borderConfigSpecs, (char *)&info,
+ wPtr->dispData.display, 0);
+ }
+ return code;
+}
+
+static int
+Tix_GrFormatGrid(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ GridFmtStruct info;
+ int code = TCL_OK;
+ int rx1, rx2, ry1, ry2;
+ int bx1, bx2, by1, by2;
+ int i, j;
+ GC gc;
+ int borderWidths[2][2];
+
+ info.x1 = 0;
+ info.y1 = 0;
+ info.x2 = 0;
+ info.y2 = 0;
+ info.border = NULL;
+ info.selectBorder = NULL;
+ info.bgBorder = NULL;
+ info.borderWidth = 0;
+ info.relief = TK_RELIEF_FLAT;
+ info.xon = 1;
+ info.xoff = 0;
+ info.yon = 1;
+ info.yoff = 0;
+ info.filled = 0;
+
+ if ((code = GetInfo(wPtr, interp, argc, argv, (FormatStruct*)&info,
+ gridConfigSpecs))!= TCL_OK) {
+ goto done;
+ }
+ gc = Tk_3DBorderGC(wPtr->dispData.tkwin, info.border,
+ TK_3D_FLAT_GC);
+
+ GetBlockPosn(wPtr, info.x1, info.y1, info.x2, info.y2,
+ &bx1, &by1, &bx2, &by2);
+
+ borderWidths[0][0] = 0;
+ borderWidths[0][1] = 0;
+ borderWidths[1][0] = 0;
+ borderWidths[1][1] = 0;
+
+ switch(info.anchor) {
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_NW:
+ borderWidths[1][0] = info.borderWidth;
+ break;
+ default:
+ ; /* do nothing. This line gets rid of compiler warnings */
+ }
+ switch(info.anchor) {
+ case TK_ANCHOR_SE:
+ case TK_ANCHOR_S:
+ case TK_ANCHOR_SW:
+ borderWidths[1][1] = info.borderWidth;
+ break;
+ default:
+ ; /* do nothing. This line gets rid of compiler warnings */
+ }
+ switch(info.anchor) {
+ case TK_ANCHOR_SW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_NW:
+ borderWidths[0][0] = info.borderWidth;
+ break;
+ default:
+ ; /* do nothing. This line gets rid of compiler warnings */
+ }
+ switch(info.anchor) {
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_E:
+ case TK_ANCHOR_SE:
+ borderWidths[0][1] = info.borderWidth;
+ break;
+ default:
+ ; /* do nothing. This line gets rid of compiler warnings */
+ }
+
+ for (i=bx1; i<=bx2; i+=(info.xon+info.xoff)) {
+ for (j=by1; j<=by2; j+=(info.yon+info.yoff)) {
+ int _bx1, _by1, _bx2, _by2;
+
+ _bx1 = i;
+ _bx2 = i+info.xon-1;
+ _by1 = j;
+ _by2 = j+info.yon-1;
+
+ if (_bx2 > bx2) {
+ _bx2 = bx2;
+ }
+ if (_by2 > by2) {
+ _by2 = by2;
+ }
+
+ Tix_GrFillCells(wPtr, info.bgBorder, info.selectBorder,
+ _bx1, _by1, _bx2, _by2, 0, TK_RELIEF_FLAT, info.filled,
+ borderWidths);
+
+ if (info.borderWidth > 0) {
+ GetRenderPosn(wPtr, _bx1, _by1, _bx2, _by2,
+ &rx1,&ry1, &rx2,&ry2);
+
+ switch(info.anchor) {
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_NW:
+ XDrawLine(wPtr->dispData.display,
+ wPtr->renderInfo->drawable, gc,
+ rx1, ry1, rx2, ry1);
+ break;
+ default:
+ ; /* do nothing. This line gets rid of compiler warnings */
+ }
+ switch(info.anchor) {
+ case TK_ANCHOR_SE:
+ case TK_ANCHOR_S:
+ case TK_ANCHOR_SW:
+ XDrawLine(wPtr->dispData.display,
+ wPtr->renderInfo->drawable, gc,
+ rx1, ry2, rx2, ry2);
+ break;
+ default:
+ ; /* do nothing. This line gets rid of compiler warnings */
+ }
+ switch(info.anchor) {
+ case TK_ANCHOR_SW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_NW:
+ XDrawLine(wPtr->dispData.display,
+ wPtr->renderInfo->drawable, gc,
+ rx1, ry1, rx1, ry2);
+ break;
+ default:
+ ; /* do nothing. This line gets rid of compiler warnings */
+ }
+ switch(info.anchor) {
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_E:
+ case TK_ANCHOR_SE:
+ XDrawLine(wPtr->dispData.display,
+ wPtr->renderInfo->drawable, gc,
+ rx2, ry1, rx2, ry2);
+ break;
+ default:
+ ; /* do nothing. This line gets rid of compiler warnings */
+ }
+ }
+ }
+ }
+
+ done:
+ if (code == TCL_BREAK) {
+ code = TCL_OK;
+ }
+ if (code == TCL_OK) {
+ if (Tix_GrSaveColor(wPtr, TK_CONFIG_BORDER, (void*)info.border) == 0) {
+ info.border = (Tk_3DBorder)NULL;
+ }
+ if (Tix_GrSaveColor(wPtr, TK_CONFIG_BORDER, (void*)info.bgBorder)==0) {
+ info.bgBorder = (Tk_3DBorder)NULL;
+ }
+ if (Tix_GrSaveColor(wPtr, TK_CONFIG_BORDER, (void*)info.selectBorder)
+ == 0) {
+ info.selectBorder = (Tk_3DBorder)NULL;
+ }
+ Tk_FreeOptions(gridConfigSpecs, (char *)&info, wPtr->dispData.display,
+ 0);
+ }
+ return code;
+}
+
+
+/* returns 1 if the caller can free the border/color */
+static int Tix_GrSaveColor(wPtr, type, ptr)
+ WidgetPtr wPtr;
+ CFG_TYPE type;
+ void * ptr;
+{
+ Tk_3DBorder border;
+ XColor * color;
+ long pixel;
+ Tix_ListIterator li;
+ int found;
+ ColorInfo * cPtr;
+
+ if (type == TK_CONFIG_COLOR) {
+ color = (XColor *)ptr;
+ pixel = color->pixel;
+ } else {
+ border = (Tk_3DBorder)ptr;
+ pixel = Tk_3DBorderColor(border)->pixel;
+ }
+
+ Tix_SimpleListIteratorInit(&li);
+ for (found = 0, Tix_SimpleListStart(&wPtr->colorInfo, &li);
+ !Tix_SimpleListDone(&li);
+ Tix_SimpleListNext (&wPtr->colorInfo, &li)) {
+
+ cPtr = (ColorInfo *)li.curr;
+ if (cPtr->pixel == pixel) {
+ cPtr->counter = wPtr->colorInfoCounter;
+ return 1;
+
+ }
+ }
+
+ cPtr = (ColorInfo *)ckalloc(sizeof(ColorInfo));
+
+ if (type == TK_CONFIG_COLOR) {
+ cPtr->color = color;
+ } else {
+ cPtr->border = border;
+ }
+ cPtr->type = (int)type;
+ cPtr->pixel = pixel;
+ cPtr->counter = wPtr->colorInfoCounter;
+
+ Tix_SimpleListAppend(&wPtr->colorInfo, (char*)cPtr, 0);
+ return 0;
+}
+
+void
+Tix_GrFreeUnusedColors(wPtr, freeAll)
+ WidgetPtr wPtr;
+ int freeAll;
+{
+ Tix_ListIterator li;
+ ColorInfo * cPtr;
+
+ Tix_SimpleListIteratorInit(&li);
+ for (Tix_SimpleListStart(&wPtr->colorInfo, &li);
+ !Tix_SimpleListDone(&li);
+ Tix_SimpleListNext (&wPtr->colorInfo, &li)) {
+
+ cPtr = (ColorInfo *)li.curr;
+ if (freeAll || cPtr->counter < wPtr->colorInfoCounter) {
+ Tix_SimpleListDelete(&wPtr->colorInfo, &li);
+
+ if (cPtr->type == (int)(TK_CONFIG_COLOR)) {
+ Tk_FreeColor(cPtr->color);
+ } else {
+ Tk_Free3DBorder(cPtr->border);
+ }
+ ckfree((char*)cPtr);
+ }
+ }
+}
diff --git a/tix/generic/tixGrRC.c b/tix/generic/tixGrRC.c
new file mode 100644
index 00000000000..920aca56412
--- /dev/null
+++ b/tix/generic/tixGrRC.c
@@ -0,0 +1,112 @@
+/*
+ * tixGrRC.c --
+ *
+ * This module handles "size" sub-commands.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixDef.h>
+#include <tixGrid.h>
+
+static TIX_DECLARE_SUBCMD(Tix_GrRCSize);
+EXTERN TIX_DECLARE_SUBCMD(Tix_GrSetSize);
+
+int
+Tix_GrSetSize(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ static Tix_SubCmdInfo subCmdInfo[] = {
+ {TIX_DEFAULT_LEN, "row", 1, TIX_VAR_ARGS, Tix_GrRCSize,
+ "index ?option value ...?"},
+ {TIX_DEFAULT_LEN, "column", 1, TIX_VAR_ARGS, Tix_GrRCSize,
+ "index ?option value ...?"},
+ };
+ static Tix_CmdInfo cmdInfo = {
+ Tix_ArraySize(subCmdInfo), 1, TIX_VAR_ARGS, "option index ?arg ...?",
+ };
+
+ return Tix_HandleSubCmds(&cmdInfo, subCmdInfo, clientData,
+ interp, argc+1, argv-1);
+}
+
+
+static int
+Tix_GrRCSize(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int which, index, code;
+ char errorMsg[300];
+ int changed;
+
+ if (argv[-1][0] == 'c') {
+ which = 0;
+ } else {
+ which = 1;
+ }
+ if (Tcl_GetInt(interp, argv[0], &index) != TCL_OK) {
+ size_t len = strlen(argv[0]);
+
+ Tcl_ResetResult(interp);
+ if (strncmp(argv[0], "default", len)!=0) {
+ Tcl_AppendResult(interp, "unknown option \"", argv[0],
+ "\"; must be an integer or \"default\"", NULL);
+ return TCL_ERROR;
+ } else {
+ /* Setting the default sizes */
+ sprintf(errorMsg, "%s %s ?option value ...?", argv[-2], argv[-1]);
+
+ code = Tix_GrConfigSize(interp, wPtr, argc-1, argv+1,
+ &wPtr->defSize[which],errorMsg, &changed);
+
+ /* Handling special cases */
+ if (code == TCL_OK) {
+ switch (wPtr->defSize[which].sizeType) {
+ case TIX_GR_DEFAULT:
+ wPtr->defSize[which].sizeType = TIX_GR_DEFINED_CHAR;
+ if (which == 0) {
+ wPtr->defSize[which].charValue = 10.0;
+ } else {
+ wPtr->defSize[which].charValue = 1.1;
+ }
+ }
+
+ switch (wPtr->defSize[which].sizeType) {
+ case TIX_GR_DEFINED_PIXEL:
+ wPtr->defSize[which].pixels=wPtr->defSize[which].sizeValue;
+ break;
+
+ case TIX_GR_DEFINED_CHAR:
+ wPtr->defSize[which].pixels =
+ (int)(wPtr->defSize[which].charValue *
+ wPtr->fontSize[which]);
+ break;
+ }
+ }
+ }
+ } else {
+ sprintf(errorMsg, "%s %s ?option value ...?", argv[-2], argv[-1]);
+
+ code = TixGridDataConfigRowColSize(interp, wPtr, wPtr->dataSet,
+ which, index, argc-1, argv+1, errorMsg, &changed);
+ }
+
+ if (changed) {
+ Tix_GrDoWhenIdle(wPtr, TIX_GR_RESIZE);
+ }
+
+ return code;
+}
diff --git a/tix/generic/tixGrSel.c b/tix/generic/tixGrSel.c
new file mode 100644
index 00000000000..9f45de68507
--- /dev/null
+++ b/tix/generic/tixGrSel.c
@@ -0,0 +1,302 @@
+/*
+ * tixGrSel.c --
+ *
+ * This module handles the selection
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixDef.h>
+#include <tixGrid.h>
+
+EXTERN TIX_DECLARE_SUBCMD(Tix_GrSelection);
+static TIX_DECLARE_SUBCMD(Tix_GrSelIncludes);
+static TIX_DECLARE_SUBCMD(Tix_GrSelModify);
+
+static int Tix_GrSelIncludes _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void Tix_GrAdjustSelection _ANSI_ARGS_((
+ WidgetPtr wPtr, SelectBlock * sbPtr));
+static void Tix_GrMergeSelection _ANSI_ARGS_((
+ WidgetPtr wPtr, SelectBlock * sbPtr));
+static int Intersect _ANSI_ARGS_((SelectBlock * s1,
+ SelectBlock * s2));
+static int Include _ANSI_ARGS_((SelectBlock * s1,
+ SelectBlock * s2));
+
+int
+Tix_GrSelection(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ static Tix_SubCmdInfo subCmdInfo[] = {
+ {TIX_DEFAULT_LEN, "adjust", 2, 4, Tix_GrSelModify,
+ "x1 y1 ?x2 y2?"},
+ {TIX_DEFAULT_LEN, "clear", 2, 4, Tix_GrSelModify,
+ "x1 y1 ?x2 y2?"},
+ {TIX_DEFAULT_LEN, "includes", 2, 4, Tix_GrSelIncludes,
+ "x1 y1 ?x2 y2?"},
+ {TIX_DEFAULT_LEN, "set", 2, 4, Tix_GrSelModify,
+ "x1 y1 ?x2 y2?"},
+ {TIX_DEFAULT_LEN, "toggle", 2, 4, Tix_GrSelModify,
+ "x1 y1 ?x2 y2?"},
+ };
+ static Tix_CmdInfo cmdInfo = {
+ Tix_ArraySize(subCmdInfo), 1, TIX_VAR_ARGS, "?option? ?arg ...?",
+ };
+
+ return Tix_HandleSubCmds(&cmdInfo, subCmdInfo, clientData,
+ interp, argc+1, argv-1);
+}
+
+static int
+Tix_GrSelIncludes(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+#if 0
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+#endif
+ return TCL_OK;
+}
+
+static int Intersect(s1, s2)
+ SelectBlock * s1;
+ SelectBlock * s2;
+{
+ return 0;
+}
+
+static int Include(s1, s2)
+ SelectBlock * s1;
+ SelectBlock * s2;
+{
+ return 0;
+}
+
+static void
+Tix_GrMergeSelection(wPtr, sbPtr)
+ WidgetPtr wPtr;
+ SelectBlock * sbPtr;
+{
+ Tix_ListIterator li;
+
+ switch (sbPtr->type) {
+ case TIX_GR_SET:
+ case TIX_GR_CLEAR:
+ if (sbPtr->range[0][0] == 0 &&
+ sbPtr->range[1][0] == 0 &&
+ sbPtr->range[0][1] == TIX_GR_MAX &&
+ sbPtr->range[1][1] == TIX_GR_MAX) {
+
+ /* clear everything else from the list
+ */
+ Tix_SimpleListIteratorInit(&li);
+
+ for (Tix_SimpleListStart(&wPtr->selList, &li);
+ !Tix_SimpleListDone(&li);
+ Tix_SimpleListNext (&wPtr->selList, &li)) {
+
+ SelectBlock *ptr = (SelectBlock *)li.curr;
+ Tix_SimpleListDelete(&wPtr->selList, &li);
+ ckfree((char*)ptr);
+ }
+ }
+ if (sbPtr->type == TIX_GR_SET) {
+ Tix_SimpleListAppend(&wPtr->selList, (char*)sbPtr, 0);
+ }
+ goto done;
+ }
+
+#if 0
+
+ switch (sbPtr->type) {
+ case TIX_GR_TOGGLE: {
+ }
+ break;
+ case TIX_GR_SET: {
+ Tix_SimpleListAppend(&wPtr->selList, (char*)sbPtr, 0);
+ }
+ break;
+ case TIX_GR_CLEAR: {
+ Tix_SimpleListIteratorInit(&li);
+
+ for (Tix_SimpleListStart(&wPtr->selList, &li);
+ !Tix_SimpleListDone(&li);
+ Tix_SimpleListNext (&wPtr->selList, &li)) {
+ }
+ }
+
+ }
+#else
+
+ Tix_SimpleListAppend(&wPtr->selList, (char*)sbPtr, 0);
+
+#endif
+
+ done:
+ Tix_GrAddChangedRect(wPtr, sbPtr->range, 0);
+}
+
+static void
+Tix_GrAdjustSelection(wPtr, sbPtr)
+ WidgetPtr wPtr;
+ SelectBlock * sbPtr;
+{
+ int changed[2][2];
+ SelectBlock * current;
+
+ current = (SelectBlock*)wPtr->selList.tail;
+
+ /*
+ * The changed region is the union of the area of the current selection
+ * and the adjusted selection.
+ */
+ changed[TIX_X][0] = sbPtr->range[TIX_X][0];
+ changed[TIX_X][1] = sbPtr->range[TIX_X][1];
+ changed[TIX_Y][0] = sbPtr->range[TIX_Y][0];
+ changed[TIX_Y][1] = sbPtr->range[TIX_Y][1];
+
+ if (changed[TIX_X][0] > current->range[TIX_X][0]) {
+ changed[TIX_X][0] = current->range[TIX_X][0];
+ }
+ if (changed[TIX_X][1] < current->range[TIX_X][1]) {
+ changed[TIX_X][1] = current->range[TIX_X][1];
+ }
+ if (changed[TIX_Y][0] > current->range[TIX_Y][0]) {
+ changed[TIX_Y][0] = current->range[TIX_Y][0];
+ }
+ if (changed[TIX_Y][1] < current->range[TIX_Y][1]) {
+ changed[TIX_Y][1] = current->range[TIX_Y][1];
+ }
+
+ /* Adjust the current selection according to sbPtr */
+ current->range[TIX_X][0] = sbPtr->range[TIX_X][0];
+ current->range[TIX_X][1] = sbPtr->range[TIX_X][1];
+ current->range[TIX_Y][0] = sbPtr->range[TIX_Y][0];
+ current->range[TIX_Y][1] = sbPtr->range[TIX_Y][1];
+
+ /* Set the changed area */
+ Tix_GrAddChangedRect(wPtr, changed, 0);
+
+ /* sbPtr is no longer needed */
+ ckfree((char*)sbPtr);
+}
+
+static int
+Tix_GrSelModify(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int type, adjust = 0;
+ SelectBlock * sbPtr = NULL;
+ int tmp;
+
+ if (argc != 2 && argc != 4) {
+ return Tix_ArgcError(interp, argc+2, argv-2, 2, "x1 y1 ?x2 y2?");
+ }
+
+ /*
+ * (1) find out the type of operation.
+ */
+ if (argv[-1][0] == 'a') {
+ if (wPtr->selList.numItems <= 0) {
+ /*
+ * There is nothing in the selection list to adjust!
+ */
+ Tcl_AppendResult(interp, "selection list is empty", NULL);
+ return TCL_ERROR;
+ }
+ adjust = 1;
+ }
+ else if (argv[-1][0] == 'c') {
+ type = TIX_GR_CLEAR;
+ }
+ else if (argv[-1][0] == 's') {
+ type = TIX_GR_SET;
+ }
+ else {
+ type = TIX_GR_TOGGLE;
+ }
+
+ sbPtr = (SelectBlock*)ckalloc(sizeof(SelectBlock));
+ sbPtr->type = type;
+
+ if (Tcl_GetInt(interp, argv[0], &sbPtr->range[0][0]) != TCL_OK) {
+ goto error;
+ }
+ if (Tcl_GetInt(interp, argv[1], &sbPtr->range[1][0]) != TCL_OK) {
+ goto error;
+ }
+ if (argc == 4) {
+ if (Tcl_GetInt(interp, argv[2], &sbPtr->range[0][1]) != TCL_OK) {
+ if (strcmp(argv[2], "max") == 0) {
+ Tcl_ResetResult(interp);
+ sbPtr->range[0][1] = TIX_GR_MAX;
+ } else {
+ goto error;
+ }
+ }
+ if (Tcl_GetInt(interp, argv[3], &sbPtr->range[1][1]) != TCL_OK) {
+ if (strcmp(argv[3], "max") == 0) {
+ Tcl_ResetResult(interp);
+ sbPtr->range[1][1] = TIX_GR_MAX;
+ } else {
+ goto error;
+ }
+ }
+ } else {
+ sbPtr->range[0][1] = sbPtr->range[0][0];
+ sbPtr->range[1][1] = sbPtr->range[1][0];
+ }
+
+ if (wPtr->selectUnit != tixRowUid) {
+ if (sbPtr->range[0][0] > sbPtr->range[0][1]) {
+ tmp = sbPtr->range[0][1];
+ sbPtr->range[0][1] = sbPtr->range[0][0];
+ sbPtr->range[0][0] = tmp;
+ }
+ } else {
+ sbPtr->range[0][0] = 0;
+ sbPtr->range[0][1] = TIX_GR_MAX;
+ }
+
+ if (wPtr->selectUnit != tixColumnUid) {
+ if (sbPtr->range[1][0] > sbPtr->range[1][1]) {
+ tmp = sbPtr->range[1][1];
+ sbPtr->range[1][1] = sbPtr->range[1][0];
+ sbPtr->range[1][0] = tmp;
+ }
+ } else {
+ sbPtr->range[1][0] = 0;
+ sbPtr->range[1][1] = TIX_GR_MAX;
+ }
+
+ if (adjust) {
+ Tix_GrAdjustSelection(wPtr, sbPtr);
+ sbPtr = NULL;
+ } else {
+ Tix_GrMergeSelection(wPtr, sbPtr);
+ }
+ wPtr->toComputeSel = 1;
+ return TCL_OK;
+
+ error:
+ if (sbPtr) {
+ ckfree((char*)sbPtr);
+ }
+ return TCL_ERROR;
+}
diff --git a/tix/generic/tixGrSort.c b/tix/generic/tixGrSort.c
new file mode 100644
index 00000000000..2be59eb76fb
--- /dev/null
+++ b/tix/generic/tixGrSort.c
@@ -0,0 +1,461 @@
+/*
+ * tixGrSel.c --
+ *
+ * This module handles the sorting of the Grid widget.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixGrid.h>
+
+/*
+ * The variables below are used to implement the "lsort" command.
+ * Unfortunately, this use of static variables prevents "lsort"
+ * from being thread-safe, but there's no alternative given the
+ * current implementation of qsort. In a threaded environment
+ * these variables should be made thread-local if possible, or else
+ * "lsort" needs internal mutual exclusion.
+ */
+
+static Tcl_Interp *sortInterp = NULL; /* Interpreter for "lsort" command.
+ * NULL means no lsort is active. */
+static enum {ASCII, INTEGER, REAL, COMMAND} sortMode;
+ /* Mode for sorting:compare as strings,
+ * compare as numbers, or call
+ * user-defined command for
+ * comparison. */
+static Tcl_DString sortCmd; /* Holds command if mode is COMMAND.
+ * pre-initialized to hold base of
+ * command. */
+static int sortIncreasing; /* 0 means sort in decreasing order,
+ * 1 means increasing order. */
+static int sortCode; /* Anything other than TCL_OK means a
+ * problem occurred while sorting; this
+ * executing a comparison command, so
+ * the sort was aborted. */
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+EXTERN TIX_DECLARE_SUBCMD(Tix_GrSort);
+
+static int SortCompareProc _ANSI_ARGS_((CONST VOID *first,
+ CONST VOID *second));
+char * Tix_GrGetCellText _ANSI_ARGS_((WidgetPtr wPtr,
+ int x, int y));
+Tix_GrSortItem * Tix_GrGetSortItems _ANSI_ARGS_((WidgetPtr wPtr,
+ int axis, int start, int end, int sortKeyIndex));
+void Tix_GrFreeSortItems _ANSI_ARGS_((WidgetPtr wPtr,
+ Tix_GrSortItem * items, int numItems));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_LsortCmd --
+ *
+ * This procedure is invoked to process the "lsort" Tcl command.
+ * See the user documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+
+char *
+Tix_GrGetCellText(wPtr, x, y)
+ WidgetPtr wPtr;
+ int x;
+ int y;
+{
+ TixGrEntry* chPtr;
+
+ if ((chPtr = (TixGrEntry*) TixGridDataFindEntry(wPtr->dataSet, x, y))) {
+ switch (Tix_DItemType(chPtr->iPtr)) {
+ case TIX_DITEM_TEXT:
+ return chPtr->iPtr->text.text;
+ case TIX_DITEM_IMAGETEXT:
+ return chPtr->iPtr->imagetext.text;
+ default:
+ return NULL;
+ }
+ } else {
+ return NULL;
+ }
+}
+
+Tix_GrSortItem *
+Tix_GrGetSortItems(wPtr, axis, start, end, sortKeyIndex)
+ WidgetPtr wPtr;
+ int axis;
+ int start;
+ int end;
+ int sortKeyIndex;
+{
+ int i, k, numItems;
+ Tix_GrSortItem *items;
+
+ if (end <= start) {
+ /* sanity check: no need to sort */
+ return (Tix_GrSortItem *) NULL;
+ }
+
+ numItems = end-start+1;
+ items = (Tix_GrSortItem *)ckalloc(sizeof(Tix_GrSortItem) * numItems);
+
+ for (k=0,i=start; i<=end; i++, k++) {
+ items[k].index = i;
+ if (axis == 0) {
+ items[k].data = Tix_GrGetCellText(wPtr, i, sortKeyIndex);
+ } else {
+ items[k].data = Tix_GrGetCellText(wPtr, sortKeyIndex, i);
+ }
+ }
+
+ return items;
+}
+
+
+void
+Tix_GrFreeSortItems(wPtr, items, numItems)
+ WidgetPtr wPtr;
+ Tix_GrSortItem * items;
+ int numItems;
+{
+ ckfree((char*)items);
+}
+
+int
+Tix_GrSort(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int i, axis, otherAxis, start, end;
+ size_t len;
+ Tix_GrSortItem *items = NULL;
+ int numItems;
+ char *command = NULL; /* Initialization needed only to
+ * prevent compiler warning. */
+ int sortKeyIndex;
+ int gridSize[2];
+
+ /*-------------------------------------------------------------------
+ * Argument parsing
+ *-------------------------------------------------------------------
+ */
+ if (sortInterp != NULL) {
+ interp->result = "can't invoke the tixGrid sort command recursively";
+ return TCL_ERROR;
+ }
+
+ /* Figure out the sorting dimension
+ */
+ len = strlen(argv[0]);
+ if (strncmp(argv[0], "rows", len)==0) {
+ axis = 1;
+ otherAxis = 0;
+ } else if (strncmp(argv[0], "column", len)==0) {
+ axis = 0;
+ otherAxis = 1;
+ } else {
+ Tcl_AppendResult(interp, "wrong dimension \"", argv[0],
+ "\", should be row or column", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /* get the start and end index
+ */
+ if (axis == 0) {
+ if (TixGridDataGetIndex(interp, wPtr, argv[1], NULL, &start, NULL)
+ !=TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (TixGridDataGetIndex(interp, wPtr, argv[2], NULL, &end, NULL)
+ !=TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ if (TixGridDataGetIndex(interp, wPtr, NULL, argv[1], NULL, &start)
+ !=TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (TixGridDataGetIndex(interp, wPtr, NULL, argv[2], NULL, &end)
+ !=TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /* Check the range
+ */
+ TixGridDataGetGridSize(wPtr->dataSet, &gridSize[0], &gridSize[1]);
+ if (start > end) {
+ int tmp = start;
+ start = end;
+ end = tmp;
+ }
+ if (start >= gridSize[axis]) {
+ /* no need to sort */
+ return TCL_OK;
+ }
+ if (end == start) {
+ /* no need to sort */
+ return TCL_OK;
+ }
+
+ /* get the options
+ */
+ if ((argc-3) %2 != 0) {
+ Tcl_AppendResult(interp, "value for \"", argv[argc-1],
+ "\" missing", NULL);
+ return TCL_ERROR;
+ }
+ sortInterp = interp;
+ sortMode = ASCII;
+ sortIncreasing = 1;
+ sortCode = TCL_OK;
+ sortKeyIndex = wPtr->hdrSize[otherAxis]; /* by default, use the first
+ * scrollable item as the key
+ */
+ for (i=3; i<argc; i+=2) {
+ len = strlen(argv[i]);
+ if (strncmp(argv[i], "-type", len) == 0) {
+ if (strcmp(argv[i+1], "ascii") == 0) {
+ sortMode = ASCII;
+ } else if (strcmp(argv[i+1], "integer") == 0) {
+ sortMode = INTEGER;
+ } else if (strcmp(argv[i+1], "real") == 0) {
+ sortMode = REAL;
+ } else {
+ Tcl_AppendResult(interp, "wrong type \"", argv[i+1],
+ "\": must be ascii, integer or real", (char *) NULL);
+ sortCode = TCL_ERROR;
+ goto done;
+ }
+ }
+ else if (strncmp(argv[i], "-order", len) == 0) {
+ if (strcmp(argv[i+1], "increasing") == 0) {
+ sortIncreasing = 1;
+ } else if (strcmp(argv[i+1], "decreasing") == 0) {
+ sortIncreasing = 0;
+ } else {
+ Tcl_AppendResult(interp, "wrong order \"", argv[i+1],
+ "\": must be increasing or decreasing", (char *) NULL);
+ sortCode = TCL_ERROR;
+ goto done;
+ }
+ }
+ else if (strncmp(argv[i], "-key", len) == 0) {
+ if (axis == 0) {
+ /* sort columns: the key is a column index (1) */
+ if (TixGridDataGetIndex(interp, wPtr, NULL, argv[i+1], NULL,
+ &sortKeyIndex) !=TCL_OK) {
+ sortCode = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ /* sort rows: the key is a row index (0)*/
+ if (TixGridDataGetIndex(interp, wPtr, argv[i+1], NULL,
+ &sortKeyIndex, NULL) !=TCL_OK) {
+ sortCode = TCL_ERROR;
+ goto done;
+ }
+ }
+ }
+ else if (strncmp(argv[i], "-command", len) == 0) {
+ sortMode = COMMAND;
+ command = argv[i+1];
+ }
+ else {
+ Tcl_AppendResult(interp, "wrong option \"", argv[i],
+ "\": must be -command, -key, -order or -type", (char *) NULL);
+ sortCode = TCL_ERROR;
+ goto done;
+ }
+ }
+ if (sortMode == COMMAND) {
+ Tcl_DStringInit(&sortCmd);
+ Tcl_DStringAppend(&sortCmd, command, -1);
+ }
+
+ /*------------------------------------------------------------------
+ * SORTING
+ *------------------------------------------------------------------
+ */
+ /* prepare the array to be sorted */
+ numItems = end - start + 1;
+ items = Tix_GrGetSortItems(wPtr, axis, start, end, sortKeyIndex);
+
+ if (items != NULL) {
+ int sizeChanged;
+
+ qsort((VOID *)items, (size_t)numItems, sizeof(Tix_GrSortItem),
+ SortCompareProc);
+
+ for (i=0; i<numItems; i++) {
+ printf("%d\n", items[i].index);
+ }
+ sizeChanged = TixGridDataUpdateSort(wPtr->dataSet, axis, start, end,
+ items);
+ if (sizeChanged) {
+ Tix_GrDoWhenIdle(wPtr, TIX_GR_RESIZE);
+ } else {
+ wPtr->toResetRB = 1;
+ Tix_GrDoWhenIdle(wPtr, TIX_GR_REDRAW);
+ }
+
+ Tix_GrFreeSortItems(wPtr, items, numItems);
+ }
+
+ /* Done */
+ if (sortCode == TCL_OK) {
+ Tcl_ResetResult(interp);
+ }
+ if (sortMode == COMMAND) {
+ Tcl_DStringFree(&sortCmd);
+ }
+
+ done:
+ sortInterp = NULL;
+ return sortCode;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SortCompareProc --
+ *
+ * This procedure is invoked by qsort to determine the proper
+ * ordering between two elements.
+ *
+ * Results:
+ * < 0 means first is "smaller" than "second", > 0 means "first"
+ * is larger than "second", and 0 means they should be treated
+ * as equal.
+ *
+ * Side effects:
+ * None, unless a user-defined comparison command does something
+ * weird.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SortCompareProc(first, second)
+ CONST VOID *first, *second; /* Elements to be compared. */
+{
+ int order;
+ char *firstString = ((Tix_GrSortItem*)first )->data;
+ char *secondString = ((Tix_GrSortItem*)second)->data;
+
+ order = 0;
+ if (sortCode != TCL_OK) {
+ /*
+ * Once an error has occurred, skip any future comparisons
+ * so as to preserve the error message in sortInterp->result.
+ */
+
+ return order;
+ }
+ if (firstString == NULL && secondString == NULL) {
+ /* equal */
+ return order;
+ }
+ if (secondString == NULL) {
+ /* first larger than second */
+ order = 1;
+ goto done;
+ }
+ if (firstString == NULL) {
+ order = -1;
+ goto done;
+ }
+
+ if (sortMode == ASCII) {
+ order = strcmp(firstString, secondString);
+ } else if (sortMode == INTEGER) {
+ int a, b;
+
+ if ((Tcl_GetInt(sortInterp, firstString, &a) != TCL_OK)
+ || (Tcl_GetInt(sortInterp, secondString, &b) != TCL_OK)) {
+ Tcl_AddErrorInfo(sortInterp,
+ "\n (converting list element from string to integer)");
+ sortCode = TCL_ERROR;
+ return order;
+ }
+ if (a > b) {
+ order = 1;
+ } else if (b > a) {
+ order = -1;
+ }
+ } else if (sortMode == REAL) {
+ double a, b;
+
+ if ((Tcl_GetDouble(sortInterp, firstString, &a) != TCL_OK)
+ || (Tcl_GetDouble(sortInterp, secondString, &b) != TCL_OK)) {
+ Tcl_AddErrorInfo(sortInterp,
+ "\n (converting list element from string to real)");
+ sortCode = TCL_ERROR;
+ return order;
+ }
+ if (a > b) {
+ order = 1;
+ } else if (b > a) {
+ order = -1;
+ }
+ } else {
+ int oldLength;
+ char *end;
+
+ /*
+ * Generate and evaluate a command to determine which string comes
+ * first.
+ */
+
+ oldLength = Tcl_DStringLength(&sortCmd);
+ Tcl_DStringAppendElement(&sortCmd, firstString);
+ Tcl_DStringAppendElement(&sortCmd, secondString);
+ sortCode = Tcl_Eval(sortInterp, Tcl_DStringValue(&sortCmd));
+ Tcl_DStringTrunc(&sortCmd, oldLength);
+ if (sortCode != TCL_OK) {
+ Tcl_AddErrorInfo(sortInterp,
+ "\n (user-defined comparison command)");
+ return order;
+ }
+
+ /*
+ * Parse the result of the command.
+ */
+
+ order = strtol(sortInterp->result, &end, 0);
+ if ((end == sortInterp->result) || (*end != 0)) {
+ Tcl_ResetResult(sortInterp);
+ Tcl_AppendResult(sortInterp,
+ "comparison command returned non-numeric result",
+ (char *) NULL);
+ sortCode = TCL_ERROR;
+ return order;
+ }
+ }
+
+done:
+ if (!sortIncreasing) {
+ order = -order;
+ }
+ return order;
+}
diff --git a/tix/generic/tixGrUtl.c b/tix/generic/tixGrUtl.c
new file mode 100644
index 00000000000..ae27ea8a584
--- /dev/null
+++ b/tix/generic/tixGrUtl.c
@@ -0,0 +1,202 @@
+/*
+ * tixGrUtl.c --
+ *
+ * Utility functions for Grid
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixDef.h>
+#include <tixGrid.h>
+
+#ifndef UCHAR
+#define UCHAR(c) ((unsigned char) (c))
+#endif
+
+/* string must be a real number plus "char". E.g, "3.0char" */
+int
+Tix_GetChars(interp, string, doublePtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ char *string; /* String describing a justification style. */
+ double *doublePtr; /* Place to store converted result. */
+{
+ char *end;
+ double d;
+
+ d = strtod(string, &end);
+ if (end == string) {
+ goto error;
+ }
+ while ((*end != '\0') && isspace(*end)) {
+ end++;
+ }
+ if (strncmp(end, "char", 4) != 0) {
+ goto error;
+ }
+ for (end+=4; (*end != '\0') && isspace(UCHAR(*end)); end++) {
+ ;
+ }
+ if (*end != '\0') {
+ goto error;
+ }
+ if (d < 0) {
+ goto error;
+ }
+
+ *doublePtr = d;
+ return TCL_OK;
+
+ error:
+ Tcl_AppendResult(interp, "bad screen distance \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+}
+
+
+int Tix_GrConfigSize(interp, wPtr, argc, argv, sizePtr, argcErrorMsg,
+ changed_ret)
+ Tcl_Interp *interp;
+ WidgetPtr wPtr;
+ int argc;
+ char **argv;
+ TixGridSize *sizePtr;
+ char * argcErrorMsg;
+ int *changed_ret;
+{
+ int pixels;
+ double chars;
+ int i;
+ TixGridSize newSize;
+ int changed = 0;
+
+ if (argc == 0) {
+ char buff[40];
+
+ Tcl_AppendResult(interp, "-size ", NULL);
+
+ switch (sizePtr->sizeType) {
+ case TIX_GR_AUTO:
+ Tcl_AppendResult(interp, "auto", NULL);
+ break;
+
+ case TIX_GR_DEFAULT:
+ Tcl_AppendResult(interp, "default", NULL);
+ break;
+
+ case TIX_GR_DEFINED_PIXEL:
+ sprintf(buff, "%d", sizePtr->sizeValue);
+ Tcl_AppendResult(interp, buff, NULL);
+ break;
+
+ case TIX_GR_DEFINED_CHAR:
+ sprintf(buff, "%fchar", sizePtr->charValue);
+ Tcl_AppendResult(interp, buff, NULL);
+ break;
+
+ default:
+ Tcl_AppendResult(interp, "default", NULL);
+ break;
+ }
+
+ Tcl_AppendResult(interp, " -pad0 ", NULL);
+ sprintf(buff, "%d", sizePtr->pad0);
+ Tcl_AppendResult(interp, buff, NULL);
+
+ Tcl_AppendResult(interp, " -pad1 ", NULL);
+ sprintf(buff, "%d", sizePtr->pad1);
+ Tcl_AppendResult(interp, buff, NULL);
+
+ return TCL_OK;
+ }
+
+ if ((argc %2) != 0) {
+ Tcl_AppendResult(interp, "value missing for option \"",
+ argv[argc-1], "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ newSize = *sizePtr;
+
+ for (i=0; i<argc; i+=2) {
+
+ if (strncmp("-size", argv[i], strlen(argv[i])) == 0) {
+ if (strcmp(argv[i+1], "auto")==0) {
+ newSize.sizeType = TIX_GR_AUTO;
+ newSize.sizeValue = 0;
+ }
+ else if (strcmp(argv[i+1], "default")==0) {
+ newSize.sizeType = TIX_GR_DEFAULT;
+ newSize.sizeValue = 0;
+ }
+ else if (Tk_GetPixels(interp, wPtr->dispData.tkwin, argv[i+1],
+ &pixels) == TCL_OK) {
+
+ newSize.sizeType = TIX_GR_DEFINED_PIXEL;
+ newSize.sizeValue = pixels;
+ }
+ else {
+ Tcl_ResetResult(interp);
+ if (Tix_GetChars(interp, argv[i+1], &chars) == TCL_OK) {
+ newSize.sizeType = TIX_GR_DEFINED_CHAR;
+ newSize.charValue = chars;
+ }
+ else {
+ return TCL_ERROR;
+ }
+ }
+ }
+ else if (strcmp("-pad0", argv[i]) == 0) {
+ if (Tk_GetPixels(interp, wPtr->dispData.tkwin, argv[i+1],
+ &pixels) == TCL_OK) {
+
+ newSize.pad0 = pixels;
+ }
+ else {
+ return TCL_ERROR;
+ }
+ }
+ else if (strcmp("-pad1", argv[i]) == 0) {
+ if (Tk_GetPixels(interp, wPtr->dispData.tkwin, argv[i+1],
+ &pixels) == TCL_OK) {
+
+ newSize.pad1 = pixels;
+ }
+ else {
+ return TCL_ERROR;
+ }
+ }
+ else {
+ Tcl_AppendResult(interp, "Unknown option \"", argv[i],
+ "\"; must be -pad0, -pad1 or -size", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (changed_ret) {
+ if (sizePtr->sizeType != newSize.sizeType) {
+ changed = 1;
+ }
+ if (sizePtr->sizeValue != newSize.sizeValue) {
+ changed = 1;
+ }
+ if (sizePtr->charValue != newSize.charValue) {
+ changed = 1;
+ }
+ if (sizePtr->pad1 != newSize.pad0) {
+ changed = 1;
+ }
+ if (sizePtr->pad1 != newSize.pad1) {
+ changed = 1;
+ }
+ *changed_ret = changed;
+ }
+
+ *sizePtr = newSize;
+ return TCL_OK;
+}
diff --git a/tix/generic/tixGrid.c b/tix/generic/tixGrid.c
new file mode 100644
index 00000000000..716c8049703
--- /dev/null
+++ b/tix/generic/tixGrid.c
@@ -0,0 +1,3307 @@
+/*
+ * tixGrid.c --
+ *
+ * This module implements "tixGrid" widgets.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixDef.h>
+#include <tixGrid.h>
+
+/*
+ * Information used for argv parsing.
+ */
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_COLOR, "-background", "background", "Background",
+ DEF_GRID_BG_COLOR, Tk_Offset(WidgetRecord, normalBg),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_COLOR, "-background", "background", "Background",
+ DEF_GRID_BG_MONO, Tk_Offset(WidgetRecord, normalBg),
+ 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_GRID_BORDER_WIDTH, Tk_Offset(WidgetRecord, borderWidth), 0},
+
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_GRID_CURSOR, Tk_Offset(WidgetRecord, cursor),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_STRING, "-editdonecmd", "editDoneCmd", "EditDoneCmd",
+ DEF_GRID_EDITDONE_COMMAND, Tk_Offset(WidgetRecord, editDoneCmd),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_STRING, "-editnotifycmd", "editNotifyCmd", "EditNotifyCmd",
+ DEF_GRID_EDITNOTIFY_COMMAND, Tk_Offset(WidgetRecord, editNotifyCmd),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+
+ {TK_CONFIG_BOOLEAN, "-floatingcols", "floatingCols", "FloatingCols",
+ DEF_GRID_FLOATING_COLS, Tk_Offset(WidgetRecord, floatRange[1]), 0},
+
+ {TK_CONFIG_BOOLEAN, "-floatingrows", "floatingRows", "FloatingRows",
+ DEF_GRID_FLOATING_ROWS, Tk_Offset(WidgetRecord, floatRange[0]), 0},
+
+ {TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_GRID_FONT, Tk_Offset(WidgetRecord, font), 0},
+
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_GRID_FG_COLOR, Tk_Offset(WidgetRecord, normalFg),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_GRID_FG_MONO, Tk_Offset(WidgetRecord, normalFg),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_STRING, "-formatcmd", "formatCmd", "FormatCmd",
+ DEF_GRID_FORMAT_COMMAND, Tk_Offset(WidgetRecord, formatCmd),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_PIXELS, "-height", "height", "Height",
+ DEF_GRID_HEIGHT, Tk_Offset(WidgetRecord, reqSize[1]), 0},
+
+ {TK_CONFIG_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground",
+ DEF_GRID_BG_COLOR, Tk_Offset(WidgetRecord, border),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground",
+ DEF_GRID_BG_MONO, Tk_Offset(WidgetRecord, border),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_GRID_HIGHLIGHT_COLOR, Tk_Offset(WidgetRecord, highlightColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_GRID_HIGHLIGHT_MONO, Tk_Offset(WidgetRecord, highlightColorPtr),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_GRID_HIGHLIGHT_WIDTH, Tk_Offset(WidgetRecord, highlightWidth), 0},
+
+ {TK_CONFIG_INT, "-leftmargin", "leftMargin", "LeftMargin",
+ DEF_GRID_LEFT_MARGIN, Tk_Offset(WidgetRecord, hdrSize[0]), 0},
+
+ {TK_CONFIG_CUSTOM, "-itemtype", "itemType", "ItemType",
+ DEF_GRID_ITEM_TYPE, Tk_Offset(WidgetRecord, diTypePtr),
+ 0, &tixConfigItemType},
+
+ {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
+ DEF_GRID_PADX, Tk_Offset(WidgetRecord, padX), 0},
+
+ {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
+ DEF_GRID_PADY, Tk_Offset(WidgetRecord, padY), 0},
+
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_GRID_RELIEF, Tk_Offset(WidgetRecord, relief), 0},
+
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_GRID_SELECT_BG_COLOR, Tk_Offset(WidgetRecord, selectBorder),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_GRID_SELECT_BG_MONO, Tk_Offset(WidgetRecord, selectBorder),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth","BorderWidth",
+ DEF_GRID_SELECT_BORDERWIDTH,Tk_Offset(WidgetRecord, selBorderWidth),0},
+
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_GRID_SELECT_FG_COLOR, Tk_Offset(WidgetRecord, selectFg),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_GRID_SELECT_FG_MONO, Tk_Offset(WidgetRecord, selectFg),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_UID, "-selectmode", "selectMode", "SelectMode",
+ DEF_GRID_SELECT_MODE, Tk_Offset(WidgetRecord, selectMode), 0},
+
+ {TK_CONFIG_UID, "-selectunit", "selectUnit", "SelectUnit",
+ DEF_GRID_SELECT_UNIT, Tk_Offset(WidgetRecord, selectUnit), 0},
+
+ {TK_CONFIG_STRING, "-sizecmd", "sizeCmd", "SizeCmd",
+ DEF_GRID_SIZE_COMMAND, Tk_Offset(WidgetRecord, sizeCmd),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_UID, "-state", (char*)NULL, (char*)NULL,
+ DEF_GRID_STATE, Tk_Offset(WidgetRecord, state), 0},
+
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_GRID_TAKE_FOCUS, Tk_Offset(WidgetRecord, takeFocus),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_INT, "-topmargin", "topMargin", "TopMargin",
+ DEF_GRID_TOP_MARGIN, Tk_Offset(WidgetRecord, hdrSize[1]), 0},
+
+ {TK_CONFIG_PIXELS, "-width", "width", "Width",
+ DEF_GRID_WIDTH, Tk_Offset(WidgetRecord, reqSize[0]), 0},
+
+ {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_GRID_X_SCROLL_COMMAND,
+ Tk_Offset(WidgetRecord, scrollInfo[0].command),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ DEF_GRID_Y_SCROLL_COMMAND,
+ Tk_Offset(WidgetRecord, scrollInfo[1].command),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+static Tk_ConfigSpec entryConfigSpecs[] = {
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+ /* These are standard procedures for TK widgets
+ * implemeted in C
+ */
+
+static void WidgetCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int WidgetConfigure _ANSI_ARGS_((Tcl_Interp *interp,
+ WidgetPtr wPtr, int argc, char **argv,
+ int flags));
+static void WidgetDestroy _ANSI_ARGS_((ClientData clientData));
+static void WidgetEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int WidgetCommand _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *, int argc, char **argv));
+static void WidgetDisplay _ANSI_ARGS_((ClientData clientData));
+static void WidgetComputeGeometry _ANSI_ARGS_((
+ ClientData clientData));
+static void IdleHandler _ANSI_ARGS_((
+ ClientData clientData));
+ /* Extra procedures for this widget
+ */
+static int ConfigElement _ANSI_ARGS_((WidgetPtr wPtr,
+ TixGrEntry *chPtr, int argc, char ** argv,
+ int flags, int forced));
+static void Tix_GrDisplayMainBody _ANSI_ARGS_((
+ WidgetPtr wPtr, Drawable buffer,
+ int winW, int winH));
+static void Tix_GrDrawBackground _ANSI_ARGS_((WidgetPtr wPtr,
+ RenderInfo * riPtr,Drawable drawable));
+static void Tix_GrDrawCells _ANSI_ARGS_((WidgetPtr wPtr,
+ RenderInfo * riPtr,Drawable drawable));
+static void Tix_GrDrawSites _ANSI_ARGS_((WidgetPtr wPtr,
+ RenderInfo * riPtr,Drawable drawable));
+int Tix_GrGetElementPosn _ANSI_ARGS_((
+ WidgetPtr wPtr, int x, int y,
+ int rect[2][2], int clipOK, int isSite,
+ int isScr, int nearest));
+static void UpdateScrollBars _ANSI_ARGS_((WidgetPtr wPtr,
+ int sizeChanged));
+static void GetScrollFractions _ANSI_ARGS_((
+ WidgetPtr wPtr, Tix_GridScrollInfo *siPtr,
+ double * first_ret, double * last_ret));
+static void Tix_GrDItemSizeChanged _ANSI_ARGS_((
+ Tix_DItem *iPtr));
+static TixGrEntry * Tix_GrFindCreateElem _ANSI_ARGS_((Tcl_Interp * interp,
+ WidgetPtr wPtr, int x, int y));
+static TixGrEntry * Tix_GrFindElem _ANSI_ARGS_((Tcl_Interp * interp,
+ WidgetPtr wPtr, int x, int y));
+static void Tix_GrPropagateSize _ANSI_ARGS_((
+ WidgetPtr wPtr, TixGrEntry * chPtr));
+static RenderBlock * Tix_GrAllocateRenderBlock _ANSI_ARGS_((
+ WidgetPtr wPtr, int winW, int winH,
+ int *exactW, int *exactH));
+static void Tix_GrFreeRenderBlock _ANSI_ARGS_((
+ WidgetPtr wPtr, RenderBlock * rbPtr));
+static void Tix_GrComputeSelection _ANSI_ARGS_((
+ WidgetPtr wPtr));
+static int Tix_GrBBox _ANSI_ARGS_((Tcl_Interp * interp,
+ WidgetPtr wPtr, int x, int y));
+static int TranslateFromTo _ANSI_ARGS_((Tcl_Interp * interp,
+ WidgetPtr wPtr, int argc, char **argv, int *from,
+ int * to, int *which));
+static void Tix_GrComputeSubSelection _ANSI_ARGS_((
+ WidgetPtr wPtr, int rect[2][2], int offs[2]));
+static int Tix_GrCallFormatCmd _ANSI_ARGS_((WidgetPtr wPtr,
+ int which));
+static void RecalScrollRegion _ANSI_ARGS_((WidgetPtr wPtr,
+ int winW, int winH,
+ Tix_GridScrollInfo *scrollInfo));
+static void Tix_GrResetRenderBlocks _ANSI_ARGS_((WidgetPtr wPtr));
+
+static TIX_DECLARE_SUBCMD(Tix_GrBdType);
+static TIX_DECLARE_SUBCMD(Tix_GrCGet);
+static TIX_DECLARE_SUBCMD(Tix_GrConfig);
+static TIX_DECLARE_SUBCMD(Tix_GrDelete);
+static TIX_DECLARE_SUBCMD(Tix_GrEdit);
+static TIX_DECLARE_SUBCMD(Tix_GrEntryCget);
+static TIX_DECLARE_SUBCMD(Tix_GrEntryConfig);
+EXTERN TIX_DECLARE_SUBCMD(Tix_GrFormat);
+static TIX_DECLARE_SUBCMD(Tix_GrGeometryInfo);
+static TIX_DECLARE_SUBCMD(Tix_GrInfo);
+static TIX_DECLARE_SUBCMD(Tix_GrIndex);
+static TIX_DECLARE_SUBCMD(Tix_GrMove);
+static TIX_DECLARE_SUBCMD(Tix_GrNearest);
+EXTERN TIX_DECLARE_SUBCMD(Tix_GrSelection);
+static TIX_DECLARE_SUBCMD(Tix_GrSet);
+EXTERN TIX_DECLARE_SUBCMD(Tix_GrSetSize);
+static TIX_DECLARE_SUBCMD(Tix_GrSetSite);
+EXTERN TIX_DECLARE_SUBCMD(Tix_GrSort);
+static TIX_DECLARE_SUBCMD(Tix_GrView);
+static TIX_DECLARE_SUBCMD(Tix_GrUnset);
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tix_GridCmd --
+ *
+ * This procedure is invoked to process the "tixGrid" Tcl
+ * command. It creates a new "TixGrid" widget.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * A new widget is created and configured.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Tix_GridCmd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window main = (Tk_Window) clientData;
+ WidgetPtr wPtr;
+ 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, "TixGrid");
+
+ /*
+ * Allocate and initialize the widget record.
+ */
+ wPtr = (WidgetPtr) ckalloc(sizeof(WidgetRecord));
+
+ wPtr->dispData.tkwin = tkwin;
+ wPtr->dispData.display = Tk_Display(tkwin);
+ wPtr->dispData.interp = interp;
+ wPtr->dispData.sizeChangedProc = Tix_GrDItemSizeChanged;
+ wPtr->font = NULL;
+ wPtr->normalBg = NULL;
+ wPtr->normalFg = NULL;
+ wPtr->command = NULL;
+ wPtr->border = NULL;
+ wPtr->borderWidth = 0;
+ wPtr->selectBorder = NULL;
+ wPtr->selBorderWidth = 0;
+ wPtr->selectFg = NULL;
+ wPtr->backgroundGC = None;
+ wPtr->selectGC = None;
+ wPtr->anchorGC = None;
+ wPtr->highlightWidth = 0;
+ wPtr->highlightColorPtr = NULL;
+ wPtr->highlightGC = None;
+ wPtr->relief = TK_RELIEF_FLAT;
+ wPtr->cursor = None;
+ wPtr->selectMode = NULL;
+ wPtr->selectUnit = NULL;
+ wPtr->anchor[0] = TIX_SITE_NONE;
+ wPtr->anchor[1] = TIX_SITE_NONE;
+ wPtr->dragSite[0] = TIX_SITE_NONE;
+ wPtr->dragSite[1] = TIX_SITE_NONE;
+ wPtr->dropSite[0] = TIX_SITE_NONE;
+ wPtr->dropSite[1] = TIX_SITE_NONE;
+ wPtr->browseCmd = 0;
+ wPtr->formatCmd = 0;
+ wPtr->editDoneCmd = 0;
+ wPtr->editNotifyCmd = 0;
+ wPtr->sizeCmd = 0;
+ wPtr->takeFocus = NULL;
+ wPtr->serial = 0;
+ wPtr->mainRB = (RenderBlock*)NULL;
+ wPtr->hdrSize[0] = 1;
+ wPtr->hdrSize[1] = 1;
+ wPtr->expArea.x1 = 10000;
+ wPtr->expArea.y1 = 10000;
+ wPtr->expArea.x2 = 0;
+ wPtr->expArea.y2 = 0;
+ wPtr->dataSet = TixGridDataSetInit();
+ wPtr->renderInfo = NULL;
+ wPtr->defSize[0].sizeType = TIX_GR_DEFINED_CHAR;
+ wPtr->defSize[0].charValue = 10.0;
+ wPtr->defSize[0].pad0 = 2;
+ wPtr->defSize[0].pad1 = 2;
+ wPtr->defSize[1].sizeType = TIX_GR_DEFINED_CHAR;
+ wPtr->defSize[1].charValue = 1.2;
+ wPtr->defSize[1].pad0 = 2;
+ wPtr->defSize[1].pad1 = 2;
+ wPtr->gridSize[0] = 0;
+ wPtr->gridSize[1] = 0;
+ wPtr->reqSize[0] = 0;
+ wPtr->reqSize[1] = 0;
+ wPtr->state = tixNormalUid;
+ wPtr->colorInfoCounter = 0;
+
+ /* The flags */
+ wPtr->idleEvent = 0;
+ wPtr->toRedraw = 0;
+ wPtr->toResize = 0;
+ wPtr->toResetRB = 0;
+ wPtr->toComputeSel = 0;
+ wPtr->toRedrawHighlight = 0;
+
+ wPtr->scrollInfo[0].command = NULL;
+ wPtr->scrollInfo[1].command = NULL;
+
+ wPtr->scrollInfo[0].max = 1;
+ wPtr->scrollInfo[0].unit = 1;
+ wPtr->scrollInfo[0].offset = 0;
+ wPtr->scrollInfo[0].window = 1.0;
+ wPtr->scrollInfo[1].max = 1;
+ wPtr->scrollInfo[1].unit = 1;
+ wPtr->scrollInfo[1].offset = 0;
+ wPtr->scrollInfo[1].window = 1.0;
+
+ Tix_SimpleListInit(&wPtr->colorInfo);
+ Tix_SimpleListInit(&wPtr->selList);
+ Tix_SimpleListInit(&wPtr->mappedWindows);
+
+ Tk_CreateEventHandler(wPtr->dispData.tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ WidgetEventProc, (ClientData) wPtr);
+ wPtr->widgetCmd = Tcl_CreateCommand(interp,
+ Tk_PathName(wPtr->dispData.tkwin), WidgetCommand, (ClientData) wPtr,
+ WidgetCmdDeletedProc);
+
+ if (WidgetConfigure(interp, wPtr, argc-2, argv+2, 0) != TCL_OK) {
+ Tk_DestroyWindow(wPtr->dispData.tkwin);
+ return TCL_ERROR;
+ }
+
+ interp->result = Tk_PathName(wPtr->dispData.tkwin);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WidgetConfigure --
+ *
+ * This procedure is called to process an argv/argc list in
+ * conjunction with the Tk option database to configure (or
+ * reconfigure) a List 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 wPtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+WidgetConfigure(interp, wPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ WidgetPtr wPtr; /* Information about widget. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Flags to pass to
+ * Tk_ConfigureWidget. */
+{
+ XGCValues gcValues;
+ GC newGC;
+ TixFont oldfont;
+ Tix_StyleTemplate stTmpl;
+
+ oldfont = wPtr->font;
+
+ if (Tk_ConfigureWidget(interp, wPtr->dispData.tkwin, configSpecs,
+ argc, argv, (char *) wPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ wPtr->bdPad = wPtr->highlightWidth + wPtr->borderWidth;
+
+ if ((wPtr->state != tixNormalUid) && (wPtr->state != tixDisabledUid)) {
+ Tcl_AppendResult(interp, "bad state value \"", wPtr->state,
+ "\": must be normal or disabled", (char *) NULL);
+ wPtr->state = tixNormalUid;
+ return TCL_ERROR;
+ }
+
+ if (oldfont != wPtr->font) {
+ int i;
+
+ /*
+ * Font has been changed (initialized), we need to reset the render
+ * blocks
+ */
+ wPtr->toResetRB = 1;
+
+ TixComputeTextGeometry(wPtr->font, "0", 1,
+ 0, &wPtr->fontSize[0], &wPtr->fontSize[1]);
+
+ /* Recalculate the default size of the cells
+ */
+ for (i=0; i<2; i++) {
+ switch (wPtr->defSize[i].sizeType) {
+ case TIX_GR_DEFINED_CHAR:
+ wPtr->defSize[i].pixels = (int)
+ (wPtr->defSize[i].charValue * wPtr->fontSize[i]);
+ break;
+ case TIX_GR_AUTO:
+ if (i==0) {
+ wPtr->defSize[i].pixels = 10 * wPtr->fontSize[0];
+ }
+ if (i==1) {
+ wPtr->defSize[i].pixels = 1 * wPtr->fontSize[1];
+ }
+ break;
+ }
+ }
+ }
+
+ /*
+ * 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(wPtr->dispData.tkwin, wPtr->border);
+
+ /*
+ * Note: GraphicsExpose events are disabled in normalGC because it's
+ * used to copy stuff from an off-screen pixmap onto the screen (we know
+ * that there's no problem with obscured areas).
+ */
+
+ /* The background GC */
+ gcValues.foreground = wPtr->normalBg->pixel;
+ gcValues.graphics_exposures = False;
+
+ newGC = Tk_GetGC(wPtr->dispData.tkwin,
+ GCForeground|GCGraphicsExposures, &gcValues);
+ if (wPtr->backgroundGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->backgroundGC);
+ }
+ wPtr->backgroundGC = newGC;
+
+ /* The selected text GC */
+ gcValues.font = TixFontId(wPtr->font);
+ gcValues.foreground = wPtr->selectFg->pixel;
+ gcValues.background = Tk_3DBorderColor(wPtr->selectBorder)->pixel;
+ gcValues.graphics_exposures = False;
+
+ newGC = Tk_GetGC(wPtr->dispData.tkwin,
+ GCForeground|GCBackground|GCFont|GCGraphicsExposures, &gcValues);
+ if (wPtr->selectGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->selectGC);
+ }
+ wPtr->selectGC = newGC;
+
+ /* The dotted anchor lines */
+ gcValues.foreground = wPtr->normalFg->pixel;
+ gcValues.background = wPtr->normalBg->pixel;
+ gcValues.graphics_exposures = False;
+ gcValues.line_style = LineDoubleDash;
+ gcValues.dashes = 2;
+ gcValues.subwindow_mode = IncludeInferiors;
+
+ newGC = Tk_GetGC(wPtr->dispData.tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures|GCLineStyle|GCDashList|
+ GCSubwindowMode, &gcValues);
+ if (wPtr->anchorGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->anchorGC);
+ }
+ wPtr->anchorGC = newGC;
+
+ /* The highlight border */
+ gcValues.background = wPtr->selectFg->pixel;
+ gcValues.foreground = wPtr->highlightColorPtr->pixel;
+ gcValues.graphics_exposures = False;
+
+ newGC = Tk_GetGC(wPtr->dispData.tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures, &gcValues);
+ if (wPtr->highlightGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->highlightGC);
+ }
+ wPtr->highlightGC = newGC;
+
+ /* We must set the options of the default styles so that
+ * -- the default styles will change according to what is in
+ * stTmpl
+ */
+ stTmpl.font = wPtr->font;
+ stTmpl.pad[0] = wPtr->padX;
+ stTmpl.pad[1] = wPtr->padY;
+ stTmpl.colors[TIX_DITEM_NORMAL].fg = wPtr->normalFg;
+ stTmpl.colors[TIX_DITEM_NORMAL].bg = wPtr->normalBg;
+ stTmpl.colors[TIX_DITEM_SELECTED].fg= wPtr->selectFg;
+ stTmpl.colors[TIX_DITEM_SELECTED].bg= Tk_3DBorderColor(wPtr->selectBorder);
+ stTmpl.flags = TIX_DITEM_FONT|TIX_DITEM_NORMAL_BG|
+ TIX_DITEM_SELECTED_BG|TIX_DITEM_NORMAL_FG|TIX_DITEM_SELECTED_FG |
+ TIX_DITEM_PADX|TIX_DITEM_PADY;
+
+ Tix_SetDefaultStyleTemplate(wPtr->dispData.tkwin, &stTmpl);
+
+ Tix_GrDoWhenIdle(wPtr, TIX_GR_RESIZE);
+
+ return TCL_OK;
+}
+/*
+ *--------------------------------------------------------------
+ *
+ * WidgetCommand --
+ *
+ * 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
+WidgetCommand(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about the widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int code;
+
+ static Tix_SubCmdInfo subCmdInfo[] = {
+ {TIX_DEFAULT_LEN, "anchor", 1, 3, Tix_GrSetSite,
+ "option ?x y?"},
+ {TIX_DEFAULT_LEN, "bdtype", 2, 4, Tix_GrBdType,
+ "x y ?xbdWidth ybdWidth?"},
+ {TIX_DEFAULT_LEN, "cget", 1, 1, Tix_GrCGet,
+ "option"},
+ {TIX_DEFAULT_LEN, "configure", 0, TIX_VAR_ARGS, Tix_GrConfig,
+ "?option? ?value? ?option value ... ?"},
+ {TIX_DEFAULT_LEN, "delete", 2, 3, Tix_GrDelete,
+ "option from ?to?"},
+ {TIX_DEFAULT_LEN, "dragsite", 1, 3, Tix_GrSetSite,
+ "option ?x y?"},
+ {TIX_DEFAULT_LEN, "dropsite", 1, 3, Tix_GrSetSite,
+ "option ?x y?"},
+ {TIX_DEFAULT_LEN, "entrycget", 3, 3, Tix_GrEntryCget,
+ "x y option"},
+ {TIX_DEFAULT_LEN, "edit", 1, 3, Tix_GrEdit,
+ "option ?args ...?"},
+ {TIX_DEFAULT_LEN, "entryconfigure", 2, TIX_VAR_ARGS, Tix_GrEntryConfig,
+ "x y ?option? ?value? ?option value ... ?"},
+ {TIX_DEFAULT_LEN, "format", 1, TIX_VAR_ARGS, Tix_GrFormat,
+ "option ?args ...?"},
+ {TIX_DEFAULT_LEN, "geometryinfo", 0, 2, Tix_GrGeometryInfo,
+ "?width height?"},
+ {TIX_DEFAULT_LEN, "info", 1, TIX_VAR_ARGS, Tix_GrInfo,
+ "option ?args ...?"},
+ {TIX_DEFAULT_LEN, "index", 2, 2, Tix_GrIndex,
+ "x y"},
+ {TIX_DEFAULT_LEN, "move", 4, 4, Tix_GrMove,
+ "option from to by"},
+ {TIX_DEFAULT_LEN, "nearest", 2, 2, Tix_GrNearest,
+ "x y"},
+#if 0
+ {TIX_DEFAULT_LEN, "see", 1, 1, Tix_GrSee,
+ "x y"},
+#endif
+ {TIX_DEFAULT_LEN, "selection", 3, 5, Tix_GrSelection,
+ "option x1 y1 ?x2 y2?"},
+ {TIX_DEFAULT_LEN, "set", 2, TIX_VAR_ARGS, Tix_GrSet,
+ "x y ?option value ...?"},
+ {TIX_DEFAULT_LEN, "size", 1, TIX_VAR_ARGS, Tix_GrSetSize,
+ "option ?args ...?"},
+#ifndef _WINDOWS
+ {TIX_DEFAULT_LEN, "sort", 3, TIX_VAR_ARGS, Tix_GrSort,
+ "dimension start end ?args ...?"},
+#endif
+ {TIX_DEFAULT_LEN, "unset", 2, 2, Tix_GrUnset,
+ "x y"},
+ {TIX_DEFAULT_LEN, "xview", 0, 3, Tix_GrView,
+ "args"},
+ {TIX_DEFAULT_LEN, "yview", 0, 3, Tix_GrView,
+ "args"},
+ };
+
+ static Tix_CmdInfo cmdInfo = {
+ Tix_ArraySize(subCmdInfo), 1, TIX_VAR_ARGS, "?option? arg ?arg ...?",
+ };
+
+ Tk_Preserve(clientData);
+ code = Tix_HandleSubCmds(&cmdInfo, subCmdInfo, clientData,
+ interp, argc, argv);
+ Tk_Release(clientData);
+
+ return code;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WidgetEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on Lists.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+WidgetEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int x2, y2;
+
+ switch (eventPtr->type) {
+ case DestroyNotify:
+ if (wPtr->dispData.tkwin != NULL) {
+ wPtr->dispData.tkwin = NULL;
+ Tcl_DeleteCommand(wPtr->dispData.interp,
+ Tcl_GetCommandName(wPtr->dispData.interp, wPtr->widgetCmd));
+ }
+ Tix_GrCancelDoWhenIdle(wPtr);
+ Tk_EventuallyFree((ClientData) wPtr, (Tix_FreeProc*)WidgetDestroy);
+ break;
+
+ case ConfigureNotify:
+ wPtr->expArea.x1 = 0;
+ wPtr->expArea.y1 = 0;
+ wPtr->expArea.x2 = Tk_Width (wPtr->dispData.tkwin) - 1;
+ wPtr->expArea.y2 = Tk_Height(wPtr->dispData.tkwin) - 1;
+ Tix_GrDoWhenIdle(wPtr, TIX_GR_RESIZE);
+ break;
+
+ case Expose:
+ if (wPtr->expArea.x1 > eventPtr->xexpose.x) {
+ wPtr->expArea.x1 = eventPtr->xexpose.x;
+ }
+ if (wPtr->expArea.y1 > eventPtr->xexpose.y) {
+ wPtr->expArea.y1 = eventPtr->xexpose.y;
+ }
+ x2 = eventPtr->xexpose.x + eventPtr->xexpose.width - 1;
+ y2 = eventPtr->xexpose.y + eventPtr->xexpose.height - 1;
+
+ if (wPtr->expArea.x2 < x2) {
+ wPtr->expArea.x2 = x2;
+ }
+ if (wPtr->expArea.y2 < y2) {
+ wPtr->expArea.y2 = y2;
+ }
+ wPtr->toRedrawHighlight = 1;
+ Tix_GrDoWhenIdle(wPtr, TIX_GR_REDRAW);
+ break;
+
+ case FocusIn:
+ wPtr->hasFocus = 1;
+ wPtr->toRedrawHighlight = 1;
+ Tix_GrDoWhenIdle(wPtr, TIX_GR_REDRAW);
+ break;
+
+ case FocusOut:
+ wPtr->hasFocus = 0;
+ wPtr->toRedrawHighlight = 1;
+ Tix_GrDoWhenIdle(wPtr, TIX_GR_REDRAW);
+ break;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WidgetDestroy --
+ *
+ * This procedure is invoked by Tk_EventuallyFree or Tk_Release
+ * to clean up the internal structure of a List at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the List is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+WidgetDestroy(clientData)
+ ClientData clientData; /* Info about the Grid widget. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+
+ if (wPtr->dataSet) {
+ Tix_GrDataRowSearch rowSearch;
+ Tix_GrDataCellSearch cellSearch;
+ int rowDone, cellDone;
+
+ for (rowDone = TixGrDataFirstRow(wPtr->dataSet, &rowSearch);
+ !rowDone;
+ rowDone = TixGrDataNextRow(&rowSearch)) {
+
+
+ for (cellDone = TixGrDataFirstCell(&rowSearch, &cellSearch);
+ !cellDone;
+ cellDone = TixGrDataNextCell(&cellSearch)) {
+
+ TixGridDataDeleteSearchedEntry(&cellSearch);
+ Tix_GrFreeElem((TixGrEntry*)cellSearch.data);
+ }
+ }
+
+ TixGridDataSetFree(wPtr->dataSet);
+ }
+
+ if (wPtr->backgroundGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->backgroundGC);
+ }
+ if (wPtr->selectGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->selectGC);
+ }
+ if (wPtr->anchorGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->anchorGC);
+ }
+ if (wPtr->highlightGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->highlightGC);
+ }
+
+ if (wPtr->mainRB) {
+ Tix_GrFreeRenderBlock(wPtr, wPtr->mainRB);
+ }
+
+ Tix_GrFreeUnusedColors(wPtr, 1);
+
+ if (!Tix_IsLinkListEmpty(wPtr->mappedWindows)) {
+ /*
+ * All mapped windows should have been unmapped when the
+ * the entries were deleted
+ */
+ panic("tixGrid: mappedWindows not NULL");
+ }
+
+ Tk_FreeOptions(configSpecs, (char *) wPtr, wPtr->dispData.display, 0);
+ ckfree((char *) wPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WidgetCmdDeletedProc --
+ *
+ * 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
+WidgetCmdDeletedProc(clientData)
+ ClientData clientData; /* Info about Grid widget. */
+{
+ WidgetPtr wPtr = (WidgetPtr) 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 (wPtr->dispData.tkwin != NULL) {
+ Tk_Window tkwin = wPtr->dispData.tkwin;
+ wPtr->dispData.tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+static void
+RecalScrollRegion(wPtr, winW, winH, scrollInfo)
+ WidgetPtr wPtr; /* Info about Grid widget. */
+ int winW;
+ int winH;
+ Tix_GridScrollInfo *scrollInfo;
+{
+ int gridSize[2];
+ int winSize[2];
+ int i, k;
+ int count;
+ int visibleSize;
+ int totalSize;
+ int pad0, pad1;
+
+ winSize[0] = winW;
+ winSize[1] = winH;
+
+ TixGridDataGetGridSize(wPtr->dataSet, &gridSize[0],
+ &gridSize[1]);
+
+ for (i=0; i<2; i++) {
+ for (k=0; k<wPtr->hdrSize[i] && k<gridSize[i]; k++) {
+ winSize[i] -= TixGridDataGetRowColSize(wPtr, wPtr->dataSet, i,
+ k, &wPtr->defSize[i], &pad0, &pad1);
+ winSize[i] -= pad0 + pad1;
+ }
+ if (winSize[i] <= 0) {
+ /*
+ * The window's contents are not visible.
+ */
+ scrollInfo[i].max = 0;
+ scrollInfo[i].window = 1.0;
+ continue;
+ }
+ if (wPtr->hdrSize[i] >= gridSize[i]) {
+ /*
+ * There is no scrollable stuff in this dimension.
+ */
+ scrollInfo[i].max = 0;
+ scrollInfo[i].window = 1.0;
+ continue;
+ }
+
+ visibleSize = winSize[i];
+
+ for (count=0,k=gridSize[i]-1; k>=wPtr->hdrSize[i]&&k>=0; count++,k--) {
+ winSize[i] -= TixGridDataGetRowColSize(wPtr, wPtr->dataSet, i,
+ k, &wPtr->defSize[i], &pad0, &pad1);
+ winSize[i] -= pad0 + pad1;
+
+ if (winSize[i] == 0) {
+ ++ count;
+ break;
+ }
+ else if (winSize[i] < 0) {
+ break;
+ }
+ }
+
+ if (count == 0) {
+ /*
+ * There is only one scrollable element and it is *partially*
+ * visible.
+ */
+ count = 1;
+ }
+ scrollInfo[i].max = (gridSize[i]-wPtr->hdrSize[i]) - count;
+
+ /*
+ * calculate the total pixel size (%%SLOOOOOOW)
+ */
+ for (totalSize=0,k=wPtr->hdrSize[i];k<gridSize[i];k++) {
+ totalSize += TixGridDataGetRowColSize(wPtr, wPtr->dataSet, i,
+ k, &wPtr->defSize[i], &pad0, &pad1);
+ totalSize += pad0 + pad1;
+ }
+
+ /*
+ *we may need some left over spaces after the last element.
+ */
+ totalSize += (-winSize[i]);
+
+ scrollInfo[i].window =
+ (double)(visibleSize) / (double)totalSize;
+ }
+ for (i=0; i<2; i++) {
+ if (scrollInfo[i].offset < 0) {
+ scrollInfo[i].offset = 0;
+ }
+ if (scrollInfo[i].offset > scrollInfo[i].max) {
+ scrollInfo[i].offset = scrollInfo[i].max;
+ }
+ }
+}
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WidgetComputeGeometry --
+ *
+ * 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:
+ * none
+ *
+ *--------------------------------------------------------------
+ */
+static void
+WidgetComputeGeometry(clientData)
+ ClientData clientData;
+{
+ WidgetPtr wPtr = (WidgetPtr)clientData;
+ int i, k;
+ int gridSize[2];
+ int req[2], pad0, pad1;
+ Tk_Window tkwin = wPtr->dispData.tkwin;
+
+ TixGridDataGetGridSize(wPtr->dataSet, &gridSize[0],
+ &gridSize[1]);
+
+ for (i=0; i<2; i++) {
+ int end = wPtr->reqSize[i];
+ if (end == 0) {
+ end = gridSize[0] + 1;
+ }
+ for (req[i]=0,k=0; k<end; k++) {
+ req[i] += TixGridDataGetRowColSize(wPtr, wPtr->dataSet, i,
+ k, &wPtr->defSize[i], &pad0, &pad1);
+ req[i] += pad0 + pad1;
+ }
+
+ req[i] += 2*(wPtr->highlightWidth + wPtr->borderWidth);
+ }
+
+ if (Tk_ReqWidth(tkwin) != req[0] || Tk_ReqHeight(tkwin) != req[0]) {
+ Tk_GeometryRequest(tkwin, req[0], req[1]);
+ }
+
+ /* arrange for the widget to be redrawn */
+ wPtr->toResetRB = 1;
+ wPtr->toComputeSel = 1;
+ wPtr->toRedrawHighlight = 1;
+
+ Tix_GrDoWhenIdle(wPtr, TIX_GR_REDRAW);
+}
+
+static void
+Tix_GrResetRenderBlocks(wPtr)
+ WidgetPtr wPtr;
+{
+ int winW, winH, exactW, exactH;
+ Tk_Window tkwin = wPtr->dispData.tkwin;
+
+ winW = Tk_Width (tkwin) - 2*wPtr->highlightWidth - 2*wPtr->borderWidth;
+ winH = Tk_Height(tkwin) - 2*wPtr->highlightWidth - 2*wPtr->borderWidth;
+
+ RecalScrollRegion(wPtr, winW, winH, wPtr->scrollInfo);
+
+ UpdateScrollBars(wPtr, 1);
+
+ if (wPtr->mainRB) {
+ Tix_GrFreeRenderBlock(wPtr, wPtr->mainRB);
+ }
+ wPtr->mainRB = Tix_GrAllocateRenderBlock(wPtr, winW, winH,&exactW,&exactH);
+
+ wPtr->expArea.x1 = 0;
+ wPtr->expArea.y1 = 0;
+ wPtr->expArea.x2 = Tk_Width (wPtr->dispData.tkwin) - 1;
+ wPtr->expArea.y2 = Tk_Height(wPtr->dispData.tkwin) - 1;
+}
+
+/*----------------------------------------------------------------------
+ * DItemSizeChanged --
+ *
+ * This is called whenever the size of one of the HList's items
+ * changes its size.
+ *----------------------------------------------------------------------
+ */
+static void
+Tix_GrDItemSizeChanged(iPtr)
+ Tix_DItem *iPtr;
+{
+ WidgetPtr wPtr = (WidgetPtr)iPtr->base.clientData;
+
+ if (wPtr) {
+ /* double-check: perhaps we haven't set the clientData yet! */
+ Tix_GrDoWhenIdle(wPtr, TIX_GR_RESIZE);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * Tix_GrDoWhenIdle --
+ *----------------------------------------------------------------------
+ */
+void
+Tix_GrDoWhenIdle(wPtr, type)
+ WidgetPtr wPtr;
+ int type;
+{
+ switch (type) {
+ case TIX_GR_RESIZE:
+ wPtr->toResize = 1;
+ break;
+ case TIX_GR_REDRAW:
+ wPtr->toRedraw = 1;
+ break;
+ }
+
+ if (!wPtr->idleEvent) {
+ wPtr->idleEvent = 1;
+ Tk_DoWhenIdle(IdleHandler, (ClientData)wPtr);
+ }
+}
+
+static void
+IdleHandler(clientData)
+ ClientData clientData; /* Info about my widget. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+
+ if (!wPtr->idleEvent) { /* sanity check */
+ return;
+ }
+ wPtr->idleEvent = 0;
+
+ if (wPtr->toResize) {
+ wPtr->toResize = 0;
+ WidgetComputeGeometry(clientData);
+ }
+ else if (wPtr->toRedraw) {
+ wPtr->toRedraw = 0;
+ WidgetDisplay(clientData);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * Tix_GrCancelDoWhenIdle --
+ *----------------------------------------------------------------------
+ */
+void
+Tix_GrCancelDoWhenIdle(wPtr)
+ WidgetPtr wPtr;
+{
+ wPtr->toResize = 0;
+ wPtr->toRedraw = 0;
+
+ if (wPtr->idleEvent) {
+ Tk_CancelIdleCall(IdleHandler, (ClientData)wPtr);
+ wPtr->idleEvent = 0;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * WidgetDisplay --
+ *
+ * Display the widget: the borders, the background and the entries.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+WidgetDisplay(clientData)
+ ClientData clientData; /* Info about my widget. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ Drawable buffer = None;
+ Tk_Window tkwin = wPtr->dispData.tkwin;
+ int winH, winW, expW, expH;
+ GC highlightGC;
+
+ if (!Tk_IsMapped(tkwin)) {
+ return;
+ }
+ wPtr->serial ++;
+
+ winW = Tk_Width(tkwin) - 2*wPtr->highlightWidth - 2*wPtr->borderWidth;
+ winH = Tk_Height(tkwin) - 2*wPtr->highlightWidth - 2*wPtr->borderWidth;
+
+ if (winW <= 0 || winH <= 0) { /* nothing to draw */
+ goto done;
+ }
+
+ if (wPtr->toResetRB) {
+ Tix_GrResetRenderBlocks(wPtr);
+ wPtr->toResetRB = 0;
+ }
+ if (wPtr->toComputeSel) {
+ Tix_GrComputeSelection(wPtr);
+ wPtr->toComputeSel = 0;
+ }
+
+ /* clip the exposed area to the visible part of the widget,
+ * just in case some of the routines had made it larger than
+ * it should be
+ */
+ if (wPtr->expArea.x1 < wPtr->bdPad) {
+ wPtr->expArea.x1 = wPtr->bdPad;
+ }
+ if (wPtr->expArea.y1 < wPtr->bdPad) {
+ wPtr->expArea.y1 = wPtr->bdPad;
+ }
+ if (wPtr->expArea.x2 >= Tk_Width(tkwin) - wPtr->bdPad) {
+ wPtr->expArea.x2 = Tk_Width(tkwin) - wPtr->bdPad - 1;
+ }
+ if (wPtr->expArea.y2 >= Tk_Height(tkwin) - wPtr->bdPad) {
+ wPtr->expArea.y2 = Tk_Height(tkwin) - wPtr->bdPad - 1;
+ }
+
+ expW = wPtr->expArea.x2 - wPtr->expArea.x1 + 1;
+ expH = wPtr->expArea.y2 - wPtr->expArea.y1 + 1;
+
+ if (expW <= 0 || expH <= 0) { /* no cells to draw */
+ goto drawBorder;
+ }
+
+ buffer = Tix_GetRenderBuffer(wPtr->dispData.display, Tk_WindowId(tkwin),
+ expW, expH, Tk_Depth(tkwin));
+
+ if (buffer == Tk_WindowId(tkwin)) {
+ /* clear the window directly */
+ XFillRectangle(wPtr->dispData.display, buffer, wPtr->backgroundGC,
+ wPtr->expArea.x1, wPtr->expArea.y1, expW, expH);
+ } else {
+ XFillRectangle(wPtr->dispData.display, buffer, wPtr->backgroundGC,
+ 0, 0, expW, expH);
+ }
+
+ if (wPtr->mainRB) {
+ Tix_GrDisplayMainBody(wPtr, buffer, winW, winH);
+ }
+
+ if (buffer != Tk_WindowId(tkwin)) {
+ XCopyArea(wPtr->dispData.display, buffer, Tk_WindowId(tkwin),
+ wPtr->backgroundGC, 0, 0, expW, expH,
+ wPtr->expArea.x1, wPtr->expArea.y1);
+ Tk_FreePixmap(wPtr->dispData.display, buffer);
+ }
+
+ drawBorder:
+ Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin), wPtr->border,
+ wPtr->highlightWidth,
+ wPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*wPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*wPtr->highlightWidth,
+ wPtr->borderWidth, wPtr->relief);
+
+ if (wPtr->toRedrawHighlight && wPtr->highlightWidth > 0) {
+ if (wPtr->hasFocus) {
+ highlightGC = wPtr->highlightGC;
+ } else {
+ highlightGC = Tk_3DBorderGC(tkwin, wPtr->border,
+ TK_3D_FLAT_GC);
+ }
+
+ Tk_DrawFocusHighlight(tkwin, highlightGC, wPtr->highlightWidth,
+ Tk_WindowId(tkwin));
+ }
+
+ done:
+ wPtr->expArea.x1 = 10000;
+ wPtr->expArea.y1 = 10000;
+ wPtr->expArea.x2 = 0;
+ wPtr->expArea.y2 = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tix_GrDisplayMainBody --
+ *
+ * Draw the background and cells
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+static void Tix_GrDisplayMainBody(wPtr, buffer, winW, winH)
+ WidgetPtr wPtr;
+ Drawable buffer;
+ int winW;
+ int winH;
+{
+ Tk_Window tkwin = wPtr->dispData.tkwin;
+ RenderInfo mainRI; /* render info for main body */
+ int i, j;
+
+ if (buffer == Tk_WindowId(tkwin)) {
+ /* rendering directly into the window */
+ mainRI.origin[0] = wPtr->highlightWidth + wPtr->borderWidth;
+ mainRI.origin[1] = wPtr->highlightWidth + wPtr->borderWidth;
+
+ } else {
+ /* rendering into a pixmap */
+ mainRI.origin[0] = wPtr->highlightWidth + wPtr->borderWidth
+ - wPtr->expArea.x1;
+ mainRI.origin[1] = wPtr->highlightWidth + wPtr->borderWidth
+ - wPtr->expArea.y1;
+ }
+
+ mainRI.drawable = buffer;
+ wPtr->colorInfoCounter ++;
+
+ wPtr->renderInfo = &mainRI;
+
+ /* 1. Draw the backgrounds
+ */
+ for (i=0; i<wPtr->mainRB->size[0]; i++) {
+ for (j=0; j<wPtr->mainRB->size[1]; j++) {
+ wPtr->mainRB->elms[i][j].borderW[0][0] = 0;
+ wPtr->mainRB->elms[i][j].borderW[1][0] = 0;
+ wPtr->mainRB->elms[i][j].borderW[0][1] = 0;
+ wPtr->mainRB->elms[i][j].borderW[1][1] = 0;
+ wPtr->mainRB->elms[i][j].filled = 0;
+ }
+ }
+ Tix_GrDrawBackground(wPtr, &mainRI, buffer);
+
+ /* 2. Draw the cells
+ */
+ Tix_GrDrawCells(wPtr, &mainRI, buffer);
+
+ /* 3. Draw the special sites (anchor, drag, drop).
+ */
+ Tix_GrDrawSites(wPtr, &mainRI, buffer);
+
+ /* done */
+ wPtr->renderInfo = NULL;
+
+ /* Free the unwanted colors: they are left overs from the "format"
+ * widget command.
+ */
+ Tix_GrFreeUnusedColors(wPtr, 0);
+}
+
+/*----------------------------------------------------------------------
+ * Tix_GrDrawCells --
+ *
+ * Redraws the cells of the Grid
+ *----------------------------------------------------------------------
+ */
+static void Tix_GrDrawCells(wPtr, riPtr, drawable)
+ WidgetPtr wPtr;
+ RenderInfo * riPtr;
+ Drawable drawable;
+{
+ int x, y, i, j;
+ int x1, y1, x2, y2;
+ TixGrEntry * chPtr;
+ int margin = wPtr->borderWidth + wPtr->highlightWidth;
+
+ for (x=0,i=0; i<wPtr->mainRB->size[0]; i++) {
+ x1 = x + margin;
+ x2 = x1 - 1 + wPtr->mainRB->dispSize[0][i].total;
+
+ if (x1 > wPtr->expArea.x2) {
+ goto nextCol;
+ }
+ if (x2 < wPtr->expArea.x1) {
+ goto nextCol;
+ }
+ /*
+ * iterate over the columns
+ */
+ for (y=0,j=0; j<wPtr->mainRB->size[1]; j++) {
+ /*
+ * iterate over each item in the column, from top
+ * to bottom
+ */
+ y1 = y + margin;
+ y2 = y1 - 1 + wPtr->mainRB->dispSize[1][j].total;
+
+ if (y1 > wPtr->expArea.y2) {
+ goto nextRow;
+ }
+ if (y2 < wPtr->expArea.y1) {
+ goto nextRow;
+ }
+ if (!wPtr->mainRB->elms[i][j].filled) {
+ if (wPtr->mainRB->elms[i][j].selected) {
+
+ Tk_Fill3DRectangle(wPtr->dispData.tkwin,
+ drawable, wPtr->selectBorder,
+ x+riPtr->origin[0]+
+ wPtr->mainRB->elms[i][j].borderW[0][0],
+ y+riPtr->origin[1]+
+ wPtr->mainRB->elms[i][j].borderW[1][0],
+ wPtr->mainRB->dispSize[0][i].total -
+ wPtr->mainRB->elms[i][j].borderW[0][0] -
+ wPtr->mainRB->elms[i][j].borderW[0][1],
+ wPtr->mainRB->dispSize[1][j].total -
+ wPtr->mainRB->elms[i][j].borderW[1][0] -
+ wPtr->mainRB->elms[i][j].borderW[1][1],
+ 0, TK_RELIEF_FLAT);
+ }
+ }
+
+ chPtr = wPtr->mainRB->elms[i][j].chPtr;
+ if (chPtr != NULL) {
+ if (Tix_DItemType(chPtr->iPtr) == TIX_DITEM_WINDOW) {
+ Tix_DItemDisplay(Tk_WindowId(wPtr->dispData.tkwin), None,
+ chPtr->iPtr, x1, y1,
+ wPtr->mainRB->dispSize[0][i].size,
+ wPtr->mainRB->dispSize[1][j].size,
+ TIX_DITEM_NORMAL_FG);
+ } else {
+ int drawX, drawY;
+ drawX = x + riPtr->origin[0] +
+ wPtr->mainRB->dispSize[0][i].preBorder;
+ drawY = y + riPtr->origin[1] +
+ wPtr->mainRB->dispSize[1][j].preBorder;
+
+ Tix_DItemDisplay(drawable, None, chPtr->iPtr,
+ drawX, drawY,
+ wPtr->mainRB->dispSize[0][i].size,
+ wPtr->mainRB->dispSize[1][j].size,
+ TIX_DITEM_NORMAL_FG);
+ }
+ }
+ nextRow:
+ y+= wPtr->mainRB->dispSize[1][j].total;
+ }
+ nextCol:
+ x+= wPtr->mainRB->dispSize[0][i].total;
+ }
+
+ for (i=0; i<wPtr->mainRB->size[0]; i++) {
+ for (j=0; j<wPtr->mainRB->size[1]; j++) {
+ chPtr = wPtr->mainRB->elms[i][j].chPtr;
+ if (chPtr != NULL) {
+ if (Tix_DItemType(chPtr->iPtr) == TIX_DITEM_WINDOW) {
+
+ Tix_SetWindowItemSerial(&wPtr->mappedWindows,
+ chPtr->iPtr, wPtr->serial);
+ }
+ }
+ }
+ }
+
+ /* unmap those windows we mapped the last time */
+ Tix_UnmapInvisibleWindowItems(&wPtr->mappedWindows, wPtr->serial);
+}
+
+/*----------------------------------------------------------------------
+ * Tix_GrDrawSites --
+ *
+ * Redraws the special sites (anchor, drag, drop)
+ *----------------------------------------------------------------------
+ */
+static void Tix_GrDrawSites(wPtr, riPtr, drawable)
+ WidgetPtr wPtr;
+ RenderInfo * riPtr;
+ Drawable drawable;
+{
+ int rect[2][2];
+ int visible;
+
+ visible = Tix_GrGetElementPosn(wPtr, wPtr->anchor[0], wPtr->anchor[1],
+ rect, 0, 1, 0, 0);
+ if (!visible) {
+ return;
+ }
+
+ Tix_DrawAnchorLines(Tk_Display(wPtr->dispData.tkwin), drawable,
+ wPtr->anchorGC,
+ rect[0][0] + riPtr->origin[0],
+ rect[1][0] + riPtr->origin[1],
+ rect[0][1] - rect[0][0] + 1,
+ rect[1][1] - rect[1][0] + 1);
+}
+
+/*----------------------------------------------------------------------
+ *
+ * Tix_GrGetElementPosn --
+ *
+ * Returns the position of a visible element on the screen.
+ *
+ * Arguments
+ * x,y: index of the element.
+ * rect: stores the return values: four sides of the cell.
+ * clipOK: if true and element is only partially visible, return only
+ * the visible portion.
+ * isSite: if (x,y) is a site, the return value depends on the
+ * selectUnit variable.
+ * isScr: should we return the position within the widget (true)
+ * or within the main display area (false).
+ * nearest:if the element is outside of the widget, should we return
+ * the position of the nearest element?
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tix_GrGetElementPosn(wPtr, x, y, rect, clipOK, isSite, isScr, nearest)
+ WidgetPtr wPtr;
+ int x;
+ int y;
+ int rect[2][2];
+ int clipOK; /* %% ignored */
+ int isSite;
+ int isScr;
+ int nearest;
+{
+ int i, j, pos[2];
+ int axis;
+ int useAxis;
+
+ if (wPtr->selectUnit == tixRowUid) {
+ axis = 0;
+ useAxis = 1;
+ }
+ else if (wPtr->selectUnit == tixColumnUid) {
+ axis = 1;
+ useAxis = 1;
+ }
+ else {
+ useAxis = 0;
+ }
+
+ /* %% didn't take care of the headers, etc */
+
+ pos[0] = x;
+ pos[1] = y;
+
+ /* clip the anchor site with the visible cells */
+ for (i=0; i<2; i++) {
+ if (pos[i] == TIX_SITE_NONE) {
+ return 0;
+ }
+
+ if (isSite && useAxis && i == axis) {
+ rect[i][0] = 0;
+ rect[i][1] = wPtr->mainRB->visArea[i]-1;
+ } else {
+ if (pos[i] >= wPtr->hdrSize[i]) {
+ pos[i] -= wPtr->scrollInfo[i].offset;
+ if (pos[i] < wPtr->hdrSize[i]) {
+ /* This cell has been scrolled "under the margins" */
+ return 0;
+ }
+ }
+
+ if (pos[i] < 0) {
+ if (!nearest) {
+ return 0;
+ }
+ pos[i] = 0;
+ }
+ if (pos[i] >= wPtr->mainRB->size[i]) {
+ if (!nearest) {
+ return 0;
+ }
+ pos[i] = wPtr->mainRB->size[i] - 1;
+ }
+ rect[i][0] = 0;
+ for (j=0; j<pos[i]; j++) {
+ rect[i][0] += wPtr->mainRB->dispSize[i][j].total;
+ }
+ rect[i][1] = rect[i][0] + wPtr->mainRB->dispSize[i][j].total - 1;
+ }
+ }
+
+ if (isScr) {
+ rect[0][0] += wPtr->bdPad;
+ rect[1][0] += wPtr->bdPad;
+ rect[0][1] += wPtr->bdPad;
+ rect[1][1] += wPtr->bdPad;
+ }
+
+ return 1;
+}
+
+/*----------------------------------------------------------------------
+ *
+ * "bdtype" sub command --
+ *
+ * Returns if the the screen position is at a border. This is useful
+ * for changing the mouse cursor when the user points at a border
+ * area. This indicates that the border can be adjusted interactively.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_GrBdType(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ Tk_Window tkwin = wPtr->dispData.tkwin;
+ int i, k, screenPos[2], bd[2], pos[2], in[2], bdWidth[2];
+ char buf[100];
+ int inX = 0;
+ int inY = 0;
+
+ if (argc != 2 && argc != 4) {
+ return Tix_ArgcError(interp, argc+2, argv-2, 2,
+ "x y ?xbdWidth ybdWidth?");
+ }
+
+ if (Tcl_GetInt(interp, argv[0], &screenPos[0]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[1], &screenPos[1]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (argc == 4) {
+ if (Tcl_GetInt(interp, argv[2], &bdWidth[0]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[3], &bdWidth[1]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ bdWidth[0] = -1;
+ bdWidth[1] = -1;
+ }
+
+ if (!Tk_IsMapped(tkwin)) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
+
+ if (wPtr->mainRB == NULL || wPtr->toResetRB) {
+ Tix_GrResetRenderBlocks(wPtr);
+ wPtr->toResetRB = 0;
+ }
+
+ screenPos[0] -= wPtr->highlightWidth - wPtr->borderWidth;
+ screenPos[1] -= wPtr->highlightWidth - wPtr->borderWidth;
+
+ for (i=0; i<2; i++) {
+ bd[i] = -1;
+ pos[i] = 0;
+ in[i] = 0;
+ for (k=0; k<wPtr->mainRB->size[i]; k++) {
+ ElmDispSize * elm = &wPtr->mainRB->dispSize[i][k];
+ if (screenPos[i] - elm->total <= 0) {
+ if (bdWidth[i] != -1) {
+ if (screenPos[i] < bdWidth[i]) {
+ bd[i] = k - 1;
+ pos[i] = k;
+ }
+ else if ((elm->total - screenPos[i]) <= bdWidth[i]) {
+ bd[i] = k;
+ pos[i] = k + 1;
+ }
+ else {
+ pos[i] = k;
+ }
+ } else {
+ if (screenPos[i] < elm->preBorder) {
+ bd[i] = k - 1;
+ pos[i] = k;
+ }
+ else if ((screenPos[i] - elm->preBorder - elm->size)>= 0) {
+ bd[i] = k;
+ pos[i] = k + 1;
+ }
+ else {
+ pos[i] = k;
+ }
+ }
+ in[i] = k;
+ break;
+ } else {
+ screenPos[i] -= elm->total;
+ }
+ }
+ }
+
+ if (in[0] < wPtr->hdrSize[0] && bd[1] >= 0) {
+ inY = 1;
+ }
+ else if (in[1] < wPtr->hdrSize[1] && bd[0] >= 0) {
+ inX = 1;
+ }
+
+ if (bd[0] < 0) {
+ bd[0] = 0;
+ }
+ if (bd[1] < 0) {
+ bd[1] = 0;
+ }
+
+ if (inX && inY) {
+ sprintf(buf, "xy %d %d", bd[0], bd[1]);
+ } else if (inX) {
+ sprintf(buf, "x %d %d", bd[0], bd[1]);
+ } else if (inY) {
+ sprintf(buf, "y %d %d", bd[0], bd[1]);
+ } else {
+ buf[0] = '\0';
+ }
+
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, buf, NULL);
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "set" sub command --
+ *
+ * Sets the item at the position on the grid. This either creates
+ * a new element or modifies the existing element. (if you don't want
+ * to change the -itemtype of the existing element, it will be more
+ * efficient to call the "itemconfigure" command).
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_GrSet(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ TixGrEntry * chPtr = NULL;
+ Tix_DItem * iPtr;
+ int x, y;
+ char * ditemType;
+ int code = TCL_OK;
+
+ /*------------------------------------------------------------
+ * (0) We need to find out where you want to set
+ *------------------------------------------------------------
+ */
+ if (TixGridDataGetIndex(interp, wPtr, argv[0], argv[1], &x, &y)!=TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*------------------------------------------------------------
+ * (1) We need to determine the option: -itemtype.
+ *------------------------------------------------------------
+ */
+ /* (1.0) Find out the -itemtype, if specified */
+ ditemType = wPtr->diTypePtr->name; /* default value */
+ if (argc > 2) {
+ size_t len;
+ int i;
+ if (argc %2 != 0) {
+ Tcl_AppendResult(interp, "value for \"", argv[argc-1],
+ "\" missing", NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+ for (i=2; i<argc; i+=2) {
+ len = strlen(argv[i]);
+ if (strncmp(argv[i], "-itemtype", len) == 0) {
+ ditemType = argv[i+1];
+ }
+ }
+ }
+
+ if (Tix_GetDItemType(interp, ditemType) == NULL) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * (2) Get this item (a new item will be allocated if it does not exist
+ * yet)
+ */
+ chPtr = Tix_GrFindCreateElem(interp, wPtr, x, y);
+
+ /* (2.1) The Display item data */
+ if ((iPtr = Tix_DItemCreate(&wPtr->dispData, ditemType)) == NULL) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ iPtr->base.clientData = (ClientData)wPtr; /* %%%% */
+
+ if (chPtr->iPtr) {
+ Tix_DItemFree(chPtr->iPtr);
+ }
+ chPtr->iPtr = iPtr;
+
+ if (ConfigElement(wPtr, chPtr, argc-2, argv+2, 0, 1) != TCL_OK) {
+ code = TCL_ERROR; goto done;
+ }
+ Tix_GrPropagateSize(wPtr, chPtr);
+
+ done:
+ if (code == TCL_ERROR) {
+ /* ? */
+ } else {
+ Tix_GrDoWhenIdle(wPtr, TIX_GR_RESIZE);
+ }
+
+ return code;
+}
+
+/*----------------------------------------------------------------------
+ * "unset" sub command
+ *----------------------------------------------------------------------
+ */
+
+static int
+Tix_GrUnset(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ TixGrEntry * chPtr;
+ int x, y;
+
+ if (TixGridDataGetIndex(interp, wPtr, argv[0], argv[1], &x, &y)
+ !=TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ chPtr = Tix_GrFindElem(interp, wPtr, x, y);
+ if (chPtr != NULL) {
+ TixGridDataDeleteEntry(wPtr->dataSet, x, y);
+ Tix_GrFreeElem(chPtr);
+ Tix_GrDoWhenIdle(wPtr, TIX_GR_RESIZE);
+ }
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "cget" sub command --
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_GrCGet(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+
+ return Tk_ConfigureValue(interp, wPtr->dispData.tkwin, configSpecs,
+ (char *)wPtr, argv[0], 0);
+}
+
+/*----------------------------------------------------------------------
+ * "configure" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_GrConfig(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+
+ if (argc == 0) {
+ return Tk_ConfigureInfo(interp, wPtr->dispData.tkwin, configSpecs,
+ (char *) wPtr, (char *) NULL, 0);
+ } else if (argc == 1) {
+ return Tk_ConfigureInfo(interp, wPtr->dispData.tkwin, configSpecs,
+ (char *) wPtr, argv[0], 0);
+ } else {
+ return WidgetConfigure(interp, wPtr, argc, argv,
+ TK_CONFIG_ARGV_ONLY);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * "delete" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_GrDelete(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int from, to, which;
+
+ if (TranslateFromTo(interp, wPtr, argc, argv, &from, &to, &which)!=TCL_OK){
+ return TCL_ERROR;
+ }
+ TixGridDataDeleteRange(wPtr, wPtr->dataSet, which, from, to);
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "edit" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_GrEdit(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int x, y;
+ Tcl_DString dstring;
+ char buff[20];
+ int len, code;
+
+ len = strlen(argv[0]);
+ if (strncmp(argv[0], "set", len) == 0) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # of arguments, must be: ",
+ argv[-2], " edit set x y", NULL);
+ }
+ if (TixGridDataGetIndex(interp, wPtr, argv[1], argv[2], &x, &y)
+ !=TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_DStringInit(&dstring);
+
+ Tcl_DStringAppendElement(&dstring, "tixGrid:EditCell");
+ Tcl_DStringAppendElement(&dstring, Tk_PathName(wPtr->dispData.tkwin));
+ sprintf(buff, "%d", x);
+ Tcl_DStringAppendElement(&dstring, buff);
+ sprintf(buff, "%d", y);
+ Tcl_DStringAppendElement(&dstring, buff);
+ } else if (strncmp(argv[0], "apply", len) == 0) {
+ if (argc != 1) {
+ Tcl_AppendResult(interp, "wrong # of arguments, must be: ",
+ argv[-2], " edit apply", NULL);
+ }
+ Tcl_DStringInit(&dstring);
+
+ Tcl_DStringAppendElement(&dstring, "tixGrid:EditApply");
+ Tcl_DStringAppendElement(&dstring, Tk_PathName(wPtr->dispData.tkwin));
+ } else {
+ Tcl_AppendResult(interp, "unknown option \"", argv[0],
+ "\", must be apply or set", NULL);
+ return TCL_ERROR;
+ }
+
+ code = Tcl_GlobalEval(interp, dstring.string);
+ Tcl_DStringFree(&dstring);
+
+ return code;
+}
+
+/*----------------------------------------------------------------------
+ * "entrycget" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_GrEntryCget(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int x, y;
+ TixGrEntry * chPtr;
+
+ if (TixGridDataGetIndex(interp, wPtr, argv[0], argv[1], &x, &y)!=TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ chPtr = Tix_GrFindElem(interp, wPtr, x, y);
+ if (!chPtr) {
+ Tcl_AppendResult(interp, "entry \"", argv[0], ",", argv[1],
+ "\" does not exist", NULL);
+ return TCL_ERROR;
+ }
+
+ return Tix_ConfigureValue2(interp, wPtr->dispData.tkwin, (char *)chPtr,
+ entryConfigSpecs, chPtr->iPtr, argv[2], 0);
+}
+
+/*----------------------------------------------------------------------
+ * "entryconfigure" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_GrEntryConfig(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int x, y;
+ TixGrEntry * chPtr;
+
+ if (TixGridDataGetIndex(interp, wPtr, argv[0], argv[1], &x, &y)!=TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ chPtr = Tix_GrFindElem(interp, wPtr, x, y);
+ if (!chPtr) {
+ Tcl_AppendResult(interp, "entry \"", argv[0], ",", argv[1],
+ "\" does not exist", NULL);
+ return TCL_ERROR;
+ }
+
+ if (argc == 2) {
+ return Tix_ConfigureInfo2(interp, wPtr->dispData.tkwin,
+ (char*)chPtr, entryConfigSpecs, chPtr->iPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ return Tix_ConfigureInfo2(interp, wPtr->dispData.tkwin,
+ (char*)chPtr, entryConfigSpecs, chPtr->iPtr, (char *) argv[2], 0);
+ } else {
+ return ConfigElement(wPtr, chPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY, 0);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * "geometryinfo" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_GrGeometryInfo(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int qSize[2];
+ double first[2], last[2];
+ char string[80];
+ int i;
+ Tix_GridScrollInfo scrollInfo[2];
+
+ if (argc == 2) {
+ if (Tcl_GetInt(interp, argv[0], &qSize[0]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[1], &qSize[1]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ qSize[0] = Tk_Width (wPtr->dispData.tkwin);
+ qSize[1] = Tk_Height(wPtr->dispData.tkwin);
+ }
+ qSize[0] -= 2*wPtr->borderWidth + 2*wPtr->highlightWidth;
+ qSize[1] -= 2*wPtr->borderWidth + 2*wPtr->highlightWidth;
+
+ RecalScrollRegion(wPtr, qSize[0], qSize[1], scrollInfo);
+
+ for (i=0; i<2; i++) {
+ qSize[i] -= 2*wPtr->borderWidth + 2*wPtr->highlightWidth;
+ GetScrollFractions(wPtr, &scrollInfo[i],
+ &first[i], &last[i]);
+ }
+
+ sprintf(string, "{%f %f} {%f %f}", first[0], last[0], first[1], last[1]);
+ Tcl_AppendResult(interp, string, NULL);
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "index" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_GrIndex(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int x, y;
+ char buff[100];
+
+ if (TixGridDataGetIndex(interp, wPtr, argv[0], argv[1], &x, &y)!=TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ sprintf(buff, "%d %d", x, y);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, buff, NULL);
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "info" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_GrInfo(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ size_t len = strlen(argv[0]);
+ int x, y;
+
+ if (strncmp(argv[0], "bbox", len)==0) {
+ if (argc != 3) {
+ return Tix_ArgcError(interp, argc+2, argv-2, 3, "x y");
+ }
+ if (TixGridDataGetIndex(interp, wPtr, argv[1], argv[2], &x, &y)
+ !=TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ return Tix_GrBBox(interp, wPtr, x, y);
+ }
+ else if (strncmp(argv[0], "exists", len)==0) {
+ if (argc != 3) {
+ return Tix_ArgcError(interp, argc+2, argv-2, 3, "x y");
+ }
+ if (TixGridDataGetIndex(interp, wPtr, argv[1], argv[2], &x, &y)
+ !=TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tix_GrFindElem(interp, wPtr, x, y)) {
+ Tcl_SetResult(interp, "1", TCL_STATIC);
+ } else {
+ Tcl_SetResult(interp, "0", TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ else {
+ Tcl_AppendResult(interp, "unknown option \"", argv[0],
+ "\": must be bbox or exists",
+ NULL);
+ return TCL_ERROR;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * "move" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_GrMove(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int from, to, which, by;
+
+ if (TranslateFromTo(interp, wPtr, 3, argv, &from, &to, &which)!=TCL_OK){
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[3], &by) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+TixGridDataMoveRange(wPtr, wPtr->dataSet, which, from, to, by);
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "nearest" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_GrNearest(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ Tk_Window tkwin = wPtr->dispData.tkwin;
+ int i, k, screenPos[2], rbPos[2];
+ char buf[100];
+ RenderBlockElem* rePtr;
+
+ if (Tcl_GetInt(interp, argv[0], &screenPos[0]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[1], &screenPos[1]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (!Tk_IsMapped(tkwin)) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
+
+ if (wPtr->mainRB == NULL || wPtr->toResetRB) {
+ Tix_GrResetRenderBlocks(wPtr);
+ wPtr->toResetRB = 0;
+ }
+
+ screenPos[0] -= wPtr->highlightWidth - wPtr->borderWidth;
+ screenPos[1] -= wPtr->highlightWidth - wPtr->borderWidth;
+
+ for (i=0; i<2; i++) {
+ for (k=0; k<wPtr->mainRB->size[i]; k++) {
+ screenPos[i] -= wPtr->mainRB->dispSize[i][k].total;
+ if (screenPos[i]<=0) {
+ break;
+ }
+ }
+ if (k >= wPtr->mainRB->size[i]) {
+ k = wPtr->mainRB->size[i] - 1;
+ }
+ rbPos[i] = k;
+ }
+ rePtr = &(wPtr->mainRB->elms[rbPos[0]][rbPos[1]]);
+
+ sprintf(buf, "%d %d", rePtr->index[0], rePtr->index[1]);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, buf, NULL);
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "anchor", "dragsite" and "dropsire" sub commands --
+ *
+ * Set/remove the anchor element
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_GrSetSite(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int changed = 0;
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int * changePtr;
+ size_t len;
+ int changedRect[2][2];
+
+ /*
+ * Determine which site should be changed (the last else clause
+ * doesn't need to check the string because HandleSubCommand
+ * already ensures that only the valid options can be specified.
+ */
+ len = strlen(argv[-1]);
+ if (strncmp(argv[-1], "anchor", len)==0) {
+ changePtr = wPtr->anchor;
+ }
+ else if (strncmp(argv[-1], "dragsite", len)==0) {
+ changePtr = wPtr->dragSite;
+ }
+ else {
+ changePtr = wPtr->dropSite;
+ }
+
+ len = strlen(argv[0]);
+ if (strncmp(argv[0], "get", len)==0) {
+ char buf[100];
+
+ sprintf(buf, "%d %d", changePtr[0], changePtr[1]);
+ Tcl_SetResult(interp, buf, TCL_VOLATILE);
+
+ return TCL_OK;
+ } else if (strncmp(argv[0], "set", len)==0) {
+ if (argc == 3) {
+ int x, y;
+
+ if (TixGridDataGetIndex(interp, wPtr, argv[1], argv[2],
+ &x, &y)!=TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (x != changePtr[0] || y != changePtr[1]) {
+ changedRect[0][0] = x;
+ changedRect[1][0] = y;
+ changedRect[0][1] = changePtr[0];
+ changedRect[1][1] = changePtr[1];
+ changed = 1;
+
+ changePtr[0] = x;
+ changePtr[1] = y;
+ }
+ } else {
+ Tcl_AppendResult(interp, "wrong # of arguments, must be: ",
+ Tk_PathName(wPtr->dispData.tkwin), " ", argv[-1],
+ " set x y", NULL);
+ return TCL_ERROR;
+ }
+ }
+ else if (strncmp(argv[0], "clear", len)==0) {
+ if (argc == 1) {
+ if (changePtr[0] !=TIX_SITE_NONE || changePtr[1] !=TIX_SITE_NONE) {
+ changedRect[0][0] = TIX_SITE_NONE;
+ changedRect[1][0] = TIX_SITE_NONE;
+ changedRect[0][1] = changePtr[0];
+ changedRect[1][1] = changePtr[1];
+ changed = 1;
+
+ changePtr[0] = TIX_SITE_NONE;
+ changePtr[1] = TIX_SITE_NONE;
+ }
+ } else {
+ Tcl_AppendResult(interp, "wrong # of arguments, must be: ",
+ Tk_PathName(wPtr->dispData.tkwin), " ", argv[-1],
+ " clear", NULL);
+ return TCL_ERROR;
+ }
+ }
+ else {
+ Tcl_AppendResult(interp, "wrong option \"", argv[0], "\", ",
+ "must be clear, get or set", NULL);
+ return TCL_ERROR;
+ }
+
+ if (changed) {
+ Tix_GrAddChangedRect(wPtr, changedRect, 1);
+ }
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_GrAddChangedRect --
+ *
+ * Add the "changed" region to the exposedArea structure.
+ *----------------------------------------------------------------------
+ */
+void
+Tix_GrAddChangedRect(wPtr, changedRect, isSite)
+ WidgetPtr wPtr;
+ int changedRect[2][2];
+ int isSite;
+{
+ int rect[2][2];
+ int visible;
+ int i;
+ int changed = 0;
+
+ if (wPtr->mainRB == NULL) {
+ /*
+ * The grid will be completely refreshed. Don't do anything
+ */
+ return;
+ }
+
+ for (i=0; i<2; i++) {
+ visible = Tix_GrGetElementPosn(wPtr, changedRect[0][i],
+ changedRect[1][i], rect, 1, isSite, 1, 1);
+ if (!visible) {
+ continue;
+ }
+ if (wPtr->expArea.x1 > rect[0][0]) {
+ wPtr->expArea.x1 = rect[0][0];
+ changed = 1;
+ }
+ if (wPtr->expArea.x2 < rect[0][1]) {
+ wPtr->expArea.x2 = rect[0][1];
+ changed = 1;
+ }
+ if (wPtr->expArea.y1 > rect[1][0]) {
+ wPtr->expArea.y1 = rect[1][0];
+ changed = 1;
+ }
+ if (wPtr->expArea.y2 < rect[1][1]) {
+ wPtr->expArea.y2 = rect[1][1];
+ changed = 1;
+ }
+ }
+ if (changed) {
+ Tix_GrDoWhenIdle(wPtr, TIX_GR_REDRAW);
+ }
+}
+
+void Tix_GrScrollPage(wPtr, count, axis)
+ WidgetPtr wPtr;
+ int count;
+ int axis;
+{
+ int k, i = axis;
+ int winSize, sz, start, num;
+ int pad0, pad1;
+
+ Tix_GridScrollInfo * siPtr = &wPtr->scrollInfo[axis];
+ int gridSize[2];
+
+ if (count == 0) {
+ return;
+ }
+
+ TixGridDataGetGridSize(wPtr->dataSet, &gridSize[0],
+ &gridSize[1]);
+
+ if (gridSize[i] < wPtr->hdrSize[i]) { /* no scrollable data */
+ return;
+ }
+
+ if (axis == 0) {
+ winSize = Tk_Width(wPtr->dispData.tkwin);
+ } else {
+ winSize = Tk_Height(wPtr->dispData.tkwin);
+ }
+ winSize -= 2*wPtr->highlightWidth + 2*wPtr->borderWidth;
+
+ for (k=0; k<wPtr->hdrSize[i] && k<gridSize[i]; k++) {
+ winSize -= TixGridDataGetRowColSize(wPtr, wPtr->dataSet, i,
+ k, &wPtr->defSize[i], &pad0, &pad1);
+ winSize -= pad0 + pad1;
+ }
+
+ if (winSize <= 0) {
+ return;
+ }
+
+ if (count > 0) {
+ start = siPtr->offset + wPtr->hdrSize[i];
+ for (; count > 0; count--) {
+ sz = winSize;
+
+ for (num=0,k=start; k<gridSize[i]; k++,num++) {
+ sz -= TixGridDataGetRowColSize(wPtr, wPtr->dataSet, i,
+ k, &wPtr->defSize[i], &pad0, &pad1);
+ sz -= pad0 + pad1;
+ if (sz == 0) {
+ num++;
+ break;
+ }
+ if (sz < 0) {
+ break;
+ }
+ }
+ if (num==0) {
+ num++;
+ }
+ start += num;
+ }
+ siPtr->offset = start - wPtr->hdrSize[i];
+ }
+ else {
+ start = siPtr->offset + wPtr->hdrSize[i];
+
+ for (; count < 0; count++) {
+ sz = winSize;
+
+ for (num=0,k=start-1; k>=wPtr->hdrSize[i]; k--,num++) {
+ sz -= TixGridDataGetRowColSize(wPtr, wPtr->dataSet, i,
+ k, &wPtr->defSize[i], &pad0, &pad1);
+ sz -= pad0 + pad1;
+ if (sz == 0) {
+ num++;
+ break;
+ }
+ if (sz < 0) {
+ break;
+ }
+ }
+ if (num==0) {
+ num++;
+ }
+ start -= num;
+ }
+ siPtr->offset = start - wPtr->hdrSize[i];
+ }
+}
+
+/*----------------------------------------------------------------------
+ * "xview" and "yview" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_GrView(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int axis, oldXOff, oldYOff;
+ Tix_GridScrollInfo * siPtr;
+
+ if (argv[-1][0] == 'x') {
+ axis = 0;
+ } else {
+ axis = 1;
+ }
+
+ oldXOff = wPtr->scrollInfo[0].offset;
+ oldYOff = wPtr->scrollInfo[1].offset;
+
+ if (argc == 0) {
+ char string[100];
+ double first, last;
+
+ GetScrollFractions(wPtr, &wPtr->scrollInfo[axis], &first, &last);
+ sprintf(string, "%f %f", first, last);
+ Tcl_AppendResult(interp, string, NULL);
+ return TCL_OK;
+ }
+ else {
+ int offset;
+ siPtr = &wPtr->scrollInfo[axis];
+
+ if (Tcl_GetInt(interp, argv[0], &offset) == TCL_OK) {
+ /* backward-compatible mode */
+ siPtr->offset = offset;
+ } else {
+ int type, count;
+ double fraction;
+
+ Tcl_ResetResult(interp);
+
+ /* Tk_GetScrollInfo () wants strange argc,argv combinations .. */
+ type = Tk_GetScrollInfo(interp, argc+2, argv-2, &fraction, &count);
+
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ return TCL_ERROR;
+
+ case TK_SCROLL_MOVETO:
+ if (siPtr->window < 1.0) {
+ fraction /= (1.0 - siPtr->window);
+ }
+
+ siPtr->offset = (int)(fraction * (siPtr->max+1));
+ break;
+
+ case TK_SCROLL_PAGES:
+ Tix_GrScrollPage(wPtr, count, axis);
+ break;
+
+ case TK_SCROLL_UNITS:
+ siPtr->offset += count * siPtr->unit;
+ break;
+ }
+ }
+ /* check ... */
+ if (siPtr->offset < 0) {
+ siPtr->offset = 0;
+ }
+ if (siPtr->offset > siPtr->max) {
+ siPtr->offset = siPtr->max;
+ }
+ }
+
+#if 0
+ printf("Configing Scrollbars: (%d %f %d) (%d %f %d)\n",
+ wPtr->scrollInfo[0].max,
+ wPtr->scrollInfo[0].window,
+ wPtr->scrollInfo[0].offset,
+ wPtr->scrollInfo[1].max,
+ wPtr->scrollInfo[1].window,
+ wPtr->scrollInfo[1].offset);
+#endif
+
+ if (oldXOff != wPtr->scrollInfo[0].offset ||
+ oldYOff != wPtr->scrollInfo[1].offset) {
+ wPtr->toResetRB = 1;
+ wPtr->toComputeSel = 1;
+ Tix_GrDoWhenIdle(wPtr, TIX_GR_REDRAW);
+ }
+ return TCL_OK;
+}
+/*----------------------------------------------------------------------
+ *
+ *
+ * Memory Management Section
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ConfigElement(wPtr, chPtr, argc, argv, flags, forced)
+ WidgetPtr wPtr;
+ TixGrEntry *chPtr;
+ int argc;
+ char ** argv;
+ int flags;
+ int forced;
+{
+ int sizeChanged;
+
+ if (Tix_WidgetConfigure2(wPtr->dispData.interp, wPtr->dispData.tkwin,
+ (char*)chPtr, entryConfigSpecs, chPtr->iPtr, argc, argv, flags,
+ forced, &sizeChanged) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (sizeChanged) {
+ /* %% be smart here: sometimes the size request doesn't need to
+ * be changed
+ */
+ Tix_GrDoWhenIdle(wPtr, TIX_GR_RESIZE);
+ } else {
+ /* set the exposed area */
+ Tix_GrDoWhenIdle(wPtr, TIX_GR_REDRAW);
+ }
+ return TCL_OK;
+}
+
+static char * areaNames[4] = {
+ "s-margin",
+ "x-margin",
+ "y-margin",
+ "main"
+};
+
+static int
+Tix_GrCallFormatCmd(wPtr, which)
+ WidgetPtr wPtr;
+ int which;
+{
+ int size;
+ int code;
+ char * p;
+ char preAlloc[1000];
+
+ size = strlen(wPtr->formatCmd) + 20*4;
+ if (size > 1000) {
+ p = (char*)ckalloc(size);
+ } else {
+ p = preAlloc;
+ }
+
+ wPtr->renderInfo->fmt.whichArea = which;
+ sprintf(p, "%s %s %d %d %d %d", wPtr->formatCmd, areaNames[which],
+ wPtr->renderInfo->fmt.x1,
+ wPtr->renderInfo->fmt.y1,
+ wPtr->renderInfo->fmt.x2,
+ wPtr->renderInfo->fmt.y2);
+ code = Tcl_GlobalEval(wPtr->dispData.interp, p);
+
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(wPtr->dispData.interp,
+ "\n (format command executed by tixGrid)");
+ Tk_BackgroundError(wPtr->dispData.interp);
+ }
+
+ if (p != preAlloc) {
+ ckfree((char*)p);
+ }
+
+ return code;
+}
+
+
+static void Tix_GrDrawBackground(wPtr, riPtr, drawable)
+ WidgetPtr wPtr;
+ RenderInfo * riPtr;
+ Drawable drawable;
+{
+ int mainSize[2];
+ int visibleHdr[2];
+
+ if (wPtr->formatCmd == NULL) {
+ return;
+ }
+
+ /* The visible size of the main area
+ */
+ mainSize[0] = wPtr->mainRB->size[0] - wPtr->hdrSize[0];
+ mainSize[1] = wPtr->mainRB->size[1] - wPtr->hdrSize[1];
+ if (mainSize[0] < 0) {
+ mainSize[0] = 0;
+ }
+ if (mainSize[1] < 0) {
+ mainSize[1] = 0;
+ }
+
+ /* the visible header size
+ */
+ if (wPtr->mainRB->size[0] < wPtr->hdrSize[0]) {
+ visibleHdr[0] = wPtr->mainRB->size[0];
+ } else {
+ visibleHdr[0] = wPtr->hdrSize[0];
+ }
+ if (wPtr->mainRB->size[1] < wPtr->hdrSize[1]) {
+ visibleHdr[1] = wPtr->mainRB->size[1];
+ } else {
+ visibleHdr[1] = wPtr->hdrSize[1];
+ }
+
+
+ /* the horizontal margin
+ */
+ if (wPtr->hdrSize[1] > 0 && mainSize[0] > 0) {
+ wPtr->renderInfo->fmt.x1 =
+ wPtr->scrollInfo[0].offset + wPtr->hdrSize[0];
+ wPtr->renderInfo->fmt.x2 =
+ wPtr->renderInfo->fmt.x1 + mainSize[0] - 1;
+ wPtr->renderInfo->fmt.y1 = 0;
+ wPtr->renderInfo->fmt.y2 = visibleHdr[1] - 1;
+
+ Tix_GrCallFormatCmd(wPtr, TIX_X_MARGIN);
+ }
+
+ /* the vertical margin
+ */
+ if (wPtr->hdrSize[0] > 0 && mainSize[1] > 0) {
+ wPtr->renderInfo->fmt.x1 = 0;
+ wPtr->renderInfo->fmt.x2 = visibleHdr[0] - 1;
+ wPtr->renderInfo->fmt.y1 =
+ wPtr->scrollInfo[1].offset + wPtr->hdrSize[1];
+ wPtr->renderInfo->fmt.y2 =
+ wPtr->renderInfo->fmt.y1 + mainSize[1] - 1;
+
+ Tix_GrCallFormatCmd(wPtr, TIX_Y_MARGIN);
+ }
+
+ /* the stationary part of the margin
+ */
+ if (visibleHdr[0] > 0 && visibleHdr[1] > 0) {
+ wPtr->renderInfo->fmt.x1 = 0;
+ wPtr->renderInfo->fmt.x2 = visibleHdr[0] - 1;
+ wPtr->renderInfo->fmt.y1 = 0;
+ wPtr->renderInfo->fmt.y2 = visibleHdr[1] - 1;
+
+ Tix_GrCallFormatCmd(wPtr, TIX_S_MARGIN);
+ }
+
+ /* the main area
+ */
+ if (mainSize[0] > 0 && mainSize[1] > 0) {
+ wPtr->renderInfo->fmt.x1 =
+ wPtr->scrollInfo[0].offset + wPtr->hdrSize[0];
+ wPtr->renderInfo->fmt.x2 =
+ wPtr->renderInfo->fmt.x1 + mainSize[0] - 1;
+ wPtr->renderInfo->fmt.y1 =
+ wPtr->scrollInfo[1].offset + wPtr->hdrSize[1];
+ wPtr->renderInfo->fmt.y2 =
+ wPtr->renderInfo->fmt.y1 + mainSize[1] - 1;
+
+ Tix_GrCallFormatCmd(wPtr, TIX_MAIN);
+ }
+}
+
+static void
+Tix_GrComputeSubSelection(wPtr, rect, offs)
+ WidgetPtr wPtr;
+ int rect[2][2];
+ int offs[2];
+{
+ int iMin, iMax, jMin, jMax;
+ Tix_ListIterator li;
+ SelectBlock * sbPtr;
+ int i, j, x, y;
+
+ Tix_SimpleListIteratorInit(&li);
+ for (Tix_SimpleListStart(&wPtr->selList, &li);
+ !Tix_SimpleListDone(&li);
+ Tix_SimpleListNext (&wPtr->selList, &li)) {
+
+ sbPtr = (SelectBlock *)li.curr;
+
+ /* clip the X direction
+ */
+ if (rect[0][0] > sbPtr->range[0][0]) {
+ iMin = rect[0][0];
+ } else {
+ iMin = sbPtr->range[0][0];
+ }
+
+ if (rect[0][1]<sbPtr->range[0][1] || sbPtr->range[0][1]==TIX_GR_MAX) {
+ iMax = rect[0][1];
+ } else {
+ iMax = sbPtr->range[0][1];
+ }
+ if (iMin > iMax) {
+ continue;
+ }
+
+ /* clip the Y direction
+ */
+ if (rect[1][0] > sbPtr->range[1][0]) {
+ jMin = rect[1][0];
+ } else {
+ jMin = sbPtr->range[1][0];
+ }
+ if (rect[1][1]<sbPtr->range[1][1] || sbPtr->range[1][1]==TIX_GR_MAX) {
+ jMax = rect[1][1];
+ } else {
+ jMax = sbPtr->range[1][1];
+ }
+ if (jMin > jMax) {
+ continue;
+ }
+
+ for (i=iMin; i<=iMax; i++) {
+ for (j=jMin; j<=jMax; j++) {
+ x = i - offs[0];
+ y = j - offs[1];
+
+ switch (sbPtr->type) {
+ case TIX_GR_CLEAR:
+ wPtr->mainRB->elms[x][y].selected = 0;
+ break;
+ case TIX_GR_SET:
+ wPtr->mainRB->elms[x][y].selected = 1;
+ break;
+ case TIX_GR_TOGGLE:
+ wPtr->mainRB->elms[x][y].selected =
+ !wPtr->mainRB->elms[x][y].selected;
+ break;
+
+ }
+ }
+ }
+ }
+}
+
+static void Tix_GrComputeSelection(wPtr)
+ WidgetPtr wPtr;
+{
+ int rect[2][2], offs[2];
+ int i, j;
+ int mainSize[2];
+ int visibleHdr[2];
+
+ for (i=0; i<wPtr->mainRB->size[0]; i++) {
+ for (j=0; j<wPtr->mainRB->size[1]; j++) {
+ wPtr->mainRB->elms[i][j].selected = 0;
+ }
+ }
+
+ /* Get the visible size of the main area
+ */
+ mainSize[0] = wPtr->mainRB->size[0] - wPtr->hdrSize[0];
+ mainSize[1] = wPtr->mainRB->size[1] - wPtr->hdrSize[1];
+ if (mainSize[0] < 0) {
+ mainSize[0] = 0;
+ }
+ if (mainSize[1] < 0) {
+ mainSize[1] = 0;
+ }
+
+ /* Get the visible header size
+ */
+ if (wPtr->mainRB->size[0] < wPtr->hdrSize[0]) {
+ visibleHdr[0] = wPtr->mainRB->size[0];
+ } else {
+ visibleHdr[0] = wPtr->hdrSize[0];
+ }
+ if (wPtr->mainRB->size[1] < wPtr->hdrSize[1]) {
+ visibleHdr[1] = wPtr->mainRB->size[1];
+ } else {
+ visibleHdr[1] = wPtr->hdrSize[1];
+ }
+
+ /* Compute selection on the stationary part of the margin
+ */
+ if (visibleHdr[0] > 0 && visibleHdr[1] > 0) {
+ rect[0][0] = 0;
+ rect[0][1] = visibleHdr[0] - 1;
+ rect[1][0] = 0;
+ rect[1][1] = visibleHdr[1] - 1;
+ offs[0] = 0;
+ offs[1] = 0;
+
+ Tix_GrComputeSubSelection(wPtr, rect, offs);
+ }
+
+ /* Compute selection on the horizontal margin
+ */
+ if (wPtr->hdrSize[1] > 0 && mainSize[0] > 0) {
+ rect[0][0] = wPtr->scrollInfo[0].offset + wPtr->hdrSize[0];
+ rect[0][1] = rect[0][0] + mainSize[0] - 1;
+ rect[1][0] = 0;
+ rect[1][1] = visibleHdr[1] - 1;
+ offs[0] = wPtr->scrollInfo[0].offset;;
+ offs[1] = 0;
+
+ Tix_GrComputeSubSelection(wPtr, rect, offs);
+ }
+
+ /* Compute selection on the vertical margin
+ */
+ if (wPtr->hdrSize[0] > 0 && mainSize[1] > 0) {
+ rect[0][0] = 0;
+ rect[0][1] = visibleHdr[0] - 1;
+ rect[1][0] = wPtr->scrollInfo[1].offset + wPtr->hdrSize[1];
+ rect[1][1] = rect[1][0] + mainSize[1] - 1;
+ offs[0] = 0;
+ offs[1] = wPtr->scrollInfo[1].offset;;
+
+ Tix_GrComputeSubSelection(wPtr, rect, offs);
+ }
+
+ /* Compute selection on the main area
+ */
+ if (mainSize[0] > 0 && mainSize[1] > 0) {
+ rect[0][0] = wPtr->scrollInfo[0].offset + wPtr->hdrSize[0];
+ rect[0][1] = rect[0][0] + mainSize[0] - 1;
+ rect[1][0] = wPtr->scrollInfo[1].offset + wPtr->hdrSize[1];
+ rect[1][1] = rect[1][0] + mainSize[1] - 1;
+ offs[0] = wPtr->scrollInfo[0].offset;;
+ offs[1] = wPtr->scrollInfo[1].offset;;
+
+ Tix_GrComputeSubSelection(wPtr, rect, offs);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * UpdateScrollBars
+ *----------------------------------------------------------------------
+ */
+static void
+GetScrollFractions(wPtr, siPtr, first_ret, last_ret)
+ WidgetPtr wPtr;
+ Tix_GridScrollInfo *siPtr;
+ double * first_ret;
+ double * last_ret;
+{
+ double first, last;
+ double usuable;
+
+ usuable = 1.0 - siPtr->window;
+
+ if (siPtr->max > 0) {
+ first = usuable * (double)(siPtr->offset) / (double)(siPtr->max);
+ last = first + siPtr->window;
+ } else {
+ first = 0.0;
+ last = 1.0;
+ }
+
+ *first_ret = first;
+ *last_ret = last;
+}
+
+static void UpdateScrollBars(wPtr, sizeChanged)
+ WidgetPtr wPtr;
+ int sizeChanged;
+{
+ int i;
+ Tix_GridScrollInfo *siPtr;
+ Tcl_Interp * interp = wPtr->dispData.interp;
+
+ for (i=0; i<2; i++) {
+ double first, last;
+ double usuable;
+
+ siPtr = &wPtr->scrollInfo[i];
+
+ usuable = 1.0 - siPtr->window;
+
+ if (siPtr->max > 0) {
+ first = usuable * (double)(siPtr->offset) / (double)(siPtr->max);
+ last = first + siPtr->window;
+ } else {
+ first = 0.0;
+ last = 1.0;
+ }
+
+ if (siPtr->command) {
+ char buff[60];
+
+ sprintf(buff, " %f %f", first, last);
+ if (Tcl_VarEval(interp, siPtr->command, buff,
+ (char *) NULL) != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (scrolling command executed by tixGrid)");
+ Tk_BackgroundError(interp);
+ }
+ }
+ }
+
+ if (wPtr->sizeCmd && sizeChanged) {
+ if (Tcl_GlobalEval(wPtr->dispData.interp, wPtr->sizeCmd) != TCL_OK) {
+ Tcl_AddErrorInfo(wPtr->dispData.interp,
+ "\n (size command executed by tixGrid)");
+ Tk_BackgroundError(wPtr->dispData.interp);
+ }
+ }
+}
+
+/*----------------------------------------------------------------------
+ * Tix_GrFindCreateElem --
+ *
+ * Returns the element. If it doesn't exist, create a new one
+ * and return it.
+ *----------------------------------------------------------------------
+ */
+
+static TixGrEntry *
+Tix_GrFindCreateElem(interp, wPtr, x, y)
+ Tcl_Interp * interp;
+ WidgetPtr wPtr;
+ int x;
+ int y;
+{
+ static TixGrEntry * defaultEntry = NULL;
+ TixGrEntry * chPtr;
+
+ if (defaultEntry == NULL) {
+ defaultEntry = (TixGrEntry*)ckalloc(sizeof(TixGrEntry));
+ defaultEntry->iPtr = NULL;
+ }
+
+ chPtr = (TixGrEntry*)TixGridDataCreateEntry(wPtr->dataSet, x, y,
+ (char*)defaultEntry);
+
+ if (chPtr == defaultEntry) {
+ defaultEntry = NULL;
+ }
+
+ return chPtr;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_GrFindElem --
+ *
+ * Return the element if it exists. Otherwise returns 0.
+ *----------------------------------------------------------------------
+ */
+static TixGrEntry *
+Tix_GrFindElem(interp, wPtr, x, y)
+ Tcl_Interp * interp; /* Used for error reporting */
+ WidgetPtr wPtr; /* The grid widget */
+ int x; /* X coord of the entry */
+ int y; /* Y coord of the entry */
+{
+ return (TixGrEntry*)TixGridDataFindEntry(wPtr->dataSet, x, y);
+}
+
+/*----------------------------------------------------------------------
+ * Tix_GrFreeElem --
+ *
+ * Frees the element.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tix_GrFreeElem(chPtr)
+ TixGrEntry * chPtr; /* The element fo free */
+{
+ if (chPtr->iPtr) {
+ Tix_DItemFree(chPtr->iPtr);
+ }
+ ckfree((char*)chPtr);
+}
+
+static void
+Tix_GrPropagateSize(wPtr, chPtr)
+ WidgetPtr wPtr;
+ TixGrEntry * chPtr;
+{
+#if 0
+ int i;
+
+ for (i=0; i<2; i++) {
+ TreeListRoot * rPtr;
+ GridHeader * hdr;
+
+ rPtr = chPtr->nodes[i].root;
+ hdr = (GridHeader*) rPtr->data;
+
+ if (hdr->size < chPtr->size[i]) {
+ hdr->size = chPtr->size[i];
+ hdr->recalSize = 0;
+ }
+ }
+#endif
+}
+
+static RenderBlock * Tix_GrAllocateRenderBlock(wPtr, winW, winH, exactW,exactH)
+ WidgetPtr wPtr;
+ int winW;
+ int winH;
+ int * exactW;
+ int * exactH;
+{
+ RenderBlock * rbPtr;
+ int i, j, k;
+ int offset[2]; /* how much the entries were scrolled */
+ int winSize[2];
+ int exactSize[2]; /* BOOL: are all the visible coloums and rows
+ * displayed in whole */
+ int pad0, pad1;
+
+ offset[0] = wPtr->scrollInfo[0].offset + wPtr->hdrSize[0];
+ offset[1] = wPtr->scrollInfo[1].offset + wPtr->hdrSize[1];
+
+ winSize[0] = winW;
+ winSize[1] = winH;
+
+ rbPtr = (RenderBlock*)ckalloc(sizeof(RenderBlock));
+
+ rbPtr->size[0]=0;
+ rbPtr->size[1]=0;
+ rbPtr->visArea[0] = winW;
+ rbPtr->visArea[1] = winH;
+
+ /* (1) find out the size requirement of each row and column.
+ * The results are stored in rbPtr->size[i] and
+ * rbPtr->dispSize[i][0 .. (rbPtr->size[i]-1)]
+ */
+ for (i=0; i<2; i++) {
+ /* i=0 : handle the column sizes;
+ * i=1 : handle the row sizes;
+ */
+ int index;
+ int pixelSize = 0;
+
+ /* The margins */
+ for (index=0; index<wPtr->hdrSize[i] && pixelSize<winSize[i]; index++){
+ pixelSize += TixGridDataGetRowColSize(wPtr, wPtr->dataSet, i,
+ index, &wPtr->defSize[i], &pad0, &pad1);
+ pixelSize += pad0 + pad1;
+ rbPtr->size[i] ++;
+ }
+
+ for (index=offset[i]; pixelSize<winSize[i]; index++) {
+ pixelSize += TixGridDataGetRowColSize(wPtr, wPtr->dataSet, i,
+ index, &wPtr->defSize[i], &pad0, &pad1);
+ pixelSize += pad0 + pad1;
+ rbPtr->size[i] ++;
+ }
+ if (pixelSize == winSize[i]) {
+ exactSize[i] = 1;
+ } else {
+ exactSize[i] = 0;
+ }
+ }
+
+ /* return values */
+
+ *exactW = exactSize[0];
+ *exactH = exactSize[1];
+
+ rbPtr->dispSize[0] = (ElmDispSize*)
+ ckalloc(sizeof(ElmDispSize)*rbPtr->size[0]);
+ rbPtr->dispSize[1] = (ElmDispSize*)
+ ckalloc(sizeof(ElmDispSize)*rbPtr->size[1]);
+
+ /*
+ * (2) fill the size info of all the visible rows and cols into
+ * the dispSize arrays;
+ */
+
+ for (i=0; i<2; i++) {
+ /*
+ * i=0 : handle the column sizes;
+ * i=1 : handle the row sizes;
+ */
+ int index;
+
+ for (k=0; k<rbPtr->size[i]; k++) {
+ if (k < wPtr->hdrSize[i]) { /* The margins */
+ index = k;
+ } else {
+ index = k + offset[i] - wPtr->hdrSize[i];
+ }
+
+ rbPtr->dispSize[i][k].size = TixGridDataGetRowColSize(wPtr,
+ wPtr->dataSet, i, index, &wPtr->defSize[i], &pad0, &pad1);
+ rbPtr->dispSize[i][k].preBorder = pad0;
+ rbPtr->dispSize[i][k].postBorder = pad1;
+ }
+ }
+
+ /*
+ * (3) Put the visible elements into the render block array,
+ * rbPtr->elms[*][*].
+ */
+ rbPtr->elms = (RenderBlockElem**)
+ ckalloc(sizeof(RenderBlockElem*)*rbPtr->size[0]);
+
+ for (i=0; i<rbPtr->size[0]; i++) {
+ rbPtr->elms[i] = (RenderBlockElem*)
+ ckalloc(sizeof(RenderBlockElem) * rbPtr->size[1]);
+ for (j=0; j<rbPtr->size[1]; j++) {
+ rbPtr->elms[i][j].chPtr = NULL;
+ rbPtr->elms[i][j].selected = 0;
+ }
+ }
+
+ for (i=0; i<rbPtr->size[0]; i++) {
+ for (j=0; j<rbPtr->size[1]; j++) {
+ int x, y;
+
+ if (i<wPtr->hdrSize[0]) {
+ x = i;
+ } else {
+ x = i+offset[0]-wPtr->hdrSize[0];
+ }
+
+ if (j<wPtr->hdrSize[1]) {
+ y = j;
+ } else {
+ y = j+offset[1]-wPtr->hdrSize[1];
+ }
+
+ rbPtr->elms[i][j].chPtr = (TixGrEntry*) TixGridDataFindEntry(
+ wPtr->dataSet, x, y);
+ rbPtr->elms[i][j].index[0] = x;
+ rbPtr->elms[i][j].index[1] = y;
+ }
+ }
+
+ for (k=0; k<2; k++) {
+ for (i=0; i<rbPtr->size[k]; i++) {
+ rbPtr->dispSize[k][i].total =
+ rbPtr->dispSize[k][i].preBorder
+ + rbPtr->dispSize[k][i].size
+ + rbPtr->dispSize[k][i].postBorder;
+ }
+ }
+
+ return rbPtr;
+}
+
+static void
+Tix_GrFreeRenderBlock(wPtr, rbPtr)
+ WidgetPtr wPtr;
+ RenderBlock * rbPtr;
+{
+ int i;
+
+ for (i=0; i<rbPtr->size[0]; i++) {
+ ckfree((char*)rbPtr->elms[i]);
+ }
+ ckfree((char*)rbPtr->elms);
+ ckfree((char*)rbPtr->dispSize[0]);
+ ckfree((char*)rbPtr->dispSize[1]);
+ ckfree((char*)rbPtr);
+}
+
+/*----------------------------------------------------------------------
+ * Tix_GrBBox --
+ *
+ * Returns the visible bounding box of a entry.
+ *
+ * Return value:
+ * See user documenetation.
+ *
+ * Side effects:
+ * None.
+ *----------------------------------------------------------------------
+ */
+
+static int Tix_GrBBox(interp, wPtr, x, y)
+ Tcl_Interp * interp; /* Interpreter to report the bbox. */
+ WidgetPtr wPtr; /* HList widget. */
+ int x; /* X coordinate of the entry.*/
+ int y; /* Y coordinate of the entry.*/
+{
+ int rect[2][2];
+ int visible;
+ char buff[100];
+
+ if (!Tk_IsMapped(wPtr->dispData.tkwin)) {
+ return TCL_OK;
+ }
+
+ visible = Tix_GrGetElementPosn(wPtr, wPtr->anchor[0], wPtr->anchor[1],
+ rect, 0, 0, 1, 0);
+ if (!visible) {
+ return TCL_OK;
+ }
+
+ sprintf(buff, "%d %d %d %d", rect[0][0], rect[1][0],
+ rect[0][1] - rect[0][0] + 1,
+ rect[1][1] - rect[1][0] + 1);
+
+ Tcl_AppendResult(interp, buff, NULL);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ * TranslateFromTo --
+ *
+ * Translate the "option from ?to?" arguments from string to integer.
+ *
+ * Results:
+ * Standard Tcl results.
+ *
+ * Side effects:
+ * On success, *from and *to contains the from and to values.
+ *----------------------------------------------------------------------
+ */
+
+static int
+TranslateFromTo(interp, wPtr, argc, argv, from, to, which)
+ Tcl_Interp * interp;
+ WidgetPtr wPtr;
+ int argc;
+ char **argv;
+ int *from;
+ int *to;
+ int * which;
+{
+ int dummy;
+ size_t len = strlen(argv[0]);
+
+ if (strncmp(argv[0], "row", len) == 0) {
+ *which = 1;
+
+ if (TixGridDataGetIndex(interp, wPtr, "0", argv[1], &dummy, from)
+ !=TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (argc == 3) {
+ if (TixGridDataGetIndex(interp, wPtr, "0", argv[2], &dummy, to)
+ !=TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ *to = *from;
+ }
+ } else if (strncmp(argv[0], "column", len) == 0) {
+ *which = 0;
+ if (TixGridDataGetIndex(interp, wPtr, argv[1], "0", from, &dummy)
+ !=TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (argc == 3) {
+ if (TixGridDataGetIndex(interp, wPtr, argv[2], "0", to, &dummy)
+ !=TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ *to = *from;
+ }
+ }
+
+ return TCL_OK;
+}
diff --git a/tix/generic/tixGrid.h b/tix/generic/tixGrid.h
new file mode 100644
index 00000000000..03df0f49201
--- /dev/null
+++ b/tix/generic/tixGrid.h
@@ -0,0 +1,462 @@
+/*
+ * tixGrid.h --
+ *
+ * Defines main data structures for tixGrid
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#ifndef _TIX_GRID_H_
+#define _TIX_GRID_H_
+
+#ifndef _TIX_GRID_DATA_H_
+#include "tixGrData.h"
+#endif
+
+#ifdef BUILD_tix
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+#define TIX_X 0
+#define TIX_Y 1
+
+
+#define TIX_S_MARGIN 0
+#define TIX_X_MARGIN 1
+#define TIX_Y_MARGIN 2
+#define TIX_MAIN 3
+
+#define TIX_SITE_NONE -1
+
+typedef struct TixGrEntry {
+ Tix_DItem * iPtr;
+ Tcl_HashEntry * entryPtr[2]; /* The index of this entry in the
+ * row/col tables */
+} TixGrEntry;
+
+/*----------------------------------------------------------------------
+ * Render Block
+ *
+ * Before the Grid is rendered, information is filled into a pseudo 2D
+ * array of RenderBlockElem's:
+ *
+ * (1) entries are placed in the appropriate (x,y) locations
+ * (2) background and borders are formatted according
+ * (3) highlights are formatted.
+ *
+ * The widget is redrawn using the render-block. This saves reformatting
+ * the next time the widget is exposed.
+ *----------------------------------------------------------------------
+ */
+typedef struct RenderBlockElem {
+ TixGrEntry * chPtr; /* not allocated, don't need to free */
+ int borderW[2][2];
+ int index[2];
+
+ unsigned int selected : 1;
+ unsigned int filled : 1;
+} RenderBlockElem;
+
+
+/* ElmDispSize --
+ *
+ * This structure stores the size information of the visible
+ * rows (RenderBlock.dispSize[0][...]) and columns
+ * (RenderBlock.dispSize[1][...])
+ */
+typedef struct ElmDispSize {
+ int preBorder;
+ int size;
+ int postBorder;
+
+ int total; /* simple the sum of the above */
+} ElmDispSize;
+
+typedef struct RenderBlock {
+ int size[2]; /* num of rows and cols in the render block */
+
+ RenderBlockElem **elms; /* An Malloc'ed pseudo 2D array (you can do
+ * things like elms[0][0]), Used for the
+ * main body of the Grid.
+ */
+ ElmDispSize *dispSize[2]; /* (dispSizes[0][x], dispSizes[1][y])
+ * will be the dimension of the element (x,y)
+ * displayed on the screen (may be bigger
+ * or smaller than its desired size). */
+ int visArea[2]; /* visible area (width times height) of
+ * the visible cells on the screen */
+} RenderBlock;
+
+/*----------------------------------------------------------------------
+ * RenderInfo
+ *
+ * This stores information for rendering from the RB into an X drawable.
+ *
+ *----------------------------------------------------------------------
+ */
+typedef struct RenderInfo {
+ Drawable drawable;
+ int origin[2];
+ int offset[2];
+ int size[2]; /* width and height of the area to draw
+ * (number of pixels starting from the offset)
+ * if offset = (2,2) and size = (5,5) we have
+ * to draw the rectangle ((2,2), (6,6));
+ */
+ struct { /* the current valid grid area for the */
+ int x1, x2, y1, y2; /* "format" command */
+ int whichArea;
+ } fmt;
+} RenderInfo;
+
+typedef struct ExposedArea {
+ int x1, y1, x2, y2;
+} ExposedArea, Rect;
+
+/*----------------------------------------------------------------------
+ * ColorInfo
+ *
+ * These colors are used by the format commands. They must be saved
+ * or otherwise the colormap may be changed ..
+ *----------------------------------------------------------------------
+ */
+typedef struct ColorInfo {
+ struct ColorInfo * next;
+ int counter;
+ int type; /* TK_CONFIG_BORDER or TK_CONFIG_COLOR */
+ long pixel;
+ Tk_3DBorder border;
+ XColor * color;
+} ColorInfo;
+
+/*----------------------------------------------------------------------
+ * SelectBlock
+ *
+ * These structures are arranged in a list and are used to determine
+ * where a cell is selected.
+ *----------------------------------------------------------------------
+ */
+#define TIX_GR_CLEAR 1
+#define TIX_GR_SET 2
+#define TIX_GR_TOGGLE 3
+
+#define TIX_GR_MAX 0x7fffffff
+
+#define TIX_GR_RESIZE 1
+#define TIX_GR_REDRAW 2
+
+
+typedef struct SelectBlock {
+ struct SelectBlock * next;
+ int range[2][2]; /* the top left and bottom right corners */
+ int type; /* TIX_GR_CLEAR, TIX_GR_SET,
+ * TIX_GR_TOGGLE
+ *
+ * If several SelectBlock covers the same
+ * cell, the last block in the wPtr->selList
+ * determines whether this cell is selected
+ * or not */
+} SelectBlock;
+
+/*----------------------------------------------------------------------
+ * GrSortItem
+ *
+ * Used to sort the items in the grid
+ *----------------------------------------------------------------------
+ */
+typedef struct Tix_GrSortItem {
+ char * data; /* is usually a string, but
+ * can be a pointer to an
+ * arbitrary data in C API */
+ int index; /* row or column */
+} Tix_GrSortItem;
+
+/*----------------------------------------------------------------------
+ * Data structure for iterating the cells inside the grid.
+ *
+ *----------------------------------------------------------------------
+ */
+
+typedef struct Tix_GrDataRowSearch {
+ struct TixGridRowCol * row;
+ Tcl_HashSearch hashSearch;
+ Tcl_HashEntry *hashPtr;
+} Tix_GrDataRowSearch;
+
+typedef struct Tix_GrDataCellSearch {
+ char * data;
+ Tcl_HashSearch hashSearch;
+ Tcl_HashEntry *hashPtr;
+} Tix_GrDataCellSearch;
+
+/*----------------------------------------------------------------------
+ *
+ * Main data structure of the grid widget.
+ *
+ *----------------------------------------------------------------------
+ */
+typedef struct Tix_GridScrollInfo {
+ char * command;
+
+ int max; /* total size (width or height) of the widget*/
+ int offset; /* The top/left side of the scrolled widget */
+ int unit; /* How much should we scroll when the user */
+
+ double window; /* visible size, percentage of the total */
+}Tix_GridScrollInfo;
+
+
+typedef struct GridStruct {
+ Tix_DispData dispData;
+
+ Tcl_Command widgetCmd; /* Token for button's widget command. */
+
+ /*
+ * Information used when displaying widget:
+ */
+ int reqSize[2]; /* For app programmer to request size */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ /* Border and general drawing */
+ int borderWidth; /* Width of 3-D borders. */
+ int selBorderWidth; /* Width of 3-D borders for selected items */
+ int relief; /* Indicates whether window as a whole is
+ * raised, sunken, or flat. */
+ Tk_3DBorder border; /* Used for drawing the 3d border. */
+ Tk_3DBorder selectBorder; /* Used for selected background. */
+ XColor *normalFg; /* Normal foreground for text. */
+ XColor *normalBg; /* Normal background for text. */
+ XColor *selectFg; /* Color for drawing selected text. */
+
+ Tk_Uid state; /* State can only be normal or disabled. */
+
+ /* GC and stuff */
+ GC backgroundGC; /* GC for drawing background. */
+ GC selectGC; /* GC for drawing selected background. */
+ GC anchorGC; /* GC for drawing dotted anchor highlight. */
+ TixFont font; /* Default font used by the DItems. */
+
+ /* Text drawing */
+ Cursor cursor; /* Current cursor for window, or None. */
+
+ /* For highlights */
+ int highlightWidth; /* Width in pixels of highlight to draw
+ * around widget when it has the focus.
+ * <= 0 means don't draw a highlight. */
+ int bdPad; /* = highlightWidth + borderWidth */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ GC highlightGC; /* For drawing traversal highlight. */
+
+ /*
+ * default pad and gap values
+ */
+ int padX, padY;
+
+ Tk_Uid selectMode; /* Selection style: single, browse, multiple,
+ * or extended. This value isn't used in C
+ * code, but the Tcl bindings use it. */
+ Tk_Uid selectUnit; /* Selection unit: cell, row or column.
+ * This value isn't used in C
+ * code, but the Tcl bindings use it. */
+
+ /*
+ * The following three sites are used according to the -selectunit.
+ * if selectunit is: "cell", [0] and [1] are used; "row", only [0]
+ * is used; "column", only [1] is used
+ */
+ int anchor[2]; /* The current anchor unit */
+ int dropSite[2]; /* The current drop site */
+ int dragSite[2]; /* The current drop site */
+
+ /*
+ * Callback commands.
+ */
+ char *command; /* The command when user double-clicks */
+ char *browseCmd; /* The command to call when the selection
+ * changes. */
+ char *editNotifyCmd; /* The command to call to determine whether
+ * a cell is editable. */
+ char *editDoneCmd; /* The command to call when an entry has
+ * been edited by the user.*/
+ char *formatCmd; /* The command to call when the Grid widget
+ * needs to be reformatted (e.g, Exposure
+ * events or when contents have been
+ * changed). */
+ char *sizeCmd; /* The command to call when the size of
+ * the listbox changes. E.g., when the user
+ * add/deletes elements. Useful for auto-
+ * scrollbar geometry managers */
+
+ /*
+ * Info for lay-out
+ */
+ 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 serial; /* this number is incremented before each time
+ * the widget is redisplayed */
+
+ TixGridDataSet * dataSet;
+ RenderBlock * mainRB; /* Malloc'ed */
+
+ int hdrSize[2]; /* number of rows (height of x header, index
+ * [0]) and columns (width of y header, index
+ * [1]) */
+ int floatRange[2]; /* Are the num of columns and rows floated?
+ * (if floated, you can scroll past the max
+ * element).*/
+ int gridSize[2]; /* the size of the grid where there is data */
+ Tix_DItemInfo * diTypePtr; /* Default item type */
+ ExposedArea expArea;
+
+ RenderInfo * renderInfo; /* only points to stuff in stack */
+ Tix_GridScrollInfo scrollInfo[2];
+ int fontSize[2]; /* size of the "0" char of the -font option
+ */
+ TixGridSize defSize[2];
+ Tix_LinkList colorInfo;
+ Tix_LinkList selList;
+ Tix_LinkList mappedWindows;
+ int colorInfoCounter;
+
+ unsigned int hasFocus : 1;
+
+ unsigned int idleEvent : 1;
+ unsigned int toResize : 1; /* idle event */
+ unsigned int toRedraw : 1; /* idle event */
+
+ unsigned int toResetRB : 1; /* Do we need to reset the render block */
+ unsigned int toComputeSel : 1;
+ unsigned int toRedrawHighlight : 1;
+} Grid;
+
+typedef Grid WidgetRecord;
+typedef Grid * WidgetPtr;
+
+#define DEF_GRID_BG_COLOR NORMAL_BG
+#define DEF_GRID_BG_MONO WHITE
+#define DEF_GRID_BORDER_WIDTH "2"
+#define DEF_GRID_BROWSE_COMMAND ""
+#define DEF_GRID_COMMAND ""
+#define DEF_GRID_CURSOR ""
+#define DEF_GRID_DEFAULT_WIDTH "40"
+#define DEF_GRID_DEFAULT_HEIGHT "20"
+#define DEF_GRID_EDITDONE_COMMAND ""
+#define DEF_GRID_EDITNOTIFY_COMMAND ""
+#define DEF_GRID_FLOATING_ROWS "0"
+#define DEF_GRID_FLOATING_COLS "0"
+#define DEF_GRID_FONT CTL_FONT
+#define DEF_GRID_FG_COLOR BLACK
+#define DEF_GRID_FG_MONO BLACK
+#define DEF_GRID_FORMAT_COMMAND ""
+#define DEF_GRID_HEIGHT "10"
+#define DEF_GRID_HIGHLIGHT_COLOR BLACK
+#define DEF_GRID_HIGHLIGHT_MONO BLACK
+#define DEF_GRID_HIGHLIGHT_WIDTH "2"
+#define DEF_GRID_LEFT_MARGIN "1"
+#define DEF_GRID_ITEM_TYPE "text"
+#define DEF_GRID_RELIEF "sunken"
+#define DEF_GRID_PADX "2"
+#define DEF_GRID_PADY "2"
+#define DEF_GRID_SELECT_BG_COLOR ACTIVE_BG
+#define DEF_GRID_SELECT_FG_COLOR BLACK
+#define DEF_GRID_SELECT_BG_MONO BLACK
+#define DEF_GRID_SELECT_FG_MONO WHITE
+#define DEF_GRID_SELECT_MODE "single"
+#define DEF_GRID_SELECT_UNIT "row"
+#define DEF_GRID_SELECT_BORDERWIDTH "1"
+#define DEF_GRID_STATE "normal"
+#define DEF_GRID_SIZE_COMMAND ""
+#define DEF_GRID_TAKE_FOCUS "1"
+#define DEF_GRID_TOP_MARGIN "1"
+#define DEF_GRID_WIDTH "4"
+#define DEF_GRID_Y_SCROLL_COMMAND ""
+#define DEF_GRID_X_SCROLL_COMMAND ""
+
+/*
+ * common functions
+ */
+
+EXTERN void Tix_GrAddChangedRect _ANSI_ARGS_((
+ WidgetPtr wPtr, int changedRect[2][2],
+ int isSite));
+EXTERN int Tix_GrConfigSize _ANSI_ARGS_((Tcl_Interp *interp,
+ WidgetPtr wPtr, int argc, char **argv,
+ TixGridSize *sizePtr, char * argcErrorMsg,
+ int *changed_ret));
+EXTERN void Tix_GrDoWhenIdle _ANSI_ARGS_((WidgetPtr wPtr,
+ int type));
+EXTERN void Tix_GrCancelDoWhenIdle _ANSI_ARGS_((WidgetPtr wPtr));
+EXTERN void Tix_GrFreeElem _ANSI_ARGS_((TixGrEntry * chPtr));
+EXTERN void Tix_GrFreeUnusedColors _ANSI_ARGS_((WidgetPtr wPtr,
+ int freeAll));
+EXTERN void Tix_GrScrollPage _ANSI_ARGS_((WidgetPtr wPtr,
+ int count, int axis));
+
+/*
+ * The dataset functions
+ */
+
+EXTERN int TixGridDataConfigRowColSize _ANSI_ARGS_((
+ Tcl_Interp * interp, WidgetPtr wPtr,
+ TixGridDataSet * dataSet, int which, int index,
+ int argc, char ** argv, char * argcErrorMsg,
+ int *changed_ret));
+EXTERN char * TixGridDataCreateEntry _ANSI_ARGS_((
+ TixGridDataSet * dataSet, int x, int y,
+ char * defaultEntry));
+EXTERN int TixGridDataDeleteEntry _ANSI_ARGS_((
+ TixGridDataSet * dataSet, int x, int y));
+EXTERN void TixGridDataDeleteRange _ANSI_ARGS_((WidgetPtr wPtr,
+ TixGridDataSet * dataSet, int which,
+ int from, int to));
+EXTERN void TixGridDataDeleteSearchedEntry _ANSI_ARGS_((
+ Tix_GrDataCellSearch * cellSearchPtr));
+EXTERN char * TixGridDataFindEntry _ANSI_ARGS_((
+ TixGridDataSet * dataSet, int x, int y));
+EXTERN int TixGrDataFirstCell _ANSI_ARGS_((
+ Tix_GrDataRowSearch * rowSearchPtr,
+ Tix_GrDataCellSearch * cellSearchPtr));
+EXTERN int TixGrDataFirstRow _ANSI_ARGS_((
+ TixGridDataSet* dataSet,
+ Tix_GrDataRowSearch * rowSearchPtr));
+EXTERN int TixGridDataGetRowColSize _ANSI_ARGS_((
+ WidgetPtr wPtr, TixGridDataSet * dataSet,
+ int which, int index, TixGridSize * defSize,
+ int *pad0, int * pad1));
+EXTERN void TixGridDataGetGridSize _ANSI_ARGS_((
+ TixGridDataSet * dataSet, int *width_ret,
+ int *height_ret));
+EXTERN int TixGridDataGetIndex _ANSI_ARGS_((
+ Tcl_Interp * interp, WidgetPtr wPtr,
+ char * xStr, char * yStr, int * xPtr, int * yPtr));
+EXTERN void TixGridDataInsert _ANSI_ARGS_((
+ TixGridDataSet * dataSet,
+ int x, int y, ClientData data));
+EXTERN void TixGridDataMoveRange _ANSI_ARGS_((WidgetPtr wPtr,
+ TixGridDataSet * dataSet, int which,
+ int from, int to, int by));
+EXTERN int TixGrDataNextCell _ANSI_ARGS_((
+ Tix_GrDataCellSearch * cellSearchPtr));
+EXTERN int TixGrDataNextRow _ANSI_ARGS_((
+ Tix_GrDataRowSearch * rowSearchPtr));
+EXTERN TixGridDataSet* TixGridDataSetInit _ANSI_ARGS_((void));
+EXTERN void TixGridDataSetFree _ANSI_ARGS_((
+ TixGridDataSet* dataSet));
+EXTERN int TixGridDataUpdateSort _ANSI_ARGS_((
+ TixGridDataSet * dataSet, int axis,
+ int start, int end, Tix_GrSortItem *items));
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /*_TIX_GRID_H_*/
diff --git a/tix/generic/tixHLCol.c b/tix/generic/tixHLCol.c
new file mode 100644
index 00000000000..1f049558417
--- /dev/null
+++ b/tix/generic/tixHLCol.c
@@ -0,0 +1,405 @@
+/*
+ * tixHLCol.c ---
+ *
+ *
+ * Implements columns inside tixHList widgets
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixHList.h>
+
+static TIX_DECLARE_SUBCMD(Tix_HLItemCreate);
+static TIX_DECLARE_SUBCMD(Tix_HLItemConfig);
+static TIX_DECLARE_SUBCMD(Tix_HLItemCGet);
+static TIX_DECLARE_SUBCMD(Tix_HLItemDelete);
+static TIX_DECLARE_SUBCMD(Tix_HLItemExists);
+
+static TIX_DECLARE_SUBCMD(Tix_HLColWidth);
+
+static HListElement * Tix_HLGetColumn _ANSI_ARGS_((Tcl_Interp *interp,
+ WidgetPtr wPtr, char ** argv, int * column_ret,
+ int mustExist));
+
+HListColumn *
+Tix_HLAllocColumn(wPtr, chPtr)
+ WidgetPtr wPtr;
+ HListElement * chPtr;
+{
+ HListColumn * column;
+ int i;
+
+ column =
+ (HListColumn*)ckalloc(sizeof(HListColumn)*wPtr->numColumns);
+ for (i=0; i<wPtr->numColumns; i++) {
+ column[i].type = HLTYPE_COLUMN;
+ column[i].self = (char*)&column[i];
+ column[i].chPtr = chPtr;
+ column[i].iPtr = NULL;
+ column[i].iPtr = NULL;
+ column[i].width = UNINITIALIZED;
+ }
+ return column;
+}
+
+static HListElement *
+Tix_HLGetColumn(interp, wPtr, argv, column_ret, mustExist)
+ Tcl_Interp *interp;
+ WidgetPtr wPtr;
+ char ** argv;
+ int * column_ret;
+ int mustExist;
+{
+ HListElement * chPtr;
+ int column;
+
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[0])) == NULL) {
+ return NULL;
+ }
+ if (Tcl_GetInt(interp, argv[1], &column) != TCL_OK) {
+ return NULL;
+ }
+ if (column >= wPtr->numColumns || column < 0) {
+ Tcl_AppendResult(interp, "Column \"", argv[1],
+ "\" does not exist", (char*)NULL);
+ return NULL;
+ }
+ if (mustExist && chPtr->col[column].iPtr == NULL) {
+ Tcl_AppendResult(interp, "entry \"", argv[0],
+ "\" does not have an item at column ", argv[1], NULL);
+ return NULL;
+ }
+
+ * column_ret = column;
+ return chPtr;
+}
+
+/*----------------------------------------------------------------------
+ * "item" sub command
+ *----------------------------------------------------------------------
+ */
+int
+Tix_HLItem(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ static Tix_SubCmdInfo subCmdInfo[] = {
+ {TIX_DEFAULT_LEN, "cget", 3, 3, Tix_HLItemCGet,
+ "entryPath column option"},
+ {TIX_DEFAULT_LEN, "configure", 2, TIX_VAR_ARGS, Tix_HLItemConfig,
+ "entryPath column ?option? ?value ...?"},
+ {TIX_DEFAULT_LEN, "create", 2, TIX_VAR_ARGS, Tix_HLItemCreate,
+ "entryPath column ?option value ...?"},
+ {TIX_DEFAULT_LEN, "delete", 2, 2, Tix_HLItemDelete,
+ "entryPath column"},
+ {TIX_DEFAULT_LEN, "exists", 2, 2, Tix_HLItemExists,
+ "entryPath column"},
+ };
+ static Tix_CmdInfo cmdInfo = {
+ Tix_ArraySize(subCmdInfo), 1, TIX_VAR_ARGS, "?option? ?arg ...?",
+ };
+
+ return Tix_HandleSubCmds(&cmdInfo, subCmdInfo, clientData,
+ interp, argc+1, argv-1);
+}
+
+/*----------------------------------------------------------------------
+ * "item cget" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLItemCGet(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+ int column;
+
+ if ((chPtr=Tix_HLGetColumn(interp, wPtr, argv, &column, 1)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ return Tk_ConfigureValue(interp, wPtr->dispData.tkwin,
+ chPtr->col[column].iPtr->base.diTypePtr->itemConfigSpecs,
+ (char *)chPtr->col[column].iPtr, argv[2], 0);
+}
+
+/*----------------------------------------------------------------------
+ * "item configure" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLItemConfig(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+ int column;
+
+ if ((chPtr=Tix_HLGetColumn(interp, wPtr, argv, &column, 1)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (argc == 2) {
+ return Tk_ConfigureInfo(interp, wPtr->dispData.tkwin,
+ chPtr->col[column].iPtr->base.diTypePtr->itemConfigSpecs,
+ (char *)chPtr->col[column].iPtr, NULL, 0);
+ } else if (argc == 3) {
+ return Tk_ConfigureInfo(interp, wPtr->dispData.tkwin,
+ chPtr->col[column].iPtr->base.diTypePtr->itemConfigSpecs,
+ (char *)chPtr->col[column].iPtr, argv[2], 0);
+ } else {
+ Tix_HLMarkElementDirty(wPtr, chPtr);
+ Tix_HLResizeWhenIdle(wPtr);
+
+ return Tix_DItemConfigure(chPtr->col[column].iPtr,
+ argc-2, argv+2, TK_CONFIG_ARGV_ONLY);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * "item create" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLItemCreate(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+ int column, i;
+ size_t len;
+ Tix_DItem * iPtr;
+ char * ditemType = NULL;
+
+ if ((chPtr=Tix_HLGetColumn(interp, wPtr, argv, &column, 0)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (argc %2) {
+ Tcl_AppendResult(interp, "value for \"", argv[argc-1],
+ "\" missing", NULL);
+ return TCL_ERROR;
+ }
+ for (i=2; i<argc; i+=2) {
+ len = strlen(argv[i]);
+ if (strncmp(argv[i], "-itemtype", len) == 0) {
+ ditemType = argv[i+1];
+ }
+ }
+ if (ditemType == NULL) {
+ ditemType = wPtr->diTypePtr->name;
+ }
+
+ iPtr = Tix_DItemCreate(&wPtr->dispData, ditemType);
+ if (iPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ iPtr->base.clientData = (ClientData)&chPtr->col[column];
+ if (Tix_DItemConfigure(iPtr, argc-2, argv+2, 0) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (chPtr->col[column].iPtr != NULL) {
+ if (Tix_DItemType(chPtr->col[column].iPtr) == TIX_DITEM_WINDOW) {
+ Tix_WindowItemListRemove(&wPtr->mappedWindows,
+ chPtr->col[column].iPtr);
+ }
+ Tix_DItemFree(chPtr->col[column].iPtr);
+ }
+ chPtr->col[column].iPtr = iPtr;
+ Tix_HLMarkElementDirty(wPtr, chPtr);
+ Tix_HLResizeWhenIdle(wPtr);
+
+ return TCL_OK;
+}
+/*----------------------------------------------------------------------
+ * "item delete" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLItemDelete(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+ int column;
+
+ if ((chPtr=Tix_HLGetColumn(interp, wPtr, argv, &column, 1)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (column == 0) {
+ Tcl_AppendResult(interp,"Cannot delete item at column 0",(char*)NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tix_DItemType(chPtr->col[column].iPtr) == TIX_DITEM_WINDOW) {
+ Tix_WindowItemListRemove(&wPtr->mappedWindows,
+ chPtr->col[column].iPtr);
+ }
+
+ /* Free the item and leave a blank */
+ Tix_DItemFree(chPtr->col[column].iPtr);
+ chPtr->col[column].iPtr = NULL;
+
+ Tix_HLMarkElementDirty(wPtr, chPtr);
+ Tix_HLResizeWhenIdle(wPtr);
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "item exists" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLItemExists(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+ int column;
+
+ if ((chPtr=Tix_HLGetColumn(interp, wPtr, argv, &column, 0)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (chPtr->col[column].iPtr == NULL) {
+ Tcl_AppendResult(interp, "0", NULL);
+ } else {
+ Tcl_AppendResult(interp, "1", NULL);
+ }
+
+ return TCL_OK;
+}
+/*----------------------------------------------------------------------
+ * "column" sub command
+ *----------------------------------------------------------------------
+ */
+int
+Tix_HLColumn(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ static Tix_SubCmdInfo subCmdInfo[] = {
+ {TIX_DEFAULT_LEN, "width", 1, 3, Tix_HLColWidth,
+ "column ?-char? ?size?"},
+ };
+ static Tix_CmdInfo cmdInfo = {
+ Tix_ArraySize(subCmdInfo), 1, TIX_VAR_ARGS, "?option? ?arg ...?",
+ };
+
+ return Tix_HandleSubCmds(&cmdInfo, subCmdInfo, clientData,
+ interp, argc+1, argv-1);
+}
+
+/*----------------------------------------------------------------------
+ * "column width" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLColWidth(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int column;
+ char buff[128];
+ int newWidth;
+
+ if (Tcl_GetInt(interp, argv[0], &column) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (column >= wPtr->numColumns || column < 0) {
+ Tcl_AppendResult(interp, "Column \"", argv[0],
+ "\" does not exist", (char*)NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 1) { /* Query */
+ if (wPtr->root->dirty || wPtr->allDirty) {
+ /* We must update the geometry NOW otherwise we will get a wrong
+ * width
+ */
+ Tix_HLCancelResizeWhenIdle(wPtr);
+ Tix_HLComputeGeometry((ClientData)wPtr);
+ }
+ sprintf(buff, "%d", wPtr->actualSize[column].width);
+ Tcl_AppendResult(interp, buff, NULL);
+ return TCL_OK;
+ }
+ else if (argc == 2) {
+ if (argv[1][0] == '\0') {
+ newWidth = UNINITIALIZED;
+ goto setwidth;
+ }
+ if (Tk_GetPixels(interp, wPtr->dispData.tkwin, argv[1],
+ &newWidth) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (newWidth < 0) {
+ newWidth = 0;
+ }
+ }
+ else if (argc == 3 && strcmp(argv[1], "-char")==0) {
+ if (argv[2][0] == '\0') {
+ newWidth = UNINITIALIZED;
+ goto setwidth;
+ }
+ if (Tcl_GetInt(interp, argv[2], &newWidth) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (newWidth < 0) {
+ newWidth = 0;
+ }
+ newWidth *= wPtr->scrollUnit[0];
+ }
+ else {
+ return Tix_ArgcError(interp, argc+3, argv-3, 3,
+ "column ?-char? ?size?");
+ }
+
+ setwidth:
+
+ if (wPtr->reqSize[column].width == newWidth) {
+ return TCL_OK;
+ } else {
+ wPtr->reqSize[column].width = newWidth;
+ }
+
+ if (wPtr->actualSize[column].width == newWidth) {
+ return TCL_OK;
+ } else {
+ wPtr->allDirty = 1;
+ Tix_HLResizeWhenIdle(wPtr);
+ return TCL_OK;
+ }
+}
diff --git a/tix/generic/tixHLHdr.c b/tix/generic/tixHLHdr.c
new file mode 100644
index 00000000000..eb0dcf432fc
--- /dev/null
+++ b/tix/generic/tixHLHdr.c
@@ -0,0 +1,576 @@
+/*
+ * tixHLHdr.c ---
+ *
+ *
+ * Implements headers for tixHList widgets
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixHList.h>
+#include <tixDef.h>
+
+static TIX_DECLARE_SUBCMD(Tix_HLHdrCreate);
+static TIX_DECLARE_SUBCMD(Tix_HLHdrConfig);
+static TIX_DECLARE_SUBCMD(Tix_HLHdrCGet);
+static TIX_DECLARE_SUBCMD(Tix_HLHdrDelete);
+static TIX_DECLARE_SUBCMD(Tix_HLHdrExist);
+static TIX_DECLARE_SUBCMD(Tix_HLHdrSize);
+
+static void FreeWindowItem _ANSI_ARGS_((Tcl_Interp *interp,
+ WidgetPtr wPtr, HListHeader *hPtr));
+static void FreeHeader _ANSI_ARGS_((Tcl_Interp *interp,
+ WidgetPtr wPtr, HListHeader *hPtr));
+static HListHeader* AllocHeader _ANSI_ARGS_((Tcl_Interp *interp,
+ WidgetPtr wPtr));
+static HListHeader* Tix_HLGetHeader _ANSI_ARGS_((Tcl_Interp * interp,
+ WidgetPtr wPtr, char * string,
+ int requireIPtr));
+
+static Tk_ConfigSpec headerConfigSpecs[] = {
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
+ (char *) NULL, 0, 0},
+
+ {TK_CONFIG_PIXELS, "-borderwidth", "headerBorderWidth", "BorderWidth",
+ DEF_HLISTHEADER_BORDER_WIDTH, Tk_Offset(HListHeader, borderWidth), 0},
+
+ {TK_CONFIG_BORDER, "-headerbackground", "headerBackground", "Background",
+ DEF_HLISTHEADER_BG_COLOR, Tk_Offset(HListHeader, background),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_BORDER, "-headerbackground", "headerBackground", "Background",
+ DEF_HLISTHEADER_BG_MONO, Tk_Offset(HListHeader, background),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_RELIEF, "-relief", "headerRelief", "Relief",
+ DEF_HLISTHEADER_RELIEF, Tk_Offset(HListHeader, relief), 0},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*----------------------------------------------------------------------
+ *
+ * Local functions
+ *
+ *----------------------------------------------------------------------
+ */
+
+static HListHeader*
+AllocHeader(interp, wPtr)
+ Tcl_Interp *interp;
+ WidgetPtr wPtr;
+{
+ HListHeader * hPtr = (HListHeader*)ckalloc(sizeof(HListHeader));
+ hPtr->type = HLTYPE_HEADER;
+ hPtr->self = (char*)hPtr;
+ hPtr->wPtr = wPtr;
+ hPtr->iPtr = NULL;
+ hPtr->width = 0;
+ hPtr->background = NULL;
+ hPtr->relief = TK_RELIEF_RAISED;
+ hPtr->borderWidth = 2;
+
+ if (Tk_ConfigureWidget(interp, wPtr->dispData.tkwin, headerConfigSpecs,
+ 0, 0, (char *)hPtr, 0) != TCL_OK) {
+ /* some unrecoverable errors */
+ return NULL;
+ }
+ return hPtr;
+}
+
+static void
+FreeWindowItem(interp, wPtr, hPtr)
+ Tcl_Interp *interp;
+ WidgetPtr wPtr;
+ HListHeader *hPtr;
+{
+ Tix_WindowItemListRemove(&wPtr->mappedWindows,
+ hPtr->iPtr);
+}
+
+static void
+FreeHeader(interp, wPtr, hPtr)
+ Tcl_Interp *interp;
+ WidgetPtr wPtr;
+ HListHeader *hPtr;
+{
+ if (hPtr->iPtr) {
+ if (Tix_DItemType(hPtr->iPtr) == TIX_DITEM_WINDOW) {
+ FreeWindowItem(interp, wPtr, hPtr);
+ }
+ Tix_DItemFree(hPtr->iPtr);
+ }
+
+ Tk_FreeOptions(headerConfigSpecs, (char *)hPtr, wPtr->dispData.display, 0);
+ ckfree((char*) hPtr);
+}
+
+static HListHeader*
+Tix_HLGetHeader(interp, wPtr, string, requireIPtr)
+ Tcl_Interp * interp;
+ WidgetPtr wPtr;
+ char * string;
+ int requireIPtr;
+{
+ int column;
+
+ if (Tcl_GetInt(interp, string, &column) != TCL_OK) {
+ return NULL;
+ }
+ if (column >= wPtr->numColumns || column < 0) {
+ Tcl_AppendResult(interp, "Column \"", string,
+ "\" does not exist", (char*)NULL);
+ return NULL;
+ }
+ if (requireIPtr && wPtr->headers[column]->iPtr == NULL) {
+ Tcl_AppendResult(interp, "Column \"", string,
+ "\" does not have a header", (char*)NULL);
+ return NULL;
+ }
+
+ return wPtr->headers[column];
+}
+
+int
+Tix_HLCreateHeaders(interp, wPtr)
+ Tcl_Interp *interp;
+ WidgetPtr wPtr;
+{
+ int i;
+
+ wPtr->headers = (HListHeader**)
+ ckalloc(sizeof(HListHeader*) * wPtr->numColumns);
+
+ for (i=0; i<wPtr->numColumns; i++) {
+ wPtr->headers[i] = NULL;
+ }
+
+ for (i=0; i<wPtr->numColumns; i++) {
+ if ((wPtr->headers[i] = AllocHeader(interp, wPtr)) == NULL) {
+ return TCL_ERROR;
+ }
+ }
+
+ wPtr->headerDirty = 1;
+ return TCL_OK;
+}
+
+void Tix_HLFreeHeaders(interp, wPtr)
+ Tcl_Interp *interp;
+ WidgetPtr wPtr;
+{
+ int i;
+
+ if (wPtr->headers == NULL) {
+ return;
+ }
+
+ for (i=0; i<wPtr->numColumns; i++) {
+ if (wPtr->headers[i] != NULL) {
+ FreeHeader(interp, wPtr, wPtr->headers[i]);
+ }
+ }
+
+ ckfree((char*)wPtr->headers);
+}
+
+void
+Tix_HLDrawHeader(wPtr, pixmap, gc, hdrX, hdrY, hdrW, hdrH, xOffset)
+ WidgetPtr wPtr;
+ Pixmap pixmap;
+ GC gc;
+ int hdrX;
+ int hdrY;
+ int hdrW;
+ int hdrH;
+ int xOffset;
+{
+ int i, x, y;
+ int drawnWidth; /* how much of the header have I drawn? */
+ int width; /* width of the current header item */
+ int winItemExtra; /* window items need a bit extra offset
+ * because they must be places relative to
+ * the main window, not the header subwindow
+ */
+ x = hdrX - xOffset;
+ y = hdrY;
+ drawnWidth = 0;
+
+ winItemExtra = wPtr->borderWidth + wPtr->highlightWidth;
+
+ if (wPtr->needToRaise) {
+ /* the needToRaise flag is set every time a new window item is
+ * created inside the header of the HList.
+ *
+ * We need to make sure that the windows items in the list
+ * body are clipped by the header subwindow. However, the window
+ * items inside the header should be over the header subwindow.
+ *
+ * The two XRaiseWindow calls in this function make sure that
+ * the stacking relationship as described above always hold
+ */
+ XRaiseWindow(Tk_Display(wPtr->headerWin),
+ Tk_WindowId(wPtr->headerWin));
+ }
+
+ for (i=0; i<wPtr->numColumns; i++) {
+ HListHeader * hPtr = wPtr->headers[i];
+ width = wPtr->actualSize[i].width;
+
+ if (i == wPtr->numColumns-1) {
+ /* If the widget is wider than required,
+ * We need to extend the last item to the end of the list,
+ * or otherwise we'll see a curtailed header
+ */
+ if (drawnWidth + width <hdrW) {
+ width = hdrW - drawnWidth;
+ }
+ }
+
+ Tk_Fill3DRectangle(wPtr->dispData.tkwin, pixmap, hPtr->background,
+ x, y, width, wPtr->headerHeight, hPtr->borderWidth,
+ hPtr->relief);
+
+ /* Note when we draw the item, we use the
+ * wPtr->actualSize[i].width instead of the (possibly extended) width
+ * so that the header is well-aligned with the element columns.
+ */
+ if (hPtr->iPtr) {
+ int itemX, itemY;
+ itemX = x+hPtr->borderWidth;
+ itemY = y+hPtr->borderWidth;
+
+ if (Tix_DItemType(hPtr->iPtr) == TIX_DITEM_WINDOW) {
+ itemX += winItemExtra;
+ itemY += winItemExtra;
+ }
+
+ Tix_DItemDisplay(pixmap, gc, hPtr->iPtr,
+ itemX, itemY,
+ wPtr->actualSize[i].width - 2*hPtr->borderWidth,
+ wPtr->headerHeight - 2*hPtr->borderWidth,
+ TIX_DITEM_NORMAL_FG);
+
+ if (wPtr->needToRaise &&
+ Tix_DItemType(hPtr->iPtr) == TIX_DITEM_WINDOW) {
+ TixWindowItem * wiPtr;
+
+ wiPtr = (TixWindowItem *)hPtr->iPtr;
+ if (Tk_WindowId(wiPtr->tkwin) == None) {
+ Tk_MakeWindowExist(wiPtr->tkwin);
+ }
+
+ XRaiseWindow(Tk_Display(wiPtr->tkwin),
+ Tk_WindowId(wiPtr->tkwin));
+ }
+ }
+
+ x += width;
+ drawnWidth += width;
+
+#if 0
+ /* %% funny, doesn't work */
+ if (drawnWidth >= hdrW) {
+ /* The rest is invisible. Don't bother to draw */
+ break;
+ }
+#endif
+ }
+
+ wPtr->needToRaise = 0;
+}
+
+void Tix_HLComputeHeaderGeometry(wPtr)
+ WidgetPtr wPtr;
+{
+ int i;
+
+ wPtr->headerHeight = 0;
+
+ for (i=0; i<wPtr->numColumns; i++) {
+ int height;
+ int width;
+
+ if (wPtr->headers[i]->iPtr) {
+ width = Tix_DItemWidth (wPtr->headers[i]->iPtr);
+ height = Tix_DItemHeight(wPtr->headers[i]->iPtr);
+ } else {
+ width = 0;
+ height = 0;
+ }
+
+ width += wPtr->headers[i]->borderWidth * 2;
+ height += wPtr->headers[i]->borderWidth * 2;
+
+ wPtr->headers[i]->width = width;
+
+ if (height > wPtr->headerHeight) {
+ wPtr->headerHeight = height;
+ }
+ }
+
+ wPtr->headerDirty = 0;
+}
+
+/*----------------------------------------------------------------------
+ * "header" sub command
+ *----------------------------------------------------------------------
+ */
+int
+Tix_HLHeader(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ static Tix_SubCmdInfo subCmdInfo[] = {
+ {TIX_DEFAULT_LEN, "cget", 2, 2, Tix_HLHdrCGet,
+ "column option"},
+ {TIX_DEFAULT_LEN, "configure", 1, TIX_VAR_ARGS, Tix_HLHdrConfig,
+ "column ?option? ?value ...?"},
+ {TIX_DEFAULT_LEN, "create", 1, TIX_VAR_ARGS, Tix_HLHdrCreate,
+ "column ?option value ...?"},
+ {TIX_DEFAULT_LEN, "delete", 1, 1, Tix_HLHdrDelete,
+ "column"},
+ {TIX_DEFAULT_LEN, "exist", 1, 1, Tix_HLHdrExist,
+ "column"},
+ {TIX_DEFAULT_LEN, "size", 1, 1, Tix_HLHdrSize,
+ "column"},
+ };
+ static Tix_CmdInfo cmdInfo = {
+ Tix_ArraySize(subCmdInfo), 1, TIX_VAR_ARGS, "?option? ?arg ...?",
+ };
+
+ return Tix_HandleSubCmds(&cmdInfo, subCmdInfo, clientData,
+ interp, argc+1, argv-1);
+}
+
+/*----------------------------------------------------------------------
+ * "header cget" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLHdrCGet(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListHeader * hPtr;
+
+ if ((hPtr=Tix_HLGetHeader(interp, wPtr, argv[0], 1)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ return Tix_ConfigureValue2(interp, wPtr->dispData.tkwin,
+ (char*)hPtr, headerConfigSpecs, hPtr->iPtr, argv[1], 0);
+}
+
+/*----------------------------------------------------------------------
+ * "header configure" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLHdrConfig(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListHeader * hPtr;
+
+ if ((hPtr=Tix_HLGetHeader(interp, wPtr, argv[0], 1)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (argc == 1) {
+ return Tix_ConfigureInfo2(interp, wPtr->dispData.tkwin,
+ (char*)hPtr, headerConfigSpecs, hPtr->iPtr,
+ (char *) NULL, 0);
+ } else if (argc == 2) {
+ return Tix_ConfigureInfo2(interp, wPtr->dispData.tkwin,
+ (char*)hPtr, headerConfigSpecs, hPtr->iPtr,
+ (char *) argv[1], 0);
+ } else {
+ int sizeChanged = 0;
+
+ if (Tix_WidgetConfigure2(interp, wPtr->dispData.tkwin,
+ (char*)hPtr, headerConfigSpecs, hPtr->iPtr,
+ argc-1, argv+1, TK_CONFIG_ARGV_ONLY, 0, &sizeChanged) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (sizeChanged) {
+ wPtr->headerDirty = 1;
+ Tix_HLResizeWhenIdle(wPtr);
+ }
+ return TCL_OK;
+ }
+}
+
+
+/*----------------------------------------------------------------------
+ * "header create" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLHdrCreate(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListHeader * hPtr;
+ int i;
+ Tix_DItem * iPtr;
+ char * ditemType = NULL;
+
+ if ((hPtr=Tix_HLGetHeader(interp, wPtr, argv[0], 0)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if ((argc %2) == 0) {
+ Tcl_AppendResult(interp, "value for \"", argv[argc-1],
+ "\" missing", NULL);
+ return TCL_ERROR;
+ }
+ for (i=1; i<argc; i+=2) {
+ if (strncmp(argv[i], "-itemtype", strlen(argv[i])) == 0) {
+ ditemType = argv[i+1];
+ }
+ }
+ if (ditemType == NULL) {
+ ditemType = wPtr->diTypePtr->name;
+ }
+
+ iPtr = Tix_DItemCreate(&wPtr->dispData, ditemType);
+ if (iPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tix_DItemType(iPtr) == TIX_DITEM_WINDOW) {
+ wPtr->needToRaise = 1;
+ }
+
+ /*
+ * mark clientData to NULL. This will tell DItemSizeChanged()
+ * that ths item belongs to the header
+ */
+ iPtr->base.clientData = (ClientData)hPtr;
+
+ if (hPtr->iPtr != NULL) {
+ if (Tix_DItemType(hPtr->iPtr) == TIX_DITEM_WINDOW) {
+ FreeWindowItem(interp, wPtr, hPtr);
+ }
+ Tix_DItemFree(hPtr->iPtr);
+ }
+ hPtr->iPtr = iPtr;
+
+ if (Tix_WidgetConfigure2(wPtr->dispData.interp, wPtr->dispData.tkwin,
+ (char*)hPtr, headerConfigSpecs, hPtr->iPtr, argc-1, argv+1, 0,
+ 1, NULL) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+
+ wPtr->headerDirty = 1;
+ Tix_HLResizeWhenIdle(wPtr);
+
+ return TCL_OK;
+}
+/*----------------------------------------------------------------------
+ * "header delete" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLHdrDelete(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListHeader * hPtr;
+
+ if ((hPtr=Tix_HLGetHeader(interp, wPtr, argv[0], 1)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (Tix_DItemType(hPtr->iPtr) == TIX_DITEM_WINDOW) {
+ FreeWindowItem(interp, wPtr, hPtr);
+ }
+
+ /* Free the item and leave a blank! */
+ Tix_DItemFree(hPtr->iPtr);
+ hPtr->iPtr = NULL;
+
+ wPtr->headerDirty = 1;
+ Tix_HLResizeWhenIdle(wPtr);
+
+ return TCL_OK;
+}
+/*----------------------------------------------------------------------
+ * "header exist" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLHdrExist(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListHeader * hPtr;
+
+ if ((hPtr=Tix_HLGetHeader(interp, wPtr, argv[0], 0)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (hPtr->iPtr == NULL) {
+ Tcl_AppendResult(interp, "0", NULL);
+ } else {
+ Tcl_AppendResult(interp, "1", NULL);
+ }
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "header size" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLHdrSize(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListHeader * hPtr;
+ char buff[128];
+
+ if ((hPtr=Tix_HLGetHeader(interp, wPtr, argv[0], 1)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (hPtr->iPtr == NULL) {
+ Tcl_AppendResult(interp, "entry \"", argv[0],
+ "\" does not have a header", (char*)NULL);
+ return TCL_ERROR;
+ }
+ sprintf(buff, "%d %d",
+ Tix_DItemWidth(hPtr->iPtr),
+ Tix_DItemHeight(hPtr->iPtr));
+ Tcl_AppendResult(interp, buff, NULL);
+ return TCL_OK;
+}
diff --git a/tix/generic/tixHLInd.c b/tix/generic/tixHLInd.c
new file mode 100644
index 00000000000..80509e13eea
--- /dev/null
+++ b/tix/generic/tixHLInd.c
@@ -0,0 +1,278 @@
+/*
+ * tixHLInd.c ---
+ *
+ * Implements indicators inside tixHList widgets
+ *
+ * Copyright (c) 1994-1995 Ioi Kim Lam. All rights reserved.
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixHList.h>
+
+static TIX_DECLARE_SUBCMD(Tix_HLIndCreate);
+static TIX_DECLARE_SUBCMD(Tix_HLIndConfig);
+static TIX_DECLARE_SUBCMD(Tix_HLIndCGet);
+static TIX_DECLARE_SUBCMD(Tix_HLIndDelete);
+static TIX_DECLARE_SUBCMD(Tix_HLIndExists);
+static TIX_DECLARE_SUBCMD(Tix_HLIndSize);
+
+
+/*----------------------------------------------------------------------
+ * "indicator" sub command
+ *----------------------------------------------------------------------
+ */
+int
+Tix_HLIndicator(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ static Tix_SubCmdInfo subCmdInfo[] = {
+ {TIX_DEFAULT_LEN, "cget", 2, 2, Tix_HLIndCGet,
+ "entryPath option"},
+ {TIX_DEFAULT_LEN, "configure", 1, TIX_VAR_ARGS, Tix_HLIndConfig,
+ "entryPath ?option? ?value ...?"},
+ {TIX_DEFAULT_LEN, "create", 1, TIX_VAR_ARGS, Tix_HLIndCreate,
+ "entryPath ?option value ...?"},
+ {TIX_DEFAULT_LEN, "delete", 1, 1, Tix_HLIndDelete,
+ "entryPath"},
+ {TIX_DEFAULT_LEN, "exists", 1, 1, Tix_HLIndExists,
+ "entryPath"},
+ {TIX_DEFAULT_LEN, "size", 1, 1, Tix_HLIndSize,
+ "entryPath"},
+ };
+ static Tix_CmdInfo cmdInfo = {
+ Tix_ArraySize(subCmdInfo), 1, TIX_VAR_ARGS, "?option? ?arg ...?",
+ };
+
+ return Tix_HandleSubCmds(&cmdInfo, subCmdInfo, clientData,
+ interp, argc+1, argv-1);
+}
+
+/*----------------------------------------------------------------------
+ * "indicator cget" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLIndCGet(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[0])) == NULL) {
+ return TCL_ERROR;
+ }
+ if (chPtr->indicator == NULL) {
+ Tcl_AppendResult(interp, "entry \"", argv[0],
+ "\" does not have an indicator", (char*)NULL);
+ return TCL_ERROR;
+ }
+ return Tk_ConfigureValue(interp, wPtr->dispData.tkwin,
+ chPtr->indicator->base.diTypePtr->itemConfigSpecs,
+ (char *)chPtr->indicator, argv[1], 0);
+}
+
+/*----------------------------------------------------------------------
+ * "indicator configure" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLIndConfig(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[0])) == NULL) {
+ return TCL_ERROR;
+ }
+ if (chPtr->indicator == NULL) {
+ Tcl_AppendResult(interp, "entry \"", argv[0],
+ "\" does not have an indicator", (char*)NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 1) {
+ return Tk_ConfigureInfo(interp, wPtr->dispData.tkwin,
+ chPtr->indicator->base.diTypePtr->itemConfigSpecs,
+ (char *)chPtr->indicator, NULL, 0);
+ } else if (argc == 2) {
+ return Tk_ConfigureInfo(interp, wPtr->dispData.tkwin,
+ chPtr->indicator->base.diTypePtr->itemConfigSpecs,
+ (char *)chPtr->indicator, argv[1], 0);
+ } else {
+ Tix_HLMarkElementDirty(wPtr, chPtr);
+ Tix_HLResizeWhenIdle(wPtr);
+
+ return Tix_DItemConfigure(chPtr->indicator,
+ argc-1, argv+1, TK_CONFIG_ARGV_ONLY);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * "indicator create" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLIndCreate(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+ int i;
+ size_t len;
+ Tix_DItem * iPtr;
+ char * ditemType = NULL;
+
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[0])) == NULL) {
+ return TCL_ERROR;
+ }
+ if ((argc %2) == 0) {
+ Tcl_AppendResult(interp, "value for \"", argv[argc-1],
+ "\" missing", NULL);
+ return TCL_ERROR;
+ }
+ for (i=1; i<argc; i+=2) {
+ len = strlen(argv[i]);
+ if (strncmp(argv[i], "-itemtype", len) == 0) {
+ ditemType = argv[i+1];
+ }
+ }
+ if (ditemType == NULL) {
+ ditemType = wPtr->diTypePtr->name;
+ }
+
+ iPtr = Tix_DItemCreate(&wPtr->dispData, ditemType);
+ if (iPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tix_DItemType(iPtr) == TIX_DITEM_WINDOW) {
+ wPtr->needToRaise = 1;
+ }
+
+ iPtr->base.clientData = (ClientData)chPtr;
+ if (Tix_DItemConfigure(iPtr, argc-1, argv+1, 0) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (chPtr->indicator != NULL) {
+ if (Tix_DItemType(chPtr->indicator) == TIX_DITEM_WINDOW) {
+ Tix_WindowItemListRemove(&wPtr->mappedWindows,
+ chPtr->indicator);
+ }
+ Tix_DItemFree(chPtr->indicator);
+ }
+ chPtr->indicator = iPtr;
+ Tix_HLMarkElementDirty(wPtr, chPtr);
+ Tix_HLResizeWhenIdle(wPtr);
+
+ return TCL_OK;
+}
+/*----------------------------------------------------------------------
+ * "indicator delete" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLIndDelete(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[0])) == NULL) {
+ return TCL_ERROR;
+ }
+ if (chPtr->indicator == NULL) {
+ Tcl_AppendResult(interp, "entry \"", argv[0],
+ "\" does not have an indicator", (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ if (Tix_DItemType(chPtr->indicator) == TIX_DITEM_WINDOW) {
+ Tix_WindowItemListRemove(&wPtr->mappedWindows,
+ chPtr->indicator);
+ }
+
+ /* Free the item and leave a blank! */
+
+ Tix_DItemFree(chPtr->indicator);
+ chPtr->indicator = NULL;
+
+ Tix_HLMarkElementDirty(wPtr, chPtr);
+ Tix_HLResizeWhenIdle(wPtr);
+
+ return TCL_OK;
+}
+/*----------------------------------------------------------------------
+ * "indicator exists" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLIndExists(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[0])) == NULL) {
+ return TCL_ERROR;
+ }
+ if (chPtr->indicator == NULL) {
+ Tcl_AppendResult(interp, "0", NULL);
+ } else {
+ Tcl_AppendResult(interp, "1", NULL);
+ }
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "indicator size" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLIndSize(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+ char buff[100];
+
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[0])) == NULL) {
+ return TCL_ERROR;
+ }
+ if (chPtr->indicator == NULL) {
+ Tcl_AppendResult(interp, "entry \"", argv[0],
+ "\" does not have an indicator", (char*)NULL);
+ return TCL_ERROR;
+ }
+ sprintf(buff, "%d %d",
+ Tix_DItemWidth(chPtr->indicator),
+ Tix_DItemHeight(chPtr->indicator));
+ Tcl_AppendResult(interp, buff, NULL);
+ return TCL_OK;
+}
diff --git a/tix/generic/tixHList.c b/tix/generic/tixHList.c
new file mode 100644
index 00000000000..1b217901df3
--- /dev/null
+++ b/tix/generic/tixHList.c
@@ -0,0 +1,4417 @@
+/*
+ * tixHList.c --
+ *
+ * This module implements "HList" widgets.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixHList.h>
+#include <tixDef.h>
+
+/*
+ * Information used for argv parsing.
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_COLOR, "-background", "background", "Background",
+ DEF_HLIST_BG_COLOR, Tk_Offset(WidgetRecord, normalBg),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_COLOR, "-background", "background", "Background",
+ DEF_HLIST_BG_MONO, Tk_Offset(WidgetRecord, normalBg),
+ 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_HLIST_BORDER_WIDTH, Tk_Offset(WidgetRecord, borderWidth), 0},
+
+ {TK_CONFIG_STRING, "-browsecmd", "browseCmd", "BrowseCmd",
+ DEF_HLIST_BROWSE_COMMAND, Tk_Offset(WidgetRecord, browseCmd),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_INT, "-columns", "columns", "Columns",
+ DEF_HLIST_COLUMNS, Tk_Offset(WidgetRecord, numColumns),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_STRING, "-command", "command", "Command",
+ DEF_HLIST_COMMAND, Tk_Offset(WidgetRecord, command),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_HLIST_CURSOR, Tk_Offset(WidgetRecord, cursor),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_STRING, "-dragcmd", "dragCmd", "DragCmd",
+ DEF_HLIST_DRAG_COMMAND, Tk_Offset(WidgetRecord, dragCmd),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_BOOLEAN, "-drawbranch", "drawBranch", "DrawBranch",
+ DEF_HLIST_DRAW_BRANCH, Tk_Offset(WidgetRecord, drawBranch), 0},
+
+ {TK_CONFIG_STRING, "-dropcmd", "dropCmd", "DropCmd",
+ DEF_HLIST_DROP_COMMAND, Tk_Offset(WidgetRecord, dropCmd),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+
+ {TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_HLIST_FONT, Tk_Offset(WidgetRecord, font), 0},
+
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_HLIST_FG_COLOR, Tk_Offset(WidgetRecord, normalFg),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_HLIST_FG_MONO, Tk_Offset(WidgetRecord, normalFg),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_PIXELS, "-gap", "gap", "Gap",
+ DEF_HLIST_GAP, Tk_Offset(WidgetRecord, gap), 0},
+
+ {TK_CONFIG_BOOLEAN, "-header", "header", "Header",
+ DEF_HLIST_HEADER, Tk_Offset(WidgetRecord, useHeader), 0},
+
+ {TK_CONFIG_INT, "-height", "height", "Height",
+ DEF_HLIST_HEIGHT, Tk_Offset(WidgetRecord, height), 0},
+
+ {TK_CONFIG_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground",
+ DEF_HLIST_BG_COLOR, Tk_Offset(WidgetRecord, border),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground",
+ DEF_HLIST_BG_MONO, Tk_Offset(WidgetRecord, border),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_HLIST_HIGHLIGHT_COLOR, Tk_Offset(WidgetRecord, highlightColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_HLIST_HIGHLIGHT_MONO, Tk_Offset(WidgetRecord, highlightColorPtr),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_HLIST_HIGHLIGHT_WIDTH, Tk_Offset(WidgetRecord, highlightWidth), 0},
+
+ {TK_CONFIG_PIXELS, "-indent", "indent", "Indent",
+ DEF_HLIST_INDENT, Tk_Offset(WidgetRecord, indent), 0},
+
+ {TK_CONFIG_BOOLEAN, "-indicator", "indicator", "Indicator",
+ DEF_HLIST_INDICATOR, Tk_Offset(WidgetRecord, useIndicator), 0},
+
+ {TK_CONFIG_STRING, "-indicatorcmd", "indicatorCmd", "IndicatorCmd",
+ DEF_HLIST_INDICATOR_CMD, Tk_Offset(WidgetRecord, indicatorCmd),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_CUSTOM, "-itemtype", "itemType", "ItemType",
+ DEF_HLIST_ITEM_TYPE, Tk_Offset(WidgetRecord, diTypePtr),
+ 0, &tixConfigItemType},
+
+ {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
+ DEF_HLIST_PADX, Tk_Offset(WidgetRecord, padX), 0},
+
+ {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
+ DEF_HLIST_PADY, Tk_Offset(WidgetRecord, padY), 0},
+
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_HLIST_RELIEF, Tk_Offset(WidgetRecord, relief), 0},
+
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_HLIST_SELECT_BG_COLOR, Tk_Offset(WidgetRecord, selectBorder),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_HLIST_SELECT_BG_MONO, Tk_Offset(WidgetRecord, selectBorder),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth","BorderWidth",
+ DEF_HLIST_SELECT_BORDERWIDTH,Tk_Offset(WidgetRecord, selBorderWidth),0},
+
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_HLIST_SELECT_FG_COLOR, Tk_Offset(WidgetRecord, selectFg),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_HLIST_SELECT_FG_MONO, Tk_Offset(WidgetRecord, selectFg),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_UID, "-selectmode", "selectMode", "SelectMode",
+ DEF_HLIST_SELECT_MODE, Tk_Offset(WidgetRecord, selectMode), 0},
+
+ {TK_CONFIG_STRING, "-separator", "separator", "Separator",
+ DEF_HLIST_SEPARATOR, Tk_Offset(WidgetRecord, separator), 0},
+
+ {TK_CONFIG_STRING, "-sizecmd", "sizeCmd", "SizeCmd",
+ DEF_HLIST_SIZE_COMMAND, Tk_Offset(WidgetRecord, sizeCmd),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_HLIST_TAKE_FOCUS, Tk_Offset(WidgetRecord, takeFocus),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_BOOLEAN, "-wideselection", "wideSelection", "WideSelection",
+ DEF_HLIST_WIDE_SELECT, Tk_Offset(WidgetRecord, wideSelect), 0},
+
+ {TK_CONFIG_INT, "-width", "width", "Width",
+ DEF_HLIST_WIDTH, Tk_Offset(WidgetRecord, width), 0},
+
+ {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_HLIST_X_SCROLL_COMMAND, Tk_Offset(WidgetRecord, xScrollCmd),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ DEF_HLIST_Y_SCROLL_COMMAND, Tk_Offset(WidgetRecord, yScrollCmd),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+static Tk_ConfigSpec entryConfigSpecs[] = {
+ {TK_CONFIG_STRING, "-data", (char *) NULL, (char *) NULL,
+ DEF_HLISTENTRY_DATA, Tk_Offset(HListElement, data), TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_UID, "-state", (char*)NULL, (char*)NULL,
+ DEF_HLISTENTRY_STATE, Tk_Offset(HListElement, state), 0},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+ /* These are standard procedures for TK widgets
+ * implemeted in C
+ */
+
+static void WidgetCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int WidgetConfigure _ANSI_ARGS_((Tcl_Interp *interp,
+ WidgetPtr wPtr, int argc, char **argv,
+ int flags));
+static void WidgetDestroy _ANSI_ARGS_((ClientData clientData));
+static void WidgetEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int WidgetCommand _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *, int argc, char **argv));
+static void WidgetDisplay _ANSI_ARGS_((ClientData clientData));
+
+ /* Extra procedures for this widget
+ */
+static HListElement * AllocElement _ANSI_ARGS_((WidgetPtr wPtr,
+ HListElement * parent, char * pathName,
+ char * name, char * ditemType));
+static void AppendList _ANSI_ARGS_((WidgetPtr wPtr,
+ HListElement *parent, HListElement *chPtr, int at,
+ HListElement *afterPtr,
+ HListElement *beforePtr));
+static void CancelRedrawWhenIdle _ANSI_ARGS_((
+ WidgetPtr wPtr));
+static void CheckScrollBar _ANSI_ARGS_((WidgetPtr wPtr,
+ int which));
+static void ComputeBranchPosition _ANSI_ARGS_((
+ WidgetPtr wPtr, HListElement *chPtr));
+static void ComputeElementGeometry _ANSI_ARGS_((WidgetPtr wPtr,
+ HListElement *chPtr, int indent));
+static void ComputeOneElementGeometry _ANSI_ARGS_((WidgetPtr wPtr,
+ HListElement *chPtr, int indent));
+static int ConfigElement _ANSI_ARGS_((WidgetPtr wPtr,
+ HListElement *chPtr, int argc, char ** argv,
+ int flags, int forced));
+static int CurSelection _ANSI_ARGS_((Tcl_Interp * interp,
+ WidgetPtr wPtr, HListElement * chPtr));
+static void DeleteNode _ANSI_ARGS_((WidgetPtr wPtr,
+ HListElement * chPtr));
+static void DeleteOffsprings _ANSI_ARGS_((WidgetPtr wPtr,
+ HListElement * chPtr));
+static void DeleteSiblings _ANSI_ARGS_((WidgetPtr wPtr,
+ HListElement * chPtr));
+static void DrawElements _ANSI_ARGS_((WidgetPtr wPtr,
+ Pixmap pixmap, GC gc, HListElement * chPtr,
+ int x, int y, int xOffset));
+static void DrawOneElement _ANSI_ARGS_((WidgetPtr wPtr,
+ Pixmap pixmap, GC gc, HListElement * chPtr,
+ int x, int y, int xOffset));
+static HListElement * FindElementAtPosition _ANSI_ARGS_((WidgetPtr wPtr,
+ int y));
+static HListElement * FindNextEntry _ANSI_ARGS_((WidgetPtr wPtr,
+ HListElement * chPtr));
+static HListElement * FindPrevEntry _ANSI_ARGS_((WidgetPtr wPtr,
+ HListElement * chPtr));
+static void FreeElement _ANSI_ARGS_((WidgetPtr wPtr,
+ HListElement * chPtr));
+static HListElement * NewElement _ANSI_ARGS_((Tcl_Interp *interp,
+ WidgetPtr wPtr, int argc, char ** argv,
+ char * pathName, char * defParentName,
+ int * newArgc));
+static void RedrawWhenIdle _ANSI_ARGS_((WidgetPtr wPtr));
+static int XScrollByPages _ANSI_ARGS_((WidgetPtr wPtr,
+ int count));
+static int XScrollByUnits _ANSI_ARGS_((WidgetPtr wPtr,
+ int count));
+static int YScrollByPages _ANSI_ARGS_((WidgetPtr wPtr,
+ int count));
+static int YScrollByUnits _ANSI_ARGS_((WidgetPtr wPtr,
+ int count));
+static int SelectionModifyRange _ANSI_ARGS_((WidgetPtr wPtr,
+ HListElement * from, HListElement * to,
+ int select));
+static void SelectionAdd _ANSI_ARGS_((WidgetPtr wPtr,
+ HListElement * chPtr));
+static void HL_SelectionClear _ANSI_ARGS_((WidgetPtr wPtr,
+ HListElement * chPtr));
+static void HL_SelectionClearAll _ANSI_ARGS_((WidgetPtr wPtr,
+ HListElement * chPtr, int *changed_ret));
+static void HL_SelectionClearNotifyAncestors _ANSI_ARGS_((
+ WidgetPtr wPtr, HListElement * chPtr));
+static void SelectionNotifyAncestors _ANSI_ARGS_((
+ WidgetPtr wPtr, HListElement * chPtr));
+static void UpdateOneScrollBar _ANSI_ARGS_((WidgetPtr wPtr,
+ char * command, int total, int window, int first));
+static void UpdateScrollBars _ANSI_ARGS_((WidgetPtr wPtr,
+ int sizeChanged));
+static void DItemSizeChangedProc _ANSI_ARGS_((
+ Tix_DItem *iPtr));
+static void SubWindowEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void GetScrollFractions _ANSI_ARGS_((int total,
+ int window, int first, double * first_ret,
+ double * last_ret));
+static int Tix_HLSeeElement _ANSI_ARGS_((
+ WidgetPtr wPtr, HListElement * chPtr,
+ int callRedraw));
+static int Tix_HLBBox _ANSI_ARGS_((Tcl_Interp * interp,
+ WidgetPtr wPtr, HListElement * chPtr));
+
+static TIX_DECLARE_SUBCMD(Tix_HLAdd);
+static TIX_DECLARE_SUBCMD(Tix_HLAddChild);
+static TIX_DECLARE_SUBCMD(Tix_HLCGet);
+static TIX_DECLARE_SUBCMD(Tix_HLConfig);
+static TIX_DECLARE_SUBCMD(Tix_HLDelete);
+static TIX_DECLARE_SUBCMD(Tix_HLEntryCget);
+static TIX_DECLARE_SUBCMD(Tix_HLEntryConfig);
+static TIX_DECLARE_SUBCMD(Tix_HLGeometryInfo);
+static TIX_DECLARE_SUBCMD(Tix_HLHide);
+static TIX_DECLARE_SUBCMD(Tix_HLInfo);
+static TIX_DECLARE_SUBCMD(Tix_HLNearest);
+static TIX_DECLARE_SUBCMD(Tix_HLSee);
+static TIX_DECLARE_SUBCMD(Tix_HLSelection);
+static TIX_DECLARE_SUBCMD(Tix_HLSetSite);
+static TIX_DECLARE_SUBCMD(Tix_HLShow);
+static TIX_DECLARE_SUBCMD(Tix_HLXView);
+static TIX_DECLARE_SUBCMD(Tix_HLYView);
+
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tix_HListCmd --
+ *
+ * This procedure is invoked to process the "HList" Tcl
+ * command. It creates a new "HList" widget.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * A new widget is created and configured.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Tix_HListCmd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window main = (Tk_Window) clientData;
+ WidgetPtr wPtr;
+ Tk_Window tkwin, subwin;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " pathName ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Allocate the main window for this window. Then allocate a subwindow
+ * to act as the header. The subwidget will always be raised to the top
+ * so that it won't be obscured by any window items
+ */
+ tkwin = Tk_CreateWindowFromPath(interp, main, argv[1], (char *) NULL);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ subwin = Tix_CreateSubWindow(interp, tkwin, "header");
+ if (subwin == NULL) {
+ Tk_DestroyWindow(tkwin);
+ return TCL_ERROR;
+ }
+
+ Tk_SetClass(tkwin, "TixHList");
+ Tk_SetClass(subwin, "TixHListHeader");
+
+ /*
+ * Allocate and initialize the widget record.
+ */
+ wPtr = (WidgetPtr) ckalloc(sizeof(WidgetRecord));
+
+ /* Init the hash table first (needed before calling AllocElement) */
+ Tcl_InitHashTable(&wPtr->childTable, TCL_STRING_KEYS);
+
+ wPtr->dispData.tkwin = tkwin;
+ wPtr->dispData.display = Tk_Display(tkwin);
+ wPtr->dispData.interp = interp;
+ wPtr->dispData.sizeChangedProc = DItemSizeChangedProc;
+ wPtr->font = NULL;
+ wPtr->normalBg = NULL;
+ wPtr->normalFg = NULL;
+ wPtr->border = NULL;
+ wPtr->borderWidth = 0;
+ wPtr->selectBorder = NULL;
+ wPtr->selBorderWidth = 0;
+ wPtr->selectFg = NULL;
+ wPtr->backgroundGC = None;
+ wPtr->normalGC = None;
+ wPtr->selectGC = None;
+ wPtr->anchorGC = None;
+ wPtr->dropSiteGC = None;
+ wPtr->highlightWidth = 0;
+ wPtr->highlightColorPtr = NULL;
+ wPtr->highlightGC = None;
+ wPtr->relief = TK_RELIEF_FLAT;
+ wPtr->cursor = None;
+ wPtr->indent = 0;
+ wPtr->resizing = 0;
+ wPtr->redrawing = 0;
+ wPtr->hasFocus = 0;
+ wPtr->topPixel = 0;
+ wPtr->leftPixel = 0;
+ wPtr->separator = NULL;
+ wPtr->selectMode = NULL;
+ wPtr->anchor = NULL;
+ wPtr->dragSite = NULL;
+ wPtr->dropSite = NULL;
+ wPtr->command = NULL;
+ wPtr->browseCmd = NULL;
+ wPtr->sizeCmd = NULL;
+ wPtr->dragCmd = NULL;
+ wPtr->dropCmd = NULL;
+ wPtr->takeFocus = NULL;
+ wPtr->xScrollCmd = NULL;
+ wPtr->yScrollCmd = NULL;
+ wPtr->scrollUnit[0] = 1;
+ wPtr->scrollUnit[1] = 1;
+ wPtr->serial = 0;
+ wPtr->numColumns = 1;
+ wPtr->initialized = 0;
+ wPtr->allDirty = 0;
+ wPtr->headerDirty = 0;
+ wPtr->needToRaise = 0;
+ wPtr->drawBranch = 1;
+ wPtr->wideSelect = 0;
+ wPtr->diTypePtr = NULL;
+ wPtr->reqSize = NULL;
+ wPtr->actualSize = NULL;
+ wPtr->root = NULL;
+ wPtr->totalSize[0] = 1;
+ wPtr->totalSize[1] = 1;
+ wPtr->useIndicator = 0;
+ wPtr->indicatorCmd = NULL;
+ wPtr->headers = NULL;
+ wPtr->useHeader = 0;
+ wPtr->headerHeight = 0;
+ wPtr->headerWin = subwin;
+ wPtr->elmToSee = 0;
+
+ Tix_LinkListInit(&wPtr->mappedWindows);
+
+ Tk_CreateEventHandler(wPtr->dispData.tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ WidgetEventProc, (ClientData) wPtr);
+ Tk_CreateEventHandler(wPtr->headerWin,
+ ExposureMask|StructureNotifyMask,
+ SubWindowEventProc, (ClientData) wPtr);
+
+ wPtr->widgetCmd = Tcl_CreateCommand(interp,
+ Tk_PathName(wPtr->dispData.tkwin), WidgetCommand, (ClientData) wPtr,
+ WidgetCmdDeletedProc);
+ if (WidgetConfigure(interp, wPtr, argc-2, argv+2, 0) != TCL_OK) {
+ Tk_DestroyWindow(wPtr->dispData.tkwin);
+ return TCL_ERROR;
+ }
+ if (Tix_HLCreateHeaders(interp, wPtr) != TCL_OK) {
+ Tk_DestroyWindow(wPtr->dispData.tkwin);
+ return TCL_ERROR;
+ }
+
+ /* Must call this **after** wPtr->numColumns is set */
+ wPtr->reqSize = Tix_HLAllocColumn(wPtr, NULL);
+ wPtr->actualSize = Tix_HLAllocColumn(wPtr, NULL);
+ wPtr->root = AllocElement(wPtr, 0, 0, 0, 0);
+
+ wPtr->initialized = 1;
+
+ interp->result = Tk_PathName(wPtr->dispData.tkwin);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WidgetCommand --
+ *
+ * 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
+WidgetCommand(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about the widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int code;
+
+ static Tix_SubCmdInfo subCmdInfo[] = {
+ {TIX_DEFAULT_LEN, "add", 1, TIX_VAR_ARGS, Tix_HLAdd,
+ "entryPath"},
+ {TIX_DEFAULT_LEN, "addchild", 1, TIX_VAR_ARGS, Tix_HLAddChild,
+ "parentEntryPath"},
+ {TIX_DEFAULT_LEN, "anchor", 1, 2, Tix_HLSetSite,
+ "option ?entryPath?"},
+ {TIX_DEFAULT_LEN, "cget", 1, 1, Tix_HLCGet,
+ "option"},
+ {TIX_DEFAULT_LEN, "column", 0, TIX_VAR_ARGS, Tix_HLColumn,
+ "?option? ?args ...?"},
+ {TIX_DEFAULT_LEN, "configure", 0, TIX_VAR_ARGS, Tix_HLConfig,
+ "?option? ?value? ?option value ... ?"},
+ {TIX_DEFAULT_LEN, "delete", 1, 2, Tix_HLDelete,
+ "option ?entryPath?"},
+ {TIX_DEFAULT_LEN, "dragsite", 1, 2, Tix_HLSetSite,
+ "option ?entryPath?"},
+ {TIX_DEFAULT_LEN, "dropsite", 1, 2, Tix_HLSetSite,
+ "option ?entryPath?"},
+ {TIX_DEFAULT_LEN, "entrycget", 2, 2, Tix_HLEntryCget,
+ "entryPath option"},
+ {TIX_DEFAULT_LEN, "entryconfigure", 1, TIX_VAR_ARGS, Tix_HLEntryConfig,
+ "entryPath ?option? ?value? ?option value ... ?"},
+ {TIX_DEFAULT_LEN, "geometryinfo", 0, 2, Tix_HLGeometryInfo,
+ "?width height?"},
+ {TIX_DEFAULT_LEN, "header", 1, TIX_VAR_ARGS, Tix_HLHeader,
+ "option ?args ...?"},
+ {TIX_DEFAULT_LEN, "hide", 2, 2, Tix_HLHide,
+ "option entryPath"},
+ {TIX_DEFAULT_LEN, "item", 0, TIX_VAR_ARGS, Tix_HLItem,
+ "?option? ?args ...?"},
+ {TIX_DEFAULT_LEN, "indicator", 1, TIX_VAR_ARGS, Tix_HLIndicator,
+ "option ?args ...?"},
+ {TIX_DEFAULT_LEN, "info", 1, TIX_VAR_ARGS, Tix_HLInfo,
+ "option ?args ...?"},
+ {TIX_DEFAULT_LEN, "nearest", 1, 1, Tix_HLNearest,
+ "y"},
+ {TIX_DEFAULT_LEN, "see", 1, 1, Tix_HLSee,
+ "entryPath"},
+ {TIX_DEFAULT_LEN, "selection", 1, 3, Tix_HLSelection,
+ "option arg ?arg ...?"},
+ {TIX_DEFAULT_LEN, "show", 2, 2, Tix_HLShow,
+ "option entryPath"},
+ {TIX_DEFAULT_LEN, "xview", 0, 3, Tix_HLXView,
+ "args"},
+ {TIX_DEFAULT_LEN, "yview", 0, 3, Tix_HLYView,
+ "args"},
+ };
+
+ static Tix_CmdInfo cmdInfo = {
+ Tix_ArraySize(subCmdInfo), 1, TIX_VAR_ARGS, "?option? arg ?arg ...?",
+ };
+
+ Tk_Preserve(clientData);
+ code = Tix_HandleSubCmds(&cmdInfo, subCmdInfo, clientData,
+ interp, argc, argv);
+ Tk_Release(clientData);
+
+ return code;
+}
+
+/*----------------------------------------------------------------------
+ * "add" sub command --
+ *
+ * Add a new item into the list
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLAdd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+ char * pathName = argv[0];
+
+ argc --;
+ argv ++;
+
+ if ((chPtr = NewElement(interp, wPtr, argc, argv, pathName,
+ NULL, &argc)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (argc > 0) {
+ if (ConfigElement(wPtr, chPtr, argc, argv, 0, 1) != TCL_OK) {
+ DeleteNode(wPtr, chPtr);
+ return TCL_ERROR;
+ }
+ } else {
+ if (Tix_DItemConfigure(chPtr->col[0].iPtr, 0, 0, 0) != TCL_OK) {
+ DeleteNode(wPtr, chPtr);
+ return TCL_ERROR;
+ }
+ }
+
+ Tcl_AppendResult(interp, chPtr->pathName, NULL);
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "addchild" sub command --
+ *
+ * Replacement for "add" sub command: it is more flexible and
+ * you can have default names for entries.
+ *
+ * Add a new item into the list
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLAddChild(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+ char * parentName;
+
+ parentName = argv[0];
+ if (argv[0] && strcmp(argv[0], "") == 0) {
+ parentName = NULL;
+ }
+
+ argc --;
+ argv ++;
+ if ((chPtr = NewElement(interp, wPtr, argc, argv, NULL,
+ parentName, &argc)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (argc > 0) {
+ if (ConfigElement(wPtr, chPtr, argc, argv, 0, 1) != TCL_OK) {
+ DeleteNode(wPtr, chPtr);
+ return TCL_ERROR;
+ }
+ } else {
+ if (Tix_DItemConfigure(chPtr->col[0].iPtr, 0, 0, 0) != TCL_OK) {
+ DeleteNode(wPtr, chPtr);
+ return TCL_ERROR;
+ }
+ }
+
+ Tcl_AppendResult(interp, chPtr->pathName, NULL);
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "anchor", "dragsite" and "dropsire" sub commands --
+ *
+ * Set/remove the anchor element
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLSetSite(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int changed = 0;
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+ HListElement ** changePtr;
+ size_t len ;
+
+ /*
+ * Determine which site should be changed.
+ */
+ len = strlen(argv[-1]);
+ if (strncmp(argv[-1], "anchor", len)==0) {
+ changePtr = &wPtr->anchor;
+ }
+ else if (strncmp(argv[-1], "dragsite", len)==0) {
+ changePtr = &wPtr->dragSite;
+ }
+ else {
+ changePtr = &wPtr->dropSite;
+ }
+
+ len = strlen(argv[0]);
+ if (strncmp(argv[0], "set", len)==0) {
+ if (argc == 2) {
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[1])) == NULL) {
+ return TCL_ERROR;
+ }
+ if (*changePtr != chPtr) {
+ *changePtr = chPtr;
+ changed = 1;
+ }
+ } else {
+ Tcl_AppendResult(interp, "wrong # of arguments, must be: ",
+ Tk_PathName(wPtr->dispData.tkwin), " ", argv[-1],
+ " set entryPath", NULL);
+ return TCL_ERROR;
+ }
+ }
+ else if (strncmp(argv[0], "clear", len)==0) {
+ if (*changePtr != NULL) {
+ *changePtr = NULL;
+ changed = 1;
+ }
+ }
+ else {
+ Tcl_AppendResult(interp, "wrong option \"", argv[0], "\", ",
+ "must be clear or set", NULL);
+ return TCL_ERROR;
+ }
+
+ if (changed) {
+ RedrawWhenIdle(wPtr);
+ }
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "cget" sub command --
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLCGet(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+
+ return Tk_ConfigureValue(interp, wPtr->dispData.tkwin, configSpecs,
+ (char *)wPtr, argv[0], 0);
+}
+
+/*----------------------------------------------------------------------
+ * "configure" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLConfig(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+
+ if (argc == 0) {
+ return Tk_ConfigureInfo(interp, wPtr->dispData.tkwin, configSpecs,
+ (char *) wPtr, (char *) NULL, 0);
+ } else if (argc == 1) {
+ return Tk_ConfigureInfo(interp, wPtr->dispData.tkwin, configSpecs,
+ (char *) wPtr, argv[0], 0);
+ } else {
+ return WidgetConfigure(interp, wPtr, argc, argv,
+ TK_CONFIG_ARGV_ONLY);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * "delete" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLDelete(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+ size_t len;
+
+ if (strcmp(argv[0], "all") == 0) {
+ Tix_HLMarkElementDirty(wPtr, wPtr->root);
+ DeleteOffsprings(wPtr, wPtr->root);
+
+ Tix_HLResizeWhenIdle(wPtr);
+ return TCL_OK;
+ }
+ len = strlen(argv[0]);
+
+ if (argc != 2) {
+ if ((strncmp(argv[0], "entry", len) == 0) ||
+ (strncmp(argv[0], "offsprings", len) == 0) ||
+ (strncmp(argv[0], "siblings", len) == 0)) {
+
+ goto wrong_arg;
+ }
+ else {
+ goto wrong_option;
+ }
+ }
+
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[1])) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (strncmp(argv[0], "entry", len) == 0) {
+ Tix_HLMarkElementDirty(wPtr, chPtr->parent);
+ DeleteNode(wPtr, chPtr);
+ }
+ else if (strncmp(argv[0], "offsprings", len) == 0) {
+ Tix_HLMarkElementDirty(wPtr, chPtr);
+ DeleteOffsprings(wPtr, chPtr);
+ }
+ else if (strncmp(argv[0], "siblings", len) == 0) {
+ Tix_HLMarkElementDirty(wPtr, chPtr);
+ DeleteSiblings(wPtr, chPtr);
+ }
+ else {
+ goto wrong_arg;
+ }
+
+ Tix_HLResizeWhenIdle(wPtr);
+ return TCL_OK;
+
+wrong_arg:
+
+ Tcl_AppendResult(interp,
+ "wrong # of arguments, should be pathName delete ", argv[0],
+ " entryPath", NULL);
+ return TCL_ERROR;
+
+wrong_option:
+
+ Tcl_AppendResult(interp, "unknown option \"", argv[0],
+ "\" must be all, entry, offsprings or siblings", NULL);
+ return TCL_ERROR;
+
+}
+
+/*----------------------------------------------------------------------
+ * "entrycget" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLEntryCget(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[0])) == NULL) {
+ return TCL_ERROR;
+ }
+ if (chPtr->col[0].iPtr == NULL) {
+ Tcl_AppendResult(interp, "Item \"", argv[0],
+ "\" does not exist", (char*)NULL);
+ return TCL_ERROR;
+ }
+ return Tix_ConfigureValue2(interp, wPtr->dispData.tkwin, (char *)chPtr,
+ entryConfigSpecs, chPtr->col[0].iPtr, argv[1], 0);
+}
+
+/*----------------------------------------------------------------------
+ * "entryconfigure" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLEntryConfig(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[0])) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (argc == 1) {
+ return Tix_ConfigureInfo2(interp, wPtr->dispData.tkwin,
+ (char*)chPtr, entryConfigSpecs, chPtr->col[0].iPtr,
+ (char *) NULL, 0);
+ } else if (argc == 2) {
+ return Tix_ConfigureInfo2(interp, wPtr->dispData.tkwin,
+ (char*)chPtr, entryConfigSpecs, chPtr->col[0].iPtr,
+ (char *) argv[1], 0);
+ } else {
+ return ConfigElement(wPtr, chPtr, argc-1, argv+1,
+ TK_CONFIG_ARGV_ONLY, 0);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * "geometryinfo" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLGeometryInfo(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int qSize[2];
+ double first[2], last[2];
+ char string[80];
+
+ if (argc == 2) {
+ if (Tcl_GetInt(interp, argv[0], &qSize[0]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[1], &qSize[1]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ qSize[0] = Tk_Width (wPtr->dispData.tkwin);
+ qSize[1] = Tk_Height(wPtr->dispData.tkwin);
+ }
+ qSize[0] -= 2*wPtr->borderWidth + 2*wPtr->highlightWidth;
+ qSize[1] -= 2*wPtr->borderWidth + 2*wPtr->highlightWidth;
+
+ if (wPtr->useHeader) {
+ qSize[1] -= wPtr->headerHeight;
+ }
+
+ GetScrollFractions(wPtr->totalSize[0], qSize[0], wPtr->leftPixel,
+ &first[0], &last[0]);
+ GetScrollFractions(wPtr->totalSize[1], qSize[1], wPtr->topPixel,
+ &first[1], &last[1]);
+
+ sprintf(string, "{%f %f} {%f %f}", first[0], last[0], first[1], last[1]);
+ Tcl_AppendResult(interp, string, NULL);
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "hide" sub command
+ *----------------------------------------------------------------------
+ */
+
+/* %% ToDo: implement the siblings ... etc options, to match those of "delete"
+ */
+static int
+Tix_HLHide(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[1])) == NULL) {
+ return TCL_ERROR;
+ }
+
+ Tix_HLMarkElementDirty(wPtr, chPtr->parent);
+ chPtr->hidden = 1;
+
+ Tix_HLResizeWhenIdle(wPtr);
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "show" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLShow(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[1])) == NULL) {
+ return TCL_ERROR;
+ }
+
+ Tix_HLMarkElementDirty(wPtr, chPtr->parent);
+ chPtr->hidden = 0;
+
+ Tix_HLResizeWhenIdle(wPtr);
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "info" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLInfo(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+ size_t len = strlen(argv[0]);
+
+ if (strncmp(argv[0], "anchor", len)==0) {
+ if (wPtr->anchor) {
+ Tcl_AppendResult(interp, wPtr->anchor->pathName, NULL);
+ }
+ return TCL_OK;
+ }
+ else if (strncmp(argv[0], "bbox", len)==0) {
+ HListElement * chPtr;
+
+ if (argc != 2) {
+ return Tix_ArgcError(interp, argc+2, argv-2, 3, "entryPath");
+ }
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[1])) == NULL) {
+ return TCL_ERROR;
+ }
+
+ return Tix_HLBBox(interp, wPtr, chPtr);
+ }
+ else if (strncmp(argv[0], "children", len)==0) {
+ HListElement * ptr;
+
+ if (argc != 1 && argc != 2) {
+ return Tix_ArgcError(interp, argc+2, argv-2, 3, "?entryPath?");
+ }
+ if (argc == 1 || (argc == 2 && *argv[1]==0)) {
+ chPtr = wPtr->root;
+ } else {
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[1])) == NULL) {
+ return TCL_ERROR;
+ }
+ }
+
+ for (ptr=chPtr->childHead; ptr; ptr=ptr->next) {
+ Tcl_AppendElement(interp, ptr->pathName);
+ }
+ return TCL_OK;
+ }
+ else if (strncmp(argv[0], "data", len)==0) {
+ if (argc != 2) {
+ return Tix_ArgcError(interp, argc+2, argv-2, 3, "entryPath");
+ }
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[1])) == NULL) {
+ return TCL_ERROR;
+ }
+
+ Tcl_AppendResult(interp, chPtr->data, NULL);
+ return TCL_OK;
+ }
+ else if (strncmp(argv[0], "dragsite", len)==0) {
+ if (wPtr->dragSite) {
+ Tcl_AppendResult(interp, wPtr->dragSite->pathName, NULL);
+ }
+ return TCL_OK;
+ }
+ else if (strncmp(argv[0], "dropsite", len)==0) {
+ if (wPtr->dropSite) {
+ Tcl_AppendResult(interp, wPtr->dropSite->pathName, NULL);
+ }
+ return TCL_OK;
+ }
+ else if (strncmp(argv[0], "exists", len)==0) {
+ if (argc != 2) {
+ return Tix_ArgcError(interp, argc+2, argv-2, 3, "entryPath");
+ }
+ chPtr = Tix_HLFindElement(interp, wPtr, argv[1]);
+
+ if (chPtr) {
+ Tcl_AppendResult(interp, "1", NULL);
+ } else {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "0", NULL);
+ }
+ return TCL_OK;
+ }
+ else if (strncmp(argv[0], "hidden", len)==0) {
+ if (argc != 2) {
+ return Tix_ArgcError(interp, argc+2, argv-2, 3, "entryPath");
+ }
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[1])) == NULL) {
+ return TCL_ERROR;
+ }
+ if (chPtr->hidden) {
+ Tcl_AppendElement(interp, "1");
+ } else {
+ Tcl_AppendElement(interp, "0");
+ }
+
+ return TCL_OK;
+ }
+ else if (strncmp(argv[0], "item", len)==0) {
+ return Tix_HLItemInfo(interp, wPtr, argc-1, argv+1);
+ }
+ else if (strncmp(argv[0], "next", len)==0) {
+ HListElement * nextPtr;
+
+ if (argc != 2) {
+ return Tix_ArgcError(interp, argc+2, argv-2, 3, "entryPath");
+ }
+
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[1])) == NULL) {
+ return TCL_ERROR;
+ }
+
+ nextPtr=FindNextEntry(wPtr, chPtr);
+
+ if (nextPtr) {
+ Tcl_AppendResult(interp, nextPtr->pathName, NULL);
+ }
+
+ return TCL_OK;
+ }
+ else if (strncmp(argv[0], "parent", len)==0) {
+ if (argc != 2) {
+ return Tix_ArgcError(interp, argc+2, argv-2, 3, "entryPath");
+ }
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[1])) == NULL) {
+ return TCL_ERROR;
+ }
+
+ Tcl_AppendResult(interp, chPtr->parent->pathName, NULL);
+ return TCL_OK;
+ }
+ else if (strncmp(argv[0], "prev", len)==0) {
+ HListElement * prevPtr;
+
+ if (argc != 2) {
+ return Tix_ArgcError(interp, argc+2, argv-2, 3, "entryPath");
+ }
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[1])) == NULL) {
+ return TCL_ERROR;
+ }
+ prevPtr = FindPrevEntry(wPtr, chPtr);
+ if (prevPtr) {
+ Tcl_AppendResult(interp, prevPtr->pathName, NULL);
+ }
+
+ return TCL_OK;
+ }
+ else if (strncmp(argv[0], "selection", len)==0) {
+ return CurSelection(interp, wPtr, wPtr->root);
+ }
+ else {
+ Tcl_AppendResult(interp, "unknown option \"", argv[0],
+ "\": must be anchor, bbox, children, data, dragsite, dropsite, ",
+ "exists, hidden, item, next, parent, prev or selection",
+ NULL);
+ return TCL_ERROR;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * "info item" sub-sub command
+ * argv[0] = x
+ * argv[1] = y
+ *
+ * returns {entryPath (indicator|column#) type component}
+ *----------------------------------------------------------------------
+ */
+int
+Tix_HLItemInfo(interp, wPtr, argc, argv)
+ Tcl_Interp *interp; /* Current interpreter. */
+ WidgetPtr wPtr; /* HList widget */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ HListElement * chPtr;
+ int itemX, itemY;
+ int listX, listY;
+ int widX, widY;
+ int i, m, n;
+ char column[20];
+
+ if (argc != 2) {
+ return Tix_ArgcError(interp, argc+3, argv-3, 3, "x y");
+ }
+ if (Tcl_GetInt(interp, argv[0], &widX) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[1], &widY) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (wPtr->root->dirty || wPtr->allDirty) {
+ /*
+ * We must update the geometry NOW otherwise we will get a wrong entry
+ */
+ Tix_HLCancelResizeWhenIdle(wPtr);
+ Tix_HLComputeGeometry((ClientData)wPtr);
+ }
+ if ((chPtr = FindElementAtPosition(wPtr, widY)) == NULL) {
+ goto none;
+ }
+
+ listX = widX - wPtr->borderWidth - wPtr->highlightWidth + wPtr->leftPixel;
+ listY = widY - wPtr->borderWidth - wPtr->highlightWidth + wPtr->topPixel;
+
+ if (wPtr->useHeader) {
+ listY -= wPtr->headerHeight;
+ }
+
+ itemX = listX - Tix_HLElementLeftOffset(wPtr, chPtr);
+ itemY = listY - Tix_HLElementTopOffset (wPtr, chPtr);
+
+ if (itemY < 0 || itemY >= chPtr->height) {
+ goto none;
+ }
+ if (itemX < 0) {
+ goto none;
+ }
+
+ if (wPtr->useIndicator && itemX < wPtr->indent) {
+ if (chPtr->indicator) {
+ int indCenterX;
+ int indOffX, indOffY;
+ int indX, indY;
+
+ /* This "if" is a BIG HACK */
+ if (chPtr->parent == wPtr->root) {
+ indCenterX = wPtr->indent/2;
+ }
+ else if (chPtr->parent->parent == wPtr->root) {
+ indCenterX = chPtr->parent->branchX - wPtr->indent;
+ } else {
+ indCenterX = chPtr->parent->branchX;
+ }
+
+ indOffX = indCenterX - Tix_DItemWidth (chPtr->indicator)/2;
+ indOffY = chPtr->iconY - Tix_DItemHeight(chPtr->indicator)/2;
+
+ indX = itemX - indOffX;
+ indY = itemY - indOffY;
+
+ /* Is it outside of the indicator? */
+ if (indX < 0 || indX >= Tix_DItemWidth (chPtr->indicator)) {
+ goto none;
+ }
+ if (indY < 0 || indY >= Tix_DItemHeight(chPtr->indicator)) {
+ goto none;
+ }
+ Tcl_AppendElement(interp, chPtr->pathName);
+ Tcl_AppendElement(interp, "indicator");
+ Tcl_AppendElement(interp, Tix_DItemTypeName(chPtr->indicator));
+ Tcl_AppendElement(interp,
+ Tix_DItemComponent(chPtr->indicator, indX, indY));
+ return TCL_OK;
+ } else {
+ goto none;
+ }
+ }
+
+ /* skip the indent part */
+
+ if (!wPtr->useIndicator && chPtr->parent == wPtr->root) {
+ /* indent not used only in this case */
+ } else {
+ itemX -= wPtr->indent;
+ }
+
+ for (m=n=0,i=0; i<wPtr->numColumns; i++) {
+ n += wPtr->actualSize[i].width;
+ if (listX < n) {
+ if (n > 1) {
+ itemX = listX - m;
+ }
+ goto _column;
+ }
+ m += wPtr->actualSize[i].width;
+ }
+ goto none;
+
+_column:
+ sprintf(column, "%d", i);
+ Tcl_AppendElement(interp, chPtr->pathName);
+ Tcl_AppendElement(interp, column);
+
+ if (chPtr->col[i].iPtr != NULL) {
+ Tcl_AppendElement(interp, Tix_DItemTypeName(chPtr->col[i].iPtr));
+ Tcl_AppendElement(interp,
+ Tix_DItemComponent(chPtr->col[i].iPtr, itemX, itemY));
+ }
+ return TCL_OK;
+
+none:
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "nearest" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLNearest(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+ int y;
+
+ if (Tcl_GetInt(interp, argv[0], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (wPtr->root->dirty || wPtr->allDirty) {
+ /*
+ * We must update the geometry NOW otherwise we will get a
+ * wrong entry.
+ */
+ Tix_HLCancelResizeWhenIdle(wPtr);
+ Tix_HLComputeGeometry((ClientData)wPtr);
+ }
+
+ if ((chPtr = FindElementAtPosition(wPtr, y)) != NULL) {
+ Tcl_AppendResult(interp, chPtr->pathName, NULL);
+ }
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "see" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLSee(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[0])) == NULL) {
+ return TCL_ERROR;
+ }
+ if (wPtr->resizing || wPtr->redrawing) {
+ if (wPtr->elmToSee) {
+ ckfree(wPtr->elmToSee);
+ }
+ wPtr->elmToSee = tixStrDup(argv[0]);
+ return TCL_OK;
+ } else {
+ Tix_HLSeeElement(wPtr, chPtr, 1);
+
+ return TCL_OK;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * Tix_HLBBox --
+ *
+ * Returns the visible bounding box of an HList element (x1, y1, x2, y2).
+ * Currently only y1 and y2 matters. x1 and x2 are always the left
+ * and right edges of the window.
+ *
+ * Return value:
+ * See user documenetation.
+ *
+ * Side effects:
+ * None.
+ *----------------------------------------------------------------------
+ */
+
+static int Tix_HLBBox(interp, wPtr, chPtr)
+ Tcl_Interp * interp; /* Interpreter to report the bbox. */
+ WidgetPtr wPtr; /* HList widget. */
+ HListElement * chPtr; /* Get the BBox for this element.*/
+{
+ int y, height;
+ int wXSize, wYSize; /* size of the listbox window area */
+ int pad;
+
+ if (!Tk_IsMapped(wPtr->dispData.tkwin)) {
+ return TCL_OK;
+ }
+
+ if (wPtr->root->dirty || wPtr->allDirty) {
+ /*
+ * We must update the geometry NOW otherwise we will wrong geometry
+ * info
+ */
+ Tix_HLCancelResizeWhenIdle(wPtr);
+ Tix_HLComputeGeometry((ClientData)wPtr);
+ }
+
+ y = Tix_HLElementTopOffset(wPtr, chPtr) - wPtr->topPixel;
+ pad = wPtr->borderWidth + wPtr->highlightWidth;
+ wXSize = Tk_Width(wPtr->dispData.tkwin ) - 2*pad;
+ wYSize = Tk_Height(wPtr->dispData.tkwin) - 2*pad;
+
+ if (wXSize <= 0) {
+ wXSize = 1;
+ }
+ if (wYSize <= 0) {
+ wYSize = 1;
+ }
+
+ height = chPtr->height;
+ if (height <= 0) {
+ height = 1;
+ }
+
+ if (y >= wYSize || (y+height) <= 0) {
+ /*
+ * The element is not visible
+ */
+ return TCL_OK;
+ } else {
+ int x1;
+ int y1, y2;
+ char buff[100];
+
+ /*
+ * The bounding box is clipped with the visible area of the widget.
+ */
+
+ x1 = pad;
+ y1 = y + wPtr->borderWidth + wPtr->highlightWidth;
+ y2 = y1 + height-1;
+
+ if (y1 < pad) {
+ y1 = pad;
+ }
+ if (y2 >= pad+wYSize) {
+ y2 = pad+wYSize -1;
+ }
+
+ if (y2 >= y1) {
+ sprintf(buff, "%d %d %d %d", x1, y1, x1+wXSize-1, y2);
+ Tcl_SetResult(interp, buff, TCL_VOLATILE);
+ }
+ return TCL_OK;
+ }
+}
+
+static int Tix_HLSeeElement(wPtr, chPtr, callRedraw)
+ WidgetPtr wPtr;
+ HListElement * chPtr;
+ int callRedraw;
+{
+ int x, y;
+ int cXSize, cYSize; /* element size */
+ int wXSize, wYSize; /* size of the listbox window area */
+ int top, left; /* new top and left offset of the HLIst */
+ int oldTop, oldLeft;
+
+ oldLeft = wPtr->leftPixel;
+ oldTop = wPtr->topPixel;
+
+ x = Tix_HLElementLeftOffset(wPtr, chPtr);
+ y = Tix_HLElementTopOffset(wPtr, chPtr);
+ if (chPtr->col[0].iPtr) {
+ cXSize = Tix_DItemWidth(chPtr->col[0].iPtr);
+ } else {
+ cXSize = chPtr->col[0].width;
+ }
+ cYSize = chPtr->height;
+ wXSize = Tk_Width(wPtr->dispData.tkwin) -
+ (2*wPtr->borderWidth + 2*wPtr->highlightWidth);
+ wYSize = Tk_Height(wPtr->dispData.tkwin) -
+ (2*wPtr->borderWidth + 2*wPtr->highlightWidth);
+
+ if (wPtr->useHeader) {
+ wYSize -= wPtr->headerHeight;
+ }
+
+ if (wXSize < 0 || wYSize < 0) {
+ /* The window is probably not visible */
+ return TCL_OK;
+ }
+
+ if (cXSize < wXSize && wPtr->numColumns == 1) {
+ /* Align on the X direction */
+ left = wPtr->leftPixel;
+ if ((x < wPtr->leftPixel) || (x+cXSize > wPtr->leftPixel+wXSize)) {
+ if (wXSize > cXSize) {
+ left = x - (wXSize-cXSize)/2;
+ } else {
+ left = x;
+ }
+ }
+ } else {
+ left = wPtr->leftPixel;
+ }
+
+ /* Align on the Y direction */
+ top = wPtr->topPixel;
+
+ if (cYSize < wYSize) {
+ if ((wPtr->topPixel-y)>wYSize || (y-wPtr->topPixel-wYSize) > wYSize) {
+ /* far away, make it middle */
+ top = y - (wYSize-cYSize)/2;
+ }
+ else if (y < wPtr->topPixel) {
+ top = y;
+ }
+ else if (y+cYSize > wPtr->topPixel+wYSize){
+ top = y+cYSize - wYSize ;
+ }
+ }
+
+ if (oldLeft != left || oldTop != top) {
+ wPtr->leftPixel = left;
+ wPtr->topPixel = top;
+
+ if (callRedraw) {
+ UpdateScrollBars(wPtr, 0);
+ RedrawWhenIdle(wPtr);
+ }
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * "selection" sub command
+ * Modify the selection in this HList box
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLSelection(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+ size_t len = strlen(argv[0]);
+ int code = TCL_OK;
+ int changed = 0;
+
+ if (strncmp(argv[0], "clear", len)==0) {
+ if (argc == 1) {
+ HL_SelectionClearAll(wPtr, wPtr->root, &changed);
+ }
+ else {
+ HListElement * from, * to;
+
+ from = Tix_HLFindElement(interp, wPtr, argv[1]);
+ if (from == NULL) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ if (argc == 3) {
+ to = Tix_HLFindElement(interp, wPtr, argv[2]);
+ if (to == NULL) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ changed = SelectionModifyRange(wPtr, from, to, 0);
+ }
+ else {
+ if (from->selected == 1) {
+ HL_SelectionClear(wPtr, from);
+ changed = 1;
+ }
+ }
+ }
+ }
+ else if (strncmp(argv[0], "includes", len)==0) {
+ if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[1])) == NULL) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ if (chPtr->selected) {
+ Tcl_AppendResult(interp, "1", NULL);
+ } else {
+ Tcl_AppendResult(interp, "0", NULL);
+ }
+ }
+ else if (strncmp(argv[0], "get", len)==0) {
+ if (argc != 1) {
+ Tix_ArgcError(interp, argc+2, argv-2, 3, "");
+ code = TCL_ERROR;
+ } else {
+ code = CurSelection(interp, wPtr, wPtr->root);
+ }
+ }
+ else if (strncmp(argv[0], "set", len)==0) {
+ HListElement * from, * to;
+
+ if (argc < 2 || argc > 3) {
+ Tix_ArgcError(interp, argc+2, argv-2, 3, "from ?to?");
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ from = Tix_HLFindElement(interp, wPtr, argv[1]);
+ if (from == NULL) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ if (argc == 3) {
+ to = Tix_HLFindElement(interp, wPtr, argv[2]);
+ if (to == NULL) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ changed = SelectionModifyRange(wPtr, from, to, 1);
+ } else {
+ if (!from->selected && !from->hidden) {
+ SelectionAdd(wPtr, from);
+ changed = 1;
+ }
+ }
+ }
+ else {
+ Tcl_AppendResult(interp, "unknown option \"", argv[0],
+ "\": must be anchor, clear, get, includes or set", NULL);
+ code = TCL_ERROR;
+ }
+
+ done:
+ if (changed) {
+ RedrawWhenIdle(wPtr);
+ }
+
+ return code;
+}
+
+/*----------------------------------------------------------------------
+ * "xview" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLXView(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+ int leftPixel;
+ int oldLeft = wPtr->leftPixel;
+ if (argc == 0) {
+ char string[20];
+
+ sprintf(string, "%d", wPtr->leftPixel);
+ Tcl_AppendResult(interp, string, NULL);
+ return TCL_OK;
+ }
+ else if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[0])) != NULL) {
+ leftPixel = Tix_HLElementLeftOffset(wPtr, chPtr);
+ }
+ else if (Tcl_GetInt(interp, argv[0], &leftPixel) == TCL_OK) {
+ /* %% todo backward-compatible mode */
+
+ }
+ else {
+ int type, count;
+ double fraction;
+
+ Tcl_ResetResult(interp);
+
+ /* Tk_GetScrollInfo () wants strange argc,argv combinations .. */
+ type = Tk_GetScrollInfo(interp, argc+2, argv-2, &fraction, &count);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ return TCL_ERROR;
+
+ case TK_SCROLL_MOVETO:
+ leftPixel = (int)(fraction * (double)wPtr->totalSize[0]);
+ break;
+
+ case TK_SCROLL_PAGES:
+ leftPixel = XScrollByPages(wPtr, count);
+ break;
+
+ case TK_SCROLL_UNITS:
+ leftPixel = XScrollByUnits(wPtr, count);
+ break;
+ }
+ }
+
+ if (oldLeft != leftPixel) {
+ wPtr->leftPixel = leftPixel;
+ UpdateScrollBars(wPtr, 0);
+
+ RedrawWhenIdle(wPtr);
+ }
+
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "yview" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_HLYView(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ HListElement * chPtr;
+ int topPixel;
+ int oldTop = wPtr->topPixel;
+
+ if (argc == 0) {
+ char string[20];
+
+ sprintf(string, "%d", wPtr->topPixel);
+ Tcl_AppendResult(interp, string, NULL);
+ return TCL_OK;
+ }
+ else if ((chPtr = Tix_HLFindElement(interp, wPtr, argv[0])) != NULL) {
+ topPixel = Tix_HLElementTopOffset(wPtr, chPtr);
+ }
+ else if (Tcl_GetInt(interp, argv[0], &topPixel) == TCL_OK) {
+ /* %% todo backward-compatible mode */
+ }
+ else {
+ int type, count;
+ double fraction;
+
+ Tcl_ResetResult(interp);
+
+ /* Tk_GetScrollInfo () wants strange argc,argv combinations .. */
+ type = Tk_GetScrollInfo(interp, argc+2, argv-2, &fraction, &count);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ return TCL_ERROR;
+
+ case TK_SCROLL_MOVETO:
+ topPixel = (int)(fraction * (double)wPtr->totalSize[1]);
+ break;
+
+ case TK_SCROLL_PAGES:
+ topPixel = YScrollByPages(wPtr, count);
+ break;
+
+ case TK_SCROLL_UNITS:
+ topPixel = YScrollByUnits(wPtr, count);
+ break;
+ }
+ }
+
+ if (oldTop != topPixel) {
+ wPtr->topPixel = topPixel;
+ UpdateScrollBars(wPtr, 0);
+
+ RedrawWhenIdle(wPtr);
+ }
+
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WidgetConfigure --
+ *
+ * This procedure is called to process an argv/argc list in
+ * conjunction with the Tk option database to configure (or
+ * reconfigure) a HList 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 wPtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+WidgetConfigure(interp, wPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ WidgetPtr wPtr; /* Information about widget. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Flags to pass to
+ * Tk_ConfigureWidget. */
+{
+ XGCValues gcValues;
+ GC newGC;
+ TixFont oldfont;
+ int oldColumns;
+ Tix_StyleTemplate stTmpl;
+
+ oldfont = wPtr->font;
+ oldColumns = wPtr->numColumns;
+ if (Tk_ConfigureWidget(interp, wPtr->dispData.tkwin, configSpecs,
+ argc, argv, (char *) wPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (wPtr->initialized && oldColumns != wPtr->numColumns) {
+ Tcl_AppendResult(interp, "Cannot change the number of columns ",
+ (char *) NULL);
+ wPtr->numColumns = oldColumns;
+ return TCL_ERROR;
+ }
+ if (wPtr->numColumns < 1) {
+ wPtr->numColumns = 1;
+ }
+
+ if (wPtr->separator == 0 || wPtr->separator[0] == 0) {
+ if (wPtr->separator != 0) {
+ ckfree(wPtr->separator);
+ }
+ wPtr->separator = (char*)tixStrDup(".");
+ }
+
+ if (oldfont != wPtr->font) {
+ /*
+ * Font has been changed (initialized)
+ */
+ TixComputeTextGeometry(wPtr->font, "0", 1,
+ 0, &wPtr->scrollUnit[0], &wPtr->scrollUnit[1]);
+ }
+
+ /*
+ * 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(wPtr->dispData.tkwin, wPtr->border);
+
+ /*
+ * Note: GraphicsExpose events are disabled in normalGC because it's
+ * used to copy stuff from an off-screen pixmap onto the screen (we know
+ * that there's no problem with obscured areas).
+ */
+
+ /* The background GC */
+ gcValues.foreground = wPtr->normalBg->pixel;
+ gcValues.graphics_exposures = False;
+
+ newGC = Tk_GetGC(wPtr->dispData.tkwin,
+ GCForeground|GCGraphicsExposures, &gcValues);
+ if (wPtr->backgroundGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->backgroundGC);
+ }
+ wPtr->backgroundGC = newGC;
+
+ /* The normal text GC */
+ gcValues.font = TixFontId(wPtr->font);
+ gcValues.foreground = wPtr->normalFg->pixel;
+ gcValues.background = wPtr->normalBg->pixel;
+ gcValues.graphics_exposures = False;
+
+ newGC = Tk_GetGC(wPtr->dispData.tkwin,
+ GCForeground|GCBackground|GCFont|GCGraphicsExposures, &gcValues);
+ if (wPtr->normalGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->normalGC);
+ }
+ wPtr->normalGC = newGC;
+
+ /* The selected text GC */
+ gcValues.font = TixFontId(wPtr->font);
+ gcValues.foreground = wPtr->selectFg->pixel;
+ gcValues.background = Tk_3DBorderColor(wPtr->selectBorder)->pixel;
+ gcValues.graphics_exposures = False;
+
+ newGC = Tk_GetGC(wPtr->dispData.tkwin,
+ GCForeground|GCBackground|GCFont|GCGraphicsExposures, &gcValues);
+ if (wPtr->selectGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->selectGC);
+ }
+ wPtr->selectGC = newGC;
+
+ /* The dotted anchor lines */
+ gcValues.foreground = wPtr->normalFg->pixel;
+ gcValues.background = wPtr->normalBg->pixel;
+ gcValues.graphics_exposures = False;
+ gcValues.line_style = LineDoubleDash;
+ gcValues.dashes = 2;
+ gcValues.subwindow_mode = IncludeInferiors;
+
+ newGC = Tk_GetGC(wPtr->dispData.tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures|GCLineStyle|GCDashList|
+ GCSubwindowMode, &gcValues);
+ if (wPtr->anchorGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->anchorGC);
+ }
+ wPtr->anchorGC = newGC;
+
+ /* The sloid dropsite lines */
+ gcValues.foreground = wPtr->normalFg->pixel;
+ gcValues.background = wPtr->normalBg->pixel;
+ gcValues.graphics_exposures = False;
+ gcValues.subwindow_mode = IncludeInferiors;
+
+ newGC = Tk_GetGC(wPtr->dispData.tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures|GCSubwindowMode,
+ &gcValues);
+ if (wPtr->dropSiteGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->dropSiteGC);
+ }
+ wPtr->dropSiteGC = newGC;
+
+ /* The highlight border */
+ gcValues.background = wPtr->selectFg->pixel;
+ gcValues.foreground = wPtr->highlightColorPtr->pixel;
+ gcValues.subwindow_mode = IncludeInferiors;
+
+ newGC = Tk_GetGC(wPtr->dispData.tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures, &gcValues);
+ if (wPtr->highlightGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->highlightGC);
+ }
+ wPtr->highlightGC = newGC;
+
+ /* We must set the options of the default styles so that
+ * -- the default styles will change according to what is in
+ * stTmpl
+ */
+
+ stTmpl.font = wPtr->font;
+ stTmpl.pad[0] = wPtr->padX;
+ stTmpl.pad[1] = wPtr->padY;
+ stTmpl.colors[TIX_DITEM_NORMAL].fg = wPtr->normalFg;
+ stTmpl.colors[TIX_DITEM_NORMAL].bg = wPtr->normalBg;
+ stTmpl.colors[TIX_DITEM_SELECTED].fg= wPtr->selectFg;
+ stTmpl.colors[TIX_DITEM_SELECTED].bg= Tk_3DBorderColor(wPtr->selectBorder);
+ stTmpl.flags = TIX_DITEM_FONT|TIX_DITEM_NORMAL_BG|
+ TIX_DITEM_SELECTED_BG|TIX_DITEM_NORMAL_FG|TIX_DITEM_SELECTED_FG |
+ TIX_DITEM_PADX|TIX_DITEM_PADY;
+ Tix_SetDefaultStyleTemplate(wPtr->dispData.tkwin, &stTmpl);
+
+ /* Probably the size of the elements in this has changed */
+ Tix_HLResizeWhenIdle(wPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WidgetEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on HLists.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+WidgetEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+
+ switch (eventPtr->type) {
+ case DestroyNotify:
+ if (wPtr->dispData.tkwin != NULL) {
+ wPtr->dispData.tkwin = NULL;
+ Tcl_DeleteCommand(wPtr->dispData.interp,
+ Tcl_GetCommandName(wPtr->dispData.interp, wPtr->widgetCmd));
+ }
+ Tix_HLCancelResizeWhenIdle(wPtr);
+ CancelRedrawWhenIdle(wPtr);
+ Tk_EventuallyFree((ClientData)wPtr, (Tix_FreeProc*)WidgetDestroy);
+ break;
+
+ case ConfigureNotify:
+ RedrawWhenIdle(wPtr);
+ UpdateScrollBars(wPtr, 1);
+ break;
+
+ case Expose:
+ RedrawWhenIdle(wPtr);
+ break;
+
+ case FocusIn:
+ wPtr->hasFocus = 1;
+ RedrawWhenIdle(wPtr);
+ break;
+
+ case FocusOut:
+ wPtr->hasFocus = 0;
+ RedrawWhenIdle(wPtr);
+ break;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SubWindowEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on the header subwindow.
+ *--------------------------------------------------------------
+ */
+static void
+SubWindowEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ Tk_FakeWin * fw;
+
+ switch (eventPtr->type) {
+ case DestroyNotify:
+
+#ifdef TK_PARENT_DESTROYED
+ /*
+ * The TK_PARENT_DESTROYED symbol is no longer defined in Tk 8.0
+ */
+ fw = (Tk_FakeWin *) (wPtr->headerWin);
+ if (fw->flags & TK_PARENT_DESTROYED) {
+ break;
+ }
+ if (wPtr->headerWin != NULL) {
+ panic("HList: header subwindow deleted illegally\n");
+ }
+#endif
+ break;
+
+ case Expose:
+ if (wPtr->headerWin != NULL) {
+ RedrawWhenIdle(wPtr);
+ }
+ break;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WidgetDestroy --
+ *
+ * This procedure is invoked by Tk_EventuallyFree or Tk_Release
+ * to clean up the internal structure of a HList at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the HList is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+WidgetDestroy(clientData)
+ ClientData clientData; /* Info about my widget. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+
+ if (wPtr->root != NULL) {
+ DeleteOffsprings(wPtr, wPtr->root);
+ FreeElement(wPtr, wPtr->root);
+ }
+
+ if (wPtr->backgroundGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->backgroundGC);
+ }
+ if (wPtr->normalGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->normalGC);
+ }
+ if (wPtr->selectGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->selectGC);
+ }
+ if (wPtr->anchorGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->anchorGC);
+ }
+ if (wPtr->dropSiteGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->dropSiteGC);
+ }
+ if (wPtr->highlightGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->highlightGC);
+ }
+
+ /* the following two members will be NULL if the widget was destroyed
+ * during its creation (e.g., wrong arguments during creation
+ */
+ if (wPtr->reqSize != NULL) {
+ ckfree((char*)wPtr->reqSize);
+ }
+ if (wPtr->actualSize != NULL) {
+ ckfree((char*)wPtr->actualSize);
+ }
+ if (wPtr->elmToSee != NULL) {
+ ckfree(wPtr->elmToSee);
+ wPtr->elmToSee = NULL;
+ }
+
+ Tix_HLFreeHeaders(wPtr->dispData.interp, wPtr);
+
+ if (!Tix_IsLinkListEmpty(wPtr->mappedWindows)) {
+ /*
+ * All mapped windows should have been unmapped when the
+ * the entries were deleted
+ */
+ panic("tixHList: mappedWindows not NULL");
+ }
+ if (wPtr->headerWin) {
+ wPtr->headerWin = NULL;
+ }
+ Tcl_DeleteHashTable(&wPtr->childTable);
+
+ Tk_FreeOptions(configSpecs, (char *) wPtr, wPtr->dispData.display, 0);
+ ckfree((char *) wPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WidgetCmdDeletedProc --
+ *
+ * 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
+WidgetCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ WidgetPtr wPtr = (WidgetPtr) 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 (wPtr->dispData.tkwin != NULL) {
+ Tk_Window tkwin = wPtr->dispData.tkwin;
+ wPtr->dispData.tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tix_HLComputeGeometry --
+ *
+ * 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:
+ * none
+ *
+ *--------------------------------------------------------------
+ */
+void
+Tix_HLComputeGeometry(clientData)
+ ClientData clientData;
+{
+ WidgetPtr wPtr = (WidgetPtr)clientData;
+ int i, reqW, reqH;
+ int sizeChanged = 0;
+ int width;
+ wPtr->resizing = 0;
+
+ /* Update geometry request */
+ if (wPtr->useHeader && wPtr->headerDirty) {
+ Tix_HLComputeHeaderGeometry(wPtr);
+ }
+
+ if (wPtr->root->dirty || wPtr->allDirty) {
+ if (wPtr->useIndicator) {
+ /*
+ * If we use indicator, then the toplevel elements are indented
+ * by wPtr->indent. Otherwise they are indented by 0 pixels
+ */
+ ComputeElementGeometry(wPtr, wPtr->root, wPtr->indent);
+ } else {
+ ComputeElementGeometry(wPtr, wPtr->root, 0);
+ }
+ }
+ width = 0;
+ for (i=0; i<wPtr->numColumns; i++) {
+ if (wPtr->reqSize[i].width != UNINITIALIZED) {
+ wPtr->actualSize[i].width = wPtr->reqSize[i].width;
+ }
+ else {
+ /* This is the req size of the entry columns */
+ int entReq = wPtr->root->col[i].width;
+
+ /* This is the req size of the header columns */
+ int hdrReq = wPtr->headers[i]->width;
+
+ if (wPtr->useHeader && hdrReq > entReq) {
+ wPtr->actualSize[i].width = hdrReq;
+ } else {
+ wPtr->actualSize[i].width = entReq;
+ }
+ }
+ width += wPtr->actualSize[i].width;
+ }
+ sizeChanged = 1;
+ wPtr->allDirty = 0;
+
+ wPtr->totalSize[0] = width;
+ wPtr->totalSize[1] = wPtr->root->allHeight;
+
+ if (wPtr->width > 0) {
+ reqW = wPtr->width * wPtr->scrollUnit[0];
+ } else {
+ reqW = width;
+ }
+ if (wPtr->height > 0) {
+ reqH = wPtr->height * wPtr->scrollUnit[1];
+ } else {
+ reqH = wPtr->root->allHeight;
+ }
+
+ wPtr->totalSize[0] += 2*wPtr->borderWidth + 2*wPtr->highlightWidth;
+ wPtr->totalSize[1] += 2*wPtr->borderWidth + 2*wPtr->highlightWidth;
+ reqW += 2*wPtr->borderWidth + 2*wPtr->highlightWidth;
+ reqH += 2*wPtr->borderWidth + 2*wPtr->highlightWidth;
+
+ if (wPtr->useHeader) {
+ reqH += wPtr->headerHeight;
+ }
+
+ /* Now we need to handle the multiple columns mode */
+
+ Tk_GeometryRequest(wPtr->dispData.tkwin, reqW, reqH);
+
+ /* Update scrollbars */
+ UpdateScrollBars(wPtr, sizeChanged);
+
+ RedrawWhenIdle(wPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ * Tix_HLResizeWhenIdle --
+ *----------------------------------------------------------------------
+ */
+void
+Tix_HLResizeWhenIdle(wPtr)
+ WidgetPtr wPtr;
+{
+ if (!wPtr->resizing) {
+ wPtr->resizing = 1;
+ Tk_DoWhenIdle(Tix_HLComputeGeometry, (ClientData)wPtr);
+ }
+ if (wPtr->redrawing) {
+ CancelRedrawWhenIdle(wPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * Tix_HLResizeNow --
+ *----------------------------------------------------------------------
+ */
+void
+Tix_HLResizeNow(wPtr)
+ WidgetPtr wPtr;
+{
+ if (wPtr->resizing) {
+ wPtr->resizing = 0;
+ Tk_CancelIdleCall(Tix_HLComputeGeometry, (ClientData)wPtr);
+ Tix_HLComputeGeometry((ClientData)wPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * Tix_HLCancelResizeWhenIdle --
+ *----------------------------------------------------------------------
+ */
+void
+Tix_HLCancelResizeWhenIdle(wPtr)
+ WidgetPtr wPtr;
+{
+ if (wPtr->resizing) {
+ wPtr->resizing = 0;
+ Tk_CancelIdleCall(Tix_HLComputeGeometry, (ClientData)wPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * RedrawWhenIdle --
+ *----------------------------------------------------------------------
+ */
+static void
+RedrawWhenIdle(wPtr)
+ WidgetPtr wPtr;
+{
+ if (!wPtr->redrawing && Tk_IsMapped(wPtr->dispData.tkwin)) {
+ wPtr->redrawing = 1;
+ Tk_DoWhenIdle(WidgetDisplay, (ClientData)wPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * CancelRedrawWhenIdle --
+ *----------------------------------------------------------------------
+ */
+static void
+CancelRedrawWhenIdle(wPtr)
+ WidgetPtr wPtr;
+{
+ if (wPtr->redrawing) {
+ wPtr->redrawing = 0;
+ Tk_CancelIdleCall(WidgetDisplay, (ClientData)wPtr);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * DItemSizeChangedProc --
+ *
+ * This is called whenever the size of one of the HList's items
+ * changes its size.
+ *----------------------------------------------------------------------
+ */
+static void DItemSizeChangedProc(iPtr)
+ Tix_DItem *iPtr;
+{
+ HLItemTypeInfo * info = (HLItemTypeInfo *)iPtr->base.clientData;
+ HListColumn * colPtr;
+ HListElement * chPtr;
+ HListHeader * hPtr;
+ WidgetPtr wPtr;
+
+ if (info == NULL) {
+ /* Perhaps we haven't set the clientData yet! */
+ return;
+ }
+
+ switch (info->type) {
+ case HLTYPE_COLUMN:
+ colPtr = (HListColumn*) info;
+ chPtr = colPtr->chPtr;
+
+ if (chPtr) { /* Sanity check */
+ Tix_HLMarkElementDirty(chPtr->wPtr, chPtr);
+ Tix_HLResizeWhenIdle(chPtr->wPtr);
+ }
+ break;
+ case HLTYPE_HEADER:
+ hPtr = (HListHeader*)info;
+ wPtr = hPtr->wPtr;
+ wPtr->headerDirty = 1;
+ if (wPtr->useHeader) {
+ Tix_HLResizeWhenIdle(wPtr);
+ }
+ break;
+ case HLTYPE_ENTRY:
+ chPtr = (HListElement*)info;
+
+ if (chPtr) { /* Sanity check */
+ Tix_HLMarkElementDirty(chPtr->wPtr, chPtr);
+ Tix_HLResizeWhenIdle(chPtr->wPtr);
+ }
+ break;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AllocElement --
+ *
+ * Allocates a new structure for the new element and record it
+ * in the hash table
+ *
+ * Results:
+ * a pointer to the new element's structure
+ *
+ * Side effects:
+ * Has table is changed
+ *--------------------------------------------------------------
+ */
+static HListElement *
+AllocElement(wPtr, parent, pathName, name, ditemType)
+ WidgetPtr wPtr;
+ HListElement * parent;
+ char * pathName;
+ char * name;
+ char * ditemType;
+{
+ HListElement * chPtr;
+ Tcl_HashEntry * hashPtr;
+ int dummy;
+ Tix_DItem * iPtr;
+
+ if (ditemType == NULL) {
+ iPtr = NULL;
+ } else {
+ if ((iPtr = Tix_DItemCreate(&wPtr->dispData, ditemType)) == NULL) {
+ return NULL;
+ }
+ }
+
+ chPtr = (HListElement*)ckalloc(sizeof(HListElement));
+
+ if (pathName) {
+ /* pathName == 0 is the root element */
+ hashPtr = Tcl_CreateHashEntry(&wPtr->childTable, pathName, &dummy);
+ Tcl_SetHashValue(hashPtr, (char*)chPtr);
+ }
+
+ if (parent) {
+ ++ parent->numCreatedChild;
+ }
+
+ if (wPtr->numColumns > 1) {
+ chPtr->col = Tix_HLAllocColumn(wPtr, chPtr);
+ } else {
+ chPtr->col = &chPtr->_oneCol;
+ chPtr->_oneCol.type = HLTYPE_COLUMN;
+ chPtr->_oneCol.self = (char*) &chPtr->_oneCol;
+ chPtr->_oneCol.chPtr = chPtr;
+ chPtr->_oneCol.iPtr = NULL;
+ chPtr->_oneCol.width = 0;
+ }
+ if (pathName) {
+ chPtr->pathName = (char*)tixStrDup(pathName);
+ } else {
+ chPtr->pathName = NULL;
+ }
+
+ if (name) {
+ chPtr->name = (char*)tixStrDup(name);
+ } else {
+ chPtr->name = NULL;
+ }
+
+ chPtr->type = HLTYPE_ENTRY;
+ chPtr->self = (char*)chPtr;
+ chPtr->wPtr = wPtr;
+ chPtr->parent = parent;
+ chPtr->prev = NULL;
+ chPtr->next = NULL;
+ chPtr->childHead = NULL;
+ chPtr->childTail = NULL;
+ chPtr->numSelectedChild = 0;
+ chPtr->numCreatedChild = 0;
+ chPtr->col[0].iPtr = iPtr;
+ chPtr->indicator = NULL;
+
+ chPtr->height = 0;
+ chPtr->allHeight = 0;
+ chPtr->selected = 0;
+ chPtr->dirty = 0;
+ chPtr->hidden = 0;
+ chPtr->state = tixNormalUid;
+ chPtr->data = NULL;
+ chPtr->branchX = 0;
+ chPtr->branchY = 0;
+
+ if (iPtr) {
+ /* The clientdata is usedful for the DItemSizeChangedProc() */
+ iPtr->base.clientData = (ClientData)&chPtr->col[0];
+ }
+
+ return chPtr;
+}
+
+static void
+FreeElement(wPtr, chPtr)
+ WidgetPtr wPtr;
+ HListElement * chPtr;
+{
+ Tcl_HashEntry * hashPtr;
+ int i;
+
+ if (chPtr->selected) {
+ HL_SelectionClear(wPtr, chPtr);
+ }
+ if (wPtr->anchor == chPtr) {
+ wPtr->anchor = NULL;
+ }
+ if (wPtr->dragSite == chPtr) {
+ wPtr->dragSite = NULL;
+ }
+ if (wPtr->dropSite == chPtr) {
+ wPtr->dropSite = NULL;
+ }
+
+ /*
+ * Free all the display items
+ */
+ for (i=0; i<wPtr->numColumns; i++) {
+ if (chPtr->col[i].iPtr) {
+ if (Tix_DItemType(chPtr->col[i].iPtr) == TIX_DITEM_WINDOW) {
+ Tix_WindowItemListRemove(&wPtr->mappedWindows,
+ chPtr->col[i].iPtr);
+ }
+ Tix_DItemFree(chPtr->col[i].iPtr);
+ }
+ }
+ if (chPtr->indicator != NULL) {
+ if (Tix_DItemType(chPtr->indicator) == TIX_DITEM_WINDOW) {
+ Tix_WindowItemListRemove(&wPtr->mappedWindows,
+ chPtr->indicator);
+ }
+ Tix_DItemFree(chPtr->indicator);
+ }
+
+ if (chPtr->col != &chPtr->_oneCol) {
+ /*
+ * This space was allocated dynamically
+ */
+ ckfree((char*)chPtr->col);
+ }
+
+ if (chPtr->pathName) {
+ /*
+ * Root does not have an entry in the hash table
+ */
+ if ((hashPtr = Tcl_FindHashEntry(&wPtr->childTable, chPtr->pathName))){
+ Tcl_DeleteHashEntry(hashPtr);
+ }
+ }
+ if (chPtr->name != NULL) {
+ ckfree(chPtr->name);
+ }
+ if (chPtr->pathName != NULL) {
+ ckfree(chPtr->pathName);
+ }
+ if (chPtr->data != NULL) {
+ ckfree(chPtr->data);
+ }
+
+ ckfree((char*)chPtr);
+}
+
+static void
+AppendList(wPtr, parent, chPtr, at, afterPtr, beforePtr)
+ WidgetPtr wPtr;
+ HListElement *parent;
+ HListElement *chPtr;
+ int at; /* At what position should this entry be added
+ * default is "-1": add at the end */
+ HListElement *afterPtr; /* after which entry should this entry be
+ * added. Default is NULL : ignore */
+ HListElement *beforePtr; /* before which entry should this entry be
+ * added. Default is NULL : ignore */
+{
+ if (parent->childHead == NULL) {
+ parent->childHead = chPtr;
+ parent->childTail = chPtr;
+ chPtr->prev = NULL;
+ chPtr->next = NULL;
+ }
+ else {
+ if (at >= 0) {
+ /*
+ * Find the current element at the "at" position
+ */
+ HListElement *ptr;
+ for (ptr=parent->childHead;
+ ptr!=NULL && at > 0;
+ ptr=ptr->next, --at) {
+ ; /* do nothing, just keep counting */
+ }
+ if (ptr != NULL) {
+ /*
+ * We need to insert the new element *before* ptr.E.g,
+ * if at == 0, then the new element should be the first
+ * of the list
+ */
+ beforePtr = ptr;
+ } else {
+ /* Seems like we walked past the end of the list. Well, do
+ * nothing here. By default, the new element will be
+ * append to the end of the list
+ */
+ }
+ }
+ if (afterPtr != NULL) {
+ if (afterPtr == parent->childTail) {
+ parent->childTail = chPtr;
+ } else {
+ afterPtr->next->prev = chPtr;
+ }
+ chPtr->prev = afterPtr;
+ chPtr->next = afterPtr->next;
+ afterPtr->next = chPtr;
+ return;
+ }
+ if (beforePtr !=NULL) {
+ if (beforePtr == parent->childHead) {
+ parent->childHead = chPtr;
+ } else {
+ beforePtr->prev->next = chPtr;
+ }
+ chPtr->prev = beforePtr->prev;
+ chPtr->next = beforePtr;
+ beforePtr->prev = chPtr;
+ return;
+ }
+
+ /*
+ * By default, append it at the end of the list
+ */
+ parent->childTail->next = chPtr;
+ chPtr->prev = parent->childTail;
+ chPtr->next = NULL;
+ parent->childTail = chPtr;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * NewElement --
+ *
+ * This procedure is creates a new element and record it both
+ * the hash table and in the tree.
+ *
+ * Results:
+ * pointer to new element
+ *
+ * Side effects:
+ * Hash table and tree changed if successful
+ *--------------------------------------------------------------
+ */
+static HListElement *
+NewElement(interp, wPtr, argc, argv, pathName, defParentName, newArgc)
+ Tcl_Interp *interp;
+ WidgetPtr wPtr;
+ int argc;
+ char ** argv;
+ char * pathName; /* Default pathname, if -pathname is not
+ * specified in the options */
+ char * defParentName; /* Default parent name (will NULL if pathName
+ * is not NULL */
+ int * newArgc;
+{
+#define FIXED_SPACE 20
+ char fixedSpace[FIXED_SPACE+1];
+ char *p, *parentName = NULL;
+ char *name; /* Last part of the name */
+ int i, n, numChars;
+ HListElement *parent;
+ HListElement *chPtr;
+ char sep = wPtr->separator[0];
+ int allocated = 0;
+ char * ditemType = NULL;
+ HListElement *afterPtr = NULL;
+ HListElement *beforePtr = NULL;
+ int at = -1;
+ int numSwitches = 0; /* counter on how many of the
+ * -after, -before and -at switches
+ * have been used. No more than one
+ * of then can be used */
+
+ /*
+ * (1) We need to determine the options:
+ * -itemtype, -after, -before and/or -at.
+ *
+ */
+ if (argc > 0) {
+ size_t len;
+ if (argc %2 != 0) {
+ Tcl_AppendResult(interp, "value for \"", argv[argc-1],
+ "\" missing", NULL);
+ chPtr = NULL;
+ goto done;
+ }
+ for (n=i=0; i<argc; i+=2) {
+ len = strlen(argv[i]);
+ if (strncmp(argv[i], "-itemtype", len) == 0) {
+ ditemType = argv[i+1];
+ goto copy;
+ }
+ else if (strncmp(argv[i], "-after", len) == 0) {
+ afterPtr = Tix_HLFindElement(interp, wPtr, argv[i+1]);
+ if (afterPtr == NULL) {
+ chPtr = NULL;
+ goto done;
+ }
+ ++ numSwitches;
+ continue;
+ }
+ else if (strncmp(argv[i], "-before", len) == 0) {
+ beforePtr = Tix_HLFindElement(interp, wPtr, argv[i+1]);
+ if (beforePtr == NULL) {
+ chPtr = NULL;
+ goto done;
+ }
+ ++ numSwitches;
+ continue;
+ }
+ else if (strncmp(argv[i], "-at", len) == 0) {
+ if (Tcl_GetInt(interp, argv[i+1], &at) != TCL_OK) {
+ chPtr = NULL;
+ goto done;
+ }
+ ++ numSwitches;
+ continue;
+ }
+
+ copy:
+ if (n!=i) {
+ argv[n] = argv[i];
+ argv[n+1] = argv[i+1];
+ }
+ n+=2;
+ }
+ * newArgc = n;
+ } else {
+ * newArgc = 0;
+ }
+ if (numSwitches > 1) {
+ Tcl_AppendResult(interp, "No more than one of the -after, -before ",
+ "and -at options can be used", NULL);
+ chPtr = NULL;
+ goto done;
+ }
+ if (ditemType == NULL) {
+ ditemType = wPtr->diTypePtr->name;
+ }
+ if (Tix_GetDItemType(interp, ditemType) == NULL) {
+ chPtr = NULL;
+ goto done;
+ }
+
+ /*------------------------------------------------------------
+ * (2) Create the new entry. The method depends on whether
+ * the "add" or "addchild" command has been called
+ *------------------------------------------------------------
+ */
+ if (pathName == NULL) {
+ /* (2.a) Called by the "addchild" command. We need to generate
+ * a default name for the child
+ *
+ */
+ char buff[40];
+
+ parentName = defParentName;
+ if (parentName == NULL) {
+ parent = wPtr->root;
+ } else {
+ if ((parent=Tix_HLFindElement(interp, wPtr, parentName))== NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "parent element \"", parentName,
+ "\" does not exist", (char *) NULL);
+ chPtr = NULL;
+ goto done;
+ }
+ }
+
+ /* Generate a default name for this entry */
+ sprintf(buff, "%d", parent->numCreatedChild);
+ name = buff;
+
+ if (parentName == NULL) {
+ pathName = (char*)tixStrDup(name);
+ allocated = 1;
+ }
+ else {
+ pathName = ckalloc(strlen(parentName)+1+ strlen(name)+1);
+ allocated = 1;
+ sprintf(pathName, "%s%c%s", parentName, sep, name);
+ }
+ }
+ else {
+ /* (2.b) Called by the "add" command.
+ *
+ * Strip the parent's name out of pathName (it's everything up
+ * to the last dot). There are two tricky parts: (a) must
+ * copy the parent's name somewhere else to avoid modifying
+ * the pathName string (for large names, space for the copy
+ * will have to be malloc'ed); (b) must special-case the
+ * situation where the parent is ".".
+ */
+
+ if ((p = strrchr(pathName, (int)sep)) == NULL) {
+ /* This is a toplevel element (no "." in it) */
+ name = pathName;
+ parentName = NULL;
+ }
+ else {
+ name = p+1;
+ numChars = p-pathName;
+ if (numChars > FIXED_SPACE) {
+ parentName = (char *) ckalloc((unsigned)(numChars+1));
+ } else {
+ parentName = fixedSpace;
+ }
+ if (numChars == 0) {
+ if ((pathName[0] == sep) && (pathName[1] == '\0')) {
+ /*
+ * The separator by itself is also a toplevel entry
+ */
+ parentName = 0;
+ } else {
+ parentName[0] = sep;
+ parentName[1] = '\0';
+ }
+ }
+ else {
+ strncpy(parentName, pathName, (size_t) numChars);
+ parentName[numChars] = '\0';
+ }
+ }
+
+ if (parentName == NULL) {
+ parent = wPtr->root;
+ } else {
+ if ((parent = Tix_HLFindElement(interp, wPtr, parentName))==NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "parent element \"", parentName,
+ "\" does not exist", (char *) NULL);
+ chPtr = NULL;
+ goto done;
+ }
+ }
+
+ }
+ if (Tix_HLFindElement(interp, wPtr, pathName) != NULL) {
+ Tcl_AppendResult(interp, "element \"", pathName,
+ "\" already exists", (char *) NULL);
+ chPtr = NULL;
+ goto done;
+ }
+ else {
+ if (afterPtr != NULL && afterPtr->parent != parent) {
+ Tcl_AppendResult(interp, "cannot add entry after \"",
+ afterPtr->pathName, "\"", NULL);
+ chPtr = NULL;
+ goto done;
+ }
+ if (beforePtr != NULL && beforePtr->parent != parent) {
+ Tcl_AppendResult(interp, "cannot add entry before \"",
+ beforePtr->pathName, "\"", NULL);
+ chPtr = NULL;
+ goto done;
+ }
+
+ Tcl_ResetResult(interp);
+ if ((chPtr = AllocElement(wPtr, parent, pathName, name, ditemType))
+ == NULL) {
+ /* Some error, now chPtr == NULL */
+ goto done;
+ }
+ AppendList(wPtr, parent, chPtr, at, afterPtr, beforePtr);
+ Tix_HLMarkElementDirty(wPtr, chPtr);
+ Tix_HLResizeWhenIdle(wPtr);
+ goto done; /* success */
+ }
+
+ done:
+ if (allocated) {
+ ckfree((char*)pathName);
+ }
+ if (parentName && parentName != fixedSpace && parentName !=defParentName) {
+ ckfree((char*)parentName);
+ }
+ return chPtr;
+}
+
+/*--------------------------------------------------------------
+ * ConfigElement --
+ *
+ * This procedure configures the element according to the
+ * options.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Hash table and tree changed if successful
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigElement(wPtr, chPtr, argc, argv, flags, forced)
+ WidgetPtr wPtr;
+ HListElement *chPtr;
+ int argc;
+ char ** argv;
+ int flags;
+ int forced; /* We need a "forced" configure to ensure that
+ * the DItem is initialized properly */
+{
+ int sizeChanged;
+
+ if (Tix_WidgetConfigure2(wPtr->dispData.interp, wPtr->dispData.tkwin,
+ (char*)chPtr, entryConfigSpecs, chPtr->col[0].iPtr, argc, argv, flags,
+ forced, &sizeChanged) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (sizeChanged) {
+ Tix_HLMarkElementDirty(wPtr, chPtr);
+ Tix_HLResizeWhenIdle(wPtr);
+ } else {
+ RedrawWhenIdle(wPtr);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FindElementAtPosition --
+ *
+ * Finds a visible element nearest to a Y position
+ *
+ * Results:
+ * Pointer to the element.
+ *
+ * Side effects:
+ * None
+ *--------------------------------------------------------------
+ */
+static HListElement * FindElementAtPosition(wPtr, y)
+ WidgetPtr wPtr;
+ int y;
+{
+ HListElement * chPtr = wPtr->root;
+ int top = 0;
+
+ y -= wPtr->borderWidth + wPtr->highlightWidth;
+ y += wPtr->topPixel;
+
+ if (wPtr->useHeader) {
+ y -= wPtr->headerHeight;
+ }
+
+ if (y < 0) {
+ /*
+ * Position is above the top of the list, return the first element in
+ * the list of toplevel entries.
+ */
+ if (wPtr->root != NULL) {
+ for (chPtr=wPtr->root->childHead; chPtr!=NULL; chPtr=chPtr->next) {
+ if (!chPtr->hidden) {
+ return chPtr;
+ }
+ }
+ }
+ return NULL;
+ }
+ if (y >= chPtr->allHeight) {
+ /*
+ * Position is past the end of the list, return the last element.
+ */
+ HListElement * vis;
+
+ chPtr=wPtr->root;
+ while (1) {
+ if (chPtr->childTail == NULL) {
+ break;
+ }
+ for (vis = chPtr->childTail; vis && vis->hidden; vis=vis->prev) {
+ ;
+ }
+ if (vis == NULL) {
+ break;
+ } else {
+ chPtr = vis;
+ continue;
+ }
+ }
+ if (chPtr == wPtr->root) {
+ /*
+ * There is either no element, or all elements are not visible
+ */
+ return NULL;
+ } else {
+ return chPtr;
+ }
+ }
+
+ /*
+ * The following is a tail-recursive function flatten out in a while
+ * loop.
+ */
+
+ while (1) {
+ again:
+ for (chPtr=chPtr->childHead; chPtr!=NULL; chPtr=chPtr->next) {
+ if (!chPtr->hidden) {
+ if (top <= y && y < top + chPtr->allHeight) {
+ if (y < top + chPtr->height) {
+ return chPtr;
+ } else {
+ top += chPtr->height;
+ goto again;
+ }
+ } else {
+ top += chPtr->allHeight;
+ }
+ }
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tix_HLFindElement --
+ *
+ * Finds an element according to its pathname.
+ *
+ * Results:
+ * Pointer to the element if found. Otherwise NULL.
+ *
+ * Side effects:
+ * None
+ *--------------------------------------------------------------
+ */
+HListElement * Tix_HLFindElement(interp, wPtr, pathName)
+ Tcl_Interp * interp;
+ WidgetPtr wPtr;
+ char * pathName;
+{
+ Tcl_HashEntry * hashPtr;
+
+ if (pathName) {
+ hashPtr = Tcl_FindHashEntry(&wPtr->childTable, pathName);
+
+ if (hashPtr) {
+ return (HListElement*) Tcl_GetHashValue(hashPtr);
+ } else {
+ Tcl_AppendResult(interp, "Entry \"", pathName,
+ "\" not found", NULL);
+ return NULL;
+ }
+ }
+ else {
+ /* pathName == 0 is the root element */
+ return wPtr->root;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SelectionModifyRange --
+ *
+ * Select or de-select all the elements between from and to
+ * (inclusive), according to the "select" argument.
+ *
+ * select == 1 : select
+ * select == 0 : de-select
+ *
+ * Return value:
+ * Whether the selection was actually changed
+ *--------------------------------------------------------------
+ */
+static int SelectionModifyRange(wPtr, from, to, select)
+ WidgetPtr wPtr;
+ HListElement * from;
+ HListElement * to;
+ int select;
+{
+ int changed = 0;
+
+ if (Tix_HLElementTopOffset(wPtr, from) > Tix_HLElementTopOffset(wPtr, to)){
+ HListElement * tmp;
+ tmp = to;
+ to = from;
+ from = tmp;
+ }
+
+ while (1) {
+ if (!from->hidden && (int)from->selected != select) {
+ if (select) {
+ SelectionAdd(wPtr, from);
+ } else {
+ HL_SelectionClear(wPtr, from);
+ changed = 1;
+ }
+ }
+
+ if (from == to) {
+ /*
+ * Iterated to the end of the region
+ */
+ break;
+ }
+
+ /*
+ * Go to the next list entry
+ */
+ if (from->childHead) {
+ from = from->childHead;
+ }
+ else if (from->next) {
+ from = from->next;
+ }
+ else {
+ /*
+ * go to a different branch
+ */
+ while (from->parent->next == NULL && from != wPtr->root) {
+ from = from->parent;
+ }
+ if (from == wPtr->root) {
+ /*
+ * Iterated over all list entries
+ */
+ break;
+ } else {
+ from = from->parent->next;
+ }
+ }
+ }
+
+ return changed;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tix_HLElementTopOffset --
+ *
+ *--------------------------------------------------------------
+ */
+int Tix_HLElementTopOffset(wPtr, chPtr)
+ WidgetPtr wPtr;
+ HListElement * chPtr;
+{
+ int top;
+ HListElement * ptr;
+
+ if (chPtr == wPtr->root) {
+ return 0;
+ }
+ top = Tix_HLElementTopOffset(wPtr, chPtr->parent);
+ top += chPtr->parent->height;
+
+ for (ptr=chPtr->parent->childHead; ptr!=NULL; ptr=ptr->next) {
+ if (ptr == chPtr) {
+ break;
+ }
+ if (ptr->hidden) {
+ continue;
+ }
+ top += ptr->allHeight;
+ }
+ return top;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tix_HLElementLeftOffset --
+ *
+ *--------------------------------------------------------------
+ */
+int Tix_HLElementLeftOffset(wPtr, chPtr)
+ WidgetPtr wPtr;
+ HListElement * chPtr;
+{
+ int left;
+
+ if (chPtr == wPtr->root || chPtr->parent == wPtr->root) {
+ return 0;
+ }
+
+ left = Tix_HLElementLeftOffset(wPtr, chPtr->parent);
+ left += wPtr->indent;
+
+ return left;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CurSelection --
+ *
+ * returns the current selection in the result of interp;
+ *
+ *--------------------------------------------------------------
+ */
+static int CurSelection(interp, wPtr, chPtr)
+ Tcl_Interp * interp;
+ WidgetPtr wPtr;
+ HListElement * chPtr;
+{
+ HListElement * ptr;
+
+ /* Since this recursion starts with wPtr->root, we determine
+ * whether a node is selected when its *parent* is called. This
+ * will save one level of recursion (otherwise all leave nodes will
+ * be recursed once and will be slow ...
+ */
+ for (ptr=chPtr->childHead; ptr; ptr=ptr->next) {
+ if (ptr->selected && !(ptr->hidden)) {
+ Tcl_AppendElement(interp, ptr->pathName);
+ }
+ if (ptr->childHead) {
+ CurSelection(interp, wPtr, ptr);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tix_HLMarkElementDirty --
+ *
+ * Marks a element "dirty", i.e., its geometry needs to be
+ * recalculated.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The element and all its ancestores are marked dirty
+ *--------------------------------------------------------------
+ */
+void Tix_HLMarkElementDirty(wPtr, chPtr)
+ WidgetPtr wPtr;
+ HListElement *chPtr;
+{
+ HListElement *ptr;
+
+ for (ptr=chPtr; ptr!= NULL && ptr->dirty == 0; ptr=ptr->parent) {
+ ptr->dirty = 1;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeElementGeometry --
+ *
+ * Compute the geometry of this element (if its dirty) and the
+ * geometry of all its dirty child elements
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The element and all its decendants are marked non-dirty
+ *--------------------------------------------------------------
+ */
+
+static void ComputeElementGeometry(wPtr, chPtr, indent)
+ WidgetPtr wPtr;
+ HListElement *chPtr;
+ int indent;
+{
+ HListElement *ptr;
+ int i;
+
+ if (!chPtr->dirty && !wPtr->allDirty) {
+ return;
+ } else {
+ chPtr->dirty = 0;
+ }
+
+ if (chPtr == wPtr->root) {
+ int i;
+ chPtr->height = 0;
+ chPtr->indent = 0;
+ for (i=0; i<wPtr->numColumns; i++) {
+ chPtr->col[i].width = 0;
+ }
+ } else {
+ ComputeOneElementGeometry(wPtr, chPtr, indent);
+ indent += wPtr->indent;
+ }
+
+ chPtr->allHeight = chPtr->height;
+
+ for (ptr=chPtr->childHead; ptr!=NULL; ptr=ptr->next) {
+ if (ptr->hidden) {
+ continue;
+ }
+ if (ptr->dirty || wPtr->allDirty) {
+ ComputeElementGeometry(wPtr, ptr, indent);
+ }
+
+ /* Propagate the child's size to the parent
+ *
+ */
+ for (i=0; i<wPtr->numColumns; i++) {
+ if (chPtr->col[i].width < ptr->col[i].width) {
+ chPtr->col[i].width = ptr->col[i].width;
+ }
+ }
+ chPtr->allHeight += ptr->allHeight;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeOneElementGeometry --
+ *
+ * Compute the geometry of the element itself, not including
+ * its children, according to its current display type.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The chPtr->height fields are updated.
+ *--------------------------------------------------------------
+ */
+static void ComputeOneElementGeometry(wPtr, chPtr, indent)
+ WidgetPtr wPtr;
+ HListElement *chPtr;
+ int indent;
+{
+ int i;
+
+ chPtr->indent = indent;
+ chPtr->height = 0;
+
+ ComputeBranchPosition(wPtr, chPtr);
+
+ for (i=0; i<wPtr->numColumns; i++) {
+ Tix_DItem * iPtr = chPtr->col[i].iPtr;
+ int width = 2*wPtr->selBorderWidth;
+ int height = 2*wPtr->selBorderWidth;
+
+ if (iPtr != NULL) {
+ Tix_DItemCalculateSize(iPtr);
+ /* Tix_DItemWidth() and Tix_DItemHeight() already include padding
+ */
+ width += Tix_DItemWidth (iPtr);
+ height += Tix_DItemHeight(iPtr);
+ }
+ if (chPtr->height < height) {
+ chPtr->height = height;
+ }
+ chPtr->col[i].width = width;
+ }
+ chPtr->col[0].width += indent;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeBranchPosition --
+ *
+ * Compute the position of the branches
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The chPtr->branchX and chPtr->branchY fields are updated.
+ *--------------------------------------------------------------
+ */
+static void ComputeBranchPosition(wPtr, chPtr)
+ WidgetPtr wPtr;
+ HListElement *chPtr;
+{
+ Tix_DItem * iPtr = chPtr->col[0].iPtr;
+ int branchX, branchY;
+ int iconX;
+ int iconY;
+ int diff;
+
+ if (iPtr) {
+ if (Tix_DItemType(iPtr) == TIX_DITEM_IMAGETEXT) {
+ /*
+ * Calculate the bottom-middle position of the bitmap/image branch
+ */
+ if (iPtr->imagetext.image != NULL) {
+ branchX = iPtr->imagetext.imageW / 2;
+ branchY = iPtr->imagetext.imageH;
+ if (Tix_DItemHeight(iPtr) > iPtr->imagetext.imageH) {
+ branchY += (Tix_DItemHeight(iPtr) -
+ iPtr->imagetext.imageH) /2;
+ }
+ }
+ else if (iPtr->imagetext.bitmap != None) {
+ branchX = iPtr->imagetext.bitmapW / 2;
+ branchY = iPtr->imagetext.bitmapH;
+ if (Tix_DItemHeight(iPtr) >iPtr->imagetext.bitmapH) {
+ branchY += (Tix_DItemHeight(iPtr) -
+ iPtr->imagetext.bitmapH) /2;
+ }
+ }
+ else {
+ branchX = wPtr->indent/2;
+ branchY = Tix_DItemHeight(iPtr);
+ }
+ } else {
+ branchX = wPtr->indent/2;
+ branchY = Tix_DItemHeight(iPtr);
+ }
+
+
+ /* X adjustment
+ */
+ iconX = Tix_DItemPadX(iPtr);
+ branchX += Tix_DItemPadX(iPtr);
+
+ /* Y adjustment
+ */
+ iconY = Tix_DItemHeight(iPtr) / 2;
+ diff = chPtr->height - Tix_DItemHeight(iPtr);
+ if (diff > 0) {
+ switch (iPtr->base.stylePtr->anchor) {
+ case TK_ANCHOR_NW: case TK_ANCHOR_N: case TK_ANCHOR_NE:
+ diff = 0;
+ break;
+ case TK_ANCHOR_W: case TK_ANCHOR_CENTER: case TK_ANCHOR_E:
+ diff /= 2;
+ break;
+ default:
+ /* Do nothing */
+ ;
+ }
+ branchY += diff;
+ iconY += diff;
+ }
+ }
+ else {
+ branchX = wPtr->indent/2;
+ branchY = chPtr->height;
+ iconX = 0;
+ iconY = chPtr->height/2;
+ }
+
+ if (wPtr->useIndicator && chPtr->parent == wPtr->root) {
+ branchX += wPtr->indent;
+ }
+
+ chPtr->branchX = branchX - 1;
+ chPtr->branchY = branchY - 1;
+ chPtr->iconX = iconX - 1;
+ chPtr->iconY = iconY - 1;
+
+ if (chPtr->branchX < 0) {
+ chPtr->branchX = 0;
+ }
+ if (chPtr->branchY < 0) {
+ chPtr->branchY = 0;
+ }
+ if (chPtr->iconX < 0) {
+ chPtr->iconX = 0;
+ }
+ if (chPtr->iconY < 0) {
+ chPtr->iconY = 0;
+ }
+
+ chPtr->branchX += wPtr->selBorderWidth;
+ chPtr->branchY += wPtr->selBorderWidth;
+ chPtr->iconX += wPtr->selBorderWidth;
+ chPtr->iconY += wPtr->selBorderWidth;
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * WidgetDisplay --
+ *
+ * Draw the widget to the screen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+WidgetDisplay(clientData)
+ ClientData clientData; /* Info about my widget. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ Drawable buffer;
+ Tk_Window tkwin = wPtr->dispData.tkwin;
+ int elmX, elmY;
+ Tcl_Interp *interp = wPtr->dispData.interp;
+
+ wPtr->redrawing = 0; /* clear the redraw flag */
+ wPtr->serial ++;
+
+ if (wPtr->elmToSee != NULL) {
+ HListElement *chPtr;
+
+ if ((chPtr = Tix_HLFindElement(interp, wPtr,
+ wPtr->elmToSee)) == NULL) {
+ Tcl_ResetResult(interp);
+ } else {
+ Tix_HLSeeElement(wPtr, chPtr, 0);
+ }
+
+ ckfree(wPtr->elmToSee);
+ wPtr->elmToSee = NULL;
+ }
+
+
+ /*
+ * STEP (1)
+ * Calculate the drawing parameters
+ */
+ if (wPtr->wideSelect) {
+ wPtr->selectWidth = Tk_Width(wPtr->dispData.tkwin) -
+ (2*wPtr->borderWidth + 2*wPtr->highlightWidth);
+ if (wPtr->selectWidth < wPtr->totalSize[0]) {
+ wPtr->selectWidth = wPtr->totalSize[0];
+ }
+ }
+
+ /* Used to clip off elements that are too low to see */
+ wPtr->bottomPixel = Tk_Height(wPtr->dispData.tkwin) - 2*wPtr->borderWidth
+ - 2*wPtr->highlightWidth;
+
+ elmX = wPtr->borderWidth + wPtr->highlightWidth - wPtr->leftPixel;
+ elmY = wPtr->borderWidth + wPtr->highlightWidth - wPtr->topPixel;
+
+ if (wPtr->useHeader) {
+ elmY += wPtr->headerHeight;
+ }
+
+ /*
+ * STEP (2)
+ * Draw the list body
+ */
+ buffer = Tix_GetRenderBuffer(wPtr->dispData.display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+
+ /* Fill the background */
+ XFillRectangle(wPtr->dispData.display, buffer, wPtr->backgroundGC,
+ 0, 0, Tk_Width(tkwin), Tk_Height(tkwin));
+
+ DrawElements(wPtr, buffer, wPtr->normalGC, wPtr->root,
+ elmX, elmY,
+ wPtr->borderWidth + wPtr->highlightWidth - wPtr->leftPixel);
+
+ if (wPtr->borderWidth > 0) {
+ /* Draw the border */
+ Tk_Draw3DRectangle(wPtr->dispData.tkwin, buffer, wPtr->border,
+ wPtr->highlightWidth, wPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*wPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*wPtr->highlightWidth, wPtr->borderWidth,
+ wPtr->relief);
+ }
+
+ if (wPtr->highlightWidth > 0) {
+ /* Draw the highlight */
+ GC gc;
+
+ if (wPtr->hasFocus) {
+ gc = wPtr->highlightGC;
+ } else {
+ gc = Tk_3DBorderGC(wPtr->dispData.tkwin, wPtr->border,
+ TK_3D_FLAT_GC);
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, wPtr->highlightWidth, buffer);
+ }
+
+ if (buffer != Tk_WindowId(tkwin)) {
+ /*
+ * Copy the information from the off-screen pixmap onto the screen,
+ * then delete the pixmap.
+ */
+
+ XCopyArea(wPtr->dispData.display, buffer, Tk_WindowId(tkwin),
+ wPtr->normalGC, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), 0, 0);
+ Tk_FreePixmap(wPtr->dispData.display, buffer);
+ }
+
+ /*
+ * STEP (3)
+ * Draw the header
+ */
+ if (wPtr->useHeader) {
+ /* We need to draw the header after the elements, because some
+ * half-scrolled elements may overwrite the space for the header
+ */
+ int hdrX, hdrY, hdrW, hdrH, pad, xOffset;
+ Drawable buffer;
+
+ pad = wPtr->borderWidth + wPtr->highlightWidth;
+ hdrX = pad;
+ hdrY = pad;
+ hdrW = Tk_Width(tkwin) - 2*pad;
+ hdrH = wPtr->headerHeight;
+ xOffset = wPtr->leftPixel;
+
+ Tk_MoveResizeWindow(wPtr->headerWin, hdrX, hdrY, hdrW, hdrH);
+ Tk_MapWindow(wPtr->headerWin);
+
+ buffer = Tix_GetRenderBuffer(wPtr->dispData.display,
+ Tk_WindowId(wPtr->headerWin), hdrW, hdrH,
+ Tk_Depth(wPtr->headerWin));
+
+ XFillRectangle(wPtr->dispData.display, buffer,
+ wPtr->backgroundGC, 0, 0, hdrW, hdrH);
+
+ Tix_HLDrawHeader(wPtr, buffer, wPtr->normalGC,
+ 0, 0, hdrW, hdrH, xOffset);
+
+ if (buffer != Tk_WindowId(wPtr->headerWin)) {
+ XCopyArea(wPtr->dispData.display, buffer,
+ Tk_WindowId(wPtr->headerWin), wPtr->normalGC,
+ 0, 0, hdrW, hdrH, 0, 0);
+
+ Tk_FreePixmap(wPtr->dispData.display, buffer);
+ }
+
+ /* If we map the header window, that may change the size requirement
+ * of the HList
+ * %% Call only when geometry is *really* changed
+ */
+ if (wPtr->sizeCmd) {
+ if (Tcl_GlobalEval(wPtr->dispData.interp, wPtr->sizeCmd)
+ != TCL_OK) {
+ Tcl_AddErrorInfo(wPtr->dispData.interp,
+ "\n (size command executed by tixHList)");
+ Tk_BackgroundError(wPtr->dispData.interp);
+ }
+ }
+ } else {
+ Tk_UnmapWindow(wPtr->headerWin);
+ }
+
+ /* unmap those windows we mapped the last time */
+ Tix_UnmapInvisibleWindowItems(&wPtr->mappedWindows, wPtr->serial);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawElements --
+ *--------------------------------------------------------------
+ */
+static void DrawElements(wPtr, pixmap, gc, chPtr, x, y, xOffset)
+ WidgetPtr wPtr;
+ Pixmap pixmap;
+ GC gc;
+ HListElement * chPtr;
+ int x;
+ int y;
+ int xOffset;
+{
+ HListElement * ptr, * lastVisible;
+ int myIconX = 0, myIconY = 0; /* center of my icon */
+ int childIconX, childIconY; /* center of child's icon */
+ int childY, childX;
+ int oldY;
+ int topBorder;
+
+ if (wPtr->useHeader) {
+ topBorder = wPtr->headerHeight;
+ } else {
+ topBorder = 0;
+ }
+
+ if (chPtr != wPtr->root) {
+ if (wPtr->bottomPixel > y && (y + chPtr->height) >= topBorder) {
+ /* Otherwise element is not see at all */
+ DrawOneElement(wPtr, pixmap, gc, chPtr, x, y, xOffset);
+ }
+ myIconX = x + chPtr->branchX;
+ myIconY = y + chPtr->branchY;
+
+ if (wPtr->useIndicator && chPtr->parent == wPtr->root) {
+ childX = x + 2 * wPtr->indent;
+ } else {
+ childX = x + wPtr->indent;
+ }
+ childY = y + chPtr->height;
+
+ if (myIconX > childX) {
+ /* Can't shift the vertical branch too much to the right */
+ myIconX = childX;
+ }
+ } else {
+ childX = x;
+ childY = y;
+ }
+
+ oldY = childY; /* saved for 2nd iteration */
+
+ /* find the last non-hidden element,
+ * to determine when to draw the vertical line
+ */
+ lastVisible = NULL;
+ for (ptr = chPtr->childTail; ptr!=NULL; ptr=ptr->prev) {
+ if (! ptr->hidden) {
+ lastVisible = ptr;
+ break;
+ }
+ }
+
+ if (lastVisible == NULL) {
+ /* No child is visible */
+ return;
+ }
+
+ /* First iteration : draw the entries and branches */
+ for (ptr = chPtr->childHead; ptr!=NULL; ptr=ptr->next) {
+ if (ptr->hidden) {
+ continue;
+ }
+
+ childIconX = childX + ptr->iconX;
+ childIconY = childY + ptr->iconY;
+
+ if (wPtr->bottomPixel > childY &&
+ (childY + ptr->allHeight) >= topBorder) {
+
+ /* Otherwise all descendants of ptr are not seen at all
+ */
+ DrawElements(wPtr, pixmap, gc, ptr, childX, childY, xOffset);
+
+ if (wPtr->drawBranch && chPtr != wPtr->root) {
+ /* Draw a horizontal branch to the child's image/bitmap */
+ XDrawLine(wPtr->dispData.display, pixmap, gc, myIconX,
+ childIconY, childIconX, childIconY);
+ }
+ }
+
+ if (wPtr->drawBranch && chPtr != wPtr->root) {
+ /*
+ * NB: no branches for toplevel elements
+ */
+ if (ptr == lastVisible) {
+ /* Last element. Must draw a vertical branch, even if element
+ * is not seen
+ */
+ int y0, y1; /* used to clip the vertical lines. Otherwise
+ * will wrap-around 65536 (max coordinate for
+ * X
+ */
+ y0 = myIconY;
+ y1 = childIconY;
+
+ if (y0 < 0) {
+ y0 = 0;
+ }
+ if (y1 > Tk_Height(wPtr->dispData.tkwin)) {
+ y1 = Tk_Height(wPtr->dispData.tkwin);
+ }
+ XDrawLine(wPtr->dispData.display, pixmap, gc, myIconX, y0,
+ myIconX, y1);
+ }
+ }
+ childY += ptr->allHeight;
+ }
+
+ if (!wPtr->useIndicator) {
+ return;
+ } else {
+ childY = oldY;
+ }
+
+ /* Second iteration : draw the indicators */
+ for (ptr = chPtr->childHead; ptr!=NULL; ptr=ptr->next) {
+ int justMapped;
+
+ if (ptr->hidden) {
+ continue;
+ }
+
+ childIconY = childY + ptr->iconY;
+
+ if (wPtr->bottomPixel > childY &&
+ (childY + ptr->allHeight) >= topBorder) {
+ /* Otherwise all descendants of ptr are not seen at all
+ */
+ if (ptr->indicator != NULL) {
+ int indW = Tix_DItemWidth (ptr->indicator);
+ int indH = Tix_DItemHeight(ptr->indicator);
+ int indX;
+ int indY = childIconY;
+
+ if (chPtr == wPtr->root) {
+ indX = wPtr->indent / 2 + wPtr->borderWidth
+ + wPtr->highlightWidth - wPtr->leftPixel;
+ } else {
+ indX = myIconX;
+ }
+
+ indX -= indW/2;
+ indY -= indH/2;
+
+ justMapped = 0;
+ if (Tix_DItemType(ptr->indicator) == TIX_DITEM_WINDOW) {
+ Tix_SetWindowItemSerial(&wPtr->mappedWindows,
+ ptr->indicator, wPtr->serial);
+ if (!Tk_IsMapped(ptr->indicator->window.tkwin)) {
+ justMapped = 1;
+ }
+ }
+
+ /* Put down the indicator */
+ Tix_DItemDisplay(pixmap, gc, ptr->indicator,
+ indX, indY, indW, indH,
+ TIX_DITEM_NORMAL_FG|TIX_DITEM_NORMAL_BG);
+
+ if (justMapped) {
+ XLowerWindow(Tk_Display(ptr->indicator->window.tkwin),
+ Tk_WindowId(ptr->indicator->window.tkwin));
+ }
+ }
+ }
+ childY += ptr->allHeight;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawOneElement --
+ *--------------------------------------------------------------
+ */
+static void DrawOneElement(wPtr, pixmap, gc, chPtr, x, y, xOffset)
+ WidgetPtr wPtr;
+ Pixmap pixmap;
+ GC gc;
+ HListElement * chPtr;
+ int x;
+ int y;
+ int xOffset;
+{
+ int i;
+ int flags = TIX_DITEM_NORMAL_FG, bgFlags = 0;
+ int selectWidth, selectX;
+
+ x = xOffset + chPtr->indent;
+
+ if (wPtr->wideSelect) {
+ selectWidth = wPtr->selectWidth;
+ selectX = xOffset;
+ } else {
+ selectWidth = Tix_DItemWidth(chPtr->col[0].iPtr)
+ + 2*wPtr->selBorderWidth;
+ selectX = x;
+ }
+
+ if (chPtr->selected) {
+ /*
+ * When the ditem is selected, we have already drawn the
+ * selection background ourself, so we don't want
+ * DitemDisplay() to draw any background for us. So in this
+ * case both TIX_DITEM_NORMAL_BG and TIX_DITEM_SELECTED_BG are
+ * *not* set
+ */
+ Tk_Fill3DRectangle(wPtr->dispData.tkwin, pixmap, wPtr->selectBorder,
+ selectX, y, selectWidth, chPtr->height, wPtr->selBorderWidth,
+ TK_RELIEF_RAISED);
+ gc = wPtr->selectGC;
+ flags |= TIX_DITEM_SELECTED_FG;
+ } else {
+ /*
+ * Set the TIX_DITEM_NORMAL_BG. This will be used unless
+ * ACTIVE_BG and/or DISABLE_BG are set
+ */
+ bgFlags |= TIX_DITEM_NORMAL_BG;
+ }
+
+ if (chPtr == wPtr->anchor) {
+ flags |= TIX_DITEM_ACTIVE_FG;
+
+ if (!chPtr->selected) {
+ /* don't set any background when the item is selected (otherwise
+ * it looks messed up when wideSelect is false
+ */
+ bgFlags |= TIX_DITEM_ACTIVE_BG;
+ }
+ }
+ if (chPtr == wPtr->dropSite) {
+ XDrawRectangle(Tk_Display(wPtr->dispData.tkwin), pixmap,
+ wPtr->dropSiteGC, selectX, y, selectWidth-1, chPtr->height-1);
+ }
+
+ /*
+ * Now Draw the display items in each column
+ *
+ * %% ToDo: clip off the non-visible items
+ */
+ x = xOffset;
+ for (i=0; i<wPtr->numColumns; i++) {
+ int drawX = x;
+ Tix_DItem * iPtr = chPtr->col[i].iPtr;
+ int itemWidth;
+
+ itemWidth = wPtr->actualSize[i].width - 2*wPtr->selBorderWidth;
+
+ /*
+ * Draw the background: this is tricky because we have idented the
+ * first column. If we call Tix_DItemDisplay() with the background
+ * flags set, the first column will look ugly
+ */
+ if (iPtr != NULL) {
+ Tix_DItemDrawBackground(pixmap, gc, iPtr,
+ drawX + wPtr->selBorderWidth, y + wPtr->selBorderWidth,
+ itemWidth,
+ chPtr->height - 2*wPtr->selBorderWidth, bgFlags);
+ }
+
+ if (i == 0) {
+ drawX += chPtr->indent;
+ itemWidth -= chPtr->indent;
+ }
+
+ if (iPtr != NULL) {
+ int justMapped = 0;
+
+ if (Tix_DItemType(iPtr) == TIX_DITEM_WINDOW) {
+ Tix_SetWindowItemSerial(&wPtr->mappedWindows,iPtr,
+ wPtr->serial);
+ if (!Tk_IsMapped(iPtr->window.tkwin)) {
+ justMapped = 1;
+ }
+ }
+
+ Tix_DItemDisplay(pixmap, gc, iPtr,
+ drawX + wPtr->selBorderWidth, y + wPtr->selBorderWidth,
+ itemWidth,
+ chPtr->height - 2*wPtr->selBorderWidth, flags);
+
+ if (justMapped) {
+ /*
+ * We need to lower it so that it doesn't
+ * overlap the header subwindow
+ */
+ XLowerWindow(Tk_Display(iPtr->window.tkwin),
+ Tk_WindowId(iPtr->window.tkwin));
+ }
+ }
+
+ x += wPtr->actualSize[i].width;
+ }
+
+ if (chPtr == wPtr->anchor) {
+ int ancW, ancH;
+ ancW = selectWidth-1;
+ ancH = chPtr->height-1;
+
+ Tix_DrawAnchorLines(Tk_Display(wPtr->dispData.tkwin), pixmap,
+ wPtr->anchorGC, selectX, y, ancW, ancH);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * SelectionAdd --
+ *--------------------------------------------------------------
+ */
+static void SelectionAdd(wPtr, chPtr)
+ WidgetPtr wPtr;
+ HListElement * chPtr;
+{
+ if (chPtr->selected) { /* sanity check */
+ return;
+ }
+
+ chPtr->selected = 1;
+ SelectionNotifyAncestors(wPtr, chPtr->parent);
+}
+
+/*
+ *----------------------------------------------------------------------
+ * HL_SelectionClear --
+ *--------------------------------------------------------------
+ */
+static void HL_SelectionClear(wPtr, chPtr)
+ WidgetPtr wPtr;
+ HListElement * chPtr;
+{
+ if (! chPtr->selected) { /* sanity check */
+ return;
+ }
+
+ chPtr->selected = 0;
+ HL_SelectionClearNotifyAncestors(wPtr, chPtr->parent);
+}
+
+/*
+ *----------------------------------------------------------------------
+ * HL_SelectionClearAll --
+ *--------------------------------------------------------------
+ */
+static void HL_SelectionClearAll(wPtr, chPtr, changed_ret)
+ WidgetPtr wPtr;
+ HListElement * chPtr;
+ int * changed_ret;
+{
+ HListElement * ptr;
+
+ if (chPtr->selected) {
+ *changed_ret = 1;
+ chPtr->selected = 0;
+ }
+
+ if (chPtr->numSelectedChild == 0) {
+ return;
+ } else {
+ chPtr->numSelectedChild = 0;
+
+ for (ptr=chPtr->childHead; ptr; ptr=ptr->next) {
+ HL_SelectionClearAll(wPtr, ptr, changed_ret);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * SelectionNotifyAncestors --
+ *
+ * !!This has nothing to do with SelectionNotify in X!!
+ *
+ * HList keeps a counter in every entry on how many of its
+ * child entries has been selected. This will make the
+ * "selection clear" very efficient. To keep this counter
+ * up-to-date, we must call SelectionNotifyAncestors() or
+ * HL_SelectionClearNotifyAncestors every time the selection
+ * has changed.
+ *--------------------------------------------------------------
+ */
+static void SelectionNotifyAncestors(wPtr, chPtr)
+ WidgetPtr wPtr;
+ HListElement * chPtr;
+{
+ chPtr->numSelectedChild ++;
+
+ if (chPtr->selected || (chPtr->numSelectedChild > 1)) {
+ /* My ancestors already know that I have selections */
+ return;
+ } else {
+ if (chPtr != wPtr->root) {
+ SelectionNotifyAncestors(wPtr, chPtr->parent);
+ }
+ }
+}
+
+static void HL_SelectionClearNotifyAncestors(wPtr, chPtr)
+ WidgetPtr wPtr;
+ HListElement * chPtr;
+{
+ chPtr->numSelectedChild --;
+
+ if (chPtr->selected || (chPtr->numSelectedChild > 0)) {
+ /* I still have selections, don't need to notify parent */
+ return;
+ } else {
+ if (chPtr != wPtr->root) {
+ SelectionNotifyAncestors(wPtr, chPtr->parent);
+ }
+ }
+}
+/*
+ *--------------------------------------------------------------
+ * DeleteOffsprings --
+ *--------------------------------------------------------------
+ */
+static void DeleteOffsprings(wPtr, chPtr)
+ WidgetPtr wPtr;
+ HListElement * chPtr;
+{
+ HListElement * ptr;
+ HListElement * toFree;
+
+ ptr=chPtr->childHead;
+ while (ptr) {
+ DeleteOffsprings(wPtr, ptr);
+ toFree = ptr;
+ ptr=ptr->next;
+ FreeElement(wPtr, toFree);
+ }
+
+ chPtr->childHead = 0;
+ chPtr->childTail = 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ * DeleteSiblings --
+ *--------------------------------------------------------------
+ */
+static void DeleteSiblings(wPtr, chPtr)
+ WidgetPtr wPtr;
+ HListElement * chPtr;
+{
+ HListElement * ptr;
+
+ for (ptr=chPtr->parent->childHead; ptr; ptr=ptr->next) {
+ if (ptr != chPtr) {
+ DeleteNode(wPtr, ptr);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * DeleteNode --
+ *--------------------------------------------------------------
+ */
+static void DeleteNode(wPtr, chPtr)
+ WidgetPtr wPtr;
+ HListElement * chPtr;
+{
+ if (chPtr->parent == NULL) {
+ /*
+ * This is root node : can't delete
+ */
+ return;
+ }
+
+ DeleteOffsprings(wPtr, chPtr);
+
+ /*
+ * Check for deleting parent's first child
+ */
+ if (chPtr == chPtr->parent->childHead) {
+ chPtr->parent->childHead = chPtr->next;
+ }
+ else {
+ chPtr->prev->next = chPtr->next;
+ }
+
+ /*
+ * Check for 'last' child (could be both first AND last)
+ */
+ if (chPtr == chPtr->parent->childTail) {
+ chPtr->parent->childTail = chPtr->prev;
+ }
+ else {
+ chPtr->next->prev = chPtr->prev;
+ }
+
+ FreeElement(wPtr, chPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ * UpdateOneScrollBar --
+ *--------------------------------------------------------------
+ */
+static void UpdateOneScrollBar(wPtr, command, total, window, first)
+ WidgetPtr wPtr;
+ char * command;
+ int total;
+ int window;
+ int first;
+{
+ char string[100];
+ double d_first, d_last;
+
+ GetScrollFractions(total, window, first, &d_first, &d_last);
+
+ sprintf(string, " %g %g", d_first, d_last);
+ if (Tix_GlobalVarEval(wPtr->dispData.interp, command, string,
+ (char *) NULL) != TCL_OK) {
+ Tcl_AddErrorInfo(wPtr->dispData.interp,
+ "\n (scrolling command executed by tixHList)");
+ Tk_BackgroundError(wPtr->dispData.interp);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * UpdateScrollBars
+ *----------------------------------------------------------------------
+ */
+static void UpdateScrollBars(wPtr, sizeChanged)
+ WidgetPtr wPtr;
+ int sizeChanged;
+{
+ int total, window, first;
+
+ CheckScrollBar(wPtr, TIX_X);
+ CheckScrollBar(wPtr, TIX_Y);
+
+ if (wPtr->xScrollCmd) {
+ total = wPtr->totalSize[0];
+ window = Tk_Width(wPtr->dispData.tkwin)
+ - 2*wPtr->borderWidth - 2*wPtr->highlightWidth;
+ first = wPtr->leftPixel;
+
+ UpdateOneScrollBar(wPtr, wPtr->xScrollCmd, total, window, first);
+ }
+
+ if (wPtr->yScrollCmd) {
+ total = wPtr->totalSize[1];
+ window = Tk_Height(wPtr->dispData.tkwin)
+ - 2*wPtr->borderWidth - 2*wPtr->highlightWidth;
+ first = wPtr->topPixel;
+
+ if (wPtr->useHeader) {
+ window -= wPtr->headerHeight;
+ }
+
+ UpdateOneScrollBar(wPtr, wPtr->yScrollCmd, total, window, first);
+ }
+
+ if (wPtr->sizeCmd && sizeChanged) {
+ if (Tcl_GlobalEval(wPtr->dispData.interp, wPtr->sizeCmd) != TCL_OK) {
+ Tcl_AddErrorInfo(wPtr->dispData.interp,
+ "\n (size command executed by tixHList)");
+ Tk_BackgroundError(wPtr->dispData.interp);
+ }
+ }
+}
+
+/*----------------------------------------------------------------------
+ * XScrollByUnits
+ *----------------------------------------------------------------------
+ */
+static int XScrollByUnits(wPtr, count)
+ WidgetPtr wPtr;
+ int count;
+{
+ return wPtr->leftPixel + count*wPtr->scrollUnit[0];
+}
+
+/*----------------------------------------------------------------------
+ * XScrollByPages
+ *----------------------------------------------------------------------
+ */
+static int XScrollByPages(wPtr, count)
+ WidgetPtr wPtr;
+ int count;
+{
+ return wPtr->leftPixel + count*Tk_Width(wPtr->dispData.tkwin);
+}
+
+/*----------------------------------------------------------------------
+ * YScrollByUnits
+ *----------------------------------------------------------------------
+ */
+static int YScrollByUnits(wPtr, count)
+ WidgetPtr wPtr;
+ int count;
+{
+ HListElement * chPtr;
+ int height;
+
+ if ((chPtr = FindElementAtPosition(wPtr, 0))) {
+ height = chPtr->height;
+ } else if (wPtr->root->childHead) {
+ height = wPtr->root->childHead->height;
+ } else {
+ height = 0;
+ }
+
+ return wPtr->topPixel + count*height;
+}
+
+/*----------------------------------------------------------------------
+ * YScrollByPages
+ *----------------------------------------------------------------------
+ */
+static int YScrollByPages(wPtr, count)
+ WidgetPtr wPtr;
+ int count;
+{
+ int window = Tk_Height(wPtr->dispData.tkwin)
+ - 2*wPtr->borderWidth - 2*wPtr->highlightWidth;
+
+ if (wPtr->useHeader) {
+ window -= wPtr->headerHeight;
+ }
+
+ return wPtr->topPixel + count*window;
+}
+
+/*----------------------------------------------------------------------
+ * CheckScrollBar
+ *
+ * Make sures that the seeting of the scrollbars are correct: i.e.
+ * the bottom element will never be scrolled up by too much.
+ *----------------------------------------------------------------------
+ */
+static void CheckScrollBar(wPtr, which)
+ WidgetPtr wPtr;
+ int which;
+{
+ int window;
+ int total;
+ int first;
+
+ if (which == TIX_Y) {
+ window = Tk_Height(wPtr->dispData.tkwin)
+ - 2*wPtr->borderWidth - 2*wPtr->highlightWidth;
+ if (wPtr->useHeader) {
+ window -= wPtr->headerHeight;
+ }
+ total = wPtr->totalSize[1];
+ first = wPtr->topPixel;
+ } else {
+ window = Tk_Width(wPtr->dispData.tkwin)
+ - 2*wPtr->borderWidth - 2*wPtr->highlightWidth;
+ total = wPtr->totalSize[0];
+ first = wPtr->leftPixel;
+ }
+
+ /* Check whether the topPixel is out of bound */
+ if (first < 0) {
+ first = 0;
+ } else {
+ if (window > total) {
+ first = 0;
+ } else if ((first + window) > total) {
+ first = total - window;
+ }
+ }
+
+ if (which == TIX_Y) {
+ wPtr->topPixel = first;
+ } else {
+ wPtr->leftPixel = first;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * GetScrollFractions --
+ *
+ * Compute the fractions of a scroll-able widget.
+ *
+ */
+static void GetScrollFractions(total, window, first, first_ret, last_ret)
+ int total;
+ int window;
+ int first;
+ double * first_ret;
+ double * last_ret;
+{
+ if (total == 0 || total < window) {
+ *first_ret = 0.0;
+ *last_ret = 1.0;
+ } else {
+ *first_ret = (double)(first) / (double)(total);
+ *last_ret = (double)(first+window) / (double)(total);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * Find the element that's immediately below this element.
+ *
+ *----------------------------------------------------------------------
+ */
+static HListElement *
+FindNextEntry(wPtr, chPtr)
+ WidgetPtr wPtr;
+ HListElement * chPtr;
+{
+ if (chPtr->childHead != NULL) {
+ return chPtr->childHead;
+ }
+ if (chPtr->next) {
+ return chPtr->next;
+ }
+
+ /* go to a different branch */
+ while (1) {
+ if (chPtr == wPtr->root) {
+ return (HListElement *)NULL;
+ }
+ chPtr = chPtr->parent;
+ if (chPtr->next) {
+ return chPtr->next;
+ }
+ }
+}
+
+/*----------------------------------------------------------------------
+ * Find the element that's immediately above this element.
+ *
+ *----------------------------------------------------------------------
+ */
+static HListElement *
+FindPrevEntry(wPtr, chPtr)
+ WidgetPtr wPtr;
+ HListElement * chPtr;
+{
+ if (chPtr->prev) {
+ /* Find the bottom of this sub-tree
+ */
+ for (chPtr=chPtr->prev; chPtr->childTail; chPtr = chPtr->childTail)
+ ;
+
+ return chPtr;
+ } else {
+ if (chPtr->parent == wPtr->root) {
+ return 0;
+ } else {
+ return chPtr->parent;
+ }
+ }
+}
+
diff --git a/tix/generic/tixHList.h b/tix/generic/tixHList.h
new file mode 100644
index 00000000000..c0252404c3a
--- /dev/null
+++ b/tix/generic/tixHList.h
@@ -0,0 +1,323 @@
+/*
+ * tixHList.h --
+ *
+ * Defines the data structures and functions used by the tixHList
+ * widget.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#ifndef _TIX_HLIST_H_
+#define _TIX_HLIST_H_
+
+#ifndef _TIX_INT_H_
+#include <tixInt.h>
+#endif
+
+#ifdef BUILD_tix
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+#define HLTYPE_COLUMN 1
+#define HLTYPE_HEADER 2
+#define HLTYPE_ENTRY 3
+
+/* This is used to indetify what object has caused a DItemSizeChange
+ * All data structs for objects that manage DItems must have these two
+ * members as the beginning of the struct.
+ */
+typedef struct HLItemTypeInfo {
+ int type;
+ char * self;
+} HLItemTypeInfo;
+
+typedef struct HListColumn {
+ /* generic type info section */
+ int type;
+ char * self;
+ struct _HListElement * chPtr;
+
+ /* other data */
+ Tix_DItem * iPtr;
+ int width;
+} HListColumn;
+
+typedef struct HListHeader {
+ /* generic type info section */
+ int type;
+ char * self;
+
+ struct HListStruct * wPtr;
+ /* other data */
+ Tix_DItem * iPtr;
+ int width;
+
+ Tk_3DBorder background; /* Used for drawing the 3d border. */
+ int relief; /* Indicates whether window as a whole is
+ * raised, sunken, or flat. */
+ int borderWidth;
+} HListHeader;
+
+/*----------------------------------------------------------------------
+ * A HListElement structure contain the information about each element
+ * inside the HList.
+ *
+ */
+typedef struct _HListElement {
+ /* generic type info section */
+ int type;
+ char * self;
+
+ /* other data */
+ struct HListStruct * wPtr;
+ struct _HListElement * parent;
+ struct _HListElement * prev;
+ struct _HListElement * next;
+ struct _HListElement * childHead;
+ struct _HListElement * childTail;
+
+ int numSelectedChild; /* number of childs that has selection(s) in
+ * them (either this child is selected or some
+ * of its descendants are selected */
+ int numCreatedChild; /* this var gets increment by one each
+ * time a child is created */
+ char * pathName; /* Full pathname of this element */
+ char * name; /* Name of this element */
+ int height; /* Height of this element, including padding
+ * and selBorderWidth;
+ */
+ int allHeight; /* Height of all descendants and self */
+ Tk_Uid state; /* State of Tab's for display purposes:
+ * normal or disabled. */
+ char * data; /* user data field */
+
+ /* bottom-middle position of the bitmap/image branch (offset from
+ * the top-left corner of the item)
+ */
+ int branchX;
+ int branchY;
+
+ /* offset of the left-middle position of the icon */
+ int iconX;
+ int iconY;
+ /*----------------------------------*/
+ /* Things to display in the element */
+ /*----------------------------------*/
+ HListColumn * col; /* the multi-column display items */
+ HListColumn _oneCol; /* If we have only one column, then this
+ * space is used (pointed to by column).
+ * This will save one Malloc */
+ int indent;
+ Tix_DItem * indicator; /* indicator: little triangle on Mac */
+
+ /*----------------------------------*/
+ /* Flags */
+ /*----------------------------------*/
+ Tix_DItemInfo * diTypePtr;
+
+ unsigned int selected : 1;
+ unsigned int hidden : 1;
+ unsigned int dirty : 1; /* If it is dirty then its geometry needs
+ * be recalculated */
+} Tix_HListElement, HListElement;
+
+/*
+ * A data structure of the following type is kept for each
+ * widget managed by this file:
+ */
+typedef struct HListStruct {
+ Tix_DispData dispData;
+ Tcl_Command widgetCmd; /* Token for button's widget command. */
+
+ /*
+ * Information used when displaying widget:
+ */
+ char *command; /* Command prefix to use when invoking
+ * scrolling commands. NULL means don't
+ * invoke commands. Malloc'ed. */
+ int width, height; /* For app programmer to request size */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ /* Border and general drawing */
+ int borderWidth; /* Width of 3-D borders. */
+ int selBorderWidth; /* Width of 3-D borders for selected items */
+ int relief; /* Indicates whether window as a whole is
+ * raised, sunken, or flat. */
+ int indent; /* How much should the children be indented
+ * (to the right)?, in pixels */
+ Tk_3DBorder border; /* Used for drawing the 3d border. */
+ Tk_3DBorder selectBorder; /* Used for selected background. */
+ XColor *normalFg; /* Normal foreground for text. */
+ XColor *normalBg; /* Normal bachground for text. */
+ XColor *selectFg; /* Color for drawing selected text. */
+ TixFont font; /* The default font used in the DItems. */
+ GC backgroundGC; /* GC for drawing background. */
+ GC normalGC; /* GC for drawing text in normal mode. */
+ GC selectGC; /* GC for drawing selected background. */
+ GC anchorGC; /* GC for drawing dotted anchor highlight. */
+ GC dropSiteGC; /* GC for drawing dotted anchor highlight. */
+
+ Cursor cursor; /* Current cursor for window, or None. */
+
+ int topPixel; /* Vertical offset */
+ int leftPixel; /* Horizontal offset */
+ int bottomPixel;
+ int wideSelect; /* BOOL: if 1, use a wide selection: the
+ * selection background color covers the whole
+ * widget. If 0, only the "significant" part
+ * of a list entry is highlighted */
+ int selectWidth; /* Width of the selection: takes effect only
+ * if wideSelect == 1 */
+ /* For highlights */
+ int highlightWidth; /* Width in pixels of highlight to draw
+ * around widget when it has the focus.
+ * <= 0 means don't draw a highlight. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ GC highlightGC; /* For drawing traversal highlight. */
+
+ /* default pad and gap values */
+ int gap, padX, padY;
+ char * separator;
+
+ Tk_Uid selectMode; /* Selection style: single, browse, multiple,
+ * or extended. This value isn't used in C
+ * code, but the Tcl bindings use it. */
+ int drawBranch; /* Whether to draw the "branch" lines from
+ * parent entry to children */
+ Tcl_HashTable childTable; /* Hash table to translate child names
+ * into (HListElement *) */
+ HListElement * root; /* Mother of all elements */
+ HListElement * anchor; /* The current anchor item */
+ HListElement * dragSite; /* The current drag site */
+ HListElement * dropSite; /* The current drop site */
+
+ char *yScrollCmd; /* Command prefix for communicating with
+ * vertical scrollbar. NULL means no command
+ * to issue. Malloc'ed. */
+ char *xScrollCmd; /* Command prefix for communicating with
+ * horizontal scrollbar. NULL means no command
+ * to issue. Malloc'ed. */
+ char *sizeCmd; /* The command to call when the size of
+ * the listbox changes. E.g., when the user
+ * add/deletes elements. Useful for
+ * auto-scrollbar geometry managers */
+ char *browseCmd; /* The command to call when the selection
+ * changes. */
+ char *indicatorCmd; /* The command to call when the user touches
+ * the indicator. */
+ char *dragCmd; /* The command to call when info about a
+ * drag source is needed */
+ char *dropCmd; /* The command to call when action at a drop
+ * side needs to be performed */
+ char *takeFocus; /* Value of -takefocus option; not used in
+ * the C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+
+ Tix_LinkList mappedWindows; /* Those windows that are are mapped by this
+ * widget*/
+ int serial; /* this number is incremented before each time
+ * the widget is redisplayed */
+
+ int numColumns; /* number of columns in the tixHList widget,
+ * cannot be changed after the widget's
+ * creation */
+
+ int totalSize[2];
+
+ HListColumn * reqSize; /* Requested column sizes by the user:
+ take precedence */
+ HListColumn * actualSize; /* Actual column sizes, calculated using
+ * the sizes of the ditems */
+
+ HListHeader ** headers; /* Stores all the headers for a HList widget */
+ int useHeader; /* whether headers should be used */
+ int headerHeight; /* required height of the header */
+
+ Tix_DItemInfo * diTypePtr; /* Default item type */
+ Tix_StyleTemplate stTmpl;
+
+ int useIndicator; /* should indicators be displayed */
+ int scrollUnit[2];
+
+ Tk_Window headerWin; /* subwindow, used to draw the headers */
+ char * elmToSee; /* name of element to "see" the next time
+ * this widget is redrawn */
+ unsigned redrawing : 1;
+ unsigned redrawingFrame : 1;
+ unsigned resizing : 1;
+ unsigned hasFocus : 1;
+ unsigned allDirty : 1;
+ unsigned initialized : 1;
+ unsigned headerDirty : 1;
+ unsigned needToRaise : 1; /* The header subwindow needs to be raised
+ * if we add a new window item into the
+ * HList widget (either in the list or
+ * in the header */
+} HList;
+
+#define TIX_X 0
+#define TIX_Y 1
+#define UNINITIALIZED -1
+
+typedef HList WidgetRecord;
+typedef HList * WidgetPtr;
+
+EXTERN HListColumn * Tix_HLAllocColumn _ANSI_ARGS_((
+ WidgetPtr wPtr, HListElement * chPtr));
+EXTERN void Tix_HLCancelResizeWhenIdle _ANSI_ARGS_((
+ WidgetPtr wPtr));
+EXTERN void Tix_HLComputeGeometry _ANSI_ARGS_((
+ ClientData clientData));
+EXTERN HListElement * Tix_HLFindElement _ANSI_ARGS_((Tcl_Interp *interp,
+ WidgetPtr wPtr, char * pathName));
+EXTERN void Tix_HLFreeMappedWindow _ANSI_ARGS_((WidgetPtr wPtr,
+ HListElement * chPtr));
+EXTERN int Tix_HLElementTopOffset _ANSI_ARGS_((
+ WidgetPtr wPtr, HListElement *chPtr));
+EXTERN int Tix_HLElementLeftOffset _ANSI_ARGS_((
+ WidgetPtr wPtr, HListElement *chPtr));
+EXTERN int Tix_HLItemInfo _ANSI_ARGS_((Tcl_Interp *interp,
+ WidgetPtr wPtr, int argc, char** argv));
+EXTERN int Tix_HLHeader _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+EXTERN int Tix_HLCreateHeaders _ANSI_ARGS_((
+ Tcl_Interp *interp, WidgetPtr wPtr));
+EXTERN void Tix_HLFreeHeaders _ANSI_ARGS_((
+ Tcl_Interp *interp, WidgetPtr wPtr));
+EXTERN void Tix_HLDrawHeader _ANSI_ARGS_((
+ WidgetPtr wPtr, Pixmap pixmap, GC gc,
+ int hdrX, int hdrY, int hdrW, int hdrH,
+ int xOffset));
+EXTERN void Tix_HLComputeHeaderGeometry _ANSI_ARGS_((
+ WidgetPtr wPtr));
+
+EXTERN void Tix_HLMarkElementDirty _ANSI_ARGS_((WidgetPtr wPtr,
+ HListElement *chPtr));
+EXTERN void Tix_HLResizeWhenIdle _ANSI_ARGS_((WidgetPtr wPtr));
+EXTERN void Tix_HLResizeNow _ANSI_ARGS_((WidgetPtr wPtr));
+EXTERN void Tix_HLComputeGeometry _ANSI_ARGS_((
+ ClientData clientData));
+EXTERN void Tix_HLCancelResizeWhenIdle _ANSI_ARGS_((
+ WidgetPtr wPtr));
+
+
+/* in tixHLCol.c */
+EXTERN TIX_DECLARE_SUBCMD(Tix_HLColumn);
+EXTERN TIX_DECLARE_SUBCMD(Tix_HLItem);
+
+/* in tixHLInd.c */
+EXTERN TIX_DECLARE_SUBCMD(Tix_HLIndicator);
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /*_TIX_HLIST_H_ */
+
diff --git a/tix/generic/tixImgCmp.c b/tix/generic/tixImgCmp.c
new file mode 100644
index 00000000000..c87b99ec6c8
--- /dev/null
+++ b/tix/generic/tixImgCmp.c
@@ -0,0 +1,1456 @@
+/*
+ * tkImgCmp.c --
+ *
+ * This procedure implements images of type "compound" for Tix.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixDef.h>
+
+/*
+ * ToDo:
+ * - lineconfig and itemconfig command
+ */
+
+/*
+ * The following data structure represents the master for a bitmap
+ * image:
+ */
+typedef struct CmpMaster {
+ Tk_ImageMaster tkMaster; /* Tk's token for image master. NULL means
+ * the image is being deleted. */
+ Tcl_Interp *interp; /* Interpreter for application that is
+ * using image. */
+ Tcl_Command imageCmd; /* Token for image command (used to delete
+ * it when the image goes away). NULL means
+ * the image command has already been
+ * deleted. */
+ Display * display; /* Display of the the window associated with
+ * this image. We need to keep it
+ * because Tk_Display(CmpMaster.tkwin) may
+ * be invalid. */
+ Tk_Window tkwin; /* default options are taken from this window.
+ * If undefined, will use the main window
+ * of this application */
+ int width, height; /* Dimensions of image. */
+ int padX, padY;
+ struct CmpLine * lineHead;
+ struct CmpLine * lineTail;
+
+ /* Thde default options, etc */
+ int borderWidth; /* Width of 3-D borders. */
+ Tk_3DBorder background; /* Used for drawing background. */
+ int relief; /* Indicates whether window as a whole is
+ * raised, sunken, or flat. */
+
+ TixFont font; /* Information about text font.*/
+ XColor *foreground; /* Color for drawing text and bitmaps */
+ GC gc; /* default GC for drawing text. */
+
+ int showBackground; /* whether the background should be drawn */
+ unsigned int changing; /* is this image going to call Tk_ImageChanged
+ * in an idle event? */
+ unsigned int isDeleted;
+} CmpMaster;
+
+#define TYPE_TEXT 0
+#define TYPE_SPACE 1
+#define TYPE_IMAGE 2
+#define TYPE_BITMAP 3
+#define TYPE_WIDGET 4
+
+typedef struct CmpLine {
+ struct CmpMaster *masterPtr;
+ struct CmpLine * next;
+ struct CmpItem * itemHead;
+ struct CmpItem * itemTail;
+ int padX, padY;
+ Tk_Anchor anchor;
+ int width, height; /* Dimensions of this line. */
+
+} CmpLine;
+
+/* abstract type */
+
+#define COMMON_MEMBERS \
+ struct CmpLine * line; \
+ struct CmpItem * next; \
+ Tk_Anchor anchor; \
+ char type; \
+ int width; \
+ int height; \
+ int padX, padY
+
+typedef struct CmpItem {
+ COMMON_MEMBERS;
+} CmpItem;
+
+typedef struct CmpBitmapItem {
+ COMMON_MEMBERS;
+
+ Pixmap bitmap;
+ XColor *foreground;
+ XColor *background;
+ GC gc; /* GC for drawing the bitmap. */
+} CmpBitmapItem;
+
+typedef struct CmpImageItem {
+ COMMON_MEMBERS;
+
+ Tk_Image image;
+ char * imageString;
+} CmpImageItem;
+
+typedef struct CmpSpaceItem {
+ COMMON_MEMBERS;
+
+} CmpSpaceItem;
+
+typedef struct CmpTextItem {
+ COMMON_MEMBERS;
+
+ char * text;
+ int numChars;
+ Tk_Justify justify; /* Justification to use for multi-line text. */
+ int wrapLength;
+ int underline; /* Index of character to underline. < 0 means
+ * don't underline anything. */
+ XColor *foreground;
+ TixFont font; /* Information about text font, or NULL. */
+ GC gc; /* GC for drawing the bitmap. */
+} CmpTextItem;
+
+typedef union CmpItemPtr {
+ CmpItem * item;
+ CmpBitmapItem * bitmap;
+ CmpImageItem * image;
+ CmpSpaceItem * space;
+ CmpTextItem * text;
+} CmpItemPtr;
+
+/*
+ * The type record for bitmap images:
+ */
+static int ImgCmpCreate _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, int objc, Tcl_Obj *CONST *objv,
+ Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *clientDataPtr));
+static ClientData ImgCmpGet _ANSI_ARGS_((Tk_Window tkwin,
+ ClientData clientData));
+static void ImgCmpDisplay _ANSI_ARGS_((ClientData clientData,
+ Display *display, Drawable drawable,
+ int imageX, int imageY, int width, int height,
+ int drawableX, int drawableY));
+static void ImgCmpFree _ANSI_ARGS_((ClientData clientData,
+ Display *display));
+static void ImgCmpDelete _ANSI_ARGS_((ClientData clientData));
+
+Tk_ImageType tixCompoundImageType = {
+ "compound", /* name */
+ ImgCmpCreate, /* createProc */
+ ImgCmpGet, /* getProc */
+ ImgCmpDisplay, /* displayProc */
+ ImgCmpFree, /* freeProc */
+ ImgCmpDelete, /* deleteProc */
+ (Tk_ImageType *) NULL /* nextPtr */
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_CMPIMAGE_BG_COLOR, Tk_Offset(CmpMaster, background),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_CMPIMAGE_BG_MONO, Tk_Offset(CmpMaster, background),
+ 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", (char *) NULL,
+ "0", Tk_Offset(CmpMaster, borderWidth), 0},
+
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+
+ {TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_CMPIMAGE_FONT, Tk_Offset(CmpMaster, font), 0},
+
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_CMPIMAGE_FG_COLOR, Tk_Offset(CmpMaster, foreground),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_CMPIMAGE_FG_MONO, Tk_Offset(CmpMaster, foreground),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_PIXELS, "-padx", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(CmpMaster, padX), 0},
+
+ {TK_CONFIG_PIXELS, "-pady", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(CmpMaster, padY), 0},
+
+ {TK_CONFIG_RELIEF, "-relief", (char *) NULL, (char *) NULL,
+ "flat", Tk_Offset(CmpMaster, relief), 0},
+
+ {TK_CONFIG_BOOLEAN, "-showbackground", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(CmpMaster, showBackground), 0},
+
+ {TK_CONFIG_WINDOW, "-window", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(CmpMaster, tkwin), TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+static Tk_ConfigSpec lineConfigSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
+ "c", Tk_Offset(CmpLine, anchor), 0},
+ {TK_CONFIG_PIXELS, "-padx", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(CmpLine, padX), 0},
+ {TK_CONFIG_PIXELS, "-pady", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(CmpLine, padY), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+static Tk_ConfigSpec bitmapConfigSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
+ "c", Tk_Offset(CmpBitmapItem, anchor), 0},
+
+ {TK_CONFIG_COLOR, "-background", "background", "Background",
+ "", Tk_Offset(CmpBitmapItem, background),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, 0},
+
+ {TK_CONFIG_BITMAP, "-bitmap", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(CmpBitmapItem, bitmap), TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ "", Tk_Offset(CmpBitmapItem, foreground),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_PIXELS, "-padx", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(CmpBitmapItem, padX), 0},
+
+ {TK_CONFIG_PIXELS, "-pady", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(CmpBitmapItem, padY), 0},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+static Tk_ConfigSpec imageConfigSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
+ "c", Tk_Offset(CmpImageItem, anchor), 0},
+ {TK_CONFIG_STRING, "-image", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(CmpImageItem, imageString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-padx", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(CmpImageItem, padX), 0},
+ {TK_CONFIG_PIXELS, "-pady", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(CmpImageItem, padY), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+static Tk_ConfigSpec spaceConfigSpecs[] = {
+ {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(CmpSpaceItem, height), 0},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(CmpSpaceItem, width), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+static Tk_ConfigSpec textConfigSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
+ "c", Tk_Offset(CmpTextItem, anchor), 0},
+
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+
+ {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(CmpTextItem, font), TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ "", Tk_Offset(CmpTextItem, foreground),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_JUSTIFY, "-justify", (char *) NULL, (char *) NULL,
+ "left", Tk_Offset(CmpTextItem, justify), 0},
+
+ {TK_CONFIG_PIXELS, "-padx", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(CmpTextItem, padX), 0},
+
+ {TK_CONFIG_PIXELS, "-pady", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(CmpTextItem, padY), 0},
+
+ {TK_CONFIG_STRING, "-text", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(CmpTextItem, text), TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_INT, "-underline", (char *) NULL, (char *) NULL,
+ "-1", Tk_Offset(CmpTextItem, underline), 0},
+
+ {TK_CONFIG_PIXELS, "-wraplength", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(CmpTextItem, wrapLength), 0},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures used only locally in this file:
+ */
+
+static int ImgCmpCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void ImgCmpCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int ImgCmpConfigureMaster _ANSI_ARGS_((
+ CmpMaster *masterPtr, int argc, char **argv,
+ int flags));
+CmpBitmapItem * AddNewBitmap _ANSI_ARGS_((CmpMaster *masterPtr,
+ CmpLine *line,
+ int argc, char **argv));
+CmpImageItem * AddNewImage _ANSI_ARGS_((CmpMaster *masterPtr,
+ CmpLine *line,
+ int argc, char **argv));
+CmpSpaceItem * AddNewSpace _ANSI_ARGS_((CmpMaster *masterPtr,
+ CmpLine *line,
+ int argc, char **argv));
+CmpTextItem * AddNewText _ANSI_ARGS_((CmpMaster *masterPtr,
+ CmpLine *line,
+ int argc, char **argv));
+CmpLine* AddNewLine _ANSI_ARGS_((CmpMaster *masterPtr,
+ int argc, char **argv));
+static void CalculateMasterSize _ANSI_ARGS_((
+ ClientData clientData));
+static void ChangeImageWhenIdle _ANSI_ARGS_((
+ CmpMaster *masterPtr));
+static void ImageProc _ANSI_ARGS_((ClientData clientData,
+ int x, int y, int width, int height,
+ int imgWidth, int imgHeight));
+static void FreeLine _ANSI_ARGS_((CmpLine * lPtr));
+static void FreeItem _ANSI_ARGS_((CmpItemPtr p));
+static void CmpEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgCmpCreate --
+ *
+ * This procedure is called by the Tk image code to create "test"
+ * images.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The data structure for a new image is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ImgCmpCreate(interp, name, objc, objv, typePtr, master, clientDataPtr)
+ Tcl_Interp *interp; /* Interpreter for application containing
+ * image. */
+ char *name; /* Name to use for image. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST *objv; /* Arguments for options (doesn't
+ * include image name or type). */
+ Tk_ImageType *typePtr; /* Pointer to our type record (not used). */
+ Tk_ImageMaster master; /* Token for image, to be used by us in
+ * later callbacks. */
+ ClientData *clientDataPtr; /* Store manager's token for image here;
+ * it will be returned in later callbacks. */
+{
+ CmpMaster *masterPtr;
+ char **argv;
+ int i, length;
+
+ argv = (char **) Tcl_Alloc((objc + 1) * sizeof(char *));
+ for (i = 0; i < objc; i++) {
+ argv[i] = Tcl_GetStringFromObj(objv[i], &length);
+ }
+ argv[objc] = NULL;
+
+ masterPtr = (CmpMaster *) ckalloc(sizeof(CmpMaster));
+ masterPtr->tkMaster = master;
+ masterPtr->interp = interp;
+ masterPtr->imageCmd = Tcl_CreateCommand(interp, name, ImgCmpCmd,
+ (ClientData)masterPtr, ImgCmpCmdDeletedProc);
+ masterPtr->tkwin = NULL;
+ masterPtr->display = NULL;
+ masterPtr->width = 0;
+ masterPtr->height = 0;
+ masterPtr->padX = 0;
+ masterPtr->padY = 0;
+ masterPtr->lineHead = NULL;
+ masterPtr->lineTail = NULL;
+ masterPtr->borderWidth = 0;
+ masterPtr->background = NULL;
+ masterPtr->relief = 0;
+ masterPtr->font = NULL;
+ masterPtr->foreground = NULL;
+ masterPtr->gc = None;
+ masterPtr->showBackground = 0;
+ masterPtr->changing = 0;
+ masterPtr->isDeleted = 0;
+
+ if (ImgCmpConfigureMaster(masterPtr, objc, argv, 0) != TCL_OK) {
+ ImgCmpDelete((ClientData) masterPtr);
+ Tcl_Free((char *) argv);
+ return TCL_ERROR;
+ }
+ *clientDataPtr = (ClientData) masterPtr;
+ Tcl_Free((char *) argv);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgCmpConfigureMaster --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ImgCmpConfigureMaster(masterPtr, argc, argv, flags)
+ CmpMaster *masterPtr; /* Pointer to data structure describing
+ * overall bitmap image to (reconfigure). */
+ int argc; /* Number of entries in argv. */
+ char **argv; /* Pairs of configuration options for image. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget,
+ * such as TK_CONFIG_ARGV_ONLY. */
+{
+ XGCValues gcValues;
+ GC newGC;
+ int i;
+
+ if (argc %2) {
+ Tcl_AppendResult(masterPtr->interp, "value missing for option \"",
+ argv[argc-1], "\"", NULL);
+ return TCL_ERROR;
+ }
+ for (i=0; i<argc; i+=2) {
+ size_t length = strlen(argv[i]);
+ if (strncmp(argv[i], "-window", length) == 0) {
+ masterPtr->tkwin = Tk_NameToWindow(masterPtr->interp, argv[i+1],
+ Tk_MainWindow(masterPtr->interp));
+ if (masterPtr->tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ }
+ if (masterPtr->tkwin == NULL) {
+ Tcl_AppendResult(masterPtr->interp,
+ "no value given for -window option.", NULL);
+ return TCL_ERROR;
+ }
+ masterPtr->display = Tk_Display(masterPtr->tkwin);
+
+ if (Tk_ConfigureWidget(masterPtr->interp, masterPtr->tkwin,
+ configSpecs, argc, argv, (char *) masterPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ Tk_CreateEventHandler(masterPtr->tkwin,
+ StructureNotifyMask, CmpEventProc, (ClientData)masterPtr);
+ /*
+ * Get the default GC for text and bitmaps
+ */
+ gcValues.foreground = masterPtr->foreground->pixel;
+ gcValues.background = Tk_3DBorderColor(masterPtr->background)->pixel;
+ gcValues.font = TixFontId(masterPtr->font);
+ gcValues.graphics_exposures = False;
+ newGC = Tk_GetGC(masterPtr->tkwin,
+ GCBackground|GCForeground|GCFont|GCGraphicsExposures,
+ &gcValues);
+ if (masterPtr->gc != None) {
+ Tk_FreeGC(Tk_Display(masterPtr->tkwin), masterPtr->gc);
+ }
+ masterPtr->gc = newGC;
+
+ ChangeImageWhenIdle(masterPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ImgCmpCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to an image 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
+ImgCmpCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about button widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ CmpMaster *masterPtr = (CmpMaster *) 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 == 'a') && (strncmp(argv[1], "add", length) == 0)) {
+ if (argc < 3) {
+ return Tix_ArgcError(interp, argc, argv, 2,
+ "type ?option value? ...");
+ }
+ c = argv[2][0];
+ length = strlen(argv[2]);
+
+ if ((c == 'l') && (strncmp(argv[2], "line", length) == 0)) {
+ CmpLine * newLine;
+
+ newLine = AddNewLine(masterPtr, argc-3, argv+3);
+ if (newLine == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ else {
+ CmpItemPtr p;
+
+ if (masterPtr->lineTail == 0) {
+ if (AddNewLine(masterPtr, 0, 0) == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ if ((c == 'b') && (strncmp(argv[2], "bitmap", length) == 0)) {
+ p.bitmap = AddNewBitmap(masterPtr, masterPtr->lineTail,
+ argc-3, argv+3);
+ if (p.bitmap == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ else if ((c == 'i') && (strncmp(argv[2], "image", length) == 0)) {
+ p.image = AddNewImage(masterPtr, masterPtr->lineTail,
+ argc-3, argv+3);
+ if (p.image == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ else if ((c == 's') && (strncmp(argv[2], "space", length) == 0)) {
+ p.space = AddNewSpace(masterPtr, masterPtr->lineTail,
+ argc-3, argv+3);
+ if (p.space == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ else if ((c == 't') && (strncmp(argv[2], "text", length) == 0)) {
+ p.text = AddNewText(masterPtr, masterPtr->lineTail,
+ argc-3, argv+3);
+ if (p.text == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ else {
+ Tcl_AppendResult(interp, "unknown option \"",
+ argv[2], "\", must be bitmap, image, line, ",
+ "space, text or widget", NULL);
+ return TCL_ERROR;
+ }
+
+ /* append to the end of the line */
+ if (masterPtr->lineTail->itemHead == NULL) {
+ masterPtr->lineTail->itemHead = p.item;
+ masterPtr->lineTail->itemTail = p.item;
+ } else {
+ masterPtr->lineTail->itemTail->next = p.item;
+ masterPtr->lineTail->itemTail = p.item;
+ }
+ }
+ ChangeImageWhenIdle(masterPtr);
+ return TCL_OK;
+ } 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);
+ return TCL_ERROR;
+ }
+ return Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
+ (char *) masterPtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc == 2) {
+ code = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ code = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, argv[2], 0);
+ } else {
+ int i;
+ for (i=2; i<argc-2; i++) {
+ length = strlen(argv[i]);
+ if (strncmp(argv[i], "-window", length) == 0) {
+ Tcl_AppendResult(interp, "The -window option cannot ",
+ "be changed.", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ code = ImgCmpConfigureMaster(masterPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ return code;
+ } else if ((c == 'i') && (strncmp(argv[1], "itemconfigure", length)== 0)) {
+ Tcl_AppendResult(interp, "unimplemented", NULL);
+ return TCL_ERROR;
+ } else if ((c == 'l') && (strncmp(argv[1], "lineconfigure", length)== 0)) {
+ Tcl_AppendResult(interp, "unimplemented", NULL);
+ return TCL_ERROR;
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be cget or configure", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+CmpLine *
+AddNewLine(masterPtr, argc, argv)
+ CmpMaster *masterPtr;
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ CmpLine * lPtr = (CmpLine *)ckalloc(sizeof(CmpLine));
+
+ lPtr->masterPtr = masterPtr;
+ lPtr->next = NULL;
+ lPtr->itemHead = NULL;
+ lPtr->itemTail = NULL;
+ lPtr->padX = 0;
+ lPtr->padY = 0;
+ lPtr->width = 1;
+ lPtr->height = 1;
+
+ lPtr->anchor = TK_ANCHOR_CENTER;
+
+ if (Tk_ConfigureWidget(masterPtr->interp, masterPtr->tkwin,
+ lineConfigSpecs, argc, argv, (char *) lPtr,
+ TK_CONFIG_ARGV_ONLY) != TCL_OK) {
+ FreeLine(lPtr);
+ return NULL;
+ }
+
+ /*
+ * Append to the end of the master's lines
+ */
+ if (masterPtr->lineHead == NULL) {
+ masterPtr->lineHead = masterPtr->lineTail = lPtr;
+ } else {
+ masterPtr->lineTail->next = lPtr;
+ masterPtr->lineTail = lPtr;
+ }
+
+ return lPtr;
+}
+
+/*----------------------------------------------------------------------
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+CmpBitmapItem *
+AddNewBitmap(masterPtr, line, argc, argv)
+ CmpMaster *masterPtr;
+ CmpLine *line;
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ CmpItemPtr p;
+ XGCValues gcValues;
+
+ p.bitmap = (CmpBitmapItem*) ckalloc(sizeof(CmpBitmapItem));
+ p.bitmap->line = line;
+ p.bitmap->next = NULL;
+ p.bitmap->anchor = TK_ANCHOR_CENTER;
+ p.bitmap->type = TYPE_BITMAP;
+ p.bitmap->padX = 0;
+ p.bitmap->padY = 0;
+ p.bitmap->width = 0;
+ p.bitmap->height = 0;
+
+ p.bitmap->bitmap = None;
+ p.bitmap->foreground = NULL;
+ p.bitmap->background = NULL;
+ p.bitmap->gc = None;
+
+ if (Tk_ConfigureWidget(masterPtr->interp, masterPtr->tkwin,
+ bitmapConfigSpecs, argc, argv, (char *) p.bitmap,
+ TK_CONFIG_ARGV_ONLY) != TCL_OK) {
+ goto error;
+ }
+
+ /* Get the GC for the bitmap */
+ if (p.bitmap->background) {
+ gcValues.background = p.bitmap->background->pixel;
+ } else {
+ gcValues.background = Tk_3DBorderColor(masterPtr->background)->pixel;
+ }
+ if (p.bitmap->foreground) {
+ gcValues.foreground = p.bitmap->foreground->pixel;
+ } else {
+ gcValues.foreground = masterPtr->foreground->pixel;
+ }
+ gcValues.graphics_exposures = False;
+ p.bitmap->gc = Tk_GetGC(masterPtr->tkwin,
+ GCBackground|GCForeground|GCGraphicsExposures,
+ &gcValues);
+
+ return p.bitmap;
+
+ error:
+
+ FreeItem(p);
+ return NULL;
+}
+
+/*----------------------------------------------------------------------
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+CmpImageItem *
+AddNewImage(masterPtr, line, argc, argv)
+ CmpMaster *masterPtr;
+ CmpLine *line;
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ CmpItemPtr p;
+
+
+ p.image = (CmpImageItem*) ckalloc(sizeof(CmpImageItem));
+ p.image->line = line;
+ p.image->next = NULL;
+ p.image->anchor = TK_ANCHOR_CENTER;
+ p.image->type = TYPE_IMAGE;
+ p.image->padX = 0;
+ p.image->padY = 0;
+ p.image->width = 0;
+ p.image->height = 0;
+
+ p.image->imageString = NULL;
+ p.image->image = NULL;
+
+ if (Tk_ConfigureWidget(masterPtr->interp, masterPtr->tkwin,
+ imageConfigSpecs, argc, argv, (char *) p.image,
+ TK_CONFIG_ARGV_ONLY) != TCL_OK) {
+ goto error;
+ }
+
+ /* Get the image */
+ if (p.image->imageString != NULL) {
+ p.image->image = Tk_GetImage(masterPtr->interp, masterPtr->tkwin,
+ p.image->imageString, ImageProc, (ClientData)p.image);
+ if (p.image->image == NULL) {
+ goto error;
+ }
+ }
+
+ return p.image;
+
+ error:
+
+ FreeItem(p);
+ return NULL;
+}
+
+/*----------------------------------------------------------------------
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+CmpSpaceItem *
+AddNewSpace(masterPtr, line, argc, argv)
+ CmpMaster *masterPtr;
+ CmpLine *line;
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ CmpItemPtr p;
+
+ p.space = (CmpSpaceItem*) ckalloc(sizeof(CmpSpaceItem));
+ p.space->line = line;
+ p.space->next = NULL;
+ p.space->anchor = TK_ANCHOR_CENTER;
+ p.space->type = TYPE_SPACE;
+ p.space->padX = 0;
+ p.space->padY = 0;
+ p.space->width = 0;
+ p.space->height = 0;
+
+ if (Tk_ConfigureWidget(masterPtr->interp, masterPtr->tkwin,
+ spaceConfigSpecs, argc, argv, (char *)p.space,
+ TK_CONFIG_ARGV_ONLY) != TCL_OK) {
+ goto error;
+ }
+
+ return p.space;
+
+ error:
+
+ FreeItem(p);
+ return NULL;
+}
+
+/*----------------------------------------------------------------------
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+CmpTextItem *
+AddNewText(masterPtr, line, argc, argv)
+ CmpMaster *masterPtr;
+ CmpLine *line;
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ CmpItemPtr p;
+ XGCValues gcValues;
+
+ p.text = (CmpTextItem*) ckalloc(sizeof(CmpTextItem));
+ p.text->line = line;
+ p.text->next = NULL;
+ p.text->anchor = TK_ANCHOR_CENTER;
+ p.text->type = TYPE_TEXT;
+ p.text->padX = 0;
+ p.text->padY = 0;
+ p.text->width = 0;
+ p.text->height = 0;
+
+ p.text->text = NULL;
+ p.text->numChars = 0;
+ p.text->justify = TK_JUSTIFY_CENTER;
+ p.text->underline = -1;
+ p.text->wrapLength = 0;
+
+ p.text->foreground = NULL;
+ p.text->font = NULL;
+ p.text->gc = None;
+
+ if (Tk_ConfigureWidget(masterPtr->interp, masterPtr->tkwin,
+ textConfigSpecs, argc, argv, (char *) p.text,
+ TK_CONFIG_ARGV_ONLY) != TCL_OK) {
+
+ goto error;
+ }
+
+ /* Get the GC for the text */
+ if (p.text->foreground) {
+ gcValues.foreground = p.text->foreground->pixel;
+ } else {
+ gcValues.foreground = masterPtr->foreground->pixel;
+ }
+ if (p.text->font) {
+ gcValues.font = TixFontId(p.text->font);
+ } else {
+ gcValues.font = TixFontId(masterPtr->font);
+ }
+ gcValues.graphics_exposures = False;
+ p.text->gc = Tk_GetGC(masterPtr->tkwin,
+ GCFont|GCForeground|GCGraphicsExposures,
+ &gcValues);
+
+ return p.text;
+
+ error:
+
+ FreeItem(p);
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgCmpGet --
+ *
+ * This procedure is called for each use of a bitmap image in a
+ * widget.
+ *
+ * Results:
+ * The return value is a token for the instance, which is passed
+ * back to us in calls to ImgCmpDisplay and ImgCmpFree.
+ *
+ * Side effects:
+ * A data structure is set up for the instance (or, an existing
+ * instance is re-used for the new one).
+ *
+ *----------------------------------------------------------------------
+ */
+static ClientData
+ImgCmpGet(tkwin, masterData)
+ Tk_Window tkwin; /* Window in which the instance will be
+ * used. */
+ ClientData masterData; /* Pointer to our master structure for the
+ * image. */
+{
+ CmpMaster *masterPtr = (CmpMaster *)masterData;
+
+ if (tkwin == masterPtr->tkwin) {
+ return masterData;
+ }
+
+ Tcl_AppendResult(masterPtr->interp,
+ "Image \"",
+ Tk_NameOfImage(masterPtr->tkMaster),
+ "\" can only be assigned to window \"",
+ Tk_PathName(masterPtr->tkwin), "\"", NULL);
+ Tcl_AddErrorInfo(masterPtr->interp, "\n (while configuring image \"");
+ Tcl_AddErrorInfo(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster));
+ Tcl_AddErrorInfo(masterPtr->interp, "\")");
+ Tk_BackgroundError(masterPtr->interp);
+
+ return NULL;
+}
+
+static void
+CalculateMasterSize(clientData)
+ ClientData clientData;
+{
+ CmpMaster *masterPtr = (CmpMaster *)clientData;
+ CmpLine *lPtr;
+ CmpItemPtr p;
+
+ masterPtr->width = 0;
+ masterPtr->height = 0;
+
+ for (lPtr = masterPtr->lineHead; lPtr; lPtr=lPtr->next) {
+ lPtr->width = 0;
+ lPtr->height = 0;
+ for (p.item = lPtr->itemHead; p.item; p.item=p.item->next) {
+
+ switch (p.item->type) {
+ case TYPE_IMAGE:
+ Tk_SizeOfImage(p.image->image,
+ &p.image->width, &p.image->height);
+ break;
+
+ case TYPE_SPACE:
+ /* Do nothing */
+ break;
+
+ case TYPE_TEXT:
+ {
+ TixFont font;
+
+ if (p.text->text == NULL) {
+ break;
+ }
+
+ if (p.text->font) {
+ font = p.text->font;
+ } else {
+ font = masterPtr->font;
+ }
+
+ p.text->numChars = strlen(p.text->text);
+ TixComputeTextGeometry(font, p.text->text,
+ p.text->numChars,
+ p.text->wrapLength,
+ &p.text->width, &p.text->height);
+ }
+ break;
+
+ case TYPE_BITMAP:
+ Tk_SizeOfBitmap(Tk_Display(masterPtr->tkwin),
+ p.bitmap->bitmap, &p.bitmap->width,
+ &p.bitmap->height);
+ break;
+
+ case TYPE_WIDGET:
+
+
+ break;
+ }
+ p.item->width += 2*p.item->padX;
+ p.item->height += 2*p.item->padY;
+
+ lPtr->width += p.item->width;
+ if (lPtr->height < p.item->height) {
+ lPtr->height = p.item->height;
+ }
+ }
+ lPtr->width += 2*lPtr->padX;
+ lPtr->height += 2*lPtr->padY;
+
+ if (masterPtr->width < lPtr->width) {
+ masterPtr->width = lPtr->width;
+ }
+ masterPtr->height += lPtr->height;
+ }
+ masterPtr->width += 2*masterPtr->padX + 2*masterPtr->borderWidth;
+ masterPtr->height += 2*masterPtr->padY + 2*masterPtr->borderWidth;
+
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width,
+ masterPtr->height, masterPtr->width, masterPtr->height);
+ masterPtr->changing = 0;
+}
+
+static void
+ChangeImageWhenIdle(masterPtr)
+ CmpMaster *masterPtr;
+{
+ if (!masterPtr->changing) {
+ masterPtr->changing = 1;
+ Tk_DoWhenIdle(CalculateMasterSize, (ClientData)masterPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgCmpDisplay --
+ *
+ * This procedure is invoked to draw a bitmap image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A portion of the image gets rendered in a pixmap or window.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ImgCmpDisplay(clientData, display, drawable, imageX, imageY, width,
+ height, drawableX, drawableY)
+ ClientData clientData; /* Pointer to CmpInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display on which to draw image. */
+ Drawable drawable; /* Pixmap or window in which to draw image. */
+ int imageX, imageY; /* Upper-left corner of region within image
+ * to draw. */
+ int width, height; /* Dimensions of region within image to draw.*/
+ int drawableX, drawableY; /* Coordinates within drawable that
+ * correspond to imageX and imageY. */
+{
+ CmpMaster * masterPtr = (CmpMaster*)clientData;
+ CmpLine *lPtr;
+ CmpItemPtr p;
+ int dx, dy, extraX;
+
+ if (masterPtr == NULL) {
+ /* attempting to draw into a invalid window (can only be drawn into
+ * the original window set by the -window option */
+ return;
+ }
+
+ if (masterPtr->showBackground) {
+ Tk_Fill3DRectangle(masterPtr->tkwin, drawable,
+ masterPtr->background,
+ drawableX + masterPtr->padX - imageX,
+ drawableY + masterPtr->padY - imageY,
+ masterPtr->width - 2*masterPtr->padX,
+ masterPtr->height - 2*masterPtr->padY,
+ masterPtr->borderWidth, masterPtr->relief);
+ }
+
+ /* ToDo: Set the clipping region according to the imageX,Y, and
+ * width, height */
+ dy = drawableY + masterPtr->padY + masterPtr->borderWidth - imageY;
+
+ for (lPtr = masterPtr->lineHead; lPtr; lPtr=lPtr->next) {
+ dx = drawableX + masterPtr->padX - imageX;
+ dx += lPtr->padX;
+ dy += lPtr->padY;
+
+ extraX = masterPtr->width - 2*masterPtr->padX - lPtr->width;
+ switch (lPtr->anchor) {
+ case TK_ANCHOR_SW: case TK_ANCHOR_W: case TK_ANCHOR_NW:
+ extraX = 0;
+ break;
+ case TK_ANCHOR_N: case TK_ANCHOR_CENTER: case TK_ANCHOR_S:
+ extraX /= 2;
+ break;
+ case TK_ANCHOR_SE: case TK_ANCHOR_E: case TK_ANCHOR_NE:
+ break;
+ }
+ dx += extraX;
+
+ for (p.item = lPtr->itemHead; p.item; p.item=p.item->next) {
+ int extraY;
+ dx += p.item->padX;
+
+ extraY = lPtr->height - 2*lPtr->padY - p.item->height;
+ switch (p.item->anchor) {
+ case TK_ANCHOR_SW: case TK_ANCHOR_S: case TK_ANCHOR_SE:
+ break;
+ case TK_ANCHOR_W: case TK_ANCHOR_CENTER: case TK_ANCHOR_E:
+ extraY /= 2;
+ break;
+ case TK_ANCHOR_NW: case TK_ANCHOR_N: case TK_ANCHOR_NE:
+ extraY = 0;
+ break;
+ }
+
+ switch (p.item->type) {
+ case TYPE_IMAGE:
+ Tk_RedrawImage(p.image->image, 0, 0,
+ p.image->width - 2*p.item->padX,
+ p.image->height - 2*p.item->padY,
+ drawable, dx, dy+extraY);
+ break;
+
+ case TYPE_SPACE:
+ /* Do nothing */
+ break;
+
+ case TYPE_TEXT:
+ {
+ TixFont font;
+
+ if (p.text->text == NULL) {
+ break;
+ }
+
+ if (p.text->font) {
+ font = p.text->font;
+ } else {
+ font = masterPtr->font;
+ }
+
+ TixDisplayText(Tk_Display(masterPtr->tkwin), drawable,
+ font, p.text->text, p.text->numChars,
+ dx, dy+extraY,
+ p.text->width - 2*p.item->padX,
+ p.text->justify,
+ p.text->underline,
+ p.text->gc);
+ }
+ break;
+
+ case TYPE_BITMAP:
+ XCopyPlane(Tk_Display(masterPtr->tkwin), p.bitmap->bitmap,
+ drawable, p.bitmap->gc, 0, 0,
+ p.bitmap->width - 2*p.item->padX,
+ p.bitmap->height - 2*p.item->padY,
+ dx, dy+extraY, 1);
+
+ break;
+
+ case TYPE_WIDGET:
+
+
+ break;
+ }
+ dx += p.item->width - p.item->padX;
+ }
+ dy += lPtr->height - lPtr->padY;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgCmpFree --
+ *
+ * This procedure is called when a widget ceases to use a
+ * particular instance of an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Internal data structures get cleaned up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgCmpFree(clientData, display)
+ ClientData clientData; /* Pointer to CmpInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display containing window that used image.*/
+{
+ /*
+ * Since one compound image can only be used in one window, when that
+ * window is deleted, this image is now useless and should be deleted as
+ * well
+ */
+}
+
+static void FreeLine(lPtr)
+ CmpLine * lPtr;
+{
+ Tk_FreeOptions(lineConfigSpecs, (char *)lPtr,
+ Tk_Display(lPtr->masterPtr->tkwin), 0);
+ ckfree((char *) lPtr);
+}
+
+static void FreeItem(p)
+ CmpItemPtr p;
+{
+ switch (p.item->type) {
+ case TYPE_IMAGE:
+ if (p.image->image) {
+ Tk_FreeImage(p.image->image);
+ }
+ Tk_FreeOptions(imageConfigSpecs, (char *)p.image,
+ Tk_Display(p.item->line->masterPtr->tkwin), 0);
+ break;
+
+ case TYPE_SPACE:
+ Tk_FreeOptions(spaceConfigSpecs, (char *)p.space,
+ Tk_Display(p.item->line->masterPtr->tkwin), 0);
+ break;
+
+ case TYPE_TEXT:
+ if (p.text->gc != None) {
+ Tk_FreeGC(Tk_Display(p.text->line->masterPtr->tkwin),
+ p.text->gc);
+ }
+ Tk_FreeOptions(textConfigSpecs, (char *)p.text,
+ Tk_Display(p.item->line->masterPtr->tkwin), 0);
+ break;
+
+ case TYPE_BITMAP:
+ if (p.bitmap->gc != None) {
+ Tk_FreeGC(Tk_Display(p.bitmap->line->masterPtr->tkwin),
+ p.bitmap->gc);
+ }
+ Tk_FreeOptions(bitmapConfigSpecs, (char *)p.bitmap,
+ Tk_Display(p.item->line->masterPtr->tkwin), 0);
+ break;
+
+ case TYPE_WIDGET:
+ break;
+ }
+ ckfree((char *) p.item);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgCmpDelete --
+ *
+ * This procedure is called by the image code to delete the
+ * master structure for an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with the image get freed.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ImgCmpDelete(masterData)
+ ClientData masterData; /* Pointer to CmpMaster structure for
+ * image. Must not have any more instances. */
+{
+ CmpMaster *masterPtr = (CmpMaster *) masterData;
+ CmpLine * lPtr;
+ CmpItemPtr p;
+
+ if (masterPtr->tkwin == NULL) {
+ goto done;
+ }
+
+ Tk_Preserve((ClientData) masterPtr);
+
+ Tk_DeleteEventHandler(masterPtr->tkwin,
+ StructureNotifyMask, CmpEventProc, (ClientData)masterPtr);
+
+ if (masterPtr->isDeleted) {
+ Tk_Release((ClientData) masterPtr);
+ return;
+ }
+ masterPtr->isDeleted = 1;
+
+ for (lPtr=masterPtr->lineHead; lPtr;) {
+ CmpLine * toDelete = lPtr;
+ lPtr = lPtr->next;
+
+ for (p.item=toDelete->itemHead; p.item;) {
+ CmpItemPtr toDelete;
+
+ toDelete.item = p.item;
+ p.item=p.item->next;
+
+ FreeItem(toDelete);
+ }
+ FreeLine(toDelete);
+ }
+
+ if (masterPtr->changing) {
+ Tk_CancelIdleCall(CalculateMasterSize, (ClientData)masterPtr);
+ }
+ masterPtr->tkMaster = NULL;
+ if (masterPtr->imageCmd != NULL) {
+ char * cmd = Tcl_GetCommandName(masterPtr->interp,masterPtr->imageCmd);
+ masterPtr->imageCmd = NULL;
+ Tcl_DeleteCommand(masterPtr->interp, cmd);
+ }
+ if (masterPtr->gc != None) {
+ Tk_FreeGC(masterPtr->display, masterPtr->gc);
+ }
+
+ Tk_FreeOptions(configSpecs, (char *) masterPtr, masterPtr->display, 0);
+ Tk_Release((ClientData) masterPtr);
+
+ done:
+ ckfree((char *) masterPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgCmpCmdDeletedProc --
+ *
+ * This procedure is invoked when the image command for an image
+ * is deleted. It deletes the image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ImgCmpCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to CmpMaster structure for
+ * image. */
+{
+ CmpMaster *masterPtr = (CmpMaster *) clientData;
+
+ Tk_Preserve((ClientData) masterPtr);
+ if (masterPtr->isDeleted == 1) {
+ Tk_Release((ClientData) masterPtr);
+ return;
+ } else {
+ if (masterPtr->tkMaster != NULL) {
+ if (Tk_MainWindow(masterPtr->interp) != NULL) {
+ Tk_DeleteImage(masterPtr->interp,
+ Tk_NameOfImage(masterPtr->tkMaster));
+ }
+ }
+ Tk_Release((ClientData) masterPtr);
+ }
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageProc --
+ *
+ * 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 HList to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ImageProc(clientData, x, y, width, height, imgWidth, imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ CmpItemPtr p;
+
+ p.image = (CmpImageItem *)clientData;
+
+ ChangeImageWhenIdle(p.item->line->masterPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CmpEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on the window that employs this compound image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CmpEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ CmpMaster *masterPtr = (CmpMaster *)clientData;
+ char * cmd;
+
+ if (eventPtr->type == DestroyNotify) {
+ if (masterPtr->imageCmd != NULL) {
+ cmd = Tcl_GetCommandName(masterPtr->interp,masterPtr->imageCmd);
+ masterPtr->imageCmd = NULL;
+ Tcl_DeleteCommand(masterPtr->interp, cmd);
+ }
+ }
+}
diff --git a/tix/generic/tixImgXpm.c b/tix/generic/tixImgXpm.c
new file mode 100644
index 00000000000..91ee852d1b7
--- /dev/null
+++ b/tix/generic/tixImgXpm.c
@@ -0,0 +1,1267 @@
+/*
+ * tixImgXpm.c --
+ *
+ * This file implements images of type "pixmap" for Tix.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixImgXpm.h>
+
+/*
+ * Prototypes for procedures used only locally in this file:
+ */
+
+static int ImgXpmCreate _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, int argc, char **argv,
+ Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *clientDataPtr));
+static ClientData ImgXpmGet _ANSI_ARGS_((Tk_Window tkwin,
+ ClientData clientData));
+static void ImgXpmDisplay _ANSI_ARGS_((ClientData clientData,
+ Display *display, Drawable drawable,
+ int imageX, int imageY, int width, int height,
+ int drawableX, int drawableY));
+static void ImgXpmFree _ANSI_ARGS_((ClientData clientData,
+ Display *display));
+static void ImgXpmDelete _ANSI_ARGS_((ClientData clientData));
+static int ImgXpmCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void ImgXpmCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void ImgXpmConfigureInstance _ANSI_ARGS_((
+ PixmapInstance *instancePtr));
+static int ImgXpmConfigureMaster _ANSI_ARGS_((
+ PixmapMaster *masterPtr, int argc, char **argv,
+ int flags));
+static int ImgXpmGetData _ANSI_ARGS_((Tcl_Interp *interp,
+ PixmapMaster *masterPtr));
+static char ** ImgXpmGetDataFromFile _ANSI_ARGS_((Tcl_Interp * interp,
+ char * string, int * numLines_return));
+static char ** ImgXpmGetDataFromId _ANSI_ARGS_((Tcl_Interp * interp,
+ char * id));
+static char ** ImgXpmGetDataFromString _ANSI_ARGS_((Tcl_Interp*interp,
+ char * string, int * numLines_return));
+static void ImgXpmGetPixmapFromData _ANSI_ARGS_((
+ Tcl_Interp * interp,
+ PixmapMaster *masterPtr,
+ PixmapInstance *instancePtr));
+static char * GetType _ANSI_ARGS_((char * colorDefn,
+ int * type_ret));
+static char * GetColor _ANSI_ARGS_((char * colorDefn,
+ char * colorName, int * type_ret));
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_STRING, "-data", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PixmapMaster, dataString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PixmapMaster, fileString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_UID, "-id", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PixmapMaster, id), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+Tk_ImageType tixPixmapImageType = {
+ "pixmap", /* name */
+ ImgXpmCreate, /* createProc */
+ ImgXpmGet, /* getProc */
+ ImgXpmDisplay, /* displayProc */
+ ImgXpmFree, /* freeProc */
+ ImgXpmDelete, /* deleteProc */
+ (Tk_ImageType *) NULL /* nextPtr */
+};
+
+/*
+ * Local data, used only in this file
+ */
+
+static Tcl_HashTable xpmTable;
+static int xpmTableInited = 0;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgXpmCreate --
+ *
+ * This procedure is called by the Tk image code to create "pixmap"
+ * images.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The data structure for a new image is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ImgXpmCreate(interp, name, argc, argv, typePtr, master, clientDataPtr)
+ Tcl_Interp *interp; /* Interpreter for application containing
+ * image. */
+ char *name; /* Name to use for image. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings for options (doesn't
+ * include image name or type). */
+ Tk_ImageType *typePtr; /* Pointer to our type record (not used). */
+ Tk_ImageMaster master; /* Token for image, to be used by us in
+ * later callbacks. */
+ ClientData *clientDataPtr; /* Store manager's token for image here;
+ * it will be returned in later callbacks. */
+{
+ PixmapMaster *masterPtr;
+
+ masterPtr = (PixmapMaster *) ckalloc(sizeof(PixmapMaster));
+ masterPtr->tkMaster = master;
+ masterPtr->interp = interp;
+ masterPtr->imageCmd = Tcl_CreateCommand(interp, name, ImgXpmCmd,
+ (ClientData) masterPtr, ImgXpmCmdDeletedProc);
+
+ masterPtr->fileString = NULL;
+ masterPtr->dataString = NULL;
+ masterPtr->id = NULL;
+ masterPtr->data = NULL;
+ masterPtr->isDataAlloced = 0;
+ masterPtr->instancePtr = NULL;
+
+ if (ImgXpmConfigureMaster(masterPtr, argc, argv, 0) != TCL_OK) {
+ ImgXpmDelete((ClientData) masterPtr);
+ return TCL_ERROR;
+ }
+ *clientDataPtr = (ClientData) masterPtr;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgXpmConfigureMaster --
+ *
+ * This procedure is called when a pixmap 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.
+ *
+ * If any error occurs, the state of *masterPtr is restored to
+ * previous state.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ImgXpmConfigureMaster(masterPtr, argc, argv, flags)
+ PixmapMaster *masterPtr; /* Pointer to data structure describing
+ * overall pixmap image to (reconfigure). */
+ int argc; /* Number of entries in argv. */
+ char **argv; /* Pairs of configuration options for image. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget,
+ * such as TK_CONFIG_ARGV_ONLY. */
+{
+ PixmapInstance *instancePtr;
+ char * oldData, * oldFile;
+ Tk_Uid oldId;
+
+ oldData = masterPtr->dataString;
+ oldFile = masterPtr->fileString;
+ oldId = masterPtr->id;
+
+ if (Tk_ConfigureWidget(masterPtr->interp, Tk_MainWindow(masterPtr->interp),
+ configSpecs, argc, argv, (char *) masterPtr, flags)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (masterPtr->id != NULL ||
+ masterPtr->dataString != NULL ||
+ masterPtr->fileString != NULL) {
+ if (ImgXpmGetData(masterPtr->interp, masterPtr) != TCL_OK) {
+ goto error;
+ }
+ } else {
+ Tcl_AppendResult(masterPtr->interp,
+ "must specify one of -data, -file or -id", NULL);
+ goto error;
+ }
+
+ /*
+ * Cycle through all of the instances of this image, regenerating
+ * the information for each instance. Then force the image to be
+ * redisplayed everywhere that it is used.
+ */
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ ImgXpmConfigureInstance(instancePtr);
+ }
+
+ if (masterPtr->data) {
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0,
+ masterPtr->size[0], masterPtr->size[1],
+ masterPtr->size[0], masterPtr->size[1]);
+ } else {
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0, 0, 0);
+ }
+
+ return TCL_OK;
+
+ error:
+ /* Restore it to the original (possible valid) mode */
+ if (masterPtr->dataString && masterPtr->dataString != oldData) {
+ ckfree(masterPtr->dataString);
+ }
+ if (masterPtr->fileString && masterPtr->fileString != oldFile) {
+ ckfree(masterPtr->fileString);
+ }
+ masterPtr->dataString = oldData;
+ masterPtr->fileString = oldFile;
+ masterPtr->id = oldId;
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgXpmGetData --
+ *
+ * Given a file name or ASCII string, this procedure parses the
+ * file or string contents to produce binary data for a pixmap.
+ *
+ * Results:
+ * If the pixmap description was parsed successfully then the data
+ * is read into an array of strings. This array will later be used
+ * to create X Pixmaps for each instance.
+ *
+ * Side effects:
+ * The masterPtr->data array is allocated when successful. Contents of
+ * *masterPtr is changed only when successful.
+ *----------------------------------------------------------------------
+ */
+static int
+ImgXpmGetData(interp, masterPtr)
+ Tcl_Interp *interp; /* For reporting errors. */
+ PixmapMaster *masterPtr;
+{
+ char ** data = NULL;
+ int isAllocated; /* do we need to free "data"? */
+ int listArgc;
+ char ** listArgv = NULL;
+ int numLines;
+ int size[2];
+ int cpp;
+ int ncolors;
+ int code = TCL_OK;
+
+ if (masterPtr->id != NULL) {
+ data = ImgXpmGetDataFromId(interp, masterPtr->id);
+ isAllocated = 0;
+ }
+ else if (masterPtr->fileString != NULL) {
+ data = ImgXpmGetDataFromFile(interp, masterPtr->fileString, &numLines);
+ isAllocated = 1;
+ }
+ else if (masterPtr->dataString != NULL) {
+ data = ImgXpmGetDataFromString(interp,masterPtr->dataString,&numLines);
+ isAllocated = 1;
+ }
+ else {
+ /* Should have been enforced by ImgXpmConfigureMaster() */
+ panic("ImgXpmGetData(): -data, -file and -id are all NULL");
+ }
+
+ if (data == NULL) {
+ /* nothing has been allocated yet. Don't need to goto done */
+ return TCL_ERROR;
+ }
+
+ /* Parse the first line of the data and get info about this pixmap */
+ if (Tcl_SplitList(interp, data[0], &listArgc, &listArgv) != TCL_OK) {
+ code = TCL_ERROR; goto done;
+ }
+
+ if (listArgc < 4) { /* file format error */
+ code = TCL_ERROR; goto done;
+ }
+
+ if (Tcl_GetInt(interp, listArgv[0], &size[0]) != TCL_OK) {
+ code = TCL_ERROR; goto done;
+ }
+ if (Tcl_GetInt(interp, listArgv[1], &size[1]) != TCL_OK) {
+ code = TCL_ERROR; goto done;
+ }
+ if (Tcl_GetInt(interp, listArgv[2], &ncolors) != TCL_OK) {
+ code = TCL_ERROR; goto done;
+ }
+ if (Tcl_GetInt(interp, listArgv[3], &cpp) != TCL_OK) {
+ code = TCL_ERROR; goto done;
+ }
+
+ if (isAllocated) {
+ if (numLines != size[1] + ncolors + 1) {
+ /* the number of lines read from the file/data
+ * is not the same as specified in the data
+ */
+ code = TCL_ERROR; goto done;
+ }
+ }
+
+ done:
+ if (code == TCL_OK) {
+ if (masterPtr->isDataAlloced && masterPtr->data) {
+ ckfree((char*)masterPtr->data);
+ }
+ masterPtr->isDataAlloced = isAllocated;
+ masterPtr->data = data;
+ masterPtr->size[0] = size[0];
+ masterPtr->size[1] = size[1];
+ masterPtr->cpp = cpp;
+ masterPtr->ncolors = ncolors;
+ } else {
+ if (isAllocated && data) {
+ ckfree((char*)data);
+ }
+
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "File format error", NULL);
+ }
+
+ if (listArgv) {
+ ckfree((char*)listArgv);
+ }
+
+ return code;
+}
+
+static char ** ImgXpmGetDataFromId(interp, id)
+ Tcl_Interp * interp;
+ char * id;
+{
+ Tcl_HashEntry * hashPtr;
+
+ if (xpmTableInited == 0) {
+ hashPtr = NULL;
+ } else {
+ hashPtr = Tcl_FindHashEntry(&xpmTable, id);
+ }
+
+ if (hashPtr == NULL) {
+ Tcl_AppendResult(interp, "unknown pixmap ID \"", id,
+ "\"", NULL);
+ return (char**)NULL;
+ } else {
+ return (char**)Tcl_GetHashValue(hashPtr);
+ }
+}
+
+static char ** ImgXpmGetDataFromString(interp, string, numLines_return)
+ Tcl_Interp * interp;
+ char * string;
+ int * numLines_return;
+{
+ int quoted;
+ char * p, * list;
+ int numLines;
+ char ** data;
+
+ /* skip the leading blanks (leading blanks are not defined in the
+ * the XPM definition, but skipping them shouldn't hurt. Also, the ability
+ * to skip the leading blanks is good for using in-line XPM data in TCL
+ * scripts
+ */
+ while (isspace(*string)) {
+ ++ string;
+ }
+
+ /* parse the header */
+ if (strncmp("/* XPM", string, 6) != 0) {
+ goto error;
+ }
+
+ /* strip the comments */
+ for (quoted = 0, p=string; *p;) {
+ if (!quoted) {
+ if (*p == '"') {
+ quoted = 1;
+ ++ p;
+ continue;
+ }
+
+ if (*p == '/' && *(p+1) == '*') {
+ *p++ = ' ';
+ *p++ = ' ';
+ while (1) {
+ if (*p == 0) {
+ break;
+ }
+ if (*p == '*' && *(p+1) == '/') {
+ *p++ = ' ';
+ *p++ = ' ';
+ break;
+ }
+ *p++ = ' ';
+ }
+ continue;
+ }
+ ++ p;
+ } else {
+ if (*p == '"') {
+ quoted = 0;
+ }
+ ++ p;
+ }
+ }
+
+ /* Search for the opening brace */
+ for (p=string; *p;) {
+ if (*p != '{') {
+ ++ p;
+ } else {
+ ++p;
+ break;
+ }
+ }
+
+ /* Change the buffer in to a proper TCL list */
+ quoted = 0;
+ list = p;
+
+ while (*p) {
+ if (!quoted) {
+ if (*p == '"') {
+ quoted = 1;
+ ++ p;
+ continue;
+ }
+
+ if (isspace(*p)) {
+ *p = ' ';
+ }
+ else if (*p == ',') {
+ *p = ' ';
+ }
+ else if (*p == '}') {
+ *p = 0;
+ break;
+ }
+ ++p;
+ }
+ else {
+ if (*p == '"') {
+ quoted = 0;
+ }
+ ++ p;
+ }
+ }
+
+ /* The following code depends on the fact that Tcl_SplitList
+ * strips away double quoates inside a list: ie:
+ * if string == "\"1\" \"2\"" then
+ * list[0] = "1"
+ * list[1] = "2"
+ * and NOT
+ *
+ * list[0] = "\"1\""
+ * list[1] = "\"2\""
+ */
+ if (Tcl_SplitList(interp, list, &numLines, &data) != TCL_OK) {
+ goto error;
+ } else {
+ if (numLines == 0) {
+ /* error: empty data? */
+ if (data != NULL) {
+ ckfree((char*)data);
+ goto error;
+ }
+ }
+ * numLines_return = numLines;
+ return data;
+ }
+
+ error:
+ Tcl_AppendResult(interp, "File format error", NULL);
+ return (char**) NULL;
+}
+
+static char ** ImgXpmGetDataFromFile(interp, fileName, numLines_return)
+ Tcl_Interp * interp;
+ char * fileName;
+ int * numLines_return;
+{
+ int fileId, size;
+ char ** data;
+ struct stat statBuf;
+ char *cmdBuffer = NULL;
+ Tcl_DString buffer; /* initialized by Tcl_TildeSubst */
+
+ fileName = Tcl_TildeSubst(interp, fileName, &buffer);
+ if (fileName == NULL) {
+ goto error;
+ }
+
+ fileId = open(fileName, O_RDONLY, 0);
+ if (fileId < 0) {
+ Tcl_AppendResult(interp, "couldn't read file \"", fileName,
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
+ goto error;
+ }
+ if (fstat(fileId, &statBuf) == -1) {
+ Tcl_AppendResult(interp, "couldn't stat file \"", fileName,
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
+ close(fileId);
+ goto error;
+ }
+ cmdBuffer = (char *) ckalloc((unsigned) statBuf.st_size+1);
+ size = read(fileId, cmdBuffer, (size_t) statBuf.st_size);
+ if (size < 0) {
+ Tcl_AppendResult(interp, "error in reading file \"", fileName,
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
+ close(fileId);
+ goto error;
+ }
+ if (close(fileId) != 0) {
+ Tcl_AppendResult(interp, "error closing file \"", fileName,
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
+ goto error;
+ }
+ cmdBuffer[size] = 0;
+
+ data = ImgXpmGetDataFromString(interp, cmdBuffer, numLines_return);
+ ckfree(cmdBuffer);
+ Tcl_DStringFree(&buffer);
+ return data;
+
+ error:
+ if (cmdBuffer != NULL) {
+ ckfree(cmdBuffer);
+ }
+ Tcl_DStringFree(&buffer);
+ return (char**)NULL;
+}
+
+
+static char *
+GetType(colorDefn, type_ret)
+ char * colorDefn;
+ int * type_ret;
+{
+ char * p = colorDefn;
+
+ /* skip white spaces */
+ while (*p && isspace(*p)) {
+ p ++;
+ }
+
+ /* parse the type */
+ if (p[0] != '\0' && p[0] == 'm' &&
+ p[1] != '\0' && isspace(p[1])) {
+ *type_ret = XPM_MONO;
+ p += 2;
+ }
+ else if (p[0] != '\0' && p[0] == 'g' &&
+ p[1] != '\0' && p[1] == '4' &&
+ p[2] != '\0' && isspace(p[2])) {
+ *type_ret = XPM_GRAY_4;
+ p += 3;
+ }
+ else if (p[0] != '\0' && p[0] == 'g' &&
+ p[1] != '\0' && isspace(p[1])) {
+ *type_ret = XPM_GRAY;
+ p += 2;
+ }
+ else if (p[0] != '\0' && p[0] == 'c' &&
+ p[1] != '\0' && isspace(p[1])) {
+ *type_ret = XPM_COLOR;
+ p += 2;
+ }
+ else if (p[0] != '\0' && p[0] == 's' &&
+ p[1] != '\0' && isspace(p[1])) {
+ *type_ret = XPM_SYMBOLIC;
+ p += 2;
+ }
+ else {
+ *type_ret = XPM_UNKNOWN;
+ return NULL;
+ }
+
+ return p;
+}
+
+/*
+ * colorName is guaranteed to be big enough
+ */
+static char *
+GetColor(colorDefn, colorName, type_ret)
+ char * colorDefn;
+ char * colorName; /* if found, name is copied to this array */
+ int * type_ret;
+{
+ int type;
+ char * p;
+
+ if (!colorDefn) {
+ return NULL;
+ }
+
+ if ((colorDefn = GetType(colorDefn, &type)) == NULL) {
+ /* unknown type */
+ return NULL;
+ }
+ else {
+ *type_ret = type;
+ }
+
+ /* skip white spaces */
+ while (*colorDefn && isspace(*colorDefn)) {
+ colorDefn ++;
+ }
+
+ p = colorName;
+
+ while (1) {
+ int dummy;
+
+ while (*colorDefn && !isspace(*colorDefn)) {
+ *p++ = *colorDefn++;
+ }
+
+ if (!*colorDefn) {
+ break;
+ }
+
+ if (GetType(colorDefn, &dummy) == NULL) {
+ /* the next string should also be considered as a part of a color
+ * name */
+
+ while (*colorDefn && isspace(*colorDefn)) {
+ *p++ = *colorDefn++;
+ }
+ } else {
+ break;
+ }
+ if (!*colorDefn) {
+ break;
+ }
+ }
+
+ /* Mark the end of the colorName */
+ *p = '\0';
+
+ return colorDefn;
+}
+
+/*----------------------------------------------------------------------
+ * ImgXpmGetPixmapFromData --
+ *
+ * Creates a pixmap for an image instance.
+ *----------------------------------------------------------------------
+ */
+static void
+ImgXpmGetPixmapFromData(interp, masterPtr, instancePtr)
+ Tcl_Interp * interp;
+ PixmapMaster *masterPtr;
+ PixmapInstance *instancePtr;
+{
+ XImage * image = NULL, * mask = NULL;
+ int depth, i, j, k, lOffset, isTransp = 0, isMono;
+ ColorStruct * colors;
+
+ depth = Tk_Depth(instancePtr->tkwin);
+
+ switch ((Tk_Visual(instancePtr->tkwin))->class) {
+ case StaticGray:
+ case GrayScale:
+ isMono = 1;
+ break;
+ default:
+ isMono = 0;
+ }
+
+ TixpXpmAllocTmpBuffer(masterPtr, instancePtr, &image, &mask);
+
+ /*
+ * Parse the colors
+ */
+ lOffset = 1;
+ colors = (ColorStruct*)ckalloc(sizeof(ColorStruct)*masterPtr->ncolors);
+
+ /*
+ * Initialize the color structures
+ */
+ for (i=0; i<masterPtr->ncolors; i++) {
+ colors[i].colorPtr = NULL;
+ if (masterPtr->cpp == 1) {
+ colors[i].c = 0;
+ } else {
+ colors[i].cstring = (char*)ckalloc(masterPtr->cpp);
+ colors[i].cstring[0] = 0;
+ }
+ }
+
+ for (i=0; i<masterPtr->ncolors; i++) {
+ char * colorDefn; /* the color definition line */
+ char * colorName; /* temp place to hold the color name
+ * defined for one type of visual */
+ char * useName; /* the color name used for this
+ * color. If there are many names
+ * defined, choose the name that is
+ * "best" for the target visual
+ */
+ int found;
+
+ colorDefn = masterPtr->data[i+lOffset]+masterPtr->cpp;
+ colorName = (char*)ckalloc(strlen(colorDefn));
+ useName = (char*)ckalloc(strlen(colorDefn));
+ found = 0;
+
+ while (colorDefn && *colorDefn) {
+ int type;
+
+ if ((colorDefn=GetColor(colorDefn, colorName, &type)) == NULL) {
+ break;
+ }
+ if (colorName[0] == '\0') {
+ continue;
+ }
+
+ switch (type) {
+ case XPM_MONO:
+ if (isMono && depth == 1) {
+ strcpy(useName, colorName);
+ found = 1; goto gotcolor;
+ }
+ break;
+ case XPM_GRAY_4:
+ if (isMono && depth == 4) {
+ strcpy(useName, colorName);
+ found = 1; goto gotcolor;
+ }
+ break;
+ case XPM_GRAY:
+ if (isMono && depth > 4) {
+ strcpy(useName, colorName);
+ found = 1; goto gotcolor;
+ }
+ break;
+ case XPM_COLOR:
+ if (!isMono) {
+ strcpy(useName, colorName);
+ found = 1; goto gotcolor;
+ }
+ break;
+ }
+ if (type != XPM_SYMBOLIC && type != XPM_UNKNOWN) {
+ if (!found) { /* use this color as default */
+ strcpy(useName, colorName);
+ found = 1;
+ }
+ }
+ }
+
+ gotcolor:
+ if (masterPtr->cpp == 1) {
+ colors[i].c = masterPtr->data[i+lOffset][0];
+ } else {
+ strncpy(colors[i].cstring, masterPtr->data[i+lOffset],
+ (size_t)masterPtr->cpp);
+ }
+
+ if (found) {
+ if (strcasecmp(useName, "none") != 0) {
+ colors[i].colorPtr = Tk_GetColor(interp,
+ instancePtr->tkwin, Tk_GetUid(useName));
+ if (colors[i].colorPtr == NULL) {
+ colors[i].colorPtr = Tk_GetColor(interp,
+ instancePtr->tkwin, Tk_GetUid("black"));
+ }
+ }
+ } else {
+ colors[i].colorPtr = Tk_GetColor(interp,
+ instancePtr->tkwin, Tk_GetUid("black"));
+ }
+
+ ckfree(colorName);
+ ckfree(useName);
+ }
+
+ lOffset += masterPtr->ncolors;
+
+ /*
+ * Parse the main body of the image
+ */
+ for (i=0; i<masterPtr->size[1]; i++) {
+ char * p = masterPtr->data[i+lOffset];
+
+ for (j=0; j<masterPtr->size[0]; j++) {
+ if (masterPtr->cpp == 1) {
+ for (k=0; k<masterPtr->ncolors; k++) {
+ if (*p == colors[k].c) {
+ TixpXpmSetPixel(instancePtr, image, mask, j, i,
+ colors[k].colorPtr, &isTransp);
+ break;
+ }
+ }
+ if (*p) {
+ p++;
+ }
+ } else {
+ for (k=0; k<masterPtr->ncolors; k++) {
+ if (strncmp(p, colors[k].cstring,
+ (size_t)masterPtr->cpp) == 0) {
+ TixpXpmSetPixel(instancePtr, image, mask, j, i,
+ colors[k].colorPtr, &isTransp);
+ break;
+ }
+ }
+ for (k=0; *p && k<masterPtr->cpp; k++) {
+ p++;
+ }
+ }
+ }
+ }
+
+ instancePtr->colors = colors;
+
+ TixpXpmRealizePixmap(masterPtr, instancePtr, image, mask, isTransp);
+ TixpXpmFreeTmpBuffer(masterPtr, instancePtr, image, mask);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgXpmConfigureInstance --
+ *
+ * This procedure is called to create displaying information for
+ * a pixmap image instance based on the configuration information
+ * in the master. It is invoked both when new instances are
+ * created and when the master is reconfigured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates errors via Tk_BackgroundError if there are problems
+ * in setting up the instance.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ImgXpmConfigureInstance(instancePtr)
+ PixmapInstance *instancePtr; /* Instance to reconfigure. */
+{
+ PixmapMaster *masterPtr = instancePtr->masterPtr;
+
+ if (instancePtr->pixmap != None) {
+ Tk_FreePixmap(Tk_Display(instancePtr->tkwin), instancePtr->pixmap);
+ }
+ TixpXpmFreeInstanceData(instancePtr, 0, Tk_Display(instancePtr->tkwin));
+
+ if (instancePtr->colors != NULL) {
+ int i;
+ for (i=0; i<masterPtr->ncolors; i++) {
+ if (instancePtr->colors[i].colorPtr != NULL) {
+ Tk_FreeColor(instancePtr->colors[i].colorPtr);
+ }
+ if (masterPtr->cpp != 1) {
+ ckfree(instancePtr->colors[i].cstring);
+ }
+ }
+ ckfree((char*)instancePtr->colors);
+ }
+
+ if (Tk_WindowId(instancePtr->tkwin) == None) {
+ Tk_MakeWindowExist(instancePtr->tkwin);
+ }
+
+ /*
+ * Assumption: masterPtr->data is always non NULL (enfored by
+ * ImgXpmConfigureMaster()). Also, the data must be in a valid
+ * format (partially enforced by ImgXpmConfigureMaster(), see comments
+ * inside that function).
+ */
+ ImgXpmGetPixmapFromData(masterPtr->interp, masterPtr, instancePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ImgXpmCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to an image 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
+ImgXpmCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about button widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ PixmapMaster *masterPtr = (PixmapMaster *) 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) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
+ (char *) masterPtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc == 2) {
+ code = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ code = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, argv[2], 0);
+ } else {
+ code = ImgXpmConfigureMaster(masterPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ return code;
+ } else if ((c == 'r') && (strncmp(argv[1], "refcount", length) == 0)) {
+ /*
+ * The "refcount" command is for debugging only
+ */
+ PixmapInstance *instancePtr;
+ int count = 0;
+ char buff[30];
+
+ for (instancePtr=masterPtr->instancePtr; instancePtr;
+ instancePtr = instancePtr->nextPtr) {
+ count += instancePtr->refCount;
+ }
+ sprintf(buff, "%d", count);
+ Tcl_SetResult(interp, buff, TCL_VOLATILE);
+ return TCL_OK;
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be cget, configure or refcount", (char *) NULL);
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgXpmGet --
+ *
+ * This procedure is called for each use of a pixmap image in a
+ * widget.
+ *
+ * Results:
+ * The return value is a token for the instance, which is passed
+ * back to us in calls to ImgXpmDisplay and ImgXpmFre.
+ *
+ * Side effects:
+ * A data structure is set up for the instance (or, an existing
+ * instance is re-used for the new one).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+ImgXpmGet(tkwin, masterData)
+ Tk_Window tkwin; /* Window in which the instance will be
+ * used. */
+ ClientData masterData; /* Pointer to our master structure for the
+ * image. */
+{
+ PixmapMaster *masterPtr = (PixmapMaster *) masterData;
+ PixmapInstance *instancePtr;
+
+ /*
+ * See if there is already an instance for this window. If so
+ * then just re-use it.
+ */
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ if (instancePtr->tkwin == tkwin) {
+ instancePtr->refCount++;
+ return (ClientData) instancePtr;
+ }
+ }
+
+ /*
+ * The image isn't already in use in this window. Make a new
+ * instance of the image.
+ */
+ instancePtr = (PixmapInstance *) ckalloc(sizeof(PixmapInstance));
+ instancePtr->refCount = 1;
+ instancePtr->masterPtr = masterPtr;
+ instancePtr->tkwin = tkwin;
+ instancePtr->pixmap = None;
+ instancePtr->nextPtr = masterPtr->instancePtr;
+ instancePtr->colors = NULL;
+ masterPtr->instancePtr = instancePtr;
+
+ TixpInitPixmapInstance(masterPtr, instancePtr);
+ ImgXpmConfigureInstance(instancePtr);
+
+ /*
+ * If this is the first instance, must set the size of the image.
+ */
+ if (instancePtr->nextPtr == NULL) {
+ if (masterPtr->data) {
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0,
+ masterPtr->size[0], masterPtr->size[1],
+ masterPtr->size[0], masterPtr->size[1]);
+ } else {
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0, 0, 0);
+ }
+ }
+
+ return (ClientData) instancePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgXpmDisplay --
+ *
+ * This procedure is invoked to draw a pixmap image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A portion of the image gets rendered in a pixmap or window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgXpmDisplay(clientData, display, drawable, imageX, imageY, width,
+ height, drawableX, drawableY)
+ ClientData clientData; /* Pointer to PixmapInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display on which to draw image. */
+ Drawable drawable; /* Pixmap or window in which to draw image. */
+ int imageX, imageY; /* Upper-left corner of region within image
+ * to draw. */
+ int width, height; /* Dimensions of region within image to draw.*/
+ int drawableX, drawableY; /* Coordinates within drawable that
+ * correspond to imageX and imageY. */
+{
+ TixpXpmDisplay(clientData, display, drawable, imageX, imageY, width,
+ height, drawableX, drawableY);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgXpmFree --
+ *
+ * This procedure is called when a widget ceases to use a
+ * particular instance of an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Internal data structures get cleaned up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgXpmFree(clientData, display)
+ ClientData clientData; /* Pointer to PixmapInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display containing window that used image.*/
+{
+ PixmapInstance *instancePtr = (PixmapInstance *) clientData;
+ PixmapInstance *prevPtr;
+
+ instancePtr->refCount--;
+ if (instancePtr->refCount > 0) {
+ return;
+ }
+
+ /*
+ * There are no more uses of the image within this widget. Free
+ * the instance structure.
+ */
+ if (instancePtr->pixmap != None) {
+ Tk_FreePixmap(display, instancePtr->pixmap);
+ }
+ TixpXpmFreeInstanceData(instancePtr, 1, display);
+
+ if (instancePtr->colors != NULL) {
+ int i;
+ for (i=0; i<instancePtr->masterPtr->ncolors; i++) {
+ if (instancePtr->colors[i].colorPtr != NULL) {
+ Tk_FreeColor(instancePtr->colors[i].colorPtr);
+ }
+ if (instancePtr->masterPtr->cpp != 1) {
+ ckfree(instancePtr->colors[i].cstring);
+ }
+ }
+ ckfree((char*)instancePtr->colors);
+ }
+
+ if (instancePtr->masterPtr->instancePtr == instancePtr) {
+ instancePtr->masterPtr->instancePtr = instancePtr->nextPtr;
+ } else {
+ for (prevPtr = instancePtr->masterPtr->instancePtr;
+ prevPtr->nextPtr != instancePtr; prevPtr = prevPtr->nextPtr) {
+ /* Empty loop body */
+ }
+ prevPtr->nextPtr = instancePtr->nextPtr;
+ }
+ ckfree((char *) instancePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgXpmDelete --
+ *
+ * This procedure is called by the image code to delete the
+ * master structure for an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with the image get freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgXpmDelete(masterData)
+ ClientData masterData; /* Pointer to PixmapMaster structure for
+ * image. Must not have any more instances. */
+{
+ PixmapMaster *masterPtr = (PixmapMaster *) masterData;
+
+ if (masterPtr->instancePtr != NULL) {
+ panic("tried to delete pixmap image when instances still exist");
+ }
+ masterPtr->tkMaster = NULL;
+ if (masterPtr->imageCmd != NULL) {
+ Tcl_DeleteCommand(masterPtr->interp,
+ Tcl_GetCommandName(masterPtr->interp, masterPtr->imageCmd));
+ }
+ if (masterPtr->isDataAlloced && masterPtr->data != NULL) {
+ ckfree((char*)masterPtr->data);
+ masterPtr->data = NULL;
+ }
+
+ Tk_FreeOptions(configSpecs, (char *) masterPtr, (Display *) NULL, 0);
+ ckfree((char *) masterPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgXpmCmdDeletedProc --
+ *
+ * This procedure is invoked when the image command for an image
+ * is deleted. It deletes the image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ImgXpmCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to PixmapMaster structure for
+ * image. */
+{
+ PixmapMaster *masterPtr = (PixmapMaster *) clientData;
+
+ masterPtr->imageCmd = NULL;
+ if (masterPtr->tkMaster != NULL) {
+ if (Tk_MainWindow(masterPtr->interp) != NULL) {
+ Tk_DeleteImage(masterPtr->interp,
+ Tk_NameOfImage(masterPtr->tkMaster));
+ }
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tix_DefinePixmap
+ *
+ * Define an XPM data structure with an unique name, so that you can
+ * later refer to this pixmap using the -id switch in [image create
+ * pixmap].
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The data is stored in a HashTable.
+ *----------------------------------------------------------------------
+ */
+int
+Tix_DefinePixmap(interp, name, data)
+ Tcl_Interp * interp;
+ Tk_Uid name; /* Name to use for bitmap. Must not already
+ * be defined as a bitmap. */
+ char **data;
+{
+ int new;
+ Tcl_HashEntry *hshPtr;
+
+ if (!xpmTableInited) {
+ xpmTableInited = 1;
+ Tcl_InitHashTable(&xpmTable, TCL_ONE_WORD_KEYS);
+ }
+
+ hshPtr = Tcl_CreateHashEntry(&xpmTable, name, &new);
+ if (!new) {
+ Tcl_AppendResult(interp, "pixmap \"", name,
+ "\" is already defined", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetHashValue(hshPtr, (char*)data);
+ return TCL_OK;
+}
diff --git a/tix/generic/tixImgXpm.h b/tix/generic/tixImgXpm.h
new file mode 100644
index 00000000000..9a7b59a3bca
--- /dev/null
+++ b/tix/generic/tixImgXpm.h
@@ -0,0 +1,139 @@
+/*
+ * tixImgXpm.h --
+ *
+ * Generic header file for the pixmap image type. This is NOT a public
+ * header file!
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#ifndef _TIX_IMG_XPM_H_
+#define _TIX_IMG_XPM_H_
+
+#ifdef BUILD_tix
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * Constants
+ */
+
+#define XPM_MONO 1
+#define XPM_GRAY_4 2
+#define XPM_GRAY 3
+#define XPM_COLOR 4
+#define XPM_SYMBOLIC 5
+#define XPM_UNKNOWN 6
+
+/*
+ * The following data structure represents the master for a pixmap
+ * image:
+ */
+
+typedef struct PixmapMaster {
+ Tk_ImageMaster tkMaster; /* Tk's token for image master. NULL means
+ * the image is being deleted. */
+ Tcl_Interp *interp; /* Interpreter for application that is
+ * using image. */
+ Tcl_Command imageCmd; /* Token for image command (used to delete
+ * it when the image goes away). NULL means
+ * the image command has already been
+ * deleted. */
+ char *fileString; /* Value of -file option (malloc'ed).
+ * valid only if the -file option is specified
+ */
+ char *dataString; /* Value of -data option (malloc'ed).
+ * valid only if the -data option is specified
+ */
+ /* First in list of all instances associated
+ * with this master. */
+ Tk_Uid id; /* ID's for XPM data already compiled
+ * into the tixwish binary */
+ int size[2]; /* width and height */
+ int ncolors; /* number of colors */
+ int cpp; /* characters per pixel */
+ char ** data; /* The data that defines this pixmap
+ * image (array of strings). It is
+ * converted into an X Pixmap when this
+ * image is instanciated
+ */
+ int isDataAlloced; /* False iff the data is got from
+ * the -id switch */
+ struct PixmapInstance *instancePtr;
+} PixmapMaster;
+
+typedef struct ColorStruct {
+ char c; /* This is used if CPP is one */
+ char * cstring; /* This is used if CPP is bigger than one */
+ XColor * colorPtr;
+} ColorStruct;
+
+/*----------------------------------------------------------------------
+ * PixmapInstance --
+ *
+ * Represents all of the instances of an image that lie within a
+ * particular window:
+ *
+ * %% ToDo
+ * Currently one instance is created for each window that uses
+ * this pixmap. This is usually OK because pixmaps are usually
+ * not shared or only shared by a small number of windows. To
+ * improve resource allocation, we can create an instance for
+ * each (Display x Visual x Depth) combo. This will usually
+ * reduce the number of instances to one.
+ *----------------------------------------------------------------------
+ */
+typedef struct PixmapInstance {
+ int refCount; /* Number of instances that share this
+ * data structure. */
+ PixmapMaster *masterPtr; /* Pointer to master for image. */
+ Tk_Window tkwin; /* Window in which the instances will be
+ * displayed. */
+ Pixmap pixmap; /* The pixmap to display. */
+ struct PixmapInstance *nextPtr;
+ /* Next in list of all instance structures
+ * associated with masterPtr (NULL means
+ * end of list).
+ */
+ ColorStruct * colors;
+ ClientData clientData; /* Place holder for platform specific
+ * instance data */
+} PixmapInstance;
+
+
+EXTERN void TixpInitPixmapInstance _ANSI_ARGS_((
+ PixmapMaster *masterPtr,
+ PixmapInstance *instancePtr));
+EXTERN void TixpXpmAllocTmpBuffer _ANSI_ARGS_((
+ PixmapMaster * masterPtr,
+ PixmapInstance * instancePtr,
+ XImage ** imagePtr, XImage ** maskPtr));
+EXTERN void TixpXpmFreeTmpBuffer _ANSI_ARGS_((
+ PixmapMaster * masterPtr,
+ PixmapInstance * instancePtr,
+ XImage * image, XImage * mask));
+EXTERN void TixpXpmSetPixel _ANSI_ARGS_((
+ PixmapInstance * instancePtr, XImage * image,
+ XImage * mask, int x, int y, XColor * colorPtr,
+ int * isTranspPtr));
+EXTERN void TixpXpmRealizePixmap _ANSI_ARGS_((
+ PixmapMaster * masterPtr,
+ PixmapInstance * instancePtr,
+ XImage * image, XImage * mask, int isTransp));
+EXTERN void TixpXpmFreeInstanceData _ANSI_ARGS_((
+ PixmapInstance *instancePtr, int delete,
+ Display *display));
+EXTERN void TixpXpmDisplay _ANSI_ARGS_((ClientData clientData,
+ Display *display, Drawable drawable,
+ int imageX, int imageY, int width, int height,
+ int drawableX, int drawableY));
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif
diff --git a/tix/generic/tixInit.c b/tix/generic/tixInit.c
new file mode 100644
index 00000000000..1daf98f895f
--- /dev/null
+++ b/tix/generic/tixInit.c
@@ -0,0 +1,615 @@
+/*
+ * tixInit.c --
+ *
+ * Initialze the internals of Tix.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+
+#ifdef ITCL_2
+#include <itcl.h>
+#endif
+
+#ifdef _WINDOWS
+#include <tkWinInt.h>
+#endif
+
+static Tix_TclCmd commands[] = {
+ /*
+ * Commands that are part of the intrinsics:
+ */
+ {"tixCallMethod", Tix_CallMethodCmd},
+ {"tixChainMethod", Tix_ChainMethodCmd},
+ {"tixClass", Tix_ClassCmd},
+ {"tixDisplayStyle", Tix_ItemStyleCmd},
+ {"tixDoWhenIdle", Tix_DoWhenIdleCmd},
+ {"tixDoWhenMapped", Tix_DoWhenMappedCmd},
+ {"tixFalse", Tix_FalseCmd},
+ {"tixFile", Tix_FileCmd},
+ {"tixFlushX", Tix_FlushXCmd},
+ {"tixForm", Tix_FormCmd},
+ {"tixHList", Tix_HListCmd},
+ {"tixItemStyle", Tix_ItemStyleCmd}, /* Old name */
+ {"tixGeometryRequest", Tix_GeometryRequestCmd},
+ {"tixGet3DBorder", Tix_Get3DBorderCmd},
+ {"tixGetBoolean", Tix_GetBooleanCmd},
+ {"tixGetInt", Tix_GetIntCmd},
+ {"tixGetMethod", Tix_GetMethodCmd},
+ {"tixHandleOptions", Tix_HandleOptionsCmd},
+#ifndef _WINDOWS
+ {"tixInputOnly", Tix_InputOnlyCmd},
+#endif
+ {"tixManageGeometry", Tix_ManageGeometryCmd},
+ {"tixMapWindow", Tix_MapWindowCmd},
+ {"tixMoveResizeWindow", Tix_MoveResizeWindowCmd},
+#ifndef _WINDOWS
+ {"tixMwm", Tix_MwmCmd},
+#endif
+ {"tixNoteBookFrame", Tix_NoteBookFrameCmd},
+ {"tixRaiseWindow", Tix_RaiseWindowCmd},
+ {"tixStringSub", Tix_StringSubCmd},
+ {"tixStrEq", Tix_StrEqCmd},
+ {"tixTmpLine", Tix_TmpLineCmd},
+ {"tixTrue", Tix_TrueCmd},
+ {"tixUnmapWindow", Tix_UnmapWindowCmd},
+ {"tixWidgetClass", Tix_ClassCmd},
+ {"tixWidgetDoWhenIdle", Tix_DoWhenIdleCmd},
+
+#ifndef TIX_VERSION_4_0_x
+ {"tixTList", Tix_TListCmd},
+ {"tixGrid", Tix_GridCmd},
+#endif
+
+ {(char *) NULL, (Tix_CmdProc)NULL}
+};
+
+typedef struct {
+ int isBeta;
+ char * binding;
+ int isDebug;
+ char * fontSet;
+ char * tixlibrary;
+ char * scheme;
+ char * schemePriority;
+} OptionStruct;
+
+static OptionStruct tixOption;
+
+/*
+ * TIX_DEF_FONTSET and TIX_DEF_SCHEME should have been defined in the
+ * Makefile by the configure script. We define them here just in case
+ * the configure script failed to determine the proper values.
+ */
+
+#ifndef TIX_DEF_FONTSET
+#ifdef _WINDOWS
+#define TIX_DEF_FONTSET "TkWin"
+#else
+#define TIX_DEF_FONTSET "TK"
+#endif
+#endif
+
+#ifndef TIX_DEF_SCHEME
+#ifdef _WINDOWS
+#define TIX_DEF_SCHEME "TkWin"
+#else
+#define TIX_DEF_SCHEME "TK"
+#endif
+#endif
+
+
+#define DEF_TIX_TOOLKIT_OPTION_BETA "1"
+#define DEF_TIX_TOOLKIT_OPTION_BINDING "Motif"
+#define DEF_TIX_TOOLKIT_OPTION_DEBUG "1"
+#define DEF_TIX_TOOLKIT_OPTION_FONTSET TIX_DEF_FONTSET
+#define DEF_TIX_TOOLKIT_OPTION_LIBRARY ""
+#define DEF_TIX_TOOLKIT_OPTION_SCHEME TIX_DEF_SCHEME
+#define DEF_TIX_TOOLKIT_OPTION_SCHEME_PRIORITY "79"
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BOOLEAN, "-beta", "tixBeta", "TixBeta",
+ DEF_TIX_TOOLKIT_OPTION_BETA, Tk_Offset(OptionStruct, isBeta),
+ 0},
+ {TK_CONFIG_STRING, "-binding", "binding", "TixBinding",
+ DEF_TIX_TOOLKIT_OPTION_BINDING, Tk_Offset(OptionStruct, binding),
+ 0},
+ {TK_CONFIG_BOOLEAN, "-debug", "tixDebug", "TixDebug",
+ DEF_TIX_TOOLKIT_OPTION_DEBUG, Tk_Offset(OptionStruct, isDebug),
+ 0},
+ {TK_CONFIG_STRING, "-fontset", "tixFontSet", "TixFontSet",
+ DEF_TIX_TOOLKIT_OPTION_FONTSET, Tk_Offset(OptionStruct, fontSet),
+ 0},
+ {TK_CONFIG_STRING, "-scheme", "tixScheme", "TixScheme",
+ DEF_TIX_TOOLKIT_OPTION_SCHEME, Tk_Offset(OptionStruct, scheme),
+ 0},
+ {TK_CONFIG_STRING, "-scheme", "tixSchemePriority", "TixSchemePriority",
+ DEF_TIX_TOOLKIT_OPTION_SCHEME_PRIORITY,
+ Tk_Offset(OptionStruct, schemePriority),
+ 0},
+ {TK_CONFIG_STRING, "-tixlibrary", "tixLibrary", "TixLibrary",
+ DEF_TIX_TOOLKIT_OPTION_LIBRARY, Tk_Offset(OptionStruct, tixlibrary),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+#ifndef TIX_LIBRARY
+#ifndef _WINDOWS
+#define TIX_LIBRARY "/usr/local/lib/tix"
+#else
+#define TIX_LIBRARY "../../library"
+#endif
+#endif
+
+/*----------------------------------------------------------------------
+ *
+ * Some global variables
+ *
+ *----------------------------------------------------------------------
+ */
+Tk_Uid tixNormalUid = (Tk_Uid)NULL;
+Tk_Uid tixCellUid = (Tk_Uid)NULL;
+Tk_Uid tixRowUid = (Tk_Uid)NULL;
+Tk_Uid tixColumnUid = (Tk_Uid)NULL;
+Tk_Uid tixDisabledUid = (Tk_Uid)NULL;
+
+/*----------------------------------------------------------------------
+ *
+ * The Display Item types
+ *
+ *----------------------------------------------------------------------
+ */
+
+extern Tix_DItemInfo tix_ImageTextItemType;
+extern Tix_DItemInfo tix_TextItemType;
+extern Tix_DItemInfo tix_WindowItemType;
+extern Tix_DItemInfo tix_ImageItemType;
+
+static int ParseToolkitOptions _ANSI_ARGS_((Tcl_Interp * interp));
+extern int TixMwmProtocolHandler _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static int Tix_Init_Internal _ANSI_ARGS_((Tcl_Interp * interp,
+ int doSource));
+int Tix_EtInit _ANSI_ARGS_((Tcl_Interp * interp));
+
+/*----------------------------------------------------------------------
+ * ParseToolkitOptions() --
+ *
+ * Before the Tix initialized, we need to determine the toolkit
+ * options which are set by the options database.
+ *----------------------------------------------------------------------
+ */
+static int
+ParseToolkitOptions(interp)
+ Tcl_Interp * interp;
+{
+ char buff[10];
+ int flag;
+
+ tixOption.isBeta = 0;
+ tixOption.binding = NULL;
+ tixOption.isDebug = 0;
+ tixOption.fontSet = NULL;
+ tixOption.tixlibrary = NULL;
+ tixOption.scheme = NULL;
+ tixOption.schemePriority = NULL;
+
+ /*
+ * The toolkit options may be set in the resources of the main window
+ */
+ if (Tk_ConfigureWidget(interp, Tk_MainWindow(interp), configSpecs,
+ 0, 0, (char *) &tixOption, 0) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Now lets set the Tix toolkit variables so that the Toolkit can
+ * initialize according to user options.
+ */
+ flag = TCL_GLOBAL_ONLY;
+ sprintf(buff, "%d", tixOption.isBeta);
+ Tcl_SetVar2(interp, "tix_priv", "-beta", buff, flag);
+ sprintf(buff, "%d", tixOption.isDebug);
+ Tcl_SetVar2(interp, "tix_priv", "-debug", buff, flag);
+
+ if (tixOption.tixlibrary == 0 || strlen(tixOption.tixlibrary) == 0) {
+ /*
+ * Set up the TCL variable "tix_library" according to the environment
+ * variable.
+ */
+ if (tixOption.tixlibrary != NULL) {
+ ckfree((char*)tixOption.tixlibrary);
+ }
+
+ tixOption.tixlibrary = (char*)getenv("TIX_LIBRARY");
+ if (tixOption.tixlibrary == NULL) {
+ tixOption.tixlibrary = TIX_LIBRARY;
+ }
+ Tcl_SetVar2(interp, "tix_priv", "-libdir",
+ tixOption.tixlibrary, flag);
+ } else {
+ Tcl_SetVar2(interp, "tix_priv", "-libdir",
+ tixOption.tixlibrary, flag);
+ ckfree((char*)tixOption.tixlibrary);
+ }
+
+ /*
+ * tixOption.tixlibrary may not be allocated by Tk_ConfigureWidget().
+ * We have already freed it (if necessary). We set it to NULL so
+ * that Tk_FreeOptions() won't try to free it.
+ */
+ tixOption.tixlibrary = NULL;
+
+ Tcl_SetVar2(interp, "tix_priv", "-binding",
+ tixOption.binding, flag);
+ Tcl_SetVar2(interp, "tix_priv", "-fontset",
+ tixOption.fontSet, flag);
+ Tcl_SetVar2(interp, "tix_priv", "-scheme",
+ tixOption.scheme, flag);
+ Tcl_SetVar2(interp, "tix_priv", "-schemepriority",
+ tixOption.schemePriority, flag);
+
+ Tk_FreeOptions(configSpecs, (char *)&tixOption,
+ Tk_Display(Tk_MainWindow(interp)), 0);
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_Init_Internal() --
+ *
+ * Initialize the Tix library. The doSource argument specifies
+ * we should source the file Init.tcl from the Tix script library
+ * path. A doSource is not necessary if Tix was included in an ET
+ * applicattion.
+ *----------------------------------------------------------------------
+ */
+
+static int
+Tix_Init_Internal(interp, doSource)
+ Tcl_Interp * interp;
+ int doSource;
+{
+ Tk_Window topLevel;
+ char * appName;
+ static int globalInitialized = 0;
+
+ /*
+ * This procedure may be called several times for several
+ * interpreters. Since some global variables are shared by
+ * all of the interpreters, we initialize these variables only
+ * once. The variable "globalInitialized" keeps track of this
+ */
+
+ extern Tk_ImageType tixPixmapImageType;
+ extern Tk_ImageType tixCompoundImageType;
+
+
+#ifdef TCL_7_5_OR_LATER
+ /*
+ * The new package mechanism, available in Tcl7.5 or later
+ */
+ if (Tcl_PkgRequire(interp, "Tcl", TCL_VERSION, 1) == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tcl_PkgRequire(interp, "Tk", TK_VERSION, 1) == NULL) {
+ return TCL_ERROR;
+ }
+#ifdef ITCL_2
+ if (Tcl_PkgRequire(interp, "Itcl", ITCL_VERSION, 0) == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tcl_PkgRequire(interp, "Itk", ITCL_VERSION, 0) == NULL) {
+ return TCL_ERROR;
+ }
+#endif
+/*
+ * // This is now done in Init.tcl
+ * if (Tcl_PkgProvide(interp, "Tix", TIX_VERSION) != TCL_OK) {
+ * return TCL_ERROR;
+ * }
+ */
+#endif
+
+ topLevel = Tk_MainWindow(interp);
+
+ if (!globalInitialized) {
+ globalInitialized = 1;
+
+ /*
+ * Initialize the global variables shared by all interpreters
+ */
+ tixNormalUid = Tk_GetUid("normal");
+ tixCellUid = Tk_GetUid("cell");
+ tixRowUid = Tk_GetUid("row");
+ tixColumnUid = Tk_GetUid("column");
+ tixDisabledUid = Tk_GetUid("disabled");
+
+#ifndef _WINDOWS
+ /* This is for tixMwm command */
+ Tk_CreateGenericHandler(TixMwmProtocolHandler, NULL);
+#endif
+
+ /* Initialize the image readers */
+#if 0 /* CYGNUS LOCAL: turn off Tix xpm handling; we have it in
+ libide. */
+ Tk_CreateImageType(&tixPixmapImageType);
+#endif /* END CYGNUS LOCAL */
+ Tk_CreateImageType(&tixCompoundImageType);
+
+ /* Initialize the display item types */
+ Tix_AddDItemType(&tix_ImageTextItemType);
+ Tix_AddDItemType(&tix_TextItemType);
+ Tix_AddDItemType(&tix_WindowItemType);
+ Tix_AddDItemType(&tix_ImageItemType);
+
+ /*
+ * Initializes all the Tix built-in bitmaps.
+ */
+#define Et_Interp interp
+#include "tixBitmaps.h"
+
+ }
+ else {
+ /*
+ * This variable is used in the __tixInit procedure.
+ */
+ Tcl_SetVar2(interp, "tix_priv", "slaveInterp", "", TCL_GLOBAL_ONLY);
+ }
+
+ /*
+ * Initialize the per-interpreter variables
+ */
+
+ /* Set the "tix_version" variable */
+ Tcl_SetVar(interp, "tix_version", TIX_VERSION, TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "tix_patchLevel", TIX_PATCHLEVEL, TCL_GLOBAL_ONLY);
+ Tcl_SetVar(interp, "tix_release", TIX_RELEASE, TCL_GLOBAL_ONLY);
+
+ /* Initialize the Tix commands */
+ Tix_CreateCommands(interp, commands, (ClientData) topLevel,
+ (void (*)_ANSI_ARGS_((ClientData))) NULL);
+
+#ifdef _WINDOWS
+ Tcl_GlobalEval(interp, "set tixPriv(isWindows) 1");
+#endif
+
+ /* Parse options database for fontSets, schemes, etc */
+ if (ParseToolkitOptions(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if ((appName = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY))== NULL) {
+ appName = "tixwish";
+ }
+
+ if (doSource) {
+
+ if (TixLoadLibrary(interp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check whether the TIX_LIBRARY variable is set to a
+ * pre-4.0.2 version of Tix. (All 4.0.2+ version will
+ * correctly identify their own versions and will print out
+ * warning messages if the version of the binary does not
+ * match with the script library
+ */
+ if (Tcl_GlobalEval(interp, "tixScriptVersion") != TCL_OK) {
+ char *tixLibraryStr;
+ fprintf(stderr,
+ "Warning: Tix script library version (pre 4.0.2)\n");
+
+ /* CYGNUS LOCAL - You are not guaranteed that tix_library
+ * is set. Check that so you don't crash printing the
+ * error message...
+ */
+
+ tixLibraryStr = Tcl_GetVar(interp, "tix_library",
+ TCL_GLOBAL_ONLY);
+ if (tixLibraryStr != NULL) {
+ fprintf(stderr, " in \"%s\"\n", tixLibraryStr);
+ }
+
+ /*
+ * END CYGNUS LOCAL
+ */
+
+ fprintf(stderr, " does not match binary version (%s).\n",
+ TIX_PATCHLEVEL);
+ fprintf(stderr, " Please check your TIX_LIBRARY environment ");
+ fprintf(stderr, "variable and your Tix installation.\n");
+ Tcl_ResetResult(interp);
+ }
+
+ if (Tcl_GlobalEval(interp, "__tixInit") != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_SetVar(interp, "tix_library", "", TCL_GLOBAL_ONLY);
+ }
+
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_Init --
+ *
+ * This is the function to call in your Tcl_AppInit() function
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tix_Init(interp)
+ Tcl_Interp * interp;
+{
+ int code = Tix_Init_Internal(interp, 1);
+
+#ifdef _WINDOWS
+ if (code != TCL_OK) {
+ char * errorInfo;
+
+ errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
+ if (errorInfo == NULL) {
+ Tcl_SetVar(interp, "errorInfo", "unknown error", TCL_GLOBAL_ONLY);
+ }
+ Tix_GlobalVarEval(interp,
+ "toplevel .err; ",
+ "bind .err <Destroy> {set err_ok 1}; ",
+ "frame .err.f; pack .err.f -side bottom -fill both; "
+ "button .err.f.i -text Ignore -width 6 -command {set err_ok 1}; ",
+ "button .err.f.e -text Exit -width 6 -command {exit}; ",
+ "pack .err.f.i -side left -padx 4 -pady 4;"
+ "pack .err.f.e -side left -padx 4 -pady 4; "
+ "text .err.text -width 70 -wrap none -height 5; "
+ "pack .err.text -side top -expand yes -fill both; "
+ ".err.text insert end $errorInfo; ",
+ "tkwait variable err_ok; ",
+ "catch {destroy .err}; ",
+ NULL);
+ }
+#endif
+ return code;
+}
+
+/*----------------------------------------------------------------------
+ * TixInitSam --
+ *
+ * This takes special care when you initialize the Tix library
+ * to run in stand-alone mode.
+ *----------------------------------------------------------------------
+ */
+int TixInitSam(interp)
+ Tcl_Interp * interp;
+{
+ return Tix_Init_Internal(interp, 0);
+}
+
+/*----------------------------------------------------------------------
+ * Tix_SafeInit --
+ *
+ * This is the function to call in your Tcl_AppInit() function
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tix_SafeInit(interp)
+ Tcl_Interp * interp;
+{
+ Tcl_SetVar2(interp, "tix_priv", "isSafe", "1", TCL_GLOBAL_ONLY);
+ return Tix_Init(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ * TixLoadLibrary --
+ *
+ * Loads the Tix library.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Tix gets initialized.
+ *----------------------------------------------------------------------
+ */
+
+/* CYGNUS_LOCAL: For Tcl8.0.3 and greater use tcl_findLibrary to find he
+ * Path to the script library. Note, this will not work with Tcl 8.1b1
+ * and on. I didn't add support for Tcl8.1a1,2 because we don't support
+ * them...
+ */
+
+#if ((TCL_MAJOR_VERSION < 8) || ((TCL_MAJOR_VERSION == 8) && (TCL_MINOR_VERSION == 0) && (TCL_RELEASE_SERIAL < 3)))
+static char *initScript =
+"if [catch {file join a a}] {\n\
+ proc tixFileJoin {args} {\n\
+ set p [join $args /]\n\
+ regsub -all {/+} $p / p\n\
+ return $p\n\
+ }\n\
+} else {\n\
+ proc tixFileJoin {args} {\n\
+ return [eval file join $args]\n\
+ }\n\
+}\n\
+\n\
+proc tix_init {} {\n\
+ global tix_library tix_version tix_patchLevel env\n\
+ rename tix_init {}\n\
+ set dirs {}\n\
+ set errors {}\n\
+ if [info exists env(TIX_LIBRARY)] {\n\
+ lappend dirs $env(TIX_LIBRARY)\n\
+ }\n\
+ if [string match {*[ab]*} $tix_patchLevel] {\n\
+ set lib tix$tix_patchLevel\n\
+ set Lib Tix$tix_patchLevel\n\
+ } else {\n\
+ set lib tix$tix_version\n\
+ set Lib Tix$tix_version\n\
+ }\n\
+ catch {\n\
+ # [pwd] may not work inside safe Tcl\n\
+ set p [pwd]\n\
+ lappend dirs [tixFileJoin $p library]\n\
+ set p [file dirname $p]\n\
+ lappend dirs [tixFileJoin $p library]\n\
+ set p [file dirname $p]\n\
+ lappend dirs [tixFileJoin $p library]\n\
+ }\n\
+ set instDir [file dirname [info library]]\n\
+ lappend dirs [tixFileJoin $instDir $lib]\n\
+ lappend dirs [tixFileJoin [tixFileJoin $instDir lib] $lib]\n\
+ catch {\n\
+ lappend dirs [tixFileJoin [tixFileJoin [file dirname [file dirname [info nameofexecutable]]] lib] $lib]\n\
+ }\n\
+ lappend dirs [tixFileJoin [tixFileJoin [file dirname [file dirname [info library]]] $lib] library]\n\
+ lappend dirs [tixFileJoin [tixFileJoin [file dirname [file dirname [info library]]] $Lib] library]\n\
+ foreach i $dirs {\n\
+ set tix_library $i\n\
+ set tixfile [tixFileJoin $i Init.tcl]\n\
+ if {[interp issafe] || [file exists $tixfile]} {\n\
+ if ![catch {uplevel #0 [list source $tixfile]} err] {\n\
+ return\n\
+ } else {\n\
+ append errors \"$tixfile: $err\n$errorInfo\n\"\n\
+ }\n\
+ }\n\
+ }\n\
+ set msg \"Can't find a usable Init.tcl in the following directories: \n\"\n\
+ append msg \" $dirs\n\"\n\
+ append msg \"$errors\n\n\"\n\
+ append msg \"This probably means that Tix wasn't installed properly.\n\"\n\
+ error $msg\n\
+}\n\
+init";
+
+#else
+static char *initScript =
+"proc tix_init {} {\n\
+ global tix_library tix_version tix_patchLevel env\n\
+ rename tix_init {}\n\
+ tcl_findLibrary tix $tix_version $tix_patchLevel Init.tcl TIX_LIBRARY tix_library\n\
+}\n\
+tix_init\n\
+";
+#endif /* CYGNUS LOCAL */
+
+int
+TixLoadLibrary(interp)
+ Tcl_Interp * interp;
+{
+ return Tcl_Eval(interp, initScript);
+}
diff --git a/tix/generic/tixInputO.c b/tix/generic/tixInputO.c
new file mode 100644
index 00000000000..3aaf79a939b
--- /dev/null
+++ b/tix/generic/tixInputO.c
@@ -0,0 +1,441 @@
+/*
+ * tixInputO.c --
+ *
+ * This module implements "InputOnly" widgets.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ *
+ */
+
+#include <tkInt.h>
+#include <tixPort.h>
+#include <tix.h>
+
+/*
+ * A data structure of the following type is kept for each
+ * widget managed by this file:
+ */
+
+typedef struct Tix_InputOnlyStruct {
+ Tk_Window tkwin; /* Window that embodies the widget. NULL
+ * means window has been deleted but
+ * widget record hasn't been cleaned up yet. */
+ Tcl_Command widgetCmd; /* Token for button's widget command. */
+ Display *display; /* X's token for the window's display. */
+ Tcl_Interp *interp; /* Interpreter associated with widget. */
+
+ /*
+ * Information used when displaying widget:
+ */
+ int width;
+ int height;
+
+ /* Cursor */
+ Cursor cursor; /* Current cursor for window, or None. */
+ int changed;
+} Tix_InputOnly;
+
+typedef Tix_InputOnly WidgetRecord;
+typedef Tix_InputOnly * WidgetPtr;
+
+/*
+ * hint:: Place these into a default.f file
+ */
+#define DEF_INPUTONLY_CURSOR ""
+#define DEF_INPUTONLY_WIDTH "0"
+#define DEF_INPUTONLY_HEIGHT "0"
+
+/*
+ * Information used for argv parsing.
+ */
+static Tk_ConfigSpec configSpecs[] = {
+
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_INPUTONLY_CURSOR, Tk_Offset(WidgetRecord, cursor),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_PIXELS, "-height", "height", "Height",
+ DEF_INPUTONLY_HEIGHT, Tk_Offset(WidgetRecord, height), 0},
+
+ {TK_CONFIG_PIXELS, "-width", "width", "Width",
+ DEF_INPUTONLY_WIDTH, Tk_Offset(WidgetRecord, 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 WidgetCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int WidgetConfigure _ANSI_ARGS_((Tcl_Interp *interp,
+ WidgetPtr wPtr, int argc, char **argv,
+ int flags));
+static void WidgetDestroy _ANSI_ARGS_((ClientData clientData));
+static void WidgetEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int WidgetCommand _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *, int argc, char **argv));
+static void Tix_MakeInputOnlyWindowExist _ANSI_ARGS_((
+ WidgetPtr wPtr));
+
+
+#define INPUT_ONLY_EVENTS_MASK \
+ KeyPressMask|KeyReleaseMask|ButtonPressMask|ButtonReleaseMask| \
+ EnterWindowMask|LeaveWindowMask|PointerMotionMask| \
+ VisibilityChangeMask|SubstructureNotifyMask| \
+ FocusChangeMask|PropertyChangeMask
+
+static XSetWindowAttributes inputOnlyAtts = {
+ None, /* background_pixmap */
+ 0, /* background_pixel */
+ None, /* border_pixmap */
+ 0, /* border_pixel */
+ ForgetGravity, /* bit_gravity */
+ NorthWestGravity, /* win_gravity */
+ NotUseful, /* backing_store */
+ (unsigned) ~0, /* backing_planes */
+ 0, /* backing_pixel */
+ False, /* save_under */
+ INPUT_ONLY_EVENTS_MASK, /* event_mask */
+ 0, /* do_not_propagate_mask */
+ False, /* override_redirect */
+ None, /* colormap */
+ None /* cursor */
+};
+
+
+static
+void Tix_MakeInputOnlyWindowExist(wPtr)
+ WidgetPtr wPtr;
+{
+ TkWindow* winPtr;
+ Tcl_HashEntry *hPtr;
+ int new;
+ Window parent;
+
+ winPtr = (TkWindow*) wPtr->tkwin;
+ inputOnlyAtts.cursor = winPtr->atts.cursor;
+
+
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ parent = XRootWindow(winPtr->display, winPtr->screenNum);
+ } else {
+ if (winPtr->parentPtr->window == None) {
+ Tk_MakeWindowExist((Tk_Window) winPtr->parentPtr);
+ }
+ parent = winPtr->parentPtr->window;
+ }
+
+ winPtr->window = XCreateWindow(winPtr->display,
+ parent,
+ winPtr->changes.x, winPtr->changes.y,
+ (unsigned) winPtr->changes.width,
+ (unsigned) winPtr->changes.height,
+ 0, 0,
+ InputOnly,
+ CopyFromParent,
+ CWEventMask|CWCursor,
+ &inputOnlyAtts);
+
+ hPtr = Tcl_CreateHashEntry(&winPtr->dispPtr->winTable,
+ (char *) winPtr->window, &new);
+ Tcl_SetHashValue(hPtr, winPtr);
+
+ winPtr->dirtyAtts = 0;
+ winPtr->dirtyChanges = 0;
+#ifdef TK_USE_INPUT_METHODS
+ winPtr->inputContext = NULL;
+#endif /* TK_USE_INPUT_METHODS */
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tix_InputOnlyCmd --
+ *
+ * This procedure is invoked to process the "inputOnly" Tcl
+ * command. It creates a new "InputOnly" widget.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * A new widget is created and configured.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Tix_InputOnlyCmd(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;
+ WidgetPtr wPtr;
+ 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;
+ }
+
+ /*
+ * Allocate and initialize the widget record.
+ */
+ wPtr = (WidgetPtr) ckalloc(sizeof(WidgetRecord));
+ wPtr->tkwin = tkwin;
+ wPtr->display = Tk_Display(tkwin);
+ wPtr->interp = interp;
+ wPtr->width = 0;
+ wPtr->height = 0;
+ wPtr->cursor = None;
+ wPtr->changed = 0;
+
+ Tk_SetClass(tkwin, "TixInputOnly");
+
+ Tix_MakeInputOnlyWindowExist(wPtr);
+
+ Tk_CreateEventHandler(wPtr->tkwin, StructureNotifyMask,
+ WidgetEventProc, (ClientData) wPtr);
+ wPtr->widgetCmd = Tcl_CreateCommand(interp, Tk_PathName(wPtr->tkwin),
+ WidgetCommand, (ClientData) wPtr, WidgetCmdDeletedProc);
+ if (WidgetConfigure(interp, wPtr, argc-2, argv+2, 0) != TCL_OK) {
+ Tk_DestroyWindow(wPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ interp->result = Tk_PathName(wPtr->tkwin);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WidgetCommand --
+ *
+ * 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
+WidgetCommand(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about the widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int result = TCL_OK;
+ int length;
+ char c;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ Tk_Preserve((ClientData) wPtr);
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, wPtr->tkwin, configSpecs,
+ (char *) wPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, wPtr->tkwin, configSpecs,
+ (char *) wPtr, argv[2], 0);
+ } else {
+ result = WidgetConfigure(interp, wPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ }
+ else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)) {
+ if (argc == 3) {
+ return Tk_ConfigureValue(interp, wPtr->tkwin, configSpecs,
+ (char *)wPtr, argv[2], 0);
+ } else {
+ return Tix_ArgcError(interp, argc, argv, 2, "option");
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be cget or configure", (char *) NULL);
+ goto error;
+ }
+
+ Tk_Release((ClientData) wPtr);
+ return result;
+
+ error:
+ Tk_Release((ClientData) wPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WidgetConfigure --
+ *
+ * This procedure is called to process an argv/argc list in
+ * conjunction with the Tk option database to configure (or
+ * reconfigure) a InputOnly 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 wPtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+WidgetConfigure(interp, wPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ WidgetPtr wPtr; /* 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, wPtr->tkwin, configSpecs,
+ argc, argv, (char *) wPtr, flags) != TCL_OK) {
+
+ return TCL_ERROR;
+ }
+
+ Tk_GeometryRequest(wPtr->tkwin, wPtr->width, wPtr->height);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WidgetEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on InputOnlys.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+WidgetEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+
+ switch (eventPtr->type) {
+ case DestroyNotify:
+ if (wPtr->tkwin != NULL) {
+ wPtr->tkwin = NULL;
+ Tcl_DeleteCommand(wPtr->interp,
+ Tcl_GetCommandName(wPtr->interp, wPtr->widgetCmd));
+ }
+ Tk_EventuallyFree((ClientData) wPtr, (Tix_FreeProc*)WidgetDestroy);
+ break;
+
+ case MapNotify:
+ case ConfigureNotify:
+ break;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WidgetDestroy --
+ *
+ * This procedure is invoked by Tk_EventuallyFree or Tk_Release
+ * to clean up the internal structure of a InputOnly at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the InputOnly is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+WidgetDestroy(clientData)
+ ClientData clientData; /* Info about my widget. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+
+ Tk_FreeOptions(configSpecs, (char *) wPtr, wPtr->display, 0);
+ ckfree((char *) wPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WidgetCmdDeletedProc --
+ *
+ * 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
+WidgetCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ WidgetPtr wPtr = (WidgetPtr) 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 (wPtr->tkwin != NULL) {
+ Tk_Window tkwin = wPtr->tkwin;
+ wPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
diff --git a/tix/generic/tixInt.h b/tix/generic/tixInt.h
new file mode 100644
index 00000000000..58a36d0f0be
--- /dev/null
+++ b/tix/generic/tixInt.h
@@ -0,0 +1,880 @@
+/*
+ * tixInt.h --
+ *
+ * Defines internal data types and functions used by the Tix library.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+#ifndef _TIX_INT_H_
+#define _TIX_INT_H_
+
+#ifndef _TIX_H_
+#include <tix.h>
+#endif
+
+#ifndef _TIX_PORT_H_
+#include <tixPort.h>
+#endif
+
+#ifdef BUILD_tix
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*----------------------------------------------------------------------
+ *
+ * Tix Display Item Types
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define TIX_DITEM_NONE 0
+#define TIX_DITEM_TEXT 1
+#define TIX_DITEM_IMAGETEXT 2
+#define TIX_DITEM_WINDOW 3
+#define TIX_DITEM_IMAGE 4
+
+/*
+ * The flags for drawing DItems
+ */
+
+#define TIX_DITEM_NORMAL_BG (0x1 << 0)
+#define TIX_DITEM_ACTIVE_BG (0x1 << 1)
+#define TIX_DITEM_SELECTED_BG (0x1 << 2)
+#define TIX_DITEM_DISABLED_BG (0x1 << 3)
+#define TIX_DITEM_NORMAL_FG (0x1 << 4)
+#define TIX_DITEM_ACTIVE_FG (0x1 << 5)
+#define TIX_DITEM_SELECTED_FG (0x1 << 6)
+#define TIX_DITEM_DISABLED_FG (0x1 << 7)
+#define TIX_DITEM_FONT (0x1 << 8)
+#define TIX_DITEM_PADX (0x1 << 9)
+#define TIX_DITEM_PADY (0x1 << 10)
+
+#if 0
+ /*
+ * %bordercolor not used
+ */
+#define TIX_DITEM_BORDER_COLOR (0x1 << 11)
+#define TIX_DITEM_BORDER_WIDTH (0x1 << 12)
+#define TIX_DITEM_RELIEF (0x1 << 13)
+#define TIX_DITEM_BOTTOM (0x1 << 14)
+#define TIX_DITEM_RIGHT (0x1 << 15)
+#endif
+
+#define TIX_DONT_CALL_CONFIG TK_CONFIG_USER_BIT
+
+/*
+ * These values are used ONLY for indexing the color array in
+ * Tix_StyleTemplate
+ */
+
+#define TIX_DITEM_NORMAL 0
+#define TIX_DITEM_ACTIVE 1
+#define TIX_DITEM_SELECTED 2
+#define TIX_DITEM_DISABLED 3
+
+/*
+ * Flags for MultiInfo
+ */
+#define TIX_CONFIG_INFO 1
+#define TIX_CONFIG_VALUE 2
+
+typedef union Tix_DItem Tix_DItem;
+typedef union Tix_DItemStyle Tix_DItemStyle;
+typedef struct Tix_DItemInfo Tix_DItemInfo;
+typedef struct Tix_DispData Tix_DispData;
+typedef struct Tix_StyleTemplate Tix_StyleTemplate;
+
+typedef void Tix_DItemCalculateSizeProc _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+typedef char * Tix_DItemComponentProc _ANSI_ARGS_((
+ Tix_DItem * iPtr, int x, int y));
+typedef int Tix_DItemConfigureProc _ANSI_ARGS_((
+ Tix_DItem * iPtr, int argc, char ** argv,
+ int flags));
+typedef Tix_DItem * Tix_DItemCreateProc _ANSI_ARGS_((
+ Tix_DispData * ddPtr,
+ Tix_DItemInfo * diTypePtr));
+typedef void Tix_DItemDisplayProc _ANSI_ARGS_((
+ Pixmap pixmap, GC gc, Tix_DItem * iPtr,
+ int x, int y, int width, int height, int flag));
+typedef void Tix_DItemFreeProc _ANSI_ARGS_((Tix_DItem * diPtr));
+typedef void Tix_DItemSizeChangedProc _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+
+typedef void Tix_DItemStyleChangedProc _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+typedef void Tix_DItemLostStyleProc _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+typedef int Tix_DItemStyleConfigureProc _ANSI_ARGS_((
+ Tix_DItemStyle* style, int argc, char ** argv,
+ int flags));
+typedef Tix_DItemStyle* Tix_DItemStyleCreateProc _ANSI_ARGS_((
+ Tcl_Interp * interp, Tk_Window tkwin,
+ Tix_DItemInfo * diTypePtr, char * name));
+typedef void Tix_DItemStyleFreeProc _ANSI_ARGS_((
+ Tix_DItemStyle* style));
+typedef void Tix_DItemStyleSetTemplateProc _ANSI_ARGS_((
+ Tix_DItemStyle* style,
+ Tix_StyleTemplate * tmplPtr));
+
+/*
+ * These are debugging routines
+ */
+
+typedef int Tix_DItemRefCountProc _ANSI_ARGS_(());
+typedef int Tix_DItemStyleRefCountProc _ANSI_ARGS_(());
+
+/*----------------------------------------------------------------------
+ * Tix_DItemInfo --
+ *
+ * This structure is used to register a new display item (call
+ * Tix_AddDItemType).
+ *----------------------------------------------------------------------
+ */
+struct Tix_DItemInfo {
+ char * name;
+ int type;
+
+ /*
+ * These procedures communicate with the items
+ */
+ Tix_DItemCreateProc * createProc;
+ Tix_DItemConfigureProc * configureProc;
+ Tix_DItemCalculateSizeProc * calculateSizeProc;
+ Tix_DItemComponentProc * componentProc;
+ Tix_DItemDisplayProc * displayProc;
+ Tix_DItemFreeProc * freeProc;
+ Tix_DItemStyleChangedProc *styleChangedProc;
+ Tix_DItemLostStyleProc * lostStyleProc;
+
+ /*
+ * These procedures communicate with the styles
+ */
+ Tix_DItemStyleCreateProc * styleCreateProc;
+ Tix_DItemStyleConfigureProc * styleConfigureProc;
+ Tix_DItemStyleFreeProc * styleFreeProc;
+ Tix_DItemStyleSetTemplateProc * styleSetTemplateProc;
+
+ Tk_ConfigSpec * itemConfigSpecs;
+ Tk_ConfigSpec * styleConfigSpecs;
+ struct Tix_DItemInfo * next;
+};
+
+/*----------------------------------------------------------------------
+ * Tix_DispData --
+ *
+ * Information needed by the display types to display the item in
+ * an X drawable.
+ *----------------------------------------------------------------------
+ */
+struct Tix_DispData {
+ Display * display;
+ Tcl_Interp * interp;
+ Tk_Window tkwin;
+ Tix_DItemSizeChangedProc * sizeChangedProc;
+};
+
+/*----------------------------------------------------------------------
+ * Tix_StyleTemplate --
+ *
+ * A StyleTemplate is used to set the values of the default styles
+ * associated with a widget
+ *----------------------------------------------------------------------
+ */
+struct Tix_StyleTemplate {
+ int flags; /* determines which field is valid */
+
+ struct {
+ XColor * bg;
+ XColor * fg;
+ } colors[4]; /* colors for the four basic modes*/
+
+ int pad[2];
+#if 0
+ /* %bordercolor not used */
+ XColor * borderColor;
+ Tix_Relief relief;
+ int borderWidth;
+#endif
+ TixFont font;
+};
+
+/*----------------------------------------------------------------------
+ *
+ *
+ * Display Item Types
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+
+/*
+ * Display Styles
+ */
+typedef struct TixBaseStyle TixBaseStyle;
+typedef struct TixImageTextStyle TixImageTextStyle;
+typedef struct TixImageStyle TixImageStyle;
+typedef struct TixTextStyle TixTextStyle;
+typedef struct TixWindowStyle TixWindowStyle;
+
+typedef struct TixBaseItem TixBaseItem;
+typedef struct TixColorStyle TixColorStyle;
+typedef struct TixImageTextItem TixImageTextItem;
+typedef struct TixImageItem TixImageItem;
+typedef struct TixTextItem TixTextItem;
+typedef struct TixWindowItem TixWindowItem;
+
+/*----------------------------------------------------------------------
+ * TixBaseItem --
+ *
+ * This is the abstract base class for all display items. All
+ * display items should have the data members defined in the
+ * BaseItem structure
+ *----------------------------------------------------------------------
+ */
+#define ITEM_COMMON_MEMBERS \
+ Tix_DItemInfo * diTypePtr; \
+ Tix_DispData * ddPtr; \
+ ClientData clientData; \
+ int size[2] /* Size of this element */ \
+
+struct TixBaseItem {
+ ITEM_COMMON_MEMBERS;
+ TixBaseStyle * stylePtr;
+};
+
+/*----------------------------------------------------------------------
+ * TixBaseStyle --
+ *
+ * This is the abstract base class for all display styles. All
+ * display items should have the data members defined in the
+ * BaseStyle structure. The common members are initialized by
+ * tixDiStyle.c
+ *
+ *----------------------------------------------------------------------
+ */
+
+#define STYLE_COMMON_MEMBERS \
+ Tcl_Command styleCmd; /* Token for style's command. */ \
+ Tcl_HashTable items; /* Ditems affected by this style */ \
+ int refCount; /* Number of ditems affected by this style */\
+ int flags; /* Various attributes */ \
+ Tcl_Interp *interp; /* Interpreter associated with style. */ \
+ Tk_Window tkwin; /* Window associated with this style */ \
+ Tix_DItemInfo * diTypePtr; \
+ Tk_Anchor anchor; /* Anchor information */ \
+ char * name; /* Name of this style */ \
+ int pad[2] /* paddings */
+
+
+#if 0
+ Tix_Relief relief
+ /* %bordercolor not used */
+ int borderWidth;
+ XColor * borderColor; /* color of the border when it is displayed
+ * in "flat border" mode
+ */
+ GC borderGC
+#endif
+
+#define STYLE_COLOR_MEMBERS \
+ struct { \
+ XColor * bg; \
+ XColor * fg; \
+ GC foreGC; \
+ GC backGC; \
+ } colors[4] /* colors and GC's for the four basic modes*/
+
+struct TixBaseStyle {
+ STYLE_COMMON_MEMBERS;
+};
+
+#define TIX_STYLE_DELETED 1
+#define TIX_STYLE_DEFAULT 2
+
+/*
+ * Abstract type for all styles that have a color element
+ */
+struct TixColorStyle {
+ STYLE_COMMON_MEMBERS;
+ STYLE_COLOR_MEMBERS;
+};
+
+/*----------------------------------------------------------------------
+ * ImageTextItem --
+ *
+ * Display an image together with a text string
+ *----------------------------------------------------------------------
+ */
+struct TixImageTextItem {
+ ITEM_COMMON_MEMBERS;
+
+ TixImageTextStyle *stylePtr;
+ /*-------------------------*/
+ /* Bitmap */
+ /*-------------------------*/
+ Pixmap bitmap;
+ int bitmapW, bitmapH; /* Size of bitmap */
+
+ /*-------------------------*/
+ /* Image */
+ /*-------------------------*/
+ char *imageString; /* Name of image to display (malloc'ed), or
+ * NULL. If non-NULL, bitmap, text, and
+ * textVarName are ignored. */
+ Tk_Image image;
+ int imageW, imageH; /* Size of image */
+
+ /*-------------------------*/
+ /* Text */
+ /*-------------------------*/
+
+ char * text; /* Show descriptive text */
+ size_t numChars; /* Size of text */
+ int textW, textH;
+ int wrapLength;
+ Tk_Justify justify; /* Justification to use for multi-line text. */
+ int underline; /* Index of character to underline. < 0 means
+ * don't underline anything. */
+
+ int showImage, showText;
+};
+
+struct TixImageTextStyle {
+ STYLE_COMMON_MEMBERS;
+ STYLE_COLOR_MEMBERS;
+ int wrapLength;
+ Tk_Justify justify; /* Justification to use for multi-line text. */
+ TixFont font;
+ int gap; /* Gap between text and image */
+};
+
+/*----------------------------------------------------------------------
+ * ImageItem --
+ *
+ * Displays an image
+ *----------------------------------------------------------------------
+ */
+struct TixImageItem {
+ ITEM_COMMON_MEMBERS;
+
+ TixImageStyle *stylePtr;
+
+ /*-------------------------*/
+ /* Image */
+ /*-------------------------*/
+ char *imageString; /* Name of image to display (malloc'ed), or
+ * NULL. If non-NULL, bitmap, text, and
+ * textVarName are ignored. */
+ Tk_Image image;
+ int imageW, imageH; /* Size of image */
+};
+
+struct TixImageStyle {
+ STYLE_COMMON_MEMBERS;
+ STYLE_COLOR_MEMBERS;
+};
+/*----------------------------------------------------------------------
+ * TextItem --
+ *
+ * Displays a text string.
+ *----------------------------------------------------------------------
+ */
+struct TixTextItem {
+ ITEM_COMMON_MEMBERS;
+
+ TixTextStyle *stylePtr;
+ /*-------------------------*/
+ /* Text */
+ /*-------------------------*/
+
+ char * text; /* Show descriptive text */
+ size_t numChars; /* Size of text */
+ int textW, textH;
+ int underline; /* Index of character to underline. < 0 means
+ * don't underline anything. */
+};
+
+struct TixTextStyle {
+ STYLE_COMMON_MEMBERS;
+ STYLE_COLOR_MEMBERS;
+ int wrapLength;
+ Tk_Justify justify; /* Justification to use for multi-line text. */
+ TixFont font;
+};
+
+/*----------------------------------------------------------------------
+ * WindowItem --
+ *
+ * Displays a window.
+ *----------------------------------------------------------------------
+ */
+struct TixWindowItem {
+ ITEM_COMMON_MEMBERS;
+ TixWindowStyle *stylePtr;
+ Tk_Window tkwin;
+ struct TixWindowItem * next;
+ int serial;
+};
+
+struct TixWindowStyle {
+ STYLE_COMMON_MEMBERS;
+};
+
+/*----------------------------------------------------------------------
+ * Tix_DItem and Tix_DItemStyle --
+ *
+ * These unions just make it easy to address the internals of the
+ * structures of the display items and styles. If you create a new
+ * display item, you will need to do you type casting yourself.
+ *----------------------------------------------------------------------
+ */
+union Tix_DItem {
+ TixBaseItem base;
+ TixImageTextItem imagetext;
+ TixTextItem text;
+ TixWindowItem window;
+ TixImageItem image;
+};
+
+union Tix_DItemStyle {
+ TixBaseStyle base;
+ TixColorStyle color;
+ TixImageTextStyle imagetext;
+ TixTextStyle text;
+ TixWindowStyle window;
+ TixImageStyle image;
+};
+
+#define Tix_DItemType(x) ((x)->base.diTypePtr->type)
+#define Tix_DItemTypeName(x) ((x)->base.diTypePtr->name)
+#define Tix_DItemWidth(x) ((x)->base.size[0])
+#define Tix_DItemHeight(x) ((x)->base.size[1])
+#define Tix_DItemConfigSpecs(x) ((x)->base.diTypePtr->itemConfigSpecs)
+#define Tix_DItemPadX(x) ((x)->base.stylePtr->pad[0])
+#define Tix_DItemPadY(x) ((x)->base.stylePtr->pad[1])
+
+#define TIX_WIDTH 0
+#define TIX_HEIGHT 1
+
+/*----------------------------------------------------------------------
+ * Tix_ArgumentList --
+ *
+ * This data structure is used to split command arguments for
+ * the display item types
+ *----------------------------------------------------------------------
+ */
+#define FIXED_SIZE 4
+typedef struct {
+ int argc;
+ char ** argv;
+} Tix_Argument;
+
+typedef struct {
+ Tix_Argument * arg;
+ int numLists;
+ Tix_Argument preAlloc[FIXED_SIZE];
+} Tix_ArgumentList;
+
+/*----------------------------------------------------------------------
+ * Tix_ScrollInfo --
+ *
+ * This data structure encapsulates all the necessary operations
+ * for scrolling widgets
+ *----------------------------------------------------------------------
+ */
+#define TIX_SCROLL_INT 1
+#define TIX_SCROLL_DOUBLE 2
+
+/* abstract type */
+typedef struct Tix_ScrollInfo {
+ int type; /* TIX_SCROLL_INT or TIX_SCROLL_DOUBLE */
+ char * command;
+} Tix_ScrollInfo;
+
+typedef struct Tix_IntScrollInfo {
+ int type; /* TIX_SCROLL_INT */
+ char * command;
+
+ int total; /* total size (width or height) of the widget*/
+ int window; /* visible size */
+ int offset; /* The top/left side of the scrolled widget */
+ int unit; /* How much should we scroll when the user
+ * press the arrow on a scrollbar? */
+
+} Tix_IntScrollInfo;
+
+typedef struct Tix_DoubleScrollInfo {
+ int type; /* TIX_SCROLL_DOUBLE */
+ char * command;
+
+ double total; /* total size (width or height) of the widget*/
+ double window; /* visible size */
+ double offset; /* The top/left side of the scrolled widget */
+ double unit; /* How much should we scroll when the user
+ * press the arrow on a scrollbar? */
+} Tix_DoubleScrollInfo;
+
+/*----------------------------------------------------------------------
+ *
+ * Global variables
+ *
+ * Should be used only in the Tix library. Some systems don't support
+ * exporting of global variables from shared libraries.
+ *
+ *----------------------------------------------------------------------
+ */
+EXTERN Tk_Uid tixNormalUid;
+EXTERN Tk_Uid tixDisabledUid;
+EXTERN Tk_Uid tixCellUid;
+EXTERN Tk_Uid tixRowUid;
+EXTERN Tk_Uid tixColumnUid;
+
+#define FLAG_READONLY 0
+#define FLAG_STATIC 1
+#define FLAG_FORCECALL 2
+
+/*----------------------------------------------------------------------
+ *
+ *
+ * MEGA-WIDGET CONFIG HANDLING
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+typedef struct _TixConfigSpec TixConfigSpec;
+typedef struct _TixConfigAlias TixConfigAlias;
+typedef struct _TixClassRecord TixClassRecord;
+
+struct _TixConfigSpec {
+ unsigned int isAlias : 1;
+ unsigned int readOnly : 1;
+ unsigned int isStatic : 1;
+ unsigned int forceCall : 1;
+
+ char * argvName;
+ char * defValue;
+
+ char * dbName; /* The additional parts of a */
+ char * dbClass; /* TixWidgetConfigSpec structure */
+
+ char *verifyCmd;
+
+ TixConfigSpec * realPtr; /* valid only if this option is an alias */
+};
+
+/*
+ * Controls the access of root widget and subwidget commands and options
+ */
+typedef struct _Tix_ExportSpec {
+ Tix_LinkList exportCmds;
+ Tix_LinkList restrictCmds;
+ Tix_LinkList exportOpts;
+ Tix_LinkList restrictOpts;
+} Tix_ExportSpec;
+
+typedef struct _Tix_SubWidgetSpec {
+ struct _Tix_SubWidgetSpec * next;
+ char * name;
+ Tix_ExportSpec export;
+} Tix_SubWidgetSpec;
+
+typedef struct _Tix_StringLink {
+ struct _Tix_StringLink *next;
+ char * string;
+} Tix_StringLink;
+
+typedef struct _Tix_SubwidgetDef {
+ struct _TixSubwidgetDef * next;
+ char * spec;
+ char * value;
+} Tix_SubwidgetDef;
+
+typedef struct _TixClassParseStruct {
+ char * alias;
+ char * ClassName;
+ char * configSpec;
+ char * def;
+ char * flag;
+ char * forceCall;
+ char * method;
+ char * readOnly;
+ char * isStatic;
+ char * superClass;
+ char * subWidget;
+ char * isVirtual;
+
+ int optArgc;
+ char ** optArgv;
+} TixClassParseStruct;
+
+struct _TixClassRecord {
+ TixClassRecord * next; /* Chains to the next class record in
+ * a superClass's unInitSubCls list */
+ TixClassRecord * superClass; /* The superclass of this class. Is
+ * NULL if this class does not have
+ * a superclass. */
+ unsigned int isWidget; /* TRUE iff this class is created by
+ * the "tixWidgetClass" command */
+ char * className; /* Instiantiation command */
+ char * ClassName; /* used in TK option database */
+
+ int nSpecs;
+ TixConfigSpec ** specs;
+ int nMethods;
+ char ** methods;
+ Tk_Window mainWindow; /* This variable is essentially
+ * a cached variable so that
+ * we can advoid calling
+ * Tk_MainWindow() */
+ int isVirtual; /* is this a virtual base class
+ * (shouldn't be instantiated)*/
+ TixClassParseStruct*parsePtr; /* Information supplied by the
+ * tixClass or tixWidgetClass
+ * commands */
+ Tix_LinkList unInitSubCls; /* The subclasses that have not been
+ * initialized. */
+ int initialized; /* Is this class initialized? A class
+ * is not initialized if it has been
+ * defined but some its superclass
+ * is not initialized.
+ */
+ Tix_LinkList subWDefs; /* the -defaults option */
+#if USE_ACCESS_CONTROL
+ Tix_LinkList subWidgets;
+ Tix_ExportSpec exportSpec; /* controls the export status
+ * of the commands and options
+ * of the root widget */
+#endif
+};
+
+typedef struct _TixInterpState {
+ char * result;
+ char * errorInfo;
+ char * errorCode;
+} TixInterpState;
+
+/*----------------------------------------------------------------------
+ *
+ * Internal procedures
+ *
+ *----------------------------------------------------------------------
+ */
+
+EXTERN int Tix_CallConfigMethod _ANSI_ARGS_((
+ Tcl_Interp *interp, TixClassRecord *cPtr,
+ char * widRec, TixConfigSpec *spec, char * value));
+EXTERN int Tix_CallMethod _ANSI_ARGS_((Tcl_Interp *interp,
+ char *context, char *widRec, char *method,
+ int argc, char **argv));
+EXTERN int Tix_ChangeOneOption _ANSI_ARGS_((
+ Tcl_Interp *interp, TixClassRecord *cPtr,
+ char * widRec, TixConfigSpec *spec, char * value,
+ int isDefault, int isInit));
+EXTERN int Tix_ChangeOptions _ANSI_ARGS_((
+ Tcl_Interp *interp, TixClassRecord *cPtr,
+ char * widRec, int argc, char ** argv));
+EXTERN TixConfigSpec * Tix_FindConfigSpecByName _ANSI_ARGS_((
+ Tcl_Interp * interp,
+ TixClassRecord * cPtr, char * name));
+EXTERN char * Tix_FindMethod _ANSI_ARGS_((Tcl_Interp *interp,
+ char *context, char *method));
+EXTERN char * Tix_FindPublicMethod _ANSI_ARGS_((
+ Tcl_Interp *interp, TixClassRecord * cPtr,
+ char * method));
+EXTERN int Tix_GetChars _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string, double *doublePtr));
+EXTERN char * Tix_GetConfigSpecFullName _ANSI_ARGS_((char *clasRec,
+ char *flag));
+EXTERN char * Tix_GetContext _ANSI_ARGS_((
+ Tcl_Interp * interp, char * widRec));
+EXTERN char * Tix_GetMethodFullName _ANSI_ARGS_((char *context,
+ char *method));
+EXTERN void Tix_GetPublicMethods _ANSI_ARGS_((Tcl_Interp *interp,
+ char *widRec, int *numMethods,
+ char *** validMethods));
+EXTERN int Tix_GetWidgetOption _ANSI_ARGS_((
+ Tcl_Interp *interp, Tk_Window tkwin,
+ char *argvName, char *dbName, char *dbClass,
+ char *defValue, int argc, char **argv,
+ int type, char *ptr));
+EXTERN int Tix_GetVar _ANSI_ARGS_((
+ Tcl_Interp *interp, TixClassRecord *cPtr,
+ char * widRec, char * flag));
+EXTERN int Tix_QueryAllOptions _ANSI_ARGS_((
+ Tcl_Interp *interp, TixClassRecord * cPtr,
+ char *widRec));
+EXTERN int Tix_QueryOneOption _ANSI_ARGS_((
+ Tcl_Interp *interp, TixClassRecord *cPtr,
+ char *widRec, char *flag));
+EXTERN int Tix_SuperClass _ANSI_ARGS_((Tcl_Interp *interp,
+ char *widClass, char ** superClass_ret));
+EXTERN int Tix_UnknownPublicMethodError _ANSI_ARGS_((
+ Tcl_Interp *interp, TixClassRecord * cPtr,
+ char * widRec, char * method));
+EXTERN int Tix_ValueMissingError _ANSI_ARGS_((Tcl_Interp *interp,
+ char *spec));
+EXTERN void Tix_AddDItemType _ANSI_ARGS_((
+ Tix_DItemInfo * diTypePtr));
+EXTERN int Tix_ConfigureInfo2 _ANSI_ARGS_((
+ Tcl_Interp *interp, Tk_Window tkwin,
+ char *entRec, Tk_ConfigSpec *entConfigSpecs,
+ Tix_DItem * iPtr, char *argvName, int flags));
+EXTERN int Tix_ConfigureValue2 _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, char * entRec,
+ Tk_ConfigSpec *entConfigSpecs, Tix_DItem * iPtr,
+ char *argvName, int flags));
+EXTERN void Tix_DItemCalculateSize _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+EXTERN char * Tix_DItemComponent _ANSI_ARGS_((Tix_DItem * diPtr,
+ int x, int y));
+EXTERN int Tix_DItemConfigure _ANSI_ARGS_((
+ Tix_DItem * diPtr, int argc,
+ char ** argv, int flags));
+EXTERN Tix_DItem * Tix_DItemCreate _ANSI_ARGS_((Tix_DispData * ddPtr,
+ char * type));
+EXTERN void Tix_DItemDrawBackground _ANSI_ARGS_((
+ Pixmap pixmap, GC gc, Tix_DItem * iPtr,
+ int x, int y, int width, int height, int flags));
+EXTERN void Tix_DItemDisplay _ANSI_ARGS_((
+ Pixmap pixmap, GC gc, Tix_DItem * iPtr,
+ int x, int y, int width, int height, int flag));
+EXTERN void Tix_DItemFree _ANSI_ARGS_((
+ Tix_DItem * iPtr));
+EXTERN void TixDItemStyleChanged _ANSI_ARGS_((
+ Tix_DItemInfo * diTypePtr,
+ Tix_DItemStyle * stylePtr));
+EXTERN void TixDItemStyleFree _ANSI_ARGS_((Tix_DItem *iPtr,
+ Tix_DItemStyle * stylePtr));
+EXTERN void TixDItemGetAnchor _ANSI_ARGS_((Tk_Anchor anchor,
+ int x, int y, int cav_w, int cav_h,
+ int width, int height, int * x_ret, int * y_ret));
+EXTERN void Tix_FreeArgumentList _ANSI_ARGS_((
+ Tix_ArgumentList *argListPtr));
+EXTERN void TixGetColorDItemGC _ANSI_ARGS_((
+ Tix_DItem * iPtr, GC * backGC_ret,
+ GC * foreGC_ret, int flags));
+EXTERN Tix_DItemStyle* TixGetDefaultDItemStyle _ANSI_ARGS_((
+ Tix_DispData * ddPtr, Tix_DItemInfo * diTypePtr,
+ Tix_DItem *iPtr, Tix_DItemStyle* oldStylePtr));
+EXTERN Tix_DItemInfo * Tix_GetDItemType _ANSI_ARGS_((
+ Tcl_Interp * interp, char *type));
+EXTERN void Tix_GetScrollFractions _ANSI_ARGS_((
+ Tix_ScrollInfo * siPtr,
+ double * first_ret, double * last_ret));
+EXTERN void Tix_InitScrollInfo _ANSI_ARGS_((
+ Tix_ScrollInfo * siPtr, int type));
+EXTERN int Tix_MultiConfigureInfo _ANSI_ARGS_((
+ Tcl_Interp * interp,
+ Tk_Window tkwin, Tk_ConfigSpec **specsList,
+ int numLists, char **widgRecList, char *argvName,
+ int flags, int request));
+EXTERN void Tix_SetDefaultStyleTemplate _ANSI_ARGS_((
+ Tk_Window tkwin, Tix_StyleTemplate * tmplPtr));
+EXTERN int Tix_SetScrollBarView _ANSI_ARGS_((
+ Tcl_Interp *interp, Tix_ScrollInfo * siPtr,
+ int argc, char **argv, int compat));
+EXTERN void Tix_SetWindowItemSerial _ANSI_ARGS_((
+ Tix_LinkList * lPtr, Tix_DItem * iPtr,
+ int serial));
+EXTERN int Tix_SplitConfig _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tk_ConfigSpec ** specsList,
+ int numLists, int argc, char ** argv,
+ Tix_ArgumentList * argListPtr));
+EXTERN void Tix_UnmapInvisibleWindowItems _ANSI_ARGS_((
+ Tix_LinkList * lPtr, int serial));
+EXTERN void Tix_UpdateScrollBar _ANSI_ARGS_((
+ Tcl_Interp *interp, Tix_ScrollInfo * siPtr));
+EXTERN int Tix_WidgetConfigure2 _ANSI_ARGS_((
+ Tcl_Interp *interp, Tk_Window tkwin, char * entRec,
+ Tk_ConfigSpec *entConfigSpecs,
+ Tix_DItem * iPtr, int argc, char ** argv,
+ int flags, int forced, int * sizeChanged_ret));
+EXTERN void Tix_WindowItemListRemove _ANSI_ARGS_((
+ Tix_LinkList * lPtr, Tix_DItem * iPtr));
+
+typedef struct _TixpSubRegion TixpSubRegion;
+
+/*
+ * Functions that should be used by Tix only. Functions prefixed by "Tix"
+ * are generic functions that has one implementation for all platforms.
+ * Functions prefixed with "Tixp" requires one implementation on each
+ * platform.
+ */
+
+EXTERN int TixInitSam _ANSI_ARGS_((Tcl_Interp * interp));
+EXTERN int TixLoadLibrary _ANSI_ARGS_((Tcl_Interp * interp));
+EXTERN void TixRestoreInterpState _ANSI_ARGS_((
+ Tcl_Interp * interp, TixInterpState * statePtr));
+EXTERN void TixSaveInterpState _ANSI_ARGS_((Tcl_Interp * interp,
+ TixInterpState * statePtr));
+
+EXTERN void TixpDrawAnchorLines _ANSI_ARGS_((Display *display,
+ Drawable drawable, GC gc, int x, int y,
+ int w, int h));
+EXTERN void TixpDrawTmpLine _ANSI_ARGS_((int x1, int y1,
+ int x2, int y2, Tk_Window tkwin));
+EXTERN void TixpEndSubRegionDraw _ANSI_ARGS_((Display *display,
+ Drawable drawable, GC gc,
+ TixpSubRegion * subRegPtr));
+EXTERN int TixpSetWindowParent _ANSI_ARGS_((Tcl_Interp * interp,
+ Tk_Window tkwin, Tk_Window newParent,
+ int parentId));
+EXTERN void TixpStartSubRegionDraw _ANSI_ARGS_((Display *display,
+ Drawable drawable, GC gc,
+ TixpSubRegion * subRegPtr, int origX,
+ int origY, int x, int y, int width, int height,
+ int needWidth, int needHeight));
+EXTERN void TixpSubRegDisplayText _ANSI_ARGS_((Display *display,
+ Drawable drawable, GC gc,
+ TixpSubRegion * subRegPtr,
+ TixFont font, char *string,
+ int numChars, int x, int y, int length,
+ Tk_Justify justify, int underline));
+EXTERN void TixpSubRegDrawBitmap _ANSI_ARGS_((Display *display,
+ Drawable drawable, GC gc,
+ TixpSubRegion * subRegPtr, Pixmap bitmap,
+ int src_x, int src_y, int width, int height,
+ int dest_x, int dest_y, unsigned long plane));
+EXTERN void TixpSubRegDrawImage _ANSI_ARGS_((
+ TixpSubRegion * subRegPtr, Tk_Image image,
+ int imageX, int imageY, int width, int height,
+ Drawable drawable, int drawableX, int drawableY));
+EXTERN void TixpSubRegFillRectangle _ANSI_ARGS_((Display *display,
+ Drawable drawable, GC gc,
+ TixpSubRegion * subRegPtr, int x, int y,
+ int width, int height));
+
+
+/*
+ * Console Stuff
+ */
+
+#if ((TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION == 5))
+
+/*
+ * The TixConsole stuff was implemented for Tcl 7.5 only
+ */
+
+extern void TixConsoleCreate _ANSI_ARGS_((Tcl_Interp *interp));
+extern int TixConsoleInit _ANSI_ARGS_((Tcl_Interp *interp));
+
+#else
+
+extern void TkConsoleCreate _ANSI_ARGS_((void));
+extern int TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp));
+
+#define TixConsoleCreate(x) TkConsoleCreate()
+#define TixConsoleInit(x) TkConsoleInit(x)
+
+#endif
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TIX_INT_H_ */
diff --git a/tix/generic/tixItcl.c b/tix/generic/tixItcl.c
new file mode 100644
index 00000000000..02993d8e6dc
--- /dev/null
+++ b/tix/generic/tixItcl.c
@@ -0,0 +1,126 @@
+/*
+ * tixItcl.c --
+ *
+ * Compatibility functions that allow Tix to work under Incr Tcl.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and
+ * redistribution of this file, and for a DISCLAIMER OF ALL
+ * WARRANTIES.
+ *
+ */
+
+/*
+ * With Tcl 8.0, namespaces moved from Itcl to Tcl, and so
+ * the Tix hacks have to be used in any verison of 8.0,
+ * regardless of the presence of Itcl...
+ */
+#include <tclInt.h>
+#include <tixInt.h>
+#include <tixItcl.h>
+
+#ifdef TK_8_0_OR_LATER
+
+/*----------------------------------------------------------------------
+ * TixItclSetGlobalNameSp --
+ *
+ * Set the ITcl scope to the global scope. This way, all the Tix
+ * commands and variables will be defined in the global scope. This
+ * is necessary for Tix to function properly under ITcl.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TixItclSetGlobalNameSp(nameSpPtr, interp)
+ TixItclNameSp * nameSpPtr;
+ Tcl_Interp * interp;
+{
+ nameSpPtr->savedVarFramePtr = nameSpPtr->iPtr->varFramePtr;
+ nameSpPtr->iPtr->varFramePtr = NULL;
+ return 1;
+}
+
+/*----------------------------------------------------------------------
+ * TixItclRestoreGlobalNameSp --
+ *
+ * Set the ITcl scope to the scope saved by TixItclSetGlobalNameSp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TixItclRestoreGlobalNameSp(nameSpPtr, interp)
+ TixItclNameSp * nameSpPtr;
+ Tcl_Interp * interp;
+{
+ nameSpPtr->iPtr->varFramePtr = nameSpPtr->savedVarFramePtr;
+}
+
+#else
+#ifdef ITCL_2
+
+
+/*----------------------------------------------------------------------
+ * TixItclSetGlobalNameSp --
+ *
+ * Set the ITcl scope to the global scope. This way, all the Tix
+ * commands and variables will be defined in the global scope. This
+ * is necessary for Tix to function properly under ITcl.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TixItclSetGlobalNameSp(nameSpPtr, interp)
+ TixItclNameSp * nameSpPtr;
+ Tcl_Interp * interp;
+{
+ nameSpPtr->savedVarFramePtr = nameSpPtr->iPtr->varFramePtr;
+ nameSpPtr->iPtr->varFramePtr = NULL;
+
+ nameSpPtr->nsToken = Itcl_ActivateNamesp(interp,
+ (Itcl_Namespace)(nameSpPtr->iPtr->globalNs));
+ if (nameSpPtr->nsToken == NULL) {
+ return 0;
+ } else {
+ return 1;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * TixItclRestoreGlobalNameSp --
+ *
+ * Set the ITcl scope to the scope saved by TixItclSetGlobalNameSp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TixItclRestoreGlobalNameSp(nameSpPtr, interp)
+ TixItclNameSp * nameSpPtr;
+ Tcl_Interp * interp;
+{
+ if (nameSpPtr->nsToken != NULL) {
+ Itcl_DeactivateNamesp(interp, nameSpPtr->nsToken);
+ }
+ nameSpPtr->iPtr->varFramePtr = nameSpPtr->savedVarFramePtr;
+}
+
+#else
+/*
+ * Put a dummy symbol here -- some linkers do not like a .o file
+ * with no code and symbols.
+ */
+
+EXTERN void TixItclDummy _ANSI_ARGS_((void));
+
+
+void
+TixItclDummy()
+{
+}
+
+#endif /* #ifdef ITCL_2 */
+#endif /* #ifdef TK_8_0_OR_LATER */
diff --git a/tix/generic/tixItcl.h b/tix/generic/tixItcl.h
new file mode 100644
index 00000000000..57c83d1cb33
--- /dev/null
+++ b/tix/generic/tixItcl.h
@@ -0,0 +1,78 @@
+/*
+ * tixItcl.h --
+ *
+ * Compatibility functions and macros that allow Tix to work
+ * under Incr Tcl.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and
+ * redistribution of this file, and for a DISCLAIMER OF ALL
+ * WARRANTIES.
+ *
+ */
+
+/*
+ * With Tcl 8.0, namespaces moved from Itcl to Tcl, and so
+ * the Tix hacks have to be used in any verison of 8.0,
+ * regardless of the presence of Itcl...
+ */
+
+#include "tix.h"
+#ifdef TK_8_0_OR_LATER
+
+#ifndef _TCLINT
+#include <tclInt.h>
+#endif
+
+/*
+ * Structure to store Tcl 8.0 name space information.
+ */
+
+typedef struct _TixItclNameSp {
+ Interp *iPtr;
+ CallFrame *savedVarFramePtr;
+} TixItclNameSp;
+
+#define DECLARE_ITCL_NAMESP(x,i) \
+ TixItclNameSp x; \
+ x.iPtr = (Interp*)(i);
+
+EXTERN int TixItclSetGlobalNameSp _ANSI_ARGS_((
+ TixItclNameSp * nameSpPtr, Tcl_Interp * interp));
+EXTERN void TixItclRestoreGlobalNameSp _ANSI_ARGS_((
+ TixItclNameSp * nameSpPtr, Tcl_Interp * interp));
+
+#else
+#ifdef ITCL_2
+
+#ifndef _TCLINT
+#include <tclInt.h>
+#endif
+/*
+ * Structure to store ITcl name space information.
+ */
+typedef struct _TixItclNameSp {
+ Interp *iPtr;
+ CallFrame *savedVarFramePtr;
+ Itcl_ActiveNamespace nsToken;
+} TixItclNameSp;
+
+#define DECLARE_ITCL_NAMESP(x,i) \
+ TixItclNameSp x; \
+ x.iPtr = (Interp*)(i); \
+ x.nsToken = NULL;
+
+EXTERN int TixItclSetGlobalNameSp _ANSI_ARGS_((
+ TixItclNameSp * nameSpPtr, Tcl_Interp * interp));
+EXTERN void TixItclRestoreGlobalNameSp _ANSI_ARGS_((
+ TixItclNameSp * nameSpPtr, Tcl_Interp * interp));
+
+#else
+
+#define DECLARE_ITCL_NAMESP(x,i)
+#define TixItclSetGlobalNameSp(a,b) (1)
+#define TixItclRestoreGlobalNameSp(a,b)
+
+#endif /* ITCL_2 */
+#endif /* TK_8_0_OR_LATER */
diff --git a/tix/generic/tixList.c b/tix/generic/tixList.c
new file mode 100644
index 00000000000..5c5345e238c
--- /dev/null
+++ b/tix/generic/tixList.c
@@ -0,0 +1,316 @@
+/*
+ * tixList.c --
+ *
+ * Implements easy-to-use link lists.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+#include <tixPort.h>
+#include <tixInt.h>
+
+#define NEXT(info,ptr) (char*)(*(char**)((ptr+(info->nextOffset))))
+#define PREV(info,ptr) (char*)(*(char**)((ptr+(info->prevOffset))))
+
+static void SetNext _ANSI_ARGS_((Tix_ListInfo * info,
+ char * ptr, char * next));
+
+static void SetNext(info, ptr, next)
+ Tix_ListInfo * info;
+ char * ptr;
+ char * next;
+{
+ char ** next_ptr = (char**)((ptr+(info->nextOffset)));
+ * next_ptr = next;
+}
+
+void Tix_LinkListInit(lPtr)
+ Tix_LinkList * lPtr;
+{
+ lPtr->numItems = 0;
+ lPtr->head = (char*)NULL;
+ lPtr->tail = (char*)NULL;
+}
+
+
+void
+Tix_LinkListAppend(infoPtr, lPtr, itemPtr, flags)
+ Tix_ListInfo * infoPtr;
+ Tix_LinkList * lPtr;
+ char * itemPtr;
+ int flags;
+{
+ char * ptr;
+
+ if (flags | TIX_UNIQUE) {
+ /* Check for uniqueness */
+ for (ptr=lPtr->head;
+ ptr!=NULL;
+ ptr=NEXT(infoPtr,ptr)) {
+ if (ptr == itemPtr) {
+ return;
+ }
+ }
+ }
+ if (lPtr->head == NULL) {
+ lPtr->head = lPtr->tail = itemPtr;
+ } else {
+ SetNext(infoPtr, lPtr->tail, itemPtr);
+ lPtr->tail = itemPtr;
+ }
+
+ SetNext(infoPtr, itemPtr, NULL);
+ ++ lPtr->numItems;
+}
+
+void Tix_LinkListIteratorInit(liPtr)
+ Tix_ListIterator * liPtr;
+{
+ liPtr->started = 0;
+}
+
+void Tix_LinkListStart(infoPtr, lPtr, liPtr)
+ Tix_ListInfo * infoPtr;
+ Tix_LinkList * lPtr;
+ Tix_ListIterator * liPtr;
+{
+ if (lPtr->head == NULL) {
+ liPtr->last = NULL;
+ liPtr->curr = NULL;
+ } else {
+ liPtr->last = liPtr->curr = lPtr->head;
+ }
+ liPtr->deleted = 0;
+ liPtr->started = 1;
+}
+
+void Tix_LinkListNext(infoPtr, lPtr, liPtr)
+ Tix_ListInfo * infoPtr;
+ Tix_LinkList * lPtr;
+ Tix_ListIterator * liPtr;
+{
+ if (liPtr->curr == NULL) {
+ return;
+ }
+ if (liPtr->deleted == 1) {
+ /* the curr pointer has already been adjusted */
+ liPtr->deleted = 0;
+ return;
+ }
+
+ liPtr->last = liPtr->curr;
+ liPtr->curr = NEXT(infoPtr, liPtr->curr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ * Tix_LinkListDelete --
+ *
+ * Deletes an element from the linklist. The proper step of deleting
+ * an element is:
+ *
+ * for (Tix_SimpleListStart(&list, &li); !Tix_SimpleListDone(&li);
+ * Tix_SimpleListNext (&list, &li)) {
+ * MyData * p = (MyData*)li.curr;
+ * if (someCondition) {
+ * Tix_SimpleListDelete(&cPtr->subWDefs, &li);
+ * ckfree((char*)p);
+ * }
+ * }
+ *
+ * i.e., The pointer can be freed only after Tix_SimpleListDelete().
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The pointers in the list are adjusted and the liPtr is advanced
+ * to the next element.
+ *----------------------------------------------------------------------
+ */
+void
+Tix_LinkListDelete(infoPtr, lPtr, liPtr)
+ Tix_ListInfo * infoPtr;
+ Tix_LinkList * lPtr;
+ Tix_ListIterator * liPtr;
+{
+ if (liPtr->curr == NULL) {
+ /* %% probably is a mistake */
+ return;
+ }
+ if (liPtr->deleted == 1) {
+ /* %% probably is a mistake */
+ return;
+ }
+ if (lPtr->head == lPtr->tail) {
+ lPtr->head = lPtr->tail = NULL;
+ liPtr->curr = NULL;
+ }
+ else if (lPtr->head == liPtr->curr) {
+ lPtr->head = NEXT(infoPtr, liPtr->curr);
+ liPtr->curr = lPtr->head;
+ liPtr->last = lPtr->head;
+ }
+ else if (lPtr->tail == liPtr->curr) {
+ lPtr->tail = liPtr->last;
+ SetNext(infoPtr, lPtr->tail, NULL);
+ liPtr->curr = NULL;
+ }
+ else {
+ SetNext(infoPtr, liPtr->last, NEXT(infoPtr, liPtr->curr));
+ liPtr->curr = NEXT(infoPtr, liPtr->last);
+ }
+ -- lPtr->numItems;
+
+ liPtr->deleted = 1;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_LinkListInsert --
+ *
+ * Insert the item at the position indicated by liPtr
+ *----------------------------------------------------------------------
+ */
+void Tix_LinkListInsert(infoPtr, lPtr, itemPtr, liPtr)
+ Tix_ListInfo * infoPtr;
+ Tix_LinkList * lPtr;
+ char * itemPtr;
+ Tix_ListIterator * liPtr;
+{
+ if (lPtr->numItems == 0) {
+ /* Just do an append
+ */
+ Tix_LinkListAppend(infoPtr, lPtr, itemPtr, 0);
+
+ /* Fix the iterator (%% I am not sure if this is necessary)
+ */
+ liPtr->curr = liPtr->last = lPtr->head;
+ return;
+ }
+
+ if (liPtr->curr == NULL) {
+ /* %% probably is a mistake */
+ return;
+ }
+ if (lPtr->head == lPtr->tail) {
+ lPtr->head = itemPtr;
+ SetNext(infoPtr, lPtr->head, lPtr->tail);
+ liPtr->last = itemPtr;
+ liPtr->curr = itemPtr;
+ }
+ else if (liPtr->curr == lPtr->head) {
+ lPtr->head = itemPtr;
+ SetNext(infoPtr, lPtr->head, liPtr->curr);
+ liPtr->last = itemPtr;
+ liPtr->curr = itemPtr;
+ }
+ else {
+ SetNext(infoPtr, liPtr->last, itemPtr);
+ SetNext(infoPtr, itemPtr, liPtr->curr);
+ liPtr->last = itemPtr;
+ }
+ ++ lPtr->numItems;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_LinkListFindAndDelete --
+ *
+ * Find an element and delete it.
+ *
+ * liPtr:
+ * Can be NULL.
+ * If non-NULL, the search will start from the current entry indexed
+ * by liPtr;
+ *
+ * Return value:
+ * 1 if element is found and deleted
+ * 0 if element is not found
+ *----------------------------------------------------------------------
+ */
+int Tix_LinkListFindAndDelete(infoPtr, lPtr, itemPtr, liPtr)
+ Tix_ListInfo * infoPtr;
+ Tix_LinkList * lPtr;
+ char * itemPtr;
+ Tix_ListIterator * liPtr;
+{
+ Tix_ListIterator defIterator;
+
+ if (liPtr == NULL) {
+ Tix_LinkListIteratorInit(&defIterator);
+ liPtr = &defIterator;
+ }
+
+ if (!liPtr->started) {
+ Tix_LinkListStart(infoPtr, lPtr, liPtr);
+ }
+
+ if (Tix_LinkListFind(infoPtr, lPtr, itemPtr, liPtr)) {
+ Tix_LinkListDelete(infoPtr, lPtr, liPtr);
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+int Tix_LinkListDeleteRange(infoPtr, lPtr, fromPtr, toPtr, liPtr)
+ Tix_ListInfo * infoPtr;
+ Tix_LinkList * lPtr;
+ char * fromPtr;
+ char * toPtr;
+ Tix_ListIterator * liPtr;
+{
+ Tix_ListIterator defIterator;
+ int start = 0;
+ int deleted = 0;
+
+ if (liPtr == NULL) {
+ Tix_LinkListIteratorInit(&defIterator);
+ liPtr = &defIterator;
+ }
+ if (!liPtr->started) {
+ Tix_LinkListStart(infoPtr, lPtr, liPtr);
+ }
+
+ for (;
+ !Tix_LinkListDone(liPtr);
+ Tix_LinkListNext (infoPtr, lPtr, liPtr)) {
+
+ if (liPtr->curr == fromPtr) {
+ start = 1;
+ }
+ if (start) {
+ Tix_LinkListDelete(infoPtr, lPtr, liPtr);
+ ++ deleted;
+ }
+ if (liPtr->curr == toPtr) {
+ break;
+ }
+ }
+
+ return deleted;
+}
+
+int Tix_LinkListFind(infoPtr, lPtr, itemPtr, liPtr)
+ Tix_ListInfo * infoPtr;
+ Tix_LinkList * lPtr;
+ char * itemPtr;
+ Tix_ListIterator * liPtr;
+{
+ if (!liPtr->started) {
+ Tix_LinkListStart(infoPtr, lPtr, liPtr);
+ }
+
+ for (Tix_LinkListStart(infoPtr, lPtr, liPtr);
+ !Tix_LinkListDone(liPtr);
+ Tix_LinkListNext (infoPtr, lPtr, liPtr)) {
+
+ if (liPtr->curr == itemPtr) {
+ return 1; /* found! */
+ }
+ }
+
+ return 0; /* Can't find */
+}
diff --git a/tix/generic/tixMethod.c b/tix/generic/tixMethod.c
new file mode 100644
index 00000000000..e09d5f371c8
--- /dev/null
+++ b/tix/generic/tixMethod.c
@@ -0,0 +1,604 @@
+/*
+ * tixMethod.c --
+ *
+ * Handle the calling of class methods.
+ *
+ * Implements the basic OOP class mechanism for the Tix Intrinsics.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+
+/* ToDo:
+ *
+ * 1) Tix_CallMethod() needs to be re-written
+ *
+ */
+#include <tclInt.h>
+#include <tk.h>
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixItcl.h>
+
+#define GetMethodTable(interp) (_TixGetHashTable(interp, "tixMethodTab", MethodTableDeleteProc))
+
+static int Tix_CallMethodByContext _ANSI_ARGS_((
+ Tcl_Interp * interp, char * context,
+ char * widRec, char * method, int argc,
+ char ** argv));
+static void Tix_RestoreContext _ANSI_ARGS_((
+ Tcl_Interp * interp, char * widRec,
+ char * oldContext));
+static void Tix_SetContext _ANSI_ARGS_((
+ Tcl_Interp * interp, char * widRec,
+ char * newContext));
+static char * Tix_SaveContext _ANSI_ARGS_((Tcl_Interp * interp,
+ char * widRec));
+static void MethodTableDeleteProc _ANSI_ARGS_((
+ ClientData clientData, Tcl_Interp *interp));
+
+/*
+ *
+ * argv[1] = widget record
+ * argv[2] = method
+ * argv[3+] = args
+ *
+ */
+TIX_DEFINE_CMD(Tix_CallMethodCmd)
+{
+ char * context;
+ char * newContext;
+ char * widRec = argv[1];
+ char * method = argv[2];
+ int result;
+
+ if (argc<3) {
+ return Tix_ArgcError(interp, argc, argv, 1, "w method ...");
+ }
+
+ if ((context = GET_RECORD(interp, widRec, "className")) == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "invalid object reference \"", widRec,
+ "\"", (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ newContext = Tix_FindMethod(interp, context, method);
+
+ if (newContext) {
+ result = Tix_CallMethodByContext(interp, newContext, widRec, method,
+ argc-3, argv+3);
+ } else {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "cannot call method \"", method,
+ "\" for context \"", context, "\".", (char*)NULL);
+ Tcl_SetVar(interp, "errorInfo", interp->result, TCL_GLOBAL_ONLY);
+ result = TCL_ERROR;
+ }
+
+ return result;
+}
+
+/*
+ *
+ * argv[1] = widget record
+ * argv[2] = method
+ * argv[3+] = args
+ *
+ */
+TIX_DEFINE_CMD(Tix_ChainMethodCmd)
+{
+ char * context;
+ char * superClassContext;
+ char * newContext;
+ char * widRec = argv[1];
+ char * method = argv[2];
+ int result;
+
+ if (argc<3) {
+ return Tix_ArgcError(interp, argc, argv, 1, "w method ...");
+ }
+
+ if ((context = Tix_GetContext(interp, widRec)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (Tix_SuperClass(interp, context, &superClassContext) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (superClassContext == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "no superclass exists for context \"",
+ context, "\".", (char*)NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ newContext = Tix_FindMethod(interp, superClassContext, method);
+
+ if (newContext) {
+ result = Tix_CallMethodByContext(interp, newContext, widRec,
+ method, argc-3, argv+3);
+ } else {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "cannot chain method \"", method,
+ "\" for context \"", context, "\".", (char*)NULL);
+ Tcl_SetVar(interp, "errorInfo", interp->result, TCL_GLOBAL_ONLY);
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ done:
+ return result;
+}
+
+/*
+ *
+ * argv[1] = widget record
+ * argv[2] = class (context)
+ * argv[3] = method
+ *
+ */
+TIX_DEFINE_CMD(Tix_GetMethodCmd)
+{
+ char * newContext;
+ char * context= argv[2];
+ char * method = argv[3];
+ char * cmdName;
+
+ if (argc!=4) {
+ return Tix_ArgcError(interp, argc, argv, 1, "w class method");
+ }
+
+ newContext = Tix_FindMethod(interp, context, method);
+
+ if (newContext) {
+ cmdName = Tix_GetMethodFullName(newContext, method);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, cmdName, NULL);
+ ckfree(cmdName);
+ } else {
+ Tcl_SetResult(interp, "", TCL_STATIC);
+ }
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_FindMethod
+ *
+ * Starting with class "context", find the first class that defines
+ * the method. This class must be the same as the class "context" or
+ * a superclass of the class "context".
+ */
+char *
+Tix_FindMethod(interp, context, method)
+ Tcl_Interp * interp;
+ char * context;
+ char * method;
+{
+ char * theContext;
+ int isNew;
+ char * key;
+ Tcl_HashEntry *hashPtr;
+
+ key = Tix_GetMethodFullName(context, method);
+ hashPtr = Tcl_CreateHashEntry(GetMethodTable(interp), key, &isNew);
+ ckfree(key);
+
+ if (!isNew) {
+ theContext = (char *) Tcl_GetHashValue(hashPtr);
+ } else {
+ for (theContext = context; theContext;) {
+ if (Tix_ExistMethod(interp, theContext, method)) {
+ break;
+ }
+ /* Go to its superclass and see if it has the method */
+ if (Tix_SuperClass(interp, theContext, &theContext) != TCL_OK) {
+ return NULL;
+ }
+ if (theContext == NULL) {
+ return NULL;
+ }
+ }
+
+ if (theContext != NULL) {
+ /*
+ * theContext may point to the stack. We have to put it
+ * in some more permanent place.
+ */
+ theContext = (char*)tixStrDup(theContext);
+ }
+ Tcl_SetHashValue(hashPtr, (char*)theContext);
+ }
+
+ return theContext;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_CallMethod
+ *
+ * Starting with class "context", find the first class that defines
+ * the method. Call this method.
+ */
+int Tix_CallMethod(interp, context, widRec, method, argc, argv)
+ Tcl_Interp * interp;
+ char * context;
+ char * widRec;
+ char * method;
+ int argc;
+ char ** argv;
+{
+ char * targetContext;
+
+ targetContext = Tix_FindMethod(interp, context, method);
+ if (targetContext != NULL) {
+ return Tix_CallMethodByContext(interp, targetContext, widRec, method,
+ argc, argv);
+ }
+ else {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "cannot call method \"", method,
+ "\" for context \"", context, "\".", (char*)NULL);
+ Tcl_SetVar(interp, "errorInfo", interp->result, TCL_GLOBAL_ONLY);
+ return TCL_ERROR;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * Tix_FindConfigSpec
+ *
+ * Starting with class "classRec", find the first class that defines
+ * the option flag. This class must be the same as the class "classRec" or
+ * a superclass of the class "classRec".
+ */
+
+/* save the old context: calling a method of a superclass will
+ * change the context of a widget.
+ */
+static char * Tix_SaveContext(interp, widRec)
+ Tcl_Interp * interp;
+ char * widRec;
+{
+ char * context;
+
+ if ((context = GET_RECORD(interp, widRec, "context")) == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "invalid object reference \"", widRec,
+ "\"", (char*)NULL);
+ return NULL;
+ }
+ else {
+ return (char*)tixStrDup(context);
+ }
+}
+
+static void Tix_RestoreContext(interp, widRec, oldContext)
+ Tcl_Interp * interp;
+ char * widRec;
+ char * oldContext;
+{
+ SET_RECORD(interp, widRec, "context", oldContext);
+ ckfree(oldContext);
+}
+
+static void Tix_SetContext(interp, widRec, newContext)
+ Tcl_Interp * interp;
+ char * widRec;
+ char * newContext;
+{
+ SET_RECORD(interp, widRec, "context", newContext);
+}
+
+
+char * Tix_GetContext(interp, widRec)
+ Tcl_Interp * interp;
+ char * widRec;
+{
+ char * context;
+
+ if ((context = GET_RECORD(interp, widRec, "context")) == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "invalid object reference \"", widRec,
+ "\"", (char*)NULL);
+ return NULL;
+ } else {
+ return context;
+ }
+}
+
+int Tix_SuperClass(interp, class, superClass_ret)
+ Tcl_Interp * interp;
+ char * class;
+ char ** superClass_ret;
+{
+ char * superclass;
+
+ if ((superclass = GET_RECORD(interp, class, "superClass")) == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "invalid class \"", class,
+ "\"; ", (char*)NULL);
+ return TCL_ERROR;
+ }
+
+ if (strlen(superclass) == 0) {
+ *superClass_ret = (char*) NULL;
+ } else {
+ *superClass_ret = superclass;
+ }
+
+ return TCL_OK;
+}
+
+char * Tix_GetMethodFullName(context, method)
+ char * context;
+ char * method;
+{
+ char * buff;
+ int max;
+ int conLen;
+
+ conLen = strlen(context);
+ max = conLen + strlen(method) + 3;
+ buff = (char*)ckalloc(max * sizeof(char));
+
+ strcpy(buff, context);
+ strcpy(buff+conLen, ":");
+ strcpy(buff+conLen+1, method);
+
+ return buff;
+}
+
+#undef ITCL_2
+
+#if !defined(ITCL_2) && !defined(TK_8_0_OR_LATER)
+
+#define Tix_GetCommandInfo Tcl_GetCommandInfo
+
+#else
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tix_GetCommandInfo --
+ *
+ * Returns various information about a Tcl command. Modified from
+ * Tcl_GetCommandInfo to work with ITcl 2.0. Always work in the global
+ * name space.
+ *
+ * Results:
+ * If cmdName exists in interp, then *infoPtr is modified to
+ * hold information about cmdName and 1 is returned. If the
+ * command doesn't exist then 0 is returned and *infoPtr isn't
+ * modified.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+int Tix_GetCommandInfo(interp, cmdName, infoPtr)
+ Tcl_Interp *interp;
+ char *cmdName;
+ Tcl_CmdInfo *infoPtr;
+{
+ register Interp *iPtr = (Interp *) interp;
+ int result;
+ DECLARE_ITCL_NAMESP(nameSp, interp);
+
+ result = TixItclSetGlobalNameSp(&nameSp, interp);
+
+ if (result != 0) {
+ result = Tcl_GetCommandInfo(interp, cmdName, infoPtr);
+ }
+
+ TixItclRestoreGlobalNameSp(&nameSp, interp);
+ return result;
+}
+#endif
+
+int Tix_ExistMethod(interp, context, method)
+ Tcl_Interp * interp;
+ char * context;
+ char * method;
+{
+ char * cmdName;
+ Tcl_CmdInfo dummy;
+ int exist;
+
+ cmdName = Tix_GetMethodFullName(context, method);
+ exist = Tix_GetCommandInfo(interp, cmdName, &dummy);
+
+ if (!exist) {
+ if (Tix_GlobalVarEval(interp, "auto_load ", cmdName,
+ (char*)NULL)!= TCL_OK) {
+ goto done;
+ }
+ if (strcmp(interp->result, "1") == 0) {
+ exist = 1;
+ }
+ }
+
+ done:
+ ckfree(cmdName);
+ Tcl_SetResult(interp, NULL, TCL_STATIC);
+ return exist;
+}
+
+/* %% There is a dirty version that uses the old argv, without having to
+ * malloc a new argv.
+ */
+static int Tix_CallMethodByContext(interp, context, widRec, method, argc, argv)
+ Tcl_Interp * interp;
+ char * context;
+ char * widRec;
+ char * method;
+ int argc;
+ char ** argv;
+{
+ char * cmdName;
+ int i, result;
+ char * oldContext;
+ char ** newArgv;
+
+ if ((oldContext = Tix_SaveContext(interp, widRec)) == NULL) {
+ return TCL_ERROR;
+ }
+ Tix_SetContext(interp, widRec, context);
+
+ cmdName = Tix_GetMethodFullName(context, method);
+
+ /* Create a new argv list */
+ newArgv = (char**)ckalloc((argc+2)*sizeof(char*));
+ newArgv[0] = cmdName;
+ newArgv[1] = widRec;
+ for (i=0; i< argc; i++) {
+ newArgv[i+2] = argv[i];
+ }
+ result = Tix_EvalArgv(interp, argc+2, newArgv);
+
+ Tix_RestoreContext(interp, widRec, oldContext);
+ ckfree((char*)newArgv);
+ ckfree(cmdName);
+
+ return result;
+}
+
+#ifndef ITCL_2
+
+#define Tix_GlobalEvalArgv(interp, cmdInfoPtr, argc, argv) \
+ (*(cmdInfoPtr)->proc)((cmdInfoPtr)->clientData, interp, argc, argv)
+
+#else
+
+EXTERN int Tix_GlobalEvalArgv _ANSI_ARGS_((Tcl_Interp * interp,
+ Tcl_CmdInfo * cmdInfoPtr, int argc));
+
+int
+Tix_GlobalEvalArgv(interp, cmdInfoPtr, argc, argv)
+ Tcl_Interp * interp;
+ Tcl_CmdInfo * cmdInfoPtr;
+ int argc;
+ char ** argv;
+{
+ register Interp *iPtr = (Interp *) interp;
+ int result;
+ CallFrame *savedVarFramePtr;
+ Itcl_ActiveNamespace nsToken;
+
+ savedVarFramePtr = iPtr->varFramePtr;
+ iPtr->varFramePtr = NULL;
+
+ nsToken = Itcl_ActivateNamesp(interp, (Itcl_Namespace)iPtr->globalNs);
+ if (nsToken == NULL) {
+ result = TCL_ERROR;
+ }
+ else {
+ result = (*cmdInfoPtr->proc)(cmdInfoPtr->clientData,interp,argc,argv);
+ Itcl_DeactivateNamesp(interp, nsToken);
+ }
+
+ iPtr->varFramePtr = savedVarFramePtr;
+ return result;
+}
+#endif /* ITCL_2 */
+
+int Tix_EvalArgv(interp, argc, argv)
+ Tcl_Interp * interp;
+ int argc;
+ char ** argv;
+{
+ Tcl_CmdInfo cmdInfo;
+
+ if (!Tix_GetCommandInfo(interp, argv[0], &cmdInfo)) {
+ char * cmdArgv[2];
+
+ /*
+ * This comand is not defined yet -- looks like we have to auto-load it
+ */
+ if (!Tix_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] = argv[0];
+
+ if ((*cmdInfo.proc)(cmdInfo.clientData, interp, 2, cmdArgv)!= TCL_OK){
+ return TCL_ERROR;
+ }
+
+ if (!Tix_GetCommandInfo(interp, argv[0], &cmdInfo)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "cannot autoload command \"",
+ argv[0], "\"",NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ return Tix_GlobalEvalArgv(interp, &cmdInfo, argc, argv);
+}
+
+char *
+Tix_FindPublicMethod(interp, cPtr, method)
+ Tcl_Interp * interp;
+ TixClassRecord * cPtr;
+ char * method;
+{
+ int i;
+ int len = strlen(method);
+
+ for (i=0; i<cPtr->nMethods; i++) {
+ if (cPtr->methods[i][0] == method[0] &&
+ strncmp(cPtr->methods[i], method, len)==0) {
+ return cPtr->methods[i];
+ }
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ * MethodTableDeleteProc --
+ *
+ * This procedure is called when the interp is about to
+ * be deleted. It cleans up the hash entries and destroys the hash
+ * table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All class method contexts are deleted for this interpreter.
+ *----------------------------------------------------------------------
+ */
+
+static void
+MethodTableDeleteProc(clientData, interp)
+ ClientData clientData;
+ Tcl_Interp *interp;
+{
+ Tcl_HashTable * methodTablePtr = (Tcl_HashTable*)clientData;
+ Tcl_HashSearch hashSearch;
+ Tcl_HashEntry *hashPtr;
+ char * context;
+
+ for (hashPtr = Tcl_FirstHashEntry(methodTablePtr, &hashSearch);
+ hashPtr;
+ hashPtr = Tcl_NextHashEntry(&hashSearch)) {
+
+ context = (char*)Tcl_GetHashValue(hashPtr);
+ if (context) {
+ ckfree(context);
+ }
+ Tcl_DeleteHashEntry(hashPtr);
+ }
+ Tcl_DeleteHashTable(methodTablePtr);
+ ckfree((char*)methodTablePtr);
+}
diff --git a/tix/generic/tixMwm.c b/tix/generic/tixMwm.c
new file mode 100644
index 00000000000..b98e2c9bd28
--- /dev/null
+++ b/tix/generic/tixMwm.c
@@ -0,0 +1,905 @@
+/*
+ * tixMwm.c --
+ *
+ * Communicating with the Motif window manager.
+ *
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tkInt.h>
+#include <tixPort.h>
+#include <tixInt.h>
+#include <X11/Xlib.h>
+#include <X11/Xatom.h>
+#include <X11/Xproto.h>
+#include <X11/Xutil.h>
+
+
+#ifdef HAS_MOTIF_INC
+#include <Xm/MwmUtil.h>
+#else
+
+/*
+ * This section is provided for the machines that don't have the Motif
+ * header files installed.
+ */
+
+#define MWM_DECOR_ALL (1L << 0)
+#define MWM_DECOR_BORDER (1L << 1)
+#define MWM_DECOR_RESIZEH (1L << 2)
+#define MWM_DECOR_TITLE (1L << 3)
+#define MWM_DECOR_MENU (1L << 4)
+#define MWM_DECOR_MINIMIZE (1L << 5)
+#define MWM_DECOR_MAXIMIZE (1L << 6)
+
+#define MWM_HINTS_DECORATIONS (1L << 1)
+
+#define PROP_MOTIF_WM_HINTS_ELEMENTS 5
+#define PROP_MWM_HINTS_ELEMENTS PROP_MOTIF_WM_HINTS_ELEMENTS
+
+/* atom name for _MWM_HINTS property */
+#define _XA_MOTIF_WM_HINTS "_MOTIF_WM_HINTS"
+#define _XA_MWM_HINTS _XA_MOTIF_WM_HINTS
+
+#define _XA_MOTIF_WM_MENU "_MOTIF_WM_MENU"
+#define _XA_MWM_MENU _XA_MOTIF_WM_MENU
+
+#define _XA_MOTIF_WM_INFO "_MOTIF_WM_INFO"
+#define _XA_MWM_INFO _XA_MOTIF_WM_INFO
+
+#define PROP_MOTIF_WM_INFO_ELEMENTS 2
+#define PROP_MWM_INFO_ELEMENTS PROP_MOTIF_WM_INFO_ELEMENTS
+
+typedef struct
+{
+ CARD32 flags;
+ CARD32 functions;
+ CARD32 decorations;
+ INT32 inputMode;
+ CARD32 status;
+} PropMotifWmHints;
+
+typedef PropMotifWmHints PropMwmHints;
+
+typedef struct
+{
+ CARD32 flags;
+ CARD32 wmWindow;
+} PropMotifWmInfo;
+
+typedef PropMotifWmInfo PropMwmInfo;
+
+#endif /* HAS_MOTIF_INC */
+
+#define MWM_DECOR_UNKNOWN (-1)
+#define MWM_DECOR_EVERYTHING (MWM_DECOR_BORDER |\
+ MWM_DECOR_RESIZEH |\
+ MWM_DECOR_TITLE |\
+ MWM_DECOR_MENU |\
+ MWM_DECOR_MINIMIZE |\
+ MWM_DECOR_MAXIMIZE)
+
+typedef struct _Tix_MwmInfo {
+ Tcl_Interp * interp;
+ Tk_Window tkwin;
+ PropMwmHints prop; /* not used */
+ Atom mwm_hints_atom;
+ Tcl_HashTable protocols;
+ unsigned int isremapping : 1;
+ unsigned int resetProtocol : 1;
+ unsigned int addedMwmMsg : 1;
+} Tix_MwmInfo;
+
+typedef struct Tix_MwmProtocol {
+ Atom protocol;
+ char * name;
+ char * menuMessage;
+ size_t messageLen;
+ unsigned int active : 1;
+} Tix_MwmProtocol;
+
+
+/* Function declaration */
+
+static void AddMwmProtocol _ANSI_ARGS_((Tcl_Interp *interp,
+ Tix_MwmInfo *wmPtr, char * name, char * message));
+static void ActivateMwmProtocol _ANSI_ARGS_((Tcl_Interp *interp,
+ Tix_MwmInfo *wmPtr, char * name));
+static void DeactivateMwmProtocol _ANSI_ARGS_((Tcl_Interp *interp,
+ Tix_MwmInfo *wmPtr, char * name));
+static void DeleteMwmProtocol _ANSI_ARGS_((Tcl_Interp *interp,
+ Tix_MwmInfo *wmPtr, char * name));
+static Tix_MwmInfo * GetMwmInfo _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin));
+static Tix_MwmProtocol* GetMwmProtocol _ANSI_ARGS_((Tcl_Interp * interp,
+ Tix_MwmInfo * wmPtr, Atom protocol));
+static int IsMwmRunning _ANSI_ARGS_((Tcl_Interp * interp,
+ Tix_MwmInfo*wmPtr));
+static int MwmDecor _ANSI_ARGS_((Tcl_Interp * interp,
+ char * string));
+static int MwmProtocol _ANSI_ARGS_((Tcl_Interp * interp,
+ Tix_MwmInfo * wmPtr, int argc, char ** argv));
+static void QueryMwmHints _ANSI_ARGS_((Tix_MwmInfo * wmPtr));
+static void RemapWindow _ANSI_ARGS_((ClientData clientData));
+static void RemapWindowWhenIdle _ANSI_ARGS_((
+ Tix_MwmInfo * wmPtr));
+static void ResetProtocols _ANSI_ARGS_((ClientData clientData));
+static void ResetProtocolsWhenIdle _ANSI_ARGS_((
+ Tix_MwmInfo * wmPtr));
+static int SetMwmDecorations _ANSI_ARGS_((Tcl_Interp *interp,
+ Tix_MwmInfo*wmPtr, int argc, char ** argv));
+static int SetMwmTransientFor _ANSI_ARGS_((Tcl_Interp *interp,
+ Tix_MwmInfo*wmPtr, TkWindow *mainWindow, int argc,
+ char ** argv));
+static void StructureProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+
+/* Local variables */
+
+static Tcl_HashTable mwmTable;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tix_MwmCmd --
+ *
+ * This procedure is invoked to process the "mwm" 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
+Tix_MwmCmd(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;
+ char c;
+ size_t length;
+ Tix_MwmInfo * wmPtr;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option pathname ?arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[1][0];
+ length = strlen(argv[1]);
+
+ if (!(winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin))) {
+ return TCL_ERROR;
+ }
+ if (!Tk_IsTopLevel(winPtr)) {
+ Tcl_AppendResult(interp, argv[2], " is not a toplevel window.", NULL);
+ return TCL_ERROR;
+ }
+ if (!(wmPtr=GetMwmInfo(interp, (Tk_Window) winPtr))) {
+ return TCL_ERROR;
+ }
+
+ if ((c == 'd') && (strncmp(argv[1], "decorations", length) == 0)) {
+ return SetMwmDecorations(interp, wmPtr, argc-3, argv+3);
+ }
+ else if ((c == 'i') && (strncmp(argv[1], "ismwmrunning", length) == 0)) {
+ if (IsMwmRunning(interp, wmPtr)) {
+ Tcl_AppendResult(interp, "1", NULL);
+ } else {
+ Tcl_AppendResult(interp, "0", NULL);
+ }
+ return TCL_OK;
+ }
+ else if ((c == 'p') && (strncmp(argv[1], "protocol", length) == 0)) {
+ return MwmProtocol(interp, wmPtr, argc-3, argv+3);
+ }
+ else if ((c == 't') && (strncmp(argv[1], "transientfor", length) == 0)) {
+ return SetMwmTransientFor(interp, wmPtr, winPtr, argc-3, argv+3);
+ }
+ else {
+ Tcl_AppendResult(interp, "unknown or ambiguous option \"",
+ argv[1], "\": must be decorations, ismwmrunning, protocol ",
+ "or transientfor",
+ NULL);
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * TixMwmProtocolHandler --
+ *
+ * A generic X event handler that handles the events from the Mwm
+ * Window manager.
+ *
+ * Results:
+ * True iff the event has been handled.
+ *
+ * Side effects:
+ * None.
+ *----------------------------------------------------------------------
+ */
+
+int
+TixMwmProtocolHandler(clientData, eventPtr)
+ ClientData clientData;
+ XEvent *eventPtr;
+{
+ TkWindow *winPtr;
+ Window handlerWindow;
+
+ if (eventPtr->type != ClientMessage) {
+ return 0;
+ }
+
+ handlerWindow = eventPtr->xany.window;
+ winPtr = (TkWindow *) Tk_IdToWindow(eventPtr->xany.display, handlerWindow);
+ if (winPtr != NULL) {
+ if (eventPtr->xclient.message_type ==
+ Tk_InternAtom((Tk_Window) winPtr,"_MOTIF_WM_MESSAGES")) {
+ TkWmProtocolEventProc(winPtr, eventPtr);
+ return 1;
+ }
+ }
+ return 0;
+}
+
+static int
+MwmDecor(interp, string)
+ Tcl_Interp * interp;
+ char * string;
+{
+ size_t len = strlen(string);
+
+ if (strncmp(string, "-all", len) == 0) {
+ return MWM_DECOR_ALL;
+ } else if (strncmp(string, "-border", len) == 0) {
+ return MWM_DECOR_BORDER;
+ } else if (strncmp(string, "-resizeh", len) == 0) {
+ return MWM_DECOR_RESIZEH;
+ } else if (strncmp(string, "-title", len) == 0) {
+ return MWM_DECOR_TITLE;
+ } else if (strncmp(string, "-menu", len) == 0) {
+ return MWM_DECOR_MENU;
+ } else if (strncmp(string, "-minimize", len) == 0) {
+ return MWM_DECOR_MINIMIZE;
+ } else if (strncmp(string, "-maximize", len) == 0) {
+ return MWM_DECOR_MAXIMIZE;
+ } else {
+ Tcl_AppendResult(interp, "unknown decoration \"", string, "\"", NULL);
+ return -1;
+ }
+}
+
+
+static void
+QueryMwmHints(wmPtr)
+ Tix_MwmInfo * wmPtr;
+{
+ Atom actualType;
+ int actualFormat;
+ unsigned long numItems, bytesAfter;
+
+ wmPtr->prop.flags = MWM_HINTS_DECORATIONS;
+
+ if (XGetWindowProperty(Tk_Display(wmPtr->tkwin),Tk_WindowId(wmPtr->tkwin),
+ wmPtr->mwm_hints_atom, 0, PROP_MWM_HINTS_ELEMENTS,
+ False, wmPtr->mwm_hints_atom, &actualType, &actualFormat, &numItems,
+ &bytesAfter, (unsigned char **) & wmPtr->prop) == Success) {
+
+ if ((actualType != wmPtr->mwm_hints_atom) || (actualFormat != 32) ||
+ (numItems <= 0)) {
+ /* It looks like this window doesn't have a _XA_MWM_HINTS
+ * property. Let's give the default value
+ */
+ wmPtr->prop.decorations = MWM_DECOR_EVERYTHING;
+ }
+ } else {
+ /* We get an error somehow. Pretend that the decorations are all
+ */
+ wmPtr->prop.decorations = MWM_DECOR_EVERYTHING;
+ }
+}
+
+static void
+RemapWindow(clientData)
+ ClientData clientData;
+{
+ Tix_MwmInfo * wmPtr = (Tix_MwmInfo *)clientData;
+
+ Tk_UnmapWindow(wmPtr->tkwin);
+ Tk_MapWindow(wmPtr->tkwin);
+ wmPtr->isremapping = 0;
+}
+
+static void
+RemapWindowWhenIdle(wmPtr)
+ Tix_MwmInfo * wmPtr;
+{
+ if (!wmPtr->isremapping) {
+ wmPtr->isremapping = 1;
+ Tk_DoWhenIdle(RemapWindow, (ClientData)wmPtr);
+ }
+}
+
+/*
+ * SetMwmDecorations --
+ *
+ *
+ */
+static
+int SetMwmDecorations(interp, wmPtr, argc, argv)
+ Tcl_Interp *interp;
+ Tix_MwmInfo*wmPtr;
+ int argc;
+ char ** argv;
+{
+ int i;
+ int decor;
+ char buff[40];
+
+ if (argc == 0 || argc == 1) {
+ /*
+ * Query the existing settings
+ */
+ QueryMwmHints(wmPtr);
+
+ if (argc == 0) {
+ /*
+ * Query all hints
+ */
+ sprintf(buff, "-border %d",
+ ((wmPtr->prop.decorations & MWM_DECOR_BORDER)!=0));
+ Tcl_AppendElement(interp, buff);
+
+ sprintf(buff, "-resizeh %d",
+ ((wmPtr->prop.decorations &MWM_DECOR_RESIZEH)!=0));
+ Tcl_AppendElement(interp, buff);
+
+ sprintf(buff, "-title %d",
+ ((wmPtr->prop.decorations & MWM_DECOR_TITLE)!=0));
+ Tcl_AppendElement(interp, buff);
+
+ sprintf(buff, "-menu %d",
+ ((wmPtr->prop.decorations & MWM_DECOR_MENU)!=0));
+ Tcl_AppendElement(interp, buff);
+
+ sprintf(buff, "-minimize %d",
+ ((wmPtr->prop.decorations&MWM_DECOR_MINIMIZE)!=0));
+ Tcl_AppendElement(interp, buff);
+
+ sprintf(buff, "-maximize %d",
+ ((wmPtr->prop.decorations&MWM_DECOR_MAXIMIZE)!=0));
+ Tcl_AppendElement(interp, buff);
+
+ return TCL_OK;
+ } else {
+ /*
+ * Query only one hint
+ */
+ if ((decor = MwmDecor(interp, argv[0])) == MWM_DECOR_UNKNOWN) {
+ return TCL_ERROR;
+ }
+
+ if (wmPtr->prop.decorations & decor) {
+ Tcl_AppendResult(interp, "1", NULL);
+ } else {
+ Tcl_AppendResult(interp, "0", NULL);
+ }
+ return TCL_OK;
+ }
+ } else {
+ if (argc %2) {
+ Tcl_AppendResult(interp, "value missing for option \"",
+ argv[argc-1], "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ for (i=0; i<argc; i+=2) {
+ int value;
+
+ if ((decor = MwmDecor(interp, argv[i])) == MWM_DECOR_UNKNOWN) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_GetBoolean(interp, argv[i+1], &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (value) {
+ wmPtr->prop.decorations |= decor;
+ }
+ else {
+ wmPtr->prop.decorations &= ~decor;
+ }
+
+ if (decor == MWM_DECOR_ALL) {
+ if (value) {
+ wmPtr->prop.decorations |= MWM_DECOR_EVERYTHING;
+ } else {
+ wmPtr->prop.decorations &= ~MWM_DECOR_EVERYTHING;
+ }
+ }
+ }
+
+ wmPtr->prop.flags = MWM_HINTS_DECORATIONS;
+ XChangeProperty(Tk_Display(wmPtr->tkwin), Tk_WindowId(wmPtr->tkwin),
+ wmPtr->mwm_hints_atom, wmPtr->mwm_hints_atom, 32, PropModeReplace,
+ (unsigned char *) &wmPtr->prop, PROP_MWM_HINTS_ELEMENTS);
+
+ if (Tk_IsMapped(wmPtr->tkwin)) {
+ /* Needs unmap/map to refresh */
+ RemapWindowWhenIdle(wmPtr);
+ }
+ return TCL_OK;
+ }
+}
+
+static int MwmProtocol(interp, wmPtr, argc, argv)
+ Tcl_Interp * interp;
+ Tix_MwmInfo * wmPtr;
+ int argc;
+ char ** argv;
+{
+ size_t len;
+
+ if (argc == 0) {
+ Tcl_HashSearch hSearch;
+ Tcl_HashEntry * hashPtr;
+ Tix_MwmProtocol * ptPtr;
+
+ /* Iterate over all the entries in the hash table */
+ for (hashPtr = Tcl_FirstHashEntry(&wmPtr->protocols, &hSearch);
+ hashPtr;
+ hashPtr = Tcl_NextHashEntry(&hSearch)) {
+
+ ptPtr = (Tix_MwmProtocol *)Tcl_GetHashValue(hashPtr);
+ Tcl_AppendElement(interp, ptPtr->name);
+ }
+ return TCL_OK;
+ }
+
+ len = strlen(argv[0]);
+ if (strncmp(argv[0], "add", len) == 0 && argc == 3) {
+ AddMwmProtocol(interp, wmPtr, argv[1], argv[2]);
+ }
+ else if (strncmp(argv[0], "activate", len) == 0 && argc == 2) {
+ ActivateMwmProtocol(interp, wmPtr, argv[1]);
+ }
+ else if (strncmp(argv[0], "deactivate", len) == 0 && argc == 2) {
+ DeactivateMwmProtocol(interp, wmPtr, argv[1]);
+ }
+ else if (strncmp(argv[0], "delete", len) == 0 && argc == 2) {
+ DeleteMwmProtocol(interp, wmPtr, argv[1]);
+ }
+ else {
+ Tcl_AppendResult(interp, "unknown option \"", argv[0],
+ "\" should be add, activate, deactivate or delete", NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+
+static void AddMwmProtocol(interp, wmPtr, name, message)
+ Tcl_Interp *interp;
+ Tix_MwmInfo *wmPtr;
+ char * name;
+ char * message;
+{
+ Atom protocol;
+ Tix_MwmProtocol *ptPtr;
+
+ protocol = Tk_InternAtom(wmPtr->tkwin, name);
+ ptPtr = GetMwmProtocol(interp, wmPtr, protocol);
+
+ if (ptPtr->menuMessage != NULL) {
+ /* This may happen if "protocol add" called twice for the same name */
+ ckfree(ptPtr->menuMessage);
+ }
+
+ if (ptPtr->name == NULL) {
+ ptPtr->name = (char*)tixStrDup(name);
+ }
+ ptPtr->menuMessage = (char*)tixStrDup(message);
+ ptPtr->messageLen = strlen(message);
+ ptPtr->active = 1;
+
+ ResetProtocolsWhenIdle(wmPtr);
+}
+
+static void ActivateMwmProtocol(interp, wmPtr, name)
+ Tcl_Interp *interp;
+ Tix_MwmInfo *wmPtr;
+ char * name;
+{
+ Atom protocol;
+ Tix_MwmProtocol *ptPtr;
+
+ protocol = Tk_InternAtom(wmPtr->tkwin, name);
+ ptPtr = GetMwmProtocol(interp, wmPtr, protocol);
+ ptPtr->active = 1;
+
+ ResetProtocolsWhenIdle(wmPtr);
+}
+
+static void DeactivateMwmProtocol(interp, wmPtr, name)
+ Tcl_Interp *interp;
+ Tix_MwmInfo *wmPtr;
+ char * name;
+{
+ Atom protocol;
+ Tix_MwmProtocol *ptPtr;
+
+ protocol = Tk_InternAtom(wmPtr->tkwin, name);
+ ptPtr = GetMwmProtocol(interp, wmPtr, protocol);
+ ptPtr->active = 0;
+
+ ResetProtocolsWhenIdle(wmPtr);
+}
+
+/*
+ * Any "wm protocol" event handlers for the deleted protocol are
+ * *not* automatically deleted. It is the application programmer's
+ * responsibility to delete them using
+ *
+ * wm protocol SOME_JUNK_PROTOCOL {}
+ */
+static void DeleteMwmProtocol(interp, wmPtr, name)
+ Tcl_Interp *interp;
+ Tix_MwmInfo *wmPtr;
+ char * name;
+{
+ Atom protocol;
+ Tix_MwmProtocol *ptPtr;
+ Tcl_HashEntry * hashPtr;
+
+ protocol = Tk_InternAtom(wmPtr->tkwin, name);
+ hashPtr = Tcl_FindHashEntry(&wmPtr->protocols, (char*)protocol);
+
+ if (hashPtr) {
+ ptPtr = (Tix_MwmProtocol *)Tcl_GetHashValue(hashPtr);
+ ckfree(ptPtr->name);
+ ckfree(ptPtr->menuMessage);
+ ckfree((char*)ptPtr);
+ Tcl_DeleteHashEntry(hashPtr);
+ }
+
+ ResetProtocolsWhenIdle(wmPtr);
+}
+
+
+static void
+ResetProtocolsWhenIdle(wmPtr)
+ Tix_MwmInfo * wmPtr;
+{
+ if (!wmPtr->resetProtocol) {
+ wmPtr->resetProtocol = 1;
+ Tk_DoWhenIdle(ResetProtocols, (ClientData)wmPtr);
+ }
+}
+
+static void ResetProtocols(clientData)
+ ClientData clientData;
+{
+ Tix_MwmInfo * wmPtr = (Tix_MwmInfo *) clientData;
+ int numProtocols = wmPtr->protocols.numEntries;
+ Atom * atoms, mwm_menu_atom, motif_msgs;
+ Tcl_HashSearch hSearch;
+ Tcl_HashEntry * hashPtr;
+ Tix_MwmProtocol * ptPtr;
+ int n;
+ Tcl_DString dString;
+
+ atoms = (Atom*)ckalloc(numProtocols * sizeof(Atom));
+ Tcl_DStringInit(&dString);
+
+ /* Iterate over all the entries in the hash table */
+ for (hashPtr = Tcl_FirstHashEntry(&wmPtr->protocols, &hSearch), n=0;
+ hashPtr;
+ hashPtr = Tcl_NextHashEntry(&hSearch)) {
+ char tmp[100];
+
+ ptPtr = (Tix_MwmProtocol *)Tcl_GetHashValue(hashPtr);
+ if (ptPtr->active) {
+ atoms[n++] = ptPtr->protocol;
+ }
+
+ Tcl_DStringAppend(&dString, ptPtr->menuMessage, ptPtr->messageLen);
+ sprintf(tmp, " f.send_msg %d\n", (int)(ptPtr->protocol));
+ Tcl_DStringAppend(&dString, tmp, (int)strlen(tmp));
+ }
+
+ /* Atoms for managing the MWM messages */
+ mwm_menu_atom = Tk_InternAtom(wmPtr->tkwin, _XA_MWM_MENU);
+ motif_msgs = Tk_InternAtom(wmPtr->tkwin, "_MOTIF_WM_MESSAGES");
+
+ /* The _MOTIF_WM_MESSAGES atom must be in the wm_protocols. Otherwise
+ * Mwm refuese to enable our menu items
+ */
+ if (!wmPtr->addedMwmMsg) {
+ Tix_GlobalVarEval(wmPtr->interp, "wm protocol ",
+ Tk_PathName(wmPtr->tkwin), " _MOTIF_WM_MESSAGES {;}", NULL);
+ wmPtr->addedMwmMsg = 1;
+ }
+
+ /*
+ * These are the extra MWM protocols defined by this application.
+ */
+ XChangeProperty(Tk_Display(wmPtr->tkwin), Tk_WindowId(wmPtr->tkwin),
+ motif_msgs, XA_ATOM, 32, PropModeReplace,
+ (unsigned char *)atoms, n);
+
+ /*
+ * Update the MWM menu items
+ */
+ XChangeProperty(Tk_Display(wmPtr->tkwin), Tk_WindowId(wmPtr->tkwin),
+ mwm_menu_atom, mwm_menu_atom, 8, PropModeReplace,
+ (unsigned char *)dString.string, dString.length+1);
+
+ Tcl_DStringFree(&dString);
+ ckfree((char*)atoms);
+
+ /* Done ! */
+ wmPtr->resetProtocol = 0;
+ if (Tk_IsMapped(wmPtr->tkwin)) {
+ /* Needs unmap/map to refresh */
+ RemapWindowWhenIdle(wmPtr);
+ }
+}
+
+
+static
+int SetMwmTransientFor(interp, wmPtr, mainWindow, argc, argv)
+ Tcl_Interp *interp;
+ Tix_MwmInfo*wmPtr;
+ TkWindow *mainWindow;
+ int argc;
+ char ** argv;
+{
+ Atom transfor_atom;
+ TkWindow * master;
+
+ transfor_atom = Tk_InternAtom(wmPtr->tkwin, "WM_TRANSIENT_FOR");
+ if (argc == 0) {
+ return TCL_OK;
+ } else if (argc == 1) {
+ master = (TkWindow *) Tk_NameToWindow(interp, argv[0],
+ (Tk_Window)mainWindow);
+ if (master == NULL) {
+ return TCL_ERROR;
+ }
+ XChangeProperty(Tk_Display(wmPtr->tkwin), Tk_WindowId(wmPtr->tkwin),
+ transfor_atom, XA_WINDOW, 32, PropModeReplace,
+ (unsigned char *)&master->window, 1);
+ return TCL_OK;
+ } else {
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StructureProc --
+ *
+ * Gets called in response to StructureNotify events in toplevels
+ * operated by the tixMwm command.
+ *
+ * Results:
+ * none
+ *
+ * Side effects:
+ * The Tix_MwmInfo for the toplevel is deleted when the toplevel
+ * is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+StructureProc(clientData, eventPtr)
+ ClientData clientData; /* Our information about window
+ * referred to by eventPtr. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ register Tix_MwmInfo * wmPtr = (Tix_MwmInfo *) clientData;
+ Tcl_HashEntry *hashPtr;
+
+ if (eventPtr->type == DestroyNotify) {
+ Tcl_HashSearch hSearch;
+ Tix_MwmProtocol * ptPtr;
+
+ /* Delete all protocols in the hash table associated with
+ * this toplevel
+ */
+ for (hashPtr = Tcl_FirstHashEntry(&wmPtr->protocols, &hSearch);
+ hashPtr;
+ hashPtr = Tcl_NextHashEntry(&hSearch)) {
+
+ ptPtr = (Tix_MwmProtocol *)Tcl_GetHashValue(hashPtr);
+ ckfree(ptPtr->name);
+ ckfree(ptPtr->menuMessage);
+ ckfree((char*)ptPtr);
+ Tcl_DeleteHashEntry(hashPtr);
+ }
+
+ Tcl_DeleteHashTable(&wmPtr->protocols);
+
+ /*
+ * Delete info about this toplevel in the table of all toplevels
+ * controlled by tixMwm
+ */
+ hashPtr = Tcl_FindHashEntry(&mwmTable, (char*)wmPtr->tkwin);
+ if (hashPtr != NULL) {
+ Tcl_DeleteHashEntry(hashPtr);
+ }
+
+ if (wmPtr->resetProtocol) {
+ Tk_CancelIdleCall(ResetProtocols, (ClientData)wmPtr);
+ wmPtr->resetProtocol = 0;
+ }
+
+ ckfree((char*)wmPtr);
+ }
+}
+
+static Tix_MwmInfo *
+GetMwmInfo(interp, tkwin)
+ Tcl_Interp * interp;
+ Tk_Window tkwin;
+{
+ static inited = 0;
+ Tcl_HashEntry *hashPtr;
+ int isNew;
+
+ if (!inited) {
+ Tcl_InitHashTable(&mwmTable, TCL_ONE_WORD_KEYS);
+ inited = 1;
+ }
+
+ hashPtr = Tcl_CreateHashEntry(&mwmTable, (char*)tkwin, &isNew);
+
+ if (!isNew) {
+ return (Tix_MwmInfo *)Tcl_GetHashValue(hashPtr);
+ }
+ else {
+ Tix_MwmInfo * wmPtr;
+
+ wmPtr = (Tix_MwmInfo*) ckalloc(sizeof(Tix_MwmInfo));
+ wmPtr->interp = interp;
+ wmPtr->tkwin = tkwin;
+ wmPtr->isremapping = 0;
+ wmPtr->resetProtocol = 0;
+ wmPtr->addedMwmMsg = 0;
+ if (Tk_WindowId(wmPtr->tkwin) == 0) {
+ Tk_MakeWindowExist(wmPtr->tkwin);
+ }
+ wmPtr->mwm_hints_atom = Tk_InternAtom(wmPtr->tkwin, _XA_MWM_HINTS);
+
+ Tcl_InitHashTable(&wmPtr->protocols, TCL_ONE_WORD_KEYS);
+
+ QueryMwmHints(wmPtr);
+
+ Tcl_SetHashValue(hashPtr, (char*)wmPtr);
+
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ StructureProc, (ClientData)wmPtr);
+
+ return wmPtr;
+ }
+}
+
+static Tix_MwmProtocol *
+GetMwmProtocol(interp, wmPtr, protocol)
+ Tcl_Interp * interp;
+ Tix_MwmInfo * wmPtr;
+ Atom protocol;
+{
+ Tcl_HashEntry * hashPtr;
+ int isNew;
+ Tix_MwmProtocol * ptPtr;
+
+ hashPtr = Tcl_CreateHashEntry(&wmPtr->protocols, (char*)protocol, &isNew);
+ if (!isNew) {
+ ptPtr = (Tix_MwmProtocol *)Tcl_GetHashValue(hashPtr);
+ } else {
+ ptPtr = (Tix_MwmProtocol *)ckalloc(sizeof(Tix_MwmProtocol));
+
+ ptPtr->protocol = protocol;
+ ptPtr->name = NULL;
+ ptPtr->menuMessage = NULL;
+
+ Tcl_SetHashValue(hashPtr, (char*)ptPtr);
+ }
+
+ return ptPtr;
+}
+
+
+static int
+IsMwmRunning(interp, wmPtr)
+ Tcl_Interp *interp;
+ Tix_MwmInfo*wmPtr;
+{
+ Atom motif_wm_info_atom;
+ Atom actual_type;
+ int actual_format;
+ unsigned long num_items, bytes_after;
+ PropMotifWmInfo *prop = 0;
+ Window root;
+
+ root = XRootWindow(Tk_Display(wmPtr->tkwin),Tk_ScreenNumber(wmPtr->tkwin));
+ motif_wm_info_atom = Tk_InternAtom(wmPtr->tkwin, _XA_MOTIF_WM_INFO);
+
+ /*
+ * If mwm is running, it will store info in the _XA_MOTIF_WM_INFO
+ * atom in the root window
+ */
+ XGetWindowProperty (Tk_Display(wmPtr->tkwin),
+ root, motif_wm_info_atom, 0, (long)PROP_MOTIF_WM_INFO_ELEMENTS,
+ 0, motif_wm_info_atom, &actual_type, &actual_format,
+ &num_items, &bytes_after, (unsigned char **) &prop);
+
+ if ((actual_type != motif_wm_info_atom) || (actual_format != 32) ||
+ (num_items < PROP_MOTIF_WM_INFO_ELEMENTS)) {
+
+ /*
+ * The _XA_MOTIF_WM_INFO doesn't exist for the root window.
+ * Persumably Mwm is not running.
+ */
+ if (prop) {
+ XFree((char *)prop);
+ }
+ return(0);
+ }
+ else {
+ /*
+ * We still need to verify that the wm_window is indeed a child of
+ * the root window.
+ */
+ Window wm_window = (Window) prop->wmWindow;
+ Window top, parent, *children;
+ unsigned int num_children;
+ int returnVal = 0;
+ int i;
+
+ if (XQueryTree(Tk_Display(wmPtr->tkwin), root, &top, &parent,
+ &children, &num_children)) {
+
+ for (returnVal = 0, i = 0; i < num_children; i++) {
+ if (children[i] == wm_window) {
+ /*
+ * is indeed a window of this root: mwm is rinning
+ */
+ returnVal = 1;
+ break;
+ }
+ }
+ }
+
+ if (prop) {
+ XFree((char *)prop);
+ }
+ if (children) {
+ XFree((char *)children);
+ }
+
+ return (returnVal);
+ }
+}
diff --git a/tix/generic/tixNBFrame.c b/tix/generic/tixNBFrame.c
new file mode 100644
index 00000000000..0f5d78aa246
--- /dev/null
+++ b/tix/generic/tixNBFrame.c
@@ -0,0 +1,1584 @@
+/*
+ * tixNBFrame.c --
+ *
+ * This module implements "tixNoteBookFrame" widgets.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixDef.h>
+
+#define NUM_TAB_POINTS 6
+
+/*
+ * A data structure of the following type is kept for each
+ * widget managed by this file:
+ */
+
+typedef struct NoteBookFrameStruct {
+ Tk_Window tkwin; /* Window that embodies the widget. 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 button's widget command. */
+
+ /*
+ * Information used when displaying widget:
+ */
+ int desiredWidth; /* Desired narrow dimension of scrollbar,
+ * in pixels. */
+ int width; /* total width of the widget */
+ int height; /* total width of the widget */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ /* Border and general drawing */
+
+ int borderWidth; /* Width of 3-D borders. */
+ Tk_3DBorder bgBorder; /* Used for drawing background. */
+ Tk_3DBorder focusBorder; /* background of the "focus" tab. */
+ Tk_3DBorder inActiveBorder; /* background of the "active" tab */
+ XColor * backPageColorPtr; /* the color used as the "back page" */
+ GC backPageGC; /* GC for drawing text in normal mode. */
+ int relief; /* Indicates whether window as a whole is
+ * raised, sunken, or flat. */
+ int tabPadx;
+ int tabPady;
+
+ int isSlave; /* if is in Slave mode, do not request for
+ * germetry */
+ /* Text drawing */
+ TixFont font; /* Information about text font, or NULL. */
+ XColor *textColorPtr; /* Color for drawing text. */
+ XColor *disabledFg; /* Foreground color when disabled. NULL
+ * means use normalFg with a 50% stipple
+ * instead. */
+ GC textGC; /* GC for drawing text in normal mode. */
+ GC focusGC; /* GC for focusing text. */
+ 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.*/
+
+ Cursor cursor; /* Current cursor for window, or None. */
+
+ struct _Tab * tabHead;
+ struct _Tab * tabTail;
+ struct _Tab * active;
+ struct _Tab * focus;
+
+ int tabsWidth; /* total width of the tabs */
+ int tabsHeight; /* total height of the tabs */
+
+ char *takeFocus; /* Value of -takefocus option; not used in
+ * the C code, but used by keyboard traversal
+ * scripts. Malloc'ed, but may be NULL. */
+
+ unsigned int redrawing : 1;
+ unsigned int gotFocus : 1;
+
+} NoteBookFrame;
+
+typedef struct _Tab {
+ struct _Tab * next;
+
+ NoteBookFrame * wPtr;
+ char * name;
+
+ Tk_Uid state; /* State of Tab's for display purposes:
+ * normal or disabled. */
+ Tk_Anchor anchor;
+
+ char * text;
+ int width, height;
+ int numChars;
+ Tk_Justify justify; /* Justification to use for multi-line text. */
+ int wrapLength;
+ int underline; /* Index of character to underline. < 0 means
+ * don't underline anything. */
+
+ Tk_Image image;
+ char * imageString;
+
+ Pixmap bitmap;
+} Tab;
+
+typedef NoteBookFrame WidgetRecord;
+typedef NoteBookFrame * WidgetPtr;
+
+/*
+ * Information used for argv parsing.
+ */
+static Tk_ConfigSpec configSpecs[] = {
+
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_NOTEBOOKFRAME_BG_COLOR, Tk_Offset(WidgetRecord, bgBorder),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_NOTEBOOKFRAME_BG_MONO, Tk_Offset(WidgetRecord, bgBorder),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_COLOR, "-backpagecolor", "backPageColor", "BackPageColor",
+ DEF_NOTEBOOKFRAME_BACKPAGE_COLOR,
+ Tk_Offset(WidgetRecord, backPageColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_COLOR, "-backpagecolor", "backPageColor", "BackPageColor",
+ DEF_NOTEBOOKFRAME_BACKPAGE_MONO,
+ Tk_Offset(WidgetRecord, backPageColorPtr),
+ 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_NOTEBOOKFRAME_BORDER_WIDTH, Tk_Offset(WidgetRecord, borderWidth),
+ 0},
+
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_NOTEBOOKFRAME_CURSOR, Tk_Offset(WidgetRecord, cursor),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_NOTEBOOKFRAME_DISABLED_FG_COLOR,
+ Tk_Offset(WidgetRecord, disabledFg),
+ TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_COLOR, "-disabledforeground", "disabledForeground",
+ "DisabledForeground", DEF_NOTEBOOKFRAME_DISABLED_FG_MONO,
+ Tk_Offset(WidgetRecord, disabledFg),
+ TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+
+ {TK_CONFIG_BORDER, "-focuscolor", "focusColor", "FocusColor",
+ DEF_NOTEBOOKFRAME_FOCUS_COLOR, Tk_Offset(WidgetRecord, focusBorder),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_BORDER, "-focuscolor", "focusColor", "FocusColor",
+ DEF_NOTEBOOKFRAME_FOCUS_MONO, Tk_Offset(WidgetRecord, focusBorder),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_NOTEBOOKFRAME_FONT, Tk_Offset(WidgetRecord, font), 0},
+
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_NOTEBOOKFRAME_FG_COLOR, Tk_Offset(WidgetRecord, textColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_NOTEBOOKFRAME_FG_MONO, Tk_Offset(WidgetRecord, textColorPtr),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_BORDER, "-inactivebackground", "inactiveBackground",
+ "Background",
+ DEF_NOTEBOOKFRAME_INACTIVE_BG_COLOR,
+ Tk_Offset(WidgetRecord, inActiveBorder),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_BORDER, "-inactivebackground", "inactiveBackground",
+ "Background",
+ DEF_NOTEBOOKFRAME_INACTIVE_BG_MONO,
+ Tk_Offset(WidgetRecord, inActiveBorder),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_NOTEBOOKFRAME_RELIEF, Tk_Offset(WidgetRecord, relief), 0},
+
+ {TK_CONFIG_BOOLEAN, "-slave", "slave", "Slave",
+ DEF_NOTEBOOKFRAME_SLAVE, Tk_Offset(WidgetRecord, isSlave), 0},
+
+ {TK_CONFIG_PIXELS, "-tabpadx", "tabPadX", "Pad",
+ DEF_NOTEBOOKFRAME_TABPADX, Tk_Offset(WidgetRecord, tabPadx), 0},
+
+ {TK_CONFIG_PIXELS, "-tabpady", "tabPadY", "Pad",
+ DEF_NOTEBOOKFRAME_TABPADY, Tk_Offset(WidgetRecord, tabPady), 0},
+
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_NOTEBOOKFRAME_TAKE_FOCUS, Tk_Offset(WidgetRecord, takeFocus),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_PIXELS, "-width", "width", "Width",
+ DEF_NOTEBOOKFRAME_WIDTH, Tk_Offset(WidgetRecord, desiredWidth), 0},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+#define DEF_NBF_TAB_ANCHOR "c"
+#define DEF_NBF_TAB_BITMAP ""
+#define DEF_NBF_TAB_IMAGE ""
+#define DEF_NBF_TAB_JUSTIFY "center"
+#define DEF_NBF_TAB_TEXT ""
+#define DEF_NBF_TAB_STATE "normal"
+#define DEF_NBF_TAB_UNDERLINE "-1"
+#define DEF_NBF_TAB_WRAPLENGTH "0"
+
+static Tk_ConfigSpec tabConfigSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", (char*)NULL, (char*)NULL,
+ DEF_NBF_TAB_ANCHOR, Tk_Offset(Tab, anchor), 0},
+
+ {TK_CONFIG_BITMAP, "-bitmap", (char*)NULL, (char*)NULL,
+ DEF_NBF_TAB_BITMAP, Tk_Offset(Tab, bitmap), TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_STRING, "-image", (char*)NULL, (char*)NULL,
+ DEF_NBF_TAB_IMAGE, Tk_Offset(Tab, imageString),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_JUSTIFY, "-justify", (char*)NULL, (char*)NULL,
+ DEF_NBF_TAB_JUSTIFY, Tk_Offset(Tab, justify), 0},
+
+ {TK_CONFIG_STRING, "-label", (char*)NULL, (char*)NULL,
+ DEF_NBF_TAB_TEXT, Tk_Offset(Tab, text), TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_UID, "-state", (char*)NULL, (char*)NULL,
+ DEF_NBF_TAB_STATE, Tk_Offset(Tab, state), 0},
+
+ {TK_CONFIG_INT, "-underline", (char*)NULL, (char*)NULL,
+ DEF_NBF_TAB_UNDERLINE, Tk_Offset(Tab, underline), 0},
+
+ {TK_CONFIG_PIXELS, "-wraplength", (char*)NULL, (char*)NULL,
+ DEF_NBF_TAB_WRAPLENGTH, Tk_Offset(Tab, wrapLength), 0},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+ /* These are standard procedures for TK widgets
+ * implemeted in C
+ */
+static void WidgetCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int WidgetConfigure _ANSI_ARGS_((Tcl_Interp *interp,
+ WidgetPtr wPtr, int argc, char **argv,
+ int flags));
+static int WidgetCommand _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *, int argc, char **argv));
+static void WidgetComputeGeometry _ANSI_ARGS_((WidgetPtr wPtr));
+static void WidgetDestroy _ANSI_ARGS_((ClientData clientData));
+static void WidgetDisplay _ANSI_ARGS_((ClientData clientData));
+static void WidgetEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+
+ /* Extra procedures for this widget
+ */
+static int AddTab _ANSI_ARGS_((WidgetPtr wPtr, char * name,
+ char ** argv, int argc));
+static void DeleteTab _ANSI_ARGS_((Tab * tPtr));
+static void CancelRedrawWhenIdle _ANSI_ARGS_((WidgetPtr wPtr));
+static void ComputeGeometry _ANSI_ARGS_((WidgetPtr wPtr));
+static void DrawTab _ANSI_ARGS_((WidgetPtr wPtr,
+ Tab * tPtr, int x, int isActive,
+ Drawable drawable));
+static Tab * FindTab _ANSI_ARGS_((Tcl_Interp *interp,
+ WidgetPtr wPtr, char * name));
+static void FocusTab _ANSI_ARGS_((WidgetPtr wPtr,
+ Tab * tPtr, int x, Drawable drawable));
+static void GetTabPoints _ANSI_ARGS_((
+ WidgetPtr wPtr, Tab * tPtr,
+ int x, XPoint *points));
+static void ImageProc _ANSI_ARGS_((ClientData clientData,
+ int x, int y, int width, int height,
+ int imgWidth, int imgHeight));
+static void RedrawWhenIdle _ANSI_ARGS_((WidgetPtr wPtr));
+static int TabConfigure _ANSI_ARGS_((WidgetPtr wPtr,
+ Tab *tPtr, char ** argv, int argc));
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tix_NoteBookFrameCmd --
+ *
+ * This procedure is invoked to process the "tixNoteBookFrame" Tcl
+ * command. It creates a new "TixNoteBookFrame" widget.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * A new widget is created and configured.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Tix_NoteBookFrameCmd(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;
+ WidgetPtr wPtr;
+ 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, "TixNoteBookFrame");
+
+ /*
+ * Allocate and initialize the widget record.
+ */
+ wPtr = (WidgetPtr) ckalloc(sizeof(WidgetRecord));
+ wPtr->tkwin = tkwin;
+ wPtr->display = Tk_Display(tkwin);
+ wPtr->interp = interp;
+ wPtr->isSlave = 1;
+ wPtr->desiredWidth = 0;
+ wPtr->interp = interp;
+ wPtr->width = 0;
+ wPtr->borderWidth = 0;
+ wPtr->bgBorder = NULL;
+ wPtr->backPageGC = None;
+ wPtr->backPageColorPtr = NULL;
+ wPtr->disabledFg = NULL;
+ wPtr->gray = None;
+ wPtr->disabledGC = None;
+ wPtr->inActiveBorder = NULL;
+ wPtr->focusBorder = NULL;
+ wPtr->font = NULL;
+ wPtr->textColorPtr = NULL;
+ wPtr->textGC = None;
+ wPtr->focusGC = None;
+ wPtr->relief = TK_RELIEF_FLAT;
+ wPtr->cursor = None;
+
+ wPtr->tabHead = 0;
+ wPtr->tabTail = 0;
+ wPtr->tabPadx = 0;
+ wPtr->tabPady = 0;
+ wPtr->active = 0;
+ wPtr->focus = 0;
+ wPtr->takeFocus = 0;
+ wPtr->redrawing = 0;
+ wPtr->gotFocus = 0;
+
+ Tk_CreateEventHandler(wPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ WidgetEventProc, (ClientData) wPtr);
+ wPtr->widgetCmd = Tcl_CreateCommand(interp, Tk_PathName(wPtr->tkwin),
+ WidgetCommand, (ClientData) wPtr, WidgetCmdDeletedProc);
+ if (WidgetConfigure(interp, wPtr, argc-2, argv+2, 0) != TCL_OK) {
+ Tk_DestroyWindow(wPtr->tkwin);
+ return TCL_ERROR;
+ }
+
+ interp->result = Tk_PathName(wPtr->tkwin);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WidgetCommand --
+ *
+ * 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
+WidgetCommand(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about the widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int result = TCL_OK;
+ int length;
+ char c;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tk_Preserve((ClientData) wPtr);
+ c = argv[1][0];
+ length = strlen(argv[1]);
+
+ if (((c == 'a') && (strncmp(argv[1], "activate", length) == 0))||
+ ((c == 'f') && (strncmp(argv[1], "focus", length) == 0))){
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " ", argv[1], " name\"", (char *) NULL);
+ goto error;
+ }
+ else {
+ if (strcmp(argv[2], "")==0) {
+ if (c == 'a') {
+ wPtr->active = 0;
+ wPtr->focus = 0;
+ }
+ else {
+ wPtr->focus = 0;
+ }
+ RedrawWhenIdle(wPtr);
+ }
+ else {
+ Tab * tPtr;
+
+ for (tPtr=wPtr->tabHead; tPtr; tPtr=tPtr->next) {
+ if (strcmp(argv[2], tPtr->name) == 0) {
+ if (c == 'a') {
+ wPtr->active = tPtr;
+ wPtr->focus = tPtr;
+ }
+ else {
+ wPtr->focus = tPtr;
+ }
+ RedrawWhenIdle(wPtr);
+ goto done;
+ }
+ }
+
+ Tcl_AppendResult(interp, "unknown tab \"",
+ argv[0], "\"", (char *) NULL);
+ goto error;
+ }
+ }
+ }
+ else if ((c == 'a') && (strncmp(argv[1], "add", length) == 0)) {
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be ",
+ argv[0], " add name ?options?", (char *) NULL);
+ goto error;
+ }
+ else {
+ if (AddTab(wPtr, argv[2], argv+3, argc-3)!= TCL_OK) {
+ goto error;
+ } else {
+ WidgetComputeGeometry(wPtr);
+ RedrawWhenIdle(wPtr);
+ }
+ }
+ }
+ else if ((c == 'c') && (strncmp(argv[1], "cget", length) == 0)) {
+ if (argc == 3) {
+ result = Tk_ConfigureValue(interp, wPtr->tkwin, configSpecs,
+ (char *)wPtr, argv[2], 0);
+ } else {
+ result = Tix_ArgcError(interp, argc, argv, 2, "option");
+ }
+ }
+ else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, wPtr->tkwin, configSpecs,
+ (char *) wPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, wPtr->tkwin, configSpecs,
+ (char *) wPtr, argv[2], 0);
+ } else {
+ result = WidgetConfigure(interp, wPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ }
+ else if ((c == 'd') && (strncmp(argv[1], "delete", length) == 0)) {
+ Tab * tPtr, * prev ;
+
+ if (argc != 3) {
+ Tix_ArgcError(interp, argc, argv, 2, "page");
+ goto error;
+ }
+
+ /* Find the tab from the list */
+ for (prev=tPtr=wPtr->tabHead; tPtr; prev=tPtr,tPtr=tPtr->next) {
+ if (strcmp(tPtr->name, argv[2])==0) {
+ break;
+ }
+ }
+ if (tPtr == NULL) {
+ Tcl_AppendResult(wPtr->interp,
+ "Unknown tab \"", argv[2], "\"", (char*) NULL);
+ goto error;
+ }
+ if (tPtr == prev) {
+ if (wPtr->tabHead == wPtr->tabTail) {
+ wPtr->tabHead = wPtr->tabTail = NULL;
+ } else {
+ wPtr->tabHead = tPtr->next;
+ }
+ } else {
+ if (tPtr == wPtr->tabTail) {
+ wPtr->tabTail = prev;
+ }
+ prev->next = tPtr->next;
+ }
+
+ DeleteTab(tPtr);
+ ComputeGeometry(wPtr);
+ RedrawWhenIdle(wPtr);
+ }
+ else if ((c == 'g') && (strncmp(argv[1], "geometryinfo", length) == 0)) {
+ char buff[20];
+
+ ComputeGeometry(wPtr);
+ sprintf(buff, "%d %d", wPtr->width, wPtr->height);
+
+ Tcl_AppendResult(interp, buff, NULL);
+ }
+ else if ((c == 'i') && (strncmp(argv[1], "identify", length) == 0)) {
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " identify x y\"", (char *) NULL);
+ goto error;
+ }
+ else {
+ int x, y, left, right;
+ Tab * tPtr;
+
+ if (Tcl_GetInt(interp, argv[2], &x) != TCL_OK) {
+ goto error;
+ }
+ if (Tcl_GetInt(interp, argv[3], &y) != TCL_OK) {
+ goto error;
+ }
+
+ if (y < wPtr->tabsHeight) {
+ left = 0;
+ for (tPtr=wPtr->tabHead; tPtr; tPtr=tPtr->next) {
+ right = left + (wPtr->borderWidth + wPtr->tabPadx) * 2
+ + tPtr->width;
+
+ if (x >= left && x <= right && tPtr->state ==tixNormalUid){
+ Tcl_AppendResult(interp, tPtr->name, NULL);
+ goto done;
+ }
+ left = right;
+ }
+ }
+
+ /*
+ * An empty string is returned to indicate "nothing selected"
+ */
+ Tcl_ResetResult(interp);
+ }
+ }
+ else if ((c == 'i') && (strncmp(argv[1], "info", length) == 0)) {
+ Tcl_ResetResult(interp);
+
+ if (argc == 3 && strcmp(argv[2], "pages")==0 ) {
+ Tab * tPtr;
+
+ for (tPtr=wPtr->tabHead; tPtr; tPtr=tPtr->next) {
+ Tcl_AppendElement(interp, tPtr->name);
+ }
+ }
+ else if (argc == 3 && strcmp(argv[2], "active")==0 ) {
+ if (wPtr->active) {
+ Tcl_AppendResult(interp, wPtr->active->name, NULL);
+ }
+ }
+ else if (argc == 3 && strcmp(argv[2], "focus")==0 ) {
+ if (wPtr->focus) {
+ Tcl_AppendResult(interp, wPtr->focus->name, NULL);
+ }
+ }
+ else if (argc == 3 && strcmp(argv[2], "focusnext")==0 ) {
+ Tab * next;
+ if (wPtr->focus) {
+ if (wPtr->focus->next) {
+ next = wPtr->focus->next;
+ } else {
+ next = wPtr->tabHead;
+ }
+ Tcl_AppendResult(interp, next->name, NULL);
+ }
+ }
+ else if (argc == 3 && strcmp(argv[2], "focusprev")==0 ) {
+ Tab * prev, *tPtr;
+
+ if (wPtr->focus==wPtr->tabHead) {
+ prev = wPtr->tabTail;
+ }
+ else {
+ for (prev=tPtr=wPtr->tabHead;tPtr; prev=tPtr,tPtr=tPtr->next) {
+ if (tPtr == wPtr->focus) {
+ break;
+ }
+ }
+ }
+
+ if (prev) {
+ Tcl_AppendResult(interp, prev->name, NULL);
+ }
+ }
+ else {
+ Tcl_AppendResult(interp, "wrong number of arguments or ",
+ "unknown option", NULL);
+ goto error;
+ }
+ }
+ else if ((c == 'm') && (strncmp(argv[1], "move", length) == 0)) {
+
+ }
+ else if ((c == 'p') && (strncmp(argv[1], "pagecget", length) == 0)) {
+ Tab * tPtr;
+
+ if (argc != 4) {
+ Tix_ArgcError(interp, argc, argv, 2, "option");
+ goto error;
+ }
+ if ((tPtr=FindTab(interp, wPtr, argv[2])) == NULL) {
+ goto error;
+ }
+ result = Tk_ConfigureValue(interp, wPtr->tkwin, tabConfigSpecs,
+ (char *)tPtr, argv[3], 0);
+ }
+ else if ((c == 'p') && (strncmp(argv[1], "pageconfigure", length) == 0)) {
+ Tab * tPtr;
+
+ if (argc < 3) {
+ Tix_ArgcError(interp, argc, argv, 2,
+ "page ?option value ...?");
+ goto error;
+ }
+ if ((tPtr=FindTab(interp, wPtr, argv[2])) == NULL) {
+ goto error;
+ }
+ if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, wPtr->tkwin, tabConfigSpecs,
+ (char *)tPtr, (char *) NULL, 0);
+ } else if (argc == 4) {
+ result = Tk_ConfigureInfo(interp, wPtr->tkwin, tabConfigSpecs,
+ (char *)tPtr, argv[3], 0);
+ } else {
+ result = TabConfigure(wPtr, tPtr, argv+3, argc-3);
+ }
+ }
+ else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be activate, add, configure, delete, ",
+ "geometryinfo, identify, move, pagecget or ",
+ "pageconfigure", (char *) NULL);
+ goto error;
+ }
+
+ done:
+ Tk_Release((ClientData) wPtr);
+ return result;
+
+ error:
+ Tk_Release((ClientData) wPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WidgetConfigure --
+ *
+ * This procedure is called to process an argv/argc list in
+ * conjunction with the Tk option database to configure (or
+ * reconfigure) a Notebookframe 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 wPtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+WidgetConfigure(interp, wPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ WidgetPtr wPtr; /* Information about widget. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Flags to pass to
+ * Tk_ConfigureWidget. */
+{
+ XGCValues gcValues;
+ GC newGC;
+ int mask;
+
+ if (Tk_ConfigureWidget(interp, wPtr->tkwin, configSpecs,
+ argc, argv, (char *) wPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (wPtr->tabPadx < 3) {
+ wPtr->tabPadx = 3;
+ }
+ if (wPtr->tabPady < 2) {
+ wPtr->tabPady = 2;
+ }
+
+ Tk_SetBackgroundFromBorder(wPtr->tkwin, wPtr->bgBorder);
+
+ /*
+ * Get the back page GC
+ */
+ gcValues.foreground = wPtr->backPageColorPtr->pixel;
+ gcValues.graphics_exposures = False;
+ newGC = Tk_GetGC(wPtr->tkwin, GCForeground|GCGraphicsExposures,
+ &gcValues);
+ if (wPtr->backPageGC != None) {
+ Tk_FreeGC(wPtr->display, wPtr->backPageGC);
+ }
+ wPtr->backPageGC = newGC;
+
+ /*
+ * Get the text GC
+ */
+ gcValues.foreground = wPtr->textColorPtr->pixel;
+ gcValues.background = Tk_3DBorderColor(wPtr->bgBorder)->pixel;
+ gcValues.font = TixFontId(wPtr->font);
+ gcValues.graphics_exposures = False;
+ newGC = Tk_GetGC(wPtr->tkwin,
+ GCBackground|GCForeground|GCFont|GCGraphicsExposures,
+ &gcValues);
+ if (wPtr->textGC != None) {
+ Tk_FreeGC(wPtr->display, wPtr->textGC);
+ }
+ wPtr->textGC = newGC;
+
+ /*
+ * Get the disabled GC
+ */
+ if (wPtr->disabledFg != NULL) {
+ gcValues.foreground = wPtr->disabledFg->pixel;
+ gcValues.background = Tk_3DBorderColor(wPtr->bgBorder)->pixel;
+ mask = GCForeground|GCBackground|GCFont;
+ } else {
+ gcValues.foreground = Tk_3DBorderColor(wPtr->bgBorder)->pixel;
+ if (wPtr->gray == None) {
+ wPtr->gray = Tk_GetBitmap(interp, wPtr->tkwin,
+ Tk_GetUid("gray50"));
+ if (wPtr->gray == None) {
+ return TCL_ERROR;
+ }
+ }
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = wPtr->gray;
+ mask = GCForeground|GCFillStyle|GCFont|GCStipple;
+ }
+ gcValues.font = TixFontId(wPtr->font);
+ newGC = Tk_GetGC(wPtr->tkwin, mask, &gcValues);
+ if (wPtr->disabledGC != None) {
+ Tk_FreeGC(wPtr->display, wPtr->disabledGC);
+ }
+ wPtr->disabledGC = newGC;
+
+ /*
+ * Get the focus GC
+ */
+ gcValues.foreground = wPtr->textColorPtr->pixel;
+ gcValues.background = Tk_3DBorderColor(wPtr->bgBorder)->pixel;
+ gcValues.graphics_exposures = False;
+ gcValues.line_style = LineDoubleDash;
+ gcValues.dashes = 2;
+ newGC = Tk_GetGC(wPtr->tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures|GCLineStyle|GCDashList,
+ &gcValues);
+ if (wPtr->focusGC != None) {
+ Tk_FreeGC(wPtr->display, wPtr->focusGC);
+ }
+ wPtr->focusGC = newGC;
+
+ WidgetComputeGeometry(wPtr);
+ RedrawWhenIdle(wPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WidgetEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on Notebookframes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+WidgetEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+
+ switch (eventPtr->type ) {
+ case DestroyNotify:
+ if (wPtr->tkwin != NULL) {
+ wPtr->tkwin = NULL;
+ Tcl_DeleteCommand(wPtr->interp,
+ Tcl_GetCommandName(wPtr->interp, wPtr->widgetCmd));
+ }
+ CancelRedrawWhenIdle(wPtr);
+ Tk_EventuallyFree((ClientData) wPtr, (Tix_FreeProc*)WidgetDestroy);
+ break;
+
+ case Expose:
+ case ConfigureNotify:
+ RedrawWhenIdle(wPtr);
+ break;
+
+ case FocusIn:
+ if (eventPtr->xfocus.detail != NotifyVirtual) {
+ wPtr->gotFocus = 1;
+ if (wPtr->focus == NULL) {
+ wPtr->focus = wPtr->active;
+ }
+ RedrawWhenIdle(wPtr);
+ }
+ break;
+
+ case FocusOut:
+ if (eventPtr->xfocus.detail != NotifyVirtual) {
+ wPtr->gotFocus = 0;
+ RedrawWhenIdle(wPtr);
+ }
+ break;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WidgetDestroy --
+ *
+ * This procedure is invoked by Tk_EventuallyFree or Tk_Release
+ * to clean up the internal structure of a Notebookframe at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the Notebookframe is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+WidgetDestroy(clientData)
+ ClientData clientData; /* Info about my widget. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ Tab * tPtr;
+
+ for (tPtr=wPtr->tabHead; tPtr;) {
+ Tab * toDelete;
+
+ toDelete = tPtr;
+ tPtr=tPtr->next;
+
+ DeleteTab(toDelete);
+ }
+
+ if (wPtr->backPageGC != None) {
+ Tk_FreeGC(wPtr->display, wPtr->backPageGC);
+ }
+ if (wPtr->textGC != None) {
+ Tk_FreeGC(wPtr->display, wPtr->textGC);
+ }
+ if (wPtr->focusGC != None) {
+ Tk_FreeGC(wPtr->display, wPtr->focusGC);
+ }
+ if (wPtr->gray != None) {
+ Tk_FreeBitmap(wPtr->display, wPtr->gray);
+ }
+ if (wPtr->disabledGC != None) {
+ Tk_FreeGC(wPtr->display, wPtr->disabledGC);
+ }
+ Tk_FreeOptions(configSpecs, (char *) wPtr, wPtr->display, 0);
+ ckfree((char *) wPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WidgetCmdDeletedProc --
+ *
+ * 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
+WidgetCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ WidgetPtr wPtr = (WidgetPtr) 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 (wPtr->tkwin != NULL) {
+ Tk_Window tkwin = wPtr->tkwin;
+ wPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindTab --
+ *
+ * Seraches for the Tab is the widget's tab list
+ *----------------------------------------------------------------------
+ */
+static Tab * FindTab(interp, wPtr, name)
+ Tcl_Interp * interp;
+ WidgetPtr wPtr;
+ char * name;
+{
+ Tab *tPtr;
+
+ for (tPtr=wPtr->tabHead; tPtr; tPtr=tPtr->next) {
+ if (strcmp(tPtr->name, name) == 0) {
+ return tPtr;
+ }
+ }
+
+ Tcl_AppendResult(interp, "Unknown tab \"", name, "\"", (char*) NULL);
+ return NULL;
+}
+
+
+static int TabConfigure(wPtr, tPtr, argv, argc)
+ WidgetPtr wPtr;
+ Tab *tPtr;
+ char ** argv;
+ int argc;
+{
+ if (Tk_ConfigureWidget(wPtr->interp, wPtr->tkwin, tabConfigSpecs,
+ argc, argv, (char *)tPtr, TK_CONFIG_ARGV_ONLY) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Free the old images for the widget, if there were any.
+ */
+ if (tPtr->image != NULL) {
+ Tk_FreeImage(tPtr->image);
+ tPtr->image = NULL;
+ }
+
+ if (tPtr->imageString != NULL) {
+ tPtr->image = Tk_GetImage(wPtr->interp, wPtr->tkwin,
+ tPtr->imageString, ImageProc, (ClientData) tPtr);
+ if (tPtr->image == NULL) {
+ return TCL_ERROR;
+ }
+ }
+
+ if (tPtr->text != NULL) {
+ tPtr->numChars = strlen(tPtr->text);
+ TixComputeTextGeometry(wPtr->font, tPtr->text, tPtr->numChars,
+ tPtr->wrapLength, &tPtr->width, &tPtr->height);
+ }
+ else if (tPtr->image != NULL) {
+ Tk_SizeOfImage(tPtr->image, &tPtr->width, &tPtr->height);
+ }
+ else if (tPtr->bitmap != None) {
+ Tk_SizeOfBitmap(wPtr->display, tPtr->bitmap, &tPtr->width,
+ &tPtr->height);
+ }
+ else {
+ tPtr->width = 0;
+ tPtr->height = 0;
+ }
+
+ WidgetComputeGeometry(wPtr);
+ RedrawWhenIdle(wPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AddTab --
+ *
+ * Adds a new tab into the list of tabs.
+ *
+ * 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 wPtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+AddTab(wPtr, name, argv, argc)
+ WidgetPtr wPtr; /* Information about widget. */
+ char * name; /* Arguments. */
+ char ** argv;
+ int argc;
+{
+ Tab * tPtr;
+
+ tPtr = (Tab*)ckalloc(sizeof(Tab));
+
+ tPtr->next = NULL;
+ tPtr->wPtr = wPtr;
+ tPtr->name = (char*)tixStrDup(name);
+ tPtr->state = tixNormalUid;
+ tPtr->text = NULL;
+ tPtr->width = 0;
+ tPtr->height = 0;
+ tPtr->numChars = 0;
+ tPtr->justify = TK_JUSTIFY_CENTER;
+ tPtr->wrapLength = 0;
+ tPtr->underline = -1;
+ tPtr->image = NULL;
+ tPtr->imageString = NULL;
+ tPtr->bitmap = None;
+ tPtr->anchor = TK_ANCHOR_CENTER;
+
+ if (TabConfigure(wPtr, tPtr, argv, argc) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /* Append the tab to the end of the list */
+
+ if (wPtr->tabHead == 0) {
+ wPtr->tabHead = wPtr->tabTail = tPtr;
+ }
+ else {
+ /* Insert right after the tail */
+ wPtr->tabTail->next = tPtr;
+ wPtr->tabTail = tPtr;
+ }
+
+ return TCL_OK;
+}
+
+static void DeleteTab(tPtr)
+ Tab * tPtr;
+{
+ if (tPtr->wPtr->focus == tPtr) {
+ tPtr->wPtr->focus = 0;
+ }
+ if (tPtr->wPtr->active == tPtr) {
+ tPtr->wPtr->active = 0;
+ }
+ if (tPtr->name) {
+ ckfree(tPtr->name);
+ }
+ if (tPtr->image) {
+ Tk_FreeImage(tPtr->image);
+ }
+
+ if (tPtr->wPtr->tkwin) {
+ Tk_FreeOptions(tabConfigSpecs, (char *)tPtr,
+ Tk_Display(tPtr->wPtr->tkwin), 0);
+ }
+ ckfree((char*)tPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RedrawWhenIdle --
+ *
+ * Redraw this widget when idle
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+RedrawWhenIdle(wPtr)
+ WidgetPtr wPtr; /* Information about widget. */
+{
+ if (! wPtr->redrawing && Tk_IsMapped(wPtr->tkwin)) {
+ wPtr->redrawing = 1;
+ Tk_DoWhenIdle(WidgetDisplay, (ClientData)wPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CancelRedrawWhenIdle --
+ *
+ * Redraw this widget when idle
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+CancelRedrawWhenIdle(wPtr)
+ WidgetPtr wPtr; /* Information about widget. */
+{
+ if (wPtr->redrawing) {
+ wPtr->redrawing = 0;
+ Tk_CancelIdleCall(WidgetDisplay, (ClientData)wPtr);
+ }
+}
+
+static void GetTabPoints(wPtr, tPtr, x, points)
+ WidgetPtr wPtr;
+ Tab * tPtr;
+ int x;
+ XPoint *points;
+{
+ points[0].x = x + wPtr->borderWidth;
+ points[0].y = wPtr->tabsHeight;
+ points[1].x = points[0].x;
+ points[1].y = wPtr->borderWidth * 2;
+ points[2].x = x + wPtr->borderWidth * 2;
+ points[2].y = wPtr->borderWidth;
+
+ points[3].x = x + tPtr->width + wPtr->tabPadx*2;
+ points[3].y = points[2].y;
+ points[4].x = points[3].x + wPtr->borderWidth;
+ points[4].y = points[1].y;
+ points[5].x = points[4].x;
+ points[5].y = points[0].y;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawTab --
+ *
+ * Draws one tab according to its position and text
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+static void DrawTab(wPtr, tPtr, x, isActive, drawable)
+ WidgetPtr wPtr;
+ Tab * tPtr;
+ int x;
+ int isActive;
+ Drawable drawable;
+{
+ Tk_3DBorder border;
+ XPoint points[NUM_TAB_POINTS];
+ int drawX, drawY, extraH;
+
+ if (isActive) {
+ border = wPtr->bgBorder;
+ } else {
+ border = wPtr->inActiveBorder;
+ }
+
+ GetTabPoints(wPtr, tPtr, x, points);
+ drawX = x + wPtr->borderWidth + wPtr->tabPadx;
+ drawY = wPtr->borderWidth + wPtr->tabPady;
+ extraH = wPtr->tabsHeight - tPtr->height -
+ wPtr->borderWidth - wPtr->tabPady *2;
+
+ if (extraH > 0) {
+ switch (tPtr->anchor) {
+ case TK_ANCHOR_SW: case TK_ANCHOR_S: case TK_ANCHOR_SE:
+ drawY += extraH;
+ break;
+ case TK_ANCHOR_W: case TK_ANCHOR_CENTER: case TK_ANCHOR_E:
+ drawY += extraH/2;
+ break;
+ case TK_ANCHOR_N: case TK_ANCHOR_NE: case TK_ANCHOR_NW:
+ /*
+ * Do nothing.
+ */
+ break;
+ }
+ }
+
+ Tk_Fill3DPolygon(wPtr->tkwin, drawable,
+ border, points, NUM_TAB_POINTS,
+ wPtr->borderWidth, TK_RELIEF_SUNKEN);
+
+ if (tPtr->text != NULL) {
+ if (tPtr->state == tixNormalUid) {
+ TixDisplayText(wPtr->display, drawable, wPtr->font,
+ tPtr->text, tPtr->numChars,
+ drawX, drawY,
+ tPtr->width,
+ tPtr->justify,
+ tPtr->underline,
+ wPtr->textGC);
+ } else {
+ TixDisplayText(wPtr->display, drawable, wPtr->font,
+ tPtr->text, tPtr->numChars,
+ drawX, drawY,
+ tPtr->width,
+ tPtr->justify,
+ tPtr->underline,
+ wPtr->disabledGC);
+ }
+ }
+ else if (tPtr->image != NULL) {
+ Tk_RedrawImage(tPtr->image, 0, 0, tPtr->width, tPtr->height,
+ drawable, drawX, drawY);
+ }
+ else if (tPtr->bitmap != None) {
+ GC gc;
+
+ if (tPtr->state == tixNormalUid) {
+ gc = wPtr->textGC;
+ } else {
+ gc = wPtr->disabledGC;
+ }
+ XSetClipOrigin(wPtr->display, gc, drawX, drawY);
+ XCopyPlane(wPtr->display, tPtr->bitmap, drawable,
+ gc, 0, 0, tPtr->width, tPtr->height,
+ drawX, drawY, 1);
+ XSetClipOrigin(wPtr->display, gc, 0, 0);
+ }
+
+#if 0
+ if (wPtr->gotFocus && tPtr == wPtr->focus) {
+ XDrawLine(Tk_Display(wPtr->tkwin), drawable, wPtr->focusGC,
+ drawX,
+ drawY + tPtr->height + 1,
+ drawX + tPtr->width,
+ drawY + tPtr->height + 1);
+ }
+#endif
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * FocusTab --
+ *
+ * Draws focus highlight on a tab.
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+static void FocusTab(wPtr, tPtr, x, drawable)
+ WidgetPtr wPtr;
+ Tab * tPtr;
+ int x;
+ Drawable drawable;
+{
+ Tk_3DBorder border;
+
+ XPoint points[NUM_TAB_POINTS];
+
+ if (wPtr->active == tPtr) {
+ border = wPtr->bgBorder;
+ } else {
+ border = wPtr->inActiveBorder;
+ }
+
+ GetTabPoints(wPtr, tPtr, x, points);
+ Tk_Draw3DPolygon(wPtr->tkwin, drawable,
+ wPtr->focusBorder, points, NUM_TAB_POINTS,
+ wPtr->borderWidth, TK_RELIEF_SUNKEN);
+
+ if (wPtr->active == tPtr) {
+ Tk_Draw3DPolygon(wPtr->tkwin, drawable,
+ border, points, NUM_TAB_POINTS,
+ wPtr->borderWidth/2, TK_RELIEF_SUNKEN);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WidgetDisplay --
+ *
+ * Redraw this widget
+ *
+ * Results:
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+WidgetDisplay(clientData)
+ ClientData clientData; /* Information about widget. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ Tab * tPtr;
+ int width, height;
+ Drawable buffer;
+
+ /* Now let's redraw */
+ if (wPtr->tabHead == NULL) {
+ /*
+ * no tabs to redraw: just draw the border
+ */
+ if ((wPtr->bgBorder != NULL) && (wPtr->relief != TK_RELIEF_FLAT)) {
+ Tk_Fill3DRectangle(wPtr->tkwin, Tk_WindowId(wPtr->tkwin),
+ wPtr->bgBorder, 0, 0,
+ Tk_Width(wPtr->tkwin), Tk_Height(wPtr->tkwin),
+ wPtr->borderWidth, wPtr->relief);
+ }
+ }
+ else {
+ int x, y, activex;
+
+ buffer = Tix_GetRenderBuffer(wPtr->display, Tk_WindowId(wPtr->tkwin),
+ Tk_Width(wPtr->tkwin), Tk_Height(wPtr->tkwin),
+ Tk_Depth(wPtr->tkwin));
+ XFillRectangle(Tk_Display(wPtr->tkwin), buffer, wPtr->backPageGC,
+ 0, 0, Tk_Width(wPtr->tkwin), Tk_Height(wPtr->tkwin));
+
+ Tk_Fill3DRectangle(wPtr->tkwin, buffer,
+ wPtr->bgBorder, 0, wPtr->tabsHeight,
+ Tk_Width(wPtr->tkwin),
+ Tk_Height(wPtr->tkwin) - wPtr->tabsHeight,
+ wPtr->borderWidth, wPtr->relief);
+
+ /* Draw the tabs */
+ x = 0;
+ for (tPtr=wPtr->tabHead; tPtr; tPtr=tPtr->next) {
+ if (tPtr == wPtr->active) {
+ activex = x;
+ DrawTab(wPtr, tPtr, x, 1, buffer);
+ }
+ else {
+ DrawTab(wPtr, tPtr, x, 0, buffer);
+ }
+ if (tPtr == wPtr->focus && wPtr->gotFocus) {
+ FocusTab(wPtr, tPtr, x, buffer);
+ }
+
+ x += (wPtr->borderWidth + wPtr->tabPadx) * 2;
+ x += tPtr->width;
+ }
+
+ /* Draw the box */
+ Tk_Draw3DRectangle(wPtr->tkwin, buffer,
+ wPtr->bgBorder, 0, wPtr->tabsHeight,
+ Tk_Width(wPtr->tkwin),
+ Tk_Height(wPtr->tkwin) - wPtr->tabsHeight,
+ wPtr->borderWidth, wPtr->relief);
+
+ if (wPtr->active != NULL) {
+ /*
+ * Fill up the gap between the active tab and the box
+ */
+ x = activex + wPtr->borderWidth;
+ y = wPtr->tabsHeight;
+ height = wPtr->borderWidth;
+ width = wPtr->active->width + wPtr->tabPadx*2;
+
+ XFillRectangle(wPtr->display, buffer,
+ Tk_3DBorderGC(wPtr->tkwin, wPtr->bgBorder, TK_3D_FLAT_GC),
+ x, y, width, height);
+ }
+
+ if (buffer != Tk_WindowId(wPtr->tkwin)) {
+ XCopyArea(wPtr->display, buffer, Tk_WindowId(wPtr->tkwin),
+ wPtr->textGC, 0, 0, Tk_Width(wPtr->tkwin),
+ Tk_Height(wPtr->tkwin), 0, 0);
+ Tk_FreePixmap(wPtr->display, buffer);
+ }
+ }
+
+ wPtr->redrawing = 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeGeometry --
+ *
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+ComputeGeometry(wPtr)
+ WidgetPtr wPtr;
+{
+ Tab * tPtr;
+
+ /* Calculate the requested size of the widget */
+ if (wPtr->tabHead == NULL) {
+ wPtr->width = wPtr->borderWidth * 2;
+ wPtr->height = wPtr->borderWidth * 2;
+
+ wPtr->tabsWidth = 0;
+ wPtr->tabsHeight = 0;
+ } else {
+ wPtr->tabsWidth = 0;
+ wPtr->tabsHeight = 0;
+ for (tPtr=wPtr->tabHead; tPtr; tPtr=tPtr->next) {
+
+ if (tPtr->text != NULL) {
+ tPtr->numChars = strlen(tPtr->text);
+ TixComputeTextGeometry(wPtr->font, tPtr->text,
+ tPtr->numChars, tPtr->wrapLength,
+ &tPtr->width, &tPtr->height);
+ }
+ else if (tPtr->image != NULL) {
+ Tk_SizeOfImage(tPtr->image, &tPtr->width, &tPtr->height);
+ }
+ else if (tPtr->bitmap != None) {
+ Tk_SizeOfBitmap(wPtr->display, tPtr->bitmap, &tPtr->width,
+ &tPtr->height);
+ }
+ else {
+ tPtr->width = 0;
+ tPtr->height = 0;
+ }
+
+ wPtr->tabsWidth += (wPtr->borderWidth + wPtr->tabPadx) * 2;
+ wPtr->tabsWidth += tPtr->width;
+
+ if (tPtr->height > wPtr->tabsHeight) {
+ wPtr->tabsHeight = tPtr->height;
+ }
+ }
+ wPtr->tabsHeight += wPtr->tabPady*2 + wPtr->borderWidth;
+
+ wPtr->width = wPtr->tabsWidth;
+ wPtr->height = wPtr->tabsHeight + wPtr->borderWidth*2;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WidgetComputeGeometry --
+ *
+ * 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 void
+WidgetComputeGeometry(wPtr)
+ WidgetPtr wPtr;
+{
+ int width;
+
+ ComputeGeometry(wPtr);
+
+ if (!wPtr->isSlave) {
+ if (wPtr->desiredWidth > 0) {
+ width = wPtr->desiredWidth;
+ } else {
+ width = wPtr->width;
+ }
+ Tk_GeometryRequest(wPtr->tkwin, width, wPtr->height);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageProc --
+ *
+ * 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 this widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the HList to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+ImageProc(clientData, x, y, width, height, imgWidth, imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ Tab * tPtr;
+
+ tPtr = (Tab *)clientData;
+
+ WidgetComputeGeometry(tPtr->wPtr);
+ RedrawWhenIdle(tPtr->wPtr);
+}
diff --git a/tix/generic/tixOption.c b/tix/generic/tixOption.c
new file mode 100644
index 00000000000..5fa79f4f3ff
--- /dev/null
+++ b/tix/generic/tixOption.c
@@ -0,0 +1,385 @@
+/*
+ * tixOption.c --
+ *
+ * Handle the "$widget config" commands
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+/* ToDo:
+ *
+ * 1) ConfigSpec structures shouldn't be shared between parent and child
+ * classes.
+ * 2) Specs array should be compacted (no duplication) and sorted according
+ * to argvName during class declaration.
+ * 3) Merge aliases with specs
+ *
+ */
+#include <tk.h>
+#include <tixPort.h>
+#include <tixInt.h>
+
+static char * FormatConfigInfo _ANSI_ARGS_((
+ Tcl_Interp *interp, TixClassRecord *cPtr,
+ char * widRec, TixConfigSpec * spec));
+/*
+ * This is a lightweight interface for querying the value of a
+ * variable in the object. This is simpler compared to
+ * [lindex [$w config -flag] 4]
+ */
+int Tix_GetVar (interp, cPtr, widRec, flag)
+ Tcl_Interp *interp;
+ TixClassRecord *cPtr;
+ char * widRec;
+ char * flag;
+{
+ TixConfigSpec * spec;
+ char * value;
+
+ spec = Tix_FindConfigSpecByName(interp, cPtr, flag);
+ if (spec != NULL) {
+ if (spec->isAlias) {
+ flag = spec->realPtr->argvName;
+ } else {
+ /* The user may have specified a shorthand like -backgro */
+ flag = spec->argvName;
+ }
+ value = Tcl_GetVar2(interp, widRec, flag, TCL_GLOBAL_ONLY);
+
+ Tcl_AppendResult(interp, value, (char*)NULL);
+ return TCL_OK;
+ }
+ else {
+ return TCL_ERROR;
+ }
+}
+
+int
+Tix_QueryOneOption(interp, cPtr, widRec, flag)
+ Tcl_Interp *interp;
+ TixClassRecord *cPtr;
+ char *widRec;
+ char *flag;
+{
+ TixConfigSpec * spec;
+ char * list;
+
+ spec = Tix_FindConfigSpecByName(interp, cPtr, flag);
+ if (spec != NULL) {
+ list = FormatConfigInfo(interp, cPtr, widRec, spec);
+ Tcl_SetResult(interp, list, TCL_VOLATILE);
+
+ ckfree(list);
+ return TCL_OK;
+ }
+ else {
+ return TCL_ERROR;
+ }
+}
+
+/*
+ * Tix_QueryAllOptions --
+ *
+ * Note: This function does not call Tix_FindConfigSpec() because
+ * it just needs to print out the list of all configSpecs from the
+ * class structure.
+ *
+ */
+int
+Tix_QueryAllOptions (interp, cPtr, widRec)
+ Tcl_Interp *interp;
+ TixClassRecord * cPtr;
+ char *widRec;
+{
+ int i, code = TCL_OK;
+ char * list;
+ char * lead = "{";
+
+ /* Iterate over all the options of class */
+ for (i=0; i<cPtr->nSpecs; i++) {
+ if (cPtr->specs[i] && cPtr->specs[i]->argvName) {
+ list = FormatConfigInfo(interp, cPtr, widRec, cPtr->specs[i]);
+ Tcl_AppendResult(interp, lead, list, "}", (char *) NULL);
+
+ ckfree(list);
+ lead = " {";
+ }
+ }
+
+ return code;
+}
+
+TixConfigSpec *
+Tix_FindConfigSpecByName(interp, cPtr, flag)
+ Tcl_Interp * interp;
+ TixClassRecord * cPtr;
+ char * flag;
+{
+ char * classRec;
+ char * key;
+ int nMatch, i;
+ size_t len;
+ Tcl_HashEntry *hashPtr;
+ TixConfigSpec *configSpec;
+
+ classRec = cPtr->className;
+
+ /*
+ * First try to look up the confifspec in a hash table,
+ * it should be faster.
+ */
+
+ key = Tix_GetConfigSpecFullName(classRec, flag);
+ hashPtr = Tcl_FindHashEntry(_TixGetHashTable(interp, "tixSpecTab", NULL),
+ key);
+ ckfree(key);
+
+ if (hashPtr) {
+ return (TixConfigSpec *) Tcl_GetHashValue(hashPtr);
+ }
+
+ /*
+ * The user may specified a partial name. Try to match, but will
+ * return error if we don't get exactly one match.
+ */
+ len = strlen(flag);
+ for (configSpec=NULL,nMatch=0,i=0; i<cPtr->nSpecs; i++) {
+ if (strncmp(flag, cPtr->specs[i]->argvName, len) == 0) {
+ if (nMatch > 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "ambiguous option \"", flag, "\"",
+ (char*)NULL);
+ return NULL;
+ } else {
+ nMatch ++;
+ configSpec = cPtr->specs[i];
+ }
+ }
+ }
+
+ if (configSpec == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "unknown option \"", flag, "\"", (char*)NULL);
+ return NULL;
+ } else {
+ return configSpec;
+ }
+}
+
+char * Tix_GetConfigSpecFullName(classRec, flag)
+ char * classRec;
+ char * flag;
+{
+ char * buff;
+ int max;
+ int conLen;
+
+ conLen = strlen(classRec);
+ max = conLen + strlen(flag) + 1;
+ buff = (char*)ckalloc(max * sizeof(char));
+
+ strcpy(buff, classRec);
+ strcpy(buff+conLen, flag);
+
+ return buff;
+}
+
+int Tix_ChangeOptions(interp, cPtr, widRec, argc, argv)
+ Tcl_Interp *interp;
+ TixClassRecord *cPtr;
+ char * widRec;
+ int argc;
+ char ** argv;
+{
+ int i, code = TCL_OK;
+ TixConfigSpec * spec;
+
+ if (argc == 0) {
+ goto done;
+ }
+
+ if ((argc %2) != 0) {
+ if (Tix_FindConfigSpecByName(interp, cPtr, argv[argc-1])) {
+ Tcl_AppendResult(interp, "value for \"", argv[argc-1],
+ "\" missing", (char*)NULL);
+ } else {
+ /* The error message is already appended by
+ * Tix_FindConfigSpecByName()
+ */
+ }
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ for (i=0; i<argc; i+=2) {
+ spec = Tix_FindConfigSpecByName(interp, cPtr, argv[i]);
+
+ if (spec == NULL) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ if (Tix_ChangeOneOption(interp, cPtr, widRec, spec,
+ argv[i+1], 0, 0)!=TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+
+ done:
+ return code;
+}
+
+int Tix_CallConfigMethod(interp, cPtr, widRec, spec, value)
+ Tcl_Interp *interp;
+ TixClassRecord *cPtr;
+ char * widRec;
+ TixConfigSpec *spec;
+ char * value;
+{
+ char * argv[2];
+ char method[200];
+ char * context = Tix_GetContext(interp, widRec);
+ char * c;
+
+ sprintf(method, "config%s", spec->argvName);
+
+ c = Tix_FindMethod(interp, context, method);
+ if (c != NULL) {
+ argv[0] = value;
+ return Tix_CallMethod(interp, c, widRec, method, 1, argv);
+ }
+
+ c = Tix_FindMethod(interp, context, "config");
+ if (c != NULL) {
+ argv[0] = spec->argvName;
+ argv[1] = value;
+ return Tix_CallMethod(interp, c, widRec, "config", 2, argv);
+ }
+
+ return TCL_OK;
+}
+
+int Tix_ChangeOneOption(interp, cPtr, widRec, spec, value, isDefault, isInit)
+ Tcl_Interp *interp;
+ TixClassRecord *cPtr;
+ char * widRec;
+ TixConfigSpec *spec;
+ char * value;
+ int isDefault; /* Set to be true when Tix tries to set
+ * the options according to their default
+ * values */
+ int isInit; /* Set to true only if the option was
+ * specified at the widget creation command
+ */
+{
+ int code = TCL_OK;
+ char * newValue = NULL;
+
+ if (spec->isAlias) {
+ spec = spec->realPtr;
+ }
+
+ /* -- STEP 1 --
+ * Check if these variables are protected.
+ * readonly means the variable can never be assigned to.
+ * static means ths variable can only ne assigned during initialization.
+ */
+
+ if (!isDefault && spec->readOnly) {
+ Tcl_AppendResult(interp, "cannot assigned to readonly variable \"",
+ spec->argvName, "\"", (char*) NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+ if (!(isInit || isDefault) && spec->isStatic) {
+ Tcl_AppendResult(interp, "cannot assigned to static variable \"",
+ spec->argvName, "\"", (char*) NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ /* -- STEP 2 --
+ * Call the verify command to check whether the value is acceptable
+ *
+ */
+ if (spec->verifyCmd != NULL) {
+ char * cmdArgv[2];
+ cmdArgv[0] = spec->verifyCmd;
+ cmdArgv[1] = value;
+
+ if (Tix_EvalArgv(interp, 2, cmdArgv) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ } else {
+ newValue = value = tixStrDup(interp->result);
+ }
+ }
+
+ /* -- STEP 3 --
+ * Call the configuration method of the widget. This method may
+ * override the user-supplied value. The configuration method should
+ * not be called during initialization.
+ */
+ if (isInit || isDefault) {
+ /* No need to call the configuration method */
+ Tcl_SetVar2(interp, widRec, spec->argvName, value,TCL_GLOBAL_ONLY);
+ }
+ else {
+ if (Tix_CallConfigMethod(interp, cPtr, widRec, spec, value)!=TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ /* -- STEP 4 --
+ * If the configuration method does not override the value, set
+ * it in the widget record.
+ *
+ * If the configuration method has override the value, it will
+ * return a non-empty string. In this case, it is the configuration
+ * method's responsibility to set the value in the widget record.
+ */
+ if (interp->result && (*interp->result)) {
+ /* value was overrided. Don't do anything */
+ Tcl_ResetResult(interp);
+ } else {
+ Tcl_SetVar2(interp, widRec, spec->argvName, value,TCL_GLOBAL_ONLY);
+ }
+ }
+
+ done:
+ if (newValue) {
+ ckfree(newValue);
+ }
+ return code;
+}
+
+static char * FormatConfigInfo(interp, cPtr, widRec, sPtr)
+ Tcl_Interp *interp;
+ TixClassRecord *cPtr;
+ char * widRec;
+ TixConfigSpec * sPtr;
+{
+ char *argv[6];
+
+ if (sPtr->isAlias) {
+ if (cPtr->isWidget) {
+ argv[0] = sPtr->argvName;
+ argv[1] = sPtr->realPtr->dbName;
+ } else {
+ argv[0] = sPtr->argvName;
+ argv[1] = sPtr->realPtr->argvName;
+ }
+ return Tcl_Merge(2, argv);
+ } else {
+ argv[0] = sPtr->argvName;
+ argv[1] = sPtr->dbName;
+ argv[2] = sPtr->dbClass;
+ argv[3] = sPtr->defValue;
+ argv[4] = Tcl_GetVar2(interp, widRec, argv[0], TCL_GLOBAL_ONLY);
+
+ return Tcl_Merge(5, argv);
+ }
+}
diff --git a/tix/generic/tixPort.h b/tix/generic/tixPort.h
new file mode 100644
index 00000000000..3bf2b10193a
--- /dev/null
+++ b/tix/generic/tixPort.h
@@ -0,0 +1,121 @@
+/*
+ * tixPort.h --
+ *
+ * This header file handles porting issues that occur because of
+ * differences between systems. It reads in platform specific
+ * portability files.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#ifndef _TIX_PORT_H_
+#define _TIX_PORT_H_
+
+#ifndef _TCL
+#include "tcl.h"
+#endif
+
+#ifndef _TK
+#include "tk.h"
+#endif
+
+#if (!defined(__WIN32__)) && (!defined(_WIN32)) && (!defined(MAC_TCL))
+ /*
+ * The Tcl/Tk porting stuff is needed only in Unix.
+ */
+#if !defined(_TCLPORT) && !defined(_TKPORT)
+# ifdef _TKINT
+# include "tkPort.h"
+# else
+# include "tclPort.h"
+# endif
+#endif
+#endif
+
+#ifndef _TIX_H_
+#include <tix.h>
+#endif
+
+#if defined(__WIN32__) || defined(_WIN32)
+# include "tixWinPort.h"
+#else
+# if defined(MAC_TCL)
+# include "tixMacPort.h"
+# else
+# include "../unix/tixUnixPort.h"
+# endif
+#endif
+
+#ifdef BUILD_tix
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+#ifdef TK_4_1_OR_LATER
+
+EXTERN Tcl_HashTable * TixGetHashTable _ANSI_ARGS_((Tcl_Interp * interp,
+ char * name, Tcl_InterpDeleteProc *deleteProc));
+#define _TixGetHashTable(i,n,p) TixGetHashTable(i,n,p)
+
+#else
+
+EXTERN Tcl_HashTable * TixGetHashTable _ANSI_ARGS_((Tcl_Interp * interp,
+ char * name));
+#define _TixGetHashTable(i,n,p) TixGetHashTable(i,n)
+
+#endif
+
+#if (TK_MAJOR_VERSION > 4)
+
+/*
+ * The font handling is changed in Tk 8.0 and later
+ */
+
+typedef Tk_Font TixFont;
+#define TixFontId(font) Tk_FontId(font)
+
+EXTERN void TixComputeTextGeometry _ANSI_ARGS_((
+ TixFont fontStructPtr, char *string,
+ int numChars, int wrapLength, int *widthPtr,
+ int *heightPtr));
+EXTERN void TixDisplayText _ANSI_ARGS_((Display *display,
+ Drawable drawable, TixFont font,
+ char *string, int numChars, int x, int y,
+ int length, Tk_Justify justify, int underline,
+ GC gc));
+
+#define TixFreeFont Tk_FreeFont
+#define TixNameOfFont Tk_NameOfFont
+#define TixGetFont Tk_GetFont
+
+#else
+
+typedef XFontStruct* TixFont;
+#define TixFontId(font) ((font)->fid)
+#define TixComputeTextGeometry TkComputeTextGeometry
+#define TixDisplayText TkDisplayText
+#define TixFreeFont Tk_FreeFontStruct
+#define TixNameOfFont Tk_NameOfFontStruct
+#define TixGetFont Tk_GetFontStruct
+
+EXTERN void TkDisplayText _ANSI_ARGS_((Display *display,
+ Drawable drawable, XFontStruct *fontStructPtr,
+ char *string, int numChars, int x, int y,
+ int length, Tk_Justify justify, int underline,
+ GC gc));
+EXTERN void TkComputeTextGeometry _ANSI_ARGS_((
+ XFontStruct *fontStructPtr, char *string,
+ int numChars, int wrapLength, int *widthPtr,
+ int *heightPtr));
+
+
+#endif
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TIX_PORT_H_ */
diff --git a/tix/generic/tixScroll.c b/tix/generic/tixScroll.c
new file mode 100644
index 00000000000..0291147fcb1
--- /dev/null
+++ b/tix/generic/tixScroll.c
@@ -0,0 +1,188 @@
+/*
+ * tixScroll.c -- Handle all the mess of Tk scroll bars
+ *
+ *
+ *
+ */
+
+#include <tixInt.h>
+
+
+void Tix_InitScrollInfo(siPtr, type)
+ Tix_ScrollInfo * siPtr;
+ int type;
+{
+ Tix_IntScrollInfo* isiPtr = (Tix_IntScrollInfo*) siPtr;
+ Tix_DoubleScrollInfo* dsiPtr = (Tix_DoubleScrollInfo*)siPtr;
+
+ siPtr->command = NULL;
+ siPtr->type = type;
+
+ if (type == TIX_SCROLL_INT) {
+ isiPtr->total = 1;
+ isiPtr->window = 1;
+ isiPtr->offset = 0;
+ isiPtr->unit = 1;
+ }
+ else {
+ dsiPtr->total = 1.0;
+ dsiPtr->window = 1.0;
+ dsiPtr->offset = 0.0;
+ dsiPtr->unit = 1.0;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * Tix_GetScrollFractions --
+ *
+ * Compute the fractions of a scroll-able widget.
+ *
+ */
+void Tix_GetScrollFractions(siPtr, first_ret, last_ret)
+ Tix_ScrollInfo * siPtr;
+ double * first_ret;
+ double * last_ret;
+{
+ Tix_IntScrollInfo* isiPtr = (Tix_IntScrollInfo*) siPtr;
+ Tix_DoubleScrollInfo* dsiPtr = (Tix_DoubleScrollInfo*)siPtr;
+ double total, window, first;
+
+ if (siPtr->type == TIX_SCROLL_INT) {
+ total = isiPtr->total;
+ window = isiPtr->window;
+ first = isiPtr->offset;
+ } else {
+ total = dsiPtr->total;
+ window = dsiPtr->window;
+ first = dsiPtr->offset;
+ }
+
+ if (total == 0 || total < window) {
+ *first_ret = 0.0;
+ *last_ret = 1.0;
+ } else {
+ *first_ret = first / total;
+ *last_ret = (first+window) / total;
+ }
+}
+
+void Tix_UpdateScrollBar(interp, siPtr)
+ Tcl_Interp *interp;
+ Tix_ScrollInfo * siPtr;
+{
+ Tix_IntScrollInfo* isiPtr = (Tix_IntScrollInfo*) siPtr;
+ Tix_DoubleScrollInfo* dsiPtr = (Tix_DoubleScrollInfo*)siPtr;
+ double d_first, d_last;
+ char string[100];
+
+ if (siPtr->type == TIX_SCROLL_INT) {
+ /* Check whether the topPixel is out of bound */
+ if (isiPtr->offset < 0) {
+ isiPtr->offset = 0;
+ } else {
+ if (isiPtr->window > isiPtr->total) {
+ isiPtr->offset = 0;
+ }
+ else if((isiPtr->offset+isiPtr->window) > isiPtr->total) {
+ isiPtr->offset = isiPtr->total - isiPtr->window;
+ }
+ }
+ } else {
+ /* Check whether the topPixel is out of bound */
+ if (dsiPtr->offset < 0) {
+ dsiPtr->offset = 0;
+ } else {
+ if (dsiPtr->window > dsiPtr->total) {
+ dsiPtr->offset = 0;
+ }
+ else if((dsiPtr->offset+dsiPtr->window) > dsiPtr->total) {
+ dsiPtr->offset = dsiPtr->total - dsiPtr->window;
+ }
+ }
+ }
+
+
+ if (siPtr->command) {
+ Tix_GetScrollFractions(siPtr, &d_first, &d_last);
+
+ sprintf(string, " %f %f", d_first, d_last);
+ if (Tcl_VarEval(interp, siPtr->command, string,
+ (char *) NULL) != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (scrolling command executed by tixTList)");
+ Tk_BackgroundError(interp);
+ }
+ }
+}
+
+int Tix_SetScrollBarView(interp, siPtr, argc, argv, compat)
+ Tcl_Interp *interp; /* Current interpreter. */
+ Tix_ScrollInfo * siPtr;
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+ int compat; /* compatibility mode */
+{
+ Tix_IntScrollInfo* isiPtr = (Tix_IntScrollInfo*) siPtr;
+ Tix_DoubleScrollInfo* dsiPtr = (Tix_DoubleScrollInfo*)siPtr;
+ int offset;
+
+ if (compat && Tcl_GetInt(interp, argv[0], &offset) == TCL_OK) {
+ /* backward-compatible mode */
+ if (siPtr->type == TIX_SCROLL_INT) {
+ isiPtr->offset = offset;
+ }
+ else {
+ dsiPtr->offset = (double)offset;
+ }
+
+ return TCL_OK;
+ }
+ else {
+ int type, count;
+ double fraction;
+
+ Tcl_ResetResult(interp);
+
+ /* Tk_GetScrollInfo () wants strange argc,argv combinations .. */
+ type = Tk_GetScrollInfo(interp, argc+2, argv-2, &fraction, &count);
+
+ if (siPtr->type == TIX_SCROLL_INT) {
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ return TCL_ERROR;
+
+ case TK_SCROLL_MOVETO:
+ isiPtr->offset =
+ (int)(fraction * (double)isiPtr->total);
+ break;
+
+ case TK_SCROLL_PAGES:
+ isiPtr->offset += count * isiPtr->window;
+ break;
+
+ case TK_SCROLL_UNITS:
+ isiPtr->offset += count * isiPtr->unit;
+ break;
+ }
+ } else {
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ return TCL_ERROR;
+
+ case TK_SCROLL_MOVETO:
+ dsiPtr->offset =
+ fraction * dsiPtr->total;
+ break;
+
+ case TK_SCROLL_PAGES:
+ dsiPtr->offset += count * dsiPtr->window;
+ break;
+
+ case TK_SCROLL_UNITS:
+ dsiPtr->offset += count * dsiPtr->unit;
+ break;
+ }
+ }
+ }
+ return TCL_OK;
+}
diff --git a/tix/generic/tixSmpLs.c b/tix/generic/tixSmpLs.c
new file mode 100644
index 00000000000..3a945a7ee87
--- /dev/null
+++ b/tix/generic/tixSmpLs.c
@@ -0,0 +1,121 @@
+/*
+ * tixSmpLs.c --
+ *
+ * To implement simple link lists (next is always the first
+ * member of the list).
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+
+static Tix_ListInfo simpleListInfo = {
+ 0,
+ TIX_UNDEFINED,
+};
+
+void Tix_SimpleListInit(lPtr)
+ Tix_LinkList * lPtr;
+{
+ Tix_LinkListInit(lPtr);
+}
+
+
+void
+Tix_SimpleListAppend(lPtr, itemPtr, flags)
+ Tix_LinkList * lPtr;
+ char * itemPtr;
+ int flags;
+{
+ Tix_LinkListAppend(&simpleListInfo, lPtr, itemPtr, flags);
+}
+
+void Tix_SimpleListIteratorInit(liPtr)
+ Tix_ListIterator * liPtr;
+{
+ Tix_LinkListIteratorInit(liPtr);
+}
+
+void Tix_SimpleListStart(lPtr, liPtr)
+ Tix_LinkList * lPtr;
+ Tix_ListIterator * liPtr;
+{
+ Tix_LinkListStart(&simpleListInfo, lPtr, liPtr);
+}
+
+void Tix_SimpleListNext(lPtr, liPtr)
+ Tix_LinkList * lPtr;
+ Tix_ListIterator * liPtr;
+{
+ Tix_LinkListNext(&simpleListInfo, lPtr, liPtr);
+}
+
+/*
+ * To delete consecutive elements, you must delete, next, delete, next ...
+ */
+void Tix_SimpleListDelete(lPtr, liPtr)
+ Tix_LinkList * lPtr;
+ Tix_ListIterator * liPtr;
+{
+ Tix_LinkListDelete(&simpleListInfo, lPtr, liPtr);
+}
+
+/*----------------------------------------------------------------------
+ * Tix_SimpleListInsert --
+ *
+ * Insert the item at the position indicated by liPtr
+ *----------------------------------------------------------------------
+ */
+void Tix_SimpleListInsert(lPtr, itemPtr, liPtr)
+ Tix_LinkList * lPtr;
+ char * itemPtr;
+ Tix_ListIterator * liPtr;
+{
+ Tix_LinkListInsert(&simpleListInfo, lPtr, itemPtr, liPtr);
+}
+
+/*----------------------------------------------------------------------
+ * Tix_SimpleListFindAndDelete --
+ *
+ * Find an element and delete it.
+ *
+ * liPtr:
+ * Can be zero.
+ * If non-zero, the search will start from the current entry indexed
+ * by liPtr;
+ *
+ * Return value:
+ * 1 if element is found and deleted
+ * 0 if element is not found
+ *----------------------------------------------------------------------
+ */
+int Tix_SimpleListFindAndDelete(lPtr, itemPtr, liPtr)
+ Tix_LinkList * lPtr;
+ char * itemPtr;
+ Tix_ListIterator * liPtr;
+{
+ return Tix_LinkListFindAndDelete(&simpleListInfo, lPtr, itemPtr, liPtr);
+}
+
+int Tix_SimpleListDeleteRange(lPtr, fromPtr, toPtr, liPtr)
+ Tix_LinkList * lPtr;
+ char * fromPtr;
+ char * toPtr;
+ Tix_ListIterator * liPtr;
+{
+ return Tix_LinkListDeleteRange(&simpleListInfo, lPtr,
+ fromPtr, toPtr, liPtr);
+}
+
+int Tix_SimpleListFind(lPtr, itemPtr, liPtr)
+ Tix_LinkList * lPtr;
+ char * itemPtr;
+ Tix_ListIterator * liPtr;
+{
+ return Tix_LinkListFind(&simpleListInfo, lPtr, itemPtr, liPtr);
+}
diff --git a/tix/generic/tixTList.c b/tix/generic/tixTList.c
new file mode 100644
index 00000000000..ca363bf6256
--- /dev/null
+++ b/tix/generic/tixTList.c
@@ -0,0 +1,2469 @@
+/*
+ * tixTList.c --
+ *
+ * This module implements "TList" widgets.
+ *
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+#include <tixDef.h>
+#include <tixTList.h>
+
+#define TIX_UP 1
+#define TIX_DOWN 2
+#define TIX_LEFT 3
+#define TIX_RIGHT 4
+
+/*
+ * Information used for argv parsing.
+ */
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_COLOR, "-background", "background", "Background",
+ DEF_TLIST_BG_COLOR, Tk_Offset(WidgetRecord, normalBg),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_COLOR, "-background", "background", "Background",
+ DEF_TLIST_BG_MONO, Tk_Offset(WidgetRecord, normalBg),
+ 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_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground",
+ DEF_TLIST_BG_COLOR, Tk_Offset(WidgetRecord, border),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_BORDER, "-highlightbackground", "highlightBackground",
+ "HighlightBackground",
+ DEF_TLIST_BG_MONO, Tk_Offset(WidgetRecord, border),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_TLIST_BORDER_WIDTH, Tk_Offset(WidgetRecord, borderWidth), 0},
+
+ {TK_CONFIG_STRING, "-browsecmd", "browseCmd", "BrowseCmd",
+ DEF_TLIST_BROWSE_COMMAND, Tk_Offset(WidgetRecord, browseCmd),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_STRING, "-command", "command", "Command",
+ DEF_TLIST_COMMAND, Tk_Offset(WidgetRecord, command),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_TLIST_CURSOR, Tk_Offset(WidgetRecord, cursor),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+
+ {TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_TLIST_FONT, Tk_Offset(WidgetRecord, font), 0},
+
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_TLIST_FG_COLOR, Tk_Offset(WidgetRecord, normalFg),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_TLIST_FG_MONO, Tk_Offset(WidgetRecord, normalFg),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_INT, "-height", "height", "Height",
+ DEF_TLIST_HEIGHT, Tk_Offset(WidgetRecord, height), 0},
+
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_TLIST_HIGHLIGHT_COLOR, Tk_Offset(WidgetRecord, highlightColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_TLIST_HIGHLIGHT_MONO, Tk_Offset(WidgetRecord, highlightColorPtr),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_TLIST_HIGHLIGHT_WIDTH, Tk_Offset(WidgetRecord, highlightWidth), 0},
+
+ {TK_CONFIG_CUSTOM, "-itemtype", "itemType", "ItemType",
+ DEF_TLIST_ITEM_TYPE, Tk_Offset(WidgetRecord, diTypePtr),
+ 0, &tixConfigItemType},
+
+ {TK_CONFIG_UID, "-orient", "orient", "Orient",
+ DEF_TLIST_ORIENT, Tk_Offset(WidgetRecord, orientUid), 0},
+
+ {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
+ DEF_TLIST_PADX, Tk_Offset(WidgetRecord, padX), 0},
+
+ {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
+ DEF_TLIST_PADY, Tk_Offset(WidgetRecord, padY), 0},
+
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_TLIST_RELIEF, Tk_Offset(WidgetRecord, relief), 0},
+
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_TLIST_SELECT_BG_COLOR, Tk_Offset(WidgetRecord, selectBorder),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_TLIST_SELECT_BG_MONO, Tk_Offset(WidgetRecord, selectBorder),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth","BorderWidth",
+ DEF_TLIST_SELECT_BORDERWIDTH,Tk_Offset(WidgetRecord, selBorderWidth),0},
+
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_TLIST_SELECT_FG_COLOR, Tk_Offset(WidgetRecord, selectFg),
+ TK_CONFIG_COLOR_ONLY},
+
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_TLIST_SELECT_FG_MONO, Tk_Offset(WidgetRecord, selectFg),
+ TK_CONFIG_MONO_ONLY},
+
+ {TK_CONFIG_UID, "-selectmode", "selectMode", "SelectMode",
+ DEF_TLIST_SELECT_MODE, Tk_Offset(WidgetRecord, selectMode), 0},
+
+ {TK_CONFIG_UID, "-state", (char*)NULL, (char*)NULL,
+ DEF_TLIST_STATE, Tk_Offset(WidgetRecord, state), 0},
+
+ {TK_CONFIG_STRING, "-sizecmd", "sizeCmd", "SizeCmd",
+ DEF_TLIST_SIZE_COMMAND, Tk_Offset(WidgetRecord, sizeCmd),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_TLIST_TAKE_FOCUS, Tk_Offset(WidgetRecord, takeFocus),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_INT, "-width", "width", "Width",
+ DEF_TLIST_WIDTH, Tk_Offset(WidgetRecord, width), 0},
+
+ {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_TLIST_X_SCROLL_COMMAND,
+ Tk_Offset(WidgetRecord, scrollInfo[0].command),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ DEF_TLIST_Y_SCROLL_COMMAND,
+ Tk_Offset(WidgetRecord, scrollInfo[1].command),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+#define DEF_TLISTENTRY_STATE "normal"
+
+static Tk_ConfigSpec entryConfigSpecs[] = {
+
+ {TK_CONFIG_UID, "-state", (char*)NULL, (char*)NULL,
+ DEF_TLISTENTRY_STATE, Tk_Offset(ListEntry, state), 0},
+
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+static Tix_ListInfo entListInfo = {
+ Tk_Offset(ListEntry, next),
+ TIX_UNDEFINED,
+};
+
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+ /* These are standard procedures for TK widgets
+ * implemeted in C
+ */
+
+static void WidgetCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int WidgetConfigure _ANSI_ARGS_((Tcl_Interp *interp,
+ WidgetPtr wPtr, int argc, char **argv,
+ int flags));
+static void WidgetDestroy _ANSI_ARGS_((ClientData clientData));
+static void WidgetEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int WidgetCommand _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *, int argc, char **argv));
+static void WidgetDisplay _ANSI_ARGS_((ClientData clientData));
+static void WidgetComputeGeometry _ANSI_ARGS_((
+ ClientData clientData));
+
+ /* Extra procedures for this widget
+ */
+static void CancelRedrawWhenIdle _ANSI_ARGS_((WidgetPtr wPtr));
+static void CancelResizeWhenIdle _ANSI_ARGS_((WidgetPtr wPtr));
+static int ConfigElement _ANSI_ARGS_((WidgetPtr wPtr,
+ ListEntry *chPtr, int argc, char ** argv,
+ int flags, int forced));
+static void RedrawRows _ANSI_ARGS_((
+ WidgetPtr wPtr, Drawable pixmap));
+static void RedrawWhenIdle _ANSI_ARGS_((WidgetPtr wPtr));
+static void ResizeRows _ANSI_ARGS_((
+ WidgetPtr wPtr, int winW, int winH));
+static void ResizeWhenIdle _ANSI_ARGS_((WidgetPtr wPtr));
+static void ResizeNow _ANSI_ARGS_((WidgetPtr wPtr));
+static void UpdateScrollBars _ANSI_ARGS_((WidgetPtr wPtr,
+ int sizeChanged));
+static int Tix_TLGetFromTo _ANSI_ARGS_((
+ Tcl_Interp *interp, WidgetPtr wPtr,
+ int argc, char **argv,
+ ListEntry ** fromPtr_ret, ListEntry ** toPtr_ret));
+static void Tix_TLDItemSizeChanged _ANSI_ARGS_((
+ Tix_DItem *iPtr));
+static void MakeGeomRequest _ANSI_ARGS_((
+ WidgetPtr wPtr));
+static int Tix_TLGetNearest _ANSI_ARGS_((
+ WidgetPtr wPtr, int posn[2]));
+static int Tix_TLGetAt _ANSI_ARGS_((WidgetPtr wPtr,
+ Tcl_Interp *interp, char * spec, int *at));
+static int Tix_TLGetNeighbor _ANSI_ARGS_((
+ WidgetPtr wPtr, Tcl_Interp *interp,
+ int type, int argc, char **argv));
+static int Tix_TranslateIndex _ANSI_ARGS_((
+ WidgetPtr wPtr, Tcl_Interp *interp, char * string,
+ int * index, int isInsert));
+static int Tix_TLDeleteRange _ANSI_ARGS_((
+ WidgetPtr wPtr, ListEntry * fromPtr,
+ ListEntry *toPtr));
+static ListEntry * AllocEntry _ANSI_ARGS_((WidgetPtr wPtr));
+static int AddElement _ANSI_ARGS_((WidgetPtr wPtr,
+ ListEntry * chPtr, int at));
+static void FreeEntry _ANSI_ARGS_((WidgetPtr wPtr,
+ ListEntry * chPtr));
+static int Tix_TLSpecialEntryInfo _ANSI_ARGS_((
+ WidgetPtr wPtr, Tcl_Interp *interp,
+ ListEntry * chPtr));
+static void Realloc _ANSI_ARGS_((WidgetPtr wPtr,int new_size));
+
+static TIX_DECLARE_SUBCMD(Tix_TLInsert);
+static TIX_DECLARE_SUBCMD(Tix_TLCGet);
+static TIX_DECLARE_SUBCMD(Tix_TLConfig);
+static TIX_DECLARE_SUBCMD(Tix_TLDelete);
+static TIX_DECLARE_SUBCMD(Tix_TLEntryCget);
+static TIX_DECLARE_SUBCMD(Tix_TLEntryConfig);
+static TIX_DECLARE_SUBCMD(Tix_TLGeometryInfo);
+static TIX_DECLARE_SUBCMD(Tix_TLIndex);
+static TIX_DECLARE_SUBCMD(Tix_TLInfo);
+static TIX_DECLARE_SUBCMD(Tix_TLNearest);
+static TIX_DECLARE_SUBCMD(Tix_TLSee);
+static TIX_DECLARE_SUBCMD(Tix_TLSelection);
+static TIX_DECLARE_SUBCMD(Tix_TLSetSite);
+static TIX_DECLARE_SUBCMD(Tix_TLView);
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tix_TListCmd --
+ *
+ * This procedure is invoked to process the "tixTList" Tcl
+ * command. It creates a new "TixTList" widget.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * A new widget is created and configured.
+ *
+ *--------------------------------------------------------------
+ */
+int
+Tix_TListCmd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tk_Window main = (Tk_Window) clientData;
+ WidgetPtr wPtr;
+ 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, "TixTList");
+
+ /*
+ * Allocate and initialize the widget record.
+ */
+ wPtr = (WidgetPtr) ckalloc(sizeof(WidgetRecord));
+
+ wPtr->dispData.tkwin = tkwin;
+ wPtr->dispData.display = Tk_Display(tkwin);
+ wPtr->dispData.interp = interp;
+ wPtr->dispData.sizeChangedProc = Tix_TLDItemSizeChanged;
+ wPtr->font = NULL;
+ wPtr->normalBg = NULL;
+ wPtr->normalFg = NULL;
+ wPtr->command = NULL;
+ wPtr->border = NULL;
+ wPtr->borderWidth = 0;
+ wPtr->selectBorder = NULL;
+ wPtr->selBorderWidth = 0;
+ wPtr->selectFg = NULL;
+ wPtr->backgroundGC = None;
+ wPtr->selectGC = None;
+ wPtr->anchorGC = None;
+ wPtr->highlightWidth = 0;
+ wPtr->highlightColorPtr = NULL;
+ wPtr->highlightGC = None;
+ wPtr->relief = TK_RELIEF_FLAT;
+ wPtr->cursor = None;
+ wPtr->redrawing = 0;
+ wPtr->resizing = 0;
+ wPtr->hasFocus = 0;
+ wPtr->selectMode = NULL;
+ wPtr->seeElemPtr = NULL;
+ wPtr->anchor = NULL;
+ wPtr->active = NULL;
+ wPtr->dropSite = NULL;
+ wPtr->dragSite = NULL;
+ wPtr->sizeCmd = NULL;
+ wPtr->browseCmd = NULL;
+ wPtr->takeFocus = NULL;
+ wPtr->orientUid = NULL;
+ wPtr->serial = 0;
+ wPtr->state = tixNormalUid;
+ wPtr->rows = (ListRow*)ckalloc(sizeof(ListRow) *1);
+ wPtr->numRow = 1;
+ wPtr->numRowAllocd = 1;
+ wPtr->width = 0;
+ wPtr->height = 0;
+
+ Tix_LinkListInit(&wPtr->entList);
+ Tix_InitScrollInfo((Tix_ScrollInfo*)&wPtr->scrollInfo[0], TIX_SCROLL_INT);
+ Tix_InitScrollInfo((Tix_ScrollInfo*)&wPtr->scrollInfo[1], TIX_SCROLL_INT);
+
+ Tk_CreateEventHandler(wPtr->dispData.tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ WidgetEventProc, (ClientData) wPtr);
+ wPtr->widgetCmd = Tcl_CreateCommand(interp,
+ Tk_PathName(wPtr->dispData.tkwin), WidgetCommand, (ClientData) wPtr,
+ WidgetCmdDeletedProc);
+
+ if (WidgetConfigure(interp, wPtr, argc-2, argv+2, 0) != TCL_OK) {
+ Tk_DestroyWindow(wPtr->dispData.tkwin);
+ return TCL_ERROR;
+ }
+
+ interp->result = Tk_PathName(wPtr->dispData.tkwin);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WidgetConfigure --
+ *
+ * This procedure is called to process an argv/argc list in
+ * conjunction with the Tk option database to configure (or
+ * reconfigure) a List 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 wPtr; old resources get freed,
+ * if there were any.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+WidgetConfigure(interp, wPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ WidgetPtr wPtr; /* Information about widget. */
+ int argc; /* Number of valid entries in argv. */
+ char **argv; /* Arguments. */
+ int flags; /* Flags to pass to
+ * Tk_ConfigureWidget. */
+{
+ XGCValues gcValues;
+ GC newGC;
+ TixFont oldfont;
+ size_t length;
+ Tix_StyleTemplate stTmpl;
+
+ oldfont = wPtr->font;
+
+ if (Tk_ConfigureWidget(interp, wPtr->dispData.tkwin, configSpecs,
+ argc, argv, (char *) wPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ length = strlen(wPtr->orientUid);
+ if (strncmp(wPtr->orientUid, "vertical", length) == 0) {
+ wPtr->isVertical = 1;
+ } else if (strncmp(wPtr->orientUid, "horizontal", length) == 0) {
+ wPtr->isVertical = 0;
+ } else {
+ Tcl_AppendResult(interp, "bad orientation \"", wPtr->orientUid,
+ "\": must be vertical or horizontal", (char *) NULL);
+ wPtr->orientUid = Tk_GetUid("vertical");
+ wPtr->isVertical = 1;
+ return TCL_ERROR;
+ }
+
+ if ((wPtr->state != tixNormalUid) && (wPtr->state != tixDisabledUid)) {
+ Tcl_AppendResult(interp, "bad state value \"", wPtr->state,
+ "\": must be normal or disabled", (char *) NULL);
+ wPtr->state = tixNormalUid;
+ return TCL_ERROR;
+ }
+
+
+ if (oldfont != wPtr->font) {
+ /* Font has been changed (initialized) */
+ TixComputeTextGeometry(wPtr->font, "0", 1,
+ 0, &wPtr->scrollInfo[0].unit, &wPtr->scrollInfo[1].unit);
+ }
+
+ /*
+ * 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(wPtr->dispData.tkwin, wPtr->border);
+
+ /*
+ * Note: GraphicsExpose events are disabled in normalGC because it's
+ * used to copy stuff from an off-screen pixmap onto the screen (we know
+ * that there's no problem with obscured areas).
+ */
+
+ /* The background GC */
+ gcValues.foreground = wPtr->normalBg->pixel;
+ gcValues.graphics_exposures = False;
+
+ newGC = Tk_GetGC(wPtr->dispData.tkwin,
+ GCForeground|GCGraphicsExposures, &gcValues);
+ if (wPtr->backgroundGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->backgroundGC);
+ }
+ wPtr->backgroundGC = newGC;
+
+ /* The selected text GC */
+ gcValues.font = TixFontId(wPtr->font);
+ gcValues.foreground = wPtr->selectFg->pixel;
+ gcValues.background = Tk_3DBorderColor(wPtr->selectBorder)->pixel;
+ gcValues.graphics_exposures = False;
+
+ newGC = Tk_GetGC(wPtr->dispData.tkwin,
+ GCForeground|GCBackground|GCFont|GCGraphicsExposures, &gcValues);
+ if (wPtr->selectGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->selectGC);
+ }
+ wPtr->selectGC = newGC;
+
+ /* The dotted anchor lines */
+ gcValues.foreground = wPtr->normalFg->pixel;
+ gcValues.background = wPtr->normalBg->pixel;
+ gcValues.graphics_exposures = False;
+ gcValues.line_style = LineDoubleDash;
+ gcValues.dashes = 2;
+ gcValues.subwindow_mode = IncludeInferiors;
+
+ newGC = Tk_GetGC(wPtr->dispData.tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures|GCLineStyle|GCDashList|
+ GCSubwindowMode, &gcValues);
+ if (wPtr->anchorGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->anchorGC);
+ }
+ wPtr->anchorGC = newGC;
+
+ /* The highlight border */
+ gcValues.background = wPtr->selectFg->pixel;
+ gcValues.foreground = wPtr->highlightColorPtr->pixel;
+ gcValues.graphics_exposures = False;
+
+ newGC = Tk_GetGC(wPtr->dispData.tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures, &gcValues);
+ if (wPtr->highlightGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->highlightGC);
+ }
+ wPtr->highlightGC = newGC;
+
+ /* We must set the options of the default styles so that
+ * -- the default styles will change according to what is in
+ * stTmpl
+ */
+ stTmpl.font = wPtr->font;
+ stTmpl.pad[0] = wPtr->padX;
+ stTmpl.pad[1] = wPtr->padY;
+ stTmpl.colors[TIX_DITEM_NORMAL].fg = wPtr->normalFg;
+ stTmpl.colors[TIX_DITEM_NORMAL].bg = wPtr->normalBg;
+ stTmpl.colors[TIX_DITEM_SELECTED].fg= wPtr->selectFg;
+ stTmpl.colors[TIX_DITEM_SELECTED].bg= Tk_3DBorderColor(wPtr->selectBorder);
+ stTmpl.flags = TIX_DITEM_FONT|TIX_DITEM_NORMAL_BG|
+ TIX_DITEM_SELECTED_BG|TIX_DITEM_NORMAL_FG|TIX_DITEM_SELECTED_FG |
+ TIX_DITEM_PADX|TIX_DITEM_PADY;
+
+ Tix_SetDefaultStyleTemplate(wPtr->dispData.tkwin, &stTmpl);
+
+ /*
+ * Probably the -font or -width or -height options have changed. Let's
+ * make geometry request
+ */
+ MakeGeomRequest(wPtr);
+
+ ResizeWhenIdle(wPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WidgetCommand --
+ *
+ * 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
+WidgetCommand(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about the widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int code;
+
+ static Tix_SubCmdInfo subCmdInfo[] = {
+ {TIX_DEFAULT_LEN, "active", 1, 2, Tix_TLSetSite,
+ "option ?index?"},
+ {TIX_DEFAULT_LEN, "anchor", 1, 2, Tix_TLSetSite,
+ "option ?index?"},
+ {TIX_DEFAULT_LEN, "cget", 1, 1, Tix_TLCGet,
+ "option"},
+ {TIX_DEFAULT_LEN, "configure", 0, TIX_VAR_ARGS, Tix_TLConfig,
+ "?option? ?value? ?option value ... ?"},
+ {TIX_DEFAULT_LEN, "delete", 1, 2, Tix_TLDelete,
+ "from ?to?"},
+ {TIX_DEFAULT_LEN, "dragsite", 1, 2, Tix_TLSetSite,
+ "option ?entryPath?"},
+ {TIX_DEFAULT_LEN, "dropsite", 1, 2, Tix_TLSetSite,
+ "option ?entryPath?"},
+ {TIX_DEFAULT_LEN, "entrycget", 2, 2, Tix_TLEntryCget,
+ "entryPath option"},
+ {TIX_DEFAULT_LEN, "entryconfigure", 1, TIX_VAR_ARGS, Tix_TLEntryConfig,
+ "index ?option? ?value? ?option value ... ?"},
+ {TIX_DEFAULT_LEN, "geometryinfo", 0, 2, Tix_TLGeometryInfo,
+ "?width height?"},
+ {TIX_DEFAULT_LEN, "index", 1, 1, Tix_TLIndex,
+ "index"},
+ {TIX_DEFAULT_LEN, "info", 1, TIX_VAR_ARGS, Tix_TLInfo,
+ "option ?args ...?"},
+ {TIX_DEFAULT_LEN, "insert", 1, TIX_VAR_ARGS, Tix_TLInsert,
+ "where ?option value ..."},
+ {TIX_DEFAULT_LEN, "nearest", 2, 2, Tix_TLNearest,
+ "x y"},
+ {TIX_DEFAULT_LEN, "see", 1, 1, Tix_TLSee,
+ "entryPath"},
+ {TIX_DEFAULT_LEN, "selection", 1, 3, Tix_TLSelection,
+ "option arg ?arg ...?"},
+ {TIX_DEFAULT_LEN, "xview", 0, 3, Tix_TLView,
+ "args"},
+ {TIX_DEFAULT_LEN, "yview", 0, 3, Tix_TLView,
+ "args"},
+ };
+
+ static Tix_CmdInfo cmdInfo = {
+ Tix_ArraySize(subCmdInfo), 1, TIX_VAR_ARGS, "?option? arg ?arg ...?",
+ };
+
+ Tk_Preserve(clientData);
+ code = Tix_HandleSubCmds(&cmdInfo, subCmdInfo, clientData,
+ interp, argc, argv);
+ Tk_Release(clientData);
+
+ return code;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WidgetEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on Lists.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+static void
+WidgetEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+
+ switch (eventPtr->type) {
+ case DestroyNotify:
+ if (wPtr->dispData.tkwin != NULL) {
+ wPtr->dispData.tkwin = NULL;
+ Tcl_DeleteCommand(wPtr->dispData.interp,
+ Tcl_GetCommandName(wPtr->dispData.interp, wPtr->widgetCmd));
+ }
+ CancelResizeWhenIdle(wPtr);
+ CancelRedrawWhenIdle(wPtr);
+ Tk_EventuallyFree((ClientData) wPtr, (Tix_FreeProc*)WidgetDestroy);
+ break;
+
+ case ConfigureNotify:
+ ResizeWhenIdle(wPtr);
+ break;
+
+ case Expose:
+ RedrawWhenIdle(wPtr);
+ break;
+
+ case FocusIn:
+ wPtr->hasFocus = 1;
+ RedrawWhenIdle(wPtr);
+ break;
+
+ case FocusOut:
+ wPtr->hasFocus = 0;
+ RedrawWhenIdle(wPtr);
+ break;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WidgetDestroy --
+ *
+ * This procedure is invoked by Tk_EventuallyFree or Tk_Release
+ * to clean up the internal structure of a List at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the List is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+WidgetDestroy(clientData)
+ ClientData clientData; /* Info about my widget. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+
+
+ if (wPtr->backgroundGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->backgroundGC);
+ }
+ if (wPtr->selectGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->selectGC);
+ }
+ if (wPtr->anchorGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->anchorGC);
+ }
+ if (wPtr->highlightGC != None) {
+ Tk_FreeGC(wPtr->dispData.display, wPtr->highlightGC);
+ }
+
+ if (wPtr->entList.numItems > 0) {
+ ListEntry * fromPtr=NULL, *toPtr=NULL;
+ char * argv[2];
+ argv[0] = "0";
+ argv[1] = "end";
+
+ Tix_TLGetFromTo(wPtr->dispData.interp, wPtr, 2, argv, &fromPtr,&toPtr);
+ Tcl_ResetResult(wPtr->dispData.interp);
+
+ if (fromPtr && toPtr) {
+ Tix_TLDeleteRange(wPtr, fromPtr, toPtr);
+ }
+ }
+
+ if (wPtr->rows) {
+ ckfree((char*)wPtr->rows);
+ }
+
+ Tk_FreeOptions(configSpecs, (char *) wPtr, wPtr->dispData.display, 0);
+ ckfree((char *) wPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WidgetCmdDeletedProc --
+ *
+ * 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
+WidgetCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ WidgetPtr wPtr = (WidgetPtr) 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 (wPtr->dispData.tkwin != NULL) {
+ Tk_Window tkwin = wPtr->dispData.tkwin;
+ wPtr->dispData.tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WidgetComputeGeometry --
+ *
+ * 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:
+ * none
+ *
+ *--------------------------------------------------------------
+ */
+static void
+WidgetComputeGeometry(clientData)
+ ClientData clientData;
+{
+ WidgetPtr wPtr = (WidgetPtr)clientData;
+ int winW, winH;
+ Tk_Window tkwin = wPtr->dispData.tkwin;
+
+ wPtr->resizing = 0;
+
+ winW = Tk_Width(tkwin) - 2*wPtr->highlightWidth - 2*wPtr->borderWidth;
+ winH = Tk_Height(tkwin) - 2*wPtr->highlightWidth - 2*wPtr->borderWidth;
+
+ ResizeRows(wPtr, winW, winH);
+ /* Update scrollbars */
+ UpdateScrollBars(wPtr, 1);
+
+ RedrawWhenIdle(wPtr);
+}
+
+static void
+MakeGeomRequest(wPtr)
+ WidgetPtr wPtr;
+{
+ int reqW, reqH;
+
+ reqW = wPtr->width * wPtr->scrollInfo[0].unit;
+ reqH = wPtr->height * wPtr->scrollInfo[1].unit;
+
+ Tk_GeometryRequest(wPtr->dispData.tkwin, reqW, reqH);
+}
+
+
+
+/*----------------------------------------------------------------------
+ * DItemSizeChanged --
+ *
+ * This is called whenever the size of one of the HList's items
+ * changes its size.
+ *----------------------------------------------------------------------
+ */
+static void
+Tix_TLDItemSizeChanged(iPtr)
+ Tix_DItem *iPtr;
+{
+ WidgetPtr wPtr = (WidgetPtr)iPtr->base.clientData;
+
+ if (wPtr) {
+ /* double-check: perhaps we haven't set the clientData yet! */
+ ResizeWhenIdle(wPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * ResizeWhenIdle --
+ *----------------------------------------------------------------------
+ */
+static void
+ResizeWhenIdle(wPtr)
+ WidgetPtr wPtr;
+{
+ if (wPtr->redrawing) {
+ CancelRedrawWhenIdle(wPtr);
+ }
+ if (!wPtr->resizing) {
+ wPtr->resizing = 1;
+ Tk_DoWhenIdle(WidgetComputeGeometry, (ClientData)wPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * ResizeWhenIdle --
+ *----------------------------------------------------------------------
+ */
+static void
+ResizeNow(wPtr)
+ WidgetPtr wPtr;
+{
+ if (wPtr->resizing) {
+ Tk_CancelIdleCall(WidgetComputeGeometry, (ClientData)wPtr);
+
+ WidgetComputeGeometry((ClientData)wPtr);
+ wPtr->resizing = 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * CancelResizeWhenIdle --
+ *----------------------------------------------------------------------
+ */
+static void
+CancelResizeWhenIdle(wPtr)
+ WidgetPtr wPtr;
+{
+ if (wPtr->resizing) {
+ wPtr->resizing = 0;
+ Tk_CancelIdleCall(WidgetComputeGeometry, (ClientData)wPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * RedrawWhenIdle --
+ *----------------------------------------------------------------------
+ */
+static void
+RedrawWhenIdle(wPtr)
+ WidgetPtr wPtr;
+{
+ if (wPtr->resizing) {
+ /*
+ * Resize will eventually call redraw.
+ */
+ return;
+ }
+ if (!wPtr->redrawing && Tk_IsMapped(wPtr->dispData.tkwin)) {
+ wPtr->redrawing = 1;
+ Tk_DoWhenIdle(WidgetDisplay, (ClientData)wPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ * CancelRedrawWhenIdle --
+ *----------------------------------------------------------------------
+ */
+static void
+CancelRedrawWhenIdle(wPtr)
+ WidgetPtr wPtr;
+{
+ if (wPtr->redrawing) {
+ wPtr->redrawing = 0;
+ Tk_CancelIdleCall(WidgetDisplay, (ClientData)wPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WidgetDisplay --
+ *
+ * Draw the widget to the screen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+WidgetDisplay(clientData)
+ ClientData clientData; /* Info about my widget. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ Pixmap pixmap;
+ Tk_Window tkwin = wPtr->dispData.tkwin;
+ int winH, winW;
+
+ wPtr->redrawing = 0; /* clear the redraw flag */
+ wPtr->serial ++;
+
+ pixmap = Tk_GetPixmap(wPtr->dispData.display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+
+ /* Fill the background */
+ XFillRectangle(wPtr->dispData.display, pixmap, wPtr->backgroundGC,
+ 0, 0, Tk_Width(tkwin), Tk_Height(tkwin));
+
+ winW = Tk_Width(tkwin) - 2*wPtr->highlightWidth - 2*wPtr->borderWidth;
+ winH = Tk_Height(tkwin) - 2*wPtr->highlightWidth - 2*wPtr->borderWidth;
+
+ if (winW > 0 && winH > 0) {
+ RedrawRows(wPtr, pixmap);
+ }
+
+ /* Draw the border */
+ Tk_Draw3DRectangle(wPtr->dispData.tkwin, pixmap, wPtr->border,
+ wPtr->highlightWidth, wPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*wPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*wPtr->highlightWidth, wPtr->borderWidth,
+ wPtr->relief);
+
+ /* Draw the highlight */
+ if (wPtr->highlightWidth > 0) {
+ GC gc;
+
+ if (wPtr->hasFocus) {
+ gc = wPtr->highlightGC;
+ } else {
+ gc = Tk_3DBorderGC(wPtr->dispData.tkwin, wPtr->border,
+ TK_3D_FLAT_GC);
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, wPtr->highlightWidth, pixmap);
+ }
+
+ /*
+ * Copy the information from the off-screen pixmap onto the screen,
+ * then delete the pixmap.
+ */
+ XCopyArea(wPtr->dispData.display, pixmap, Tk_WindowId(tkwin),
+ wPtr->backgroundGC, 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), 0, 0);
+ Tk_FreePixmap(wPtr->dispData.display, pixmap);
+
+}
+
+/*----------------------------------------------------------------------
+ * AddElement --
+ *
+ * Add the element at the position indicated by "at".
+ *----------------------------------------------------------------------
+ */
+static int
+AddElement(wPtr, chPtr, at)
+ WidgetPtr wPtr;
+ ListEntry * chPtr;
+ int at;
+{
+ if (at >= wPtr->entList.numItems) {
+ /* The "end" position */
+ Tix_LinkListAppend(&entListInfo, &wPtr->entList, (char*)chPtr, 0);
+ }
+ else {
+ Tix_ListIterator li;
+ Tix_LinkListIteratorInit(&li);
+
+ for (Tix_LinkListStart(&entListInfo, &wPtr->entList, &li);
+ !Tix_LinkListDone(&li);
+ Tix_LinkListNext (&entListInfo, &wPtr->entList, &li)) {
+
+ if (at == 0) {
+ Tix_LinkListInsert(&entListInfo, &wPtr->entList,
+ (char*)chPtr, &li);
+ break;
+ } else {
+ -- at;
+ }
+ }
+ }
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * AllocEntry --
+ *
+ * Allocates memory for a new entry and initializes it to a
+ * proper state.
+ *----------------------------------------------------------------------
+ */
+static ListEntry *
+AllocEntry(wPtr)
+ WidgetPtr wPtr;
+{
+ ListEntry * chPtr;
+
+ chPtr = (ListEntry *)ckalloc(sizeof(ListEntry));
+ chPtr->state = NULL;
+ chPtr->selected = 0;
+ chPtr->iPtr = NULL;
+
+ return chPtr;
+}
+
+/*----------------------------------------------------------------------
+ * FreeEntry --
+ *
+ * Free the entry and all resources allocated to this entry.
+ * This entry must already be deleted from the list.
+ *----------------------------------------------------------------------
+ */
+static void
+FreeEntry(wPtr, chPtr)
+ WidgetPtr wPtr;
+ ListEntry * chPtr;
+{
+
+ if (wPtr->seeElemPtr == chPtr) {
+ /*
+ * This is the element that should be visible the next time
+ * we draw the window. Adjust the "to see element" to an element
+ * that is close to it.
+ */
+ if (chPtr->next != NULL) {
+ wPtr->seeElemPtr = chPtr->next;
+ } else {
+ ListEntry *p;
+
+ wPtr->seeElemPtr = NULL;
+ for (p=(ListEntry*)wPtr->entList.head; p; p=p->next) {
+ if (p->next == chPtr) {
+ wPtr->seeElemPtr = p;
+ break;
+ }
+ }
+ }
+ }
+
+ if (wPtr->anchor == chPtr) {
+ wPtr->anchor = NULL;
+ }
+ if (wPtr->active == chPtr) {
+ wPtr->active = NULL;
+ }
+ if (wPtr->dragSite == chPtr) {
+ wPtr->dragSite = NULL;
+ }
+ if (wPtr->dropSite == chPtr) {
+ wPtr->dropSite = NULL;
+ }
+
+ if (chPtr->iPtr != NULL) {
+ if (Tix_DItemType(chPtr->iPtr) == TIX_DITEM_WINDOW) {
+#if 0
+ Tix_WindowItemListRemove(&wPtr->mappedWindows,
+ chPtr->iPtr);
+#endif
+ }
+ Tix_DItemFree(chPtr->iPtr);
+ }
+
+ Tk_FreeOptions(entryConfigSpecs, (char *)chPtr,wPtr->dispData.display, 0);
+ ckfree((char*)chPtr);
+}
+
+/*----------------------------------------------------------------------
+ * "insert" sub command --
+ *
+ * Insert a new item into the list
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_TLInsert(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ ListEntry * chPtr = NULL;
+ char buff[40];
+ char * ditemType;
+ int at;
+ int added = 0;
+ int code = TCL_OK;
+
+ /*------------------------------------------------------------
+ * (1) We need to determine the options:
+ * -itemtype and -at.
+ *------------------------------------------------------------
+ */
+
+ /* (1.1) Find out where */
+ if (Tix_TranslateIndex(wPtr, interp, argv[0], &at, 1) != TCL_OK) {
+ code = TCL_ERROR; goto done;
+ }
+
+ /* (1.2) Find out the -itemtype, if specified */
+ ditemType = wPtr->diTypePtr->name; /* default value */
+ if (argc > 1) {
+ size_t len;
+ int i;
+ if (argc %2 != 1) {
+ Tcl_AppendResult(interp, "value for \"", argv[argc-1],
+ "\" missing", NULL);
+ code = TCL_ERROR; goto done;
+ }
+ for (i=1; i<argc; i+=2) {
+ len = strlen(argv[i]);
+ if (strncmp(argv[i], "-itemtype", len) == 0) {
+ ditemType = argv[i+1];
+ }
+ }
+ }
+
+ if (Tix_GetDItemType(interp, ditemType) == NULL) {
+ code = TCL_ERROR; goto done;
+ }
+
+ /*
+ * (2) Allocate a new entry
+ */
+ chPtr = AllocEntry(wPtr);
+
+ /* (2.1) The Display item data */
+ if ((chPtr->iPtr = Tix_DItemCreate(&wPtr->dispData, ditemType)) == NULL) {
+ code = TCL_ERROR; goto done;
+ }
+ chPtr->iPtr->base.clientData = (ClientData)wPtr;
+ chPtr->size[0] = chPtr->iPtr->base.size[0];
+ chPtr->size[1] = chPtr->iPtr->base.size[1];
+
+ /*
+ * (3) Add the entry into the list
+ */
+ if (AddElement(wPtr, chPtr, at) != TCL_OK) {
+ code = TCL_ERROR; goto done;
+ } else {
+ added = 1;
+ }
+
+ if (ConfigElement(wPtr, chPtr, argc-1, argv+1, 0, 1) != TCL_OK) {
+ code = TCL_ERROR; goto done;
+ }
+
+ ResizeWhenIdle(wPtr);
+
+ done:
+ if (code == TCL_ERROR) {
+ if (chPtr != NULL) {
+ if (added) {
+ Tix_LinkListFindAndDelete(&entListInfo, &wPtr->entList,
+ (char*)chPtr, NULL);
+ }
+ FreeEntry(wPtr, chPtr);
+ }
+ } else {
+ sprintf(buff, "%d", at);
+ Tcl_AppendResult(interp, buff, NULL);
+ }
+
+ return code;
+}
+
+static int
+Tix_TLSpecialEntryInfo(wPtr, interp, chPtr)
+ WidgetPtr wPtr;
+ Tcl_Interp *interp;
+ ListEntry * chPtr;
+{
+ char buff[100];
+
+ if (chPtr) {
+ int i;
+ Tix_ListIterator li;
+
+ Tix_LinkListIteratorInit(&li);
+
+ for (i=0,Tix_LinkListStart(&entListInfo, &wPtr->entList, &li);
+ !Tix_LinkListDone(&li);
+ Tix_LinkListNext(&entListInfo, &wPtr->entList, &li),i++) {
+ if (li.curr == (char*)chPtr) {
+ break;
+ }
+ }
+ if (li.curr != NULL) {
+ sprintf(buff, "%d", i);
+ Tcl_AppendResult(interp, buff, NULL);
+ } else {
+ panic("TList list entry is invalid");
+ }
+ } else {
+ Tcl_ResetResult(interp);
+ }
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "index" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_TLIndex(clientData, interp, argc, argv)
+ ClientData clientData; /* TList widget record. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int index;
+ char buff[100];
+
+ if (Tix_TranslateIndex(wPtr, interp, argv[0], &index, 0) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ sprintf(buff, "%d", index);
+ Tcl_AppendResult(interp, buff, NULL);
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "info" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_TLInfo(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ size_t len = strlen(argv[0]);
+
+ if (strncmp(argv[0], "anchor", len)==0) {
+ return Tix_TLSpecialEntryInfo(wPtr, interp, wPtr->anchor);
+ }
+ else if (strncmp(argv[0], "active", len)==0) {
+ return Tix_TLSpecialEntryInfo(wPtr, interp, wPtr->active);
+ }
+ else if (strncmp(argv[0], "down", len)==0) {
+ return Tix_TLGetNeighbor(wPtr, interp, TIX_DOWN, argc-1, argv+1);
+ }
+ else if (strncmp(argv[0], "left", len)==0) {
+ return Tix_TLGetNeighbor(wPtr, interp, TIX_LEFT, argc-1, argv+1);
+ }
+ else if (strncmp(argv[0], "right", len)==0) {
+ return Tix_TLGetNeighbor(wPtr, interp, TIX_RIGHT, argc-1, argv+1);
+ }
+ else if (strncmp(argv[0], "selection", len)==0) {
+ ListEntry *chPtr;
+ int i;
+ char buffer[32];
+
+ for (chPtr=(ListEntry*)wPtr->entList.head, i=0;
+ chPtr;
+ chPtr=chPtr->next, i++) {
+
+ if (chPtr->selected) {
+ if (i) {
+ Tcl_AppendResult(interp, " ", (char *) NULL);
+ }
+ sprintf(buffer, "%d", i);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ }
+ }
+ return TCL_OK;
+ }
+ else if (strncmp(argv[0], "size", len)==0) {
+ char buff[100];
+
+ sprintf(buff, "%d", wPtr->entList.numItems);
+ Tcl_AppendResult(interp, buff, NULL);
+
+ return TCL_OK;
+ }
+ else if (strncmp(argv[0], "up", len)==0) {
+ return Tix_TLGetNeighbor(wPtr, interp, TIX_UP, argc-1, argv+1);
+ }
+ else {
+ Tcl_AppendResult(interp, "unknown option \"", argv[0],
+ "\": must be anchor or selection",
+ NULL);
+ return TCL_ERROR;
+ }
+}
+
+static int
+Tix_TranslateIndex(wPtr, interp, string, index, isInsert)
+ WidgetPtr wPtr; /* TList widget record. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ char * string; /* String representation of the index. */
+ int * index; /* Returns the index value(0 = 1st element).*/
+ int isInsert; /* Is this function called by an "insert"
+ * operation? */
+{
+ if (strcmp(string, "end") == 0) {
+ *index = wPtr->entList.numItems;
+ }
+ else if (Tix_TLGetAt(wPtr, interp, string, index) != TCL_OK) {
+ if (Tcl_GetInt(interp, string, index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ else if (*index < 0) {
+ Tcl_AppendResult(interp,"expected non-negative integer but got \"",
+ string, "\"", NULL);
+ return TCL_ERROR;
+ }
+ }
+
+
+ /*
+ * The meaning of "end" means:
+ * isInsert:wPtr->entList.numItems
+ * !isInsert:wPtr->entList.numItems-1;
+ */
+
+ if (isInsert) {
+ if (*index > wPtr->entList.numItems) {
+ /*
+ * By default add it to the end, just to follow what TK
+ * does for the Listbox widget
+ */
+ *index = wPtr->entList.numItems;
+ }
+ } else {
+ if (*index >= wPtr->entList.numItems) {
+ /*
+ * By default add it to the end, just to follow what TK
+ * does for the Listbox widget
+ */
+ *index = wPtr->entList.numItems - 1;
+ }
+ }
+
+ if (*index < 0) {
+ *index = 0;
+ }
+
+ return TCL_OK;
+}
+
+static int Tix_TLGetNeighbor(wPtr, interp, type, argc, argv)
+ WidgetPtr wPtr;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int type;
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int index;
+ int dst;
+ int xStep, yStep;
+ int numPerRow;
+ char buff[100];
+
+ if (argc != 1) {
+ Tix_ArgcError(interp, argc+3, argv-3, 3, "index");
+ }
+
+ if (Tix_TranslateIndex(wPtr, interp, argv[0], &index, 0) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (wPtr->entList.numItems == 0) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
+
+ numPerRow = wPtr->rows[0].numEnt;
+
+ if (wPtr->isVertical) {
+ xStep = numPerRow;
+ yStep = 1;
+ } else {
+ xStep = 1;
+ yStep = numPerRow;
+ }
+
+ switch (type) {
+ case TIX_UP:
+ dst = index - yStep;
+ break;
+ case TIX_DOWN:
+ dst = index + yStep;
+ break;
+ case TIX_LEFT:
+ dst = index - xStep;
+ break;
+ case TIX_RIGHT:
+ dst = index + xStep;
+ break;
+ }
+
+ if (dst < 0) {
+ dst = index;
+ } else if (dst >= wPtr->entList.numItems) {
+ dst = index;
+ }
+
+ sprintf(buff, "%d", dst);
+ Tcl_AppendResult(interp, buff, NULL);
+
+ return TCL_OK;
+}
+
+
+
+/*----------------------------------------------------------------------
+ * "cget" sub command --
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_TLCGet(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+
+ return Tk_ConfigureValue(interp, wPtr->dispData.tkwin, configSpecs,
+ (char *)wPtr, argv[0], 0);
+}
+
+/*----------------------------------------------------------------------
+ * "configure" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_TLConfig(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+
+ if (argc == 0) {
+ return Tk_ConfigureInfo(interp, wPtr->dispData.tkwin, configSpecs,
+ (char *) wPtr, (char *) NULL, 0);
+ } else if (argc == 1) {
+ return Tk_ConfigureInfo(interp, wPtr->dispData.tkwin, configSpecs,
+ (char *) wPtr, argv[0], 0);
+ } else {
+ return WidgetConfigure(interp, wPtr, argc, argv,
+ TK_CONFIG_ARGV_ONLY);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * "geometryinfo" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_TLGeometryInfo(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int qSize[2];
+ double first[2], last[2];
+ char string[40];
+ int i;
+
+ if (argc == 2) {
+ if (Tcl_GetInt(interp, argv[0], &qSize[0]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[1], &qSize[1]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ qSize[0] = Tk_Width (wPtr->dispData.tkwin);
+ qSize[1] = Tk_Height(wPtr->dispData.tkwin);
+ }
+ qSize[0] -= 2*wPtr->borderWidth + 2*wPtr->highlightWidth;
+ qSize[1] -= 2*wPtr->borderWidth + 2*wPtr->highlightWidth;
+
+ for (i=0; i<2; i++) {
+ qSize[i] -= 2*wPtr->borderWidth + 2*wPtr->highlightWidth;
+ Tix_GetScrollFractions((Tix_ScrollInfo*)&wPtr->scrollInfo[i],
+ &first[i], &last[i]);
+ }
+
+ sprintf(string, "{%f %f} {%f %f}", first[0], last[0], first[1], last[1]);
+ Tcl_AppendResult(interp, string, NULL);
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "delete" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_TLDelete(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ ListEntry * fromPtr, *toPtr;
+ int code = TCL_OK;
+
+ if (argc < 1 || argc > 2) {
+ Tix_ArgcError(interp, argc+2, argv-2, 2, "from ?to?");
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ if (Tix_TLGetFromTo(interp, wPtr, argc, argv, &fromPtr, &toPtr)!= TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ if (fromPtr == NULL) {
+ goto done;
+ }
+
+ if (Tix_TLDeleteRange(wPtr, fromPtr, toPtr)) {
+ ResizeWhenIdle(wPtr);
+ }
+
+ done:
+ return code;
+}
+
+/* returns true if some element has been deleted */
+static int Tix_TLDeleteRange(wPtr, fromPtr, toPtr)
+ WidgetPtr wPtr;
+ ListEntry * fromPtr;
+ ListEntry *toPtr;
+{
+ int started;
+ Tix_ListIterator li;
+
+ Tix_LinkListIteratorInit(&li);
+ started = 0;
+ for (Tix_LinkListStart(&entListInfo, &wPtr->entList, &li);
+ !Tix_LinkListDone(&li);
+ Tix_LinkListNext (&entListInfo, &wPtr->entList, &li)) {
+
+ ListEntry * curr = (ListEntry *)li.curr;
+ if (curr == fromPtr) {
+ started = 1;
+ }
+ if (started) {
+ Tix_LinkListDelete(&entListInfo, &wPtr->entList, &li);
+ FreeEntry(wPtr, curr);
+ }
+ if (curr == toPtr) {
+ break;
+ }
+ }
+
+ return started;
+}
+
+
+/*----------------------------------------------------------------------
+ * "entrycget" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_TLEntryCget(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ ListEntry * chPtr, * dummy;
+
+ if (Tix_TLGetFromTo(interp, wPtr, 1, argv, &chPtr, &dummy)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (chPtr == NULL) {
+ Tcl_AppendResult(interp, "list entry \"", argv[0],
+ "\" does not exist", NULL);
+ return TCL_ERROR;
+ }
+
+ return Tix_ConfigureValue2(interp, wPtr->dispData.tkwin, (char *)chPtr,
+ entryConfigSpecs, chPtr->iPtr, argv[1], 0);
+}
+
+/*----------------------------------------------------------------------
+ * "entryconfigure" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_TLEntryConfig(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ ListEntry * chPtr, * dummy;
+
+ if (Tix_TLGetFromTo(interp, wPtr, 1, argv, &chPtr, &dummy)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (chPtr == NULL) {
+ Tcl_AppendResult(interp, "list entry \"", argv[0],
+ "\" does not exist", NULL);
+ return TCL_ERROR;
+ }
+
+ if (argc == 1) {
+ return Tix_ConfigureInfo2(interp, wPtr->dispData.tkwin,
+ (char*)chPtr, entryConfigSpecs, chPtr->iPtr, (char *) NULL, 0);
+ } else if (argc == 2) {
+ return Tix_ConfigureInfo2(interp, wPtr->dispData.tkwin,
+ (char*)chPtr, entryConfigSpecs, chPtr->iPtr, (char *) argv[1], 0);
+ } else {
+ return ConfigElement(wPtr, chPtr, argc-1, argv+1,
+ TK_CONFIG_ARGV_ONLY, 0);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * "nearest" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_TLNearest(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int posn[2];
+ int index;
+ char buff[100];
+
+ if (Tcl_GetInt(interp, argv[0], &posn[0]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[1], &posn[1]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ index = Tix_TLGetNearest(wPtr, posn);
+ Tcl_ResetResult(interp);
+
+ if (index != -1) {
+ sprintf(buff, "%d", index);
+ Tcl_AppendResult(interp, buff, NULL);
+ }
+ return TCL_OK;
+}
+
+static int Tix_TLGetAt(wPtr, interp, spec, at)
+ WidgetPtr wPtr;
+ Tcl_Interp *interp;
+ char * spec;
+ int *at;
+{
+ int posn[2];
+ char *p, *end;
+
+ if (spec[0] != '@') {
+ return TCL_ERROR;
+ }
+
+ p = spec+1;
+ posn[0] = strtol(p, &end, 0);
+ if ((end == p) || (*end != ',')) {
+ return TCL_ERROR;
+ }
+ p = end+1;
+ posn[1] = strtol(p, &end, 0);
+ if ((end == p) || (*end != 0)) {
+ return TCL_ERROR;
+ }
+
+ *at = Tix_TLGetNearest(wPtr, posn);
+ return TCL_OK;
+}
+
+static int Tix_TLGetNearest(wPtr, posn)
+ WidgetPtr wPtr;
+ int posn[2];
+{
+ int i, j, index;
+ int maxX, maxY;
+ int r, c;
+
+ if (wPtr->resizing) {
+ ResizeNow(wPtr);
+ }
+
+ if (wPtr->entList.numItems == 0) {
+ return -1;
+ }
+
+ /* clip off the position with the border of the window */
+
+ posn[0] -= wPtr->borderWidth + wPtr->highlightWidth;
+ posn[1] -= wPtr->borderWidth + wPtr->highlightWidth;
+
+ maxX = Tk_Width (wPtr->dispData.tkwin);
+ maxY = Tk_Height(wPtr->dispData.tkwin);
+
+ maxX -= 2*(wPtr->borderWidth + wPtr->highlightWidth);
+ maxY -= 2*(wPtr->borderWidth + wPtr->highlightWidth);
+
+ if (posn[0] >= maxX) {
+ posn[0] = maxX -1;
+ }
+ if (posn[1] >= maxY) {
+ posn[1] = maxY -1;
+ }
+ if (posn[0] < 0) {
+ posn[0] = 0;
+ }
+ if (posn[1] < 0) {
+ posn[1] = 0;
+ }
+
+ i = (wPtr->isVertical == 0);
+ j = (wPtr->isVertical == 1);
+
+ posn[0] += wPtr->scrollInfo[0].offset;
+ posn[1] += wPtr->scrollInfo[1].offset;
+
+ r = posn[i] / wPtr->maxSize[i];
+ c = posn[j] / wPtr->maxSize[j];
+
+ index = (r * wPtr->rows[0].numEnt) + c;
+
+ if (index >= wPtr->entList.numItems) {
+ index = wPtr->entList.numItems - 1;
+ }
+
+ return index;
+}
+
+/*----------------------------------------------------------------------
+ * "selection" sub command
+ * Modify the selection in this HList box
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_TLGetFromTo(interp, wPtr, argc, argv, fromPtr_ret, toPtr_ret)
+ Tcl_Interp *interp;
+ WidgetPtr wPtr;
+ int argc;
+ char **argv;
+ ListEntry ** fromPtr_ret;
+ ListEntry ** toPtr_ret;
+{
+ /*
+ * ToDo: make it more efficient by saving the previous from and to
+ * pointers and make the list of childrens a doubly-linked list
+ */
+ ListEntry * fromPtr;
+ ListEntry * toPtr;
+ int from, to, tmp;
+
+ if (Tix_TranslateIndex(wPtr, interp, argv[0], &from, 0) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (argc == 2) {
+ if (Tix_TranslateIndex(wPtr, interp, argv[1], &to, 0) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ to = from;
+ }
+
+ if (from > to) {
+ /* swap from and to */
+ tmp = to; to = from; from = tmp;
+ }
+
+ fromPtr = NULL;
+ toPtr = NULL;
+
+ if (from >= wPtr->entList.numItems) {
+ fromPtr = (ListEntry *)wPtr->entList.tail;
+ toPtr = (ListEntry *)wPtr->entList.tail;
+ }
+ if (to >= wPtr->entList.numItems) {
+ toPtr = (ListEntry *)wPtr->entList.tail;
+ }
+
+ if (fromPtr == NULL) {
+ for (fromPtr = (ListEntry*)wPtr->entList.head;
+ from > 0;
+ fromPtr=fromPtr->next) {
+
+ -- from;
+ -- to;
+ }
+ }
+ if (toPtr == NULL) {
+ for (toPtr = fromPtr; to > 0; toPtr=toPtr->next) {
+ -- to;
+ }
+ }
+
+ * fromPtr_ret = fromPtr;
+ if (toPtr_ret) {
+ * toPtr_ret = toPtr;
+ }
+ return TCL_OK;
+}
+
+static int
+Tix_TLSelection(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ size_t len = strlen(argv[0]);
+ int code = TCL_OK;
+ int changed = 0;
+ ListEntry * chPtr, * fromPtr, * toPtr;
+
+ if (strncmp(argv[0], "clear", len)==0) {
+ if (argc == 1) {
+ /*
+ * Clear all entries
+ */
+ for (chPtr=(ListEntry*)wPtr->entList.head;
+ chPtr;
+ chPtr=chPtr->next) {
+
+ chPtr->selected = 0;
+ }
+ changed = 1;
+ }
+ else {
+ if (Tix_TLGetFromTo(interp, wPtr, argc-1, argv+1, &fromPtr, &toPtr)
+ != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ if (fromPtr == NULL) {
+ goto done;
+ }
+ else {
+ while (1) {
+ fromPtr->selected = 0;
+ if (fromPtr == toPtr) {
+ break;
+ } else {
+ fromPtr=fromPtr->next;
+ }
+ }
+ changed = 1;
+ goto done;
+ }
+ }
+ }
+ else if (strncmp(argv[0], "includes", len)==0) {
+ if (argc != 2) {
+ Tix_ArgcError(interp, argc+2, argv-2, 3, "index");
+ code = TCL_ERROR;
+ goto done;
+ }
+ if (Tix_TLGetFromTo(interp, wPtr, argc-1, argv+1, &fromPtr, &toPtr)
+ != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ if (fromPtr->selected) {
+ Tcl_AppendResult(interp, "1", NULL);
+ } else {
+ Tcl_AppendResult(interp, "0", NULL);
+ }
+ }
+ else if (strncmp(argv[0], "set", len)==0) {
+ if (argc < 2 || argc > 3) {
+ Tix_ArgcError(interp, argc+2, argv-2, 3, "from ?to?");
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ if (Tix_TLGetFromTo(interp, wPtr, argc-1, argv+1, &fromPtr, &toPtr)
+ != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ if (fromPtr == NULL) {
+ goto done;
+ }
+ else {
+ while (1) {
+ fromPtr->selected = 1;
+ if (fromPtr == toPtr) {
+ break;
+ } else {
+ fromPtr=fromPtr->next;
+ }
+ }
+ changed = 1;
+ goto done;
+ }
+ }
+ else {
+ Tcl_AppendResult(interp, "unknown option \"", argv[0],
+ "\": must be anchor, clear, includes or set", NULL);
+ code = TCL_ERROR;
+ }
+
+ done:
+ if (changed) {
+ RedrawWhenIdle(wPtr);
+ }
+
+ return code;
+}
+
+/*----------------------------------------------------------------------
+ * "see" command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_TLSee(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ ListEntry * chPtr, * dummy;
+
+ if (argc == 1) {
+ if (Tix_TLGetFromTo(interp, wPtr, 1, argv, &chPtr, &dummy) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (chPtr != NULL) {
+ wPtr->seeElemPtr = chPtr;
+ RedrawWhenIdle(wPtr);
+ }
+ } else {
+ Tcl_AppendResult(interp, "wrong # of arguments, must be: ",
+ Tk_PathName(wPtr->dispData.tkwin), " ", argv[-1],
+ " index", NULL);
+ }
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "anchor", "dragsite" and "dropsite" sub commands --
+ *
+ * Set/remove the anchor element
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_TLSetSite(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ int changed = 0;
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ ListEntry * fromPtr;
+ ListEntry * toPtr; /* unused */
+ ListEntry ** changePtr;
+ size_t len;
+
+ /* Determine which site should be changed (the last else clause
+ * doesn't need to check the string because HandleSubCommand
+ * already ensures that only the valid options can be specified.
+ **/
+ len = strlen(argv[-1]);
+ if (strncmp(argv[-1], "anchor", len)==0) {
+ changePtr = &wPtr->anchor;
+ }
+ else if (strncmp(argv[-1], "active", len)==0) {
+ changePtr = &wPtr->active;
+ }
+ else if (strncmp(argv[-1], "dragsite", len)==0) {
+ changePtr = &wPtr->dragSite;
+ }
+ else {
+ changePtr = &wPtr->dropSite;
+ }
+
+ len = strlen(argv[0]);
+ if (strncmp(argv[0], "set", len)==0) {
+ if (argc == 2) {
+ if (Tix_TLGetFromTo(interp,wPtr, argc-1, argv+1, &fromPtr, &toPtr)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (*changePtr != fromPtr) {
+ *changePtr = fromPtr;
+ changed = 1;
+ }
+ } else {
+ Tcl_AppendResult(interp, "wrong # of arguments, must be: ",
+ Tk_PathName(wPtr->dispData.tkwin), " ", argv[-1],
+ " set index", NULL);
+ return TCL_ERROR;
+ }
+ }
+ else if (strncmp(argv[0], "clear", len)==0) {
+ if (*changePtr != NULL) {
+ *changePtr = NULL;
+ changed = 1;
+ }
+ }
+ else {
+ Tcl_AppendResult(interp, "wrong option \"", argv[0], "\", ",
+ "must be clear or set", NULL);
+ return TCL_ERROR;
+ }
+
+ if (changed) {
+ RedrawWhenIdle(wPtr);
+ }
+
+ return TCL_OK;
+}
+
+/*----------------------------------------------------------------------
+ * "xview" and "yview" sub command
+ *----------------------------------------------------------------------
+ */
+static int
+Tix_TLView(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ WidgetPtr wPtr = (WidgetPtr) clientData;
+ int axis;
+
+ if (argv[-1][0] == 'x') {
+ axis = 0;
+ } else {
+ axis = 1;
+ }
+
+ if (argc == 0) {
+ char string[80];
+ double first, last;
+
+ Tix_GetScrollFractions((Tix_ScrollInfo*)&wPtr->scrollInfo[axis],
+ &first, &last);
+
+ sprintf(string, "{%f %f}", first, last);
+ Tcl_AppendResult(interp, string, NULL);
+ return TCL_OK;
+ }
+ else if (Tix_SetScrollBarView(interp,
+ (Tix_ScrollInfo*)&wPtr->scrollInfo[axis], argc, argv, 0) != TCL_OK) {
+
+ return TCL_ERROR;
+ }
+
+ UpdateScrollBars(wPtr, 0);
+ RedrawWhenIdle(wPtr);
+ return TCL_OK;
+}
+/*----------------------------------------------------------------------
+ *
+ *
+ * Memory Management Section
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+ConfigElement(wPtr, chPtr, argc, argv, flags, forced)
+ WidgetPtr wPtr;
+ ListEntry *chPtr;
+ int argc;
+ char ** argv;
+ int flags;
+ int forced;
+{
+ int sizeChanged;
+
+ if (Tix_WidgetConfigure2(wPtr->dispData.interp, wPtr->dispData.tkwin,
+ (char*)chPtr, entryConfigSpecs, chPtr->iPtr, argc, argv, flags,
+ forced, &sizeChanged) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (sizeChanged) {
+ chPtr->size[0] = chPtr->iPtr->base.size[0];
+ chPtr->size[1] = chPtr->iPtr->base.size[1];
+ ResizeWhenIdle(wPtr);
+ } else {
+ RedrawWhenIdle(wPtr);
+ }
+ return TCL_OK;
+}
+
+static void
+Realloc(wPtr, new_size)
+ WidgetPtr wPtr;
+ int new_size;
+{
+ if (new_size < 1) {
+ new_size = 1;
+ }
+ if (new_size == wPtr->numRowAllocd) {
+ return;
+ }
+ wPtr->rows = (ListRow*)ckrealloc(wPtr->rows, sizeof(ListRow)*new_size);
+ wPtr->numRowAllocd = new_size;
+}
+
+static void ResizeRows(wPtr, winW, winH)
+ WidgetPtr wPtr;
+ int winW; /* -1 == current width */
+ int winH; /* -1 == current height */
+{
+ ListEntry * chPtr;
+ ListEntry * rowHead;
+ int n, c, r;
+ int maxI; /* max of width in the current column */
+ int maxJ; /* max of height among all elements */
+ int curRow;
+ int i, j;
+ int sizeJ;
+ int winSize[2];
+
+ if (wPtr->isVertical) {
+ i = 0; /* Column major, 0,0 -> 0,1 -> 0,2 ... -> 1,0 */
+ j = 1;
+ } else {
+ i = 1; /* Row major, 0,0 -> 1,0 -> 2,0 ... -> 0,1 */
+ j = 0;
+ }
+
+ if (winW == -1) {
+ winW = Tk_Width (wPtr->dispData.tkwin);
+ }
+ if (winH == -1) {
+ winH = Tk_Height(wPtr->dispData.tkwin);
+ }
+
+ winSize[0] = winW;
+ winSize[1] = winH;
+
+ if (wPtr->entList.numItems == 0) {
+ wPtr->rows[0].chPtr = NULL;
+ wPtr->rows[0].size[0] = 1;
+ wPtr->rows[0].size[1] = 1;
+ wPtr->rows[0].numEnt = 0;
+
+ wPtr->numRow = 1;
+ goto done;
+ }
+
+ /* -- The following verbal description follows the "Column Major"
+ * model. Row major are similar, just the i,j incides are swapped
+ *
+ * (1) (a) Search for the tallest element, use it as the height of all
+ * the elements;
+ * (b) Search for the widest element, use it as the width of all
+ * the elements;
+ */
+ for (maxJ=1, maxI=1, chPtr = (ListEntry*)wPtr->entList.head;
+ chPtr;
+ chPtr=chPtr->next) {
+
+ if (maxJ < chPtr->iPtr->base.size[j]) {
+ maxJ = chPtr->iPtr->base.size[j];
+ }
+ if (maxI < chPtr->iPtr->base.size[i]) {
+ maxI = chPtr->iPtr->base.size[i];
+ }
+ }
+ wPtr->maxSize[i] = maxI;
+ wPtr->maxSize[j] = maxJ;
+
+ /* (2) Calculate how many elements can be in each column
+ *
+ */
+ n = winSize[j] / maxJ;
+ if (n <=0) {
+ n = 1;
+ }
+
+ wPtr->numRow = 0;
+ curRow = 0;
+ c = 0;
+ sizeJ = 0;
+ rowHead = (ListEntry*)wPtr->entList.head;
+ for(chPtr = (ListEntry*)wPtr->entList.head; chPtr; chPtr=chPtr->next) {
+ sizeJ += chPtr->iPtr->base.size[j];
+ ++ c;
+ if (c == n || chPtr->next == NULL) {
+ if (curRow >= wPtr->numRowAllocd) {
+ Realloc(wPtr, curRow*2);
+ }
+ wPtr->rows[curRow].chPtr = rowHead;
+ wPtr->rows[curRow].size[i] = maxI;
+ wPtr->rows[curRow].size[j] = sizeJ;
+ wPtr->rows[curRow].numEnt = c;
+ ++ curRow;
+ ++ wPtr->numRow;
+ c = 0;
+ rowHead = chPtr->next;
+ sizeJ = 0;
+ }
+ }
+
+ done:
+ /* calculate the size of the total and visible area */
+ wPtr->scrollInfo[i].total = 0;
+ wPtr->scrollInfo[j].total = 0;
+
+ for (r=0; r<wPtr->numRow; r++) {
+ wPtr->scrollInfo[i].total += wPtr->rows[r].size[i];
+ if (wPtr->scrollInfo[j].total < wPtr->rows[r].size[j]) {
+ wPtr->scrollInfo[j].total = wPtr->rows[r].size[j];
+ }
+ }
+
+ wPtr->scrollInfo[i].window = winSize[i];
+ wPtr->scrollInfo[j].window = winSize[j];
+
+ if (wPtr->scrollInfo[i].total < 1) {
+ wPtr->scrollInfo[i].total = 1;
+ }
+ if (wPtr->scrollInfo[j].total < 1) {
+ wPtr->scrollInfo[j].total = 1;
+ }
+ if (wPtr->scrollInfo[i].window < 1) {
+ wPtr->scrollInfo[i].window = 1;
+ }
+ if (wPtr->scrollInfo[j].window < 1) {
+ wPtr->scrollInfo[j].window = 1;
+ }
+
+ /* If we have much fewer rows now, adjust the size of the rows list */
+ if (wPtr->numRowAllocd > (2*wPtr->numRow)) {
+ Realloc(wPtr, 2*wPtr->numRow);
+ }
+
+ /* Update the scrollbars */
+
+ UpdateScrollBars(wPtr, 1);
+}
+/*----------------------------------------------------------------------
+ * RedrawRows --
+ *
+ * Redraw the rows, according to the "offset: in both directions
+ *----------------------------------------------------------------------
+ */
+
+static void
+RedrawRows(wPtr, pixmap)
+ WidgetPtr wPtr;
+ Drawable pixmap;
+{
+ int r, n;
+ int p[2];
+ ListEntry * chPtr;
+ int i, j;
+ int total;
+ int windowSize;
+
+ if (wPtr->entList.numItems == 0) {
+ return;
+ }
+
+ if (wPtr->isVertical) {
+ i = 0; /* Column major, 0,0 -> 0,1 -> 0,2 ... -> 1,0 */
+ j = 1;
+ windowSize = Tk_Width(wPtr->dispData.tkwin);
+ } else {
+ i = 1; /* Row major, 0,0 -> 1,0 -> 2,0 ... -> 0,1 */
+ j = 0;
+ windowSize = Tk_Height(wPtr->dispData.tkwin);
+ }
+
+ p[i] = wPtr->highlightWidth + wPtr->borderWidth;
+ windowSize -= 2*p[i];
+
+ if (windowSize < 1) {
+ windowSize = 1;
+ }
+
+ if (wPtr->seeElemPtr != NULL) {
+ /*
+ * Adjust the scrolling so that the given entry is visible.
+ */
+ int start = 0; /* x1 position of the element to see. */
+ int size = 0; /* width of the element to see. */
+ int old = wPtr->scrollInfo[i].offset;
+
+ for (r=0, n=0, chPtr=(ListEntry*)wPtr->entList.head; chPtr;
+ chPtr=chPtr->next, n++) {
+ if (chPtr == wPtr->seeElemPtr) {
+ size = wPtr->rows[r].size[i];
+ break;
+ }
+ if (n == wPtr->rows[r].numEnt) {
+ n=0;
+ r++;
+ start += wPtr->rows[r].size[i];
+ }
+ }
+
+ if (wPtr->scrollInfo[i].offset + windowSize > start + size) {
+ wPtr->scrollInfo[i].offset = start + size - windowSize;
+ }
+ if (wPtr->scrollInfo[i].offset < start) {
+ wPtr->scrollInfo[i].offset = start;
+ }
+ if (wPtr->scrollInfo[i].offset != old) {
+ UpdateScrollBars(wPtr, 0);
+ }
+ wPtr->seeElemPtr = NULL;
+ }
+
+ /* Search for a row that is (possibly partially) visible*/
+ total=0; r=0;
+ if (wPtr->scrollInfo[i].offset != 0) {
+ for (; r<wPtr->numRow; r++) {
+ total += wPtr->rows[r].size[i];
+
+ if (total > wPtr->scrollInfo[i].offset) {
+ p[i] -= wPtr->scrollInfo[i].offset -
+ (total - wPtr->rows[r].size[i]);
+ break;
+ }
+ if (total == wPtr->scrollInfo[i].offset) {
+ r++;
+ break;
+ }
+ }
+ }
+
+ /* Redraw all the visible rows */
+ for (; r<wPtr->numRow; r++) {
+
+ p[j] = wPtr->highlightWidth + wPtr->borderWidth;
+
+ total=0; n=0; chPtr=wPtr->rows[r].chPtr;
+ if (wPtr->scrollInfo[j].offset > 0) {
+ /* Search for a column that is (possibly partially) visible*/
+ for (;
+ n<wPtr->rows[r].numEnt;
+ n++, chPtr = chPtr->next) {
+
+ total += chPtr->iPtr->base.size[j];
+ if (total > wPtr->scrollInfo[j].offset) {
+ /* Adjust for the shift due to partially visible elements*/
+ p[j] -= wPtr->scrollInfo[j].offset -
+ (total - chPtr->iPtr->base.size[j]);
+ break;
+ }
+ if (total == wPtr->scrollInfo[j].offset) {
+ n++; chPtr = chPtr->next;
+ break;
+ }
+ }
+ }
+
+ /* Redraw all the visible columns in this row */
+ for (; n<wPtr->rows[r].numEnt; n++, chPtr = chPtr->next) {
+ int flags = TIX_DITEM_NORMAL_FG;
+ int W, H;
+
+ if (chPtr->selected) {
+ flags |= TIX_DITEM_SELECTED_FG;
+ flags |= TIX_DITEM_SELECTED_BG;
+ }
+
+ if (wPtr->isVertical) {
+ W = wPtr->rows[r].size[0];
+ H = chPtr->iPtr->base.size[1];
+ } else {
+ H = wPtr->rows[r].size[1];
+ W = chPtr->iPtr->base.size[0];
+ }
+
+ Tix_DItemDisplay(pixmap, None, chPtr->iPtr, p[0], p[1], W, H,
+ flags);
+
+ if (chPtr == wPtr->anchor) {
+ Tix_DrawAnchorLines(Tk_Display(wPtr->dispData.tkwin), pixmap,
+ wPtr->anchorGC, p[0], p[1], W-1, H-1);
+ }
+ p[j] += wPtr->maxSize[j];
+ }
+
+ /* advance to the next row */
+ p[i]+= wPtr->rows[r].size[i];
+ }
+}
+
+/*----------------------------------------------------------------------
+ * UpdateScrollBars
+ *----------------------------------------------------------------------
+ */
+static void UpdateScrollBars(wPtr, sizeChanged)
+ WidgetPtr wPtr;
+ int sizeChanged;
+{
+ Tix_UpdateScrollBar(wPtr->dispData.interp,
+ (Tix_ScrollInfo*)&wPtr->scrollInfo[0]);
+ Tix_UpdateScrollBar(wPtr->dispData.interp,
+ (Tix_ScrollInfo*)&wPtr->scrollInfo[1]);
+
+ if (wPtr->sizeCmd && sizeChanged) {
+ if (Tcl_Eval(wPtr->dispData.interp, wPtr->sizeCmd) != TCL_OK) {
+ Tcl_AddErrorInfo(wPtr->dispData.interp,
+ "\n (size command executed by tixTList)");
+ Tk_BackgroundError(wPtr->dispData.interp);
+ }
+ }
+}
diff --git a/tix/generic/tixTList.h b/tix/generic/tixTList.h
new file mode 100644
index 00000000000..2a614e24946
--- /dev/null
+++ b/tix/generic/tixTList.h
@@ -0,0 +1,138 @@
+/*
+ * tixTList.h --
+ *
+ * This header file defines the data structures used by the tixTList
+ * widget.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#ifndef _TIX_TLIST_H_
+#define _TIX_TLIST_H_
+
+#define TIX_X 0
+#define TIX_Y 1
+
+typedef struct ListEntry {
+ struct ListEntry * next;
+ Tix_DItem * iPtr;
+ Tk_Uid state;
+ int size[2];
+ unsigned int selected : 1;
+} ListEntry;
+
+typedef struct ListRow {
+ ListEntry * chPtr;
+ int size[2];
+ int numEnt;
+} ListRow;
+
+/*
+ * A data structure of the following type is kept for each
+ * widget managed by this file:
+ */
+typedef struct ListStruct {
+ Tix_DispData dispData;
+
+ Tcl_Command widgetCmd; /* Token for button's widget command. */
+
+ /*
+ * Information used when displaying widget:
+ */
+ int width, height; /* For app programmer to request size */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ /* Border and general drawing */
+ int borderWidth; /* Width of 3-D borders. */
+ int selBorderWidth; /* Width of 3-D borders for selected items */
+ int relief; /* Indicates whether window as a whole is
+ * raised, sunken, or flat. */
+ Tk_3DBorder border; /* Used for drawing the 3d border. */
+ Tk_3DBorder selectBorder; /* Used for selected background. */
+ XColor *normalFg; /* Normal foreground for text. */
+ XColor *normalBg; /* Normal background for text. */
+ XColor *selectFg; /* Color for drawing selected text. */
+
+ /* GC and stuff */
+ GC backgroundGC; /* GC for drawing background. */
+ GC selectGC; /* GC for drawing selected background. */
+ GC anchorGC; /* GC for drawing dotted anchor highlight. */
+ TixFont font; /* Default font used by the DItems. */
+
+ /* Text drawing */
+ Cursor cursor; /* Current cursor for window, or None. */
+
+ /* For highlights */
+ int highlightWidth; /* Width in pixels of highlight to draw
+ * around widget when it has the focus.
+ * <= 0 means don't draw a highlight. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ GC highlightGC; /* For drawing traversal highlight. */
+
+ /* default pad and gap values */
+ int padX, padY;
+
+ Tk_Uid selectMode; /* Selection style: single, browse, multiple,
+ * or extended. This value isn't used in C
+ * code, but the Tcl bindings use it. */
+ Tk_Uid state; /* State can only be normal or disabled. */
+ Tix_LinkList entList;
+
+ int numRowAllocd;
+ int numRow;
+ ListRow * rows;
+
+ ListEntry * seeElemPtr; /* The current item to "see" */
+ ListEntry * anchor; /* The current anchor item */
+ ListEntry * active; /* The current active item */
+ ListEntry * dropSite; /* The current drop site */
+ ListEntry * dragSite; /* The current drop site */
+
+ /*
+ * Commands
+ */
+ char *command; /* The command when user double-clicks */
+ char *browseCmd; /* The command to call when the selection
+ * changes. */
+ char *sizeCmd; /* The command to call when the size of
+ * the listbox changes. E.g., when the user
+ * add/deletes elements. Useful for
+ * auto-scrollbar geometry managers */
+
+ /* These options control how the items are arranged on the list */
+ Tk_Uid orientUid; /* Can be "vertical" or "horizontal" */
+ int packMode[2]; /* is row and column packed */
+ int numMajor[2]; /* num of rows and columns */
+ int itemSize[2]; /* horizontal and vertical size of items, -1
+ * means natural size */
+
+ /* Info for laying out */
+ int maxSize[2]; /* max size of all elements in X and Y, (they
+ * do not need to be the same element, may be
+ * invalid according to mode */
+ 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 serial; /* this number is incremented before each time
+ * the widget is redisplayed */
+
+ Tix_DItemInfo * diTypePtr; /* Default item type */
+ Tix_IntScrollInfo scrollInfo[2];
+ unsigned int redrawing : 1;
+ unsigned int resizing : 1;
+ unsigned int hasFocus : 1;
+ unsigned int isVertical : 1;
+} TixTListWidget;
+
+typedef TixTListWidget WidgetRecord;
+typedef TixTListWidget * WidgetPtr;
+
+#endif /* _TIX_TLIST_H_ */
diff --git a/tix/generic/tixUtils.c b/tix/generic/tixUtils.c
new file mode 100644
index 00000000000..9a11b3805aa
--- /dev/null
+++ b/tix/generic/tixUtils.c
@@ -0,0 +1,863 @@
+/*
+ * tixUtils.c --
+ *
+ * This file contains some utility functions for Tix, such as the
+ * subcommand handling functions and option handling functions.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+/*
+ * tclInt.h is needed for the va_list declaration.
+ */
+#include <tclInt.h>
+#include <tixPort.h>
+#include <tixInt.h>
+
+/*
+ * 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));
+
+static int ReliefParseProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin, char *value,
+ char *widRec, int offset));
+static char * ReliefPrintProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *widRec, int offset,
+ Tix_FreeProc **freeProcPtr));
+/*
+ * Global vars used in this file
+ */
+static Tcl_DString command; /* Used to assemble lines of terminal input
+ * into Tcl commands. */
+
+
+#define WRONG_ARGC 1
+#define NO_MATCH 2
+
+
+/*----------------------------------------------------------------------
+ * TixSaveInterpState --
+ *
+ * Save the current application-visible state of the interpreter.
+ * This can later be restored by the TixSaveInterpState() function.
+ * These two functions are useful if you want to evaluate a Tcl
+ * command, which may cause errors, inside a command function.
+ *
+ * Each TixSaveInterpState() call much be matched by one
+ * TixRestoreInterpState() call with the same statePtr. statePtr
+ * should be allocated by the calling function, usually
+ * as a variable on the stack.
+ *----------------------------------------------------------------------
+ */
+
+void
+TixSaveInterpState(interp, statePtr)
+ Tcl_Interp * interp;
+ TixInterpState * statePtr;
+{
+ char * p;
+ if (interp->result) {
+ statePtr->result = (char*)tixStrDup(interp->result);
+ } else {
+ statePtr->result = NULL;
+ }
+
+ p = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
+ if (p) {
+ statePtr->errorInfo = (char*)tixStrDup(p);
+ } else {
+ statePtr->errorInfo = NULL;
+ }
+
+ p = Tcl_GetVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
+ if (p) {
+ statePtr->errorCode = (char*)tixStrDup(p);
+ } else {
+ statePtr->errorCode = NULL;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * TixRestoreInterpState --
+ *
+ * See TixSaveInterpState above.
+ *----------------------------------------------------------------------
+ */
+
+void
+TixRestoreInterpState(interp, statePtr)
+ Tcl_Interp * interp;
+ TixInterpState * statePtr;
+{
+ if (statePtr->result) {
+ Tcl_SetResult(interp, statePtr->result, TCL_DYNAMIC);
+ }
+ if (statePtr->errorInfo) {
+ Tcl_SetVar2(interp, "errorInfo", NULL, statePtr->errorInfo,
+ TCL_GLOBAL_ONLY);
+ ckfree((char*)statePtr->errorInfo);
+ } else {
+ Tcl_UnsetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
+ }
+ if (statePtr->errorCode) {
+ Tcl_SetVar2(interp, "errorCode", NULL, statePtr->errorCode,
+ TCL_GLOBAL_ONLY);
+ ckfree((char*)statePtr->errorCode);
+ } else {
+ Tcl_UnsetVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * Tix_HandleSubCmds --
+ *
+ * This function makes it easier to write major-minor style TCL
+ * commands. It matches the minor command (sub-command) names
+ * with names defined in the cmdInfo structure and call the
+ * appropriate sub-command functions for you. This function will
+ * automatically generate error messages when the user calls an
+ * invalid sub-command or calls a sub-command with incorrect
+ * number of arguments.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int Tix_HandleSubCmds(cmdInfo, subCmdInfo, clientData, interp, argc, argv)
+ Tix_CmdInfo * cmdInfo;
+ Tix_SubCmdInfo * subCmdInfo;
+ ClientData clientData; /* Main window associated with
+ * interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+
+ int i;
+ int len;
+ int error = NO_MATCH;
+ Tix_SubCmdInfo * s;
+
+ /*
+ * First check if the number of arguments to the major command
+ * is correct
+ */
+ argc -= 1;
+ if (argc < cmdInfo->minargc ||
+ (cmdInfo->maxargc != TIX_VAR_ARGS && argc > cmdInfo->maxargc)) {
+
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " ", cmdInfo->info, "\".", (char *) NULL);
+
+ return TCL_ERROR;
+ }
+
+ /*
+ * Now try to match the subcommands with argv[1]
+ */
+ argc -= 1;
+ len = strlen(argv[1]);
+
+ for (i = 0, s = subCmdInfo; i < cmdInfo->numSubCmds; i++, s++) {
+ if (s->name == TIX_DEFAULT_SUBCMD) {
+ if (s->checkArgvProc) {
+ if (!((*s->checkArgvProc)(clientData, interp, argc+1, argv+1))) {
+ /* Some improper argv in the arguments of the default
+ * subcommand
+ */
+ break;
+ }
+ }
+ return (*s->proc)(clientData, interp, argc+1, argv+1);
+ }
+
+ if (s->namelen == TIX_DEFAULT_LEN) {
+ s->namelen = strlen(s->name);
+ }
+ if (s->name[0] == argv[1][0] && strncmp(argv[1],s->name,len)==0) {
+ if (argc < s->minargc) {
+ error = WRONG_ARGC;
+ break;
+ }
+
+ if (s->maxargc != TIX_VAR_ARGS &&
+ argc > s->maxargc) {
+ error = WRONG_ARGC;
+ break;
+ }
+
+ /*
+ * Here we have a matched argc and command name --> go for it!
+ */
+ return (*s->proc)(clientData, interp, argc, argv+2);
+ }
+ }
+
+ if (error == WRONG_ARGC) {
+ /*
+ * got a match but incorrect number of arguments
+ */
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " ", argv[1], " ", s->info, "\"", (char *) NULL);
+ } else {
+ int max;
+
+ /*
+ * no match: let print out all the options
+ */
+ Tcl_AppendResult(interp, "unknown option \"",
+ argv[1], "\".", (char *) NULL);
+
+ if (cmdInfo->numSubCmds == 0) {
+ max = 0;
+ } else {
+ if (subCmdInfo[cmdInfo->numSubCmds-1].name == TIX_DEFAULT_SUBCMD) {
+ max = cmdInfo->numSubCmds-1;
+ } else {
+ max = cmdInfo->numSubCmds;
+ }
+ }
+
+ if (max == 0) {
+ Tcl_AppendResult(interp,
+ " This command does not take any options.",
+ (char *) NULL);
+ } else if (max == 1) {
+ Tcl_AppendResult(interp,
+ " Must be ", subCmdInfo->name, ".", (char *)NULL);
+ } else {
+ Tcl_AppendResult(interp, " Must be ", (char *) NULL);
+
+ for (i = 0, s = subCmdInfo; i < max; i++, s++) {
+ if (i == max-1) {
+ Tcl_AppendResult(interp,"or ",s->name, ".", (char *) NULL);
+ } else if (i == max-2) {
+ Tcl_AppendResult(interp, s->name, " ", (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, s->name, ", ", (char *) NULL);
+ }
+ }
+ }
+ }
+ return TCL_ERROR;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_Exit --
+ *
+ * Call the "exit" tcl command so that things can be cleaned up
+ * before calling the unix exit(2);
+ *
+ *----------------------------------------------------------------------
+ */
+void Tix_Exit(interp, code)
+ Tcl_Interp* interp;
+ int code;
+{
+ if (code != 0 && interp && interp->result != 0) {
+ fprintf(stderr, "%s\n", interp->result);
+ fprintf(stderr, "%s\n",
+ Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY));
+ }
+
+ if (interp) {
+ Tcl_GlobalEval(interp, "exit");
+ }
+ exit(code);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tix_LoadTclLibrary --
+ *
+ * Loads in a TCL library for an application according to
+ * the library settings.
+ *
+ * Results:
+ * TCL_OK or TCL_ERROR
+ *
+ * envName the environment variable that indicates the library
+ * tclName the TCL variable that points to the TCL library.
+ * initFile the file to load in during initialization.
+ * defDir the default directory to search if the user hasn't set
+ * the environment variable.
+ * appName the name of the application.
+ *----------------------------------------------------------------------
+ */
+
+/* Some compilers can't handle multi-line character strings very well ...
+ * So I just using this big lump of mess here.
+ */
+
+static char _format[] = "lappend auto_path $%s \nif [file exists $%s/%s] {\nsource $%s/%s\n} else {\nset msg \"\ncan't find $%s/%s;\\nperhaps you \"\nappend msg \"need to install %s\\nor set your %s \"\nappend msg \"environment variable?\"\nerror $msg\n}";
+
+int
+Tix_LoadTclLibrary(interp, envName, tclName, initFile, defDir, appName)
+ Tcl_Interp *interp;
+ char *envName;
+ char *tclName;
+ char *initFile;
+ char *defDir;
+ char *appName;
+{
+ char * libDir, *initCmd;
+ size_t size;
+ int code;
+ char *format;
+ format = _format;
+
+ libDir = getenv(envName);
+ if (libDir == NULL) {
+ libDir = defDir;
+ }
+
+ /*
+ * This size should be big enough.
+ */
+
+ size = strlen(format) + strlen(tclName)*4 + strlen(initFile)*3
+ + strlen(appName) + strlen(envName) + 100;
+ initCmd = ckalloc(sizeof(char) * size);
+
+ Tcl_SetVar(interp, tclName, libDir, TCL_GLOBAL_ONLY);
+
+ sprintf(initCmd, format,
+ tclName,
+ tclName, initFile,
+ tclName, initFile,
+ tclName, initFile,
+ appName, envName
+ );
+
+ code = Tcl_GlobalEval(interp, initCmd);
+ ckfree(initCmd);
+ return code;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_CreateCommands --
+ *
+ *
+ * Creates a list of commands stored in the array "commands"
+ *----------------------------------------------------------------------
+ */
+
+void Tix_CreateCommands(interp, commands, clientData, deleteProc)
+ Tcl_Interp *interp;
+ Tix_TclCmd *commands;
+ ClientData clientData;
+ Tcl_CmdDeleteProc *deleteProc;
+{
+ Tix_TclCmd * cmdPtr;
+
+ for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {
+ Tcl_CreateCommand(interp, cmdPtr->name,
+ cmdPtr->cmdProc, clientData, deleteProc);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * Tix_DrawAnchorLines --
+ *
+ * Draw dotted anchor lines around anchor elements
+ *----------------------------------------------------------------------
+ */
+
+void Tix_DrawAnchorLines(display, drawable, gc, x, y, w, h)
+ Display *display;
+ Drawable drawable;
+ GC gc;
+ int x;
+ int y;
+ int w;
+ int h;
+{
+ TixpDrawAnchorLines(display, drawable, gc, x, y, w, h);
+}
+
+/*----------------------------------------------------------------------
+ * Tix_CreateSubWindow --
+ *
+ * Creates a subwindow for a widget (usually used to draw headers,
+ * e.g, HList and Grid widgets)
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tix_CreateSubWindow(interp, tkwin, subPath)
+ Tcl_Interp * interp;
+ Tk_Window tkwin;
+ char * subPath;
+{
+ Tcl_DString dString;
+ Tk_Window subwin;
+
+ Tcl_DStringInit(&dString);
+ Tcl_DStringAppend(&dString, Tk_PathName(tkwin),
+ strlen(Tk_PathName(tkwin)));
+ Tcl_DStringAppend(&dString, ".tixsw:", 7);
+ Tcl_DStringAppend(&dString, subPath, strlen(subPath));
+
+ subwin = Tk_CreateWindowFromPath(interp, tkwin, dString.string,
+ (char *) NULL);
+
+ Tcl_DStringFree(&dString);
+
+ return subwin;
+}
+
+/*----------------------------------------------------------------------
+ * Tix_GetRenderBuffer --
+ *
+ * Returns a drawable for rendering a widget. If there is sufficient
+ * resource, a pixmap is returned so that double-buffering can
+ * be done. However, if resource is insufficient, then the
+ * windowId is returned. In the second case happens, the caller
+ * of this function has two choices: (1) draw to the window directly
+ * (which may lead to flashing on the screen) or (2) try to allocate
+ * smaller pixmaps.
+ *----------------------------------------------------------------------
+ */
+
+static int
+ErrorProc(clientData, errorEventPtr)
+ ClientData clientData;
+ XErrorEvent *errorEventPtr; /* unused */
+{
+ int * badAllocPtr = (int*) clientData;
+
+ * badAllocPtr = 1;
+ return 0; /* return 0 means error has been
+ * handled properly */
+}
+
+Drawable Tix_GetRenderBuffer(display, windowId, width, height, depth)
+ Display *display;
+ Window windowId;
+ int width;
+ int height;
+ int depth;
+{
+ Tk_ErrorHandler handler;
+ Pixmap pixmap;
+ int badAlloc = 0;
+
+ handler= Tk_CreateErrorHandler(display, BadAlloc,
+ -1, -1, (Tk_ErrorProc *) ErrorProc, (ClientData) &badAlloc);
+ pixmap = Tk_GetPixmap(display, windowId, width, height, depth);
+
+#ifndef _WINDOWS
+ /*
+ * This XSync call is necessary because X may delay the delivery of the
+ * error message. This will make our graphics a bit slower, though,
+ * especially over slow lines
+ */
+ XSync(display, 0);
+#endif
+ /* If ErrorProc() is eevr called, it is called before XSync returns */
+
+ Tk_DeleteErrorHandler(handler);
+
+ if (!badAlloc) {
+ return pixmap;
+ } else {
+ return windowId;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tix_GlobalVarEval --
+ *
+ * Given a variable number of string arguments, concatenate them
+ * all together and execute the result as a Tcl command in the global
+ * scope.
+ *
+ * Results:
+ * A standard Tcl return result. An error message or other
+ * result may be left in interp->result.
+ *
+ * Side effects:
+ * Depends on what was done by the command.
+ *
+ *----------------------------------------------------------------------
+ */
+ /* VARARGS2 */ /* ARGSUSED */
+int
+#ifdef TCL_VARARGS_DEF
+Tix_GlobalVarEval TCL_VARARGS_DEF(Tcl_Interp *,arg1)
+#else
+#ifndef lint
+Tix_GlobalVarEval(va_alist)
+#else
+Tix_GlobalVarEval(iPtr, p, va_alist)
+ Tcl_Interp *iPtr; /* Interpreter in which to execute command. */
+ char *p; /* One or more strings to concatenate,
+ * terminated with a NULL string. */
+#endif
+ va_dcl
+#endif
+{
+ va_list argList;
+ Tcl_DString buf;
+ char *string;
+ Tcl_Interp *interp;
+ int result;
+
+#ifdef TCL_VARARGS_DEF
+ /*
+ * Copy the strings one after the other into a single larger
+ * string. Use stack-allocated space for small commands, but if
+ * the command gets too large than call ckalloc to create the
+ * space.
+ */
+
+ interp = TCL_VARARGS_START(Tcl_Interp *,arg1,argList);
+ Tcl_DStringInit(&buf);
+ while (1) {
+ string = va_arg(argList, char *);
+ if (string == NULL) {
+ break;
+ }
+ Tcl_DStringAppend(&buf, string, -1);
+ }
+ va_end(argList);
+
+ result = Tcl_GlobalEval(interp, Tcl_DStringValue(&buf));
+ Tcl_DStringFree(&buf);
+ return result;
+#else
+ va_start(argList);
+ interp = va_arg(argList, Tcl_Interp *);
+ Tcl_DStringInit(&buf);
+ while (1) {
+ string = va_arg(argList, char *);
+ if (string == NULL) {
+ break;
+ }
+ Tcl_DStringAppend(&buf, string, -1);
+ }
+ va_end(argList);
+
+ result = Tcl_GlobalEval(interp, Tcl_DStringValue(&buf));
+ Tcl_DStringFree(&buf);
+ return result;
+#endif
+}
+
+/*----------------------------------------------------------------------
+ * TixGetHashTable --
+ *
+ * This functions makes it possible to keep one hash table per
+ * interpreter. This way, Tix classes can be used in multiple
+ * interpreters.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef TK_4_1_OR_LATER
+
+static void DeleteHashTableProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp * interp));
+static void
+DeleteHashTableProc(clientData, interp)
+ ClientData clientData;
+ Tcl_Interp * interp;
+{
+ Tcl_HashTable * htPtr = (Tcl_HashTable *)clientData;
+ Tcl_HashSearch hashSearch;
+ Tcl_HashEntry * hashPtr;
+
+ for (hashPtr = Tcl_FirstHashEntry(htPtr, &hashSearch);
+ hashPtr;
+ hashPtr = Tcl_NextHashEntry(&hashSearch)) {
+ Tcl_DeleteHashEntry(hashPtr);
+ }
+
+ Tcl_DeleteHashTable(htPtr);
+ ckfree((char*)htPtr);
+}
+
+Tcl_HashTable *
+TixGetHashTable(interp, name, deleteProc)
+ Tcl_Interp * interp;
+ char * name;
+ Tcl_InterpDeleteProc *deleteProc;
+{
+ Tcl_HashTable * htPtr;
+
+ htPtr = (Tcl_HashTable*)Tcl_GetAssocData(interp, name, NULL);
+ if (htPtr == NULL) {
+ htPtr = (Tcl_HashTable *)ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(htPtr, TCL_STRING_KEYS);
+ Tcl_SetAssocData(interp, name, NULL, (ClientData)htPtr);
+ if (deleteProc) {
+ Tcl_CallWhenDeleted(interp, deleteProc, (ClientData)htPtr);
+ } else {
+ Tcl_CallWhenDeleted(interp, DeleteHashTableProc,
+ (ClientData)htPtr);
+ }
+ }
+
+ return htPtr;
+}
+
+#else
+
+Tcl_HashTable *
+TixGetHashTable(interp, name)
+ Tcl_Interp * interp; /* Current interpreter. */
+ char * name; /* Textual name of the hash table. */
+{
+ static int inited = 0;
+ static Tcl_HashTable classTable;
+ static Tcl_HashTable methodTable;
+ static Tcl_HashTable specTable;
+
+ if (!inited) {
+ Tcl_InitHashTable(&classTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&methodTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&specTable, TCL_STRING_KEYS);
+ inited = 1;
+ }
+
+ if (strcmp(name, "tixClassTab") == 0) {
+ return &classTable;
+ } else if (strcmp(name, "tixSpecTab") == 0) {
+ return &specTable;
+ } else if (strcmp(name, "tixMethodTab") == 0) {
+ return &methodTable;
+ } else {
+ panic("Unknown hash table %s", name);
+ }
+}
+#endif
+
+/*----------------------------------------------------------------------
+ *
+ * The Tix Customed Config Options
+ *
+ *----------------------------------------------------------------------
+ */
+
+/*----------------------------------------------------------------------
+ * ReliefParseProc --
+ *
+ * Parse the text string and store the Tix_Relief information
+ * inside the widget record.
+ *----------------------------------------------------------------------
+ */
+static int ReliefParseProc(clientData, interp, tkwin, value, widRec,offset)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ Tk_Window tkwin;
+ char *value;
+ char *widRec; /* Must point to a valid Tix_DItem struct */
+ int offset;
+{
+ Tix_Relief * ptr = (Tix_Relief *)(widRec + offset);
+ Tix_Relief newVal;
+
+ if (value != NULL) {
+ size_t len = strlen(value);
+
+ if (strncmp(value, "raised", len) == 0) {
+ newVal = TIX_RELIEF_RAISED;
+ } else if (strncmp(value, "flat", len) == 0) {
+ newVal = TIX_RELIEF_FLAT;
+ } else if (strncmp(value, "sunken", len) == 0) {
+ newVal = TIX_RELIEF_SUNKEN;
+ } else if (strncmp(value, "groove", len) == 0) {
+ newVal = TIX_RELIEF_GROOVE;
+ } else if (strncmp(value, "ridge", len) == 0) {
+ newVal = TIX_RELIEF_RIDGE;
+ } else if (strncmp(value, "solid", len) == 0) {
+ newVal = TIX_RELIEF_SOLID;
+ } else {
+ goto error;
+ }
+ } else {
+ value = "";
+ goto error;
+ }
+
+ *ptr = newVal;
+ return TCL_OK;
+
+ error:
+ Tcl_AppendResult(interp, "bad relief type \"", value,
+ "\": must be flat, groove, raised, ridge, solid or sunken", NULL);
+ return TCL_ERROR;
+}
+
+static char *ReliefPrintProc(clientData, tkwin, widRec,offset, freeProcPtr)
+ ClientData clientData;
+ Tk_Window tkwin;
+ char *widRec;
+ int offset;
+ Tix_FreeProc **freeProcPtr;
+{
+ Tix_Relief *ptr = (Tix_Relief*)(widRec+offset);
+
+ switch (*ptr) {
+ case TIX_RELIEF_RAISED:
+ return "raised";
+ case TIX_RELIEF_FLAT:
+ return "flat";
+ case TIX_RELIEF_SUNKEN:
+ return "sunken";
+ case TIX_RELIEF_GROOVE:
+ return "groove";
+ case TIX_RELIEF_RIDGE:
+ return "ridge";
+ case TIX_RELIEF_SOLID:
+ return "solid";
+ default:
+ return "unknown";
+ }
+}
+/*
+ * The global data structures to use in widget configSpecs arrays
+ *
+ * These are declared in <tix.h>
+ */
+
+Tk_CustomOption tixConfigRelief = {
+ ReliefParseProc, ReliefPrintProc, 0,
+};
+
+/* Tix_SetRcFileName --
+ *
+ * Sets a user-specific startup file in a way that's compatible with
+ * different versions of Tclsh
+ */
+void Tix_SetRcFileName(interp, rcFileName)
+ Tcl_Interp * interp;
+ char * rcFileName;
+{
+#ifdef TCL_7_5_OR_LATER
+ /*
+ * Starting from TCL 7.5, the symbol tcl_rcFileName is no longer
+ * exported by libtcl.a. Instead, this variable must be set using
+ * a TCL global variable
+ */
+ Tcl_SetVar(interp, "tcl_rcFileName", rcFileName, TCL_GLOBAL_ONLY);
+#else
+ tcl_RcFileName = rcFileName;
+#endif
+}
+
+#if (TK_MAJOR_VERSION > 4)
+
+/*
+ * The TkComputeTextGeometry function is no longer supported in Tk 8.0+
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TixComputeTextGeometry --
+ *
+ * This procedure computes the amount of screen space needed to
+ * display a multi-line string of text.
+ *
+ * Results:
+ * There is no return value. The dimensions of the screen area
+ * needed to display the text are returned in *widthPtr, and *heightPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TixComputeTextGeometry(font, string, numChars, wrapLength,
+ widthPtr, heightPtr)
+ TixFont font; /* Font that will be used to display text. */
+ char *string; /* String whose dimensions are to be
+ * computed. */
+ int numChars; /* Number of characters to consider from
+ * string. */
+ int wrapLength; /* Longest permissible line length, in
+ * pixels. <= 0 means no automatic wrapping:
+ * just let lines get as long as needed. */
+ int *widthPtr; /* Store width of string here. */
+ int *heightPtr; /* Store height of string here. */
+{
+ Tk_TextLayout textLayout;
+
+ /*
+ * The justification itself doesn't affect the geometry (size) of
+ * the text string. We pass TK_JUSTIFY_LEFT.
+ */
+
+ textLayout = Tk_ComputeTextLayout(font,
+ string, numChars, wrapLength, TK_JUSTIFY_LEFT, 0,
+ widthPtr, heightPtr);
+ Tk_FreeTextLayout(textLayout);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TixDisplayText --
+ *
+ * Display a text string on one or more lines.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The text given by "string" gets displayed at the given location
+ * in the given drawable with the given font etc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TixDisplayText(display, drawable, font, string, numChars, x, y,
+ length, justify, underline, gc)
+ Display *display; /* X display to use for drawing text. */
+ Drawable drawable; /* Window or pixmap in which to draw the
+ * text. */
+ TixFont font; /* Font that determines geometry of text
+ * (should be same as font in gc). */
+ char *string; /* String to display; may contain embedded
+ * newlines. */
+ int numChars; /* Number of characters to use from string. */
+ int x, y; /* Pixel coordinates within drawable of
+ * upper left corner of display area. */
+ int length; /* Line length in pixels; used to compute
+ * word wrap points and also for
+ * justification. Must be > 0. */
+ Tk_Justify justify; /* How to justify lines. */
+ int underline; /* Index of character to underline, or < 0
+ * for no underlining. */
+ GC gc; /* Graphics context to use for drawing text. */
+{
+ Tk_TextLayout textLayout;
+ int dummy;
+
+ textLayout = Tk_ComputeTextLayout(font,
+ string, numChars, length, justify, 0,
+ &dummy, &dummy);
+
+ Tk_DrawTextLayout(display, drawable, gc, textLayout,
+ x, y, 0, -1);
+ Tk_UnderlineTextLayout(display, drawable, gc,
+ textLayout, x, y, underline);
+
+ Tk_FreeTextLayout(textLayout);
+}
+#endif
+
diff --git a/tix/generic/tixWidget.c b/tix/generic/tixWidget.c
new file mode 100644
index 00000000000..a225eec1997
--- /dev/null
+++ b/tix/generic/tixWidget.c
@@ -0,0 +1,309 @@
+/*
+ * tixWidget.c --
+ *
+ * Constructs Tix-based compound widgets
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tclInt.h>
+#include <tixInt.h>
+#include <tixItcl.h>
+
+static int ParseOptions _ANSI_ARGS_((
+ Tcl_Interp * interp,TixClassRecord * cPtr,
+ char *widRec, int argc, char** argv));
+
+TIX_DECLARE_CMD(Tix_InstanceCmd);
+
+/*----------------------------------------------------------------------
+ * Tix_CreateWidgetCmd
+ *
+ * Create an instance object of a Tix widget class.
+ *
+ * argv[0] = object name.
+ * argv[1+] = args
+ *----------------------------------------------------------------------
+ */
+TIX_DEFINE_CMD(Tix_CreateWidgetCmd)
+{
+ TixClassRecord * cPtr =(TixClassRecord *)clientData;
+ TixConfigSpec * spec;
+ char * widRec = NULL;
+ char * rootCmd = NULL;
+ char * tmpArgv[3];
+ char * value;
+ int i;
+ int code = TCL_OK;
+ Tk_Window mainWin = Tk_MainWindow(interp);
+ Tcl_DString ds;
+
+ DECLARE_ITCL_NAMESP(nameSp, interp);
+
+ if (argc <= 1) {
+ return Tix_ArgcError(interp, argc, argv, 1, "pathname ?arg? ...");
+ } else {
+ widRec = argv[1];
+ }
+
+ if (Tk_NameToWindow(interp, widRec, mainWin) != NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "window name \"", widRec,
+ "\" already exists", NULL);
+ return TCL_ERROR;
+ } else {
+ Tcl_ResetResult(interp);
+ }
+
+ if (!TixItclSetGlobalNameSp(&nameSp, interp)) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * Before doing anything, let's reset the TCL result, errorInfo,
+ * errorCode, etc.
+ */
+ Tcl_SetVar2(interp, "errorInfo", NULL, "", TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, "errorCode", NULL, "", TCL_GLOBAL_ONLY);
+ Tcl_ResetResult(interp);
+
+ /* Set up the widget record */
+ rootCmd = ckalloc(strlen(widRec)+10);
+ sprintf(rootCmd, "%s:root", widRec);
+ Tcl_SetVar2(interp, widRec, "className", cPtr->className, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, widRec, "ClassName", cPtr->ClassName, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, widRec, "context", cPtr->className, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, widRec, "w:root", widRec, TCL_GLOBAL_ONLY);
+ Tcl_SetVar2(interp, widRec, "rootCmd", rootCmd, TCL_GLOBAL_ONLY);
+
+ /* We need to create the root widget in order to parse the options
+ * database
+ */
+ if (Tix_CallMethod(interp, cPtr->className, widRec, "CreateRootWidget",
+ argc-2, argv+2) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ /* Parse the options specified in the option database and supplied
+ * in the command line.
+ */
+ Tcl_ResetResult(interp);
+ if (ParseOptions(interp, cPtr, widRec, argc-2, argv+2) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ /* Rename the root widget command and create a new TCL command for
+ * this widget
+ */
+
+#ifndef TK_8_0_OR_LATER
+ tmpArgv[0] = "rename";
+ tmpArgv[1] = widRec;
+ tmpArgv[2] = rootCmd;
+
+ if (Tcl_RenameCmd((ClientData)0, interp, 3, tmpArgv) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+#else
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppendElement(&ds, "rename");
+ Tcl_DStringAppendElement(&ds, widRec);
+ Tcl_DStringAppendElement(&ds, rootCmd);
+
+ if (Tcl_Eval(interp, ds.string) != TCL_OK) {
+ Tcl_DStringFree(&ds);
+ code = TCL_ERROR;
+ goto done;
+ } else {
+ Tcl_DStringFree(&ds);
+ }
+#endif
+
+ Tcl_CreateCommand(interp, widRec, Tix_InstanceCmd,
+ (ClientData)cPtr, NULL);
+
+ /* Now call the initialization methods defined by the Tix Intrinsics
+ */
+ if (Tix_CallMethod(interp, cPtr->className, widRec, "InitWidgetRec",
+ 0, 0) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ if (Tix_CallMethod(interp, cPtr->className, widRec, "ConstructWidget",
+ 0, 0) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ if (Tix_CallMethod(interp, cPtr->className, widRec, "SetBindings",
+ 0, 0) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ /* The widget has been successfully initialized. Now call the config
+ * method for all -forceCall options
+ */
+ for (i=0; i<cPtr->nSpecs; i++) {
+ spec = cPtr->specs[i];
+ if (spec->forceCall) {
+ value = Tcl_GetVar2(interp, widRec, spec->argvName,
+ TCL_GLOBAL_ONLY);
+ if (Tix_CallConfigMethod(interp, cPtr, widRec, spec,
+ value)!=TCL_OK){
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+ }
+
+ Tcl_SetResult(interp, widRec, TCL_VOLATILE);
+
+ done:
+
+ if (code != TCL_OK) {
+ /* %% TCL CORE USED !! %% */
+ Interp *iPtr = (Interp *) interp;
+ char * oldResult, * oldErrorInfo, * oldErrorCode;
+ Tk_Window topLevel, tkwin;
+
+ /* We need to save the old error message because
+ * interp->result may be changed by some of the following function
+ * calls.
+ */
+ if (interp->result) {
+ oldResult = (char*)tixStrDup(interp->result);
+#if 0
+ printf("%s -->\n%s\n", widRec, oldResult);
+#endif
+ } else {
+ oldResult = NULL;
+ }
+ oldErrorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
+ oldErrorCode = Tcl_GetVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
+
+ Tcl_ResetResult(interp);
+
+ /* (1) window */
+ topLevel = cPtr->mainWindow;
+
+ if (widRec != NULL) {
+ Display *display = NULL;
+
+ tkwin = Tk_NameToWindow(interp, widRec, topLevel);
+ if (tkwin != NULL) {
+ display = Tk_Display(tkwin);
+ Tk_DestroyWindow(tkwin);
+ }
+
+ /* (2) widget command + root command */
+ Tcl_DeleteCommand(interp, widRec);
+ Tcl_DeleteCommand(interp, rootCmd);
+
+ /* (3) widget record */
+ Tcl_UnsetVar(interp, widRec, TCL_GLOBAL_ONLY);
+
+ if (display) {
+#ifndef _WINDOWS
+ XSync(display, False);
+#endif
+ while (1) {
+ if (Tk_DoOneEvent(TK_X_EVENTS|TK_DONT_WAIT) == 0) {
+ break;
+ }
+ }
+ }
+ }
+ if (oldResult) {
+ Tcl_SetResult(interp, oldResult, TCL_DYNAMIC);
+ }
+ if (oldErrorInfo && *oldErrorInfo) {
+ Tcl_SetVar2(interp, "errorInfo", NULL, oldErrorInfo,
+ TCL_GLOBAL_ONLY);
+ } else {
+ Tcl_SetVar2(interp, "errorInfo", NULL, oldResult,
+ TCL_GLOBAL_ONLY);
+ }
+ if (oldErrorCode) {
+ Tcl_SetVar2(interp, "errorCode", NULL, oldErrorCode,
+ TCL_GLOBAL_ONLY);
+ }
+ iPtr->flags |= ERR_IN_PROGRESS;
+ }
+ if (rootCmd) {
+ ckfree(rootCmd);
+ }
+
+ TixItclRestoreGlobalNameSp(&nameSp, interp);
+
+ return code;
+}
+
+/*----------------------------------------------------------------------
+ * Subroutines for object instantiation.
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+static int ParseOptions(interp, cPtr, widRec, argc, argv)
+ Tcl_Interp * interp;
+ TixClassRecord * cPtr;
+ char *widRec;
+ int argc;
+ char** argv;
+{
+ int i;
+ TixConfigSpec *spec;
+ Tk_Window tkwin;
+ char * value;
+
+ if ((argc %2) != 0) {
+ Tcl_AppendResult(interp, "missing argument for \"", argv[argc-1],
+ "\"", NULL);
+ return TCL_ERROR;
+ }
+
+ if ((tkwin = Tk_NameToWindow(interp, widRec, cPtr->mainWindow)) == NULL) {
+ return TCL_ERROR;
+ }
+
+ /* Set all specs by their default values */
+ for (i=0; i<cPtr->nSpecs; i++) {
+ spec = cPtr->specs[i];
+
+ if (!spec->isAlias) {
+ if ((value=Tk_GetOption(tkwin,spec->dbName,spec->dbClass))==NULL) {
+ value = spec->defValue;
+ }
+ if (Tix_ChangeOneOption(interp, cPtr, widRec, spec,
+ value, 1, 0)!=TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ }
+
+ /* Set specs according to argument line values */
+ for (i=0; i<argc; i+=2) {
+ spec = Tix_FindConfigSpecByName(interp, cPtr, argv[i]);
+
+ if (spec == NULL) { /* this is an invalid flag */
+ return TCL_ERROR;
+ }
+
+ if (Tix_ChangeOneOption(interp, cPtr, widRec, spec,
+ argv[i+1], 0, 1)!=TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ return TCL_OK;
+}
diff --git a/tix/generic/tk4.2/console.tcl b/tix/generic/tk4.2/console.tcl
new file mode 100644
index 00000000000..f9a6254c558
--- /dev/null
+++ b/tix/generic/tk4.2/console.tcl
@@ -0,0 +1,433 @@
+# 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.34 96/08/26 20:14:30
+#
+# 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.
+#
+
+# TODO: history - remember partially written command
+
+# tkConsoleInit --
+# This procedure constructs and configures the console windows.
+#
+# Arguments:
+# None.
+
+proc tkConsoleInit {} {
+ if ![winfo exists .console] tkConsoleInit
+
+ global tcl_platform
+
+ if {[info commands macscrollbar] == "macscrollbar"} {
+ # Use the native scrollbar for the console
+ rename scrollbar ""
+ rename macscrollbar scrollbar
+ }
+ 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"} {
+ after idle {.console configure -font {Monaco 9 normal}}
+ .sb configure -bg white
+ .console configure -bg white -bd 0 -highlightthickness 0 \
+ -selectbackground black -selectforeground white \
+ -selectborderwidth 0 -insertwidth 1
+ .console tag configure sel -relief ridge
+ bind .console <FocusIn> { .console tag configure sel -borderwidth 0
+ .console configure -selectbackground black -selectforeground white }
+ bind .console <FocusOut> { .console tag configure sel -borderwidth 2
+ .console configure -selectbackground white -selectforeground black }
+ }
+
+ tkConsoleBind .console
+
+ .console tag configure stderr -foreground red
+ .console tag configure stdin -foreground blue
+
+ focus .console
+
+ wm protocol . WM_DELETE_WINDOW { wm withdraw . }
+ wm title . "Console"
+ flush stdout
+ .console mark set output [.console index "end - 1 char"]
+ tkTextSetCursor .console end
+ .console mark set promptEnd insert
+ .console mark gravity promptEnd left
+}
+
+# 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} {
+ if ![winfo exists .console] tkConsoleInit
+
+ 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 [interp record $cmd]
+ if {$result != ""} {
+ .console insert insert "$result\n"
+ }
+ tkConsoleHistory reset
+ tkConsolePrompt
+ } else {
+ tkConsolePrompt partial
+ }
+ .console yview -pickplace insert
+}
+
+# tkConsoleHistory --
+# This procedure implements command line history for the
+# console. In general is evals the history command in the
+# main interpreter to obtain the history. The global variable
+# histNum is used to store the current location in the history.
+#
+# Arguments:
+# cmd - Which action to take: prev, next, reset.
+
+set histNum 1
+proc tkConsoleHistory {cmd} {
+ if ![winfo exists .console] tkConsoleInit
+
+ 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 {interp 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 {interp 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 ![winfo exists .console] tkConsoleInit
+
+ if {$partial == "normal"} {
+ set temp [.console index "end - 1 char"]
+ .console mark set output end
+ if [interp eval "info exists tcl_prompt1"] {
+ interp eval "eval \[set tcl_prompt1\]"
+ } else {
+ puts -nonewline "% "
+ }
+ } else {
+ set temp [.console index output]
+ .console mark set output end
+ if [interp eval "info exists tcl_prompt2"] {
+ interp eval "eval \[set tcl_prompt2\]"
+ } else {
+ puts -nonewline "> "
+ }
+ }
+ flush stdout
+ .console mark set output $temp
+ tkTextSetCursor .console end
+ .console mark set promptEnd insert
+ .console mark gravity promptEnd left
+}
+
+# tkConsoleBind --
+# This procedure first ensures that the default bindings for the Text
+# class have been defined. Then certain bindings are overridden for
+# the class.
+#
+# Arguments:
+# None.
+
+proc tkConsoleBind {win} {
+ if ![winfo exists .console] tkConsoleInit
+
+ bindtags $win "$win Text . all"
+
+ # 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 $win <Alt-KeyPress> {# nothing }
+ bind $win <Meta-KeyPress> {# nothing}
+ bind $win <Control-KeyPress> {# nothing}
+ bind $win <Escape> {# nothing}
+ bind $win <KP_Enter> {# nothing}
+
+ bind $win <Tab> {
+ tkConsoleInsert %W \t
+ focus %W
+ break
+ }
+ 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
+ }
+ }
+ foreach prev {Control-n Down} {
+ bind $win <$prev> {
+ tkConsoleHistory next
+ break
+ }
+ }
+ bind $win <Control-v> {
+ if [%W compare insert > promptEnd] {
+ catch {
+ %W insert insert [selection get -displayof %W] {input stdin}
+ %W see insert
+ }
+ }
+ break
+ }
+ bind $win <Insert> {
+ catch {tkConsoleInsert %W [selection get -displayof %W]}
+ break
+ }
+ 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>> {
+ continue
+ }
+ bind $win <<Copy>> {
+ if {[selection own -displayof %W] == "%W"} {
+ clipboard clear -displayof %W
+ catch {
+ clipboard append -displayof %W [selection get -displayof %W]
+ }
+ }
+ break
+ }
+ bind $win <<Paste>> {
+ catch {
+ set clip [selection get -displayof %W -selection CLIPBOARD]
+ set list [split $clip \n\r]
+ tkConsoleInsert %W [lindex $list 0]
+ foreach x [lrange $list 1 end] {
+ %W mark set insert {end - 1c}
+ tkConsoleInsert %W "\n"
+ tkConsoleInvoke
+ tkConsoleInsert %W $x
+ }
+ }
+ break
+ }
+}
+
+# tkConsoleInsert --
+# Insert a string into a text at the point of the insertion cursor.
+# If there is a selection in the text, and it covers the point of the
+# insertion cursor, then delete the selection before inserting. Insertion
+# 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 ![winfo exists .console] tkConsoleInit
+
+ 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
+ }
+ }
+ if {[$w compare insert < promptEnd]} {
+ $w mark set insert end
+ }
+ $w insert insert $s {input stdin}
+ $w see insert
+}
+
+# tkConsoleOutput --
+#
+# This routine is called directly by ConsolePutsCmd to cause a string
+# to be displayed in the console.
+#
+# Arguments:
+# dest - The output tag to be used: either "stderr" or "stdout".
+# string - The string to be displayed.
+
+proc tkConsoleOutput {dest string} {
+ if ![winfo exists .console] tkConsoleInit
+
+ .console insert output $string $dest
+ .console see insert
+}
+
+# tkConsoleExit --
+#
+# This routine is called by ConsoleEventProc when the main window of
+# the application is destroyed.
+#
+# Arguments:
+# None.
+
+proc tkConsoleExit {} {
+ if ![winfo exists .console] tkConsoleInit
+
+ exit
+}
+
+# can't do this in SamTk
+#
+#tkConsoleInit
diff --git a/tix/generic/tk4.2/tk.tcl b/tix/generic/tk4.2/tk.tcl
new file mode 100644
index 00000000000..c305faa743b
--- /dev/null
+++ b/tix/generic/tk4.2/tk.tcl
@@ -0,0 +1,157 @@
+# tk.tcl --
+#
+# Initialization script normally executed in the interpreter for each
+# Tk-based application. Arranges class bindings for widgets.
+#
+# SCCS: @(#) tk.tcl 1.87 96/09/30 09:28:02
+#
+# 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 4.2
+package require -exact Tcl 7.6
+
+# Add Tk's directory to the end of the auto-load search path, if it
+# isn't already on the path:
+
+if {[lsearch -exact $auto_path $tk_library] < 0} {
+ lappend auto_path $tk_library
+}
+
+# Turn off strict Motif look and feel as a default.
+
+set tk_strictMotif 0
+
+# tkScreenChanged --
+# This procedure is invoked by the binding mechanism whenever the
+# "current" screen is changing. The procedure does two things.
+# First, it uses "upvar" to make global variable "tkPriv" point at an
+# array variable that holds state for the current display. Second,
+# it initializes the array if it didn't already exist.
+#
+# Arguments:
+# screen - The name of the new screen.
+
+proc tkScreenChanged screen {
+ set disp [file rootname $screen]
+ uplevel #0 upvar #0 tkPriv.$disp tkPriv
+ global tkPriv
+ if [info exists tkPriv] {
+ set tkPriv(screen) $screen
+ return
+ }
+ 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(mouseMoved) 0
+ set tkPriv(oldGrab) {}
+ set tkPriv(popup) {}
+ set tkPriv(postedMb) {}
+ set tkPriv(pressX) 0
+ set tkPriv(pressY) 0
+ set tkPriv(screen) $screen
+ set tkPriv(selectMode) char
+ set tkPriv(window) {}
+}
+
+# Do initial setup for tkPriv, so that it is always bound to something
+# (otherwise, if someone references it, it may get set to a non-upvar-ed
+# value, which will cause trouble later).
+
+tkScreenChanged [winfo screen .]
+
+# tkEventMotifBindings --
+# This procedure is invoked as a trace whenever tk_strictMotif is
+# changed. It is used to turn on or turn off the motif virtual
+# bindings.
+#
+# 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.
+# ----------------------------------------------------------------------
+
+# No need in SamTk
+#
+#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> {focus [tk_focusNext %W]}
+bind all <Shift-Tab> {focus [tk_focusPrev %W]}
+
+# tkCancelRepeat --
+# This procedure is invoked to cancel an auto-repeat action described
+# by tkPriv(afterId). It's used by several widgets to auto-scroll
+# the widget when the mouse is dragged out of the widget with a
+# button pressed.
+#
+# Arguments:
+# None.
+
+proc tkCancelRepeat {} {
+ global tkPriv
+ after cancel $tkPriv(afterId)
+ set tkPriv(afterId) {}
+}
diff --git a/tix/install.sh b/tix/install.sh
new file mode 100755
index 00000000000..0ff4b6a08e8
--- /dev/null
+++ b/tix/install.sh
@@ -0,0 +1,119 @@
+#!/bin/sh
+
+#
+# install - install a program, script, or datafile
+# This comes from X11R5; it is not part of GNU.
+#
+# $XConsortium: install.sh,v 1.2 89/12/18 14:47:22 jim Exp $
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch.
+#
+
+
+# set DOITPROG to echo to test this script
+
+# Don't use :- since 4.3BSD and earlier shells don't like it.
+doit="${DOITPROG-}"
+
+
+# put in absolute paths if you don't have them in your path; or use env. vars.
+
+mvprog="${MVPROG-mv}"
+cpprog="${CPPROG-cp}"
+chmodprog="${CHMODPROG-chmod}"
+chownprog="${CHOWNPROG-chown}"
+chgrpprog="${CHGRPPROG-chgrp}"
+stripprog="${STRIPPROG-strip}"
+rmprog="${RMPROG-rm}"
+
+instcmd="$mvprog"
+chmodcmd=""
+chowncmd=""
+chgrpcmd=""
+stripcmd=""
+rmcmd="$rmprog -f"
+mvcmd="$mvprog"
+src=""
+dst=""
+
+while [ x"$1" != x ]; do
+ case $1 in
+ -c) instcmd="$cpprog"
+ shift
+ continue;;
+
+ -m) chmodcmd="$chmodprog $2"
+ shift
+ shift
+ continue;;
+
+ -o) chowncmd="$chownprog $2"
+ shift
+ shift
+ continue;;
+
+ -g) chgrpcmd="$chgrpprog $2"
+ shift
+ shift
+ continue;;
+
+ -s) stripcmd="$stripprog"
+ shift
+ continue;;
+
+ *) if [ x"$src" = x ]
+ then
+ src=$1
+ else
+ dst=$1
+ fi
+ shift
+ continue;;
+ esac
+done
+
+if [ x"$src" = x ]
+then
+ echo "install: no input file specified"
+ exit 1
+fi
+
+if [ x"$dst" = x ]
+then
+ echo "install: no destination specified"
+ exit 1
+fi
+
+
+# If destination is a directory, append the input filename; if your system
+# does not like double slashes in filenames, you may need to add some logic
+
+if [ -d $dst ]
+then
+ dst="$dst"/`basename $src`
+fi
+
+# Make a temp file name in the proper directory.
+
+dstdir=`dirname $dst`
+dsttmp=$dstdir/#inst.$$#
+
+# Move or copy the file name to the temp name
+
+$doit $instcmd $src $dsttmp
+
+# and set any options; do chmod last to preserve setuid bits
+
+if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; fi
+if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; fi
+if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; fi
+if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; fi
+
+# Now rename the file to the real destination.
+
+$doit $rmcmd $dst
+$doit $mvcmd $dsttmp $dst
+
+
+exit 0
diff --git a/tix/library/Balloon.tcl b/tix/library/Balloon.tcl
new file mode 100644
index 00000000000..bcc400f0837
--- /dev/null
+++ b/tix/library/Balloon.tcl
@@ -0,0 +1,565 @@
+# Balloon.tcl --
+#
+# The help widget. It provides both "balloon" type of help
+# message and "status bar" type of help message. You can use
+# this widget to indicate the function of the widgets inside
+# your application.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+tixWidgetClass tixBalloon {
+ -classname TixBalloon
+ -superclass tixShell
+ -method {
+ bind post unbind
+ }
+ -flag {
+ -installcolormap -initwait -state -statusbar
+ }
+ -configspec {
+ {-installcolormap installColormap InstallColormap false}
+ {-initwait initWait InitWait 1000}
+ {-state state State both}
+ {-statusbar statusBar StatusBar ""}
+
+ {-cursor cursor Cursur left_ptr}
+ }
+ -default {
+ {*background #ffff60}
+ {*foreground black}
+ {*borderWidth 0}
+ {.borderWidth 1}
+ {.background black}
+ {*Label.anchor w}
+ {*Label.justify left}
+ }
+}
+
+# Class Record
+#
+set tixBalloon(bals) ""
+
+proc tixBalloon:InitWidgetRec {w} {
+ upvar #0 $w data
+ global tixBalloon
+
+ tixChainMethod $w InitWidgetRec
+
+ set data(isActive) 0
+ set data(client) ""
+
+ lappend tixBalloon(bals) $w
+}
+
+proc tixBalloon:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ wm overrideredirect $w 1
+ wm withdraw $w
+
+ # Frame 1 : arrow
+ frame $w.f1 -bd 0
+ set data(w:label) [label $w.f1.lab -bd 0 -relief flat \
+ -bitmap [tix getbitmap balarrow]]
+ pack $data(w:label) -side left -padx 1 -pady 1
+
+ # Frame 2 : Message
+ frame $w.f2 -bd 0
+ set data(w:message) [label $w.f2.message -padx 0 -pady 0 -bd 0]
+ pack $data(w:message) -side left -expand yes -fill both -padx 10 -pady 1
+
+ # Pack all
+ pack $w.f1 -fill both
+ pack $w.f2 -fill both
+
+ # This is an event tag used by the clients
+ #
+ bind TixBal$w <Destroy> "tixBalloon:ClientDestroy $w %W"
+}
+
+proc tixBalloon:Destructor {w} {
+ global tixBalloon
+
+ set bals ""
+ foreach b $tixBalloon(bals) {
+ if {$w != $b} {
+ lappend bals $b
+ }
+ }
+ set tixBalloon(bals) $bals
+
+ tixChainMethod $w Destructor
+}
+
+#----------------------------------------------------------------------
+# Config:
+#----------------------------------------------------------------------
+proc tixBalloon:config-state {w value} {
+ upvar #0 $w data
+
+ case $value {
+ {none balloon status both} ""
+ default {
+ error "invalid value $value, must be none, balloon, status, or both"
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+# "RAW" event bindings:
+#----------------------------------------------------------------------
+
+bind all <B1-Motion> "+tixBalloon_XXMotion %X %Y 1"
+bind all <B2-Motion> "+tixBalloon_XXMotion %X %Y 2"
+bind all <B3-Motion> "+tixBalloon_XXMotion %X %Y 3"
+bind all <B4-Motion> "+tixBalloon_XXMotion %X %Y 4"
+bind all <B5-Motion> "+tixBalloon_XXMotion %X %Y 5"
+bind all <Any-Motion> "+tixBalloon_XXMotion %X %Y 0"
+bind all <Leave> "+tixBalloon_XXMotion %X %Y %b"
+bind all <Button> "+tixBalloon_XXButton %X %Y %b"
+bind all <ButtonRelease> "+tixBalloon_XXButtonUp %X %Y %b"
+
+proc tixBalloon_XXMotion {rootX rootY b} {
+ global tixBalloon
+
+ foreach w $tixBalloon(bals) {
+ tixBalloon:XXMotion $w $rootX $rootY $b
+ }
+}
+
+proc tixBalloon_XXButton {rootX rootY b} {
+ global tixBalloon
+
+ foreach w $tixBalloon(bals) {
+ tixBalloon:XXButton $w $rootX $rootY $b
+ }
+}
+
+proc tixBalloon_XXButtonUp {rootX rootY b} {
+ global tixBalloon
+
+ foreach w $tixBalloon(bals) {
+ tixBalloon:XXButtonUp $w $rootX $rootY $b
+ }
+}
+
+
+# return true if d is a descendant of w
+#
+proc tixIsDescendant {w d} {
+ if [string match $w .] {
+ return 1
+ }
+ return [string match $w.* $d]
+}
+
+# All the button events are fine if the ballooned widget is
+# a descendant of the grabbing widget
+#
+proc tixBalloon:GrabBad {w cw} {
+ global tixBalloon
+
+ set g [grab current $w]
+ if {$g == ""} {
+ return 0
+ }
+ if [info exists tixBalloon(g_ignore,$g)] {
+ return 1
+ }
+ if [info exists tixBalloon(g_ignore,[winfo class $g])] {
+ return 1
+ }
+ if {$g == $cw || [tixIsDescendant $g $cw]} {
+ return 0
+ }
+ return 1
+}
+
+proc tixBalloon:XXMotion {w rootX rootY b} {
+ upvar #0 $w data
+
+ if {$data(-state) == "none"} {
+ return
+ }
+
+ if {$b == 0} {
+ if [info exists data(b:1)] {unset data(b:1)}
+ if [info exists data(b:2)] {unset data(b:2)}
+ if [info exists data(b:3)] {unset data(b:3)}
+ if [info exists data(b:4)] {unset data(b:4)}
+ if [info exists data(b:5)] {unset data(b:5)}
+ }
+
+
+ if {[array names data b:*] != ""} {
+ # Some buttons are down. Do nothing
+ #
+ return
+ }
+
+ set cw [winfo containing $rootX $rootY]
+ if [tixBalloon:GrabBad $w $cw] {
+ return
+ }
+
+ # Find the a client window that matches
+ #
+ if {$w == $cw || [string match $w.* $cw]} {
+ # Cursor moved over the balloon -- Ignore
+ return
+ }
+
+ while {$cw != ""} {
+ if [info exists data(m:$cw)] {
+ set client $cw
+ break
+ } else {
+ set cw [winfo parent $cw]
+ }
+ }
+ if {![info exists client]} {
+ # The cursor is at a position covered by a non-client
+ # Popdown the balloon if it is up
+ if {$data(isActive)} {
+ tixBalloon:Deactivate $w
+ }
+ set data(client) ""
+ if [info exists data(cancel)] {
+ unset data(cancel)
+ }
+ return
+ }
+
+ if {$data(client) != $client} {
+ if {$data(isActive)} {
+ tixBalloon:Deactivate $w
+ }
+ set data(client) $client
+ after $data(-initwait) tixBalloon:SwitchToClient $w $client
+ }
+}
+
+proc tixBalloon:XXButton {w rootX rootY b} {
+ upvar #0 $w data
+
+ tixBalloon:XXMotion $w $rootX $rootY $b
+
+ set data(b:$b) 1
+
+ if {$data(isActive)} {
+ tixBalloon:Deactivate $w
+ } else {
+ set data(cancel) 1
+ }
+}
+
+proc tixBalloon:XXButtonUp {w rootX rootY b} {
+ upvar #0 $w data
+
+ tixBalloon:XXMotion $w $rootX $rootY $b
+ if [info exists data(b:$b)] {
+ unset data(b:$b)
+ }
+}
+
+#----------------------------------------------------------------------
+# "COOKED" event bindings:
+#----------------------------------------------------------------------
+
+# switch the balloon to a new client
+#
+proc tixBalloon:SwitchToClient {w client} {
+ upvar #0 $w data
+
+ if {![winfo exists $w]} {
+ return
+ }
+ if {![winfo exists $client]} {
+ return
+ }
+ if {$client != $data(client)} {
+ return
+ }
+ if [info exists data(cancel)] {
+ unset data(cancel)
+ return
+ }
+
+ if [tixBalloon:GrabBad $w $w] {
+ return
+ }
+
+ tixBalloon:Activate $w
+}
+
+proc tixBalloon:ClientDestroy {w client} {
+ if {![winfo exists $w]} {
+ return
+ }
+
+ upvar #0 $w data
+
+ if {$data(client) == $client} {
+ tixBalloon:Deactivate $w
+ set data(client) ""
+ }
+
+ # Maybe thses have already been unset by the Destroy method
+ #
+ if [info exists data(m:$client)] {unset data(m:$client)}
+ if [info exists data(s:$client)] {unset data(s:$client)}
+}
+
+#----------------------------------------------------------------------
+# Popping up balloon:
+#----------------------------------------------------------------------
+proc tixBalloon:Activate {w} {
+ upvar #0 $w data
+
+ if [tixBalloon:GrabBad $w $w] {
+ return
+ }
+ if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] == ""} {
+ return
+ }
+
+ switch $data(-state) {
+ "both" {
+ tixBalloon:PopUp $w
+ tixBalloon:SetStatus $w
+ }
+ "balloon" {
+ tixBalloon:PopUp $w
+ }
+ "status" {
+ tixBalloon:SetStatus $w
+ }
+ }
+
+ set data(isActive) 1
+
+ after 200 tixBalloon:Verify $w
+}
+
+
+# %% Perhaps this is no more needed
+#
+proc tixBalloon:Verify {w} {
+ upvar #0 $w data
+
+ if {![winfo exists $w]} {
+ return
+ }
+ if {!$data(isActive)} {
+ return
+ }
+
+ if [tixBalloon:GrabBad $w $w] {
+ tixBalloon:Deactivate $w
+ return
+ }
+ if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] == ""} {
+ tixBalloon:Deactivate $w
+ return
+ }
+ after 200 tixBalloon:Verify $w
+}
+
+proc tixBalloon:Deactivate {w} {
+ upvar #0 $w data
+
+ tixBalloon:PopDown $w
+ tixBalloon:ClearStatus $w
+ set data(isActive) 0
+ if [info exists data(cancel)] {
+ unset data(cancel)
+ }
+}
+
+proc tixBalloon:PopUp {w} {
+ upvar #0 $w data
+
+ if [tixGetBoolean -nocomplain $data(-installcolormap)] {
+ wm colormapwindows [winfo toplevel $data(client)] $w
+ }
+
+ # trick: the following lines allow the balloon window to
+ # acquire a stable width and height when it is finally
+ # put on the visible screen
+ #
+ set client $data(client)
+ $data(w:message) config -text $data(m:$client)
+ wm geometry $w +10000+10000
+ wm deiconify $w
+ raise $w
+ update
+
+ # The windows may become destroyed as a result of the "update" command
+ #
+ if {![winfo exists $w]} {
+ return
+ }
+ if {![winfo exists $client]} {
+ return
+ }
+ # Put it on the visible screen
+ #
+ set x [expr [winfo rootx $client]+[winfo width $client]/2]
+ set y [expr int([winfo rooty $client]+[winfo height $client]/1.3)]
+
+ set width [winfo reqwidth $w]
+ set height [winfo reqheight $w]
+ set scrwidth [winfo vrootwidth $w]
+ set scrheight [winfo vrootheight $w]
+
+ # If the balloon is too far right, pull it back to the left
+ #
+ if {[expr $x + $width] > $scrwidth} {
+ set x [expr $scrwidth - $width]
+ }
+
+ # If the balloon is too far left, pull it back to the right
+ #
+ if {$x < 0} {
+ set x 0
+ }
+
+ # If the listbox is below bottom of screen, put it upwards
+ #
+ if {[expr $y + $height] > $scrheight} {
+ set y [expr $scrheight-$height]
+ }
+ if {$y < 0} {
+ set y 0
+ }
+
+ wm geometry $w +$x+$y
+}
+
+proc tixBalloon:PopDown {w} {
+ upvar #0 $w data
+
+ # Close the balloon
+ #
+ wm withdraw $w
+
+ # We don't set the data(client) to be zero, so that the balloon
+ # will re-appear only if you move out then in the client window
+ # set data(client) ""
+}
+
+proc tixBalloon:SetStatus {w} {
+ upvar #0 $w data
+
+ if {![winfo exists $data(-statusbar)]} {
+ return
+ }
+ if {![info exists data(s:$data(client))]} {
+ return
+ }
+
+ set vv [$data(-statusbar) cget -textvariable]
+ if {$vv == ""} {
+ $data(-statusbar) config -text $data(s:$data(client))
+ } else {
+ uplevel #0 set $vv [list $data(s:$data(client))]
+ }
+}
+
+proc tixBalloon:ClearStatus {w} {
+ upvar #0 $w data
+
+ if {![winfo exists $data(-statusbar)]} {
+ return
+ }
+
+ # Clear the StatusBar widget
+ #
+ set vv [$data(-statusbar) cget -textvariable]
+ if {$vv == ""} {
+ $data(-statusbar) config -text ""
+ } else {
+ uplevel #0 set $vv [list ""]
+ }
+}
+
+#----------------------------------------------------------------------
+# PublicMethods:
+#----------------------------------------------------------------------
+
+# %% if balloon is already popped-up for this client, change mesage
+#
+proc tixBalloon:bind {w client args} {
+ upvar #0 $w data
+
+ if [info exists data(m:$client)] {
+ set alreadyBound 1
+ } else {
+ set alreadyBound 0
+ }
+
+ set opt(-balloonmsg) ""
+ set opt(-statusmsg) ""
+ set opt(-msg) ""
+
+ tixHandleOptions opt {-balloonmsg -msg -statusmsg} $args
+
+ if {$opt(-balloonmsg) != ""} {
+ set data(m:$client) $opt(-balloonmsg)
+ } else {
+ set data(m:$client) $opt(-msg)
+ }
+ if {$opt(-statusmsg) != ""} {
+ set data(s:$client) $opt(-statusmsg)
+ } else {
+ set data(s:$client) $opt(-msg)
+ }
+
+ tixAppendBindTag $client TixBal$w
+}
+
+proc tixBalloon:post {w client} {
+ upvar #0 $w data
+
+ if {![info exists data(m:$client)]} {
+ return
+ }
+ tixBalloon:Enter $w $client
+ incr data(fakeEnter)
+}
+
+proc tixBalloon:unbind {w client} {
+ upvar #0 $w data
+
+ if [info exists data(m:$client)] {
+ if [info exists data(m:$client)] {unset data(m:$client)}
+ if [info exists data(s:$client)] {unset data(s:$client)}
+
+ if [winfo exists $client] {
+ catch {tixDeleteBindTag $client TixBal$w}
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+#
+# Utility function
+#
+#----------------------------------------------------------------------
+#
+# $w can be a widget name or a classs name
+proc tixBalIgnoreWhenGrabbed {wc} {
+ global tixBalloon
+ set tixBalloon(g_ignore,$wc) ""
+}
+
+tixBalIgnoreWhenGrabbed TixComboBox
+tixBalIgnoreWhenGrabbed Menu
+tixBalIgnoreWhenGrabbed Menubutton
diff --git a/tix/library/BtnBox.tcl b/tix/library/BtnBox.tcl
new file mode 100644
index 00000000000..fbc6432a698
--- /dev/null
+++ b/tix/library/BtnBox.tcl
@@ -0,0 +1,115 @@
+# BtnBox.tcl --
+#
+# Implements the tixButtonBox widget
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixButtonBox {
+ -superclass tixPrimitive
+ -classname TixButtonBox
+ -method {
+ add invoke button buttons
+ }
+ -flag {
+ -orientation -orient -padx -pady -state
+ }
+ -static {
+ -orientation
+ }
+ -configspec {
+ {-orientation orientation Orientation horizontal}
+ {-padx padX Pad 0}
+ {-pady padY Pad 0}
+ {-state state State normal}
+ }
+ -alias {
+ {-orient -orientation}
+ }
+ -default {
+ {.borderWidth 1}
+ {.relief raised}
+ {.padX 5}
+ {.padY 10}
+ {*Button.anchor c}
+ {*Button.padX 5}
+ }
+}
+
+proc tixButtonBox:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+
+ set data(g:buttons) ""
+}
+
+#----------------------------------------------------------------------
+# CONFIG OPTIONS
+#----------------------------------------------------------------------
+proc tixButtonBox:config-padx {w arg} {
+ upvar #0 $w data
+
+ foreach item $data(g:buttons) {
+ pack configure $w.$item -padx $arg
+ }
+}
+
+proc tixButtonBox:config-pady {w arg} {
+ upvar #0 $w data
+
+ foreach item $data(g:buttons) {
+ pack configure $w.$item -pady $arg
+ }
+}
+
+proc tixButtonBox:config-state {w arg} {
+ upvar #0 $w data
+
+ foreach item $data(g:buttons) {
+ $w.$item config -state $arg
+ }
+}
+
+#----------------------------------------------------------------------
+# Methods
+# WIDGET COMMANDS
+#----------------------------------------------------------------------
+proc tixButtonBox:add {w name args} {
+ upvar #0 $w data
+
+ eval button $w.$name $args
+ if {$data(-orientation) == "horizontal"} {
+ pack $w.$name -side left -expand yes -fill y\
+ -padx $data(-padx) -pady $data(-pady)
+ } else {
+ pack $w.$name -side top -expand yes -fill x\
+ -padx $data(-padx) -pady $data(-pady)
+ }
+
+ # allow for subwidget access
+ #
+ lappend data(g:buttons) $name
+ set data(w:$name) $w.$name
+
+ return $w.$name
+}
+
+proc tixButtonBox:button {w name args} {
+ return [eval tixCallMethod $w subwidget $name $args]
+}
+
+proc tixButtonBox:buttons {w args} {
+ return [eval tixCallMethod $w subwidgets -group buttons $args]
+}
+
+#
+# call the command
+proc tixButtonBox:invoke {w name} {
+ upvar #0 $w data
+
+ $w.$name invoke
+}
diff --git a/tix/library/CObjView.tcl b/tix/library/CObjView.tcl
new file mode 100644
index 00000000000..8d8a123ef4a
--- /dev/null
+++ b/tix/library/CObjView.tcl
@@ -0,0 +1,359 @@
+# CObjView.tcl --
+#
+# This file implements the Canvas Object View widget. This is a base
+# class of IconView. It implements:
+
+# (1) Automatic placement/adjustment of the scrollbars according
+# to the canvas objects inside the canvas subwidget. The
+# scrollbars are adjusted so that the canvas is just large
+# enough to see all the objects.
+#
+# (2) D+D bindings of the objects (%% not implemented)
+#
+# (3) Keyboard traversal of the objects (%% not implemented). By the
+# virtual method :SelectObject.
+#
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixCObjView {
+ -classname TixCObjView
+ -superclass tixScrolledWidget
+ -method {
+ adjustscrollregion
+ }
+ -flag {
+ -xscrollincrement -yscrollincrement
+ }
+ -static {
+ }
+ -configspec {
+ {-xscrollincrement xScrollIncrement ScrollIncrement 10}
+ {-yscrollincrement yScrollIncrement ScrollIncrement 10}
+ }
+ -default {
+ {.scrollbar auto}
+ {*borderWidth 1}
+ {*canvas.background #c3c3c3}
+ {*canvas.highlightBackground #d9d9d9}
+ {*canvas.relief sunken}
+ {*canvas.takeFocus 1}
+ {*Scrollbar.background #d9d9d9}
+ {*Scrollbar.relief sunken}
+ {*Scrollbar.troughColor #c3c3c3}
+ {*Scrollbar.takeFocus 0}
+ {*Scrollbar.width 15}
+ }
+ -forcecall {
+ -scrollbar
+ }
+}
+
+proc tixCObjView:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ set data(w:canvas) \
+ [canvas $w.canvas]
+ set data(w:hsb) \
+ [scrollbar $w.hsb -orient horizontal]
+ set data(w:vsb) \
+ [scrollbar $w.vsb -orient vertical]
+
+ set data(pw:client) $data(w:canvas)
+
+ set data(xorig) 0
+ set data(yorig) 0
+
+ set data(sx1) 0
+ set data(sy1) 0
+ set data(sx2) 0
+ set data(sy2) 0
+}
+
+proc tixCObjView:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+# %% scan/drag of canvas??
+#
+# $data(w:canvas) config \
+# -xscrollcommand "tixCObjView:XScroll $w"\
+# -yscrollcommand "tixCObjView:YScroll $w"
+
+ $data(w:hsb) config -command "tixCObjView:UserScroll $w x"
+ $data(w:vsb) config -command "tixCObjView:UserScroll $w y"
+}
+
+#----------------------------------------------------------------------
+#
+# option configs
+#----------------------------------------------------------------------
+proc tixCObjView:config-takefocus {w value} {
+ upvar #0 $w data
+
+ $data(w:canvas) config -takefocus $value
+}
+
+#----------------------------------------------------------------------
+#
+# Widget commands
+#----------------------------------------------------------------------
+proc tixCObjView:adjustscrollregion {w} {
+ upvar #0 $w data
+
+ set cW [tixWinWidth $data(w:canvas)]
+ set cH [tixWinHeight $data(w:canvas)]
+
+ tixCObjView:GetScrollRegion $w $cW $cH 1 1
+}
+
+#----------------------------------------------------------------------
+#
+# Private Methods
+#----------------------------------------------------------------------
+
+proc tixCObjView:GeometryInfo {w cW cH} {
+ upvar #0 $w data
+
+ set bd \
+ [expr [$data(w:canvas) cget -bd] + [$data(w:canvas) cget -highlightthickness]]
+
+ incr cW -[expr 2*$bd]
+ incr cH -[expr 2*$bd]
+
+ return [tixCObjView:GetScrollRegion $w $cW $cH 0 0]
+}
+
+proc tixCObjView:PlaceWindow {w} {
+ upvar #0 $w data
+
+ set cW [tixWinWidth $data(w:canvas)]
+ set cH [tixWinHeight $data(w:canvas)]
+
+ tixCObjView:GetScrollRegion $w $cW $cH 1 0
+
+ tixChainMethod $w PlaceWindow
+}
+
+proc tixCObjView:GetScrollRegion {w cW cH setReg callConfig} {
+ upvar #0 $w data
+
+ set x1max $data(xorig)
+ set y1max $data(yorig)
+
+ set x2min [expr $x1max + $cW - 1]
+ set y2min [expr $y1max + $cH - 1]
+
+ set bbox [$data(w:canvas) bbox all]
+
+ if {$bbox == ""} {
+ set bbox {0 0 1 1}
+ }
+
+ set x1 [lindex $bbox 0]
+ set y1 [lindex $bbox 1]
+ set x2 [lindex $bbox 2]
+ set y2 [lindex $bbox 3]
+
+ set bd \
+ [expr [$data(w:canvas) cget -bd] + [$data(w:canvas) cget -highlightthickness]]
+
+ incr x1 -$bd
+ incr y1 -$bd
+ incr x2 -$bd
+ incr y2 -$bd
+
+ if {$x1 > $x1max} {
+ set x1 $x1max
+ }
+ if {$y1 > $y1max} {
+ set y1 $y1max
+ }
+ if {$x2 < $x2min} {
+ set x2 $x2min
+ }
+ if {$y2 < $y2min} {
+ set y2 $y2min
+ }
+
+ set data(sx1) $x1
+ set data(sy1) $y1
+ set data(sx2) $x2
+ set data(sy2) $y2
+
+ set sW [expr $x2 - $x1 + 1]
+ set sH [expr $y2 - $y1 + 1]
+
+# puts "sregion = {$x1 $y1 $x2 $y2}; sW=$sW; cW=$cW"
+
+ if {$sW > $cW} {
+ set hsbSpec {0.5 1}
+ } else {
+ set hsbSpec {0 1}
+ }
+ if {$sH > $cH} {
+ set vsbSpec {0.5 1}
+ } else {
+ set vsbSpec {0 1}
+ }
+
+ if $setReg {
+ tixCObjView:SetScrollBars $w $cW $cH $sW $sH
+ }
+ if $callConfig {
+ tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
+ }
+
+ return [list $hsbSpec $vsbSpec]
+}
+
+#xF = xFirst
+#
+proc tixCObjView:SetScrollBars {w cW cH sW sH} {
+ upvar #0 $w data
+
+# puts "$data(xorig) <--> $data(sx1)"
+
+ set xF [expr ($data(xorig).0-$data(sx1).0)/$sW.0]
+ set xL [expr $cW.0/$sW.0 + $xF]
+
+ set yF [expr ($data(yorig).0-$data(sy1).0)/$sH.0]
+ set yL [expr $cH.0/$sH.0 + $yF]
+
+# puts "$xF $xL : $yF $yL"
+ $data(w:hsb) set $xF $xL
+ $data(w:vsb) set $yF $yL
+}
+
+proc tixCObjView:UserScroll {w dir type args} {
+ upvar #0 $w data
+
+ $data(w:canvas) config -xscrollincrement 1 -yscrollincrement 1
+
+ case $dir {
+ x {
+ set n $data(xorig)
+ set orig $data(xorig)
+ set s1 $data(sx1)
+ set total [expr $data(sx2)-$data(sx1)]
+ set page [tixWinWidth $data(w:canvas)]
+ set min $data(sx1)
+ set max [expr $data(sx1)+$total-$page]
+ set inc $data(-xscrollincrement)
+ }
+ y {
+ set n $data(yorig)
+ set orig $data(yorig)
+ set s1 $data(sy1)
+ set total [expr $data(sy2)-$data(sy1)]
+ set page [tixWinHeight $data(w:canvas)]
+ set min $data(sy1)
+ set max [expr $data(sy1)+$total-$page]
+ set inc $data(-yscrollincrement)
+ }
+ }
+
+ case $type {
+ scroll {
+ set amt [lindex $args 0]
+ set unit [lindex $args 1]
+
+ case $unit {
+ units {
+ incr n [expr int($inc)*$amt]
+ }
+ pages {
+ incr n [expr $page*$amt]
+ }
+ }
+ }
+ moveto {
+ set first [lindex $args 0]
+ set n [expr round($first*$total)+$s1]
+ }
+ }
+
+ if {$n < $min} {
+ set n $min
+ }
+ if {$n > $max} {
+ set n $max
+ }
+
+# puts "n=$n min=$min max=$max"
+
+ case $dir {
+ x {
+ $data(w:canvas) xview scroll [expr $n-$orig] units
+ set data(xorig) $n
+ }
+ y {
+ $data(w:canvas) yview scroll [expr $n-$orig] units
+ set data(yorig) $n
+ }
+ }
+
+ set cW [tixWinWidth $data(w:canvas)]
+ set cH [tixWinHeight $data(w:canvas)]
+ set sW [expr $data(sx2)-$data(sx1)+1]
+ set sH [expr $data(sy2)-$data(sy1)+1]
+
+ tixCObjView:SetScrollBars $w $cW $cH $sW $sH
+}
+
+# Junk
+#
+#
+proc tixCObjView:XScroll {w first last} {
+ upvar #0 $w data
+
+ set sc [$data(w:canvas) cget -scrollregion]
+ if {$sc == ""} {
+ set x1 1
+ set x2 [tixWinWidth $data(w:canvas)]
+ } else {
+ set x1 [lindex $sc 0]
+ set x2 [lindex $sc 2]
+ }
+
+ set W [expr $x2 - $x1]
+ if {$W < 1} {
+ set W 1
+ }
+
+ $data(w:hsb) set $first $last
+
+# tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
+}
+
+# Junk
+#
+proc tixCObjView:YScroll {w first last} {
+ upvar #0 $w data
+
+ set sc [$data(w:canvas) cget -scrollregion]
+
+ if {$sc == ""} {
+ set y1 1
+ set y2 [tixWinHeight $data(w:canvas)]
+ } else {
+ set y1 [lindex $sc 1]
+ set y2 [lindex $sc 3]
+ }
+
+ set H [expr $y2 - $y1]
+ if {$H < 1} {
+ set H 1
+ }
+
+ $data(w:vsb) set $first $last
+
+# tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
+}
diff --git a/tix/library/ChkList.tcl b/tix/library/ChkList.tcl
new file mode 100644
index 00000000000..b0f7307af0a
--- /dev/null
+++ b/tix/library/ChkList.tcl
@@ -0,0 +1,237 @@
+# ChkList.tcl --
+#
+# This file implements the TixCheckList widget.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixCheckList {
+ -classname TixCheckList
+ -superclass tixTree
+ -method {
+ getselection getstatus setstatus
+ }
+ -flag {
+ -radio
+ }
+ -configspec {
+ {-radio radio Radio false tixVerifyBoolean}
+
+ {-ignoreinvoke ignoreInvoke IgnoreInvoke true tixVerifyBoolean}
+ }
+ -static {
+ -radio
+ }
+ -default {
+ {.scrollbar auto}
+ {.doubleClick false}
+ {*Scrollbar.background #d9d9d9}
+ {*Scrollbar.relief sunken}
+ {*Scrollbar.takeFocus 0}
+ {*Scrollbar.troughColor #c3c3c3}
+ {*Scrollbar.width 15}
+ {*borderWidth 1}
+ {*hlist.background #c3c3c3}
+ {*hlist.drawBranch 1}
+ {*hlist.height 10}
+ {*hlist.highlightBackground #d9d9d9}
+ {*hlist.indicator 1}
+ {*hlist.indent 20}
+ {*hlist.itemType imagetext}
+ {*hlist.padX 3}
+ {*hlist.padY 0}
+ {*hlist.relief sunken}
+ {*hlist.takeFocus 1}
+ {*hlist.wideSelection 0}
+ {*hlist.width 20}
+ }
+}
+
+proc tixCheckList:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+
+ if {$data(-radio)} {
+ set data(selected) ""
+ }
+}
+
+#----------------------------------------------------------------------
+#
+# Widget commands
+#
+#----------------------------------------------------------------------
+
+# Helper function for getselection
+#
+proc tixCheckList:GetSel {w var ent mode} {
+ upvar #0 $w data
+ upvar $var img
+
+ set ents ""
+
+ catch {
+ if ![string comp [$data(w:hlist) entrycget $ent -bitmap] $img($mode)] {
+ lappend ents $ent
+ }
+ }
+
+ foreach child [$data(w:hlist) info children $ent] {
+ set ents [concat $ents [tixCheckList:GetSel $w img $child $mode]]
+ }
+
+ return $ents
+}
+
+
+# Mode can be on, off, default
+#
+proc tixCheckList:getselection {w {mode on}} {
+ upvar #0 $w data
+
+ set img(on) [tix getbitmap ck_on]
+ set img(off) [tix getbitmap ck_off]
+ set img(default) [tix getbitmap ck_def]
+
+ set ents ""
+ foreach child [$data(w:hlist) info children] {
+ set ents [concat $ents [tixCheckList:GetSel $w img $child $mode]]
+ }
+ return $ents
+}
+
+proc tixCheckList:getstatus {w ent} {
+ upvar #0 $w data
+
+ if {[$data(w:hlist) entrycget $ent -itemtype] == "imagetext"} {
+ set img(on) [tix getbitmap ck_on]
+ set img(off) [tix getbitmap ck_off]
+ set img(default) [tix getbitmap ck_def]
+
+ set bitmap [$data(w:hlist) entrycget $ent -bitmap]
+
+ if {"x$bitmap" == "x$img(on)"} {
+ set status on
+ }
+ if {"x$bitmap" == "x$img(off)"} {
+ set status off
+ }
+ if {"x$bitmap" == "x$img(default)"} {
+ set status default
+ }
+ }
+
+ if [info exists status] {
+ return $status
+ } else {
+ return "none"
+ }
+}
+
+proc tixCheckList:setstatus {w ent {mode on}} {
+ upvar #0 $w data
+
+ if {$data(-radio)} {
+ set status [tixCheckList:getstatus $w $ent]
+
+ if {"x$status" == "x$mode"} {
+ return
+ }
+
+ if {$mode == "on"} {
+ if {$data(selected) != ""} {
+ tixCheckList:Select $w $data(selected) off
+ }
+ set data(selected) $ent
+ tixCheckList:Select $w $ent $mode
+ } elseif {$mode == "off"} {
+ if {"x$data(selected)" == "x$ent"} {
+ return
+ }
+ tixCheckList:Select $w $ent $mode
+ } else {
+ tixCheckList:Select $w $ent $mode
+ }
+ } else {
+ tixCheckList:Select $w $ent $mode
+ }
+}
+
+proc tixCheckList:Select {w ent mode} {
+ upvar #0 $w data
+
+ if {[$data(w:hlist) entrycget $ent -itemtype] == "imagetext"} {
+ set img(on) ck_on
+ set img(off) ck_off
+ set img(default) ck_def
+
+ if [catch {
+ set bitmap [tix getbitmap $img($mode)]
+ $data(w:hlist) entryconfig $ent -bitmap $bitmap
+ }] {
+ # must be the "none" mode
+ #
+ catch {
+ $data(w:hlist) entryconfig $ent -bitmap ""
+ }
+ }
+ }
+
+ return $mode
+}
+
+proc tixCheckList:HandleCheck {w ent} {
+ upvar #0 $w data
+
+ if {[$data(w:hlist) entrycget $ent -itemtype] == "imagetext"} {
+ set img(on) [tix getbitmap ck_on]
+ set img(off) [tix getbitmap ck_off]
+ set img(default) [tix getbitmap ck_def]
+
+ set curMode [tixCheckList:getstatus $w $ent]
+
+ case $curMode {
+ on {
+ tixCheckList:setstatus $w $ent off
+ }
+ off {
+ tixCheckList:setstatus $w $ent on
+ }
+ none {
+ return
+ }
+ default {
+ tixCheckList:setstatus $w $ent on
+ }
+ }
+ }
+}
+
+proc tixCheckList:Command {w B} {
+ upvar #0 $w data
+ upvar $B bind
+
+ set ent [tixEvent flag V]
+ tixCheckList:HandleCheck $w $ent
+
+ tixChainMethod $w Command $B
+}
+
+proc tixCheckList:BrowseCmd {w B} {
+ upvar #0 $w data
+ upvar $B bind
+
+ set ent [tixEvent flag V]
+
+ case [tixEvent type] {
+ {<ButtonPress-1> <space>} {
+ tixCheckList:HandleCheck $w $ent
+ }
+ }
+
+ tixChainMethod $w BrowseCmd $B
+}
diff --git a/tix/library/ComboBox.tcl b/tix/library/ComboBox.tcl
new file mode 100644
index 00000000000..66b46058e7e
--- /dev/null
+++ b/tix/library/ComboBox.tcl
@@ -0,0 +1,1549 @@
+# tixCombobox --
+#
+# A combobox widget is basically a listbox widget with an entry
+# widget.
+#
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+tixWidgetClass tixComboBox {
+ -classname TixComboBox
+ -superclass tixLabelWidget
+ -method {
+ addhistory align appendhistory flash invoke insert pick popdown
+ }
+ -flag {
+ -anchor -arrowbitmap -browsecmd -command -crossbitmap
+ -disablecallback -disabledforeground -dropdown -editable
+ -fancy -grab -histlimit -historylimit -history -listcmd
+ -listwidth -prunehistory -selection -selectmode -state
+ -tickbitmap -validatecmd -value -variable
+ }
+ -static {
+ -dropdown -fancy
+ }
+ -forcecall {
+ -variable -selectmode -state
+ }
+ -configspec {
+ {-arrowbitmap arrowBitmap ArrowBitmap ""}
+ {-anchor anchor Anchor w}
+ {-browsecmd browseCmd BrowseCmd ""}
+ {-command command Command ""}
+ {-crossbitmap crossBitmap CrossBitmap ""}
+ {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
+ {-disabledforeground disabledForeground DisabledForeground #606060}
+ {-dropdown dropDown DropDown true tixVerifyBoolean}
+ {-editable editable Editable false tixVerifyBoolean}
+ {-fancy fancy Fancy false tixVerifyBoolean}
+ {-grab grab Grab global}
+ {-listcmd listCmd ListCmd ""}
+ {-listwidth listWidth ListWidth ""}
+ {-historylimit historyLimit HistoryLimit ""}
+ {-history history History false tixVerifyBoolean}
+ {-prunehistory pruneHistory PruneHistory true tixVerifyBoolean}
+ {-selectmode selectMode SelectMode browse}
+ {-selection selection Selection ""}
+ {-state state State normal}
+ {-validatecmd validateCmd ValidateCmd ""}
+ {-value value Value ""}
+ {-variable variable Variable ""}
+ {-tickbitmap tickBitmap TickBitmap ""}
+ }
+ -alias {
+ {-histlimit -historylimit}
+ }
+ -default {
+ {*Entry.relief sunken}
+ {*TixScrolledListBox.scrollbar auto}
+ {*Listbox.exportSelection false}
+ {*Listbox.takeFocus false}
+ {*shell.borderWidth 2}
+ {*shell.relief raised}
+ {*shell.cursor arrow}
+ {*Button.anchor c}
+ {*Button.borderWidth 1}
+ {*Button.highlightThickness 0}
+ {*Button.padX 0}
+ {*Button.padY 0}
+ {*tick.width 18}
+ {*tick.height 18}
+ {*cross.width 18}
+ {*cross.height 18}
+ {*arrow.anchor c}
+ {*arrow.width 15}
+ {*arrow.height 18}
+ {*Entry.background #c3c3c3}
+ {*Label.font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*}
+ }
+}
+
+# States: normal numbers: for dropdown style
+# d+digit(s) : for non-dropdown style
+#
+proc tixComboBox:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+
+ set data(curIndex) ""
+ set data(varInited) 0
+ set data(state) none
+ set data(ignore) 0
+
+ if {$data(-history)} {
+ set data(-editable) 1
+ }
+
+ if ![string compare $data(-arrowbitmap) ""] {
+ set data(-arrowbitmap) [tix getbitmap cbxarrow]
+ }
+ if ![string compare $data(-crossbitmap) ""] {
+ set data(-crossbitmap) [tix getbitmap cross]
+ }
+ if ![string compare $data(-tickbitmap) ""] {
+ set data(-tickbitmap) [tix getbitmap tick]
+ }
+}
+
+proc tixComboBox:ConstructFramedWidget {w frame} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructFramedWidget $frame
+
+ if {$data(-dropdown)} {
+ tixComboBox:ConstructEntryFrame $w $frame
+ tixComboBox:ConstructListShell $w
+ } else {
+ set f1 [frame $frame.f1]
+ set f2 [frame $frame.f2]
+
+ tixComboBox:ConstructEntryFrame $w $f1
+ tixComboBox:ConstructListFrame $w $f2
+ pack $f1 -side top -pady 2 -fill x
+ pack $f2 -side top -pady 2 -fill both -expand yes
+ }
+}
+
+proc tixComboBox:ConstructEntryFrame {w frame} {
+ upvar #0 $w data
+
+ # (1) The entry
+ #
+ set data(w:entry) [entry $frame.entry]
+
+ if {!$data(-editable)} {
+ set bg [$w cget -bg]
+ $data(w:entry) config -bg $bg -state disabled -takefocus 1
+ }
+
+ # This is used during "config-state"
+ #
+ set data(entryfg) [$data(w:entry) cget -fg]
+
+ # (2) The dropdown button, not necessary when not in dropdown mode
+ #
+ set data(w:arrow) [button $frame.arrow -bitmap $data(-arrowbitmap)]
+ if {!$data(-dropdown)} {
+ set xframe [frame $frame.xframe -width 19]
+ }
+
+ # (3) The fancy tick and cross buttons
+ #
+ if {$data(-fancy)} {
+ if {$data(-editable)} {
+ set data(w:cross) [button $frame.cross -bitmap $data(-crossbitmap)]
+ set data(w:tick) [button $frame.tick -bitmap $data(-tickbitmap)]
+
+ pack $frame.cross -side left -padx 1
+ pack $frame.tick -side left -padx 1
+ } else {
+ set data(w:tick) [button $frame.tick -bitmap $data(-tickbitmap)]
+ pack $frame.tick -side left -padx 1
+ }
+ }
+
+ if {$data(-dropdown)} {
+ pack $data(w:arrow) -side right -padx 1
+ foreach wid "$data(w:frame) $data(w:label)" {
+ tixAddBindTag $wid TixComboWid
+ tixSetMegaWidget $wid $w TixComboBox
+ }
+ } else {
+ pack $xframe -side right -padx 1
+ }
+ pack $frame.entry -side right -fill x -expand yes -padx 1
+}
+
+proc tixComboBox:ConstructListShell {w} {
+ upvar #0 $w data
+
+ # Create the shell and the list
+ #------------------------------
+ set data(w:shell) [menu $w.shell -bd 2 -relief raised -tearoff 0]
+ wm overrideredirect $data(w:shell) 1
+ wm withdraw $data(w:shell)
+
+ set data(w:slistbox) [tixScrolledListBox $data(w:shell).slistbox \
+ -anchor $data(-anchor) -scrollbarspace y \
+ -options {listbox.selectMode "browse"}]
+
+ set data(w:listbox) [$data(w:slistbox) subwidget listbox]
+
+ pack $data(w:slistbox) -expand yes -fill both -padx 2 -pady 2
+}
+
+proc tixComboBox:ConstructListFrame {w frame} {
+ upvar #0 $w data
+
+ set data(w:slistbox) [tixScrolledListBox $frame.slistbox \
+ -anchor $data(-anchor)]
+
+ set data(w:listbox) [$data(w:slistbox) subwidget listbox]
+
+ pack $data(w:slistbox) -expand yes -fill both
+}
+
+
+proc tixComboBox:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ # (1) Fix the bindings for the combobox
+ #
+ bindtags $w "$w TixComboBox [winfo toplevel $w] all"
+
+ # (2) The entry subwidget
+ #
+ tixSetMegaWidget $data(w:entry) $w TixComboBox
+
+ bindtags $data(w:entry) [list $data(w:entry) Entry TixComboEntry\
+ TixComboWid [winfo toplevel $data(w:entry)] all]
+
+ # (3) The listbox and slistbox
+ #
+ $data(w:slistbox) config -browsecmd \
+ "tixComboBox:LbBrowse $w"
+ $data(w:slistbox) config -command\
+ "tixComboBox:LbCommand $w"
+ $data(w:listbox) config -takefocus 0
+
+ tixAddBindTag $data(w:listbox) TixComboLb
+ tixAddBindTag $data(w:slistbox) TixComboLb
+ tixSetMegaWidget $data(w:listbox) $w TixComboBox
+ tixSetMegaWidget $data(w:slistbox) $w TixComboBox
+
+ # (4) The buttons
+ #
+ if {$data(-dropdown)} {
+ $data(w:arrow) config -takefocus 0
+ tixAddBindTag $data(w:arrow) TixComboArrow
+ tixSetMegaWidget $data(w:arrow) $w TixComboBox
+
+ bind $data(w:root) <1> "tixComboBox:RootDown $w"
+ bind $data(w:root) <ButtonRelease-1> "tixComboBox:RootUp $w"
+ }
+
+ if {$data(-fancy)} {
+ if {$data(-editable)} {
+ $data(w:cross) config -command "tixComboBox:CrossBtn $w" \
+ -takefocus 0
+ }
+ $data(w:tick) config -command "tixComboBox:Invoke $w" -takefocus 0
+ }
+
+ if {$data(-dropdown)} {
+ set data(state) 0
+ } else {
+ set data(state) n0
+ }
+}
+
+proc tixComboBoxBind {} {
+ #----------------------------------------------------------------------
+ # The class bindings for the TixComboBox
+ #
+ tixBind TixComboBox <Escape> {
+ if [tixComboBox:EscKey %W] {
+ break
+ }
+ }
+ tixBind TixComboBox <Configure> {
+ tixWidgetDoWhenIdle tixComboBox:align %W
+ }
+ # Only the two "linear" detail_fields are for tabbing (moving) among
+ # widgets inside the same toplevel. Other detail_fields are sort
+ # of irrelevant
+ #
+ tixBind TixComboBox <FocusOut> {
+ if {![string compare %d NotifyNonlinear] ||
+ ![string compare %d NotifyNonlinearVirtual]} {
+
+ if [info exists %W(cancelTab)] {
+ unset %W(cancelTab)
+ } else {
+ if [string compare [set %W(-state)] disabled] {
+ if [string compare [set %W(-selection)] [set %W(-value)]] {
+ tixComboBox:Invoke %W
+ }
+ }
+ }
+ }
+ }
+ tixBind TixComboBox <FocusIn> {
+ if {[tixStrEq %d NotifyNonlinear] ||
+ [tixStrEq %d NotifyNonlinearVirtual]} {
+
+ focus [%W subwidget entry]
+
+ # CYGNUS LOCAL: Setting the selection if there is no data
+ # causes backspace to misbehave.
+ if {[[set %W(w:entry)] get] != ""} {
+ [set %W(w:entry)] selection from 0
+ [set %W(w:entry)] selection to end
+ }
+ }
+ }
+
+ #----------------------------------------------------------------------
+ # The class tixBindings for the arrow button widget inside the TixComboBox
+ #
+
+ tixBind TixComboArrow <1> {
+ tixComboBox:ArrowDown [tixGetMegaWidget %W TixComboBox]
+ }
+ tixBind TixComboArrow <ButtonRelease-1> {
+ tixComboBox:ArrowUp [tixGetMegaWidget %W TixComboBox]
+ }
+ tixBind TixComboArrow <Escape> {
+ if [tixComboBox:EscKey [tixGetMegaWidget %W TixComboBox]] {
+ break
+ }
+ }
+
+
+ #----------------------------------------------------------------------
+ # The class tixBindings for the entry widget inside the TixComboBox
+ #
+ tixBind TixComboEntry <Up> {
+ tixComboBox:EntDirKey [tixGetMegaWidget %W TixComboBox] up
+ }
+ tixBind TixComboEntry <Down> {
+ tixComboBox:EntDirKey [tixGetMegaWidget %W TixComboBox] down
+ }
+ tixBind TixComboEntry <Prior> {
+ tixComboBox:EntDirKey [tixGetMegaWidget %W TixComboBox] pageup
+ }
+ tixBind TixComboEntry <Next> {
+ tixComboBox:EntDirKey [tixGetMegaWidget %W TixComboBox] pagedown
+ }
+ tixBind TixComboEntry <Return> {
+ tixComboBox:EntReturnKey [tixGetMegaWidget %W TixComboBox]
+ }
+ tixBind TixComboEntry <KeyPress> {
+ tixComboBox:EntKeyPress [tixGetMegaWidget %W TixComboBox]
+ }
+ tixBind TixComboEntry <Escape> {
+ if [tixComboBox:EscKey [tixGetMegaWidget %W TixComboBox]] {
+ break
+ }
+ }
+ tixBind TixComboEntry <Tab> {
+ if {[set [tixGetMegaWidget %W TixComboBox](-state)] != "disabled"} {
+ if [tixComboBox:EntTab [tixGetMegaWidget %W TixComboBox]] {
+ break
+ }
+ }
+ }
+ tixBind TixComboEntry <1> {
+ if {[set [tixGetMegaWidget %W TixComboBox](-state)] != "disabled"} {
+ focus %W
+ }
+ }
+ tixBind TixComboEntry <ButtonRelease-2> {
+ tixComboBox:EntKeyPress [tixGetMegaWidget %W TixComboBox]
+ }
+
+ #----------------------------------------------------------------------
+ # The class bindings for the listbox subwidget
+ #
+
+ tixBind TixComboWid <Escape> {
+ if [tixComboBox:EscKey [tixGetMegaWidget %W TixComboBox]] {
+ break
+ }
+ }
+
+ #----------------------------------------------------------------------
+ # The class bindings for some widgets inside ComboBox
+ #
+ tixBind TixComboWid <ButtonRelease-1> {
+ tixComboBox:WidUp [tixGetMegaWidget %W TixComboBox]
+ }
+ tixBind TixComboWid <Escape> {
+ if [tixComboBox:EscKey [tixGetMegaWidget %W TixComboBox]] {
+ break
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+# Cooked events
+#----------------------------------------------------------------------
+proc tixComboBox:ArrowDown {w} {
+ upvar #0 $w data
+
+ if ![string compare $data(-state) disabled] {
+ return
+ }
+
+ case $data(state) {
+ {0} {
+ tixComboBox:GoState 1 $w
+ }
+ {2} {
+ tixComboBox:GoState 19 $w
+ }
+ default {
+ tixComboBox:StateError $w
+ }
+ }
+}
+
+proc tixComboBox:ArrowUp {w} {
+ upvar #0 $w data
+
+ case $data(state) {
+ {1} {
+ tixComboBox:GoState 2 $w
+ }
+ {19} {
+ # data(ignore) was already set in state 19
+ tixComboBox:GoState 4 $w
+ }
+ {5} {
+ tixComboBox:GoState 13 $w
+ }
+ default {
+ tixComboBox:StateError $w
+ }
+ }
+}
+
+proc tixComboBox:RootDown {w} {
+ upvar #0 $w data
+
+ case $data(state) {
+ {0} {
+ # Ignore
+ }
+ {2} {
+ tixComboBox:GoState 3 $w
+ }
+ default {
+ tixComboBox:StateError $w
+ }
+ }
+}
+
+proc tixComboBox:RootUp {w} {
+ upvar #0 $w data
+
+ case $data(state) {
+ {1} {
+ tixComboBox:GoState 12 $w
+ }
+ {3} {
+ # data(ignore) was already set in state 3
+ tixComboBox:GoState 4 $w
+ }
+ {5} {
+ tixComboBox:GoState 7 $w
+ }
+ default {
+ tixComboBox:StateError $w
+ }
+ }
+}
+
+proc tixComboBox:WidUp {w} {
+ upvar #0 $w data
+
+ case $data(state) {
+ {1} {
+ tixComboBox:GoState 12 $w
+ }
+ {5} {
+ tixComboBox:GoState 13 $w
+ }
+ }
+}
+
+proc tixComboBox:LbBrowse {w args} {
+ upvar #0 $w data
+
+ set event [tixEvent type]
+ set x [tixEvent flag x]
+ set y [tixEvent flag y]
+ set X [tixEvent flag X]
+ set Y [tixEvent flag Y]
+
+ if ![string compare $data(-state) disabled] {
+ return
+ }
+
+ case $event {
+ <1> {
+ case $data(state) {
+ {2} {
+ tixComboBox:GoState 5 $w $x $y $X $Y
+ }
+ {5} {
+ tixComboBox:GoState 5 $w $x $y $X $Y
+ }
+ {n0} {
+ tixComboBox:GoState n6 $w $x $y $X $Y
+ }
+ default {
+ tixComboBox:StateError $w
+ }
+ }
+ }
+ <ButtonRelease-1> {
+ case $data(state) {
+ {5} {
+ tixComboBox:GoState 6 $w $x $y $X $Y
+ }
+ {n6} {
+ tixComboBox:GoState n0 $w
+ }
+ default {
+ tixComboBox:StateError $w
+ }
+ }
+ }
+ default {
+ # Must be a motion event
+ case $data(state) {
+ {1} {
+ tixComboBox:GoState 9 $w $x $y $X $Y
+ }
+ {5} {
+ tixComboBox:GoState 5 $w $x $y $X $Y
+ }
+ {n6} {
+ tixComboBox:GoState n6 $w $x $y $X $Y
+ }
+ default {
+ tixComboBox:StateError $w
+ }
+ }
+ }
+ }
+}
+
+proc tixComboBox:LbCommand {w} {
+ upvar #0 $w data
+
+ case $data(state) {
+ {n0} {
+ tixComboBox:GoState n1 $w
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+# General keyboard event
+
+# returns 1 if the combobox is in some special state and the Escape key
+# shouldn't be handled by the toplevel bind tag. As a result, when a combobox
+# is popped up in a dialog box, Escape will popdown the combo. If the combo
+# is not popped up, Escape will invoke the toplevel bindtag (which can
+# pop down the dialog box)
+#
+proc tixComboBox:EscKey {w} {
+ upvar #0 $w data
+
+ if ![string compare $data(-state) disabled] {
+ return
+ }
+
+ case $data(state) {
+ {0} {
+ tixComboBox:GoState 17 $w
+ }
+ {2} {
+ tixComboBox:GoState 16 $w
+ return 1
+ }
+ {n0} {
+ tixComboBox:GoState n4 $w
+ }
+ default {
+ # ignore
+ return 1
+ }
+ }
+
+ return 0
+}
+
+#----------------------------------------
+# Keyboard events
+#----------------------------------------
+proc tixComboBox:EntDirKey {w dir} {
+ upvar #0 $w data
+
+ if ![string compare $data(-state) disabled] {
+ return
+ }
+
+ case $data(state) {
+ {0} {
+ tixComboBox:GoState 10 $w $dir
+ }
+ {2} {
+ tixComboBox:GoState 11 $w $dir
+ }
+ {5} {
+ # ignore
+ }
+ {n0} {
+ tixComboBox:GoState n3 $w $dir
+ }
+ }
+}
+
+proc tixComboBox:EntReturnKey {w} {
+ upvar #0 $w data
+
+ if ![string compare $data(-state) disabled] {
+ return
+ }
+
+ case $data(state) {
+ {0} {
+ tixComboBox:GoState 14 $w
+ }
+ {2} {
+ tixComboBox:GoState 15 $w
+ }
+ {5} {
+ # ignore
+ }
+ {n0} {
+ tixComboBox:GoState n1 $w
+ }
+ }
+}
+
+# Return 1 == break from the binding == no keyboard focus traversal
+proc tixComboBox:EntTab {w} {
+ upvar #0 $w data
+
+ case $data(state) {
+ {0} {
+ tixComboBox:GoState 14 $w
+ set data(cancelTab) ""
+ return 0
+ }
+ {2} {
+ tixComboBox:GoState 15 $w
+ set data(cancelTab) ""
+ return 0
+ }
+ {n0} {
+ tixComboBox:GoState n1 $w
+ set data(cancelTab) ""
+ return 0
+ }
+ default {
+ return 1
+ }
+ }
+}
+
+proc tixComboBox:EntKeyPress {w} {
+ upvar #0 $w data
+
+ if {!$data(-editable)} {
+ return
+ }
+ if [tixStrEq $data(-state) disabled] {
+ return
+ }
+
+ case $data(state) {
+ {0 2 n0} {
+ tixComboBox:ClearListboxSelection $w
+ tixComboBox:SetSelection $w [$data(w:entry) get] 0 0
+ }
+
+ }
+}
+
+#----------------------------------------------------------------------
+
+proc tixComboBox:HandleDirKey {w dir} {
+ upvar #0 $w data
+
+ if [tixComboBox:CheckListboxSelection $w] {
+ case $dir {
+ "up" {
+ tkListboxUpDown $data(w:listbox) -1
+ set data(curIndex) [lindex [$data(w:listbox) curselection] 0]
+ tixComboBox:SetSelectionFromListbox $w
+ }
+ "down" {
+ tkListboxUpDown $data(w:listbox) 1
+ set data(curIndex) [lindex [$data(w:listbox) curselection] 0]
+ tixComboBox:SetSelectionFromListbox $w
+ }
+ "pageup" {
+ $data(w:listbox) yview scroll -1 pages
+ }
+ "pagedown" {
+ $data(w:listbox) yview scroll 1 pages
+ }
+ }
+ } else {
+ # There wasn't good selection in the listbox.
+ #
+ tixComboBox:SetSelectionFromListbox $w
+ }
+}
+
+proc tixComboBox:Invoke {w} {
+ upvar #0 $w data
+
+ tixComboBox:SetValue $w $data(-selection)
+ if ![winfo exists $w] {
+ return
+ }
+
+ if {$data(-history)} {
+ tixComboBox:addhistory $w $data(-value)
+ set data(curIndex) 0
+ }
+ $data(w:entry) selection from 0
+ $data(w:entry) selection to end
+ $data(w:entry) icursor end
+}
+
+#----------------------------------------------------------------------
+# MAINTAINING THE -VALUE
+#----------------------------------------------------------------------
+proc tixComboBox:SetValue {w newValue {noUpdate 0} {updateEnt 1}} {
+ upvar #0 $w data
+
+ if {$data(-validatecmd) != ""} {
+ set data(-value) [tixEvalCmdBinding $w $data(-validatecmd) "" $newValue]
+ } else {
+ set data(-value) $newValue
+ }
+
+ if {! $noUpdate} {
+ tixVariable:UpdateVariable $w
+ }
+
+ if {$updateEnt} {
+ if {!$data(-editable)} {
+ $data(w:entry) delete 0 end
+ $data(w:entry) insert 0 $data(-value)
+ }
+ }
+
+ if {!$data(-disablecallback) && $data(-command) != ""} {
+ if {![info exists data(varInited)]} {
+ set bind(specs) {%V}
+ set bind(%V) $data(-value)
+
+ tixEvalCmdBinding $w $data(-command) bind $data(-value)
+ if ![winfo exists $w] {
+ # The user destroyed the window!
+ return
+ }
+ }
+ }
+
+ set data(-selection) $data(-value)
+ if {$updateEnt} {
+ tixSetEntry $data(w:entry) $data(-value)
+
+ if {$data(-anchor) == "e"} {
+ tixComboBox:EntryAlignEnd $w
+ }
+ }
+}
+
+# markSel: should the all the text in the entry be highlighted?
+#
+proc tixComboBox:SetSelection {w value {markSel 1} {setent 1}} {
+ upvar #0 $w data
+
+ if {$setent} {
+ tixSetEntry $data(w:entry) $value
+ }
+ set data(-selection) $value
+
+ if {$data(-selectmode) == "browse"} {
+ if {$markSel} {
+ $data(w:entry) selection range 0 end
+ }
+ if {$data(-browsecmd) != ""} {
+ set bind(specs) {%V}
+ set bind(%V) [$data(w:entry) get]
+ tixEvalCmdBinding $w $data(-browsecmd) bind [$data(w:entry) get]
+ }
+ } else {
+ tixComboBox:SetValue $w $value 0 0
+ }
+}
+
+proc tixComboBox:ClearListboxSelection {w} {
+ upvar #0 $w data
+
+ $data(w:listbox) selection clear 0 end
+}
+
+proc tixComboBox:UpdateListboxSelection {w index} {
+ upvar #0 $w data
+
+ if {$index != ""} {
+ $data(w:listbox) selection set $index
+ $data(w:listbox) selection anchor $index
+ }
+}
+
+
+proc tixComboBox:Cancel {w} {
+ upvar #0 $w data
+
+ tixSetEntry $data(w:entry) $data(-value)
+ tixComboBox:SetSelection $w $data(-value)
+
+ if {"x[tixComboBox:LbGetSelection $w]" != "x$data(-selection)"} {
+ tixComboBox:ClearListboxSelection $w
+ }
+}
+
+proc tixComboBox:flash {w} {
+ tixComboBox:BlinkEntry $w
+}
+
+# Make the entry blink when the user selects a choice
+#
+proc tixComboBox:BlinkEntry {w} {
+ upvar #0 $w data
+
+ if {![info exists data(entryBlacken)]} {
+ set old_bg [$data(w:entry) cget -bg]
+ set old_fg [$data(w:entry) cget -fg]
+
+ $data(w:entry) config -fg $old_bg
+ $data(w:entry) config -bg $old_fg
+
+ set data(entryBlacken) 1
+ after 50 tixComboBox:RestoreBlink $w [list $old_bg] [list $old_fg]
+ }
+}
+
+proc tixComboBox:RestoreBlink {w old_bg old_fg} {
+ upvar #0 $w data
+
+ if {[info exists data(w:entry)] && [winfo exists $data(w:entry)]} {
+ $data(w:entry) config -fg $old_fg
+ $data(w:entry) config -bg $old_bg
+ }
+
+ if [info exists data(entryBlacken)] {
+ unset data(entryBlacken)
+ }
+}
+
+#----------------------------------------
+# Handle events inside the list box
+#----------------------------------------
+
+proc tixComboBox:LbIndex {w {flag ""}} {
+ upvar #0 $w data
+
+ set sel [lindex [$data(w:listbox) curselection] 0]
+ if {$sel != ""} {
+ return $sel
+ } else {
+ if {$flag == "emptyOK"} {
+ return ""
+ } else {
+ return 0
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+#
+# STATE MANIPULATION
+#
+#----------------------------------------------------------------------
+proc tixComboBox:GoState-0 {w} {
+ upvar #0 $w data
+}
+
+proc tixComboBox:GoState-1 {w} {
+ upvar #0 $w data
+
+ tixComboBox:Popup $w
+}
+
+proc tixComboBox:GoState-2 {w} {
+ upvar #0 $w data
+
+}
+
+proc tixComboBox:GoState-3 {w} {
+ upvar #0 $w data
+
+ set data(ignore) 1
+ tixComboBox:Popdown $w
+}
+
+proc tixComboBox:GoState-4 {w} {
+ upvar #0 $w data
+
+ tixComboBox:Ungrab $w
+ if {$data(ignore)} {
+ tixComboBox:Cancel $w
+ } else {
+ tixComboBox:Invoke $w
+ }
+ tixComboBox:GoState 0 $w
+}
+
+proc tixComboBox:GoState-5 {w x y X Y} {
+ upvar #0 $w data
+
+ tixComboBox:LbSelect $w $x $y $X $Y
+}
+
+proc tixComboBox:GoState-6 {w x y X Y} {
+ upvar #0 $w data
+
+ tixComboBox:Popdown $w
+
+ if [tixWithinWindow $data(w:shell) $X $Y] {
+ set data(ignore) 0
+ } else {
+ set data(ignore) 1
+ }
+
+ tixComboBox:GoState 4 $w
+}
+
+proc tixComboBox:GoState-7 {w} {
+ upvar #0 $w data
+
+ tixComboBox:Popdown $w
+ set data(ignore) 1
+ catch {
+ global tkPriv
+ if {$tkPriv(afterId) != ""} {
+ tkCancelRepeat
+ }
+ }
+
+ set data(ignore) 1
+ tixComboBox:GoState 4 $w
+}
+
+proc tixComboBox:GoState-9 {w x y X Y} {
+ upvar #0 $w data
+
+ catch {
+ tkButtonUp $data(w:arrow)
+ }
+ tixComboBox:GoState 5 $w $x $y $X $Y
+}
+
+proc tixComboBox:GoState-10 {w dir} {
+ upvar #0 $w data
+
+ tixComboBox:Popup $w
+ if {![tixComboBox:CheckListboxSelection $w]} {
+ # There wasn't good selection in the listbox.
+ #
+ tixComboBox:SetSelectionFromListbox $w
+ }
+
+ tixComboBox:GoState 2 $w
+}
+
+proc tixComboBox:GoState-11 {w dir} {
+ upvar #0 $w data
+
+ tixComboBox:HandleDirKey $w $dir
+
+ tixComboBox:GoState 2 $w
+}
+
+proc tixComboBox:GoState-12 {w} {
+ upvar #0 $w data
+
+ catch {
+ tkButtonUp $data(w:arrow)
+ }
+
+ tixComboBox:GoState 2 $w
+}
+
+proc tixComboBox:GoState-13 {w} {
+ upvar #0 $w data
+
+ catch {
+ global tkPriv
+ if {$tkPriv(afterId) != ""} {
+ tkCancelRepeat
+ }
+ }
+ tixComboBox:GoState 2 $w
+}
+
+proc tixComboBox:GoState-14 {w} {
+ upvar #0 $w data
+
+ tixComboBox:Invoke $w
+ tixComboBox:GoState 0 $w
+}
+
+proc tixComboBox:GoState-15 {w} {
+ upvar #0 $w data
+
+ tixComboBox:Popdown $w
+ set data(ignore) 0
+ tixComboBox:GoState 4 $w
+}
+
+proc tixComboBox:GoState-16 {w} {
+ upvar #0 $w data
+
+ tixComboBox:Popdown $w
+ tixComboBox:Cancel $w
+ set data(ignore) 1
+ tixComboBox:GoState 4 $w
+}
+
+proc tixComboBox:GoState-17 {w} {
+ upvar #0 $w data
+
+ tixComboBox:Cancel $w
+ tixComboBox:GoState 0 $w
+}
+
+proc tixComboBox:GoState-19 {w} {
+ upvar #0 $w data
+
+ if {"x$data(-selection)" != "x$data(-value)"} {
+ set data(ignore) 0
+ } else {
+ set data(ignore) 1
+ }
+ tixComboBox:Popdown $w
+}
+
+#----------------------------------------------------------------------
+# Non-dropdown states
+#----------------------------------------------------------------------
+proc tixComboBox:GoState-n0 {w} {
+ upvar #0 $w data
+}
+
+proc tixComboBox:GoState-n1 {w} {
+ upvar #0 $w data
+
+ tixComboBox:Invoke $w
+ tixComboBox:GoState n0 $w
+}
+
+proc tixComboBox:GoState-n3 {w dir} {
+ upvar #0 $w data
+
+ tixComboBox:HandleDirKey $w $dir
+ tixComboBox:GoState n0 $w
+}
+
+proc tixComboBox:GoState-n4 {w} {
+ upvar #0 $w data
+
+ tixComboBox:Cancel $w
+ tixComboBox:GoState n0 $w
+}
+
+proc tixComboBox:GoState-n6 {w x y X Y} {
+ upvar #0 $w data
+
+ tixComboBox:LbSelect $w $x $y $X $Y
+}
+
+#----------------------------------------------------------------------
+# General State Manipulation
+#----------------------------------------------------------------------
+proc tixComboBox:GoState {s w args} {
+ upvar #0 $w data
+
+ tixComboBox:SetState $w $s
+ eval tixComboBox:GoState-$s $w $args
+}
+
+proc tixComboBox:SetState {w s} {
+ upvar #0 $w data
+
+# catch {puts [info level -2]}
+# puts "setting state $data(state) --> $s"
+ set data(state) $s
+}
+
+proc tixComboBox:StateError {w} {
+ upvar #0 $w data
+
+# error "wrong state $data(state)"
+}
+
+#----------------------------------------------------------------------
+# Listbox handling
+#----------------------------------------------------------------------
+
+# Set a selection if there isn't one. Returns true if there was already
+# a good selection inside the listbox
+#
+proc tixComboBox:CheckListboxSelection {w} {
+ upvar #0 $w data
+
+ if {[$data(w:listbox) curselection] == ""} {
+ if {$data(curIndex) == ""} {
+ set data(curIndex) 0
+ }
+
+ $data(w:listbox) activate $data(curIndex)
+ $data(w:listbox) selection clear 0 end
+ $data(w:listbox) selection set $data(curIndex)
+ $data(w:listbox) see $data(curIndex)
+ return 0
+ } else {
+ return 1
+ }
+}
+
+proc tixComboBox:SetSelectionFromListbox {w} {
+ upvar #0 $w data
+
+ set string [$data(w:listbox) get $data(curIndex)]
+ tixComboBox:SetSelection $w $string
+ tixComboBox:UpdateListboxSelection $w $data(curIndex)
+}
+
+proc tixComboBox:LbGetSelection {w} {
+ upvar #0 $w data
+ set index [tixComboBox:LbIndex $w emptyOK]
+
+ if {$index >=0} {
+ return [$data(w:listbox) get $index]
+ } else {
+ return ""
+ }
+}
+
+proc tixComboBox:LbSelect {w x y X Y} {
+ upvar #0 $w data
+
+ set index [tixComboBox:LbIndex $w emptyOK]
+ if {$index == ""} {
+ set index [$data(w:listbox) nearest $y]
+ }
+
+ if {$index >= 0} {
+ if {"x[focus -lastfor $data(w:entry)]" != "x$data(w:entry)" &&
+ "x[focus -lastfor $data(w:entry)]" != "x$data(w:listbox)"} {
+ focus $data(w:entry)
+ }
+
+ set string [$data(w:listbox) get $index]
+ tixComboBox:SetSelection $w $string
+
+ tixComboBox:UpdateListboxSelection $w $index
+ }
+}
+
+#----------------------------------------------------------------------
+# Internal commands
+#----------------------------------------------------------------------
+proc tixComboBox:CrossBtn {w} {
+ upvar #0 $w data
+
+ $data(w:entry) delete 0 end
+ tixComboBox:ClearListboxSelection $w
+ tixComboBox:SetSelection $w ""
+}
+
+#--------------------------------------------------
+# Popping up list shell
+#--------------------------------------------------
+
+# Popup the listbox and grab
+#
+#
+proc tixComboBox:Popup {w} {
+ global tcl_platform
+ upvar #0 $w data
+
+ if {![winfo ismapped $data(w:root)]} {
+ return
+ }
+
+ #---------------------------------------------------------------------
+ # Pop up
+ #
+ if {$data(-listcmd) != ""} {
+ # This option allows the user to fill in the listbox on demand
+ #
+ tixEvalCmdBinding $w $data(-listcmd)
+ }
+
+ # calculate the size
+ set y [winfo rooty $data(w:entry)]
+ incr y [winfo height $data(w:entry)]
+ incr y 3
+
+ set bd [$data(w:shell) cget -bd]
+# incr bd [$data(w:shell) cget -highlightthickness]
+ set height [expr [winfo reqheight $data(w:slistbox)] + 2*$bd]
+
+ set x1 [winfo rootx $data(w:entry)]
+ if {$data(-listwidth) == ""} {
+ if [winfo ismapped $data(w:arrow)] {
+ set x2 [winfo rootx $data(w:arrow)]
+ if {$x2 >= $x1} {
+ incr x2 [winfo width $data(w:arrow)]
+ set width [expr "$x2 - $x1"]
+ } else {
+ set width [winfo width $data(w:entry)]
+ set x2 [expr $x1 + $width]
+ }
+ } else {
+ set width [winfo width $data(w:entry)]
+ set x2 [expr $x1 + $width]
+ }
+ } else {
+ set width $data(-listwidth)
+ set x2 [expr $x1 + $width]
+ }
+
+ set reqwidth [winfo reqwidth $data(w:shell)]
+ if {$reqwidth < $width} {
+ set reqwidth $width
+ } else {
+ if {$reqwidth > [expr $width *3]} {
+ set reqwidth [expr $width *3]
+ }
+ if {$reqwidth > [winfo vrootwidth .]} {
+ set reqwidth [winfo vrootwidth .]
+ }
+ }
+ set width $reqwidth
+
+
+ # If the listbox is too far right, pull it back to the left
+ #
+ set scrwidth [winfo vrootwidth .]
+ if {$x2 > $scrwidth} {
+ set x1 [expr $scrwidth - $width]
+ }
+
+ # If the listbox is too far left, pull it back to the right
+ #
+ if {$x1 < 0} {
+ set x1 0
+ }
+
+ # If the listbox is below bottom of screen, put it upwards
+ #
+ set scrheight [winfo vrootheight .]
+ set bottom [expr $y+$height]
+ if {$bottom > $scrheight} {
+ set y [expr $y-$height-[winfo height $data(w:entry)]-5]
+ }
+
+ # OK , popup the shell
+ #
+
+ wm geometry $data(w:shell) $reqwidth\x$height+$x1+$y
+ if {$tcl_platform(platform) == "windows"} {
+ update
+ }
+ wm deiconify $data(w:shell)
+ if {$tcl_platform(platform) == "windows"} {
+ update
+ }
+
+ raise $data(w:shell)
+ focus $data(w:entry)
+ set data(popped) 1
+
+ tixComboBox:Grab $w
+}
+
+proc tixComboBox:SetCursor {w cursor} {
+ upvar #0 $w data
+
+ $w config -cursor $cursor
+}
+
+proc tixComboBox:Popdown {w} {
+ upvar #0 $w data
+
+ wm withdraw $data(w:shell)
+ tixComboBox:SetCursor $w ""
+}
+
+# Grab the server so that user cannot move the windows around
+proc tixComboBox:Grab {w} {
+ upvar #0 $w data
+
+ tixComboBox:SetCursor $w arrow
+ catch {
+ # We catch here because grab may fail under a lot of circumstances
+ # Just don't want to break the code ...
+ case $data(-grab) {
+ global {
+ tixPushGrab -global $data(w:root)
+ }
+ local {
+ tixPushGrab $data(w:root)
+ }
+ }
+ }
+}
+
+proc tixComboBox:Ungrab {w} {
+ upvar #0 $w data
+
+ case $data(-grab) {
+ global {
+ tixPopGrab
+ }
+ local {
+ tixPopGrab
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+# Alignment
+#----------------------------------------------------------------------
+# The following two routines can emulate a "right align mode" for the
+# entry in the combo box.
+
+proc tixComboBox:EntryAlignEnd {w} {
+ upvar #0 $w data
+ $data(w:entry) xview end
+}
+
+
+proc tixComboBox:Destructor {w} {
+ upvar #0 $w data
+
+ tixUnsetMegaWidget $data(w:entry)
+ tixVariable:DeleteVariable $w
+
+ # Chain this to the superclass
+ #
+ tixChainMethod $w Destructor
+}
+
+
+#----------------------------------------------------------------------
+# CONFIG OPTIONS
+#----------------------------------------------------------------------
+
+proc tixComboBox:config-state {w value} {
+ upvar #0 $w data
+ catch {if {"x[$data(w:arrow) cget -state]" == "x$value"} {
+ set a 1
+ }}
+ if [info exists a] {
+ return
+ }
+
+ catch {$data(w:arrow) config -state $value}
+ catch {$data(w:tick) config -state $value}
+ catch {$data(w:cross) config -state $value}
+ catch {$data(w:slistbox) config -state $value}
+
+ if ![string compare $value normal] {
+ set fg [$data(w:arrow) cget -fg]
+ set entryFg $data(entryfg)
+ set lbSelFg [lindex [$data(w:listbox) config -selectforeground] 3]
+ set lbSelBg [lindex [$data(w:listbox) config -selectbackground] 3]
+ set entrySelFg [lindex [$data(w:entry) config -selectforeground] 3]
+ set entrySelBg [lindex [$data(w:entry) config -selectbackground] 3]
+ } else {
+ set fg [$data(w:arrow) cget -disabledforeground]
+ set entryFg $data(-disabledforeground)
+ set lbSelFg $entryFg
+ set lbSelBg [$data(w:listbox) cget -bg]
+ set entrySelFg $entryFg
+ set entrySelBg [$data(w:entry) cget -bg]
+ }
+ if [string compare $fg ""] {
+ $data(w:label) config -fg $fg
+ $data(w:listbox) config -fg $fg -selectforeground $lbSelFg \
+ -selectbackground $lbSelBg
+ }
+ $data(w:entry) config -fg $entryFg -selectforeground $entrySelFg \
+ -selectbackground $entrySelBg
+
+ if ![string compare $value normal] {
+ if {$data(-editable)} {
+ $data(w:entry) config -state normal
+ }
+ $data(w:entry) config -takefocus 1
+ } else {
+ if {$data(-editable)} {
+ $data(w:entry) config -state disabled
+ }
+ $data(w:entry) config -takefocus 0
+ }
+}
+
+proc tixComboBox:config-value {w value} {
+ upvar #0 $w data
+
+ tixComboBox:SetValue $w $value
+
+ set data(-selection) $value
+
+ if {"x[tixComboBox:LbGetSelection $w]" != "x$value"} {
+ tixComboBox:ClearListboxSelection $w
+ }
+}
+
+proc tixComboBox:config-selection {w value} {
+ upvar #0 $w data
+
+ tixComboBox:SetSelection $w $value
+
+ if {"x[tixComboBox:LbGetSelection $w]" != "x$value"} {
+ tixComboBox:ClearListboxSelection $w
+ }
+}
+
+proc tixComboBox:config-variable {w arg} {
+ upvar #0 $w data
+
+ if [tixVariable:ConfigVariable $w $arg] {
+ # The value of data(-value) is changed if tixVariable:ConfigVariable
+ # returns true
+ set data(-selection) $data(-value)
+ tixComboBox:SetValue $w $data(-value) 1
+ }
+ catch {
+ unset data(varInited)
+ }
+ set data(-variable) $arg
+}
+
+
+#----------------------------------------------------------------------
+# WIDGET COMMANDS
+#----------------------------------------------------------------------
+proc tixComboBox:align {w args} {
+ upvar #0 $w data
+
+ if {$data(-anchor) == "e"} {
+ tixComboBox:EntryAlignEnd $w
+ }
+}
+
+proc tixComboBox:addhistory {w value} {
+ upvar #0 $w data
+
+ tixComboBox:insert $w 0 $value
+ $data(w:listbox) selection clear 0 end
+
+ if {$data(-prunehistory)} {
+ # Prune from the end
+ #
+ set max [$data(w:listbox) size]
+ if {$max <= 1} {
+ return
+ }
+ for {set i [expr $max -1]} {$i >= 1} {incr i -1} {
+ if {"x[$data(w:listbox) get $i]" == "x$value"} {
+ $data(w:listbox) delete $i
+ break
+ }
+ }
+ }
+}
+
+proc tixComboBox:appendhistory {w value} {
+ upvar #0 $w data
+
+ tixComboBox:insert $w end $value
+ $data(w:listbox) selection clear 0 end
+
+ if {$data(-prunehistory)} {
+ # Prune from the end
+ #
+ set max [$data(w:listbox) size]
+ if {$max <= 1} {
+ return
+ }
+ for {set i [expr $max -2]} {$i >= 0} {incr i -1} {
+ if {"x[$data(w:listbox) get $i]" == "x$value"} {
+ $data(w:listbox) delete $i
+ break
+ }
+ }
+ }
+}
+
+proc tixComboBox:insert {w index newitem} {
+ upvar #0 $w data
+
+ $data(w:listbox) insert $index $newitem
+
+ if {$data(-history) && $data(-historylimit) != ""} {
+ if {"x[$data(w:listbox) size]" == "x$data(-historylimit)"} {
+ $data(w:listbox) delete 0
+ }
+ }
+}
+
+proc tixComboBox:pick {w index} {
+ upvar #0 $w data
+
+ $data(w:listbox) activate $index
+ $data(w:listbox) selection clear 0 end
+ $data(w:listbox) selection set active
+ $data(w:listbox) see active
+ set text [$data(w:listbox) get $index]
+
+ tixComboBox:SetValue $w $text
+
+ set data(curIndex) $index
+}
+
+proc tixComboBox:invoke {w} {
+ tixComboBox:Invoke $w
+}
+
+proc tixComboBox:popdown {w} {
+ upvar #0 $w data
+
+ if {$data(-dropdown)} {
+ tixComboBox:Popdown $w
+ }
+}
diff --git a/tix/library/Compat.tcl b/tix/library/Compat.tcl
new file mode 100644
index 00000000000..c1f9005399d
--- /dev/null
+++ b/tix/library/Compat.tcl
@@ -0,0 +1,39 @@
+# Compat.tcl --
+#
+# This file wraps around many incompatibilities from Tix 3.6
+# to Tix 4.0.
+#
+# (1) "box" to "Box" changes
+# (2) "DlgBtns" to "ButtonBox" changes
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+proc tixDlgBtns {args} {
+ return [eval tixButtonBox $args]
+}
+
+proc tixStdDlgBtns {args} {
+ return [eval tixStdButtonBox $args]
+}
+
+proc tixCombobox {args} {
+ return [eval tixComboBox $args]
+}
+
+proc tixFileSelectbox {args} {
+ return [eval tixFileSelectBox $args]
+}
+
+proc tixScrolledListbox {args} {
+ return [eval tixScrolledListBox $args]
+}
+
+proc tixInit {args} {
+ eval tix config $args
+ puts stderr "tixInit no longer needed for this version of Tix"
+}
diff --git a/tix/library/Console.tcl b/tix/library/Console.tcl
new file mode 100644
index 00000000000..26b0da92aa0
--- /dev/null
+++ b/tix/library/Console.tcl
@@ -0,0 +1,515 @@
+# 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.
+#
+# This file was distributed as a part of Tk 4.1 by Sun
+# Microsystems, Inc. and subsequently modified by Expert
+# Interface Techonoligies and included as a part of Tix.
+#
+# Some of the functions in this file have been renamed from
+# using a "tk" prefix to a "tix" prefix to avoid namespace
+# conflict with the original file.
+#
+# Copyright (c) 1995-1996 Sun Microsystems, Inc.
+# Copyright (c) 1996 Expert Interface Technologies.
+#
+# See the file "docs/license.tcltk" for information on usage and
+# redistribution of the original file "console.tcl". These license
+# terms do NOT apply to other files in the Tix distribution.
+#
+# See the file "license.terms" for information on usage and
+# redistribution * of this file, and for a DISCLAIMER OF ALL
+# WARRANTIES.
+
+# tixConsoleInit --
+# This procedure constructs and configures the console windows.
+#
+# Arguments:
+# None.
+
+proc tixConsoleInit {} {
+ global tcl_platform
+
+ uplevel #0 set tixConsoleTextFont Courier
+ uplevel #0 set tixConsoleTextSize 14
+
+ set f [frame .f]
+ set fontcb [tixComboBox $f.size -label "" -command "tixConsoleSetFont" \
+ -variable tixConsoleTextFont \
+ -options {
+ entry.width 15
+ listbox.height 5
+ }]
+ set sizecb [tixComboBox $f.font -label "" -command "tixConsoleSetFont" \
+ -variable tixConsoleTextSize \
+ -options {
+ entry.width 4
+ listbox.width 6
+ listbox.height 5
+ }]
+ pack $fontcb $sizecb -side left
+ pack $f -side top -fill x -padx 2 -pady 2
+ foreach font {
+ "Courier New"
+ "Courier"
+ "Helvetica"
+ "Lucida"
+ "Lucida Typewriter"
+ "MS LineDraw"
+ "System"
+ "Times Roman"
+ } {
+ $fontcb subwidget listbox insert end $font
+ }
+
+ for {set s 6} {$s < 25} {incr s} {
+ $sizecb subwidget listbox insert end $s
+ }
+
+ bind [$fontcb subwidget entry] <Escape> "focus .console"
+ bind [$sizecb subwidget entry] <Escape> "focus .console"
+
+ text .console -yscrollcommand ".sb set" -setgrid true \
+ -highlightcolor [. cget -bg] -highlightbackground [. cget -bg] \
+ -cursor left_ptr
+ scrollbar .sb -command ".console yview" -highlightcolor [. cget -bg] \
+ -highlightbackground [. cget -bg]
+ pack .sb -side right -fill both
+ pack .console -fill both -expand 1 -side left
+
+ tixConsoleBind .console
+
+ .console tag configure stderr -foreground red
+ .console tag configure stdin -foreground blue
+
+ focus .console
+
+ wm protocol . WM_DELETE_WINDOW { wm withdraw . }
+ wm title . "Console"
+ flush stdout
+ .console mark set output [.console index "end - 1 char"]
+ tkTextSetCursor .console end
+ .console mark set promptEnd insert
+ .console mark gravity promptEnd left
+
+ tixConsoleSetFont
+}
+
+proc tixConsoleSetFont {args} {
+ if ![winfo exists .console] tixConsoleInit
+
+ global tixConsoleTextFont tixConsoleTextSize
+
+ set font -*-$tixConsoleTextFont-medium-r-normal-*-$tixConsoleTextSize-*-*-*-*-*-*-*
+ .console config -font $font
+}
+
+# tixConsoleInvoke --
+# 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 tixConsoleInvoke {args} {
+ if ![winfo exists .console] tixConsoleInit
+
+ if {[.console dlineinfo insert] != {}} {
+ set setend 1
+ } else {
+ set setend 0
+ }
+ 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 == ""} {
+ tixConsolePrompt
+ } elseif [info complete $cmd] {
+ .console mark set output end
+ .console tag delete input
+ set err [catch {
+ set result [interp record $cmd]
+ } result]
+
+ if {$result != ""} {
+ if {$err} {
+ .console insert insert "$result\n" stderr
+ } else {
+ .console insert insert "$result\n"
+ }
+ }
+ tixConsoleHistory reset
+ tixConsolePrompt
+ } else {
+ tixConsolePrompt partial
+ }
+ if {$setend} {
+ .console yview -pickplace insert
+ }
+}
+
+# tixConsoleHistory --
+# This procedure implements command line history for the
+# console. In general is evals the history command in the
+# main interpreter to obtain the history. The global variable
+# histNum is used to store the current location in the history.
+#
+# Arguments:
+# cmd - Which action to take: prev, next, reset.
+
+set histNum 1
+proc tixConsoleHistory {cmd} {
+ if ![winfo exists .console] tixConsoleInit
+
+ 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 {interp 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 {interp eval $cmd} cmd
+ }
+ .console delete promptEnd end
+ .console insert promptEnd $cmd {input stdin}
+ }
+ reset {
+ set histNum 1
+ }
+ }
+}
+
+# tixConsolePrompt --
+# 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 tixConsolePrompt {{partial normal}} {
+ if ![winfo exists .console] tixConsoleInit
+
+ if {$partial == "normal"} {
+ set temp [.console index "end - 1 char"]
+ .console mark set output end
+ if [interp eval "info exists tcl_prompt1"] {
+ interp eval "eval \[set tcl_prompt1\]"
+ } else {
+ puts -nonewline "% "
+ }
+ } else {
+ set temp [.console index output]
+ .console mark set output end
+ if [interp eval "info exists tcl_prompt2"] {
+ interp eval "eval \[set tcl_prompt2\]"
+ } else {
+ puts -nonewline "> "
+ }
+ }
+
+ flush stdout
+ .console mark set output $temp
+ tkTextSetCursor .console end
+ .console mark set promptEnd insert
+ .console mark gravity promptEnd left
+}
+
+# tixConsoleBind --
+# This procedure first ensures that the default bindings for the Text
+# class have been defined. Then certain bindings are overridden for
+# the class.
+#
+# Arguments:
+# None.
+
+proc tixConsoleBind {win} {
+ if ![winfo exists .console] tixConsoleInit
+
+ bindtags $win "$win Text . all"
+
+ # 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 $win <Alt-KeyPress> {# nothing }
+ bind $win <Meta-KeyPress> {# nothing}
+ bind $win <Control-KeyPress> {# nothing}
+ bind $win <Escape> {# nothing}
+ bind $win <KP_Enter> {# nothing}
+
+ bind $win <Tab> {
+ tixConsoleInsert %W \t
+ focus %W
+ break
+ }
+ bind $win <Return> {
+ %W mark set insert {end - 1c}
+ tixConsoleInsert %W "\n"
+ tixConsoleInvoke
+ 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> {
+ tixConsoleHistory prev
+ break
+ }
+ }
+ foreach prev {Control-n Down} {
+ bind $win <$prev> {
+ tixConsoleHistory next
+ break
+ }
+ }
+ bind $win <Control-v> {
+ if [%W compare insert > promptEnd] {
+ catch {
+ %W insert insert [selection get -displayof %W] {input stdin}
+ %W see insert
+ }
+ }
+ break
+ }
+ bind $win <Insert> {
+ catch {tixConsoleInsert %W [selection get -displayof %W]}
+ break
+ }
+ bind $win <KeyPress> {
+ tixConsoleInsert %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 <Control-Up> {
+ %W yview scroll -1 unit
+ break;
+ }
+ bind $win <Control-Down> {
+ %W yview scroll 1 unit
+ break;
+ }
+ bind $win <Prior> {
+ %W yview scroll -1 pages
+ }
+ bind $win <Next> {
+ %W yview scroll 1 pages
+ }
+ bind $win <F9> {
+ eval destroy [winfo child .]
+ source $tix_library/Console.tcl
+ }
+ foreach copy {F16 Meta-w Control-i} {
+ bind $win <$copy> {
+ if {[selection own -displayof %W] == "%W"} {
+ clipboard clear -displayof %W
+ catch {
+ clipboard append -displayof %W [selection get -displayof %W]
+ }
+ }
+ break
+ }
+ }
+ foreach paste {F18 Control-y} {
+ bind $win <$paste> {
+ catch {
+ set clip [selection get -displayof %W -selection CLIPBOARD]
+ set list [split $clip \n\r]
+ tixConsoleInsert %W [lindex $list 0]
+ foreach x [lrange $list 1 end] {
+ %W mark set insert {end - 1c}
+ tixConsoleInsert %W "\n"
+ tixConsoleInvoke
+ tixConsoleInsert %W $x
+ }
+ }
+ break
+ }
+ }
+}
+
+# tixConsoleInsert --
+# Insert a string into a text at the point of the insertion cursor.
+# If there is a selection in the text, and it covers the point of the
+# insertion cursor, then delete the selection before inserting. Insertion
+# 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 tixConsoleInsert {w s} {
+ if ![winfo exists .console] tixConsoleInit
+
+ if {[.console dlineinfo insert] != {}} {
+ set setend 1
+ } else {
+ set setend 0
+ }
+ 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
+ }
+ }
+ if {[$w compare insert < promptEnd]} {
+ $w mark set insert end
+ }
+ $w insert insert $s {input stdin}
+ if $setend {
+ .console see insert
+ }
+}
+
+
+
+# tixConsoleOutput --
+#
+# This routine is called directly by ConsolePutsCmd to cause a string
+# to be displayed in the console.
+#
+# Arguments:
+# dest - The output tag to be used: either "stderr" or "stdout".
+# string - The string to be displayed.
+
+proc tixConsoleOutput {dest string} {
+ if ![winfo exists .console] tixConsoleInit
+
+ if {[.console dlineinfo insert] != {}} {
+ set setend 1
+ } else {
+ set setend 0
+ }
+ .console insert output $string $dest
+ if $setend {
+ .console see insert
+ }
+}
+
+# tixConsoleExit --
+#
+# This routine is called by ConsoleEventProc when the main window of
+# the application is destroyed.
+#
+# Arguments:
+# None.
+
+proc tixConsoleExit {} {
+ if ![winfo exists .console] tixConsoleInit
+
+ exit
+}
+
diff --git a/tix/library/Control.tcl b/tix/library/Control.tcl
new file mode 100644
index 00000000000..c96429f7343
--- /dev/null
+++ b/tix/library/Control.tcl
@@ -0,0 +1,498 @@
+# Control.tcl --
+#
+# Implements the TixControl Widget. It is called the "SpinBox"
+# in other toolkits.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixControl {
+ -classname TixControl
+ -superclass tixLabelWidget
+ -method {
+ incr decr invoke update
+ }
+ -flag {
+ -allowempty -autorepeat -command -decrcmd -disablecallback
+ -disabledforeground -incrcmd -initwait -integer -llimit
+ -repeatrate -max -min -selectmode -step -state -validatecmd
+ -value -variable -ulimit
+ }
+ -forcecall {
+ -variable -state
+ }
+ -configspec {
+ {-allowempty allowEmpty AllowEmpty false}
+ {-autorepeat autoRepeat AutoRepeat true}
+ {-command command Command ""}
+ {-decrcmd decrCmd DecrCmd ""}
+ {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
+ {-disabledforeground disabledForeground DisabledForeground #303030}
+ {-incrcmd incrCmd IncrCmd ""}
+ {-initwait initWait InitWait 500}
+ {-integer integer Integer false}
+ {-max max Max ""}
+ {-min min Min ""}
+ {-repeatrate repeatRate RepeatRate 50}
+ {-step step Step 1}
+ {-state state State normal}
+ {-selectmode selectMode SelectMode normal}
+ {-validatecmd validateCmd ValidateCmd ""}
+ {-value value Value 0}
+ {-variable variable Variable ""}
+ }
+ -alias {
+ {-llimit -min}
+ {-ulimit -max}
+ }
+ -default {
+ {.borderWidth 0}
+ {*entry.relief sunken}
+ {*entry.width 5}
+ {*label.anchor e}
+ {*label.borderWidth 0}
+ {*Label.font -Adobe-Helvetica-Bold-R-Normal--*-120-*}
+ {*Button.anchor c}
+ {*Button.borderWidth 2}
+ {*Button.highlightThickness 1}
+ {*Button.takeFocus 0}
+ {*Entry.background #c3c3c3}
+ }
+}
+
+proc tixControl:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+
+ set data(varInited) 0
+ set data(serial) 0
+}
+
+proc tixControl:ConstructFramedWidget {w frame} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructFramedWidget $frame
+
+ set data(w:entry) [entry $frame.entry]
+
+ set data(w:incr) [button $frame.incr -bitmap [tix getbitmap incr] \
+ -takefocus 0]
+ set data(w:decr) [button $frame.decr -bitmap [tix getbitmap decr] \
+ -takefocus 0]
+
+# tixForm $data(w:entry) -left 0 -top 0 -bottom -1 -right $data(w:decr)
+# tixForm $data(w:incr) -right -1 -top 0 -bottom %50
+# tixForm $data(w:decr) -right -1 -top $data(w:incr) -bottom -1
+
+ pack $data(w:entry) -side left -expand yes -fill both
+ pack $data(w:decr) -side bottom -fill both -expand yes
+ pack $data(w:incr) -side top -fill both -expand yes
+
+ $data(w:entry) delete 0 end
+ $data(w:entry) insert 0 $data(-value)
+
+ # This value is used to configure the disable/normal fg of the ebtry
+ set data(entryfg) [$data(w:entry) cget -fg]
+ set data(labelfg) [$data(w:label) cget -fg]
+}
+
+proc tixControl:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ if {$data(-autorepeat)} {
+ bind $data(w:incr) <ButtonPress-1> \
+ [format {after idle tixControl:StartRepeat %s 1} $w]
+ bind $data(w:decr) <ButtonPress-1> \
+ [format {after idle tixControl:StartRepeat %s -1} $w]
+
+ # These bindings will stop the button autorepeat when the
+ # mouse button is up
+ foreach btn "$data(w:incr) $data(w:decr)" amt {1 -1} {
+ bind $btn <ButtonRelease-1> "tixControl:StopRepeat $w $amt"
+ }
+ } else {
+ # Force the non-autorepeat case to use the normal
+ # tk button class bindings
+ $data(w:incr) configure -command "tixControl:incr $w"
+ $data(w:decr) configure -command "tixControl:decr $w"
+ }
+
+ tixSetMegaWidget $data(w:entry) $w
+
+ # If user press <return>, verify the value and call the -command
+ #
+ tixAddBindTag $data(w:entry) TixControl:Entry
+}
+
+proc tixControlBind {} {
+ tixBind TixControl:Entry <Return> {
+ tixControl:Invoke [tixGetMegaWidget %W] 1
+ }
+ tixBind TixControl:Entry <Escape> {
+ tixControl:Escape [tixGetMegaWidget %W]
+ }
+ tixBind TixControl:Entry <Up> {
+ [tixGetMegaWidget %W] incr
+ }
+ tixBind TixControl:Entry <Down> {
+ [tixGetMegaWidget %W] decr
+ }
+ tixBind TixControl:Entry <FocusOut> {
+ if {"%d" == "NotifyNonlinear" || "%d" == "NotifyNonlinearVirtual"} {
+ tixControl:Tab [tixGetMegaWidget %W] %d
+ }
+ }
+ tixBind TixControl:Entry <Any-KeyPress> {
+ tixControl:KeyPress [tixGetMegaWidget %W]
+ }
+ tixBind TixControl:Entry <Any-Tab> {
+ # This has a higher priority than the <Any-KeyPress> binding
+ # --> so that data(edited) is not set
+ }
+}
+
+#----------------------------------------------------------------------
+# CONFIG OPTIONS
+#----------------------------------------------------------------------
+proc tixControl:config-state {w arg} {
+ upvar #0 $w data
+
+ if {$arg == "normal"} {
+ $data(w:incr) config -state $arg
+ $data(w:decr) config -state $arg
+ catch {
+ $data(w:label) config -fg $data(labelfg)
+ }
+ $data(w:entry) config -state $arg -fg $data(entryfg)
+ tixControl:SetBindings $w
+ } else {
+ $data(w:incr) config -state $arg
+ $data(w:decr) config -state $arg
+ catch {
+ $data(w:label) config -fg $data(-disabledforeground)
+ }
+ $data(w:entry) config -state $arg -fg $data(-disabledforeground)
+ bind $data(w:incr) <ButtonPress-1> {}
+ bind $data(w:decr) <ButtonPress-1> {}
+ }
+}
+
+proc tixControl:config-value {w value} {
+ upvar #0 $w data
+
+ tixControl:SetValue $w $value 0 1
+
+ # This will tell the Intrinsics: "Please use this value"
+ # because "value" might be altered by SetValues
+ #
+ return $data(-value)
+}
+
+proc tixControl:config-variable {w arg} {
+ upvar #0 $w data
+
+ if [tixVariable:ConfigVariable $w $arg] {
+ # The value of data(-value) is changed if tixVariable:ConfigVariable
+ # returns true
+ tixControl:SetValue $w $data(-value) 1 1
+ }
+ catch {
+ unset data(varInited)
+ }
+ set data(-variable) $arg
+}
+
+#----------------------------------------------------------------------
+# User Commands
+#----------------------------------------------------------------------
+proc tixControl:incr {w {by 1}} {
+ upvar #0 $w data
+
+ if {$data(-state) != "disabled"} {
+ if {[catch {$data(w:entry) index sel.first}] == 0} {
+ $data(w:entry) select from end
+ $data(w:entry) select to end
+ }
+ # CYGNUS LOCAL - why set value before changing it?
+ #tixControl:SetValue $w [$data(w:entry) get] 0 1
+ tixControl:AdjustValue $w $by
+ }
+}
+
+proc tixControl:decr {w {by 1}} {
+ upvar #0 $w data
+
+ if {$data(-state) != "disabled"} {
+ if {[catch {$data(w:entry) index sel.first}] == 0} {
+ $data(w:entry) select from end
+ $data(w:entry) select to end
+ }
+ # CYGNUS LOCAL - why set value before changing it?
+ #tixControl:SetValue $w [$data(w:entry) get] 0 1
+ tixControl:AdjustValue $w [expr 0 - $by]
+ }
+}
+
+proc tixControl:invoke {w} {
+ upvar #0 $w data
+
+ tixControl:Invoke $w 0
+}
+
+proc tixControl:update {w} {
+ upvar #0 $w data
+
+ if [info exists data(edited)] {
+ tixControl:invoke $w
+ }
+}
+
+#----------------------------------------------------------------------
+# Internal Commands
+#----------------------------------------------------------------------
+
+# Change the value by a multiple of the data(-step)
+#
+proc tixControl:AdjustValue {w amount} {
+ upvar #0 $w data
+
+ if {$amount == 1 && $data(-incrcmd) != ""} {
+ set newValue [tixEvalCmdBinding $w $data(-incrcmd) "" $data(-value)]
+ } elseif {$amount == -1 && $data(-decrcmd) != ""} {
+ set newValue [tixEvalCmdBinding $w $data(-decrcmd) "" $data(-value)]
+ } else {
+ set newValue [expr $data(-value) + $amount * $data(-step)]
+ }
+
+ if {$data(-state) != "disabled"} {
+ tixControl:SetValue $w $newValue 0 1
+ }
+}
+
+proc tixControl:SetValue {w newvalue noUpdate forced} {
+ upvar #0 $w data
+
+ if {[$data(w:entry) selection present]} {
+ set oldSelection \
+ "[$data(w:entry) index sel.first] [$data(w:entry) index sel.last]"
+ }
+
+ set oldvalue $data(-value)
+ set oldCursor [$data(w:entry) index insert]
+ set changed 0
+
+
+ if {$data(-validatecmd) != ""} {
+ # Call the user supplied validation command
+ #
+ set data(-value) [tixEvalCmdBinding $w $data(-validatecmd) "" $newvalue]
+ } else {
+ # Here we only allow int or floating numbers
+ #
+ # If the new value is not a valid number, the old value will be
+ # kept due to the "catch" statements
+ #
+ if [catch {expr 0+$newvalue}] {
+ set newvalue 0
+ set data(-value) 0
+ set changed 1
+ }
+
+ if {$newvalue == ""} {
+ if {![tixGetBoolean -nocomplain $data(-allowempty)]} {
+ set newvalue 0
+ set changed 1
+ } else {
+ set data(-value) ""
+ }
+ }
+
+ if {$newvalue != ""} {
+ # Change this to a valid decimal string (trim leading 0)
+ #
+ regsub {^[0]*} $newvalue "" newvalue
+ if [catch {expr 0+$newvalue}] {
+ set newvalue 0
+ set data(-value) 0
+ set changed 1
+ }
+ if {$newvalue == ""} {
+ set newvalue 0
+ }
+
+ if [tixGetBoolean -nocomplain $data(-integer)] {
+ set data(-value) [tixGetInt -nocomplain $newvalue]
+ } else {
+ if [catch {set data(-value) [format "%d" $newvalue]}] {
+ if [catch {set data(-value) [expr $newvalue+0.0]}] {
+ set data(-value) $oldvalue
+ }
+ }
+ }
+
+ # Now perform boundary checking
+ #
+ if {$data(-max) != "" && $data(-value) > $data(-max)} {
+ set data(-value) $data(-max)
+ }
+ if {$data(-min) != "" && $data(-value) < $data(-min)} {
+ set data(-value) $data(-min)
+ }
+ }
+ }
+
+ if {! $noUpdate} {
+ tixVariable:UpdateVariable $w
+ }
+
+ if {$forced || "x$newvalue" != "x$data(-value)" || $changed} {
+ $data(w:entry) delete 0 end
+ $data(w:entry) insert 0 $data(-value)
+ $data(w:entry) icursor $oldCursor
+ if {[info exists oldSelection]} {
+ eval $data(w:entry) selection range $oldSelection
+ }
+ }
+
+ if {!$data(-disablecallback) && $data(-command) != ""} {
+ if {![info exists data(varInited)]} {
+ set bind(specs) ""
+ tixEvalCmdBinding $w $data(-command) bind $data(-value)
+ }
+ }
+}
+
+proc tixControl:Invoke {w forced} {
+ upvar #0 $w data
+
+ catch {
+ unset data(edited)
+ }
+
+ if {[catch {$data(w:entry) index sel.first}] == 0} {
+ # THIS ENTRY OWNS SELECTION --> TURN IT OFF
+ #
+ $data(w:entry) select from end
+ $data(w:entry) select to end
+ }
+
+ tixControl:SetValue $w [$data(w:entry) get] 0 $forced
+}
+
+#----------------------------------------------------------------------
+# The three functions StartRepeat, Repeat and StopRepeat make use of the
+# data(serial) variable to discard spurious repeats: If a button is clicked
+# repeatedly but is not hold down, the serial counter will increase
+# successively and all "after" time event handlers will be discarded
+#----------------------------------------------------------------------
+proc tixControl:StartRepeat {w amount} {
+ if {![winfo exists $w]} {
+ return
+ }
+
+ upvar #0 $w data
+
+ incr data(serial)
+ # CYGNUS LOCAL bug fix
+ # Need to set a local variable because otherwise the buttonrelease
+ # callback could change the value of data(serial) between now and
+ # the time the repeat is scheduled.
+ set serial $data(serial)
+
+ if {$data(-autorepeat)} {
+ tixControl:doAdjustValue $w $amount
+ after $data(-initwait) tixControl:Repeat $w $amount $serial
+ }
+
+ focus $data(w:entry)
+}
+
+proc tixControl:doAdjustValue {w amount} {
+
+ upvar #0 $w data
+
+ if {[catch {$data(w:entry) index sel.first}] == 0} {
+ $data(w:entry) select from end
+ $data(w:entry) select to end
+ }
+
+ if [info exists data(edited)] {
+ unset data(edited)
+ tixControl:SetValue $w [$data(w:entry) get] 0 1
+ }
+
+ tixControl:AdjustValue $w $amount
+}
+
+proc tixControl:Repeat {w amount serial} {
+ if {![winfo exists $w]} {
+ return
+ }
+ upvar #0 $w data
+
+ if {$serial == $data(serial)} {
+ tixControl:AdjustValue $w $amount
+
+ if {$data(-autorepeat)} {
+ after $data(-repeatrate) tixControl:Repeat $w $amount $serial
+ }
+ }
+}
+
+proc tixControl:StopRepeat {w amount} {
+ upvar #0 $w data
+
+ if {$data(-autorepeat) == "false" } {
+ tixControl:doAdjustValue $w $amount
+ }
+
+ incr data(serial)
+}
+
+proc tixControl:Destructor {w} {
+
+ tixVariable:DeleteVariable $w
+
+ # Chain this to the superclass
+ #
+ tixChainMethod $w Destructor
+}
+
+# ToDo: maybe should return -code break if the value is not good ...
+#
+proc tixControl:Tab {w detail} {
+ upvar #0 $w data
+
+ if {![info exists data(edited)]} {
+ return
+ } else {
+ unset data(edited)
+ }
+
+ tixControl:invoke $w
+}
+
+proc tixControl:Escape {w} {
+ upvar #0 $w data
+
+ $data(w:entry) delete 0 end
+ $data(w:entry) insert 0 $data(-value)
+}
+
+proc tixControl:KeyPress {w} {
+ upvar #0 $w data
+
+ if {$data(-selectmode) == "normal"} {
+ set data(edited) 0
+ return
+ } else {
+ # == "immediate"
+ after 1 tixControl:invoke $w
+ }
+}
diff --git a/tix/library/DefSchm.tcl b/tix/library/DefSchm.tcl
new file mode 100644
index 00000000000..843b14ddd9a
--- /dev/null
+++ b/tix/library/DefSchm.tcl
@@ -0,0 +1,86 @@
+# DefSchm.tcl --
+#
+# Implements the default color and font schemes for Tix.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc tixSetDefaultFontset {} {
+ global tixOption
+
+ set tixOption(font) -Adobe-Helvetica-Medium-R-Normal--*-120-*
+ set tixOption(bold_font) -Adobe-Helvetica-Bold-R-Normal--*-120-*
+ set tixOption(menu_font) -Adobe-Helvetica-Bold-R-Normal--*-120-*
+ set tixOption(italic_font) -Adobe-Helvetica-Bold-O-Normal--*-120-*
+ set tixOption(fixed_font) -*-courier-medium-r-*-*-14-*-*-*-*-*-*-*
+}
+
+proc tixSetDefaultScheme-Color {} {
+ global tixOption
+
+ set tixOption(bg) #d9d9d9
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) #c3c3c3
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) #a3a3a3
+ set tixOption(dark2_fg) black
+ set tixOption(inactive_bg) #a3a3a3
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) #ececec
+ set tixOption(light1_fg) white
+ set tixOption(light2_bg) #fcfcfc
+ set tixOption(light2_fg) white
+
+ set tixOption(active_bg) $tixOption(dark1_bg)
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray55
+
+ set tixOption(input1_bg) #d9d9d9
+ set tixOption(input2_bg) #d9d9d9
+ set tixOption(output1_bg) $tixOption(dark1_bg)
+ set tixOption(output2_bg) $tixOption(bg)
+
+ set tixOption(select_fg) black
+ set tixOption(select_bg) #c3c3c3
+
+ set tixOption(selector) #b03060
+}
+
+proc tixSetDefaultScheme-Mono {} {
+
+ global tixOption
+
+ set tixOption(bg) lightgray
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) gray70
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) gray60
+ set tixOption(dark2_fg) white
+ set tixOption(inactive_bg) lightgray
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) gray90
+ set tixOption(light1_fg) white
+ set tixOption(light2_bg) gray95
+ set tixOption(light2_fg) white
+
+ set tixOption(active_bg) gray90
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray55
+
+ set tixOption(input1_bg) $tixOption(light1_bg)
+ set tixOption(input2_bg) $tixOption(light1_bg)
+ set tixOption(output1_bg) $tixOption(light1_bg)
+ set tixOption(output2_bg) $tixOption(light1_bg)
+
+ set tixOption(select_fg) white
+ set tixOption(select_bg) black
+
+ set tixOption(selector) black
+}
diff --git a/tix/library/DialogS.tcl b/tix/library/DialogS.tcl
new file mode 100644
index 00000000000..024b4085ed6
--- /dev/null
+++ b/tix/library/DialogS.tcl
@@ -0,0 +1,169 @@
+# DialogS.tcl --
+#
+#
+# Implements the DialogShell widget. It tells the window
+# manager that it is a dialog window and should be treated specially.
+# The exact treatment depends on the treatment of the window
+# manager
+#
+# Copyright (c) 1994-1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixDialogShell {
+ -superclass tixShell
+ -classname TixDialogShell
+ -method {
+ popdown popup center
+ }
+ -flag {
+ -mapped -minheight -minwidth -parent -transient
+ }
+ -static {}
+ -configspec {
+ {-mapped mapped Mapped 0}
+ {-minwidth minWidth MinWidth 0}
+ {-minheight minHeight MinHeight 0}
+ {-transient transient Transient true}
+ {-parent parent Parent ""}
+ }
+}
+
+#----------------------------------------------------------------------
+# Construct widget
+#----------------------------------------------------------------------
+
+proc tixDialogShell:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ # Set the title of this shell appropriately
+ #
+ if {$data(-title) == ""} {
+ # dynamically sets the title
+ #
+ set data(-title) [winfo name $w]
+ }
+ wm title $w $data(-title)
+
+ # Set the parent of this dialog shell
+ #
+ if {$data(-parent) == ""} {
+ set data(-parent) [winfo parent $w]
+ }
+
+ # Set the minsize and maxsize of the thing
+ #
+ wm minsize $w $data(-minwidth) $data(-minheight)
+}
+
+# The next procedures manage the dialog boxes
+#
+proc tixDialogShell:popup {w {parent ""}} {
+ upvar #0 $w data
+
+ # First update to make sure the boxes are the right size
+ #
+ update idletask
+
+ # Then we set the position and update
+ #
+ tixDialogShell:center $w $parent
+
+ # and now make it visible. Viola! Centered over parent.
+ #
+ wm deiconify $w
+}
+
+# This procedure centers a dialog box over a window making sure that the
+# dialog box doesn't appear off the screen
+#
+# However, if the parent is smaller than this dialog, make this dialog
+# appear at parent(x,y) + (20,20)
+#
+proc tixDialogShell:center {w {parent ""}} {
+ upvar #0 $w data
+
+ # Tell the WM that we'll do this ourselves.
+ wm sizefrom $w user
+ wm positionfrom $w user
+
+ if {$parent == ""} {
+ set parent $data(-parent)
+ }
+ if [catch {set parent [winfo toplevel $parent]}] {
+ set parent "."
+ }
+
+ # Where is my parent and what are it's dimensions
+ #
+ if {$parent != ""} {
+ set pargeo [split [wm geometry $parent] "+x"]
+ set parentW [lindex $pargeo 0]
+ set parentH [lindex $pargeo 1]
+ set parx [lindex $pargeo 2]
+ set pary [lindex $pargeo 3]
+
+ if {[tixGetBoolean -nocomplain $data(-transient)]} {
+ wm transient $w $parent
+ }
+ } else {
+ set parentW [winfo screenwidth $w]
+ set parentH [winfo screenheight $w]
+ set parx 0
+ set pary 0
+ set parent [winfo parent $w]
+ }
+
+ # What are is the offset of the virtual window
+ set vrootx [winfo vrootx $parent]
+ set vrooty [winfo vrooty $parent]
+
+ # What are my dimensions ?
+ set dialogW [winfo reqwidth $w]
+ set dialogH [winfo reqheight $w]
+
+ if {$dialogW < [expr $parentW-30] || $dialogW < [expr $parentH-30]} {
+ set dialogx [expr $parx+($parentW-$dialogW)/2+$vrootx]
+ set dialogy [expr $pary+($parentH-$dialogH)/2+$vrooty]
+ } else {
+ # This dialog is too big. Place it at (parentx, parenty) + (20,20)
+ #
+ set dialogx [expr $parx+20+$vrootx]
+ set dialogy [expr $pary+20+$vrooty]
+ }
+
+ set maxx [expr "[winfo screenwidth $parent] - $dialogW"]
+ set maxy [expr "[winfo screenheight $parent] - $dialogH"]
+
+ # Make sure it doesn't go off screen
+ #
+ if {$dialogx < 0} {
+ set dialogx 0
+ } else {
+ if {$dialogx > $maxx} {
+ set dialogx $maxx
+ }
+ }
+ if {$dialogy < 0} {
+ set dialogy 0
+ } else {
+ if {$dialogy > $maxy} {
+ set dialogy $maxy
+ }
+ }
+
+ # set my new position (and dimensions)
+ #
+ if {[wm geometry $w] == "1x1+0+0"} {
+ wm geometry $w $dialogW\x$dialogH\+$dialogx\+$dialogy
+ }
+}
+
+proc tixDialogShell:popdown {w args} {
+ wm withdraw $w
+}
+
diff --git a/tix/library/DirBox.tcl b/tix/library/DirBox.tcl
new file mode 100644
index 00000000000..905fe99d205
--- /dev/null
+++ b/tix/library/DirBox.tcl
@@ -0,0 +1,220 @@
+# DirBox.tcl --
+#
+# Implements the tixDirSelectBox widget.
+#
+# - overrides the -browsecmd and -command options of the
+# HList subwidget
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixDirSelectBox {
+ -classname TixDirSelectBox
+ -superclass tixPrimitive
+ -method {
+ }
+ -flag {
+ -command -disablecallback -value
+ }
+ -configspec {
+ {-command command Command ""}
+ {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
+ {-label label Label "Directory:"}
+ {-value value Value ""}
+ }
+ -forcecall {
+ -value -label
+ }
+ -default {
+ {*combo*listbox.height 5}
+ {*combo.label.anchor w}
+ {*combo.labelSide top}
+ {*combo.hostory true}
+ {*combo.historyLimit 20}
+ }
+}
+
+proc tixDirSelectBox:InitWidgetRec {w} {
+ upvar #0 $w data
+ tixChainMethod $w InitWidgetRec
+}
+
+proc tixDirSelectBox:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+ set data(w:dircbx) [tixFileComboBox $w.dircbx]
+ set data(w:dirlist) [tixDirList $w.dirlist]
+
+ pack $data(w:dircbx) -side top -fill x -padx 4 -pady 2
+ pack $data(w:dirlist) -side top -fill both -expand yes -padx 4 -pady 2
+
+ if ![string comp $data(-value) ""] {
+ set data(-value) [tixFSPWD]
+ }
+}
+
+proc tixDirSelectBox:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ $data(w:dircbx) config -command "tixDirSelectBox:Cmd-DirCbx $w"
+ $data(w:dirlist) config -command "tixDirSelectBox:Cmd-DirList $w"\
+ -browsecmd "tixDirSelectBox:Browse-DirList $w"
+}
+
+#----------------------------------------------------------------------
+# Incoming event: User
+#----------------------------------------------------------------------
+
+# User activates the FileComboBox
+#
+#
+proc tixDirSelectBox:Cmd-DirCbx {w args} {
+ upvar #0 $w data
+
+ set fInfo [tixEvent value]
+ set path [lindex $fInfo 0]
+
+ if {![file exists $path]} {
+ tk_dialog .tix_error "" "Directory \"$path\" does not exist." \
+ error 0 Ok
+ $data(w:dircbx) config \
+ -text [tixFSDisplayName [tixFSNormDir $data(-value)]] \
+ -directory $data(-value)
+ return
+
+ #
+ # The following code is not used because directories cannot be created
+ # on Windows
+ #
+
+ # 1.1 Check for validity. The pathname cannot contain invalid chars
+ #
+ if ![tixFSIsValid $path] {
+ tk_dialog .tix_error "Error" \
+ "\"$path\" is not a valid directory name" \
+ error 0 Ok
+ $data(w:dircbx) config \
+ -text [tixFSDisplayName [tixFSNormDir $data(-value)]] \
+ -directory $data(-value)
+ return
+ }
+
+ # 1.2 Prompt for creation
+ #
+ set choice [tk_dialog .tix_error "" \
+ "Directory \"$path\" does not exist. Do you want to create it?" \
+ question 1 Yes No]
+ if {$choice == 1} {
+ $data(w:dircbx) config \
+ -text [tixFSDisplayName [tixFSNormDir $data(-value)]] \
+ -directory $data(-value)
+ return
+ } else {
+ if ![tixFSCreateDirs $path] {
+ tk_dialog .tix_error "Error" \
+ "Cannot create directory \"$path\". Permission denied" \
+ error 0 Ok
+ $data(w:dircbx) config \
+ -text [tixFSDisplayName [tixFSNormDir $data(-value)]] \
+ -directory $data(-value)
+ return
+ }
+ tixDirSelectBox:SetValue $w $path 1 1
+ }
+ } elseif {![file isdirectory $path]} {
+ # 2.1: Can't choose a non-directory file
+ #
+ tk_dialog .tix_error "Error" \
+ "\"$path\" is not a directory." \
+ error 0 Ok
+ $data(w:dircbx) config \
+ -text [tixFSDisplayName [tixFSNormDir $data(-value)]] \
+ -directory $data(-value)
+ return
+ } else {
+ # OK. It is an existing directory
+ #
+ tixDirSelectBox:SetValue $w $path 1 1
+ }
+}
+
+# User activates the dir list
+#
+#
+proc tixDirSelectBox:Cmd-DirList {w args} {
+ upvar #0 $w data
+
+ set dir $data(-value)
+ catch {
+ set dir [tixEvent flag V]
+ }
+ set dir [tixFSNormDir $dir]
+ tixDirSelectBox:SetValue $w $dir 0 0
+}
+
+# User browses the dir list
+#
+#
+proc tixDirSelectBox:Browse-DirList {w args} {
+ upvar #0 $w data
+
+ set dir $data(-value)
+ catch {
+ set dir [tixEvent flag V]
+ }
+ set dir [tixFSNormDir $dir]
+ tixDirSelectBox:SetValue $w $dir 0 0
+}
+
+#----------------------------------------------------------------------
+# Incoming event: Application
+#----------------------------------------------------------------------
+proc tixDirSelectBox:config-value {w value} {
+ upvar #0 $w data
+ set value [tixFSNormDir $value]
+
+ tixDirSelectBox:SetValue $w $value 1 1
+ return $value
+}
+
+proc tixDirSelectBox:config-label {w value} {
+ upvar #0 $w data
+
+ $data(w:dircbx) subwidget combo config -label $value
+}
+
+#----------------------------------------------------------------------
+#
+# Internal functions
+#
+#----------------------------------------------------------------------
+
+# Arguments:
+# callback:Bool Should we invoke the the -command.
+# setlist:Bool Should we set the -value of the DirList subwidget.
+#
+proc tixDirSelectBox:SetValue {w dir callback setlist} {
+ upvar #0 $w data
+
+ set data(-value) $dir
+ $data(w:dircbx) config -text [tixFSDisplayName $dir] \
+ -directory [tixFSDisplayName $dir]
+ if {$setlist && [file isdirectory $dir]} {
+ tixSetSilent $data(w:dirlist) $dir
+ }
+
+ if {$callback} {
+ if {!$data(-disablecallback) && ![tixStrEq $data(-command) ""]} {
+ set bind(specs) {%V}
+ set bind(%V) $data(-value)
+
+ tixEvalCmdBinding $w $data(-command) bind $data(-value)
+ }
+ }
+}
diff --git a/tix/library/DirDlg.tcl b/tix/library/DirDlg.tcl
new file mode 100644
index 00000000000..1c6721df094
--- /dev/null
+++ b/tix/library/DirDlg.tcl
@@ -0,0 +1,90 @@
+# DirDlg.tcl --
+#
+# Implements the Directory Selection Dialog widget.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixDirSelectDialog {
+ -classname TixDirSelectDialog
+ -superclass tixDialogShell
+ -method {}
+ -flag {
+ -command
+ }
+ -configspec {
+ {-command command Command ""}
+ {-title title Title "Select A Directory"}
+ }
+
+ -default {
+ {*ok.text "OK"}
+ {*ok.underline 0}
+ {*ok.width 6}
+ {*cancel.text "Cancel"}
+ {*cancel.underline 0}
+ {*cancel.width 6}
+ {*dirbox.borderWidth 1}
+ {*dirbox.relief raised}
+ }
+}
+
+proc tixDirSelectDialog:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ # the buttons
+ frame $w.f -relief raised -bd 1
+ set data(w:ok) [button $w.f.ok -command \
+ "tixDirSelectDialog:OK $w"]
+ set data(w:cancel) [button $w.f.cancel -command \
+ "tixDirSelectDialog:Cancel $w"]
+
+ pack $data(w:ok) $data(w:cancel) -side left -expand yes -padx 10 -pady 8
+ pack $w.f -side bottom -fill x
+ # the dir select box
+ set data(w:dirbox) [tixDirSelectBox $w.dirbox \
+ -command "tixDirSelectDialog:DirBoxCmd $w"]
+ pack $data(w:dirbox) -expand yes -fill both
+}
+
+proc tixDirSelectDialog:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ bind $w <Alt-Key-d> "focus [$data(w:dirbox) subwidget dircbx]"
+}
+
+proc tixDirSelectDialog:OK {w} {
+ upvar #0 $w data
+
+ wm withdraw $w
+ $data(w:dirbox) subwidget dircbx invoke
+}
+
+proc tixDirSelectDialog:DirBoxCmd {w args} {
+ upvar #0 $w data
+
+ set value [tixEvent flag V]
+ wm withdraw $w
+ tixDirSelectDialog:CallCmd $w $value
+}
+
+proc tixDirSelectDialog:CallCmd {w value} {
+ upvar #0 $w data
+
+ if {$data(-command) != ""} {
+ set bind(specs) "%V"
+ set bind(%V) $value
+ tixEvalCmdBinding $w $data(-command) bind $value
+ }
+}
+
+proc tixDirSelectDialog:Cancel {w} {
+ wm withdraw $w
+}
diff --git a/tix/library/DirList.tcl b/tix/library/DirList.tcl
new file mode 100644
index 00000000000..2d96f4d15a3
--- /dev/null
+++ b/tix/library/DirList.tcl
@@ -0,0 +1,286 @@
+# DirList.tcl --
+#
+# Implements the tixDirList widget.
+#
+# - overrides the -browsecmd and -command options of the
+# HList subwidget
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixDirList {
+ -classname TixDirList
+ -superclass tixScrolledHList
+ -method {
+ chdir
+ }
+ -flag {
+ -browsecmd -command -dircmd -disablecallback
+ -root -rootname -showhidden -value
+ }
+ -configspec {
+ {-browsecmd browseCmd BrowseCmd ""}
+ {-command command Command ""}
+ {-dircmd dirCmd DirCmd ""}
+ {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
+ {-root root Root ""}
+ {-rootname rootName RootName ""}
+ {-showhidden showHidden ShowHidden 0 tixVerifyBoolean}
+ {-value value Value ""}
+ }
+ -default {
+ {.scrollbar auto}
+ {*borderWidth 1}
+ {*hlist.background #c3c3c3}
+ {*hlist.indent 7}
+ {*hlist.relief sunken}
+ {*hlist.height 10}
+ {*hlist.width 20}
+ {*hlist.padX 2}
+ {*hlist.padY 0}
+ {*hlist.wideSelection 0}
+ {*hlist.drawBranch 0}
+ {*hlist.highlightBackground #d9d9d9}
+ {*hlist.itemType imagetext}
+ {*hlist.takeFocus 1}
+ }
+ -forcecall {
+ -value
+ }
+}
+
+# Important data members:
+#
+# data(vpath)
+# The currently selected vpath. This internal variable is useful on
+# the Win95 platform, where an directory may correspond to more than
+# one node in the hierarchy. For example, C:\Windows\Desktop\Foo
+# can appead as "Desktop\Foo" and
+# "Desktop\My Computer\C:\Windows\Desktop\Foo". This variable tells us
+# which icon should we show given the same DOS pathname.
+#
+
+proc tixDirList:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+}
+
+proc tixDirList:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ $data(w:hlist) config \
+ -separator [tixFSSep] \
+ -selectmode "single"
+
+ # We must creat an extra copy of these images to avoid flashes on
+ # the screen when user changes directory
+ #
+# set data(images) [image create compound -window $data(w:hlist)]
+# $data(images) add image -image [tix getimage act_fold]
+# $data(images) add image -image [tix getimage folder]
+# $data(images) add image -image [tix getimage openfold]
+}
+
+proc tixDirList:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ $data(w:hlist) config \
+ -browsecmd "tixDirList:Browse $w" \
+ -command "tixDirList:Command $w"
+
+ if [tixStrEq $data(-value) ""] {
+ set data(-value) [tixFSPWD]
+ }
+ if [catch {
+ set data(vpath) [tixFSVPath [tixFSNormDir $data(-value)]]
+ }] {
+ set data(vpath) [tixFSVPath [tixFSNormDir [tixFSPWD]]]
+ }
+}
+
+#----------------------------------------------------------------------
+# Incoming-Events
+#----------------------------------------------------------------------
+proc tixDirList:Browse {w args} {
+ upvar #0 $w data
+
+ uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
+ set vpath [tixEvent flag V]
+ set value [$data(w:hlist) info data $vpath]
+
+ tixDirList:HighLight $w $vpath
+
+ set data(vpath) $vpath
+ set data(-value) $value
+
+ tixDirList:CallBrowseCmd $w $data(-value)
+}
+
+proc tixDirList:Command {w args} {
+ upvar #0 $w data
+
+ set vpath [tixEvent value]
+ set value [$data(w:hlist) info data $vpath]
+ set data(-value) $value
+
+ tixDirList:LoadDir $w [tixFSNormDir $value] $vpath
+ tixDirList:HighLight $w $vpath
+
+ set data(vpath) $vpath
+ tixDirList:CallCommand $w $data(-value)
+}
+
+#----------------------------------------------------------------------
+# Outgoing-Events
+#----------------------------------------------------------------------
+
+proc tixDirList:CallBrowseCmd {w value} {
+ upvar #0 $w data
+
+ if {$data(-browsecmd) != ""} {
+ set bind(specs) "%V"
+ set bind(%V) $value
+ tixEvalCmdBinding $w $data(-browsecmd) bind $value
+ }
+}
+
+proc tixDirList:CallCommand {w value} {
+ upvar #0 $w data
+
+ if {$data(-command) != "" && !$data(-disablecallback)} {
+ set bind(specs) "%V"
+ set bind(%V) $value
+ tixEvalCmdBinding $w $data(-command) bind $value
+ }
+}
+
+#----------------------------------------------------------------------
+# Directory loading
+#----------------------------------------------------------------------
+proc tixDirList:LoadDir {w {npath ""} {vpath ""}} {
+ upvar #0 $w data
+
+ tixBusy $w on $data(w:hlist)
+
+ $data(w:hlist) delete all
+
+ if {![string compare $npath ""]} {
+ set npath [tixFSNormDir $data(-value)]
+ set vpath [tixFSVPath $npath]
+ }
+
+ tixDirList:ListHierachy $w $npath $vpath
+ tixDirList:ListSubDirs $w $npath $vpath
+
+ tixWidgetDoWhenIdle tixBusy $w off $data(w:hlist)
+}
+
+proc tixDirList:ListHierachy {w dir vpath} {
+ upvar #0 $w data
+ uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
+
+ foreach p [tixFSSplit $vpath] {
+ set vpath [lindex $p 0]
+ set text [lindex $p 1]
+ set path [lindex $p 2]
+
+ $data(w:hlist) add $vpath -text $text -data $path \
+ -image [tix getimage openfold]
+ }
+}
+
+proc tixDirList:ListSubDirs {w dir vpath} {
+ upvar #0 $w data
+ uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
+
+ $data(w:hlist) entryconfig $vpath \
+ -image [tix getimage act_fold]
+
+ foreach ent [tixFSListDir $vpath 1 0 0 $data(-showhidden)] {
+ set vp [lindex $ent 0]
+ set name [lindex $ent 1]
+ set path [lindex $ent 2]
+
+ $data(w:hlist) add $vp -text $name -data $path \
+ -image [tix getimage folder]
+ }
+}
+
+proc tixDirList:SetValue {w npath vpath {flag ""}} {
+ upvar #0 $w data
+
+ if {![string compare $flag reload] ||
+ ![$data(w:hlist) info exists $vpath]} {
+ tixDirList:LoadDir $w $npath $vpath
+ }
+
+ tixDirList:HighLight $w $vpath
+
+ set data(-value) [tixFSDisplayName $npath]
+ set data(vpath) $vpath
+ tixDirList:CallCommand $w $data(-value)
+}
+
+proc tixDirList:HighLight {w vpath} {
+ upvar #0 $w data
+
+ if {![tixStrEq $data(vpath) $vpath]} {
+ set old $data(vpath)
+
+ if [$data(w:hlist) info exists $old] {
+ # Un-highlight the originally selected entry by changing its
+ # folder image
+
+ if {[$data(w:hlist) info children $old] == ""} {
+ $data(w:hlist) entryconfig $old\
+ -image [tix getimage folder]
+ } else {
+ $data(w:hlist) entryconfig $old\
+ -image [tix getimage openfold]
+ }
+ }
+ }
+
+ # Highlight the newly selected entry
+ #
+ $data(w:hlist) entryconfig $vpath \
+ -image [tix getimage act_fold]
+ $data(w:hlist) anchor set $vpath
+ $data(w:hlist) select clear
+ $data(w:hlist) select set $vpath
+ $data(w:hlist) see $vpath
+}
+
+#----------------------------------------------------------------------
+# Config options
+#----------------------------------------------------------------------
+proc tixDirList:config-value {w value} {
+ upvar #0 $w data
+
+ tixDirList:chdir $w $value
+ return $data(-value)
+}
+
+proc tixDirList:config-showhidden {w value} {
+ upvar #0 $w data
+
+ tixWidgetDoWhenIdle tixDirList:LoadDir $w
+}
+
+#----------------------------------------------------------------------
+# Public methods
+#----------------------------------------------------------------------
+proc tixDirList:chdir {w value} {
+ upvar #0 $w data
+
+ set path [tixFSNormDir $value]
+ tixDirList:SetValue $w $path [tixFSVPath $path]
+}
diff --git a/tix/library/DirTree.tcl b/tix/library/DirTree.tcl
new file mode 100644
index 00000000000..a625fc0b252
--- /dev/null
+++ b/tix/library/DirTree.tcl
@@ -0,0 +1,400 @@
+# DirTree.tcl --
+#
+# Implements directory tree for Unix file systems
+#
+# What the indicators mean:
+#
+# (+): There are some subdirectories in this directory which are not
+# currently visible.
+# (-): This directory has some subdirectories and they are all visible
+#
+# none: The dir has no subdirectori(es).
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixDirTree {
+ -classname TixDirTree
+ -superclass tixVTree
+ -method {
+ activate chdir refresh
+ }
+ -flag {
+ -browsecmd -command -directory -disablecallback -showhidden -value
+ }
+ -configspec {
+ {-browsecmd browseCmd BrowseCmd ""}
+ {-command command Command ""}
+ {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
+ {-showhidden showHidden ShowHidden 0 tixVerifyBoolean}
+ {-value value Value ""}
+ }
+ -alias {
+ {-directory -value}
+ }
+ -default {
+ {.scrollbar auto}
+ {*Scrollbar.background #d9d9d9}
+ {*Scrollbar.relief sunken}
+ {*Scrollbar.takeFocus 0}
+ {*Scrollbar.troughColor #c3c3c3}
+ {*Scrollbar.width 15}
+ {*borderWidth 1}
+ {*hlist.indicator 1}
+ {*hlist.background #c3c3c3}
+ {*hlist.drawBranch 1}
+ {*hlist.height 10}
+ {*hlist.highlightBackground #d9d9d9}
+ {*hlist.indent 20}
+ {*hlist.itemType imagetext}
+ {*hlist.padX 3}
+ {*hlist.padY 0}
+ {*hlist.relief sunken}
+ {*hlist.takeFocus 1}
+ {*hlist.wideSelection 0}
+ {*hlist.width 20}
+ }
+}
+
+proc tixDirTree:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+
+ if {$data(-value) == ""} {
+ global env
+ if {[info exists env(PWD)]} {
+ set data(-value) $env(PWD)
+ } else {
+ set data(-value) [pwd]
+ }
+ }
+
+ tixDirTree:SetDir $w [tixFileIntName $data(-value)]
+}
+
+proc tixDirTree:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+ tixDoWhenMapped $w "tixDirTree:StartUp $w"
+
+ $data(w:hlist) config \
+ -separator [tixDirSep] \
+ -selectmode "single" -drawbranch 1
+
+ # We must creat an extra copy of these images to avoid flashes on
+ # the screen when user changes directory
+ #
+ set data(images) [image create compound -window $data(w:hlist)]
+ $data(images) add image -image [tix getimage act_fold]
+ $data(images) add image -image [tix getimage folder]
+ $data(images) add image -image [tix getimage openfold]
+}
+
+proc tixDirTree:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+# %% do I still need this?
+# bind $data(w:hlist) <3> "tixDirTree:DeleteSib $w %x %y"
+}
+
+# This procedure is supposed to "trim" the directory tree view to
+# just the current directory and its ancestors.
+#
+#proc tixDirTree:DeleteSib {w x y} {
+# upvar #0 $w data
+#
+# set ent [$data(w:hlist) nearest $y]
+#
+# if {$ent != ""} {
+# $data(w:hlist) anchor set $ent
+#
+# for {set e $ent} {$e != "/"} {set e [$data(w:hlist) info parent $e]} {
+# $data(w:hlist) delete siblings $e
+# }
+# tixDirTree:Browse $w $ent
+# }
+#}
+
+# %% This functions needs to be optimized
+#
+#
+proc tixDirTree:HasSubDir {w dir} {
+ upvar #0 $w data
+
+ if {[tixListDir $dir 1 0 0 $data(-showhidden)] != ""} {
+ return 1
+ } else {
+ return 0
+ }
+}
+
+
+# Add one dir into the parent directory, sorted alphabetically
+#
+proc tixDirTree:AddToList {w dir parent name image} {
+ upvar #0 $w data
+
+ set added 0
+ foreach sib [$data(w:hlist) info children $parent] {
+ if {[string compare $dir $sib] < 0} {
+ $data(w:hlist) add $dir -before $sib -text $name -image $image
+ set added 1
+ break
+ }
+ }
+ if !$added {
+ $data(w:hlist) add $dir -text $name -image $image
+ }
+
+ if [tixDirTree:HasSubDir $w $dir] {
+ tixVTree:SetMode $w $dir open
+ }
+}
+
+# Add $dir and all ancestors of $dir into the HList widget
+#
+#
+proc tixDirTree:AddAncestors {w dir} {
+ upvar #0 $w data
+ uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
+
+ set path ""
+ set parent ""
+ foreach name [tixFileSplit $dir] {
+ set path [tixSubFolder $path $name]
+ if {![$data(w:hlist) info exists $path]} {
+ tixDirTree:AddToList $w $path $parent [tixFileDisplayName $path] \
+ [tix getimage openfold]
+ }
+ set parent $path
+ }
+}
+
+# Add all the sub directories of $dir into the HList widget
+#
+#
+proc tixDirTree:ListDirs {w dir} {
+ upvar #0 $w data
+ uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
+
+ tixBusy $w on $data(w:hlist)
+
+ foreach name [tixListDir $dir 1 0 0 $data(-showhidden)] {
+ set subdir [tixSubFolder $dir $name]
+ if {![$data(w:hlist) info exists $subdir]} {
+ tixDirTree:AddToList $w $subdir $dir [tixFileDisplayName $subdir] \
+ [tix getimage folder]
+ }
+ }
+
+ tixWidgetDoWhenIdle tixBusy $w off $data(w:hlist)
+}
+
+proc tixDirTree:LoadDir {w dir {mode toggle}} {
+ if {![winfo exists $w]} {
+ return
+ }
+
+ upvar #0 $w data
+ uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
+
+ # Add the directory and set it to the active directory
+ #
+ if ![$data(w:hlist) info exists $dir] {
+ tixDirTree:AddAncestors $w $dir
+ }
+ $data(w:hlist) entryconfig $dir -image [tix getimage act_fold]
+
+ if {$mode == "toggle"} {
+ if {[$data(w:hlist) info children $dir] == ""} {
+ set mode expand
+ } else {
+ set mode flatten
+ }
+ }
+
+ if {$mode == "expand"} {
+ tixDirTree:ListDirs $w $dir
+ if {[$data(w:hlist) info children $dir] == ""} {
+ tixVTree:SetMode $w $dir none
+ } else {
+ tixVTree:SetMode $w $dir close
+ }
+ } else {
+ $data(w:hlist) delete offsprings $dir
+ tixVTree:SetMode $w $dir open
+ }
+}
+
+proc tixDirTree:ToggleDir {w value mode} {
+ upvar #0 $w data
+
+ tixDirTree:LoadDir $w $value $mode
+ tixDirTree:CallCommand $w
+}
+
+proc tixDirTree:CallCommand {w} {
+ upvar #0 $w data
+
+ if {$data(-command) != "" && !$data(-disablecallback)} {
+ set bind(specs) {%V}
+ set bind(%V) $data(-value)
+
+ tixEvalCmdBinding $w $data(-command) bind $data(-value)
+ }
+}
+
+proc tixDirTree:CallBrowseCmd {w ent} {
+ upvar #0 $w data
+
+ if {$data(-browsecmd) != "" && !$data(-disablecallback)} {
+ set bind(specs) {%V}
+ set bind(%V) $data(-value)
+
+ tixEvalCmdBinding $w $data(-browsecmd) bind [list $data(-value)]
+ }
+}
+
+proc tixDirTree:StartUp {w} {
+ if {![winfo exists $w]} {
+ return
+ }
+
+ upvar #0 $w data
+
+ tixDirTree:LoadDir $w $data(i-directory)
+}
+
+proc tixDirTree:ChangeDir {w value {forced 0}} {
+ upvar #0 $w data
+
+ if {!$forced && $data(i-directory) == $value} {
+ return
+ }
+ uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
+
+ if {!$forced && [$data(w:hlist) info exists $value]} {
+ # Set the old directory to "non active"
+ #
+ if [$data(w:hlist) info exists $data(i-directory)] {
+ $data(w:hlist) entryconfig $data(i-directory) \
+ -image [tix getimage folder]
+ }
+
+ $data(w:hlist) entryconfig $value \
+ -image [tix getimage act_fold]
+
+ } else {
+ if {$forced} {
+ if {[$data(w:hlist) info children $value] == ""} {
+ set mode flatten
+ } else {
+ set mode expand
+ }
+ } else {
+ set mode toggle
+ }
+ tixDirTree:LoadDir $w $value $mode
+ tixDirTree:CallCommand $w
+ }
+ tixDirTree:SetDir $w $value
+}
+
+
+proc tixDirTree:SetDir {w intName} {
+ upvar #0 $w data
+
+ set data(i-directory) $intName
+ set data(-value) [tixNativeName $intName]
+}
+
+#----------------------------------------------------------------------
+#
+# Virtual Methods
+#
+#----------------------------------------------------------------------
+proc tixDirTree:OpenCmd {w ent} {
+ tixDirTree:ToggleDir $w $ent expand
+ tixDirTree:ChangeDir $w $ent
+ tixDirTree:CallBrowseCmd $w $ent
+}
+
+proc tixDirTree:CloseCmd {w ent} {
+ tixDirTree:ToggleDir $w $ent flatten
+ tixDirTree:ChangeDir $w $ent
+ tixDirTree:CallBrowseCmd $w $ent
+}
+
+proc tixDirTree:Command {w B} {
+ upvar #0 $w data
+ upvar $B bind
+
+ set ent [tixEvent flag V]
+ tixChainMethod $w Command $B
+
+ if {$data(-command) != ""} {
+ tixEvalCmdBinding $w $data(-command) bind $ent
+ }
+}
+
+# This is a virtual method
+#
+proc tixDirTree:BrowseCmd {w B} {
+ upvar #0 $w data
+ upvar $B bind
+
+ set ent [tixEvent flag V]
+
+# if {[$data(w:hlist) indicator exist $ent] &&
+# [$data(w:hlist) info children $ent] == ""} {
+#
+# tixVTree:Activate $w $ent open
+# }
+
+ if {[string index $ent 0] != "/"} {
+ # This is a hack because %V may have been modified by
+ # callbrowsecmd ....
+ set ent [tixFileIntName $ent]
+ }
+ tixDirTree:ChangeDir $w $ent
+ tixDirTree:CallBrowseCmd $w $ent
+}
+
+#----------------------------------------------------------------------
+#
+# Public Methods
+#
+#----------------------------------------------------------------------
+proc tixDirTree:chdir {w value} {
+ tixDirTree:ChangeDir $w [tixFileIntName $value]
+}
+
+proc tixDirTree:refresh {w {dir ""}} {
+ upvar #0 $w data
+
+ if {$dir == ""} {
+ set dir $data(-value)
+ }
+
+ tixDirTree:ChangeDir $w [tixFileIntName $dir] 1
+
+
+ # Delete any stale directories that no longer exist
+ #
+ foreach sub [$data(w:hlist) info children [tixFileIntName $dir]] {
+ if {![file exists [tixNativeName $sub]]} {
+ $data(w:hlist) delete entry $sub
+ }
+ }
+}
+
+proc tixDirTree:config-directory {w value} {
+ tixDirTree:ChangeDir $w [tixFileIntName $value]
+}
diff --git a/tix/library/DragDrop.tcl b/tix/library/DragDrop.tcl
new file mode 100644
index 00000000000..633fd2cbd69
--- /dev/null
+++ b/tix/library/DragDrop.tcl
@@ -0,0 +1,161 @@
+# DragDrop.tcl ---
+#
+# Implements drag+drop for Tix widgets.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixClass tixDragDropContext {
+ -superclass {}
+ -classname TixDragDropContext
+ -method {
+ cget configure drag drop set startdrag
+ }
+ -flag {
+ -command -source
+ }
+ -configspec {
+ {-command ""}
+ {-source ""}
+ }
+}
+
+proc tixDragDropContext:Constructor {w} {
+ upvar #0 $w data
+}
+
+#----------------------------------------------------------------------
+# Private methods
+#
+#----------------------------------------------------------------------
+proc tixDragDropContext:CallCommand {w target command X Y} {
+ upvar #0 $w data
+
+ set x [expr $X-[winfo rootx $target]]
+ set y [expr $Y-[winfo rooty $target]]
+
+ regsub %x $command $x command
+ regsub %y $command $y command
+ regsub %X $command $X command
+ regsub %Y $command $Y command
+ regsub %W $command $target command
+ regsub %S $command [list $data(-command)] command
+
+ eval $command
+}
+
+proc tixDragDropContext:Send {w target event X Y} {
+ upvar #0 $w data
+ global tixDrop
+
+ foreach tag [tixDropBindTags $target] {
+ if [info exists tixDrop($tag,$event)] {
+ tixDragDropContext:CallCommand $w $target \
+ $tixDrop($tag,$event) $X $Y
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+# set --
+#
+# Set the "small data" of the type supported by the source widget
+#----------------------------------------------------------------------
+
+proc tixDragDropContext:set {w type data} {
+
+}
+
+#----------------------------------------------------------------------
+# startdrag --
+#
+# Start the dragging action
+#----------------------------------------------------------------------
+proc tixDragDropContext:startdrag {w x y} {
+ upvar #0 $w data
+
+ set data(oldTarget) ""
+
+ $data(-source) config -cursor "[tix getbitmap drop] black"
+ tixDragDropContext:drag $w $x $y
+}
+
+#----------------------------------------------------------------------
+# drag --
+#
+# Continue the dragging action
+#----------------------------------------------------------------------
+proc tixDragDropContext:drag {w X Y} {
+ upvar #0 $w data
+ global tixDrop
+
+ set target [winfo containing $X $Y]
+
+ if {$target != $data(oldTarget)} {
+ if {$data(oldTarget) != ""} {
+ tixDragDropContext:Send $w $data(oldTarget) <Out> $X $Y
+ }
+ if {$target != ""} {
+ tixDragDropContext:Send $w $target <In> $X $Y
+ }
+ set data(oldTarget) $target
+ }
+ if {$target != ""} {
+ tixDragDropContext:Send $w $target <Over> $X $Y
+ }
+}
+
+proc tixDragDropContext:drop {w X Y} {
+ upvar #0 $w data
+ global tixDrop
+
+ set target [winfo containing $X $Y]
+ if {$target != ""} {
+ tixDragDropContext:Send $w $target <Drop> $X $Y
+ }
+
+ if {$data(-source) != ""} {
+ $data(-source) config -cursor ""
+ }
+ set data(-source) ""
+}
+
+#----------------------------------------------------------------------
+# Public Procedures -- This is NOT a member of the tixDragDropContext
+# class!
+#
+# parameters :
+# $w: who wants to start dragging? (currently ignored)
+#----------------------------------------------------------------------
+proc tixGetDragDropContext {w} {
+ global tixDD
+ if {[info exists tixDD]} {
+ return tixDD
+ }
+
+ return [tixDragDropContext tixDD]
+}
+
+proc tixDropBind {w event command} {
+ global tixDrop
+
+ set tixDrop($w) 1
+ set tixDrop($w,$event) $command
+}
+
+proc tixDropBindTags {w args} {
+ global tixDropTags
+
+ if {$args == ""} {
+ if [info exists tixDropTags($w)] {
+ return $tixDropTags($w)
+ } else {
+ return [list [winfo class $w] $w]
+ }
+ } else {
+ set tixDropTags($w) $args
+ }
+}
diff --git a/tix/library/DtlList.tcl b/tix/library/DtlList.tcl
new file mode 100644
index 00000000000..c6d234277c5
--- /dev/null
+++ b/tix/library/DtlList.tcl
@@ -0,0 +1,44 @@
+# DtlList.tcl --
+#
+# This file implements DetailList widgets
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixDetailList {
+ -classname TixDetailList
+ -superclass tixScrolledGrid
+ -method {
+ }
+ -flag {
+ -hdrbackground
+ }
+ -configspec {
+ {-hdrbackground hdrBackground HdrBackground #606060}
+ }
+ -alias {
+ {-hdrbg -hdrbackground}
+ }
+ -default {
+ {*grid.topMargin 1}
+ {*grid.leftMargin 0}
+ }
+}
+
+
+proc tixDetailList:FormatCmd {w area x1 y1 x2 y2} {
+ upvar #0 $w data
+
+ case $area {
+ main {
+ }
+ default {
+ $data(w:grid) format border $x1 $y1 $x2 $y2 \
+ -filled 1 \
+ -relief raised -bd 1 -bg $data(-hdrbackground)
+ }
+ }
+}
diff --git a/tix/library/EFileBox.tcl b/tix/library/EFileBox.tcl
new file mode 100644
index 00000000000..00dd2643886
--- /dev/null
+++ b/tix/library/EFileBox.tcl
@@ -0,0 +1,452 @@
+# EFileBox.tcl --
+#
+# Implements the Extended File Selection Box widget.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+#
+# ToDo
+# (1) If user has entered an invalid directory, give an error dialog
+#
+
+tixWidgetClass tixExFileSelectBox {
+ -classname TixExFileSelectBox
+ -superclass tixPrimitive
+ -method {
+ filter invoke
+ }
+ -flag {
+ -browsecmd -command -dialog -dir -dircmd -directory
+ -disablecallback -filetypes -pattern -selection -showhidden -value
+ }
+ -forcecall {
+ -filetypes
+ }
+ -configspec {
+ {-browsecmd browseCmd BrowseCmd ""}
+ {-command command Command ""}
+ {-dialog dialog Dialog ""}
+ {-dircmd dirCmd DirCmd ""}
+ {-directory directory Directory ""}
+ {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
+ {-filetypes fileTypes FileTypes ""}
+ {-pattern pattern Pattern *}
+ {-showhidden showHidden ShowHidden 0 tixVerifyBoolean}
+ {-value value Value ""}
+ }
+ -alias {
+ {-dir -directory}
+ {-selection -value}
+ }
+
+ -default {
+ {*dir.label {Directories:}}
+ {*dir.editable true}
+ {*dir.history true}
+ {*dir*listbox.height 5}
+ {*file.label Files:}
+ {*file.editable true}
+ {*file.history false}
+ {*file*listbox.height 5}
+ {*types.label {List Files of Type:}}
+ {*types*listbox.height 3}
+ {*TixComboBox.labelSide top}
+ {*TixComboBox*Label.anchor w}
+ {*dir.label.underline 0}
+ {*file.label.underline 0}
+ {*types.label.underline 14}
+ {*TixComboBox.anchor e}
+ {*TixHList.height 7}
+ {*filelist*listbox.height 7}
+ {*hidden.wrapLength 3c}
+ {*hidden.justify left}
+ }
+}
+
+proc tixExFileSelectBox:InitWidgetRec {w} {
+ upvar #0 $w data
+ global env
+
+ tixChainMethod $w InitWidgetRec
+
+ if {$data(-directory) == ""} {
+ global env
+
+ if {[info exists env(PWD)]} {
+ set data(-directory) $env(PWD)
+ } else {
+ set data(-directory) [pwd]
+ }
+ }
+ set data(oldDir) ""
+ set data(flag) 0
+}
+
+
+#----------------------------------------------------------------------
+# Construct widget
+#----------------------------------------------------------------------
+proc tixExFileSelectBox:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ # listbox frame
+ set lf [frame $w.lf]
+
+ # The pane that contains the two listboxes
+ #
+ set pane [tixPanedWindow $lf.pane -orientation horizontal]
+ set fpane [$pane add 1 -size 160]
+ set dpane [$pane add 2 -size 160]
+
+ $dpane config -relief flat
+ $fpane config -relief flat
+
+ # The File List Pane
+ #
+ set data(w:file) [tixComboBox $fpane.file\
+ -command "tixExFileSelectBox:Cmd-FileCombo $w"\
+ -prunehistory true \
+ -options { \
+ label.anchor w \
+ }]
+ set data(w:filelist) [tixScrolledListBox $fpane.filelist \
+ -command "tixExFileSelectBox:Cmd-FileList $w 1"\
+ -browsecmd "tixExFileSelectBox:Cmd-FileList $w 0"]
+ pack $data(w:file) -padx 8 -pady 4 -side top -fill x
+ pack $data(w:filelist) -padx 8 -pady 4 -side top -fill both -expand yes
+
+ # The Directory Pane
+ #
+ set data(w:dir) [tixComboBox $dpane.dir \
+ -command "tixExFileSelectBox:Cmd-DirCombo $w"\
+ -prunehistory true \
+ -options { \
+ label.anchor w \
+ }]
+ set data(w:dirlist) [tixDirList $dpane.dirlist \
+ -command "tixExFileSelectBox:Cmd-DirList $w"\
+ -browsecmd "tixExFileSelectBox:Browse-DirList $w"]
+ pack $data(w:dir) -padx 8 -pady 4 -side top -fill x
+ pack $data(w:dirlist) -padx 8 -pady 4 -side top -fill both -expand yes
+
+ # The file types listbox
+ #
+ set data(w:types) [tixComboBox $lf.types\
+ -command "tixExFileSelectBox:Cmd-TypeCombo $w" \
+ -options { \
+ label.anchor w \
+ }]
+
+ pack $data(w:types) -padx 12 -pady 4 -side bottom -fill x -anchor w
+ pack $pane -side top -padx 4 -pady 4 -expand yes -fill both
+
+ # Buttons to the right
+ #
+ set bf [frame $w.bf]
+ set data(w:ok) [button $bf.ok -text OK\
+ -underline 0 -command "tixExFileSelectBox:Ok $w"]
+ set data(w:cancel) [button $bf.cancel -text Cancel\
+ -underline 0 -command "tixExFileSelectBox:Cancel $w"]
+ set data(w:hidden) [checkbutton $bf.hidden -text "Show Hidden Files"\
+ -underline 0\
+ -variable [format %s(-showhidden) $w] -onvalue 1 -offvalue 0\
+ -command "tixExFileSelectBox:SetShowHidden $w"]
+
+ pack $data(w:ok) $data(w:cancel) $data(w:hidden)\
+ -side top -fill x -padx 6 -pady 3
+
+ pack $bf -side right -fill both -pady 6
+ pack $lf -side left -expand yes -fill both
+
+ tixDoWhenMapped $w "tixExFileSelectBox:Map $w"
+
+ if {$data(-filetypes) == ""} {
+ $data(w:types) config -state disabled
+ }
+}
+
+
+#----------------------------------------------------------------------
+# Configuration
+#----------------------------------------------------------------------
+proc tixExFileSelectBox:config-showhidden {w value} {
+ upvar #0 $w data
+
+ set data(-showhidden) $value
+ tixExFileSelectBox:SetShowHidden $w
+}
+
+# Update both DirList and {file list and dir combo}
+#
+#
+proc tixExFileSelectBox:config-directory {w value} {
+ upvar #0 $w data
+
+ if {![tixIsAbsPath $value]} {
+ return $data(-directory)
+ }
+
+ set data(-directory) [tixFSAbsPath $value]
+ tixSetSilent $data(w:dirlist) $data(-directory)
+ tixSetSilent $data(w:dir) $data(-directory)
+ tixWidgetDoWhenIdle tixExFileSelectBox:LoadFiles $w reload
+
+ return $data(-directory)
+}
+
+proc tixExFileSelectBox:config-filetypes {w value} {
+ upvar #0 $w data
+
+ $data(w:types) subwidget listbox delete 0 end
+
+ foreach name [array names data] {
+ if [string match type,* $name] {
+ catch {unset data($name)}
+ }
+ }
+
+ if {$value == ""} {
+ $data(w:types) config -state disabled
+ } else {
+ $data(w:types) config -state normal
+
+ foreach type $value {
+ $data(w:types) insert end [lindex $type 1]
+ set data(type,[lindex $type 1]) [lindex $type 0]
+ }
+ tixSetSilent $data(w:types) ""
+ }
+}
+
+#----------------------------------------------------------------------
+# MISC Methods
+#----------------------------------------------------------------------
+proc tixExFileSelectBox:SetShowHidden {w} {
+ upvar #0 $w data
+
+ $data(w:dirlist) config -showhidden $data(-showhidden)
+
+ tixWidgetDoWhenIdle tixExFileSelectBox:LoadFiles $w reload
+}
+
+# User activates the dir combobox
+#
+#
+proc tixExFileSelectBox:Cmd-DirCombo {w args} {
+ upvar #0 $w data
+
+ set dir [tixEvent flag V]
+ if {![tixIsAbsPath $dir]} {
+ return
+ }
+ set dir [tixFSAbsPath $dir]
+
+ if {![file isdirectory $dir]} {
+ return
+ }
+
+ $data(w:dirlist) config -value $dir
+ set data(-directory) $dir
+}
+
+# User activates the dir list
+#
+#
+proc tixExFileSelectBox:Cmd-DirList {w args} {
+ upvar #0 $w data
+
+ set dir $data(-directory)
+ catch {
+ set dir [tixEvent flag V]
+ }
+ set dir [tixFSAbsPath $dir]
+
+ tixSetSilent $data(w:dir) $dir
+ set data(-directory) $dir
+
+ tixWidgetDoWhenIdle tixExFileSelectBox:LoadFiles $w noreload
+}
+
+# User activates the dir list
+#
+#
+proc tixExFileSelectBox:Browse-DirList {w args} {
+ upvar #0 $w data
+
+ set dir [tixEvent flag V]
+ tixExFileSelectBox:Cmd-DirList $w $dir
+}
+
+proc tixExFileSelectBox:IsPattern {w string} {
+ foreach char [split $string ""] {
+ if {$char == "*" || $char == "?" || $char == "\{" || $char == "\[" } {
+ return 1
+ }
+ }
+ return 0
+}
+
+proc tixExFileSelectBox:Cmd-FileCombo {w value} {
+ upvar #0 $w data
+
+ if {[tixEvent type] == "<Return>"} {
+ tixExFileSelectBox:Ok $w
+ }
+}
+
+proc tixExFileSelectBox:Ok {w} {
+ upvar #0 $w data
+
+ set value [string trim [$data(w:file) subwidget entry get]]
+ if {$value == ""} {
+ set value $data(-pattern)
+ }
+ tixSetSilent $data(w:file) $value
+
+ if [tixExFileSelectBox:IsPattern $w $value] {
+ set data(-pattern) $value
+ tixWidgetDoWhenIdle tixExFileSelectBox:LoadFiles $w reload
+ } else {
+ if [tixIsAbsPath $value] {
+ set intName [tixFileIntName $value]
+ } else {
+ set intName [tixSubFolder [tixFileIntName $data(-directory)] \
+ [tixFileIntName $value]]
+ }
+ set data(-value) [tixNativeName $intName]
+ tixExFileSelectBox:Invoke $w
+ }
+}
+
+proc tixExFileSelectBox:Cancel {w} {
+ upvar #0 $w data
+
+ if {$data(-dialog) != ""} {
+ eval $data(-dialog) popdown
+ }
+}
+
+proc tixExFileSelectBox:Invoke {w} {
+ upvar #0 $w data
+
+ # Save some old history
+ #
+ $data(w:dir) addhistory [$data(w:dir) cget -value]
+ $data(w:file) addhistory $data(-pattern)
+ $data(w:file) addhistory $data(-value)
+ if {$data(-dialog) != ""} {
+ eval $data(-dialog) popdown
+ }
+ if {$data(-command) != "" && !$data(-disablecallback)} {
+ set bind(specs) "%V"
+ set bind(%V) $data(-value)
+ tixEvalCmdBinding $w $data(-command) bind $data(-value)
+ }
+}
+
+proc tixExFileSelectBox:Cmd-FileList {w invoke args} {
+ upvar #0 $w data
+
+ set index [lindex [$data(w:filelist) subwidget listbox curselection] 0]
+ if {$index == ""} {
+ set index 0
+ }
+
+ set file [$data(w:filelist) subwidget listbox get $index]
+ tixSetSilent $data(w:file) $file
+
+ set data(-value) [tixNativeName [tixSubFolder \
+ [tixFileIntName $data(-directory)] [tixFileIntName $file]]]
+
+ if {$invoke == 1} {
+ tixExFileSelectBox:Invoke $w
+ } else {
+ if {$data(-browsecmd) != ""} {
+ tixEvalCmdBinding $w $data(-browsecmd) "" $data(-value)
+ }
+ }
+}
+
+proc tixExFileSelectBox:Cmd-TypeCombo {w args} {
+ upvar #0 $w data
+
+ set value [tixEvent flag V]
+
+ if [info exists data(type,$value)] {
+ set data(-pattern) $data(type,$value)
+ tixSetSilent $data(w:file) $data(-pattern)
+ tixWidgetDoWhenIdle tixExFileSelectBox:LoadFiles $w reload
+ }
+}
+
+proc tixExFileSelectBox:LoadFiles {w flag} {
+ upvar #0 $w data
+
+ if {$flag != "reload" && $data(-directory) == $data(oldDir)} {
+ return
+ }
+
+ if {![winfo ismapped [winfo toplevel $w]]} {
+ tixDoWhenMapped [winfo toplevel $w] \
+ "tixExFileSelectBox:LoadFiles $w $flag"
+ return
+ }
+
+ set listbox [$data(w:filelist) subwidget listbox]
+ $listbox delete 0 end
+
+ set data(-value) ""
+
+ tixBusy $w on [$data(w:dirlist) subwidget hlist]
+
+ set intDir [tixFileIntName $data(-directory)]
+ foreach name [tixListDir $intDir 0 1 0 \
+ $data(-showhidden) $data(-pattern)] {
+
+ $listbox insert end [tixFileDisplayName [tixSubFolder $intDir $name]]
+ }
+
+ if {$data(oldDir) != $data(-directory)} {
+ # Otherwise if the user has already selected a file and then presses
+ # "show hidden", the selection won't be wiped out.
+ tixSetSilent $data(w:file) $data(-pattern)
+ }
+ set data(oldDir) $data(-directory)
+
+ tixWidgetDoWhenIdle tixBusy $w off [$data(w:dirlist) subwidget hlist]
+}
+
+#
+# Called when thd listbox is first mapped
+proc tixExFileSelectBox:Map {w} {
+ if {![winfo exists $w]} {
+ return
+ }
+
+ upvar #0 $w data
+
+ set bind(specs) "%V"
+ set bind(%V) $data(-value)
+ tixEvalCmdBinding $w bind \
+ "tixExFileSelectBox:Cmd-DirList $w" $data(-directory)
+}
+
+#----------------------------------------------------------------------
+# Public commands
+#
+#----------------------------------------------------------------------
+proc tixExFileSelectBox:invoke {w} {
+ tixExFileSelectBox:Invoke $w
+}
+
+proc tixExFileSelectBox:filter {w} {
+ tixExFileSelectBox:LoadFiles $w reload
+}
+
diff --git a/tix/library/EFileDlg.tcl b/tix/library/EFileDlg.tcl
new file mode 100644
index 00000000000..b862767d6b8
--- /dev/null
+++ b/tix/library/EFileDlg.tcl
@@ -0,0 +1,51 @@
+# EFileDlg.tcl --
+#
+# Implements the Extended File Selection Dialog widget.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixExFileSelectDialog {
+ -classname TixExFileSelectDialog
+ -superclass tixDialogShell
+ -method {}
+ -flag {
+ -command
+ }
+ -configspec {
+ {-command command Command ""}
+
+ {-title title Title "Select A File"}
+ }
+}
+
+proc tixExFileSelectDialog:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+ set data(w:fsbox) [tixExFileSelectBox $w.fsbox -dialog $w \
+ -command $data(-command)]
+ pack $data(w:fsbox) -expand yes -fill both
+}
+
+proc tixExFileSelectDialog:config-command {w value} {
+ upvar #0 $w data
+
+ $data(w:fsbox) config -command $value
+}
+
+proc tixExFileSelectDialog:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ bind $w <Alt-Key-f> "focus [$data(w:fsbox) subwidget file]"
+ bind $w <Alt-Key-t> "focus [$data(w:fsbox) subwidget types]"
+ bind $w <Alt-Key-d> "focus [$data(w:fsbox) subwidget dir]"
+ bind $w <Alt-Key-o> "tkButtonInvoke [$data(w:fsbox) subwidget ok]"
+ bind $w <Alt-Key-c> "tkButtonInvoke [$data(w:fsbox) subwidget cancel]"
+ bind $w <Alt-Key-s> "tkButtonInvoke [$data(w:fsbox) subwidget hidden]"
+}
diff --git a/tix/library/Event.tcl b/tix/library/Event.tcl
new file mode 100644
index 00000000000..c04f60a395c
--- /dev/null
+++ b/tix/library/Event.tcl
@@ -0,0 +1,239 @@
+# Event.tcl --
+#
+# Handles the event bindings of the -command and -browsecmd options
+# (and various of others such as -validatecmd).
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#----------------------------------------------------------------------
+# Evaluate high-level bindings (-command, -browsecmd, etc):
+# with % subsitution or without (compatibility mode)
+#
+#
+# BUG : if a -command is intercepted by a hook, the hook must use
+# the same record name as the issuer of the -command. For the time
+# being, you must use the name "bind" as the record name!!!!!
+#
+#----------------------------------------------------------------------
+set _tix_event_flags ""
+append _tix_event_flags " %%"
+append _tix_event_flags " %#"
+#append _tix_event_flags " %a"
+append _tix_event_flags " %b"
+append _tix_event_flags " %c"
+append _tix_event_flags " %d"
+append _tix_event_flags " %f"
+append _tix_event_flags " %h"
+append _tix_event_flags " %k"
+append _tix_event_flags " %m"
+append _tix_event_flags " %o"
+append _tix_event_flags " %p"
+append _tix_event_flags " %s"
+append _tix_event_flags " %t"
+append _tix_event_flags " %w"
+append _tix_event_flags " %x"
+append _tix_event_flags " %y"
+append _tix_event_flags " %A"
+append _tix_event_flags " %B"
+append _tix_event_flags " %E"
+append _tix_event_flags " %K"
+append _tix_event_flags " %N"
+append _tix_event_flags " %R"
+#append _tix_event_flags " %S"
+append _tix_event_flags " %T"
+append _tix_event_flags " %W"
+append _tix_event_flags " %X"
+append _tix_event_flags " %Y"
+
+proc tixBind {tag event action} {
+ global _tix_event_flags
+
+ append cmd "_tixRecordFlags $event $_tix_event_flags;"
+ append cmd "$action; "
+ append cmd "_tixDeleteFlags"
+
+ bind $tag $event $cmd
+}
+
+# This is a "name stack" for storing the "bind" structures
+#
+# The bottom of the event stack is usually a raw event (generated by tixBind)
+# but it may also be a programatically triggered (caused by tixEvalCmdBinding)
+#
+#
+
+set tixEvent(nameStack) ""
+set tixEvent(stackLevel) 0
+
+proc tixPushEventStack {} {
+ global tixEvent
+
+ set lastEvent [lindex $tixEvent(nameStack) 0]
+ incr tixEvent(stackLevel)
+ set thisEvent _tix_event$tixEvent(stackLevel)
+
+ set tixEvent(nameStack) \
+ [list $thisEvent $tixEvent(nameStack)]
+
+ if {$lastEvent == ""} {
+ upvar #0 $thisEvent this
+ set this(type) <Application>
+ } else {
+ upvar #0 $lastEvent last
+ upvar #0 $thisEvent this
+
+ foreach name [array names last] {
+ set this($name) $last($name)
+ }
+ }
+
+ return $thisEvent
+}
+
+proc tixPopEventStack {varName} {
+ global tixEvent
+
+ if {$varName != [lindex $tixEvent(nameStack) 0]} {
+ error "unmatched tixPushEventStack and tixPopEventStack calls"
+ }
+ incr tixEvent(stackLevel) -1
+ set tixEvent(nameStack) [lindex $tixEvent(nameStack) 1]
+ global $varName
+ unset $varName
+}
+
+
+# Events triggered by tixBind
+#
+proc _tixRecordFlags [concat event $_tix_event_flags] {
+ global _tix_event_flags
+
+ set thisName [tixPushEventStack]; upvar #0 $thisName this
+
+ set this(type) $event
+ foreach f $_tix_event_flags {
+ set this($f) [set $f]
+ }
+}
+
+proc _tixDeleteFlags {} {
+ global tixEvent
+
+ tixPopEventStack [lindex $tixEvent(nameStack) 0]
+}
+
+# programatically trigged events
+#
+proc tixEvalCmdBinding {w cmd {subst ""} args} {
+ global tixPriv tixEvent tix
+
+ set thisName [tixPushEventStack]; upvar #0 $thisName this
+
+ if {$subst != ""} {
+ upvar $subst bind
+
+ if [info exists bind(specs)] {
+ foreach spec $bind(specs) {
+ set this($spec) $bind($spec)
+ }
+ }
+ if [info exists bind(type)] {
+ set this(type) $bind(type)
+ }
+ }
+
+ if [catch {
+ if [tixGetBoolean -nocomplain $tix(-extracmdargs)] {
+ # Compatibility mode
+ #
+ set ret [uplevel #0 $cmd $args]
+ } else {
+ set ret [uplevel $cmd]
+ }
+ } error] {
+ if [catch {
+ tixCmdErrorHandler $error
+ } error] {
+ # double fault: just print out
+ tixBuiltInCmdErrorHandler $error
+ }
+ tixPopEventStack $thisName
+ return ""
+ } else {
+ tixPopEventStack $thisName
+
+ return $ret
+ }
+}
+
+proc tixEvent {option args} {
+ global tixPriv tixEvent
+ set varName [lindex $tixEvent(nameStack) 0]
+
+ if {$varName == ""} {
+ error "tixEvent called when no event is being processed"
+ } else {
+ upvar #0 $varName event
+ }
+
+ case $option {
+ type {
+ return $event(type)
+ }
+ value {
+ if [info exists event(%V)] {
+ return $event(%V)
+ } else {
+ return ""
+ }
+ }
+ flag {
+ set f %[lindex $args 0]
+ if [info exists event($f)] {
+ return $event($f)
+ }
+ error "The flag \"[lindex $args 0]\" does not exist"
+ }
+ match {
+ return [string match [lindex $args 0] $event(type)]
+ }
+ default {
+ error "unknown option \"$option\""
+ }
+ }
+}
+
+# tixBuiltInCmdErrorHandler --
+#
+# Default method to report command handler errors. This procedure is
+# also called if double-fault happens (command handler causes error,
+# then tixCmdErrorHandler causes error).
+#
+proc tixBuiltInCmdErrorHandler {errorMsg} {
+ global errorInfo tcl_platform
+ if ![info exists errorInfo] {
+ set errorInfo "???"
+ }
+ if {$tcl_platform(platform) == "windows"} then {
+ bgerror "Tix Error: $errorMsg"
+ } else {
+ puts "Error:\n $errorMsg\n$errorInfo"
+ }
+}
+
+# tixCmdErrorHandler --
+#
+# You can redefine this command to handle the errors that occur
+# in the command handlers. See the programmer's documentation
+# for details
+#
+if ![string compare [info command tixCmdErrorHandler] ""] {
+ proc tixCmdErrorHandler {errorMsg} {
+ tixBuiltInCmdErrorHandler $errorMsg
+ }
+}
+
diff --git a/tix/library/FileBox.tcl b/tix/library/FileBox.tcl
new file mode 100644
index 00000000000..7067edb5b00
--- /dev/null
+++ b/tix/library/FileBox.tcl
@@ -0,0 +1,579 @@
+# FileBox.tcl --
+#
+# Implements the File Selection Box widget.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+# ToDo
+# (1) If user has entered an invalid directory, give an error dialog
+#
+
+tixWidgetClass tixFileSelectBox {
+ -superclass tixPrimitive
+ -classname TixFileSelectBox
+ -method {
+ filter invoke
+ }
+ -flag {
+ -browsecmd -command -dir -directory -disablecallback
+ -grab -pattern -selection -value
+ }
+ -configspec {
+ {-browsecmd browseCmd BrowseCmd ""}
+ {-command command Command ""}
+ {-directory directory Directory ""}
+ {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
+ {-grab grab Grab global}
+ {-pattern pattern Pattern *}
+ {-value value Value ""}
+ }
+ -alias {
+ {-selection -value}
+ {-dir -directory}
+ }
+ -forcecall {
+ -value
+ }
+ -default {
+ {.relief raised}
+ {*filelist*Listbox.takeFocus true}
+ {.borderWidth 1}
+ {*Label.anchor w}
+ {*Label.borderWidth 0}
+ {*Label.font -Adobe-Helvetica-Bold-R-Normal--*-120-*}
+ {*TixComboBox*scrollbar auto}
+ {*TixComboBox*Label.anchor w}
+ {*TixScrolledListBox.scrollbar auto}
+ {*Listbox.exportSelection false}
+ {*directory*Label.text "Directories:"}
+ {*directory*Label.underline 0}
+ {*file*Label.text "Files:"}
+ {*file*Label.underline 2}
+ {*filter.label "Filter:"}
+ {*filter*label.underline 3}
+ {*filter.labelSide top}
+ {*selection.label "Selection:"}
+ {*selection*label.underline 0}
+ {*selection.labelSide top}
+ }
+}
+
+
+proc tixFileSelectBox:InitWidgetRec {w} {
+ upvar #0 $w data
+ global env
+
+ tixChainMethod $w InitWidgetRec
+
+ if {$data(-directory) == ""} {
+ set data(-directory) [pwd]
+ }
+ if {$data(-pattern) == ""} {
+ set data(-pattern) [tixFilePattern allFiles]
+ }
+
+ tixFileSelectBox:SetPat $w [tixFileIntName $data(-pattern)]
+ tixFileSelectBox:SetDir $w [tixFileIntName $data(-directory)]
+
+ set data(flag) 0
+ set data(fakeDir) 0
+}
+
+#----------------------------------------------------------------------
+# Construct widget
+#----------------------------------------------------------------------
+proc tixFileSelectBox:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ set frame1 [tixFileSelectBox:CreateFrame1 $w]
+ set frame2 [tixFileSelectBox:CreateFrame2 $w]
+ set frame3 [tixFileSelectBox:CreateFrame3 $w]
+
+ pack $frame1 -in $w -side top -fill x
+ pack $frame3 -in $w -side bottom -fill x
+ pack $frame2 -in $w -side top -fill both -expand yes
+}
+
+proc tixFileSelectBox:CreateFrame1 {w} {
+ upvar #0 $w data
+
+ frame $w.f1 -border 10
+ tixComboBox $w.f1.filter -editable 1\
+ -command "$w filter" -anchor e \
+ -options {
+ slistbox.scrollbar auto
+ listbox.height 5
+ label.anchor w
+ }
+ set data(w:filter) $w.f1.filter
+
+ pack $data(w:filter) -side top -expand yes -fill both
+ return $w.f1
+}
+
+proc tixFileSelectBox:CreateFrame2 {w} {
+ upvar #0 $w data
+
+ tixPanedWindow $w.f2 -orientation horizontal
+ # THE LEFT FRAME
+ #-----------------------
+ set dir [$w.f2 add directory -size 120]
+ $dir config -relief flat
+ label $dir.lab
+ set data(w:dirlist) [tixScrolledListBox $dir.dirlist\
+ -scrollbar auto\
+ -options {listbox.width 4 listbox.height 6}]
+
+ pack $dir.lab -side top -fill x -padx 10
+ pack $data(w:dirlist) -side bottom -expand yes -fill both -padx 10
+
+ # THE RIGHT FRAME
+ #-----------------------
+ set file [$w.f2 add file -size 160]
+ $file config -relief flat
+ label $file.lab
+ set data(w:filelist) [tixScrolledListBox $file.filelist \
+ -scrollbar auto\
+ -options {listbox.width 4 listbox.height 6}]
+
+ pack $file.lab -side top -fill x -padx 10
+ pack $data(w:filelist) -side bottom -expand yes -fill both -padx 10
+
+ return $w.f2
+}
+
+proc tixFileSelectBox:CreateFrame3 {w} {
+ upvar #0 $w data
+
+ frame $w.f3 -border 10
+ tixComboBox $w.f3.selection -editable 1\
+ -command "tixFileSelectBox:SelInvoke $w" \
+ -anchor e \
+ -options {
+ slistbox.scrollbar auto
+ listbox.height 5
+ label.anchor w
+ }
+
+ set data(w:selection) $w.f3.selection
+
+ pack $data(w:selection) -side top -fill both
+
+ return $w.f3
+}
+
+proc tixFileSelectBox:SelInvoke {w args} {
+ upvar #0 $w data
+
+ set event [tixEvent type]
+
+ if {$event != "<FocusOut>" && $event != "<Tab>"} {
+ $w invoke
+ }
+}
+
+proc tixFileSelectBox:SetValue {w value} {
+ upvar #0 $w data
+
+ set data(i-value) $value
+ set data(-value) [tixNativeName $value 0]
+}
+
+proc tixFileSelectBox:SetDir {w value} {
+ upvar #0 $w data
+
+ set data(i-directory) $value
+ set data(-directory) [tixNativeName $value]
+}
+
+proc tixFileSelectBox:SetPat {w value} {
+ upvar #0 $w data
+
+ set data(i-pattern) $value
+ set data(-pattern) [tixNativeName $value 0]
+}
+
+
+#----------------------------------------------------------------------
+# BINDINGS
+#----------------------------------------------------------------------
+
+proc tixFileSelectBox:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ tixDoWhenMapped $w "tixFileSelectBox:FirstMapped $w"
+
+ $data(w:dirlist) config \
+ -browsecmd "tixFileSelectBox:SelectDir $w" \
+ -command "tixFileSelectBox:InvokeDir $w"
+
+ $data(w:filelist) config \
+ -browsecmd "tixFileSelectBox:SelectFile $w" \
+ -command "tixFileSelectBox:InvokeFile $w"
+}
+
+#----------------------------------------------------------------------
+# CONFIG OPTIONS
+#----------------------------------------------------------------------
+proc tixFileSelectBox:config-directory {w value} {
+ upvar #0 $w data
+
+ if {$value == ""} {
+ set value [pwd]
+ }
+ tixFileSelectBox:SetDir $w [tixFileIntName $value]
+ tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
+ $w filter
+
+ return $data(-directory)
+}
+
+proc tixFileSelectBox:config-pattern {w value} {
+ upvar #0 $w data
+
+ if {$value == ""} {
+ set value [tixFilePattern allFiles]
+ }
+
+ tixFileSelectBox:SetPat $w [tixFileIntName $value]
+ tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
+
+ # Returning a value means we have overridden the value and updated
+ # the widget record ourselves.
+ #
+ return $data(-pattern)
+}
+
+proc tixFileSelectBox:config-value {w value} {
+ upvar #0 $w data
+
+ tixFileSelectBox:SetValue $w [tixFileIntName $value]
+ tixSetSilent $data(w:selection) $value
+
+ return $data(-value)
+}
+
+#----------------------------------------------------------------------
+# PUBLIC METHODS
+#----------------------------------------------------------------------
+proc tixFileSelectBox:filter {w args} {
+ upvar #0 $w data
+
+ $data(w:filter) popdown
+ tixFileSelectBox:InterpFilter $w
+ tixFileSelectBox:LoadDir $w
+}
+
+proc tixFileSelectBox:invoke {w args} {
+ upvar #0 $w data
+
+ if {[$data(w:selection) cget -value] !=
+ [$data(w:selection) cget -selection]} {
+ # this will in turn call "invoke" again ...
+ #
+ $data(w:selection) invoke
+ return
+ }
+
+ # record the filter
+ #
+ set filter [tixFileSelectBox:InterpFilter $w]
+ $data(w:filter) addhistory $filter
+
+ # record the selection
+ #
+ set userInput [string trim [$data(w:selection) cget -value]]
+ tixFileSelectBox:SetValue $w \
+ [tixFileIntName $userInput $data(i-directory)]
+ $data(w:selection) addhistory $data(-value)
+
+ $data(w:filter) align
+ $data(w:selection) align
+
+ if {$data(-command) != "" && !$data(-disablecallback)} {
+ set bind(specs) "%V"
+ set bind(%V) $data(-value)
+ tixEvalCmdBinding $w $data(-command) bind $data(-value)
+ }
+}
+
+#----------------------------------------------------------------------
+# INTERNAL METHODS
+#----------------------------------------------------------------------
+# InterpFilter:
+# Interprets the value of the w:filter widget.
+#
+# Side effects:
+# Changes the fields data(-directory) and data(-pattenn)
+#
+proc tixFileSelectBox:InterpFilter {w {filter ""}} {
+ upvar #0 $w data
+
+ if {$filter == ""} {
+ set filter [$data(w:filter) cget -selection]
+ if {$filter == ""} {
+ set filter [$data(w:filter) cget -value]
+ }
+ }
+
+ set i_filter [tixFileIntName $filter]
+
+ if [file isdir $filter] {
+ tixFileSelectBox:SetDir $w $i_filter
+ tixFileSelectBox:SetPat $w [tixFilePattern allFiles]
+ } else {
+ set nDir [file dir $filter]
+ if {$nDir == "" || $nDir == "."} {
+ tixFileSelectBox:SetDir $w [tixFileIntName $data(i-directory)]
+ } else {
+ tixFileSelectBox:SetDir $w [tixFileIntName $nDir]
+ }
+ tixFileSelectBox:SetPat $w [tixFileIntName [file tail $filter]]
+ }
+
+ tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
+
+ return $data(filter)
+}
+
+proc tixFileSelectBox:SetFilter {w dir pattern} {
+ upvar #0 $w data
+
+ set data(filter) [tixSubFolder $dir $pattern]
+ tixSetSilent $data(w:filter) [tixNativeName $data(filter)]
+}
+
+proc tixFileSelectBox:LoadDirIntoLists {w} {
+ upvar #0 $w data
+
+ $data(w:dirlist) subwidget listbox delete 0 end
+ $data(w:filelist) subwidget listbox delete 0 end
+
+ set dir $data(i-directory)
+
+ # (1) List the directories
+ #
+ set isDrive 0
+ catch {
+ set nDir [tixNativeName $dir]
+ if {[llength [file split $nDir]] == 1} {
+ set isDrive 1
+ }
+ }
+ foreach name [tixListDir $dir 1 0 1 1] {
+ if ![string compare ".." $name] {
+ if $isDrive {
+ continue
+ }
+ }
+ $data(w:dirlist) subwidget listbox insert end $name
+ }
+
+ # (2) List the files
+ #
+ # %% UNIX'ISM:
+ # If the pattern is "*" force glob to list the .* files.
+ # However, since the user might not
+ # be interested in them, shift the listbox so that the "normal" files
+ # are seen first
+ #
+ # NOTE: if we pass $pat == "" but with $showHidden set to true,
+ # tixListDir will list "* .*" in Unix. See the comment on top of
+ # the tixListDir code.
+ #
+ if {[string compare $data(i-pattern) *] == 0} {
+ set pat ""
+ } else {
+ set pat $data(i-pattern)
+ }
+
+ set top 0
+ foreach name [tixListDir $dir 0 1 0 0 $pat] {
+ $data(w:filelist) subwidget listbox insert end $name
+ if [string match .* $name] {
+ incr top
+ }
+ }
+
+ $data(w:filelist) subwidget listbox yview $top
+}
+
+proc tixFileSelectBox:LoadDir {w} {
+ upvar #0 $w data
+
+ tixBusy $w on [$data(w:dirlist) subwidget listbox]
+
+ tixFileSelectBox:LoadDirIntoLists $w
+ tixFileSelectBox:MkDirMenu $w
+
+ if {[$data(w:dirlist) subwidget listbox size] == 0} {
+ # fail safe, just in case the user has inputed an errnoeuos
+ # directory
+ $data(w:dirlist) subwidget listbox insert 0 ".."
+ }
+
+ tixWidgetDoWhenIdle tixBusy $w off [$data(w:dirlist) subwidget listbox]
+}
+
+# %% unimplemented
+#
+proc tixFileSelectBox:MkDirMenu {w} {
+ upvar #0 $w data
+}
+
+# User single clicks on the directory listbox
+#
+proc tixFileSelectBox:SelectDir {w} {
+ upvar #0 $w data
+
+ if {$data(fakeDir) > 0} {
+ incr data(fakeDir) -1
+ $data(w:dirlist) subwidget listbox select clear 0 end
+ $data(w:dirlist) subwidget listbox activate -1
+ return
+ }
+
+ if {$data(flag)} {
+ return
+ }
+ set data(flag) 1
+
+ set subdir [tixListboxGetCurrent [$data(w:dirlist) subwidget listbox]]
+ if {$subdir == ""} {
+ set subdir "."
+ }
+
+ tixFileSelectBox:SetFilter $w \
+ [tixFileIntName [tixSubFolder $data(i-directory) $subdir]] \
+ $data(i-pattern)
+ set data(flag) 0
+}
+
+proc tixFileSelectBox:InvokeDir {w} {
+ upvar #0 $w data
+
+ set theDir [$data(w:dirlist) subwidget listbox get active]
+
+ tixFileSelectBox:SetDir $w [tixFileIntName \
+ [tixSubFolder $data(i-directory) $theDir]]
+
+ $data(w:dirlist) subwidget listbox select clear 0 end
+
+ tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
+ tixFileSelectBox:InterpFilter $w [tixNativeName $data(filter)]
+
+ tixFileSelectBox:LoadDir $w
+
+ if {![tixEvent match <Return>]} {
+ incr data(fakeDir) 1
+ }
+}
+
+proc tixFileSelectBox:SelectFile {w} {
+ upvar #0 $w data
+
+ if {$data(flag)} {
+ return
+ }
+ set data(flag) 1
+
+ # Reset the "Filter:" box to the current directory:
+ #
+ $data(w:dirlist) subwidget listbox select clear 0 end
+ tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
+
+ # Now select the file
+ #
+ set selected [tixListboxGetCurrent [$data(w:filelist) subwidget listbox]]
+ if {$selected != ""} {
+ # Make sure that the selection is not empty!
+ #
+ tixFileSelectBox:SetValue $w \
+ [tixFileIntName [tixSubFolder $data(i-directory) $selected]]
+ tixSetSilent $data(w:selection) $data(-value)
+
+ if {$data(-browsecmd) != ""} {
+ tixEvalCmdBinding $w $data(-browsecmd) "" $data(-value)
+ }
+ }
+ set data(flag) 0
+}
+
+proc tixFileSelectBox:InvokeFile {w} {
+ upvar #0 $w data
+
+ set selected [tixListboxGetCurrent [$data(w:filelist) subwidget listbox]]
+ if {$selected != ""} {
+ $w invoke
+ }
+}
+
+# This is only called the first this fileBox is mapped -- load the directory
+#
+proc tixFileSelectBox:FirstMapped {w} {
+ if {![winfo exists $w]} {
+ return
+ }
+
+ upvar #0 $w data
+
+ tixFileSelectBox:SetFilter $w $data(i-directory) $data(i-pattern)
+ tixFileSelectBox:LoadDir $w
+ $data(w:filter) align
+}
+
+
+#----------------------------------------------------------------------
+#
+#
+# C O N V E N I E N C E R O U T I N E S
+#
+#
+#----------------------------------------------------------------------
+
+# This is obsolete. Use the widget tixFileSelectDialog instead
+#
+#
+proc tixMkFileDialog {w args} {
+ set option(-okcmd) ""
+ set option(-helpcmd) ""
+
+ tixHandleOptions option {-okcmd -helpcmd} $args
+
+ toplevel $w
+ wm minsize $w 10 10
+
+ tixStdDlgBtns $w.btns
+
+ if {$option(-okcmd) != ""} {
+ tixFileSelectBox $w.fsb -command "wm withdraw $w; $option(-okcmd)"
+ } else {
+ tixFileSelectBox $w.fsb -command "wm withdraw $w"
+ }
+
+ $w.btns button ok config -command "$w.fsb invoke"
+ $w.btns button apply config -command "$w.fsb filter" -text Filter
+ $w.btns button cancel config -command "wm withdraw $w"
+
+ if {$option(-helpcmd) == ""} {
+ $w.btns button help config -state disabled
+ } else {
+ $w.btns button help config -command $option(-helpcmd)
+ }
+ wm protocol $w WM_DELETE_WINDOW "wm withdraw $w"
+ pack $w.btns -side bottom -fill both
+ pack $w.fsb -fill both -expand yes
+
+ return $w.fsb
+}
+
+
diff --git a/tix/library/FileCbx.tcl b/tix/library/FileCbx.tcl
new file mode 100644
index 00000000000..fc1ba6401e7
--- /dev/null
+++ b/tix/library/FileCbx.tcl
@@ -0,0 +1,100 @@
+# tixFileCombobox --
+#
+# A combobox widget for entering file names, directory names, file
+# patterns, etc.
+#
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+# tixFileComboBox displays and accepts the DOS pathnames only. It doesn't
+# recognize UNC file names or Tix VPATHS.
+#
+tixWidgetClass tixFileComboBox {
+ -classname TixFileComboBox
+ -superclass tixPrimitive
+ -method {
+ invoke
+ }
+ -flag {
+ -command -defaultfile -directory -text
+ }
+ -forcecall {
+ -directory
+ }
+ -configspec {
+ {-defaultfile defaultFile DefaultFile ""}
+ {-directory directory Directory ""}
+ {-command command Command ""}
+ {-text text Text ""}
+ }
+ -default {
+ }
+}
+
+proc tixFileComboBox:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+
+ if ![string comp $data(-directory) ""] {
+ set data(-directory) [tixFSPWD]
+ }
+}
+
+proc tixFileComboBox:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+ set data(w:combo) [tixComboBox $w.combo -editable true -dropdown true]
+ pack $data(w:combo) -expand yes -fill both
+}
+
+proc tixFileComboBox:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+ $data(w:combo) config -command "tixFileComboBox:OnComboCmd $w"
+}
+
+proc tixFileComboBox:OnComboCmd {w args} {
+ upvar #0 $w data
+
+ set text [string trim [tixEvent value]]
+
+ set fInfo [tixFSNorm [tixFSVPath $data(-directory)] \
+ $text $data(-defaultfile) "" errorMsg]
+ if [info exists errorMsg] {
+
+ } else {
+ tixSetSilent $data(w:combo) [lindex $fInfo 0]
+ if [string compare $data(-command) ""] {
+ set bind(specs) {%V}
+ set bind(%V) $fInfo
+ tixEvalCmdBinding $w $data(-command) bind $fInfo
+ }
+ }
+}
+
+proc tixFileComboBox:config-text {w val} {
+ upvar #0 $w data
+
+ tixSetSilent $data(w:combo) $val
+}
+
+proc tixFileComboBox:config-directory {w val} {
+ upvar #0 $w data
+
+ set data(-directory) [tixFSNormDir $val]
+ return $data(-directory)
+}
+
+proc tixFileComboBox:invoke {w} {
+ upvar #0 $w data
+
+ $data(w:combo) invoke
+}
+
+
diff --git a/tix/library/FileCmpt.tcl b/tix/library/FileCmpt.tcl
new file mode 100644
index 00000000000..d7b1d06ad04
--- /dev/null
+++ b/tix/library/FileCmpt.tcl
@@ -0,0 +1,31 @@
+# FileCmpt.tcl --
+#
+# File access portibility routines.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+# Internal file names
+# (1) Idempotent: [tixFileIntName $intName] == $intName
+# (2) Does not contain "~", "..", "."
+# (3) All DOS type C:foo will be translated to absoulte path such as
+# /\C:\windows\foo
+# (4) Does not contail trailing "/" or "\\" characters
+#
+
+proc tixFileResolveName {nativeName {defParent ""}} {
+ if {$defParent != ""} {
+ return [tixNativeName [tixFileIntName $nativeName [tixFileIntName $defParent]]]
+ } else {
+ return [tixNativeName [tixFileIntName $nativeName]]
+ }
+}
+
+proc tixNSubFolder {parent sub} {
+ return [tixNativeName [tixSubFolder \
+ [tixFileIntName $parent] [tixFileIntName $sub]]]
+}
diff --git a/tix/library/FileDlg.tcl b/tix/library/FileDlg.tcl
new file mode 100644
index 00000000000..8a82062d2c6
--- /dev/null
+++ b/tix/library/FileDlg.tcl
@@ -0,0 +1,70 @@
+# FileDlg.tcl --
+#
+# Implements the File Selection Dialog widget.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixFileSelectDialog {
+ -classname TixFileSelectDialog
+ -superclass tixStdDialogShell
+ -method {
+ }
+ -flag {
+ -command
+ }
+ -configspec {
+ {-command command Command ""}
+
+ {-title title Title "Select A File"}
+ }
+}
+
+proc tixFileSelectDialog:ConstructTopFrame {w frame} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructTopFrame $frame
+
+ set data(w:fsbox) [tixFileSelectBox $frame.fsbox \
+ -command "tixFileSelectDialog:Invoke $w"]
+ pack $data(w:fsbox) -expand yes -fill both
+}
+
+proc tixFileSelectDialog:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ $data(w:btns) subwidget ok config -command "$data(w:fsbox) invoke" \
+ -underline 0
+ $data(w:btns) subwidget apply config -command "$data(w:fsbox) filter" \
+ -text Filter -underline 0
+ $data(w:btns) subwidget cancel config -command "wm withdraw $w" \
+ -underline 0
+ $data(w:btns) subwidget help config -underline 0
+
+
+ bind $w <Alt-Key-l> "focus [$data(w:fsbox) subwidget filelist]"
+ bind $w <Alt-Key-d> "focus [$data(w:fsbox) subwidget dirlist]"
+ bind $w <Alt-Key-s> "focus [$data(w:fsbox) subwidget selection]"
+ bind $w <Alt-Key-t> "focus [$data(w:fsbox) subwidget filter]"
+ bind $w <Alt-Key-o> "tkButtonInvoke [$data(w:btns) subwidget ok]"
+ bind $w <Alt-Key-f> "tkButtonInvoke [$data(w:btns) subwidget apply]"
+ bind $w <Alt-Key-c> "tkButtonInvoke [$data(w:btns) subwidget cancel]"
+ bind $w <Alt-Key-h> "tkButtonInvoke [$data(w:btns) subwidget help]"
+}
+
+proc tixFileSelectDialog:Invoke {w filename} {
+ upvar #0 $w data
+
+ wm withdraw $w
+
+ if {$data(-command) != ""} {
+ set bind(specs) "%V"
+ set bind(%V) $filename
+ tixEvalCmdBinding $w $data(-command) bind $filename
+ }
+}
diff --git a/tix/library/FileEnt.tcl b/tix/library/FileEnt.tcl
new file mode 100644
index 00000000000..acddd61a166
--- /dev/null
+++ b/tix/library/FileEnt.tcl
@@ -0,0 +1,235 @@
+# FileEnt.tcl --
+#
+# TixFileEntry Widget: an entry box for entering filenames.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixFileEntry {
+ -classname TixFileEntry
+ -superclass tixLabelWidget
+ -method {
+ invoke filedialog update
+ }
+ -flag {
+ -activatecmd -command -dialogtype -disablecallback -disabledforeground
+ -filebitmap -selectmode -state -validatecmd -value -variable
+ }
+ -forcecall {
+ -variable
+ }
+ -static {
+ -filebitmap
+ }
+ -configspec {
+ {-activatecmd activateCmd ActivateCmd ""}
+ {-command command Command ""}
+ {-dialogtype dialogType DialogType ""}
+ {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
+ {-disabledforeground disabledForeground DisabledForeground #303030}
+ {-filebitmap fileBitmap FileBitmap ""}
+ {-selectmode selectMode SelectMode normal}
+ {-state state State normal}
+ {-validatecmd validateCmd ValidateCmd ""}
+ {-value value Value ""}
+ {-variable variable Variable ""}
+ }
+ -default {
+ {*frame.borderWidth 2}
+ {*frame.relief sunken}
+ {*Label.font -Adobe-Helvetica-Bold-R-Normal--*-120-*-*-*-*-*-*}
+ {*Button.highlightThickness 0}
+ {*Entry.highlightThickness 0}
+ {*Entry.borderWidth 0}
+ {*Entry.background #c3c3c3}
+ }
+}
+
+proc tixFileEntry:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+ set data(varInited) 0
+
+ if {$data(-filebitmap) == ""} {
+ set data(-filebitmap) [tix getbitmap openfile]
+ }
+}
+
+proc tixFileEntry:ConstructFramedWidget {w frame} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructFramedWidget $frame
+
+ set data(w:entry) [entry $frame.entry]
+ set data(w:button) [button $frame.button -bitmap $data(-filebitmap) \
+ -takefocus 0]
+ set data(entryfg) [$data(w:entry) cget -fg]
+
+ pack $data(w:button) -side right -fill both
+ pack $data(w:entry) -side left -expand yes -fill both
+}
+
+proc tixFileEntry:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ $data(w:button) config -command "tixFileEntry:OpenFile $w"
+ tixSetMegaWidget $data(w:entry) $w
+
+ # If user press <return>, verify the value and call the -command
+ #
+ bind $data(w:entry) <Return> "tixFileEntry:invoke $w"
+ bind $data(w:entry) <KeyPress> {
+ if {[set [tixGetMegaWidget %W](-selectmode)] == "immediate"} {
+ tixFileEntry:invoke [tixGetMegaWidget %W]
+ }
+ }
+ bind $data(w:entry) <FocusOut> {
+ if {"%d" == "NotifyNonlinear" || "%d" == "NotifyNonlinearVirtual"} {
+ tixFileEntry:invoke [tixGetMegaWidget %W]
+ }
+ }
+ bind $w <FocusIn> "focus $data(w:entry)"
+}
+
+#----------------------------------------------------------------------
+# CONFIG OPTIONS
+#----------------------------------------------------------------------
+proc tixFileEntry:config-state {w value} {
+ upvar #0 $w data
+
+ if {$value == "normal"} {
+ $data(w:button) config -state $value
+ $data(w:entry) config -state $value -fg $data(entryfg)
+ catch {
+ $data(w:label) config -fg $data(entryfg)
+ }
+ } else {
+ $data(w:button) config -state $value
+ $data(w:entry) config -state $value -fg $data(-disabledforeground)
+ catch {
+ $data(w:label) config -fg $data(-disabledforeground)
+ }
+ }
+
+ return ""
+}
+
+proc tixFileEntry:config-value {w value} {
+ tixFileEntry:SetValue $w $value
+}
+
+proc tixFileEntry:config-variable {w arg} {
+ upvar #0 $w data
+
+ if [tixVariable:ConfigVariable $w $arg] {
+ # The value of data(-value) is changed if tixVariable:ConfigVariable
+ # returns true
+ tixFileEntry:SetValue $w $data(-value)
+ }
+ catch {
+ unset data(varInited)
+ }
+ set data(-variable) $arg
+}
+
+#----------------------------------------------------------------------
+# User Commands
+#----------------------------------------------------------------------
+proc tixFileEntry:invoke {w} {
+ upvar #0 $w data
+
+ if {[catch {$data(w:entry) index sel.first}] == 0} {
+ # THIS ENTRY OWNS SELECTION --> TURN IT OFF
+ #
+ $data(w:entry) select from end
+ $data(w:entry) select to end
+ }
+
+ tixFileEntry:SetValue $w [$data(w:entry) get]
+}
+
+proc tixFileEntry:filedialog {w args} {
+ upvar #0 $w data
+
+ if {$args == ""} {
+ return [tix filedialog $data(-dialogtype)]
+ } else {
+ return [eval [tix filedialog $data(-dialogtype)] $args]
+ }
+}
+
+proc tixFileEntry:update {w} {
+ upvar #0 $w data
+
+ if {"x[$data(w:entry) get]" != "x$data(-value)"} {
+ tixFileEntry:invoke $w
+ }
+}
+#----------------------------------------------------------------------
+# Internal Commands
+#----------------------------------------------------------------------
+proc tixFileEntry:OpenFile {w} {
+ upvar #0 $w data
+
+ if {$data(-activatecmd) != ""} {
+ uplevel #0 $data(-activatecmd)
+ }
+
+ set filedlg [tix filedialog $data(-dialogtype)]
+
+
+ $filedlg config -parent [winfo toplevel $w] \
+ -command "tixFileEntry:FileDlgCallback $w"
+
+ focus $data(w:entry)
+
+ $filedlg popup
+}
+
+proc tixFileEntry:FileDlgCallback {w args} {
+ set filename [tixEvent flag V]
+
+ tixFileEntry:SetValue $w $filename
+}
+
+proc tixFileEntry:SetValue {w value} {
+ upvar #0 $w data
+
+ if {$data(-validatecmd) != ""} {
+ set value [tixEvalCmdBinding $w $data(-validatecmd) "" $value]
+ }
+
+ if {$data(-state) == "normal"} {
+ $data(w:entry) delete 0 end
+ $data(w:entry) insert 0 $value
+ $data(w:entry) xview end
+ }
+
+ set data(-value) $value
+
+ tixVariable:UpdateVariable $w
+
+ if {$data(-command) != "" && !$data(-disablecallback)} {
+ if {![info exists data(varInited)]} {
+ set bind(specs) ""
+ tixEvalCmdBinding $w $data(-command) bind $value
+ }
+ }
+}
+
+proc tixFileEntry:Destructor {w} {
+ upvar #0 $w data
+
+ tixUnsetMegaWidget $data(w:entry)
+ tixVariable:DeleteVariable $w
+
+ # Chain this to the superclass
+ #
+ tixChainMethod $w Destructor
+}
diff --git a/tix/library/FileUtil.tcl b/tix/library/FileUtil.tcl
new file mode 100644
index 00000000000..319d9878e6d
--- /dev/null
+++ b/tix/library/FileUtil.tcl
@@ -0,0 +1,92 @@
+# FileUtil.tcl ---
+#
+#
+# Utility functions for filename handling.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc tixResolveDir {dir} {
+ set dir [tixFile tildesubst $dir]
+ set dir [tixFile trimslash $dir]
+
+ if {$dir == "/"} {
+ return $dir
+ }
+
+ if {[string index $dir 0] != "/"} {
+ # Isn't an absolute path
+ #
+ set appPWD [pwd]
+ catch {
+ cd $dir
+ set dir [pwd]
+ }
+ cd $appPWD
+ return $dir
+ }
+
+ set names [split $dir "/"]
+
+ # Get rid of all "."
+ set n /
+ foreach name [lrange $names 1 end] {
+ if {[string compare "." $name]} {
+ lappend n $name
+ }
+ }
+ if {$n == "/"} {
+ return /
+ }
+
+ # Get rid of all ".."
+ #
+ set list [tixCompressDotDot $n 0]
+
+ if {$list == "/"} {
+ return /
+ }
+
+ # General case
+ #
+ set dir ""
+ foreach sub [lrange $list 1 end] {
+ append dir /$sub
+ }
+ return $dir
+}
+
+proc tixCompressDotDot {list i} {
+ set done 0
+
+ while {1} {
+ if {$i >= [llength $list]} {
+ return $list
+ }
+
+ if {[lindex $list $i] != ".."} {
+ incr i
+ continue
+ }
+
+ # We encounter a ".."
+ #
+ if {$i == 0} {
+ # Can't handle this
+ #
+ return ""
+ }
+ if {$i == 1} {
+ set l [lindex $list 0]
+ set list [concat $l [lrange $list 2 end]]
+ continue
+ }
+
+ set l [lrange $list 0 [expr $i-2]]
+ set list [concat $l [lrange $list [expr $i+1] end]]
+ incr i -1
+ }
+}
diff --git a/tix/library/FloatEnt.tcl b/tix/library/FloatEnt.tcl
new file mode 100644
index 00000000000..1813a6c8fb4
--- /dev/null
+++ b/tix/library/FloatEnt.tcl
@@ -0,0 +1,126 @@
+# FloatEnt.tcl --
+#
+# An entry widget that can be attached on top of any widget to
+# provide dynamic editing. It is used to provide dynamic editing
+# for the tixGrid widget, among other things.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixFloatEntry {
+ -classname TixFloatEntry
+ -superclass tixPrimitive
+ -method {
+ invoke post unpost
+ }
+ -flag {
+ -command -value
+ }
+ -configspec {
+ {-value value Value ""}
+ {-command command Command ""}
+ }
+ -default {
+ {.entry.highlightThickness 0}
+ }
+}
+
+#----------------------------------------------------------------------
+#
+# Initialization bindings
+#
+#----------------------------------------------------------------------
+
+proc tixFloatEntry:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+}
+
+proc tixFloatEntry:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+ set data(w:entry) [entry $w.entry]
+ pack $data(w:entry) -expand yes -fill both
+}
+
+proc tixFloatEntry:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+ tixBind $data(w:entry) <Return> "tixFloatEntry:invoke $w"
+}
+
+#----------------------------------------------------------------------
+#
+# Class bindings
+#
+#----------------------------------------------------------------------
+
+proc tixFloatEntryBind {} {
+ tixBind TixFloatEntry <FocusIn> {
+ if {![tixStrEq [focus -displayof [set %W(w:entry)]] [set %W(w:entry)]]} {
+ focus [%W subwidget entry]
+ [set %W(w:entry)] selection from 0
+ [set %W(w:entry)] selection to end
+ [set %W(w:entry)] icursor end
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+#
+# Public methods
+#
+#----------------------------------------------------------------------
+proc tixFloatEntry:post {w x y {width ""} {height ""}} {
+ upvar #0 $w data
+
+ if {$width == ""} {
+ set width [winfo reqwidth $data(w:entry)]
+ }
+ if {$height == ""} {
+ set height [winfo reqheight $data(w:entry)]
+ }
+
+ place $w -x $x -y $y -width $width -height $height -bordermode ignore
+ raise $w
+ focus $data(w:entry)
+}
+
+proc tixFloatEntry:unpost {w} {
+ upvar #0 $w data
+
+ place forget $w
+}
+
+proc tixFloatEntry:config-value {w val} {
+ upvar #0 $w data
+
+ $data(w:entry) delete 0 end
+ $data(w:entry) insert 0 $val
+
+ $data(w:entry) selection from 0
+ $data(w:entry) selection to end
+ $data(w:entry) icursor end
+}
+#----------------------------------------------------------------------
+#
+# Private methods
+#
+#----------------------------------------------------------------------
+
+proc tixFloatEntry:invoke {w} {
+ upvar #0 $w data
+
+ if ![tixStrEq $data(-command) ""] {
+ set bind(specs) {%V}
+ set bind(%V) [$data(w:entry) get]
+
+ tixEvalCmdBinding $w $data(-command) bind $bind(%V)
+ }
+}
diff --git a/tix/library/Grid.tcl b/tix/library/Grid.tcl
new file mode 100644
index 00000000000..4dd37d07528
--- /dev/null
+++ b/tix/library/Grid.tcl
@@ -0,0 +1,1113 @@
+# Grid.tcl --
+#
+# This file defines the default bindings for Tix Grid widgets.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# 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:
+#
+# afterId - Token returned by "after" for autoscanning.
+# fakeRelease - Cancel the ButtonRelease-1 after the user double click
+#--------------------------------------------------------------------------
+#
+proc tixGridBind {} {
+ tixBind TixGrid <ButtonPress-1> {
+ tixGrid:Button-1 %W %x %y
+ }
+ tixBind TixGrid <Shift-ButtonPress-1> {
+ tixGrid:Shift-Button-1 %W %x %y
+ }
+ tixBind TixGrid <Control-ButtonPress-1> {
+ tixGrid:Control-Button-1 %W %x %y
+ }
+ tixBind TixGrid <ButtonRelease-1> {
+ tixGrid:ButtonRelease-1 %W %x %y
+ }
+ tixBind TixGrid <Double-ButtonPress-1> {
+ tixGrid:Double-1 %W %x %y
+ }
+ tixBind TixGrid <B1-Motion> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ set tkPriv(X) %X
+ set tkPriv(Y) %Y
+
+ tixGrid:B1-Motion %W %x %y
+ }
+ tixBind TixGrid <Control-B1-Motion> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ set tkPriv(X) %X
+ set tkPriv(Y) %Y
+
+ tixGrid:Control-B1-Motion %W %x %y
+ }
+ tixBind TixGrid <B1-Leave> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ set tkPriv(X) %X
+ set tkPriv(Y) %Y
+
+ tixGrid:B1-Leave %W
+ }
+ tixBind TixGrid <B1-Enter> {
+ tixGrid:B1-Enter %W %x %y
+ }
+ tixBind TixGrid <Control-B1-Leave> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ set tkPriv(X) %X
+ set tkPriv(Y) %Y
+
+ tixGrid:Control-B1-Leave %W
+ }
+ tixBind TixGrid <Control-B1-Enter> {
+ tixGrid:Control-B1-Enter %W %x %y
+ }
+
+ # Keyboard bindings
+ #
+ tixBind TixGrid <Up> {
+ tixGrid:DirKey %W up
+ }
+ tixBind TixGrid <Down> {
+ tixGrid:DirKey %W down
+ }
+ tixBind TixGrid <Left> {
+ tixGrid:DirKey %W left
+ }
+ tixBind TixGrid <Right> {
+ tixGrid:DirKey %W right
+ }
+ tixBind TixGrid <Prior> {
+ %W yview scroll -1 pages
+ }
+ tixBind TixGrid <Next> {
+ %W yview scroll 1 pages
+ }
+ tixBind TixGrid <Return> {
+ tixGrid:Return %W
+ }
+ tixBind TixGrid <space> {
+ tixGrid:Space %W
+ }
+}
+
+#----------------------------------------------------------------------
+#
+#
+# Mouse bindings
+#
+#
+#----------------------------------------------------------------------
+
+proc tixGrid:Button-1 {w x y} {
+ if {[$w cget -state] == "disabled"} {
+ return
+ }
+ tixGrid:SetFocus $w
+
+ case [tixGrid:GetState $w] {
+ {0} {
+ tixGrid:GoState 1 $w $x $y
+ }
+ }
+}
+
+proc tixGrid:Shift-Button-1 {w x y} {
+ if {[$w cget -state] == "disabled"} {
+ return
+ }
+ tixGrid:SetFocus $w
+
+ case [tixGrid:GetState $w] {
+ }
+}
+
+proc tixGrid:Control-Button-1 {w x y} {
+ if {[$w cget -state] == "disabled"} {
+ return
+ }
+ tixGrid:SetFocus $w
+
+ case [tixGrid:GetState $w] {
+ {s0} {
+ tixGrid:GoState s1 $w $x $y
+ }
+ {b0} {
+ tixGrid:GoState b1 $w $x $y
+ }
+ {m0} {
+ tixGrid:GoState m1 $w $x $y
+ }
+ {e0} {
+ tixGrid:GoState e10 $w $x $y
+ }
+ }
+}
+
+proc tixGrid:ButtonRelease-1 {w x y} {
+ case [tixGrid:GetState $w] {
+ {2} {
+ tixGrid:GoState 5 $w $x $y
+ }
+ {4} {
+ tixGrid:GoState 3 $w $x $y
+ }
+ }
+}
+
+proc tixGrid:B1-Motion {w x y} {
+ case [tixGrid:GetState $w] {
+ {2 4} {
+ tixGrid:GoState 4 $w $x $y
+ }
+ }
+}
+
+proc tixGrid:Control-B1-Motion {w x y} {
+ case [tixGrid:GetState $w] {
+ {s2 s4} {
+ tixGrid:GoState s4 $w $x $y
+ }
+ {b2 b4} {
+ tixGrid:GoState b4 $w $x $y
+ }
+ {m2 m5} {
+ tixGrid:GoState m4 $w $x $y
+ }
+ }
+}
+
+proc tixGrid:Double-1 {w x y} {
+ case [tixGrid:GetState $w] {
+ {s0} {
+ tixGrid:GoState s7 $w $x $y
+ }
+ {b0} {
+ tixGrid:GoState b7 $w $x $y
+ }
+ }
+}
+
+proc tixGrid:B1-Leave {w} {
+ case [tixGrid:GetState $w] {
+ {s2 s4} {
+ tixGrid:GoState s5 $w
+ }
+ {b2 b4} {
+ tixGrid:GoState b5 $w
+ }
+ {m2 m5} {
+ tixGrid:GoState m8 $w
+ }
+ {e2 e5} {
+ tixGrid:GoState e8 $w
+ }
+ }
+}
+
+proc tixGrid:B1-Enter {w x y} {
+ case [tixGrid:GetState $w] {
+ {s5 s6} {
+ tixGrid:GoState s4 $w $x $y
+ }
+ {b5 b6} {
+ tixGrid:GoState b4 $w $x $y
+ }
+ {m8 m9} {
+ tixGrid:GoState m4 $w $x $y
+ }
+ {e8 e9} {
+ tixGrid:GoState e4 $w $x $y
+ }
+ }
+}
+
+proc tixGrid:Control-B1-Leave {w} {
+ case [tixGrid:GetState $w] {
+ {s2 s4} {
+ tixGrid:GoState s5 $w
+ }
+ {b2 b4} {
+ tixGrid:GoState b5 $w
+ }
+ {m2 m5} {
+ tixGrid:GoState m8 $w
+ }
+ }
+}
+
+proc tixGrid:Control-B1-Enter {w x y} {
+ case [tixGrid:GetState $w] {
+ {s5 s6} {
+ tixGrid:GoState s4 $w $x $y
+ }
+ {b5 b6} {
+ tixGrid:GoState b4 $w $x $y
+ }
+ {m8 m9} {
+ tixGrid:GoState m4 $w $x $y
+ }
+ }
+}
+
+proc tixGrid:AutoScan {w} {
+ case [tixGrid:GetState $w] {
+ {s5 s6} {
+ tixGrid:GoState s6 $w
+ }
+ {b5 b6} {
+ tixGrid:GoState b6 $w
+ }
+ {m8 m9} {
+ tixGrid:GoState m9 $w
+ }
+ {e8 e9} {
+ tixGrid:GoState e9 $w
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+#
+#
+# Key bindings
+#
+#
+#----------------------------------------------------------------------
+proc tixGrid:DirKey {w key} {
+ if {[$w cget -state] == "disabled"} {
+ return
+ }
+ case [tixGrid:GetState $w] {
+ {s0} {
+ tixGrid:GoState s8 $w $key
+ }
+ {b0} {
+ tixGrid:GoState b8 $w $key
+ }
+ }
+}
+
+proc tixGrid:Return {w} {
+ if {[$w cget -state] == "disabled"} {
+ return
+ }
+ case [tixGrid:GetState $w] {
+ {s0} {
+ tixGrid:GoState s9 $w
+ }
+ {b0} {
+ tixGrid:GoState b9 $w
+ }
+ }
+}
+
+proc tixGrid:Space {w} {
+ if {[$w cget -state] == "disabled"} {
+ return
+ }
+ case [tixGrid:GetState $w] {
+ {s0} {
+ tixGrid:GoState s10 $w
+ }
+ {b0} {
+ tixGrid:GoState b10 $w
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+#
+# STATE MANIPULATION
+#
+#
+#----------------------------------------------------------------------
+proc tixGrid:GetState {w} {
+ global $w:priv:state
+
+ if {![info exists $w:priv:state]} {
+ set $w:priv:state 0
+ }
+ return [set $w:priv:state]
+}
+
+proc tixGrid:SetState {w n} {
+ global $w:priv:state
+
+ set $w:priv:state $n
+}
+
+proc tixGrid:GoState {n w args} {
+
+# puts "going from [tixGrid:GetState $w] --> $n"
+
+ tixGrid:SetState $w $n
+ eval tixGrid:GoState-$n $w $args
+}
+
+#----------------------------------------------------------------------
+# SELECTION ROUTINES
+#----------------------------------------------------------------------
+proc tixGrid:SelectSingle {w ent} {
+ $w selection set [lindex $ent 0] [lindex $ent 1]
+ tixGrid:CallBrowseCmd $w $ent
+}
+
+#----------------------------------------------------------------------
+# SINGLE SELECTION
+#----------------------------------------------------------------------
+proc tixGrid:GoState-0 {w} {
+ set list $w:_list
+ global $list
+
+ if [info exists $list] {
+ foreach cmd [set $list] {
+ uplevel #0 $cmd
+ }
+ if [info exists $list] {
+ unset $list
+ }
+ }
+}
+
+proc tixGrid:GoState-1 {w x y} {
+ set ent [$w nearest $x $y]
+ if {$ent != ""} {
+ tixGrid:SetAnchor $w $ent
+ }
+ tixGrid:CheckEdit $w
+ $w selection clear 0 0 max max
+
+ if [string compare [$w cget -selectmode] single] {
+ tixGrid:SelectSingle $w $ent
+ }
+ tixGrid:GoState 2 $w
+}
+
+proc tixGrid:GoState-2 {w} {
+}
+
+proc tixGrid:GoState-3 {w x y} {
+ set ent [$w nearest $x $y]
+
+ if {$ent != ""} {
+ tixGrid:SelectSingle $w $ent
+ }
+ tixGrid:GoState 0 $w
+}
+
+proc tixGrid:GoState-5 {w x y} {
+ set ent [$w nearest $x $y]
+
+ if {$ent != ""} {
+ tixGrid:SelectSingle $w $ent
+ tixGrid:SetEdit $w $ent
+ }
+ tixGrid:GoState 0 $w
+}
+
+
+proc tixGrid:GoState-4 {w x y} {
+ set ent [$w nearest $x $y]
+
+ case [$w cget -selectmode] {
+ single {
+ tixGrid:SetAnchor $w $ent
+ }
+ browse {
+ tixGrid:SetAnchor $w $ent
+ $w selection clear 0 0 max max
+ tixGrid:SelectSingle $w $ent
+ }
+ {multiple extended} {
+ set anchor [$w anchor get]
+ $w selection adjust [lindex $anchor 0] [lindex $anchor 1] \
+ [lindex $ent 0] [lindex $ent 1]
+ }
+ }
+}
+
+proc tixGrid:GoState-s5 {w} {
+ tixGrid:StartScan $w
+}
+
+proc tixGrid:GoState-s6 {w} {
+ global tkPriv
+
+ tixGrid:DoScan $w
+}
+
+proc tixGrid:GoState-s7 {w x y} {
+ set ent [$w nearest $x $y]
+
+ if {$ent != ""} {
+ $w selection clear
+ $w selection set $ent
+ tixGrid:CallCommand $w $ent
+ }
+ tixGrid:GoState s0 $w
+}
+
+proc tixGrid:GoState-s8 {w key} {
+ set anchor [$w info anchor]
+
+ if {$anchor == ""} {
+ set anchor 0
+ } else {
+ set anchor [$w info $key $anchor]
+ }
+
+ $w anchor set $anchor
+ $w see $anchor
+ tixGrid:GoState s0 $w
+}
+
+proc tixGrid:GoState-s9 {w} {
+ set anchor [$w info anchor]
+
+ if {$anchor == ""} {
+ set anchor 0
+ $w anchor set $anchor
+ $w see $anchor
+ }
+
+ if {[$w info anchor] != ""} {
+ # ! may not have any elements
+ #
+ tixGrid:CallCommand $w [$w info anchor]
+ $w selection clear
+ $w selection set $anchor
+ }
+
+ tixGrid:GoState s0 $w
+}
+
+proc tixGrid:GoState-s10 {w} {
+ set anchor [$w info anchor]
+
+ if {$anchor == ""} {
+ set anchor 0
+ $w anchor set $anchor
+ $w see $anchor
+ }
+
+ if {[$w info anchor] != ""} {
+ # ! may not have any elements
+ #
+ tixGrid:CallBrowseCmd $w [$w info anchor]
+ $w selection clear
+ $w selection set $anchor
+ }
+
+ tixGrid:GoState s0 $w
+}
+
+#----------------------------------------------------------------------
+# BROWSE SELECTION
+#----------------------------------------------------------------------
+proc tixGrid:GoState-b0 {w} {
+}
+
+proc tixGrid:GoState-b1 {w x y} {
+ set ent [$w nearest $x $y]
+ if {$ent != ""} {
+ $w anchor set $ent
+ $w selection clear
+ $w selection set $ent
+ tixGrid:CallBrowseCmd $w $ent
+ }
+ tixGrid:GoState b2 $w
+}
+
+proc tixGrid:GoState-b2 {w} {
+}
+
+proc tixGrid:GoState-b3 {w} {
+ set ent [$w info anchor]
+ if {$ent != ""} {
+ $w selection clear
+ $w selection set $ent
+ tixGrid:CallBrowseCmd $w $ent
+ }
+ tixGrid:GoState b0 $w
+}
+
+proc tixGrid:GoState-b4 {w x y} {
+ set ent [$w nearest $x $y]
+ if {$ent != ""} {
+ $w anchor set $ent
+ $w selection clear
+ $w selection set $ent
+ tixGrid:CallBrowseCmd $w $ent
+ }
+}
+
+proc tixGrid:GoState-b5 {w} {
+ tixGrid:StartScan $w
+}
+
+proc tixGrid:GoState-b6 {w} {
+ global tkPriv
+
+ tixGrid:DoScan $w
+}
+
+proc tixGrid:GoState-b7 {w x y} {
+ set ent [$w nearest $x $y]
+
+ if {$ent != ""} {
+ $w selection clear
+ $w selection set $ent
+ tixGrid:CallCommand $w $ent
+ }
+ tixGrid:GoState b0 $w
+}
+
+proc tixGrid:GoState-b8 {w key} {
+ set anchor [$w info anchor]
+
+ if {$anchor == ""} {
+ set anchor 0
+ } else {
+ set anchor [$w info $key $anchor]
+ }
+
+ $w anchor set $anchor
+ $w selection clear
+ $w selection set $anchor
+ $w see $anchor
+
+ tixGrid:CallBrowseCmd $w $anchor
+ tixGrid:GoState b0 $w
+}
+
+proc tixGrid:GoState-b9 {w} {
+ set anchor [$w info anchor]
+
+ if {$anchor == ""} {
+ set anchor 0
+ $w anchor set $anchor
+ $w see $anchor
+ }
+
+ if {[$w info anchor] != ""} {
+ # ! may not have any elements
+ #
+ tixGrid:CallCommand $w [$w info anchor]
+ $w selection clear
+ $w selection set $anchor
+ }
+
+ tixGrid:GoState b0 $w
+}
+
+proc tixGrid:GoState-b10 {w} {
+ set anchor [$w info anchor]
+
+ if {$anchor == ""} {
+ set anchor 0
+ $w anchor set $anchor
+ $w see $anchor
+ }
+
+ if {[$w info anchor] != ""} {
+ # ! may not have any elements
+ #
+ tixGrid:CallBrowseCmd $w [$w info anchor]
+ $w selection clear
+ $w selection set $anchor
+ }
+
+ tixGrid:GoState b0 $w
+}
+
+#----------------------------------------------------------------------
+# MULTIPLE SELECTION
+#----------------------------------------------------------------------
+proc tixGrid:GoState-m0 {w} {
+}
+
+proc tixGrid:GoState-m1 {w x y} {
+ set ent [$w nearest $x $y]
+ if {$ent != ""} {
+ $w anchor set $ent
+ $w selection clear
+ $w selection set $ent
+ tixGrid:CallBrowseCmd $w $ent
+ }
+ tixGrid:GoState m2 $w
+}
+
+proc tixGrid:GoState-m2 {w} {
+}
+
+proc tixGrid:GoState-m3 {w} {
+ set ent [$w info anchor]
+ if {$ent != ""} {
+ tixGrid:CallBrowseCmd $w $ent
+ }
+ tixGrid:GoState m0 $w
+}
+
+proc tixGrid:GoState-m4 {w x y} {
+ set from [$w info anchor]
+ set to [$w nearest $x $y]
+ if {$to != ""} {
+ $w selection clear
+ $w selection set $from $to
+ tixGrid:CallBrowseCmd $w $to
+ }
+ tixGrid:GoState m5 $w
+}
+
+proc tixGrid:GoState-m5 {w} {
+}
+
+proc tixGrid:GoState-m6 {w x y} {
+ set ent [$w nearest $x $y]
+ if {$ent != ""} {
+ tixGrid:CallBrowseCmd $w $ent
+ }
+ tixGrid:GoState m0 $w
+}
+
+proc tixGrid:GoState-m7 {w x y} {
+ set from [$w info anchor]
+ set to [$w nearest $x $y]
+ if {$from == ""} {
+ set from $to
+ $w anchor set $from
+ }
+ if {$to != ""} {
+ $w selection clear
+ $w selection set $from $to
+ tixGrid:CallBrowseCmd $w $to
+ }
+ tixGrid:GoState m5 $w
+}
+
+
+proc tixGrid:GoState-m8 {w} {
+ tixGrid:StartScan $w
+}
+
+proc tixGrid:GoState-m9 {w} {
+ tixGrid:DoScan $w
+}
+
+proc tixGrid:GoState-xm7 {w x y} {
+ set ent [$w nearest $x $y]
+
+ if {$ent != ""} {
+ $w selection clear
+ $w selection set $ent
+ tixGrid:CallCommand $w $ent
+ }
+ tixGrid:GoState m0 $w
+}
+
+#----------------------------------------------------------------------
+# EXTENDED SELECTION
+#----------------------------------------------------------------------
+proc tixGrid:GoState-e0 {w} {
+}
+
+proc tixGrid:GoState-e1 {w x y} {
+ set ent [$w nearest $x $y]
+ if {$ent != ""} {
+ $w anchor set $ent
+ $w selection clear
+ $w selection set $ent
+ tixGrid:CallBrowseCmd $w $ent
+ }
+ tixGrid:GoState e2 $w
+}
+
+proc tixGrid:GoState-e2 {w} {
+}
+
+proc tixGrid:GoState-e3 {w} {
+ set ent [$w info anchor]
+ if {$ent != ""} {
+ tixGrid:CallBrowseCmd $w $ent
+ }
+ tixGrid:GoState e0 $w
+}
+
+proc tixGrid:GoState-e4 {w x y} {
+ set from [$w info anchor]
+ set to [$w nearest $x $y]
+ if {$to != ""} {
+ $w selection clear
+ $w selection set $from $to
+ tixGrid:CallBrowseCmd $w $to
+ }
+ tixGrid:GoState e5 $w
+}
+
+proc tixGrid:GoState-e5 {w} {
+}
+
+proc tixGrid:GoState-e6 {w x y} {
+ set ent [$w nearest $x $y]
+ if {$ent != ""} {
+ tixGrid:CallBrowseCmd $w $ent
+ }
+ tixGrid:GoState e0 $w
+}
+
+proc tixGrid:GoState-e7 {w x y} {
+ set from [$w info anchor]
+ set to [$w nearest $x $y]
+ if {$from == ""} {
+ set from $to
+ $w anchor set $from
+ }
+ if {$to != ""} {
+ $w selection clear
+ $w selection set $from $to
+ tixGrid:CallBrowseCmd $w $to
+ }
+ tixGrid:GoState e5 $w
+}
+
+
+proc tixGrid:GoState-e8 {w} {
+ tixGrid:StartScan $w
+}
+
+proc tixGrid:GoState-e9 {w} {
+ tixGrid:DoScan $w
+}
+
+proc tixGrid:GoState-e10 {w x y} {
+ set ent [$w nearest $x $y]
+ if {$ent != ""} {
+ if {[$w info anchor] == ""} {
+ $w anchor set $ent
+ }
+ if [$w selection includes $ent] {
+ $w selection clear $ent
+ } else {
+ $w selection set $ent
+ }
+ tixGrid:CallBrowseCmd $w $ent
+ }
+ tixGrid:GoState e2 $w
+}
+
+proc tixGrid:GoState-xm7 {w x y} {
+ set ent [$w nearest $x $y]
+
+ if {$ent != ""} {
+ $w selection clear
+ $w selection set $ent
+ tixGrid:CallCommand $w $ent
+ }
+ tixGrid:GoState e0 $w
+}
+
+#----------------------------------------------------------------------
+# HODGE PODGE
+#----------------------------------------------------------------------
+
+proc tixGrid:GoState-12 {w x y} {
+ tkCancelRepeat
+ tixGrid:GoState 5 $w $x $y
+}
+
+proc tixGrid:GoState-13 {w ent oldEnt} {
+ global tkPriv
+ set tkPriv(tix,indicator) $ent
+ set tkPriv(tix,oldEnt) $oldEnt
+ tixGrid:IndicatorCmd $w <Arm> $ent
+}
+
+proc tixGrid:GoState-14 {w x y} {
+ global tkPriv
+
+ if [tixGrid:InsideArmedIndicator $w $x $y] {
+ $w anchor set $tkPriv(tix,indicator)
+ $w select clear
+ $w select set $tkPriv(tix,indicator)
+ tixGrid:IndicatorCmd $w <Activate> $tkPriv(tix,indicator)
+ } else {
+ tixGrid:IndicatorCmd $w <Disarm> $tkPriv(tix,indicator)
+ }
+
+ unset tkPriv(tix,indicator)
+ tixGrid:GoState 0 $w
+}
+
+proc tixGrid:GoState-16 {w ent} {
+ if {$ent == ""} {
+ return
+ }
+ if {[$w cget -selectmode] != "single"} {
+ tixGrid:Select $w $ent
+ tixGrid:Browse $w $ent
+ }
+}
+
+proc tixGrid:GoState-18 {w} {
+ global tkPriv
+ tkCancelRepeat
+ tixGrid:GoState 6 $w $tkPriv(x) $tkPriv(y)
+}
+
+proc tixGrid:GoState-20 {w x y} {
+ global tkPriv
+
+ if {![tixGrid:InsideArmedIndicator $w $x $y]} {
+ tixGrid:GoState 21 $w $x $y
+ } else {
+ tixGrid:IndicatorCmd $w <Arm> $tkPriv(tix,indicator)
+ }
+}
+
+proc tixGrid:GoState-21 {w x y} {
+ global tkPriv
+
+ if {[tixGrid:InsideArmedIndicator $w $x $y]} {
+ tixGrid:GoState 20 $w $x $y
+ } else {
+ tixGrid:IndicatorCmd $w <Disarm> $tkPriv(tix,indicator)
+ }
+}
+
+proc tixGrid:GoState-22 {w} {
+ global tkPriv
+
+ if {$tkPriv(tix,oldEnt) != ""} {
+ $w anchor set $tkPriv(tix,oldEnt)
+ } else {
+ $w anchor clear
+ }
+ tixGrid:GoState 0 $w
+}
+
+
+#----------------------------------------------------------------------
+# callback actions
+#----------------------------------------------------------------------
+proc tixGrid:SetAnchor {w ent} {
+ if [string compare $ent ""] {
+ $w anchor set [lindex $ent 0] [lindex $ent 1]
+# $w see $ent
+ }
+}
+
+proc tixGrid:Select {w ent} {
+ $w selection clear
+ $w select set $ent
+}
+
+proc tixGrid:StartScan {w} {
+ global tkPriv
+ set tkPriv(afterId) [after 50 tixGrid:AutoScan $w]
+}
+
+proc tixGrid:DoScan {w} {
+ global tkPriv
+ set x $tkPriv(x)
+ set y $tkPriv(y)
+ set X $tkPriv(X)
+ set Y $tkPriv(Y)
+
+ set out 0
+ if {$y >= [winfo height $w]} {
+ $w yview scroll 1 units
+ set out 1
+ }
+ if {$y < 0} {
+ $w yview scroll -1 units
+ set out 1
+ }
+ if {$x >= [winfo width $w]} {
+ $w xview scroll 2 units
+ set out 1
+ }
+ if {$x < 0} {
+ $w xview scroll -2 units
+ set out 1
+ }
+
+ if {$out} {
+ set tkPriv(afterId) [after 50 tixGrid:AutoScan $w]
+ }
+}
+
+proc tixGrid:CallBrowseCmd {w ent} {
+ return
+
+ set browsecmd [$w cget -browsecmd]
+ if {$browsecmd != ""} {
+ set bind(specs) {%V}
+ set bind(%V) $ent
+
+ tixEvalCmdBinding $w $browsecmd bind $ent
+ }
+}
+
+proc tixGrid:CallCommand {w ent} {
+ set command [$w cget -command]
+ if {$command != ""} {
+ set bind(specs) {%V}
+ set bind(%V) $ent
+
+ tixEvalCmdBinding $w $command bind $ent
+ }
+}
+
+# tixGrid:EditCell --
+#
+# This command is called when "$w edit set $x $y" is called. It causes
+# an SetEdit call when the grid's state is 0.
+#
+proc tixGrid:EditCell {w x y} {
+ set list $w:_list
+ global $list
+
+ case [tixGrid:GetState $w] {
+ {0} {
+ tixGrid:SetEdit $w [list $x $y]
+ }
+ default {
+ lappend $list [list tixGrid:SetEdit $w [list $x $y]]
+ }
+ }
+}
+
+# tixGrid:EditApply --
+#
+# This command is called when "$w edit apply $x $y" is called. It causes
+# an CheckEdit call when the grid's state is 0.
+#
+proc tixGrid:EditApply {w} {
+ set list $w:_list
+ global $list
+
+ case [tixGrid:GetState $w] {
+ {0} {
+ tixGrid:CheckEdit $w
+ }
+ default {
+ lappend $list [list tixGrid:CheckEdit $w]
+ }
+ }
+}
+
+# tixGrid:CheckEdit --
+#
+# This procedure is called when the user sets the focus on a cell.
+# If another cell is being edited, apply the changes of that cell.
+#
+proc tixGrid:CheckEdit {w} {
+ set edit $w.tixpriv__edit
+ if [winfo exists $edit] {
+ #
+ # If it -command is not empty, it is being used for another cell.
+ # Invoke it so that the other cell can be updated.
+ #
+ if ![tixStrEq [$edit cget -command] ""] {
+ $edit invoke
+ }
+ }
+}
+
+# tixGrid:SetEdit --
+#
+# Puts a floatentry on top of an editable entry.
+#
+proc tixGrid:SetEdit {w ent} {
+ set edit $w.tixpriv__edit
+ tixGrid:CheckEdit $w
+
+ set editnotifycmd [$w cget -editnotifycmd]
+ if [tixStrEq $editnotifycmd ""] {
+ return
+ }
+ set px [lindex $ent 0]
+ set py [lindex $ent 1]
+
+ if ![uplevel #0 $editnotifycmd $px $py] {
+ return
+ }
+ if [$w info exists $px $py] {
+ if [catch {
+ set oldValue [$w entrycget $px $py -text]
+ }] {
+ # The entry doesn't support -text option. Can't edit it.
+ #
+ # If the application wants to force editing of an entry, it could
+ # delete or replace the entry in the editnotifyCmd procedure.
+ #
+ return
+ }
+ } else {
+ set oldValue ""
+ }
+
+ set bbox [$w info bbox [lindex $ent 0] [lindex $ent 1]]
+ set x [lindex $bbox 0]
+ set y [lindex $bbox 1]
+ set W [lindex $bbox 2]
+ set H [lindex $bbox 3]
+
+ if ![winfo exists $edit] {
+ tixFloatEntry $edit
+ }
+
+ $edit config -command "tixGrid:DoneEdit $w $ent"
+ $edit post $x $y $W $H
+
+ $edit config -value $oldValue
+}
+
+proc tixGrid:DoneEdit {w x y args} {
+ set edit $w.tixpriv__edit
+ $edit config -command ""
+ $edit unpost
+
+ set value [tixEvent value]
+ if [$w info exists $x $y] {
+ if [catch {
+ $w entryconfig $x $y -text $value
+ }] {
+ return
+ }
+ } elseif ![tixStrEq $value ""] {
+ if [catch {
+ # This needs to be catch'ed because the default itemtype may
+ # not support the -text option
+ #
+ $w set $x $y -text $value
+ }] {
+ return
+ }
+ } else {
+ return
+ }
+
+ set editDoneCmd [$w cget -editdonecmd]
+ if ![tixStrEq $editDoneCmd ""] {
+ uplevel #0 $editDoneCmd $x $y
+ }
+}
+
+proc tixGrid:SetFocus {w} {
+ if [$w cget -takefocus] {
+ if ![string match $w.* [focus -displayof $w]] {
+ focus $w
+ }
+ }
+}
diff --git a/tix/library/HList.tcl b/tix/library/HList.tcl
new file mode 100644
index 00000000000..bac1914d532
--- /dev/null
+++ b/tix/library/HList.tcl
@@ -0,0 +1,841 @@
+# HList.tcl --
+#
+# This file defines the default bindings for Tix Hierarchical Listbox
+# widgets.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# 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:
+#
+# afterId - Token returned by "after" for autoscanning.
+# fakeRelease - Cancel the ButtonRelease-1 after the user double click
+#--------------------------------------------------------------------------
+#
+proc tixHListBind {} {
+ tixBind TixHList <ButtonPress-1> {
+ tixHList:Button-1 %W %x %y ""
+ }
+ tixBind TixHList <Shift-ButtonPress-1> {
+ tixHList:Button-1 %W %x %y s
+ }
+ tixBind TixHList <Control-ButtonPress-1> {
+ tixHList:Button-1 %W %x %y c
+ }
+ tixBind TixHList <ButtonRelease-1> {
+ tixHList:ButtonRelease-1 %W %x %y
+ }
+ tixBind TixHList <Double-ButtonPress-1> {
+ tixHList:Double-1 %W %x %y
+ }
+ tixBind TixHList <B1-Motion> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ set tkPriv(X) %X
+ set tkPriv(Y) %Y
+
+ tixHList:B1-Motion %W %x %y
+ }
+ tixBind TixHList <B1-Leave> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ set tkPriv(X) %X
+ set tkPriv(Y) %Y
+
+ tixHList:B1-Leave %W
+ }
+ tixBind TixHList <B1-Enter> {
+ tixHList:B1-Enter %W %x %y
+ }
+
+ # Keyboard bindings
+ #
+ tixBind TixHList <Up> {
+ tixHList:UpDown %W prev ""
+ }
+ tixBind TixHList <Down> {
+ tixHList:UpDown %W next ""
+ }
+ tixBind TixHList <Shift-Up> {
+ tixHList:UpDown %W prev s
+ }
+ tixBind TixHList <Shift-Down> {
+ tixHList:UpDown %W next s
+ }
+ tixBind TixHList <Left> {
+ tixHList:LeftRight %W left
+ }
+ tixBind TixHList <Right> {
+ tixHList:LeftRight %W right
+ }
+ tixBind TixHList <Prior> {
+ %W yview scroll -1 pages
+ }
+ tixBind TixHList <Next> {
+ %W yview scroll 1 pages
+ }
+ tixBind TixHList <Return> {
+ tixHList:Keyboard-Activate %W
+ }
+ tixBind TixHList <space> {
+ tixHList:Keyboard-Browse %W
+ }
+}
+
+#----------------------------------------------------------------------
+#
+#
+# Key bindings
+#
+#
+#----------------------------------------------------------------------
+proc tixHList:Keyboard-Activate {w} {
+ if {[tixHList:GetState $w] != 0} {
+ return
+ }
+ set ent [$w info anchor]
+
+ if {$ent == ""} {
+ return
+ }
+
+ if {[$w cget -selectmode] == "single"} {
+ $w select clear
+ $w select set $ent
+ }
+
+ set command [$w cget -command]
+ if {$command != ""} {
+ set bind(specs) {%V}
+ set bind(%V) $ent
+
+ tixEvalCmdBinding $w $command bind $ent
+ }
+}
+
+proc tixHList:Keyboard-Browse {w} {
+ if {[tixHList:GetState $w] != 0} {
+ return
+ }
+ set ent [$w info anchor]
+
+ if {$ent == ""} {
+ return
+ }
+
+ if {[$w cget -selectmode] == "single"} {
+ $w select clear
+ $w select set $ent
+ }
+
+ tixHList:Browse $w $ent
+}
+
+proc tixHList:LeftRight {w spec} {
+ catch {
+ uplevel #0 unset $w:priv:shiftanchor
+ }
+ if {[tixHList:GetState $w] != 0} {
+ return
+ }
+
+ set anchor [$w info anchor]
+ if {$anchor == ""} {
+ set anchor [lindex [$w info children] 0]
+ }
+ if {$anchor == ""} {
+ return
+ }
+
+ set ent $anchor
+ while {1} {
+ set e $ent
+ if {$spec == "left"} {
+ set ent [$w info parent $e]
+
+ if {$ent == "" || [$w entrycget $ent -state] == "disabled"} {
+ set ent [$w info prev $e]
+ }
+ } else {
+ set ent [lindex [$w info children $e] 0]
+
+ if {$ent == "" || [$w entrycget $ent -state] == "disabled"} {
+ set ent [$w info next $e]
+ }
+ }
+
+ if {$ent == ""} {
+ break
+ }
+ if {[$w entrycget $ent -state] == "disabled"} {
+ continue
+ }
+ if [$w info hidden $ent] {
+ continue
+ }
+ break
+ }
+
+ if {$ent == ""} {
+ return
+ }
+
+ $w anchor set $ent
+ $w see $ent
+
+ if {[$w cget -selectmode] != "single"} {
+ $w select clear
+ $w selection set $ent
+
+ tixHList:Browse $w $ent
+ }
+}
+
+proc tixHList:UpDown {w spec mod} {
+ if {[tixHList:GetState $w] != 0} {
+ return
+ }
+ set anchor [$w info anchor]
+ set done 0
+
+ if {$anchor == ""} {
+ set anchor [lindex [$w info children] 0]
+
+ if {$anchor == ""} {
+ return
+ }
+
+ if {[$w entrycget $anchor -state] != "disabled"} {
+ # That's a good anchor
+ set done 1
+ } else {
+ # We search for the first non-disabled entry (downward)
+ set spec next
+ }
+ }
+
+ set ent $anchor
+ # Find the prev/next non-disabled entry
+ #
+ while {!$done} {
+ set ent [$w info $spec $ent]
+ if {$ent == ""} {
+ break
+ }
+ if {[$w entrycget $ent -state] == "disabled"} {
+ continue
+ }
+ if [$w info hidden $ent] {
+ continue
+ }
+ break
+ }
+
+ if {$ent == ""} {
+ return
+ } else {
+ $w see $ent
+ $w anchor set $ent
+
+ set selMode [$w cget -selectmode]
+ if {$mod == "s" && ($selMode == "extended" || $selMode == "multiple")} {
+ global $w:priv:shiftanchor
+
+ if ![info exists $w:priv:shiftanchor] {
+ set $w:priv:shiftanchor $anchor
+ }
+
+ $w selection clear
+ $w selection set $ent [set $w:priv:shiftanchor]
+
+ tixHList:Browse $w $ent
+ } else {
+ catch {
+ uplevel #0 unset $w:priv:shiftanchor
+ }
+
+ if {[$w cget -selectmode] != "single"} {
+ $w select clear
+ $w selection set $ent
+
+ tixHList:Browse $w $ent
+ }
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+#
+#
+# Mouse bindings
+#
+#
+#----------------------------------------------------------------------
+
+proc tixHList:Button-1 {w x y mod} {
+# if {[$w cget -state] == "disabled"} {
+# return
+# }
+
+ if [$w cget -takefocus] {
+ focus $w
+ }
+
+ set selMode [$w cget -selectmode]
+
+ case [tixHList:GetState $w] {
+ {0} {
+ if {$mod == "s" && $selMode == "multiple"} {
+ tixHList:GoState 28 $w $x $y
+ return
+ }
+ if {$mod == "s" && $selMode == "extended"} {
+ tixHList:GoState 28 $w $x $y
+ return
+ }
+ if {$mod == "c" && $selMode == "extended"} {
+ tixHList:GoState 33 $w $x $y
+ return
+ }
+
+ tixHList:GoState 1 $w $x $y
+ }
+ }
+}
+
+proc tixHList:ButtonRelease-1 {w x y} {
+ case [tixHList:GetState $w] {
+ {5 16} {
+ tixHList:GoState 6 $w $x $y
+ }
+ {15} {
+ tixHList:GoState 17 $w $x $y
+ }
+ {10 11} {
+ tixHList:GoState 18 $w
+ }
+ {13 20} {
+ tixHList:GoState 14 $w $x $y
+ }
+ {21} {
+ tixHList:GoState 22 $w
+ }
+ {24} {
+ tixHList:GoState 25 $w
+ }
+ {26 28 33} {
+ tixHList:GoState 27 $w
+ }
+ {30} {
+ tixHList:GoState 32 $w
+ }
+ }
+}
+
+proc tixHList:Double-1 {w x y} {
+ case [tixHList:GetState $w] {
+ {0} {
+ tixHList:GoState 23 $w $x $y
+ }
+ }
+}
+
+proc tixHList:B1-Motion {w x y} {
+ case [tixHList:GetState $w] {
+ {1} {
+ tixHList:GoState 5 $w $x $y
+ }
+ {5 16} {
+ tixHList:GoState 5 $w $x $y
+ }
+ {13 20 21} {
+ tixHList:GoState 20 $w $x $y
+ }
+ {24 26 28} {
+ tixHList:GoState 26 $w $x $y
+ }
+ }
+}
+
+proc tixHList:B1-Leave {w} {
+ case [tixHList:GetState $w] {
+ {5} {
+ tixHList:GoState 10 $w
+ }
+ {26} {
+ tixHList:GoState 29 $w
+ }
+ }
+}
+
+proc tixHList:B1-Enter {w x y} {
+ case [tixHList:GetState $w] {
+ {10 11} {
+ tixHList:GoState 12 $w $x $y
+ }
+ {29 30} {
+ tixHList:GoState 31 $w $x $y
+ }
+ }
+}
+
+proc tixHList:AutoScan {w} {
+ case [tixHList:GetState $w] {
+ {29 30} {
+ tixHList:GoState 30 $w
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+#
+# STATE MANIPULATION
+#
+#
+#----------------------------------------------------------------------
+proc tixHList:GetState {w} {
+ global $w:priv:state
+
+ if {![info exists $w:priv:state]} {
+ set $w:priv:state 0
+ }
+ return [set $w:priv:state]
+}
+
+proc tixHList:SetState {w n} {
+ global $w:priv:state
+
+ set $w:priv:state $n
+}
+
+proc tixHList:GoState {n w args} {
+
+# puts "going from [tixHList:GetState $w] --> $n"
+
+ tixHList:SetState $w $n
+ eval tixHList:GoState-$n $w $args
+}
+
+#----------------------------------------------------------------------
+# States
+#----------------------------------------------------------------------
+proc tixHList:GoState-0 {w} {
+
+}
+proc tixHList:GoState-1 {w x y} {
+ set oldEnt [$w info anchor]
+ set ent [tixHList:SetAnchor $w $x $y 1]
+
+ if {$ent == ""} {
+ tixHList:GoState 0 $w
+ return
+ }
+
+ set info [$w info item $x $y]
+ if {[lindex $info 1] == "indicator"} {
+ tixHList:GoState 13 $w $ent $oldEnt
+ } else {
+ if {[$w entrycget $ent -state] == "disabled"} {
+ tixHList:GoState 0 $w
+ } else {
+ case [$w cget -selectmode] {
+ {single browse} {
+ tixHList:GoState 16 $w $ent
+ }
+ default {
+ tixHList:GoState 24 $w $ent
+ }
+ }
+ }
+ }
+}
+
+proc tixHList:GoState-5 {w x y} {
+ set oldEnt [$w info anchor]
+
+ set ent [tixHList:SetAnchor $w $x $y]
+
+ if {$ent == "" || $oldEnt == $ent} {
+ return
+ }
+
+ if {[$w cget -selectmode] != "single"} {
+ tixHList:Select $w $ent
+ tixHList:Browse $w $ent
+ }
+}
+
+proc tixHList:GoState-6 {w x y} {
+ set ent [tixHList:SetAnchor $w $x $y]
+
+ if {$ent == ""} {
+ tixHList:GoState 0 $w
+ return
+ }
+ tixHList:Select $w $ent
+ tixHList:Browse $w $ent
+
+ tixHList:GoState 0 $w
+}
+
+proc tixHList:GoState-10 {w} {
+ tixHList:StartScan $w
+}
+
+proc tixHList:GoState-11 {w} {
+ global tkPriv
+
+ tixHList:DoScan $w
+
+ set oldEnt [$w info anchor]
+ set ent [tixHList:SetAnchor $w $tkPriv(x) $tkPriv(y)]
+
+ if {$ent == "" || $oldEnt == $ent} {
+ return
+ }
+
+ if {[$w cget -selectmode] != "single"} {
+ tixHList:Select $w $ent
+ tixHList:Browse $w $ent
+ }
+}
+
+proc tixHList:GoState-12 {w x y} {
+ tkCancelRepeat
+ tixHList:GoState 5 $w $x $y
+}
+
+proc tixHList:GoState-13 {w ent oldEnt} {
+ global tkPriv
+ set tkPriv(tix,indicator) $ent
+ set tkPriv(tix,oldEnt) $oldEnt
+ tixHList:CallIndicatorCmd $w <Arm> $ent
+}
+
+proc tixHList:GoState-14 {w x y} {
+ global tkPriv
+
+ if [tixHList:InsideArmedIndicator $w $x $y] {
+ $w anchor set $tkPriv(tix,indicator)
+ $w select clear
+ $w select set $tkPriv(tix,indicator)
+ tixHList:CallIndicatorCmd $w <Activate> $tkPriv(tix,indicator)
+ } else {
+ tixHList:CallIndicatorCmd $w <Disarm> $tkPriv(tix,indicator)
+ }
+
+ unset tkPriv(tix,indicator)
+ tixHList:GoState 0 $w
+}
+
+proc tixHList:GoState-16 {w ent} {
+ if {$ent != "" && [$w cget -selectmode] != "single"} {
+ tixHList:Select $w $ent
+ tixHList:Browse $w $ent
+ }
+}
+
+proc tixHList:GoState-18 {w} {
+ global tkPriv
+ tkCancelRepeat
+ tixHList:GoState 6 $w $tkPriv(x) $tkPriv(y)
+}
+
+proc tixHList:GoState-20 {w x y} {
+ global tkPriv
+
+ if {![tixHList:InsideArmedIndicator $w $x $y]} {
+ tixHList:GoState 21 $w $x $y
+ } else {
+ tixHList:CallIndicatorCmd $w <Arm> $tkPriv(tix,indicator)
+ }
+}
+
+proc tixHList:GoState-21 {w x y} {
+ global tkPriv
+
+ if {[tixHList:InsideArmedIndicator $w $x $y]} {
+ tixHList:GoState 20 $w $x $y
+ } else {
+ tixHList:CallIndicatorCmd $w <Disarm> $tkPriv(tix,indicator)
+ }
+}
+
+proc tixHList:GoState-22 {w} {
+ global tkPriv
+
+ if {$tkPriv(tix,oldEnt) != ""} {
+ $w anchor set $tkPriv(tix,oldEnt)
+ } else {
+ $w anchor clear
+ }
+ tixHList:GoState 0 $w
+}
+
+proc tixHList:GoState-23 {w x y} {
+ set ent [tixHList:GetNearest $w $y]
+
+ if {$ent != ""} {
+ set info [$w info item $x $y]
+
+ if {[lindex $info 1] == "indicator"} {
+ tixHList:CallIndicatorCmd $w <Activate> $ent
+ } else {
+ $w select set $ent
+ set command [$w cget -command]
+ if {$command != ""} {
+ set bind(specs) {%V}
+ set bind(%V) $ent
+
+ tixEvalCmdBinding $w $command bind $ent
+ }
+ }
+ }
+ tixHList:GoState 0 $w
+}
+
+proc tixHList:GoState-24 {w ent} {
+ if {$ent != ""} {
+ tixHList:Select $w $ent
+ tixHList:Browse $w $ent
+ }
+}
+
+proc tixHList:GoState-25 {w} {
+ set ent [$w info anchor]
+
+ if {$ent != ""} {
+ tixHList:Select $w $ent
+ tixHList:Browse $w $ent
+ }
+
+ tixHList:GoState 0 $w
+}
+
+
+proc tixHList:GoState-26 {w x y} {
+ set anchor [$w info anchor]
+ if {$anchor == ""} {
+ set first [lindex [$w info children ""] 0]
+ if {$first != ""} {
+ $w anchor set $first
+ set anchor $first
+ } else {
+ return
+ }
+ }
+
+ set ent [tixHList:GetNearest $w $y 1]
+
+ if {$ent != ""} {
+ $w selection clear
+ $w selection set $anchor $ent
+
+ tixHList:Browse $w $ent
+ }
+}
+
+proc tixHList:GoState-27 {w} {
+ set ent [$w info anchor]
+
+ if {$ent != ""} {
+ tixHList:Browse $w $ent
+ }
+
+ tixHList:GoState 0 $w
+}
+
+proc tixHList:GoState-28 {w x y} {
+ set anchor [$w info anchor]
+ if {$anchor == ""} {
+ set first [lindex [$w info children ""] 0]
+ if {$first != ""} {
+ $w anchor set $first
+ set anchor $first
+ } else {
+ return
+ }
+ }
+
+ set ent [tixHList:GetNearest $w $y 1]
+ if {$ent != ""} {
+ $w selection clear
+ $w selection set $anchor $ent
+
+ tixHList:Browse $w $ent
+ }
+}
+
+proc tixHList:GoState-29 {w} {
+ tixHList:StartScan $w
+}
+
+proc tixHList:GoState-30 {w} {
+ global tkPriv
+
+ tixHList:DoScan $w
+
+ set anchor [$w info anchor]
+ if {$anchor == ""} {
+ set first [lindex [$w info children ""] 0]
+ if {$first != ""} {
+ $w anchor set $first
+ set anchor $first
+ } else {
+ return
+ }
+ }
+
+ set ent [tixHList:GetNearest $w $tkPriv(y) 1]
+ if {$ent != ""} {
+ $w selection clear
+ $w selection set $anchor $ent
+
+ tixHList:Browse $w $ent
+ }
+}
+
+proc tixHList:GoState-31 {w x y} {
+ tkCancelRepeat
+ tixHList:GoState 26 $w $x $y
+}
+
+proc tixHList:GoState-32 {w} {
+ tkCancelRepeat
+ tixHList:GoState 0 $w
+}
+
+proc tixHList:GoState-33 {w x y} {
+ set ent [tixHList:GetNearest $w $y]
+ if {$ent != ""} {
+ $w anchor set $ent
+ $w selection set $ent
+ tixHList:Browse $w $ent
+ }
+}
+
+
+#----------------------------------------------------------------------
+#
+# Common actions
+#
+#----------------------------------------------------------------------
+proc tixHList:GetNearest {w y {disableOK 0}} {
+ set ent [$w nearest $y]
+
+ if {$ent != ""} {
+ if {!$disableOK && [$w entrycget $ent -state] == "disabled"} {
+ return ""
+ }
+ }
+
+ return $ent
+}
+
+proc tixHList:SetAnchor {w x y {disableOK 0}} {
+ set ent [tixHList:GetNearest $w $y $disableOK]
+
+ if {$ent != ""} {
+ if {[$w entrycget $ent -state] != "disabled"} {
+ $w anchor set $ent
+ $w see $ent
+ return $ent
+ } elseif $disableOK {
+ return $ent
+ }
+ }
+
+ return ""
+}
+
+proc tixHList:Select {w ent} {
+ if {"x[$w info selection]" != "x$ent"} {
+ $w selection clear
+ $w select set $ent
+ }
+}
+
+#----------------------------------------------------------------------
+#
+# Auto scan
+#
+#----------------------------------------------------------------------
+proc tixHList:StartScan {w} {
+ global tkPriv
+ set tkPriv(afterId) [after 50 tixHList:AutoScan $w]
+}
+
+proc tixHList:DoScan {w} {
+ global tkPriv
+ set x $tkPriv(x)
+ set y $tkPriv(y)
+ set X $tkPriv(X)
+ set Y $tkPriv(Y)
+
+ if {$y >= [winfo height $w]} {
+ $w yview scroll 1 units
+ } elseif {$y < 0} {
+ $w yview scroll -1 units
+ } elseif {$x >= [winfo width $w]} {
+ $w xview scroll 2 units
+ } elseif {$x < 0} {
+ $w xview scroll -2 units
+ } else {
+ return
+ }
+
+ set tkPriv(afterId) [after 50 tixHList:AutoScan $w]
+}
+
+
+#----------------------------------------------------------------------
+#
+# Indicator handling
+#
+#----------------------------------------------------------------------
+
+proc tixHList:CallIndicatorCmd {w event ent} {
+ set cmd [$w cget -indicatorcmd]
+
+ if {$cmd != ""} {
+ set bind(type) $event
+ set bind(specs) {%V}
+ set bind(%V) $ent
+
+ tixEvalCmdBinding $w $cmd bind $ent
+ }
+}
+
+proc tixHList:InsideArmedIndicator {w x y} {
+ global tkPriv
+
+ set ent [tixHList:GetNearest $w $y 1]
+ if {$ent == "" || $ent != $tkPriv(tix,indicator)} {
+ return 0
+ }
+
+ set info [$w info item $x $y]
+ if {[lindex $info 1] == "indicator"} {
+ return 1
+ } else {
+ return 0
+ }
+}
+
+proc tixHList:Browse {w ent} {
+ set browsecmd [$w cget -browsecmd]
+ if {$browsecmd != ""} {
+ set bind(specs) {%V}
+ set bind(%V) $ent
+
+ tixEvalCmdBinding $w $browsecmd bind $ent
+ }
+}
+
+
diff --git a/tix/library/HListDD.tcl b/tix/library/HListDD.tcl
new file mode 100644
index 00000000000..aa337b90cd7
--- /dev/null
+++ b/tix/library/HListDD.tcl
@@ -0,0 +1,199 @@
+# HListDD.tcl --
+#
+# !!! PRE-ALPHA CODE, NOT USED, DON'T USE !!!
+#
+# This file implements drag+drop for HList.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#
+# events
+#
+#
+
+proc tixHListSingle:DragTimer {w ent} {
+ case [tixHListSingle:GetState $w] {
+ {1} {
+ # fire up
+ }
+ }
+}
+
+
+
+
+
+#----------------------------------------------------------------------
+#
+# Drag + Drop Bindings
+#
+#----------------------------------------------------------------------
+
+ #----------------------------------------#
+ # Sending Actions #
+ #----------------------------------------#
+
+#----------------------------------------------------------------------
+# tixHListSingle:Send:WaitDrag --
+#
+# Sender wait for dragging action
+#----------------------------------------------------------------------
+proc tixHListSingle:Send:WaitDrag {w x y} {
+ global tixPriv
+
+ set ent [tixHListSingle:GetNearest $w $y]
+ if {$ent != ""} {
+ $w anchor set $ent
+ $w select clear
+ $w select set $ent
+
+ set tixPriv(dd,$w:moved) 0
+ set tixPriv(dd,$w:entry) $ent
+
+# set browsecmd [$w cget -browsecmd]
+# if {$browsecmd != "" && $ent != ""} {
+# eval $browsecmd $ent
+# }
+ }
+}
+
+proc tixHListSingle:Send:StartDrag {w x y} {
+ global tixPriv
+ set dd [tixGetDragDropContext $w]
+
+ if {![info exists tixPriv(dd,$w:entry)]} {
+ return
+ }
+ if {$tixPriv(dd,$w:entry) == ""} {
+ return
+ }
+
+ if {$tixPriv(dd,$w:moved) == 0} {
+ $w dragsite set $tixPriv(dd,$w:entry)
+ set tixPriv(dd,$w:moved) 1
+ $dd config -source $w -command "tixHListSingle:Send:Cmd $w"
+ $dd startdrag $X $Y
+ } else {
+ $dd drag $X $Y
+ }
+}
+
+proc tixHListSingle:Send:DoneDrag {w x y} {
+ global tixPriv
+ global moved
+
+ if {![info exists tixPriv(dd,$w:entry)]} {
+ return
+ }
+ if {$tixPriv(dd,$w:entry) == ""} {
+ return
+ }
+
+ if {$tixPriv(dd,$w:moved) == 1} {
+ set dd [tixGetDragDropContext $w]
+ $dd drop $X $Y
+ }
+ $w dragsite clear
+ catch {unset tixPriv(dd,$w:moved)}
+ catch {unset tixPriv(dd,$w:entry)}
+}
+
+proc tixHListSingle:Send:Cmd {w option args} {
+ set dragCmd [$w cget -dragcmd]
+ if {$dragCmd != ""} {
+ return [eval $dragCmd $option $args]
+ }
+
+ # Perform the default action
+ #
+ case "$option" {
+ who {
+ return $w
+ }
+ types {
+ return {data text}
+ }
+ get {
+ global tixPriv
+ if {[lindex $args 0] == "text"} {
+ if {$tixPriv(dd,$w:entry) != ""} {
+ return [$w entrycget $tixPriv(dd,$w:entry) -text]
+ }
+ }
+ if {[lindex $args 0] == "data"} {
+ if {$tixPriv(dd,$w:entry) != ""} {
+ return [$w entrycget $tixPriv(dd,$w:entry) -data]
+ }
+ }
+ }
+ }
+}
+
+ #----------------------------------------#
+ # Receiving Actions #
+ #----------------------------------------#
+proc tixHListSingle:Rec:DragOver {w sender x y} {
+ if {[$w cget -selectmode] != "dragdrop"} {
+ return
+ }
+
+ set ent [tixHListSingle:GetNearest $w $y]
+ if {$ent != ""} {
+ $w dropsite set $ent
+ } else {
+ $w dropsite clear
+ }
+}
+
+proc tixHListSingle:Rec:DragIn {w sender x y} {
+ if {[$w cget -selectmode] != "dragdrop"} {
+ return
+ }
+ set ent [tixHListSingle:GetNearest $w $y]
+ if {$ent != ""} {
+ $w dropsite set $ent
+ } else {
+ $w dropsite clear
+ }
+}
+
+proc tixHListSingle:Rec:DragOut {w sender x y} {
+ if {[$w cget -selectmode] != "dragdrop"} {
+ return
+ }
+ $w dropsite clear
+}
+
+proc tixHListSingle:Rec:Drop {w sender x y} {
+ if {[$w cget -selectmode] != "dragdrop"} {
+ return
+ }
+ $w dropsite clear
+
+ set ent [tixHListSingle:GetNearest $w $y]
+ if {$ent != ""} {
+ $w anchor set $ent
+ $w select clear
+ $w select set $ent
+ }
+
+ set dropCmd [$w cget -dropcmd]
+ if {$dropCmd != ""} {
+ eval $dropCmd $sender $x $y
+ return
+ }
+
+# set browsecmd [$w cget -browsecmd]
+# if {$browsecmd != "" && $ent != ""} {
+# eval $browsecmd [list $ent]
+# }
+}
+
+tixDropBind TixHListSingle <In> "tixHListSingle:Rec:DragIn %W %S %x %y"
+tixDropBind TixHListSingle <Over> "tixHListSingle:Rec:DragOver %W %S %x %y"
+tixDropBind TixHListSingle <Out> "tixHListSingle:Rec:DragOut %W %S %x %y"
+tixDropBind TixHListSingle <Drop> "tixHListSingle:Rec:Drop %W %S %x %y"
diff --git a/tix/library/IconView.tcl b/tix/library/IconView.tcl
new file mode 100644
index 00000000000..1104d240ace
--- /dev/null
+++ b/tix/library/IconView.tcl
@@ -0,0 +1,271 @@
+# IconView.tcl --
+#
+# This file implements the Icon View widget: the "icon" view mode of
+# the MultiView widget. It implements:
+#
+# (1) Creation of the icons in the canvas subwidget.
+# (2) Automatic arrangement of the objects
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixIconView {
+ -classname TixIconView
+ -superclass tixCObjView
+ -method {
+ add arrange
+ }
+ -flag {
+ -autoarrange
+ }
+ -static {
+ }
+ -configspec {
+ {-autoarrange autoArrange AutoArrange 0 tixVerifyBoolean}
+ }
+ -default {
+ {.scrollbar auto}
+ {*borderWidth 1}
+ {*canvas.background #c3c3c3}
+ {*canvas.highlightBackground #d9d9d9}
+ {*canvas.relief sunken}
+ {*canvas.takeFocus 1}
+ {*Scrollbar.background #d9d9d9}
+ {*Scrollbar.relief sunken}
+ {*Scrollbar.troughColor #c3c3c3}
+ {*Scrollbar.takeFocus 0}
+ {*Scrollbar.width 15}
+ }
+ -forcecall {
+ }
+}
+
+proc tixIconView:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+}
+
+proc tixIconView:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ set c $data(w:canvas)
+
+ bind $c <1> "tixIconView:StartDrag $w %x %y"
+ bind $c <B1-Motion> "tixIconView:Drag $w %x %y"
+ bind $c <ButtonRelease-1> "tixIconView:EndDrag $w"
+}
+
+proc tixIconView:StartDrag {w x y} {
+ upvar #0 $w data
+ global lastX lastY
+
+ set c $data(w:canvas)
+ $c raise current
+
+ set lastX [$c canvasx $x]
+ set lastY [$c canvasy $y]
+}
+
+
+proc tixIconView:Drag {w x y} {
+ upvar #0 $w data
+ global lastX lastY
+
+ set c $data(w:canvas)
+ set x [$c canvasx $x]
+ set y [$c canvasy $y]
+ $c move current [expr $x-$lastX] [expr $y-$lastY]
+ set lastX $x
+ set lastY $y
+}
+
+proc tixIconView:EndDrag {w} {
+ upvar #0 $w data
+
+ tixCallMethod $w adjustscrollregion
+}
+
+#----------------------------------------------------------------------
+#
+# option configs
+#----------------------------------------------------------------------
+proc tixIconView:add {w tag image text} {
+ upvar #0 $w data
+
+ set cmp [image create compound -window $data(w:canvas)]
+
+ $cmp add image -image $image
+ $cmp add line
+ $cmp add text -text $text
+
+ set id [$data(w:canvas) create image 0 0 -image $cmp -anchor nw]
+ $data(w:canvas) addtag $tag withtag $id
+
+ if {$data(-autoarrange)} {
+ tixWidgetDoWhenIdle tixIconView:Arrange $w 1
+ }
+}
+
+# Do it in an idle handler, so that Arrange is not called before the window
+# is properly mapped.
+#
+proc tixIconView:arrange {w} {
+ tixWidgetDoWhenIdle tixIconView:Arrange $w 1
+}
+
+
+proc tixIconView:PackOneRow {w row y maxH bd padX padY} {
+ upvar #0 $w data
+
+ set iX [expr $bd+$padX]
+ foreach i $row {
+ set box [$data(w:canvas) bbox $i]
+ set W [expr [lindex $box 2]-[lindex $box 0]+1]
+ set H [expr [lindex $box 3]-[lindex $box 1]+1]
+
+ set iY [expr $y + $maxH - $H]
+ $data(w:canvas) coords $i $iX $iY
+ incr iX [expr $W+$padX]
+ }
+}
+
+# virtual method
+#
+proc tixIconView:PlaceWindow {w} {
+ upvar #0 $w data
+
+ if {$data(-autoarrange)} {
+ tixWidgetDoWhenIdle tixIconView:Arrange $w 0
+ }
+
+ tixChainMethod $w PlaceWindow
+}
+
+proc tixIconView:Arrange {w adjust} {
+ upvar #0 $w data
+
+ set padX 2
+ set padY 2
+
+ tixIconView:ArrangeGrid $w $padX $padY
+ if {$adjust} {
+ tixCallMethod $w adjustscrollregion
+ }
+}
+
+# the items are not packed
+#
+proc tixIconView:ArrangeGrid {w padX padY} {
+ upvar #0 $w data
+
+ set maxW 0
+ set maxH 0
+ foreach item [$data(w:canvas) find all] {
+ set box [$data(w:canvas) bbox $item]
+ set itemW [expr [lindex $box 2]-[lindex $box 0]+1]
+ set itemH [expr [lindex $box 3]-[lindex $box 1]+1]
+ if {$maxW < $itemW} {
+ set maxW $itemW
+ }
+ if {$maxH < $itemH} {
+ set maxH $itemH
+ }
+ }
+ if {$maxW == 0 || $maxH == 0} {
+ return
+ }
+
+ set winW [tixWinWidth $data(w:canvas)]
+ set bd [expr [$data(w:canvas) cget -bd]+\
+ [$data(w:canvas) cget -highlightthickness]]
+ set cols [expr $winW / ($maxW+$padX)]
+ if {$cols < 1} {
+ set cols 1
+ }
+ set y $bd
+
+ set c 0
+ set x $bd
+ foreach item [$data(w:canvas) find all] {
+ set box [$data(w:canvas) bbox $item]
+ set itemW [expr [lindex $box 2]-[lindex $box 0]+1]
+ set itemH [expr [lindex $box 3]-[lindex $box 1]+1]
+
+ set iX [expr $x + $padX + ($maxW-$itemW)/2]
+ set iY [expr $y + $padY + ($maxH-$itemH) ]
+
+ $data(w:canvas) coords $item $iX $iY
+ incr c
+ incr x [expr $maxW + $padY]
+ if {$c == $cols} {
+ set c 0
+ incr y [expr $maxH + $padY]
+ set x $bd
+ }
+ }
+}
+
+# the items are packed
+#
+proc tixIconView:ArrangePack {w padX padY} {
+ upvar #0 $w data
+
+ set winW [tixWinWidth $data(w:canvas)]
+ set bd [expr [$data(w:canvas) cget -bd]+\
+ [$data(w:canvas) cget -highlightthickness]]
+ set y [expr $bd + $padY]
+
+ set maxH 0
+ set usedW $padX
+ set row ""
+ foreach item [$data(w:canvas) find all] {
+ set box [$data(w:canvas) bbox $item]
+ set itemW [expr [lindex $box 2]-[lindex $box 0]+1]
+ set itemH [expr [lindex $box 3]-[lindex $box 1]+1]
+
+ if {[expr $usedW + $itemW] > $winW} {
+ if {$row == ""} {
+ # only one item in this row
+ #
+ $data(w:canvas) coords $item [expr $bd + $padX] $y
+ incr y [expr $itemH+$padY]
+ continue
+ } else {
+ # this item is not in this row. Arrange the previous items
+ # first
+ #
+ tixIconView:PackOneRow $w $row $y $maxH $bd $padX $padY
+
+ incr y $maxH
+ set row ""
+ set maxH 0
+ set usedW $padX
+ }
+ }
+ lappend row $item
+ if {$maxH < $itemH} {
+ set maxH $itemH
+ }
+ incr usedW [expr $padX+$itemW]
+ }
+ if {$row != ""} {
+ tixIconView:PackOneRow $w $row $y $maxH $bd $padX $padY
+ }
+}
+
+#----------------------------------------------------------------------
+#
+# Widget commands
+#----------------------------------------------------------------------
+
+#----------------------------------------------------------------------
+#
+# Private Methods
+#----------------------------------------------------------------------
+
diff --git a/tix/library/Init.tcl b/tix/library/Init.tcl
new file mode 100644
index 00000000000..d8e955f177d
--- /dev/null
+++ b/tix/library/Init.tcl
@@ -0,0 +1,163 @@
+# Init.tcl --
+#
+# Initializes the Tix library and performes version checking to ensure
+# the Tcl, Tk and Tix script libraries loaded matches with the binary
+# of the respective packages.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+if ![tixStrEq $tix_library ""] {
+ global auto_path
+ lappend auto_path $tix_library
+}
+
+if [catch {file join a a}] {
+ proc tixFileJoin {args} {
+ set p [join $args /]
+ regsub -all {/+} $p / p
+ return $p
+ }
+} else {
+ proc tixFileJoin {args} {
+ return [eval file join $args]
+ }
+}
+
+proc __tixError {errorMsg} {
+ error [concat $errorMsg \
+ "Please check your TIX_LIBRARY environment variable and " \
+ "your Tix installation."]
+}
+
+proc __tixInit {} {
+ global tix tixPriv env tix_version tix_patchLevel tk_version tix_library
+ global tcl_version
+
+ if [info exists tix(initialized)] {
+ return
+ }
+ if {[info command "@scope"] != ""} {
+ set hasItcl 1
+ } else {
+ set hasItcl 0
+ }
+
+ # STEP 0: Version checking using the Tcl7.5 package mechanism. This is not
+ # done if we are linked to Tcl 7.4.
+ #
+ if [string compare [info command package] ""] {
+ if {![string comp [info command tixScriptVersion] ""] &&
+ ![auto_load tixScriptVersion]} {
+ __tixError [concat "Cannot determine version of Tix script " \
+ "library. Requires version $tix_version."]
+ }
+
+ if !$hasItcl {
+ set pkgVersion $tix_version.$tcl_version
+ } else {
+ # The extra .1 indicates that the Tix binary is specially
+ # compiled for Itcl. This is necessary for the "package
+ # require" command to load in the correct shared library
+ # file.
+ set pkgVersion $tix_version.$tcl_version.1
+ }
+
+ package provide Tix $pkgVersion
+ if [tixStrEq $tix_library ""] {
+ package provide Tixsam $pkgVersion
+ }
+ }
+
+ # STEP 1: Version checking
+ #
+ #
+ if {![string compare [info command tixScriptVersion] ""] &&
+ ![auto_load tixScriptVersion]} {
+ __tixError [concat "Cannot determine version of Tix script library. "\
+ "Requires version $tix_version."]
+
+ } elseif [string compare [tixScriptVersion] $tix_version] {
+ __tixError [concat "Tix script library version ([tixScriptVersion]) "\
+ "does not match binary version ($tix_version)"]
+
+ } elseif [string compare [tixScriptPatchLevel] $tix_patchLevel] {
+ __tixError [concat "Tix script library patch-level "\
+ "([tixScriptPatchLevel]) does not match binary patch-level "\
+ "($tix_patchLevel)"]
+ }
+
+ if [info exists errorMsg] {
+ error $errorMsg
+ }
+
+ # STEP 2: Initialize file compatibility modules
+ #
+ #
+ if [info exists tixPriv(isWindows)] {
+ tixInitFileCmpt:Win
+ } elseif [info exists env(WINDOWS_EMU_DEBUG)] {
+ tixInitFileCmpt:Win
+ tixWinFileEmu
+ } else {
+ tixInitFileCmpt:Unix
+ }
+
+ # STEP 3: Initialize the Tix application context
+ #
+ #
+
+ tixAppContext tix
+
+ # STEP 4: Initialize the bindings for widgets that are implemented in C
+ #
+ #
+ if [string compare [info command tixHList] ""] {
+ tixHListBind
+ }
+ if [string compare [info command tixTList] ""] {
+ tixTListBind
+ }
+ if [string compare [info command tixGrid] ""] {
+ tixGridBind
+ }
+ tixComboBoxBind
+ tixControlBind
+ tixFloatEntryBind
+ tixLabelEntryBind
+ tixScrolledGridBind
+ tixScrolledListBoxBind
+
+ # STEP 5: Some ITCL compatibility stuff
+ #
+ #
+ if $hasItcl {
+ rename update __update
+
+ # We use $colon$colon as a hack here. The reason is, starting from
+ # Tix 4.0.6/4.1b1, all the double colons in Tix classnames have
+ # been replaced by a single colon by a sed script. This modification
+ # makes it possible to use Tix with ITCL without having to modify
+ # the ITCL core. However, we don't want the real double colon
+ # (which means the global scope in ITCL) to be replaced. The
+ # $colon$colon just by-passes the sed script.
+ #
+ proc update {args} {
+ set colon :
+ @scope $colon$colon eval __update $args
+ }
+
+ rename tkwait __tkwait
+
+ proc tkwait {args} {
+ set colon :
+ @scope $colon$colon eval __tkwait $args
+ }
+ }
+
+ rename __tixError ""
+ rename __tixInit ""
+}
diff --git a/tix/library/LabEntry.tcl b/tix/library/LabEntry.tcl
new file mode 100644
index 00000000000..ebcf55983ed
--- /dev/null
+++ b/tix/library/LabEntry.tcl
@@ -0,0 +1,83 @@
+# LabEntry.tcl --
+#
+# TixLabelEntry Widget: an entry box with a label
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+tixWidgetClass tixLabelEntry {
+ -classname TixLabelEntry
+ -superclass tixLabelWidget
+ -method {
+ }
+ -flag {
+ -disabledforeground -state
+ }
+ -forcecall {
+ -state
+ }
+ -static {
+ }
+ -configspec {
+ {-disabledforeground disabledForeground DisabledForeground #303030}
+ {-state state State normal}
+ }
+ -default {
+ {.borderWidth 0}
+ {*entry.relief sunken}
+ {*entry.width 7}
+ {*label.anchor e}
+ {*label.borderWidth 0}
+ {*Label.font -Adobe-Helvetica-Bold-R-Normal--*-120-*}
+ {*Entry.background #c3c3c3}
+ }
+}
+
+proc tixLabelEntry:ConstructFramedWidget {w frame} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructFramedWidget $frame
+
+ set data(w:entry) [entry $frame.entry]
+ pack $data(w:entry) -side left -expand yes -fill both
+
+ # This value is used to configure the disable/normal fg of the ebtry
+ #
+ set data(entryfg) [$data(w:entry) cget -fg]
+ set data(labelfg) [$data(w:label) cget -fg]
+}
+
+proc tixLabelEntryBind {} {
+ tixBind TixLabelEntry <FocusIn> {
+ if {![tixStrEq [focus -displayof [set %W(w:entry)]] [set %W(w:entry)]]} {
+ focus [%W subwidget entry]
+ [set %W(w:entry)] selection from 0
+ [set %W(w:entry)] selection to end
+ [set %W(w:entry)] icursor end
+ }
+ }
+}
+
+
+#----------------------------------------------------------------------
+# CONFIG OPTIONS
+#----------------------------------------------------------------------
+proc tixLabelEntry:config-state {w value} {
+ upvar #0 $w data
+
+ if {$value == "normal"} {
+ catch {
+ $data(w:label) config -fg $data(labelfg)
+ }
+ $data(w:entry) config -state $value -fg $data(entryfg)
+ } else {
+ catch {
+ $data(w:label) config -fg $data(-disabledforeground)
+ }
+ $data(w:entry) config -state $value -fg $data(-disabledforeground)
+ }
+}
diff --git a/tix/library/LabFrame.tcl b/tix/library/LabFrame.tcl
new file mode 100644
index 00000000000..6a7ed3c33e5
--- /dev/null
+++ b/tix/library/LabFrame.tcl
@@ -0,0 +1,45 @@
+# LabFrame.tcl --
+#
+# TixLabelFrame Widget: a frame box with a label
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixLabelFrame {
+ -classname TixLabelFrame
+ -superclass tixLabelWidget
+ -method {
+ frame
+ }
+ -flag {}
+ -static {}
+ -configspec {
+ {-labelside labelSide LabelSide acrosstop}
+ {-padx padX Pad 2}
+ {-pady padY Pad 2}
+ }
+ -alias {}
+ -default {
+ {*Label.font -Adobe-Helvetica-Bold-R-Normal--*-120-*}
+ {*Label.anchor c}
+ {.frame.borderWidth 2}
+ {.frame.relief groove}
+ {.border.borderWidth 2}
+ {.border.relief groove}
+ {.borderWidth 2}
+ {.padX 2}
+ {.padY 2}
+ {.anchor sw}
+ }
+}
+
+#----------------------------------------------------------------------
+# Public methods
+#----------------------------------------------------------------------
+proc tixLabelFrame:frame {w args} {
+
+ return [eval tixCallMethod $w subwidget frame $args]
+}
diff --git a/tix/library/LabWidg.tcl b/tix/library/LabWidg.tcl
new file mode 100644
index 00000000000..ac2899f16a1
--- /dev/null
+++ b/tix/library/LabWidg.tcl
@@ -0,0 +1,152 @@
+# LabWidg.tcl --
+#
+# TixLabelWidget: Virtual base class. Do not instantiate
+#
+# This widget class is the base class for all widgets that has a
+# label. Most Tix compound widgets will have a label so that
+# the app programmer doesn't need to add labels themselvel.
+#
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+# LabelSide : top, left, right, bottom, none, acrosstop
+#
+# public widgets:
+# frame, label
+#
+
+tixWidgetClass tixLabelWidget {
+ -superclass tixPrimitive
+ -classname TixLabelWidget
+ -flag {
+ -label -labelside -padx -pady
+ }
+ -static {-labelside}
+ -configspec {
+ {-label label Label ""}
+ {-labelside labelSide LabelSide left}
+ {-padx padX Pad 0}
+ {-pady padY Pad 0}
+ }
+}
+
+proc tixLabelWidget:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ if {$data(-labelside) != "acrosstop"} {
+ set data(w:frame) [frame $w.frame]
+ } else {
+ set data(pw:border) [frame $w.border]
+ set data(pw:pad) [frame $w.border.pad]
+ set data(w:frame) [frame $w.border.frame]
+ }
+
+ if {$data(-labelside) != "none"} {
+ set data(w:label) [label $w.label -text $data(-label)]
+ }
+ tixLabelWidget:Pack $w
+
+ tixCallMethod $w ConstructFramedWidget $data(w:frame)
+}
+
+proc tixLabelWidget:ConstructFramedWidget {w frame} {
+ # Do nothing
+}
+
+proc tixLabelWidget:Pack {w} {
+ upvar #0 $w data
+
+ if [catch {tixLabelWidget:Pack-$data(-labelside) $w}] {
+ error "unknown -labelside option \"$data(-labelside)\""
+ }
+}
+
+proc tixLabelWidget:Pack-acrosstop {w} {
+ upvar #0 $w data
+
+ set labHalfHeight [expr [winfo reqheight $data(w:label)] / 2]
+ set padHeight [expr $labHalfHeight - [$data(pw:border) cget -bd]]
+ if {$padHeight < 0} {
+ set padHeight 0
+ }
+
+ tixForm $data(w:label) -top 0 -left 4\
+ -padx [expr $data(-padx) +4] -pady $data(-pady)
+ tixForm $data(pw:border) -top $labHalfHeight -bottom -1 \
+ -left 0 -right -1 -padx $data(-padx) -pady $data(-pady)
+ tixForm $data(pw:pad) -left 0 -right -1 \
+ -top 0 -bottom $padHeight
+ tixForm $data(w:frame) -top $data(pw:pad) -bottom -1 \
+ -left 0 -right -1
+}
+
+proc tixLabelWidget:Pack-top {w} {
+ upvar #0 $w data
+
+ pack $data(w:label) -side top \
+ -padx $data(-padx) -pady $data(-pady) \
+ -fill x
+ pack $data(w:frame) -side top \
+ -padx $data(-padx) -pady $data(-pady) \
+ -expand yes -fill both
+}
+
+proc tixLabelWidget:Pack-bottom {w} {
+ upvar #0 $w data
+
+ pack $data(w:label) -side bottom \
+ -padx $data(-padx) -pady $data(-pady) \
+ -fill x
+ pack $data(w:frame) -side bottom \
+ -padx $data(-padx) -pady $data(-pady) \
+ -expand yes -fill both
+}
+
+proc tixLabelWidget:Pack-left {w} {
+ upvar #0 $w data
+
+ pack $data(w:label) -side left \
+ -padx $data(-padx) -pady $data(-pady) \
+ -fill y
+ pack $data(w:frame) -side left \
+ -padx $data(-padx) -pady $data(-pady) \
+ -expand yes -fill both
+}
+
+proc tixLabelWidget:Pack-right {w} {
+ upvar #0 $w data
+
+ pack $data(w:label) -side right \
+ -padx $data(-padx) -pady $data(-pady) \
+ -fill x
+ pack $data(w:frame) -side right \
+ -padx $data(-padx) -pady $data(-pady) \
+ -expand yes -fill both
+}
+
+proc tixLabelWidget:Pack-none {w} {
+ upvar #0 $w data
+
+ pack $data(w:frame)\
+ -padx $data(-padx) -pady $data(-pady) \
+ -expand yes -fill both
+}
+
+#----------------------------------------------------------------------
+# CONFIG OPTIONS
+#----------------------------------------------------------------------
+proc tixLabelWidget:config-label {w value} {
+ upvar #0 $w data
+
+ $data(w:label) config -text $value
+
+ if {$data(-labelside) == "acrosstop"} {
+ tixLabelWidget:Pack-acrosstop $w
+ }
+}
diff --git a/tix/library/ListNBk.tcl b/tix/library/ListNBk.tcl
new file mode 100644
index 00000000000..374efe728e9
--- /dev/null
+++ b/tix/library/ListNBk.tcl
@@ -0,0 +1,150 @@
+# ListNBk.tcl --
+#
+# "List NoteBook" widget. Acts similarly to the notebook but uses a
+# HList widget to represent the pages.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixListNoteBook {
+ -classname TixListNoteBook
+ -superclass tixVStack
+ -method {
+ }
+ -flag {
+ -height -width
+ }
+ -configspec {
+ {-width width Width 0}
+ {-height height Height 0}
+ }
+ -forcecall {
+ -dynamicgeometry -width -height
+ }
+ -default {
+ {*Orientation horizontal}
+ }
+}
+
+proc tixListNoteBook:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+ set data(w_pane) [tixPanedWindow $w.pane -panerelief flat]
+ set p1 [$data(w_pane) add p1 -expand 0]
+ set p2 [$data(w_pane) add p2 -expand 1]
+ set data(w_p2) $p2
+ set data(w:shlist) [tixScrolledHList $p1.shlist]
+ set data(w:hlist) [$data(w:shlist) subwidget hlist]
+
+ if [tixStrEq [$data(w_pane) cget -orientation] vertical] {
+ pack $data(w:shlist) -expand yes -fill both -padx 2 -pady 3
+ } else {
+ pack $data(w:shlist) -expand yes -fill both -padx 3 -pady 2
+ }
+
+ $data(w:hlist) config \
+ -command "tixListNoteBook:Choose $w"\
+ -browsecmd "tixListNoteBook:Choose $w"\
+ -selectmode single
+
+ pack $data(w_pane) -expand yes -fill both
+}
+
+proc tixListNoteBook:add {w child args} {
+ upvar #0 $w data
+
+ if [string match *.* $child] {
+ error "the name of the page cannot contain the \".\" character"
+ }
+ return [eval tixChainMethod $w add $child $args]
+}
+
+#----------------------------------------------------------------------
+# Virtual Methods
+#----------------------------------------------------------------------
+proc tixListNoteBook:InitGeometryManager {w} {
+ tixWidgetDoWhenIdle tixListNoteBook:InitialRaise $w
+}
+
+proc tixListNoteBook:InitialRaise {w} {
+ upvar #0 $w data
+
+ if ![string comp $data(topchild) ""] {
+ set top [lindex $data(windows) 0]
+ } else {
+ set top $data(topchild)
+ }
+
+ if ![tixStrEq $top ""] {
+ tixCallMethod $w raise $top
+ }
+}
+
+proc tixListNoteBook:CreateChildFrame {w child} {
+ upvar #0 $w data
+
+ set f [frame $data(w_p2).$child]
+
+ return $f
+}
+
+proc tixListNoteBook:RaiseChildFrame {w child} {
+ upvar #0 $w data
+
+ if [string comp $data(topchild) $child] {
+ if [string comp $data(topchild) ""] {
+ pack forget $data(w:$data(topchild))
+ }
+ pack $data(w:$child) -expand yes -fill both
+ }
+}
+
+#
+#----------------------------------------------------------------------
+#
+
+proc tixListNoteBook:config-dynamicgeometry {w value} {
+ upvar #0 $w data
+
+ $data(w_pane) config -dynamicgeometry $value
+}
+
+proc tixListNoteBook:config-width {w value} {
+ upvar #0 $w data
+
+ if {$value != 0} {
+ $data(w_pane) config -width $value
+ }
+}
+
+proc tixListNoteBook:config-height {w value} {
+ upvar #0 $w data
+
+ if {$value != 0} {
+ $data(w_pane) config -height $value
+ }
+}
+
+proc tixListNoteBook:raise {w child} {
+ upvar #0 $w data
+
+ $data(w:hlist) selection clear
+ $data(w:hlist) selection set $child
+ $data(w:hlist) anchor set $child
+
+ tixChainMethod $w raise $child
+}
+
+proc tixListNoteBook:Choose {w args} {
+ upvar #0 $w data
+
+ set entry [tixEvent flag V]
+
+ if {[lsearch $data(windows) $entry] != -1} {
+ tixCallMethod $w raise $entry
+ }
+}
diff --git a/tix/library/Makefile b/tix/library/Makefile
new file mode 100644
index 00000000000..33800b1f4a5
--- /dev/null
+++ b/tix/library/Makefile
@@ -0,0 +1,5 @@
+tclIndex::
+ ../tools/tixindex *tcl
+
+clean::
+ -rm -f *.bak *~
diff --git a/tix/library/Meter.tcl b/tix/library/Meter.tcl
new file mode 100644
index 00000000000..499ed8f1f11
--- /dev/null
+++ b/tix/library/Meter.tcl
@@ -0,0 +1,124 @@
+# Meter.tcl --
+#
+# Implements the tixMeter widget
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+tixWidgetClass tixMeter {
+ -classname TixMeter
+ -superclass tixPrimitive
+ -method {
+ }
+ -flag {
+ -foreground -text -value
+ }
+ -configspec {
+ {-fillcolor fillColor FillColor #8080ff}
+ {-foreground foreground Foreground black}
+ {-text text Text ""}
+ {-value value Value 0}
+ }
+ -default {
+ {.relief sunken}
+ {.borderWidth 2}
+ {.width 150}
+ }
+}
+
+proc tixMeter:InitWidgetRec {w} {
+ upvar #0 $w data
+ global env
+
+ tixChainMethod $w InitWidgetRec
+}
+
+#----------------------------------------------------------------------
+# Construct widget
+#----------------------------------------------------------------------
+proc tixMeter:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ set data(w:canvas) [canvas $w.canvas]
+ pack $data(w:canvas) -expand yes -fill both
+
+ tixMeter:Update $w
+}
+
+proc tixMeter:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+}
+
+proc tixMeter:Update {w} {
+ upvar #0 $w data
+
+ # set the width of the canvas
+ set W [expr $data(-width)-\
+ ([$data(w:root) cget -bd]+[$data(w:root) cget -highlightthickness]*2)]
+ $data(w:canvas) config -width $W
+
+ if {$data(-text) == ""} {
+ set text [format "%d%%" [expr int($data(-value)*100)]]
+ } else {
+ set text $data(-text)
+ }
+
+ # (Create/Modify) the text item.
+ #
+ if {![info exists data(text)]} {
+ set data(text) [$data(w:canvas) create text 0 0 -text $text]
+ } else {
+ $data(w:canvas) itemconfig $data(text) -text $text
+ }
+
+ set bbox [$data(w:canvas) bbox $data(text)]
+
+ set itemW [expr [lindex $bbox 2]-[lindex $bbox 0]]
+ set itemH [expr [lindex $bbox 3]-[lindex $bbox 1]]
+
+
+ $data(w:canvas) coord $data(text) [expr $W/2] [expr $itemH/2+4]
+
+ set H [expr $itemH + 4]
+ $data(w:canvas) config -height [expr $H]
+
+
+ set rectW [expr int($W*$data(-value))]
+
+ if {![info exists data(rect)]} {
+ set data(rect) [$data(w:canvas) create rectangle 0 0 $rectW 1000]
+ } else {
+ $data(w:canvas) coord $data(rect) 0 0 $rectW 1000
+ }
+
+ $data(w:canvas) itemconfig $data(rect) \
+ -fill $data(-fillcolor) -outline $data(-fillcolor)
+
+ $data(w:canvas) raise $data(text)
+}
+
+#----------------------------------------------------------------------
+# Configuration
+#----------------------------------------------------------------------
+proc tixMeter:config-value {w value} {
+ upvar #0 $w data
+
+ set data(-value) $value
+ tixMeter:Update $w
+}
+
+proc tixMeter:config-text {w value} {
+ upvar #0 $w data
+
+ set data(-text) $value
+ tixMeter:Update $w
+}
+
diff --git a/tix/library/MultView.tcl b/tix/library/MultView.tcl
new file mode 100644
index 00000000000..3a8029d014a
--- /dev/null
+++ b/tix/library/MultView.tcl
@@ -0,0 +1,152 @@
+# MultView.tcl --
+#
+# Implements the multi-view widget
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+tixWidgetClass tixMultiView {
+ -classname TixMultiView
+ -superclass tixPrimitive
+ -method {
+ add
+ }
+ -flag {
+ -browsecmd -command -view
+ }
+ -forcecall {
+ -view
+ }
+ -configspec {
+ {-browsecmd browseCmd BrowseCmd ""}
+ {-command command Command ""}
+ {-view view View icon tixMultiView:VerifyView}
+ }
+ -alias {
+ }
+
+ -default {
+ }
+}
+
+proc tixMultiView:InitWidgetRec {w} {
+ upvar #0 $w data
+ global env
+
+ tixChainMethod $w InitWidgetRec
+}
+
+#----------------------------------------------------------------------
+# Construct widget
+#----------------------------------------------------------------------
+proc tixMultiView:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ set data(w:stlist) [tixScrolledTList $w.stlist]
+ set data(w:sgrid) [tixScrolledGrid $w.sgrid]
+ set data(w:icon) [tixIconView $w.icon]
+
+ set data(w:tlist) [$data(w:stlist) subwidget tlist]
+ set data(w:grid) [$data(w:sgrid) subwidget grid]
+
+ $data(w:grid) config -formatcmd "tixMultiView:GridFormat $w" \
+ -leftmargin 0 -topmargin 1
+}
+
+proc tixMultiView:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+}
+
+proc tixMultiView:GetWid {w which} {
+ upvar #0 $w data
+
+ case $which {
+ list {
+ return $data(w:stlist)
+ }
+ icon {
+ return $data(w:icon)
+ }
+ detail {
+ return $data(w:sgrid)
+ }
+ }
+}
+#----------------------------------------------------------------------
+# Configuration
+#----------------------------------------------------------------------
+proc tixMultiView:config-view {w value} {
+ upvar #0 $w data
+
+ if {$data(-view) != ""} {
+ pack forget [tixMultiView:GetWid $w $data(-view)]
+ }
+
+ pack [tixMultiView:GetWid $w $value] -expand yes -fill both
+}
+#----------------------------------------------------------------------
+# Private methods
+#----------------------------------------------------------------------
+proc tixMultiView:GridFormat {w area x1 y1 x2 y2} {
+ upvar #0 $w data
+
+ case $area {
+ main {
+ }
+ {x-margin y-margin s-margin} {
+ # cborder specifies consecutive 3d borders
+ #
+ $data(w:grid) format cborder $x1 $y1 $x2 $y2 \
+ -fill 1 -relief raised -bd 2 -bg gray60 \
+ -selectbackground gray80
+ }
+ }
+
+}
+
+#----------------------------------------------------------------------
+# Public methods
+#----------------------------------------------------------------------
+
+# Return value is the index of "$name" in the grid subwidget
+#
+#
+proc tixMultiView:add {w name args} {
+ upvar #0 $w data
+
+ set validOptions {-image -text}
+
+ set opt(-image) ""
+ set opt(-text) ""
+
+ tixHandleOptions -nounknown opt $validOptions $args
+
+ $data(w:icon) add $name $opt(-image) $opt(-text)
+ $data(w:tlist) insert end -itemtype imagetext \
+ -image $opt(-image) -text $opt(-text)
+ $data(w:grid) set 0 end -itemtype imagetext \
+ -image $opt(-image) -text $opt(-text)
+
+ return max
+}
+
+#----------------------------------------------------------------------
+# checker
+#----------------------------------------------------------------------
+proc tixMultiView:VerifyView {value} {
+ case $value {
+ {icon list detail} {
+ return $value
+ }
+ }
+ error "bad view \"$value\", must be detail, icon or list"
+}
+
diff --git a/tix/library/NoteBook.tcl b/tix/library/NoteBook.tcl
new file mode 100644
index 00000000000..ac219768a6c
--- /dev/null
+++ b/tix/library/NoteBook.tcl
@@ -0,0 +1,248 @@
+# NoteBook.tcl --
+#
+# tixNoteBook: NoteBook type of window.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixNoteBook {
+ -classname TixNoteBook
+ -superclass tixVStack
+ -method {
+ }
+ -flag {
+ }
+ -configspec {
+ {-takefocus takeFocus TakeFocus 0 tixVerifyBoolean}
+ }
+ -default {
+ {.Background #d9d9d9}
+ {.nbframe.tabPadX 8}
+ {.nbframe.tabPadY 0}
+ {.nbframe.borderWidth 2}
+ {.nbframe.Background #d9d9d9}
+ {*nbframe.relief raised}
+ {*nbframe.font -Adobe-Helvetica-Bold-R-Normal--*-120-*}
+ }
+}
+
+proc tixNoteBook:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+
+ set data(pad-x1) 0
+ set data(pad-x2) 0
+ set data(pad-y1) 20
+ set data(pad-y2) 0
+}
+
+proc tixNoteBook:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ set data(w:top) [tixNoteBookFrame $w.nbframe -slave 1 -takefocus 1]
+ set data(w:nbframe) $data(w:top)
+
+ bind $data(w:top) <ButtonPress-1> "tixNoteBook:MouseDown $w %x %y"
+ bind $data(w:top) <ButtonRelease-1> "tixNoteBook:MouseUp $w %x %y"
+
+ bind $data(w:top) <B1-Motion> "tixNoteBook:MouseDown $w %x %y"
+
+ bind $data(w:top) <Left> "tixNoteBook:FocusNext $w prev"
+ bind $data(w:top) <Right> "tixNoteBook:FocusNext $w next"
+
+ bind $data(w:top) <Return> "tixNoteBook:SetFocusByKey $w"
+ bind $data(w:top) <space> "tixNoteBook:SetFocusByKey $w"
+}
+
+#----------------------------------------------------------------------
+# Public methods
+#----------------------------------------------------------------------
+proc tixNoteBook:add {w child args} {
+ upvar #0 $w data
+
+ set ret [eval tixChainMethod $w add $child $args]
+
+ set new_args ""
+ tixForEach {flag value} $args {
+ if {$flag != "-createcmd" && $flag != "-raisecmd"} {
+ lappend new_args $flag
+ lappend new_args $value
+ }
+ }
+
+ eval $data(w:top) add $child $new_args
+
+ return $ret
+}
+
+proc tixNoteBook:raise {w child} {
+ upvar #0 $w data
+
+ tixChainMethod $w raise $child
+
+ if {[$data(w:top) pagecget $child -state] == "normal"} {
+ $data(w:top) activate $child
+ }
+}
+
+proc tixNoteBook:delete {w child} {
+ upvar #0 $w data
+
+ tixChainMethod $w delete $child
+ $data(w:top) delete $child
+}
+
+#----------------------------------------------------------------------
+# Private methods
+#----------------------------------------------------------------------
+proc tixNoteBook:Resize {w} {
+ upvar #0 $w data
+
+ # We have to take care of the size of the tabs so that
+ #
+ set rootReq [$data(w:top) geometryinfo]
+ set tW [lindex $rootReq 0]
+ set tH [lindex $rootReq 1]
+
+ set data(pad-x1) 2
+ set data(pad-x2) 2
+ set data(pad-y1) [expr $tH + $data(-ipadx) + 1]
+ set data(pad-y2) 2
+ set data(minW) [expr $tW]
+ set data(minH) [expr $tH]
+
+ # Now that we know data(pad-y1), we can chain the call
+ #
+ tixChainMethod $w Resize
+}
+
+proc tixNoteBook:MouseDown {w x y} {
+ upvar #0 $w data
+
+ focus $data(w:top)
+
+ set name [$data(w:top) identify $x $y]
+ $data(w:top) focus $name
+ set data(w:down) $name
+}
+
+proc tixNoteBook:MouseUp {w x y} {
+ upvar #0 $w data
+
+ #it could happen (using the tk/menu) that a MouseUp
+ #proceeds without a MouseDown event!!
+ if {! [info exists data(w:down)] || ! [info exists data(w:top)]} {
+ return
+ }
+
+ set name [$data(w:top) identify $x $y]
+
+ if {$name != "" && $name == $data(w:down) && [$data(w:top) pagecget $name -state] == "normal" } {
+ $data(w:top) activate $name
+ tixCallMethod $w raise $name
+ } else {
+ $data(w:top) focus ""
+ }
+}
+
+
+#----------------------------------------------------------------------
+#
+# Section for keyboard bindings
+#
+#----------------------------------------------------------------------
+
+proc tixNoteBook:FocusNext {w dir} {
+ upvar #0 $w data
+
+ if {[$data(w:top) info focus] == ""} {
+ set name [$data(w:top) info active]
+ $data(w:top) focus $name
+
+ if {$name != ""} {
+ return
+ }
+ } else {
+ set name [$data(w:top) info focus$dir]
+ $data(w:top) focus $name
+ }
+}
+
+proc tixNoteBook:SetFocusByKey {w} {
+ upvar #0 $w data
+
+ set name [$data(w:top) info focus]
+
+ if {$name != "" && [$data(w:top) pagecget $name -state] == "normal"} {
+ tixCallMethod $w raise $name
+ $data(w:top) activate $name
+ }
+}
+
+#----------------------------------------------------------------------
+# Automatic bindings for alt keys
+#----------------------------------------------------------------------
+proc tixNoteBookFind {w char} {
+ global tkPriv
+ set char [string tolower $char]
+
+ foreach child [winfo child $w] {
+ if {![winfo ismapped $w]} {
+ continue
+ }
+ switch [winfo class $child] {
+ {Toplevel} {
+ continue
+ }
+ TixNoteBook {
+ set nbframe [$child subwidget nbframe]
+ foreach page [$nbframe info pages] {
+ set char2 [string index [$nbframe pagecget $page -label] \
+ [$nbframe pagecget $page -underline]]
+ if {([string compare $char [string tolower $char2]] == 0)||
+ ($char == "")} {
+ if {[$nbframe pagecget $page -state] != "disabled"} {
+ return "$child $page"
+ }
+ }
+ }
+ }
+ }
+ # Well, this notebook doesn't match with the key, but maybe
+ # it contains a "subnotebook" that will match ..
+ set match [tixNoteBookFind $child $char]
+ if {$match != ""} {
+ return $match
+ }
+ }
+ return ""
+}
+
+proc tixTraverseToNoteBook {w char} {
+ if {$char == ""} {
+ return 0
+ }
+ if {![winfo exists $w]} {
+ return 0
+ }
+ set list [tixNoteBookFind [winfo toplevel $w] $char]
+ if {$list != ""} {
+ [lindex $list 0] raise [lindex $list 1]
+ return 1
+ }
+ return 0
+}
+
+#----------------------------------------------------------------------
+# Set default class bindings
+#----------------------------------------------------------------------
+
+bind all <Alt-KeyPress> "+tixTraverseToNoteBook %W %A"
+bind all <Meta-KeyPress> "+tixTraverseToNoteBook %W %A"
+
diff --git a/tix/library/OldUtil.tcl b/tix/library/OldUtil.tcl
new file mode 100644
index 00000000000..bf2a98e2f14
--- /dev/null
+++ b/tix/library/OldUtil.tcl
@@ -0,0 +1,223 @@
+# OldUtil.tcl -
+#
+# This is an undocumented file.
+# Are these features used in Tix : NO.
+# Should I use these features : NO.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc setenv {name args} {
+ global env
+
+ if {[llength $args] == 1} {
+ return [set env($name) [lindex $args 0]]
+ } else {
+ if {[info exists env($ename)] == 0} {
+ tkerror "Error in setenv: "
+ "environment variable \"$name\" does not exist"
+ } else {
+ return $env($name)
+ }
+ }
+}
+#----------------------------------------------------------------------
+#
+#
+# U T I L I T Y F U N C T I O N S F O R T I X
+#
+#
+#----------------------------------------------------------------------
+
+# RESET THE STRING IN THE ENTRY
+proc tixSetEntry {entry string} {
+ set oldstate [lindex [$entry config -state] 4]
+ $entry config -state normal
+ $entry delete 0 end
+ $entry insert 0 $string
+ $entry config -state $oldstate
+}
+
+# GET THE FIRST SELECTED ITEM IN A LIST
+proc tixListGetSingle {lst} {
+ set indices [$lst curselection]
+ if {$indices != "" } {
+ return [$lst get [lindex $indices 0]]
+ } else {
+ return ""
+ }
+}
+
+#----------------------------------------------------------------------
+# RECORD A DIALOG'S POSITION AND RESTORE IT THE NEXT TIME IT IS OPENED
+#----------------------------------------------------------------------
+proc tixDialogRestore {w {flag -geometry}} {
+ global tixDPos
+
+ if [info exists tixDPos($w)] {
+ if ![winfo ismapped $w] {
+ wm geometry $w $tixDPos($w)
+ wm deiconify $w
+ }
+ } elseif {$flag == "-geometry"} {
+ update
+ set tixDPos($w) [winfo geometry $w]
+ } else {
+ update
+ set tixDPos($w) +[winfo rootx $w]+[winfo rooty $w]
+ }
+}
+#----------------------------------------------------------------------
+# RECORD A DIALOG'S POSITION AND RESTORE IT THE NEXT TIME IT IS OPENED
+#----------------------------------------------------------------------
+proc tixDialogWithdraw {w {flag -geometry}} {
+ global tixDPos
+
+ if [winfo ismapped $w] {
+ if {$flag == "-geometry"} {
+ set tixDPos($w) [winfo geometry $w]
+ } else {
+ set tixDPos($w) +[winfo rootx $w]+[winfo rooty $w]
+ }
+ wm withdraw $w
+ }
+}
+#----------------------------------------------------------------------
+# RECORD A DIALOG'S POSITION AND RESTORE IT THE NEXT TIME IT IS OPENED
+#----------------------------------------------------------------------
+proc tixDialogDestroy {w {flag -geometry}} {
+ global tixDPos
+
+ if [winfo ismapped $w] {
+ if {$flag == "-geometry"} {
+ set tixDPos($w) [winfo geometry $w]
+ } else {
+ set tixDPos($w) +[winfo rootx $w]+[winfo rooty $w]
+ }
+ }
+ destroy $w
+}
+
+# Obsolete
+#
+proc tixQueryAppResource {name class default} {
+
+ set value [option get . $name $class]
+ if {$value == ""} {
+ return $default
+ } else {
+ return $value
+ }
+}
+proc tixCreateToplevel {w {type -mapped}} {
+ upvar #0 $w data
+
+ toplevel $w
+ wm minsize $w 0 0
+ if {$type == "-withdrawn"} {
+ wm withdraw $w
+ }
+
+ bind $w <Destroy> [bind Toplevel <Destroy>]
+ bind $w <Map> [bind Toplevel <Map>]
+ bind $w <Unmap> [bind Toplevel <Unmap>]
+ bind $w <Visibility> [bind Toplevel <Visibility>]
+ bind $w <Destroy> "+_tixToplevelDestroy $w"
+ bind $w <Map> "+_tixToplevelMap $w"
+ bind $w <Unmap> "+_tixToplevelUnmap $w"
+ bind $w <Visibility> "+_tixToplevelVisibility $w"
+}
+
+proc _tixToplevelDestroy {w} {
+ upvar #0 $w data
+
+ unset data
+}
+
+proc _tixToplevelUnmap {w} {
+ upvar #0 $w data
+
+ foreach dlg $data(dialogs) {
+ set data($dlg,geom) [winfo geometry $dlg]
+ wm withdraw $dlg
+ }
+}
+
+proc _tixToplevelMap {w} {
+ upvar #0 $w data
+
+ foreach dlg $data(dialogs) {
+ wm geometry $dlg $data($dlg,geom)
+ wm deiconify $dlg
+ }
+}
+
+proc _tixToplevelVisibility {w} {
+ upvar #0 $w data
+
+ foreach dlg $data(dialogs) {
+ raise $dlg $w
+ }
+}
+
+proc tixCreateDialogShell {w {type -mapped}} {
+ toplevel $w
+ set parent [winfo parent $w]
+ upvar #0 $parent data
+
+ wm minsize $w 0 0
+ wm withdraw $w
+ update
+ mwm transfor $w [winfo parent $w]
+ lappend data(dialogs) $w
+ bind $w <Destroy> "_tixDialogDestroy $w"
+
+ if {$type != "-withdrawn"} {
+ wm deiconify $w
+ }
+}
+
+proc _tixDialogDestroy {w} {
+ set parent [winfo parent $w]
+ upvar #0 $parent data
+
+ catch {unset $data($w,geom)}
+}
+
+
+proc _tixInitMainWindow {w} {
+ upvar #0 $w data
+
+ set data(dialogs) ""
+
+ bind $w <Destroy> +[bind Toplevel <Destroy>]
+ bind $w <Map> +[bind Toplevel <Map>]
+ bind $w <Unmap> +[bind Toplevel <Unmap>]
+ bind $w <Visibility> +[bind Toplevel <Visibility>]
+ bind $w <Destroy> "+_tixToplevelDestroy $w"
+ bind $w <Map> "+_tixToplevelMap $w"
+ bind $w <Unmap> "+_tixToplevelUnmap $w"
+ bind $w <Visibility> "+_tixToplevelVisibility $w"
+}
+
+# The "mwm" command comes from tkmwm, a cousin package of Tix
+# If this wish does not support mwm, the following line prevent code
+# that uses "mwm" from breaking.
+#
+if {[info commands mwm] == ""} {
+ proc mwm {args} {}
+}
+
+#----------------------------------------------------------------------
+# Automatically initialization call
+#----------------------------------------------------------------------
+
+# This has been disabled
+
+if 0 {
+ _tixInitMainWindow .
+}
+
diff --git a/tix/library/OptMenu.tcl b/tix/library/OptMenu.tcl
new file mode 100644
index 00000000000..a44c3334f60
--- /dev/null
+++ b/tix/library/OptMenu.tcl
@@ -0,0 +1,389 @@
+# OptMenu.tcl --
+#
+# This file implements the TixOptionMenu widget.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+tixWidgetClass tixOptionMenu {
+ -classname TixOptionMenu
+ -superclass tixLabelWidget
+ -method {
+ add delete disable enable entrycget entryconfigure entries
+ }
+ -flag {
+ -command -disablecallback -dynamicgeometry -value -variable
+ -validatecmd -state
+ }
+ -forcecall {
+ -variable -state
+ }
+ -configspec {
+ {-command command Command ""}
+ {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
+ {-dynamicgeometry dynamicGeometry DynamicGeometry 0 tixVerifyBoolean}
+ {-state state State normal}
+ {-value value Value ""}
+ {-validatecmd validateCmd ValidateCmd ""}
+ {-variable variable Variable ""}
+ }
+ -default {
+ {.highlightThickness 0}
+ {.takeFocus 0}
+ {.frame.menubutton.relief raised}
+ {.frame.menubutton.borderWidth 2}
+ {.frame.menubutton.anchor w}
+ {.frame.menubutton.highlightThickness 2}
+ {.frame.menubutton.takeFocus 1}
+ }
+}
+
+proc tixOptionMenu:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+
+ set data(nItems) 0
+ set data(items) ""
+ set data(posted) 0
+ set data(varInited) 0
+ set data(maxWidth) 0
+}
+
+proc tixOptionMenu:ConstructFramedWidget {w frame} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructFramedWidget $frame
+
+ set data(w:menubutton) [menubutton $frame.menubutton -indicatoron 1]
+ set data(w:menu) [menu $frame.menubutton.menu -tearoff 0]
+ pack $data(w:menubutton) -side left -expand yes -fill both
+
+ $data(w:menubutton) config -menu $data(w:menu)
+
+ bind $data(w:menubutton) <Up> [bind Menubutton <space>]
+ bind $data(w:menubutton) <Down> [bind Menubutton <space>]
+
+ tixSetMegaWidget $data(w:menubutton) $w
+}
+
+proc tixOptionMenu:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+}
+
+#----------------------------------------------------------------------
+# Private methods
+#----------------------------------------------------------------------
+proc tixOptionMenu:Invoke {w name} {
+ upvar #0 $w data
+
+ if {"$data(-state)" == "normal"} {
+ tixOptionMenu:SetValue $w $name
+ }
+}
+
+proc tixOptionMenu:SetValue {w value {noUpdate 0}} {
+ upvar #0 $w data
+
+ if {$data(-validatecmd) != ""} {
+ set value [tixEvalCmdBinding $w $data(-validatecmd) "" $value]
+ }
+
+ set name $value
+
+ if {$name == "" || [info exists data(varInited)]} {
+ # variable may contain a bogus value
+ if {![info exists data($name,index)]} {
+ set data(-value) ""
+ tixVariable:UpdateVariable $w
+ $data(w:menubutton) config -text ""
+ return
+ }
+ }
+
+ if [info exists data($name,index)] {
+ $data(w:menubutton) config -text $data($name,label)
+
+ set data(-value) $value
+
+ if {! $noUpdate} {
+ tixVariable:UpdateVariable $w
+ }
+
+ if {$data(-command) != "" && !$data(-disablecallback)} {
+ if {![info exists data(varInited)]} {
+ set bind(specs) ""
+ tixEvalCmdBinding $w $data(-command) bind $value
+ }
+ }
+ } else {
+ error "item \"$value\" does not exist"
+ }
+}
+
+proc tixOptionMenu:SetMaxWidth {w} {
+ upvar #0 $w data
+
+ foreach name $data(items) {
+ set len [string length $data($name,label)]
+ if {$data(maxWidth) < $len} {
+ set data(maxWidth) $len
+ }
+ }
+
+ if {$data(maxWidth) > 0} {
+ $data(w:menubutton) config -width $data(maxWidth)
+ }
+}
+
+#----------------------------------------------------------------------
+# Configuration
+#----------------------------------------------------------------------
+proc tixOptionMenu:config-state {w value} {
+ upvar #0 $w data
+
+ if ![info exists data(w:label)] {
+ return
+ }
+
+ if {$value == "normal"} {
+ catch {
+ $data(w:label) config -fg \
+ [$data(w:menubutton) cget -foreground]
+ }
+ $data(w:menubutton) config -state $value
+ } else {
+ catch {
+ $data(w:label) config -fg \
+ [$data(w:menubutton) cget -disabledforeground]
+ }
+ $data(w:menubutton) config -state $value
+ }
+}
+
+proc tixOptionMenu:config-value {w value} {
+ upvar #0 $w data
+
+ tixOptionMenu:SetValue $w $value
+
+ # This will tell the Intrinsics: "Please use this value"
+ # because "value" might be altered by SetValues
+ #
+ return $data(-value)
+}
+
+proc tixOptionMenu:config-variable {w arg} {
+ upvar #0 $w data
+
+ if [tixVariable:ConfigVariable $w $arg] {
+ # The value of data(-value) is changed if tixVariable:ConfigVariable
+ # returns true
+ tixOptionMenu:SetValue $w $data(-value) 1
+ }
+ catch {
+ unset data(varInited)
+ }
+ set data(-variable) $arg
+}
+
+#----------------------------------------------------------------------
+# Public Methdos
+#----------------------------------------------------------------------
+proc tixOptionMenu:add {w type name args} {
+ upvar #0 $w data
+
+ if [info exists data($name,index)] {
+ error "item $name already exists in the option menu $w"
+ }
+
+ case $type {
+ "command" {
+ set validOptions {
+ -command -label
+ }
+ set opt(-command) ""
+ set opt(-label) $name
+
+ tixHandleOptions -nounknown opt $validOptions $args
+
+ if {$opt(-command) != ""} {
+ error "option -command cannot be specified"
+ }
+
+ # Create a new item inside the menu
+ #
+ eval $data(w:menu) add command $args \
+ [list -label $opt(-label) \
+ -command "tixOptionMenu:Invoke $w \{$name\}"]
+ set index $data(nItems)
+
+ # Store info about this item
+ #
+ set data($index,name) $name
+ set data($name,type) cmd
+ set data($name,label) $opt(-label)
+ set data($name,index) $index
+
+ if {$index == 0} {
+ $data(w:menubutton) config -text $data($name,label)
+ tixOptionMenu:SetValue $w $name
+ }
+
+ incr data(nItems)
+ lappend data(items) $name
+
+ if $data(-dynamicgeometry) {
+ tixOptionMenu:SetMaxWidth $w
+ }
+ }
+ "separator" {
+ $data(w:menu) add separator
+
+ set index $data(nItems)
+ # Store info about this item
+ #
+ set data($index,name) $name
+ set data($name,type) sep
+ set data($name,label) ""
+ set data($name,index) $index
+
+ incr data(nItems)
+ lappend data(items) $name
+ }
+ default {
+ error "only types \"separator\" and \"command\" are allowed"
+ }
+ }
+
+ return ""
+}
+
+proc tixOptionMenu:delete {w item} {
+ upvar #0 $w data
+
+ if {![info exists data($item,index)]} {
+ error "item $item does not exist in $w"
+ }
+
+ # Rehash the item list
+ set newItems ""
+ set oldIndex 0
+ set newIndex 0
+ foreach name $data(items) {
+ if {$item == $name} {
+ unset data($name,label)
+ unset data($name,index)
+ unset data($name,type)
+ $data(w:menu) delete $oldIndex
+ } else {
+ set data($name,index) $newIndex
+ set data($newIndex,name) $name
+ incr newIndex
+ lappend newItems $name
+ }
+ incr oldIndex
+ }
+ incr oldIndex -1; unset data($oldIndex,name)
+ set data(nItems) $newIndex
+ set data(items) $newItems
+
+ if {$data(-value) == $item} {
+ set newVal ""
+ foreach item $data(items) {
+ if {$data($item,type) == "cmd"} {
+ set newVal $item
+ }
+ }
+ tixOptionMenu:SetValue $w $newVal
+ }
+
+ return ""
+}
+
+
+proc tixOptionMenu:disable {w item} {
+ upvar #0 $w data
+
+ if {![info exists data($item,index)]} {
+ error "item $item does not exist in $w"
+ } else {
+ catch {$data(w:menu) entryconfig $data($item,index) -state disabled}
+ }
+}
+
+proc tixOptionMenu:enable {w item} {
+ upvar #0 $w data
+
+ if {![info exists data($item,index)]} {
+ error "item $item does not exist in $w"
+ } else {
+ catch {$data(w:menu) entryconfig $data($item,index) -state normal}
+ }
+}
+
+proc tixOptionMenu:entryconfigure {w item args} {
+ upvar #0 $w data
+
+ if {![info exists data($item,index)]} {
+ error "item $item does not exist in $w"
+ } else {
+ return [eval $data(w:menu) entryconfig $data($item,index) $args]
+ }
+}
+
+proc tixOptionMenu:entrycget {w item arg} {
+ upvar #0 $w data
+
+ if {![info exists data($item,index)]} {
+ error "item $item does not exist in $w"
+ } else {
+ return [$data(w:menu) entrycget $data($item,index) $arg]
+ }
+}
+
+proc tixOptionMenu:entries {w} {
+ upvar #0 $w data
+
+ return $data(items)
+}
+
+
+proc tixOptionMenu:Destructor {w} {
+
+ tixVariable:DeleteVariable $w
+
+ # Chain this to the superclass
+ #
+ tixChainMethod $w Destructor
+}
+
+#----------------------------------------------------------------------
+# Obsolete
+# These have been replaced by new commands in Tk 4.0
+#
+proc tixOptionMenu:Post {w} {
+ upvar #0 $w data
+
+ set rootx [winfo rootx $data(w:frame)]
+ set rooty [winfo rooty $data(w:frame)]
+
+ # adjust for the border of the menu and frame
+ #
+ incr rootx [lindex [$data(w:menu) config -border] 4]
+ incr rooty [lindex [$data(w:frame) config -border] 4]
+ incr rooty [lindex [$data(w:menu) config -border] 4]
+
+ set value $data(-value)
+ set y [$data(w:menu) yposition $data($value,index)]
+
+ $data(w:menu) post $rootx [expr $rooty - $y]
+ $data(w:menu) activate $data($value,index)
+ grab -global $data(w:menubutton)
+ set data(posted) 1
+}
diff --git a/tix/library/PanedWin.tcl b/tix/library/PanedWin.tcl
new file mode 100644
index 00000000000..fff9241b50e
--- /dev/null
+++ b/tix/library/PanedWin.tcl
@@ -0,0 +1,1215 @@
+# PanedWin.tcl --
+#
+# This file implements the TixPanedWindow widget
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+tixWidgetClass tixPanedWindow {
+ -classname TixPanedWindow
+ -superclass tixPrimitive
+ -method {
+ add delete forget manage panecget paneconfigure panes setsize
+ }
+ -flag {
+ -command -dynamicgeometry -handleactivebg -handlebg -orient
+ -orientation -panebd -paneborderwidth -panerelief
+ -separatoractivebg -separatorbg
+ }
+ -static {
+ -orientation
+ }
+ -configspec {
+ {-command command Command ""}
+ {-dynamicgeometry dynamicGeometry DynamicGeometry 1 tixVerifyBoolean}
+ {-handleactivebg handleActiveBg HandleActiveBg #ececec}
+ {-handlebg handleBg Background #d9d9d9}
+ {-orientation orientation Orientation vertical}
+ {-paneborderwidth paneBorderWidth PaneBorderWidth 1}
+ {-panerelief paneRelief PaneRelief raised}
+ {-separatoractivebg separatorActiveBg SeparatorActiveBg red}
+ {-separatorbg separatorBg Background #d9d9d9}
+ }
+ -alias {
+ {-panebd -paneborderwidth}
+ {-orient -orientation}
+ }
+}
+
+#----------------------------------------------------------------------
+# ClassInitialization:
+#----------------------------------------------------------------------
+
+proc tixPanedWindow:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+
+ set data(items) ""
+ set data(nItems) 0
+ set data(totalsize) 0
+ set data(movePending) 0
+
+ set data(repack) 0
+ set data(counter) 0
+
+ set data(maxReqW) 1
+ set data(maxReqH) 1
+}
+
+proc tixPanedWindow:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+ # Do nothing
+}
+
+proc tixPanedWindow:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ bind $w <Configure> [list tixPanedWindow:MasterGeomProc $w ""]
+}
+
+#----------------------------------------------------------------------
+# ConfigOptions:
+#----------------------------------------------------------------------
+proc tixPanedWindow:config-handlebg {w arg} {
+ upvar #0 $w data
+
+ for {set i 1} {$i < $data(nItems)} {incr i} {
+ $data(btn,$i) config -bg $arg
+ }
+}
+
+#----------------------------------------------------------------------
+# PublicMethods:
+#----------------------------------------------------------------------
+
+
+# method: add
+#
+# Adds a new pane into the PanedWindow.
+#
+# options -size -max -min -allowresize
+#
+proc tixPanedWindow:add {w name args} {
+ upvar #0 $w data
+
+ if {[winfo exists $w.$name] && !$data($name,forgotten)} {
+ error "Pane $name is already managed"
+ }
+ # Step 1: Parse the options to get the children's size options
+
+ # The default values
+ #
+ if [info exists data($name,forgotten)] {
+ set option(-size) $data($name,size)
+ set option(-min) $data($name,min)
+ set option(-max) $data($name,max)
+ set option(-allowresize) $data($name,allowresize)
+ set option(-expand) $data($name,expand)
+ } else {
+ set option(-size) 0
+ set option(-min) 0
+ set option(-max) 100000
+ set option(-allowresize) 1
+ set option(-expand) 0
+ }
+
+ set option(-before) ""
+ set option(-after) ""
+ set option(-at) ""
+ set validOpts {-after -allowresize -at -before -expand -max -min -size}
+
+ tixHandleOptions option $validOpts $args
+
+ set data($name,size) $option(-size)
+ set data($name,rsize) $option(-size)
+ set data($name,min) $option(-min)
+ set data($name,max) $option(-max)
+ set data($name,allowresize) $option(-allowresize)
+ set data($name,expand) $option(-expand)
+ set data($name,forgotten) 0
+
+ if {$data($name,expand) < 0} {
+ set data($name,expand) 0
+ }
+
+ # Step 2: Add the frame and the separator (if necessary)
+ #
+ if {![winfo exist $w.$name]} {
+ # need to check because the frame may have been "forget'ten"
+ #
+ frame $w.$name -bd $data(-paneborderwidth) -relief $data(-panerelief)
+ }
+
+ if {$option(-at) != ""} {
+ set at [tixGetInt $option(-at)]
+ if {$at < 0} {
+ set at 0
+ }
+ } elseif {$option(-after) != ""} {
+ set index [lsearch -exact $data(items) $option(-after)]
+ if {$index == -1} {
+ error "Pane $option(-after) doesn't exists"
+ } else {
+ set at [incr index]
+ }
+ } elseif {$option(-before) != ""} {
+ set index [lsearch -exact $data(items) $option(-before)]
+ if {$index == -1} {
+ error "Pane $option(-before) doesn't exists"
+ }
+ set at $index
+ } else {
+ set at end
+ }
+
+ set data(items) [linsert $data(items) $at $name]
+ incr data(nItems)
+
+ if {$data(nItems) > 1} {
+ tixPanedWindow:AddSeparator $w
+ }
+ set data(w:$name) $w.$name
+
+ # Step 3: Add the new frame. Adjust the window later (do when idle)
+ #
+ tixManageGeometry $w.$name "tixPanedWindow:ClientGeomProc $w"
+ bind $w.$name <Configure> \
+ [list tixPanedWindow:ClientGeomProc $w "" $w.$name]
+
+ tixPanedWindow:RepackWhenIdle $w
+
+ return $w.$name
+}
+
+proc tixPanedWindow:manage {w name args} {
+ upvar #0 $w data
+
+ if {![winfo exists $w.$name]} {
+ error "Pane $name does not exist"
+ }
+ if {!$data($name,forgotten)} {
+ error "Pane $name is already managed"
+ }
+ tixMapWindow $data(w:$name)
+ eval tixPanedWindow:add $w [list $name] $args
+}
+
+proc tixPanedWindow:forget {w name} {
+ upvar #0 $w data
+
+ if {![winfo exists $w.$name]} {
+ error "Pane $name does not exist"
+ }
+ if $data($name,forgotten) {
+ # It has already been forgotten
+ #
+ return
+ }
+
+ set items ""
+ foreach item $data(items) {
+ if {$item != $name} {
+ lappend items $item
+ }
+ }
+ set data(items) $items
+ incr data(nItems) -1
+
+ set i $data(nItems)
+ if {$i > 0} {
+ destroy $data(btn,$i)
+ destroy $data(sep,$i)
+ unset data(btn,$i)
+ unset data(sep,$i)
+ }
+ set data($name,forgotten) 1
+
+ tixUnmapWindow $w.$name
+
+ tixPanedWindow:RepackWhenIdle $w
+}
+
+proc tixPanedWindow:delete {w name} {
+ upvar #0 $w data
+
+ if {![winfo exists $w.$name]} {
+ error "Pane $name does not exist"
+ }
+
+
+ if {!$data($name,forgotten)} {
+ set items ""
+ foreach item $data(items) {
+ if {$item != $name} {
+ lappend items $item
+ }
+ }
+ set data(items) $items
+ incr data(nItems) -1
+
+ set i $data(nItems)
+ if {$i > 0} {
+ destroy $data(btn,$i)
+ destroy $data(sep,$i)
+ unset data(btn,$i)
+ unset data(sep,$i)
+ }
+ }
+ unset data($name,allowresize)
+ unset data($name,expand)
+ unset data($name,forgotten)
+ unset data($name,max)
+ unset data($name,min)
+ unset data($name,rsize)
+ unset data($name,size)
+ unset data(w:$name)
+ destroy $w.$name
+
+ tixPanedWindow:RepackWhenIdle $w
+}
+
+proc tixPanedWindow:paneconfigure {w name args} {
+ upvar #0 $w data
+
+ if {![info exists data($name,size)]} {
+ error "pane \"$name\" does not exist in $w"
+ }
+
+ set len [llength $args]
+
+ if {$len == 0} {
+ set value [$data(w:$name) configure]
+ lappend value [list -allowresize "" "" "" $data($name,allowresize)]
+ lappend value [list -expand "" "" "" $data($name,expand)]
+ lappend value [list -max "" "" "" $data($name,max)]
+ lappend value [list -min "" "" "" $data($name,min)]
+ lappend value [list -size "" "" "" $data($name,size)]
+ return $value
+ }
+
+ if {$len == 1} {
+ case [lindex $args 0] {
+ -allowresize {
+ return [list -allowresize "" "" "" $data($name,allowresize)]
+ }
+ -expand {
+ return [list -expand "" "" "" $data($name,expand)]
+ }
+ -min {
+ return [list -min "" "" "" $data($name,min)]
+ }
+ -max {
+ return [list -max "" "" "" $data($name,max)]
+ }
+ -size {
+ return [list -size "" "" "" $data($name,size)]
+ }
+ default {
+ return [$data(w:$name) configure [lindex $args 0]]
+ }
+ }
+ }
+
+ # By default handle each of the options
+ #
+ set option(-allowresize) $data($name,allowresize)
+ set option(-expand) $data($name,expand)
+ set option(-min) $data($name,min)
+ set option(-max) $data($name,max)
+ set option(-size) $data($name,size)
+
+ tixHandleOptions -nounknown option {-allowresize -expand -max -min -size} \
+ $args
+
+ #
+ # the widget options
+ set new_args ""
+ tixForEach {flag value} $args {
+ case $flag {
+ {-expand -min -max -allowresize -size} {
+
+ }
+ default {
+ lappend new_args $flag
+ lappend new_args $value
+ }
+ }
+ }
+
+ if {[llength $new_args] >= 2} {
+ eval $data(w:$name) configure $new_args
+ }
+
+ #
+ # The add-on options
+ set data($name,allowresize) $option(-allowresize)
+ set data($name,expand) $option(-expand)
+ set data($name,max) $option(-max)
+ set data($name,min) $option(-min)
+ set data($name,rsize) $option(-size)
+ set data($name,size) $option(-size)
+
+ #
+ # Integrity check
+ if {$data($name,expand) < 0} {
+ set data($name,expand) 0
+ }
+ if {$data($name,size) < $data($name,min)} {
+ set data($name,size) $data($name,min)
+ }
+ if {$data($name,size) > $data($name,max)} {
+ set data($name,size) $data($name,max)
+ }
+
+ tixPanedWindow:RepackWhenIdle $w
+ return ""
+}
+
+proc tixPanedWindow:panecget {w name option} {
+ upvar #0 $w data
+
+ if {![info exists data($name,size)]} {
+ error "pane \"$name\" does not exist in $w"
+ }
+
+ case $option {
+ {-min -max -allowresize -size} {
+ regsub \\\- $option "" option
+ return "$data($name,$option)"
+ }
+ default {
+ return [$data(w:$name) cget $option]
+ }
+ }
+}
+
+# return the name of all panes
+proc tixPanedWindow:panes {w} {
+ upvar #0 $w data
+
+ return $data(items)
+}
+
+# set the size of a pane, specifying which direction it should
+# grow/shrink
+proc tixPanedWindow:setsize {w item size {direction next}} {
+ upvar #0 $w data
+
+ set posn [lsearch $data(items) $item]
+ if {$posn == -1} {
+ error "pane \"$item\" does not exist"
+ }
+
+ set diff [expr $size - $data($item,size)]
+ if {$diff == 0} {
+ return
+ }
+
+ if {$posn == 0 && $direction == "prev"} {
+ set direction next
+ }
+ if {$posn == [expr $data(nItems)-1] && $direction == "next"} {
+ set direction prev
+ }
+
+ if {$data(-orientation) == "vertical"} {
+ set rx [winfo rooty $data(w:$item)]
+ } else {
+ set rx [winfo rootx $data(w:$item)]
+ }
+ if {$direction == "prev"} {
+ set rx [expr $rx - $diff]
+ } elseif {$data(-orientation) == "vertical"} {
+ set rx [expr $rx + [winfo height $data(w:$item)] + $diff]
+ incr posn
+ } else {
+ set rx [expr $rx + [winfo width $data(w:$item)] + $diff]
+ incr posn
+ }
+
+ # Set up the panedwin in a proper state
+ #
+ tixPanedWindow:BtnDown $w $posn 1
+ tixPanedWindow:BtnMove $w $posn $rx 1
+ tixPanedWindow:BtnUp $w $posn 1
+
+ return $data(items)
+}
+
+#----------------------------------------------------------------------
+# PrivateMethods:
+#----------------------------------------------------------------------
+
+proc tixPanedWindow:AddSeparator {w} {
+ global tcl_platform
+
+ upvar #0 $w data
+
+ set n [expr $data(nItems)-1]
+
+ # CYGNUS LOCAL: On Windows, use relief ridge and a thicker line.
+ if {$tcl_platform(platform) == "windows"} then {
+ set relief "ridge"
+ set thickness 4
+ } else {
+ set relief "sunken"
+ set thickness 2
+ }
+ if {$data(-orientation) == "vertical"} {
+ set data(sep,$n) [frame $w.sep$n -relief $relief \
+ -bd 1 -height $thickness -width 10000 -bg $data(-separatorbg)]
+ } else {
+ set data(sep,$n) [frame $w.sep$n -relief $relief \
+ -bd 1 -width $thickness -height 10000 -bg $data(-separatorbg)]
+ }
+
+ set data(btn,$n) [frame $w.btn$n -relief raised \
+ -bd 1 -width 9 -height 9 \
+ -bg $data(-handlebg)]
+
+ if {$data(-orientation) == "vertical"} {
+ set cursor sb_v_double_arrow
+ } else {
+ set cursor sb_h_double_arrow
+ }
+ $data(sep,$n) config -cursor $cursor
+ $data(btn,$n) config -cursor $cursor
+
+ foreach wid "$data(btn,$n) $data(sep,$n)" {
+ bind $wid \
+ <ButtonPress-1> "tixPanedWindow:BtnDown $w $n"
+ bind $wid \
+ <ButtonRelease-1> "tixPanedWindow:BtnUp $w $n"
+ bind $wid \
+ <Any-Enter> "tixPanedWindow:HighlightBtn $w $n"
+ bind $wid \
+ <Any-Leave> "tixPanedWindow:DeHighlightBtn $w $n"
+ }
+
+ if {$data(-orientation) == "vertical"} {
+ bind $data(btn,$n) <B1-Motion> \
+ "tixPanedWindow:BtnMove $w $n %Y"
+ } else {
+ bind $data(btn,$n) <B1-Motion> \
+ "tixPanedWindow:BtnMove $w $n %X"
+ }
+
+ if {$data(-orientation) == "vertical"} {
+# place $data(btn,$n) -relx 0.90 -y [expr "$data(totalsize)-5"]
+# place $data(sep,$n) -x 0 -y [expr "$data(totalsize)-1"] -relwidth 1
+ } else {
+# place $data(btn,$n) -rely 0.90 -x [expr "$data(totalsize)-5"]
+# place $data(sep,$n) -y 0 -x [expr "$data(totalsize)-1"] -relheight 1
+ }
+}
+
+proc tixPanedWindow:BtnDown {w item {fake 0}} {
+ upvar #0 $w data
+
+ if {$data(-orientation) == "vertical"} {
+ set spec -height
+ } else {
+ set spec -width
+ }
+
+ if {!$fake} {
+ for {set i 1} {$i < $data(nItems)} {incr i} {
+ $data(sep,$i) config -bg $data(-separatoractivebg) $spec 1
+ }
+ update idletasks
+ $data(btn,$item) config -relief sunken
+ }
+
+ tixPanedWindow:GetMotionLimit $w $item $fake
+
+ if {!$fake} {
+ grab -global $data(btn,$item)
+ }
+ set data(movePending) 0
+}
+
+proc tixPanedWindow:Min2 {a b} {
+ if {$a < $b} {
+ return $a
+ } else {
+ return $b
+ }
+}
+
+proc tixPanedWindow:GetMotionLimit {w item fake} {
+ upvar #0 $w data
+
+ set curBefore 0
+ set minBefore 0
+ set maxBefore 0
+
+ for {set i 0} {$i < $item} {incr i} {
+ set name [lindex $data(items) $i]
+ incr curBefore $data($name,size)
+ incr minBefore $data($name,min)
+ incr maxBefore $data($name,max)
+ }
+
+ set curAfter 0
+ set minAfter 0
+ set maxAfter 0
+ while {$i < $data(nItems)} {
+ set name [lindex $data(items) $i]
+ incr curAfter $data($name,size)
+ incr minAfter $data($name,min)
+ incr maxAfter $data($name,max)
+ incr i
+ }
+
+ set beforeToGo [tixPanedWindow:Min2 \
+ [expr "$curBefore-$minBefore"] [expr "$maxAfter-$curAfter"]]
+
+ set afterToGo [tixPanedWindow:Min2 \
+ [expr "$curAfter-$minAfter"] [expr "$maxBefore-$curBefore"]]
+
+ set data(beforeLimit) [expr "$curBefore-$beforeToGo"]
+ set data(afterLimit) [expr "$curBefore+$afterToGo"]
+ set data(curSize) $curBefore
+
+ if {!$fake} {
+ tixPanedWindow:PlotHandles $w 1
+ }
+}
+
+# Compress the motion so that update is quick even on slow machines
+#
+# rootp = root position (either rootx or rooty)
+proc tixPanedWindow:BtnMove {w item rootp {fake 0}} {
+ upvar #0 $w data
+
+ set data(rootp) $rootp
+
+ if {$fake} {
+ tixPanedWindow:BtnMoveCompressed $w $item $fake
+ } else {
+ if {$data(movePending) == 0} {
+ after 2 tixPanedWindow:BtnMoveCompressed $w $item
+ set data(movePending) 1
+ }
+ }
+}
+
+proc tixPanedWindow:BtnMoveCompressed {w item {fake 0}} {
+ if {![winfo exists $w]} {
+ return
+ }
+
+ upvar #0 $w data
+
+ if {$data(-orientation) == "vertical"} {
+ set p [expr $data(rootp)-[winfo rooty $w]]
+ } else {
+ set p [expr $data(rootp)-[winfo rootx $w]]
+ }
+
+ if {$p == $data(curSize)} {
+ set data(movePending) 0
+ return
+ }
+
+ if {$p < $data(beforeLimit)} {
+ set p $data(beforeLimit)
+ }
+ if {$p >= $data(afterLimit)} {
+ set p $data(afterLimit)
+ }
+ tixPanedWindow:CalculateChange $w $item $p $fake
+
+ if {!$fake} {
+ # Force the redraw to happen
+ #
+ update idletasks
+ }
+ set data(movePending) 0
+}
+
+# Calculate the change in response to mouse motions
+#
+proc tixPanedWindow:CalculateChange {w item p {fake 0}} {
+ upvar #0 $w data
+
+ if {$p < $data(curSize)} {
+ tixPanedWindow:MoveBefore $w $item $p
+ } elseif {$p > $data(curSize)} {
+ tixPanedWindow:MoveAfter $w $item $p
+ }
+
+ if {!$fake} {
+ tixPanedWindow:PlotHandles $w 1
+ }
+}
+
+proc tixPanedWindow:MoveBefore {w item p} {
+ upvar #0 $w data
+
+ set n [expr "$data(curSize)-$p"]
+
+ # Shrink the frames before
+ #
+ set from [expr $item-1]
+ set to 0
+ tixPanedWindow:Iterate $w $from $to tixPanedWindow:Shrink $n
+
+ # Adjust the frames after
+ #
+ set from $item
+ set to [expr "$data(nItems)-1"]
+ tixPanedWindow:Iterate $w $from $to tixPanedWindow:Grow $n
+
+ set data(curSize) $p
+}
+
+proc tixPanedWindow:MoveAfter {w item p} {
+ upvar #0 $w data
+
+ set n [expr "$p-$data(curSize)"]
+
+ # Shrink the frames after
+ #
+ set from $item
+ set to [expr "$data(nItems)-1"]
+ tixPanedWindow:Iterate $w $from $to tixPanedWindow:Shrink $n
+
+ # Graw the frame before
+ #
+ set from [expr $item-1]
+ set to 0
+ tixPanedWindow:Iterate $w $from $to tixPanedWindow:Grow $n
+
+ set data(curSize) $p
+}
+
+proc tixPanedWindow:CancleLines {w} {
+ upvar #0 $w data
+
+ if [info exists data(lines)] {
+ foreach line $data(lines) {
+ set x1 [lindex $line 0]
+ set y1 [lindex $line 1]
+ set x2 [lindex $line 2]
+ set y2 [lindex $line 3]
+
+ tixTmpLine $x1 $y1 $x2 $y2 $w
+ }
+
+ catch {unset data(lines)}
+ }
+}
+
+proc tixPanedWindow:PlotHandles {w transient} {
+ global tcl_platform
+
+ upvar #0 $w data
+
+ set totalsize 0
+ set i 0
+
+ if {$data(-orientation) == "vertical"} {
+ set btnp [expr [winfo width $w]-13]
+ } else {
+ set h [winfo height $w]
+ if {$h > 18} {
+ set btnp 9
+ } else {
+ set btnp [expr $h-9]
+ }
+ }
+
+ set firstpane [lindex $data(items) 0]
+ set totalsize $data($firstpane,size)
+
+ if {$transient} {
+ tixPanedWindow:CancleLines $w
+ set data(lines) ""
+ }
+
+ for {set i 1} {$i < $data(nItems)} {incr i} {
+ if {! $transient} {
+ if {$data(-orientation) == "vertical"} {
+ # CYGNUS LOCAL: Don't use buttons on Windows
+ if {$tcl_platform(platform) != "windows"} then {
+ place $data(btn,$i) -x $btnp -y [expr "$totalsize-4"]
+ }
+ place $data(sep,$i) -x 0 -y [expr "$totalsize-1"] -relwidth 1
+ } else {
+ # CYGNUS LOCAL: Don't use buttons on Windows
+ if {$tcl_platform(platform) != "windows"} then {
+ place $data(btn,$i) -y $btnp -x [expr "$totalsize-5"]
+ }
+ place $data(sep,$i) -y 0 -x [expr "$totalsize-1"] -relheight 1
+ }
+ } else {
+ if {$data(-orientation) == "vertical"} {
+ set x1 [winfo rootx $w]
+ set x2 [expr $x1 + [winfo width $w]]
+ set y [expr $totalsize-1+[winfo rooty $w]]
+
+ tixTmpLine $x1 $y $x2 $y $w
+ lappend data(lines) [list $x1 $y $x2 $y]
+ } else {
+ set y1 [winfo rooty $w]
+ set y2 [expr $y1 + [winfo height $w]]
+ set x [expr $totalsize-1+[winfo rootx $w]]
+
+ tixTmpLine $x $y1 $x $y2 $w
+ lappend data(lines) [list $x $y1 $x $y2]
+ }
+ }
+
+ set name [lindex $data(items) $i]
+ incr totalsize $data($name,size)
+ }
+}
+
+proc tixPanedWindow:BtnUp {w item {fake 0}} {
+ upvar #0 $w data
+
+ if {!$fake} {
+ tixPanedWindow:CancleLines $w
+ }
+
+ tixPanedWindow:UpdateSizes $w
+
+ if {!$fake} {
+ $data(btn,$item) config -relief raised
+ grab release $data(btn,$item)
+ }
+}
+
+
+proc tixPanedWindow:HighlightBtn {w item} {
+ upvar #0 $w data
+
+ $data(btn,$item) config -background $data(-handleactivebg)
+}
+
+proc tixPanedWindow:DeHighlightBtn {w item} {
+ upvar #0 $w data
+
+ $data(btn,$item) config -background $data(-handlebg)
+}
+
+#----------------------------------------------------------------------
+#
+#
+# Geometry management routines
+#
+#
+#----------------------------------------------------------------------
+
+# update the sizes of each pane according to the data($name,size) variables
+#
+proc tixPanedWindow:UpdateSizes {w} {
+ global tcl_platform
+
+ upvar #0 $w data
+
+ set data(totalsize) 0
+
+ set mw [winfo width $w]
+ set mh [winfo height $w]
+
+ for {set i 0} {$i < $data(nItems)} {incr i} {
+ set name [lindex $data(items) $i]
+
+ if {$data($name,size) > 0} {
+ if {$data(-orientation) == "vertical"} {
+ tixMoveResizeWindow $w.$name 0 $data(totalsize) \
+ $mw $data($name,size)
+ tixMapWindow $w.$name
+ raise $w.$name
+ } else {
+ tixMoveResizeWindow $w.$name $data(totalsize) 0 \
+ $data($name,size) $mh
+ tixMapWindow $w.$name
+ raise $w.$name
+ }
+ } else {
+ tixUnmapWindow $w.$name
+ }
+ incr data(totalsize) $data($name,size)
+ }
+
+ # Reset the color and width of the separator
+ #
+ if {$data(-orientation) == "vertical"} {
+ set spec -height
+ } else {
+ set spec -width
+ }
+
+ # CYGNUS LOCAL: On Windows, use a thicker line.
+ if {$tcl_platform(platform) == "windows"} then {
+ set thickness 4
+ } else {
+ set thickness 2
+ }
+
+ for {set i 1} {$i < $data(nItems)} {incr i} {
+ $data(sep,$i) config -bg $data(-separatorbg) $spec $thickness
+ raise $data(sep,$i)
+ raise $data(btn,$i)
+ }
+
+
+ # Invoke the callback command
+ #
+ if {$data(-command) != ""} {
+ set sizes ""
+ foreach item $data(items) {
+ lappend sizes $data($item,size)
+ }
+ set bind(specs) ""
+ tixEvalCmdBinding $w $data(-command) bind [list $sizes]
+ }
+}
+
+proc tixPanedWindow:GetNaturalSizes {w} {
+ upvar #0 $w data
+
+ set data(totalsize) 0
+ set totalreq 0
+
+ if {$data(-orientation) == "vertical"} {
+ set majorspec height
+ set minorspec width
+ } else {
+ set majorspec width
+ set minorspec height
+ }
+
+ set minorsize 0
+ foreach name $data(items) {
+ if {[winfo manager $w.$name] != "tixGeometry"} {
+ error "Geometry management error: pane \"$w.$name\" cannot be managed by \"[winfo manager $w.$name]\"\nhint: delete the line \"[winfo manager $w.$name] $w.$name ...\" from your program"
+ }
+
+ # set the minor size
+ #
+ set req_minor [winfo req$minorspec $w.$name]
+
+ if {$req_minor > $minorsize} {
+ set minorsize $req_minor
+ }
+
+ # Check the natural size against the max, min requirements.
+ # Change the natural size if necessary
+ #
+ if {$data($name,size) <= 1} {
+ set data($name,size) [winfo req$majorspec $w.$name]
+ }
+
+ if {$data($name,size) > 1} {
+ # If we get zero maybe the widget was not initialized yet ...
+ #
+ # %% hazard : what if the window is really 1x1?
+ #
+ if {$data($name,size) < $data($name,min)} {
+ set data($name,size) $data($name,min)
+ }
+ if {$data($name,size) > $data($name,max)} {
+ set data($name,size) $data($name,max)
+ }
+ }
+
+ # kludge: because a frame always returns req size of {1,1} before
+ # the packer processes it, we do the following to mark the
+ # pane as "size unknown"
+ #
+# if {$data($name,size) == 1 && ![winfo ismapped $w.$name]} {
+# set data($name,size) 0
+# }
+
+ # Add up the total size
+ #
+ incr data(totalsize) $data($name,size)
+
+ # Find out the request size
+ #
+ if {$data($name,rsize) == 0} {
+ set rsize [winfo req$majorspec $w.$name]
+ } else {
+ set rsize $data($name,rsize)
+ }
+
+ if {$rsize < $data($name,min)} {
+ set rsize $data($name,min)
+ }
+ if {$rsize > $data($name,max)} {
+ set rsize $data($name,max)
+ }
+
+ incr totalreq $rsize
+ }
+
+ if {$data(-orientation) == "vertical"} {
+ return "$minorsize $totalreq"
+ } else {
+ return "$totalreq $minorsize"
+ }
+}
+
+#--------------------------------------------------
+# Handling resize
+#--------------------------------------------------
+proc tixPanedWindow:ClientGeomProc {w type client} {
+ tixPanedWindow:RepackWhenIdle $w
+}
+
+#
+# This monitor the sizes of the master window
+#
+proc tixPanedWindow:MasterGeomProc {w master} {
+ tixPanedWindow:RepackWhenIdle $w
+}
+
+proc tixPanedWindow:RepackWhenIdle {w} {
+ if {![winfo exist $w]} {
+ return
+ }
+ upvar #0 $w data
+
+ if {$data(repack) == 0} {
+ tixWidgetDoWhenIdle tixPanedWindow:Repack $w
+ set data(repack) 1
+ }
+}
+
+#
+# This monitor the sizes of the master window
+#
+proc tixPanedWindow:Repack {w} {
+ upvar #0 $w data
+
+ # Calculate the desired size of the master
+ #
+ set dim [tixPanedWindow:GetNaturalSizes $w]
+
+ if {$data(-width) != 0} {
+ set mreqw $data(-width)
+ } else {
+ set mreqw [lindex $dim 0]
+ }
+
+ if {$data(-height) != 0} {
+ set mreqh $data(-height)
+ } else {
+ set mreqh [lindex $dim 1]
+ }
+
+ if !$data(-dynamicgeometry) {
+ if {$mreqw < $data(maxReqW)} {
+ set mreqw $data(maxReqW)
+ }
+ if {$mreqh < $data(maxReqH)} {
+ set mreqh $data(maxReqH)
+ }
+ set data(maxReqW) $mreqw
+ set data(maxReqH) $mreqh
+ }
+ if {$mreqw != [winfo reqwidth $w] || $mreqh != [winfo reqheight $w] } {
+ if {![info exists data(counter)]} {
+ set data(counter) 0
+ }
+ if {$data(counter) < 50} {
+ incr data(counter)
+ tixGeometryRequest $w $mreqw $mreqh
+ tixWidgetDoWhenIdle tixPanedWindow:Repack $w
+ set data(repack) 1
+ return
+ }
+ }
+
+ set data(counter) 0
+
+ if {$data(nItems) == 0} {
+ set data(repack) 0
+ return
+ }
+
+ tixWidgetDoWhenIdle tixPanedWindow:DoRepack $w
+}
+
+proc tixPanedWindow:DoRepack {w} {
+ upvar #0 $w data
+
+ if {$data(-orientation) == "vertical"} {
+ set newSize [winfo height $w]
+ } else {
+ set newSize [winfo width $w]
+ }
+
+ if {$newSize <= 1} {
+ # Probably this window is too small to see anyway
+ # %%Kludge: I don't know if this always work.
+ #
+ set data(repack) 0
+ return
+ }
+
+ set totalExp 0
+ foreach name $data(items) {
+ set totalExp [expr $totalExp + $data($name,expand)]
+ }
+
+ if {$newSize > $data(totalsize)} {
+ # Grow
+ #
+ set toGrow [expr "$newSize-$data(totalsize)"]
+
+ set p [llength $data(items)]
+ foreach name $data(items) {
+ set toGrow [tixPanedWindow:xGrow $w $name $toGrow $totalExp $p]
+ if {$toGrow > 0} {
+ set totalExp [expr $totalExp-$data($name,expand)]
+ incr p -1
+ } else {
+ break
+ }
+ }
+ } else {
+ # Shrink
+ #
+ set toShrink [expr "$data(totalsize)-$newSize"]
+
+ set usedSize 0
+ foreach name $data(items) {
+ set toShrink [tixPanedWindow:xShrink $w $name $toShrink \
+ $totalExp $newSize $usedSize]
+ if {$toShrink > 0} {
+ set totalExp [expr $totalExp-$data($name,expand)]
+ incr usedSize $data($name,size)
+ } else {
+ break
+ }
+ }
+ }
+
+ tixPanedWindow:UpdateSizes $w
+ tixPanedWindow:PlotHandles $w 0
+
+ set data(repack) 0
+}
+
+#--------------------------------------------------
+# Shrink and grow items
+#--------------------------------------------------
+#
+# toGrow: how much free area to grow into
+# p: == 1 if $name is the last in the list of items
+# totalExp: used to calculate the amount of the free area that this
+# window can grow into
+#
+proc tixPanedWindow:xGrow {w name toGrow totalExp p} {
+ upvar #0 $w data
+
+ if {$p == 1} {
+ set canGrow $toGrow
+ } else {
+ if {$totalExp == 0} {
+ set canGrow 0
+ } else {
+ set canGrow [expr int($toGrow * $data($name,expand) / $totalExp)]
+ }
+ }
+
+ if {[expr $canGrow + $data($name,size)] > $data($name,max)} {
+ set canGrow [expr $data($name,max) - $data($name,size)]
+ }
+
+ incr data($name,size) $canGrow
+ incr toGrow -$canGrow
+
+ return $toGrow
+}
+
+proc tixPanedWindow:xShrink {w name toShrink totalExp newSize usedSize} {
+ upvar #0 $w data
+
+ if {$totalExp == 0} {
+ set canShrink 0
+ } else {
+ set canShrink [expr int($toShrink * $data($name,expand) / $totalExp)]
+ }
+
+ if {[expr $data($name,size) - $canShrink] < $data($name,min)} {
+ set canShrink [expr $data($name,size) -$data($name,min)]
+ }
+ if {[expr $usedSize + $data($name,size) - $canShrink] > $newSize} {
+ set data($name,size) [expr $newSize - $usedSize]
+ return 0
+ } else {
+ incr data($name,size) -$canShrink
+ incr toShrink -$canShrink
+
+ return $toShrink
+ }
+}
+
+#--------------------------------------------------
+# Shrink and grow items
+#--------------------------------------------------
+proc tixPanedWindow:Shrink {w name n} {
+ upvar #0 $w data
+
+ set canShrink [expr "$data($name,size) - $data($name,min)"]
+
+ if {$canShrink > $n} {
+ incr data($name,size) -$n
+ return 0
+ } elseif {$canShrink > 0} {
+ set data($name,size) $data($name,min)
+ incr n -$canShrink
+ }
+ return $n
+}
+
+proc tixPanedWindow:Grow {w name n} {
+ upvar #0 $w data
+
+ set canGrow [expr "$data($name,max) - $data($name,size)"]
+
+ if {$canGrow > $n} {
+ incr data($name,size) $n
+ return 0
+ } elseif {$canGrow > 0} {
+ set data($name,size) $data($name,max)
+ incr n -$canGrow
+ }
+
+ return $n
+}
+
+proc tixPanedWindow:Iterate {w from to proc n} {
+ upvar #0 $w data
+
+ if {$from <= $to} {
+ for {set i $from} {$i <= $to} {incr i} {
+ set n [$proc $w [lindex $data(items) $i] $n]
+ if {$n == 0} {
+ break
+ }
+ }
+ } else {
+ for {set i $from} {$i >= $to} {incr i -1} {
+ set n [$proc $w [lindex $data(items) $i] $n]
+ if {$n == 0} {
+ break
+ }
+ }
+ }
+}
diff --git a/tix/library/PopMenu.tcl b/tix/library/PopMenu.tcl
new file mode 100644
index 00000000000..5e6a7b9f0ef
--- /dev/null
+++ b/tix/library/PopMenu.tcl
@@ -0,0 +1,218 @@
+# PopMenu.tcl --
+#
+# This file implements the TixPopupMenu widget
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixPopupMenu {
+ -classname TixPopupMenu
+ -superclass tixShell
+ -method {
+ bind post unbind
+ }
+ -flag {
+ -buttons -installcolormap -postcmd -spring -state -title
+ }
+ -configspec {
+ {-buttons buttons Buttons {{3 {Any}}}}
+ {-installcolormap installColormap InstallColormap false}
+ {-postcmd postCmd PostCmd ""}
+ {-spring spring Spring 1 tixVerifyBoolean}
+ {-state state State normal}
+
+ {-cursor corsor Cursur arrow}
+ }
+ -static {
+ -buttons
+ }
+ -default {
+ {*Menu.tearOff 0}
+ }
+}
+
+proc tixPopupMenu:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+
+ set data(g:clients) ""
+}
+
+proc tixPopupMenu:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ wm overrideredirect $w 1
+ wm withdraw $w
+
+ set data(w:menubutton) [menubutton $w.menubutton -text $data(-title) \
+ -menu $w.menubutton.menu -anchor w]
+ set data(w:menu) [menu $w.menubutton.menu]
+
+ pack $data(w:menubutton) -expand yes -fill both
+}
+
+proc tixPopupMenu:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ foreach elm $data(-buttons) {
+ set btn [lindex $elm 0]
+ foreach mod [lindex $elm 1] {
+ tixBind TixPopupMenu:MB:$w <$mod-ButtonPress-$btn> \
+ "tixPopupMenu:Unpost $w"
+
+ tixBind TixPopupMenu:$w <$mod-ButtonPress-$btn> \
+ "tixPopupMenu:post $w %W %x %y"
+ }
+
+ tixBind TixPopupMenu:MB:$w <ButtonRelease-$btn> \
+ "tixPopupMenu:BtnRelease $w %X %Y"
+
+ tixBind TixPopupMenu:M:$w <Unmap> \
+ "tixPopupMenu:Unmap $w"
+ tixBind TixPopupMenu:$w <ButtonRelease-$btn> \
+ "tixPopupMenu:BtnRelease $w %X %Y"
+
+ tixAddBindTag $data(w:menubutton) TixPopupMenu:MB:$w
+ tixAddBindTag $data(w:menu) TixPopupMenu:M:$w
+ }
+}
+
+
+#----------------------------------------------------------------------
+# PrivateMethods:
+#----------------------------------------------------------------------
+proc tixPopupMenu:Unpost {w} {
+ upvar #0 $w data
+
+ catch {
+ tkMenuUnpost ""
+ }
+# tkMbButtonUp $data(w:menubutton)
+}
+
+proc tixPopupMenu:BtnRelease {w rootX rootY} {
+ upvar #0 $w data
+
+ set cW [winfo containing $rootX $rootY]
+
+ if {$data(-spring)} {
+ tixPopupMenu:Unpost $w
+ }
+}
+
+proc tixPopupMenu:Unmap {w} {
+ upvar #0 $w data
+ wm withdraw $w
+}
+
+proc tixPopupMenu:Destructor {w} {
+ upvar #0 $w data
+
+ foreach client $data(g:clients) {
+ if [winfo exists $client] {
+ tixDeleteBindTag $client TixPopupMenu:$w
+ }
+ }
+
+ # delete the extra bindings
+ #
+ foreach tag [list TixPopupMenu:MB:$w TixPopupMenu:M:$w] {
+ foreach e [bind $tag] {
+ bind $tag $e ""
+ }
+ }
+
+ tixChainMethod $w Destructor
+}
+
+proc tixPopupMenu:config-title {w value} {
+ upvar #0 $w data
+
+ $data(w:menubutton) config -text $value
+}
+
+#----------------------------------------------------------------------
+# PublicMethods:
+#----------------------------------------------------------------------
+proc tixPopupMenu:bind {w args} {
+ upvar #0 $w data
+
+ foreach client $args {
+ if {[lsearch $data(g:clients) $client] == -1} {
+ lappend data(g:clients) $client
+ tixAppendBindTag $client TixPopupMenu:$w
+ }
+ }
+}
+
+proc tixPopupMenu:unbind {w args} {
+ upvar #0 $w data
+
+ foreach client $args {
+ if [winfo exists $client] {
+ set index [lsearch $data(g:clients) $client]
+ if {$index != -1} {
+ tixDeleteBindTag $client TixPopupMenu:$w
+ set data(g:clients) [lreplace $data(g:clients) $index $index]
+ }
+ }
+ }
+}
+
+proc tixPopupMenu:post {w client x y} {
+ upvar #0 $w data
+ global tkPriv
+
+ if {$data(-state) == "disabled"} {
+ return
+ }
+
+ set rootx [expr $x + [winfo rootx $client]]
+ set rooty [expr $y + [winfo rooty $client]]
+
+ if {$data(-postcmd) != ""} {
+ set ret [tixEvalCmdBinding $w $data(-postcmd) "" $rootx $rooty]
+ if ![tixGetBoolean $ret] {
+ return
+ }
+ }
+
+ if [tixGetBoolean -nocomplain $data(-installcolormap)] {
+ wm colormapwindows . "$w"
+ }
+
+
+ set menuWidth [winfo reqwidth $data(w:menu)]
+ set width [winfo reqwidth $w]
+ set height [winfo reqheight $w]
+
+ if {$width < $menuWidth} {
+ set width $menuWidth
+ }
+
+ set wx $rootx
+ set wy $rooty
+
+ # trick: the following lines allow the popup menu
+ # acquire a stable width and height when it is finally
+ # put on the visible screen. Advoid flashing
+ #
+ wm geometry $w +10000+10000
+ wm deiconify $w
+ raise $w
+
+ update
+ wm geometry $w $width\x$height+$wx+$wy
+ update
+
+ tkMbEnter $data(w:menubutton)
+ tkMbPost $tkPriv(inMenubutton) $rootx $rooty
+}
diff --git a/tix/library/Primitiv.tcl b/tix/library/Primitiv.tcl
new file mode 100644
index 00000000000..1befb5dde2b
--- /dev/null
+++ b/tix/library/Primitiv.tcl
@@ -0,0 +1,425 @@
+# Primitiv.tcl --
+#
+# This is the primitive widget. It is just a frame with proper
+# inheritance wrapping. All new Tix widgets will be derived from
+# this widget
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+
+# No superclass, so the superclass switch is not used
+#
+#
+tixWidgetClass tixPrimitive {
+ -virtual true
+ -superclass {}
+ -classname TixPrimitive
+ -method {
+ cget configure subwidget subwidgets
+ }
+ -flag {
+ -background -borderwidth -cursor
+ -height -highlightbackground -highlightcolor -highlightthickness
+ -options -relief -takefocus -width -bd -bg
+ }
+ -static {
+ -options
+ }
+ -configspec {
+ {-background background Background #d9d9d9}
+ {-borderwidth borderWidth BorderWidth 0}
+ {-cursor cursor Cursor ""}
+ {-height height Height 0}
+ {-highlightbackground highlightBackground HighlightBackground #c3c3c3}
+ {-highlightcolor highlightColor HighlightColor black}
+ {-highlightthickness highlightThickness HighlightThickness 0}
+ {-options options Options ""}
+ {-relief relief Relief flat}
+ {-takefocus takeFocus TakeFocus 0 tixVerifyBoolean}
+ {-width width Width 0}
+ }
+ -alias {
+ {-bd -borderwidth}
+ {-bg -background}
+ }
+}
+
+#----------------------------------------------------------------------
+# ClassInitialization:
+#----------------------------------------------------------------------
+
+# not used
+# Implemented in C
+#
+# Override: never
+proc tixPrimitive:Constructor {w args} {
+
+ upvar #0 $w data
+ upvar #0 $data(className) classRec
+
+ # Set up some minimal items in the class record.
+ #
+ set data(w:root) $w
+ set data(rootCmd) $w:root
+
+ # We need to create the root widget in order to parse the options
+ # database
+ tixCallMethod $w CreateRootWidget
+
+ # Parse the default options from the options database
+ #
+ tixPrimitive:ParseDefaultOptions $w
+
+ # Parse the options supplied by the user
+ #
+ tixPrimitive:ParseUserOptions $w $args
+
+ # Rename the widget command so that it can be use to access
+ # the methods of this class
+
+ tixPrimitive:MkWidgetCmd $w
+
+ # Inistalize the Widget Record
+ #
+ tixCallMethod $w InitWidgetRec
+
+ # Construct the compound widget
+ #
+ tixCallMethod $w ConstructWidget
+
+ # Do the bindings
+ #
+ tixCallMethod $w SetBindings
+
+ # Call the configuration methods for all "force call" options
+ #
+ foreach option $classRec(forceCall) {
+ tixInt_ChangeOptions $w $option $data($option)
+ }
+}
+
+
+# Create only the root widget. We need the root widget to query the option
+# database.
+#
+# Override: seldom. (unless you want to use a toplevel as root widget)
+# Chain : never.
+
+proc tixPrimitive:CreateRootWidget {w args} {
+ upvar #0 $w data
+ upvar #0 $data(className) classRec
+
+ frame $w -class $data(ClassName)
+}
+
+proc tixPrimitive:ParseDefaultOptions {w} {
+ upvar #0 $w data
+ upvar #0 $data(className) classRec
+
+ # SET UP THE INSTANCE RECORD ACCORDING TO DEFAULT VALUES IN
+ # THE OPTIONS DATABASE
+ #
+ foreach option $classRec(options) {
+ set spec [tixInt_GetOptionSpec $data(className) $option]
+
+ if {[lindex $spec 0] == "="} {
+ continue
+ }
+
+ set o_name [lindex $spec 1]
+ set o_class [lindex $spec 2]
+ set o_default [lindex $spec 3]
+
+ if {![catch "option get $w $o_name $o_class" db_default]} {
+ if {$db_default != ""} {
+ set data($option) $db_default
+ } else {
+ set data($option) $o_default
+ }
+ } else {
+ set data($option) $o_default
+ }
+ }
+}
+
+proc tixPrimitive:ParseUserOptions {w arglist} {
+ upvar #0 $w data
+ upvar #0 $data(className) classRec
+
+ # SET UP THE INSTANCE RECORD ACCORDING TO COMMAND ARGUMENTS FROM
+ # THE USER OF THE TIX LIBRARY (i.e. Application programmer:)
+ #
+ tixForEach {option arg} $arglist {
+ if {[lsearch $classRec(options) $option] != "-1"} {
+ set spec [tixInt_GetOptionSpec $data(className) $option]
+
+ if {[lindex $spec 0] != "="} {
+ set data($option) $arg
+ } else {
+ set realOption [lindex $spec 1]
+ set data($realOption) $arg
+ }
+ } else {
+ error "unknown option $option. Should be: [tixInt_ListOptions $w]"
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+# Initialize the widget record
+#
+#
+# Override: always
+# Chain : always, before
+proc tixPrimitive:InitWidgetRec {w} {
+ # default: do nothing
+}
+
+#----------------------------------------------------------------------
+# SetBindings
+#
+#
+# Override: sometimes
+# Chain : sometimes, before
+#
+bind TixDestroyHandler <Destroy> {
+ [tixGetMethod %W [set %W(className)] Destructor] %W
+}
+
+proc tixPrimitive:SetBindings {w} {
+ upvar #0 $w data
+
+ if {[winfo toplevel $w] == $w} {
+ bindtags $w [concat TixDestroyHandler [bindtags $w]]
+ } else {
+ bind $data(w:root) <Destroy> \
+ "[tixGetMethod $w $data(className) Destructor] $w"
+ }
+}
+
+#----------------------------------------------------------------------
+# PrivateMethod: ConstructWidget
+#
+# Construct and set up the compound widget
+#
+# Override: sometimes
+# Chain : sometimes, before
+#
+proc tixPrimitive:ConstructWidget {w} {
+ upvar #0 $w data
+
+ $data(rootCmd) config \
+ -background $data(-background) \
+ -borderwidth $data(-borderwidth) \
+ -cursor $data(-cursor) \
+ -relief $data(-relief)
+
+ if {$data(-width) != 0} {
+ $data(rootCmd) config -width $data(-width)
+ }
+ if {$data(-height) != 0} {
+ $data(rootCmd) config -height $data(-height)
+ }
+
+ set rootname *[string range $w 1 end]
+
+ tixForEach {spec value} $data(-options) {
+ option add $rootname*$spec $value 100
+ }
+}
+
+#----------------------------------------------------------------------
+# PrivateMethod: MkWidgetCmd
+#
+# Construct and set up the compound widget
+#
+# Override: sometimes
+# Chain : sometimes, before
+#
+proc tixPrimitive:MkWidgetCmd {w} {
+ upvar #0 $w data
+
+ rename $w $data(rootCmd)
+ tixInt_MkInstanceCmd $w
+}
+
+
+#----------------------------------------------------------------------
+# ConfigOptions:
+#----------------------------------------------------------------------
+
+#----------------------------------------------------------------------
+# ConfigMethod: config
+#
+# Configure one option.
+#
+# Override: always
+# Chain : automatic.
+#
+# Note the hack of [winfo width] in this procedure
+#
+# The hack is necessary because of the bad interaction between TK's geometry
+# manager (the packer) and the frame widget. The packer determines the size
+# of the root widget of the ComboBox (a frame widget) according to the
+# requirement of the slaves inside the frame widget, NOT the -width
+# option of the frame widget.
+#
+# However, everytime the frame widget is
+# configured, it sends a geometry request to the packer according to its
+# -width and -height options and the packer will temporarily resize
+# the frame widget according to the requested size! The packer then realizes
+# something is wrong and revert to the size determined by the slaves. This
+# cause a flash on the screen.
+#
+foreach opt {-height -width -background -borderwidth -cursor
+ -highlightbackground -highlightcolor -relief -takefocus -bd -bg} {
+
+ set tixPrimOpt($opt) 1
+}
+
+proc tixPrimitive:config {w option value} {
+ global tixPrimOpt
+ upvar #0 $w data
+
+ if [info exists tixPrimOpt($option)] {
+ $data(rootCmd) config $option $value
+ }
+}
+
+#----------------------------------------------------------------------
+# PublicMethods:
+#----------------------------------------------------------------------
+
+#----------------------------------------------------------------------
+# This method is used to implement the "subwidgets" widget command.
+# Will be re-written in C. It can't be used as a public method because
+# of the lame substring comparison routines used in tixClass.c
+#
+#
+proc tixPrimitive:subwidgets {w type args} {
+ upvar #0 $w data
+
+ case $type {
+ -class {
+ set name [lindex $args 0]
+ set args [lrange $args 1 end]
+ # access subwidgets of a particular class
+ #
+ # note: if $name=="Frame", will *not return the root widget as well
+ #
+ set sub ""
+ foreach des [tixDescendants $w] {
+ if {[winfo class $des] == $name} {
+ lappend sub $des
+ }
+ }
+
+ # Note: if the there is no subwidget of this class, does not
+ # cause any error.
+ #
+ if {$args == ""} {
+ return $sub
+ } else {
+ foreach des $sub {
+ eval $des $args
+ }
+ return ""
+ }
+ }
+ -group {
+ set name [lindex $args 0]
+ set args [lrange $args 1 end]
+ # access subwidgets of a particular group
+ #
+ if [info exists data(g:$name)] {
+ if {$args == ""} {
+ set ret ""
+ foreach item $data(g:$name) {
+ lappend ret $w.$item
+ }
+ return $ret
+ } else {
+ foreach item $data(g:$name) {
+ eval $w.$item $args
+ }
+ return ""
+ }
+ } else {
+ error "no such subwidget group $name"
+ }
+ }
+ -all {
+ set sub [tixDescendants $w]
+
+ if {$args == ""} {
+ return $sub
+ } else {
+ foreach des $sub {
+ eval $des $args
+ }
+ return ""
+ }
+ }
+ default {
+ error "unknown flag $type, should be -all, -class or -group"
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+# PublicMethod: subwidget
+#
+# Access a subwidget withe a particular name
+#
+# Override: never
+# Chain : never
+#
+proc tixPrimitive:subwidget {w name args} {
+ upvar #0 $w data
+
+ if [info exists data(w:$name)] {
+ if {$args == ""} {
+ return $data(w:$name)
+ } else {
+ return [eval $data(w:$name) $args]
+ }
+ } else {
+ error "no such subwidget $name"
+ }
+}
+
+
+#----------------------------------------------------------------------
+# PrivateMethods:
+#----------------------------------------------------------------------
+
+# delete the widget record and remove the command
+#
+proc tixPrimitive:Destructor {w} {
+ upvar #0 $w data
+
+ if {![info exists data(w:root)]} {
+ return
+ }
+
+ if {[info commands $w] != ""} {
+ # remove the command
+ #
+ rename $w ""
+ }
+
+ if {[info commands $data(rootCmd)] != ""} {
+ # remove the command of the root widget
+ #
+ rename $data(rootCmd) ""
+ }
+
+ # delete the widget record
+ #
+ catch {unset data}
+}
diff --git a/tix/library/ResizeH.tcl b/tix/library/ResizeH.tcl
new file mode 100644
index 00000000000..7e14e8f8895
--- /dev/null
+++ b/tix/library/ResizeH.tcl
@@ -0,0 +1,495 @@
+# ResizeH.tcl --
+#
+# tixResizeHandle: A general purpose "resizing handle"
+# widget. You can use it to resize pictures, widgets, etc. When
+# using it to resize a widget, you can use the "attachwidget"
+# command to attach it to a widget and it will handle all the
+# events for you.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+#
+#
+
+tixWidgetClass tixResizeHandle {
+ -classname TixResizeHandle
+ -superclass tixVResize
+
+ -method {
+ attachwidget detachwidget hide show
+ }
+ -flag {
+ -command -cursorfg -cursorbg -handlesize -hintcolor -hintwidth -x -y
+ }
+ -configspec {
+ {-command command Command ""}
+ {-cursorfg cursorFg CursorColor white}
+ {-cursorbg cursorBg CursorColor red}
+ {-handlesize handleSize HandleSize 6}
+ {-hintcolor hintColor HintColor red}
+ {-hintwidth hintWidth HintWidth 1}
+ {-x x X 0}
+ {-y y Y 0}
+ }
+}
+
+proc tixResizeHandle:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+
+ set data(shown) 0
+ set data(widget) ""
+}
+
+proc tixResizeHandle:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ # Create the hints
+ #
+ set data(w_ht) $w:tix_priv_ht
+ set data(w_hb) $w:tix_priv_hb
+ set data(w_hl) $w:tix_priv_hl
+ set data(w_hr) $w:tix_priv_hr
+
+ frame $data(w_ht) -height $data(-hintwidth) -bg $data(-background)
+ frame $data(w_hb) -height $data(-hintwidth) -bg $data(-background)
+ frame $data(w_hl) -width $data(-hintwidth) -bg $data(-background)
+ frame $data(w_hr) -width $data(-hintwidth) -bg $data(-background)
+
+ # Create the corner resize handles
+ #
+ set data(w_r00) $w
+
+# Windows don't like this
+# $data(rootCmd) config\
+# -cursor "top_left_corner $data(-cursorbg) $data(-cursorfg)"
+
+ $data(rootCmd) config -cursor top_left_corner
+
+ set data(w_r01) $w:tix_priv_01
+ set data(w_r10) $w:tix_priv_10
+ set data(w_r11) $w:tix_priv_11
+
+ frame $data(w_r01) -relief $data(-relief) -bd $data(-borderwidth) \
+ -cursor "bottom_left_corner"\
+ -bg $data(-background)
+ frame $data(w_r10) -relief $data(-relief) -bd $data(-borderwidth) \
+ -cursor "top_right_corner"\
+ -bg $data(-background)
+ frame $data(w_r11) -relief $data(-relief) -bd $data(-borderwidth) \
+ -cursor "bottom_right_corner"\
+ -bg $data(-background)
+
+ # Create the border resize handles
+ #
+ set data(w_bt) $w:tix_priv_bt
+ set data(w_bb) $w:tix_priv_bb
+ set data(w_bl) $w:tix_priv_bl
+ set data(w_br) $w:tix_priv_br
+
+ frame $data(w_bt) -relief $data(-relief) -bd $data(-borderwidth) \
+ -cursor "top_side"\
+ -bg $data(-background)
+ frame $data(w_bb) -relief $data(-relief) -bd $data(-borderwidth) \
+ -cursor "bottom_side"\
+ -bg $data(-background)
+ frame $data(w_bl) -relief $data(-relief) -bd $data(-borderwidth) \
+ -cursor "left_side"\
+ -bg $data(-background)
+ frame $data(w_br) -relief $data(-relief) -bd $data(-borderwidth) \
+ -cursor "right_side"\
+ -bg $data(-background)
+}
+
+proc tixResizeHandle:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ bind $data(w_r00) <1> \
+ "tixResizeHandle:dragstart $w $data(w_r00) 1 %X %Y {1 1 -1 -1}"
+ bind $data(w_r01) <1> \
+ "tixResizeHandle:dragstart $w $data(w_r01) 1 %X %Y {1 0 -1 1}"
+ bind $data(w_r10) <1> \
+ "tixResizeHandle:dragstart $w $data(w_r10) 1 %X %Y {0 1 1 -1}"
+ bind $data(w_r11) <1> \
+ "tixResizeHandle:dragstart $w $data(w_r11) 1 %X %Y {0 0 1 1}"
+ bind $data(w_bt) <1> \
+ "tixResizeHandle:dragstart $w $data(w_bt) 1 %X %Y {0 1 0 -1}"
+ bind $data(w_bb) <1> \
+ "tixResizeHandle:dragstart $w $data(w_bb) 1 %X %Y {0 0 0 1}"
+ bind $data(w_bl) <1> \
+ "tixResizeHandle:dragstart $w $data(w_bl) 1 %X %Y {1 0 -1 0}"
+ bind $data(w_br) <1> \
+ "tixResizeHandle:dragstart $w $data(w_br) 1 %X %Y {0 0 1 0}"
+
+ foreach win [list \
+ $data(w_r00)\
+ $data(w_r01)\
+ $data(w_r10)\
+ $data(w_r11)\
+ $data(w_bt)\
+ $data(w_bb)\
+ $data(w_bl)\
+ $data(w_br)\
+ ] {
+ bind $win <B1-Motion> "tixVResize:drag $w %X %Y"
+ bind $win <ButtonRelease-1> "tixVResize:dragend $w $win 0 %X %Y"
+ bind $win <Any-Escape> "tixVResize:dragend $w $win 1 0 0"
+ }
+}
+
+#----------------------------------------------------------------------
+# Config Methods
+#----------------------------------------------------------------------
+proc tixResizeHandle:config-width {w value} {
+ tixWidgetDoWhenIdle tixResizeHandle:ComposeWindow $w
+}
+
+proc tixResizeHandle:config-height {w value} {
+ tixWidgetDoWhenIdle tixResizeHandle:ComposeWindow $w
+}
+
+proc tixResizeHandle:config-x {w value} {
+ tixWidgetDoWhenIdle tixResizeHandle:ComposeWindow $w
+}
+
+proc tixResizeHandle:config-y {w value} {
+ tixWidgetDoWhenIdle tixResizeHandle:ComposeWindow $w
+}
+
+
+#----------------------------------------------------------------------
+# Public Methods
+#----------------------------------------------------------------------
+proc tixResizeHandle:dragstart {w win depress rootx rooty mrect} {
+ upvar #0 $w data
+
+ set wx $data(-x)
+ set wy $data(-y)
+ set ww $data(-width)
+ set wh $data(-height)
+
+ tixVResize:dragstart $w $win $depress $rootx $rooty \
+ [list $wx $wy $ww $wh] $mrect
+}
+
+# tixDeleteBindTag --
+#
+# Delete the bindtag(s) in the args list from the bindtags of the widget
+#
+proc tixDeleteBindTag {w args} {
+ if ![winfo exists $w] {
+ return
+ }
+ set newtags ""
+
+ foreach tag [bindtags $w] {
+ if {[lsearch $args $tag] == -1} {
+ lappend newtags $tag
+ }
+ }
+ bindtags $w $newtags
+}
+
+proc tixAddBindTag {w args} {
+ bindtags $w [concat [bindtags $w] $args]
+}
+
+proc tixResizeHandle:attachwidget {w widget args} {
+ upvar #0 $w data
+
+ set opt(-move) 0
+ tixHandleOptions opt {-move} $args
+
+ if {$data(widget) != ""} {
+ tixDeleteBindTag $data(widget) TixResizeHandleTag:$w
+ }
+
+ set data(widget) $widget
+
+ if {$data(widget) != ""} {
+ # Just in case TixResizeHandleTag was already there
+ tixDeleteBindTag $data(widget) TixResizeHandleTag:$w
+ tixAddBindTag $data(widget) TixResizeHandleTag:$w
+
+
+ set data(-x) [winfo x $data(widget)]
+ set data(-y) [winfo y $data(widget)]
+ set data(-width) [winfo width $data(widget)]
+ set data(-height) [winfo height $data(widget)]
+
+ tixResizeHandle:show $w
+ tixResizeHandle:ComposeWindow $w
+
+ # Now set the bindings
+ #
+ if {$opt(-move)} {
+ bind TixResizeHandleTag:$w <1> \
+ "tixResizeHandle:Attach $w %X %Y"
+ bind TixResizeHandleTag:$w <B1-Motion> \
+ "tixResizeHandle:BMotion $w %X %Y"
+ bind TixResizeHandleTag:$w <Any-Escape> \
+ "tixResizeHandle:BRelease $w 1 %X %Y"
+ bind TixResizeHandleTag:$w <ButtonRelease-1>\
+ "tixResizeHandle:BRelease $w 0 %X %Y"
+ } else {
+ # if "move" is false, then the widget won't be moved as a whole --
+ # ResizeHandle will only move its sides
+ bind TixResizeHandleTag:$w <1> {;}
+ bind TixResizeHandleTag:$w <B1-Motion> {;}
+ bind TixResizeHandleTag:$w <Any-Escape> {;}
+ bind TixResizeHandleTag:$w <ButtonRelease-1> {;}
+ }
+ }
+}
+
+proc tixResizeHandle:detachwidget {w} {
+ upvar #0 $w data
+
+ if {$data(widget) != ""} {
+ tixDeleteBindTag $data(widget) TixResizeHandleTag:$w
+ }
+ tixResizeHandle:hide $w
+}
+
+proc tixResizeHandle:show {w} {
+ upvar #0 $w data
+
+ set data(shown) 1
+
+ raise $data(w_ht)
+ raise $data(w_hb)
+ raise $data(w_hl)
+ raise $data(w_hr)
+
+ raise $data(w_r00)
+ raise $data(w_r01)
+ raise $data(w_r10)
+ raise $data(w_r11)
+
+ raise $data(w_bt)
+ raise $data(w_bb)
+ raise $data(w_bl)
+ raise $data(w_br)
+
+# tixCancleIdleTask tixResizeHandle:ComposeWindow $w
+ tixResizeHandle:ComposeWindow $w
+}
+
+
+proc tixResizeHandle:hide {w} {
+ upvar #0 $w data
+
+ if {!$data(shown)} {
+ return
+ }
+
+ set data(shown) 0
+
+ place forget $data(w_r00)
+ place forget $data(w_r01)
+ place forget $data(w_r10)
+ place forget $data(w_r11)
+
+ place forget $data(w_bt)
+ place forget $data(w_bb)
+ place forget $data(w_bl)
+ place forget $data(w_br)
+
+ place forget $data(w_ht)
+ place forget $data(w_hb)
+ place forget $data(w_hl)
+ place forget $data(w_hr)
+}
+
+proc tixResizeHandle:Destructor {w} {
+ upvar #0 $w data
+
+ if {$data(widget) != ""} {
+ tixDeleteBindTag $data(widget) TixResizeHandleTag:$w
+ }
+
+ catch {destroy $data(w_r01)}
+ catch {destroy $data(w_r10)}
+ catch {destroy $data(w_r11)}
+
+ catch {destroy $data(w_bt)}
+ catch {destroy $data(w_bb)}
+ catch {destroy $data(w_bl)}
+ catch {destroy $data(w_br)}
+
+ catch {destroy $data(w_ht)}
+ catch {destroy $data(w_hb)}
+ catch {destroy $data(w_hl)}
+ catch {destroy $data(w_hr)}
+
+ tixChainMethod $w Destructor
+}
+
+#----------------------------------------------------------------------
+# Private Methods Dealing With Attached Widgets
+#----------------------------------------------------------------------
+proc tixResizeHandle:Attach {w rx ry} {
+ upvar #0 $w data
+
+ tixResizeHandle:dragstart $w $data(widget) 0 $rx $ry {1 1 0 0}
+}
+
+proc tixResizeHandle:BMotion {w rx ry} {
+ tixVResize:drag $w $rx $ry
+}
+
+
+proc tixResizeHandle:BRelease {w isAbort rx ry} {
+ upvar #0 $w data
+
+ tixVResize:dragend $w $data(widget) $isAbort $rx $ry
+}
+
+#----------------------------------------------------------------------
+# Private Methods
+#----------------------------------------------------------------------
+proc tixResizeHandle:DrawTmpLines {w} {
+ upvar #0 $w data
+
+ set x1 $data(hf:x1)
+ set y1 $data(hf:y1)
+ set x2 $data(hf:x2)
+ set y2 $data(hf:y2)
+
+ tixTmpLine $x1 $y1 $x2 $y1 $w
+ tixTmpLine $x1 $y2 $x2 $y2 $w
+ tixTmpLine $x1 $y1 $x1 $y2 $w
+ tixTmpLine $x2 $y1 $x2 $y2 $w
+}
+
+# Place the hint frame to indicate the changes
+#
+proc tixResizeHandle:SetHintFrame {w x1 y1 width height} {
+ upvar #0 $w data
+
+ # The four sides of the window
+ #
+ set x2 [expr "$x1+$width"]
+ set y2 [expr "$y1+$height"]
+
+ set rx [winfo rootx [winfo parent $w]]
+ set ry [winfo rooty [winfo parent $w]]
+
+ incr x1 $rx
+ incr y1 $ry
+ incr x2 $rx
+ incr y2 $ry
+
+ if {[info exists data(hf:x1)]} {
+ tixResizeHandle:DrawTmpLines $w
+ }
+
+ set data(hf:x1) $x1
+ set data(hf:y1) $y1
+ set data(hf:x2) $x2
+ set data(hf:y2) $y2
+
+ tixResizeHandle:DrawTmpLines $w
+}
+
+proc tixResizeHandle:ShowHintFrame {w} {
+ upvar #0 $w data
+
+ place forget $data(w_ht)
+ place forget $data(w_hb)
+ place forget $data(w_hl)
+ place forget $data(w_hr)
+
+ update
+}
+
+proc tixResizeHandle:HideHintFrame {w} {
+ upvar #0 $w data
+
+ tixResizeHandle:DrawTmpLines $w
+ unset data(hf:x1)
+ unset data(hf:y1)
+ unset data(hf:x2)
+ unset data(hf:y2)
+}
+
+proc tixResizeHandle:UpdateSize {w x y width height} {
+ upvar #0 $w data
+
+ set data(-x) $x
+ set data(-y) $y
+ set data(-width) $width
+ set data(-height) $height
+
+ tixResizeHandle:ComposeWindow $w
+
+ if {$data(widget) != ""} {
+ place $data(widget) -x $x -y $y -width $width -height $height
+ }
+
+ if {$data(-command) != ""} {
+ eval $data(-command) $x $y $width $height
+ }
+}
+
+proc tixResizeHandle:ComposeWindow {w} {
+ upvar #0 $w data
+
+ set px $data(-x)
+ set py $data(-y)
+ set pw $data(-width)
+ set ph $data(-height)
+
+ # Show the hint frames
+ #
+ set x1 $px
+ set y1 $py
+ set x2 [expr "$px+$pw"]
+ set y2 [expr "$py+$ph"]
+
+ place $data(w_ht) -x $x1 -y $y1 -width $pw -bordermode outside
+ place $data(w_hb) -x $x1 -y $y2 -width $pw -bordermode outside
+ place $data(w_hl) -x $x1 -y $y1 -height $ph -bordermode outside
+ place $data(w_hr) -x $x2 -y $y1 -height $ph -bordermode outside
+
+ # Set the four corner resize handles
+ #
+ set sz_2 [expr $data(-handlesize)/2]
+
+ set x1 [expr "$px - $sz_2"]
+ set y1 [expr "$py - $sz_2"]
+ set x2 [expr "$px - $sz_2" + $pw]
+ set y2 [expr "$py - $sz_2" + $ph]
+
+ place $data(w_r00) -x $x1 -y $y1 \
+ -width $data(-handlesize) -height $data(-handlesize)
+ place $data(w_r01) -x $x1 -y $y2\
+ -width $data(-handlesize) -height $data(-handlesize)
+ place $data(w_r10) -x $x2 -y $y1\
+ -width $data(-handlesize) -height $data(-handlesize)
+ place $data(w_r11) -x $x2 -y $y2\
+ -width $data(-handlesize) -height $data(-handlesize)
+
+
+ # Set the four border resize handles
+ #
+ set mx [expr "$px + $pw/2 - $sz_2"]
+ set my [expr "$py + $ph/2 - $sz_2"]
+
+ place $data(w_bt) -x $mx -y $y1 \
+ -width $data(-handlesize) -height $data(-handlesize)
+ place $data(w_bb) -x $mx -y $y2 \
+ -width $data(-handlesize) -height $data(-handlesize)
+ place $data(w_bl) -x $x1 -y $my \
+ -width $data(-handlesize) -height $data(-handlesize)
+ place $data(w_br) -x $x2 -y $my \
+ -width $data(-handlesize) -height $data(-handlesize)
+}
diff --git a/tix/library/SGrid.tcl b/tix/library/SGrid.tcl
new file mode 100644
index 00000000000..870ea48db12
--- /dev/null
+++ b/tix/library/SGrid.tcl
@@ -0,0 +1,228 @@
+# SGrid.tcl --
+#
+# This file implements Scrolled Grid widgets
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixScrolledGrid {
+ -classname TixScrolledGrid
+ -superclass tixScrolledWidget
+ -method {
+ }
+ -flag {
+ }
+ -configspec {
+ }
+ -default {
+ {.scrollbar auto}
+ {*grid.borderWidth 1}
+ {*grid.Background #c3c3c3}
+ {*grid.highlightBackground #d9d9d9}
+ {*grid.relief sunken}
+ {*grid.takeFocus 1}
+ {*Scrollbar.background #d9d9d9}
+ {*Scrollbar.troughColor #c3c3c3}
+ {*Scrollbar.takeFocus 0}
+ {*Scrollbar.relief sunken}
+ {*Scrollbar.width 15}
+ }
+}
+
+proc tixScrolledGrid:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ set data(w:grid) [tixGrid $w.grid]
+
+ set data(w:hsb) \
+ [scrollbar $w.hsb -orient horizontal -takefocus 0]
+ set data(w:vsb) \
+ [scrollbar $w.vsb -orient vertical -takefocus 0]
+
+ set data(pw:client) $data(w:grid)
+
+ pack $data(w:grid) -expand yes -fill both -padx 0 -pady 0
+}
+
+proc tixScrolledGrid:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ $data(w:grid) config \
+ -xscrollcommand "$data(w:hsb) set"\
+ -yscrollcommand "$data(w:vsb) set"\
+ -sizecmd "tixScrolledWidget:Configure $w" \
+ -formatcmd "tixCallMethod $w FormatCmd"
+
+ $data(w:hsb) config -command "$data(w:grid) xview"
+ $data(w:vsb) config -command "$data(w:grid) yview"
+
+ bindtags $data(w:grid) \
+ "$data(w:grid) TixSGrid TixGrid [winfo toplevel $data(w:grid)] all"
+
+ tixSetMegaWidget $data(w:grid) $w
+}
+
+#----------------------------------------------------------------------
+# RAW event bindings
+#----------------------------------------------------------------------
+proc tixScrolledGridBind {} {
+ tixBind TixScrolledGrid <ButtonPress-1> {
+ tixScrolledGrid:Button-1 [tixGetMegaWidget %W] %x %y
+ }
+ tixBind TixScrolledGrid <Shift-ButtonPress-1> {
+ tixScrolledGrid:Shift-Button-1 %W %x %y
+ }
+ tixBind TixScrolledGrid <Control-ButtonPress-1> {
+ tixScrolledGrid:Control-Button-1 %W %x %y
+ }
+ tixBind TixScrolledGrid <ButtonRelease-1> {
+ tixScrolledGrid:ButtonRelease-1 %W %x %y
+ }
+ tixBind TixScrolledGrid <Double-ButtonPress-1> {
+ tixScrolledGrid:Double-1 %W %x %y
+ }
+ tixBind TixScrolledGrid <B1-Motion> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ set tkPriv(X) %X
+ set tkPriv(Y) %Y
+
+ tixScrolledGrid:B1-Motion %W %x %y
+ }
+ tixBind TixScrolledGrid <Control-B1-Motion> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ set tkPriv(X) %X
+ set tkPriv(Y) %Y
+
+ tixScrolledGrid:Control-B1-Motion %W %x %y
+ }
+ tixBind TixScrolledGrid <B1-Leave> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ set tkPriv(X) %X
+ set tkPriv(Y) %Y
+
+ tixScrolledGrid:B1-Leave %W
+ }
+ tixBind TixScrolledGrid <B1-Enter> {
+ tixScrolledGrid:B1-Enter %W %x %y
+ }
+ tixBind TixScrolledGrid <Control-B1-Leave> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ set tkPriv(X) %X
+ set tkPriv(Y) %Y
+
+ tixScrolledGrid:Control-B1-Leave %W
+ }
+ tixBind TixScrolledGrid <Control-B1-Enter> {
+ tixScrolledGrid:Control-B1-Enter %W %x %y
+ }
+
+ # Keyboard bindings
+ #
+ tixBind TixScrolledGrid <Up> {
+ tixScrolledGrid:DirKey %W up
+ }
+ tixBind TixScrolledGrid <Down> {
+ tixScrolledGrid:DirKey %W down
+ }
+ tixBind TixScrolledGrid <Left> {
+ tixScrolledGrid:DirKey %W left
+ }
+ tixBind TixScrolledGrid <Right> {
+ tixScrolledGrid:DirKey %W right
+ }
+ tixBind TixScrolledGrid <Prior> {
+ %W yview scroll -1 pages
+ }
+ tixBind TixScrolledGrid <Next> {
+ %W yview scroll 1 pages
+ }
+ tixBind TixScrolledGrid <Return> {
+ tixScrolledGrid:Return %W
+ }
+ tixBind TixScrolledGrid <space> {
+ tixScrolledGrid:Space %W
+ }
+}
+
+#----------------------------------------------------------------------
+#
+#
+# Mouse bindings
+#
+#
+#----------------------------------------------------------------------
+proc tixScrolledGrid:Button-1 {w x y} {
+ if {[$w cget -state] == "disabled"} {
+ return
+ }
+ if [$w cget -takefocus] {
+ focus $w
+ }
+ case [tixScrolled:GetState $w] {
+ {0} {
+ tixScrolledGrid:GoState s1 $w $x $y
+ }
+ {b0} {
+ tixScrolledGrid:GoState b1 $w $x $y
+ }
+ {m0} {
+ tixScrolledGrid:GoState m1 $w $x $y
+ }
+ {e0} {
+ tixScrolledGrid:GoState e1 $w $x $y
+ }
+ }
+}
+
+
+
+#----------------------------------------------------------------------
+#
+# option configs
+#----------------------------------------------------------------------
+
+#----------------------------------------------------------------------
+#
+# Widget commands
+#----------------------------------------------------------------------
+
+
+#----------------------------------------------------------------------
+#
+# Private Methods
+#----------------------------------------------------------------------
+
+#----------------------------------------------------------------------
+# Virtual Methods
+#----------------------------------------------------------------------
+proc tixScrolledGrid:FormatCmd {w area x1 y1 x2 y2} {
+ # do nothing
+}
+
+#----------------------------------------------------------------------
+# virtual functions to query the client window's scroll requirement
+#----------------------------------------------------------------------
+proc tixScrolledGrid:GeometryInfo {w mW mH} {
+ upvar #0 $w data
+
+
+ if {$mW < 1} {
+ set mW 1
+ }
+ if {$mH < 1} {
+ set mH 1
+ }
+
+ return [$data(w:grid) geometryinfo $mW $mH]
+}
diff --git a/tix/library/SHList.tcl b/tix/library/SHList.tcl
new file mode 100644
index 00000000000..36fe0e883ef
--- /dev/null
+++ b/tix/library/SHList.tcl
@@ -0,0 +1,155 @@
+# SHList.tcl --
+#
+# This file implements Scrolled HList widgets
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixScrolledHList {
+ -classname TixScrolledHList
+ -superclass tixScrolledWidget
+ -method {
+ }
+ -flag {
+ -highlightbackground -highlightcolor -highlightthickness
+ }
+ -configspec {
+ {-highlightbackground -highlightBackground HighlightBackground #d9d9d9}
+ {-highlightcolor -highlightColor HighlightColor black}
+ {-highlightthickness -highlightThickness HighlightThickness 2}
+ }
+ -default {
+ {.scrollbar auto}
+ {*f1.borderWidth 1}
+ {*hlist.Background #c3c3c3}
+ {*hlist.highlightBackground #d9d9d9}
+ {*hlist.relief sunken}
+ {*hlist.takeFocus 1}
+ {*Scrollbar.background #d9d9d9}
+ {*Scrollbar.troughColor #c3c3c3}
+ {*Scrollbar.takeFocus 0}
+ {*Scrollbar.relief sunken}
+ {*Scrollbar.width 15}
+ }
+ -forcecall {
+ -highlightbackground -highlightcolor -highlightthickness
+ }
+}
+
+proc tixScrolledHList:ConstructWidget {w} {
+ upvar #0 $w data
+ global tcl_platform
+
+ tixChainMethod $w ConstructWidget
+
+ set data(pw:f1) \
+ [frame $w.f1 -takefocus 0]
+ set data(w:hlist) \
+ [tixHList $w.f1.hlist -bd 0 -takefocus 1 -highlightthickness 0]
+
+ pack $data(w:hlist) -in $data(pw:f1) -expand yes -fill both -padx 0 -pady 0
+
+ set data(w:hsb) \
+ [scrollbar $w.hsb -orient horizontal -takefocus 0]
+ set data(w:vsb) \
+ [scrollbar $w.vsb -orient vertical -takefocus 0]
+
+ if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
+ set data(w:sizebox) [ide_sizebox $w.sizebox]
+ }
+
+ set data(pw:client) $data(pw:f1)
+}
+
+proc tixScrolledHList:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ $data(w:hlist) config \
+ -xscrollcommand "$data(w:hsb) set"\
+ -yscrollcommand "$data(w:vsb) set"\
+ -sizecmd "tixScrolledWidget:Configure $w"
+
+ $data(w:hsb) config -command "$data(w:hlist) xview"
+ $data(w:vsb) config -command "$data(w:hlist) yview"
+
+}
+
+#----------------------------------------------------------------------
+#
+# option configs
+#----------------------------------------------------------------------
+proc tixScrolledHList:config-takefocus {w value} {
+ upvar #0 $w data
+
+ $data(w:hlist) config -takefocus $value
+}
+
+proc tixScrolledHList:config-highlightbackground {w value} {
+ upvar #0 $w data
+
+ $data(pw:f1) config -highlightbackground $value
+}
+
+proc tixScrolledHList:config-highlightcolor {w value} {
+ upvar #0 $w data
+
+ $data(pw:f1) config -highlightcolor $value
+}
+
+proc tixScrolledHList:config-highlightthickness {w value} {
+ upvar #0 $w data
+
+ $data(pw:f1) config -highlightthickness $value
+}
+
+
+#----------------------------------------------------------------------
+#
+# Widget commands
+#----------------------------------------------------------------------
+
+#----------------------------------------------------------------------
+#
+# Private Methods
+#----------------------------------------------------------------------
+# virtual
+#
+proc tixScrolledHList:RepackHook {w} {
+ upvar #0 $w data
+
+if 0 {
+ if [tixGetBoolean [$data(w:hlist) cget -header]] {
+ set data(vsbPadY) [winfo height $data(w:hlist).tixsw:header]
+ } else {
+ set data(vsbPadY) 0
+ }
+
+ puts $data(vsbPadY)\ $data(w:hlist).tixsw:header
+}
+ tixChainMethod $w RepackHook
+}
+#----------------------------------------------------------------------
+# virtual functions to query the client window's scroll requirement
+#----------------------------------------------------------------------
+proc tixScrolledHList:GeometryInfo {w mW mH} {
+ upvar #0 $w data
+
+ set extra [expr [$w.f1 cget -bd]+[$w.f1 cget -highlightthickness]]
+
+ set mW [expr $mW - $extra*2]
+ set mH [expr $mH - $extra*2]
+
+ if {$mW < 1} {
+ set mW 1
+ }
+ if {$mH < 1} {
+ set mH 1
+ }
+
+ return [$data(w:hlist) geometryinfo $mW $mH]
+}
diff --git a/tix/library/SListBox.tcl b/tix/library/SListBox.tcl
new file mode 100644
index 00000000000..6cd1630546d
--- /dev/null
+++ b/tix/library/SListBox.tcl
@@ -0,0 +1,304 @@
+# SListBox.tcl --
+#
+# This file implements Scrolled Listbox widgets
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+# ToDo:
+# -anchor (none)
+#
+
+tixWidgetClass tixScrolledListBox {
+ -classname TixScrolledListBox
+ -superclass tixScrolledWidget
+ -method {
+ }
+ -flag {
+ -anchor -browsecmd -command -state
+ }
+ -static {
+ -anchor
+ }
+ -configspec {
+ {-anchor anchor Anchor w}
+ {-browsecmd browseCmd BrowseCmd ""}
+ {-command command Command ""}
+ {-state state State normal}
+ {-takefocus takeFocus TakeFocus 1 tixVerifyBoolean}
+ }
+ -default {
+ {.scrollbar auto}
+ {*borderWidth 1}
+ {*listbox.highlightBackground #d9d9d9}
+ {*listbox.relief sunken}
+ {*listbox.background #c3c3c3}
+ {*listbox.takeFocus 1}
+ {*Scrollbar.background #d9d9d9}
+ {*Scrollbar.troughColor #c3c3c3}
+ {*Scrollbar.takeFocus 0}
+ {*Scrollbar.relief sunken}
+ {*Scrollbar.width 15}
+ }
+}
+
+proc tixScrolledListBox:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+
+ set data(x-first) 0
+ set data(x-last) 1
+ set data(y-first) 0
+ set data(y-last) 1
+}
+
+proc tixScrolledListBox:ConstructWidget {w} {
+ upvar #0 $w data
+ global tcl_platform
+
+ tixChainMethod $w ConstructWidget
+
+ set data(w:listbox) \
+ [listbox $w.listbox]
+ set data(w:hsb) \
+ [scrollbar $w.hsb -orient horizontal]
+ set data(w:vsb) \
+ [scrollbar $w.vsb -orient vertical ]
+
+ if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
+ set data(w:sizebox) [ide_sizebox $w.sizebox]
+ }
+
+ set data(pw:client) $data(w:listbox)
+}
+
+proc tixScrolledListBox:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ $data(w:listbox) config \
+ -xscrollcommand "tixScrolledListBox:XView $w"\
+ -yscrollcommand "tixScrolledListBox:YView $w"
+
+ $data(w:hsb) config -command "$data(w:listbox) xview"
+ $data(w:vsb) config -command "$data(w:listbox) yview"
+
+ bind $w <Configure> "+tixScrolledListBox:Configure $w"
+ bind $w <FocusIn> "focus $data(w:listbox)"
+
+ bindtags $data(w:listbox) \
+ "$data(w:listbox) TixListboxState Listbox TixListbox [winfo toplevel $data(w:listbox)] all"
+ tixSetMegaWidget $data(w:listbox) $w
+}
+
+proc tixScrolledListBoxBind {} {
+ tixBind TixListboxState <1> {
+ if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
+ break
+ }
+ }
+ tixBind TixListbox <1> {
+ if [tixGetBoolean -nocomplain [%W cget -takefocus]] {
+ focus %W
+ }
+ tixScrolledListBox:Browse [tixGetMegaWidget %W]
+ }
+
+ tixBind TixListboxState <B1-Motion> {
+ if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
+ break
+ }
+ }
+ tixBind TixListbox <B1-Motion> {
+ tixScrolledListBox:Browse [tixGetMegaWidget %W]
+ }
+
+ tixBind TixListboxState <Up> {
+ if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
+ break
+ }
+ }
+ tixBind TixListbox <Up> {
+ tixScrolledListBox:KeyBrowse [tixGetMegaWidget %W]
+ }
+
+ tixBind TixListboxState <Down> {
+ if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
+ break
+ }
+ }
+ tixBind TixListbox <Down> {
+ tixScrolledListBox:KeyBrowse [tixGetMegaWidget %W]
+ }
+
+ tixBind TixListboxState <Return> {
+ if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
+ break
+ }
+ }
+ tixBind TixListbox <Return> {
+ tixScrolledListBox:KeyInvoke [tixGetMegaWidget %W]
+ }
+
+
+ tixBind TixListboxState <Double-1> {
+ if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
+ break
+ }
+ }
+ tixBind TixListbox <Double-1> {
+ tixScrolledListBox:Invoke [tixGetMegaWidget %W]
+ }
+
+ tixBind TixListboxState <ButtonRelease-1> {
+ if {[set [tixGetMegaWidget %W](-state)] == "disabled"} {
+ break
+ }
+ }
+ tixBind TixListbox <ButtonRelease-1> {
+ tixScrolledListBox:Browse [tixGetMegaWidget %W]
+ }
+}
+
+proc tixScrolledListBox:Browse {w} {
+ upvar #0 $w data
+
+ if {$data(-browsecmd) != ""} {
+ set bind(specs) {%V}
+ set bind(%V) [$data(w:listbox) get \
+ [$data(w:listbox) nearest [tixEvent flag y]]]
+ tixEvalCmdBinding $w $data(-browsecmd) bind
+ }
+}
+
+proc tixScrolledListBox:KeyBrowse {w} {
+ upvar #0 $w data
+
+ if {$data(-browsecmd) != ""} {
+ set bind(specs) {%V}
+ set bind(%V) [$data(w:listbox) get active]
+ tixEvalCmdBinding $w $data(-browsecmd) bind
+ }
+}
+
+# tixScrolledListBox:Invoke --
+#
+# The user has invoked the listbox by pressing either the <Returh>
+# key or double-clicking. Call the user-supplied -command function.
+#
+# For both -browsecmd and -command, it is the responsibility of the
+# user-supplied function to determine the current selection of the listbox
+#
+proc tixScrolledListBox:Invoke {w} {
+ upvar #0 $w data
+
+ if {$data(-command) != ""} {
+ set bind(specs) {%V}
+ set bind(%V) [$data(w:listbox) get \
+ [$data(w:listbox) nearest [tixEvent flag y]]]
+ tixEvalCmdBinding $w $data(-command) bind
+ }
+}
+
+proc tixScrolledListBox:KeyInvoke {w} {
+ upvar #0 $w data
+
+ if {$data(-command) != ""} {
+ set bind(specs) {%V}
+ set bind(%V) [$data(w:listbox) get active]
+ tixEvalCmdBinding $w $data(-command) bind
+ }
+}
+
+#----------------------------------------------------------------------
+#
+# option configs
+#----------------------------------------------------------------------
+proc tixScrolledListBox:config-takefocus {w value} {
+ upvar #0 $w data
+
+ $data(w:listbox) config -takefocus $value
+}
+
+
+#----------------------------------------------------------------------
+#
+# Widget commands
+#----------------------------------------------------------------------
+
+
+#----------------------------------------------------------------------
+#
+# Private Methods
+#----------------------------------------------------------------------
+proc tixScrolledListBox:XView {w first last} {
+ upvar #0 $w data
+
+ set data(x-first) $first
+ set data(x-last) $last
+
+ $data(w:hsb) set $first $last
+ tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
+
+
+}
+
+proc tixScrolledListBox:YView {w first last} {
+ upvar #0 $w data
+
+ set data(y-first) $first
+ set data(y-last) $last
+
+ $data(w:vsb) set $first $last
+ tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
+
+ # Somehow an update here must be used to advoid osscilation
+ #
+ update idletasks
+}
+
+#
+#----------------------------------------------------------------------
+# virtual functions to query the client window's scroll requirement
+#----------------------------------------------------------------------
+proc tixScrolledListBox:GeometryInfo {w mW mH} {
+ upvar #0 $w data
+
+ return [list \
+ [list $data(x-first) $data(x-last)]\
+ [list $data(y-first) $data(y-last)]]
+}
+
+proc tixScrolledListBox:Configure {w} {
+ upvar #0 $w data
+
+ tixWidgetDoWhenIdle tixScrolledListBox:TrickScrollbar $w
+
+ if {$data(-anchor) == "e"} {
+ $data(w:listbox) xview 100000
+ }
+}
+
+# This procedure is necessary because listbox does not call x,y scroll command
+# when its size is changed
+#
+proc tixScrolledListBox:TrickScrollbar {w} {
+ upvar #0 $w data
+
+ if [$data(w:listbox) select include 0] {
+ set inc 1
+ } else {
+ set inc 0
+ }
+
+ $data(w:listbox) select set 0
+ if {!$inc} {
+ $data(w:listbox) select clear 0
+ }
+}
diff --git a/tix/library/STList.tcl b/tix/library/STList.tcl
new file mode 100644
index 00000000000..2dd786d7cae
--- /dev/null
+++ b/tix/library/STList.tcl
@@ -0,0 +1,92 @@
+# STList.tcl --
+#
+# This file implements Scrolled TList widgets
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixScrolledTList {
+ -classname TixScrolledTList
+ -superclass tixScrolledWidget
+ -method {
+ }
+ -flag {
+ }
+ -configspec {
+ }
+ -default {
+ {.scrollbar auto}
+ {*borderWidth 1}
+ {*tlist.background #c3c3c3}
+ {*tlist.highlightBackground #d9d9d9}
+ {*tlist.relief sunken}
+ {*tlist.takeFocus 1}
+ {*Scrollbar.background #d9d9d9}
+ {*Scrollbar.troughColor #c3c3c3}
+ {*Scrollbar.takeFocus 0}
+ {*Scrollbar.relief sunken}
+ {*Scrollbar.width 15}
+ }
+}
+
+proc tixScrolledTList:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ set data(w:tlist) \
+ [tixTList $w.tlist]
+ set data(w:hsb) \
+ [scrollbar $w.hsb -orient horizontal]
+ set data(w:vsb) \
+ [scrollbar $w.vsb -orient vertical ]
+
+ set data(pw:client) $data(w:tlist)
+}
+
+proc tixScrolledTList:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ $data(w:tlist) config \
+ -xscrollcommand "$data(w:hsb) set"\
+ -yscrollcommand "$data(w:vsb) set"\
+ -sizecmd "tixScrolledWidget:Configure $w"
+
+ $data(w:hsb) config -command "$data(w:tlist) xview"
+ $data(w:vsb) config -command "$data(w:tlist) yview"
+}
+
+#----------------------------------------------------------------------
+#
+# option configs
+#----------------------------------------------------------------------
+proc tixScrolledTList:config-takefocus {w value} {
+ upvar #0 $w data
+
+ $data(w:tlist) config -takefocus $value
+}
+
+#----------------------------------------------------------------------
+#
+# Widget commands
+#----------------------------------------------------------------------
+
+
+#----------------------------------------------------------------------
+#
+# Private Methods
+#----------------------------------------------------------------------
+
+#----------------------------------------------------------------------
+# virtual functions to query the client window's scroll requirement
+#----------------------------------------------------------------------
+proc tixScrolledTList:GeometryInfo {w mW mH} {
+ upvar #0 $w data
+
+ return [$data(w:tlist) geometryinfo $mW $mH]
+}
diff --git a/tix/library/SText.tcl b/tix/library/SText.tcl
new file mode 100644
index 00000000000..ae741f276a5
--- /dev/null
+++ b/tix/library/SText.tcl
@@ -0,0 +1,138 @@
+# SText.tcl --
+#
+# This file implements Scrolled Text widgets
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+
+tixWidgetClass tixScrolledText {
+ -classname TixScrolledText
+ -superclass tixScrolledWidget
+ -method {
+ }
+ -flag {
+ }
+ -static {
+ }
+ -configspec {
+ }
+ -default {
+ {.scrollbar both}
+ {*borderWidth 1}
+ {*text.background #c3c3c3}
+ {*text.highlightBackground #d9d9d9}
+ {*text.relief sunken}
+ {*text.takeFocus 1}
+ {*Scrollbar.background #d9d9d9}
+ {*Scrollbar.relief sunken}
+ {*Scrollbar.troughColor #c3c3c3}
+ {*Scrollbar.takeFocus 0}
+ {*Scrollbar.width 15}
+ }
+ -forcecall {
+ -scrollbar
+ }
+}
+
+proc tixScrolledText:ConstructWidget {w} {
+ upvar #0 $w data
+ global tcl_platform
+
+ tixChainMethod $w ConstructWidget
+
+ set data(w:text) \
+ [text $w.text]
+ set data(w:hsb) \
+ [scrollbar $w.hsb -orient horizontal]
+ set data(w:vsb) \
+ [scrollbar $w.vsb -orient vertical]
+
+ if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
+ set data(w:sizebox) [ide_sizebox $w.sizebox]
+ }
+
+ set data(pw:client) $data(w:text)
+}
+
+proc tixScrolledText:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ $data(w:text) config \
+ -xscrollcommand "tixScrolledText:XScroll $w"\
+ -yscrollcommand "tixScrolledText:YScroll $w"
+
+ $data(w:hsb) config -command "$data(w:text) xview"
+ $data(w:vsb) config -command "$data(w:text) yview"
+}
+
+#----------------------------------------------------------------------
+#
+# option configs
+#----------------------------------------------------------------------
+proc tixScrolledText:config-takefocus {w value} {
+ upvar #0 $w data
+
+ $data(w:text) config -takefocus $value
+}
+
+proc tixScrolledText:config-scrollbar {w value} {
+ upvar #0 $w data
+
+ if {[string match "auto*" $value]} {
+ set value "both"
+ }
+ set data(-scrollbar) $value
+
+ tixChainMethod $w config-scrollbar $value
+
+ return $value
+}
+
+#----------------------------------------------------------------------
+#
+# Widget commands
+#----------------------------------------------------------------------
+
+
+#----------------------------------------------------------------------
+#
+# Private Methods
+#----------------------------------------------------------------------
+
+#----------------------------------------------------------------------
+# virtual functions to query the client window's scroll requirement
+#----------------------------------------------------------------------
+proc tixScrolledText:GeometryInfo {w mW mH} {
+ upvar #0 $w data
+
+ return [list "$data(x,first) $data(x,last)" "$data(y,first) $data(y,last)"]
+}
+
+proc tixScrolledText:XScroll {w first last} {
+ upvar #0 $w data
+
+ set data(x,first) $first
+ set data(x,last) $last
+
+ $data(w:hsb) set $first $last
+
+ tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
+}
+
+proc tixScrolledText:YScroll {w first last} {
+ upvar #0 $w data
+
+ set data(y,first) $first
+ set data(y,last) $last
+
+ $data(w:vsb) set $first $last
+
+ tixWidgetDoWhenIdle tixScrolledWidget:Configure $w
+}
diff --git a/tix/library/SWidget.tcl b/tix/library/SWidget.tcl
new file mode 100644
index 00000000000..21990da6036
--- /dev/null
+++ b/tix/library/SWidget.tcl
@@ -0,0 +1,507 @@
+# SWidget.tcl --
+#
+# tixScrolledWidget: virtual base class. Do not instantiate
+# This is the core class for all scrolled widgets.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+tixWidgetClass tixScrolledWidget {
+ -virtual true
+ -classname TixScrolledWidget
+ -superclass tixPrimitive
+ -method {
+ }
+ -flag {
+ -scrollbar -scrollbarspace
+ }
+ -configspec {
+ {-scrollbar scrollbar Scrollbar both}
+ {-scrollbarspace scrollbarSpace ScrollbarSpace {both}}
+ {-sizebox sizeBox SizeBox 0}
+ }
+}
+
+proc tixScrolledWidget:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+
+ set data(x,first) 0
+ set data(x,last) 0
+
+ set data(y,first) 0
+ set data(y,last) 0
+
+ set data(lastSpec) ""
+ set data(lastMW) ""
+ set data(lastMH) ""
+ set data(lastScbW) ""
+ set data(lastScbH) ""
+
+ set data(repack) 0
+ set data(counter) 0
+
+ set data(vsbPadY) 0
+ set data(hsbPadX) 0
+}
+
+proc tixScrolledWidget:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ tixManageGeometry $data(pw:client) "tixScrolledWidget:ClientGeomProc $w"
+ bind $data(pw:client) <Configure> \
+ [list tixScrolledWidget:ClientGeomProc $w "" $data(pw:client)]
+
+ tixManageGeometry $data(w:hsb) "tixScrolledWidget:ClientGeomProc $w"
+ bind $data(w:hsb) <Configure> \
+ [list tixScrolledWidget:ClientGeomProc $w "" $data(w:hsb)]
+
+ tixManageGeometry $data(w:vsb) "tixScrolledWidget:ClientGeomProc $w"
+ bind $data(w:vsb) <Configure> \
+ [list tixScrolledWidget:ClientGeomProc $w "" $data(w:vsb)]
+
+ bind $w <Configure> "tixScrolledWidget:MasterGeomProc $w"
+
+ tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
+ set data(repack) 1
+}
+
+proc tixScrolledWidget:config-scrollbar {w value} {
+ upvar #0 $w data
+ global tcl_platform
+
+ if {[lindex $value 0] == "auto"} {
+ foreach xspec [lrange $value 1 end] {
+ case $xspec {
+ {+x -x +y -y} {}
+ default {
+ error "bad -scrollbar value \"$value\""
+ }
+ }
+ }
+ } else {
+ case $value in {
+ {none x y both} {}
+ default {
+ error "bad -scrollbar value \"$value\""
+ }
+ }
+ }
+
+ if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
+ set data(-scrollbar) both
+ }
+
+ if {$data(repack) == 0} {
+ set data(repack) 1
+ tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
+ }
+}
+
+proc tixScrolledWidget:config-scrollbarspace {w value} {
+ upvar #0 $w data
+
+ if {$data(repack) == 0} {
+ set data(repack) 1
+ tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
+ }
+}
+
+proc tixScrolledWidget:config-sizebox {w value} {
+ error "unimplemented"
+}
+
+
+#----------------------------------------------------------------------
+#
+# Scrollbar calculations
+#
+#----------------------------------------------------------------------
+proc tixScrolledWidget:ClientGeomProc {w type client} {
+ upvar #0 $w data
+
+ if {$data(repack) == 0} {
+ set data(repack) 1
+ tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
+ }
+}
+
+proc tixScrolledWidget:MasterGeomProc {w} {
+ upvar #0 $w data
+
+ if {$data(repack) == 0} {
+ set data(repack) 1
+ tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
+ }
+}
+
+proc tixScrolledWidget:Configure {w} {
+ if {![winfo exists $w]} {
+ return
+ }
+
+ upvar #0 $w data
+
+ if {$data(repack) == 0} {
+ set data(repack) 1
+ tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
+ }
+}
+
+proc tixScrolledWidget:ScrollCmd {w scrollbar axis first last} {
+ upvar #0 $w data
+
+ $scrollbar set $first $last
+}
+
+# Show or hide the scrollbars as required.
+#
+# spec: 00 = need none
+# spec: 01 = need y
+# spec: 10 = need x
+# spec: 11 = need xy
+#
+proc tixScrolledWidget:Repack {w} {
+ tixCallMethod $w RepackHook
+}
+
+proc tixScrolledWidget:RepackHook {w} {
+ upvar #0 $w data
+ global tcl_platform
+
+ if {![winfo exists $w]} {
+ # This was generated by the <Destroy> event
+ #
+ return
+ }
+
+ set client $data(pw:client)
+
+ # Calculate the size of the master
+ #
+ set mreqw [winfo reqwidth $w]
+ set mreqh [winfo reqheight $w]
+ set creqw [winfo reqwidth $client]
+ set creqh [winfo reqheight $client]
+
+ set scbW [winfo reqwidth $w.vsb]
+ set scbH [winfo reqheight $w.hsb]
+
+ case $data(-scrollbarspace) {
+ "x" {
+ incr creqh $scbH
+ }
+ "y" {
+ incr creqw $scbW
+ }
+ "both" {
+ incr creqw $scbW
+ incr creqh $scbH
+ }
+ }
+
+ if {$data(-width) != 0} {
+ set creqw $data(-width)
+ }
+ if {$data(-height) != 0} {
+ set creqh $data(-height)
+ }
+
+ if {$mreqw != $creqw || $mreqh != $creqh } {
+ if {![info exists data(counter)]} {
+ set data(counter) 0
+ }
+ if {$data(counter) < 50} {
+ incr data(counter)
+ tixGeometryRequest $w $creqw $creqh
+ tixWidgetDoWhenIdle tixScrolledWidget:Repack $w
+ set data(repack) 1
+ return
+ }
+ }
+
+ set data(counter) 0
+ set mw [winfo width $w]
+ set mh [winfo height $w]
+
+ set cw [expr $mw - $scbW]
+ set ch [expr $mh - $scbH]
+
+ set scbx [expr $mw - $scbW]
+ set scby [expr $mh - $scbH]
+
+ # Check the validity of the sizes: if window was not mapped then
+ # sizes will be below 1x1
+ if {$cw < 1} {
+ set cw 1
+ }
+ if {$ch < 1} {
+ set ch 1
+ }
+ if {$scbx < 1} {
+ set scbx 1
+ }
+ if {$scby < 1} {
+ set scby 1
+ }
+
+ if {[lindex $data(-scrollbar) 0] == "auto"} {
+ # Find out how we are going to pack the scrollbars
+ #
+ set spec [tixScrolledWidget:CheckScrollbars $w $scbW $scbH]
+
+ foreach xspec [lrange $data(-scrollbar) 1 end] {
+ case $xspec {
+ +x {
+ set spec [expr $spec | 10]
+ }
+ -x {
+ set spec [expr $spec & 01]
+ }
+ +y {
+ set spec [expr $spec | 01]
+ }
+ -y {
+ set spec [expr $spec & 10]
+ }
+ }
+ }
+ if {$spec == 0} {
+ set spec 00
+ }
+ if {$spec == 1} {
+ set spec 01
+ }
+ } else {
+ case $data(-scrollbar) in {
+ none {
+ set spec 00
+ }
+ x {
+ set spec 10
+ }
+ y {
+ set spec 01
+ }
+ both {
+ set spec 11
+ }
+ }
+ }
+
+
+ if {$data(lastSpec)==$spec && $data(lastMW)==$mw && $data(lastMH)==$mh} {
+ if {$data(lastScbW) == $scbW && $data(lastScbH) == $scbH} {
+ tixCallMethod $w PlaceWindow
+ set data(repack) 0
+ return
+ }
+ }
+
+ set vsbH [expr $mh - $data(vsbPadY)]
+ set hsbW [expr $mw - $data(hsbPadX)]
+
+ if {$vsbH < 1} {
+ set vsbH 1
+ }
+ if {$hsbW < 1} {
+ set hsbW 1
+ }
+
+ case $spec in {
+ "00" {
+ tixMoveResizeWindow $client 0 0 $mw $mh
+
+ tixMapWindow $client
+ tixUnmapWindow $data(w:hsb)
+ tixUnmapWindow $data(w:vsb)
+ }
+ "01" {
+ tixMoveResizeWindow $client 0 0 $cw $mh
+ tixMoveResizeWindow $data(w:vsb) $scbx $data(vsbPadY) $scbW $vsbH
+
+ tixMapWindow $client
+ tixUnmapWindow $data(w:hsb)
+ tixMapWindow $data(w:vsb)
+ }
+ "10" {
+ tixMoveResizeWindow $client 0 0 $mw $ch
+ tixMoveResizeWindow $data(w:hsb) $data(hsbPadX) $scby $hsbW $scbH
+
+ tixMapWindow $client
+ tixMapWindow $data(w:hsb)
+ tixUnmapWindow $data(w:vsb)
+ }
+ "11" {
+ set vsbH [expr $ch - $data(vsbPadY)]
+ set hsbW [expr $cw - $data(hsbPadX)]
+ if {$vsbH < 1} {
+ set vsbH 1
+ }
+ if {$hsbW < 1} {
+ set hsbW 1
+ }
+
+ tixMoveResizeWindow $client 0 0 $cw $ch
+ tixMoveResizeWindow $data(w:vsb) $scbx $data(vsbPadY) $scbW $vsbH
+ tixMoveResizeWindow $data(w:hsb) $data(hsbPadX) $scby $hsbW $scbH
+ if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
+ tixMoveResizeWindow $data(w:sizebox) $scbx $scby $scbW $scbH
+ }
+
+ tixMapWindow $client
+ tixMapWindow $data(w:hsb)
+ tixMapWindow $data(w:vsb)
+ if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
+ tixMapWindow $data(w:sizebox)
+ }
+ }
+ }
+
+ set data(lastSpec) $spec
+ set data(lastMW) $mw
+ set data(lastMH) $mh
+ set data(lastScbW) $scbW
+ set data(lastScbH) $scbH
+
+ tixCallMethod $w PlaceWindow
+ set data(repack) 0
+}
+
+proc tixScrolledWidget:PlaceWindow {w} {
+ # virtual base function
+}
+
+#
+# Helper function
+#
+proc tixScrolledWidget:NeedScrollbar {w axis} {
+ upvar #0 $w data
+
+ if {$data($axis,first) > 0.0} {
+ return 1
+ }
+
+ if {$data($axis,last) < 1.0} {
+ return 1
+ }
+
+ return 0
+}
+
+# Return whether H and V needs scrollbars in a list of two booleans
+#
+#
+proc tixScrolledWidget:CheckScrollbars {w scbW scbH} {
+ upvar #0 $w data
+
+ set mW [winfo width $w]
+ set mH [winfo height $w]
+
+ set info [tixCallMethod $w GeometryInfo $mW $mH]
+
+ if {$info != ""} {
+ set xSpec [lindex $info 0]
+ set ySpec [lindex $info 1]
+
+ set data(x,first) [lindex $xSpec 0]
+ set data(x,last) [lindex $xSpec 1]
+
+ set data(y,first) [lindex $ySpec 0]
+ set data(y,last) [lindex $ySpec 1]
+ }
+
+ set needX [tixScrolledWidget:NeedScrollbar $w x]
+ set needY [tixScrolledWidget:NeedScrollbar $w y]
+
+ if {[winfo ismapped $w]==0} {
+ return "$needX$needY"
+ }
+
+ if {$needX && $needY} {
+ return 11
+ }
+
+ if {$needX == 0 && $needY == 0} {
+ return 00
+ }
+
+ if {$needX} {
+ set mH [expr $mH - $scbH]
+ }
+ if {$needY} {
+ set mW [expr $mW - $scbW]
+ }
+
+ set info [tixCallMethod $w GeometryInfo $mW $mH]
+ if {$info != ""} {
+ set xSpec [lindex $info 0]
+ set ySpec [lindex $info 1]
+
+ set data(x,first) [lindex $xSpec 0]
+ set data(x,last) [lindex $xSpec 1]
+
+ set data(y,first) [lindex $ySpec 0]
+ set data(y,last) [lindex $ySpec 1]
+ }
+
+ set needX [tixScrolledWidget:NeedScrollbar $w x]
+ set needY [tixScrolledWidget:NeedScrollbar $w y]
+
+ return "$needX$needY"
+}
+
+#----------------------------------------------------------------------
+# Following is a bunch of crap. Not needed in TK 4.0.
+#----------------------------------------------------------------------
+
+#----------------------------------------------------------------------
+# Keyboard events -
+#
+# Raw event handlers: redirect binding events to class methods
+#
+proc tixScrolledWidget:RawUpKey {w} {
+ tixCallMethod $w HandleLineUp
+}
+
+proc tixScrolledWidget:RawDownKey {w} {
+ tixCallMethod $w HandleLineDown
+}
+
+proc tixScrolledWidget:RawLeftKey {w} {
+ tixCallMethod $w HandleLeftKey
+}
+
+proc tixScrolledWidget:RawRightKey {w} {
+ tixCallMethod $w HandleRightKey
+}
+
+proc tixScrolledWidget:RawPriorKey {w} {
+ tixCallMethod $w HandlePageUp
+}
+
+proc tixScrolledWidget:RawNextKey {w} {
+ tixCallMethod $w HandlePageDown
+}
+
+# Virtual event handlers: subclasses can derive from these functions
+#
+
+proc tixScrolledWidget:HandleLineUp {w} {}
+
+proc tixScrolledWidget:HandleLineDown {w} {}
+
+proc tixScrolledWidget:HandlePageUp {w} {}
+
+proc tixScrolledWidget:HandlePageDown {w} {}
+
+proc tixScrolledWidget:HandleLeftKey {w} {}
+
+proc tixScrolledWidget:HandleRightKey {w} {}
diff --git a/tix/library/SWindow.tcl b/tix/library/SWindow.tcl
new file mode 100644
index 00000000000..728341a71b2
--- /dev/null
+++ b/tix/library/SWindow.tcl
@@ -0,0 +1,277 @@
+# SWindow.tcl --
+#
+# This file implements Scrolled Window widgets
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#
+#
+# Example:
+#
+# tixScrolledWindow .w
+# set window [.w subwidget window]
+# # Now you can put a whole widget hierachy inside $window.
+# #
+# button $window.b
+# pack $window.b
+#
+# Author's note
+#
+# Note, the current implementation does not allow the child window
+# to be outside of the parent window when the parent's size is larger
+# than the child's size. This is fine for normal operations. However,
+# it is not suitable for an MDI master window. Therefore, you will notice
+# that the MDI master window is not a subclass of ScrolledWidget at all.
+#
+#
+
+tixWidgetClass tixScrolledWindow {
+ -classname TixScrolledWindow
+ -superclass tixScrolledWidget
+ -method {
+ }
+ -flag {
+ -expandmode -shrink -xscrollincrement -yscrollincrement
+ }
+ -static {
+ }
+ -configspec {
+ {-expandmode expandMode ExpandMode expand}
+ {-shrink shrink Shrink ""}
+ {-xscrollincrement xScrollIncrement ScrollIncrement ""}
+ {-yscrollincrement yScrollIncrement ScrollIncrement ""}
+
+ {-scrollbarspace scrollbarSpace ScrollbarSpace {both}}
+ }
+ -default {
+ {.scrollbar auto}
+ {*window.borderWidth 1}
+ {*f1.borderWidth 1}
+ {*Scrollbar.borderWidth 1}
+ {*Scrollbar.background #d9d9d9}
+ {*Scrollbar.relief sunken}
+ {*Scrollbar.troughColor #c3c3c3}
+ {*Scrollbar.takeFocus 0}
+ {*Scrollbar.width 15}
+ }
+}
+
+proc tixScrolledWindow:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+
+ set data(dx) 0
+ set data(dy) 0
+}
+
+proc tixScrolledWindow:ConstructWidget {w} {
+ upvar #0 $w data
+ global tcl_platform
+
+ tixChainMethod $w ConstructWidget
+
+ set data(pw:f1) \
+ [frame $w.f1 -relief sunken]
+ set data(pw:f2) \
+ [frame $w.f2 -bd 0]
+ set data(w:window) \
+ [frame $w.f2.window -bd 0]
+ pack $data(pw:f2) -in $data(pw:f1) -expand yes -fill both
+
+ set data(w:hsb) \
+ [scrollbar $w.hsb -orient horizontal -takefocus 0]
+ set data(w:vsb) \
+ [scrollbar $w.vsb -orient vertical -takefocus 0]
+# set data(w:pann) \
+# [frame $w.pann -bd 2 -relief groove]
+
+ if {$data(-sizebox) && $tcl_platform(platform) == "windows"} {
+ set data(w:sizebox) [ide_sizebox $w.sizebox]
+ }
+
+ $data(pw:f1) config -highlightthickness \
+ [$data(w:hsb) cget -highlightthickness]
+
+ set data(pw:client) $data(pw:f1)
+}
+
+proc tixScrolledWindow:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ $data(w:hsb) config -command "tixScrolledWindow:ScrollBarCB $w x"
+ $data(w:vsb) config -command "tixScrolledWindow:ScrollBarCB $w y"
+
+ tixManageGeometry $data(w:window) "tixScrolledWindow:WindowGeomProc $w"
+}
+
+# This guy just keeps asking for a same size as the w:window
+#
+proc tixScrolledWindow:WindowGeomProc {w args} {
+ upvar #0 $w data
+
+ set rw [winfo reqwidth $data(w:window)]
+ set rh [winfo reqheight $data(w:window)]
+
+ if {$rw != [winfo reqwidth $data(pw:f2)] ||
+ $rh != [winfo reqheight $data(pw:f2)]} {
+ tixGeometryRequest $data(pw:f2) $rw $rh
+ }
+}
+
+proc tixScrolledWindow:Scroll {w axis total window first args} {
+ upvar #0 $w data
+
+ case [lindex $args 0] {
+ "scroll" {
+ set amt [lindex $args 1]
+ set unit [lindex $args 2]
+
+ case $unit {
+ "units" {
+ set incr $axis\scrollincrement
+ if {$data(-$incr) != ""} {
+ set by $data(-$incr)
+ } else {
+ set by [expr $window / 16]
+ }
+ set first [expr $first + $amt * $by]
+ }
+ "pages" {
+ set first [expr $first + $amt * $window]
+ }
+ }
+ }
+ "moveto" {
+ set to [lindex $args 1]
+ set first [expr int($to * $total)]
+ }
+ }
+
+ if {[expr $first + $window] > $total} {
+ set first [expr $total - $window]
+ }
+ if {$first < 0} {
+ set first 0
+ }
+
+ return $first
+}
+
+proc tixScrolledWindow:ScrollBarCB {w axis args} {
+ upvar #0 $w data
+
+ set bd \
+ [expr [$data(pw:f1) cget -bd] + [$data(pw:f1) cget -highlightthickness]]
+ set fw [expr [winfo width $data(pw:f1)] - 2*$bd]
+ set fh [expr [winfo height $data(pw:f1)] - 2*$bd]
+ set ww [winfo reqwidth $data(w:window)]
+ set wh [winfo reqheight $data(w:window)]
+
+ if {$axis == "x"} {
+ set data(dx) \
+ [eval tixScrolledWindow:Scroll $w $axis $ww $fw $data(dx) $args]
+ } else {
+ set data(dy) \
+ [eval tixScrolledWindow:Scroll $w $axis $wh $fh $data(dy) $args]
+ }
+
+ tixWidgetDoWhenIdle tixScrolledWindow:PlaceWindow $w
+}
+
+proc tixScrolledWindow:PlaceWindow {w} {
+ upvar #0 $w data
+
+ set bd \
+ [expr [$data(pw:f1) cget -bd] + [$data(pw:f1) cget -highlightthickness]]
+ set fw [expr [winfo width $data(pw:f1)] - 2*$bd]
+ set fh [expr [winfo height $data(pw:f1)] - 2*$bd]
+ set ww [winfo reqwidth $data(w:window)]
+ set wh [winfo reqheight $data(w:window)]
+
+ tixMapWindow $data(w:window)
+
+ if {$data(-expandmode) == "expand"} {
+ if {$ww < $fw} {
+ set ww $fw
+ }
+ if {$wh < $fh} {
+ set wh $fh
+ }
+ }
+ if {$data(-shrink) == "x"} {
+ if {$fw < $ww} {
+ set ww $fw
+ }
+ }
+
+ tixMoveResizeWindow $data(w:window) -$data(dx) -$data(dy) $ww $wh
+
+ set first [expr $data(dx).0 / $ww.0]
+ set last [expr $first + ($fw.0 / $ww.0)]
+ $data(w:hsb) set $first $last
+
+ set first [expr $data(dy).0 / $wh.0]
+ set last [expr $first + ($fh.0 / $wh.0)]
+ $data(w:vsb) set $first $last
+}
+
+#----------------------------------------------------------------------
+# virtual functions to query the client window's scroll requirement
+#
+# When this function is called, the scrolled window is going to be
+# mapped, if it is still unmapped. Also, it is going to change its
+# size. Therefore, it is a good time to check whether the w:window needs
+# to be re-positioned due to the new parent window size.
+#----------------------------------------------------------------------
+proc tixScrolledWindow:GeometryInfo {w mW mH} {
+ upvar #0 $w data
+
+ set bd \
+ [expr [$data(pw:f1) cget -bd] + [$data(pw:f1) cget -highlightthickness]]
+ set fw [expr $mW -2*$bd]
+ set fh [expr $mH -2*$bd]
+ set ww [winfo reqwidth $data(w:window)]
+ set wh [winfo reqheight $data(w:window)]
+
+ # Calculate the X info
+ #
+ if {$fw >= $ww} {
+ if {$data(dx) > 0} {
+ set data(dx) 0
+ }
+ set xinfo [list 0.0 1.0]
+ } else {
+ set maxdx [expr $ww - $fw]
+ if {$data(dx) > $maxdx} {
+ set data(dx) $maxdx
+ }
+ set first [expr $data(dx).0 / $ww.0]
+ set last [expr $first + ($fw.0 / $ww.0)]
+ set xinfo [list $first $last]
+ }
+ # Calculate the Y info
+ #
+ if {$fh >= $wh} {
+ if {$data(dy) > 0} {
+ set data(dy) 0
+ }
+ set yinfo [list 0.0 1.0]
+ } else {
+ set maxdy [expr $wh - $fh]
+ if {$data(dy) > $maxdy} {
+ set data(dy) $maxdy
+ }
+ set first [expr $data(dy).0 / $wh.0]
+ set last [expr $first + ($fh.0 / $wh.0)]
+ set yinfo [list $first $last]
+ }
+
+ return [list $xinfo $yinfo]
+}
diff --git a/tix/library/Select.tcl b/tix/library/Select.tcl
new file mode 100644
index 00000000000..e92831ce801
--- /dev/null
+++ b/tix/library/Select.tcl
@@ -0,0 +1,295 @@
+# Select.tcl --
+#
+# Implement the tixSelect widget.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixSelect {
+ -superclass tixLabelWidget
+ -classname TixSelect
+ -method {
+ add button invoke
+ }
+ -flag {
+ -allowzero -buttontype -command -disablecallback -orientation
+ -orient -padx -pady -radio -selectedbg -state -validatecmd
+ -value -variable
+ }
+ -forcecall {
+ -variable -state
+ }
+ -static {
+ -allowzero -orientation -padx -pady -radio
+ }
+ -configspec {
+ {-allowzero allowZero AllowZero 0 tixVerifyBoolean}
+ {-buttontype buttonType ButtonType button}
+ {-command command Command ""}
+ {-disablecallback disableCallback DisableCallback 0 tixVerifyBoolean}
+ {-orientation orientation Orientation horizontal}
+ {-padx padx Pad 0}
+ {-pady pady Pad 0}
+ {-radio radio Radio 0 tixVerifyBoolean}
+ {-selectedbg selectedBg SelectedBg gray}
+ {-state state State normal}
+ {-validatecmd validateCmd ValidateCmd ""}
+ {-value value Value ""}
+ {-variable variable Variable ""}
+ }
+ -alias {
+ {-orient -orientation}
+ }
+ -default {
+ {*frame.borderWidth 1}
+ {*frame.relief sunken}
+ {*Button.borderWidth 2}
+ {*Button.highlightThickness 0}
+ }
+}
+
+proc tixSelect:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+ set data(items) ""
+ set data(buttonbg) ""
+ set data(varInited) 0
+}
+
+#----------------------------------------------------------------------
+# CONFIG OPTIONS
+#----------------------------------------------------------------------
+proc tixSelect:config-state {w arg} {
+ upvar #0 $w data
+
+ if {$arg == "disabled"} {
+ foreach item $data(items) {
+ $data(w:$item) config -state disabled -relief raised \
+ -bg $data(buttonbg)
+ }
+ if ![info exists data(labelFg)] {
+ set data(labelFg) [$data(w:label) cget -foreground]
+ catch {
+ $data(w:label) config -fg [tix option get disabled_fg]
+ }
+ }
+ } else {
+ foreach item $data(items) {
+ if {[lsearch $data(-value) $item] != -1} {
+ # This button is selected
+ #
+ $data(w:$item) config -relief sunken -bg $data(-selectedbg) \
+ -state normal
+ } else {
+ $data(w:$item) config -relief raised -bg $data(buttonbg) \
+ -command "$w invoke $item" -state normal
+ }
+ }
+ if [info exists data(labelFg)] {
+ catch {
+ $data(w:label) config -fg $data(labelFg)
+ }
+ unset data(labelFg)
+ }
+ }
+
+ return ""
+}
+
+proc tixSelect:config-variable {w arg} {
+ upvar #0 $w data
+
+ set oldValue $data(-value)
+
+ if [tixVariable:ConfigVariable $w $arg] {
+ # The value of data(-value) is changed if tixVariable:ConfigVariable
+ # returns true
+ set newValue $data(-value)
+ set data(-value) $oldValue
+ tixSelect:config-value $w $newValue
+ }
+ catch {
+ unset data(varInited)
+ }
+ set data(-variable) $arg
+}
+
+proc tixSelect:config-value {w value} {
+ upvar #0 $w data
+
+ # sanity checking
+ #
+ foreach item $value {
+ if {[lsearch $data(items) $item] == "-1"} {
+ error "subwidget \"$item\" does not exist"
+ }
+ }
+
+ tixSelect:SetValue $w $value
+}
+
+#----------------------------------------------------------------------
+# WIDGET COMMANDS
+#----------------------------------------------------------------------
+proc tixSelect:add {w name args} {
+ upvar #0 $w data
+
+ set data(w:$name) [eval $data(-buttontype) $data(w:frame).$name -command \
+ [list "$w invoke $name"] -takefocus 0 $args]
+
+ if {$data(-orientation) == "horizontal"} {
+ pack $data(w:$name) -side left -expand yes -fill y\
+ -padx $data(-padx) -pady $data(-pady)
+ } else {
+ pack $data(w:$name) -side top -expand yes -fill x\
+ -padx $data(-padx) -pady $data(-pady)
+ }
+
+ if {$data(-state) == "disabled"} {
+ $data(w:$name) config -relief raised -state disabled
+ }
+
+ # find out the background of the buttons
+ #
+ if {$data(buttonbg) == ""} {
+ set data(buttonbg) [lindex [$data(w:$name) config -background] 4]
+
+ }
+
+ lappend data(items) $name
+}
+
+# Obsolete command
+#
+proc tixSelect:button {w name args} {
+ upvar #0 $w data
+
+ if {$args != ""} {
+ return [eval $data(w:$name) $args]
+ } else {
+ return $w.$name
+ }
+}
+
+# This is called when a button is invoked
+#
+proc tixSelect:invoke {w button} {
+ upvar #0 $w data
+
+ if {$data(-state) != "normal"} {
+ return
+ }
+
+ set newValue $data(-value)
+
+ if {[lsearch $data(-value) $button] != -1} {
+ # This button was selected
+ #
+ if {[llength $data(-value)] > 1 || [tixGetBoolean $data(-allowzero)]} {
+
+ # Take the button from the selected list
+ #
+ set newValue ""
+ foreach item $data(-value) {
+ if {$item != $button} {
+ lappend newValue $item
+ }
+ }
+ }
+ } else {
+ # This button was not selected
+ #
+ if [tixGetBoolean $data(-radio)] {
+ # The button become the sole item in the list
+ #
+ set newValue [list $button]
+ } else {
+ # Add this button into the list
+ #
+ lappend newValue $button
+ }
+ }
+
+ if {$newValue != $data(-value)} {
+ tixSelect:SetValue $w $newValue
+ }
+}
+
+#----------------------------------------------------------------------
+# Private functions
+#----------------------------------------------------------------------
+proc tixSelect:SetValue {w newValue {noUpdate 0}} {
+ upvar #0 $w data
+
+ set oldValue $data(-value)
+
+ if {$data(-validatecmd) != ""} {
+ set data(-value) [tixEvalCmdBinding $w $data(-validatecmd) "" $newValue]
+ } else {
+ if {[tixGetBoolean $data(-radio)] && [llength $newValue] > 1} {
+ error "cannot choose more than one items in a radio box"
+ }
+
+ if {![tixGetBoolean $data(-allowzero)] && [llength $newValue] == 0} {
+ error "empty selection not allowed"
+ }
+
+ set data(-value) $newValue
+ }
+
+ if {! $noUpdate} {
+ tixVariable:UpdateVariable $w
+ }
+
+ # Reset all to be unselected
+ #
+ foreach item $data(items) {
+ if {[lsearch $data(-value) $item] == -1} {
+ # Is unselected
+ #
+ if {[lsearch $oldValue $item] != -1} {
+ # was selected
+ # -> popup the button, call command
+ #
+ $data(w:$item) config -relief raised -bg $data(buttonbg)
+ tixSelect:CallCommand $w $item 0
+ }
+ } else {
+ # Is selected
+ #
+ if {[lsearch $oldValue $item] == -1} {
+ # was unselected
+ # -> push down the button, call command
+ #
+ $data(w:$item) config -relief sunken -bg $data(-selectedbg)
+ tixSelect:CallCommand $w $item 1
+ }
+ }
+ }
+}
+
+proc tixSelect:CallCommand {w name value} {
+ upvar #0 $w data
+
+ if {!$data(-disablecallback) && $data(-command) != ""} {
+ if {![info exists data(varInited)]} {
+ set bind(specs) "name value"
+ set bind(name) $name
+ set bind(value) $value
+ tixEvalCmdBinding $w $data(-command) bind $name $value
+ }
+ }
+}
+
+proc tixSelect:Destructor {w} {
+
+ tixVariable:DeleteVariable $w
+
+ # Chain this to the superclass
+ #
+ tixChainMethod $w Destructor
+}
diff --git a/tix/library/Shell.tcl b/tix/library/Shell.tcl
new file mode 100644
index 00000000000..388563797ca
--- /dev/null
+++ b/tix/library/Shell.tcl
@@ -0,0 +1,41 @@
+# Shell.tcl --
+#
+# This is the base class to all shell widget
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#
+# type : normal, transient, overrideredirect
+#
+tixWidgetClass tixShell {
+ -superclass tixPrimitive
+ -classname TixShell
+ -flag {
+ -title
+ }
+ -configspec {
+ {-title title Title ""}
+ }
+ -forcecall {
+ -title
+ }
+}
+
+#----------------------------------------------------------------------
+# ClassInitialization:
+#----------------------------------------------------------------------
+proc tixShell:CreateRootWidget {w args} {
+ upvar #0 $w data
+ upvar #0 $data(className) classRec
+
+ toplevel $w -class $data(ClassName)
+ wm withdraw $w
+}
+
+proc tixShell:config-title {w value} {
+ wm title $w $value
+}
diff --git a/tix/library/SimpDlg.tcl b/tix/library/SimpDlg.tcl
new file mode 100644
index 00000000000..054d67e4d69
--- /dev/null
+++ b/tix/library/SimpDlg.tcl
@@ -0,0 +1,42 @@
+# SimpDlg.tcl --
+#
+# This file implements Simple Dialog widgets
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixSimpleDialog {
+ -classname TixSimpleDialog
+ -superclass tixDialogShell
+ -method {}
+ -flag {
+ -buttons -message -type
+ }
+ -configspec {
+ {-buttons buttons Buttons ""}
+ {-message message Message ""}
+ {-type type Type info}
+ }
+}
+
+proc tixSimpleDialog:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ frame $w.top
+
+ label $w.top.icon -image [tix getimage $data(-type)]
+ label $w.top.message -text $data(-message)
+
+ pack $w.top.icon -side left -padx 20 -pady 50 -anchor c
+ pack $w.top.message -side left -padx 10 -pady 50 -anchor c
+
+ frame $w.bot
+
+ pack $w.bot -side bottom -fill x
+ pack $w.top -side top -expand yes -fill both
+}
diff --git a/tix/library/StackWin.tcl b/tix/library/StackWin.tcl
new file mode 100644
index 00000000000..7c0a00e2cad
--- /dev/null
+++ b/tix/library/StackWin.tcl
@@ -0,0 +1,80 @@
+# StackWin.tcl --
+#
+# Similar to NoteBook but uses a Select widget to represent the pages.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixStackWindow {
+ -classname TixStackWindow
+ -superclass tixVStack
+ -method {
+ }
+ -flag {
+ }
+ -configspec {
+ }
+}
+
+proc tixStackWindow:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ set data(w:tabs) [tixSelect $w.tabs]
+
+ # We can't use the packer because it will conflict with the
+ # geometry management of the VStack widget.
+ #
+ tixManageGeometry $data(w:tabs) "tixVStack:ClientGeomProc $w"
+}
+
+proc tixStackWindow:add {w child args} {
+ upvar #0 $w data
+
+ set ret [eval tixChainMethod $w add $child $args]
+
+ # Find out the -label option
+ #
+ tixForEach {flag value} $args {
+ if {$flag == "-label"} {
+ set label $value
+ }
+ }
+
+ $data(w:tabs) add $child -command "$w raise $child" \
+ -text $label
+
+ return $ret
+}
+
+proc tixStackWindow:raise {w child} {
+ upvar #0 $w data
+
+ $data(w:tabs) config -value $child
+
+ tixChainMethod $w raise $child
+}
+
+proc tixStackWindow:Resize {w} {
+ upvar #0 $w data
+
+ # We have to take care of the size of the tabs so that
+ #
+ set tW [winfo reqwidth $data(w:tabs)]
+ set tH [winfo reqheight $data(w:tabs)]
+
+ tixMoveResizeWindow $data(w:tabs) $data(-ipadx) $data(-ipady) $tW $tH
+ tixMapWindow $data(w:tabs)
+
+ set data(pad-y1) [expr $tH + $data(-ipadx)]
+ set data(minW) [expr $tW + 2 * $data(-ipadx)]
+ set data(minH) [expr $tH + 2 * $data(-ipady)]
+
+ # Now that we know data(pad-y1), we can chain the call
+ #
+ tixChainMethod $w Resize
+}
diff --git a/tix/library/StatBar.tcl b/tix/library/StatBar.tcl
new file mode 100644
index 00000000000..16de0d671ce
--- /dev/null
+++ b/tix/library/StatBar.tcl
@@ -0,0 +1,51 @@
+# StatBar.tcl --
+#
+# The StatusBar of an application.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixStatusBar {
+ -classname TixStatusBar
+ -superclass tixPrimitive
+ -method {
+ }
+ -flag {
+ -fields
+ }
+ -static {
+ -fields
+ }
+ -configspec {
+ {-fields fields Fields ""}
+ }
+}
+
+#--------------------------
+# Create Widget
+#--------------------------
+proc tixStatusBar:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ foreach field $data(-fields) {
+ set name [lindex $field 0]
+ set width [lindex $field 1]
+
+ set data(w:width) [label $w.$name -width $width]
+ }
+}
+
+
+#----------------------------------------------------------------------
+# Public methods
+#----------------------------------------------------------------------
+
+
+#----------------------------------------------------------------------
+# Internal commands
+#----------------------------------------------------------------------
diff --git a/tix/library/StdBBox.tcl b/tix/library/StdBBox.tcl
new file mode 100644
index 00000000000..8ffe94c3815
--- /dev/null
+++ b/tix/library/StdBBox.tcl
@@ -0,0 +1,66 @@
+# StdBBox.tcl --
+#
+# Standard Button Box, used in standard dialog boxes
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+
+tixWidgetClass tixStdButtonBox {
+ -classname TixStdButtonBox
+ -superclass tixButtonBox
+ -flag {
+ -applycmd -cancelcmd -helpcmd -okcmd
+ }
+ -configspec {
+ {-applycmd applyCmd ApplyCmd ""}
+ {-cancelcmd cancelCmd CancelCmd ""}
+ {-helpcmd helpCmd HelpCmd ""}
+ {-okcmd okCmd OkCmd ""}
+ }
+ -default {
+ {.borderWidth 1}
+ {.relief raised}
+ {.padX 5}
+ {.padY 10}
+ {*Button.anchor c}
+ {*Button.padX 5}
+ }
+}
+
+proc tixStdButtonBox:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ $w add ok -text OK -under 0 -width 6 -command $data(-okcmd)
+ $w add apply -text Apply -under 0 -width 6 -command $data(-applycmd)
+ $w add cancel -text Cancel -under 0 -width 6 -command $data(-cancelcmd)
+ $w add help -text Help -under 0 -width 6 -command $data(-helpcmd)
+}
+
+proc tixStdButtonBox:config {w flag value} {
+ upvar #0 $w data
+
+ case $flag {
+ -okcmd {
+ $data(w:ok) config -command $value
+ }
+ -applycmd {
+ $data(w:apply) config -command $value
+ }
+ -cancelcmd {
+ $data(w:cancel) config -command $value
+ }
+ -helpcmd {
+ $data(w:help) config -command $value
+ }
+ default {
+ tixChainMethod $w config $flag $value
+ }
+ }
+}
diff --git a/tix/library/StdShell.tcl b/tix/library/StdShell.tcl
new file mode 100644
index 00000000000..940b096e306
--- /dev/null
+++ b/tix/library/StdShell.tcl
@@ -0,0 +1,44 @@
+# StdShell.tcl --
+#
+# Standard Dialog Shell.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixStdDialogShell {
+ -classname TixStdDialogShell
+ -superclass tixDialogShell
+ -method {}
+ -flag {
+ -cached
+ }
+ -configspec {
+ {-cached cached Cached ""}
+ }
+}
+
+proc tixStdDialogShell:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+ set data(w:btns) [tixStdButtonBox $w.btns]
+ set data(w_tframe) [frame $w.tframe]
+
+ pack $data(w_tframe) -side top -expand yes -fill both
+ pack $data(w:btns) -side bottom -fill both
+
+ tixCallMethod $w ConstructTopFrame $data(w_tframe)
+}
+
+
+# Subclasses of StdDialogShell should override this method instead of
+# ConstructWidget.
+#
+# Override : always
+# chain : before
+proc tixStdDialogShell:ConstructTopFrame {w frame} {
+ # Do nothing
+}
diff --git a/tix/library/TList.tcl b/tix/library/TList.tcl
new file mode 100644
index 00000000000..85981722966
--- /dev/null
+++ b/tix/library/TList.tcl
@@ -0,0 +1,995 @@
+# TList.tcl --
+#
+# This file defines the default bindings for Tix Tabular Listbox
+# widgets.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# 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:
+#
+# afterId - Token returned by "after" for autoscanning.
+# fakeRelease - Cancel the ButtonRelease-1 after the user double click
+#--------------------------------------------------------------------------
+#
+proc tixTListBind {} {
+ tixBind TixTList <ButtonPress-1> {
+ tixTList:Button-1 %W %x %y
+ }
+ tixBind TixTList <Shift-ButtonPress-1> {
+ tixTList:Shift-Button-1 %W %x %y
+ }
+ tixBind TixTList <Control-ButtonPress-1> {
+ tixTList:Control-Button-1 %W %x %y
+ }
+ tixBind TixTList <ButtonRelease-1> {
+ tixTList:ButtonRelease-1 %W %x %y
+ }
+ tixBind TixTList <Double-ButtonPress-1> {
+ tixTList:Double-1 %W %x %y
+ }
+ tixBind TixTList <B1-Motion> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ set tkPriv(X) %X
+ set tkPriv(Y) %Y
+
+ tixTList:B1-Motion %W %x %y
+ }
+ tixBind TixTList <Control-B1-Motion> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ set tkPriv(X) %X
+ set tkPriv(Y) %Y
+
+ tixTList:Control-B1-Motion %W %x %y
+ }
+ tixBind TixTList <B1-Leave> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ set tkPriv(X) %X
+ set tkPriv(Y) %Y
+
+ tixTList:B1-Leave %W
+ }
+ tixBind TixTList <B1-Enter> {
+ tixTList:B1-Enter %W %x %y
+ }
+ tixBind TixTList <Control-B1-Leave> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ set tkPriv(X) %X
+ set tkPriv(Y) %Y
+
+ tixTList:Control-B1-Leave %W
+ }
+ tixBind TixTList <Control-B1-Enter> {
+ tixTList:Control-B1-Enter %W %x %y
+ }
+
+ # Keyboard bindings
+ #
+ tixBind TixTList <Up> {
+ tixTList:DirKey %W up
+ }
+ tixBind TixTList <Down> {
+ tixTList:DirKey %W down
+ }
+ tixBind TixTList <Left> {
+ tixTList:DirKey %W left
+ }
+ tixBind TixTList <Right> {
+ tixTList:DirKey %W right
+ }
+ tixBind TixTList <Prior> {
+ %W yview scroll -1 pages
+ }
+ tixBind TixTList <Next> {
+ %W yview scroll 1 pages
+ }
+ tixBind TixTList <Return> {
+ tixTList:Return %W
+ }
+ tixBind TixTList <space> {
+ tixTList:Space %W
+ }
+}
+
+#----------------------------------------------------------------------
+#
+#
+# Mouse bindings
+#
+#
+#----------------------------------------------------------------------
+
+proc tixTList:Button-1 {w x y} {
+ if {[$w cget -state] == "disabled"} {
+ return
+ }
+ if [$w cget -takefocus] {
+ focus $w
+ }
+ case [tixTList:GetState $w] {
+ {s0} {
+ tixTList:GoState s1 $w $x $y
+ }
+ {b0} {
+ tixTList:GoState b1 $w $x $y
+ }
+ {m0} {
+ tixTList:GoState m1 $w $x $y
+ }
+ {e0} {
+ tixTList:GoState e1 $w $x $y
+ }
+ }
+}
+
+proc tixTList:Shift-Button-1 {w x y} {
+ if {[$w cget -state] == "disabled"} {
+ return
+ }
+ if [$w cget -takefocus] {
+ focus $w
+ }
+ case [tixTList:GetState $w] {
+ {s0} {
+ tixTList:GoState s1 $w $x $y
+ }
+ {b0} {
+ tixTList:GoState b1 $w $x $y
+ }
+ {m0} {
+ tixTList:GoState m7 $w $x $y
+ }
+ {e0} {
+ tixTList:GoState e7 $w $x $y
+ }
+ }
+}
+
+proc tixTList:Control-Button-1 {w x y} {
+ if {[$w cget -state] == "disabled"} {
+ return
+ }
+ if [$w cget -takefocus] {
+ focus $w
+ }
+ case [tixTList:GetState $w] {
+ {s0} {
+ tixTList:GoState s1 $w $x $y
+ }
+ {b0} {
+ tixTList:GoState b1 $w $x $y
+ }
+ {m0} {
+ tixTList:GoState m1 $w $x $y
+ }
+ {e0} {
+ tixTList:GoState e10 $w $x $y
+ }
+ }
+}
+
+proc tixTList:ButtonRelease-1 {w x y} {
+ case [tixTList:GetState $w] {
+ {s2 s4 s5 s6} {
+ tixTList:GoState s3 $w
+ }
+ {b2 b4 b5 b6} {
+ tixTList:GoState b3 $w
+ }
+ {m2} {
+ tixTList:GoState m3 $w
+ }
+ {m5} {
+ tixTList:GoState m6 $w $x $y
+ }
+ {m9} {
+ tixTList:GoState m0 $w
+ }
+ {e2} {
+ tixTList:GoState e3 $w
+ }
+ {e5} {
+ tixTList:GoState e6 $w $x $y
+ }
+ {e9} {
+ tixTList:GoState e0 $w
+ }
+ }
+}
+
+proc tixTList:B1-Motion {w x y} {
+ case [tixTList:GetState $w] {
+ {s2 s4} {
+ tixTList:GoState s4 $w $x $y
+ }
+ {b2 b4} {
+ tixTList:GoState b4 $w $x $y
+ }
+ {m2 m5} {
+ tixTList:GoState m4 $w $x $y
+ }
+ {e2 e5} {
+ tixTList:GoState e4 $w $x $y
+ }
+ }
+}
+
+proc tixTList:Control-B1-Motion {w x y} {
+ case [tixTList:GetState $w] {
+ {s2 s4} {
+ tixTList:GoState s4 $w $x $y
+ }
+ {b2 b4} {
+ tixTList:GoState b4 $w $x $y
+ }
+ {m2 m5} {
+ tixTList:GoState m4 $w $x $y
+ }
+ }
+}
+
+proc tixTList:Double-1 {w x y} {
+ case [tixTList:GetState $w] {
+ {s0} {
+ tixTList:GoState s7 $w $x $y
+ }
+ {b0} {
+ tixTList:GoState b7 $w $x $y
+ }
+ }
+}
+
+proc tixTList:B1-Leave {w} {
+ case [tixTList:GetState $w] {
+ {s2 s4} {
+ tixTList:GoState s5 $w
+ }
+ {b2 b4} {
+ tixTList:GoState b5 $w
+ }
+ {m2 m5} {
+ tixTList:GoState m8 $w
+ }
+ {e2 e5} {
+ tixTList:GoState e8 $w
+ }
+ }
+}
+
+proc tixTList:B1-Enter {w x y} {
+ case [tixTList:GetState $w] {
+ {s5 s6} {
+ tixTList:GoState s4 $w $x $y
+ }
+ {b5 b6} {
+ tixTList:GoState b4 $w $x $y
+ }
+ {m8 m9} {
+ tixTList:GoState m4 $w $x $y
+ }
+ {e8 e9} {
+ tixTList:GoState e4 $w $x $y
+ }
+ }
+}
+
+proc tixTList:Control-B1-Leave {w} {
+ case [tixTList:GetState $w] {
+ {s2 s4} {
+ tixTList:GoState s5 $w
+ }
+ {b2 b4} {
+ tixTList:GoState b5 $w
+ }
+ {m2 m5} {
+ tixTList:GoState m8 $w
+ }
+ }
+}
+
+proc tixTList:Control-B1-Enter {w x y} {
+ case [tixTList:GetState $w] {
+ {s5 s6} {
+ tixTList:GoState s4 $w $x $y
+ }
+ {b5 b6} {
+ tixTList:GoState b4 $w $x $y
+ }
+ {m8 m9} {
+ tixTList:GoState m4 $w $x $y
+ }
+ }
+}
+
+proc tixTList:AutoScan {w} {
+ case [tixTList:GetState $w] {
+ {s5 s6} {
+ tixTList:GoState s6 $w
+ }
+ {b5 b6} {
+ tixTList:GoState b6 $w
+ }
+ {m8 m9} {
+ tixTList:GoState m9 $w
+ }
+ {e8 e9} {
+ tixTList:GoState e9 $w
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+#
+#
+# Key bindings
+#
+#
+#----------------------------------------------------------------------
+proc tixTList:DirKey {w key} {
+ if {[$w cget -state] == "disabled"} {
+ return
+ }
+ case [tixTList:GetState $w] {
+ {s0} {
+ tixTList:GoState s8 $w $key
+ }
+ {b0} {
+ tixTList:GoState b8 $w $key
+ }
+ }
+}
+
+proc tixTList:Return {w} {
+ if {[$w cget -state] == "disabled"} {
+ return
+ }
+ case [tixTList:GetState $w] {
+ {s0} {
+ tixTList:GoState s9 $w
+ }
+ {b0} {
+ tixTList:GoState b9 $w
+ }
+ }
+}
+
+proc tixTList:Space {w} {
+ if {[$w cget -state] == "disabled"} {
+ return
+ }
+ case [tixTList:GetState $w] {
+ {s0} {
+ tixTList:GoState s10 $w
+ }
+ {b0} {
+ tixTList:GoState b10 $w
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+#
+# STATE MANIPULATION
+#
+#
+#----------------------------------------------------------------------
+proc tixTList:GetState {w} {
+ global $w:priv:state
+
+ if {![info exists $w:priv:state]} {
+ case [$w cget -selectmode] {
+ single {
+ set $w:priv:state s0
+ }
+ browse {
+ set $w:priv:state b0
+ }
+ multiple {
+ set $w:priv:state m0
+ }
+ extended {
+ set $w:priv:state e0
+ }
+ default {
+ set $w:priv:state unknown
+ }
+ }
+ }
+ return [set $w:priv:state]
+}
+
+proc tixTList:SetState {w n} {
+ global $w:priv:state
+
+ set $w:priv:state $n
+}
+
+proc tixTList:GoState {n w args} {
+
+# puts "going from [tixTList:GetState $w] --> $n"
+
+ tixTList:SetState $w $n
+ eval tixTList:GoState-$n $w $args
+}
+
+#----------------------------------------------------------------------
+# States
+#----------------------------------------------------------------------
+
+#----------------------------------------------------------------------
+# SINGLE SELECTION
+#----------------------------------------------------------------------
+proc tixTList:GoState-s0 {w} {
+}
+
+proc tixTList:GoState-s1 {w x y} {
+ set ent [$w nearest $x $y]
+ if {$ent != ""} {
+ $w anchor set $ent
+ }
+ tixTList:GoState s2 $w
+}
+
+proc tixTList:GoState-s2 {w} {
+}
+
+proc tixTList:GoState-s3 {w} {
+ set ent [$w info anchor]
+ if {$ent != ""} {
+ $w selection clear
+ $w selection set $ent
+ tixTList:CallBrowseCmd $w $ent
+ }
+ tixTList:GoState s0 $w
+}
+
+proc tixTList:GoState-s4 {w x y} {
+ set ent [$w nearest $x $y]
+ if {$ent != ""} {
+ $w anchor set $ent
+ }
+}
+
+proc tixTList:GoState-s5 {w} {
+ tixTList:StartScan $w
+}
+
+proc tixTList:GoState-s6 {w} {
+ global tkPriv
+
+ tixTList:DoScan $w
+}
+
+proc tixTList:GoState-s7 {w x y} {
+ set ent [$w nearest $x $y]
+
+ if {$ent != ""} {
+ $w selection clear
+ $w selection set $ent
+ tixTList:CallCommand $w $ent
+ }
+ tixTList:GoState s0 $w
+}
+
+proc tixTList:GoState-s8 {w key} {
+ set anchor [$w info anchor]
+
+ if {$anchor == ""} {
+ set anchor 0
+ } else {
+ set anchor [$w info $key $anchor]
+ }
+
+ $w anchor set $anchor
+ $w see $anchor
+ tixTList:GoState s0 $w
+}
+
+proc tixTList:GoState-s9 {w} {
+ set anchor [$w info anchor]
+
+ if {$anchor == ""} {
+ set anchor 0
+ $w anchor set $anchor
+ $w see $anchor
+ }
+
+ if {[$w info anchor] != ""} {
+ # ! may not have any elements
+ #
+ tixTList:CallCommand $w [$w info anchor]
+ $w selection clear
+ $w selection set $anchor
+ }
+
+ tixTList:GoState s0 $w
+}
+
+proc tixTList:GoState-s10 {w} {
+ set anchor [$w info anchor]
+
+ if {$anchor == ""} {
+ set anchor 0
+ $w anchor set $anchor
+ $w see $anchor
+ }
+
+ if {[$w info anchor] != ""} {
+ # ! may not have any elements
+ #
+ tixTList:CallBrowseCmd $w [$w info anchor]
+ $w selection clear
+ $w selection set $anchor
+ }
+
+ tixTList:GoState s0 $w
+}
+
+#----------------------------------------------------------------------
+# BROWSE SELECTION
+#----------------------------------------------------------------------
+proc tixTList:GoState-b0 {w} {
+}
+
+proc tixTList:GoState-b1 {w x y} {
+ set ent [$w nearest $x $y]
+ if {$ent != ""} {
+ $w anchor set $ent
+ $w selection clear
+ $w selection set $ent
+ tixTList:CallBrowseCmd $w $ent
+ }
+ tixTList:GoState b2 $w
+}
+
+proc tixTList:GoState-b2 {w} {
+}
+
+proc tixTList:GoState-b3 {w} {
+ set ent [$w info anchor]
+ if {$ent != ""} {
+ $w selection clear
+ $w selection set $ent
+ tixTList:CallBrowseCmd $w $ent
+ }
+ tixTList:GoState b0 $w
+}
+
+proc tixTList:GoState-b4 {w x y} {
+ set ent [$w nearest $x $y]
+ if {$ent != ""} {
+ $w anchor set $ent
+ $w selection clear
+ $w selection set $ent
+ tixTList:CallBrowseCmd $w $ent
+ }
+}
+
+proc tixTList:GoState-b5 {w} {
+ tixTList:StartScan $w
+}
+
+proc tixTList:GoState-b6 {w} {
+ global tkPriv
+
+ tixTList:DoScan $w
+}
+
+proc tixTList:GoState-b7 {w x y} {
+ set ent [$w nearest $x $y]
+
+ if {$ent != ""} {
+ $w selection clear
+ $w selection set $ent
+ tixTList:CallCommand $w $ent
+ }
+ tixTList:GoState b0 $w
+}
+
+proc tixTList:GoState-b8 {w key} {
+ set anchor [$w info anchor]
+
+ if {$anchor == ""} {
+ set anchor 0
+ } else {
+ set anchor [$w info $key $anchor]
+ }
+
+ $w anchor set $anchor
+ $w selection clear
+ $w selection set $anchor
+ $w see $anchor
+
+ tixTList:CallBrowseCmd $w $anchor
+ tixTList:GoState b0 $w
+}
+
+proc tixTList:GoState-b9 {w} {
+ set anchor [$w info anchor]
+
+ if {$anchor == ""} {
+ set anchor 0
+ $w anchor set $anchor
+ $w see $anchor
+ }
+
+ if {[$w info anchor] != ""} {
+ # ! may not have any elements
+ #
+ tixTList:CallCommand $w [$w info anchor]
+ $w selection clear
+ $w selection set $anchor
+ }
+
+ tixTList:GoState b0 $w
+}
+
+proc tixTList:GoState-b10 {w} {
+ set anchor [$w info anchor]
+
+ if {$anchor == ""} {
+ set anchor 0
+ $w anchor set $anchor
+ $w see $anchor
+ }
+
+ if {[$w info anchor] != ""} {
+ # ! may not have any elements
+ #
+ tixTList:CallBrowseCmd $w [$w info anchor]
+ $w selection clear
+ $w selection set $anchor
+ }
+
+ tixTList:GoState b0 $w
+}
+
+#----------------------------------------------------------------------
+# MULTIPLE SELECTION
+#----------------------------------------------------------------------
+proc tixTList:GoState-m0 {w} {
+}
+
+proc tixTList:GoState-m1 {w x y} {
+ set ent [$w nearest $x $y]
+ if {$ent != ""} {
+ $w anchor set $ent
+ $w selection clear
+ $w selection set $ent
+ tixTList:CallBrowseCmd $w $ent
+ }
+ tixTList:GoState m2 $w
+}
+
+proc tixTList:GoState-m2 {w} {
+}
+
+proc tixTList:GoState-m3 {w} {
+ set ent [$w info anchor]
+ if {$ent != ""} {
+ tixTList:CallBrowseCmd $w $ent
+ }
+ tixTList:GoState m0 $w
+}
+
+proc tixTList:GoState-m4 {w x y} {
+ set from [$w info anchor]
+ set to [$w nearest $x $y]
+ if {$to != ""} {
+ $w selection clear
+ $w selection set $from $to
+ tixTList:CallBrowseCmd $w $to
+ }
+ tixTList:GoState m5 $w
+}
+
+proc tixTList:GoState-m5 {w} {
+}
+
+proc tixTList:GoState-m6 {w x y} {
+ set ent [$w nearest $x $y]
+ if {$ent != ""} {
+ tixTList:CallBrowseCmd $w $ent
+ }
+ tixTList:GoState m0 $w
+}
+
+proc tixTList:GoState-m7 {w x y} {
+ set from [$w info anchor]
+ set to [$w nearest $x $y]
+ if {$from == ""} {
+ set from $to
+ $w anchor set $from
+ }
+ if {$to != ""} {
+ $w selection clear
+ $w selection set $from $to
+ tixTList:CallBrowseCmd $w $to
+ }
+ tixTList:GoState m5 $w
+}
+
+
+proc tixTList:GoState-m8 {w} {
+ tixTList:StartScan $w
+}
+
+proc tixTList:GoState-m9 {w} {
+ tixTList:DoScan $w
+}
+
+proc tixTList:GoState-xm7 {w x y} {
+ set ent [$w nearest $x $y]
+
+ if {$ent != ""} {
+ $w selection clear
+ $w selection set $ent
+ tixTList:CallCommand $w $ent
+ }
+ tixTList:GoState m0 $w
+}
+
+#----------------------------------------------------------------------
+# EXTENDED SELECTION
+#----------------------------------------------------------------------
+proc tixTList:GoState-e0 {w} {
+}
+
+proc tixTList:GoState-e1 {w x y} {
+ set ent [$w nearest $x $y]
+ if {$ent != ""} {
+ $w anchor set $ent
+ $w selection clear
+ $w selection set $ent
+ tixTList:CallBrowseCmd $w $ent
+ }
+ tixTList:GoState e2 $w
+}
+
+proc tixTList:GoState-e2 {w} {
+}
+
+proc tixTList:GoState-e3 {w} {
+ set ent [$w info anchor]
+ if {$ent != ""} {
+ tixTList:CallBrowseCmd $w $ent
+ }
+ tixTList:GoState e0 $w
+}
+
+proc tixTList:GoState-e4 {w x y} {
+ set from [$w info anchor]
+ set to [$w nearest $x $y]
+ if {$to != ""} {
+ $w selection clear
+ $w selection set $from $to
+ tixTList:CallBrowseCmd $w $to
+ }
+ tixTList:GoState e5 $w
+}
+
+proc tixTList:GoState-e5 {w} {
+}
+
+proc tixTList:GoState-e6 {w x y} {
+ set ent [$w nearest $x $y]
+ if {$ent != ""} {
+ tixTList:CallBrowseCmd $w $ent
+ }
+ tixTList:GoState e0 $w
+}
+
+proc tixTList:GoState-e7 {w x y} {
+ set from [$w info anchor]
+ set to [$w nearest $x $y]
+ if {$from == ""} {
+ set from $to
+ $w anchor set $from
+ }
+ if {$to != ""} {
+ $w selection clear
+ $w selection set $from $to
+ tixTList:CallBrowseCmd $w $to
+ }
+ tixTList:GoState e5 $w
+}
+
+
+proc tixTList:GoState-e8 {w} {
+ tixTList:StartScan $w
+}
+
+proc tixTList:GoState-e9 {w} {
+ tixTList:DoScan $w
+}
+
+proc tixTList:GoState-e10 {w x y} {
+ set ent [$w nearest $x $y]
+ if {$ent != ""} {
+ if {[$w info anchor] == ""} {
+ $w anchor set $ent
+ }
+ if [$w selection includes $ent] {
+ $w selection clear $ent
+ } else {
+ $w selection set $ent
+ }
+ tixTList:CallBrowseCmd $w $ent
+ }
+ tixTList:GoState e2 $w
+}
+
+proc tixTList:GoState-xm7 {w x y} {
+ set ent [$w nearest $x $y]
+
+ if {$ent != ""} {
+ $w selection clear
+ $w selection set $ent
+ tixTList:CallCommand $w $ent
+ }
+ tixTList:GoState e0 $w
+}
+
+#----------------------------------------------------------------------
+# HODGE PODGE
+#----------------------------------------------------------------------
+
+proc tixTList:GoState-12 {w x y} {
+ tkCancelRepeat
+ tixTList:GoState 5 $w $x $y
+}
+
+proc tixTList:GoState-13 {w ent oldEnt} {
+ global tkPriv
+ set tkPriv(tix,indicator) $ent
+ set tkPriv(tix,oldEnt) $oldEnt
+ tixTList:IndicatorCmd $w <Arm> $ent
+}
+
+proc tixTList:GoState-14 {w x y} {
+ global tkPriv
+
+ if [tixTList:InsideArmedIndicator $w $x $y] {
+ $w anchor set $tkPriv(tix,indicator)
+ $w select clear
+ $w select set $tkPriv(tix,indicator)
+ tixTList:IndicatorCmd $w <Activate> $tkPriv(tix,indicator)
+ } else {
+ tixTList:IndicatorCmd $w <Disarm> $tkPriv(tix,indicator)
+ }
+
+ unset tkPriv(tix,indicator)
+ tixTList:GoState 0 $w
+}
+
+proc tixTList:GoState-16 {w ent} {
+ if {$ent == ""} {
+ return
+ }
+ if {[$w cget -selectmode] != "single"} {
+ tixTList:Select $w $ent
+ tixTList:Browse $w $ent
+ }
+}
+
+proc tixTList:GoState-18 {w} {
+ global tkPriv
+ tkCancelRepeat
+ tixTList:GoState 6 $w $tkPriv(x) $tkPriv(y)
+}
+
+proc tixTList:GoState-20 {w x y} {
+ global tkPriv
+
+ if {![tixTList:InsideArmedIndicator $w $x $y]} {
+ tixTList:GoState 21 $w $x $y
+ } else {
+ tixTList:IndicatorCmd $w <Arm> $tkPriv(tix,indicator)
+ }
+}
+
+proc tixTList:GoState-21 {w x y} {
+ global tkPriv
+
+ if {[tixTList:InsideArmedIndicator $w $x $y]} {
+ tixTList:GoState 20 $w $x $y
+ } else {
+ tixTList:IndicatorCmd $w <Disarm> $tkPriv(tix,indicator)
+ }
+}
+
+proc tixTList:GoState-22 {w} {
+ global tkPriv
+
+ if {$tkPriv(tix,oldEnt) != ""} {
+ $w anchor set $tkPriv(tix,oldEnt)
+ } else {
+ $w anchor clear
+ }
+ tixTList:GoState 0 $w
+}
+
+
+#----------------------------------------------------------------------
+# callback actions
+#----------------------------------------------------------------------
+proc tixTList:SetAnchor {w x y} {
+ set ent [$w nearest $x $y]
+ if {$ent != "" && [$w entrycget $ent -state] != "disabled"} {
+ $w anchor set $ent
+ $w see $ent
+ return $ent
+ }
+
+ return ""
+}
+
+proc tixTList:Select {w ent} {
+ $w selection clear
+ $w select set $ent
+}
+
+proc tixTList:StartScan {w} {
+ global tkPriv
+ set tkPriv(afterId) [after 50 tixTList:AutoScan $w]
+}
+
+proc tixTList:DoScan {w} {
+ global tkPriv
+ set x $tkPriv(x)
+ set y $tkPriv(y)
+ set X $tkPriv(X)
+ set Y $tkPriv(Y)
+
+ set out 0
+ if {$y >= [winfo height $w]} {
+ $w yview scroll 1 units
+ set out 1
+ }
+ if {$y < 0} {
+ $w yview scroll -1 units
+ set out 1
+ }
+ if {$x >= [winfo width $w]} {
+ $w xview scroll 2 units
+ set out 1
+ }
+ if {$x < 0} {
+ $w xview scroll -2 units
+ set out 1
+ }
+
+ if {$out} {
+ set tkPriv(afterId) [after 50 tixTList:AutoScan $w]
+ }
+}
+
+proc tixTList:CallBrowseCmd {w ent} {
+ set browsecmd [$w cget -browsecmd]
+ if {$browsecmd != ""} {
+ set bind(specs) {%V}
+ set bind(%V) $ent
+
+ tixEvalCmdBinding $w $browsecmd bind $ent
+ }
+}
+
+proc tixTList:CallCommand {w ent} {
+ set command [$w cget -command]
+ if {$command != ""} {
+ set bind(specs) {%V}
+ set bind(%V) $ent
+
+ tixEvalCmdBinding $w $command bind $ent
+ }
+}
diff --git a/tix/library/Tix.tcl b/tix/library/Tix.tcl
new file mode 100644
index 00000000000..762bfbf8f56
--- /dev/null
+++ b/tix/library/Tix.tcl
@@ -0,0 +1,506 @@
+# Tix.tcl --
+#
+# This file implements the Tix application context class
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+if 0 {
+proc tix {} {
+ # dummy proc. make sure the entry "tix" is in the tclIndex file
+ #
+}
+}
+
+tixClass tixAppContext {
+ -superclass {}
+ -classname TixAppContext
+ -method {
+ cget configure addbitmapdir filedialog getbitmap getimage
+ option platform resetoptions setbitmap
+ }
+ -flag {
+ -binding -debug -extracmdargs -filedialog -fontset -grabmode
+ -haspixmap -libdir -scheme -schemepriority -percentsubst
+ }
+ -readonly {
+ -haspixmap
+ }
+ -configspec {
+ {-binding TK}
+ {-debug false}
+ {-extracmdargs 1}
+ {-filedialog ""}
+ {-fontset TK}
+ {-grabmode global}
+ {-haspixmap 0}
+ {-libdir ""}
+ {-percentsubst 0}
+ {-scheme TK}
+ {-schemepriority 21}
+ }
+ -alias {
+ }
+}
+
+proc tixAppContext:Constructor {w} {
+ upvar #0 $w data
+ global tix_priv env argv0 tixPriv
+ global tix_library tixOption tcl_platform
+
+ if {[info exists tcl_platform] && $tcl_platform(platform) == "windows"} {
+ regsub -all "/" $tix_library \\ tix_library
+ }
+
+ if [info exists data(initialized)] {
+ error "tixAppContext has already be initialized"
+ } else {
+ set data(initialized) 1
+ }
+
+ if [tixStrEq $tix_library ""] {
+ set data(et) 1
+ } else {
+ set data(et) 0
+ }
+
+ set data(isStartUp) 1
+ # Thses options were set when tixwish started up
+ #
+ set data(-binding) $tix_priv(-binding)
+ set data(-debug) $tix_priv(-debug)
+ set data(-fontset) $tix_priv(-fontset)
+ set data(-scheme) $tix_priv(-scheme)
+ set data(-schemepriority) $tix_priv(-schemepriority)
+
+ if ![info exists tix_priv(isSafe)] {
+ set data(-libdir) [tixFSAbsPath $tix_library]
+ }
+ set tixOption(prioLevel) $tix_priv(-schemepriority)
+
+ # Enable/Disable Intrinsics debugging
+ #
+ if {$data(-debug)} {
+ set tix_priv(debug) 1
+ } else {
+ set tix_priv(debug) 0
+ }
+
+ if ![info exists tix_priv(isSafe)] {
+ tixAppContext:config-fontset $w $data(-fontset)
+ tixAppContext:config-scheme $w $data(-scheme)
+ }
+
+ tixAppContext:BitmapInit $w
+ tixAppContext:FileDialogInit $w
+
+ # Force the "." window to accept the new Tix options
+ #
+ foreach spec [. configure] {
+ if {[llength $spec] > 2} {
+ set flag [lindex $spec 0]
+ set name [lindex $spec 1]
+ set class [lindex $spec 2]
+ set value [option get . $name $class]
+ catch {. config $flag $value}
+ }
+ }
+ # Clean up any error message generated by the above loop
+ catch {uplevel #0 set errorInfo \"\"}
+
+ set data(isStartUp) 0
+
+ # Hack: if env(TIX_DEBUG_INTERACTIVE) is set, then
+ # an interactive prompt is always printed
+ #
+ if {[info exists env(TIX_DEBUG_INTERACTIVE)] &&
+ ![info exists tix_priv(slaveInterp)]} {
+
+ # For widget programming, it is more convient to have the error
+ # message printed on the terminal. For some extensive usage of
+ # bindings, suce as in the case of tixBalloon, the default
+ # therror just doesn't work.
+ #
+ proc tkerror {err} {
+ global errorInfo
+ puts $err
+ puts $errorInfo
+ }
+ }
+
+ #
+ # Hack
+ #
+ if [info exists env(TIX_DEBUG_GEOMETRY)] {
+ global tcl_interactive
+ if {$tcl_interactive == 0} {
+ wm geometry . $env(TIX_DEBUG_GEOMETRY)
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+# Configurations
+#
+#----------------------------------------------------------------------
+proc tixAppContext:resetoptions {w scheme fontset {schemePrio ""}} {
+ upvar #0 $w data
+
+ if {! $data(et)} {
+ global tixOption
+ option clear
+
+ if {$schemePrio != ""} {
+ set tixOption(prioLevel) $schemePrio
+ }
+ tixAppContext:config-scheme $w $scheme
+ tixAppContext:config-fontset $w $fontset
+ }
+}
+
+proc tixAppContext:config-fontset {w value} {
+ upvar #0 $w data
+ global tix_priv tixOption
+
+ set data(-fontset) $value
+
+ #-----------------------------------
+ # Initialization of options database
+ #-----------------------------------
+ # Load the fontset
+ #
+ if {!$data(et)} {
+ set prefDir [tixFileJoin $data(-libdir) pref]
+ set fontSetFile [tixFileJoin $prefDir $data(-fontset).fsc]
+ if [file exists $fontSetFile] {
+ source $fontSetFile
+ tixPref:InitFontSet:$data(-fontset)
+ tixAppContext:CheckFontSets $w
+ tixPref:SetFontSet:$data(-fontset)
+ } else {
+ tixAppContext:StartupError \
+ "\aError: cannot use fontset \"$data(-fontset)\""
+ tixAppContext:StartupError \
+ " Using default fontset "
+ tixSetDefaultFontset
+ tixAppContext:CheckFontSets $w
+ }
+ } else {
+ if [catch {
+ tixPref:InitFontSet:$data(-fontset)
+ tixAppContext:CheckFontSets $w
+ tixPref:SetFontSet:$data(-fontset)
+ }] {
+ # User chose non-existent fontset
+ #
+ tixAppContext:StartupError \
+ "\aError: cannot use fontset \"$data(-fontset)\""
+ tixAppContext:StartupError \
+ " Using default fontset "
+ tixSetDefaultFontset
+ tixAppContext:CheckFontSets $w
+ }
+ }
+
+ # Compatibility stuff: the obsolete name courier_font has been changed to
+ # fixed_font
+ set tixOption(courier_font) $tixOption(fixed_font)
+}
+
+proc tixAppContext:config-scheme {w value} {
+ upvar #0 $w data
+ global tix_priv
+
+ set data(-scheme) $value
+
+ # Load the color scheme
+ #
+ if {!$data(et)} {
+ set schemeName [tixFileJoin [tixFileJoin $data(-libdir) pref] \
+ $data(-scheme).csc]
+ if [file exists $schemeName] {
+ source $schemeName
+ if {[winfo depth .] >= 8} {
+ tixPref:SetScheme-Color:$data(-scheme)
+ } else {
+ tixPref:SetScheme-Mono:$data(-scheme)
+ }
+ } else {
+ tixAppContext:StartupError \
+ "\aError: cannot use color scheme \"$data(-scheme)\""
+ tixAppContext:StartupError \
+ " Using default color scheme"
+ if {[winfo depth .] >= 8} {
+ tixSetDefaultScheme-Color
+ } else {
+ tixSetDefaultScheme-Mono
+ }
+ }
+ } else {
+ if [catch {
+ if {[winfo depth .] >= 8} {
+ tixPref:SetScheme-Color:$data(-scheme)
+ } else {
+ tixPref:SetScheme-Mono:$data(-scheme)
+ }
+ }] {
+ # User chose non-existent color scheme
+ #
+ tixAppContext:StartupError \
+ "\aError: cannot use color scheme \"$data(-scheme)\""
+ tixAppContext:StartupError \
+ " Using default color scheme"
+ if {[winfo depth .] >= 8} {
+ tixSetDefaultScheme-Color
+ } else {
+ tixSetDefaultScheme-Mono
+ }
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+# Private methods
+#
+#----------------------------------------------------------------------
+proc tixAppContext:BitmapInit {w} {
+ upvar #0 $w data
+
+ # See whether we have pixmap extension
+ #
+ set data(-haspixmap) true
+
+ # Dynamically set the bitmap directory
+ #
+ if {! $data(et)} {
+ set data(bitmapdirs) [list [tixFileJoin $data(-libdir) bitmaps]]
+ } else {
+ set data(bitmapdirs) ""
+ }
+}
+
+proc tixAppContext:FileDialogInit {w} {
+ upvar #0 $w data
+
+ if {$data(-filedialog) == ""} {
+ set data(-filedialog) [option get . fileDialog FileDialog]
+ }
+ if {$data(-filedialog) == ""} {
+ set data(-filedialog) tixFileSelectDialog
+ }
+}
+
+#----------------------------------------------------------------------
+# If a font in the fontset is not available, use a default fontset.
+#
+proc tixAppContext:CheckFontSets {w} {
+ upvar #0 $w data
+ global tixOption tcl_version
+
+ if {$tcl_version >= "8.0"} {
+ # fonts will never fail ..
+ return
+ }
+
+ set default_font "fixed"
+ set options {font bold_font menu_font italic_font fixed_font}
+
+ if [winfo exists .tix-xxx-test] {
+ destroy .tix-xxx-test
+ }
+ set lab [label .tix-xxx-test]
+ foreach opt $options {
+ if [catch {$lab config -font $tixOption($opt)}] {
+ tixAppContext:StartupError \
+ "\aError: cannot use font \"$tixOption($opt)\" as \"$opt\""
+ puts stderr \
+ " using \"$default_font\" instead"
+
+ set tixOption($opt) $default_font
+ }
+ }
+ destroy $lab
+}
+
+#----------------------------------------------------------------------
+# Public methods
+#----------------------------------------------------------------------
+proc tixAppContext:addbitmapdir {w bmpdir} {
+ upvar #0 $w data
+
+ if {[lsearch $data(bitmapdirs) $bmpdir] == "-1"} {
+ lappend data(bitmapdirs) $bmpdir
+ }
+}
+
+proc tixAppContext:getimage {w name} {
+ upvar #0 $w data
+ global tixPriv tix_priv
+
+ if {[info exists data(img:$name)]} {
+ return $data(img:$name)
+ }
+
+ if ![info exists tix_priv(isSafe)] {
+ foreach dir $data(bitmapdirs) {
+ if [file exists [tixFileJoin $dir $name.xpm]] {
+ if {![catch {
+ set data(img:$name) \
+ [image create pixmap -file [tixFileJoin $dir $name.xpm]]
+ }]} {
+ break
+ }
+ }
+ if [file exists [tixFileJoin $dir $name.gif]] {
+ global TRANSPARENT_GIF_COLOR
+ if {![catch {
+ set data(img:$name) \
+ [image create photo -file [tixFileJoin $dir $name.gif]]
+ }]} {
+ break
+ }
+ }
+ if [file exists [tixFileJoin $dir $name.ppm]] {
+ if {![catch {
+ set data(img:$name) \
+ [image create photo -file [tixFileJoin $dir $name.ppm]]
+ }]} {
+ break
+ }
+ }
+ if [file exists [tixFileJoin $dir $name.xbm]] {
+ if {![catch {
+ set data(img:$name) \
+ [image create bitmap -file [tixFileJoin $dir $name.xbm]]
+ }]} {
+ break
+ }
+ }
+ if [file exists [tixFileJoin $dir $name]] {
+ if {![catch {
+ set data(img:$name) \
+ [image create bitmap -file [tixFileJoin $dir $name]]
+ }]} {
+ break
+ }
+ }
+ }
+ }
+
+ if {![info exists data(img:$name)]} {
+ catch {
+ # This is for compiled-in images
+ set data(img:$name) [image create pixmap -id $name]
+ } err
+ if [string match internal* $err] {
+ error $err
+ }
+ }
+
+ if {[info exists data(img:$name)]} {
+ return $data(img:$name)
+ } else {
+ error "image file \"$name\" cannot be found"
+ }
+}
+
+
+proc tixAppContext:getbitmap {w bitmapname} {
+ upvar #0 $w data
+ global tix_priv
+
+ if {[info exists data(bmp:$bitmapname)]} {
+ return $data(bmp:$bitmapname)
+ } else {
+ set ext [file extension $bitmapname]
+ if {$ext == ""} {
+ set ext .xbm
+ }
+
+ # This is the fallback value. If we can't find the bitmap in
+ # the bitmap directories, then use the name of the bitmap
+ # as the default value.
+ #
+ set data(bmp:$bitmapname) $bitmapname
+
+ if [info exists tix_priv(isSafe)] {
+ return $data(bmp:$bitmapname)
+ }
+
+ foreach dir $data(bitmapdirs) {
+ case $ext {
+ .xbm {
+ if [file exists [tixFileJoin $dir $bitmapname.xbm]] {
+ set data(bmp:$bitmapname) \
+ @[tixFileJoin $dir $bitmapname.xbm]
+ break
+ }
+ if [file exists [tixFileJoin $dir $bitmapname]] {
+ set data(bmp:$bitmapname) @[tixFileJoin $dir $bitmapname]
+ break
+ }
+ }
+ default {
+ if [file exists [tixFileJoin $dir $bitmapname]] {
+ set data(bmp:$bitmapname) @[tixFileJoin $dir $bitmapname]
+ break
+ }
+ }
+ }
+ }
+
+ return $data(bmp:$bitmapname)
+ }
+}
+
+proc tixAppContext:filedialog {w {type tixFileSelectDialog}} {
+ upvar #0 $w data
+
+ if {$type == ""} {
+ set type $data(-filedialog)
+ }
+ if {![info exists data(filedialog,$type)]} {
+ set data(filedialog,$type) ""
+ }
+
+ if {$data(filedialog,$type) == "" || ![winfo exists $data(filedialog,$type)]} {
+ set data(filedialog,$type) [$type .tixapp_filedialog_$type]
+ }
+
+ return $data(filedialog,$type)
+}
+
+proc tixAppContext:option {w action option {value ""}} {
+ upvar #0 $w data
+ global tixOption
+
+ if {$action == "get"} {
+ return $tixOption($option)
+ }
+}
+
+proc tixAppContext:platform {w} {
+ upvar #0 $w data
+ global tixPriv
+
+ if [info exists tixPriv(isWindows)] {
+ return windows
+ } else {
+ return unix
+ }
+}
+
+proc tixAppContext:StartupError {msg} {
+ catch {
+ puts stderr $msg
+ }
+}
+
+if [tixStrEq [info command toplevel] ""] {
+ proc toplevel {args} {
+ return eval frame $args
+ }
+}
diff --git a/tix/library/Tree.tcl b/tix/library/Tree.tcl
new file mode 100644
index 00000000000..04650dfb073
--- /dev/null
+++ b/tix/library/Tree.tcl
@@ -0,0 +1,190 @@
+# Tree.tcl --
+#
+# This file implements the TixTree widget.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+tixWidgetClass tixTree {
+ -classname TixTree
+ -superclass tixVTree
+ -method {
+ autosetmode close getmode open setmode
+ }
+ -flag {
+ -browsecmd -command -opencmd -closecmd
+ }
+ -configspec {
+ {-browsecmd browseCmd BrowseCmd ""}
+ {-command command Command ""}
+ {-closecmd closeCmd CloseCmd ""}
+ {-opencmd openCmd OpenCmd ""}
+ }
+ -default {
+ {.scrollbar auto}
+ {*Scrollbar.background #d9d9d9}
+ {*Scrollbar.relief sunken}
+ {*Scrollbar.takeFocus 0}
+ {*Scrollbar.troughColor #c3c3c3}
+ {*Scrollbar.width 15}
+ {*borderWidth 1}
+ {*hlist.background #c3c3c3}
+ {*hlist.drawBranch 1}
+ {*hlist.height 10}
+ {*hlist.highlightBackground #d9d9d9}
+ {*hlist.indicator 1}
+ {*hlist.indent 20}
+ {*hlist.itemType imagetext}
+ {*hlist.padX 3}
+ {*hlist.padY 0}
+ {*hlist.relief sunken}
+ {*hlist.takeFocus 1}
+ {*hlist.wideSelection 0}
+ {*hlist.width 20}
+ }
+}
+
+proc tixTree:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+}
+
+proc tixTree:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+}
+
+proc tixTree:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+}
+
+#----------------------------------------------------------------------
+#
+# Widget commands
+#
+#----------------------------------------------------------------------
+proc tixTree:autosetmode {w} {
+ tixTree:SetModes $w ""
+}
+
+proc tixTree:close {w ent} {
+ upvar #0 $w data
+
+ set type [tixVTree:GetType $w $ent]
+ if {$type == "close"} {
+ tixCallMethod $w Activate $ent $type
+ }
+}
+
+proc tixTree:open {w ent} {
+ upvar #0 $w data
+
+ set type [tixVTree:GetType $w $ent]
+ if {$type == "open"} {
+ tixCallMethod $w Activate $ent $type
+ }
+}
+
+proc tixTree:getmode {w ent} {
+ tixVTree:GetType $w $ent
+}
+
+proc tixTree:setmode {w ent mode} {
+ tixVTree:SetMode $w $ent $mode
+}
+#----------------------------------------------------------------------
+#
+# Private Methods
+#
+#----------------------------------------------------------------------
+proc tixTree:SetModes {w ent} {
+ upvar #0 $w data
+
+ set mode none
+
+ if {$ent == ""} {
+ set children [$data(w:hlist) info children]
+ } else {
+ set children [$data(w:hlist) info children $ent]
+ }
+
+ if {$children != ""} {
+ set mode close
+
+ foreach c $children {
+ if [$data(w:hlist) info hidden $c] {
+ set mode open
+ }
+ tixTree:SetModes $w $c
+ }
+ }
+
+ if {$ent != ""} {
+ tixVTree:SetMode $w $ent $mode
+ }
+}
+#----------------------------------------------------------------------
+#
+# Virtual Methods
+#
+#----------------------------------------------------------------------
+proc tixTree:OpenCmd {w ent} {
+ upvar #0 $w data
+
+ if {$data(-opencmd) != ""} {
+ tixTree:CallSwitchCmd $w $data(-opencmd) $ent
+ } else {
+ tixChainMethod $w OpenCmd $ent
+
+ }
+}
+
+proc tixTree:CloseCmd {w ent} {
+ upvar #0 $w data
+
+ if {$data(-closecmd) != ""} {
+ tixTree:CallSwitchCmd $w $data(-closecmd) $ent
+ } else {
+ tixChainMethod $w CloseCmd $ent
+ }
+}
+
+# Call the opencmd or closecmd, depending on the mode ($cmd argument)
+#
+proc tixTree:CallSwitchCmd {w cmd ent} {
+ upvar #0 $w data
+
+ set bind(specs) {%V}
+ set bind(%V) $ent
+
+ tixEvalCmdBinding $w $cmd bind $ent
+}
+
+proc tixTree:Command {w B} {
+ upvar #0 $w data
+ upvar $B bind
+
+ tixChainMethod $w Command $B
+
+ set ent [tixEvent flag V]
+ if {$data(-command) != ""} {
+ tixEvalCmdBinding $w $data(-command) bind $ent
+ }
+}
+
+proc tixTree:BrowseCmd {w B} {
+ upvar #0 $w data
+
+ set ent [tixEvent flag V]
+ if {$data(-browsecmd) != ""} {
+ tixEvalCmdBinding $w $data(-browsecmd) "" $ent
+ }
+}
diff --git a/tix/library/UnixFile.tcl b/tix/library/UnixFile.tcl
new file mode 100644
index 00000000000..a2d577df6af
--- /dev/null
+++ b/tix/library/UnixFile.tcl
@@ -0,0 +1,407 @@
+# UnixFile.tcl --
+#
+# Unix file access portibility routines.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc tixInitFileCmpt:Unix {} {
+
+# tixFSSplit --
+#
+# Splits a directory into its hierarchical components
+#
+# "hlist-type hierachical path" <- "vpath"
+# "name"
+# "directory name" <- "path"
+#
+proc tixFSSplit {dir} {
+ if [string compare [tixFSPathType $dir] "absolute"] {
+ error "$dir must be an absolute path"
+ }
+
+ set path ""
+ set p ""
+ foreach d [tixFileSplit $dir] {
+ set p [tixFSJoin $p $d]
+ lappend path [list $p $d $p]
+ }
+ return $path
+}
+
+# returns true if $dir is an valid path (always true in Unix)
+#
+proc tixFSValid {dir} {
+ return 1
+}
+
+# Directory separator
+#
+proc tixFSSep {} {
+ return "/"
+}
+
+# tixFSIntName
+#
+# Returns the "virtual path" of a filename
+#
+proc tixFSIntName {dir} {
+ if [string compare [tixFSPathType $dir] "absolute"] {
+ error "$dir must be an absolute path"
+ }
+
+ return $dir
+}
+
+proc tixFSResolveName {p} {
+ return $p
+}
+
+
+# These subcommands of "file" only exist in Tcl 7.5+. We define the following
+# wrappers so that the code also works under Tcl 7.4
+#
+global tcl_version
+if ![string compare $tcl_version 7.4] {
+
+ proc tixFSPathType {dir} {
+ if ![string compare [string index $dir 0] /] {
+ return "absolute"
+ }
+ if ![string compare [string index $dir 0] ~] {
+ return "absolute"
+ }
+ return "relative"
+ }
+
+ proc tixFSJoin {dir sub} {
+ set joined $dir/$sub
+
+ regsub -all {[/]+} $joined / joined
+ return $joined
+ }
+
+} else {
+ proc tixFSPathType {dir} {
+ return [file pathtype $dir]
+ }
+
+ proc tixFSJoin {dir sub} {
+ return [file join $dir $sub]
+ }
+}
+
+# dir: Make a listing of this directory
+# showSubDir: Want to list the subdirectories?
+# showFile: Want to list the non-directory files in this directory?
+# showPrevDir: Want to list ".." as well?
+# showHidden: Want to list the hidden files?
+#
+# return value: a list of files and/or subdirectories
+#
+proc tixFSListDir {dir showSubDir showFile showPrevDir showHidden {pattern ""}} {
+ set appPWD [pwd]
+
+ if [catch {cd $dir} err] {
+ # The user has entered an invalid directory
+ # %% todo: prompt error, go back to last succeed directory
+ cd $appPWD
+ return ""
+ }
+
+ if {$pattern == ""} {
+ if $showHidden {
+ set pattern "* .*"
+ } else {
+ set pattern *
+ }
+ } elseif {$pattern == "*"} {
+ if $showHidden {
+ set pattern "* .*"
+ }
+ }
+
+ set list ""
+ foreach pat $pattern {
+ if [catch {set names [lsort [glob -nocomplain $pat]]} err] {
+ # Cannot read directory
+ # %% todo: show directory permission denied
+ continue
+ }
+
+ catch {
+ # We are catch'ing, just in case the "file" command
+ # returns unexpected errors
+ #
+ foreach fname $names {
+ if {![string compare . $fname]} {
+ continue
+ }
+ if [file isdirectory $fname] {
+ if {![string compare ".." $fname] && !$showPrevDir} {
+ continue
+ }
+ if $showSubDir {
+ lappend list [file tail $fname]
+ }
+ } else {
+ if $showFile {
+ lappend list [file tail $fname]
+ }
+ }
+ }
+ }
+ }
+
+ cd $appPWD
+
+ if {[llength $pattern] > 1} {
+ # get rid of duplicated names
+ #
+ set list1 ""
+ set oldfile ""
+ foreach name [lsort $list] {
+ if {$name == $oldfile} {
+ continue
+ }
+ lappend list1 $name
+ set oldfile $name
+ }
+ return [_tixFSMakeList $dir $list1]
+ } else {
+ return [_tixFSMakeList $dir $list]
+ }
+}
+
+# _tixFSMakeList -
+#
+# Internal procedure. Used only by tixFSListDir
+proc _tixFSMakeList {dir list} {
+ set l ""
+ foreach file $list {
+ set path [tixFSJoin $dir $file]
+ lappend l [list $path $file $path]
+ }
+
+ return $l
+}
+
+# Directory separator
+#
+proc tixDirSep {} {
+ return "/"
+}
+
+
+# tixFSInfo --
+#
+# Returns information about the file system of this OS
+#
+# hasdrives: Boolean
+# Does this file system support seperate disk drives?
+#
+proc tixFSInfo {args} {
+ case [lindex $args 0] {
+ hasdrives {
+ return 0
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+# Obsolete
+#----------------------------------------------------------------------
+
+# nativeName: native filename used in this OS, comes from the user or
+# application programmer
+# defParent: if the filename is not an absolute path, treat it as a
+# subfolder of $defParent
+proc tixFileIntName {nativeName {defParent ""}} {
+ if {![tixIsAbsPath $nativeName]} {
+ if {$defParent != ""} {
+ set path [tixSubFolder $defParent $nativeName]
+ } else {
+ set path $nativeName
+ }
+ } else {
+ set path $nativeName
+ }
+
+ set intName ""
+ set path [tixFile trimslash [tixFile tildesubst $path]]
+ foreach name [tixFileSplit $path] {
+ set intName [tixSubFolder $intName $name]
+ }
+ return $intName
+}
+
+proc tixNativeName {name {mustBeAbs ""}} {
+ return $name
+}
+
+proc tixFileDisplayName {intName} {
+ if {$intName == "/"} {
+ return "/"
+ } else {
+ return [file tail $intName]
+ }
+}
+
+
+proc tixFileSplit {intName} {
+
+ set l ""
+ foreach n [split $intName /] {
+ if {$n == ""} {
+ continue
+ }
+ if {$n == "."} {
+ continue
+ }
+
+ lappend l $n
+ }
+
+
+ while 1 {
+ set idx [lsearch $l ".."]
+ if {$idx == -1} {
+ break;
+ }
+ set l [lreplace $l [expr $idx -1] $idx]
+ }
+
+
+ if {[string index $intName 0] == "/"} {
+ return [concat "/" $l]
+ } else {
+ return $l
+ }
+}
+
+proc tixSubFolder {parent sub} {
+ if {$parent == ""} {
+ return $sub
+ }
+ if {$parent == "/"} {
+ return /$sub
+ } else {
+ return $parent/$sub
+ }
+}
+
+# dir: Make a listing of this directory
+# showSubDir: Want to list the subdirectories?
+# showFile: Want to list the non-directory files in this directory?
+# showPrevDir: Want to list ".." as well?
+# showHidden: Want to list the hidden files?
+#
+# return value: a list of files and/or subdirectories
+#
+proc tixListDir {dir showSubDir showFile showPrevDir showHidden {pattern ""}} {
+
+ set appPWD [pwd]
+
+ if [catch {cd $dir} err] {
+ # The user has entered an invalid directory
+ # %% todo: prompt error, go back to last succeed directory
+ cd $appPWD
+ return ""
+ }
+
+ if {$pattern == ""} {
+ if $showHidden {
+ set pattern "* .*"
+ } else {
+ set pattern *
+ }
+ } elseif {$pattern == "*"} {
+ if $showHidden {
+ set pattern "* .*"
+ }
+ }
+
+ set list ""
+ foreach pat $pattern {
+ if [catch {set names [lsort [glob -nocomplain $pat]]} err] {
+ # Cannot read directory
+ # %% todo: show directory permission denied
+ continue
+ }
+
+ catch {
+ # We are catch'ing, just in case the "file" command
+ # returns unexpected errors
+ #
+ foreach fname $names {
+ if {![string compare . $fname]} {
+ continue
+ }
+ if [file isdirectory $fname] {
+ if {![string compare ".." $fname] && !$showPrevDir} {
+ continue
+ }
+ if $showSubDir {
+ lappend list [file tail $fname]
+ }
+ } else {
+ if $showFile {
+ lappend list [file tail $fname]
+ }
+ }
+ }
+ }
+ }
+
+ cd $appPWD
+
+ if {[llength $pattern] > 1} {
+ set list1 ""
+ set oldfile ""
+ foreach name [lsort $list] {
+ if {$name == $oldfile} {
+ continue
+ }
+ lappend list1 $name
+ set oldfile $name
+ }
+ return $list1
+ } else {
+ return $list
+ }
+}
+
+# returns the "root directory" of this operating system
+#
+proc tixRootDir {} {
+ return "/"
+}
+
+proc tixIsAbsPath {nativeName} {
+ set c [string index $nativeName 0]
+ if {$c == "~" || $c == "/"} {
+ return 1
+ } else {
+ return 0
+ }
+}
+
+proc tixVerifyFile {file} {
+ return [tixFileIntName $file]
+}
+
+proc tixFilePattern {args} {
+ if {[lsearch $args allFiles] != -1} {
+ return *
+ }
+ return *
+}
+}
+
+
+
+
+
diff --git a/tix/library/Utils.tcl b/tix/library/Utils.tcl
new file mode 100644
index 00000000000..5ba27cdcf6b
--- /dev/null
+++ b/tix/library/Utils.tcl
@@ -0,0 +1,498 @@
+# Util.tcl --
+#
+# The Tix utility commands. Some of these commands are
+# replacement of or extensions to the existing TK
+# commands. Occasionaly, you have to use the commands inside
+# this file instead of thestandard TK commands to make your
+# applicatiion work better with Tix. Please read the
+# documentations (programmer's guide, man pages) for information
+# about these utility commands.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+#
+# kludge: should be able to handle all kinds of flags
+# now only handles "-flag value" pairs.
+#
+proc tixHandleArgv {p_argv p_options validFlags} {
+ upvar $p_options opt
+ upvar $p_argv argv
+
+ set old_argv $argv
+ set argv ""
+
+ tixForEach {flag value} $old_argv {
+ if {[lsearch $validFlags $flag] != "-1"} {
+ # The caller will handle this option exclusively
+ # It won't be added back to the original arglist
+ #
+ eval $opt($flag,action) $value
+ } else {
+ # The caller does not handle this option
+ #
+ lappend argv $flag
+ lappend argv $value
+ }
+ }
+}
+
+#-----------------------------------------------------------------------
+# tixDisableAll -
+#
+# Disable all members in a sub widget tree
+#
+proc tixDisableAll {w} {
+ foreach x [tixDescendants $w] {
+ catch {$x config -state disabled}
+ }
+}
+
+#----------------------------------------------------------------------
+# tixEnableAll -
+#
+# enable all members in a sub widget tree
+#
+proc tixEnableAll {w} {
+ foreach x [tixDescendants $w] {
+ catch {$x config -state normal}
+ }
+}
+
+#----------------------------------------------------------------------
+# tixDescendants -
+#
+# Return a list of all the member of a widget subtree, including
+# the tree's root widget.
+#
+proc tixDescendants {parent} {
+ set des ""
+ lappend des $parent
+
+ foreach w [winfo children $parent] {
+ foreach x [tixDescendants $w] {
+ lappend des $x
+ }
+ }
+ return $des
+}
+
+
+#----------------------------------------------------------------------
+# tixForEach -
+#
+# Extension of foreach, can handle more than one names
+#
+#
+proc tixForEach {names list body} {
+ set len [llength $list]
+ set i 0
+
+ while {$i < $len} {
+ foreach name $names {
+ uplevel 1 [list set $name [lindex $list $i]]
+ incr i
+ }
+
+ if {$i > $len} {
+ error "incorrect number of items in the list \{$list\}"
+ }
+
+ uplevel 1 $body
+ }
+}
+
+#----------------------------------------------------------------------
+# tixTopLevel -
+#
+# Create a toplevel widget and unmap it immediately. This will ensure
+# that this toplevel widgets will not be popped up prematurely when you
+# create Tix widgets inside it.
+#
+# "tixTopLevel" also provide options for you to specify the appearance
+# and behavior of this toplevel.
+#
+#
+#
+proc tixTopLevel {w args} {
+ set opt (-geometry) ""
+ set opt (-minsize) ""
+ set opt (-maxsize) ""
+ set opt (-width) ""
+ set opt (-height) ""
+
+ eval toplevel $w $args
+ wm withdraw $w
+}
+
+# This is a big kludge
+#
+# Substitutes all [...] and $.. in the string in $args
+#
+proc tixInt_Expand {args} {
+ return $args
+}
+
+# Print out all the config options of a widget
+#
+proc tixPConfig {w} {
+ foreach opt [lsort [$w config]] {
+ puts $opt
+ }
+}
+
+proc tixAppendBindTag {w tag} {
+ bindtags $w [concat [bindtags $w] $tag]
+}
+
+proc tixAddBindTag {w tag} {
+ bindtags $w [concat $tag [bindtags $w] ]
+}
+
+proc tixSubwidgetRef {sub} {
+ global tixSRef
+
+ return $tixSRef($sub)
+}
+
+proc tixSubwidgetRetCreate {sub ref} {
+ global tixSRef
+
+ set tixSRef($sub) $ref
+}
+
+proc tixSubwidgetRetDelete {sub} {
+ global tixSRef
+
+ catch {unset tixSRef($sub)}
+}
+
+proc tixListboxGetCurrent {listbox} {
+ return [tixEvent flag V]
+}
+
+
+# tixSetMegaWidget --
+#
+# Associate a subwidget with its mega widget "owner". This is mainly
+# used when we add a new bindtag to a subwidget and we need to find out
+# the name of the mega widget inside the binding.
+#
+proc tixSetMegaWidget {w mega {type any}} {
+ global tixMega
+
+ set tixMega($type,$w) $mega
+}
+
+proc tixGetMegaWidget {w {type any}} {
+ global tixMega
+
+ return $tixMega($type,$w)
+}
+
+proc tixUnsetMegaWidget {w} {
+ global tixMega
+
+ if [info exists tixMega($w)] {
+ unset tixMega($w)
+ }
+}
+
+# tixBusy : display busy cursors on a window
+#
+#
+# Should flush the event queue (but not do any idle tasks) before blocking
+# the target window (I am not sure if it is aready doing so )
+#
+# ToDo: should take some additional windows to raise
+#
+proc tixBusy {w flag {focuswin ""}} {
+
+ if {[info command tixInputOnly] == ""} {
+ return
+ }
+
+ global tixBusy
+ set toplevel [winfo toplevel $w]
+
+ if {![info exists tixBusy(cursor)]} {
+ set tixBusy(cursor) watch
+# set tixBusy(cursor) "[tix getbitmap hourglass] \
+# [string range [tix getbitmap hourglass.mask] 1 end]\
+# black white"
+ }
+
+ if {$toplevel == "."} {
+ set inputonly0 .__tix__busy0
+ set inputonly1 .__tix__busy1
+ set inputonly2 .__tix__busy2
+ set inputonly3 .__tix__busy3
+ } else {
+ set inputonly0 $toplevel.__tix__busy0
+ set inputonly1 $toplevel.__tix__busy1
+ set inputonly2 $toplevel.__tix__busy2
+ set inputonly3 $toplevel.__tix__busy3
+ }
+
+ if {![winfo exists $inputonly0]} {
+ for {set i 0} {$i < 4} {incr i} {
+ tixInputOnly [set inputonly$i] -cursor $tixBusy(cursor)
+ }
+ }
+
+ case $flag {
+ on {
+ if {$focuswin != "" && [winfo id $focuswin] != 0} {
+ if [info exists tixBusy($focuswin,oldcursor)] {
+ return
+ }
+ set tixBusy($focuswin,oldcursor) [$focuswin cget -cursor]
+ $focuswin config -cursor $tixBusy(cursor)
+
+ set x1 [expr [winfo rootx $focuswin]-[winfo rootx $toplevel]]
+ set y1 [expr [winfo rooty $focuswin]-[winfo rooty $toplevel]]
+
+ set W [winfo width $focuswin]
+ set H [winfo height $focuswin]
+ set x2 [expr $x1 + $W]
+ set y2 [expr $y1 + $H]
+
+
+ if {$y1 > 0} {
+ tixMoveResizeWindow $inputonly0 0 0 10000 $y1
+ }
+ if {$x1 > 0} {
+ tixMoveResizeWindow $inputonly1 0 0 $x1 10000
+ }
+ tixMoveResizeWindow $inputonly2 0 $y2 10000 10000
+ tixMoveResizeWindow $inputonly3 $x2 0 10000 10000
+
+ for {set i 0} {$i < 4} {incr i} {
+ tixMapWindow [set inputonly$i]
+ tixRaiseWindow [set inputonly$i]
+ }
+ tixFlushX $w
+ } else {
+ tixMoveResizeWindow $inputonly0 0 0 10000 10000
+ tixMapWindow $inputonly0
+ tixRaiseWindow $inputonly0
+ }
+ }
+ off {
+ tixUnmapWindow $inputonly0
+ tixUnmapWindow $inputonly1
+ tixUnmapWindow $inputonly2
+ tixUnmapWindow $inputonly3
+
+ if {$focuswin != "" && [winfo id $focuswin] != 0} {
+ if [info exists tixBusy($focuswin,oldcursor)] {
+ $focuswin config -cursor $tixBusy($focuswin,oldcursor)
+ if [info exists tixBusy($focuswin,oldcursor)] {
+ unset tixBusy($focuswin,oldcursor)
+ }
+ }
+ }
+ }
+ }
+
+}
+
+proc tixOptionName {w} {
+ return [string range $w 1 [expr [string length $w]-1]]
+}
+
+proc tixSetSilent {chooser value} {
+ $chooser config -disablecallback true
+ $chooser config -value $value
+ $chooser config -disablecallback false
+}
+
+proc tixSetChooser {chooser value} {
+
+ puts "obsolete command tixSetChooser, call tixSetSilent instead"
+
+ $chooser config -disablecallback true
+ $chooser config -value $value
+ $chooser config -disablecallback false
+}
+
+# This command is useful if you want to ingore the arguments
+# passed by the -command or -browsecmd options of the Tix widgets. E.g
+#
+# tixFileSelectDialog .c -command "puts foo; tixBreak"
+#
+#
+proc tixBreak {args} {}
+
+#----------------------------------------------------------------------
+# tixDestroy -- deletes a Tix class object (not widget classes)
+#----------------------------------------------------------------------
+proc tixDestroy {w} {
+ upvar #0 $w data
+
+ set destructor ""
+ if [info exists data(className)] {
+ catch {
+ set destructor [tixGetMethod $w $data(className) Destructor]
+ }
+ }
+ if {$destructor != ""} {
+ $destructor $w
+ }
+ catch {
+ rename $w ""
+ }
+ catch {
+ unset data
+ }
+ return ""
+}
+
+proc tixPushGrab {args} {
+ global tix_priv
+
+ if {![info exists tix_priv(grab-list)]} {
+ set tix_priv(grab-list) ""
+ set tix_priv(grab-mode) ""
+ set tix_priv(grab-nopush) ""
+ }
+
+ case [llength $args] {
+ 1 {
+ set opt ""
+ set w [lindex $args 0]
+ }
+ 2 {
+ set opt [lindex $args 0]
+ set w [lindex $args 1]
+ }
+ default {
+ error "wrong #of arguments: tixPushGrab ?-global? window"
+ }
+ }
+
+ # Not everyone will call tixPushGrab. If someone else has a grab already
+ # save that one as well, so that we can restore that later
+ #
+ set last [lindex $tix_priv(grab-list) end]
+ set current [grab current $w]
+
+ if {$current != "" && $current != $last} {
+ # Someone called "grab" directly
+ #
+ lappend tix_priv(grab-list) $current
+ lappend tix_priv(grab-mode) [grab status $current]
+ lappend tix_priv(grab-nopush) 1
+ }
+
+ # Now push myself into the stack
+ #
+ lappend tix_priv(grab-list) $w
+ lappend tix_priv(grab-mode) $opt
+ lappend tix_priv(grab-nopush) 0
+
+ if {$opt == "-global"} {
+ grab -global $w
+ } else {
+ grab $w
+ }
+}
+
+proc tixPopGrab {} {
+ global tix_priv
+
+ if {![info exists tix_priv(grab-list)]} {
+ set tix_priv(grab-list) ""
+ set tix_priv(grab-mode) ""
+ set tix_priv(grab-nopush) ""
+ }
+
+ set len [llength $tix_priv(grab-list)]
+ if {$len <= 0} {
+ error "no window is grabbed by tixGrab"
+ }
+
+ set w [lindex $tix_priv(grab-list) end]
+ grab release $w
+
+ if {$len > 1} {
+ set tix_priv(grab-list) \
+ [lrange $tix_priv(grab-list) 0 [expr $len-2]]
+ set tix_priv(grab-mode) \
+ [lrange $tix_priv(grab-mode) 0 [expr $len-2]]
+ set tix_priv(grab-nopush) \
+ [lrange $tix_priv(grab-nopush) 0 [expr $len-2]]
+
+ set w [lindex $tix_priv(grab-list) end]
+ set m [lindex $tix_priv(grab-list) end]
+ set np [lindex $tix_priv(grab-nopush) end]
+
+ if {$np == 1} {
+ # We have a grab set by "grab"
+ #
+ set len [llength $tix_priv(grab-list)]
+
+ if {$len > 1} {
+ set tix_priv(grab-list) \
+ [lrange $tix_priv(grab-list) 0 [expr $len-2]]
+ set tix_priv(grab-mode) \
+ [lrange $tix_priv(grab-mode) 0 [expr $len-2]]
+ set tix_priv(grab-nopush) \
+ [lrange $tix_priv(grab-nopush) 0 [expr $len-2]]
+ } else {
+ set tix_priv(grab-list) ""
+ set tix_priv(grab-mode) ""
+ set tix_priv(grab-nopush) ""
+ }
+ }
+
+ if {$m == "-global"} {
+ grab -global $w
+ } else {
+ grab $w
+ }
+ } else {
+ set tix_priv(grab-list) ""
+ set tix_priv(grab-mode) ""
+ set tix_priv(grab-nopush) ""
+ }
+}
+
+proc tixWithinWindow {wid rootX rootY} {
+ set rx1 [winfo rootx $wid]
+ set ry1 [winfo rooty $wid]
+ set rw [winfo width $wid]
+ set rh [winfo height $wid]
+ set rx2 [expr $rx1+$rw]
+ set ry2 [expr $ry1+$rh]
+
+ if {$rootX >= $rx1 && $rootX < $rx2 && $rootY >= $ry1 && $rootY < $ry2} {
+ return 1
+ } else {
+ return 0
+ }
+}
+
+proc tixWinWidth {w} {
+ set W [winfo width $w]
+ set bd [expr [$w cget -bd] + [$w cget -highlightthickness]]
+
+ return [expr $W - 2*$bd]
+}
+
+proc tixWinHeight {w} {
+ set H [winfo height $w]
+ set bd [expr [$w cget -bd] + [$w cget -highlightthickness]]
+
+ return [expr $H - 2*$bd]
+}
+
+# junk?
+#
+proc tixWinCmd {w} {
+ return [winfo command $w]
+}
diff --git a/tix/library/VResize.tcl b/tix/library/VResize.tcl
new file mode 100644
index 00000000000..a21f7f094a8
--- /dev/null
+++ b/tix/library/VResize.tcl
@@ -0,0 +1,205 @@
+# VResize.tcl --
+#
+# tixVResize:
+# Virtual base class for all classes that provide resize capability,
+# such as the resize handle and the MDI client window.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixVResize {
+ -virtual true
+ -classname TixVResize
+ -superclass tixPrimitive
+ -method {
+ drag dragend dragstart
+ }
+ -flag {
+ -gridded -gridx -gridy -minwidth -minheight
+ }
+ -configspec {
+ {-gridded gridded Gridded false}
+ {-gridx gridX Grid 10}
+ {-gridy gridY Grid 10}
+ {-minwidth minWidth MinWidth 0}
+ {-minheight minHeight MinHeight 0}
+ }
+}
+
+
+proc tixVResize:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+
+ set data(movePending) 0
+ set data(aborted) 0
+ set data(depress) 0
+}
+
+#----------------------------------------------------------------------
+# Public methods
+#----------------------------------------------------------------------
+# Start dragging a window
+#
+proc tixVResize:dragstart {w win depress rootx rooty wrect mrect} {
+ upvar #0 $w data
+
+ set data(rootx) $rootx
+ set data(rooty) $rooty
+
+ set data(mx) [lindex $mrect 0]
+ set data(my) [lindex $mrect 1]
+ set data(mw) [lindex $mrect 2]
+ set data(mh) [lindex $mrect 3]
+
+ set data(fx) [lindex $wrect 0]
+ set data(fy) [lindex $wrect 1]
+ set data(fw) [lindex $wrect 2]
+ set data(fh) [lindex $wrect 3]
+
+ set data(old_x) [lindex $wrect 0]
+ set data(old_y) [lindex $wrect 1]
+ set data(old_w) [lindex $wrect 2]
+ set data(old_h) [lindex $wrect 3]
+
+ if {$data(mw) < 0} {
+ set data(maxx) [expr "$data(fx) + $data(old_w) - $data(-minwidth)"]
+ } else {
+ set data(maxx) 32000
+ }
+ if {$data(mh) < 0} {
+ set data(maxy) [expr "$data(fy) + $data(old_h) - $data(-minheight)"]
+ } else {
+ set data(maxy) 32000
+ }
+
+ set data(aborted) 0
+
+ tixCallMethod $w ShowHintFrame
+ tixCallMethod $w SetHintFrame $data(fx) $data(fy) $data(fw) $data(fh)
+
+ # Grab so that all button events are captured
+ #
+ grab $win
+ focus $win
+
+ set data(depress) $depress
+ if {$depress} {
+ set data(oldRelief) [$win cget -relief]
+ $win config -relief sunken
+ }
+}
+
+
+proc tixVResize:drag {w rootx rooty} {
+ upvar #0 $w data
+
+ if {$data(aborted) == 0} {
+ set data(newrootx) $rootx
+ set data(newrooty) $rooty
+
+ if {$data(movePending) == 0} {
+ set data(movePending) 1
+ after 2 tixVResize:DragCompressed $w
+ }
+ }
+}
+
+proc tixVResize:dragend {w win isAbort rootx rooty} {
+ upvar #0 $w data
+
+ if {$data(aborted)} {
+ if {$isAbort == 0} {
+ grab release $win
+ }
+ return
+ }
+
+ # Just in case some draggings are not applied.
+ #
+ update
+
+ tixCallMethod $w HideHintFrame
+
+ if {$isAbort} {
+ set data(aborted) 1
+ } else {
+ # Apply the changes
+ #
+ tixCallMethod $w UpdateSize $data(fx) $data(fy) $data(fw) $data(fh)
+
+ # Release the grab
+ #
+ grab release $win
+ }
+
+ if {$data(depress)} {
+ $win config -relief $data(oldRelief)
+ }
+}
+
+#----------------------------------------------------------------------
+# Internal methods
+#----------------------------------------------------------------------
+
+proc tixVResize:DragCompressed {w} {
+ if {![winfo exists $w]} {
+ return
+ }
+
+ upvar #0 $w data
+
+ if {$data(aborted) == 1 || $data(movePending) == 0} {
+ return
+ }
+
+ set dx [expr "$data(newrootx) - $data(rootx)"]
+ set dy [expr "$data(newrooty) - $data(rooty)"]
+
+ set data(fx) [expr "$data(old_x) + ($dx * $data(mx))"]
+ set data(fy) [expr "$data(old_y) + ($dy * $data(my))"]
+ set data(fw) [expr "$data(old_w) + ($dx * $data(mw))"]
+ set data(fh) [expr "$data(old_h) + ($dy * $data(mh))"]
+
+ if {$data(fw) < $data(-minwidth)} {
+ set data(fw) $data(-minwidth)
+ }
+ if {$data(fh) < $data(-minheight)} {
+ set data(fh) $data(-minheight)
+ }
+
+ if {$data(fx) > $data(maxx)} {
+ set data(fx) $data(maxx)
+ }
+ if {$data(fy) > $data(maxy)} {
+ set data(fy) $data(maxy)
+ }
+
+ # If we need grid, set x,y,w,h to fit the grid
+ #
+ # *note* grid overrides minwidth and maxwidth ...
+ #
+ if {$data(-gridded)} {
+ set data(fx) [expr "round($data(fx).0/$data(-gridx)) * $data(-gridx)"]
+ set data(fy) [expr "round($data(fy).0/$data(-gridy)) * $data(-gridy)"]
+
+ set fx2 [expr $data(fx) + $data(fw) - 2]
+ set fy2 [expr $data(fy) + $data(fh) - 2]
+
+ set fx2 [expr "round($fx2.0/$data(-gridx)) * $data(-gridx)"]
+ set fy2 [expr "round($fy2.0/$data(-gridy)) * $data(-gridy)"]
+
+ set data(fw) [expr $fx2 - $data(fx) + 1]
+ set data(fh) [expr $fy2 - $data(fy) + 1]
+ }
+
+ tixCallMethod $w SetHintFrame $data(fx) $data(fy) $data(fw) $data(fh)
+
+ update idletasks
+
+ set data(movePending) 0
+}
diff --git a/tix/library/VStack.tcl b/tix/library/VStack.tcl
new file mode 100644
index 00000000000..8685a74786f
--- /dev/null
+++ b/tix/library/VStack.tcl
@@ -0,0 +1,426 @@
+# VStack.tcl --
+#
+# Virtual base class, do not instantiate! This is the core
+# class for all NoteBook style widgets. Stack maintains a list
+# of windows. It provides methods to create, delete windows as
+# well as stepping through them.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+#
+
+
+tixWidgetClass tixVStack {
+ -virtual true
+ -classname TixVStack
+ -superclass tixPrimitive
+ -method {
+ add delete pageconfigure pagecget pages raise raised
+ }
+ -flag {
+ -dynamicgeometry -ipadx -ipady
+ }
+ -configspec {
+ {-dynamicgeometry dynamicGeometry DynamicGeometry 0 tixVerifyBoolean}
+ {-ipadx ipadX Pad 0}
+ {-ipady ipadY Pad 0}
+ }
+}
+
+proc tixVStack:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+
+ set data(pad-x1) 0
+ set data(pad-x2) 0
+ set data(pad-y1) 0
+ set data(pad-y2) 0
+
+ set data(windows) ""
+ set data(nWindows) 0
+ set data(topchild) ""
+
+ set data(minW) 1
+ set data(minH) 1
+
+ set data(w:top) $w
+ set data(counter) 0
+ set data(repack) 0
+}
+
+proc tixVStack:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+ tixCallMethod $w InitGeometryManager
+}
+
+#----------------------------------------------------------------------
+# Public methods
+#----------------------------------------------------------------------
+proc tixVStack:add {w child args} {
+ upvar #0 $w data
+
+ set validOptions {-createcmd -raisecmd}
+
+ set opt(-createcmd) ""
+ set opt(-raisecmd) ""
+
+ tixHandleOptions -nounknown opt $validOptions $args
+
+ set data($child,raisecmd) $opt(-raisecmd)
+ set data($child,createcmd) $opt(-createcmd)
+
+ set data(w:$child) [tixCallMethod $w CreateChildFrame $child]
+
+ lappend data(windows) $child
+ incr data(nWindows) 1
+
+ return $data(w:$child)
+}
+
+proc tixVStack:delete {w child} {
+ upvar #0 $w data
+
+ if [info exists data($child,createcmd)] {
+ if [winfo exists $data(w:$child)] {
+ bind $data(w:$child) <Destroy> {;}
+ destroy $data(w:$child)
+ }
+ catch {unset data($child,createcmd)}
+ catch {unset data($child,raisecmd)}
+ catch {unset data(w:$child)}
+
+ set index [lsearch $data(windows) $child]
+ if {$index >= 0} {
+ set data(windows) [lreplace $data(windows) $index $index]
+ incr data(nWindows) -1
+ }
+
+ if ![string comp $data(topchild) $child] {
+ set data(topchild) ""
+ foreach page $data(windows) {
+ if [string comp $page $child] {
+ $w raise $page
+ set data(topchild) $page
+ break
+ }
+ }
+ }
+ } else {
+ error "page $child does not exist"
+ }
+}
+
+proc tixVStack:pagecget {w child option} {
+ upvar #0 $w data
+
+ if {![info exists data($child,createcmd)]} {
+ error "page \"$child\" does not exist in $w"
+ }
+
+ case $option {
+ -createcmd {
+ return "$data($child,createcmd)"
+ }
+ -raisecmd {
+ return "$data($child,raisecmd)"
+ }
+ default {
+ if {$data(w:top) != $w} {
+ return [$data(w:top) pagecget $child $option]
+ } else {
+ error "unknown option \"$option\""
+ }
+ }
+ }
+}
+
+proc tixVStack:pageconfigure {w child args} {
+ upvar #0 $w data
+
+ if {![info exists data($child,createcmd)]} {
+ error "page \"$child\" does not exist in $w"
+ }
+
+ set len [llength $args]
+
+ if {$len == 0} {
+ set value [$data(w:top) pageconfigure $child]
+ lappend value [list -createcmd "" "" "" $data($child,createcmd)]
+ lappend value [list -raisecmd "" "" "" $data($child,raisecmd)]
+ return $value
+ }
+
+ if {$len == 1} {
+ case [lindex $args 0] {
+ -createcmd {
+ return [list -createcmd "" "" "" $data($child,createcmd)]
+ }
+ -raisecmd {
+ return [list -raisecmd "" "" "" $data($child,raisecmd)]
+ }
+ default {
+ return [$data(w:top) pageconfigure $child [lindex $args 0]]
+ }
+ }
+ }
+
+ # By default handle each of the options
+ #
+ set opt(-createcmd) $data($child,createcmd)
+ set opt(-raisecmd) $data($child,raisecmd)
+
+ tixHandleOptions -nounknown opt {-createcmd -raisecmd} $args
+
+ #
+ # the widget options
+ set new_args ""
+ tixForEach {flag value} $args {
+ if {$flag != "-createcmd" && $flag != "-raisecmd"} {
+ lappend new_args $flag
+ lappend new_args $value
+ }
+ }
+
+ if {[llength $new_args] >= 2} {
+ eval $data(w:top) pageconfig $child $new_args
+ }
+
+ #
+ # The add-on options
+ set data($child,raisecmd) $opt(-raisecmd)
+ set data($child,createcmd) $opt(-createcmd)
+
+ return ""
+}
+
+proc tixVStack:pages {w} {
+ upvar #0 $w data
+
+ return $data(windows)
+}
+
+proc tixVStack:raise {w child} {
+ upvar #0 $w data
+
+ if {![info exists data($child,createcmd)]} {
+ error "page $child does not exist"
+ }
+
+ if {[info exists data($child,createcmd)] && $data($child,createcmd) !=""} {
+ uplevel #0 $data($child,createcmd)
+ set data($child,createcmd) ""
+ }
+
+ tixCallMethod $w RaiseChildFrame $child
+
+ set oldTopChild $data(topchild)
+ set data(topchild) $child
+
+ if [string comp $oldTopChild $child] {
+ if [string comp $child,raisecmd ""] {
+ uplevel #0 $data($child,raisecmd)
+ }
+ }
+}
+
+proc tixVStack:raised {w} {
+ upvar #0 $w data
+
+ return $data(topchild)
+}
+
+#----------------------------------------------------------------------
+# Virtual Methods
+#----------------------------------------------------------------------
+proc tixVStack:InitGeometryManager {w} {
+ upvar #0 $w data
+
+ bind $w <Configure> "tixVStack:MasterGeomProc $w"
+ bind $data(w:top) <Destroy> "+tixVStack:DestroyTop $w"
+
+ if {$data(repack) == 0} {
+ set data(repack) 1
+ tixWidgetDoWhenIdle tixCallMethod $w Resize
+ }
+}
+
+proc tixVStack:CreateChildFrame {w child} {
+ upvar #0 $w data
+
+ set f [frame $data(w:top).$child]
+
+ tixManageGeometry $f "tixVStack:ClientGeomProc $w"
+ bind $f <Configure> "tixVStack:ClientGeomProc $w -configure $f"
+ bind $f <Destroy> "$w delete $child"
+
+ return $f
+}
+
+proc tixVStack:RaiseChildFrame {w child} {
+ upvar #0 $w data
+
+ # Hide the original visible window
+ if {[string comp $data(topchild) ""] &&
+ [string comp $data(topchild) $child]} {
+ tixUnmapWindow $data(w:$data(topchild))
+ }
+
+ set myW [winfo width $w]
+ set myH [winfo height $w]
+
+ set cW [expr $myW - $data(pad-x1) - $data(pad-x2) - 2*$data(-ipadx)]
+ set cH [expr $myH - $data(pad-y1) - $data(pad-y2) - 2*$data(-ipady)]
+ set cX [expr $data(pad-x1) + $data(-ipadx)]
+ set cY [expr $data(pad-y1) + $data(-ipady)]
+
+ if {$cW > 0 && $cH > 0} {
+ tixMoveResizeWindow $data(w:$child) $cX $cY $cW $cH
+ tixMapWindow $data(w:$child)
+ raise $data(w:$child)
+ }
+}
+
+
+
+#----------------------------------------------------------------------
+#
+# G E O M E T R Y M A N A G E M E N T
+#
+#----------------------------------------------------------------------
+proc tixVStack:DestroyTop {w} {
+ catch {
+ destroy $w
+ }
+}
+
+proc tixVStack:MasterGeomProc {w args} {
+ if {![winfo exists $w]} {
+ return
+ }
+
+ upvar #0 $w data
+
+ if {$data(repack) == 0} {
+ set data(repack) 1
+ tixWidgetDoWhenIdle tixCallMethod $w Resize
+ }
+}
+
+proc tixVStack:ClientGeomProc {w flag client} {
+ if {![winfo exists $w]} {
+ return
+ }
+ upvar #0 $w data
+
+ if {$data(repack) == 0} {
+ set data(repack) 1
+ tixWidgetDoWhenIdle tixCallMethod $w Resize
+ }
+
+ if {$flag == "-lostslave"} {
+ error "Geometry Management Error: \
+Another geometry manager has taken control of $client.\
+This error is usually caused because a widget has been created\
+in the wrong frame: it should have been created inside $client instead\
+of $w"
+ }
+}
+
+proc tixVStack:Resize {w} {
+ if {![winfo exists $w]} {
+ return
+ }
+
+ upvar #0 $w data
+
+ if {$data(nWindows) == 0} {
+ set data(repack) 0
+ return
+ }
+
+ if {$data(-width) == 0 || $data(-height) == 0} {
+ if {!$data(-dynamicgeometry)} {
+ # Calculate my required width and height
+ #
+ set maxW 1
+ set maxH 1
+
+ foreach child $data(windows) {
+ set cW [winfo reqwidth $data(w:$child)]
+ set cH [winfo reqheight $data(w:$child)]
+
+ if {$maxW < $cW} {
+ set maxW $cW
+ }
+ if {$maxH < $cH} {
+ set maxH $cH
+ }
+ }
+ set reqW $maxW
+ set reqH $maxH
+ } else {
+ if [string comp $data(topchild) ""] {
+ set reqW [winfo reqwidth $data(w:$data(topchild))]
+ set reqH [winfo reqheight $data(w:$data(topchild))]
+ } else {
+ set reqW 1
+ set reqH 1
+ }
+ }
+
+ incr reqW [expr $data(pad-x1) + $data(pad-x2) + 2*$data(-ipadx)]
+ incr reqH [expr $data(pad-y1) + $data(pad-y2) + 2*$data(-ipady)]
+
+ if {$reqW < $data(minW)} {
+ set reqW $data(minW)
+ }
+ if {$reqH < $data(minH)} {
+ set reqH $data(minH)
+ }
+ }
+ # These take higher precedence
+ #
+ if {$data(-width) != 0} {
+ set reqW $data(-width)
+ }
+ if {$data(-height) != 0} {
+ set reqH $data(-height)
+ }
+
+ if {[winfo reqwidth $w] != $reqW || [winfo reqheight $w] != $reqH} {
+ if {![info exists data(counter)]} {
+ set data(counter) 0
+ }
+ if {$data(counter) < 50} {
+ incr data(counter)
+ tixGeometryRequest $w $reqW $reqH
+ tixWidgetDoWhenIdle tixCallMethod $w Resize
+ set data(repack) 1
+ return
+ }
+ }
+ set data(counter) 0
+
+ if [string comp $data(w:top) $w] {
+ tixMoveResizeWindow $data(w:top) 0 0 [winfo width $w] [winfo height $w]
+ tixMapWindow $data(w:top)
+ }
+
+ if ![string comp $data(topchild) ""] {
+ set top [lindex $data(windows) 0]
+ } else {
+ set top $data(topchild)
+ }
+
+ if [string comp $top ""] {
+ tixCallMethod $w raise $top
+ }
+
+ set data(repack) 0
+}
diff --git a/tix/library/VTree.tcl b/tix/library/VTree.tcl
new file mode 100644
index 00000000000..71f346bfc20
--- /dev/null
+++ b/tix/library/VTree.tcl
@@ -0,0 +1,205 @@
+# VTree.tcl --
+#
+# Virtual base class for Tree widgets.
+#
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+tixWidgetClass tixVTree {
+ -virtual true
+ -classname TixVTree
+ -superclass tixScrolledHList
+ -method {
+ }
+ -flag {
+ -ignoreinvoke
+ }
+ -configspec {
+ {-ignoreinvoke ignoreInvoke IgnoreInvoke false tixVerifyBoolean}
+ }
+ -default {
+ }
+}
+
+proc tixVTree:InitWidgetRec {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w InitWidgetRec
+}
+
+proc tixVTree:ConstructWidget {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w ConstructWidget
+
+ set data(indStyle) [tixDisplayStyle image -refwindow $data(w:hlist) \
+ -padx 0 -pady 0]
+}
+
+proc tixVTree:SetBindings {w} {
+ upvar #0 $w data
+
+ tixChainMethod $w SetBindings
+
+ $data(w:hlist) config \
+ -indicatorcmd "tixVTree:IndicatorCmd $w" \
+ -browsecmd "tixVTree:BrowseCmdHook $w"\
+ -command "tixVTree:CommandHook $w"
+}
+
+proc tixVTree:IndicatorCmd {w args} {
+ upvar #0 $w data
+
+ uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
+ set event [tixEvent type]
+ set ent [tixEvent flag V]
+
+ set type [tixVTree:GetType $w $ent]
+ set plus [tix getimage plus]
+ set plusarm [tix getimage plusarm]
+ set minus [tix getimage minus]
+ set minusarm [tix getimage minusarm]
+
+ case $event {
+ <Arm> {
+ if {$type == "open"} {
+ $data(w:hlist) indicator config $ent -image $plusarm
+ } else {
+ $data(w:hlist) indicator config $ent -image $minusarm
+ }
+ }
+ <Disarm> {
+ if {$type == "open"} {
+ $data(w:hlist) indicator config $ent -image $plus
+ } else {
+ $data(w:hlist) indicator config $ent -image $minus
+ }
+ }
+ <Activate> {
+ upvar bind bind
+ tixCallMethod $w Activate $ent $type
+ set bind(%V) $ent
+ tixVTree:BrowseCmdHook $w
+ }
+ }
+}
+
+proc tixVTree:GetType {w ent} {
+ upvar #0 $w data
+
+ uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
+ if ![$data(w:hlist) indicator exists $ent] {
+ return none
+ }
+
+ set img [$data(w:hlist) indicator cget $ent -image]
+
+ if {$img == [tix getimage plus]} {
+ return open
+ }
+ if {$img == [tix getimage plusarm]} {
+ return open
+ }
+ return close
+}
+
+proc tixVTree:Activate {w ent type} {
+ upvar #0 $w data
+
+ uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
+
+ set plus [tix getimage plus]
+ set minus [tix getimage minus]
+
+ if {$type == "open"} {
+ tixCallMethod $w OpenCmd $ent
+ $data(w:hlist) indicator config $ent -image $minus
+ } else {
+ tixCallMethod $w CloseCmd $ent
+ $data(w:hlist) indicator config $ent -image $plus
+ }
+}
+
+proc tixVTree:CommandHook {w args} {
+ upvar #0 $w data
+ upvar bind bind
+
+ tixCallMethod $w Command bind
+}
+
+proc tixVTree:BrowseCmdHook {w args} {
+ upvar #0 $w data
+ upvar bind bind
+
+ tixCallMethod $w BrowseCmd bind
+}
+
+proc tixVTree:SetMode {w ent mode} {
+ upvar #0 $w data
+
+ uplevel #0 set TRANSPARENT_GIF_COLOR [$data(w:hlist) cget -bg]
+
+ case $mode {
+ open {
+ $data(w:hlist) indicator create $ent -itemtype image \
+ -image [tix getimage plus] -style $data(indStyle)
+ }
+ close {
+ $data(w:hlist) indicator create $ent -itemtype image \
+ -image [tix getimage minus] -style $data(indStyle)
+ }
+ none {
+ if [$data(w:hlist) indicator exist $ent] {
+ $data(w:hlist) indicator delete $ent
+ }
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+#
+# Virtual Methods
+#
+#----------------------------------------------------------------------
+proc tixVTree:OpenCmd {w ent} {
+ upvar #0 $w data
+
+ # The default action
+ foreach kid [$data(w:hlist) info children $ent] {
+ $data(w:hlist) show entry $kid
+ }
+}
+
+proc tixVTree:CloseCmd {w ent} {
+ upvar #0 $w data
+
+ # The default action
+ foreach kid [$data(w:hlist) info children $ent] {
+ $data(w:hlist) hide entry $kid
+ }
+}
+
+proc tixVTree:Command {w B} {
+ upvar #0 $w data
+ upvar $B bind
+
+ if {$data(-ignoreinvoke)} {
+ return
+ }
+ set ent [tixEvent flag V]
+ if [$data(w:hlist) indicator exist $ent] {
+ tixVTree:Activate $w $ent [tixVTree:GetType $w $ent]
+ }
+}
+
+proc tixVTree:BrowseCmd {w B} {
+}
+#----------------------------------------------------------------------
+#
+# Widget commands
+#
+#----------------------------------------------------------------------
diff --git a/tix/library/Variable.tcl b/tix/library/Variable.tcl
new file mode 100644
index 00000000000..c37472bcfeb
--- /dev/null
+++ b/tix/library/Variable.tcl
@@ -0,0 +1,96 @@
+# Variable.tcl --
+#
+# Routines in this file are used to set up and operate variables
+# for classes that support the -variable option
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+
+
+# tixVariable:ConfigVariable --
+#
+# Set up the -variable option for the object $w
+#
+# Side effects:
+#
+# data(-variable) is changed to the name of the global variable
+# if the global variable exists, data(-value) takes the value of this
+# variable.
+# if the global variable does not exist, it is created with the
+# current data(-value)
+#
+# Return value:
+#
+# true is data(-value) is changed, indicating that data(-command)
+# should be invoked.
+#
+proc tixVariable:ConfigVariable {w arg} {
+ upvar #0 $w data
+
+ set changed 0
+
+ if {$data(-variable) != ""} {
+ uplevel #0 \
+ [list trace vdelete $data(-variable) w "tixVariable:TraceProc $w"]
+ }
+
+ if {$arg != ""} {
+ if [uplevel #0 info exists [list $arg]] {
+ # This global variable exists, we use its value
+ #
+ set data(-value) [uplevel #0 set [list $arg]]
+ set changed 1
+ } else {
+ # This global variable does not exist; let's set it
+ #
+ uplevel #0 [list set $arg $data(-value)]
+ }
+ uplevel #0 \
+ [list trace variable $arg w "tixVariable:TraceProc $w"]
+ }
+
+ return $changed
+}
+
+proc tixVariable:UpdateVariable {w} {
+ upvar #0 $w data
+
+ if {$data(-variable) != ""} {
+ uplevel #0 \
+ [list trace vdelete $data(-variable) w "tixVariable:TraceProc $w"]
+ uplevel #0 \
+ [list set $data(-variable) $data(-value)]
+ uplevel #0 \
+ [list trace variable $data(-variable) w "tixVariable:TraceProc $w"]
+
+ # just in case someone has another trace and restricted my change
+ #
+ set data(-value) [uplevel #0 set [list $data(-variable)]]
+ }
+}
+
+proc tixVariable:TraceProc {w name1 name2 op} {
+ upvar #0 $w data
+ set varname $data(-variable)
+
+ if [catch {$w config -value [uplevel #0 [list set $varname]]} err] {
+ uplevel #0 [list set $varname [list [$w cget -value]]]
+ error $err
+ }
+ return
+}
+
+proc tixVariable:DeleteVariable {w} {
+ upvar #0 $w data
+
+ # Must delete the trace command of the -variable
+ #
+ if {$data(-variable) != ""} {
+ uplevel #0 \
+ [list trace vdelete $data(-variable) w "tixVariable:TraceProc $w"]
+ }
+}
diff --git a/tix/library/Verify.tcl b/tix/library/Verify.tcl
new file mode 100644
index 00000000000..559dc22fc51
--- /dev/null
+++ b/tix/library/Verify.tcl
@@ -0,0 +1,21 @@
+# Verify.tcl --
+#
+# Config option verification routines.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc tixVerifyBoolean {val} {
+ return [tixGetBoolean $val]
+}
+
+proc tixVerifyDirectory {val} {
+ if ![file isdir $val] {
+ error "\"$val\" is not a directory"
+ }
+ return $val
+}
+
diff --git a/tix/library/Version.tcl b/tix/library/Version.tcl
new file mode 100644
index 00000000000..ac8a61cc0ef
--- /dev/null
+++ b/tix/library/Version.tcl
@@ -0,0 +1,17 @@
+# Version.tcl --
+#
+# This file is automatically generated by the Tix version control tool
+#
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc tixScriptVersion {} {
+ return 4.1
+}
+proc tixScriptPatchLevel {} {
+ return 4.1.0
+}
diff --git a/tix/library/WInfo.tcl b/tix/library/WInfo.tcl
new file mode 100644
index 00000000000..976aaec719a
--- /dev/null
+++ b/tix/library/WInfo.tcl
@@ -0,0 +1,35 @@
+# WInfo.tcl --
+#
+# This file implements the command tixWInfo, which return various
+# information about a Tix widget.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc tixWInfo {option w} {
+ upvar #0 $w data
+
+ case $option {
+ tix {
+ # Is this a Tix widget?
+ #
+ return [info exists data(className)]
+ }
+ compound {
+ # Is this a compound widget?
+ # Currently this is the same as "tixWinfo tix" because only
+ # Tix compilant compound widgets are supported
+ return [info exists data(className)]
+ }
+ class {
+ if {[info exists data(className)]} {
+ return $data(className)
+ } else {
+ return ""
+ }
+ }
+ }
+}
diff --git a/tix/library/WinFile.tcl b/tix/library/WinFile.tcl
new file mode 100644
index 00000000000..06bfde24381
--- /dev/null
+++ b/tix/library/WinFile.tcl
@@ -0,0 +1,648 @@
+# WinFile.tcl --
+#
+# MS Window file access portibility routines.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc tixInitFileCmpt:Win {} {
+ global tixPriv tcl_platform
+
+ if {$tcl_platform(osVersion) >= 4.0} {
+ set tixPriv(isWin95) 1
+ } else {
+ set tixPriv(isWin95) 0
+ }
+ if $tixPriv(isWin95) {
+ set tixPriv(WinPrefix) xx\\xx
+ } else {
+ set tixPriv(WinPrefix) xx
+ }
+
+#----------------------------------------------------------------------
+#
+# MS Windows
+#
+#----------------------------------------------------------------------
+
+# splits a Windows directory into its hierarchical components
+#
+proc tixFSSplit {vpath} {
+ global tixPriv
+
+ set path ""
+ if $tixPriv(isWin95) {
+ if ![string compare $vpath xx] {
+ lappend path [list xx "Desktop" "C:\\Windows\\Desktop" ]
+ return $path
+ }
+ if ![string compare $vpath xx\\xx] {
+ lappend path [list xx "Desktop" "C:\\Windows\\Desktop" ]
+ lappend path [list xx\\xx "My Computer" "C:\\"]
+ return $path
+ }
+
+ set prefix "xx\\xx"
+ if ![regsub {^xx\\xx\\} $vpath "" dir] {
+ if [regsub {^xx\\} $vpath "" dir] {
+ lappend path [list xx "Desktop" "C:\\Windows\\Desktop" ]
+ set v "xx"
+ set p "C:\\Windows\\Desktop"
+ foreach d [split $dir \\] {
+ append v \\$d
+ append p \\$d
+ lappend path [list $v $d $p]
+ }
+ return $path
+ }
+ }
+ regsub {:$} $dir :/ dir
+ lappend path [list xx "Desktop" "C:\\Windows\\Desktop" ]
+ lappend path [list xx\\xx "My Computer" "C:\\"]
+ } else {
+ if ![string compare $vpath xx] {
+ lappend path [list xx "My Computer" "C:\\"]
+ return $path
+ }
+ lappend path [list xx "My Computer" "C:\\"]
+
+ set prefix xx
+ regsub {^xx\\} $vpath "" dir
+ regsub {:$} $dir :/ dir
+ }
+
+ if ![string compare $dir ""] {
+ return $path
+ }
+ if [string compare [file pathtype $dir] "absolute"] {
+ error "$dir must be an absolute path"
+ }
+
+ set dirs [file split $dir]
+ set p ""
+ foreach d $dirs {
+ set p [file join $p $d]
+ regsub -all / $p \\ p
+ set vpath $prefix\\$p
+ regsub {[\\]$} $vpath "" vpath
+ regsub {:/$} $d ":" d
+ lappend path [list $vpath $d $p]
+ }
+
+ return $path
+}
+
+# returns true if $dir is an valid path (not equal to "")
+#
+proc tixFSValid {dir} {
+ return [expr ![string compare $dir ""]]
+}
+
+# tixFSIntName
+#
+# Returns the "virtual path" of a filename
+#
+proc tixFSIntName {dir} {
+ global tixPriv
+
+ if ![string compare $dir ""] {
+ if $tixPriv(isWin95) {
+ return "xx\\xx"
+ } else {
+ return xx
+ }
+ }
+
+ if [string compare [file pathtype $dir] "absolute"] {
+ error "$dir must be an absolute path"
+ }
+
+ if $tixPriv(isWin95) {
+ set vpath "xx\\xx\\$dir"
+ } else {
+ set vpath "xx\\$dir"
+ }
+ regsub {:/$} $vpath ":" vpath
+ regsub {[\\]$} $vpath "" vpath
+ return $vpath
+}
+
+proc tixFSIntJoin {dir sub} {
+ set vpath $dir\\$sub
+ regsub -all {\\\\} $vpath \\ vpath
+ regsub {:/$} $vpath : vpath
+ regsub {[\\]$} $vpath "" vpath
+ return $vpath
+}
+
+proc tixFSJoin {dir sub} {
+ set p [file join $dir $sub]
+ regsub -all / $p \\ p
+ return $p
+}
+
+proc tixFSResolveName {p} {
+ regsub -all / $p \\ p
+ if [regexp {:([^\\]|$)} $p] {
+ regsub : $p :\\ p
+ }
+ return $p
+}
+
+# dir: Make a listing of this directory
+# showSubDir: Want to list the subdirectories?
+# showFile: Want to list the non-directory files in this directory?
+# showPrevDir: Want to list ".." as well?
+# showHidden: Want to list the hidden files? (%% is ignored)
+#
+# return value: a list of files and/or subdirectories
+#
+proc tixFSListDir {vpath showSubDir showFile showPrevDir showHidden {pattern ""}} {
+ global tixPriv
+ set appPWD [pwd]
+ set list ""
+
+ if $tixPriv(isWin95) {
+ if ![string compare $vpath xx] {
+ set dir C:\\Windows\\Desktop
+ if {$showSubDir} {
+ lappend list xx:
+ }
+ } elseif ![string compare $vpath xx\\xx] {
+ if {$showSubDir} {
+ return [tixFSGetDrives]
+ } else {
+ return ""
+ }
+ } else {
+ if ![regsub {^xx\\xx\\} $vpath "" dir] {
+ regsub {^xx\\} $vpath C:\\Windows\\Desktop\\ dir
+ }
+ regsub {:$} $dir :\\ dir
+ }
+ } else {
+ if ![string compare $vpath xx] {
+ if {$showSubDir} {
+ return [tixFSGetDrives]
+ } else {
+ return ""
+ }
+ }
+
+ regsub {^xx\\} $vpath "" dir
+ regsub {:$} $dir :\\ dir
+ }
+
+ if [catch {cd $dir} err] {
+ # The user has entered an invalid directory
+ # %% todo: prompt error, go back to last succeed directory
+ cd $appPWD
+ return ""
+ }
+
+ if {$pattern == ""} {
+ set pattern "*"
+ }
+
+ if [catch {set names [lsort [eval glob -nocomplain $pattern]]} err] {
+ # Cannot read directory
+ # %% todo: show directory permission denied
+ cd $appPWD
+ return ""
+ }
+
+ catch {
+ # We are catch'ing, just in case the "file" command returns unexpected
+ # errors
+ #
+ foreach fname $names {
+ if {![string compare . $fname]} {
+ continue
+ }
+ if {![string compare ".." $fname]} {
+ continue
+ }
+ if [file isdirectory $fname] {
+ if $showSubDir {
+ lappend list [file tail $fname]
+ }
+ } else {
+ if $showFile {
+ lappend list [file tail $fname]
+ }
+ }
+ }
+ }
+ cd $appPWD
+
+ if {$showSubDir && $showPrevDir && $dir != "/"} {
+ return [tixFSMakeList $vpath $dir [lsort [concat .. $list]]]
+ } else {
+ return [tixFSMakeList $vpath $dir $list]
+ }
+}
+
+proc tixFSMakeList {vpath dir list} {
+ global tixPriv
+
+ if $tixPriv(isWin95) {
+ set prefix xx\\xx
+ } else {
+ set prefix xx
+ }
+ set l ""
+ foreach file $list {
+ if ![string compare $file xx:] {
+ lappend l [list xx\\xx "My Computer" "C:\\"]
+ } else {
+ set path [tixFSJoin $dir $file]
+ lappend l [list $vpath\\$file $file $path]
+ }
+ }
+
+ return $l
+}
+
+proc tixFSSep {} {
+ return "\\"
+}
+
+proc tixFSGetDrives {} {
+ global tixPriv
+
+ if [info exists tixPriv(drives)] {
+ return $tixPriv(drives)
+ } else {
+ set drives [list A: B:]
+ foreach d {c d e f g h i j k l m n o p q r s t u v w x y z} {
+ if [file exists $d:\\] {
+ lappend drives [string toupper $d:]
+ }
+ }
+
+ set tixPriv(drives) ""
+ foreach d $drives {
+ lappend tixPriv(drives) [list $tixPriv(WinPrefix)\\$d $d $d\\]
+ }
+ }
+ return $tixPriv(drives)
+}
+
+#----------------------------------------------------------------------
+#
+# OBSOLETE
+#
+#----------------------------------------------------------------------
+
+
+
+# Directory separator
+#
+proc tixDirSep {} {
+ return "\\"
+}
+
+# returns the "root directory" of this operating system
+#
+# out: intName
+proc tixRootDir {} {
+ return "/"
+}
+
+# is an absoulte path only if it starts with a baclskash
+# or starts with "<drive letter>:"
+#
+# in: nativeName
+#
+proc tixIsAbsPath {nativeName} {
+ set c [string index $nativeName 0]
+ if {$c == "\\"} {
+ return 1
+ }
+
+ if {[string compare [string toupper $c] A] < 0} {
+ return 0
+ }
+ if {[string compare [string toupper $c] Z] > 0} {
+ return 0
+ }
+ if {[string index $nativeName 1] != ":"} {
+ return 0
+ }
+ return 1
+}
+
+# returns <drive>:
+#
+proc tixWinGetFileDrive {nativeName} {
+ set c [string index $nativeName 0]
+ if {$c == "\\"} {
+ return [string toupper [string range [pwd] 0 1]]
+ }
+
+ if {[string compare [string toupper $c] A] < 0} {
+ return [string toupper [string range [pwd] 0 1]]
+ }
+ if {[string compare [string toupper $c] Z] > 0} {
+ return [string toupper [string range [pwd] 0 1]]
+ }
+ if {[string index $nativeName 1] != ":"} {
+ return [string toupper [string range [pwd] 0 1]]
+ }
+ return [string toupper [string range $nativeName 0 1]]
+}
+
+# returns the absolute pathname of the file
+# (not including the drive letter or the first backslash)
+#
+# [tixWinGetFileDrive]\\[tixWinGetFilePath] gives the complete
+# drive and pathname
+#
+proc tixWinGetFilePath {nativeName} {
+ set c [string index $nativeName 0]
+ if {$c == "\\"} {
+ return ""
+ }
+
+ if {[string compare [string toupper $c] A] < 0} {
+ return [tixWinGetPathFromDrive $nativeName]
+ }
+ if {[string compare [string toupper $c] Z] > 0} {
+ return [tixWinGetPathFromDrive $nativeName]
+ }
+ if {[string index $nativeName 1] != ":"} {
+ return [tixWinGetPathFromDrive $nativeName]
+ }
+ if {[string index $nativeName 2] != "\\"} {
+ regexp {[A-z]:} $nativeName drive
+ regsub {[A-z]:} $nativeName "" path
+ return [tixWinGetPathFromDrive $path $drive]
+ }
+
+ regsub {[A-z]:[\\]} $nativeName "" path
+ return $path
+}
+
+proc tixWinCurrentDrive {} {
+ return [string range [pwd] 0 1]
+}
+
+proc tixWinGetPathFromDrive {path {drive ""}} {
+ if {$drive == ""} {
+ set drive [tixWinCurrentDrive]
+ }
+
+ #
+ # %% currently TCL (7.5b3) does not tell what the current path
+ # on a particular drive is
+
+ return $path
+}
+
+#
+#
+# nativeName: native filename used in this OS, comes from the user or
+# application programmer
+# defParent: (intName) if the filename is not an absolute path,
+# treat it as a subfolder of $defParent
+# (must be an intName, must be absolute)
+proc tixFileIntName {nativeName {defParent ""}} {
+ if {![tixIsAbsPath $nativeName]} {
+ if {$defParent != ""} {
+ if {[string index $defParent 0] != "/"} {
+ error "Tix toolkit error: \"$defParent\" is not an absolute internal file name"
+ }
+ set path [tixSubFolder $defParent $nativeName]
+ } else {
+ set path $nativeName
+ }
+ } else {
+ set path /[tixWinGetFileDrive $nativeName]\\[tixWinGetFilePath $nativeName]
+ }
+
+ set intName ""
+ foreach name [tixFileSplit $path] {
+ set intName [tixSubFolder $intName $name]
+ }
+
+ return $intName
+}
+
+# in: internal name
+# out: native name
+proc tixNativeName {intName {mustBeAbs 1}} {
+ if {[string index $intName 0] != "/"} {
+ if {$mustBeAbs} {
+ error "Tix internal error: \"$intName\" is not an intName"
+ } else {
+ return $intName
+ }
+ }
+ if {$intName == "/"} {
+ return C:\\
+ }
+ regsub {/[\\]} $intName "" nativeName
+ if {[string length $nativeName] == 2} {
+ return $nativeName\\
+ } else {
+ return $nativeName
+ }
+}
+
+# how a filename should be displayed
+#
+# e.g. /\C: becomes C:\\
+# /\ becomes "My Computer"
+# /\C:\\Windows is Windows
+proc tixFileDisplayName {intName} {
+ if {[string index $intName 0] != "/"} {
+ error "Tix internal error: \"$intName\" is not an intName"
+ }
+
+ if {$intName == "/"} {
+ return "My Computer"
+ }
+
+ regsub {/[\\]} $intName "" nativeName
+
+ if {[string length $nativeName] == 2} {
+ return [string toupper $nativeName\\]
+ } else {
+ return [file tail $nativeName]
+ }
+}
+
+# in: internal name
+# out: a list of paths
+proc tixFileSplit {intName} {
+
+ set l ""
+ foreach n [split $intName /\\] {
+ if {$n == ""} {
+ continue
+ }
+ if {$n == "."} {
+ continue
+ }
+
+ lappend l $n
+ }
+
+
+ while 1 {
+ set idx [lsearch $l ".."]
+ if {$idx == -1} {
+ break;
+ }
+ set l [lreplace $l [expr $idx -1] $idx]
+ }
+
+
+ if {[string index $intName 0] == "/"} {
+ return [concat "/" $l]
+ } else {
+ return $l
+ }
+}
+
+# parent, sub: intName
+#
+proc tixSubFolder {parent sub} {
+ if {$parent == ""} {
+ return $sub
+ }
+ return $parent\\$sub
+}
+
+proc tixWinGetDrives {} {
+ global tixPriv
+
+ if [info exists tixPriv(drives)] {
+ return $tixPriv(drives)
+ } else {
+ set tixPriv(drives) {A: B:}
+ foreach d {c e d f g h i j k l m n o p q r s t u v w x y z} {
+ if [file exists $d:] {
+ lappend tixPriv(drives) [string toupper $d:]
+ }
+ }
+ }
+ return $tixPriv(drives)
+}
+
+# dir: Make a listing of this directory
+# showSubDir: Want to list the subdirectories?
+# showFile: Want to list the non-directory files in this directory?
+# showPrevDir: Want to list ".." as well?
+# showHidden: Want to list the hidden files? (%% is ignored)
+#
+# return value: a list of files and/or subdirectories
+#
+proc tixListDir {dir showSubDir showFile showPrevDir showHidden {pattern ""}} {
+ set appPWD [pwd]
+
+ if {$dir == "/"} {
+ if {$showSubDir} {
+ return [tixWinGetDrives]
+ } else {
+ return ""
+ }
+ }
+
+ if [catch {cd [tixNativeName $dir]} err] {
+ # The user has entered an invalid directory
+ # %% todo: prompt error, go back to last succeed directory
+ cd $appPWD
+ return ""
+ }
+
+ if {$pattern == ""} {
+ set pattern "*"
+ }
+
+ if [catch {set names [lsort [eval glob -nocomplain $pattern]]} err] {
+ # Cannot read directory
+ # %% todo: show directory permission denied
+ cd $appPWD
+ return ""
+ }
+
+ set list ""
+ catch {
+ # We are catch'ing, just in case the "file" command returns unexpected
+ # errors
+ #
+ foreach fname $names {
+ if {![string compare . $fname]} {
+ continue
+ }
+ if {![string compare ".." $fname]} {
+ continue
+ }
+ if [file isdirectory $fname] {
+ if $showSubDir {
+ lappend list [file tail $fname]
+ }
+ } else {
+ if $showFile {
+ lappend list [file tail $fname]
+ }
+ }
+ }
+ }
+ cd $appPWD
+
+ if {$showSubDir && $showPrevDir && $dir != "/"} {
+ return [lsort [concat .. $list]]
+ } else {
+ return $list
+ }
+}
+
+proc tixVerifyFile {file} {
+ return [tixFileIntName $file]
+}
+
+proc tixFilePattern {args} {
+ if {[lsearch $args allFiles] != -1} {
+ return *
+ }
+ return *
+}
+
+}
+
+# tixWinFileEmu --
+#
+# Emulates a MS Windows file system environemnt inside Unix
+#
+proc tixWinFileEmu {} {
+ cd /mnt/c
+ rename pwd __pwd
+ rename cd __cd
+ proc EmuConvert {path} {
+ if [regsub ^/mnt/c/ $path c:/ path] {
+ return $path
+ }
+ if [regsub ^/mnt/d/ $path d:/ path] {
+ return $path
+ }
+ if [regsub ^/mnt/c\$ $path c:/ path] {
+ return $path
+ }
+ if [regsub ^/mnt/d\$ $path d:/ path] {
+ return $path
+ }
+ return c:/windows
+ }
+
+ proc pwd {} {
+ return [EmuConvert [__pwd]]
+ }
+ proc glob {args} {
+
+ }
+}
diff --git a/tix/library/bitmaps/act_fold.gif b/tix/library/bitmaps/act_fold.gif
new file mode 100644
index 00000000000..624ae391921
--- /dev/null
+++ b/tix/library/bitmaps/act_fold.gif
Binary files differ
diff --git a/tix/library/bitmaps/act_fold.xbm b/tix/library/bitmaps/act_fold.xbm
new file mode 100644
index 00000000000..f9bea92aaa9
--- /dev/null
+++ b/tix/library/bitmaps/act_fold.xbm
@@ -0,0 +1,5 @@
+#define act_fold_width 16
+#define act_fold_height 10
+static unsigned char act_fold_bits[] = {
+ 0xfc, 0x00, 0xaa, 0x0f, 0x55, 0x15, 0xeb, 0xff, 0x15, 0x80, 0x0b, 0x40,
+ 0x05, 0x20, 0x03, 0x10, 0x01, 0x08, 0xff, 0x07};
diff --git a/tix/library/bitmaps/act_fold.xpm b/tix/library/bitmaps/act_fold.xpm
new file mode 100644
index 00000000000..510a059f7c8
--- /dev/null
+++ b/tix/library/bitmaps/act_fold.xpm
@@ -0,0 +1,22 @@
+/* XPM */
+static char * act_fold_xpm[] = {
+/* width height num_colors chars_per_pixel */
+"16 12 4 1",
+/* colors */
+" s None c None",
+". c black",
+"X c yellow",
+"o c #5B5B57574646",
+/* pixels */
+" .... ",
+" .XXXX. ",
+" .XXXXXX. ",
+"............. ",
+".oXoXoXoXoXo. ",
+".XoX............",
+".oX.XXXXXXXXXXX.",
+".Xo.XXXXXXXXXX. ",
+".o.XXXXXXXXXXX. ",
+".X.XXXXXXXXXXX. ",
+"..XXXXXXXXXX.. ",
+"............. "};
diff --git a/tix/library/bitmaps/balarrow.xbm b/tix/library/bitmaps/balarrow.xbm
new file mode 100755
index 00000000000..e74055af489
--- /dev/null
+++ b/tix/library/bitmaps/balarrow.xbm
@@ -0,0 +1,4 @@
+#define balarrow_width 6
+#define balarrow_height 6
+static char balarrow_bits[] = {
+ 0x1f, 0x07, 0x07, 0x09, 0x11, 0x20};
diff --git a/tix/library/bitmaps/cbxarrow.xbm b/tix/library/bitmaps/cbxarrow.xbm
new file mode 100755
index 00000000000..ae4054488b9
--- /dev/null
+++ b/tix/library/bitmaps/cbxarrow.xbm
@@ -0,0 +1,6 @@
+#define cbxarrow_width 11
+#define cbxarrow_height 14
+static char cbxarrow_bits[] = {
+ 0x00, 0x00, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00, 0x70, 0x00,
+ 0xfe, 0x03, 0xfc, 0x01, 0xf8, 0x00, 0x70, 0x00, 0x20, 0x00, 0x00, 0x00,
+ 0xfe, 0x03, 0xfe, 0x03};
diff --git a/tix/library/bitmaps/ck_def.xbm b/tix/library/bitmaps/ck_def.xbm
new file mode 100644
index 00000000000..15813a5f4de
--- /dev/null
+++ b/tix/library/bitmaps/ck_def.xbm
@@ -0,0 +1,6 @@
+#define ck_def_width 13
+#define ck_def_height 13
+static unsigned char ck_def_bits[] = {
+ 0xff, 0x1f, 0x01, 0x10, 0x55, 0x15, 0x01, 0x10, 0x55, 0x15, 0x01, 0x10,
+ 0x55, 0x15, 0x01, 0x10, 0x55, 0x15, 0x01, 0x10, 0x55, 0x15, 0x01, 0x10,
+ 0xff, 0x1f};
diff --git a/tix/library/bitmaps/ck_off.xbm b/tix/library/bitmaps/ck_off.xbm
new file mode 100644
index 00000000000..9aa002fbbde
--- /dev/null
+++ b/tix/library/bitmaps/ck_off.xbm
@@ -0,0 +1,6 @@
+#define ck_off_width 13
+#define ck_off_height 13
+static unsigned char ck_off_bits[] = {
+ 0xff, 0x1f, 0x01, 0x10, 0x01, 0x10, 0x01, 0x10, 0x01, 0x10, 0x01, 0x10,
+ 0x01, 0x10, 0x01, 0x10, 0x01, 0x10, 0x01, 0x10, 0x01, 0x10, 0x01, 0x10,
+ 0xff, 0x1f};
diff --git a/tix/library/bitmaps/ck_on.xbm b/tix/library/bitmaps/ck_on.xbm
new file mode 100644
index 00000000000..7631bd72075
--- /dev/null
+++ b/tix/library/bitmaps/ck_on.xbm
@@ -0,0 +1,6 @@
+#define ck_on_width 13
+#define ck_on_height 13
+static unsigned char ck_on_bits[] = {
+ 0xff, 0x1f, 0x01, 0x10, 0x01, 0x10, 0x01, 0x14, 0x01, 0x16, 0x01, 0x17,
+ 0x89, 0x13, 0xdd, 0x11, 0xf9, 0x10, 0x71, 0x10, 0x21, 0x10, 0x01, 0x10,
+ 0xff, 0x1f};
diff --git a/tix/library/bitmaps/cross.xbm b/tix/library/bitmaps/cross.xbm
new file mode 100755
index 00000000000..de51300ce07
--- /dev/null
+++ b/tix/library/bitmaps/cross.xbm
@@ -0,0 +1,6 @@
+#define cross_width 14
+#define cross_height 14
+static char cross_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x06, 0x18, 0x0e, 0x1c, 0x1c, 0x0e, 0x38, 0x07,
+ 0xf0, 0x03, 0xe0, 0x01, 0xe0, 0x01, 0xf0, 0x03, 0x38, 0x07, 0x1c, 0x0e,
+ 0x0e, 0x1c, 0x06, 0x18};
diff --git a/tix/library/bitmaps/decr.xbm b/tix/library/bitmaps/decr.xbm
new file mode 100755
index 00000000000..ee2194e50b0
--- /dev/null
+++ b/tix/library/bitmaps/decr.xbm
@@ -0,0 +1,4 @@
+#define decr_width 7
+#define decr_height 4
+static char decr_bits[] = {
+ 0x7f, 0x3e, 0x1c, 0x08};
diff --git a/tix/library/bitmaps/drop.xbm b/tix/library/bitmaps/drop.xbm
new file mode 100644
index 00000000000..a7ba3b373ea
--- /dev/null
+++ b/tix/library/bitmaps/drop.xbm
@@ -0,0 +1,8 @@
+#define drop_width 16
+#define drop_height 16
+#define drop_x_hot 6
+#define drop_y_hot 4
+static unsigned char drop_bits[] = {
+ 0x00, 0x00, 0xfe, 0x07, 0x02, 0x04, 0x02, 0x04, 0x42, 0x04, 0xc2, 0x04,
+ 0xc2, 0x05, 0xc2, 0x07, 0xc2, 0x07, 0xc2, 0x0f, 0xfe, 0x1f, 0xc0, 0x07,
+ 0xc0, 0x06, 0x00, 0x0c, 0x00, 0x1c, 0x00, 0x08};
diff --git a/tix/library/bitmaps/file.gif b/tix/library/bitmaps/file.gif
new file mode 100644
index 00000000000..45da9962ba5
--- /dev/null
+++ b/tix/library/bitmaps/file.gif
Binary files differ
diff --git a/tix/library/bitmaps/file.xbm b/tix/library/bitmaps/file.xbm
new file mode 100644
index 00000000000..7bf12bb4c9f
--- /dev/null
+++ b/tix/library/bitmaps/file.xbm
@@ -0,0 +1,5 @@
+#define file_width 12
+#define file_height 12
+static unsigned char file_bits[] = {
+ 0xfe, 0x00, 0x02, 0x03, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02,
+ 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0x02, 0xfe, 0x03};
diff --git a/tix/library/bitmaps/file.xpm b/tix/library/bitmaps/file.xpm
new file mode 100644
index 00000000000..089fdf3ba22
--- /dev/null
+++ b/tix/library/bitmaps/file.xpm
@@ -0,0 +1,18 @@
+/* XPM */
+static char * file_xpm[] = {
+"12 12 3 1",
+" s None c None",
+". c black",
+"X c #FFFFFFFFF3CE",
+" ........ ",
+" .XXXXXX. ",
+" .XXXXXX... ",
+" .XXXXXXXX. ",
+" .XXXXXXXX. ",
+" .XXXXXXXX. ",
+" .XXXXXXXX. ",
+" .XXXXXXXX. ",
+" .XXXXXXXX. ",
+" .XXXXXXXX. ",
+" .XXXXXXXX. ",
+" .......... "};
diff --git a/tix/library/bitmaps/folder.gif b/tix/library/bitmaps/folder.gif
new file mode 100644
index 00000000000..112bce7ab09
--- /dev/null
+++ b/tix/library/bitmaps/folder.gif
Binary files differ
diff --git a/tix/library/bitmaps/folder.xbm b/tix/library/bitmaps/folder.xbm
new file mode 100644
index 00000000000..0398f0de777
--- /dev/null
+++ b/tix/library/bitmaps/folder.xbm
@@ -0,0 +1,5 @@
+#define folder_width 16
+#define folder_height 10
+static unsigned char folder_bits[] = {
+ 0xfc, 0x00, 0x02, 0x07, 0x01, 0x08, 0x01, 0x08, 0x01, 0x08, 0x01, 0x08,
+ 0x01, 0x08, 0x01, 0x08, 0x01, 0x08, 0xff, 0x07};
diff --git a/tix/library/bitmaps/folder.xpm b/tix/library/bitmaps/folder.xpm
new file mode 100644
index 00000000000..60537e3b9d8
--- /dev/null
+++ b/tix/library/bitmaps/folder.xpm
@@ -0,0 +1,21 @@
+/* XPM */
+static char * folder_foo_xpm[] = {
+/* width height num_colors chars_per_pixel */
+"16 12 3 1",
+/* colors */
+" s None c None",
+". c black",
+"X c #f0ff80",
+/* pixels */
+" .... ",
+" .XXXX. ",
+" .XXXXXX. ",
+"............. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+"............. "};
diff --git a/tix/library/bitmaps/harddisk.xbm b/tix/library/bitmaps/harddisk.xbm
new file mode 100755
index 00000000000..34107eadeff
--- /dev/null
+++ b/tix/library/bitmaps/harddisk.xbm
@@ -0,0 +1,14 @@
+#define harddisk_width 32
+#define harddisk_height 32
+static unsigned char harddisk_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0xf8, 0xff, 0xff, 0x1f, 0x08, 0x00, 0x00, 0x18, 0xa8, 0xaa, 0xaa, 0x1a,
+ 0x48, 0x55, 0xd5, 0x1d, 0xa8, 0xaa, 0xaa, 0x1b, 0x48, 0x55, 0x55, 0x1d,
+ 0xa8, 0xfa, 0xaf, 0x1a, 0xc8, 0xff, 0xff, 0x1d, 0xa8, 0xfa, 0xaf, 0x1a,
+ 0x48, 0x55, 0x55, 0x1d, 0xa8, 0xaa, 0xaa, 0x1a, 0x48, 0x55, 0x55, 0x1d,
+ 0xa8, 0xaa, 0xaa, 0x1a, 0xf8, 0xff, 0xff, 0x1f, 0xf8, 0xff, 0xff, 0x1f,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/tix/library/bitmaps/hourglas.mask b/tix/library/bitmaps/hourglas.mask
new file mode 100644
index 00000000000..12aa0445b0f
--- /dev/null
+++ b/tix/library/bitmaps/hourglas.mask
@@ -0,0 +1,16 @@
+#define hourglass_mask_width 32
+#define hourglass_mask_height 32
+#define hourglass_mask_x_hot 16
+#define hourglass_mask_y_hot 15
+static char hourglass_mask_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0x7f, 0xfc, 0xff, 0xff, 0x7f,
+ 0x58, 0x00, 0x00, 0x34, 0x58, 0x00, 0x00, 0x34, 0x58, 0x00, 0x00, 0x34,
+ 0x98, 0x00, 0x00, 0x32, 0x98, 0x00, 0x00, 0x32, 0x98, 0x00, 0x00, 0x32,
+ 0x18, 0x01, 0x00, 0x31, 0x18, 0xfd, 0x7e, 0x31, 0x18, 0xfa, 0xbf, 0x30,
+ 0x18, 0xe4, 0x4f, 0x30, 0x18, 0xd8, 0x37, 0x30, 0x18, 0x20, 0x09, 0x30,
+ 0x18, 0x40, 0x05, 0x30, 0x18, 0x20, 0x08, 0x30, 0x18, 0x18, 0x31, 0x30,
+ 0x18, 0x04, 0x41, 0x30, 0x18, 0x02, 0x80, 0x30, 0x18, 0x01, 0x00, 0x31,
+ 0x18, 0x01, 0x00, 0x31, 0x98, 0x00, 0x01, 0x32, 0x98, 0x00, 0x01, 0x32,
+ 0x98, 0x80, 0x03, 0x32, 0x58, 0xc0, 0x07, 0x34, 0x58, 0xf0, 0x1f, 0x34,
+ 0x58, 0xfe, 0xff, 0x34, 0xf8, 0xff, 0xff, 0x3f, 0xfc, 0xff, 0xff, 0x7f,
+ 0xfc, 0xff, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00};
diff --git a/tix/library/bitmaps/hourglas.xbm b/tix/library/bitmaps/hourglas.xbm
new file mode 100755
index 00000000000..834c20c23f9
--- /dev/null
+++ b/tix/library/bitmaps/hourglas.xbm
@@ -0,0 +1,16 @@
+#define hourglass_width 32
+#define hourglas_height 32
+#define hourglas_x_hot 16
+#define hourglas_y_hot 15
+static char hourglas_bits[] = {
+ 0xfe, 0xff, 0xff, 0xff, 0xfe, 0xff, 0xff, 0xff, 0xfe, 0xff, 0xff, 0xff,
+ 0x7c, 0x00, 0x00, 0x7c, 0x7c, 0x00, 0x00, 0x7c, 0x7c, 0x00, 0x00, 0x7c,
+ 0xfc, 0x00, 0x00, 0x7e, 0xfc, 0x00, 0x00, 0x7e, 0xfc, 0x00, 0x00, 0x7e,
+ 0xbc, 0x01, 0x00, 0x7b, 0xbc, 0xfd, 0x7e, 0x7b, 0x3c, 0xfb, 0xbf, 0x79,
+ 0x3c, 0xe6, 0xcf, 0x78, 0x3c, 0xdc, 0x77, 0x78, 0x3c, 0x38, 0x39, 0x78,
+ 0x3c, 0x60, 0x0d, 0x78, 0x3c, 0x38, 0x38, 0x78, 0x3c, 0x1c, 0x71, 0x78,
+ 0x3c, 0x06, 0xc1, 0x78, 0x3c, 0x03, 0x80, 0x79, 0xbc, 0x01, 0x00, 0x7b,
+ 0xbc, 0x01, 0x00, 0x7b, 0xfc, 0x00, 0x01, 0x7e, 0xfc, 0x00, 0x01, 0x7e,
+ 0xfc, 0x80, 0x03, 0x7e, 0x7c, 0xc0, 0x07, 0x7c, 0x7c, 0xf0, 0x1f, 0x7c,
+ 0x7c, 0xfe, 0xff, 0x7c, 0xfe, 0xff, 0xff, 0x7f, 0xfe, 0xff, 0xff, 0xff,
+ 0xfe, 0xff, 0xff, 0xff, 0xfe, 0xff, 0xff, 0xff};
diff --git a/tix/library/bitmaps/incr.xbm b/tix/library/bitmaps/incr.xbm
new file mode 100755
index 00000000000..b73e89ebe63
--- /dev/null
+++ b/tix/library/bitmaps/incr.xbm
@@ -0,0 +1,4 @@
+#define incr_width 7
+#define incr_height 4
+static char incr_bits[] = {
+ 0x08, 0x1c, 0x3e, 0x7f};
diff --git a/tix/library/bitmaps/info.gif b/tix/library/bitmaps/info.gif
new file mode 100644
index 00000000000..df1d68d0716
--- /dev/null
+++ b/tix/library/bitmaps/info.gif
Binary files differ
diff --git a/tix/library/bitmaps/info.xpm b/tix/library/bitmaps/info.xpm
new file mode 100644
index 00000000000..4be94ea9137
--- /dev/null
+++ b/tix/library/bitmaps/info.xpm
@@ -0,0 +1,38 @@
+/* XPM */
+static char * info_xpm[] = {
+"32 32 3 1",
+" s None c None",
+". c #000000000000",
+"X c white",
+" ",
+" ......... ",
+" ...XXXXXXXXX... ",
+" .XXXXXXXXXXXXXXX. ",
+" ..XXXXXXXXXXXXXXXXX.. ",
+" .XXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXX...XXXXXXXXXX. ",
+" .XXXXXXXXX.....XXXXXXXXX. ",
+" .XXXXXXXXX.......XXXXXXXXX. ",
+" .XXXXXXXXXX.......XXXXXXXXXX. ",
+" .XXXXXXXXXX.......XXXXXXXXXX. ",
+" .XXXXXXXXXXX.....XXXXXXXXXXX. ",
+".XXXXXXXXXXXXX...XXXXXXXXXXXXX. ",
+".XXXXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+".XXXXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+" .XXXXXXXXXX.......XXXXXXXXXX. ",
+" .XXXXXXXXXX.......XXXXXXXXXX. ",
+" .XXXXXXXXXX.......XXXXXXXXXX. ",
+" .XXXXXXXXX.......XXXXXXXXX. ",
+" .XXXXXXXX.......XXXXXXXX. ",
+" .XXXXXXXX.......XXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXX. ",
+" ..XXXXXXXXXXXXXXXXX.. ",
+" .XXXXXXXXXXXXXXX. ",
+" ...XXXXXXXXX... ",
+" ......... "};
diff --git a/tix/library/bitmaps/maximize.xbm b/tix/library/bitmaps/maximize.xbm
new file mode 100644
index 00000000000..bfc9276fd29
--- /dev/null
+++ b/tix/library/bitmaps/maximize.xbm
@@ -0,0 +1,6 @@
+#define maximize_width 15
+#define maximize_height 15
+static unsigned char maximize_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0xfc, 0x1f, 0x04, 0x10, 0x04, 0x70, 0x04, 0x70,
+ 0x04, 0x70, 0x04, 0x70, 0x04, 0x70, 0x04, 0x70, 0x04, 0x70, 0x04, 0x70,
+ 0xfc, 0x7f, 0xf0, 0x7f, 0xf0, 0x7f};
diff --git a/tix/library/bitmaps/minimize.xbm b/tix/library/bitmaps/minimize.xbm
new file mode 100644
index 00000000000..029eb4e76ed
--- /dev/null
+++ b/tix/library/bitmaps/minimize.xbm
@@ -0,0 +1,6 @@
+#define minimize_width 15
+#define minimize_height 15
+static unsigned char minimize_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x01,
+ 0x20, 0x03, 0x20, 0x03, 0xe0, 0x03, 0xc0, 0x03, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/tix/library/bitmaps/minus.gif b/tix/library/bitmaps/minus.gif
new file mode 100644
index 00000000000..1ff7dba7d87
--- /dev/null
+++ b/tix/library/bitmaps/minus.gif
Binary files differ
diff --git a/tix/library/bitmaps/minus.xbm b/tix/library/bitmaps/minus.xbm
new file mode 100644
index 00000000000..280b5089687
--- /dev/null
+++ b/tix/library/bitmaps/minus.xbm
@@ -0,0 +1,5 @@
+#define minus_width 9
+#define minus_height 9
+static unsigned char minus_bits[] = {
+ 0xff, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x01, 0x7d, 0x01, 0x01, 0x01,
+ 0x01, 0x01, 0x01, 0x01, 0xff, 0x01};
diff --git a/tix/library/bitmaps/minus.xpm b/tix/library/bitmaps/minus.xpm
new file mode 100644
index 00000000000..28fa48ce3fd
--- /dev/null
+++ b/tix/library/bitmaps/minus.xpm
@@ -0,0 +1,14 @@
+/* XPM */
+static char * minus_xpm[] = {
+"9 9 2 1",
+". s None c None",
+" c black",
+" ",
+" ....... ",
+" ....... ",
+" ....... ",
+" . . ",
+" ....... ",
+" ....... ",
+" ....... ",
+" "};
diff --git a/tix/library/bitmaps/minusarm.gif b/tix/library/bitmaps/minusarm.gif
new file mode 100644
index 00000000000..4ae5fce5f16
--- /dev/null
+++ b/tix/library/bitmaps/minusarm.gif
Binary files differ
diff --git a/tix/library/bitmaps/minusarm.xbm b/tix/library/bitmaps/minusarm.xbm
new file mode 100644
index 00000000000..522e51daade
--- /dev/null
+++ b/tix/library/bitmaps/minusarm.xbm
@@ -0,0 +1,5 @@
+#define minusarm_width 9
+#define minusarm_height 9
+static unsigned char minusarm_bits[] = {
+ 0xff, 0x01, 0x01, 0x01, 0x7d, 0x01, 0x7d, 0x01, 0x01, 0x01, 0x7d, 0x01,
+ 0x7d, 0x01, 0x01, 0x01, 0xff, 0x01};
diff --git a/tix/library/bitmaps/minusarm.xpm b/tix/library/bitmaps/minusarm.xpm
new file mode 100644
index 00000000000..d2e3ea751bc
--- /dev/null
+++ b/tix/library/bitmaps/minusarm.xpm
@@ -0,0 +1,15 @@
+/* XPM */
+static char * minusarm_xpm[] = {
+"9 9 3 1",
+" c black",
+". c yellow",
+"X c #808080808080",
+" ",
+" ....... ",
+" ....... ",
+" .XXXXX. ",
+" .X X. ",
+" .XXXXX. ",
+" ....... ",
+" ....... ",
+" "};
diff --git a/tix/library/bitmaps/mktransgif.tcl b/tix/library/bitmaps/mktransgif.tcl
new file mode 100644
index 00000000000..085ac7a62a6
--- /dev/null
+++ b/tix/library/bitmaps/mktransgif.tcl
@@ -0,0 +1,11 @@
+#!/usr/local/bin/tclsh
+
+set dont(plusarm.gif) 1
+set dont(minusarm.gif) 1
+
+foreach file [glob *.gif] {
+ if ![info exists dont($file)] {
+ puts "giftool -1 -B $file"
+ }
+}
+
diff --git a/tix/library/bitmaps/network.xbm b/tix/library/bitmaps/network.xbm
new file mode 100755
index 00000000000..68d73b930dd
--- /dev/null
+++ b/tix/library/bitmaps/network.xbm
@@ -0,0 +1,14 @@
+#define network_width 32
+#define network_height 32
+static unsigned char network_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x7f, 0x00, 0x00, 0x02, 0x40,
+ 0x00, 0x00, 0xfa, 0x5f, 0x00, 0x00, 0x0a, 0x50, 0x00, 0x00, 0x0a, 0x52,
+ 0x00, 0x00, 0x0a, 0x52, 0x00, 0x00, 0x8a, 0x51, 0x00, 0x00, 0x0a, 0x50,
+ 0x00, 0x00, 0x4a, 0x50, 0x00, 0x00, 0x0a, 0x50, 0x00, 0x00, 0x0a, 0x50,
+ 0x00, 0x00, 0xfa, 0x5f, 0x00, 0x00, 0x02, 0x40, 0xfe, 0x7f, 0x52, 0x55,
+ 0x02, 0x40, 0xaa, 0x6a, 0xfa, 0x5f, 0xfe, 0x7f, 0x0a, 0x50, 0xfe, 0x7f,
+ 0x0a, 0x52, 0x80, 0x00, 0x0a, 0x52, 0x80, 0x00, 0x8a, 0x51, 0x80, 0x00,
+ 0x0a, 0x50, 0x80, 0x00, 0x4a, 0x50, 0x80, 0x00, 0x0a, 0x50, 0xe0, 0x03,
+ 0x0a, 0x50, 0x20, 0x02, 0xfa, 0xdf, 0x3f, 0x03, 0x02, 0x40, 0xa0, 0x02,
+ 0x52, 0x55, 0xe0, 0x03, 0xaa, 0x6a, 0x00, 0x00, 0xfe, 0x7f, 0x00, 0x00,
+ 0xfe, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/tix/library/bitmaps/no_entry.gif b/tix/library/bitmaps/no_entry.gif
new file mode 100644
index 00000000000..f5f2f4b9a70
--- /dev/null
+++ b/tix/library/bitmaps/no_entry.gif
Binary files differ
diff --git a/tix/library/bitmaps/no_entry.xpm b/tix/library/bitmaps/no_entry.xpm
new file mode 100644
index 00000000000..f0bcdf3eb4c
--- /dev/null
+++ b/tix/library/bitmaps/no_entry.xpm
@@ -0,0 +1,39 @@
+/* XPM */
+static char * no_entry_xpm[] = {
+"32 32 4 1",
+" s None c None",
+". c #000000000000",
+"X c red",
+"o c yellow",
+" ",
+" ......... ",
+" ...XXXXXXXXX... ",
+" .XXXXXXXXXXXXXXX. ",
+" ..XXXXXXXXXXXXXXXXX.. ",
+" .XXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+".XXXXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+".XXX.......................XXX. ",
+".XXX.ooooooooooooooooooooo.XXX. ",
+".XXX.ooooooooooooooooooooo.XXX. ",
+".XXX.ooooooooooooooooooooo.XXX. ",
+".XXX.ooooooooooooooooooooo.XXX. ",
+".XXX.ooooooooooooooooooooo.XXX. ",
+".XXX.ooooooooooooooooooooo.XXX. ",
+".XXX.......................XXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXX. ",
+" ..XXXXXXXXXXXXXXXXX.. ",
+" .XXXXXXXXXXXXXXX. ",
+" ...XXXXXXXXX... ",
+" ......... "};
diff --git a/tix/library/bitmaps/openfile.xbm b/tix/library/bitmaps/openfile.xbm
new file mode 100644
index 00000000000..3f493fd6dce
--- /dev/null
+++ b/tix/library/bitmaps/openfile.xbm
@@ -0,0 +1,5 @@
+#define openfile_width 16
+#define openfile_height 10
+static unsigned char openfile_bits[] = {
+ 0xf8, 0x01, 0x04, 0x06, 0x02, 0x08, 0x02, 0x10, 0xe2, 0xff, 0x52, 0x55,
+ 0xaa, 0x2a, 0x56, 0x15, 0xaa, 0x0a, 0xfe, 0x07};
diff --git a/tix/library/bitmaps/openfold.gif b/tix/library/bitmaps/openfold.gif
new file mode 100644
index 00000000000..889709b55f4
--- /dev/null
+++ b/tix/library/bitmaps/openfold.gif
Binary files differ
diff --git a/tix/library/bitmaps/openfold.xbm b/tix/library/bitmaps/openfold.xbm
new file mode 100644
index 00000000000..5dca1c91004
--- /dev/null
+++ b/tix/library/bitmaps/openfold.xbm
@@ -0,0 +1,5 @@
+#define openfold_width 16
+#define openfold_height 10
+static unsigned char openfold_bits[] = {
+ 0xfc, 0x00, 0x02, 0x07, 0x01, 0x08, 0xc1, 0xff, 0x21, 0x80, 0x11, 0x40,
+ 0x09, 0x20, 0x05, 0x10, 0x03, 0x08, 0xff, 0x07};
diff --git a/tix/library/bitmaps/openfold.xpm b/tix/library/bitmaps/openfold.xpm
new file mode 100644
index 00000000000..191fe1e72bc
--- /dev/null
+++ b/tix/library/bitmaps/openfold.xpm
@@ -0,0 +1,21 @@
+/* XPM */
+static char * openfolder_xpm[] = {
+/* width height num_colors chars_per_pixel */
+"16 12 3 1",
+/* colors */
+" s None c None",
+". c black",
+"X c #f0ff80",
+/* pixels */
+" .... ",
+" .XXXX. ",
+" .XXXXXX. ",
+"............. ",
+".XXXXXXXXXXX. ",
+".XXX............",
+".XX.XXXXXXXXXXX.",
+".XX.XXXXXXXXXX. ",
+".X.XXXXXXXXXXX. ",
+".X.XXXXXXXXXXX. ",
+"..XXXXXXXXXX.. ",
+"............. "};
diff --git a/tix/library/bitmaps/plus.gif b/tix/library/bitmaps/plus.gif
new file mode 100644
index 00000000000..696b3d80691
--- /dev/null
+++ b/tix/library/bitmaps/plus.gif
Binary files differ
diff --git a/tix/library/bitmaps/plus.xbm b/tix/library/bitmaps/plus.xbm
new file mode 100644
index 00000000000..ff0278a5509
--- /dev/null
+++ b/tix/library/bitmaps/plus.xbm
@@ -0,0 +1,5 @@
+#define plus_width 9
+#define plus_height 9
+static unsigned char plus_bits[] = {
+ 0xff, 0x01, 0x01, 0x01, 0x11, 0x01, 0x11, 0x01, 0x7d, 0x01, 0x11, 0x01,
+ 0x11, 0x01, 0x01, 0x01, 0xff, 0x01};
diff --git a/tix/library/bitmaps/plus.xpm b/tix/library/bitmaps/plus.xpm
new file mode 100644
index 00000000000..27b83d32c53
--- /dev/null
+++ b/tix/library/bitmaps/plus.xpm
@@ -0,0 +1,14 @@
+/* XPM */
+static char * plus_xpm[] = {
+"9 9 2 1",
+". s None c None",
+" c black",
+" ",
+" ....... ",
+" ... ... ",
+" ... ... ",
+" . . ",
+" ... ... ",
+" ... ... ",
+" ....... ",
+" "};
diff --git a/tix/library/bitmaps/plusarm.gif b/tix/library/bitmaps/plusarm.gif
new file mode 100644
index 00000000000..52528edd313
--- /dev/null
+++ b/tix/library/bitmaps/plusarm.gif
Binary files differ
diff --git a/tix/library/bitmaps/plusarm.xbm b/tix/library/bitmaps/plusarm.xbm
new file mode 100644
index 00000000000..28b5f02a2da
--- /dev/null
+++ b/tix/library/bitmaps/plusarm.xbm
@@ -0,0 +1,5 @@
+#define plusarm_width 9
+#define plusarm_height 9
+static unsigned char plusarm_bits[] = {
+ 0xff, 0x01, 0x01, 0x01, 0x6d, 0x01, 0x6d, 0x01, 0x01, 0x01, 0x6d, 0x01,
+ 0x6d, 0x01, 0x01, 0x01, 0xff, 0x01};
diff --git a/tix/library/bitmaps/plusarm.xpm b/tix/library/bitmaps/plusarm.xpm
new file mode 100644
index 00000000000..e06e5764014
--- /dev/null
+++ b/tix/library/bitmaps/plusarm.xpm
@@ -0,0 +1,15 @@
+/* XPM */
+static char * plusarm_xpm[] = {
+"9 9 3 1",
+" c black",
+". c yellow",
+"X c gray40",
+" ",
+" ....... ",
+" ... ... ",
+" ..X X.. ",
+" . X . ",
+" ..X X.. ",
+" ... ... ",
+" ....... ",
+" "};
diff --git a/tix/library/bitmaps/resize1.xbm b/tix/library/bitmaps/resize1.xbm
new file mode 100644
index 00000000000..47eb4d9adab
--- /dev/null
+++ b/tix/library/bitmaps/resize1.xbm
@@ -0,0 +1,8 @@
+#define resize1_width 13
+#define resize1_height 13
+#define resize1_x_hot 6
+#define resize1_y_hot 6
+static unsigned char resize1_bits[] = {
+ 0x7f, 0x00, 0x21, 0x00, 0x11, 0x00, 0x31, 0x00, 0x6d, 0x00, 0xdb, 0x00,
+ 0xb1, 0x11, 0x60, 0x1b, 0xc0, 0x16, 0x80, 0x11, 0x00, 0x11, 0x80, 0x10,
+ 0xc0, 0x1f};
diff --git a/tix/library/bitmaps/resize2.xbm b/tix/library/bitmaps/resize2.xbm
new file mode 100644
index 00000000000..b5ed893e244
--- /dev/null
+++ b/tix/library/bitmaps/resize2.xbm
@@ -0,0 +1,8 @@
+#define resize2_width 13
+#define resize2_height 13
+#define resize2_x_hot 6
+#define resize2_y_hot 6
+static unsigned char resize2_bits[] = {
+ 0xc0, 0x1f, 0x80, 0x10, 0x00, 0x11, 0x80, 0x11, 0xc0, 0x16, 0x60, 0x1b,
+ 0xb1, 0x11, 0xdb, 0x00, 0x6d, 0x00, 0x31, 0x00, 0x11, 0x00, 0x21, 0x00,
+ 0x7f, 0x00};
diff --git a/tix/library/bitmaps/restore.xbm b/tix/library/bitmaps/restore.xbm
new file mode 100644
index 00000000000..e40ea020cfc
--- /dev/null
+++ b/tix/library/bitmaps/restore.xbm
@@ -0,0 +1,6 @@
+#define restore_width 15
+#define restore_height 15
+static unsigned char restore_bits[] = {
+ 0x00, 0x00, 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f,
+ 0xfc, 0x1f, 0x00, 0x00, 0xfc, 0x1f, 0xf8, 0x0f, 0xf0, 0x07, 0xe0, 0x03,
+ 0xc0, 0x01, 0x80, 0x00, 0x00, 0x00};
diff --git a/tix/library/bitmaps/srcfile.gif b/tix/library/bitmaps/srcfile.gif
new file mode 100644
index 00000000000..98e145a27ab
--- /dev/null
+++ b/tix/library/bitmaps/srcfile.gif
Binary files differ
diff --git a/tix/library/bitmaps/srcfile.xbm b/tix/library/bitmaps/srcfile.xbm
new file mode 100644
index 00000000000..18ed3471513
--- /dev/null
+++ b/tix/library/bitmaps/srcfile.xbm
@@ -0,0 +1,5 @@
+#define srcfile_width 12
+#define srcfile_height 12
+static unsigned char srcfile_bits[] = {
+ 0xfe, 0x01, 0x02, 0x01, 0x02, 0x07, 0x02, 0x04, 0x72, 0x04, 0x8a, 0x04,
+ 0x0a, 0x04, 0x0a, 0x04, 0x8a, 0x04, 0x72, 0x04, 0x02, 0x04, 0xfe, 0x07};
diff --git a/tix/library/bitmaps/srcfile.xpm b/tix/library/bitmaps/srcfile.xpm
new file mode 100644
index 00000000000..9f306b8c22d
--- /dev/null
+++ b/tix/library/bitmaps/srcfile.xpm
@@ -0,0 +1,18 @@
+/* XPM */
+static char * srcfile_xpm[] = {
+"12 12 3 1",
+" s None c None",
+". c black",
+"X c gray91",
+" ........ ",
+" .XXXXXX. ",
+" .XXXXXX... ",
+" .XXXXXXXX. ",
+" .XX...XXX. ",
+" .X.XXX.XX. ",
+" .X.XXXXXX. ",
+" .X.XXXXXX. ",
+" .X.XXX.XX. ",
+" .XX...XXX. ",
+" .XXXXXXXX. ",
+" .......... "};
diff --git a/tix/library/bitmaps/system.xbm b/tix/library/bitmaps/system.xbm
new file mode 100644
index 00000000000..1f3a01cc3a4
--- /dev/null
+++ b/tix/library/bitmaps/system.xbm
@@ -0,0 +1,6 @@
+#define system_width 15
+#define system_height 15
+static unsigned char system_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x3f,
+ 0x02, 0x20, 0x02, 0x20, 0xfe, 0x3f, 0xfe, 0x3f, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/tix/library/bitmaps/textfile.gif b/tix/library/bitmaps/textfile.gif
new file mode 100644
index 00000000000..764d498aa53
--- /dev/null
+++ b/tix/library/bitmaps/textfile.gif
Binary files differ
diff --git a/tix/library/bitmaps/textfile.xbm b/tix/library/bitmaps/textfile.xbm
new file mode 100644
index 00000000000..c0b3b90c44e
--- /dev/null
+++ b/tix/library/bitmaps/textfile.xbm
@@ -0,0 +1,5 @@
+#define textfile_width 12
+#define textfile_height 12
+static unsigned char textfile_bits[] = {
+ 0xfe, 0x01, 0x02, 0x01, 0x02, 0x07, 0x7a, 0x04, 0x02, 0x04, 0x3a, 0x04,
+ 0x02, 0x04, 0xfa, 0x04, 0x02, 0x04, 0xfa, 0x04, 0x02, 0x04, 0xfe, 0x07};
diff --git a/tix/library/bitmaps/textfile.xpm b/tix/library/bitmaps/textfile.xpm
new file mode 100644
index 00000000000..5ac6706779d
--- /dev/null
+++ b/tix/library/bitmaps/textfile.xpm
@@ -0,0 +1,18 @@
+/* XPM */
+static char * textfile_xpm[] = {
+"12 12 3 1",
+" s None c None",
+". c black",
+"X c #FFFFFFFFF3CE",
+" ........ ",
+" .XXXXXX. ",
+" .XXXXXX... ",
+" .X....XXX. ",
+" .XXXXXXXX. ",
+" .X...XXXX. ",
+" .XXXXXXXX. ",
+" .X.....XX. ",
+" .XXXXXXXX. ",
+" .X.....XX. ",
+" .XXXXXXXX. ",
+" .......... "};
diff --git a/tix/library/bitmaps/tick.xbm b/tix/library/bitmaps/tick.xbm
new file mode 100755
index 00000000000..817f1868e84
--- /dev/null
+++ b/tix/library/bitmaps/tick.xbm
@@ -0,0 +1,6 @@
+#define tick_width 14
+#define tick_height 14
+static char tick_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x38, 0x00, 0x1c, 0x00, 0x0e,
+ 0x00, 0x07, 0x80, 0x03, 0xc2, 0x01, 0xe7, 0x00, 0x7f, 0x00, 0x3e, 0x00,
+ 0x1c, 0x00, 0x08, 0x00};
diff --git a/tix/library/bitmaps/warning.gif b/tix/library/bitmaps/warning.gif
new file mode 100644
index 00000000000..5ef641e3689
--- /dev/null
+++ b/tix/library/bitmaps/warning.gif
Binary files differ
diff --git a/tix/library/bitmaps/warning.xpm b/tix/library/bitmaps/warning.xpm
new file mode 100644
index 00000000000..d540d65a9a7
--- /dev/null
+++ b/tix/library/bitmaps/warning.xpm
@@ -0,0 +1,38 @@
+/* XPM */
+static char * warning_xpm[] = {
+"32 32 3 1",
+" s None c None",
+". c #000000000000",
+"X c yellow",
+" ",
+" ......... ",
+" ...XXXXXXXXX... ",
+" .XXXXXXXXXXXXXXX. ",
+" ..XXXXXXXXXXXXXXXXX.. ",
+" .XXXXXXXXX...XXXXXXXXX. ",
+" .XXXXXXXXX.....XXXXXXXXX. ",
+" .XXXXXXXXX.....XXXXXXXXX. ",
+" .XXXXXXXXX.......XXXXXXXXX. ",
+" .XXXXXXXXXX.......XXXXXXXXXX. ",
+" .XXXXXXXXXX.......XXXXXXXXXX. ",
+" .XXXXXXXXXX.......XXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXX.......XXXXXXXXXXX. ",
+".XXXXXXXXXXXX.....XXXXXXXXXXXX. ",
+".XXXXXXXXXXXX.....XXXXXXXXXXXX. ",
+".XXXXXXXXXXXX.....XXXXXXXXXXXX. ",
+".XXXXXXXXXXXXX...XXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXXXXXXXXXXXXXXXXX. ",
+" .XXXXXXXXXXXX...XXXXXXXXXXXX. ",
+" .XXXXXXXXXXX.....XXXXXXXXXXX. ",
+" .XXXXXXXXX.......XXXXXXXXX. ",
+" .XXXXXXXX.......XXXXXXXX. ",
+" .XXXXXXXX.......XXXXXXXX. ",
+" .XXXXXXXX.....XXXXXXXX. ",
+" ..XXXXXXX...XXXXXXX.. ",
+" .XXXXXXXXXXXXXXX. ",
+" ...XXXXXXXXX... ",
+" ......... "};
diff --git a/tix/library/fs.tcl b/tix/library/fs.tcl
new file mode 100644
index 00000000000..6f5e1e25846
--- /dev/null
+++ b/tix/library/fs.tcl
@@ -0,0 +1,644 @@
+# tixAssert --
+#
+# Debugging routine. Evaluates the test script in the context of the
+# caller. The test script is responsible for generating the error.
+#
+proc tixAssert {script} {
+ uplevel $script
+}
+
+proc tixAssertNorm {path} {
+ if ![tixFSIsNorm $path] {
+ error "\"$path\" is not a normalized path"
+ }
+}
+
+proc tixAssertVPath {vpath} {
+ if ![tixFSIsVPath $vpath] {
+ error "\"$vpath\" is not a VPATH"
+ }
+}
+
+# tixFSAbsPath --
+#
+# Converts $path into an normalized absolute path
+#
+proc tixFSAbsPath {path} {
+ return [lindex [tixFSNorm [tixFSVPWD] $path] 0]
+}
+
+# tixFSVPWD --
+#
+# Returns the VPATH of the current directory.
+#
+proc tixFSVPWD {} {
+ return [tixFSVPath [tixFSPWD]]
+}
+
+if {![info exists tcl_platform] || $tcl_platform(platform) == "unix"} {
+
+# tixFSPWD --
+#
+# Return the current directory
+#
+proc tixFSPWD {} {
+ return [pwd]
+}
+
+# tixFSDisplayName --
+#
+# Returns the name of a normalized path which is usually displayed by
+# the OS
+#
+proc tixFSDisplayName {normpath} {
+ tixAssert {
+ tixAssertNorm $normpath
+ }
+ return $normpath
+}
+
+proc tixFSIsAbsPath {path} {
+ return [tixStrEq [string index $path 0] /]
+}
+
+# tixFSIsNorm_os --
+#
+# Returns true iff this pathname is normalized, in the OS native name
+# format
+#
+proc tixFSIsNorm_os {path} {
+ return [tixFSIsNorm $path]
+}
+
+proc tixFSIsNorm {path} {
+ if [tixStrEq $path /] {
+ return 1
+ }
+
+ # relative path
+ #
+ if ![regexp {^/} $path] {
+ return 0
+ }
+
+ if [regexp {/[.]$} $path] {
+ return 0
+ }
+ if [regexp {/[.][.]$} $path] {
+ return 0
+ }
+ if [regexp {/[.]/} $path] {
+ return 0
+ }
+ if [regexp {/[.][.]/} $path] {
+ return 0
+ }
+ if [tixStrEq $path .] {
+ return 0
+ }
+ if [tixStrEq $path ..] {
+ return 0
+ }
+
+ # Tilde
+ #
+ if [regexp {^~} $path] {
+ return 0
+ }
+
+ # Double slashes
+ #
+ if [regexp {//} $path] {
+ return 0
+ }
+
+ # Trailing slashes
+ #
+ if [regexp {/$} $path] {
+ return 0
+ }
+
+ return 1
+}
+
+# tixFSIsValid --
+#
+# Checks whether a native pathname contains invalid characters.
+#
+proc tixFSIsValid {path} {
+ return 1
+}
+
+proc tixFSIsVPath {vpath} {
+ return [tixFSIsNorm $vpath]
+}
+
+# tixFSVPath --
+#
+# Converts a native pathname to its VPATH
+#
+proc tixFSVPath {path} {
+ tixAssert {
+ tixAssertNorm $path
+ }
+ return $path
+}
+
+# tixFSPath --
+#
+# Converts a vpath to a native pathname
+proc tixFSPath {vpath} {
+ tixAssert {
+ tixAssertVPath $vpath
+ }
+ return $vpath
+}
+
+# tixFSTildeSubst -- [Unix only]
+#
+# Substitutes any leading tilde characters if possible. No error is
+# generated if the user doesn't exist.
+#
+proc tixFSTildeSubst {text} {
+ if [tixStrEq [string index $text 0] ~] {
+ # The following will report if the user doesn't exist
+ if [catch {
+ file isdir $text
+ }] {
+ return ./$text
+ }
+ return [tixFile tilde $text]
+ } else {
+ return $text
+ }
+}
+
+# tixFSNorm --
+#
+# Interprets the user's input and return file information about this
+# input.
+#
+# Arguments:
+# See documentation (docs/Files.txt)
+#
+proc tixFSNorm {context text {defFile ""} {flagsVar ""} {errorMsgVar ""}} {
+ tixAssert {
+ tixAssertVPath $context
+ }
+
+ if ![tixStrEq $errorMsgVar ""] {
+ upvar $errorMsgVar errorMsg
+ }
+ if ![tixStrEq $flagsVar ""] {
+ upvar $flagsVar flags
+ }
+
+ set hasDirSuffix [regexp {/$} $text]
+ set text [tixFSTildeSubst $text]
+ set text [_tixJoin $context $text]
+
+ if {$hasDirSuffix || [file isdir $text]} {
+ set dir $text
+ set tail $defFile
+ } else {
+ set dir [file dirname $text]
+ set tail [file tail $text]
+ }
+
+ set norm $dir/$tail
+ regsub -all /+ $norm / norm
+ if ![tixStrEq $norm /] {
+ regsub {/$} $norm "" norm
+ }
+
+ if ![info exists flag(noPattern)] {
+ set isPat 0
+ foreach char [split $tail ""] {
+ if {$char == "*" || $char == "?"} {
+ set isPat 1
+ break
+ }
+ }
+ if {$isPat} {
+ return [list $norm $dir "" $tail]
+ }
+ }
+
+ return [list $norm $dir $tail ""]
+}
+
+# _tixJoin -- [Internal]
+#
+# Joins two native pathnames.
+#
+proc _tixJoin {p1 p2} {
+ if [tixStrEq [string index $p2 0] /] {
+ return [_tixNormalize $p2]
+ } else {
+ return [_tixNormalize $p1/$p2]
+ }
+}
+
+# tixFSNormDir --
+#
+# Normalizes an absolute path.
+#
+proc tixFSNormDir {dir} {
+ set dir [tixFile tilde $dir]
+ if ![tixStrEq [string index $dir 0] /] {
+ error "\"$dir\" must be an absolute pathname"
+ }
+ if ![file isdir $dir] {
+ error "\"$dir\" is not a directory"
+ }
+ return [_tixNormalize $dir]
+}
+
+# _tixNormalize --
+#
+# Normalizes an absolute pathname.
+#
+# $dir must be an absolute pathname
+#
+proc _tixNormalize {path} {
+ tixAssert {
+ if ![tixStrEq [string index $path 0] /] {
+ error "\"$path\" must be an absolute pathname"
+ }
+ }
+
+ # Don't be fooled: $path doesn't need to be a directory. The following
+ # code just makes it easy to get rid of trailing . and ..
+ #
+ set path $path/
+ regsub -all /+ $path / path
+ while 1 {
+ if ![regsub {/\./} $path "/" path] break
+ }
+ while 1 {
+ if ![regsub {/\.$} $path "" path] break
+ }
+
+ while 1 {
+ if ![regsub {/[^/]+/\.\./} $path "/" path] break
+ while 1 {
+ if ![regsub {^/\.\./} $path "/" path] break
+ }
+ }
+ while 1 {
+ if ![regsub {^/\.\./} $path "/" path] break
+ }
+
+ regsub {/$} $path "" path
+ if [tixStrEq $path ""] {
+ return /
+ } else {
+ return $path
+ }
+}
+
+# tixFSCreateDirs
+#
+#
+#
+proc tixFSCreateDirs {path} {
+ tixAssert {
+ error "Procedure tixFSCreateDirs not implemented on all platforms"
+ }
+ if [tixStrEq $path /] {
+ return 1
+ }
+ if [file exists $path] {
+ return 1
+ }
+ if ![tixFSCreateDirs [file dirname $path]] {
+ return 0
+ }
+ if [catch {exec mkdir $path}] {
+ return 0
+ }
+ return 1
+}
+
+} else {
+
+#-Win--------------------------------------------------------------------
+
+# (Win) tixFSPWD --
+#
+# Return the current directory
+#
+proc tixFSPWD {} {
+ set p [pwd]
+ regsub -all / $p \\ p
+ return $p
+}
+# Win
+#
+proc tixFSIsNorm {path} {
+
+ # Drive root directory
+ # CYGNUS LOCAL: drive can be immediately followed by directory separator.
+ #
+ if [regexp {^[A-z]:\\?$} $path] {
+ return 1
+ }
+
+ # If it is not a drive root directory, it must
+ # have a leading [drive letter:]\\[non empty string]
+ # CYGNUS LOCAL: A UNC path (\\host\dir) is also OK.
+ if ![regexp {^[A-z]:\\.} $path] {
+ if ![regexp {^\\\\.*\\.} $path] {
+ return 0
+ }
+ }
+
+ # relative path
+ #
+ if [regexp {\\[.]$} $path] {
+ return 0
+ }
+ if [regexp {\\[.][.]$} $path] {
+ return 0
+ }
+ if [regexp {\\[.]\\} $path] {
+ return 0
+ }
+ if [regexp {\\[.][.]\\} $path] {
+ return 0
+ }
+ if [tixStrEq $path .] {
+ return 0
+ }
+ if [tixStrEq $path ..] {
+ return 0
+ }
+
+ # Double slashes
+ # CYGNUS LOCAL: Double slashes at the front are OK.
+ #
+ if [regexp {.\\\\} $path] {
+ return 0
+ }
+
+ # Trailing slashes
+ #
+ if [regexp {[\\]$} $path] {
+ return 0
+ }
+
+ return 1
+}
+
+# (Win) tixFSNorm --
+#
+# Interprets the user's input and return file information about this
+# input.
+#
+# Arguments:
+# See documentation (docs/Files.txt)
+#
+proc tixFSNorm {context text {defFile ""} {flagsVar ""} {errorMsgVar ""}} {
+ tixAssert {
+ tixAssertVPath $context
+ }
+
+ if ![tixStrEq $errorMsgVar ""] {
+ upvar $errorMsgVar errorMsg
+ }
+ if ![tixStrEq $flagsVar ""] {
+ upvar $flagsVar flags
+ }
+
+ set isDir [regexp {[\\]$} $text]
+ set text [_tixJoin $context $text]
+ set path [tixFSPath $text]
+
+ if {$isDir || [file isdir $path]} {
+ set vpath $text
+ set tail $defFile
+ } else {
+ set list [split $text \\]
+ set tail [lindex $list end]
+ set len [string length $tail]
+ set vpath [string range $text 0 [expr [string len $text]-$len-1]]
+ regsub {[\\]$} $vpath "" vpath
+ }
+
+ set path [tixFSPath $vpath]
+
+ if ![info exists flag(noPattern)] {
+ set isPat 0
+ foreach char [split $tail ""] {
+ if {$char == "*" || $char == "?"} {
+ set isPat 1
+ break
+ }
+ }
+ if {$isPat} {
+ return [list $path $vpath "" $tail]
+ }
+ }
+
+ return [list $path $vpath $tail ""]
+}
+
+# Win
+#
+# _tixJoin -- [internal]
+#
+# Joins a pathname to a VPATH
+#
+proc _tixJoin {vp1 p2} {
+ if [tixFSIsAbsPath $p2] {
+ return [tixFSVPath [_tixNormalize $p2]]
+ } else {
+ return [tixFSVPath [_tixNormalize [tixFSPath $vp1]\\$p2]]
+ }
+}
+
+# (Win) tixFSIsAbsPath
+#
+# The Tcl "file pathtype" is buggy. E.g. C:\.\..\. is absolute, but
+# "file pathtype" thinks that it isn't
+#
+
+proc tixFSIsAbsPath {path} {
+ # CYGNUS LOCAL: Handle a UNC path (\\host\dir)
+ if [regexp {^\\\\.*\\.} $path] {
+ return 1
+ }
+ return [regexp {^[A-z]:\\} $path]
+}
+
+# (Win) tixFSIsNorm_os
+#
+# Returns true iff this pathname is normalized, in the OS native name
+# format
+#
+proc tixFSIsNorm_os {path} {
+ if [regexp {^[A-z]:[\\]$} $path] {
+ return 1
+ }
+ if [regexp {^[A-z]:$} $path] {
+ return 0
+ }
+
+ return [tixFSIsNorm $path]
+
+}
+
+# Win
+#
+# _tixNormalize --
+#
+# Normalizes an absolute pathname.
+#
+# $dir must be an absolute native pathname
+#
+proc _tixNormalize {abpath} {
+ tixAssert {
+ if ![tixFSIsAbsPath $abpath] {
+ error "\"$abpath\" must be an absolute pathname"
+ }
+ }
+
+ # CYGNUS LOCAL: Handle UNC paths (\\host\dir)
+ if [regexp {^\\\\.*\\.} $abpath] {
+ set drive "\\"
+ regsub {^\\} $abpath "" path
+ } else {
+ if ![regexp {^[A-z]:} $abpath drive] {
+ tixPanic "\"$abpath\" does not contain a drive letter"
+ }
+ set drive [string toupper $drive]
+
+ regsub {^[A-z]:} $abpath "" path
+ }
+
+ # Don't be fooled: $path doesn't need to be a directory. The following
+ # code "set path $path\\" just makes it easy to get rid of trailing
+ # . and ..
+ #
+ set path $path\\
+ regsub -all {[\\]+} $path \\ path
+ while 1 {
+ if ![regsub {\\[.]\\} $path "\\" path] break
+ }
+ while 1 {
+ if ![regsub {\\[.]$} $path "" path] break
+ }
+
+ while 1 {
+ if ![regsub {\\[^\\]+\\[.][.]\\} $path "\\" path] break
+ while 1 {
+ if ![regsub {^\\[.][.]\\} $path "\\" path] break
+ }
+ }
+ while 1 {
+ if ![regsub {^\\[.][.]\\} $path "\\" path] break
+ }
+
+ regsub {[\\]+$} $path "" path
+ return $drive$path
+}
+
+# Win
+#
+# tixFSNormDir --
+#
+# Normalizes a directory
+#
+proc tixFSNormDir {dir} {
+ if ![tixFSIsAbsPath $dir] {
+ error "\"$dir\" must be an absolute pathname"
+ }
+ if ![file isdir $dir] {
+ error "\"$dir\" is not a directory"
+ }
+ return [_tixNormalize $dir]
+}
+
+
+proc tixPanic {message} {
+ error $message
+}
+
+# tixFSIsValid --
+#
+# Checks whether a native pathname contains invalid characters.
+#
+proc tixFSIsValid {path} {
+ return 1
+}
+
+# Win
+#
+#
+proc tixFSIsVPath {vpath} {
+ global tixPriv
+ if $tixPriv(isWin95) {
+ # CYGNUS LOCAL: Accept UNC path (\\host\dir)
+ if [string match {xx\\xx\\\\\\*\\*} $vpath] {
+ return 1
+ }
+ return [string match {xx\\xx\\[A-z]:*} $vpath]
+ } else {
+ return [string match {xx\\[A-z]:*} $vpath]
+ }
+}
+
+# Win
+#
+# tixFSVPath --
+#
+# Converts a normalized native pathname to its VPATH
+#
+proc tixFSVPath {path} {
+ global tixPriv
+
+ tixAssert {
+ tixAssertNorm $path
+ }
+ return $tixPriv(WinPrefix)\\$path
+}
+
+# tixFSPath --
+#
+# Converts a vpath to a native pathname
+proc tixFSPath {vpath} {
+ global tixPriv
+ tixAssert {
+ tixAssertVPath $vpath
+ }
+ if $tixPriv(isWin95) {
+ set path [string range $vpath 6 end]
+ } else {
+ set path [string range $vpath 3 end]
+ }
+ regsub {:$} $path :\\ path
+
+ return $path
+}
+
+# tixFSDisplayName --
+#
+# Returns the name of a normalized path which is usually displayed by
+# the OS
+#
+proc tixFSDisplayName {normpath} {
+ tixAssert {
+ tixAssertNorm $normpath
+ }
+
+ if [regexp {^[A-z]:$} $normpath] {
+ return $normpath\\
+ } else {
+ return $normpath
+ }
+}
+
+
+tixInitFileCmpt:Win
+
+}
diff --git a/tix/library/pref/12Point.fs b/tix/library/pref/12Point.fs
new file mode 100644
index 00000000000..cf477270adf
--- /dev/null
+++ b/tix/library/pref/12Point.fs
@@ -0,0 +1,11 @@
+
+proc tixSetFontset {} {
+ global tixOption
+
+ set tixOption(font) -*-helvetica-medium-r-normal-*-12-*-*-*-*-*-*-*
+ set tixOption(bold_font) -*-helvetica-bold-r-normal-*-12-*-*-*-*-*-*-*
+ set tixOption(menu_font) -*-helvetica-bold-r-normal-*-12-*-*-*-*-*-*-*
+ set tixOption(italic_font) -*-helvetica-bold-o-normal-*-12-*-*-*-*-*-*-*
+ set tixOption(fixed_font) -*-courier-medium-r-*-*-12-*-*-*-*-*-*-*
+ set tixOption(border1) 1
+}
diff --git a/tix/library/pref/12Point.fsc b/tix/library/pref/12Point.fsc
new file mode 100644
index 00000000000..89790f76583
--- /dev/null
+++ b/tix/library/pref/12Point.fsc
@@ -0,0 +1,32 @@
+proc tixPref:InitFontSet:12Point {} {
+
+ global tixOption
+
+ set tixOption(font) -*-helvetica-medium-r-normal-*-12-*-*-*-*-*-*-*
+ set tixOption(bold_font) -*-helvetica-bold-r-normal-*-12-*-*-*-*-*-*-*
+ set tixOption(menu_font) -*-helvetica-bold-r-normal-*-12-*-*-*-*-*-*-*
+ set tixOption(italic_font) -*-helvetica-bold-o-normal-*-12-*-*-*-*-*-*-*
+ set tixOption(fixed_font) -*-courier-medium-r-*-*-12-*-*-*-*-*-*-*
+ set tixOption(border1) 1
+
+}
+proc tixPref:SetFontSet:12Point {} {
+global tixOption
+option add *Font $tixOption(font) $tixOption(prioLevel)
+option add *font $tixOption(font) $tixOption(prioLevel)
+option add *Menu.font $tixOption(menu_font) $tixOption(prioLevel)
+option add *TixMenu.font $tixOption(menu_font) $tixOption(prioLevel)
+option add *Menubutton.font $tixOption(menu_font) $tixOption(prioLevel)
+option add *Label.font $tixOption(bold_font) $tixOption(prioLevel)
+option add *Scale.font $tixOption(italic_font) $tixOption(prioLevel)
+option add *TixBalloon*Label.font $tixOption(font) $tixOption(prioLevel)
+option add *TixBitmapButton*label.font $tixOption(font) $tixOption(prioLevel)
+option add *TixControl*label.font $tixOption(bold_font) $tixOption(prioLevel)
+option add *TixLabelEntry*label.font $tixOption(bold_font) $tixOption(prioLevel)
+option add *TixLabelFrame*label.font $tixOption(bold_font) $tixOption(prioLevel)
+option add *TixMwmClient*title.font $tixOption(menu_font) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.font $tixOption(menu_font) $tixOption(prioLevel)
+option add *TixOptionMenu*menubutton.font $tixOption(font) $tixOption(prioLevel)
+option add *TixComboBox*Entry.font $tixOption(font) $tixOption(prioLevel)
+option add *TixFileSelectBox*Label.font $tixOption(bold_font) $tixOption(prioLevel)
+}
diff --git a/tix/library/pref/14Point.fs b/tix/library/pref/14Point.fs
new file mode 100644
index 00000000000..04768419e2d
--- /dev/null
+++ b/tix/library/pref/14Point.fs
@@ -0,0 +1,10 @@
+proc tixSetFontset {} {
+
+ global tixOption
+
+ set tixOption(font) -*-helvetica-medium-r-normal-*-14-*-*-*-*-*-*-*
+ set tixOption(bold_font) -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*
+ set tixOption(menu_font) -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*
+ set tixOption(italic_font) -*-helvetica-bold-o-normal-*-14-*-*-*-*-*-*-*
+ set tixOption(fixed_font) -*-courier-medium-r-*-*-14-*-*-*-*-*-*-*
+}
diff --git a/tix/library/pref/14Point.fsc b/tix/library/pref/14Point.fsc
new file mode 100644
index 00000000000..20acdd4ca03
--- /dev/null
+++ b/tix/library/pref/14Point.fsc
@@ -0,0 +1,32 @@
+proc tixPref:InitFontSet:14Point {} {
+
+
+ global tixOption
+
+ set tixOption(font) -*-helvetica-medium-r-normal-*-14-*-*-*-*-*-*-*
+ set tixOption(bold_font) -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*
+ set tixOption(menu_font) -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*
+ set tixOption(italic_font) -*-helvetica-bold-o-normal-*-14-*-*-*-*-*-*-*
+ set tixOption(fixed_font) -*-courier-medium-r-*-*-14-*-*-*-*-*-*-*
+
+}
+proc tixPref:SetFontSet:14Point {} {
+global tixOption
+option add *Font $tixOption(font) $tixOption(prioLevel)
+option add *font $tixOption(font) $tixOption(prioLevel)
+option add *Menu.font $tixOption(menu_font) $tixOption(prioLevel)
+option add *TixMenu.font $tixOption(menu_font) $tixOption(prioLevel)
+option add *Menubutton.font $tixOption(menu_font) $tixOption(prioLevel)
+option add *Label.font $tixOption(bold_font) $tixOption(prioLevel)
+option add *Scale.font $tixOption(italic_font) $tixOption(prioLevel)
+option add *TixBalloon*Label.font $tixOption(font) $tixOption(prioLevel)
+option add *TixBitmapButton*label.font $tixOption(font) $tixOption(prioLevel)
+option add *TixControl*label.font $tixOption(bold_font) $tixOption(prioLevel)
+option add *TixLabelEntry*label.font $tixOption(bold_font) $tixOption(prioLevel)
+option add *TixLabelFrame*label.font $tixOption(bold_font) $tixOption(prioLevel)
+option add *TixMwmClient*title.font $tixOption(menu_font) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.font $tixOption(menu_font) $tixOption(prioLevel)
+option add *TixOptionMenu*menubutton.font $tixOption(font) $tixOption(prioLevel)
+option add *TixComboBox*Entry.font $tixOption(font) $tixOption(prioLevel)
+option add *TixFileSelectBox*Label.font $tixOption(bold_font) $tixOption(prioLevel)
+}
diff --git a/tix/library/pref/Bisque.cs b/tix/library/pref/Bisque.cs
new file mode 100644
index 00000000000..66c5c7a0eea
--- /dev/null
+++ b/tix/library/pref/Bisque.cs
@@ -0,0 +1,32 @@
+proc tixSetScheme-Color {} {
+ global tixOption
+
+ set tixOption(bg) bisque1
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) bisque2
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) bisque3
+ set tixOption(dark2_fg) black
+ set tixOption(inactive_bg) bisque3
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) bisque1
+ set tixOption(light1_fg) white
+ set tixOption(light2_bg) bisque1
+ set tixOption(light2_fg) white
+
+ set tixOption(active_bg) $tixOption(dark1_bg)
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray55
+
+ set tixOption(input1_bg) bisque2
+ set tixOption(input2_bg) bisque2
+ set tixOption(output1_bg) $tixOption(dark1_bg)
+ set tixOption(output2_bg) $tixOption(bg)
+
+ set tixOption(select_fg) black
+ set tixOption(select_bg) bisque2
+
+ set tixOption(selector) #b03060
+}
diff --git a/tix/library/pref/Bisque.csc b/tix/library/pref/Bisque.csc
new file mode 100644
index 00000000000..3048691ec17
--- /dev/null
+++ b/tix/library/pref/Bisque.csc
@@ -0,0 +1,335 @@
+proc tixPref:SetScheme-Color:Bisque {} {
+
+ global tixOption
+
+ set tixOption(bg) bisque1
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) bisque2
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) bisque3
+ set tixOption(dark2_fg) black
+ set tixOption(inactive_bg) bisque3
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) bisque1
+ set tixOption(light1_fg) white
+ set tixOption(light2_bg) bisque1
+ set tixOption(light2_fg) white
+
+ set tixOption(active_bg) $tixOption(dark1_bg)
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray55
+
+ set tixOption(input1_bg) bisque2
+ set tixOption(input2_bg) bisque2
+ set tixOption(output1_bg) $tixOption(dark1_bg)
+ set tixOption(output2_bg) $tixOption(bg)
+
+ set tixOption(select_fg) black
+ set tixOption(select_bg) bisque2
+
+ set tixOption(selector) #b03060
+
+option add *background $tixOption(bg) 10
+option add *Background $tixOption(bg) $tixOption(prioLevel)
+option add *background $tixOption(bg) $tixOption(prioLevel)
+option add *Foreground $tixOption(fg) $tixOption(prioLevel)
+option add *foreground $tixOption(fg) $tixOption(prioLevel)
+option add *activeBackground $tixOption(active_bg) $tixOption(prioLevel)
+option add *activeForeground $tixOption(active_fg) $tixOption(prioLevel)
+option add *HighlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *selectBackground $tixOption(select_bg) $tixOption(prioLevel)
+option add *selectForeground $tixOption(select_fg) $tixOption(prioLevel)
+option add *selectBorderWidth 0 $tixOption(prioLevel)
+option add *Menu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *TixMenu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Menubutton.padY 5 $tixOption(prioLevel)
+option add *Button.borderWidth 2 $tixOption(prioLevel)
+option add *Button.anchor c $tixOption(prioLevel)
+option add *Checkbutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Radiobutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Entry.relief sunken $tixOption(prioLevel)
+option add *Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Entry.foreground black $tixOption(prioLevel)
+option add *Entry.insertBackground black $tixOption(prioLevel)
+option add *Label.anchor w $tixOption(prioLevel)
+option add *Label.borderWidth 0 $tixOption(prioLevel)
+option add *Listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Listbox.relief sunken $tixOption(prioLevel)
+option add *Scale.foreground $tixOption(fg) $tixOption(prioLevel)
+option add *Scale.activeForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.relief sunken $tixOption(prioLevel)
+option add *Scrollbar.borderWidth 1 $tixOption(prioLevel)
+option add *Scrollbar.width 15 $tixOption(prioLevel)
+option add *Text.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Text.relief sunken $tixOption(prioLevel)
+option add *TixBalloon*background "#ffff60" $tixOption(prioLevel)
+option add *TixBalloon*foreground black $tixOption(prioLevel)
+option add *TixBalloon.background black $tixOption(prioLevel)
+option add *TixBalloon*Label.anchor w $tixOption(prioLevel)
+option add *TixControl*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixControl*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixControl*entry.foreground black $tixOption(prioLevel)
+option add *TixControl*entry.insertBackground black $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirList*f1.relief sunken $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixScrolledHList*f1.relief sunken $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixFileEntry*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixHList.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.foreground black $tixOption(prioLevel)
+option add *TixLabelEntry*entry.insertBackground black $tixOption(prioLevel)
+option add *TixMultiList*Listbox.borderWidth 0 $tixOption(prioLevel)
+option add *TixMultiList*Listbox.highlightThickness 0 $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.width 15 $tixOption(prioLevel)
+option add *TixMultiList*f1.borderWidth 2 $tixOption(prioLevel)
+option add *TixMultiList*f1.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*f1.highlightThickness 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.relief raised $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.borderWidth 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*Menubutton.padY 2 $tixOption(prioLevel)
+option add *TixNoteBook.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.backPageColor $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.inactiveBackground $tixOption(inactive_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleActiveBg $tixOption(active_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.seperatorBg $tixOption(bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleBg $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixPopupMenu*menubutton.background $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow.frame.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.borderWidth 1 $tixOption(prioLevel)
+option add *TixComboBox*Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.foreground black $tixOption(prioLevel)
+option add *TixComboBox*Entry.insertBackground black $tixOption(prioLevel)
+}
+proc tixPref:SetScheme-Mono:Bisque {} {
+
+
+ global tixOption
+
+ set tixOption(bg) lightgray
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) gray70
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) gray60
+ set tixOption(dark2_fg) white
+ set tixOption(inactive_bg) lightgray
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) gray90
+ set tixOption(light1_fg) white
+ set tixOption(light2_bg) gray95
+ set tixOption(light2_fg) white
+
+ set tixOption(active_bg) gray90
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray55
+
+ set tixOption(input1_bg) $tixOption(light1_bg)
+ set tixOption(input2_bg) $tixOption(light1_bg)
+ set tixOption(output1_bg) $tixOption(light1_bg)
+ set tixOption(output2_bg) $tixOption(light1_bg)
+
+ set tixOption(select_fg) white
+ set tixOption(select_bg) black
+
+ set tixOption(selector) black
+
+option add *background $tixOption(bg) 10
+option add *Background $tixOption(bg) $tixOption(prioLevel)
+option add *background $tixOption(bg) $tixOption(prioLevel)
+option add *Foreground $tixOption(fg) $tixOption(prioLevel)
+option add *foreground $tixOption(fg) $tixOption(prioLevel)
+option add *activeBackground $tixOption(active_bg) $tixOption(prioLevel)
+option add *activeForeground $tixOption(active_fg) $tixOption(prioLevel)
+option add *HighlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *selectBackground $tixOption(select_bg) $tixOption(prioLevel)
+option add *selectForeground $tixOption(select_fg) $tixOption(prioLevel)
+option add *selectBorderWidth 0 $tixOption(prioLevel)
+option add *Menu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *TixMenu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Menubutton.padY 5 $tixOption(prioLevel)
+option add *Button.borderWidth 2 $tixOption(prioLevel)
+option add *Button.anchor c $tixOption(prioLevel)
+option add *Checkbutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Radiobutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Entry.relief sunken $tixOption(prioLevel)
+option add *Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Entry.foreground black $tixOption(prioLevel)
+option add *Entry.insertBackground black $tixOption(prioLevel)
+option add *Label.anchor w $tixOption(prioLevel)
+option add *Label.borderWidth 0 $tixOption(prioLevel)
+option add *Listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Listbox.relief sunken $tixOption(prioLevel)
+option add *Scale.foreground $tixOption(fg) $tixOption(prioLevel)
+option add *Scale.activeForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.relief sunken $tixOption(prioLevel)
+option add *Scrollbar.borderWidth 1 $tixOption(prioLevel)
+option add *Scrollbar.width 15 $tixOption(prioLevel)
+option add *Text.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Text.relief sunken $tixOption(prioLevel)
+option add *TixBalloon*background "#ffff60" $tixOption(prioLevel)
+option add *TixBalloon*foreground black $tixOption(prioLevel)
+option add *TixBalloon.background black $tixOption(prioLevel)
+option add *TixBalloon*Label.anchor w $tixOption(prioLevel)
+option add *TixControl*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixControl*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixControl*entry.foreground black $tixOption(prioLevel)
+option add *TixControl*entry.insertBackground black $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirList*f1.relief sunken $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixScrolledHList*f1.relief sunken $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixFileEntry*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixHList.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.foreground black $tixOption(prioLevel)
+option add *TixLabelEntry*entry.insertBackground black $tixOption(prioLevel)
+option add *TixMultiList*Listbox.borderWidth 0 $tixOption(prioLevel)
+option add *TixMultiList*Listbox.highlightThickness 0 $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.width 15 $tixOption(prioLevel)
+option add *TixMultiList*f1.borderWidth 2 $tixOption(prioLevel)
+option add *TixMultiList*f1.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*f1.highlightThickness 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.relief raised $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.borderWidth 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*Menubutton.padY 2 $tixOption(prioLevel)
+option add *TixNoteBook.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.backPageColor $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.inactiveBackground $tixOption(inactive_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleActiveBg $tixOption(active_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.seperatorBg $tixOption(bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleBg $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixPopupMenu*menubutton.background $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow.frame.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.borderWidth 1 $tixOption(prioLevel)
+option add *TixComboBox*Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.foreground black $tixOption(prioLevel)
+option add *TixComboBox*Entry.insertBackground black $tixOption(prioLevel)
+}
diff --git a/tix/library/pref/Blue.cs b/tix/library/pref/Blue.cs
new file mode 100644
index 00000000000..8b69ab2eb2a
--- /dev/null
+++ b/tix/library/pref/Blue.cs
@@ -0,0 +1,32 @@
+proc tixSetScheme-Color {} {
+ global tixOption
+
+ set tixOption(bg) #9090f0
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) #8080d0
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) #7070c0
+ set tixOption(dark2_fg) black
+ set tixOption(inactive_bg) #8080da
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) #a8a8ff
+ set tixOption(light1_fg) black
+ set tixOption(light2_bg) #c0c0ff
+ set tixOption(light2_fg) black
+
+ set tixOption(active_bg) $tixOption(dark1_bg)
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray25
+
+ set tixOption(input1_bg) $tixOption(light1_bg)
+ set tixOption(input2_bg) $tixOption(bg)
+ set tixOption(output1_bg) $tixOption(light1_bg)
+ set tixOption(output2_bg) $tixOption(bg)
+
+ set tixOption(select_fg) white
+ set tixOption(select_bg) black
+
+ set tixOption(selector) yellow
+}
diff --git a/tix/library/pref/Blue.csc b/tix/library/pref/Blue.csc
new file mode 100644
index 00000000000..32bf64df1a0
--- /dev/null
+++ b/tix/library/pref/Blue.csc
@@ -0,0 +1,335 @@
+proc tixPref:SetScheme-Color:Blue {} {
+
+ global tixOption
+
+ set tixOption(bg) #9090f0
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) #8080d0
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) #7070c0
+ set tixOption(dark2_fg) black
+ set tixOption(inactive_bg) #8080da
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) #a8a8ff
+ set tixOption(light1_fg) black
+ set tixOption(light2_bg) #c0c0ff
+ set tixOption(light2_fg) black
+
+ set tixOption(active_bg) $tixOption(dark1_bg)
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray25
+
+ set tixOption(input1_bg) $tixOption(light1_bg)
+ set tixOption(input2_bg) $tixOption(bg)
+ set tixOption(output1_bg) $tixOption(light1_bg)
+ set tixOption(output2_bg) $tixOption(bg)
+
+ set tixOption(select_fg) white
+ set tixOption(select_bg) black
+
+ set tixOption(selector) yellow
+
+option add *background $tixOption(bg) 10
+option add *Background $tixOption(bg) $tixOption(prioLevel)
+option add *background $tixOption(bg) $tixOption(prioLevel)
+option add *Foreground $tixOption(fg) $tixOption(prioLevel)
+option add *foreground $tixOption(fg) $tixOption(prioLevel)
+option add *activeBackground $tixOption(active_bg) $tixOption(prioLevel)
+option add *activeForeground $tixOption(active_fg) $tixOption(prioLevel)
+option add *HighlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *selectBackground $tixOption(select_bg) $tixOption(prioLevel)
+option add *selectForeground $tixOption(select_fg) $tixOption(prioLevel)
+option add *selectBorderWidth 0 $tixOption(prioLevel)
+option add *Menu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *TixMenu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Menubutton.padY 5 $tixOption(prioLevel)
+option add *Button.borderWidth 2 $tixOption(prioLevel)
+option add *Button.anchor c $tixOption(prioLevel)
+option add *Checkbutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Radiobutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Entry.relief sunken $tixOption(prioLevel)
+option add *Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Entry.foreground black $tixOption(prioLevel)
+option add *Entry.insertBackground black $tixOption(prioLevel)
+option add *Label.anchor w $tixOption(prioLevel)
+option add *Label.borderWidth 0 $tixOption(prioLevel)
+option add *Listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Listbox.relief sunken $tixOption(prioLevel)
+option add *Scale.foreground $tixOption(fg) $tixOption(prioLevel)
+option add *Scale.activeForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.relief sunken $tixOption(prioLevel)
+option add *Scrollbar.borderWidth 1 $tixOption(prioLevel)
+option add *Scrollbar.width 15 $tixOption(prioLevel)
+option add *Text.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Text.relief sunken $tixOption(prioLevel)
+option add *TixBalloon*background "#ffff60" $tixOption(prioLevel)
+option add *TixBalloon*foreground black $tixOption(prioLevel)
+option add *TixBalloon.background black $tixOption(prioLevel)
+option add *TixBalloon*Label.anchor w $tixOption(prioLevel)
+option add *TixControl*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixControl*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixControl*entry.foreground black $tixOption(prioLevel)
+option add *TixControl*entry.insertBackground black $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirList*f1.relief sunken $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixScrolledHList*f1.relief sunken $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixFileEntry*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixHList.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.foreground black $tixOption(prioLevel)
+option add *TixLabelEntry*entry.insertBackground black $tixOption(prioLevel)
+option add *TixMultiList*Listbox.borderWidth 0 $tixOption(prioLevel)
+option add *TixMultiList*Listbox.highlightThickness 0 $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.width 15 $tixOption(prioLevel)
+option add *TixMultiList*f1.borderWidth 2 $tixOption(prioLevel)
+option add *TixMultiList*f1.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*f1.highlightThickness 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.relief raised $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.borderWidth 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*Menubutton.padY 2 $tixOption(prioLevel)
+option add *TixNoteBook.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.backPageColor $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.inactiveBackground $tixOption(inactive_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleActiveBg $tixOption(active_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.seperatorBg $tixOption(bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleBg $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixPopupMenu*menubutton.background $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow.frame.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.borderWidth 1 $tixOption(prioLevel)
+option add *TixComboBox*Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.foreground black $tixOption(prioLevel)
+option add *TixComboBox*Entry.insertBackground black $tixOption(prioLevel)
+}
+proc tixPref:SetScheme-Mono:Blue {} {
+
+
+ global tixOption
+
+ set tixOption(bg) lightgray
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) gray70
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) gray60
+ set tixOption(dark2_fg) white
+ set tixOption(inactive_bg) lightgray
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) gray90
+ set tixOption(light1_fg) white
+ set tixOption(light2_bg) gray95
+ set tixOption(light2_fg) white
+
+ set tixOption(active_bg) gray90
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray55
+
+ set tixOption(input1_bg) $tixOption(light1_bg)
+ set tixOption(input2_bg) $tixOption(light1_bg)
+ set tixOption(output1_bg) $tixOption(light1_bg)
+ set tixOption(output2_bg) $tixOption(light1_bg)
+
+ set tixOption(select_fg) white
+ set tixOption(select_bg) black
+
+ set tixOption(selector) black
+
+option add *background $tixOption(bg) 10
+option add *Background $tixOption(bg) $tixOption(prioLevel)
+option add *background $tixOption(bg) $tixOption(prioLevel)
+option add *Foreground $tixOption(fg) $tixOption(prioLevel)
+option add *foreground $tixOption(fg) $tixOption(prioLevel)
+option add *activeBackground $tixOption(active_bg) $tixOption(prioLevel)
+option add *activeForeground $tixOption(active_fg) $tixOption(prioLevel)
+option add *HighlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *selectBackground $tixOption(select_bg) $tixOption(prioLevel)
+option add *selectForeground $tixOption(select_fg) $tixOption(prioLevel)
+option add *selectBorderWidth 0 $tixOption(prioLevel)
+option add *Menu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *TixMenu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Menubutton.padY 5 $tixOption(prioLevel)
+option add *Button.borderWidth 2 $tixOption(prioLevel)
+option add *Button.anchor c $tixOption(prioLevel)
+option add *Checkbutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Radiobutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Entry.relief sunken $tixOption(prioLevel)
+option add *Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Entry.foreground black $tixOption(prioLevel)
+option add *Entry.insertBackground black $tixOption(prioLevel)
+option add *Label.anchor w $tixOption(prioLevel)
+option add *Label.borderWidth 0 $tixOption(prioLevel)
+option add *Listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Listbox.relief sunken $tixOption(prioLevel)
+option add *Scale.foreground $tixOption(fg) $tixOption(prioLevel)
+option add *Scale.activeForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.relief sunken $tixOption(prioLevel)
+option add *Scrollbar.borderWidth 1 $tixOption(prioLevel)
+option add *Scrollbar.width 15 $tixOption(prioLevel)
+option add *Text.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Text.relief sunken $tixOption(prioLevel)
+option add *TixBalloon*background "#ffff60" $tixOption(prioLevel)
+option add *TixBalloon*foreground black $tixOption(prioLevel)
+option add *TixBalloon.background black $tixOption(prioLevel)
+option add *TixBalloon*Label.anchor w $tixOption(prioLevel)
+option add *TixControl*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixControl*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixControl*entry.foreground black $tixOption(prioLevel)
+option add *TixControl*entry.insertBackground black $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirList*f1.relief sunken $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixScrolledHList*f1.relief sunken $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixFileEntry*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixHList.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.foreground black $tixOption(prioLevel)
+option add *TixLabelEntry*entry.insertBackground black $tixOption(prioLevel)
+option add *TixMultiList*Listbox.borderWidth 0 $tixOption(prioLevel)
+option add *TixMultiList*Listbox.highlightThickness 0 $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.width 15 $tixOption(prioLevel)
+option add *TixMultiList*f1.borderWidth 2 $tixOption(prioLevel)
+option add *TixMultiList*f1.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*f1.highlightThickness 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.relief raised $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.borderWidth 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*Menubutton.padY 2 $tixOption(prioLevel)
+option add *TixNoteBook.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.backPageColor $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.inactiveBackground $tixOption(inactive_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleActiveBg $tixOption(active_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.seperatorBg $tixOption(bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleBg $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixPopupMenu*menubutton.background $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow.frame.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.borderWidth 1 $tixOption(prioLevel)
+option add *TixComboBox*Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.foreground black $tixOption(prioLevel)
+option add *TixComboBox*Entry.insertBackground black $tixOption(prioLevel)
+}
diff --git a/tix/library/pref/Gray.cs b/tix/library/pref/Gray.cs
new file mode 100644
index 00000000000..2aca521d93e
--- /dev/null
+++ b/tix/library/pref/Gray.cs
@@ -0,0 +1,33 @@
+proc tixSetScheme-Color {} {
+
+ global tixOption
+
+ set tixOption(bg) lightgray
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) gray
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) gray50
+ set tixOption(dark2_fg) black
+ set tixOption(inactive_bg) gray50
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) gray90
+ set tixOption(light1_fg) white
+ set tixOption(light2_bg) gray95
+ set tixOption(light2_fg) white
+
+ set tixOption(active_bg) $tixOption(dark1_bg)
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray55
+
+ set tixOption(input1_bg) $tixOption(dark1_bg)
+ set tixOption(input2_bg) $tixOption(bg)
+ set tixOption(output1_bg) $tixOption(dark1_bg)
+ set tixOption(output2_bg) $tixOption(bg)
+
+ set tixOption(select_fg) black
+ set tixOption(select_bg) lightblue
+
+ set tixOption(selector) yellow
+}
diff --git a/tix/library/pref/Gray.csc b/tix/library/pref/Gray.csc
new file mode 100644
index 00000000000..f98d8b34ebb
--- /dev/null
+++ b/tix/library/pref/Gray.csc
@@ -0,0 +1,336 @@
+proc tixPref:SetScheme-Color:Gray {} {
+
+
+ global tixOption
+
+ set tixOption(bg) lightgray
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) gray
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) gray50
+ set tixOption(dark2_fg) black
+ set tixOption(inactive_bg) gray50
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) gray90
+ set tixOption(light1_fg) white
+ set tixOption(light2_bg) gray95
+ set tixOption(light2_fg) white
+
+ set tixOption(active_bg) $tixOption(dark1_bg)
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray55
+
+ set tixOption(input1_bg) $tixOption(dark1_bg)
+ set tixOption(input2_bg) $tixOption(bg)
+ set tixOption(output1_bg) $tixOption(dark1_bg)
+ set tixOption(output2_bg) $tixOption(bg)
+
+ set tixOption(select_fg) black
+ set tixOption(select_bg) lightblue
+
+ set tixOption(selector) yellow
+
+option add *background $tixOption(bg) 10
+option add *Background $tixOption(bg) $tixOption(prioLevel)
+option add *background $tixOption(bg) $tixOption(prioLevel)
+option add *Foreground $tixOption(fg) $tixOption(prioLevel)
+option add *foreground $tixOption(fg) $tixOption(prioLevel)
+option add *activeBackground $tixOption(active_bg) $tixOption(prioLevel)
+option add *activeForeground $tixOption(active_fg) $tixOption(prioLevel)
+option add *HighlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *selectBackground $tixOption(select_bg) $tixOption(prioLevel)
+option add *selectForeground $tixOption(select_fg) $tixOption(prioLevel)
+option add *selectBorderWidth 0 $tixOption(prioLevel)
+option add *Menu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *TixMenu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Menubutton.padY 5 $tixOption(prioLevel)
+option add *Button.borderWidth 2 $tixOption(prioLevel)
+option add *Button.anchor c $tixOption(prioLevel)
+option add *Checkbutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Radiobutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Entry.relief sunken $tixOption(prioLevel)
+option add *Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Entry.foreground black $tixOption(prioLevel)
+option add *Entry.insertBackground black $tixOption(prioLevel)
+option add *Label.anchor w $tixOption(prioLevel)
+option add *Label.borderWidth 0 $tixOption(prioLevel)
+option add *Listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Listbox.relief sunken $tixOption(prioLevel)
+option add *Scale.foreground $tixOption(fg) $tixOption(prioLevel)
+option add *Scale.activeForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.relief sunken $tixOption(prioLevel)
+option add *Scrollbar.borderWidth 1 $tixOption(prioLevel)
+option add *Scrollbar.width 15 $tixOption(prioLevel)
+option add *Text.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Text.relief sunken $tixOption(prioLevel)
+option add *TixBalloon*background "#ffff60" $tixOption(prioLevel)
+option add *TixBalloon*foreground black $tixOption(prioLevel)
+option add *TixBalloon.background black $tixOption(prioLevel)
+option add *TixBalloon*Label.anchor w $tixOption(prioLevel)
+option add *TixControl*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixControl*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixControl*entry.foreground black $tixOption(prioLevel)
+option add *TixControl*entry.insertBackground black $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirList*f1.relief sunken $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixScrolledHList*f1.relief sunken $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixFileEntry*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixHList.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.foreground black $tixOption(prioLevel)
+option add *TixLabelEntry*entry.insertBackground black $tixOption(prioLevel)
+option add *TixMultiList*Listbox.borderWidth 0 $tixOption(prioLevel)
+option add *TixMultiList*Listbox.highlightThickness 0 $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.width 15 $tixOption(prioLevel)
+option add *TixMultiList*f1.borderWidth 2 $tixOption(prioLevel)
+option add *TixMultiList*f1.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*f1.highlightThickness 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.relief raised $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.borderWidth 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*Menubutton.padY 2 $tixOption(prioLevel)
+option add *TixNoteBook.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.backPageColor $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.inactiveBackground $tixOption(inactive_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleActiveBg $tixOption(active_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.seperatorBg $tixOption(bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleBg $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixPopupMenu*menubutton.background $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow.frame.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.borderWidth 1 $tixOption(prioLevel)
+option add *TixComboBox*Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.foreground black $tixOption(prioLevel)
+option add *TixComboBox*Entry.insertBackground black $tixOption(prioLevel)
+}
+proc tixPref:SetScheme-Mono:Gray {} {
+
+
+ global tixOption
+
+ set tixOption(bg) lightgray
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) gray70
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) gray60
+ set tixOption(dark2_fg) white
+ set tixOption(inactive_bg) lightgray
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) gray90
+ set tixOption(light1_fg) white
+ set tixOption(light2_bg) gray95
+ set tixOption(light2_fg) white
+
+ set tixOption(active_bg) gray90
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray55
+
+ set tixOption(input1_bg) $tixOption(light1_bg)
+ set tixOption(input2_bg) $tixOption(light1_bg)
+ set tixOption(output1_bg) $tixOption(light1_bg)
+ set tixOption(output2_bg) $tixOption(light1_bg)
+
+ set tixOption(select_fg) white
+ set tixOption(select_bg) black
+
+ set tixOption(selector) black
+
+option add *background $tixOption(bg) 10
+option add *Background $tixOption(bg) $tixOption(prioLevel)
+option add *background $tixOption(bg) $tixOption(prioLevel)
+option add *Foreground $tixOption(fg) $tixOption(prioLevel)
+option add *foreground $tixOption(fg) $tixOption(prioLevel)
+option add *activeBackground $tixOption(active_bg) $tixOption(prioLevel)
+option add *activeForeground $tixOption(active_fg) $tixOption(prioLevel)
+option add *HighlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *selectBackground $tixOption(select_bg) $tixOption(prioLevel)
+option add *selectForeground $tixOption(select_fg) $tixOption(prioLevel)
+option add *selectBorderWidth 0 $tixOption(prioLevel)
+option add *Menu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *TixMenu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Menubutton.padY 5 $tixOption(prioLevel)
+option add *Button.borderWidth 2 $tixOption(prioLevel)
+option add *Button.anchor c $tixOption(prioLevel)
+option add *Checkbutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Radiobutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Entry.relief sunken $tixOption(prioLevel)
+option add *Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Entry.foreground black $tixOption(prioLevel)
+option add *Entry.insertBackground black $tixOption(prioLevel)
+option add *Label.anchor w $tixOption(prioLevel)
+option add *Label.borderWidth 0 $tixOption(prioLevel)
+option add *Listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Listbox.relief sunken $tixOption(prioLevel)
+option add *Scale.foreground $tixOption(fg) $tixOption(prioLevel)
+option add *Scale.activeForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.relief sunken $tixOption(prioLevel)
+option add *Scrollbar.borderWidth 1 $tixOption(prioLevel)
+option add *Scrollbar.width 15 $tixOption(prioLevel)
+option add *Text.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Text.relief sunken $tixOption(prioLevel)
+option add *TixBalloon*background "#ffff60" $tixOption(prioLevel)
+option add *TixBalloon*foreground black $tixOption(prioLevel)
+option add *TixBalloon.background black $tixOption(prioLevel)
+option add *TixBalloon*Label.anchor w $tixOption(prioLevel)
+option add *TixControl*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixControl*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixControl*entry.foreground black $tixOption(prioLevel)
+option add *TixControl*entry.insertBackground black $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirList*f1.relief sunken $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixScrolledHList*f1.relief sunken $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixFileEntry*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixHList.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.foreground black $tixOption(prioLevel)
+option add *TixLabelEntry*entry.insertBackground black $tixOption(prioLevel)
+option add *TixMultiList*Listbox.borderWidth 0 $tixOption(prioLevel)
+option add *TixMultiList*Listbox.highlightThickness 0 $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.width 15 $tixOption(prioLevel)
+option add *TixMultiList*f1.borderWidth 2 $tixOption(prioLevel)
+option add *TixMultiList*f1.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*f1.highlightThickness 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.relief raised $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.borderWidth 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*Menubutton.padY 2 $tixOption(prioLevel)
+option add *TixNoteBook.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.backPageColor $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.inactiveBackground $tixOption(inactive_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleActiveBg $tixOption(active_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.seperatorBg $tixOption(bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleBg $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixPopupMenu*menubutton.background $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow.frame.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.borderWidth 1 $tixOption(prioLevel)
+option add *TixComboBox*Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.foreground black $tixOption(prioLevel)
+option add *TixComboBox*Entry.insertBackground black $tixOption(prioLevel)
+}
diff --git a/tix/library/pref/Makefile b/tix/library/pref/Makefile
new file mode 100644
index 00000000000..f3a724c2879
--- /dev/null
+++ b/tix/library/pref/Makefile
@@ -0,0 +1,45 @@
+# WARNING
+#
+# This Makefile is NOT for installation purposes. Please read the file
+# docs/Install.html for information about installing Tix.
+#
+#
+#
+#
+#
+#
+# fs = font scheme source
+# cs = color scheme source
+#
+# fsc = font scheme compiled
+# csc = color scheme compiled
+#
+
+
+.SUFFIXES: .fs .cs .csc .fsc
+
+all:: FONT_PREF COLOR_PREF
+
+FONT_SRC = 14Point.fs 12Point.fs TK.fs
+
+FONT_PREF:: ${FONT_SRC:.fs=.fsc}
+
+COLOR_SRC = Bisque.cs Blue.cs Gray.cs SGIGray.cs TixGray.cs TK.cs
+
+COLOR_PREF:: ${COLOR_SRC:.cs=.csc}
+
+fresh::
+ -rm -f ${COLOR_SRC:.cs=.csc} FONT_PREF:: ${FONT_SRC:.fs=.fsc}
+ make
+
+.cs.csc:
+ tixmkpref -color $< > $@
+
+.fs.fsc:
+ tixmkpref -font $< > $@
+
+distclean:
+ - rm -f *.a *.o core errs *~ \#* TAGS *.E a.out errors \
+ *.ps
+
+clean:: distclean
diff --git a/tix/library/pref/Old12Pt.fs b/tix/library/pref/Old12Pt.fs
new file mode 100644
index 00000000000..4e62760dbc8
--- /dev/null
+++ b/tix/library/pref/Old12Pt.fs
@@ -0,0 +1,11 @@
+
+proc tixSetFontset:12Point {} {
+ global tixOption
+
+ set tixOption(font) -*-helvetica-medium-r-normal-*-12-*-*-*-*-*-*-*
+ set tixOption(bold_font) -*-helvetica-bold-r-normal-*-12-*-*-*-*-*-*-*
+ set tixOption(menu_font) -*-helvetica-bold-o-normal-*-12-*-*-*-*-*-*-*
+ set tixOption(italic_font) -*-helvetica-bold-o-normal-*-12-*-*-*-*-*-*-*
+ set tixOption(fixed_font) -*-courier-medium-r-*-*-12-*-*-*-*-*-*-*
+ set tixOption(border1) 1
+}
diff --git a/tix/library/pref/Old14Pt.fs b/tix/library/pref/Old14Pt.fs
new file mode 100644
index 00000000000..d562eab4880
--- /dev/null
+++ b/tix/library/pref/Old14Pt.fs
@@ -0,0 +1,10 @@
+proc tixSetFontset {} {
+
+ global tixOption
+
+ set tixOption(font) -*-helvetica-medium-r-normal-*-14-*-*-*-*-*-*-*
+ set tixOption(bold_font) -*-helvetica-bold-r-normal-*-14-*-*-*-*-*-*-*
+ set tixOption(menu_font) -*-helvetica-bold-o-normal-*-14-*-*-*-*-*-*-*
+ set tixOption(italic_font) -*-helvetica-bold-o-normal-*-14-*-*-*-*-*-*-*
+ set tixOption(fixed_font) -*-courier-medium-r-*-*-14-*-*-*-*-*-*-*
+}
diff --git a/tix/library/pref/SGIGray.cs b/tix/library/pref/SGIGray.cs
new file mode 100644
index 00000000000..eeb255f0258
--- /dev/null
+++ b/tix/library/pref/SGIGray.cs
@@ -0,0 +1,35 @@
+proc tixSetScheme-Color {} {
+
+ global tixOption
+
+ set tixOption(bg) lightgray
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) gray
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) gray50
+ set tixOption(dark2_fg) black
+ set tixOption(inactive_bg) gray50
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) gray90
+ set tixOption(light1_fg) white
+ set tixOption(light2_bg) gray95
+ set tixOption(light2_fg) white
+
+ set tixOption(active_bg) $tixOption(bg)
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray35
+
+ set tixOption(input1_bg) rosybrown
+ set tixOption(input2_bg) rosybrown
+ set tixOption(output1_bg) $tixOption(dark1_bg)
+ set tixOption(output2_bg) $tixOption(bg)
+
+ set tixOption(select_fg) black
+ set tixOption(select_bg) lightblue
+
+ set tixOption(selector) yellow
+}
+
+
diff --git a/tix/library/pref/SGIGray.csc b/tix/library/pref/SGIGray.csc
new file mode 100644
index 00000000000..6b4f974beb0
--- /dev/null
+++ b/tix/library/pref/SGIGray.csc
@@ -0,0 +1,336 @@
+proc tixPref:SetScheme-Color:SGIGray {} {
+
+
+ global tixOption
+
+ set tixOption(bg) lightgray
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) gray
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) gray50
+ set tixOption(dark2_fg) black
+ set tixOption(inactive_bg) gray50
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) gray90
+ set tixOption(light1_fg) white
+ set tixOption(light2_bg) gray95
+ set tixOption(light2_fg) white
+
+ set tixOption(active_bg) $tixOption(bg)
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray35
+
+ set tixOption(input1_bg) rosybrown
+ set tixOption(input2_bg) rosybrown
+ set tixOption(output1_bg) $tixOption(dark1_bg)
+ set tixOption(output2_bg) $tixOption(bg)
+
+ set tixOption(select_fg) black
+ set tixOption(select_bg) lightblue
+
+ set tixOption(selector) yellow
+
+option add *background $tixOption(bg) 10
+option add *Background $tixOption(bg) $tixOption(prioLevel)
+option add *background $tixOption(bg) $tixOption(prioLevel)
+option add *Foreground $tixOption(fg) $tixOption(prioLevel)
+option add *foreground $tixOption(fg) $tixOption(prioLevel)
+option add *activeBackground $tixOption(active_bg) $tixOption(prioLevel)
+option add *activeForeground $tixOption(active_fg) $tixOption(prioLevel)
+option add *HighlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *selectBackground $tixOption(select_bg) $tixOption(prioLevel)
+option add *selectForeground $tixOption(select_fg) $tixOption(prioLevel)
+option add *selectBorderWidth 0 $tixOption(prioLevel)
+option add *Menu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *TixMenu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Menubutton.padY 5 $tixOption(prioLevel)
+option add *Button.borderWidth 2 $tixOption(prioLevel)
+option add *Button.anchor c $tixOption(prioLevel)
+option add *Checkbutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Radiobutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Entry.relief sunken $tixOption(prioLevel)
+option add *Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Entry.foreground black $tixOption(prioLevel)
+option add *Entry.insertBackground black $tixOption(prioLevel)
+option add *Label.anchor w $tixOption(prioLevel)
+option add *Label.borderWidth 0 $tixOption(prioLevel)
+option add *Listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Listbox.relief sunken $tixOption(prioLevel)
+option add *Scale.foreground $tixOption(fg) $tixOption(prioLevel)
+option add *Scale.activeForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.relief sunken $tixOption(prioLevel)
+option add *Scrollbar.borderWidth 1 $tixOption(prioLevel)
+option add *Scrollbar.width 15 $tixOption(prioLevel)
+option add *Text.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Text.relief sunken $tixOption(prioLevel)
+option add *TixBalloon*background "#ffff60" $tixOption(prioLevel)
+option add *TixBalloon*foreground black $tixOption(prioLevel)
+option add *TixBalloon.background black $tixOption(prioLevel)
+option add *TixBalloon*Label.anchor w $tixOption(prioLevel)
+option add *TixControl*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixControl*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixControl*entry.foreground black $tixOption(prioLevel)
+option add *TixControl*entry.insertBackground black $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirList*f1.relief sunken $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixScrolledHList*f1.relief sunken $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixFileEntry*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixHList.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.foreground black $tixOption(prioLevel)
+option add *TixLabelEntry*entry.insertBackground black $tixOption(prioLevel)
+option add *TixMultiList*Listbox.borderWidth 0 $tixOption(prioLevel)
+option add *TixMultiList*Listbox.highlightThickness 0 $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.width 15 $tixOption(prioLevel)
+option add *TixMultiList*f1.borderWidth 2 $tixOption(prioLevel)
+option add *TixMultiList*f1.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*f1.highlightThickness 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.relief raised $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.borderWidth 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*Menubutton.padY 2 $tixOption(prioLevel)
+option add *TixNoteBook.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.backPageColor $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.inactiveBackground $tixOption(inactive_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleActiveBg $tixOption(active_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.seperatorBg $tixOption(bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleBg $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixPopupMenu*menubutton.background $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow.frame.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.borderWidth 1 $tixOption(prioLevel)
+option add *TixComboBox*Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.foreground black $tixOption(prioLevel)
+option add *TixComboBox*Entry.insertBackground black $tixOption(prioLevel)
+}
+proc tixPref:SetScheme-Mono:SGIGray {} {
+
+
+ global tixOption
+
+ set tixOption(bg) lightgray
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) gray70
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) gray60
+ set tixOption(dark2_fg) white
+ set tixOption(inactive_bg) lightgray
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) gray90
+ set tixOption(light1_fg) white
+ set tixOption(light2_bg) gray95
+ set tixOption(light2_fg) white
+
+ set tixOption(active_bg) gray90
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray55
+
+ set tixOption(input1_bg) $tixOption(light1_bg)
+ set tixOption(input2_bg) $tixOption(light1_bg)
+ set tixOption(output1_bg) $tixOption(light1_bg)
+ set tixOption(output2_bg) $tixOption(light1_bg)
+
+ set tixOption(select_fg) white
+ set tixOption(select_bg) black
+
+ set tixOption(selector) black
+
+option add *background $tixOption(bg) 10
+option add *Background $tixOption(bg) $tixOption(prioLevel)
+option add *background $tixOption(bg) $tixOption(prioLevel)
+option add *Foreground $tixOption(fg) $tixOption(prioLevel)
+option add *foreground $tixOption(fg) $tixOption(prioLevel)
+option add *activeBackground $tixOption(active_bg) $tixOption(prioLevel)
+option add *activeForeground $tixOption(active_fg) $tixOption(prioLevel)
+option add *HighlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *selectBackground $tixOption(select_bg) $tixOption(prioLevel)
+option add *selectForeground $tixOption(select_fg) $tixOption(prioLevel)
+option add *selectBorderWidth 0 $tixOption(prioLevel)
+option add *Menu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *TixMenu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Menubutton.padY 5 $tixOption(prioLevel)
+option add *Button.borderWidth 2 $tixOption(prioLevel)
+option add *Button.anchor c $tixOption(prioLevel)
+option add *Checkbutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Radiobutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Entry.relief sunken $tixOption(prioLevel)
+option add *Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Entry.foreground black $tixOption(prioLevel)
+option add *Entry.insertBackground black $tixOption(prioLevel)
+option add *Label.anchor w $tixOption(prioLevel)
+option add *Label.borderWidth 0 $tixOption(prioLevel)
+option add *Listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Listbox.relief sunken $tixOption(prioLevel)
+option add *Scale.foreground $tixOption(fg) $tixOption(prioLevel)
+option add *Scale.activeForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.relief sunken $tixOption(prioLevel)
+option add *Scrollbar.borderWidth 1 $tixOption(prioLevel)
+option add *Scrollbar.width 15 $tixOption(prioLevel)
+option add *Text.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Text.relief sunken $tixOption(prioLevel)
+option add *TixBalloon*background "#ffff60" $tixOption(prioLevel)
+option add *TixBalloon*foreground black $tixOption(prioLevel)
+option add *TixBalloon.background black $tixOption(prioLevel)
+option add *TixBalloon*Label.anchor w $tixOption(prioLevel)
+option add *TixControl*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixControl*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixControl*entry.foreground black $tixOption(prioLevel)
+option add *TixControl*entry.insertBackground black $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirList*f1.relief sunken $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixScrolledHList*f1.relief sunken $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixFileEntry*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixHList.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.foreground black $tixOption(prioLevel)
+option add *TixLabelEntry*entry.insertBackground black $tixOption(prioLevel)
+option add *TixMultiList*Listbox.borderWidth 0 $tixOption(prioLevel)
+option add *TixMultiList*Listbox.highlightThickness 0 $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.width 15 $tixOption(prioLevel)
+option add *TixMultiList*f1.borderWidth 2 $tixOption(prioLevel)
+option add *TixMultiList*f1.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*f1.highlightThickness 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.relief raised $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.borderWidth 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*Menubutton.padY 2 $tixOption(prioLevel)
+option add *TixNoteBook.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.backPageColor $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.inactiveBackground $tixOption(inactive_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleActiveBg $tixOption(active_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.seperatorBg $tixOption(bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleBg $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixPopupMenu*menubutton.background $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow.frame.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.borderWidth 1 $tixOption(prioLevel)
+option add *TixComboBox*Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.foreground black $tixOption(prioLevel)
+option add *TixComboBox*Entry.insertBackground black $tixOption(prioLevel)
+}
diff --git a/tix/library/pref/TK.cs b/tix/library/pref/TK.cs
new file mode 100644
index 00000000000..d33a902c09d
--- /dev/null
+++ b/tix/library/pref/TK.cs
@@ -0,0 +1,32 @@
+proc tixSetScheme-Color {} {
+ global tixOption
+
+ set tixOption(bg) #d9d9d9
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) #c3c3c3
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) #a3a3a3
+ set tixOption(dark2_fg) black
+ set tixOption(inactive_bg) #a3a3a3
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) #ececec
+ set tixOption(light1_fg) white
+ set tixOption(light2_bg) #fcfcfc
+ set tixOption(light2_fg) white
+
+ set tixOption(active_bg) $tixOption(dark1_bg)
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray55
+
+ set tixOption(input1_bg) #d9d9d9
+ set tixOption(input2_bg) #d9d9d9
+ set tixOption(output1_bg) $tixOption(dark1_bg)
+ set tixOption(output2_bg) $tixOption(bg)
+
+ set tixOption(select_fg) black
+ set tixOption(select_bg) #c3c3c3
+
+ set tixOption(selector) #b03060
+}
diff --git a/tix/library/pref/TK.csc b/tix/library/pref/TK.csc
new file mode 100644
index 00000000000..2b745e32fc4
--- /dev/null
+++ b/tix/library/pref/TK.csc
@@ -0,0 +1,69 @@
+proc tixPref:SetScheme-Color:TK {} {
+
+ global tixOption
+
+ set tixOption(bg) #d9d9d9
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) #c3c3c3
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) #a3a3a3
+ set tixOption(dark2_fg) black
+ set tixOption(inactive_bg) #a3a3a3
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) #ececec
+ set tixOption(light1_fg) white
+ set tixOption(light2_bg) #fcfcfc
+ set tixOption(light2_fg) white
+
+ set tixOption(active_bg) $tixOption(dark1_bg)
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray55
+
+ set tixOption(input1_bg) #d9d9d9
+ set tixOption(input2_bg) #d9d9d9
+ set tixOption(output1_bg) $tixOption(dark1_bg)
+ set tixOption(output2_bg) $tixOption(bg)
+
+ set tixOption(select_fg) black
+ set tixOption(select_bg) #c3c3c3
+
+ set tixOption(selector) #b03060
+
+}
+proc tixPref:SetScheme-Mono:TK {} {
+
+
+ global tixOption
+
+ set tixOption(bg) lightgray
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) gray70
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) gray60
+ set tixOption(dark2_fg) white
+ set tixOption(inactive_bg) lightgray
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) gray90
+ set tixOption(light1_fg) white
+ set tixOption(light2_bg) gray95
+ set tixOption(light2_fg) white
+
+ set tixOption(active_bg) gray90
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray55
+
+ set tixOption(input1_bg) $tixOption(light1_bg)
+ set tixOption(input2_bg) $tixOption(light1_bg)
+ set tixOption(output1_bg) $tixOption(light1_bg)
+ set tixOption(output2_bg) $tixOption(light1_bg)
+
+ set tixOption(select_fg) white
+ set tixOption(select_bg) black
+
+ set tixOption(selector) black
+
+}
diff --git a/tix/library/pref/TK.fs b/tix/library/pref/TK.fs
new file mode 100644
index 00000000000..b996cac166e
--- /dev/null
+++ b/tix/library/pref/TK.fs
@@ -0,0 +1,13 @@
+
+proc tixSetFontset {} {
+
+ global tixOption
+
+ set tixOption(font) -Adobe-Helvetica-Medium-R-Normal--*-120-*
+ set tixOption(bold_font) -Adobe-Helvetica-Bold-R-Normal--*-120-*
+ set tixOption(menu_font) -Adobe-Helvetica-Bold-R-Normal--*-120-*
+ set tixOption(italic_font) -Adobe-Helvetica-Bold-O-Normal--*-120-*
+ set tixOption(fixed_font) -*-courier-medium-r-*-*-14-*-*-*-*-*-*-*
+ set tixOption(border1) 1
+}
+
diff --git a/tix/library/pref/TK.fsc b/tix/library/pref/TK.fsc
new file mode 100644
index 00000000000..c747485cdcf
--- /dev/null
+++ b/tix/library/pref/TK.fsc
@@ -0,0 +1,16 @@
+proc tixPref:InitFontSet:TK {} {
+
+
+ global tixOption
+
+ set tixOption(font) -Adobe-Helvetica-Medium-R-Normal--*-120-*
+ set tixOption(bold_font) -Adobe-Helvetica-Bold-R-Normal--*-120-*
+ set tixOption(menu_font) -Adobe-Helvetica-Bold-R-Normal--*-120-*
+ set tixOption(italic_font) -Adobe-Helvetica-Bold-O-Normal--*-120-*
+ set tixOption(fixed_font) -*-courier-medium-r-*-*-14-*-*-*-*-*-*-*
+ set tixOption(border1) 1
+
+}
+proc tixPref:SetFontSet:TK {} {
+global tixOption
+}
diff --git a/tix/library/pref/TixGray.cs b/tix/library/pref/TixGray.cs
new file mode 100644
index 00000000000..c31a4fe07ff
--- /dev/null
+++ b/tix/library/pref/TixGray.cs
@@ -0,0 +1,33 @@
+proc tixSetScheme-Color {} {
+
+ global tixOption
+
+ set tixOption(bg) lightgray
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) gray86
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) gray77
+ set tixOption(dark2_fg) black
+ set tixOption(inactive_bg) gray77
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) gray92
+ set tixOption(light1_fg) white
+ set tixOption(light2_bg) gray95
+ set tixOption(light2_fg) white
+
+ set tixOption(active_bg) $tixOption(dark1_bg)
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray55
+
+ set tixOption(input1_bg) gray95
+ set tixOption(input2_bg) gray95
+ set tixOption(output1_bg) $tixOption(dark1_bg)
+ set tixOption(output2_bg) $tixOption(bg)
+
+ set tixOption(select_fg) black
+ set tixOption(select_bg) lightblue
+
+ set tixOption(selector) yellow
+}
diff --git a/tix/library/pref/TixGray.csc b/tix/library/pref/TixGray.csc
new file mode 100644
index 00000000000..c394a0d50c2
--- /dev/null
+++ b/tix/library/pref/TixGray.csc
@@ -0,0 +1,336 @@
+proc tixPref:SetScheme-Color:TixGray {} {
+
+
+ global tixOption
+
+ set tixOption(bg) lightgray
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) gray86
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) gray77
+ set tixOption(dark2_fg) black
+ set tixOption(inactive_bg) gray77
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) gray92
+ set tixOption(light1_fg) white
+ set tixOption(light2_bg) gray95
+ set tixOption(light2_fg) white
+
+ set tixOption(active_bg) $tixOption(dark1_bg)
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray55
+
+ set tixOption(input1_bg) gray95
+ set tixOption(input2_bg) gray95
+ set tixOption(output1_bg) $tixOption(dark1_bg)
+ set tixOption(output2_bg) $tixOption(bg)
+
+ set tixOption(select_fg) black
+ set tixOption(select_bg) lightblue
+
+ set tixOption(selector) yellow
+
+option add *background $tixOption(bg) 10
+option add *Background $tixOption(bg) $tixOption(prioLevel)
+option add *background $tixOption(bg) $tixOption(prioLevel)
+option add *Foreground $tixOption(fg) $tixOption(prioLevel)
+option add *foreground $tixOption(fg) $tixOption(prioLevel)
+option add *activeBackground $tixOption(active_bg) $tixOption(prioLevel)
+option add *activeForeground $tixOption(active_fg) $tixOption(prioLevel)
+option add *HighlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *selectBackground $tixOption(select_bg) $tixOption(prioLevel)
+option add *selectForeground $tixOption(select_fg) $tixOption(prioLevel)
+option add *selectBorderWidth 0 $tixOption(prioLevel)
+option add *Menu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *TixMenu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Menubutton.padY 5 $tixOption(prioLevel)
+option add *Button.borderWidth 2 $tixOption(prioLevel)
+option add *Button.anchor c $tixOption(prioLevel)
+option add *Checkbutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Radiobutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Entry.relief sunken $tixOption(prioLevel)
+option add *Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Entry.foreground black $tixOption(prioLevel)
+option add *Entry.insertBackground black $tixOption(prioLevel)
+option add *Label.anchor w $tixOption(prioLevel)
+option add *Label.borderWidth 0 $tixOption(prioLevel)
+option add *Listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Listbox.relief sunken $tixOption(prioLevel)
+option add *Scale.foreground $tixOption(fg) $tixOption(prioLevel)
+option add *Scale.activeForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.relief sunken $tixOption(prioLevel)
+option add *Scrollbar.borderWidth 1 $tixOption(prioLevel)
+option add *Scrollbar.width 15 $tixOption(prioLevel)
+option add *Text.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Text.relief sunken $tixOption(prioLevel)
+option add *TixBalloon*background "#ffff60" $tixOption(prioLevel)
+option add *TixBalloon*foreground black $tixOption(prioLevel)
+option add *TixBalloon.background black $tixOption(prioLevel)
+option add *TixBalloon*Label.anchor w $tixOption(prioLevel)
+option add *TixControl*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixControl*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixControl*entry.foreground black $tixOption(prioLevel)
+option add *TixControl*entry.insertBackground black $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirList*f1.relief sunken $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixScrolledHList*f1.relief sunken $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixFileEntry*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixHList.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.foreground black $tixOption(prioLevel)
+option add *TixLabelEntry*entry.insertBackground black $tixOption(prioLevel)
+option add *TixMultiList*Listbox.borderWidth 0 $tixOption(prioLevel)
+option add *TixMultiList*Listbox.highlightThickness 0 $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.width 15 $tixOption(prioLevel)
+option add *TixMultiList*f1.borderWidth 2 $tixOption(prioLevel)
+option add *TixMultiList*f1.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*f1.highlightThickness 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.relief raised $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.borderWidth 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*Menubutton.padY 2 $tixOption(prioLevel)
+option add *TixNoteBook.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.backPageColor $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.inactiveBackground $tixOption(inactive_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleActiveBg $tixOption(active_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.seperatorBg $tixOption(bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleBg $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixPopupMenu*menubutton.background $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow.frame.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.borderWidth 1 $tixOption(prioLevel)
+option add *TixComboBox*Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.foreground black $tixOption(prioLevel)
+option add *TixComboBox*Entry.insertBackground black $tixOption(prioLevel)
+}
+proc tixPref:SetScheme-Mono:TixGray {} {
+
+
+ global tixOption
+
+ set tixOption(bg) lightgray
+ set tixOption(fg) black
+
+ set tixOption(dark1_bg) gray70
+ set tixOption(dark1_fg) black
+ set tixOption(dark2_bg) gray60
+ set tixOption(dark2_fg) white
+ set tixOption(inactive_bg) lightgray
+ set tixOption(inactive_fg) black
+
+ set tixOption(light1_bg) gray90
+ set tixOption(light1_fg) white
+ set tixOption(light2_bg) gray95
+ set tixOption(light2_fg) white
+
+ set tixOption(active_bg) gray90
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) gray55
+
+ set tixOption(input1_bg) $tixOption(light1_bg)
+ set tixOption(input2_bg) $tixOption(light1_bg)
+ set tixOption(output1_bg) $tixOption(light1_bg)
+ set tixOption(output2_bg) $tixOption(light1_bg)
+
+ set tixOption(select_fg) white
+ set tixOption(select_bg) black
+
+ set tixOption(selector) black
+
+option add *background $tixOption(bg) 10
+option add *Background $tixOption(bg) $tixOption(prioLevel)
+option add *background $tixOption(bg) $tixOption(prioLevel)
+option add *Foreground $tixOption(fg) $tixOption(prioLevel)
+option add *foreground $tixOption(fg) $tixOption(prioLevel)
+option add *activeBackground $tixOption(active_bg) $tixOption(prioLevel)
+option add *activeForeground $tixOption(active_fg) $tixOption(prioLevel)
+option add *HighlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *selectBackground $tixOption(select_bg) $tixOption(prioLevel)
+option add *selectForeground $tixOption(select_fg) $tixOption(prioLevel)
+option add *selectBorderWidth 0 $tixOption(prioLevel)
+option add *Menu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *TixMenu.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Menubutton.padY 5 $tixOption(prioLevel)
+option add *Button.borderWidth 2 $tixOption(prioLevel)
+option add *Button.anchor c $tixOption(prioLevel)
+option add *Checkbutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Radiobutton.selectColor $tixOption(selector) $tixOption(prioLevel)
+option add *Entry.relief sunken $tixOption(prioLevel)
+option add *Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Entry.foreground black $tixOption(prioLevel)
+option add *Entry.insertBackground black $tixOption(prioLevel)
+option add *Label.anchor w $tixOption(prioLevel)
+option add *Label.borderWidth 0 $tixOption(prioLevel)
+option add *Listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Listbox.relief sunken $tixOption(prioLevel)
+option add *Scale.foreground $tixOption(fg) $tixOption(prioLevel)
+option add *Scale.activeForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.relief sunken $tixOption(prioLevel)
+option add *Scrollbar.borderWidth 1 $tixOption(prioLevel)
+option add *Scrollbar.width 15 $tixOption(prioLevel)
+option add *Text.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Text.relief sunken $tixOption(prioLevel)
+option add *TixBalloon*background "#ffff60" $tixOption(prioLevel)
+option add *TixBalloon*foreground black $tixOption(prioLevel)
+option add *TixBalloon.background black $tixOption(prioLevel)
+option add *TixBalloon*Label.anchor w $tixOption(prioLevel)
+option add *TixControl*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixControl*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixControl*entry.foreground black $tixOption(prioLevel)
+option add *TixControl*entry.insertBackground black $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirList*f1.relief sunken $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixScrolledHList*f1.relief sunken $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixFileEntry*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixHList.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.foreground black $tixOption(prioLevel)
+option add *TixLabelEntry*entry.insertBackground black $tixOption(prioLevel)
+option add *TixMultiList*Listbox.borderWidth 0 $tixOption(prioLevel)
+option add *TixMultiList*Listbox.highlightThickness 0 $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.width 15 $tixOption(prioLevel)
+option add *TixMultiList*f1.borderWidth 2 $tixOption(prioLevel)
+option add *TixMultiList*f1.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*f1.highlightThickness 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.relief raised $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.borderWidth 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*Menubutton.padY 2 $tixOption(prioLevel)
+option add *TixNoteBook.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.backPageColor $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.inactiveBackground $tixOption(inactive_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleActiveBg $tixOption(active_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.seperatorBg $tixOption(bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleBg $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixPopupMenu*menubutton.background $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow.frame.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.borderWidth 1 $tixOption(prioLevel)
+option add *TixComboBox*Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.foreground black $tixOption(prioLevel)
+option add *TixComboBox*Entry.insertBackground black $tixOption(prioLevel)
+}
diff --git a/tix/library/pref/TkWin.cs b/tix/library/pref/TkWin.cs
new file mode 100644
index 00000000000..0c4b61b7ff1
--- /dev/null
+++ b/tix/library/pref/TkWin.cs
@@ -0,0 +1,65 @@
+proc tixSetScheme-Color {} {
+ global tixOption
+
+ set tixOption(bg) SystemButtonFace
+ set tixOption(fg) SystemButtonText
+
+ set tixOption(dark1_bg) SystemScrollbar
+ set tixOption(dark1_fg) SystemButtonText
+# set tixOption(dark2_bg) SystemDisabledText
+# set tixOption(dark2_fg) black
+ set tixOption(inactive_bg) SystemButtonFace
+ set tixOption(inactive_fg) SystemButtonText
+
+ set tixOption(light1_bg) SystemButtonFace
+# set tixOption(light1_fg) white
+# set tixOption(light2_bg) #fcfcfc
+# set tixOption(light2_fg) white
+
+ set tixOption(active_bg) $tixOption(dark1_bg)
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) SystemDisabledText
+
+ set tixOption(input1_bg) SystemWindow
+# set tixOption(input2_bg)
+# set tixOption(output1_bg) $tixOption(dark1_bg)
+# set tixOption(output2_bg) $tixOption(bg)
+
+ set tixOption(select_fg) SystemHighlightText
+ set tixOption(select_bg) SystemHighlight
+
+ set tixOption(selector) SystemHighlight
+}
+
+proc tixSetScheme-Mono {} {
+ global tixOption
+
+ set tixOption(bg) SystemButtonFace
+ set tixOption(fg) SystemButtonText
+
+ set tixOption(dark1_bg) SystemScrollbar
+ set tixOption(dark1_fg) SystemButtonText
+# set tixOption(dark2_bg) SystemDisabledText
+# set tixOption(dark2_fg) black
+ set tixOption(inactive_bg) SystemButtonFace
+ set tixOption(inactive_fg) SystemButtonText
+
+ set tixOption(light1_bg) SystemButtonFace
+# set tixOption(light1_fg) white
+# set tixOption(light2_bg) #fcfcfc
+# set tixOption(light2_fg) white
+
+ set tixOption(active_bg) $tixOption(dark1_bg)
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) SystemDisabledText
+
+ set tixOption(input1_bg) white
+# set tixOption(input2_bg)
+# set tixOption(output1_bg) $tixOption(dark1_bg)
+# set tixOption(output2_bg) $tixOption(bg)
+
+ set tixOption(select_fg) SystemHighlightText
+ set tixOption(select_bg) SystemHighlight
+
+ set tixOption(selector) SystemHighlight
+}
diff --git a/tix/library/pref/TkWin.csc b/tix/library/pref/TkWin.csc
new file mode 100644
index 00000000000..d893bcd1ea4
--- /dev/null
+++ b/tix/library/pref/TkWin.csc
@@ -0,0 +1,320 @@
+proc tixPref:SetScheme-Color:TkWin {} {
+
+ global tixOption
+
+ set tixOption(bg) SystemButtonFace
+ set tixOption(fg) SystemButtonText
+
+ set tixOption(dark1_bg) SystemScrollbar
+ set tixOption(dark1_fg) SystemButtonText
+# set tixOption(dark2_bg) SystemDisabledText
+# set tixOption(dark2_fg) black
+ set tixOption(inactive_bg) SystemButtonFace
+ set tixOption(inactive_fg) SystemButtonText
+
+ set tixOption(light1_bg) SystemButtonFace
+# set tixOption(light1_fg) white
+# set tixOption(light2_bg) #fcfcfc
+# set tixOption(light2_fg) white
+
+ set tixOption(active_bg) $tixOption(dark1_bg)
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) SystemDisabledText
+
+ set tixOption(input1_bg) SystemWindow
+# set tixOption(input2_bg)
+# set tixOption(output1_bg) $tixOption(dark1_bg)
+# set tixOption(output2_bg) $tixOption(bg)
+
+ set tixOption(select_fg) SystemHighlightText
+ set tixOption(select_bg) SystemHighlight
+
+ set tixOption(selector) SystemHighlight
+
+option add *Menubutton.padY 5 $tixOption(prioLevel)
+option add *Button.borderWidth 2 $tixOption(prioLevel)
+option add *Button.anchor c $tixOption(prioLevel)
+option add *Entry.relief sunken $tixOption(prioLevel)
+option add *Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Entry.foreground black $tixOption(prioLevel)
+option add *Entry.insertBackground black $tixOption(prioLevel)
+option add *Label.anchor w $tixOption(prioLevel)
+option add *Label.borderWidth 0 $tixOption(prioLevel)
+option add *Listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Listbox.relief sunken $tixOption(prioLevel)
+option add *Scale.foreground $tixOption(fg) $tixOption(prioLevel)
+option add *Scale.activeForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.relief sunken $tixOption(prioLevel)
+option add *Scrollbar.borderWidth 1 $tixOption(prioLevel)
+#option add *Scrollbar.width 15 $tixOption(prioLevel)
+option add *Text.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Text.relief sunken $tixOption(prioLevel)
+option add *TixBalloon*background "#ffff60" $tixOption(prioLevel)
+option add *TixBalloon*foreground black $tixOption(prioLevel)
+option add *TixBalloon.background black $tixOption(prioLevel)
+option add *TixBalloon*Label.anchor w $tixOption(prioLevel)
+option add *TixControl*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixControl*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixControl*entry.foreground black $tixOption(prioLevel)
+option add *TixControl*entry.insertBackground black $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.activeBackground $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.disabledBackground $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixDirTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.activeBackground $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.disabledBackground $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixDirList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirList*f1.relief sunken $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.activeBackground $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.disabledBackground $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixScrolledHList*f1.relief sunken $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.activeBackground $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.disabledBackground $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixFileEntry*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixHList.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.foreground black $tixOption(prioLevel)
+option add *TixLabelEntry*entry.insertBackground black $tixOption(prioLevel)
+option add *TixMultiList*Listbox.borderWidth 0 $tixOption(prioLevel)
+option add *TixMultiList*Listbox.highlightThickness 0 $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.relief sunken $tixOption(prioLevel)
+#option add *TixMultiList*Scrollbar.width 15 $tixOption(prioLevel)
+option add *TixMultiList*f1.borderWidth 2 $tixOption(prioLevel)
+option add *TixMultiList*f1.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*f1.highlightThickness 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.relief raised $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.borderWidth 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*Menubutton.padY 2 $tixOption(prioLevel)
+option add *TixNoteBook.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.backPageColor $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.inactiveBackground $tixOption(inactive_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleActiveBg $tixOption(active_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.separatorBg $tixOption(bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleBg $tixOption(bg) $tixOption(prioLevel)
+option add *TixPopupMenu*menubutton.background $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledText.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow.frame.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.borderWidth 1 $tixOption(prioLevel)
+option add *TixComboBox*Entry.highlightBackground $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.foreground SystemWindowText $tixOption(prioLevel)
+option add *TixComboBox*Entry.insertBackground SystemWindowText $tixOption(prioLevel)
+option add *TixComboBox*Entry.selectBackground $tixOption(select_bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.selectForeground $tixOption(select_fg) $tixOption(prioLevel)
+option add *TixComboBox*TixScrolledListBox.selectBackground $tixOption(select_bg) $tixOption(prioLevel)
+option add *TixComboBox*TixScrolledListBox.selectForeground $tixOption(select_fg) $tixOption(prioLevel)
+}
+proc tixPref:SetScheme-Mono:TkWin {} {
+
+ global tixOption
+
+ set tixOption(bg) SystemButtonFace
+ set tixOption(fg) SystemButtonText
+
+ set tixOption(dark1_bg) SystemScrollbar
+ set tixOption(dark1_fg) SystemButtonText
+# set tixOption(dark2_bg) SystemDisabledText
+# set tixOption(dark2_fg) black
+ set tixOption(inactive_bg) SystemButtonFace
+ set tixOption(inactive_fg) SystemButtonText
+
+ set tixOption(light1_bg) SystemButtonFace
+# set tixOption(light1_fg) white
+# set tixOption(light2_bg) #fcfcfc
+# set tixOption(light2_fg) white
+
+ set tixOption(active_bg) $tixOption(dark1_bg)
+ set tixOption(active_fg) $tixOption(fg)
+ set tixOption(disabled_fg) SystemDisabledText
+
+ set tixOption(input1_bg) white
+# set tixOption(input2_bg)
+# set tixOption(output1_bg) $tixOption(dark1_bg)
+# set tixOption(output2_bg) $tixOption(bg)
+
+ set tixOption(select_fg) SystemHighlightText
+ set tixOption(select_bg) SystemHighlight
+
+ set tixOption(selector) SystemHighlight
+
+option add *Menubutton.padY 5 $tixOption(prioLevel)
+option add *Button.borderWidth 2 $tixOption(prioLevel)
+option add *Button.anchor c $tixOption(prioLevel)
+option add *Entry.relief sunken $tixOption(prioLevel)
+option add *Entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Entry.foreground black $tixOption(prioLevel)
+option add *Entry.insertBackground black $tixOption(prioLevel)
+option add *Label.anchor w $tixOption(prioLevel)
+option add *Label.borderWidth 0 $tixOption(prioLevel)
+option add *Listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Listbox.relief sunken $tixOption(prioLevel)
+option add *Scale.foreground $tixOption(fg) $tixOption(prioLevel)
+option add *Scale.activeForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderForeground $tixOption(bg) $tixOption(prioLevel)
+option add *Scale.sliderBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *Scrollbar.relief sunken $tixOption(prioLevel)
+option add *Scrollbar.borderWidth 1 $tixOption(prioLevel)
+#option add *Scrollbar.width 15 $tixOption(prioLevel)
+option add *Text.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *Text.relief sunken $tixOption(prioLevel)
+option add *TixBalloon*background "#ffff60" $tixOption(prioLevel)
+option add *TixBalloon*foreground black $tixOption(prioLevel)
+option add *TixBalloon.background black $tixOption(prioLevel)
+option add *TixBalloon*Label.anchor w $tixOption(prioLevel)
+option add *TixControl*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixControl*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixControl*entry.foreground black $tixOption(prioLevel)
+option add *TixControl*entry.insertBackground black $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.activeBackground $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixDirTree*hlist.disabledBackground $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixDirTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.activeBackground $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixDirList*hlist.disabledBackground $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixDirList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixDirList*f1.relief sunken $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.activeBackground $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.disabledBackground $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixScrolledHList*f1.relief sunken $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.activeBackground $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.disabledBackground $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixTree*f1.borderWidth 1 $tixOption(prioLevel)
+option add *TixTree*f1.relief sunken $tixOption(prioLevel)
+option add *TixFileEntry*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixHList.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.activeBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixHList.disabledBackground $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixLabelEntry*entry.foreground black $tixOption(prioLevel)
+option add *TixLabelEntry*entry.insertBackground black $tixOption(prioLevel)
+option add *TixMultiList*Listbox.borderWidth 0 $tixOption(prioLevel)
+option add *TixMultiList*Listbox.highlightThickness 0 $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixMultiList*Scrollbar.relief sunken $tixOption(prioLevel)
+#option add *TixMultiList*Scrollbar.width 15 $tixOption(prioLevel)
+option add *TixMultiList*f1.borderWidth 2 $tixOption(prioLevel)
+option add *TixMultiList*f1.relief sunken $tixOption(prioLevel)
+option add *TixMultiList*f1.highlightThickness 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.relief raised $tixOption(prioLevel)
+option add *TixMDIMenuBar*menubar.borderWidth 2 $tixOption(prioLevel)
+option add *TixMDIMenuBar*Menubutton.padY 2 $tixOption(prioLevel)
+option add *TixNoteBook.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.Background $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.backPageColor $tixOption(bg) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.inactiveBackground $tixOption(inactive_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleActiveBg $tixOption(active_bg) $tixOption(prioLevel)
+option add *TixPanedWindow.separatorBg $tixOption(bg) $tixOption(prioLevel)
+option add *TixPanedWindow.handleBg $tixOption(bg) $tixOption(prioLevel)
+option add *TixPopupMenu*menubutton.background $tixOption(dark1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledHList*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledTList*tlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledListBox*listbox.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledText.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledText*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixScrolledWindow*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixScrolledWindow.frame.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.background $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*Scrollbar.troughColor $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.highlightBackground $tixOption(bg) $tixOption(prioLevel)
+option add *TixTree*hlist.background $tixOption(light1_bg) $tixOption(prioLevel)
+option add *TixTree*hlist.borderWidth 1 $tixOption(prioLevel)
+option add *TixComboBox*Entry.highlightBackground $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.background $tixOption(input1_bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.foreground SystemWindowText $tixOption(prioLevel)
+option add *TixComboBox*Entry.insertBackground SystemWindowText $tixOption(prioLevel)
+option add *TixComboBox*Entry.selectBackground $tixOption(select_bg) $tixOption(prioLevel)
+option add *TixComboBox*Entry.selectForeground $tixOption(select_fg) $tixOption(prioLevel)
+option add *TixComboBox*TixScrolledListBox.selectBackground $tixOption(select_bg) $tixOption(prioLevel)
+option add *TixComboBox*TixScrolledListBox.selectForeground $tixOption(select_fg) $tixOption(prioLevel)
+}
diff --git a/tix/library/pref/TkWin.fs b/tix/library/pref/TkWin.fs
new file mode 100644
index 00000000000..3648b364ba7
--- /dev/null
+++ b/tix/library/pref/TkWin.fs
@@ -0,0 +1,13 @@
+
+proc tixSetFontset {} {
+
+ global tixOption
+
+ set tixOption(font) "windows-message"
+ set tixOption(bold_font) "windows-status"
+ set tixOption(menu_font) "windows-menu"
+ set tixOption(italic_font) "windows-message"
+ set tixOption(fixed_font) "systemfixed"
+ set tixOption(border1) 1
+}
+
diff --git a/tix/library/pref/TkWin.fsc b/tix/library/pref/TkWin.fsc
new file mode 100644
index 00000000000..9dc0a5eeaf7
--- /dev/null
+++ b/tix/library/pref/TkWin.fsc
@@ -0,0 +1,31 @@
+proc tixPref:InitFontSet:TkWin {} {
+
+
+ global tixOption
+
+ set tixOption(font) "windows-message"
+ set tixOption(bold_font) "windows-status"
+ set tixOption(menu_font) "windows-menu"
+ set tixOption(italic_font) "windows-message"
+ set tixOption(fixed_font) "systemfixed"
+ set tixOption(border1) 1
+
+}
+proc tixPref:SetFontSet:TkWin {} {
+global tixOption
+option add *Menu.font $tixOption(menu_font) $tixOption(prioLevel)
+option add *TixMenu.font $tixOption(menu_font) $tixOption(prioLevel)
+option add *Menubutton.font $tixOption(menu_font) $tixOption(prioLevel)
+option add *Label.font $tixOption(bold_font) $tixOption(prioLevel)
+option add *Scale.font $tixOption(italic_font) $tixOption(prioLevel)
+option add *TixBalloon*Label.font $tixOption(font) $tixOption(prioLevel)
+option add *TixBitmapButton*label.font $tixOption(font) $tixOption(prioLevel)
+option add *TixControl*label.font $tixOption(bold_font) $tixOption(prioLevel)
+option add *TixLabelEntry*label.font $tixOption(bold_font) $tixOption(prioLevel)
+option add *TixLabelFrame*label.font $tixOption(bold_font) $tixOption(prioLevel)
+option add *TixMwmClient*title.font $tixOption(menu_font) $tixOption(prioLevel)
+option add *TixNoteBook.nbframe.font $tixOption(menu_font) $tixOption(prioLevel)
+option add *TixOptionMenu*menubutton.font $tixOption(font) $tixOption(prioLevel)
+option add *TixComboBox*Entry.font $tixOption(font) $tixOption(prioLevel)
+option add *TixFileSelectBox*Label.font $tixOption(bold_font) $tixOption(prioLevel)
+}
diff --git a/tix/library/pref/tixmkpref b/tix/library/pref/tixmkpref
new file mode 100755
index 00000000000..d42efadfa7f
--- /dev/null
+++ b/tix/library/pref/tixmkpref
@@ -0,0 +1,413 @@
+#!/usr/local/bin/tclsh
+# Undocumented program. Don't use it.
+#
+# Usage:
+#
+# tixmkpref option name.src > name.tcl
+#
+
+proc tixDefOption {classes specs {level \$tixOption(prioLevel)}} {
+ global isFont tixOption
+
+ foreach class $classes {
+ foreach spec $specs {
+ if [regexp (Font)|(font) $spec] {
+ if {$isFont} {
+ puts "option add *$class$spec $level"
+ }
+ } else {
+ if {!$isFont} {
+ set aspec [subst $spec]
+ puts "option add *$class$spec $level"
+ }
+ }
+ }
+ }
+}
+
+proc option {classes specs {level \$tixOption(prioLevel)}} {
+ tixDefOption $classes $specs $level
+}
+
+proc tixInitOptionDatabase {isWin} {
+ global tixOption isFont
+
+ # general stuff, everything gets these defaults unless otherwise specified
+ #-------------------------------------------------------------------------
+ if {! $isWin} then {
+ tixDefOption {""} {{Font $tixOption(font)}}
+ tixDefOption {""} {{font $tixOption(font)}}
+
+ tixDefOption {""} {{background $tixOption(bg)}} 10
+ tixDefOption {""} {{Background $tixOption(bg)}}
+ tixDefOption {""} {{background $tixOption(bg)}}
+ tixDefOption {""} {{Foreground $tixOption(fg)}}
+ tixDefOption {""} {{foreground $tixOption(fg)}}
+ tixDefOption {""} {{activeBackground $tixOption(active_bg)}}
+ tixDefOption {""} {{activeForeground $tixOption(active_fg)}}
+ tixDefOption {""} {{HighlightBackground $tixOption(bg)}}
+ tixDefOption {""} {{selectBackground $tixOption(select_bg)}}
+ tixDefOption {""} {{selectForeground $tixOption(select_fg)}}
+ tixDefOption {""} {{selectBorderWidth 0}}
+ }
+
+ #----------------------------------------
+ # Standard TK Widget Options
+ #
+ # We set up the options for the TK widgets only if
+ # the strictTK option is not selected.
+ #----------------------------------------
+
+ if {$isWin} then {
+ tixDefOption {Menu TixMenu} {
+ {.font $tixOption(menu_font)}
+ }
+ } else {
+ tixDefOption {Menu TixMenu} {
+ {.font $tixOption(menu_font)}
+ {.selectColor $tixOption(selector)}
+ }
+ }
+
+ tixDefOption {Menubutton} {
+ {.font $tixOption(menu_font)}
+ {.padY 5}
+ }
+
+ tixDefOption {Button} {
+ {.borderWidth 2}
+ {.anchor c}
+ }
+
+ if {! $isWin} then {
+ tixDefOption {Checkbutton Radiobutton} {
+ {.selectColor $tixOption(selector)}
+ }
+ }
+
+ tixDefOption {Entry} {
+ {.relief sunken}
+ {.highlightBackground $tixOption(bg)}
+ {.background $tixOption(input1_bg)}
+ {.foreground black}
+ {.insertBackground black}
+ }
+
+ tixDefOption {Label} {
+ {.anchor w}
+ {.borderWidth 0}
+ {.font $tixOption(bold_font)}
+ }
+
+ tixDefOption {Listbox} {
+ {.background $tixOption(light1_bg)}
+ {.relief sunken}
+ }
+
+ tixDefOption {Scale} {
+ {.foreground $tixOption(fg)}
+ {.activeForeground $tixOption(bg)}
+ {.background $tixOption(bg)}
+ {.sliderForeground $tixOption(bg)}
+ {.sliderBackground $tixOption(light1_bg)}
+ {.font $tixOption(italic_font)}
+ }
+
+ tixDefOption {Scrollbar} {
+ {.background $tixOption(bg)}
+ {.troughColor $tixOption(light1_bg)}
+ {.relief sunken}
+ {.borderWidth 1}
+ {.width 15}
+ }
+
+ tixDefOption {Text} {
+ {.background $tixOption(input1_bg)}
+ {.relief sunken}
+ }
+
+ #----------------------------------------------------------------------
+ # TIX WIDGETS
+ #----------------------------------------------------------------------
+
+ tixDefOption {TixBalloon} {
+ {*background "#ffff60"}
+ {*foreground black}
+ {.background black}
+ {*Label.font $tixOption(font)}
+ {*Label.anchor w}
+ }
+
+ tixDefOption {TixBitmapButton} {
+ {*label.font $tixOption(font)}
+ }
+
+ tixDefOption {TixControl} {
+ {*entry.highlightBackground $tixOption(bg)}
+ {*entry.background $tixOption(input1_bg)}
+ {*entry.foreground black}
+ {*entry.insertBackground black}
+ {*label.font $tixOption(bold_font)}
+ }
+
+ # DLG_BTNS
+ #
+ tixDefOption {TixStdButtonBox} {
+ }
+
+ # DIR_LIST
+ #
+ tixDefOption {TixDirTree TixDirList TixScrolledHList TixTree} {
+ {*Scrollbar.background $tixOption(bg)}
+ {*Scrollbar.troughColor $tixOption(light1_bg)}
+ {*hlist.highlightBackground $tixOption(bg)}
+ {*hlist.background $tixOption(input1_bg)}
+ {*hlist.activeBackground $tixOption(input1_bg)}
+ {*hlist.disabledBackground $tixOption(input1_bg)}
+ {*f1.borderWidth 1}
+ {*f1.relief sunken}
+ }
+
+ tixDefOption {TixFileEntry} {
+ {*Entry.background $tixOption(input1_bg)}
+ }
+
+ tixDefOption {TixHList} {
+ {.background $tixOption(light1_bg)}
+ {.activeBackground $tixOption(light1_bg)}
+ {.disabledBackground $tixOption(light1_bg)}
+ }
+
+ tixDefOption {TixLabelEntry} {
+ {*entry.highlightBackground $tixOption(bg)}
+ {*entry.background $tixOption(input1_bg)}
+ {*entry.foreground black}
+ {*entry.insertBackground black}
+ {*label.font $tixOption(bold_font)}
+ }
+
+ tixDefOption {TixLabelFrame} {
+ {*label.font $tixOption(bold_font)}
+ }
+
+ tixDefOption {TixMultiList} {
+ {*Listbox.borderWidth 0}
+ {*Listbox.highlightThickness 0}
+ {*Scrollbar.background $tixOption(bg)}
+ {*Scrollbar.troughColor $tixOption(light1_bg)}
+ {*Scrollbar.relief sunken}
+ {*Scrollbar.width 15}
+ {*f1.borderWidth 2}
+ {*f1.relief sunken}
+ {*f1.highlightThickness 2}
+ }
+
+ # MwmClient
+ #
+ tixDefOption {TixMwmClient} {
+ {*title.font $tixOption(menu_font)}
+ }
+
+ tixDefOption {TixMDIMenuBar} {
+ {*menubar.relief raised}
+ {*menubar.borderWidth 2}
+ {*Menubutton.padY 2}
+ }
+
+ # NoteBook
+ #
+ tixDefOption {TixNoteBook} {
+ {.Background $tixOption(bg)}
+ {.nbframe.Background $tixOption(bg)}
+ {.nbframe.font $tixOption(menu_font)}
+ {.nbframe.backPageColor $tixOption(bg)}
+ {.nbframe.inactiveBackground $tixOption(inactive_bg)}
+ }
+
+ # OPTION_MENU
+ #
+ tixDefOption {TixOptionMenu} {
+ {*menubutton.font $tixOption(font)}
+ }
+
+ # PANED_WINDOW
+ #
+ tixDefOption {TixPanedWindow} {
+ {.handleActiveBg $tixOption(active_bg)}
+ {.separatorBg $tixOption(bg)}
+ {.handleBg $tixOption(bg)}
+ }
+
+ # POPUP MENU
+ #
+ tixDefOption {TixPopupMenu} {
+ {*menubutton.background $tixOption(dark1_bg)}
+ }
+
+ # SCROLLED_HLIST
+ #
+ tixDefOption {TixScrolledHList} {
+ {*Scrollbar.background $tixOption(bg)}
+ {*Scrollbar.troughColor $tixOption(light1_bg)}
+ {*hlist.highlightBackground $tixOption(bg)}
+ {*hlist.background $tixOption(light1_bg)}
+ }
+
+ tixDefOption {TixScrolledTList} {
+ {*Scrollbar.background $tixOption(bg)}
+ {*Scrollbar.troughColor $tixOption(light1_bg)}
+ {*tlist.highlightBackground $tixOption(bg)}
+ {*tlist.background $tixOption(light1_bg)}
+ }
+
+ # SCROLLED_LISTBOX, .. ETC
+ #
+ tixDefOption {TixScrolledListBox} {
+ {.background $tixOption(bg)}
+ {*Scrollbar.background $tixOption(bg)}
+ {*Scrollbar.troughColor $tixOption(light1_bg)}
+ {*listbox.highlightBackground $tixOption(bg)}
+ {*listbox.background $tixOption(light1_bg)}
+ }
+
+ tixDefOption {TixScrolledText} {
+ {.background $tixOption(bg)}
+ {*Scrollbar.background $tixOption(bg)}
+ {*Scrollbar.troughColor $tixOption(light1_bg)}
+ }
+
+
+ # SCROLLED_WINDOW
+ #
+ tixDefOption {TixScrolledWindow} {
+ {.background $tixOption(bg)}
+ {*Scrollbar.background $tixOption(bg)}
+ {*Scrollbar.troughColor $tixOption(light1_bg)}
+ {.frame.background $tixOption(light1_bg)}
+ }
+
+
+ # SELECT
+ #
+ tixDefOption {TixSelect} {
+ }
+
+ tixDefOption {TixTree} {
+ {.background $tixOption(bg)}
+ {*Scrollbar.background $tixOption(bg)}
+ {*Scrollbar.troughColor $tixOption(light1_bg)}
+ {*hlist.highlightBackground $tixOption(bg)}
+ {*hlist.background $tixOption(light1_bg)}
+ {*hlist.borderWidth 1}
+ }
+ # NON ALPHABETICAL ORDER WIDGETS
+
+ # Since TK's option database follows the order-of-declaration rule, not
+ # specific-vs-general rule, the options of the widgets below depends on
+ # the options of the widget above, so their options must be defined here
+
+ # COMBOBOX
+ if {! $isWin} then {
+ tixDefOption {TixComboBox} {
+ {*Entry.font $tixOption(font)}
+ {*Entry.highlightBackground $tixOption(bg)}
+ {*Entry.background $tixOption(input1_bg)}
+ {*Entry.foreground black}
+ {*Entry.insertBackground black}
+ }
+ } else {
+ tixDefOption {TixComboBox} {
+ {*Entry.font $tixOption(font)}
+ {*Entry.highlightBackground $tixOption(input1_bg)}
+ {*Entry.background $tixOption(input1_bg)}
+ {*Entry.foreground SystemWindowText}
+ {*Entry.insertBackground SystemWindowText}
+ {*Entry.selectBackground $tixOption(select_bg)}
+ {*Entry.selectForeground $tixOption(select_fg)}
+ {*TixScrolledListBox.selectBackground $tixOption(select_bg)}
+ {*TixScrolledListBox.selectForeground $tixOption(select_fg)}
+ }
+ }
+
+ # FILE_SELECT_BOX
+ #
+ tixDefOption {TixFileSelectBox} {
+ {*Label.font $tixOption(bold_font)}
+ }
+
+ tixDefOption {TixExFileSelectBox} {
+ }
+}
+
+#----------------------------------------------------------------------
+# The default fontset and schemes
+#
+#----------------------------------------------------------------------
+
+source ../DefSchm.tcl
+rename tixSetDefaultFontset tixSetFontset
+rename tixSetDefaultScheme-Color tixSetScheme-Color
+rename tixSetDefaultScheme-Mono tixSetScheme-Mono
+
+#----------------------------------------------------------------------
+# Action:
+#----------------------------------------------------------------------
+if [string match TK* [lindex $argv 1]] {
+ set isTK 1
+} elseif {[string match TkWin* [lindex $argv 1]]} {
+ set isTK 0
+ set isWin 1
+} else {
+ set isTK 0
+ set isWin 0
+}
+set schemeName [lindex [split [lindex $argv 1] "."] 0]
+source [lindex $argv 1]
+
+
+tixSetFontset
+
+if {[lindex $argv 0] == "-font"} {
+
+ set isFont 1
+
+ # FontSets will be set in two steps.
+ # (1) init fontsets
+ # ... tix checks the validity of the fonts ...
+ # (2) add the fontsets into the option database.
+ #
+ puts "proc tixPref:InitFontSet:$schemeName {} { "
+ puts [info body tixSetFontset]
+ puts "}"
+
+ puts "proc tixPref:SetFontSet:$schemeName {} { "
+ puts "global tixOption"
+ if {! $isTK} {
+ tixInitOptionDatabase $isWin
+ }
+ puts "}"
+
+
+} else {
+ set isFont 0
+
+ # Do the Color First
+ #
+ puts "proc tixPref:SetScheme-Color:$schemeName {} {"
+ puts [info body tixSetScheme-Color]
+ if {! $isTK} {
+ tixSetScheme-Color
+ tixInitOptionDatabase $isWin
+ }
+ puts "}"
+
+ # Now Do the Mono
+ #
+ puts "proc tixPref:SetScheme-Mono:$schemeName {} {"
+ puts [info body tixSetScheme-Mono]
+ if {! $isTK} {
+ tixSetScheme-Mono
+ tixInitOptionDatabase $isWin
+ }
+ puts "}"
+}
diff --git a/tix/library/tclIndex b/tix/library/tclIndex
new file mode 100644
index 00000000000..2169b60e24f
--- /dev/null
+++ b/tix/library/tclIndex
@@ -0,0 +1,521 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "tixindex" program,
+# *NOT* by the "auto_mkindex" command,
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(tixBalloon) "source {$dir/Balloon.tcl}"
+set auto_index(tixBalloon:AutoLoad) "source {$dir/Balloon.tcl}"
+set auto_index(tixBalloon_XXMotion) "source {$dir/Balloon.tcl}"
+set auto_index(tixBalloon_XXButton) "source {$dir/Balloon.tcl}"
+set auto_index(tixBalloon_XXButtonUp) "source {$dir/Balloon.tcl}"
+set auto_index(tixIsDescendant) "source {$dir/Balloon.tcl}"
+set auto_index(tixBalIgnoreWhenGrabbed) "source {$dir/Balloon.tcl}"
+set auto_index(tixButtonBox) "source {$dir/BtnBox.tcl}"
+set auto_index(tixButtonBox:AutoLoad) "source {$dir/BtnBox.tcl}"
+set auto_index(tixCObjView) "source {$dir/CObjView.tcl}"
+set auto_index(tixCObjView:AutoLoad) "source {$dir/CObjView.tcl}"
+set auto_index(tixCheckList) "source {$dir/ChkList.tcl}"
+set auto_index(tixCheckList:AutoLoad) "source {$dir/ChkList.tcl}"
+set auto_index(tixComboBox) "source {$dir/ComboBox.tcl}"
+set auto_index(tixComboBox:AutoLoad) "source {$dir/ComboBox.tcl}"
+set auto_index(tixComboBoxBind) "source {$dir/ComboBox.tcl}"
+set auto_index(tixDlgBtns) "source {$dir/Compat.tcl}"
+set auto_index(tixStdDlgBtns) "source {$dir/Compat.tcl}"
+set auto_index(tixCombobox) "source {$dir/Compat.tcl}"
+set auto_index(tixFileSelectbox) "source {$dir/Compat.tcl}"
+set auto_index(tixScrolledListbox) "source {$dir/Compat.tcl}"
+set auto_index(tixInit) "source {$dir/Compat.tcl}"
+set auto_index(tixConsoleInit) "source {$dir/Console.tcl}"
+set auto_index(tixConsoleSetFont) "source {$dir/Console.tcl}"
+set auto_index(tixConsoleInvoke) "source {$dir/Console.tcl}"
+set auto_index(tixConsoleHistory) "source {$dir/Console.tcl}"
+set auto_index(tixConsolePrompt) "source {$dir/Console.tcl}"
+set auto_index(tixConsoleBind) "source {$dir/Console.tcl}"
+set auto_index(tixConsoleInsert) "source {$dir/Console.tcl}"
+set auto_index(tixConsoleOutput) "source {$dir/Console.tcl}"
+set auto_index(tixConsoleExit) "source {$dir/Console.tcl}"
+set auto_index(tixControl) "source {$dir/Control.tcl}"
+set auto_index(tixControl:AutoLoad) "source {$dir/Control.tcl}"
+set auto_index(tixControlBind) "source {$dir/Control.tcl}"
+set auto_index(tixSetDefaultFontset) "source {$dir/DefSchm.tcl}"
+set auto_index(tixSetDefaultScheme-Color) "source {$dir/DefSchm.tcl}"
+set auto_index(tixSetDefaultScheme-Mono) "source {$dir/DefSchm.tcl}"
+set auto_index(tixDialogShell) "source {$dir/DialogS.tcl}"
+set auto_index(tixDialogShell:AutoLoad) "source {$dir/DialogS.tcl}"
+set auto_index(tixDirSelectBox) "source {$dir/DirBox.tcl}"
+set auto_index(tixDirSelectBox:AutoLoad) "source {$dir/DirBox.tcl}"
+set auto_index(tixDirSelectDialog) "source {$dir/DirDlg.tcl}"
+set auto_index(tixDirSelectDialog:AutoLoad) "source {$dir/DirDlg.tcl}"
+set auto_index(tixDirList) "source {$dir/DirList.tcl}"
+set auto_index(tixDirList:AutoLoad) "source {$dir/DirList.tcl}"
+set auto_index(tixDirTree) "source {$dir/DirTree.tcl}"
+set auto_index(tixDirTree:AutoLoad) "source {$dir/DirTree.tcl}"
+set auto_index(tixDragDropContext) "source {$dir/DragDrop.tcl}"
+set auto_index(tixDragDropContext:AutoLoad) "source {$dir/DragDrop.tcl}"
+set auto_index(tixGetDragDropContext) "source {$dir/DragDrop.tcl}"
+set auto_index(tixDropBind) "source {$dir/DragDrop.tcl}"
+set auto_index(tixDropBindTags) "source {$dir/DragDrop.tcl}"
+set auto_index(tixDetailList) "source {$dir/DtlList.tcl}"
+set auto_index(tixDetailList:AutoLoad) "source {$dir/DtlList.tcl}"
+set auto_index(tixExFileSelectBox) "source {$dir/EFileBox.tcl}"
+set auto_index(tixExFileSelectBox:AutoLoad) "source {$dir/EFileBox.tcl}"
+set auto_index(tixExFileSelectDialog) "source {$dir/EFileDlg.tcl}"
+set auto_index(tixExFileSelectDialog:AutoLoad) "source {$dir/EFileDlg.tcl}"
+set auto_index(tixBind) "source {$dir/Event.tcl}"
+set auto_index(tixPushEventStack) "source {$dir/Event.tcl}"
+set auto_index(tixPopEventStack) "source {$dir/Event.tcl}"
+set auto_index(_tixRecordFlags) "source {$dir/Event.tcl}"
+set auto_index(_tixDeleteFlags) "source {$dir/Event.tcl}"
+set auto_index(tixEvalCmdBinding) "source {$dir/Event.tcl}"
+set auto_index(tixEvent) "source {$dir/Event.tcl}"
+set auto_index(tixBuiltInCmdErrorHandler) "source {$dir/Event.tcl}"
+set auto_index(tixFileSelectBox) "source {$dir/FileBox.tcl}"
+set auto_index(tixFileSelectBox:AutoLoad) "source {$dir/FileBox.tcl}"
+set auto_index(tixMkFileDialog) "source {$dir/FileBox.tcl}"
+set auto_index(tixFileComboBox) "source {$dir/FileCbx.tcl}"
+set auto_index(tixFileComboBox:AutoLoad) "source {$dir/FileCbx.tcl}"
+set auto_index(tixFileResolveName) "source {$dir/FileCmpt.tcl}"
+set auto_index(tixNSubFolder) "source {$dir/FileCmpt.tcl}"
+set auto_index(tixFileSelectDialog) "source {$dir/FileDlg.tcl}"
+set auto_index(tixFileSelectDialog:AutoLoad) "source {$dir/FileDlg.tcl}"
+set auto_index(tixFileEntry) "source {$dir/FileEnt.tcl}"
+set auto_index(tixFileEntry:AutoLoad) "source {$dir/FileEnt.tcl}"
+set auto_index(tixResolveDir) "source {$dir/FileUtil.tcl}"
+set auto_index(tixCompressDotDot) "source {$dir/FileUtil.tcl}"
+set auto_index(tixFloatEntry) "source {$dir/FloatEnt.tcl}"
+set auto_index(tixFloatEntry:AutoLoad) "source {$dir/FloatEnt.tcl}"
+set auto_index(tixFloatEntryBind) "source {$dir/FloatEnt.tcl}"
+set auto_index(tixGridBind) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:Button-1) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:Shift-Button-1) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:Control-Button-1) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:ButtonRelease-1) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:B1-Motion) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:Control-B1-Motion) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:Double-1) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:B1-Leave) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:B1-Enter) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:Control-B1-Leave) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:Control-B1-Enter) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:AutoScan) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:DirKey) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:Return) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:Space) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GetState) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:SetState) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:SelectSingle) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-0) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-1) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-2) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-3) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-5) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-4) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-s5) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-s6) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-s7) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-s8) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-s9) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-s10) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-b0) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-b1) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-b2) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-b3) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-b4) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-b5) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-b6) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-b7) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-b8) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-b9) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-b10) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-m0) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-m1) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-m2) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-m3) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-m4) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-m5) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-m6) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-m7) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-m8) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-m9) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-xm7) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-e0) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-e1) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-e2) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-e3) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-e4) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-e5) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-e6) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-e7) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-e8) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-e9) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-e10) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-xm7) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-12) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-13) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-14) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-16) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-18) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-20) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-21) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:GoState-22) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:SetAnchor) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:Select) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:StartScan) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:DoScan) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:CallBrowseCmd) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:CallCommand) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:EditCell) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:EditApply) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:CheckEdit) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:SetEdit) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:DoneEdit) "source {$dir/Grid.tcl}"
+set auto_index(tixGrid:SetFocus) "source {$dir/Grid.tcl}"
+set auto_index(tixHListBind) "source {$dir/HList.tcl}"
+set auto_index(tixHList:Keyboard-Activate) "source {$dir/HList.tcl}"
+set auto_index(tixHList:Keyboard-Browse) "source {$dir/HList.tcl}"
+set auto_index(tixHList:LeftRight) "source {$dir/HList.tcl}"
+set auto_index(tixHList:UpDown) "source {$dir/HList.tcl}"
+set auto_index(tixHList:Button-1) "source {$dir/HList.tcl}"
+set auto_index(tixHList:ButtonRelease-1) "source {$dir/HList.tcl}"
+set auto_index(tixHList:Double-1) "source {$dir/HList.tcl}"
+set auto_index(tixHList:B1-Motion) "source {$dir/HList.tcl}"
+set auto_index(tixHList:B1-Leave) "source {$dir/HList.tcl}"
+set auto_index(tixHList:B1-Enter) "source {$dir/HList.tcl}"
+set auto_index(tixHList:AutoScan) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GetState) "source {$dir/HList.tcl}"
+set auto_index(tixHList:SetState) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-0) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-1) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-5) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-6) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-10) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-11) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-12) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-13) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-14) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-16) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-18) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-20) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-21) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-22) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-23) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-24) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-25) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-26) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-27) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-28) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-29) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-30) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-31) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-32) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GoState-33) "source {$dir/HList.tcl}"
+set auto_index(tixHList:GetNearest) "source {$dir/HList.tcl}"
+set auto_index(tixHList:SetAnchor) "source {$dir/HList.tcl}"
+set auto_index(tixHList:Select) "source {$dir/HList.tcl}"
+set auto_index(tixHList:StartScan) "source {$dir/HList.tcl}"
+set auto_index(tixHList:DoScan) "source {$dir/HList.tcl}"
+set auto_index(tixHList:CallIndicatorCmd) "source {$dir/HList.tcl}"
+set auto_index(tixHList:InsideArmedIndicator) "source {$dir/HList.tcl}"
+set auto_index(tixHList:Browse) "source {$dir/HList.tcl}"
+set auto_index(tixHListSingle:DragTimer) "source {$dir/HListDD.tcl}"
+set auto_index(tixHListSingle:Send:WaitDrag) "source {$dir/HListDD.tcl}"
+set auto_index(tixHListSingle:Send:StartDrag) "source {$dir/HListDD.tcl}"
+set auto_index(tixHListSingle:Send:DoneDrag) "source {$dir/HListDD.tcl}"
+set auto_index(tixHListSingle:Send:Cmd) "source {$dir/HListDD.tcl}"
+set auto_index(tixHListSingle:Rec:DragOver) "source {$dir/HListDD.tcl}"
+set auto_index(tixHListSingle:Rec:DragIn) "source {$dir/HListDD.tcl}"
+set auto_index(tixHListSingle:Rec:DragOut) "source {$dir/HListDD.tcl}"
+set auto_index(tixHListSingle:Rec:Drop) "source {$dir/HListDD.tcl}"
+set auto_index(tixIconView) "source {$dir/IconView.tcl}"
+set auto_index(tixIconView:AutoLoad) "source {$dir/IconView.tcl}"
+set auto_index(__tixError) "source {$dir/Init.tcl}"
+set auto_index(__tixInit) "source {$dir/Init.tcl}"
+set auto_index(tixLabelEntry) "source {$dir/LabEntry.tcl}"
+set auto_index(tixLabelEntry:AutoLoad) "source {$dir/LabEntry.tcl}"
+set auto_index(tixLabelEntryBind) "source {$dir/LabEntry.tcl}"
+set auto_index(tixLabelFrame) "source {$dir/LabFrame.tcl}"
+set auto_index(tixLabelFrame:AutoLoad) "source {$dir/LabFrame.tcl}"
+set auto_index(tixLabelWidget) "source {$dir/LabWidg.tcl}"
+set auto_index(tixLabelWidget:AutoLoad) "source {$dir/LabWidg.tcl}"
+set auto_index(tixListNoteBook) "source {$dir/ListNBk.tcl}"
+set auto_index(tixListNoteBook:AutoLoad) "source {$dir/ListNBk.tcl}"
+set auto_index(tixMeter) "source {$dir/Meter.tcl}"
+set auto_index(tixMeter:AutoLoad) "source {$dir/Meter.tcl}"
+set auto_index(tixMultiView) "source {$dir/MultView.tcl}"
+set auto_index(tixMultiView:AutoLoad) "source {$dir/MultView.tcl}"
+set auto_index(tixNoteBook) "source {$dir/NoteBook.tcl}"
+set auto_index(tixNoteBook:AutoLoad) "source {$dir/NoteBook.tcl}"
+set auto_index(tixNoteBookFind) "source {$dir/NoteBook.tcl}"
+set auto_index(tixTraverseToNoteBook) "source {$dir/NoteBook.tcl}"
+set auto_index(setenv) "source {$dir/OldUtil.tcl}"
+set auto_index(tixSetEntry) "source {$dir/OldUtil.tcl}"
+set auto_index(tixListGetSingle) "source {$dir/OldUtil.tcl}"
+set auto_index(tixDialogRestore) "source {$dir/OldUtil.tcl}"
+set auto_index(tixDialogWithdraw) "source {$dir/OldUtil.tcl}"
+set auto_index(tixDialogDestroy) "source {$dir/OldUtil.tcl}"
+set auto_index(tixQueryAppResource) "source {$dir/OldUtil.tcl}"
+set auto_index(tixCreateToplevel) "source {$dir/OldUtil.tcl}"
+set auto_index(_tixToplevelDestroy) "source {$dir/OldUtil.tcl}"
+set auto_index(_tixToplevelUnmap) "source {$dir/OldUtil.tcl}"
+set auto_index(_tixToplevelMap) "source {$dir/OldUtil.tcl}"
+set auto_index(_tixToplevelVisibility) "source {$dir/OldUtil.tcl}"
+set auto_index(tixCreateDialogShell) "source {$dir/OldUtil.tcl}"
+set auto_index(_tixDialogDestroy) "source {$dir/OldUtil.tcl}"
+set auto_index(_tixInitMainWindow) "source {$dir/OldUtil.tcl}"
+set auto_index(tixOptionMenu) "source {$dir/OptMenu.tcl}"
+set auto_index(tixOptionMenu:AutoLoad) "source {$dir/OptMenu.tcl}"
+set auto_index(tixPanedWindow) "source {$dir/PanedWin.tcl}"
+set auto_index(tixPanedWindow:AutoLoad) "source {$dir/PanedWin.tcl}"
+set auto_index(tixPopupMenu) "source {$dir/PopMenu.tcl}"
+set auto_index(tixPopupMenu:AutoLoad) "source {$dir/PopMenu.tcl}"
+set auto_index(tixPrimitive) "source {$dir/Primitiv.tcl}"
+set auto_index(tixPrimitive:AutoLoad) "source {$dir/Primitiv.tcl}"
+set auto_index(tixResizeHandle) "source {$dir/ResizeH.tcl}"
+set auto_index(tixResizeHandle:AutoLoad) "source {$dir/ResizeH.tcl}"
+set auto_index(tixDeleteBindTag) "source {$dir/ResizeH.tcl}"
+set auto_index(tixAddBindTag) "source {$dir/ResizeH.tcl}"
+set auto_index(tixScrolledGrid) "source {$dir/SGrid.tcl}"
+set auto_index(tixScrolledGrid:AutoLoad) "source {$dir/SGrid.tcl}"
+set auto_index(tixScrolledGridBind) "source {$dir/SGrid.tcl}"
+set auto_index(tixScrolledHList) "source {$dir/SHList.tcl}"
+set auto_index(tixScrolledHList:AutoLoad) "source {$dir/SHList.tcl}"
+set auto_index(tixScrolledListBox) "source {$dir/SListBox.tcl}"
+set auto_index(tixScrolledListBox:AutoLoad) "source {$dir/SListBox.tcl}"
+set auto_index(tixScrolledListBoxBind) "source {$dir/SListBox.tcl}"
+set auto_index(tixScrolledTList) "source {$dir/STList.tcl}"
+set auto_index(tixScrolledTList:AutoLoad) "source {$dir/STList.tcl}"
+set auto_index(tixScrolledText) "source {$dir/SText.tcl}"
+set auto_index(tixScrolledText:AutoLoad) "source {$dir/SText.tcl}"
+set auto_index(tixScrolledWidget) "source {$dir/SWidget.tcl}"
+set auto_index(tixScrolledWidget:AutoLoad) "source {$dir/SWidget.tcl}"
+set auto_index(tixScrolledWindow) "source {$dir/SWindow.tcl}"
+set auto_index(tixScrolledWindow:AutoLoad) "source {$dir/SWindow.tcl}"
+set auto_index(tixSelect) "source {$dir/Select.tcl}"
+set auto_index(tixSelect:AutoLoad) "source {$dir/Select.tcl}"
+set auto_index(tixShell) "source {$dir/Shell.tcl}"
+set auto_index(tixShell:AutoLoad) "source {$dir/Shell.tcl}"
+set auto_index(tixSimpleDialog) "source {$dir/SimpDlg.tcl}"
+set auto_index(tixSimpleDialog:AutoLoad) "source {$dir/SimpDlg.tcl}"
+set auto_index(tixStackWindow) "source {$dir/StackWin.tcl}"
+set auto_index(tixStackWindow:AutoLoad) "source {$dir/StackWin.tcl}"
+set auto_index(tixStatusBar) "source {$dir/StatBar.tcl}"
+set auto_index(tixStatusBar:AutoLoad) "source {$dir/StatBar.tcl}"
+set auto_index(tixStdButtonBox) "source {$dir/StdBBox.tcl}"
+set auto_index(tixStdButtonBox:AutoLoad) "source {$dir/StdBBox.tcl}"
+set auto_index(tixStdDialogShell) "source {$dir/StdShell.tcl}"
+set auto_index(tixStdDialogShell:AutoLoad) "source {$dir/StdShell.tcl}"
+set auto_index(tixTListBind) "source {$dir/TList.tcl}"
+set auto_index(tixTList:Button-1) "source {$dir/TList.tcl}"
+set auto_index(tixTList:Shift-Button-1) "source {$dir/TList.tcl}"
+set auto_index(tixTList:Control-Button-1) "source {$dir/TList.tcl}"
+set auto_index(tixTList:ButtonRelease-1) "source {$dir/TList.tcl}"
+set auto_index(tixTList:B1-Motion) "source {$dir/TList.tcl}"
+set auto_index(tixTList:Control-B1-Motion) "source {$dir/TList.tcl}"
+set auto_index(tixTList:Double-1) "source {$dir/TList.tcl}"
+set auto_index(tixTList:B1-Leave) "source {$dir/TList.tcl}"
+set auto_index(tixTList:B1-Enter) "source {$dir/TList.tcl}"
+set auto_index(tixTList:Control-B1-Leave) "source {$dir/TList.tcl}"
+set auto_index(tixTList:Control-B1-Enter) "source {$dir/TList.tcl}"
+set auto_index(tixTList:AutoScan) "source {$dir/TList.tcl}"
+set auto_index(tixTList:DirKey) "source {$dir/TList.tcl}"
+set auto_index(tixTList:Return) "source {$dir/TList.tcl}"
+set auto_index(tixTList:Space) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GetState) "source {$dir/TList.tcl}"
+set auto_index(tixTList:SetState) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-s0) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-s1) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-s2) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-s3) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-s4) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-s5) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-s6) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-s7) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-s8) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-s9) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-s10) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-b0) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-b1) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-b2) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-b3) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-b4) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-b5) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-b6) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-b7) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-b8) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-b9) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-b10) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-m0) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-m1) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-m2) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-m3) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-m4) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-m5) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-m6) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-m7) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-m8) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-m9) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-xm7) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-e0) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-e1) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-e2) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-e3) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-e4) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-e5) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-e6) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-e7) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-e8) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-e9) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-e10) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-xm7) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-12) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-13) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-14) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-16) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-18) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-20) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-21) "source {$dir/TList.tcl}"
+set auto_index(tixTList:GoState-22) "source {$dir/TList.tcl}"
+set auto_index(tixTList:SetAnchor) "source {$dir/TList.tcl}"
+set auto_index(tixTList:Select) "source {$dir/TList.tcl}"
+set auto_index(tixTList:StartScan) "source {$dir/TList.tcl}"
+set auto_index(tixTList:DoScan) "source {$dir/TList.tcl}"
+set auto_index(tixTList:CallBrowseCmd) "source {$dir/TList.tcl}"
+set auto_index(tixTList:CallCommand) "source {$dir/TList.tcl}"
+set auto_index(tix) "source {$dir/Tix.tcl}"
+set auto_index(tixAppContext) "source {$dir/Tix.tcl}"
+set auto_index(tixAppContext:AutoLoad) "source {$dir/Tix.tcl}"
+set auto_index(tixTree) "source {$dir/Tree.tcl}"
+set auto_index(tixTree:AutoLoad) "source {$dir/Tree.tcl}"
+set auto_index(tixInitFileCmpt:Unix) "source {$dir/UnixFile.tcl}"
+set auto_index(tixFSSplit) "source {$dir/UnixFile.tcl}"
+set auto_index(tixFSValid) "source {$dir/UnixFile.tcl}"
+set auto_index(tixFSSep) "source {$dir/UnixFile.tcl}"
+set auto_index(tixFSIntName) "source {$dir/UnixFile.tcl}"
+set auto_index(tixFSResolveName) "source {$dir/UnixFile.tcl}"
+set auto_index(tixFSListDir) "source {$dir/UnixFile.tcl}"
+set auto_index(_tixFSMakeList) "source {$dir/UnixFile.tcl}"
+set auto_index(tixDirSep) "source {$dir/UnixFile.tcl}"
+set auto_index(tixFSInfo) "source {$dir/UnixFile.tcl}"
+set auto_index(tixFileIntName) "source {$dir/UnixFile.tcl}"
+set auto_index(tixNativeName) "source {$dir/UnixFile.tcl}"
+set auto_index(tixFileDisplayName) "source {$dir/UnixFile.tcl}"
+set auto_index(tixFileSplit) "source {$dir/UnixFile.tcl}"
+set auto_index(tixSubFolder) "source {$dir/UnixFile.tcl}"
+set auto_index(tixListDir) "source {$dir/UnixFile.tcl}"
+set auto_index(tixRootDir) "source {$dir/UnixFile.tcl}"
+set auto_index(tixIsAbsPath) "source {$dir/UnixFile.tcl}"
+set auto_index(tixVerifyFile) "source {$dir/UnixFile.tcl}"
+set auto_index(tixFilePattern) "source {$dir/UnixFile.tcl}"
+set auto_index(tixHandleArgv) "source {$dir/Utils.tcl}"
+set auto_index(tixDisableAll) "source {$dir/Utils.tcl}"
+set auto_index(tixEnableAll) "source {$dir/Utils.tcl}"
+set auto_index(tixDescendants) "source {$dir/Utils.tcl}"
+set auto_index(tixForEach) "source {$dir/Utils.tcl}"
+set auto_index(tixTopLevel) "source {$dir/Utils.tcl}"
+set auto_index(tixInt_Expand) "source {$dir/Utils.tcl}"
+set auto_index(tixPConfig) "source {$dir/Utils.tcl}"
+set auto_index(tixAppendBindTag) "source {$dir/Utils.tcl}"
+set auto_index(tixAddBindTag) "source {$dir/Utils.tcl}"
+set auto_index(tixSubwidgetRef) "source {$dir/Utils.tcl}"
+set auto_index(tixSubwidgetRetCreate) "source {$dir/Utils.tcl}"
+set auto_index(tixSubwidgetRetDelete) "source {$dir/Utils.tcl}"
+set auto_index(tixListboxGetCurrent) "source {$dir/Utils.tcl}"
+set auto_index(tixSetMegaWidget) "source {$dir/Utils.tcl}"
+set auto_index(tixGetMegaWidget) "source {$dir/Utils.tcl}"
+set auto_index(tixUnsetMegaWidget) "source {$dir/Utils.tcl}"
+set auto_index(tixBusy) "source {$dir/Utils.tcl}"
+set auto_index(tixOptionName) "source {$dir/Utils.tcl}"
+set auto_index(tixSetSilent) "source {$dir/Utils.tcl}"
+set auto_index(tixSetChooser) "source {$dir/Utils.tcl}"
+set auto_index(tixBreak) "source {$dir/Utils.tcl}"
+set auto_index(tixDestroy) "source {$dir/Utils.tcl}"
+set auto_index(tixPushGrab) "source {$dir/Utils.tcl}"
+set auto_index(tixPopGrab) "source {$dir/Utils.tcl}"
+set auto_index(tixWithinWindow) "source {$dir/Utils.tcl}"
+set auto_index(tixWinWidth) "source {$dir/Utils.tcl}"
+set auto_index(tixWinHeight) "source {$dir/Utils.tcl}"
+set auto_index(tixWinCmd) "source {$dir/Utils.tcl}"
+set auto_index(tixVResize) "source {$dir/VResize.tcl}"
+set auto_index(tixVResize:AutoLoad) "source {$dir/VResize.tcl}"
+set auto_index(tixVStack) "source {$dir/VStack.tcl}"
+set auto_index(tixVStack:AutoLoad) "source {$dir/VStack.tcl}"
+set auto_index(tixVTree) "source {$dir/VTree.tcl}"
+set auto_index(tixVTree:AutoLoad) "source {$dir/VTree.tcl}"
+set auto_index(tixVariable:ConfigVariable) "source {$dir/Variable.tcl}"
+set auto_index(tixVariable:UpdateVariable) "source {$dir/Variable.tcl}"
+set auto_index(tixVariable:TraceProc) "source {$dir/Variable.tcl}"
+set auto_index(tixVariable:DeleteVariable) "source {$dir/Variable.tcl}"
+set auto_index(tixVerifyBoolean) "source {$dir/Verify.tcl}"
+set auto_index(tixVerifyDirectory) "source {$dir/Verify.tcl}"
+set auto_index(tixScriptVersion) "source {$dir/Version.tcl}"
+set auto_index(tixScriptPatchLevel) "source {$dir/Version.tcl}"
+set auto_index(tixWInfo) "source {$dir/WInfo.tcl}"
+set auto_index(tixInitFileCmpt:Win) "source {$dir/WinFile.tcl}"
+set auto_index(tixFSSplit) "source {$dir/WinFile.tcl}"
+set auto_index(tixFSValid) "source {$dir/WinFile.tcl}"
+set auto_index(tixFSIntName) "source {$dir/WinFile.tcl}"
+set auto_index(tixFSIntJoin) "source {$dir/WinFile.tcl}"
+set auto_index(tixFSJoin) "source {$dir/WinFile.tcl}"
+set auto_index(tixFSResolveName) "source {$dir/WinFile.tcl}"
+set auto_index(tixFSListDir) "source {$dir/WinFile.tcl}"
+set auto_index(tixFSMakeList) "source {$dir/WinFile.tcl}"
+set auto_index(tixFSSep) "source {$dir/WinFile.tcl}"
+set auto_index(tixFSGetDrives) "source {$dir/WinFile.tcl}"
+set auto_index(tixDirSep) "source {$dir/WinFile.tcl}"
+set auto_index(tixRootDir) "source {$dir/WinFile.tcl}"
+set auto_index(tixIsAbsPath) "source {$dir/WinFile.tcl}"
+set auto_index(tixWinGetFileDrive) "source {$dir/WinFile.tcl}"
+set auto_index(tixWinGetFilePath) "source {$dir/WinFile.tcl}"
+set auto_index(tixWinCurrentDrive) "source {$dir/WinFile.tcl}"
+set auto_index(tixWinGetPathFromDrive) "source {$dir/WinFile.tcl}"
+set auto_index(tixFileIntName) "source {$dir/WinFile.tcl}"
+set auto_index(tixNativeName) "source {$dir/WinFile.tcl}"
+set auto_index(tixFileDisplayName) "source {$dir/WinFile.tcl}"
+set auto_index(tixFileSplit) "source {$dir/WinFile.tcl}"
+set auto_index(tixSubFolder) "source {$dir/WinFile.tcl}"
+set auto_index(tixWinGetDrives) "source {$dir/WinFile.tcl}"
+set auto_index(tixListDir) "source {$dir/WinFile.tcl}"
+set auto_index(tixVerifyFile) "source {$dir/WinFile.tcl}"
+set auto_index(tixFilePattern) "source {$dir/WinFile.tcl}"
+set auto_index(tixWinFileEmu) "source {$dir/WinFile.tcl}"
+set auto_index(tixAssert) "source {$dir/fs.tcl}"
+set auto_index(tixAssertNorm) "source {$dir/fs.tcl}"
+set auto_index(tixAssertVPath) "source {$dir/fs.tcl}"
+set auto_index(tixFSAbsPath) "source {$dir/fs.tcl}"
+set auto_index(tixFSVPWD) "source {$dir/fs.tcl}"
+set auto_index(tixFSPWD) "source {$dir/fs.tcl}"
+set auto_index(tixFSDisplayName) "source {$dir/fs.tcl}"
+set auto_index(tixFSIsAbsPath) "source {$dir/fs.tcl}"
+set auto_index(tixFSIsNorm_os) "source {$dir/fs.tcl}"
+set auto_index(tixFSIsNorm) "source {$dir/fs.tcl}"
+set auto_index(tixFSIsValid) "source {$dir/fs.tcl}"
+set auto_index(tixFSIsVPath) "source {$dir/fs.tcl}"
+set auto_index(tixFSVPath) "source {$dir/fs.tcl}"
+set auto_index(tixFSPath) "source {$dir/fs.tcl}"
+set auto_index(tixFSTildeSubst) "source {$dir/fs.tcl}"
+set auto_index(tixFSNorm) "source {$dir/fs.tcl}"
+set auto_index(_tixJoin) "source {$dir/fs.tcl}"
+set auto_index(tixFSNormDir) "source {$dir/fs.tcl}"
+set auto_index(_tixNormalize) "source {$dir/fs.tcl}"
+set auto_index(tixFSCreateDirs) "source {$dir/fs.tcl}"
+set auto_index(tixFSPWD) "source {$dir/fs.tcl}"
+set auto_index(tixFSIsNorm) "source {$dir/fs.tcl}"
+set auto_index(tixFSNorm) "source {$dir/fs.tcl}"
+set auto_index(_tixJoin) "source {$dir/fs.tcl}"
+set auto_index(tixFSIsAbsPath) "source {$dir/fs.tcl}"
+set auto_index(tixFSIsNorm_os) "source {$dir/fs.tcl}"
+set auto_index(_tixNormalize) "source {$dir/fs.tcl}"
+set auto_index(tixFSNormDir) "source {$dir/fs.tcl}"
+set auto_index(tixPanic) "source {$dir/fs.tcl}"
+set auto_index(tixFSIsValid) "source {$dir/fs.tcl}"
+set auto_index(tixFSIsVPath) "source {$dir/fs.tcl}"
+set auto_index(tixFSVPath) "source {$dir/fs.tcl}"
+set auto_index(tixFSPath) "source {$dir/fs.tcl}"
+set auto_index(tixFSDisplayName) "source {$dir/fs.tcl}"
diff --git a/tix/license.terms b/tix/license.terms
new file mode 100644
index 00000000000..47568a1cd53
--- /dev/null
+++ b/tix/license.terms
@@ -0,0 +1,32 @@
+Copyright (c) 1993-95 Ioi Kim Lam.
+Copyright (c) 1996 Expert Interface Technologies.
+
+Permission is hereby granted, without written agreement and without
+license or royalty fees, to use, copy, modify, and distribute this
+software and its documentation for any purpose, provided that the
+above copyright notice and the following two paragraphs appear in all
+copies of this software.
+
+IN NO EVENT SHALL THE AUTHORS OF THIS SOFTWARE BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF
+THE AUTHORS OF THIS SOFTWARE HAVE BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGE.
+
+THE AUTHORS OF THIS SOFTWARE SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
+FITNESS FOR A PARTICULAR PURPOSE. THE SOFTWARE PROVIDED HEREUNDER IS ON
+AN "AS IS" BASIS, AND THE AUTHORS OF THIS SOFTWARE HAVE NO OBLIGATION TO
+PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
+
+----------------------------------------------------------------------
+
+Parts of this software are based on the Tcl/Tk software copyrighted by
+the Regents of the University of California, Sun Microsystems, Inc.,
+and other parties. The original license terms of the Tcl/Tk software
+distribution is included in the file docs/license.tcltk.
+
+Parts of this software are based on the HTML Library software
+copyrighted by Sun Microsystems, Inc. The original license terms of
+the HTML Library software distribution is included in the file
+docs/license.html_lib.
diff --git a/tix/man/Balloon.html b/tix/man/Balloon.html
new file mode 100644
index 00000000000..8856d076c92
--- /dev/null
+++ b/tix/man/Balloon.html
@@ -0,0 +1,174 @@
+
+
+
+<TITLE>tixBalloon - Create and manipulate tixBalloon widgets</TITLE>
+<Center><H2>tixBalloon - Create and manipulate tixBalloon widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixBalloon<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+The <B>tixBalloon</B></I> class is derived from the <B>TixShell</B></I>
+class and inherits all the commands, options and subwidgets of its
+super-class.
+</pre><H3>STANDARD OPTIONS</H3>
+The Balloon widget supports all the standard options of a frame widget.
+See the <B>options(n)</B></I> manual entry for details on the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>initWait</B></I>
+Class: <B>InitWait</B></I>
+Switch: <B>-initwait</B></I>
+</code></code></code></pre>
+<UL>
+In milliseconds. Specifies how long the balloon should wait before
+popping up in a widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>state</B></I>
+Class: <B>State</B></I>
+Switch: <B>-state</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the which help message to display when the mouse pointer
+enters a widget associated with this balloon. Valid options are
+<B>both</B></I>: display both the balloon message and the status bar
+message, <B>balloon</B></I>: display only the balloon message,
+<B>status</B></I>: display only the status bar message and <B>none</B></I>:
+display no messages.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>statusBar</B></I>
+Class: <B>statusBar</B></I>
+Switch: <B>-statusbar</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the widget to use as the status bar of this balloon. This
+widget must have a "-text" option. Usually a label widget is used.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>label</B></I>
+Class: <B>Label</B></I>
+</code></code></code></pre>
+<UL>
+The label widget that shows the little arrow bitmap in the pop-up
+balloon window.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>message</B></I>
+Class: <B>Label</B></I>
+</code></code></code></pre>
+<UL>
+The message widget that shows the descriptive message in the the pop-up
+balloon window.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixBalloon</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a Balloon widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+Balloon widget such as its cursor and relief.
+
+The Balloon widget can be used to show popped-up messages
+that describe the functions of the widgets in an application. A
+Balloon widget can be bound to a number of widgets. When the user
+moves the cursor inside a widget to which a Balloon widget has been
+bound, a small pop-up window with a descriptive message will be shown
+on the screen.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixBalloon</B></I> command creates a new Tcl command whose name is
+command may be used to invoke various operations on the widget. It has
+the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+determine the exact behavior of the command. The following commands
+are possible for Balloon widgets:
+<DL>
+<DT> <I>pathName <B>bind</B></I> widget ?<I>option value ... </I></B>?
+</I></B>
+<DD> Binds the Balloon widget to the <I>widget</I></B>. The messages to be
+shown can be passed as extra arguments to this command in <I>option
+value</B></I> pairs. Possible options: <B>-balloonmsg</B></I> specifies the
+string to show on the pop-up balloon window; <B>-statusmsg</B></I>
+specifies the string to show on the status bar; <B>-msg</B></I> specifies a
+string to show on both the balloon window and the stats bar window.
+When used together, the <B>-msg</B></I> option has a lower precedence than
+the <B>-balloonmsg</B></I> and <B>-statusmsg</B></I> options.
+
+The <B>bind</B></I> command can also be used to change the messages after
+the initial bindings were set. Example:
+</DL>
+<P>
+<pre><code><code><code>
+ button .b
+ tixBalloon .bal
+
+ # Add balloon binding
+ .bal bind .b -msg "This is a button"
+
+ ...
+
+ # Change the balloon binding
+ .bal bind .b -msg "This is a useful button"
+</code></code></code></pre>
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixBalloon</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixBalloon</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>unbind<I> widget</I></B>
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+</DL>
+</pre><H3>BINDINGS</H3>
+<P>
+After a widget has be bound to a Balloon widget, when the user moves
+the cursor into this widget, the Balloon widget is activated: if the
+<B>-balloonmsg</B></I> option of this widget is set, the balloon window
+pops up; if the <B>-statusmsg</B></I> option of this widget is set, the
+message will be displayed in the status bar widget.
+<P>
+When the user moves the cursor out of the widget, the Balloon widget
+is de-activated: the balloon window is withdrawn and the status-bar
+message removed.
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:19 EST 1997 </i> ---
+<i>Serial 853731294</i>
diff --git a/tix/man/Balloon.n b/tix/man/Balloon.n
new file mode 100644
index 00000000000..2c60526d6fc
--- /dev/null
+++ b/tix/man/Balloon.n
@@ -0,0 +1,237 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixBalloon tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixBalloon \- Create and manipulate tixBalloon widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixBalloon\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+The \fBtixBalloon\fR class is derived from the \fBTixShell\fR
+class and inherits all the commands, options and subwidgets of its
+super-class.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+The Balloon widget supports all the standard options of a frame widget.
+See the \fBoptions(n)\fR manual entry for details on the standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBinitWait\fR
+Class: \fBInitWait\fR
+Switch: \fB\-initwait\fR
+.fi
+.IP
+In milliseconds. Specifies how long the balloon should wait before
+popping up in a widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Switch: \fB\-state\fR
+.fi
+.IP
+Specifies the which help message to display when the mouse pointer
+enters a widget associated with this balloon. Valid options are
+\fBboth\fR: display both the balloon message and the status bar
+message, \fBballoon\fR: display only the balloon message,
+\fBstatus\fR: display only the status bar message and \fBnone\fR:
+display no messages.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBstatusBar\fR
+Class: \fBstatusBar\fR
+Switch: \fB\-statusbar\fR
+.fi
+.IP
+Specifies the widget to use as the status bar of this balloon. This
+widget must have a "-text" option. Usually a label widget is used.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabel\fR
+Class: \fBLabel\fR
+.fi
+.IP
+The label widget that shows the little arrow bitmap in the pop-up
+balloon window.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBmessage\fR
+Class: \fBLabel\fR
+.fi
+.IP
+The message widget that shows the descriptive message in the the pop-up
+balloon window.
+'----------END
+'
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixBalloon\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a Balloon widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+Balloon widget such as its cursor and relief.
+
+The Balloon widget can be used to show popped-up messages
+that describe the functions of the widgets in an application. A
+Balloon widget can be bound to a number of widgets. When the user
+moves the cursor inside a widget to which a Balloon widget has been
+bound, a small pop-up window with a descriptive message will be shown
+on the screen.
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixBalloon\fR command creates a new Tcl command whose name is
+the same as the path name of the Balloon widget's window. This
+command may be used to invoke various operations on the widget. It has
+the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+Balloon widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following commands
+are possible for Balloon widgets:
+.TP
+\fIpathName \fBbind\fR widget ?\fIoption value ... \fR?
+'
+Binds the Balloon widget to the \fIwidget\fR. The messages to be
+shown can be passed as extra arguments to this command in \fIoption
+value\fR pairs. Possible options: \fB\-balloonmsg\fR specifies the
+string to show on the pop-up balloon window; \fB\-statusmsg\fR
+specifies the string to show on the status bar; \fB\-msg\fR specifies a
+string to show on both the balloon window and the stats bar window.
+When used together, the \fB\-msg\fR option has a lower precedence than
+the \fB\-balloonmsg\fR and \fB\-statusmsg\fR options.
+
+The \fBbind\fR command can also be used to change the messages after
+the initial bindings were set. Example:
+.PP
+.nf
+ button .b
+ tixBalloon .bal
+
+ # Add balloon binding
+ .bal bind .b -msg "This is a button"
+
+ ...
+
+ # Change the balloon binding
+ .bal bind .b -msg "This is a useful button"
+.fi
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixBalloon\fR command.
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixBalloon\fR command.
+'
+'
+'
+.TP
+\fIpathName \fBunbind\fI widget\fR
+'
+Cancels the Balloon widget's binding with \fIwidget\fR.
+'
+'
+.TP
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+'
+'
+'----------------------------------------------------------------------
+.SH BINDINGS
+.PP
+After a widget has be bound to a Balloon widget, when the user moves
+the cursor into this widget, the Balloon widget is activated: if the
+\fB\-balloonmsg\fR option of this widget is set, the balloon window
+pops up; if the \fB\-statusmsg\fR option of this widget is set, the
+message will be displayed in the status bar widget.
+.PP
+When the user moves the cursor out of the widget, the Balloon widget
+is de-activated: the balloon window is withdrawn and the status-bar
+message removed.
+'
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/BtnBox.html b/tix/man/BtnBox.html
new file mode 100644
index 00000000000..57e6a578d6d
--- /dev/null
+++ b/tix/man/BtnBox.html
@@ -0,0 +1,154 @@
+
+
+
+<TITLE>tixButtonBox - Create and manipulate Tix ButtonBox widgets</TITLE>
+<Center><H2>tixButtonBox - Create and manipulate Tix ButtonBox widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixButtonBox<I> <I>pathName ?<I>options</I></B>?
+</pre><H3>STANDARD OPTIONS</H3>
+<P>
+<pre><code><code><code>
+<B>
+anchor background cursor
+relief borderWidth
+</B></I>
+</code></code></code></pre>
+<P>
+See the <B>options(n)</B></I> manual entry for details on the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>orientation</B></I>
+Class: <B>Orientation</B></I>
+Switch: <B>-orientation</B></I>
+Alias: <B>-orient</B></I>
+</code></code></code></pre>
+<UL>
+<B>Static Option</B></I>. Specifies the orientation of the button
+subwidgets. Only the values "horizontal" and "vertical" are recognized.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>padx</B></I>
+Class: <B>Pad</B></I>
+Switch: <B>-padx</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the horizontal padding between two neighboring button
+subwidgets in the ButtonBox widget.
+
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>pady</B></I>
+Class: <B>Pad</B></I>
+Switch: <B>-pady</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the vertical padding between two neighboring button
+subwidgets in the ButtonBox widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>state</B></I>
+Class: <B>State</B></I>
+Switch: <B>-state</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the state of all the buttons inside the ButtonBox widget.
+
+<I>Note</I></B>:
+Setting this option using the <I>config</I></B> widget command will enable
+or disable all the buttons subwidgets. Original states of the
+individual buttons are <I>not</I></B> saved. Only the values "normal" and
+"disabled" are recognized.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+All the button subwidgets created as a result of the <B>add</B></I> command
+can be accessed by the <B>subwidget</B></I> command. They are identified by
+the <B>buttonName</B></I> parameter to the <B>add</B></I> command. Here is an
+example:
+<P>
+<pre><code><code><code>
+ tixButtonBox .bbox
+ pack .bbox
+ .bbox add eat -text Eat
+ .bbox add sleep -text Sleep
+ .bbox subwidget eat config -fg green
+ .bbox subwidget sleep config -fg red
+</code></code></code></pre>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixButtonBox</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a ButtonBox
+widget. Additional options, described above, may be specified on the
+command line or in the option database to configure aspects of the
+ButtonBox such as its cursor and relief.
+<P>
+The ButtonBox widget can be used as a container widget to hold the
+</pre><H3>WIDGET COMMAND</H3>
+<P>
+The <B>tixButtonBox</B></I> command creates a new Tcl command whose name is
+be used to invoke various operations on the widget. It has the
+following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as
+determine the exact behavior of the command. The following
+commands are possible for ButtonBox widgets:
+<DL>
+<DT> <I>pathName <B>add <I>buttonName </I></B>?<I>option value ...</I></B>?
+</I></B>
+<DD> Add a new button subwidget with the name <I>buttonName</I></B> into
+the ButtonBox widget. Additional configuration options can be given to
+configure the new button subwidget.
+</DL>
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixButtonBox</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixButtonBox</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>invoke <I>buttonName</I></B>
+</I></B>
+<DD> Invoke the button subwidget with the name </B></I>buttonName</B></I>.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no additional arguments are given, returns the pathname of the
+subwidget of the specified name.
+
+When no additional arguments are given, the widget command of the
+specified subwidget will be called with these parameters.
+</DL>
+</pre><H3>BINDINGS</H3>
+<P>
+TixButtonBox widgets have no default bindings. The button subwidgets
+retain their default Tk bindings.
+</pre><H3>KEYWORDS</H3>
+Tix(n), Container Widgets
+<hr><i>Last modified Sun Jan 19 22:34:19 EST 1997 </i> ---
+<i>Serial 853731295</i>
diff --git a/tix/man/BtnBox.n b/tix/man/BtnBox.n
new file mode 100644
index 00000000000..6ead99d6655
--- /dev/null
+++ b/tix/man/BtnBox.n
@@ -0,0 +1,219 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixButtonBox tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixButtonBox \- Create and manipulate Tix ButtonBox widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixButtonBox\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fB
+'
+anchor background cursor
+relief borderWidth
+'
+\fR
+.ta 4c
+.fi
+.LP
+See the \fBoptions(n)\fR manual entry for details on the standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBorientation\fR
+Class: \fBOrientation\fR
+Switch: \fB\-orientation\fR
+Alias: \fB\-orient\fR
+.fi
+.IP
+\fBStatic Option\fR. Specifies the orientation of the button
+subwidgets. Only the values "horizontal" and "vertical" are recognized.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBpadx\fR
+Class: \fBPad\fR
+Switch: \fB\-padx\fR
+.fi
+.IP
+Specifies the horizontal padding between two neighboring button
+subwidgets in the ButtonBox widget.
+'----------END
+
+'----------BEGIN
+.LP
+.nf
+Name: \fBpady\fR
+Class: \fBPad\fR
+Switch: \fB\-pady\fR
+.fi
+.IP
+Specifies the vertical padding between two neighboring button
+subwidgets in the ButtonBox widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Switch: \fB\-state\fR
+.fi
+.IP
+Specifies the state of all the buttons inside the ButtonBox widget.
+
+\fINote\fR:
+Setting this option using the \fIconfig\fR widget command will enable
+or disable all the buttons subwidgets. Original states of the
+individual buttons are \fInot\fR saved. Only the values "normal" and
+"disabled" are recognized.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+.PP
+'
+All the button subwidgets created as a result of the \fBadd\fR command
+can be accessed by the \fBsubwidget\fR command. They are identified by
+the \fBbuttonName\fR parameter to the \fBadd\fR command. Here is an
+example:
+.PP
+.nf
+ tixButtonBox .bbox
+ pack .bbox
+ .bbox add eat -text Eat
+ .bbox add sleep -text Sleep
+ .bbox subwidget eat config -fg green
+ .bbox subwidget sleep config -fg red
+.fi
+.BE
+'
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixButtonBox\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a ButtonBox
+widget. Additional options, described above, may be specified on the
+command line or in the option database to configure aspects of the
+ButtonBox such as its cursor and relief.
+'
+.PP
+The ButtonBox widget can be used as a container widget to hold the
+``action'' buttons in a dialog box.
+'
+'----------------------------------------------------------------------
+.SH "WIDGET COMMAND"
+.PP
+'
+The \fBtixButtonBox\fR command creates a new Tcl command whose name is
+the same as the path name of the ButtonBox's window. This command may
+be used to invoke various operations on the widget. It has the
+following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as
+the ButtonBox widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for ButtonBox widgets:
+'
+.TP
+'
+\fIpathName \fBadd \fIbuttonName \fR?\fIoption value ...\fR?
+'
+Add a new button subwidget with the name \fIbuttonName\fR into
+the ButtonBox widget. Additional configuration options can be given to
+configure the new button subwidget.
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixButtonBox\fR command.
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixButtonBox\fR command.
+'
+'
+.TP
+\fIpathName \fBinvoke \fIbuttonName\fR
+'
+Invoke the button subwidget with the name \fRbuttonName\fR.
+'
+.TP
+'
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no additional arguments are given, returns the pathname of the
+subwidget of the specified name.
+
+When no additional arguments are given, the widget command of the
+specified subwidget will be called with these parameters.
+'
+'----------------------------------------------------------------------
+.SH BINDINGS
+.PP
+TixButtonBox widgets have no default bindings. The button subwidgets
+retain their default Tk bindings.
+'
+'
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n), Container Widgets
diff --git a/tix/man/ChkList.html b/tix/man/ChkList.html
new file mode 100644
index 00000000000..bb8f3a61b82
--- /dev/null
+++ b/tix/man/ChkList.html
@@ -0,0 +1,192 @@
+
+
+
+<TITLE>tixCheckList - Create and manipulate tixCheckList widgets</TITLE>
+<Center><H2>tixCheckList - Create and manipulate tixCheckList widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixCheckList<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+The <B>TixCheckList</B></I> class is derived from the <B>TixTree</B></I> class
+and inherits all the commands, options and subwidgets of its
+super-class.
+</pre><H3>STANDARD OPTIONS</H3>
+<B>TixCheckList</B></I> supports all the standard options of a frame
+widget. See the <B>options(n)</B></I> manual entry for details on the
+standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>browseCmd</B></I>
+Class: <B>BrowseCmd</B></I>
+Switch: <B>-browsecmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a command to call whenever the user browses on an entry
+(usually by single-clicking on the entry). The command is called with
+one argument, the pathname of the entry.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>command</B></I>
+Class: <B>Command</B></I>
+Switch: <B>-command</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a command to call whenever the user activates an entry
+(usually by double-clicking on the entry). The command
+is called with one argument, the pathname of the entry.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>radio</B></I>
+Class: <B>Radio</B></I>
+Switch: <B>-radio</B></I>
+</code></code></code></pre>
+<UL>
+A Boolean value. If set to true, the user can select at most one item
+at a time; if set to false, the user can select as many items as
+possible.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>hlist</B></I>
+Class: <B>TixHList</B></I>
+</code></code></code></pre>
+<UL>
+The hierarchical listbox that displays the CheckList.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>hsb</B></I>
+Class: <B>Scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+The horizontal scrollbar subwidget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>vsb</B></I>
+Class: <B>Scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+The vertical scrollbar subwidget.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixCheckList</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a CheckList widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the CheckList
+widget such as its cursor and relief.
+
+The CheckList widget displays a list of items to be selected by the
+user. CheckList acts similarly to the Tk checkbutton or radiobutton
+widgets, except it is capable of handling many more items than
+checkbuttons or radiobuttons.
+
+The items are contained in the <B>hlist</B></I> subwidget. Each item may
+be in one of the following status: <B>on</B></I> (indicated by a check
+bitmap), <B>off</B></I> (indicated by a cross bitmap) <B>default</B></I>
+(indicated by a gray box bitmap) or <B>none</B></I>, in which case the item
+will not be accompanied by a bitmap. The items whose status is
+<B>on</B></I>, <B>off</B></I> or <B>default</B></I> are called the <I>selectable</I></B>
+items and can be checked or crossed by the user. All selectable
+entries must be of the type <B>imagetext</B></I>.
+
+The items whose status is <B>none</B></I> cannot be checked or crossed by
+the user; usually they are included in the <B>hlist</B></I> subwidget only
+for explanation purposes or as separators.
+
+Initially, all the items have a <I>none</I></B> status. To make an item
+selectable, you can call the <B>setstatus</B></I> command to change its
+status (see below).
+
+Notice that CheckList is a subclass of the TixTree widget and thus is
+is capable of displaying a hierachy of selectable entries. When
+necessary, you can call the <B>setmode</B></I> method (see
+<B>TixTree(n)</B></I>) to define the hierachical structure of the
+selectable entries.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixCheckList</B></I> command creates a new Tcl command whose name is
+be used to invoke various operations on the widget. It has the
+following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+determine the exact behavior of the command. The following commands
+are possible for CheckList widgets:
+<DL>
+<DT> <I>pathName <B>getselection</B></I> ?<I>status</I></B>?
+</I></B>
+<DD> Returns a list of items whose status matches <I>status</I></B>. If
+<I>status</I></B> is not specified, the list of items in the "<B>on</B></I>"
+status will be returned.
+</DL>
+<DL>
+<DT> <I>pathName <B>getstatus</B></I> <I>entryPath</I></B>
+</I></B>
+<DD> Returns the current status of <I>entryPath</I></B>.
+</DL>
+<DL>
+<DT> <I>pathName <B>setstatus</B></I> <I>entryPath status</I></B>
+</I></B>
+<DD> Sets the status of <I>entryPath</I></B> to be <I>status</I></B>. A bitmap will
+be displayed next to the entry its status is <B>on</B></I>, <B>off</B></I> or
+<B>default</B></I>.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+</DL>
+</pre><H3>EXAMPLE</H3>
+<P>
+This example creates several choices for the user to select.
+<P>
+\fC
+<pre><code><code><code>
+ tixCheckList .c
+ .c subwidget hlist add choice1 -itemtype imagetext -text "Choice 1"
+ .c subwidget hlist add choice2 -itemtype imagetext -text "Choice 2"
+ .c subwidget hlist add choice3 -itemtype imagetext -text "Choice 3"
+ .c setstatus choice1 on
+ .c setstatus choice2 off
+ .c setstatus choice3 off
+ pack .c
+</code></code></code></pre>
+</B></I>
+</pre><H3>BINDINGS</H3>
+<P>
+The basic mouse and keyboard bindings of the CheckList widget are the
+same as the bindings of the TixTree widget.
+
+In addition, the status of the entries in the CheckList are toggled
+under the following conditions:
+<UL>
+[1] <BR>
+When the user press the mouse button over an entry.
+</UL>
+<UL>
+[2] <BR>
+When the user press the &lt;space&gt; key over an entry.
+</UL>
+<UL>
+[3] <BR>
+When the user press the &lt;Return&gt; key over an entry.
+</UL>
+</pre><H3>KEYWORDS</H3>
+Tix(n), tixHList(n), tixTree(n)
+<!Serial 851729142>
+<hr><i>Last modified Fri Jan 17 23:00:21 EST 1997 </i> ---
+<i>Serial 853731295</i>
diff --git a/tix/man/ChkList.n b/tix/man/ChkList.n
new file mode 100644
index 00000000000..94285fb37cb
--- /dev/null
+++ b/tix/man/ChkList.n
@@ -0,0 +1,252 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixCheckList tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixCheckList \- Create and manipulate tixCheckList widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixCheckList\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+The \fBTixCheckList\fR class is derived from the \fBTixTree\fR class
+and inherits all the commands, options and subwidgets of its
+super-class.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+\fBTixCheckList\fR supports all the standard options of a frame
+widget. See the \fBoptions(n)\fR manual entry for details on the
+standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBbrowseCmd\fR
+Class: \fBBrowseCmd\fR
+Switch: \fB\-browsecmd\fR
+.fi
+.IP
+Specifies a command to call whenever the user browses on an entry
+(usually by single-clicking on the entry). The command is called with
+one argument, the pathname of the entry.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Switch: \fB\-command\fR
+.fi
+.IP
+Specifies a command to call whenever the user activates an entry
+(usually by double-clicking on the entry). The command
+is called with one argument, the pathname of the entry.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBradio\fR
+Class: \fBRadio\fR
+Switch: \fB\-radio\fR
+.fi
+.IP
+A Boolean value. If set to true, the user can select at most one item
+at a time; if set to false, the user can select as many items as
+possible.
+'----------END
+'
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'----------BEGIN
+.LP
+.nf
+Name: \fBhlist\fR
+Class: \fBTixHList\fR
+.fi
+.IP
+The hierarchical listbox that displays the CheckList.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBhsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The horizontal scrollbar subwidget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The vertical scrollbar subwidget.
+'----------END
+'
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixCheckList\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a CheckList widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the CheckList
+widget such as its cursor and relief.
+
+The CheckList widget displays a list of items to be selected by the
+user. CheckList acts similarly to the Tk checkbutton or radiobutton
+widgets, except it is capable of handling many more items than
+checkbuttons or radiobuttons.
+
+The items are contained in the \fBhlist\fR subwidget. Each item may
+be in one of the following status: \fBon\fR (indicated by a check
+bitmap), \fBoff\fR (indicated by a cross bitmap) \fBdefault\fR
+(indicated by a gray box bitmap) or \fBnone\fR, in which case the item
+will not be accompanied by a bitmap. The items whose status is
+\fBon\fR, \fBoff\fR or \fBdefault\fR are called the \fIselectable\fR
+items and can be checked or crossed by the user. All selectable
+entries must be of the type \fBimagetext\fR.
+
+The items whose status is \fBnone\fR cannot be checked or crossed by
+the user; usually they are included in the \fBhlist\fR subwidget only
+for explanation purposes or as separators.
+
+Initially, all the items have a \fInone\fR status. To make an item
+selectable, you can call the \fBsetstatus\fR command to change its
+status (see below).
+'
+
+Notice that CheckList is a subclass of the TixTree widget and thus is
+is capable of displaying a hierachy of selectable entries. When
+necessary, you can call the \fBsetmode\fR method (see
+\fBTixTree(n)\fR) to define the hierachical structure of the
+selectable entries.
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixCheckList\fR command creates a new Tcl command whose name is
+the same as the path name of the CheckList's window. This command may
+be used to invoke various operations on the widget. It has the
+following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+CheckList widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following commands
+are possible for CheckList widgets:
+'
+.TP
+\fIpathName \fBgetselection\fR ?\fIstatus\fR?
+'
+Returns a list of items whose status matches \fIstatus\fR. If
+\fIstatus\fR is not specified, the list of items in the "\fBon\fR"
+status will be returned.
+'
+.TP
+\fIpathName \fBgetstatus\fR \fIentryPath\fR
+'
+Returns the current status of \fIentryPath\fR.
+'
+.TP
+\fIpathName \fBsetstatus\fR \fIentryPath status\fR
+'
+Sets the status of \fIentryPath\fR to be \fIstatus\fR. A bitmap will
+be displayed next to the entry its status is \fBon\fR, \fBoff\fR or
+\fBdefault\fR.
+'
+'
+.TP
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+'
+'----------------------------------------------------------------------
+.SH EXAMPLE
+'
+.PP
+This example creates several choices for the user to select.
+.PP
+\fC
+.nf
+ tixCheckList .c
+ .c subwidget hlist add choice1 -itemtype imagetext -text "Choice 1"
+ .c subwidget hlist add choice2 -itemtype imagetext -text "Choice 2"
+ .c subwidget hlist add choice3 -itemtype imagetext -text "Choice 3"
+ .c setstatus choice1 on
+ .c setstatus choice2 off
+ .c setstatus choice3 off
+ pack .c
+.fi
+\fR
+'
+'----------------------------------------------------------------------
+.SH BINDINGS
+.PP
+'
+The basic mouse and keyboard bindings of the CheckList widget are the
+same as the bindings of the TixTree widget.
+
+In addition, the status of the entries in the CheckList are toggled
+under the following conditions:
+'
+.IP [1]
+When the user press the mouse button over an entry.
+'
+.IP [2]
+When the user press the <space> key over an entry.
+'
+.IP [3]
+When the user press the <Return> key over an entry.
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n), tixHList(n), tixTree(n)
diff --git a/tix/man/Control.html b/tix/man/Control.html
new file mode 100644
index 00000000000..a6d18390745
--- /dev/null
+++ b/tix/man/Control.html
@@ -0,0 +1,371 @@
+
+
+
+<TITLE>tixControl - Create and manipulate tixControl widgets</TITLE>
+<Center><H2>tixControl - Create and manipulate tixControl widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixControl<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+The <B>TixControl</B></I> class is derived from the <B>TixLabelWidget</B></I>
+class and inherits all the commands, options and subwidgets of its
+super-class.
+</pre><H3>STANDARD OPTIONS</H3>
+The Control widget supports all the standard options of a frame
+widget. See the <B>options(n)</B></I> manual entry for details on the
+standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>allowEmpty</B></I>
+Class: <B>AllowEmpty</B></I>
+Switch: <B>-allowempty</B></I>
+</code></code></code></pre>
+<UL>
+Specifies whether the Control widget should allow the empty string
+as a valid input.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>autorepeat</B></I>
+Class: <B>AutoRepeat</B></I>
+Switch: <B>-autorepeat</B></I>
+</code></code></code></pre>
+<UL>
+Specifies whether the Control widget should have autorepeat behavior.
+If set to be "true", the value of the Control widget will be
+automatically incremented or decremented when the user holds down the
+mouse button over the arrow buttons. Only values "true" and
+"false" will be recognized.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>command</B></I>
+Class: <B>Command</B></I>
+Switch: <B>-command</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the command to be called when the <B>-value</B></I> option of
+the Control widget is changed. The command will be called with one
+arguments -- the new value of the Control widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>decrCmd</B></I>
+Class: <B>DecrCmd</B></I>
+Switch: <B>-decrcmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a TCL command to be called when the the user presses the
+down-arrow button subwidget. This command is called with one parameter
+-- the current <B>-value</B></I> of this Control widget. This
+command is to decrement this value by one step, according to its own
+definition of "decrement", and return the decremented value, which
+will be stored in the <B>-value</B></I> of this Control widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>disableCallback</B></I>
+Class: <B>DisableCallback</B></I>
+Switch: <B>-disablecallback</B></I>
+</code></code></code></pre>
+<UL>
+A boolean value indicating whether callbacks should be disabled. When
+set to true, the TCL command specified by the <B>-command</B></I> option
+is not executed when the <B>-value</B></I> of the Control widget
+changes.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>disableForeground</B></I>
+Class: <B>DisableForeground</B></I>
+Switch: <B>-disableforeground</B></I>
+</code></code></code></pre>
+<UL>
+The foreground color to use for of the entry subwidget when the
+Control widget is disabled.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>incrCmd</B></I>
+Class: <B>IncrCmd</B></I>
+Switch: <B>-incrcmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a TCL command to be called when the the user presses the
+up-arrow button subwidget. This command is called with one parameter
+-- the current <B>-value</B></I> of this Control widget. This
+command is to increment this value by one step, according to its own
+definition of "increment", and return the incremented value, which
+will be stored in the <B>-value</B></I> of this Control widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>initwait</B></I>
+Class: <B>Initwait</B></I>
+Switch: <B>-initwait</B></I>
+</code></code></code></pre>
+<UL>
+Specifies how long the Control widget should wait initially before
+it starts to automatically increment or decrement its value in the
+autorepeat mode. In milliseconds.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>integer</B></I>
+Class: <B>Integer</B></I>
+Switch: <B>-integer</B></I>
+</code></code></code></pre>
+<UL>
+A Boolean value specifying whether only integer numbers are accepted.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>label</B></I>
+Class: <B>Label</B></I>
+Switch: <B>-label</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the string to display as the label of this Control widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>labelSide</B></I>
+Class: <B>LabelSide</B></I>
+Switch: <B>-labelside</B></I>
+</code></code></code></pre>
+<UL>
+Specifies where the label should be displayed relative to the entry
+subwidget. Valid options are: <B>top</B></I>, <B>left</B></I>, <B>right</B></I>,
+<B>bottom</B></I>, <B>none</B></I> or <B>acrosstop</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>max</B></I>
+Class: <B>Max</B></I>
+Switch: <B>-max</B></I>
+Alias: <B>-ulimit</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the upper limit of the value of the Control widget. When set
+to empty string, the Control widget has no upper limit.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>min</B></I>
+Class: <B>Min</B></I>
+Switch: <B>-min</B></I>
+Alias: <B>-llimit</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the lower limit of the value of the Control widget.When set
+to empty string, the Control widget has no lower limit.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>repeatRate</B></I>
+Class: <B>RepeatRate</B></I>
+Switch: <B>-repeatrate</B></I>
+</code></code></code></pre>
+<UL>
+Specifies how often the value of the Control widget should be
+incremented or decremented when it is in the autorepeat mode. In
+milliseconds.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>selectMode</B></I>
+Class: <B>SelectMode</B></I>
+Switch: <B>-selectmode</B></I>
+</code></code></code></pre>
+<UL>
+Specifies how the Control widget should react to \fC&lt;KeyPress&gt;</B></I>
+events. When set to "immediate", any user keyboard inputs will
+immediately change the <B>-value</B></I> option. When set to "normal", the
+user keyboard inputs will be copied to the <B>-value</B></I> option only
+if the\fC &lt;Return&gt;</B></I> key is pressed or the keyboard focus is
+changed. The use of the immediate mode is discouraged. For effective
+use of the Control widget, one should use the normal mode together
+with the <B>update</B></I> widget command (see below).
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>state</B></I>
+Class: <B>State</B></I>
+Switch: <B>-state</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the whether the Control widget is normal or
+disabled. Only the values "normal" and "disabled" are recognized.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>step</B></I>
+Class: <B>Step</B></I>
+Switch: <B>-step</B></I>
+</code></code></code></pre>
+<UL>
+Specifies by how much the value of the Control widget should be
+incremented or decrmented when the user press the arrow buttons.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>validateCmd</B></I>
+Class: <B>ValidateCmd</B></I>
+Switch: <B>-validatecmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a TCL command to be called when the -value of the
+Control widget is about to change. This command is called
+with one parameter -- the new <B>-value</B></I> entered by the user. This
+command is to validate this new value by returning a value it deems
+valid.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>value</B></I>
+Class: <B>Value</B></I>
+Switch: <B>-value</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the value of the Control widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>variable</B></I>
+Class: <B>Variable</B></I>
+Switch: <B>-variable</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the global variable in which the value of the
+Control widget should be stored. The value of the Control widget
+will be automatically updated when this variable is changed.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>decr</B></I>
+Class: <B>Button</B></I>
+</code></code></code></pre>
+<UL>
+The down arrow button.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>entry</B></I>
+Class: <B>Entry</B></I>
+</code></code></code></pre>
+<UL>
+The entry that shows the value of this Control widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>incr</B></I>
+Class: <B>Button</B></I>
+</code></code></code></pre>
+<UL>
+The up arrow button.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>label</B></I>
+Class: <B>Label</B></I>
+</code></code></code></pre>
+<UL>
+The label subwidget.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixControl</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a Control widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+Control widget such as its cursor and relief.
+
+The Control widget is also known as the <B>SpinBox</B></I> widget.
+It is generally used to control a value. The user can adjust the value
+by pressing the two arrow buttons or by entering the value directly
+into the entry. The new value will be checked against the user-defined
+upper and lower limits.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixControl</B></I> command creates a new Tcl command whose name is
+command may be used to invoke various operations on the widget. It has
+the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+determine the exact behavior of the command. The following commands
+are possible for Control widgets:
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixControl</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixControl</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>decr</B></I>
+</I></B>
+<DD> Decrements the value of the Control widget by the step specified
+by the <I>-step</I></B> option.
+</DL>
+<DL>
+<DT> <I>pathName <B>incr</B></I>
+</I></B>
+<DD> Increments the value of the Control widget by the step
+specified by the <I>-step</I></B> option.
+</DL>
+<DL>
+<DT> <I>pathName <B>invoke</B></I>
+</I></B>
+<DD> Causes the command specified by the <I>-command</I></B> option to be
+invoked.
+</DL>
+<DL>
+<DT> <I>pathName <B>update</B></I>
+</I></B>
+<DD> If the user has modified the entry using keyboard inputs, the update
+command will <B>update</B></I> the <B>-value</B></I> of this Control
+"normal", one should call the <B>update</B></I> command on this widget
+before examining its <B>-value</B></I> option. This command has no effect
+in if the <B>-selectmode</B></I> option is set to "immediate".
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+</DL>
+</pre><H3>BINDINGS</H3>
+<P>
+When the user presses the up/down arrow buttons (or press the &lt;Up&gt; and
+&lt;Down&gt; arrow keys on the keyboard), the value of the tixControl widget
+is adjusted according to the <B>-validatecmd</B></I>, <B>-incrcmd</B></I>,
+<B>-decrcmd</B></I>, <B>-step</B></I>, <B>-max</B></I> and <B>-min</B></I> options.
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:20 EST 1997 </i> ---
+<i>Serial 853731296</i>
diff --git a/tix/man/Control.n b/tix/man/Control.n
new file mode 100644
index 00000000000..490b3246d56
--- /dev/null
+++ b/tix/man/Control.n
@@ -0,0 +1,478 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixControl tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixControl \- Create and manipulate tixControl widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixControl\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+The \fBTixControl\fR class is derived from the \fBTixLabelWidget\fR
+class and inherits all the commands, options and subwidgets of its
+super-class.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+The Control widget supports all the standard options of a frame
+widget. See the \fBoptions(n)\fR manual entry for details on the
+standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBallowEmpty\fR
+Class: \fBAllowEmpty\fR
+Switch: \fB\-allowempty\fR
+.fi
+.IP
+Specifies whether the Control widget should allow the empty string
+as a valid input.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBautorepeat\fR
+Class: \fBAutoRepeat\fR
+Switch: \fB\-autorepeat\fR
+.fi
+.IP
+Specifies whether the Control widget should have autorepeat behavior.
+If set to be "true", the value of the Control widget will be
+automatically incremented or decremented when the user holds down the
+mouse button over the arrow buttons. Only values "true" and
+"false" will be recognized.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Switch: \fB\-command\fR
+.fi
+.IP
+Specifies the command to be called when the \fB\-value\fR option of
+the Control widget is changed. The command will be called with one
+arguments -- the new value of the Control widget.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdecrCmd\fR
+Class: \fBDecrCmd\fR
+Switch: \fB\-decrcmd\fR
+.fi
+.IP
+Specifies a TCL command to be called when the the user presses the
+down-arrow button subwidget. This command is called with one parameter
+-- the current \fB\-value\fR of this Control widget. This
+command is to decrement this value by one step, according to its own
+definition of "decrement", and return the decremented value, which
+will be stored in the \fB\-value\fR of this Control widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdisableCallback\fR
+Class: \fBDisableCallback\fR
+Switch: \fB\-disablecallback\fR
+.fi
+.IP
+A boolean value indicating whether callbacks should be disabled. When
+set to true, the TCL command specified by the \fB\-command\fR option
+is not executed when the \fB\-value\fR of the Control widget
+changes.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdisableForeground\fR
+Class: \fBDisableForeground\fR
+Switch: \fB\-disableforeground\fR
+.fi
+.IP
+The foreground color to use for of the entry subwidget when the
+Control widget is disabled.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBincrCmd\fR
+Class: \fBIncrCmd\fR
+Switch: \fB\-incrcmd\fR
+.fi
+.IP
+Specifies a TCL command to be called when the the user presses the
+up-arrow button subwidget. This command is called with one parameter
+-- the current \fB\-value\fR of this Control widget. This
+command is to increment this value by one step, according to its own
+definition of "increment", and return the incremented value, which
+will be stored in the \fB\-value\fR of this Control widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBinitwait\fR
+Class: \fBInitwait\fR
+Switch: \fB\-initwait\fR
+.fi
+.IP
+Specifies how long the Control widget should wait initially before
+it starts to automatically increment or decrement its value in the
+autorepeat mode. In milliseconds.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBinteger\fR
+Class: \fBInteger\fR
+Switch: \fB\-integer\fR
+.fi
+.IP
+A Boolean value specifying whether only integer numbers are accepted.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabel\fR
+Class: \fBLabel\fR
+Switch: \fB\-label\fR
+.fi
+.IP
+Specifies the string to display as the label of this Control widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabelSide\fR
+Class: \fBLabelSide\fR
+Switch: \fB\-labelside\fR
+.fi
+.IP
+Specifies where the label should be displayed relative to the entry
+subwidget. Valid options are: \fBtop\fR, \fBleft\fR, \fBright\fR,
+\fBbottom\fR, \fBnone\fR or \fBacrosstop\fR.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBmax\fR
+Class: \fBMax\fR
+Switch: \fB\-max\fR
+Alias: \fB\-ulimit\fR
+.fi
+.IP
+Specifies the upper limit of the value of the Control widget. When set
+to empty string, the Control widget has no upper limit.
+'----------END
+''
+'----------BEGIN
+.LP
+.nf
+Name: \fBmin\fR
+Class: \fBMin\fR
+Switch: \fB\-min\fR
+Alias: \fB\-llimit\fR
+.fi
+.IP
+Specifies the lower limit of the value of the Control widget.When set
+to empty string, the Control widget has no lower limit.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBrepeatRate\fR
+Class: \fBRepeatRate\fR
+Switch: \fB\-repeatrate\fR
+.fi
+.IP
+Specifies how often the value of the Control widget should be
+incremented or decremented when it is in the autorepeat mode. In
+milliseconds.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBselectMode\fR
+Class: \fBSelectMode\fR
+Switch: \fB\-selectmode\fR
+.fi
+.IP
+Specifies how the Control widget should react to \fC<KeyPress>\fR
+events. When set to "immediate", any user keyboard inputs will
+immediately change the \fB\-value\fR option. When set to "normal", the
+user keyboard inputs will be copied to the \fB\-value\fR option only
+if the\fC <Return>\fR key is pressed or the keyboard focus is
+changed. The use of the immediate mode is discouraged. For effective
+use of the Control widget, one should use the normal mode together
+with the \fBupdate\fR widget command (see below).
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Switch: \fB\-state\fR
+.fi
+.IP
+Specifies the whether the Control widget is normal or
+disabled. Only the values "normal" and "disabled" are recognized.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBstep\fR
+Class: \fBStep\fR
+Switch: \fB\-step\fR
+.fi
+.IP
+Specifies by how much the value of the Control widget should be
+incremented or decrmented when the user press the arrow buttons.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvalidateCmd\fR
+Class: \fBValidateCmd\fR
+Switch: \fB\-validatecmd\fR
+.fi
+.IP
+Specifies a TCL command to be called when the -value of the
+Control widget is about to change. This command is called
+with one parameter -- the new \fB\-value\fR entered by the user. This
+command is to validate this new value by returning a value it deems
+valid.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvalue\fR
+Class: \fBValue\fR
+Switch: \fB\-value\fR
+.fi
+.IP
+Specifies the value of the Control widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvariable\fR
+Class: \fBVariable\fR
+Switch: \fB\-variable\fR
+.fi
+.IP
+Specifies the global variable in which the value of the
+Control widget should be stored. The value of the Control widget
+will be automatically updated when this variable is changed.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'----------BEGIN
+.LP
+.nf
+Name: \fBdecr\fR
+Class: \fBButton\fR
+.fi
+.IP
+The down arrow button.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBentry\fR
+Class: \fBEntry\fR
+.fi
+.IP
+The entry that shows the value of this Control widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBincr\fR
+Class: \fBButton\fR
+.fi
+.IP
+The up arrow button.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabel\fR
+Class: \fBLabel\fR
+.fi
+.IP
+The label subwidget.
+'----------END
+'
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixControl\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a Control widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+Control widget such as its cursor and relief.
+
+The Control widget is also known as the \fBSpinBox\fR widget.
+It is generally used to control a value. The user can adjust the value
+by pressing the two arrow buttons or by entering the value directly
+into the entry. The new value will be checked against the user-defined
+upper and lower limits.
+'
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixControl\fR command creates a new Tcl command whose name is
+the same as the path name of the Control widget's window. This
+command may be used to invoke various operations on the widget. It has
+the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+Control widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following commands
+are possible for Control widgets:
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixControl\fR command.
+'
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixControl\fR command.
+'
+.TP
+\fIpathName \fBdecr\fR
+'
+Decrements the value of the Control widget by the step specified
+by the \fI\-step\fR option.
+'
+'
+.TP
+\fIpathName \fBincr\fR
+'
+Increments the value of the Control widget by the step
+specified by the \fI\-step\fR option.
+'
+'
+.TP
+\fIpathName \fBinvoke\fR
+'
+Causes the command specified by the \fI\-command\fR option to be
+invoked.
+'
+.TP
+\fIpathName \fBupdate\fR
+'
+If the user has modified the entry using keyboard inputs, the update
+command will \fBupdate\fR the \fB\-value\fR of this Control
+widget. When the Control widget's \fB\-selectmode\fR option is set to
+"normal", one should call the \fBupdate\fR command on this widget
+before examining its \fB\-value\fR option. This command has no effect
+in if the \fB\-selectmode\fR option is set to "immediate".
+'
+.TP
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+'
+'
+'
+'----------------------------------------------------------------------
+.SH BINDINGS
+.PP
+'
+When the user presses the up/down arrow buttons (or press the <Up> and
+<Down> arrow keys on the keyboard), the value of the tixControl widget
+is adjusted according to the \fB\-validatecmd\fR, \fB\-incrcmd\fR,
+\fB\-decrcmd\fR, \fB\-step\fR, \fB\-max\fR and \fB\-min\fR options.
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/DItem.html b/tix/man/DItem.html
new file mode 100644
index 00000000000..3c01eaa6e6c
--- /dev/null
+++ b/tix/man/DItem.html
@@ -0,0 +1,420 @@
+
+
+
+<TITLE>Tix Display Items</TITLE>
+<Center><H2>Tix Display Items</H2></Center><hr>
+
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+The Tix <B>Display Items</B></I> and <B>Display Types</B></I> are devised to
+solve a general problem: many Tix widgets (both existing and planned
+ones) display many items of many types simutaneously.
+<P>
+For example, a hierarchical listbox widget (HList) can display items
+of images, plain text and subwindows in the form of a
+hierarchy. Another widget, the tabular listbox, (TList, currently
+planned and will be released in Tix 4.1) also display items of the
+same types, although it arranges the items in a tabular form. Yet
+another widget, the spreadsheet widget, also displays similar types
+items, but in yet another format.
+<P>
+In these examples, the display items in different widgets are only
+different in how they are arranged by the <B>host widget</B></I>. In Tix,
+display items are clearly separated from the host widgets. The
+advantage is two-fold: first, the creation and configuration of
+display items become uniform across different host widgets. Second,
+new display item types can be added without the need to modify the
+existing host widgets.
+<P>
+In a way, Tix display items are similar to the items inside Tk
+the canvas widget. However, unlike the Tix display items, the canvas
+items are not independent of the canvas widget; this makes it
+impossible to use the canvas items inside other types of TK widgets.
+<P>
+The appearance of a display item is controlled by a set of
+<I>attributes</I></B>. It is observed that each the attributes usually fall
+into one of two categroies: "<I>individual</I></B>" or
+"<I>collective</I></B>". For example, the text items inside a HList widget
+may all display a different text string; however, in most cases, the
+text items share the same color, font and spacing. Instead of keeping
+a duplicated version of the same attributes inside each display item,
+it will be advantageous to put the collective attributes in a
+special object called a <B>display style</B></I>. First, there is the space
+concern: a host widget may have many thousands of items; keeping
+dupilcated attributes will be very wasteful. Second, when it becomes
+necessary to change a collective attribute, such as changing all the
+change only the display style object than to modify all the text
+items one by one.
+<P>
+The attributes of the a display item are thus stored in two places: it
+has a set of <B>item options</B></I> to store its individual attributes. Each
+display item is also associated with a <I>display style</I></B>, which specifies
+the collective attributes of all items associated with itself.
+<P>
+The division between the individual and collective attributes are
+fixed and cannot be changed. Thus, when it becomes necessary for some
+items to differ in their collective attributes, two or more <B>display
+styles</B></I> can be used. For example, suppose you want to display two
+columns of text items inside an HList widget, one column in red and
+the other in blue. You can create a TextStyle object called "red",
+which defines a red foreground, and another called "blue", which
+defines a blue foreground. You can then associate all text items of
+the first column to "red" and the second column to "blue".
+</pre><H3>DISPLAY ITEM TYPES AND OPTIONS</H3>
+Currently there are three types of display items: <B>text</B></I>,
+<B>imagetext</B></I> and <B>window</B></I>.
+</pre><H3>IMAGETEXT ITEMS</H3>
+Display items of the type <B>imagetext</B></I> are used to display an image
+together with a text string. Imagetext items support the following options:
+<P>
+<B>ITEM OPTIONS</B></I>
+<P>
+<UL>
+<P>
+<pre><code><code><code>
+Name: <B>bitmap</B></I>
+Class: <B>Bitmap</B></I>
+Switch: <B>-bitmap</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the bitmap to display in the item.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>image</B></I>
+Class: <B>Image</B></I>
+Switch: <B>-image</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the image to display in the item. When both the
+<B>-bitmap</B></I> and <B>-image</B></I> options are specified, only the image
+will be displayed.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>imageTextStyle</B></I>
+Class: <B>ImageTextStyle</B></I>
+Switch: <B>-style</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the display style to use for this item. Must be the
+name of a <B>imagetext</B></I> display style that has already be created by
+the <B>tixDisplayStyle(n)</B></I> command.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>showImage</B></I>
+Class: <B>ShowImage</B></I>
+Switch: <B>-showimage</B></I>
+</code></code></code></pre>
+<UL>
+A Boolean value that specifies whether the image/bitmap should be
+displayed.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>showText</B></I>
+Class: <B>ShowText</B></I>
+Switch: <B>-showtext</B></I>
+</code></code></code></pre>
+<UL>
+A Boolean value that specifies whether the text string should be
+displayed.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>text</B></I>
+Class: <B>Text</B></I>
+Switch: <B>-text</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the text string to display in the item.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>underline</B></I>
+Class: <B>Underline</B></I>
+Switch: <B>-underline</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the integer index of a character to underline in the text
+string in the item. 0 corresponds to the first character of the text
+displayed in the widget, 1 to the next character, and so on.
+</UL>
+</UL>
+<P>
+<B>STYLE OPTIONS</B></I>
+<P>
+The style information of <B>imagetext</B></I> items are stored in the
+<B>imagetext</B></I> display style. The following options are supported:
+<UL>
+<P>
+<B>STANDARD OPTIONS</B></I>
+<P>
+\fC
+<pre><code><code><code>
+activeBackground activeForeground
+anchor background
+disabledBackground disabledForeground
+foreground font
+justify padX
+padY selectBackground
+selectForeground wrapLength
+</code></code></code></pre>
+</B></I>
+<P>
+See the <B>options(n)</B></I> manual entry for details on the standard
+options.
+<P>
+<P>
+<B>STYLE-SPECIFIC OPTIONS</B></I>
+<P>
+<P>
+<pre><code><code><code>
+Name: <B>gap</B></I>
+Class: <B>Gap</B></I>
+Switch: <B>-gap</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the distance between the bitmap/image and the text string,
+in number of pixels.
+</UL>
+</UL>
+</pre><H3>TEXT ITEMS</H3>
+Display items of the type <B>text</B></I> are used to display a text string
+in a widget. Text items support the following options:
+<P>
+<B>ITEM OPTIONS</B></I>
+<P>
+<UL>
+<P>
+<pre><code><code><code>
+Name: <B>textStyle</B></I>
+Class: <B>TextStyle</B></I>
+Switch: <B>-style</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the display style to use for this text item. Must be the
+name of a <B>text</B></I> display style that has already be created by the
+<B>tixDisplayStyle(n)</B></I> command.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>text</B></I>
+Class: <B>Text</B></I>
+Switch: <B>-text</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the text string to display in the item.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>underline</B></I>
+Class: <B>Underline</B></I>
+Switch: <B>-underline</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the integer index of a character to underline in the item.
+0 corresponds to the first character of the text displayed in the
+widget, 1 to the next character, and so on.
+</UL>
+</UL>
+<B>STYLE OPTIONS</B></I>
+<P>
+<UL>
+<P>
+<B>STANDARD OPTIONS</B></I>
+<P>
+\fC
+<pre><code><code><code>
+activeBackground activeForeground
+anchor background
+disabledBackground disabledForeground
+foreground font
+justify padX
+padY selectBackground
+selectForeground wrapLength
+</code></code></code></pre>
+</B></I>
+<P>
+See the <B>options(n)</B></I> manual entry for details on the standard
+options.
+<P>
+</UL>
+</pre><H3>WINDOW ITEMS</H3>
+Display items of the type <B>window</B></I> are used to display a
+sub-window in a widget. <B>Window</B></I> items support the following
+options:
+<P>
+<B>ITEM OPTIONS</B></I>
+<P>
+<UL>
+<P>
+<pre><code><code><code>
+Name: <B>windowStyle</B></I>
+Class: <B>WindowStyle</B></I>
+Switch: <B>-style</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the display style to use for this window item. Must be the
+name of a <B>window</B></I> display style that has already be created by
+the <B>tixDisplayStyle(n)</B></I> command.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>window</B></I>
+Class: <B>Window</B></I>
+Switch: <B>-window</B></I>
+Alias: <B>-widget</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the sub-window to display in the item.
+</UL>
+</UL>
+<B>STYLE OPTIONS</B></I>
+<P>
+<UL>
+<B>STANDARD OPTIONS</B></I>
+<P>
+\fC
+<pre><code><code><code>
+anchor
+padX padY
+<P>
+</code></code></code></pre>
+See the <B>options(n)</B></I> manual entry for details on the standard
+options.
+<P>
+</UL>
+</pre><H3>CREATING DISPLAY ITEMS</H3>
+Display items do not exist on their and thus they cannot be created
+independently of the widgets they reside in. As a rule, display items
+are created by special widget commands of their "host" widgets. For
+example, the HList widgets has a command <B>item</B></I> which can be used
+to create new display items. The following code creates a new imagetext
+item at the third column of the entry foo inside an HList widget:
+<P>
+\fC
+<pre><code><code><code>
+ tixHList .h -columns 3
+ .h add foo
+ .h item create foo 2 -itemtype imagetext -text Hello -image image1
+</code></code></code></pre>
+<P>
+</B></I>
+The <B>item create</B></I> command of the HList widget accepts a variable
+number of arguments. The special argument <B>-itemtype</B></I> specifies
+which type of display item to create. Options that are valid for this
+type of display items can then be specified by one or more
+<I>option-value</I></B> pairs.
+<P>
+After the display item is created, they can then be configured or
+destroyed using the commands provided by the host widget. For example,
+the HList widget has the command <B>item configure</B></I>, <B>item cget</B></I>
+and <B>item delete</B></I> for accessing the display items.
+</pre><H3>CREATING AND MANIPULATING DISPLAY STYLES</H3>
+Display styles are created by the command <B>tixDisplayStyle</B></I>:
+</pre><H3>SYNOPSIS</H3>
+<B>tixDisplayStyle<I> <I>itemType</I></B> ?<I>-stylename name</I></B>? ?<I>-refwindow pathName</I></B>? ?<I>options value ...</I></B>?
+<P>
+<I>itemType</I></B> must be one of the existing display items types such as
+<B>text</B></I>, <B>imagetext</B></I>, <B>window</B></I> or any new types added by
+the user. Additional arguments can be given in one or more
+<I>option-value</I></B> pairs. <I>option</I></B> can be any of the valid option
+for this display style or any of the following:
+<P>
+<UL>
+<DL>
+<DT> <B>-stylename <I>name</I></B>
+</I></B>
+<DD> Specifies a name for this style. If unspecified, then a default name
+will be chosen for this style.
+</DL>
+<DL>
+<DT> <B>-refwindow <I>pathName</I></B>
+</I></B>
+<DD> Specifies a window to use for determine the default values of the
+display type. If unspecified, the main window will be used. Default
+values for the display types can be set via the options database. The
+following example sets the <B>-disablebackground</B></I> and
+<B>-disabledforeground</B></I> options of a <B>text</B></I> display style via
+the option database:
+\fC
+</DL>
+<pre><code><code><code>
+option add *table.list*disabledForeground blue
+option add *table.list*disabledBackground darkgray
+tixDisplayStyle text -refwindow .table.list -fg red
+</code></code></code></pre>
+</B></I>
+By using the option database to set the options of the display styles,
+we can advoid hard-coding the option values and give the user more
+flexibility in customization. See option(n) for a detailed description
+of the option database.
+</pre><H3>STYLE COMMAND</H3>
+<P>
+The <B>tixDisplayStyle</B></I> command creates a new Tcl command whose name is the
+same as the name of the newly created display style. This command
+may be used to invoke various operations on the display style. It has the
+following general form:
+<pre>
+<I>styleName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>styleName</I></B> is the name of the command. <I>Option</I></B> and the
+<I>arg</I></B>s determine the exact behavior of the command. The following
+commands are possible:
+<DL>
+<DT> <I>styleName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the valid options of this
+display style.
+</DL>
+<DL>
+<DT> <I>styleName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the display style. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>styleName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given option(s) to have the given value(s); in this case
+the command returns an empty string. <I>Option</I></B> may have any of the
+valid options of this display style.
+</DL>
+<DL>
+<DT> <I>styleName <B>delete</B></I>
+</I></B>
+<DD> Destroy this display style object.
+</DL>
+</pre><H3>EXAMPLE</H3>
+The following example creates two columns of data in a HList
+widget. The first column is in red and the second column in blue. The
+colors of the columns are controlled by two different <B>text</B></I>
+styles. Also, the anchor and font of the second column is chosen so
+that the income data is aligned properly.
+<P>
+\fC
+<pre><code><code><code>
+set courier -*-courier-medium-r-*-*-14-*-*-*-*-*-*-*
+tixHList .h -columns 2; pack .h
+set red [tixDisplayStyle text -fg #800000]
+set blue [tixDisplayStyle text -fg #000080 -anchor e -font $courier]
+
+foreach n {{Joe $10,000} {Peter $20,000} {Raj $90,000} {Zinh $0}} {
+ set entry [.h addchild {}]
+ .h item create $entry 0 -itemtype text \\
+ -text [lindex $n 0] -style $red
+ .h item create $entry 1 -itemtype text \\
+ -text [lindex $n 1] -style $blue
+}
+</code></code></code></pre>
+<P>
+</B></I>
+
+<hr><i>Last modified Sun Jan 19 22:34:21 EST 1997 </i> ---
+<i>Serial 853731297</i>
diff --git a/tix/man/DItem.n b/tix/man/DItem.n
new file mode 100644
index 00000000000..0dd1220e822
--- /dev/null
+++ b/tix/man/DItem.n
@@ -0,0 +1,542 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixItemType tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+Tix Display Items
+'
+.BE
+'
+.SH DESCRIPTION
+'
+The Tix \fBDisplay Items\fR and \fBDisplay Types\fR are devised to
+solve a general problem: many Tix widgets (both existing and planned
+ones) display many items of many types simutaneously.
+'
+.PP
+'
+For example, a hierarchical listbox widget (HList) can display items
+of images, plain text and subwindows in the form of a
+hierarchy. Another widget, the tabular listbox, (TList, currently
+planned and will be released in Tix 4.1) also display items of the
+same types, although it arranges the items in a tabular form. Yet
+another widget, the spreadsheet widget, also displays similar types
+items, but in yet another format.
+'
+.PP
+'
+In these examples, the display items in different widgets are only
+different in how they are arranged by the \fBhost widget\fR. In Tix,
+display items are clearly separated from the host widgets. The
+advantage is two-fold: first, the creation and configuration of
+display items become uniform across different host widgets. Second,
+new display item types can be added without the need to modify the
+existing host widgets.
+'
+.PP
+'
+In a way, Tix display items are similar to the items inside Tk
+the canvas widget. However, unlike the Tix display items, the canvas
+items are not independent of the canvas widget; this makes it
+impossible to use the canvas items inside other types of TK widgets.
+'
+.PP
+'
+The appearance of a display item is controlled by a set of
+\fIattributes\fR. It is observed that each the attributes usually fall
+into one of two categroies: "\fIindividual\fR" or
+"\fIcollective\fR". For example, the text items inside a HList widget
+may all display a different text string; however, in most cases, the
+text items share the same color, font and spacing. Instead of keeping
+a duplicated version of the same attributes inside each display item,
+it will be advantageous to put the collective attributes in a
+special object called a \fBdisplay style\fR. First, there is the space
+concern: a host widget may have many thousands of items; keeping
+dupilcated attributes will be very wasteful. Second, when it becomes
+necessary to change a collective attribute, such as changing all the
+text items' foreground color to red, it will be more efficient to
+change only the display style object than to modify all the text
+items one by one.
+'
+.PP
+'
+The attributes of the a display item are thus stored in two places: it
+has a set of \fBitem options\fR to store its individual attributes. Each
+display item is also associated with a \fIdisplay style\fR, which specifies
+the collective attributes of all items associated with itself.
+'
+.PP
+'
+The division between the individual and collective attributes are
+fixed and cannot be changed. Thus, when it becomes necessary for some
+items to differ in their collective attributes, two or more \fBdisplay
+styles\fR can be used. For example, suppose you want to display two
+columns of text items inside an HList widget, one column in red and
+the other in blue. You can create a TextStyle object called "red",
+which defines a red foreground, and another called "blue", which
+defines a blue foreground. You can then associate all text items of
+the first column to "red" and the second column to "blue".
+'
+.SH DISPLAY ITEM TYPES AND OPTIONS
+'
+Currently there are three types of display items: \fBtext\fR,
+\fBimagetext\fR and \fBwindow\fR.
+'
+'----------------------------------------------------------------------
+' ImageText
+'----------------------------------------------------------------------
+.SH IMAGETEXT ITEMS
+'
+Display items of the type \fBimagetext\fR are used to display an image
+together with a text string. Imagetext items support the following options:
+'
+.PP
+\fBITEM OPTIONS\fR
+.PP
+.RS
+'----------BEGIN
+.LP
+.nf
+Name: \fBbitmap\fR
+Class: \fBBitmap\fR
+Switch: \fB\-bitmap\fR
+.fi
+.IP
+Specifies the bitmap to display in the item.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBimage\fR
+Class: \fBImage\fR
+Switch: \fB\-image\fR
+.fi
+.IP
+Specifies the image to display in the item. When both the
+\fB\-bitmap\fR and \fB\-image\fR options are specified, only the image
+will be displayed.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBimageTextStyle\fR
+Class: \fBImageTextStyle\fR
+Switch: \fB\-style\fR
+.fi
+.IP
+Specifies the display style to use for this item. Must be the
+name of a \fBimagetext\fR display style that has already be created by
+the \fBtixDisplayStyle(n)\fR command.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBshowImage\fR
+Class: \fBShowImage\fR
+Switch: \fB\-showimage\fR
+.fi
+.IP
+A Boolean value that specifies whether the image/bitmap should be
+displayed.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBshowText\fR
+Class: \fBShowText\fR
+Switch: \fB\-showtext\fR
+.fi
+.IP
+A Boolean value that specifies whether the text string should be
+displayed.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBtext\fR
+Class: \fBText\fR
+Switch: \fB\-text\fR
+.fi
+.IP
+Specifies the text string to display in the item.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBunderline\fR
+Class: \fBUnderline\fR
+Switch: \fB\-underline\fR
+.fi
+.IP
+Specifies the integer index of a character to underline in the text
+string in the item. 0 corresponds to the first character of the text
+displayed in the widget, 1 to the next character, and so on.
+'----------END
+.RE
+'
+.PP
+\fBSTYLE OPTIONS\fR
+'
+.PP
+The style information of \fBimagetext\fR items are stored in the
+\fBimagetext\fR display style. The following options are supported:
+'
+.RS
+'
+.PP
+\fBSTANDARD OPTIONS\fR
+'
+.PP
+\fC
+.ta 6c
+.nf
+activeBackground activeForeground
+anchor background
+disabledBackground disabledForeground
+foreground font
+justify padX
+padY selectBackground
+selectForeground wrapLength
+.fi
+\fR
+.ta 4c
+.PP
+See the \fBoptions(n)\fR manual entry for details on the standard
+options.
+.PP
+'
+.PP
+\fBSTYLE-SPECIFIC OPTIONS\fR
+.PP
+'----------BEGIN
+.LP
+.nf
+Name: \fBgap\fR
+Class: \fBGap\fR
+Switch: \fB\-gap\fR
+'
+.fi
+.IP
+Specifies the distance between the bitmap/image and the text string,
+in number of pixels.
+'----------END
+'
+.RE
+'
+'**********************************************************************
+'
+' text
+'
+'**********************************************************************
+.SH TEXT ITEMS
+'
+Display items of the type \fBtext\fR are used to display a text string
+in a widget. Text items support the following options:
+'
+.PP
+\fBITEM OPTIONS\fR
+.PP
+.RS
+'----------BEGIN
+.LP
+.nf
+Name: \fBtextStyle\fR
+Class: \fBTextStyle\fR
+Switch: \fB\-style\fR
+.fi
+.IP
+Specifies the display style to use for this text item. Must be the
+name of a \fBtext\fR display style that has already be created by the
+\fBtixDisplayStyle(n)\fR command.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBtext\fR
+Class: \fBText\fR
+Switch: \fB\-text\fR
+.fi
+.IP
+Specifies the text string to display in the item.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBunderline\fR
+Class: \fBUnderline\fR
+Switch: \fB\-underline\fR
+.fi
+.IP
+Specifies the integer index of a character to underline in the item.
+0 corresponds to the first character of the text displayed in the
+widget, 1 to the next character, and so on.
+'----------END
+.RE
+'
+\fBSTYLE OPTIONS\fR
+.PP
+.RS
+.PP
+\fBSTANDARD OPTIONS\fR
+'
+.PP
+\fC
+.ta 6c
+.nf
+activeBackground activeForeground
+anchor background
+disabledBackground disabledForeground
+foreground font
+justify padX
+padY selectBackground
+selectForeground wrapLength
+.fi
+\fR
+.ta 4c
+.PP
+See the \fBoptions(n)\fR manual entry for details on the standard
+options.
+'
+'
+.PP
+.RE
+'**********************************************************************
+'
+' Window
+'
+'**********************************************************************
+.SH WINDOW ITEMS
+'
+Display items of the type \fBwindow\fR are used to display a
+sub-window in a widget. \fBWindow\fR items support the following
+options:
+'
+.PP
+\fBITEM OPTIONS\fR
+.PP
+.RS
+'----------BEGIN
+.LP
+.nf
+Name: \fBwindowStyle\fR
+Class: \fBWindowStyle\fR
+Switch: \fB\-style\fR
+.fi
+.IP
+Specifies the display style to use for this window item. Must be the
+name of a \fBwindow\fR display style that has already be created by
+the \fBtixDisplayStyle(n)\fR command.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBwindow\fR
+Class: \fBWindow\fR
+Switch: \fB\-window\fR
+Alias: \fB\-widget\fR
+.fi
+.IP
+Specifies the sub-window to display in the item.
+'----------END
+'
+.RE
+'
+\fBSTYLE OPTIONS\fR
+.PP
+.RS
+\fBSTANDARD OPTIONS\fR
+'
+.PP
+\fC
+.ta 6c
+.nf
+anchor
+padX padY
+.PP
+.fi
+.ta 4c
+See the \fBoptions(n)\fR manual entry for details on the standard
+options.
+'
+.PP
+.RE
+'
+'**********************************************************************
+'
+.SH CREATING DISPLAY ITEMS
+'
+'
+Display items do not exist on their and thus they cannot be created
+independently of the widgets they reside in. As a rule, display items
+are created by special widget commands of their "host" widgets. For
+example, the HList widgets has a command \fBitem\fR which can be used
+to create new display items. The following code creates a new imagetext
+item at the third column of the entry foo inside an HList widget:
+'
+.PP
+\fC
+.nf
+ tixHList .h -columns 3
+ .h add foo
+ .h item create foo 2 \-itemtype imagetext \-text Hello \-image image1
+.fi
+.PP
+\fR
+'
+The \fBitem create\fR command of the HList widget accepts a variable
+number of arguments. The special argument \fB\-itemtype\fR specifies
+which type of display item to create. Options that are valid for this
+type of display items can then be specified by one or more
+\fIoption\-value\fR pairs.
+'
+.PP
+'
+After the display item is created, they can then be configured or
+destroyed using the commands provided by the host widget. For example,
+the HList widget has the command \fBitem configure\fR, \fBitem cget\fR
+and \fBitem delete\fR for accessing the display items.
+'
+'**********************************************************************
+'
+.SH CREATING AND MANIPULATING DISPLAY STYLES
+'
+'
+Display styles are created by the command \fBtixDisplayStyle\fR:
+'
+.SH SYNOPSIS
+\fBtixDisplayStyle\fI \fIitemType\fR ?\fI\-stylename name\fR? ?\fI\-refwindow pathName\fR? ?\fIoptions value ...\fR?
+'
+'
+.PP
+\fIitemType\fR must be one of the existing display items types such as
+\fBtext\fR, \fBimagetext\fR, \fBwindow\fR or any new types added by
+the user. Additional arguments can be given in one or more
+\fIoption\-value\fR pairs. \fIoption\fR can be any of the valid option
+for this display style or any of the following:
+.PP
+.RS
+'
+.TP
+\fB\-stylename \fIname\fR
+'
+Specifies a name for this style. If unspecified, then a default name
+will be chosen for this style.
+'
+.TP
+\fB\-refwindow \fIpathName\fR
+'
+Specifies a window to use for determine the default values of the
+display type. If unspecified, the main window will be used. Default
+values for the display types can be set via the options database. The
+following example sets the \fB\-disablebackground\fR and
+\fB\-disabledforeground\fR options of a \fBtext\fR display style via
+the option database:
+\fC
+.nf
+option add *table.list*disabledForeground blue
+option add *table.list*disabledBackground darkgray
+tixDisplayStyle text -refwindow .table.list -fg red
+.fi
+\fR
+'
+By using the option database to set the options of the display styles,
+we can advoid hard-coding the option values and give the user more
+flexibility in customization. See option(n) for a detailed description
+of the option database.
+'
+.SH STYLE COMMAND
+.PP
+The \fBtixDisplayStyle\fR command creates a new Tcl command whose name is the
+same as the name of the newly created display style. This command
+may be used to invoke various operations on the display style. It has the
+following general form:
+'
+'
+.DS C
+'
+\fIstyleName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIstyleName\fR is the name of the command. \fIOption\fR and the
+\fIarg\fRs determine the exact behavior of the command. The following
+commands are possible:
+'
+.TP
+\fIstyleName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the valid options of this
+display style.
+'
+.TP
+'
+\fIstyleName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the display style. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIstyleName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given option(s) to have the given value(s); in this case
+the command returns an empty string. \fIOption\fR may have any of the
+valid options of this display style.
+'
+.TP
+\fIstyleName \fBdelete\fR
+'
+Destroy this display style object.
+'
+.SH EXAMPLE
+'
+The following example creates two columns of data in a HList
+widget. The first column is in red and the second column in blue. The
+colors of the columns are controlled by two different \fBtext\fR
+styles. Also, the anchor and font of the second column is chosen so
+that the income data is aligned properly.
+'
+.PP
+\fC
+.nf
+set courier -*-courier-medium-r-*-*-14-*-*-*-*-*-*-*
+tixHList .h -columns 2; pack .h
+set red [tixDisplayStyle text -fg #800000]
+set blue [tixDisplayStyle text -fg #000080 -anchor e -font $courier]
+
+foreach n {{Joe $10,000} {Peter $20,000} {Raj $90,000} {Zinh $0}} {
+ set entry [.h addchild {}]
+ .h item create $entry 0 -itemtype text \\
+ -text [lindex $n 0] -style $red
+ .h item create $entry 1 -itemtype text \\
+ -text [lindex $n 1] -style $blue
+}
+.fi
+.PP
+\fR
+
diff --git a/tix/man/Destroy.html b/tix/man/Destroy.html
new file mode 100644
index 00000000000..58d25c1fcbe
--- /dev/null
+++ b/tix/man/Destroy.html
@@ -0,0 +1,21 @@
+
+
+
+<TITLE>tixDestroy - Destroy Tix Objects</TITLE>
+<Center><H2>tixDestroy - Destroy Tix Objects</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixDestroy</B></I> <I>objectName</I></B>
+</pre><HR>
+
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixDestroy</B></I> destroys a Tix object whose class is declared by
+the <B>tixClass</B></I> keyword. When the object is destroyed, its
+<B>Destructor</B></I> function is called and the memory allocated for this
+object is freed.
+</pre><H3>KEYWORDS</H3>
+Tix, Object
+<!Serial 851729143>
+<hr><i>Last modified Fri Jan 17 23:00:38 EST 1997 </i> ---
+<i>Serial 853731297</i>
diff --git a/tix/man/Destroy.n b/tix/man/Destroy.n
new file mode 100644
index 00000000000..8e638f4d007
--- /dev/null
+++ b/tix/man/Destroy.n
@@ -0,0 +1,32 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+.HS tixDestroy tix 4.0
+.BS
+'
+.SH NAME
+tixDestroy \- Destroy Tix Objects
+'
+.SH SYNOPSIS
+\fBtixDestroy\fR \fIobjectName\fR
+'
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBtixDestroy\fR destroys a Tix object whose class is declared by
+the \fBtixClass\fR keyword. When the object is destroyed, its
+\fBDestructor\fR function is called and the memory allocated for this
+object is freed.
+'
+.SH KEYWORDS
+Tix, Object
diff --git a/tix/man/DirDlg.html b/tix/man/DirDlg.html
new file mode 100644
index 00000000000..eae37c6ce28
--- /dev/null
+++ b/tix/man/DirDlg.html
@@ -0,0 +1,123 @@
+
+
+
+<TITLE>tixDirSelectDialog - Create and manipulate directory selection dialogs.</TITLE>
+<Center><H2>tixDirSelectDialog - Create and manipulate directory selection dialogs.</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixDirSelectDialog<I> <I>pathName ?<I>options</I></B>?
+</pre><H3>STANDARD OPTIONS</H3>
+<B>TixDirSelectDialog</B></I> supports all the standard options of a
+toplevel widget. See the <B>options(n)</B></I> manual entry for details on
+the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>command</B></I>
+Class: <B>Command</B></I>
+Switch: <B>-command</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the command to be called when the user selects a directory
+in the dialog box. The command is called with one extra argument, the
+complete pathname of the directory. If the user cancels the selection,
+this command is not called.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>dirbox</B></I>
+Class: <B>TixDirSelectBox</B></I>
+</code></code></code></pre>
+<UL>
+The DirSelectBox widget that consists of the main part of the dialog.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>cancel</B></I>
+Class: <B>Button</B></I>
+</code></code></code></pre>
+<UL>
+The "Cancel" button.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>ok</B></I>
+Class: <B>Buton</B></I>
+</code></code></code></pre>
+<UL>
+The "OK" button.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixDirSelectDialog</B></I> command creates a new window (given by
+the <I>pathName</I></B> argument) and makes it into a DirSelectDialog
+widget. Additional options, described above, may be specified on the
+command line or in the option database to configure aspects of the
+DirSelectDialog such as its cursor and relief.
+
+The DirSelectDialog widget presents the directories in the file system
+in a dialog window. The user can use this dialog window to navigate
+through the file system to select the desired directory.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixDirSelectDialog</B></I> command creates a new Tcl command whose
+This command may be used to invoke various operations on the
+widget. It has the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+determine the exact behavior of the command. The following commands
+are possible for DirSelectDialog widgets:
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixDirSelectDialog</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixDirSelectDialog</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>popup</B></I>
+</I></B>
+<DD> Pops up the DirSelectDialog widget on the screen.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+</DL>
+</pre><H3>EXAMPLE</H3>
+<pre><code><code><code>
+set dlg [tixDirSelectDialog .dlg -command SelectDir]
+$dlg popup
+
+proc SelectDir {dir} {
+ puts "You have selected \\"$dir\\""
+}
+</code></code></code></pre>
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:21 EST 1997 </i> ---
+<i>Serial 853731297</i>
diff --git a/tix/man/DirDlg.n b/tix/man/DirDlg.n
new file mode 100644
index 00000000000..29372af50e8
--- /dev/null
+++ b/tix/man/DirDlg.n
@@ -0,0 +1,175 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixDirSelectDialog tix 4.1
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixDirSelectDialog \- Create and manipulate directory selection dialogs.
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixDirSelectDialog\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+\fBTixDirSelectDialog\fR supports all the standard options of a
+toplevel widget. See the \fBoptions(n)\fR manual entry for details on
+the standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Switch: \fB\-command\fR
+.fi
+.IP
+Specifies the command to be called when the user selects a directory
+in the dialog box. The command is called with one extra argument, the
+complete pathname of the directory. If the user cancels the selection,
+this command is not called.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'----------BEGIN
+.LP
+.nf
+Name: \fBdirbox\fR
+Class: \fBTixDirSelectBox\fR
+.fi
+.IP
+The DirSelectBox widget that consists of the main part of the dialog.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcancel\fR
+Class: \fBButton\fR
+.fi
+.IP
+The "Cancel" button.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBok\fR
+Class: \fBButon\fR
+.fi
+.IP
+The "OK" button.
+'----------END
+'
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixDirSelectDialog\fR command creates a new window (given by
+the \fIpathName\fR argument) and makes it into a DirSelectDialog
+widget. Additional options, described above, may be specified on the
+command line or in the option database to configure aspects of the
+DirSelectDialog such as its cursor and relief.
+
+The DirSelectDialog widget presents the directories in the file system
+in a dialog window. The user can use this dialog window to navigate
+through the file system to select the desired directory.
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixDirSelectDialog\fR command creates a new Tcl command whose
+name is the same as the path name of the DirSelectDialog's window.
+This command may be used to invoke various operations on the
+widget. It has the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+DirSelectDialog widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following commands
+are possible for DirSelectDialog widgets:
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixDirSelectDialog\fR command.
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixDirSelectDialog\fR command.
+'
+.TP
+\fIpathName \fBpopup\fR
+'
+Pops up the DirSelectDialog widget on the screen.
+'
+.TP
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+'
+'
+.SH EXAMPLE
+'
+.nf
+set dlg [tixDirSelectDialog .dlg -command SelectDir]
+$dlg popup
+
+proc SelectDir {dir} {
+ puts "You have selected \\"$dir\\""
+}
+.fi
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/DirList.html b/tix/man/DirList.html
new file mode 100644
index 00000000000..bff9b19e179
--- /dev/null
+++ b/tix/man/DirList.html
@@ -0,0 +1,220 @@
+
+
+
+<TITLE>tixDirList - Create and manipulate tixDirList widgets</TITLE>
+<Center><H2>tixDirList - Create and manipulate tixDirList widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixDirList<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+The <B>TixDirList</B></I> class is derived from the <B>TixScrolledHList</B></I>
+class and inherits all the commands, options and subwidgets of its
+super-class.
+</pre><H3>STANDARD OPTIONS</H3>
+<B>TixDirList</B></I> supports all the standard options of a frame widget.
+See the <B>options(n)</B></I> manual entry for details on the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>browseCmd</B></I>
+Class: <B>BrowseCmd</B></I>
+Switch: <B>-browsecmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a command to call whenever the user browses on a directory
+(usually by single-clicking on the name of the directory). The command
+is called with one argument, the complete pathname of the directory.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>command</B></I>
+Class: <B>Command</B></I>
+Switch: <B>-command</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the command to be called when the user activates on a directory
+(usually by double-clicking on the name of the directory). The command
+is called with one argument, the complete pathname of the directory.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>dircmd</B></I>
+Class: <B>DirCmd</B></I>
+Switch: <B>-dircmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the TCL command to be called when a directory listing is
+needed for a particular directory. If this option is not specified, by
+default the DirList widget will attempt to read the directory as a
+Unix directory. On special occasions, the application programmer may
+want to supply a special method for reading directories: for example,
+when he needs to list remote directories. In this case, the
+<B>-dircmd</B></I> option can be used. The specified command accepts two
+arguments: the first is the name of the directory to be listed; the
+second is a Boolean value indicating whether hidden sub-directories
+should be listed. This command returns a list of names of the
+sub-directories of this directory. For example:
+\fC
+</UL>
+<pre><code><code><code>
+
+ proc read_dir {dir show_hidden} {
+ if {$dir == "C:\\"} {
+ return {DOS NORTON WINDOWS}
+ } else {
+ return {}
+ }
+ }
+</code></code></code></pre>
+</B></I>
+<P>
+<pre><code><code><code>
+Name: <B>disableCallback</B></I>
+Class: <B>DisableCallback</B></I>
+Switch: <B>-disablecallback</B></I>
+</code></code></code></pre>
+<UL>
+A boolean value indicating whether callbacks should be disabled. When
+set to true, the TCL command specified by the <B>-command</B></I> option
+is not executed when the <B>-value</B></I> of the DirList widget
+changes.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>showHidden</B></I>
+Class: <B>ShowHidden</B></I>
+Switch: <B>-showhidden</B></I>
+</code></code></code></pre>
+<UL>
+Specifies whether hidden directories should be shown. By default, a
+directory name starting with a period "." is considered as a hidden
+directory. This rule can be overridden by supplying an alternative
+<B>-dircmd</B></I> option.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>root</B></I>
+Class: <B>Root</B></I>
+Switch: <B>-root</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the name of the root directory. Usually this is <B>"/"</B></I>
+under Unix machines, but can be changed to <B>"C:\\"</B></I> in DOS environments.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>rootName</B></I>
+Class: <B>RootNAme</B></I>
+Switch: <B>-rootname</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a text string to display at the root directory. If
+unspecified, the text string will be the same as the string specified
+by <B>-root</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>value</B></I>
+Class: <B>Value</B></I>
+Switch: <B>-value</B></I>
+Alias: <B>-directory</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the name of the current directory to be displayed in the
+DirList widget.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>hlist</B></I>
+Class: <B>TixHList</B></I>
+</code></code></code></pre>
+<UL>
+The hierarchical listbox that displays the directory listing.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>hsb</B></I>
+Class: <B>Scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+The horizontal scrollbar subwidget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>vsb</B></I>
+Class: <B>Scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+The vertical scrollbar subwidget.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixDirList</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a DirList widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+DirList such as its cursor and relief.
+
+The DirList widget displays a list view of a directory, its
+previous directories and its sub-directories. The user can choose one
+of the directories displayed in the list or change to another
+directory.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixDirList</B></I> command creates a new Tcl command whose name is
+command may be used to invoke various operations on the widget. It has
+the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+determine the exact behavior of the command. The following commands
+are possible for DirList widgets:
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixDirList</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>chdir</B></I> <I>dir</I></B>
+</I></B>
+<DD> Change the current directory to <I>dir</I></B>.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixDirList</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+</DL>
+</pre><H3>BINDINGS</H3>
+<P>
+The mouse and keyboard bindings of the DirList widget are the same as
+the bindings of the HList widget.
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:22 EST 1997 </i> ---
+<i>Serial 853731297</i>
diff --git a/tix/man/DirList.n b/tix/man/DirList.n
new file mode 100644
index 00000000000..44636d4741c
--- /dev/null
+++ b/tix/man/DirList.n
@@ -0,0 +1,302 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixDirList tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixDirList \- Create and manipulate tixDirList widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixDirList\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+The \fBTixDirList\fR class is derived from the \fBTixScrolledHList\fR
+class and inherits all the commands, options and subwidgets of its
+super-class.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+\fBTixDirList\fR supports all the standard options of a frame widget.
+See the \fBoptions(n)\fR manual entry for details on the standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBbrowseCmd\fR
+Class: \fBBrowseCmd\fR
+Switch: \fB\-browsecmd\fR
+.fi
+.IP
+Specifies a command to call whenever the user browses on a directory
+(usually by single-clicking on the name of the directory). The command
+is called with one argument, the complete pathname of the directory.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Switch: \fB\-command\fR
+.fi
+.IP
+Specifies the command to be called when the user activates on a directory
+(usually by double-clicking on the name of the directory). The command
+is called with one argument, the complete pathname of the directory.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdircmd\fR
+Class: \fBDirCmd\fR
+Switch: \fB\-dircmd\fR
+.fi
+.IP
+Specifies the TCL command to be called when a directory listing is
+needed for a particular directory. If this option is not specified, by
+default the DirList widget will attempt to read the directory as a
+Unix directory. On special occasions, the application programmer may
+want to supply a special method for reading directories: for example,
+when he needs to list remote directories. In this case, the
+\fB\-dircmd\fR option can be used. The specified command accepts two
+arguments: the first is the name of the directory to be listed; the
+second is a Boolean value indicating whether hidden sub-directories
+should be listed. This command returns a list of names of the
+sub-directories of this directory. For example:
+\fC
+.nf
+
+ proc read_dir {dir show_hidden} {
+ if {$dir == "C:\\"} {
+ return {DOS NORTON WINDOWS}
+ } else {
+ return {}
+ }
+ }
+.fi
+\fR
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdisableCallback\fR
+Class: \fBDisableCallback\fR
+Switch: \fB\-disablecallback\fR
+.fi
+.IP
+A boolean value indicating whether callbacks should be disabled. When
+set to true, the TCL command specified by the \fB\-command\fR option
+is not executed when the \fB\-value\fR of the DirList widget
+changes.
+'----------END
+'
+'----------BEGIN
+'
+.LP
+.nf
+Name: \fBshowHidden\fR
+Class: \fBShowHidden\fR
+Switch: \fB\-showhidden\fR
+.fi
+.IP
+Specifies whether hidden directories should be shown. By default, a
+directory name starting with a period "." is considered as a hidden
+directory. This rule can be overridden by supplying an alternative
+\fB\-dircmd\fR option.
+'----------END
+'
+'----------END
+'
+.LP
+.nf
+Name: \fBroot\fR
+Class: \fBRoot\fR
+Switch: \fB\-root\fR
+.fi
+.IP
+'
+Specifies the name of the root directory. Usually this is \fB"/"\fR
+under Unix machines, but can be changed to \fB"C:\\"\fR in DOS environments.
+'----------END
+'
+'----------END
+'
+.LP
+.nf
+Name: \fBrootName\fR
+Class: \fBRootNAme\fR
+Switch: \fB\-rootname\fR
+.fi
+.IP
+'
+Specifies a text string to display at the root directory. If
+unspecified, the text string will be the same as the string specified
+by \fB\-root\fR.
+'----------END
+'
+'----------END
+'
+.LP
+.nf
+Name: \fBvalue\fR
+Class: \fBValue\fR
+Switch: \fB\-value\fR
+Alias: \fB\-directory\fR
+.fi
+.IP
+Specifies the name of the current directory to be displayed in the
+DirList widget.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'----------BEGIN
+.LP
+.nf
+Name: \fBhlist\fR
+Class: \fBTixHList\fR
+.fi
+.IP
+The hierarchical listbox that displays the directory listing.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBhsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The horizontal scrollbar subwidget.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The vertical scrollbar subwidget.
+'----------END
+'
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixDirList\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a DirList widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+DirList such as its cursor and relief.
+
+The DirList widget displays a list view of a directory, its
+previous directories and its sub-directories. The user can choose one
+of the directories displayed in the list or change to another
+directory.
+'
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixDirList\fR command creates a new Tcl command whose name is
+the same as the path name of the DirList's window. This
+command may be used to invoke various operations on the widget. It has
+the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+DirList widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following commands
+are possible for DirList widgets:
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixDirList\fR command.
+'
+.TP
+\fIpathName \fBchdir\fR \fIdir\fR
+'
+Change the current directory to \fIdir\fR.
+'
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixDirList\fR command.
+'
+'
+.TP
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+'
+'
+'
+'----------------------------------------------------------------------
+.SH BINDINGS
+.PP
+'
+The mouse and keyboard bindings of the DirList widget are the same as
+the bindings of the HList widget.
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/DirTree.html b/tix/man/DirTree.html
new file mode 100644
index 00000000000..5dfc7e56ecb
--- /dev/null
+++ b/tix/man/DirTree.html
@@ -0,0 +1,199 @@
+
+
+
+<TITLE>tixDirTree - Create and manipulate tixDirTree widgets</TITLE>
+<Center><H2>tixDirTree - Create and manipulate tixDirTree widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixDirTree<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+The <B>TixDirTree</B></I> class is derived from the <B>TixScrolledHList</B></I>
+class and inherits all the commands, options and subwidgets of its
+super-class.
+</pre><H3>STANDARD OPTIONS</H3>
+<B>TixDirTree</B></I> supports all the standard options of a frame widget.
+See the <B>options(n)</B></I> manual entry for details on the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>browseCmd</B></I>
+Class: <B>BrowseCmd</B></I>
+Switch: <B>-browsecmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a command to call whenever the user browses on a directory
+(usually by single-clicking on the name of the directory). The command
+is called with one argument, the complete pathname of the directory.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>command</B></I>
+Class: <B>Command</B></I>
+Switch: <B>-command</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the command to be called when the user activates on a directory
+(usually by double-clicking on the name of the directory). The command
+is called with one argument, the complete pathname of the directory.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>dircmd</B></I>
+Class: <B>DirCmd</B></I>
+Switch: <B>-dircmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the TCL command to be called when a directory listing is
+needed for a particular directory. If this option is not specified, by
+default the DirTree widget will attempt to read the directory as a
+Unix directory. On special occasions, the application programmer may
+want to supply a special method for reading directories: for example,
+when he needs to list remote directories. In this case, the
+<B>-dircmd</B></I> option can be used. The specified command accepts two
+arguments: the first is the name of the directory to be listed; the
+second is a Boolean value indicating whether hidden sub-directories
+should be listed. This command returns a list of names of the
+sub-directories of this directory. For example:
+\fC
+</UL>
+<pre><code><code><code>
+
+ proc read_dir {dir show_hidden} {
+ if {$dir == "C:\\"} {
+ return {DOS NORTON WINDOWS}
+ } else {
+ return {}
+ }
+ }
+</code></code></code></pre>
+</B></I>
+<P>
+<pre><code><code><code>
+Name: <B>disableCallback</B></I>
+Class: <B>DisableCallback</B></I>
+Switch: <B>-disablecallback</B></I>
+</code></code></code></pre>
+<UL>
+A boolean value indicating whether callbacks should be disabled. When
+set to true, the TCL command specified by the <B>-command</B></I> option
+is not executed when the <B>-value</B></I> of the DirTree widget
+changes.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>showHidden</B></I>
+Class: <B>ShowHidden</B></I>
+Switch: <B>-showhidden</B></I>
+</code></code></code></pre>
+<UL>
+Specifies whether hidden directories should be shown. By default, a
+directory name starting with a period "." is considered as a hidden
+directory. This rule can be overridden by supplying an alternative
+<B>-dircmd</B></I> option.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>value</B></I>
+Class: <B>Value</B></I>
+Switch: <B>-value</B></I>
+Alias: <B>-directory</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the name of the current directory to be displayed in the
+DirTree widget.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>hlist</B></I>
+Class: <B>TixHList</B></I>
+</code></code></code></pre>
+<UL>
+The hierarchical listbox that displays the directory listing.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>hsb</B></I>
+Class: <B>Scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+The horizontal scrollbar subwidget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>vsb</B></I>
+Class: <B>Scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+The vertical scrollbar subwidget.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixDirTree</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a DirTree widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+DirTree such as its cursor and relief.
+
+The DirTree widget displays a list view of a directory, its
+previous directories and its sub-directories. The user can choose one
+of the directories displayed in the list or change to another
+directory.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixDirTree</B></I> command creates a new Tcl command whose name is
+command may be used to invoke various operations on the widget. It has
+the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+determine the exact behavior of the command. The following commands
+are possible for DirTree widgets:
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixDirTree</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>chdir</B></I> <I>dir</I></B>
+</I></B>
+<DD> Change the current directory to <I>dir</I></B>.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixDirTree</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+</DL>
+</pre><H3>BINDINGS</H3>
+<P>
+The mouse and keyboard bindings of the DirTree widget are the same as
+the bindings of the HList widget.
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:22 EST 1997 </i> ---
+<i>Serial 853731297</i>
diff --git a/tix/man/DirTree.n b/tix/man/DirTree.n
new file mode 100644
index 00000000000..d2e9ff9f25c
--- /dev/null
+++ b/tix/man/DirTree.n
@@ -0,0 +1,273 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixDirTree tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixDirTree \- Create and manipulate tixDirTree widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixDirTree\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+The \fBTixDirTree\fR class is derived from the \fBTixScrolledHList\fR
+class and inherits all the commands, options and subwidgets of its
+super-class.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+\fBTixDirTree\fR supports all the standard options of a frame widget.
+See the \fBoptions(n)\fR manual entry for details on the standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBbrowseCmd\fR
+Class: \fBBrowseCmd\fR
+Switch: \fB\-browsecmd\fR
+.fi
+.IP
+Specifies a command to call whenever the user browses on a directory
+(usually by single-clicking on the name of the directory). The command
+is called with one argument, the complete pathname of the directory.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Switch: \fB\-command\fR
+.fi
+.IP
+Specifies the command to be called when the user activates on a directory
+(usually by double-clicking on the name of the directory). The command
+is called with one argument, the complete pathname of the directory.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdircmd\fR
+Class: \fBDirCmd\fR
+Switch: \fB\-dircmd\fR
+.fi
+.IP
+Specifies the TCL command to be called when a directory listing is
+needed for a particular directory. If this option is not specified, by
+default the DirTree widget will attempt to read the directory as a
+Unix directory. On special occasions, the application programmer may
+want to supply a special method for reading directories: for example,
+when he needs to list remote directories. In this case, the
+\fB\-dircmd\fR option can be used. The specified command accepts two
+arguments: the first is the name of the directory to be listed; the
+second is a Boolean value indicating whether hidden sub-directories
+should be listed. This command returns a list of names of the
+sub-directories of this directory. For example:
+\fC
+.nf
+
+ proc read_dir {dir show_hidden} {
+ if {$dir == "C:\\"} {
+ return {DOS NORTON WINDOWS}
+ } else {
+ return {}
+ }
+ }
+.fi
+\fR
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdisableCallback\fR
+Class: \fBDisableCallback\fR
+Switch: \fB\-disablecallback\fR
+.fi
+.IP
+A boolean value indicating whether callbacks should be disabled. When
+set to true, the TCL command specified by the \fB\-command\fR option
+is not executed when the \fB\-value\fR of the DirTree widget
+changes.
+'----------END
+'
+'----------BEGIN
+'
+.LP
+.nf
+Name: \fBshowHidden\fR
+Class: \fBShowHidden\fR
+Switch: \fB\-showhidden\fR
+.fi
+.IP
+Specifies whether hidden directories should be shown. By default, a
+directory name starting with a period "." is considered as a hidden
+directory. This rule can be overridden by supplying an alternative
+\fB\-dircmd\fR option.
+'----------END
+'
+'----------END
+'
+.LP
+.nf
+Name: \fBvalue\fR
+Class: \fBValue\fR
+Switch: \fB\-value\fR
+Alias: \fB\-directory\fR
+.fi
+.IP
+Specifies the name of the current directory to be displayed in the
+DirTree widget.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'----------BEGIN
+.LP
+.nf
+Name: \fBhlist\fR
+Class: \fBTixHList\fR
+.fi
+.IP
+The hierarchical listbox that displays the directory listing.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBhsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The horizontal scrollbar subwidget.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The vertical scrollbar subwidget.
+'----------END
+'
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixDirTree\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a DirTree widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+DirTree such as its cursor and relief.
+
+The DirTree widget displays a list view of a directory, its
+previous directories and its sub-directories. The user can choose one
+of the directories displayed in the list or change to another
+directory.
+'
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixDirTree\fR command creates a new Tcl command whose name is
+the same as the path name of the DirTree's window. This
+command may be used to invoke various operations on the widget. It has
+the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+DirTree widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following commands
+are possible for DirTree widgets:
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixDirTree\fR command.
+'
+.TP
+\fIpathName \fBchdir\fR \fIdir\fR
+'
+Change the current directory to \fIdir\fR.
+'
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixDirTree\fR command.
+'
+'
+.TP
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+'
+'
+'
+'----------------------------------------------------------------------
+.SH BINDINGS
+.PP
+'
+The mouse and keyboard bindings of the DirTree widget are the same as
+the bindings of the HList widget.
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/EFileBox.html b/tix/man/EFileBox.html
new file mode 100644
index 00000000000..8087225320e
--- /dev/null
+++ b/tix/man/EFileBox.html
@@ -0,0 +1,284 @@
+
+
+
+<TITLE>tixExFileSelectBox - Create and manipulate tixExFileSelectBox widgets</TITLE>
+<Center><H2>tixExFileSelectBox - Create and manipulate tixExFileSelectBox widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixExFileSelectBox<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+The <B>TixExFileSelectBox</B></I> class does not have a super-class.
+</pre><H3>STANDARD OPTIONS</H3>
+<B>TixExFileSelectBox</B></I> supports all the standard options of a frame
+widget. See the <B>options(n)</B></I> manual entry for details on the
+standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>browseCmd</B></I>
+Class: <B>BrowseCmd</B></I>
+Switch: <B>-browsecmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a command to call whenever the user browses on a filename in
+the file listbox (usually by single-clicking on the filename). The command
+is called with one argument, the complete pathname of the file.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>command</B></I>
+Class: <B>Command</B></I>
+Switch: <B>-command</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the command to be called when the user chooses on a filename
+the file listbox (usually by double-clicking on the filename). The command
+is called with one argument, the complete pathname of the file.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>dialog</B></I>
+Class: <B>Dialog</B></I>
+Switch: <B>-dialog</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a dialog box which contains this ExFileSelectBox widget. The
+dialog box must be a widget of the class TixShell or its
+descendant classes. <I>This is an internal option and should not be used
+by application programmers.</B></I>
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>dircmd</B></I>
+Class: <B>DirCmd</B></I>
+Switch: <B>-dircmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the TCL command to be called when a file listing is needed
+for a particular directory. If this option is not specified, by
+default the ExFileSelectBox widget will attempt to read the directory
+as a Unix directory. On special occasions, the application programmer
+may want to supply a special method for reading directories: for
+example, when he needs to list remote files. In this case, the
+<B>-dircmd</B></I> option can be used. The specified command accepts three
+arguments: the first is the name of the directory to be listed; the
+second is a list of file patterns, the third is a Boolean value
+indicating whether hidden files should be listed. This command returns
+a list of names of the files of this directory which match with the
+file patterns.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>directory</B></I>
+Class: <B>Directory</B></I>
+Switch: <B>-directory</B></I>
+Alias: <B>-dir</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the current directory whose files and sub-directories are
+displayed in the ExFileSelectBox.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>disableCallback</B></I>
+Class: <B>DisableCallback</B></I>
+Switch: <B>-disablecallback</B></I>
+</code></code></code></pre>
+<UL>
+A boolean value indicating whether callbacks should be disabled. When
+set to true, the TCL command specified by the <B>-command</B></I> option
+is not executed when the <B>-value</B></I> of the ExFileSelectBox
+widget changes.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>fileTypes</B></I>
+Class: <B>FileTypes</B></I>
+Switch: <B>-filetypes</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the file types that can be selected from the "List Files of
+Type:" ComboBox subwidget. The value of this option must be a TCL
+list; each item of this list must in turn be a list of two elements.
+The first element is a list of file patterns. The second element is a
+string that describe these file patterns. For example:
+</UL>
+<pre><code><code><code>
+ tixExFileSelectBox .box -filetypes {
+ {{*} {All files}}
+ {{*.txt} {Text files}}
+ {{*.c *.h} {C source files}}
+ }
+</code></code></code></pre>
+<P>
+<pre><code><code><code>
+Name: <B>showHidden</B></I>
+Class: <B>ShowHidden</B></I>
+Switch: <B>-showhidden</B></I>
+</code></code></code></pre>
+<UL>
+Specifies whether hidden directories should be shown. By default, a
+directory name starting with a period "\." is considered as a hidden
+directory.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>pattern</B></I>
+Class: <B>Pattern</B></I>
+Switch: <B>-pattern</B></I>
+</code></code></code></pre>
+<UL>
+Specifies whether the file pattern(s) to match with the files in the
+current directory. One or more file patterns can be given at the same
+time. For example, {*\.c *\.h} will match all files that have either the
+".h" or ".c" extensions.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>value</B></I>
+Class: <B>Value</B></I>
+Switch: <B>-value</B></I>
+Alias: <B>-selection</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the name of the filename currently selected by the user.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>cancel</B></I>
+Class: <B>Button</B></I>
+</code></code></code></pre>
+<UL>
+The button widget with the "Cancel" label.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>dir</B></I>
+Class: <B>TixComboBox</B></I>
+</code></code></code></pre>
+<UL>
+The ComboBox subwidget under the "Directories" heading.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>dirlist</B></I>
+Class: <B>TixDirList</B></I>
+</code></code></code></pre>
+<UL>
+The DirList subwidget that shows the hierarchical list of directories.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>file</B></I>
+Class: <B>TixComboBox</B></I>
+</code></code></code></pre>
+<UL>
+The ComboBox subwidget under the "Files" heading.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>filelist</B></I>
+Class: <B>TixScrolledListBox</B></I>
+</code></code></code></pre>
+<UL>
+The ScrolledListBox subwidget that shows the list of filenames.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>hidden</B></I>
+Class: <B>Checkbutton</B></I>
+</code></code></code></pre>
+<UL>
+The checkbutton widget with the "Show Hidden Files" label.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>ok</B></I>
+Class: <B>Button</B></I>
+</code></code></code></pre>
+<UL>
+The button widget with the "OK" label.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>types</B></I>
+Class: <B>TixComboBox</B></I>
+</code></code></code></pre>
+<UL>
+The ComboBox subwidget under the "List Files of Type" heading.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixExFileSelectBox</B></I> command creates a new window (given by
+the <I>pathName</I></B> argument) and makes it into a
+ExFileSelectBox widget. Additional options, described above,
+may be specified on the command line or in the option database to
+configure aspects of the ExFileSelectBox such as its cursor
+and relief.
+
+The ExFileSelectBox widget is usually embedded in a
+tixExFileSelectDialog widget. It provides an convenient method for the
+user to select files. The style of the ExFileSelectBox widget is very
+similar to the standard file dialog in MS Windows 3.1.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixExFileSelectBox</B></I> command creates a new Tcl command whose
+window. This command may be used to invoke various operations on the
+widget. It has the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+<I>arg</I></B>s determine the exact behavior of the command. The following
+commands are possible for ExFileSelectBox widgets:
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixExFileSelectBox</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixExFileSelectBox</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>filter</B></I>
+</I></B>
+<DD> Forces the ExFileSelectBox widget to re-filter all the filenames
+according to the <B>-pattern</B></I> option.
+</DL>
+<DL>
+<DT> <I>pathName <B>invoke</B></I>
+</I></B>
+<DD> Forces the ExFileSelectBox widget to perform actions as if the user
+has pressed the "OK" button.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+</DL>
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:23 EST 1997 </i> ---
+<i>Serial 853731298</i>
diff --git a/tix/man/EFileBox.n b/tix/man/EFileBox.n
new file mode 100644
index 00000000000..9087fc9639a
--- /dev/null
+++ b/tix/man/EFileBox.n
@@ -0,0 +1,376 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixExFileSelectBox tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixExFileSelectBox \- Create and manipulate tixExFileSelectBox widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixExFileSelectBox\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+The \fBTixExFileSelectBox\fR class does not have a super-class.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+\fBTixExFileSelectBox\fR supports all the standard options of a frame
+widget. See the \fBoptions(n)\fR manual entry for details on the
+standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBbrowseCmd\fR
+Class: \fBBrowseCmd\fR
+Switch: \fB\-browsecmd\fR
+.fi
+.IP
+Specifies a command to call whenever the user browses on a filename in
+the file listbox (usually by single-clicking on the filename). The command
+is called with one argument, the complete pathname of the file.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Switch: \fB\-command\fR
+.fi
+.IP
+Specifies the command to be called when the user chooses on a filename
+the file listbox (usually by double-clicking on the filename). The command
+is called with one argument, the complete pathname of the file.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdialog\fR
+Class: \fBDialog\fR
+Switch: \fB\-dialog\fR
+.fi
+.IP
+Specifies a dialog box which contains this ExFileSelectBox widget. The
+dialog box must be a widget of the class TixShell or its
+descendant classes. \fIThis is an internal option and should not be used
+by application programmers.\fR
+'----------END
+'----------BEGIN
+.LP
+.nf
+Name: \fBdircmd\fR
+Class: \fBDirCmd\fR
+Switch: \fB\-dircmd\fR
+.fi
+.IP
+Specifies the TCL command to be called when a file listing is needed
+for a particular directory. If this option is not specified, by
+default the ExFileSelectBox widget will attempt to read the directory
+as a Unix directory. On special occasions, the application programmer
+may want to supply a special method for reading directories: for
+example, when he needs to list remote files. In this case, the
+\fB\-dircmd\fR option can be used. The specified command accepts three
+arguments: the first is the name of the directory to be listed; the
+second is a list of file patterns, the third is a Boolean value
+indicating whether hidden files should be listed. This command returns
+a list of names of the files of this directory which match with the
+file patterns.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdirectory\fR
+Class: \fBDirectory\fR
+Switch: \fB\-directory\fR
+Alias: \fB\-dir\fR
+.fi
+.IP
+Specifies the current directory whose files and sub-directories are
+displayed in the ExFileSelectBox.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdisableCallback\fR
+Class: \fBDisableCallback\fR
+Switch: \fB\-disablecallback\fR
+.fi
+.IP
+A boolean value indicating whether callbacks should be disabled. When
+set to true, the TCL command specified by the \fB\-command\fR option
+is not executed when the \fB\-value\fR of the ExFileSelectBox
+widget changes.
+'----------END
+'
+'----------BEGIN
+'
+.LP
+.nf
+Name: \fBfileTypes\fR
+Class: \fBFileTypes\fR
+Switch: \fB\-filetypes\fR
+.fi
+.IP
+Specifies the file types that can be selected from the "List Files of
+Type:" ComboBox subwidget. The value of this option must be a TCL
+list; each item of this list must in turn be a list of two elements.
+The first element is a list of file patterns. The second element is a
+string that describe these file patterns. For example:
+.nf
+ tixExFileSelectBox .box -filetypes {
+ {{*} {All files}}
+ {{*.txt} {Text files}}
+ {{*.c *.h} {C source files}}
+ }
+.fi
+'----------END
+'
+'----------BEGIN
+'
+.LP
+.nf
+Name: \fBshowHidden\fR
+Class: \fBShowHidden\fR
+Switch: \fB\-showhidden\fR
+.fi
+.IP
+Specifies whether hidden directories should be shown. By default, a
+directory name starting with a period "\." is considered as a hidden
+directory.
+'----------END
+'
+'----------BEGIN
+'
+.LP
+.nf
+Name: \fBpattern\fR
+Class: \fBPattern\fR
+Switch: \fB\-pattern\fR
+.fi
+.IP
+Specifies whether the file pattern(s) to match with the files in the
+current directory. One or more file patterns can be given at the same
+time. For example, {*\.c *\.h} will match all files that have either the
+".h" or ".c" extensions.
+'----------END
+'
+'
+'----------END
+'
+.LP
+.nf
+Name: \fBvalue\fR
+Class: \fBValue\fR
+Switch: \fB\-value\fR
+Alias: \fB\-selection\fR
+.fi
+.IP
+Specifies the name of the filename currently selected by the user.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'----------BEGIN
+.LP
+.nf
+Name: \fBcancel\fR
+Class: \fBButton\fR
+.fi
+.IP
+The button widget with the "Cancel" label.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdir\fR
+Class: \fBTixComboBox\fR
+.fi
+.IP
+The ComboBox subwidget under the "Directories" heading.
+'----------END
+'----------BEGIN
+.LP
+.nf
+Name: \fBdirlist\fR
+Class: \fBTixDirList\fR
+.fi
+.IP
+The DirList subwidget that shows the hierarchical list of directories.
+'----------END
+'----------BEGIN
+.LP
+.nf
+Name: \fBfile\fR
+Class: \fBTixComboBox\fR
+.fi
+.IP
+The ComboBox subwidget under the "Files" heading.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBfilelist\fR
+Class: \fBTixScrolledListBox\fR
+.fi
+.IP
+The ScrolledListBox subwidget that shows the list of filenames.
+'----------END
+'----------BEGIN
+.LP
+.nf
+Name: \fBhidden\fR
+Class: \fBCheckbutton\fR
+.fi
+.IP
+The checkbutton widget with the "Show Hidden Files" label.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBok\fR
+Class: \fBButton\fR
+.fi
+.IP
+The button widget with the "OK" label.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBtypes\fR
+Class: \fBTixComboBox\fR
+.fi
+.IP
+The ComboBox subwidget under the "List Files of Type" heading.
+'----------END
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixExFileSelectBox\fR command creates a new window (given by
+the \fIpathName\fR argument) and makes it into a
+ExFileSelectBox widget. Additional options, described above,
+may be specified on the command line or in the option database to
+configure aspects of the ExFileSelectBox such as its cursor
+and relief.
+
+The ExFileSelectBox widget is usually embedded in a
+tixExFileSelectDialog widget. It provides an convenient method for the
+user to select files. The style of the ExFileSelectBox widget is very
+similar to the standard file dialog in MS Windows 3.1.
+'
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixExFileSelectBox\fR command creates a new Tcl command whose
+name is the same as the path name of the ExFileSelectBox's
+window. This command may be used to invoke various operations on the
+widget. It has the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+ExFileSelectBox widget's path name. \fIOption\fR and the
+\fIarg\fRs determine the exact behavior of the command. The following
+commands are possible for ExFileSelectBox widgets:
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixExFileSelectBox\fR command.
+'
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixExFileSelectBox\fR command.
+'
+'
+.TP
+\fIpathName \fBfilter\fR
+'
+Forces the ExFileSelectBox widget to re-filter all the filenames
+according to the \fB\-pattern\fR option.
+'
+.TP
+\fIpathName \fBinvoke\fR
+'
+Forces the ExFileSelectBox widget to perform actions as if the user
+has pressed the "OK" button.
+'
+.TP
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+'
+'
+'
+'----------------------------------------------------------------------
+'.SH BINDINGS
+'.PP
+'
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/EFileDlg.html b/tix/man/EFileDlg.html
new file mode 100644
index 00000000000..ea1e7ab34c9
--- /dev/null
+++ b/tix/man/EFileDlg.html
@@ -0,0 +1,106 @@
+
+
+
+<TITLE>tixExFileSelectDialog - Create and manipulate tixExFileSelectDialog widgets</TITLE>
+<Center><H2>tixExFileSelectDialog - Create and manipulate tixExFileSelectDialog widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixExFileSelectDialog<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+The <B>TixExFileSelectDialog</B></I> class does not have a super-class.
+</pre><H3>STANDARD OPTIONS</H3>
+<B>TixExFileSelectDialog</B></I> supports all the standard options of a frame
+widget. See the <B>options(n)</B></I> manual entry for details on the
+standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>command</B></I>
+Class: <B>Command</B></I>
+Switch: <B>-command</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the command to be called when the user chooses on a filename
+(usually by selecting the filename and clicking on the "OK" button").
+The command is called with one argument, the complete pathname of the
+file.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>fsbox</B></I>
+Class: <B>TixExFileSelectBox</B></I>
+</code></code></code></pre>
+<UL>
+The ExFileSelectBox subwidget embedded inside the ExFileSelectDialog.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixExFileSelectDialog</B></I> command creates a new window (given by
+the <I>pathName</I></B> argument) and makes it into a ExFileSelectDialog
+widget. Additional options, described above, may be specified on the
+command line or in the option database to configure aspects of the
+ExFileSelectDialog such as its cursor and relief.
+
+The ExFileSelectDialog widget provides an convenient method for the
+user to select files. The style of the ExFileSelectDialog widget is
+very similar to the standard file dialog in MS Windows 3.1.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixExFileSelectDialog</B></I> command creates a new Tcl command whose
+window. This command may be used to invoke various operations on the
+widget. It has the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+<I>arg</I></B>s determine the exact behavior of the command. The following
+commands are possible for ExFileSelectDialog widgets:
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixExFileSelectDialog</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixExFileSelectDialog</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>popdown</B></I>
+</I></B>
+<DD> Withdraws the ExFileSelectDialog from the screen.
+</DL>
+<DL>
+<DT> <I>pathName <B>popup</B></I>
+</I></B>
+<DD> Pops up the ExFileSelectDialog on the screen.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I>name ?args?</I></B>
+</I></B>
+<DD> When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+</DL>
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:23 EST 1997 </i> ---
+<i>Serial 853731298</i>
diff --git a/tix/man/EFileDlg.n b/tix/man/EFileDlg.n
new file mode 100644
index 00000000000..85e23d32e0e
--- /dev/null
+++ b/tix/man/EFileDlg.n
@@ -0,0 +1,164 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixExFileSelectDialog tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixExFileSelectDialog \- Create and manipulate tixExFileSelectDialog widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixExFileSelectDialog\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+The \fBTixExFileSelectDialog\fR class does not have a super-class.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+\fBTixExFileSelectDialog\fR supports all the standard options of a frame
+widget. See the \fBoptions(n)\fR manual entry for details on the
+standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Switch: \fB\-command\fR
+.fi
+.IP
+Specifies the command to be called when the user chooses on a filename
+(usually by selecting the filename and clicking on the "OK" button").
+The command is called with one argument, the complete pathname of the
+file.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'----------BEGIN
+.LP
+.nf
+Name: \fBfsbox\fR
+Class: \fBTixExFileSelectBox\fR
+.fi
+.IP
+The ExFileSelectBox subwidget embedded inside the ExFileSelectDialog.
+'----------END
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixExFileSelectDialog\fR command creates a new window (given by
+the \fIpathName\fR argument) and makes it into a ExFileSelectDialog
+widget. Additional options, described above, may be specified on the
+command line or in the option database to configure aspects of the
+ExFileSelectDialog such as its cursor and relief.
+
+The ExFileSelectDialog widget provides an convenient method for the
+user to select files. The style of the ExFileSelectDialog widget is
+very similar to the standard file dialog in MS Windows 3.1.
+'
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixExFileSelectDialog\fR command creates a new Tcl command whose
+name is the same as the path name of the ExFileSelectDialog's
+window. This command may be used to invoke various operations on the
+widget. It has the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+ExFileSelectDialog widget's path name. \fIOption\fR and the
+\fIarg\fRs determine the exact behavior of the command. The following
+commands are possible for ExFileSelectDialog widgets:
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixExFileSelectDialog\fR command.
+'
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixExFileSelectDialog\fR command.
+'
+'
+.TP
+\fIpathName \fBpopdown\fR
+'
+Withdraws the ExFileSelectDialog from the screen.
+'
+.TP
+\fIpathName \fBpopup\fR
+'
+Pops up the ExFileSelectDialog on the screen.
+'
+'
+.TP
+\fIpathName \fBsubwidget \fIname ?args?\fR
+'
+When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+'
+'
+'
+'----------------------------------------------------------------------
+'.SH BINDINGS
+'.PP
+'
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/FileBox.html b/tix/man/FileBox.html
new file mode 100644
index 00000000000..0214542e4e3
--- /dev/null
+++ b/tix/man/FileBox.html
@@ -0,0 +1,216 @@
+
+
+
+<TITLE>tixFileSelectBox - Create and manipulate Tix FileSelectBox widgets</TITLE>
+<Center><H2>tixFileSelectBox - Create and manipulate Tix FileSelectBox widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixFileSelectBox<I> <I>pathName ?<I>options</I></B>?
+</pre><H3>STANDARD OPTIONS</H3>
+The FileSelectBox widget supports all the standard options of a frame
+widget. See the <B>options(n)</B></I> manual entry for details on the standard
+options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>browsecmd</B></I>
+Class: <B>browseCmd</B></I>
+Switch: <B>-browsecmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the command to execute when the user browses through the
+files. By default, if the <B>-browsecmd</B></I> is specified, the browse
+command will be executed when the user clicks on a filename in the
+<I>Files</I></B> listbox.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>command</B></I>
+Class: <B>Command</B></I>
+Switch: <B>-command</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the command to execute when the FileSelectBox is
+invoked. This command is executed with one parameter : the filename
+selected by the user.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>directory</B></I>
+Class: <B>Directory</B></I>
+Switch: <B>-directory</B></I>
+Alias: <B>-dir</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the directory to look for files. By default this will be the
+current working directory of the program and will be changed as the
+user browses through the directories.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>disableCallback</B></I>
+Class: <B>DisableCallback</B></I>
+Switch: <B>-disablecallback</B></I>
+</code></code></code></pre>
+<UL>
+A boolean value indicating whether callbacks should be disabled. When
+set to true, the TCL command specified by the <B>-command</B></I> option
+is not executed when the <B>-value</B></I> of the ExFileSelectBox
+widget changes.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>pattern</B></I>
+Class: <B>Pattern</B></I>
+Switch: <B>-pattern</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the matching pattern of the file names that should be listed in
+the <I>Files</I></B> listbox. For example "*.c" matches all the filenames that
+end with ".c". If this option is set to the empty string, the default
+pattern "*" will be used.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>value</B></I>
+Class: <B>Value</B></I>
+Switch: <B>-value</B></I>
+Alias: <B>-selection</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the name of the filename currently selected by the user.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>dirlist</B></I>
+Class: <B>TixScrolledListBox</B></I>
+</code></code></code></pre>
+<UL>
+The scrolled listbox that shows the directories.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>filelist</B></I>
+Class: <B>TixScrolledListBox</B></I>
+</code></code></code></pre>
+<UL>
+The scrolled listbox that shows the files.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>filter</B></I>
+Class: <B>TixComboBox</B></I>
+</code></code></code></pre>
+<UL>
+The ComboBox listbox that shows the filter string.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>selection</B></I>
+Class: <B>TixComboBox</B></I>
+</code></code></code></pre>
+<UL>
+The ComboBox listbox that shows the file selection.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixFileSelectBox</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a FileSelectBox widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+FileSelectBox such as its cursor and relief.
+<P>
+The FileSelectBox is similar to the standard Motif(TM) file-selection
+box. It is generally used for the user to choose a file. FileSelectBox
+stores the files mostly recently selected into a ComboBox widget so
+that they can be quickly selected again. The <B>tixFileSelectDialog</B></I>
+widget is a combination of the FileSelectBox widget and a dialog
+widget.
+</pre><H3>WIDGET COMMAND</H3>
+<P>
+The <B>tixFileSelectBox</B></I> command creates a new Tcl command whose
+This command may be used to invoke various operations on the widget.
+It has the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+<I>arg</I></B>s determine the exact behavior of the command. The following
+commands are possible for FileSelectBox widgets:
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixFileSelectBox</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixFileSelectBox</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>filter</B></I>
+</I></B>
+<DD> Updates the files listed in the FileSelectBox according to the
+filtering pattern sepcified in the <B>filter</B></I> subwidget.
+</DL>
+<DL>
+<DT> <I>pathName <B>invoke</B></I>
+</I></B>
+<DD> Execute the command specified by the <B>-command</B></I> option with the
+filename stored in the <B>selection</B></I> subwidget.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+</DL>
+</pre><H3>DEFAULT BINDINGS</H3>
+TIX automatically creates class bindings for FileSelectBoxes that give them
+the following default behavior:
+<UL>
+[1] <BR>
+Mouse button 1 in the <I>Directory</I></B> listbox will change the filter
+string to the selected directory.
+</UL>
+<UL>
+[2] <BR>
+Mouse button 1 in the <I>Files</I></B> listbox will change the filename
+that appears in the <I>Selection</I></B> entry. It will also trigger the
+<B>-browsecmd</B></I> if the option has been specified.
+</UL>
+<UL>
+[3] <BR>
+The current directory will be changed by (1) double clicking the
+<I>Directory</I></B> listbox or (2) invoking the <I>Filter</I></B> ComboBox.
+Please refer to the man page of <B>tixComboBox</B></I> for the default
+bindings of the ComboBoxes and how they can be invoked.
+</UL>
+<UL>
+[4] <BR>
+The command specified by the option -command will be invoked by (1)
+double clicking the <I>Files</I></B> listbox or (2) invoking
+<I>Selection</I></B> ComboBox.
+</UL>
+</pre><H3>KEYWORDS</H3>
+tixFileSelectBox, tixComboBox, tixFileSelectDialog, Tix(n),
+<hr><i>Last modified Sun Jan 19 22:34:24 EST 1997 </i> ---
+<i>Serial 853731298</i>
diff --git a/tix/man/FileBox.n b/tix/man/FileBox.n
new file mode 100644
index 00000000000..53787f1807e
--- /dev/null
+++ b/tix/man/FileBox.n
@@ -0,0 +1,259 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixFileSelectBox tix 4.0
+.BS
+'
+'
+.SH NAME
+tixFileSelectBox \- Create and manipulate Tix FileSelectBox widgets
+'
+'
+'
+.SH SYNOPSIS
+\fBtixFileSelectBox\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+The FileSelectBox widget supports all the standard options of a frame
+widget. See the \fBoptions(n)\fR manual entry for details on the standard
+options.
+'
+'
+'
+.SH "WIDGET-SPECIFIC OPTIONS"
+'----------
+.LP
+.nf
+Name: \fBbrowsecmd\fR
+Class: \fBbrowseCmd\fR
+Switch: \fB\-browsecmd\fR
+.fi
+.IP
+Specifies the command to execute when the user browses through the
+files. By default, if the \fB\-browsecmd\fR is specified, the browse
+command will be executed when the user clicks on a filename in the
+\fIFiles\fR listbox.
+'----------
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Switch: \fB\-command\fR
+.fi
+.IP
+Specifies the command to execute when the FileSelectBox is
+invoked. This command is executed with one parameter : the filename
+selected by the user.
+'----------
+.LP
+.nf
+Name: \fBdirectory\fR
+Class: \fBDirectory\fR
+Switch: \fB\-directory\fR
+Alias: \fB\-dir\fR
+.fi
+.IP
+Specifies the directory to look for files. By default this will be the
+current working directory of the program and will be changed as the
+user browses through the directories.
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdisableCallback\fR
+Class: \fBDisableCallback\fR
+Switch: \fB\-disablecallback\fR
+.fi
+.IP
+A boolean value indicating whether callbacks should be disabled. When
+set to true, the TCL command specified by the \fB\-command\fR option
+is not executed when the \fB\-value\fR of the ExFileSelectBox
+widget changes.
+'----------END
+'----------
+.LP
+.nf
+Name: \fBpattern\fR
+Class: \fBPattern\fR
+Switch: \fB\-pattern\fR
+.fi
+.IP
+Specifies the matching pattern of the file names that should be listed in
+the \fIFiles\fR listbox. For example "*.c" matches all the filenames that
+end with ".c". If this option is set to the empty string, the default
+pattern "*" will be used.
+'----------
+.LP
+.nf
+Name: \fBvalue\fR
+Class: \fBValue\fR
+Switch: \fB\-value\fR
+Alias: \fB\-selection\fR
+.fi
+.IP
+Specifies the name of the filename currently selected by the user.
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdirlist\fR
+Class: \fBTixScrolledListBox\fR
+.fi
+.IP
+The scrolled listbox that shows the directories.
+'----------END
+'----------BEGIN
+.LP
+.nf
+Name: \fBfilelist\fR
+Class: \fBTixScrolledListBox\fR
+.fi
+.IP
+The scrolled listbox that shows the files.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBfilter\fR
+Class: \fBTixComboBox\fR
+.fi
+.IP
+The ComboBox listbox that shows the filter string.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBselection\fR
+Class: \fBTixComboBox\fR
+.fi
+.IP
+The ComboBox listbox that shows the file selection.
+'----------END
+'
+.BE
+'======================
+'
+'
+'
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixFileSelectBox\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a FileSelectBox widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+FileSelectBox such as its cursor and relief.
+.PP
+The FileSelectBox is similar to the standard Motif(TM) file-selection
+box. It is generally used for the user to choose a file. FileSelectBox
+stores the files mostly recently selected into a ComboBox widget so
+that they can be quickly selected again. The \fBtixFileSelectDialog\fR
+widget is a combination of the FileSelectBox widget and a dialog
+widget.
+'
+.SH "WIDGET COMMAND"
+.PP
+'
+The \fBtixFileSelectBox\fR command creates a new Tcl command whose
+name is the same as the path name of the FileSelectBox's window.
+This command may be used to invoke various operations on the widget.
+It has the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+FileSelectBox widget's path name. \fIOption\fR and the
+\fIarg\fRs determine the exact behavior of the command. The following
+commands are possible for FileSelectBox widgets:
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixFileSelectBox\fR command.
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixFileSelectBox\fR command.
+'
+.TP
+'
+\fIpathName \fBfilter\fR
+'
+Updates the files listed in the FileSelectBox according to the
+filtering pattern sepcified in the \fBfilter\fR subwidget.
+.TP
+'
+\fIpathName \fBinvoke\fR
+Execute the command specified by the \fB\-command\fR option with the
+filename stored in the \fBselection\fR subwidget.
+'
+.TP
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+'
+'
+.SH "DEFAULT BINDINGS"
+TIX automatically creates class bindings for FileSelectBoxes that give them
+the following default behavior:
+.IP [1]
+Mouse button 1 in the \fIDirectory\fR listbox will change the filter
+string to the selected directory.
+.IP [2]
+Mouse button 1 in the \fIFiles\fR listbox will change the filename
+that appears in the \fISelection\fR entry. It will also trigger the
+\fB\-browsecmd\fR if the option has been specified.
+.IP [3]
+The current directory will be changed by (1) double clicking the
+\fIDirectory\fR listbox or (2) invoking the \fIFilter\fR ComboBox.
+Please refer to the man page of \fBtixComboBox\fR for the default
+bindings of the ComboBoxes and how they can be invoked.
+.IP [4]
+The command specified by the option -command will be invoked by (1)
+double clicking the \fIFiles\fR listbox or (2) invoking
+\fISelection\fR ComboBox.
+'
+'
+.SH KEYWORDS
+tixFileSelectBox, tixComboBox, tixFileSelectDialog, Tix(n),
diff --git a/tix/man/FileDlg.html b/tix/man/FileDlg.html
new file mode 100644
index 00000000000..eb62ebf0407
--- /dev/null
+++ b/tix/man/FileDlg.html
@@ -0,0 +1,115 @@
+
+
+
+<TITLE>tixFileSelectDialog - Create and manipulate tixFileSelectDialog widgets</TITLE>
+<Center><H2>tixFileSelectDialog - Create and manipulate tixFileSelectDialog widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixFileSelectDialog<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+The <B>TixFileSelectDialog</B></I> class does not have a super-class.
+</pre><H3>STANDARD OPTIONS</H3>
+<B>TixFileSelectDialog</B></I> supports all the standard options of a frame
+widget. See the <B>options(n)</B></I> manual entry for details on the
+standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>command</B></I>
+Class: <B>Command</B></I>
+Switch: <B>-command</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the command to be called when the user chooses on a filename
+(usually by selecting the filename and clicking on the "OK" button").
+The command is called with one argument, the complete pathname of the
+file.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>btns</B></I>
+Class: <B>TixStdButtonBox</B></I>
+</code></code></code></pre>
+<UL>
+The StdButtonBox subwidget at the bottom of FileSelectDialog. It
+contains the "OK", "Filter, "Cancel" and "Help" buttons.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>fsbox</B></I>
+Class: <B>TixFileSelectBox</B></I>
+</code></code></code></pre>
+<UL>
+The FileSelectBox subwidget at the top of the FileSelectDialog.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixFileSelectDialog</B></I> command creates a new window (given by
+the <I>pathName</I></B> argument) and makes it into a FileSelectDialog
+widget. Additional options, described above, may be specified on the
+command line or in the option database to configure aspects of the
+FileSelectDialog such as its cursor and relief.
+<P>
+The FileSelectDialog widget provides an convenient method for the user
+to select files. The FileSelectBox is similar to the standard
+Motif(TM) file-selection box.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixFileSelectDialog</B></I> command creates a new Tcl command whose
+window. This command may be used to invoke various operations on the
+widget. It has the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+<I>arg</I></B>s determine the exact behavior of the command. The following
+commands are possible for FileSelectDialog widgets:
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixFileSelectDialog</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixFileSelectDialog</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>popdown</B></I>
+</I></B>
+<DD> Withdraws the FileSelectDialog from the screen.
+</DL>
+<DL>
+<DT> <I>pathName <B>popup</B></I>
+</I></B>
+<DD> Pops up the FileSelectDialog on the screen.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I>name ?args?</I></B>
+</I></B>
+<DD> When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+</DL>
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:24 EST 1997 </i> ---
+<i>Serial 853731298</i>
diff --git a/tix/man/FileDlg.n b/tix/man/FileDlg.n
new file mode 100644
index 00000000000..135af3902a0
--- /dev/null
+++ b/tix/man/FileDlg.n
@@ -0,0 +1,174 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixFileSelectDialog tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixFileSelectDialog \- Create and manipulate tixFileSelectDialog widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixFileSelectDialog\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+The \fBTixFileSelectDialog\fR class does not have a super-class.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+\fBTixFileSelectDialog\fR supports all the standard options of a frame
+widget. See the \fBoptions(n)\fR manual entry for details on the
+standard options.
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Switch: \fB\-command\fR
+.fi
+.IP
+Specifies the command to be called when the user chooses on a filename
+(usually by selecting the filename and clicking on the "OK" button").
+The command is called with one argument, the complete pathname of the
+file.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'----------BEGIN
+.LP
+.nf
+Name: \fBbtns\fR
+Class: \fBTixStdButtonBox\fR
+.fi
+.IP
+The StdButtonBox subwidget at the bottom of FileSelectDialog. It
+contains the "OK", "Filter, "Cancel" and "Help" buttons.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBfsbox\fR
+Class: \fBTixFileSelectBox\fR
+.fi
+.IP
+The FileSelectBox subwidget at the top of the FileSelectDialog.
+'----------END
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixFileSelectDialog\fR command creates a new window (given by
+the \fIpathName\fR argument) and makes it into a FileSelectDialog
+widget. Additional options, described above, may be specified on the
+command line or in the option database to configure aspects of the
+FileSelectDialog such as its cursor and relief.
+.PP
+The FileSelectDialog widget provides an convenient method for the user
+to select files. The FileSelectBox is similar to the standard
+Motif(TM) file-selection box.
+'
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixFileSelectDialog\fR command creates a new Tcl command whose
+name is the same as the path name of the FileSelectDialog's
+window. This command may be used to invoke various operations on the
+widget. It has the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+FileSelectDialog widget's path name. \fIOption\fR and the
+\fIarg\fRs determine the exact behavior of the command. The following
+commands are possible for FileSelectDialog widgets:
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixFileSelectDialog\fR command.
+'
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixFileSelectDialog\fR command.
+'
+'
+.TP
+\fIpathName \fBpopdown\fR
+'
+Withdraws the FileSelectDialog from the screen.
+'
+.TP
+\fIpathName \fBpopup\fR
+'
+Pops up the FileSelectDialog on the screen.
+'
+'
+.TP
+\fIpathName \fBsubwidget \fIname ?args?\fR
+'
+When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+'
+'
+'
+'----------------------------------------------------------------------
+'.SH BINDINGS
+'.PP
+'
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/FileEnt.html b/tix/man/FileEnt.html
new file mode 100644
index 00000000000..eb0cc554805
--- /dev/null
+++ b/tix/man/FileEnt.html
@@ -0,0 +1,262 @@
+
+
+
+<TITLE>tixFileEntry - Create and manipulate tixFileEntry widgets</TITLE>
+<Center><H2>tixFileEntry - Create and manipulate tixFileEntry widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixFileEntry<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+The <B>TixFileEntry</B></I> class is derived from the <B>TixLabelWidget</B></I>
+class and inherits all the commands, options and
+subwidgets of its super-class.
+</pre><H3>STANDARD OPTIONS</H3>
+The FileEntry widget supports all the standard options of a frame
+widget. See the <B>options(n)</B></I> manual entry for details on the
+standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>activateCmd</B></I>
+Class: <B>ActivateCmd</B></I>
+Switch: <B>-activatecmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the command to be called when the user activates the
+<B>button</B></I> subwidget. This command is called before the file dialog
+is popped up and can be used to customize the file dialog (which may
+be shared by several FileEnt widget).
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>command</B></I>
+Class: <B>Command</B></I>
+Switch: <B>-command</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the command to be called when the <B>-value</B></I> option of
+the FileEntry is changed. This usually happens when the user inputs a
+filename into the entry subwidget and hits the &lt;Return&gt; key. The
+command will be called with one arguments -- the new value of the
+FileEntry widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>dialogType</B></I>
+Class: <B>DialogType</B></I>
+Switch: <B>-dialogtype</B></I>
+</code></code></code></pre>
+<UL>
+Specifies which type of file selection dialog should be popped up when
+the user invokes the <B>button</B></I> subwidget. Current only two values
+are valid: <B>tixFileSelectDialog</B></I> or <B>tixExFileSelectDialog</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>disableCallback</B></I>
+Class: <B>DisableCallback</B></I>
+Switch: <B>-disablecallback</B></I>
+</code></code></code></pre>
+<UL>
+A boolean value indicating whether callbacks should be disabled. When
+set to true, the TCL command specified by the <B>-command</B></I> option
+is not executed when the <B>-value</B></I> of the FileEntry widget
+changes.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>disableForeground</B></I>
+Class: <B>DisableForeground</B></I>
+Switch: <B>-disableforeground</B></I>
+</code></code></code></pre>
+<UL>
+The foreground color to use for of the entry subwidget when the
+FileEntry widget is disabled.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>fileBitmap</B></I>
+Class: <B>FileBitmap</B></I>
+Switch: <B>-filebitmap</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the bitmap to display in side the <B>button</B></I> subwidget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>label</B></I>
+Class: <B>Label</B></I>
+Switch: <B>-label</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the string to display as the label of this FileEntry widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>labelSide</B></I>
+Class: <B>LabelSide</B></I>
+Switch: <B>-labelside</B></I>
+</code></code></code></pre>
+<UL>
+Specifies where the label should be displayed relative to the entry
+subwidget. Valid options are: <B>top</B></I>, <B>left</B></I>, <B>right</B></I>,
+<B>bottom</B></I>, <B>none</B></I> or <B>acrosstop</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>selectMode</B></I>
+Class: <B>SelectMode</B></I>
+Switch: <B>-selectmode</B></I>
+</code></code></code></pre>
+<UL>
+Specifies how the FileEntry widget should react to \fC&lt;KeyPress&gt;</B></I>
+events. When set to "immediate", any user keyboard inputs will
+immediately change the <B>-value</B></I> option. When set to "normal", the
+user keyboard inputs will be copied to the <B>-value</B></I> option only
+if the\fC &lt;Return&gt;</B></I> key is pressed or the keyboard focus is
+changed. The use of the immediate mode is discouraged. For effective
+use of the FileEntry widget, one should use the normal mode together
+with the <B>update</B></I> widget command (see below).
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>state</B></I>
+Class: <B>State</B></I>
+Switch: <B>-state</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the whether the FileEntry widget is normal or disabled. Only
+the values "normal" and "disabled" are recognized.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>validateCmd</B></I>
+Class: <B>ValidateCmd</B></I>
+Switch: <B>-validatecmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a TCL command to be called when the -value of the
+FileEntry widget is about to change. This command is called
+with one parameter -- the new <B>-value</B></I> entered by the user. This
+command is to validate this new value by returning a value it deems
+valid.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>value</B></I>
+Class: <B>Value</B></I>
+Switch: <B>-value</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the value of the FileEntry.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>variable</B></I>
+Class: <B>Variable</B></I>
+Switch: <B>-variable</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the global variable in which the value of the FileEntry
+should be stored. The value of the FileEntry will be automatically
+updated when this variable is changed.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>button</B></I>
+Class: <B>Button</B></I>
+</code></code></code></pre>
+<UL>
+The button subwidget next to the entry subwidget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>entry</B></I>
+Class: <B>Entry</B></I>
+</code></code></code></pre>
+<UL>
+The entry subwidget in which the user can type in a filename.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixFileEntry</B></I> command creates a new window (given by
+the <I>pathName</I></B> argument) and makes it into a FileEntry
+widget. Additional options, described above, may be specified on the
+command line or in the option database to configure aspects of the
+FileEntry such as its cursor and relief.
+<P>
+The FileEntry widget can be used to input a filename. The user can
+type in the filename manually. Alternatively, the user can press the
+button widget that sits next to the entry, which will bring up a file
+selection dialog of the type specified by the <B>-dialogtype</B></I> option.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixFileEntry</B></I> command creates a new Tcl command whose
+window. This command may be used to invoke various operations on the
+widget. It has the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+<I>arg</I></B>s determine the exact behavior of the command. The following
+commands are possible for FileEntry widgets:
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixFileEntry</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixFileEntry</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>invoke</B></I>
+</I></B>
+<DD> Forces the FileEntry widget to act as if the user has pressed the
+&lt;return&gt; key inside the entry subwidget.
+</DL>
+<DL>
+<DT> <I>pathName <B>filedialog</B></I> <I>?args?</I></B>
+</I></B>
+<DD> When no additional arguments are given, this command returns the
+pathname of the file dialog box associated with this FileEnt
+widget. When additional arguments are given, the widget command of the
+file dialog will be called with these arguments.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I>name ?args?</I></B>
+</I></B>
+<DD> When no options are given, this command returns the pathname of the
+subwidget of the specified name. When options are given, the widget
+command of the specified subwidget will be called with these options.
+</DL>
+<DL>
+<DT> <I>pathName <B>update</B></I>
+</I></B>
+<DD> If the user has modified the entry using keyboard inputs, the update
+command will <B>update</B></I> the <B>-value</B></I> of this FileEntry
+to "normal", one should call the <B>update</B></I> command on this widget
+before examining its <B>-value</B></I> option. This command has no effect
+in if the <B>-selectmode</B></I> option is set to "immediate".
+</DL>
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:25 EST 1997 </i> ---
+<i>Serial 853731299</i>
diff --git a/tix/man/FileEnt.n b/tix/man/FileEnt.n
new file mode 100644
index 00000000000..06a2c08de74
--- /dev/null
+++ b/tix/man/FileEnt.n
@@ -0,0 +1,345 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixFileEntry tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixFileEntry \- Create and manipulate tixFileEntry widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixFileEntry\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+The \fBTixFileEntry\fR class is derived from the \fBTixLabelWidget\fR
+class and inherits all the commands, options and
+subwidgets of its super-class.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+The FileEntry widget supports all the standard options of a frame
+widget. See the \fBoptions(n)\fR manual entry for details on the
+standard options.
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBactivateCmd\fR
+Class: \fBActivateCmd\fR
+Switch: \fB\-activatecmd\fR
+.fi
+.IP
+Specifies the command to be called when the user activates the
+\fBbutton\fR subwidget. This command is called before the file dialog
+is popped up and can be used to customize the file dialog (which may
+be shared by several FileEnt widget).
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Switch: \fB\-command\fR
+.fi
+.IP
+Specifies the command to be called when the \fB\-value\fR option of
+the FileEntry is changed. This usually happens when the user inputs a
+filename into the entry subwidget and hits the <Return> key. The
+command will be called with one arguments -- the new value of the
+FileEntry widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdialogType\fR
+Class: \fBDialogType\fR
+Switch: \fB\-dialogtype\fR
+.fi
+.IP
+Specifies which type of file selection dialog should be popped up when
+the user invokes the \fBbutton\fR subwidget. Current only two values
+are valid: \fBtixFileSelectDialog\fR or \fBtixExFileSelectDialog\fR.
+'----------END
+'----------BEGIN
+.LP
+.nf
+Name: \fBdisableCallback\fR
+Class: \fBDisableCallback\fR
+Switch: \fB\-disablecallback\fR
+.fi
+.IP
+A boolean value indicating whether callbacks should be disabled. When
+set to true, the TCL command specified by the \fB\-command\fR option
+is not executed when the \fB\-value\fR of the FileEntry widget
+changes.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdisableForeground\fR
+Class: \fBDisableForeground\fR
+Switch: \fB\-disableforeground\fR
+.fi
+.IP
+The foreground color to use for of the entry subwidget when the
+FileEntry widget is disabled.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBfileBitmap\fR
+Class: \fBFileBitmap\fR
+Switch: \fB\-filebitmap\fR
+.fi
+.IP
+Specifies the bitmap to display in side the \fBbutton\fR subwidget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabel\fR
+Class: \fBLabel\fR
+Switch: \fB\-label\fR
+.fi
+.IP
+Specifies the string to display as the label of this FileEntry widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabelSide\fR
+Class: \fBLabelSide\fR
+Switch: \fB\-labelside\fR
+.fi
+.IP
+Specifies where the label should be displayed relative to the entry
+subwidget. Valid options are: \fBtop\fR, \fBleft\fR, \fBright\fR,
+\fBbottom\fR, \fBnone\fR or \fBacrosstop\fR.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBselectMode\fR
+Class: \fBSelectMode\fR
+Switch: \fB\-selectmode\fR
+.fi
+.IP
+Specifies how the FileEntry widget should react to \fC<KeyPress>\fR
+events. When set to "immediate", any user keyboard inputs will
+immediately change the \fB\-value\fR option. When set to "normal", the
+user keyboard inputs will be copied to the \fB\-value\fR option only
+if the\fC <Return>\fR key is pressed or the keyboard focus is
+changed. The use of the immediate mode is discouraged. For effective
+use of the FileEntry widget, one should use the normal mode together
+with the \fBupdate\fR widget command (see below).
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Switch: \fB\-state\fR
+.fi
+.IP
+Specifies the whether the FileEntry widget is normal or disabled. Only
+the values "normal" and "disabled" are recognized.
+'----------END
+''
+'----------BEGIN
+.LP
+.nf
+Name: \fBvalidateCmd\fR
+Class: \fBValidateCmd\fR
+Switch: \fB\-validatecmd\fR
+.fi
+.IP
+Specifies a TCL command to be called when the -value of the
+FileEntry widget is about to change. This command is called
+with one parameter -- the new \fB\-value\fR entered by the user. This
+command is to validate this new value by returning a value it deems
+valid.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvalue\fR
+Class: \fBValue\fR
+Switch: \fB\-value\fR
+.fi
+.IP
+Specifies the value of the FileEntry.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvariable\fR
+Class: \fBVariable\fR
+Switch: \fB\-variable\fR
+.fi
+.IP
+Specifies the global variable in which the value of the FileEntry
+should be stored. The value of the FileEntry will be automatically
+updated when this variable is changed.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'----------BEGIN
+.LP
+.nf
+Name: \fBbutton\fR
+Class: \fBButton\fR
+.fi
+.IP
+The button subwidget next to the entry subwidget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBentry\fR
+Class: \fBEntry\fR
+.fi
+.IP
+The entry subwidget in which the user can type in a filename.
+'----------END
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixFileEntry\fR command creates a new window (given by
+the \fIpathName\fR argument) and makes it into a FileEntry
+widget. Additional options, described above, may be specified on the
+command line or in the option database to configure aspects of the
+FileEntry such as its cursor and relief.
+.PP
+The FileEntry widget can be used to input a filename. The user can
+type in the filename manually. Alternatively, the user can press the
+button widget that sits next to the entry, which will bring up a file
+selection dialog of the type specified by the \fB\-dialogtype\fR option.
+'
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixFileEntry\fR command creates a new Tcl command whose
+name is the same as the path name of the FileEntry's
+window. This command may be used to invoke various operations on the
+widget. It has the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+FileEntry widget's path name. \fIOption\fR and the
+\fIarg\fRs determine the exact behavior of the command. The following
+commands are possible for FileEntry widgets:
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixFileEntry\fR command.
+'
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixFileEntry\fR command.
+'
+'
+.TP
+\fIpathName \fBinvoke\fR
+'
+Forces the FileEntry widget to act as if the user has pressed the
+<return> key inside the entry subwidget.
+'
+.TP
+\fIpathName \fBfiledialog\fR \fI?args?\fR
+'
+When no additional arguments are given, this command returns the
+pathname of the file dialog box associated with this FileEnt
+widget. When additional arguments are given, the widget command of the
+file dialog will be called with these arguments.
+'
+'
+.TP
+\fIpathName \fBsubwidget \fIname ?args?\fR
+'
+When no options are given, this command returns the pathname of the
+subwidget of the specified name. When options are given, the widget
+command of the specified subwidget will be called with these options.
+'
+.TP
+\fIpathName \fBupdate\fR
+'
+If the user has modified the entry using keyboard inputs, the update
+command will \fBupdate\fR the \fB\-value\fR of this FileEntry
+widget. When the FileEntry widget's \fB\-selectmode\fR option is set
+to "normal", one should call the \fBupdate\fR command on this widget
+before examining its \fB\-value\fR option. This command has no effect
+in if the \fB\-selectmode\fR option is set to "immediate".
+'
+'
+'----------------------------------------------------------------------
+'.SH BINDINGS
+'.PP
+'
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/Form.html b/tix/man/Form.html
new file mode 100644
index 00000000000..2303d0c22b3
--- /dev/null
+++ b/tix/man/Form.html
@@ -0,0 +1,419 @@
+
+
+
+<TITLE>tixForm - Geometry manager based on attachment rules</TITLE>
+<Center><H2>tixForm - Geometry manager based on attachment rules</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<P>
+<B>tixForm<I> option arg ?arg ...?</I></B>
+</pre><HR>
+<P>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixForm</B></I> command is used to communicate with the
+<B>tixForm</B></I> Geometry Manager, a geometry manager that arranges the
+geometry of the children in a parent window according to attachment
+rules. The <B>tixForm</B></I> geometry manager is very flexible and
+powerful; it can be used to emulate all the existing features of the
+Tk packer and placer geometry managers (see <B>pack(n)</B></I>,
+<B>place(n)</B></I>).
+The <B>tixForm</B></I> command can have any of several forms,
+depending on the <I>option</I></B> argument:
+<DL>
+<DT> <B>tixForm<I> slave </I></B>?<I>options</I></B>?
+</I></B>
+<DD> If the first argument to <B>tixForm</B></I> is a window name (any value
+<B>tixForm configure</B></I>.
+</DL>
+<DL>
+<DT> <B>tixForm check <I>master</I></B>
+</I></B>
+<DD> This command checks whether there is circular dependency in the
+DEPENDENCY</B></I> below). It returns the Boolean value <B>TRUE</B></I> if it
+discover circular dependency and <B>FALSE</B></I> otherwise.
+</DL>
+<DL>
+<DT> <B>tixForm configure<I> slave </I></B>?<I>-option value ...</I></B>?
+</I></B>
+<DD> Sets or adjusts the attachment values of the slave window
+according to the <I>-option value</I></B> argument pairs.
+</DL>
+<UL>
+<DL>
+<DT> <B>-b</B></I> <I>attachment</I></B>
+</I></B>
+<DD> Abbreviation for the <B>-bottom</B></I> option.
+</DL>
+<DL>
+<DT> <B>-bottom</B></I> <I>attachment</I></B>
+</I></B>
+<DD> Specifies an attachment for the bottom edge of the slave window. The
+attachment must specied according to the section <B>SPECIFYING
+ATTACHMENTS</B></I> below.
+</DL>
+<DL>
+<DT> <B>-bottomspring</B></I> <I>weight</I></B>
+</I></B>
+<DD> Specifies the weight of the spring at the bottom edge of the slave
+window. See the section <B>USING SPRINGS</B></I> below.
+</DL>
+<DL>
+<DT> <B>-bp</B></I> <I>value</I></B>
+</I></B>
+<DD> Abbreviation for the <B>-padbottom</B></I> option.
+</DL>
+<DL>
+<DT> <B>-bs</B></I> <I>weight</I></B>
+</I></B>
+<DD> Abbreviation for the <B>-bottomspring</B></I> option.
+</DL>
+<DL>
+<DT> <B>-fill</B></I> <I>master</I></B>
+</I></B>
+<DD> Specifies the fillings when springs are used for this widget. The
+value must be <B>x</B></I>, <B>y</B></I>, <B>both</B></I> or <B>none</B></I>.
+</DL>
+<DL>
+<DT> <B>-in</B></I> <I>master</I></B>
+</I></B>
+<DD> Places the slave window into the specified master window. If the slave
+was originally in another master window, all attachment values with
+respect to the original master window are discarded. Even if the
+attachment values are the same as in the original master window, they
+need to be specified again. The <B>-in</B></I> flag, when needed, must appear
+as the first flag after the name of the slave. Otherwise an error is
+generated.
+</DL>
+<DL>
+<DT> <B>-l</B></I> <I>attachment</I></B>
+</I></B>
+<DD> Abbreviation for the <B>-left</B></I> option.
+</DL>
+<DL>
+<DT> <B>-left</B></I> <I>attachment</I></B>
+</I></B>
+<DD> Specifies an attachment for the left edge of the slave window. The
+attachment must specied according to the section <B>SPECIFYING
+ATTACHMENTS</B></I> below.
+</DL>
+<DL>
+<DT> <B>-leftspring</B></I> <I>weight</I></B>
+</I></B>
+<DD> Specifies the weight of the spring at the left edge of the slave
+window. See the section <B>USING SPRINGS</B></I> below.
+</DL>
+<DL>
+<DT> <B>-lp</B></I> <I>value</I></B>
+</I></B>
+<DD> Abbreviation for the <B>-padleft</B></I> option.
+</DL>
+<DL>
+<DT> <B>-ls</B></I> <I>weight</I></B>
+</I></B>
+<DD> Abbreviation for the <B>-leftspring</B></I> option.
+</DL>
+<DL>
+<DT> <B>-padbottom</B></I> <I>value</I></B>
+</I></B>
+<DD> Specifies the amount of external padding to leave on the bottom side
+of the slave. The <I>value</I></B> may have any of the forms acceptable to
+<B>Tk_GetPixels(3)</B></I>.
+</DL>
+<DL>
+<DT> <B>-padleft</B></I> <I>value</I></B>
+</I></B>
+<DD> Specifies the amount of external padding to leave on the left side of
+the slave.
+</DL>
+<DL>
+<DT> <B>-padright</B></I> <I>value</I></B>
+</I></B>
+<DD> Specifies the amount of external padding to leave on the right side of
+the slave.
+</DL>
+<DL>
+<DT> <B>-padtop</B></I> <I>value</I></B>
+</I></B>
+<DD> Specifies the amount of external padding to leave on the top side of
+the slave.
+</DL>
+<DL>
+<DT> <B>-padx</B></I> <I>value</I></B>
+</I></B>
+<DD> Specifies the amount of external padding to leave on both the left and
+the right sides of the slave.
+</DL>
+<DL>
+<DT> <B>-pady</B></I> <I>value</I></B>
+</I></B>
+<DD> Specifies the amount of external padding to leave on both the top and
+the bottom sides of the slave.
+</DL>
+<DL>
+<DT> <B>-r</B></I> <I>attachment</I></B>
+</I></B>
+<DD> Abbreviation for the <B>-right</B></I> option.
+</DL>
+<DL>
+<DT> <B>-right</B></I> <I>attachment</I></B>
+</I></B>
+<DD> Specifies an attachment for the right edge of the slave window. The
+attachment must specied according to the section <B>SPECIFYING
+ATTACHMENTS</B></I> below.
+</DL>
+<DL>
+<DT> <B>-rightspring</B></I> <I>weight</I></B>
+</I></B>
+<DD> Specifies the weight of the spring at the right edge of the slave
+window. See the section <B>USING SPRINGS</B></I> below.
+</DL>
+<DL>
+<DT> <B>-rp</B></I> <I>value</I></B>
+</I></B>
+<DD> Abbreviation for the <B>-padright</B></I> option.
+</DL>
+<DL>
+<DT> <B>-rs</B></I> <I>weight</I></B>
+</I></B>
+<DD> Abbreviation for the <B>-rightspring</B></I> option.
+</DL>
+<DL>
+<DT> <B>-t</B></I> <I>attachment</I></B>
+</I></B>
+<DD> Abbreviation for the <B>-top</B></I> option.
+</DL>
+<DL>
+<DT> <B>-top</B></I> <I>attachment</I></B>
+</I></B>
+<DD> Specifies an attachment for the top edge of the slave window. The
+attachment must specied according to the section <B>SPECIFYING
+ATTACHMENTS</B></I> below.
+</DL>
+<DL>
+<DT> <B>-topspring</B></I> <I>weight</I></B>
+</I></B>
+<DD> Specifies the weight of the spring at the top edge of the slave
+window. See the section <B>USING SPRINGS</B></I> below.
+</DL>
+<DL>
+<DT> <B>-tp</B></I> <I>value</I></B>
+</I></B>
+<DD> Abbreviation for the <B>-padtop</B></I> option.
+</DL>
+<DL>
+<DT> <B>-ts</B></I> <I>weight</I></B>
+</I></B>
+<DD> Abbreviation for the <B>-topspring</B></I> option.
+</DL>
+</UL>
+<DL>
+<DT> <B>tixForm forget<I> slave </I></B>?<I>slave ...</I></B>?
+</I></B>
+<DD> Removes each of the slaves from its master and unmaps their windows.
+The slaves will no longer be managed by tixForm. All attachment values
+with respect to their master windows are discarded. If another slave
+is attached to this slave, then the attachment of the other slave will
+be changed to grid attachment based on its geometry.
+</DL>
+<DL>
+<DT> <B>tixForm grid <I>master </I></B>?<I>x_size y_size</I></B>?
+</I></B>
+<DD> When <I>x_size</I></B> and <I>y_size</I></B> are given, this command returns the
+number of grids of the master window in a pair of integers of the form
+{<I>x_size y_size</I></B>}. When both <I>x_size</I></B> and <I>y_size</I></B> are
+given, this command changes the number of horizontal and vertical
+grids on the master window.
+</DL>
+<DL>
+<DT> <B>tixForm info<I> slave</I></B> ?<I>option</I></B>?
+</I></B>
+<DD> Queries the attachment options of a slave window. <I>option</I></B> can be
+any of the options accepted by the <B>tixForm configure</B></I> command. If
+<I>option</I></B> is given, only the value of that option is returned.
+Otherwise, this command returns a list whose elements are the current
+configuration state of the slave given in the same <I>option-value</I></B> form
+that might be specified to <B>tixForm configure</B></I>. The first two
+elements in this list list are "<B>-in<I> master</I></B>" where
+</DL>
+<DL>
+<DT> <B>tixForm slaves <I>master</I></B>
+</I></B>
+<DD> Returns a list of all of the slaves for the master window. The order
+of the slaves in the list is the same as their order in the packing
+order. If master has no slaves then an empty string is returned.
+</DL>
+<P>
+</pre><H3>SPECIFYING ATTACHMENTS</H3>
+One can specify an attachment for each side of a slave window managed
+by tixForm. An attachment is specified in the the form "-<I>side</I></B>
+{<I>anchor_point</I></B> <I>offset</I></B>}". -<I>side</I></B> can be one of
+<B>-top</B></I>, <B>-bottom</B></I>, <B>-left</B></I> or <B>-right</B></I>.
+<P>
+<I>Offset</I></B> is given in screen units (i.e. any of the forms
+acceptable to <B>Tk_GetPixels</B></I>). A positive offset indicates
+shifting to a position to the right or bottom of an anchor point. A
+negative offset indicates shifting to a position to the left or top of
+an anchor point.
+<P>
+<I>Anchor_point</I></B> can be given in one of the
+following forms:
+<UL>
+<DL>
+<DT> <B>Grid Attachment</B></I>
+</I></B>
+<DD> The master window is divided into a number of horizontal and vertical
+grids. By default the master window is divided into 100x100 grids; the
+number of grids can be adjusted by the <B>tixForm grid</B></I> command. A
+grid attachment anchor point is given by a <B>%</B></I> sign followed by an
+<B>integer</B></I> value. For example, <B>%0</B></I> spceifies the first grid
+line (the top or left edge of the master window). <B>%100</B></I> spceifies
+the last grid line (the bottom or right edge of the master window).
+</DL>
+<DL>
+<DT> <B>Opposite Side Attachment</B></I>
+</I></B>
+<DD> Opposite attachment specifies an anchor point located on the
+<B>opposite</B></I> side of another slave widget, which must be managed by
+tixForm in the same master window. An opposite attachment anchor point
+is given by the name of another widget. For example, "tixForm .b -top
+{.a 0}" attaches the <B>top</B></I> side of the widget <B>\.b</B></I> to the
+<B>bottom</B></I> of the widget <B>\.a</B></I>.
+</DL>
+<DL>
+<DT> <B>Parallel Side Attachment</B></I>
+</I></B>
+<DD> Opposite attachment specifies an anchor point located on the
+<B>same</B></I> side of another slave widget, which must be managed by
+tixForm in the same master window. An parallel attachment anchor point
+is given by the sign <B>&amp;</B></I> follwed by the name of another widget.
+For example, "tixForm .b -top {&amp;.a 0}" attaches the <B>top</B></I> side of
+the widget <B>\.b</B></I> to the <B>top</B></I> of the widget <B>\.a</B></I>, making
+the <B>top</B></I> sides of these two widgets at the same vertical position
+in their parent window.
+</DL>
+<DL>
+<DT> <B>No Attachment</B></I>
+</I></B>
+<DD> Specifies a side of the slave to be attached to nothing, indicated by
+the keyword <B>none</B></I>. When the <B>none</B></I> anchor point is given, the
+offser must be zero.
+
+When a side of a slave is attached to <B>{none 0}</B></I>, the position
+of this side is calculated by the position of the other side and the
+natural size of the slave. For example, if a the <B>left</B></I> side of a
+widget is attached to <B>{%0 100}</B></I>, its <B>right</B></I> side attached to
+<B>{none 0}</B></I>, and the natural size of the widget is <B>50</B></I> pixels,
+the <B>right</B></I> side of the widget will be positioned at pixel <B>{%0
+149}</B></I>.
+
+When both <B>-top</B></I> and <B>-bottom</B></I> are attached to <B>none</B></I>,
+then by default <B>-top</B></I> will be attached to <B>{%0 0}</B></I>. When both
+<B>-left</B></I> and <B>-right</B></I> are attached to none, then by default
+<B>-left</B></I> will be attached to <B>{%0 0}</B></I>.
+</DL>
+</UL>
+<P>
+Shifting effects can be achieved by specifying a non-zero offset with
+an anchor point. In the following example, the <B>top</B></I> side of
+widget <B>\.b</B></I> is attached to the <B>bottom</B></I> of <B>\.a</B></I>; hence <B>\.b</B></I>
+always appears below <B>\.a</B></I>. Also, the left edge of <B>\.b</B></I>
+is attached to the <B>left</B></I> side of <B>\.a</B></I> with a 10
+pixel offest. Therefore, the <B>left</B></I> edge of <B>\.b</B></I> is always
+<P>
+<pre><code><code><code>
+ tixForm .b -left {.a 10} -top {.a 0}
+</code></code></code></pre>
+<P>
+<B>ABBREVIATIONS:</B></I> Certain abbreviations can be made on the
+attachment specifications: First an offset of zero can be omitted.
+Thus, the following two lines are equivalent:
+<P>
+<pre><code><code><code>
+ tixForm .b -top {.a 0} -right {%100 0}
+ tixForm .b -top {.a} -right {%100}
+</code></code></code></pre>
+<P>
+Also, because of the way TCL handles lists, when you omit the offset,
+you can also leave out the braces. So you can further simplify the
+above to:
+<P>
+<pre><code><code><code>
+ tixForm .b -top .a -right %100
+</code></code></code></pre>
+<P>
+In the second case, when the anchor point is omitted, the offset must
+be given. A default anchor point is chosen according to the value of
+the offset. If the anchor point is <B>0</B></I> or positive, the default
+anchor point %0 is used; thus, "tixForm \.b -top 15" attaches the top
+edge of <B>\.b</B></I> to a position 15 pixels below the top edge of the
+master window. If the anchor point is "<B>-0</B></I>" or negative, the
+default anchor point <B>%100</B></I> is used; thus, "tixForm \.a -right
+-2" attaches the right edge of <B>\.a</B></I> to a position 2 pixels to
+below shows a command with its equivalent abbreviation.
+<P>
+<pre><code><code><code>
+ tixForm .b -top {%0 10} -bottom {%100 0}
+ tixForm .b -top 10 -bottom -0
+</code></code></code></pre>
+<P>
+</pre><H3>USING SPRINGS</H3>
+To be written.
+<P>
+</pre><H3>ALGORITHM OF TIXFORM</H3>
+TixForm starts with any slave in the list of slaves of the master
+window. Then it tries to determine the position of each side of the
+slave.
+<P>
+If the attachment of a side of the slave is grid attachment, the
+position of the side is readily determined.
+<P>
+If the attachment of this side is <B>none</B></I>, then tixForm tries to
+determine the position of the opposite side first, and then use the
+position of the opposite side and the natural size of the slave to
+determine the position of this side.
+<P>
+If the attachment is opposite or parallel widget attachments, then
+tixForm tries to determine the positions of the other widget first,
+and then use the positions of the other widget and the natural size of
+the slave determine the position of this side. This recursive
+algorithmis carried on until the positions of all slaves are
+determined.
+<P>
+</pre><H3>CIRCULAR DEPENDENCY</H3>
+<P>
+The algorithm of tixForm will fail if a circular dependency exists in
+the attachments of the slaves. For example:
+<P>
+<pre><code><code><code>
+ tixForm .c -left .b
+ tixForm .b -right .c
+</code></code></code></pre>
+<P>
+In this example, the position of the left side of <B>.b</B></I> depends on
+the right side of <B>.c</B></I>, which in turn depends on the left side of <B>.b</B></I>.
+<P>
+When a circular dependency is discovered during the execution of the
+tixForm algorithm, tixForm will generate a background error and the
+geometry of the slaves are undefined (and will be arbitrary). Notice
+that tixForm only executes the algorithm when the specification of the
+attachments. Also, unlike the Motif Form manager widget, tixForm
+defines circular dependency as "<I>dependency in the same
+dimension</B></I>". Therefore, the following code fragment will does not
+have circular dependency because the two widgets do not depend on each
+other in the same dimension (<B>\.b</B></I> depends <B>.c</B></I> in the
+horizontal dimension and <B>.c</B></I> depends on <B>.b</B></I> in the vertical
+dimension):
+<P>
+<pre><code><code><code>
+ tixForm .b -left .c
+ tixForm .c -top .b
+</code></code></code></pre>
+<P>
+</pre><H3>BUGS</H3>
+<P>
+Springs have not been fully implemented yet.
+</pre><H3>KEYWORDS</H3>
+Tix(n), Form, Geometry Management
+<hr><i>Last modified Sun Jan 19 22:34:27 EST 1997 </i> ---
+<i>Serial 853731299</i>
diff --git a/tix/man/Form.n b/tix/man/Form.n
new file mode 100644
index 00000000000..9c47472cd93
--- /dev/null
+++ b/tix/man/Form.n
@@ -0,0 +1,460 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixForm tix 4.0
+.BS
+'
+'
+.SH NAME
+tixForm \- Geometry manager based on attachment rules
+'
+'
+'
+.SH SYNOPSIS
+.PP
+\fBtixForm\fI option arg ?arg ...?\fR
+.BE
+.PP
+.SH DESCRIPTION
+.PP
+'
+The \fBtixForm\fR command is used to communicate with the
+\fBtixForm\fR Geometry Manager, a geometry manager that arranges the
+geometry of the children in a parent window according to attachment
+rules. The \fBtixForm\fR geometry manager is very flexible and
+powerful; it can be used to emulate all the existing features of the
+Tk packer and placer geometry managers (see \fBpack(n)\fR,
+\fBplace(n)\fR).
+'
+The \fBtixForm\fR command can have any of several forms,
+depending on the \fIoption\fR argument:
+'
+.TP
+\fBtixForm\fI slave \fR?\fIoptions\fR?
+'
+If the first argument to \fBtixForm\fR is a window name (any value
+starting with ``.''), then the command is processed in the same way as
+\fBtixForm configure\fR.
+'
+.TP
+\fBtixForm check \fImaster\fR
+'
+This command checks whether there is circular dependency in the
+attachments of the master's slaves (see the section \fBCIRCULAR
+DEPENDENCY\fR below). It returns the Boolean value \fBTRUE\fR if it
+discover circular dependency and \fBFALSE\fR otherwise.
+'
+.TP
+\fBtixForm configure\fI slave \fR?\fI\-option value ...\fR?
+'
+Sets or adjusts the attachment values of the slave window
+according to the \fI\-option value\fR argument pairs.
+'
+.RS
+'
+.TP
+\fB\-b\fR \fIattachment\fR
+'
+Abbreviation for the \fB\-bottom\fR option.
+'
+.TP
+\fB\-bottom\fR \fIattachment\fR
+'
+Specifies an attachment for the bottom edge of the slave window. The
+attachment must specied according to the section \fBSPECIFYING
+ATTACHMENTS\fR below.
+'
+.TP
+\fB\-bottomspring\fR \fIweight\fR
+'
+Specifies the weight of the spring at the bottom edge of the slave
+window. See the section \fBUSING SPRINGS\fR below.
+'
+.TP
+\fB\-bp\fR \fIvalue\fR
+'
+Abbreviation for the \fB\-padbottom\fR option.
+'
+.TP
+\fB\-bs\fR \fIweight\fR
+'
+Abbreviation for the \fB\-bottomspring\fR option.
+'
+'
+.TP
+\fB\-fill\fR \fImaster\fR
+'
+Specifies the fillings when springs are used for this widget. The
+value must be \fBx\fR, \fBy\fR, \fBboth\fR or \fBnone\fR.
+'
+.TP
+\fB\-in\fR \fImaster\fR
+'
+Places the slave window into the specified master window. If the slave
+was originally in another master window, all attachment values with
+respect to the original master window are discarded. Even if the
+attachment values are the same as in the original master window, they
+need to be specified again. The \fB\-in\fR flag, when needed, must appear
+as the first flag after the name of the slave. Otherwise an error is
+generated.
+'
+.TP
+\fB\-l\fR \fIattachment\fR
+'
+Abbreviation for the \fB\-left\fR option.
+'
+.TP
+\fB\-left\fR \fIattachment\fR
+'
+Specifies an attachment for the left edge of the slave window. The
+attachment must specied according to the section \fBSPECIFYING
+ATTACHMENTS\fR below.
+'
+.TP
+\fB\-leftspring\fR \fIweight\fR
+'
+Specifies the weight of the spring at the left edge of the slave
+window. See the section \fBUSING SPRINGS\fR below.
+'
+.TP
+\fB\-lp\fR \fIvalue\fR
+'
+Abbreviation for the \fB\-padleft\fR option.
+'
+.TP
+\fB\-ls\fR \fIweight\fR
+'
+Abbreviation for the \fB\-leftspring\fR option.
+'
+'
+.TP
+\fB\-padbottom\fR \fIvalue\fR
+'
+Specifies the amount of external padding to leave on the bottom side
+of the slave. The \fIvalue\fR may have any of the forms acceptable to
+\fBTk_GetPixels(3)\fR.
+'
+'
+.TP
+\fB\-padleft\fR \fIvalue\fR
+'
+Specifies the amount of external padding to leave on the left side of
+the slave.
+'
+.TP
+\fB\-padright\fR \fIvalue\fR
+'
+Specifies the amount of external padding to leave on the right side of
+the slave.
+'
+.TP
+\fB\-padtop\fR \fIvalue\fR
+'
+Specifies the amount of external padding to leave on the top side of
+the slave.
+'
+.TP
+\fB\-padx\fR \fIvalue\fR
+'
+Specifies the amount of external padding to leave on both the left and
+the right sides of the slave.
+'
+.TP
+\fB\-pady\fR \fIvalue\fR
+'
+Specifies the amount of external padding to leave on both the top and
+the bottom sides of the slave.
+'
+'
+.TP
+\fB\-r\fR \fIattachment\fR
+'
+Abbreviation for the \fB\-right\fR option.
+'
+.TP
+\fB\-right\fR \fIattachment\fR
+'
+Specifies an attachment for the right edge of the slave window. The
+attachment must specied according to the section \fBSPECIFYING
+ATTACHMENTS\fR below.
+'
+.TP
+\fB\-rightspring\fR \fIweight\fR
+'
+Specifies the weight of the spring at the right edge of the slave
+window. See the section \fBUSING SPRINGS\fR below.
+'
+'
+.TP
+\fB\-rp\fR \fIvalue\fR
+'
+Abbreviation for the \fB\-padright\fR option.
+'
+.TP
+\fB\-rs\fR \fIweight\fR
+'
+Abbreviation for the \fB\-rightspring\fR option.
+'
+'
+.TP
+\fB\-t\fR \fIattachment\fR
+'
+Abbreviation for the \fB\-top\fR option.
+'
+.TP
+\fB\-top\fR \fIattachment\fR
+'
+Specifies an attachment for the top edge of the slave window. The
+attachment must specied according to the section \fBSPECIFYING
+ATTACHMENTS\fR below.
+'
+'
+.TP
+\fB\-topspring\fR \fIweight\fR
+'
+Specifies the weight of the spring at the top edge of the slave
+window. See the section \fBUSING SPRINGS\fR below.
+'
+'
+.TP
+\fB\-tp\fR \fIvalue\fR
+'
+Abbreviation for the \fB\-padtop\fR option.
+'
+.TP
+\fB\-ts\fR \fIweight\fR
+'
+Abbreviation for the \fB\-topspring\fR option.
+'
+.RE
+.TP
+\fBtixForm forget\fI slave \fR?\fIslave ...\fR?
+'
+Removes each of the slaves from its master and unmaps their windows.
+The slaves will no longer be managed by tixForm. All attachment values
+with respect to their master windows are discarded. If another slave
+is attached to this slave, then the attachment of the other slave will
+be changed to grid attachment based on its geometry.
+'
+.TP
+\fBtixForm grid \fImaster \fR?\fIx_size y_size\fR?
+'
+When \fIx_size\fR and \fIy_size\fR are given, this command returns the
+number of grids of the master window in a pair of integers of the form
+{\fIx_size y_size\fR}. When both \fIx_size\fR and \fIy_size\fR are
+given, this command changes the number of horizontal and vertical
+grids on the master window.
+'
+.TP
+\fBtixForm info\fI slave\fR ?\fIoption\fR?
+'
+Queries the attachment options of a slave window. \fIoption\fR can be
+any of the options accepted by the \fBtixForm configure\fR command. If
+\fIoption\fR is given, only the value of that option is returned.
+Otherwise, this command returns a list whose elements are the current
+configuration state of the slave given in the same \fIoption\-value\fR form
+that might be specified to \fBtixForm configure\fR. The first two
+elements in this list list are "\fB\-in\fI master\fR" where
+\fImaster\fR is the slave's master window.
+'
+.TP
+\fBtixForm slaves \fImaster\fR
+'
+Returns a list of all of the slaves for the master window. The order
+of the slaves in the list is the same as their order in the packing
+order. If master has no slaves then an empty string is returned.
+'
+.PP
+.SH SPECIFYING ATTACHMENTS
+'
+One can specify an attachment for each side of a slave window managed
+by tixForm. An attachment is specified in the the form "\-\fIside\fR
+{\fIanchor_point\fR \fIoffset\fR}". \-\fIside\fR can be one of
+\fB\-top\fR, \fB\-bottom\fR, \fB\-left\fR or \fB\-right\fR.
+.PP
+\fIOffset\fR is given in screen units (i.e. any of the forms
+acceptable to \fBTk_GetPixels\fR). A positive offset indicates
+shifting to a position to the right or bottom of an anchor point. A
+negative offset indicates shifting to a position to the left or top of
+an anchor point.
+.PP
+\fIAnchor_point\fR can be given in one of the
+following forms:
+'
+.RS
+.TP
+\fBGrid Attachment\fR
+'
+The master window is divided into a number of horizontal and vertical
+grids. By default the master window is divided into 100x100 grids; the
+number of grids can be adjusted by the \fBtixForm grid\fR command. A
+grid attachment anchor point is given by a \fB%\fR sign followed by an
+\fBinteger\fR value. For example, \fB%0\fR spceifies the first grid
+line (the top or left edge of the master window). \fB%100\fR spceifies
+the last grid line (the bottom or right edge of the master window).
+'
+.TP
+\fBOpposite Side Attachment\fR
+'
+Opposite attachment specifies an anchor point located on the
+\fBopposite\fR side of another slave widget, which must be managed by
+tixForm in the same master window. An opposite attachment anchor point
+is given by the name of another widget. For example, "tixForm .b \-top
+{.a 0}" attaches the \fBtop\fR side of the widget \fB\.b\fR to the
+\fBbottom\fR of the widget \fB\.a\fR.
+'
+.TP
+\fBParallel Side Attachment\fR
+'
+Opposite attachment specifies an anchor point located on the
+\fBsame\fR side of another slave widget, which must be managed by
+tixForm in the same master window. An parallel attachment anchor point
+is given by the sign \fB&\fR follwed by the name of another widget.
+For example, "tixForm .b \-top {&.a 0}" attaches the \fBtop\fR side of
+the widget \fB\.b\fR to the \fBtop\fR of the widget \fB\.a\fR, making
+the \fBtop\fR sides of these two widgets at the same vertical position
+in their parent window.
+'
+.TP
+\fBNo Attachment\fR
+'
+Specifies a side of the slave to be attached to nothing, indicated by
+the keyword \fBnone\fR. When the \fBnone\fR anchor point is given, the
+offser must be zero.
+
+When a side of a slave is attached to \fB{none 0}\fR, the position
+of this side is calculated by the position of the other side and the
+natural size of the slave. For example, if a the \fBleft\fR side of a
+widget is attached to \fB{%0 100}\fR, its \fBright\fR side attached to
+\fB{none 0}\fR, and the natural size of the widget is \fB50\fR pixels,
+the \fBright\fR side of the widget will be positioned at pixel \fB{%0
+149}\fR.
+
+When both \fB\-top\fR and \fB\-bottom\fR are attached to \fBnone\fR,
+then by default \fB\-top\fR will be attached to \fB{%0 0}\fR. When both
+\fB\-left\fR and \fB\-right\fR are attached to none, then by default
+\fB\-left\fR will be attached to \fB{%0 0}\fR.
+'
+.RE
+.PP
+Shifting effects can be achieved by specifying a non-zero offset with
+an anchor point. In the following example, the \fBtop\fR side of
+widget \fB\.b\fR is attached to the \fBbottom\fR of \fB\.a\fR; hence \fB\.b\fR
+always appears below \fB\.a\fR. Also, the left edge of \fB\.b\fR
+is attached to the \fBleft\fR side of \fB\.a\fR with a 10
+pixel offest. Therefore, the \fBleft\fR edge of \fB\.b\fR is always
+shifted 10 pixels to the right of \fB\.a\fR's \fBleft\fR edge:
+.PP
+.nf
+ tixForm .b \-left {.a 10} \-top {.a 0}
+.fi
+.PP
+\fBABBREVIATIONS:\fR Certain abbreviations can be made on the
+attachment specifications: First an offset of zero can be omitted.
+Thus, the following two lines are equivalent:
+.PP
+.nf
+ tixForm .b \-top {.a 0} \-right {%100 0}
+ tixForm .b \-top {.a} \-right {%100}
+.fi
+.PP
+Also, because of the way TCL handles lists, when you omit the offset,
+you can also leave out the braces. So you can further simplify the
+above to:
+.PP
+.nf
+ tixForm .b \-top .a \-right %100
+.fi
+.PP
+In the second case, when the anchor point is omitted, the offset must
+be given. A default anchor point is chosen according to the value of
+the offset. If the anchor point is \fB0\fR or positive, the default
+anchor point %0 is used; thus, "tixForm \.b \-top 15" attaches the top
+edge of \fB\.b\fR to a position 15 pixels below the top edge of the
+master window. If the anchor point is "\fB-0\fR" or negative, the
+default anchor point \fB%100\fR is used; thus, "tixForm \.a \-right
+\-2" attaches the right edge of \fB\.a\fR to a position 2 pixels to
+the left of the master window's \fBright\fR edge. An further example
+below shows a command with its equivalent abbreviation.
+'
+.PP
+.nf
+ tixForm .b \-top {%0 10} \-bottom {%100 0}
+ tixForm .b \-top 10 \-bottom \-0
+.fi
+.PP
+.SH USING SPRINGS
+'
+To be written.
+'
+.PP
+.SH ALGORITHM OF TIXFORM
+'
+TixForm starts with any slave in the list of slaves of the master
+window. Then it tries to determine the position of each side of the
+slave.
+.PP
+If the attachment of a side of the slave is grid attachment, the
+position of the side is readily determined.
+.PP
+If the attachment of this side is \fBnone\fR, then tixForm tries to
+determine the position of the opposite side first, and then use the
+position of the opposite side and the natural size of the slave to
+determine the position of this side.
+.PP
+If the attachment is opposite or parallel widget attachments, then
+tixForm tries to determine the positions of the other widget first,
+and then use the positions of the other widget and the natural size of
+the slave determine the position of this side. This recursive
+algorithmis carried on until the positions of all slaves are
+determined.
+.PP
+.SH CIRCULAR DEPENDENCY
+.PP
+The algorithm of tixForm will fail if a circular dependency exists in
+the attachments of the slaves. For example:
+.PP
+.nf
+ tixForm .c \-left .b
+ tixForm .b \-right .c
+.fi
+.PP
+In this example, the position of the left side of \fB.b\fR depends on
+the right side of \fB.c\fR, which in turn depends on the left side of \fB.b\fR.
+.PP
+When a circular dependency is discovered during the execution of the
+tixForm algorithm, tixForm will generate a background error and the
+geometry of the slaves are undefined (and will be arbitrary). Notice
+that tixForm only executes the algorithm when the specification of the
+slaves' attachments is complete. Therefore, it allows intermediate
+states of circular dependency during the specification of the slaves'
+attachments. Also, unlike the Motif Form manager widget, tixForm
+defines circular dependency as "\fIdependency in the same
+dimension\fR". Therefore, the following code fragment will does not
+have circular dependency because the two widgets do not depend on each
+other in the same dimension (\fB\.b\fR depends \fB.c\fR in the
+horizontal dimension and \fB.c\fR depends on \fB.b\fR in the vertical
+dimension):
+.PP
+.nf
+ tixForm .b \-left .c
+ tixForm .c \-top .b
+.fi
+.PP
+.SH BUGS
+'
+.PP
+Springs have not been fully implemented yet.
+'
+.SH KEYWORDS
+Tix(n), Form, Geometry Management
diff --git a/tix/man/GetBool.html b/tix/man/GetBool.html
new file mode 100644
index 00000000000..c816891cfe8
--- /dev/null
+++ b/tix/man/GetBool.html
@@ -0,0 +1,24 @@
+
+
+
+<TITLE>tixGetBoolean - Get the boolean value of a string.</TITLE>
+<Center><H2>tixGetBoolean - Get the boolean value of a string.</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<P>
+<B>tixGetBoolean<I> ?-nocomplain? string</I></B>
+<P>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The command <B>tixGetBoolean</B></I> returns "0" if the string is a valid
+TCL string for the boolean value FALSE. It returns "1" if the string
+is a valid TCL string for the boolean value TRUE.
+
+When the string is not a valid TCL boolean value and the
+<B>-nocomplain</B></I> option is specified, <B>tixGetBoolean</B></I> will return
+"0". Otherwise it will generate an error.
+<P>
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:29 EST 1997 </i> ---
+<i>Serial 853731299</i>
diff --git a/tix/man/GetBool.n b/tix/man/GetBool.n
new file mode 100644
index 00000000000..571642bca0d
--- /dev/null
+++ b/tix/man/GetBool.n
@@ -0,0 +1,44 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixGetBoolean tix 4.0
+.BS
+'
+'
+.SH NAME
+tixGetBoolean - Get the boolean value of a string.
+'
+'
+'
+.SH SYNOPSIS
+.PP
+\fBtixGetBoolean\fI ?-nocomplain? string\fR
+.PP
+.SH DESCRIPTION
+.PP
+'
+'
+The command \fBtixGetBoolean\fR returns "0" if the string is a valid
+TCL string for the boolean value FALSE. It returns "1" if the string
+is a valid TCL string for the boolean value TRUE.
+
+When the string is not a valid TCL boolean value and the
+\fB-nocomplain\fR option is specified, \fBtixGetBoolean\fR will return
+"0". Otherwise it will generate an error.
+'
+'
+'
+'
+.PP
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/GetInt.html b/tix/man/GetInt.html
new file mode 100644
index 00000000000..467c1650884
--- /dev/null
+++ b/tix/man/GetInt.html
@@ -0,0 +1,26 @@
+
+
+
+<TITLE>tixGetInt - Get the integer value of a string.</TITLE>
+<Center><H2>tixGetInt - Get the integer value of a string.</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<P>
+<B>tixGetInt<I> ?-nocomplain? ?-trunc? string</I></B>
+<P>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The command <B>tixGetInt</B></I> converts any number into an integer
+number. By default, it will round the number to the nearest integer.
+When the <B>-trunc</B></I> option is specified, the number is truncated
+instead of rounded.
+
+When the string is not a valid TCL numerical value and the
+<B>-nocomplain</B></I> option is specified, <B>tixGetInt</B></I> will return
+"0". Otherwise it will generate an error.
+<P>
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<!Serial 851729145>
+<hr><i>Last modified Fri Jan 17 23:01:05 EST 1997 </i> ---
+<i>Serial 853731299</i>
diff --git a/tix/man/GetInt.n b/tix/man/GetInt.n
new file mode 100644
index 00000000000..845b78f2559
--- /dev/null
+++ b/tix/man/GetInt.n
@@ -0,0 +1,45 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixGetInt tix 4.0
+.BS
+'
+'
+.SH NAME
+tixGetInt - Get the integer value of a string.
+'
+'
+'
+.SH SYNOPSIS
+.PP
+\fBtixGetInt\fI ?-nocomplain? ?-trunc? string\fR
+.PP
+.SH DESCRIPTION
+.PP
+'
+'
+The command \fBtixGetInt\fR converts any number into an integer
+number. By default, it will round the number to the nearest integer.
+When the \fB-trunc\fR option is specified, the number is truncated
+instead of rounded.
+
+When the string is not a valid TCL numerical value and the
+\fB-nocomplain\fR option is specified, \fBtixGetInt\fR will return
+"0". Otherwise it will generate an error.
+'
+'
+'
+'
+.PP
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/Grid.html b/tix/man/Grid.html
new file mode 100644
index 00000000000..25569a3ac31
--- /dev/null
+++ b/tix/man/Grid.html
@@ -0,0 +1,225 @@
+<!-- Copyright (c) 1996, Expert Interface Technologies
+
+See the file "license.terms" for information on usage and
+redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+The file man.macros and some of the macros used by this file are
+copyrighted: (c) 1990 The Regents of the University of California.
+(c) 1994-1995 Sun Microsystems, Inc.
+The license terms of the Tcl/Tk distrobution are in the file
+license.tcl.>
+<Title> tixGrid</Title>
+<h1>tixGrid </h1> <blockquote>Create and manipulate Tix Grid widgets.</blockquote><p>
+<p><hr>
+<h1> Standard Options </h1><p>
+<blockquote>
+<TABLE ALIGN=ABSCENTER BORDER=1 CELLSPACING=0 CELLPADDING=4>
+<TR>
+<TD><code><b>background</b></code></TD>
+<TD><code><b>borderWidth</b></code></TD>
+<TD><code><b>cursor</b></code></TD>
+<TD><code><b>font</b></code><br></TD>
+</TR>
+<TR>
+<TD><code><b>foreground</b></code></TD>
+<TD><code><b>height</b></code></TD>
+<TD><code><b>highlightColor</b></code></TD>
+<TD><code><b>highlightThickness</b></code><br></TD>
+</TR>
+<TR>
+<TD><code><b>relief</b></code></TD>
+<TD><code><b>selectBackground</b></code></TD>
+<TD><code><b>selectForeground</b></code></TD>
+<TD><code><b>width</b></code><br></TD>
+</TR>
+<TR>
+<TD><code><b>xScrollCommand</b></code></TD>
+<TD><code><b>yScrollCommand</b></code></TD>
+<TD><code><b></b></code></TD>
+<TD><code><b></b></code><br></TD>
+</TR>
+</TABLE>
+<p>See the <b>options(n)</b> manual entry for details on the standard options.<p>
+</blockquote>
+<p> <h1>Widget Specific Options</h1> <p>
+<DL>
+<DT>
+<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=4>
+<TR>
+<TD>Name:</TD>
+<TD><code><b>editDoneCmd</b></code><br></TD>
+</TR>
+<TR>
+<TD>Class:</TD>
+<TD><code><b>EditDoneCmd</b></code><br></TD>
+</TR>
+<TR>
+<TD>Command-line switch:</TD>
+<TD><code><b>-editdonecmd</b></code><br></TD>
+</TR>
+</TABLE>
+<DD><p>If non-empty, gives a Tcl command to be executed when the user has edited grid cell. When this command is called, it is passed with two additional parameters: <i>x</i> <i>y</i>, where (<i>x</i>,<i>y</i>) is the location of the cell that has just been edited.<p>
+<DT>
+<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=4>
+<TR>
+<TD>Name:</TD>
+<TD><code><b>editNotifyCmd</b></code><br></TD>
+</TR>
+<TR>
+<TD>Class:</TD>
+<TD><code><b>EditNotifyCmd</b></code><br></TD>
+</TR>
+<TR>
+<TD>Command-line switch:</TD>
+<TD><code><b>-editnotifycmd</b></code><br></TD>
+</TR>
+</TABLE>
+<DD><p>If non-empty, gives a Tcl command to be executed when the user tries to edit a grid cell. When this command is called, it is passed with two additional parameters: <i>x</i> <i>y</i>, where (<i>x</i>,<i>y</i>,) is the location of the cell. This command should return a boolean value: <b>true</b> indicates that the cells is editable and <b>false</b> otherwise.<p>
+<DT>
+<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=4>
+<TR>
+<TD>Name:</TD>
+<TD><code><b>formatCmd</b></code><br></TD>
+</TR>
+<TR>
+<TD>Class:</TD>
+<TD><code><b>FormatCmd</b></code><br></TD>
+</TR>
+<TR>
+<TD>Command-line switch:</TD>
+<TD><code><b>-formatcmd</b></code><br></TD>
+</TR>
+</TABLE>
+<DD><p>If non-empty, gives a Tcl command to be executed when the grid cells need to be formatted on the screen. Normally, this command calls the <b>format</b> widget command (see below). When this command is called, it is passed with five additional parameters: <i>type</i> <i>x1</i> <i>y1</i> <i>x2</i> <i>y2</i>. <i>type</i> gives the logical type of the region in the grid. It may be one of the following. <b>x-region</b>: the horizontal margin; <b>y-region</b>: the vertical margin; <b>s-region</b>, the area where the the horizontal and vertical margins are joined; <b>main</b>: all the cells that do not fall into the above three types. <i>x1</i> <i>y1</i> <i>x2</i> <i>y2</i> gives the extent of the region that needs formatting.<p>
+<DT>
+<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=4>
+<TR>
+<TD>Name:</TD>
+<TD><code><b>leftMargin</b></code><br></TD>
+</TR>
+<TR>
+<TD>Class:</TD>
+<TD><code><b>LeftMargin</b></code><br></TD>
+</TR>
+<TR>
+<TD>Command-line switch:</TD>
+<TD><code><b>-leftmargin</b></code><br></TD>
+</TR>
+</TABLE>
+<DD><p>In the number of cells, gives the width of vertical margin. A zero indicates that no vertical should be drawn.<p>
+<DT>
+<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=4>
+<TR>
+<TD>Name:</TD>
+<TD><code><b>selectMode</b></code><br></TD>
+</TR>
+<TR>
+<TD>Class:</TD>
+<TD><code><b>SelectMode</b></code><br></TD>
+</TR>
+<TR>
+<TD>Command-line switch:</TD>
+<TD><code><b>-selectmode</b></code><br></TD>
+</TR>
+</TABLE>
+<DD><p>Specifies one of several styles for manipulating the selection. The value of the option may be arbitrary, but the default bindings expect it to be either <b>single</b>, <b>browse</b>, <b>multiple</b>, or <b>extended</b>; the default value is <b>single</b>.<p>
+<DT>
+<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=4>
+<TR>
+<TD>Name:</TD>
+<TD><code><b>selectUnit</b></code><br></TD>
+</TR>
+<TR>
+<TD>Class:</TD>
+<TD><code><b>SelectUnit</b></code><br></TD>
+</TR>
+<TR>
+<TD>Command-line switch:</TD>
+<TD><code><b>-selectunit</b></code><br></TD>
+</TR>
+</TABLE>
+<DD><p>Specifies the selection unit. Valid values are <b>cell</b>, <b>column</b> or <b>row</b>.<p>
+<DT>
+<TABLE BORDER=0 CELLSPACING=0 CELLPADDING=4>
+<TR>
+<TD>Name:</TD>
+<TD><code><b>topMargin</b></code><br></TD>
+</TR>
+<TR>
+<TD>Class:</TD>
+<TD><code><b>TopMargin</b></code><br></TD>
+</TR>
+<TR>
+<TD>Command-line switch:</TD>
+<TD><code><b>-topmargin</b></code><br></TD>
+</TR>
+</TABLE>
+<DD><p>In the number of cells, gives the height of horizontal margin. A zero indicates that no horizontal should be drawn.<p>
+</DL>
+<p>
+<p><hr>
+<h1>Description</h1><p>
+The <b>tixGrid</b> command creates a new window (given by the <i>pathName</i> argument) and makes it into a <b>tixGrid</b> widget. Additional options, described above, may be specified on the command line or in the option database to configure aspects of the <b>tixGrid</b> widget such as its cursor and relief. <p> A Grid widget displays its contents in a two dimensional grid of cells. Each cell may contain one Tix <b>display</b> <b>item</b>, which may be in text, graphics or other formats. See the <b>tixItemType(n)</b> manual page for more information about Tix display items. Individual cells, or groups of cells, can be formatted with a wide range of attributes, such as its color, relief and border.</p>
+<h2> Widget Command</h2><p>
+The <b>tixGrid</b> command creates a new Tcl command whose name is the same as the path name of the <b>tixGrid</b> widget's window. This command may be used to invoke various operations on the widget. It has the following general form:
+<blockquote>
+<code><i>pathName option</i> </code>?<code><i>arg arg ...</i></code>?
+</blockquote>
+<i>PathName</i> is the name of the command, which is the same as the <b>tixGrid</b> widget's path name. <i>Option</i> and the <i>arg</i>s determine the exact behavior of the command. The following commands are possible for <b>tixGrid</b> widgets: <p>
+<DL>
+<DT>
+<i>pathName</i> <b>anchor</b> <i>option</i> ?<i>args</i> <i>...</i>?
+<DD>Manipulates the <b>anchor cell</b> of the <b>tixGrid</b> widget. The anchor cell is the end of the selection that is fixed while the user is dragging out a selection with the mouse. <p>
+<DT>
+<i>pathName</i> <b>bdtype</b>
+<DD> <p>
+<DT>
+<i>pathName</i> <b>cget</b> <i>option</i>
+<DD>Returns the current value of the configuration option given by <i>option</i>. <i>Option</i> may have any of the values accepted by the <b>tixGrid</b> command. <p>
+<DT>
+<i>pathName</i> <b>configure</b> ?<i>option</i>? ?<i>value</i> <i>option</i> <i>value</i> <i>...</i>?
+<DD>Query or modify the configuration options of the widget. If no <i>option</i> is specified, returns a list describing all of the available options for <i>pathName</i> (see <b>Tk_ConfigureInfo(n)</b> for information on the format of this list.) If <i>option</i> is specified with no <i>value</i>, then the command returns a list describing the one named option (this list will be identical to the corresponding sublist of the value returned if no <i>option</i> is specified). If one or more <i>option-value</i> pairs are specified, then the command modifies the given widget option(s) to have the given value(s); in this case the command returns an empty string. <i>Option</i> may have any of the values accepted by the <b>tixGrid</b> command. <p>
+<DT>
+<i>pathName</i> <b>delete</b> <i>dim</i> <i>from</i> ?<i>to</i>?
+<DD><i>Dim</i> may be <b>row</b> or <b>column</b>. If <i>to</i> is not given, deletes a single row (or column) at the position <i>from</i>. If <i>to</i> is given, deletes the range of rows (or columns) from position <i>from</i> through <i>to</i>. <p>
+<DT>
+<i>pathName</i> <b>edit apply</b>
+<DD>If any cell is being edited, de-highlight the cell and applies the changes. <p>
+<DT>
+<i>pathName</i> <b>edit set</b> <i>x</i> <i>y</i>
+<DD>Highlights the cell at (<i>x</i>,<i>y</i>) for editing, if the <b>-editnotify</b> command returns true for this cell. <p>
+<DT>
+<i>pathName</i> <b>entrycget</b> <i>x</i> <i>y</i> <i>option</i>
+<DD>Returns the current value of the configuration option given by <i>option</i> of the cell at (<i>x</i>,<i>y</i>). <i>Option</i> may have any of the values accepted by the <b>set</b> widget command. <p>
+<DT>
+<i>pathName</i> <b>entryconfigure</b> <i>x</i> <i>y</i> ?<i>option</i>? ?<i>value</i> <i>option</i> <i>value</i> <i>...</i>?
+<DD>Query or modify the configuration options of the cell at (<i>x</i>,<i>y</i>). If no <i>option</i> is specified, returns a list describing all of the available options for the cell (see <b>Tk_ConfigureInfo(n)</b> for information on the format of this list.) If <i>option</i> is specified with no <i>value</i>, then the command returns a list describing the one named option (this list will be identical to the corresponding sublist of the value returned if no <i>option</i> is specified.) If one or more <i>option-value</i> pairs are specified, then the command modifies the given widget option(s) to have the given value(s); in this case the command returns an empty string. <i>Option</i> may have any of the values accepted by the <b>set</b> widget command. <p>
+<DT>
+<i>pathName</i> <b>format</b>
+<DD> <p>
+<DT>
+<i>pathName</i> <b>index</b>
+<DD> <p>
+<DT>
+<i>pathName</i> <b>move</b> <i>dim</i> <i>from</i> <i>to</i> <i>offset</i>
+<DD><i>Dim</i> may be <b>row</b> or <b>column</b>. Moves the the range of rows (or columns) from position <i>from</i> through <i>to</i> by the distance indicated by <i>offset</i>. For example, <b>move</b> <b>row</b> <b>2</b> <b>4</b> <b>1</b> moves the rows 2,3,4 to rows 3,4,5. <p>
+<DT>
+<i>pathName</i> <b>set</b> <i>x</i> <i>y</i> ?<i><b>-itemtype</b></i> <i>type</i>? ?<i>option</i> <i>value...</i>?
+<DD>Creates a new display item at the cell at (<i>x</i>,<i>y</i>). The optional <b>-itemtype</b> parameter gives the type of the display item. An additional list of <i>option-value</i> pairs specify options of the display item. If a display item already exists at this cell, the old item will be deleted automatically. <p>
+<DT>
+<i>pathName</i> <b>size</b> <i>dim</i> <i>index</i> ?<i>option</i> <i>value</i> <i>...</i>?
+<DD>Queries or sets the size of the row or column given by <i>dim</i> and <i>index</i>. <i>Dim</i> may be <b>row</b> or <b>column</b>. <i>Index</i> may be any non-negative integer that gives the position of a given row (or column). <i>Index</i> can also be the string <b>default</b>; in this case, this command queries or sets the default size of all rows (or columns). <p> When no <i>option</i>-<i>value</i> pair is given, this command returns a list containing the current size setting of the given row (or column). When <i>option</i>-<i>value</i> pairs are given, the corresponding options of the size setting of the given row are changed. <i>Option</i> may be one of the follwing: <p><DL><DT><b>-pad0</b> <i>pixels</i><DD>Specifies the paddings to the left or a column or the top of a row.<p><DT><b>-pad1</b> <i>pixels</i><DD>Specifies the paddings to the right or a column or the bottom of a row.<p><DT><b>-size</b> <i>val</i><DD>Specifies the width of a column or the height of a row. <i>Val</i> may be: <b>auto</b> -- the width of the column is set the the widest cell in the column; a valid Tk screen distance unit (see <b>Tk_GetPixels(n)</b>); or a real number following by the word <b>chars</b> (e.g. <b>3.4chars</b>) that sets the width of the column to the given number of characters.<p></DL> <p>
+<DT>
+<i>pathName</i> <b>unset</b> <i>x</i> <i>y</i>
+<DD>Clears the cell at (<i>x</i>,<i>y</i>) by removing its display item. <p>
+<DT>
+<i>pathName</i> <b>xview</b>
+<DD> <p>
+<DT>
+<i>pathName</i> <b>yview</b>
+<DD> <p>
+</DL>
+
+<!Serial 851729152>
+<hr><i>Last modified Fri Jan 17 23:01:07 EST 1997 </i> ---
+<i>Serial 853731300</i>
diff --git a/tix/man/Grid.n b/tix/man/Grid.n
new file mode 100644
index 00000000000..118db48d1fe
--- /dev/null
+++ b/tix/man/Grid.n
@@ -0,0 +1,347 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and
+'\" redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+'\" The definitions below are for supplemental macros used in Tix
+'\" manual entries.
+'\"
+'\" .HS name section [date [version]]
+'\" Replacement for .TH in other man pages. See below for valid
+'\" section names.
+'\"
+'\" .AP type name in/out [indent]
+'\" Start paragraph describing an argument to a library procedure.
+'\" type is type of argument (int, etc.), in/out is either "in", "out",
+'\" or "in/out" to describe whether procedure reads or modifies arg,
+'\" and indent is equivalent to second arg of .IP (shouldn't ever be
+'\" needed; use .AS below instead)
+'\"
+'\" .AS [type [name]]
+'\" Give maximum sizes of arguments for setting tab stops. Type and
+'\" name are examples of largest possible arguments that will be passed
+'\" to .AP later. If args are omitted, default tab stops are used.
+'\"
+'\" .BS
+'\" Start box enclosure. From here until next .BE, everything will be
+'\" enclosed in one large box.
+'\"
+'\" .BE
+'\" End of box enclosure.
+'\"
+'\" .VS
+'\" Begin vertical sidebar, for use in marking newly-changed parts
+'\" of man pages.
+'\"
+'\" .VE
+'\" End of vertical sidebar.
+'\"
+'\" .DS
+'\" Begin an indented unfilled display.
+'\"
+'\" .DE
+'\" End of indented unfilled display.
+'\"
+.\"
+'\" # Heading for Tix man pages
+.de HS
+.ds ^3 \\0
+.if !"\\$3"" .ds ^3 \\$3
+.if '\\$2'cmds' .TH "\\$1" 1 "\\*(^3" "\\$4" "\\$5"
+.if '\\$2'lib' .TH "\\$1" 3 "\\*(^3" "\\$4" "\\$5"
+.if '\\$2'ncmds' .TH "\\$1" n "\\*(^3" "\\$4" "\\$5"
+.if '\\$2'tcl' .TH "\\$1" n "\\*(^3" Tcl "Tcl Built-In Commands"
+.if '\\$2'tk' .TH "\\$1" n "\\*(^3" Tk "Tk Commands"
+.if '\\$2'tclc' .TH "\\$1" 3 "\\*(^3" Tcl "Tcl Library Procedures"
+.if '\\$2'tkc' .TH "\\$1" 3 "\\*(^3" Tk "Tk Library Procedures"
+.if '\\$2'tclcmds' .TH "\\$1" 1 "\\*(^3" Tcl "Tcl Applications"
+.if '\\$2'tkcmds' .TH "\\$1" 1 "\\*(^3" Tk "Tk Applications"
+.if '\\$2'tix' .TH "\\$1" n "\\*(^3" Tix "Tix Commands"
+.if '\\$2'tixcmds' .TH "\\$1" 1 "\\*(^3" Tix "Tix Applications"
+.if t .wh -1.3i ^B
+.nr ^l \\n(.l
+.ad b
+..
+'\" # Start an argument description
+.de AP
+.ie !"\\$4"" .TP \\$4
+.el \{\
+. ie !"\\$2"" .TP \\n()Cu
+. el .TP 15
+.\}
+.ie !"\\$3"" \{\
+.ta \\n()Au \\n()Bu
+\&\\$1 \\fI\\$2\\fP (\\$3)
+.\".b
+.\}
+.el \{\
+.br
+.ie !"\\$2"" \{\
+\&\\$1 \\fI\\$2\\fP
+.\}
+.el \{\
+\&\\fI\\$1\\fP
+.\}
+.\}
+..
+'\" # define tabbing values for .AP
+.de AS
+.nr )A 10n
+.if !"\\$1"" .nr )A \\w'\\$1'u+3n
+.nr )B \\n()Au+15n
+.\"
+.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n
+.nr )C \\n()Bu+\\w'(in/out)'u+2n
+..
+'\" # BS - start boxed text
+'\" # ^y = starting y location
+'\" # ^b = 1
+.de BS
+.br
+.mk ^y
+.nr ^b 1u
+.if n .nf
+.if n .ti 0
+.if n \l'\\n(.lu\(ul'
+.if n .fi
+..
+'\" # BE - end boxed text (draw box now)
+.de BE
+.nf
+.ti 0
+.mk ^t
+.ie n \l'\\n(^lu\(ul'
+.el \{\
+.\" Draw four-sided box normally, but don't draw top of
+.\" box if the box started on an earlier page.
+.ie !\\n(^b-1 \{\
+\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.el \}\
+\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.\}
+.fi
+.br
+.nr ^b 0
+..
+'\" # VS - start vertical sidebar
+'\" # ^Y = starting y location
+'\" # ^v = 1 (for troff; for nroff this doesn't matter)
+.de VS
+.mk ^Y
+.ie n 'mc \s12\(br\s0
+.el .nr ^v 1u
+..
+'\" # VE - end of vertical sidebar
+.de VE
+.ie n 'mc
+.el \{\
+.ev 2
+.nf
+.ti 0
+.mk ^t
+\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n'
+.sp -1
+.fi
+.ev
+.\}
+.nr ^v 0
+..
+'\" # Special macro to handle page bottom: finish off current
+'\" # box/sidebar if in box/sidebar mode, then invoked standard
+'\" # page bottom macro.
+.de ^B
+.ev 2
+'ti 0
+'nf
+.mk ^t
+.if \\n(^b \{\
+.\" Draw three-sided box if this is the box's first page,
+.\" draw two sides but no top otherwise.
+.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.\}
+.if \\n(^v \{\
+.nr ^x \\n(^tu+1v-\\n(^Yu
+\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c
+.\}
+.bp
+'fi
+.ev
+.if \\n(^b \{\
+.mk ^y
+.nr ^b 2
+.\}
+.if \\n(^v \{\
+.mk ^Y
+.\}
+..
+'\" # DS - begin display
+.de DS
+.RS
+.nf
+.sp
+..
+'\" # DE - end display
+.de DE
+.fi
+.RE
+.sp
+..
+
+
+.HS tixGrid tix 4.1
+.BS
+.SH NAME
+tixGrid \- Create and manipulate Tix Grid widgets
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 5c 11c
+\fBbackground\fR \fBborderWidth\fR \fBcursor\fR
+\fBfont\fR \fBforeground\fR \fBheight\fR
+\fBhighlightColor\fR \fBhighlightThickness\fR \fBrelief\fR
+\fBselectBackground\fR \fBselectForeground\fR \fBwidth\fR
+\fBxScrollCommand\fR \fByScrollCommand\fR \fB\fR
+.fi
+.LP
+See the \fBoptions(n)\fR manual entry for details on the standard options.
+.SH "STANDARD OPTIONS"
+.ta 5c
+.LP
+.nf
+Name: \fBeditDoneCmd\fR
+Class: \fBEditDoneCmd\fR
+Command-line switch: \fB\-editdonecmd\fR
+.fi
+.IP
+If non-empty, gives a Tcl command to be executed when the user has edited grid cell. When this command is called, it is passed with two additional parameters: \fIx\fR \fIy\fR, where (\fIx\fR,\fIy\fR) is the location of the cell that has just been edited.
+.LP
+.nf
+Name: \fBeditNotifyCmd\fR
+Class: \fBEditNotifyCmd\fR
+Command-line switch: \fB\-editnotifycmd\fR
+.fi
+.IP
+If non-empty, gives a Tcl command to be executed when the user tries to edit a grid cell. When this command is called, it is passed with two additional parameters: \fIx\fR \fIy\fR, where (\fIx\fR,\fIy\fR,) is the location of the cell. This command should return a boolean value: \fBtrue\fR indicates that the cells is editable and \fBfalse\fR otherwise.
+.LP
+.nf
+Name: \fBformatCmd\fR
+Class: \fBFormatCmd\fR
+Command-line switch: \fB\-formatcmd\fR
+.fi
+.IP
+If non-empty, gives a Tcl command to be executed when the grid cells need to be formatted on the screen. Normally, this command calls the \fBformat\fR widget command (see below). When this command is called, it is passed with five additional parameters: \fItype\fR \fIx1\fR \fIy1\fR \fIx2\fR \fIy2\fR. \fItype\fR gives the logical type of the region in the grid. It may be one of the following. \fBx-region\fR: the horizontal margin; \fBy-region\fR: the vertical margin; \fBs-region\fR, the area where the the horizontal and vertical margins are joined; \fBmain\fR: all the cells that do not fall into the above three types. \fIx1\fR \fIy1\fR \fIx2\fR \fIy2\fR gives the extent of the region that needs formatting.
+.LP
+.nf
+Name: \fBleftMargin\fR
+Class: \fBLeftMargin\fR
+Command-line switch: \fB\-leftmargin\fR
+.fi
+.IP
+In the number of cells, gives the width of vertical margin. A zero indicates that no vertical should be drawn.
+.LP
+.nf
+Name: \fBselectMode\fR
+Class: \fBSelectMode\fR
+Command-line switch: \fB\-selectmode\fR
+.fi
+.IP
+Specifies one of several styles for manipulating the selection. The value of the option may be arbitrary, but the default bindings expect it to be either \fBsingle\fR, \fBbrowse\fR, \fBmultiple\fR, or \fBextended\fR; the default value is \fBsingle\fR.
+.LP
+.nf
+Name: \fBselectUnit\fR
+Class: \fBSelectUnit\fR
+Command-line switch: \fB\-selectunit\fR
+.fi
+.IP
+Specifies the selection unit. Valid values are \fBcell\fR, \fBcolumn\fR or \fBrow\fR.
+.LP
+.nf
+Name: \fBtopMargin\fR
+Class: \fBTopMargin\fR
+Command-line switch: \fB\-topmargin\fR
+.fi
+.IP
+In the number of cells, gives the height of horizontal margin. A zero indicates that no horizontal should be drawn.
+.BE
+.SH DESCRIPTION
+The \fBtixGrid\fR command creates a new window (given by the \fIpathName\fR argument) and makes it into a \fBtixGrid\fR widget. Additional options, described above, may be specified on the command line or in the option database to configure aspects of the \fBtixGrid\fR widget such as its cursor and relief.
+.PP
+A Grid widget displays its contents in a two dimensional grid of cells. Each cell may contain one Tix \fBdisplay\fR \fBitem\fR, which may be in text, graphics or other formats. See the \fBtixItemType(n)\fR manual page for more information about Tix display items. Individual cells, or groups of cells, can be formatted with a wide range of attributes, such as its color, relief and border.
+.SH "WIDGET COMMAND"
+.PP
+The \fBtixGrid\fR command creates a new Tcl command whose name is the same as the path name of the \fBtixGrid\fR widget's window. This command may be used to invoke various operations on the widget. It has the following general form:
+.DS C
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+\fIPathName\fR is the name of the command, which is the same as the \fBtixGrid\fR widget's path name. \fIOption\fR and the \fIarg\fRs determine the exact behavior of the command. The following commands are possible for \fBtixGrid\fR widgets:
+.TP
+\fIpathName\fR \fBanchor\fR \fIoption\fR \fR?\fIargs\fR \fI...\fR\fR?
+Manipulates the \fBanchor cell\fR of the \fBtixGrid\fR widget. The anchor cell is the end of the selection that is fixed while the user is dragging out a selection with the mouse.
+.TP
+\fIpathName\fR \fBbdtype\fR
+.TP
+\fIpathName\fR \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given by \fIoption\fR. \fIOption\fR may have any of the values accepted by the \fBtixGrid\fR command.
+.TP
+\fIpathName\fR \fBconfigure\fR \fR?\fIoption\fR\fR? \fR?\fIvalue\fR \fIoption\fR \fIvalue\fR \fI...\fR\fR?
+Query or modify the configuration options of the widget. If no \fIoption\fR is specified, returns a list describing all of the available options for \fIpathName\fR (see \fBTk_ConfigureInfo(n)\fR for information on the format of this list.) If \fIoption\fR is specified with no \fIvalue\fR, then the command returns a list describing the one named option (this list will be identical to the corresponding sublist of the value returned if no \fIoption\fR is specified). If one or more \fIoption\-value\fR pairs are specified, then the command modifies the given widget option(s) to have the given value(s); in this case the command returns an empty string. \fIOption\fR may have any of the values accepted by the \fBtixGrid\fR command.
+.TP
+\fIpathName\fR \fBdelete\fR \fIdim\fR \fIfrom\fR \fR?\fIto\fR\fR?
+\fIDim\fR may be \fBrow\fR or \fBcolumn\fR. If \fIto\fR is not given, deletes a single row (or column) at the position \fIfrom\fR. If \fIto\fR is given, deletes the range of rows (or columns) from position \fIfrom\fR through \fIto\fR.
+.TP
+\fIpathName\fR \fBedit apply\fR
+If any cell is being edited, de-highlight the cell and applies the changes.
+.TP
+\fIpathName\fR \fBedit set\fR \fIx\fR \fIy\fR
+Highlights the cell at (\fIx\fR,\fIy\fR) for editing, if the \fB-editnotify\fR command returns true for this cell.
+.TP
+\fIpathName\fR \fBentrycget\fR \fIx\fR \fIy\fR \fIoption\fR
+Returns the current value of the configuration option given by \fIoption\fR of the cell at (\fIx\fR,\fIy\fR). \fIOption\fR may have any of the values accepted by the \fBset\fR widget command.
+.TP
+\fIpathName\fR \fBentryconfigure\fR \fIx\fR \fIy\fR \fR?\fIoption\fR\fR? \fR?\fIvalue\fR \fIoption\fR \fIvalue\fR \fI...\fR\fR?
+Query or modify the configuration options of the cell at (\fIx\fR,\fIy\fR). If no \fIoption\fR is specified, returns a list describing all of the available options for the cell (see \fBTk_ConfigureInfo(n)\fR for information on the format of this list.) If \fIoption\fR is specified with no \fIvalue\fR, then the command returns a list describing the one named option (this list will be identical to the corresponding sublist of the value returned if no \fIoption\fR is specified.) If one or more \fIoption\-value\fR pairs are specified, then the command modifies the given widget option(s) to have the given value(s); in this case the command returns an empty string. \fIOption\fR may have any of the values accepted by the \fBset\fR widget command.
+.TP
+\fIpathName\fR \fBformat\fR
+.TP
+\fIpathName\fR \fBindex\fR
+.TP
+\fIpathName\fR \fBmove\fR \fIdim\fR \fIfrom\fR \fIto\fR \fIoffset\fR
+\fIDim\fR may be \fBrow\fR or \fBcolumn\fR. Moves the the range of rows (or columns) from position \fIfrom\fR through \fIto\fR by the distance indicated by \fIoffset\fR. For example, \fBmove\fR \fBrow\fR \fB2\fR \fB4\fR \fB1\fR moves the rows 2,3,4 to rows 3,4,5.
+.TP
+\fIpathName\fR \fBset\fR \fIx\fR \fIy\fR \fR?\fI\fB-itemtype\fR\fR \fItype\fR\fR? \fR?\fIoption\fR \fIvalue...\fR\fR?
+Creates a new display item at the cell at (\fIx\fR,\fIy\fR). The optional \fB-itemtype\fR parameter gives the type of the display item. An additional list of \fIoption-value\fR pairs specify options of the display item. If a display item already exists at this cell, the old item will be deleted automatically.
+.TP
+\fIpathName\fR \fBsize\fR \fIdim\fR \fIindex\fR \fR?\fIoption\fR \fIvalue\fR \fI...\fR\fR?
+Queries or sets the size of the row or column given by \fIdim\fR and \fIindex\fR. \fIDim\fR may be \fBrow\fR or \fBcolumn\fR. \fIIndex\fR may be any non-negative integer that gives the position of a given row (or column). \fIIndex\fR can also be the string \fBdefault\fR; in this case, this command queries or sets the default size of all rows (or columns).
+
+When no \fIoption\fR-\fIvalue\fR pair is given, this command returns a list containing the current size setting of the given row (or column). When \fIoption\fR-\fIvalue\fR pairs are given, the corresponding options of the size setting of the given row are changed. \fIOption\fR may be one of the follwing:
+.RS
+.TP
+\fB-pad0\fR \fIpixels\fR
+Specifies the paddings to the left or a column or the top of a row.
+.TP
+\fB-pad1\fR \fIpixels\fR
+Specifies the paddings to the right or a column or the bottom of a row.
+.TP
+\fB-size\fR \fIval\fR
+Specifies the width of a column or the height of a row. \fIVal\fR may be: \fBauto\fR -- the width of the column is set the the widest cell in the column; a valid Tk screen distance unit (see \fBTk_GetPixels(n)\fR); or a real number following by the word \fBchars\fR (e.g. \fB3.4chars\fR) that sets the width of the column to the given number of characters.
+.RE
+.TP
+\fIpathName\fR \fBunset\fR \fIx\fR \fIy\fR
+Clears the cell at (\fIx\fR,\fIy\fR) by removing its display item.
+.TP
+\fIpathName\fR \fBxview\fR
+.TP
+\fIpathName\fR \fByview\fR
+.DE
+
diff --git a/tix/man/HList.html b/tix/man/HList.html
new file mode 100644
index 00000000000..d2177f6c628
--- /dev/null
+++ b/tix/man/HList.html
@@ -0,0 +1,1087 @@
+
+
+
+<TITLE>tixHList - Create and manipulate Tix Hierarchial List widgets</TITLE>
+<Center><H2>tixHList - Create and manipulate Tix Hierarchial List widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixHList<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+None.
+</pre><H3>STANDARD OPTIONS</H3>
+<P>
+<pre><code><code><code>
+<B>background</B></I> <B>borderWidth</B></I> <B>cursor</B></I> <B>foreground</B></I>
+<B>font</B></I> <B>height</B></I> <B>highlightColor <B>highlightThickness
+<B>relief</B></I> <B>selectBackground</B></I> <B>selectForeground</B></I>
+<B>xScrollCommand</B></I> <B>yScrollCommand</B></I> <B>width</B></I>
+</code></code></code></pre>
+<P>
+See the <B>options(n)</B></I> manual entry for details on the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>browsecmd</B></I>
+Class: <B>BrowseCmd</B></I>
+Switch: <B>-browsecmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a TCL command to be executed when the user browses through the
+entries in the HList widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>columns</B></I>
+Class: <B>Columns</B></I>
+Switch: <B>-columns</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the number of columns in this HList widget. This option can
+only be set during the creation of the HList widget and cannot be
+changed subsequently.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>command</B></I>
+Class: <B>Command</B></I>
+Switch: <B>-command</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the TCL command to be executed when the user invokes a list
+entry in the HList widget. Normally the user invokes a list
+entry by double-clicking it or pressing the Return key.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>drawBranch</B></I>
+Class: <B>DrawBranch</B></I>
+Switch: <B>-drawbranch</B></I>
+</code></code></code></pre>
+<UL>
+A Boolean value to specify whether branch line should be drawn to
+connect list entries to their parents.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>foreground</B></I>
+Class: <B>Foreground</B></I>
+Switch: <B>-foreground</B></I>
+Alias: <B>-fg</B></I>
+</code></code></code></pre>
+<UL>
+<B>[OBSOLETE]</B></I> Specifies the default foreground color for the list entries.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>gap</B></I>
+Class: <B>Gap</B></I>
+Switch: <B>-gap</B></I>
+</code></code></code></pre>
+<UL>
+<B>[OBSOLETE]</B></I> The default distance between the bitmap/image and the
+text in list entries.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>header</B></I>
+Class: <B>Header</B></I>
+Switch: <B>-header</B></I>
+</code></code></code></pre>
+<UL>
+A Boolean value specifying whether headers should be displayed for
+this HList widget (see the <B>header</B></I> widget command below).
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>height</B></I>
+Class: <B>Height</B></I>
+Switch: <B>-height</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the desired height for the window in number of characters.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>indent</B></I>
+Class: <B>Indent</B></I>
+Switch: <B>-indent</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the amount of horizontal indentation between a list entry
+and its children. Must be a valid screen distance value.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>indicator</B></I>
+Class: <B>Indicator</B></I>
+Switch: <B>-indicator</B></I>
+</code></code></code></pre>
+<UL>
+Specifies whether the indicators should be displayed inside the HList
+widget. See the <B>indicator</B></I> widget command below.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>indicatorCmd</B></I>
+Class: <B>IndicatorCmd</B></I>
+Switch: <B>-indicatorcmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a TCL command to be executed when the user manipulates the
+indicator of an HList entry. The <B>-indicatorcmd</B></I> is triggered
+when the user press or releases the mouse button over the indicator in
+an HList entry. By default the TCL command specified by
+<B>-indicatorcmd</B></I> is executed with one additional argument, the
+entryPath of the entry whose indicator has been triggered. Additional
+information about the event can be obtained by the <B>tixEvent</B></I>
+command.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>itemType</B></I>
+Class: <B>ItemType</B></I>
+Switch: <B>-itemtype</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the default type of display item for this HList widget. When
+you call the add and addchild widget commands, display items of this
+type will be created if the <B>-itemtype</B></I> option is not specified .
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>padX</B></I>
+Class: <B>Pad</B></I>
+Switch: <B>-padx</B></I>
+</code></code></code></pre>
+<UL>
+<B>[OBSOLETE]</B></I> The default horizontal padding for list entries.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>padY</B></I>
+Class: <B>Pad</B></I>
+Switch: <B>-padx</B></I>
+</code></code></code></pre>
+<UL>
+<B>[OBSOLETE]</B></I> The default vertical padding for list entries.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>selectBackground</B></I>
+Class: <B>SelectBackground</B></I>
+Switch: <B>-selectbackground</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the background color for the selected list entries.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>selectBorderWidth</B></I>
+Class: <B>BorderWidth</B></I>
+Switch: <B>-selectborderwidth</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a non-negative value indicating the width of the 3-D border
+to draw around selected items. The value may have any of the forms
+acceptable to <B>Tk_GetPixels</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>selectForeground</B></I>
+Class: <B>SelectForeground</B></I>
+Switch: <B>-selectforeground</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the foreground color for the selected list entries.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>selectMode</B></I>
+Class: <B>SelectMode</B></I>
+Switch: <B>-selectmode</B></I>
+</code></code></code></pre>
+<UL>
+Specifies one of several styles for manipulating the selection. The
+value of the option may be arbitrary, but the default bindings expect
+it to be either <B>single</B></I>, <B>browse</B></I>, <B>multiple</B></I>, or
+<B>extended</B></I>; the default value is <B>single</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>sizeCmd</B></I>
+Class: <B>SizeCmd</B></I>
+Switch: <B>-sizecmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a TCL script to be called whenever the HList widget
+changes its size. This command can be useful to implement "user scroll
+bars when needed" features.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>separator</B></I>
+Class: <B>Separator</B></I>
+Switch: <B>-separator</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the character to used as the separator character when
+intepreting the path-names of list entries. By default the character
+"." is used.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>width</B></I>
+Class: <B>Width</B></I>
+Switch: <B>-width</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the desired width for the window in characters.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixHList</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a HList widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+HList widget such as its cursor and relief.
+<P>
+The HList widget can be used to display any data that have a
+hierarchical structure, for example, file system directory trees. The
+list entries are indented and connected by branch lines according to
+their places in the hierachy.
+<P>
+Each list entry is identified by an <B>entryPath</B></I>. The entryPath is a
+sequence of <B>entry names</B></I> separated by the separator charactor
+(specified by the <B>-separator</B></I> option). An <B>entry name</B></I> can be
+any string that does not contain the separator charactor, or it can be
+the a string that contains only one separator charactor.
+<P>
+For example, when "." is used as the separator charactor,
+"one.two.three" is the entryPath for a list entry whose parent is
+"one.two", whose parent is "one", which is a toplevel entry (has no
+parents).
+<P>
+Another examples: ".two.three" is the entryPath for a list entry whose
+parent is ".two", whose parent is ".", which is a toplevel entry.
+</pre><H3>DISPLAY ITEMS</H3>
+<P>
+Each list entry in an HList widget is associated with a <B>display
+item</B></I>. The display item determines what visual information should
+be displayed for this list entry. Please see the <B>DItem(n)</B></I> manual
+page for a list of all display items.
+
+When a list entry is created by the <B>add</B></I> or <B>addchild</B></I> widget
+commands, the type of its display item is determined by the
+<B>-itemtype</B></I> option passed to these commands. If the
+<B>-itemtype</B></I> is omitted, then by default the type specified by
+</pre><H3>WIDGET COMMAND</H3>
+<P>
+The <B>tixHList</B></I> command creates a new Tcl command whose name is the
+may be used to invoke various operations on the widget. It has the
+following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as
+determine the exact behavior of the command. The following
+commands are possible for HList widgets:
+<DL>
+<DT> <I>pathName <B>add<I> entryPath </I></B>?<I>option value ...</I></B>?
+</I></B>
+<DD> Creates a new list entry with the pathname <I>entryPath</I></B>. A list
+entry must be created after its parent is created (unless this entry
+is a top-level entry, which has no parent). This command returns the
+entryPath of the newly created list entry. The following
+configuration options can be given to configure the list entry:
+</DL>
+<UL>
+<DL>
+<DT> <B>-at<I> position</I></B>
+</I></B>
+<DD> Insert the new list at the position given by <I>position</I></B>.
+<I>position</I></B> must be a valid integer. the Position <B>0</B></I> indicates
+the first position, <B>1</B></I> indicates the second position, and so on.
+</DL>
+<DL>
+<DT> <B>-after<I> afterWhich</I></B>
+</I></B>
+<DD> Insert the new list entry after the entry identified by
+<I>afterWhich</I></B>. <I>afterWhich</I></B> must be a valid list entry and it
+mush have the same parent as the new list entry
+</DL>
+<DL>
+<DT> <B>-before<I> beforeWhich</I></B>
+</I></B>
+<DD> Insert the new list entry before the entry identified by
+<I>beforeWhich</I></B>. <I>beforeWhich</I></B> must be a valid list entry and it
+mush have the same parent as the new list entry
+</DL>
+<DL>
+<DT> <B>-data<I> string</I></B>
+</I></B>
+<DD> Specifies a string to associate with this list entry. This string can
+be queried by the <B>info</B></I> widget command. The application
+programmer can use the <B>-data</B></I> option to associate the list entry
+with the data it represents.
+</DL>
+<DL>
+<DT> <B>-itemtype<I> type</I></B>
+</I></B>
+<DD> Specifies the type of display item to be display for the new list
+entry. <B>type</B></I> must be a valid display item type. Currently the
+available display item types are <B>imagetext</B></I>, <B>text</B></I>, and
+<B>window</B></I>. If this option is not specified, then by default the
+</DL>
+<DL>
+<DT> <B>-state</B></I>
+</I></B>
+<DD> Specifies whether this entry can be selected or invoked by the user.
+Must be either <B>normal</B></I> or <B>disabled</B></I>.
+</DL>
+</UL>
+The <B>add</B></I> widget command accepts additional configuration options
+to configure the display item associated with this list entry. The set
+of additional configuration options depends on the type of the display
+item given by the <B>-itemtype</B></I> option. Please see the
+<B>DItem(n)</B></I> manual page for a list of the configuration options for
+each of the display item types.
+<DL>
+<DT> <I>pathName <B>addchild<I> parentPath </I></B>?<I>option value ... </I></B>?
+</I></B>
+<DD> Adds a new child entry to the children list of the list entry
+identified by <I>parentPath</I></B>. Or, if <I>parentPath</I></B> is set to be
+the empty string, then creates a new toplevel entry. The name of the
+new list entry will be a unique name automatically generated by the
+HList widget. Usually if <I>parentPath</I></B> is <B>foo</B></I>, then the
+entryPath of the new entry will be <B>foo.1</B></I>, <B>foo.2</B></I>, ... etc.
+This command returns the entryPath of the newly created list entry.
+<I>option</I></B> can be any option for the <B>add</B></I> widget command.
+</DL>
+<DL>
+<DT> <I>pathName <B>anchor set <I>entryPath</I></B>
+</I></B>
+<DD> Sets the anchor to the list entry identified by <I>entryPath</I></B>. The
+anchor is the end of the selection that is fixed while the user is
+dragging out a selection with the mouse.
+</DL>
+<DL>
+<DT> <I>pathName <B>anchor clear</B></I>
+</I></B>
+<DD> Removes the anchor, if any, from this HList widget. This only
+removes the surrounding highlights of the anchor entry and does not
+affect its selection status.
+</DL>
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixHList</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>column width <I>col</I></B> ?<I>-char</I></B>? ?<I>width</I></B>?
+</I></B>
+<DD> Querys or sets the width of a the column <I>col</I></B> in the HList
+widget. The value of <I>col</I></B> is zero-based: 0 stands for the first
+column, 1 stands for the second, and so on. If no further parameters
+are given, returns the current width of this column (in number of
+pixels). Additional parameters can be given to set the width of this
+column:
+</DL>
+<P>
+<UL>
+<DL>
+<DT> <I>pathName <B>column width <I>col</I></B> <B>{}</B></I>
+</I></B>
+<DD> An empty string indicates that the width of the column should be just
+wide enough to display the widest element in this column. In this
+case, the width of this column may change as a result of the elements
+in this column changing their sizes.
+</DL>
+<DL>
+<DT> <I>pathName <B>column width <I>col</I></B> <I>width</I></B>
+</I></B>
+<DD> <I>width</I></B> must be in a form accepted by <B>Tk_GetPixels(3)</B></I>.
+</DL>
+<DL>
+<DT> <I>pathName <B>column width <I>col</I></B> <B>-char</B></I> <I>nChars</I></B>
+</I></B>
+<DD> The width is set to be the average width occupied by <I>nChars</I></B>
+number of characters of the font specified by the <B>-font</B></I> option
+of this HList widget.
+</DL>
+</UL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixHList</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>delete</B></I> <I>option</I></B> ?<I>entryPath</I></B>?
+</I></B>
+<DD> Delete one or more list entries. <I>option</I></B> may be one of the
+following:
+</DL>
+<UL>
+<DL>
+<DT> <B>all</B></I>
+</I></B>
+<DD> Delete all entries in the HList. In this case the <I>entryPath</I></B>
+does not need to be specified.
+</DL>
+<DL>
+<DT> <B>entry</B></I>
+</I></B>
+<DD> Delete the entry specified by <I>entryPath</I></B> and all its offsprings,
+if any.
+</DL>
+<DL>
+<DT> <B>offsprings</B></I>
+</I></B>
+<DD> Delete all the offsprings, if any, of the entry specified by
+<I>entryPath</I></B>. However, <I>entryPath</I></B> itself is not deleted.
+</DL>
+<DL>
+<DT> <B>siblings</B></I>
+</I></B>
+<DD> Delete all the list entries that share the same parent with the entry
+specified by <I>entryPath</I></B>. However, <I>entryPath</I></B> itself is not
+deleted.
+</DL>
+</UL>
+<DL>
+<DT> <I>pathName <B>dragsite set <I>entryPath</I></B>
+</I></B>
+<DD> Sets the dragsite to the list entry identified by
+<I>entryPath</I></B>. The dragsite is used to indicate the source of a
+drag-and-drop action. Currently drag-and-drop functionality has not
+been implemented in Tix yet.
+</DL>
+<DL>
+<DT> <I>pathName <B>dragsite clear</B></I>
+</I></B>
+<DD> Remove the dragsite, if any, from the this HList widget. This only
+removes the surrounding highlights of the dragsite entry and does not
+affect its selection status.
+</DL>
+<DL>
+<DT> <I>pathName <B>dropsite set <I>entryPath</I></B>
+</I></B>
+<DD> Sets the dropsite to the list entry identified by <I>entryPath</I></B>. The
+dropsite is used to indicate the target of a grag-and-drop
+action. Currently drag-and-drop functionality has not been implemented
+in Tix yet.
+</DL>
+<DL>
+<DT> <I>pathName <B>dropsite clear</B></I>
+</I></B>
+<DD> Remove the dropsite, if any, from the this HList widget. This only
+removes the surrounding highlights of the dropsite entry and does not
+affect its selection status.
+</DL>
+<DL>
+<DT> <I>pathName <B>entrycget</B></I> <I> entryPath option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B> for the entry indentfied by <I>entryPath</I></B>. <I>Option</I></B>
+may have any of the values accepted by the <B>add</B></I> widget command.
+</DL>
+<DL>
+<DT> <I>pathName <B>entryconfigure<I> entryPath </I></B>?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the list entry indentfied
+by <I>entryPath</I></B>. If no <I>option</I></B> is specified, returns a list
+describing all of the available options for <I>entryPath</I></B> (see
+<B>Tk_ConfigureInfo</B></I> for information on the format of this list.) If
+<I>option</I></B> is specified with no <I>value</I></B>, then the command
+returns a list describing the one named option (this list will be
+identical to the corresponding sublist of the value returned if no
+<I>option</I></B> is specified). If one or more <I>option-value</I></B> pairs
+are specified, then the command modifies the given option(s) to have
+the given value(s); in this case the command returns an empty string.
+<I>Option</I></B> may have any of the values accepted by the <B>add</B></I> or
+<B>addchild</B></I> widget command. The exact set of options depends on the
+value of the <B>-itemtype</B></I> option passed to the the <B>add</B></I> or
+<B>addchild</B></I> widget command when this list entry is created.
+</DL>
+<DL>
+<DT> <I>pathName <B>header <I>option</I></B> <I>col</I></B> ?<I>args ...</I></B>?
+</I></B>
+<DD> Manipulates the header items of this HList widget. If the
+<B>-header</B></I> option of this HList widget is set to true, then a
+header item is displayed at the top of each column. The <I>col</I></B>
+argument for this command must be a valid integer. 0 indicates the
+first column, 1 the second column, ... and so on. This command
+supports the following options:
+</DL>
+<UL>
+<DL>
+<DT> <I>pathName <B>header <B>cget</B></I> <I>col</I></B> <I>option</I></B>
+</I></B>
+<DD> If the <I>col</I></B>-th column has a header display item, returns the
+value of the specified <I>option</I></B> of the header item. If the header
+</DL>
+<DL>
+<DT> <I>pathName <B>header <B>configure</B></I> <I>col</I></B> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the header display item
+of the <I>col</I></B>-th column. The header item must exist, or an error
+will result. If no <I>option</I></B> is specified, returns a list
+describing all of the available options for the header display item
+(see <B>Tk_ConfigureInfo(3)</B></I> for information on the format of this
+list.) If <I>option</I></B> is specified with no <I>value</I></B>, then the
+command returns a list describing the one named option (this list will
+be identical to the corresponding sublist of the value returned if no
+<I>option</I></B> is specified). If one or more <I>option-value</I></B> pairs
+are specified, then the command modifies the given option(s) to have
+the given value(s); in this case the command returns an empty
+string. <I>Option</I></B> may have any of the values accepted by the
+<B>header create</B></I> widget command. The exact set of options depends
+on the value of the <B>-itemtype</B></I> option passed to the the <B>header
+create</B></I> widget command when this display item was created.
+</DL>
+<DL>
+<DT> <I>pathName <B>header <B>create</B></I> <I>col</I></B> ?<I>-itemtype type</I></B>? ?<I>option value ...</I></B>?
+</I></B>
+<DD> Creates a new display item as the header for the <I>col</I></B>-th
+column. If an header display item already exists for this column, it
+will be replaced by the new item. An optional parameter
+<I>-itemtype</I></B> can be used to specify what type of display item
+should be created. If the <I>-itemtype</I></B> is not given, then by
+option is used. Additional parameters, in <I>option-value</I></B> pairs,
+can be passed to configure the appearance of the display item. Each
+<I>option-value</I></B> pair must be a valid option for this type of
+display item or one of the following:
+</DL>
+<UL>
+<DL>
+<DT> <B>-borderwidth</B></I>
+</I></B>
+<DD> Specifies the border width of this header item.
+</DL>
+<DL>
+<DT> <B>-headerbackground</B></I>
+</I></B>
+<DD> Specifies the background color of this header item.
+</DL>
+<DL>
+<DT> <B>-relief</B></I>
+</I></B>
+<DD> Specifies the relief type of the border of this header item.
+</DL>
+</UL>
+<DL>
+<DT> <I>pathName <B>header <B>delete <I>col</I></B>
+</I></B>
+<DD> Deletes the header display item for the <I>col</I></B>-th column.
+</DL>
+<DL>
+<DT> <I>pathName <B>header <B>exists <I>col</I></B>
+</I></B>
+<DD> Return true if an header display item exists for the <I>col</I></B>-th
+column; return false otherwise.
+</DL>
+<DL>
+<DT> <I>pathName <B>header <B>size <I>entryPath</I></B>
+</I></B>
+<DD> If an header display item exists for the <I>col</I></B>-th column , returns
+its size in a two element list of the form {<I>width height</I></B>};
+returns an error if the header display item does not exist.
+</DL>
+</UL>
+<DL>
+<DT> <I>pathName <B>hide <I>option ?entryPath?</I></B>
+</I></B>
+<DD> Makes some of entries invisible invisible without deleting them.
+<I>Option</I></B> can be one of the following:
+</DL>
+<UL>
+<DL>
+<DT> <B>entry</B></I>
+</I></B>
+<DD> Hides the list entry identified by <I>entryPath</I></B>.
+</DL>
+<P>
+Currently only the <B>entry</B></I> option is supported. Other options will
+be added in the next release.
+</UL>
+<DL>
+<DT> <I>pathName <B>indicator <I>option</I></B> entryPath ?<I>args ...</I></B>?
+</I></B>
+<DD> Manipulates the indicator on the list entries. An indicator is usually
+a small display item (such as an image) that is displayed to the left
+to an entry to indicate the status of the entry. For example, it may
+be used to indicator whether a directory is opened or
+closed. <I>option</I></B> can be one of the following:
+</DL>
+<UL>
+<DL>
+<DT> <I>pathName <B>indicator <B>cget</B></I> <I>entryPath</I></B> <I>option</I></B>
+</I></B>
+<DD> If the list entry given by <I>entryPath</I></B> has an indicator, returns
+the value of the specified <I>option</I></B> of the indicator. If the
+</DL>
+<DL>
+<DT> <I>pathName <B>indicator <B>configure</B></I> <I>entryPath</I></B> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the indicator display
+item of the entry specified by <I>entryPath</I></B>. The indicator item
+must exist, or an error will result. If no <I>option</I></B> is specified,
+returns a list describing all of the available options for the
+indicator display item (see <B>Tk_ConfigureInfo(3)</B></I> for information
+on the format of this list). If <I>option</I></B> is specified with no
+<I>value</I></B>, then the command returns a list describing the one named
+option (this list will be identical to the corresponding sublist of
+the value returned if no <I>option</I></B> is specified). If one or more
+<I>option-value</I></B> pairs are specified, then the command modifies the
+given option(s) to have the given value(s); in this case the command
+returns an empty string. <I>Option</I></B> may have any of the values
+accepted by the <B>indicator create</B></I> widget command. The exact set
+of options depends on the value of the <B>-itemtype</B></I> option passed
+to the the <B>indicator create</B></I> widget command when this display item
+was created.
+</DL>
+<DL>
+<DT> <I>pathName <B>indicator <B>create</B></I> <I>entryPath</I></B> ?<I>-itemtype type</I></B>? ?<I>option value ...</I></B>?
+</I></B>
+<DD> Creates a new display item as the indicator for the entry specified by
+<I>entryPath</I></B>. If an indicator display item already exists for this
+entry, it will be replaced by the new item. An optional parameter
+<I>-itemtype</I></B> can be used to specify what type of display item
+should be created. If the <I>-itemtype</I></B> is not given, then by
+option is used. Additional parameters, in <I>option-value</I></B> pairs,
+can be passed to configure the appearance of the display item. Each
+<I>option-value</I></B> pair must be a valid option for this type of
+display item.
+</DL>
+<DL>
+<DT> <I>pathName <B>indicator <B>delete <I>entryPath</I></B>
+</I></B>
+<DD> Deletes the indicator display item for the entry given by <I>entryPath</I></B>.
+</DL>
+<DL>
+<DT> <I>pathName <B>indicator <B>exists <I>entryPath</I></B>
+</I></B>
+<DD> Return true if an indicator display item exists for the entry given by
+<I>entryPath</I></B>; return false otherwise.
+</DL>
+<DL>
+<DT> <I>pathName <B>indicator <B>size <I>entryPath</I></B>
+</I></B>
+<DD> If an indicator display item exists for the entry given by
+<I>entryPath</I></B>, returns its size in a two element list of the form
+{<I>width height</I></B>}; returns an error if the indicator display item
+does not exist.
+</DL>
+</UL>
+<DL>
+<DT> <I>pathName <B>info <I>option</I></B> <I>arg ...</I></B>
+</I></B>
+<DD> Query information about the HList widget. <I>option</I></B> can be one
+of the following:
+</DL>
+<UL>
+<DL>
+<DT> <I>pathName <B>info <B>anchor</B></I>
+</I></B>
+<DD> Returns the entryPath of the current anchor, if any, of the HList
+widget. If the anchor is not set, returns the empty string.
+</DL>
+<DL>
+<DT> <I>pathName <B>info bbox</B></I> <I>entryPath</I></B>
+</I></B>
+<DD> Returns a list of four numbers describing the visible bounding box of
+the entry given <I>entryPath</I></B>. The first two elements of the list
+give the x and y coordinates of the upper-left corner of the screen
+area covered by the entry (specified in pixels relative to the widget)
+and the last two elements give the lower-right corner of the area, in
+pixels. If no part of the entry given by index is visible on the
+screen then the result is an empty string; if the entry is partially
+visible, the result gives the only the visible area of the entry.
+</DL>
+<DL>
+<DT> <I>pathName <B>info <B>children</B></I> ?<I>entryPath</I></B>?
+</I></B>
+<DD> children entries. Otherwise returns a list of the toplevel
+</DL>
+<DL>
+<DT> <I>pathName <B>info <B>data</B></I> ?<I>entryPath</I></B>?
+</I></B>
+<DD> Returns the data associated with <I>entryPath</I></B>.
+</DL>
+<DL>
+<DT> <I>pathName <B>info <B>dragsite</B></I>
+</I></B>
+<DD> Returns the entryPath of the current dragsite, if any, of the HList
+widget. If the dragsite is not set, returns the empty string.
+</DL>
+<DL>
+<DT> <I>pathName <B>info <B>dropsite</B></I>
+</I></B>
+<DD> Returns the entryPath of the current dropsite, if any, of the HList
+widget. If the dropsite is not set, returns the empty string.
+</DL>
+<DL>
+<DT> <I>pathName <B>info <B>exists</B></I> <I>entryPath</I></B>
+</I></B>
+<DD> Returns a boolean value indicating whether the list entry
+<I>entrpyPath</I></B> exists.
+</DL>
+<DL>
+<DT> <I>pathName <B>info <B>hidden</B></I> <I>entryPath</I></B>
+</I></B>
+<DD> Returns a boolean value indicating whether the list entry
+<B>entrpyPath</B></I> is hidden or not.
+</DL>
+<DL>
+<DT> <I>pathName <B>info <B>next</B></I> <I>entryPath</I></B>
+</I></B>
+<DD> Returns the entryPath of the list entry, if any, immediately below
+this list entry. If this entry is already at the bottom of the HList
+widget, returns an empty string.
+</DL>
+<DL>
+<DT> <I>pathName <B>info <B>parent</B></I> <I>entryPath</I></B>
+</I></B>
+<DD> Returns the name of the parent of the list entry identified by
+<I>entrpyPath</I></B>. If <I>entrpyPath</I></B> is a toplevel list entry,
+returns the empty string.
+</DL>
+<DL>
+<DT> <I>pathName <B>info <B>prev</B></I> <I>entryPath</I></B>
+</I></B>
+<DD> Returns the entryPath of the list entry, if any, immediately above
+this list entry. If this entry is already at the top of the HList
+widget, returns an empty string.
+</DL>
+<DL>
+<DT> <I>pathName <B>info <B>selection</B></I>
+</I></B>
+<DD> Returns a list of selected entries in the HList widget. If no entries
+are selectd, returns an empty string.
+</DL>
+</UL>
+<DL>
+<DT> <I>pathName <B>item <I>option</I></B> ?<I>args ...</I></B>?
+</I></B>
+<DD> Creates and configures the display items at individual columns the
+entries. The form of additional of arguments depends on the choice of
+<I>option</I></B>:
+</DL>
+<UL>
+<DL>
+<DT> <I>pathName <B>item <B>cget <I>entryPath col option</I></B>
+</I></B>
+<DD> Returns the current value of the configure <I>option</I></B> of the display
+item at the column designated by <I>col</I></B> of the entry specified by
+<I>entryPath</I></B>.
+</DL>
+<DL>
+<DT> <I>pathName <B>item configure <I>entryPath col</I></B> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the display item at the
+column designated by <I>col</I></B> of the entry specified by
+<I>entryPath</I></B>. If no <I>option</I></B> is specified, returns a list
+describing all of the available options for <I>entryPath</I></B> (see
+<B>Tk_ConfigureInfo(3)</B></I> for information on the format of this
+list). If <I>option</I></B> is specified with no <I>value</I></B>, then the
+command returns a list describing the one named option (this list will
+be identical to the corresponding sublist of the value returned if no
+<I>option</I></B> is specified). If one or more <I>option-value</I></B> pairs
+are specified, then the command modifies the given option(s) to have
+the given value(s); in this case the command returns an empty string.
+<I>Option</I></B> may have any of the values accepted by the <B>item
+create</B></I> widget command. The exact set of options depends on the
+value of the <B>-itemtype</B></I> option passed to the the <B>item
+create</B></I> widget command when this display item was created.
+</DL>
+<DL>
+<DT> <I>pathName <B>item create <I>entryPath col</I></B> ?<I>-itemtype type</I></B>? ?<I>option value ...</I></B>?
+</I></B>
+<DD> Creates a new display item at the column designated by <I>col</I></B> of
+the entry specified by <I>entryPath</I></B>. An optional parameter
+<I>-itemtype</I></B> can be used to specify what type of display items
+should be created. If the <I>-itemtype</I></B> is not specified, then by
+option is used. Additional parameters, in <I>option-value</I></B> pairs,
+can be passed to configure the appearance of the display item. Each
+<I>option- value</I></B> pair must be a valid option for this type of
+display item.
+</DL>
+<DL>
+<DT> <I>pathName <B>item delete <I>entryPath col</I></B>
+</I></B>
+<DD> Deletes the display item at the column designated by <I>col</I></B> of
+the entry specified by <I>entryPath</I></B>.
+</DL>
+<DL>
+<DT> <I>pathName <B>item exists <I>entryPath col</I></B>
+</I></B>
+<DD> Returns true if there is a display item at the column designated by
+<I>col</I></B> of the entry specified by <I>entryPath</I></B>; returns false
+otherwise.
+</DL>
+</UL>
+<DL>
+<DT> <I>pathName <B>nearest <I>y</I></B>
+</I></B>
+<DD> Given a y-coordinate within the HList window, this command returns
+the entryPath of the (visible) HList element nearest to that
+y-coordinate.
+</DL>
+<DL>
+<DT> <I>pathName <B>see <I>entryPath</I></B>
+</I></B>
+<DD> Adjust the view in the HList so that the entry given by <I>entryPath</I></B> is
+visible. If the entry is already visible then the command has no
+effect; if the entry is near one edge of the window then the HList
+scrolls to bring the element into view at the edge; otherwise the
+HList widget scrolls to center the entry.
+</DL>
+<DL>
+<DT> <I>pathName <B>selection <I>option</I></B> <I>arg ...</I></B>
+</I></B>
+<DD> This command is used to adjust the selection within a HList widget. It
+has several forms, depending on <I>option</I></B>:
+</DL>
+<UL>
+<DL>
+<DT> <I>pathName <B>selection clear </B></I>?<I>from</I></B>? ?<I>to</I></B>?
+</I></B>
+<DD> When no extra arguments are given, deselects all of the list entrie(s)
+in this HList widget. When only <I>from</I></B> is given, only the list
+entry identified by <I>from</I></B> is deselected. When both <I>from</I></B> and
+<I>to</I></B> are given, deselects all of the list entrie(s) between
+between <I>from</I></B> and <I>to</I></B>, inclusive, without affecting the
+selection state of entries outside that range.
+</DL>
+<DL>
+<DT> <I>pathName <B>selection get</B></I>
+</I></B>
+<DD> This is an alias for the <B>info selection</B></I> widget command.
+,
+</DL>
+<DL>
+<DT> <I>pathName <B>selection includes <I>entryPath</I></B>
+</I></B>
+<DD> Returns 1 if the list entry indicated by <I>entryPath</I></B> is currently
+selected; returns 0 otherwise.
+</DL>
+<DL>
+<DT> <I>pathName <B>selection set <I>from</I></B> ?<I>to</I></B>?
+</I></B>
+<DD> Selects all of the list entrie(s) between between <I>from</I></B> and
+<I>to</I></B>, inclusive, without affecting the selection state of entries
+outside that range. When only <I>from</I></B> is given, only the list entry
+identified by <I>from</I></B> is selected.
+</DL>
+</UL>
+<DL>
+<DT> <I>pathName <B>show <I>option ?entryPath?</I></B>
+</I></B>
+<DD> Show the entries that are hidden by the <B>hide</B></I> command,
+<I>option</I></B> can be one of the following:
+</DL>
+<UL>
+<DL>
+<DT> <B>entry</B></I>
+</I></B>
+<DD> Shows the list entry identified by <I>entryPath</I></B>.
+</DL>
+<P>
+Currently only the <B>entry</B></I> option is supported. Other options will
+be added in future releases.
+</UL>
+<DL>
+<DT> <I>pathName <B>xview <I>args</I></B>
+</I></B>
+<DD> This command is used to query and change the horizontal position of the
+forms:
+</DL>
+<UL>
+<DL>
+<DT> <I>pathName <B>xview</B></I>
+</I></B>
+<DD> Returns a list containing two elements. Each element is a real
+fraction between 0 and 1; together they describe the horizontal span
+that is visible in the window. For example, if the first element is
+</DL>
+
+off-screen to the left, the middle 40% is visible in the window, and
+40% of the entry is off-screen to the right. These are the same values
+passed to scrollbars via the <B>-xscrollcommand</B></I> option.
+<DL>
+<DT> <I>pathName <B>xview</B></I> <I>entryPath</I></B>
+</I></B>
+<DD> Adjusts the view in the window so that the list entry identified by
+<I>entryPath</I></B> is aligned to the left edge of the window.
+</DL>
+<DL>
+<DT> <I>pathName <B>xview moveto<I> fraction</I></B>
+</I></B>
+<DD> Adjusts the view in the window so that <I>fraction</I></B> of the total
+width of the HList is off-screen to the left. <I>fraction</I></B> must be
+a fraction between 0 and 1.
+</DL>
+<DL>
+<DT> <I>pathName <B>xview scroll <I>number what</I></B>
+</I></B>
+<DD> This command shifts the view in the window left or right according to
+<I>number</I></B> and <I>what</I></B>. <I>Number</I></B> must be an integer.
+<I>What</I></B> must be either <B>units</B></I> or <B>pages</B></I> or an
+abbreviation of one of these. If <I>what</I></B> is <B>units</B></I>, the view
+adjusts left or right by <I>number</I></B> character units (the width of
+the <B>0</B></I> character) on the display; if it is <B>pages</B></I> then the
+view adjusts by <I>number</I></B> screenfuls. If <I>number</I></B> is negative
+then characters farther to the left become visible; if it is positive
+then characters farther to the right become visible.
+</DL>
+</UL>
+<DL>
+<DT> <I>pathName <B>yview <I>?args</I></B>?
+</I></B>
+<DD> This command is used to query and change the vertical position of the
+</DL>
+<UL>
+<DL>
+<DT> <I>pathName <B>yview</B></I>
+</I></B>
+<DD> Returns a list containing two elements, both of which are real
+fractions between 0 and 1. The first element gives the position of
+the list element at the top of the window, relative to the HList as a
+whole (0.5 means it is halfway through the HList, for example). The
+second element gives the position of the list entry just after the
+last one in the window, relative to the HList as a whole. These are
+the same values passed to scrollbars via the <B>-yscrollcommand</B></I>
+option.
+</DL>
+<DL>
+<DT> <I>pathName <B>yview</B></I> <I>entryPath</I></B>
+</I></B>
+<DD> Adjusts the view in the window so that the list entry given by
+<I>entryPath</I></B> is displayed at the top of the window.
+</DL>
+<DL>
+<DT> <I>pathName <B>yview moveto<I> fraction</I></B>
+</I></B>
+<DD> Adjusts the view in the window so that the list entry given by
+<I>fraction</I></B> appears at the top of the window. <I>Fraction</I></B> is a
+fraction between 0 and 1; 0 indicates the first entry in the
+HList, 0.33 indicates the entry one-third the way through the
+HList, and so on.
+</DL>
+<DL>
+<DT> <I>pathName <B>yview scroll <I>number what</I></B>
+</I></B>
+<DD> This command adjust the view in the window up or down according to
+<I>number</I></B> and <I>what</I></B>. <I>Number</I></B> must be an integer.
+<I>What</I></B> must be either <B>units</B></I> or <B>pages</B></I>. If <I>what</I></B>
+is <B>units</B></I>, the view adjusts up or down by <I>number</I></B> lines; if
+it is <B>pages</B></I> then the view adjusts by <I>number</I></B> screenfuls.
+If <I>number</I></B> is negative then earlier entries become visible; if
+it is positive then later entries become visible.
+</DL>
+</UL>
+</pre><H3>BINDINGS</H3>
+<P>
+<UL>
+[1] <BR>
+If the <B>-selectmode</B></I> is "browse", when the user drags the mouse
+pointer over the list entries, the entry under the pointer will be
+highlighted and the <B>-browsecmd</B></I> procedure will be called with
+one parameter, the entryPath of the highlighted entry. Only one entry
+can be highlighted at a time. The <B>-command</B></I> procedure will be
+called when the user double-clicks on a list entry.
+</UL>
+<UL>
+[2] <BR>
+If the <B>-selectmode</B></I> is "single", the entries will only be
+highlighted by mouse &lt;ButtonRelease-1&gt; events. When a new list entry
+is highlighted, the <B>-browsecmd</B></I> procedure will be called with
+one parameter indicating the highlighted list entry. The
+<B>-command</B></I> procedure will be called when the user double-clicks
+on a list entry.
+</UL>
+<UL>
+[3] <BR>
+If the <B>-selectmode</B></I> is "multiple", when the user drags the mouse
+pointer over the list entries, all the entries under the pointer will
+be highlighted. However, only a contiguous region of list entries can
+be selected. When the highlighted area is changed, the
+<B>-browsecmd</B></I> procedure will be called with an undefined
+parameter. It is the responsibility of the <B>-browsecmd</B></I> procedure
+to find out the exact highlighted selection in the HList. The
+<B>-command</B></I> procedure will be called when the user double-clicks
+on a list entry.
+</UL>
+<UL>
+[4] <BR>
+If the <B>-selectmode</B></I> is "extended", when the user drags the mouse
+pointer over the list entries, all the entries under the pointer will
+be highlighted. The user can also make disjointed selections using
+&lt;Control-ButtonPress-1&gt;. When the highlighted area is changed, the
+<B>-browsecmd</B></I> procedure will be called with an undefined
+parameter. It is the responsibility of the <B>-browsecmd</B></I> procedure
+to find out the exact highlighted selection in the HList. The
+<B>-command</B></I> procedure will be called when the user double-clicks
+on a list entry.
+</UL>
+<UL>
+[5] <BR>
+<B>Arrow key bindings:</B></I> &lt;Up&gt; arrow key moves the anchor point to the
+item right on top of the current anchor item. &lt;Down&gt; arrow key moves
+the anchor point to the item right below the current anchor item.
+&lt;Left&gt; arrow key moves the anchor to the parent item of the current
+anchor item. &lt;Right&gt; moves the anchor to the first child of the
+current anchor item. If the current anchor item does not have any
+children, moves the anchor to the item right below the current anchor
+item.
+</UL>
+</pre><H3>EXAMPLE</H3>
+<P>
+This example demonstrates how to use an HList to store a file
+<P>
+\fC
+<pre><code><code><code>
+ tixHList .h -separator "/" -browsecmd browse -selectmode single \\
+ -itemtype text
+ .h add / -text /
+ .h add /home -text /home
+ .h add /home/ioi -text /home/ioi
+ .h add /home/foo -text /home/foo
+ .h add /usr -text /usr
+ .h add /usr/lib -text /usr/lib
+ pack .h
+
+ proc browse {file} {
+ puts "$file browsed"
+ }
+</code></code></code></pre>
+</B></I>
+</pre><H3>BUGS</H3>
+The fact that the display item at column 0 is implicitly associated
+with the whole entry is probably a design bug. This was done for
+backward compatibility purposes. The result is that there is a large
+overlap between the <B>item</B></I> command and the <B>add</B></I>,
+<B>addchild</B></I>, <B>entrycget</B></I> and <B>entryconfigure</B></I>
+commands. Whenever multiple columns exist, the programmer should use
+ONLY the <B>item</B></I> command to create and configure the display items
+in each column; the <B>add</B></I>, <B>addchild</B></I>, <B>entrycget</B></I> and
+<B>entryconfigure</B></I> should be used ONLY to create and configure
+entries.
+</pre><H3>KEYWORDS</H3>
+Tix(n), Hierarchical Listbox
+<hr><i>Last modified Sun Jan 19 22:34:30 EST 1997 </i> ---
+<i>Serial 853731301</i>
diff --git a/tix/man/HList.n b/tix/man/HList.n
new file mode 100644
index 00000000000..6d0db5c2340
--- /dev/null
+++ b/tix/man/HList.n
@@ -0,0 +1,1182 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixHList tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixHList \- Create and manipulate Tix Hierarchial List widgets
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixHList\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+None.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBborderWidth\fR \fBcursor\fR \fBforeground\fR
+\fBfont\fR \fBheight\fR \fBhighlightColor \fBhighlightThickness
+\fBrelief\fR \fBselectBackground\fR \fBselectForeground\fR
+\fBxScrollCommand\fR \fByScrollCommand\fR \fBwidth\fR
+.ta 4c
+.fi
+.LP
+See the \fBoptions(n)\fR manual entry for details on the standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBbrowsecmd\fR
+Class: \fBBrowseCmd\fR
+Switch: \fB\-browsecmd\fR
+.fi
+.IP
+Specifies a TCL command to be executed when the user browses through the
+entries in the HList widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcolumns\fR
+Class: \fBColumns\fR
+Switch: \fB\-columns\fR
+.fi
+.IP
+Specifies the number of columns in this HList widget. This option can
+only be set during the creation of the HList widget and cannot be
+changed subsequently.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Switch: \fB\-command\fR
+.fi
+.IP
+Specifies the TCL command to be executed when the user invokes a list
+entry in the HList widget. Normally the user invokes a list
+entry by double-clicking it or pressing the Return key.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdrawBranch\fR
+Class: \fBDrawBranch\fR
+Switch: \fB\-drawbranch\fR
+.fi
+.IP
+A Boolean value to specify whether branch line should be drawn to
+connect list entries to their parents.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBforeground\fR
+Class: \fBForeground\fR
+Switch: \fB\-foreground\fR
+Alias: \fB\-fg\fR
+.fi
+.IP
+\fB[OBSOLETE]\fR Specifies the default foreground color for the list entries.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBgap\fR
+Class: \fBGap\fR
+Switch: \fB\-gap\fR
+.fi
+.IP
+\fB[OBSOLETE]\fR The default distance between the bitmap/image and the
+text in list entries.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBheader\fR
+Class: \fBHeader\fR
+Switch: \fB\-header\fR
+.fi
+.IP
+A Boolean value specifying whether headers should be displayed for
+this HList widget (see the \fBheader\fR widget command below).
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Switch: \fB\-height\fR
+.fi
+.IP
+Specifies the desired height for the window in number of characters.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBindent\fR
+Class: \fBIndent\fR
+Switch: \fB\-indent\fR
+.fi
+.IP
+Specifies the amount of horizontal indentation between a list entry
+and its children. Must be a valid screen distance value.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBindicator\fR
+Class: \fBIndicator\fR
+Switch: \fB\-indicator\fR
+.fi
+.IP
+Specifies whether the indicators should be displayed inside the HList
+widget. See the \fBindicator\fR widget command below.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBindicatorCmd\fR
+Class: \fBIndicatorCmd\fR
+Switch: \fB\-indicatorcmd\fR
+.fi
+.IP
+Specifies a TCL command to be executed when the user manipulates the
+indicator of an HList entry. The \fB\-indicatorcmd\fR is triggered
+when the user press or releases the mouse button over the indicator in
+an HList entry. By default the TCL command specified by
+\fB\-indicatorcmd\fR is executed with one additional argument, the
+entryPath of the entry whose indicator has been triggered. Additional
+information about the event can be obtained by the \fBtixEvent\fR
+command.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBitemType\fR
+Class: \fBItemType\fR
+Switch: \fB\-itemtype\fR
+.fi
+.IP
+Specifies the default type of display item for this HList widget. When
+you call the add and addchild widget commands, display items of this
+type will be created if the \fB\-itemtype\fR option is not specified .
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBpadX\fR
+Class: \fBPad\fR
+Switch: \fB\-padx\fR
+.fi
+.IP
+\fB[OBSOLETE]\fR The default horizontal padding for list entries.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBpadY\fR
+Class: \fBPad\fR
+Switch: \fB\-padx\fR
+.fi
+.IP
+\fB[OBSOLETE]\fR The default vertical padding for list entries.
+'----------END
+'----------BEGIN
+.LP
+.nf
+Name: \fBselectBackground\fR
+Class: \fBSelectBackground\fR
+Switch: \fB\-selectbackground\fR
+.fi
+.IP
+Specifies the background color for the selected list entries.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBselectBorderWidth\fR
+Class: \fBBorderWidth\fR
+Switch: \fB\-selectborderwidth\fR
+.fi
+.IP
+Specifies a non-negative value indicating the width of the 3-D border
+to draw around selected items. The value may have any of the forms
+acceptable to \fBTk_GetPixels\fR.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBselectForeground\fR
+Class: \fBSelectForeground\fR
+Switch: \fB\-selectforeground\fR
+.fi
+.IP
+Specifies the foreground color for the selected list entries.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBselectMode\fR
+Class: \fBSelectMode\fR
+Switch: \fB\-selectmode\fR
+.fi
+.IP
+Specifies one of several styles for manipulating the selection. The
+value of the option may be arbitrary, but the default bindings expect
+it to be either \fBsingle\fR, \fBbrowse\fR, \fBmultiple\fR, or
+\fBextended\fR; the default value is \fBsingle\fR.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBsizeCmd\fR
+Class: \fBSizeCmd\fR
+Switch: \fB\-sizecmd\fR
+.fi
+.IP
+Specifies a TCL script to be called whenever the HList widget
+changes its size. This command can be useful to implement "user scroll
+bars when needed" features.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBseparator\fR
+Class: \fBSeparator\fR
+Switch: \fB\-separator\fR
+.fi
+.IP
+Specifies the character to used as the separator character when
+intepreting the path-names of list entries. By default the character
+"." is used.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Switch: \fB\-width\fR
+.fi
+.IP
+Specifies the desired width for the window in characters.
+'----------END
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixHList\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a HList widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+HList widget such as its cursor and relief.
+.PP
+The HList widget can be used to display any data that have a
+hierarchical structure, for example, file system directory trees. The
+list entries are indented and connected by branch lines according to
+their places in the hierachy.
+.PP
+Each list entry is identified by an \fBentryPath\fR. The entryPath is a
+sequence of \fBentry names\fR separated by the separator charactor
+(specified by the \fB\-separator\fR option). An \fBentry name\fR can be
+any string that does not contain the separator charactor, or it can be
+the a string that contains only one separator charactor.
+.PP
+For example, when "." is used as the separator charactor,
+"one.two.three" is the entryPath for a list entry whose parent is
+"one.two", whose parent is "one", which is a toplevel entry (has no
+parents).
+.PP
+Another examples: ".two.three" is the entryPath for a list entry whose
+parent is ".two", whose parent is ".", which is a toplevel entry.
+'
+.SH "DISPLAY ITEMS"
+.PP
+Each list entry in an HList widget is associated with a \fBdisplay
+item\fR. The display item determines what visual information should
+be displayed for this list entry. Please see the \fBDItem(n)\fR manual
+page for a list of all display items.
+
+When a list entry is created by the \fBadd\fR or \fBaddchild\fR widget
+commands, the type of its display item is determined by the
+\fB\-itemtype\fR option passed to these commands. If the
+\fB\-itemtype\fR is omitted, then by default the type specified by
+this HList widget's \fB\-itemtype\fR option is used.
+'----------------------------------------------------------------------
+.SH "WIDGET COMMAND"
+.PP
+'
+The \fBtixHList\fR command creates a new Tcl command whose name is the
+same as the path name of the HList widget's window. This command
+may be used to invoke various operations on the widget. It has the
+following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as
+the HList widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for HList widgets:
+'
+.TP
+\fIpathName \fBadd\fI entryPath \fR?\fIoption value ...\fR?
+'
+Creates a new list entry with the pathname \fIentryPath\fR. A list
+entry must be created after its parent is created (unless this entry
+is a top-level entry, which has no parent). This command returns the
+entryPath of the newly created list entry. The following
+configuration options can be given to configure the list entry:
+'
+.RS
+'
+.TP
+\fB\-at\fI position\fR
+'
+Insert the new list at the position given by \fIposition\fR.
+\fIposition\fR must be a valid integer. the Position \fB0\fR indicates
+the first position, \fB1\fR indicates the second position, and so on.
+'
+.TP
+\fB\-after\fI afterWhich\fR
+'
+Insert the new list entry after the entry identified by
+\fIafterWhich\fR. \fIafterWhich\fR must be a valid list entry and it
+mush have the same parent as the new list entry
+'
+.TP
+\fB\-before\fI beforeWhich\fR
+'
+Insert the new list entry before the entry identified by
+\fIbeforeWhich\fR. \fIbeforeWhich\fR must be a valid list entry and it
+mush have the same parent as the new list entry
+'
+.TP
+\fB\-data\fI string\fR
+'
+Specifies a string to associate with this list entry. This string can
+be queried by the \fBinfo\fR widget command. The application
+programmer can use the \fB\-data\fR option to associate the list entry
+with the data it represents.
+'
+.TP
+\fB\-itemtype\fI type\fR
+'
+Specifies the type of display item to be display for the new list
+entry. \fBtype\fR must be a valid display item type. Currently the
+available display item types are \fBimagetext\fR, \fBtext\fR, and
+\fBwindow\fR. If this option is not specified, then by default the
+type specified by this HList widget's \fB\-itemtype\fR option is used.
+'
+.TP
+\fB\-state\fR
+'
+Specifies whether this entry can be selected or invoked by the user.
+Must be either \fBnormal\fR or \fBdisabled\fR.
+'
+.RE
+'
+The \fBadd\fR widget command accepts additional configuration options
+to configure the display item associated with this list entry. The set
+of additional configuration options depends on the type of the display
+item given by the \fB\-itemtype\fR option. Please see the
+\fBDItem(n)\fR manual page for a list of the configuration options for
+each of the display item types.
+'
+.TP
+\fIpathName \fBaddchild\fI parentPath \fR?\fIoption value ... \fR?
+'
+Adds a new child entry to the children list of the list entry
+identified by \fIparentPath\fR. Or, if \fIparentPath\fR is set to be
+the empty string, then creates a new toplevel entry. The name of the
+new list entry will be a unique name automatically generated by the
+HList widget. Usually if \fIparentPath\fR is \fBfoo\fR, then the
+entryPath of the new entry will be \fBfoo.1\fR, \fBfoo.2\fR, ... etc.
+This command returns the entryPath of the newly created list entry.
+\fIoption\fR can be any option for the \fBadd\fR widget command.
+'
+.TP
+\fIpathName \fBanchor set \fIentryPath\fR
+'
+Sets the anchor to the list entry identified by \fIentryPath\fR. The
+anchor is the end of the selection that is fixed while the user is
+dragging out a selection with the mouse.
+'
+.TP
+\fIpathName \fBanchor clear\fR
+'
+Removes the anchor, if any, from this HList widget. This only
+removes the surrounding highlights of the anchor entry and does not
+affect its selection status.
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixHList\fR command.
+'
+.TP
+'
+\fIpathName \fBcolumn width \fIcol\fR ?\fI\-char\fR? ?\fIwidth\fR?
+'
+Querys or sets the width of a the column \fIcol\fR in the HList
+widget. The value of \fIcol\fR is zero-based: 0 stands for the first
+column, 1 stands for the second, and so on. If no further parameters
+are given, returns the current width of this column (in number of
+pixels). Additional parameters can be given to set the width of this
+column:
+.PP
+.RS
+.TP
+\fIpathName \fBcolumn width \fIcol\fR \fB{}\fR
+'
+An empty string indicates that the width of the column should be just
+wide enough to display the widest element in this column. In this
+case, the width of this column may change as a result of the elements
+in this column changing their sizes.
+'
+.TP
+\fIpathName \fBcolumn width \fIcol\fR \fIwidth\fR
+'
+\fIwidth\fR must be in a form accepted by \fBTk_GetPixels(3)\fR.
+'
+.TP
+\fIpathName \fBcolumn width \fIcol\fR \fB-char\fR \fInChars\fR
+'
+The width is set to be the average width occupied by \fInChars\fR
+number of characters of the font specified by the \fB\-font\fR option
+of this HList widget.
+'
+.RE
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixHList\fR command.
+'
+.TP
+\fIpathName \fBdelete\fR \fIoption\fR ?\fIentryPath\fR?
+Delete one or more list entries. \fIoption\fR may be one of the
+following:
+.RS
+.TP
+\fBall\fR
+Delete all entries in the HList. In this case the \fIentryPath\fR
+does not need to be specified.
+'
+.TP
+\fBentry\fR
+Delete the entry specified by \fIentryPath\fR and all its offsprings,
+if any.
+'
+.TP
+\fBoffsprings\fR
+Delete all the offsprings, if any, of the entry specified by
+\fIentryPath\fR. However, \fIentryPath\fR itself is not deleted.
+'
+.TP
+\fBsiblings\fR
+Delete all the list entries that share the same parent with the entry
+specified by \fIentryPath\fR. However, \fIentryPath\fR itself is not
+deleted.
+.RE
+'
+'
+.TP
+\fIpathName \fBdragsite set \fIentryPath\fR
+'
+Sets the dragsite to the list entry identified by
+\fIentryPath\fR. The dragsite is used to indicate the source of a
+drag-and-drop action. Currently drag-and-drop functionality has not
+been implemented in Tix yet.
+'
+.TP
+\fIpathName \fBdragsite clear\fR
+Remove the dragsite, if any, from the this HList widget. This only
+removes the surrounding highlights of the dragsite entry and does not
+affect its selection status.
+'
+'
+.TP
+\fIpathName \fBdropsite set \fIentryPath\fR
+'
+Sets the dropsite to the list entry identified by \fIentryPath\fR. The
+dropsite is used to indicate the target of a grag-and-drop
+action. Currently drag-and-drop functionality has not been implemented
+in Tix yet.
+'
+.TP
+\fIpathName \fBdropsite clear\fR
+'
+Remove the dropsite, if any, from the this HList widget. This only
+removes the surrounding highlights of the dropsite entry and does not
+affect its selection status.
+'
+.TP
+\fIpathName \fBentrycget\fR \fI entryPath option\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR for the entry indentfied by \fIentryPath\fR. \fIOption\fR
+may have any of the values accepted by the \fBadd\fR widget command.
+'
+.TP
+\fIpathName \fBentryconfigure\fI entryPath \fR?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the list entry indentfied
+by \fIentryPath\fR. If no \fIoption\fR is specified, returns a list
+describing all of the available options for \fIentryPath\fR (see
+\fBTk_ConfigureInfo\fR for information on the format of this list.) If
+\fIoption\fR is specified with no \fIvalue\fR, then the command
+returns a list describing the one named option (this list will be
+identical to the corresponding sublist of the value returned if no
+\fIoption\fR is specified). If one or more \fIoption\-value\fR pairs
+are specified, then the command modifies the given option(s) to have
+the given value(s); in this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBadd\fR or
+\fBaddchild\fR widget command. The exact set of options depends on the
+value of the \fB\-itemtype\fR option passed to the the \fBadd\fR or
+\fBaddchild\fR widget command when this list entry is created.
+'
+'
+.TP
+\fIpathName \fBheader \fIoption\fR \fIcol\fR ?\fIargs ...\fR?
+'
+Manipulates the header items of this HList widget. If the
+\fB\-header\fR option of this HList widget is set to true, then a
+header item is displayed at the top of each column. The \fIcol\fR
+argument for this command must be a valid integer. 0 indicates the
+first column, 1 the second column, ... and so on. This command
+supports the following options:
+'
+.RS
+.TP
+\fIpathName \fBheader \fBcget\fR \fIcol\fR \fIoption\fR
+'
+If the \fIcol\fR-th column has a header display item, returns the
+value of the specified \fIoption\fR of the header item. If the header
+doesn't exist, returns an error.
+'
+.TP
+\fIpathName \fBheader \fBconfigure\fR \fIcol\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the header display item
+of the \fIcol\fR-th column. The header item must exist, or an error
+will result. If no \fIoption\fR is specified, returns a list
+describing all of the available options for the header display item
+(see \fBTk_ConfigureInfo(3)\fR for information on the format of this
+list.) If \fIoption\fR is specified with no \fIvalue\fR, then the
+command returns a list describing the one named option (this list will
+be identical to the corresponding sublist of the value returned if no
+\fIoption\fR is specified). If one or more \fIoption\-value\fR pairs
+are specified, then the command modifies the given option(s) to have
+the given value(s); in this case the command returns an empty
+string. \fIOption\fR may have any of the values accepted by the
+\fBheader create\fR widget command. The exact set of options depends
+on the value of the \fB\-itemtype\fR option passed to the the \fBheader
+create\fR widget command when this display item was created.
+'
+.TP
+\fIpathName \fBheader \fBcreate\fR \fIcol\fR ?\fI\-itemtype type\fR? ?\fIoption value ...\fR?
+'
+Creates a new display item as the header for the \fIcol\fR-th
+column. If an header display item already exists for this column, it
+will be replaced by the new item. An optional parameter
+\fI\-itemtype\fR can be used to specify what type of display item
+should be created. If the \fI\-itemtype\fR is not given, then by
+default the type specified by this HList widget's \fB\-itemtype\fR
+option is used. Additional parameters, in \fIoption-value\fR pairs,
+can be passed to configure the appearance of the display item. Each
+\fIoption-value\fR pair must be a valid option for this type of
+display item or one of the following:
+.RS
+'
+.TP
+\fB\-borderwidth\fR
+'
+Specifies the border width of this header item.
+'
+.TP
+\fB\-headerbackground\fR
+'
+Specifies the background color of this header item.
+'
+.TP
+\fB\-relief\fR
+'
+Specifies the relief type of the border of this header item.
+'
+.RE
+'
+.TP
+\fIpathName \fBheader \fBdelete \fIcol\fR
+'
+Deletes the header display item for the \fIcol\fR-th column.
+'
+.TP
+\fIpathName \fBheader \fBexists \fIcol\fR
+'
+Return true if an header display item exists for the \fIcol\fR-th
+column; return false otherwise.
+'
+.TP
+\fIpathName \fBheader \fBsize \fIentryPath\fR
+'
+If an header display item exists for the \fIcol\fR-th column , returns
+its size in a two element list of the form {\fIwidth height\fR};
+returns an error if the header display item does not exist.
+'
+.RE
+'
+.TP
+\fIpathName \fBhide \fIoption ?entryPath?\fR
+'
+Makes some of entries invisible invisible without deleting them.
+\fIOption\fR can be one of the following:
+.RS
+.TP
+\fBentry\fR
+Hides the list entry identified by \fIentryPath\fR.
+.PP
+Currently only the \fBentry\fR option is supported. Other options will
+be added in the next release.
+.RE
+'
+.TP
+\fIpathName \fBindicator \fIoption\fR entryPath ?\fIargs ...\fR?
+'
+Manipulates the indicator on the list entries. An indicator is usually
+a small display item (such as an image) that is displayed to the left
+to an entry to indicate the status of the entry. For example, it may
+be used to indicator whether a directory is opened or
+closed. \fIoption\fR can be one of the following:
+'
+.RS
+.TP
+\fIpathName \fBindicator \fBcget\fR \fIentryPath\fR \fIoption\fR
+'
+If the list entry given by \fIentryPath\fR has an indicator, returns
+the value of the specified \fIoption\fR of the indicator. If the
+indicator doesn't exist, returns an error.
+'
+.TP
+\fIpathName \fBindicator \fBconfigure\fR \fIentryPath\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the indicator display
+item of the entry specified by \fIentryPath\fR. The indicator item
+must exist, or an error will result. If no \fIoption\fR is specified,
+returns a list describing all of the available options for the
+indicator display item (see \fBTk_ConfigureInfo(3)\fR for information
+on the format of this list). If \fIoption\fR is specified with no
+\fIvalue\fR, then the command returns a list describing the one named
+option (this list will be identical to the corresponding sublist of
+the value returned if no \fIoption\fR is specified). If one or more
+\fIoption\-value\fR pairs are specified, then the command modifies the
+given option(s) to have the given value(s); in this case the command
+returns an empty string. \fIOption\fR may have any of the values
+accepted by the \fBindicator create\fR widget command. The exact set
+of options depends on the value of the \fB\-itemtype\fR option passed
+to the the \fBindicator create\fR widget command when this display item
+was created.
+'
+.TP
+\fIpathName \fBindicator \fBcreate\fR \fIentryPath\fR ?\fI\-itemtype type\fR? ?\fIoption value ...\fR?
+'
+Creates a new display item as the indicator for the entry specified by
+\fIentryPath\fR. If an indicator display item already exists for this
+entry, it will be replaced by the new item. An optional parameter
+\fI\-itemtype\fR can be used to specify what type of display item
+should be created. If the \fI\-itemtype\fR is not given, then by
+default the type specified by this HList widget's \fB\-itemtype\fR
+option is used. Additional parameters, in \fIoption-value\fR pairs,
+can be passed to configure the appearance of the display item. Each
+\fIoption-value\fR pair must be a valid option for this type of
+display item.
+'
+.TP
+\fIpathName \fBindicator \fBdelete \fIentryPath\fR
+'
+Deletes the indicator display item for the entry given by \fIentryPath\fR.
+'
+.TP
+\fIpathName \fBindicator \fBexists \fIentryPath\fR
+'
+Return true if an indicator display item exists for the entry given by
+\fIentryPath\fR; return false otherwise.
+'
+.TP
+\fIpathName \fBindicator \fBsize \fIentryPath\fR
+'
+If an indicator display item exists for the entry given by
+\fIentryPath\fR, returns its size in a two element list of the form
+{\fIwidth height\fR}; returns an error if the indicator display item
+does not exist.
+'
+.RE
+'
+.TP
+\fIpathName \fBinfo \fIoption\fR \fIarg ...\fR
+'
+Query information about the HList widget. \fIoption\fR can be one
+of the following:
+.RS
+.TP
+\fIpathName \fBinfo \fBanchor\fR
+'
+Returns the entryPath of the current anchor, if any, of the HList
+widget. If the anchor is not set, returns the empty string.
+'
+.TP
+\fIpathName \fBinfo bbox\fR \fIentryPath\fR
+'
+Returns a list of four numbers describing the visible bounding box of
+the entry given \fIentryPath\fR. The first two elements of the list
+give the x and y coordinates of the upper-left corner of the screen
+area covered by the entry (specified in pixels relative to the widget)
+and the last two elements give the lower-right corner of the area, in
+pixels. If no part of the entry given by index is visible on the
+screen then the result is an empty string; if the entry is partially
+visible, the result gives the only the visible area of the entry.
+'
+.TP
+\fIpathName \fBinfo \fBchildren\fR ?\fIentryPath\fR?
+'
+If \fIentrpyPath\fR is given, returns a list of the entryPath's of its
+children entries. Otherwise returns a list of the toplevel
+entryPath's.
+'
+.TP
+\fIpathName \fBinfo \fBdata\fR ?\fIentryPath\fR?
+'
+Returns the data associated with \fIentryPath\fR.
+'
+.TP
+\fIpathName \fBinfo \fBdragsite\fR
+'
+Returns the entryPath of the current dragsite, if any, of the HList
+widget. If the dragsite is not set, returns the empty string.
+'
+.TP
+\fIpathName \fBinfo \fBdropsite\fR
+'
+Returns the entryPath of the current dropsite, if any, of the HList
+widget. If the dropsite is not set, returns the empty string.
+'
+.TP
+\fIpathName \fBinfo \fBexists\fR \fIentryPath\fR
+Returns a boolean value indicating whether the list entry
+\fIentrpyPath\fR exists.
+'
+.TP
+\fIpathName \fBinfo \fBhidden\fR \fIentryPath\fR
+'
+Returns a boolean value indicating whether the list entry
+\fBentrpyPath\fR is hidden or not.
+'
+.TP
+\fIpathName \fBinfo \fBnext\fR \fIentryPath\fR
+Returns the entryPath of the list entry, if any, immediately below
+this list entry. If this entry is already at the bottom of the HList
+widget, returns an empty string.
+'
+.TP
+\fIpathName \fBinfo \fBparent\fR \fIentryPath\fR
+Returns the name of the parent of the list entry identified by
+\fIentrpyPath\fR. If \fIentrpyPath\fR is a toplevel list entry,
+returns the empty string.
+'
+.TP
+\fIpathName \fBinfo \fBprev\fR \fIentryPath\fR
+'
+Returns the entryPath of the list entry, if any, immediately above
+this list entry. If this entry is already at the top of the HList
+widget, returns an empty string.
+'
+.TP
+\fIpathName \fBinfo \fBselection\fR
+'
+Returns a list of selected entries in the HList widget. If no entries
+are selectd, returns an empty string.
+.RE
+'
+.TP
+\fIpathName \fBitem \fIoption\fR ?\fIargs ...\fR?
+'
+Creates and configures the display items at individual columns the
+entries. The form of additional of arguments depends on the choice of
+\fIoption\fR:
+'
+.RS
+'
+.TP
+\fIpathName \fBitem \fBcget \fIentryPath col option\fR
+'
+'
+Returns the current value of the configure \fIoption\fR of the display
+item at the column designated by \fIcol\fR of the entry specified by
+\fIentryPath\fR.
+'
+.TP
+\fIpathName \fBitem configure \fIentryPath col\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the display item at the
+column designated by \fIcol\fR of the entry specified by
+\fIentryPath\fR. If no \fIoption\fR is specified, returns a list
+describing all of the available options for \fIentryPath\fR (see
+\fBTk_ConfigureInfo(3)\fR for information on the format of this
+list). If \fIoption\fR is specified with no \fIvalue\fR, then the
+command returns a list describing the one named option (this list will
+be identical to the corresponding sublist of the value returned if no
+\fIoption\fR is specified). If one or more \fIoption\-value\fR pairs
+are specified, then the command modifies the given option(s) to have
+the given value(s); in this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBitem
+create\fR widget command. The exact set of options depends on the
+value of the \fB\-itemtype\fR option passed to the the \fBitem
+create\fR widget command when this display item was created.
+'
+.TP
+\fIpathName \fBitem create \fIentryPath col\fR ?\fI\-itemtype type\fR? ?\fIoption value ...\fR?
+'
+'
+Creates a new display item at the column designated by \fIcol\fR of
+the entry specified by \fIentryPath\fR. An optional parameter
+\fI\-itemtype\fR can be used to specify what type of display items
+should be created. If the \fI\-itemtype\fR is not specified, then by
+default the type specified by this HList widget's \fB\-itemtype\fR
+option is used. Additional parameters, in \fIoption-value\fR pairs,
+can be passed to configure the appearance of the display item. Each
+\fIoption- value\fR pair must be a valid option for this type of
+display item.
+'
+.TP
+\fIpathName \fBitem delete \fIentryPath col\fR
+'
+Deletes the display item at the column designated by \fIcol\fR of
+the entry specified by \fIentryPath\fR.
+'
+.TP
+\fIpathName \fBitem exists \fIentryPath col\fR
+'
+Returns true if there is a display item at the column designated by
+\fIcol\fR of the entry specified by \fIentryPath\fR; returns false
+otherwise.
+'
+.RE
+'
+.TP
+\fIpathName \fBnearest \fIy\fR
+'
+Given a y-coordinate within the HList window, this command returns
+the entryPath of the (visible) HList element nearest to that
+y-coordinate.
+'
+'
+.TP
+\fIpathName \fBsee \fIentryPath\fR
+'
+Adjust the view in the HList so that the entry given by \fIentryPath\fR is
+visible. If the entry is already visible then the command has no
+effect; if the entry is near one edge of the window then the HList
+scrolls to bring the element into view at the edge; otherwise the
+HList widget scrolls to center the entry.
+'
+.TP
+\fIpathName \fBselection \fIoption\fR \fIarg ...\fR
+'
+This command is used to adjust the selection within a HList widget. It
+has several forms, depending on \fIoption\fR:
+.RS
+'
+.TP
+\fIpathName \fBselection clear \fR?\fIfrom\fR? ?\fIto\fR?
+'
+When no extra arguments are given, deselects all of the list entrie(s)
+in this HList widget. When only \fIfrom\fR is given, only the list
+entry identified by \fIfrom\fR is deselected. When both \fIfrom\fR and
+\fIto\fR are given, deselects all of the list entrie(s) between
+between \fIfrom\fR and \fIto\fR, inclusive, without affecting the
+selection state of entries outside that range.
+'
+.TP
+\fIpathName \fBselection get\fR
+'
+This is an alias for the \fBinfo selection\fR widget command.
+,
+.TP
+\fIpathName \fBselection includes \fIentryPath\fR
+'
+Returns 1 if the list entry indicated by \fIentryPath\fR is currently
+selected; returns 0 otherwise.
+'
+.TP
+\fIpathName \fBselection set \fIfrom\fR ?\fIto\fR?
+'
+Selects all of the list entrie(s) between between \fIfrom\fR and
+\fIto\fR, inclusive, without affecting the selection state of entries
+outside that range. When only \fIfrom\fR is given, only the list entry
+identified by \fIfrom\fR is selected.
+.RE
+'
+.TP
+\fIpathName \fBshow \fIoption ?entryPath?\fR
+'
+Show the entries that are hidden by the \fBhide\fR command,
+\fIoption\fR can be one of the following:
+.RS
+.TP
+\fBentry\fR
+Shows the list entry identified by \fIentryPath\fR.
+.PP
+Currently only the \fBentry\fR option is supported. Other options will
+be added in future releases.
+.RE
+'
+.TP
+\fIpathName \fBxview \fIargs\fR
+This command is used to query and change the horizontal position of the
+information in the widget's window. It can take any of the following
+forms:
+.RS
+.TP
+\fIpathName \fBxview\fR
+'
+Returns a list containing two elements. Each element is a real
+fraction between 0 and 1; together they describe the horizontal span
+that is visible in the window. For example, if the first element is
+.2 and the second element is .6, 20% of the HList entry is
+off-screen to the left, the middle 40% is visible in the window, and
+40% of the entry is off-screen to the right. These are the same values
+passed to scrollbars via the \fB\-xscrollcommand\fR option.
+.TP
+\fIpathName \fBxview\fR \fIentryPath\fR
+'
+Adjusts the view in the window so that the list entry identified by
+\fIentryPath\fR is aligned to the left edge of the window.
+.TP
+\fIpathName \fBxview moveto\fI fraction\fR
+'
+Adjusts the view in the window so that \fIfraction\fR of the total
+width of the HList is off-screen to the left. \fIfraction\fR must be
+a fraction between 0 and 1.
+'
+.TP
+\fIpathName \fBxview scroll \fInumber what\fR
+'
+This command shifts the view in the window left or right according to
+\fInumber\fR and \fIwhat\fR. \fINumber\fR must be an integer.
+\fIWhat\fR must be either \fBunits\fR or \fBpages\fR or an
+abbreviation of one of these. If \fIwhat\fR is \fBunits\fR, the view
+adjusts left or right by \fInumber\fR character units (the width of
+the \fB0\fR character) on the display; if it is \fBpages\fR then the
+view adjusts by \fInumber\fR screenfuls. If \fInumber\fR is negative
+then characters farther to the left become visible; if it is positive
+then characters farther to the right become visible.
+'
+.RE
+'
+.TP
+\fIpathName \fByview \fI?args\fR?
+'
+This command is used to query and change the vertical position of the
+entries in the widget's window. It can take any of the following forms:
+'
+.RS
+.TP
+\fIpathName \fByview\fR
+'
+Returns a list containing two elements, both of which are real
+fractions between 0 and 1. The first element gives the position of
+the list element at the top of the window, relative to the HList as a
+whole (0.5 means it is halfway through the HList, for example). The
+second element gives the position of the list entry just after the
+last one in the window, relative to the HList as a whole. These are
+the same values passed to scrollbars via the \fB\-yscrollcommand\fR
+option.
+'
+.TP
+\fIpathName \fByview\fR \fIentryPath\fR
+'
+Adjusts the view in the window so that the list entry given by
+\fIentryPath\fR is displayed at the top of the window.
+'
+.TP
+\fIpathName \fByview moveto\fI fraction\fR
+'
+Adjusts the view in the window so that the list entry given by
+\fIfraction\fR appears at the top of the window. \fIFraction\fR is a
+fraction between 0 and 1; 0 indicates the first entry in the
+HList, 0.33 indicates the entry one-third the way through the
+HList, and so on.
+.TP
+\fIpathName \fByview scroll \fInumber what\fR
+'
+This command adjust the view in the window up or down according to
+\fInumber\fR and \fIwhat\fR. \fINumber\fR must be an integer.
+\fIWhat\fR must be either \fBunits\fR or \fBpages\fR. If \fIwhat\fR
+is \fBunits\fR, the view adjusts up or down by \fInumber\fR lines; if
+it is \fBpages\fR then the view adjusts by \fInumber\fR screenfuls.
+If \fInumber\fR is negative then earlier entries become visible; if
+it is positive then later entries become visible.
+.RE
+'
+'----------------------------------------------------------------------
+.SH BINDINGS
+.PP
+.IP [1]
+If the \fB\-selectmode\fR is "browse", when the user drags the mouse
+pointer over the list entries, the entry under the pointer will be
+highlighted and the \fB\-browsecmd\fR procedure will be called with
+one parameter, the entryPath of the highlighted entry. Only one entry
+can be highlighted at a time. The \fB\-command\fR procedure will be
+called when the user double-clicks on a list entry.
+'
+.IP [2]
+If the \fB\-selectmode\fR is "single", the entries will only be
+highlighted by mouse <ButtonRelease-1> events. When a new list entry
+is highlighted, the \fB\-browsecmd\fR procedure will be called with
+one parameter indicating the highlighted list entry. The
+\fB\-command\fR procedure will be called when the user double-clicks
+on a list entry.
+'
+'
+.IP [3]
+If the \fB\-selectmode\fR is "multiple", when the user drags the mouse
+pointer over the list entries, all the entries under the pointer will
+be highlighted. However, only a contiguous region of list entries can
+be selected. When the highlighted area is changed, the
+\fB\-browsecmd\fR procedure will be called with an undefined
+parameter. It is the responsibility of the \fB\-browsecmd\fR procedure
+to find out the exact highlighted selection in the HList. The
+\fB\-command\fR procedure will be called when the user double-clicks
+on a list entry.
+'
+.IP [4]
+'
+If the \fB\-selectmode\fR is "extended", when the user drags the mouse
+pointer over the list entries, all the entries under the pointer will
+be highlighted. The user can also make disjointed selections using
+<Control-ButtonPress-1>. When the highlighted area is changed, the
+\fB\-browsecmd\fR procedure will be called with an undefined
+parameter. It is the responsibility of the \fB\-browsecmd\fR procedure
+to find out the exact highlighted selection in the HList. The
+\fB\-command\fR procedure will be called when the user double-clicks
+on a list entry.
+'
+.IP [5]
+\fBArrow key bindings:\fR <Up> arrow key moves the anchor point to the
+item right on top of the current anchor item. <Down> arrow key moves
+the anchor point to the item right below the current anchor item.
+<Left> arrow key moves the anchor to the parent item of the current
+anchor item. <Right> moves the anchor to the first child of the
+current anchor item. If the current anchor item does not have any
+children, moves the anchor to the item right below the current anchor
+item.
+'----------------------------------------------------------------------
+.SH EXAMPLE
+.PP
+This example demonstrates how to use an HList to store a file
+directory structure and respond to the user's browse events:
+.PP
+\fC
+.nf
+ tixHList .h -separator "/" \-browsecmd browse \-selectmode single \\
+ -itemtype text
+ .h add / \-text /
+ .h add /home \-text /home
+ .h add /home/ioi \-text /home/ioi
+ .h add /home/foo \-text /home/foo
+ .h add /usr \-text /usr
+ .h add /usr/lib \-text /usr/lib
+ pack .h
+
+ proc browse {file} {
+ puts "$file browsed"
+ }
+.fi
+\fR
+'
+'
+.SH BUGS
+'
+The fact that the display item at column 0 is implicitly associated
+with the whole entry is probably a design bug. This was done for
+backward compatibility purposes. The result is that there is a large
+overlap between the \fBitem\fR command and the \fBadd\fR,
+\fBaddchild\fR, \fBentrycget\fR and \fBentryconfigure\fR
+commands. Whenever multiple columns exist, the programmer should use
+ONLY the \fBitem\fR command to create and configure the display items
+in each column; the \fBadd\fR, \fBaddchild\fR, \fBentrycget\fR and
+\fBentryconfigure\fR should be used ONLY to create and configure
+entries.
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n), Hierarchical Listbox
diff --git a/tix/man/InpOnly.html b/tix/man/InpOnly.html
new file mode 100644
index 00000000000..874c7a1ce03
--- /dev/null
+++ b/tix/man/InpOnly.html
@@ -0,0 +1,77 @@
+
+
+
+<TITLE>tixInputOnly - Create and manipulate TIX <B>InputOnly</B></I> widgets</TITLE>
+<Center><H2>tixInputOnly - Create and manipulate TIX <B>InputOnly</B></I> widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixInputOnly<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+None
+</pre><H3>STANDARD OPTIONS</H3>
+Only the following three standard options are supported by
+<B>TixInputOnly</B></I>:
+<P>
+<pre><code><code><code>
+<B>
+cursor width height
+</B></I>
+</code></code></code></pre>
+<P>
+See the "options(n)" manual entry for details on the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<B>TixInputOnly</B></I> does not have any widget specific options.
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixInputOnly</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a <B>tixInputOnly</B></I>
+widget. Additional options, described above, may be specified on the
+command line or in the option database to configure aspects of the
+<B>tixInputOnly</B></I> such as its cursor or width.
+<P>
+<B>TixInputOnly</B></I> widgets are not visible to the user. The only
+purpose of <B>TixInputOnly</B></I> widgets are to accept inputs from the
+user, which can be done with the <B>bind</B></I> command.
+</pre><H3>WIDGET COMMAND</H3>
+<P>
+The <B>tixInputOnly</B></I> command creates a new Tcl command whose name is
+command may be used to invoke various operations on the widget. It
+has the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+the exact behavior of the command. The following commands are
+possible for <B>tixInputOnly</B></I> widgets:
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixInputOnly</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If
+no <I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixInputOnly</B></I> command.
+</DL>
+</pre><H3>BINDINGS</H3>
+<P>
+<B>tixInputOnly</B></I> widgets have no default bindings.
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:30 EST 1997 </i> ---
+<i>Serial 853731301</i>
diff --git a/tix/man/InpOnly.n b/tix/man/InpOnly.n
new file mode 100644
index 00000000000..2a4b74a0c85
--- /dev/null
+++ b/tix/man/InpOnly.n
@@ -0,0 +1,126 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+.HS tixInputOnly tix 4.0
+.BS
+'----------------------------------------------------------------------
+.SH NAME
+tixInputOnly \- Create and manipulate TIX \fBInputOnly\fR widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixInputOnly\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+None
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+Only the following three standard options are supported by
+\fBTixInputOnly\fR:
+.LP
+.nf
+.ta 4c 8c 12c
+\fB
+'
+cursor width height
+'
+\fR
+.ta 4c
+.fi
+.LP
+'
+See the "options(n)" manual entry for details on the standard options.
+'
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+\fBTixInputOnly\fR does not have any widget specific options.
+'
+.BE
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixInputOnly\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a \fBtixInputOnly\fR
+widget. Additional options, described above, may be specified on the
+command line or in the option database to configure aspects of the
+\fBtixInputOnly\fR such as its cursor or width.
+.PP
+\fBTixInputOnly\fR widgets are not visible to the user. The only
+purpose of \fBTixInputOnly\fR widgets are to accept inputs from the
+user, which can be done with the \fBbind\fR command.
+'
+'----------------------------------------------------------------------
+.SH "WIDGET COMMAND"
+.PP
+'
+The \fBtixInputOnly\fR command creates a new Tcl command whose name is
+the same as the path name of the \fBtixInputOnly\fR's window. This
+command may be used to invoke various operations on the widget. It
+has the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+InputOnly widget's path name. \fIOption\fR and the \fIarg\fRs determine
+the exact behavior of the command. The following commands are
+possible for \fBtixInputOnly\fR widgets:
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixInputOnly\fR command.
+'
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If
+no \fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixInputOnly\fR command.
+'
+'
+'
+'----------------------------------------------------------------------
+.SH BINDINGS
+.PP
+\fBtixInputOnly\fR widgets have no default bindings.
+'
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/LabEntry.html b/tix/man/LabEntry.html
new file mode 100644
index 00000000000..ccc439428e8
--- /dev/null
+++ b/tix/man/LabEntry.html
@@ -0,0 +1,136 @@
+
+
+
+<TITLE>tixLabelEntry - Create and manipulate tixLabelEntry widgets</TITLE>
+<Center><H2>tixLabelEntry - Create and manipulate tixLabelEntry widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixLabelEntry<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+The <B>TixLabelEntry</B></I> class is derived from the <B>TixLabelWidget</B></I>
+class and inherits all the commands, options and subwidgets of its
+super-class.
+</pre><H3>STANDARD OPTIONS</H3>
+The LabelEntry widget supports all the standard options of a frame
+widget. See the <B>options(n)</B></I> manual entry for details on the
+standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>disableForeground</B></I>
+Class: <B>DisableForeground</B></I>
+Switch: <B>-disableforeground</B></I>
+</code></code></code></pre>
+<UL>
+The foreground color to use for of the entry subwidget when the
+LabelEntry widget is disabled.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>label</B></I>
+Class: <B>Label</B></I>
+Switch: <B>-label</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the string to display as the label of this LabelEntry widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>labelSide</B></I>
+Class: <B>LabelSide</B></I>
+Switch: <B>-labelside</B></I>
+</code></code></code></pre>
+<UL>
+Specifies where the label should be displayed relative to the entry
+subwidget. Valid options are: <B>top</B></I>, <B>left</B></I>, <B>right</B></I>,
+<B>bottom</B></I>, <B>none</B></I> or <B>acrosstop</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>state</B></I>
+Class: <B>State</B></I>
+Switch: <B>-state</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the whether the LabelEntry widget is normal or disabled. Only
+the values "normal" and "disabled" are recognized.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>label</B></I>
+Class: <B>Label</B></I>
+</code></code></code></pre>
+<UL>
+The label subwidget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>entry</B></I>
+Class: <B>Entry</B></I>
+</code></code></code></pre>
+<UL>
+The entry subwidget.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixLabelEntry</B></I> command creates a new window (given by
+the <I>pathName</I></B> argument) and makes it into a LabelEntry
+widget. Additional options, described above, may be specified on the
+command line or in the option database to configure aspects of the
+LabelEntry such as its cursor and relief.
+<P>
+The LabelEntry widget packages an entry widget and a label into one
+mega widget. It can be used be used to simplify the creation of
+"entry-form" type of interface. In this kind of interface, one must
+create many entry widgets with label widgets next to them and describe
+the use of each of the entry widgets.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixLabelEntry</B></I> command creates a new Tcl command whose
+window. This command may be used to invoke various operations on the
+widget. It has the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+<I>arg</I></B>s determine the exact behavior of the command. The following
+commands are possible for LabelEntry widgets:
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixLabelEntry</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixLabelEntry</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I>name ?args?</I></B>
+</I></B>
+<DD> When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+</DL>
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:31 EST 1997 </i> ---
+<i>Serial 853731301</i>
diff --git a/tix/man/LabEntry.n b/tix/man/LabEntry.n
new file mode 100644
index 00000000000..52ead207919
--- /dev/null
+++ b/tix/man/LabEntry.n
@@ -0,0 +1,201 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixLabelEntry tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixLabelEntry \- Create and manipulate tixLabelEntry widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixLabelEntry\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+The \fBTixLabelEntry\fR class is derived from the \fBTixLabelWidget\fR
+class and inherits all the commands, options and subwidgets of its
+super-class.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+The LabelEntry widget supports all the standard options of a frame
+widget. See the \fBoptions(n)\fR manual entry for details on the
+standard options.
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdisableForeground\fR
+Class: \fBDisableForeground\fR
+Switch: \fB\-disableforeground\fR
+.fi
+.IP
+The foreground color to use for of the entry subwidget when the
+LabelEntry widget is disabled.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabel\fR
+Class: \fBLabel\fR
+Switch: \fB\-label\fR
+.fi
+.IP
+Specifies the string to display as the label of this LabelEntry widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabelSide\fR
+Class: \fBLabelSide\fR
+Switch: \fB\-labelside\fR
+.fi
+.IP
+Specifies where the label should be displayed relative to the entry
+subwidget. Valid options are: \fBtop\fR, \fBleft\fR, \fBright\fR,
+\fBbottom\fR, \fBnone\fR or \fBacrosstop\fR.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Switch: \fB\-state\fR
+.fi
+.IP
+Specifies the whether the LabelEntry widget is normal or disabled. Only
+the values "normal" and "disabled" are recognized.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabel\fR
+Class: \fBLabel\fR
+.fi
+.IP
+The label subwidget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBentry\fR
+Class: \fBEntry\fR
+.fi
+.IP
+The entry subwidget.
+'----------END
+.BE
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixLabelEntry\fR command creates a new window (given by
+the \fIpathName\fR argument) and makes it into a LabelEntry
+widget. Additional options, described above, may be specified on the
+command line or in the option database to configure aspects of the
+LabelEntry such as its cursor and relief.
+.PP
+The LabelEntry widget packages an entry widget and a label into one
+mega widget. It can be used be used to simplify the creation of
+"entry-form" type of interface. In this kind of interface, one must
+create many entry widgets with label widgets next to them and describe
+the use of each of the entry widgets.
+'
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixLabelEntry\fR command creates a new Tcl command whose
+name is the same as the path name of the LabelEntry's
+window. This command may be used to invoke various operations on the
+widget. It has the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+LabelEntry widget's path name. \fIOption\fR and the
+\fIarg\fRs determine the exact behavior of the command. The following
+commands are possible for LabelEntry widgets:
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixLabelEntry\fR command.
+'
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixLabelEntry\fR command.
+'
+'
+'
+.TP
+\fIpathName \fBsubwidget \fIname ?args?\fR
+'
+When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+'
+'
+'
+'----------------------------------------------------------------------
+'.SH BINDINGS
+'.PP
+'
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/LabFrame.html b/tix/man/LabFrame.html
new file mode 100644
index 00000000000..03fb7489949
--- /dev/null
+++ b/tix/man/LabFrame.html
@@ -0,0 +1,155 @@
+
+
+
+<TITLE>tixLabelFrame - Create and manipulate tixLabelFrame widgets</TITLE>
+<Center><H2>tixLabelFrame - Create and manipulate tixLabelFrame widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixLabelFrame<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+The <B>TixLabelFrame</B></I> class is derived from the <B>TixLabelWidget</B></I>
+class and inherits all the commands, options and subwidgets of its
+super-class.
+</pre><H3>STANDARD OPTIONS</H3>
+The LabelFrame widget supports all the standard options of a frame
+widget. See the <B>options(n)</B></I> manual entry for details on the
+standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>label</B></I>
+Class: <B>Label</B></I>
+Switch: <B>-label</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the string to display as the label of this LabelFrame widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>labelSide</B></I>
+Class: <B>LabelSide</B></I>
+Switch: <B>-labelside</B></I>
+</code></code></code></pre>
+<UL>
+Specifies where the label should be displayed relative to the entry
+subwidget. Valid options are: <B>top</B></I>, <B>left</B></I>, <B>right</B></I>,
+<B>bottom</B></I>, <B>none</B></I> or <B>acrosstop</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>padX</B></I>
+Class: <B>Pad</B></I>
+Switch: <B>-padx</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the amount of the horizontal padding around the <B>frame</B></I>
+subwidget. Must be a valid non-negative integer number.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>padY</B></I>
+Class: <B>Pad</B></I>
+Switch: <B>-pady</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the amount of the vertical padding around the <B>frame</B></I>
+subwidget.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>frame</B></I>
+Class: <B>Frame</B></I>
+</code></code></code></pre>
+<UL>
+The frame subwidget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>label</B></I>
+Class: <B>Label</B></I>
+</code></code></code></pre>
+<UL>
+The label subwidget.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixLabelFrame</B></I> command creates a new window (given by
+the <I>pathName</I></B> argument) and makes it into a LabelFrame
+widget. Additional options, described above, may be specified on the
+command line or in the option database to configure aspects of the
+LabelFrame such as its cursor and relief.
+</pre><H3>CREATING WIDGETS INSIDE A LABELFRAME</H3>
+<P>
+The LabelFrame widget packages a frame widget and a label into one
+mega widget. To create widgets inside a LabelFrame widget, one must
+create the new widgets relative to the <B>frame</B></I> subwidget and
+manage them inside the <B>frame</B></I> subwidget. An error will be
+generated if one tries to create widgets as immediate children of the
+LabelFrame. For example: the following is correct code, which creates
+new widgets inside the frame subwidget:
+<P>
+<pre><code><code><code>
+ tixLabelFrame .f
+ set f [.f subwidget frame]
+ button $f.b -text hi
+ pack $f.b
+</code></code></code></pre>
+<P>
+The following example code is <I>incorrect</I></B> because it tries to
+create immediate children of the LabelFrame <B>\.f</B></I>:
+<P>
+<pre><code><code><code>
+ tixLabelFrame .f
+ button .f.b -text hi
+ pack .f.b
+</code></code></code></pre>
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixLabelFrame</B></I> command creates a new Tcl command whose
+window. This command may be used to invoke various operations on the
+widget. It has the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+<I>arg</I></B>s determine the exact behavior of the command. The following
+commands are possible for LabelFrame widgets:
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixLabelFrame</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixLabelFrame</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I>name ?args?</I></B>
+</I></B>
+<DD> When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+</DL>
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:31 EST 1997 </i> ---
+<i>Serial 853731301</i>
diff --git a/tix/man/LabFrame.n b/tix/man/LabFrame.n
new file mode 100644
index 00000000000..35bd406c4e7
--- /dev/null
+++ b/tix/man/LabFrame.n
@@ -0,0 +1,222 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixLabelFrame tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixLabelFrame \- Create and manipulate tixLabelFrame widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixLabelFrame\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+The \fBTixLabelFrame\fR class is derived from the \fBTixLabelWidget\fR
+class and inherits all the commands, options and subwidgets of its
+super-class.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+The LabelFrame widget supports all the standard options of a frame
+widget. See the \fBoptions(n)\fR manual entry for details on the
+standard options.
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabel\fR
+Class: \fBLabel\fR
+Switch: \fB\-label\fR
+.fi
+.IP
+Specifies the string to display as the label of this LabelFrame widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabelSide\fR
+Class: \fBLabelSide\fR
+Switch: \fB\-labelside\fR
+.fi
+.IP
+Specifies where the label should be displayed relative to the entry
+subwidget. Valid options are: \fBtop\fR, \fBleft\fR, \fBright\fR,
+\fBbottom\fR, \fBnone\fR or \fBacrosstop\fR.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBpadX\fR
+Class: \fBPad\fR
+Switch: \fB\-padx\fR
+.fi
+.IP
+Specifies the amount of the horizontal padding around the \fBframe\fR
+subwidget. Must be a valid non-negative integer number.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBpadY\fR
+Class: \fBPad\fR
+Switch: \fB\-pady\fR
+.fi
+.IP
+Specifies the amount of the vertical padding around the \fBframe\fR
+subwidget.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBframe\fR
+Class: \fBFrame\fR
+.fi
+.IP
+The frame subwidget.
+'----------END
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabel\fR
+Class: \fBLabel\fR
+.fi
+.IP
+The label subwidget.
+'----------END
+.BE
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixLabelFrame\fR command creates a new window (given by
+the \fIpathName\fR argument) and makes it into a LabelFrame
+widget. Additional options, described above, may be specified on the
+command line or in the option database to configure aspects of the
+LabelFrame such as its cursor and relief.
+'
+.SH CREATING WIDGETS INSIDE A LABELFRAME
+.PP
+'
+The LabelFrame widget packages a frame widget and a label into one
+mega widget. To create widgets inside a LabelFrame widget, one must
+create the new widgets relative to the \fBframe\fR subwidget and
+manage them inside the \fBframe\fR subwidget. An error will be
+generated if one tries to create widgets as immediate children of the
+LabelFrame. For example: the following is correct code, which creates
+new widgets inside the frame subwidget:
+.PP
+.nf
+ tixLabelFrame .f
+ set f [.f subwidget frame]
+ button $f.b \-text hi
+ pack $f.b
+.fi
+.PP
+The following example code is \fIincorrect\fR because it tries to
+create immediate children of the LabelFrame \fB\.f\fR:
+.PP
+.nf
+ tixLabelFrame .f
+ button .f.b \-text hi
+ pack .f.b
+.fi
+'
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixLabelFrame\fR command creates a new Tcl command whose
+name is the same as the path name of the LabelFrame's
+window. This command may be used to invoke various operations on the
+widget. It has the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+LabelFrame widget's path name. \fIOption\fR and the
+\fIarg\fRs determine the exact behavior of the command. The following
+commands are possible for LabelFrame widgets:
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixLabelFrame\fR command.
+'
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixLabelFrame\fR command.
+'
+'
+'
+.TP
+\fIpathName \fBsubwidget \fIname ?args?\fR
+'
+When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+'
+'
+'
+'----------------------------------------------------------------------
+'.SH BINDINGS
+'.PP
+'
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/ListNBK.html b/tix/man/ListNBK.html
new file mode 100644
index 00000000000..f604323de83
--- /dev/null
+++ b/tix/man/ListNBK.html
@@ -0,0 +1,213 @@
+
+
+
+<TITLE>tixListNoteBook - Create and manipulate tixListNoteBook widgets</TITLE>
+<Center><H2>tixListNoteBook - Create and manipulate tixListNoteBook widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixListNoteBook<I> <I>pathName ?<I>options</I></B>?
+</pre><H3>STANDARD OPTIONS</H3>
+The ListNoteBook widget supports all the standard options of a frame widget.
+See the options(n) manual entry for details on the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>dynamicGeometry</B></I>
+Class: <B>DynamicGeometry</B></I>
+Switch: <B>-dynamicgeometry</B></I>
+</code></code></code></pre>
+<UL>
+If set to false, the size of the ListNotebook will match the size of the
+largest page. If set to true, the size of the ListNotebook will match the
+size of the current page (therefore, the size may change when the user
+selects different pages). The default value is false. A setting of true
+is discouraged.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>ipadX</B></I>
+Class: <B>Pad</B></I>
+Switch: <B>-ipadx</B></I>
+</code></code></code></pre>
+<UL>
+The amount of internal horizontal paddings around the sides of the
+page subwidgets.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>ipadY</B></I>
+Class: <B>Pad</B></I>
+Switch: <B>-ipady</B></I>
+</code></code></code></pre>
+<UL>
+The amount of internal vertical paddings around the sides of the
+page subwidgets.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>hlist</B></I>
+Class: <B>TixHList</B></I>
+</code></code></code></pre>
+<UL>
+The HList widget that displays the names of the pages.
+</UL>
+<P>
+In addition, all the page subwidgets created as a result of the
+<B>add</B></I> command can be accessed by the <B>subwidget</B></I> command. They
+are identified by the <B>pageName</B></I> parameter to the <B>add</B></I>
+command.
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixListNoteBook</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a ListNoteBook widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+ListNoteBook widget such as its cursor and relief.
+
+The ListNoteBook widget is very similar to the TixNoteBook widget: it
+can be used to display many windows in a limited space using a
+"notebook" metaphore. The notebook is divided into a stack of pages
+(windows). At one time only one of these pages can be shown. The user
+can navigate through these pages by choosing the name of the desired
+page in the <B>hlist</B></I> subwidget.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixListNoteBook</B></I> command creates a new Tcl command whose name is
+command may be used to invoke various operations on the widget. It has
+the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+determine the exact behavior of the command. The following commands
+are possible for ListNoteBook widgets:
+<DL>
+<DT> <I>pathName <B>add<I> pageName </I></B>?<I>option value ...</I></B>?
+</I></B>
+<DD> Adds a new ListNotebook page subwidget into the ListNoteBook widget.
+<I>pageName</I></B> must be the name of an existing entry of the
+<B>hlist</B></I> subwidget. You must create the entry before calling the
+<B>add</B></I> command. Please refer to the <B>tixHList(n)</B></I> manual entry
+for adding entries in an HList widget.
+
+Additional parameters may be supplied to configure this page
+subwidget. Possible options are:
+</DL>
+<UL>
+<DL>
+<DT> <B>-createcmd</B></I>
+</I></B>
+<DD> Specifies a TCL command to be called the first time a page is shown on
+the screen. This option can be used to delay the creation of the
+contents of a page until necessary. Therefore, it can be used to speed
+up interface creation process especially when there are a large number
+of pages in a ListNoteBook widget.
+</DL>
+<DL>
+<DT> <B>-raisecmd</B></I>
+</I></B>
+<DD> Specifies a TCL command to be called whenever this page is raised by
+the user.
+</DL>
+</UL>
+When successful, this command returns the pathname of the newly
+created page.
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>.<I>Option</I></B> may have any of the values accepted by the
+<B>tixListNoteBook</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixListNoteBook</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>delete<I> pageName</I></B>?
+</I></B>
+<DD> Deletes the page identified by <I>pageName</I></B>.
+</DL>
+<DL>
+<DT> <I>pathName <B>pagecget</B></I> <I>pageName option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B> in the page given by <I>pageName</I></B>. <I>Option</I></B> may
+have any of the values accepted by the <B>add</B></I> widget command.
+</DL>
+<DL>
+<DT> <I>pathName <B>pageconfigure<I> pageName ?<I>option</I></B>? <I>?value ...</I></B>?
+</I></B>
+<DD> When no option is given, prints out the values of all options of this
+page. If <I>option</I></B> is specified with no <I>value</I></B>, then the
+command returns the current value of that option. If one or more
+<I>option-value</I></B> pairs are specified, then the command modifies the
+command returns an empty string. <I>Option</I></B> may be any of options
+accepted by the <B>add</B></I> widget command.
+</DL>
+<DL>
+<DT> <I>pathName <B>pages</B></I>
+</I></B>
+<DD> Returns a list of the names of all the pages.
+</DL>
+<DL>
+<DT> <I>pathName <B>raise <I>pageName</I></B>
+</I></B>
+<DD> Raise the page identified by <I>pageName</I></B>.
+</DL>
+<DL>
+<DT> <I>pathName <B>raised</B></I>
+</I></B>
+<DD> Returns the name of the currently raised page.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+</DL>
+</pre><H3>EXAMPLE</H3>
+<pre><code><code><code>
+ tixListNoteBook .n; pack .n
+ .n subwidget hlist add page1 -text "Page 1"
+ .n subwidget hlist add page2 -text "Page 2"
+
+ set page1 [.n add page1]
+ set page2 [.n add page2]
+
+ button $page1.b -text "On page1"
+ button $page2.b -text "On page2"
+
+ pack $page1.b
+ pack $page2.b
+
+ .n raise page2
+</code></code></code></pre>
+</pre><H3>BINDINGS</H3>
+<P>
+When the user activates an entry in the <B>hlist</B></I> subwidget, the
+page associated with that entry will be raised to the front. This can
+be done by using the mouse or keyboard. The <I>hlist</I></B> subwidget
+operates with its <B>-selectmode</B></I> option set to single. See the
+event bindings of the HList widget for more details.
+</pre><H3>KEYWORDS</H3>
+Tix(n), tixHList(n)
+<hr><i>Last modified Sun Jan 19 22:34:32 EST 1997 </i> ---
+<i>Serial 853731302</i>
diff --git a/tix/man/ListNBK.n b/tix/man/ListNBK.n
new file mode 100644
index 00000000000..630a7f02e59
--- /dev/null
+++ b/tix/man/ListNBK.n
@@ -0,0 +1,277 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixListNoteBook tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixListNoteBook - Create and manipulate tixListNoteBook widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixListNoteBook\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+The ListNoteBook widget supports all the standard options of a frame widget.
+See the options(n) manual entry for details on the standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdynamicGeometry\fR
+Class: \fBDynamicGeometry\fR
+Switch: \fB\-dynamicgeometry\fR
+.fi
+.IP
+If set to false, the size of the ListNotebook will match the size of the
+largest page. If set to true, the size of the ListNotebook will match the
+size of the current page (therefore, the size may change when the user
+selects different pages). The default value is false. A setting of true
+is discouraged.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBipadX\fR
+Class: \fBPad\fR
+Switch: \fB\-ipadx\fR
+.fi
+.IP
+The amount of internal horizontal paddings around the sides of the
+page subwidgets.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBipadY\fR
+Class: \fBPad\fR
+Switch: \fB\-ipady\fR
+.fi
+.IP
+The amount of internal vertical paddings around the sides of the
+page subwidgets.
+'----------END
+'
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+.LP
+.nf
+Name: \fBhlist\fR
+Class: \fBTixHList\fR
+.fi
+.IP
+The HList widget that displays the names of the pages.
+'
+'----------END
+'
+.LP
+In addition, all the page subwidgets created as a result of the
+\fBadd\fR command can be accessed by the \fBsubwidget\fR command. They
+are identified by the \fBpageName\fR parameter to the \fBadd\fR
+command.
+'
+'
+.BE
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixListNoteBook\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a ListNoteBook widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+ListNoteBook widget such as its cursor and relief.
+
+The ListNoteBook widget is very similar to the TixNoteBook widget: it
+can be used to display many windows in a limited space using a
+"notebook" metaphore. The notebook is divided into a stack of pages
+(windows). At one time only one of these pages can be shown. The user
+can navigate through these pages by choosing the name of the desired
+page in the \fBhlist\fR subwidget.
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixListNoteBook\fR command creates a new Tcl command whose name is
+the same as the path name of the ListNoteBook widget's window. This
+command may be used to invoke various operations on the widget. It has
+the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+ListNoteBook widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following commands
+are possible for ListNoteBook widgets:
+'
+'
+.TP
+'
+\fIpathName \fBadd\fI pageName \fR?\fIoption value ...\fR?
+'
+Adds a new ListNotebook page subwidget into the ListNoteBook widget.
+\fIpageName\fR must be the name of an existing entry of the
+\fBhlist\fR subwidget. You must create the entry before calling the
+\fBadd\fR command. Please refer to the \fBtixHList(n)\fR manual entry
+for adding entries in an HList widget.
+
+Additional parameters may be supplied to configure this page
+subwidget. Possible options are:
+'
+.RS
+.TP
+\fB\-createcmd\fR
+'
+Specifies a TCL command to be called the first time a page is shown on
+the screen. This option can be used to delay the creation of the
+contents of a page until necessary. Therefore, it can be used to speed
+up interface creation process especially when there are a large number
+of pages in a ListNoteBook widget.
+'
+.TP
+\fB\-raisecmd\fR
+'
+Specifies a TCL command to be called whenever this page is raised by
+the user.
+'
+.RE
+'
+When successful, this command returns the pathname of the newly
+created page.
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR.\fIOption\fR may have any of the values accepted by the
+\fBtixListNoteBook\fR command.
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixListNoteBook\fR command.
+'
+'
+.TP
+\fIpathName \fBdelete\fI pageName\fR?
+'
+Deletes the page identified by \fIpageName\fR.
+'
+.TP
+\fIpathName \fBpagecget\fR \fIpageName option\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR in the page given by \fIpageName\fR. \fIOption\fR may
+have any of the values accepted by the \fBadd\fR widget command.
+'
+'
+.TP
+\fIpathName \fBpageconfigure\fI pageName ?\fIoption\fR? \fI?value ...\fR?
+'
+'
+When no option is given, prints out the values of all options of this
+page. If \fIoption\fR is specified with no \fIvalue\fR, then the
+command returns the current value of that option. If one or more
+\fIoption\-value\fR pairs are specified, then the command modifies the
+given page's option(s) to have the given value(s); in this case the
+command returns an empty string. \fIOption\fR may be any of options
+accepted by the \fBadd\fR widget command.
+'
+.TP
+\fIpathName \fBpages\fR
+'
+Returns a list of the names of all the pages.
+'
+.TP
+\fIpathName \fBraise \fIpageName\fR
+'
+Raise the page identified by \fIpageName\fR.
+'
+.TP
+\fIpathName \fBraised\fR
+'
+Returns the name of the currently raised page.
+'
+.TP
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+'
+'
+'----------------------------------------------------------------------
+.SH EXAMPLE
+'
+.nf
+ tixListNoteBook .n; pack .n
+ .n subwidget hlist add page1 -text "Page 1"
+ .n subwidget hlist add page2 -text "Page 2"
+
+ set page1 [.n add page1]
+ set page2 [.n add page2]
+
+ button $page1.b -text "On page1"
+ button $page2.b -text "On page2"
+
+ pack $page1.b
+ pack $page2.b
+
+ .n raise page2
+.fi
+'----------------------------------------------------------------------
+.SH BINDINGS
+.PP
+When the user activates an entry in the \fBhlist\fR subwidget, the
+page associated with that entry will be raised to the front. This can
+be done by using the mouse or keyboard. The \fIhlist\fR subwidget
+operates with its \fB\-selectmode\fR option set to single. See the
+event bindings of the HList widget for more details.
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n), tixHList(n)
diff --git a/tix/man/Meter.html b/tix/man/Meter.html
new file mode 100644
index 00000000000..71d1ff047c7
--- /dev/null
+++ b/tix/man/Meter.html
@@ -0,0 +1,96 @@
+
+
+
+<TITLE>tixMeter - Create and manipulate Tix Meter widgets</TITLE>
+<Center><H2>tixMeter - Create and manipulate Tix Meter widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixMeter<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+None.
+</pre><H3>STANDARD OPTIONS</H3>
+The Balloon widget supports all the standard options of a frame widget.
+See the <B>options(n)</B></I> manual entry for details on the standard options.
+<P>
+<pre><code><code><code>
+Name: <B>foreground</B></I>
+Class: <B>Foreground</B></I>
+Switch: <B>-foreground</B></I>
+</code></code></code></pre>
+<UL>
+The color of the progress bar.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>text</B></I>
+Class: <B>Text</B></I>
+Switch: <B>-text</B></I>
+</code></code></code></pre>
+<UL>
+The text string to place inside the progress bar. If not specified,
+then the text string will be the percentage value specified by the
+<B>-value</B></I> option.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>value</B></I>
+Class: <B>Value</B></I>
+Switch: <B>-value</B></I>
+</code></code></code></pre>
+<UL>
+A real value that specifies the progress. Must be between 0.0 to 1.0.
+</UL>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixMeter</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a Meter widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+Meter widget such as its cursor and relief.
+
+The Meter widget can be used to show the pregress of a background job
+which may take a long time to execute.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixMeter</B></I> command creates a new Tcl command whose name is
+command may be used to invoke various operations on the widget. It has
+the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+determine the exact behavior of the command. The following commands
+are possible for Meter widgets:
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixMeter</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixMeter</B></I> command.
+</DL>
+</pre><H3>BINDINGS</H3>
+<P>
+There is no bindings for the Meter widget.
+</pre><H3>KEYWORDS</H3>
+Tix(n), Meter Widget
+
+<!Serial 851729147>
+<hr><i>Last modified Fri Jan 17 23:01:36 EST 1997 </i> ---
+<i>Serial 853731302</i>
diff --git a/tix/man/Meter.n b/tix/man/Meter.n
new file mode 100644
index 00000000000..ce840efba11
--- /dev/null
+++ b/tix/man/Meter.n
@@ -0,0 +1,139 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixMeter tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixMeter \- Create and manipulate Tix Meter widgets
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixMeter\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+None.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+The Meter widget supports all the standard options of a frame widget.
+See the \fBoptions(n)\fR manual entry for details on the standard options.
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBfillColor\fR
+Class: \fBFillColor\fR
+Switch: \fB\-fillcolor\fR
+.fi
+.IP
+The color of the progress bar.
+'----------END
+'----------BEGIN
+.LP
+.nf
+Name: \fBtext\fR
+Class: \fBText\fR
+Switch: \fB\-text\fR
+.fi
+.IP
+The text string to place inside the progress bar. If not specified,
+then the text string will be the percentage value specified by the
+\fB\-value\fR option.
+'----------END
+'----------BEGIN
+.LP
+.nf
+Name: \fBvalue\fR
+Class: \fBValue\fR
+Switch: \fB\-value\fR
+.fi
+.IP
+A real value that specifies the progress. Must be between 0.0 to 1.0.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixMeter\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a Meter widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+Meter widget such as its cursor and relief.
+
+The Meter widget can be used to show the pregress of a background job
+which may take a long time to execute.
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixMeter\fR command creates a new Tcl command whose name is
+the same as the path name of the Meter widget's window. This
+command may be used to invoke various operations on the widget. It has
+the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+Meter widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following commands
+are possible for Meter widgets:
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixMeter\fR command.
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixMeter\fR command.
+'
+'
+'
+'
+'----------------------------------------------------------------------
+.SH BINDINGS
+.PP
+There is no bindings for the Meter widget.
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n), Meter Widget
+
diff --git a/tix/man/Mwm.html b/tix/man/Mwm.html
new file mode 100644
index 00000000000..98f66cdd3fb
--- /dev/null
+++ b/tix/man/Mwm.html
@@ -0,0 +1,85 @@
+
+
+
+<TITLE>tixMwm - Communicate with the Motif(tm) window manager.</TITLE>
+<Center><H2>tixMwm - Communicate with the Motif(tm) window manager.</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<P>
+<B>tixMwm<I> option <I>pathName ?args? </I></B>
+<P>
+</pre><H3>COMMAND OPTIONS</H3>
+<P>
+<DL>
+<DT> <B>tixMwm decoration <I>pathName</I></B> ?option? ?value? ?...?
+</I></B>
+<DD> When no options are given, this command returns the values of all the
+decorations options for the toplevel window with the <I>pathName</I></B>.
+
+When only one option is given without specifying the value, the
+current value of that option is returned.
+
+When more than one "option value" pairs are passed to this command,
+the specified values will be assigned to the corresponding options. As
+a result, the appearance of the Motif decorations around the toplevel
+window will be changed.
+
+Possible options are: <B>-border</B></I>, <B>-menu</B></I>, <B>-maximize</B></I>,
+<B>-minimize</B></I>, <B>-resizeh</B></I> and <B>-title</B></I>. The value must be a
+Boolean value. The values returned by this command are undefined when
+the window is not managed by mwm.
+</DL>
+<DL>
+<DT> <B>tixMwm ismwmrunning <I>pathName</I></B>
+</I></B>
+<DD> This returns true if mwm is running on the screen where the specified
+window is located, false otherwise.
+</DL>
+<DL>
+<DT> <B>tixMwm protocol <I>pathName
+</I></B>
+<DD> When no additional options are given, this command returns all
+protocols associated with this toplevel window.
+</DL>
+<DL>
+<DT> <B>tixMwm protocol <I>pathName <B>activate<I> protocol_name</I></B>
+</DL>
+<DL>
+<DT> <B>tixMwm protocol <I>pathName <B>add<I> protocol_name menu_message</I></B>
+</I></B>
+<DD> Add a new mwm protocol message for this toplevel window. The
+message is identified by the string name specified in
+specified by <I>menu_message</I></B>. Once a new mwm protocol message is
+added to a toplevel, it can be catched by the TK <B>wm protocol</B></I>
+command. Here is an example:
+</DL>
+<pre><code><code><code>
+ tixMwm protocol . add MY_PRINT_HELLO \\
+ {"Print Hello" _H Ctrl&lt;Key&gt;H}
+ wm protocol . MY_PRINT_HELLO {puts Hello}
+</code></code></code></pre>
+<DL>
+<DT> <B>tixMwm protocol <I>pathName <B>deactivate<I> protocol_name</I></B>
+</DL>
+<DL>
+<DT> <B>tixMwm protocol <I>pathName <B>delete<I> protocol_name</I></B>
+</I></B>
+<DD> window manager protocol handler associated with this protocol (by the
+<B>wm protocol</B></I> command) is not deleted automatically. You have to
+delete the protocol handle explicitly. E.g.:
+</DL>
+<pre><code><code><code>
+ tixMwm protocol . delete MY_PRINT_HELLO
+ wm protocol . MY_PRINT_HELLO {}
+</code></code></code></pre>
+<P>
+</pre><H3>BUGS</H3>
+On some versions of Mwm, the <B>-border</B></I> will not disappear unless
+<B>-resizeh</B></I> is turned off. Also, the -title will not disappear
+unless all of <B>-title</B></I>, <B>-menu</B></I>, <B>-maximize</B></I> and
+<B>-minimize</B></I> are turned off.
+<P>
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:32 EST 1997 </i> ---
+<i>Serial 853731302</i>
diff --git a/tix/man/Mwm.n b/tix/man/Mwm.n
new file mode 100644
index 00000000000..fbf49ce1061
--- /dev/null
+++ b/tix/man/Mwm.n
@@ -0,0 +1,110 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixMwm tix 4.0
+.BS
+'
+'
+.SH NAME
+tixMwm - Communicate with the Motif(tm) window manager.
+'
+'
+'
+.SH SYNOPSIS
+.PP
+\fBtixMwm\fI option \fIpathName ?args? \fR
+.PP
+.SH COMMAND OPTIONS
+.PP
+.TP
+\fBtixMwm decoration \fIpathName\fR ?option? ?value? ?...?
+'
+When no options are given, this command returns the values of all the
+decorations options for the toplevel window with the \fIpathName\fR.
+
+When only one option is given without specifying the value, the
+current value of that option is returned.
+
+When more than one "option value" pairs are passed to this command,
+the specified values will be assigned to the corresponding options. As
+a result, the appearance of the Motif decorations around the toplevel
+window will be changed.
+
+Possible options are: \fB-border\fR, \fB-menu\fR, \fB-maximize\fR,
+\fB-minimize\fR, \fB-resizeh\fR and \fB-title\fR. The value must be a
+Boolean value. The values returned by this command are undefined when
+the window is not managed by mwm.
+'
+'
+.TP
+\fBtixMwm ismwmrunning \fIpathName\fR
+This returns true if mwm is running on the screen where the specified
+window is located, false otherwise.
+'
+'
+.TP
+\fBtixMwm protocol \fIpathName
+'
+When no additional options are given, this command returns all
+protocols associated with this toplevel window.
+'
+.TP
+\fBtixMwm protocol \fIpathName \fBactivate\fI protocol_name\fR
+'
+Activate the mwm protocol message in mwm's menu.
+'
+.TP
+\fBtixMwm protocol \fIpathName \fBadd\fI protocol_name menu_message\fR
+'
+Add a new mwm protocol message for this toplevel window. The
+message is identified by the string name specified in
+\fIprotocol_name\fR. A menu item will be added into mwm's menu as
+specified by \fImenu_message\fR. Once a new mwm protocol message is
+added to a toplevel, it can be catched by the TK \fBwm protocol\fR
+command. Here is an example:
+.nf
+ tixMwm protocol . add MY_PRINT_HELLO \\
+ {"Print Hello" _H Ctrl<Key>H}
+ wm protocol . MY_PRINT_HELLO {puts Hello}
+.fi
+'
+.TP
+\fBtixMwm protocol \fIpathName \fBdeactivate\fI protocol_name\fR
+'
+Deactivate the mwm protocol message in mwm's menu.
+'
+.TP
+\fBtixMwm protocol \fIpathName \fBdelete\fI protocol_name\fR
+'
+Delete the mwm protocol message from mwm's menu. Please note that the
+window manager protocol handler associated with this protocol (by the
+\fBwm protocol\fR command) is not deleted automatically. You have to
+delete the protocol handle explicitly. E.g.:
+.nf
+ tixMwm protocol . delete MY_PRINT_HELLO
+ wm protocol . MY_PRINT_HELLO {}
+.fi
+'
+.PP
+.SH BUGS
+'
+On some versions of Mwm, the \fB-border\fR will not disappear unless
+\fB-resizeh\fR is turned off. Also, the -title will not disappear
+unless all of \fB-title\fR, \fB-menu\fR, \fB-maximize\fR and
+\fB-minimize\fR are turned off.
+'
+'
+'
+.PP
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/NBFrame.html b/tix/man/NBFrame.html
new file mode 100644
index 00000000000..40fd0e4ec4f
--- /dev/null
+++ b/tix/man/NBFrame.html
@@ -0,0 +1,100 @@
+
+
+
+<TITLE>tixNBFrame - Create and manipulate Tix NoteBook Frame widgets</TITLE>
+<Center><H2>tixNBFrame - Create and manipulate Tix NoteBook Frame widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixNBFrame<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+None.
+</pre><H3>STANDARD OPTIONS</H3>
+<P>
+<pre><code><code><code>
+<B>
+background borderWidth cursor disabledForeground
+foreground font height highlightColor
+highlightThickness relief takeFocus
+width</B></I>
+</code></code></code></pre>
+<P>
+See the <B>options(n)</B></I> manual entry for details on the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>backPageColor</B></I>
+Class: <B>BackPageColor</B></I>
+Switch: <B>-backpagecolor</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the color for the extra space on the row of tabs which is
+not covered by any page tabs.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>focusColor</B></I>
+Class: <B>FocusColor</B></I>
+Switch: <B>-focuscolor</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the color for the focus highlight.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>inactiveBackground</B></I>
+Class: <B>InactiveBackground</B></I>
+Switch: <B>-inactivebackground</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the color for the inactive tabs (the active tab always have
+the same background color as the notebook).
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>tabPadX</B></I>
+Class: <B>Pad</B></I>
+Switch: <B>-tabpadx</B></I>
+</code></code></code></pre>
+<UL>
+The horizontal padding around the text labels on the page tabs.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>tabPadY</B></I>
+Class: <B>Pad</B></I>
+Switch: <B>-tabpady</B></I>
+</code></code></code></pre>
+<UL>
+The vertical padding around the text labels on the page tabs.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+The NBFrame widget is used privately inside the <B>TixNoteBook(n)</B></I>
+widget to display the page tabs. The application programmer should
+never create a NBFrame widget directly. The sole purpose of this maual
+page is to describe the options that can be used to configure the
+appearance of the TixNoteBook widget.
+<P>
+The name of the NBFrame subwidget inside the TixNoteBook widget is
+called <B>nbframe</B></I>. It can be accessed using the <B>subwidget</B></I>
+command of the TixNoteBook widget or the <B>-options</B></I> switch:
+<P>
+</pre><H3>EXAMPLE</H3>
+<pre><code><code><code>
+ tixNoteBook .d -options {
+ nbframe.BackPageColor gray60
+ }
+ .d subwidget nbframe config -font fixed
+
+ .d add page1 -label "Page1"
+ set page [.d subwidget page1]
+ button $page.b1
+ pack $page.b1
+
+ pack .d -expand yes -fill both
+</code></code></code></pre>
+</pre><H3>KEYWORDS</H3>
+Tix(n), TixNoteBook(n)
+<hr><i>Last modified Sun Jan 19 22:34:33 EST 1997 </i> ---
+<i>Serial 853731302</i>
diff --git a/tix/man/NBFrame.n b/tix/man/NBFrame.n
new file mode 100644
index 00000000000..bf78ccf6753
--- /dev/null
+++ b/tix/man/NBFrame.n
@@ -0,0 +1,147 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixNBFrame tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixNBFrame \- Create and manipulate Tix NoteBook Frame widgets
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixNBFrame\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+None.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+.LP
+.nf
+.ta 4c 8c 12c
+\fB
+background borderWidth cursor disabledForeground
+foreground font height highlightColor
+highlightThickness relief takeFocus
+width\fR
+.ta 4c
+.fi
+.LP
+See the \fBoptions(n)\fR manual entry for details on the standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBbackPageColor\fR
+Class: \fBBackPageColor\fR
+Switch: \fB\-backpagecolor\fR
+.fi
+.IP
+Specifies the color for the extra space on the row of tabs which is
+not covered by any page tabs.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBfocusColor\fR
+Class: \fBFocusColor\fR
+Switch: \fB\-focuscolor\fR
+.fi
+.IP
+Specifies the color for the focus highlight.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBinactiveBackground\fR
+Class: \fBInactiveBackground\fR
+Switch: \fB\-inactivebackground\fR
+.fi
+.IP
+Specifies the color for the inactive tabs (the active tab always have
+the same background color as the notebook).
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBtabPadX\fR
+Class: \fBPad\fR
+Switch: \fB\-tabpadx\fR
+.fi
+.IP
+The horizontal padding around the text labels on the page tabs.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBtabPadY\fR
+Class: \fBPad\fR
+Switch: \fB\-tabpady\fR
+.fi
+.IP
+The vertical padding around the text labels on the page tabs.
+'----------END
+'
+'
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+'
+The NBFrame widget is used privately inside the \fBTixNoteBook(n)\fR
+widget to display the page tabs. The application programmer should
+never create a NBFrame widget directly. The sole purpose of this maual
+page is to describe the options that can be used to configure the
+appearance of the TixNoteBook widget.
+.PP
+The name of the NBFrame subwidget inside the TixNoteBook widget is
+called \fBnbframe\fR. It can be accessed using the \fBsubwidget\fR
+command of the TixNoteBook widget or the \fB\-options\fR switch:
+.PP
+'----------------------------------------------------------------------
+.SH EXAMPLE
+'
+.nf
+ tixNoteBook .d -options {
+ nbframe.BackPageColor gray60
+ }
+ .d subwidget nbframe config -font fixed
+
+ .d add page1 -label "Page1"
+ set page [.d subwidget page1]
+ button $page.b1
+ pack $page.b1
+
+ pack .d -expand yes -fill both
+.fi
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n), TixNoteBook(n)
diff --git a/tix/man/NoteBook.html b/tix/man/NoteBook.html
new file mode 100644
index 00000000000..108c68d1f03
--- /dev/null
+++ b/tix/man/NoteBook.html
@@ -0,0 +1,263 @@
+
+
+
+<TITLE>tixNoteBook - Create and manipulate tixNoteBook widgets</TITLE>
+<Center><H2>tixNoteBook - Create and manipulate tixNoteBook widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixNoteBook<I> <I>pathName ?<I>options</I></B>?
+</pre><H3>STANDARD OPTIONS</H3>
+The NoteBook widget supports all the standard options of a frame widget.
+See the options(n) manual entry for details on the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>dynamicGeometry</B></I>
+Class: <B>DynamicGeometry</B></I>
+Switch: <B>-dynamicgeometry</B></I>
+</code></code></code></pre>
+<UL>
+If set to false, the size of the Notebook will match the size of the
+largest page. If set to true, the size of the Notebook will match the
+size of the current page (therefore, the size may change when the user
+selects different pages). The default value is false. A setting of true
+is discouraged.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>ipadX</B></I>
+Class: <B>Pad</B></I>
+Switch: <B>-ipadx</B></I>
+</code></code></code></pre>
+<UL>
+The amount of internal horizontal paddings around the sides of the
+page subwidgets.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>ipadY</B></I>
+Class: <B>Pad</B></I>
+Switch: <B>-ipady</B></I>
+</code></code></code></pre>
+<UL>
+The amount of internal vertical paddings around the sides of the
+page subwidgets.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>nbframe</B></I>
+Class: <B>tixNoteBookFrame</B></I>
+</code></code></code></pre>
+<UL>
+The "note book frame" widget that displays ths tabs of the notebook.
+Most of the display options of the page tabs are controlled by this
+subwidget. For example, if you need to choose a different font to
+display the tab names of the pages, the color of the inactive tabs or
+the color behind the tabs, you can configure the options of the
+<B>nbframe</B></I> subwidget. See the manual page of
+<B>tixNoteBookFrame(n)</B></I> for more details.
+</UL>
+<P>
+In addition, all the page subwidgets created as a result of the
+<B>add</B></I> command can be accessed by the <B>subwidget</B></I> command. They
+are identified by the <B>pageName</B></I> parameter to the <B>add</B></I>
+command.
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixNoteBook</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a NoteBook widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+NoteBook widget such as its cursor and relief.
+
+The NoteBook widget can be used to display many windows in a
+limited space using a "notebook" metaphore. The notebook is divided
+into a stack of pages (windows). At one time only one of these pages
+can be shown. The user can navigate through these pages by choosing
+the visual "tabs" at the top of the NoteBook widget.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixNoteBook</B></I> command creates a new Tcl command whose name is
+command may be used to invoke various operations on the widget. It has
+the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+determine the exact behavior of the command. The following commands
+are possible for NoteBook widgets:
+<DL>
+<DT> <I>pathName <B>add<I> pageName </I></B>?<I>option value ...</I></B>?
+</I></B>
+<DD> Adds a new notebook page subwidget into the NoteBook widget.
+Additional parameters may be supplied to configure this page
+subwidget. Possible options are:
+</DL>
+<UL>
+<DL>
+<DT> <B>-anchor</B></I>
+</I></B>
+<DD> Specifies how the information in a tab (e.g. text or a bitmap) is to
+be displayed in the widget. Must be one of the values <B>n</B></I>,
+<B>ne</B></I>, <B>e</B></I>, <B>se</B></I>, <B>s</B></I>, <B>sw</B></I>, <B>w</B></I>, <B>nw</B></I>, or
+<B>center</B></I>. For example, nw means display the information such that
+its top-left corner is at the top-left corner of the widget.
+</DL>
+<DL>
+<DT> <B>-bitmap</B></I>
+</I></B>
+<DD> Specifies a bitmap to display on the tab of this page. The bitmap is
+displayed only if none of the <B>-label</B></I> or <B>-image</B></I> options are
+specified.
+</DL>
+<DL>
+<DT> <B>-createcmd</B></I>
+</I></B>
+<DD> Specifies a TCL command to be called the first time a page is shown on
+the screen. This option can be used to delay the creation of the
+contents of a page until necessary. Therefore, it can be used to speed
+up interface creation process especially when there are a large number
+of pages in a NoteBook widget.
+</DL>
+<DL>
+<DT> <B>-image</B></I>
+</I></B>
+<DD> Specifies an image to display on the tab of this page. The image is
+displayed only if the <B>-label</B></I> options is not specified.
+</DL>
+<DL>
+<DT> <B>-justify</B></I>
+</I></B>
+<DD> When there are multiple lines of text displayed in a tab, this option
+determines how the lines line up with each other. Must be one of left,
+</DL>
+<DL>
+<DT> <B>-label</B></I>
+</I></B>
+<DD> Specifies a text label string to display on the tab of this page subwidget.
+</DL>
+<DL>
+<DT> <B>-raisecmd</B></I>
+</I></B>
+<DD> Specifies a TCL command to be called whenever this page is raised by
+the user.
+</DL>
+<DL>
+<DT> <B>-state</B></I>
+</I></B>
+<DD> Specifies whether this page can be raised by the user. Must be either
+<B>normal</B></I> or <B>disabled</B></I>.
+</DL>
+<DL>
+<DT> <B>-underline</B></I>
+</I></B>
+<DD> Specifies the integer index of a character to underline in the tab.
+This option is used by the default bindings to implement keyboard
+traversal for menu buttons and menu entries. 0 corresponds to the
+first character of the text displayed in the widget, 1 to the next
+character, and so on.
+</DL>
+<DL>
+<DT> <B>-wraplength</B></I>
+</I></B>
+<DD> This option specifies the maximum line length of the label string on
+this tab. If the line length of the label string exceeds this length,
+it is wrapped onto the next line, so that no line is longer than the
+specified length. The value may be specified in any of the standard
+forms for screen distances. If this value is less than or equal to 0
+then no wrapping is done: lines will break only at newline characters
+in the text.
+</DL>
+</UL>
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>.<I>Option</I></B> may have any of the values accepted by the
+<B>tixNoteBook</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixNoteBook</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>delete<I> pageName</I></B>?
+</I></B>
+<DD> Deletes the page identified by <I>pageName</I></B>.
+</DL>
+<DL>
+<DT> <I>pathName <B>pagecget</B></I> <I>pageName option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B> in the page given by <I>pageName</I></B>. <I>Option</I></B> may
+have any of the values accepted by the <B>add</B></I> widget command.
+</DL>
+<DL>
+<DT> <I>pathName <B>pageconfigure<I> pageName ?<I>option</I></B>? <I>?value ...</I></B>?
+</I></B>
+<DD> When no option is given, prints out the values of all options of this
+page. If <I>option</I></B> is specified with no <I>value</I></B>, then the
+command returns the current value of that option. If one or more
+<I>option-value</I></B> pairs are specified, then the command modifies the
+command returns an empty string. <I>Option</I></B> may be any of options
+accepted by the <B>add</B></I> widget command.
+</DL>
+<DL>
+<DT> <I>pathName <B>pages</B></I>
+</I></B>
+<DD> Returns a list of the names of all the pages.
+</DL>
+<DL>
+<DT> <I>pathName <B>raise <I>pageName</I></B>
+</I></B>
+<DD> Raise the page identified by <I>pageName</I></B>.
+</DL>
+<DL>
+<DT> <I>pathName <B>raised</B></I>
+</I></B>
+<DD> Returns the name of the currently raised page.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+</DL>
+</pre><H3>BINDINGS</H3>
+<P>
+<UL>
+[1] <BR>
+When the user pressed the left mouse button over a notebook tab, the
+notebook page associated with that tab will be raised to the top of
+the stack of pages.
+</UL>
+<P>
+<UL>
+[2] <BR>
+The pages can also be selected using the keyboard. The user can type
+the <B>&lt;Tab&gt;</B></I> key to cycle among the set of pages. When the focus
+appears on the desired page, the user can type <B>&lt;Return&gt;</B></I> or
+<B>&lt;space&gt;</B></I> to select that page. Or, if the user wants to cancel the
+selection, he/she can type the <B>&lt;Escape&gt;</B></I> key.
+</UL>
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:33 EST 1997 </i> ---
+<i>Serial 853731303</i>
diff --git a/tix/man/NoteBook.n b/tix/man/NoteBook.n
new file mode 100644
index 00000000000..e7e746dcc9d
--- /dev/null
+++ b/tix/man/NoteBook.n
@@ -0,0 +1,329 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixNoteBook tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixNoteBook - Create and manipulate tixNoteBook widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixNoteBook\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+The NoteBook widget supports all the standard options of a frame widget.
+See the options(n) manual entry for details on the standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdynamicGeometry\fR
+Class: \fBDynamicGeometry\fR
+Switch: \fB\-dynamicgeometry\fR
+.fi
+.IP
+If set to false, the size of the Notebook will match the size of the
+largest page. If set to true, the size of the Notebook will match the
+size of the current page (therefore, the size may change when the user
+selects different pages). The default value is false. A setting of true
+is discouraged.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBipadX\fR
+Class: \fBPad\fR
+Switch: \fB\-ipadx\fR
+.fi
+.IP
+The amount of internal horizontal paddings around the sides of the
+page subwidgets.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBipadY\fR
+Class: \fBPad\fR
+Switch: \fB\-ipady\fR
+.fi
+.IP
+The amount of internal vertical paddings around the sides of the
+page subwidgets.
+'----------END
+'
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'----------BEGIN
+.LP
+.nf
+Name: \fBnbframe\fR
+Class: \fBtixNoteBookFrame\fR
+.fi
+.IP
+The "note book frame" widget that displays ths tabs of the notebook.
+Most of the display options of the page tabs are controlled by this
+subwidget. For example, if you need to choose a different font to
+display the tab names of the pages, the color of the inactive tabs or
+the color behind the tabs, you can configure the options of the
+\fBnbframe\fR subwidget. See the manual page of
+\fBtixNoteBookFrame(n)\fR for more details.
+'
+'----------END
+'
+.LP
+In addition, all the page subwidgets created as a result of the
+\fBadd\fR command can be accessed by the \fBsubwidget\fR command. They
+are identified by the \fBpageName\fR parameter to the \fBadd\fR
+command.
+'
+'
+.BE
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixNoteBook\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a NoteBook widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+NoteBook widget such as its cursor and relief.
+
+The NoteBook widget can be used to display many windows in a
+limited space using a "notebook" metaphore. The notebook is divided
+into a stack of pages (windows). At one time only one of these pages
+can be shown. The user can navigate through these pages by choosing
+the visual "tabs" at the top of the NoteBook widget.
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixNoteBook\fR command creates a new Tcl command whose name is
+the same as the path name of the NoteBook widget's window. This
+command may be used to invoke various operations on the widget. It has
+the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+NoteBook widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following commands
+are possible for NoteBook widgets:
+'
+'
+.TP
+'
+\fIpathName \fBadd\fI pageName \fR?\fIoption value ...\fR?
+'
+Adds a new notebook page subwidget into the NoteBook widget.
+Additional parameters may be supplied to configure this page
+subwidget. Possible options are:
+'
+.RS
+.TP
+\fB\-anchor\fR
+'
+Specifies how the information in a tab (e.g. text or a bitmap) is to
+be displayed in the widget. Must be one of the values \fBn\fR,
+\fBne\fR, \fBe\fR, \fBse\fR, \fBs\fR, \fBsw\fR, \fBw\fR, \fBnw\fR, or
+\fBcenter\fR. For example, nw means display the information such that
+its top-left corner is at the top-left corner of the widget.
+'
+.TP
+\fB\-bitmap\fR
+'
+Specifies a bitmap to display on the tab of this page. The bitmap is
+displayed only if none of the \fB-label\fR or \fB-image\fR options are
+specified.
+'
+.TP
+\fB\-createcmd\fR
+'
+Specifies a TCL command to be called the first time a page is shown on
+the screen. This option can be used to delay the creation of the
+contents of a page until necessary. Therefore, it can be used to speed
+up interface creation process especially when there are a large number
+of pages in a NoteBook widget.
+'
+.TP
+\fB\-image\fR
+'
+Specifies an image to display on the tab of this page. The image is
+displayed only if the \fB-label\fR options is not specified.
+'
+.TP
+\fB\-justify\fR
+'
+When there are multiple lines of text displayed in a tab, this option
+determines how the lines line up with each other. Must be one of left,
+center, or right. \fBLeft\fR means that the lines' left edges all
+line up, \fBcenter\fR means that the lines' centers are aligned, and
+\fBright\fR means that the lines' right edges line up.
+'
+.TP
+\fB\-label\fR
+'
+Specifies a text label string to display on the tab of this page subwidget.
+'
+.TP
+\fB\-raisecmd\fR
+'
+Specifies a TCL command to be called whenever this page is raised by
+the user.
+'
+.TP
+\fB\-state\fR
+'
+Specifies whether this page can be raised by the user. Must be either
+\fBnormal\fR or \fBdisabled\fR.
+'
+.TP
+\fB\-underline\fR
+'
+Specifies the integer index of a character to underline in the tab.
+This option is used by the default bindings to implement keyboard
+traversal for menu buttons and menu entries. 0 corresponds to the
+first character of the text displayed in the widget, 1 to the next
+character, and so on.
+'
+.TP
+\fB\-wraplength\fR
+'
+This option specifies the maximum line length of the label string on
+this tab. If the line length of the label string exceeds this length,
+it is wrapped onto the next line, so that no line is longer than the
+specified length. The value may be specified in any of the standard
+forms for screen distances. If this value is less than or equal to 0
+then no wrapping is done: lines will break only at newline characters
+in the text.
+'
+'
+.RE
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR.\fIOption\fR may have any of the values accepted by the
+\fBtixNoteBook\fR command.
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixNoteBook\fR command.
+'
+'
+.TP
+\fIpathName \fBdelete\fI pageName\fR?
+'
+Deletes the page identified by \fIpageName\fR.
+'
+.TP
+\fIpathName \fBpagecget\fR \fIpageName option\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR in the page given by \fIpageName\fR. \fIOption\fR may
+have any of the values accepted by the \fBadd\fR widget command.
+'
+'
+.TP
+\fIpathName \fBpageconfigure\fI pageName ?\fIoption\fR? \fI?value ...\fR?
+'
+'
+When no option is given, prints out the values of all options of this
+page. If \fIoption\fR is specified with no \fIvalue\fR, then the
+command returns the current value of that option. If one or more
+\fIoption\-value\fR pairs are specified, then the command modifies the
+given page's option(s) to have the given value(s); in this case the
+command returns an empty string. \fIOption\fR may be any of options
+accepted by the \fBadd\fR widget command.
+'
+.TP
+\fIpathName \fBpages\fR
+'
+Returns a list of the names of all the pages.
+'
+.TP
+\fIpathName \fBraise \fIpageName\fR
+'
+Raise the page identified by \fIpageName\fR.
+'
+.TP
+\fIpathName \fBraised\fR
+'
+Returns the name of the currently raised page.
+'
+.TP
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+'
+'
+'----------------------------------------------------------------------
+.SH BINDINGS
+.PP
+.IP [1]
+When the user pressed the left mouse button over a notebook tab, the
+notebook page associated with that tab will be raised to the top of
+the stack of pages.
+'
+.PP
+.IP [2]
+The pages can also be selected using the keyboard. The user can type
+the \fB<Tab>\fR key to cycle among the set of pages. When the focus
+appears on the desired page, the user can type \fB<Return>\fR or
+\fB<space>\fR to select that page. Or, if the user wants to cancel the
+selection, he/she can type the \fB<Escape>\fR key.
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/OptMenu.html b/tix/man/OptMenu.html
new file mode 100644
index 00000000000..a61929ce831
--- /dev/null
+++ b/tix/man/OptMenu.html
@@ -0,0 +1,232 @@
+
+
+
+<TITLE>tixOptionMenu - Create and manipulate tixOptionMenu widgets</TITLE>
+<Center><H2>tixOptionMenu - Create and manipulate tixOptionMenu widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixOptionMenu<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+The <B>TixOptionMenu</B></I> class is derived from the <B>TixLabelWidget</B></I>
+class and inherits all the commands, options and
+subwidgets of its super-class.
+</pre><H3>STANDARD OPTIONS</H3>
+The OptionMenu widget supports all the standard Tix widget
+options. See the <B>Tix-Options(n)</B></I> manual entry for details on the
+standard Tix widget options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>command</B></I>
+Class: <B>Command</B></I>
+Switch: <B>-command</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the command to be called when the <B>-value</B></I> option of
+the OptionMenu is changed. The command will be called with one
+arguments -- the new value of the OptionMenu widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>disableCallback</B></I>
+Class: <B>DisableCallback</B></I>
+Switch: <B>-disablecallback</B></I>
+</code></code></code></pre>
+<UL>
+A boolean value indicating whether callbacks should be disabled. When
+set to true, the TCL command specified by the <B>-command</B></I> option
+is not executed when the <B>-value</B></I> of the OptionMenu widget
+changes.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>dynamicGeometry</B></I>
+Class: <B>DynamicGeometry</B></I>
+Switch: <B>-dynamicgeometry</B></I>
+</code></code></code></pre>
+<UL>
+A boolean value indicating whether the size of the <B>menubutton</B></I>
+subwidget should change dynamically to match the width of the
+currently selected menu entry. If set to false (the default), the the
+size of the menubutton subwidget will be wide enough to display every
+menu entry fully and does not change when the user selects different
+entries.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>label</B></I>
+Class: <B>Label</B></I>
+Switch: <B>-label</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the string to display as the label of this OptionMenu widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>labelSide</B></I>
+Class: <B>LabelSide</B></I>
+Switch: <B>-labelside</B></I>
+</code></code></code></pre>
+<UL>
+Specifies where the label should be displayed relative to the entry
+subwidget. Valid options are: <B>top</B></I>, <B>left</B></I>, <B>right</B></I>,
+<B>bottom</B></I>, <B>none</B></I> or <B>acrosstop</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>state</B></I>
+Class: <B>State</B></I>
+Switch: <B>-state</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the whether the OptionMenu widget is normal or disabled. Only
+the values "normal" and "disabled" are recognized.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>value</B></I>
+Class: <B>Value</B></I>
+Switch: <B>-value</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the value of the OptionMenu. The value of the OptionMenu
+widget is the name of the item currently displayed by its
+<B>menubutton</B></I> subwidget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>variable</B></I>
+Class: <B>Variable</B></I>
+Switch: <B>-variable</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the global variable in which the value of the OptionMenu
+should be stored. The value of the OptionMenu will be automatically
+updated when this variable is changed.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>menu</B></I>
+Class: <B>Menu</B></I>
+</code></code></code></pre>
+<UL>
+The menu subwidget, which is popped up when the user press the
+<B>menubutton</B></I> subwidget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>menubutton</B></I>
+Class: <B>Menubutton</B></I>
+</code></code></code></pre>
+<UL>
+The menubutton subwidget.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixOptionMenu</B></I> command creates a new window (given by
+the <I>pathName</I></B> argument) and makes it into a OptionMenu
+widget. Additional options, described above, may be specified on the
+command line or in the option database to configure aspects of the
+OptionMenu such as its cursor and relief.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixOptionMenu</B></I> command creates a new Tcl command whose
+window. This command may be used to invoke various operations on the
+widget. It has the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+<I>arg</I></B>s determine the exact behavior of the command. The following
+commands are possible for OptionMenu widgets:
+<DL>
+<DT> <I>pathName <B>add</B></I> <I>type name </I></B>?<I>option value ...</I></B>?
+</I></B>
+<DD> Adds a new item into the OptionMenu widget. <I>type</I></B> must be either
+<B>command</B></I> or <B>separator</B></I>. The <I>options</I></B> may be any of the
+valid options for the <B>command</B></I> or <B>separator</B></I> menu entry
+types for the TK <B>menu</B></I> widget class, except <B>-command</B></I>.
+</DL>
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixOptionMenu</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixOptionMenu</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>delete</B></I> <I>name</I></B>
+</I></B>
+<DD> Deletes the menu entry identified by <I>name</I></B>.
+</DL>
+<DL>
+<DT> <I>pathName <B>disable</B></I> <I>name</I></B>
+</I></B>
+<DD> Disables the menu entry identified by <I>name</I></B>.
+</DL>
+<DL>
+<DT> <I>pathName <B>enable</B></I> <I>name</I></B>
+</I></B>
+<DD> Enables the menu entry identified by <I>name</I></B>.
+</DL>
+<DL>
+<DT> <I>pathName <B>entrycget</B></I> <I>name option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B> in the menu entry identified by <I>name</I></B>. <I>Option</I></B>
+may have any of the values accepted by the <B>add</B></I> widget command.
+</DL>
+<DL>
+<DT> <I>pathName <B>entryconfigure<I> name</I></B> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the menu entry identified
+by <I>name</I></B>. If no <I>option</I></B> is specified, returns a list
+describing all of the available options for the menu entry (see
+<B>Tk_ConfigureInfo</B></I> for information on the format of this list).
+If <I>option</I></B> is specified with no <I>value</I></B>, then the command
+returns a list describing the one named option (this list will be
+identical to the corresponding sublist of the value returned if no
+<I>option</I></B> is specified). If one or more <I>option-value</I></B> pairs
+are specified, then the command modifies the given option(s) to
+have the given value(s); in this case the command returns an empty
+string. <I>Option</I></B> may have any of the values accepted by the
+<B>add</B></I> widget command.
+</DL>
+<DL>
+<DT> <I>pathName <B>entries</B></I>
+</I></B>
+<DD> Returns the names of all the entries currently in the OptionMenu
+widget.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I>name ?args?</I></B>
+</I></B>
+<DD> When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+</DL>
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:34 EST 1997 </i> ---
+<i>Serial 853731303</i>
diff --git a/tix/man/OptMenu.n b/tix/man/OptMenu.n
new file mode 100644
index 00000000000..873a33075fa
--- /dev/null
+++ b/tix/man/OptMenu.n
@@ -0,0 +1,306 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixOptionMenu tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixOptionMenu \- Create and manipulate tixOptionMenu widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixOptionMenu\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+The \fBTixOptionMenu\fR class is derived from the \fBTixLabelWidget\fR
+class and inherits all the commands, options and
+subwidgets of its super-class.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+The OptionMenu widget supports all the standard Tix widget
+options. See the \fBTix-Options(n)\fR manual entry for details on the
+standard Tix widget options.
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Switch: \fB\-command\fR
+.fi
+.IP
+Specifies the command to be called when the \fB\-value\fR option of
+the OptionMenu is changed. The command will be called with one
+arguments -- the new value of the OptionMenu widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdisableCallback\fR
+Class: \fBDisableCallback\fR
+Switch: \fB\-disablecallback\fR
+.fi
+.IP
+A boolean value indicating whether callbacks should be disabled. When
+set to true, the TCL command specified by the \fB\-command\fR option
+is not executed when the \fB\-value\fR of the OptionMenu widget
+changes.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdynamicGeometry\fR
+Class: \fBDynamicGeometry\fR
+Switch: \fB\-dynamicgeometry\fR
+.fi
+.IP
+A boolean value indicating whether the size of the \fBmenubutton\fR
+subwidget should change dynamically to match the width of the
+currently selected menu entry. If set to false (the default), the the
+size of the menubutton subwidget will be wide enough to display every
+menu entry fully and does not change when the user selects different
+entries.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabel\fR
+Class: \fBLabel\fR
+Switch: \fB\-label\fR
+.fi
+.IP
+Specifies the string to display as the label of this OptionMenu widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabelSide\fR
+Class: \fBLabelSide\fR
+Switch: \fB\-labelside\fR
+.fi
+.IP
+Specifies where the label should be displayed relative to the entry
+subwidget. Valid options are: \fBtop\fR, \fBleft\fR, \fBright\fR,
+\fBbottom\fR, \fBnone\fR or \fBacrosstop\fR.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Switch: \fB\-state\fR
+.fi
+.IP
+Specifies the whether the OptionMenu widget is normal or disabled. Only
+the values "normal" and "disabled" are recognized.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvalue\fR
+Class: \fBValue\fR
+Switch: \fB\-value\fR
+.fi
+.IP
+Specifies the value of the OptionMenu. The value of the OptionMenu
+widget is the name of the item currently displayed by its
+\fBmenubutton\fR subwidget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvariable\fR
+Class: \fBVariable\fR
+Switch: \fB\-variable\fR
+.fi
+.IP
+Specifies the global variable in which the value of the OptionMenu
+should be stored. The value of the OptionMenu will be automatically
+updated when this variable is changed.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'----------BEGIN
+.LP
+.nf
+Name: \fBmenu\fR
+Class: \fBMenu\fR
+.fi
+.IP
+The menu subwidget, which is popped up when the user press the
+\fBmenubutton\fR subwidget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBmenubutton\fR
+Class: \fBMenubutton\fR
+.fi
+.IP
+The menubutton subwidget.
+'----------END
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixOptionMenu\fR command creates a new window (given by
+the \fIpathName\fR argument) and makes it into a OptionMenu
+widget. Additional options, described above, may be specified on the
+command line or in the option database to configure aspects of the
+OptionMenu such as its cursor and relief.
+'
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixOptionMenu\fR command creates a new Tcl command whose
+name is the same as the path name of the OptionMenu's
+window. This command may be used to invoke various operations on the
+widget. It has the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+OptionMenu widget's path name. \fIOption\fR and the
+\fIarg\fRs determine the exact behavior of the command. The following
+commands are possible for OptionMenu widgets:
+'
+'
+.TP
+\fIpathName \fBadd\fR \fItype name \fR?\fIoption value ...\fR?
+'
+Adds a new item into the OptionMenu widget. \fItype\fR must be either
+\fBcommand\fR or \fBseparator\fR. The \fIoptions\fR may be any of the
+valid options for the \fBcommand\fR or \fBseparator\fR menu entry
+types for the TK \fBmenu\fR widget class, except \fB\-command\fR.
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixOptionMenu\fR command.
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixOptionMenu\fR command.
+'
+.TP
+\fIpathName \fBdelete\fR \fIname\fR
+'
+Deletes the menu entry identified by \fIname\fR.
+'
+'
+.TP
+\fIpathName \fBdisable\fR \fIname\fR
+'
+Disables the menu entry identified by \fIname\fR.
+'
+.TP
+\fIpathName \fBenable\fR \fIname\fR
+'
+Enables the menu entry identified by \fIname\fR.
+'
+'
+.TP
+\fIpathName \fBentrycget\fR \fIname option\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR in the menu entry identified by \fIname\fR. \fIOption\fR
+may have any of the values accepted by the \fBadd\fR widget command.
+'
+.TP
+'
+\fIpathName \fBentryconfigure\fI name\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the menu entry identified
+by \fIname\fR. If no \fIoption\fR is specified, returns a list
+describing all of the available options for the menu entry (see
+\fBTk_ConfigureInfo\fR for information on the format of this list).
+If \fIoption\fR is specified with no \fIvalue\fR, then the command
+returns a list describing the one named option (this list will be
+identical to the corresponding sublist of the value returned if no
+\fIoption\fR is specified). If one or more \fIoption\-value\fR pairs
+are specified, then the command modifies the given option(s) to
+have the given value(s); in this case the command returns an empty
+string. \fIOption\fR may have any of the values accepted by the
+\fBadd\fR widget command.
+'
+.TP
+\fIpathName \fBentries\fR
+'
+Returns the names of all the entries currently in the OptionMenu
+widget.
+'
+.TP
+\fIpathName \fBsubwidget \fIname ?args?\fR
+'
+When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+'
+'
+'
+'----------------------------------------------------------------------
+'.SH BINDINGS
+'.PP
+'
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/PanedWin.html b/tix/man/PanedWin.html
new file mode 100644
index 00000000000..8a7bdf43b3a
--- /dev/null
+++ b/tix/man/PanedWin.html
@@ -0,0 +1,307 @@
+
+
+
+<TITLE>tixPanedWindow - Create and manipulate tixPanedWindow widgets</TITLE>
+<Center><H2>tixPanedWindow - Create and manipulate tixPanedWindow widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixPanedWindow<I> <I>pathName ?<I>options</I></B>?
+</pre><H3>STANDARD OPTIONS</H3>
+The PanedWindow widget supports all the standard options of a frame
+widget. See the <B>options(n)</B></I> manual entry for details on the
+standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>command</B></I>
+Class: <B>Command</B></I>
+Switch: <B>-command</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the command to invoke when the panes change their sizes.
+This command is called with a list of integers that record the new
+sizes of the panes. The sizes of the panes are listed in the order of
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>dynamicGeometry</B></I>
+Class: <B>DynamicGeometry</B></I>
+Switch: <B>-dynamicgeometry</B></I>
+</code></code></code></pre>
+<UL>
+If set to true, the size of the PanedWindow will dynamically change
+if the size of any of its panes changes. Otherwise, the size of the
+PanedWindow will only increase when size of any of its panes changes
+and will not decrease. The default value is true.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>handleActiveBg</B></I>
+Class: <B>HandleActiveBg</B></I>
+Switch: <B>-handleactivebg</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the active background color of the resize handles. When the
+mouse cursor enters a resize handle, the resize handle will adopt
+the active background color.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>handleBg</B></I>
+Class: <B>Background</B></I>
+Switch: <B>-handlebg</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the normal background color of the resize handles.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>height</B></I>
+Class: <B>Height</B></I>
+Switch: <B>-height</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the desired height for the window.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>orientation</B></I>
+Class: <B>Orientation</B></I>
+Switch: <B>-orientation</B></I>
+Alias: <B>-orient</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the orientation of the panes. Must be either <B>vertical</B></I>
+or <B>horizontal</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>paneBorderWidth</B></I>
+Class: <B>PaneBorderWidth</B></I>
+Switch: <B>-paneborderwidth</B></I>
+Alias: <B>-panebd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the border width of the panes.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>paneRelief</B></I>
+Class: <B>PaneRelief</B></I>
+Switch: <B>-panerelief</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the border relief of the panes.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>separatorActiveBg</B></I>
+Class: <B>SeparatorActiveBg</B></I>
+Switch: <B>-separatoractivebg</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the active background color of the separators. When the user
+grabs a resize handle, the separators
+will adopt the active background color.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>separatorBg</B></I>
+Class: <B>Background</B></I>
+Switch: <B>-separatorbg</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the normal background color of the separators.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>width</B></I>
+Class: <B>Width</B></I>
+Switch: <B>-width</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the desired width for the window.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+All the pane subwidgets created as a result of the <B>add</B></I> command
+can be accessed by the <B>subwidget</B></I> command. They are identified by
+the <B>paneName</B></I> parameter to the <B>add</B></I> command.
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+
+<P>
+The <B>tixPanedWindow</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a PanedWindow widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+PanedWindow widget such as its cursor and relief.
+<P>
+The PanedWindow widget allows the user to interactively manipulate the
+sizes of several panes. The panes can be arranged either vertically or
+horizontally. Each individual pane may have upper and lower limits of
+its size. The user changes the sizes of the panes by dragging the
+resize handle between two panes.
+</pre><H3>WIDGET COMMAND</H3>
+<P>
+The <B>tixPanedWindow</B></I> command creates a new Tcl command whose name is
+command may be used to invoke various operations on the widget. It
+has the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+the exact behavior of the command. The following commands are
+possible for PanedWindow widgets:
+<DL>
+<DT> <I>pathName <B>add<I> paneName </I></B>?<I>option value ...</I></B>?
+</I></B>
+<DD> Adds a new pane subwidget with the name <I>paneName</I></B> into the
+PanedWindow widget. Additional configuration options can be
+given to configure the new button subwidget. Three configuration
+options are supported:
+</DL>
+<UL>
+<DL>
+<DT> <B>-after</B></I> <I>pane</I></B>
+</I></B>
+<DD> Specifies that the new pane should be placed after <I>pane</I></B> in the
+list of panes in this PanedWindow widget.
+<B>-at</B></I> <I>integer</I></B>
+Specifies the position of the new pane in the list of panes in this
+PanedWindow widget. <B>0</B></I> means the first position, <B>1</B></I> means
+the second, and so on. In addition, <B>end</B></I> means the end of the
+list.
+</DL>
+<DL>
+<DT> <B>-before</B></I> <I>pane</I></B>
+</I></B>
+<DD> Specifies that the new pane should be placed before <I>pane</I></B> in the
+list of panes in this PanedWindow widget.
+</DL>
+<DL>
+<DT> <B>-expand</B></I> <I>factor</I></B>
+</I></B>
+<DD> Specifies the <B>expand/shrink factor</B></I> of this pane. <I>Factor</I></B>
+must be a non-negative floating point number. The default value is
+0.0. The expand/shrink factor is used to calculate how much each pane
+should grow or shrink when the size of the PanedWindow main window is
+changed. When the main window expands/shrinks by <I>n</I></B> pixels, then
+pane <I>i</I></B> will grow/shrink by about <I>n * factor(i) /
+summation(factors)</B></I>, where <I>factor(i)</I></B> is the expand/shrink
+factor of pane i and <I>summation(factors)</I></B> is the summation of the
+expand/shrink factors of all the panes. If <I>summation(factors)</I></B> is
+0.0, however, only the last visible pane will be grown or shrunk.
+</DL>
+<DL>
+<DT> <B>-min</B></I> <I>integer</I></B>
+</I></B>
+<DD> Specifies the minimum size, in pixels, of the new pane; the default is 0.
+</DL>
+<DL>
+<DT> <B>-max</B></I> <I>integer</I></B>
+</I></B>
+<DD> Specifies the maximum size, in pixels, of the new pane; the default is 10000.
+</DL>
+<DL>
+<DT> <B>-size</B></I> <I>integer</I></B>
+</I></B>
+<DD> Specifies the size, in pixels, of the new pane; if the <B>-size</B></I>
+option is not given, or set to the empty string, the PanedWindow
+widget will use the natural size of the pane subwidget.
+</DL>
+</UL>
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may be <B>-min</B></I>, <B>-max</B></I> and/or
+<B>-size</B></I>, or any option accepted by the Tk frame widget.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may be any
+of the non-static options of the PanedWindow widget.
+</DL>
+<DL>
+<DT> <I>pathName <B>delete</B></I> <I>paneName</I></B>
+</I></B>
+<DD> Removes the pane given by <I>paneName</I></B> and deletes its contents.
+</DL>
+<DL>
+<DT> <I>pathName <B>forget</B></I> <I>paneName</I></B>
+</I></B>
+<DD> Removes the pane given by <I>paneName</I></B> but does not delete its
+contents. This pane can be later added back to the PanedWindow widget
+by the <B>manage</B></I> method.
+</DL>
+<DL>
+<DT> <I>pathName <B>manage</B></I> <I>paneName </I></B>?<I>option value ...</I></B>?
+</I></B>
+<DD> Adds the pane given by <I>paneName</I></B> back to the PanedWindow widget.
+<I>PaneName</I></B> must be already forgotten by the <B>forget</B></I>
+method. Additional <I>option-value</I></B> pairs, same as those accepted by
+the <B>add</B></I> method, can be given to control the appearance and
+position of the pane.
+</DL>
+<DL>
+<DT> <I>pathName <B>panecget</B></I> <I>paneName option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B> in the pane given by <I>paneName</I></B>. <I>Option</I></B> may
+have any of the values accepted by the <B>add</B></I> widget command.
+</DL>
+<DL>
+<DT> <I>pathName <B>paneconfigure<I> paneName ?<I>option</I></B>? <I>?value ...</I></B>?
+</I></B>
+<DD> When no option is given, prints out the values of all options of this
+pane. If <I>option</I></B> is specified with no <I>value</I></B>, then the
+command returns the current value of that option. If one or more
+<I>option-value</I></B> pairs are specified, then the command modifies the
+command returns an empty string. <I>Option</I></B> may be <B>-min</B></I>,
+<B>-max</B></I> and/or <B>-size</B></I>, or any option accepted by the Tk
+frame widget. The sizes of the panes may be changed as a result of
+calling the <B>paneconfigure</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>panes</B></I>
+</I></B>
+<DD> Returns a list of the names of all panes.
+</DL>
+<DL>
+<DT> <I>pathName <B>setsize</B></I> <I>paneName newSize</I></B> ?<I>direction</I></B>?
+</I></B>
+<DD> Sets the size of the pane specified by <I>paneName</I></B> to
+<I>newSize</I></B>. The <I>direction</I></B> parameter specifies in which
+direction the pane should grow/shrink. Possible values are <B>next</B></I>:
+the pane will grow or shrink by moving the boundary between itself and
+the pane to its right or bottom; <B>prev</B></I>: the pane will grow or
+shrink by moving the boundary between itself and the pane to its left
+or top.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no options are given, returns the pathname of the subwidget of
+the specified name.
+
+When options are given, the widget command of the specified subwidget will
+be called with these options.
+</DL>
+</pre><H3>BINDINGS</H3>
+<B>-max</B></I> and <B>-size</B></I> options of the panes.
+</pre><H3>KEYWORDS</H3>
+TIX, Container Widget
+<hr><i>Last modified Sun Jan 19 22:34:35 EST 1997 </i> ---
+<i>Serial 853731303</i>
diff --git a/tix/man/PanedWin.n b/tix/man/PanedWin.n
new file mode 100644
index 00000000000..558d0603804
--- /dev/null
+++ b/tix/man/PanedWin.n
@@ -0,0 +1,400 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixPanedWindow tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixPanedWindow \- Create and manipulate tixPanedWindow widgets
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixPanedWindow\fI \fIpathName ?\fIoptions\fR?
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+The PanedWindow widget supports all the standard options of a frame
+widget. See the \fBoptions(n)\fR manual entry for details on the
+standard options.
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+'
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Switch: \fB\-command\fR
+'
+.fi
+.IP
+'
+Specifies the command to invoke when the panes change their sizes.
+This command is called with a list of integers that record the new
+sizes of the panes. The sizes of the panes are listed in the order of
+the panes' creation.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdynamicGeometry\fR
+Class: \fBDynamicGeometry\fR
+Switch: \fB\-dynamicgeometry\fR
+.fi
+.IP
+'
+If set to true, the size of the PanedWindow will dynamically change
+if the size of any of its panes changes. Otherwise, the size of the
+PanedWindow will only increase when size of any of its panes changes
+and will not decrease. The default value is true.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+'
+Name: \fBhandleActiveBg\fR
+Class: \fBHandleActiveBg\fR
+Switch: \fB\-handleactivebg\fR
+'
+.fi
+.IP
+'
+Specifies the active background color of the resize handles. When the
+mouse cursor enters a resize handle, the resize handle will adopt
+the active background color.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+'
+Name: \fBhandleBg\fR
+Class: \fBBackground\fR
+Switch: \fB\-handlebg\fR
+'
+.fi
+.IP
+'
+Specifies the normal background color of the resize handles.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Switch: \fB\-height\fR
+.fi
+.IP
+Specifies the desired height for the window.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBorientation\fR
+Class: \fBOrientation\fR
+Switch: \fB\-orientation\fR
+Alias: \fB\-orient\fR
+.fi
+.IP
+Specifies the orientation of the panes. Must be either \fBvertical\fR
+or \fBhorizontal\fR.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBpaneBorderWidth\fR
+Class: \fBPaneBorderWidth\fR
+Switch: \fB\-paneborderwidth\fR
+Alias: \fB\-panebd\fR
+.fi
+.IP
+Specifies the border width of the panes.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBpaneRelief\fR
+Class: \fBPaneRelief\fR
+Switch: \fB\-panerelief\fR
+.fi
+.IP
+Specifies the border relief of the panes.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+'
+Name: \fBseparatorActiveBg\fR
+Class: \fBSeparatorActiveBg\fR
+Switch: \fB\-separatoractivebg\fR
+'
+.fi
+.IP
+'
+Specifies the active background color of the separators. When the user
+grabs a resize handle, the separators
+will adopt the active background color.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+'
+Name: \fBseparatorBg\fR
+Class: \fBBackground\fR
+Switch: \fB\-separatorbg\fR
+'
+.fi
+.IP
+'
+Specifies the normal background color of the separators.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Switch: \fB\-width\fR
+.fi
+.IP
+Specifies the desired width for the window.
+'----------END
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+.PP
+'
+All the pane subwidgets created as a result of the \fBadd\fR command
+can be accessed by the \fBsubwidget\fR command. They are identified by
+the \fBpaneName\fR parameter to the \fBadd\fR command.
+'
+.BE
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+
+.PP
+'
+The \fBtixPanedWindow\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a PanedWindow widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+PanedWindow widget such as its cursor and relief.
+'
+.PP
+'
+The PanedWindow widget allows the user to interactively manipulate the
+sizes of several panes. The panes can be arranged either vertically or
+horizontally. Each individual pane may have upper and lower limits of
+its size. The user changes the sizes of the panes by dragging the
+resize handle between two panes.
+'
+'----------------------------------------------------------------------
+.SH "WIDGET COMMAND"
+'
+.PP
+'
+The \fBtixPanedWindow\fR command creates a new Tcl command whose name is
+the same as the path name of the PanedWindow widget's window. This
+command may be used to invoke various operations on the widget. It
+has the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+'
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+frame widget's path name. \fIOption\fR and the \fIarg\fRs determine
+the exact behavior of the command. The following commands are
+possible for PanedWindow widgets:
+'
+.TP
+'
+\fIpathName \fBadd\fI paneName \fR?\fIoption value ...\fR?
+'
+Adds a new pane subwidget with the name \fIpaneName\fR into the
+PanedWindow widget. Additional configuration options can be
+given to configure the new button subwidget. Three configuration
+options are supported:
+.RS
+'
+.TP
+\fB\-after\fR \fIpane\fR
+'
+Specifies that the new pane should be placed after \fIpane\fR in the
+list of panes in this PanedWindow widget.
+'
+\fB\-at\fR \fIinteger\fR
+'
+Specifies the position of the new pane in the list of panes in this
+PanedWindow widget. \fB0\fR means the first position, \fB1\fR means
+the second, and so on. In addition, \fBend\fR means the end of the
+list.
+'
+.TP
+\fB\-before\fR \fIpane\fR
+'
+Specifies that the new pane should be placed before \fIpane\fR in the
+list of panes in this PanedWindow widget.
+'
+.TP
+\fB\-expand\fR \fIfactor\fR
+'
+Specifies the \fBexpand/shrink factor\fR of this pane. \fIFactor\fR
+must be a non-negative floating point number. The default value is
+0.0. The expand/shrink factor is used to calculate how much each pane
+should grow or shrink when the size of the PanedWindow main window is
+changed. When the main window expands/shrinks by \fIn\fR pixels, then
+pane \fIi\fR will grow/shrink by about \fIn * factor(i) /
+summation(factors)\fR, where \fIfactor(i)\fR is the expand/shrink
+factor of pane i and \fIsummation(factors)\fR is the summation of the
+expand/shrink factors of all the panes. If \fIsummation(factors)\fR is
+0.0, however, only the last visible pane will be grown or shrunk.
+'
+.TP
+\fB\-min\fR \fIinteger\fR
+'
+Specifies the minimum size, in pixels, of the new pane; the default is 0.
+'
+.TP
+\fB\-max\fR \fIinteger\fR
+Specifies the maximum size, in pixels, of the new pane; the default is 10000.
+'
+.TP
+\fB\-size\fR \fIinteger\fR
+Specifies the size, in pixels, of the new pane; if the \fB\-size\fR
+option is not given, or set to the empty string, the PanedWindow
+widget will use the natural size of the pane subwidget.
+'
+.RE
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may be \fB\-min\fR, \fB\-max\fR and/or
+\fB\-size\fR, or any option accepted by the Tk frame widget.
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may be any
+of the non-static options of the PanedWindow widget.
+'
+.TP
+\fIpathName \fBdelete\fR \fIpaneName\fR
+'
+Removes the pane given by \fIpaneName\fR and deletes its contents.
+'
+.TP
+\fIpathName \fBforget\fR \fIpaneName\fR
+'
+Removes the pane given by \fIpaneName\fR but does not delete its
+contents. This pane can be later added back to the PanedWindow widget
+by the \fBmanage\fR method.
+'
+.TP
+\fIpathName \fBmanage\fR \fIpaneName \fR?\fIoption value ...\fR?
+'
+Adds the pane given by \fIpaneName\fR back to the PanedWindow widget.
+\fIPaneName\fR must be already forgotten by the \fBforget\fR
+method. Additional \fIoption-value\fR pairs, same as those accepted by
+the \fBadd\fR method, can be given to control the appearance and
+position of the pane.
+'
+.TP
+\fIpathName \fBpanecget\fR \fIpaneName option\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR in the pane given by \fIpaneName\fR. \fIOption\fR may
+have any of the values accepted by the \fBadd\fR widget command.
+'
+.TP
+'
+\fIpathName \fBpaneconfigure\fI paneName ?\fIoption\fR? \fI?value ...\fR?
+'
+'
+When no option is given, prints out the values of all options of this
+pane. If \fIoption\fR is specified with no \fIvalue\fR, then the
+command returns the current value of that option. If one or more
+\fIoption\-value\fR pairs are specified, then the command modifies the
+given pane's option(s) to have the given value(s); in this case the
+command returns an empty string. \fIOption\fR may be \fB\-min\fR,
+\fB\-max\fR and/or \fB\-size\fR, or any option accepted by the Tk
+frame widget. The sizes of the panes may be changed as a result of
+calling the \fBpaneconfigure\fR command.
+'
+.TP
+\fIpathName \fBpanes\fR
+'
+Returns a list of the names of all panes.
+'
+.TP
+\fIpathName \fBsetsize\fR \fIpaneName newSize\fR ?\fIdirection\fR?
+'
+Sets the size of the pane specified by \fIpaneName\fR to
+\fInewSize\fR. The \fIdirection\fR parameter specifies in which
+direction the pane should grow/shrink. Possible values are \fBnext\fR:
+the pane will grow or shrink by moving the boundary between itself and
+the pane to its right or bottom; \fBprev\fR: the pane will grow or
+shrink by moving the boundary between itself and the pane to its left
+or top.
+'
+.TP
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no options are given, returns the pathname of the subwidget of
+the specified name.
+
+When options are given, the widget command of the specified subwidget will
+be called with these options.
+'
+'----------------------------------------------------------------------
+.SH BINDINGS
+'
+The panes' sizes will be changed when the user drags the handles. The
+change in the panes' sizes may be subjected to the \fB\-min\fR,
+\fB\-max\fR and \fB\-size\fR options of the panes.
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+'
+TIX, Container Widget
diff --git a/tix/man/PopMenu.html b/tix/man/PopMenu.html
new file mode 100644
index 00000000000..db33efbeebb
--- /dev/null
+++ b/tix/man/PopMenu.html
@@ -0,0 +1,177 @@
+
+
+
+<TITLE>tixPopupMenu - Create and manipulate tixPopupMenu widgets</TITLE>
+<Center><H2>tixPopupMenu - Create and manipulate tixPopupMenu widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixPopupMenu<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+The <B>tixPopupMenu</B></I> class is derived from the <B>TixShell</B></I>
+class and inherits all the commands, options and subwidgets of its
+super-class.
+</pre><H3>STANDARD OPTIONS</H3>
+The PopupMenu widget supports all the standard options of a frame widget.
+See the <B>options(n)</B></I> manual entry for details on the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>buttons</B></I>
+Class: <B>Buttons</B></I>
+Switch: <B>-buttons</B></I>
+</code></code></code></pre>
+<UL>
+A TCL list that specifies the mouse button(s) and key modifier(s) that
+bring up the popup menu. Each element of this list is in turn a list
+that contains two elements: the first element is an integer that
+indicates the
+mouse button that brings up the popup menu; the second element
+specifies the key modifiers that should be used in conjunction with
+the mouse button. For example, the value <B>{{1 {Control Meta}} {3
+{Any}}}</B></I> specifies that the popup menu can be popped up by (a)
+pressing mouse button 1 with either the Control or the Meta key or (b)
+pressing mouse button 3 with any key modifier. The default value is
+<B>{{3 {Any}}}</B></I>: only mouse button 3 brings up the popup menu.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>postCmd</B></I>
+Class: <B>PostCmd</B></I>
+Switch: <B>-postcmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a command to be evaluated just before the menu is about to
+pop-up. This command is called with two default arguments: the root
+x-y coordinates where the user has pressed the mouse button. This
+command must return a boolean value: a false indicates that the menu
+should be popped up. This option can be used to find out where the
+user has pressed the mouse-button and optionally disable the popup
+menu over certain screen areas.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>spring</B></I>
+Class: <B>Spring</B></I>
+Switch: <B>-spring</B></I>
+</code></code></code></pre>
+<UL>
+When set to <B>true</B></I>, the menu will be automatically popped down if
+the user releases the mouse button outside of the menu and no menu
+commands will be invoked. This makes it easy for the user to cancel
+the popup menu without pressing the Escape key. The default value is
+<B>true</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>state</B></I>
+Class: <B>State</B></I>
+Switch: <B>-state</B></I>
+</code></code></code></pre>
+<UL>
+Must be either <B>disabled</B></I> or <B>normal</B></I>. The PopupMenu widget will not
+pop up unless its <B>-state</B></I> is set to <B>normal</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>title</B></I>
+Class: <B>Title</B></I>
+Switch: <B>-title</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a text string to display inside the <B>menubutton</B></I>
+subwidget, as the title of this PopupMenu.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>menu</B></I>
+Class: <B>Menu</B></I>
+</code></code></code></pre>
+<UL>
+The menu subwidget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>menubutton</B></I>
+Class: <B>Menubutton</B></I>
+</code></code></code></pre>
+<UL>
+The menubutton subwidget.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixPopupMenu</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a PopupMenu widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+PopupMenu widget such as its cursor and relief.
+
+The Tix PopupMenu widget can be used as a replacement of the
+<B>tk_popup</B></I> command. The advantage of the Tix PopupMenu widget is
+it requires less application code to manipulate. Also, it provides a
+title for the popup menu, which is not available from <B>tk_popup</B></I>.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixPopupMenu</B></I> command creates a new Tcl command whose name is
+command may be used to invoke various operations on the widget. It has
+the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+determine the exact behavior of the command. The following commands
+are possible for PopupMenu widgets:
+<DL>
+<DT> <I>pathName <B>bind <I>widget </I></B>?<I>widget ...</I></B>?
+</I></B>
+<DD> Binds this PopupMenu to one or more <I>widgets</I></B>. The PopupMenu
+will be activated when the user presses the right mouse button over
+these <I>widgets</I></B>.
+</DL>
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixPopupMenu</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixPopupMenu</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>post <I>widget x y</I></B>
+</I></B>
+<DD> Posts the PopupMenu inside the <I>widget</I></B> at the coordinate
+<I>x</I></B>,<I>y</I></B>.
+</DL>
+<DL>
+<DT> <I>pathName <B>unbind <I>widget </I></B>?<I>widget ...</I></B>?
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+</DL>
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:35 EST 1997 </i> ---
+<i>Serial 853731303</i>
diff --git a/tix/man/PopMenu.n b/tix/man/PopMenu.n
new file mode 100644
index 00000000000..5df47c4e54d
--- /dev/null
+++ b/tix/man/PopMenu.n
@@ -0,0 +1,246 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixPopupMenu tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixPopupMenu \- Create and manipulate tixPopupMenu widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixPopupMenu\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+The \fBtixPopupMenu\fR class is derived from the \fBTixShell\fR
+class and inherits all the commands, options and subwidgets of its
+super-class.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+The PopupMenu widget supports all the standard options of a frame widget.
+See the \fBoptions(n)\fR manual entry for details on the standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBbuttons\fR
+Class: \fBButtons\fR
+Switch: \fB\-buttons\fR
+.fi
+.IP
+A TCL list that specifies the mouse button(s) and key modifier(s) that
+bring up the popup menu. Each element of this list is in turn a list
+that contains two elements: the first element is an integer that
+indicates the
+mouse button that brings up the popup menu; the second element
+specifies the key modifiers that should be used in conjunction with
+the mouse button. For example, the value \fB{{1 {Control Meta}} {3
+{Any}}}\fR specifies that the popup menu can be popped up by (a)
+pressing mouse button 1 with either the Control or the Meta key or (b)
+pressing mouse button 3 with any key modifier. The default value is
+\fB{{3 {Any}}}\fR: only mouse button 3 brings up the popup menu.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBpostCmd\fR
+Class: \fBPostCmd\fR
+Switch: \fB\-postcmd\fR
+.fi
+.IP
+Specifies a command to be evaluated just before the menu is about to
+pop-up. This command is called with two default arguments: the root
+x-y coordinates where the user has pressed the mouse button. This
+command must return a boolean value: a false indicates that the menu
+shouldn't be popped up at this point; a true indicates that the menu
+should be popped up. This option can be used to find out where the
+user has pressed the mouse-button and optionally disable the popup
+menu over certain screen areas.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBspring\fR
+Class: \fBSpring\fR
+Switch: \fB\-spring\fR
+.fi
+.IP
+When set to \fBtrue\fR, the menu will be automatically popped down if
+the user releases the mouse button outside of the menu and no menu
+commands will be invoked. This makes it easy for the user to cancel
+the popup menu without pressing the Escape key. The default value is
+\fBtrue\fR.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Switch: \fB\-state\fR
+.fi
+.IP
+Must be either \fBdisabled\fR or \fBnormal\fR. The PopupMenu widget will not
+pop up unless its \fB\-state\fR is set to \fBnormal\fR.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBtitle\fR
+Class: \fBTitle\fR
+Switch: \fB\-title\fR
+.fi
+.IP
+Specifies a text string to display inside the \fBmenubutton\fR
+subwidget, as the title of this PopupMenu.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'----------BEGIN
+.LP
+.nf
+Name: \fBmenu\fR
+Class: \fBMenu\fR
+.fi
+.IP
+The menu subwidget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBmenubutton\fR
+Class: \fBMenubutton\fR
+.fi
+.IP
+The menubutton subwidget.
+'----------END
+'
+.BE
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixPopupMenu\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a PopupMenu widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+PopupMenu widget such as its cursor and relief.
+
+The Tix PopupMenu widget can be used as a replacement of the
+\fBtk_popup\fR command. The advantage of the Tix PopupMenu widget is
+it requires less application code to manipulate. Also, it provides a
+title for the popup menu, which is not available from \fBtk_popup\fR.
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixPopupMenu\fR command creates a new Tcl command whose name is
+the same as the path name of the PopupMenu widget's window. This
+command may be used to invoke various operations on the widget. It has
+the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+PopupMenu widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following commands
+are possible for PopupMenu widgets:
+.TP
+\fIpathName \fBbind \fIwidget \fR?\fIwidget ...\fR?
+'
+Binds this PopupMenu to one or more \fIwidgets\fR. The PopupMenu
+will be activated when the user presses the right mouse button over
+these \fIwidgets\fR.
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixPopupMenu\fR command.
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixPopupMenu\fR command.
+'
+'
+.TP
+\fIpathName \fBpost \fIwidget x y\fR
+'
+Posts the PopupMenu inside the \fIwidget\fR at the coordinate
+\fIx\fR,\fIy\fR.
+'
+'
+.TP
+\fIpathName \fBunbind \fIwidget \fR?\fIwidget ...\fR?
+'
+Cancels the PopupMenu's binding with the \fIwidget(s)\fR.
+'
+'
+.TP
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+'
+'
+'----------------------------------------------------------------------
+'.SH BINDINGS
+'.PP
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/SHList.html b/tix/man/SHList.html
new file mode 100644
index 00000000000..7024a083f7d
--- /dev/null
+++ b/tix/man/SHList.html
@@ -0,0 +1,160 @@
+
+
+
+<TITLE>tixScrolledHList - Create and manipulate Tix ScrolledHList widgets</TITLE>
+<Center><H2>tixScrolledHList - Create and manipulate Tix ScrolledHList widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixScrolledHList<I> <I>pathName ?<I>options</I></B>?
+</pre><H3>STANDARD OPTIONS</H3>
+<P>
+<pre><code><code><code>
+<B>
+anchor background cursor
+relief borderWidth
+</B></I>
+</code></code></code></pre>
+<P>
+See the <B>options(n)</B></I> manual entry for details on the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>height</B></I>
+Class: <B>Height</B></I>
+Switch: <B>-height</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the desired height for the window, in pixels.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>scrollbar</B></I>
+Class: <B>Scrollbar</B></I>
+Switch: <B>-scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the display policy of the scrollbars. The following
+values are recognized:
+</UL>
+<UL>
+<DL>
+<DT> <B>auto</B></I> </B></I>?<I>\+x</I></B>? </B></I>?<I>-x</I></B>? </B></I>?<I>\+y</I></B>? </B></I>?<I>-y</I></B>?
+</I></B>
+<DD> When <B>-scrollbar</B></I> is set to "<B>auto</B></I>", the scrollbars are
+shown only when needed. Additional modifiers can be used to force a
+scrollbar to be shown or hidden. For example, "<B>auto -y</B></I>" means
+the horizontal scrollbar should be shown when needed but the vertical
+scrollbar should always be hidden; "<B>auto +x</B></I>" means the vertical
+scrollbar should be shown when needed but the horizontal scrollbar
+should always be shown, and so on.
+</DL>
+<DL>
+<DT> <B>both</B></I>
+</I></B>
+<DD> Both scrollbars are shown
+</DL>
+<DL>
+<DT> <B>none</B></I>
+</I></B>
+<DD> The scrollbars are never shown.
+</DL>
+<DL>
+<DT> <B>x</B></I>
+</I></B>
+<DD> Only the horizontal scrollbar is shown;
+</DL>
+<DL>
+<DT> <B>y</B></I>
+</I></B>
+<DD> Only the vertical scrollbar is shown.
+</DL>
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>width</B></I>
+Class: <B>Width</B></I>
+Switch: <B>-width</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the desired width for the window, in pixels.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>hsb</B></I>
+Class: <B>Scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+The horizontal scrollbar subwidget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>hlist</B></I>
+Class: <B>Hlist</B></I>
+</code></code></code></pre>
+<UL>
+The tixHList subwidget inside the ScrolledHList widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>vsb</B></I>
+Class: <B>Scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+The vertical scrollbar subwidget.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixScrolledHList</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a ScrolledHList widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+ScrolledHList widget such as its cursor and relief.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixScrolledHList</B></I> command creates a new Tcl command whose
+command may be used to invoke various
+operations on the widget. It has the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as
+determine the exact behavior of the command. The following
+commands are possible for ScrolledHList widgets:
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixScrolledHList</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If
+no <I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixScrolledHList</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no additional arguments are given, returns the pathname of the
+subwidget of the specified name.
+
+When no additional arguments are given, the widget command of the
+specified subwidget will be called with these parameters.
+</DL>
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:36 EST 1997 </i> ---
+<i>Serial 853731304</i>
diff --git a/tix/man/SHList.n b/tix/man/SHList.n
new file mode 100644
index 00000000000..700e375d8e8
--- /dev/null
+++ b/tix/man/SHList.n
@@ -0,0 +1,220 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixScrolledHList tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixScrolledHList \- Create and manipulate Tix ScrolledHList widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixScrolledHList\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fB
+'
+anchor background cursor
+relief borderWidth
+'
+\fR
+.ta 4c
+.fi
+.LP
+See the \fBoptions(n)\fR manual entry for details on the standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Switch: \fB-height\fR
+.fi
+.IP
+Specifies the desired height for the window, in pixels.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBscrollbar\fR
+Class: \fBScrollbar\fR
+Switch: \fB\-scrollbar\fR
+.fi
+.IP
+Specifies the display policy of the scrollbars. The following
+values are recognized:
+.RS
+'
+.TP
+\fBauto\fR \fR?\fI\+x\fR? \fR?\fI\-x\fR? \fR?\fI\+y\fR? \fR?\fI\-y\fR?
+'
+When \fB\-scrollbar\fR is set to "\fBauto\fR", the scrollbars are
+shown only when needed. Additional modifiers can be used to force a
+scrollbar to be shown or hidden. For example, "\fBauto \-y\fR" means
+the horizontal scrollbar should be shown when needed but the vertical
+scrollbar should always be hidden; "\fBauto +x\fR" means the vertical
+scrollbar should be shown when needed but the horizontal scrollbar
+should always be shown, and so on.
+'
+.TP
+\fBboth\fR
+Both scrollbars are shown
+'
+.TP
+\fBnone\fR
+The scrollbars are never shown.
+'
+.TP
+\fBx\fR
+Only the horizontal scrollbar is shown;
+'
+.TP
+\fBy\fR
+Only the vertical scrollbar is shown.
+'
+.RE
+'
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Switch: \fB-width\fR
+.fi
+.IP
+Specifies the desired width for the window, in pixels.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBhsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The horizontal scrollbar subwidget.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBhlist\fR
+Class: \fBHlist\fR
+.fi
+.IP
+The tixHList subwidget inside the ScrolledHList widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The vertical scrollbar subwidget.
+'----------END
+'
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixScrolledHList\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a ScrolledHList widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+ScrolledHList widget such as its cursor and relief.
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixScrolledHList\fR command creates a new Tcl command whose
+name is the same as the path name of the ScrolledHList widget's window. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as
+the ScrolledHList widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for ScrolledHList widgets:
+'
+.TP
+'
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixScrolledHList\fR command.
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If
+no \fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixScrolledHList\fR command.
+'
+.TP
+'
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no additional arguments are given, returns the pathname of the
+subwidget of the specified name.
+
+When no additional arguments are given, the widget command of the
+specified subwidget will be called with these parameters.
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/SListBox.html b/tix/man/SListBox.html
new file mode 100644
index 00000000000..9f8fe08b8b7
--- /dev/null
+++ b/tix/man/SListBox.html
@@ -0,0 +1,214 @@
+
+
+
+<TITLE>tixScrolledListBox - Create and manipulate Tix ScrolledListBox widgets</TITLE>
+<Center><H2>tixScrolledListBox - Create and manipulate Tix ScrolledListBox widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixScrolledListBox<I> <I>pathName ?<I>options</I></B>?
+</pre><H3>STANDARD OPTIONS</H3>
+<P>
+<pre><code><code><code>
+<B>
+anchor background cursor
+relief borderWidth
+</B></I>
+</code></code></code></pre>
+<P>
+See the <B>options(n)</B></I> manual entry for details on the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>anchor</B></I>
+Class: <B>Anchor</B></I>
+Switch: <B>-anchor</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the alignment of the items inside the listbox subwidget.
+Only the values <B>w</B></I> and <B>e</B></I> are allowed. When set to <B>w</B></I>,
+the listbox is automatically aligned to the beginning of the items.
+When set to <B>e</B></I>, the listbox is automatically aligned to the end
+of the items. Automatically alignment only happens when the
+ScrolledListBox widget changes its size.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>browsecmd</B></I>
+Class: <B>BrowseCmd</B></I>
+Switch: <B>-browsecmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the command to be called when the user browses the elements
+inside the <B>listbox</B></I> subwidget (see the BINDINGS section below).
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>command</B></I>
+Class: <B>Command</B></I>
+Switch: <B>-command</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the command to be called when the user invokes the <B>listbox</B></I>
+subwidget (see the BINDINGS section below).
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>height</B></I>
+Class: <B>Height</B></I>
+Switch: <B>-height</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the desired height for the window, in pixels.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>scrollbar</B></I>
+Class: <B>Scrollbar</B></I>
+Switch: <B>-scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the display policy of the scrollbars. The following
+values are recognized:
+</UL>
+<UL>
+<DL>
+<DT> <B>auto</B></I> </B></I>?<I>\+x</I></B>? </B></I>?<I>-x</I></B>? </B></I>?<I>\+y</I></B>? </B></I>?<I>-y</I></B>?
+</I></B>
+<DD> When <B>-scrollbar</B></I> is set to "<B>auto</B></I>", the scrollbars are
+shown only when needed. Additional modifiers can be used to force a
+scrollbar to be shown or hidden. For example, "<B>auto -y</B></I>" means
+the horizontal scrollbar should be shown when needed but the vertical
+scrollbar should always be hidden; "<B>auto +x</B></I>" means the vertical
+scrollbar should be shown when needed but the horizontal scrollbar
+should always be shown, and so on.
+</DL>
+<DL>
+<DT> <B>both</B></I>
+</I></B>
+<DD> Both scrollbars are shown
+</DL>
+<DL>
+<DT> <B>none</B></I>
+</I></B>
+<DD> The scrollbars are never shown.
+</DL>
+<DL>
+<DT> <B>x</B></I>
+</I></B>
+<DD> Only the horizontal scrollbar is shown;
+</DL>
+<DL>
+<DT> <B>y</B></I>
+</I></B>
+<DD> Only the vertical scrollbar is shown.
+</DL>
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>width</B></I>
+Class: <B>Width</B></I>
+Switch: <B>-width</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the desired width for the window, in pixels.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>hsb</B></I>
+Class: <B>Scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+The horizontal scrollbar subwidget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>listbox</B></I>
+Class: <B>Listbox</B></I>
+</code></code></code></pre>
+<UL>
+The listbox subwidget inside the ScrolledListBox widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>vsb</B></I>
+Class: <B>Scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+The vertical scrollbar subwidget.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixScrolledListBox</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a ScrolledListBox widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+ScrolledListBox widget such as its cursor and relief.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixScrolledListBox</B></I> command creates a new Tcl command whose
+window. This command may be used to invoke various operations on the
+widget. It has the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+determine the exact behavior of the command. The following commands
+are possible for ScrolledListBox widgets:
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixScrolledListBox</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If
+no <I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixScrolledListBox</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no additional arguments are given, returns the pathname of the
+subwidget of the specified name.
+
+When no additional arguments are given, the widget command of the
+specified subwidget will be called with these parameters.
+</DL>
+</pre><H3>BINDINGS</H3>
+<P>
+<UL>
+[1] <BR>
+If the <B>-browsecmd</B></I> option is set, the command which it referes
+to is called whenever a &lt;ButtonPress-1&gt; or a &lt;Motion-1&gt; event occurrs
+inside the <B>listbox</B></I> subwidget.
+</UL>
+<P>
+<UL>
+[2] <BR>
+The command specified by the <B>-command</B></I> option is invoked when a
+&lt;Double-1&gt; event occurrs inside the <B>listbox</B></I> subwidget.
+</UL>
+</pre><H3>BUGS</H3>
+The capitalization of some of the commands names in Tix 3.x has been
+changed in Tix 4.0. All commands that ended with <B>box</B></I> have been
+changed to a capitalized <B>Box</B></I>. Hence, the command
+<B>tixScrolledListbox</B></I> in Tix 3.x has been changed to
+<B>tixScrolledListBox</B></I> in Tix 4.0
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:36 EST 1997 </i> ---
+<i>Serial 853731304</i>
diff --git a/tix/man/SListBox.n b/tix/man/SListBox.n
new file mode 100644
index 00000000000..2a1d8808036
--- /dev/null
+++ b/tix/man/SListBox.n
@@ -0,0 +1,285 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixScrolledListBox tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixScrolledListBox \- Create and manipulate Tix ScrolledListBox widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixScrolledListBox\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fB
+'
+anchor background cursor
+relief borderWidth
+'
+\fR
+.ta 4c
+.fi
+.LP
+See the \fBoptions(n)\fR manual entry for details on the standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'----------BEGIN
+.LP
+.nf
+Name: \fBanchor\fR
+Class: \fBAnchor\fR
+Switch: \fB\-anchor\fR
+.fi
+.IP
+Specifies the alignment of the items inside the listbox subwidget.
+Only the values \fBw\fR and \fBe\fR are allowed. When set to \fBw\fR,
+the listbox is automatically aligned to the beginning of the items.
+When set to \fBe\fR, the listbox is automatically aligned to the end
+of the items. Automatically alignment only happens when the
+ScrolledListBox widget changes its size.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBbrowsecmd\fR
+Class: \fBBrowseCmd\fR
+Switch: \fB\-browsecmd\fR
+.fi
+.IP
+Specifies the command to be called when the user browses the elements
+inside the \fBlistbox\fR subwidget (see the BINDINGS section below).
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Switch: \fB\-command\fR
+.fi
+.IP
+Specifies the command to be called when the user invokes the \fBlistbox\fR
+subwidget (see the BINDINGS section below).
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Switch: \fB\-height\fR
+.fi
+.IP
+Specifies the desired height for the window, in pixels.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBscrollbar\fR
+Class: \fBScrollbar\fR
+Switch: \fB\-scrollbar\fR
+.fi
+.IP
+Specifies the display policy of the scrollbars. The following
+values are recognized:
+.RS
+'
+.TP
+\fBauto\fR \fR?\fI\+x\fR? \fR?\fI\-x\fR? \fR?\fI\+y\fR? \fR?\fI\-y\fR?
+'
+When \fB\-scrollbar\fR is set to "\fBauto\fR", the scrollbars are
+shown only when needed. Additional modifiers can be used to force a
+scrollbar to be shown or hidden. For example, "\fBauto \-y\fR" means
+the horizontal scrollbar should be shown when needed but the vertical
+scrollbar should always be hidden; "\fBauto +x\fR" means the vertical
+scrollbar should be shown when needed but the horizontal scrollbar
+should always be shown, and so on.
+'
+.TP
+\fBboth\fR
+Both scrollbars are shown
+'
+.TP
+\fBnone\fR
+The scrollbars are never shown.
+'
+.TP
+\fBx\fR
+Only the horizontal scrollbar is shown;
+'
+.TP
+\fBy\fR
+Only the vertical scrollbar is shown.
+'
+.RE
+'
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Switch: \fB-width\fR
+.fi
+.IP
+Specifies the desired width for the window, in pixels.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBhsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The horizontal scrollbar subwidget.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlistbox\fR
+Class: \fBListbox\fR
+.fi
+.IP
+The listbox subwidget inside the ScrolledListBox widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The vertical scrollbar subwidget.
+'----------END
+'
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixScrolledListBox\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a ScrolledListBox widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+ScrolledListBox widget such as its cursor and relief.
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixScrolledListBox\fR command creates a new Tcl command whose
+name is the same as the path name of the ScrolledListBox widget's
+window. This command may be used to invoke various operations on the
+widget. It has the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+ScrolledListBox widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following commands
+are possible for ScrolledListBox widgets:
+'
+.TP
+'
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixScrolledListBox\fR command.
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If
+no \fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixScrolledListBox\fR command.
+'
+.TP
+'
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no additional arguments are given, returns the pathname of the
+subwidget of the specified name.
+
+When no additional arguments are given, the widget command of the
+specified subwidget will be called with these parameters.
+'
+'----------------------------------------------------------------------
+'
+.SH BINDINGS
+.PP
+.IP [1]
+'
+If the \fB\-browsecmd\fR option is set, the command which it referes
+to is called whenever a <ButtonPress\-1> or a <Motion\-1> event occurrs
+inside the \fBlistbox\fR subwidget.
+'
+.PP
+.IP [2]
+'
+The command specified by the \fB\-command\fR option is invoked when a
+<Double\-1> event occurrs inside the \fBlistbox\fR subwidget.
+'
+'----------------------------------------------------------------------
+'
+.SH BUGS
+'
+The capitalization of some of the commands names in Tix 3.x has been
+changed in Tix 4.0. All commands that ended with \fBbox\fR have been
+changed to a capitalized \fBBox\fR. Hence, the command
+\fBtixScrolledListbox\fR in Tix 3.x has been changed to
+\fBtixScrolledListBox\fR in Tix 4.0
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/SText.html b/tix/man/SText.html
new file mode 100644
index 00000000000..af4234ea36c
--- /dev/null
+++ b/tix/man/SText.html
@@ -0,0 +1,160 @@
+
+
+
+<TITLE>tixScrolledText - Create and manipulate Tix ScrolledText widgets</TITLE>
+<Center><H2>tixScrolledText - Create and manipulate Tix ScrolledText widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixScrolledText<I> <I>pathName ?<I>options</I></B>?
+</pre><H3>STANDARD OPTIONS</H3>
+<P>
+<pre><code><code><code>
+<B>
+anchor background cursor
+relief borderWidth
+</B></I>
+</code></code></code></pre>
+<P>
+See the <B>options(n)</B></I> manual entry for details on the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>height</B></I>
+Class: <B>Height</B></I>
+Switch: <B>-height</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the desired height for the window, in pixels.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>scrollbar</B></I>
+Class: <B>Scrollbar</B></I>
+Switch: <B>-scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the display policy of the scrollbars. The following
+values are recognized:
+</UL>
+<UL>
+<DL>
+<DT> <B>auto</B></I> </B></I>?<I>\+x</I></B>? </B></I>?<I>-x</I></B>? </B></I>?<I>\+y</I></B>? </B></I>?<I>-y</I></B>?
+</I></B>
+<DD> When <B>-scrollbar</B></I> is set to "<B>auto</B></I>", the scrollbars are
+shown only when needed. Additional modifiers can be used to force a
+scrollbar to be shown or hidden. For example, "<B>auto -y</B></I>" means
+the horizontal scrollbar should be shown when needed but the vertical
+scrollbar should always be hidden; "<B>auto +x</B></I>" means the vertical
+scrollbar should be shown when needed but the horizontal scrollbar
+should always be shown, and so on.
+</DL>
+<DL>
+<DT> <B>both</B></I>
+</I></B>
+<DD> Both scrollbars are shown
+</DL>
+<DL>
+<DT> <B>none</B></I>
+</I></B>
+<DD> The scrollbars are never shown.
+</DL>
+<DL>
+<DT> <B>x</B></I>
+</I></B>
+<DD> Only the horizontal scrollbar is shown;
+</DL>
+<DL>
+<DT> <B>y</B></I>
+</I></B>
+<DD> Only the vertical scrollbar is shown.
+</DL>
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>width</B></I>
+Class: <B>Width</B></I>
+Switch: <B>-width</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the desired width for the window, in pixels.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>hsb</B></I>
+Class: <B>Scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+The horizontal scrollbar subwidget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>text</B></I>
+Class: <B>Text</B></I>
+</code></code></code></pre>
+<UL>
+The Text subwidget inside the ScrolledText widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>vsb</B></I>
+Class: <B>Scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+The vertical scrollbar subwidget.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixScrolledText</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a ScrolledText widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+ScrolledText widget such as its cursor and relief.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixScrolledText</B></I> command creates a new Tcl command whose
+command may be used to invoke various
+operations on the widget. It has the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as
+determine the exact behavior of the command. The following
+commands are possible for ScrolledText widgets:
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixScrolledText</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If
+no <I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixScrolledText</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no additional arguments are given, returns the pathname of the
+subwidget of the specified name.
+
+When no additional arguments are given, the widget command of the
+specified subwidget will be called with these parameters.
+</DL>
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:37 EST 1997 </i> ---
+<i>Serial 853731304</i>
diff --git a/tix/man/SText.n b/tix/man/SText.n
new file mode 100644
index 00000000000..c0ce8f521ec
--- /dev/null
+++ b/tix/man/SText.n
@@ -0,0 +1,220 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixScrolledText tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixScrolledText \- Create and manipulate Tix ScrolledText widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixScrolledText\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fB
+'
+anchor background cursor
+relief borderWidth
+'
+\fR
+.ta 4c
+.fi
+.LP
+See the \fBoptions(n)\fR manual entry for details on the standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Switch: \fB-height\fR
+.fi
+.IP
+Specifies the desired height for the window, in pixels.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBscrollbar\fR
+Class: \fBScrollbar\fR
+Switch: \fB\-scrollbar\fR
+.fi
+.IP
+Specifies the display policy of the scrollbars. The following
+values are recognized:
+.RS
+'
+.TP
+\fBauto\fR \fR?\fI\+x\fR? \fR?\fI\-x\fR? \fR?\fI\+y\fR? \fR?\fI\-y\fR?
+'
+When \fB\-scrollbar\fR is set to "\fBauto\fR", the scrollbars are
+shown only when needed. Additional modifiers can be used to force a
+scrollbar to be shown or hidden. For example, "\fBauto \-y\fR" means
+the horizontal scrollbar should be shown when needed but the vertical
+scrollbar should always be hidden; "\fBauto +x\fR" means the vertical
+scrollbar should be shown when needed but the horizontal scrollbar
+should always be shown, and so on.
+'
+.TP
+\fBboth\fR
+Both scrollbars are shown
+'
+.TP
+\fBnone\fR
+The scrollbars are never shown.
+'
+.TP
+\fBx\fR
+Only the horizontal scrollbar is shown;
+'
+.TP
+\fBy\fR
+Only the vertical scrollbar is shown.
+'
+.RE
+'
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Switch: \fB-width\fR
+.fi
+.IP
+Specifies the desired width for the window, in pixels.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBhsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The horizontal scrollbar subwidget.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBtext\fR
+Class: \fBText\fR
+.fi
+.IP
+The Text subwidget inside the ScrolledText widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The vertical scrollbar subwidget.
+'----------END
+'
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixScrolledText\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a ScrolledText widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+ScrolledText widget such as its cursor and relief.
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixScrolledText\fR command creates a new Tcl command whose
+name is the same as the path name of the ScrolledText widget's window. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as
+the ScrolledText widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for ScrolledText widgets:
+'
+.TP
+'
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixScrolledText\fR command.
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If
+no \fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixScrolledText\fR command.
+'
+.TP
+'
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no additional arguments are given, returns the pathname of the
+subwidget of the specified name.
+
+When no additional arguments are given, the widget command of the
+specified subwidget will be called with these parameters.
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/SWindow.html b/tix/man/SWindow.html
new file mode 100644
index 00000000000..ac4bbc0021c
--- /dev/null
+++ b/tix/man/SWindow.html
@@ -0,0 +1,206 @@
+
+
+
+<TITLE>tixScrolledWindow - Create and manipulate Tix ScrolledWindow widgets</TITLE>
+<Center><H2>tixScrolledWindow - Create and manipulate Tix ScrolledWindow widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixScrolledWindow<I> <I>pathName ?<I>options</I></B>?
+</pre><H3>STANDARD OPTIONS</H3>
+<P>
+<pre><code><code><code>
+<B>
+anchor background cursor
+relief borderWidth
+</B></I>
+</code></code></code></pre>
+<P>
+See the <B>options(n)</B></I> manual entry for details on the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>height</B></I>
+Class: <B>Height</B></I>
+Switch: <B>-height</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the desired height for the window, in pixels.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>scrollbar</B></I>
+Class: <B>Scrollbar</B></I>
+Switch: <B>-scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the display policy of the scrollbars. The following
+values are recognized:
+</UL>
+<UL>
+<DL>
+<DT> <B>auto</B></I> </B></I>?<I>\+x</I></B>? </B></I>?<I>-x</I></B>? </B></I>?<I>\+y</I></B>? </B></I>?<I>-y</I></B>?
+</I></B>
+<DD> When <B>-scrollbar</B></I> is set to "<B>auto</B></I>", the scrollbars are
+shown only when needed. Additional modifiers can be used to force a
+scrollbar to be shown or hidden. For example, "<B>auto -y</B></I>" means
+the horizontal scrollbar should be shown when needed but the vertical
+scrollbar should always be hidden; "<B>auto +x</B></I>" means the vertical
+scrollbar should be shown when needed but the horizontal scrollbar
+should always be shown, and so on.
+</DL>
+<DL>
+<DT> <B>both</B></I>
+</I></B>
+<DD> Both scrollbars are shown
+</DL>
+<DL>
+<DT> <B>none</B></I>
+</I></B>
+<DD> The scrollbars are never shown.
+</DL>
+<DL>
+<DT> <B>x</B></I>
+</I></B>
+<DD> Only the horizontal scrollbar is shown;
+</DL>
+<DL>
+<DT> <B>y</B></I>
+</I></B>
+<DD> Only the vertical scrollbar is shown.
+</DL>
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>width</B></I>
+Class: <B>Width</B></I>
+Switch: <B>-width</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the desired width for the window, in pixels.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>xScrollIncrement</B></I>
+Class: <B>ScrollIncrement</B></I>
+Switch: <B>-xscrollincrement</B></I>
+</code></code></code></pre>
+<UL>
+Specifies by how much the window should be scrolled in the horizontal
+direction when the user presses the arrows in the horizontal
+scrollbar. In Pixels.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>yScrollIncrement</B></I>
+Class: <B>ScrollIncrement</B></I>
+Switch: <B>-yscrollincrement</B></I>
+</code></code></code></pre>
+<UL>
+Specifies by how much the window should be scrolled in the vertical
+direction when the user presses the arrows in the horizontal
+scrollbar. In pixels.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>hsb</B></I>
+Class: <B>Scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+The horizontal scrollbar subwidget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>window</B></I>
+Class: <B>Frame</B></I>
+</code></code></code></pre>
+<UL>
+The frame subwidget which is scrolled by the ScrolledWindow widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>vsb</B></I>
+Class: <B>Scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+The vertical scrollbar subwidget.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixScrolledWindow</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a ScrolledWindow widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+ScrolledWindow widget such as its cursor and relief.
+</pre><H3>CREATING WIDGETS INSIDE A SCROLLEDWINDOW WIDGET</H3>
+<P>
+To create widgets inside a ScrolledWindow widget, one must create the
+new widgets relative to the <B>window</B></I> subwidget and manage them
+inside the <B>window</B></I> subwidget. An error will be generated if one
+tries to create widgets as immediate children of the ScrolledWindow.
+For example: the following is correct code, which creates new widgets
+inside the window subwidget:
+<P>
+<pre><code><code><code>
+ tixScrolledWindow .w; pack .w
+ set f [.w subwidget window]
+ button $f.b -text hi -width 40 -height 40
+ pack $f.b
+</code></code></code></pre>
+<P>
+The following example code is <I>incorrect</I></B> because it tries to
+create immediate children of the ScrolledWindow <B>\.w</B></I>:
+<P>
+<pre><code><code><code>
+ tixScrolledWindow .w; pack .w
+ button .w.b -text hi -width 40 -height 40
+ pack .w.b
+</code></code></code></pre>
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixScrolledWindow</B></I> command creates a new Tcl command whose
+command may be used to invoke various
+operations on the widget. It has the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as
+determine the exact behavior of the command. The following
+commands are possible for ScrolledWindow widgets:
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixScrolledWindow</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If
+no <I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixScrolledWindow</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no additional arguments are given, returns the pathname of the
+subwidget of the specified name.
+
+When no additional arguments are given, the widget command of the
+specified subwidget will be called with these parameters.
+</DL>
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:37 EST 1997 </i> ---
+<i>Serial 853731304</i>
diff --git a/tix/man/SWindow.n b/tix/man/SWindow.n
new file mode 100644
index 00000000000..d1f624d3cf6
--- /dev/null
+++ b/tix/man/SWindow.n
@@ -0,0 +1,271 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixScrolledWindow tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixScrolledWindow \- Create and manipulate Tix ScrolledWindow widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixScrolledWindow\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fB
+'
+anchor background cursor
+relief borderWidth
+'
+\fR
+.ta 4c
+.fi
+.LP
+See the \fBoptions(n)\fR manual entry for details on the standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Switch: \fB-height\fR
+.fi
+.IP
+Specifies the desired height for the window, in pixels.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBscrollbar\fR
+Class: \fBScrollbar\fR
+Switch: \fB\-scrollbar\fR
+.fi
+.IP
+Specifies the display policy of the scrollbars. The following
+values are recognized:
+.RS
+'
+.TP
+\fBauto\fR \fR?\fI\+x\fR? \fR?\fI\-x\fR? \fR?\fI\+y\fR? \fR?\fI\-y\fR?
+'
+When \fB\-scrollbar\fR is set to "\fBauto\fR", the scrollbars are
+shown only when needed. Additional modifiers can be used to force a
+scrollbar to be shown or hidden. For example, "\fBauto \-y\fR" means
+the horizontal scrollbar should be shown when needed but the vertical
+scrollbar should always be hidden; "\fBauto +x\fR" means the vertical
+scrollbar should be shown when needed but the horizontal scrollbar
+should always be shown, and so on.
+'
+.TP
+\fBboth\fR
+Both scrollbars are shown
+'
+.TP
+\fBnone\fR
+The scrollbars are never shown.
+'
+.TP
+\fBx\fR
+Only the horizontal scrollbar is shown;
+'
+.TP
+\fBy\fR
+Only the vertical scrollbar is shown.
+'
+.RE
+'
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Switch: \fB-width\fR
+.fi
+.IP
+Specifies the desired width for the window, in pixels.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBxScrollIncrement\fR
+Class: \fBScrollIncrement\fR
+Switch: \fB-xscrollincrement\fR
+.fi
+.IP
+Specifies by how much the window should be scrolled in the horizontal
+direction when the user presses the arrows in the horizontal
+scrollbar. In Pixels.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fByScrollIncrement\fR
+Class: \fBScrollIncrement\fR
+Switch: \fB-yscrollincrement\fR
+.fi
+.IP
+Specifies by how much the window should be scrolled in the vertical
+direction when the user presses the arrows in the horizontal
+scrollbar. In pixels.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBhsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The horizontal scrollbar subwidget.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBwindow\fR
+Class: \fBFrame\fR
+.fi
+.IP
+The frame subwidget which is scrolled by the ScrolledWindow widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The vertical scrollbar subwidget.
+'----------END
+'
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixScrolledWindow\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a ScrolledWindow widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+ScrolledWindow widget such as its cursor and relief.
+'
+.SH CREATING WIDGETS INSIDE A SCROLLEDWINDOW WIDGET
+.PP
+'
+To create widgets inside a ScrolledWindow widget, one must create the
+new widgets relative to the \fBwindow\fR subwidget and manage them
+inside the \fBwindow\fR subwidget. An error will be generated if one
+tries to create widgets as immediate children of the ScrolledWindow.
+For example: the following is correct code, which creates new widgets
+inside the window subwidget:
+.PP
+.nf
+ tixScrolledWindow .w; pack .w
+ set f [.w subwidget window]
+ button $f.b \-text hi \-width 40 \-height 40
+ pack $f.b
+.fi
+.PP
+The following example code is \fIincorrect\fR because it tries to
+create immediate children of the ScrolledWindow \fB\.w\fR:
+.PP
+.nf
+ tixScrolledWindow .w; pack .w
+ button .w.b \-text hi \-width 40 \-height 40
+ pack .w.b
+.fi
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixScrolledWindow\fR command creates a new Tcl command whose
+name is the same as the path name of the ScrolledWindow widget's window. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as
+the ScrolledWindow widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for ScrolledWindow widgets:
+'
+.TP
+'
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixScrolledWindow\fR command.
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If
+no \fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixScrolledWindow\fR command.
+'
+.TP
+'
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no additional arguments are given, returns the pathname of the
+subwidget of the specified name.
+
+When no additional arguments are given, the widget command of the
+specified subwidget will be called with these parameters.
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/Select.html b/tix/man/Select.html
new file mode 100644
index 00000000000..d4c9d2b9830
--- /dev/null
+++ b/tix/man/Select.html
@@ -0,0 +1,307 @@
+
+
+
+<TITLE>tixSelect - Create and manipulate tixSelect widgets</TITLE>
+<Center><H2>tixSelect - Create and manipulate tixSelect widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixSelect<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+The <B>TixSelect</B></I> class is derived from the <B>TixLabelWidget</B></I>
+class and inherits all the commands, options and
+subwidgets of its super-class.
+</pre><H3>STANDARD OPTIONS</H3>
+The Select widget supports all the standard options of a frame widget.
+See the <B>options(n)</B></I> manual entry for details on the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>allowZero</B></I>
+Class: <B>AllowZero</B></I>
+Switch: <B>-allowzero</B></I>
+</code></code></code></pre>
+<UL>
+A boolean value that specifies whether the selection can be empty.
+When set to false, at least one button subwidget must be selected at
+any time.
+
+<B>Note</B></I>: When the Select widget is first constructed, the default
+selection is always empty, even if <B>-allowzero</B></I> is set to
+<B>false</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>buttonType</B></I>
+Class: <B>ButtonType</B></I>
+Switch: <B>-buttontype</B></I>
+</code></code></code></pre>
+<UL>
+The type of buttons to be used as subwidgets inside the Select widget.
+By default, the standard Tk <B>button</B></I> widget class is used.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>command</B></I>
+Class: <B>Command</B></I>
+Switch: <B>-command</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the TCL command to be executed when the <B>-value</B></I> of the
+Select widget is changed. This command will be invoked with
+two arguments. The first is the name of the button subwidget that has
+toggled. The second is a boolean value indicating whether the button
+subwidget is selected. This command is executed only when the
+<B>-disableCallback</B></I> option is set to false.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>disableCallback</B></I>
+Class: <B>DisableCallback</B></I>
+Switch: <B>-disablecallback</B></I>
+</code></code></code></pre>
+<UL>
+A boolean value indicating whether callbacks should be disabled. When
+set to true, the TCL command specified by the <B>-command</B></I> option
+is not executed when the <B>-value</B></I> of the Select widget
+changes.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>orientation</B></I>
+Class: <B>Orientation</B></I>
+Switch: <B>-orientation</B></I>
+Alias: <B>-orient</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the orientation of the button subwidgets. Only the values
+<B>horizontal</B></I> and <B>vertical</B></I> are recognized. This is a
+<I>static option</I></B> and it can only be assigned during the creation of
+the widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>label</B></I>
+Class: <B>Label</B></I>
+Switch: <B>-label</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the string to display as the label of this Select widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>labelSide</B></I>
+Class: <B>LabelSide</B></I>
+Switch: <B>-labelside</B></I>
+</code></code></code></pre>
+<UL>
+Specifies where the label should be displayed relative to the Select
+widget. Valid options are: <B>top</B></I>, <B>left</B></I>, <B>right</B></I>,
+<B>bottom</B></I>, <B>none</B></I> or <B>acrosstop</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>padX</B></I>
+Class: <B>Pad</B></I>
+Switch: <B>-padx</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the horizontal padding between two neighboring button
+subwidgets. This is a <I>static option</I></B> and it can only be assigned
+during the creation of the widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>padY</B></I>
+Class: <B>Pad</B></I>
+Switch: <B>-padx</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the vertical padding between two neighboring button
+subwidgets. This is a <I>static option</I></B> and it can only be assigned
+during the creation of the widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>radio</B></I>
+Class: <B>Radio</B></I>
+Switch: <B>-radio</B></I>
+</code></code></code></pre>
+<UL>
+A boolean value that specifies whether the Select widget
+should act as a radio-box. When set to true, at most one button
+subwidget can be selected at any time. This is a <I>static option</I></B>
+and it can only be assigned during the creation of the widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>selectedBg</B></I>
+Class: <B>SelectedBg</B></I>
+Switch: <B>-selectedbg</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the background color of all the selected button subwidgets.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>state</B></I>
+Class: <B>State</B></I>
+Switch: <B>-state</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the state of all the buttons inside the Select widget. Only
+the values <B>normal</B></I> and <B>disabled</B></I> are recognized. When the
+state is set to <B>disabled</B></I>, all user actions on this Select widget
+are ignore.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>validateCmd</B></I>
+Class: <B>ValidateCmd</B></I>
+Switch: <B>-validatecmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a TCL command to be called when the -value of the
+Select widget is about to change. This command is called with
+one parameter -- the new <B>-value</B></I> entered by the user. This
+command is to validate this new value by returning a value it deems
+valid.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>value</B></I>
+Class: <B>Value</B></I>
+Switch: <B>-value</B></I>
+</code></code></code></pre>
+<UL>
+The value of a Select widget is a list of the names of the
+button subwidgets that have been selected by the user.
+
+When you assign the value of a Select widget using the "config -value"
+widget command, the TCL command specified by the <B>-command</B></I>
+option will be invoked if some button subwidgets are toggled.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>variable</B></I>
+Class: <B>Variable</B></I>
+Switch: <B>-variable</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the global variable in which the value of the Select widget
+should be stored. The value of a Select widget is stored as a list of
+the names of the button subwidgets that have been selected by the
+user. The value of the Select widget will be automatically updated
+when this variable is changed.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<P>
+<pre><code><code><code>
+Name: <B>label</B></I>
+Class: <B>Label</B></I>
+</code></code></code></pre>
+<UL>
+The label subwidget.
+</UL>
+<P>
+In addition, all the button subwidgets created as a result of the
+<B>add</B></I> widget command can be accessed by the <B>subwidget</B></I>
+command. They are identified by the <I>buttonName</I></B> parameter to the
+<B>add</B></I> widget command. Here is an example:
+<P>
+<pre><code><code><code>
+ tixSelect .s
+ pack .s
+ .s add eat -text Eat
+ .s add sleep -text Sleep
+ .s subwidget eat config -fg green
+ .s subwidget sleep config -fg red
+</code></code></code></pre>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixSelect</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a Select widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+Select widget such as its cursor and relief.
+
+The Select widget is a container of button subwidgets. It can
+be used to provide radio-box or check-box style of selection options
+for the user.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixSelect</B></I> command creates a new Tcl command whose name is
+command may be used to invoke various operations on the widget. It
+has the following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+determine the exact behavior of the command. The following commands
+are possible for Select widgets:
+<DL>
+<DT> <I>pathName <B>add<I> buttonName </I></B>?<I>option value ... </I></B>?
+</I></B>
+<DD> Adds a new button subwidget with the name </B></I>buttonName</B></I> into the
+Select widget. Additional configuration options can be given
+to configure the new button subwidget.
+</DL>
+<DL>
+<DT> <I>pathName <B>cget<I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixSelect</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixSelect</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>invoke<I> buttonName</I></B>
+</I></B>
+<DD> Invokes the button subwidget with the name </B></I>buttonName</B></I>.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget<I> name ?args?</I></B>
+</I></B>
+<DD> When no options are given, returns the pathname of the subwidget of
+the specified name.
+
+When options are given, the widget command of the specified subwidget will
+be called with these options.
+</DL>
+</pre><H3>BINDINGS</H3>
+<P>
+When the user presses the left mouse button over the a button
+subwidget, it will be toggled and the <B>-value</B></I> option of the
+tixSelect widget will be changed.
+</pre><H3>EXAMPLE</H3>
+<P>
+The following example creates a radio-box style iconbar for the user
+to choose one value among <B>eat</B></I>, <B>work</B></I> or <B>sleep</B></I>.
+<P>
+<pre><code><code><code>
+ tixSelect .s -radio true -allowzero false
+ .s add eat -bitmap [tix getbitmap eat]
+ .s add work -bitmap [tix getbitmap work]
+ .s add sleep -bitmap [tix getbitmap sleep]
+</code></code></code></pre>
+</pre><H3>KEYWORDS</H3>
+Tix(n), Container Widget
+<hr><i>Last modified Sun Jan 19 22:34:38 EST 1997 </i> ---
+<i>Serial 853731305</i>
diff --git a/tix/man/Select.n b/tix/man/Select.n
new file mode 100644
index 00000000000..87614c1b213
--- /dev/null
+++ b/tix/man/Select.n
@@ -0,0 +1,400 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixSelect tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixSelect \- Create and manipulate tixSelect widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixSelect\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+The \fBTixSelect\fR class is derived from the \fBTixLabelWidget\fR
+class and inherits all the commands, options and
+subwidgets of its super-class.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+The Select widget supports all the standard options of a frame widget.
+See the \fBoptions(n)\fR manual entry for details on the standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBallowZero\fR
+Class: \fBAllowZero\fR
+Switch: \fB\-allowzero\fR
+.fi
+.IP
+A boolean value that specifies whether the selection can be empty.
+When set to false, at least one button subwidget must be selected at
+any time.
+
+\fBNote\fR: When the Select widget is first constructed, the default
+selection is always empty, even if \fB\-allowzero\fR is set to
+\fBfalse\fR.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBbuttonType\fR
+Class: \fBButtonType\fR
+Switch: \fB\-buttontype\fR
+.fi
+.IP
+The type of buttons to be used as subwidgets inside the Select widget.
+By default, the standard Tk \fBbutton\fR widget class is used.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Switch: \fB\-command\fR
+.fi
+.IP
+Specifies the TCL command to be executed when the \fB\-value\fR of the
+Select widget is changed. This command will be invoked with
+two arguments. The first is the name of the button subwidget that has
+toggled. The second is a boolean value indicating whether the button
+subwidget is selected. This command is executed only when the
+\fB\-disableCallback\fR option is set to false.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdisableCallback\fR
+Class: \fBDisableCallback\fR
+Switch: \fB\-disablecallback\fR
+.fi
+.IP
+A boolean value indicating whether callbacks should be disabled. When
+set to true, the TCL command specified by the \fB\-command\fR option
+is not executed when the \fB\-value\fR of the Select widget
+changes.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBorientation\fR
+Class: \fBOrientation\fR
+Switch: \fB\-orientation\fR
+Alias: \fB\-orient\fR
+.fi
+.IP
+Specifies the orientation of the button subwidgets. Only the values
+\fBhorizontal\fR and \fBvertical\fR are recognized. This is a
+\fIstatic option\fR and it can only be assigned during the creation of
+the widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabel\fR
+Class: \fBLabel\fR
+Switch: \fB\-label\fR
+.fi
+.IP
+Specifies the string to display as the label of this Select widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabelSide\fR
+Class: \fBLabelSide\fR
+Switch: \fB\-labelside\fR
+.fi
+.IP
+Specifies where the label should be displayed relative to the Select
+widget. Valid options are: \fBtop\fR, \fBleft\fR, \fBright\fR,
+\fBbottom\fR, \fBnone\fR or \fBacrosstop\fR.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBpadX\fR
+Class: \fBPad\fR
+Switch: \fB\-padx\fR
+.fi
+.IP
+Specifies the horizontal padding between two neighboring button
+subwidgets. This is a \fIstatic option\fR and it can only be assigned
+during the creation of the widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBpadY\fR
+Class: \fBPad\fR
+Switch: \fB\-padx\fR
+.fi
+.IP
+Specifies the vertical padding between two neighboring button
+subwidgets. This is a \fIstatic option\fR and it can only be assigned
+during the creation of the widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBradio\fR
+Class: \fBRadio\fR
+Switch: \fB\-radio\fR
+.fi
+.IP
+A boolean value that specifies whether the Select widget
+should act as a radio-box. When set to true, at most one button
+subwidget can be selected at any time. This is a \fIstatic option\fR
+and it can only be assigned during the creation of the widget.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBselectedBg\fR
+Class: \fBSelectedBg\fR
+Switch: \fB\-selectedbg\fR
+.fi
+.IP
+Specifies the background color of all the selected button subwidgets.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Switch: \fB\-state\fR
+.fi
+.IP
+Specifies the state of all the buttons inside the Select widget. Only
+the values \fBnormal\fR and \fBdisabled\fR are recognized. When the
+state is set to \fBdisabled\fR, all user actions on this Select widget
+are ignore.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvalidateCmd\fR
+Class: \fBValidateCmd\fR
+Switch: \fB\-validatecmd\fR
+.fi
+.IP
+Specifies a TCL command to be called when the -value of the
+Select widget is about to change. This command is called with
+one parameter -- the new \fB\-value\fR entered by the user. This
+command is to validate this new value by returning a value it deems
+valid.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvalue\fR
+Class: \fBValue\fR
+Switch: \fB\-value\fR
+.fi
+.IP
+The value of a Select widget is a list of the names of the
+button subwidgets that have been selected by the user.
+
+When you assign the value of a Select widget using the "config -value"
+widget command, the TCL command specified by the \fB\-command\fR
+option will be invoked if some button subwidgets are toggled.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvariable\fR
+Class: \fBVariable\fR
+Switch: \fB\-variable\fR
+.fi
+.IP
+Specifies the global variable in which the value of the Select widget
+should be stored. The value of a Select widget is stored as a list of
+the names of the button subwidgets that have been selected by the
+user. The value of the Select widget will be automatically updated
+when this variable is changed.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+.PP
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabel\fR
+Class: \fBLabel\fR
+.fi
+.IP
+The label subwidget.
+'----------END
+.PP
+In addition, all the button subwidgets created as a result of the
+\fBadd\fR widget command can be accessed by the \fBsubwidget\fR
+command. They are identified by the \fIbuttonName\fR parameter to the
+\fBadd\fR widget command. Here is an example:
+.PP
+.nf
+ tixSelect .s
+ pack .s
+ .s add eat -text Eat
+ .s add sleep -text Sleep
+ .s subwidget eat config -fg green
+ .s subwidget sleep config -fg red
+.fi
+'
+'
+.BE
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixSelect\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a Select widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+Select widget such as its cursor and relief.
+
+The Select widget is a container of button subwidgets. It can
+be used to provide radio-box or check-box style of selection options
+for the user.
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixSelect\fR command creates a new Tcl command whose name is
+the same as the path name of the Select widget's window. This
+command may be used to invoke various operations on the widget. It
+has the following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+Select widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following commands
+are possible for Select widgets:
+'
+.TP
+\fIpathName \fBadd\fI buttonName \fR?\fIoption value ... \fR?
+'
+Adds a new button subwidget with the name \fRbuttonName\fR into the
+Select widget. Additional configuration options can be given
+to configure the new button subwidget.
+'
+.TP
+\fIpathName \fBcget\fI \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixSelect\fR command.
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixSelect\fR command.
+'
+'
+.TP
+\fIpathName \fBinvoke\fI buttonName\fR
+'
+Invokes the button subwidget with the name \fRbuttonName\fR.
+'
+'
+.TP
+\fIpathName \fBsubwidget\fI name ?args?\fR
+'
+When no options are given, returns the pathname of the subwidget of
+the specified name.
+
+When options are given, the widget command of the specified subwidget will
+be called with these options.
+'
+'
+'----------------------------------------------------------------------
+.SH BINDINGS
+.PP
+'
+When the user presses the left mouse button over the a button
+subwidget, it will be toggled and the \fB\-value\fR option of the
+tixSelect widget will be changed.
+'
+'----------------------------------------------------------------------
+.SH EXAMPLE
+.PP
+'
+The following example creates a radio-box style iconbar for the user
+to choose one value among \fBeat\fR, \fBwork\fR or \fBsleep\fR.
+.PP
+.nf
+ tixSelect .s \-radio true \-allowzero false
+ .s add eat \-bitmap [tix getbitmap eat]
+ .s add work \-bitmap [tix getbitmap work]
+ .s add sleep \-bitmap [tix getbitmap sleep]
+.fi
+'
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n), Container Widget
diff --git a/tix/man/StdBBox.html b/tix/man/StdBBox.html
new file mode 100644
index 00000000000..a7b2376bde2
--- /dev/null
+++ b/tix/man/StdBBox.html
@@ -0,0 +1,166 @@
+
+
+
+<TITLE>tixStdButonBox - Create and manipulate Tix StdButonBox widgets</TITLE>
+<Center><H2>tixStdButonBox - Create and manipulate Tix StdButonBox widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixStdButonBox<I> <I>pathName ?<I>options</I></B>?
+</pre><H3>STANDARD OPTIONS</H3>
+<P>
+<pre><code><code><code>
+<B>
+anchor background cursor
+relief borderWidth
+</B></I>
+</code></code></code></pre>
+<P>
+See the <B>options(n)</B></I> manual entry for details on the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>orientation</B></I>
+Class: <B>Orientation</B></I>
+Switch: <B>-orientation</B></I>
+Alias: <B>-orient</B></I>
+</code></code></code></pre>
+<UL>
+<B>Static Option</B></I>. Specifies the orientation of the button
+subwidgets. Only the values "horizontal" and "vertical" are recognized.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>padx</B></I>
+Class: <B>Pad</B></I>
+Switch: <B>-padx</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the horizontal padding between two neighboring button
+subwidgets in the StdButonBox widget.
+
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>padx</B></I>
+Class: <B>Pad</B></I>
+Switch: <B>-padx</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the vertical padding between two neighboring button
+subwidgets in the StdButonBox widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>state</B></I>
+Class: <B>State</B></I>
+Switch: <B>-state</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the state of all the buttons inside the StdButtonBox widget.
+
+<I>Note</I></B>:
+Setting this option using the <I>config</I></B> widget command will enable
+or disable all the buttons subwidgets. Original states of the
+individual buttons are <I>not</I></B> saved.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<P>
+<pre><code><code><code>
+Name: <B>ok</B></I>
+Class: <B>Button</B></I>
+</code></code></code></pre>
+<UL>
+The first button subwidget. By default it displays the text string "Ok"
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>apply</B></I>
+Class: <B>Button</B></I>
+</code></code></code></pre>
+<UL>
+The second button subwidget. By default it displays the text string "Apply"
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>cancel</B></I>
+Class: <B>Button</B></I>
+</code></code></code></pre>
+<UL>
+The third button subwidget. By default it displays the text string "Cancel"
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>help</B></I>
+Class: <B>Button</B></I>
+</code></code></code></pre>
+<UL>
+The fourth button subwidget. By default it displays the text string "Help"
+</UL>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixStdButonBox</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a StdButonBox widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the StdButonBox
+such as its cursor and relief.
+<P>
+The StdButonBox widget is a group of Standard buttons for Motif-like
+dialog boxes.
+
+</pre><H3>WIDGET COMMAND</H3>
+<P>
+The <B>tixStdButonBox</B></I> command creates a new Tcl command whose name is
+be used to invoke various operations on the widget. It has the
+following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as
+determine the exact behavior of the command. The following
+commands are possible for StdButonBox widgets:
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixStdButonBox</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixStdButonBox</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>invoke <I>buttonName</I></B>
+</I></B>
+<DD> Invoke the button subwidget with the name </B></I>buttonName</B></I>.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no additional arguments are given, returns the pathname of the
+subwidget of the specified name.
+
+When no additional arguments are given, the widget command of the
+specified subwidget will be called with these parameters.
+</DL>
+</pre><H3>BINDINGS</H3>
+<P>
+TixStdButonBox widgets have no default bindings. The button subwidgets
+retain their default Tk bindings.
+</pre><H3>KEYWORDS</H3>
+Tix(n), Container Widgets
+<hr><i>Last modified Sun Jan 19 22:34:38 EST 1997 </i> ---
+<i>Serial 853731305</i>
diff --git a/tix/man/StdBBox.n b/tix/man/StdBBox.n
new file mode 100644
index 00000000000..f820afbac00
--- /dev/null
+++ b/tix/man/StdBBox.n
@@ -0,0 +1,239 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixStdButonBox tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixStdButonBox \- Create and manipulate Tix StdButonBox widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixStdButonBox\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+\fB
+'
+anchor background cursor
+relief borderWidth
+'
+\fR
+.ta 4c
+.fi
+.LP
+See the \fBoptions(n)\fR manual entry for details on the standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBorientation\fR
+Class: \fBOrientation\fR
+Switch: \fB\-orientation\fR
+Alias: \fB\-orient\fR
+.fi
+.IP
+\fBStatic Option\fR. Specifies the orientation of the button
+subwidgets. Only the values "horizontal" and "vertical" are recognized.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBpadx\fR
+Class: \fBPad\fR
+Switch: \fB\-padx\fR
+.fi
+.IP
+Specifies the horizontal padding between two neighboring button
+subwidgets in the StdButonBox widget.
+'----------END
+
+'----------BEGIN
+.LP
+.nf
+Name: \fBpadx\fR
+Class: \fBPad\fR
+Switch: \fB\-padx\fR
+.fi
+.IP
+Specifies the vertical padding between two neighboring button
+subwidgets in the StdButonBox widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Switch: \fB\-state\fR
+.fi
+.IP
+Specifies the state of all the buttons inside the StdButtonBox widget.
+
+\fINote\fR:
+Setting this option using the \fIconfig\fR widget command will enable
+or disable all the buttons subwidgets. Original states of the
+individual buttons are \fInot\fR saved.
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+.PP
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBok\fR
+Class: \fBButton\fR
+.fi
+.IP
+The first button subwidget. By default it displays the text string "Ok"
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBapply\fR
+Class: \fBButton\fR
+.fi
+.IP
+The second button subwidget. By default it displays the text string "Apply"
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcancel\fR
+Class: \fBButton\fR
+.fi
+.IP
+The third button subwidget. By default it displays the text string "Cancel"
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBhelp\fR
+Class: \fBButton\fR
+.fi
+.IP
+The fourth button subwidget. By default it displays the text string "Help"
+'----------END
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixStdButonBox\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a StdButonBox widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the StdButonBox
+such as its cursor and relief.
+'
+.PP
+The StdButonBox widget is a group of Standard buttons for Motif-like
+dialog boxes.
+
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET COMMAND"
+.PP
+'
+The \fBtixStdButonBox\fR command creates a new Tcl command whose name is
+the same as the path name of the StdButonBox's window. This command may
+be used to invoke various operations on the widget. It has the
+following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as
+the StdButonBox widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for StdButonBox widgets:
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixStdButonBox\fR command.
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixStdButonBox\fR command.
+'
+'
+.TP
+\fIpathName \fBinvoke \fIbuttonName\fR
+'
+Invoke the button subwidget with the name \fRbuttonName\fR.
+'
+.TP
+'
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no additional arguments are given, returns the pathname of the
+subwidget of the specified name.
+
+When no additional arguments are given, the widget command of the
+specified subwidget will be called with these parameters.
+'
+'----------------------------------------------------------------------
+.SH BINDINGS
+.PP
+TixStdButonBox widgets have no default bindings. The button subwidgets
+retain their default Tk bindings.
+'
+'
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n), Container Widgets
diff --git a/tix/man/TList.html b/tix/man/TList.html
new file mode 100644
index 00000000000..5dddf5329cb
--- /dev/null
+++ b/tix/man/TList.html
@@ -0,0 +1,606 @@
+
+
+
+<TITLE>tixTList - Create and manipulate Tix Tabular List widgets</TITLE>
+<Center><H2>tixTList - Create and manipulate Tix Tabular List widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixTList<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+None.
+</pre><H3>STANDARD OPTIONS</H3>
+<P>
+<pre><code><code><code>
+<B>background</B></I> <B>borderWidth</B></I> <B>cursor</B></I> <B>foreground</B></I>
+<B>font</B></I> <B>height</B></I> <B>highlightColor <B>highlightThickness
+<B>relief</B></I> <B>selectBackground</B></I> <B>selectForeground</B></I>
+<B>xScrollCommand</B></I> <B>yScrollCommand</B></I> <B>width</B></I>
+</code></code></code></pre>
+<P>
+See the <B>options(n)</B></I> manual entry for details on the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>browsecmd</B></I>
+Class: <B>BrowseCmd</B></I>
+Switch: <B>-browsecmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a TCL command to be executed when the user browses through the
+entries in the TList widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>command</B></I>
+Class: <B>Command</B></I>
+Switch: <B>-command</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the TCL command to be executed when the user invokes a list
+entry in the TList widget. Normally the user invokes a list
+entry by double-clicking it or pressing the Return key.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>foreground</B></I>
+Class: <B>Foreground</B></I>
+Switch: <B>-foreground</B></I>
+Alias: <B>-fg</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the default foreground color for the list entries.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>height</B></I>
+Class: <B>Height</B></I>
+Switch: <B>-height</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the desired height for the window in number of characters.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>itemType</B></I>
+Class: <B>ItemType</B></I>
+Switch: <B>-itemtype</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the default type of display item for this TList widget. When
+you call the <B>insert</B></I> widget commands, display items of this
+type will be created if the <B>-itemtype</B></I> option is not specified .
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>orient</B></I>
+Class: <B>Orient</B></I>
+Switch: <B>-orient</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the order of tabularizing the list entries. When set to
+"<B>vertical</B></I>", the entries are arranged in a column, from top to
+bottom. If the entries cannot be contained in one column, the
+remaining entries will go to the next column, and so on. When set to
+"<B>horizontal</B></I>", the entries are arranged in a row, from left to
+right. If the entries cannot be contained in one row, the remaining
+entries will go to the next row, and so on.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>padX</B></I>
+Class: <B>Pad</B></I>
+Switch: <B>-padx</B></I>
+</code></code></code></pre>
+<UL>
+The default horizontal padding for list entries.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>padY</B></I>
+Class: <B>Pad</B></I>
+Switch: <B>-padx</B></I>
+</code></code></code></pre>
+<UL>
+The default vertical padding for list entries.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>selectBackground</B></I>
+Class: <B>SelectBackground</B></I>
+Switch: <B>-selectbackground</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the background color for the selected list entries.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>selectBorderWidth</B></I>
+Class: <B>BorderWidth</B></I>
+Switch: <B>-selectborderwidth</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a non-negative value indicating the width of the 3-D border
+to draw around selected items. The value may have any of the forms
+acceptable to <B>Tk_GetPixels</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>selectForeground</B></I>
+Class: <B>SelectForeground</B></I>
+Switch: <B>-selectforeground</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the foreground color for the selected list entries.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>selectMode</B></I>
+Class: <B>SelectMode</B></I>
+Switch: <B>-selectmode</B></I>
+</code></code></code></pre>
+<UL>
+Specifies one of several styles for manipulating the selection. The
+value of the option may be arbitrary, but the default bindings expect
+it to be either <B>single</B></I>, <B>browse</B></I>, <B>multiple</B></I>, or
+<B>extended</B></I>; the default value is <B>single</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>sizeCmd</B></I>
+Class: <B>SizeCmd</B></I>
+Switch: <B>-sizecmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a TCL script to be called whenever the TList widget
+changes its size. This command can be useful to implement "user scroll
+bars when needed" features.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>state</B></I>
+Class: <B>State</B></I>
+Switch: <B>-state</B></I>
+</code></code></code></pre>
+<UL>
+Specifies whether the TList command should react to user actions. When
+set to "<B>normal</B></I>", the TList reacts to user actions in the normal
+way. When set to "<B>disabled</B></I>", the TList can only be scrolled, but
+its entries cannot be selected or activated.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>width</B></I>
+Class: <B>Width</B></I>
+Switch: <B>-width</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the desired width for the window in characters.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixTList</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a TList widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+TList widget such as its cursor and relief.
+<P>
+The TList widget can be used to display data in a tabular format. The
+list entries of a TList widget are similar to the entries in the Tk
+listbox widget. The main differences are (1) the TList widget can
+display the list entries in a two dimensional format and (2) you can
+use graphical images as well as multiple colors and fonts for
+the list entries.
+<P>
+Each list entry is identified by an <B>index</B></I>, which can be in the
+following forms:
+<UL>
+<DL>
+<DT> <I>number</I></B>
+</I></B>
+<DD> An integer that indicates the position of the entry in the list. 0
+means the first position, 1 means the second position, and so on.
+</DL>
+<DL>
+<DT> <B>end</B></I>
+</I></B>
+<DD> Indicates the end of the listbox. For some commands this means just
+after the last entry; for other commands it means the last entry.
+</DL>
+<DL>
+<DT> <B>@</B></I><I>x</I></B>,<I>y</I></B>
+</I></B>
+<DD> Indicates the element that covers the point in the listbox window
+specified by x and y (in pixel coordinates). If no element covers that
+point, then the closest element to that point is used.
+</DL>
+</UL>
+</pre><H3>DISPLAY ITEMS</H3>
+<P>
+Each list entry in an TList widget is associated with a <B>display
+item</B></I>. The display item determines what visual information should
+be displayed for this list entry. Please see the <B>DItem(n)</B></I> manual
+page for a list of all display items.
+<P>
+When a list entry is created by the <B>insert</B></I> command, the type of
+its display item is determined by the <B>-itemtype</B></I> option passed
+to these commands. If the <B>-itemtype</B></I> is omitted, then by default
+used.
+</pre><H3>WIDGET COMMAND</H3>
+<P>
+The <B>tixTList</B></I> command creates a new Tcl command whose name is the
+may be used to invoke various operations on the widget. It has the
+following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as
+determine the exact behavior of the command. The following
+commands are possible for TList widgets:
+<DL>
+<DT> <I>pathName <B>anchor set <I>index</I></B>
+</I></B>
+<DD> Sets the anchor to the list entry identified by <I>index</I></B>. The
+anchor is the end of the selection that is fixed while dragging out a
+selection with the mouse.
+</DL>
+<DL>
+<DT> <I>pathName <B>anchor clear</B></I>
+</I></B>
+<DD> Removes the anchor, if any, from this TList widget. This only removes
+the surrounding highlights of the anchor entry and does not affect its
+selection status.
+</DL>
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixTList</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixTList</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>delete</B></I> <I>from</I></B> ?<I>to</I></B>?
+</I></B>
+<DD> Deletes one or more list entries between the two entries specified by
+the indices <I>from</I></B> and <I>to</I></B>. If <I>to</I></B> is not specified, deletes
+the single entry specified by <I>from</I></B>.
+</DL>
+<DL>
+<DT> <I>pathName <B>dragsite set <I>index</I></B>
+</I></B>
+<DD> Sets the dragsite to the list entry identified by
+<I>index</I></B>. The dragsite is used to indicate the source of a
+drag-and-drop action. Currently drag-and-drop functionality has not
+been implemented in Tix yet.
+</DL>
+<DL>
+<DT> <I>pathName <B>dragsite clear</B></I>
+</I></B>
+<DD> Remove the dragsite, if any, from the this TList widget. This only
+removes the surrounding highlights of the dragsite entry and does not
+affect its selection status.
+</DL>
+<DL>
+<DT> <I>pathName <B>dropsite set <I>index</I></B>
+</I></B>
+<DD> Sets the dropsite to the list entry identified by <I>index</I></B>. The
+dropsite is used to indicate the target of a grag-and-drop
+action. Currently drag-and-drop functionality has not been implemented
+in Tix yet.
+</DL>
+<DL>
+<DT> <I>pathName <B>dropsite clear</B></I>
+</I></B>
+<DD> Remove the dropsite, if any, from the this TList widget. This only
+removes the surrounding highlights of the dropsite entry and does not
+affect its selection status.
+</DL>
+<DL>
+<DT> <I>pathName <B>entrycget</B></I> <I>index option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B> for the entry indentfied by <I>index</I></B>. <I>Option</I></B> may
+have any of the values accepted by the <B>insert</B></I> widget command.
+</DL>
+<DL>
+<DT> <I>pathName <B>entryconfigure<I> index </I></B>?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the list entry indentfied
+by <I>index</I></B>. If no <I>option</I></B> is specified, returns a list
+describing all of the available options for <I>index</I></B> (see
+<B>Tk_ConfigureInfo</B></I> for information on the format of this list). If
+<I>option</I></B> is specified with no <I>value</I></B>, then the command
+returns a list describing the one named option (this list will be
+identical to the corresponding sublist of the value returned if no
+<I>option</I></B> is specified). If one or more <I>option-value</I></B> pairs
+are specified, then the command modifies the given option(s) to have
+the given value(s); in this case the command returns an empty string.
+<I>Option</I></B> may have any of the values accepted by the <B>insert</B></I>
+widget command. The exact set of options depends on the
+value of the <B>-itemtype</B></I> option passed to the the <B>insert</B></I>
+widget command when this list entry is created.
+</DL>
+<DL>
+<DT> <I>pathName <B>insert<I> index </I></B>?<I>option value ...</I></B>?
+</I></B>
+<DD> Creates a new list entry at the position indicated by <I>index</I></B>. The
+following configuration options can be given to configure the list
+entry:
+</DL>
+<UL>
+<DL>
+<DT> <B>-itemtype<I> type</I></B>
+</I></B>
+<DD> Specifies the type of display item to be display for the new list
+entry. <I>type</I></B> must be a valid display item type. Currently the
+available display item types are <B>image</B></I>, <B>imagetext</B></I>,
+<B>text</B></I>, and <B>window</B></I>. If this option is not specified, then by
+option is used.
+</DL>
+<DL>
+<DT> <B>-state</B></I>
+</I></B>
+<DD> Specifies whether this entry can be selected or invoked by the user.
+Must be either <B>normal</B></I> or <B>disabled</B></I>.
+</DL>
+</UL>
+The <B>insert</B></I> widget command accepts additional configuration options
+to configure the display item associated with this list entry. The set
+of additional configuration options depends on the type of the display
+item given by the <B>-itemtype</B></I> option. Please see the
+<B>DItem(n)</B></I> manual page for a list of the configuration options for
+each of the display item types.
+<DL>
+<DT> <I>pathName <B>info <I>option</I></B> <I>arg ...</I></B>
+</I></B>
+<DD> Query information about the TList widget. <I>option</I></B> can be one
+of the following:
+</DL>
+<UL>
+<DL>
+<DT> <I>pathName <B>info <B>anchor</B></I> <I>index</I></B>
+</I></B>
+<DD> ;
+Returns the index of the current anchor, if any, of the TList
+widget. If the anchor is not set, returns the empty string.
+</DL>
+<DL>
+<DT> <I>pathName <B>info <B>dragsite</B></I> <I>index</I></B>
+</I></B>
+<DD> Returns the index of the current dragsite, if any, of the TList
+widget. If the dragsite is not set, returns the empty string.
+</DL>
+<DL>
+<DT> <I>pathName <B>info <B>dropsite</B></I> <I>index</I></B>
+</I></B>
+<DD> Returns the index of the current dropsite, if any, of the TList
+widget. If the dropsite is not set, returns the empty string.
+</DL>
+<DL>
+<DT> <I>pathName <B>info <B>selection</B></I>
+</I></B>
+<DD> Returns a list of selected elements in the TList widget. If no entries
+are selectd, returns an empty string.
+</DL>
+</UL>
+<DL>
+<DT> <I>pathName <B>nearest <I>x y</I></B>
+</I></B>
+<DD> Given an (x,y) coordinate within the TList window, this command
+returns the index of the TList element nearest to that coordinate.
+</DL>
+<DL>
+<DT> <I>pathName <B>see <I>index</I></B>
+</I></B>
+<DD> Adjust the view in the TList so that the entry given by <I>index</I></B> is
+visible. If the entry is already visible then the command has no
+effect; if the entry is near one edge of the window then the TList
+scrolls to bring the element into view at the edge; otherwise the
+TList widget scrolls to center the entry.
+</DL>
+<DL>
+<DT> <I>pathName <B>selection <I>option</I></B> <I>arg ...</I></B>
+</I></B>
+<DD> This command is used to adjust the selection within a TList widget. It
+has several forms, depending on <I>option</I></B>:
+</DL>
+<UL>
+<DL>
+<DT> <I>pathName <B>selection clear </B></I>?<I>from</I></B>? ?<I>to</I></B>?
+</I></B>
+<DD> When no extra arguments are given, deselects all of the list entrie(s)
+in this TList widget. When only <I>from</I></B> is given, only the list
+entry identified by <I>from</I></B> is deselected. When both <I>from</I></B> and
+<I>to</I></B> are given, deselects all of the list entrie(s) between
+between <I>from</I></B> and <I>to</I></B>, inclusive, without affecting the
+selection state of entries outside that range.
+</DL>
+<DL>
+<DT> <I>pathName <B>selection includes <I>index</I></B>
+</I></B>
+<DD> Returns 1 if the list entry indicated by <I>index</I></B> is currently
+selected; returns 0 otherwise.
+</DL>
+<DL>
+<DT> <I>pathName <B>selection set <I>from</I></B> ?<I>to</I></B>?
+</I></B>
+<DD> Selects all of the list entrie(s) between between <I>from</I></B> and
+<I>to</I></B>, inclusive, without affecting the selection state of entries
+outside that range. When only <I>from</I></B> is given, only the list entry
+identified by <I>from</I></B> is selected.
+</DL>
+</UL>
+<DL>
+<DT> <I>pathName <B>xview <I>args</I></B>
+</I></B>
+<DD> This command is used to query and change the horizontal position of the
+forms:
+</DL>
+<UL>
+<DL>
+<DT> <I>pathName <B>xview</B></I>
+</I></B>
+<DD> Returns a list containing two elements. Each element is a real
+fraction between 0 and 1; together they describe the horizontal span
+that is visible in the window. For example, if the first element is
+</DL>
+
+off-screen to the left, the middle 40% is visible in the window, and
+40% of the entry is off-screen to the right. These are the same values
+passed to scrollbars via the <B>-xscrollcommand</B></I> option.
+<DL>
+<DT> <I>pathName <B>xview</B></I> <I>index</I></B>
+</I></B>
+<DD> Adjusts the view in the window so that the list entry identified by
+<I>index</I></B> is aligned to the left edge of the window.
+</DL>
+<DL>
+<DT> <I>pathName <B>xview moveto<I> fraction</I></B>
+</I></B>
+<DD> Adjusts the view in the window so that <I>fraction</I></B> of the total
+width of the TList is off-screen to the left. <I>fraction</I></B> must be
+a fraction between 0 and 1.
+</DL>
+<DL>
+<DT> <I>pathName <B>xview scroll <I>number what</I></B>
+</I></B>
+<DD> This command shifts the view in the window left or right according to
+<I>number</I></B> and <I>what</I></B>. <I>Number</I></B> must be an integer.
+<I>What</I></B> must be either <B>units</B></I> or <B>pages</B></I> or an
+abbreviation of one of these. If <I>what</I></B> is <B>units</B></I>, the view
+adjusts left or right by <I>number</I></B> character units (the width of
+the <B>0</B></I> character) on the display; if it is <B>pages</B></I> then the
+view adjusts by <I>number</I></B> screenfuls. If <I>number</I></B> is negative
+then characters farther to the left become visible; if it is positive
+then characters farther to the right become visible.
+</DL>
+</UL>
+<DL>
+<DT> <I>pathName <B>yview <I>?args</I></B>?
+</I></B>
+<DD> This command is used to query and change the vertical position of the
+</DL>
+<UL>
+<DL>
+<DT> <I>pathName <B>yview</B></I>
+</I></B>
+<DD> Returns a list containing two elements, both of which are real
+fractions between 0 and 1. The first element gives the position of
+the list element at the top of the window, relative to the TList as a
+whole (0.5 means it is halfway through the TList, for example). The
+second element gives the position of the list entry just after the
+last one in the window, relative to the TList as a whole. These are
+the same values passed to scrollbars via the <B>-yscrollcommand</B></I>
+option.
+</DL>
+<DL>
+<DT> <I>pathName <B>yview</B></I> <I>index</I></B>
+</I></B>
+<DD> Adjusts the view in the window so that the list entry given by
+<I>index</I></B> is displayed at the top of the window.
+</DL>
+<DL>
+<DT> <I>pathName <B>yview moveto<I> fraction</I></B>
+</I></B>
+<DD> Adjusts the view in the window so that the list entry given by
+<I>fraction</I></B> appears at the top of the window. <I>Fraction</I></B> is a
+fraction between 0 and 1; 0 indicates the first entry in the TList,
+0.33 indicates the entry one-third the way through the TList, and so
+on.
+</DL>
+<DL>
+<DT> <I>pathName <B>yview scroll <I>number what</I></B>
+</I></B>
+<DD> This command adjust the view in the window up or down according to
+<I>number</I></B> and <I>what</I></B>. <I>Number</I></B> must be an integer.
+<I>What</I></B> must be either <B>units</B></I> or <B>pages</B></I>. If <I>what</I></B>
+is <B>units</B></I>, the view adjusts up or down by <I>number</I></B> lines; if
+it is <B>pages</B></I> then the view adjusts by <I>number</I></B> screenfuls.
+If <I>number</I></B> is negative then earlier entries become visible; if
+it is positive then later entries become visible.
+</DL>
+</UL>
+</pre><H3>BINDINGS</H3>
+<P>
+<UL>
+[1] <BR>
+If the <B>-selectmode</B></I> is "browse", when the user drags the mouse
+pointer over the list entries, the entry under the pointer will be
+highlighted and the <B>-browsecmd</B></I> procedure will be called with
+one parameter, the index of the highlighted entry. Only one entry
+can be highlighted at a time. The <B>-command</B></I> procedure will be
+called when the user double-clicks on a list entry.
+</UL>
+<UL>
+[2] <BR>
+If the <B>-selectmode</B></I> is "single", the entries will only be
+highlighted by mouse &lt;ButtonRelease-1&gt; events. When a new list entry
+is highlighted, the <B>-browsecmd</B></I> procedure will be called with
+one parameter indicating the highlighted list entry. The
+<B>-command</B></I> procedure will be called when the user double-clicks
+on a list entry.
+</UL>
+<UL>
+[3] <BR>
+If the <B>-selectmode</B></I> is "multiple", when the user drags the mouse
+pointer over the list entries, all the entries under the pointer will
+be highlighted. However, only a contiguous region of list entries can
+be selected. When the highlighted area is changed, the
+<B>-browsecmd</B></I> procedure will be called with an undefined
+parameter. It is the responsibility of the <B>-browsecmd</B></I> procedure
+to find out the exact highlighted selection in the TList. The
+<B>-command</B></I> procedure will be called when the user double-clicks
+on a list entry.
+</UL>
+<UL>
+[4] <BR>
+If the <B>-selectmode</B></I> is "extended", when the user drags the mouse
+pointer over the list entries, all the entries under the pointer will
+be highlighted. The user can also make disjointed selections using
+&lt;Control-ButtonPress-1&gt;. When the highlighted area is changed, the
+<B>-browsecmd</B></I> procedure will be called with an undefined
+parameter. It is the responsibility of the <B>-browsecmd</B></I> procedure
+to find out the exact highlighted selection in the TList. The
+<B>-command</B></I> procedure will be called when the user double-clicks
+on a list entry.
+</UL>
+</pre><H3>EXAMPLE</H3>
+<P>
+This example demonstrates how to use an TList to store a list of
+numbers:
+<P>
+\fC
+<pre><code><code><code>
+ set image [tix getimage folder]
+ tixTList .t -orient vertical
+ .t insert end -itemtype imagetext -image $image -text one
+ .t insert end -itemtype imagetext -image $image -text two
+ .t insert end -itemtype imagetext -image $image -text three
+ .t insert end -itemtype imagetext -image $image -text four
+ .t insert end -itemtype imagetext -image $image -text five
+ .t insert end -itemtype imagetext -image $image -text six
+ pack .t -expand yes -fill both
+</code></code></code></pre>
+</B></I>
+</pre><H3>KEYWORDS</H3>
+Tix(n), Tabular Listbox, Display Items
+<!Serial 851729151>
+<hr><i>Last modified Fri Jan 17 23:02:12 EST 1997 </i> ---
+<i>Serial 853731306</i>
diff --git a/tix/man/TList.n b/tix/man/TList.n
new file mode 100644
index 00000000000..8cd17adbd73
--- /dev/null
+++ b/tix/man/TList.n
@@ -0,0 +1,680 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixTList tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixTList \- Create and manipulate Tix Tabular List widgets
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixTList\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+None.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+.LP
+.nf
+.ta 4c 8c 12c
+\fBbackground\fR \fBborderWidth\fR \fBcursor\fR \fBforeground\fR
+\fBfont\fR \fBheight\fR \fBhighlightColor \fBhighlightThickness
+\fBrelief\fR \fBselectBackground\fR \fBselectForeground\fR
+\fBxScrollCommand\fR \fByScrollCommand\fR \fBwidth\fR
+.ta 4c
+.fi
+.LP
+See the \fBoptions(n)\fR manual entry for details on the standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBbrowsecmd\fR
+Class: \fBBrowseCmd\fR
+Switch: \fB\-browsecmd\fR
+.fi
+.IP
+Specifies a TCL command to be executed when the user browses through the
+entries in the TList widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Switch: \fB\-command\fR
+.fi
+.IP
+Specifies the TCL command to be executed when the user invokes a list
+entry in the TList widget. Normally the user invokes a list
+entry by double-clicking it or pressing the Return key.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBforeground\fR
+Class: \fBForeground\fR
+Switch: \fB\-foreground\fR
+Alias: \fB\-fg\fR
+.fi
+.IP
+Specifies the default foreground color for the list entries.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBheight\fR
+Class: \fBHeight\fR
+Switch: \fB\-height\fR
+.fi
+.IP
+Specifies the desired height for the window in number of characters.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBitemType\fR
+Class: \fBItemType\fR
+Switch: \fB\-itemtype\fR
+.fi
+.IP
+Specifies the default type of display item for this TList widget. When
+you call the \fBinsert\fR widget commands, display items of this
+type will be created if the \fB\-itemtype\fR option is not specified .
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBorient\fR
+Class: \fBOrient\fR
+Switch: \fB\-orient\fR
+.fi
+.IP
+Specifies the order of tabularizing the list entries. When set to
+"\fBvertical\fR", the entries are arranged in a column, from top to
+bottom. If the entries cannot be contained in one column, the
+remaining entries will go to the next column, and so on. When set to
+"\fBhorizontal\fR", the entries are arranged in a row, from left to
+right. If the entries cannot be contained in one row, the remaining
+entries will go to the next row, and so on.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBpadX\fR
+Class: \fBPad\fR
+Switch: \fB\-padx\fR
+.fi
+.IP
+The default horizontal padding for list entries.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBpadY\fR
+Class: \fBPad\fR
+Switch: \fB\-padx\fR
+.fi
+.IP
+The default vertical padding for list entries.
+'----------END
+'----------BEGIN
+.LP
+.nf
+Name: \fBselectBackground\fR
+Class: \fBSelectBackground\fR
+Switch: \fB\-selectbackground\fR
+.fi
+.IP
+Specifies the background color for the selected list entries.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBselectBorderWidth\fR
+Class: \fBBorderWidth\fR
+Switch: \fB\-selectborderwidth\fR
+.fi
+.IP
+Specifies a non-negative value indicating the width of the 3-D border
+to draw around selected items. The value may have any of the forms
+acceptable to \fBTk_GetPixels\fR.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBselectForeground\fR
+Class: \fBSelectForeground\fR
+Switch: \fB\-selectforeground\fR
+.fi
+.IP
+Specifies the foreground color for the selected list entries.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBselectMode\fR
+Class: \fBSelectMode\fR
+Switch: \fB\-selectmode\fR
+.fi
+.IP
+Specifies one of several styles for manipulating the selection. The
+value of the option may be arbitrary, but the default bindings expect
+it to be either \fBsingle\fR, \fBbrowse\fR, \fBmultiple\fR, or
+\fBextended\fR; the default value is \fBsingle\fR.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBsizeCmd\fR
+Class: \fBSizeCmd\fR
+Switch: \fB\-sizecmd\fR
+.fi
+.IP
+Specifies a TCL script to be called whenever the TList widget
+changes its size. This command can be useful to implement "user scroll
+bars when needed" features.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Switch: \fB\-state\fR
+.fi
+.IP
+Specifies whether the TList command should react to user actions. When
+set to "\fBnormal\fR", the TList reacts to user actions in the normal
+way. When set to "\fBdisabled\fR", the TList can only be scrolled, but
+its entries cannot be selected or activated.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBwidth\fR
+Class: \fBWidth\fR
+Switch: \fB\-width\fR
+.fi
+.IP
+Specifies the desired width for the window in characters.
+'----------END
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixTList\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a TList widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+TList widget such as its cursor and relief.
+'
+.PP
+The TList widget can be used to display data in a tabular format. The
+list entries of a TList widget are similar to the entries in the Tk
+listbox widget. The main differences are (1) the TList widget can
+display the list entries in a two dimensional format and (2) you can
+use graphical images as well as multiple colors and fonts for
+the list entries.
+'
+.PP
+Each list entry is identified by an \fBindex\fR, which can be in the
+following forms:
+.RS
+.TP
+\fInumber\fR
+'
+An integer that indicates the position of the entry in the list. 0
+means the first position, 1 means the second position, and so on.
+'
+.TP
+\fBend\fR
+'
+Indicates the end of the listbox. For some commands this means just
+after the last entry; for other commands it means the last entry.
+'
+.TP
+\fB@\fR\fIx\fR,\fIy\fR
+'
+Indicates the element that covers the point in the listbox window
+specified by x and y (in pixel coordinates). If no element covers that
+point, then the closest element to that point is used.
+'
+.RE
+'
+.SH "DISPLAY ITEMS"
+.PP
+Each list entry in an TList widget is associated with a \fBdisplay
+item\fR. The display item determines what visual information should
+be displayed for this list entry. Please see the \fBDItem(n)\fR manual
+page for a list of all display items.
+'
+.PP
+When a list entry is created by the \fBinsert\fR command, the type of
+its display item is determined by the \fB\-itemtype\fR option passed
+to these commands. If the \fB\-itemtype\fR is omitted, then by default
+the type specified by this TList widget's \fB\-itemtype\fR option is
+used.
+'----------------------------------------------------------------------
+.SH "WIDGET COMMAND"
+.PP
+'
+The \fBtixTList\fR command creates a new Tcl command whose name is the
+same as the path name of the TList widget's window. This command
+may be used to invoke various operations on the widget. It has the
+following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as
+the TList widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for TList widgets:
+'
+.TP
+\fIpathName \fBanchor set \fIindex\fR
+'
+Sets the anchor to the list entry identified by \fIindex\fR. The
+anchor is the end of the selection that is fixed while dragging out a
+selection with the mouse.
+'
+.TP
+\fIpathName \fBanchor clear\fR
+'
+Removes the anchor, if any, from this TList widget. This only removes
+the surrounding highlights of the anchor entry and does not affect its
+selection status.
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixTList\fR command.
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixTList\fR command.
+'
+.TP
+\fIpathName \fBdelete\fR \fIfrom\fR ?\fIto\fR?
+Deletes one or more list entries between the two entries specified by
+the indices \fIfrom\fR and \fIto\fR. If \fIto\fR is not specified, deletes
+the single entry specified by \fIfrom\fR.
+'
+.TP
+\fIpathName \fBdragsite set \fIindex\fR
+'
+Sets the dragsite to the list entry identified by
+\fIindex\fR. The dragsite is used to indicate the source of a
+drag-and-drop action. Currently drag-and-drop functionality has not
+been implemented in Tix yet.
+'
+.TP
+\fIpathName \fBdragsite clear\fR
+Remove the dragsite, if any, from the this TList widget. This only
+removes the surrounding highlights of the dragsite entry and does not
+affect its selection status.
+'
+'
+.TP
+\fIpathName \fBdropsite set \fIindex\fR
+'
+Sets the dropsite to the list entry identified by \fIindex\fR. The
+dropsite is used to indicate the target of a grag-and-drop
+action. Currently drag-and-drop functionality has not been implemented
+in Tix yet.
+'
+.TP
+\fIpathName \fBdropsite clear\fR
+'
+Remove the dropsite, if any, from the this TList widget. This only
+removes the surrounding highlights of the dropsite entry and does not
+affect its selection status.
+'
+.TP
+\fIpathName \fBentrycget\fR \fIindex option\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR for the entry indentfied by \fIindex\fR. \fIOption\fR may
+have any of the values accepted by the \fBinsert\fR widget command.
+'
+.TP
+\fIpathName \fBentryconfigure\fI index \fR?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the list entry indentfied
+by \fIindex\fR. If no \fIoption\fR is specified, returns a list
+describing all of the available options for \fIindex\fR (see
+\fBTk_ConfigureInfo\fR for information on the format of this list). If
+\fIoption\fR is specified with no \fIvalue\fR, then the command
+returns a list describing the one named option (this list will be
+identical to the corresponding sublist of the value returned if no
+\fIoption\fR is specified). If one or more \fIoption\-value\fR pairs
+are specified, then the command modifies the given option(s) to have
+the given value(s); in this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBinsert\fR
+widget command. The exact set of options depends on the
+value of the \fB\-itemtype\fR option passed to the the \fBinsert\fR
+widget command when this list entry is created.
+'
+.TP
+\fIpathName \fBinsert\fI index \fR?\fIoption value ...\fR?
+'
+Creates a new list entry at the position indicated by \fIindex\fR. The
+following configuration options can be given to configure the list
+entry:
+'
+.RS
+'
+.TP
+\fB\-itemtype\fI type\fR
+'
+Specifies the type of display item to be display for the new list
+entry. \fItype\fR must be a valid display item type. Currently the
+available display item types are \fBimage\fR, \fBimagetext\fR,
+\fBtext\fR, and \fBwindow\fR. If this option is not specified, then by
+default the type specified by this TList widget's \fB\-itemtype\fR
+option is used.
+'
+.TP
+\fB\-state\fR
+'
+Specifies whether this entry can be selected or invoked by the user.
+Must be either \fBnormal\fR or \fBdisabled\fR.
+'
+.RE
+'
+The \fBinsert\fR widget command accepts additional configuration options
+to configure the display item associated with this list entry. The set
+of additional configuration options depends on the type of the display
+item given by the \fB\-itemtype\fR option. Please see the
+\fBDItem(n)\fR manual page for a list of the configuration options for
+each of the display item types.
+'
+.TP
+\fIpathName \fBinfo \fIoption\fR \fIarg ...\fR
+'
+Query information about the TList widget. \fIoption\fR can be one
+of the following:
+.RS
+.TP
+\fIpathName \fBinfo \fBanchor\fR \fIindex\fR
+;
+Returns the index of the current anchor, if any, of the TList
+widget. If the anchor is not set, returns the empty string.
+'
+.TP
+\fIpathName \fBinfo \fBdragsite\fR \fIindex\fR
+Returns the index of the current dragsite, if any, of the TList
+widget. If the dragsite is not set, returns the empty string.
+'
+.TP
+\fIpathName \fBinfo \fBdropsite\fR \fIindex\fR
+Returns the index of the current dropsite, if any, of the TList
+widget. If the dropsite is not set, returns the empty string.
+'
+.TP
+\fIpathName \fBinfo \fBselection\fR
+'
+Returns a list of selected elements in the TList widget. If no entries
+are selectd, returns an empty string.
+.RE
+'
+.TP
+\fIpathName \fBnearest \fIx y\fR
+'
+Given an (x,y) coordinate within the TList window, this command
+returns the index of the TList element nearest to that coordinate.
+'
+'
+.TP
+\fIpathName \fBsee \fIindex\fR
+'
+Adjust the view in the TList so that the entry given by \fIindex\fR is
+visible. If the entry is already visible then the command has no
+effect; if the entry is near one edge of the window then the TList
+scrolls to bring the element into view at the edge; otherwise the
+TList widget scrolls to center the entry.
+'
+.TP
+\fIpathName \fBselection \fIoption\fR \fIarg ...\fR
+'
+This command is used to adjust the selection within a TList widget. It
+has several forms, depending on \fIoption\fR:
+.RS
+'
+.TP
+\fIpathName \fBselection clear \fR?\fIfrom\fR? ?\fIto\fR?
+'
+When no extra arguments are given, deselects all of the list entrie(s)
+in this TList widget. When only \fIfrom\fR is given, only the list
+entry identified by \fIfrom\fR is deselected. When both \fIfrom\fR and
+\fIto\fR are given, deselects all of the list entrie(s) between
+between \fIfrom\fR and \fIto\fR, inclusive, without affecting the
+selection state of entries outside that range.
+'
+.TP
+\fIpathName \fBselection includes \fIindex\fR
+'
+Returns 1 if the list entry indicated by \fIindex\fR is currently
+selected; returns 0 otherwise.
+'
+.TP
+\fIpathName \fBselection set \fIfrom\fR ?\fIto\fR?
+'
+Selects all of the list entrie(s) between between \fIfrom\fR and
+\fIto\fR, inclusive, without affecting the selection state of entries
+outside that range. When only \fIfrom\fR is given, only the list entry
+identified by \fIfrom\fR is selected.
+.RE
+'
+.TP
+\fIpathName \fBxview \fIargs\fR
+This command is used to query and change the horizontal position of the
+information in the widget's window. It can take any of the following
+forms:
+.RS
+.TP
+\fIpathName \fBxview\fR
+'
+Returns a list containing two elements. Each element is a real
+fraction between 0 and 1; together they describe the horizontal span
+that is visible in the window. For example, if the first element is
+.2 and the second element is .6, 20% of the TList entry is
+off-screen to the left, the middle 40% is visible in the window, and
+40% of the entry is off-screen to the right. These are the same values
+passed to scrollbars via the \fB\-xscrollcommand\fR option.
+.TP
+\fIpathName \fBxview\fR \fIindex\fR
+'
+Adjusts the view in the window so that the list entry identified by
+\fIindex\fR is aligned to the left edge of the window.
+.TP
+\fIpathName \fBxview moveto\fI fraction\fR
+'
+Adjusts the view in the window so that \fIfraction\fR of the total
+width of the TList is off-screen to the left. \fIfraction\fR must be
+a fraction between 0 and 1.
+'
+.TP
+\fIpathName \fBxview scroll \fInumber what\fR
+'
+This command shifts the view in the window left or right according to
+\fInumber\fR and \fIwhat\fR. \fINumber\fR must be an integer.
+\fIWhat\fR must be either \fBunits\fR or \fBpages\fR or an
+abbreviation of one of these. If \fIwhat\fR is \fBunits\fR, the view
+adjusts left or right by \fInumber\fR character units (the width of
+the \fB0\fR character) on the display; if it is \fBpages\fR then the
+view adjusts by \fInumber\fR screenfuls. If \fInumber\fR is negative
+then characters farther to the left become visible; if it is positive
+then characters farther to the right become visible.
+'
+.RE
+'
+.TP
+\fIpathName \fByview \fI?args\fR?
+'
+This command is used to query and change the vertical position of the
+entries in the widget's window. It can take any of the following forms:
+'
+.RS
+.TP
+\fIpathName \fByview\fR
+'
+Returns a list containing two elements, both of which are real
+fractions between 0 and 1. The first element gives the position of
+the list element at the top of the window, relative to the TList as a
+whole (0.5 means it is halfway through the TList, for example). The
+second element gives the position of the list entry just after the
+last one in the window, relative to the TList as a whole. These are
+the same values passed to scrollbars via the \fB\-yscrollcommand\fR
+option.
+'
+.TP
+\fIpathName \fByview\fR \fIindex\fR
+'
+Adjusts the view in the window so that the list entry given by
+\fIindex\fR is displayed at the top of the window.
+'
+.TP
+\fIpathName \fByview moveto\fI fraction\fR
+'
+Adjusts the view in the window so that the list entry given by
+\fIfraction\fR appears at the top of the window. \fIFraction\fR is a
+fraction between 0 and 1; 0 indicates the first entry in the TList,
+0.33 indicates the entry one-third the way through the TList, and so
+on.
+.TP
+\fIpathName \fByview scroll \fInumber what\fR
+'
+This command adjust the view in the window up or down according to
+\fInumber\fR and \fIwhat\fR. \fINumber\fR must be an integer.
+\fIWhat\fR must be either \fBunits\fR or \fBpages\fR. If \fIwhat\fR
+is \fBunits\fR, the view adjusts up or down by \fInumber\fR lines; if
+it is \fBpages\fR then the view adjusts by \fInumber\fR screenfuls.
+If \fInumber\fR is negative then earlier entries become visible; if
+it is positive then later entries become visible.
+.RE
+'
+'----------------------------------------------------------------------
+.SH BINDINGS
+.PP
+.IP [1]
+If the \fB\-selectmode\fR is "browse", when the user drags the mouse
+pointer over the list entries, the entry under the pointer will be
+highlighted and the \fB\-browsecmd\fR procedure will be called with
+one parameter, the index of the highlighted entry. Only one entry
+can be highlighted at a time. The \fB\-command\fR procedure will be
+called when the user double-clicks on a list entry.
+'
+.IP [2]
+If the \fB\-selectmode\fR is "single", the entries will only be
+highlighted by mouse <ButtonRelease-1> events. When a new list entry
+is highlighted, the \fB\-browsecmd\fR procedure will be called with
+one parameter indicating the highlighted list entry. The
+\fB\-command\fR procedure will be called when the user double-clicks
+on a list entry.
+'
+'
+.IP [3]
+If the \fB\-selectmode\fR is "multiple", when the user drags the mouse
+pointer over the list entries, all the entries under the pointer will
+be highlighted. However, only a contiguous region of list entries can
+be selected. When the highlighted area is changed, the
+\fB\-browsecmd\fR procedure will be called with an undefined
+parameter. It is the responsibility of the \fB\-browsecmd\fR procedure
+to find out the exact highlighted selection in the TList. The
+\fB\-command\fR procedure will be called when the user double-clicks
+on a list entry.
+'
+.IP [4]
+'
+If the \fB\-selectmode\fR is "extended", when the user drags the mouse
+pointer over the list entries, all the entries under the pointer will
+be highlighted. The user can also make disjointed selections using
+<Control-ButtonPress-1>. When the highlighted area is changed, the
+\fB\-browsecmd\fR procedure will be called with an undefined
+parameter. It is the responsibility of the \fB\-browsecmd\fR procedure
+to find out the exact highlighted selection in the TList. The
+\fB\-command\fR procedure will be called when the user double-clicks
+on a list entry.
+'
+'----------------------------------------------------------------------
+.SH EXAMPLE
+.PP
+This example demonstrates how to use an TList to store a list of
+numbers:
+.PP
+\fC
+.nf
+ set image [tix getimage folder]
+ tixTList .t -orient vertical
+ .t insert end -itemtype imagetext -image $image -text one
+ .t insert end -itemtype imagetext -image $image -text two
+ .t insert end -itemtype imagetext -image $image -text three
+ .t insert end -itemtype imagetext -image $image -text four
+ .t insert end -itemtype imagetext -image $image -text five
+ .t insert end -itemtype imagetext -image $image -text six
+ pack .t -expand yes -fill both
+.fi
+\fR
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n), Tabular Listbox, Display Items
diff --git a/tix/man/TixComboBox.html b/tix/man/TixComboBox.html
new file mode 100644
index 00000000000..33e4bd927b4
--- /dev/null
+++ b/tix/man/TixComboBox.html
@@ -0,0 +1,492 @@
+
+
+
+<TITLE>tixComboBox - Create and manipulate tixComboBox widgets</TITLE>
+<Center><H2>tixComboBox - Create and manipulate tixComboBox widgets</H2></Center><hr>
+
+<P>
+</pre><H3>SYNOPSIS</H3>
+<B>tixComboBox<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+The <B>TixComboBox</B></I> class is derived from the <B>TixLabelWidget</B></I>
+class and inherits all the commands, options and subwidgets
+of its super-class.
+</pre><H3>STANDARD OPTIONS</H3>
+<B>TixComboBox</B></I> supports all the standard options of a frame widget.
+See the options(n) manual entry for details on the standard options.
+<P>
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>anchor</B></I>
+Class: <B>Anchor</B></I>
+Switch: <B>-anchor</B></I>
+</code></code></code></pre>
+<UL>
+Specifies how the string inside the entry subwidget should be aligned.
+Only the values "w" or "e" are allowed. When set the "w", the entry is
+aligned to its beginning. When set to "e", it is aligned to its end.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>arrowBitmap</B></I>
+Class: <B>ArrowBitmap</B></I>
+Switch: <B>-arrowbitmap</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the bitmap to be used in the arrow button beside the entry
+widget. The default is an downward arrow bitmap in the file
+$tix_library/bitmaps/cbxarrow
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>browseCmd</B></I>
+Class: <B>BrowseCmd</B></I>
+Switch: <B>-browsecmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the command to be called when the user browses through the
+listbox. This command can be used to provide instant feedback when the
+user examines items in the listbox before committing a choice.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>command</B></I>
+Class: <B>Command</B></I>
+Switch: <B>-command</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the command to be called when the ComboBox is invoked
+or when the <B>-value</B></I> of the ComboBox is changed.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>crossBitmap</B></I>
+Class: <B>CrossBitmap</B></I>
+Switch: <B>-crossbitmap</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the bitmap to be used in the "cross" button to the left of
+the entry widget. The default is a bitmap in the file
+$tix_library/bitmaps/cross
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>disableCallback</B></I>
+Class: <B>DisableCallback</B></I>
+Switch: <B>-disablecallback</B></I>
+</code></code></code></pre>
+<UL>
+A boolean value indicating whether callbacks should be disabled. When
+set to true, the TCL command specified by the <B>-command</B></I> option
+is not executed when the <B>-value</B></I> of the ComboBox.
+changes.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>disabledforeground</B></I>
+Class: <B>DisabledForeground</B></I>
+Switch: <B>-disabledforeground</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the foreground color to be used when the ComboBox is disabled.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>dropdown</B></I>
+Class: <B>Dropdown</B></I>
+Switch: <B>-dropdown</B></I>
+</code></code></code></pre>
+<UL>
+A Boolean value specifying the style of the ComboBox. When set to
+"true", the listbox is only displayed temporarily when the arrow
+button is pressed. When set to "false", the listbox is always
+displayed.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>editable</B></I>
+Class: <B>Editable</B></I>
+Switch: <B>-editable</B></I>
+</code></code></code></pre>
+<UL>
+Specifies whether the user is allowed to type into the entry subwidget of
+the ComboBox.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>fancy</B></I>
+Class: <B>Fancy</B></I>
+Switch: <B>-fancy</B></I>
+</code></code></code></pre>
+<UL>
+A Boolean value specifying whether the cross and tick button
+subwidgets should be shown.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>grab</B></I>
+Class: <B>Grab</B></I>
+Switch: <B>-grab</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the pointer grabbing policy when the listbox is popped up.
+Only values "global", "local" or "none" are allowed. By default global
+grab is used. However, when you are developing your application, you
+may want to use only local grabbing so that in the event of errors,
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>historyLimit</B></I>
+Class: <B>historyLimit</B></I>
+Switch: <B>-historylimit</B></I>
+Alias: <B>-histlimit</B></I>
+</code></code></code></pre>
+<UL>
+Specifies how many previous user inputs can be stored in the history
+list.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>history</B></I>
+Class: <B>History</B></I>
+Switch: <B>-history</B></I>
+</code></code></code></pre>
+<UL>
+A Boolean value specifying whether previous user inputs should be
+stored in the history list.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>label</B></I>
+Class: <B>Label</B></I>
+Switch: <B>-label</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the string to display as the label of this ComboBox widget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>labelSide</B></I>
+Class: <B>LabelSide</B></I>
+Switch: <B>-labelside</B></I>
+</code></code></code></pre>
+<UL>
+Specifies where the label should be displayed relative to the entry
+subwidget. Valid options are: <B>top</B></I>, <B>left</B></I>, <B>right</B></I>,
+<B>bottom</B></I>, <B>none</B></I> or <B>acrosstop</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>listCmd</B></I>
+Class: <B>listCmd</B></I>
+Switch: <B>-listcmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a TCL command to be called every time when the listbox pops
+up. This option allows you to fill up the listbox on-demand. This
+option is ignored when the listbox is not in the <B>dropdown</B></I> style.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>listWidth</B></I>
+Class: <B>listWidth</B></I>
+Switch: <B>-listwidth</B></I>
+</code></code></code></pre>
+<UL>
+If set, this option controls the width of the listbox subwidget when
+it is popped up. The option is ignored when the listbox is not in the
+<B>dropdown</B></I> style.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>prunehistory</B></I>
+Class: <B>PruneHistory</B></I>
+Switch: <B>-prunehistory</B></I>
+</code></code></code></pre>
+<UL>
+Specifies whether duplicated previous user inputs should be pruned
+from the the history list. Only Boolean values are allowed.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>selection</B></I>
+Class: <B>Selection</B></I>
+Switch: <B>-selection</B></I>
+</code></code></code></pre>
+<UL>
+Contains the selection in the ComboBox (the string displayed in the
+entry subwidget). Depending on the <B>-selectmode</B></I>, the selection
+of a ComboBox may be different than its <B>-value</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>selection</B></I>
+Class: <B>Selection</B></I>
+Switch: <B>-selection</B></I>
+</code></code></code></pre>
+<UL>
+This option stores the temporary selection. When the user types in a
+text string inside the entry widget, that string is considered as a
+temporary input and is stored inside the <B>-selection</B></I> option. The
+<B>-value</B></I> option is updated only when the user presses the return
+key.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>selectMode</B></I>
+Class: <B>SelectMode</B></I>
+Switch: <B>-selectmode</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the how the combobox responds to the mouse button events in
+the listbox subwidget; can eithet be <B>"browse"</B></I> or
+<B>"immediate"</B></I>. The default <B>-selectmode</B></I> is "browse". See the
+<B>BINDINGS</B></I> section below.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>state</B></I>
+Class: <B>State</B></I>
+Switch: <B>-state</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the whether the ComboBox is normal or disabled.
+Only the values "normal" and "disabled" are recognized.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>tickBitmap</B></I>
+Class: <B>tickBitmap</B></I>
+Switch: <B>-tickbitmap</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the bitmap to be used in the "tick" button to the left of
+the entry widget. The default is a bitmap in the file
+$tix_library/bitmaps/tick
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>validateCmd</B></I>
+Class: <B>ValidateCmd</B></I>
+Switch: <B>-validatecmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a TCL command to be called when the <B>-value</B></I> of the
+ComboBox is about to change. This command is called with one parameter
+-- the new <B>-value</B></I> entered by the user. This command is to
+validate this new value by returning a value it deems valid.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>value</B></I>
+Class: <B>Value</B></I>
+Switch: <B>-value</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the string to be displayed in the entry subwidget of the
+ComboBox. When queried, the returned value is the last value
+selected by the user. When the <B>-value</B></I> option is changed as a
+result of the <B>config -value</B></I> widget command, the TCL command
+specified by the <B>-command</B></I> option is called.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>variable</B></I>
+Class: <B>Variable</B></I>
+Switch: <B>-variable</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the global variable in which the value of the
+ComboBox should be stored. The value of the ComboBox
+will be automatically updated when this variable is changed.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>arrow</B></I>
+Class: <B>Button</B></I>
+</code></code></code></pre>
+<UL>
+The down arrow button.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>cross</B></I>
+Class: <B>Button</B></I>
+</code></code></code></pre>
+<UL>
+The cross button. Available only when <B>-fancy</B></I> is set.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>entry</B></I>
+Class: <B>Entry</B></I>
+</code></code></code></pre>
+<UL>
+The entry that shows the value of this <B>tixControl</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>label</B></I>
+Class: <B>Label</B></I>
+</code></code></code></pre>
+<UL>
+The label subwidget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>listbox</B></I>
+Class: <B>Listbox</B></I>
+</code></code></code></pre>
+<UL>
+The listbox that holds all the list entries.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>slistbox</B></I>
+Class: <B>TixScrolledListBox</B></I>
+</code></code></code></pre>
+<UL>
+The scrolled-listbox that provides the scrollbars.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>tick</B></I>
+Class: <B>Button</B></I>
+</code></code></code></pre>
+<UL>
+The tick button. Available only when <B>-fancy</B></I> is set.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixComboBox</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a <B>tixComboBox</B></I> widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+ComboBox such as its cursor and relief.
+
+The Tix ComboBox widget is similar to the combo box control in
+MS Windows. The user can select a choice by either typing in the entry
+subwdget or selecting from the listbox subwidget.
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixComboBox</B></I> command creates a new Tcl command whose name is the
+may be used to invoke various operations on the widget. It has the
+following general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+determine the exact behavior of the command. The following commands
+are possible for ComboBox widgets:
+<DL>
+<DT> <I>pathName <B>addhistory<I> string </I></B>
+</I></B>
+<DD> Add the string to the beinning of the listbox.
+</DL>
+<DL>
+<DT> <I>pathName <B>appendhistory<I> string </I></B>
+</I></B>
+<DD> Append the string to the end of the listbox.
+</DL>
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixComboBox</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixComboBox</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>flash <I>index string</I></B>
+</I></B>
+<DD> Flashes the ComboBox. <B>flash</B></I> is usually called by a
+<I>-command</I></B> procedure to acknowledge to the user that he has
+selected a value for the ComboBox.
+</DL>
+<DL>
+<DT> <I>pathName <B>insert <I>index string</I></B>
+</I></B>
+<DD> Insert the <I> string</I></B> into the listbox at the specified index.
+<I>index</I></B> must be a valid listbox index.
+</DL>
+<DL>
+<DT> <I>pathName <B>pick <I>index</I></B>
+</I></B>
+<DD> Set the (<I>index</I></B>)th item in the listbox to be the current value of
+the ComboBox. As a result, the <I>value</I></B> of the ComboBox is changed
+and the TCL command sepcified by the <I>-command</I></B> option will be
+called.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no options are given, returns the pathname of the subwidget of
+the specified name.
+
+When options are given, the widget command of the specified subwidget will
+be called with these options.
+</DL>
+<P>
+</pre><H3>BINDINGS</H3>
+<P>
+<UL>
+[1] <BR>
+If the <B>-selectmode</B></I> is "immediate", when the user enters a
+keystroke, clicks on an item or drags the mouse pointer in the
+listbox, the <B>-value</B></I> of the ComboBox will be immediately set to
+this item and the <B>-command</B></I> procedure will be called.
+</UL>
+<UL>
+[2] <BR>
+If the <B>-selectmode</B></I> is "browse", when the user enters a
+keystroke, clicks on an item or drags the mouse pointer in the
+listbox, the <B>-selection</B></I> of the ComboBox will be immediately set
+to the new content of the entry subwidget; also the <B>-browsecmd</B></I>
+procedure will be called. The <B>-value</B></I> option will be changed
+only when the user invokes the ComboBox (see [3] below). If the user
+presses the &lt;Escape&gt; key at any time, any new <B>-selection</B></I> will
+be ignored and the text inside the entry subwidget will be restored to
+the current <B>-value</B></I> of the ComboBox.
+</UL>
+<UL>
+[3] <BR>
+If the <B>-dropdown</B></I> option is true, the user can invoke the
+ComboBox by releasing the left mouse button over the desired item in
+the listbox. If the <B>-dropdown</B></I> option is false, the user can
+invoke the ComboBox by double-clicking over the desired item in the
+listbox. In both cases, the user can also invoke the listbox by
+pressing the &lt;Return&gt; or &lt;Tab&gt; key inside the entry subwidget, or
+switching the input focus to another widget inside the same toplevel
+widget
+</UL>
+<P>
+</pre><H3>BUGS</H3>
+<P>
+Starting from Tix vetsion 4.0, the default <B>-value</B></I> of the
+ComboBox is the empty string. If you want the ComboBox to show a
+string by default, you must configure its <B>-value</B></I> option
+explicitly.
+<P>
+</pre><H3>KEYWORDS</H3>
+Tix(n), ComboBox(n), listbox(n)
+<hr><i>Last modified Sun Jan 19 22:34:20 EST 1997 </i> ---
+<i>Serial 853731296</i>
diff --git a/tix/man/TixComboBox.n b/tix/man/TixComboBox.n
new file mode 100644
index 00000000000..d47243cf746
--- /dev/null
+++ b/tix/man/TixComboBox.n
@@ -0,0 +1,619 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixComboBox tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixComboBox - Create and manipulate tixComboBox widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SYNOPSIS
+\fBtixComboBox\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+The \fBTixComboBox\fR class is derived from the \fBTixLabelWidget\fR
+class and inherits all the commands, options and subwidgets
+of its super-class.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+\fBTixComboBox\fR supports all the standard options of a frame widget.
+See the options(n) manual entry for details on the standard options.
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBanchor\fR
+Class: \fBAnchor\fR
+Switch: \fB\-anchor\fR
+.fi
+.IP
+Specifies how the string inside the entry subwidget should be aligned.
+Only the values "w" or "e" are allowed. When set the "w", the entry is
+aligned to its beginning. When set to "e", it is aligned to its end.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBarrowBitmap\fR
+Class: \fBArrowBitmap\fR
+Switch: \fB\-arrowbitmap\fR
+.fi
+.IP
+Specifies the bitmap to be used in the arrow button beside the entry
+widget. The default is an downward arrow bitmap in the file
+$tix_library/bitmaps/cbxarrow
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBbrowseCmd\fR
+Class: \fBBrowseCmd\fR
+Switch: \fB\-browsecmd\fR
+.fi
+.IP
+Specifies the command to be called when the user browses through the
+listbox. This command can be used to provide instant feedback when the
+user examines items in the listbox before committing a choice.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Switch: \fB\-command\fR
+.fi
+.IP
+Specifies the command to be called when the ComboBox is invoked
+or when the \fB\-value\fR of the ComboBox is changed.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcrossBitmap\fR
+Class: \fBCrossBitmap\fR
+Switch: \fB\-crossbitmap\fR
+.fi
+.IP
+Specifies the bitmap to be used in the "cross" button to the left of
+the entry widget. The default is a bitmap in the file
+$tix_library/bitmaps/cross
+'
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdisableCallback\fR
+Class: \fBDisableCallback\fR
+Switch: \fB\-disablecallback\fR
+.fi
+.IP
+A boolean value indicating whether callbacks should be disabled. When
+set to true, the TCL command specified by the \fB\-command\fR option
+is not executed when the \fB\-value\fR of the ComboBox.
+changes.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdisabledforeground\fR
+Class: \fBDisabledForeground\fR
+Switch: \fB\-disabledforeground\fR
+.fi
+.IP
+Specifies the foreground color to be used when the ComboBox is disabled.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdropdown\fR
+Class: \fBDropdown\fR
+Switch: \fB\-dropdown\fR
+.fi
+.IP
+A Boolean value specifying the style of the ComboBox. When set to
+"true", the listbox is only displayed temporarily when the arrow
+button is pressed. When set to "false", the listbox is always
+displayed.
+'
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBeditable\fR
+Class: \fBEditable\fR
+Switch: \fB\-editable\fR
+.fi
+.IP
+Specifies whether the user is allowed to type into the entry subwidget of
+the ComboBox.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBfancy\fR
+Class: \fBFancy\fR
+Switch: \fB\-fancy\fR
+.fi
+.IP
+A Boolean value specifying whether the cross and tick button
+subwidgets should be shown.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBgrab\fR
+Class: \fBGrab\fR
+Switch: \fB\-grab\fR
+.fi
+.IP
+Specifies the pointer grabbing policy when the listbox is popped up.
+Only values "global", "local" or "none" are allowed. By default global
+grab is used. However, when you are developing your application, you
+may want to use only local grabbing so that in the event of errors,
+your X display won\'t be locked up.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBhistoryLimit\fR
+Class: \fBhistoryLimit\fR
+Switch: \fB\-historylimit\fR
+Alias: \fB\-histlimit\fR
+.fi
+.IP
+Specifies how many previous user inputs can be stored in the history
+list.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBhistory\fR
+Class: \fBHistory\fR
+Switch: \fB\-history\fR
+.fi
+.IP
+A Boolean value specifying whether previous user inputs should be
+stored in the history list.
+'
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabel\fR
+Class: \fBLabel\fR
+Switch: \fB\-label\fR
+.fi
+.IP
+Specifies the string to display as the label of this ComboBox widget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabelSide\fR
+Class: \fBLabelSide\fR
+Switch: \fB\-labelside\fR
+.fi
+.IP
+Specifies where the label should be displayed relative to the entry
+subwidget. Valid options are: \fBtop\fR, \fBleft\fR, \fBright\fR,
+\fBbottom\fR, \fBnone\fR or \fBacrosstop\fR.
+'----------END
+''
+'----------BEGIN
+.LP
+.nf
+Name: \fBlistCmd\fR
+Class: \fBlistCmd\fR
+Switch: \fB\-listcmd\fR
+.fi
+.IP
+Specifies a TCL command to be called every time when the listbox pops
+up. This option allows you to fill up the listbox on-demand. This
+option is ignored when the listbox is not in the \fBdropdown\fR style.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlistWidth\fR
+Class: \fBlistWidth\fR
+Switch: \fB\-listwidth\fR
+.fi
+.IP
+If set, this option controls the width of the listbox subwidget when
+it is popped up. The option is ignored when the listbox is not in the
+\fBdropdown\fR style.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBprunehistory\fR
+Class: \fBPruneHistory\fR
+Switch: \fB\-prunehistory\fR
+.fi
+.IP
+Specifies whether duplicated previous user inputs should be pruned
+from the the history list. Only Boolean values are allowed.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBselection\fR
+Class: \fBSelection\fR
+Switch: \fB\-selection\fR
+.fi
+.IP
+Contains the selection in the ComboBox (the string displayed in the
+entry subwidget). Depending on the \fB\-selectmode\fR, the selection
+of a ComboBox may be different than its \fB\-value\fR.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBselection\fR
+Class: \fBSelection\fR
+Switch: \fB\-selection\fR
+.fi
+.IP
+This option stores the temporary selection. When the user types in a
+text string inside the entry widget, that string is considered as a
+temporary input and is stored inside the \fB\-selection\fR option. The
+\fB\-value\fR option is updated only when the user presses the return
+key.
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBselectMode\fR
+Class: \fBSelectMode\fR
+Switch: \fB\-selectmode\fR
+.fi
+.IP
+Specifies the how the combobox responds to the mouse button events in
+the listbox subwidget; can eithet be \fB"browse"\fR or
+\fB"immediate"\fR. The default \fB\-selectmode\fR is "browse". See the
+\fBBINDINGS\fR section below.
+'----------END
+'----------BEGIN
+.LP
+.nf
+Name: \fBstate\fR
+Class: \fBState\fR
+Switch: \fB\-state\fR
+.fi
+.IP
+Specifies the whether the ComboBox is normal or disabled.
+Only the values "normal" and "disabled" are recognized.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBtickBitmap\fR
+Class: \fBtickBitmap\fR
+Switch: \fB\-tickbitmap\fR
+.fi
+.IP
+Specifies the bitmap to be used in the "tick" button to the left of
+the entry widget. The default is a bitmap in the file
+$tix_library/bitmaps/tick
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvalidateCmd\fR
+Class: \fBValidateCmd\fR
+Switch: \fB\-validatecmd\fR
+.fi
+.IP
+Specifies a TCL command to be called when the \fB\-value\fR of the
+ComboBox is about to change. This command is called with one parameter
+-- the new \fB\-value\fR entered by the user. This command is to
+validate this new value by returning a value it deems valid.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvalue\fR
+Class: \fBValue\fR
+Switch: \fB\-value\fR
+.fi
+.IP
+Specifies the string to be displayed in the entry subwidget of the
+ComboBox. When queried, the returned value is the last value
+selected by the user. When the \fB\-value\fR option is changed as a
+result of the \fBconfig -value\fR widget command, the TCL command
+specified by the \fB\-command\fR option is called.
+'----------END
+'
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvariable\fR
+Class: \fBVariable\fR
+Switch: \fB\-variable\fR
+.fi
+.IP
+Specifies the global variable in which the value of the
+ComboBox should be stored. The value of the ComboBox
+will be automatically updated when this variable is changed.
+'
+'----------END
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBarrow\fR
+Class: \fBButton\fR
+.fi
+.IP
+The down arrow button.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcross\fR
+Class: \fBButton\fR
+.fi
+.IP
+The cross button. Available only when \fB\-fancy\fR is set.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBentry\fR
+Class: \fBEntry\fR
+.fi
+.IP
+The entry that shows the value of this \fBtixControl\fR.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlabel\fR
+Class: \fBLabel\fR
+.fi
+.IP
+The label subwidget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBlistbox\fR
+Class: \fBListbox\fR
+.fi
+.IP
+The listbox that holds all the list entries.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBslistbox\fR
+Class: \fBTixScrolledListBox\fR
+.fi
+.IP
+The scrolled-listbox that provides the scrollbars.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBtick\fR
+Class: \fBButton\fR
+.fi
+.IP
+The tick button. Available only when \fB\-fancy\fR is set.
+'----------END
+'
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixComboBox\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a \fBtixComboBox\fR widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the
+ComboBox such as its cursor and relief.
+
+The Tix ComboBox widget is similar to the combo box control in
+MS Windows. The user can select a choice by either typing in the entry
+subwdget or selecting from the listbox subwidget.
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixComboBox\fR command creates a new Tcl command whose name is the
+same as the path name of the ComboBox's window. This command
+may be used to invoke various operations on the widget. It has the
+following general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+ComboBox widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following commands
+are possible for ComboBox widgets:
+'
+.TP
+\fIpathName \fBaddhistory\fI string \fR
+'
+Add the string to the beinning of the listbox.
+'
+.TP
+\fIpathName \fBappendhistory\fI string \fR
+'
+Append the string to the end of the listbox.
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixComboBox\fR command.
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixComboBox\fR command.
+'
+'
+.TP
+\fIpathName \fBflash \fIindex string\fR
+'
+Flashes the ComboBox. \fBflash\fR is usually called by a
+\fI\-command\fR procedure to acknowledge to the user that he has
+selected a value for the ComboBox.
+'
+'
+.TP
+\fIpathName \fBinsert \fIindex string\fR
+'
+Insert the \fI string\fR into the listbox at the specified index.
+\fIindex\fR must be a valid listbox index.
+'
+'
+.TP
+\fIpathName \fBpick \fIindex\fR
+'
+Set the (\fIindex\fR)th item in the listbox to be the current value of
+the ComboBox. As a result, the \fIvalue\fR of the ComboBox is changed
+and the TCL command sepcified by the \fI\-command\fR option will be
+called.
+'
+'
+.TP
+'
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no options are given, returns the pathname of the subwidget of
+the specified name.
+
+When options are given, the widget command of the specified subwidget will
+be called with these options.
+'
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH BINDINGS
+.PP
+.IP [1]
+If the \fB\-selectmode\fR is "immediate", when the user enters a
+keystroke, clicks on an item or drags the mouse pointer in the
+listbox, the \fB\-value\fR of the ComboBox will be immediately set to
+this item and the \fB\-command\fR procedure will be called.
+'
+'
+.IP [2]
+If the \fB\-selectmode\fR is "browse", when the user enters a
+keystroke, clicks on an item or drags the mouse pointer in the
+listbox, the \fB\-selection\fR of the ComboBox will be immediately set
+to the new content of the entry subwidget; also the \fB\-browsecmd\fR
+procedure will be called. The \fB\-value\fR option will be changed
+only when the user invokes the ComboBox (see [3] below). If the user
+presses the <Escape> key at any time, any new \fB\-selection\fR will
+be ignored and the text inside the entry subwidget will be restored to
+the current \fB\-value\fR of the ComboBox.
+'
+.IP [3]
+If the \fB\-dropdown\fR option is true, the user can invoke the
+ComboBox by releasing the left mouse button over the desired item in
+the listbox. If the \fB\-dropdown\fR option is false, the user can
+invoke the ComboBox by double-clicking over the desired item in the
+listbox. In both cases, the user can also invoke the listbox by
+pressing the <Return> or <Tab> key inside the entry subwidget, or
+switching the input focus to another widget inside the same toplevel
+widget
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH BUGS
+.PP
+Starting from Tix vetsion 4.0, the default \fB\-value\fR of the
+ComboBox is the empty string. If you want the ComboBox to show a
+string by default, you must configure its \fB\-value\fR option
+explicitly.
+'
+'----------------------------------------------------------------------
+.PP
+.SH KEYWORDS
+Tix(n), ComboBox(n), listbox(n)
diff --git a/tix/man/TixIntro.html b/tix/man/TixIntro.html
new file mode 100644
index 00000000000..cd590206c57
--- /dev/null
+++ b/tix/man/TixIntro.html
@@ -0,0 +1,55 @@
+
+
+
+<TITLE>TixIntro - Introduction to the Tix widget set</TITLE>
+<Center><H2>TixIntro - Introduction to the Tix widget set</H2></Center><hr>
+
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+Tix is a set of mega widgets based on the standard Tk widgets. If you
+are planning only to use Tix with the standard Tk widget set, you can
+use the program <B>tixwish(1)</B></I> to interpret your TCL scripts.
+<P>
+To use Tix with other TCL extension packages, you have to call the
+function <B>Tix_Init()</B></I> in your <B>Tcl_AppInit()</B></I> function. Here
+is an example:
+<pre><code><code><code>
+
+int Tcl_AppInit(interp)
+ Tcl_Interp *interp;
+{
+ Tk_Window main;
+
+ main = Tk_MainWindow(interp);
+
+ if (Tcl_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (Tk_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (Tix_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ /*
+ * Call the init procedures for included packages.
+ * Each call should look like this:
+ *
+ * if (Mod_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * where "Mod" is the name of the module.
+ */
+}
+</code></code></code></pre>
+</pre><H3>Files</H3>
+The release notes of this version of Tix is in the HTML file
+<B>Tix4.0/README.html</B></I>. Plain text version of this file can be found
+as <B>Tix4.0/README.txt</B></I>. Latest information about Tix can also be
+located on line at &lt;URL:http://www.xpi.com/tix/&gt;
+</pre><H3>KEYWORDS</H3>
+Tix(n), compound widgets, Tix Intrinsics
+<hr><i>Last modified Sun Jan 19 22:34:39 EST 1997 </i> ---
+<i>Serial 853731306</i>
diff --git a/tix/man/TixIntro.n b/tix/man/TixIntro.n
new file mode 100644
index 00000000000..ea7e55ded8d
--- /dev/null
+++ b/tix/man/TixIntro.n
@@ -0,0 +1,73 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+.HS TixIntro tix 4.0
+.BS
+'
+'
+.SH NAME
+TixIntro \- Introduction to the Tix widget set
+.BE
+'
+'
+.SH DESCRIPTION
+'
+Tix is a set of mega widgets based on the standard Tk widgets. If you
+are planning only to use Tix with the standard Tk widget set, you can
+use the program \fBtixwish(1)\fR to interpret your TCL scripts.
+.PP
+To use Tix with other TCL extension packages, you have to call the
+function \fBTix_Init()\fR in your \fBTcl_AppInit()\fR function. Here
+is an example:
+.nf
+
+int Tcl_AppInit(interp)
+ Tcl_Interp *interp;
+{
+ Tk_Window main;
+
+ main = Tk_MainWindow(interp);
+
+ if (Tcl_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ if (Tk_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+
+ if (Tix_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ /*
+ * Call the init procedures for included packages.
+ * Each call should look like this:
+ *
+ * if (Mod_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * where "Mod" is the name of the module.
+ */
+}
+.fi
+'
+.SH Files
+'
+The release notes of this version of Tix is in the HTML file
+\fBTix4.0/README.html\fR. Plain text version of this file can be found
+as \fBTix4.0/README.txt\fR. Latest information about Tix can also be
+located on line at <URL:http://www.xpi.com/tix/>
+'
+'
+.SH KEYWORDS
+'
+Tix(n), compound widgets, Tix Intrinsics
diff --git a/tix/man/Tree.html b/tix/man/Tree.html
new file mode 100644
index 00000000000..0b98f064495
--- /dev/null
+++ b/tix/man/Tree.html
@@ -0,0 +1,237 @@
+
+
+
+<TITLE>tixTree - Create and manipulate tixTree widgets</TITLE>
+<Center><H2>tixTree - Create and manipulate tixTree widgets</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixTree<I> <I>pathName ?<I>options</I></B>?
+<P>
+</pre><H3>SUPER-CLASS</H3>
+The <B>TixTree</B></I> class is derived from the <B>TixScrolledHList</B></I>
+class and inherits all the commands, options and subwidgets of its
+super-class.
+</pre><H3>STANDARD OPTIONS</H3>
+<B>TixTree</B></I> supports all the standard options of a frame widget.
+See the <B>options(n)</B></I> manual entry for details on the standard options.
+</pre><H3>WIDGET-SPECIFIC OPTIONS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>browseCmd</B></I>
+Class: <B>BrowseCmd</B></I>
+Switch: <B>-browsecmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a command to call whenever the user browses on an entry
+(usually by single-clicking on the entry). The command is called with
+one argument, the pathname of the entry.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>closeCmd</B></I>
+Class: <B>CloseCmd</B></I>
+Switch: <B>-closecmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a command to call whenever an entry needs to be closed (See
+the BINDINGS section below). This command is called with one argument,
+the pathname of the entry. This command should perform appropriate
+actions to close the specified entry. If the <B>-closecmd</B></I> option
+is not specified, the default closing action is to hide all child
+entries of the specified entry.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>command</B></I>
+Class: <B>Command</B></I>
+Switch: <B>-command</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a command to call whenever the user activates an entry
+(usually by double-clicking on the entry). The command
+is called with one argument, the pathname of the entry.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>ignoreInvoke</B></I>
+Class: <B>IgnoreInvoke</B></I>
+Switch: <B>-ignoreinvoke</B></I>
+</code></code></code></pre>
+<UL>
+A Boolean value that specifies when a branch should be opened or
+closed. A branch will always be opened or closed when the user presses
+the (+) and (-) indicators. However, when the user invokes a branch
+(by doublc-clicking or pressing &lt;Return&gt;), the branch will be opened
+or closed only if <B>-ignoreinvoke</B></I> is set to false (the default
+setting).
+
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>openCmd</B></I>
+Class: <B>OpenCmd</B></I>
+Switch: <B>-opencmd</B></I>
+</code></code></code></pre>
+<UL>
+Specifies a command to call whenever an entry needs to be opened (See
+the BINDINGS section below). This command is called with one argument,
+the pathname of the entry. This command should perform appropriate
+actions to open the specified entry. If the <B>-opencmd</B></I> option
+is not specified, the default opening action is to show all the child
+entries of the specified entry.
+</UL>
+</pre><H3>SUBWIDGETS</H3>
+<P>
+<pre><code><code><code>
+Name: <B>hlist</B></I>
+Class: <B>TixHList</B></I>
+</code></code></code></pre>
+<UL>
+The hierarchical listbox that displays the tree.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>hsb</B></I>
+Class: <B>Scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+The horizontal scrollbar subwidget.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>vsb</B></I>
+Class: <B>Scrollbar</B></I>
+</code></code></code></pre>
+<UL>
+The vertical scrollbar subwidget.
+</UL>
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tixTree</B></I> command creates a new window (given by the
+<I>pathName</I></B> argument) and makes it into a Tree widget. Additional
+options, described above, may be specified on the command line or in
+the option database to configure aspects of the Tree widget such as its
+cursor and relief.
+
+The Tree widget can be used to display hierachical data in a tree
+form. The user can adjust the view of the tree by opening or closing
+parts of the tree.
+
+To display a static tree structure, you can add the entries into the
+<B>hlist</B></I> subwidget and hide any entries as desired. Then you can
+call the <B>autosetmode</B></I> method. This will set up the Tree widget so
+that it handles all the <I>open</I></B> and <I>close</I></B> events
+automatically. (Please see the demonstration program
+demos/samples/Tree.tcl).
+
+The above method is not applicable if you want to maintain a dynamic
+tree structure, i.e, you do not know all the entries in the tree and
+you need to add or delete entries subsequently. To do this, you should
+first create the entries in the <B>hlist</B></I> subwidget. Then, use the
+setmode method to indicate the entries that can be opened or closed,
+and use the <B>-opencmd</B></I> and <B> -closecmd</B></I> options to handle
+the opening and closing events. (Please see the demonstration program
+demos/samples/DynTree.tcl demo).
+</pre><H3>WIDGET COMMANDS</H3>
+<P>
+The <B>tixTree</B></I> command creates a new Tcl command whose name is the
+to invoke various operations on the widget. It has the following
+general form:
+<pre>
+<I>pathName option </I></B>?<I>arg arg ...</I></B>?
+<P>
+</pre>
+<I>PathName</I></B> is the name of the command, which is the same as the
+determine the exact behavior of the command. The following commands
+are possible for Tree widgets:
+<DL>
+<DT> <I>pathName <B>autosetmode</B></I>
+</I></B>
+<DD> This command calls the <B>setmode</B></I> method for all the entries in
+this Tree widget: if an entry has no child entries, its mode is set to
+<B>none</B></I>. Otherwise, if the entry has any hidden child entries, its
+mode is set to <B>open</B></I>; otherwise its mode is set to <B>close</B></I>.
+</DL>
+<DL>
+<DT> <I>pathName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>tixTree</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>close <I>entryPath</I></B>
+</I></B>
+<DD> Close the entry given by <I>entryPath</I></B> if its <I>mode</I></B> is <B>close</B></I>.
+</DL>
+<DL>
+<DT> <I>pathName <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the widget. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>pathName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. <I>Option</I></B> may have
+any of the values accepted by the <B>tixTree</B></I> command.
+</DL>
+<DL>
+<DT> <I>pathName <B>getmode <I>entryPath</I></B>
+</I></B>
+<DD> Returns the current <I>mode</I></B> of the entry given by <I>entryPath</I></B>.
+</DL>
+<DL>
+<DT> <I>pathName <B>open <I>entryPath</I></B>
+</I></B>
+<DD> Open the entry givaen by <I>entryPath</I></B> if its <I>mode</I></B> is <B>open</B></I>.
+</DL>
+<DL>
+<DT> <I>pathName <B>setmode <I> entryPath mode</I></B>
+</I></B>
+<DD> This command is used to indicate whether the entry given by
+<I>entryPath</I></B> has children entries and whether the children are
+visible. <I>mode</I></B> must be one of <B>open</B></I>,
+<B>close</B></I> or <B>none</B></I>. If <I>mode</I></B> is set to <B>open</B></I>, a (+)
+indicator is drawn next the the entry. If <I>mode</I></B> is set to
+<B>close</B></I>, a (-) indicator is drawn next the the entry. If
+<I>mode</I></B> is set to <B>none</B></I>, no indicators will be drawn for this
+entry. The default <I>mode</I></B> is none. The <B>open</B></I> mode indicates
+the entry has hidden children and this entry can be opened by the
+user. The <B>close</B></I> mode indicates that all the children of the entry
+are now visible and the entry can be closed by the user.
+</DL>
+<DL>
+<DT> <I>pathName <B>subwidget <I> name ?args?</I></B>
+</I></B>
+<DD> When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+</DL>
+</pre><H3>BINDINGS</H3>
+<P>
+The basic mouse and keyboard bindings of the Tree widget are the same
+as the bindings of the HList widget.
+
+In addition, the entries can be opened or closed under the following
+conditions:
+<UL>
+[1] <BR>
+If the <I>mode</I></B> of the entry is <B>open</B></I>, it can be opened by clicking
+on its (+) indicator or double-clicking on the entry.
+</UL>
+<UL>
+[2] <BR>
+If the <I>mode</I></B> of the entry is <B>close</B></I>, it can be closed by clicking
+on its (-) indicator or double-clicking on the entry.
+</UL>
+</pre><H3>KEYWORDS</H3>
+Tix(n),tixHList(n)
+<hr><i>Last modified Sun Jan 19 22:34:40 EST 1997 </i> ---
+<i>Serial 853731306</i>
diff --git a/tix/man/Tree.n b/tix/man/Tree.n
new file mode 100644
index 00000000000..f05c14d4f38
--- /dev/null
+++ b/tix/man/Tree.n
@@ -0,0 +1,306 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS tixTree tix 4.0
+.BS
+'
+'
+'----------------------------------------------------------------------
+.SH NAME
+tixTree \- Create and manipulate tixTree widgets
+'
+'
+'
+'----------------------------------------------------------------------
+.SH SYNOPSIS
+\fBtixTree\fI \fIpathName ?\fIoptions\fR?
+'
+'
+'----------------------------------------------------------------------
+.PP
+.SH SUPER-CLASS
+The \fBTixTree\fR class is derived from the \fBTixScrolledHList\fR
+class and inherits all the commands, options and subwidgets of its
+super-class.
+'
+'----------------------------------------------------------------------
+.SH "STANDARD OPTIONS"
+'
+\fBTixTree\fR supports all the standard options of a frame widget.
+See the \fBoptions(n)\fR manual entry for details on the standard options.
+'
+'
+'----------------------------------------------------------------------
+.SH "WIDGET-SPECIFIC OPTIONS"
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBbrowseCmd\fR
+Class: \fBBrowseCmd\fR
+Switch: \fB\-browsecmd\fR
+.fi
+.IP
+Specifies a command to call whenever the user browses on an entry
+(usually by single-clicking on the entry). The command is called with
+one argument, the pathname of the entry.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcloseCmd\fR
+Class: \fBCloseCmd\fR
+Switch: \fB\-closecmd\fR
+.fi
+.IP
+Specifies a command to call whenever an entry needs to be closed (See
+the BINDINGS section below). This command is called with one argument,
+the pathname of the entry. This command should perform appropriate
+actions to close the specified entry. If the \fB\-closecmd\fR option
+is not specified, the default closing action is to hide all child
+entries of the specified entry.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBcommand\fR
+Class: \fBCommand\fR
+Switch: \fB\-command\fR
+.fi
+.IP
+Specifies a command to call whenever the user activates an entry
+(usually by double-clicking on the entry). The command
+is called with one argument, the pathname of the entry.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBignoreInvoke\fR
+Class: \fBIgnoreInvoke\fR
+Switch: \fB\-ignoreinvoke\fR
+.fi
+.IP
+A Boolean value that specifies when a branch should be opened or
+closed. A branch will always be opened or closed when the user presses
+the (+) and (-) indicators. However, when the user invokes a branch
+(by doublc-clicking or pressing <Return>), the branch will be opened
+or closed only if \fB\-ignoreinvoke\fR is set to false (the default
+setting).
+'----------END
+'
+
+'----------BEGIN
+.LP
+.nf
+Name: \fBopenCmd\fR
+Class: \fBOpenCmd\fR
+Switch: \fB\-opencmd\fR
+.fi
+.IP
+Specifies a command to call whenever an entry needs to be opened (See
+the BINDINGS section below). This command is called with one argument,
+the pathname of the entry. This command should perform appropriate
+actions to open the specified entry. If the \fB\-opencmd\fR option
+is not specified, the default opening action is to show all the child
+entries of the specified entry.
+'----------END
+'
+'
+'----------------------------------------------------------------------
+.SH SUBWIDGETS
+'----------BEGIN
+.LP
+.nf
+Name: \fBhlist\fR
+Class: \fBTixHList\fR
+.fi
+.IP
+The hierarchical listbox that displays the tree.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBhsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The horizontal scrollbar subwidget.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBvsb\fR
+Class: \fBScrollbar\fR
+.fi
+.IP
+The vertical scrollbar subwidget.
+'----------END
+'
+.BE
+'
+'
+'----------------------------------------------------------------------
+.SH DESCRIPTION
+'
+.PP
+'
+The \fBtixTree\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a Tree widget. Additional
+options, described above, may be specified on the command line or in
+the option database to configure aspects of the Tree widget such as its
+cursor and relief.
+
+The Tree widget can be used to display hierachical data in a tree
+form. The user can adjust the view of the tree by opening or closing
+parts of the tree.
+
+To display a static tree structure, you can add the entries into the
+\fBhlist\fR subwidget and hide any entries as desired. Then you can
+call the \fBautosetmode\fR method. This will set up the Tree widget so
+that it handles all the \fIopen\fR and \fIclose\fR events
+automatically. (Please see the demonstration program
+demos/samples/Tree.tcl).
+
+The above method is not applicable if you want to maintain a dynamic
+tree structure, i.e, you do not know all the entries in the tree and
+you need to add or delete entries subsequently. To do this, you should
+first create the entries in the \fBhlist\fR subwidget. Then, use the
+setmode method to indicate the entries that can be opened or closed,
+and use the \fB\-opencmd\fR and \fB \-closecmd\fR options to handle
+the opening and closing events. (Please see the demonstration program
+demos/samples/DynTree.tcl demo).
+'
+'
+'----------------------------------------------------------------------
+.SH WIDGET COMMANDS
+.PP
+'
+The \fBtixTree\fR command creates a new Tcl command whose name is the
+same as the path name of the Tree's window. This command may be used
+to invoke various operations on the widget. It has the following
+general form:
+'
+.DS C
+'
+\fIpathName option \fR?\fIarg arg ...\fR?
+.PP
+.DE
+'
+\fIPathName\fR is the name of the command, which is the same as the
+Tree widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following commands
+are possible for Tree widgets:
+'
+.TP
+\fIpathName \fBautosetmode\fR
+'
+This command calls the \fBsetmode\fR method for all the entries in
+this Tree widget: if an entry has no child entries, its mode is set to
+\fBnone\fR. Otherwise, if the entry has any hidden child entries, its
+mode is set to \fBopen\fR; otherwise its mode is set to \fBclose\fR.
+'
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBtixTree\fR command.
+'
+'
+.TP
+\fIpathName \fBclose \fIentryPath\fR
+'
+Close the entry given by \fIentryPath\fR if its \fImode\fR is \fBclose\fR.
+'
+'
+.TP
+'
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the widget. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string. \fIOption\fR may have
+any of the values accepted by the \fBtixTree\fR command.
+'
+'
+.TP
+\fIpathName \fBgetmode \fIentryPath\fR
+'
+Returns the current \fImode\fR of the entry given by \fIentryPath\fR.
+'
+.TP
+\fIpathName \fBopen \fIentryPath\fR
+'
+Open the entry givaen by \fIentryPath\fR if its \fImode\fR is \fBopen\fR.
+'
+.TP
+\fIpathName \fBsetmode \fI entryPath mode\fR
+'
+This command is used to indicate whether the entry given by
+\fIentryPath\fR has children entries and whether the children are
+visible. \fImode\fR must be one of \fBopen\fR,
+\fBclose\fR or \fBnone\fR. If \fImode\fR is set to \fBopen\fR, a (+)
+indicator is drawn next the the entry. If \fImode\fR is set to
+\fBclose\fR, a (-) indicator is drawn next the the entry. If
+\fImode\fR is set to \fBnone\fR, no indicators will be drawn for this
+entry. The default \fImode\fR is none. The \fBopen\fR mode indicates
+the entry has hidden children and this entry can be opened by the
+user. The \fBclose\fR mode indicates that all the children of the entry
+are now visible and the entry can be closed by the user.
+'
+.TP
+\fIpathName \fBsubwidget \fI name ?args?\fR
+'
+When no options are given, this command returns the pathname of the
+subwidget of the specified name.
+
+When options are given, the widget command of the specified subwidget
+will be called with these options.
+'
+'
+'
+'----------------------------------------------------------------------
+.SH BINDINGS
+.PP
+'
+The basic mouse and keyboard bindings of the Tree widget are the same
+as the bindings of the HList widget.
+
+In addition, the entries can be opened or closed under the following
+conditions:
+'
+.IP [1]
+If the \fImode\fR of the entry is \fBopen\fR, it can be opened by clicking
+on its (+) indicator or double-clicking on the entry.
+'
+.IP [2]
+If the \fImode\fR of the entry is \fBclose\fR, it can be closed by clicking
+on its (-) indicator or double-clicking on the entry.
+'
+'
+'----------------------------------------------------------------------
+.SH KEYWORDS
+Tix(n),tixHList(n)
diff --git a/tix/man/Utils.html b/tix/man/Utils.html
new file mode 100644
index 00000000000..5309f9d32ee
--- /dev/null
+++ b/tix/man/Utils.html
@@ -0,0 +1,70 @@
+
+
+
+<TITLE>Utils - Utility commands in Tix 4.0.</TITLE>
+<Center><H2>Utils - Utility commands in Tix 4.0.</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<DL>
+<DT> <B>tixDescendants<I> <I>pathName</I></B>
+</DL>
+<DL>
+<DT> <B>tixDisableAll <I>pathName</I></B>
+</DL>
+<DL>
+<DT> <B>tixEnableAll <I>pathName</I></B>
+</DL>
+<DL>
+<DT> <B>tixPushGrab</B></I> ?<I>-global</I></B>? <I>window</I></B>
+</DL>
+<DL>
+<DT> <B>tixPopGrab</B></I>
+</DL>
+</pre><HR>
+<P>
+</pre><H3>DESCRIPTION</H3>
+<P>
+<DL>
+<DT> <B>tixDescendants</B></I> <I>pathName</I></B>
+</I></B>
+<DD> Returns a list of all the descendant widgets of <I>pathName</I></B> plus
+<I>pathName</I></B> itself.
+</DL>
+<DL>
+<DT> <B>tixDisableAll</B></I> <I>pathName</I></B>
+</I></B>
+<DD> Disables <I>pathName</I></B> and all its descendants.
+</DL>
+<DL>
+<DT> <B>tixEnableAll</B></I> <I>pathName</I></B>
+</I></B>
+<DD> Enables <I>pathName</I></B> and all its descendants.
+</DL>
+<DL>
+<DT> <B>tixPushGrab</B></I> ?<I>-global</I></B>? <I>window</I></B>
+</I></B>
+<DD> The <B>tixPushGrab</B></I> and <B>tixPopGrab</B></I> commands allows you to
+perform "cascade-grabbing". <B>tixPushGrab</B></I> calls the <B>grab(n)</B></I>
+command on <I>window</I></B> and saves <I>window</I></B> on a grabbing
+stack.
+</DL>
+<DL>
+<DT> <B>tixPopGrab</B></I>
+</I></B>
+<DD> <B>tixPopGrab</B></I> pops the top-most element from the grabbing stack and
+release its grab. If the grabbing stack is not empty, then
+<B>tixPopGrab</B></I> will execute grab(n) on the current top-most element
+in the grabbing stack.
+</DL>
+</pre><H3>NOTES</H3>
+<P>
+Some Tix widgets (for example, tixComboBox and tixPanedWindow) grabs
+the screen on certain occasions using <B>tixPushGrab</B></I> and
+<B>tixPopGrab</B></I>. Therefore, if you need to grab the screen when these
+widgets are present, you should also call <B>tixPushGrab</B></I> and
+<B>tixPopGrab</B></I> in place of the Tk <B>grab</B></I> and <B>grab release</B></I>
+commands. Otherwise, the behavior of these widgets may be undefined.
+</pre><H3>KEYWORDS</H3>
+Tix(n),grab(n)
+<hr><i>Last modified Sun Jan 19 22:34:40 EST 1997 </i> ---
+<i>Serial 853731306</i>
diff --git a/tix/man/Utils.n b/tix/man/Utils.n
new file mode 100644
index 00000000000..0bffedcc74d
--- /dev/null
+++ b/tix/man/Utils.n
@@ -0,0 +1,82 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS Utils tix 4.0
+.BS
+'
+'
+.SH NAME
+Utils - Utility commands in Tix 4.0.
+'
+'
+'
+.SH SYNOPSIS
+.TP
+\fBtixDescendants\fI \fIpathName\fR
+.TP
+\fBtixDisableAll \fIpathName\fR
+.TP
+\fBtixEnableAll \fIpathName\fR
+.TP
+\fBtixPushGrab\fR ?\fI-global\fR? \fIwindow\fR
+.TP
+\fBtixPopGrab\fR
+.BE
+.PP
+.SH DESCRIPTION
+.PP
+.TP
+\fBtixDescendants\fR \fIpathName\fR
+'
+Returns a list of all the descendant widgets of \fIpathName\fR plus
+\fIpathName\fR itself.
+'
+.TP
+\fBtixDisableAll\fR \fIpathName\fR
+'
+Disables \fIpathName\fR and all its descendants.
+'
+'
+.TP
+\fBtixEnableAll\fR \fIpathName\fR
+'
+Enables \fIpathName\fR and all its descendants.
+'
+'
+.TP
+\fBtixPushGrab\fR ?\fI-global\fR? \fIwindow\fR
+'
+The \fBtixPushGrab\fR and \fBtixPopGrab\fR commands allows you to
+perform "cascade-grabbing". \fBtixPushGrab\fR calls the \fBgrab(n)\fR
+command on \fIwindow\fR and saves \fIwindow\fR on a grabbing
+stack.
+'
+.TP
+\fBtixPopGrab\fR
+'
+\fBtixPopGrab\fR pops the top-most element from the grabbing stack and
+release its grab. If the grabbing stack is not empty, then
+\fBtixPopGrab\fR will execute grab(n) on the current top-most element
+in the grabbing stack.
+'
+.SH NOTES
+.PP
+Some Tix widgets (for example, tixComboBox and tixPanedWindow) grabs
+the screen on certain occasions using \fBtixPushGrab\fR and
+\fBtixPopGrab\fR. Therefore, if you need to grab the screen when these
+widgets are present, you should also call \fBtixPushGrab\fR and
+\fBtixPopGrab\fR in place of the Tk \fBgrab\fR and \fBgrab release\fR
+commands. Otherwise, the behavior of these widgets may be undefined.
+'
+.SH KEYWORDS
+Tix(n),grab(n)
diff --git a/tix/man/Wm.html b/tix/man/Wm.html
new file mode 100644
index 00000000000..65d23b05acc
--- /dev/null
+++ b/tix/man/Wm.html
@@ -0,0 +1,45 @@
+
+
+
+<TITLE>Wm - Tix's addition to the standard TK <B>wm</B></I> command.</TITLE>
+<Center><H2>Wm - Tix's addition to the standard TK <B>wm</B></I> command.</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<P>
+<B>wm<I> capture <I>pathName </I></B>
+<P>
+<B>wm<I> release <I>pathName </I></B>
+<P>
+</pre><H3>DESCRIPTION</H3>
+<P>
+
+The <B>wm capture</B></I> and the <B>wm release</B></I> commands change the
+toplevel attribute of Tk widgets.
+</pre><H3>COMMAND OPTIONS</H3>
+<P>
+<DL>
+<DT> <B>wm capture <I>pathName</I></B>
+</I></B>
+<DD> Converts the toplevel window specified by <I>pathName</I></B> into a non-toplevel
+widget. Normally this command is called to convert a <B>toplevel</B></I> widget
+into a <B>frame</B></I> widget. The newly-converted frame widget is
+un-mapped from the screen. To make it appear inside its parent, you
+must call a geometry manager (e.g. pack) explictly.
+</DL>
+<DL>
+<DT> <B>wm release <I>pathName</I></B>
+</I></B>
+<DD> Makes the non-toplevel window specified by <I>pathName</I></B> into a toplevel
+widget. Normally this command is called to convert a <B>frame</B></I> widget
+into a <B>toplevel</B></I> widget, but it can also be used on any
+non-toplevel widget (e.g, button). The newly-converted toplevel window
+is automatically mapped to the screen. To prevent it from appearing in
+the screen, you must call <B>wm withdraw</B></I> immediately after calling
+<B>wm release</B></I>.
+</DL>
+<P>
+</pre><H3>KEYWORDS</H3>
+Tix(n)
+<!Serial 851729151>
+<hr><i>Last modified Fri Jan 17 23:02:21 EST 1997 </i> ---
+<i>Serial 853731307</i>
diff --git a/tix/man/Wm.n b/tix/man/Wm.n
new file mode 100644
index 00000000000..1cfc9cbcad1
--- /dev/null
+++ b/tix/man/Wm.n
@@ -0,0 +1,59 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+'----------------------------------------------------------------------
+.HS wm tix 4.0
+.BS
+'
+'
+.SH NAME
+Wm - Tix's addition to the standard TK \fBwm\fR command.
+'
+'
+'
+.SH SYNOPSIS
+.PP
+\fBwm\fI capture \fIpathName \fR
+.PP
+\fBwm\fI release \fIpathName \fR
+.PP
+.SH DESCRIPTION
+.PP
+
+The \fBwm capture\fR and the \fBwm release\fR commands change the
+toplevel attribute of Tk widgets.
+.SH COMMAND OPTIONS
+.PP
+.TP
+\fBwm capture \fIpathName\fR
+'
+Converts the toplevel window specified by \fIpathName\fR into a non-toplevel
+widget. Normally this command is called to convert a \fBtoplevel\fR widget
+into a \fBframe\fR widget. The newly-converted frame widget is
+un-mapped from the screen. To make it appear inside its parent, you
+must call a geometry manager (e.g. pack) explictly.
+'
+.TP
+\fBwm release \fIpathName\fR
+'
+Makes the non-toplevel window specified by \fIpathName\fR into a toplevel
+widget. Normally this command is called to convert a \fBframe\fR widget
+into a \fBtoplevel\fR widget, but it can also be used on any
+non-toplevel widget (e.g, button). The newly-converted toplevel window
+is automatically mapped to the screen. To prevent it from appearing in
+the screen, you must call \fBwm withdraw\fR immediately after calling
+\fBwm release\fR.
+'
+'
+.PP
+.SH KEYWORDS
+Tix(n)
diff --git a/tix/man/compound.html b/tix/man/compound.html
new file mode 100644
index 00000000000..7fa637f1210
--- /dev/null
+++ b/tix/man/compound.html
@@ -0,0 +1,314 @@
+
+
+
+<TITLE>Compound - Create multi-line compound images.</TITLE>
+<Center><H2>Compound - Create multi-line compound images.</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>image create compound </B></I>?<I>name</I></B>? ?<I>options</I></B>?
+</pre><HR>
+</pre><H3>DESCRIPTION</H3>
+<P>
+Compound image types can be used to create images that consists of
+multiple horizontal lines; each line is composed of a series of items
+(texts, bitmaps, images or spaces) arranged from left to
+right. Compound images are mainly used to embed complex drawings into
+widgets that support the <B>-image</B></I> option. As shown in the EXAMPLE
+section below, a compound image can be used to display a bitmap and a
+text string simutaneously in a TK <B>button(n)</B></I> widget.
+</pre><H3>CREATING COMPOUND IMAGES</H3>
+<P>
+Like all images, compound images are created using the <B>image create</B></I>
+command. Compound images support the following <I>options</I></B>:
+<DL>
+<DT> <B>-background <I>color</I></B>
+</I></B>
+<DD> Specifies the background color of the compound image. This color is
+also used as the default background color for the bitmap items in the
+compound image.
+</DL>
+<DL>
+<DT> <B>-borderwidth <I>pixels</I></B>
+</I></B>
+<DD> Specifies a non-negative value indicating the width of the 3-D border
+drawn around the compound image.
+</DL>
+<DL>
+<DT> <B>-font <I>font</I></B>
+</I></B>
+<DD> Specifies the default font for the text items in the compound image.
+</DL>
+<DL>
+<DT> <B>-foreground <I>color</I></B>
+</I></B>
+<DD> Specifies the default foreground color for the bitmap and text items
+in the compound image.
+</DL>
+<DL>
+<DT> <B>-padx <I>value</I></B>
+</I></B>
+<DD> Specifies a non-negative value indicating how much extra space to
+request for the compound image in the X-direction. The <I>value</I></B> may
+have any of the forms acceptable to <B>Tk_GetPixels(3)</B></I>.
+</DL>
+<DL>
+<DT> <B>-pady <I>value</I></B>
+</I></B>
+<DD> Specifies a non-negative value indicating how much extra space to
+request for the compound image in the Y-direction.
+</DL>
+<DL>
+<DT> <B>-relief <I>value</I></B>
+</I></B>
+<DD> Specifies the 3-D effect desired for the background of the compound
+image. Acceptable values are <B>raised</B></I>, <B>sunken</B></I>, <B>flat</B></I>,
+<B>ridge</B></I>, and <B>groove</B></I>.
+</DL>
+<DL>
+<DT> <B>-showbackground <I>value</I></B>
+</I></B>
+<DD> Specifies whether the background and the 3D borders should be drawn.
+Must be a valid boolean value. By default the background is not drawn
+and the compound image appears to have a transparent background.
+</DL>
+<DL>
+<DT> <B>-window <I>pathName</I></B>
+</I></B>
+<DD> Specifies the window in which the compound image is displayed. One
+compound image can be displayed in only one window. When that window
+is destroyed, the compound image is automatically destroyed as well.
+This option must be specified when calling the <B>image create
+compound</B></I> command and cannot be changed by the <B>configure</B></I> image
+command.
+</DL>
+</pre><H3>IMAGE COMMAND</H3>
+<P>
+When a compound image is created, Tk also creates a new command whose
+name is the same as the image. This command may be used to invoke
+various operations on the image. It has the following general form:
+<pre>
+<I>imageName option </I></B>?<I>arg arg ...</I></B>?
+</pre>
+<I>Option</I></B> and the <I>arg</I></B>s
+determine the exact behavior of the command. The following
+commands are possible for compound images:
+<DL>
+<DT> <I>imageName <B>add line</B></I> ?<I>option value ...</I></B>?
+</I></B>
+<DD> Creates a new line at the bottom of the compound image. Lines support
+the following <I>options</I></B>:
+</DL>
+<UL>
+<DL>
+<DT> <B>-anchor</B></I> value
+</I></B>
+<DD> Specifies how the line should be aligned along the horizontal axis.
+When the values are <B>w</B></I>, <B>sw</B></I> or <B>nw</B></I>, the line is aligned
+to the left. When the values are <B>c</B></I>, <B>s</B></I> or <B>n</B></I>, the line
+is aligned to the middle. When the values are <B>e</B></I>, <B>se</B></I> or
+<B>ne</B></I>, the line is aligned to the right.
+</DL>
+<DL>
+<DT> <B>-padx <I>value</I></B>
+</I></B>
+<DD> Specifies a non-negative value indicating how much extra space to
+request for this line in the X-direction.
+</DL>
+</UL>
+<DL>
+<DT> <I>imageName <B>add <I>item-type</I></B> ?<I>option value ...</I></B>?
+</I></B>
+<DD> Creates a new item of the type <I>item-type</I></B> at the end of the last
+line of the compound image. All types of items support
+these following common <I>options</I></B>:
+</DL>
+<UL>
+<DL>
+<DT> <B>-anchor</B></I> value
+</I></B>
+<DD> Specifies how the item should be aligned along the vertical axis. When
+the values are <B>n</B></I>, <B>nw</B></I> or <B>ne</B></I>, the item is aligned to
+the top of the line. When the values are <B>c</B></I>, <B>w</B></I> or <B>e</B></I>,
+the item is aligned to the middle of the line. When the values are
+<B>s</B></I>, <B>se</B></I> or <B>sw</B></I>, the item is aligned to the bottom of
+the line.
+</DL>
+<DL>
+<DT> <B>-padx <I>value</I></B>
+</I></B>
+<DD> Specifies a non-negative value indicating how much extra space to
+request for this item in the X-direction.
+</DL>
+<DL>
+<DT> <B>-pady <I>value</I></B>
+</I></B>
+<DD> Specifies a non-negative value indicating how much extra space to
+request for this item in the Y-direction.
+</DL>
+<DL>
+<DT> <I>item-type</I></B> can be any of the following:
+</DL>
+</UL>
+<DL>
+<DT> <I>imageName <B>add bitmap</B></I> ?<I>option value ...</I></B>?
+</I></B>
+<DD> Creates a new bitmap item of at the end of the last
+line of the compound image. Additional <I>options</I></B> accepted by the
+bitmap type are:
+</DL>
+<UL>
+<DL>
+<DT> <B>-background <I>color</I></B>
+</I></B>
+<DD> Specifies the background color of the bitmap item.
+</DL>
+<DL>
+<DT> <B>-bitmap <I>name</I></B>
+</I></B>
+<DD> Specifies a bitmap to display in this item, in any of the forms
+acceptable to <B>Tk_GetBitmap(3)</B></I>.
+</DL>
+<DL>
+<DT> <B>-foreground <I>color</I></B>
+</I></B>
+<DD> Specifies the foreground color of the bitmap item.
+</DL>
+</UL>
+<DL>
+<DT> <I>imageName <B>add image</B></I> ?<I>option value ...</I></B>?
+</I></B>
+<DD> Creates a new image item of at the end of the last
+line of the compound image. Additional <I>options</I></B> accepted by the
+image type are:
+</DL>
+<UL>
+<DL>
+</DL>
+<DL>
+<DT> <B>-image <I>name</I></B>
+</I></B>
+<DD> Specifies an image to display in this item. <I>name</I></B>
+must have been created with the <B>image create</B></I> command.
+</DL>
+</UL>
+<DL>
+<DT> <I>imageName <B>add space</B></I> ?<I>option value ...</I></B>?
+</I></B>
+<DD> Creates a new space item of at the end of the last line of the
+compound image. Space items do not display anything. They just acts as
+space holders that add additional spaces between items inside a
+compound image. Additional <I>options</I></B> accepted by the image type
+are:
+</DL>
+<UL>
+<DL>
+</DL>
+<DL>
+<DT> <B>-width <I>value</I></B>
+</I></B>
+<DD> Specifies the width of this space. The <I>value</I></B> may have any of the
+forms acceptable to <B>Tk_GetPixels(3)</B></I>.
+</DL>
+<DL>
+<DT> <B>-height <I>value</I></B>
+</I></B>
+<DD> Specifies the height of this space. The <I>value</I></B> may have any of
+the forms acceptable to <B>Tk_GetPixels(3)</B></I>.
+</DL>
+</UL>
+<DL>
+<DT> <I>imageName <B>add text</B></I> ?<I>option value ...</I></B>?
+</I></B>
+<DD> Creates a new text item of at the end of the last line of the compound
+image. Additional <I>options</I></B> accepted by the text type are:
+</DL>
+<UL>
+<DL>
+<DT> <B>-background <I>color</I></B>
+</I></B>
+<DD> Specifies the background color of the text item.
+</DL>
+<DL>
+<DT> <B>-font <I>name</I></B>
+</I></B>
+<DD> Specifies the font to be used for this text item.
+</DL>
+<DL>
+<DT> <B>-foreground <I>color</I></B>
+</I></B>
+<DD> Specifies the foreground color of the text item.
+</DL>
+<DL>
+<DT> <B>-justify</B></I> <I>value</I></B>
+</I></B>
+<DD> When there are multiple lines of text displayed in a text item, this
+option determines how the lines line up with each other. <I>value</I></B>
+must be one of <B>left</B></I>, <B>center</B></I>, or <B>right</B></I>. <B>Left</B></I>
+right edges line up.
+</DL>
+<DL>
+<DT> <B>-text <I>string</I></B>
+</I></B>
+<DD> Specifies a text string to display in this text item.
+</DL>
+<DL>
+<DT> <B>-underline</B></I> <I>value</I></B>
+</I></B>
+<DD> Specifies the integer index of a character to underline in the text
+item. 0 corresponds to the first character of the text displayed in
+the text item, 1 to the next character, and so on.
+</DL>
+<DL>
+<DT> <B>-wraplength</B></I> <I>value</I></B>
+</I></B>
+<DD> This option specifies the maximum line length of the label string on
+this text item. If the line length of the label string exceeds this
+length, it is wrapped onto the next line, so that no line is longer
+than the specified length. The value may be specified in any of the
+standard forms for screen distances. If this value is less than or
+equal to 0 then no wrapping is done: lines will break only at newline
+characters in the text.
+</DL>
+</UL>
+<DL>
+<DT> <I>imageName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>image create compound</B></I> command.
+</DL>
+<DL>
+<DT> <I>imageName <B>configure</B></I> ?<I>option</I></B>? ?<I>value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options for the image. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>imageName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given option(s) to have the given value(s); in this case
+the command returns an empty string. <I>Option</I></B> may have any of the
+values accepted by the <B>image create compound</B></I> command, except the
+<B>-window</B></I> option
+</DL>
+</pre><H3>EXAMPLE</H3>
+The following example creates a compound image with a bitmap and a
+text string and places this image into a Tk <B>bitton(n)</B></I>
+widget. Notice that the image must be created after the creation of
+the window that it resides in.
+<pre><code><code><code>
+ button .b
+ set img [image create compound -window .b]
+ $img add line
+ $img add bitmap -bitmap warning
+ $img add space -width 8
+ $img add text -text "Warning" -underline 0
+ .b config -image $img
+ pack .b
+</code></code></code></pre>
+</pre><H3>KEYWORDS</H3>
+image(n), Tix(n)
+<hr><i>Last modified Sun Jan 19 22:34:41 EST 1997 </i> ---
+<i>Serial 853731307</i>
diff --git a/tix/man/compound.n b/tix/man/compound.n
new file mode 100644
index 00000000000..da0543efac8
--- /dev/null
+++ b/tix/man/compound.n
@@ -0,0 +1,339 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+.HS compound tix 4.0
+.BS
+.SH NAME
+Compound \- Create multi-line compound images.
+.SH SYNOPSIS
+\fBimage create compound \fR?\fIname\fR? ?\fIoptions\fR?
+.BE
+'
+.SH DESCRIPTION
+.PP
+'
+Compound image types can be used to create images that consists of
+multiple horizontal lines; each line is composed of a series of items
+(texts, bitmaps, images or spaces) arranged from left to
+right. Compound images are mainly used to embed complex drawings into
+widgets that support the \fB\-image\fR option. As shown in the EXAMPLE
+section below, a compound image can be used to display a bitmap and a
+text string simutaneously in a TK \fBbutton(n)\fR widget.
+'
+.SH "CREATING COMPOUND IMAGES"
+.PP
+Like all images, compound images are created using the \fBimage create\fR
+command. Compound images support the following \fIoptions\fR:
+.TP
+\fB\-background \fIcolor\fR
+'
+Specifies the background color of the compound image. This color is
+also used as the default background color for the bitmap items in the
+compound image.
+'
+.TP
+\fB\-borderwidth \fIpixels\fR
+'
+Specifies a non-negative value indicating the width of the 3-D border
+drawn around the compound image.
+'
+.TP
+\fB\-font \fIfont\fR
+'
+Specifies the default font for the text items in the compound image.
+'
+.TP
+\fB\-foreground \fIcolor\fR
+'
+Specifies the default foreground color for the bitmap and text items
+in the compound image.
+'
+.TP
+\fB\-padx \fIvalue\fR
+'
+Specifies a non-negative value indicating how much extra space to
+request for the compound image in the X-direction. The \fIvalue\fR may
+have any of the forms acceptable to \fBTk_GetPixels(3)\fR.
+'
+.TP
+\fB\-pady \fIvalue\fR
+'
+Specifies a non-negative value indicating how much extra space to
+request for the compound image in the Y-direction.
+.TP
+\fB\-relief \fIvalue\fR
+'
+Specifies the 3-D effect desired for the background of the compound
+image. Acceptable values are \fBraised\fR, \fBsunken\fR, \fBflat\fR,
+\fBridge\fR, and \fBgroove\fR.
+'
+.TP
+\fB\-showbackground \fIvalue\fR
+'
+Specifies whether the background and the 3D borders should be drawn.
+Must be a valid boolean value. By default the background is not drawn
+and the compound image appears to have a transparent background.
+'
+.TP
+\fB\-window \fIpathName\fR
+'
+Specifies the window in which the compound image is displayed. One
+compound image can be displayed in only one window. When that window
+is destroyed, the compound image is automatically destroyed as well.
+This option must be specified when calling the \fBimage create
+compound\fR command and cannot be changed by the \fBconfigure\fR image
+command.
+'
+.SH "IMAGE COMMAND"
+.PP
+When a compound image is created, Tk also creates a new command whose
+name is the same as the image. This command may be used to invoke
+various operations on the image. It has the following general form:
+.DS C
+\fIimageName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+'
+determine the exact behavior of the command. The following
+commands are possible for compound images:
+'
+'
+.TP
+\fIimageName \fBadd line\fR ?\fIoption value ...\fR?
+'
+Creates a new line at the bottom of the compound image. Lines support
+the following \fIoptions\fR:
+.RS
+.TP
+\fB\-anchor\fR value
+'
+Specifies how the line should be aligned along the horizontal axis.
+When the values are \fBw\fR, \fBsw\fR or \fBnw\fR, the line is aligned
+to the left. When the values are \fBc\fR, \fBs\fR or \fBn\fR, the line
+is aligned to the middle. When the values are \fBe\fR, \fBse\fR or
+\fBne\fR, the line is aligned to the right.
+'
+.TP
+\fB\-padx \fIvalue\fR
+'
+Specifies a non-negative value indicating how much extra space to
+request for this line in the X-direction.
+.RE
+'
+.TP
+\fIimageName \fBadd \fIitem-type\fR ?\fIoption value ...\fR?
+'
+Creates a new item of the type \fIitem-type\fR at the end of the last
+line of the compound image. All types of items support
+these following common \fIoptions\fR:
+.RS
+.TP
+\fB-anchor\fR value
+'
+Specifies how the item should be aligned along the vertical axis. When
+the values are \fBn\fR, \fBnw\fR or \fBne\fR, the item is aligned to
+the top of the line. When the values are \fBc\fR, \fBw\fR or \fBe\fR,
+the item is aligned to the middle of the line. When the values are
+\fBs\fR, \fBse\fR or \fBsw\fR, the item is aligned to the bottom of
+the line.
+'
+.TP
+\fB\-padx \fIvalue\fR
+'
+Specifies a non-negative value indicating how much extra space to
+request for this item in the X-direction.
+'
+.TP
+\fB\-pady \fIvalue\fR
+'
+Specifies a non-negative value indicating how much extra space to
+request for this item in the Y-direction.
+'
+.TP
+\fIitem-type\fR can be any of the following:
+.RE
+'
+'----------------------------------------
+.TP
+\fIimageName \fBadd bitmap\fR ?\fIoption value ...\fR?
+'
+Creates a new bitmap item of at the end of the last
+line of the compound image. Additional \fIoptions\fR accepted by the
+bitmap type are:
+'
+.RS
+.TP
+\fB\-background \fIcolor\fR
+'
+Specifies the background color of the bitmap item.
+'
+'
+.TP
+\fB\-bitmap \fIname\fR
+'
+Specifies a bitmap to display in this item, in any of the forms
+acceptable to \fBTk_GetBitmap(3)\fR.
+'
+.TP
+\fB\-foreground \fIcolor\fR
+'
+Specifies the foreground color of the bitmap item.
+'
+.RE
+'----------------------------------------
+.TP
+\fIimageName \fBadd image\fR ?\fIoption value ...\fR?
+'
+Creates a new image item of at the end of the last
+line of the compound image. Additional \fIoptions\fR accepted by the
+image type are:
+'
+.RS
+.TP
+'
+.TP
+\fB\-image \fIname\fR
+'
+Specifies an image to display in this item. \fIname\fR
+must have been created with the \fBimage create\fR command.
+'
+.RE
+'----------------------------------------
+.TP
+\fIimageName \fBadd space\fR ?\fIoption value ...\fR?
+'
+Creates a new space item of at the end of the last line of the
+compound image. Space items do not display anything. They just acts as
+space holders that add additional spaces between items inside a
+compound image. Additional \fIoptions\fR accepted by the image type
+are:
+'
+.RS
+.TP
+'
+.TP
+\fB\-width \fIvalue\fR
+'
+Specifies the width of this space. The \fIvalue\fR may have any of the
+forms acceptable to \fBTk_GetPixels(3)\fR.
+'
+.TP
+\fB\-height \fIvalue\fR
+'
+Specifies the height of this space. The \fIvalue\fR may have any of
+the forms acceptable to \fBTk_GetPixels(3)\fR.
+'
+.RE
+'----------------------------------------
+.TP
+\fIimageName \fBadd text\fR ?\fIoption value ...\fR?
+'
+Creates a new text item of at the end of the last line of the compound
+image. Additional \fIoptions\fR accepted by the text type are:
+'
+.RS
+.TP
+\fB\-background \fIcolor\fR
+'
+Specifies the background color of the text item.
+'
+.TP
+\fB\-font \fIname\fR
+'
+Specifies the font to be used for this text item.
+'
+.TP
+\fB\-foreground \fIcolor\fR
+'
+Specifies the foreground color of the text item.
+'
+.TP
+\fB\-justify\fR \fIvalue\fR
+'
+When there are multiple lines of text displayed in a text item, this
+option determines how the lines line up with each other. \fIvalue\fR
+must be one of \fBleft\fR, \fBcenter\fR, or \fBright\fR. \fBLeft\fR
+means that the lines' left edges all line up, \fBcenter\fR means that
+the lines' centers are aligned, and \fBright\fR means that the lines'
+right edges line up.
+'
+.TP
+\fB\-text \fIstring\fR
+'
+Specifies a text string to display in this text item.
+'
+.TP
+\fB\-underline\fR \fIvalue\fR
+'
+Specifies the integer index of a character to underline in the text
+item. 0 corresponds to the first character of the text displayed in
+the text item, 1 to the next character, and so on.
+'
+.TP
+\fB\-wraplength\fR \fIvalue\fR
+'
+This option specifies the maximum line length of the label string on
+this text item. If the line length of the label string exceeds this
+length, it is wrapped onto the next line, so that no line is longer
+than the specified length. The value may be specified in any of the
+standard forms for screen distances. If this value is less than or
+equal to 0 then no wrapping is done: lines will break only at newline
+characters in the text.
+'
+.RE
+'----------------------------------------
+'
+.TP
+\fIimageName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBimage create compound\fR command.
+'
+.TP
+\fIimageName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+'
+Query or modify the configuration options for the image. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIimageName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given option(s) to have the given value(s); in this case
+the command returns an empty string. \fIOption\fR may have any of the
+values accepted by the \fBimage create compound\fR command, except the
+\fB\-window\fR option
+'.
+'----------------------------------------
+'
+.SH EXAMPLE
+'
+The following example creates a compound image with a bitmap and a
+text string and places this image into a Tk \fBbitton(n)\fR
+widget. Notice that the image must be created after the creation of
+the window that it resides in.
+'
+.nf
+ button .b
+ set img [image create compound -window .b]
+ $img add line
+ $img add bitmap -bitmap warning
+ $img add space -width 8
+ $img add text -text "Warning" -underline 0
+ .b config -image $img
+ pack .b
+.fi
+'
+.SH KEYWORDS
+image(n), Tix(n)
diff --git a/tix/man/index.html b/tix/man/index.html
new file mode 100644
index 00000000000..3e8422e2158
--- /dev/null
+++ b/tix/man/index.html
@@ -0,0 +1,67 @@
+<H1>Tix Reference Manual Pages</h1>
+
+Welcome to the Tix Reference Manual Pages.
+
+<h3>General Section</h3>
+<hr>
+<ul>
+ <li><a href="../man/TixIntro.html"> Introduction to the Tix Library</a>
+ <li><a href="../man/tixwish.html"> The Tix Windowing Shell</a>
+</ul>
+
+<hr>
+
+<h3>Widgets and Commands</h3>
+<ul>
+ <li><a href="../man/Balloon.html"> tixBalloon</a>
+ <li><a href="../man/BtnBox.html"> tixButtonBox</a>
+ <li><a href="../man/ChkList.html"> tixCheckList</a>
+ <li><a href="../man/ComboBox.html"> tixComboBox</a>
+ <li><a href="../man/Control.html"> tixControl</a>
+ <li><a href="../man/DItem.html"> Display Items</a>
+ <li><a href="../man/Destroy.html"> tixDestroy</a>
+ <li><a href="../man/DirList.html"> tixDirList</a>
+ <li><a href="../man/DirDlg.html"> tixDirSelectDialog</a>
+ <li><a href="../man/DirTree.html"> tixDirTree</a>
+ <li><a href="../man/EFileBox.html"> tixExFileSelectBox</a>
+ <li><a href="../man/EFileDlg.html"> tixExFileSelectDialog</a>
+ <li><a href="../man/FileBox.html"> tixFileSelectBox</a>
+ <li><a href="../man/FileDlg.html"> tixFileSelectDialog</a>
+ <li><a href="../man/FileEnt.html"> tixFileEntry</a>
+ <li><a href="../man/Form.html"> tixForm</a>
+ <li><a href="../man/GetBool.html"> tixGetBoolean</a>
+ <li><a href="../man/GetInt.html"> tixGetInt</a>
+ <li><a href="../man/Grid.html"> tixGrid</a>
+ <li><a href="../man/HList.html"> tixHList</a>
+ <li><a href="../man/InpOnly.html"> tixInputOnly</a>
+ <li><a href="../man/LabEntry.html"> tixLabelEntry</a>
+ <li><a href="../man/LabFrame.html"> tixLabelFrame</a>
+ <li><a href="../man/ListNBK.html"> tixListNoteBook</a>
+ <li><a href="../man/Mwm.html"> tixMwm</a>
+ <li><a href="../man/NBFrame.html"> tixNBFrame</a>
+ <li><a href="../man/NoteBook.html"> tixNoteBook</a>
+ <li><a href="../man/OptMenu.html"> tixOptionMenu</a>
+ <li><a href="../man/PanedWin.html"> tixPanedWindow</a>
+ <li><a href="../man/PopMenu.html"> tixPopupMenu</a>
+ <li><a href="../man/SHList.html"> tixScrolledHList</a>
+ <li><a href="../man/SListBox.html"> tixScrolledListBox</a>
+ <li><a href="../man/SText.html"> tixScrolledText</a>
+ <li><a href="../man/SWindow.html"> tixScrolledWindow</a>
+ <li><a href="../man/Select.html"> tixSelect</a>
+ <li><a href="../man/StdBBox.html"> tixStdButtonBox</a>
+ <li><a href="../man/Tree.html"> tixTree</a>
+ <li><a href="../man/Wm.html"> Wm</a>
+ <li><a href="../man/Utils.html"> Tix Utility Procedures</a>
+ <li><a href="../man/compound.html"> Creating <b>compound</b> images</a>
+ <li><a href="../man/pixmap.html"> Creating <b>pixmap</b> images
+ using XPM files</a>
+ <li><a href="../man/tix.html"> Accessing Tix Application Context</a>
+
+</ul>
+
+<i><p>
+<a href="../README.html">Back to the Tix Documentation Master Index</a>
+</i>
+<!Serial 851729152>
+<hr><i>Last modified Fri Jan 17 23:02:26 EST 1997 </i> ---
+<i>Serial 853731307</i>
diff --git a/tix/man/man.macros b/tix/man/man.macros
new file mode 100644
index 00000000000..a272ecc3d8b
--- /dev/null
+++ b/tix/man/man.macros
@@ -0,0 +1,186 @@
+'\" The definitions below are for supplemental macros used in Tix
+'\" manual entries.
+'\"
+'\" .HS name section [date [version]]
+'\" Replacement for .TH in other man pages. See below for valid
+'\" section names.
+'\"
+'\" .AP type name in/out [indent]
+'\" Start paragraph describing an argument to a library procedure.
+'\" type is type of argument (int, etc.), in/out is either "in", "out",
+'\" or "in/out" to describe whether procedure reads or modifies arg,
+'\" and indent is equivalent to second arg of .IP (shouldn't ever be
+'\" needed; use .AS below instead)
+'\"
+'\" .AS [type [name]]
+'\" Give maximum sizes of arguments for setting tab stops. Type and
+'\" name are examples of largest possible arguments that will be passed
+'\" to .AP later. If args are omitted, default tab stops are used.
+'\"
+'\" .BS
+'\" Start box enclosure. From here until next .BE, everything will be
+'\" enclosed in one large box.
+'\"
+'\" .BE
+'\" End of box enclosure.
+'\"
+'\" .VS
+'\" Begin vertical sidebar, for use in marking newly-changed parts
+'\" of man pages.
+'\"
+'\" .VE
+'\" End of vertical sidebar.
+'\"
+'\" .DS
+'\" Begin an indented unfilled display.
+'\"
+'\" .DE
+'\" End of indented unfilled display.
+'\"
+.\"
+'\" # Heading for Tix man pages
+.de HS
+.ds ^3 \\0
+.if !"\\$3"" .ds ^3 \\$3
+.if '\\$2'cmds' .TH "\\$1" 1 "\\*(^3" "\\$4" "\\$5"
+.if '\\$2'lib' .TH "\\$1" 3 "\\*(^3" "\\$4" "\\$5"
+.if '\\$2'ncmds' .TH "\\$1" n "\\*(^3" "\\$4" "\\$5"
+.if '\\$2'tcl' .TH "\\$1" n "\\*(^3" Tcl "Tcl Built-In Commands"
+.if '\\$2'tk' .TH "\\$1" n "\\*(^3" Tk "Tk Commands"
+.if '\\$2'tclc' .TH "\\$1" 3 "\\*(^3" Tcl "Tcl Library Procedures"
+.if '\\$2'tkc' .TH "\\$1" 3 "\\*(^3" Tk "Tk Library Procedures"
+.if '\\$2'tclcmds' .TH "\\$1" 1 "\\*(^3" Tcl "Tcl Applications"
+.if '\\$2'tkcmds' .TH "\\$1" 1 "\\*(^3" Tk "Tk Applications"
+.if '\\$2'tix' .TH "\\$1" n "\\*(^3" Tix "Tix Commands"
+.if '\\$2'tixcmds' .TH "\\$1" 1 "\\*(^3" Tix "Tix Applications"
+.if t .wh -1.3i ^B
+.nr ^l \\n(.l
+.ad b
+..
+'\" # Start an argument description
+.de AP
+.ie !"\\$4"" .TP \\$4
+.el \{\
+. ie !"\\$2"" .TP \\n()Cu
+. el .TP 15
+.\}
+.ie !"\\$3"" \{\
+.ta \\n()Au \\n()Bu
+\&\\$1 \\fI\\$2\\fP (\\$3)
+.\".b
+.\}
+.el \{\
+.br
+.ie !"\\$2"" \{\
+\&\\$1 \\fI\\$2\\fP
+.\}
+.el \{\
+\&\\fI\\$1\\fP
+.\}
+.\}
+..
+'\" # define tabbing values for .AP
+.de AS
+.nr )A 10n
+.if !"\\$1"" .nr )A \\w'\\$1'u+3n
+.nr )B \\n()Au+15n
+.\"
+.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n
+.nr )C \\n()Bu+\\w'(in/out)'u+2n
+..
+'\" # BS - start boxed text
+'\" # ^y = starting y location
+'\" # ^b = 1
+.de BS
+.br
+.mk ^y
+.nr ^b 1u
+.if n .nf
+.if n .ti 0
+.if n \l'\\n(.lu\(ul'
+.if n .fi
+..
+'\" # BE - end boxed text (draw box now)
+.de BE
+.nf
+.ti 0
+.mk ^t
+.ie n \l'\\n(^lu\(ul'
+.el \{\
+.\" Draw four-sided box normally, but don't draw top of
+.\" box if the box started on an earlier page.
+.ie !\\n(^b-1 \{\
+\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.el \}\
+\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.\}
+.fi
+.br
+.nr ^b 0
+..
+'\" # VS - start vertical sidebar
+'\" # ^Y = starting y location
+'\" # ^v = 1 (for troff; for nroff this doesn't matter)
+.de VS
+.mk ^Y
+.ie n 'mc \s12\(br\s0
+.el .nr ^v 1u
+..
+'\" # VE - end of vertical sidebar
+.de VE
+.ie n 'mc
+.el \{\
+.ev 2
+.nf
+.ti 0
+.mk ^t
+\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n'
+.sp -1
+.fi
+.ev
+.\}
+.nr ^v 0
+..
+'\" # Special macro to handle page bottom: finish off current
+'\" # box/sidebar if in box/sidebar mode, then invoked standard
+'\" # page bottom macro.
+.de ^B
+.ev 2
+'ti 0
+'nf
+.mk ^t
+.if \\n(^b \{\
+.\" Draw three-sided box if this is the box's first page,
+.\" draw two sides but no top otherwise.
+.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.\}
+.if \\n(^v \{\
+.nr ^x \\n(^tu+1v-\\n(^Yu
+\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c
+.\}
+.bp
+'fi
+.ev
+.if \\n(^b \{\
+.mk ^y
+.nr ^b 2
+.\}
+.if \\n(^v \{\
+.mk ^Y
+.\}
+..
+'\" # DS - begin display
+.de DS
+.RS
+.nf
+.sp
+..
+'\" # DE - end display
+.de DE
+.fi
+.RE
+.sp
+..
diff --git a/tix/man/pixmap.html b/tix/man/pixmap.html
new file mode 100644
index 00000000000..a47a5cb3663
--- /dev/null
+++ b/tix/man/pixmap.html
@@ -0,0 +1,77 @@
+
+
+
+<TITLE>pixmap - Create color images from XPM files.</TITLE>
+<Center><H2>pixmap - Create color images from XPM files.</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>image create pixmap </B></I>?<I>name</I></B>? ?<I>options</I></B>?
+</pre><HR>
+
+</pre><H3>DESCRIPTION</H3>
+<P>
+XPM is a popular X Window image file format for storing color icons.
+The <B>pixmap</B></I> image type defined by the <B>Tix(n)</B></I> library can be
+used to create color images using XPM files.
+
+</pre><H3>CREATING PIXMAPS</H3>
+<P>
+Like all images, pixmaps are created using the <B>image create</B></I>
+command. Pixmaps support the following <I>options</I></B>:
+<DL>
+<DT> <B>-data <I>string</I></B>
+</I></B>
+<DD> Specifies the contents of the source pixmap as a string. The string
+must adhere to the XPM file format (e.g., as generated by the
+<B>pixmap(1)</B></I> program). If both the <B>-data</B></I> and <B>-file</B></I>
+options are specified, the <B>-data</B></I> option takes precedence.
+Please note that the XPM file parsing code in the xpm library is
+extremely fragile. The first line of the string must be "<B>/* XPM
+*/</B></I>" or otherwise a segmatation fault will be caused.
+</DL>
+<DL>
+<DT> <B>-file <I>name</I></B>
+</I></B>
+<DD> <I>name</I></B> gives the name of a file whose contents define the source
+pixmap. The file must adhere to the XPM file format (e.g., as
+generated by the <B>pixmap(1)</B></I> program).
+</DL>
+</pre><H3>IMAGE COMMAND</H3>
+<P>
+When a pixmap image is created, Tk also creates a new command whose
+name is the same as the image. This command may be used to invoke
+various operations on the image. It has the following general form:
+<pre>
+<I>imageName option </I></B>?<I>arg arg ...</I></B>?
+</pre>
+<I>Option</I></B> and the <I>arg</I></B>s
+determine the exact behavior of the command. The following
+commands are possible for pixmap images:
+<DL>
+<DT> <I>imageName <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may have any of the values accepted by the
+<B>image create pixmap</B></I> command.
+</DL>
+<DL>
+<DT> <I>imageName <B>configure</B></I> ?<I>option</I></B>? ?<I>value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options for the image. If no
+<I>option</I></B> is specified, returns a list describing all of the
+available options for <I>imageName</I></B> (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given option(s) to have the given value(s); in this case
+the command returns an empty string. <I>Option</I></B> may have any of the
+values accepted by the <B>image create pixmap</B></I> command.
+
+</DL>
+</pre><H3>KEYWORDS</H3>
+pixmap(1), image(n), Tix(n)
+<!Serial 851729152>
+<hr><i>Last modified Fri Jan 17 23:02:31 EST 1997 </i> ---
+<i>Serial 853731307</i>
diff --git a/tix/man/pixmap.n b/tix/man/pixmap.n
new file mode 100644
index 00000000000..ef5c8dc2ef9
--- /dev/null
+++ b/tix/man/pixmap.n
@@ -0,0 +1,84 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+.HS pixmap tix 4.0
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+.SH NAME
+pixmap \- Create color images from XPM files.
+.SH SYNOPSIS
+\fBimage create pixmap \fR?\fIname\fR? ?\fIoptions\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+XPM is a popular X Window image file format for storing color icons.
+The \fBpixmap\fR image type defined by the \fBTix(n)\fR library can be
+used to create color images using XPM files.
+
+.SH "CREATING PIXMAPS"
+.PP
+Like all images, pixmaps are created using the \fBimage create\fR
+command. Pixmaps support the following \fIoptions\fR:
+.TP
+\fB\-data \fIstring\fR
+'
+Specifies the contents of the source pixmap as a string. The string
+must adhere to the XPM file format (e.g., as generated by the
+\fBpixmap(1)\fR program). If both the \fB\-data\fR and \fB\-file\fR
+options are specified, the \fB\-data\fR option takes precedence.
+Please note that the XPM file parsing code in the xpm library is
+extremely fragile. The first line of the string must be "\fB/* XPM
+*/\fR" or otherwise a segmatation fault will be caused.
+'
+.TP
+\fB\-file \fIname\fR
+'
+\fIname\fR gives the name of a file whose contents define the source
+pixmap. The file must adhere to the XPM file format (e.g., as
+generated by the \fBpixmap(1)\fR program).
+'
+.SH "IMAGE COMMAND"
+.PP
+When a pixmap image is created, Tk also creates a new command whose
+name is the same as the image. This command may be used to invoke
+various operations on the image. It has the following general form:
+.DS C
+\fIimageName option \fR?\fIarg arg ...\fR?
+.DE
+\fIOption\fR and the \fIarg\fRs
+'
+determine the exact behavior of the command. The following
+commands are possible for pixmap images:
+.TP
+\fIimageName \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may have any of the values accepted by the
+\fBimage create pixmap\fR command.
+.TP
+\fIimageName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+'
+Query or modify the configuration options for the image. If no
+\fIoption\fR is specified, returns a list describing all of the
+available options for \fIimageName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given option(s) to have the given value(s); in this case
+the command returns an empty string. \fIOption\fR may have any of the
+values accepted by the \fBimage create pixmap\fR command.
+
+.SH KEYWORDS
+pixmap(1), image(n), Tix(n)
diff --git a/tix/man/tix.html b/tix/man/tix.html
new file mode 100644
index 00000000000..a7a42928d04
--- /dev/null
+++ b/tix/man/tix.html
@@ -0,0 +1,216 @@
+
+
+
+<TITLE>tix - Manipulate Tix internal state</TITLE>
+<Center><H2>tix - Manipulate Tix internal state</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tix</B></I> <I>option </I></B>?<I>arg arg ...</I></B>?
+</pre><H3>CONFIGURATION OPTIONS</H3>
+The Tix application context supports the following configuration
+options. Usually, these options are set using the X resource database,
+different color scheme for the Tix widgets, these two lines can be
+<P>
+<pre><code><code><code>
+ *TixScheme: Gray
+ *TixFontSet: 14Point
+</code></code></code></pre>
+<P>
+<pre><code><code><code>
+Name: <B>binding</B></I>
+Class: <B>Binding</B></I>
+Switch: <B>-binding</B></I>
+</code></code></code></pre>
+<UL>
+This is an obsolete option.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>debug</B></I>
+Class: <B>Debug</B></I>
+Switch: <B>-debug</B></I>
+</code></code></code></pre>
+<UL>
+Specifies whether the Tix widgets should run in debug mode.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>tixFontSet</B></I>
+Class: <B>TixFontSet</B></I>
+Switch: <B>-fontset</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the fontset to use for the Tix widgets. Valid options are
+<B>TK</B></I>, <B>12Point</B></I> and <B>14Point</B></I>. <B>TK</B></I> specifies that the
+standard TK fonts should be used. The default value is <B>14Point</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>tixScheme</B></I>
+Class: <B>TixScheme</B></I>
+Switch: <B>-scheme</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the color scheme to use for the Tix widgets. Valid options
+are <B>TK</B></I>, <B>Gray</B></I>, <B>Blue</B></I>, <B>Bisque</B></I>, <B>SGIGray</B></I> and
+<B>TixGray</B></I>. The default value is <B>TixGray</B></I>. If you want the
+standard TK color scheme, you can use the value <B>TK</B></I>. If you want
+to use the TK 3.6 bisque color scheme, you can use the value <B>Bisque</B></I>.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>tixSchemePriority</B></I>
+Class: <B>TixSchemePriority</B></I>
+Switch: <B>-schemepriority</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the priority level of the TK options set by th Tix
+schemes. Please refer to the TK <B>option(n)</B></I> manual page for a
+discussion of the priority level of Tix options. The default value is
+79, which makes the Tix schemes at a higher priority than the
+settings in the .Xdefaults file. If you want to allow the Tix schemes
+to be overridden by the settings in the .Xdefaults file, you can set
+the following line in you .Xdefaults file:
+</UL>
+<pre><code><code><code>
+*TixSchemePriority: 21
+</code></code></code></pre>
+</pre><HR>
+
+</pre><H3>DESCRIPTION</H3>
+<P>
+The <B>tix</B></I> command provides access to miscellaneous elements of
+the information manipulated by this command pertains to the
+application as a whole, or to a screen or display, rather than to a
+particular window. The command can take any of a number of different
+forms depending on the <I>option</I></B> argument. The legal forms are:
+<DL>
+<DT> <B>tix <B>addbitmapdir</B></I> <I>directory</I></B>
+</I></B>
+<DD> Tix maintains a list of directory under which which the <B>tix
+getimage</B></I> and <B>tix getbitmap</B></I> commands will search for image
+files. The standard bitmap directory is
+<B>$TIX_LIBRARY/bitmaps</B></I>. The <B>addbitmapdir</B></I> command adds
+<I>directory</I></B> into this list. By using this command, the image files
+of an applications can also be located using the <B>tix getimage</B></I> ot
+<B>tix getbitmap</B></I> command.
+</DL>
+<DL>
+<DT> <B>tix <B>cget</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of the configuration option given by
+<I>option</I></B>. <I>Option</I></B> may be any of the options described in the
+<B>CONFIGURATION OPTIONS</B></I> section.
+</DL>
+<DL>
+<DT> <B>tix <B>configure</B></I> ?<I>option</I></B>? <I>?value option value ...</I></B>?
+</I></B>
+<DD> Query or modify the configuration options of the Tix application
+context. If no <I>option</I></B> is specified, returns a list describing
+all of the available options (see <B>Tk_ConfigureInfo</B></I> for
+information on the format of this list). If <I>option</I></B> is specified
+with no <I>value</I></B>, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no <I>option</I></B> is specified). If
+one or more <I>option-value</I></B> pairs are specified, then the command
+modifies the given option(s) to have the given value(s); in this case
+the command returns an empty string. <I>Option</I></B> may be any of the
+options described in the <B>CONFIGURATION OPTIONS</B></I> section.
+</DL>
+<DL>
+<DT> <B>tix filedialog </B></I>?<I>class</I></B>?
+</I></B>
+<DD> Returns the file selection dialog that may be shared among different
+modules of this application. This command will create a file selection
+dialog widget when it is called the first time. This dialog will be
+returned by all subsequent calls to <B>tix filedialog</B></I>. An optional
+<I>class</I></B> parameter can be passed to specified what type of file
+selection dialog widget is desired. Possible options are
+<B>tixFileSelectDialog</B></I> or <B>tixExFileSelectDialog.</B></I>
+</DL>
+<DL>
+<DT> <B>tix getbitmap <I>name</I></B>
+</I></B>
+<DD> Locates a bitmap file of the name <I>name</I></B>.xpm or <I>name</I></B> in one
+of the bitmap directories (see the <B>addbitmapdir</B></I> command
+above). By using <B>tix getbitmap</B></I>, you can advoid hard coding the
+pathnames of the bitmap files in your application. When successful, it
+returns the complete pathname of the bitmap file, prefixed with the
+character <B>@</B></I>. The returned value can be used to configure the
+<B>-bitmap</B></I> option of the TK and Tix widgets.
+</DL>
+<DL>
+<DT> <B>tix getimage <I>name</I></B>
+</I></B>
+<DD> Locates an image file of the name <I>name</I></B>.xpm, <I>name</I></B>.xbm or
+<I>name</I></B>.ppm in one of the bitmap directories (see the
+<B>addbitmapdir</B></I> command above). If more than one file with the same
+name (but different extensions) exist, then the image type is chosen
+according to the depth of the X display: xbm images are chosen on
+monochrome displays and color images are chosen on color displays. By
+using <B>tix getimage</B></I>, you can advoid hard coding the pathnames of
+the image files in your application. When successful, this command
+returns the name of the newly created image, which can be used to
+configure the <B>-image</B></I> option of the TK and Tix widgets.
+</DL>
+<DL>
+<DT> <B>tix <B>option</B></I> ?<I>args ...</I></B>?
+</I></B>
+<DD> Manipulates the options manitained by the Tix scheme
+mechanism. Available options are:
+
+</DL>
+<pre><code><code><code>
+\fCactive_bg</B></I> \fCactive_fg</B></I> \fCbg</B></I>
+\fCbold_font</B></I> \fCdark1_bg</B></I> \fCdark1_fg</B></I>
+\fCdark2_bg</B></I> \fCdark2_fg</B></I> \fCdisabled_fg</B></I>
+\fCfg</B></I> \fCfixed_font</B></I> \fCfont</B></I>
+\fCinactive_bg</B></I> \fCinactive_fg</B></I> \fCinput1_bg</B></I>
+\fCinput2_bg</B></I> \fCitalic_font</B></I> \fClight1_bg</B></I>
+\fClight1_fg</B></I> \fClight2_bg</B></I> \fClight2_fg</B></I>
+\fCmenu_font</B></I> \fCoutput1_bg</B></I> \fCoutput2_bg</B></I>
+\fCselect_bg</B></I> \fCselect_fg</B></I> \fCselector</B></I>
+</code></code></code></pre>
+
+The arguments to the <B>tix <B>option</B></I> command can take the
+following form(s):
+<UL>
+<DL>
+<DT> <B>tix option get</B></I> <I>option</I></B>
+</I></B>
+<DD> Returns the current value of <I>option</I></B>.
+</DL>
+</UL>
+<DL>
+<DT> <B>tix <B>resetoptions</B></I> <I>newScheme newFontSet</I></B> ?<I>newScmPrio</I></B>?
+</I></B>
+<DD> Resets the scheme and fontset of the Tix application to
+<I>newScheme</I></B> and <I>newFontSet</I></B>, respectively. This affects only
+those widgets created <B>after</B></I> this call. Therefore, it is best to
+call the <B>resetoptions</B></I> command <B>before</B></I> the creation of any
+widgets in a Tix application.
+
+The optional parameter <I>newScmPrio</I></B> can be given to reset the
+priority level of the TK options set by the Tix schemes.
+</DL>
+</pre><H3>BUGS</H3>
+Because of the way TK handles the X option database, after tixwish has
+started up, it is not possible to reset the color schemes and font
+sets using the <B>tix config</B></I> command. Instead, the <B>tix
+resetoptions</B></I> command must be used.
+<P>
+The tk_setPalette command does not work very well under Tix. To use
+it, one must follow these steps:
+<UL>
+\fC
+<pre><code><code><code>
+
+tix resetoptions TK TK
+tk_setPalette lightblue
+</code></code></code></pre>
+</B></I>
+</UL>
+</pre><H3>KEYWORDS</H3>
+file selection dialog
+<hr><i>Last modified Sun Jan 19 22:34:41 EST 1997 </i> ---
+<i>Serial 853731308</i>
diff --git a/tix/man/tix.n b/tix/man/tix.n
new file mode 100644
index 00000000000..1b2921e88a9
--- /dev/null
+++ b/tix/man/tix.n
@@ -0,0 +1,256 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+.HS tix tix 4.0
+.BS
+'
+.SH NAME
+tix \- Manipulate Tix internal state
+'
+.SH SYNOPSIS
+\fBtix\fR \fIoption \fR?\fIarg arg ...\fR?
+'
+'----------------------------------------------------------------------
+.SH "CONFIGURATION OPTIONS"
+'
+The Tix application context supports the following configuration
+options. Usually, these options are set using the X resource database,
+i.e., in the user's \fB\.Xdefault\fR file. For example, to choose a
+different color scheme for the Tix widgets, these two lines can be
+added to the user's \fB\.Xdefault\fR file:
+.PP
+.nf
+ *TixScheme: Gray
+ *TixFontSet: 14Point
+.fi
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBbinding\fR
+Class: \fBBinding\fR
+Switch: \fB\-binding\fR
+.fi
+.IP
+This is an obsolete option.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBdebug\fR
+Class: \fBDebug\fR
+Switch: \fB\-debug\fR
+.fi
+.IP
+Specifies whether the Tix widgets should run in debug mode.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBtixFontSet\fR
+Class: \fBTixFontSet\fR
+Switch: \fB\-fontset\fR
+.fi
+.IP
+Specifies the fontset to use for the Tix widgets. Valid options are
+\fBTK\fR, \fB12Point\fR and \fB14Point\fR. \fBTK\fR specifies that the
+standard TK fonts should be used. The default value is \fB14Point\fR.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBtixScheme\fR
+Class: \fBTixScheme\fR
+Switch: \fB\-scheme\fR
+.fi
+.IP
+Specifies the color scheme to use for the Tix widgets. Valid options
+are \fBTK\fR, \fBGray\fR, \fBBlue\fR, \fBBisque\fR, \fBSGIGray\fR and
+\fBTixGray\fR. The default value is \fBTixGray\fR. If you want the
+standard TK color scheme, you can use the value \fBTK\fR. If you want
+to use the TK 3.6 bisque color scheme, you can use the value \fBBisque\fR.
+'----------END
+'
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBtixSchemePriority\fR
+Class: \fBTixSchemePriority\fR
+Switch: \fB\-schemepriority\fR
+.fi
+.IP
+Specifies the priority level of the TK options set by th Tix
+schemes. Please refer to the TK \fBoption(n)\fR manual page for a
+discussion of the priority level of Tix options. The default value is
+79, which makes the Tix schemes at a higher priority than the
+settings in the .Xdefaults file. If you want to allow the Tix schemes
+to be overridden by the settings in the .Xdefaults file, you can set
+the following line in you .Xdefaults file:
+.nf
+*TixSchemePriority: 21
+.fi
+'----------END
+'
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBtix\fR command provides access to miscellaneous elements of
+Tix's internal state and the Tix \fBapplication context\fR. Most of
+the information manipulated by this command pertains to the
+application as a whole, or to a screen or display, rather than to a
+particular window. The command can take any of a number of different
+forms depending on the \fIoption\fR argument. The legal forms are:
+'
+.TP
+\fBtix \fBaddbitmapdir\fR \fIdirectory\fR
+'
+Tix maintains a list of directory under which which the \fBtix
+getimage\fR and \fBtix getbitmap\fR commands will search for image
+files. The standard bitmap directory is
+\fB$TIX_LIBRARY/bitmaps\fR. The \fBaddbitmapdir\fR command adds
+\fIdirectory\fR into this list. By using this command, the image files
+of an applications can also be located using the \fBtix getimage\fR ot
+\fBtix getbitmap\fR command.
+'
+.TP
+\fBtix \fBcget\fR \fIoption\fR
+'
+Returns the current value of the configuration option given by
+\fIoption\fR. \fIOption\fR may be any of the options described in the
+\fBCONFIGURATION OPTIONS\fR section.
+'
+.TP
+\fBtix \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+'
+Query or modify the configuration options of the Tix application
+context. If no \fIoption\fR is specified, returns a list describing
+all of the available options (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given option(s) to have the given value(s); in this case
+the command returns an empty string. \fIOption\fR may be any of the
+options described in the \fBCONFIGURATION OPTIONS\fR section.
+'
+'
+.TP
+\fBtix filedialog \fR?\fIclass\fR?
+'
+Returns the file selection dialog that may be shared among different
+modules of this application. This command will create a file selection
+dialog widget when it is called the first time. This dialog will be
+returned by all subsequent calls to \fBtix filedialog\fR. An optional
+\fIclass\fR parameter can be passed to specified what type of file
+selection dialog widget is desired. Possible options are
+\fBtixFileSelectDialog\fR or \fBtixExFileSelectDialog.\fR
+'
+.TP
+\fBtix getbitmap \fIname\fR
+'
+Locates a bitmap file of the name \fIname\fR.xpm or \fIname\fR in one
+of the bitmap directories (see the \fBaddbitmapdir\fR command
+above). By using \fBtix getbitmap\fR, you can advoid hard coding the
+pathnames of the bitmap files in your application. When successful, it
+returns the complete pathname of the bitmap file, prefixed with the
+character \fB@\fR. The returned value can be used to configure the
+\fB\-bitmap\fR option of the TK and Tix widgets.
+'
+.TP
+\fBtix getimage \fIname\fR
+'
+Locates an image file of the name \fIname\fR.xpm, \fIname\fR.xbm or
+\fIname\fR.ppm in one of the bitmap directories (see the
+\fBaddbitmapdir\fR command above). If more than one file with the same
+name (but different extensions) exist, then the image type is chosen
+according to the depth of the X display: xbm images are chosen on
+monochrome displays and color images are chosen on color displays. By
+using \fBtix getimage\fR, you can advoid hard coding the pathnames of
+the image files in your application. When successful, this command
+returns the name of the newly created image, which can be used to
+configure the \fB\-image\fR option of the TK and Tix widgets.
+'
+'
+.TP
+\fBtix \fBoption\fR ?\fIargs ...\fR?
+'
+Manipulates the options manitained by the Tix scheme
+mechanism. Available options are:
+
+.nf
+.ta 4c 8c 12c
+\fCactive_bg\fR \fCactive_fg\fR \fCbg\fR
+\fCbold_font\fR \fCdark1_bg\fR \fCdark1_fg\fR
+\fCdark2_bg\fR \fCdark2_fg\fR \fCdisabled_fg\fR
+\fCfg\fR \fCfixed_font\fR \fCfont\fR
+\fCinactive_bg\fR \fCinactive_fg\fR \fCinput1_bg\fR
+\fCinput2_bg\fR \fCitalic_font\fR \fClight1_bg\fR
+\fClight1_fg\fR \fClight2_bg\fR \fClight2_fg\fR
+\fCmenu_font\fR \fCoutput1_bg\fR \fCoutput2_bg\fR
+\fCselect_bg\fR \fCselect_fg\fR \fCselector\fR
+.ta 4c
+.fi
+'
+
+The arguments to the \fBtix \fBoption\fR command can take the
+following form(s):
+.RS
+.TP
+\fBtix option get\fR \fIoption\fR
+'
+Returns the current value of \fIoption\fR.
+.RE
+'
+'
+.TP
+\fBtix \fBresetoptions\fR \fInewScheme newFontSet\fR ?\fInewScmPrio\fR?
+'
+'
+Resets the scheme and fontset of the Tix application to
+\fInewScheme\fR and \fInewFontSet\fR, respectively. This affects only
+those widgets created \fBafter\fR this call. Therefore, it is best to
+call the \fBresetoptions\fR command \fBbefore\fR the creation of any
+widgets in a Tix application.
+
+The optional parameter \fInewScmPrio\fR can be given to reset the
+priority level of the TK options set by the Tix schemes.
+'
+'
+.SH BUGS
+'
+Because of the way TK handles the X option database, after tixwish has
+started up, it is not possible to reset the color schemes and font
+sets using the \fBtix config\fR command. Instead, the \fBtix
+resetoptions\fR command must be used.
+'
+.PP
+The tk_setPalette command does not work very well under Tix. To use
+it, one must follow these steps:
+.RS
+\fC
+.nf
+
+tix resetoptions TK TK
+tk_setPalette lightblue
+.fi
+\fR
+.RE
+'
+.SH KEYWORDS
+file selection dialog
diff --git a/tix/man/tixwish.1 b/tix/man/tixwish.1
new file mode 100644
index 00000000000..4864ee67a1a
--- /dev/null
+++ b/tix/man/tixwish.1
@@ -0,0 +1,192 @@
+'\"
+'\" Copyright (c) 1996, Expert Interface Technologies
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+'\" The file man.macros and some of the macros used by this file are
+'\" copyrighted: (c) 1990 The Regents of the University of California.
+'\" (c) 1994-1995 Sun Microsystems, Inc.
+'\" The license terms of the Tcl/Tk distrobution are in the file
+'\" license.tcl.
+.so man.macros
+.HS wish tixcmds 4.0
+.BS
+'\" Note: do not modify the .SH NAME line immediately below!
+'
+.SH NAME
+tixwish \- Windowing shell for interpreting Tix commands.
+'
+.SH SYNOPSIS
+\fBtixwish\fR ?\fIfileName arg arg ...\fR?
+'
+.SH OPTIONS
+'
+.IP "\fB\-display \fIdisplay\fR" 20
+Display (and screen) on which to display window.
+'
+.IP "\fB\-geometry \fIgeometry\fR" 20
+Initial geometry to use for window. If this option is specified, its
+value is stored in the \fBgeometry\fR global variable of the application's
+Tcl interpreter.
+'
+.IP "\fB\-name \fIname\fR" 20
+'
+Use \fIname\fR as the title to be displayed in the window, and
+as the name of the interpreter for \fBsend\fR commands.
+'
+.IP "\fB\-sync\fR" 20
+'
+Execute all X server commands synchronously, so that errors are
+reported immediately. This will result in much slower execution, but
+it is useful for debugging.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTixwish\fR is a simple program consisting of the Tcl command
+language, the Tk toolkit, and a main program that reads commands from
+standard input or from a file. It creates a main window and then
+processes Tcl commands.
+'
+If \fBtixwish\fR is invoked with no arguments, or with a first
+argument that starts with ``\-'', then it reads Tcl commands
+interactively from standard input.
+'
+It will continue processing commands until all windows have been
+deleted or until end-of-file is reached on standard input. If there
+exists a file \fB.tixwishrc\fR in the home directory of the user,
+\fBtixwish\fR evaluates the file as a Tcl script just before reading
+the first command from standard input.
+'
+.PP
+'
+If \fBtixwish\fR is invoked with an initial \fIfileName\fR argument,
+then \fIfileName\fR is treated as the name of a script file.
+\fBTixwish\fR will evaluate the script in \fIfileName\fR (which
+presumably creates a user interface), then it will respond to events
+until all windows have been deleted. Commands will not be read from
+standard input. There is no automatic evaluation of \fB.tixwishrc\fR
+in this case, but the script file can always \fBsource\fR it if
+desired.
+
+.SH "OPTIONS"
+.PP
+\fBTixwish\fR automatically processes all of the command-line options
+described in the \fBOPTIONS\fR summary above. Any other command-line
+arguments besides these are passed through to the application using
+the \fBargc\fR and \fBargv\fR variables described later.
+
+.SH "APPLICATION NAME AND CLASS"
+.PP
+.VS
+The name of the application, which is used for purposes such as
+\fBsend\fR commands, is taken from the \fB\-name\fR option,
+if it is specified; otherwise it is taken from \fIfileName\fR,
+if it is specified, or from the command name by which
+\fBtixwish\fR was invoked. In the last two cases, if the name contains a ``/''
+character, then only the characters after the last slash are used
+as the application name.
+.PP
+The class of the application, which is used for purposes such as
+specifying options with a \fBRESOURCE_MANAGER\fR property or .Xdefaults
+file, is the same as its name except that the first letter is
+capitalized.
+.VE
+
+.SH "VARIABLES"
+.PP
+\fBTixwish\fR sets the following Tcl variables:
+.TP 15
+\fBargc\fR
+Contains a count of the number of \fIarg\fR arguments (0 if none),
+not including the options described above.
+.TP 15
+\fBargv\fR
+Contains a Tcl list whose elements are the \fIarg\fR arguments (not
+including the options described above), in order, or an empty string
+if there are no \fIarg\fR arguments.
+.TP 15
+\fBargv0\fR
+Contains \fIfileName\fR if it was specified.
+Otherwise, contains the name by which \fBtixwish\fR was invoked.
+.TP 15
+\fBgeometry\fR
+If the \fB\-geometry\fR option is specified, \fBtixwish\fR copies its
+value into this variable. If the variable still exists after
+\fIfileName\fR has been evaluated, \fBtixwish\fR uses the value of
+the variable in a \fBwm geometry\fR command to set the main
+window's geometry.
+.TP 15
+\fBtcl_interactive\fR
+'
+Contains 1 if \fBtixwish\fR is reading commands interactively
+(\fBfileName\fR was not specified and standard input is a
+terminal-like device), 0 otherwise.
+'
+.SH "X RESOURCES"
+'
+\fBTixwish\fR makes use of several X Resources to determine the
+\fBToolkit Options\fR for the Tix library. These X resources must be
+set using \fBRESOURCE_MANAGER\fR properties or .Xdefaults files
+\fBbefore\fR \fBtixwish\fR starts running. These resources must be
+associated with the main window of the \fBtixwish\fR application.
+These options include:
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBtixScheme\fR
+Class: \fBTixScheme\fR
+.fi
+.IP
+Specifies the color scheme to use for the Tix application. Currently
+only these schemes are supported: Blue, Gray, SGIGray, TixGray, and
+TK.
+'----------END
+'
+'----------BEGIN
+.LP
+.nf
+Name: \fBtixFontSet\fR
+Class: \fBTixFontSet\fR
+.fi
+.IP
+Specifies the FontSet to use for the Tix application. A FontSet
+designates the fonts to use for different types of widgets. Currently
+only these FontSets are supported: 12Point, 14Point and TK.
+'----------END
+.PP
+For example, you may put these two lines in your .Xdefaults file
+.nf
+ *tixwish.tixScheme: Gray
+ *tixwish.tixFontSet: 12Point
+.fi
+.SH "SCRIPT FILES"
+.PP
+If you create a Tcl script in a file whose first line is
+.DS
+\fB#!/usr/local/bin/tixwish\fR
+.DE
+then you can invoke the script file directly from your shell if you
+mark it as executable. This assumes that \fBtixwish\fR has been
+installed in the default location in /usr/local/bin; if it's installed
+somewhere else then you'll have to modify the above line to match.
+Many UNIX systems do not allow the \fB#!\fR line to exceed about 30
+characters in length, so be sure that the \fBtixwish\fR executable can be
+accessed with a short file name.
+
+.SH PROMPTS
+.PP
+When \fBtixwish\fR is invoked interactively it normally prompts for each
+command with ``\fB% \fR''. You can change the prompt by setting the
+variables \fBtcl_prompt1\fR and \fBtcl_prompt2\fR. If variable
+\fBtcl_prompt1\fR exists then it must consist of a Tcl script to
+output a prompt; instead of outputting a prompt \fBtixwish\fR will
+evaluate the script in \fBtcl_prompt1\fR. The variable
+\fBtcl_prompt2\fR is used in a similar way when a newline is typed but
+the current command isn't yet complete; if \fBtcl_prompt2\fR isn't set
+then no prompt is output for incomplete commands.
+
+.SH KEYWORDS
+shell, wish, Tk, toolkit
diff --git a/tix/man/tixwish.html b/tix/man/tixwish.html
new file mode 100644
index 00000000000..c03a4317758
--- /dev/null
+++ b/tix/man/tixwish.html
@@ -0,0 +1,172 @@
+
+
+
+<TITLE>tixwish - Windowing shell for interpreting Tix commands.</TITLE>
+<Center><H2>tixwish - Windowing shell for interpreting Tix commands.</H2></Center><hr>
+
+</pre><H3>SYNOPSIS</H3>
+<B>tixwish</B></I> ?<I>fileName arg arg ...</I></B>?
+</pre><H3>OPTIONS</H3>
+<UL>
+<B>-display <I>display</I></B> <BR>
+Display (and screen) on which to display window.
+</UL>
+<UL>
+<B>-geometry <I>geometry</I></B> <BR>
+Initial geometry to use for window. If this option is specified, its
+Tcl interpreter.
+</UL>
+<UL>
+<B>-name <I>name</I></B> <BR>
+Use <I>name</I></B> as the title to be displayed in the window, and
+as the name of the interpreter for <B>send</B></I> commands.
+</UL>
+<UL>
+<B>-sync</B></I> <BR>
+Execute all X server commands synchronously, so that errors are
+reported immediately. This will result in much slower execution, but
+it is useful for debugging.
+</UL>
+</pre><HR>
+
+</pre><H3>DESCRIPTION</H3>
+<P>
+<B>Tixwish</B></I> is a simple program consisting of the Tcl command
+language, the Tk toolkit, and a main program that reads commands from
+standard input or from a file. It creates a main window and then
+processes Tcl commands.
+If <B>tixwish</B></I> is invoked with no arguments, or with a first
+interactively from standard input.
+It will continue processing commands until all windows have been
+deleted or until end-of-file is reached on standard input. If there
+exists a file <B>.tixwishrc</B></I> in the home directory of the user,
+<B>tixwish</B></I> evaluates the file as a Tcl script just before reading
+the first command from standard input.
+<P>
+If <B>tixwish</B></I> is invoked with an initial <I>fileName</I></B> argument,
+then <I>fileName</I></B> is treated as the name of a script file.
+<B>Tixwish</B></I> will evaluate the script in <I>fileName</I></B> (which
+presumably creates a user interface), then it will respond to events
+until all windows have been deleted. Commands will not be read from
+standard input. There is no automatic evaluation of <B>.tixwishrc</B></I>
+in this case, but the script file can always <B>source</B></I> it if
+desired.
+
+</pre><H3>OPTIONS</H3>
+<P>
+<B>Tixwish</B></I> automatically processes all of the command-line options
+described in the <B>OPTIONS</B></I> summary above. Any other command-line
+arguments besides these are passed through to the application using
+the <B>argc</B></I> and <B>argv</B></I> variables described later.
+
+</pre><H3>APPLICATION NAME AND CLASS</H3>
+<P>
+The name of the application, which is used for purposes such as
+<B>send</B></I> commands, is taken from the <B>-name</B></I> option,
+if it is specified; otherwise it is taken from <I>fileName</I></B>,
+if it is specified, or from the command name by which
+character, then only the characters after the last slash are used
+as the application name.
+<P>
+The class of the application, which is used for purposes such as
+specifying options with a <B>RESOURCE_MANAGER</B></I> property or .Xdefaults
+file, is the same as its name except that the first letter is
+capitalized.
+
+</pre><H3>VARIABLES</H3>
+<P>
+<B>Tixwish</B></I> sets the following Tcl variables:
+<DL>
+<DT> <B>argc</B></I>
+</I></B>
+<DD> Contains a count of the number of <I>arg</I></B> arguments (0 if none),
+not including the options described above.
+</DL>
+<DL>
+<DT> <B>argv</B></I>
+</I></B>
+<DD> Contains a Tcl list whose elements are the <I>arg</I></B> arguments (not
+including the options described above), in order, or an empty string
+if there are no <I>arg</I></B> arguments.
+</DL>
+<DL>
+<DT> <B>argv0</B></I>
+</I></B>
+<DD> Contains <I>fileName</I></B> if it was specified.
+Otherwise, contains the name by which <B>tixwish</B></I> was invoked.
+</DL>
+<DL>
+<DT> <B>geometry</B></I>
+</I></B>
+<DD> If the <B>-geometry</B></I> option is specified, <B>tixwish</B></I> copies its
+value into this variable. If the variable still exists after
+<I>fileName</I></B> has been evaluated, <B>tixwish</B></I> uses the value of
+the variable in a <B>wm geometry</B></I> command to set the main
+</DL>
+<DL>
+<DT> <B>tcl_interactive</B></I>
+</I></B>
+<DD> Contains 1 if <B>tixwish</B></I> is reading commands interactively
+(<B>fileName</B></I> was not specified and standard input is a
+terminal-like device), 0 otherwise.
+</DL>
+</pre><H3>X RESOURCES</H3>
+<B>Tixwish</B></I> makes use of several X Resources to determine the
+<B>Toolkit Options</B></I> for the Tix library. These X resources must be
+set using <B>RESOURCE_MANAGER</B></I> properties or .Xdefaults files
+<B>before</B></I> <B>tixwish</B></I> starts running. These resources must be
+associated with the main window of the <B>tixwish</B></I> application.
+These options include:
+<P>
+<pre><code><code><code>
+Name: <B>tixScheme</B></I>
+Class: <B>TixScheme</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the color scheme to use for the Tix application. Currently
+only these schemes are supported: Blue, Gray, SGIGray, TixGray, and
+TK.
+</UL>
+<P>
+<pre><code><code><code>
+Name: <B>tixFontSet</B></I>
+Class: <B>TixFontSet</B></I>
+</code></code></code></pre>
+<UL>
+Specifies the FontSet to use for the Tix application. A FontSet
+designates the fonts to use for different types of widgets. Currently
+only these FontSets are supported: 12Point, 14Point and TK.
+</UL>
+<P>
+For example, you may put these two lines in your .Xdefaults file
+<pre><code><code><code>
+ *tixwish.tixScheme: Gray
+ *tixwish.tixFontSet: 12Point
+</code></code></code></pre>
+</pre><H3>SCRIPT FILES</H3>
+<P>
+If you create a Tcl script in a file whose first line is
+<pre>
+<B>#!/usr/local/bin/tixwish</B></I>
+</pre>
+then you can invoke the script file directly from your shell if you
+mark it as executable. This assumes that <B>tixwish</B></I> has been
+Many UNIX systems do not allow the <B>#!</B></I> line to exceed about 30
+characters in length, so be sure that the <B>tixwish</B></I> executable can be
+accessed with a short file name.
+
+</pre><H3>PROMPTS</H3>
+<P>
+When <B>tixwish</B></I> is invoked interactively it normally prompts for each
+variables <B>tcl_prompt1</B></I> and <B>tcl_prompt2</B></I>. If variable
+<B>tcl_prompt1</B></I> exists then it must consist of a Tcl script to
+output a prompt; instead of outputting a prompt <B>tixwish</B></I> will
+evaluate the script in <B>tcl_prompt1</B></I>. The variable
+<B>tcl_prompt2</B></I> is used in a similar way when a newline is typed but
+then no prompt is output for incomplete commands.
+
+</pre><H3>KEYWORDS</H3>
+shell, wish, Tk, toolkit
+<!Serial 851729152>
+<hr><i>Last modified Fri Jan 17 23:02:37 EST 1997 </i> ---
+<i>Serial 853731308</i>
diff --git a/tix/tests/Driver.tcl b/tix/tests/Driver.tcl
new file mode 100644
index 00000000000..5f5372a138e
--- /dev/null
+++ b/tix/tests/Driver.tcl
@@ -0,0 +1,356 @@
+# This is the "Test Driver" program that sources in each test script. It
+# must be invoked by the test/Test.tcl program (in Unix) or by a properly
+# configured wish.exe program (in Wondows).
+#
+
+catch {
+ cd [file dirname [info script]]
+}
+
+set oldglobals {}
+set oldglobals [info globals]
+
+# Some parts of the test execute tests for a specific platform. The variable
+# tixPriv(test:platform) controls the tests for which platform should
+# be executed. This can be controlled by the TEST_PLATFORM environment
+# variable
+
+set tixPriv(test:platform) unix
+if [info exists tcl_platform(platform)] {
+ if {$tcl_platform(platform) == "windows"} {
+ set tixPriv(test:platform) windows
+ }
+}
+
+if [info exists env(TEST_PLATFORM)] {
+ set tixPriv(test:platform) $env(TEST_PLATFORM)
+}
+
+global testConfig
+if {![info exists tix]} {
+ if ![info exists tcl_platform(platform)] {
+ puts "ERROR: this version of wish doesn't support dynamic loading"
+ exit -1
+ }
+
+ # This must have been executed by a plain wish expecting to
+ # dynamic load Tix.
+
+ puts -nonewline "trying to dynamically load Tix ... "
+
+ global tk_version
+ if {$tcl_platform(platform) == "unix"} {
+ case $tk_version {
+ 4.1 {
+ set testConfig(dynlib) \
+ ../unix/tk4.1/libtix4.1.4.1[info sharedlibextension]
+ }
+ 4.2 {
+ set testConfig(dynlib) \
+ ../unix/tk4.2/libtix4.1.4.2[info sharedlibextension]
+ }
+ }
+ } else {
+ case $tk_version {
+ 4.1 {
+ set testConfig(dynlib) ..\\win\\tix41.dll
+ }
+ 4.2 {
+ set testConfig(dynlib) ..\\win\\tix41.dll
+ }
+ }
+ }
+
+ if [info exists testConfig(dynlib)] {
+ load $testConfig(dynlib) Tix
+ }
+
+ if {[info exists tix]} {
+ puts succeeded
+ } else {
+ puts failed
+ exit
+ }
+} else {
+ set testConfig(dynlib) ""
+}
+
+proc Driver:Test {name f} {
+ global oldglobals errorInfo testConfig
+
+ foreach w [winfo children .] {
+ if [string comp .__top $w] {
+ destroy $w
+ }
+ }
+
+ foreach g [info globals] {
+ if {[lsearch $oldglobals $g] == -1} {
+# uplevel #0 unset $g
+ }
+ }
+
+ if {$testConfig(VERBOSE) >= 20} {
+ puts ------------------------------------------------------------
+ puts "Loading script $name"
+ } else {
+ puts $name
+ }
+
+ update
+ uplevel #0 source $f
+ Event-Initialize
+ catch {
+ wm title . [About]
+ if {$testConfig(VERBOSE) >= 20} {
+ puts " [About]"
+ puts "---------------------starting-------------------------------"
+ }
+ }
+
+ set code [catch {
+ Test
+ } error]
+
+ if $code {
+ if {$code == 1234} {
+ puts -nonewline "Test $f is aborted"
+ } else {
+ puts -nonewline "Test $f is aborted unexpectedly"
+ }
+ if {[info exists errorInfo] && ![tixStrEq $errorInfo ""]} {
+ puts " by the following error\n$errorInfo"
+ } else {
+ puts "."
+ }
+ }
+ Done
+}
+
+# fileList: name of the file that contains a list of test targets
+# type: "dir" or "script"
+#
+proc Driver:GetTargets {fileList type} {
+ set fd [open $fileList {RDONLY}]
+ set data {}
+
+ while {![eof $fd]} {
+ set line [string trim [gets $fd]]
+ if [regexp ^# $line] {
+ continue
+ }
+ append data $line\n
+ }
+
+ close $fd
+ set files {}
+
+ foreach item $data {
+ set takeit 1
+
+ foreach cond [lrange $item 1 end] {
+ set inverse 0
+ set cond [string trim $cond]
+ if {[string index $cond 0] == "!"} {
+ set cond [string range $cond 1 end]
+ set inverse 1
+ }
+
+ set true 1
+ case [lindex $cond 0] {
+ c {
+ set cmd [lindex $cond 1]
+ if {[info command $cmd] != $cmd} {
+ if ![auto_load $cmd] {
+ set true 0
+ }
+ }
+ }
+ i {
+ if {[lsearch [image types] [lindex $cond 1]] == -1} {
+ set true 0
+ }
+ }
+ v {
+ set var [lindex $cond 1]
+ if ![uplevel #0 info exists [list $var]] {
+ set true 0
+ }
+ }
+ default {
+ # must be an expression
+ #
+ if ![uplevel #0 expr [list $cond]] {
+ set true 0
+ }
+ }
+ }
+
+ if {$inverse} {
+ set true [expr !$true]
+ }
+ if {!$true} {
+ set takeit 0
+ break
+ }
+ }
+
+ if {$takeit} {
+ lappend files [lindex $item 0]
+ }
+ }
+ return $files
+}
+
+proc Driver:Main {} {
+ global argv env
+
+ if [tixStrEq $argv "dont"] {
+ return
+ }
+
+ set argvfiles $argv
+ set env(WAITTIME) 200
+
+ set errCount 0
+
+ set PWD [pwd]
+ if {$argvfiles == {}} {
+ set argvfiles [Driver:GetTargets files dir]
+ }
+
+ foreach f $argvfiles {
+ Driver:Execute $f
+ cd $PWD
+ }
+}
+
+proc Driver:Execute {f} {
+ global testConfig
+
+ if [file isdir $f] {
+ raise .
+ set dir $f
+
+ if {$testConfig(VERBOSE) >= 20} {
+ puts "Entering directory $dir ..."
+ }
+ cd $dir
+
+ if [file exists pkginit.tcl] {
+ # call the package initialization file, which is
+ # something specific to the files in this directory
+ #
+ source pkginit.tcl
+ }
+ foreach f [Driver:GetTargets files script] {
+ set _PWD [pwd]
+ Driver:Test $dir/$f $f
+ cd $_PWD
+ }
+ if {$testConfig(VERBOSE) >= 20} {
+ puts "Leaving directory $dir ..."
+ }
+ } else {
+ set dir [file dirname $f]
+ if {$dir != {}} {
+ if {$testConfig(VERBOSE) >= 20} {
+ puts "Entering directory $dir ..."
+ }
+ cd $dir
+ if [file exists pkginit.tcl] {
+ # call the package initialization file, which is
+ # something specific to the files in this directory
+ #
+ source pkginit.tcl
+ }
+ set f [file tail $f]
+ }
+ set _PWD [pwd]
+ Driver:Test $f $f
+ cd $_PWD
+
+ if {$testConfig(VERBOSE) >= 20} {
+ puts "Leaving directory $dir ..."
+ }
+ }
+}
+
+if [tixStrEq [tix platform] "windows"] {
+ # The following are a bunch of useful functions to make it more convenient
+ # to run the tests on Windows inside the Tix console window.
+ #
+
+ # do --
+ #
+ # Execute a test.
+ #
+ proc do {f} {
+ set PWD [pwd]
+ Driver:Execute $f
+ cd $PWD
+ puts "% "
+ }
+
+ # rnew --
+ #
+ # Read in all the files in the Tix library path that has been modified.
+ #
+ proc rnew {} {
+ global lastModified filesPatterns
+ foreach file [eval glob $filesPatterns] {
+ set mtime [file mtime $file]
+ if {$lastModified < $mtime} {
+ set lastModified $mtime
+ puts "sourcing $file"
+ uplevel #0 source [list $file]
+ }
+ }
+ }
+
+ # pk --
+ #
+ # pack widgets filled and expanded
+ proc pk {args} {
+ eval pack $args -expand yes -fill both
+ }
+
+ # Initialize the lastModified so that rnew only loads in newly modified
+ # files
+ #
+ set filesPatterns {../library/*.tcl Driver.tcl library/*.tcl}
+ set lastModified 0
+ foreach file [eval glob $filesPatterns] {
+ set mtime [file mtime $file]
+ if {$lastModified < $mtime} {
+ set lastModified $mtime
+ }
+ }
+
+ proc ei {} {
+ global errorInfo
+ puts $errorInfo
+ }
+}
+
+
+uplevel #0 source library/TestLib.tcl
+uplevel #0 source library/CaseData.tcl
+wm title . "Test-driving Tix"
+Driver:Main
+
+puts "$testConfig(errCount) error(s) found"
+
+if {[tix platform] != "windows"} {
+ destroy .
+ catch {
+ update
+ }
+ exit 0
+} else {
+ puts -nonewline "type \"exit\" to quit the test\n% "
+ proc q {} {
+ exit
+ }
+}
+
diff --git a/tix/tests/Makefile.in b/tix/tests/Makefile.in
new file mode 100644
index 00000000000..771f6deaa5a
--- /dev/null
+++ b/tix/tests/Makefile.in
@@ -0,0 +1,198 @@
+# This file is a Makefile for Tix. 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.
+#
+# See the file README for information about executing the test
+# suites.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+#
+@SET_MAKE@
+
+BINSRC_DIR = @SRC_DIR@
+SRC_DIR = @SRC_DIR@
+LIBRARY_DIR = @SRC_DIR@/library
+DEMOS_DIR = @SRC_DIR@/demos
+MANUAL_DIR = @SRC_DIR@/man
+VPATH = @SRC_DIR@
+
+all: @TIX_TARGETS@ @TIX_TEST_LOAD@
+
+test: all
+
+unix-tk4.0:: tk40
+
+unix-tk4.1:: tk41
+
+unix-tk4.2:: tk42
+
+unix-itcl2.0:: itcl20
+
+unix-itcl2.1:: itcl21
+
+# There are no test for the following targets (they don't really need
+# tests)
+unix-et-tk4.0::
+
+unix-et-tk4.1::
+
+demos-c::
+
+# Some versions of make, like SGI's, use the following variable to
+# determine which shell to use for executing commands:
+SHELL = @SHELL@
+
+SUBSETS=
+
+ENVIRON_74 = TEST_TCL_LIBRARY=@TCL74_SRC_DIR@/library \
+ TEST_TK_LIBRARY=@TK40_SRC_DIR@/library \
+ TEST_ITCL_LIBRARY=@ITCL20_SRC_DIR@/itcl/library \
+ TEST_ITK_LIBRARY=@ITCL20_SRC_DIR@/itk/library \
+ IWIDGETS_LIBRARY=@ITCL20_SRC_DIR@/iwidgets2.0.0 \
+ TIX_LIBRARY=@SRC_DIR@/library \
+ TEST_BINSRC_DIR=$(BINSRC_DIR) \
+ TEST_LDPATHS=""
+
+
+ENVIRON_75 = TEST_TCL_LIBRARY=@TCL75_SRC_DIR@/library \
+ TEST_TK_LIBRARY=@TK41_SRC_DIR@/library \
+ TEST_ITCL_LIBRARY=@ITCL20_SRC_DIR@/itcl/library \
+ TEST_ITK_LIBRARY=@ITCL20_SRC_DIR@/itk/library \
+ IWIDGETS_LIBRARY=@ITCL20_SRC_DIR@/iwidgets2.0.0 \
+ TIX_LIBRARY=@SRC_DIR@/library \
+ TEST_BINSRC_DIR=$(BINSRC_DIR) \
+ TEST_LDPATHS=@TCL75_SRC_DIR@/unix:@TK41_SRC_DIR@/unix:$(BINSRC_DIR)/unix-tk4.1
+
+
+ENVIRON_76 = TEST_TCL_LIBRARY=@TCL76_SRC_DIR@/library \
+ TEST_TK_LIBRARY=@TK42_SRC_DIR@/library \
+ TEST_ITCL_LIBRARY=@ITCL20_SRC_DIR@/itcl/library \
+ TEST_ITK_LIBRARY=@ITCL20_SRC_DIR@/itk/library \
+ IWIDGETS_LIBRARY=@ITCL20_SRC_DIR@/iwidgets2.0.0 \
+ TIX_LIBRARY=@SRC_DIR@/library \
+ TEST_BINSRC_DIR=$(BINSRC_DIR) \
+ TEST_LDPATHS=@TCL76_SRC_DIR@/unix:@TK42_SRC_DIR@/unix:$(BINSRC_DIR)/unix-tk4.2
+
+ENVIRON_ITCL_20 = TEST_TCL_LIBRARY=@ITCL20_SRC_DIR@/tcl7.4/library \
+ TEST_TK_LIBRARY=@ITCL20_SRC_DIR@/tk4.0/library \
+ TEST_ITCL_LIBRARY=@ITCL20_SRC_DIR@/itcl/library \
+ TEST_ITK_LIBRARY=@ITCL20_SRC_DIR@/itk/library \
+ IWIDGETS_LIBRARY=@ITCL20_SRC_DIR@/iwidgets2.0.0 \
+ TIX_LIBRARY=@SRC_DIR@/library \
+ TEST_BINSRC_DIR=$(BINSRC_DIR) \
+ TEST_LDPATHS=""
+
+ENVIRON_ITCL_21 = TEST_TCL_LIBRARY=@ITCL21_SRC_DIR@/tcl7.5/library \
+ TEST_TK_LIBRARY=@ITCL21_SRC_DIR@/tk4.1/library \
+ TEST_ITCL_LIBRARY=@ITCL21_SRC_DIR@/itcl/library \
+ TEST_ITK_LIBRARY=@ITCL21_SRC_DIR@/itk/library \
+ IWIDGETS_LIBRARY=@ITCL21_SRC_DIR@/iwidgets2.1.0 \
+ TIX_LIBRARY=@SRC_DIR@/library \
+ TEST_BINSRC_DIR=$(BINSRC_DIR) \
+ TEST_LDPATHS=@ITCL21_SRC_DIR@/itk/unix:@ITCL21_SRC_DIR@/itcl/unix:@ITCL21_SRC_DIR@/tcl7.5/unix:@ITCL21_SRC_DIR@/tk4.1/unix:$(BINSRC_DIR)/unix-itcl2.1
+
+tk40::
+ @$(ENVIRON_74) \
+ tclsh Test.tcl tk40 $(SUBSETS)
+
+tk41::
+ @$(ENVIRON_75) \
+ tclsh Test.tcl tk41 $(SUBSETS)
+
+tk42::
+ @$(ENVIRON_76) \
+ tclsh Test.tcl tk42 $(SUBSETS)
+
+itcl20::
+ @$(ENVIRON_ITCL_20) \
+ tclsh Test.tcl itcl20 $(SUBSETS)
+
+itcl21::
+ @$(ENVIRON_ITCL_21) \
+ tclsh Test.tcl itcl21 $(SUBSETS)
+
+load::
+ @$(ENVIRON_75) \
+ tclsh Test.tcl load $(SUBSETS)
+
+Makefile: Makefile.in
+ cd $(SRC_DIR); $(SHELL) config.status
+
+distclean:
+ - rm -f Makefile
+
+#----------------------------------------------------------------------
+#
+# Testing the files in the binary distribution
+#
+#----------------------------------------------------------------------
+
+dist: dist_tk40 dist_tk41 dist_itcl20 dist_itcl21
+
+BDIST=$(TIX_BIN_DIST_DIR)
+SDIST=$(TIX_SRC_DIST_DIR)
+
+ENV_TK40_DIST = \
+ TIX_LIBRARY=$(SDIST)/library \
+ TCL_LIBRARY=@TCL74_SRC_DIR@/library \
+ TK_LIBRARY=@TK40_SRC_DIR@/library \
+ LD_LIBRARY_PATH=$(SITE_LDPATH)
+
+ENV_TK41_DIST = \
+ TIX_LIBRARY=$(SDIST)/library \
+ TCL_LIBRARY=@TCL75_SRC_DIR@/library \
+ TK_LIBRARY=@TK41_SRC_DIR@/library \
+ LD_LIBRARY_PATH=$(BDIST)/unix-tk4.1:$(SITE_LDPATH)
+
+ENV_ITCL20_DIST = \
+ TIX_LIBRARY=$(SDIST)/library \
+ TCL_LIBRARY=@ITCL20_SRC_DIR@/tcl7.4/library \
+ TK_LIBRARY=@ITCL20_SRC_DIR@/tk4.0/library \
+ ITCL_LIBRARY=@ITCL20_SRC_DIR@/itcl/library \
+ ITK_LIBRARY=@ITCL20_SRC_DIR@/itk/library \
+ IWIDGETS_LIBRARY=@ITCL20_SRC_DIR@/iwidgets2.0.0 \
+ LD_LIBRARY_PATH=$(SITE_LDPATH)
+
+ENV_ITCL21_DIST = \
+ TIX_LIBRARY=$(SDIST)/library \
+ TCL_LIBRARY=@ITCL21_SRC_DIR@/tcl7.5/library \
+ TK_LIBRARY=@ITCL21_SRC_DIR@/tk4.1/library \
+ ITCL_LIBRARY=@ITCL21_SRC_DIR@/itcl/library \
+ ITK_LIBRARY=@ITCL21_SRC_DIR@/itk/library \
+ IWIDGETS_LIBRARY=@ITCL21_SRC_DIR@/iwidgets2.1.0 \
+ LD_LIBRARY_PATH=$(BDIST)/unix-itcl2.1:$(SITE_LDPATH)
+
+dist_tk40:
+ @echo
+ @echo ======================== tk40_dist
+ @echo
+ -$(ENV_TK40_DIST) ldd $(BDIST)/unix-tk4.0/tixwish
+ $(ENV_TK40_DIST) $(BDIST)/unix-tk4.0/tixwish Driver.tcl $(SUBSETS)
+
+dist_tk41:
+ @echo
+ @echo ======================== tk41_dist
+ @echo
+ -$(ENV_TK41_DIST) ldd $(BDIST)/unix-tk4.1/tixwish
+ $(ENV_TK41_DIST) $(BDIST)/unix-tk4.1/tixwish Driver.tcl $(SUBSETS)
+
+dist_itcl20:
+ @echo
+ @echo ======================== itcl20_dist
+ @echo
+ -$(ENV_ITCL20_DIST) ldd $(BDIST)/unix-itcl2.0/itixwish
+ $(ENV_ITCL20_DIST) $(BDIST)/unix-itcl2.0/itixwish Driver.tcl $(SUBSETS)
+
+dist_itcl21:
+ @echo
+ @echo ======================== itcl21_dist
+ @echo
+ -$(ENV_ITCL21_DIST) ldd $(BDIST)/unix-itcl2.1/itixwish
+ $(ENV_ITCL21_DIST) $(BDIST)/unix-itcl2.1/itixwish Driver.tcl $(SUBSETS)
diff --git a/tix/tests/README b/tix/tests/README
new file mode 100644
index 00000000000..13deba5f2ae
--- /dev/null
+++ b/tix/tests/README
@@ -0,0 +1,58 @@
+ Tix Test Suite
+ --------------
+COPYRIGHT
+
+ Copyright (c) 1996, Expert Interface Technologies
+
+ See the file "license.terms" for information on usage and
+ redistribution of this file, and for a DISCLAIMER OF ALL
+ WARRANTIES.
+
+EXECUTING TEST SUITES
+
+UNIX --
+
+ 1) cd to the test/ subdirectory.
+
+ 2) To execute all of the test suite for all compilation targets, run:
+
+ make all
+
+ 3) To execute all of the test suites for a single compilation
+ target, run:
+
+ make unix-tk4.0
+ or make unix-itcl2.0
+ or make unix-itcl2.1
+ or make unix-tk4.1
+
+ 4) To execute a specific test only, you must invoke the apropriate
+ executable explicitly:
+
+ ../unix-tk4.0/tixwish Driver.tcl general/select.tcl
+
+ executes the test file general/select.tcl for the unix-tk4.0
+ compilation target.
+
+ ../unix-tk4.0/tixwish Driver.tcl general
+
+ executes all the test files in the general/ subdirectory for the
+ unix-tk4.0 compilation target.
+
+WINDOWS --
+
+ 1) Open the DOS command window.
+
+ 2) cd to the test/ subdirectory in the Tix source tree.
+
+ 3) Run the following line in the DOS window to execute all the tests.
+
+ txwish41.exe Driver.tcl
+
+ 4) To select a specific test, try
+
+ txwish41.exe Driver.tcl general/select.tcl
+ txwish41.exe Driver.tcl general
+
+ ... etc
+
diff --git a/tix/tests/Test.tcl b/tix/tests/Test.tcl
new file mode 100755
index 00000000000..b2e605232ca
--- /dev/null
+++ b/tix/tests/Test.tcl
@@ -0,0 +1,60 @@
+#! /bin/sh
+# the next line restarts using tclsh \
+exec tclsh "$0" "$@"
+
+# Test.tcl --
+#
+# This file executes the Tix test suite for the Unix platform.
+# Don't execute this file directly. Read the README file in this
+# directory first.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+set targets [lindex $argv 0]
+set argvfiles [lrange $argv 1 end]
+
+set env(WAITTIME) 200
+
+set genDirs {
+ general xpm hlist
+}
+
+set env(TCL_LIBRARY) $env(TEST_TCL_LIBRARY)
+set env(TK_LIBRARY) $env(TEST_TK_LIBRARY)
+set env(ITCL_LIBRARY) $env(TEST_ITCL_LIBRARY)
+set env(ITK_LIBRARY) $env(TEST_ITK_LIBRARY)
+set BINSRC_DIR $env(TEST_BINSRC_DIR)
+
+catch {
+ unset env(TIX_DEBUG_INTERACTIVE)
+}
+
+set load(bin) $BINSRC_DIR/../tk4.1/unix/wish
+set tk40(bin) $BINSRC_DIR/unix-tk4.0/tixwish
+set tk41(bin) $BINSRC_DIR/unix-tk4.1/tixwish
+set tk42(bin) $BINSRC_DIR/unix-tk4.2/tixwish
+set itcl20(bin) $BINSRC_DIR/unix-itcl2.0/itixwish
+set itcl21(bin) $BINSRC_DIR/unix-itcl2.1/itixwish
+
+if ![info exists env(LD_LIBRARY_PATH)] {
+ set env(LD_LIBRARY_PATH) ""
+}
+if [info exists env(TEST_LDPATHS)] {
+ set env(LD_LIBRARY_PATH) $env(TEST_LDPATHS):$env(LD_LIBRARY_PATH)
+}
+
+foreach t $targets {
+ upvar #0 $t target
+
+ puts "Executing ---\n"
+ puts "env TCL_LIBRARY=$env(TCL_LIBRARY) TK_LIBRARY=$env(TK_LIBRARY) ITCL_LIBRARY=$env(ITCL_LIBRARY) ITK_LIBRARY=$env(ITK_LIBRARY) LD_LIBRARY_PATH=$env(LD_LIBRARY_PATH) TIX_LIBRARY=$env(TIX_LIBRARY) $target(bin)"
+ puts ""
+
+
+ puts "Testing target $t with executable $target(bin)"
+ eval exec $target(bin) Driver.tcl $argvfiles >@ stdout 2>@ stderr
+}
diff --git a/tix/tests/cleanup/cleanup.tcl b/tix/tests/cleanup/cleanup.tcl
new file mode 100644
index 00000000000..b76f44d0289
--- /dev/null
+++ b/tix/tests/cleanup/cleanup.tcl
@@ -0,0 +1,28 @@
+# cleanup.tcl --
+#
+# This program tests whether whether there is any garbage left
+# after all the test files are executed. If so, either Tix has
+# resource leak or the test suite doesn't clean up properly.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+ return "Testing resource leaks"
+}
+
+proc Test {} {
+ global testConfig
+
+ if {$testConfig(VERBOSE) >= 20} {
+ foreach image [image names] {
+ puts "Warning: \[resource leak\] image $image of type [image type $image]"
+ foreach option [$image configure] {
+ puts " $option"
+ }
+ }
+ }
+}
diff --git a/tix/tests/cleanup/files b/tix/tests/cleanup/files
new file mode 100644
index 00000000000..4dae806d004
--- /dev/null
+++ b/tix/tests/cleanup/files
@@ -0,0 +1 @@
+cleanup.tcl \ No newline at end of file
diff --git a/tix/tests/files b/tix/tests/files
new file mode 100644
index 00000000000..747a4781423
--- /dev/null
+++ b/tix/tests/files
@@ -0,0 +1,24 @@
+# List of tests to execute.
+# Format:
+#
+# {<file/directory name> <Description> <List of conditions>}
+# {<file/directory name> <Description> <List of conditions>}
+# ...
+#
+# the conditions are AND'ed. Target is taken only if all conditions
+# are true
+
+{general }
+{xpm {i pixmap} }
+{hlist {c tixHList} }
+{load {c load} }
+{tlist {c tixTList} }
+{grid {c tixGrid} }
+{itcl {c @scope} }
+
+# This following subdirectory tests whether there is any garbage left
+# after all the test files are executed. If so, either Tix has
+# resource leak or the test suite doesn't clean up properly.
+#
+
+{cleanup }
diff --git a/tix/tests/general/NoteBook.tcl b/tix/tests/general/NoteBook.tcl
new file mode 100644
index 00000000000..c68a5301171
--- /dev/null
+++ b/tix/tests/general/NoteBook.tcl
@@ -0,0 +1,60 @@
+proc About {} {
+ return "Testing the notebook widgets"
+}
+
+proc NoteBookPageConfig {w pages} {
+ foreach page $pages {
+ Assert {"x[$w pagecget $page -label]" == "x$page"}
+ Assert {"x[$w pageconfigure $page -label]" == "x-label {} {} {} $page"}
+ $w pageconfigure $page -label foo
+ Assert {"x[$w pagecget $page -label]" == "xfoo"}
+ update
+ }
+}
+
+proc Test {} {
+ foreach class {tixListNoteBook tixNoteBook tixStackWindow} {
+ set w [$class .d]
+ pack $w
+ update
+
+ set pages {1 2 3 4 5 6 1111111112221}
+
+ foreach page $pages {
+ if {$class == "tixListNoteBook"} {
+ $w subwidget hlist add $page -itemtype imagetext \
+ -image [tix getimage folder] -text $page
+ }
+ set p [$w add $page -label $page]
+ for {set x 1} {$x < 10} {incr x} {
+ button $p.$x -text $x
+ pack $p.$x -fill x
+ }
+ }
+
+ foreach page $pages {
+ $w raise $page
+ Assert {"x[$w raised]" == "x$page"}
+ update
+ }
+
+ Assert {[string compare $pages [$w pages]] == 0}
+
+ # test the "hooking" of the notebook frame subwidget
+ #
+ #
+ if {$class == "tixNoteBook"} {
+ NoteBookPageConfig $w $pages
+ }
+
+ foreach page $pages {
+ Assert {"x[$w pagecget $page -raisecmd]" == "x"}
+# Assert {"x[$w pageconfigure $page -raisecmd]" == "x-raisecmd {} {} {} {}"}
+ $w pageconfigure $page -raisecmd "RaiseCmd $page"
+ Assert {"x[$w pagecget $page -raisecmd]" == "xRaiseCmd $page"}
+ update
+ }
+
+ destroy $w
+ }
+}
diff --git a/tix/tests/general/api.tcl b/tix/tests/general/api.tcl
new file mode 100644
index 00000000000..7dcf278944d
--- /dev/null
+++ b/tix/tests/general/api.tcl
@@ -0,0 +1,254 @@
+# api.tcl --
+#
+# Performs a comprehensive test on all the Tix widgets and
+# commands. This test knows the types and arguments of many
+# common Tix widget methods. It calls each widget method and
+# ensure that it work as expected.
+#
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+set depd(init) ""
+set info(init) "Initialization, find out all the widget classes"
+set depd(wcreate) "init"
+set info(wcreate) "Try to create each widget"
+set depd(method) "init wcreate"
+set info(method) "Try to call each public method of all widgets"
+set depd(config-state) "init wcreate method"
+set info(config-state) "Configuring -state of widgets"
+
+proc APITest:init {} {
+ global widCmd cmdNames auto_index testConfig
+
+ TestBlock api-1.1 {Find out all the widget classes} {
+ # (1) Stores all the Tix commands in the associative array
+ # cmdNames
+ #
+ foreach cmd [info commands tix*] {
+ if [regexp : $cmd] {
+ continue
+ }
+ set cmdNames($cmd) ""
+ }
+
+ foreach name [array names auto_index "tix*:AutoLoad"] {
+ if [regsub {:AutoLoad} $name "" cmd] {
+ set cmdNames($cmd) ""
+ }
+ }
+
+ # (3). Don't want to mess with the console routines
+ #
+ foreach name [array names cmdNames] {
+ if [string match tixCon* $name] {
+ catch {
+ unset cmdNames($name)
+ }
+ }
+ }
+
+ # (2) Find out the names of the widget creation commands
+ #
+ foreach cmd [lsort [array names cmdNames]] {
+ if [info exists $cmd\(superClass\)] {
+ if {[set $cmd\(superClass\)] == ""} {
+ continue
+ }
+ }
+ switch -regexp -- $cmd {
+ {(DoWhenIdle)|(:)} {
+ continue
+ }
+ }
+
+ if [info exists err] {
+ unset err
+ }
+
+ catch {
+ auto_load $cmd
+ }
+ catch {
+ if {[uplevel #0 set $cmd\(isWidget\)] == 1} {
+ if {$testConfig(VERBOSE) > 20} {
+ puts "Found widget class: $cmd"
+ }
+ set widCmd($cmd) ""
+ }
+ }
+ }
+ }
+}
+
+proc APITest:wcreate {} {
+ global widCmd testConfig
+
+ TestBlock api-2 {Find out all the widget classes} {
+ foreach cls [lsort [array names widCmd]] {
+ if {[uplevel #0 set $cls\(virtual\)] == 1} {
+ # This is a virtual base class. Skip it.
+ #
+ continue
+ }
+
+ TestBlock api-2.1-$cls "Create widget of class: $cls" {
+ $cls .c
+ if ![tixStrEq [winfo toplevel .c] .c] {
+ pack .c -expand yes -fill both
+ }
+ update
+ }
+
+ TestBlock api-2.2-$cls "Widget Deletion" {
+ catch {
+ destroy .c
+ }
+
+ frame .c
+ update idletasks
+ global .c
+ if {[info exists .c] && [array names .c] != "context"} {
+ catch {
+ parray .c
+ }
+ catch {
+ puts [set .c]
+ }
+ error "widget record has not been deleted properly"
+ }
+ }
+ catch {
+ destroy .c
+ }
+ }
+ }
+}
+
+proc APITest:method {} {
+ global widCmd testConfig
+
+ TestBlock api-3 {Call all the methods of a widget class} {
+
+ foreach cls [lsort [array names widCmd]] {
+ if {[uplevel #0 set $cls\(virtual\)] == 1} {
+ continue
+ }
+
+ TestBlock api-3.1-$cls "Widget class: $cls" {
+ $cls .c
+
+ upvar #0 $cls classRec
+ foreach method [lsort $classRec(methods)] {
+ TestBlock api-3.1.1 "method: $method" {
+ catch {
+ .c $method
+ }
+ }
+ }
+ }
+ catch {
+ destroy .c
+ }
+ }
+ }
+}
+
+proc APITest:config-state {} {
+ global widCmd testConfig
+
+ TestBlock api-4 {Call the config-state method} {
+
+ foreach cls [lsort [array names widCmd]] {
+ if {[uplevel #0 set $cls\(virtual\)] == 1} {
+ continue
+ }
+
+ $cls .c
+ catch {
+ pack .c
+ }
+ if [catch {.c cget -state}] {
+ destroy .c
+ continue
+ }
+
+ if [tixStrEq $cls tixBalloon] {
+ destroy .c
+ continue
+ }
+
+ TestBlock api-4.1-$cls "Class: $cls" {
+ .c config -state disabled
+ Assert {[tixStrEq [.c cget -state] "disabled"]}
+ update
+ Assert {[tixStrEq [.c cget -state] "disabled"]}
+
+ .c config -state normal
+ Assert {[tixStrEq [.c cget -state] "normal"]}
+ update
+ Assert {[tixStrEq [.c cget -state] "normal"]}
+
+
+ .c config -state disabled
+ Assert {[tixStrEq [.c cget -state] "disabled"]}
+ .c config -state normal
+ Assert {[tixStrEq [.c cget -state] "normal"]}
+
+ }
+ catch {
+ destroy .c; update
+ }
+ }
+ }
+}
+
+proc APITest {t {level 0}} {
+ global depd tested info
+
+ if {$level > 300} {
+ error "possibly circular dependency"
+ }
+
+ set tested(none) 1
+
+ if [info exist tested($t)] {
+ return
+ }
+ foreach dep $depd($t) {
+ if {![info exists tested($dep)]} {
+ APITest $dep [expr $level + 1]
+ }
+ }
+
+ if {$t == "all"} {
+ set tested($t) 1
+ return
+ } else {
+ update
+ eval APITest:$t
+ set tested($t) 1
+ }
+}
+
+proc About {} {
+ return "Tix API Testing Suite"
+}
+
+proc Test {} {
+ global depd env
+
+ if [info exists env(APT_SUBSET)] {
+ set tests $env(APT_SUBSET)
+ } else {
+ set tests [array names depd]
+ }
+
+ foreach test $tests {
+ APITest $test
+ }
+}
+
diff --git a/tix/tests/general/cmderror.tcl b/tix/tests/general/cmderror.tcl
new file mode 100644
index 00000000000..1ff2d4dd132
--- /dev/null
+++ b/tix/tests/general/cmderror.tcl
@@ -0,0 +1,49 @@
+# cmderror.tcl --
+#
+# This program tests whether command handler errors are processed
+# properly by the Tix toolkit.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+ return "Testing command handler errors are processed properly"
+}
+
+proc Test {} {
+ global cmdHandlerCalled
+
+ if {![string compare [info command tixCmdErrorHandler] ""]} {
+ if ![auto_load tixCmdErrorHandler] {
+ TestAbort "toolkit error: procedure \"tixCmdErrorHandler\" not implemented"
+ }
+ }
+ rename tixCmdErrorHandler _default_tixCmdErrorHandler
+ proc tixCmdErrorHandler {msg} {
+ global cmdHandlerCalled
+ set cmdHandlerCalled 1
+ }
+
+ # We cause an error to occur in the -command handler of the combobox
+ # widget. Such an error shouldn't cause the operation to fail.
+ # See the programmer's documentation of tixCmdErrorHandler for details.
+ #
+ catch {
+ tixComboBox .c -command CmdNotFound
+ .c invoke
+ set cmdNotFailed 1
+ }
+ Assert {[info exists cmdNotFailed]}
+ Assert {[info exists cmdHandlerCalled]}
+
+ # Clean up
+ #
+ destroy .c
+ rename tixCmdErrorHandler ""
+ rename _default_tixCmdErrorHandler tixCmdErrorHandler
+ unset cmdHandlerCalled
+
+}
diff --git a/tix/tests/general/combobox.tcl b/tix/tests/general/combobox.tcl
new file mode 100644
index 00000000000..870fadb713f
--- /dev/null
+++ b/tix/tests/general/combobox.tcl
@@ -0,0 +1,107 @@
+# combobox.tcl --
+#
+# Tests the ComboBox widget.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+ return "Testing the ComboBox widget."
+}
+
+proc cbTest_Command {args} {
+ global cbTest_selected
+
+ set cbTest_selected [tixEvent value]
+}
+
+proc cbTest_ListCmd {w} {
+ global counter
+
+ incr counter
+
+ $w subwidget listbox delete 0 end
+ $w subwidget listbox insert end 0
+ $w subwidget listbox insert end 1
+ $w subwidget listbox insert end 2
+}
+
+
+proc Test {} {
+ global cbTest_selected
+
+ for {set dropdown 1} {$dropdown >= 0} {incr dropdown -1} {
+
+ TestBlock combo-1.1 {Config -value} {
+ set w [tixComboBox .c -command cbTest_Command -dropdown $dropdown \
+ -editable true]
+ pack $w
+ update
+ set val "Testing some value .."
+ $w config -value $val
+ Assert {[tixStrEq "$cbTest_selected" $val]}
+ }
+
+ TestBlock combo-1.2 {selection from listbox} {
+ $w subwidget listbox insert end "entry 0"
+ $w subwidget listbox insert end "entry 1"
+ $w subwidget listbox insert end "entry 2"
+
+ for {set x 0} {$x <= 2} {incr x} {
+ Click [$w subwidget arrow]
+ update
+
+ if $dropdown {
+ ClickListboxEntry [$w subwidget listbox] $x single
+ } else {
+ ClickListboxEntry [$w subwidget listbox] $x single
+ ClickListboxEntry [$w subwidget listbox] $x double
+ }
+ update
+
+ Assert {[tixStrEq "$cbTest_selected" "entry $x"]}
+ }
+ }
+
+ TestBlock combo-1.3 {invokation by keyboard} {
+ set val "Testing by key with \\ slashes"
+ KeyboardString [$w subwidget entry] $val
+ KeyboardEvent [$w subwidget entry] <Return>
+ update
+
+ Assert {[tixStrEq "$cbTest_selected" "$val"]}
+ }
+
+ catch {
+ destroy $w
+ }
+ }
+
+ TestBlock combo-2.1 {-listcmd of ComboBox} {
+ global counter
+ set counter 0
+ tixComboBox .c -listcmd "cbTest_ListCmd .c"
+ pack .c -expand yes -fill both
+ update
+
+ Click [.c subwidget arrow]
+ update
+ Assert {$counter == 1}
+ Click [.c subwidget arrow]
+ update
+
+ Click [.c subwidget arrow]
+ update
+ Click [.c subwidget arrow]
+ update
+ Assert {$counter == 2}
+
+
+ Assert {[.c subwidget listbox get 0] == "0"}
+ Assert {[.c subwidget listbox get 1] == "1"}
+ Assert {[.c subwidget listbox get 2] == "2"}
+ }
+}
diff --git a/tix/tests/general/dirbox.tcl b/tix/tests/general/dirbox.tcl
new file mode 100644
index 00000000000..c672cd069a0
--- /dev/null
+++ b/tix/tests/general/dirbox.tcl
@@ -0,0 +1,281 @@
+# dirbox.tcl --
+#
+# Tests the DirSelectBox and DirSelectDialog widgets.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+ return "Testing the DirSelectBox and DirSelectDialog widgets."
+}
+
+# Try to configure the directory of a widget and see if it satisfy all
+# the requirements:
+#
+# 1: Should return error for non-existant directory, preserving
+# the old directory
+#
+# 2: When given a non-normalized path, it should normalize it.
+#
+proc TestConfigDirectory {class spec pack} {
+ global errorInfo
+
+ set w .w
+
+ if [winfo exists $w] {
+ destroy $w
+ }
+
+ TestBlock config-dir-1.1 "Simple creating of $class" {
+ # Creation without the spec. The default value should be normalized
+ #
+
+ # The default value should always be an absolute path
+ #
+ $class .w
+ set value [$w cget $spec]
+ Assert {[tixFSIsNorm_os $value]} 0 cont
+ }
+ catch {
+ destroy .w
+ }
+
+ TestBlock config-dir-1.2 "Creation with arbitrary (perhaps invalid) path" {
+ foreach item [GetCases_FsNormDir] {
+ if [info exists errorInfo] {
+ set errorInfo ""
+ }
+
+ set text [lindex $item 0]
+ set want [lindex $item 1]
+ set wanterr [lindex $item 2]
+
+ set err [catch {
+ set w [$class .w $spec $text]
+ set got [$w cget -value]
+ }]
+ Assert {$err == $wanterr}
+ if {!$err} {
+ set want [tixFSDisplayName $want]
+ Assert {[tixStrEq $want $got]}
+ }
+
+ catch {
+ destroy .w
+ }
+ }
+ }
+
+ catch {
+ destroy .w
+ }
+
+ TestBlock config-dir-1.2 "Config with arbitrary (perhaps invalid) path" {
+ set w [$class .w]
+
+ foreach item [GetCases_FsNormDir] {
+ if [info exists errorInfo] {
+ set errorInfo ""
+ }
+
+ set text [lindex $item 0]
+ set want [lindex $item 1]
+ set wanterr [lindex $item 2]
+
+ set err [catch {
+ $w config $spec $text
+ set got [$w cget -value]
+ }]
+ Assert {$err == $wanterr}
+
+ if $err {
+ # Should hold the previous -value
+ #
+ set value [$w cget $spec]
+ Assert {[tixFSIsNorm_os $value]} 0 cont
+ } else {
+ set value [$w cget $spec]
+ Assert {[tixFSIsNorm_os $value]} 0 cont
+
+ set want [tixFSDisplayName $want]
+ Assert {[tixStrEq $want $got]}
+ }
+
+ if $pack {
+ pack $w -expand yes -fill both -padx 10 -pady 10
+ update idletasks
+ }
+ }
+ }
+
+ catch {
+ destroy $w
+ }
+}
+
+proc TestRand {max} {
+ global testRandSeed
+
+ if ![info exists testRandSeed] {
+ set testRandSeed [expr [lindex [time {cd [pwd]}] 0] * 47 + 147]
+ }
+
+ set x [expr ($testRandSeed + 47) * [lindex [time {cd [pwd]}] 0]]
+ set x [expr $x + 7 * $max]
+ set testRandSeed [expr ($x % $max) + $max]
+
+ return [expr $testRandSeed % $max]
+}
+
+# TestHListWildClick --
+#
+# Randomly click around an hlist widget
+#
+# Args:
+# hlist:widget The HList widget.
+# mode: Either "single" or "double", indicating which type
+# of mouse click is desired.
+# cmd: Command to call after each click.
+#
+proc TestHListWildClick {hlist mode cmd} {
+ # The percentage chance that we sould traverse to a child node
+ #
+ set chance 40
+
+ for {set x 0} {$x < 10} {incr x} {
+ set node [$hlist info children ""]
+ if [tixStrEq $node ""] {
+ return
+ }
+
+ while 1 {
+ set ran [TestRand 100]
+ if {$ran >= $chance} {
+ break
+ }
+ set children [$hlist info children $node]
+ if [tixStrEq $children ""] {
+ break
+ }
+ set node [lindex $children [expr $ran % [llength $children]]]
+ }
+
+ TestBlock wild-click-1.1 "clicking \"$node\" of HList" {
+ if {![regexp -nocase alex [$hlist info data $node]]} {
+ #
+ # dirty fix: "alex" may be an AFS mounted file. Reading this
+ # directory may start an FTP session, which may be slow like
+ # hell
+ #
+ ClickHListEntry $hlist $node $mode
+ eval $cmd [list $node]
+ }
+ }
+ }
+}
+
+
+proc DirboxTest_Cmd {args} {
+ global dirboxTest_selected
+
+ set dirboxTest_selected [tixEvent value]
+}
+
+proc DirboxTest_Compare {isDirBox w h node} {
+ global dirboxTest_selected
+
+ set selFile [$h info data $node]
+
+ Assert {[tixStrEq "$dirboxTest_selected" "$selFile"]}
+ set dirboxTest_selected ""
+
+ if {$isDirBox} {
+ set entry [$w subwidget dircbx subwidget combo subwidget entry]
+ set entText [$entry get]
+ Assert {[tixStrEq "$entText" "$selFile"]}
+ }
+}
+
+proc Test {} {
+ global dirboxTest_selected
+
+ #------------------------------------------------------------
+ # (1) DirList
+ #------------------------------------------------------------
+
+ TestBlock dirbox-1.1 {Generic testing of tixDirList} {
+ TestConfigDirectory tixDirList -value 1
+ }
+
+ TestBlock dirbox-1.2 {Wild click on the hlist subwidget} {
+ set dirboxTest_selected ""
+ set w [tixDirList .c -command DirboxTest_Cmd]
+ set h [$w subwidget hlist]
+ pack $w -expand yes -fill both
+ TestHListWildClick $h double "DirboxTest_Compare 0 $w $h"
+ }
+ catch {
+ destroy $w
+ }
+
+ #------------------------------------------------------------
+ # (2) DirTree
+ #------------------------------------------------------------
+
+ TestBlock dirbox-2.1 {Generic testing of tixDirTree} {
+# TestConfigDirectory tixDirTree -value 1
+ }
+
+ TestBlock dirbox-2.2 {Wild click on the hlist subwidget} {
+ set dirboxTest_selected ""
+ set w [tixDirTree .c -command DirboxTest_Cmd]
+ set h [$w subwidget hlist]
+ pack $w -expand yes -fill both
+# TestHListWildClick $h double "DirboxTest_Compare 0 $w $h"
+ }
+ catch {
+ destroy $w
+ }
+
+ #------------------------------------------------------------
+ # (3) DirBox
+ #------------------------------------------------------------
+
+ TestBlock dirbox-3.1 {Generic testing of tixDirSelectBox} {
+# TestConfigDirectory tixDirSelectBox -value 1
+ }
+
+ TestBlock dirbox-3.2 {Wild click on the hlist subwidget} {
+ set dirboxTest_selected ""
+ set w [tixDirSelectBox .c -command DirboxTest_Cmd]
+ set h [$w subwidget dirlist subwidget hlist]
+ pack $w -expand yes -fill both
+# TestHListWildClick $h double "DirboxTest_Compare 0 $w $h"
+ }
+ catch {
+ destroy $w
+ }
+
+ TestBlock dirbox-4.1 {-disablecallback option} {
+ global dirbox_called
+ tixDirList .c -command dirbox_callback
+ pack .c
+ set dirbox_called 0
+ .c config -disablecallback 1
+ .c config -value [pwd]
+ .c config -disablecallback 0
+ Assert {$dirbox_called == 0}
+ }
+ catch {
+ destroy .c
+ }
+}
+
+proc dirbox_callback {args} {
+ global dirbox_called
+ set dirbox_called 1
+}
+
diff --git a/tix/tests/general/draw.tcl b/tix/tests/general/draw.tcl
new file mode 100644
index 00000000000..6206f007410
--- /dev/null
+++ b/tix/tests/general/draw.tcl
@@ -0,0 +1,22 @@
+# draw.tcl --
+#
+# Test the drawing functions in Tix.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+ return "Test the drawing functions in Tix."
+}
+
+proc Test {} {
+ TestBlock draw-1.1 {tixTmpLine} {
+ tixTmpLine 0 50 300 50
+ tixTmpLine 0 50 300 50
+ tixTmpLine 0 50 300 50 .
+ tixTmpLine 0 50 300 50 .
+ }
+}
diff --git a/tix/tests/general/event0.tcl b/tix/tests/general/event0.tcl
new file mode 100644
index 00000000000..fd46b6edba7
--- /dev/null
+++ b/tix/tests/general/event0.tcl
@@ -0,0 +1,100 @@
+proc About {} {
+ return "Testing the event emulation routines in the test suite"
+}
+
+proc TestEntry_Invoke {w} {
+ global testEntry_Invoked testEntry_value1
+
+ set testEntry_Invoked 1
+ set testEntry_value1 [$w get]
+}
+
+proc Test {} {
+ global foo
+ set foo 0
+
+ TestBlock event0-1.1 {Typing return in an entry widget} {
+ global testEntry_Invoked testEntry_value0 testEntry_value1
+
+ set testEntry_Invoked 0
+ entry .e -textvariable testEntry_value0
+ set testEntry_value0 "Entering some text ..."
+ bind .e <Return> "TestEntry_Invoke .e"
+ pack .e
+ update
+
+ KeyboardEvent .e <Return>
+ update
+ Assert {$testEntry_Invoked == 1}
+ Assert {$testEntry_value0 == $testEntry_value1}
+ }
+
+ TestBlock event0-1.2 {Typing characters in an entry widget} {
+ set testEntry_value0 ""
+ set val "Typing the keyboard ..."
+
+ focus .e
+ .e delete 0 end
+ update
+ KeyboardString .e $val
+ update
+ Assert {[tixStrEq "$testEntry_value0" "$val"]}
+ }
+
+ TestBlock event0-1.3 {Typing characters and slashes in an entry widget} {
+ set testEntry_value0 ""
+ set val "Typing the \\ keyboard ..."
+
+ focus .e
+ .e delete 0 end
+ KeyboardString .e $val
+ update
+ Assert {[tixStrEq "$testEntry_value0" "$val"]}
+
+ destroy .e
+ }
+
+ TestBlock event0-1.4 {Testing ClickListboxEntry} {
+ listbox .l -selectmode single
+ .l insert end "index 0"
+ .l insert end "index 1"
+ .l insert end "index 2"
+
+ pack .l; update
+
+ for {set x 0} {$x <= 2} {incr x} {
+ ClickListboxEntry .l $x single
+ update
+ Assert {[.l index active] == $x}
+ Assert {[.l curselection] == $x}
+ }
+
+ destroy .l
+ update
+ }
+
+ TestBlock event0-1.5 {Clicking a button} {
+ button .b -command "set foo 1"
+ pack .b; update
+
+ Click .b
+ Assert {$foo == 1}
+ }
+
+ TestBlock event0-1.6 {Drag and selecting a combobox} {
+ tixComboBox .c
+ .c insert end 10
+ .c insert end 10
+ .c insert end 10
+ .c insert end 10
+ .c insert end 10
+ pack .c; update
+
+ HoldDown [.c subwidget arrow]
+ Drag [.c subwidget listbox] 10 10
+ Release [.c subwidget listbox] 10 10
+ Release [.c subwidget arrow] -30 30
+
+ Assert {[.c cget -value] == "10"}
+ }
+}
diff --git a/tix/tests/general/filebox.tcl b/tix/tests/general/filebox.tcl
new file mode 100644
index 00000000000..4ded2be0854
--- /dev/null
+++ b/tix/tests/general/filebox.tcl
@@ -0,0 +1,133 @@
+# filebox.tcl --
+#
+# Tests the File selection box and dialog widget.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+ return "Testing the (Ex)FileSelectBox and (Ex)FileSelectDialog widgets."
+}
+
+proc FdTest_GetFile {args} {
+ global fdTest_selected
+
+ set fdTest_selected [tixEvent value]
+}
+
+proc Test {} {
+ global fdTest_fullPath
+
+ if [tixStrEq [tix platform] "unix"] {
+ set fdTest_fullPath /etc/passwd
+ } else {
+ set fdTest_fullPath C:\\Windows\\System.ini
+ }
+
+ Test_FileSelectBox
+ Test_FileSelectDialog
+
+ Test_ExFileSelectBox
+ Test_ExFileSelectDialog
+}
+
+proc Test_FileSelectBox {} {
+ global fdTest_selected fdTest_fullPath
+
+ TestBlock filebox-1.1 {FileSelectBox} {
+ set w [tixFileSelectBox .f -command FdTest_GetFile]
+ pack $w -expand yes -fill both
+ update
+
+ InvokeComboBoxByKey [$w subwidget selection] "$fdTest_fullPath"
+ Assert {[tixStrEq $fdTest_selected "$fdTest_fullPath"]}
+ }
+ catch {
+ destroy $w
+ }
+}
+
+proc Test_FileSelectDialog {} {
+ global fdTest_selected fdTest_fullPath
+
+ TestBlock filebox-2.1 {FileSelectDialog} {
+ set w [tixFileSelectDialog .f -command FdTest_GetFile]
+ $w popup
+ update
+
+ InvokeComboBoxByKey [$w subwidget fsbox subwidget selection] \
+ "$fdTest_fullPath"
+ Assert {[tixStrEq $fdTest_selected "$fdTest_fullPath"]}
+ }
+ catch {
+ destroy $w
+ }
+}
+
+proc Test_ExFileSelectBox {} {
+ global fdTest_selected fdTest_fullPath
+
+ TestBlock filebox-3.1 {ExFileSelectBox} {
+ set w [tixExFileSelectBox .f -command FdTest_GetFile]
+ pack $w -expand yes -fill both
+ update
+
+ $w subwidget file config -selection "$fdTest_fullPath" \
+ -value "$fdTest_fullPath"
+ Assert {[tixStrEq $fdTest_selected "$fdTest_fullPath"]}
+ }
+
+ TestBlock filebox-3.2 {Keyboard input in ExFileSelectBox entry subwidget} {
+ set dirCbx [$w subwidget dir]
+ set fileCbx [$w subwidget file]
+ set okBtn [$w subwidget ok]
+
+ foreach file {Foo bar "Foo Bar"} {
+ set fdTest_selected ""
+
+ InvokeComboBoxByKey $fileCbx $file
+ set fullPath [tixFSJoin [$dirCbx cget -value] $file]
+ update
+
+ Assert {[tixStrEq "$fdTest_selected" "$fullPath"]}
+ }
+ }
+
+ TestBlock filebox-3.3 {Keyboard and then press OK} {
+ foreach file {bar "Foo Bar"} {
+ set fdTest_selected ""
+
+ SetComboBoxByKey $fileCbx $file
+ Click $okBtn
+ set fullPath [tixFSJoin [$dirCbx cget -value] $file]
+ update
+
+ Assert {[tixStrEq "$fdTest_selected" "$fullPath"]}
+ }
+ }
+
+ catch {
+ destroy $w
+ }
+}
+
+proc Test_ExFileSelectDialog {} {
+ global fdTest_selected fdTest_fullPath
+
+ TestBlock filebox-4.1 {ExFileSelectDialog} {
+ set w [tixExFileSelectDialog .f -command FdTest_GetFile]
+ $w popup
+ update
+
+ InvokeComboBoxByKey [$w subwidget fsbox subwidget file] \
+ $fdTest_fullPath
+ Assert {[tixStrEq $fdTest_selected "$fdTest_fullPath"]}
+ }
+
+ catch {
+ destroy $w
+ }
+}
diff --git a/tix/tests/general/files b/tix/tests/general/files
new file mode 100644
index 00000000000..21acdc020b3
--- /dev/null
+++ b/tix/tests/general/files
@@ -0,0 +1,20 @@
+testtmpl.tcl
+api.tcl
+minterp.tcl
+options.tcl
+labentry.tcl
+event0.tcl
+fs.tcl
+oop.tcl
+optmenu.tcl
+select.tcl
+slistbox.tcl
+var1.tcl
+NoteBook.tcl
+mwm.tcl
+cmderror.tcl
+dirbox.tcl
+filebox.tcl
+combobox.tcl
+samples.tcl
+draw.tcl
diff --git a/tix/tests/general/fs.tcl b/tix/tests/general/fs.tcl
new file mode 100644
index 00000000000..d2f1e86ca62
--- /dev/null
+++ b/tix/tests/general/fs.tcl
@@ -0,0 +1,236 @@
+# fs.tcl --
+#
+# Test the portable file handling ("FS") routines.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+ return "Testing portable file handling routines"
+}
+
+proc Test {} {
+ global tixPriv errorInfo
+
+ TestBlock fs-1.1 {tixFSPath command} {
+ if {$tixPriv(test:platform) == "windows"} {
+ # PATHNAME expected VPATH result
+ #-------------------------------------------------------
+ set list [list \
+ [list :px:\\C: C:\\ 0] \
+ [list :px:\\c: "" 1] \
+ ]
+ regsub -all :px: $list $tixPriv(WinPrefix) list
+
+ foreach item "$list" {
+ set vpath [lindex $item 0]
+ set want [lindex $item 1]
+ set experr [lindex $item 2]
+
+
+ TestBlock fs-1.1.1 "tixFSPath $vpath" {
+ set err [catch {
+ set got [tixFSPath $vpath]
+ }]
+
+ if $experr {
+ Assert {$err == $experr}
+ } else {
+ Assert {[tixStrEq $want $got]}
+ }
+ }
+ }
+ }
+ }
+
+ TestBlock fs-1.2 {tixFSIsNorm command} {
+ if {$tixPriv(test:platform) == "unix"} {
+
+ # PATHNAME to TEST expected result
+ #-------------------------------------------------------
+ set list {
+ {/home/ioi 1}
+ {/foo.bar 1}
+ {/.../foo 1}
+ {/.../foo/bar/... 1}
+ {/.../.foo/bar/... 1}
+ {/.../.f./bar/... 1}
+ {/.../.f./bar/... 1}
+ {/..a/... 1}
+ {"/. / " 1}
+ {//a 0}
+ {/a/b/ 0}
+ {/a/b// 0}
+ {/a/b/. 0}
+ {a/b 0}
+ {a/b/. 0}
+ {/./b 0}
+ {/../b 0}
+ {/../../b 0}
+ {/./a/../b/.. 0}
+ {~ioi 0}
+ {/~ioi 1}
+ {/ 1}
+ }
+ } else {
+ set list {
+ {C:/ 0}
+ {foo 0}
+ {c: 0}
+ {C: 1}
+ {C:\\Windows 1}
+ {C:\\ 0}
+ {C:\\..\\Windows 0}
+ {C:\\...\\Windows 1}
+ {C:\\.../Windows 1}
+ {C:\\.\\Windows 0}
+ {.. 0}
+ {..\\.. 0}
+ {..\\ 0}
+ {. 0}
+ {.\\. 0}
+ {.\\ 0}
+ {C:\\. 0}
+ {C:Windows 0}
+ {C:\\Windows\\App 1}
+ {"C:\\My Programs\\~App" 1}
+ }
+ }
+
+ foreach item $list {
+ set text [lindex $item 0]
+ set want [lindex $item 1]
+
+
+ TestBlock fs-1.2.1 "tixFSIsNorm $text" {
+ Assert {[tixFSIsNorm $text] == $want}
+ }
+ }
+ }
+
+ TestBlock fs-1.3 {tixFSNormDir command} {
+ foreach item [GetCases_FsNormDir] {
+ set text [lindex $item 0]
+ set want [lindex $item 1]
+ set wanterr [lindex $item 2]
+
+ if !$wanterr {
+ # Check test case error
+ Assert {[tixFSIsNorm $want]}
+ }
+
+ TestBlock fs-1.3.1 "tixFSNormDir $text" {
+ set err [catch {
+ set got [tixFSNormDir $text]
+ }]
+
+ Assert {$err == $wanterr}
+ if {!$err} {
+ Assert {[tixStrEq $want $got]}
+ }
+ }
+ }
+ }
+
+ TestBlock fs-1.4 {tixFSNorm command} {
+ set list [GetCases_FSNorm]
+
+ set appPWD [pwd]
+ foreach item $list {
+ set text [lindex $item 0]
+ set context [lindex $item 1]
+ set want [lindex $item 2]
+
+ TestBlock fs-1.4.1 "tixFSNorm $context $text" {
+ set lst [tixFSNorm $context $text]
+ set dir [lindex $lst 1]
+ Assert {[tixStrEq $want $dir]}
+ Assert {[tixStrEq [pwd] $appPWD]}
+ }
+ }
+ }
+
+ TestBlock fs-1.5 {tilde handling} {
+ if {$tixPriv(test:platform) == "unix"} {
+ set who "nobody"
+ if {[string comp $who "nobody"] == 0} {
+ catch {set who [exec whoami]}
+ }
+ if {[string comp $who "nobody"] == 0} {
+ catch {set who [exec logname]}
+ }
+ set home /
+ catch {
+ set home [glob ~$who]
+ }
+ set list {
+ {~$who {$home $home "" ""}}
+ {~ {$home $home "" ""}}
+ {~/*.* {$home/*.* $home "" "*.*"}}
+ {"~/*.* *.tcl" {"$home/*.* *.tcl" $home "" "*.* *.tcl"}}
+ }
+
+ foreach item $list {
+ set item [subst $item]
+ set text [lindex $item 0]
+ set want [lindex $item 1]
+
+ TestBlock fs-1.5.1 "tixFSNorm \[pwd\] $text" {
+ set list [tixFSNorm [pwd] $text]
+
+ Assert {
+ [tixStrEq [lindex $list 0] [lindex $want 0]] &&
+ [tixStrEq [lindex $list 1] [lindex $want 1]] &&
+ [tixStrEq [lindex $list 2] [lindex $want 2]] &&
+ [tixStrEq [lindex $list 3] [lindex $want 3]]
+ }
+ }
+ }
+ }
+ }
+
+ TestBlock fs-1.6 {tixFSVPath} {
+ if {$tixPriv(test:platform) == "unix"} {
+
+ # PATHNAME to TEST expected Causes error for
+ # result tixFSVPath?
+ #----------------------------------------------------------------
+ set list {
+ {. "" 1}
+ {foo "" 1}
+ {./ "" 1}
+ }
+ } else {
+ set list {
+ {. "" 1}
+ }
+ regsub -all ^:px: $list $tixPriv(WinPrefix) list
+ }
+
+ # (ToDo): write the test
+ #
+ }
+
+ TestBlock fs-2.1 {obsolete tests} {
+ # Some obsolete test. Should be taken out.
+ #
+ if {$tixPriv(test:platform) == "unix"} {
+ set home [glob ~]
+ if {$home == "/"} {
+ set homeprefix {}
+ } else {
+ set homeprefix $home
+ }
+
+ # it shouldn't do itemname substitution
+ #
+ Assert {[tixFileIntName *] == "*"}
+ Assert {[tixFileIntName ~/*] == "$homeprefix/*"}
+
+ Assert {[tixFileIntName /home/ioi/../foo/bar/..] == "/home/foo"}
+ }
+ }
+}
diff --git a/tix/tests/general/labentry.tcl b/tix/tests/general/labentry.tcl
new file mode 100644
index 00000000000..714fda12b75
--- /dev/null
+++ b/tix/tests/general/labentry.tcl
@@ -0,0 +1,52 @@
+# labentry.tcl --
+#
+# Tests the TixLabelEntry widget.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+ return "Testing the TixLabelEntry widget"
+}
+
+proc Test {} {
+ TestBlock labent-1.1 {LabelEntry focus management} {
+ set t [toplevel .t]
+
+ set w [tixLabelEntry .t.c -label "Stuff: "]
+ pack $w -padx 20 -pady 10
+ tixLabelEntry .t.d -label "Stuff: "
+ pack .t.d -padx 20 -pady 10
+ focus $w
+ update
+
+ set px [winfo pointerx $t]
+ set py [winfo pointery $t]
+ set W [winfo width $t]
+ set H [winfo height $t]
+
+ if {$W < 100} {
+ set W 100
+ }
+ if {$H < 100} {
+ set H 100
+ }
+
+ set mx [expr $px - $W / 2]
+ set my [expr $py - $H / 2]
+
+ # We must move the window under the cursor in order to test
+ # the current focus
+ #
+ wm geometry $t $W\x$H+$mx+$my
+ raise $t
+ update
+
+ Assert {[focus -lastfor $t] == [$w subwidget entry]}
+
+ destroy $t
+ }
+}
diff --git a/tix/tests/general/minterp.tcl b/tix/tests/general/minterp.tcl
new file mode 100644
index 00000000000..270f73f032b
--- /dev/null
+++ b/tix/tests/general/minterp.tcl
@@ -0,0 +1,60 @@
+# minterp.tcl
+#
+# Tests Tix running under multiple interpreters.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+ return "Tests Tix running under multiple interpreters."
+}
+
+proc Test {} {
+ global tix tcl_version
+ if ![string comp [info commands interp] ""] {
+ # Does not support multiple interpreters.
+ return
+ }
+
+ if {[lsearch [package names] Itcl] != -1} {
+ #
+ # multiple interpreters currently core dumps under itcl2.1
+ #
+# return
+ }
+
+ TestBlock minterp-1.1 {multiple interpreters} {
+ for {set x 0} {$x < 5} {incr x} {
+ global testConfig
+ interp create a
+ interp eval a "set dynlib [list $testConfig(dynlib)]"
+ if {[info exists tix(et)] && $tix(et) == 1} {
+ interp eval a {
+ catch {load "" Tk}
+ catch {load "" ITcl}
+ catch {load "" ITk}
+ catch {load "" Tclsam}
+ catch {load "" Tksam}
+ catch {load "" Tixsam}
+ }
+ } else {
+ interp eval a {
+ load "" Tk
+ load $dynlib Tix
+ }
+ }
+ interp eval a {
+ tixControl .d -label Test
+ tixComboBox .e -label Test
+ tixDirList .l
+ pack .l -expand yes -fill both
+ pack .d .e -expand yes -fill both
+ update
+ }
+ interp delete a
+ }
+ }
+}
diff --git a/tix/tests/general/mwm.tcl b/tix/tests/general/mwm.tcl
new file mode 100644
index 00000000000..5419351eaee
--- /dev/null
+++ b/tix/tests/general/mwm.tcl
@@ -0,0 +1,46 @@
+# mwm.tcl --
+#
+# Test tixMwm command.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+ return "Testing tixMwm command"
+}
+
+proc Test {} {
+ if ![string compare [info command tixMwm] ""] {
+ puts "(OK) The tixMwm command is not available."
+ return
+ }
+ if ![tixMwm ismwmrunning .] {
+ puts "(OK) Mwm is not running on this display."
+ return
+ }
+
+ toplevel .d
+ toplevel .e
+
+ test {tixMwm protocol .d add MY_PRINT_HELLO {"Print Hello" _H Ctrl<Key>H}}
+ wm protocol .d MY_PRINT_HELLO {puts Hello}
+
+ test {tixMwm protocol .e add MY_PRINT_HELLO {"Print Hello" _H Ctrl<Key>H}}
+ wm protocol .e MY_PRINT_HELLO {puts Hello}
+
+ test {destroy .d}
+
+ test {tixMwm protocol .e add MY_PRINT_HELLO {"Print Hello" _H Ctrl<Key>H}}
+ wm protocol .e MY_PRINT_HELLO {puts Hello}
+
+ test {tixMwm protocol . delete MY_PRINT_HELLO}
+ wm protocol . MY_PRINT_HELLO {}
+
+ test {tixMwm protocol .e add MY_PRINT_HELLO {"Print Hello" _H Ctrl<Key>H}}
+ wm protocol .e MY_PRINT_HELLO {puts Hello}
+
+ test {destroy .e}
+}
diff --git a/tix/tests/general/oop.tcl b/tix/tests/general/oop.tcl
new file mode 100644
index 00000000000..340e4cb91bf
--- /dev/null
+++ b/tix/tests/general/oop.tcl
@@ -0,0 +1,11 @@
+proc About {} {
+ return "Testing OOP features"
+}
+
+proc Test {} {
+ test {tix} {arg}
+ test {tixWidgetClass} {arg}
+ test {tixClass} {arg}
+ test {tixNoteBook} {arg}
+ test {tixAppContext} {arg}
+}
diff --git a/tix/tests/general/options.tcl b/tix/tests/general/options.tcl
new file mode 100644
index 00000000000..acb40f0384c
--- /dev/null
+++ b/tix/tests/general/options.tcl
@@ -0,0 +1,17 @@
+proc About {} {
+ return "Testing the option configuration of the Tix widgets"
+}
+
+proc Test {} {
+ test {tixComboBox .c -xxxxx} {missing}
+ test {tixComboBox .c -xxxxx xxx} {unknown}
+ test {tixComboBox .c -d xxx} {ambi}
+ test {tixComboBox .c -disab 0} {ambi}
+ test {tixComboBox .c -disablecal 0}
+ Assert {[.c cget -disablecallback] == 0}
+ Assert {[.c cget -disableca] == 0}
+ test {tixComboBox .d -histl 10}
+ Assert {[.d cget -histlimit] == 10}
+ Assert {[.d cget -histlim] == 10}
+ Assert {[.d cget -historylimit] == 10}
+}
diff --git a/tix/tests/general/optmenu.tcl b/tix/tests/general/optmenu.tcl
new file mode 100644
index 00000000000..6b0ea0150a2
--- /dev/null
+++ b/tix/tests/general/optmenu.tcl
@@ -0,0 +1,105 @@
+proc About {} {
+ return "Testing Option Menu widget"
+}
+
+proc Test {} {
+ tixOptionMenu .p -label "From File Format : " -command "selectproc input" \
+ -disablecallback 1 \
+ -options {
+ label.width 19
+ label.anchor e
+ menubutton.width 15
+ }
+
+ pack .p
+
+ .p add command text -label "Plain Text"
+ .p add command post -label "PostScript"
+ .p add command format -label "Formatted Text"
+ .p add command html -label "HTML"
+ .p add separator sep
+ .p add command tex -label "LaTeX"
+ .p add command rtf -label "Rich Text Format"
+
+ update
+
+ foreach ent [.p entries] {
+ test {.p delete $ent}
+ }
+
+ Assert {[.p subwidget menubutton cget -text] == {}}
+
+ test {destroy .p}
+
+ # Testing deleting "sep" at the end
+ #
+ tixOptionMenu .p -label "From File Format : " -command "selectproc input" \
+ -disablecallback 1 \
+ -options {
+ label.width 19
+ label.anchor e
+ menubutton.width 15
+ }
+
+
+ pack .p
+
+ .p add command text -label "Plain Text"
+ .p add command post -label "PostScript"
+ .p add command format -label "Formatted Text"
+ .p add command html -label "HTML"
+ .p add separator sep
+ .p add command tex -label "LaTeX"
+ .p add command rtf -label "Rich Text Format"
+
+ test {.p delete text}
+ test {.p delete post}
+ test {.p delete html}
+ test {.p delete format}
+ test {.p delete tex}
+ test {.p delete rtf}
+ test {.p delete sep}
+
+ Assert {[.p subwidget menubutton cget -text] == {}}
+ test {destroy .p}
+
+ # Testing deleting "sep" as the second-last one
+ #
+ tixOptionMenu .p -label "From File Format : " -command "selectproc input" \
+ -disablecallback 1 \
+ -options {
+ label.width 19
+ label.anchor e
+ menubutton.width 15
+ }
+
+
+ pack .p
+
+ .p add command text -label "Plain Text"
+ .p add command post -label "PostScript"
+ .p add command format -label "Formatted Text"
+ .p add command html -label "HTML"
+ .p add separator sep
+ .p add command tex -label "LaTeX"
+ .p add command rtf -label "Rich Text Format"
+
+ test {.p delete text}
+ global .p
+ Assert {[info exists .p(text,type)] == 0}
+ Assert {[info exists .p(text,name)] == 0}
+ Assert {[info exists .p(text,label)] == 0}
+ test {.p delete post}
+ test {.p delete html}
+ test {.p delete format}
+ test {.p delete tex}
+
+ Assert {[.p cget -value] == "rtf"}
+ test {.p delete sep}
+ Assert {[.p cget -value] == "rtf"}
+ test {.p delete rtf}
+
+ Assert {[.p subwidget menubutton cget -text] == {}}
+
+ test {destroy .p}
+}
diff --git a/tix/tests/general/pane.tcl b/tix/tests/general/pane.tcl
new file mode 100644
index 00000000000..918386794ce
--- /dev/null
+++ b/tix/tests/general/pane.tcl
@@ -0,0 +1,29 @@
+# pane.tcl --
+#
+# Test the PanedWindow widget.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+ return "Test the PanedWindow widget."
+}
+
+proc Test {} {
+ TestBlock pane-1.1 {tixPanedWindow -expand} {
+ tixPanedWindow .p -orient horizontal
+ pack .p -expand yes -fill both
+ set p1 [.p add pane1 -expand 0.3]
+ set p2 [.p add pane2 -expand 1]
+ set p3 [.p add pane3 -size 20]
+ .p config -width 300 -height 200
+ update
+ .p config -width 500
+ update
+ .p config -width 200
+ update
+ }
+}
diff --git a/tix/tests/general/pkginit.tcl b/tix/tests/general/pkginit.tcl
new file mode 100644
index 00000000000..6f0dbc39038
--- /dev/null
+++ b/tix/tests/general/pkginit.tcl
@@ -0,0 +1,6 @@
+# pkginit.tcl --
+#
+#
+# This file contains the initialization code for all the test programs
+# in this directory.
+#
diff --git a/tix/tests/general/samples.tcl b/tix/tests/general/samples.tcl
new file mode 100644
index 00000000000..4c39834ea53
--- /dev/null
+++ b/tix/tests/general/samples.tcl
@@ -0,0 +1,73 @@
+# samples.tcl --
+#
+# Tests all the sample programs in the demo/samples directory.
+#
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+ return "Testing all the sample programs in the demo/samples directory"
+}
+
+proc Test {} {
+ global samples_dir demo_dir tix_library
+
+ TestBlock samples-1.0 "Finding the demo directory" {
+ foreach dir "$tix_library/demos $tix_library/../demos ../../demos ../demos demos" {
+ if {[file exists $dir] && [file isdir $dir]} {
+ set pwd [pwd]
+ cd $dir
+ set demo_dir [pwd]
+ set samples_dir [pwd]/samples
+ cd $pwd
+ break
+ }
+ }
+ }
+
+ if ![info exists samples_dir] {
+ puts "Cannot find demos directory. Sample tests are skipped"
+ return
+ } else {
+ puts "loading demos from $demo_dir"
+ }
+
+ TestBlock samples-1.1 "Running widget demo" {
+ if [file exists $demo_dir/widget] {
+ uplevel #0 source [list $demo_dir/widget]
+ Widget:SelfTest
+ }
+ }
+ if ![file exists $samples_dir/AllSampl.tcl] {
+ return
+ }
+ uplevel #0 source [list $samples_dir/AllSampl.tcl]
+
+ ForAllSamples root "" Test_Sample
+}
+
+
+proc Test_Sample {token type text dest} {
+ global samples_dir tix_demo_running
+
+ set tix_demo_running 1
+
+ if {$type == "f"} {
+ set w .sampl_top
+ TestBlock samples-2-$dest "Loading sample $dest" {
+ uplevel #0 source [list $samples_dir/$dest]
+ toplevel $w
+ wm geometry $w +100+100
+ wm title $w $text
+ RunSample $w
+ update
+ }
+ catch {
+ destroy $w
+ }
+ }
+}
diff --git a/tix/tests/general/select.tcl b/tix/tests/general/select.tcl
new file mode 100644
index 00000000000..5a10b815ae7
--- /dev/null
+++ b/tix/tests/general/select.tcl
@@ -0,0 +1,45 @@
+proc About {} {
+ return "Testing the TixSelect widget"
+}
+
+proc Test {} {
+ set dis [tix option get disabled_fg]
+ set norm [tix option get fg]
+
+ # Create with a normal state
+ #
+ #
+ tixSelect .foo -allowzero 0 -radio 1 -label "Foo:" \
+ -state normal
+ .foo add "1" -text "One"
+ .foo add "2" -text "Two"
+ pack .foo
+
+ Assert {[.foo subwidget label cget -foreground] == $norm}
+ .foo config -state normal
+ .foo config -state normal
+ Assert {[.foo subwidget label cget -foreground] == $norm}
+ .foo config -state disabled
+ Assert {[.foo subwidget label cget -foreground] == $dis}
+ .foo config -state normal
+ Assert {[.foo subwidget label cget -foreground] == $norm}
+
+ update
+ destroy .foo
+
+ tixSelect .foo -allowzero 0 -radio 1 -label "Foo:" \
+ -state disabled
+ .foo add "1" -text "One"
+ .foo add "2" -text "Two"
+ pack .foo
+
+ Assert {[.foo subwidget label cget -foreground] == $dis}
+ .foo config -state normal
+ Assert {[.foo subwidget label cget -foreground] == $norm}
+ .foo config -state normal
+ Assert {[.foo subwidget label cget -foreground] == $norm}
+ .foo config -state disabled
+ Assert {[.foo subwidget label cget -foreground] == $dis}
+ .foo config -state normal
+ Assert {[.foo subwidget label cget -foreground] == $norm}
+}
diff --git a/tix/tests/general/slistbox.tcl b/tix/tests/general/slistbox.tcl
new file mode 100644
index 00000000000..4a670d8369b
--- /dev/null
+++ b/tix/tests/general/slistbox.tcl
@@ -0,0 +1,16 @@
+proc About {} {
+ return "Testing ScrolledListBox"
+}
+
+proc Test {} {
+ set w [tixScrolledListBox .listbox]
+ pack $w
+
+ foreach item {{1 1} 2 3 4 5 6} {
+ $w subwidget listbox insert end $item
+ }
+
+ Click [$w subwidget listbox] 30 30
+
+ destroy $w
+}
diff --git a/tix/tests/general/testtmpl.tcl b/tix/tests/general/testtmpl.tcl
new file mode 100644
index 00000000000..ddaf80166c7
--- /dev/null
+++ b/tix/tests/general/testtmpl.tcl
@@ -0,0 +1,28 @@
+# testtmpl.tcl --
+#
+# Test Template:
+#
+# This program is used as the first test: see whether we can execute any
+# case at all.
+#
+# This program is also used as a template file for writing other test
+# cases.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+ return "Testing whether the test program starts up properly"
+}
+
+proc Test {} {
+ TestBlock testtmpl-1.1 {NULL test} {
+ #
+ # If this fails, we are in big trouble and probably none of the
+ # tests can pass. Abort all the tests
+ #
+ } 1 abortall
+}
diff --git a/tix/tests/general/var1.tcl b/tix/tests/general/var1.tcl
new file mode 100644
index 00000000000..7422821fe71
--- /dev/null
+++ b/tix/tests/general/var1.tcl
@@ -0,0 +1,59 @@
+proc About {} {
+ return "Testing -variable option with Tix widgets"
+}
+
+proc Test {} {
+ global foo bar arr
+
+ set classes {tixControl tixComboBox}
+ set value 1234
+
+ foreach class $classes {
+ set w [$class .foo]
+ pack $w
+ update idletasks
+
+ TestBlock var1-1.1 {$class: config -variable with initialized value} {
+ set bar $value
+ $w config -variable bar
+ update idletasks
+ Assert {[$w cget -value] == $value}
+ }
+
+ TestBlock var1-1.2 {$class: config -variable w/ uninitialized value} {
+ destroy $w
+ set w [$class .foo]
+ $w config -variable bar
+ Assert {[$w cget -value] == $bar}
+ }
+
+ TestBlock var1-1.2 {$class: config -variable} {
+ set foo 111
+ $w config -variable foo
+ update idletasks
+ Assert {[$w cget -value] == $foo}
+ }
+
+ TestBlock var1-1.2 {$class: config -value} {
+ $w config -value 123
+ Assert {[$w cget -value] == 123}
+ Assert {[set [$w cget -variable]] == 123}
+ }
+
+ TestBlock var1-1.2 {$class: config -variable on array variable} {
+ set arr(12) 1234
+ $w config -variable arr(12)
+ Assert {[$w cget -value] == $arr(12)}
+ }
+
+ TestBlock var1-1.2 {$class: config -value on array variable} {
+ $w config -value 12
+ Assert {[$w cget -value] == 12}
+ Assert {[set [$w cget -variable]] == 12}
+ }
+
+ catch {
+ destroy $w
+ }
+ }
+}
diff --git a/tix/tests/grid/Grid.tcl b/tix/tests/grid/Grid.tcl
new file mode 100644
index 00000000000..0c37b0fdce2
--- /dev/null
+++ b/tix/tests/grid/Grid.tcl
@@ -0,0 +1,155 @@
+# This tests the Grid widget.
+#
+#
+#
+proc About {} {
+ return "Basic tests for the Grid widget"
+}
+
+proc Test {} {
+ TestBlock grid-1.1 {Grid creation} {
+ test {tixGrid} {args}
+ test {tixGrid .g -ff} {unknown}
+ test {tixGrid .g -width} {missing}
+
+ Assert {[info command .g] == {}}
+ Assert {![winfo exists .g]}
+ }
+
+ TestBlock grid-1.2 {Grid creation} {
+ set g [tixGrid .g]
+ pack $g -expand yes -fill both
+ update
+ destroy $g
+ }
+
+ TestBlock grid-2.1 {Grid widget commands} {
+ set g [tixGrid .g]
+ pack $g -expand yes -fill both
+ test {$g} {args}
+ set foo ""
+ }
+ TestBlock grid-2.2 {Grid widget commands} {
+ $g config -selectmode browse
+ Assert {[tixStrEq [$g cget -selectmode] browse]}
+ }
+
+ #----------------------------------------
+ # Sites
+ #----------------------------------------
+ foreach cmd {anchor dragsite dropsite} {
+ TestBlock grid-3.1 "Grid \"$cmd\" widget command" {
+ test1 {$g $cmd} \
+ "wrong # args: should be \".g $cmd option ?x y?\""
+ }
+ TestBlock grid-3.2 "Grid \"$cmd\" widget command" {
+ test1 {$g $cmd foo} \
+ {wrong option "foo", must be clear, get or set}
+ }
+ TestBlock grid-3.3 "Grid \"$cmd\" widget command" {
+ test1 {$g $cmd clear bar} \
+ "wrong # of arguments, must be: .g $cmd clear"
+ }
+ TestBlock grid-3.4 "Grid \"$cmd\" widget command" {
+ test1 {$g $cmd set 0 0 bar} \
+ "wrong # args: should be \".g $cmd option ?x y?\""
+ }
+ TestBlock grid-3.5 "Grid \"$cmd\" widget command" {
+ test1 {$g $cmd set xxx 0} \
+ {expected integer but got "xxx"}
+ }
+ TestBlock grid-3.6 "Grid \"$cmd\" widget command" {
+ test1 {$g $cmd set 0 xxx} \
+ {expected integer but got "xxx"}
+ }
+ foreach selunit {row column cell} {
+ TestBlock grid-3.7 "Grid \"$cmd\" widget command" {
+ $g config -selectunit $selunit
+ $g $cmd set 0 0
+ update
+ }
+ }
+ TestBlock grid-3.8 "Grid \"$cmd\" widget command" {
+ $g $cmd set 0 0
+ Assert {[tixStrEq [$g $cmd get] "0 0"]}
+ }
+ TestBlock grid-3.9 "Grid \"$cmd\" widget command" {
+ $g $cmd set -20 -0
+ Assert {[tixStrEq [$g $cmd get] "0 0"]}
+ }
+ TestBlock grid-3.10 "Grid \"$cmd\" widget command" {
+ $g $cmd set 10000000 100000000
+ Assert {[tixStrEq [$g $cmd get] "10000000 100000000"]}
+ }
+ }
+
+ #----------------------------------------
+ # set
+ #----------------------------------------
+ TestBlock grid-4.1 {Grid "set" widget command} {
+ test {$g set} {args}
+ test {$g set 0 0 -foo} {missing}
+ test {$g set 0 0 -foo bar} {unknown}
+ test {$g set 0 0 -itemtype foo} {unknown}
+ test {$g set 0 0 -itemtype imagetext -image foo} {image}
+ test {$g set 0 0 -itemtype imagetext -text Hello -image \
+ [tix getimage folder]
+ }
+ update
+ }
+
+ TestBlock grid-4.2 {Grid "set" widget command} {
+ for {set x 0} {$x < 19} {incr x} {
+ for {set y 0} {$y < 13} {incr y} {
+ $g set $x $y -itemtype imagetext -text ($x,$y) \
+ -image [tix getimage folder]
+ }
+ }
+ update
+ }
+
+ TestBlock grid-4.3 {Grid "unset" widget command} {
+ for {set x 0} {$x < 23} {incr x} {
+ for {set y 0} {$y < 19} {incr y} {
+ $g unset $x $y
+ }
+ }
+ update
+ }
+
+
+ #----------------------------------------
+ # delete
+ #----------------------------------------
+ TestBlock grid-5.1 {Grid "delete" widget command} {
+ for {set x 0} {$x < 19} {incr x} {
+ for {set y 0} {$y < 13} {incr y} {
+ $g set $x $y -itemtype imagetext -text ($x,$y) \
+ -image [tix getimage folder]
+ }
+ }
+ foreach index {0 1 3 2 6 3 1 1 max 19 13 max} {
+ $g delete row $index
+ $g delete col $index
+ update
+ }
+ }
+ #----------------------------------------
+ # move
+ #----------------------------------------
+ TestBlock grid-6.1 {Grid "move" widget command} {
+ for {set x 0} {$x < 19} {incr x} {
+ for {set y 0} {$y < 13} {incr y} {
+ $g set $x $y -itemtype imagetext -text ($x,$y) \
+ -image [tix getimage folder]
+ }
+ }
+ foreach index {0 1 3 2 6 3 1 1 max 19 13 max} {
+ $g move row $index $index 3
+ $g move col $index $index -2
+ update
+ }
+ }
+
+}
+
diff --git a/tix/tests/grid/files b/tix/tests/grid/files
new file mode 100644
index 00000000000..627c7bff522
--- /dev/null
+++ b/tix/tests/grid/files
@@ -0,0 +1 @@
+Grid.tcl \ No newline at end of file
diff --git a/tix/tests/hlist/DirList.tcl b/tix/tests/hlist/DirList.tcl
new file mode 100644
index 00000000000..3c4abe93309
--- /dev/null
+++ b/tix/tests/hlist/DirList.tcl
@@ -0,0 +1,51 @@
+# This file tests the pixmap image reader
+#
+
+proc About {} {
+ return "This file performs test on the DirList widget"
+}
+
+proc Test {} {
+ set w .dirlist
+
+ tixDirList $w
+ pack $w
+
+ set h [$w subwidget hlist]
+
+ # If we didn't specifi -value, the DirList should display the
+ # current directory
+ Assert {[tixStrEq [$w cget -value] [tixFSPWD]]}
+
+ # After changing the directory, the selection and anchor should change as
+ # well
+ set root [$h info children ""]
+ ClickHListEntry $h $root single
+ Assert {[tixStrEq [$w cget -value] [$h info data $root]]}
+ Assert {[tixStrEq [$h info selection] $root]}
+ Assert {[tixStrEq [$h info anchor] $root]}
+
+ case [tix platform] {
+ unix {
+ set dir1 /etc
+ set dir2 /etc
+ }
+ windows {
+ set dir1 C:\\Windows
+ set dir2 C:\\Backup
+ }
+ default {
+ return
+ }
+ }
+
+ foreach dir [list $dir1 $dir2] {
+ if ![file exists $dir] {
+ continue
+ }
+
+ $w config -value $dir
+ Assert {[tixStrEq [$w cget -value] $dir]}
+ Assert {[tixStrEq [$h info data [$h info anchor]] $dir]}
+ }
+}
diff --git a/tix/tests/hlist/HLHdr.tcl b/tix/tests/hlist/HLHdr.tcl
new file mode 100644
index 00000000000..22f295c0eea
--- /dev/null
+++ b/tix/tests/hlist/HLHdr.tcl
@@ -0,0 +1,94 @@
+# This tests the "header" functions in HList
+#
+#
+# Assumptions:
+# (1) add command OK
+#
+
+proc test {cmd {result {}} {ret {}}} {
+ if [catch {set ret [uplevel 1 $cmd]} err] {
+ set done 0
+ foreach r $result {
+ if [regexp $r $err] {
+ puts "error message OK: $err"
+ set done 1
+ break
+ }
+ }
+ if {!$done} {
+ error $err
+ }
+ } else {
+ puts "execution OK: $cmd"
+ }
+ return $ret
+}
+
+set h [tixHList .h -header 1 -columns 2]
+pack $h -expand yes -fill both
+$h add hello -text hello
+$h add noind -text hello
+
+test {$h header} {args}
+test {$h header bad} {unknown}
+
+# Test for create
+#
+#
+
+test {$h header create} {args}
+test {$h header create 3} {{exist}}
+test {$h header create 1 -itemtype} {missing}
+test {$h header create 1 -itemtype bad} {unknown}
+test {$h header create 1 -itemtype imagetext -text Hello -image [tix getimage folder]}
+
+
+# Test for cget
+#
+test {$h header cget} {args}
+test {$h header cget 0 -text} {does not have}
+test {$h header cget 1} {args}
+test {$h header cget 3 -text} {exist}
+test {$h header cget 1 arg arg} {args}
+test {$h header cget 1 -bad} {{unknown}}
+test {$h header cget 1 -text}
+
+# Test for config
+#
+test {$h header config} {args}
+test {$h header config 3 -text} {exist}
+test {$h header config 0 -text} {does not have}
+test {$h header config 1 -bad} {{unknown}}
+test {$h header config 1}
+test {$h header config 1 -text}
+test {$h header config 1 -text Hi}
+
+# Test for size
+#
+test {$h header size} {args}
+test {$h header size 0 0} {args}
+test {$h header size 4} {exist}
+test {$h header size 0} {not have}
+test {puts [$h header size 1]}
+
+
+# Test for exist
+#
+test {$h header exist} {args}
+test {$h header exist hello hi} {args}
+test {$h header exist 4} {exist}
+test {puts [$h header exist 0]}
+test {puts [$h header exist 1]}
+
+# Test for delete
+#
+test {$h header delete} {args}
+test {$h header delete hello hi} {args}
+test {$h header delete 4} {exist}
+test {$h header delete 0} {not have}
+test {$h header delete 1}
+
+# just do it again ..
+#
+test {$h header create 1 -itemtype imagetext -text Hello -image [tix getimage folder]}
+
diff --git a/tix/tests/hlist/HLInd.tcl b/tix/tests/hlist/HLInd.tcl
new file mode 100644
index 00000000000..ed4f127366e
--- /dev/null
+++ b/tix/tests/hlist/HLInd.tcl
@@ -0,0 +1,51 @@
+proc Test {} {
+ set h [tixHList .h -indicator 1 -indent 20]
+ pack $h -expand yes -fill both
+ button .b -text close -command "Done forced"
+ pack .b
+
+ $h add hello -text hello
+ $h add noind -text hello
+
+ test {$h indicator} {args}
+ test {$h indicator bad} {unknown}
+
+ # Test for create
+ #
+ #
+
+ test {$h indicator create} {args}
+ test {$h indicator create xyz} {{not found}}
+ test {$h indicator create hello -itemtype} {missing}
+ test {$h indicator create hello -itemtype bad} {unknown}
+ test {$h indicator create hello -itemtype imagetext \
+ -image [tix getimage plus]}
+
+ # Test for cget
+ #
+ test {$h indicator cget} {args}
+ test {$h indicator cget hello} {args}
+ test {$h indicator cget hello arg arg} {args}
+ test {$h indicator cget noind -text} {{does not have}}
+ test {$h indicator cget hello -bad} {{unknown}}
+ test {$h indicator cget hello -image}
+
+ # Test for size
+ #
+ test {$h indicator size} {args}
+ test {$h indicator size hello hi} {args}
+ test {$h indicator size bad} {{not found}}
+ test {$h indicator size noind} {{does not have}}
+ test {set x [$h indicator size hello]}
+ test {$h indicator cget hello -image} {{does not}}
+
+ # Test for delete
+ #
+ test {$h indicator delete} {args}
+ test {$h indicator delete hello hi} {args}
+ test {$h indicator delete bad} {{not found}}
+ test {$h indicator delete hello}
+ test {$h indicator cget hello -image} {{does not}}
+
+ update
+}
diff --git a/tix/tests/hlist/HList.tcl b/tix/tests/hlist/HList.tcl
new file mode 100644
index 00000000000..16b6373e403
--- /dev/null
+++ b/tix/tests/hlist/HList.tcl
@@ -0,0 +1,76 @@
+# HList.tcl --
+#
+# General HList test.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+ return "General tests for the HList widget"
+}
+
+
+proc Test {} {
+ set h [tixHList .h -selectmode single]
+ pack $h -expand yes -fill both
+
+ #
+ PutP "Testing the selection command"
+ #
+
+ for {set x 0} {$x < 40} {incr x} {
+ $h add foo$x -text Foo$x
+ }
+ update
+
+ test {$h selection set} {arg}
+ test {$h selection set foo1}
+
+ test {$h selection get foo} {arg}
+ Assert {[tixStrEq [$h selection get] "foo1"]}
+ Assert {[tixStrEq [$h selection get] [$h info selection]]}
+
+ #
+ PutP "Testing the info bbox command"
+ #
+ $h config -browsecmd "HLTest_BrowseCmd $h"
+ global hlTest_selected
+ for {set x 0} {$x <= 3} {incr x} {
+ set ent foo[expr $x * 8]
+ $h see $ent
+ update
+
+ set bbox [$h info bbox $ent]
+ Assert {![tixStrEq "$bbox" ""]}
+
+ set hlTest_selected ""
+ Click $h [lindex $bbox 0] [lindex $bbox 1]
+ update
+ Assert {[tixStrEq "$hlTest_selected" "$ent"]}
+
+ set hlTest_selected ""
+ Click $h [lindex $bbox 2] [lindex $bbox 3]
+ update
+ Assert {[tixStrEq "$hlTest_selected" "$ent"]}
+ }
+
+ #
+ PutP "Testing the ClickHListEntry test function"
+ #
+ for {set x 0} {$x <= 3} {incr x} {
+ set hlTest_selected ""
+ set ent foo[expr $x * 8]
+ ClickHListEntry $h $ent
+ update
+ Assert {[tixStrEq "$hlTest_selected" "$ent"]}
+ }
+}
+
+proc HLTest_BrowseCmd {w args} {
+ global hlTest_selected
+
+ set hlTest_selected [tixEvent value]
+}
diff --git a/tix/tests/hlist/files b/tix/tests/hlist/files
new file mode 100644
index 00000000000..1098edb1e57
--- /dev/null
+++ b/tix/tests/hlist/files
@@ -0,0 +1,3 @@
+HLInd.tcl
+DirList.tcl
+items.tcl \ No newline at end of file
diff --git a/tix/tests/hlist/items.tcl b/tix/tests/hlist/items.tcl
new file mode 100644
index 00000000000..a961025b095
--- /dev/null
+++ b/tix/tests/hlist/items.tcl
@@ -0,0 +1,40 @@
+# items.tcl --
+#
+# Test the handling of DisplayStyle and DisplayItem.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc About {} {
+ return "Test the handling of DisplayStyle and DisplayItem."
+}
+
+proc Test {} {
+ TestBlock items-1.1 {tixTmpLine} {
+ tixHList .c
+ set style [tixDisplayStyle text -refwindow .c -font fixed]
+ .c add a -itemtype text -style $style -text Hello
+ .c add b -itemtype text -text Hello
+
+ tixHList .d
+ .d add a -itemtype text -style $style -text Hello
+ .d add b -itemtype text -text Hello
+
+ pack .c .d -expand yes -fill both
+ update
+
+ destroy .c
+ update
+ Assert {[string comp [info command $style] ""] == 0}
+ }
+
+ catch {
+ destroy .c
+ }
+ catch {
+ destroy .d
+ }
+}
diff --git a/tix/tests/itcl/files b/tix/tests/itcl/files
new file mode 100644
index 00000000000..49446caf31e
--- /dev/null
+++ b/tix/tests/itcl/files
@@ -0,0 +1,5 @@
+general.tcl
+scope1.tcl
+namesp.tcl
+itk.tcl
+
diff --git a/tix/tests/itcl/general.tcl b/tix/tests/itcl/general.tcl
new file mode 100644
index 00000000000..f6e4fb269a8
--- /dev/null
+++ b/tix/tests/itcl/general.tcl
@@ -0,0 +1,9 @@
+# ITcl general test
+#
+
+proc About {} {
+ return "This file performs general test on Tix w/ ITcl 2.0"
+}
+
+proc Test {} {
+}
diff --git a/tix/tests/itcl/itk.tcl b/tix/tests/itcl/itk.tcl
new file mode 100644
index 00000000000..e93e3cc1438
--- /dev/null
+++ b/tix/tests/itcl/itk.tcl
@@ -0,0 +1,24 @@
+# This file tests the pixmap image reader
+#
+
+proc About {} {
+ return "This file performs tests with ITK mega widgets"
+}
+
+proc Test {} {
+ frame .f
+ pack .f
+ tixPanedWindow .f.tpw
+ pack .f.tpw -side left -expand yes -fill both
+ set p1 [.f.tpw add t1 -min 20 -size 120 ]
+ set p2 [.f.tpw add t2 -min 20 -size 80 ]
+ frame $p1.t1
+ frame $p2.t2
+ pack $p1.t1 $p2.t2
+ tixScrolledListBox $p1.t1.list
+ tixScrolledListBox $p2.t2.list
+ pack $p1.t1.list $p2.t2.list
+
+ Combobox .ibox -labeltext "ItkBox" -items {one two three}
+ pack .ibox
+}
diff --git a/tix/tests/itcl/namesp.tcl b/tix/tests/itcl/namesp.tcl
new file mode 100644
index 00000000000..0f565242093
--- /dev/null
+++ b/tix/tests/itcl/namesp.tcl
@@ -0,0 +1,22 @@
+# This file tests the pixmap image reader
+#
+
+proc About {} {
+ return "This file performs test on name space"
+}
+
+proc Test {} {
+ namespace mySpace {
+ variable hsl ".hsl"
+ proc creatHSL {} {
+ global hsl
+ tixScrolledHList $hsl
+ }
+ proc packHSL {} {
+ global hsl
+ pack $hsl
+ }
+ }
+ mySpace::creatHSL
+ mySpace::packHSL
+}
diff --git a/tix/tests/itcl/pkginit.tcl b/tix/tests/itcl/pkginit.tcl
new file mode 100644
index 00000000000..f3040cd641e
--- /dev/null
+++ b/tix/tests/itcl/pkginit.tcl
@@ -0,0 +1,2 @@
+#@scope :: {lappend auto_path $env(IWIDGETS_LIBRARY)}
+#@scope :: {source "$env(IWIDGETS_LIBRARY)/init.iwidgets"}
diff --git a/tix/tests/itcl/scope1.tcl b/tix/tests/itcl/scope1.tcl
new file mode 100644
index 00000000000..41cd8075861
--- /dev/null
+++ b/tix/tests/itcl/scope1.tcl
@@ -0,0 +1,54 @@
+proc About {} {
+ return "Testing creation of Tix widgets inside ITCL classes"
+}
+
+proc Test {} {
+ class foo {
+ inherit itk::Widget
+
+ constructor {args} {
+ itk_component add lab {
+ label $itk_interior.lab \
+ -textvariable [code choice($this)]
+ }
+
+ itk_component add le {
+ tixOptionMenu $itk_interior.le \
+ -label "File format" \
+ -variable [code choice($this)] \
+ -command "$this foocmd"
+ }
+
+ foreach cmd {HTML PostScript ASCII} {
+ $itk_component(le) add command $cmd
+ }
+
+ pack $itk_component(lab) $itk_component(le) \
+ -anchor e \
+ -padx 10 \
+ -pady 10 \
+ -fill x
+
+ eval itk_initialize $args
+ }
+ common choice
+
+ method foocmd {args} {
+ puts $args
+ }
+ method set_format {format} {
+ set choice($this) $format
+ }
+ }
+ usual TixOptionMenu {
+ }
+
+ foo .xy
+ pack .xy
+ .xy set_format ASCII
+ update
+ .xy component le config -value PostScript
+ update
+ .xy component le config -value HTML
+}
+
diff --git a/tix/tests/library/CaseData.tcl b/tix/tests/library/CaseData.tcl
new file mode 100644
index 00000000000..1d0c9195980
--- /dev/null
+++ b/tix/tests/library/CaseData.tcl
@@ -0,0 +1,148 @@
+# CaseData.tcl --
+#
+# Contains data for test cases
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+# GetHomeDirs --
+#
+# Returns a list of user names (prefixed with tilde) and their
+# home directories
+#
+proc GetHomeDirs {} {
+ set tryList {root ftp admin operator uucp adm man john ioi}
+ if [catch {
+ lappend tryList [exec whoami]
+ }] {
+ catch {
+ lappend tryList [exec logname]
+ }
+ }
+
+
+ set list {}
+ foreach user $tryList {
+ if [info exists done($user)] {
+ continue
+ }
+ set expanded [tixFile tilde ~$user]
+ if ![tixStrEq $expanded ~$user] {
+ lappend list [list ~$user $expanded]
+ }
+ set done($user) 1
+ }
+ return $list
+}
+
+# GetCases_FsNormDir --
+#
+# Returns a set of test cases for verifying whether a non-normalized
+# directory is properly notmalized
+#
+proc GetCases_FsNormDir {} {
+
+ if [tixStrEq [tix platform] unix] {
+ # PATHNAME to TEST expected result Causes error for
+ # tixFSNormDir?
+ #----------------------------------------------------------------
+ set list {
+ {. "" 1}
+ {foo "" 1}
+ {~nosuchuser "" 1}
+ {~nosuchuser/../ "" 1}
+ {/ / 0}
+ {/// / 0}
+ {/./ / 0}
+ {/./. / 0}
+ {/./. / 0}
+ {/././.././../ / 0}
+ {/etc /etc 0}
+ {/etc/../etc /etc 0}
+ {/etc/../etc/./ /etc 0}
+ {/etc/../etc/./ /etc 0}
+ {/etc/../usr/./lib /usr/lib 0}
+ }
+ foreach userInfo [GetHomeDirs] {
+ lappend list [list [lindex $userInfo 0] [lindex $userInfo 1] 0]
+ }
+ } else {
+ set list [list \
+ [list . "" 1] \
+ [list foo "" 1] \
+ [list .. "" 1] \
+ [list ..\\foo "" 1] \
+ [list ..\\dat\\. "" 1] \
+ [list C: "" 1] \
+ [list C:\\ C: 0] \
+ [list c:\\ C: 0] \
+ [list C:\\\\ C: 0] \
+ [list C:\\ C: 0] \
+ [list C:\\. C: 0] \
+ [list C:\\Windows C:\\Windows 0] \
+ [list C:\\Windows\\System C:\\Windows\\System 0] \
+ [list C:\\Windows\\.. C: 0] \
+ ]
+ }
+
+ return $list
+}
+
+# GetCases_FSNorm --
+#
+# Returns a set of test cases for testing the tixFSNorm command.
+#
+proc GetCases_FSNorm {} {
+ global tixPriv
+
+ if [tixStrEq [tix platform] unix] {
+ # PATHNAME to TEST context <---------- Expected Result ----------------------------------->
+ # path vpath(todo) files(todo) patterns(todo)
+ #----------------------------------------------------------------
+ set list {
+ {. / / }
+ {./ / / }
+ {./////./ / / }
+ {.. / / }
+ {../ / / }
+ {../.. / / }
+ {../../../ / / }
+ {/etc / /etc }
+ {/etc///../etc/// / /etc }
+ {/etc///../etc///.. / / }
+ {/etc///../etc///../ / / }
+ {/etc/. / /etc }
+ {/./etc/. / /etc }
+ {/./././etc/. / /etc }
+ {/usr/./././local/./lib//// / /usr/local/lib }
+ {./././././etc/ / /etc }
+ {/etc/../etc / /etc }
+ {/etc/../etc/../etc / /etc }
+ {/etc/../etc/../ / / }
+ {~foobar/foo / /~foobar }
+ {~foobar/foo/ / /~foobar/foo }
+ }
+ } else {
+ set p $tixPriv(WinPrefix)
+
+ set list [list \
+ [list . $p\\C: $p\\C: ] \
+ [list .\\. $p\\C: $p\\C: ] \
+ [list .\\Windows $p\\C: $p\\C:\\Windows ] \
+ [list .\\Windows\\..\\ $p\\C: $p\\C: ] \
+ [list tmp\\ $p\\C: $p\\C:\\tmp ] \
+ [list "no such file" $p\\C: $p\\C: ] \
+ [list "autoexec.bat" $p\\C: $p\\C: ] \
+ [list "ignore/slash\\dd" $p\\C: $p\\C:\\ignore/slash ] \
+ [list "has space\\" $p\\C: "$p\\C:\\has space" ] \
+ [list "has space" $p\\C: "$p\\C:" ] \
+ ]
+ # ToDo:
+ # (1) xx\xx\C: + .. should be xx\xx
+ # (2) xx\xx\C: + D: should be xx\xx\D:
+ }
+ return $list
+}
diff --git a/tix/tests/library/TestLib.tcl b/tix/tests/library/TestLib.tcl
new file mode 100644
index 00000000000..31b7320e305
--- /dev/null
+++ b/tix/tests/library/TestLib.tcl
@@ -0,0 +1,598 @@
+# TestLib.tcl --
+#
+# Implements the procedures used by the Tix test suite.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+set testapp(tix,w,normal) {
+ tixButtonBox tixComboBox tixControl tixDirList tixDirTree
+ tixExDirSelectBox tixExFileSelectBox tixFileSelectBox tixFileEntry
+ tixLabelEntry tixLabelFrame tixNoteBook tixOptionMenu
+ tixPanedWindow tixScrolledHList tixScrolledListBox
+ tixScrolledTList tixScrolledText tixScrolledWindow tixSelect
+ tixStdButtonBox tixTree
+}
+set testapp(tix,w,shell) {
+ tixBalloon tixDialogShell tixExFileSelectDialog tixFileSelectDialog
+ tixPopupMenu tixStdDialogShell
+}
+set testapp(tix,w,base) {
+ tixLabelWidget
+ tixPrimitive
+ tixScrolledWidget
+ tixShell
+ tixStackWindow
+ tixVResize tixVStack tixVTree
+}
+set testapp(tix,w,unsupported) {
+ tixMDIMenuBar
+ tixMDIWindow
+ tixMwmClient
+ tixResizeHandle
+ tixSimpleDialog
+ tixStatusBar
+}
+
+# testConfig(VERBOSE) is the "Verbosity level" of the test suite.
+#
+# 0 -- No messages except the name of the tests
+# 10 -- Print out the number of each test block
+# 15 -- Print out the number and name of each test block
+# 20 -- Print out all kinds of messages
+# 30 -- level 20, plus when an error occurs, prints out the stack trace.
+#
+if [info exists env(TEST_VERBOSE)] {
+ if [catch {
+ set testConfig(VERBOSE) [expr "int($env(TEST_VERBOSE) + 0)"]
+ }] {
+ set testConfig(VERBOSE) 10
+ }
+} else {
+ set testConfig(VERBOSE) 0
+}
+
+set testConfig(errCount) 0
+
+#----------------------------------------------------------------------
+#
+# General assertion and evaluation
+#
+#----------------------------------------------------------------------
+
+# Assert --
+#
+# Evaulates an assertion. Output error message if the assertion is false
+#
+proc Assert {cond {printErrInfo 0} {abortMode abortfile}} {
+ global errorInfo testConfig
+ if [info exists errorInfo] {
+ set errorInfo ""
+ }
+ uplevel 1 [list \
+ if !($cond) [list \
+ TestError "Failed Assertion \"$cond\"\n evaluated as \"[uplevel 1 subst -nocommand [list $cond]]\" :: [uplevel 1 subst [list $cond]]" $printErrInfo $abortMode
+ ] \
+ ]
+}
+
+# TestAbort --
+#
+# Aborts a single test file.
+#
+proc TestAbort {msg} {
+ error $msg
+}
+
+# test --
+#
+# Try to evaluate a command.
+#
+proc test {cmd {result {}} {ret {}}} {
+ global testConfig
+
+ if [catch {set ret [uplevel 1 $cmd]} err] {
+ set done 0
+ foreach r $result {
+ if [regexp $r $err] {
+ if {$testConfig(VERBOSE) >= 20} {
+ puts "Passed (Error message is expected):"
+ puts " command = \"$cmd\""
+ puts " expected error = \"$result\""
+ puts " actual error = $err"
+ }
+ set done 1
+ break
+ }
+ }
+ if {!$done} {
+ error $err
+ }
+ } else {
+ if {$testConfig(VERBOSE) >= 20} {
+ puts "Passed (Execution OK):\n command = \"$cmd\""
+ }
+ }
+ return $ret
+}
+
+# test1 --
+#
+# Try to evaluate a command and make sure its error result is the same
+# as $result.
+#
+proc test1 {cmd {result {}}} {
+ global testConfig
+
+ set ret ""
+ if [catch {set ret [uplevel 1 $cmd]} err] {
+ if ![tixStrEq $err $result] {
+ error $err
+ } else {
+ if {$testConfig(VERBOSE) >= 20} {
+ puts "Passed (Error message is expected):"
+ puts " command = \"$cmd\""
+ puts " expected error = \"$result\""
+ }
+ }
+ } else {
+ if {$testConfig(VERBOSE) >= 20} {
+ puts "Passed (Execution OK):\n command = \"$cmd\""
+ }
+ }
+ return $ret
+}
+
+#----------------------------------------------------------------------
+#
+# Mouse event emulation routines
+#
+#----------------------------------------------------------------------
+proc GetRoot {w x y} {
+ upvar X X
+ upvar Y Y
+
+ set x0 [winfo rootx $w]
+ set y0 [winfo rooty $w]
+
+ set X [expr $x0 + $x]
+ set Y [expr $y0 + $y]
+}
+
+proc MouseEvent {w type x y args} {
+ set tags [bindtags $w]
+ GetRoot $w $x $y
+
+ lappend args %q
+ lappend args $w
+ lappend args %W
+ lappend args $w
+ lappend args %x
+ lappend args $x
+ lappend args %y
+ lappend args $y
+ lappend args %X
+ lappend args $X
+ lappend args %Y
+ lappend args $Y
+
+ set found 0
+ foreach t $tags {
+ set cmd [string trim [bind $t $type]]
+
+ if {$cmd != ""} {
+ set found 1
+ }
+ tixForEach {sub val} $args {
+ regsub -all $sub $cmd $val cmd
+ }
+ uplevel #0 $cmd
+ }
+ if {$found == 0} {
+ global testConfig
+ if $testConfig(VERBOSE) {
+ puts "(testlib warning): widget $w has no bindings for $type"
+ }
+ }
+ return $found
+}
+
+# KeyboardString --
+#
+# Send a string to the widget via a list of key strokes. This does
+# NOT ensure that an entry widget has the exact content as $string.
+# You need to call $entry delete 0 end first!
+#
+proc KeyboardString {w string} {
+ set tags [bindtags $w]
+
+ lappend args %q
+ lappend args $w
+ lappend args %W
+ lappend args $w
+
+ set found 0
+
+ foreach c [split $string ""] {
+ foreach t $tags {
+ set cmd [string trim [bind $t <KeyPress>]]
+
+ if {$cmd != ""} {
+ set found 1
+ }
+ set list $args
+ lappend list %A
+ lappend list [list $c]
+
+ tixForEach {sub val} $list {
+ regsub -all $sub $cmd $val cmd
+ }
+
+ # This is really weird. If our char is '\', the lappend line
+ # makes it a quoted \\, but the previous regsub makes it back
+ # to a single quote. So we use regsub again to make it a \\
+ # again. But that's not enough, because uplevel will change it
+ # back to a single quote and will eventually mess us up. Hence
+ # we use quad-slashes here!
+ #
+ regsub -all {[\\]} $cmd {\\\\} cmd
+ uplevel #0 $cmd
+ }
+ }
+ if {$found == 0} {
+ puts "warning: widget $w has no bindings for $type"
+ }
+ return $found
+
+}
+
+# KeyboardEvent --
+#
+# Send a special keyboard event to the widget. E.g., <Return>
+# <space>, <Escape>, <BackSpace> etc. To send ascii character
+# strings, use KeyboardString
+#
+proc KeyboardEvent {w type} {
+ set tags [bindtags $w]
+
+ lappend args %q
+ lappend args $w
+ lappend args %W
+ lappend args $w
+
+ set found 0
+ foreach t $tags {
+ set cmd [string trim [bind $t $type]]
+
+ if {$cmd != ""} {
+ set found 1
+ }
+ tixForEach {sub val} $args {
+ regsub -all $sub $cmd $val cmd
+ }
+ uplevel #0 $cmd
+ }
+ if {$found == 0} {
+ puts "warning: widget $w has no bindings for $type"
+ }
+ return $found
+}
+
+proc Event-Initialize {} {
+ global app
+
+ set app(X) -1000
+ set app(Y) -1000
+ set app(curWid) {}
+}
+
+proc InWidget {w} {
+ global app
+
+ return [tixWithinWindow $w $app(X) $app(Y)]
+}
+
+proc Leave {w {x -10} {y -10} args} {
+ global app
+
+ eval MouseEvent $w <Leave> $x $y $args
+}
+
+proc B1-Leave {w {x -10} {y -10} args} {
+ global app
+
+ eval MouseEvent $w <Leave> $x $y $args
+}
+
+proc RecordRoot {w x y} {
+ global app
+
+ GetRoot $w $x $y
+ set app(X) $X
+ set app(Y) $Y
+}
+
+proc Enter {w {x -1} {y -1} args} {
+ global app
+
+ if {$y == -1} {
+ set x [expr [winfo width $w] / 2]
+ set y [expr [winfo height $w] / 2]
+ }
+
+ if {$app(curWid) != {} && [winfo exists $app(curWid)]} {
+ Leave $app(curWid)
+ }
+ RecordRoot $w $x $y
+
+ eval MouseEvent $w <Enter> $x $y $args
+ set app(curWid) $w
+}
+
+proc Drag {w {x -1} {y -1} args} {
+ global app
+
+ if {$y == -1} {
+ set x [expr [winfo width $w] / 2]
+ set y [expr [winfo height $w] / 2]
+ }
+
+ if {![InWidget $w]} {
+ B1-Leave $w $x $y
+ }
+
+ eval MouseEvent $w <B1-Motion> $x $y $args
+}
+
+# Release --
+#
+# Release mouse button 1 in a widget
+#
+proc Release {w {x -1} {y -1} args} {
+ global app
+
+ if {$y == -1} {
+ set x [expr [winfo width $w] / 2]
+ set y [expr [winfo height $w] / 2]
+ }
+ eval MouseEvent $w <ButtonRelease-1> $x $y $args
+}
+
+# Assumming the button was not originally down
+#
+proc HoldDown {w {x -1} {y -1} args} {
+ global app
+
+ if {$y == -1} {
+ set x [expr [winfo width $w] / 2]
+ set y [expr [winfo height $w] / 2]
+ }
+ if {![InWidget $w]} {
+ Enter $w $x $y
+ }
+
+ if {![eval MouseEvent $w <ButtonPress-1> $x $y $args]} {
+ eval MouseEvent $w <1> $x $y $args
+ }
+}
+
+proc Click {w {x -1} {y -1} args} {
+ global app
+
+ if {$y == -1} {
+ set x [expr [winfo width $w] / 2]
+ set y [expr [winfo height $w] / 2]
+ }
+ eval HoldDown $w $x $y $args
+ eval MouseEvent $w <ButtonRelease-1> $x $y $args
+}
+
+proc Double {w {x -1} {y -1} args} {
+ global app
+
+ if {$y == -1} {
+ set x [expr [winfo width $w] / 2]
+ set y [expr [winfo height $w] / 2]
+ }
+ eval MouseEvent $w <Double-1> $x $y $args
+}
+
+# ClickListboxEntry --
+#
+# Simulate the event where a listbox entry is clicked.
+# Args:
+# w:widget pathname of listbox
+# index:LbIndex index of entry to be clicked.
+# mode:string "single" or "double" indicating whether a single or
+# double click is desired.
+#
+proc ClickListboxEntry {w index {mode single}} {
+ $w see $index
+ set bbox [$w bbox $index]
+ set x1 [lindex $bbox 0]
+ set y1 [lindex $bbox 1]
+
+ if {$mode == "single"} {
+ Click $w $x1 $y1
+ } else {
+ Double $w $x1 $y1
+ }
+}
+
+# ClickHListEntry --
+#
+# Simulate the event where an HList entry is clicked.
+# Args:
+# w:widget pathname of HList
+# index:HLIndex index of entry to be clicked.
+# mode:string "single" or "double" indicating whether a single or
+# double click is desired.
+#
+proc ClickHListEntry {w index {mode single}} {
+ $w see $index
+ update
+ set bbox [$w info bbox $index]
+ set x1 [lindex $bbox 0]
+ set y1 [lindex $bbox 1]
+
+ if {$mode == "single"} {
+ Click $w $x1 $y1
+ } else {
+ Double $w $x1 $y1
+ }
+}
+
+# InvokeComboBoxByKey --
+#
+# Simulate the event when the user types in a string into the
+# entry subwidget of a ComboBox widget and then type Return
+#
+proc InvokeComboBoxByKey {w string} {
+ set ent [$w subwidget entry]
+ $ent delete 0 end
+ KeyboardString $ent $string
+ KeyboardEvent $ent <Return>
+ update
+}
+
+# SetComboBoxByKey --
+#
+# Simulate the event when the user types in a string into the
+# entry subwidget of a ComboBox widget, *without* a subsequent
+# Return keystroke.
+#
+proc SetComboBoxByKey {w string} {
+ set ent [$w subwidget entry]
+ $ent delete 0 end
+ KeyboardString $ent $string
+ update
+}
+
+#----------------------------------------------------------------------
+#
+# main routines
+#
+#----------------------------------------------------------------------
+
+proc Done {args} {
+ global testConfig
+
+ if {$testConfig(VERBOSE) >= 20} {
+ puts "------------------------done--------------------------------"
+ }
+}
+
+proc Wait {msecs} {
+ global Test:timer
+ set Test:timer 0
+ after $msecs uplevel #0 set Test:timer 1
+ tkwait variable Test:timer
+}
+
+proc TestPuts {msg} {
+ puts $msg
+}
+
+#----------------------------------------------------------------------
+#
+# Messages
+#
+#----------------------------------------------------------------------
+proc PutP {msg} {
+ puts $msg
+}
+proc PutTitle {msg} {
+ puts $msg
+}
+proc PutSubTitle {msg} {
+ puts $msg
+}
+proc PutSubSubTitle {msg} {
+ puts $msg
+}
+proc TestWarn {msg} {
+ puts "Warning: $msg"
+}
+proc TestError {msg {printErrInfo 0} {abortMode cont}} {
+ global testConfig
+ puts " $msg"
+ case $abortMode {
+ cont {
+ if {$printErrInfo || $testConfig(VERBOSE) >= 30} {
+ global errorInfo
+ puts "\$errorInfo = $errorInfo"
+ }
+ return
+ }
+ abortfile {
+ return -code 1234
+ }
+ abortall {
+ global errorInfo
+ puts "Aborting all test files because of the unrecoverable error:"
+ puts $errorInfo
+ exit 1
+ }
+ }
+}
+
+# TestBlock --
+#
+# Performs a block of test. A block is mainly used to group
+# together tests that are dependent on each other. TestBlocks
+# may be nested.
+#
+# Args:
+# name: Textual name of the test. E.g.: button-1.1
+# description: Short description of the test. "Pressing button"
+# printErrInfo: If an error occurs, should the errorInfo be printed
+# to the console. (Normally only a one-liner error
+# message is printed).
+# abortMode: cont -- skip this block and go to the next block
+# abortfile -- skip all other blocks in this file
+# abortall -- skip all the Tix tests.
+#
+proc TestBlock {name description script {printErrInfo 0} {abortMode cont}} {
+ global testConfig
+
+ set code [catch {uplevel 1 $script} result]
+
+ if {$testConfig(VERBOSE) >= 15} {
+ set des "($description)"
+ } else {
+ set des ""
+ }
+
+ if {$code != 0} {
+ incr testConfig(errCount)
+ puts stdout "---- $name FAILED $des"
+ puts "Script is"
+ foreach line [split $script \n] {
+ regsub "^\[[format %s \ \n\t]\]*" $line "" line
+ puts " $line"
+ }
+ puts "Error message:"
+ TestError $result $printErrInfo $abortMode
+ puts stdout "----"
+ } elseif $testConfig(VERBOSE) {
+ puts stdout "++++ $name PASSED $des"
+ }
+}
+
+#----------------------------------------------------------------------
+#
+# general initialization
+#
+#----------------------------------------------------------------------
+
+# init the event emulation
+#
+
+# some window managers don't put the main window at a default place, this
+# may be quite annoying for the user
+#
+wm geometry . +0+0
+
diff --git a/tix/tests/library/TestLib.txt b/tix/tests/library/TestLib.txt
new file mode 100644
index 00000000000..43aea02c9e2
--- /dev/null
+++ b/tix/tests/library/TestLib.txt
@@ -0,0 +1,53 @@
+HIGH LEVEL INTERFACE FOR INTERACTIVE TESTING
+--------------------------------------------
+Click:
+
+ Simulates a the event when a user moves the mouse pointer into
+ the widget (if the cursor is still outside of the widget), press
+ the button and release it.
+
+
+Double:
+
+ Simulates a the event when a user moves the mouse pointer into
+ the widget (if the cursor is still outside of the widget), double-click
+ the button and release it.
+
+
+MESSAGE PRINTING
+----------------
+
+PutP
+
+ Prints a progress message.
+
+PutTitle
+
+ Prints the title of a test file
+
+PutSubTitle
+
+ Print the title of a part of a test file
+
+PutSubSubTitle
+
+ One more level than PutSubTitle
+
+TestWarn
+
+ Print a warning message. This will be counted in the final report.
+
+TestError {msg {printErrInfo 0} {abortMode cont}}
+
+ Print an error message. abortMode controls how the error affects
+ other test cases:
+
+ cont: simply print the message and continue
+ abortfile: skip other test cases in this file
+ abortall: abort the all other tests and exit the test
+ program.
+
+ printErrInfo specifies whether the "$errorInfo" variable should be
+ printed.
+
+
diff --git a/tix/tests/library/load-init.tcl b/tix/tests/library/load-init.tcl
new file mode 100644
index 00000000000..b383e8b8cb2
--- /dev/null
+++ b/tix/tests/library/load-init.tcl
@@ -0,0 +1,7 @@
+#
+#
+#
+
+puts -nonewline "trying to load the Tix dynamic library ... "
+load ../../unix-tk4.1/libtix.so Tix
+puts "done"
diff --git a/tix/tests/load/files b/tix/tests/load/files
new file mode 100644
index 00000000000..3026fe89955
--- /dev/null
+++ b/tix/tests/load/files
@@ -0,0 +1 @@
+general.tcl
diff --git a/tix/tests/load/general.tcl b/tix/tests/load/general.tcl
new file mode 100644
index 00000000000..e1744bcaef2
--- /dev/null
+++ b/tix/tests/load/general.tcl
@@ -0,0 +1,22 @@
+# This file tests the pixmap image reader
+#
+
+proc About {} {
+ return "This file performs general test on Tix w/ Tk 4.1 dynamic loading"
+}
+
+proc Test {} {
+ if [tixStrEq [info commands tix] tix] {
+ return
+ }
+
+ if ![file exists ../../unix-tk4.1/libtix.so] {
+ puts "File ../../unix-tk4.1/libtix.so doesn't exist."
+ puts "Dynamic loading skipped."
+ return
+ }
+
+ test {load ../../unix-tk4.1/libtix.so Tix}
+ test {tixComboBox .c}
+ test {pack .c}
+}
diff --git a/tix/tests/load/pkginit.tcl b/tix/tests/load/pkginit.tcl
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/tix/tests/load/pkginit.tcl
diff --git a/tix/tests/tlist/TList.tcl b/tix/tests/tlist/TList.tcl
new file mode 100644
index 00000000000..536f8b8c8f4
--- /dev/null
+++ b/tix/tests/tlist/TList.tcl
@@ -0,0 +1,38 @@
+# This tests the TList widget.
+#
+#
+# Assumptions:
+# None
+#
+proc About {} {
+ return "Basic tests for the TList widget"
+}
+
+proc Test {} {
+
+ #
+ # Test the creation
+ #
+ test {tixTList} {args}
+ test {tixTList .t -ff} {unknown}
+ test {tixTList .t -width} {missing}
+
+ if {[info command .t] != {}} {
+ error "widget not destroyed when creation failed"
+ }
+
+ set t [tixTList .t]
+ test {$t} {args}
+
+ #
+ # Test the "insert" command
+ #
+ test {$t insert} {args}
+ test {$t insert 0 -foo} {missing}
+ test {$t insert 0 -foo bar} {unknown}
+ test {$t insert 0 -itemtype foo} {unknown}
+ test {$t insert 0 -itemtype text -image foo} {unknown}
+ test {$t insert 0 -itemtype text -text Hello}
+
+ pack $t
+}
diff --git a/tix/tests/tlist/files b/tix/tests/tlist/files
new file mode 100644
index 00000000000..7c39b5b8cac
--- /dev/null
+++ b/tix/tests/tlist/files
@@ -0,0 +1 @@
+TList.tcl \ No newline at end of file
diff --git a/tix/tests/xpm/2cpp.xpm b/tix/tests/xpm/2cpp.xpm
new file mode 100644
index 00000000000..bd559d249c3
--- /dev/null
+++ b/tix/tests/xpm/2cpp.xpm
@@ -0,0 +1,11 @@
+/* XPM */
+static char * folder_xpm[] = {
+"4 4 3 2",
+ "AA c black",
+".. c white",
+"XY c yellow",
+"AAAAAAXY",
+"XYAAAAAA",
+"..AA..AA",
+"..AAAA..",
+};
diff --git a/tix/tests/xpm/brace.xpm b/tix/tests/xpm/brace.xpm
new file mode 100644
index 00000000000..805494c4ea9
--- /dev/null
+++ b/tix/tests/xpm/brace.xpm
@@ -0,0 +1,19 @@
+/* XPM */
+static char * tmp [] = {
+/* width height ncolors cpp [x_hot y_hot] */
+"10 10 2 1 -1 -1",
+/* colors */
+" s iconColor1 m black c gray",
+"} s iconColor2 m white c white",
+/* pixels */
+" ",
+" ",
+" ",
+" ",
+" ",
+"}}}}}}}}}}",
+"}}}}}}}}}}",
+"}}}}}}}}}}",
+"}}}}}}}}}}",
+"}}}}}}}}}}"};
+
diff --git a/tix/tests/xpm/comments.xpm b/tix/tests/xpm/comments.xpm
new file mode 100644
index 00000000000..de45058d570
--- /dev/null
+++ b/tix/tests/xpm/comments.xpm
@@ -0,0 +1,21 @@
+/* XPM */
+static char * tmp [] = {
+/* width height ncolors cpp [x_hot y_hot] */
+/* width height ncolors cpp [x_hot y_hot] */ /* Some comments */
+"10 10 2 1 -1 -1",
+/* colors */
+" s iconColor1 m black c gray",
+"} s iconColor2 m white c white",
+/* pixels */
+" ",
+" ",
+" ",
+" ",
+ /* Some comments */
+" ",
+"}}}}}}}}}}",
+"}}}}}}}}}}",
+"}}}}}}}}}}" /* Some comments */,
+"}}}}}}}}}}",
+"}}}}}}}}}}" /* Some comments */};
+
diff --git a/tix/tests/xpm/compound.tcl b/tix/tests/xpm/compound.tcl
new file mode 100644
index 00000000000..603db3d39b3
--- /dev/null
+++ b/tix/tests/xpm/compound.tcl
@@ -0,0 +1,47 @@
+proc About {} {
+ return "the compound image type"
+}
+
+proc Test {} {
+ set num 3
+ # Test for create
+ #
+ #
+ test {image create compound -foo} {missing}
+ test {image create compound -window} {missing}
+ test {image create compound -window foo} {path name}
+ test {set image1 [image create compound -window .b]} {path name}
+
+ for {set i 0} {$i < $num} {incr i} {
+ button .b$i
+ pack .b$i
+ }
+
+ # (0) Empty image
+ #
+ test {set image0 [image create compound -window .b0]}
+
+ # (1) Simple image
+ #
+ test {set image1 [image create compound -window .b1]}
+
+ $image1 add line
+ $image1 add text -text Hello
+
+ # (2) Two lines
+ #
+ test {set image2 [image create compound -window .b2]}
+
+ $image2 add line
+ $image2 add text -text "Line One"
+ $image2 add line
+ $image2 add text -text "Line Two"
+
+
+ # Display them
+ #
+ for {set i 0} {$i < $num} {incr i} {
+ .b$i config -image [set image$i]
+ }
+
+}
diff --git a/tix/tests/xpm/f-badcol.xpm b/tix/tests/xpm/f-badcol.xpm
new file mode 100644
index 00000000000..7e27b863d43
--- /dev/null
+++ b/tix/tests/xpm/f-badcol.xpm
@@ -0,0 +1,21 @@
+/* XPM */
+static char * folder_xpm[] = {
+/* width height num_colors chars_per_pixel */
+"16 12 3 1",
+/* colors */
+" s None c None",
+". c black",
+"X c foooo",
+/* pixels */
+" .... ",
+" .XXXX. ",
+" .XXXXXX. ",
+"............. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+"............. "};
diff --git a/tix/tests/xpm/f-badpix.xpm b/tix/tests/xpm/f-badpix.xpm
new file mode 100644
index 00000000000..fdb4cb13f5b
--- /dev/null
+++ b/tix/tests/xpm/f-badpix.xpm
@@ -0,0 +1,21 @@
+/* XPM */
+static char * folder_xpm[] = {
+/* width height num_colors chars_per_pixel */
+"16 12 3 1",
+/* colors */
+" s None c None",
+". c black",
+"X c #f0ff80",
+/* pixels */
+" .... ",
+" .XXXX. ",
+" .XXXXXX. ",
+"............. ",
+".XBBBBBBXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXBBXXX. ",
+".XXBBBBBBXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXNNXXX. ",
+".XXXXXXXXXXX. ",
+"............. "};
diff --git a/tix/tests/xpm/f-commt.xpm b/tix/tests/xpm/f-commt.xpm
new file mode 100644
index 00000000000..3158fd20782
--- /dev/null
+++ b/tix/tests/xpm/f-commt.xpm
@@ -0,0 +1,32 @@
+/* XPM */
+static char * folder_xpm[] = {
+/* width height num_colors chars_per_pixel */
+"16 12 3 1",
+/* colors */
+" s None c None",
+". c black",
+"X c #f0ff80",
+/* pixels
+
+asd
+a
+sd
+as
+da
+sd
+asad
+
+
+ */
+" .... ",
+" .XXXX. ",
+" .XXXXXX. ",
+"............. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+"............. "};
diff --git a/tix/tests/xpm/f-missline.xpm b/tix/tests/xpm/f-missline.xpm
new file mode 100644
index 00000000000..e9f04c0f78c
--- /dev/null
+++ b/tix/tests/xpm/f-missline.xpm
@@ -0,0 +1,19 @@
+/* XPM */
+static char * folder_xpm[] = {
+/* width height num_colors chars_per_pixel */
+"16 12 3 1",
+/* colors */
+" s None c None",
+". c black",
+"X c foooo",
+/* pixels */
+" .... ",
+" .XXXX. ",
+" .XXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+"............. "};
diff --git a/tix/tests/xpm/f-ok.xpm b/tix/tests/xpm/f-ok.xpm
new file mode 100644
index 00000000000..fda7c15a549
--- /dev/null
+++ b/tix/tests/xpm/f-ok.xpm
@@ -0,0 +1,21 @@
+/* XPM */
+static char * folder_xpm[] = {
+/* width height num_colors chars_per_pixel */
+"16 12 3 1",
+/* colors */
+" s None c None",
+". c black",
+"X c #f0ff80",
+/* pixels */
+" .... ",
+" .XXXX. ",
+" .XXXXXX. ",
+"............. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+"............. "};
diff --git a/tix/tests/xpm/f-shortln.xpm b/tix/tests/xpm/f-shortln.xpm
new file mode 100644
index 00000000000..6a6f8f2ac45
--- /dev/null
+++ b/tix/tests/xpm/f-shortln.xpm
@@ -0,0 +1,21 @@
+/* XPM */
+static char * folder_xpm[] = {
+/* width height num_colors chars_per_pixel */
+"16 12 3 1",
+/* colors */
+" s None c None",
+". c black",
+"X c #f0ff80",
+/* pixels */
+" .... ",
+" .XXXX. ",
+" .XXXXXX. ",
+"............. ",
+".XXXXXXXXXXX. ",
+".XX",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XX. ",
+".XX. ",
+".XX. ",
+"............. "};
diff --git a/tix/tests/xpm/files b/tix/tests/xpm/files
new file mode 100644
index 00000000000..73010a9b47e
--- /dev/null
+++ b/tix/tests/xpm/files
@@ -0,0 +1,2 @@
+xpm.tcl
+compound.tcl \ No newline at end of file
diff --git a/tix/tests/xpm/folder.xpm b/tix/tests/xpm/folder.xpm
new file mode 100644
index 00000000000..fda7c15a549
--- /dev/null
+++ b/tix/tests/xpm/folder.xpm
@@ -0,0 +1,21 @@
+/* XPM */
+static char * folder_xpm[] = {
+/* width height num_colors chars_per_pixel */
+"16 12 3 1",
+/* colors */
+" s None c None",
+". c black",
+"X c #f0ff80",
+/* pixels */
+" .... ",
+" .XXXX. ",
+" .XXXXXX. ",
+"............. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+".XXXXXXXXXXX. ",
+"............. "};
diff --git a/tix/tests/xpm/xpm.tcl b/tix/tests/xpm/xpm.tcl
new file mode 100644
index 00000000000..f1eee30932c
--- /dev/null
+++ b/tix/tests/xpm/xpm.tcl
@@ -0,0 +1,145 @@
+proc About {} {
+ return "the pixmap image reader"
+}
+
+proc Test {} {
+
+ set data {
+/* XPM */
+static char * folder_xpm[] = {
+/* width height num_colors chars_per_pixel */
+"16 12 4 1",
+/* colors */
+" s None c None",
+". c black",
+"X c #f0ff80",
+"+ c red",
+/* pixels */
+" .... ",
+" .XXXX. ",
+" .XXXXXX. ",
+"............. ",
+".XXXXXXXXXXX. ",
+".XXXXX+XXXXX. ",
+".XXXXX+XXXXX. ",
+".XX+++++++XX. ",
+".XXXXX+XXXXX. ",
+".XXXXX+XXXXX. ",
+".XXXXXXXXXXX. ",
+"............. "};
+ }
+
+set data1 {
+/* XPM */
+static char * news4_xpm[] = {
+/* width height ncolors chars_per_pixel */
+"45 34 6 1",
+/* colors */
+" s None c None",
+". c black",
+"X c lemon chiffon",
+"o c tan",
+"O c blue",
+"+ c dark slate grey",
+/* pixels */
+" ",
+" ",
+" . ",
+" .X. ",
+" ..XX. ",
+" .XXX.X. ",
+" .XXX.XX. ",
+" .XXX.XXXX. ",
+" ..XXX.XXX.XX. ",
+" .XX...XXX.o..X. ",
+" .XX.OO.XX.oooo.X.. ",
+" .XXX..O.X.oo..oo..X.. ",
+" ..XXX.X..XX..o...oo.XXX. ",
+" .XXXX.XXXXX.XX.oo...XXXXX. ",
+" .XX..XXXX..XXXX.o.XXXX.XXX. ",
+" .X.X.XXXX.XXX.XX..XXX..XXXX. ",
+" ..X.XXXXX.XX..XXXXXXX.XXXX.XX. ",
+" .X.X.XXX.XX.XXXX.XXX.XXXX.XXX. ",
+" .X.X.X.XX.XXXX.XXXXXXX..XXX.. ",
+" .X.X.XX.XXX..XX.XXXX.XXX...+ ",
+" ++.X.X.XXXX.XXX.XXXX.XXX..++ ",
+" ++++.X.X.XX.XX..XXX.XXXX..++ ",
+" +++++.X.X.XXX.XXXX.XXX...++ ",
+" +++++.X.X.X.XXX..XXX..+++ ",
+" +++++.X.X.XXX.XXXX..++ ",
+" +++++.X.X.X.XXX...++ ",
+" ++++.X.X.XXX..+++ ",
+" ++++.X.X.X..++ ",
+" +++.XX...++ ",
+" ++...+++ ",
+" ++++ ",
+" ",
+" ",
+" "};
+}
+
+
+ # Test for create
+ #
+ #
+
+ # Good pixmap
+ #
+ test {set pixmap1 [image create pixmap -file f-ok.xpm]}
+
+ # With some comments
+ #
+ test {set pixmap2 [image create pixmap -file f-commt.xpm]}
+
+ # Bad color (should use "black" by default)
+ #
+ test {set pixmap3 [image create pixmap -file f-badcol.xpm]}
+
+ # Shortened lines (should show garbage, shouldn't core dump)
+ #
+ test {set pixmap4 [image create pixmap -file f-shortln.xpm]}
+
+ # Two chars per pixel
+ #
+ test {set pixmap5 [image create pixmap -file 2cpp.xpm]}
+
+ # Bad pixel (should show garbage for undefined pixels)
+ #
+ test {set pixmap6 [image create pixmap -file f-badpix.xpm]}
+
+
+ # Data switch
+ #
+ test {set pixmap7 [image create pixmap -data $data]}
+
+
+ # Missing one line
+ #
+ test {image create pixmap -file f-missline.xpm} {File For}
+
+ # Multi-word color names
+ #
+ test {set pixmap8 [image create pixmap -data $data1]}
+
+ # Brace used as pixel value
+ #
+ test {set pixmap9 [image create pixmap -file brace.xpm]}
+
+ # Many /* ... */ comments
+ #
+ test {set pixmap10 [image create pixmap -file brace.xpm]}
+
+ set num 10
+ for {set i 1} {$i < $num} {incr i} {
+ button .b$i -image [set pixmap$i] -bg red
+ pack .b$i
+ }
+
+ update
+
+ for {set i 1} {$i < $num} {incr i} {
+ destroy .b$i
+ image delete [set pixmap$i]
+ }
+
+}
diff --git a/tix/tixConfig.sh.in b/tix/tixConfig.sh.in
new file mode 100644
index 00000000000..dbc4807a914
--- /dev/null
+++ b/tix/tixConfig.sh.in
@@ -0,0 +1,25 @@
+# tixConfig.sh --
+#
+# This shell script (for sh) is generated automatically by Tix'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 Tcl extensions so that they don't have to figure this all
+# out for themselves.
+#
+# The information in this file is specific to a single platform.
+#
+# SCCS: @(#) tclConfig.sh.in 1.20 97/07/01 11:40:19
+
+# String to pass to linker to pick up the Tcl library from its
+# build directory.
+TIX_BUILD_LIB_SPEC='@TIX_BUILD_LIB_SPEC@'
+
+# The name of the tix library. Used for dependencies...
+TIX_LIB_FILE='@TIX_LIB_FILE@'
+
+# The directory where tix was build.
+TIX_BUILD_LOCATION='@TIX_BUILD_LOCATION@'
+
+# The full pathname to the tix library.
+TIX_LIB_FULL_PATH='@TIX_LIB_FULL_PATH@'
diff --git a/tix/tools/README.html b/tix/tools/README.html
new file mode 100644
index 00000000000..aa185cc112c
--- /dev/null
+++ b/tix/tools/README.html
@@ -0,0 +1,32 @@
+<TITLE>Tix Tools</TITLE>
+<Center><H1>Tix Tools</H1></Center>
+
+<h3><a href="color.tcl">color.tcl</a></h3>
+
+ <code>color.tcl</code> displays all the available colors in your X
+ display. This program requires <code>tixwish</code>.
+
+<h3><a href="hanno.tcl">hanno.tcl</a> -- An HTML Annotation Program</h3>
+
+ <code>hanno.tcl</code> automatically generates a "Last Modified"
+tag for HTML files. It recursively traverses all sub-directories
+and generates a "Last Modified" tag for each HTML file according
+to the file's last modification date. Please read the file for
+available options.
+
+<h3><a href="tcltrim">tcltrim</a></h3>
+
+ <code>tcltrim</code> trims all comments and white spaces from TCL
+ files.
+
+<h3><a href="tixindex">tixindex</a></h3>
+
+ <code>tixindex</code> builds the tclIndex file for the Tix widget
+ implementation files. You must use this program to index the Tix
+ librarys instead of the normal TCL <code>auto_mkindex</code>
+ command.
+
+
+<!Serial 851729152>
+<hr><i>Last modified Fri Jan 17 23:03:15 EST 1997 </i> ---
+<i>Serial 853731308</i>
diff --git a/tix/tools/color.tcl b/tix/tools/color.tcl
new file mode 100755
index 00000000000..40bcc512149
--- /dev/null
+++ b/tix/tools/color.tcl
@@ -0,0 +1,39 @@
+#! /usr/local/bin/tixwish
+
+proc readfile {w} {
+ global color
+
+ set file [open /usr/lib/X11/rgb.txt RDONLY]
+ while {[eof $file] == 0} {
+ set line [gets $file]
+
+ set name [lrange $line 3 end]
+ set color($name,r) [lindex $line 0]
+ set color($name,g) [lindex $line 1]
+ set color($name,b) [lindex $line 2]
+ $w insert end $name
+ }
+ close $file
+
+ bind $w <ButtonRelease-1> "+setcolor $w %y"
+}
+
+proc setcolor {w y} {
+ global color
+ set name [$w get [$w nearest $y]]
+
+ .f config -bg $name
+ .g config -bg $name
+}
+
+proc start {} {
+ frame .f -relief raised -bd 2 -width 100 -height 10
+ frame .g -relief sunken -bd 2 -width 100 -height 10
+ tixScrolledListBox .b
+ readfile [.b subwidget listbox]
+
+ pack .f .g .b -side left -expand yes -fill both -padx 3 -pady 3
+ wm minsize . 0 0
+}
+
+start
diff --git a/tix/tools/doconfig.tcl b/tix/tools/doconfig.tcl
new file mode 100755
index 00000000000..e016f2e4f3c
--- /dev/null
+++ b/tix/tools/doconfig.tcl
@@ -0,0 +1,746 @@
+#!/bin/sh
+# the next line restarts using tclsh \
+exec tclsh "$0" "$@"
+
+source [file join [file dirname [info script]] doxx.tcl]
+
+
+p {
+dnl This file is an input file used by the GNU "autoconf" program to
+dnl generate the file "configure", which is run to configure the
+dnl Makefile in this directory.
+
+AC_INIT(../../generic/tixInit.c)
+
+#--------------------------------------------------------------------
+# Remove the ./config.cache file and rerun configure if
+# the cache file belong to a different architecture
+#----------------------------------------------------------------------
+AC_CHECK_PROG(UNAME, uname -a, [uname -a], "")
+if test "$UNAME" = ""; then
+ AC_CHECK_PROG(UNAME, uname, [uname], "")
+fi
+
+if test "$UNAME" != ""; then
+ uname=`$UNAME`
+ AC_MSG_CHECKING([cached value of \$uname])
+ AC_CACHE_VAL(ac_cv_prog_uname, [nocached=1 ac_cv_prog_uname=`$UNAME`])
+ if test "$nocached" = "1"; then
+ AC_MSG_RESULT(no)
+ else
+ AC_MSG_RESULT(yes)
+ fi
+
+ if test "$uname" != "$ac_cv_prog_uname"; then
+ echo "Running on a different machine/architecture. Can't use cached values"
+ echo "Removing config.cache and running configure again ..."
+ rm -f config.cache
+ CMDLINE="$0 $*"
+ exec $CMDLINE
+ fi
+fi
+
+#----------------------------------------------------------------------
+# We don't want to use any relative path because we need to generate
+# Makefile's in subdirectories
+#----------------------------------------------------------------------
+if test "$INSTALL" = "./install.sh"; then
+ INSTALL=`pwd`/install.sh
+fi
+
+#--------------------------------------------------------------------
+# Version information about this TIX release.
+#--------------------------------------------------------------------
+
+TIX_VERSION=4.1
+TIX_MAJOR_VERSION=4
+TIX_MINOR_VERSION=1
+}
+
+if !$ITCL {
+ p {
+BIN_VERSION=${TIX_VERSION}.@@_V_TCL_VER_@@
+ }
+} else {
+ p {
+BIN_VERSION=${TIX_VERSION}.@@_V_TCL_VER_@@.1
+ }
+}
+
+p {
+
+VERSION=${BIN_VERSION}
+
+#--------------------------------------------------------------------
+# See if user wants to use gcc to compile Tix. This option must
+# be used before any checking that uses the C compiler.
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(gcc, [ --enable-gcc allow use of gcc if available],
+ [tix_ok=$enableval], [tix_ok=no])
+if test "$tix_ok" = "yes"; then
+ AC_PROG_CC
+else
+ CC=${CC-cc}
+AC_SUBST(CC)
+fi
+
+AC_PROG_INSTALL
+AC_PROG_RANLIB
+AC_HAVE_HEADERS(unistd.h limits.h)
+AC_PROG_MAKE_SET
+
+#--------------------------------------------------------------------
+# unsigned char is not supported by some non-ANSI compilers.
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING([unsigned char])
+AC_TRY_COMPILE([#include <stdio.h>],[
+ unsigned char c = 'c';
+], tcl_ok=supported, tcl_ok=not supported)
+
+AC_MSG_RESULT($tcl_ok)
+if test $tcl_ok = supported; then
+ AC_DEFINE(UCHAR_SUPPORTED)
+fi
+
+#--------------------------------------------------------------------
+# Check whether there is an strcasecmp function on this system.
+# This is a bit tricky because under SCO it's in -lsocket and
+# under Sequent Dynix it's in -linet.
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(strcasecmp, tcl_ok=1, tcl_ok=0)
+if test "$tcl_ok" = 0; then
+ AC_CHECK_LIB(socket, strcasecmp, tcl_ok=1, tcl_ok=0)
+fi
+if test "$tcl_ok" = 0; then
+ AC_CHECK_LIB(inet, strcasecmp, tcl_ok=1, tcl_ok=0)
+fi
+if test "$tcl_ok" = 0; then
+ AC_DEFINE(NO_STRCASECMP)
+fi
+}
+
+# LocatePkg75 --
+#
+# This procedure is used to locate Tcl, Tk and ITcl packages for
+# tcl versions 7.5, 7.6, 7.7 and 8.0 and itcl 2.1, 2.2. It should be
+# able to work with a higher version of Tcl if its directory structure
+# is similar to Tcl 7.5~8.0
+#
+proc LocatePkg75 {} {
+ global ITCL
+
+set template {
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Pkg is; if
+# not, assume that its top-level directory is a sibling of ours.
+#--------------------------------------------------------------------
+
+AC_ARG_WITH(pkg, [ --with-pkg=DIR use Pkg @@_V_PKG_VER_@@ source from DIR],
+ val=$withval, val="")
+
+AC_MSG_CHECKING([Pkg source directory])
+
+if test "$val" != ""; then
+ PKG_SRC_DIR=$val
+ if test ! -d $PKG_SRC_DIR; then
+ AC_MSG_ERROR(Directory $PKG_SRC_DIR doesn't exist)
+ AC_MSG_ERROR(Please install the source code of Pkg @@_V_PKG_VER_@@)
+ exit 1
+ fi
+else
+ dirs="../../../pkg@@_V_PKG_VER_@@*"
+ PKG_SRC_DIR="no-no"
+ for i in $dirs; do
+ if test -d $i; then
+ PKG_SRC_DIR=`cd $i; pwd`
+ fi
+ done
+
+ if test ! -d $PKG_SRC_DIR; then
+ AC_MSG_ERROR(Cannot locate Pkg source directory in $dirs)
+ AC_MSG_ERROR(Please install the source code of Pkg @@_V_PKG_VER_@@)
+ exit 1
+ fi
+fi
+AC_MSG_RESULT($PKG_SRC_DIR)
+
+PKG_BIN_DIR=$PKG_SRC_DIR/unix
+}
+
+if !$ITCL {
+ #
+ # Do Tcl
+ #
+ set str $template
+ regsub -all PKG $str TCL str
+ regsub -all Pkg $str Tcl str
+ regsub -all pkg $str tcl str
+ p $str
+
+ #
+ # Do Tk
+ #
+ set str $template
+ regsub -all PKG $str TK str
+ regsub -all Pkg $str Tk str
+ regsub -all pkg $str tk str
+ p $str
+} else {
+ #
+ # Do ITcl
+ #
+ set str $template
+ regsub -all PKG $str ITCL str
+ regsub -all Pkg $str ITcl str
+ regsub -all pkg $str itcl str
+ p $str
+ p {
+ITCL_ROOT_DIR=$ITCL_SRC_DIR
+
+TCL_SRC_DIR=$ITCL_ROOT_DIR/tcl@@_V_TCL_VER_@@
+TK_SRC_DIR=$ITCL_ROOT_DIR/tk@@_V_TK_VER_@@
+
+TCL_BIN_DIR=$TCL_SRC_DIR/unix
+TK_BIN_DIR=$TK_SRC_DIR/unix
+ }
+}
+
+}
+
+LocatePkg75
+
+p {
+#--------------------------------------------------------------------
+# Find out the top level source directory of the Tix package.
+#--------------------------------------------------------------------
+TIX_SRC_DIR=`cd ../..; pwd`
+}
+
+p_sam {
+#--------------------------------------------------------------------
+# See if we should compile SAM
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(sam,
+ [ --enable-sam build stand-alone modules],
+ [ok=$enableval], [ok=no])
+
+if test "$ok" = "yes"; then
+ TIX_BUILD_SAM="yes"
+ TIX_SAM_TARGETS='$(SAM_TARGETS)'
+else
+ TIX_BUILD_SAM="no"
+fi
+}
+
+if $ENABLE_SAM {
+ if $SAM_EXE {
+ p {
+ TIX_SAM_INSTALL="_install_sam_exe_ _install_sam_lib_"
+ }
+ } else {
+ p {
+ TIX_SAM_INSTALL=_install_sam_lib_
+ }
+ }
+}
+
+##
+## Tcl 7.4 --> we need to find the location of the X libs, etc.
+##
+
+p74 {
+#--------------------------------------------------------------------
+# Supply a substitute for stdlib.h if it doesn't define strtol,
+# strtoul, or strtod (which it doesn't in some versions of SunOS).
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING(stdlib.h)
+AC_HEADER_EGREP(strtol, stdlib.h, tk_ok=yes, tk_ok=no)
+AC_HEADER_EGREP(strtoul, stdlib.h, , tk_ok=no)
+AC_HEADER_EGREP(strtod, stdlib.h, , tk_ok=no)
+if test $tk_ok = no; then
+ AC_DEFINE(NO_STDLIB_H)
+fi
+AC_MSG_RESULT($tk_ok)
+
+#--------------------------------------------------------------------
+# Check for various typedefs and provide substitutes if
+# they don't exist.
+#--------------------------------------------------------------------
+
+AC_MODE_T
+AC_PID_T
+AC_SIZE_T
+AC_UID_T
+
+#--------------------------------------------------------------------
+# 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
+# no include files, so double-check its result just to be safe.
+#--------------------------------------------------------------------
+
+AC_PATH_X
+not_really_there=""
+if test "$no_x" = ""; then
+ if test "$x_includes" = ""; then
+ AC_TRY_CPP([#include <X11/XIntrinsic.h>], , not_really_there="yes")
+ else
+ if test ! -r $x_includes/X11/Intrinsic.h; then
+ not_really_there="yes"
+ fi
+ fi
+fi
+if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then
+ echo checking for X11 header files
+ XINCLUDES="# no special path needed"
+ AC_TRY_CPP([#include <X11/Intrinsic.h>], , XINCLUDES="nope")
+ if test "$XINCLUDES" = nope; then
+ dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/include/X11R4 /usr/X11R5/include /usr/include/X11R5 /usr/openwin/include /usr/X11/include /usr/sww/include"
+ for i in $dirs ; do
+ if test -r $i/X11/Intrinsic.h; then
+ XINCLUDES=" -I$i"
+ fi
+ done
+ fi
+else
+ if test "$x_includes" != ""; then
+ XINCLUDES=-I$x_includes
+ else
+ XINCLUDES="# no special path needed"
+ fi
+fi
+if test "$XINCLUDES" = nope; then
+ echo "Warning: couldn't find any X11 include files."
+ XINCLUDES="# no include files found"
+fi
+AC_SUBST(XINCLUDES)
+
+if test "$no_x" = yes; then
+ XLIBSW=nope
+ if test "$XLIBSW" = nope; then
+ dirs="/usr/unsupported/lib /usr/local/lib /usr/X386/lib /usr/lib/X11R4 /usr/X11R5/lib /usr/lib/X11R5 /usr/openwin/lib /usr/X11/lib /usr/sww/X11/lib"
+ for i in $dirs ; do
+ if test -r $i/libX11.a -o -r $i/libX11.so -o -r $i/libX11.sl; then
+ XLIBSW="-L$i -lX11"
+ fi
+ done
+ fi
+else
+ if test "$x_libraries" = ""; then
+ XLIBSW=-lX11
+ else
+ XLIBSW="-L$x_libraries -lX11"
+ fi
+fi
+if test "$XLIBSW" = nope ; then
+ AC_CHECK_LIB(Xwindow, XCreateWindow, XLIBSW=-lXwindow)
+fi
+if test "$XLIBSW" = nope ; then
+ echo "Warning: couldn't find the X11 library archive. Using -lX11."
+ XLIBSW=-lX11
+fi
+AC_SUBST(XLIBSW)
+
+#--------------------------------------------------------------------
+# 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
+# "gethostbyname" to check for -lnsl.
+# 2. Use each function name only once: can't redo a check because
+# autoconf caches the results of the last check and won't redo it.
+# 3. Use -lnsl and -lsocket only if they supply procedures that
+# aren't already present in the normal libraries. This is because
+# IRIX 5.2 has libraries, but they aren't needed and they're
+# bogus: they goof up name resolution if used.
+# 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+# To get around this problem, check for both libraries together
+# if -lsocket doesn't work by itself.
+#--------------------------------------------------------------------
+
+AC_CHECK_LIB(Xbsd, main, [LIBS="$LIBS -lXbsd"])
+
+tk_checkBoth=0
+AC_CHECK_FUNC(connect, tk_checkSocket=0, tk_checkSocket=1)
+if test "$tk_checkSocket" = 1; then
+ AC_CHECK_LIB(socket, main, LIBS="$LIBS -lsocket", tk_checkBoth=1)
+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.
+#
+# Note: can't use ac_check_lib macro (at least, not in Autoconf 2.1)
+# because it can't deal with the "-" in the library name.
+#--------------------------------------------------------------------
+
+if test -d /usr/include/mit ; then
+ AC_MSG_CHECKING([MIT X libraries])
+ tk_oldCFlags=$CFLAGS
+ CFLAGS="$CFLAGS -I/usr/include/mit"
+ tk_oldLibs=$LIBS
+ LIBS="$LIBS -lX11-mit"
+ AC_TRY_LINK([
+ #include <X11/Xlib.h>
+ ], [
+ XOpenDisplay(0);
+ ], [
+ AC_MSG_RESULT(yes)
+ XLIBSW="-lX11-mit"
+ XINCLUDES="-I/usr/include/mit"
+ ], AC_MSG_RESULT(no))
+ CFLAGS=$tk_oldCFlags
+ LIBS=$tk_oldLibs
+fi
+
+#--------------------------------------------------------------------
+# On a few very rare systems, all of the libm.a stuff is
+# already in libc.a. Set compiler flags accordingly.
+# Also, Linux requires the "ieee" library for math to
+# 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"])
+AC_SUBST(MATH_LIBS)
+
+#--------------------------------------------------------------------
+# If this system doesn't have a memmove procedure, use memcpy
+# instead.
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(memmove, , [AC_DEFINE(memmove, memcpy)])
+}
+
+ptcl {
+IS_ITCL=0
+ITCL_BUILD_LIB_SPEC=""
+ITK_BUILD_LIB_SPEC=""
+TIX_EXE_FILE=tixwish
+TCL_SAMEXE_FILE=satclsh
+TK_SAMEXE_FILE=sawish
+TIX_SAMEXE_FILE=satixwish
+}
+
+pitcl {
+AC_DEFINE(ITCL_2)
+IS_ITCL=1
+TIX_EXE_FILE=tixwish
+TCL_SAMEXE_FILE=satclsh_not_supported
+TK_SAMEXE_FILE=sawish_not_supported
+TIX_SAMEXE_FILE=satixwish_not_supported
+}
+
+p74 {
+TIX_LIB_FILE=lib@@_V_LNAME_@@4140@@_V_BVEREXT_@@.a
+TIX_MAKE_LIB="ar cr ${TIX_LIB_FILE} \${OBJS}"
+TIX_BUILD_LIB_SPEC="\$(TIX_LIB_FILE)"
+TCL_SAM_FILE=libtclsam74.a
+TK_SAM_FILE=libtksam40.a
+TIX_SAM_FILE=lib@@_V_LNAME_@@sam4140@@_V_BVEREXT_@@.a
+TCL_MAKE_SAM="ar cr ${TCL_SAM_FILE} \${TCL_SAM_OBJS}"
+TK_MAKE_SAM="ar cr ${TK_SAM_FILE} \${TK_SAM_OBJS}"
+TIX_MAKE_SAM="ar cr ${TIX_SAM_FILE} \${TIX_SAM_OBJS}"
+TCL_BUILD_SAM_SPEC="\$(TCL_SAM_FILE)"
+TK_BUILD_SAM_SPEC="\$(TK_SAM_FILE)"
+TIX_BUILD_SAM_SPEC="\$(TIX_SAM_FILE)"
+}
+
+if {$ITCL && $subs(@@_V_ITCL_VER_@@) == "2.0"} {
+ p {
+ITCL_BUILD_LIB_SPEC="\$(ITCL_ROOT_DIR)/itcl/libitcl.a"
+ITK_BUILD_LIB_SPEC="\$(ITCL_ROOT_DIR)/itk/libitk.a"
+ }
+}
+
+p75+ {
+#--------------------------------------------------------------------
+# 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
+CC=$TCL_CC
+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
+TIX_LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
+
+#--------------------------------------------------------------------
+# Read in configuration information generated by Tk and arrange
+# for it to be substituted into our Makefile.
+#--------------------------------------------------------------------
+file=$TK_BIN_DIR/tkConfig.sh
+. $file
+
+TIX_DEFS="$TK_DEFS $TCL_DEFS"
+
+# 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
+ TIX_BUILD_LIB_SPEC="-L`pwd` -l@@_V_LNAME_@@${VERSION}"
+ TIX_BUILD_SAM_SPEC="-L`pwd` -l@@_V_LNAME_@@sam${VERSION}"
+ TCL_BUILD_SAM_SPEC="-L`pwd` -ltclsam${TCL_VERSION}"
+ TK_BUILD_SAM_SPEC="-L`pwd` -ltksam${TK_VERSION}"
+ TIX_LIB_SPEC="-L${exec_prefix}/lib -l@@_V_LNAME_@@${VERSION}"
+else
+ TIX_BUILD_LIB_SPEC="-L`pwd` -l@@_V_LNAME_@@`echo ${VERSION} | tr -d .`"
+ TIX_BUILD_SAM_SPEC="-L`pwd` -l@@_V_LNAME_@@sam`echo ${VERSION} | tr -d .`"
+ TCL_BUILD_SAM_SPEC="-L`pwd` -ltclsam`echo ${TCL_VERSION} | tr -d .`"
+ TK_BUILD_SAM_SPEC="-L`pwd` -ltksam`echo ${TK_VERSION} | tr -d .`"
+ TIX_LIB_SPEC="-L${exec_prefix}/lib -l@@_V_LNAME_@@`echo ${VERSION} | tr -d .`"
+fi
+
+#--------------------------------------------------------------------
+# See if we should compile shared library.
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(shared,
+ [ --enable-shared build lib@@_V_LNAME_@@ as a shared library],
+ [ok=$enableval], [ok=no])
+
+if test "$ok" = "yes" -a "${SHLIB_SUFFIX}" != ""; then
+ TIX_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+ RANLIB=":"
+
+ # The main Tix library
+ #
+ eval "TIX_LIB_FILE=lib@@_V_LNAME_@@${TCL_SHARED_LIB_SUFFIX}"
+ TIX_MAKE_LIB="\${SHLIB_LD} -o ${TIX_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tcl SAM library
+ #
+ VERSION=@@_V_TCL_VER_@@
+ eval "TCL_SAM_FILE=libtclsam${TCL_SHARED_LIB_SUFFIX}"
+ TCL_MAKE_SAM="\${SHLIB_LD} -o ${TCL_SAM_FILE} \${TCL_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tk SAM library
+ #
+ VERSION=@@_V_TK_VER_@@
+ eval "TK_SAM_FILE=libtksam${TCL_SHARED_LIB_SUFFIX}"
+ TK_MAKE_SAM="\${SHLIB_LD} -o ${TK_SAM_FILE} \${TK_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tix SAM library
+ #
+ VERSION=${BIN_VERSION}
+ eval "TIX_SAM_FILE=lib@@_V_LNAME_@@sam${TCL_SHARED_LIB_SUFFIX}"
+ TIX_MAKE_SAM="\${SHLIB_LD} -o ${TIX_SAM_FILE} \${TIX_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+else
+ TIX_SHLIB_CFLAGS=""
+
+ # The main Tix library
+ #
+ eval "TIX_LIB_FILE=lib@@_V_LNAME_@@${TCL_UNSHARED_LIB_SUFFIX}"
+ TIX_MAKE_LIB="ar cr ${TIX_LIB_FILE} \${OBJS}"
+
+ # The Tcl SAM library
+
+ VERSION=@@_V_TCL_VER_@@
+ eval "TCL_SAM_FILE=libtclsam${TCL_UNSHARED_LIB_SUFFIX}"
+ TCL_MAKE_SAM="ar cr ${TCL_SAM_FILE} \${TCL_SAM_OBJS}"
+
+ # The Tk SAM library
+ #
+ VERSION=@@_V_TK_VER_@@
+ eval "TK_SAM_FILE=libtksam${TCL_UNSHARED_LIB_SUFFIX}"
+ TK_MAKE_SAM="ar cr ${TK_SAM_FILE} \${TK_SAM_OBJS}"
+
+ # The Tix SAM library
+ #
+ VERSION=${BIN_VERSION}
+ eval "TIX_SAM_FILE=lib@@_V_LNAME_@@sam${TCL_UNSHARED_LIB_SUFFIX}"
+ TIX_MAKE_SAM="ar cr ${TIX_SAM_FILE} \${TIX_SAM_OBJS}"
+fi
+}
+
+if {$ITCL && $subs(@@_V_ITCL_VER_@@) != "2.0"} {
+ p {
+#--------------------------------------------------------------------
+# Read in configuration information generated by ITcl
+# and arrange for it to be substituted into our Makefile.
+#--------------------------------------------------------------------
+file=$ITCL_ROOT_DIR/itcl/unix/itclConfig.sh
+. $file
+ }
+ if {$subs(@@_V_ITCL_VER_@@) > 2.1} {
+ p {
+#--------------------------------------------------------------------
+# Read in configuration information generated by ITk
+# and arrange for it to be substituted into our Makefile.
+#--------------------------------------------------------------------
+file=$ITCL_ROOT_DIR/itk/unix/itkConfig.sh
+. $file
+ }
+ } else {
+ p {
+#----------------------------------------------------------------------
+# The ITK_BUILD_LIB_SPEC is incorrect in Itcl 2.1
+#----------------------------------------------------------------------
+ITK_BUILD_LIB_SPEC="-L\$(ITCL_ROOT_DIR)/itk/unix ${ITK_BUILD_LIB_SPEC}"
+ }
+ }
+}
+
+p75+ {
+
+#--------------------------------------------------------------------
+# Check for the existence of the -lsocket and -lnsl libraries.
+# The order here is important, so that they end up in the right
+# order in the command line generated by make. Here are some
+# special considerations:
+# 1. Use "connect" and "accept" to check for -lsocket, and
+# "gethostbyname" to check for -lnsl.
+# 2. Use each function name only once: can't redo a check because
+# autoconf caches the results of the last check and won't redo it.
+# 3. Use -lnsl and -lsocket only if they supply procedures that
+# aren't already present in the normal libraries. This is because
+# IRIX 5.2 has libraries, but they aren't needed and they're
+# bogus: they goof up name resolution if used.
+# 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+# To get around this problem, check for both libraries together
+# if -lsocket doesn't work by itself.
+#--------------------------------------------------------------------
+
+checked=0
+for i in $TK_LIBS; do
+ if test "$i" = "-lsocket"; then
+ checked=1
+ fi
+done
+
+if test "$checked" = "0"; then
+ tcl_checkBoth=0
+ AC_CHECK_FUNC(connect, tcl_checkSocket=0, tcl_checkSocket=1)
+ if test "$tcl_checkSocket" = 1; then
+ AC_CHECK_LIB(socket, main, TK_LIBS="$TK_LIBS -lsocket",
+ tcl_checkBoth=1)
+ fi
+ if test "$tcl_checkBoth" = 1; then
+ tk_oldLibs=$TK_LIBS
+ TK_LIBS="$TK_LIBS -lsocket -lnsl"
+ AC_CHECK_FUNC(accept, tcl_checkNsl=0, [TK_LIBS=$tk_oldLibs])
+ fi
+ AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main,
+ [TK_LIBS="$TK_LIBS -lnsl"]))
+fi
+}
+
+p {
+#----------------------------------------------------------------------
+# Substitution strings exported by TIX
+#----------------------------------------------------------------------
+AC_SUBST(CC)
+AC_SUBST(RANLIB)
+AC_SUBST(SHLIB_CFLAGS)
+AC_SUBST(SHLIB_LD)
+AC_SUBST(SHLIB_LD_LIBS)
+AC_SUBST(SHLIB_SUFFIX)
+AC_SUBST(SHLIB_VERSION)
+AC_SUBST(DL_LIBS)
+AC_SUBST(LD_FLAGS)
+AC_SUBST(TCL_BUILD_LIB_SPEC)
+AC_SUBST(TCL_LIBS)
+AC_SUBST(TCL_VERSION)
+AC_SUBST(TCL_SRC_DIR)
+AC_SUBST(TCL_BIN_DIR)
+AC_SUBST(TK_BUILD_LIB_SPEC)
+AC_SUBST(TK_LIBS)
+AC_SUBST(TK_VERSION)
+AC_SUBST(TK_SRC_DIR)
+AC_SUBST(TK_BIN_DIR)
+AC_SUBST(TK_XINCLUDES)
+AC_SUBST(TIX_LD_SEARCH_FLAGS)
+AC_SUBST(TIX_MAJOR_VERSION)
+AC_SUBST(TIX_MINOR_VERSION)
+AC_SUBST(TIX_VERSION)
+AC_SUBST(TIX_SRC_DIR)
+AC_SUBST(TIX_SHLIB_CFLAGS)
+AC_SUBST(TIX_MAKE_LIB)
+AC_SUBST(TIX_LIB_FILE)
+AC_SUBST(TIX_BUILD_LIB_SPEC)
+AC_SUBST(TIX_LIB_SPEC)
+AC_SUBST(TIX_EXE_FILE)
+AC_SUBST(TIX_SAM_TARGETS)
+AC_SUBST(TIX_SAM_INSTALL)
+AC_SUBST(TCL_SAM_FILE)
+AC_SUBST(TCL_MAKE_SAM)
+AC_SUBST(TK_SAM_FILE)
+AC_SUBST(TK_MAKE_SAM)
+AC_SUBST(TIX_SAM_FILE)
+AC_SUBST(TIX_MAKE_SAM)
+AC_SUBST(TIX_DEFS)
+AC_SUBST(ITCL_BUILD_LIB_SPEC)
+AC_SUBST(ITK_BUILD_LIB_SPEC)
+AC_SUBST(TCL_SAMEXE_FILE)
+AC_SUBST(TK_SAMEXE_FILE)
+AC_SUBST(TIX_SAMEXE_FILE)
+AC_SUBST(TCL_BUILD_SAM_SPEC)
+AC_SUBST(TK_BUILD_SAM_SPEC)
+AC_SUBST(TIX_BUILD_SAM_SPEC)
+}
+
+p75+ {
+# The "binary version" of Tix (see docs/Pkg.txt)
+TIX_VERSION_PKG=${BIN_VERSION}
+AC_SUBST(TIX_VERSION_PKG)
+}
+
+if !$TCL74 {
+ p_sam {
+TIXSAM_PKG_FILE="[[file join [file dirname \$dir] ${TIX_SAM_FILE}]]"
+if test "$TIX_BUILD_SAM" = "yes"; then
+ TIX_SAM_PACKAGE_IFNEEDED="package ifneeded Tixsam ${TIX_VERSION_PKG} [[list load \"${TIXSAM_PKG_FILE}\" Tixsam]]"
+fi
+ }
+}
+
+p75+ {
+# The package file, usually a shared library
+TIX_PKG_FILE="[[file join [file dirname \$dir] ${TIX_LIB_FILE}]]"
+AC_SUBST(TIX_PKG_FILE)
+AC_SUBST(TIX_SAM_PACKAGE_IFNEEDED)
+}
+
+
+
+
+pitcl {
+AC_SUBST(ITCL_ROOT_DIR)
+}
+
+p74 {
+AC_OUTPUT(Makefile)
+}
+
+p75+ {
+AC_OUTPUT(Makefile pkgIndex.tcl)
+}
diff --git a/tix/tools/domakefile.tcl b/tix/tools/domakefile.tcl
new file mode 100755
index 00000000000..5f2e437ada0
--- /dev/null
+++ b/tix/tools/domakefile.tcl
@@ -0,0 +1,764 @@
+#!/bin/sh
+# the next line restarts using tclsh \
+exec tclsh "$0" "$@"
+
+# Tis program is used to generate the Makefile.in files for building Unix
+# binaries.
+#
+
+source [file join [file dirname [info script]] doxx.tcl]
+
+p {
+# Makefile --
+#
+# This file is a Makefile to compile Tix with Tk version
+# @@_V_TK_VER_@@. 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.
+
+#----------------------------------------------------------------
+# Things you can change to personalize the Makefile for your own
+# site (you can make these changes in either Makefile.in or
+# Makefile, but changes to Makefile will get lost if you re-run
+# the configuration script).
+#----------------------------------------------------------------
+
+# Default top-level directories in which to install architecture-
+# specific files (exec_prefix) and machine-independent files such
+# as scripts (prefix). The values specified here may be overridden
+# at configure-time with the --exec-prefix and --prefix options
+# to the "configure" script.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+TIX_VERSION = @TIX_VERSION@
+
+@SET_MAKE@
+
+# Directory in which to install the library of Tix scripts and demos
+# (note: you can set the TIX_LIBRARY environment variable at run-time to
+# override the compiled-in location):
+TIX_LIBRARY = $(prefix)/lib/tix$(TIX_VERSION)
+
+# Directory in which to install the archive libtix.a:
+LIB_DIR = $(exec_prefix)/lib
+LIB_INSTALL_DIR = $(LIB_DIR)
+LIB_RUNTIME_DIR = $(LIB_DIR)
+
+# Directory in which to install the program tixwish:
+BIN_DIR = $(exec_prefix)/bin
+
+# To change the compiler switches, for example to change from -O
+# to -g, change the following line:
+CFLAGS = -O
+
+# To disable ANSI-C procedure prototypes reverse the comment characters
+# on the following lines:
+PROTO_FLAGS =
+#PROTO_FLAGS = -DNO_PROTOTYPE
+
+# To enable memory debugging reverse the comment characters on the following
+# lines. Warning: if you enable memory debugging, you must do it
+# *everywhere*, including all the code that calls Tcl, and you must use
+# ckalloc and ckfree everywhere instead of malloc and free.
+MEM_DEBUG_FLAGS =
+#MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG
+
+# Some versions of make, like SGI's, use the following variable to
+# determine which shell to use for executing commands:
+SHELL = /bin/sh
+}
+
+p74 {
+# Location of the Tcl @@_V_TCL_VER_@@ source directory.
+#
+TCL_SRC_DIR = @TCL_SRC_DIR@
+
+# Location of the Tk @@_V_TK_VER_@@ source directory.
+#
+TK_SRC_DIR = @TK_SRC_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: must include at least Tix, Tcl, Xlib,
+# and the math library (in that order). The "@LIBS@" part will be
+# replaced (or has already been replaced) with relevant libraries as
+# determined by the configure script.
+LIBS = @ITK_BUILD_LIB_SPEC@ @ITCL_BUILD_LIB_SPEC@ \\
+ $(TK_SRC_DIR)/libtk.a $(TCL_SRC_DIR)/libtcl.a \
+ $(X11_LIB_SWITCHES) @LIBS@ @MATH_LIBS@
+
+# Libraries for building a stand-alone Tclsh.
+#
+LIBS_TCLONLY = $(TCL_SRC_DIR)/libtcl.a @LIBS@ @MATH_LIBS@
+
+RUN_TCLSH = TCL_LIBRARY=$(TCL_SRC_DIR)/library \\
+ TK_LIBRARY=$(TK_SRC_DIR)/library \\
+ $(TCL_SRC_DIR)/tclsh
+}
+
+p75+ {
+# Location of the Tcl @@_V_TCL_VER_@@ source directory.
+#
+TCL_SRC_DIR = @TCL_SRC_DIR@
+TCL_GENERIC_DIR = $(TCL_SRC_DIR)/generic
+
+# Location of the Tk @@_V_TK_VER_@@ source directory.
+#
+TK_SRC_DIR = @TK_SRC_DIR@
+TK_GENERIC_DIR = $(TK_SRC_DIR)/generic
+
+# Libraries to use when linking:
+LIBS = @ITK_BUILD_LIB_SPEC@ @ITCL_BUILD_LIB_SPEC@ \\
+ @TK_BUILD_LIB_SPEC@ @TCL_BUILD_LIB_SPEC@ @TK_LIBS@
+
+# Libraries for building a stand-alone Tclsh.
+#
+LIBS_TCLONLY = @TCL_BUILD_LIB_SPEC@ @TCL_LIBS@
+
+RUN_TCLSH = TCL_LIBRARY=$(TCL_SRC_DIR)/library \\
+ TK_LIBRARY=$(TK_SRC_DIR)/library \\
+ $(TCL_SRC_DIR)/unix/tclsh
+}
+
+pitcl {
+# Location of the ITcl @@_V_ITCL_VER_@@ root directory.
+#
+ITCL_ROOT_DIR = @ITCL_ROOT_DIR@
+ITCL_SRC_DIR = $(ITCL_ROOT_DIR)/itcl
+ITK_SRC_DIR = $(ITCL_ROOT_DIR)/itk
+}
+
+p {
+
+#----------------------------------------------------------------
+# 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.
+#----------------------------------------------------------------
+}
+
+p {
+CC = @CC@
+}
+
+p75+ {
+SHLIB_CFLAGS = @SHLIB_CFLAGS@
+SHLIB_LD = @SHLIB_LD@
+SHLIB_SUFFIX = @SHLIB_SUFFIX@
+SHLIB_VERSION = @SHLIB_VERSION@
+TIX_SHLIB_CFLAGS = @TIX_SHLIB_CFLAGS@
+TK_XINCLUDES = @TK_XINCLUDES@
+}
+
+if !$ITCL {
+ p {
+ITCL_EXT =
+ }
+} else {
+ p {
+ITCL_EXT = .1
+ }
+}
+
+p {
+SRC_DIR = @TIX_SRC_DIR@
+GENERIC_DIR = $(SRC_DIR)/generic
+UNIX_DIR = $(SRC_DIR)/unix
+AC_FLAGS = @DEFS@ @TIX_DEFS@
+RANLIB = @RANLIB@
+INSTALL = @TIX_SRC_DIR@/install.sh -c
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+TIX_LIB_FILE = @TIX_LIB_FILE@
+TIX_EXE_FILE = @TIX_EXE_FILE@
+TCL_SAM_FILE = @TCL_SAM_FILE@
+TK_SAM_FILE = @TK_SAM_FILE@
+TIX_SAM_FILE = @TIX_SAM_FILE@
+TCL_SAMEXE_FILE = @TCL_SAMEXE_FILE@
+TK_SAMEXE_FILE = @TK_SAMEXE_FILE@
+TIX_SAMEXE_FILE = @TIX_SAMEXE_FILE@
+
+INST_EXE = $(TIX_EXE_FILE)$(TIX_VERSION).@@_V_TCL_VER_@@$(ITCL_EXT)
+INST_TIX_SAMEXE = $(TIX_SAMEXE_FILE)$(TIX_VERSION).@@_V_TCL_VER_@@$(ITCL_EXT)
+INST_TK_SAMEXE = $(TK_SAMEXE_FILE)@@_V_TK_VER_@@
+INST_TCL_SAMEXE = $(TCL_SAMEXE_FILE)@@_V_TCL_VER_@@
+}
+
+if $ENABLE_SAM {
+ if $SAM_EXE {
+ p {
+SAM_TARGETS = $(TCL_SAM_FILE) $(TK_SAM_FILE) $(TIX_SAM_FILE) \\
+ $(TCL_SAMEXE_FILE) $(TK_SAMEXE_FILE) $(TIX_SAMEXE_FILE)
+ }
+ } else {
+ p {
+SAM_TARGETS = $(TIX_SAM_FILE)
+ }
+ }
+}
+
+p {
+TIX_SAM_TARGETS = @TIX_SAM_TARGETS@
+SAM_INSTALL = @TIX_SAM_INSTALL@
+}
+
+
+if $ITCL {
+ if {$subs(@@_V_ITCL_VER_@@) == "2.1"} {
+ p {
+ITCL21_CFLAGS = -DITCL_21=1
+ }
+ } else {
+ p {
+ITCL21_CFLAGS =
+ }
+ }
+ if {$subs(@@_V_ITCL_VER_@@) == "2.0"} {
+ p {
+ITCL_CFLAGS = -I$(ITCL_ROOT_DIR)/itcl -I$(ITCL_ROOT_DIR)/itk
+ }
+ } else {
+ p {
+ITCL_CFLAGS = -I$(ITCL_ROOT_DIR)/itcl/generic \\
+ -I$(ITCL_ROOT_DIR)/itk/generic $(ITCL21_CFLAGS)
+ }
+ }
+} else {
+ p {
+ITCL_CFLAGS =
+ }
+}
+
+p74 {
+CC_SWITCHES = $(CFLAGS) $(AC_FLAGS) \\
+ -I$(TCL_SRC_DIR) -I$(TK_SRC_DIR) $(ITCL_CFLAGS) \\
+ -I$(GENERIC_DIR) -I$(UNIX_DIR) $(X11_INCLUDES)
+}
+
+p75+ {
+CC_SWITCHES = $(CFLAGS) $(AC_FLAGS) -I$(TCL_GENERIC_DIR) \\
+ -I$(TCL_SRC_DIR)/unix -I$(TK_GENERIC_DIR) -I$(TK_SRC_DIR)/unix \\
+ $(ITCL_CFLAGS) \\
+ -I$(GENERIC_DIR) -I$(UNIX_DIR) $(TK_XINCLUDES) $(TIX_SHLIB_CFLAGS)
+}
+
+
+p {
+#----------------------------------------------------------------
+# The information below should be usable as is. You shouldn't need
+# to modify it.
+#----------------------------------------------------------------
+
+CORE_OBJS = \\
+ tixClass.o \\
+ tixCmds.o \\
+ tixCompat.o \\
+ tixError.o \\
+ tixGeometry.o \\
+ tixInit.o \\
+ tixItcl.o \\
+ tixList.o \\
+ tixMethod.o \\
+ tixOption.o \\
+ tixScroll.o \\
+ tixSmpLs.o \\
+ tixUtils.o \\
+ tixWidget.o
+
+DITEM_OBJS = \\
+ tixDItem.o \\
+ tixDiITxt.o \\
+ tixDiImg.o \\
+ tixDiStyle.o \\
+ tixDiText.o \\
+ tixDiWin.o
+
+MANAGER_OBJS = \\
+ tixForm.o \\
+ tixFormMisc.o
+
+WIDGET_OBJS = \\
+ tixGrid.o \\
+ tixGrData.o \\
+ tixGrFmt.o \\
+ tixGrRC.o \\
+ tixGrSel.o \\
+ tixGrSort.o \\
+ tixGrUtl.o \\
+ tixHList.o \\
+ tixHLCol.o \\
+ tixHLInd.o \\
+ tixHLHdr.o \\
+ tixInputO.o \\
+ tixNBFrame.o \\
+ tixTList.o
+
+MISC_OBJS = \\
+ tixImgCmp.o \\
+ tixImgXpm.o \\
+ tixMwm.o
+
+UNIX_OBJS = \\
+ tixUnixDraw.o \\
+ tixUnixXpm.o \\
+ tixUnixWm.o
+
+OBJS = $(CORE_OBJS) $(DITEM_OBJS) $(MANAGER_OBJS) $(MISC_OBJS) \\
+ $(WIDGET_OBJS) $(UNIX_OBJS)
+
+TCL_SAM_OBJS = \\
+ tclUnixSam@@_V_TCLVER_@@.o
+
+TK_SAM_OBJS = \\
+ tkUnixSam@@_V_TKVER_@@.o
+
+TIX_SAM_OBJS = \\
+ $(OBJS) tixUnixSam.o
+}
+
+p {
+#----------------------------------------------------------------------
+# These are the scripts that we'll compile into the SAM's. The
+# scripts of TK must be included in the fixed order.
+#----------------------------------------------------------------------
+}
+
+p {
+TCL_SCRIPTS = $(TCL_SRC_DIR)/library/*.tcl
+}
+
+if {$subs(@@_V_TCL_VER_@@) == 7.4} {p {
+TK_SCRIPTS = \\
+ $(TK_SRC_DIR)/library/tkerror.tcl \\
+ $(TK_SRC_DIR)/library/dialog.tcl \\
+ $(TK_SRC_DIR)/library/focus.tcl \\
+ $(TK_SRC_DIR)/library/obsolete.tcl \\
+ $(TK_SRC_DIR)/library/palette.tcl \\
+ $(TK_SRC_DIR)/library/tearoff.tcl \\
+ $(SRC_DIR)/generic/tk4.0/tk.tcl \\
+ $(TK_SRC_DIR)/library/button.tcl \\
+ $(TK_SRC_DIR)/library/entry.tcl \\
+ $(TK_SRC_DIR)/library/listbox.tcl \\
+ $(TK_SRC_DIR)/library/menu.tcl \\
+ $(TK_SRC_DIR)/library/scale.tcl \\
+ $(TK_SRC_DIR)/library/scrollbar.tcl \\
+ $(TK_SRC_DIR)/library/text.tcl
+}}
+
+if {$subs(@@_V_TCL_VER_@@) == 7.5} {p {
+TK_SCRIPTS = \\
+ $(TK_SRC_DIR)/library/bgerror.tcl \\
+ $(TK_SRC_DIR)/library/dialog.tcl \\
+ $(TK_SRC_DIR)/library/focus.tcl \\
+ $(TK_SRC_DIR)/library/obsolete.tcl \\
+ $(TK_SRC_DIR)/library/optMenu.tcl \\
+ $(TK_SRC_DIR)/library/palette.tcl \\
+ $(TK_SRC_DIR)/library/tearoff.tcl \\
+ $(SRC_DIR)/generic/tk4.1/tk.tcl \\
+ $(TK_SRC_DIR)/library/button.tcl \\
+ $(TK_SRC_DIR)/library/entry.tcl \\
+ $(TK_SRC_DIR)/library/listbox.tcl \\
+ $(TK_SRC_DIR)/library/menu.tcl \\
+ $(TK_SRC_DIR)/library/scale.tcl \\
+ $(TK_SRC_DIR)/library/scrlbar.tcl \\
+ $(TK_SRC_DIR)/library/text.tcl \\
+ $(SRC_DIR)/generic/tk4.1/console.tcl
+}}
+
+if {$subs(@@_V_TCL_VER_@@) == 7.6} {p {
+TK_SCRIPTS = \\
+ $(TK_SRC_DIR)/library/bgerror.tcl \\
+ $(TK_SRC_DIR)/library/dialog.tcl \\
+ $(TK_SRC_DIR)/library/focus.tcl \\
+ $(TK_SRC_DIR)/library/obsolete.tcl \\
+ $(TK_SRC_DIR)/library/optMenu.tcl \\
+ $(TK_SRC_DIR)/library/palette.tcl \\
+ $(TK_SRC_DIR)/library/tearoff.tcl \\
+ $(TK_SRC_DIR)/library/clrpick.tcl \\
+ $(TK_SRC_DIR)/library/comdlg.tcl \\
+ $(TK_SRC_DIR)/library/msgbox.tcl \\
+ $(TK_SRC_DIR)/library/tkfbox.tcl \\
+ $(TK_SRC_DIR)/library/xmfbox.tcl \\
+ $(SRC_DIR)/generic/tk4.2/tk.tcl \\
+ $(TK_SRC_DIR)/library/button.tcl \\
+ $(TK_SRC_DIR)/library/entry.tcl \\
+ $(TK_SRC_DIR)/library/listbox.tcl \\
+ $(TK_SRC_DIR)/library/menu.tcl \\
+ $(TK_SRC_DIR)/library/scale.tcl \\
+ $(TK_SRC_DIR)/library/scrlbar.tcl \\
+ $(TK_SRC_DIR)/library/text.tcl \\
+ $(SRC_DIR)/generic/tk4.2/console.tcl
+}}
+
+if {$subs(@@_V_TCL_VER_@@) == 8.0} {p {
+TK_SCRIPTS = \\
+ $(TK_SRC_DIR)/library/bgerror.tcl \\
+ $(TK_SRC_DIR)/library/dialog.tcl \\
+ $(TK_SRC_DIR)/library/focus.tcl \\
+ $(TK_SRC_DIR)/library/obsolete.tcl \\
+ $(TK_SRC_DIR)/library/optMenu.tcl \\
+ $(TK_SRC_DIR)/library/palette.tcl \\
+ $(TK_SRC_DIR)/library/tearoff.tcl \\
+ $(TK_SRC_DIR)/library/clrpick.tcl \\
+ $(TK_SRC_DIR)/library/comdlg.tcl \\
+ $(TK_SRC_DIR)/library/msgbox.tcl \\
+ $(TK_SRC_DIR)/library/tkfbox.tcl \\
+ $(TK_SRC_DIR)/library/xmfbox.tcl \\
+ $(SRC_DIR)/generic/tk4.2/tk.tcl \\
+ $(TK_SRC_DIR)/library/button.tcl \\
+ $(TK_SRC_DIR)/library/entry.tcl \\
+ $(TK_SRC_DIR)/library/listbox.tcl \\
+ $(TK_SRC_DIR)/library/menu.tcl \\
+ $(TK_SRC_DIR)/library/scale.tcl \\
+ $(TK_SRC_DIR)/library/scrlbar.tcl \\
+ $(TK_SRC_DIR)/library/text.tcl \\
+ $(SRC_DIR)/generic/tk8.0/console.tcl
+}}
+
+p {
+TIX_SCRIPTS = \\
+ $(SRC_DIR)/library/pref/*.fsc \\
+ $(SRC_DIR)/library/pref/*.csc \\
+ $(SRC_DIR)/library/*.tcl
+}
+
+##
+## Compilation rules for main targets
+##
+
+p {
+all: $(TIX_LIB_FILE) $(TIX_EXE_FILE) @TIX_SAM_TARGETS@
+
+$(TIX_LIB_FILE): $(OBJS)
+ rm -f $(TIX_LIB_FILE)
+ @TIX_MAKE_LIB@
+ $(RANLIB) $(TIX_LIB_FILE)
+
+$(TCL_SAM_FILE): $(TCL_SAM_OBJS)
+ rm -f $(TCL_SAM_FILE)
+ @TCL_MAKE_SAM@
+ $(RANLIB) $(TCL_SAM_FILE)
+
+$(TK_SAM_FILE): $(TK_SAM_OBJS)
+ rm -f $(TK_SAM_FILE)
+ @TK_MAKE_SAM@
+ $(RANLIB) $(TK_SAM_FILE)
+
+$(TIX_SAM_FILE): $(TIX_SAM_OBJS)
+ rm -f $(TIX_SAM_FILE)
+ @TIX_MAKE_SAM@
+ $(RANLIB) $(TIX_SAM_FILE)
+
+$(TIX_EXE_FILE): tixAppInit.o $(TIX_LIB_FILE)
+ $(CC) @LD_FLAGS@ tixAppInit.o @TIX_BUILD_LIB_SPEC@ $(LIBS) \\
+ @TIX_LD_SEARCH_FLAGS@ -o $(TIX_EXE_FILE)
+
+$(TCL_SAMEXE_FILE): $(UNIX_DIR)/samAppInit.c $(TCL_SAM_FILE)
+ $(CC) $(CC_SWITCHES) @LD_FLAGS@ -DUSE_TCL $(UNIX_DIR)/samAppInit.c \\
+ @TCL_BUILD_SAM_SPEC@ $(LIBS_TCLONLY) \\
+ @TIX_LD_SEARCH_FLAGS@ -o $(TCL_SAMEXE_FILE)
+
+$(TK_SAMEXE_FILE): $(UNIX_DIR)/samAppInit.c $(TCL_SAM_FILE) $(TK_SAM_FILE)
+ $(CC) $(CC_SWITCHES) @LD_FLAGS@ -DUSE_TK $(UNIX_DIR)/samAppInit.c \\
+ @TK_BUILD_SAM_SPEC@ @TCL_BUILD_SAM_SPEC@ $(LIBS) \\
+ @TIX_LD_SEARCH_FLAGS@ -o $(TK_SAMEXE_FILE)
+
+$(TIX_SAMEXE_FILE): $(UNIX_DIR)/samAppInit.c $(TCL_SAM_FILE) $(TK_SAM_FILE) \\
+ $(TIX_SAM_FILE)
+ $(CC) $(CC_SWITCHES) @LD_FLAGS@ -DUSE_TIX $(UNIX_DIR)/samAppInit.c \\
+ @TIX_BUILD_SAM_SPEC@ \\
+ @TK_BUILD_SAM_SPEC@ @TCL_BUILD_SAM_SPEC@ \\
+ $(LIBS) \\
+ @TIX_LD_SEARCH_FLAGS@ -o $(TIX_SAMEXE_FILE)
+
+}
+
+##
+## .o file rules
+##
+
+p {
+#----------------------------------------------------------------------
+#
+# .o file rules
+#
+#----------------------------------------------------------------------
+tixAppInit.o : tixAppInit.c
+ $(CC) -c $(CC_SWITCHES) tixAppInit.c
+
+tixClass.o : $(GENERIC_DIR)/tixClass.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixClass.c
+
+tixCmds.o: $(GENERIC_DIR)/tixCmds.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixCmds.c
+
+tixCompat.o: $(GENERIC_DIR)/tixCompat.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixCompat.c
+
+tixDItem.o: $(GENERIC_DIR)/tixDItem.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDItem.c
+
+tixDiImg.o: $(GENERIC_DIR)/tixDiImg.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiImg.c
+
+tixDiITxt.o: $(GENERIC_DIR)/tixDiITxt.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiITxt.c
+
+tixDiStyle.o: $(GENERIC_DIR)/tixDiStyle.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiStyle.c
+
+tixDiText.o: $(GENERIC_DIR)/tixDiText.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiText.c
+
+tixDiWin.o: $(GENERIC_DIR)/tixDiWin.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiWin.c
+
+tixError.o: $(GENERIC_DIR)/tixError.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixError.c
+
+tixForm.o: $(GENERIC_DIR)/tixForm.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixForm.c
+
+tixFormMisc.o: $(GENERIC_DIR)/tixFormMisc.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixFormMisc.c
+
+tixGeometry.o: $(GENERIC_DIR)/tixGeometry.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGeometry.c
+
+tixGrid.o: $(GENERIC_DIR)/tixGrid.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrid.c
+
+tixGrData.o: $(GENERIC_DIR)/tixGrData.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrData.c
+
+tixGrFmt.o: $(GENERIC_DIR)/tixGrFmt.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrFmt.c
+
+tixGrRC.o: $(GENERIC_DIR)/tixGrRC.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrRC.c
+
+tixGrSel.o: $(GENERIC_DIR)/tixGrSel.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrSel.c
+
+tixGrSort.o: $(GENERIC_DIR)/tixGrSort.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrSort.c
+
+tixGrUtl.o: $(GENERIC_DIR)/tixGrUtl.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrUtl.c
+
+tixHLCol.o: $(GENERIC_DIR)/tixHLCol.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixHLCol.c
+
+tixHLHdr.o: $(GENERIC_DIR)/tixHLHdr.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixHLHdr.c
+
+tixHLInd.o: $(GENERIC_DIR)/tixHLInd.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixHLInd.c
+
+tixHList.o: $(GENERIC_DIR)/tixHList.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixHList.c
+
+tixImgCmp.o: $(GENERIC_DIR)/tixImgCmp.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixImgCmp.c
+
+tixImgXpm.o: $(GENERIC_DIR)/tixImgXpm.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixImgXpm.c
+
+tixInit.o: $(GENERIC_DIR)/tixInit.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixInit.c
+
+tixItcl.o: $(GENERIC_DIR)/tixItcl.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixItcl.c
+
+tixInputO.o : $(GENERIC_DIR)/tixInputO.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixInputO.c
+
+tixList.o: $(GENERIC_DIR)/tixList.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixList.c
+
+tixMethod.o : $(GENERIC_DIR)/tixMethod.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixMethod.c
+
+tixMwm.o: $(GENERIC_DIR)/tixMwm.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixMwm.c
+
+tixNBFrame.o: $(GENERIC_DIR)/tixNBFrame.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixNBFrame.c
+
+tixOption.o: $(GENERIC_DIR)/tixOption.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixOption.c
+
+tixSmpLs.o: $(GENERIC_DIR)/tixSmpLs.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixSmpLs.c
+
+tixScroll.o: $(GENERIC_DIR)/tixScroll.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixScroll.c
+
+tixTList.o: $(GENERIC_DIR)/tixTList.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixTList.c
+
+tixUtils.o: $(GENERIC_DIR)/tixUtils.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixUtils.c
+
+tixWidget.o: $(GENERIC_DIR)/tixWidget.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixWidget.c
+
+tixUnixDraw.o: $(UNIX_DIR)/tixUnixDraw.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tixUnixDraw.c
+
+tixUnixXpm.o: $(UNIX_DIR)/tixUnixXpm.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tixUnixXpm.c
+
+tixUnixWm.o: $(UNIX_DIR)/tixUnixWm.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tixUnixWm.c
+
+#
+# Dependence rules for SAM
+#
+tclUnixSam@@_V_TCLVER_@@.o: tclUnixSam@@_V_TCLVER_@@.c tclSamLib.c
+ $(CC) -c $(CC_SWITCHES) tclUnixSam@@_V_TCLVER_@@.c
+
+tclSamLib.c:
+ $(RUN_TCLSH) $(SRC_DIR)/tools/tclc.tcl $(TCL_SCRIPTS) \\
+ > tclSamLib.c
+
+tkUnixSam@@_V_TKVER_@@.o: tkUnixSam@@_V_TKVER_@@.c tkSamLib.c
+ $(CC) -c $(CC_SWITCHES) tkUnixSam@@_V_TKVER_@@.c
+
+tkSamLib.c:
+ $(RUN_TCLSH) $(SRC_DIR)/tools/tclc.tcl $(TK_SCRIPTS) \\
+ > tkSamLib.c
+
+tixUnixSam.o: $(UNIX_DIR)/tixUnixSam.c $(UNIX_DIR)/tixSamLib.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tixUnixSam.c
+
+$(UNIX_DIR)/tixSamLib.c:
+ $(RUN_TCLSH) $(SRC_DIR)/tools/tclc.tcl $(TIX_SCRIPTS) \\
+ > $(UNIX_DIR)/tixSamLib.c
+}
+
+pitcl {
+IWIDGETS = iwidgets@@_V_IWIDGETS_VER_@@
+}
+
+p {
+
+tests: $(TIX_EXE_FILE)
+ TCL_LIBRARY=$(TCL_SRC_DIR)/library TK_LIBRARY=$(TK_SRC_DIR)/library \\
+ ITCL_LIBRARY=$(ITCL_SRC_DIR)/library \\
+ ITK_LIBRARY=$(ITK_SRC_DIR)/library \\
+ IWIDGETS_LIBRARY=$(ITCL_ROOT_DIR)/$(IWIDGETS) \\
+ TIX_LIBRARY=$(SRC_DIR)/library \\
+ LD_LIBRARY_PATH=${LD_LIBRARY_PATH}:. \\
+ ./$(TIX_EXE_FILE) $(SRC_DIR)/tests/Driver.tcl
+}
+
+p_sam {
+sa-tests: $(TIX_SAMEXE_FILE)
+ ./$(TIX_SAMEXE_FILE) $(SRC_DIR)/tests/Driver.tcl
+}
+
+p {
+#----------------------------------------------------------------------
+#
+# INSTALLATION
+#
+#----------------------------------------------------------------------
+_install_: $(TIX_LIB_FILE) $(TIX_EXE_FILE) $(SAM_INSTALL)
+ @for i in $(LIB_DIR) $(BIN_DIR) ; \\
+ do \\
+ if [ ! -d $$i ] ; then \\
+ echo "Making directory $$i"; \\
+ mkdir $$i; \\
+ chmod 755 $$i; \\
+ else true; \\
+ fi; \\
+ done;
+ @echo "Installing $(TIX_LIB_FILE) as $(LIB_DIR)/$(TIX_LIB_FILE)"
+ @$(INSTALL_PROGRAM) $(TIX_LIB_FILE) $(LIB_DIR)/$(TIX_LIB_FILE)
+ @echo "Installing $(TIX_EXE_FILE) as $(BIN_DIR)/$(INST_EXE)"
+ @$(INSTALL_PROGRAM) $(TIX_EXE_FILE) $(BIN_DIR)/$(INST_EXE)
+
+_install_sam_exe_: $(SAM_TARGETS)
+ @for i in $(LIB_DIR) $(BIN_DIR) ; \\
+ do \\
+ if [ ! -d $$i ] ; then \\
+ echo "Making directory $$i"; \\
+ mkdir $$i; \\
+ chmod 755 $$i; \\
+ else true; \\
+ fi; \\
+ done;
+ @echo "Installing $(TK_SAM_FILE) as $(LIB_DIR)/$(TK_SAM_FILE)"
+ @$(INSTALL_PROGRAM) $(TK_SAM_FILE) $(LIB_DIR)/$(TK_SAM_FILE)
+ @echo "Installing $(TCL_SAM_FILE) as $(LIB_DIR)/$(TCL_SAM_FILE)"
+ @$(INSTALL_PROGRAM) $(TCL_SAM_FILE) $(LIB_DIR)/$(TCL_SAM_FILE)
+ @echo ""
+ @echo "Installing $(TIX_SAMEXE_FILE) as $(BIN_DIR)/$(INST_TIX_SAMEXE)"
+ @$(INSTALL_PROGRAM) $(TIX_SAMEXE_FILE) $(BIN_DIR)/$(INST_TIX_SAMEXE)
+ @echo "Installing $(TK_SAMEXE_FILE) as $(BIN_DIR)/$(INST_TK_SAMEXE)"
+ @$(INSTALL_PROGRAM) $(TK_SAMEXE_FILE) $(BIN_DIR)/$(INST_TK_SAMEXE)
+ @echo "Installing $(TCL_SAMEXE_FILE) as $(BIN_DIR)/$(INST_TCL_SAMEXE)"
+ @$(INSTALL_PROGRAM) $(TCL_SAMEXE_FILE) $(BIN_DIR)/$(INST_TCL_SAMEXE)
+
+_install_sam_lib_: $(SAM_TARGETS)
+ @for i in $(LIB_DIR) $(BIN_DIR) ; \\
+ do \\
+ if [ ! -d $$i ] ; then \\
+ echo "Making directory $$i"; \\
+ mkdir $$i; \\
+ chmod 755 $$i; \\
+ else true; \\
+ fi; \\
+ done;
+ @echo "Installing $(TIX_SAM_FILE) as $(LIB_DIR)/$(TIX_SAM_FILE)"
+ @$(INSTALL_PROGRAM) $(TIX_SAM_FILE) $(LIB_DIR)/$(TIX_SAM_FILE)
+
+
+install: _install_
+ @echo The binary files have been installed.
+ @echo You probably need to make install in the parent directory
+ @echo to install other files.
+}
+
+
+##
+## cleanup rules, etc
+##
+
+p {
+sam_clean:
+ rm -f $(UNIX_DIR)/tixSamLib.c $(UNIX_DIR)/tixBitmaps.c
+
+clean:
+ rm -f *.so *.a *.o *_s.o core errs *~ \\#* TAGS *.E sta* \\
+ a.out errors $(TIX_EXE_FILE) $(TIX_LIB_FILE) *.bak \\
+ $(SAM_TARGETS) tclSamLib.c tkSamLib.c
+
+distclean: clean
+ rm -f Makefile config.* lib.exp
+
+depend:
+ makedepend -- $(CC_SWITCHES) -- $(SRCS)
+
+Makefile: Makefile.in
+ ./config.status
+
+.c.o:
+ $(CC) -c $(CC_SWITCHES) $<
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
+}
diff --git a/tix/tools/dosstrip.tcl b/tix/tools/dosstrip.tcl
new file mode 100755
index 00000000000..bb997e2fa73
--- /dev/null
+++ b/tix/tools/dosstrip.tcl
@@ -0,0 +1,72 @@
+#! /bin/sh
+# the next line restarts using tclsh7.6 \
+unset TCL_LIBRARY; exec tclsh7.6 "$0" "$@"
+
+
+if {$argv == {}} {
+ puts "usage: dosstrip.tcl \[-n|-f\] file"
+ exit 1
+}
+
+set files $argv
+
+if {[llength $files] > 1 && [lindex $files 0] == "-n"} {
+ set test 1
+ set files [lrange $files 1 end]
+} else {
+ set test 0
+}
+
+if {[llength $files] > 1 && [lindex $files 0] == "-f"} {
+ set forced 1
+ set files [lrange $files 1 end]
+} else {
+ set forced 0
+}
+
+foreach file $files {
+ if [file isdir $file] {
+ puts stderr "$file is a directory"
+ continue
+ }
+ if [catch {set fd [open $file {RDONLY}]}] {
+ puts stderr "Cannot open $file for reading"
+ continue
+ }
+ fconfigure $fd -translation binary
+ set data [read $fd [file size $file]]
+ close $fd
+ set ctrlM [format %s \r]
+ if {[regsub -all $ctrlM $data "" data]} {
+ if {$test} {
+ puts "$file contains ^M"
+ } else {
+ set chmod 0
+ if [catch {set fd [open $file {WRONLY TRUNC}]}] {
+ if $forced {
+ catch {exec chmod u+w $file}
+ if [catch {set fd [open $file {WRONLY TRUNC}]}] {
+ puts stderr "Cannot open $file for writing"
+ continue
+ }
+ set chmod 1
+ } else {
+ puts stderr "Cannot open $file for writing"
+ continue
+ }
+ }
+ puts $fd $data
+ close $fd
+ if {$chmod} {
+ catch {exec chmod u-w $file}
+ }
+ }
+ puts "+ $file"
+ } else {
+ if {$test} {
+ puts "$file does not contain ^M"
+ } else {
+ puts "- $file"
+ }
+ }
+}
diff --git a/tix/tools/doxx.tcl b/tix/tools/doxx.tcl
new file mode 100644
index 00000000000..f8299557fbd
--- /dev/null
+++ b/tix/tools/doxx.tcl
@@ -0,0 +1,160 @@
+# doxx.tcl --
+#
+# Common code shared by doconfig.tcl and domakefile.tcl
+#
+
+case $argv {
+ tk4.0 {
+ set TCL_VERSION 7.4
+ set subs(@@_V_TCL_VER_@@) 7.4
+ set subs(@@_V_TCLVER_@@) 74
+ set subs(@@_V_TK_VER_@@) 4.0
+ set subs(@@_V_TKVER_@@) 40
+ }
+ tk4.1 {
+ set TCL_VERSION 7.5
+ set subs(@@_V_TCL_VER_@@) 7.5
+ set subs(@@_V_TCLVER_@@) 75
+ set subs(@@_V_TK_VER_@@) 4.1
+ set subs(@@_V_TKVER_@@) 41
+ }
+ tk4.2 {
+ set TCL_VERSION 7.6
+ set subs(@@_V_TCL_VER_@@) 7.6
+ set subs(@@_V_TCLVER_@@) 76
+ set subs(@@_V_TK_VER_@@) 4.2
+ set subs(@@_V_TKVER_@@) 42
+ }
+ tk4.3 {
+ set TCL_VERSION 7.7
+ set subs(@@_V_TCL_VER_@@) 7.7
+ set subs(@@_V_TCLVER_@@) 77
+ set subs(@@_V_TK_VER_@@) 4.3
+ set subs(@@_V_TKVER_@@) 43
+ }
+ tk8.0 {
+ set TCL_VERSION 8.0
+ set subs(@@_V_TCL_VER_@@) 8.0
+ set subs(@@_V_TCLVER_@@) 80
+ set subs(@@_V_TK_VER_@@) 8.0
+ set subs(@@_V_TKVER_@@) 80
+ }
+ itcl2.0 {
+ set TCL_VERSION 7.4
+ set subs(@@_V_TCL_VER_@@) 7.4
+ set subs(@@_V_TCLVER_@@) 74
+ set subs(@@_V_TK_VER_@@) 4.0
+ set subs(@@_V_TKVER_@@) 40
+ set subs(@@_V_ITCL_VER_@@) 2.0
+ set subs(@@_V_ITCLVER_@@) 20
+ }
+ itcl2.1 {
+ set TCL_VERSION 7.5
+ set subs(@@_V_TCL_VER_@@) 7.5
+ set subs(@@_V_TCLVER_@@) 75
+ set subs(@@_V_TK_VER_@@) 4.1
+ set subs(@@_V_TKVER_@@) 41
+ set subs(@@_V_ITCL_VER_@@) 2.1
+ set subs(@@_V_ITCLVER_@@) 21
+ set subs(@@_V_IWIDGETS_VER_@@) 2.1.0
+ }
+ itcl2.2 {
+ set TCL_VERSION 7.6
+ set subs(@@_V_TCL_VER_@@) 7.6
+ set subs(@@_V_TCLVER_@@) 76
+ set subs(@@_V_TK_VER_@@) 4.2
+ set subs(@@_V_TKVER_@@) 42
+ set subs(@@_V_ITCL_VER_@@) 2.2
+ set subs(@@_V_ITCLVER_@@) 22
+ set subs(@@_V_IWIDGETS_VER_@@) 2.2.0
+ }
+ default {
+ puts stderr "option \"$argv\" not supported"
+ exit 1
+ }
+}
+
+if [info exists subs(@@_V_ITCLVER_@@)] {
+ set ITCL 1
+ set subs(@@_V_LNAME_@@) tix
+ set subs(@@_V_BVEREXT_@@) 1
+} else {
+ set ITCL 0
+ set subs(@@_V_LNAME_@@) tix
+ set subs(@@_V_BVEREXT_@@) ""
+}
+
+if {$subs(@@_V_TCL_VER_@@) == 7.4} {
+ set TCL74 1
+} else {
+ set TCL74 0
+}
+
+proc p {string} {
+ global subs
+
+ foreach name [array name subs] {
+ regsub -all $name $string $subs($name) string
+ }
+ regsub ^[format \n] $string "" string
+ regsub "\[[format \t] \]*\$" $string "" string
+ regsub -all \\\\\\\\ $string \\ string
+ puts $string
+}
+
+proc p74 {string} {
+ global TCL74
+ if $TCL74 {
+ p $string
+ }
+}
+
+proc p75+ {string} {
+ global TCL74
+ if !$TCL74 {
+ p $string
+ }
+}
+
+proc pitcl {string} {
+ global ITCL
+ if $ITCL {
+ p $string
+ }
+}
+
+proc ptcl {string} {
+ global ITCL
+ if !$ITCL {
+ p $string
+ }
+}
+
+set ENABLE_SAM 0
+set SAM_LIB 0
+set SAM_EXE 0
+
+if {!$ITCL} {
+ if {$TCL_VERSION <= 7.6} {
+ set ENABLE_SAM 1
+ set SAM_LIB 1
+ set SAM_EXE 1
+ } else {
+ set ENABLE_SAM 1
+ set SAM_LIB 1
+ set SAM_EXE 0
+ }
+} else {
+ if {$TCL_VERSION == 7.6} {
+ set ENABLE_SAM 1
+ set SAM_LIB 1
+ set SAM_EXE 0
+ }
+}
+
+proc p_sam {string} {
+ global ENABLE_SAM
+ if $ENABLE_SAM {
+ p $string
+ }
+}
diff --git a/tix/tools/hanno.tcl b/tix/tools/hanno.tcl
new file mode 100755
index 00000000000..579c07fcef3
--- /dev/null
+++ b/tix/tools/hanno.tcl
@@ -0,0 +1,66 @@
+#!/bin/sh
+# the next line restarts using tixwish \
+exec tclsh7.6 "$0" "$@"
+
+# Options
+#
+# -v : Verbose mode. Print out what hanno is doing.
+#
+set verbose 0
+
+if {[info exists env(TIX_VERBOSE)] && $env(TIX_VERBOSE) == 1} {
+ set verbose 1
+}
+
+if {[lsearch -glob $argv -v*] != -1} {
+ set verbose 1
+}
+
+set files [exec find . -name *.html -print]
+
+foreach file $files {
+ if {$verbose} {
+ puts "\[html anno]: checking $file"
+ }
+ set output {}
+ set src [open $file RDONLY]
+
+ set changed 1
+
+ while {![eof $src]} {
+ set line [gets $src]
+
+ if {[regexp -nocase {[ \t]*\<hr>\<i>Last modified.*} $line]} {
+ # Do nothing
+ } elseif {[regexp -nocase {[ \t]*\<i>Serial.*\</i>} $line]} {
+ if {[scan $line "<i>Serial %d</i>" lastmtime] == 1} {
+ if {[expr [file mtime $file] - $lastmtime] >= 10} {
+ set changed 1
+ } else {
+ set changed 0
+ }
+ }
+ } else {
+ append output $line\n
+ }
+ }
+ close $src
+
+ if {$changed == 1} {
+ if {$verbose} {
+ puts "\[html anno]: modifying tag of $file"
+ }
+
+ set date [clock format [file mtime $file]]
+
+ set des [open $file {WRONLY TRUNC}]
+ puts -nonewline $des $output
+
+ # Somehow the "seek" is necessary
+ #
+ seek $des -1 current
+ puts $des "<hr><i>Last modified $date </i> --- "
+ puts $des "<i>Serial [file mtime $file]</i>"
+ close $des
+ }
+}
diff --git a/tix/tools/icon.tcl b/tix/tools/icon.tcl
new file mode 100755
index 00000000000..a9a839cb3e6
--- /dev/null
+++ b/tix/tools/icon.tcl
@@ -0,0 +1,17 @@
+wm geometry . +200+100
+
+if [tixMwm ismwmrunning .] {
+ tixMwm decoration . -border 0 -menu 0 -minimize 0 -resizeh 0 -title 0 \
+ -maximize 0
+}
+
+set tk_strictMotif 1
+frame .f -bd 3 -bg lightgray -relief raised
+button .b -bd 1 -highlightthickness 0 -bg gray80 -fg #a04040 -relief sunken \
+ -font -*-helvetica-bold-r-*-*-18-*-*-*-*-*-*-* -anchor s
+
+.b config -text "Advantages of Tix"
+. config -bg gray40
+pack .f -padx 1 -pady 1
+pack .b -in .f -padx 0 -pady 0
+
diff --git a/tix/tools/makebitmap.tcl b/tix/tools/makebitmap.tcl
new file mode 100755
index 00000000000..80601a2901c
--- /dev/null
+++ b/tix/tools/makebitmap.tcl
@@ -0,0 +1,81 @@
+#!/bin/sh
+# the next line restarts using tclsh \
+exec tclsh "$0" "$@"
+
+# makebitmap.tcl --
+#
+# Generates a ET file that Includes all built-in bitmaps and
+# bitmaps.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+
+set PWD [pwd]
+
+foreach dir $argv {
+ cd $dir
+
+ foreach filename [glob -nocomplain *] {
+ case [file ext $filename] {
+ {.xbm} {
+ set root [file root $filename]
+ if {$root == ""} {
+ continue
+ }
+
+ set bitsName {}
+ set widthName {}
+ set heightName {}
+ set data [exec cat $filename]
+ regexp {[A-z_0-9]*_bits} $data bitsName
+ regexp {[A-z_0-9]*_width} $data widthName
+ regexp {[A-z_0-9]*_height} $data heightName
+ if ![regexp unsigned $data] {
+ regsub char $data "unsigned char" data
+ }
+
+ if {$bitsName == {} ||
+ $widthName == {} ||
+ $heightName == {}} {
+
+ puts stderr \
+ "Warning: bad XBM format in file $dir/$filename, file excluded"
+ } else {
+ puts "\{"
+ puts [exec cat $filename]
+ puts -nonewline "Tk_DefineBitmap(Et_Interp, "
+ puts -nonewline "Tk_GetUid(\"$root\"), "
+ puts -nonewline "$bitsName, "
+ puts -nonewline "$widthName, "
+ puts -nonewline "$heightName);"
+ puts ""
+ puts "\}"
+ }
+
+ }
+ {.xpm} {
+ set name [file root $filename]
+ set data [exec cat $filename]
+ if [regexp char\[^\\\[\]* $data root] {
+ regsub char $root "" root
+ regsub \[\*\] $root "" root
+ set root [string trim $root]
+ } else {
+ set root [file root $filename]\_xpm
+ }
+ puts "\{"
+ puts [exec cat $filename]
+ puts -nonewline "Tix_DefinePixmap(Et_Interp, "
+ puts -nonewline "Tk_GetUid(\"$name\"), "
+ puts -nonewline "$root);"
+ puts ""
+ puts "\}"
+ }
+ }
+ }
+ cd $PWD
+}
+
diff --git a/tix/tools/makescript.tcl b/tix/tools/makescript.tcl
new file mode 100755
index 00000000000..06840abcc74
--- /dev/null
+++ b/tix/tools/makescript.tcl
@@ -0,0 +1,150 @@
+#!/bin/sh
+# the next line restarts using tclsh \
+exec tclsh "$0" "$@"
+
+set dir [lindex $argv 0]
+
+proc CheckDep {file dep} {
+ global $file $dep
+
+ if [info exist $file\($dep\)] {
+ return 1
+ } else {
+ foreach dd [array names $file] {
+ if [CheckDep $dd $dep] {
+ return 1
+ }
+ }
+ return 0
+ }
+}
+
+proc PrintDep {file dep} {
+ global $file $dep
+
+ if [info exist $file\($dep\)] {
+ return "$file"
+ } else {
+ foreach dd [array names $file] {
+ set list [PrintDep $dd $dep]
+ if {$list != {}} {
+ return "$file -> $list"
+ }
+ }
+ return {}
+ }
+}
+
+
+foreach line [split [exec cat $dir/tclIndex] \n] {
+ regsub auto_index $line a line
+ regsub "\"source \{\\\$dir/" $line "" line
+ regsub "\}\"" $line "" line
+
+ if [regexp :: $line] {
+ continue
+ }
+
+ eval $line
+}
+
+set fake(Compat.tcl,FileBox.tcl) 1
+set fake(Compat.tcl,ComboBox.tcl) 1
+set fake(Compat.tcl,WinFile.tcl) 1
+set fake(Compat.tcl,UnixFile.tcl) 1
+set fake(FileCmpt.tcl,Tix.tcl) 1
+set fake(DefSchm.tcl,Tix.tcl) 1
+set fake(Tix.tcl,Balloon.tcl) 1
+set fake(FileCmpt.tcl,Tix.tcl) 1
+set fake(Tix.tcl,FileDlg.tcl) 1
+set fake(Tix.tcl,Shell.tcl) 1
+set fake(FileBox.tcl,FileDlg.tcl) 1
+set fake(UnixFile.tcl,WinFile.tcl) 1
+set fake(WinFile.tcl,UnixFile.tcl) 1
+set fake(UnixFile.tcl,Tix.tcl) 1
+set fake(WinFile.tcl,Tix.tcl) 1
+set fake(WinFile.tcl,Compat.tcl) 1
+
+
+set fake(Tix.tcl,Balloon.tcl) 1
+set fake(Tix.tcl,Shell.tcl) 1
+set fake(Tix.tcl,FileDlg.tcl) 1
+set fake(Utils.tcl,FileDlg.tcl) 1
+set fake(ComboBox.tcl,FileBox.tcl) 1
+
+cd ../library
+
+if 1 {
+ set TH [glob *.tcl]
+} else {
+ set TH {Compat.tcl FileBox.tcl Tix.tcl FileCmpt.tcl Tree.tcl Verify.tcl}
+}
+
+set hasError 0
+
+foreach file [lsort $TH] {
+ set files($file) 1
+ set data [exec cat $file]
+ foreach proc [array names a] {
+ set otherFile $a($proc)
+
+ if {$a($proc) == $file} {
+ continue
+ }
+ if [info exist $file\($otherFile\)] {
+ continue
+ }
+ if [regexp $proc $data] {
+ if [info exists fake($file,$otherFile)] {
+ puts stderr "\t(ignored) FAKE dependence $file -> $otherFile"
+ continue
+ } elseif [CheckDep $otherFile $file] {
+ puts stderr "\t(error) CIRCULAR dependence $file -> $otherFile"
+ puts stderr "\t$file -> [PrintDep $otherFile $file]"
+ set hasError 1
+ } else {
+ set $file\($otherFile\) 1
+ puts stderr "$file -> $otherFile"
+ }
+ }
+ }
+}
+
+if {$hasError} {
+ puts stderr "Error occurred"
+ exit -1
+} else {
+ puts stderr "All dependencies resolved. Proceeding ..."
+}
+
+proc Load {file} {
+ global loaded dir
+
+ if [info exists loaded($file)] {
+ return
+ } else {
+ global $file
+ if [info exists $file] {
+ foreach n [array names $file] {
+ Load $n
+ }
+ }
+ puts " ET_INCLUDE( $dir/$file );"
+ set loaded($file) 1
+ }
+}
+
+proc LoadFiles {} {
+ global files loaded
+ catch {
+ unset loaded
+ }
+
+ foreach f [array names files] {
+ Load $f
+ }
+}
+
+LoadFiles
+
+puts stderr Done
diff --git a/tix/tools/mkfaq.tcl b/tix/tools/mkfaq.tcl
new file mode 100755
index 00000000000..49e21f8373a
--- /dev/null
+++ b/tix/tools/mkfaq.tcl
@@ -0,0 +1,10 @@
+#! /usr/local/bin/tclsh
+#
+# This program is used to generate the FAQ.txt file
+#
+# Options
+#
+# none ..
+#
+
+
diff --git a/tix/tools/setcolon.sh b/tix/tools/setcolon.sh
new file mode 100755
index 00000000000..6302565f15c
--- /dev/null
+++ b/tix/tools/setcolon.sh
@@ -0,0 +1,32 @@
+#!/bin/sh
+#
+# setcolon.sh --
+#
+#
+# This program replaces all occurrences of :: in a file to :. It can
+# be used to convert Tix mega widget classes to use the new convention
+# of the single colon qualifier in method names.
+#
+# *Use with caution*. You may not want to replace all double colons in
+# your program with single colons. The following is the entire
+# program. Please examine carefully before execution.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+
+
+if test "$*" = ""; then
+ echo Usage: $0 file [files ...]
+ echo
+ cat $0
+ exit
+fi
+
+for i in $*;
+do
+ echo "modifying $i";
+ sed -e 's|::|:|' $i > $i.tmp;
+ mv $i.tmp $i;
+done;
diff --git a/tix/tools/tclc.tcl b/tix/tools/tclc.tcl
new file mode 100644
index 00000000000..fa1405c58c2
--- /dev/null
+++ b/tix/tools/tclc.tcl
@@ -0,0 +1,223 @@
+proc ParseFile {fileName n} {set fd [open $fileName {RDONLY}]
+set lineNum 1
+puts "static char script_$n\[\] = \{"
+set N [format \n]
+set T [format \t]
+set NTS [format "\n\t\ "]
+set sep ""
+while {![eof $fd]} {set line [gets $fd]
+regsub -all $N $line " " foo
+append foo \na
+set foo [subst -nocommands -novariables $foo]
+if [regexp $N $foo] {set cmd "$line\n"
+} else {regsub -all \\\\\[$NTS\]*$ $line " " line
+set cmd "$line"
+}
+set cmd '[join [split $cmd ""] ',']'
+regsub -all \\\\ $cmd \\\\\\\\ cmd
+regsub -all $N $cmd \\n cmd
+regsub -all $T $cmd \\t cmd
+regsub -all ''' $cmd '\\'' cmd
+regsub -all '\"' $cmd '\\\"' cmd
+puts -nonewline $sep$cmd
+set sep ,\n
+}
+puts "$sep'\\0'\};"
+close $fd
+}
+proc tclc_Main {} {global argv argv0
+set files [lrange $argv 0 end]
+set n 0
+foreach fileName $argv {ParseFile $fileName $n
+incr n
+}
+puts "static int LoadScripts(interp)"
+puts " Tcl_Interp * interp;"
+puts "\{"
+if {$n > 0} {puts " char *scripts\[$n\];"
+puts " int i;"
+for {set k 0} {$k < $n} {incr k} {puts " scripts\[$k\] = script_$k;"
+}
+puts " for (i=0; i<$n; i++) \{"
+puts " if (Tcl_Eval(interp, scripts\[i\]) != TCL_OK) \{"
+puts " return TCL_ERROR;"
+puts " \}"
+puts " \}"
+}
+puts " return TCL_OK;"
+puts "\}"
+}
+
+proc jdb_ParseFile {fileName rewriteProc} {global jdbLines
+if [info exists jdbLines] {unset jdbLines
+}
+set data ""
+set fd [open $fileName {RDONLY}]
+set fileLineNum 1
+set scapLineNum 1
+set fileLineNumx 1
+set newLine [format \n]
+set NTS [format "\n\t\ "]
+while {![eof $fd]} {set line [gets $fd]
+regsub -all $newLine $line " " foo
+append foo \na
+set foo [subst -nocommands -novariables $foo]
+if [regexp $newLine $foo] {append data "$line\n"
+set jdbLines($scapLineNum) $fileLineNumx
+incr scapLineNum
+incr fileLineNum
+set fileLineNumx $fileLineNum
+} else {regsub -all \\\\\[$NTS\]*$ $line " " line
+append data "$line"
+incr fileLineNum
+}
+}
+close $fd
+global jdb_rewProc
+set jdb_rewProc $rewriteProc
+return [jdb_Rewrite $fileName 1 $data]
+}
+proc jdb_BreakCommand {lineNum script wordsName typesName lnumsName} {upvar $wordsName words
+upvar $typesName types
+upvar $lnumsName lnums
+set i 0
+set word ""
+set sep ""
+set N [format %s \n]
+foreach item [split $script " "] {append word $sep$item
+if ![string comp [string trim $word] ""] {continue
+}
+if [info complete $word] {set n [regsub -all $N $word "" dummy]
+set tmp [string trim $word]
+set len [string len $tmp]
+if {[string index $tmp 0] == "\{" &&
+ [string index $tmp [expr $len-1]] == "\}"} {set word [string range $tmp 1 [expr $len-2]]
+set itemType brace
+} elseif {[string index $tmp 0] == "\"" &&
+ [string index $tmp [expr $len-1]] == "\""} {set word [string range $tmp 1 [expr $len-2]]
+set itemType quote
+} else {set itemType none
+}
+set lnums($i) $lineNum
+set types($i) $itemType
+set words($i) $word
+incr lineNum $n
+incr i
+set word ""
+set sep ""
+} else {set sep " "
+}
+}
+if [string comp [string trim $word] ""] {error "badly formatted script\n$script"
+}
+}
+proc jdb_Recurse {file lineNum script} {global builtin
+set cmd [lindex [split $script " "] 0]
+if [info exists builtin($cmd)] {set script [$builtin($cmd) $file $lineNum $script]
+}
+return $script
+}
+proc jdb_JoinCommand {wordsName typesName} {upvar $wordsName words
+upvar $typesName types
+set rwt ""
+set sep ""
+foreach i [lsort -integer [array names words]] {case $types($i) {
+ brace {append rwt "$sep\{"
+append rwt "$words($i)"
+append rwt "\}"
+} quote {append rwt "$sep\""
+append rwt "$words($i)"
+append rwt "\""
+} default {append rwt "$sep$words($i)"
+}}
+set sep " "
+}
+return $rwt
+}
+proc jdb_Rewrite {file lineNum script} {global jdb_rewProc xxx
+set rewritten ""
+set cmd ""
+foreach line [split $script \n] {append cmd $line\n
+if [info complete $cmd] {append rewritten [$jdb_rewProc $file $lineNum $cmd]
+incr lineNum [regsub -all [format %s \n] $cmd "" dummy]
+set cmd ""
+}
+}
+if [string comp $cmd {}] {error "Script is not complete: \n$script"
+} else {return $rewritten
+}
+}
+set builtin(catch) jdb_RewriteCatch
+set builtin(case) jdb_RewriteCase
+set builtin(for) jdb_RewriteFor
+set builtin(foreach) jdb_RewriteForeach
+set builtin(if) jdb_RewriteIf
+set builtin(proc) jdb_RewriteProc
+set builtin(while) jdb_RewriteWhile
+proc jdb_RewriteCatch {file lineNum script} {jdb_BreakCommand $lineNum $script words types lnums
+if [info exists words(1)] {set words(1) [jdb_Rewrite $file $lnums(1) $words(1)]
+}
+return [jdb_JoinCommand words types]
+}
+proc jdb_RewriteCase {file lineNum script} {jdb_BreakCommand $lineNum $script words types lnums
+set indices [lsort -integer [array names words]]
+if [info exists words(2)] {if ![string comp $words(2) in] {set list [lrange $indices 3 end]
+} else {set list [lrange $indices 2 end]
+}
+if {[llength $list] > 1} {set len [llength $list]
+for {set x 1} {$x < $len} {incr x 2} {set i [lindex $list $x]
+set words($i) [jdb_Rewrite $file $lnums($i) $words($i)]
+}
+} else {set i [lindex $list 0]
+set words($i) [jdb_RewriteCaseBodyList $file $lnums($i) $words($i)]
+}
+}
+return [jdb_JoinCommand words types]
+}
+proc jdb_RewriteCaseBodyList {file lineNum script} {jdb_BreakCommand $lineNum $script words types lnums
+set indices [lsort -integer [array names words]]
+set len [llength $indices]
+for {set x 1} {$x < $len} {incr x 2} {set i [lindex $indices $x]
+set words($i) [jdb_Rewrite $file $lnums($i) $words($i)]
+}
+return [jdb_JoinCommand words types]
+}
+proc jdb_RewriteIf {file lineNum script} {jdb_BreakCommand $lineNum $script words types lnums
+set expected if
+foreach i [lsort -integer [array names words]] {set ln $lnums($i)
+set item $words($i)
+case $expected {
+ if {set expected expr
+} expr {set expected stmt
+} stmt {if [string comp [string trim $item] "then"] {set words($i) [jdb_Rewrite $file $ln $item]
+set expected el_elif
+}
+} el_elif {if {$item == "elseif"} {set expected expr
+} else {set expected stmt
+}
+}}
+}
+return [jdb_JoinCommand words types]
+}
+proc jdb_RewriteProc {file lineNum script} {jdb_BreakCommand $lineNum $script words types lnums
+if [info exists words(3)] {set words(3) [jdb_Rewrite $file $lnums(3) $words(3)]
+}
+return [jdb_JoinCommand words types]
+}
+proc jdb_RewriteWhile {file lineNum script} {jdb_BreakCommand $lineNum $script words types lnums
+if [info exists words(2)] {set words(2) [jdb_Rewrite $file $lnums(2) $words(2)]
+}
+return [jdb_JoinCommand words types]
+}
+proc jdb_RewriteFor {file lineNum script} {jdb_BreakCommand $lineNum $script words types lnums
+if [info exists words(4)] {set words(4) [jdb_Rewrite $file $lnums(4) $words(4)]
+}
+return [jdb_JoinCommand words types]
+}
+proc jdb_RewriteForeach {file lineNum script} {jdb_BreakCommand $lineNum $script words types lnums
+if [info exists words(3)] {set words(3) [jdb_Rewrite $file $lnums(3) $words(3)]
+}
+return [jdb_JoinCommand words types]
+}
+
+tclc_Main
diff --git a/tix/tools/tclc_s.tcl b/tix/tools/tclc_s.tcl
new file mode 100644
index 00000000000..6b6dd57910f
--- /dev/null
+++ b/tix/tools/tclc_s.tcl
@@ -0,0 +1,85 @@
+# tclc.tcl --
+#
+# This Tcl script translates Tcl commands to one C string.
+#
+# Usage:
+# [tclsh] tclc.tcl file1.tcl [file2.tcl ...]
+#
+# The output is printed in the standard output.
+
+# ParseFile --
+#
+# Read in a file and insert line number information into the code.
+#
+proc ParseFile {fileName n} {
+ set fd [open $fileName {RDONLY}]
+ set lineNum 1
+
+ puts "static char script_$n\[\] = \{"
+
+ set N [format \n]
+ set T [format \t]
+ set NTS [format "\n\t\ "]
+ set sep ""
+ while {![eof $fd]} {
+ set line [gets $fd]
+
+ # Check whether this line is backslash-ended. If so, merge this line
+ # with the next one
+ #
+ regsub -all $N $line " " foo
+ append foo \na
+ set foo [subst -nocommands -novariables $foo]
+ if [regexp $N $foo] {
+ set cmd "$line\n"
+ } else {
+ regsub -all \\\\\[$NTS\]*$ $line " " line
+ set cmd "$line"
+ }
+ set cmd '[join [split $cmd ""] ',']'
+ regsub -all \\\\ $cmd \\\\\\\\ cmd
+ regsub -all $N $cmd \\n cmd
+ regsub -all $T $cmd \\t cmd
+ regsub -all ''' $cmd '\\'' cmd
+ regsub -all '\"' $cmd '\\\"' cmd
+
+ puts -nonewline $sep$cmd
+ set sep ,\n
+ }
+ puts "$sep'\\0'\};"
+ close $fd
+}
+
+proc tclc_Main {} {
+ global argv argv0
+
+ set files [lrange $argv 0 end]
+
+ set n 0
+ foreach fileName $argv {
+ ParseFile $fileName $n
+ incr n
+ }
+
+ puts "static int LoadScripts(interp)"
+ puts " Tcl_Interp * interp;"
+ puts "\{"
+
+ if {$n > 0} {
+ puts " char *scripts\[$n\];"
+ puts " int i;"
+
+ for {set k 0} {$k < $n} {incr k} {
+ puts " scripts\[$k\] = script_$k;"
+ }
+
+ puts " for (i=0; i<$n; i++) \{"
+ puts " if (Tcl_Eval(interp, scripts\[i\]) != TCL_OK) \{"
+ puts " return TCL_ERROR;"
+ puts " \}"
+ puts " \}"
+ }
+
+ puts " return TCL_OK;"
+ puts "\}"
+}
diff --git a/tix/tools/tcltrim b/tix/tools/tcltrim
new file mode 100755
index 00000000000..8a77e9a1c79
--- /dev/null
+++ b/tix/tools/tcltrim
@@ -0,0 +1,24 @@
+#!/usr/local/bin/tclsh
+
+foreach source $argv {
+ set target [file rootname $source].tt
+
+ set src [open $source RDONLY]
+ set tgt [open $target {RDWR CREAT TRUNC}]
+
+ while {[eof $src] == 0} {
+ set line [string trim [gets $src]]
+
+ if {$line == ""} {
+ continue
+ }
+ if {[string index $line 0] == "#"} {
+ continue
+ }
+ puts $tgt $line
+ }
+
+ close $src
+ close $tgt
+}
+
diff --git a/tix/tools/tixindex b/tix/tools/tixindex
new file mode 100755
index 00000000000..1122ab6d1a1
--- /dev/null
+++ b/tix/tools/tixindex
@@ -0,0 +1,66 @@
+#!/bin/sh
+# the next line restarts using tclsh \
+exec tclsh "$0" "$@"
+
+proc tixAutoMkIndex {dir args} {
+ global errorCode errorInfo
+ set oldDir [pwd]
+ cd $dir
+ set dir [pwd]
+ append index "# Tcl autoload index file, version 2.0\n"
+ append index "# This file is generated by the \"tixindex\" program,\n"
+ append index "# *NOT* by the \"auto_mkindex\" command,\n"
+ append index "# and sourced to set up indexing information for one or\n"
+ append index "# more commands. Typically each line is a command that\n"
+ append index "# sets an element in the auto_index array, where the\n"
+ append index "# element name is the name of a command and the value is\n"
+ append index "# a script that loads the command.\n\n"
+ foreach file [eval glob $args] {
+ set f ""
+ set error [catch {
+ set f [open $file]
+ while {[gets $f line] >= 0} {
+ if [regexp {^tixClass[ ]+([^ ]*)} $line match className] {
+ append index "set [list auto_index($className)]"
+ append index " \"source {\$dir/$file}\"\n"
+ append index "set [list auto_index($className:AutoLoad)]"
+ append index " \"source {\$dir/$file}\"\n"
+ set isClass($className) 1
+ }
+ if [regexp {^tixWidgetClass[ ]+([^ ]*)} $line match className] {
+ append index "set [list auto_index($className)]"
+ append index " \"source {\$dir/$file}\"\n"
+ append index "set [list auto_index($className:AutoLoad)]"
+ append index " \"source {\$dir/$file}\"\n"
+ set isClass($className) 1
+ }
+
+ if [regexp {^proc[ ]+([^ ]*)} $line match procName] {
+ set prefix [lindex [split $procName :] 0]
+ if {![info exists isClass($prefix)]} {
+ append index "set [list auto_index($procName)]"
+ append index " \"source {\$dir/$file}\"\n"
+ }
+ }
+ }
+ close $f
+ } msg]
+ if $error {
+ set code $errorCode
+ set info $errorInfo
+ catch {close $f}
+ cd $oldDir
+ error $msg $info $code
+ }
+ }
+ set f [open tclIndex w]
+ puts $f $index nonewline
+ close $f
+ cd $oldDir
+}
+
+if {$argv == {}} {
+ eval tixAutoMkIndex . *.tcl
+} else {
+ eval tixAutoMkIndex . $argv
+}
diff --git a/tix/tools/tixverify.tcl b/tix/tools/tixverify.tcl
new file mode 100755
index 00000000000..3dec025a5fa
--- /dev/null
+++ b/tix/tools/tixverify.tcl
@@ -0,0 +1,323 @@
+#! /bin/sh
+# the next line restarts using tclsh7.5 \
+exec tclsh7.5 "$0" "$@"
+
+#
+# tixverify.tcl
+#
+# Parses some files in the Tix distribution (.tcl scripts, Makefile.in,
+# etc) and detect potential errors.
+#
+#
+
+#----------------------------------------------------------------------
+# AUX ROUTINES
+#----------------------------------------------------------------------
+
+proc Usage {} {
+ global info
+
+ puts "Usage: \[test ... --\] files ..."
+ puts "available tests:"
+ set maxLen 0
+ foreach name [lsort [array names info]] {
+ if {$maxLen < [string length $name]} {
+ set maxLen [string length $name]
+ }
+ }
+ foreach name [lsort [array names info]] {
+ puts " [format %-$maxLen\s $name] : $info($name)"
+ }
+}
+
+proc ReadFile {file} {
+ set data {}
+ set fd [open $file {RDONLY}]
+ while {![eof $fd]} {
+ append data [gets $fd]\n
+ }
+ close $fd
+ return $data
+}
+
+# returns a list of all the procedures in the $file
+#
+#
+proc ProcParser {file} {
+ global procs
+ set procs {}
+
+ set interp [interp create]
+
+ foreach cmd [$interp eval info commands] {
+ if {$cmd == "rename"} {
+ continue
+ }
+ if {$cmd == "proc"} {
+ continue
+ }
+ if {$cmd == "unknown"} {
+ continue
+ }
+ if {$cmd == "source"} {
+ continue
+ }
+ if {$cmd == "info"} {
+ continue
+ }
+ if {$cmd == "set"} {
+ continue
+ }
+ $interp eval [list rename $cmd {}]
+ }
+
+ $interp eval rename source __source
+ $interp eval rename info __info
+ $interp eval rename rename __rename
+ $interp alias unknown unknown_sub
+ $interp alias proc proc_sub
+
+ proc unknown_sub {args} {
+ #puts "Ignoring toplevel command $args"
+ }
+
+ proc proc_sub {name arg body} {
+ global procs
+ lappend procs [list $name $arg $body]
+ }
+
+ $interp eval __source $file
+ interp delete $interp
+
+ return $procs
+}
+
+#----------------------------------------------------------------------
+# THE TESTS
+#----------------------------------------------------------------------
+
+#----------------------------------------------------------------------
+#
+set info(make) "the .o targets in the Makefiles"
+
+proc Verify:make {files} {
+ # $files is not used
+ #
+ set list {}
+ set list_s {}
+ set appPWD [pwd]
+ set dir [file dirname [info script]]
+ cd $dir
+ cd ..
+ set dir [pwd]
+ cd $appPWD
+ puts "checking the makefiles $dir/*/Makefile.in"
+ foreach file [glob $dir/*/Makefile.in] {
+ set data [ReadFile $file]
+ if [regexp {tixClass[.]o} $data] {
+ lappend list $file
+
+ foreach line [split $data \n] {
+ if [regexp {tix[A-z]*[.]o} $line target] {
+ regsub _s $target "" target
+ set targets($target) 1
+ }
+ }
+ }
+ if [regexp {tixClass_s[.]o} $data] {
+ lappend list_s $file
+ }
+ }
+
+ foreach file $list {
+ set data [ReadFile $file]
+ set filename "$file:\n"
+ foreach target [lsort [array names targets]] {
+ if {![regexp $target $data]} {
+ puts -nonewline $filename
+ puts \t$target
+ set filename ""
+ }
+ }
+ if {[lsearch $list_s $file] != -1} {
+ foreach target [lsort [array names targets]] {
+ if {$target == "tixAppInit.o"} {
+ continue
+ }
+ regsub {[.]o} $target _s.o target
+ if {![regexp $target $data]} {
+ puts -nonewline $filename
+ puts \t$target
+ set filename ""
+ }
+ }
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+#
+set info(strcmp) "ungarded string comparisons"
+
+proc Verify:strcmp {files} {
+ catch {
+ set lines ""
+ set lines [eval exec egrep -n [list {if.*[!=]=.*[^x]\$}] $files]
+ }
+
+ foreach line [split $lines \n] {
+ if [regexp {[x]\$} $line] {
+ continue
+ }
+ puts $line
+ }
+}
+
+#----------------------------------------------------------------------
+#
+set info(strcmp1) "improperly guarded string comparisons"
+
+proc Verify:strcmp1 {files} {
+ catch {
+ set lines ""
+ set lines [eval exec egrep -n [list {if.*[!=]=.*[x]\$}] $files]
+ }
+
+ foreach line [split $lines \n] {
+ if ![regexp {[\"]x[^\"]*[\"][ ]*[!=]=[ ]*[\"]x[^\"]*[\"]} $line stuff] {
+ puts $line
+ continue
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+#
+set info(bool) "unverified boolean options (missing tixVerifyBoolean)"
+
+proc Verify:bool {files} {
+ set boolOpts {
+ -disablecallback
+ -dropdown
+ -editable
+ -fancy
+ -history
+ -prunehistory
+ -disablecallback
+ -showhidden
+ -takefocus
+ -allowzero
+ -radio
+ -dynamicgeometry
+ -ignoreinvoke
+ }
+
+ puts "checking the following options: \{$boolOpts\}"
+
+ set rexp ""
+ set prefix ""
+
+ foreach opt $boolOpts {
+ append rexp "$prefix\(\{$opt\[\ \].*\[^n\]\}\)"
+ set prefix "|"
+ }
+
+ catch {
+ puts [eval exec egrep -n [list $rexp] $files]
+ }
+}
+
+#----------------------------------------------------------------------
+#
+set info(classname) "misspelled class name"
+
+proc Verify:classname {files} {
+ foreach file $files {
+ set data [exec cat $file]
+ if [regexp "(tixWidgetClass|tixClass)\[^\{\]*\{" $data def] {
+ regsub (tixWidgetClass|tixClass) $def "" def
+ regsub \{ $def "" def
+ set def [string trim $def]
+
+ set inFile "in file $file:\n"
+
+ foreach line [split $data \n] {
+ if {[regexp "^proc.*:" $line] && ![regexp $def: $line]} {
+ puts -nonewline $inFile
+ puts " $line"
+ set inFile ""
+ }
+ }
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+#
+set info(chain) "improperly chained methods"
+
+proc Verify:chain {files} {
+ set baseClass(InitWidgetRec) tixPrimitive
+ set baseClass(ConstructWidget) tixPrimitive
+ set baseClass(SetBindings) tixPrimitive
+ set baseClass(Destructor) tixPrimitive
+ set mustChain [array names baseClass]
+
+ foreach file $files {
+ foreach proc [ProcParser $file] {
+ set name [lindex $proc 0]
+ set args [lindex $proc 1]
+ set body [lindex $proc 2]
+
+ set class [lindex [split $name :] 0]
+ set method [lindex [split $name :] 1]
+
+ foreach p $mustChain {
+ if {$baseClass($p) == $class} {
+ continue
+ }
+ if [regexp :$p $name] {
+ if {![string match "*tixChainMethod \$w $p*" $body]} {
+ puts $name
+ }
+ }
+ }
+ }
+ }
+}
+
+#----------------------------------------------------------------------
+# Main program
+#----------------------------------------------------------------------
+if {$argv == {}} {
+ Usage
+ exit 0
+}
+
+set idx [lsearch $argv "--"]
+if {$idx > 0 } {
+ set tests [lrange $argv 0 [expr $idx-1]]
+} else {
+ set tests [lsort [array names info]]
+}
+
+if {$idx != -1} {
+ set files [lrange $argv [expr $idx+1] end]
+} else {
+ set files $argv
+}
+
+
+foreach test $tests {
+ if {![info exists info($test)]} {
+ puts "Error: \"$test\" is not a test"
+ Usage
+ exit 1
+ }
+}
+
+foreach test $tests {
+ puts "Executing test \"$test\": Checking $info($test)"
+ Verify:$test $files
+ puts --------OK-----------
+}
diff --git a/tix/unix/Makefile.in b/tix/unix/Makefile.in
new file mode 100644
index 00000000000..2489008cca8
--- /dev/null
+++ b/tix/unix/Makefile.in
@@ -0,0 +1,347 @@
+# This file is a Makefile for Tix. 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.
+#
+
+#----------------------------------------------------------------
+# Things you can change to personalize the Makefile for your own
+# site (you can make these changes in either Makefile.in or
+# Makefile, but changes to Makefile will get lost if you re-run
+# the configuration script).
+#----------------------------------------------------------------
+
+# Default top-level directories in which to install architecture-
+# specific files (exec_prefix) and machine-independent files such
+# as scripts (prefix). The values specified here may be overridden
+# at configure-time with the --exec-prefix and --prefix options
+# to the "configure" script.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+
+@SET_MAKE@
+
+TIX_VERSION = @TIX_VERSION@
+
+# Directory in which to install the library of Tix scripts and demos
+# (note: you can set the TIX_LIBRARY environment variable at run-time to
+# override the compiled-in location):
+TIX_LIBRARY = $(prefix)/share/tix$(TIX_VERSION)
+
+# Directory in which to install the archive libtix.a:
+LIB_DIR = $(exec_prefix)/lib
+
+# Directory in which to install the program wish:
+BIN_DIR = $(exec_prefix)/bin
+
+# Directory in which to install the include file tix.h:
+INCLUDE_DIR = $(prefix)/include
+
+# Top-level directory for manual entries:
+MAN_DIR = $(prefix)/man
+
+# Directory in which to install manual entry for wish:
+MAN1_DIR = $(MAN_DIR)/man1
+
+# Directory in which to install manual entries for Tix's C library
+# procedures:
+MAN3_DIR = $(MAN_DIR)/man3
+
+# Directory in which to install manual entries for the built-in
+# Tcl commands implemented by Tix:
+MANN_DIR = $(MAN_DIR)/mann
+
+# Some versions of make, like SGI's, use the following variable to
+# determine which shell to use for executing commands:
+SHELL = @SHELL@
+
+#----------------------------------------------------------------
+# 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.
+#----------------------------------------------------------------
+INSTALL = @SRC_DIR@/install.sh -c
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+SRC_DIR = @SRC_DIR@
+INC_DIR = @SRC_DIR@/generic
+UNIX_DIR = @SRC_DIR@/unix
+LIBRARY_DIR = @SRC_DIR@/library
+DEMOS_DIR = @SRC_DIR@/demos
+DEMO_PROGS = widget
+TOOLS_DIR = @SRC_DIR@/tools
+MANUAL_DIR = @SRC_DIR@/man
+# CYGNUS LOCAL: Set VPATH to unix subdirectory, not top level.
+VPATH = @SRC_DIR@/unix
+CFLAGS = @CFLAGS@
+
+# CYGNUS LOCAL: Just recur for most targets:
+
+SUBDIR = @SUBDIR@
+
+all test:
+ @cd $(SUBDIR) && $(MAKE) $@
+
+mostlyclean-recursive clean-recursive distclean-recursive \
+maintainer-clean-recursive:
+ @cd $(SUBDIR) && $(MAKE) `echo $@ | sed 's/-recursive//'`
+
+configure:
+ cd $(SRC_DIR)/unix && autoconf
+
+mostlyclean: mostlyclean-recursive
+
+maintainer-clean: distclean-local maintainer-clean-recursive
+
+config.status: configure
+ $(SHELL) config.status --recheck
+
+# END CYGNUS LOCAL
+
+#----------------------------------------------------------------------
+#
+# Installation
+#
+#----------------------------------------------------------------------
+install:: install-basic install-binaries
+ @echo done
+
+BINDIRS = tk4.0 tk4.1 tk4.2 tk4.3 tk8.0 itcl2.0 itcl2.1 itcl2.2
+
+install-binaries::
+ @for i in $(BINDIRS); \
+ do \
+ if test -r $$i/Makefile; then \
+ echo "Entering directory $$i"; \
+ cd $$i; \
+ $(MAKE) prefix=$(prefix) \
+ exec_prefix=$(exec_prefix) _install_; \
+ cd ..; \
+ fi; \
+ done;
+
+#
+# Basic installtion
+#
+install-basic:: install-libraries install-headers install-demos \
+ install-man install-tools
+
+install-tools:
+ @for i in $(BIN_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "installing the tixindex program for building tclIndex for Tix scripts"
+ @cd $(TOOLS_DIR); $(INSTALL_PROGRAM) tixindex $(BIN_DIR)/tixindex
+
+install-headers:
+ @for i in $(INCLUDE_DIR); \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @for i in $(INC_DIR)/tix.h; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(INCLUDE_DIR); \
+ done;
+
+install-libraries:
+ @for i in $(TIX_LIBRARY) $(TIX_LIBRARY)/bitmaps $(TIX_LIBRARY)/pref; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @for i in $(LIBRARY_DIR)/*.tcl $(LIBRARY_DIR)/tclIndex; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(TIX_LIBRARY); \
+ done;
+ @for i in $(LIBRARY_DIR)/bitmaps/* .gif $(LIBRARY_DIR)/bitmaps/*.x*m; \
+ do \
+ if [ -f $$i ] ; then \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(TIX_LIBRARY)/bitmaps; \
+ fi; \
+ done;
+ @for i in $(LIBRARY_DIR)/pref/*.f* $(LIBRARY_DIR)/pref/*.c* $(LIBRARY_DIR)/pref/tixmkpref; \
+ do \
+ if [ -f $$i ] ; then \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(TIX_LIBRARY)/pref; \
+ fi; \
+ done;
+ @echo "Installing pkgIndex.tcl"
+ @cat */pkgIndex.tcl > pkgIndex.tcl
+ @$(INSTALL_DATA) pkgIndex.tcl $(TIX_LIBRARY)
+
+install-demos:
+ @for i in $(prefix)/lib $(TIX_LIBRARY) $(TIX_LIBRARY)/demos \
+ $(TIX_LIBRARY)/demos/bitmaps $(TIX_LIBRARY)/demos/samples ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @cd $(DEMOS_DIR); for i in *; \
+ do \
+ if [ -f $$i ] ; then \
+ echo "Installing demos/$$i"; \
+ sed -e '1 s|/usr/local/bin/tixwish|$(BIN_DIR)/tixwish|' \
+ $$i > $(TIX_LIBRARY)/demos/$$i; \
+ fi; \
+ done;
+ @for i in $(DEMO_PROGS); \
+ do \
+ chmod 755 $(TIX_LIBRARY)/demos/$$i; \
+ done;
+ @for i in $(DEMOS_DIR)/bitmaps/*; \
+ do \
+ if [ -f $$i ] ; then \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(TIX_LIBRARY)/demos/bitmaps; \
+ fi; \
+ done;
+ @for i in $(DEMOS_DIR)/samples/*; \
+ do \
+ if [ -f $$i ] ; then \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(TIX_LIBRARY)/demos/samples; \
+ fi; \
+ done;
+
+install-man:
+ @for i in $(MAN_DIR) $(MAN1_DIR) $(MAN3_DIR) $(MANN_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @cd $(MANUAL_DIR); for i in *.n *.1; \
+ do \
+ echo "Installing doc/$$i"; \
+ rm -f $(MANN_DIR)/$$i; \
+ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+ $$i > $(MANN_DIR)/$$i; \
+ chmod 444 $(MANN_DIR)/$$i; \
+ done;
+
+# CYGNUS LOCAL: install-minimal target.
+install-minimal: install-libraries
+
+tests::
+ @for i in $(BINDIRS); \
+ do \
+ if test -r $$i/Makefile; then \
+ echo "Entering directory $$i"; \
+ cd $$i; \
+ $(MAKE) tests; \
+ cd $(UNIX_DIR); \
+ fi; \
+ done;
+
+sa-tests::
+ @for i in $(BINDIRS); \
+ do \
+ if test -r $$i/Makefile; then \
+ echo "Entering directory $$i"; \
+ cd $$i; \
+ $(MAKE) sa-tests; \
+ cd $(UNIX_DIR); \
+ fi; \
+ done;
+
+compile::
+ @for i in $(BINDIRS); \
+ do \
+ if test -r $$i/Makefile; then \
+ echo "Entering directory $$i"; \
+ cd $$i; \
+ $(MAKE) CFLAGS=$(CFLAGS) ; \
+ cd $(UNIX_DIR); \
+ fi; \
+ done;
+
+clean::
+ @for i in $(BINDIRS); \
+ do \
+ if test -r $$i/Makefile; then \
+ echo "Entering directory $$i"; \
+ cd $$i; \
+ $(MAKE) clean; \
+ cd $(UNIX_DIR); \
+ fi; \
+ done;
+ - rm -f tixSamLib.c tixBitmaps.c
+
+distclean::
+ @for i in $(BINDIRS); \
+ do \
+ if test -r $$i/Makefile; then \
+ echo "Entering directory $$i"; \
+ cd $$i; \
+ $(MAKE) distclean; \
+ cd $(UNIX_DIR); \
+ fi; \
+ done;
+ - rm -f config.status Makefile.bak config.status \
+ config.cache config.log tixConfig.tcl *~ Makefile
+
+# CYGNUS LOCAL: Makefile depends upon config.status
+Makefile:Makefile.in config.status
+ ./config.status
+
+autoconf::
+ autoconf
+
+config::
+ -cd tk4.0; ./configure
+ -cd tk4.1; ./configure
+ -cd tk4.2; ./configure
+ -cd tk4.3; ./configure
+ -cd tk8.0; ./configure
+ -cd itcl2.0; ./configure
+ -cd itcl2.1; ./configure
+ -cd itcl2.2; ./configure
+
+config-shared::
+ -cd tk4.0; ./configure
+ -cd tk4.1; ./configure --enable-shared
+ -cd tk4.2; ./configure --enable-shared
+ -cd tk4.3; ./configure --enable-shared
+ -cd tk8.0; ./configure --enable-shared
+ -cd itcl2.0; ./configure
+ -cd itcl2.1; ./configure --enable-shared
+ -cd itcl2.2; ./configure --enable-shared
+
+config-shared-sam::
+ -cd tk4.0; ./configure --enable-sam
+ -cd tk4.1; ./configure --enable-shared --enable-sam
+ -cd tk4.2; ./configure --enable-shared --enable-sam
+ -cd tk4.3; ./configure --enable-shared
+ -cd tk8.0; ./configure --enable-shared
+ -cd itcl2.0; ./configure
+ -cd itcl2.1; ./configure --enable-shared
+ -cd itcl2.2; ./configure --enable-shared
+
diff --git a/tix/unix/aclocal.m4 b/tix/unix/aclocal.m4
new file mode 100644
index 00000000000..9e327b90d1d
--- /dev/null
+++ b/tix/unix/aclocal.m4
@@ -0,0 +1 @@
+"sinclude(../../config/acinclude.m4)"
diff --git a/tix/unix/configure b/tix/unix/configure
new file mode 100755
index 00000000000..5f7d983cfd0
--- /dev/null
+++ b/tix/unix/configure
@@ -0,0 +1,1506 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.12.2
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+ac_help="$ac_help
+ --with-tclconfig directory containing tcl configuration (tclConfig.sh)"
+ac_help="$ac_help
+ --with-tkconfig directory containing tk configuration (tkConfig.sh)"
+ac_help="$ac_help
+ --with-tclinclude directory where tcl headers are"
+ac_help="$ac_help
+ --with-tkinclude directory where tk headers are"
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.12.2"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=../generic/tixInit.c
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:565: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ # Account for people who put trailing slashes in PATH elements.
+ case "$ac_dir/" in
+ /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ if test -f $ac_dir/$ac_prog; then
+ if test $ac_prog = install &&
+ grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ else
+ ac_cv_path_install="$ac_dir/$ac_prog -c"
+ break 2
+ fi
+ fi
+ done
+ ;;
+ esac
+ done
+ IFS="$ac_save_IFS"
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL="$ac_cv_path_install"
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL="$ac_install_sh"
+ fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6
+echo "configure:616: checking whether ${MAKE-make} sets \${MAKE}" >&5
+set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftestmake <<\EOF
+all:
+ @echo 'ac_maketemp="${MAKE}"'
+EOF
+# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=`
+if test -n "$ac_maketemp"; then
+ eval ac_cv_prog_make_${ac_make}_set=yes
+else
+ eval ac_cv_prog_make_${ac_make}_set=no
+fi
+rm -f conftestmake
+fi
+if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ SET_MAKE=
+else
+ echo "$ac_t""no" 1>&6
+ SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+
+#----------------------------------------------------------------------
+# We don't want to use any relative path because we need to generate
+# Makefile's in subdirectories
+#----------------------------------------------------------------------
+if test "$INSTALL" = "./install.sh"; then
+ INSTALL=`pwd`/install.sh
+fi
+SRC_DIR=`cd ${srcdir}/..; pwd`
+
+
+# Check for Tcl and Tk.
+
+dirlist=".. ../../ ../../../ ../../../../ ../../../../../ ../../../../../../ ../../../../../../.. ../../../../../../../.. ../../../../../../../../.. ../../../../../../../../../.."
+if test x"${no_tcl}" = x ; then
+ no_tcl=true
+ # Check whether --with-tclconfig or --without-tclconfig was given.
+if test "${with_tclconfig+set}" = set; then
+ withval="$with_tclconfig"
+ with_tclconfig=${withval}
+fi
+
+ echo $ac_n "checking for Tcl configuration script""... $ac_c" 1>&6
+echo "configure:665: checking for Tcl configuration script" >&5
+ if eval "test \"`echo '$''{'ac_cv_c_tclconfig'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+
+ if test x"${with_tclconfig}" != x ; then
+ if test -f "${with_tclconfig}/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd ${with_tclconfig}; pwd)`
+ else
+ { echo "configure: error: ${with_tclconfig} directory doesn't contain tclConfig.sh" 1>&2; exit 1; }
+ fi
+ fi
+
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in $dirlist; do
+ if test -f $srcdir/$i/unix/tclConfig.sh ; then
+ ac_cv_c_tclconfig=`(cd $srcdir/$i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in $dirlist; do
+ if test -n "`ls -dr $i/tcl* 2>/dev/null`" ; then
+ tclconfpath=$i
+ break
+ fi
+ done
+
+ for i in `ls -dr $tclconfpath/tcl* 2>/dev/null ` ; do
+ if test -f $i/unix/tclConfig.sh ; then
+ ac_cv_c_tclconfig=`(cd $i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ ccpath=`which ${CC} | sed -e 's:/bin/.*::'`/lib
+ if test -f $ccpath/tclConfig.sh; then
+ ac_cv_c_tclconfig=$ccpath
+ fi
+ fi
+
+fi
+
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ TCLCONFIG=""
+ echo "configure: warning: Can't find Tcl configuration definitions" 1>&2
+ else
+ no_tcl=""
+ TCLCONFIG=${ac_cv_c_tclconfig}/tclConfig.sh
+ echo "$ac_t""${TCLCONFIG}" 1>&6
+ fi
+fi
+
+
+
+ . $TCLCONFIG
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+dirlist=".. ../../ ../../../ ../../../../ ../../../../../ ../../../../../../ ../../../../../../.. ../../../../../../../.. ../../../../../../../../.. ../../../../../../../../../.."
+if test x"${no_tk}" = x ; then
+ no_tk=true
+ # Check whether --with-tkconfig or --without-tkconfig was given.
+if test "${with_tkconfig+set}" = set; then
+ withval="$with_tkconfig"
+ with_tkconfig=${withval}
+fi
+
+ echo $ac_n "checking for Tk configuration script""... $ac_c" 1>&6
+echo "configure:752: checking for Tk configuration script" >&5
+ if eval "test \"`echo '$''{'ac_cv_c_tkconfig'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+
+ if test x"${with_tkconfig}" != x ; then
+ if test -f "${with_tkconfig}/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd ${with_tkconfig}; pwd)`
+ else
+ { echo "configure: error: ${with_tkconfig} directory doesn't contain tkConfig.sh" 1>&2; exit 1; }
+ fi
+ fi
+
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ for i in $dirlist; do
+ if test -f $srcdir/$i/unix/tkConfig.sh ; then
+ ac_cv_c_tkconfig=`(cd $srcdir/$i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ for i in $dirlist; do
+ if test -n "`ls -dr $i/tk* 2>/dev/null`" ; then
+ tkconfpath=$i
+ break
+ fi
+ done
+
+ for i in `ls -dr $tkconfpath/tk* 2>/dev/null ` ; do
+ if test -f $i/unix/tkConfig.sh ; then
+ ac_cv_c_tkconfig=`(cd $i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ ccpath=`which ${CC} | sed -e 's:/bin/.*::'`/lib
+ if test -f $ccpath/tkConfig.sh; then
+ ac_cv_c_tkconfig=$ccpath
+ fi
+ fi
+
+fi
+
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ TKCONFIG=""
+ echo "configure: warning: Can't find Tk configuration definitions" 1>&2
+ else
+ no_tk=""
+ TKCONFIG=${ac_cv_c_tkconfig}/tkConfig.sh
+ echo "$ac_t""${TKCONFIG}" 1>&6
+ fi
+fi
+
+
+
+ if test -f "$TKCONFIG" ; then
+ . $TKCONFIG
+ fi
+
+
+
+
+
+
+
+
+
+
+
+
+
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:828: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # This must be in double quotes, not single quotes, because CPP may get
+ # substituted into the Makefile and "${CC-cc}" will confuse make.
+ CPP="${CC-cc} -E"
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp.
+ cat > conftest.$ac_ext <<EOF
+#line 843 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:849: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -E -traditional-cpp"
+ cat > conftest.$ac_ext <<EOF
+#line 860 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:866: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -nologo -E"
+ cat > conftest.$ac_ext <<EOF
+#line 877 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:883: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+ ac_cv_prog_CPP="$CPP"
+fi
+ CPP="$ac_cv_prog_CPP"
+else
+ ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+
+dirlist=".. ../../ ../../../ ../../../../ ../../../../../ ../../../../../../ ../../../../../../.. ../../../../../../../.. ../../../../../../../../.. ../../../../../../../../../.."
+no_tcl=true
+echo $ac_n "checking for Tcl headers in the source tree""... $ac_c" 1>&6
+echo "configure:911: checking for Tcl headers in the source tree" >&5
+# Check whether --with-tclinclude or --without-tclinclude was given.
+if test "${with_tclinclude+set}" = set; then
+ withval="$with_tclinclude"
+ with_tclinclude=${withval}
+fi
+
+if eval "test \"`echo '$''{'ac_cv_c_tclh'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+if test x"${with_tclinclude}" != x ; then
+ if test -f ${with_tclinclude}/tcl.h ; then
+ ac_cv_c_tclh=`(cd ${with_tclinclude}; pwd)`
+ elif test -f ${with_tclinclude}/generic/tcl.h ; then
+ ac_cv_c_tclh=`(cd ${with_tclinclude}/generic; pwd)`
+ else
+ { echo "configure: error: ${with_tclinclude} directory doesn't contain headers" 1>&2; exit 1; }
+ fi
+fi
+
+if test x"${ac_cv_c_tclconfig}" != x ; then
+ for i in $dirlist; do
+ if test -f $ac_cv_c_tclconfig/$i/generic/tcl.h ; then
+ ac_cv_c_tclh=`(cd $ac_cv_c_tclconfig/$i/generic; pwd)`
+ break
+ fi
+ done
+fi
+
+if test x"${ac_cv_c_tclh}" = x ; then
+ for i in $dirlist; do
+ if test -n "`ls -dr $srcdir/$i/tcl* 2>/dev/null`" ; then
+ tclpath=$srcdir/$i
+ break
+ fi
+ done
+
+ for i in `ls -dr $tclpath/tcl* 2>/dev/null ` ; do
+ if test -f $i/generic/tcl.h ; then
+ ac_cv_c_tclh=`(cd $i/generic; pwd)`
+ break
+ fi
+ done
+fi
+
+if test x"${ac_cv_c_tclh}" = x ; then
+ ccpath=`which ${CC} | sed -e 's:/bin/.*::'`/include
+ if test -f $ccpath/tcl.h; then
+ ac_cv_c_tclh=$ccpath
+ fi
+fi
+
+if test x"${ac_cv_c_tclh}" = x ; then
+ echo "$ac_t""none" 1>&6
+ ac_safe=`echo "tcl.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for tcl.h""... $ac_c" 1>&6
+echo "configure:968: checking for tcl.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 973 "configure"
+#include "confdefs.h"
+#include <tcl.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:978: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_cv_c_tclh=installed
+else
+ echo "$ac_t""no" 1>&6
+ac_cv_c_tclh=""
+fi
+
+else
+ echo "$ac_t""${ac_cv_c_tclh}" 1>&6
+fi
+
+fi
+
+ TCLHDIR=""
+if test x"${ac_cv_c_tclh}" = x ; then
+ { echo "configure: error: Can't find any Tcl headers" 1>&2; exit 1; }
+fi
+if test x"${ac_cv_c_tclh}" != x ; then
+ no_tcl=""
+ if test x"${ac_cv_c_tclh}" != x"installed" ; then
+ if test x"${CC}" = xcl ; then
+ tmp="`cygpath --windows ${ac_cv_c_tclh}`"
+ ac_cv_c_tclh="`echo $tmp | sed -e s#\\\\\\\\#/#g`"
+ fi
+ echo "$ac_t""${ac_cv_c_tclh}" 1>&6
+ TCLHDIR="-I${ac_cv_c_tclh}"
+ fi
+fi
+
+
+
+# FIXME: consider only doing this if --with-x given.
+
+#
+# Ok, lets find the tk source trees so we can use the headers
+# If the directory (presumably symlink) named "tk" exists, use that one
+# in preference to any others. Same logic is used when choosing library
+# and again with Tcl. The search order is the best place to look first, then in
+# decreasing significance. The loop breaks if the trigger file is found.
+# Note the gross little conversion here of srcdir by cd'ing to the found
+# directory. This converts the path from a relative to an absolute, so
+# recursive cache variables for the path will work right. We check all
+# the possible paths in one loop rather than many seperate loops to speed
+# things up.
+# the alternative search directory is involked by --with-tkinclude
+#
+dirlist=".. ../../ ../../../ ../../../../ ../../../../../ ../../../../../../ ../../../../../../.. ../../../../../../../.. ../../../../../../../../.. ../../../../../../../../../.."
+no_tk=true
+echo $ac_n "checking for Tk headers in the source tree""... $ac_c" 1>&6
+echo "configure:1042: checking for Tk headers in the source tree" >&5
+# Check whether --with-tkinclude or --without-tkinclude was given.
+if test "${with_tkinclude+set}" = set; then
+ withval="$with_tkinclude"
+ with_tkinclude=${withval}
+fi
+
+if eval "test \"`echo '$''{'ac_cv_c_tkh'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+if test x"${with_tkinclude}" != x ; then
+ if test -f ${with_tkinclude}/tk.h ; then
+ ac_cv_c_tkh=`(cd ${with_tkinclude}; pwd)`
+ elif test -f ${with_tkinclude}/generic/tk.h ; then
+ ac_cv_c_tkh=`(cd ${with_tkinclude}/generic; pwd)`
+ else
+ { echo "configure: error: ${with_tkinclude} directory doesn't contain headers" 1>&2; exit 1; }
+ fi
+fi
+
+if test x"${ac_cv_c_tkconfig}" != x ; then
+ for i in $dirlist; do
+ if test -f $ac_cv_c_tkconfig/$i/generic/tk.h ; then
+ ac_cv_c_tkh=`(cd $ac_cv_c_tkconfig/$i/generic; pwd)`
+ break
+ fi
+ done
+fi
+
+if test x"${ac_cv_c_tkh}" = x ; then
+ for i in $dirlist; do
+ if test -n "`ls -dr $srcdir/$i/tk* 2>/dev/null`" ; then
+ tkpath=$srcdir/$i
+ break
+ fi
+ done
+
+ for i in `ls -dr $tkpath/tk* 2>/dev/null ` ; do
+ if test -f $i/generic/tk.h ; then
+ ac_cv_c_tkh=`(cd $i/generic; pwd)`
+ break
+ fi
+ done
+fi
+
+if test x"${ac_cv_c_tkh}" = x ; then
+ echo "$ac_t""none" 1>&6
+ ccpath=`which ${CC} | sed -e 's:/bin/.*::'`/include
+ if test -f $ccpath/tk.h; then
+ ac_cv_c_tkh=$ccpath
+ fi
+else
+ echo "$ac_t""${ac_cv_c_tkh}" 1>&6
+fi
+
+fi
+
+ TKHDIR=""
+if test x"${ac_cv_c_tkh}" = x ; then
+ { echo "configure: error: Can't find any Tk headers" 1>&2; exit 1; }
+fi
+if test x"${ac_cv_c_tkh}" != x ; then
+ no_tk=""
+ if test x"${ac_cv_c_tkh}" != x"installed" ; then
+ if test x"${CC}" = xcl ; then
+ tmp="`cygpath --windows ${ac_cv_c_tkh}`"
+ ac_cv_c_tkh="`echo $tmp | sed -e s#\\\\\\\\#/#g`"
+ fi
+ echo "$ac_t""found in ${ac_cv_c_tkh}" 1>&6
+ TKHDIR="-I${ac_cv_c_tkh}"
+ fi
+fi
+
+
+
+
+SUBDIR=tk${TK_VERSION}
+
+subdirs="${SUBDIR}"
+
+
+TIX_VERSION=4.1
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set) 2>&1 | grep ac_space` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.12.2"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "Makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@SET_MAKE@%$SET_MAKE%g
+s%@SRC_DIR@%$SRC_DIR%g
+s%@TCLCONFIG@%$TCLCONFIG%g
+s%@TCL_DEFS@%$TCL_DEFS%g
+s%@TCL_LIBS@%$TCL_LIBS%g
+s%@TCL_SHLIB_CFLAGS@%$TCL_SHLIB_CFLAGS%g
+s%@TCL_SHLIB_LD@%$TCL_SHLIB_LD%g
+s%@TCL_LD_FLAGS@%$TCL_LD_FLAGS%g
+s%@TCL_LD_SEARCH_FLAGS@%$TCL_LD_SEARCH_FLAGS%g
+s%@TCL_RANLIB@%$TCL_RANLIB%g
+s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
+s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
+s%@TKCONFIG@%$TKCONFIG%g
+s%@TK_VERSION@%$TK_VERSION%g
+s%@TK_DEFS@%$TK_DEFS%g
+s%@TK_LIBS@%$TK_LIBS%g
+s%@TK_BUILD_INCLUDES@%$TK_BUILD_INCLUDES%g
+s%@TK_XINCLUDES@%$TK_XINCLUDES%g
+s%@TK_XLIBSW@%$TK_XLIBSW%g
+s%@TK_BUILD_LIB_SPEC@%$TK_BUILD_LIB_SPEC%g
+s%@TK_LIB_SPEC@%$TK_LIB_SPEC%g
+s%@CPP@%$CPP%g
+s%@TCLHDIR@%$TCLHDIR%g
+s%@TKHDIR@%$TKHDIR%g
+s%@SUBDIR@%$SUBDIR%g
+s%@subdirs@%$subdirs%g
+s%@TIX_VERSION@%$TIX_VERSION%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+ case "$ac_given_INSTALL" in
+ [/$]*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ esac
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
+if test "$no_recursion" != yes; then
+
+ # Remove --cache-file and --srcdir arguments so they do not pile up.
+ ac_sub_configure_args=
+ ac_prev=
+ for ac_arg in $ac_configure_args; do
+ if test -n "$ac_prev"; then
+ ac_prev=
+ continue
+ fi
+ case "$ac_arg" in
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ ;;
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ ;;
+ *) ac_sub_configure_args="$ac_sub_configure_args $ac_arg" ;;
+ esac
+ done
+
+ for ac_config_dir in ${SUBDIR}; do
+
+ # Do not complain, so a configure script can configure whichever
+ # parts of a large source tree are present.
+ if test ! -d $srcdir/$ac_config_dir; then
+ continue
+ fi
+
+ echo configuring in $ac_config_dir
+
+ case "$srcdir" in
+ .) ;;
+ *)
+ if test -d ./$ac_config_dir || mkdir ./$ac_config_dir; then :;
+ else
+ { echo "configure: error: can not create `pwd`/$ac_config_dir" 1>&2; exit 1; }
+ fi
+ ;;
+ esac
+
+ ac_popdir=`pwd`
+ cd $ac_config_dir
+
+ # A "../" for each directory in /$ac_config_dir.
+ ac_dots=`echo $ac_config_dir|sed -e 's%^\./%%' -e 's%[^/]$%&/%' -e 's%[^/]*/%../%g'`
+
+ case "$srcdir" in
+ .) # No --srcdir option. We are building in place.
+ ac_sub_srcdir=$srcdir ;;
+ /*) # Absolute path.
+ ac_sub_srcdir=$srcdir/$ac_config_dir ;;
+ *) # Relative path.
+ ac_sub_srcdir=$ac_dots$srcdir/$ac_config_dir ;;
+ esac
+
+ # Check for guested configure; otherwise get Cygnus style configure.
+ if test -f $ac_sub_srcdir/configure; then
+ ac_sub_configure=$ac_sub_srcdir/configure
+ elif test -f $ac_sub_srcdir/configure.in; then
+ ac_sub_configure=$ac_configure
+ else
+ echo "configure: warning: no configuration information is in $ac_config_dir" 1>&2
+ ac_sub_configure=
+ fi
+
+ # The recursion is here.
+ if test -n "$ac_sub_configure"; then
+
+ # Make the cache file name correct relative to the subdirectory.
+ case "$cache_file" in
+ /*) ac_sub_cache_file=$cache_file ;;
+ *) # Relative path.
+ ac_sub_cache_file="$ac_dots$cache_file" ;;
+ esac
+ case "$ac_given_INSTALL" in
+ [/$]*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ esac
+
+ echo "running ${CONFIG_SHELL-/bin/sh} $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_sub_srcdir"
+ # The eval makes quoting arguments work.
+ if eval ${CONFIG_SHELL-/bin/sh} $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_sub_srcdir
+ then :
+ else
+ { echo "configure: error: $ac_sub_configure failed for $ac_config_dir" 1>&2; exit 1; }
+ fi
+ fi
+
+ cd $ac_popdir
+ done
+fi
+
diff --git a/tix/unix/configure.in b/tix/unix/configure.in
new file mode 100644
index 00000000000..a837f7574d6
--- /dev/null
+++ b/tix/unix/configure.in
@@ -0,0 +1,35 @@
+dnl This file is an input file used by the GNU "autoconf" program to
+dnl generate the file "configure", which is run to configure the
+dnl Makefile in this directory.
+
+AC_INIT(../generic/tixInit.c)
+
+AC_PROG_INSTALL
+AC_PROG_MAKE_SET
+
+#----------------------------------------------------------------------
+# We don't want to use any relative path because we need to generate
+# Makefile's in subdirectories
+#----------------------------------------------------------------------
+if test "$INSTALL" = "./install.sh"; then
+ INSTALL=`pwd`/install.sh
+fi
+SRC_DIR=`cd ${srcdir}/..; pwd`
+AC_SUBST(SRC_DIR)
+
+# Check for Tcl and Tk.
+CYG_AC_PATH_TCLCONFIG
+CYG_AC_LOAD_TCLCONFIG
+CYG_AC_PATH_TKCONFIG
+CYG_AC_LOAD_TKCONFIG
+CYG_AC_PATH_TCLH
+# FIXME: consider only doing this if --with-x given.
+CYG_AC_PATH_TKH
+
+SUBDIR=tk${TK_VERSION}
+AC_SUBST(SUBDIR)
+AC_CONFIG_SUBDIRS(${SUBDIR})
+
+TIX_VERSION=4.1
+AC_SUBST(TIX_VERSION)
+AC_OUTPUT(Makefile)
diff --git a/tix/unix/samAppInit.c b/tix/unix/samAppInit.c
new file mode 100644
index 00000000000..955f5e1db80
--- /dev/null
+++ b/tix/unix/samAppInit.c
@@ -0,0 +1,177 @@
+/*
+ * samAppInit.c --
+ *
+ * Provides a default version of the Tcl_AppInit procedure for
+ * use in stand-alone Tcl, Tk or Tix applications.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ * Copyright (c) 1995 Ioi K Lam
+ * 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.
+ */
+
+#include <tcl.h>
+
+#ifdef USE_TIX
+# ifndef USE_TK
+# define USE_TK
+# endif
+#endif
+
+#ifdef USE_TK
+#include <tk.h>
+#endif
+
+#ifdef USE_TIX
+# include <tix.h>
+#else
+# if (TCL_MAJOR_VERSION > 7)
+# define TCL_7_5_OR_LATER
+# else
+# if ((TCL_MAJOR_VERSION == 7) && (TCL_MINOR_VERSION >= 5))
+# define TCL_7_5_OR_LATER
+# endif
+# endif
+#endif
+
+EXTERN int Tclsam_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int Tksam_Init _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN int Tixsam_Init _ANSI_ARGS_((Tcl_Interp *interp));
+
+/*
+ * 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;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ * This is the main program for the application.
+ *
+ * Results:
+ * None: Tk_Main never returns here, so this procedure never
+ * returns either.
+ *
+ * Side effects:
+ * Whatever the application does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+main(argc, argv)
+ int argc; /* Number of command-line arguments. */
+ char **argv; /* Values of command-line arguments. */
+{
+#ifdef USE_TK
+ Tk_Main(argc, argv, Tcl_AppInit);
+#else
+ Tcl_Main(argc, argv, Tcl_AppInit);
+#endif
+
+ return 0; /* Needed only to prevent compiler warning. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppInit(interp)
+ Tcl_Interp *interp; /* Interpreter for application. */
+{
+ if (Tclsam_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+#ifdef USE_TK
+ if (Tksam_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+#endif
+
+#ifdef USE_TIX
+ if (Tixsam_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+#endif
+
+#ifdef TCL_7_5_OR_LATER
+ Tcl_StaticPackage(interp, "Tclsam", Tclsam_Init, NULL);
+#ifdef USE_TK
+ Tcl_StaticPackage(interp, "Tk", Tk_Init, NULL);
+ Tcl_StaticPackage(interp, "Tksam", Tksam_Init, NULL);
+#endif
+#ifdef USE_TIX
+ Tcl_StaticPackage(interp, "Tix", Tix_Init, NULL);
+ Tcl_StaticPackage(interp, "Tixsam", Tixsam_Init, NULL);
+#endif
+#endif
+
+ /*
+ * Call the init procedures for included packages. Each call should
+ * look like this:
+ *
+ * if (Mod_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * where "Mod" is the name of the module.
+ */
+
+ /*
+ * Call Tcl_CreateCommand for application-specific commands, if
+ * they weren't already created by the init procedures called above.
+ */
+
+ /*
+ * Specify a user-specific startup file to invoke if the application
+ * is run interactively. Typically the startup file is "~/.apprc"
+ * where "app" is the name of the application. If this line is deleted
+ * then no user-specific startup file will be run under any conditions.
+ */
+#if defined(USE_TIX)
+# define RC_FILENAME "~/.tixwishrc"
+#else
+# if defined(USE_TK)
+# define RC_FILENAME "~/.wishrc"
+# else
+# define RC_FILENAME "~/.tclshrc"
+# endif
+#endif
+
+#ifdef TCL_7_5_OR_LATER
+ /*
+ * Starting from TCL 7.5, the symbol tcl_rcFileName is no longer
+ * exported by libtcl.a. Instead, this variable must be set using
+ * a TCL global variable
+ */
+ Tcl_SetVar(interp, "tcl_rcFileName", RC_FILENAME, TCL_GLOBAL_ONLY);
+#else
+ tcl_RcFileName = RC_FILENAME;
+#endif
+
+ return TCL_OK;
+}
diff --git a/tix/unix/tixUnixDraw.c b/tix/unix/tixUnixDraw.c
new file mode 100644
index 00000000000..f0eab0fcbb1
--- /dev/null
+++ b/tix/unix/tixUnixDraw.c
@@ -0,0 +1,307 @@
+/*
+ * tixUnixDraw.c --
+ *
+ * Implement the Unix specific function calls for drawing.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixUnixInt.h>
+
+
+/*
+ *----------------------------------------------------------------------
+ * TixpDrawTmpLine --
+ *
+ * Draws a "temporary" line between the two points. The line can be
+ * removed by calling the function again with the same parameters.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * A line is XOR'ed onto the screen.
+ *----------------------------------------------------------------------
+ */
+void
+TixpDrawTmpLine(x1, y1, x2, y2, tkwin)
+ int x1;
+ int y1;
+ int x2;
+ int y2;
+ Tk_Window tkwin;
+{
+ GC gc;
+ XGCValues values;
+ unsigned long valuemask = GCForeground | GCSubwindowMode | GCFunction;
+ Window winId; /* The Window to draw into. */
+ Tk_Window toplevel; /* Toplevel containing the tkwin. */
+ int rootx1, rooty1; /* Root x and y of the toplevel window. */
+ int rootx2, rooty2;
+
+ for (toplevel=tkwin; !Tk_IsTopLevel(toplevel);
+ toplevel=Tk_Parent(toplevel)) {
+ ;
+ }
+
+ Tk_GetRootCoords(toplevel, &rootx1, &rooty1);
+ rootx2 = rootx1 + Tk_Width(toplevel) - 1;
+ rooty2 = rooty1 + Tk_Height(toplevel) - 1;
+
+ if (x1 >= rootx1 && x2 <= rootx2 && y1 >= rooty1 && y2 <= rooty2) {
+ /*
+ * The line is completely inside the toplevel containing
+ * tkwin. It's better to draw into this window because on some
+ * X servers, especially PC X Servers running on Windows,
+ * drawing into the root window shows no effect.
+ */
+ winId = Tk_WindowId(toplevel);
+ x1 -= rootx1;
+ y1 -= rooty1;
+ x2 -= rootx1;
+ y2 -= rooty1;
+ } else {
+ winId = XRootWindow(Tk_Display(tkwin), Tk_ScreenNumber(tkwin));
+ }
+
+ values.foreground = 0xff;
+ values.subwindow_mode = IncludeInferiors;
+ values.function = GXxor;
+
+ gc = XCreateGC(Tk_Display(tkwin), winId, valuemask, &values);
+ XDrawLine(Tk_Display(tkwin), winId, gc, x1, y1, x2, y2);
+ XFreeGC(Tk_Display(tkwin), gc);
+}
+
+/*----------------------------------------------------------------------
+ * TixpDrawAnchorLines --
+ *
+ * See comments near Tix_DrawAnchorLines.
+ *----------------------------------------------------------------------
+ */
+
+void TixpDrawAnchorLines(display, drawable, gc, x, y, w, h)
+ Display *display;
+ Drawable drawable;
+ GC gc;
+ int x;
+ int y;
+ int w;
+ int h;
+{
+ XPoint points[4];
+
+ if (w < 1) {
+ w = 1;
+ }
+ if (h < 1) {
+ h = 1;
+ }
+
+ XDrawRectangle(display, drawable, gc, x, y, w-1, h-1);
+
+ /*
+ * Draw these points so that the corners will not be rounded
+ */
+ points[0].x = x;
+ points[0].y = y;
+ points[1].x = x + w - 1;
+ points[1].y = y;
+ points[2].x = x;
+ points[2].y = y + h - 1;
+ points[3].x = x + w - 1;
+ points[3].y = y + h - 1;
+
+ XDrawPoints(display, drawable, gc, points, 4, CoordModeOrigin);
+}
+
+/*----------------------------------------------------------------------
+ * TixpStartSubRegionDraw --
+ *
+ * Limits the subsequent drawing operations into the prescribed
+ * rectangle region. This takes effect up to a matching
+ * TixEndSubRegionDraw() call.
+ *
+ * Return value:
+ * none.
+ *----------------------------------------------------------------------
+ */
+
+void
+TixpStartSubRegionDraw(display, drawable, gc, subRegPtr, origX, origY,
+ x, y, width, height, needWidth, needHeight)
+ Display *display;
+ Drawable drawable;
+ GC gc;
+ TixpSubRegion * subRegPtr;
+ int origX;
+ int origY;
+ int x;
+ int y;
+ int width;
+ int height;
+ int needWidth;
+ int needHeight;
+{
+ if ((width < needWidth) || (height < needHeight)) {
+ subRegPtr->rectUsed = 1;
+ subRegPtr->rect.x = (short)x;
+ subRegPtr->rect.y = (short)y;
+ subRegPtr->rect.width = (short)width;
+ subRegPtr->rect.height = (short)height;
+
+ XSetClipRectangles(display, gc, origX, origY, &subRegPtr->rect,
+ 1, Unsorted);
+ } else {
+ subRegPtr->rectUsed = 0;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * TixpEndSubRegionDraw --
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TixpEndSubRegionDraw(display, drawable, gc, subRegPtr)
+ Display *display;
+ Drawable drawable;
+ GC gc;
+ TixpSubRegion * subRegPtr;
+{
+ if (subRegPtr->rectUsed) {
+ subRegPtr->rect.x = (short)0;
+ subRegPtr->rect.y = (short)0;
+ subRegPtr->rect.width = (short)20000;
+ subRegPtr->rect.height = (short)20000;
+ XSetClipRectangles(display, gc, 0, 0, &subRegPtr->rect, 1, Unsorted);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TixpSubRegDisplayText --
+ *
+ * Display a text string on one or more lines in a sub region.
+ *
+ * Results:
+ * See TkDisplayText
+ *
+ * Side effects:
+ * See TkDisplayText
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TixpSubRegDisplayText(display, drawable, gc, subRegPtr, font, string,
+ numChars, x, y, length, justify, underline)
+ Display *display; /* X display to use for drawing text. */
+ Drawable drawable; /* Window or pixmap in which to draw the
+ * text. */
+ GC gc; /* Graphics context to use for drawing text. */
+ TixpSubRegion * subRegPtr; /* Information about the subregion */
+ TixFont font; /* Font that determines geometry of text
+ * (should be same as font in gc). */
+ char *string; /* String to display; may contain embedded
+ * newlines. */
+ int numChars; /* Number of characters to use from string. */
+ int x, y; /* Pixel coordinates within drawable of
+ * upper left corner of display area. */
+ int length; /* Line length in pixels; used to compute
+ * word wrap points and also for
+ * justification. Must be > 0. */
+ Tk_Justify justify; /* How to justify lines. */
+ int underline; /* Index of character to underline, or < 0
+ * for no underlining. */
+{
+ TixDisplayText(display, drawable, font, string,
+ numChars, x, y, length, justify, underline, gc);
+}
+
+/*----------------------------------------------------------------------
+ * TixpSubRegFillRectangle --
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TixpSubRegFillRectangle(display, drawable, gc, subRegPtr, x, y, width, height)
+ Display *display; /* X display to use for drawing rectangle. */
+ Drawable drawable; /* Window or pixmap in which to draw the
+ * rectangle. */
+ GC gc; /* Graphics context to use for drawing. */
+ TixpSubRegion * subRegPtr; /* Information about the subregion */
+ int x, y; /* Pixel coordinates within drawable of
+ * upper left corner of display area. */
+ int width, height; /* Size of the rectangle. */
+{
+ XFillRectangle(display, drawable, gc, x, y, width, height);
+}
+
+/*----------------------------------------------------------------------
+ * TixpSubRegDrawImage --
+ *
+ * Draws a Tk image in a subregion.
+ *----------------------------------------------------------------------
+ */
+void
+TixpSubRegDrawImage(subRegPtr, image, imageX, imageY, width, height,
+ drawable, drawableX, drawableY)
+ TixpSubRegion * subRegPtr;
+ Tk_Image image;
+ int imageX;
+ int imageY;
+ int width;
+ int height;
+ Drawable drawable;
+ int drawableX;
+ int drawableY;
+{
+ if (subRegPtr->rectUsed) {
+ if (drawableX < subRegPtr->rect.x) {
+ width -= subRegPtr->rect.x - drawableX;
+ imageX += subRegPtr->rect.x - drawableX;
+ drawableX = subRegPtr->rect.x;
+ }
+ if (drawableX + width > subRegPtr->rect.x + subRegPtr->rect.width) {
+ width = subRegPtr->rect.x - drawableX + subRegPtr->rect.width;
+ }
+
+ if (drawableY < subRegPtr->rect.y) {
+ height -= subRegPtr->rect.y - drawableY;
+ imageY += subRegPtr->rect.y - drawableY;
+ drawableY = subRegPtr->rect.y;
+ }
+ if (drawableY + height > subRegPtr->rect.y + subRegPtr->rect.height) {
+ height = subRegPtr->rect.y - drawableY + subRegPtr->rect.height;
+ }
+ }
+
+ Tk_RedrawImage(image, imageX, imageY, width, height, drawable,
+ drawableX, drawableY);
+}
+
+void
+TixpSubRegDrawBitmap(display, drawable, gc, subRegPtr, bitmap, src_x, src_y,
+ width, height, dest_x, dest_y, plane)
+ Display *display;
+ Drawable drawable;
+ GC gc;
+ TixpSubRegion * subRegPtr;
+ Pixmap bitmap;
+ int src_x, src_y;
+ int width, height;
+ int dest_x, dest_y;
+ unsigned long plane;
+{
+ XCopyPlane(display, bitmap, drawable, gc, src_x, src_y, width, height,
+ dest_x, dest_y, plane);
+}
diff --git a/tix/unix/tixUnixInt.h b/tix/unix/tixUnixInt.h
new file mode 100644
index 00000000000..5e9b2c5b762
--- /dev/null
+++ b/tix/unix/tixUnixInt.h
@@ -0,0 +1,20 @@
+/*
+ * tixUnixInt.h
+ *
+ * Internal header file for Tix on the Unix platform.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#ifndef _TIX_UNIX_INT_H_
+#define _TIX_UNIX_INT_H_
+
+#ifndef _TIX_INT_H_
+#include "tixInt.h"
+#endif
+
+#endif /* _TIX_UNIX_INT_H_ */
diff --git a/tix/unix/tixUnixPort.h b/tix/unix/tixUnixPort.h
new file mode 100644
index 00000000000..56356915430
--- /dev/null
+++ b/tix/unix/tixUnixPort.h
@@ -0,0 +1,29 @@
+/*
+ * tixUnixPort.h --
+ *
+ * This header file handles porting issues that occur because of
+ * differences between systems. It reads in platform specific
+ * portability files.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#ifndef _TIX_UNIXPORT_H_
+#define _TIX_UNIXPORT_H_
+
+struct _TixpSubRegion {
+ XRectangle rect;
+ int rectUsed;
+};
+
+#ifdef UCHAR_SUPPORTED
+typedef unsigned char UNSIGNED_CHAR;
+#else
+typedef char UNSIGNED_CHAR;
+#endif
+
+#endif /* _TIX_UNIXPORT_H_ */
diff --git a/tix/unix/tixUnixSam.c b/tix/unix/tixUnixSam.c
new file mode 100644
index 00000000000..996d6ef55cf
--- /dev/null
+++ b/tix/unix/tixUnixSam.c
@@ -0,0 +1,39 @@
+/*
+ * eixInit41.c --
+ *
+ * Initializes embedded Tix for Tix version 4.1.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixInt.h>
+
+#include "tixSamLib.c"
+
+int SamTix_Init _ANSI_ARGS_((Tcl_Interp *interp));
+
+int
+Tixsam_Init(interp)
+ Tcl_Interp *interp; /* Interpreter to initialize. */
+{
+ Tcl_Interp * Et_Interp = interp;
+
+ if (TixInitSam(interp) != TCL_OK ){
+ return TCL_ERROR;
+ }
+ if (LoadScripts(interp) != TCL_OK ){
+ return TCL_ERROR;
+ }
+ if (Tcl_GlobalEval(interp, "__tixInit") != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+int
+Tixsam_SafeInit(interp)
+ Tcl_Interp *interp; /* Interpreter to initialize. */
+{
+ return Tixsam_Init(interp);
+}
diff --git a/tix/unix/tixUnixWm.c b/tix/unix/tixUnixWm.c
new file mode 100644
index 00000000000..c3a1a921e48
--- /dev/null
+++ b/tix/unix/tixUnixWm.c
@@ -0,0 +1,23 @@
+/*
+ * tixUnixWm.c --
+ *
+ * Implement the Windows specific function calls for window management.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include "tixUnixInt.h"
+
+int
+TixpSetWindowParent(interp, tkwin, newParent, parentId)
+ Tcl_Interp * interp;
+ Tk_Window tkwin;
+ Tk_Window newParent;
+ int parentId;
+{
+ return TCL_OK;
+}
diff --git a/tix/unix/tixUnixXpm.c b/tix/unix/tixUnixXpm.c
new file mode 100644
index 00000000000..8140b9067bf
--- /dev/null
+++ b/tix/unix/tixUnixXpm.c
@@ -0,0 +1,270 @@
+/*
+ * tixUnixImgXpm.c --
+ *
+ * Implement the Windows specific function calls for the pixmap
+ * image type.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tixPort.h>
+#include <tixUnixInt.h>
+#include <tixImgXpm.h>
+
+typedef struct PixmapData {
+ Pixmap mask; /* Mask: only display pixmap pixels where
+ * there are 1's here. */
+ GC gc; /* Graphics context for displaying pixmap.
+ * None means there was an error while
+ * setting up the instance, so it cannot
+ * be displayed. */
+} PixmapData;
+
+
+/*----------------------------------------------------------------------
+ * TixpInitPixmapInstance --
+ *
+ * Initializes the platform-specific data of a pixmap instance
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TixpInitPixmapInstance(masterPtr, instancePtr)
+ PixmapMaster *masterPtr; /* Pointer to master for image. */
+ PixmapInstance *instancePtr;/* The pixmap instance. */
+{
+ PixmapData * dataPtr;
+
+ dataPtr = (PixmapData *)ckalloc(sizeof(PixmapData));
+ dataPtr->mask = None;
+ dataPtr->gc = None;
+
+ instancePtr->clientData = (ClientData)dataPtr;
+}
+
+/*----------------------------------------------------------------------
+ * TixpXpmAllocTmpBuffer --
+ *
+ * Allocate a temporary space to draw the image.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TixpXpmAllocTmpBuffer(masterPtr, instancePtr, imagePtr, maskPtr)
+ PixmapMaster * masterPtr;
+ PixmapInstance * instancePtr;
+ XImage ** imagePtr;
+ XImage ** maskPtr;
+{
+ int pad;
+ XImage * image = NULL, * mask = NULL;
+ Display *display = Tk_Display(instancePtr->tkwin);
+ int depth;
+
+ depth = Tk_Depth(instancePtr->tkwin);
+
+ if (depth > 16) {
+ pad = 32;
+ } else if (depth > 8) {
+ pad = 16;
+ } else {
+ pad = 8;
+ }
+
+ /*
+ * Create the XImage structures to store the temporary image
+ */
+ image = XCreateImage(display,
+ Tk_Visual(instancePtr->tkwin),
+ depth, ZPixmap, 0, 0,
+ masterPtr->size[0], masterPtr->size[1], pad, 0);
+ image->data =
+ (char *)ckalloc(image->bytes_per_line * masterPtr->size[1]);
+
+ mask = XCreateImage(display,
+ Tk_Visual(instancePtr->tkwin),
+ 1, XYPixmap, 0, 0,
+ masterPtr->size[0], masterPtr->size[1], pad, 0);
+
+ mask->data =
+ (char *)ckalloc(mask->bytes_per_line * masterPtr->size[1]);
+
+ *imagePtr = image;
+ *maskPtr = mask;
+}
+
+void
+TixpXpmFreeTmpBuffer(masterPtr, instancePtr, image, mask)
+ PixmapMaster * masterPtr;
+ PixmapInstance * instancePtr;
+ XImage * image;
+ XImage * mask;
+{
+ if (image) {
+ ckfree((char*)image->data);
+ image->data = NULL;
+ XDestroyImage(image);
+ }
+ if (mask) {
+ ckfree((char*)mask->data);
+ mask->data = NULL;
+ XDestroyImage(mask);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * TixpXpmSetPixel --
+ *
+ * Sets the pixel at the given (x,y) coordinate to be the given
+ * color.
+ *----------------------------------------------------------------------
+ */
+void
+TixpXpmSetPixel(instancePtr, image, mask, x, y, colorPtr, isTranspPtr)
+ PixmapInstance * instancePtr;
+ XImage * image;
+ XImage * mask;
+ int x;
+ int y;
+ XColor * colorPtr;
+ int * isTranspPtr;
+{
+ if (colorPtr != NULL) {
+ XPutPixel(image, x, y, colorPtr->pixel);
+ XPutPixel(mask, x, y, 1);
+ } else {
+ XPutPixel(mask, x, y, 0);
+ *isTranspPtr = 1;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * TixpXpmRealizePixmap --
+ *
+ * On Unix: Create the pixmap from the buffer.
+ * On Windows: Free the mask if there are no transparent pixels.
+ *----------------------------------------------------------------------
+ */
+
+void
+TixpXpmRealizePixmap(masterPtr, instancePtr, image, mask, isTransp)
+ PixmapMaster * masterPtr;
+ PixmapInstance * instancePtr;
+ XImage * image;
+ XImage * mask;
+ int isTransp;
+{
+ Display *display = Tk_Display(instancePtr->tkwin);
+ int depth = Tk_Depth(instancePtr->tkwin);
+ PixmapData *dataPtr = (PixmapData*)instancePtr->clientData;
+ unsigned int gcMask;
+ XGCValues gcValues;
+ GC gc;
+
+ instancePtr->pixmap = Tk_GetPixmap(display,
+ Tk_WindowId(instancePtr->tkwin),
+ masterPtr->size[0], masterPtr->size[1], depth);
+
+ gc = Tk_GetGC(instancePtr->tkwin, 0, NULL);
+
+ XPutImage(display, instancePtr->pixmap,
+ gc, image, 0, 0, 0, 0, masterPtr->size[0], masterPtr->size[1]);
+
+ Tk_FreeGC(display, gc);
+
+ if (isTransp) {
+ /*
+ * There are transparent pixels. We need a mask.
+ */
+ dataPtr->mask = Tk_GetPixmap(display,
+ Tk_WindowId(instancePtr->tkwin),
+ masterPtr->size[0], masterPtr->size[1], 1);
+ gc = XCreateGC(display, dataPtr->mask, 0, NULL);
+ XPutImage(display, dataPtr->mask,
+ gc, mask, 0, 0, 0, 0, masterPtr->size[0], masterPtr->size[1]);
+ XFreeGC(display, gc);
+ } else {
+ dataPtr->mask = None;
+ }
+
+ /*
+ * Allocate a GC for drawing this instance (mask is not used if there
+ * is no transparent pixels inside the image).
+ */
+ if (dataPtr->mask != None) {
+ gcMask = GCGraphicsExposures|GCClipMask;
+ } else {
+ gcMask = GCGraphicsExposures;
+ }
+ gcValues.graphics_exposures = False;
+ gcValues.clip_mask = dataPtr->mask;
+
+ gc = Tk_GetGC(instancePtr->tkwin, gcMask, &gcValues);
+ dataPtr->gc = gc;
+}
+
+void
+TixpXpmFreeInstanceData(instancePtr, delete, display)
+ PixmapInstance *instancePtr;/* Pixmap instance. */
+ int delete; /* Should the instance data structure
+ * be deleted as well? */
+ Display *display; /* Display containing window that used image.*/
+{
+ PixmapData *dataPtr = (PixmapData*)instancePtr->clientData;
+
+ if (dataPtr->mask != None) {
+ Tk_FreePixmap(display, dataPtr->mask);
+ dataPtr->mask = None;
+ }
+ if (dataPtr->gc != None) {
+ Tk_FreeGC(display, dataPtr->gc);
+ dataPtr->gc = None;
+ }
+ if (delete) {
+ ckfree((char*)dataPtr);
+ instancePtr->clientData = NULL;
+ }
+}
+
+void
+TixpXpmDisplay(clientData, display, drawable, imageX, imageY, width,
+ height, drawableX, drawableY)
+ ClientData clientData; /* Pointer to PixmapInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display on which to draw image. */
+ Drawable drawable; /* Pixmap or window in which to draw image. */
+ int imageX, imageY; /* Upper-left corner of region within image
+ * to draw. */
+ int width, height; /* Dimensions of region within image to draw.*/
+ int drawableX, drawableY; /* Coordinates within drawable that
+ * correspond to imageX and imageY. */
+{
+ PixmapInstance *instancePtr = (PixmapInstance *) clientData;
+ PixmapData *dataPtr = (PixmapData*)instancePtr->clientData;
+
+ /*
+ * If there's no graphics context, it means that an error occurred
+ * while creating the image instance so it can't be displayed.
+ */
+ if (dataPtr->gc == None) {
+ return;
+ }
+
+ /*
+ * We always use clipping: modify the clip origin within
+ * the graphics context to line up with the image's origin.
+ * Then draw the image and reset the clip origin.
+ */
+ XSetClipOrigin(display, dataPtr->gc, drawableX - imageX,
+ drawableY - imageY);
+ XCopyArea(display, instancePtr->pixmap, drawable, dataPtr->gc,
+ imageX, imageY, (unsigned) width, (unsigned) height,
+ drawableX, drawableY);
+ XSetClipOrigin(display, dataPtr->gc, 0, 0);
+}
diff --git a/tix/unix/tk4.2/Makefile.in b/tix/unix/tk4.2/Makefile.in
new file mode 100644
index 00000000000..e7d552befbf
--- /dev/null
+++ b/tix/unix/tk4.2/Makefile.in
@@ -0,0 +1,541 @@
+# Makefile --
+#
+# This file is a Makefile to compile Tix with Tk version
+# 4.2. 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.
+
+# CYGNUS LOCAL: Set VPATH.
+VPATH = @srcdir@
+srcdir = @srcdir@
+
+#----------------------------------------------------------------
+# Things you can change to personalize the Makefile for your own
+# site (you can make these changes in either Makefile.in or
+# Makefile, but changes to Makefile will get lost if you re-run
+# the configuration script).
+#----------------------------------------------------------------
+
+# Default top-level directories in which to install architecture-
+# specific files (exec_prefix) and machine-independent files such
+# as scripts (prefix). The values specified here may be overridden
+# at configure-time with the --exec-prefix and --prefix options
+# to the "configure" script.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+TIX_VERSION = @TIX_VERSION@
+
+@SET_MAKE@
+
+# Directory in which to install the library of Tix scripts and demos
+# (note: you can set the TIX_LIBRARY environment variable at run-time to
+# override the compiled-in location):
+TIX_LIBRARY = $(prefix)/lib/tix$(TIX_VERSION)
+
+# Directory in which to install the archive libtix.a:
+LIB_DIR = $(exec_prefix)/lib
+LIB_INSTALL_DIR = $(LIB_DIR)
+LIB_RUNTIME_DIR = $(LIB_DIR)
+
+# Directory in which to install the program tixwish:
+BIN_DIR = $(exec_prefix)/bin
+
+# To change the compiler switches, for example to change from -O
+# to -g, change the following line:
+CFLAGS = -O
+
+# To disable ANSI-C procedure prototypes reverse the comment characters
+# on the following lines:
+PROTO_FLAGS =
+#PROTO_FLAGS = -DNO_PROTOTYPE
+
+# To enable memory debugging reverse the comment characters on the following
+# lines. Warning: if you enable memory debugging, you must do it
+# *everywhere*, including all the code that calls Tcl, and you must use
+# ckalloc and ckfree everywhere instead of malloc and free.
+MEM_DEBUG_FLAGS =
+#MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG
+
+# Some versions of make, like SGI's, use the following variable to
+# determine which shell to use for executing commands:
+SHELL = /bin/sh
+
+# Location of the Tcl 7.6 source directory.
+#
+TCL_SRC_DIR = @TCL_SRC_DIR@
+TCL_GENERIC_DIR = $(TCL_SRC_DIR)/generic
+TCL_BIN_DIR = @TCL_BIN_DIR@
+
+# Location of the Tk 4.2 source directory.
+#
+TK_SRC_DIR = @TK_SRC_DIR@
+TK_GENERIC_DIR = $(TK_SRC_DIR)/generic
+
+# Libraries to use when linking:
+LIBS = @ITK_BUILD_LIB_SPEC@ @ITCL_BUILD_LIB_SPEC@ \
+ @TK_BUILD_LIB_SPEC@ @TCL_BUILD_LIB_SPEC@ @TK_LIBS@
+
+# Libraries for building a stand-alone Tclsh.
+#
+LIBS_TCLONLY = @TCL_BUILD_LIB_SPEC@ @TCL_LIBS@
+
+RUN_TCLSH = TCL_LIBRARY=$(TCL_SRC_DIR)/library \
+ TK_LIBRARY=$(TK_SRC_DIR)/library \
+ $(TCL_BIN_DIR)/unix/tclsh
+
+
+#----------------------------------------------------------------
+# 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.
+#----------------------------------------------------------------
+
+CC = @CC@
+
+SHLIB_CFLAGS = @SHLIB_CFLAGS@
+SHLIB_LD = @SHLIB_LD@
+SHLIB_SUFFIX = @SHLIB_SUFFIX@
+SHLIB_VERSION = @SHLIB_VERSION@
+TIX_SHLIB_CFLAGS = @TIX_SHLIB_CFLAGS@
+TK_XINCLUDES = @TK_XINCLUDES@
+
+ITCL_EXT =
+
+SRC_DIR = @TIX_SRC_DIR@
+GENERIC_DIR = $(SRC_DIR)/generic
+UNIX_DIR = $(SRC_DIR)/unix
+AC_FLAGS = @DEFS@ @TIX_DEFS@
+RANLIB = @RANLIB@
+INSTALL = @TIX_SRC_DIR@/install.sh -c
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+TIX_LIB_FILE = @TIX_LIB_FILE@
+TIX_EXE_FILE = @TIX_EXE_FILE@
+TCL_SAM_FILE = @TCL_SAM_FILE@
+TK_SAM_FILE = @TK_SAM_FILE@
+TIX_SAM_FILE = @TIX_SAM_FILE@
+TCL_SAMEXE_FILE = @TCL_SAMEXE_FILE@
+TK_SAMEXE_FILE = @TK_SAMEXE_FILE@
+TIX_SAMEXE_FILE = @TIX_SAMEXE_FILE@
+
+INST_EXE = $(TIX_EXE_FILE)$(TIX_VERSION).7.6$(ITCL_EXT)
+INST_TIX_SAMEXE = $(TIX_SAMEXE_FILE)$(TIX_VERSION).7.6$(ITCL_EXT)
+INST_TK_SAMEXE = $(TK_SAMEXE_FILE)4.2
+INST_TCL_SAMEXE = $(TCL_SAMEXE_FILE)7.6
+
+SAM_TARGETS = $(TCL_SAM_FILE) $(TK_SAM_FILE) $(TIX_SAM_FILE) \
+ $(TCL_SAMEXE_FILE) $(TK_SAMEXE_FILE) $(TIX_SAMEXE_FILE)
+
+TIX_SAM_TARGETS = @TIX_SAM_TARGETS@
+SAM_INSTALL = @TIX_SAM_INSTALL@
+
+ITCL_CFLAGS =
+
+CC_SWITCHES = $(CFLAGS) $(AC_FLAGS) -I$(TCL_GENERIC_DIR) \
+ -I$(TCL_SRC_DIR)/unix -I$(TK_GENERIC_DIR) -I$(TK_SRC_DIR)/unix \
+ $(ITCL_CFLAGS) \
+ -I$(GENERIC_DIR) -I$(UNIX_DIR) $(TK_XINCLUDES) $(TIX_SHLIB_CFLAGS)
+
+#----------------------------------------------------------------
+# The information below should be usable as is. You shouldn't need
+# to modify it.
+#----------------------------------------------------------------
+
+CORE_OBJS = \
+ tixClass.o \
+ tixCmds.o \
+ tixCompat.o \
+ tixError.o \
+ tixGeometry.o \
+ tixInit.o \
+ tixItcl.o \
+ tixList.o \
+ tixMethod.o \
+ tixOption.o \
+ tixScroll.o \
+ tixSmpLs.o \
+ tixUtils.o \
+ tixWidget.o
+
+DITEM_OBJS = \
+ tixDItem.o \
+ tixDiITxt.o \
+ tixDiImg.o \
+ tixDiStyle.o \
+ tixDiText.o \
+ tixDiWin.o
+
+MANAGER_OBJS = \
+ tixForm.o \
+ tixFormMisc.o
+
+WIDGET_OBJS = \
+ tixGrid.o \
+ tixGrData.o \
+ tixGrFmt.o \
+ tixGrRC.o \
+ tixGrSel.o \
+ tixGrSort.o \
+ tixGrUtl.o \
+ tixHList.o \
+ tixHLCol.o \
+ tixHLInd.o \
+ tixHLHdr.o \
+ tixInputO.o \
+ tixNBFrame.o \
+ tixTList.o
+
+MISC_OBJS = \
+ tixImgCmp.o \
+ tixImgXpm.o \
+ tixMwm.o
+
+UNIX_OBJS = \
+ tixUnixDraw.o \
+ tixUnixXpm.o \
+ tixUnixWm.o
+
+OBJS = $(CORE_OBJS) $(DITEM_OBJS) $(MANAGER_OBJS) $(MISC_OBJS) \
+ $(WIDGET_OBJS) $(UNIX_OBJS)
+
+TCL_SAM_OBJS = \
+ tclUnixSam76.o
+
+TK_SAM_OBJS = \
+ tkUnixSam42.o
+
+TIX_SAM_OBJS = \
+ $(OBJS) tixUnixSam.o
+
+#----------------------------------------------------------------------
+# These are the scripts that we'll compile into the SAM's. The
+# scripts of TK must be included in the fixed order.
+#----------------------------------------------------------------------
+
+TCL_SCRIPTS = $(TCL_SRC_DIR)/library/*.tcl
+
+TK_SCRIPTS = \
+ $(TK_SRC_DIR)/library/bgerror.tcl \
+ $(TK_SRC_DIR)/library/dialog.tcl \
+ $(TK_SRC_DIR)/library/focus.tcl \
+ $(TK_SRC_DIR)/library/obsolete.tcl \
+ $(TK_SRC_DIR)/library/optMenu.tcl \
+ $(TK_SRC_DIR)/library/palette.tcl \
+ $(TK_SRC_DIR)/library/tearoff.tcl \
+ $(TK_SRC_DIR)/library/clrpick.tcl \
+ $(TK_SRC_DIR)/library/comdlg.tcl \
+ $(TK_SRC_DIR)/library/msgbox.tcl \
+ $(TK_SRC_DIR)/library/tkfbox.tcl \
+ $(TK_SRC_DIR)/library/xmfbox.tcl \
+ $(SRC_DIR)/generic/tk4.2/tk.tcl \
+ $(TK_SRC_DIR)/library/button.tcl \
+ $(TK_SRC_DIR)/library/entry.tcl \
+ $(TK_SRC_DIR)/library/listbox.tcl \
+ $(TK_SRC_DIR)/library/menu.tcl \
+ $(TK_SRC_DIR)/library/scale.tcl \
+ $(TK_SRC_DIR)/library/scrlbar.tcl \
+ $(TK_SRC_DIR)/library/text.tcl \
+ $(SRC_DIR)/generic/tk4.2/console.tcl
+
+TIX_SCRIPTS = \
+ $(SRC_DIR)/library/pref/*.fsc \
+ $(SRC_DIR)/library/pref/*.csc \
+ $(SRC_DIR)/library/*.tcl
+
+all: $(TIX_LIB_FILE) $(TIX_EXE_FILE) @TIX_SAM_TARGETS@
+
+$(TIX_LIB_FILE): $(OBJS)
+ rm -f $(TIX_LIB_FILE)
+ @TIX_MAKE_LIB@
+ $(RANLIB) $(TIX_LIB_FILE)
+
+$(TCL_SAM_FILE): $(TCL_SAM_OBJS)
+ rm -f $(TCL_SAM_FILE)
+ @TCL_MAKE_SAM@
+ $(RANLIB) $(TCL_SAM_FILE)
+
+$(TK_SAM_FILE): $(TK_SAM_OBJS)
+ rm -f $(TK_SAM_FILE)
+ @TK_MAKE_SAM@
+ $(RANLIB) $(TK_SAM_FILE)
+
+$(TIX_SAM_FILE): $(TIX_SAM_OBJS)
+ rm -f $(TIX_SAM_FILE)
+ @TIX_MAKE_SAM@
+ $(RANLIB) $(TIX_SAM_FILE)
+
+$(TIX_EXE_FILE): tixAppInit.o $(TIX_LIB_FILE)
+ $(CC) @LD_FLAGS@ tixAppInit.o @TIX_BUILD_LIB_SPEC@ $(LIBS) \
+ @TIX_LD_SEARCH_FLAGS@ -o $(TIX_EXE_FILE)
+
+$(TCL_SAMEXE_FILE): $(UNIX_DIR)/samAppInit.c $(TCL_SAM_FILE)
+ $(CC) $(CC_SWITCHES) @LD_FLAGS@ -DUSE_TCL $(UNIX_DIR)/samAppInit.c \
+ @TCL_BUILD_SAM_SPEC@ $(LIBS_TCLONLY) \
+ @TIX_LD_SEARCH_FLAGS@ -o $(TCL_SAMEXE_FILE)
+
+$(TK_SAMEXE_FILE): $(UNIX_DIR)/samAppInit.c $(TCL_SAM_FILE) $(TK_SAM_FILE)
+ $(CC) $(CC_SWITCHES) @LD_FLAGS@ -DUSE_TK $(UNIX_DIR)/samAppInit.c \
+ @TK_BUILD_SAM_SPEC@ @TCL_BUILD_SAM_SPEC@ $(LIBS) \
+ @TIX_LD_SEARCH_FLAGS@ -o $(TK_SAMEXE_FILE)
+
+$(TIX_SAMEXE_FILE): $(UNIX_DIR)/samAppInit.c $(TCL_SAM_FILE) $(TK_SAM_FILE) \
+ $(TIX_SAM_FILE)
+ $(CC) $(CC_SWITCHES) @LD_FLAGS@ -DUSE_TIX $(UNIX_DIR)/samAppInit.c \
+ @TIX_BUILD_SAM_SPEC@ \
+ @TK_BUILD_SAM_SPEC@ @TCL_BUILD_SAM_SPEC@ \
+ $(LIBS) \
+ @TIX_LD_SEARCH_FLAGS@ -o $(TIX_SAMEXE_FILE)
+
+
+#----------------------------------------------------------------------
+#
+# .o file rules
+#
+#----------------------------------------------------------------------
+tixAppInit.o : tixAppInit.c
+ $(CC) -c $(CC_SWITCHES) $(srcdir)/tixAppInit.c
+
+tixClass.o : $(GENERIC_DIR)/tixClass.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixClass.c
+
+tixCmds.o: $(GENERIC_DIR)/tixCmds.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixCmds.c
+
+tixCompat.o: $(GENERIC_DIR)/tixCompat.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixCompat.c
+
+tixDItem.o: $(GENERIC_DIR)/tixDItem.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDItem.c
+
+tixDiImg.o: $(GENERIC_DIR)/tixDiImg.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiImg.c
+
+tixDiITxt.o: $(GENERIC_DIR)/tixDiITxt.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiITxt.c
+
+tixDiStyle.o: $(GENERIC_DIR)/tixDiStyle.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiStyle.c
+
+tixDiText.o: $(GENERIC_DIR)/tixDiText.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiText.c
+
+tixDiWin.o: $(GENERIC_DIR)/tixDiWin.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiWin.c
+
+tixError.o: $(GENERIC_DIR)/tixError.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixError.c
+
+tixForm.o: $(GENERIC_DIR)/tixForm.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixForm.c
+
+tixFormMisc.o: $(GENERIC_DIR)/tixFormMisc.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixFormMisc.c
+
+tixGeometry.o: $(GENERIC_DIR)/tixGeometry.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGeometry.c
+
+tixGrid.o: $(GENERIC_DIR)/tixGrid.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrid.c
+
+tixGrData.o: $(GENERIC_DIR)/tixGrData.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrData.c
+
+tixGrFmt.o: $(GENERIC_DIR)/tixGrFmt.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrFmt.c
+
+tixGrRC.o: $(GENERIC_DIR)/tixGrRC.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrRC.c
+
+tixGrSel.o: $(GENERIC_DIR)/tixGrSel.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrSel.c
+
+tixGrSort.o: $(GENERIC_DIR)/tixGrSort.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrSort.c
+
+tixGrUtl.o: $(GENERIC_DIR)/tixGrUtl.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrUtl.c
+
+tixHLCol.o: $(GENERIC_DIR)/tixHLCol.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixHLCol.c
+
+tixHLHdr.o: $(GENERIC_DIR)/tixHLHdr.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixHLHdr.c
+
+tixHLInd.o: $(GENERIC_DIR)/tixHLInd.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixHLInd.c
+
+tixHList.o: $(GENERIC_DIR)/tixHList.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixHList.c
+
+tixImgCmp.o: $(GENERIC_DIR)/tixImgCmp.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixImgCmp.c
+
+tixImgXpm.o: $(GENERIC_DIR)/tixImgXpm.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixImgXpm.c
+
+tixInit.o: $(GENERIC_DIR)/tixInit.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixInit.c
+
+tixItcl.o: $(GENERIC_DIR)/tixItcl.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixItcl.c
+
+tixInputO.o : $(GENERIC_DIR)/tixInputO.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixInputO.c
+
+tixList.o: $(GENERIC_DIR)/tixList.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixList.c
+
+tixMethod.o : $(GENERIC_DIR)/tixMethod.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixMethod.c
+
+tixMwm.o: $(GENERIC_DIR)/tixMwm.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixMwm.c
+
+tixNBFrame.o: $(GENERIC_DIR)/tixNBFrame.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixNBFrame.c
+
+tixOption.o: $(GENERIC_DIR)/tixOption.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixOption.c
+
+tixSmpLs.o: $(GENERIC_DIR)/tixSmpLs.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixSmpLs.c
+
+tixScroll.o: $(GENERIC_DIR)/tixScroll.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixScroll.c
+
+tixTList.o: $(GENERIC_DIR)/tixTList.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixTList.c
+
+tixUtils.o: $(GENERIC_DIR)/tixUtils.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixUtils.c
+
+tixWidget.o: $(GENERIC_DIR)/tixWidget.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixWidget.c
+
+tixUnixDraw.o: $(UNIX_DIR)/tixUnixDraw.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tixUnixDraw.c
+
+tixUnixXpm.o: $(UNIX_DIR)/tixUnixXpm.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tixUnixXpm.c
+
+tixUnixWm.o: $(UNIX_DIR)/tixUnixWm.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tixUnixWm.c
+
+#
+# Dependence rules for SAM
+#
+tclUnixSam76.o: tclUnixSam76.c tclSamLib.c
+ $(CC) -c $(CC_SWITCHES) tclUnixSam76.c
+
+tclSamLib.c:
+ $(RUN_TCLSH) $(SRC_DIR)/tools/tclc.tcl $(TCL_SCRIPTS) \
+ > tclSamLib.c
+
+tkUnixSam42.o: tkUnixSam42.c tkSamLib.c
+ $(CC) -c $(CC_SWITCHES) tkUnixSam42.c
+
+tkSamLib.c:
+ $(RUN_TCLSH) $(SRC_DIR)/tools/tclc.tcl $(TK_SCRIPTS) \
+ > tkSamLib.c
+
+tixUnixSam.o: $(UNIX_DIR)/tixUnixSam.c $(UNIX_DIR)/tixSamLib.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tixUnixSam.c
+
+$(UNIX_DIR)/tixSamLib.c:
+ $(RUN_TCLSH) $(SRC_DIR)/tools/tclc.tcl $(TIX_SCRIPTS) \
+ > $(UNIX_DIR)/tixSamLib.c
+
+
+tests: $(TIX_EXE_FILE)
+ TCL_LIBRARY=$(TCL_SRC_DIR)/library TK_LIBRARY=$(TK_SRC_DIR)/library \
+ ITCL_LIBRARY=$(ITCL_SRC_DIR)/library \
+ ITK_LIBRARY=$(ITK_SRC_DIR)/library \
+ IWIDGETS_LIBRARY=$(ITCL_ROOT_DIR)/$(IWIDGETS) \
+ TIX_LIBRARY=$(SRC_DIR)/library \
+ LD_LIBRARY_PATH=${LD_LIBRARY_PATH}:. \
+ ./$(TIX_EXE_FILE) $(SRC_DIR)/tests/Driver.tcl
+
+sa-tests: $(TIX_SAMEXE_FILE)
+ ./$(TIX_SAMEXE_FILE) $(SRC_DIR)/tests/Driver.tcl
+
+#----------------------------------------------------------------------
+#
+# INSTALLATION
+#
+#----------------------------------------------------------------------
+_install_: $(TIX_LIB_FILE) $(TIX_EXE_FILE) $(SAM_INSTALL)
+ @for i in $(LIB_DIR) $(BIN_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing $(TIX_LIB_FILE) as $(LIB_DIR)/$(TIX_LIB_FILE)"
+ @$(INSTALL_PROGRAM) $(TIX_LIB_FILE) $(LIB_DIR)/$(TIX_LIB_FILE)
+ @echo "Installing $(TIX_EXE_FILE) as $(BIN_DIR)/$(INST_EXE)"
+ @$(INSTALL_PROGRAM) $(TIX_EXE_FILE) $(BIN_DIR)/$(INST_EXE)
+
+_install_sam_: $(SAM_TARGETS)
+ @for i in $(LIB_DIR) $(BIN_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing $(TIX_SAM_FILE) as $(LIB_DIR)/$(TIX_SAM_FILE)"
+ @$(INSTALL_PROGRAM) $(TIX_SAM_FILE) $(LIB_DIR)/$(TIX_SAM_FILE)
+ @echo "Installing $(TK_SAM_FILE) as $(LIB_DIR)/$(TK_SAM_FILE)"
+ @$(INSTALL_PROGRAM) $(TK_SAM_FILE) $(LIB_DIR)/$(TK_SAM_FILE)
+ @echo "Installing $(TCL_SAM_FILE) as $(LIB_DIR)/$(TCL_SAM_FILE)"
+ @$(INSTALL_PROGRAM) $(TCL_SAM_FILE) $(LIB_DIR)/$(TCL_SAM_FILE)
+ @echo ""
+ @echo "Installing $(TIX_SAMEXE_FILE) as $(BIN_DIR)/$(INST_TIX_SAMEXE)"
+ @$(INSTALL_PROGRAM) $(TIX_SAMEXE_FILE) $(BIN_DIR)/$(INST_TIX_SAMEXE)
+ @echo "Installing $(TK_SAMEXE_FILE) as $(BIN_DIR)/$(INST_TK_SAMEXE)"
+ @$(INSTALL_PROGRAM) $(TK_SAMEXE_FILE) $(BIN_DIR)/$(INST_TK_SAMEXE)
+ @echo "Installing $(TCL_SAMEXE_FILE) as $(BIN_DIR)/$(INST_TCL_SAMEXE)"
+ @$(INSTALL_PROGRAM) $(TCL_SAMEXE_FILE) $(BIN_DIR)/$(INST_TCL_SAMEXE)
+
+
+install: _install_
+ @echo The binary files have been installed.
+ @echo You probably need to make install in the parent directory
+ @echo to install other files.
+
+sam_clean:
+ rm -f $(UNIX_DIR)/tixSamLib.c $(UNIX_DIR)/tixBitmaps.c
+
+clean:
+ rm -f *.so *.a *.o *_s.o core errs *~ \#* TAGS *.E sta* \
+ a.out errors $(TIX_EXE_FILE) $(TIX_LIB_FILE) *.bak \
+ $(SAM_TARGETS) tclSamLib.c tkSamLib.c
+
+distclean: clean
+ rm -f Makefile config.* lib.exp
+
+depend:
+ makedepend -- $(CC_SWITCHES) -- $(SRCS)
+
+# CYGNUS LOCAL: Makefile depends upon config.status
+Makefile: Makefile.in config.status
+ ./config.status
+
+.c.o:
+ $(CC) -c $(CC_SWITCHES) $<
+
+# CYGNUS LOCAL: Rebuild config.status when appropriate.
+config.status: configure
+ $(SHELL) config.status --recheck
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
+
diff --git a/tix/unix/tk4.2/configure b/tix/unix/tk4.2/configure
new file mode 100755
index 00000000000..7c48b9c53de
--- /dev/null
+++ b/tix/unix/tk4.2/configure
@@ -0,0 +1,2190 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.12.2
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+ac_help="$ac_help
+ --enable-gcc allow use of gcc if available"
+ac_help="$ac_help
+ --with-tcl=DIR use Tcl 7.6 source from DIR"
+ac_help="$ac_help
+ --with-tk=DIR use Tk 4.2 source from DIR"
+ac_help="$ac_help
+ --enable-sam build stand-alone modules"
+ac_help="$ac_help
+ --enable-shared build libtix as a shared library"
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.12.2"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=../../generic/tixInit.c
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+
+#--------------------------------------------------------------------
+# Remove the ./config.cache file and rerun configure if
+# the cache file belong to a different architecture
+#----------------------------------------------------------------------
+# Extract the first word of "uname -a", so it can be a program name with args.
+set dummy uname -a; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:543: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_UNAME'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$UNAME"; then
+ ac_cv_prog_UNAME="$UNAME" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_UNAME="uname -a"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_UNAME" && ac_cv_prog_UNAME=""""
+fi
+fi
+UNAME="$ac_cv_prog_UNAME"
+if test -n "$UNAME"; then
+ echo "$ac_t""$UNAME" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test "$UNAME" = ""; then
+ # Extract the first word of "uname", so it can be a program name with args.
+set dummy uname; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:573: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_UNAME'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$UNAME"; then
+ ac_cv_prog_UNAME="$UNAME" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_UNAME="uname"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_UNAME" && ac_cv_prog_UNAME=""""
+fi
+fi
+UNAME="$ac_cv_prog_UNAME"
+if test -n "$UNAME"; then
+ echo "$ac_t""$UNAME" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+fi
+
+if test "$UNAME" != ""; then
+ uname=`$UNAME`
+ echo $ac_n "checking cached value of \$uname""... $ac_c" 1>&6
+echo "configure:604: checking cached value of \$uname" >&5
+ if eval "test \"`echo '$''{'ac_cv_prog_uname'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ nocached=1 ac_cv_prog_uname=`$UNAME`
+fi
+
+ if test "$nocached" = "1"; then
+ echo "$ac_t""no" 1>&6
+ else
+ echo "$ac_t""yes" 1>&6
+ fi
+
+ if test "$uname" != "$ac_cv_prog_uname"; then
+ echo "Running on a different machine/architecture. Can't use cached values"
+ echo "Removing config.cache and running configure again ..."
+ rm -f config.cache
+ CMDLINE="$0 $*"
+ exec $CMDLINE
+ fi
+fi
+
+#----------------------------------------------------------------------
+# We don't want to use any relative path because we need to generate
+# Makefile's in subdirectories
+#----------------------------------------------------------------------
+if test "$INSTALL" = "./install.sh"; then
+ INSTALL=`pwd`/install.sh
+fi
+
+#--------------------------------------------------------------------
+# Version information about this TIX release.
+#--------------------------------------------------------------------
+
+TIX_VERSION=4.1
+TIX_MAJOR_VERSION=4
+TIX_MINOR_VERSION=1
+
+BIN_VERSION=${TIX_VERSION}.7.6
+
+
+VERSION=${BIN_VERSION}
+
+#--------------------------------------------------------------------
+# See if user wants to use gcc to compile Tix. This option must
+# be used before any checking that uses the C compiler.
+#--------------------------------------------------------------------
+
+# Check whether --enable-gcc or --disable-gcc was given.
+if test "${enable_gcc+set}" = set; then
+ enableval="$enable_gcc"
+ tix_ok=$enableval
+else
+ tix_ok=no
+fi
+
+if test "$tix_ok" = "yes"; then
+ # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:664: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:693: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_prog_rejected=no
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -z "$CC"; then
+ case "`uname -s`" in
+ *win32* | *WIN32*)
+ # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:743: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="cl"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+ ;;
+ esac
+ fi
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:774: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext <<EOF
+#line 784 "configure"
+#include "confdefs.h"
+main(){return(0);}
+EOF
+if { (eval echo configure:788: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cc_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:808: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:813: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:822: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gcc=yes
+else
+ ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+else
+ GCC=
+fi
+
+ac_test_CFLAGS="${CFLAGS+set}"
+ac_save_CFLAGS="$CFLAGS"
+CFLAGS=
+echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:841: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+
+else
+ CC=${CC-cc}
+
+fi
+
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:908: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ # Account for people who put trailing slashes in PATH elements.
+ case "$ac_dir/" in
+ /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ if test -f $ac_dir/$ac_prog; then
+ if test $ac_prog = install &&
+ grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ else
+ ac_cv_path_install="$ac_dir/$ac_prog -c"
+ break 2
+ fi
+ fi
+ done
+ ;;
+ esac
+ done
+ IFS="$ac_save_IFS"
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL="$ac_cv_path_install"
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL="$ac_install_sh"
+ fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+# Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:961: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_RANLIB="ranlib"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:988: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # This must be in double quotes, not single quotes, because CPP may get
+ # substituted into the Makefile and "${CC-cc}" will confuse make.
+ CPP="${CC-cc} -E"
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp.
+ cat > conftest.$ac_ext <<EOF
+#line 1003 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1009: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -E -traditional-cpp"
+ cat > conftest.$ac_ext <<EOF
+#line 1020 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1026: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -nologo -E"
+ cat > conftest.$ac_ext <<EOF
+#line 1037 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1043: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+ ac_cv_prog_CPP="$CPP"
+fi
+ CPP="$ac_cv_prog_CPP"
+else
+ ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+for ac_hdr in unistd.h limits.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:1071: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1076 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1081: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6
+echo "configure:1108: checking whether ${MAKE-make} sets \${MAKE}" >&5
+set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftestmake <<\EOF
+all:
+ @echo 'ac_maketemp="${MAKE}"'
+EOF
+# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=`
+if test -n "$ac_maketemp"; then
+ eval ac_cv_prog_make_${ac_make}_set=yes
+else
+ eval ac_cv_prog_make_${ac_make}_set=no
+fi
+rm -f conftestmake
+fi
+if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ SET_MAKE=
+else
+ echo "$ac_t""no" 1>&6
+ SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+
+#--------------------------------------------------------------------
+# unsigned char is not supported by some non-ANSI compilers.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking unsigned char""... $ac_c" 1>&6
+echo "configure:1140: checking unsigned char" >&5
+cat > conftest.$ac_ext <<EOF
+#line 1142 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+int main() {
+
+ unsigned char c = 'c';
+
+; return 0; }
+EOF
+if { (eval echo configure:1151: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ tcl_ok=supported
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ tcl_ok=not supported
+fi
+rm -f conftest*
+
+echo "$ac_t""$tcl_ok" 1>&6
+if test $tcl_ok = supported; then
+ cat >> confdefs.h <<\EOF
+#define UCHAR_SUPPORTED 1
+EOF
+
+fi
+
+#--------------------------------------------------------------------
+# Check whether there is an strcasecmp function on this system.
+# This is a bit tricky because under SCO it's in -lsocket and
+# under Sequent Dynix it's in -linet.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for strcasecmp""... $ac_c" 1>&6
+echo "configure:1177: checking for strcasecmp" >&5
+if eval "test \"`echo '$''{'ac_cv_func_strcasecmp'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1182 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char strcasecmp(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char strcasecmp();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_strcasecmp) || defined (__stub___strcasecmp)
+choke me
+#else
+strcasecmp();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1205: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_strcasecmp=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_strcasecmp=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'strcasecmp`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_ok=1
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+if test "$tcl_ok" = 0; then
+ echo $ac_n "checking for strcasecmp in -lsocket""... $ac_c" 1>&6
+echo "configure:1227: checking for strcasecmp in -lsocket" >&5
+ac_lib_var=`echo socket'_'strcasecmp | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lsocket $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1235 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char strcasecmp();
+
+int main() {
+strcasecmp()
+; return 0; }
+EOF
+if { (eval echo configure:1246: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_ok=1
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+fi
+if test "$tcl_ok" = 0; then
+ echo $ac_n "checking for strcasecmp in -linet""... $ac_c" 1>&6
+echo "configure:1270: checking for strcasecmp in -linet" >&5
+ac_lib_var=`echo inet'_'strcasecmp | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-linet $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1278 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char strcasecmp();
+
+int main() {
+strcasecmp()
+; return 0; }
+EOF
+if { (eval echo configure:1289: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_ok=1
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+fi
+if test "$tcl_ok" = 0; then
+ cat >> confdefs.h <<\EOF
+#define NO_STRCASECMP 1
+EOF
+
+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.
+#--------------------------------------------------------------------
+
+# Check whether --with-tcl or --without-tcl was given.
+if test "${with_tcl+set}" = set; then
+ withval="$with_tcl"
+ val=$withval
+else
+ val=""
+fi
+
+
+echo $ac_n "checking Tcl source directory""... $ac_c" 1>&6
+echo "configure:1333: checking Tcl source directory" >&5
+
+if test "$val" != ""; then
+ TCL_SRC_DIR=$val
+ if test ! -d $TCL_SRC_DIR; then
+ { echo "configure: error: Directory $TCL_SRC_DIR doesn't exist" 1>&2; exit 1; }
+ { echo "configure: error: Please install the source code of Tcl 7.6" 1>&2; exit 1; }
+ exit 1
+ fi
+else
+ # CYGNUS LOCAL: Just use tcl.
+ dirs="${srcdir}/../../../tcl7.6* ${srcdir}/../../../tcl"
+ TCL_SRC_DIR="no-no"
+ for i in $dirs; do
+ if test -d $i; then
+ TCL_SRC_DIR=`cd $i; pwd`
+ fi
+ done
+
+ if test ! -d $TCL_SRC_DIR; then
+ { echo "configure: error: Cannot locate Tcl source directory in $dirs" 1>&2; exit 1; }
+ { echo "configure: error: Please install the source code of Tcl 7.6" 1>&2; exit 1; }
+ exit 1
+ fi
+fi
+echo "$ac_t""$TCL_SRC_DIR" 1>&6
+
+# CYGNUS LOCAL: This used to get TCL_BIN_DIR from TCL_SRC_DIR, which
+# only works when srcdir == objdir
+TCL_BIN_DIR=../../../tcl/unix
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Tk is; if
+# not, assume that its top-level directory is a sibling of ours.
+#--------------------------------------------------------------------
+
+# Check whether --with-tk or --without-tk was given.
+if test "${with_tk+set}" = set; then
+ withval="$with_tk"
+ val=$withval
+else
+ val=""
+fi
+
+
+echo $ac_n "checking Tk source directory""... $ac_c" 1>&6
+echo "configure:1379: checking Tk source directory" >&5
+
+if test "$val" != ""; then
+ TK_SRC_DIR=$val
+ if test ! -d $TK_SRC_DIR; then
+ { echo "configure: error: Directory $TK_SRC_DIR doesn't exist" 1>&2; exit 1; }
+ { echo "configure: error: Please install the source code of Tk 4.2" 1>&2; exit 1; }
+ exit 1
+ fi
+else
+ # CYGNUS LOCAL: Just use tk
+ dirs="${srcdir}/../../../tk4.2* ${srcdir}/../../../tk"
+ TK_SRC_DIR="no-no"
+ for i in $dirs; do
+ if test -d $i; then
+ TK_SRC_DIR=`cd $i; pwd`
+ fi
+ done
+
+ if test ! -d $TK_SRC_DIR; then
+ { echo "configure: error: Cannot locate Tk source directory in $dirs" 1>&2; exit 1; }
+ { echo "configure: error: Please install the source code of Tk 4.2" 1>&2; exit 1; }
+ exit 1
+ fi
+fi
+echo "$ac_t""$TK_SRC_DIR" 1>&6
+
+# CYGNUS LOCAL: This used to get TK_BIN_DIR from TK_SRC_DIR, which
+# only works when srcdir == objdir
+TK_BIN_DIR=../../../tk/unix
+
+#--------------------------------------------------------------------
+# Find out the top level source directory of the Tix package.
+#--------------------------------------------------------------------
+TIX_SRC_DIR=`cd ${srcdir}/../..; pwd`
+
+#--------------------------------------------------------------------
+# See if we should compile SAM
+#--------------------------------------------------------------------
+
+# Check whether --enable-sam or --disable-sam was given.
+if test "${enable_sam+set}" = set; then
+ enableval="$enable_sam"
+ ok=$enableval
+else
+ ok=no
+fi
+
+
+if test "$ok" = "yes"; then
+ TIX_BUILD_SAM="yes"
+ TIX_SAM_TARGETS='$(SAM_TARGETS)'
+ TIX_SAM_INSTALL=_install_sam_
+else
+ TIX_BUILD_SAM="no"
+fi
+
+IS_ITCL=0
+ITCL_BUILD_LIB_SPEC=""
+ITK_BUILD_LIB_SPEC=""
+TIX_EXE_FILE=tixwish
+TCL_SAMEXE_FILE=satclsh
+TK_SAMEXE_FILE=sawish
+TIX_SAMEXE_FILE=satixwish
+
+#--------------------------------------------------------------------
+# 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
+CC=$TCL_CC
+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
+TIX_LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
+
+#--------------------------------------------------------------------
+# Read in configuration information generated by Tk and arrange
+# for it to be substituted into our Makefile.
+#--------------------------------------------------------------------
+file=$TK_BIN_DIR/tkConfig.sh
+. $file
+
+TIX_DEFS="$TK_DEFS $TCL_DEFS"
+
+# 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
+ TIX_BUILD_LIB_SPEC="-L`pwd` -ltix${VERSION}"
+ TIX_BUILD_SAM_SPEC="-L`pwd` -ltixsam${VERSION}"
+ TCL_BUILD_SAM_SPEC="-L`pwd` -ltclsam${TCL_VERSION}"
+ TK_BUILD_SAM_SPEC="-L`pwd` -ltksam${TK_VERSION}"
+ TIX_LIB_SPEC="-L${exec_prefix}/lib -ltix${VERSION}"
+else
+ TIX_BUILD_LIB_SPEC="-L`pwd` -ltix`echo ${VERSION} | tr -d .`"
+ TIX_BUILD_SAM_SPEC="-L`pwd` -ltixsam`echo ${VERSION} | tr -d .`"
+ TCL_BUILD_SAM_SPEC="-L`pwd` -ltclsam`echo ${TCL_VERSION} | tr -d .`"
+ TK_BUILD_SAM_SPEC="-L`pwd` -ltksam`echo ${TK_VERSION} | tr -d .`"
+ TIX_LIB_SPEC="-L${exec_prefix}/lib -ltix`echo ${VERSION} | tr -d .`"
+fi
+
+#--------------------------------------------------------------------
+# See if we should compile shared library.
+#--------------------------------------------------------------------
+
+# Check whether --enable-shared or --disable-shared was given.
+if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ ok=$enableval
+else
+ ok=no
+fi
+
+
+if test "$ok" = "yes" -a "${SHLIB_SUFFIX}" != ""; then
+ TIX_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+ RANLIB=":"
+
+ # The main Tix library
+ #
+ eval "TIX_LIB_FILE=libtix${TCL_SHARED_LIB_SUFFIX}"
+ TIX_MAKE_LIB="\${SHLIB_LD} -o ${TIX_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tcl SAM library
+ #
+ VERSION=7.6
+ eval "TCL_SAM_FILE=libtclsam${TCL_SHARED_LIB_SUFFIX}"
+ TCL_MAKE_SAM="\${SHLIB_LD} -o ${TCL_SAM_FILE} \${TCL_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tk SAM library
+ #
+ VERSION=4.2
+ eval "TK_SAM_FILE=libtksam${TCL_SHARED_LIB_SUFFIX}"
+ TK_MAKE_SAM="\${SHLIB_LD} -o ${TK_SAM_FILE} \${TK_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tix SAM library
+ #
+ VERSION=${BIN_VERSION}
+ eval "TIX_SAM_FILE=libtixsam${TCL_SHARED_LIB_SUFFIX}"
+ TIX_MAKE_SAM="\${SHLIB_LD} -o ${TIX_SAM_FILE} \${TIX_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+else
+ TIX_SHLIB_CFLAGS=""
+
+ # The main Tix library
+ #
+ eval "TIX_LIB_FILE=libtix${TCL_UNSHARED_LIB_SUFFIX}"
+ TIX_MAKE_LIB="ar cr ${TIX_LIB_FILE} \${OBJS}"
+
+ # The Tcl SAM library
+
+ VERSION=7.6
+ eval "TCL_SAM_FILE=libtclsam${TCL_UNSHARED_LIB_SUFFIX}"
+ TCL_MAKE_SAM="ar cr ${TCL_SAM_FILE} \${TCL_SAM_OBJS}"
+
+ # The Tk SAM library
+ #
+ VERSION=4.2
+ eval "TK_SAM_FILE=libtksam${TCL_UNSHARED_LIB_SUFFIX}"
+ TK_MAKE_SAM="ar cr ${TK_SAM_FILE} \${TK_SAM_OBJS}"
+
+ # The Tix SAM library
+ #
+ VERSION=${BIN_VERSION}
+ eval "TIX_SAM_FILE=libtixsam${TCL_UNSHARED_LIB_SUFFIX}"
+ TIX_MAKE_SAM="ar cr ${TIX_SAM_FILE} \${TIX_SAM_OBJS}"
+fi
+
+
+#--------------------------------------------------------------------
+# Check for the existence of the -lsocket and -lnsl libraries.
+# The order here is important, so that they end up in the right
+# order in the command line generated by make. Here are some
+# special considerations:
+# 1. Use "connect" and "accept" to check for -lsocket, and
+# "gethostbyname" to check for -lnsl.
+# 2. Use each function name only once: can't redo a check because
+# autoconf caches the results of the last check and won't redo it.
+# 3. Use -lnsl and -lsocket only if they supply procedures that
+# aren't already present in the normal libraries. This is because
+# IRIX 5.2 has libraries, but they aren't needed and they're
+# bogus: they goof up name resolution if used.
+# 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+# To get around this problem, check for both libraries together
+# if -lsocket doesn't work by itself.
+#--------------------------------------------------------------------
+
+checked=0
+for i in $TK_LIBS; do
+ if test "$i" = "-lsocket"; then
+ checked=1
+ fi
+done
+
+if test "$checked" = "0"; then
+ tcl_checkBoth=0
+ echo $ac_n "checking for connect""... $ac_c" 1>&6
+echo "configure:1587: checking for connect" >&5
+if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1592 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char connect(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char connect();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_connect) || defined (__stub___connect)
+choke me
+#else
+connect();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1615: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_connect=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_connect=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'connect`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_checkSocket=0
+else
+ echo "$ac_t""no" 1>&6
+tcl_checkSocket=1
+fi
+
+ if test "$tcl_checkSocket" = 1; then
+ echo $ac_n "checking for main in -lsocket""... $ac_c" 1>&6
+echo "configure:1637: checking for main in -lsocket" >&5
+ac_lib_var=`echo socket'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lsocket $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1645 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:1652: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ TK_LIBS="$TK_LIBS -lsocket"
+else
+ echo "$ac_t""no" 1>&6
+tcl_checkBoth=1
+fi
+
+ fi
+ if test "$tcl_checkBoth" = 1; then
+ tk_oldLibs=$TK_LIBS
+ TK_LIBS="$TK_LIBS -lsocket -lnsl"
+ echo $ac_n "checking for accept""... $ac_c" 1>&6
+echo "configure:1678: checking for accept" >&5
+if eval "test \"`echo '$''{'ac_cv_func_accept'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1683 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char accept(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char accept();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_accept) || defined (__stub___accept)
+choke me
+#else
+accept();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1706: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_accept=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_accept=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'accept`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_checkNsl=0
+else
+ echo "$ac_t""no" 1>&6
+TK_LIBS=$tk_oldLibs
+fi
+
+ fi
+ echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6
+echo "configure:1728: checking for gethostbyname" >&5
+if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1733 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char gethostbyname(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char gethostbyname();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_gethostbyname) || defined (__stub___gethostbyname)
+choke me
+#else
+gethostbyname();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1756: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_gethostbyname=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_gethostbyname=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+echo $ac_n "checking for main in -lnsl""... $ac_c" 1>&6
+echo "configure:1774: checking for main in -lnsl" >&5
+ac_lib_var=`echo nsl'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lnsl $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1782 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:1789: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ TK_LIBS="$TK_LIBS -lnsl"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+fi
+
+fi
+
+#----------------------------------------------------------------------
+# Substitution strings exported by TIX
+#----------------------------------------------------------------------
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+# The "binary version" of Tix (see docs/Pkg.txt)
+TIX_VERSION_PKG=${BIN_VERSION}
+
+
+TIXSAM_PKG_FILE="[file join [file dirname \$dir] ${TIX_SAM_FILE}]"
+if test "$TIX_BUILD_SAM" = "yes"; then
+ TIX_SAM_PACKAGE_IFNEEDED="package ifneeded Tixsam ${TIX_VERSION_PKG} [list load \"${TIXSAM_PKG_FILE}\" Tixsam]"
+fi
+
+# The package file, usually a shared library
+TIX_PKG_FILE="[file join [file dirname \$dir] ${TIX_LIB_FILE}]"
+
+
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set) 2>&1 | grep ac_space` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.12.2"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "Makefile pkgIndex.tcl" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@UNAME@%$UNAME%g
+s%@CC@%$CC%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@RANLIB@%$RANLIB%g
+s%@CPP@%$CPP%g
+s%@SET_MAKE@%$SET_MAKE%g
+s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
+s%@SHLIB_LD@%$SHLIB_LD%g
+s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
+s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
+s%@SHLIB_VERSION@%$SHLIB_VERSION%g
+s%@DL_LIBS@%$DL_LIBS%g
+s%@LD_FLAGS@%$LD_FLAGS%g
+s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
+s%@TCL_LIBS@%$TCL_LIBS%g
+s%@TCL_VERSION@%$TCL_VERSION%g
+s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
+s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g
+s%@TK_BUILD_LIB_SPEC@%$TK_BUILD_LIB_SPEC%g
+s%@TK_LIBS@%$TK_LIBS%g
+s%@TK_VERSION@%$TK_VERSION%g
+s%@TK_SRC_DIR@%$TK_SRC_DIR%g
+s%@TK_BIN_DIR@%$TK_BIN_DIR%g
+s%@TK_XINCLUDES@%$TK_XINCLUDES%g
+s%@TIX_LD_SEARCH_FLAGS@%$TIX_LD_SEARCH_FLAGS%g
+s%@TIX_MAJOR_VERSION@%$TIX_MAJOR_VERSION%g
+s%@TIX_MINOR_VERSION@%$TIX_MINOR_VERSION%g
+s%@TIX_VERSION@%$TIX_VERSION%g
+s%@TIX_SRC_DIR@%$TIX_SRC_DIR%g
+s%@TIX_SHLIB_CFLAGS@%$TIX_SHLIB_CFLAGS%g
+s%@TIX_MAKE_LIB@%$TIX_MAKE_LIB%g
+s%@TIX_LIB_FILE@%$TIX_LIB_FILE%g
+s%@TIX_BUILD_LIB_SPEC@%$TIX_BUILD_LIB_SPEC%g
+s%@TIX_LIB_SPEC@%$TIX_LIB_SPEC%g
+s%@TIX_EXE_FILE@%$TIX_EXE_FILE%g
+s%@TIX_SAM_TARGETS@%$TIX_SAM_TARGETS%g
+s%@TIX_SAM_INSTALL@%$TIX_SAM_INSTALL%g
+s%@TCL_SAM_FILE@%$TCL_SAM_FILE%g
+s%@TCL_MAKE_SAM@%$TCL_MAKE_SAM%g
+s%@TK_SAM_FILE@%$TK_SAM_FILE%g
+s%@TK_MAKE_SAM@%$TK_MAKE_SAM%g
+s%@TIX_SAM_FILE@%$TIX_SAM_FILE%g
+s%@TIX_MAKE_SAM@%$TIX_MAKE_SAM%g
+s%@TIX_DEFS@%$TIX_DEFS%g
+s%@ITCL_BUILD_LIB_SPEC@%$ITCL_BUILD_LIB_SPEC%g
+s%@ITK_BUILD_LIB_SPEC@%$ITK_BUILD_LIB_SPEC%g
+s%@TCL_SAMEXE_FILE@%$TCL_SAMEXE_FILE%g
+s%@TK_SAMEXE_FILE@%$TK_SAMEXE_FILE%g
+s%@TIX_SAMEXE_FILE@%$TIX_SAMEXE_FILE%g
+s%@TCL_BUILD_SAM_SPEC@%$TCL_BUILD_SAM_SPEC%g
+s%@TK_BUILD_SAM_SPEC@%$TK_BUILD_SAM_SPEC%g
+s%@TIX_BUILD_SAM_SPEC@%$TIX_BUILD_SAM_SPEC%g
+s%@TIX_VERSION_PKG@%$TIX_VERSION_PKG%g
+s%@TIX_PKG_FILE@%$TIX_PKG_FILE%g
+s%@TIX_SAM_PACKAGE_IFNEEDED@%$TIX_SAM_PACKAGE_IFNEEDED%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile pkgIndex.tcl"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+ case "$ac_given_INSTALL" in
+ [/$]*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ esac
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
+
diff --git a/tix/unix/tk4.2/configure.in b/tix/unix/tk4.2/configure.in
new file mode 100644
index 00000000000..7ccf63eb6f6
--- /dev/null
+++ b/tix/unix/tk4.2/configure.in
@@ -0,0 +1,431 @@
+dnl This file is an input file used by the GNU "autoconf" program to
+dnl generate the file "configure", which is run to configure the
+dnl Makefile in this directory.
+
+AC_INIT(../../generic/tixInit.c)
+
+#--------------------------------------------------------------------
+# Remove the ./config.cache file and rerun configure if
+# the cache file belong to a different architecture
+#----------------------------------------------------------------------
+AC_CHECK_PROG(UNAME, uname -a, [uname -a], "")
+if test "$UNAME" = ""; then
+ AC_CHECK_PROG(UNAME, uname, [uname], "")
+fi
+
+if test "$UNAME" != ""; then
+ uname=`$UNAME`
+ AC_MSG_CHECKING([cached value of \$uname])
+ AC_CACHE_VAL(ac_cv_prog_uname, [nocached=1 ac_cv_prog_uname=`$UNAME`])
+ if test "$nocached" = "1"; then
+ AC_MSG_RESULT(no)
+ else
+ AC_MSG_RESULT(yes)
+ fi
+
+ if test "$uname" != "$ac_cv_prog_uname"; then
+ echo "Running on a different machine/architecture. Can't use cached values"
+ echo "Removing config.cache and running configure again ..."
+ rm -f config.cache
+ CMDLINE="$0 $*"
+ exec $CMDLINE
+ fi
+fi
+
+#----------------------------------------------------------------------
+# We don't want to use any relative path because we need to generate
+# Makefile's in subdirectories
+#----------------------------------------------------------------------
+if test "$INSTALL" = "./install.sh"; then
+ INSTALL=`pwd`/install.sh
+fi
+
+#--------------------------------------------------------------------
+# Version information about this TIX release.
+#--------------------------------------------------------------------
+
+TIX_VERSION=4.1
+TIX_MAJOR_VERSION=4
+TIX_MINOR_VERSION=1
+
+BIN_VERSION=${TIX_VERSION}.7.6
+
+
+VERSION=${BIN_VERSION}
+
+#--------------------------------------------------------------------
+# See if user wants to use gcc to compile Tix. This option must
+# be used before any checking that uses the C compiler.
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(gcc, [ --enable-gcc allow use of gcc if available],
+ [tix_ok=$enableval], [tix_ok=no])
+if test "$tix_ok" = "yes"; then
+ AC_PROG_CC
+else
+ CC=${CC-cc}
+AC_SUBST(CC)
+fi
+
+AC_PROG_INSTALL
+AC_PROG_RANLIB
+AC_HAVE_HEADERS(unistd.h limits.h)
+AC_PROG_MAKE_SET
+
+#--------------------------------------------------------------------
+# unsigned char is not supported by some non-ANSI compilers.
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING([unsigned char])
+AC_TRY_COMPILE([#include <stdio.h>],[
+ unsigned char c = 'c';
+], tcl_ok=supported, tcl_ok=not supported)
+
+AC_MSG_RESULT($tcl_ok)
+if test $tcl_ok = supported; then
+ AC_DEFINE(UCHAR_SUPPORTED)
+fi
+
+#--------------------------------------------------------------------
+# Check whether there is an strcasecmp function on this system.
+# This is a bit tricky because under SCO it's in -lsocket and
+# under Sequent Dynix it's in -linet.
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(strcasecmp, tcl_ok=1, tcl_ok=0)
+if test "$tcl_ok" = 0; then
+ AC_CHECK_LIB(socket, strcasecmp, tcl_ok=1, tcl_ok=0)
+fi
+if test "$tcl_ok" = 0; then
+ AC_CHECK_LIB(inet, strcasecmp, tcl_ok=1, tcl_ok=0)
+fi
+if test "$tcl_ok" = 0; then
+ AC_DEFINE(NO_STRCASECMP)
+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.
+#--------------------------------------------------------------------
+
+AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 7.6 source from DIR],
+ val=$withval, val="")
+
+AC_MSG_CHECKING([Tcl source directory])
+
+if test "$val" != ""; then
+ TCL_SRC_DIR=$val
+ if test ! -d $TCL_SRC_DIR; then
+ AC_MSG_ERROR(Directory $TCL_SRC_DIR doesn't exist)
+ AC_MSG_ERROR(Please install the source code of Tcl 7.6)
+ exit 1
+ fi
+else
+ # CYGNUS LOCAL: Just use tcl.
+ dirs="${srcdir}/../../../tcl7.6* ${srcdir}/../../../tcl"
+ TCL_SRC_DIR="no-no"
+ for i in $dirs; do
+ if test -d $i; then
+ TCL_SRC_DIR=`cd $i; pwd`
+ fi
+ done
+
+ if test ! -d $TCL_SRC_DIR; then
+ AC_MSG_ERROR(Cannot locate Tcl source directory in $dirs)
+ AC_MSG_ERROR(Please install the source code of Tcl 7.6)
+ exit 1
+ fi
+fi
+AC_MSG_RESULT($TCL_SRC_DIR)
+
+# CYGNUS LOCAL: This used to get TCL_BIN_DIR from TCL_SRC_DIR, which
+# only works when srcdir == objdir
+TCL_BIN_DIR=../../../tcl/unix
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Tk is; if
+# not, assume that its top-level directory is a sibling of ours.
+#--------------------------------------------------------------------
+
+AC_ARG_WITH(tk, [ --with-tk=DIR use Tk 4.2 source from DIR],
+ val=$withval, val="")
+
+AC_MSG_CHECKING([Tk source directory])
+
+if test "$val" != ""; then
+ TK_SRC_DIR=$val
+ if test ! -d $TK_SRC_DIR; then
+ AC_MSG_ERROR(Directory $TK_SRC_DIR doesn't exist)
+ AC_MSG_ERROR(Please install the source code of Tk 4.2)
+ exit 1
+ fi
+else
+ # CYGNUS LOCAL: Just use tk
+ dirs="${srcdir}/../../../tk4.2* ${srcdir}/../../../tk"
+ TK_SRC_DIR="no-no"
+ for i in $dirs; do
+ if test -d $i; then
+ TK_SRC_DIR=`cd $i; pwd`
+ fi
+ done
+
+ if test ! -d $TK_SRC_DIR; then
+ AC_MSG_ERROR(Cannot locate Tk source directory in $dirs)
+ AC_MSG_ERROR(Please install the source code of Tk 4.2)
+ exit 1
+ fi
+fi
+AC_MSG_RESULT($TK_SRC_DIR)
+
+# CYGNUS LOCAL: This used to get TK_BIN_DIR from TK_SRC_DIR, which
+# only works when srcdir == objdir
+TK_BIN_DIR=../../../tk/unix
+
+#--------------------------------------------------------------------
+# Find out the top level source directory of the Tix package.
+#--------------------------------------------------------------------
+TIX_SRC_DIR=`cd ${srcdir}/../..; pwd`
+
+#--------------------------------------------------------------------
+# See if we should compile SAM
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(sam,
+ [ --enable-sam build stand-alone modules],
+ [ok=$enableval], [ok=no])
+
+if test "$ok" = "yes"; then
+ TIX_BUILD_SAM="yes"
+ TIX_SAM_TARGETS='$(SAM_TARGETS)'
+ TIX_SAM_INSTALL=_install_sam_
+else
+ TIX_BUILD_SAM="no"
+fi
+
+IS_ITCL=0
+ITCL_BUILD_LIB_SPEC=""
+ITK_BUILD_LIB_SPEC=""
+TIX_EXE_FILE=tixwish
+TCL_SAMEXE_FILE=satclsh
+TK_SAMEXE_FILE=sawish
+TIX_SAMEXE_FILE=satixwish
+
+#--------------------------------------------------------------------
+# 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
+CC=$TCL_CC
+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
+TIX_LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
+
+#--------------------------------------------------------------------
+# Read in configuration information generated by Tk and arrange
+# for it to be substituted into our Makefile.
+#--------------------------------------------------------------------
+file=$TK_BIN_DIR/tkConfig.sh
+. $file
+
+TIX_DEFS="$TK_DEFS $TCL_DEFS"
+
+# 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
+ TIX_BUILD_LIB_SPEC="-L`pwd` -ltix${VERSION}"
+ TIX_BUILD_SAM_SPEC="-L`pwd` -ltixsam${VERSION}"
+ TCL_BUILD_SAM_SPEC="-L`pwd` -ltclsam${TCL_VERSION}"
+ TK_BUILD_SAM_SPEC="-L`pwd` -ltksam${TK_VERSION}"
+ TIX_LIB_SPEC="-L${exec_prefix}/lib -ltix${VERSION}"
+else
+ TIX_BUILD_LIB_SPEC="-L`pwd` -ltix`echo ${VERSION} | tr -d .`"
+ TIX_BUILD_SAM_SPEC="-L`pwd` -ltixsam`echo ${VERSION} | tr -d .`"
+ TCL_BUILD_SAM_SPEC="-L`pwd` -ltclsam`echo ${TCL_VERSION} | tr -d .`"
+ TK_BUILD_SAM_SPEC="-L`pwd` -ltksam`echo ${TK_VERSION} | tr -d .`"
+ TIX_LIB_SPEC="-L${exec_prefix}/lib -ltix`echo ${VERSION} | tr -d .`"
+fi
+
+#--------------------------------------------------------------------
+# See if we should compile shared library.
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(shared,
+ [ --enable-shared build libtix as a shared library],
+ [ok=$enableval], [ok=no])
+
+if test "$ok" = "yes" -a "${SHLIB_SUFFIX}" != ""; then
+ TIX_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+ RANLIB=":"
+
+ # The main Tix library
+ #
+ eval "TIX_LIB_FILE=libtix${TCL_SHARED_LIB_SUFFIX}"
+ TIX_MAKE_LIB="\${SHLIB_LD} -o ${TIX_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tcl SAM library
+ #
+ VERSION=7.6
+ eval "TCL_SAM_FILE=libtclsam${TCL_SHARED_LIB_SUFFIX}"
+ TCL_MAKE_SAM="\${SHLIB_LD} -o ${TCL_SAM_FILE} \${TCL_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tk SAM library
+ #
+ VERSION=4.2
+ eval "TK_SAM_FILE=libtksam${TCL_SHARED_LIB_SUFFIX}"
+ TK_MAKE_SAM="\${SHLIB_LD} -o ${TK_SAM_FILE} \${TK_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tix SAM library
+ #
+ VERSION=${BIN_VERSION}
+ eval "TIX_SAM_FILE=libtixsam${TCL_SHARED_LIB_SUFFIX}"
+ TIX_MAKE_SAM="\${SHLIB_LD} -o ${TIX_SAM_FILE} \${TIX_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+else
+ TIX_SHLIB_CFLAGS=""
+
+ # The main Tix library
+ #
+ eval "TIX_LIB_FILE=libtix${TCL_UNSHARED_LIB_SUFFIX}"
+ TIX_MAKE_LIB="ar cr ${TIX_LIB_FILE} \${OBJS}"
+
+ # The Tcl SAM library
+
+ VERSION=7.6
+ eval "TCL_SAM_FILE=libtclsam${TCL_UNSHARED_LIB_SUFFIX}"
+ TCL_MAKE_SAM="ar cr ${TCL_SAM_FILE} \${TCL_SAM_OBJS}"
+
+ # The Tk SAM library
+ #
+ VERSION=4.2
+ eval "TK_SAM_FILE=libtksam${TCL_UNSHARED_LIB_SUFFIX}"
+ TK_MAKE_SAM="ar cr ${TK_SAM_FILE} \${TK_SAM_OBJS}"
+
+ # The Tix SAM library
+ #
+ VERSION=${BIN_VERSION}
+ eval "TIX_SAM_FILE=libtixsam${TCL_UNSHARED_LIB_SUFFIX}"
+ TIX_MAKE_SAM="ar cr ${TIX_SAM_FILE} \${TIX_SAM_OBJS}"
+fi
+
+
+#--------------------------------------------------------------------
+# Check for the existence of the -lsocket and -lnsl libraries.
+# The order here is important, so that they end up in the right
+# order in the command line generated by make. Here are some
+# special considerations:
+# 1. Use "connect" and "accept" to check for -lsocket, and
+# "gethostbyname" to check for -lnsl.
+# 2. Use each function name only once: can't redo a check because
+# autoconf caches the results of the last check and won't redo it.
+# 3. Use -lnsl and -lsocket only if they supply procedures that
+# aren't already present in the normal libraries. This is because
+# IRIX 5.2 has libraries, but they aren't needed and they're
+# bogus: they goof up name resolution if used.
+# 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+# To get around this problem, check for both libraries together
+# if -lsocket doesn't work by itself.
+#--------------------------------------------------------------------
+
+checked=0
+for i in $TK_LIBS; do
+ if test "$i" = "-lsocket"; then
+ checked=1
+ fi
+done
+
+if test "$checked" = "0"; then
+ tcl_checkBoth=0
+ AC_CHECK_FUNC(connect, tcl_checkSocket=0, tcl_checkSocket=1)
+ if test "$tcl_checkSocket" = 1; then
+ AC_CHECK_LIB(socket, main, TK_LIBS="$TK_LIBS -lsocket",
+ tcl_checkBoth=1)
+ fi
+ if test "$tcl_checkBoth" = 1; then
+ tk_oldLibs=$TK_LIBS
+ TK_LIBS="$TK_LIBS -lsocket -lnsl"
+ AC_CHECK_FUNC(accept, tcl_checkNsl=0, [TK_LIBS=$tk_oldLibs])
+ fi
+ AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main,
+ [TK_LIBS="$TK_LIBS -lnsl"]))
+fi
+
+#----------------------------------------------------------------------
+# Substitution strings exported by TIX
+#----------------------------------------------------------------------
+AC_SUBST(CC)
+AC_SUBST(RANLIB)
+AC_SUBST(SHLIB_CFLAGS)
+AC_SUBST(SHLIB_LD)
+AC_SUBST(SHLIB_LD_LIBS)
+AC_SUBST(SHLIB_SUFFIX)
+AC_SUBST(SHLIB_VERSION)
+AC_SUBST(DL_LIBS)
+AC_SUBST(LD_FLAGS)
+AC_SUBST(TCL_BUILD_LIB_SPEC)
+AC_SUBST(TCL_LIBS)
+AC_SUBST(TCL_VERSION)
+AC_SUBST(TCL_SRC_DIR)
+AC_SUBST(TCL_BIN_DIR)
+AC_SUBST(TK_BUILD_LIB_SPEC)
+AC_SUBST(TK_LIBS)
+AC_SUBST(TK_VERSION)
+AC_SUBST(TK_SRC_DIR)
+AC_SUBST(TK_BIN_DIR)
+AC_SUBST(TK_XINCLUDES)
+AC_SUBST(TIX_LD_SEARCH_FLAGS)
+AC_SUBST(TIX_MAJOR_VERSION)
+AC_SUBST(TIX_MINOR_VERSION)
+AC_SUBST(TIX_VERSION)
+AC_SUBST(TIX_SRC_DIR)
+AC_SUBST(TIX_SHLIB_CFLAGS)
+AC_SUBST(TIX_MAKE_LIB)
+AC_SUBST(TIX_LIB_FILE)
+AC_SUBST(TIX_BUILD_LIB_SPEC)
+AC_SUBST(TIX_LIB_SPEC)
+AC_SUBST(TIX_EXE_FILE)
+AC_SUBST(TIX_SAM_TARGETS)
+AC_SUBST(TIX_SAM_INSTALL)
+AC_SUBST(TCL_SAM_FILE)
+AC_SUBST(TCL_MAKE_SAM)
+AC_SUBST(TK_SAM_FILE)
+AC_SUBST(TK_MAKE_SAM)
+AC_SUBST(TIX_SAM_FILE)
+AC_SUBST(TIX_MAKE_SAM)
+AC_SUBST(TIX_DEFS)
+AC_SUBST(ITCL_BUILD_LIB_SPEC)
+AC_SUBST(ITK_BUILD_LIB_SPEC)
+AC_SUBST(TCL_SAMEXE_FILE)
+AC_SUBST(TK_SAMEXE_FILE)
+AC_SUBST(TIX_SAMEXE_FILE)
+AC_SUBST(TCL_BUILD_SAM_SPEC)
+AC_SUBST(TK_BUILD_SAM_SPEC)
+AC_SUBST(TIX_BUILD_SAM_SPEC)
+
+# The "binary version" of Tix (see docs/Pkg.txt)
+TIX_VERSION_PKG=${BIN_VERSION}
+AC_SUBST(TIX_VERSION_PKG)
+
+TIXSAM_PKG_FILE="[[file join [file dirname \$dir] ${TIX_SAM_FILE}]]"
+if test "$TIX_BUILD_SAM" = "yes"; then
+ TIX_SAM_PACKAGE_IFNEEDED="package ifneeded Tixsam ${TIX_VERSION_PKG} [[list load \"${TIXSAM_PKG_FILE}\" Tixsam]]"
+fi
+
+# The package file, usually a shared library
+TIX_PKG_FILE="[[file join [file dirname \$dir] ${TIX_LIB_FILE}]]"
+AC_SUBST(TIX_PKG_FILE)
+AC_SUBST(TIX_SAM_PACKAGE_IFNEEDED)
+
+AC_OUTPUT(Makefile pkgIndex.tcl)
+
diff --git a/tix/unix/tk4.2/pkgIndex.tcl.in b/tix/unix/tk4.2/pkgIndex.tcl.in
new file mode 100644
index 00000000000..fc82f9db9b6
--- /dev/null
+++ b/tix/unix/tk4.2/pkgIndex.tcl.in
@@ -0,0 +1,4 @@
+# Tcl package index file, version 1.0
+
+package ifneeded Tix @TIX_VERSION_PKG@ [list load "@TIX_PKG_FILE@" Tix]
+@TIX_SAM_PACKAGE_IFNEEDED@
diff --git a/tix/unix/tk4.2/tclUnixSam76.c b/tix/unix/tk4.2/tclUnixSam76.c
new file mode 100644
index 00000000000..e7c66e9565e
--- /dev/null
+++ b/tix/unix/tk4.2/tclUnixSam76.c
@@ -0,0 +1,26 @@
+/*
+ * tclUnixSam76.c --
+ *
+ * Initializes the Tcl stand-alone module Tcl version 7.6.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include "tclPort.h"
+#include "tclInt.h"
+
+#include "tclSamLib.c"
+
+int SamTcl_Init _ANSI_ARGS_((Tcl_Interp *interp));
+
+int
+Tclsam_Init(interp)
+ Tcl_Interp *interp; /* Interpreter to initialize. */
+{
+ Tcl_Eval(interp, "set tcl_library {}");
+ return LoadScripts(interp);
+}
diff --git a/tix/unix/tk4.2/tixAppInit.c b/tix/unix/tk4.2/tixAppInit.c
new file mode 100644
index 00000000000..69621043b2d
--- /dev/null
+++ b/tix/unix/tk4.2/tixAppInit.c
@@ -0,0 +1,112 @@
+/*
+ * tixAppInit.c --
+ *
+ * Provides a default version of the Tcl_AppInit procedure for
+ * use in wish and similar Tk-based applications.
+ *
+ * Copyright (c) 1995 Ioi K Lam
+ * 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.
+ */
+
+#include <tk.h>
+#include <tix.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;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ * This is the main program for the application.
+ *
+ * Results:
+ * None: Tk_Main never returns here, so this procedure never
+ * returns either.
+ *
+ * Side effects:
+ * Whatever the application does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+main(argc, argv)
+ int argc; /* Number of command-line arguments. */
+ char **argv; /* Values of command-line arguments. */
+{
+ Tk_Main(argc, argv, Tcl_AppInit);
+ return 0; /* Needed only to prevent compiler warning. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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, (Tcl_PackageInitProc *) NULL);
+ if (Tix_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tix", Tix_Init, (Tcl_PackageInitProc *) NULL);
+
+ /*
+ * Call the init procedures for included packages. Each call should
+ * look like this:
+ *
+ * if (Mod_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * where "Mod" is the name of the module.
+ */
+
+ /*
+ * Call Tcl_CreateCommand for application-specific commands, if
+ * they weren't already created by the init procedures called above.
+ */
+
+ /*
+ * Specify a user-specific startup file to invoke if the application
+ * is run interactively. Typically the startup file is "~/.apprc"
+ * where "app" is the name of the application. If this line is deleted
+ * then no user-specific startup file will be run under any conditions.
+ */
+ Tix_SetRcFileName(interp, "~/.tixwishrc");
+
+ return TCL_OK;
+}
diff --git a/tix/unix/tk4.2/tkUnixSam42.c b/tix/unix/tk4.2/tkUnixSam42.c
new file mode 100644
index 00000000000..00dfbe4ffed
--- /dev/null
+++ b/tix/unix/tk4.2/tkUnixSam42.c
@@ -0,0 +1,215 @@
+/*
+ * tkUnixSam42.c --
+ *
+ * Initializes the Tk stand-alone module Tk version 4.2.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tkPort.h>
+#include <tkInt.h>
+
+#if defined(__WIN32__) || defined(_WIN32)
+# define SAMTK_WINDOWS
+#else
+# if defined(MAC_TCL)
+# define SAMTK_MAC
+# else
+# define SAMTK_UNIX
+# include <tkUnixInt.h>
+# endif
+#endif
+
+int SamTk_Init _ANSI_ARGS_((Tcl_Interp *interp));
+
+#include "tkSamLib.c"
+
+static int
+SamTkPlatformInit(interp)
+ Tcl_Interp * interp;
+{
+#ifdef SAMTK_UNIX
+ TkCreateXEventSource();
+#endif
+ Tcl_Eval(interp, "set tk_library {}");
+ return LoadScripts(interp);
+}
+
+/*
+ * The variables and table below are used to parse arguments from
+ * the "argv" variable in Tk_Init.
+ */
+
+static int synchronize;
+static char *name;
+static char *display;
+static char *geometry;
+static char *colormap;
+static char *visual;
+static int rest = 0;
+
+static Tk_ArgvInfo argTable[] = {
+ {"-colormap", TK_ARGV_STRING, (char *) NULL, (char *) &colormap,
+ "Colormap for main window"},
+ {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
+ "Display to use"},
+ {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
+ "Initial geometry for window"},
+ {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
+ "Name to use for application"},
+ {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
+ "Use synchronous mode for display server"},
+ {"-visual", TK_ARGV_STRING, (char *) NULL, (char *) &visual,
+ "Visual for main window"},
+ {"--", TK_ARGV_REST, (char *) 1, (char *) &rest,
+ "Pass all remaining arguments through to script"},
+ {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
+ (char *) NULL}
+};
+
+int
+Tksam_Init(interp)
+ Tcl_Interp *interp; /* Interpreter to initialize. */
+{
+ char *p;
+ int argc, code;
+ char **argv, *args[20];
+ Tcl_DString class;
+ char buffer[30];
+
+ /*
+ * 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.
+ */
+
+ synchronize = 0;
+ name = display = geometry = colormap = visual = NULL;
+ 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;
+ }
+ p = Tcl_Merge(argc, argv);
+ Tcl_SetVar2(interp, "argv", (char *) NULL, p, TCL_GLOBAL_ONLY);
+ sprintf(buffer, "%d", argc);
+ Tcl_SetVar2(interp, "argc", (char *) NULL, buffer, TCL_GLOBAL_ONLY);
+ ckfree(p);
+ }
+
+ /*
+ * Figure out the application's name and class.
+ */
+
+ if (name == NULL) {
+ name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
+ if ((name == NULL) || (*name == 0)) {
+ name = "tk";
+ } else {
+ p = strrchr(name, '/');
+ if (p != NULL) {
+ name = p+1;
+ }
+ }
+ }
+ Tcl_DStringInit(&class);
+ Tcl_DStringAppend(&class, name, -1);
+ p = Tcl_DStringValue(&class);
+ if (islower(*p)) {
+ *p = toupper((unsigned char) *p);
+ }
+
+ /*
+ * Create an argument list for creating the top-level window,
+ * using the information parsed from argv, if any.
+ */
+
+ args[0] = "toplevel";
+ args[1] = ".";
+ args[2] = "-class";
+ args[3] = Tcl_DStringValue(&class);
+ argc = 4;
+ if (display != NULL) {
+ args[argc] = "-screen";
+ args[argc+1] = display;
+ argc += 2;
+
+ /*
+ * 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 (Tk_GetNumMainWindows() == 0) {
+ Tcl_SetVar2(interp, "env", "DISPLAY", display, TCL_GLOBAL_ONLY);
+ }
+ }
+ if (colormap != NULL) {
+ args[argc] = "-colormap";
+ args[argc+1] = colormap;
+ argc += 2;
+ }
+ if (visual != NULL) {
+ args[argc] = "-visual";
+ args[argc+1] = visual;
+ argc += 2;
+ }
+ args[argc] = NULL;
+ code = TkCreateFrame((ClientData) NULL, interp, argc, args, 1, name);
+ Tcl_DStringFree(&class);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ Tcl_ResetResult(interp);
+ if (synchronize) {
+ XSynchronize(Tk_Display(Tk_MainWindow(interp)), True);
+ }
+
+ /*
+ * Set the geometry of the main window, if requested. Put the
+ * requested geometry into the "geometry" variable.
+ */
+
+ if (geometry != NULL) {
+ Tcl_SetVar(interp, "geometry", geometry, TCL_GLOBAL_ONLY);
+ code = Tcl_VarEval(interp, "wm geometry . ", geometry, (char *) NULL);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ }
+ 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 = SamTkPlatformInit(interp);
+
+ done:
+ if (argv != NULL) {
+ ckfree((char *) argv);
+ }
+ return code;
+}
+
diff --git a/tix/unix/tk8.0/Makefile.in b/tix/unix/tk8.0/Makefile.in
new file mode 100644
index 00000000000..07c5c085fb1
--- /dev/null
+++ b/tix/unix/tk8.0/Makefile.in
@@ -0,0 +1,555 @@
+# Makefile --
+#
+# This file is a Makefile to compile Tix with Tk version
+# 8.0. 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.
+
+# CYGNUS LOCAL: Set VPATH.
+VPATH = @srcdir@
+srcdir = @srcdir@
+
+#----------------------------------------------------------------
+# Things you can change to personalize the Makefile for your own
+# site (you can make these changes in either Makefile.in or
+# Makefile, but changes to Makefile will get lost if you re-run
+# the configuration script).
+#----------------------------------------------------------------
+
+# Default top-level directories in which to install architecture-
+# specific files (exec_prefix) and machine-independent files such
+# as scripts (prefix). The values specified here may be overridden
+# at configure-time with the --exec-prefix and --prefix options
+# to the "configure" script.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+TIX_VERSION = @TIX_VERSION@
+
+@SET_MAKE@
+
+# Directory in which to install the library of Tix scripts and demos
+# (note: you can set the TIX_LIBRARY environment variable at run-time to
+# override the compiled-in location):
+TIX_LIBRARY = $(prefix)/share/tix$(TIX_VERSION)
+
+# Directory in which to install the archive libtix.a:
+LIB_DIR = $(exec_prefix)/lib
+LIB_INSTALL_DIR = $(LIB_DIR)
+LIB_RUNTIME_DIR = $(LIB_DIR)
+
+# Directory in which to install the program tixwish:
+BIN_DIR = $(exec_prefix)/bin
+
+# To change the compiler switches, for example to change from -O
+# to -g, change the following line:
+CFLAGS = -O
+
+# To disable ANSI-C procedure prototypes reverse the comment characters
+# on the following lines:
+PROTO_FLAGS =
+#PROTO_FLAGS = -DNO_PROTOTYPE
+
+# To enable memory debugging reverse the comment characters on the following
+# lines. Warning: if you enable memory debugging, you must do it
+# *everywhere*, including all the code that calls Tcl, and you must use
+# ckalloc and ckfree everywhere instead of malloc and free.
+MEM_DEBUG_FLAGS =
+#MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG
+
+# Some versions of make, like SGI's, use the following variable to
+# determine which shell to use for executing commands:
+SHELL = /bin/sh
+
+# Location of the Tcl 8.0 source directory.
+#
+TCL_SRC_DIR = @TCL_SRC_DIR@
+TCL_GENERIC_DIR = $(TCL_SRC_DIR)/generic
+TCL_BIN_DIR = @TCL_BIN_DIR@
+
+# Location of the Tk 8.0 source directory.
+#
+TK_SRC_DIR = @TK_SRC_DIR@
+TK_GENERIC_DIR = $(TK_SRC_DIR)/generic
+
+# Libraries to use when linking:
+LIBS = @ITK_BUILD_LIB_SPEC@ @ITCL_BUILD_LIB_SPEC@ \
+ @TK_BUILD_LIB_SPEC@ @TCL_BUILD_LIB_SPEC@ @TK_LIBS@
+
+# Libraries for building a stand-alone Tclsh.
+#
+LIBS_TCLONLY = @TCL_BUILD_LIB_SPEC@ @TCL_LIBS@
+
+RUN_TCLSH = TCL_LIBRARY=$(TCL_SRC_DIR)/library \
+ TK_LIBRARY=$(TK_SRC_DIR)/library \
+ $(TCL_BIN_DIR)/tclsh
+
+
+#----------------------------------------------------------------
+# 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.
+#----------------------------------------------------------------
+
+CC = @CC@
+
+SHLIB_CFLAGS = @SHLIB_CFLAGS@
+SHLIB_LD = @SHLIB_LD@
+SHLIB_SUFFIX = @SHLIB_SUFFIX@
+SHLIB_VERSION = @SHLIB_VERSION@
+TIX_SHLIB_CFLAGS = @TIX_SHLIB_CFLAGS@
+TK_XINCLUDES = @TK_XINCLUDES@
+
+ITCL_EXT =
+
+SRC_DIR = @TIX_SRC_DIR@
+GENERIC_DIR = $(SRC_DIR)/generic
+UNIX_DIR = $(SRC_DIR)/unix
+AC_FLAGS = @DEFS@ @TIX_DEFS@
+RANLIB = @RANLIB@
+TIX_RANLIB = @TIX_RANLIB@
+INSTALL = @TIX_SRC_DIR@/install.sh -c
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+TIX_LIB_FILE = @TIX_LIB_FILE@
+TIX_EXE_FILE = @TIX_EXE_FILE@
+TCL_SAM_FILE = @TCL_SAM_FILE@
+TK_SAM_FILE = @TK_SAM_FILE@
+TIX_SAM_FILE = @TIX_SAM_FILE@
+TCL_SAMEXE_FILE = @TCL_SAMEXE_FILE@
+TK_SAMEXE_FILE = @TK_SAMEXE_FILE@
+TIX_SAMEXE_FILE = @TIX_SAMEXE_FILE@
+
+INST_EXE = $(TIX_EXE_FILE)$(TIX_VERSION).8.0$(ITCL_EXT)
+INST_TIX_SAMEXE = $(TIX_SAMEXE_FILE)$(TIX_VERSION).8.0$(ITCL_EXT)
+INST_TK_SAMEXE = $(TK_SAMEXE_FILE)8.0
+INST_TCL_SAMEXE = $(TCL_SAMEXE_FILE)8.0
+
+SAM_TARGETS = $(TIX_SAM_FILE)
+
+TIX_SAM_TARGETS = @TIX_SAM_TARGETS@
+SAM_INSTALL = @TIX_SAM_INSTALL@
+
+ITCL_CFLAGS =
+
+CC_SWITCHES = $(CFLAGS) $(AC_FLAGS) -I$(TCL_GENERIC_DIR) \
+ -I$(TCL_SRC_DIR)/unix -I$(TK_GENERIC_DIR) -I$(TK_SRC_DIR)/unix \
+ $(ITCL_CFLAGS) \
+ -I$(GENERIC_DIR) -I$(UNIX_DIR) $(TK_XINCLUDES) $(TIX_SHLIB_CFLAGS)
+
+#----------------------------------------------------------------
+# The information below should be usable as is. You shouldn't need
+# to modify it.
+#----------------------------------------------------------------
+
+CORE_OBJS = \
+ tixClass.o \
+ tixCmds.o \
+ tixCompat.o \
+ tixError.o \
+ tixGeometry.o \
+ tixInit.o \
+ tixItcl.o \
+ tixList.o \
+ tixMethod.o \
+ tixOption.o \
+ tixScroll.o \
+ tixSmpLs.o \
+ tixUtils.o \
+ tixWidget.o
+
+DITEM_OBJS = \
+ tixDItem.o \
+ tixDiITxt.o \
+ tixDiImg.o \
+ tixDiStyle.o \
+ tixDiText.o \
+ tixDiWin.o
+
+MANAGER_OBJS = \
+ tixForm.o \
+ tixFormMisc.o
+
+WIDGET_OBJS = \
+ tixGrid.o \
+ tixGrData.o \
+ tixGrFmt.o \
+ tixGrRC.o \
+ tixGrSel.o \
+ tixGrSort.o \
+ tixGrUtl.o \
+ tixHList.o \
+ tixHLCol.o \
+ tixHLInd.o \
+ tixHLHdr.o \
+ tixInputO.o \
+ tixNBFrame.o \
+ tixTList.o
+
+MISC_OBJS = \
+ tixImgCmp.o \
+ tixImgXpm.o \
+ tixMwm.o
+
+UNIX_OBJS = \
+ tixUnixDraw.o \
+ tixUnixXpm.o \
+ tixUnixWm.o
+
+OBJS = $(CORE_OBJS) $(DITEM_OBJS) $(MANAGER_OBJS) $(MISC_OBJS) \
+ $(WIDGET_OBJS) $(UNIX_OBJS)
+
+TCL_SAM_OBJS = \
+ tclUnixSam80.o
+
+TK_SAM_OBJS = \
+ tkUnixSam80.o
+
+TIX_SAM_OBJS = \
+ $(OBJS) tixUnixSam.o
+
+#----------------------------------------------------------------------
+# These are the scripts that we'll compile into the SAM's. The
+# scripts of TK must be included in the fixed order.
+#----------------------------------------------------------------------
+
+TCL_SCRIPTS = $(TCL_SRC_DIR)/library/*.tcl
+
+TK_SCRIPTS = \
+ $(TK_SRC_DIR)/library/bgerror.tcl \
+ $(TK_SRC_DIR)/library/dialog.tcl \
+ $(TK_SRC_DIR)/library/focus.tcl \
+ $(TK_SRC_DIR)/library/obsolete.tcl \
+ $(TK_SRC_DIR)/library/optMenu.tcl \
+ $(TK_SRC_DIR)/library/palette.tcl \
+ $(TK_SRC_DIR)/library/tearoff.tcl \
+ $(TK_SRC_DIR)/library/clrpick.tcl \
+ $(TK_SRC_DIR)/library/comdlg.tcl \
+ $(TK_SRC_DIR)/library/msgbox.tcl \
+ $(TK_SRC_DIR)/library/tkfbox.tcl \
+ $(TK_SRC_DIR)/library/xmfbox.tcl \
+ $(SRC_DIR)/generic/tk4.2/tk.tcl \
+ $(TK_SRC_DIR)/library/button.tcl \
+ $(TK_SRC_DIR)/library/entry.tcl \
+ $(TK_SRC_DIR)/library/listbox.tcl \
+ $(TK_SRC_DIR)/library/menu.tcl \
+ $(TK_SRC_DIR)/library/scale.tcl \
+ $(TK_SRC_DIR)/library/scrlbar.tcl \
+ $(TK_SRC_DIR)/library/text.tcl \
+ $(SRC_DIR)/generic/tk8.0/console.tcl
+
+TIX_SCRIPTS = \
+ $(SRC_DIR)/library/pref/*.fsc \
+ $(SRC_DIR)/library/pref/*.csc \
+ $(SRC_DIR)/library/*.tcl
+
+all: $(TIX_LIB_FILE) $(TIX_EXE_FILE) @TIX_SAM_TARGETS@
+
+$(TIX_LIB_FILE): $(OBJS)
+ rm -f $(TIX_LIB_FILE)
+ @TIX_MAKE_LIB@
+ $(TIX_RANLIB) $(TIX_LIB_FILE)
+
+$(TCL_SAM_FILE): $(TCL_SAM_OBJS)
+ rm -f $(TCL_SAM_FILE)
+ @TCL_MAKE_SAM@
+ $(TIX_RANLIB) $(TCL_SAM_FILE)
+
+$(TK_SAM_FILE): $(TK_SAM_OBJS)
+ rm -f $(TK_SAM_FILE)
+ @TK_MAKE_SAM@
+ $(TIX_RANLIB) $(TK_SAM_FILE)
+
+$(TIX_SAM_FILE): $(TIX_SAM_OBJS)
+ rm -f $(TIX_SAM_FILE)
+ @TIX_MAKE_SAM@
+ $(TIX_RANLIB) $(TIX_SAM_FILE)
+
+$(TIX_EXE_FILE): tixAppInit.o $(TIX_LIB_FILE) @TCL_LIB_FULL_PATH@ \
+ @TK_LIB_FULL_PATH@ @ITCL_LIB_FULL_PATH@
+ $(CC) @LD_FLAGS@ tixAppInit.o @TIX_BUILD_LIB_SPEC@ $(LIBS) \
+ @TIX_LD_SEARCH_FLAGS@ -o $(TIX_EXE_FILE)
+
+$(TCL_SAMEXE_FILE): $(UNIX_DIR)/samAppInit.c $(TCL_SAM_FILE)
+ $(CC) $(CC_SWITCHES) @LD_FLAGS@ -DUSE_TCL $(UNIX_DIR)/samAppInit.c \
+ @TCL_BUILD_SAM_SPEC@ $(LIBS_TCLONLY) \
+ @TIX_LD_SEARCH_FLAGS@ -o $(TCL_SAMEXE_FILE)
+
+$(TK_SAMEXE_FILE): $(UNIX_DIR)/samAppInit.c $(TCL_SAM_FILE) $(TK_SAM_FILE) \
+ @TCL_LIB_FULL_PATH@ @TK_LIB_FULL_PATH@ @ITCL_LIB_FULL_PATH@
+ $(CC) $(CC_SWITCHES) @LD_FLAGS@ -DUSE_TK $(UNIX_DIR)/samAppInit.c \
+ @TK_BUILD_SAM_SPEC@ @TCL_BUILD_SAM_SPEC@ $(LIBS) \
+ @TIX_LD_SEARCH_FLAGS@ -o $(TK_SAMEXE_FILE)
+
+$(TIX_SAMEXE_FILE): $(UNIX_DIR)/samAppInit.c $(TCL_SAM_FILE) $(TK_SAM_FILE) \
+ $(TIX_SAM_FILE) @TCL_LIB_FULL_PATH@ @TK_LIB_FULL_PATH@ \
+ @ITCL_LIB_FULL_PATH@
+ $(CC) $(CC_SWITCHES) @LD_FLAGS@ -DUSE_TIX $(UNIX_DIR)/samAppInit.c \
+ @TIX_BUILD_SAM_SPEC@ \
+ @TK_BUILD_SAM_SPEC@ @TCL_BUILD_SAM_SPEC@ \
+ $(LIBS) \
+ @TIX_LD_SEARCH_FLAGS@ -o $(TIX_SAMEXE_FILE)
+
+
+#----------------------------------------------------------------------
+#
+# .o file rules
+#
+#----------------------------------------------------------------------
+tixAppInit.o : tixAppInit.c
+ $(CC) -c $(CC_SWITCHES) $(srcdir)/tixAppInit.c
+
+tixClass.o : $(GENERIC_DIR)/tixClass.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixClass.c
+
+tixCmds.o: $(GENERIC_DIR)/tixCmds.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixCmds.c
+
+tixCompat.o: $(GENERIC_DIR)/tixCompat.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixCompat.c
+
+tixDItem.o: $(GENERIC_DIR)/tixDItem.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDItem.c
+
+tixDiImg.o: $(GENERIC_DIR)/tixDiImg.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiImg.c
+
+tixDiITxt.o: $(GENERIC_DIR)/tixDiITxt.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiITxt.c
+
+tixDiStyle.o: $(GENERIC_DIR)/tixDiStyle.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiStyle.c
+
+tixDiText.o: $(GENERIC_DIR)/tixDiText.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiText.c
+
+tixDiWin.o: $(GENERIC_DIR)/tixDiWin.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiWin.c
+
+tixError.o: $(GENERIC_DIR)/tixError.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixError.c
+
+tixForm.o: $(GENERIC_DIR)/tixForm.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixForm.c
+
+tixFormMisc.o: $(GENERIC_DIR)/tixFormMisc.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixFormMisc.c
+
+tixGeometry.o: $(GENERIC_DIR)/tixGeometry.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGeometry.c
+
+tixGrid.o: $(GENERIC_DIR)/tixGrid.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrid.c
+
+tixGrData.o: $(GENERIC_DIR)/tixGrData.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrData.c
+
+tixGrFmt.o: $(GENERIC_DIR)/tixGrFmt.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrFmt.c
+
+tixGrRC.o: $(GENERIC_DIR)/tixGrRC.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrRC.c
+
+tixGrSel.o: $(GENERIC_DIR)/tixGrSel.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrSel.c
+
+tixGrSort.o: $(GENERIC_DIR)/tixGrSort.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrSort.c
+
+tixGrUtl.o: $(GENERIC_DIR)/tixGrUtl.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrUtl.c
+
+tixHLCol.o: $(GENERIC_DIR)/tixHLCol.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixHLCol.c
+
+tixHLHdr.o: $(GENERIC_DIR)/tixHLHdr.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixHLHdr.c
+
+tixHLInd.o: $(GENERIC_DIR)/tixHLInd.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixHLInd.c
+
+tixHList.o: $(GENERIC_DIR)/tixHList.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixHList.c
+
+tixImgCmp.o: $(GENERIC_DIR)/tixImgCmp.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixImgCmp.c
+
+tixImgXpm.o: $(GENERIC_DIR)/tixImgXpm.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixImgXpm.c
+
+tixInit.o: $(GENERIC_DIR)/tixInit.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixInit.c
+
+tixItcl.o: $(GENERIC_DIR)/tixItcl.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixItcl.c
+
+tixInputO.o : $(GENERIC_DIR)/tixInputO.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixInputO.c
+
+tixList.o: $(GENERIC_DIR)/tixList.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixList.c
+
+tixMethod.o : $(GENERIC_DIR)/tixMethod.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixMethod.c
+
+tixMwm.o: $(GENERIC_DIR)/tixMwm.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixMwm.c
+
+tixNBFrame.o: $(GENERIC_DIR)/tixNBFrame.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixNBFrame.c
+
+tixOption.o: $(GENERIC_DIR)/tixOption.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixOption.c
+
+tixSmpLs.o: $(GENERIC_DIR)/tixSmpLs.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixSmpLs.c
+
+tixScroll.o: $(GENERIC_DIR)/tixScroll.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixScroll.c
+
+tixTList.o: $(GENERIC_DIR)/tixTList.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixTList.c
+
+tixUtils.o: $(GENERIC_DIR)/tixUtils.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixUtils.c
+
+tixWidget.o: $(GENERIC_DIR)/tixWidget.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixWidget.c
+
+tixUnixDraw.o: $(UNIX_DIR)/tixUnixDraw.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tixUnixDraw.c
+
+tixUnixXpm.o: $(UNIX_DIR)/tixUnixXpm.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tixUnixXpm.c
+
+tixUnixWm.o: $(UNIX_DIR)/tixUnixWm.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tixUnixWm.c
+
+#
+# Dependence rules for SAM
+#
+tclUnixSam80.o: tclUnixSam80.c tclSamLib.c
+ $(CC) -c $(CC_SWITCHES) tclUnixSam80.c
+
+tclSamLib.c:
+ $(RUN_TCLSH) $(SRC_DIR)/tools/tclc.tcl $(TCL_SCRIPTS) \
+ > tclSamLib.c
+
+tkUnixSam80.o: tkUnixSam80.c tkSamLib.c
+ $(CC) -c $(CC_SWITCHES) tkUnixSam80.c
+
+tkSamLib.c:
+ $(RUN_TCLSH) $(SRC_DIR)/tools/tclc.tcl $(TK_SCRIPTS) \
+ > tkSamLib.c
+
+tixUnixSam.o: $(UNIX_DIR)/tixUnixSam.c tixSamLib.c
+ $(CC) -c -I. $(CC_SWITCHES) $(UNIX_DIR)/tixUnixSam.c
+
+tixSamLib.c:
+ $(RUN_TCLSH) $(SRC_DIR)/tools/tclc.tcl $(TIX_SCRIPTS) \
+ > tixSamLib.c
+
+
+tests: $(TIX_EXE_FILE)
+ TCL_LIBRARY=$(TCL_SRC_DIR)/library TK_LIBRARY=$(TK_SRC_DIR)/library \
+ ITCL_LIBRARY=$(ITCL_SRC_DIR)/library \
+ ITK_LIBRARY=$(ITK_SRC_DIR)/library \
+ IWIDGETS_LIBRARY=$(ITCL_ROOT_DIR)/$(IWIDGETS) \
+ TIX_LIBRARY=$(SRC_DIR)/library \
+ LD_LIBRARY_PATH=${LD_LIBRARY_PATH}:. \
+ ./$(TIX_EXE_FILE) $(SRC_DIR)/tests/Driver.tcl
+
+sa-tests: $(TIX_SAMEXE_FILE)
+ ./$(TIX_SAMEXE_FILE) $(SRC_DIR)/tests/Driver.tcl
+
+#----------------------------------------------------------------------
+#
+# INSTALLATION
+#
+#----------------------------------------------------------------------
+_install_: $(TIX_LIB_FILE) $(TIX_EXE_FILE) $(SAM_INSTALL)
+ @for i in $(LIB_DIR) $(BIN_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing $(TIX_LIB_FILE) as $(LIB_DIR)/$(TIX_LIB_FILE)"
+ @$(INSTALL_DATA) $(TIX_LIB_FILE) $(LIB_DIR)/$(TIX_LIB_FILE)
+ @echo "Installing $(TIX_EXE_FILE) as $(BIN_DIR)/$(INST_EXE)"
+ @$(INSTALL_DATA) $(TIX_EXE_FILE) $(BIN_DIR)/$(INST_EXE)
+
+_install_sam_exe_: $(SAM_TARGETS)
+ @for i in $(LIB_DIR) $(BIN_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing $(TK_SAM_FILE) as $(LIB_DIR)/$(TK_SAM_FILE)"
+ @$(INSTALL_DATA) $(TK_SAM_FILE) $(LIB_DIR)/$(TK_SAM_FILE)
+ @echo "Installing $(TCL_SAM_FILE) as $(LIB_DIR)/$(TCL_SAM_FILE)"
+ @$(INSTALL_DATA) $(TCL_SAM_FILE) $(LIB_DIR)/$(TCL_SAM_FILE)
+ @echo ""
+ @echo "Installing $(TIX_SAMEXE_FILE) as $(BIN_DIR)/$(INST_TIX_SAMEXE)"
+ @$(INSTALL_PROGRAM) $(TIX_SAMEXE_FILE) $(BIN_DIR)/$(INST_TIX_SAMEXE)
+ @echo "Installing $(TK_SAMEXE_FILE) as $(BIN_DIR)/$(INST_TK_SAMEXE)"
+ @$(INSTALL_PROGRAM) $(TK_SAMEXE_FILE) $(BIN_DIR)/$(INST_TK_SAMEXE)
+ @echo "Installing $(TCL_SAMEXE_FILE) as $(BIN_DIR)/$(INST_TCL_SAMEXE)"
+ @$(INSTALL_PROGRAM) $(TCL_SAMEXE_FILE) $(BIN_DIR)/$(INST_TCL_SAMEXE)
+
+_install_sam_lib_: $(SAM_TARGETS)
+ @for i in $(LIB_DIR) $(BIN_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing $(TIX_SAM_FILE) as $(LIB_DIR)/$(TIX_SAM_FILE)"
+ @$(INSTALL_DATA) $(TIX_SAM_FILE) $(LIB_DIR)/$(TIX_SAM_FILE)
+
+
+install: _install_
+ @echo The binary files have been installed.
+ @echo You probably need to make install in the parent directory
+ @echo to install other files.
+
+sam_clean:
+ rm -f tixSamLib.c $(UNIX_DIR)/tixBitmaps.c
+
+clean:
+ rm -f *.so *.a *.o *_s.o core errs *~ \#* TAGS *.E sta* \
+ a.out errors $(TIX_EXE_FILE) $(TIX_LIB_FILE) *.bak \
+ $(SAM_TARGETS) tclSamLib.c tkSamLib.c
+
+distclean: clean
+ rm -f Makefile config.* lib.exp
+
+depend:
+ makedepend -- $(CC_SWITCHES) -- $(SRCS)
+
+# CYGNUS LOCAL: Makefile depends upon config.status
+Makefile: Makefile.in config.status
+ ./config.status
+
+.c.o:
+ $(CC) -c $(CC_SWITCHES) $<
+
+# CYGNUS LOCAL: Rebuild config.status when appropriate.
+config.status: configure
+ $(SHELL) config.status --recheck
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
+
diff --git a/tix/unix/tk8.0/configure b/tix/unix/tk8.0/configure
new file mode 100755
index 00000000000..fc8be4b47cc
--- /dev/null
+++ b/tix/unix/tk8.0/configure
@@ -0,0 +1,2163 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+ac_help="$ac_help
+ --enable-gcc allow use of gcc if available"
+ac_help="$ac_help
+ --with-tcl=DIR use Tcl 8.0 source from DIR"
+ac_help="$ac_help
+ --with-tk=DIR use Tk 8.0 source from DIR"
+ac_help="$ac_help
+ --enable-sam build stand-alone modules"
+ac_help="$ac_help
+ --enable-shared build libtix as a shared library"
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.13"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=../../generic/tixInit.c
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+
+#--------------------------------------------------------------------
+# Remove the ./config.cache file and rerun configure if
+# the cache file belong to a different architecture
+#
+# This doesn't seem to work in the Cygnus environment,
+# it causes an error message about having more than
+# one target, so I disabled it. meissner@cygnus.com
+#----------------------------------------------------------------------
+#AC_CHECK_PROG(UNAME, uname -a, [uname -a], "")
+#if test "$UNAME" = ""; then
+# AC_CHECK_PROG(UNAME, uname, [uname], "")
+#fi
+#
+#if test "$UNAME" != ""; then
+# uname=`$UNAME`
+# AC_MSG_CHECKING([cached value of \$uname])
+# AC_CACHE_VAL(ac_cv_prog_uname, [nocached=1 ac_cv_prog_uname=`$UNAME`])
+# if test "$nocached" = "1"; then
+# AC_MSG_RESULT(no)
+# else
+# AC_MSG_RESULT(yes)
+# fi
+#
+# if test "$uname" != "$ac_cv_prog_uname"; then
+# echo "Running on a different machine/architecture. Can't use cached values"
+# echo "Removing config.cache and running configure again ..."
+# rm -f config.cache
+# CMDLINE="$0 $*"
+# exec $CMDLINE
+# fi
+#fi
+
+#----------------------------------------------------------------------
+# We don't want to use any relative path because we need to generate
+# Makefile's in subdirectories
+#----------------------------------------------------------------------
+if test "$INSTALL" = "./install.sh"; then
+ INSTALL=`pwd`/install.sh
+fi
+
+#--------------------------------------------------------------------
+# Version information about this TIX release.
+#--------------------------------------------------------------------
+
+TIX_VERSION=4.1
+TIX_MAJOR_VERSION=4
+TIX_MINOR_VERSION=1
+
+BIN_VERSION=${TIX_VERSION}.8.0
+
+
+VERSION=${BIN_VERSION}
+
+#--------------------------------------------------------------------
+# See if user wants to use gcc to compile Tix. This option must
+# be used before any checking that uses the C compiler.
+#--------------------------------------------------------------------
+
+# Check whether --enable-gcc or --disable-gcc was given.
+if test "${enable_gcc+set}" = set; then
+ enableval="$enable_gcc"
+ tix_ok=$enableval
+else
+ tix_ok=no
+fi
+
+if test "$tix_ok" = "yes"; then
+ # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:606: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:636: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_prog_rejected=no
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -z "$CC"; then
+ case "`uname -s`" in
+ *win32* | *WIN32*)
+ # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:687: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="cl"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+ ;;
+ esac
+ fi
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:719: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 730 "configure"
+#include "confdefs.h"
+
+main(){return(0);}
+EOF
+if { (eval echo configure:735: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cc_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:761: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:766: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:775: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gcc=yes
+else
+ ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+else
+ GCC=
+fi
+
+ac_test_CFLAGS="${CFLAGS+set}"
+ac_save_CFLAGS="$CFLAGS"
+CFLAGS=
+echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:794: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+
+else
+ CC=${CC-cc}
+
+fi
+
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:861: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ # Account for people who put trailing slashes in PATH elements.
+ case "$ac_dir/" in
+ /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ if test -f $ac_dir/$ac_prog; then
+ if test $ac_prog = install &&
+ grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ else
+ ac_cv_path_install="$ac_dir/$ac_prog -c"
+ break 2
+ fi
+ fi
+ done
+ ;;
+ esac
+ done
+ IFS="$ac_save_IFS"
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL="$ac_cv_path_install"
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL="$ac_install_sh"
+ fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+# Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:916: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_RANLIB="ranlib"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:944: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # This must be in double quotes, not single quotes, because CPP may get
+ # substituted into the Makefile and "${CC-cc}" will confuse make.
+ CPP="${CC-cc} -E"
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp.
+ cat > conftest.$ac_ext <<EOF
+#line 959 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:965: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -E -traditional-cpp"
+ cat > conftest.$ac_ext <<EOF
+#line 976 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:982: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -nologo -E"
+ cat > conftest.$ac_ext <<EOF
+#line 993 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:999: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+ ac_cv_prog_CPP="$CPP"
+fi
+ CPP="$ac_cv_prog_CPP"
+else
+ ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+for ac_hdr in unistd.h limits.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:1027: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1032 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1037: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6
+echo "configure:1064: checking whether ${MAKE-make} sets \${MAKE}" >&5
+set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftestmake <<\EOF
+all:
+ @echo 'ac_maketemp="${MAKE}"'
+EOF
+# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=`
+if test -n "$ac_maketemp"; then
+ eval ac_cv_prog_make_${ac_make}_set=yes
+else
+ eval ac_cv_prog_make_${ac_make}_set=no
+fi
+rm -f conftestmake
+fi
+if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ SET_MAKE=
+else
+ echo "$ac_t""no" 1>&6
+ SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+
+#--------------------------------------------------------------------
+# unsigned char is not supported by some non-ANSI compilers.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking unsigned char""... $ac_c" 1>&6
+echo "configure:1096: checking unsigned char" >&5
+cat > conftest.$ac_ext <<EOF
+#line 1098 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+int main() {
+
+ unsigned char c = 'c';
+
+; return 0; }
+EOF
+if { (eval echo configure:1107: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ tcl_ok=supported
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ tcl_ok=notsupported
+fi
+rm -f conftest*
+
+echo "$ac_t""$tcl_ok" 1>&6
+if test $tcl_ok = supported; then
+ cat >> confdefs.h <<\EOF
+#define UCHAR_SUPPORTED 1
+EOF
+
+fi
+
+#--------------------------------------------------------------------
+# Check whether there is an strcasecmp function on this system.
+# This is a bit tricky because under SCO it's in -lsocket and
+# under Sequent Dynix it's in -linet.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for strcasecmp""... $ac_c" 1>&6
+echo "configure:1133: checking for strcasecmp" >&5
+if eval "test \"`echo '$''{'ac_cv_func_strcasecmp'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1138 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char strcasecmp(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char strcasecmp();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_strcasecmp) || defined (__stub___strcasecmp)
+choke me
+#else
+strcasecmp();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1161: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_strcasecmp=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_strcasecmp=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'strcasecmp`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_ok=1
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+if test "$tcl_ok" = 0; then
+ echo $ac_n "checking for strcasecmp in -lsocket""... $ac_c" 1>&6
+echo "configure:1183: checking for strcasecmp in -lsocket" >&5
+ac_lib_var=`echo socket'_'strcasecmp | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lsocket $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1191 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char strcasecmp();
+
+int main() {
+strcasecmp()
+; return 0; }
+EOF
+if { (eval echo configure:1202: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_ok=1
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+fi
+if test "$tcl_ok" = 0; then
+ echo $ac_n "checking for strcasecmp in -linet""... $ac_c" 1>&6
+echo "configure:1226: checking for strcasecmp in -linet" >&5
+ac_lib_var=`echo inet'_'strcasecmp | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-linet $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1234 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char strcasecmp();
+
+int main() {
+strcasecmp()
+; return 0; }
+EOF
+if { (eval echo configure:1245: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_ok=1
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+fi
+if test "$tcl_ok" = 0; then
+ cat >> confdefs.h <<\EOF
+#define NO_STRCASECMP 1
+EOF
+
+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.
+#--------------------------------------------------------------------
+
+# Check whether --with-tcl or --without-tcl was given.
+if test "${with_tcl+set}" = set; then
+ withval="$with_tcl"
+ val=$withval
+else
+ val=""
+fi
+
+
+echo $ac_n "checking Tcl source directory""... $ac_c" 1>&6
+echo "configure:1289: checking Tcl source directory" >&5
+
+if test "$val" != ""; then
+ TCL_SRC_DIR=$val
+ if test ! -d $TCL_SRC_DIR; then
+ { echo "configure: error: Directory $TCL_SRC_DIR doesn't exist" 1>&2; exit 1; }
+ { echo "configure: error: Please install the source code of Tcl 8.0" 1>&2; exit 1; }
+ exit 1
+ fi
+else
+ # CYGNUS LOCAL: Just use tcl.
+ dirs="${srcdir}/../../../tcl8.0* ${srcdir}/../../../tcl"
+ TCL_SRC_DIR="no-no"
+ for i in $dirs; do
+ if test -d $i; then
+ TCL_SRC_DIR=`cd $i; pwd`
+ fi
+ done
+
+ if test ! -d $TCL_SRC_DIR; then
+ { echo "configure: error: Cannot locate Tcl source directory in $dirs" 1>&2; exit 1; }
+ { echo "configure: error: Please install the source code of Tcl 8.0" 1>&2; exit 1; }
+ exit 1
+ fi
+fi
+echo "$ac_t""$TCL_SRC_DIR" 1>&6
+
+# CYGNUS LOCAL: This used to get TCL_BIN_DIR from TCL_SRC_DIR, which
+# only works when srcdir == objdir
+TCL_BIN_DIR=../../../tcl/unix
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Tk is; if
+# not, assume that its top-level directory is a sibling of ours.
+#--------------------------------------------------------------------
+
+# Check whether --with-tk or --without-tk was given.
+if test "${with_tk+set}" = set; then
+ withval="$with_tk"
+ val=$withval
+else
+ val=""
+fi
+
+
+echo $ac_n "checking Tk source directory""... $ac_c" 1>&6
+echo "configure:1335: checking Tk source directory" >&5
+
+if test "$val" != ""; then
+ TK_SRC_DIR=$val
+ if test ! -d $TK_SRC_DIR; then
+ { echo "configure: error: Directory $TK_SRC_DIR doesn't exist" 1>&2; exit 1; }
+ { echo "configure: error: Please install the source code of Tk 8.0" 1>&2; exit 1; }
+ exit 1
+ fi
+else
+ # CYGNUS LOCAL: Just use tk
+ dirs="${srcdir}/../../../tk8.0* ${srcdir}/../../../tk"
+ TK_SRC_DIR="no-no"
+ for i in $dirs; do
+ if test -d $i; then
+ TK_SRC_DIR=`cd $i; pwd`
+ fi
+ done
+
+ if test ! -d $TK_SRC_DIR; then
+ { echo "configure: error: Cannot locate Tk source directory in $dirs" 1>&2; exit 1; }
+ { echo "configure: error: Please install the source code of Tk 8.0" 1>&2; exit 1; }
+ exit 1
+ fi
+fi
+echo "$ac_t""$TK_SRC_DIR" 1>&6
+
+# CYGNUS LOCAL: This used to get TK_BIN_DIR from TK_SRC_DIR, which
+# only works when srcdir == objdir
+TK_BIN_DIR=../../../tk/unix
+
+#--------------------------------------------------------------------
+# Find out the top level source directory of the Tix package.
+#--------------------------------------------------------------------
+TIX_SRC_DIR=`cd ${srcdir}/../..; pwd`
+
+#--------------------------------------------------------------------
+# See if we should compile SAM
+#--------------------------------------------------------------------
+
+# Check whether --enable-sam or --disable-sam was given.
+if test "${enable_sam+set}" = set; then
+ enableval="$enable_sam"
+ ok=$enableval
+else
+ ok=no
+fi
+
+
+if test "$ok" = "yes"; then
+ TIX_BUILD_SAM="yes"
+ TIX_SAM_TARGETS='$(SAM_TARGETS)'
+else
+ TIX_BUILD_SAM="no"
+fi
+
+ TIX_SAM_INSTALL=_install_sam_lib_
+
+IS_ITCL=0
+ITCL_BUILD_LIB_SPEC=""
+ITK_BUILD_LIB_SPEC=""
+TIX_EXE_FILE=tixwish
+TCL_SAMEXE_FILE=satclsh
+TK_SAMEXE_FILE=sawish
+TIX_SAMEXE_FILE=satixwish
+
+#--------------------------------------------------------------------
+# 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
+CC=$TCL_CC
+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
+TIX_LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
+
+#--------------------------------------------------------------------
+# Read in configuration information generated by Tk and arrange
+# for it to be substituted into our Makefile.
+#--------------------------------------------------------------------
+file=$TK_BIN_DIR/tkConfig.sh
+. $file
+
+TIX_DEFS="$TK_DEFS $TCL_DEFS"
+
+# 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.
+
+TIX_BUILD_LOCATION="`pwd`"
+if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
+ TIX_BUILD_LIB_SPEC="-L`pwd` -ltix${VERSION}"
+ TIX_BUILD_SAM_SPEC="-L`pwd` -ltixsam${VERSION}"
+ TCL_BUILD_SAM_SPEC="-L`pwd` -ltclsam${TCL_VERSION}"
+ TK_BUILD_SAM_SPEC="-L`pwd` -ltksam${TK_VERSION}"
+ TIX_LIB_SPEC="-L${exec_prefix}/lib -ltix${VERSION}"
+else
+ TIX_BUILD_LIB_SPEC="-L`pwd` -ltix`echo ${VERSION} | tr -d .`"
+ TIX_BUILD_SAM_SPEC="-L`pwd` -ltixsam`echo ${VERSION} | tr -d .`"
+ TCL_BUILD_SAM_SPEC="-L`pwd` -ltclsam`echo ${TCL_VERSION} | tr -d .`"
+ TK_BUILD_SAM_SPEC="-L`pwd` -ltksam`echo ${TK_VERSION} | tr -d .`"
+ TIX_LIB_SPEC="-L${exec_prefix}/lib -ltix`echo ${VERSION} | tr -d .`"
+fi
+
+#--------------------------------------------------------------------
+# See if we should compile shared library.
+#--------------------------------------------------------------------
+
+# Check whether --enable-shared or --disable-shared was given.
+if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ ok=$enableval
+else
+ ok=no
+fi
+
+
+if test "$ok" = "yes" -a "${SHLIB_SUFFIX}" != ""; then
+ TIX_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+ TIX_RANLIB=":"
+
+ # The main Tix library
+ #
+ eval "TIX_LIB_FILE=libtix${TCL_SHARED_LIB_SUFFIX}"
+ TIX_MAKE_LIB="\${SHLIB_LD} -o ${TIX_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tcl SAM library
+ #
+ VERSION=8.0
+ eval "TCL_SAM_FILE=libtclsam${TCL_SHARED_LIB_SUFFIX}"
+ TCL_MAKE_SAM="\${SHLIB_LD} -o ${TCL_SAM_FILE} \${TCL_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tk SAM library
+ #
+ VERSION=8.0
+ eval "TK_SAM_FILE=libtksam${TCL_SHARED_LIB_SUFFIX}"
+ TK_MAKE_SAM="\${SHLIB_LD} -o ${TK_SAM_FILE} \${TK_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tix SAM library
+ #
+ VERSION=${BIN_VERSION}
+ eval "TIX_SAM_FILE=libtixsam${TCL_SHARED_LIB_SUFFIX}"
+ TIX_MAKE_SAM="\${SHLIB_LD} -o ${TIX_SAM_FILE} \${TIX_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+else
+ TIX_SHLIB_CFLAGS=""
+ TIX_RANLIB='$(RANLIB)'
+
+ # The main Tix library
+ #
+ eval "TIX_LIB_FILE=libtix${TCL_UNSHARED_LIB_SUFFIX}"
+ TIX_MAKE_LIB="ar cr ${TIX_LIB_FILE} \${OBJS}"
+
+ # The Tcl SAM library
+
+ VERSION=8.0
+ eval "TCL_SAM_FILE=libtclsam${TCL_UNSHARED_LIB_SUFFIX}"
+ TCL_MAKE_SAM="ar cr ${TCL_SAM_FILE} \${TCL_SAM_OBJS}"
+
+ # The Tk SAM library
+ #
+ VERSION=8.0
+ eval "TK_SAM_FILE=libtksam${TCL_UNSHARED_LIB_SUFFIX}"
+ TK_MAKE_SAM="ar cr ${TK_SAM_FILE} \${TK_SAM_OBJS}"
+
+ # The Tix SAM library
+ #
+ VERSION=${BIN_VERSION}
+ eval "TIX_SAM_FILE=libtixsam${TCL_UNSHARED_LIB_SUFFIX}"
+ TIX_MAKE_SAM="ar cr ${TIX_SAM_FILE} \${TIX_SAM_OBJS}"
+fi
+
+
+#--------------------------------------------------------------------
+# Check for the existence of the -lsocket and -lnsl libraries.
+# The order here is important, so that they end up in the right
+# order in the command line generated by make. Here are some
+# special considerations:
+# 1. Use "connect" and "accept" to check for -lsocket, and
+# "gethostbyname" to check for -lnsl.
+# 2. Use each function name only once: can't redo a check because
+# autoconf caches the results of the last check and won't redo it.
+# 3. Use -lnsl and -lsocket only if they supply procedures that
+# aren't already present in the normal libraries. This is because
+# IRIX 5.2 has libraries, but they aren't needed and they're
+# bogus: they goof up name resolution if used.
+# 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+# To get around this problem, check for both libraries together
+# if -lsocket doesn't work by itself.
+#--------------------------------------------------------------------
+
+checked=0
+for i in $TK_LIBS; do
+ if test "$i" = "-lsocket"; then
+ checked=1
+ fi
+done
+
+if test "$checked" = "0"; then
+ tcl_checkBoth=0
+ echo $ac_n "checking for connect""... $ac_c" 1>&6
+echo "configure:1546: checking for connect" >&5
+if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1551 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char connect(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char connect();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_connect) || defined (__stub___connect)
+choke me
+#else
+connect();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1574: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_connect=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_connect=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'connect`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_checkSocket=0
+else
+ echo "$ac_t""no" 1>&6
+tcl_checkSocket=1
+fi
+
+ if test "$tcl_checkSocket" = 1; then
+ echo $ac_n "checking for main in -lsocket""... $ac_c" 1>&6
+echo "configure:1596: checking for main in -lsocket" >&5
+ac_lib_var=`echo socket'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lsocket $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1604 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:1611: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ TK_LIBS="$TK_LIBS -lsocket"
+else
+ echo "$ac_t""no" 1>&6
+tcl_checkBoth=1
+fi
+
+ fi
+ if test "$tcl_checkBoth" = 1; then
+ tk_oldLibs=$TK_LIBS
+ TK_LIBS="$TK_LIBS -lsocket -lnsl"
+ echo $ac_n "checking for accept""... $ac_c" 1>&6
+echo "configure:1637: checking for accept" >&5
+if eval "test \"`echo '$''{'ac_cv_func_accept'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1642 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char accept(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char accept();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_accept) || defined (__stub___accept)
+choke me
+#else
+accept();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1665: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_accept=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_accept=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'accept`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_checkNsl=0
+else
+ echo "$ac_t""no" 1>&6
+TK_LIBS=$tk_oldLibs
+fi
+
+ fi
+ echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6
+echo "configure:1687: checking for gethostbyname" >&5
+if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1692 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char gethostbyname(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char gethostbyname();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_gethostbyname) || defined (__stub___gethostbyname)
+choke me
+#else
+gethostbyname();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1715: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_gethostbyname=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_gethostbyname=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+echo $ac_n "checking for main in -lnsl""... $ac_c" 1>&6
+echo "configure:1733: checking for main in -lnsl" >&5
+ac_lib_var=`echo nsl'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lnsl $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1741 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:1748: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ TK_LIBS="$TK_LIBS -lnsl"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+fi
+
+fi
+
+TIX_LIB_FULL_PATH="`pwd`/${TIX_LIB_FILE}"
+
+#----------------------------------------------------------------------
+# Substitution strings exported by TIX
+#----------------------------------------------------------------------
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+# The "binary version" of Tix (see docs/Pkg.txt)
+TIX_VERSION_PKG=${BIN_VERSION}
+
+
+TIXSAM_PKG_FILE="[file join [file dirname \$dir] ${TIX_SAM_FILE}]"
+if test "$TIX_BUILD_SAM" = "yes"; then
+ TIX_SAM_PACKAGE_IFNEEDED="package ifneeded Tixsam ${TIX_VERSION_PKG} [list load \"${TIXSAM_PKG_FILE}\" Tixsam]"
+fi
+
+# The package file, usually a shared library
+TIX_PKG_FILE="[file join [file dirname \$dir] ${TIX_LIB_FILE}]"
+
+
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.13"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "Makefile pkgIndex.tcl ../../tixConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@CC@%$CC%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@RANLIB@%$RANLIB%g
+s%@CPP@%$CPP%g
+s%@SET_MAKE@%$SET_MAKE%g
+s%@TIX_RANLIB@%$TIX_RANLIB%g
+s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
+s%@SHLIB_LD@%$SHLIB_LD%g
+s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
+s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
+s%@SHLIB_VERSION@%$SHLIB_VERSION%g
+s%@DL_LIBS@%$DL_LIBS%g
+s%@LD_FLAGS@%$LD_FLAGS%g
+s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
+s%@TCL_LIBS@%$TCL_LIBS%g
+s%@TCL_VERSION@%$TCL_VERSION%g
+s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
+s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g
+s%@TCL_LIB_FULL_PATH@%$TCL_LIB_FULL_PATH%g
+s%@TK_BUILD_LIB_SPEC@%$TK_BUILD_LIB_SPEC%g
+s%@TK_LIBS@%$TK_LIBS%g
+s%@TK_VERSION@%$TK_VERSION%g
+s%@TK_SRC_DIR@%$TK_SRC_DIR%g
+s%@TK_BIN_DIR@%$TK_BIN_DIR%g
+s%@TK_XINCLUDES@%$TK_XINCLUDES%g
+s%@TK_LIB_FULL_PATH@%$TK_LIB_FULL_PATH%g
+s%@TIX_LD_SEARCH_FLAGS@%$TIX_LD_SEARCH_FLAGS%g
+s%@TIX_MAJOR_VERSION@%$TIX_MAJOR_VERSION%g
+s%@TIX_MINOR_VERSION@%$TIX_MINOR_VERSION%g
+s%@TIX_VERSION@%$TIX_VERSION%g
+s%@TIX_SRC_DIR@%$TIX_SRC_DIR%g
+s%@TIX_SHLIB_CFLAGS@%$TIX_SHLIB_CFLAGS%g
+s%@TIX_MAKE_LIB@%$TIX_MAKE_LIB%g
+s%@TIX_LIB_FILE@%$TIX_LIB_FILE%g
+s%@TIX_BUILD_LIB_SPEC@%$TIX_BUILD_LIB_SPEC%g
+s%@TIX_LIB_SPEC@%$TIX_LIB_SPEC%g
+s%@TIX_EXE_FILE@%$TIX_EXE_FILE%g
+s%@TIX_SAM_TARGETS@%$TIX_SAM_TARGETS%g
+s%@TIX_SAM_INSTALL@%$TIX_SAM_INSTALL%g
+s%@TIX_LIB_FULL_PATH@%$TIX_LIB_FULL_PATH%g
+s%@TCL_SAM_FILE@%$TCL_SAM_FILE%g
+s%@TCL_MAKE_SAM@%$TCL_MAKE_SAM%g
+s%@TK_SAM_FILE@%$TK_SAM_FILE%g
+s%@TK_MAKE_SAM@%$TK_MAKE_SAM%g
+s%@TIX_SAM_FILE@%$TIX_SAM_FILE%g
+s%@TIX_MAKE_SAM@%$TIX_MAKE_SAM%g
+s%@TIX_DEFS@%$TIX_DEFS%g
+s%@ITCL_BUILD_LIB_SPEC@%$ITCL_BUILD_LIB_SPEC%g
+s%@ITCL_LIB_FULL_PATH@%$ITCL_LIB_FULL_PATH%g
+s%@ITK_BUILD_LIB_SPEC@%$ITK_BUILD_LIB_SPEC%g
+s%@TCL_SAMEXE_FILE@%$TCL_SAMEXE_FILE%g
+s%@TK_SAMEXE_FILE@%$TK_SAMEXE_FILE%g
+s%@TIX_SAMEXE_FILE@%$TIX_SAMEXE_FILE%g
+s%@TCL_BUILD_SAM_SPEC@%$TCL_BUILD_SAM_SPEC%g
+s%@TK_BUILD_SAM_SPEC@%$TK_BUILD_SAM_SPEC%g
+s%@TIX_BUILD_SAM_SPEC@%$TIX_BUILD_SAM_SPEC%g
+s%@TIX_BUILD_LOCATION@%$TIX_BUILD_LOCATION%g
+s%@TIX_VERSION_PKG@%$TIX_VERSION_PKG%g
+s%@TIX_PKG_FILE@%$TIX_PKG_FILE%g
+s%@TIX_SAM_PACKAGE_IFNEEDED@%$TIX_SAM_PACKAGE_IFNEEDED%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile pkgIndex.tcl ../../tixConfig.sh"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+ case "$ac_given_INSTALL" in
+ [/$]*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ esac
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
+
diff --git a/tix/unix/tk8.0/configure.in b/tix/unix/tk8.0/configure.in
new file mode 100644
index 00000000000..aa129962a3e
--- /dev/null
+++ b/tix/unix/tk8.0/configure.in
@@ -0,0 +1,445 @@
+dnl This file is an input file used by the GNU "autoconf" program to
+dnl generate the file "configure", which is run to configure the
+dnl Makefile in this directory.
+
+AC_INIT(../../generic/tixInit.c)
+
+#--------------------------------------------------------------------
+# Remove the ./config.cache file and rerun configure if
+# the cache file belong to a different architecture
+#
+# This doesn't seem to work in the Cygnus environment,
+# it causes an error message about having more than
+# one target, so I disabled it. meissner@cygnus.com
+#----------------------------------------------------------------------
+#AC_CHECK_PROG(UNAME, uname -a, [uname -a], "")
+#if test "$UNAME" = ""; then
+# AC_CHECK_PROG(UNAME, uname, [uname], "")
+#fi
+#
+#if test "$UNAME" != ""; then
+# uname=`$UNAME`
+# AC_MSG_CHECKING([cached value of \$uname])
+# AC_CACHE_VAL(ac_cv_prog_uname, [nocached=1 ac_cv_prog_uname=`$UNAME`])
+# if test "$nocached" = "1"; then
+# AC_MSG_RESULT(no)
+# else
+# AC_MSG_RESULT(yes)
+# fi
+#
+# if test "$uname" != "$ac_cv_prog_uname"; then
+# echo "Running on a different machine/architecture. Can't use cached values"
+# echo "Removing config.cache and running configure again ..."
+# rm -f config.cache
+# CMDLINE="$0 $*"
+# exec $CMDLINE
+# fi
+#fi
+
+#----------------------------------------------------------------------
+# We don't want to use any relative path because we need to generate
+# Makefile's in subdirectories
+#----------------------------------------------------------------------
+if test "$INSTALL" = "./install.sh"; then
+ INSTALL=`pwd`/install.sh
+fi
+
+#--------------------------------------------------------------------
+# Version information about this TIX release.
+#--------------------------------------------------------------------
+
+TIX_VERSION=4.1
+TIX_MAJOR_VERSION=4
+TIX_MINOR_VERSION=1
+
+BIN_VERSION=${TIX_VERSION}.8.0
+
+
+VERSION=${BIN_VERSION}
+
+#--------------------------------------------------------------------
+# See if user wants to use gcc to compile Tix. This option must
+# be used before any checking that uses the C compiler.
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(gcc, [ --enable-gcc allow use of gcc if available],
+ [tix_ok=$enableval], [tix_ok=no])
+if test "$tix_ok" = "yes"; then
+ AC_PROG_CC
+else
+ CC=${CC-cc}
+AC_SUBST(CC)
+fi
+
+AC_PROG_INSTALL
+AC_PROG_RANLIB
+AC_HAVE_HEADERS(unistd.h limits.h)
+AC_PROG_MAKE_SET
+
+#--------------------------------------------------------------------
+# unsigned char is not supported by some non-ANSI compilers.
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING([unsigned char])
+AC_TRY_COMPILE([#include <stdio.h>],[
+ unsigned char c = 'c';
+], tcl_ok=supported, tcl_ok=notsupported)
+
+AC_MSG_RESULT($tcl_ok)
+if test $tcl_ok = supported; then
+ AC_DEFINE(UCHAR_SUPPORTED)
+fi
+
+#--------------------------------------------------------------------
+# Check whether there is an strcasecmp function on this system.
+# This is a bit tricky because under SCO it's in -lsocket and
+# under Sequent Dynix it's in -linet.
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(strcasecmp, tcl_ok=1, tcl_ok=0)
+if test "$tcl_ok" = 0; then
+ AC_CHECK_LIB(socket, strcasecmp, tcl_ok=1, tcl_ok=0)
+fi
+if test "$tcl_ok" = 0; then
+ AC_CHECK_LIB(inet, strcasecmp, tcl_ok=1, tcl_ok=0)
+fi
+if test "$tcl_ok" = 0; then
+ AC_DEFINE(NO_STRCASECMP)
+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.
+#--------------------------------------------------------------------
+
+AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.0 source from DIR],
+ val=$withval, val="")
+
+AC_MSG_CHECKING([Tcl source directory])
+
+if test "$val" != ""; then
+ TCL_SRC_DIR=$val
+ if test ! -d $TCL_SRC_DIR; then
+ AC_MSG_ERROR(Directory $TCL_SRC_DIR doesn't exist)
+ AC_MSG_ERROR(Please install the source code of Tcl 8.0)
+ exit 1
+ fi
+else
+ # CYGNUS LOCAL: Just use tcl.
+ dirs="${srcdir}/../../../tcl8.0* ${srcdir}/../../../tcl"
+ TCL_SRC_DIR="no-no"
+ for i in $dirs; do
+ if test -d $i; then
+ TCL_SRC_DIR=`cd $i; pwd`
+ fi
+ done
+
+ if test ! -d $TCL_SRC_DIR; then
+ AC_MSG_ERROR(Cannot locate Tcl source directory in $dirs)
+ AC_MSG_ERROR(Please install the source code of Tcl 8.0)
+ exit 1
+ fi
+fi
+AC_MSG_RESULT($TCL_SRC_DIR)
+
+# CYGNUS LOCAL: This used to get TCL_BIN_DIR from TCL_SRC_DIR, which
+# only works when srcdir == objdir
+TCL_BIN_DIR=../../../tcl/unix
+
+#--------------------------------------------------------------------
+# See if there was a command-line option for where Tk is; if
+# not, assume that its top-level directory is a sibling of ours.
+#--------------------------------------------------------------------
+
+AC_ARG_WITH(tk, [ --with-tk=DIR use Tk 8.0 source from DIR],
+ val=$withval, val="")
+
+AC_MSG_CHECKING([Tk source directory])
+
+if test "$val" != ""; then
+ TK_SRC_DIR=$val
+ if test ! -d $TK_SRC_DIR; then
+ AC_MSG_ERROR(Directory $TK_SRC_DIR doesn't exist)
+ AC_MSG_ERROR(Please install the source code of Tk 8.0)
+ exit 1
+ fi
+else
+ # CYGNUS LOCAL: Just use tk
+ dirs="${srcdir}/../../../tk8.0* ${srcdir}/../../../tk"
+ TK_SRC_DIR="no-no"
+ for i in $dirs; do
+ if test -d $i; then
+ TK_SRC_DIR=`cd $i; pwd`
+ fi
+ done
+
+ if test ! -d $TK_SRC_DIR; then
+ AC_MSG_ERROR(Cannot locate Tk source directory in $dirs)
+ AC_MSG_ERROR(Please install the source code of Tk 8.0)
+ exit 1
+ fi
+fi
+AC_MSG_RESULT($TK_SRC_DIR)
+
+# CYGNUS LOCAL: This used to get TK_BIN_DIR from TK_SRC_DIR, which
+# only works when srcdir == objdir
+TK_BIN_DIR=../../../tk/unix
+
+#--------------------------------------------------------------------
+# Find out the top level source directory of the Tix package.
+#--------------------------------------------------------------------
+TIX_SRC_DIR=`cd ${srcdir}/../..; pwd`
+
+#--------------------------------------------------------------------
+# See if we should compile SAM
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(sam,
+ [ --enable-sam build stand-alone modules],
+ [ok=$enableval], [ok=no])
+
+if test "$ok" = "yes"; then
+ TIX_BUILD_SAM="yes"
+ TIX_SAM_TARGETS='$(SAM_TARGETS)'
+else
+ TIX_BUILD_SAM="no"
+fi
+
+ TIX_SAM_INSTALL=_install_sam_lib_
+
+IS_ITCL=0
+ITCL_BUILD_LIB_SPEC=""
+ITK_BUILD_LIB_SPEC=""
+TIX_EXE_FILE=tixwish
+TCL_SAMEXE_FILE=satclsh
+TK_SAMEXE_FILE=sawish
+TIX_SAMEXE_FILE=satixwish
+
+#--------------------------------------------------------------------
+# 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
+CC=$TCL_CC
+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
+TIX_LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
+
+#--------------------------------------------------------------------
+# Read in configuration information generated by Tk and arrange
+# for it to be substituted into our Makefile.
+#--------------------------------------------------------------------
+file=$TK_BIN_DIR/tkConfig.sh
+. $file
+
+TIX_DEFS="$TK_DEFS $TCL_DEFS"
+
+# 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.
+
+TIX_BUILD_LOCATION="`pwd`"
+if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
+ TIX_BUILD_LIB_SPEC="-L`pwd` -ltix${VERSION}"
+ TIX_BUILD_SAM_SPEC="-L`pwd` -ltixsam${VERSION}"
+ TCL_BUILD_SAM_SPEC="-L`pwd` -ltclsam${TCL_VERSION}"
+ TK_BUILD_SAM_SPEC="-L`pwd` -ltksam${TK_VERSION}"
+ TIX_LIB_SPEC="-L${exec_prefix}/lib -ltix${VERSION}"
+else
+ TIX_BUILD_LIB_SPEC="-L`pwd` -ltix`echo ${VERSION} | tr -d .`"
+ TIX_BUILD_SAM_SPEC="-L`pwd` -ltixsam`echo ${VERSION} | tr -d .`"
+ TCL_BUILD_SAM_SPEC="-L`pwd` -ltclsam`echo ${TCL_VERSION} | tr -d .`"
+ TK_BUILD_SAM_SPEC="-L`pwd` -ltksam`echo ${TK_VERSION} | tr -d .`"
+ TIX_LIB_SPEC="-L${exec_prefix}/lib -ltix`echo ${VERSION} | tr -d .`"
+fi
+
+#--------------------------------------------------------------------
+# See if we should compile shared library.
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(shared,
+ [ --enable-shared build libtix as a shared library],
+ [ok=$enableval], [ok=no])
+
+if test "$ok" = "yes" -a "${SHLIB_SUFFIX}" != ""; then
+ TIX_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+ TIX_RANLIB=":"
+
+ # The main Tix library
+ #
+ eval "TIX_LIB_FILE=libtix${TCL_SHARED_LIB_SUFFIX}"
+ TIX_MAKE_LIB="\${SHLIB_LD} -o ${TIX_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tcl SAM library
+ #
+ VERSION=8.0
+ eval "TCL_SAM_FILE=libtclsam${TCL_SHARED_LIB_SUFFIX}"
+ TCL_MAKE_SAM="\${SHLIB_LD} -o ${TCL_SAM_FILE} \${TCL_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tk SAM library
+ #
+ VERSION=8.0
+ eval "TK_SAM_FILE=libtksam${TCL_SHARED_LIB_SUFFIX}"
+ TK_MAKE_SAM="\${SHLIB_LD} -o ${TK_SAM_FILE} \${TK_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tix SAM library
+ #
+ VERSION=${BIN_VERSION}
+ eval "TIX_SAM_FILE=libtixsam${TCL_SHARED_LIB_SUFFIX}"
+ TIX_MAKE_SAM="\${SHLIB_LD} -o ${TIX_SAM_FILE} \${TIX_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+else
+ TIX_SHLIB_CFLAGS=""
+ TIX_RANLIB='$(RANLIB)'
+
+ # The main Tix library
+ #
+ eval "TIX_LIB_FILE=libtix${TCL_UNSHARED_LIB_SUFFIX}"
+ TIX_MAKE_LIB="ar cr ${TIX_LIB_FILE} \${OBJS}"
+
+ # The Tcl SAM library
+
+ VERSION=8.0
+ eval "TCL_SAM_FILE=libtclsam${TCL_UNSHARED_LIB_SUFFIX}"
+ TCL_MAKE_SAM="ar cr ${TCL_SAM_FILE} \${TCL_SAM_OBJS}"
+
+ # The Tk SAM library
+ #
+ VERSION=8.0
+ eval "TK_SAM_FILE=libtksam${TCL_UNSHARED_LIB_SUFFIX}"
+ TK_MAKE_SAM="ar cr ${TK_SAM_FILE} \${TK_SAM_OBJS}"
+
+ # The Tix SAM library
+ #
+ VERSION=${BIN_VERSION}
+ eval "TIX_SAM_FILE=libtixsam${TCL_UNSHARED_LIB_SUFFIX}"
+ TIX_MAKE_SAM="ar cr ${TIX_SAM_FILE} \${TIX_SAM_OBJS}"
+fi
+
+
+#--------------------------------------------------------------------
+# Check for the existence of the -lsocket and -lnsl libraries.
+# The order here is important, so that they end up in the right
+# order in the command line generated by make. Here are some
+# special considerations:
+# 1. Use "connect" and "accept" to check for -lsocket, and
+# "gethostbyname" to check for -lnsl.
+# 2. Use each function name only once: can't redo a check because
+# autoconf caches the results of the last check and won't redo it.
+# 3. Use -lnsl and -lsocket only if they supply procedures that
+# aren't already present in the normal libraries. This is because
+# IRIX 5.2 has libraries, but they aren't needed and they're
+# bogus: they goof up name resolution if used.
+# 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+# To get around this problem, check for both libraries together
+# if -lsocket doesn't work by itself.
+#--------------------------------------------------------------------
+
+checked=0
+for i in $TK_LIBS; do
+ if test "$i" = "-lsocket"; then
+ checked=1
+ fi
+done
+
+if test "$checked" = "0"; then
+ tcl_checkBoth=0
+ AC_CHECK_FUNC(connect, tcl_checkSocket=0, tcl_checkSocket=1)
+ if test "$tcl_checkSocket" = 1; then
+ AC_CHECK_LIB(socket, main, TK_LIBS="$TK_LIBS -lsocket",
+ tcl_checkBoth=1)
+ fi
+ if test "$tcl_checkBoth" = 1; then
+ tk_oldLibs=$TK_LIBS
+ TK_LIBS="$TK_LIBS -lsocket -lnsl"
+ AC_CHECK_FUNC(accept, tcl_checkNsl=0, [TK_LIBS=$tk_oldLibs])
+ fi
+ AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main,
+ [TK_LIBS="$TK_LIBS -lnsl"]))
+fi
+
+TIX_LIB_FULL_PATH="`pwd`/${TIX_LIB_FILE}"
+
+#----------------------------------------------------------------------
+# Substitution strings exported by TIX
+#----------------------------------------------------------------------
+AC_SUBST(CC)
+AC_SUBST(RANLIB)
+AC_SUBST(TIX_RANLIB)
+AC_SUBST(SHLIB_CFLAGS)
+AC_SUBST(SHLIB_LD)
+AC_SUBST(SHLIB_LD_LIBS)
+AC_SUBST(SHLIB_SUFFIX)
+AC_SUBST(SHLIB_VERSION)
+AC_SUBST(DL_LIBS)
+AC_SUBST(LD_FLAGS)
+AC_SUBST(TCL_BUILD_LIB_SPEC)
+AC_SUBST(TCL_LIBS)
+AC_SUBST(TCL_VERSION)
+AC_SUBST(TCL_SRC_DIR)
+AC_SUBST(TCL_BIN_DIR)
+AC_SUBST(TCL_LIB_FULL_PATH)
+AC_SUBST(TK_BUILD_LIB_SPEC)
+AC_SUBST(TK_LIBS)
+AC_SUBST(TK_VERSION)
+AC_SUBST(TK_SRC_DIR)
+AC_SUBST(TK_BIN_DIR)
+AC_SUBST(TK_XINCLUDES)
+AC_SUBST(TK_LIB_FULL_PATH)
+AC_SUBST(TIX_LD_SEARCH_FLAGS)
+AC_SUBST(TIX_MAJOR_VERSION)
+AC_SUBST(TIX_MINOR_VERSION)
+AC_SUBST(TIX_VERSION)
+AC_SUBST(TIX_SRC_DIR)
+AC_SUBST(TIX_SHLIB_CFLAGS)
+AC_SUBST(TIX_MAKE_LIB)
+AC_SUBST(TIX_LIB_FILE)
+AC_SUBST(TIX_BUILD_LIB_SPEC)
+AC_SUBST(TIX_LIB_SPEC)
+AC_SUBST(TIX_EXE_FILE)
+AC_SUBST(TIX_SAM_TARGETS)
+AC_SUBST(TIX_SAM_INSTALL)
+AC_SUBST(TIX_LIB_FULL_PATH)
+AC_SUBST(TCL_SAM_FILE)
+AC_SUBST(TCL_MAKE_SAM)
+AC_SUBST(TK_SAM_FILE)
+AC_SUBST(TK_MAKE_SAM)
+AC_SUBST(TIX_SAM_FILE)
+AC_SUBST(TIX_MAKE_SAM)
+AC_SUBST(TIX_DEFS)
+AC_SUBST(ITCL_BUILD_LIB_SPEC)
+AC_SUBST(ITCL_LIB_FULL_PATH)
+AC_SUBST(ITK_BUILD_LIB_SPEC)
+AC_SUBST(TCL_SAMEXE_FILE)
+AC_SUBST(TK_SAMEXE_FILE)
+AC_SUBST(TIX_SAMEXE_FILE)
+AC_SUBST(TCL_BUILD_SAM_SPEC)
+AC_SUBST(TK_BUILD_SAM_SPEC)
+AC_SUBST(TIX_BUILD_SAM_SPEC)
+AC_SUBST(TIX_BUILD_LOCATION)
+# The "binary version" of Tix (see docs/Pkg.txt)
+TIX_VERSION_PKG=${BIN_VERSION}
+AC_SUBST(TIX_VERSION_PKG)
+
+TIXSAM_PKG_FILE="[[file join [file dirname \$dir] ${TIX_SAM_FILE}]]"
+if test "$TIX_BUILD_SAM" = "yes"; then
+ TIX_SAM_PACKAGE_IFNEEDED="package ifneeded Tixsam ${TIX_VERSION_PKG} [[list load \"${TIXSAM_PKG_FILE}\" Tixsam]]"
+fi
+
+# The package file, usually a shared library
+TIX_PKG_FILE="[[file join [file dirname \$dir] ${TIX_LIB_FILE}]]"
+AC_SUBST(TIX_PKG_FILE)
+AC_SUBST(TIX_SAM_PACKAGE_IFNEEDED)
+
+AC_OUTPUT(Makefile pkgIndex.tcl ../../tixConfig.sh)
+
diff --git a/tix/unix/tk8.0/pkgIndex.tcl.in b/tix/unix/tk8.0/pkgIndex.tcl.in
new file mode 100644
index 00000000000..fc82f9db9b6
--- /dev/null
+++ b/tix/unix/tk8.0/pkgIndex.tcl.in
@@ -0,0 +1,4 @@
+# Tcl package index file, version 1.0
+
+package ifneeded Tix @TIX_VERSION_PKG@ [list load "@TIX_PKG_FILE@" Tix]
+@TIX_SAM_PACKAGE_IFNEEDED@
diff --git a/tix/unix/tk8.0/tixAppInit.c b/tix/unix/tk8.0/tixAppInit.c
new file mode 100644
index 00000000000..69621043b2d
--- /dev/null
+++ b/tix/unix/tk8.0/tixAppInit.c
@@ -0,0 +1,112 @@
+/*
+ * tixAppInit.c --
+ *
+ * Provides a default version of the Tcl_AppInit procedure for
+ * use in wish and similar Tk-based applications.
+ *
+ * Copyright (c) 1995 Ioi K Lam
+ * 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.
+ */
+
+#include <tk.h>
+#include <tix.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;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ * This is the main program for the application.
+ *
+ * Results:
+ * None: Tk_Main never returns here, so this procedure never
+ * returns either.
+ *
+ * Side effects:
+ * Whatever the application does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+main(argc, argv)
+ int argc; /* Number of command-line arguments. */
+ char **argv; /* Values of command-line arguments. */
+{
+ Tk_Main(argc, argv, Tcl_AppInit);
+ return 0; /* Needed only to prevent compiler warning. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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, (Tcl_PackageInitProc *) NULL);
+ if (Tix_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tix", Tix_Init, (Tcl_PackageInitProc *) NULL);
+
+ /*
+ * Call the init procedures for included packages. Each call should
+ * look like this:
+ *
+ * if (Mod_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * where "Mod" is the name of the module.
+ */
+
+ /*
+ * Call Tcl_CreateCommand for application-specific commands, if
+ * they weren't already created by the init procedures called above.
+ */
+
+ /*
+ * Specify a user-specific startup file to invoke if the application
+ * is run interactively. Typically the startup file is "~/.apprc"
+ * where "app" is the name of the application. If this line is deleted
+ * then no user-specific startup file will be run under any conditions.
+ */
+ Tix_SetRcFileName(interp, "~/.tixwishrc");
+
+ return TCL_OK;
+}
diff --git a/tix/unix/tk8.1/Makefile.in b/tix/unix/tk8.1/Makefile.in
new file mode 100644
index 00000000000..dcfdea0be7b
--- /dev/null
+++ b/tix/unix/tk8.1/Makefile.in
@@ -0,0 +1,556 @@
+# Makefile --
+#
+# This file is a Makefile to compile Tix with Tk version
+# 8.1. 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.
+
+# CYGNUS LOCAL: Set VPATH.
+VPATH = @srcdir@
+srcdir = @srcdir@
+
+#----------------------------------------------------------------
+# Things you can change to personalize the Makefile for your own
+# site (you can make these changes in either Makefile.in or
+# Makefile, but changes to Makefile will get lost if you re-run
+# the configuration script).
+#----------------------------------------------------------------
+
+# Default top-level directories in which to install architecture-
+# specific files (exec_prefix) and machine-independent files such
+# as scripts (prefix). The values specified here may be overridden
+# at configure-time with the --exec-prefix and --prefix options
+# to the "configure" script.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+TIX_VERSION = @TIX_VERSION@
+
+@SET_MAKE@
+
+# Directory in which to install the library of Tix scripts and demos
+# (note: you can set the TIX_LIBRARY environment variable at run-time to
+# override the compiled-in location):
+TIX_LIBRARY = $(prefix)/share/tix$(TIX_VERSION)
+
+# Directory in which to install the archive libtix.a:
+LIB_DIR = $(exec_prefix)/lib
+LIB_INSTALL_DIR = $(LIB_DIR)
+LIB_RUNTIME_DIR = $(LIB_DIR)
+
+# Directory in which to install the program tixwish:
+BIN_DIR = $(exec_prefix)/bin
+
+# To change the compiler switches, for example to change from -O
+# to -g, change the following line:
+CFLAGS = -O
+TIX_CFLAGS = $(CFLAGS) -fwritable-strings
+
+# To disable ANSI-C procedure prototypes reverse the comment characters
+# on the following lines:
+PROTO_FLAGS =
+#PROTO_FLAGS = -DNO_PROTOTYPE
+
+# To enable memory debugging reverse the comment characters on the following
+# lines. Warning: if you enable memory debugging, you must do it
+# *everywhere*, including all the code that calls Tcl, and you must use
+# ckalloc and ckfree everywhere instead of malloc and free.
+MEM_DEBUG_FLAGS =
+#MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG
+
+# Some versions of make, like SGI's, use the following variable to
+# determine which shell to use for executing commands:
+SHELL = /bin/sh
+
+# Location of the Tcl 8.1 source directory.
+#
+TCL_SRC_DIR = @TCL_SRC_DIR@
+TCL_GENERIC_DIR = $(TCL_SRC_DIR)/generic
+TCL_BIN_DIR = @TCL_BIN_DIR@
+
+# Location of the Tk 8.1 source directory.
+#
+TK_SRC_DIR = @TK_SRC_DIR@
+TK_GENERIC_DIR = $(TK_SRC_DIR)/generic
+
+# Libraries to use when linking:
+LIBS = @ITK_BUILD_LIB_SPEC@ @ITCL_BUILD_LIB_SPEC@ \
+ @TK_BUILD_LIB_SPEC@ @TCL_BUILD_LIB_SPEC@ @TK_LIBS@
+
+# Libraries for building a stand-alone Tclsh.
+#
+LIBS_TCLONLY = @TCL_BUILD_LIB_SPEC@ @TCL_LIBS@
+
+RUN_TCLSH = TCL_LIBRARY=$(TCL_SRC_DIR)/library \
+ TK_LIBRARY=$(TK_SRC_DIR)/library \
+ $(TCL_BIN_DIR)/tclsh
+
+
+#----------------------------------------------------------------
+# 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.
+#----------------------------------------------------------------
+
+CC = @CC@
+
+SHLIB_CFLAGS = @SHLIB_CFLAGS@
+SHLIB_LD = @SHLIB_LD@
+SHLIB_SUFFIX = @SHLIB_SUFFIX@
+SHLIB_VERSION = @SHLIB_VERSION@
+TIX_SHLIB_CFLAGS = @TIX_SHLIB_CFLAGS@
+TK_XINCLUDES = @TK_XINCLUDES@
+
+ITCL_EXT =
+
+SRC_DIR = @TIX_SRC_DIR@
+GENERIC_DIR = $(SRC_DIR)/generic
+UNIX_DIR = $(SRC_DIR)/unix
+AC_FLAGS = @DEFS@ @TIX_DEFS@
+RANLIB = @RANLIB@
+TIX_RANLIB = @TIX_RANLIB@
+INSTALL = @TIX_SRC_DIR@/install.sh -c
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+TIX_LIB_FILE = @TIX_LIB_FILE@
+TIX_EXE_FILE = @TIX_EXE_FILE@
+TCL_SAM_FILE = @TCL_SAM_FILE@
+TK_SAM_FILE = @TK_SAM_FILE@
+TIX_SAM_FILE = @TIX_SAM_FILE@
+TCL_SAMEXE_FILE = @TCL_SAMEXE_FILE@
+TK_SAMEXE_FILE = @TK_SAMEXE_FILE@
+TIX_SAMEXE_FILE = @TIX_SAMEXE_FILE@
+
+INST_EXE = $(TIX_EXE_FILE)$(TIX_VERSION).8.1$(ITCL_EXT)
+INST_TIX_SAMEXE = $(TIX_SAMEXE_FILE)$(TIX_VERSION).8.1$(ITCL_EXT)
+INST_TK_SAMEXE = $(TK_SAMEXE_FILE)8.1
+INST_TCL_SAMEXE = $(TCL_SAMEXE_FILE)8.1
+
+SAM_TARGETS = $(TIX_SAM_FILE)
+
+TIX_SAM_TARGETS = @TIX_SAM_TARGETS@
+SAM_INSTALL = @TIX_SAM_INSTALL@
+
+ITCL_CFLAGS =
+
+CC_SWITCHES = $(TIX_CFLAGS) $(AC_FLAGS) -I$(TCL_GENERIC_DIR) \
+ -I$(TCL_SRC_DIR)/unix -I$(TK_GENERIC_DIR) -I$(TK_SRC_DIR)/unix \
+ $(ITCL_CFLAGS) \
+ -I$(GENERIC_DIR) -I$(UNIX_DIR) $(TK_XINCLUDES) $(TIX_SHLIB_CFLAGS)
+
+#----------------------------------------------------------------
+# The information below should be usable as is. You shouldn't need
+# to modify it.
+#----------------------------------------------------------------
+
+CORE_OBJS = \
+ tixClass.o \
+ tixCmds.o \
+ tixCompat.o \
+ tixError.o \
+ tixGeometry.o \
+ tixInit.o \
+ tixItcl.o \
+ tixList.o \
+ tixMethod.o \
+ tixOption.o \
+ tixScroll.o \
+ tixSmpLs.o \
+ tixUtils.o \
+ tixWidget.o
+
+DITEM_OBJS = \
+ tixDItem.o \
+ tixDiITxt.o \
+ tixDiImg.o \
+ tixDiStyle.o \
+ tixDiText.o \
+ tixDiWin.o
+
+MANAGER_OBJS = \
+ tixForm.o \
+ tixFormMisc.o
+
+WIDGET_OBJS = \
+ tixGrid.o \
+ tixGrData.o \
+ tixGrFmt.o \
+ tixGrRC.o \
+ tixGrSel.o \
+ tixGrSort.o \
+ tixGrUtl.o \
+ tixHList.o \
+ tixHLCol.o \
+ tixHLInd.o \
+ tixHLHdr.o \
+ tixInputO.o \
+ tixNBFrame.o \
+ tixTList.o
+
+MISC_OBJS = \
+ tixImgCmp.o \
+ tixImgXpm.o \
+ tixMwm.o
+
+UNIX_OBJS = \
+ tixUnixDraw.o \
+ tixUnixXpm.o \
+ tixUnixWm.o
+
+OBJS = $(CORE_OBJS) $(DITEM_OBJS) $(MANAGER_OBJS) $(MISC_OBJS) \
+ $(WIDGET_OBJS) $(UNIX_OBJS)
+
+TCL_SAM_OBJS = \
+ tclUnixSam80.o
+
+TK_SAM_OBJS = \
+ tkUnixSam80.o
+
+TIX_SAM_OBJS = \
+ $(OBJS) tixUnixSam.o
+
+#----------------------------------------------------------------------
+# These are the scripts that we'll compile into the SAM's. The
+# scripts of TK must be included in the fixed order.
+#----------------------------------------------------------------------
+
+TCL_SCRIPTS = $(TCL_SRC_DIR)/library/*.tcl
+
+TK_SCRIPTS = \
+ $(TK_SRC_DIR)/library/bgerror.tcl \
+ $(TK_SRC_DIR)/library/dialog.tcl \
+ $(TK_SRC_DIR)/library/focus.tcl \
+ $(TK_SRC_DIR)/library/obsolete.tcl \
+ $(TK_SRC_DIR)/library/optMenu.tcl \
+ $(TK_SRC_DIR)/library/palette.tcl \
+ $(TK_SRC_DIR)/library/tearoff.tcl \
+ $(TK_SRC_DIR)/library/clrpick.tcl \
+ $(TK_SRC_DIR)/library/comdlg.tcl \
+ $(TK_SRC_DIR)/library/msgbox.tcl \
+ $(TK_SRC_DIR)/library/tkfbox.tcl \
+ $(TK_SRC_DIR)/library/xmfbox.tcl \
+ $(SRC_DIR)/generic/tk4.2/tk.tcl \
+ $(TK_SRC_DIR)/library/button.tcl \
+ $(TK_SRC_DIR)/library/entry.tcl \
+ $(TK_SRC_DIR)/library/listbox.tcl \
+ $(TK_SRC_DIR)/library/menu.tcl \
+ $(TK_SRC_DIR)/library/scale.tcl \
+ $(TK_SRC_DIR)/library/scrlbar.tcl \
+ $(TK_SRC_DIR)/library/text.tcl \
+ $(SRC_DIR)/generic/tk8.0/console.tcl
+
+TIX_SCRIPTS = \
+ $(SRC_DIR)/library/pref/*.fsc \
+ $(SRC_DIR)/library/pref/*.csc \
+ $(SRC_DIR)/library/*.tcl
+
+all: $(TIX_LIB_FILE) $(TIX_EXE_FILE) @TIX_SAM_TARGETS@
+
+$(TIX_LIB_FILE): $(OBJS)
+ rm -f $(TIX_LIB_FILE)
+ @TIX_MAKE_LIB@
+ $(TIX_RANLIB) $(TIX_LIB_FILE)
+
+$(TCL_SAM_FILE): $(TCL_SAM_OBJS)
+ rm -f $(TCL_SAM_FILE)
+ @TCL_MAKE_SAM@
+ $(TIX_RANLIB) $(TCL_SAM_FILE)
+
+$(TK_SAM_FILE): $(TK_SAM_OBJS)
+ rm -f $(TK_SAM_FILE)
+ @TK_MAKE_SAM@
+ $(TIX_RANLIB) $(TK_SAM_FILE)
+
+$(TIX_SAM_FILE): $(TIX_SAM_OBJS)
+ rm -f $(TIX_SAM_FILE)
+ @TIX_MAKE_SAM@
+ $(TIX_RANLIB) $(TIX_SAM_FILE)
+
+$(TIX_EXE_FILE): tixAppInit.o $(TIX_LIB_FILE) @TCL_LIB_FULL_PATH@ \
+ @TK_LIB_FULL_PATH@ @ITCL_LIB_FULL_PATH@
+ $(CC) @LD_FLAGS@ tixAppInit.o @TIX_BUILD_LIB_SPEC@ $(LIBS) \
+ @TIX_LD_SEARCH_FLAGS@ -o $(TIX_EXE_FILE)
+
+$(TCL_SAMEXE_FILE): $(UNIX_DIR)/samAppInit.c $(TCL_SAM_FILE)
+ $(CC) $(CC_SWITCHES) @LD_FLAGS@ -DUSE_TCL $(UNIX_DIR)/samAppInit.c \
+ @TCL_BUILD_SAM_SPEC@ $(LIBS_TCLONLY) \
+ @TIX_LD_SEARCH_FLAGS@ -o $(TCL_SAMEXE_FILE)
+
+$(TK_SAMEXE_FILE): $(UNIX_DIR)/samAppInit.c $(TCL_SAM_FILE) $(TK_SAM_FILE) \
+ @TCL_LIB_FULL_PATH@ @TK_LIB_FULL_PATH@ @ITCL_LIB_FULL_PATH@
+ $(CC) $(CC_SWITCHES) @LD_FLAGS@ -DUSE_TK $(UNIX_DIR)/samAppInit.c \
+ @TK_BUILD_SAM_SPEC@ @TCL_BUILD_SAM_SPEC@ $(LIBS) \
+ @TIX_LD_SEARCH_FLAGS@ -o $(TK_SAMEXE_FILE)
+
+$(TIX_SAMEXE_FILE): $(UNIX_DIR)/samAppInit.c $(TCL_SAM_FILE) $(TK_SAM_FILE) \
+ $(TIX_SAM_FILE) @TCL_LIB_FULL_PATH@ @TK_LIB_FULL_PATH@ \
+ @ITCL_LIB_FULL_PATH@
+ $(CC) $(CC_SWITCHES) @LD_FLAGS@ -DUSE_TIX $(UNIX_DIR)/samAppInit.c \
+ @TIX_BUILD_SAM_SPEC@ \
+ @TK_BUILD_SAM_SPEC@ @TCL_BUILD_SAM_SPEC@ \
+ $(LIBS) \
+ @TIX_LD_SEARCH_FLAGS@ -o $(TIX_SAMEXE_FILE)
+
+
+#----------------------------------------------------------------------
+#
+# .o file rules
+#
+#----------------------------------------------------------------------
+tixAppInit.o : tixAppInit.c
+ $(CC) -c $(CC_SWITCHES) $(srcdir)/tixAppInit.c
+
+tixClass.o : $(GENERIC_DIR)/tixClass.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixClass.c
+
+tixCmds.o: $(GENERIC_DIR)/tixCmds.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixCmds.c
+
+tixCompat.o: $(GENERIC_DIR)/tixCompat.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixCompat.c
+
+tixDItem.o: $(GENERIC_DIR)/tixDItem.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDItem.c
+
+tixDiImg.o: $(GENERIC_DIR)/tixDiImg.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiImg.c
+
+tixDiITxt.o: $(GENERIC_DIR)/tixDiITxt.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiITxt.c
+
+tixDiStyle.o: $(GENERIC_DIR)/tixDiStyle.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiStyle.c
+
+tixDiText.o: $(GENERIC_DIR)/tixDiText.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiText.c
+
+tixDiWin.o: $(GENERIC_DIR)/tixDiWin.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixDiWin.c
+
+tixError.o: $(GENERIC_DIR)/tixError.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixError.c
+
+tixForm.o: $(GENERIC_DIR)/tixForm.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixForm.c
+
+tixFormMisc.o: $(GENERIC_DIR)/tixFormMisc.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixFormMisc.c
+
+tixGeometry.o: $(GENERIC_DIR)/tixGeometry.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGeometry.c
+
+tixGrid.o: $(GENERIC_DIR)/tixGrid.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrid.c
+
+tixGrData.o: $(GENERIC_DIR)/tixGrData.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrData.c
+
+tixGrFmt.o: $(GENERIC_DIR)/tixGrFmt.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrFmt.c
+
+tixGrRC.o: $(GENERIC_DIR)/tixGrRC.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrRC.c
+
+tixGrSel.o: $(GENERIC_DIR)/tixGrSel.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrSel.c
+
+tixGrSort.o: $(GENERIC_DIR)/tixGrSort.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrSort.c
+
+tixGrUtl.o: $(GENERIC_DIR)/tixGrUtl.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixGrUtl.c
+
+tixHLCol.o: $(GENERIC_DIR)/tixHLCol.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixHLCol.c
+
+tixHLHdr.o: $(GENERIC_DIR)/tixHLHdr.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixHLHdr.c
+
+tixHLInd.o: $(GENERIC_DIR)/tixHLInd.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixHLInd.c
+
+tixHList.o: $(GENERIC_DIR)/tixHList.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixHList.c
+
+tixImgCmp.o: $(GENERIC_DIR)/tixImgCmp.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixImgCmp.c
+
+tixImgXpm.o: $(GENERIC_DIR)/tixImgXpm.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixImgXpm.c
+
+tixInit.o: $(GENERIC_DIR)/tixInit.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixInit.c
+
+tixItcl.o: $(GENERIC_DIR)/tixItcl.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixItcl.c
+
+tixInputO.o : $(GENERIC_DIR)/tixInputO.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixInputO.c
+
+tixList.o: $(GENERIC_DIR)/tixList.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixList.c
+
+tixMethod.o : $(GENERIC_DIR)/tixMethod.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixMethod.c
+
+tixMwm.o: $(GENERIC_DIR)/tixMwm.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixMwm.c
+
+tixNBFrame.o: $(GENERIC_DIR)/tixNBFrame.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixNBFrame.c
+
+tixOption.o: $(GENERIC_DIR)/tixOption.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixOption.c
+
+tixSmpLs.o: $(GENERIC_DIR)/tixSmpLs.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixSmpLs.c
+
+tixScroll.o: $(GENERIC_DIR)/tixScroll.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixScroll.c
+
+tixTList.o: $(GENERIC_DIR)/tixTList.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixTList.c
+
+tixUtils.o: $(GENERIC_DIR)/tixUtils.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixUtils.c
+
+tixWidget.o: $(GENERIC_DIR)/tixWidget.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tixWidget.c
+
+tixUnixDraw.o: $(UNIX_DIR)/tixUnixDraw.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tixUnixDraw.c
+
+tixUnixXpm.o: $(UNIX_DIR)/tixUnixXpm.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tixUnixXpm.c
+
+tixUnixWm.o: $(UNIX_DIR)/tixUnixWm.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tixUnixWm.c
+
+#
+# Dependence rules for SAM
+#
+tclUnixSam80.o: tclUnixSam80.c tclSamLib.c
+ $(CC) -c $(CC_SWITCHES) tclUnixSam80.c
+
+tclSamLib.c:
+ $(RUN_TCLSH) $(SRC_DIR)/tools/tclc.tcl $(TCL_SCRIPTS) \
+ > tclSamLib.c
+
+tkUnixSam80.o: tkUnixSam80.c tkSamLib.c
+ $(CC) -c $(CC_SWITCHES) tkUnixSam80.c
+
+tkSamLib.c:
+ $(RUN_TCLSH) $(SRC_DIR)/tools/tclc.tcl $(TK_SCRIPTS) \
+ > tkSamLib.c
+
+tixUnixSam.o: $(UNIX_DIR)/tixUnixSam.c tixSamLib.c
+ $(CC) -c -I. $(CC_SWITCHES) $(UNIX_DIR)/tixUnixSam.c
+
+tixSamLib.c:
+ $(RUN_TCLSH) $(SRC_DIR)/tools/tclc.tcl $(TIX_SCRIPTS) \
+ > tixSamLib.c
+
+
+tests: $(TIX_EXE_FILE)
+ TCL_LIBRARY=$(TCL_SRC_DIR)/library TK_LIBRARY=$(TK_SRC_DIR)/library \
+ ITCL_LIBRARY=$(ITCL_SRC_DIR)/library \
+ ITK_LIBRARY=$(ITK_SRC_DIR)/library \
+ IWIDGETS_LIBRARY=$(ITCL_ROOT_DIR)/$(IWIDGETS) \
+ TIX_LIBRARY=$(SRC_DIR)/library \
+ LD_LIBRARY_PATH=${LD_LIBRARY_PATH}:. \
+ ./$(TIX_EXE_FILE) $(SRC_DIR)/tests/Driver.tcl
+
+sa-tests: $(TIX_SAMEXE_FILE)
+ ./$(TIX_SAMEXE_FILE) $(SRC_DIR)/tests/Driver.tcl
+
+#----------------------------------------------------------------------
+#
+# INSTALLATION
+#
+#----------------------------------------------------------------------
+_install_: $(TIX_LIB_FILE) $(TIX_EXE_FILE) $(SAM_INSTALL)
+ @for i in $(LIB_DIR) $(BIN_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing $(TIX_LIB_FILE) as $(LIB_DIR)/$(TIX_LIB_FILE)"
+ @$(INSTALL_DATA) $(TIX_LIB_FILE) $(LIB_DIR)/$(TIX_LIB_FILE)
+ @echo "Installing $(TIX_EXE_FILE) as $(BIN_DIR)/$(INST_EXE)"
+ @$(INSTALL_PROGRAM) $(TIX_EXE_FILE) $(BIN_DIR)/$(INST_EXE)
+
+_install_sam_exe_: $(SAM_TARGETS)
+ @for i in $(LIB_DIR) $(BIN_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing $(TK_SAM_FILE) as $(LIB_DIR)/$(TK_SAM_FILE)"
+ @$(INSTALL_DATA) $(TK_SAM_FILE) $(LIB_DIR)/$(TK_SAM_FILE)
+ @echo "Installing $(TCL_SAM_FILE) as $(LIB_DIR)/$(TCL_SAM_FILE)"
+ @$(INSTALL_DATA) $(TCL_SAM_FILE) $(LIB_DIR)/$(TCL_SAM_FILE)
+ @echo ""
+ @echo "Installing $(TIX_SAMEXE_FILE) as $(BIN_DIR)/$(INST_TIX_SAMEXE)"
+ @$(INSTALL_PROGRAM) $(TIX_SAMEXE_FILE) $(BIN_DIR)/$(INST_TIX_SAMEXE)
+ @echo "Installing $(TK_SAMEXE_FILE) as $(BIN_DIR)/$(INST_TK_SAMEXE)"
+ @$(INSTALL_PROGRAM) $(TK_SAMEXE_FILE) $(BIN_DIR)/$(INST_TK_SAMEXE)
+ @echo "Installing $(TCL_SAMEXE_FILE) as $(BIN_DIR)/$(INST_TCL_SAMEXE)"
+ @$(INSTALL_PROGRAM) $(TCL_SAMEXE_FILE) $(BIN_DIR)/$(INST_TCL_SAMEXE)
+
+_install_sam_lib_: $(SAM_TARGETS)
+ @for i in $(LIB_DIR) $(BIN_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing $(TIX_SAM_FILE) as $(LIB_DIR)/$(TIX_SAM_FILE)"
+ @$(INSTALL_DATA) $(TIX_SAM_FILE) $(LIB_DIR)/$(TIX_SAM_FILE)
+
+
+install: _install_
+ @echo The binary files have been installed.
+ @echo You probably need to make install in the parent directory
+ @echo to install other files.
+
+sam_clean:
+ rm -f tixSamLib.c $(UNIX_DIR)/tixBitmaps.c
+
+clean:
+ rm -f *.so *.a *.o *_s.o core errs *~ \#* TAGS *.E sta* \
+ a.out errors $(TIX_EXE_FILE) $(TIX_LIB_FILE) *.bak \
+ $(SAM_TARGETS) tclSamLib.c tkSamLib.c
+
+distclean: clean
+ rm -f Makefile config.* lib.exp
+
+depend:
+ makedepend -- $(CC_SWITCHES) -- $(SRCS)
+
+# CYGNUS LOCAL: Makefile depends upon config.status
+Makefile: Makefile.in config.status
+ ./config.status
+
+.c.o:
+ $(CC) -c $(CC_SWITCHES) $<
+
+# CYGNUS LOCAL: Rebuild config.status when appropriate.
+config.status: configure
+ $(SHELL) config.status --recheck
+
+# DO NOT DELETE THIS LINE -- make depend depends on it.
+
diff --git a/tix/unix/tk8.1/aclocal.m4 b/tix/unix/tk8.1/aclocal.m4
new file mode 100644
index 00000000000..f5b22bea8aa
--- /dev/null
+++ b/tix/unix/tk8.1/aclocal.m4
@@ -0,0 +1 @@
+"sinclude(../../../config/acinclude.m4)"
diff --git a/tix/unix/tk8.1/configure b/tix/unix/tk8.1/configure
new file mode 100755
index 00000000000..a51613bc700
--- /dev/null
+++ b/tix/unix/tk8.1/configure
@@ -0,0 +1,2480 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+ac_help="$ac_help
+ --enable-gcc allow use of gcc if available"
+ac_help="$ac_help
+ --with-tclconfig directory containing tcl configuration (tclConfig.sh)"
+ac_help="$ac_help
+ --with-tkconfig directory containing tk configuration (tkConfig.sh)"
+ac_help="$ac_help
+ --with-tclinclude directory where tcl headers are"
+ac_help="$ac_help
+ --with-tkinclude directory where tk headers are"
+ac_help="$ac_help
+ --enable-sam build stand-alone modules"
+ac_help="$ac_help
+ --enable-shared build libtix as a shared library"
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.13"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=../../generic/tixInit.c
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+
+#--------------------------------------------------------------------
+# Remove the ./config.cache file and rerun configure if
+# the cache file belong to a different architecture
+#
+# This doesn't seem to work in the Cygnus environment,
+# it causes an error message about having more than
+# one target, so I disabled it. meissner@cygnus.com
+#----------------------------------------------------------------------
+#AC_CHECK_PROG(UNAME, uname -a, [uname -a], "")
+#if test "$UNAME" = ""; then
+# AC_CHECK_PROG(UNAME, uname, [uname], "")
+#fi
+#
+#if test "$UNAME" != ""; then
+# uname=`$UNAME`
+# AC_MSG_CHECKING([cached value of \$uname])
+# AC_CACHE_VAL(ac_cv_prog_uname, [nocached=1 ac_cv_prog_uname=`$UNAME`])
+# if test "$nocached" = "1"; then
+# AC_MSG_RESULT(no)
+# else
+# AC_MSG_RESULT(yes)
+# fi
+#
+# if test "$uname" != "$ac_cv_prog_uname"; then
+# echo "Running on a different machine/architecture. Can't use cached values"
+# echo "Removing config.cache and running configure again ..."
+# rm -f config.cache
+# CMDLINE="$0 $*"
+# exec $CMDLINE
+# fi
+#fi
+
+#----------------------------------------------------------------------
+# We don't want to use any relative path because we need to generate
+# Makefile's in subdirectories
+#----------------------------------------------------------------------
+if test "$INSTALL" = "./install.sh"; then
+ INSTALL=`pwd`/install.sh
+fi
+
+#--------------------------------------------------------------------
+# Version information about this TIX release.
+#--------------------------------------------------------------------
+
+TIX_VERSION=4.1
+TIX_MAJOR_VERSION=4
+TIX_MINOR_VERSION=1
+
+BIN_VERSION=${TIX_VERSION}.8.1
+
+
+VERSION=${BIN_VERSION}
+
+#--------------------------------------------------------------------
+# See if user wants to use gcc to compile Tix. This option must
+# be used before any checking that uses the C compiler.
+#--------------------------------------------------------------------
+
+# Check whether --enable-gcc or --disable-gcc was given.
+if test "${enable_gcc+set}" = set; then
+ enableval="$enable_gcc"
+ tix_ok=$enableval
+else
+ tix_ok=no
+fi
+
+if test "$tix_ok" = "yes"; then
+ # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:610: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:640: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_prog_rejected=no
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -z "$CC"; then
+ case "`uname -s`" in
+ *win32* | *WIN32*)
+ # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:691: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="cl"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+ ;;
+ esac
+ fi
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:723: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 734 "configure"
+#include "confdefs.h"
+
+main(){return(0);}
+EOF
+if { (eval echo configure:739: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cc_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:765: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:770: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:779: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gcc=yes
+else
+ ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+else
+ GCC=
+fi
+
+ac_test_CFLAGS="${CFLAGS+set}"
+ac_save_CFLAGS="$CFLAGS"
+CFLAGS=
+echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:798: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+
+else
+ CC=${CC-cc}
+
+fi
+
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:865: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ # Account for people who put trailing slashes in PATH elements.
+ case "$ac_dir/" in
+ /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ if test -f $ac_dir/$ac_prog; then
+ if test $ac_prog = install &&
+ grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ else
+ ac_cv_path_install="$ac_dir/$ac_prog -c"
+ break 2
+ fi
+ fi
+ done
+ ;;
+ esac
+ done
+ IFS="$ac_save_IFS"
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL="$ac_cv_path_install"
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL="$ac_install_sh"
+ fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+# Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:920: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_RANLIB="ranlib"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:948: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # This must be in double quotes, not single quotes, because CPP may get
+ # substituted into the Makefile and "${CC-cc}" will confuse make.
+ CPP="${CC-cc} -E"
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp.
+ cat > conftest.$ac_ext <<EOF
+#line 963 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:969: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -E -traditional-cpp"
+ cat > conftest.$ac_ext <<EOF
+#line 980 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:986: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -nologo -E"
+ cat > conftest.$ac_ext <<EOF
+#line 997 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1003: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+ ac_cv_prog_CPP="$CPP"
+fi
+ CPP="$ac_cv_prog_CPP"
+else
+ ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+for ac_hdr in unistd.h limits.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:1031: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1036 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1041: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6
+echo "configure:1068: checking whether ${MAKE-make} sets \${MAKE}" >&5
+set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftestmake <<\EOF
+all:
+ @echo 'ac_maketemp="${MAKE}"'
+EOF
+# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=`
+if test -n "$ac_maketemp"; then
+ eval ac_cv_prog_make_${ac_make}_set=yes
+else
+ eval ac_cv_prog_make_${ac_make}_set=no
+fi
+rm -f conftestmake
+fi
+if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ SET_MAKE=
+else
+ echo "$ac_t""no" 1>&6
+ SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+
+#--------------------------------------------------------------------
+# unsigned char is not supported by some non-ANSI compilers.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking unsigned char""... $ac_c" 1>&6
+echo "configure:1100: checking unsigned char" >&5
+cat > conftest.$ac_ext <<EOF
+#line 1102 "configure"
+#include "confdefs.h"
+#include <stdio.h>
+int main() {
+
+ unsigned char c = 'c';
+
+; return 0; }
+EOF
+if { (eval echo configure:1111: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ tcl_ok=supported
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ tcl_ok=notsupported
+fi
+rm -f conftest*
+
+echo "$ac_t""$tcl_ok" 1>&6
+if test $tcl_ok = supported; then
+ cat >> confdefs.h <<\EOF
+#define UCHAR_SUPPORTED 1
+EOF
+
+fi
+
+#--------------------------------------------------------------------
+# Check whether there is an strcasecmp function on this system.
+# This is a bit tricky because under SCO it's in -lsocket and
+# under Sequent Dynix it's in -linet.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for strcasecmp""... $ac_c" 1>&6
+echo "configure:1137: checking for strcasecmp" >&5
+if eval "test \"`echo '$''{'ac_cv_func_strcasecmp'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1142 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char strcasecmp(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char strcasecmp();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_strcasecmp) || defined (__stub___strcasecmp)
+choke me
+#else
+strcasecmp();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1165: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_strcasecmp=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_strcasecmp=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'strcasecmp`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_ok=1
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+if test "$tcl_ok" = 0; then
+ echo $ac_n "checking for strcasecmp in -lsocket""... $ac_c" 1>&6
+echo "configure:1187: checking for strcasecmp in -lsocket" >&5
+ac_lib_var=`echo socket'_'strcasecmp | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lsocket $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1195 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char strcasecmp();
+
+int main() {
+strcasecmp()
+; return 0; }
+EOF
+if { (eval echo configure:1206: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_ok=1
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+fi
+if test "$tcl_ok" = 0; then
+ echo $ac_n "checking for strcasecmp in -linet""... $ac_c" 1>&6
+echo "configure:1230: checking for strcasecmp in -linet" >&5
+ac_lib_var=`echo inet'_'strcasecmp | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-linet $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1238 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char strcasecmp();
+
+int main() {
+strcasecmp()
+; return 0; }
+EOF
+if { (eval echo configure:1249: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_ok=1
+else
+ echo "$ac_t""no" 1>&6
+tcl_ok=0
+fi
+
+fi
+if test "$tcl_ok" = 0; then
+ cat >> confdefs.h <<\EOF
+#define NO_STRCASECMP 1
+EOF
+
+fi
+
+# Check for Tcl and Tk.
+
+dirlist=".. ../../ ../../../ ../../../../ ../../../../../ ../../../../../../ ../../../../../../.. ../../../../../../../.. ../../../../../../../../.. ../../../../../../../../../.."
+if test x"${no_tcl}" = x ; then
+ no_tcl=true
+ # Check whether --with-tclconfig or --without-tclconfig was given.
+if test "${with_tclconfig+set}" = set; then
+ withval="$with_tclconfig"
+ with_tclconfig=${withval}
+fi
+
+ echo $ac_n "checking for Tcl configuration script""... $ac_c" 1>&6
+echo "configure:1290: checking for Tcl configuration script" >&5
+ if eval "test \"`echo '$''{'ac_cv_c_tclconfig'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+
+ if test x"${with_tclconfig}" != x ; then
+ if test -f "${with_tclconfig}/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd ${with_tclconfig}; pwd)`
+ else
+ { echo "configure: error: ${with_tclconfig} directory doesn't contain tclConfig.sh" 1>&2; exit 1; }
+ fi
+ fi
+
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in $dirlist; do
+ if test -f $srcdir/$i/unix/tclConfig.sh ; then
+ ac_cv_c_tclconfig=`(cd $srcdir/$i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in $dirlist; do
+ if test -n "`ls -dr $i/tcl* 2>/dev/null`" ; then
+ tclconfpath=$i
+ break
+ fi
+ done
+
+ for i in `ls -dr $tclconfpath/tcl* 2>/dev/null ` ; do
+ if test -f $i/unix/tclConfig.sh ; then
+ ac_cv_c_tclconfig=`(cd $i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ ccpath=`which ${CC} | sed -e 's:/bin/.*::'`/lib
+ if test -f $ccpath/tclConfig.sh; then
+ ac_cv_c_tclconfig=$ccpath
+ fi
+ fi
+
+fi
+
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ TCLCONFIG=""
+ echo "configure: warning: Can't find Tcl configuration definitions" 1>&2
+ else
+ no_tcl=""
+ TCLCONFIG=${ac_cv_c_tclconfig}/tclConfig.sh
+ echo "$ac_t""${TCLCONFIG}" 1>&6
+ fi
+fi
+
+
+
+ . $TCLCONFIG
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+dirlist=".. ../../ ../../../ ../../../../ ../../../../../ ../../../../../../ ../../../../../../.. ../../../../../../../.. ../../../../../../../../.. ../../../../../../../../../.."
+if test x"${no_tk}" = x ; then
+ no_tk=true
+ # Check whether --with-tkconfig or --without-tkconfig was given.
+if test "${with_tkconfig+set}" = set; then
+ withval="$with_tkconfig"
+ with_tkconfig=${withval}
+fi
+
+ echo $ac_n "checking for Tk configuration script""... $ac_c" 1>&6
+echo "configure:1381: checking for Tk configuration script" >&5
+ if eval "test \"`echo '$''{'ac_cv_c_tkconfig'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+
+ if test x"${with_tkconfig}" != x ; then
+ if test -f "${with_tkconfig}/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd ${with_tkconfig}; pwd)`
+ else
+ { echo "configure: error: ${with_tkconfig} directory doesn't contain tkConfig.sh" 1>&2; exit 1; }
+ fi
+ fi
+
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ for i in $dirlist; do
+ if test -f $srcdir/$i/unix/tkConfig.sh ; then
+ ac_cv_c_tkconfig=`(cd $srcdir/$i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ for i in $dirlist; do
+ if test -n "`ls -dr $i/tk* 2>/dev/null`" ; then
+ tkconfpath=$i
+ break
+ fi
+ done
+
+ for i in `ls -dr $tkconfpath/tk* 2>/dev/null ` ; do
+ if test -f $i/unix/tkConfig.sh ; then
+ ac_cv_c_tkconfig=`(cd $i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ ccpath=`which ${CC} | sed -e 's:/bin/.*::'`/lib
+ if test -f $ccpath/tkConfig.sh; then
+ ac_cv_c_tkconfig=$ccpath
+ fi
+ fi
+
+fi
+
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ TKCONFIG=""
+ echo "configure: warning: Can't find Tk configuration definitions" 1>&2
+ else
+ no_tk=""
+ TKCONFIG=${ac_cv_c_tkconfig}/tkConfig.sh
+ echo "$ac_t""${TKCONFIG}" 1>&6
+ fi
+fi
+
+
+
+ if test -f "$TKCONFIG" ; then
+ . $TKCONFIG
+ fi
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+dirlist=".. ../../ ../../../ ../../../../ ../../../../../ ../../../../../../ ../../../../../../.. ../../../../../../../.. ../../../../../../../../.. ../../../../../../../../../.."
+no_tcl=true
+echo $ac_n "checking for Tcl headers in the source tree""... $ac_c" 1>&6
+echo "configure:1461: checking for Tcl headers in the source tree" >&5
+# Check whether --with-tclinclude or --without-tclinclude was given.
+if test "${with_tclinclude+set}" = set; then
+ withval="$with_tclinclude"
+ with_tclinclude=${withval}
+fi
+
+if eval "test \"`echo '$''{'ac_cv_c_tclh'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+if test x"${with_tclinclude}" != x ; then
+ if test -f ${with_tclinclude}/tcl.h ; then
+ ac_cv_c_tclh=`(cd ${with_tclinclude}; pwd)`
+ elif test -f ${with_tclinclude}/generic/tcl.h ; then
+ ac_cv_c_tclh=`(cd ${with_tclinclude}/generic; pwd)`
+ else
+ { echo "configure: error: ${with_tclinclude} directory doesn't contain headers" 1>&2; exit 1; }
+ fi
+fi
+
+if test x"${ac_cv_c_tclconfig}" != x ; then
+ for i in $dirlist; do
+ if test -f $ac_cv_c_tclconfig/$i/generic/tcl.h ; then
+ ac_cv_c_tclh=`(cd $ac_cv_c_tclconfig/$i/generic; pwd)`
+ break
+ fi
+ done
+fi
+
+if test x"${ac_cv_c_tclh}" = x ; then
+ for i in $dirlist; do
+ if test -n "`ls -dr $srcdir/$i/tcl* 2>/dev/null`" ; then
+ tclpath=$srcdir/$i
+ break
+ fi
+ done
+
+ for i in `ls -dr $tclpath/tcl* 2>/dev/null ` ; do
+ if test -f $i/generic/tcl.h ; then
+ ac_cv_c_tclh=`(cd $i/generic; pwd)`
+ break
+ fi
+ done
+fi
+
+if test x"${ac_cv_c_tclh}" = x ; then
+ ccpath=`which ${CC} | sed -e 's:/bin/.*::'`/include
+ if test -f $ccpath/tcl.h; then
+ ac_cv_c_tclh=$ccpath
+ fi
+fi
+
+if test x"${ac_cv_c_tclh}" = x ; then
+ echo "$ac_t""none" 1>&6
+ ac_safe=`echo "tcl.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for tcl.h""... $ac_c" 1>&6
+echo "configure:1518: checking for tcl.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1523 "configure"
+#include "confdefs.h"
+#include <tcl.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1528: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_cv_c_tclh=installed
+else
+ echo "$ac_t""no" 1>&6
+ac_cv_c_tclh=""
+fi
+
+else
+ echo "$ac_t""${ac_cv_c_tclh}" 1>&6
+fi
+
+fi
+
+ TCLHDIR=""
+if test x"${ac_cv_c_tclh}" = x ; then
+ { echo "configure: error: Can't find any Tcl headers" 1>&2; exit 1; }
+fi
+if test x"${ac_cv_c_tclh}" != x ; then
+ no_tcl=""
+ if test x"${ac_cv_c_tclh}" != x"installed" ; then
+ if test x"${CC}" = xcl ; then
+ tmp="`cygpath --windows ${ac_cv_c_tclh}`"
+ ac_cv_c_tclh="`echo $tmp | sed -e s#\\\\\\\\#/#g`"
+ fi
+ echo "$ac_t""${ac_cv_c_tclh}" 1>&6
+ TCLHDIR="-I${ac_cv_c_tclh}"
+ fi
+fi
+
+
+
+# FIXME: consider only doing this if --with-x given.
+
+#
+# Ok, lets find the tk source trees so we can use the headers
+# If the directory (presumably symlink) named "tk" exists, use that one
+# in preference to any others. Same logic is used when choosing library
+# and again with Tcl. The search order is the best place to look first, then in
+# decreasing significance. The loop breaks if the trigger file is found.
+# Note the gross little conversion here of srcdir by cd'ing to the found
+# directory. This converts the path from a relative to an absolute, so
+# recursive cache variables for the path will work right. We check all
+# the possible paths in one loop rather than many seperate loops to speed
+# things up.
+# the alternative search directory is involked by --with-tkinclude
+#
+dirlist=".. ../../ ../../../ ../../../../ ../../../../../ ../../../../../../ ../../../../../../.. ../../../../../../../.. ../../../../../../../../.. ../../../../../../../../../.."
+no_tk=true
+echo $ac_n "checking for Tk headers in the source tree""... $ac_c" 1>&6
+echo "configure:1592: checking for Tk headers in the source tree" >&5
+# Check whether --with-tkinclude or --without-tkinclude was given.
+if test "${with_tkinclude+set}" = set; then
+ withval="$with_tkinclude"
+ with_tkinclude=${withval}
+fi
+
+if eval "test \"`echo '$''{'ac_cv_c_tkh'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+if test x"${with_tkinclude}" != x ; then
+ if test -f ${with_tkinclude}/tk.h ; then
+ ac_cv_c_tkh=`(cd ${with_tkinclude}; pwd)`
+ elif test -f ${with_tkinclude}/generic/tk.h ; then
+ ac_cv_c_tkh=`(cd ${with_tkinclude}/generic; pwd)`
+ else
+ { echo "configure: error: ${with_tkinclude} directory doesn't contain headers" 1>&2; exit 1; }
+ fi
+fi
+
+if test x"${ac_cv_c_tkconfig}" != x ; then
+ for i in $dirlist; do
+ if test -f $ac_cv_c_tkconfig/$i/generic/tk.h ; then
+ ac_cv_c_tkh=`(cd $ac_cv_c_tkconfig/$i/generic; pwd)`
+ break
+ fi
+ done
+fi
+
+if test x"${ac_cv_c_tkh}" = x ; then
+ for i in $dirlist; do
+ if test -n "`ls -dr $srcdir/$i/tk* 2>/dev/null`" ; then
+ tkpath=$srcdir/$i
+ break
+ fi
+ done
+
+ for i in `ls -dr $tkpath/tk* 2>/dev/null ` ; do
+ if test -f $i/generic/tk.h ; then
+ ac_cv_c_tkh=`(cd $i/generic; pwd)`
+ break
+ fi
+ done
+fi
+
+if test x"${ac_cv_c_tkh}" = x ; then
+ echo "$ac_t""none" 1>&6
+ ccpath=`which ${CC} | sed -e 's:/bin/.*::'`/include
+ if test -f $ccpath/tk.h; then
+ ac_cv_c_tkh=$ccpath
+ fi
+else
+ echo "$ac_t""${ac_cv_c_tkh}" 1>&6
+fi
+
+fi
+
+ TKHDIR=""
+if test x"${ac_cv_c_tkh}" = x ; then
+ { echo "configure: error: Can't find any Tk headers" 1>&2; exit 1; }
+fi
+if test x"${ac_cv_c_tkh}" != x ; then
+ no_tk=""
+ if test x"${ac_cv_c_tkh}" != x"installed" ; then
+ if test x"${CC}" = xcl ; then
+ tmp="`cygpath --windows ${ac_cv_c_tkh}`"
+ ac_cv_c_tkh="`echo $tmp | sed -e s#\\\\\\\\#/#g`"
+ fi
+ echo "$ac_t""found in ${ac_cv_c_tkh}" 1>&6
+ TKHDIR="-I${ac_cv_c_tkh}"
+ fi
+fi
+
+
+
+
+#--------------------------------------------------------------------
+# Find out the top level source directory of the Tix package.
+#--------------------------------------------------------------------
+TIX_SRC_DIR=`cd ${srcdir}/../..; pwd`
+
+#--------------------------------------------------------------------
+# See if we should compile SAM
+#--------------------------------------------------------------------
+
+# Check whether --enable-sam or --disable-sam was given.
+if test "${enable_sam+set}" = set; then
+ enableval="$enable_sam"
+ ok=$enableval
+else
+ ok=no
+fi
+
+
+if test "$ok" = "yes"; then
+ TIX_BUILD_SAM="yes"
+ TIX_SAM_TARGETS='$(SAM_TARGETS)'
+else
+ TIX_BUILD_SAM="no"
+fi
+
+ TIX_SAM_INSTALL=_install_sam_lib_
+
+IS_ITCL=0
+ITCL_BUILD_LIB_SPEC=""
+ITK_BUILD_LIB_SPEC=""
+TIX_EXE_FILE=tixwish
+TCL_SAMEXE_FILE=satclsh
+TK_SAMEXE_FILE=sawish
+TIX_SAMEXE_FILE=satixwish
+
+#--------------------------------------------------------------------
+# Read in configuration information generated by Tcl for shared
+# libraries, and arrange for it to be substituted into our
+# Makefile.
+#--------------------------------------------------------------------
+
+CC=$TCL_CC
+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
+TIX_LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
+
+#--------------------------------------------------------------------
+# Read in configuration information generated by Tk and arrange
+# for it to be substituted into our Makefile.
+#--------------------------------------------------------------------
+
+TIX_DEFS="$TK_DEFS $TCL_DEFS"
+
+# 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.
+
+TIX_BUILD_LOCATION="`pwd`"
+if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
+ TIX_BUILD_LIB_SPEC="-L`pwd` -ltix${VERSION}"
+ TIX_BUILD_SAM_SPEC="-L`pwd` -ltixsam${VERSION}"
+ TCL_BUILD_SAM_SPEC="-L`pwd` -ltclsam${TCL_VERSION}"
+ TK_BUILD_SAM_SPEC="-L`pwd` -ltksam${TK_VERSION}"
+ TIX_LIB_SPEC="-L${exec_prefix}/lib -ltix${VERSION}"
+else
+ TIX_BUILD_LIB_SPEC="-L`pwd` -ltix`echo ${VERSION} | tr -d .`"
+ TIX_BUILD_SAM_SPEC="-L`pwd` -ltixsam`echo ${VERSION} | tr -d .`"
+ TCL_BUILD_SAM_SPEC="-L`pwd` -ltclsam`echo ${TCL_VERSION} | tr -d .`"
+ TK_BUILD_SAM_SPEC="-L`pwd` -ltksam`echo ${TK_VERSION} | tr -d .`"
+ TIX_LIB_SPEC="-L${exec_prefix}/lib -ltix`echo ${VERSION} | tr -d .`"
+fi
+
+#--------------------------------------------------------------------
+# See if we should compile shared library.
+#--------------------------------------------------------------------
+
+# Check whether --enable-shared or --disable-shared was given.
+if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ ok=$enableval
+else
+ ok=no
+fi
+
+
+if test "$ok" = "yes" -a "${SHLIB_SUFFIX}" != ""; then
+ TIX_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+ TIX_RANLIB=":"
+
+ # The main Tix library
+ #
+ eval "TIX_LIB_FILE=libtix${TCL_SHARED_LIB_SUFFIX}"
+ TIX_MAKE_LIB="\${SHLIB_LD} -o ${TIX_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tcl SAM library
+ #
+ VERSION=8.1
+ eval "TCL_SAM_FILE=libtclsam${TCL_SHARED_LIB_SUFFIX}"
+ TCL_MAKE_SAM="\${SHLIB_LD} -o ${TCL_SAM_FILE} \${TCL_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tk SAM library
+ #
+ VERSION=8.1
+ eval "TK_SAM_FILE=libtksam${TCL_SHARED_LIB_SUFFIX}"
+ TK_MAKE_SAM="\${SHLIB_LD} -o ${TK_SAM_FILE} \${TK_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tix SAM library
+ #
+ VERSION=${BIN_VERSION}
+ eval "TIX_SAM_FILE=libtixsam${TCL_SHARED_LIB_SUFFIX}"
+ TIX_MAKE_SAM="\${SHLIB_LD} -o ${TIX_SAM_FILE} \${TIX_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+else
+ TIX_SHLIB_CFLAGS=""
+ TIX_RANLIB='$(RANLIB)'
+
+ # The main Tix library
+ #
+ eval "TIX_LIB_FILE=libtix${TCL_UNSHARED_LIB_SUFFIX}"
+ TIX_MAKE_LIB="ar cr ${TIX_LIB_FILE} \${OBJS}"
+
+ # The Tcl SAM library
+
+ VERSION=8.1
+ eval "TCL_SAM_FILE=libtclsam${TCL_UNSHARED_LIB_SUFFIX}"
+ TCL_MAKE_SAM="ar cr ${TCL_SAM_FILE} \${TCL_SAM_OBJS}"
+
+ # The Tk SAM library
+ #
+ VERSION=8.1
+ eval "TK_SAM_FILE=libtksam${TCL_UNSHARED_LIB_SUFFIX}"
+ TK_MAKE_SAM="ar cr ${TK_SAM_FILE} \${TK_SAM_OBJS}"
+
+ # The Tix SAM library
+ #
+ VERSION=${BIN_VERSION}
+ eval "TIX_SAM_FILE=libtixsam${TCL_UNSHARED_LIB_SUFFIX}"
+ TIX_MAKE_SAM="ar cr ${TIX_SAM_FILE} \${TIX_SAM_OBJS}"
+fi
+
+TIX_LIB_FULL_PATH="`pwd`/${TIX_LIB_FILE}"
+
+#--------------------------------------------------------------------
+# Check for the existence of the -lsocket and -lnsl libraries.
+# The order here is important, so that they end up in the right
+# order in the command line generated by make. Here are some
+# special considerations:
+# 1. Use "connect" and "accept" to check for -lsocket, and
+# "gethostbyname" to check for -lnsl.
+# 2. Use each function name only once: can't redo a check because
+# autoconf caches the results of the last check and won't redo it.
+# 3. Use -lnsl and -lsocket only if they supply procedures that
+# aren't already present in the normal libraries. This is because
+# IRIX 5.2 has libraries, but they aren't needed and they're
+# bogus: they goof up name resolution if used.
+# 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+# To get around this problem, check for both libraries together
+# if -lsocket doesn't work by itself.
+#--------------------------------------------------------------------
+
+checked=0
+for i in $TK_LIBS; do
+ if test "$i" = "-lsocket"; then
+ checked=1
+ fi
+done
+
+if test "$checked" = "0"; then
+ tcl_checkBoth=0
+ echo $ac_n "checking for connect""... $ac_c" 1>&6
+echo "configure:1846: checking for connect" >&5
+if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1851 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char connect(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char connect();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_connect) || defined (__stub___connect)
+choke me
+#else
+connect();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1874: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_connect=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_connect=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'connect`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_checkSocket=0
+else
+ echo "$ac_t""no" 1>&6
+tcl_checkSocket=1
+fi
+
+ if test "$tcl_checkSocket" = 1; then
+ echo $ac_n "checking for main in -lsocket""... $ac_c" 1>&6
+echo "configure:1896: checking for main in -lsocket" >&5
+ac_lib_var=`echo socket'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lsocket $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1904 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:1911: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ TK_LIBS="$TK_LIBS -lsocket"
+else
+ echo "$ac_t""no" 1>&6
+tcl_checkBoth=1
+fi
+
+ fi
+ if test "$tcl_checkBoth" = 1; then
+ tk_oldLibs=$TK_LIBS
+ TK_LIBS="$TK_LIBS -lsocket -lnsl"
+ echo $ac_n "checking for accept""... $ac_c" 1>&6
+echo "configure:1937: checking for accept" >&5
+if eval "test \"`echo '$''{'ac_cv_func_accept'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1942 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char accept(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char accept();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_accept) || defined (__stub___accept)
+choke me
+#else
+accept();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:1965: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_accept=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_accept=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'accept`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_checkNsl=0
+else
+ echo "$ac_t""no" 1>&6
+TK_LIBS=$tk_oldLibs
+fi
+
+ fi
+ echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6
+echo "configure:1987: checking for gethostbyname" >&5
+if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1992 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char gethostbyname(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char gethostbyname();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_gethostbyname) || defined (__stub___gethostbyname)
+choke me
+#else
+gethostbyname();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2015: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_gethostbyname=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_gethostbyname=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+echo $ac_n "checking for main in -lnsl""... $ac_c" 1>&6
+echo "configure:2033: checking for main in -lnsl" >&5
+ac_lib_var=`echo nsl'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lnsl $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2041 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:2048: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ TK_LIBS="$TK_LIBS -lnsl"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+fi
+
+fi
+
+#----------------------------------------------------------------------
+# Substitution strings exported by TIX
+#----------------------------------------------------------------------
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+# The "binary version" of Tix (see docs/Pkg.txt)
+TIX_VERSION_PKG=${BIN_VERSION}
+
+
+TIXSAM_PKG_FILE="[file join [file dirname \$dir] ${TIX_SAM_FILE}]"
+if test "$TIX_BUILD_SAM" = "yes"; then
+ TIX_SAM_PACKAGE_IFNEEDED="package ifneeded Tixsam ${TIX_VERSION_PKG} [list load \"${TIXSAM_PKG_FILE}\" Tixsam]"
+fi
+
+# The package file, usually a shared library
+TIX_PKG_FILE="[file join [file dirname \$dir] ${TIX_LIB_FILE}]"
+
+
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.13"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "Makefile pkgIndex.tcl ../../tixConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@CC@%$CC%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@RANLIB@%$RANLIB%g
+s%@CPP@%$CPP%g
+s%@SET_MAKE@%$SET_MAKE%g
+s%@TCLCONFIG@%$TCLCONFIG%g
+s%@TCL_DEFS@%$TCL_DEFS%g
+s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g
+s%@TCL_LIB_FULL_PATH@%$TCL_LIB_FULL_PATH%g
+s%@TCL_LIBS@%$TCL_LIBS%g
+s%@TCL_CFLAGS@%$TCL_CFLAGS%g
+s%@TCL_SHLIB_CFLAGS@%$TCL_SHLIB_CFLAGS%g
+s%@TCL_SHLIB_LD@%$TCL_SHLIB_LD%g
+s%@TCL_LD_FLAGS@%$TCL_LD_FLAGS%g
+s%@TCL_LD_SEARCH_FLAGS@%$TCL_LD_SEARCH_FLAGS%g
+s%@TCL_RANLIB@%$TCL_RANLIB%g
+s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
+s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
+s%@TKCONFIG@%$TKCONFIG%g
+s%@TK_VERSION@%$TK_VERSION%g
+s%@TK_DEFS@%$TK_DEFS%g
+s%@TK_LIB_FILE@%$TK_LIB_FILE%g
+s%@TK_LIB_FULL_PATH@%$TK_LIB_FULL_PATH%g
+s%@TK_LIBS@%$TK_LIBS%g
+s%@TK_BUILD_INCLUDES@%$TK_BUILD_INCLUDES%g
+s%@TK_XINCLUDES@%$TK_XINCLUDES%g
+s%@TK_XLIBSW@%$TK_XLIBSW%g
+s%@TK_BUILD_LIB_SPEC@%$TK_BUILD_LIB_SPEC%g
+s%@TK_LIB_SPEC@%$TK_LIB_SPEC%g
+s%@TCLHDIR@%$TCLHDIR%g
+s%@TKHDIR@%$TKHDIR%g
+s%@TIX_RANLIB@%$TIX_RANLIB%g
+s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
+s%@SHLIB_LD@%$SHLIB_LD%g
+s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
+s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
+s%@SHLIB_VERSION@%$SHLIB_VERSION%g
+s%@DL_LIBS@%$DL_LIBS%g
+s%@LD_FLAGS@%$LD_FLAGS%g
+s%@TCL_VERSION@%$TCL_VERSION%g
+s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
+s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g
+s%@TK_SRC_DIR@%$TK_SRC_DIR%g
+s%@TK_BIN_DIR@%$TK_BIN_DIR%g
+s%@TIX_LD_SEARCH_FLAGS@%$TIX_LD_SEARCH_FLAGS%g
+s%@TIX_MAJOR_VERSION@%$TIX_MAJOR_VERSION%g
+s%@TIX_MINOR_VERSION@%$TIX_MINOR_VERSION%g
+s%@TIX_VERSION@%$TIX_VERSION%g
+s%@TIX_SRC_DIR@%$TIX_SRC_DIR%g
+s%@TIX_SHLIB_CFLAGS@%$TIX_SHLIB_CFLAGS%g
+s%@TIX_MAKE_LIB@%$TIX_MAKE_LIB%g
+s%@TIX_LIB_FILE@%$TIX_LIB_FILE%g
+s%@TIX_BUILD_LIB_SPEC@%$TIX_BUILD_LIB_SPEC%g
+s%@TIX_LIB_SPEC@%$TIX_LIB_SPEC%g
+s%@TIX_EXE_FILE@%$TIX_EXE_FILE%g
+s%@TIX_SAM_TARGETS@%$TIX_SAM_TARGETS%g
+s%@TIX_SAM_INSTALL@%$TIX_SAM_INSTALL%g
+s%@TIX_LIB_FULL_PATH@%$TIX_LIB_FULL_PATH%g
+s%@TCL_SAM_FILE@%$TCL_SAM_FILE%g
+s%@TCL_MAKE_SAM@%$TCL_MAKE_SAM%g
+s%@TK_SAM_FILE@%$TK_SAM_FILE%g
+s%@TK_MAKE_SAM@%$TK_MAKE_SAM%g
+s%@TIX_SAM_FILE@%$TIX_SAM_FILE%g
+s%@TIX_MAKE_SAM@%$TIX_MAKE_SAM%g
+s%@TIX_DEFS@%$TIX_DEFS%g
+s%@ITCL_BUILD_LIB_SPEC@%$ITCL_BUILD_LIB_SPEC%g
+s%@ITCL_LIB_FULL_PATH@%$ITCL_LIB_FULL_PATH%g
+s%@ITK_BUILD_LIB_SPEC@%$ITK_BUILD_LIB_SPEC%g
+s%@TCL_SAMEXE_FILE@%$TCL_SAMEXE_FILE%g
+s%@TK_SAMEXE_FILE@%$TK_SAMEXE_FILE%g
+s%@TIX_SAMEXE_FILE@%$TIX_SAMEXE_FILE%g
+s%@TCL_BUILD_SAM_SPEC@%$TCL_BUILD_SAM_SPEC%g
+s%@TK_BUILD_SAM_SPEC@%$TK_BUILD_SAM_SPEC%g
+s%@TIX_BUILD_SAM_SPEC@%$TIX_BUILD_SAM_SPEC%g
+s%@TIX_BUILD_LOCATION@%$TIX_BUILD_LOCATION%g
+s%@TIX_VERSION_PKG@%$TIX_VERSION_PKG%g
+s%@TIX_PKG_FILE@%$TIX_PKG_FILE%g
+s%@TIX_SAM_PACKAGE_IFNEEDED@%$TIX_SAM_PACKAGE_IFNEEDED%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile pkgIndex.tcl ../../tixConfig.sh"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+ case "$ac_given_INSTALL" in
+ [/$]*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ esac
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
+
diff --git a/tix/unix/tk8.1/configure.in b/tix/unix/tk8.1/configure.in
new file mode 100644
index 00000000000..701c794d28b
--- /dev/null
+++ b/tix/unix/tk8.1/configure.in
@@ -0,0 +1,372 @@
+dnl This file is an input file used by the GNU "autoconf" program to
+dnl generate the file "configure", which is run to configure the
+dnl Makefile in this directory.
+
+AC_INIT(../../generic/tixInit.c)
+
+#--------------------------------------------------------------------
+# Remove the ./config.cache file and rerun configure if
+# the cache file belong to a different architecture
+#
+# This doesn't seem to work in the Cygnus environment,
+# it causes an error message about having more than
+# one target, so I disabled it. meissner@cygnus.com
+#----------------------------------------------------------------------
+#AC_CHECK_PROG(UNAME, uname -a, [uname -a], "")
+#if test "$UNAME" = ""; then
+# AC_CHECK_PROG(UNAME, uname, [uname], "")
+#fi
+#
+#if test "$UNAME" != ""; then
+# uname=`$UNAME`
+# AC_MSG_CHECKING([cached value of \$uname])
+# AC_CACHE_VAL(ac_cv_prog_uname, [nocached=1 ac_cv_prog_uname=`$UNAME`])
+# if test "$nocached" = "1"; then
+# AC_MSG_RESULT(no)
+# else
+# AC_MSG_RESULT(yes)
+# fi
+#
+# if test "$uname" != "$ac_cv_prog_uname"; then
+# echo "Running on a different machine/architecture. Can't use cached values"
+# echo "Removing config.cache and running configure again ..."
+# rm -f config.cache
+# CMDLINE="$0 $*"
+# exec $CMDLINE
+# fi
+#fi
+
+#----------------------------------------------------------------------
+# We don't want to use any relative path because we need to generate
+# Makefile's in subdirectories
+#----------------------------------------------------------------------
+if test "$INSTALL" = "./install.sh"; then
+ INSTALL=`pwd`/install.sh
+fi
+
+#--------------------------------------------------------------------
+# Version information about this TIX release.
+#--------------------------------------------------------------------
+
+TIX_VERSION=4.1
+TIX_MAJOR_VERSION=4
+TIX_MINOR_VERSION=1
+
+BIN_VERSION=${TIX_VERSION}.8.1
+
+
+VERSION=${BIN_VERSION}
+
+#--------------------------------------------------------------------
+# See if user wants to use gcc to compile Tix. This option must
+# be used before any checking that uses the C compiler.
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(gcc, [ --enable-gcc allow use of gcc if available],
+ [tix_ok=$enableval], [tix_ok=no])
+if test "$tix_ok" = "yes"; then
+ AC_PROG_CC
+else
+ CC=${CC-cc}
+AC_SUBST(CC)
+fi
+
+AC_PROG_INSTALL
+AC_PROG_RANLIB
+AC_HAVE_HEADERS(unistd.h limits.h)
+AC_PROG_MAKE_SET
+
+#--------------------------------------------------------------------
+# unsigned char is not supported by some non-ANSI compilers.
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING([unsigned char])
+AC_TRY_COMPILE([#include <stdio.h>],[
+ unsigned char c = 'c';
+], tcl_ok=supported, tcl_ok=notsupported)
+
+AC_MSG_RESULT($tcl_ok)
+if test $tcl_ok = supported; then
+ AC_DEFINE(UCHAR_SUPPORTED)
+fi
+
+#--------------------------------------------------------------------
+# Check whether there is an strcasecmp function on this system.
+# This is a bit tricky because under SCO it's in -lsocket and
+# under Sequent Dynix it's in -linet.
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(strcasecmp, tcl_ok=1, tcl_ok=0)
+if test "$tcl_ok" = 0; then
+ AC_CHECK_LIB(socket, strcasecmp, tcl_ok=1, tcl_ok=0)
+fi
+if test "$tcl_ok" = 0; then
+ AC_CHECK_LIB(inet, strcasecmp, tcl_ok=1, tcl_ok=0)
+fi
+if test "$tcl_ok" = 0; then
+ AC_DEFINE(NO_STRCASECMP)
+fi
+
+# Check for Tcl and Tk.
+CYG_AC_PATH_TCLCONFIG
+CYG_AC_LOAD_TCLCONFIG
+CYG_AC_PATH_TKCONFIG
+CYG_AC_LOAD_TKCONFIG
+CYG_AC_PATH_TCLH
+# FIXME: consider only doing this if --with-x given.
+CYG_AC_PATH_TKH
+
+#--------------------------------------------------------------------
+# Find out the top level source directory of the Tix package.
+#--------------------------------------------------------------------
+TIX_SRC_DIR=`cd ${srcdir}/../..; pwd`
+
+#--------------------------------------------------------------------
+# See if we should compile SAM
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(sam,
+ [ --enable-sam build stand-alone modules],
+ [ok=$enableval], [ok=no])
+
+if test "$ok" = "yes"; then
+ TIX_BUILD_SAM="yes"
+ TIX_SAM_TARGETS='$(SAM_TARGETS)'
+else
+ TIX_BUILD_SAM="no"
+fi
+
+ TIX_SAM_INSTALL=_install_sam_lib_
+
+IS_ITCL=0
+ITCL_BUILD_LIB_SPEC=""
+ITK_BUILD_LIB_SPEC=""
+TIX_EXE_FILE=tixwish
+TCL_SAMEXE_FILE=satclsh
+TK_SAMEXE_FILE=sawish
+TIX_SAMEXE_FILE=satixwish
+
+#--------------------------------------------------------------------
+# Read in configuration information generated by Tcl for shared
+# libraries, and arrange for it to be substituted into our
+# Makefile.
+#--------------------------------------------------------------------
+
+CC=$TCL_CC
+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
+TIX_LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
+
+#--------------------------------------------------------------------
+# Read in configuration information generated by Tk and arrange
+# for it to be substituted into our Makefile.
+#--------------------------------------------------------------------
+
+TIX_DEFS="$TK_DEFS $TCL_DEFS"
+
+# 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.
+
+TIX_BUILD_LOCATION="`pwd`"
+if test "${TCL_LIB_VERSIONS_OK}" = "ok"; then
+ TIX_BUILD_LIB_SPEC="-L`pwd` -ltix${VERSION}"
+ TIX_BUILD_SAM_SPEC="-L`pwd` -ltixsam${VERSION}"
+ TCL_BUILD_SAM_SPEC="-L`pwd` -ltclsam${TCL_VERSION}"
+ TK_BUILD_SAM_SPEC="-L`pwd` -ltksam${TK_VERSION}"
+ TIX_LIB_SPEC="-L${exec_prefix}/lib -ltix${VERSION}"
+else
+ TIX_BUILD_LIB_SPEC="-L`pwd` -ltix`echo ${VERSION} | tr -d .`"
+ TIX_BUILD_SAM_SPEC="-L`pwd` -ltixsam`echo ${VERSION} | tr -d .`"
+ TCL_BUILD_SAM_SPEC="-L`pwd` -ltclsam`echo ${TCL_VERSION} | tr -d .`"
+ TK_BUILD_SAM_SPEC="-L`pwd` -ltksam`echo ${TK_VERSION} | tr -d .`"
+ TIX_LIB_SPEC="-L${exec_prefix}/lib -ltix`echo ${VERSION} | tr -d .`"
+fi
+
+#--------------------------------------------------------------------
+# See if we should compile shared library.
+#--------------------------------------------------------------------
+
+AC_ARG_ENABLE(shared,
+ [ --enable-shared build libtix as a shared library],
+ [ok=$enableval], [ok=no])
+
+if test "$ok" = "yes" -a "${SHLIB_SUFFIX}" != ""; then
+ TIX_SHLIB_CFLAGS="${SHLIB_CFLAGS}"
+ TIX_RANLIB=":"
+
+ # The main Tix library
+ #
+ eval "TIX_LIB_FILE=libtix${TCL_SHARED_LIB_SUFFIX}"
+ TIX_MAKE_LIB="\${SHLIB_LD} -o ${TIX_LIB_FILE} \${OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tcl SAM library
+ #
+ VERSION=8.1
+ eval "TCL_SAM_FILE=libtclsam${TCL_SHARED_LIB_SUFFIX}"
+ TCL_MAKE_SAM="\${SHLIB_LD} -o ${TCL_SAM_FILE} \${TCL_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tk SAM library
+ #
+ VERSION=8.1
+ eval "TK_SAM_FILE=libtksam${TCL_SHARED_LIB_SUFFIX}"
+ TK_MAKE_SAM="\${SHLIB_LD} -o ${TK_SAM_FILE} \${TK_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+ # The Tix SAM library
+ #
+ VERSION=${BIN_VERSION}
+ eval "TIX_SAM_FILE=libtixsam${TCL_SHARED_LIB_SUFFIX}"
+ TIX_MAKE_SAM="\${SHLIB_LD} -o ${TIX_SAM_FILE} \${TIX_SAM_OBJS} ${SHLIB_LD_LIBS}"
+
+else
+ TIX_SHLIB_CFLAGS=""
+ TIX_RANLIB='$(RANLIB)'
+
+ # The main Tix library
+ #
+ eval "TIX_LIB_FILE=libtix${TCL_UNSHARED_LIB_SUFFIX}"
+ TIX_MAKE_LIB="ar cr ${TIX_LIB_FILE} \${OBJS}"
+
+ # The Tcl SAM library
+
+ VERSION=8.1
+ eval "TCL_SAM_FILE=libtclsam${TCL_UNSHARED_LIB_SUFFIX}"
+ TCL_MAKE_SAM="ar cr ${TCL_SAM_FILE} \${TCL_SAM_OBJS}"
+
+ # The Tk SAM library
+ #
+ VERSION=8.1
+ eval "TK_SAM_FILE=libtksam${TCL_UNSHARED_LIB_SUFFIX}"
+ TK_MAKE_SAM="ar cr ${TK_SAM_FILE} \${TK_SAM_OBJS}"
+
+ # The Tix SAM library
+ #
+ VERSION=${BIN_VERSION}
+ eval "TIX_SAM_FILE=libtixsam${TCL_UNSHARED_LIB_SUFFIX}"
+ TIX_MAKE_SAM="ar cr ${TIX_SAM_FILE} \${TIX_SAM_OBJS}"
+fi
+
+TIX_LIB_FULL_PATH="`pwd`/${TIX_LIB_FILE}"
+
+#--------------------------------------------------------------------
+# Check for the existence of the -lsocket and -lnsl libraries.
+# The order here is important, so that they end up in the right
+# order in the command line generated by make. Here are some
+# special considerations:
+# 1. Use "connect" and "accept" to check for -lsocket, and
+# "gethostbyname" to check for -lnsl.
+# 2. Use each function name only once: can't redo a check because
+# autoconf caches the results of the last check and won't redo it.
+# 3. Use -lnsl and -lsocket only if they supply procedures that
+# aren't already present in the normal libraries. This is because
+# IRIX 5.2 has libraries, but they aren't needed and they're
+# bogus: they goof up name resolution if used.
+# 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+# To get around this problem, check for both libraries together
+# if -lsocket doesn't work by itself.
+#--------------------------------------------------------------------
+
+checked=0
+for i in $TK_LIBS; do
+ if test "$i" = "-lsocket"; then
+ checked=1
+ fi
+done
+
+if test "$checked" = "0"; then
+ tcl_checkBoth=0
+ AC_CHECK_FUNC(connect, tcl_checkSocket=0, tcl_checkSocket=1)
+ if test "$tcl_checkSocket" = 1; then
+ AC_CHECK_LIB(socket, main, TK_LIBS="$TK_LIBS -lsocket",
+ tcl_checkBoth=1)
+ fi
+ if test "$tcl_checkBoth" = 1; then
+ tk_oldLibs=$TK_LIBS
+ TK_LIBS="$TK_LIBS -lsocket -lnsl"
+ AC_CHECK_FUNC(accept, tcl_checkNsl=0, [TK_LIBS=$tk_oldLibs])
+ fi
+ AC_CHECK_FUNC(gethostbyname, , AC_CHECK_LIB(nsl, main,
+ [TK_LIBS="$TK_LIBS -lnsl"]))
+fi
+
+#----------------------------------------------------------------------
+# Substitution strings exported by TIX
+#----------------------------------------------------------------------
+AC_SUBST(CC)
+AC_SUBST(RANLIB)
+AC_SUBST(TIX_RANLIB)
+AC_SUBST(SHLIB_CFLAGS)
+AC_SUBST(SHLIB_LD)
+AC_SUBST(SHLIB_LD_LIBS)
+AC_SUBST(SHLIB_SUFFIX)
+AC_SUBST(SHLIB_VERSION)
+AC_SUBST(DL_LIBS)
+AC_SUBST(LD_FLAGS)
+AC_SUBST(TCL_BUILD_LIB_SPEC)
+AC_SUBST(TCL_LIBS)
+AC_SUBST(TCL_VERSION)
+AC_SUBST(TCL_SRC_DIR)
+AC_SUBST(TCL_BIN_DIR)
+AC_SUBST(TCL_LIB_FULL_PATH)
+AC_SUBST(TK_BUILD_LIB_SPEC)
+AC_SUBST(TK_LIBS)
+AC_SUBST(TK_VERSION)
+AC_SUBST(TK_SRC_DIR)
+AC_SUBST(TK_BIN_DIR)
+AC_SUBST(TK_XINCLUDES)
+AC_SUBST(TK_LIB_FULL_PATH)
+AC_SUBST(TIX_LD_SEARCH_FLAGS)
+AC_SUBST(TIX_MAJOR_VERSION)
+AC_SUBST(TIX_MINOR_VERSION)
+AC_SUBST(TIX_VERSION)
+AC_SUBST(TIX_SRC_DIR)
+AC_SUBST(TIX_SHLIB_CFLAGS)
+AC_SUBST(TIX_MAKE_LIB)
+AC_SUBST(TIX_LIB_FILE)
+AC_SUBST(TIX_BUILD_LIB_SPEC)
+AC_SUBST(TIX_LIB_SPEC)
+AC_SUBST(TIX_EXE_FILE)
+AC_SUBST(TIX_SAM_TARGETS)
+AC_SUBST(TIX_SAM_INSTALL)
+AC_SUBST(TIX_LIB_FULL_PATH)
+AC_SUBST(TCL_SAM_FILE)
+AC_SUBST(TCL_MAKE_SAM)
+AC_SUBST(TK_SAM_FILE)
+AC_SUBST(TK_MAKE_SAM)
+AC_SUBST(TIX_SAM_FILE)
+AC_SUBST(TIX_MAKE_SAM)
+AC_SUBST(TIX_DEFS)
+AC_SUBST(ITCL_BUILD_LIB_SPEC)
+AC_SUBST(ITCL_LIB_FULL_PATH)
+AC_SUBST(ITK_BUILD_LIB_SPEC)
+AC_SUBST(TCL_SAMEXE_FILE)
+AC_SUBST(TK_SAMEXE_FILE)
+AC_SUBST(TIX_SAMEXE_FILE)
+AC_SUBST(TCL_BUILD_SAM_SPEC)
+AC_SUBST(TK_BUILD_SAM_SPEC)
+AC_SUBST(TIX_BUILD_SAM_SPEC)
+AC_SUBST(TIX_BUILD_LOCATION)
+
+# The "binary version" of Tix (see docs/Pkg.txt)
+TIX_VERSION_PKG=${BIN_VERSION}
+AC_SUBST(TIX_VERSION_PKG)
+
+TIXSAM_PKG_FILE="[[file join [file dirname \$dir] ${TIX_SAM_FILE}]]"
+if test "$TIX_BUILD_SAM" = "yes"; then
+ TIX_SAM_PACKAGE_IFNEEDED="package ifneeded Tixsam ${TIX_VERSION_PKG} [[list load \"${TIXSAM_PKG_FILE}\" Tixsam]]"
+fi
+
+# The package file, usually a shared library
+TIX_PKG_FILE="[[file join [file dirname \$dir] ${TIX_LIB_FILE}]]"
+AC_SUBST(TIX_PKG_FILE)
+AC_SUBST(TIX_SAM_PACKAGE_IFNEEDED)
+
+AC_OUTPUT(Makefile pkgIndex.tcl ../../tixConfig.sh)
+
diff --git a/tix/unix/tk8.1/pkgIndex.tcl.in b/tix/unix/tk8.1/pkgIndex.tcl.in
new file mode 100644
index 00000000000..fc82f9db9b6
--- /dev/null
+++ b/tix/unix/tk8.1/pkgIndex.tcl.in
@@ -0,0 +1,4 @@
+# Tcl package index file, version 1.0
+
+package ifneeded Tix @TIX_VERSION_PKG@ [list load "@TIX_PKG_FILE@" Tix]
+@TIX_SAM_PACKAGE_IFNEEDED@
diff --git a/tix/unix/tk8.1/tixAppInit.c b/tix/unix/tk8.1/tixAppInit.c
new file mode 100644
index 00000000000..69621043b2d
--- /dev/null
+++ b/tix/unix/tk8.1/tixAppInit.c
@@ -0,0 +1,112 @@
+/*
+ * tixAppInit.c --
+ *
+ * Provides a default version of the Tcl_AppInit procedure for
+ * use in wish and similar Tk-based applications.
+ *
+ * Copyright (c) 1995 Ioi K Lam
+ * 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.
+ */
+
+#include <tk.h>
+#include <tix.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;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ * This is the main program for the application.
+ *
+ * Results:
+ * None: Tk_Main never returns here, so this procedure never
+ * returns either.
+ *
+ * Side effects:
+ * Whatever the application does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+main(argc, argv)
+ int argc; /* Number of command-line arguments. */
+ char **argv; /* Values of command-line arguments. */
+{
+ Tk_Main(argc, argv, Tcl_AppInit);
+ return 0; /* Needed only to prevent compiler warning. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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, (Tcl_PackageInitProc *) NULL);
+ if (Tix_Init(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tix", Tix_Init, (Tcl_PackageInitProc *) NULL);
+
+ /*
+ * Call the init procedures for included packages. Each call should
+ * look like this:
+ *
+ * if (Mod_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * where "Mod" is the name of the module.
+ */
+
+ /*
+ * Call Tcl_CreateCommand for application-specific commands, if
+ * they weren't already created by the init procedures called above.
+ */
+
+ /*
+ * Specify a user-specific startup file to invoke if the application
+ * is run interactively. Typically the startup file is "~/.apprc"
+ * where "app" is the name of the application. If this line is deleted
+ * then no user-specific startup file will be run under any conditions.
+ */
+ Tix_SetRcFileName(interp, "~/.tixwishrc");
+
+ return TCL_OK;
+}
diff --git a/tix/win/DLLDemo/Demo.c b/tix/win/DLLDemo/Demo.c
new file mode 100644
index 00000000000..d15ec554b20
--- /dev/null
+++ b/tix/win/DLLDemo/Demo.c
@@ -0,0 +1,132 @@
+/*
+ * Demo.c --
+ *
+ * Demonstrates how to create a Windows DLL that uses Tcl/Tk and
+ * (optionally) Tix.
+ *
+ * A Windows DLL for Tcl/TK must have three functions. Two of them
+ * are DLL Entry Points, required by Windows and are called when
+ * the DLL is loaded into Windows. The third one is a function
+ * called <Pkg>_Init, which is called when the DLL is loaded into
+ * tclsh.exe or wish.exe via the "load" command.
+ *
+ * DLL Entry Points:
+ *
+ * For the two DLL entry points, actually only one of them is called,
+ * depending which compiler you are using. If you use VC++, you should
+ * define the function DllMain. If you use Borland C++, you should
+ * define the function DllEntryPoint. In this file, we just define
+ * both of them so that this file can be happily compiled under
+ * both compilers. We will just make DllEntryPoint to call DllMain(),
+ * which should carry any initialization actions required. In most
+ * cases, however, we wouldn't do any initialization and just return
+ * TRUE.
+ *
+ * <Pkg>_Init function
+ *
+ * You must have a function called <Pkg>_Init, where <Pkg> is the name
+ * of your package. In our case, we name the package "Demo" so the
+ * function is Demo_Init(). It should just do the normal sort of
+ * initializations required by a Tcl extension (create commands,
+ * variables, etc). In our example, we create a command called
+ * "demoHello" which just returns the string "Hello Tcl/Tk World".
+ *
+ * Linking to the C language API of Tix
+ *
+ * Nothing special needs to be done. You have to make sure the Tix
+ * header files are in the INCLUDE directories and like against Tix41.lib
+ * when you create your DLL. See the "demo_tix.dll" target in
+ * the makefile.bc
+ */
+#include <tkPort.h>
+#include <tkWinInt.h>
+#include <tkInt.h>
+
+/*
+ * Forward Declarations
+ */
+
+BOOL APIENTRY DllMain _ANSI_ARGS_((HINSTANCE hInst,
+ DWORD reason, LPVOID reserved));
+
+int Demo_HelloCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp * interp, int argc, char ** argv));
+/*
+ *----------------------------------------------------------------------
+ *
+ * DllEntryPoint --
+ *
+ * This wrapper function is used by Borland to invoke the
+ * initialization code for Tk. It simply calls the DllMain
+ * routine.
+ *
+ * Results:
+ * See DllMain.
+ *
+ * Side effects:
+ * See DllMain.
+ *
+ *----------------------------------------------------------------------
+ */
+
+BOOL APIENTRY
+DllEntryPoint(hInst, reason, reserved)
+ HINSTANCE hInst; /* Library instance handle. */
+ DWORD reason; /* Reason this function is being called. */
+ LPVOID reserved; /* Not used. */
+{
+ return DllMain(hInst, reason, reserved);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DllMain --
+ *
+ * DLL entry point.
+ *
+ * Results:
+ * TRUE on sucess, FALSE on failure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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.
+ */
+
+ return(TRUE);
+}
+
+
+int
+Demo_HelloCmd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp * interp;
+ int argc;
+ char ** argv;
+{
+ Tcl_AppendResult(interp, "Hello Tcl/Tk World", NULL);
+
+ return TCL_OK;
+}
+
+int _export
+Demo_Init(interp)
+ Tcl_Interp * interp;
+{
+ Tcl_CreateCommand(interp, "demoHello", Demo_HelloCmd, NULL, NULL);
+
+ return TCL_OK;
+}
diff --git a/tix/win/DLLDemo/Makefile.bc b/tix/win/DLLDemo/Makefile.bc
new file mode 100644
index 00000000000..f98ec0c8ff5
--- /dev/null
+++ b/tix/win/DLLDemo/Makefile.bc
@@ -0,0 +1,178 @@
+# 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.
+#
+
+
+#
+# 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
+#
+
+TMPDIR = .
+TOOLS = d:\bc45
+TCLDIR = D:\tcl7.5
+TKDIR = D:\tk4.1
+TIXDIR = D:\Tix4.1a2
+
+# uncomment the following line to compile with symbols
+#DEBUG=1
+
+# uncomment the following two lines to compile with TCL_MEM_DEBUG
+#DEBUGDEFINES =TCL_MEM_DEBUG
+
+# You shouldn't need to change anything below this line
+# -------------------------------------------------------------------
+
+#
+# Borland C++ tools
+#
+
+BORLAND = $(TOOLS)
+IMPLIB = Implib
+BCC32 = Bcc32
+BCC = Bcc
+RC = brcc32
+CP = copy
+RM = del
+
+TCL_INCLUDES = $(TCLDIR)\generic;$(TCLDIR)\win
+TK_INCLUDES = $(TKDIR)\generic;$(TKDIR)\xlib;$(TKDIR)\win
+TIX_INCLUDES = $(TIXDIR)\include;$(TIXDIR)\generic;$(TIXDIR)\win
+INCLUDES = $(BORLAND)\include;$(TIX_INCLUDES);$(TK_INCLUDES);$(TCL_INCLUDES)
+
+LIBDIRS = $(BORLAND)\lib
+TCLLIBDIR = $(TCLDIR)\win
+TKLIBDIR = $(TKDIR)\win
+TIXLIBDIR = $(TIXDIR)\win
+
+
+!ifndef DEBUG
+
+# these macros cause maximum optimization and no symbols
+DEBUGLDFLAGS =
+DEBUGCCFLAGS = -v- -vi- -O2
+
+!else
+
+# these macros enable debugging
+DEBUGLDFLAGS = -v
+DEBUGCCFLAGS = -k -Od -v
+
+!endif
+
+DEFINES = _RTLDLL;$(DEBUGDEFINES)
+
+PROJECTCCFLAGS= $(DEBUGCCFLAGS) -w-par -w-stu
+
+LNFLAGS_dll = -Tpd -aa -c $(DEBUGLDFLAGS) $(BORLAND)\lib\c0d32
+LNLIBS_dll = $(TKLIBDIR)\$(TKLIB) $(TCLLIBDIR)\$(TCLLIB) import32 cw32i
+LNLIBS_tixdll = $(TIXLIBDIR)\$(TIXLIB) $(TKLIBDIR)\$(TKLIB) $(TCLLIBDIR)\$(TCLLIB) import32 cw32i
+
+#
+# Global makefile settings
+#
+
+.AUTODEPEND
+.CACHEAUTODEPEND
+
+.suffixes: .c .dll .lib .obj .exe
+
+.path.c=.
+.path.obj=$(TMPDIR)
+
+OBJS = $(TMPDIR)\Demo.obj
+
+TCLLIB = tcl75.lib
+TKLIB = tk41.lib
+TIXLIB = tix41.lib
+TCLDLL = tcl75.dll
+TKDLL = tk41.dll
+TIXDLL = tix41.dll
+
+# This target is a DLL that depends only on Tcl and TK
+#
+DEMO_DLL = demo.dll
+
+# This target is a DLL that depends on Tcl, TK and Tix
+#
+DEMO_TIX_DLL = demo_tix.dll
+
+#
+# Targets
+#
+
+all: cfgdll $(DEMO_DLL) cfgcln
+
+tix: cfgdll $(DEMO_TIX_DLL) cfgcln
+
+# Implicit Targets
+
+.c.obj:
+ @$(BCC32) {$< }
+
+.dll.lib:
+ $(IMPLIB) -c $@ $<
+
+#
+# Configuration file targets - these files are implicitly used by the compiler
+#
+
+cfgdll:
+ @$(CP) &&|
+ -n$(TMPDIR) -I$(INCLUDES) -c -WD
+ -D$(DEFINES) -3 -d $(PROJECTCCFLAGS)
+| bcc32.cfg >NUL
+
+cfgcln:
+ @$(RM) bcc32.cfg
+
+#
+# DLL targets
+#
+
+$(DEMO_DLL): $(OBJS) demo.def
+ tlink32 @&&|
+$(LNFLAGS_dll) $(OBJS)
+$@
+-x
+$(LNLIBS_dll)
+demo.def
+|
+
+#
+# DLL targets
+#
+
+$(DEMO_TIX_DLL): $(OBJS) demo.def
+ tlink32 @&&|
+$(LNFLAGS_dll) $(OBJS)
+$@
+-x
+$(LNLIBS_tixdll)
+demo.def
+|
+
+
+# The following rule automatically generates a tix.def file containing
+# an export entry for every public symbol in the $(TKDLL) library.
+
+demo.def: $(OBJS)
+ $(TCLLIBDIR)\dumpexts.exe -o $@ $(DEMO_DLL) @&&|
+ $(OBJS)
+|
+
+# remove all generated files
+
+clean:
+ $(RM) $(DEMO_DLL)
+ $(RM) $(DEMO_TIX_DLL)
+ $(RM) demo.def
+ $(RM) $(TMPDIR)\*.obj
+ $(RM) bcc32.cfg
diff --git a/tix/win/DLLDemo/README b/tix/win/DLLDemo/README
new file mode 100644
index 00000000000..1dc5b1d24aa
--- /dev/null
+++ b/tix/win/DLLDemo/README
@@ -0,0 +1,72 @@
+(0) Introduction:
+
+ The files in this directory demonstrates how to create a Win32 DLL
+ for Tcl/TK. It creates a file called DEMO.DLL which can be loaded
+ into wish41.exe via the "load" command.
+
+ The Borland C++ makefile (Makefile.bc) and a C file (Demo.c) gives
+ an example for all the steps that you need to take to create such a
+ DLL to load under Tcl/Tk. Moreover, if you are using Tix and need to
+ call the Tix C functions in your DLL, please refer to the Makefile.bc
+ for the necessary compilation flags required.
+
+(1) Requirement:
+
+ Tcl/Tk sources are required. You can download them from
+
+ ftp://ftp.smli.com/pub/tcl/tcl75b3.zip
+ ftp://ftp.smli.com/pub/tcl/tk41b3.zip
+
+ Tix sources are required in you need to compile against Tix.DLL. It
+ can be downloaded from
+
+ ftp://ftp.xpi.com/pub/windows/tix41a2.zip
+
+(2) Compilation:
+
+ (a) You must compile the Tcl/Tk sources first. The reason is we
+ need the files tcl75.lib and tk41.lib, which are not released
+ by Sun in their binary release. This is also a good exercise
+ for you to set up your environment for compiling Tcl/Tk-based
+ software.
+
+ If you have BC++ (4.5 or later) installed on your system, edit
+ the header part of the file tcl7.5b3\win\makefile.bc to reflect
+ the settings in your environment. Then
+
+ cd tcl7.5b3\win\
+ make -f makefile.bc
+
+ When this finishes, you will get tcl75.dll and tcl75.lib in this
+ directory.
+
+ Do the same things to get tk41.dll and tk41.lib
+
+ (b) Now cd to the DLLDemo directory and edit the file makefile.bc to
+ to reflect the settings in your environment. Don't worry about the
+ setting of the TIX directories yet.
+
+ Now type
+
+ make -f makefile.bc
+
+ in this directory. When this is done, you should get a demo.dll. Start
+ up wish41.exe. When you get the console screen, type the following
+ in it:
+
+ load demo.dll
+ puts [demoHello]
+
+ (c) If your DLL doesn't need to call the C functions of Tix (like our
+ demo.dll), you can stop here. If you need to call the Tix C functions,
+ then first install the Tix sources and get tix41.lib and tix41.dll.
+ then change back to the DLLDemo directory and type
+
+ make -f makefile.bc tix
+
+ This will compile a demo_tix.dll that is linked to tix41.dll, tk41.dll
+ and tcl75.dll.
+
+
+
+
diff --git a/tix/win/Makefile.in b/tix/win/Makefile.in
new file mode 100644
index 00000000000..3797c8581e0
--- /dev/null
+++ b/tix/win/Makefile.in
@@ -0,0 +1,620 @@
+# This file is CYGNUS LOCAL. It is a copy of makefile.vc modified for
+# GNU make. Only the support for tcl 7.6 is finished.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+VPATH = @srcdir@:@srcdir@/../generic
+srcdir = @srcdir@
+
+CC = @CC@
+CFLAGS = @CFLAGS@
+NM = @NM@
+AS = @AS@
+LD = @LD@
+DLLTOOL = @DLLTOOL@
+WINDRES = @WINDRES@
+OBJEXT = @OBJEXT@
+
+# makefile.vc --
+#
+# Visual C++ 4.x makefile for Tix.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#----------------------------------------------------------------------
+# Environment setting
+#
+# You can set the following variables in your DOS environment. This
+# way you don't need to change this file. E.g.:
+#
+# set TCL_VER=7.5
+# nmake -f makefile.vc
+#
+# You can also set these variables in the command line to nmake. E.g.:
+#
+# nmake TCL_VER=7.5 -f makefile.vc
+#
+# TOOLS32 = location of VC++ 32-bit development tools.
+# TIX_DEBUG = Compile Tix with debug information.
+# TCL_VER = version of Tcl to compile with. Should be either 7.5
+# or 7.6
+#----------------------------------------------------------------------
+
+#!IFNDEF TOOLS32
+#TOOLS32 = C:\msdev
+#!ENDIF
+
+#!IFNDEF TIX_DEBUG
+#NODEBUG=1
+#!ENDIF
+
+#!IFNDEF TCL_VER
+#TCL_VER = 7.6
+#!ENDIF
+
+TCL_VER = @TCL_VER@
+
+ifeq ($(TCL_VER),7.5)
+
+TMPDIR = tcl7.5
+TCLDIR = ../../tcl7.5
+TKDIR = ../../tk4.1
+TCLLIB = tcl75.lib
+TCLDLL = tcl75.dll
+TKLIB = tk41.lib
+TKDLL = tk41.dll
+TIXLIB = $(TMPDIR)/tix4175.lib
+TIXLIBNAME = tix4175.lib
+TIXDLL = $(TMPDIR)/tix4175.dll
+TIXDLLNAME = tix4175.dll
+TIXWISH = $(TMPDIR)/tix4175.exe
+TIXWISHNAME = tix4175.exe
+
+CONSOLE_OBJ = tkConsole41.$(OBJEXT)
+
+endif
+
+ifeq ($(TCL_VER),7.6)
+
+TMPDIR = tcl7.6
+TCLDIR = ../../tcl
+TCLSRCDIR = $(srcdir)/../../tcl
+TKDIR = ../../tk
+TKSRCDIR = $(srcdir)/../../tk
+TCLLIB = libtcl76.a
+TCLDLL = cygtcl76.dll
+TKLIB = libtk42.a
+TKDLL = cygtk42.dll
+TIXLIB = $(TMPDIR)/libtix4176.a
+TIXLIBNAME = libtix4176.a
+TIXDLL = $(TMPDIR)/tix4176.dll
+TIXDLLNAME = tix4176.dll
+TIXWISH = $(TMPDIR)/tix4176.exe
+TIXWISHNAME = tix4176.exe
+
+CONSOLE_OBJ = tkConsole42.$(OBJEXT)
+
+endif
+
+ifeq ($(TCL_VER),8.0a1)
+
+TMPDIR = tcl8.0
+TCLDIR = ../../tcl8.0a1
+TKDIR = ../../tk8.0a1
+TCLLIB = tcl80.lib
+TCLDLL = tcl80.dll
+TKLIB = tk80.lib
+TKDLL = tk80.dll
+TIXLIB = $(TMPDIR)/tix4180.lib
+TIXLIBNAME = tix4180.lib
+TIXDLL = $(TMPDIR)/tix4180.dll
+TIXDLLNAME = tix4180.dll
+TIXWISH = $(TMPDIR)/tix4180.exe
+TIXWISHNAME = tix4180.exe
+
+CONSOLE_OBJ = tkConsole80a1.$(OBJEXT)
+
+endif
+
+ifeq ($(TCL_VER),8.0b1)
+
+TMPDIR = tcl8.0
+TCLDIR = ../../tcl8.0b1
+TKDIR = ../../tk8.0b1
+TCLLIB = tcl80.lib
+TCLDLL = tcl80.dll
+TKLIB = tk80.lib
+TKDLL = tk80.dll
+TIXLIB = $(TMPDIR)/tix4180.lib
+TIXLIBNAME = tix4180.lib
+TIXDLL = $(TMPDIR)/tix4180.dll
+TIXDLLNAME = tix4180.dll
+TIXWISH = $(TMPDIR)/tix4180.exe
+TIXWISHNAME = tix4180.exe
+
+CONSOLE_OBJ = tkConsole80b1.$(OBJEXT)
+
+endif
+
+ifeq ($(TCL_VER),8.0)
+
+TMPDIR = tcl8.0
+TCLDIR = ../../tcl
+TCLSRCDIR = $(srcdir)/../../tcl
+TKDIR = ../../tk
+TKSRCDIR = $(srcdir)/../../tk
+TCLLIB = libtcl80.a
+ifeq ($(OBJEXT),obj)
+TCLDLL = sntcl80.dll
+else
+TCLDLL = cygtcl80.dll
+endif
+TKLIB = libtk80.a
+ifeq ($(OBJEXT),obj)
+TKDLL = sntk80.dll
+else
+TKDLL = cygtk80.dll
+endif
+TIXRAWLIBNAME = $(TMPDIR)/tix4180.lib
+TIXLIB = $(TMPDIR)/libtix4180.a
+TIXLIBNAME = libtix4180.a
+TIXDLL = $(TMPDIR)/tix4180.dll
+TIXDLLNAME = tix4180.dll
+TIXWISH = $(TMPDIR)/tix4180.exe
+TIXWISHNAME = tix4180.exe
+
+CONSOLE_OBJ = tkConsole80b1.$(OBJEXT)
+
+endif
+
+ifeq ($(TCL_VER),8.1)
+
+TMPDIR = tcl8.1
+TCLDIR = ../../tcl8.1
+TCLSRCDIR = $(srcdir)/../../tcl8.1
+TKDIR = ../../tk8.1
+TKSRCDIR = $(srcdir)/../../tk8.1
+TCLLIB = libtcl81.a
+ifeq ($(OBJEXT),obj)
+TCLDLL = sntcl81.dll
+else
+TCLDLL = cygtcl81.dll
+endif
+TKLIB = libtk81.a
+ifeq ($(OBJEXT),obj)
+TKDLL = sntk81.dll
+else
+TKDLL = cygtk81.dll
+endif
+TIXRAWLIBNAME = $(TMPDIR)/tix4181.lib
+TIXLIB = $(TMPDIR)/libtix4181.a
+TIXLIBNAME = libtix4181.a
+TIXDLL = $(TMPDIR)/tix4181.dll
+TIXDLLNAME = tix4181.dll
+TIXWISH = $(TMPDIR)/tix4181.exe
+TIXWISHNAME = tix4181.exe
+
+CONSOLE_OBJ = tkConsole81.$(OBJEXT)
+
+endif
+
+
+ifeq ($(TCL_VER),2.2i)
+
+TMPDIR = itcl2.2
+ITCL_DIR = ../../itcl2.2
+TCLDIR = $(ITCL_DIR)/tcl7.6
+TKDIR = $(ITCL_DIR)/tk4.2
+TCLLIB = tcl76i.lib
+TCLDLL = tcl76i.dll
+TKLIB = tk42i.lib
+TKDLL = tk42i.dll
+TIXLIB = $(TMPDIR)/tix41761.lib
+TIXLIBNAME = tix41761.lib
+TIXDLL = $(TMPDIR)/tix41761.dll
+TIXDLLNAME = tix41761.dll
+TIXWISH = $(TMPDIR)/tix41761.exe
+TIXWISHNAME = tix41761.exe
+
+CONSOLE_OBJ = tkConsole42.$(OBJEXT)
+
+ITCL_LIBS = $(ITCL_DIR)\itcl\win\itcl22.lib $(ITCL_DIR)\itk\win\itk22.lib
+ITCL_CFLAGS = -DITCL_2 -I$(ITCL_DIR)\itcl\generic -I$(ITCL_DIR)\itk\generic
+
+endif
+
+#!IFNDEF TCLDIR
+#!ERROR "Unsupported Tcl version $(TCL_VER)"
+#!ENDIF
+
+ifeq ($(OBJEXT),obj)
+TMPDIR=.
+endif
+
+# Project directories
+#
+# ROOT = top of source tree
+# TMPDIR = location where .o files should be stored during build
+# TCLDIR = location of top of Tcl source heirarchy
+#
+
+ROOT = ..
+
+# uncomment the following two lines to compile with TCL_MEM_DEBUG
+#DEBUGDEFINES =-DTCL_MEM_DEBUG
+
+# Make sure the VC++ tools are at the head of the path
+#PATH=$(TOOLS32)\bin;$(PATH)
+
+TCLLIBDIR = $(TCLDIR)/win
+TKLIBDIR = $(TKDIR)/win
+WINDIR = $(ROOT)/win
+GENERICDIR = $(ROOT)/generic
+XLIBDIR = $(ROOT)/xlib
+
+cc32 = $(TOOLS32)\bin\cl -I$(TOOLS32)\include
+rc32 = $(TOOLS32)\bin\rc
+link32 = $(TOOLS32)\bin\link
+
+#----------------------------------------------------------------------
+# You shouldn't normally modify anything below this line
+#----------------------------------------------------------------------
+
+X_TK_INCLUDES = -I$(srcdir) -I$(srcdir)/../generic \
+ -I$(TKSRCDIR)/generic -I$(TKSRCDIR)/win -I$(TKSRCDIR)/xlib \
+ -I$(TCLSRCDIR)/generic
+
+TK_INCLUDES = -D_Windows $(X_TK_INCLUDES)
+
+TK_DEFINES = \
+ -nologo $(DEBUGDEFINES)
+
+WISHOBJS = \
+ $(TMPDIR)/tixWinMain.$(OBJEXT)
+
+TIXOBJS = \
+ $(TMPDIR)/$(CONSOLE_OBJ) \
+ $(TMPDIR)/tixClass.$(OBJEXT) \
+ $(TMPDIR)/tixCmds.$(OBJEXT) \
+ $(TMPDIR)/tixCompat.$(OBJEXT) \
+ $(TMPDIR)/tixDiImg.$(OBJEXT) \
+ $(TMPDIR)/tixDiITxt.$(OBJEXT) \
+ $(TMPDIR)/tixDiStyle.$(OBJEXT) \
+ $(TMPDIR)/tixDItem.$(OBJEXT) \
+ $(TMPDIR)/tixDiText.$(OBJEXT) \
+ $(TMPDIR)/tixDiWin.$(OBJEXT) \
+ $(TMPDIR)/tixError.$(OBJEXT) \
+ $(TMPDIR)/tixForm.$(OBJEXT) \
+ $(TMPDIR)/tixFormMisc.$(OBJEXT) \
+ $(TMPDIR)/tixGeometry.$(OBJEXT) \
+ $(TMPDIR)/tixHLCol.$(OBJEXT) \
+ $(TMPDIR)/tixHLHdr.$(OBJEXT) \
+ $(TMPDIR)/tixHLInd.$(OBJEXT) \
+ $(TMPDIR)/tixImgCmp.$(OBJEXT) \
+ $(TMPDIR)/tixHList.$(OBJEXT) \
+ $(TMPDIR)/tixList.$(OBJEXT) \
+ $(TMPDIR)/tixMethod.$(OBJEXT) \
+ $(TMPDIR)/tixOption.$(OBJEXT) \
+ $(TMPDIR)/tixSmpLs.$(OBJEXT) \
+ $(TMPDIR)/tixWidget.$(OBJEXT) \
+ $(TMPDIR)/tixInit.$(OBJEXT) \
+ $(TMPDIR)/tixItcl.$(OBJEXT) \
+ $(TMPDIR)/tixUtils.$(OBJEXT) \
+ $(TMPDIR)/tixImgXpm.$(OBJEXT) \
+ $(TMPDIR)/tixNBFrame.$(OBJEXT) \
+ $(TMPDIR)/tixTList.$(OBJEXT) \
+ $(TMPDIR)/tixGrid.$(OBJEXT) \
+ $(TMPDIR)/tixGrData.$(OBJEXT) \
+ $(TMPDIR)/tixGrRC.$(OBJEXT) \
+ $(TMPDIR)/tixGrFmt.$(OBJEXT) \
+ $(TMPDIR)/tixGrSel.$(OBJEXT) \
+ $(TMPDIR)/tixGrUtl.$(OBJEXT) \
+ $(TMPDIR)/tixScroll.$(OBJEXT) \
+ $(TMPDIR)/tixWCmpt.$(OBJEXT) \
+ $(TMPDIR)/tixWinDraw.$(OBJEXT) \
+ $(TMPDIR)/tixWinXpm.$(OBJEXT) \
+ $(TMPDIR)/tixWinWm.$(OBJEXT)
+
+CP = copy
+
+#!include <ntwin32.mak>
+
+all: $(TIXDLL) $(TIXWISH)
+
+$(TMPDIR)/tixcyg.def: $(TIXOBJS)
+ echo 'EXPORTS' > tmp.def
+ for o in $(TIXOBJS); do \
+ $(NM) --extern-only --defined-only $$o | sed -e 's/[^ ]* [^ ]* //' -e 's/^_//' | fgrep -v DllEntryPoint | fgrep -v DllMain | fgrep -v impure_ptr | fgrep -v _real@ >> tmp.def; \
+ done
+ mv tmp.def $(TMPDIR)/tixcyg.def
+
+# USE THESE IF YOU DO NOT WANT TO LINK TO ON MSVCRT.DLL
+#XGUILIBS = $(guilibs)
+#XCVARS = $(cvars)
+
+XGUILIBS = $(guilibsdll)
+XCVARS = $(cvarsdll)
+
+# (ToDo) $(TIXDLL) doesn't have resources to define its icon, etc.
+#
+
+ifeq ($(OBJEXT),o)
+
+$(TIXDLL): $(TIXOBJS) $(TMPDIR)/tixcyg.def
+ $(CC) -s -nostartfiles -Wl,--base-file,tix.base -Wl,--dll -o $(TIXDLLNAME) $(TIXOBJS) $(TKLIBDIR)/$(TKLIB) $(TCLLIBDIR)/$(TCLLIB) -lcygwin -ladvapi32 -luser32 -lgdi32 -lcomdlg32 -lkernel32 -Wl,--subsystem,windows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66600000
+ $(DLLTOOL) --as=$(AS) --dllname $(TIXDLLNAME) --def $(TMPDIR)/tixcyg.def --base-file tix.base --output-exp tix.exp
+ $(CC) -s -nostartfiles -Wl,--base-file,tix.base -Wl,tix.exp -Wl,-dll -o $(TIXDLLNAME) $(TIXOBJS) $(TKLIBDIR)/$(TKLIB) $(TCLLIBDIR)/$(TCLLIB) -lcygwin -ladvapi32 -luser32 -lgdi32 -lcomdlg32 -lkernel32 -Wl,--subsystem,windows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66600000
+ $(DLLTOOL) --as=$(AS) --dllname $(TIXDLLNAME) --def $(TMPDIR)/tixcyg.def --base-file tix.base --output-exp tix.exp
+ $(CC) -nostartfiles -Wl,tix.exp -Wl,--dll -o $(TIXDLLNAME) $(TIXOBJS) $(TKLIBDIR)/$(TKLIB) $(TCLLIBDIR)/$(TCLLIB) -lcygwin -ladvapi32 -luser32 -lgdi32 -lcomdlg32 -lkernel32 -Wl,--subsystem,windows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66600000
+ cp $(TIXDLLNAME) $(TIXDLL)
+
+$(TIXLIB): $(TMPDIR)/tixcyg.def
+ $(DLLTOOL) --as=$(AS) --dllname $(TIXDLLNAME) --def $(TMPDIR)/tixcyg.def --output-lib $(TIXLIB)
+
+$(TIXWISH): $(WISHOBJS) $(TIXOBJS) $(TIXLIB) $(TMPDIR)/tixwishres.$(OBJEXT)
+ $(CC) -mwindows $(WISHOBJS) $(TMPDIR)/tixwishres.$(OBJEXT) $(TIXLIB) \
+ $(TKLIBDIR)/$(TKLIB) $(TCLLIBDIR)/$(TCLLIB) \
+ -o $(TIXWISH)
+else
+
+$(TIXDLL): $(TIXOBJS) $(TMPDIR)/tixcyg.def
+ link -debug -dll -out:$(TIXDLL) $(TKLIBDIR)/$(TKLIB) \
+ $(TCLLIBDIR)/$(TCLLIB) $(TIXOBJS) -def:$(TMPDIR)/tixcyg.def \
+ gdi32.lib user32.lib
+ mv $(TIXRAWLIBNAME) $(TIXLIB)
+
+$(TIXLIB): $(TIXDLL)
+
+$(TIXWISH): $(WISHOBJS) $(TIXOBJS) $(TIXLIB) $(TMPDIR)/tixwishres.$(OBJEXT)
+ link -DEBUG $(WISHOBJS) $(TMPDIR)/tixwishres.$(OBJEXT) $(TIXLIB) \
+ $(TKLIBDIR)/$(TKLIB) $(TCLLIBDIR)/$(TCLLIB) \
+ -OUT:$(TIXWISH) user32.lib
+endif
+
+
+#
+# Special case object file targets
+#
+
+$(TMPDIR)/testMain.$(OBJEXT): $(ROOT)/win/tixWinMain.c
+ $(CC) -c $(TK_INCLUDES) -DSTATIC_BUILD -DTK_TEST $(CFLAGS) -o $@ $?
+
+$(TMPDIR)/tixWinMain.$(OBJEXT): $(ROOT)/win/tixWinMain.c
+ $(CC) -c $(TK_INCLUDES) -DSTATIC_BUILD $(CFLAGS) -o $@ $?
+
+ifeq ($(OBJEXT),o)
+
+$(TMPDIR)/tixwishres.$(OBJEXT): $(ROOT)/win/rc/tixwish.rc
+ $(WINDRES) --include $(srcdir)/rc --include $(srcdir)/../generic --define VS_VERSION_INFO=1 $(srcdir)/rc/tixwish.rc $(TMPDIR)/tixwishres.$(OBJEXT)
+
+else
+
+$(TMPDIR)/tixwishres.$(OBJEXT): $(ROOT)/win/rc/tixwish.rc
+ rc -i$(srcdir)/rc -i$(srcdir)/../generic -dVS_VERSION_INFO=1 -fo$(TMPDIR)/tixwishres.$(OBJEXT) $(srcdir)/rc/tixwish.rc
+
+endif
+#
+# Implicit rules
+#
+
+.c.$(OBJEXT):
+ $(CC) -c $(CFLAGS) -DDLL_BUILD -DBUILD_tix $(TK_INCLUDES) -c -o $@ $<
+
+$(TMPDIR)/%.$(OBJEXT): %.c
+ $(CC) -c $(CFLAGS) -DDLL_BUILD -DBUILD_tix $(TK_INCLUDES) -c -o $@ $<
+
+clean:
+ rm -f $(TMPDIR)/*.$(OBJEXT) $(TMPDIR)/*.exp $(TMPDIR)/*.def
+ rm -f $(TIXLIB) $(TIXDLL) $(TIXDLLNAME) $(TIXWISH)
+
+Makefile: $(srcdir)/Makefile.in config.status
+ $(SHELL) config.status
+
+config.status: $(srcdir)/configure
+ ./config.status --recheck
+
+#----------------------------------------------------------------------
+#
+# Installation
+#
+#----------------------------------------------------------------------
+
+TIX_VERSION = @TIX_VERSION@
+
+# Directory in which to install the library of Tix scripts and demos
+# (note: you can set the TIX_LIBRARY environment variable at run-time to
+# override the compiled-in location):
+TIX_LIBRARY = $(prefix)/share/tix$(TIX_VERSION)
+
+# CYGNUS LOCAL: dj - change to autoconf'd directories
+
+# Directory in which to install the archive libtix.a:
+LIB_DIR = @libdir@
+
+# Directory in which to install the program wish:
+BIN_DIR = @bindir@
+
+# Directory in which to install the include file tix.h:
+INCLUDE_DIR = @includedir@
+
+# Top-level directory for manual entries:
+MAN_DIR = @mandir@
+
+# Directory in which to install manual entry for wish:
+MAN1_DIR = $(MAN_DIR)/man1
+
+# Directory in which to install manual entries for Tix's C library
+# procedures:
+MAN3_DIR = $(MAN_DIR)/man3
+
+# Directory in which to install manual entries for the built-in
+# Tcl commands implemented by Tix:
+MANN_DIR = $(MAN_DIR)/mann
+
+INSTALL = @SRC_DIR@/install.sh -c
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+SRC_DIR = @SRC_DIR@
+INC_DIR = @SRC_DIR@/generic
+UNIX_DIR = @SRC_DIR@/unix
+LIBRARY_DIR = @SRC_DIR@/library
+DEMOS_DIR = @SRC_DIR@/demos
+DEMO_PROGS = widget
+TOOLS_DIR = @SRC_DIR@/tools
+MANUAL_DIR = @SRC_DIR@/man
+
+install:: install-basic install-binaries
+ @echo done
+
+install-binaries::
+ @for i in $(LIB_DIR) $(BIN_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing $(TIXLIB) as $(LIB_DIR)/$(TIXLIBNAME)"
+ @$(INSTALL_DATA) $(TIXLIB) $(LIB_DIR)/$(TIXLIBNAME)
+ @echo "Installing $(TIXWISH) as $(BIN_DIR)/$(TIXWISHNAME)"
+ @$(INSTALL_PROGRAM) $(TIXWISH) $(BIN_DIR)/$(TIXWISHNAME)
+ @echo "Installing $(TIXDLL) as $(BIN_DIR)/$(TIXDLLNAME)"
+ @$(INSTALL_PROGRAM) $(TIXDLL) $(BIN_DIR)/$(TIXDLLNAME)
+
+#
+# Basic installtion
+#
+install-basic:: install-libraries install-headers install-demos \
+ install-man install-tools
+
+install-tools:
+ @for i in $(BIN_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "installing the tixindex program for building tclIndex for Tix scripts"
+ @cd $(TOOLS_DIR); $(INSTALL_PROGRAM) tixindex $(BIN_DIR)/tixindex
+
+install-headers:
+ @for i in $(INCLUDE_DIR); \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @for i in $(INC_DIR)/tix.h; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(INCLUDE_DIR); \
+ done;
+
+install-libraries:
+ @for i in $(BIN_DIR) $(prefix)/lib $(TIX_LIBRARY) $(TIX_LIBRARY)/bitmaps $(TIX_LIBRARY)/pref; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing $(TIXDLL) as $(BIN_DIR)/$(TIXDLLNAME)"
+ @$(INSTALL_PROGRAM) $(TIXDLL) $(BIN_DIR)/$(TIXDLLNAME)
+ @for i in $(LIBRARY_DIR)/*.tcl $(LIBRARY_DIR)/tclIndex; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(TIX_LIBRARY); \
+ done;
+ @for i in $(LIBRARY_DIR)/bitmaps/*; \
+ do \
+ if [ -f $$i ] ; then \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(TIX_LIBRARY)/bitmaps; \
+ fi; \
+ done;
+ @for i in $(LIBRARY_DIR)/pref/*; \
+ do \
+ if [ -f $$i ] ; then \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(TIX_LIBRARY)/pref; \
+ fi; \
+ done;
+ @echo "Installing pkgIndex.tcl"
+ @$(INSTALL_DATA) $(srcdir)/pkgIndex.tcl $(TIX_LIBRARY)
+
+install-demos:
+ @for i in $(prefix)/lib $(TIX_LIBRARY) $(TIX_LIBRARY)/demos \
+ $(TIX_LIBRARY)/demos/bitmaps $(TIX_LIBRARY)/demos/samples ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @cd $(DEMOS_DIR); for i in *; \
+ do \
+ if [ -f $$i ] ; then \
+ echo "Installing demos/$$i"; \
+ sed -e '1 s|/usr/local/bin/tixwish|$(BIN_DIR)/tixwish|' \
+ $$i > $(TIX_LIBRARY)/demos/$$i; \
+ fi; \
+ done;
+ @for i in $(DEMO_PROGS); \
+ do \
+ chmod 755 $(TIX_LIBRARY)/demos/$$i; \
+ done;
+ @for i in $(DEMOS_DIR)/bitmaps/*; \
+ do \
+ if [ -f $$i ] ; then \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(TIX_LIBRARY)/demos/bitmaps; \
+ fi; \
+ done;
+ @for i in $(DEMOS_DIR)/samples/*; \
+ do \
+ if [ -f $$i ] ; then \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(TIX_LIBRARY)/demos/samples; \
+ fi; \
+ done;
+
+install-man:
+ @for i in $(MAN_DIR) $(MAN1_DIR) $(MAN3_DIR) $(MANN_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @cd $(MANUAL_DIR); for i in *.n *.1; \
+ do \
+ echo "Installing doc/$$i"; \
+ rm -f $(MANN_DIR)/$$i; \
+ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+ $$i > $(MANN_DIR)/$$i; \
+ chmod 444 $(MANN_DIR)/$$i; \
+ done;
+
+install-info info installcheck:
+
+install-minimal: install-libraries
+ @echo "Installing $(TIXDLL) as $(BIN_DIR)/$(TIXDLLNAME)"
+ @$(INSTALL_PROGRAM) $(TIXDLL) $(BIN_DIR)/$(TIXDLLNAME)
diff --git a/tix/win/README b/tix/win/README
new file mode 100644
index 00000000000..e37cd347433
--- /dev/null
+++ b/tix/win/README
@@ -0,0 +1,2 @@
+Currently this file is empty.
+
diff --git a/tix/win/aclocal.m4 b/tix/win/aclocal.m4
new file mode 100644
index 00000000000..9e327b90d1d
--- /dev/null
+++ b/tix/win/aclocal.m4
@@ -0,0 +1 @@
+"sinclude(../../config/acinclude.m4)"
diff --git a/tix/win/configure b/tix/win/configure
new file mode 100755
index 00000000000..0ded7defc70
--- /dev/null
+++ b/tix/win/configure
@@ -0,0 +1,1681 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+ac_help="$ac_help
+ --with-tclconfig directory containing tcl configuration (tclConfig.sh)"
+ac_help="$ac_help
+ --with-tkconfig directory containing tk configuration (tkConfig.sh)"
+ac_help="$ac_help
+ --with-tclinclude directory where tcl headers are"
+ac_help="$ac_help
+ --with-tkinclude directory where tk headers are"
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.13"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=../generic/tixInit.c
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+
+# Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:537: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:567: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_prog_rejected=no
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -z "$CC"; then
+ case "`uname -s`" in
+ *win32* | *WIN32*)
+ # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:618: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="cl"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+ ;;
+ esac
+ fi
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:650: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 661 "configure"
+#include "confdefs.h"
+
+main(){return(0);}
+EOF
+if { (eval echo configure:666: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cc_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:692: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:697: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:706: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gcc=yes
+else
+ ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+else
+ GCC=
+fi
+
+ac_test_CFLAGS="${CFLAGS+set}"
+ac_save_CFLAGS="$CFLAGS"
+CFLAGS=
+echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:725: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+
+echo $ac_n "checking for object suffix""... $ac_c" 1>&6
+echo "configure:757: checking for object suffix" >&5
+if eval "test \"`echo '$''{'ac_cv_objext'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ rm -f conftest*
+echo 'int i = 1;' > conftest.$ac_ext
+if { (eval echo configure:763: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ for ac_file in conftest.*; do
+ case $ac_file in
+ *.c) ;;
+ *) ac_cv_objext=`echo $ac_file | sed -e s/conftest.//` ;;
+ esac
+ done
+else
+ { echo "configure: error: installation or configuration problem; compiler does not work" 1>&2; exit 1; }
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_objext" 1>&6
+OBJEXT=$ac_cv_objext
+ac_objext=$ac_cv_objext
+
+NM=${NM-nm}
+
+AS=${AS-as}
+
+LD=${LD-ld}
+
+DLLTOOL=${DLLTOOL-dlltool}
+
+WINDRES=${WINDRES-windres}
+
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:821: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ # Account for people who put trailing slashes in PATH elements.
+ case "$ac_dir/" in
+ /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ if test -f $ac_dir/$ac_prog; then
+ if test $ac_prog = install &&
+ grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ else
+ ac_cv_path_install="$ac_dir/$ac_prog -c"
+ break 2
+ fi
+ fi
+ done
+ ;;
+ esac
+ done
+ IFS="$ac_save_IFS"
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL="$ac_cv_path_install"
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL="$ac_install_sh"
+ fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+
+# Check for Tcl and Tk.
+
+dirlist=".. ../../ ../../../ ../../../../ ../../../../../ ../../../../../../ ../../../../../../.. ../../../../../../../.. ../../../../../../../../.. ../../../../../../../../../.."
+if test x"${no_tcl}" = x ; then
+ no_tcl=true
+ # Check whether --with-tclconfig or --without-tclconfig was given.
+if test "${with_tclconfig+set}" = set; then
+ withval="$with_tclconfig"
+ with_tclconfig=${withval}
+fi
+
+ echo $ac_n "checking for Tcl configuration script""... $ac_c" 1>&6
+echo "configure:886: checking for Tcl configuration script" >&5
+ if eval "test \"`echo '$''{'ac_cv_c_tclconfig'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+
+ if test x"${with_tclconfig}" != x ; then
+ if test -f "${with_tclconfig}/tclConfig.sh" ; then
+ ac_cv_c_tclconfig=`(cd ${with_tclconfig}; pwd)`
+ else
+ { echo "configure: error: ${with_tclconfig} directory doesn't contain tclConfig.sh" 1>&2; exit 1; }
+ fi
+ fi
+
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in $dirlist; do
+ if test -f $srcdir/$i/unix/tclConfig.sh ; then
+ ac_cv_c_tclconfig=`(cd $srcdir/$i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ for i in $dirlist; do
+ if test -n "`ls -dr $i/tcl* 2>/dev/null`" ; then
+ tclconfpath=$i
+ break
+ fi
+ done
+
+ for i in `ls -dr $tclconfpath/tcl* 2>/dev/null ` ; do
+ if test -f $i/unix/tclConfig.sh ; then
+ ac_cv_c_tclconfig=`(cd $i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ ccpath=`which ${CC} | sed -e 's:/bin/.*::'`/lib
+ if test -f $ccpath/tclConfig.sh; then
+ ac_cv_c_tclconfig=$ccpath
+ fi
+ fi
+
+fi
+
+ if test x"${ac_cv_c_tclconfig}" = x ; then
+ TCLCONFIG=""
+ echo "configure: warning: Can't find Tcl configuration definitions" 1>&2
+ else
+ no_tcl=""
+ TCLCONFIG=${ac_cv_c_tclconfig}/tclConfig.sh
+ echo "$ac_t""${TCLCONFIG}" 1>&6
+ fi
+fi
+
+
+
+ . $TCLCONFIG
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+dirlist=".. ../../ ../../../ ../../../../ ../../../../../ ../../../../../../ ../../../../../../.. ../../../../../../../.. ../../../../../../../../.. ../../../../../../../../../.."
+if test x"${no_tk}" = x ; then
+ no_tk=true
+ # Check whether --with-tkconfig or --without-tkconfig was given.
+if test "${with_tkconfig+set}" = set; then
+ withval="$with_tkconfig"
+ with_tkconfig=${withval}
+fi
+
+ echo $ac_n "checking for Tk configuration script""... $ac_c" 1>&6
+echo "configure:977: checking for Tk configuration script" >&5
+ if eval "test \"`echo '$''{'ac_cv_c_tkconfig'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+
+ if test x"${with_tkconfig}" != x ; then
+ if test -f "${with_tkconfig}/tkConfig.sh" ; then
+ ac_cv_c_tkconfig=`(cd ${with_tkconfig}; pwd)`
+ else
+ { echo "configure: error: ${with_tkconfig} directory doesn't contain tkConfig.sh" 1>&2; exit 1; }
+ fi
+ fi
+
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ for i in $dirlist; do
+ if test -f $srcdir/$i/unix/tkConfig.sh ; then
+ ac_cv_c_tkconfig=`(cd $srcdir/$i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ for i in $dirlist; do
+ if test -n "`ls -dr $i/tk* 2>/dev/null`" ; then
+ tkconfpath=$i
+ break
+ fi
+ done
+
+ for i in `ls -dr $tkconfpath/tk* 2>/dev/null ` ; do
+ if test -f $i/unix/tkConfig.sh ; then
+ ac_cv_c_tkconfig=`(cd $i/unix; pwd)`
+ break
+ fi
+ done
+ fi
+
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ ccpath=`which ${CC} | sed -e 's:/bin/.*::'`/lib
+ if test -f $ccpath/tkConfig.sh; then
+ ac_cv_c_tkconfig=$ccpath
+ fi
+ fi
+
+fi
+
+ if test x"${ac_cv_c_tkconfig}" = x ; then
+ TKCONFIG=""
+ echo "configure: warning: Can't find Tk configuration definitions" 1>&2
+ else
+ no_tk=""
+ TKCONFIG=${ac_cv_c_tkconfig}/tkConfig.sh
+ echo "$ac_t""${TKCONFIG}" 1>&6
+ fi
+fi
+
+
+
+ if test -f "$TKCONFIG" ; then
+ . $TKCONFIG
+ fi
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:1054: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # This must be in double quotes, not single quotes, because CPP may get
+ # substituted into the Makefile and "${CC-cc}" will confuse make.
+ CPP="${CC-cc} -E"
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp.
+ cat > conftest.$ac_ext <<EOF
+#line 1069 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1075: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -E -traditional-cpp"
+ cat > conftest.$ac_ext <<EOF
+#line 1086 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1092: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -nologo -E"
+ cat > conftest.$ac_ext <<EOF
+#line 1103 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1109: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+ ac_cv_prog_CPP="$CPP"
+fi
+ CPP="$ac_cv_prog_CPP"
+else
+ ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+
+dirlist=".. ../../ ../../../ ../../../../ ../../../../../ ../../../../../../ ../../../../../../.. ../../../../../../../.. ../../../../../../../../.. ../../../../../../../../../.."
+no_tcl=true
+echo $ac_n "checking for Tcl headers in the source tree""... $ac_c" 1>&6
+echo "configure:1137: checking for Tcl headers in the source tree" >&5
+# Check whether --with-tclinclude or --without-tclinclude was given.
+if test "${with_tclinclude+set}" = set; then
+ withval="$with_tclinclude"
+ with_tclinclude=${withval}
+fi
+
+if eval "test \"`echo '$''{'ac_cv_c_tclh'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+if test x"${with_tclinclude}" != x ; then
+ if test -f ${with_tclinclude}/tcl.h ; then
+ ac_cv_c_tclh=`(cd ${with_tclinclude}; pwd)`
+ elif test -f ${with_tclinclude}/generic/tcl.h ; then
+ ac_cv_c_tclh=`(cd ${with_tclinclude}/generic; pwd)`
+ else
+ { echo "configure: error: ${with_tclinclude} directory doesn't contain headers" 1>&2; exit 1; }
+ fi
+fi
+
+if test x"${ac_cv_c_tclconfig}" != x ; then
+ for i in $dirlist; do
+ if test -f $ac_cv_c_tclconfig/$i/generic/tcl.h ; then
+ ac_cv_c_tclh=`(cd $ac_cv_c_tclconfig/$i/generic; pwd)`
+ break
+ fi
+ done
+fi
+
+if test x"${ac_cv_c_tclh}" = x ; then
+ for i in $dirlist; do
+ if test -n "`ls -dr $srcdir/$i/tcl* 2>/dev/null`" ; then
+ tclpath=$srcdir/$i
+ break
+ fi
+ done
+
+ for i in `ls -dr $tclpath/tcl* 2>/dev/null ` ; do
+ if test -f $i/generic/tcl.h ; then
+ ac_cv_c_tclh=`(cd $i/generic; pwd)`
+ break
+ fi
+ done
+fi
+
+if test x"${ac_cv_c_tclh}" = x ; then
+ ccpath=`which ${CC} | sed -e 's:/bin/.*::'`/include
+ if test -f $ccpath/tcl.h; then
+ ac_cv_c_tclh=$ccpath
+ fi
+fi
+
+if test x"${ac_cv_c_tclh}" = x ; then
+ echo "$ac_t""none" 1>&6
+ ac_safe=`echo "tcl.h" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for tcl.h""... $ac_c" 1>&6
+echo "configure:1194: checking for tcl.h" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1199 "configure"
+#include "confdefs.h"
+#include <tcl.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1204: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_cv_c_tclh=installed
+else
+ echo "$ac_t""no" 1>&6
+ac_cv_c_tclh=""
+fi
+
+else
+ echo "$ac_t""${ac_cv_c_tclh}" 1>&6
+fi
+
+fi
+
+ TCLHDIR=""
+if test x"${ac_cv_c_tclh}" = x ; then
+ { echo "configure: error: Can't find any Tcl headers" 1>&2; exit 1; }
+fi
+if test x"${ac_cv_c_tclh}" != x ; then
+ no_tcl=""
+ if test x"${ac_cv_c_tclh}" != x"installed" ; then
+ if test x"${CC}" = xcl ; then
+ tmp="`cygpath --windows ${ac_cv_c_tclh}`"
+ ac_cv_c_tclh="`echo $tmp | sed -e s#\\\\\\\\#/#g`"
+ fi
+ echo "$ac_t""${ac_cv_c_tclh}" 1>&6
+ TCLHDIR="-I${ac_cv_c_tclh}"
+ fi
+fi
+
+
+
+# FIXME: consider only doing this if --with-x given.
+
+#
+# Ok, lets find the tk source trees so we can use the headers
+# If the directory (presumably symlink) named "tk" exists, use that one
+# in preference to any others. Same logic is used when choosing library
+# and again with Tcl. The search order is the best place to look first, then in
+# decreasing significance. The loop breaks if the trigger file is found.
+# Note the gross little conversion here of srcdir by cd'ing to the found
+# directory. This converts the path from a relative to an absolute, so
+# recursive cache variables for the path will work right. We check all
+# the possible paths in one loop rather than many seperate loops to speed
+# things up.
+# the alternative search directory is involked by --with-tkinclude
+#
+dirlist=".. ../../ ../../../ ../../../../ ../../../../../ ../../../../../../ ../../../../../../.. ../../../../../../../.. ../../../../../../../../.. ../../../../../../../../../.."
+no_tk=true
+echo $ac_n "checking for Tk headers in the source tree""... $ac_c" 1>&6
+echo "configure:1268: checking for Tk headers in the source tree" >&5
+# Check whether --with-tkinclude or --without-tkinclude was given.
+if test "${with_tkinclude+set}" = set; then
+ withval="$with_tkinclude"
+ with_tkinclude=${withval}
+fi
+
+if eval "test \"`echo '$''{'ac_cv_c_tkh'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+
+if test x"${with_tkinclude}" != x ; then
+ if test -f ${with_tkinclude}/tk.h ; then
+ ac_cv_c_tkh=`(cd ${with_tkinclude}; pwd)`
+ elif test -f ${with_tkinclude}/generic/tk.h ; then
+ ac_cv_c_tkh=`(cd ${with_tkinclude}/generic; pwd)`
+ else
+ { echo "configure: error: ${with_tkinclude} directory doesn't contain headers" 1>&2; exit 1; }
+ fi
+fi
+
+if test x"${ac_cv_c_tkconfig}" != x ; then
+ for i in $dirlist; do
+ if test -f $ac_cv_c_tkconfig/$i/generic/tk.h ; then
+ ac_cv_c_tkh=`(cd $ac_cv_c_tkconfig/$i/generic; pwd)`
+ break
+ fi
+ done
+fi
+
+if test x"${ac_cv_c_tkh}" = x ; then
+ for i in $dirlist; do
+ if test -n "`ls -dr $srcdir/$i/tk* 2>/dev/null`" ; then
+ tkpath=$srcdir/$i
+ break
+ fi
+ done
+
+ for i in `ls -dr $tkpath/tk* 2>/dev/null ` ; do
+ if test -f $i/generic/tk.h ; then
+ ac_cv_c_tkh=`(cd $i/generic; pwd)`
+ break
+ fi
+ done
+fi
+
+if test x"${ac_cv_c_tkh}" = x ; then
+ echo "$ac_t""none" 1>&6
+ ccpath=`which ${CC} | sed -e 's:/bin/.*::'`/include
+ if test -f $ccpath/tk.h; then
+ ac_cv_c_tkh=$ccpath
+ fi
+else
+ echo "$ac_t""${ac_cv_c_tkh}" 1>&6
+fi
+
+fi
+
+ TKHDIR=""
+if test x"${ac_cv_c_tkh}" = x ; then
+ { echo "configure: error: Can't find any Tk headers" 1>&2; exit 1; }
+fi
+if test x"${ac_cv_c_tkh}" != x ; then
+ no_tk=""
+ if test x"${ac_cv_c_tkh}" != x"installed" ; then
+ if test x"${CC}" = xcl ; then
+ tmp="`cygpath --windows ${ac_cv_c_tkh}`"
+ ac_cv_c_tkh="`echo $tmp | sed -e s#\\\\\\\\#/#g`"
+ fi
+ echo "$ac_t""found in ${ac_cv_c_tkh}" 1>&6
+ TKHDIR="-I${ac_cv_c_tkh}"
+ fi
+fi
+
+
+
+
+TCL_VER=${TCL_VERSION}
+
+
+if test -d tcl${TCL_VERSION}; then
+ true
+else
+ mkdir tcl${TCL_VERSION}
+fi
+
+SRC_DIR=`cd ${srcdir}/..; pwd`
+
+
+TIX_VERSION=4.1
+
+
+VERSION=${TIX_VERSION}.${TCL_VERSION}
+
+if test "$GCC" = yes; then
+ TIX_BUILD_LIB_SPEC="-L`pwd`/tcl${TCL_VERSION} -ltix`echo ${VERSION} | tr -d .`"
+ TIX_LIB_FULL_PATH="`pwd`/tcl${TCL_VERSION}/libtix`echo ${VERSION} | tr -d .`.a"
+ TIX_LIB_FILE="libtix`echo ${VERSION} | tr -d .`.a"
+ TIX_BUILD_LOCATION="`pwd`/tcl${TCL_VERSION}"
+else
+ tmp="`pwd`/libtix`echo ${VERSION} | tr -d .`.a"
+ TIX_LIB_FILE="libtix`echo ${VERSION} | tr -d .`.a"
+ tmp2="`cygpath --windows $tmp`"
+ TIX_BUILD_LIB_SPEC="`echo $tmp2 | sed -e s#\\\\\\\\#/#g`"
+ TIX_LIB_FULL_PATH=${TIX_BUILD_LIB_SPEC}
+ TIX_BUILD_LOCATION="`pwd`\\tcl${TCL_VERSION}"
+fi
+
+
+
+
+
+
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.13"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "Makefile ../tixConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@CC@%$CC%g
+s%@OBJEXT@%$OBJEXT%g
+s%@NM@%$NM%g
+s%@AS@%$AS%g
+s%@LD@%$LD%g
+s%@DLLTOOL@%$DLLTOOL%g
+s%@WINDRES@%$WINDRES%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@TCLCONFIG@%$TCLCONFIG%g
+s%@TCL_DEFS@%$TCL_DEFS%g
+s%@TCL_LIB_FILE@%$TCL_LIB_FILE%g
+s%@TCL_LIB_FULL_PATH@%$TCL_LIB_FULL_PATH%g
+s%@TCL_LIBS@%$TCL_LIBS%g
+s%@TCL_CFLAGS@%$TCL_CFLAGS%g
+s%@TCL_SHLIB_CFLAGS@%$TCL_SHLIB_CFLAGS%g
+s%@TCL_SHLIB_LD@%$TCL_SHLIB_LD%g
+s%@TCL_LD_FLAGS@%$TCL_LD_FLAGS%g
+s%@TCL_LD_SEARCH_FLAGS@%$TCL_LD_SEARCH_FLAGS%g
+s%@TCL_RANLIB@%$TCL_RANLIB%g
+s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
+s%@TCL_LIB_SPEC@%$TCL_LIB_SPEC%g
+s%@TKCONFIG@%$TKCONFIG%g
+s%@TK_VERSION@%$TK_VERSION%g
+s%@TK_DEFS@%$TK_DEFS%g
+s%@TK_LIB_FILE@%$TK_LIB_FILE%g
+s%@TK_LIB_FULL_PATH@%$TK_LIB_FULL_PATH%g
+s%@TK_LIBS@%$TK_LIBS%g
+s%@TK_BUILD_INCLUDES@%$TK_BUILD_INCLUDES%g
+s%@TK_XINCLUDES@%$TK_XINCLUDES%g
+s%@TK_XLIBSW@%$TK_XLIBSW%g
+s%@TK_BUILD_LIB_SPEC@%$TK_BUILD_LIB_SPEC%g
+s%@TK_LIB_SPEC@%$TK_LIB_SPEC%g
+s%@CPP@%$CPP%g
+s%@TCLHDIR@%$TCLHDIR%g
+s%@TKHDIR@%$TKHDIR%g
+s%@TCL_VER@%$TCL_VER%g
+s%@SRC_DIR@%$SRC_DIR%g
+s%@TIX_VERSION@%$TIX_VERSION%g
+s%@TIX_BUILD_LIB_SPEC@%$TIX_BUILD_LIB_SPEC%g
+s%@TIX_LIB_FILE@%$TIX_LIB_FILE%g
+s%@TIX_BUILD_LOCATION@%$TIX_BUILD_LOCATION%g
+s%@TIX_LIB_FULL_PATH@%$TIX_LIB_FULL_PATH%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile ../tixConfig.sh"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+ case "$ac_given_INSTALL" in
+ [/$]*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ esac
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
diff --git a/tix/win/configure.in b/tix/win/configure.in
new file mode 100644
index 00000000000..571b3416dda
--- /dev/null
+++ b/tix/win/configure.in
@@ -0,0 +1,65 @@
+dnl This whole file is CYGNUS LOCAL
+
+AC_INIT(../generic/tixInit.c)
+
+AC_PROG_CC
+AC_OBJEXT
+NM=${NM-nm}
+AC_SUBST(NM)
+AS=${AS-as}
+AC_SUBST(AS)
+LD=${LD-ld}
+AC_SUBST(LD)
+DLLTOOL=${DLLTOOL-dlltool}
+AC_SUBST(DLLTOOL)
+WINDRES=${WINDRES-windres}
+AC_SUBST(WINDRES)
+AC_PROG_INSTALL
+
+# Check for Tcl and Tk.
+CYG_AC_PATH_TCLCONFIG
+CYG_AC_LOAD_TCLCONFIG
+CYG_AC_PATH_TKCONFIG
+CYG_AC_LOAD_TKCONFIG
+CYG_AC_PATH_TCLH
+# FIXME: consider only doing this if --with-x given.
+CYG_AC_PATH_TKH
+
+TCL_VER=${TCL_VERSION}
+AC_SUBST(TCL_VER)
+
+if test -d tcl${TCL_VERSION}; then
+ true
+else
+ mkdir tcl${TCL_VERSION}
+fi
+
+SRC_DIR=`cd ${srcdir}/..; pwd`
+AC_SUBST(SRC_DIR)
+
+TIX_VERSION=4.1
+AC_SUBST(TIX_VERSION)
+
+VERSION=${TIX_VERSION}.${TCL_VERSION}
+
+if test "$GCC" = yes; then
+ TIX_BUILD_LIB_SPEC="-L`pwd`/tcl${TCL_VERSION} -ltix`echo ${VERSION} | tr -d .`"
+ TIX_LIB_FULL_PATH="`pwd`/tcl${TCL_VERSION}/libtix`echo ${VERSION} | tr -d .`.a"
+ TIX_LIB_FILE="libtix`echo ${VERSION} | tr -d .`.a"
+ TIX_BUILD_LOCATION="`pwd`/tcl${TCL_VERSION}"
+else
+ tmp="`pwd`/libtix`echo ${VERSION} | tr -d .`.a"
+ TIX_LIB_FILE="libtix`echo ${VERSION} | tr -d .`.a"
+ tmp2="`cygpath --windows $tmp`"
+ TIX_BUILD_LIB_SPEC="`echo $tmp2 | sed -e s#\\\\\\\\#/#g`"
+ TIX_LIB_FULL_PATH=${TIX_BUILD_LIB_SPEC}
+ TIX_BUILD_LOCATION="`pwd`\\tcl${TCL_VERSION}"
+fi
+
+
+AC_SUBST(TIX_BUILD_LIB_SPEC)
+AC_SUBST(TIX_LIB_FILE)
+AC_SUBST(TIX_BUILD_LOCATION)
+AC_SUBST(TIX_LIB_FULL_PATH)
+
+AC_OUTPUT(Makefile ../tixConfig.sh)
diff --git a/tix/win/makefile.bc b/tix/win/makefile.bc
new file mode 100644
index 00000000000..a2ec771e328
--- /dev/null
+++ b/tix/win/makefile.bc
@@ -0,0 +1,367 @@
+# makefile.bc --
+#
+# Borland C++ 4.5/5.0 makefile for Tix.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+# uncomment the following two lines to compile with TCL_MEM_DEBUG
+#DEBUGDEFINES =TCL_MEM_DEBUG
+
+#----------------------------------------------------------------------
+# Environment setting
+#
+# You can set the following variables in your DOS environment. This
+# way you don't need to change this file. E.g.:
+#
+# set TCL_VER=7.5
+# make -f makefile.vc
+#
+# You can also set these variables in the command line to make. E.g.:
+#
+# make TCL_VER=7.5 -f makefile.bc
+#
+# TOOLS = location of BC++ 32-bit development tools.
+# (DEFAULT: C:\BC45)
+# TIX_DEBUG = Compile Tix with debug information.
+# (DEFAULT: undefined -- debug is not enabled.)
+# TCL_VER = version of Tcl to compile with. Should be either 7.5
+# or 7.6
+# (DEFAULT: Compile with Tcl 7.6)
+#----------------------------------------------------------------------
+
+!IFNDEF TOOLS
+TOOLS = C:\BC45
+!ENDIF
+
+!IFNDEF TIX_DEBUG
+NODEBUG = 1
+!ENDIF
+
+!IFNDEF TCL_VER
+TCL_VER = 7.6
+!ENDIF
+
+!IF "$(TCL_VER)" == "7.5"
+
+TMPDIR = tcl7.5
+TCLDIR = ..\..\tcl7.5
+TKDIR = ..\..\tk4.1
+TCLLIB = tcl75.lib
+TCLDLL = tcl75.dll
+TKLIB = tk41.lib
+TKDLL = tk41.dll
+TIXLIB = $(TMPDIR)\tix4175.lib
+TIXDLL = $(TMPDIR)\tix4175.dll
+TIXWISH = $(TMPDIR)\tix4175.exe
+
+CONSOLE_OBJ = tkConsole41.obj
+
+!ENDIF
+
+!IF "$(TCL_VER)" == "7.6"
+
+TMPDIR = tcl7.6
+TCLDIR = ..\..\tcl7.6
+TKDIR = ..\..\tk4.2
+TCLLIB = tcl76.lib
+TCLDLL = tcl76.dll
+TKLIB = tk42.lib
+TKDLL = tk42.dll
+TIXLIB = $(TMPDIR)\tix4176.lib
+TIXDLL = $(TMPDIR)\tix4176.dll
+TIXWISH = $(TMPDIR)\tix4176.exe
+
+CONSOLE_OBJ = tkConsole42.obj
+
+!ENDIF
+
+!IF "$(TCL_VER)" == "8.0a1"
+
+TMPDIR = tcl8.0
+TCLDIR = ..\..\tcl8.0a1
+TKDIR = ..\..\tk8.0a1
+TCLLIB = tcl80.lib
+TCLDLL = tcl80.dll
+TKLIB = tk80.lib
+TKDLL = tk80.dll
+TIXLIB = $(TMPDIR)\tix4180.lib
+TIXDLL = $(TMPDIR)\tix4180.dll
+TIXWISH = $(TMPDIR)\tix4180.exe
+
+CONSOLE_OBJ = tkConsole80a1.obj
+
+!ENDIF
+
+!IF "$(TCL_VER)" == "8.0b1"
+
+TMPDIR = tcl8.0
+TCLDIR = ..\..\tcl8.0b1
+TKDIR = ..\..\tk8.0b1
+TCLLIB = tcl80.lib
+TCLDLL = tcl80.dll
+TKLIB = tk80.lib
+TKDLL = tk80.dll
+TIXLIB = $(TMPDIR)\tix4180.lib
+TIXDLL = $(TMPDIR)\tix4180.dll
+TIXWISH = $(TMPDIR)\tix4180.exe
+
+CONSOLE_OBJ = tkConsole80b1.obj
+
+!ENDIF
+
+!IF "$(TCL_VER)" == "2.2i"
+
+TMPDIR = itcl2.2
+ITCL_DIR = ..\..\itcl2.2
+TCLDIR = $(ITCL_DIR)\tcl7.6
+TKDIR = $(ITCL_DIR)\tk4.2
+TCLLIB = tcl76i.lib
+TCLDLL = tcl76i.dll
+TKLIB = tk42i.lib
+TKDLL = tk42i.dll
+TIXLIB = $(TMPDIR)\tix41761.lib
+TIXDLL = $(TMPDIR)\tix41761.dll
+TIXWISH = $(TMPDIR)\tix41761.exe
+
+CONSOLE_OBJ = tkConsole42.obj
+
+ITCL_LIBS = $(ITCL_DIR)\itcl\win\itcl22.lib $(ITCL_DIR)\itk\win\itk22.lib
+ITCL_INCLUDES = $(ITCL_DIR)\itcl\generic;$(ITCL_DIR)\itk\generic
+ITCL_DEFINES = ITCL_2
+!ENDIF
+
+!IFNDEF TCLDIR
+!ERROR "Unsupported Tcl version $(TCL_VER)"
+!ENDIF
+
+#
+# ROOT = top of source tree
+# TMPDIR = location where .obj files should be stored during build
+#
+
+ROOT = ..
+
+#
+# Borland C++ tools
+#
+
+BORLAND = $(TOOLS)
+IMPLIB = Implib
+BCC32 = Bcc32
+BCC = Bcc
+RC = brcc32
+CP = copy
+RM = del
+
+TCL_INCLUDES = $(TCLDIR)\generic;$(TCLDIR)\win;$(ITCL_INCLUDES)
+TK_INCLUDES = $(TKDIR)\generic;$(TKDIR)\xlib;$(TKDIR)\win
+TIX_INCLUDES = $(ROOT)\generic;$(ROOT)\win
+INCLUDES = $(BORLAND)\include;$(TIX_INCLUDES);$(TK_INCLUDES);$(TCL_INCLUDES)
+
+LIBDIRS = $(BORLAND)\lib;$(ROOT)\win
+TCLLIBDIR = $(TCLDIR)\win
+TKLIBDIR = $(TKDIR)\win
+
+!ifndef DEBUG
+
+# these macros cause maximum optimization and no symbols
+DEBUGLDFLAGS =
+DEBUGCCFLAGS = -v- -vi- -O2
+
+!else
+
+# these macros enable debugging
+DEBUGLDFLAGS = -v
+DEBUGCCFLAGS = -k -Od -v
+
+!endif
+
+DEFINES = _RTLDLL;$(DEBUGDEFINES);__BORLAND;$(ITCL_DEFINES)
+
+
+PROJECTCCFLAGS= $(DEBUGCCFLAGS) -w-par -w-stu
+
+LNFLAGS_exe = -Tpe -aa -c $(DEBUGLDFLAGS) $(BORLAND)\lib\c0w32
+LNFLAGS_dll = -Tpd -aa -c $(DEBUGLDFLAGS) $(BORLAND)\lib\c0d32
+
+LNLIBS_exe=$(TIXLIB) $(TKLIBDIR)\$(TKLIB) $(TCLLIBDIR)\$(TCLLIB) \
+ $(ITCL_LIBS) import32 cw32i
+LNLIBS_dll=$(TKLIBDIR)\$(TKLIB) $(TCLLIBDIR)\$(TCLLIB) \
+ $(ITCL_LIBS) import32 cw32i
+
+#
+# Global makefile settings
+#
+
+.AUTODEPEND
+.CACHEAUTODEPEND
+
+.suffixes: .c .dll .lib .obj .exe
+
+.path.c=$(ROOT)\win;$(ROOT)\generic;$(ROOT)\xlib
+.path.obj=$(TMPDIR)
+
+WISHOBJS = \
+ $(TMPDIR)\tixWinMain.obj
+
+TIXOBJS = \
+ $(TMPDIR)\$(CONSOLE_OBJ) \
+ $(TMPDIR)\tixClass.obj \
+ $(TMPDIR)\tixCmds.obj \
+ $(TMPDIR)\tixCompat.obj \
+ $(TMPDIR)\tixDiImg.obj \
+ $(TMPDIR)\tixDiITxt.obj \
+ $(TMPDIR)\tixDiStyle.obj \
+ $(TMPDIR)\tixDItem.obj \
+ $(TMPDIR)\tixDiText.obj \
+ $(TMPDIR)\tixDiWin.obj \
+ $(TMPDIR)\tixError.obj \
+ $(TMPDIR)\tixForm.obj \
+ $(TMPDIR)\tixFormMisc.obj\
+ $(TMPDIR)\tixGeometry.obj\
+ $(TMPDIR)\tixGrData.obj \
+ $(TMPDIR)\tixGrid.obj \
+ $(TMPDIR)\tixGrFmt.obj \
+ $(TMPDIR)\tixGrRC.obj \
+ $(TMPDIR)\tixGrSel.obj \
+ $(TMPDIR)\tixGrUtl.obj \
+ $(TMPDIR)\tixHLCol.obj \
+ $(TMPDIR)\tixHLHdr.obj \
+ $(TMPDIR)\tixHLInd.obj \
+ $(TMPDIR)\tixHList.obj \
+ $(TMPDIR)\tixImgCmp.obj \
+ $(TMPDIR)\tixImgXpm.obj \
+ $(TMPDIR)\tixInit.obj \
+ $(TMPDIR)\tixItcl.obj \
+ $(TMPDIR)\tixList.obj \
+ $(TMPDIR)\tixMethod.obj \
+ $(TMPDIR)\tixNBFrame.obj \
+ $(TMPDIR)\tixOption.obj \
+ $(TMPDIR)\tixScroll.obj \
+ $(TMPDIR)\tixSmpLs.obj \
+ $(TMPDIR)\tixTList.obj \
+ $(TMPDIR)\tixUtils.obj \
+ $(TMPDIR)\tixWCmpt.obj \
+ $(TMPDIR)\tixWidget.obj \
+ $(TMPDIR)\tixWinDraw.obj \
+ $(TMPDIR)\tixWinXpm.obj \
+ $(TMPDIR)\tixWinWm.obj
+
+#
+# Targets
+#
+
+all: cfgdll $(TIXDLL) cfgexe $(TIXWISH) cfgcln
+test: cfgdll $(TIXDLL) cfgtest $(TKTEST) cfgcln
+
+# Implicit Targets
+
+.c.obj:
+ @$(BCC32) {$< }
+
+.dll.lib:
+ $(IMPLIB) -c $@ $<
+
+.rc.res:
+ $(RC) -i$(INCLUDES) $<
+
+#
+# Special case object file targets
+#
+
+$(TMPDIR)\testMain.obj : $(ROOT)\win\tixWinMain.c
+ $(BCC32) -c -o$@ $(ROOT)\win\tixWinMain.c
+
+#
+# Configuration file targets - these files are implicitly used by the compiler
+#
+
+cfgdll:
+ @$(CP) &&|
+ -n$(TMPDIR) -I$(INCLUDES) -c -WD
+ -D$(DEFINES) -3 -d $(PROJECTCCFLAGS)
+| bcc32.cfg >NUL
+
+cfgexe:
+ @$(CP) &&|
+ -n$(TMPDIR) -I$(INCLUDES) -c -W
+ -D$(DEFINES) -3 -d $(PROJECTCCFLAGS)
+| bcc32.cfg >NUL
+
+cfgtest:
+ @$(CP) &&|
+ -n$(TMPDIR) -I$(INCLUDES) -c -W
+ -D$(DEFINES);TCL_TEST -3 -d $(PROJECTCCFLAGS)
+| bcc32.cfg >NUL
+
+cfgcln:
+ @$(RM) bcc32.cfg
+
+#
+# Executable targets
+#
+
+$(TIXDLL): $(TIXOBJS) tix.def
+ tlink32 -L$(LIBDIRS) @&&|
+$(LNFLAGS_dll) $(TIXOBJS)
+$@
+-x
+$(LNLIBS_dll)
+tix.def
+|
+
+$(TIXWISH): $(WISHOBJS) $(TIXLIB) $(TIXOBJS)
+ tlink32 -L$(LIBDIRS) @&&|
+$(LNFLAGS_exe) $(WISHOBJS)
+$@
+-x
+$(LNLIBS_exe)
+|, &&|
+EXETYPE WINDOWS
+CODE PRELOAD MOVEABLE DISCARDABLE
+DATA PRELOAD MOVEABLE MULTIPLE
+|,
+
+#
+# Other dependencies
+#
+
+# The following rule automatically generates a tix.def file containing
+# an export entry for every public symbol in the $(TKDLL) library.
+
+tix.def: $(TIXOBJS)
+ $(TCLLIBDIR)\dumpexts.exe -o $@ $(TKDLL) @&&|
+ $(TIXOBJS)
+|
+
+# remove all generated files
+
+clean:
+ -del $(TMPDIR)\*.obj
+ -del $(TMPDIR)\*.exp
+ -del $(TMPDIR)\*.res
+ -del $(TMPDIR)\*.def
+ -del $(TIXLIB)
+ -del $(TIXDLL)
+ -del $(TIXWISH)
+ -del bcc32.cfg
+
+dist:
+ $(MAKE) TCL_VER=7.5
+ $(MAKE) TCL_VER=7.6
+ $(MAKE) TCL_VER=8.0b1
+ $(MAKE) TCL_VER=2.2i
+
+distclean:
+ $(MAKE) -f makefile.bc TCL_VER=7.5 clean
+ $(MAKE) -f makefile.bc TCL_VER=7.6 clean
+ $(MAKE) -f makefile.bc TCL_VER=8.0b1 clean
+ $(MAKE) -f makefile.bc TCL_VER=2.2i clean
+
+
+move:
+ tclsh76 n:/bin/mkdist.tcl ../dist/windist.tcl
diff --git a/tix/win/makefile.vc b/tix/win/makefile.vc
new file mode 100644
index 00000000000..1043a9dab38
--- /dev/null
+++ b/tix/win/makefile.vc
@@ -0,0 +1,292 @@
+# makefile.vc --
+#
+# Visual C++ 4.x makefile for Tix.
+#
+# Copyright (c) 1996, Expert Interface Technologies
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+#----------------------------------------------------------------------
+# Environment setting
+#
+# You can set the following variables in your DOS environment. This
+# way you don't need to change this file. E.g.:
+#
+# set TCL_VER=7.5
+# nmake -f makefile.vc
+#
+# You can also set these variables in the command line to nmake. E.g.:
+#
+# nmake TCL_VER=7.5 -f makefile.vc
+#
+# TOOLS32 = location of VC++ 32-bit development tools.
+# TIX_DEBUG = Compile Tix with debug information.
+# TCL_VER = version of Tcl to compile with. Should be either 7.5
+# or 7.6
+#----------------------------------------------------------------------
+
+!IFNDEF TOOLS32
+TOOLS32 = C:\msdev
+!ENDIF
+
+!IFNDEF TIX_DEBUG
+NODEBUG=1
+!ENDIF
+
+!IFNDEF TCL_VER
+TCL_VER = 7.6
+!ENDIF
+
+!IF "$(TCL_VER)" == "7.5"
+
+TMPDIR = tcl7.5
+TCLDIR = ..\..\tcl7.5
+TKDIR = ..\..\tk4.1
+TCLLIB = tcl75.lib
+TCLDLL = tcl75.dll
+TKLIB = tk41.lib
+TKDLL = tk41.dll
+TIXLIB = $(TMPDIR)\tix4175.lib
+TIXDLL = $(TMPDIR)\tix4175.dll
+TIXWISH = $(TMPDIR)\tix4175.exe
+
+CONSOLE_OBJ = tkConsole41.obj
+
+!ENDIF
+
+!IF "$(TCL_VER)" == "7.6"
+
+TMPDIR = tcl7.6
+TCLDIR = ..\..\tcl7.6
+TKDIR = ..\..\tk4.2
+TCLLIB = tcl76.lib
+TCLDLL = tcl76.dll
+TKLIB = tk42.lib
+TKDLL = tk42.dll
+TIXLIB = $(TMPDIR)\tix4176.lib
+TIXDLL = $(TMPDIR)\tix4176.dll
+TIXWISH = $(TMPDIR)\tix4176.exe
+
+CONSOLE_OBJ = tkConsole42.obj
+
+!ENDIF
+
+!IF "$(TCL_VER)" == "8.0a1"
+
+TMPDIR = tcl8.0
+TCLDIR = ..\..\tcl8.0a1
+TKDIR = ..\..\tk8.0a1
+TCLLIB = tcl80.lib
+TCLDLL = tcl80.dll
+TKLIB = tk80.lib
+TKDLL = tk80.dll
+TIXLIB = $(TMPDIR)\tix4180.lib
+TIXDLL = $(TMPDIR)\tix4180.dll
+TIXWISH = $(TMPDIR)\tix4180.exe
+
+CONSOLE_OBJ = tkConsole80a1.obj
+
+!ENDIF
+
+!IF "$(TCL_VER)" == "8.0b1"
+
+TMPDIR = tcl8.0
+TCLDIR = ..\..\tcl8.0b1
+TKDIR = ..\..\tk8.0b1
+TCLLIB = tcl80.lib
+TCLDLL = tcl80.dll
+TKLIB = tk80.lib
+TKDLL = tk80.dll
+TIXLIB = $(TMPDIR)\tix4180.lib
+TIXDLL = $(TMPDIR)\tix4180.dll
+TIXWISH = $(TMPDIR)\tix4180.exe
+
+CONSOLE_OBJ = tkConsole80b1.obj
+
+!ENDIF
+
+!IF "$(TCL_VER)" == "2.2i"
+
+TMPDIR = itcl2.2
+ITCL_DIR = ..\..\itcl2.2
+TCLDIR = $(ITCL_DIR)\tcl7.6
+TKDIR = $(ITCL_DIR)\tk4.2
+TCLLIB = tcl76i.lib
+TCLDLL = tcl76i.dll
+TKLIB = tk42i.lib
+TKDLL = tk42i.dll
+TIXLIB = $(TMPDIR)\tix41761.lib
+TIXDLL = $(TMPDIR)\tix41761.dll
+TIXWISH = $(TMPDIR)\tix41761.exe
+
+CONSOLE_OBJ = tkConsole42.obj
+
+ITCL_LIBS = $(ITCL_DIR)\itcl\win\itcl22.lib $(ITCL_DIR)\itk\win\itk22.lib
+ITCL_CFLAGS = -DITCL_2 -I$(ITCL_DIR)\itcl\generic -I$(ITCL_DIR)\itk\generic
+
+!ENDIF
+
+!IFNDEF TCLDIR
+!ERROR "Unsupported Tcl version $(TCL_VER)"
+!ENDIF
+
+
+# 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 = ..
+
+# uncomment the following two lines to compile with TCL_MEM_DEBUG
+#DEBUGDEFINES =-DTCL_MEM_DEBUG
+
+# Make sure the VC++ tools are at the head of the path
+PATH=$(TOOLS32)\bin;$(PATH)
+
+TCLLIBDIR = $(TCLDIR)\win
+TKLIBDIR = $(TKDIR)\win
+WINDIR = $(ROOT)\win
+GENERICDIR = $(ROOT)\generic
+XLIBDIR = $(ROOT)\xlib
+
+cc32 = $(TOOLS32)\bin\cl -I$(TOOLS32)\include
+rc32 = $(TOOLS32)\bin\rc
+link32 = $(TOOLS32)\bin\link
+
+#----------------------------------------------------------------------
+# You shouldn't normally modify anything below this line
+#----------------------------------------------------------------------
+
+X_TK_INCLUDES = -I$(TOOLS32)\include \
+ -I$(ROOT)\win -I$(ROOT)\generic \
+ -I$(TKDIR)\generic -I$(TKDIR)\win -I$(TKDIR)\xlib \
+ -I$(TCLDIR)\generic
+
+TK_INCLUDES = /ML -D_Windows $(X_TK_INCLUDES)
+
+TK_DEFINES = \
+ -nologo $(DEBUGDEFINES)
+
+WISHOBJS = \
+ $(TMPDIR)\tixWinMain.obj
+
+TIXOBJS = \
+ $(TMPDIR)\$(CONSOLE_OBJ) \
+ $(TMPDIR)\tixClass.obj \
+ $(TMPDIR)\tixCmds.obj \
+ $(TMPDIR)\tixCompat.obj \
+ $(TMPDIR)\tixDiImg.obj \
+ $(TMPDIR)\tixDiITxt.obj \
+ $(TMPDIR)\tixDiStyle.obj \
+ $(TMPDIR)\tixDItem.obj \
+ $(TMPDIR)\tixDiText.obj \
+ $(TMPDIR)\tixDiWin.obj \
+ $(TMPDIR)\tixError.obj \
+ $(TMPDIR)\tixForm.obj \
+ $(TMPDIR)\tixFormMisc.obj \
+ $(TMPDIR)\tixGeometry.obj \
+ $(TMPDIR)\tixHLCol.obj \
+ $(TMPDIR)\tixHLHdr.obj \
+ $(TMPDIR)\tixHLInd.obj \
+ $(TMPDIR)\tixImgCmp.obj \
+ $(TMPDIR)\tixHlist.obj \
+ $(TMPDIR)\tixList.obj \
+ $(TMPDIR)\tixMethod.obj \
+ $(TMPDIR)\tixOption.obj \
+ $(TMPDIR)\tixSmpLs.obj \
+ $(TMPDIR)\tixWidget.obj \
+ $(TMPDIR)\tixInit.obj \
+ $(TMPDIR)\tixItcl.obj \
+ $(TMPDIR)\tixUtils.obj \
+ $(TMPDIR)\tixImgXpm.obj \
+ $(TMPDIR)\tixNBFrame.obj \
+ $(TMPDIR)\tixTList.obj \
+ $(TMPDIR)\tixGrid.obj \
+ $(TMPDIR)\tixGrData.obj \
+ $(TMPDIR)\tixGrRC.obj \
+ $(TMPDIR)\tixGrFmt.obj \
+ $(TMPDIR)\tixGrSel.obj \
+ $(TMPDIR)\tixGrUtl.obj \
+ $(TMPDIR)\tixScroll.obj \
+ $(TMPDIR)\tixWCmpt.obj \
+ $(TMPDIR)\tixWinDraw.obj \
+ $(TMPDIR)\tixWinXpm.obj \
+ $(TMPDIR)\tixWinWm.obj
+
+CP = copy
+
+!include <ntwin32.mak>
+
+all: $(TIXDLL) $(TIXWISH)
+
+$(TMPDIR)\tixvc.def: $(TIXOBJS)
+ $(TCLLIBDIR)\dumpexts.exe -o $@ $(TIXDLL) @<<
+ $(TIXOBJS)
+<<
+
+# USE THESE IF YOU DO NOT WANT TO LINK TO ON MSVCRT.DLL
+#XGUILIBS = $(guilibs)
+#XCVARS = $(cvars)
+
+XGUILIBS = $(guilibsdll)
+XCVARS = $(cvarsdll)
+
+# (ToDo) $(TIXDLL) doesn't have resources to define its icon, etc.
+#
+$(TIXDLL): $(TIXOBJS) $(TMPDIR)\tixvc.def
+ $(link32) $(linkdebug) $(dlllflags) -def:$(TMPDIR)\tixvc.def \
+ $(TKLIBDIR)\$(TKLIB) $(TCLLIBDIR)\$(TCLLIB) $(XGUILIBS) \
+ $(ITCL_LIBS) \
+ -out:$(TIXDLL) @<<
+ $(TIXOBJS)
+<<
+
+
+$(TIXWISH): $(WISHOBJS) $(TIXOBJS) $(TIXLIB) $(TMPDIR)\tixwish.res
+ $(link32) $(linkdebug) $(guilflags) \
+ $(WISHOBJS) $(TMPDIR)\tixwish.res $(TIXLIB) \
+ $(TKLIBDIR)\$(TKLIB) $(TCLLIBDIR)\$(TCLLIB) $(XGUILIBS) \
+ $(ITCL_LIBS) \
+ -out:$(TIXWISH)
+
+
+#
+# Special case object file targets
+#
+
+$(TMPDIR)\testMain.obj: $(ROOT)\win\tixWinMain.c
+ $(cc32) $(cdebug) $(cflags) $(ITCL_CFLAGS) $(XCVARS) $(TK_INCLUDES) \
+ $(TK_DEFINES) -DTK_TEST -Fo$@ $?
+
+#
+# Implicit rules
+#
+
+{$(ROOT)\xlib}.c{$(TMPDIR)}.obj:
+ $(cc32) $(cdebug) $(cflags) $(ITCL_CFLAGS) $(XCVARS) $(TK_INCLUDES) \
+ $(TK_DEFINES) -Fo$(TMPDIR)\ $<
+
+{$(ROOT)\generic}.c{$(TMPDIR)}.obj:
+ $(cc32) $(cdebug) $(cflags) $(ITCL_CFLAGS) $(XCVARS) $(TK_INCLUDES) \
+ $(TK_DEFINES) -Fo$(TMPDIR)\ $<
+
+{$(ROOT)\win}.c{$(TMPDIR)}.obj:
+ $(cc32) $(cdebug) $(cflags) $(ITCL_CFLAGS) $(XCVARS) $(TK_INCLUDES) \
+ $(TK_DEFINES) -Fo$(TMPDIR)\ $<
+
+{$(ROOT)\win\rc}.rc{$(TMPDIR)}.res:
+ $(rc32) -fo $@ -r -i $(ROOT)\generic -i $(X_TK_INCLUDES) $<
+
+clean:
+ -del $(TMPDIR)\*.obj
+ -del $(TMPDIR)\*.exp
+ -del $(TMPDIR)\*.res
+ -del $(TMPDIR)\*.def
+ -del $(TIXLIB)
+ -del $(TIXDLL)
+ -del $(TIXWISH)
diff --git a/tix/win/pkgIndex.tcl b/tix/win/pkgIndex.tcl
new file mode 100644
index 00000000000..d06733e9e81
--- /dev/null
+++ b/tix/win/pkgIndex.tcl
@@ -0,0 +1,15 @@
+# Tcl package index file, version 1.0
+
+package ifneeded Tix 4.1.7.5 \
+ [list load "[file join [file dirname $dir] tix4175.dll]" Tix]
+
+package ifneeded Tix 4.1.7.6 \
+ [list load "[file join [file dirname $dir] tix4176.dll]" Tix]
+
+# Itcl 2.2
+package ifneeded Tix 4.1.7.6.1 \
+ [list load "[file join [file dirname $dir] tix41761.dll]" Tix]
+
+package ifneeded Tix 4.1.8.0 \
+ [list load "[file join [file dirname $dir] tix4180.dll]" Tix]
+
diff --git a/tix/win/rc/tixwish.ico b/tix/win/rc/tixwish.ico
new file mode 100755
index 00000000000..7616c6029cd
--- /dev/null
+++ b/tix/win/rc/tixwish.ico
Binary files differ
diff --git a/tix/win/rc/tixwish.rc b/tix/win/rc/tixwish.rc
new file mode 100644
index 00000000000..144ca4c00b1
--- /dev/null
+++ b/tix/win/rc/tixwish.rc
@@ -0,0 +1,40 @@
+// SCCS: @(#) wish.rc 1.8 96/04/12 18:08:09
+//
+// Version
+//
+
+#include <tix.h>
+
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION 4,1,1,0
+ PRODUCTVERSION 4,1,1,0
+ FILEFLAGSMASK 0x3fL
+ FILEFLAGS 0x0L
+ FILEOS 0x4L
+ FILETYPE 0x1L
+ FILESUBTYPE 0x0L
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904b0"
+ BEGIN
+ VALUE "FileDescription", "Tixwish Application\0"
+ VALUE "OriginalFilename", "txwish41.exe\0"
+ VALUE "CompanyName", "Expert Interface Technologies\0"
+ VALUE "FileVersion", TIX_PATCH_LEVEL
+ VALUE "LegalCopyright", "Copyright \251 1996\0"
+ VALUE "ProductName", "Tix 4.1 for Windows\0"
+ VALUE "ProductVersion", TIX_PATCH_LEVEL
+ END
+ END
+ BLOCK "VarFileInfo"
+ BEGIN
+ VALUE "Translation", 0x409, 1200
+ END
+END
+
+//
+// Icon
+//
+
+tixwish ICON DISCARDABLE "tixwish.ico"
diff --git a/tix/win/tcl7.6/dummy.dir b/tix/win/tcl7.6/dummy.dir
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/tix/win/tcl7.6/dummy.dir
diff --git a/tix/win/tcl8.0/dummy.dir b/tix/win/tcl8.0/dummy.dir
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/tix/win/tcl8.0/dummy.dir
diff --git a/tix/win/tcl8.1/dummy.dir b/tix/win/tcl8.1/dummy.dir
new file mode 100644
index 00000000000..e69de29bb2d
--- /dev/null
+++ b/tix/win/tcl8.1/dummy.dir
diff --git a/tix/win/tixWCmpt.c b/tix/win/tixWCmpt.c
new file mode 100644
index 00000000000..70663ef34da
--- /dev/null
+++ b/tix/win/tixWCmpt.c
@@ -0,0 +1,184 @@
+/*
+ * tixWCmpt.c --
+ *
+ * Windows compatibility module: implements missing functions in Windows.
+ */
+
+#include <tkWinInt.h>
+#include <tixPort.h>
+#include <tixInt.h>
+
+#ifndef strcasecmp
+int strcasecmp(char * a, char *b)
+{
+ while (1) {
+ if (*a== 0 && *b==0) {
+ return 0;
+ }
+ if (*a==0) {
+ return (1);
+ }
+ if (*b==0) {
+ return (-1);
+ }
+ if (tolower(*a)>tolower(*b)) {
+ return (-1);
+ }
+ if (tolower(*b)>tolower(*a)) {
+ return (1);
+ }
+ a++; b++;
+ }
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XLowerWindow --
+ *
+ * Change the stacking order of a window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the stacking order of the specified window.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+XLowerWindow(display, w)
+ Display* display;
+ Window w;
+{
+ HWND window = TkWinGetHWND(w);
+
+ display->request++;
+ SetWindowPos(window, HWND_TOPMOST, 0, 0, 0, 0,
+ SWP_NOMOVE | SWP_NOSIZE);
+}
+
+
+
+#if 1
+void XDrawPoints(display, d, gc, points, npoints, mode)
+ Display* display;
+ Drawable d;
+ GC gc;
+ XPoint* points;
+ int npoints;
+ int mode;
+{
+ int i;
+
+ for (i=0; i<npoints; i++) {
+ XDrawLine(display, d, gc, points[i].x, points[i].y,
+ points[i].x, points[i].y);
+ }
+}
+
+#endif
+
+#if 1
+
+/*
+ * The following declaration is for the VC++ DLL entry point.
+ */
+
+BOOL APIENTRY DllMain _ANSI_ARGS_((HINSTANCE hInst,
+ DWORD reason, LPVOID reserved));
+
+/* CYGNUS LOCAL */
+#ifdef __CYGWIN32__
+/* cygwin32 requires an impure pointer variable, which must be
+ explicitly initialized when the DLL starts up. */
+struct _reent *_impure_ptr;
+extern struct _reent *_imp__reent_data;
+#endif
+/* END CYGNUS LOCAL */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DllEntryPoint --
+ *
+ * This wrapper function is used by Borland to invoke the
+ * initialization code for Tk. It simply calls the DllMain
+ * routine.
+ *
+ * Results:
+ * See DllMain.
+ *
+ * Side effects:
+ * See DllMain.
+ *
+ *----------------------------------------------------------------------
+ */
+
+BOOL APIENTRY
+DllEntryPoint(hInst, reason, reserved)
+ HINSTANCE hInst; /* Library instance handle. */
+ DWORD reason; /* Reason this function is being called. */
+ LPVOID reserved; /* Not used. */
+{
+ return DllMain(hInst, reason, reserved);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DllMain --
+ *
+ * DLL entry point.
+ *
+ * Results:
+ * TRUE on sucess, FALSE on failure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+BOOL APIENTRY
+DllMain(hInstance, reason, reserved)
+ HINSTANCE hInstance;
+ DWORD reason;
+ LPVOID reserved;
+{
+ /* CYGNUS LOCAL */
+#ifdef __CYGWIN32__
+ /* cygwin32 requires the impure data pointer to be initialized
+ when the DLL starts up. */
+ _impure_ptr = _imp__reent_data;
+#endif
+ /* END CYGNUS LOCAL */
+
+ /*
+ * 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.
+ */
+
+ return(TRUE);
+}
+#else
+
+#define DllExport __declspec( dllexport )
+
+DllExport
+DllEntryPoint(hInst, reason, reserved)
+ HINSTANCE hInst; /* Library instance handle. */
+ DWORD reason; /* Reason this function is being called. */
+ LPVOID reserved; /* Not used. */
+{
+ return TRUE;
+}
+
+#endif
+
+int TixPlatformInit(Tcl_Interp * interp)
+{
+ return Tcl_GlobalEval(interp, "set tix(isWindows) 1");
+}
diff --git a/tix/win/tixWinDraw.c b/tix/win/tixWinDraw.c
new file mode 100644
index 00000000000..97b02b55f4c
--- /dev/null
+++ b/tix/win/tixWinDraw.c
@@ -0,0 +1,310 @@
+/*
+ * tixWinDraw.c --
+ *
+ * Implement the Windows specific function calls for drawing.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tkInt.h>
+#include <tkWinInt.h>
+#include <tixInt.h>
+#include <tixPort.h>
+
+/*----------------------------------------------------------------------
+ * TixpDrawTmpLine --
+ *
+ * Draws a "temporarily" line on the desktop window with XOR
+ * drawing mode. This function is used by the PanedWindow and
+ * ResizeHandler to draw the rubberband lines. Calling the
+ * function again with the same parameters cancels the temporary
+ * lines without affecting what was originally on the screen.
+ *----------------------------------------------------------------------
+ */
+
+void
+TixpDrawTmpLine(x1, y1, x2, y2, tkwin)
+ int x1;
+ int y1;
+ int x2;
+ int y2;
+ Tk_Window tkwin;
+{
+ HWND desktop;
+ HDC hdc;
+ HPEN hpen;
+ HGDIOBJ old;
+
+ desktop = GetDesktopWindow();
+ hdc = GetWindowDC(desktop);
+ hpen = CreatePen(PS_SOLID, 0, RGB(255,255,255));
+
+ old = SelectObject(hdc, hpen);
+ SetROP2(hdc, R2_XORPEN);
+
+ MoveToEx(hdc, x1, y1, NULL);
+ LineTo(hdc, x2, y2);
+
+ SelectObject(hdc, old);
+ DeleteObject(hpen);
+ ReleaseDC(desktop, hdc);
+}
+
+/*----------------------------------------------------------------------
+ * TixpDrawAnchorLines --
+ *
+ * See comments near Tix_DrawAnchorLines.
+ *----------------------------------------------------------------------
+ */
+
+void
+TixpDrawAnchorLines(display, drawable, gc, x, y, w, h)
+ Display *display;
+ Drawable drawable;
+ GC gc;
+ int x;
+ int y;
+ int w;
+ int h;
+{
+ HDC hdc;
+ TkWinDCState state;
+ HPEN hpen;
+ HGDIOBJ old;
+
+ hdc = TkWinGetDrawableDC(display, drawable, &state);
+ hpen = CreatePen(PS_DOT, 1, gc->foreground);
+
+ old = SelectObject(hdc, hpen);
+ MoveToEx(hdc, x, y, NULL);
+ LineTo(hdc, x, y+h-1);
+ LineTo(hdc, x+w-1, y+h-1);
+ LineTo(hdc, x+w-1, y);
+ LineTo(hdc, x, y);
+
+ SelectObject(hdc, old);
+ DeleteObject(hpen);
+
+ TkWinReleaseDrawableDC(drawable, hdc, &state);
+}
+
+/*----------------------------------------------------------------------
+ * TixpStartSubRegionDraw --
+ *
+ * Limits the subsequent drawing operations into the prescribed
+ * rectangle region. This takes effect up to a matching
+ * TixEndSubRegionDraw() call.
+ *
+ * Return value:
+ * none.
+ *----------------------------------------------------------------------
+ */
+
+void
+TixpStartSubRegionDraw(display, drawable, gc, subRegPtr, origX, origY,
+ x, y, width, height, needWidth, needHeight)
+ Display *display;
+ Drawable drawable;
+ GC gc;
+ TixpSubRegion * subRegPtr;
+ int origX;
+ int origY;
+ int x;
+ int y;
+ int width;
+ int height;
+ int needWidth;
+ int needHeight;
+{
+ TkWinDrawable * wdrPtr;
+ int depth;
+
+ if ((width < needWidth) || (height < needHeight)) {
+ subRegPtr->origX = origX;
+ subRegPtr->origY = origY;
+ subRegPtr->x = x;
+ subRegPtr->y = y;
+ subRegPtr->width = width;
+ subRegPtr->height = height;
+
+ /*
+ * Find out the depth of the drawable and create a pixmap of
+ * the same depth.
+ */
+
+ wdrPtr = (TkWinDrawable *)drawable;
+ if (wdrPtr->type == TWD_BITMAP) {
+ depth = wdrPtr->bitmap.depth;
+ } else {
+ depth = wdrPtr->window.winPtr->depth;
+ }
+
+ subRegPtr->pixmap = Tk_GetPixmap(display, drawable, width, height,
+ depth);
+
+ if (subRegPtr->pixmap != None) {
+ /*
+ * It could be None if we have somehow exhausted the Windows
+ * GDI resources.
+ */
+ XCopyArea(display, drawable, subRegPtr->pixmap, gc, x, y,
+ width, height, 0, 0);
+ }
+ } else {
+ subRegPtr->pixmap = None;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * TixpEndSubRegionDraw --
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TixpEndSubRegionDraw(display, drawable, gc, subRegPtr)
+ Display *display;
+ Drawable drawable;
+ GC gc;
+ TixpSubRegion * subRegPtr;
+{
+ if (subRegPtr->pixmap != None) {
+ XCopyArea(display, subRegPtr->pixmap, drawable, gc, 0, 0,
+ subRegPtr->width, subRegPtr->height,
+ subRegPtr->x, subRegPtr->y);
+ Tk_FreePixmap(display, subRegPtr->pixmap);
+ subRegPtr->pixmap = None;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TixpSubRegDisplayText --
+ *
+ * Display a text string on one or more lines in a sub region.
+ *
+ * Results:
+ * See TkDisplayText
+ *
+ * Side effects:
+ * See TkDisplayText
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TixpSubRegDisplayText(display, drawable, gc, subRegPtr, font, string,
+ numChars, x, y, length, justify, underline)
+ Display *display; /* X display to use for drawing text. */
+ Drawable drawable; /* Window or pixmap in which to draw the
+ * text. */
+ GC gc; /* Graphics context to use for drawing text. */
+ TixpSubRegion * subRegPtr; /* Information about the subregion */
+ TixFont font; /* Font that determines geometry of text
+ * (should be same as font in gc). */
+ char *string; /* String to display; may contain embedded
+ * newlines. */
+ int numChars; /* Number of characters to use from string. */
+ int x, y; /* Pixel coordinates within drawable of
+ * upper left corner of display area. */
+ int length; /* Line length in pixels; used to compute
+ * word wrap points and also for
+ * justification. Must be > 0. */
+ Tk_Justify justify; /* How to justify lines. */
+ int underline; /* Index of character to underline, or < 0
+ * for no underlining. */
+{
+ if (subRegPtr->pixmap != None) {
+ TixDisplayText(display, subRegPtr->pixmap, font, string,
+ numChars, x - subRegPtr->x, y - subRegPtr->y,
+ length, justify, underline, gc);
+ } else {
+ TixDisplayText(display, drawable, font, string,
+ numChars, x, y, length, justify, underline, gc);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * TixpSubRegFillRectangle --
+ *
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TixpSubRegFillRectangle(display, drawable, gc, subRegPtr, x, y, width, height)
+ Display *display; /* X display to use for drawing rectangle. */
+ Drawable drawable; /* Window or pixmap in which to draw the
+ * rectangle. */
+ GC gc; /* Graphics context to use for drawing. */
+ TixpSubRegion * subRegPtr; /* Information about the subregion */
+ int x, y; /* Pixel coordinates within drawable of
+ * upper left corner of display area. */
+ int width, height; /* Size of the rectangle. */
+{
+ if (subRegPtr->pixmap != None) {
+ XFillRectangle(display, subRegPtr->pixmap, gc,
+ x - subRegPtr->x, y - subRegPtr->x, width, height);
+ } else {
+ XFillRectangle(display, drawable, gc, x, y, width, height);
+ }
+}
+
+/*----------------------------------------------------------------------
+ * TixpSubRegDrawImage --
+ *
+ * Draws a Tk image in a subregion.
+ *----------------------------------------------------------------------
+ */
+
+void
+TixpSubRegDrawImage(subRegPtr, image, imageX, imageY, width, height,
+ drawable, drawableX, drawableY)
+ TixpSubRegion * subRegPtr;
+ Tk_Image image;
+ int imageX;
+ int imageY;
+ int width;
+ int height;
+ Drawable drawable;
+ int drawableX;
+ int drawableY;
+{
+ if (subRegPtr->pixmap != None) {
+ Tk_RedrawImage(image, imageX, imageY, width, height, subRegPtr->pixmap,
+ drawableX - subRegPtr->x, drawableY - subRegPtr->y);
+ } else {
+ Tk_RedrawImage(image, imageX, imageY, width, height, drawable,
+ drawableX, drawableY);
+ }
+}
+
+void
+TixpSubRegDrawBitmap(display, drawable, gc, subRegPtr, bitmap, src_x, src_y,
+ width, height, dest_x, dest_y, plane)
+ Display *display;
+ Drawable drawable;
+ GC gc;
+ TixpSubRegion * subRegPtr;
+ Pixmap bitmap;
+ int src_x, src_y;
+ int width, height;
+ int dest_x, dest_y;
+ unsigned long plane;
+{
+ XSetClipOrigin(display, gc, dest_x, dest_y);
+ if (subRegPtr->pixmap != None) {
+ XCopyPlane(display, bitmap, subRegPtr->pixmap, gc, src_x, src_y,
+ width, height, dest_x - subRegPtr->x, dest_y - subRegPtr->y,
+ plane);
+ } else {
+ XCopyPlane(display, bitmap, drawable, gc, src_x, src_y, width, height,
+ dest_x, dest_y, plane);
+ }
+ XSetClipOrigin(display, gc, 0, 0);
+}
diff --git a/tix/win/tixWinInt.h b/tix/win/tixWinInt.h
new file mode 100644
index 00000000000..d0a5cf99f83
--- /dev/null
+++ b/tix/win/tixWinInt.h
@@ -0,0 +1,20 @@
+/*
+ * tixWinInt.h
+ *
+ * Internal header file for Tix on the Windows platform.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#ifndef _TIX_WIN_INT_H_
+#define _TIX_WIN_INT_H_
+
+#ifndef _TIX_INT_H_
+#include "tixInt.h"
+#endif
+
+#endif /* _TIX_WIN_INT_H_ */
diff --git a/tix/win/tixWinMain.c b/tix/win/tixWinMain.c
new file mode 100644
index 00000000000..b06862d499a
--- /dev/null
+++ b/tix/win/tixWinMain.c
@@ -0,0 +1,303 @@
+/*
+ * tixWinMain.c --
+ *
+ * Main entry point for wish and other Tk-based applications.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ *
+ */
+
+#include <tk.h>
+#include <tixInt.h>
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#undef WIN32_LEAN_AND_MEAN
+#include <malloc.h>
+#include <locale.h>
+
+#ifdef ITCL_2
+#include "itcl.h"
+#include "itk.h"
+#endif
+
+/*
+ * The following declarations refer to internal Tk routines. These
+ * interfaces are available for use, but are not supported.
+ */
+
+EXTERN void TkConsoleCreate _ANSI_ARGS_((void));
+EXTERN int TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp));
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void WishPanic _ANSI_ARGS_(TCL_VARARGS(char *,format));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WinMain --
+ *
+ * Main entry point from Windows.
+ *
+ * Results:
+ * Returns false if initialization fails, otherwise it never
+ * returns.
+ *
+ * Side effects:
+ * Just about anything, since from here we call arbitrary Tcl code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int APIENTRY
+WinMain(hInstance, hPrevInstance, lpszCmdLine, nCmdShow)
+ HINSTANCE hInstance;
+ HINSTANCE hPrevInstance;
+ LPSTR lpszCmdLine;
+ int nCmdShow;
+{
+ char **argv, **argvlist, *p;
+ int argc, size, i;
+ char buffer[MAX_PATH];
+
+ Tcl_SetPanicProc(WishPanic);
+
+ /*
+ * 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);
+
+ /*
+ * Precompute an overly pessimistic guess at the number of arguments
+ * in the command line by counting non-space spans. Note that we
+ * have to allow room for the executable name and the trailing NULL
+ * argument.
+ */
+
+ for (size = 3, p = lpszCmdLine; *p != '\0'; p++) {
+ if (isspace(*p)) {
+ size++;
+ while (isspace(*p)) {
+ p++;
+ }
+ if (*p == '\0') {
+ break;
+ }
+ }
+ }
+ argvlist = (char **) ckalloc((unsigned) (size * sizeof(char *)));
+ argv = argvlist;
+
+ /*
+ * Parse the Windows command line string. If an argument begins with a
+ * double quote, then spaces are considered part of the argument until the
+ * next double quote. The argument terminates at the second quote. Note
+ * that this is different from the usual Unix semantics.
+ */
+
+ for (i = 1, p = lpszCmdLine; *p != '\0'; i++) {
+ while (isspace(*p)) {
+ p++;
+ }
+ if (*p == '\0') {
+ break;
+ }
+ if (*p == '"') {
+ p++;
+ argv[i] = p;
+ while ((*p != '\0') && (*p != '"')) {
+ p++;
+ }
+ } else {
+ argv[i] = p;
+ while (*p != '\0' && !isspace(*p)) {
+ p++;
+ }
+ }
+ if (*p != '\0') {
+ *p = '\0';
+ p++;
+ }
+ }
+ argv[i] = NULL;
+ argc = i;
+
+ /*
+ * Since Windows programs don't get passed the command name as the
+ * first argument, we need to fetch it explicitly.
+ */
+
+ GetModuleFileName(NULL, buffer, sizeof(buffer));
+ argv[0] = buffer;
+
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppInit(interp)
+ Tcl_Interp *interp; /* Interpreter for application. */
+{
+ /*
+ * 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();
+
+ if (Tcl_Init(interp) == TCL_ERROR) {
+ if (Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY)) {
+ MessageBox(NULL, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY),
+ "Tcl Init Error", MB_OK|MB_ICONSTOP);
+ } else {
+ MessageBox(NULL, interp->result, "Tcl Init Error",
+ MB_OK|MB_ICONSTOP );
+ }
+ return TCL_ERROR;
+ }
+
+ if (Tk_Init(interp) == TCL_ERROR) {
+ if (Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY)) {
+ MessageBox(NULL, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY),
+ "Tk Init Error", MB_OK|MB_ICONSTOP);
+ } else {
+ MessageBox(NULL, interp->result, "Tk Init Error",
+ MB_OK|MB_ICONSTOP);
+ }
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tk", Tk_Init, (Tcl_PackageInitProc *) NULL);
+
+#ifdef ITCL_2
+ if (Itcl_Init(interp) == TCL_ERROR) {
+ if (Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY)) {
+ MessageBox(NULL, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY),
+ "Itcl Init Error", MB_OK|MB_ICONSTOP);
+ } else {
+ MessageBox(NULL, interp->result, "Itcl Init Error",
+ MB_OK|MB_ICONSTOP);
+ }
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Itcl", Itcl_Init, (Tcl_PackageInitProc *) NULL);
+
+ if (Itk_Init(interp) == TCL_ERROR) {
+ if (Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY)) {
+ MessageBox(NULL, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY),
+ "Itk Init Error", MB_OK|MB_ICONSTOP);
+ } else {
+ MessageBox(NULL, interp->result, "Itk Init Error",
+ MB_OK|MB_ICONSTOP);
+ }
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Itk", Itk_Init, (Tcl_PackageInitProc *) NULL);
+#endif
+
+ if (Tix_Init(interp) == TCL_ERROR) {
+ if (Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY)) {
+ MessageBox(NULL, Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY),
+ "Tix Init Error", MB_OK|MB_ICONSTOP);
+ } else {
+ MessageBox(NULL, interp->result, "Tix Init Error",
+ MB_OK|MB_ICONSTOP);
+ }
+ return TCL_ERROR;
+ }
+ Tcl_StaticPackage(interp, "Tix", Tix_Init, (Tcl_PackageInitProc *) NULL);
+
+ /*
+ * Initialize the console only if we are running as an interactive
+ * application.
+ */
+
+ if (strcmp(Tcl_GetVar(interp, "tcl_interactive", TCL_GLOBAL_ONLY), "1")
+ == 0) {
+ if (TkConsoleInit(interp) == TCL_ERROR) {
+ return TCL_ERROR;
+ }
+ }
+
+ Tcl_SetVar(interp, "tcl_rcFileName", "~/wishrc.tcl", TCL_GLOBAL_ONLY);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WishPanic --
+ *
+ * Display a message and exit.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Exits the program.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+WishPanic TCL_VARARGS_DEF(char *,arg1)
+{
+ va_list argList;
+ char buf[1024];
+ char *format;
+
+ 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);
+ ExitProcess(1);
+}
+
diff --git a/tix/win/tixWinPort.h b/tix/win/tixWinPort.h
new file mode 100644
index 00000000000..05ec1442657
--- /dev/null
+++ b/tix/win/tixWinPort.h
@@ -0,0 +1,43 @@
+/*
+ * tixWinPort.h --
+ *
+ * This header file handles porting issues that occur because of
+ * differences between systems. It reads in platform specific
+ * portability files.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#ifndef _TIX_WINPORT_H_
+#define _TIX_WINPORT_H_
+
+#include <malloc.h>
+#include <stdio.h>
+
+#include <stdlib.h>
+#include <string.h>
+#include <errno.h>
+#include <sys/stat.h>
+#include <sys/timeb.h>
+#include <time.h>
+#include <io.h>
+#include <fcntl.h>
+
+#define WIN32_LEAN_AND_MEAN
+#include <windows.h>
+#undef WIN32_LEAN_AND_MEAN
+
+struct _TixpSubRegion {
+ Pixmap pixmap;
+ int origX, origY;
+ int x, y;
+ int width, height;
+};
+
+typedef unsigned char UNSIGNED_CHAR;
+
+#endif /* _TIX_WINPORT_H_ */
diff --git a/tix/win/tixWinWm.c b/tix/win/tixWinWm.c
new file mode 100644
index 00000000000..8da36047bbc
--- /dev/null
+++ b/tix/win/tixWinWm.c
@@ -0,0 +1,24 @@
+/*
+ * tixWinWm.c --
+ *
+ * Functions related to window management that are specific to
+ * the Windows platform
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include "tixWinInt.h"
+
+int
+TixpSetWindowParent(interp, tkwin, newParent, parentId)
+ Tcl_Interp * interp;
+ Tk_Window tkwin;
+ Tk_Window newParent;
+ int parentId;
+{
+ return TCL_OK;
+}
diff --git a/tix/win/tixWinXpm.c b/tix/win/tixWinXpm.c
new file mode 100644
index 00000000000..51c8459664f
--- /dev/null
+++ b/tix/win/tixWinXpm.c
@@ -0,0 +1,309 @@
+/*
+ * tixWinImgXpm.c --
+ *
+ * Implement the Windows specific function calls for the pixmap
+ * image type.
+ *
+ * Copyright (c) 1996, Expert Interface Technologies
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ */
+
+#include <tkInt.h>
+#include <tkWinInt.h>
+#include <tix.h>
+#include <tixImgXpm.h>
+
+typedef struct PixmapData {
+ HDC bitmapDC; /* Bitmap used on Windows platforms */
+ HDC maskDC; /* Mask used on Windows platforms */
+ HBITMAP bitmap, bitmapOld;
+ HBITMAP maskBm, maskBmOld;
+} PixmapData;
+
+static void CopyTransparent _ANSI_ARGS_((Display* display,
+ HDC srcDC, Drawable dest,
+ int src_x, int src_y, int width,
+ int height, int dest_x, int dest_y,
+ HDC maskDC));
+
+
+/*----------------------------------------------------------------------
+ * TixpInitPixmapInstance --
+ *
+ * Initializes the platform-specific data of a pixmap instance
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TixpInitPixmapInstance(masterPtr, instancePtr)
+ PixmapMaster *masterPtr; /* Pointer to master for image. */
+ PixmapInstance *instancePtr;/* The pixmap instance. */
+{
+ PixmapData * dataPtr;
+
+ dataPtr = (PixmapData *)ckalloc(sizeof(PixmapData));
+ dataPtr->maskDC = NULL;
+ dataPtr->bitmapDC = NULL;
+
+ instancePtr->clientData = (ClientData)dataPtr;
+}
+
+
+/*----------------------------------------------------------------------
+ * TixpXpmAllocTmpBuffer --
+ *
+ * Allocate a temporary space to draw the image.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TixpXpmAllocTmpBuffer(masterPtr, instancePtr, imagePtr, maskPtr)
+ PixmapMaster * masterPtr;
+ PixmapInstance * instancePtr;
+ XImage ** imagePtr;
+ XImage ** maskPtr;
+{
+ XImage * image = NULL; /* Unused. Always return NULL. */
+ XImage * mask;
+ Display *display = Tk_Display(instancePtr->tkwin);
+ int depth;
+ int maskSize;
+ int i;
+ int wordBits = sizeof(WORD)*8; /* # of bits in WORD */
+ int wordBytes = sizeof(WORD)/sizeof(char); /* # of bytes in WORD */
+ int words_per_line;
+
+ depth = Tk_Depth(instancePtr->tkwin);
+
+ instancePtr->pixmap = Tk_GetPixmap(display,
+ Tk_WindowId(instancePtr->tkwin),
+ masterPtr->size[0], masterPtr->size[1], depth);
+
+ mask = (XImage*)ckalloc(sizeof(XImage));
+
+ mask->width = masterPtr->size[0];
+ mask->height = masterPtr->size[1];
+
+ /*
+ * In Windows, each scan line in the the mask data must be aligned
+ * to words. The padding bits must be zero'ed.
+ */
+ words_per_line = (mask->width + (wordBits-1))/wordBits;
+ mask->bytes_per_line = words_per_line * wordBytes;
+
+ maskSize = mask->bytes_per_line * mask->height;
+ mask->data = (char *)ckalloc(maskSize);
+ for (i=0; i<maskSize; i++) {
+ mask->data[i] = 0;
+ }
+
+ *imagePtr = image;
+ *maskPtr = mask;
+}
+
+
+void
+TixpXpmFreeTmpBuffer(masterPtr, instancePtr, image, mask)
+ PixmapMaster * masterPtr;
+ PixmapInstance * instancePtr;
+ XImage * image;
+ XImage * mask;
+{
+ if (image) {
+ ckfree((char*)image->data);
+ image->data = NULL;
+ XDestroyImage(image);
+ }
+ if (mask) {
+ ckfree((char*)mask->data);
+ mask->data = NULL;
+ ckfree((char*)mask);
+ }
+}
+
+
+/*----------------------------------------------------------------------
+ * TixpXpmSetPixel --
+ *
+ * Sets the pixel at the given (x,y) coordinate to be the given
+ * color.
+ *----------------------------------------------------------------------
+ */
+void
+TixpXpmSetPixel(instancePtr, image, mask, x, y, colorPtr, isTranspPtr)
+ PixmapInstance * instancePtr;
+ XImage * image;
+ XImage * mask;
+ int x;
+ int y;
+ XColor * colorPtr;
+ int * isTranspPtr;
+{
+ char * p;
+ int n;
+ GC gc;
+ XGCValues gcValues;
+ Display *display = Tk_Display(instancePtr->tkwin);
+
+ if (colorPtr != NULL) {
+ gcValues.foreground = colorPtr->pixel;
+ gc = Tk_GetGC(instancePtr->tkwin, GCForeground, &gcValues);
+ XDrawRectangle(display, instancePtr->pixmap, gc, x, y, 1, 1);
+ Tk_FreeGC(display, gc);
+ }
+
+ p = mask->data;
+ p+= y*(mask->bytes_per_line);
+ p+= x/8;
+ n = x%8;
+
+ if (colorPtr != NULL) {
+ *p |= (1 << (7-n));
+ } else {
+ *p &= ~(1 << (7-n));
+ *isTranspPtr = 1;
+ }
+}
+
+/*----------------------------------------------------------------------
+ * TixpXpmRealizePixmap --
+ *
+ * On Unix: Create the pixmap from the buffer.
+ * On Windows: Free the mask if there are no transparent pixels.
+ *----------------------------------------------------------------------
+ */
+void
+TixpXpmRealizePixmap(masterPtr, instancePtr, image, mask, isTransp)
+ PixmapMaster * masterPtr;
+ PixmapInstance * instancePtr;
+ XImage * image;
+ XImage * mask;
+{
+ Display *display = Tk_Display(instancePtr->tkwin);
+ PixmapData *dataPtr = (PixmapData*)instancePtr->clientData;
+ HDC dc, bitmapDC;
+ TkWinDCState dcState;
+ HBITMAP bitmap, bitmapOld;
+ int w, h;
+
+ w = masterPtr->size[0];
+ h = masterPtr->size[1];
+
+ dc = TkWinGetDrawableDC(display, instancePtr->pixmap, &dcState);
+ bitmapDC = CreateCompatibleDC(dc);
+
+ bitmap = CreateCompatibleBitmap(dc, w, h);
+ bitmapOld = SelectObject(bitmapDC, bitmap);
+
+ BitBlt(bitmapDC, 0, 0, w, h, dc, 0, 0, SRCCOPY);
+
+ if (isTransp) {
+ HDC maskDC;
+ HBITMAP maskBm, maskBmOld;
+
+ /*
+ * There are transparent pixels. We need a mask.
+ */
+ maskDC = CreateCompatibleDC(dc);
+ maskBm = CreateBitmap(w, h, 1, 1, (CONST VOID*)mask->data);
+ maskBmOld = SelectObject(maskDC, maskBm);
+
+ BitBlt(bitmapDC, 0, 0, w, h, maskDC, 0, 0, SRCAND);
+ BitBlt(maskDC, 0, 0, w, h, maskDC, 0, 0, NOTSRCCOPY);
+
+ TkWinReleaseDrawableDC(instancePtr->pixmap, dc, &dcState);
+ dataPtr->maskDC = maskDC;
+ dataPtr->maskBm = maskBm;
+ dataPtr->maskBmOld = maskBmOld;
+ } else {
+ dataPtr->maskDC = NULL;
+ }
+ dataPtr->bitmapDC = bitmapDC;
+ dataPtr->bitmap = bitmap;
+ dataPtr->bitmapOld = bitmapOld;
+}
+
+void
+TixpXpmFreeInstanceData(instancePtr, delete, display)
+ PixmapInstance *instancePtr; /* Pixmap instance. */
+ int delete; /* Should the instance data structure
+ * be deleted as well? */
+ Display * display; /* Unused on Windows. */
+{
+ PixmapData *dataPtr = (PixmapData*)instancePtr->clientData;
+
+ if (dataPtr->maskDC != NULL) {
+ DeleteObject(SelectObject(dataPtr->maskDC,
+ dataPtr->maskBmOld));
+ DeleteDC(dataPtr->maskDC);
+ dataPtr->maskDC = NULL;
+ }
+ if (dataPtr->bitmapDC != NULL) {
+ DeleteObject(SelectObject(dataPtr->bitmapDC,
+ dataPtr->bitmapOld));
+ DeleteDC(dataPtr->bitmapDC);
+ dataPtr->bitmapDC = NULL;
+ }
+ if (delete) {
+ ckfree((char*)dataPtr);
+ instancePtr->clientData = NULL;
+ }
+}
+
+void
+TixpXpmDisplay(clientData, display, drawable, imageX, imageY, width,
+ height, drawableX, drawableY)
+ ClientData clientData; /* Pointer to PixmapInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display on which to draw image. */
+ Drawable drawable; /* Pixmap or window in which to draw image. */
+ int imageX, imageY; /* Upper-left corner of region within image
+ * to draw. */
+ int width, height; /* Dimensions of region within image to draw.*/
+ int drawableX, drawableY; /* Coordinates within drawable that
+ * correspond to imageX and imageY. */
+{
+ PixmapInstance *instancePtr = (PixmapInstance *) clientData;
+ PixmapData *dataPtr = (PixmapData*)instancePtr->clientData;
+
+ CopyTransparent(display, dataPtr->bitmapDC, drawable,
+ imageX, imageY, width, height,
+ drawableX, drawableY, dataPtr->maskDC);
+}
+
+static void
+CopyTransparent(display, srcDC, dest, src_x, src_y, width, height, dest_x,
+ dest_y, maskDC)
+ Display* display;
+ HDC srcDC;
+ Drawable dest;
+ int src_x;
+ int src_y;
+ int width;
+ int height;
+ int dest_x;
+ int dest_y;
+ HDC maskDC;
+{
+ HDC destDC;
+ TkWinDCState destState;
+
+ destDC = TkWinGetDrawableDC(display, dest, &destState);
+
+ if (maskDC) {
+ BitBlt(destDC, dest_x, dest_y, width, height, maskDC, src_x, src_y,
+ SRCAND);
+ BitBlt(destDC, dest_x, dest_y, width, height, srcDC, src_x, src_y,
+ SRCPAINT);
+ } else {
+ BitBlt(destDC, dest_x, dest_y, width, height, srcDC, src_x, src_y,
+ SRCCOPY);
+ }
+
+ TkWinReleaseDrawableDC(dest, destDC, &destState);
+}
+
diff --git a/tix/win/tkConsole41.c b/tix/win/tkConsole41.c
new file mode 100644
index 00000000000..3c5ba1c13dc
--- /dev/null
+++ b/tix/win/tkConsole41.c
@@ -0,0 +1,543 @@
+/*
+ * 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.37 96/04/20 15:17:32
+ */
+
+#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;
+
+static Tcl_Interp *gStdoutInterp = NULL;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int ConsoleCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
+static void ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int InterpreterCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+static int ConsoleInput _ANSI_ARGS_((ClientData instanceData,
+ Tcl_File inFile, char *buf, int toRead,
+ int *errorCode));
+static int ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
+ Tcl_File outFile, char *buf, int toWrite,
+ int *errorCode));
+static int ConsoleClose _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp, Tcl_File inFile,
+ Tcl_File outFile));
+
+/*
+ * This structure describes the channel type structure for file based IO:
+ */
+
+static Tcl_ChannelType consoleChannelType = {
+ "console", /* Type name. */
+ NULL, /* Always non-blocking.*/
+ ConsoleClose, /* Close proc. */
+ ConsoleInput, /* Input proc. */
+ ConsoleOutput, /* Output proc. */
+ NULL, /* Seek proc. */
+ NULL, /* Set option proc. */
+ NULL, /* Get option proc. */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ Tcl_File inFile, outFile, errFile;
+
+ inFile = Tcl_GetFile((ClientData) 0, 0);
+ outFile = Tcl_GetFile((ClientData) 1, 0);
+ errFile = Tcl_GetFile((ClientData) 2, 0);
+
+ consoleChannel = Tcl_CreateChannel(&consoleChannelType, "console0",
+ inFile, NULL, (ClientData) NULL);
+ 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",
+ NULL, outFile, (ClientData) NULL);
+ 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",
+ NULL, errFile, (ClientData) NULL);
+ if (consoleChannel != NULL) {
+ Tcl_SetChannelOption(NULL, consoleChannel, "-translation", "lf");
+ Tcl_SetChannelOption(NULL, consoleChannel, "-buffering", "none");
+ }
+ Tcl_SetStdChannel(consoleChannel, TCL_STDERR);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkConsoleInit --
+ *
+ * Initialize the console. This code actually creates a new
+ * application and associated interpreter. This effectivly hides
+ * the implementation from the main application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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();
+ if (consoleInterp == NULL) {
+ goto error;
+ }
+
+ /*
+ * Initialized Tcl and Tk.
+ */
+
+ 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;
+ Tcl_CreateCommand(interp, "console", ConsoleCmd, (ClientData) info,
+ (Tcl_CmdDeleteProc *) ConsoleDeleteProc);
+ Tcl_CreateCommand(consoleInterp, "interp", InterpreterCmd,
+ (ClientData) info, (Tcl_CmdDeleteProc *) NULL);
+
+ Tk_CreateEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc,
+ (ClientData) info);
+
+ Tcl_Preserve((ClientData) consoleInterp);
+ if (Tcl_Eval(consoleInterp, initCmd) == TCL_ERROR) {
+ /* goto error; -- no problem for now... */
+ printf("Eval error: %s", consoleInterp->result);
+ }
+ Tcl_Release((ClientData) consoleInterp);
+ return TCL_OK;
+
+ error:
+ if (consoleInterp != NULL) {
+ Tcl_DeleteInterp(consoleInterp);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleOutput--
+ *
+ * Writes the given output on the IO channel. Returns count of how
+ * many characters were actually written, and an error indication.
+ *
+ * Results:
+ * A count of how many characters were written is returned and an
+ * error indication is returned in an output argument.
+ *
+ * Side effects:
+ * Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleOutput(instanceData, outFile, buf, toWrite, errorCode)
+ ClientData instanceData; /* Unused. */
+ Tcl_File outFile; /* Output device for channel. */
+ 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, outFile, buf, toWrite);
+ }
+
+ return toWrite;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleInput --
+ *
+ * Read input from the console. Not currently implemented.
+ *
+ * Results:
+ * Always returns EOF.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleInput(instanceData, inFile, buf, bufSize, errorCode)
+ ClientData instanceData; /* Unused. */
+ Tcl_File inFile; /* Input device for channel. */
+ char *buf; /* Where to store data read. */
+ int bufSize; /* How much space is available
+ * in the buffer? */
+ int *errorCode; /* Where to store error code. */
+{
+ return 0; /* Always return EOF. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleClose --
+ *
+ * Closes the IO channel.
+ *
+ * Results:
+ * Always returns 0 (success).
+ *
+ * Side effects:
+ * Frees the dummy file associated with the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleClose(instanceData, interp, inFile, outFile)
+ ClientData instanceData; /* Unused. */
+ Tcl_Interp *interp; /* Unused. */
+ Tcl_File inFile; /* Input file to close. */
+ Tcl_File outFile; /* Output file to close. */
+{
+ if (inFile) {
+ Tcl_FreeFile(inFile);
+ }
+ if (outFile && (outFile != inFile)) {
+ Tcl_FreeFile(outFile);
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleCmd --
+ *
+ * The console command implements a Tcl interface to the various console
+ * options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ 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;
+ char *wmCmd = "wm title . {";
+
+ Tcl_DStringInit(&dString);
+ Tcl_DStringAppend(&dString, wmCmd, strlen(wmCmd));
+ Tcl_DStringAppend(&dString, argv[2], strlen(argv[2]));
+ Tcl_DStringAppend(&dString, "}", strlen("}"));
+ Tcl_Eval(consoleInterp, dString.string);
+ 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 {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": should be hide, show, or title",
+ (char *) NULL);
+ result = TCL_ERROR;
+ }
+ Tcl_Release((ClientData) consoleInterp);
+ return result;
+} /* ConsoleCmd */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpreterCmd --
+ *
+ * This command allows the console interp to communicate with the
+ * main interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpreterCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+ char c;
+ int length;
+ int result;
+ Tcl_Interp *otherInterp;
+
+ 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;
+ otherInterp = info->interp;
+ 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;
+ }
+ Tcl_Release((ClientData) otherInterp);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleDeleteProc --
+ *
+ * If the console command is deleted we destroy the console window
+ * and all associated data structures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+ConsoleDeleteProc(clientData)
+ ClientData clientData;
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+
+ Tcl_DeleteInterp(info->consoleInterp);
+ info->consoleInterp = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleEventProc --
+ *
+ * This event procedure is registered on the main window of the
+ * slave interpreter. If the user or a running script causes the
+ * main window to be destroyed, then we need to inform the console
+ * interpreter by invoking "tkConsoleExit".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Invokes the "tkConsoleExit" procedure in the console interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConsoleEventProc(clientData, eventPtr)
+ ClientData clientData;
+ XEvent *eventPtr;
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+ Tcl_Interp *consoleInterp;
+
+ if (eventPtr->type == DestroyNotify) {
+ consoleInterp = info->consoleInterp;
+ Tcl_Preserve((ClientData) consoleInterp);
+ Tcl_Eval(consoleInterp, "tkConsoleExit");
+ Tcl_Release((ClientData) consoleInterp);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkConsolePrint --
+ *
+ * Prints to the give text to the console. Given the main interp
+ * this functions find the appropiate console interp and forwards
+ * the text to be added to that console.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkConsolePrint(interp, outFile, buffer, size)
+ Tcl_Interp *interp; /* Main interpreter. */
+ Tcl_File outFile; /* Should be stdout or stderr. */
+ char *buffer; /* Text buffer. */
+ long size; /* Size of text buffer. */
+{
+ Tcl_DString command, output;
+ Tcl_CmdInfo cmdInfo;
+ char *cmd;
+ ConsoleInfo *info;
+ Tcl_Interp *consoleInterp;
+ int result;
+ int fd = (int) Tcl_GetFileInfo(outFile, NULL);
+
+ if (interp == NULL) {
+ return;
+ }
+
+ if (fd == 2) {
+ cmd = "tkConsoleOutput stderr ";
+ } else {
+ cmd = "tkConsoleOutput stdout ";
+ }
+
+ result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
+ if (result == 0) {
+ return;
+ }
+ info = (ConsoleInfo *) cmdInfo.clientData;
+
+ Tcl_DStringInit(&output);
+ Tcl_DStringAppend(&output, buffer, size);
+
+ Tcl_DStringInit(&command);
+ Tcl_DStringAppend(&command, cmd, strlen(cmd));
+ Tcl_DStringAppendElement(&command, output.string);
+
+ consoleInterp = info->consoleInterp;
+ Tcl_Preserve((ClientData) consoleInterp);
+ Tcl_Eval(consoleInterp, command.string);
+ Tcl_Release((ClientData) consoleInterp);
+
+ Tcl_DStringFree(&command);
+ Tcl_DStringFree(&output);
+}
diff --git a/tix/win/tkConsole42.c b/tix/win/tkConsole42.c
new file mode 100644
index 00000000000..6f0cf840096
--- /dev/null
+++ b/tix/win/tkConsole42.c
@@ -0,0 +1,624 @@
+/*
+ * 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.43 96/08/26 19:42:51
+ */
+
+#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;
+
+static Tcl_Interp *gStdoutInterp = NULL;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int ConsoleCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
+static void ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int InterpreterCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+static int ConsoleInput _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toRead, int *errorCode));
+static int ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toWrite, int *errorCode));
+static int ConsoleClose _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp));
+static void ConsoleWatch _ANSI_ARGS_((ClientData instanceData,
+ int mask));
+static int ConsoleReady _ANSI_ARGS_((ClientData instanceData,
+ int mask));
+static Tcl_File ConsoleFile _ANSI_ARGS_((ClientData instanceData,
+ int direction));
+
+/*
+ * This structure describes the channel type structure for file based IO:
+ */
+
+static Tcl_ChannelType consoleChannelType = {
+ "console", /* Type name. */
+ NULL, /* Always non-blocking.*/
+ ConsoleClose, /* Close proc. */
+ ConsoleInput, /* Input proc. */
+ ConsoleOutput, /* Output proc. */
+ NULL, /* Seek proc. */
+ NULL, /* Set option proc. */
+ NULL, /* Get option proc. */
+ ConsoleWatch, /* Watch for events on console. */
+ ConsoleReady, /* Are events present? */
+ ConsoleFile, /* Get a Tcl_File 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 --
+ *
+ * Initialize the console. This code actually creates a new
+ * application and associated interpreter. This effectivly hides
+ * the implementation from the main application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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();
+ if (consoleInterp == NULL) {
+ goto error;
+ }
+
+ /*
+ * Initialized Tcl and Tk.
+ */
+
+ 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;
+ Tcl_CreateCommand(interp, "console", ConsoleCmd, (ClientData) info,
+ (Tcl_CmdDeleteProc *) ConsoleDeleteProc);
+ Tcl_CreateCommand(consoleInterp, "interp", InterpreterCmd,
+ (ClientData) info, (Tcl_CmdDeleteProc *) NULL);
+
+ Tk_CreateEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc,
+ (ClientData) info);
+
+ Tcl_Preserve((ClientData) consoleInterp);
+ if (Tcl_Eval(consoleInterp, initCmd) == TCL_ERROR) {
+ /* goto error; -- no problem for now... */
+ printf("Eval error: %s", consoleInterp->result);
+ }
+ Tcl_Release((ClientData) consoleInterp);
+ return TCL_OK;
+
+ error:
+ if (consoleInterp != NULL) {
+ Tcl_DeleteInterp(consoleInterp);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleOutput--
+ *
+ * Writes the given output on the IO channel. Returns count of how
+ * many characters were actually written, and an error indication.
+ *
+ * Results:
+ * A count of how many characters were written is returned and an
+ * error indication is returned in an output argument.
+ *
+ * Side effects:
+ * Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleInput --
+ *
+ * Read input from the console. Not currently implemented.
+ *
+ * Results:
+ * Always returns EOF.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleInput(instanceData, buf, bufSize, errorCode)
+ ClientData instanceData; /* Unused. */
+ char *buf; /* Where to store data read. */
+ int bufSize; /* How much space is available
+ * in the buffer? */
+ int *errorCode; /* Where to store error code. */
+{
+ return 0; /* Always return EOF. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleClose --
+ *
+ * Closes the IO channel.
+ *
+ * Results:
+ * Always returns 0 (success).
+ *
+ * Side effects:
+ * Frees the dummy file associated with the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleClose(instanceData, interp)
+ ClientData instanceData; /* Unused. */
+ Tcl_Interp *interp; /* Unused. */
+{
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleWatch --
+ *
+ * Called by the notifier to set up the console device so that
+ * events will be noticed. Since there are no events on the
+ * console, this routine just returns without doing anything.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ConsoleWatch(instanceData, mask)
+ ClientData instanceData; /* Device ID for the channel. */
+ int mask; /* OR-ed combination of
+ * TCL_READABLE, TCL_WRITABLE and
+ * TCL_EXCEPTION, for the events
+ * we are interested in. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleReady --
+ *
+ * Invoked by the notifier to notice whether any events are present
+ * on the console. Since there are no events on the console, this
+ * routine always returns zero.
+ *
+ * Results:
+ * Always 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleReady(instanceData, mask)
+ ClientData instanceData; /* Device ID for the channel. */
+ int mask; /* OR-ed combination of
+ * TCL_READABLE, TCL_WRITABLE and
+ * TCL_EXCEPTION, for the events
+ * we are interested in. */
+{
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleFile --
+ *
+ * Invoked by the generic IO layer to get a Tcl_File from a channel.
+ * Because console channels do not use Tcl_Files, this function always
+ * returns NULL.
+ *
+ * Results:
+ * Always NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static Tcl_File
+ConsoleFile(instanceData, direction)
+ ClientData instanceData; /* Device ID for the channel. */
+ int direction; /* TCL_READABLE or TCL_WRITABLE
+ * to indicate which direction of
+ * the channel is being requested. */
+{
+ return (Tcl_File) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleCmd --
+ *
+ * The console command implements a Tcl interface to the various console
+ * options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ 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;
+ char *wmCmd = "wm title . {";
+
+ Tcl_DStringInit(&dString);
+ Tcl_DStringAppend(&dString, wmCmd, strlen(wmCmd));
+ Tcl_DStringAppend(&dString, argv[2], strlen(argv[2]));
+ Tcl_DStringAppend(&dString, "}", strlen("}"));
+ Tcl_Eval(consoleInterp, dString.string);
+ 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) {
+ Tcl_Eval(info->consoleInterp, argv[2]);
+ } 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpreterCmd --
+ *
+ * This command allows the console interp to communicate with the
+ * main interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpreterCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+ char c;
+ int length;
+ int result;
+ Tcl_Interp *otherInterp;
+
+ 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;
+ otherInterp = info->interp;
+ 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;
+ }
+ Tcl_Release((ClientData) otherInterp);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleDeleteProc --
+ *
+ * If the console command is deleted we destroy the console window
+ * and all associated data structures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+ConsoleDeleteProc(clientData)
+ ClientData clientData;
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+
+ Tcl_DeleteInterp(info->consoleInterp);
+ info->consoleInterp = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleEventProc --
+ *
+ * This event procedure is registered on the main window of the
+ * slave interpreter. If the user or a running script causes the
+ * main window to be destroyed, then we need to inform the console
+ * interpreter by invoking "tkConsoleExit".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Invokes the "tkConsoleExit" procedure in the console interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConsoleEventProc(clientData, eventPtr)
+ ClientData clientData;
+ XEvent *eventPtr;
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+ Tcl_Interp *consoleInterp;
+
+ if (eventPtr->type == DestroyNotify) {
+ consoleInterp = info->consoleInterp;
+ Tcl_Preserve((ClientData) consoleInterp);
+ Tcl_Eval(consoleInterp, "tkConsoleExit");
+ Tcl_Release((ClientData) consoleInterp);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkConsolePrint --
+ *
+ * Prints to the give text to the console. Given the main interp
+ * this functions find the appropiate console interp and forwards
+ * the text to be added to that console.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkConsolePrint(interp, devId, buffer, size)
+ Tcl_Interp *interp; /* Main interpreter. */
+ int devId; /* TCL_STDOUT for stdout, TCL_STDERR for
+ * stderr. */
+ char *buffer; /* Text buffer. */
+ long size; /* Size of text buffer. */
+{
+ Tcl_DString command, output;
+ Tcl_CmdInfo cmdInfo;
+ char *cmd;
+ ConsoleInfo *info;
+ Tcl_Interp *consoleInterp;
+ int result;
+
+ if (interp == NULL) {
+ return;
+ }
+
+ if (devId == TCL_STDERR) {
+ cmd = "tkConsoleOutput stderr ";
+ } else {
+ cmd = "tkConsoleOutput stdout ";
+ }
+
+ result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
+ if (result == 0) {
+ return;
+ }
+ info = (ConsoleInfo *) cmdInfo.clientData;
+
+ Tcl_DStringInit(&output);
+ Tcl_DStringAppend(&output, buffer, size);
+
+ Tcl_DStringInit(&command);
+ Tcl_DStringAppend(&command, cmd, strlen(cmd));
+ Tcl_DStringAppendElement(&command, output.string);
+
+ consoleInterp = info->consoleInterp;
+ Tcl_Preserve((ClientData) consoleInterp);
+ Tcl_Eval(consoleInterp, command.string);
+ Tcl_Release((ClientData) consoleInterp);
+
+ Tcl_DStringFree(&command);
+ Tcl_DStringFree(&output);
+}
diff --git a/tix/win/tkConsole80a1.c b/tix/win/tkConsole80a1.c
new file mode 100644
index 00000000000..4f6d2228804
--- /dev/null
+++ b/tix/win/tkConsole80a1.c
@@ -0,0 +1,631 @@
+/*
+ * 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.46 96/10/24 15:49:44
+ */
+
+#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;
+
+static Tcl_Interp *gStdoutInterp = NULL;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int ConsoleCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
+static void ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int InterpreterCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+static int ConsoleInput _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toRead, int *errorCode));
+static int ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toWrite, int *errorCode));
+static int ConsoleClose _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp));
+static void ConsoleWatch _ANSI_ARGS_((ClientData instanceData,
+ int mask));
+static int ConsoleReady _ANSI_ARGS_((ClientData instanceData,
+ int mask));
+static Tcl_File ConsoleFile _ANSI_ARGS_((ClientData instanceData,
+ int direction));
+
+/*
+ * This structure describes the channel type structure for file based IO:
+ */
+
+static Tcl_ChannelType consoleChannelType = {
+ "console", /* Type name. */
+ NULL, /* Always non-blocking.*/
+ ConsoleClose, /* Close proc. */
+ ConsoleInput, /* Input proc. */
+ ConsoleOutput, /* Output proc. */
+ NULL, /* Seek proc. */
+ NULL, /* Set option proc. */
+ NULL, /* Get option proc. */
+ ConsoleWatch, /* Watch for events on console. */
+ ConsoleReady, /* Are events present? */
+ ConsoleFile, /* Get a Tcl_File 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 --
+ *
+ * Initialize the console. This code actually creates a new
+ * application and associated interpreter. This effectivly hides
+ * the implementation from the main application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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();
+ if (consoleInterp == NULL) {
+ goto error;
+ }
+
+ /*
+ * Initialized Tcl and Tk.
+ */
+
+ 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;
+ Tcl_CreateCommand(interp, "console", ConsoleCmd, (ClientData) info,
+ (Tcl_CmdDeleteProc *) ConsoleDeleteProc);
+ Tcl_CreateCommand(consoleInterp, "interp", InterpreterCmd,
+ (ClientData) info, (Tcl_CmdDeleteProc *) NULL);
+
+ Tk_CreateEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc,
+ (ClientData) info);
+
+ Tcl_Preserve((ClientData) consoleInterp);
+ if (Tcl_Eval(consoleInterp, initCmd) == TCL_ERROR) {
+ /* goto error; -- no problem for now... */
+ printf("Eval error: %s", consoleInterp->result);
+ }
+ Tcl_Release((ClientData) consoleInterp);
+ return TCL_OK;
+
+ error:
+ if (consoleInterp != NULL) {
+ Tcl_DeleteInterp(consoleInterp);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleOutput--
+ *
+ * Writes the given output on the IO channel. Returns count of how
+ * many characters were actually written, and an error indication.
+ *
+ * Results:
+ * A count of how many characters were written is returned and an
+ * error indication is returned in an output argument.
+ *
+ * Side effects:
+ * Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleInput --
+ *
+ * Read input from the console. Not currently implemented.
+ *
+ * Results:
+ * Always returns EOF.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleInput(instanceData, buf, bufSize, errorCode)
+ ClientData instanceData; /* Unused. */
+ char *buf; /* Where to store data read. */
+ int bufSize; /* How much space is available
+ * in the buffer? */
+ int *errorCode; /* Where to store error code. */
+{
+ return 0; /* Always return EOF. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleClose --
+ *
+ * Closes the IO channel.
+ *
+ * Results:
+ * Always returns 0 (success).
+ *
+ * Side effects:
+ * Frees the dummy file associated with the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleClose(instanceData, interp)
+ ClientData instanceData; /* Unused. */
+ Tcl_Interp *interp; /* Unused. */
+{
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleWatch --
+ *
+ * Called by the notifier to set up the console device so that
+ * events will be noticed. Since there are no events on the
+ * console, this routine just returns without doing anything.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ConsoleWatch(instanceData, mask)
+ ClientData instanceData; /* Device ID for the channel. */
+ int mask; /* OR-ed combination of
+ * TCL_READABLE, TCL_WRITABLE and
+ * TCL_EXCEPTION, for the events
+ * we are interested in. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleReady --
+ *
+ * Invoked by the notifier to notice whether any events are present
+ * on the console. Since there are no events on the console, this
+ * routine always returns zero.
+ *
+ * Results:
+ * Always 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleReady(instanceData, mask)
+ ClientData instanceData; /* Device ID for the channel. */
+ int mask; /* OR-ed combination of
+ * TCL_READABLE, TCL_WRITABLE and
+ * TCL_EXCEPTION, for the events
+ * we are interested in. */
+{
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleFile --
+ *
+ * Invoked by the generic IO layer to get a Tcl_File from a channel.
+ * Because console channels do not use Tcl_Files, this function always
+ * returns NULL.
+ *
+ * Results:
+ * Always NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static Tcl_File
+ConsoleFile(instanceData, direction)
+ ClientData instanceData; /* Device ID for the channel. */
+ int direction; /* TCL_READABLE or TCL_WRITABLE
+ * to indicate which direction of
+ * the channel is being requested. */
+{
+ return (Tcl_File) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleCmd --
+ *
+ * The console command implements a Tcl interface to the various console
+ * options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ 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;
+ char *wmCmd = "wm title . {";
+
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpreterCmd --
+ *
+ * This command allows the console interp to communicate with the
+ * main interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpreterCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+ char c;
+ int length;
+ int result;
+ Tcl_Interp *otherInterp;
+
+ 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;
+ otherInterp = info->interp;
+ 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;
+ }
+ Tcl_Release((ClientData) otherInterp);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleDeleteProc --
+ *
+ * If the console command is deleted we destroy the console window
+ * and all associated data structures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+ConsoleDeleteProc(clientData)
+ ClientData clientData;
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+
+ Tcl_DeleteInterp(info->consoleInterp);
+ info->consoleInterp = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleEventProc --
+ *
+ * This event procedure is registered on the main window of the
+ * slave interpreter. If the user or a running script causes the
+ * main window to be destroyed, then we need to inform the console
+ * interpreter by invoking "tkConsoleExit".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Invokes the "tkConsoleExit" procedure in the console interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConsoleEventProc(clientData, eventPtr)
+ ClientData clientData;
+ XEvent *eventPtr;
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+ Tcl_Interp *consoleInterp;
+
+ if (eventPtr->type == DestroyNotify) {
+ consoleInterp = info->consoleInterp;
+ Tcl_Preserve((ClientData) consoleInterp);
+ Tcl_Eval(consoleInterp, "tkConsoleExit");
+ Tcl_Release((ClientData) consoleInterp);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkConsolePrint --
+ *
+ * Prints to the give text to the console. Given the main interp
+ * this functions find the appropiate console interp and forwards
+ * the text to be added to that console.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkConsolePrint(interp, devId, buffer, size)
+ Tcl_Interp *interp; /* Main interpreter. */
+ int devId; /* TCL_STDOUT for stdout, TCL_STDERR for
+ * stderr. */
+ char *buffer; /* Text buffer. */
+ long size; /* Size of text buffer. */
+{
+ Tcl_DString command, output;
+ Tcl_CmdInfo cmdInfo;
+ char *cmd;
+ ConsoleInfo *info;
+ Tcl_Interp *consoleInterp;
+ int result;
+
+ if (interp == NULL) {
+ return;
+ }
+
+ if (devId == TCL_STDERR) {
+ cmd = "tkConsoleOutput stderr ";
+ } else {
+ cmd = "tkConsoleOutput stdout ";
+ }
+
+ result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
+ if (result == 0) {
+ return;
+ }
+ info = (ConsoleInfo *) cmdInfo.clientData;
+
+ Tcl_DStringInit(&output);
+ Tcl_DStringAppend(&output, buffer, size);
+
+ Tcl_DStringInit(&command);
+ Tcl_DStringAppend(&command, cmd, strlen(cmd));
+ Tcl_DStringAppendElement(&command, output.string);
+
+ consoleInterp = info->consoleInterp;
+ Tcl_Preserve((ClientData) consoleInterp);
+ Tcl_Eval(consoleInterp, command.string);
+ Tcl_Release((ClientData) consoleInterp);
+
+ Tcl_DStringFree(&command);
+ Tcl_DStringFree(&output);
+}
diff --git a/tix/win/tkConsole80b1.c b/tix/win/tkConsole80b1.c
new file mode 100644
index 00000000000..217c23872ff
--- /dev/null
+++ b/tix/win/tkConsole80b1.c
@@ -0,0 +1,611 @@
+/*
+ * 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.51 97/04/25 16:52:39
+ */
+
+#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;
+
+static Tcl_Interp *gStdoutInterp = NULL;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int ConsoleCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
+static void ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int InterpreterCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+static int ConsoleInput _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toRead, int *errorCode));
+static int ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toWrite, int *errorCode));
+static int ConsoleClose _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp));
+static void ConsoleWatch _ANSI_ARGS_((ClientData instanceData,
+ int mask));
+static int ConsoleHandle _ANSI_ARGS_((ClientData instanceData,
+ int direction, ClientData *handlePtr));
+
+
+void TkConsolePrint (Tcl_Interp *interp, int devId, char *buffer, long size); /* Size of text buffer. */
+
+/*
+ * This structure describes the channel type structure for file based IO:
+ */
+
+static Tcl_ChannelType consoleChannelType = {
+ "console", /* Type name. */
+ NULL, /* Always non-blocking.*/
+ ConsoleClose, /* Close proc. */
+ ConsoleInput, /* Input proc. */
+ ConsoleOutput, /* Output proc. */
+ NULL, /* Seek proc. */
+ NULL, /* Set option proc. */
+ NULL, /* Get option proc. */
+ 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 --
+ *
+ * Initialize the console. This code actually creates a new
+ * application and associated interpreter. This effectivly hides
+ * the implementation from the main application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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();
+ if (consoleInterp == NULL) {
+ goto error;
+ }
+
+ /*
+ * Initialized Tcl and Tk.
+ */
+
+ 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;
+ Tcl_CreateCommand(interp, "console", ConsoleCmd, (ClientData) info,
+ (Tcl_CmdDeleteProc *) ConsoleDeleteProc);
+ Tcl_CreateCommand(consoleInterp, "consoleinterp", InterpreterCmd,
+ (ClientData) info, (Tcl_CmdDeleteProc *) NULL);
+
+ Tk_CreateEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc,
+ (ClientData) info);
+
+ Tcl_Preserve((ClientData) consoleInterp);
+ if (Tcl_Eval(consoleInterp, initCmd) == TCL_ERROR) {
+ /* goto error; -- no problem for now... */
+ printf("Eval error: %s", consoleInterp->result);
+ }
+ Tcl_Release((ClientData) consoleInterp);
+ return TCL_OK;
+
+ error:
+ if (consoleInterp != NULL) {
+ Tcl_DeleteInterp(consoleInterp);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleOutput--
+ *
+ * Writes the given output on the IO channel. Returns count of how
+ * many characters were actually written, and an error indication.
+ *
+ * Results:
+ * A count of how many characters were written is returned and an
+ * error indication is returned in an output argument.
+ *
+ * Side effects:
+ * Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleInput --
+ *
+ * Read input from the console. Not currently implemented.
+ *
+ * Results:
+ * Always returns EOF.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleInput(instanceData, buf, bufSize, errorCode)
+ ClientData instanceData; /* Unused. */
+ char *buf; /* Where to store data read. */
+ int bufSize; /* How much space is available
+ * in the buffer? */
+ int *errorCode; /* Where to store error code. */
+{
+ return 0; /* Always return EOF. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleClose --
+ *
+ * Closes the IO channel.
+ *
+ * Results:
+ * Always returns 0 (success).
+ *
+ * Side effects:
+ * Frees the dummy file associated with the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleClose(instanceData, interp)
+ ClientData instanceData; /* Unused. */
+ Tcl_Interp *interp; /* Unused. */
+{
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleWatch --
+ *
+ * Called by the notifier to set up the console device so that
+ * events will be noticed. Since there are no events on the
+ * console, this routine just returns without doing anything.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ConsoleWatch(instanceData, mask)
+ ClientData instanceData; /* Device ID for the channel. */
+ int mask; /* OR-ed combination of
+ * TCL_READABLE, TCL_WRITABLE and
+ * TCL_EXCEPTION, for the events
+ * we are interested in. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleHandle --
+ *
+ * Invoked by the generic IO layer to get a handle from a channel.
+ * Because console channels are not devices, this function always
+ * fails.
+ *
+ * Results:
+ * Always returns TCL_ERROR.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleHandle(instanceData, direction, handlePtr)
+ ClientData instanceData; /* Device ID for the channel. */
+ int direction; /* TCL_READABLE or TCL_WRITABLE to indicate
+ * which direction of the channel is being
+ * requested. */
+ ClientData *handlePtr; /* Where to store handle */
+{
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleCmd --
+ *
+ * The console command implements a Tcl interface to the various console
+ * options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpreterCmd --
+ *
+ * This command allows the console interp to communicate with the
+ * main interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpreterCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+ char c;
+ int length;
+ int result;
+ Tcl_Interp *otherInterp;
+
+ 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]);
+ otherInterp = info->interp;
+ 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;
+ }
+ Tcl_Release((ClientData) otherInterp);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleDeleteProc --
+ *
+ * If the console command is deleted we destroy the console window
+ * and all associated data structures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+ConsoleDeleteProc(clientData)
+ ClientData clientData;
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+
+ Tcl_DeleteInterp(info->consoleInterp);
+ info->consoleInterp = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleEventProc --
+ *
+ * This event procedure is registered on the main window of the
+ * slave interpreter. If the user or a running script causes the
+ * main window to be destroyed, then we need to inform the console
+ * interpreter by invoking "tkConsoleExit".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Invokes the "tkConsoleExit" procedure in the console interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkConsolePrint --
+ *
+ * Prints to the give text to the console. Given the main interp
+ * this functions find the appropiate console interp and forwards
+ * the text to be added to that console.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkConsolePrint(interp, devId, buffer, size)
+ Tcl_Interp *interp; /* Main interpreter. */
+ int devId; /* TCL_STDOUT for stdout, TCL_STDERR for
+ * stderr. */
+ char *buffer; /* Text buffer. */
+ long size; /* Size of text buffer. */
+{
+ Tcl_DString command, output;
+ Tcl_CmdInfo cmdInfo;
+ char *cmd;
+ ConsoleInfo *info;
+ Tcl_Interp *consoleInterp;
+ int result;
+
+ if (interp == NULL) {
+ return;
+ }
+
+ if (devId == TCL_STDERR) {
+ cmd = "tkConsoleOutput stderr ";
+ } else {
+ cmd = "tkConsoleOutput stdout ";
+ }
+
+ result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
+ if (result == 0) {
+ return;
+ }
+ info = (ConsoleInfo *) cmdInfo.clientData;
+
+ Tcl_DStringInit(&output);
+ Tcl_DStringAppend(&output, buffer, size);
+
+ Tcl_DStringInit(&command);
+ Tcl_DStringAppend(&command, cmd, strlen(cmd));
+ Tcl_DStringAppendElement(&command, output.string);
+
+ consoleInterp = info->consoleInterp;
+ Tcl_Preserve((ClientData) consoleInterp);
+ Tcl_Eval(consoleInterp, command.string);
+ Tcl_Release((ClientData) consoleInterp);
+
+ Tcl_DStringFree(&command);
+ Tcl_DStringFree(&output);
+}
diff --git a/tix/win/tkConsole81.c b/tix/win/tkConsole81.c
new file mode 100644
index 00000000000..c25a14f1501
--- /dev/null
+++ b/tix/win/tkConsole81.c
@@ -0,0 +1,613 @@
+/*
+ * 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.51 97/04/25 16:52:39
+ */
+
+#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;
+
+static Tcl_Interp *gStdoutInterp = NULL;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int ConsoleCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void ConsoleDeleteProc _ANSI_ARGS_((ClientData clientData));
+static void ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int InterpreterCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+static int ConsoleInput _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toRead, int *errorCode));
+static int ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toWrite, int *errorCode));
+static int ConsoleClose _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp));
+static void ConsoleWatch _ANSI_ARGS_((ClientData instanceData,
+ int mask));
+static int ConsoleHandle _ANSI_ARGS_((ClientData instanceData,
+ int direction, ClientData *handlePtr));
+
+
+void TkConsolePrint (Tcl_Interp *interp, int devId, char *buffer, long size); /* Size of text buffer. */
+
+/*
+ * This structure describes the channel type structure for file based IO:
+ */
+
+static Tcl_ChannelType consoleChannelType = {
+ "console", /* Type name. */
+ NULL, /* Always non-blocking.*/
+ ConsoleClose, /* Close proc. */
+ ConsoleInput, /* Input proc. */
+ ConsoleOutput, /* Output proc. */
+ NULL, /* Seek proc. */
+ NULL, /* Set option proc. */
+ NULL, /* Get option proc. */
+ 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;
+
+ TclInitSubsystems(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_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 --
+ *
+ * Initialize the console. This code actually creates a new
+ * application and associated interpreter. This effectivly hides
+ * the implementation from the main application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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();
+ if (consoleInterp == NULL) {
+ goto error;
+ }
+
+ /*
+ * Initialized Tcl and Tk.
+ */
+
+ 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;
+ Tcl_CreateCommand(interp, "console", ConsoleCmd, (ClientData) info,
+ (Tcl_CmdDeleteProc *) ConsoleDeleteProc);
+ Tcl_CreateCommand(consoleInterp, "consoleinterp", InterpreterCmd,
+ (ClientData) info, (Tcl_CmdDeleteProc *) NULL);
+
+ Tk_CreateEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc,
+ (ClientData) info);
+
+ Tcl_Preserve((ClientData) consoleInterp);
+ if (Tcl_Eval(consoleInterp, initCmd) == TCL_ERROR) {
+ /* goto error; -- no problem for now... */
+ printf("Eval error: %s", consoleInterp->result);
+ }
+ Tcl_Release((ClientData) consoleInterp);
+ return TCL_OK;
+
+ error:
+ if (consoleInterp != NULL) {
+ Tcl_DeleteInterp(consoleInterp);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleOutput--
+ *
+ * Writes the given output on the IO channel. Returns count of how
+ * many characters were actually written, and an error indication.
+ *
+ * Results:
+ * A count of how many characters were written is returned and an
+ * error indication is returned in an output argument.
+ *
+ * Side effects:
+ * Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleInput --
+ *
+ * Read input from the console. Not currently implemented.
+ *
+ * Results:
+ * Always returns EOF.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleInput(instanceData, buf, bufSize, errorCode)
+ ClientData instanceData; /* Unused. */
+ char *buf; /* Where to store data read. */
+ int bufSize; /* How much space is available
+ * in the buffer? */
+ int *errorCode; /* Where to store error code. */
+{
+ return 0; /* Always return EOF. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleClose --
+ *
+ * Closes the IO channel.
+ *
+ * Results:
+ * Always returns 0 (success).
+ *
+ * Side effects:
+ * Frees the dummy file associated with the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleClose(instanceData, interp)
+ ClientData instanceData; /* Unused. */
+ Tcl_Interp *interp; /* Unused. */
+{
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleWatch --
+ *
+ * Called by the notifier to set up the console device so that
+ * events will be noticed. Since there are no events on the
+ * console, this routine just returns without doing anything.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ConsoleWatch(instanceData, mask)
+ ClientData instanceData; /* Device ID for the channel. */
+ int mask; /* OR-ed combination of
+ * TCL_READABLE, TCL_WRITABLE and
+ * TCL_EXCEPTION, for the events
+ * we are interested in. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleHandle --
+ *
+ * Invoked by the generic IO layer to get a handle from a channel.
+ * Because console channels are not devices, this function always
+ * fails.
+ *
+ * Results:
+ * Always returns TCL_ERROR.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleHandle(instanceData, direction, handlePtr)
+ ClientData instanceData; /* Device ID for the channel. */
+ int direction; /* TCL_READABLE or TCL_WRITABLE to indicate
+ * which direction of the channel is being
+ * requested. */
+ ClientData *handlePtr; /* Where to store handle */
+{
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleCmd --
+ *
+ * The console command implements a Tcl interface to the various console
+ * options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpreterCmd --
+ *
+ * This command allows the console interp to communicate with the
+ * main interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpreterCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+ char c;
+ int length;
+ int result;
+ Tcl_Interp *otherInterp;
+
+ 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]);
+ otherInterp = info->interp;
+ 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;
+ }
+ Tcl_Release((ClientData) otherInterp);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleDeleteProc --
+ *
+ * If the console command is deleted we destroy the console window
+ * and all associated data structures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+ConsoleDeleteProc(clientData)
+ ClientData clientData;
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+
+ Tcl_DeleteInterp(info->consoleInterp);
+ info->consoleInterp = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleEventProc --
+ *
+ * This event procedure is registered on the main window of the
+ * slave interpreter. If the user or a running script causes the
+ * main window to be destroyed, then we need to inform the console
+ * interpreter by invoking "tkConsoleExit".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Invokes the "tkConsoleExit" procedure in the console interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkConsolePrint --
+ *
+ * Prints to the give text to the console. Given the main interp
+ * this functions find the appropiate console interp and forwards
+ * the text to be added to that console.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkConsolePrint(interp, devId, buffer, size)
+ Tcl_Interp *interp; /* Main interpreter. */
+ int devId; /* TCL_STDOUT for stdout, TCL_STDERR for
+ * stderr. */
+ char *buffer; /* Text buffer. */
+ long size; /* Size of text buffer. */
+{
+ Tcl_DString command, output;
+ Tcl_CmdInfo cmdInfo;
+ char *cmd;
+ ConsoleInfo *info;
+ Tcl_Interp *consoleInterp;
+ int result;
+
+ if (interp == NULL) {
+ return;
+ }
+
+ if (devId == TCL_STDERR) {
+ cmd = "tkConsoleOutput stderr ";
+ } else {
+ cmd = "tkConsoleOutput stdout ";
+ }
+
+ result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
+ if (result == 0) {
+ return;
+ }
+ info = (ConsoleInfo *) cmdInfo.clientData;
+
+ Tcl_DStringInit(&output);
+ Tcl_DStringAppend(&output, buffer, size);
+
+ Tcl_DStringInit(&command);
+ Tcl_DStringAppend(&command, cmd, strlen(cmd));
+ Tcl_DStringAppendElement(&command, output.string);
+
+ consoleInterp = info->consoleInterp;
+ Tcl_Preserve((ClientData) consoleInterp);
+ Tcl_Eval(consoleInterp, command.string);
+ Tcl_Release((ClientData) consoleInterp);
+
+ Tcl_DStringFree(&command);
+ Tcl_DStringFree(&output);
+}
diff --git a/tk/ChangeLog b/tk/ChangeLog
new file mode 100644
index 00000000000..8fc363a4cb8
--- /dev/null
+++ b/tk/ChangeLog
@@ -0,0 +1,886 @@
+2000-01-26 DJ Delorie <dj@cygnus.com>
+
+ * win/tkWin32Dll.c (DllMain): Use _imp__ instead of __imp_
+
+1999-03-02 James Ingham <jingham@cygnus.com>
+
+ Copying over irox's 3D changes from Tk8.1 for a more Win95 look.
+ The button changes don't seem to work, so I will leave them out
+ for now.
+
+ * win/tkWin3d.c (Tk_3DVerticalBevel, Tk_3DHorizontalBevel): The
+ dark pixels are drawn inside the bevel, not outside.
+
+Fri Feb 26 17:40:55 1999 Geoffrey Noer <noer@cygnus.com>
+
+ * win/configure.in: change "cygwin32*" to "cygwin*"
+ * win/configure: Regenerated.
+ * configure.in: Change "cygwin32*" to "cygwin*"
+ * configure: Regenerate.
+
+1999-02-11 Syd Polk <spolk@cygnus.com>
+
+ * unix/configure.in: Forgot to AC_SUBST TK_LIB_FULL_PATH.
+ * unix/configure: Regenerate.
+
+1999-02-10 Syd Polk <spolk@cygnus.com>
+
+ * unix/configure.in unix/tkConfig.sh.in: Export TK_LIB_FULL_PATH.
+ * unix/configure: Regenerate.
+
+1999-01-29 James Ingham <jingham@cygnus.com>
+
+ * win/configure.in: Fill in the XINCLUDE symbol.
+ * win/configure: regenerate.
+
+Mon Jan 11 10:57:05 1999 Jim Ingham <jingham@cygnus.com>
+
+ * win/tkTextDisp.c (tkTextSeeCmd): This is only a workaround for
+ a bug somewhere in Tk. If you change the font for the gdbtk
+ debug window the see command that follows the report of the
+ destruction of the preferences window will return a NULL from
+ FindDLine. This should not happen, but I can't find a simple
+ case that shows the behavior, and have not taken the time to
+ chase it all the way down. This fix makes the error harmless.
+
+Thu Dec 17 10:43:53 1998 Jim Ingham <jingham@cygnus.com>
+
+ * win/tkWinFont.c (Tk_MeasureChar): Add dummy max argument and
+ bogus (infinte) maxLength to second call to
+ GetTextExtentExPoint to work around a bug in NT/J 4.0 service
+ pack 3 or less.
+
+Thu Dec 3 12:34:18 1998 Jim Ingham jingham@cygnus.com
+
+ * library/tkfbox.tcl (tkIconListInvoke): Fixed a merge goof
+ that was preventing double-clicking in the file dialog from
+ working.
+
+Tue Nov 24 18:27:40 1998 Jim Ingham jingham@cygnus.com
+
+ * Import of Tk 8.0.4 from Scriptics.
+
+Thu Aug 20 14:32:59 1998 Jim Ingham jingham@cygnus.com
+
+ * Import of Tk 8.0.3 from Scriptics, with our modifications.
+
+Thu Aug 20 18:14:43 1998 Khamis Abuelkomboz <khamis@cygnus.com>
+
+ * win/tkWinDialog.c: Enlarged the file dialog buffer to include more
+ files that the magic (14 files) limit.
+
+Wed Aug 12 18:24:45 1998 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/Makefile.in (TK_CFLAGS): Remove $(include32).
+
+Fri Jul 31 14:37:29 1998 Ian Roxborough <irox@cygnus.com>
+
+ * win/Makefile.in: add tkTextCharType symbol to tkcyg.def require by SN.
+
+Mon Jul 22 15:44:19 1998 Ian Roxborough <irox@cygnus.com>
+
+ * win/Makefile.in: add some symbols to tkcyg.def require by SN.
+
+Mon Jul 13 14:12:39 1998 Jeff Holcomb <jeffh@cygnus.com>
+
+ * win/tkWinX.c: Removed temporary define for MNC_CLOSE.
+
+Mon Jul 6 18:13:02 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * win/Makefile.in: Remove bad line with just "mv" on it.
+
+Mon Jul 6 15:53:35 1998 Ian Roxborough <irox@cygnus.com>
+ * win/Makefile.in: Don't set lflags or lcommon if you're not
+ setting OBJEXT to 'obj', (i.e. for MSVC).
+
+Sat Jul 4 16:21:25 1998 Ian Roxborough <irox@cygnus.com>
+ * win/Makefile.in: Don't make dumpext.exe unless you're using MSVC
+ and setting OBJEXT = obj.
+
+1998-07-03 Ben Elliston <bje@cygnus.com>
+
+ Patches from Ian Roxborough <irox@cygnus.com>.
+ * win/configure.in: Add AC_OBJEXT macro invocation.
+
+ * win/configure: Regenerate.
+
+ * win/Makefile.in: Don't assume object files end in `.o'.
+
+Wed Jul 1 00:11:02 1998 Khamis Abuelkomboz <khamis@cygnus.com>
+
+ * unix/tkUnixDefault.h (DEF_TEXT_TAB_SIZE): new macro to define
+ the default tab size "8".
+
+ * win/tkWinDefault.h (DEF_TEXT_TAB_SIZE): new macro to define the
+ default tab size "8".
+
+ * mac/tkMacDefault.h (DEF_TEXT_TAB_SIZE): new macro to define the
+ default tab size "8".
+
+ * generic/tkTextDisp.c (NextTabStop): Added the text widget pointer
+ as an argument for this function to read the set tab-width for
+ the default tabulator behavior. Default is 8.
+
+ * generic/tkText.c: (configSpecs) Added "-tabsize" to the option
+ command list of the text widget. It defines the width of the
+ default tabulator, default 8.
+
+ * generic/tkText.h: added a new structur member to TkText "tabsize",
+ it stores the tab width (default 8). "-tabs" doesn't support
+ normal text tabulator behaviar, so we can't use it in SN.
+
+Thu Jun 18 10:27:00 1998 Syd Polk <spolk@cygnus.com>
+
+ * Removed all of the files in Tk 8.1a2 not in Tk 8.0p2. They
+ were added when the import was done.
+
+Fri Jun 12 11:48:26 1998 Mumit Khan <khan@xraylith.wisc.edu>
+
+ * configure.in (*-*-mingw32*): Support.
+ * win/Makefile.in (DLL_LDLIBS, DLL_LDFLAGS): New variables.
+ (tkcyg.def): Ignore errors.
+ (plugin.def): Likewise.
+ ($(TKDLL),$(TKPLUGINDLL)): Cleanup DLL build flags and use
+ DLL_LDLIBS and DLL_LDFLAGS.
+ * win/configure.in (DLL_LDLIBS, DLL_LDFLAGS): Define and substitute.
+ (TK_PATCH_LEVEL): Bump to p2.
+ * win/tkWinPort.h (TK_READ_DATA_PENDING): Define for Mingw32.
+ (timezone,timeval,gettimeofday): Don't define/declare for Mingw32.
+ * win/tkWinX.c (GetCurrentTime): Define as GetTickCount if
+ __MINGW32__ as well.
+ * win/configure: Rebuild.
+
+Fri May 29 17:12:29 1998 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/Makefile.in (X11_INCLUDE_INSTALL_DIR): New variable.
+ (install-libraries): Install X11 header files in
+ X11_INCLUDE_INSTALL_DIR.
+ (install-minimal): Don't create INCLUDE_INSTALL_DIR.
+ * win/configure.in: Call AC_CANONICAL_HOST.
+ * win/configure: Rebuild.
+
+Wed May 27 17:00:35 1998 Ian Lance Taylor <ian@cygnus.com>
+
+ * library/tkfbox.tcl (tkFDialog): Save the old multiple setting,
+ and recreate the dialog if it changes.
+
+Thu Apr 30 18:10:15 1998 Geoffrey Noer <noer@cygnus.com>
+
+ * win/Makefile.in: invoke gcc instead of ld when producing
+ dlls. Pass the linker options down via args to -Wl options.
+
+Sun Apr 26 15:45:18 1998 Khamis Abuelkomboz <khamis@mxbig.multix.de>
+
+ * generic/tkCanvBmap.c (tkCreateBitmap): renamed from "CreateBitmap"
+ to avoid conflicts with the already defined MSVC procedure.
+
+Thu Apr 23 10:09:29 1998 Tom Tromey <tromey@cygnus.com>
+
+ * library/tkfbox.tcl (tkFDialog_Config): Use lindex, not join, to
+ extract list item.
+ (tkFDialog_Config): Recognize -choosedir option.
+ (tkFDialog_OkCmd): If -choosedir set, then don't special-case
+ directories.
+ (tkFDialog_VerifyFileName): Handle -choosedir.
+ (tkFDialog_ListBrowse): Likewise.
+
+Thu Apr 16 17:30:46 1998 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/tkWinButton.c (WinButton): Add pixFlags field.
+ (TkpCreateButton): Initialize new pixFlags field.
+ (TkpDestroyButton): Clear pixmap field if we free the pixmap.
+ (TkpRealDisplayButton): Don't free the pixmap just because we're
+ unmapping the window. Check pixFlags field to see if we can use
+ the cached pixmap. Set pixFlag field if we cache the pixmap.
+ * generic/tkButton.c (TkButtonWorldChanged): Remove Cygnus local
+ patch; once again check whether the button is mapped before
+ scheduling a call to TkpDisplayButton.
+ (ButtonVarProc): Likewise.
+
+Thu Apr 16 15:59:55 MEST 1998 Khamis Abuelkomboz <khamis@multix.de>
+ * library/tkfbox.tcl
+ -One COMMENT: I have never seen so bad tcl/source code as how this
+ stuped tk/filedialog is implemented!!!!!!!!!!!!!
+
+ (tkIconList_Select): Include the fact that by multi-selection a file
+ could contain blanks, so that the file is added as a list
+ element.
+ (tkFDialog): When the dialog is not new created (withdrawn) don't
+ center it again
+ -Define Tracer before calling the dialog and immediatly remove
+ it after selection.
+ -tk dialog box doesn't use dynamic array names, so it's
+ not possible to use more than one dialog box at the same
+ time. Other dialogs must be deleted!
+ (tkFDialog_SetPath): Accept the fact that the variable could be bound
+ on a already deleted widget (trace).
+ -No tracer here.
+ (tkFDialog_Config): "glob" command returns a list of items, so we must
+ join the result, this was bugy when a file has contained blanks.
+ (tkFDialog_ActivateEnt): We can't trim a list.
+ (tkFDialog_OkCmd): Join file name only by single selection.
+ (tkFDialog_ListInvoke): Differ between single and multi selection by
+ joining files.
+ -return a list of files by multi-selection and the file itself
+ by single-selection.
+
+Tue Apr 14 15:01:10 1998 Ian Lance Taylor <ian@cygnus.com>
+
+ * generic/tkText.c (TextBlinkProc): Remove test of TkTextCharBbox,
+ since it is a difference from standard releases, and it will never
+ change what happens.
+
+Mon Apr 13 17:55:13 1998 Ian Lance Taylor <ian@cygnus.com>
+
+ * compat/memmove.c: Remove.
+
+Thu Apr 9 15:00:47 1998 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/msgbox.tcl (tkMessageBox): When a default button
+ is supplied, simply set the focus on it, don't bind <Return>.
+ For all buttons, bind <Return> for them so the button command
+ is invoked.
+
+Tue Apr 7 20:32:40 1998 Ian Lance Taylor <ian@cygnus.com>
+
+ * tests/msgbox.test: Update unknown option message for -modal
+ option.
+
+Fri Mar 27 15:18:30 1998 Jeff Holcomb <jeffh@cygnus.com>
+
+ * win/tkWinX.c: Added temporary define for MNC_CLOSE.
+
+Wed Mar 11 13:48:31 1998 Tom Tromey <tromey@cygnus.com>
+
+ * library/entry.tcl: Only bind <Insert> when not on Windows.
+
+Sat Mar 21 21:18:06 1998 Elena Zannoni <ezannoni@kwikemart.cygnus.com>
+
+ Merged changes from Foundry (list follows in reverse chronological order)
+
+ - Tom Tromey <tromey@cygnus.com>
+ * win/tkWinWm.c (InitWm): Look for "tk" icon first in
+ application's resources and then in Tk DLL's.
+ * generic/tkButton.c (TkButtonWorldChanged): Don't check to see if
+ button is unmapped before scheduling a redraw.
+ * win/tkWinWm.c (Tk_WmCmd): In "frame" case, make window exist if
+ it doesn't already.
+ * generic/tkButton.c (ButtonVarProc): Don't check to see if button
+ is unmapped before scheduling a redraw.
+ * win/tkWinButton.c (TkpRealDisplayButton): Destroy backing pixmap
+ if window is unmapped.
+ * win/tkWinWm.c (EX_TRANSIENT_STYLE): Define as 0.
+ * win/tkWinX.c (Tk_TranslateWinEvent): Handle WM_MENUCHAR.
+ (GenerateXEvent): Likewise.
+ * win/tkWinWm.c (UpdateWrapper): Turn off maximize box and sizebox
+ for non-resizable windows.
+ * win/tkWinDialog.c (Tk_MessageBoxCmd): Don't pass
+ MB_SETFOREGROUND for "-modal system".
+
+ - Ian Lance Taylor <ian@cygnus.com>
+ * win/Makefile.in ($(TKDLL)): Don't generate relocs for debugging
+ information.
+ * win/tkWinFont.c (Tk_MeasureChars): Free the partials array.
+ * win/tkWinFont.c (Tk_MeasureChars): Rearrange to always use sizes
+ from partials array, rather than size.cx.
+
+ - Tom Tromey <tromey@cygnus.com>
+ * win/tkWinMenu.c (TkWinHandleMenuEvent): Don't use height element
+ of indicatorDimensions when computing width.
+ * win/tkWinDialog.c: Reverted previous change. It turns out that
+ with the change, if the user selects too many files, the list will
+ be truncated in the middle but no error message will be returned.
+ This makes it impossible to detect failures.
+ * win/tkWinDialog.c (ParseFileDlgArgs): If -multiple passed, don't
+ require files to exist. This is a hack to work around a bug in
+ the common dialog.
+ (CYG_MAX_PATH): New define.
+ (_OpenFileData): Use CYG_MAX_PATH.
+ (GetFileName): Likewise.
+ * generic/tkTextDisp.c (DisplayDLine): Display cursor for disabled
+ widgets on Windows.
+
+ - Ian Lance Taylor <ian@cygnus.com>
+ * win/tkWinFont.c (WinFont): Remove widths field.
+ (Tk_MeasureChars): Rewrite to use GetTextExtentExPoint, and not
+ assume that Windows doesn't do kerning, since in reality it does
+ do kerning.
+ (AllocFont): Don't initialize widths field.
+
+ - Tom Tromey <tromey@cygnus.com>
+ * library/text.tcl (tkTextButton1): Unconditionally set the
+ focus.
+
+ - Ian Lance Taylor <ian@cygnus.com>
+ * win/tkWinDialog.c (Tk_MessageBoxCmd): If -modal system, pass
+ MB_SETFOREGROUND. May or may not be useless.
+ * generic/tkFocus.c (SetFocus): If force, then don't just return
+ even if the desired window is already the focus window.
+ * win/tkWinPointer.c (TkpChangeFocus): Call XSetInputFocus even if
+ force.
+ * win/tkWinWm.c (EX_TRANSIENT_STYLE): Remove WS_EX_TOOLWINDOW.
+
+Mon Jan 12 15:45:03 1997 Syd Polk <spolk@cygnus.com>
+
+ * library/tkfbox.tcl (tk_getOpenFile): tk_getOpenFile would complain
+ and behave incorrectly if the -initialdir argument had a space
+ in it.
+
+Wed Dec 31 12:27:25 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/Makefile.in (install-libraries): Install the X11 header
+ files as well as tk.h.
+
+Tue Dec 23 16:31:07 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/Makefile.in ($(TKDLL)): Don't generate relocs for debugging
+ information.
+
+Mon Nov 17 18:07:12 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/tkWinButton.c (TkpCreateButton): Initialize pixmap field.
+ (TkpDestroyButton): Free pixmap field.
+ (TkpDisplayButton): Entire function moved into
+ TkpRealDisplayButton.
+ (TkpRealDisplayButton): New static function, from old
+ TkpDisplayButton.
+ (TkpComputeButtonGeometry): Discard any saved pixmap.
+ (ButtonProc): Call TkpRealDisplayButton, not TkpDisplayButton.
+
+Fri Nov 14 12:24:04 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/tkWinMenu.c (TkpDestroyMenu): Remove the menu handle from
+ winMenuTable. Clear modalMenuPtr if we're destroying it.
+ (TkWinHandleMenuEvent): Don't treat WM_SYSCOMMAND like
+ WM_COMMAND.
+
+ * win/tkWinDialog.c (Tk_MessageBoxCmd): If -modal task, and
+ -parent not used, pass hWnd as NULL to MessageBox.
+
+Tue Nov 11 20:07:04 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/tkWinMenu.c (TkWinHandleMenuEvent): If TkPreprocessMenu
+ returns an error, call Tcl_BackgroundError.
+
+Fri Nov 7 15:52:23 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/tkWinDialog.c (Tk_MessageBoxCmd): Accept -modal option.
+ * library/msgbox.tcl (tkMessageBox): Accept and ignore -modal
+ option.
+
+Tue Oct 28 17:51:06 1997 Martin M. Hunt <hunt@cygnus.com>
+
+ * generic/tkText.c: Patch text.txt from the net. Fixes
+ Win95 selection bug.
+
+ * library/dialog.tcl (tk_dialog): Two fixes from the net for
+ Windows 95 dialogs. Patch "dialog.txt" from "Robert Embleton"
+ <embleton@crystal.cirrus.com>
+
+Tue Oct 28 16:36:11 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (install-minimal): New target.
+ * win/Makefile.in (install-minimal): New target.
+
+Thu Oct 23 12:59:18 1997 Tom Tromey <tromey@cygnus.com>
+
+ * generic/tkScale.c (ConfigureScale): When setting scale value,
+ don't cause scale to invoke command.
+
+Fri Oct 10 19:41:57 1997 Tom Tromey <tromey@cygnus.com>
+
+ * xlib/X11/Xlib.h: On Windows, use a typdef for Status.
+
+ * win/tkWinPort.h: Declare struct timeval.
+
+Wed Oct 8 18:33:41 1997 Jeffrey A Law (law@cygnus.com)
+
+ * generic/tkText.c: Avoid ANSI-C code.
+
+Tue Oct 7 10:32:01 1997 Tom Tromey <tromey@cygnus.com>
+
+ * library/button.tcl: Bind <Return> to invoke buttons on Windows.
+
+Thu Oct 2 17:05:14 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * generic/tkColor.c (struct TkGCList): Define.
+ (Tk_GetColor): Initialize gcList element.
+ (Tk_GetColorByValue): Likewise.
+ (TkMapOverColors): New function.
+ (TkRegisterColorGC, TkDeregisterColorGC): New functions.
+ (TkColorChanged): New function.
+ * generic/tkColor.h (TkGCList): Define typedef.
+ (TkColor): Add gcList field.
+ (TkMapOverColors, TkColorChanged): Declare.
+ * generic/tkGC.c: Include tkInt.h.
+ (TkGC): Add foreground and background fields.
+ (ValueKey): Add foreground and background fields.
+ (Tk_GetGCColor): Rename from Tk_GetGC. Add foreground and
+ background parameters. Register the GC with the colors.
+ (Tk_GetGC): New function which just calls Tk_GetGCColor.
+ (Tk_FreeGC): Deregister colors.
+ * generic/tk.h (Tk_GetGCColor): Declare.
+ * generic/tkInt.h (TkRegisterColorGC): Declare.
+ (TkDeregisterColorGC): Declare.
+ * win/tkWinColor.c (ChangeColor): New static function.
+ (TkWinSysColorChange): New function.
+ * win/tkWinWm.c (WmProc): Handle WM_SYSCOLORCHANGE.
+ * win/tkWinInt.h (TkWinSysColorChange): Declare.
+ * generic/tk3d.c: Change some calls to Tk_GetGC to call
+ Tk_GetGCColor instead.
+ * generic/tkButton.c: Likewise.
+ * generic/tkCanvArc.c: Likewise.
+ * generic/tkCanvBmap.c: Likewise.
+ * generic/tkCanvLine.c: Likewise.
+ * generic/tkCanvPoly.c: Likewise.
+ * generic/tkCanvText.c: Likewise.
+ * generic/tkCanvas.c: Likewise.
+ * generic/tkEntry.c: Likewise.
+ * generic/tkImgBmap.c: Likewise.
+ * generic/tkImgPhoto.c: Likewise.
+ * generic/tkListbox.c: Likewise.
+ * generic/tkMenuDraw.c: Likewise.
+ * generic/tkMenuButton.c: Likewise.
+ * generic/tkMessage.c: Likewise.
+ * generic/tkRectOval.c: Likewise.
+ * generic/tkScale.c: Likewise.
+ * generic/tkTextDisp.c: Likewise.
+
+Tue Sep 30 17:13:16 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/tkWinPointer.c (TkWinCancelMouseTimer): New function.
+ * win/tkWinWm.c (WmProc): Call it in WM_ENTERSIZEMOVE case.
+
+Mon Sep 15 16:29:16 PDT 1997 Khamis Abuelkomboz <khamis@cygnus.com>
+ generic/tkText.[ch]
+ Added a new functionality for the editor '-synccommand'. When it es
+ not empty, this command is called, when ever the contents in the
+ editor is changed (insert, delete). The function is called with the
+ same parameters how it called for the editor.
+ This functionality is used in the new GUI for SN to be able to open
+ more than one editor with the same file (like emacs multiple buffers).
+
+Wed Sep 10 12:56:43 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * generic/tkImgPhoto.c (FreeColorTable): Add force parameter.
+ Change all callers.
+ (DisposeInstance): Force FreeColorTable to free the color table
+ immediately, in case we are being called from TkDeleteAllImages
+ when Tk is exiting.
+
+ * win/tkWinMenu.c (TkWinHandleMenuEvent): If TkInvokeMenu returns
+ an error, call Tcl_BackgroundError.
+
+ * win/Makefile.in (install-libraries): Don't try to install *.gif
+ or *.xbm.
+
+Mon Sep 8 17:13:49 MET DST 1997 Zsolt Koppany <zkoppany@multix.de>
+ unix/tkUnixEvent.c
+ Deleted the second unnecessary call of XOpenDisplay().
+
+Thu Sep 4 20:07:23 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/tkWinFont.c (nonClientMap): New static array.
+ (TkpGetFontFromAttributes): If the font is in a magic windows-*
+ family, use SystemParametersInfo to get the attributes.
+ (TkWinNCMetricsChanged): New function.
+ (FontChanged): New static function.
+ * win/tkWinInt.h (TkWinNCMetricsChanged): Declare.
+ * generic/tkFont.c (TkUpdateFonts): New function.
+ * generic/tkFont.h (TkUpdateFonts): Declare.
+ * win/tkWinWm.c (WmProc): Handle WM_SETTINGCHANGE with a wParam
+ value of SPI_SETNONCLIENTMETRICS.
+
+Thu Sep 4 11:34:20 1997 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/palette.tcl (tkRecolorTree): If color isn't
+ set don't try to apply it.
+
+ * library/menu.tcl: Apply patch "menu2.txt" from patches
+ archive.
+
+Fri Aug 29 11:27:17 1997 Tom Tromey <tromey@cygnus.com>
+
+ * library/menu.tcl (tk_popup): Use Tcl syntax for call to
+ tk_menuSetFocus.
+
+Thu Aug 28 15:25:31 MET DST 1997 Zsolt Koppany <zkoppany@multix.de>
+ * generic/tkImgGIF.c
+ Memory bug fix.
+
+Thu Aug 28 13:36:30 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * testsuite/tk.tests/tk-test.exp: Permit capital letters in test
+ case names. Try better error string handling.
+
+ * generic/tkInitScript.h (initScript): Don't call pwd in a safe
+ interpreter.
+
+ * library/tkfbox.tcl (tkFDialog_VerifyFileName): Only add file to
+ selectFile using lappend if -multiple.
+ * tests/filebox.tcl: Set the expected unknown options based on the
+ command and mode.
+
+Sun Aug 24 21:40:30 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/Makefile.in ($(TKDLL)): Set base address to 0x66300000.
+
+Mon Aug 18 18:13:00 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/tkWinDialog.c (GetFileName): Handle the case of a single
+ file when OFN_ALLOWMULTISELECT is set.
+
+Fri Aug 15 19:26:39 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/tkWinInit.c (initScript): Don't append share to [info
+ library] (revert patch of Aug 7).
+
+Thu Aug 14 09:29:45 1997 Tom Tromey <tromey@sanguine.cygnus.com>
+
+ * library/dialog.tcl (tk_dialog): Run update after setting
+ geometry. From the net.
+
+Wed Aug 13 12:28:08 1997 Tom Tromey <tromey@sanguine.cygnus.com>
+
+ * library/tkfbox.tcl (tkFDialog_VerifyFileName): Use fname and not
+ contents of entry to compute flat, path, and file.
+
+Tue Aug 12 18:02:15 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/rc/cygnus.ico: Change color to match other Cygnus designs.
+
+Tue Aug 12 17:37:36 MET DST 1997 Zsolt Koppany <zkoppany@multix.de>
+
+ * unix/tkUnixWm.c
+ Memory leak bug fixes.
+
+ * generic/tkText.c
+ TkTextRedrawRegion() should be called only if TkTextCharBbox()
+ does not return -1, because in that case x,y and h variables
+ will not be set.
+
+Mon Aug 11 16:58:08 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Call AC_CANONICAL_HOST. Check host, not target,
+ for cygwin32.
+ * configure: Rebuild.
+
+ * win/rc/cygnus.ico: New file.
+ * win/rc/tk.rc: Replace tk.ico with cygnus.ico.
+
+Mon Aug 11 11:14:31 1997 Martin M. Hunt <hunt@cygnus.com>
+
+ * generic/tk.h, generic/tkImage.c, generic/tkImgBmap.c,
+ generic/tkImgGIF.c, generic/tkImgPhoto.c, generic/tkTest.c,
+ generic/tkWindow.c, library/tkfbox.tcl, tests/imgPhoto.test,
+ doc/photo.n: Two patches from Jan.Nijtmans@cmg.nl. Fixes
+ numerous image problems including GIF transparency.
+
+Fri Aug 8 21:14:55 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/tkWinPointer.c (TkpChangeFocus): If force is set, call
+ SetForegroundWindow.
+
+Thu Aug 7 12:55:50 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * generic/tkFrame.c (mapFrameWindow): New static variable.
+ (mapFrameFrame): New static variable.
+ (MapFrame): Set new variables.
+ (TkInstallFrameMenu): Use new variables.
+
+ * win/tkWinInit.c (initScript): Look under share.
+
+Wed Aug 6 23:47:01 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/Makefile.in: Update for Tk 8.0.
+ * win/configure.in: Likewise.
+ * win/configure: Rebuild.
+ * win/tkWinInt.h (TkFontAttributes): Don't use typedef if
+ __GNUC__.
+ * win/tkWinPort.h (strnicmp, stricmp): Define if __CYGWIN32__.
+ (strncasecmp, strcasecmp): Don't define if __CYGWIN32__.
+
+Tue Aug 5 14:00:53 1997 Tom Tromey <tromey@cygnus.com>
+
+ * tests/all: Preserved local changes.
+ * tests/defs: Preserved local changes.
+
+Fri Jul 25 12:42:54 1997 Stephen Peters <speters@cygnus.com>
+
+ * win/tkWinDialog.c (GetFileName, ParseFileDlgArgs): Changes to
+ let tk_getOpenFile and tk_getSaveFile deal with multi-file
+ selections on Windows.
+ * doc/getOpenFile.n: Add documentation for `-multiple' option.
+
+Thu Jul 24 13:12:02 1997 Stephen Peters <speters@cygnus.com>
+
+ * library/tkfbox.tcl: Changes to let tk_getOpenFile take a
+ `-multiple yes' argument and handle multi-file selections.
+
+Tue Jul 22 12:40:50 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/Makefile.in (.c.o): Use CFLAGS.
+
+Sat Jul 12 11:28:22 MET DST 1997 Zsolt Koppany <zkoppany@multix.de>
+
+ * generic/tkImgGIF.c
+ Patch from tk8.b2 in GetCode().
+ * generic/tkImgPhoto.c
+ Purify UMR bug fix in AllocateColors().
+
+Wed Jul 9 14:43:57 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * generic/tkMain.c: Include winuser.h if _WIN32.
+ (Tk_Main): If _WIN32, call MessageBox on error.
+
+Fri Jul 4 13:36:03 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/tkWinImage.c (PutPixel): Correct yet another bug.
+
+Thu Jul 3 16:00:57 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/tkWinImage.c (PutPixel): For a depth of 16 bits, convert a
+ 24 bit truecolor value into a 16 bit truecolor value. Correct
+ error in storing high byte. For a depth of 1 bit, correct error
+ in clearing bit.
+
+Thu Jun 26 14:02:03 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/Makefile.in (WINDRES): New variable.
+ (install-binaries): Don't install DLL here...
+ (install-libraries): ...install it here instead.
+ ($(TKDLL)): Depend upon and link with tkres.o.
+ ($(WISH)): Depend upon and link with wishres.o.
+ ($(TKTEST)): Likewise.
+ (tkres.o, wishres.o): New targets.
+ * win/tkWinX.c (TkWinGetTkModule): If __CYGWIN32__, use cygtkdll
+ as the DLL name.
+ * win/configure.in: Define and substitute WINDRES.
+ * win/configure: Rebuild.
+
+Tue Jun 24 11:42:06 1997 Tom Tromey <tromey@cygnus.com>
+
+ * library/palette.tcl (tkRecolorTree): Properly quote color name.
+ From Jeffrey Hobbs.
+
+Mon Jun 23 10:15:56 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (install-binaries, install-libraries): New targets.
+
+Wed Jun 18 12:21:57 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/Makefile.in: Copy install, install-binaries,
+ install-libraries, and install-demos rules, and associated
+ variables from unix/Makefile.in, with appropriate adjustments.
+
+Thu Jun 12 19:20:57 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/Makefile.in (tkcyg.def): Don't export impure_ptr.
+
+Tue Jun 10 19:16:39 1997 Stephen Peters <speters@cygnus.com>
+
+ * unix/configure.in: Use a real replacement for memmove, instead
+ of using memcpy (which doesn't guarantee overlaps will copy
+ correctly).
+ * unix/configure: Rebuilt.
+ * unix/Makefile.in: Use replacement memmove if needed.
+ * compat/memmove.c: New file for replacing memmove.
+
+Mon Jun 9 16:26:13 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/configure.in: Set TK_BUILD_INCLUDES.
+ * win/configure: Rebuild.
+
+Fri Jun 6 23:43:34 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ Add support for building with cygwin32:
+ * win/Makefile.in: Rewrite completely based on makefile.vc.
+ * win/configure.in: Rewrite completely.
+ * win/configure: Rebuild.
+ * win/tkWin32Dll.c (_impure_ptr): Define if __CYGWIN32__.
+ (__imp_reent_data): Declare if __CYGWIN32__.
+ (DllMain): Initialize _impure_ptr if __CYGWIN32__.
+ * win/tkWinX.c (GetCurrentTime): Define as GetTickCount if
+ __CYGWIN32__.
+
+Thu May 22 15:49:40 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * win/configure.in: Use win rather than CONFIGDIR.
+ * win/configure: Rebuild.
+
+Fri May 9 19:07:17 1997 Zsolt Koppany <zkoppany@multix.de>
+
+ * generic/tkWindow.c (GetScreen): Init metaModMask, altModMask
+ (from Purify).
+
+Tue May 13 23:19:20 1997 Zsolt Koppany <zsolt@cygnus.com>
+
+ * generic/tkText.c (ConfigureText): Bug fix from Ousterhout.
+
+Wed Apr 23 14:36:14 1997 Tom Tromey <tromey@cygnus.com>
+
+ * library/tkfbox.tcl: Incorporated version from Tk 8.0.
+
+Tue Mar 25 23:35:02 1997 Martin M. Hunt <hunt@cygnus.com>
+
+ * library/palette.tcl: Patch from kcorey@eng.sun.com
+ (Ken Corey)
+
+Tue Mar 18 16:01:05 1997 Martin M. Hunt <hunt@cygnus.com>
+
+ * generic/tkImgGIF.c: Fix GIF transparency. Patch from
+ nijtmans@nici.kun.nl
+
+Thu Mar 13 10:42:01 1997 Tom Tromey <tromey@cygnus.com>
+
+ * win/configure.in: Don't run AC_C_CROSS.
+ (AC_CONFIG_AUX_DIR): Look in srcdir.
+
+Fri Mar 7 13:08:47 1997 Tom Tromey <tromey@cygnus.com>
+
+ * Updated to Tk 4.2p2.
+
+Thu Nov 21 10:07:02 1996 Tom Tromey <tromey@cygnus.com>
+
+ * generic/tkGrid.c (Tk_GridCmd): Applied fix suggested by Stephen
+ Uhler.
+
+ * library/menu.tcl: Applied patch from Ousterhout.
+
+Mon Oct 14 12:17:11 1996 Tom Tromey <tromey@cygnus.com>
+
+ * Makefile.in (RUNTEST): Use srcdir, not SRC_DIR.
+ (tk-check): Ditto.
+ (check): Renamed from tk-check.
+
+ * testsuite/config/default.exp (find_x_display): New proc.
+ (tk_start): Use find_x_display.
+
+Mon Aug 19 12:30:51 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * testsuite/config/default.exp, testsuite/tk.tests/tk-test.exp:
+ New files.
+
+ * Makefile.in (EXPECT, RUNTESTFLAGS, RUNTEST): New variables.
+ (tk-check): New target.
+
+ * tests/all: Look for tests in srcdir.
+ * tests/defs: Set srcdir if not already set.
+
+Thu Aug 15 12:50:47 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * generic/tkArgv.c (defaultTable): Added -version.
+ (Tk_ParseArgv): Handle -version option.
+ * generic/tk.h (TK_ARGV_VERSION): New define.
+
+Mon Aug 5 10:47:09 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * Makefile.in (configure): Don't depend on configure.in.
+ (config.status): Depend on configure.
+
+Wed Jun 26 12:51:43 1996 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * configure.in (AC_PREREQ): autoconf 2.5 or higher.
+ * configure: Rebuilt.
+
+Mon May 6 09:45:20 1996 Tom Tromey <tromey@lisa.cygnus.com>
+
+ * generic/tkMain.c (Tk_Main): Exit after printing version number.
+
+Tue Apr 30 13:40:04 1996 Tom Tromey <tromey@snuffle.cygnus.com>
+
+ * generic/tkMain.c (Tk_Main): Removed "-inet-1.0".
+
+Mon Apr 29 17:43:15 1996 Tom Tromey <tromey@snuffle.cygnus.com>
+
+ * generic/tkMain.c (argTable): Added -version.
+ (Tk_Main): Handle -version.
+
+Thu Mar 7 10:08:57 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * Makefile.in (config.status): Depend on nothing.
+
+Wed Mar 6 19:07:38 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * Makefile.in (Makefile): Removed redundant target.
+
+Thu Feb 29 21:32:44 1996 Fred Fish <fnf@cygnus.com>
+
+ * Makefile.in (srcdir): Add macro.
+ (configure): Run autoconf in source dir, not build dir.
+
+Thu Feb 29 14:59:03 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * Makefile.in (Makefile): New rule.
+ (config.status): New rule.
+
+Wed Jan 24 09:42:29 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * Makefile.in: Replaced realclean with maintainer-clean.
+
+Fri Jan 12 11:00:06 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * library/tclIndex: Removed all references to console.tcl.
+ (Hack).
+
+ * library/console.tcl (tkConsoleInvoke): Use "interp eval" with
+ history command, not nonexistent "interp record" command.
+ (tkConsoleHistory, tkConsolePrompt): Include pathname argument to
+ "interp eval".
+
+Wed Jan 10 12:49:00 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * configure.in, configure, Makefile.in, README.configure: New
+ files.
+
+ * Tk: Updated to Tk4.1a2. Entries after this line mostly likely
+ apply to files in some subdirectory.
+
+Tue Dec 19 18:32:36 1995 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * Makefile.in (check, installcheck): New null rules.
+
+Wed Oct 25 20:12:01 1995 Brendan Kehoe <brendan@lisa.cygnus.com>
+
+ * Makefile.in (prefix, exec_prefix): Set to @prefix@ and
+ @exec_prefix@, so configure can substitute them properly.
+
+Tue Oct 24 18:49:59 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * Makefile.in (X11_INCLUDES, X11_LIB_SWITCHES): switch to
+ X11_CFLAGS, X11_LDFLAGS and X11_LIBS.
+ (CC_SWITCHES): Use X11_CFLAGS.
+
+ * configure.in: Statically link X libraries on Solaris, SunOS,
+ and HPUX.
+
+Tue Oct 10 14:33:17 1995 Stu Grossman (grossman@cygnus.com)
+
+ * tkConfig.c (Tk_ConfigureInfo), tkSelect.c (HandleTclCommand
+ LostSelection): Use free() instead of TCL_DYNAMIC in
+ interp->freeProc to prevent crashes. Apparantly tcl7.4 changed
+ the result protocol around slightly.
+
+Sat Sep 30 09:39:11 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * configure.in: Upgraded to autoconf v2, removed cruft which did a poor
+ job of finding X location in favor of AC_PATH_X.
+ * configure: Regenerated.
+
+Sun Aug 20 00:15:51 1995 Jason Molenda (crash@phydeaux.cygnus.com)
+
+ * tkMain.c: make tcl_RcFileName defn an extern so it doesn't
+ conflict with the one in the new tcl/tclBasic.c.
+
+Mon Jun 12 17:09:28 1995 Stu Grossman (grossman@cygnus.com)
+
+ * configure: Ignore --cache-file option instead of bombing out.
+
+Mon Dec 12 12:17:16 1994 Stu Grossman (grossman@cygnus.com)
+
+ * tkConfig.h: Don't use prototype for select. This allows HPUX
+ 8.x build.
+
+Tue Oct 18 12:41:49 1994 Jim Wilson (wilson@chestnut.cygnus.com)
+
+ * Makefile.in (CC_SWITCHES): Add X11_INCLUDE_FLAGS.
diff --git a/tk/Makefile.in b/tk/Makefile.in
new file mode 100644
index 00000000000..ada985112aa
--- /dev/null
+++ b/tk/Makefile.in
@@ -0,0 +1,71 @@
+# Minimal top-level Makefile. Just pass everything to the $(CONFIGDIR)
+# subdir.
+# Tom Tromey <tromey@cygnus.com>
+
+CONFIGDIR=@CONFIGDIR@
+
+VPATH = @srcdir@
+SHELL = @SHELL@
+srcdir = @srcdir@
+
+@SET_MAKE@
+
+all install install-binaries install-libraries install-minimal:
+ @cd $(CONFIGDIR) && $(MAKE) $@
+
+# Nothing for these yet.
+installcheck install-info info:
+
+mostlyclean-recursive clean-recursive distclean-recursive \
+maintainer-clean-recursive:
+ @cd $(CONFIGDIR) && $(MAKE) `echo $@ | sed 's/-recursive//'`
+
+# Don't depend on configure.in, because we can't ensure that the user
+# has autoconf.
+configure:
+ cd $(srcdir) ; autoconf
+
+mostlyclean: mostlyclean-recursive
+
+clean: clean-recursive
+
+distclean-local:
+ rm -f Makefile config.status config.cache config.log
+
+distclean: distclean-recursive distclean-local
+
+maintainer-clean: distclean-local maintainer-clean-recursive
+
+Makefile: Makefile.in config.status
+ CONFIG_FILES=Makefile CONFIG_HEADERS= $(SHELL) ./config.status
+
+config.status: configure
+ $(SHELL) config.status --recheck
+
+#----------------------------------------------------------------
+# These let the DejaGnu test suite run when DejaGnu isn't
+# installed yet, so run it from the srcdir and objdir.
+#----------------------------------------------------------------
+EXPECT = ` \
+ if [ -f $${rootme}/../expect/expect ] ; then \
+ echo $${rootme}/../expect/expect ; \
+ else echo expect ; fi`
+
+RUNTESTFLAGS =
+RUNTEST = ` \
+ if [ -f $(srcdir)/../dejagnu/runtest ] ; then \
+ echo $(srcdir)/../dejagnu/runtest ; \
+ else echo runtest ; fi`
+
+check:
+ cd $(CONFIGDIR) && $(MAKE) tktest
+ rootme=`pwd`; export rootme; \
+ srcdir=${srcdir}; export srcdir ; \
+ EXPECT=${EXPECT} ; export EXPECT ; \
+ if [ -f $${rootme}/../expect/expect ] ; then \
+ TCL_LIBRARY=`cd $${srcdir}/../tcl/library && pwd`; \
+ export TCL_LIBRARY; \
+ TK_LIBRARY=`cd $${srcdir}/library && pwd`; \
+ export TK_LIBRARY; \
+ fi ; \
+ $(RUNTEST) $(RUNTESTFLAGS) --tool tk --srcdir $(srcdir)/testsuite
diff --git a/tk/README b/tk/README
new file mode 100644
index 00000000000..d75186be68b
--- /dev/null
+++ b/tk/README
@@ -0,0 +1,393 @@
+The Tk Toolkit
+
+RCS: @(#) $Id$
+
+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.0.3, which is the third patch update
+for Tk 8.0. This release is designed to work with Tcl 8.0.3 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
+
+Other books are listed at
+http://www.scriptics.com/resource/doc/books/
+http://www.tclconsortium.org/resources/books.html
+
+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.scriptics.com/
+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 Windows 98.)
+
+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 Tcl/Tk
+ (http://www.scriptics.com/) 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 (you may need to replace "patch -p" with "patch -p0"
+ depending on your version of the patch program):
+ 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. To subscribe send a message to:
+
+ wintcl-request@tclconsorium.org
+ or
+ mactcl-request@tclconsorium.org
+
+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. Tcl Resource Center
+----------------------
+Visit http://www.scritics.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 extensions, applications, binary
+releases, and patches. You can contribute patches by sending them
+to <patches@scriptics.com>. You can also recommend more URLs for the
+resource center using the forms labeled "Add a Resource".
+
+10. 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 Scriptics. 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
+Scriptics (info@scriptics.com), NeoSoft (info@neosoft.com),
+Computerized Processes Unlimited (gwl@cpu.com),
+and Data Kinetics (education@dkl.com).
+
+11. Release organization
+------------------------
+
+The version numbers described below are available to Tcl scripts
+as the tk_version and tk_patchLevel Tcl variables.
+
+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 used to have a suffix such as p1 or p2. Now we use
+a 3-part version number: major.minor.patchlevel. (e.g., 8.0.3)
+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.
diff --git a/tk/bitmaps/error.bmp b/tk/bitmaps/error.bmp
new file mode 100644
index 00000000000..5a1331f436e
--- /dev/null
+++ b/tk/bitmaps/error.bmp
@@ -0,0 +1,8 @@
+#define error_width 17
+#define error_height 17
+static unsigned char error_bits[] = {
+ 0xf0, 0x0f, 0x00, 0x58, 0x15, 0x00, 0xac, 0x2a, 0x00, 0x16, 0x50, 0x00,
+ 0x2b, 0xa0, 0x00, 0x55, 0x40, 0x01, 0xa3, 0xc0, 0x00, 0x45, 0x41, 0x01,
+ 0x83, 0xc2, 0x00, 0x05, 0x45, 0x01, 0x03, 0xca, 0x00, 0x05, 0x74, 0x01,
+ 0x0a, 0xa8, 0x00, 0x14, 0x58, 0x00, 0xe8, 0x2f, 0x00, 0x50, 0x15, 0x00,
+ 0xa0, 0x0a, 0x00};
diff --git a/tk/bitmaps/gray12.bmp b/tk/bitmaps/gray12.bmp
new file mode 100644
index 00000000000..a0eafa14526
--- /dev/null
+++ b/tk/bitmaps/gray12.bmp
@@ -0,0 +1,6 @@
+#define gray12_width 16
+#define gray12_height 16
+static unsigned char gray12_bits[] = {
+ 0x00, 0x00, 0x22, 0x22, 0x00, 0x00, 0x88, 0x88, 0x00, 0x00, 0x22, 0x22,
+ 0x00, 0x00, 0x88, 0x88, 0x00, 0x00, 0x22, 0x22, 0x00, 0x00, 0x88, 0x88,
+ 0x00, 0x00, 0x22, 0x22, 0x00, 0x00, 0x88, 0x88};
diff --git a/tk/bitmaps/gray25.bmp b/tk/bitmaps/gray25.bmp
new file mode 100644
index 00000000000..fdaef49c71c
--- /dev/null
+++ b/tk/bitmaps/gray25.bmp
@@ -0,0 +1,6 @@
+#define gray25_width 16
+#define gray25_height 16
+static unsigned char gray25_bits[] = {
+ 0x88, 0x88, 0x22, 0x22, 0x88, 0x88, 0x22, 0x22, 0x88, 0x88, 0x22, 0x22,
+ 0x88, 0x88, 0x22, 0x22, 0x88, 0x88, 0x22, 0x22, 0x88, 0x88, 0x22, 0x22,
+ 0x88, 0x88, 0x22, 0x22, 0x88, 0x88, 0x22, 0x22};
diff --git a/tk/bitmaps/gray50.bmp b/tk/bitmaps/gray50.bmp
new file mode 100644
index 00000000000..1f9fbc0e51f
--- /dev/null
+++ b/tk/bitmaps/gray50.bmp
@@ -0,0 +1,6 @@
+#define gray50_width 16
+#define gray50_height 16
+static unsigned char gray50_bits[] = {
+ 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa,
+ 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa,
+ 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa};
diff --git a/tk/bitmaps/gray75.bmp b/tk/bitmaps/gray75.bmp
new file mode 100644
index 00000000000..f700b2cd028
--- /dev/null
+++ b/tk/bitmaps/gray75.bmp
@@ -0,0 +1,6 @@
+#define gray75_width 16
+#define gray75_height 16
+static unsigned char gray75_bits[] = {
+ 0x77, 0x77, 0xdd, 0xdd, 0x77, 0x77, 0xdd, 0xdd, 0x77, 0x77, 0xdd, 0xdd,
+ 0x77, 0x77, 0xdd, 0xdd, 0x77, 0x77, 0xdd, 0xdd, 0x77, 0x77, 0xdd, 0xdd,
+ 0x77, 0x77, 0xdd, 0xdd, 0x77, 0x77, 0xdd, 0xdd};
diff --git a/tk/bitmaps/hourglass.bmp b/tk/bitmaps/hourglass.bmp
new file mode 100644
index 00000000000..bb1d8ad0e7c
--- /dev/null
+++ b/tk/bitmaps/hourglass.bmp
@@ -0,0 +1,9 @@
+#define hourglass_width 19
+#define hourglass_height 21
+static unsigned char hourglass_bits[] = {
+ 0xff, 0xff, 0x07, 0x55, 0x55, 0x05, 0xa2, 0x2a, 0x03, 0x66, 0x15, 0x01,
+ 0xa2, 0x2a, 0x03, 0x66, 0x15, 0x01, 0xc2, 0x0a, 0x03, 0x46, 0x05, 0x01,
+ 0x82, 0x0a, 0x03, 0x06, 0x05, 0x01, 0x02, 0x03, 0x03, 0x86, 0x05, 0x01,
+ 0xc2, 0x0a, 0x03, 0x66, 0x15, 0x01, 0xa2, 0x2a, 0x03, 0x66, 0x15, 0x01,
+ 0xa2, 0x2a, 0x03, 0x66, 0x15, 0x01, 0xa2, 0x2a, 0x03, 0xff, 0xff, 0x07,
+ 0xab, 0xaa, 0x02};
diff --git a/tk/bitmaps/info.bmp b/tk/bitmaps/info.bmp
new file mode 100644
index 00000000000..801476e48e6
--- /dev/null
+++ b/tk/bitmaps/info.bmp
@@ -0,0 +1,5 @@
+#define info_width 8
+#define info_height 21
+static unsigned char info_bits[] = {
+ 0x3c, 0x2a, 0x16, 0x2a, 0x14, 0x00, 0x00, 0x3f, 0x15, 0x2e, 0x14, 0x2c,
+ 0x14, 0x2c, 0x14, 0x2c, 0x14, 0x2c, 0xd7, 0xab, 0x55};
diff --git a/tk/bitmaps/questhead.bmp b/tk/bitmaps/questhead.bmp
new file mode 100644
index 00000000000..17b2929326a
--- /dev/null
+++ b/tk/bitmaps/questhead.bmp
@@ -0,0 +1,9 @@
+#define questhead_width 20
+#define questhead_height 22
+static unsigned char questhead_bits[] = {
+ 0xf8, 0x1f, 0x00, 0xac, 0x2a, 0x00, 0x56, 0x55, 0x00, 0xeb, 0xaf, 0x00,
+ 0xf5, 0x5f, 0x01, 0xfb, 0xbf, 0x00, 0x75, 0x5d, 0x01, 0xfb, 0xbe, 0x02,
+ 0x75, 0x5d, 0x05, 0xab, 0xbe, 0x0a, 0x55, 0x5f, 0x07, 0xab, 0xaf, 0x00,
+ 0xd6, 0x57, 0x01, 0xac, 0xab, 0x00, 0xd8, 0x57, 0x00, 0xb0, 0xaa, 0x00,
+ 0x50, 0x55, 0x00, 0xb0, 0x0b, 0x00, 0xd0, 0x17, 0x00, 0xb0, 0x0b, 0x00,
+ 0x58, 0x15, 0x00, 0xa8, 0x2a, 0x00};
diff --git a/tk/bitmaps/question.bmp b/tk/bitmaps/question.bmp
new file mode 100644
index 00000000000..ceba2ab60fe
--- /dev/null
+++ b/tk/bitmaps/question.bmp
@@ -0,0 +1,10 @@
+#define question_width 17
+#define question_height 27
+static unsigned char question_bits[] = {
+ 0xf0, 0x0f, 0x00, 0x58, 0x15, 0x00, 0xac, 0x2a, 0x00, 0x56, 0x55, 0x00,
+ 0x2b, 0xa8, 0x00, 0x15, 0x50, 0x01, 0x0b, 0xa0, 0x00, 0x05, 0x60, 0x01,
+ 0x0b, 0xa0, 0x00, 0x05, 0x60, 0x01, 0x0b, 0xb0, 0x00, 0x00, 0x58, 0x01,
+ 0x00, 0xaf, 0x00, 0x80, 0x55, 0x00, 0xc0, 0x2a, 0x00, 0x40, 0x15, 0x00,
+ 0xc0, 0x02, 0x00, 0x40, 0x01, 0x00, 0xc0, 0x02, 0x00, 0x40, 0x01, 0x00,
+ 0xc0, 0x02, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0xc0, 0x02, 0x00,
+ 0x40, 0x01, 0x00, 0xc0, 0x02, 0x00, 0x00, 0x01, 0x00};
diff --git a/tk/bitmaps/warning.bmp b/tk/bitmaps/warning.bmp
new file mode 100644
index 00000000000..79254403f21
--- /dev/null
+++ b/tk/bitmaps/warning.bmp
@@ -0,0 +1,5 @@
+#define warning_width 6
+#define warning_height 19
+static unsigned char warning_bits[] = {
+ 0x0c, 0x16, 0x2b, 0x15, 0x2b, 0x15, 0x2b, 0x16, 0x0a, 0x16, 0x0a, 0x16,
+ 0x0a, 0x00, 0x00, 0x1e, 0x0a, 0x16, 0x0a};
diff --git a/tk/changes b/tk/changes
new file mode 100644
index 00000000000..8ef41cf4dbf
--- /dev/null
+++ b/tk/changes
@@ -0,0 +1,4284 @@
+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$
+
+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.
+
+3/18/91 (bug fix) Modified tkShare.c to fix bug causing "DeleteGroup
+couldn't find group on shareList" panic.
+
+3/18/91 (bug fix) Several changes to tkListbox.c and tkScrollbar.c to
+handle listboxes (and scrollbars) with zero total entries in them.
+
+3/22/91 (bug fix) Fixed a few ='s in tkListbox.c that should be ==.
+
+3/22/91 (bug fix) Fixed error in main.c that caused BadWindow errors
+in some cases where wish scripts invoke "destroy .".
+
+3/23/91 (new feature) Added Tk_CancelIdleCall to remove Tk_DoWhenIdle
+handler.
+
+3/23/91 (bug fix and new feature) Added -name option to main.c, made
+it more clever about choosing name (was always using the name "wish"
+on most Unix systems).
+
+3/23/91 (new feature) Added TK_CONFIG_STRING option to Tk_ConfigureWidget,
+used it to malloc strings for various widget options that used to be
+Tk_Uid's (e.g. button text, message strings, etc.). Eliminates core
+leaks when values change in continuous non-repeating fashion.
+
+3/29/91 (new feature) Added Tk_Preserve, Tk_Release, and
+Tk_EventuallyFree procedures to help manage widget records and avoid
+premature memory free-ing.
+
+4/4/91 (bug fix) Fixed problem in tkWm.c where top-level window geometry
+wasn't tracking correctly when wm-induced size change also changed window
+position (e.g. menus wouldn't be displayed at the right places).
+
+4/5/91 (new feature) Added "invoke" option to widget command for buttons,
+check buttons, and radio buttons.
+
+4/5/91 (new feature) Added "unpack" option to "pack" command.
+
+4/5/91 (bug fix) Changed tkPack.c to use new Tk_Preserve code and be
+more careful about window deletions that occur while repacking is in
+progress.
+
+4/6/91 (bug fix) Major overhaul of deletion code in all widgets to use
+Tk_Preserve and Tk_Release. Should fix many problems.
+
+4/6/91 (bug fix) Changed "winfo children" to generate correct lists
+when child names have embedded spaces.
+
+4/6/91 (new feature) Added "screenheight" and "screenwidth" options to
+"winfo".
+
+4/18/91 (bug fix) Binding mechanism didn't correctly handle very long
+%-substitutions in commands (e.g. long path names) and caused memory
+to be overwritten. Modified tkBind.c to fix.
+
+---------------------- Release 1.1, 4/18/91 -------------------------
+
+4/19/91 (bug fix) Inconsistent ICCCM handling of coordinates of reparented
+windows causes windows to gradually walk south when moved or resized.
+Fixed tkWm.c to patch around the problem.
+
+---------------------- Release 1.2, 4/24/91 -------------------------
+
+4/26/91 (new feature) Added -geometry and -display switches to wish.
+Also wrote wish manual entry.
+
+5/3/91 (bug fix) Fixed bug in tkListbox.c that caused garbage to appear
+at right edge of window when strings were to large to fit in window.
+
+5/3/91 (bug fix) Fixed bug in tkListbox.c where topIndex wasn't getting
+updated when elements were deleted: tended to cause errors in
+communication with scrollbars.
+
+5/16/91 (bug fix) Fixed bug in tk3d.c, which caused core dumps when
+consecutive points in a polygon were the same (happened with some
+configurations of radio buttons, for example).
+
+5/16/91 (bug fix) Fixed main.c to allow stdin to be redirected.
+
+6/1/91 (bug fix) Make sure that pointers are never used after being
+freed.
+
+6/15/91 (bug fix) Fixed bug in tkBind.c that caused current binding
+values to not always be printed correctly.
+
+6/15/91 (bug fix) Make sure that interpreters are always unregistered
+when their main windows are deleted, and make wish delete the main
+window before exiting.
+
+8/21/91 (misfeature correction) Automatically set source of window
+position to "user" in "wm geometry" command, unless it has been
+explicitly set to "program".
+
+9/5/91 (bug fix) Modified option code to accept '#' as a comment
+character in .Xdefaults files, in addition to '!'.
+
+9/10/91 (misfeature correction) Changed binding mechanism so that
+numeric %-sequences are output in decimal instead of hex.
+
+9/19/91 (bug fix) Fixed bug in Tk_DoOneEvent(1) where it wasn't
+checking files and X connections properly so it missed events.
+
+10/6/91 (new feature) Reorganized tkBind.c to provide generic "binding
+table" structure, which can be used to create bindings on items in
+canvases as well as windows.
+
+10/6/91 (new feature) Upgraded buttons and menus to use new tracing
+code in Tcl 6.0. Allows radio buttons and check buttons to both set
+and clear themselves when associated variable changes.
+
+10/17/91 (bug fix) Fixed 2 bugs in listboxes: accidentally advanced the
+selection when new entries were inserted in the listbox after the location
+of the selected item(s), and goofed up on redisplay if selected item
+was deleted and then selection was immediately lost.
+
+10/27/91 (bug fix) "pack unpack" wasn't telling Tk that it no longer
+manages window; this led to core dumps in some situations.
+
+10/31/91 (reorganization) Renamed manual entries so that they are no
+more than 14 characters in length.
+
+10/31/91 (reorganization) Changed tk.h and tkInt.h so that tkInt.h
+doesn't needed to be included by tk.h.
+
+11/3/91 (portability improvement) Eliminated use of "class" as a variable
+name, since it's a reserved word in C++.
+
+11/7/91 (reorganization) Many changes to upgrade for Tcl 6.1 including
+use of Tcl hash tables instead of separate "Hash_" module. The "lib"
+subdirectory is no longer needed in Tk.
+
+---------------------- Release 1.3, 11/7/91 -------------------------
+
+11/24/91 (bug fix) Fixed bug causing occasional errors if existing bindings
+are modified (FindSequence in tkBind.c forget to set *maskPtr).
+
+11/24/91 (bug fix) Used wrong hash table in Tk_GetColorByValue. Could
+cause new entries to get created unnecessarily.
+
+12/2/91 (bug fix) Changed "bind" code to put backslashes in front of
+special characters (e.g. [ or \) that appear in %-replacements, so that
+they can be parsed cleanly.
+
+12/10/91 (bug fix) Manual entries had first lines that caused "man" program
+to try weird preprocessor. Added blank comment lines to fix problem.
+
+1/2/92 (documentation cleanup) Changed manual entries for Tk_GetBitmap
+and the like to make it more clear that the argument must be a Tk_Uid
+and not a string.
+
+1/2/92 (bug fix) Fixed problem where scrollbars that were very short or
+very narrow (too small to hold both arrows) could cause negative values
+in calls to XClearArea, which crashed some servers.
+
+1/2/92 (bug fix) Fixed bug in TkMeasureChars occurring when maxChars
+is 0. Occasionally affected things like message window geometry.
+
+1/3/92 (new feature) Added procedures Tk_GetJustify, Tk_GetAnchor,
+Tk_GetCapStyle, and Tk_GetJoinStyle, plus support for these things
+in Tk_ConfigureWidget.
+
+---------------------- Release 1.4, 1/10/92 -------------------------
+
+1/12/92 (bug fix) TkMenubutton.c wasn't cleaning up mbPtr->varName
+properly during menubutton cleanup if an error occurred during
+menubutton creation.
+
+1/19/92 (bug fix) Fixed off-by-one bug in tkListbox.c that caused
+scrollbars to display a slider that was too large.
+
+2/10/92 (bug fix) Tk_CreateFileHandler didn't correctly handle case
+where new mask was specified for existing handler.
+
+2/13/92 (bug fix) Tk_DeleteAllBindings wasn't correctly removing
+bindings from the pattern table: only did the removal for the
+first pattern in a pattern list.
+
+2/15/92 (new feature) Added procedures Tk_DefineBitmap and
+Tk_SizeOfBitmap. Tk_GetBitmapFromData is now considered obsolete
+and probably shouldn't be used anymore. Tk_GetBitmapFromData
+is now implemented by calling Tk_DefineBitmap and Tk_GetBitmap.
+
+2/15/92 (new feature) Added "curselection" and "select clear" options
+to widget command for listboxes.
+
+2/15/92 (new feature) Added Tk_3DBorderColor procedure.
+
+2/17/92 (relaxed limitations) Changed scrollbars so they no longer limit
+the slider position to lie within the object's range: can scroll off the
+end of an object, if the object permits it. Changed listboxes and
+entries to explicitly prevent viewing off the ends. Also relaxed
+listbox index checks so that out-of-range indices are automatically
+adjust to fit within the listbox range.
+
+2/19/92 (bug fix) tkWindow.c tended to leave half-created windows around
+if a new window's name was found to be in use already. Fixed to clean
+them up.
+
+2/22/92 (new feature) Added -anchor, -bitmap, -height, -textvariable,
+-width options to labels, buttons, check buttons, menu buttons, and radio
+buttons. This means that (a) size can be controlled better, (b) bitmaps
+can be displayed in any buttons, (c) the position of the text within the
+button can be controlled, and (d) a button can be made to display the value
+of a variable, continuously updating itself. Also changed -selector option
+so that if it's specified as an empty string then no selector is drawn
+for the button.
+
+2/22/92 (new feature) Changed menus to support bitmaps in menu entries:
+added new -bitmap option for entries.
+
+2/26/92 (bug fix) "after" command, when invoked with just one argument,
+called Tk_Sleep rather than registering a timer handler and looping on
+Tk_DoOneEvent. As a result, it caused the application to become non-
+responsive to X events during the sleep. Changed to use a Tk_DoOneEvent
+loop so that it is responsive.
+
+2/26/92 (bug fix) Tk's main program didn't map the main window until
+after the startup script returned. Changed to map the window as a
+do-when-idle handler, so that scripts can cause the window to be
+mapped immediately with a call to "update" or "after".
+
+2/28/92 (bug fix) "wm withdraw" wasn't working if invoked before window
+was originally mapped: window got mapped anyway. Fixed so that the
+window doesn't get mapped as long as it's withdrawn.
+
+2/29/92 (new feature) Can use "focus none" to clear input focus.
+
+2/29/92 (bug fix) Fixed tkEvent.c to generate SubstructureNotify events
+properly. These weren't being generated previously.
+
+2/29/92 (bug fix) Fixed entries so that newline characters can be properly
+displayed (as `\x0a'). Had to change interface to TkDisplayChars in order
+to do this (added flags argument).
+
+2/29/92 (bug fix) Change Tk not to update size and position of top-level
+windows directly during calls like Tk_ResizeWindow. Instead, wait until
+actual event is received. This makes updates happen at same time as
+callbacks.
+
+3/6/92 (bug fix) TkMenubutton.c was dumping core when a menubutton was
+pressed at a time when there was no associated menu for the button.
+
+3/6/92 (new feature) Added Tk script library directory with official
+Tk initialization file "tk.tcl". Other procedures used by Tk are in
+other files. Tk procedures and variables all have names starting
+with "tk_". Also added Wish startup script "wish.tcl", which sources
+both the Tk and Tcl startup scripts. This means that things like
+auto-loading and abbreviation expansion are now available in wish.
+Added new variables tk_library, tk_priv, and tk_version.
+
+3/6/92 (new feature) It's now possible to set bindings for whole
+classes by using the class name in the bind command. For example,
+"bind Button <Enter> {puts stdout Hi!}" will cause a message to be
+printed whenever any mouse button is entered. Can also use "all"
+to set bindings for all widgets. Widget-specific bindings override
+class bindings which override "all" bindings.
+
+3/6/92 (reorganization) Changed buttons (all flavors) and listboxes to
+eliminate all hard-wired behavior. Instead, default behavior is set
+by class bindings in tk.tcl. Also set up class bindings for menus,
+menubuttons, and entries, which previously had no default behavior at
+all. Scrollbars and scales still have hard-wired behavior that can't
+be overridden.
+
+3/7/92 (look-and-feel change) Changed listboxes and entries and menus
+to use button 2 for scanning instead of button 3. This is more consistent
+with the official Motif use of button 2 for dragging.
+
+3/10/92 (new features) Added more options to "winfo" command: screencells,
+screendepth, screenmmheight, screenmmwidth, and screenvisual.
+
+3/13/92 (bug fix) Event sharing mechanism (tkShare.c) wasn't checking
+to see whether window was mapped before sharing events with it.
+
+3/16/92 (bug fix) Tk_SetInternalBorderWidth was passing wrong window to
+geometry-management procedures, causing core-dumps when menu buttons
+had their border widths changed.
+
+3/16/92 (bug fix) Menus were setting their geometry directory rather
+than using Tk_GeometryRequest mechanism.
+
+3/17/92 (new feature) Added -cursor option to all widgets to set the
+active cursor for the widget. Also added TK_CONFIG_ACTIVE_CURSOR
+configure type.
+
+3/18/92 (new feature) Implemented generalized screen coordinates to
+allow resolution-independent specification in many cases (but pixel-
+based coordinates are still OK). Added Tk_GetScreenMM(),
+Tk_GetPixels(), new configure types TK_CONFIG_SCREEN_MM and
+TK_CONFIG_PIXELS. Changed widgets to use this new configure types
+wherever possible (a few of the more complex cases still haven't
+been taken care of yet). Added "pixels" and "fpixels" options to
+"winfo" command.
+
+3/18/92 (new feature) First cut at canvas widgets is done and part of
+the official Tk now. Canvases display text and structured graphics,
+and allow you to bind commands to events related to the text and
+graphics.
+
+3/21/92 (new feature) Added new "place" command. It implements a
+new geometry manager that provides fixed placement, rubber-sheet
+placement, and combinations of the two. Eliminated the commands
+"move", "resize", and "map" that were provided by main.c but never
+officially supported; the placer provides all of this functionality.
+
+3/23/92 (bug fix) Fixed bug in tkWm.c where top-level windows were
+occasionally not being given the right size. The problem occurred
+when a string of resizes happened all in a row (such as deleting all
+the windows in an application and then recreating them).
+
+3/23/92 (new feature) Added Tk_CoordsToWindow procedure and
+"winfo containing" command. These may be used to locate the window
+containing a given point.
+
+3/28/92 (new feature) Added "-exportselection" option to listboxes,
+so that listbox selection need not necessarily be the X selection.
+
+4/12/92 (bug fix) Changed menu buttons to store name of menubutton
+in the associated variable, rather than the name of the menu. This
+is necessary in order to allow several menu buttons to share the
+same menu.
+*** POTENTIAL INCOMPATIBILITY ***
+
+4/12/92 (bug fix) Fixed core dump that occurred in tkError.c when
+removing the first error record from the error list.
+
+4/15/92 (bug fix) Fixed bug in tkBind.c that prevented <KeyPress-1>
+event specifications from being processed correctly: the "1" was
+treated as a button name rather than a keysym.
+
+4/18/92 (new feature) Added Tk_DefineCursor and Tk_UndefineCursor
+procedures.
+
+4/18/92 (new feature) Major revision to listboxes. Can now scroll and
+scan in both x and y, plus -exportselection option allows selection not
+to be exported. The "view" widget command has been replaced by "xview"
+and "yview", and the "scan" widget command has a new syntax.
+*** POTENTIAL INCOMPATIBILITY ***
+
+4/18/92 (new feature) Added -exportselection option to entries, so you
+can select whether you want the entry selection to be the X selection
+or not.
+
+4/24/92 (new features) Added TK_CONFIG_CUSTOM type to Tk_ConfigureWidget,
+plus added new flags TK_CONFIG_NULL_OK, TK_CONFIG_DONT_SET_DEFAULT,
+and TK_CONFIG_OPTION_SPECIFIED. Several other new types, such as
+TK_CONFIG_CAP_STYLE, were also added as part of implementing canvases.
+
+4/29/92 (bug fix) Changed "-selector" default for menus to have separate
+values for mono and color.
+
+4/30/92 (bug fix) Fixed bug in tkListbox.c where it occasionally generated
+bogus scroll commands (last index less than first).
+
+4/30/92 (reorganization) Moved demos directory to "library/demos".
+
+---------------------- Release 2.0, 5/1/92 -------------------------
+
+5/2/92 (bug fix) Fixed problem in tkListbox.c where it was doing too many
+redisplays after repeated insertions. Also reduced number of invocations
+of scrollbar commands.
+
+5/7/92 (portability improvement) Changed main.c not to use TK_EXCEPTION
+flag; it isn't needed and it causes problems on some systems.
+
+5/9/92 (bug fix) Plugged core leaks in tkListbox.c and tkBind.c
+
+5/9/92 (bug fix) TkBind.c was accidentally deleting bindings during
+attempts to print non-existent bindings.
+
+5/11/92 (bug fix) Maximum name length for applications (name used in
+"send" commands) was too short (only 20); increased to 1000. Also
+fixed bug related to over-long names that caused core dumps.
+
+5/13/92 (bug fix) tkShare.c was using a dangling pointer if a share
+group was deleted as a side-effect of a shared event.
+
+5/13/92 (bug fix) Various initialization and core leak problems in
+tkGC.c, tkSend.c, tkMenu.c, tkEvent.c, tkCanvas.c, tkCanvPoly.c,
+tkCanvLine.c, tkListbox.c, tkEntry.c.
+
+5/13/92 (bug fix) Empty entries could be scanned off the left edge,
+displaying a garbage character.
+
+5/13/92 (bug fix) Fixed a few problems with window manager interactions,
+such as tendency for windows to spontaneously shrink in size. By no
+means are all of the problems fixed, though.
+
+5/13/92 (performance optimization) Changed Tk_GeometryRequest not to
+invoke geometry manager unless requested size has changed.
+
+---------------------- Release 2.1, 5/14/92 -------------------------
+
+5/1/92 (new features) Added flags like TK_IDLE_EVENTS to Tk_DoWhenIdle,
+plus added "idletasks" option to "update" command. Tk_DoWhenIdle arguments
+look different now, but the change should be upward-compatible.
+
+5/17/92 (new feature/bug fix) Added support for VisibilityNotify events
+to the "bind" command. For some reason they weren't supported previously.
+
+5/17/92 (new feature) Added "tkwait" command.
+
+5/17/92 (new feature) Added "grab" command.
+
+5/17/92 (new feature) Added "-width" option to messages. Also changed
+messages to use the computed (i.e. desired) line length when displaying,
+not the actual width of the window.
+
+5/17/92 (bug fixes) Did some more fiddling with tkWm.c in the hopes
+of improving window manager interactions. Now there won't be more than
+one configure request outstanding to the wm at a time.
+
+5/17/92 (bug fix) Arrowheads on canvas lines weren't being translated
+or scaled correctly.
+
+5/20/92 (bug fix) Page-mode scrolling didn't work correctly for canvases
+(wrong windowUnits was passed to scrollbars).
+
+5/20/92 (bug fix) Changed scrollbars not to lose highlight when pointer
+leaves window with button down. Also changed redisplay to double-buffer
+for smoother redraws.
+
+5/21/92 (new feature) Added "gray50" and "gray25" as predefined bitmaps.
+
+5/22/92 (new feature) Buttons can now be disabled using the "-state" and
+"-disabledforeground configuration options. The "activate" and "deactivate"
+widget commands for buttons are now obsolete and will go away soon.
+Please change Tcl scripts not to use them.
+
+5/23/92 (new feature) Entries can now be disabled using the "-state"
+config option. Also improved class bindings for entries to keep the
+cursor visible in the window when operations occur. Also made slight
+improvements in the way redisplay is done.
+
+5/23/92 (new feature) Added "-textvariable" option to entries so that
+the text in an entry can be tied to the value of a global variable in
+a fashion similar to buttons.
+
+5/27/92 (new feature) Added "-textvariable" and "-anchor" options to
+messages.
+
+5/28/92 (new feature) Added "-padx" and "-pady" and "-underline" options
+to menubuttons.
+
+5/28/92 (feature change) Changed "-width" and "-height" options on
+all flavors of buttons and menubuttons so that they are orthogonal
+to "-padx" and "-pady". It used to be that -width overrode -padx
+(no padding). Now they accumulate.
+
+5/29/92 (new feature) Added "-disabledforeground" option to menus and
+all flavors of buttons (can specify color for disabled things rather
+than just using stipple to gray out).
+
+5/29/92 (new features) Added many new options to menu entries:
+-activebackground, -background, -font, -state, -underline. The
+"disable" and "enable" widget commands for menus are now obsolete
+and will go away soon. Please change Tcl scripts not to use them.
+
+5/29/92 (new features) Added "atom" and "atomname" options to "winfo"
+command.
+
+5/29/92 (new feature) Wrote tk_listboxSingleSelect procedure, which
+can be used to change listbox behavior so that only a single item is
+selected at once.
+
+6/1/92 (new feature) Added new modifier names "Meta" and "Alt" for
+"bind" command.
+
+6/3/92 (new feature) Added "winfo toplevel" command.
+
+6/3/92 (new feature) Made several changes for greater Motif compliance,
+including:
+ - menu retention if you click and release in the menu button,
+ - keyboard traversal of menus (see traversal.man)
+ - no widget flashing if you set $tk_strictMotif to 1
+
+6/15/92 (bug fix) Fixed problem in tkBind.c where command string for a
+binding could get reallocated while the command was being executed (e.g.
+bindings that delete or change themselves).
+
+6/15/92 (bug fix) Don't allow "tabWidth" field to become zero in tkFont.c:
+can cause core dumps for fonts that don't enough information to compute
+tab widths.
+
+6/19/92 (bug fix) Fixed bug in binding mechanism that caused structure-
+related events to be reported both to the correct window and its parent.
+
+7/14/92 (bug fix) Changed tkColor.c not to free colors for visual types
+StaticGray or StaticColor.
+
+7/15/92 (new feature) Text widgets now exist. They display any number of
+lines of text with a variety of display formats, and include hypertext
+facilities. See the manual page for details.
+
+7/20/92 (bug fix) If a top-level window was put in the iconic state to
+begin with, it could be deiconified with "wm deiconify .foo" until it had
+first been deiconified by hand from the window manager. Tk was getting
+confused and thought the window was mapped when it wasn't.
+
+7/29/92 (bug fix) Don't permit rectangles or ovals to have zero-sized
+dimensions. Round up to at least one pixel.
+
+7/29/92 (new features) Major upgrade to canvases:
+ - new item types: arc, window, bitmap
+ - added Bezier spline support for lines and polygons
+ - rectangles and ovals now center their outlines on the shape,
+ rather than drawing them entirely inside the shape
+ - new "coords" and "bbox" widget commands
+ - new "-tags" option for all item types.
+ - new "-confine" option to prevent scrolling off edge of canvas.
+
+8/6/92 (new feature) Added "-width" and "-height" options to frames.
+The "-geometry" option is now obsolete and should be removed from Tcl
+scripts: it may go away in the future.
+
+8/7/92 (bug fix) Error messages in Tk_ParseArgv were sometimes including
+the option name where they should have included its value.
+
+---------------------- Release 2.2, 8/7/92 -------------------------
+
+8/7/92 (bug fix) Changed tkCanvas.c to be more conservative in the area
+it passes to XCopyArea.
+
+8/8/92 (bug fix) Fixed bug in tkTextDisp.c that sometimes caused core
+dumps when text views changed (e.g. typing return on last line of screen).
+
+8/8/92 (bug fix) Fixed bug in menu.tcl that caused errors when using
+keyboard to traverse over separator menu entries.
+
+8/10/92 (bug fix) Changed to use OPEN_MAX instead of MAX_FD to compute
+maximum # of open files.
+
+8/10/92 (bug fix) Canvases weren't updating scrollbars on window size
+changes. They also weren't recentering canvases on window size changes.
+
+8/10/92 (bug fix) There were still a few places where commands were being
+invoked at local level instead of global level (e.g. commands associated
+with buttons and menu entries).
+
+8/10/92 (bug fix) TkBind.c used to ignore explicit shift modifiers for
+all keys (i.e. <Shift-Tab> was treated the same as <Tab>). Modified to
+allow explicit request for shift modifier, like <Shift-Tab>.
+
+8/13/92 (feature change) Changed default fonts to request "Adobe" fonts
+explicitly.
+
+8/16/92 (bug fixes) Modified tkCanvArc.c and tkTrig.c to increase slightly
+the bounding boxes for arcs, in order to make sure that proper redisplay
+occurs when arcs are moved (little turds were getting left behind).
+
+8/16/92 (bug fix) Modified tkCanvas.c not to redraw at all if the redisplay
+area is off the screen. Also, only do a background clear for the portion
+of the redraw area that is on-screen. Also, reduced size of off-screen
+pixmaps used for redisplaying, which speeds up redisplay in some cases.
+
+8/19/92 (bug fix) Canvases that were taller than wide were not being
+redisplayed properly.
+
+8/20/92 (new feature) Added Tk_CreateGenericHandler procedure for trapping
+all X events (useful for tracing, watching non-Tk windows, etc.).
+
+8/21/92 (bug fix) Widgets weren't always being notified when they got
+the focus back again (the problem had to do with grabs and menus in
+particular).
+
+8/21/92 (new feature) Added "-state" option to scale widgets.
+
+8/22/92 (new feature) Changed tkBitmap.c to allow tilde-substitution
+to occur in bitmap file names.
+
+---------------------- Release 2.3, 8/24/92 -------------------------
+
+8/27/92 (bug fix) Changes to -activebackground and -activeforeground options
+for menubuttons were being lost.
+
+8/27/92 (bug fix) Entries were selecting last character when a B1-drag
+occurred past the right edge of the text.
+
+8/28/92 (bug fix) Fixed bug in canvases where a grab during a button
+press caused the canvas state to lock up so that it didn't select a
+new current item.
+
+9/7/92 (bug fix) Changed tkMenu.c to accept numerical menu indices that
+are out of range; now it just rounds them off to the nearest existing
+entry.
+
+9/7/92 (bug fix) Fixed bug in tkTextDisp.c that caused core dumps when
+invoking "yview -pickplace" widget command on texts that are too small
+to hold any lines at all.
+
+9/11/92 (bug fix) Fixed bug in tkTextDisp.c that caused core dumps
+when adding tags to non-existent lines.
+
+9/11/92 (bug fix) Line items in canvases didn't permit an empty fill
+color (i.e. couldn't make them transparent).
+
+9/14/92 (reorganization) Changed manual entries to use .1, .3, and .n
+extensions. Added "install" target to Makefile to suggest how Tk should
+be installed.
+
+9/16/92 (bug fix) Changed tkSend.c to always specify the root window of
+screen 0 rather than using DefaultRootWindow. DefaultRootWindow doesn't
+always go to screen 0 on displays with multiple screens, which can result
+in send's not being possible between the screens.
+
+9/18/92 (new feature) Added three new options to "wm" command: "protocol",
+"client", and "command". These provide support for window manager protocols
+such as WM_DELETE_WINDOW and WM_TAKE_FOCUS, plus support for the
+WM_CLIENT_MACHINE and WM_COMMAND properties.
+
+9/30/92 (new feature) Implemented color model support, including
+"tk colormodel" command and Tk_GetColorModel and Tk_SetColorModel
+procedures. These allow you to force mono operation even on a color
+display. Also changed color allocation not to give errors when colors
+run out, but just to switch to a mono color model.
+
+10/1/92 (bug fixes) Fixed two bugs in tkTextBTree.c that caused core dumps
+during text deletion.
+
+10/5/92 (bug work-around) Changed tkColor.c to ignore errors when freeing
+colors. This is needed to work around improper reference count management
+for colormap entries under X11/NeWS.
+
+10/7/92 (new feature) Added support for different visual types, including
+procedures Tk_SetWindowVisual and Tk_SetWindowColormap, plus macros
+Tk_Visual, Tk_Depth, and Tk_Colormap. The code for this was contributed
+by Paul Mackerras.
+
+10/7/92 (new feature) Added Tk_IsTopLevel macro.
+
+10/12/92 (bug fix) Fixed bug in tk.tcl that caused torn-off menus with
+cascaded children not to track mouse motion correctly (the cascade
+switched in response to mouse motions within the cascaded child).
+
+10/12/92 (new feature) Major changes to focus handling:
+(a) Tk watches FocusIn and FocusOut events for focus changes, not Enter
+ and Leave, so it will work better with explicit-focus-model window
+ managers (e.g. mwm in default mode).
+(b) Tk generates FocusIn and FocusOut events for the focus window now.
+ The old procedural interface (via Tk_CreateFocusHandler) is obsolete
+ and is no longer used inside Tk. It is still supported for
+ compatibility, but won't be for long. You should change your code
+ to use FocusIn and FocusOut events instead.
+(c) The model for FocusIn and FocusOut events is different than the
+ one described in Xlib documentation. See the "focus" manual entry
+ for details.
+(d) If there is no input focus then keyboard events are discarded. They
+ used to be directed to the mouse pointer window, although this wasn't
+ documented. The focus now defaults to the root window.
+*** POTENTIAL INCOMPATIBILITY ***
+
+10/15/92 (bug fix) Fixed text items in canvases where they didn't
+display the insertion cursor if the item had no characters in it.
+
+10/26/92 (bug fix) Fixed bug in tkSelect.c that occasionally caused
+BadWindow X protocol errors when retrieving the selection. Tk wasn't
+making sure that a window existed before using it to retrieve the
+selection.
+
+10/30/92 (feature change) Changed canvases so that if the scroll region
+is smaller than the window and -confine is on, the scroll region isn't
+forced to be centered in the window; it can be anywhere that meets the
+confinement restrictions.
+
+11/2/92 (new feature) Added "winfo exists" command.
+
+11/5/92 (new feature) Changed DoWhenIdle handlers so that if a new
+when-idle handler is created as a side-effect of another when-idle
+handler, the new handler isn't invoked until Tk has first checked
+for other events to process.
+
+11/6/92 (bug fixes, new features) Major overhaul of window manager
+interface:
+(a) Tk should now work with virtual-root window managers;
+(b) windows will now place more accurately on the screen and stay where
+ they're supposed to;
+(c) size changes handled more reliably;
+(d) code now works robustly in the face of withdrawals followed
+ immediately by deiconifications.
+(e) Added new procedure Tk_GetVRootInfo and new options to "winfo" command:
+ vrootx, vrooty, vrootwidth, vrootheight.
+(f) Added "overrideredirect" option to "wm".
+(g) Fixed bug where change in width-only via "wm geom" didn't always work
+ (min and max window sizes weren't being set properly for the wm).
+
+11/6/92 (bug fixes) Modified menus so that they work correctly with
+virtual root window managers. Also fixed bug where menus didn't move
+along with their associated windows, so that the menu popped up at
+the old location of the window rather than its new location.
+
+11/9/92 (new constraint) Made it illegal to give windows names that
+start with upper-case letters, since such names will goof up the
+option database by appearing to be classes rather than names.
+*** POTENTIAL INCOMPATIBILITY ***
+
+11/10/92 (new feature) Added Postscript output to canvases.
+
+11/13/92 (bug fix) Changed default for maximum size passed to window
+manager from 1000000 (which causes some wm's to make windows too large
+when "maximized") to the size of the display.
+
+11/14/92 (feature change) Major overhaul of menubuttons and pull-down
+menus. Removed event-sharing code, including Tk_ShareEvents and
+Tk_UnshareEvents. The -variable option for menubuttons has been
+removed,and the "post" and "unpost" widget commands for menubuttons
+no longer exist. The "post" widget command for menus no longer
+allows a group option. The procedure tk_menus has been replaced
+with a new procedure, tk_menuBar, which has a slightly different
+interface.
+*** POTENTIAL INCOMPATIBILITY ***
+
+11/20/92 (new features, feature changes) Major overhaul of grab
+mechanism to produce more correct event streams. Also changed Tcl
+commands to require explicit window for grab releases (makes it
+possible for grabs to work on multiple displays simultaneously).
+The old "grab none" command no longer exists, but new options
+have been added: "current", "release", "set", and "status".
+*** POTENTIAL INCOMPATIBILITY ***
+
+11/20/92 (new feature) Use TK_LIBRARY environment variable to set library
+directory location, if it is defined. Otherwise fall back on usual
+compiled-in value.
+
+11/25/92 (bug fix) "wm grid" command was using wrong window.
+
+11/29/92 (bug fix) Fixed core dump that occurred when trying to use
+placer on top-level windows: return error instead.
+
+11/29/92 (bug fix) Selection retrieval wasn't making sure that the window
+on whose behalf selection is being retrieved actually exists.
+
+12/3/92 (new feature) Added support for Mode_switch key to support the
+full ISO character set. Also added event handlers for MappingNotify
+events so that Tk updates itself in response to keycode and modifier
+changes.
+
+12/6/92 (bug fix) Ignore recursive attempts to destroy window.
+
+12/9/92 (new demos) Added "tcolor" and "rmt" demos.
+
+12/10/92 (new features) Added "yposition" widget command for menus,
+changed "delete" widget command to take an optional second index,
+and changed -command option for cascade entries so that it is
+invoked when the entry is activated rather than when it is invoked.
+*** POTENTIAL INCOMPATIBILITY ***
+
+12/12/92 (implementation change) Changed the procedures Tk_FreeBitmap,
+Tk_NameOfBitmap, Tk_SizeOfBitmap, Tk_FreeCursor, Tk_NameOfCursor, and
+Tk_FreeGC to require an addition Display argument. This is needed for
+Tk to function correctly when an application has windows on multiple
+displays.
+*** POTENTIAL INCOMPATIBILITY ***
+
+12/12/92 (new feature) Started creating a test suite. Right now it
+only has a few tests.
+
+12/12/92 (new feature) Modified the packer so that a window can be
+packed in descendants of its parent (used to be restricted to the
+parent alone). This makes it possible to hide extra windows used
+for geometry management. Also, can use generalized screen distances
+in the "pack" command.
+
+12/16/92 (feature change) Boolean options such as -exportselection now
+print as 0/1 rather than true/false (both the default and current values
+print this way). This makes it easier to use these values in expressions.
+*** POTENTIAL INCOMPATIBILITY ***
+
+12/16/92 (name change) The classes "RadioButton" and "CheckButton" have
+been renamed "Radiobutton" and "Checkbutton" for consistency. From now
+on widget class names will have exactly one capital letter.
+*** POTENTIAL INCOMPATIBILITY ***
+
+12/16/92 (new feature) Added -setgrid option to listboxes.
+
+12/16/92 (new feature) The "destroy" command, and the "delete" widget
+command for canvases, now accept any number of arguments, including
+zero.
+
+12/16/92 (new feature) Changed internal TkBindError procedure to
+Tk_BackgroundError and exported it to Tk clients.
+
+12/16/92 (option name change) Changed the place command's "dependents"
+option to "slaves" for better consistency with documentation.
+*** POTENTIAL INCOMPATIBILITY ***
+
+12/16/92 (name changes) Renamed the "cursor*" options in entries and
+canvases to "insert*". Also renamed the "cursor" index to "insert" and
+the "cursor" widget command to "icursor". This was done to avoid
+confusion between the mouse cursor and the insertion cursor.
+*** POTENTIAL INCOMPATIBILITY ***
+
+---------------------- Release 3.0, 12/17/92 -------------------------
+
+12/17/92 (bug fix) Fixed dangling-pointer bug in canvases that occurred
+if a <LeaveNotify> binding deleted the current item.
+
+12/18/92 (bug fix) Core dump occurred if "wm" invoked with no arguments.
+Also, tkWm.c wasn't properly setting WM_CLASS property on application
+startup.
+
+12/18/92 (incorrect documentation) Updated manual entries for Tk_FreeGC,
+Tk_FreeCursor, and Tk_FreeBitmap to reflect new interface that requires
+"display" argument.
+
+12/18/92 (missing documentation) Added documentation for the canvas
+"postscript" command, which was missing in the 3.0 release.
+
+12/21/92 (bug fixes) There were lots of problems with the new installation
+targets in the Makefiles, such as using "cp -f" and not installing
+prolog.ps. Made several other miscellaneous improvements to Makefile.
+
+12/21/92 (bug fix) Arrowheads on canvas line items weren't moving properly
+after coordinate changes made with the "coords" widget command.
+
+12/21/92 (bug fix) If top-level window was initially withdrawn, couldn't
+ever deiconify it again.
+
+12/21/92 (bug fix) Double-button event sequences didn't always trigger
+properly when grabs were in effect.
+
+12/22/92 (bug fix) The packer didn't display any top or bottom windows
+after a left or right expanded window, and vice versa. Also made the
+distribution of space among expanded windows more even.
+
+12/28/92 (new features) Several improvements to selection:
+(a) Added procedures Tk_ClearSelection and Tk_DeleteSelHandler.
+(b) Added "clear" and "own" options to "selection" command, extended
+ "handle" option to delete handlers.
+(c) Error returns from "selection handle" scripts are now turned into
+ selection retrieval errors ("no such selection") rather than an
+ empty selection.
+(d) Tk responds automatically for targets APPLICATION (name of application,
+ so you can "send" to it) and WINDOW_NAME (name of window within
+ application.
+(e) Added test file "select.test" to test suite.
+
+12/28/92 (bug fix) Fixed problem with flashing menus that occurred
+because menu.tcl was willing to unpost and then immediately repost
+the same menu.
+
+1/6/93 (bug fix) Test for UnmapNotify events in tkPack.c used = instead
+of ==.
+
+1/21/93 (bug fix) Changed many widgets to eliminate use of
+DefaultVisualofScreen, DefaultColormap, etc. and use the visuals
+and colormaps for the actual windows instead. Also changed to
+inherit colormaps and windows from parent by default.
+
+1/21/93 (new features) Added new winfo options "cells", "depth", and
+"visual".
+
+1/23/93 (bug fix) Fixed problem with text display that could result
+in negative XCopyArea heights being sent to X server. This causes some
+servers (e.g. some versions of OpenWindows) to crash.
+
+1/25/93 (new feature) Added -postcommand option to menus, so that menus
+can be reconfigured before each posting.
+
+1/29/93 (feature change) Changed %X and %Y in bindings so that they
+refer to the virtual root rather than the true root. Although
+potentially incompatible, this change should almost always "do the
+right thing".
+*** POTENTIAL INCOMPATIBILITY ***
+
+1/31/93 (bug fix) Changed "send" code to grab server while updating
+the registry property (before this fix, two programs could allocate
+the same interpreter name if they started up simultaneously). In
+order to make this fix I had to change the code for reclaiming
+names of dead interpreters in a way that sometimes allows dead
+interpreters to persist in the registry.
+
+2/1/93 (feature change) Changed entries to allow leftmost "visible"
+character to be the end of the text (i.e. no characters actually visible).
+This is needed so that the cursor can be displayed even if the last
+actual character is too wide to fit in the window.
+
+2/3/93 (bug fix) Fixed two bugs in tkFocus.c: (a) FocusIn events
+were getting lost in some cases because the focus window hadn't been
+created yet (e.g. new top-level window pops up underneath the mouse);
+(b) Tk was accidentally triggering FocusOut events when the mouse
+moved from a top-level window to one of its children.
+
+2/4/93 (new feature) Added "visibility" option to "tkwait" command to make
+it easier to wait for a new window to appear on the screen.
+
+---------------------- Release 3.1, 2/5/93 -------------------------
+
+2/10/93 (installation improvements) Makefile improvements: added RANLIB
+variable for easier Sys-V installation, changed to use INCLUDE_DIR
+properly, and added SHELL variable for SGI systems.
+
+---------------------- Release 3.2, 2/11/93 -------------------------
+
+2/11/93 (new feature) Added "wm state" command, and improved wm so that
+the right thing will happen if you invoke "wm iconify" when a window is
+withdrawn.
+
+2/14/93 (bug fix) When -colormap option was used in generating Postscript
+for canvases, Tk didn't add an extra space after the color command.
+
+2/14/93 (new feature) Changed "extern" declarations in tk.h to "EXTERN",
+which will use the definition of EXTERN from tcl.h and work correctly
+in C++ programs.
+
+2/18/93 (bug fix) Item-specific bindings weren't getting deleted from
+canvas items when the items were deleted. As a result, they could
+suddenly re-appear for new items if the new items were allocated a
+record at the same addresses as the old ones.
+
+2/18/93 (feature reversal) Changed "after" back again, so that it sleeps
+*without* responding to events when it is invoked with just one argument;
+can always use tkwait plus after with additional arguments to achieve
+the effect of responding to events.
+*** POTENTIAL INCOMPATIBILITY ***
+
+2/20/93 (bug fix) Fixed bug in tkWindow.c where colormaps weren't being
+set correctly for new top-level windows on different screens than their
+parents (the bug results in X protocol errors: "invalid Colormap
+parameter").
+
+2/22/93 (bug fix) Changed "#!/usr/local/wish" in demo scripts to
+"#!/usr/local/bin/wish" to reflect new location of binary.
+
+2/22/93 (new feature) Added new reliefs "groove" and "ridge".
+
+2/25/93 (new feature) Added new built-in bitmaps: "error", "hourglass",
+"info", "question", "questhead", and "warning". Also added new demo in
+"widget" to display all of these (under the Miscellaneous menu).
+
+2/25/93 (improved implementation) Changed DrawText procedure in
+prolog for outputting Postscript from canvases to use stringwidth
+instead of charpath+pathbbox: avoids limitcheck problems with long
+strings, and also properly includes space characters in calculation.
+
+2/25/93 (bug fix) Fixed several bugs in library/menu.tcl that caused
+menu traversal to mis-behave when menu had no entries.
+
+2/26/93 (new feature) Added "wm frame" command.
+
+3/6/93 (bug fix) Mwm in click-to-focus mode was goofing up grabs so that
+pull-down menus were sometimes unresponsive. Modified tk.tcl to ignore
+the spurious B1-Enter events generated by mwm, plus modified tkGrab.c to
+release simulated button grabs correctly.
+
+3/8/93 (bug fix) Tk had wrong interpretation of "lbearing" font metric,
+which caused text to be displayed at the wrong horizontal position in
+several places (labels/buttons, listboxes, canvas text, scales). This
+change will cause slight changes in the way certain widgets are
+displayed.
+
+3/12/93 (bug fix) Fixed core dumps that occurred in tkEntry.c because of
+zero values in entryPtr->avgWidth.
+
+3/12/93 (bug fix) Tk_CoordsToWindow was using root coordinates always.
+Changed to use virtual-root coordinates when a virtual-root window
+manager is being used. Before this fix, "winfo containing" didn't
+return the correct window under virtual-root window managers.
+
+3/18/93 (bug fix) Modified tkWm.c so that Tk doesn't fight with window
+manager over position of window; it just takes what the window manager
+gives it.
+
+3/21/93 (new feature) Changed menus to display cascade entries with
+standard Motif arrows at right side.a
+
+3/22/93 (bug fix) Fixed bug in tkPack.c that was causing memory to
+get trashed with the integer value 1.
+
+3/22/93 (bug fix) Canvas text didn't print correctly if it contained
+an open paren (or other special character) immediately followed by
+an octal digit.
+
+3/22/93 (bug fix) Text widgets didn't redisplay properly in cases
+where two or more groups of lines both got taller at the same time
+(e.g. from tag changes), causing two separate bit copies where the
+first bit copy's target area overlapped the source area for
+the second bit copy.
+
+4/1/93 (bug fix) Changed canvases to use ISO Latin-1 font encoding
+if that's supported by the Postscript interpreter. Also added workaround
+for bug in NeWSprint related to stipple fills.
+
+4/1/93 (bug fixes) Made various changes to focusing and grabs to
+eliminate extraneous focus events and generally improve behavior.
+
+4/2/93 (bug fix) Modified tkWm.c not to wait indefinitely for the window
+manager to map or reconfigure a window: this led to deadlock in some
+situations, such as creating a new top-level window with a grab held.
+
+4/19/93 (bug fix) Fixed another bug in tkWm.c that caused windows to walk
+across the screen in some situations. Also fixed problem where rapid
+posting and unposting of cascaded submenus (or menus?) could cause Tk
+to become confused about whether or not a window is mapped (added
+TkWmUnmapWindow procedure to make top-level unmaps synchronous).
+
+4/24/93 (feature change) Changed the "after" command to allow times
+less than or equal to 0, and to use 0 whenever they occur.
+
+4/26/93 (new feature) Implemented security check for "send" as proposed
+by Bennett Todd: incoming sends are now rejected unless (a) xhost-style
+access control is enabled and (b) the list of authorized hosts is
+empty. In other words, you have to use xauth to use send. This feature
+can be disabled by setting the TK_NO_SECURITY flag at compile-time.
+
+5/15/93 (improvement) Switched to use Tcl_PrintDouble whenever returning
+real values as Tcl results. This potentially allows higher precision.
+Switched to use %.15g whenever printing reals in Postscript files.
+However, the change Tcl_PrintDouble causes incompatibilities. For
+now, it's disabled with a macro in tclInt.h that redefines Tcl_PrintDouble.
+Tk 4.0 will delete the macro, and you can also delete it now if you
+want the better (but incompatible) behavior.
+
+5/19/93 (bug fix) Fixed divide-by-zero problem that could occur in
+closeness calculations for canvas oval items.
+
+5/30/93 (bug fix) PROP and CONFIG were accidentally #defined to the same
+value in tkBind.c, which could cause incorrect %-substitutions in event
+bindings in a few exotic cases.
+
+6/4/93 (improvement) Changed to use GNU autoconfig for configuration.
+Makefile format changed, and Tcl is no longer automatically included
+in Tk releases.
+
+6/7/93 (bug fix) Fixed off-by-one error in rounding negative coordinates
+during redisplay of canvases.
+
+6/9/93 (feature improvement) Modified default bindings for entries to
+keep one character visible to the left of the cursor during backspaces.
+
+6/18/93 (feature improvement) Added patchlevel.h, for use in coordinating
+future patch releases, and also added tk_patchLevel variable to make the
+patch level available in scripts.
+
+6/26/93 (bug fix) Fixed numeric problems in scales that occurred with
+very large scale values.
+
+6/26/93 (bug fix) Polygon items in canvases could cause core dumps if
+the "coords" widget command was used to add one new coordinate.
+
+6/26/93 (bug fix) Changed canvases to handle large stipple patterns
+gracefully (stipples used to jump around during redisplay and lose
+coherency).
+
+7/1/93 (syntax change, new feature) Implemented the new packer syntax
+as described in the book. For now the old syntax will continue to be
+supported too. Converting over is straightforward except (a) use
+"-anchor" instead of "frame", and (b) padding is different (separate
+internal and external padding, plus pad amounts are *on each side*
+instead of total). Also added "pack propagate" command for keeping
+the packer from setting the master's requested size.
+
+7/1/93 Changed copyright notices. The effect is the same as with the
+old notices, but the new notices more clearly disclaim liability.
+
+7/7/93 (new feature) Added support for window stacking order. Windows
+will now stack in the order created (most recent on top), plus "raise"
+and "lower" commands may be used to restack (Tk_RestackWindow procedure
+is available from C level).
+
+7/7/93 (reorganization) Moved main.c to tkMain.c, reorganized it to
+call Tcl_AppInit just like tclsh does, and added argv0 variable to contain
+application name, and added default Tcl_AppInit procedure for wish.
+Also added tkTest.c to hold C code for testing.
+
+7/7/93 (new feature) Added new Tk-specific "exit" command, which cleans
+up properly before exiting. It replaces the Tcl "exit" command, and
+can be used in place of "destroy .".
+
+7/9/93 (new features) Added tk_dialog library procedure that creates
+dialogs with a bitmap, message, and any number of buttons. Also changed
+default tkerror procedure to use tk_dialog plus offer the user a chance
+to see a Tcl stack trace.
+
+-------------------- Release 3.3 Beta 1, 7/9/93 -------------------------
+
+7/12/93 (configuration changes) Eliminated leading blank line in
+configure script; provided separate targets in Makefile for installing
+binary and non-binary information; fixed -lnsl and -lsocket handling
+in configure; added autoconf support for fd_set type; check for various
+typedefs like mode_t and size_t, and provide substitutes if they
+don't exist; don't include tkAppInit.o in libtk.a; try to locate the
+X includes and library in all of the standard places for various systems.
+
+7/14/93 (new feature) Modified tkMain.c so that it stores the value
+of the -display command-line option into the DISPLAY environment
+variable, if it is specified.
+
+7/15/93 (feature removal) Removed auto-initialization feature from
+Tk_ConfigureWidget, so that you must once again initialize all fields
+of a widget record before calling Tk_ConfigureWidget. This restores
+the behavior back to what it was in Tk 3.2.
+
+7/16/93 (bug fix) Modified tkBind.c to ignore the Caps Lock modifier
+unless it is explicitly requested in a binding. Without this fix,
+buttons and menus and other things didn't work if the Caps Lock key
+was active.
+
+-------------------- Release 3.3 Beta 2, 7/21/93 -------------------------
+
+7/21/93 (new feature) Change "make install" so that it will modify the
+#! lines on demo scripts to reflect the place where the wish binary
+is installed.
+
+7/23/93 (new feature) Added Tk_MainWindow procedure that returns the
+main window associated with a Tcl interpreter. This is intended for
+use by Tcl_AppInit and other initialization procedures.
+
+7/24/93 (configuration improvements) Changed configure script not to
+omplain about "fd_set" missing if it's defined in <sys/select.h>.
+
+7/28/93 (bug fix) "Bad Match - parameter mismatch" errors were
+sometimes occurring when several top-level windows got created
+at the same time, due to wrong choice of sibling when stacking
+windows.
+
+8/14/93 (new feature) Added support for tcl_prompt1 and tcl_prompt2
+to wish main program: makes prompts user-settable.
+
+8/19/93 (bug fix) Bindings to event sequences like "aD" never matched
+because the Shift key has to be pressed before D. Modified Tk to
+ignore extraneous keypresses if they are for modifier keys.
+
+8/26/93 (configuration changes) Added Tk_Init, modified Tcl_AppInit
+procedures to use it and Tcl_Init. Added support for .wishrc file.
+
+8/28/93 (new feature) The main window is now a legitimate toplevel
+widget.
+
+-------------------- Release 3.3 Beta 3, 8/30/93 -------------------------
+
+9/2/93 (bug fix) The packer wasn't always relaying out a master after
+changes to some of the configuration options of its slaves.
+
+9/2/93 (bug fix) The binding mechanism made it impossible for patterns
+like <Double-ButtonRelease-1> to ever match.
+
+9/2/93 (bug fix) Fixed core dump that occurred for bitmap canvas items
+if Postscript is generated but no -bitmap option has been specified.
+
+9/4/93 (enhancement) Slight improvements to menu traversal: set menu
+traversal bindings for menubar window in tk_menuBar, plus trigger
+traversal on <Any-Alt-Keypress> instead of <Alt-Keypress>.
+
+9/9/93 (bug fix) Changed tkBind.c so that the Num_Lock key doesn't
+prevent events from triggering bindings.
+
+9/9/93 (bug fix) Changed tkOption.c to always fetch RESOURCE_MANAGER
+property from root window of screen 0, rather than using default
+screen.
+
+9/9/93 (bug fix) Entry widgets weren't allocating quite enough width
+for themselves. Fixed this and changed the size computation to match
+what's done for buttons and texts.
+
+9/16/93 (bug fix) Changed tkMain.c not to call exit C procedure directly;
+instead always invoke "exit" Tcl command so that application can redefine
+the command to do additional cleanup.
+
+-------------------- Release 3.3, 9/29/93 -------------------------
+
+9/30/93 (bug fix) Packer wasn't unmapping slaves when master got deleted.
+
+9/30/93 (bug fix) Binding event sequences such as <Right> were being
+misprinted as ASCII characters such as "S".
+
+10/6/93 (bug fix) Canvases weren't unmapping window items when the canvas
+got unmapped, which caused problems for window items whose windows weren't
+descendants of the canvas (they got left on the screen).
+
+10/7/93 (feature change) NULL proc arguments to Tk_CreateFileHandler used
+to have a special undocumented meaning (fd was display); eliminated this
+special interpretation.
+
+10/7/93 (configuration change) Eliminated dependency of tkMain.c on
+tkInt.h and tkConfig.h, so that it's easier for people to copy the file
+out of the source directory to make modified versions.
+
+10/8/93 (bug fix) 3.0 introduced a bug where the class of the application
+wasn't being set properly, so options based on the application class
+weren't triggering. Fixed by adding new argument to Tk_CreateMainWindow.
+
+10/11/93 (bug fix) Fixed bug in tkTextBTree.c where some deletions would
+cause core dumps due to halfwayLinePtr not getting set correctly.
+
+10/18/93 (bug fix) Fixed a couple of bugs that made it hard to actually
+display N characters in an entry with "-width N" (tended to scroll the
+entry so that only N-1 characters were visible at once).
+
+10/22/93 (bug fix) During configuration, XINCLUDE_DIR and XLIBRARY_DIR
+weren't overriding xmkmf like they were supposed to.
+
+10/23/93 (new feature) Allow negative scale factors in canvas "scale"
+widget command.
+
+10/23/93 (bug fix) Grabs weren't being cleaned up right if the grab
+window was deleted, causing core-dumps in some cases.
+
+10/23/93 (bug fix) tk_TextSelectTo wasn't checking to be sure that
+the "anchor" mark exists.
+
+10/27/93 (bug fix) Fixed core dump that could occur in a text widget if
+the scroll command modifies the text.
+
+11/1/93 (bug fix) Change texts so that the -yscrollcommand option is
+invoked at display time, not when the window is re-layed out. This
+eliminated various core dumps that could occur if -yscrollcommand modified
+the text.
+
+-------------------- Release 3.4, 11/04/93 -------------------------
+
+Note: there is no 3.5 release. It was flawed and was thus withdrawn
+shortly after it was released.
+
+11/12/93 (bug fix) TkMain.c didn't compile on some systems because of
+R_OK in call to "access". Changed to eliminate call to "access".
+
+-------------------- Release 3.6, 11/26/93 -------------------------
+
+11/10/93 (bug fix) Packer and placer didn't always reposition a window
+correctly if it was managed inside a neice or lower descendant (using
+"-in" option) and the neice's parent moved.
+
+11/24/93 (bug fix) Fixed time problem in selection (retrievals could
+fail if retriever hasn't received any X events since selection was
+made, so that time of retrieval appears to be older than time of
+selection). Selection code is now much less picky about times, both
+on retrieving and supplying sides.
+
+12/2/93 (new feature) Changed arrow-head drawing code for canvas
+lines to draw a 0-width outline in addition to filling the area:
+this produces much nicer, more symmetrical displays.
+
+12/2/93 (bug fix) When colors ran out, Tk was invoking "tkerror"
+when its state was internally inconsistent, which could cause
+core dumps in some situations (e.g. if tkerror used the same color
+that caused colors to run out). Changed notification to occur
+as a when-idle handler.
+
+12/3/93 (bug fix) During a global grab, Tk wasn't including PointerMotion
+in the list of grabbed events, so pointer motion couldn't be tracked
+outside the grabbing application.
+
+12/3/93 (bug fix) Canvases didn't handle smoothed lines correctly
+when they only contained two points.
+
+12/3/93 (bug fix) Fixed bug in tkWindow.c where certain kinds of
+errors during window creation could cause Destroy events to be generated
+for a window that was never completely initialized.
+
+12/13/93 (bug fix) Fixed bug in tkTextDisp.c that resulted in core
+dumps at line 1467 under exmh. The exact situation is that a text
+widget was being redisplayed at a time when it had a -yscrollcommand
+option but hadn't yet been mapped onto the screen.
+
+12/17/93 (bug fix) Fixed bug in tkWindow.c whereby new top-level windows
+with non-default visuals still inherited border pixmap from parent (root),
+which could cause visual clash and X error.
+
+12/17/93 (bug fix) Fixed bug in tkTextDisp.c that caused round-off
+error in the information passed to scroll commands.
+
+12/18/93 (bug fix) Fixed bug in tkPack.c that caused core dumps in
+some situations if a master with siblings packed "-in" it was deleted.
+
+12/18/93 (bug fix) Added "compat" directory to distribution, since it's
+referenced by tkConfig.h on some systems.
+
+12/18/93 (performance improvement) Improved performance of appending to
+a listbox, so that inserting N items doesn't take N**2 time.
+
+12/20/93 (bug fix) Fixed bug in canvas ovals that caused the fill color
+for the oval to stick out past the outline.
+
+1/2/94 (fixed Xlib bug) Added code to reuse X resource identifiers so
+that they won't run out in long running applications. There are three
+new library procedures: Tk_FreeXId, Tk_GetPixmap, and Tk_FreePixmap.
+Modified all Tk code to use these procedures, so wish applications should
+now be able to run forever without running out of identifiers.
+
+1/10/94 (bug fix) tkCursor wasn't freeing pixmaps used to create
+cursors, which caused memory leaks in programs that changed cursors
+frequently.
+
+1/21/94 (bug fix) Fixed bug in scales that caused them to loop
+infinitely drawing tick-marks when -from and -to were the same.
+
+2/2/94 (bug fix) Fixed problem where messages that contained tabs
+didn't always compute the correct size, so that text spilled off
+the right edge. The fix adds an extra "tabOrigin" parameter to
+the internal procedures TkMeasureChars, TkDisplayChars, and
+TkUnderlineChars.
+
+2/4/94 (bug fix) Fixed off-by-one problem in tkBind.c that caused
+it to read past the initialized part of dispPtr->modKeyCodes.
+
+2/7/94 (bug fix) Text widgets didn't handle grabs correctly, such
+that the "current" character got stuck if a grab occurred while a
+mouse button was down. It would get unstuck until after the
+next button press and release.
+
+2/19/94 (bug fix) Fixed prolog.ps (prolog for Postscript printing from
+canvases) so that it correctly prints all of the characters in the
+ISO Latin-1 character set.
+
+2/19/94 (bug fix) Modified tkBind.c to save and restore the interpreter's
+result across the execution of binding scripts. Otherwise if an event
+triggers in the middle of some other script (e.g. a destroy event during
+window creation, because there was an error in the creation command),
+the intepreter's result gets lost.
+
+2/19/94 (bug fix) Fixed bug in dealing with results of sent command
+that could cause them to get lost in some situations.
+
+2/21/94 (bug fix) Don't let user close a dialog window created by
+tk_dialog, since this would cause tk_dialog to hang: force the user
+to select one of the dialog's buttons.
+
+2/21/94 (bug fix) Fixed bug in canvas polygons whereby they didn't
+correctly handle changes in the number of points (via "coords"
+widget command).
+
+2/23/94 (bug fix) Large bitmaps in canvases didn't print correctly
+because they overflowed the 64-KB limit on strings in Postscript.
+Changed canvas printing to split up large bitmaps into mutliple
+smaller ones for printing.
+
+2/25/94 (bug fix) The "." window was being set up with -width
+and -height options, which interfered with geometry management (any
+configuration change on "." causes the window to change size to
+200x200, then change back again).
+
+2/26/94 (bug fix) Fixed several bugs that occurred when a Destroy
+event handler for a window deleted the window's parent.
+
+3/3/94 (new features) Changes to binding mechanism:
+ - The modifiers for "Alt", "Meta", and "M" are now computed by
+ examining the modifier map, rather than being hardwired to
+ M2, M1, and M1.
+ - When processing events, one script is invoked for each object
+ in the list passed to Tk_BindEvent, rather than stopping as
+ soon as a script is invoked for some object. The "break" and
+ "continue" commands can be used within a script to abort all
+ scripts for the event or the current one.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Added "bindtags" command so that new binding groups can be
+ defined for widgets and the evaluation order can be changed.
+ - When matching events to bindings, extra modifiers are now ignored,
+ as if "Any" were specified for every event. The "Any" modifier
+ is still recognized, but it is ignored and is deprecated.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - In % sequences that print window identifiers (e.g. %a and %S), print
+ in hexadecimal rather than decimal, for consistence with "winfo id".
+ *** POTENTIAL INCOMPATIBILITY ***
+ - The "bind" command no longer supports the event types CirculateRequest,
+ ConfigureRequest, MapRequest, or ResizeRequest. These event types
+ are somewhat dangerous, and they never worked anyway.
+
+3/13/94 (bug fix) Fixed numerous problems with the "wm iconwindow" command.
+It appears that this command never really worked at all, but it should
+work OK now.
+
+3/14/94 (feature changes) Removed several obsolete features:
+ - Eliminated "enable" and "disable" widget commands for menus.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Eliminated "activate" and "deactivate" widget commands for buttons,
+ checkbuttons, radiobuttons, and menubuttons.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Removed -geometry option for frames and toplevels: it causes
+ problems when .Xdefaults files contain entries like
+ "*geometry: +0+0". Must use -width and -height instead.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Desupported "tkVersion" variable: use "tk_version" instead.
+ *** POTENTIAL INCOMPATIBILITY ***
+
+3/16/94 (feature changes) Changes to listboxes:
+ - Eliminated -geometry option (it causes problems when .Xdefaults
+ files contain entries like "*geometry: +0+0"). Added -width
+ and -height options to use instead.
+ *** POTENTIAL INCOMPATIBILITY ***
+
+3/21/94 (bug fix) Fixed bug in tkOption.c where the option cache wasn't
+properly cleaned up after window deletion; this could cause the wrong
+value from the option database to be used under some conditions.
+
+3/25/94 (new features) Changes to geometry management:
+ - Added Tk_MaintainGeometry and Tk_UnmaintainGeometry procedures
+ to solve problems with -in windows. Modified the packer, the
+ placer, and canvases to use them.
+ - Changed 2nd argument to Tk_ManageGeometry from Tk_GeometryProc *
+ to a pointer to a structure with additional information about
+ the geometry manager, such as name and procedure to call when
+ slaves are stolen.
+ *** POTENTIAL INCOMPATIBILITY ***
+
+3/28/94 (new feature) Overhauled event management:
+ - Added "cancel" option to the "after" command so that you can
+ cancel previously-scheduled commands.
+ - Separated X-specific stuff from generic event management. The
+ file tkEvent.c can now be used stand-alone without the rest of Tk.
+ See the manual entry for Tk_EventInit for information on which
+ procedures are available this way.
+ - Added Tk_CreateFileHandler2 procedure, which provides a lower-level
+ and more powerful form of file event handler.
+ - Fixed bug in Tk_DoOneEvent where an infinite loop could occur if
+ the TK_FILE_EVENT and TK_DONT_WAIT flags were set simultaneously
+ (there were bugs with several other combinations too; all should
+ be fixed now).
+
+3/28/94 (new feature) Added "fileevent" command, which allows event-
+driven I/O in the style of Mark Diekhans' "addinput" command.
+
+4/11/94 (new feature) Better support for colormaps and visuals:
+ - Added new -colormap and -visual options to toplevels and frames.
+ - Added "winfo visualsavailable" command.
+ - Added "wm colormapwindows" command, plus support for WM_COLORMAP_WINDOWS
+ to Tk_SetWindowColormap.
+ - Added new library procedures Tk_GetVisual, Tk_GetColormap,
+ and Tk_FreeColormap.
+
+4/11/94 (bug fix) Fixed core dump that used to occur when specifying
+an iconwindow ("wm iconwindow") for a toplevel on a different screen
+than the main window.
+
+4/23/94 (new feature) Added support for images, including the following:
+ - New "image" command for creating images.
+ - Built-in image type: bitmap.
+ - New "image" item type in canvases.
+ - Labels, buttons, checkbuttons, radiobuttons, menubuttons, and
+ menu entries now support a -image option for displaying images.
+ - Tk_CreateImageType and Tk_ImageChanged procedures, for defining
+ new types of images in C.
+ - Tk_GetImage, Tk_FreeImage, Tk_RedrawImage, and Tk_SizeOfImage
+ procedures, for using images in widgets.
+
+5/1/94 (new features) Added new procedures Tk_3DVerticalBevel and
+Tk_3DHorizontalBevel.
+
+5/11/94 (new features) Major overhaul of text widgets:
+ - Implemented embedded windows and "window" widget command.
+ - Added new configuration options for tags: -justify, -lmargin1,
+ -lmargin2, -rmargin, -offset, -spacing1, -spacing2, and -spacing3.
+ See the "Display styles" widget demo for examples.
+ - Added new configuration options for texts: -spacing1, -spacing2,
+ and -spacing3.
+ - Added "tagList" option to "insert" widget command to control
+ tags on new text. Made tagged regions so they aren't sticky on
+ either side: new characters get a tag only if the old chars. on
+ both sides had it.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Added gravity for marks, and "mark gravity" widget command.
+ - Added horizontal scrolling, "xview" widget command, -xscrollcommand
+ option. Changed "scan" widget commands to support horizontal
+ scrolling.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Added "search" widget command for searching (either exact matches
+ or regular expressions).
+ - New widget commands: bbox, dlineinfo, and see.
+ - Changed implementation of bindings so that Enter and Leave
+ events are not generated unless the tag has just become present
+ (or just ceased to be present) on the current character. Also
+ changed bindings to process separately for each tag, rather than
+ having high-priority tags override low-priority ones.
+ - The "end" index now refers to the character after the last newline
+ rather than the newline itself. You can now tag the final newline
+ and set a mark after the final newline.
+ - Deletions of the "sel" tag and the "insert" and "current" marks
+ are now ignored silently, rather than generating errors. This means
+ you can do things like "eval .t tag delete [.t tag names]".
+
+5/19/94 (bug fix) Canvases didn't generate proper Postscript for stippled
+text.
+
+5/20/94 (new feature) Added "bell" command to ring the display's bell.
+
+5/20/94 (new feature) Incorporated "square" demonstration widget into
+tktest application.
+
+5/20/94 (new features) Changed wish application (tkMain.c):
+ - wish no longer processes the -help option.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - The wish main program is now called Tk_Main; tkAppInit.c has a
+ "main" procedure that calls Tk_Main. This makes it easier to use
+ Tk with C++ programs, which need their own main programs, and it
+ also allows an application to prefilter the argument list before
+ calling Tk_Main.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - The application's class is now the same as its name (except the
+ first letter is capitalized), instead of "Tk".
+ *** POTENTIAL INCOMPATIBILITY ***
+ - The -file keyword is no longer required: the script file name can
+ be provided as the first argument without being preceded by "-file",
+ as in tclsh. For backward compatibility the "-file" keyword is
+ ignored if it is the first argument, but it is deprecated.
+
+5/26/94 (feature removed) Removed support for "fill" justify mode from
+Tk_GetJustify and from the TK_CONFIG_JUSTIFY configuration option. None
+of the built-in widgets ever supported this mode anyway.
+*** POTENTIAL INCOMPATIBILITY ***
+
+5/27/94 (feature change) Changed Tk to use Tk_PrintDouble everywhere
+that it converts reals to strings. This means that floating-point
+values will be generated in some cases where integer-like values were
+generated before.
+*** POTENTIAL INCOMPATIBILITY ***
+
+6/1/94 (feature change) Renamed "pack newinfo" command to "pack info".
+The old "pack info" command is no longer available.
+*** POTENTIAL INCOMPATIBILITY ***
+
+6/20/94 (feature changes) Overhaul of entry widgets:
+ - Added "-justify" option.
+ - Added "-show" option to make entries easier to use for passwords.
+ - Added "cget" widget command.
+ - Added "selection range" and "selection present" widget commands.
+ - Added "anchor" symbolic index.
+ - Changed "-scrollcommand" option to "-xscrollcommand", "view"
+ widget command to "xview", for compatibility with other widgets.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Changed sel.last to refer to character just *after* last one
+ selected, again for compatibility with other widgets.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - For "delete" widget command, second index now refers to character
+ just *after* last one to delete.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Overhauled bindings to be more Motif-compatible and to include
+ common Emacs bindings for editing.
+ - Changed -width option: if specified as 0, widget sizes to fit
+ its current text.
+
+6/11/94 (new features) Improved Motif compatibility:
+ - Added "-highlightwidth" and "-highlightcolor" options to all widgets.
+
+6/27/94 (bug fix) Postscript generation for text items in canvases was
+not justifying the text properly when a -width was specified that was
+longer than the longest line.
+
+6/27/94 (bug fix) "winfo exists" used to report a window as existing
+if it was in the process of being destroyed (i.e., a destroy handler
+is in the middle of execution). Changed to report it as non-existent
+under these conditions.
+*** POTENTIAL INCOMPATIBILITY ***
+
+7/11/94 (bug fix) Selections claimed via "selection own" weren't always
+being cleared properly when the selection was claimed away. Also fixed
+bug where Tk wasn't properly claiming the selection, if there haven't
+been any recent X events at the time of the claim.
+
+7/13/94 (feature changes) Overhaul of scrollbar widgets:
+ - New widget commands: "activate", "cget", "fraction", and "identify".
+ - New options: -activebackground, -activerelief, -highlightcolor,
+ -jump, -highlightthickness, and -troughcolor. What used to be
+ -background is now -troughcolor, -foreground is now -background,
+ and -activeforeground is now -activebackground.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Added new syntax for "set" command, "get" result, and generated
+ commands. Changed other widgets to use the new syntax.
+ - Moved the bindings out of C and into Tcl scripts, using the new
+ options and widget commands. Added support for all Motif
+ bindings, plus jump scrolling and cancelling of slider drags.
+
+7/16/94 (bug fix) Canvases assumed that the Leave event for one item
+didn't modify or delete the next current item; this could cause core
+dumps under some conditions.
+
+7/23/94 (feature change) Modified Tk_BackgroundError so that tkerror
+is invoked as an idle handler. If tkerror generates a break exception
+then all other queued reports are aborted.
+
+8/14/94 (bug fix) "cursorOffTime" and "cursorOnTime" were confused in
+canvases, resulting in the same time being used for both.
+
+8/16/94 (bug fix) "tkwait variable" command didn't detect errors in
+variable name, such as trying to wait for an entire array.
+
+9/2/94 (new features) Overhaul of scale widgets:
+ - Floating-point values are supported now, following Paul Mackerras'
+ "fscale" widget. Added "-resolution" and "-digits" options.
+ - Added "-variable" option to link scale to variable, following
+ Henning Schulzrinne's implementation.
+ - Added focus highlight (-highlightthickness and -highlightcolor
+ options).
+ - Added new widget commands "cget", "coords", "identify", plus
+ improved "get"; removed wired-in bindings, added complete set
+ of Motif bindings via Tcl scripts.
+ - Changed -sliderforeground option to -background, -background to
+ -troughColor, -activeforeground to -activebackground.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Moved value label from below horizontal scales to above the scale,
+ for Motif compliance.
+
+9/9/94 (bug fix) Fixed bug in tkWm.c that caused long delays in "raise"
+command under some conditions (window already at the top of the stack).
+
+9/10/94 (new features) Overhaul of label/button/checkbutton/radiobutton
+widgets:
+ - Added focus highlight (-highlightthickness and -highlightcolor
+ options).
+ - Added new widget command "cget".
+ - Changed -selector option to -selectcolor, and changed its meaning
+ too: empty no longer means don't draw the indicator; it means
+ don't use a special color when selected.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Added -indicatoron (controls whether indicator is displayed) and
+ -selectimage (gives special image to display when selected) options.
+ - Modified bindings to be more Motif-like, added binding for space
+ key.
+ - Changed padding defaults to give widgets correct Motif appearance
+ by default. Also, changed to ignore padding options when displaying
+ an image or bitmap.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Can now display text on multiple lines: newlines cause line breaks,
+ and word wrapping can be requested with -wraplength option. Also
+ added -justify and -underline options.
+ - The -value option for radiobuttons can now have an empty string as
+ its value; it no longer defaults to the name of the widget.
+ *** POTENTIAL INCOMPATIBILITY ***
+
+9/13/94 (new features) Modified both canvases and messages to support
+-highlightthickness and -highlightcolor options plus "cget" widget
+command.
+
+9/19/94 (new features) Added Tk_UnsetGrid procedure, modified widgets
+to use it. Also changed Tk_SetGrid so that at most one window per
+toplevel can have gridding enabled.
+
+9/23/94 (new features) Major overhaul of listbox widgets:
+ - Added focus highlight (-highlightthickness and -highlightcolor
+ options).
+ - Added new widget command "cget".
+ - Revised selection commands to support single selections as well
+ as multiple disjoint selections; syntax of "selection" widget
+ command has changed to support this. Added new option -selectmode
+ for specifying which mode to use. Default is single selection;
+ tk_listboxSingleSelect procedure no longer exists. Selections
+ now return as items separated by newlines instead of a list whose
+ elements are the items.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Extended "get" widget command to allow many items to be retrieved
+ at once.
+ - Added "bbox" widget command for finding position of an element on
+ screen.
+ - Added "activate" command to mark element with traversal focus.
+ - Extended index mechanism to support new types of indices:
+ "active", "anchor", "@x,y".
+ - Added "see" widget command.
+ - Revised bindings to include all Motif features except for AddMode.
+ - If -width or -height option is <= 0, the widget requests a size just
+ large enough to hold all of its text.
+
+10/6/94 (new features) Overhaul of menubuttons:
+ - Added focus highlight (-highlightthickness and -highlightcolor
+ options).
+ - Added new widget command "cget".
+ - Added -indicatoron option to display option menu indicator.
+ - The -menu option must be a child of the menubutton.
+ *** POTENTIAL INCOMPATIBILITY ***
+
+10/6/94 (new features) Overhaul of menu widgets:
+ - Added new widget commands "cget" and "entrycget".
+ - Changed the implementation of tear-off menus to be more
+ Motif-like; added -tearoff option for specifying whether
+ tearoff entry is displayed.
+ - Changed interpretation of "@y" index: it now returns the
+ closest entry, rather than "none" if y is outside the menu's
+ range.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - The -menu option for a cascade entry must now be a child of
+ the menu.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Added "type" widget command, so that you can query the type of
+ an entry.
+ - Added -foreground, -activeforeground, -selectcolor, -indicatoron,
+ -image, and -selectimage options to menu entries.
+ - Changed "selector" menu option to "selectColor" for Motif compliance.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Added -relief option for menus, just for consistency with other
+ widgets (it was implicitly "raised" before).
+
+10/6/94 (feature change) Completely overhauled the bindings for menus
+and menubuttons. They now fit better with other Tk 4.0 facilities,
+such as the new binding mechanism, and they provide better Motif
+compliance (e.g. keyboard traversal of submenus). Also, the bindings
+now support option menus, popup menus, and proper Motif tear-off
+menus.
+
+10/6/94 (obsolete features) The procedures tk_menuBar and
+tk_bindForTraversal are no longer needed in Tk 4.0. They still exist
+for compability, but they do nothing.
+
+10/6/94 (new procedures) Added "tk_popup" procedure for posting a
+popup menu, and "tk_optionMenu" for creating an option menubutton
+and its associated menu.
+
+10/6/94 (change in name) The variable "tk_priv" has been renamed
+to "tkPriv" to reflect that fact that it is private to Tk now.
+This shouldn't cause any problems, since no-one except Tk should
+have been using it before anyway (right?).
+
+10/6/94 (bug fix) Fixed bug in texts where sometimes the text would
+stop tracking mouse motion (the "current" item wouldn't get updated)
+because the text widget missed a ButtonRelease event.
+
+10/20/94 (new features) Overhauled selection code to support multiple
+selections (primary, secondary, etc.) and multiple displays:
+ - Changed "selection" command to support new options such as
+ "-displayof" and "-selection". Old command formats are still
+ supported for compatibility, but they are no longer documented
+ and are deprecated.
+ - Changed procedures Tk_GetSelection, Tk_CreateSelHandler, and
+ Tk_ClearSelection to take additional "selection" argument.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Selection targets APPLICATION and WINDOW_NAME have been replaced
+ by TK_APPLICATION and TK_WINDOW.
+ *** POTENTIAL INCOMPATIBILITY ***
+
+10/20/94 (new features) Added support for clipboard:
+ - New "clipboard" command.
+ - C procedures Tk_ClipboardClear and Tk_ClipboardAppend.
+ - Bindings for "cut", "paste", and "copy" for text and entry widgets,
+ plus "copy" binding for listboxes.
+
+10/24/94 (bug fix) Button widgets weren't checking for errors when
+setting the values of associated variables.
+
+11/3/94 (bug fix) Fixed bug whereby Tk would hang if "exit" was invoked
+from inside a <Destroy> binding.
+
+11/15/94 (new features) Overhaul of focus mechanism:
+ - Added support for multiple displays: separate focus windows are
+ kept for each display.
+ - Added support for keyboard traversal.
+ - Changed focus model so Tk keeps track of a focus window for each
+ top-level window and automatically sets the focus on Enter to the
+ top-level. Tk no longer synthesizes FocusIn and FocusOut events,
+ but just uses the standard X mechanisms. There is no "default"
+ focus window anymore; the focus reverts to top-levels by default.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Changed focus command: eliminated "focus default" and "focus none",
+ added "-displayof" and "-lastfor" options. An empty string is now
+ used to signify "no focus" instead of "none".
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Added library procedures tk_focusNext, tk_focusPrev, and
+ tk_focusFollowsMouse.
+ - Removed obsolete Tk_CreateFocusHandler: must use FocusIn and
+ FocusOut events now.
+ *** POTENTIAL INCOMPATIBILITY ***
+
+11/23/94 (new features) Overhaul of "send" command:
+ - Added support for multiple displays: -displayof option to "send".
+ - Added asynchronous sends: -async option to "send".
+ - Eliminated fixed timeouts on sends: as long as the target
+ application appears to exist, the send will wait for it.
+ - Stale entries get removed from the application registry now,
+ so "winfo interps" should never return non-existent applications.
+ - Can change the name of an application with "tk appname" command.
+ This is also the preferred way of querying the application name
+ now.
+ - The errorCode and errorInfo variables are now propagated back to
+ the sender now, so a full stack trace is available.
+ - Tk checks display security on each send now, instead of just during
+ initialization, so changes in the security status are seen immediately
+ by all applications.
+ - The above changes required changes to the data formats used for
+ communication between source and target applications, so Tk 4.0
+ applications cannot send to, or be sent from, Tk 3.6 applications.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - The procedure Tk_RegisterInterp has been replaced with Tk_SetAppName.
+ *** POTENTIAL INCOMPATIBILITY ***
+
+12/6/94 (cleanup) Eliminated "interp" argument to Tk_GetColorByValue,
+since it is no longer needed.
+*** POTENTIAL INCOMPATIBILITY ***
+
+12/7/94 (feature change) Changed the "wm" command so that top-level
+windows are now resizable by default. You can no longer specify
+empty arguments to "wm maxsize" and "wm minsize".
+*** POTENTIAL INCOMPATIBILITY ***
+
+12/8/94 (new feature) Added new "photo" image type using code provided
+by Paul Mackerras: currently supports only PPM "P6" format images.
+
+12/14/94 (new features) Canvas modifications:
+ - Modified the interfaces between generic canvas code and the item
+ types so that it's easy for people to write new item types outside
+ of Tk.
+ - Added support for transparent bitmap items: just specify an
+ empty string as the background color.
+ - Changed the "xview" and "yview" commands for canvases to use the
+ new scrolling syntax.
+ - Eliminated -scrollincrement option.
+ *** POTENTIAL INCOMPATIBILITY ***
+
+12/14/94 (bug fix) Fixed bug where the dimensions of canvas arrowheads
+scaled during a "scale" widget command, but the scaling was only
+temporary and got lost on the next re-configure of the item. The
+correct behavior is for the arrowheads not to scale.
+
+-------------------- Release 4.0b1, 12/23/94 -------------------------
+
+12/26/94 (bug fix) Removed obsolete demos from Makefile (color, dialog,
+size), fixed "install" target.
+
+1/3/95 (bug fix) Fixed all procedure calls to explicitly cast arguments:
+implicit conversions from prototypes don't work when compiling under
+non-ANSI compilers. Tk is now clean under gcc -Wconversion.
+
+1/4/95 (bug fix) Used "screenX" without ever setting it in DisplayText
+in tkCanvText.c: caused tabs in canvas text items to get messed up.
+
+1/4/95 (bug fix) Canvases forgot to register the built-in types if
+Tk_CreateItemType was called before a canvas widget was created.
+
+1/4/95 (bug fixes) Fixed glitches in various text bindings:
+ - Up used to do nothing if the cursor was at 2.0.
+ - Right used to make the cursor invisible if it was just before
+ the final newline of the text.
+ - Control-t didn't conform to Emacs; made it conform to GNU Emacs.
+ - Deleted Control-x binding, since it doesn't conform to anything and
+ is confusing for Emacs users.
+
+1/4/95 (bug fixes) Changed Control-t for entries just as for texts (see
+above) an deleted Control-x for entries (see above).
+
+1/4/95 (bug fix) The packer didn't map slaves unless the master was mapped;
+this could cause slaves to get "lost" so that they weren't mapped until the
+master resized.
+
+1/5/95 (bug fix) Scrollbars weren't executing the proper code the first time
+the mouse entered the widget; this caused problems if tk_strictMotif was
+set.
+
+1/6/95 (bug fix) Fixed label/button/checkbutton/radiobutton/menubutton
+widgets to allow arbitrary screen distances when specifying -width and
+-height for an image or bitmap (the manual pages already documented this
+but the code didn't implement it).
+
+1/6/95 (new feature) Added very primitive support for input methods,
+as suggested by Martin Forssen. This should be enough for European
+character sets (Compose key) but it isn't near enough for Asian
+character sets.
+
+1/8/95 (bug fix) Fixed problem in canvas "xview" and "yview" commands
+where divide-by-zero errors could sometimes occur.
+
+1/8/95 (bug fix) New event handler didn't properly handle files for
+which both TK_READABLE and TK_WRITABLE were specified.
+
+1/11/95 (bug fix) Fixed bug with text selections: was returning count
+too high for data, causing bogus garbage to appear when selection was
+copied.
+
+-------------------- Release 4.0b2, 1/12/95 -------------------------
+
+1/27/95 (feature removal) Removed %D substitution from binding scripts:
+wasn't portable, shouldn't be used anyway.
+*** POTENTIAL INCOMPATIBILITY ***
+
+1/27/95 (new features) Added -displayof options to the commands
+"winfo atom", "winfo atomname", "winfo containing", "winfo interps",
+and "winfo pathname".
+
+1/27/95 (new feature) Added "idle" option to "after" command to run
+scripts as idle handlers.
+
+1/28/95 (new feature) Modified placer to make -x and -relx additive
+if you specify both. Same for -y and -rely, -width and -relwidth,
+and -height and -relheight. This makes it easy to make request such
+as "make .a 2 pixels larger than .b".
+*** POTENTIAL INCOMPATIBILITY ***
+
+1/28/95 (new feature) Improved auto-grab mechanism in canvases (which
+prevents current item from changing while a button is down): changed
+to report Enter and Leave events for the current item while a button
+is down. However, as before, no Enter events are reported for other
+items until the button goes up.
+
+1/28/95 (new feature) Bitmap images are now transparent if the -background
+is specified as an empty string (-maskdata and -maskfile are ignored in
+this case). This is also the default.
+
+1/28/95 (bug fix) Tk didn't support manufacturer- or site-specific keysyms
+such as SunAudioMute. Modified tkBind.c so that it uses XStringToKeysym
+in addition to its own hash table, so that all keysyms are now available.
+
+1/30/95 (feature change) Modified "clipboard append" so that it reclaims
+the clipboard selection if it had been previously lost, rather than just
+generating an error. This handles certain race conditions more cleanly,
+and also allows the use of programs like "xclipboard".
+
+1/30/95 (new feature) Added -xscrollincrement and -yscrollincrement
+options to canvases.
+
+1/31/95 (bug fix) Geometry management was broken if a particular geometry
+manager claimed a slave away from itself.
+
+1/31/95 (bug fix) Fixed bug in tkVisual.c where a visual with fewer bits
+than requested was being selected in preference to one with just the right
+number of bits.
+
+1/31/95 (bug fix) Texts weren't redisplaying the padding region properly
+after changes in -padx or -pady.
+
+1/31/95 (new features) More text improvements:
+ - Extended "insert" widget command for texts to allow multiple
+ text-tagList pairs in the same command.
+ - Added -nocase option to "search" widget command.
+ - Added -overstrike option to tags.
+ - Added tab stops, via -tabs option for widget and for tags.
+
+2/10/95 (bug fix) Modified all widgets to allow renaming of widget
+commands. Deleting a widget command will delete the widget.
+
+2/11/95 (new feature) Added -highlightbackground option to all widgets.
+
+2/14/95 (new feature) Added "insert" widget command for menus.
+
+2/15/95 (new feature) Modified text display code (for all widgets) to
+display well-known control characters like newline and backspace as
+\n or \b instead of \xa.
+
+2/15/95 (bug fix) Modified bitmap and photo image managers to delete
+the image command when the image is deleted. Also modified them to
+allow renaming of the image command, and to delete the image if the
+image command is deleted.
+
+2/15/95 (bug fix) Fixed text widgets to allow horizontal scrolling
+even if wrapping was enabled, if a line isn't entirely visible due to
+a large character or embedded window.
+
+2/16/95 (feature change) Added "postcascade" widget command to menus,
+changed "invoke" and "activate" not to post or unpost submenus. Also
+fixed bug in redisplay that tended to leave bits of garbage on menu
+when submenu unposted.
+*** POTENTIAL INCOMPATIBILITY ***
+
+2/16/95 (feature removal) Removed "snap back" behavior (slider
+snaps back to old position if you move the mouse outside the widet
+before releasing the button) from scrollbars and scales.
+
+2/16/95 (bug fix) The last line of a listbox wasn't being displayed if
+it was only partially visible.
+
+2/16/95 (new features) Added support for "-resolution 0" (no rounding
+of values) to scale widgets, plus smarter computation of how many digits
+to display.
+
+2/17/95 (bug fix) Fixed bug in text bindings for things like Shift-Left:
+didn't properly set the anchor position.
+
+2/20/95 (bug fix) Changed management of COLORMAP_WINDOWS property to
+add the toplevel implicitly to the end of the list if it wasn't already
+on the list somewhere. Without this, some window managers implicitly
+put it at the front of the list, so that colormaps in internal windows
+are never used.
+
+2/20/95 (bug fix) Changed to use separate command procedures for
+button, checkbutton, label, and radiobutton commands. This allows the
+class commands to be renamed without breaking their behavior.
+
+2/20/95 (removed feature) The "bind" command no longer supports
+"Keymap" events; they never worked anyway.
+
+2/20/95 (bug fix) The text "search" widget command looped infinitely
+when searching an empty text.
+
+2/20/95 (bug fix) Canvases weren't redrawing their borders after
+configuration changes.
+
+2/20/95 (upgrade) Changed to use autoconf version 2.2.
+
+2/21/95 (bug fix) Fixed several bug fixes in menu bindings that occur
+when menus have no entries.
+
+2/21/95 (bug fix) Fixed bug in geometry management that caused windows
+packed -in siblings to not always be mapped and unmapped properly
+(particularly when the toplevel got unmapped and mapped).
+
+2/22/95 (bug fix) Fixed resource leak problem in tkTextDisp.c that
+caused embedded windows not to be unmapped when off-screen.
+
+2/23/95 (bug fix) "After cancel" dumped core when the script for an
+after event cancelled itself.
+
+2/24/95 (bug fix) Text and entry widgets weren't properly ignoring
+Alt-, Control-, and Meta- keystrokes, so a widget-specific binding
+for one of these resulted in the character also being inserted.
+
+2/24/95 (bug fix) Several widgets accidentally performed unsigned
+division on negative numbers, thereby losing the sign bit. This
+mostly affected the display of images and bitmaps in buttons,
+menubuttons, and messages.
+
+2/24/95 (feature reversal) Restored old behavior of %A so that it
+returns non-printing characters as well as printing ones now.
+*** POTENTIAL INCOMPATIBILITY with Tk 4.0b2, but not with Tk 3.6 ***
+
+2/24/95 (bug fix) Duplicate "leave" events could occur for canvas
+items under some conditions, due to recursive calls to PickCurrentItem.
+Added code to detect and skip the nested calls.
+
+2/24/95 (bug fix) Fixed bug where an error could occur during the first
+keystroke in an application if its binding invoked "break".
+
+2/25/95 (new feature) Modified syntax of "search" widget command for
+texts. The -nowrap switch and the "variable" final argument are no
+longer supported. Instead, there is a -count switch to replace
+the final argument; if the final argument is specified, it is now
+a stopping index for the search. The features of -nowrap can be
+achieved now with the stopping index.
+*** POTENTIAL INCOMPATIBILITY with Tk 4.0b2, but not with Tk 3.6 ***
+
+2/27/95 (bug fix) Fixed problem that appears to prevent keyboard
+input for working under IRIX: tkBind.c was ignoring XmbLookupString
+calls that returned a status of XLookupBoth.
+
+2/27/95 (new feature) Added Tk_GetItemTypes procedure to return
+information about available canvas item types.
+
+2/27/95 (feature change) Changed Makefile to always use install-sh
+for installations: there's just too much variation among "install"
+system programs, which makes installation flakey.
+
+2/27/95 (bug fix) Fixed bug in tkSend.c that caused core dumps if
+the app's main window was destroyed by a destroy handler on a
+child.
+
+3/5/95 (feature change) Change separator character used in "bind +..."
+bindings from semi-colon to newline (permits bindings that are
+comments, for what that's worth).
+
+3/7/95 (bug fix/feature change) Overhauled focus code, both in C
+and in Tcl:
+ - Tk won't move the X focus in response to the "focus" command
+ unless either the application already has the focus or the
+ -force switch is specified.
+ - Tk no longer sets the X focus to anything other than top-levels;
+ it synthesizes events for FocusIn and FocusOut to children.
+ - A window no longer has to be viewable when focussed to; Tk will
+ set the X focus later, when the window becomes viewable.
+ - Added -takefocus option to all widgets.
+ - Rewrote tk_focusPrev and tk_focusNext to use the -takefocus option.
+ These procedures no longer set the focus; they just return the
+ next window in focus order.
+ *** POTENTIAL INCOMPATIBILITY with Tk 4.0b2, but not with Tk 3.6 ***
+ - Eliminated tk_focusContinue.
+ *** POTENTIAL INCOMPATIBILITY with Tk 4.0b2, but not with Tk 3.6 ***
+
+3/8/95 (new feature, bug fix) Added support for tk_strictMotif variable
+in C: Tk_StrictMotif library procedure. Modified buttons, menubuttons,
+menus to use it. This fixes the problem with menus not supporting
+tk_strictMotif properly in Tk4.0b1 and b2.
+
+3/16/95 (feature overhaul) Overhauled color management:
+ - Changed Tk so it never denies a color request because a colormap
+ filled up. Instead, it allocates the closest available color.
+ - Eliminated "color model" mechanism. The "tk colormodel" command
+ is gone, as are the procedures Tk_GetColorModel and Tk_SetColorModel.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Changed 3D border implementation to allocate colors for shadows
+ lazily, so they're never allocated if they're never used. Also
+ added new feature whereby stippling is used for borders when
+ the colormap has run out of entries. Changed arguments to many
+ of Tk_3D C procedures to take a Tk_Window as argument instead of
+ a (Display *). This is needed to do lazy color allocation.
+ *** POTENTIAL INCOMPATIBILITY ***
+ - Eliminated colormap argument to Tk_GetColor, Tk_GetColorByValue,
+ and Tk_Get3DBorder.
+ *** POTENTIAL INCOMPATIBILITY ***
+
+3/16/95 (feature change) Event bindings created from Tcl will now ignore
+Enter, Leave, FocusIn, and FocusOut events with detail NotifyInferior.
+This is done in anticipation of mega-widgets, so that the user of a
+mega-widget can create Enter/Leave bindings on the mega-widget without
+seeing spurious events as the mouse moves among the windows in the
+mega-widget.
+*** POTENTIAL INCOMPATIBILITY ***
+
+3/17/95 (feature change) Changed C interfaces throughout Tk to use ints
+instead of unsigneds: the unsigneds turn out to cause subtle problems
+with arithmetic in some places, and using ints everywhere is just
+simpler.
+*** POTENTIAL INCOMPATIBILITY ***
+
+3/23/95 (bug fix) Selections longer than 4000 bytes were being
+truncated to 4000 bytes.
+
+-------------------- Release 4.0b3, 3/24/95 -------------------------
+
+3/25/95 (bug fix) Changed "install" to "./install" in Makefile so that
+"make install" will work even when "." isn't in the search path.
+
+3/25/95 (bug fix) Modified Tk's selection mechanism to prevent core
+dumps in other applications during retrievals of large selections
+(this is actually a bug in the other apps, but I've patched Tk to
+keep it from getting triggered).
+
+3/25/95 (bug fix) Fixed bug where X window for "." wasn't being
+deleted.
+
+3/27/95 (bug fix) Fixed many bugs associated with having more than
+one application in a single process.
+
+3/28/95 (bug fix) The "search" widget command for texts didn't
+return the correct index and count if there were embedded widgets
+on the same line as the returned range but before the end of
+the range.
+
+3/28/95 (bug fix) Changed pasting via button 2 in text and entries
+so that it inserts at the pointer location, not the location of
+the insertion cursor.
+
+3/28/95 (bug fix) Fixed several bugs related to <Destroy> bindings
+that delete ancestors in the window hierarchy. Also eliminated
+extraneous calls to XDestroyWindow, which speeds up window deletion
+by about 3x.
+
+3/28/95 (bug fix) Several widgets (buttons, menubuttons, menus) didn't
+properly handle image deletions that occurred while the widget was
+being deleted (caused core dumps).
+
+3/29/95 (bug fix) When retrieving long selections from text widgets,
+parts of lines were getting duplicated in the selection information.
+
+4/1/95 (bug fix) Fixed bug that caused infinite loop in horizontal
+scales with 0 range.
+
+4/1/95 (bug fix) Fixed problem with -command option for scrollbars and
+-takefocus option that caused commands to be evaluated in the wrong
+context.
+
+4/1/95 (bug fix) Fixed problem with option database that caused it to
+sometimes use the wrong option (wasn't flushing the database properly
+after a change in a window's class).
+
+4/1/95 (bug fix) If a line in a text widget just barely fit in the window,
+Tk was allocating a second screen line just for the newline character.
+
+4/1/95 (new feature) When backspacing in an entry widget, when you reach
+the left edge of the widget, the insertion cursor gets recentered.
+
+4/1/95 (new features) Added "winfo pointerx" and "winfo pointery" commands
+to fetch the current pointer position.
+
+4/6/95 (bug fix) If the last line of a text widget was only partially
+visible, it was counted as visible for purposes of the scrollbar. Now
+it is treated as if it were off-screen for scrolling purposes.
+
+4/6/95 (new feature) Modified "bell" command to reset screen saver as well.
+
+4/6/95 (feature change) Modified menu scanning (where menus pull down
+as you drag across their menubuttons) so it only works among menus
+in the same toplevel; it used to work for any menubuttons in the
+application.
+
+4/6/95 (bug fix) Canvas text items weren't allowing real numbers in
+"@x,y" notation for specifying indices.
+
+4/7/95 (bug fix) Menus didn't display correctly when -activeborderwidth
+was large.
+
+4/7/95 (bug fix) Changed "clipboard append" command to support -- option
+and to always treat the last argument as data, even if it starts with
+"-".
+
+4/17/95 (new feature) Added -wrap option to text tags.
+
+4/18/95 (bug fix) Listboxes and texts weren't updating their grid information
+when -width or -height changed.
+
+4/18/95 (bug fix) "Down" didn't work right in text widgets if the last
+line was only partially visible in the window.
+
+4/19/95 (bug fix) Listboxes didn't handle partially visible last lines
+right: couldn't scroll it into full visibility, for example.
+
+4/20/95 (bug fix) If a toplevel was positioned with a command like
+"wm geometry . -0-0", the window didn't reposition itself to maintain
+that geometry after a size change.
+
+4/21/95 (feature change) Changed order of binding tags so widget bindings
+fire before class bindings. New order is: widget, class, toplevel, all.
+*** POTENTIAL INCOMPATIBILITY with Tk 4.0b3, but not with Tk 3.6 ***
+
+4/23/95 (new feature) Added "winfo colormapfull" command.
+
+4/23/95 (new feature) Buttons and radiobuttons and checkbuttons now
+treat Return the same as Space, unless tk_strictMotif is set.
+
+4/23/95 (bug fix) Modified menu tear-off procedure to duplicate the
+binding tags and bindings of the original in the copy.
+
+4/25/95 (bug fix and feature change) Modified mechanism for choosing
+"best" visual to fix a bug where depth wasn't really getting highest
+priority in all situations.
+
+4/28/95 (bug fix) Failed text searches starting at "end" could result
+in an infinite loop in Tk.
+
+4/30/95 (new feature) Added "wm resizable" command to enable and
+disable interactive resizing.
+
+4/30/95 (new feature) Added "window names" widget command to texts:
+returns a list of all embedded windows.
+
+5/2/95 (feature change) Changed text searches so that forward searches
+start at the given index, rather than the character just after the
+given index.
+*** POTENTIAL INCOMPATIBILITY with Tk 4.0b3, but not with Tk 3.6 ***
+
+5/4/95 (bug fix) Default bit gravity for windows was wrong (it was
+ForgetGravity) causing unnecessary flashing when windows were resized.
+
+5/4/95 (feature change) Modified Tk_DoOneEvent so that it doesn't
+sleep if there's nothing that will wake it up again (e.g. no file
+or timer handlers). Returns 0 immediately.
+
+5/5/95 (configuration change) Changed to use BSDgettimeofday instead
+of gettimeofday on systems like IRIX where BSDgettimeofday is
+available. This avoids compilation problems due to the different
+interface to gettimeofday provided by IRIX.
+
+5/5/95 (feature change) Changed binding mechanism so that all bindings
+are created immediately at initialization time, rather than waiting
+until the first FocusIn or Enter event for a class.
+
+5/6/95 (feature change) Changed default text for labels, buttons,
+checkbuttons, radiobuttons, menubuttons, and messages from " " to
+"".
+
+5/6/95 (bug fix) If the application was destroyed in the middle of
+an "update" command, Tk would dump core.
+
+5/6/95 (bug fix) Changed manual entries to use the standard .TH
+macro instead of a custom .HS macro; the .HS macro confuses index
+generators like makewhatis.
+
+5/6/95 (bug fix) Change "wm iconwindow" command to disable button
+presses for the icon window. This is needed so that the window
+manager can get those events (X only allows button presses to go
+to one client for a given window).
+
+5/9/95 (new feature) When specifying visuals, can now use "best"
+with a depth, e.g. "-visual {best 8}" to get the best 8-bit visual.
+
+5/18/95 (bug fix) Fixed bug with -spacing* options for text widget:
+screen distances weren't allowed, only integers.
+
+5/20/95 (bug fix) Eliminated memory leaks in tkTextDisp.c and elsewhere.
+
+5/22/95 (color change) Changed the Tk color palette to a gray scheme.
+Also added a library procedure tk_setPalette that makes it easy to
+change colors on the fly, and a procedure tk_bisque that restores the
+previous light brown scheme.
+
+5/28/95 (bug fix) Modified canvases so that the -width and -height
+options refer to the space inside the borders, not the total widget
+space. Also changed "xview" and "yview" commands and scroll-increment
+rounding to use the pixel just inside the borders, rather than (0,0).
+
+5/28/95 (bug fix) Several widgets (e.g. entries, buttons, and menus)
+didn't properly handle unsets of variables they were tracing, if the
+variables were reference through upvars in procedures.
+
+6/4/95 (bug fix) The placer wasn't rounding window widths right when
+both -relx and -relwidth were specified (or -rely and -relheight) so
+that rounding errors accumulated.
+
+6/4/95 (feature improvement) Change parsing of text indices to handle
+weird mark and tag names better (e.g. any string ending with ".first"
+will now be parsed as a tag name, even if it contains embedded spaces,
+etc.).
+
+6/4/95 (feature change) If a font defines glyphs for control characters,
+they are now displayed, instead of translating the character to a
+backslash sequence (however, tabs and newlines are still treated
+specially; glyphs are not displayed for these characters).
+
+6/4/95 (bug fix) Modify the implementation of "raise" and "lower" for
+toplevels so that it now works under olwm and olvwm. It didn't use to
+work, and the problem is really in the window manager, but Tk now
+patches around it. However, only "total" raises and lowers work:
+raising and lowering relative to a sibling still don't work under
+olvwm and olwm.
+
+6/4/95 (feature change) Modified tab code in texts so that a tab always
+occupies at least as much space as a space character.
+
+6/4/95 (bug fix) The "%t" substitution wasn't being made properly in
+Enter and Leave event bindings.
+
+6/7/95 (new feature) Added support for GIF images. Unfortunately it's
+a bit fragile: certain kinds of badly formed images can cause core
+dumps; I don't know enough about the GIF reader (taken from giftoppm)
+to figure this out.
+
+6/7/95 (bug fix and feature change) Fixed PPM image reader to be more
+flexible about header formats, and added support for PGM images.
+
+6/7/95 (feature change) Added -outlinestipple option to canvas arc
+items, changed "-style arc" to use -outline as the color instead of
+-fill (the old approach was pretty quirky).
+*** POTENTIAL INCOMPATIBILITY ***
+
+6/8/95 (feature change) Modified interface to Tk_Main to pass in the
+address of the application-specific initialization procedure.
+Tcl_AppInit is no longer hardwired into Tk_Main. This is needed
+in order to make Tcl a shared library.
+
+6/8/95 (feature change) Modified Makefile so that the installed versions
+of wish and libtk.a have version number in them (e.g. wish4.0 and
+libtk4.0.a) and the library directory name also has an embedded version
+number (e.g., /usr/local/lib/tk4.0). This should make it easier for
+Tk 4.0 to coexist with earlier versions.
+
+6/9/95 (new feature) Added -outline and -width options to canvas polygon
+items.
+
+6/9/95 (feature changed) Renamed -decimate in photo widget to -subsample
+(decimate wasn't technically correct).
+*** POTENTIAL INCOMPATIBILITY with Tk 4.0b3, but not with Tk 3.6 ***
+
+-------------------- Release 4.0b4, 6/16/95 -------------------------
+
+6/19/95 (bug fix) Colors weren't being rounded correctly in canvas
+Postscript generation: caused "white" to appear slightly gray when
+the display of the canvas used only 8 bits per color.
+
+6/20/95 (bug fix) "bbox" widget command for texts didn't return
+proper width for tabs.
+
+6/20/95 (bug fix) Scrollbars didn't always work right for texts:
+couldn't scroll all the way to the bottom of the text in a single
+drag of the slider.
+
+6/20/95 (new feature) Added "delta" widget command for scrollbars
+(needed for above bug fix).
+
+6/23/95 (bug fix) Listboxes weren't properly redisplaying their
+borders when the were configured to a smaller size.
+
+6/23/95 (new feature) Added "winfo server" command.
+
+6/23/95 (bug fix) If a menu was posted, couldn't switch to another
+menu with an Alt- key.
+
+6/24/95 (new feature) Added "winfo pointerxy" command.
+
+6/25/95 (bug fix) Tk_ParseArgv referenced beyond the end of 0-length
+option names.
+
+6/25/95 (bug fix) Fixed problem in tkOption.c where "cachedWindow"
+could get garbage in it if the main window's class was changed by
+calling Tk_SetClass.
+
+6/25/95 (bug fix) Fixed two bugs in menus, one where errors in
+variable traces weren't propagated correctly and one where "invoke"
+was invoked at the wrong stack level, with the result that variable
+traces didn't have access to the right variables.
+
+6/27/95 (bug fix) tk3d.c wasn't using all the right information
+when deciding whether or not to stipple borders, so it stippled
+borders even on 16-bit true-color displays.
+
+6/28/95 (bug fix) Page up and down operations in texts could cause
+insertion cursor to drift to the right. Changed tkTextScrollPages
+to use upper-left corner of current character, rather than center
+of character.
+
+6/28/95 (bug fix) Changed text widget so that you can't put the
+insertion cursor after the last newline in the text.
+
+6/28/95 (bug fix) Bitmap images didn't allow ~'s in file names.
+
+6/28/95 (bug fix) Fixed problem that could cause core dumps in the
+text widget when dealing with embedded windows (there were problems
+if the act of redisplaying caused the window layout to change, which
+can happen with embedded windows).
+
+6/28/95 (bug fix) Texts didn't handle indices with double negatives,
+such as ".t mark set insert {insert + -20 chars}".
+
+6/28/95 (bug fix) Fixed problem where focus didn't always revert to
+its prior window after a dialog box was dismissed.
+
+6/28/95 (bug fix) Fixed problem with "search" widget command returning
+incorrect length on some backwards regexp searches.
+
+6/28/95 (bug fix) Successive "wm iconbitmap . {}" commands could cause
+a core dump.
+
+6/29/95 (new feature) Added -elementborderwidth option for scrollbars
+so the -borderwidth can be set to 0 without flattening the arrows and
+slider.
+
+-------------------- Release 4.0, 7/1/95 -------------------------
+
+7/18/95 (bug fix) %t in event bindings didn't work properly for some
+events (e.g. PropertyNotify).
+
+7/18/95 (bug fix) Changed "exec wish" lines in demo scripts to
+"exec wish4.0" to avoid version conflicts.
+
+7/18/95 (bug fix) Fixed round-off errors in scrolling for texts,
+canvases, listboxes, and entries. The error could cause the view
+to shift up in a command like "$w yview moveto [lindex [$w yview] 0]".
+
+7/19/95 (bug fix) Canvases weren't always redrawing borders correctly
+when they became unobscured. There were also some problems with
+improper refresh after size changes.
+
+7/19/95 (bug fix) Fixed bug in text index processing that causes
+tests textIndex-11.1 and textIndex12.1 to fail on some platforms.
+
+7/19/95 (bug fix) Fixed bug where 2-second delays were ocurring during
+"raise" and "lower" commands for toplevel windows under some window
+managers (such as fvwm).
+
+7/20/95 (bug fix) Text searches were misbehaving when there were embedded
+windows on the starting line of the search. The most common symptom is
+that Tk would fail to find a match at the starting position for the
+search.
+
+7/22/95 (bug fix) Fixed core dump that could occur in menus if a checkbutton
+entry's -variable option referred to an array (or couldn't be read
+by the menu C code for some other reason).
+
+7/22/95 (bug fix) Text widgets didn't update their scrollbars when
+changes were made to information that was off-screen.
+
+7/25/95 (bug fix) Fixed core-dump in tkListbox.c that used to happen
+in the command ".l bbox end" if the listbox was empty.
+
+7/25/95 (bug fix) Page-up and page-down bindings for listboxes didn't
+move active element to remain on the screen.
+
+7/25/95 (bug fix) Patched around H-P compiler problem that results in
+core-dumps in tkImgPhoto.c during image handling.
+
+7/25/95 (bug fix) Fixed bug in tkImgPhoto.c that caused core dumps
+(during Tk self-tests and other image uses) on AIX and other machines
+where "schar" in tkImgPhoto.c was being defined as "short" instead of
+"char".
+
+7/26/95 (bug fix) The PPM image reader couldn't handle maximum intensity
+values other than 255.
+
+7/26/95 (bug fix) Canvases didn't redraw their borders when the relief
+changed from raised to flat.
+
+7/27/95 (bug fix) Canvases didn't set the scrolling values correctly
+when no scroll region was specified.
+
+7/28/95 (bug fix) Modified menu and tk_dialog scripts to restore any
+old grab that might have been in effect before a menu or dialog was
+posted.
+
+----------------- Released patch 4.0p1, 7/29/95 ----------------------
+
+8/4/95 (bug fix) Calls to toupper and tolower weren't using the UCHAR
+macro, so they didn't always work in non-U.S. locales. (JO)
+
+8/14/95 (new feature) Added -tearoffcommand option for menus.
+
+8/16/95 (bug fix) Canvases didn't generate proper Enter and Leave
+events if the Leave handler for an item reconfigured the canvas in
+a way that made the old current item the new current item again. (JO)
+
+8/21/95 (bug fix/feature change) When -takefocus was a script, Tk
+was allowing window viewability to override it. Changed so that
+viewability is now ignored when -takefocus is a script. (JO)
+
+8/21/95 (bug fixes) Fixed memory leaks in tkSend.c, tkSelect.c, and
+tkUnixWm.c (JO).
+
+8/21/95 (bug fix) Text widgets didn't handle commands like
+".t search -backwards foo end 1.0" properly: never found foo. (JO)
+
+8/23/95 (new feature) Added Makefile and configure.in support for
+dynamic loading. (JO)
+
+8/25/95 (bug fix) The "frame" and "toplevel" commands couldn't safely
+be renamed, due to a kludgy way that they shared a single command
+procedure. Split into separate procedures. (JO)
+
+8/25/95 (bug fix) Fixed bug in libary/menu.tcl that caused "grab
+window not visible" errors for popup menus (and perhaps elsewhere?). (JO)
+
+8/25/95 (bug fix / new feature) The "gray25" bitmap was really only
+12.5% on, not 25%. Added new "gray12" bitmap that is the same as the
+old "gray25". "Gray25" is still supported for compatibility, but its
+use is deprecated. (JO)
+
+8/25/95 (bug fix) Scrollbar bindings didn't properly handle case where
+B2 is clicked while B1 is already down. (JO)
+
+8/26/95 (bug fix) Menus were ignoring -activebackground if tk_strictMotif
+was set, but not -activeforeground. Changed to ignore both. (JO)
+
+8/26/95 (bug fix) Scales and scrollbars didn't properly handle a
+-repeatdelay value of 0 (they shouldn't auto-repeat in this case). (JO)
+
+8/28/95 (bug fix) Tcl errors were occurring for tkPriv(oldGrab) when
+clicking on a disabled option menu. (JO)
+
+8/28/95 (bug fix) Changed event-handling code to use FD_SETSIZE instead
+of OPEN_MAX, since OPEN_MAX is incorrect on some systems (e.g., IRIX). (JO)
+
+8/28/95 (bug fix) Fixed bug in photo images that caused garbling of
+image data in the "put" and "copy" commands if the source data had
+only one scan line but had a width less than the width of the target
+image. (JO)
+
+8/29/95 (bug fix) Tk used to refuse to post menus if they had no
+entries. This made it impossible for a menu to fill itself the first
+time it is posted. Changed to allow menus with no entries to be
+posted. (JO)
+
+8/30/95 (bug fix) If there was extra space at the bottom of a menu,
+it wasn't being redisplayed properly.
+
+8/30/95 (new feature) Added -transient option to menus.
+
+8/30/95 (new features) Added proper button 2 support to both scrollbars
+and scales (it sets the slider position from the mouse position). (JO)
+
+8/30/95 (bug fix) Fixed potential core dump that could occur in
+photo images (ReadPPMFileHeader could overflow buffer under some bad
+inputs, such as certain GIF images). (JO)
+
+8/30/95 (bug fix) Errors of the form `syntax error in expression "!"'
+could occasionally happen in tkScaleDrag. (JO)
+
+8/31/95 (new feature) Changed man page installation (with "mkLinks"
+script) to create additional links for manual pages corresponding to
+each of the procedure and command names described in the pages. (JO)
+
+9/1/95 (new feature) Added "after info" command. Also added checks
+so that one interpreter can't cancel another's "after" events. (JO)
+
+9/8/95 (bug fix) Fixed bug that could cause memory corruption and core
+dumps if a "fileevent" handler was deleted while the handler was
+active. (JO)
+
+9/11/95 Reorganized Tk sources for Windows and Mac ports. All sources
+are now in subdirectories: "generic" contains sources that work on all
+platforms, "windows", "mac", and "unix" directories contain platform-
+specific sources. (SS)
+
+9/11/95 (new feature) Added new "notifier" mechanism to allow multiple
+implementations of the mechanisms for finding out about events. This
+change was necessary to support Mac and PC platforms, but it may also
+allow other goodies such as combining Xt and Tk widgets in a single
+application. See the new manual entry Notifier.3 for details. (SS)
+
+9/11/95 (feature change) Changed interface to Tk_RestrictProc so that
+(a) it takes a clientData argument instead of display and arg, and
+(b) it returns a value that can ask for the event to be discarded as well
+as deferred or processed. (SS)
+*** POTENTIAL INCOMPATIBILITY ***
+
+9/11/95 (new feature) Added TK_WINDOW_EVENTS #define, which is equivalent
+to TK_X_EVENTS but is now preferred, since it applies to all platforms. (SS)
+
+9/11/95 (feature change) Can't export variables anymore because this doesn't
+work under Windows DLLs. Eliminated tk_NumMainWindows variable and replaced
+with procedure Tk_GetNumMainWindows. (SS)
+*** POTENTIAL INCOMPATIBILITY ***
+
+9/11/95 (new feature) Added procedure Tk_PreserveColormap to increment
+the reference count on colormaps. Used in photo widgets. (SS)
+
+----------------- Released patch 4.0p2, 9/15/95 ----------------------
+
+----------------- Released 4.1a1, 9/15/95 ----------------------
+
+9/22/95 (renamed files) Changed the names of the bitmap images in the
+$tk_library/demos/images directory to use the .bmap file extension. (RJ)
+
+9/22/95 (bug fix) Fixed bug where text widgets could occasionally
+display the insertion cursor both at the end of one line and the
+beginning of the next. (JO)
+
+9/25/95 (bug fix) Fixed bug that could cause core dumps when an
+application uses multiple screens and a binding destroys the main
+window (bind code was using MainInfo structure after it had been
+freed). (JO)
+
+9/25/95 (bug fix) Text widgets sometimes scrolled backwards on
+occasion if you dragged down past the bottom of the scrollbar. (JO)
+
+9/25/95 (bug fix) Fixed bug in menus where a cascaded submenu posted
+from a torn-off menu could be left posted if mouse was pulled off the
+end of the cascade and released. (JO)
+
+9/25/95 (new feature) Added "--" switch to wish, so that you can
+pass arguments like -n through to a script without having wish
+interpret them. (JO)
+
+9/25/95 (bug fix) Fixed core dump that could occur for radiobuttons
+and selectbuttons if -selectcolor was an empty string. (JO)
+
+9/26/95 (bug fix) Entries didn't used to notice if a trace procedure
+on the -textvariable overrode a new value set by the entry. This
+could cause the variable to get out of sync with the contents of the
+entry. (JO)
+
+9/26/95 (new feature) Added -sliderrelief option to scales, changed
+default bindings to change the slider's relief to sunken while it's
+being dragged with the mouse. (JO)
+
+9/26/95 (bug fix) TkColor.c wasn't computing colormap size correctly;
+could result in X Protocol error for QueryColors when colormaps run
+out of colors. (JO)
+
+9/26/95 (bug fix) Wish couldn't handle script files with spaces in
+their names. (JO)
+
+9/27/95 (cosmetic clean-up) Removed extraneous spaces to make error
+messages consistent: ": should be" is now ": should be". (JO)
+
+9/27/95 (feature change) Modified tk_dialog so that it uses the
+option database for the -wraplength option on the message. This
+allows the option to be overridden by the caller. (JO)
+
+9/28/95 (bug fix) Wish incorrectly parsed the command line under
+Windows, causing backslashes to be substituted. (SS)
+
+9/28/95 (bug fix) Wish now sources wishrc.tcl instead of .wishrc. (SS)
+
+9/28/95 (bug fix) Tk_DoOneEvent returned 0 under some circumstances
+when it was possible to find more work to do. For example, if a
+signal interrupted select(), but no event handlers were triggered, it
+would return 0 even though it could still detect events by reentering
+select(). (SS)
+
+9/29/95 (bug fix) "winfo interps" caused a crash under Windows. (SS)
+
+10/1/95 (feature change) Eliminated Tk_NotifyIdle interface in favor of
+Tk_IdlePending. (SS)
+
+10/1/95 (bug fix) Turned motion event collapsing into an idle handler
+so it will be easier to move the event loop into Tcl. (SS)
+
+10/1/95 (bug fix) Fixed several problems with negative coordinates
+in canvases. One example: dragging a canvas rectangle with a wide
+border and fractional coordinates could leave junk on the screen
+if the rectangle was in negative coordinate space. (JO)
+
+10/2/95 (bug fix) Tk was improperly handling Enter/Leave events
+during a button grab. (SS)
+
+10/2/95 (new feature) Added support for the Macintosh do script
+('dosc') event. Available only on the Macintosh. (RJ)
+
+10/4/95 (new feature) Added support for compiling with VC++.
+Resulting binaries work under Win32s through NT.
+
+----------------- Released 4.1a2, 10/6/95 ----------------------
+
+10/10/95 (new feature) Macintosh Tk now supports the complete set
+of X cursors that Unix Tk supports. (RJ)
+
+10/11/95 (bug fix) Tk now supports all of the X11 cursors under
+Windows. (SS)
+
+10/11/95 (bug fix) The "wm resizable" command was missing from the
+Windows version of Tk. (SS)
+
+10/12/95 (bug fix) Macintosh Tk had problems with clipping toplevel
+windows that children of any frame other than another toplevel. (RJ)
+
+10/13/95 (bug fix) Eliminated dependency on MKS toolkit for generating
+the tk.def file from Borland object files. (SS)
+
+10/16/95 (bug fix) Fixed clipping and update problems relating to
+the raising and lowering of overlapping windows on Mac. (RJ)
+
+10/30/95 (bug fix) When focus-follows-mode (invoked via tk_focusFollowsMouse),
+was focussing on windows even in situations where keyboard traversal would
+skip the window. Changed to use the tkFocusOK procedure so that the
+criteria for focussing are the same in both modes. (JO)
+
+11/2/95 (bug fix) Changed listbox bindings to ignore double-clicks.
+This avoids errors that used to occur if a user defined a binding
+for double-click that deleted the listbox. (JO)
+
+11/3/95 (feature change) Moved most of the Tk event loop to Tcl. Many
+Tk_ names have become Tcl names now:
+
+TK_READABLE => TCL_READABLE
+TK_WRITABLE => TCL_WRITABLE
+TK_EXCEPTION => TCL_EXCEPTION
+TK_DONT_WAIT => TCL_DONT_WAIT
+TK_WINDOW_EVENTS => TCL_WINDOW_EVENTS
+TK_FILE_EVENTS => TCL_FILE_EVENTS
+TK_TIMER_EVENTS => TCL_TIMER_EVENTS
+TK_IDLE_EVENTS => TCL_IDLE_EVENTS
+TK_ALL_EVENTS => TCL_ALL_EVENTS
+Tk_IdleProc => Tcl_IdleProc
+Tk_FileProc => Tcl_FileProc
+Tk_TimerProc => Tcl_TimerProc
+Tk_TimerToken => Tcl_TimerToken
+Tk_BackgroundError => Tcl_BackgroundError
+Tk_CancelIdleCall => Tcl_CancelIdleCall
+Tk_CreateFileHandler => Tcl_CreateFileHandler
+Tk_CreateTimerHandler =>Tcl_CreateTimerHandler
+Tk_DeleteFileHandler => Tcl_DeleteFileHandler
+Tk_DeleteTimerHandler =>Tk_DeleteTimerHandler
+Tk_DoOneEvent => Tcl_DoOneEvent
+Tk_DoWhenIdle => Tcl_DoWhenIdle
+Tk_Sleep => Tcl_Sleep
+tkerror => bgerror
+
+Other than the name changes, the functions are the same. In addition,
+there are #defines in tk.h so that the old Tk names will still work.
+tkerror and bgerror are specially hacked as synonyms, so it should be
+safe to use either one. You should switch to the new Tcl names ASAP,
+though, since the old Tk names will eventually be desupported. (JO)
+
+11/7/95 (features removed) As part of moving the event loop to Tcl,
+the following procedures were deleted:
+ - Tk_EventInit (the presence of the event loop in Tcl should
+ make this unneccessary).
+ - Tk_CreatFileHandler2 (you can get the same effect by using event
+ sources in Tcl, but you have to modify your code to use the new
+ Tcl APIs).
+ - All of the stuff in the manual entries Notifer.3 and QueueEvent.3;
+ this has changed because the notifier got reworked when it was
+ moved to Tcl.
+*** POTENTIAL INCOMPATIBILITY ***
+
+11/7/95 (feature change) Changed to use exit handler to cleanup windows
+in Tk, so Tk no longer needs to have a private copy of the "exit" command.
+(JO)
+
+11/7/95 (bug fix) If wish was invoked with a command-line geometry and
+a script file (e.g. "wish foo.tcl -geometry 30x20"), and if one of
+the windows created by the script used the -setgrid option, then the
+width and height from the command line were lost. (JO)
+
+11/8/95 (bug fix) The "see" command didn't work quite right for texts:
+if the window was small and you try to "see" a line just offscreen,
+Tk centered the line (actually, mis-centered it) when it should have
+aligned it at the top or bottom. (JO)
+
+11/9/95 (bug fix) The "send" command crashed if you tried to send to
+a different display with "-displayof". (JO)
+
+11/9/95 (bug fix) The Symbol font didn't print right in Postscript
+output, because of changes made to re-encode fonts to get proper
+ISO Latin1 behavior. Changed the code not to re-encode the Symbol
+font. (JO)
+
+11/13/95 (bug fix) Fixed Makefile.in and configure.in for UNIX so that
+configure can be run from a clean directory separate from the Tcl source
+tree, and compilations can be performed there. (JO)
+
+11/17/95 (bug fix) If a window was gridded, Tk still computed the
+default maximum dimensions in pixel units, which resulted in windows
+that could grow much larger than the screen. (JO)
+
+11/17/95 (bug fix) If a menus entries were all disabled, posting
+the menu and typing Up or Down caused an infinite loop, locking
+up the screen (JO).
+
+11/19/95 (bug fix) The focus wasn't being restored properly after a
+menu selection in a cascaded menu. (JO)
+
+11/19/95 (bug fix) Menubutton's didn't stipple display their images
+differently when disabled. Change to have the same behavior as buttons:
+the image is stippled over in the background color when the menubutton
+is disabled. (JO)
+
+11/21/95 (bug fix) Changes in display attributes such as font could
+cause core dumps in the text widget under some circumstances involving
+line wrapping. (JO)
+
+11/22/95 (bug fix/new feature) Changed both the placer and the packer
+to ensure that slaves are unmapped whenever the master is unmapped.
+This saves time that slaves might otherwise spend trying to redisplay
+themselves when they're unmapped. (JO)
+
+11/22/95 (bug fix) Space and return keys didn't work for menus if
+they were posted via Alt-x keystrokes. (JO)
+
+11/24/95 (bug fix) tk_dialog procedure had binding for <Return> that
+always activated default binding, even if input focus was in some
+other binding. Removed this feature, since existing focus support
+will already "do the right thing". (JO)
+
+11/24/95 (bug fix) Both canvases and texts could dump core if a binding
+(such as ButtonRelease on an internal item) deleted the widget. (JO)
+
+11/24/95 (feature change) Replaced "configInfo" file with tkConfig.sh,
+which is more complete and uses slightly different names. Also
+arranged for tkConfig.sh to be installed in the platform-specific
+library directory. (JO)
+
+11/24/95 (bug fix) It was possible for a slave to be placed or packed
+-in itself, with unpleasant consequences. It is now an error for the
+slave to be its own master for geometry management. (JO)
+
+11/25/95 (bug fix) The -command option of scales was sometimes being
+invoked spuriously (e.g. when the mouse moved in the scale without a
+button down). This was because the scale wasn't rounding properly
+when setting the scale value from its associated variable. (JO)
+
+----------------- Released patch 4.0p3, 11/28/95 ----------------------
+
+12/18/95 (feature change) Moved Tk_Preserve, Tk_Release, and
+Tk_EventuallyFree to Tcl, renamed to Tcl_Preserve etc. Added #defines
+to tk.h so that the old names still work. (JO)
+
+12/23/95 (bug fix) If a single process had > 1 Tk application, Tk
+didn't guarantee that the application names were unique, which could
+cause all sorts of confusion with "send". (JO)
+
+12/23/95 (feature change) Eliminated Tk_CreateMainWindow and moved
+all of its functionality to Tk_Init. All that you need to do now
+to get Tk in an application is to call Tk_Init. Improved Tk_Init
+so that -colormap and -visual command-line arguments are now passed
+through to TkCreateFrame. Tk_Main is much simpler now, since a lot
+of its functionality has moved to Tk_Init. (JO)
+*** POTENTIAL INCOMPATIBILITY ***
+
+12/23/95 (new feature) Added support for Tcl_StaticPackage so
+that Tk can now be loaded into slave interpreters with the "load"
+command to create new applications. (JO)
+
+12/23/95 (new features) Added support for -colormap and -visual command-
+line options for wish. (JO)
+
+1/4/95 (bug fix) Fixed keyboard code to properly handle alt-key
+sequences for international keyboards and menu-accelerators. (SS)
+
+1/5/96 (bug fix) Scrollbar code sometimes generated errors on accesses
+to tkPriv(relief) during control-clicks. (JO)
+
+1/9/96 (new feature) added the "grid" command to provide a table based
+geometry manager. (SU)
+
+1/12/96 (performance optimization) Changed the way tag information is kept
+in the text's Btree so the cost of adding and removing tag ranges is no longer
+proportional to the number of unique tags in the text. In the old system
+the cost of adding N unique tags was O(N-squared). The new implementation is
+optimized for tags that only cover a small amount of text, measuring from
+their earliest tag range to the end of their last range. In the best case the
+cost of adding a tag range is unrelated to the number of unique tags, so the
+cost of adding N tags is only O(N). In the worst case, where all tags
+cover all the text, the cost is still O(N-squared) to add N such tags.
+Deleting tags still has an O(N) cost (so deleting N tags is O(N-squared),
+but it is now a factor of 2 faster than the old system. (BW)
+
+1/12/96 (new feature) added the text "dump" operation that returns information
+about all elements in a text widget: text, tags, marks, and windows. (BW)
+
+1/12/96 (new feature) added the text "mark next" and "mark previous" operations
+to search forward and backwards for the next (previous) mark in the text. (BW)
+
+1/12/96 (new feature) added the text "tag prevrange" operation to search
+backwards for the current or previous range of a tag. (BW)
+
+1/16/96 (new feature) Added support for relative widget placement on
+the "grid" command. (SU)
+
+1/17/96 (new feature) Modified the Makefile/configure setup to support
+compiling Tk as a shared library. Use the --enable-shared option to
+the "configure" script. (JO)
+
+----------------- Released 4.1b1, 1/26/96 -----------------------
+
+2/2/96 (bug fix) Frames were getting a default size of 200x200, whereas
+there should be no default. (JO)
+
+2/2/96 (bug fix) Argc wasn't getting reset properly after Tk removed
+the arguments it understood from those on the command line. (JO)
+
+2/6/96 (bug fix) Fixed off by one error in argument parsing code under
+Windows. (SS)
+
+2/6/96 (bug fix) "wm transient" now works under Windows. The resulting
+toplevel is created with a modal dialog box frame and will not appear
+in the taskbar under Windows '95. (SS)
+
+2/9/96 (bug fix) Changed Makefile.in to use -L and -l for Tcl and Tk
+libraries so that shared libraries are more likely to be found correctly
+on more platforms. (JO)
+
+2/14/96 (feature change) Eliminated tk_CanvasTagsOption variable because
+it can't be exported safely across DLL boundaries. Instead, exported
+Tk_CanvasTagsParseProc and Tk_CanvasTagsPrintProc procedures for
+use by canvas type managers in creating their own custom options. (JO)
+*** POTENTIAL INCOMPATIBILITY ***
+
+2/14/96 (bug fix) "winfo pointerxy" when applied to a non-toplevel window
+crashed wish. (SS)
+
+2/14/96 (bug fix) "tkwait visibility" would hang under Windows. (SS)
+
+2/14/96 (bug fix) Cursors were not being updated until an enter event.
+In cases where the cursor left the toplevel and reentered before Tk
+noticed, the cursor would get "stuck" until the next enter event.
+Similarly, if the cursor attribute of a window was updated while the
+mouse was in the window, the cursor would not change until the next
+time the mouse entered the window. (SS)
+
+2/15/96 (bug fix) If a top-level was resizable in one direction
+(e.g. "wm resizable . 0 1"), once the user resized it any changes
+in the internally requested size (by the widgets) were ignored,
+even for the non-resizable dimension. Fixed to handle the two
+dimensions totally independently, so the widget's requests are
+honored as long as that dimension hasn't been set by the user. (JO)
+
+2/17/96 (bug fix) If a text widget had very long lines (e.g. more than
+32K pixels), integer overflow could occur, resulting in parts of the
+line not being visible. (JO)
+
+2/20/96 (feature change) Changed the -minsize option of grid to take
+screen units instead of pixels. (SU)
+
+2/20/96 (bug fix) grid row and column weights are compared against
+MINWEIGHT (0.001) instead of 0.0 to guard against divide by zero errors
+during weight normalization. (SU)
+
+2/20/96 (bug fix) Menu commands were not being invoked sometimes.
+There was a race condition that caused events to be processed while a
+menu was being unposted. (SS)
+
+----------------- Released 4.1b2, 2/23/96 -----------------------
+
+2/23/96 (bug fix) Alt-keys invoked in torn-off and popped up menus
+caused menus to be posted in the parent toplevel. (JO)
+
+2/23/96 (bug fix) Canvases weren't always updating their scrollbars
+when they should. (JO)
+
+2/23/96 (bug fix) Fixed core dump that could occur if a WM_DELETE_PROTOCOL
+handler generated an error. (JO)
+
+2/24/96 (bug fix) Removed dependencies on Makefile in the UNIX Makefile:
+this caused problems on some platforms (like Linux?). (JO)
+
+2/24/96 (feature change) Changed text and entry widgets so that they
+set the insertion cursor before inserting during a button-2 click.
+Also made optional bindings check for tk_strictMotif at the time of
+the event, rather than at the time the bindings are created. (JO)
+
+2/24/96 (bug fix) Tk tended to crash with an X error when unsetting
+an icon window (e.g. "wm iconwindow . {}"). (JO)
+
+2/25/96 (bug fix) Wasn't removing windows from the WM_COLORMAP_WINDOWS
+property when they were deleted. (JO)
+
+3/1/96 (new feature) Added new "bbox" widget command for entries.
+Also modified mouse bindings for entries and texts so that the
+mouse position rounds to the nearest inter-character gap, rather
+than the left edge of the character under the mouse. This provides
+more natural selection behavior. (JO)
+
+3/1/96 (bug fix) Fixed core dump that could occur in image code if an
+image was deleted while in use in a widet, then re-used in another
+widget while "deleted". (JO)
+
+3/1/96 (bug fix) Calling wish with a single argument caused a crash
+under Windows due to an off-by-one error in the argument parsing code. (SS)
+
+3/1/96 (bug fix) Palette management was broken and resulted in
+incorrect palette realization and refresh behavior. Also, images were
+being drawn incorrectly if they were attached to widgets that had a
+private colormap. (SS)
+
+3/2/96 (bug fix) It was possible to press the mouse button over an
+option menu, drag to a pulldown menu, and have the pulldown menu
+popup in place of the option menu. Fixed this so that option menus
+are isolated from each other and from pulldowns. (JO)
+
+3/2/96 (bug fix) Fixed yet another bug that caused long delays when
+raising toplevel windows. (JO)
+
+3/2/96 (bug fix) Fixed bug in canvases where zero-sized rectangles
+and ovals didn't always redisplay right (could leave trailing
+garbage on screen when moved). (JO)
+
+3/2/96 (bug fix) Entry widgets reset their insertion cursor, selection,
+and view whenever the text variable changed, plus whenever a "configure"
+widget command was invoked and there was a text variable for the
+widget. Fixed to preserve this information as much as possible. (JO)
+
+3/5/96 (new feature) Added version suffix to shared library names so that
+Tk will compile under NetBSD and FreeBSD (I hope). (JO)
+
+3/6/96 (bug fix) Changed the way certain configure & motion events are
+reported. This fixes several bugs in menus & "winfo rootx". (RJ)
+
+3/7/96 (bug fix) Fixed tag remove bug that showed up when draging out a
+selection. If you had dragged left, then tried to drag back right, the
+left edge of the selection wasn't being updated because the tag remove
+wasn't doing anything. (BW)
+
+3/7/96 (bug fix) Fixed the boundary conditions of tag prevrange. The second
+index argument wasn't effecting in stopping the search if it fell within
+a range. The second index has to come at or before the start of a range
+for the range to be found by tag prevrange. (BW)
+
+3/7/96 (bug fix) "puts" to stdout or stderr when running from a script
+caused wish41.exe to exit silently. Now the output is silently
+discarded without generating an error. (SS)
+
+3/7/96 (bug fix) Fixed bug where wish was treating empty lines in the input
+as end of input, if the input came from stdin. This would cause it to
+complain about missing closing braces etc. (JL)
+
+----------------- Released 4.1b3, 3/8/96 -----------------------
+
+3/9/96 (bug fix) Fixed bug in text.tcl that could cause errors in text
+widgets of the form 'can't use non-numeric string as operand of "-"'. (JO)
+
+3/12/96 (feature improvement) Modified startup script to look in several
+different places for the Tcl library directory. This should allow tk
+to find the libraries under all but the weirdest conditions, even without
+the TK_LIBRARY environment variable being set. (JO)
+
+3/14/96 (bug fix) "wish bogus_file_name" didn't print an error message. (JO)
+
+3/14/96 (bug fix) Button-2 wasn't claiming the focus during paste
+operations. (JO)
+
+3/14/96 (bug fix) "tkwait visibility" use to hang forever if its window
+was deleted. Now it detects this condition and returns an error. (JO)
+
+3/16/96 (bug fix) Changed configuration stuff to get dynamic loading and
+shared libraries working under AIX. (JO)
+
+3/16/96 (bug fix) Fixed core dumps that could occur when a slave interpreter
+was deleted in the middle of executin bindings. (JO)
+
+3/18/96 (new feature) Added support for Activate/Deactivate events.
+Currently, these new X events will generated only on the Macintosh. (RJ/CS)
+
+3/21/96 (bug fix) The "tag prevrange" command would fail to return the current
+range if it began at 1.0 and the starting point of the search was within
+the range. (BW)
+
+3/21/96 (configuration improvement) Changed configure script so it
+doesn't use version numbers (as in -ltk4.1 and libtk4.1.so) under
+SunOS 4.1, where they don't work anyway. (JO)
+
+3/22/96 (bug fix) Made Tk more robust against interpreter deletion. Now it
+should be safe to delete an interpreter with a Tk application inside it,
+without first deleting the Tk application. (JL)
+
+3/26/96 (bug fix) Tk now returns results from a "send" to an interpreter
+in which the Tk application is destroyed, if the interpreter continues
+computing after the Tk application is destroyed. Previously any results
+computed after '.' was destroyed in the target interpreter were discarded
+by the "send". (JL)
+
+3/26/96 (new feature) Tk now provides a static Tktest package which is
+present only in test versions of Tk; this allows the testing commands to
+be loaded into new interpreters besides the main one. (JL)
+
+3/28/96 (bug fix) Changed the tk_dialog procedure *not* to make the
+dialog a transient for its parent. The old behavior meant that the
+dialog did not get posted if the parent was iconified. (JO)
+
+4/5/96 (bug fix) Tk would occasionally crash when destroying toplevels
+under Windows. (SS)
+
+4/5/96 (bug fix) Fonts were not being properly deallocated, causing
+GDI resources to be consumed and never released under Windows. (SS)
+
+4/11/96 (bug fix) Toplevel windows with no specified geometry were
+always appearing in the upper left corner of the screen under
+Windows. (SS)
+
+4/11/96 (bug fix) "wm minsize" did not properly report the minimum
+size imposed by the Windows window manager. (SS)
+
+4/13/96 (bug fix) Text widgets could dump core in some cases where
+text was inserted on the top visible line. (JO)
+
+4/16/96 (bug fix) Changed menu code to ignore errors that occur when
+restoring a grab: the old grab window might not be visible anymore. (JO)
+
+----------------- Released 4.1, 4/21/96 -----------------------
+
+5/1/96 (bug fix) "option readfile" did not handle files with CRLF
+line termination. (SS)
+
+5/1/96 (bug fix) Changed to install tkConfig.sh under "make install-binaries",
+not "make install-libraries". (JO)
+
+5/7/96 (bug fix) Moved initScript in tkUnixInit.c to writable memory to
+avoid potential core dumps. (JO)
+
+5/7/96 (bug fix) Changed tk_dialog back so that the dialog box is a
+transient window again. This is needed to make sure that the dialog
+box doesn't get obscured. Also changed it to return -1 if the dialog
+window is deleted before the user presses a button. (JO)
+
+5/16/96 (bug fix) Fixed bug that caused core-dumps if a text widget
+with -setgrid 1 was deleted by removing its command. (JO)
+
+5/16/96 (bug fix) Fixed bug that caused Tk initialization to use improperly
+initialized variables left over from previous invocation of Tk_Init on
+another interpreter. (JL)
+
+5/16/96 (new feature) Implemented application embedding on Windows
+platforms (only Tk inside another application, not the other way yet). (JL)
+
+5/16/96 (new feature) Added C API Tk_SafeInit that adds Tk to a safe
+interpreter. (JL)
+
+5/16/96 (bug fix) Fixed bug that caused Tk initialization to use improperly
+initialized variables left over from previous invocation of Tk_Init on
+another interpreter. (JL)
+
+5/16/96 (new feature) Implemented application embedding on Windows
+platforms (only Tk inside another application, not the other way yet). (JL)
+
+5/16/96 (new feature) Added C API Tk_SafeInit that adds Tk to a safe
+interpreter. (JL)
+
+5/22/96 (bug fix) Listboxes weren't properly ignoring double clicks on
+button 1. (JO)
+
+6/12/96 (bug fix) Focus was automatically placed on new toplevels.
+This caused the titlebar to flash during menubar traversal. (SS)
+
+6/12/96 (bug fix) Iconification of a window with a specified geometry
+by using the minimize button would leave the window in an inconsistent
+state. When the window was deiconified using "wm deiconify", the
+window would continue to display as an icon with the deiconified
+geometry. (SS)
+
+6/12/96 (bug fix) Fixed a resource leak where the text widget was not
+freeing all of the TkRegions it created. This fix affects all
+platforms, but is particularly important for Win32s. (SS)
+
+6/21/96 (configuration change) Added --enable-gcc switch to configure
+script to make Tk just like Tcl. Now Tk will not use gcc unless you
+request it explicitly. (JO)
+
+7/18/96 (bug fix) Changed "configure" script to add an extra -R switch
+(or whatever is appropriate to the platform) if the X library is in a
+nonstandard place. This guarantees that the shared library can be
+found at runtime without having to set the LD_LIBRARY_PATH variable. (JO)
+
+7/19/96 (bug fix) Fixed bug in tkImgGIF.c that cause core dumps if a
+GIF file contained multiple images. (JO)
+
+7/20/96 (bug fix) Deadlock could occur if a recursive series of send
+operations involved multiple displays. (JO)
+
+7/23/96 (bug fix) Fixed a resource leak where deallocated XIDs were
+taking up memory on Windows and Macintosh platforms. (SS)
+
+7/30/96 (bug fix) A core dump could occur if a <Destroy> handler for
+a window tried to create a child in the half-dead window. Fixed by
+making the window's name disappear from the name table once it starts
+to be deleted. (JO)
+
+----------------- Released patch 4.1p1, 8/2/96 -----------------------
+
+4/30/96 (new feature) Added support for named virtual events. New "event"
+command to define/destroy named virtual events and to programmatically
+send both real and virtual events to Tk. (CS)
+
+8/6/96 (bug fix) Entry widgets were invoking scrollbar update functions
+too often. (JO)
+
+8/9/96 (bug fix) 7/30 change above for <Destroy> handlers broke many
+things by making window available during Destroy handler. Reworked
+fix for core dump to simply disallow creating children of half-dead
+parents. (JO)
+
+8/12/96 (bug fix) Fixed bug where using the Copy menu item on the
+Macintosh would append a NULL character at the end of the text. (RJ)
+
+8/15/96 (bug fix) Fixed Mac code so garbage wouldn't be printed in
+text and entry widgets when function & other non-printing keys were
+pressed. (RJ)
+
+8/15/96 (configuration improvement) Changed the file patchlevel.h
+to be tkPatch.h. This avoids conflict with the Tcl file and is now
+in 8.3 format on the Windows platform. (RJ)
+
+8/19/96 (bug fix) Fixed a bug under Windows where the initial window
+position for a toplevel window was reported as +0+0, regardless of the
+actual position. (SS)
+
+8/21/96 (bug fix) If the last character on a line in a text widget was
+a space character that didn't completely fit, the text widget would
+sometimes add an extra wrap line. (JO)
+
+8/22/96 (feature change) Complete rewrite of the grid geometry manager.
+There is a new layout algorithm that produces better (but different)
+layouts in many common cases. (SU)
+
+8/22/96 (new feature) There are two new options for the grid geometry
+manager, "grid update" which forces an immediate layout calculation,
+and a "-pad" option to rowconfigure and columnconfigure that allows for
+extra space around widgets. (SU)
+
+8/22/96 (feature change) The order in which the grid geometry manager
+reports slaves is now last-managed first. (SU)
+
+8/22/96 (feature change) The column and row weights in the grid
+geometry manager are kept internally as integers, instead of floating
+point values. Floating point values are still accepted on the command line,
+but are truncated to integers. (SU)
+
+8/22/96 (new feature) There are four new commands for opening common
+dialog boxes: tk_chooseColor, tk_getOpenFile, tk_getSaveFile and
+tk_messageBox. Native dialog boxes are used wherever available. (IL)
+
+8/22/96 (new demos) Added "fsbox", "msgbox" and "clrpick" demos. (IL)
+
+8/23/96 (feature change) Invoking the edit menu on the Macintosh now
+generates the following virtual events <<Cut>>, <<Copy>>, <<Paste>>,
+and <<Clear>> instead of faking key events. (RJ)
+*** POTENTIAL INCOMPATIBILITY ***
+
+8/25/96 (bug fix) Fixed a bug that would cause "grid x" to dump core. (SU)
+
+8/26/96 (new feature) Added the "unsupported1" command to the
+Macintosh version of Tk. This command will allow you to set the style
+of a new toplevel Window (much like overrideredirect). You can use
+this to get access to all of the Native Mac window styles. This is to
+hold you over until we get a more general solution added to the
+toplevel command. (RJ)
+
+8/26/96 (new feature) Added support to handle the zoom box on a
+Macintosh window. (Currently, you can only get a Tk window with a
+zoom box by using the "unsupported1" command. (RJ)
+
+8/27/96 (documentation change) Removed old change bars (for changes in
+Tk 4.1 and earlier releases) from manual entries. (JO)
+
+----------------- Released 4.2b1, 8/30/96 -----------------------
+
+9/5/96 (bug fixes) Fixed several bugs in file dialogs: individual files
+could be listed twice, if a long list of files were shown, and the view
+scrolled to the right, and then a different file file was shown, the
+scrollregion on the canvas wasn't being reset, so the file dialog was
+broken from then on, added an update idletasks so that the watch
+cursor was shown when the dialog was thinking. For the motif file
+dialog, fixed the weights for resizing. On the clrpicker, fixed the
+finalColor variable which caused problems when the OK button was
+"clicked" before the dialog was mapped (in the test suite). Added Ioi's
+last changes from before he left. For message boxes, if a single button
+message box is shown (currently only 'ok'), it is set to be the default
+even if not specified. (KC)
+
+9/5/96 (bug fix) Fixed bug on Macintosh where menus would appear in a
+seemingly random location. (RJ)
+
+9/5/96 (bug fix) Text widgets had rounding problems with the "yview"
+command that caused them sometimes to round to the line before the
+correct one. (JO)
+
+9/5/96 (bug fix) Changed grab code to retry grabs after errors where
+another application already has the grab. This is needed to get
+around race conditions with some window managers and will hopefully
+solve the grab errors that people see occasionally. (JO)
+
+9/6/96 (bug fix) Fixed x-y coordinate confusion problem with scaling
+of window items in canvases. (JO)
+
+9/11/96 (bug fix) The open and save file dialogs would change the
+current working directory under Windows. (SS)
+
+9/12/96 (bug fix) The Tk event system was delivering events to dead
+windows, if the event handler got reentered during a Destroy event
+handler. This could cause core dumps and other problems. (JO)
+
+9/20/96 (bug fix) In XFillRectangles under Windows, a brush was not
+being deallocated. (SS)
+
+9/20/96 (bug fix) The Mac window manager used to generate a mouseUp
+event for a top level that was recently raised to the front/active
+window which often caused a tk(priv) error. The up event is no
+longer generated with solves several problems. (RJ)
+
+9/25/96 (bug fix) The font code under Windows was leaking memory
+whenever a new font was referenced using the three part font names. (SS)
+
+9/26/96 (bug fix) The tests for the common dialogs still used the 'testevent'
+function. I updated these calls in clrpick.test, msgbox.test, filebox.test
+to use the new event gereating mechanism.
+
+9/18/96 (bug fix) Long-standing bug in bind where <Button-1><Button-1> was
+reported as <Double-Button-1>, but <Double-Key-a> was reported as "aa". (CS)
+
+9/27/96 (bug fix) Bindings didn't work on 64-bit machines due to changes
+made for virtual events. (CS)
+
+9/30/96 (feature change) Binding for new virtual events included both
+lower and upper-case, e.g., <<Copy>> was defined as <Control-c> and
+<Control-C>. Previously, widgets were directly bound to only lower-case
+bindings. The upper-case binding caused incompatibility with some existing
+Tcl programs, so the upper case bindings for <<Cut>>, <<Copy>>, and <<Paste>>
+were removed. (CS)
+
+9/30/96 (bug fix) The postscript code in the canvas widget now uses
+channels to get and write .ps files which fixed a bug on the Mac where
+an output file would have mixed EOL characters. In addition, I added
+the ability for the prolog to come from the Tk shared library on the
+Mac which makes it possible to have a standalone application. (RJ)
+
+10/1/96 (feature change) "grid forget" was renamed "grid remove". A new
+command "grid forget" was added whose semantics are the same as "pack forget"
+(SAU)
+*** POTENTIAL INCOMPATIBILITY ***
+
+10/1/96 (feature change) grid no longer accepts floating point values for
+row or column weights, integers must be used. (SAU)
+*** POTENTIAL INCOMPATIBILITY ***
+
+10/1/96 (feature change) "grid {column,row}configure <master> <index>"
+returns a list of option value pairs for all of the row or column
+constraints. It used to return an error. (SAU)
+
+10/1/96 (bug fix) "The way grid handles '^' short-cuts was re-written
+to eliminate core dumps. (SAU)
+
+10/3/96 (feature change) A virtual event binding associated with a
+given physical event is now considered less specific than a binding for
+that same physical event, all other things being equal. (CS).
+
+10/3/96 (bug fix) Under Windows text placed on the clipboard did not
+undergo CRLF translation when delivered to other applications. (SS)
+
+10/3/96 (bug fix) Copying an image onto itself with a zoom factor that
+caused the image to grow was accessing freed memory. (SS)
+
+10/3/96 (bug fix) Under Windows, the image blank subcommand did not
+work. (SS)
+
+10/10/96 (bug fix) Under Windows & Macintosh, XSetFont and XChangeGC
+were not implemented, and XSetLineAttributes did not correctly update
+the GC. (SS)
+
+10/10/96 (bug fix) Under Windows, 8-bit non-palette displays were not
+handled properly. (SS)
+
+10/10/96 (bug fix) Under Windows, images of depth other than 8 or 24
+bits were not being rendered properly. (SS)
+
+10/10/96 (bug fix) Under Windows, bitmap subimages were not correctly
+displayed. (SS)
+
+10/14/96 (bug fix) Under Window, wm resizable would constrain both
+programatic resizes as well as user resizes. (SS)
+
+----------------- Released 4.2, 10/16/96 -----------------------
+
+10/17/96 (bug fix) XCopyPlane was broken under Windows and would cause
+a crash when used with a clipping bitmap. (SS)
+
+10/21/96 (bug fix) Added missing resources needed by tk_getOpenDialog
+on the Macintosh to the shared library for Tk. (RJ)
+
+10/22/96 (bug fix) Invoking a menu with an Alt key sequence caused an
+error due to a misplaced common in library/menu.tcl. (JO)
+
+10/23/96 (bug fix) Errors in files sourced by the Macintosh
+"Source..." menu are now correctly reported via the background
+error mechanism. (RJ)
+
+10/23/96 (bug fix) Fixed a bug in the Mac subwindow implementation
+that caused refreshes to not occur for canvases with embedded
+windows. (RJ)
+
+10/24/96 (bug fix) Provided workaround for Apple bug that doesn't
+handle zooming correctly for floating windows. (RJ)
+
+10/24/96 (bug fix) Macintosh tearoff menus are now correctly
+displayed as Mac floating windows. (RJ)
+
+11/1/96 (bug fix) Restored manual page for procedures like
+Tk_CreateWindowFromPath and Tk_DestroyWindow; was accidentally deleted
+when Tk_CreateMainWindow procedure was decommissioned. (JO)
+
+11/19/96 (bug fix) Fixed bugs in postscript code that would cause the
+prefix to not be included and the output file to have the wrong
+permissions. (RJ)
+
+12/2/96 (bug fix) Fixed problem with canvas lines where it didn't
+compute bounding boxes correctly for zero-width lines: this could
+potentially leave garbage on the screen when items were deleted or
+moved. (JO)
+
+12/5/96 (bug fix) Fixed the Macintosh implementation of pointer x/y
+which was returning garbage. (RJ)
+
+12/6/96 (bug fix) Fixed grid bug where the positioning of slaves was
+incorrect for non-zero values of ipadx and ipady (SU)
+
+12/6/96 (bug fix) Fixed grid bug where slaves got "lost" when an
+already managed slave is re-managed in a different master. (SAU)
+
+----------------- Released 4.2p1, 12/8/96 (Mac only) --------------
+
+1/17/97 (bug fix) Fixed bug where the Tk clipboard was not in sync
+with the Macintosh clipboard on start-up. (RJ)
+
+----------------- Released 4.2p2, 1/31/97 --------------
+
+----------------------------------------------------------
+Changes for Tk 4.2 go above this line.
+Changes for Tk 4.3 go below this line.
+----------------------------------------------------------
+
+9/19/96 (improvement) Implemented table driven mechanism for deciding
+whether a command is safe. If it is added by Tk_Init and it appears in the
+table then it is kept, otherwise it is removed in a safe interpreter. (JL)
+
+10/18/96 (new feature) Added support for application embedding:
+ - Frame and toplevel widgets now have a -container option, which
+ turns the widget into a container.
+ - Toplevel widgets have a -use option for requesting that the
+ widget be embedded in another application.
+ - Wish also supports a -use command-line option.
+Embedding is fully supported under Unix, but the implementation is
+not complete under Windows or the Macintosh (it works just well
+enough to support the Tcl/Tk plugin). (JO)
+
+10/22/96 (bug fix) The commands "winfo rootx" and "winfo rooty" didn't
+work for non-toplevel windows in embedded applications: they returned
+the coordinates of the nearest toplevel. (JO)
+
+12/02/96 (new feature) Implemented Safe Tk. Tk can now be loaded into a
+safe interpreter that has been created with tcl_safeCreateInterp, by
+calling load {} Tk interpname. (JL)
+
+12/02/96 (new feature) A safe Tk interpreter can no longer generate
+postscript output from a canvas. (JL)
+
+12/02/96 (new feature) Added -channel option to photo command to allow
+image data to be read from a channel. This is useful in safe Tk
+interpreters where the data cannot be read directly from a file. (JL)
+
+----------------------------------------------------------
+Changes for Tk 4.3 go above this line.
+Changes for Tk 8.0 go below this line.
+----------------------------------------------------------
+
+9/1/96 (new features) 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.
+ *** POTENTIAL INCOMPATIBILITY ***
+(CS)
+
+9/24/96 (bug fix) Under Windows, transient windows would be destroyed
+if their master was destroyed, even if the transient window was not a
+child of the master. (SS)
+
+10/18/96 (new features) A -menu option has been added to the toplevel
+widget command, which allows a menu to operate as a menubar. On the
+Macintosh, the menubar is displayed accross the top of the main monitor,
+just like with other applications. Under Windows and Unix, the menu is
+attached to the toplevel window. Also, changed some semantics.
+Tearoff menus will now reflect changes to the menu it was
+torn off from, and are deleted when the master menu is
+deleted. Tearoffs also reflect more look-and-feel of the
+platforms they are running on. (SRP)
+
+10/31/96 (bug fix) Under Windows, missing system cursors would
+generate an error instead of falling through to the Tk cursor of the
+same name. (SS)
+
+11/7/96 (feature change) Under Unix, default borderwidth is now 1 to
+more closely approximate CDE. (SS)
+Note: this change was undone on 6/12/97, restoring the default border
+width to 2 again. (JO)
+
+11/7/96 (new feature) The button widget now supports a -default option
+that draws a platform specific default ring around the widget. (SS)
+
+11/7/96 (feature change) Under Windows, buttons and scrollbars now
+have native look and feel. This affects the default class bindings
+and the way the some configuration options are interpreted. Refer to
+the widget manual pages for more details. (SS)
+*** POTENTIAL INCOMPATIBILITY ***
+
+11/19/96 (bug fix) Under Windows, images were incorrectly drawn on
+16-bit displays. (SS)
+
+11/19/96 (bug fix) Under Windows, the class name for the main window
+(.) was not properly generated from argv0. (SS)
+
+11/20/96 (bug fix) Fixed a couple of bugs in the Canvas widget. The
+postscript file is now created with the correct permissions. Also,
+the prolog is now properly included in all cases. (RJ)
+
+11/22/96 (bug fix) Under Windows, the initial directory and file names
+were not properly translated before being passed to the system
+open/save file dialogs. So forward slashes were not converted to
+backslashes, and tilde substitution was not performed. (SS)
+
+11/25/96 (feature change) Under Windows and Macintosh, the selection
+highlight is now hidden whenever an entry or text widget loses focus.
+Also, the previous selection information is not lost when a new
+selection is made in a different widget. (SS)
+
+11/26/96 (new feature) Added support for images as primitive types in
+text widgets. (SU)
+
+11/30/96 (configuration improvement) Modified configure.in to handle the
+case where Tcl and Tk are installed in different places by including both
+their library directories in the library search path for Tk. (JO)
+
+12/3/96 (bug fixes) Fixed two bugs related to canvas lines that caused
+the screen to be incorrectly refreshed, leaving garbage on the screen.
+One bug was related to lines with width zero, and the other was
+related to lines with very long miters. (JO)
+
+12/4/96 (bug fix) The "update" command was only syncing the display
+for its main window. Changed to sync all displays. (JO)
+
+12/5/96 (bug fix) Color deallocation would occasionally cause a panic
+under Windows. (SS)
+
+12/5/96 (bug fix) Errors during startup were silently discarded under
+Windows. (SS)
+
+12/5/96 (bug fix) Errors during startup were silently discarded under
+Windows. (SS)
+
+12/11/96 (bug fix) Text widgets weren't considering the -spacing1
+and -spacing2 options when computing their desired geometry. (JO)
+
+12/12/96 (feature change) Option menus using tk_optionMenu were
+created with command entries that set the option menu's variable in a
+command string. This has been changed so that the option menu's
+entries are now radiobutton entries so that the entries that matches
+the variable is now checked when the menu is posted. (SRP)
+
+12/12/96 (feature change) The destroy command no longer returns an
+error when a window does not exist. (SRP)
+
+12/13/96 (new feature) grid row/column-configure accepts a list of
+indices in addition to a single index. (SU)
+
+12/17/96 (bug fix) Under Windows, command line was not being parsed
+correctly if it contained the literal characters \" (CS)
+
+12/17/96 (feature change) Native Windows labels do not get a focus-ring
+border. (CS)
+
+12/17/96 (bug fix) Under Windows, colors specified as "#XXYYZZ" where XX, YY,
+or ZZ were not valid hex digits were getting a random color value instead of
+being an error. (CS)
+
+----------------- Released 8.0a1, 12/17/96 -----------------------
+
+12/23/96 (bug fix) Fixed two menu bugs:
+ - Menus could get stacked below other windows so that they weren't
+ visible when posted (especially under olvwm and fvwm).
+ - Under olvwm if you pressed button 1 over an entry in a new-style
+ menubar, the menu didn't appear until you moved the mouse slightly.
+(JO)
+
+1/6/97 (bug fix) Focus could accidentally get grabbed by an application
+away from the rightful focus owner if the focus recently changed from one
+application to another. (JO)
+
+1/6/97 (bug fix) Under Windows, the console was appearing even for
+non-interactive applications. This was a side effect of a general
+problem with the wm state of windows that were being mapped for the
+first time. (SS)
+
+1/6/97 (bug fix) Under Windows, the initialization code was not
+looking in the right directory for the Tk libraries when the program
+being run was not in the Tcl installation heirarchy. (SS)
+
+1/8/97 (bug fix) Under Windows, the windows were not being unmapped
+properly, which led to strange packer behavior. (SS)
+
+1/8/97 (bug fix) The "winfo containing" command (and the Tk_CoordsToWindow
+procedure) didn't work properly on Unix in the presence of embedding or
+menubars. (JO)
+
+1/15/97 (bug fix) Invoking "destroy ." as the command from a menu would
+cause Tk to crash because TkMainInfo was freed before menu released its
+resources. This bug had already been fixed for scrollbars and buttons. (CS)
+
+1/15/97 (bug fix) Tk is now working under Win32s again, including Win32
+version 1.25. Fixed separate problems in fonts and dialogs. (CS)
+
+1/15/97 (feature change) Under Windows, font sizes are now specified in
+points, not pixels. The mapping between pointsize and pixels depends on
+Windows having accurate metrics for the monitor (plug&play helps). Font
+metrics are still reported in pixels. (CS)
+
+1/21/97 (bug fix) Grid no longer reports rows or columns "out of range"
+when requesting their constraints. (SAU)
+
+1/21/97 (bug fix) Fixed some window manager related bugs on the
+Macintosh. Now better support global grabs. (RJ)
+
+1/21/97 (bug fix) For Windows: Fixed problems with canvas items that
+used end caps. Fixed arc implementation to more closely approximate
+X. Stippling now works properly on fat lines. (SS)
+
+1/21/97 (bug fix) Small interlaced GIF images were not properly
+decoded. (SS)
+
+1/21/97 (bug fix) More changes to image code to try to handle 16-bit
+displays properly under Windows. (SS)
+
+1/21/97 (bug fix) Numerous display bugs on Unix and Macintosh are now
+fixed. Numerous binding problems for menubars under Unix are now
+fixed. Deletion of menu separators under Windows is now fixed. (SRP)
+
+----------------- Released 8.0a2, 1/24/97 -----------------------
+
+1/29/97 (feature change) The -transient field for menus is no longer
+supported. There is now a -type field which is used to achieve the
+same purpose that the -transient field accomplished. When a menu is
+created, the -type field controls whether the menu is a normal
+pull-down menu, a floating tearoff menu or a menubar. This option is
+normally only used by the library code and internally by the menubar
+code. (SRP)
+*** POTENTIAL INCOMPATIBILITY ***
+
+2/5/97 (feature change) Changed the photo image mechanism to use
+Tcl_Channels instead of FILE * as an argument to image matching
+functions. The change will make it much easier to write cross
+platform image types in Tk. Note: FILE * is no longer used anywhere
+in Tk. (RJ)
+*** POTENTIAL INCOMPATIBILITY ***
+
+2/7/97 (enhancement) Were not allowed to bind to virtual events inside of
+canvas or text widget (e.g., "$canvas bind all <<foo>> {script}" or
+"$text tag bind sel <<foo>> {script}"); it would return an error
+disallowing that binding. Now _can_ bind to a virtual event, but that
+binding inside of the canvas or text widget will only fire if the
+underlying virtual event definition is of type key, button, motion,
+enter, or leave; all other physical event types get filtered out by the
+widget before the virtual event mapping is done. (CS)
+
+2/22/97 (bug fix) Under Unix, "wm geometry +-20+-30" didn't work. (JO)
+
+2/24/97 (bug fix) The photo image didn't always zero out enough of its
+pixel and dither correction arrays. (JO)
+
+2/25/97 (bug fix) Fixed focus problem that could cause "BadMatch (invalid
+parameter attributes)" in X_SetInputFocus requests on Unix. (JO)
+
+2/25/97 (bug fix and new feature) Added new "gray75" bitmap, fixed
+"gray25" bitmap to really be 25% on (due to an ancient mistake, it
+had been only 12% on). (JO)
+
+2/28/97 (bug fix) Windows: made embedding work again on Win32 platform.
+Prevent iconification, deiconinification on embedded windows. (JL)
+
+3/4/97 (new feature) Added the ability to manipulate the Apple and
+Help menus on the Macintosh; the system menu on Windows; and to have a
+right justified Help menu on Unix. See the documentation for menu.n
+for more details. (SRP)
+
+3/4/97 (bug fix) Prevented core dump at exit if a <Destroy> binding on "."
+gets invoked from destroying a nested widget and the binding causes the
+interpreter to be deleted. The core dump was being caused by the
+interpreter not being Tcl_Preserve'd during the destroy of ".". (JL)
+
+3/4/97 (bug fix) Under Unix, when embedded Tk is running in a separate
+process, correctly handle a race condition: ignore cross-over messages from
+the X server for windows that Tk thinks it had already deleted, when the
+containing process deletes its container window. Some other race conditions
+still remain, e.g. with pixmaps, colormaps and images. (JL)
+
+3/10/97 (bug fix) Prevented core dump in generic console code due to
+following a NULL pointer when the console interpreter was already deleted.
+This may happen due to different orders of deletion possible at exit. (JL)
+
+3/10/97 (bug fix) Fixed bug on Mac and Windows that caused time to be
+ignored when considering if a single click was actually a double
+click. (RJ)
+
+3/11/97 (feature change) A major oversight has been that although it was
+documented that the Tk programmer was asking for a font in points (1/72 of an
+inch), under Unix and Mac Tk was actually asking for a font in pixels, while
+only under Windows was it using points. This caused applications to appear
+much larger when run under Windows. Now, on all platforms the (purportedly)
+correct size in points is used when asking for fonts. However, for
+compatibility with existing tk4.2 applications that depend on fonts being of
+specified pixel size, XLFDs retain their incorrect behavior of getting a
+font in pixels. (CCS)
+*** POTENTIAL INCOMPATIBILITY ***
+
+3/13/97 (new feature) "tk scaling" command to setup the mapping between
+pixels and points. This scaling factor is used by all widgets that accept
+ruler distances, not just fonts. (CCS)
+
+3/24/97 (new feature) Added "-columnbreak" option to menu
+entries. When this value is "1", the entry will appear at the top of a
+new column in a non-menubar menu. Also added "-hideMargin". Together
+with "-columnBreak", menus with palettes are now possible. (SRP)
+
+3/26/97 (new features and bug fix) Titles for tearoff menus were
+broken on the Mac and Windows. Added the ability to set the title of a
+menu when it gets torn off and override Tk's automatic generation of
+the title. On the Macintosh, whenever a menu
+label contains three dots in a row "...", the menu will instead
+display the elipses character 'É'. (SRP)
+
+3/27/97 (bug fixes) When a menu had an error executing a postcommand,
+the error information was getting lost. On Windows, a set of
+menubuttons was not highligting properly when clicking between
+windows. On Windows, post commands were getting executed twice for
+popup menus. On Macintosh, fixed problem where menubars were not
+always current. (SRP)
+
+4/11/97 (new feature) Menubuttons now have a direction flag which
+controls where the menu popups up relative to the button. (SRP)
+
+4/24/97 (bug fix) Transient windows did not obey the resizable setting
+under Windows. (SS)
+
+4/24/97 (bug fix) wm geometry did not correctly parse negative
+coordinates. (SS)
+
+4/29/97 (bug fix) Changed the canvas polygon implementation to only
+report the coordinates specified by the end user not the automatically
+generated end point of a self closing polygon. (RJ)
+*** POTENTIAL INCOMPATIBILITY ***
+
+4/23/97 (feature change) Loosened the rules on parsing font names so that
+unix-centric fonts in scripts don't break when run on Windows or Mac.
+(1) Previously, an XLFD had to specify font name, weight, slant, and size;
+now, a minimal XLFD (such as "*-times-*") will be accepted, and all
+unspecified attributes will be given default values. (2) Previously, in the
+{name size style ...} format, only the style was optional; now both the size
+and the style are optional; this solves the problem of old scripts that
+contain specifications of the form "-font fixed" or "-font times". (CCS)
+
+5/7/97 (new feature) Menus now send a virtual event <<MenuSelect>>
+when an item is highlighted in a menu. Applications can use this to
+implement context-sensitive help. (SRP)
+
+5/14/97 (bug fix) Fixed a race condition in the focus code where focus
+could be taken away from a window incorrectly. Scenario is that the main
+window creates a toplevel and assigns focus to it. When the user moves the
+mouse from the main window into the toplevel there was a race between
+two different kinds of focus events. (BW)
+
+5/20/97 (bug fix) Fixed bug where the clipboard was not rendered before
+the application exited. (SS)
+
+5/22/97 (feature change) When a Tk8.0 menu is configured, all menus
+derived from it (menubars, tearoff) mirror the changes. This was not
+true for the "-tearoff" flag. In Tk4.6, tearoff menus had the
+"-tearoff" flag turned off. Now, the "-tearoff" flag is tracked just
+as the other options are. Tearoff menus and menubars with the
+"-tearoff" option set will not display the tearoff item. This means
+that a given menu entry for a menu and a tearoff of that menu will
+match now. (SRP)
+*** POTENTIAL INCOMPATIBILITY ***
+
+----------------- Released 8.0b1, 5/27/97 -----------------------
+
+5/30/97 (bug fix) Made the options to the grid command shortcut-able.
+Ie. You can now use -stick, in addition to -sticky. (RJ)
+
+6/2/97 (bug fix) Fixed bug in startup code that caused a problem in
+finding the library files when they are installed in a directory
+containing a space in the name. (SS)
+
+6/2/97 (bug fix) Virtual events associated with <Enter>/<Leave> in text
+widget tag caused panic. (CCS)
+
+6/6/97 (bug fix) On some systems, struct timeval.tv_sec is unsigned. (SS)
+
+6/6/97 (feature change) Changed -default option on buttons to take
+three states: normal, active, disabled. This allows apps to have a
+row of buttons where the default ring moves between buttons without
+changing the geometry of the buttons. See the button.n manual page
+for more details. (SS)
+*** POTENTIAL INCOMPATIBILITY with Tk 8.0b1, but not with Tk 4.2 ***
+
+6/9/97 (bug fix) Canvas postscript printing now works for bitmaps
+under Windows. (SS)
+
+6/10/97 (bug fix) Fixed bug in bindings for listboxes where state wasn't
+being properly initialized on Shift-1 button presses. (JO)
+
+6/11/97 (bug fix) Text widget display code did not include internal
+padding in the damage calculation for borders leading to unrefreshed
+sections on Windows and Mac. (SS)
+
+6/12/97 (feature reversal) Changed default border widths under Unix
+back to 2 again. This reverses the change made on 11/7/96. (JO)
+
+6/13/97 (bug fixes) In canvas text item: the insertion cursor wasn't shown
+if insertion point was at end of text item, it was impossible to click to
+position the insertion point after the last character, and @x,y indices were
+computed incorrectly if -scrollregion had been specified and canvas was
+scrolled. (CCS)
+
+6/13/97 (bug fix) Hitting up/down arrows in a text widget packed in a
+toplevel window created with the "-screen" option would cause an error dialog
+to pop up. (CCS)
+
+6/12/97 (bug fix) Fixed bug in canvas text items where multi-line
+selections were not highlighted properly. This bug existed only in
+earlier releases of Tk 8.0. (JO)
+
+6/16/97 (bug fix) In some obscure cases, canvas window items could
+accidentally specified a 0x0 size for the window, which caused a
+BadValue error under X. (JO)
+
+6/17/97 (bug fix) Tk buttons on the Macintosh will now correctly
+draw under MacOS 8.0. (RJ)
+
+6/18/97 (feature change) Changed the way highlights are drawn in text
+widgets so that the empty space to the left of a line is highlighted
+whenever the leftmost character of the line is highlighted (the empty
+space didn't used to be highlighted). This produces a neater left
+edge when several lines are selected. (JO)
+
+6/18/97 (bug fix) Tk was using the wrong system colors to draw various
+widgets under Windows. (SS)
+
+6/19/97 (bug fix) Under Windows, the "wm transient" and "wm overrideredirect"
+subcommands can now be applied to a toplevel to change its window
+style at any time during the life of the window. (SS)
+
+6/19/97 (feature change) All GIF and XBM images needed for the "TK"
+file dialog box are included in-line in tkfbox.tcl. (IL)
+
+6/27/97 (bug fix) Revamped focus code to eliminate most XSetInputFocus
+calls from the FilterEvent procedure. This moves the implementation back
+towards the Tk 4.2 implementation, but adds embedding support. There is
+still a known bug with twm's NoTitleFocus and embedded windows. However,
+the races in a2 and the funny focus stealing in b1 are gone. (BW)
+
+6/25/97 (bug fix) Error message was not properly reported when using
+button 'toggle'. (DL)
+
+6/25/97 (bug fix) Removed one source of memory corruption in tkGrid.c code
+(fixes what was exercised by "grid col . 0 -w 1; grid col . 0 -w 25") (DL)
+
+----------------- Released 8.0b2, 6/30/97 -----------------------
+
+7/1/97 (bug fix) Menu shortcut and tearoff reported problem fixed. (DL)
+
+7/1/97 (new feature) TK_BUILD_SHARED flag set in tkConfig.sh
+when Tk has been built with --enable-shared. TK_SRC_DIR added.
+A new tkLibObjs make target, echoing the list of the .o's needed
+to build a tk library, is now provided. (DL)
+
+7/9/97 (bug fix) Fixed Tk_CreateFileHandler and Tk_DeleteFileHandler
+macros to directly call the Tcl equivalents. (JL)
+
+7/10/97 (bug fix) On the Mac, if the binding for <<MenuSelect>> was
+drawing, the drawing could bleed over into the menus. This is now
+fixed. (SRP)
+
+7/10/97 (bug fixes) Removed duplicate code related to Tk_SafeInit,
+made a single init script handling both cases. (DL)
+
+7/10/97 (feature change) On Unix, to be able to load Tk into a safe
+interp you need to set the env(DISPLAY) var. Some API should be
+added to allow master crontrol over Tk instantiation. (DL)
+
+7/11/97 (new feature) On the Mac, menus that are too big for the
+screen will now scroll. This is part of the interface on the Mac,
+impossible under Windows, and is not done for Unix. (SRP)
+
+7/21/97 (bug fix) After fixing the bug that in canvas text item the insertion
+cursor wasn't shown if insertion point was at end of text item, introduced a
+different bug in where clicking in entry widget with 0 characters would
+crash or display garbage. (CCS)
+
+7/22/97 (bug fix) If there were a whole bunch of returns or tabs in a row in
+a canvas text item, then the temporary buffer used when outputting
+postscript could overflow and overwrite the stack. (CCS)
+
+7/23/97 (feature change) Reenabled "tkwait" in the Safe Tk base. (JL)
+
+7/24/97 (bug fix) Single init script for both Win and Unix.
+new library/safetk.tcl using features from new tcl safe.tcl (DL)
+
+7/30/97 (feature change) As a result of native menus, you can no
+longer drag through a frame of menubuttons on Macintosh and Windows
+and have the menus pop down. You can still click on individual
+menubuttons and their menus will pop down. Applications needing to
+present a menubar should consider using the new "-menu" configuration
+of the toplevel widget to set up menubar which behaves correctly on
+Macintosh, Windows and X Windows. (SRP)
+
+7/31/97 (bug fix) Tk widget commands can now safely be hidden commands.
+Previously destroying the widget would potentially leave dangling pointers
+and destroy an exposed command instead of a hidden one if an exposed
+command by that name existed. (JL)
+
+7/31/97 (bug fix) On Windows, popup menus were not tracking the right mouse
+button correctly if it was used to invoke the menu. On Unix, tearoff
+menus were stealing focus when the mouse moving over them even when
+focus following was turned off. (SRP)
+
+8/4/97 (bug fix) Fixed problem under USENIX where raising a toplevel
+window could cause an X error if the window had just been withdrawn. (JO)
+
+8/4/97 (feature change) tkerror and bgerror are not anymore hard links
+maintained by the Tcl core. The implementation of bgerror provided by
+Tk tries, for backward compatibility only, to to call "tkerror" and
+if that fails, falls back to the usual dialog and stack trace option
+posting. You can thus still use either "bgerror" or "tkerror" as your
+application error handling proc, but using "bgerror" is strongly
+recommended as support for "tkerror" will eventually vanish in upcoming
+releases. (DL)
+*** POTENTIAL INCOMPATIBILITY with scripts that were using
+ the actual hardlink implementation 'features' and with
+ scripts (if any) that would be calling the default "tkerror" to
+ simulate error messages (use "bgerror" instead) ***
+
+8/7/97 (feature change/addition) Removed the gif files used for the
+Open dialog box on UNIX (they were previously made inline). Added a
+new images directory that includes several images of the Tcl and Tcl
+Powered logos. (RJ)
+
+8/7/97 (bug fix) Fixed focus to deal with embedding when there is
+no window manager. (BW)
+
+8/8/97 (bug fix) Fixed bug in photo image code where photo images from
+different interpreters could get confused if they had the same name. (JO)
+
+8/8/97 (new feature) Added new procedure Tk_GetImageMasterData for
+mapping image names to master data. (JO)
+
+8/8/97 (feature change) Modified Tk_FindPhoto procedure to require
+extra "interp" argument (needed for bug fix above). (JO)
+*** POTENTIAL INCOMPATIBILITY ***
+
+8/8/97 (bug fix) Fixed problems under Windows renaming toplevels with
+menubars. Fixed problems on all platforms renaming menu widgets and
+using new menus of the same name as an old one as cascades. Fixed a
+cosmetic problem with tearoff menus. (SRP)
+
+8/13/97 (bug fixes) Fixed "-from" option for the "image create" and
+"imageName read" commands for GIF images, which didn't used to work
+correctly. Also made transparency work correctly for GIF images
+without the TRANSPARENT_GIF_COLOR hack; TRANSPARENT_GIF_COLOR is
+now ignored. These fixes were provided by Jan Nijtmans. (JO)
+
+8/13/97 (new feature) added safe::loadTk command to load Tk in a
+safe slave interpreter. See the loadTk.n manual page for more
+details. (DL)
+
+----------------- Released 8.0, 8/18/97 -----------------------
+
+8/22/97 - (bug fix) Fixed syntax error in tk_popup; option menus now
+popup over their selected items like they did in tk4.2. Fixed problem
+where cascades sometimes did not work on X. On X, menubars with
+checkbuttons and radiobuttons in them would infinite loop when
+mappped. (SRP)
+
+8/27/97 (new feature) Added support for new X11R6 colors under Windows
+and Mac platforms. (SS)
+
+8/29/97 (bug fix) Wish crashed if stdin was closed. (SS)
+
+9/10/97 (bug fix) "font actual {helvetica 10} -displayof ." wasn't taking
+into account the "-displayof" option. This problem also existed for the
+"font metrics" and "font measure" commands. (CCS)
+
+9/16/97 (new feature) Added "resource delete" and "resource files"
+command to the Mac. Also fixed "resource write" when the resource
+was specified by id and already existed. (JI)
+
+9/16/97 (bug fix) Added null bindings to <Command-KeyPress> for the
+text and entry widget on the Macintosh. This prevents unbound command
+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
+after "selection clear" on Windows. (SS)
+
+10/14/97 (bug fix) If a canvas had contained windows that were off-screen,
+the windows could sometimes reappear (in the wrong place) if the canvas was
+enlarged. (JO)
+
+10/20/97 (bug fix) Omitting the arguments to the text widget "mark
+gravity" option caused a crash. (SS)
+
+10/21/97 (bug fix) Tk did not reset the result after native dialog
+modal loops on Window so background events could perturb the dialog
+result. (SS)
+
+10/23/97 (bug fix) Memory leak in unix's TkpGetFontFamilies. Thanks
+to James Bonfield for the fix. (DL)
+
+10/27/97 (bug fix) Fixed event reporting for the Mac during a grab
+when the pointer was out of the toplevel window. (RJ)
+
+10/28/97 (bug fix) Under Unix, override-redirect was getting set
+incorrectly for menus, so that "wm overrideredirect" returned 0. (JO)
+
+10/28/97 (bug fix) Under Unix, focus code could sometimes cause the
+display to deadlock (it wasn't flushing the output buffer after issuing
+an ungrab command). (JO)
+
+10/28/97 (bug fix) If a PPM image file wasn't complete (e.g. it
+consisted of nothing but space characters) Tk entered an infinite loop
+reading the header. (JO)
+
+10/28/97 (bug fixes) On the Mac, menubars assigned to toplevels would
+disappear after a menu item was invoked from them. On Windows,
+clicking a system menu with added items and then again with a
+different set of added items would crash. On all platforms, a command
+menu entry that caused the entry to be deleted, another one created in
+its place, and the replacement deleted would cause a panic. On Unix,
+<<MenuSelect>> event bindings were firing every time the mouse moved,
+instead of everytime the active menu item changed. (SRP)
+
+10/27/97 (bug fix) If a particular race condition occurred under Windows,
+Tk would crash complaining about trying to free a color that wasn't
+allocated. (SS)
+
+10/28/97 (bug fix) Under Windows, button grabs did not report motion
+events that occurred outside of Tk windows. (SS)
+
+10/28/97 (bug fix) Fixed incorrect display of transparent images on
+the Macintosh. (JI)
+
+10/29/97 (bug fix) Reworked the handling of out-of-range indices in
+the widget command for listboxes: there were all sorts of quirks
+before (e.g., ".l delete -1" actually deleted the first element
+of the listbox). (JO)
+
+10/29/97 (bug fix) Fixed crash on the Macintosh that could occur if a
+window is moved before it is mapped where the X window was created but
+the Macintosh port was not. (RJ)
+
+10/29/97 (bug fix) Fixed several errors in how wm state was maintained
+on the Macintosh. Tk now also will iconify a toplevel window on the
+Mac if the new Appearance Manager is present. (RJ)
+
+10/28/97 (bug fixes) In canvas' postscript command: User name
+information was leaked in safe interpreters on Unix (security fix).
+Errors while reading prolog.ps were not propagated and the error
+message was mixed with partial data. Note: postscript output does
+not work in safe interpreters on unix and windows. (DL)
+
+10/28/97 (bug fix) Safe Tk interps on unix were leaking env(DISPLAY). (DL)
+
+10/31/97 (bug fix) Fixed problems related to the input focus when one
+application had windows open simultaneously on several displays. (JO)
+
+10/31/97 (bug fix) Fixed several problems with traversal of menus via
+the keyboard under Unix. (SRP)
+
+11/4/97 (bug fix) Fixed various word-size related problems for 64-bit
+architectures. (SS)
+
+11/5/97 (bug fix) Embedding on Windows was using freed data (crashing
+in safe.test with TCL_MEM_DEBUG). NB: Embedding is still not fully
+implemented on Windows ! (It works mostly when Tk is embeded into it's
+own Tk frame (safe::loadTk case), but not well with respect to resizing
+with a toplevel container or with an external process). (DL)
+
+----------------- Released 8.0p1, 11/7/97 -----------------------
+
+11/20/97 (bug fix) Fixed bug on the Mac where the "package require"
+command caused menus to stop working. (JI)
+
+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 <weissman@gte.com> and Jan Nijtmans <Jan.Nijtmans@wxs.nl>
+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
+<sebastian.wangnick@eurocontrol.be> 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)
diff --git a/tk/compat/license.terms b/tk/compat/license.terms
new file mode 100644
index 00000000000..03ca6fcb319
--- /dev/null
+++ b/tk/compat/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., and other parties. The following
+terms apply to all files associated with the software unless explicitly
+disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
diff --git a/tk/compat/limits.h b/tk/compat/limits.h
new file mode 100644
index 00000000000..9487dac2200
--- /dev/null
+++ b/tk/compat/limits.h
@@ -0,0 +1,24 @@
+/*
+ * limits.h --
+ *
+ * This is a dummy header file to #include in Tcl when there
+ * is no limits.h in /usr/include. There are only a few
+ * definitions here; also see tclPort.h, which already
+ * #defines some of the things here if they're not arleady
+ * defined.
+ *
+ * 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$
+ */
+
+#define LONG_MIN 0x80000000
+#define LONG_MAX 0x7fffffff
+#define INT_MIN 0x80000000
+#define INT_MAX 0x7fffffff
+#define SHRT_MIN 0x8000
+#define SHRT_MAX 0x7fff
diff --git a/tk/compat/stdlib.h b/tk/compat/stdlib.h
new file mode 100644
index 00000000000..0dabdaf8392
--- /dev/null
+++ b/tk/compat/stdlib.h
@@ -0,0 +1,45 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _STDLIB
+#define _STDLIB
+
+#include <tcl.h>
+
+extern void abort _ANSI_ARGS_((void));
+extern double atof _ANSI_ARGS_((CONST char *string));
+extern int atoi _ANSI_ARGS_((CONST char *string));
+extern long atol _ANSI_ARGS_((CONST char *string));
+extern char * calloc _ANSI_ARGS_((unsigned int numElements,
+ unsigned int size));
+extern void exit _ANSI_ARGS_((int status));
+extern int free _ANSI_ARGS_((char *blockPtr));
+extern char * getenv _ANSI_ARGS_((CONST char *name));
+extern char * malloc _ANSI_ARGS_((unsigned int numBytes));
+extern void qsort _ANSI_ARGS_((VOID *base, int n, int size,
+ int (*compar)(CONST VOID *element1, CONST VOID
+ *element2)));
+extern char * realloc _ANSI_ARGS_((char *ptr, unsigned int numBytes));
+extern double strtod _ANSI_ARGS_((CONST char *string, char **endPtr));
+extern long strtol _ANSI_ARGS_((CONST char *string, char **endPtr,
+ int base));
+extern unsigned long strtoul _ANSI_ARGS_((CONST char *string,
+ char **endPtr, int base));
+
+#endif /* _STDLIB */
diff --git a/tk/compat/unistd.h b/tk/compat/unistd.h
new file mode 100644
index 00000000000..1a13f585e63
--- /dev/null
+++ b/tk/compat/unistd.h
@@ -0,0 +1,84 @@
+/*
+ * unistd.h --
+ *
+ * Macros, CONSTants and prototypes for Posix conformance.
+ *
+ * Copyright 1989 Regents of the University of California
+ * Permission to use, copy, modify, and distribute this
+ * software and its documentation for any purpose and without
+ * fee is hereby granted, provided that the above copyright
+ * notice appear in all copies. 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$
+ */
+
+#ifndef _UNISTD
+#define _UNISTD
+
+#include <sys/types.h>
+#ifndef _TCL
+# include "tcl.h"
+#endif
+
+#ifndef NULL
+#define NULL 0
+#endif
+
+/*
+ * Strict POSIX stuff goes here. Extensions go down below, in the
+ * ifndef _POSIX_SOURCE section.
+ */
+
+extern void _exit _ANSI_ARGS_((int status));
+extern int access _ANSI_ARGS_((CONST char *path, int mode));
+extern int chdir _ANSI_ARGS_((CONST char *path));
+extern int chown _ANSI_ARGS_((CONST char *path, uid_t owner, gid_t group));
+extern int close _ANSI_ARGS_((int fd));
+extern int dup _ANSI_ARGS_((int oldfd));
+extern int dup2 _ANSI_ARGS_((int oldfd, int newfd));
+extern int execl _ANSI_ARGS_((CONST char *path, ...));
+extern int execle _ANSI_ARGS_((CONST char *path, ...));
+extern int execlp _ANSI_ARGS_((CONST char *file, ...));
+extern int execv _ANSI_ARGS_((CONST char *path, char **argv));
+extern int execve _ANSI_ARGS_((CONST char *path, char **argv, char **envp));
+extern int execvp _ANSI_ARGS_((CONST char *file, char **argv));
+extern pid_t fork _ANSI_ARGS_((void));
+extern char *getcwd _ANSI_ARGS_((char *buf, size_t size));
+extern gid_t getegid _ANSI_ARGS_((void));
+extern uid_t geteuid _ANSI_ARGS_((void));
+extern gid_t getgid _ANSI_ARGS_((void));
+extern int getgroups _ANSI_ARGS_((int bufSize, int *buffer));
+extern pid_t getpid _ANSI_ARGS_((void));
+extern uid_t getuid _ANSI_ARGS_((void));
+extern int isatty _ANSI_ARGS_((int fd));
+extern long lseek _ANSI_ARGS_((int fd, long offset, int whence));
+extern int pipe _ANSI_ARGS_((int *fildes));
+extern int read _ANSI_ARGS_((int fd, char *buf, size_t size));
+extern int setgid _ANSI_ARGS_((gid_t group));
+extern int setuid _ANSI_ARGS_((uid_t user));
+extern unsigned sleep _ANSI_ARGS_ ((unsigned seconds));
+extern char *ttyname _ANSI_ARGS_((int fd));
+extern int unlink _ANSI_ARGS_((CONST char *path));
+extern int write _ANSI_ARGS_((int fd, CONST char *buf, size_t size));
+
+#ifndef _POSIX_SOURCE
+extern char *crypt _ANSI_ARGS_((CONST char *, CONST char *));
+extern int fchown _ANSI_ARGS_((int fd, uid_t owner, gid_t group));
+extern int flock _ANSI_ARGS_((int fd, int operation));
+extern int ftruncate _ANSI_ARGS_((int fd, unsigned long length));
+extern int ioctl _ANSI_ARGS_((int fd, int request, ...));
+extern int readlink _ANSI_ARGS_((CONST char *path, char *buf, int bufsize));
+extern int setegid _ANSI_ARGS_((gid_t group));
+extern int seteuid _ANSI_ARGS_((uid_t user));
+extern int setreuid _ANSI_ARGS_((int ruid, int euid));
+extern int symlink _ANSI_ARGS_((CONST char *, CONST char *));
+extern int ttyslot _ANSI_ARGS_((void));
+extern int truncate _ANSI_ARGS_((CONST char *path, unsigned long length));
+extern int vfork _ANSI_ARGS_((void));
+#endif /* _POSIX_SOURCE */
+
+#endif /* _UNISTD */
+
diff --git a/tk/configure b/tk/configure
new file mode 100755
index 00000000000..f60a117eccd
--- /dev/null
+++ b/tk/configure
@@ -0,0 +1,983 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.13"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=generic/tk.h
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+
+# Make sure we can run config.sub.
+if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then :
+else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking host system type""... $ac_c" 1>&6
+echo "configure:552: checking host system type" >&5
+
+host_alias=$host
+case "$host_alias" in
+NONE)
+ case $nonopt in
+ NONE)
+ if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then :
+ else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; }
+ fi ;;
+ *) host_alias=$nonopt ;;
+ esac ;;
+esac
+
+host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias`
+host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+echo "$ac_t""$host" 1>&6
+
+
+case "${host}" in
+*-*-cygwin* | *-*-mingw32*)
+ CONFIGDIR="win"
+
+ ;;
+*)
+ CONFIGDIR="unix"
+
+ ac_aux_dir=
+for ac_dir in $CONFIGDIR $srcdir/$CONFIGDIR; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in $CONFIGDIR $srcdir/$CONFIGDIR" 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+ ;;
+esac
+
+echo $ac_n "checking whether ${MAKE-make} sets \${MAKE}""... $ac_c" 1>&6
+echo "configure:604: checking whether ${MAKE-make} sets \${MAKE}" >&5
+set dummy ${MAKE-make}; ac_make=`echo "$2" | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_prog_make_${ac_make}_set'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftestmake <<\EOF
+all:
+ @echo 'ac_maketemp="${MAKE}"'
+EOF
+# GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+eval `${MAKE-make} -f conftestmake 2>/dev/null | grep temp=`
+if test -n "$ac_maketemp"; then
+ eval ac_cv_prog_make_${ac_make}_set=yes
+else
+ eval ac_cv_prog_make_${ac_make}_set=no
+fi
+rm -f conftestmake
+fi
+if eval "test \"`echo '$ac_cv_prog_make_'${ac_make}_set`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ SET_MAKE=
+else
+ echo "$ac_t""no" 1>&6
+ SET_MAKE="MAKE=${MAKE-make}"
+fi
+
+subdirs="$CONFIGDIR"
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.13"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+
+trap 'rm -fr `echo "Makefile" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@host@%$host%g
+s%@host_alias@%$host_alias%g
+s%@host_cpu@%$host_cpu%g
+s%@host_vendor@%$host_vendor%g
+s%@host_os@%$host_os%g
+s%@CONFIGDIR@%$CONFIGDIR%g
+s%@SET_MAKE@%$SET_MAKE%g
+s%@subdirs@%$subdirs%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
+if test "$no_recursion" != yes; then
+
+ # Remove --cache-file and --srcdir arguments so they do not pile up.
+ ac_sub_configure_args=
+ ac_prev=
+ for ac_arg in $ac_configure_args; do
+ if test -n "$ac_prev"; then
+ ac_prev=
+ continue
+ fi
+ case "$ac_arg" in
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ ;;
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ ;;
+ *) ac_sub_configure_args="$ac_sub_configure_args $ac_arg" ;;
+ esac
+ done
+
+ for ac_config_dir in $CONFIGDIR; do
+
+ # Do not complain, so a configure script can configure whichever
+ # parts of a large source tree are present.
+ if test ! -d $srcdir/$ac_config_dir; then
+ continue
+ fi
+
+ echo configuring in $ac_config_dir
+
+ case "$srcdir" in
+ .) ;;
+ *)
+ if test -d ./$ac_config_dir || mkdir ./$ac_config_dir; then :;
+ else
+ { echo "configure: error: can not create `pwd`/$ac_config_dir" 1>&2; exit 1; }
+ fi
+ ;;
+ esac
+
+ ac_popdir=`pwd`
+ cd $ac_config_dir
+
+ # A "../" for each directory in /$ac_config_dir.
+ ac_dots=`echo $ac_config_dir|sed -e 's%^\./%%' -e 's%[^/]$%&/%' -e 's%[^/]*/%../%g'`
+
+ case "$srcdir" in
+ .) # No --srcdir option. We are building in place.
+ ac_sub_srcdir=$srcdir ;;
+ /*) # Absolute path.
+ ac_sub_srcdir=$srcdir/$ac_config_dir ;;
+ *) # Relative path.
+ ac_sub_srcdir=$ac_dots$srcdir/$ac_config_dir ;;
+ esac
+
+ # Check for guested configure; otherwise get Cygnus style configure.
+ if test -f $ac_sub_srcdir/configure; then
+ ac_sub_configure=$ac_sub_srcdir/configure
+ elif test -f $ac_sub_srcdir/configure.in; then
+ ac_sub_configure=$ac_configure
+ else
+ echo "configure: warning: no configuration information is in $ac_config_dir" 1>&2
+ ac_sub_configure=
+ fi
+
+ # The recursion is here.
+ if test -n "$ac_sub_configure"; then
+
+ # Make the cache file name correct relative to the subdirectory.
+ case "$cache_file" in
+ /*) ac_sub_cache_file=$cache_file ;;
+ *) # Relative path.
+ ac_sub_cache_file="$ac_dots$cache_file" ;;
+ esac
+
+ echo "running ${CONFIG_SHELL-/bin/sh} $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_sub_srcdir"
+ # The eval makes quoting arguments work.
+ if eval ${CONFIG_SHELL-/bin/sh} $ac_sub_configure $ac_sub_configure_args --cache-file=$ac_sub_cache_file --srcdir=$ac_sub_srcdir
+ then :
+ else
+ { echo "configure: error: $ac_sub_configure failed for $ac_config_dir" 1>&2; exit 1; }
+ fi
+ fi
+
+ cd $ac_popdir
+ done
+fi
+
+
diff --git a/tk/configure.in b/tk/configure.in
new file mode 100644
index 00000000000..f66718873c0
--- /dev/null
+++ b/tk/configure.in
@@ -0,0 +1,28 @@
+dnl This file is used as input to autoconf to generate configure.
+dnl The only reason we need this is that the Tk directory structure
+dnl changed in 7.5, and this change lets us avoid changing the
+dnl configuration superstructure.
+dnl Tom Tromey <tromey@cygnus.com>
+
+AC_PREREQ(2.5)
+
+AC_INIT(generic/tk.h)
+
+AC_CANONICAL_HOST
+
+case "${host}" in
+*-*-cygwin* | *-*-mingw32*)
+ CONFIGDIR="win"
+ AC_SUBST(CONFIGDIR)
+ ;;
+*)
+ CONFIGDIR="unix"
+ AC_SUBST(CONFIGDIR)
+ AC_CONFIG_AUX_DIR($CONFIGDIR)
+ ;;
+esac
+
+AC_PROG_MAKE_SET
+AC_CONFIG_SUBDIRS($CONFIGDIR)
+AC_OUTPUT(Makefile)
+
diff --git a/tk/doc/3DBorder.3 b/tk/doc/3DBorder.3
new file mode 100644
index 00000000000..2916e8e1d2c
--- /dev/null
+++ b/tk/doc/3DBorder.3
@@ -0,0 +1,262 @@
+'\"
+'\" 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$
+'\"
+.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
+void
+\fBTk_Draw3DPolygon(\fItkwin, drawable, border, pointPtr, numPoints, polyBorderWidth, leftRelief\fB)\fR
+.sp
+void
+\fBTk_Fill3DPolygon(\fItkwin, drawable, border, pointPtr, numPoints, polyBorderWidth, leftRelief\fB)\fR
+.sp
+void
+\fBTk_3DVerticalBevel\fR(\fItkwin, drawable, border, x, y, width, height, leftBevel, relief\fB)\fR
+.sp
+void
+\fBTk_3DHorizontalBevel\fR(\fItkwin, drawable, border, x, y, width, height, leftIn, rightIn, topBevel, relief\fB)\fR
+.sp
+void
+\fBTk_SetBackgroundFromBorder(\fItkwin, border\fB)\fR
+.sp
+char *
+\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
+X-coordinate of upper-left corner of rectangle describing border
+or bevel, in pixels.
+.AP int y in
+Y-coordinate of upper-left corner of rectangle describing border or
+bevel, in pixels.
+.AP int width in
+Width of rectangle describing border or bevel, in pixels.
+.AP int height in
+Height of rectangle describing border or bevel, in pixels.
+.AP int borderWidth in
+Width of border in pixels. Positive means border is inside rectangle
+given by \fIx\fR, \fIy\fR, \fIwidth\fR, \fIheight\fR, negative means
+border is outside rectangle.
+.AP int relief in
+Indicates 3-D position of interior of object relative to exterior;
+should be TK_RELIEF_RAISED, TK_RELIEF_SUNKEN, TK_RELIEF_GROOVE,
+TK_RELIEF_SOLID, or TK_RELIEF_RIDGE (may also be TK_RELIEF_FLAT
+for \fBTk_Fill3DRectangle\fR).
+.AP XPoint *pointPtr in
+Pointer to array of points describing the set of vertices in a polygon.
+The polygon need not be closed (it will be closed automatically if it
+isn't).
+.AP int numPoints in
+Number of points at \fI*pointPtr\fR.
+.AP int polyBorderWidth in
+Width of border in pixels. If positive, border is drawn to left of
+trajectory given by \fIpointPtr\fR; if negative, border is drawn to
+right of trajectory. If \fIleftRelief\fR is TK_RELIEF_GROOVE or
+TK_RELIEF_RIDGE then the border is centered on the trajectory.
+.AP int leftRelief in
+Height of left side of polygon's path relative to right. TK_RELIEF_RAISED
+means left side should appear higher and TK_RELIEF_SUNKEN means right side
+should appear higher;
+TK_RELIEF_GROOVE and TK_RELIEF_RIDGE mean the obvious things.
+For \fBTk_Fill3DPolygon\fR, TK_RELIEF_FLAT may also be specified to
+indicate no difference in height.
+.AP int leftBevel in
+Non-zero means this bevel forms the left side of the object; zero means
+it forms the right side.
+.AP int leftIn in
+Non-zero means that the left edge of the horizontal bevel angles in,
+so that the bottom of the edge is farther to the right than
+the top.
+Zero means the edge angles out, so that the bottom is farther to the
+left than the top.
+.AP int rightIn in
+Non-zero means that the right edge of the horizontal bevel angles in,
+so that the bottom of the edge is farther to the left than the top.
+Zero means the edge angles out, so that the bottom is farther to the
+right than the top.
+.AP int topBevel in
+Non-zero means this bevel forms the top side of the object; zero means
+it forms the bottom side.
+.AP int which in
+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
+must refer to a compatible
+pixmap or window: one associated with the same screen and with the
+same depth as \fItkwin\fR.
+The \fIx\fR, \fIy\fR, \fIwidth\fR, and
+\fIheight\fR arguments define the bounding box of the border region
+within \fIdrawable\fR (usually \fIx\fR and \fIy\fR are zero and
+\fIwidth\fR and \fIheight\fR are the dimensions of the window), and
+\fIborderWidth\fR specifies the number of pixels actually
+occupied by the border. The \fIrelief\fR argument indicates
+which of several three-dimensional effects is desired:
+TK_RELIEF_RAISED means that the interior of the rectangle should appear raised
+relative to the exterior of the rectangle, and
+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
+\fInumPoints\fR arguments define a trajectory, \fIpolyBorderWidth\fR
+indicates how wide the border should be (and on which side of the
+trajectory to draw it), and \fIleftRelief\fR indicates which side
+of the trajectory should appear raised. \fBTk_Draw3DPolygon\fR
+draws a border around the given trajectory using the colors from
+\fIborder\fR to produce a three-dimensional appearance. If the trajectory is
+non-self-intersecting, the appearance will be a raised or sunken
+polygon shape. The trajectory may be self-intersecting, although
+it's not clear how useful this is.
+.PP
+\fBTk_Fill3DPolygon\fR is to \fBTk_Draw3DPolygon\fR what
+\fBTk_Fill3DRectangle\fR is to \fBTk_Draw3DRectangle\fR: it fills
+the polygonal area with the background color from \fIborder\fR,
+then calls \fBTk_Draw3DPolygon\fR to draw a border around the
+area (unless \fIleftRelief\fR is TK_RELIEF_FLAT; in this case no
+border is drawn).
+.PP
+The procedures \fBTk_3DVerticalBevel\fR and \fBTk_3DHorizontalBevel\fR
+provide lower-level drawing primitives that are used by
+procedures such as \fBTk_Draw3DRectangle\fR.
+These procedures are also useful in their own right for drawing
+rectilinear border shapes.
+\fBTk_3DVerticalBevel\fR draws a vertical beveled edge, such as the
+left or right side of a rectangle, and \fBTk_3DHorizontalBevel\fR
+draws a horizontal beveled edge, such as the top or bottom of a
+rectangle.
+Each procedure takes \fIx\fR, \fIy\fR, \fIwidth\fR, and \fIheight\fR
+arguments that describe the rectangular area of the beveled edge
+(e.g., \fIwidth\fR is the border width for \fBTk_3DVerticalBevel\fR).
+The \fIleftBorder\fR and \fItopBorder\fR arguments indicate the
+position of the border relative to the ``inside'' of the object, and
+\fIrelief\fR indicates the relief of the inside of the object relative
+to the outside.
+\fBTk_3DVerticalBevel\fR just draws a rectangular region.
+\fBTk_3DHorizontalBevel\fR draws a trapezoidal region to generate
+mitered corners; it should be called after \fBTk_3DVerticalBevel\fR
+(otherwise \fBTk_3DVerticalBevel\fR will overwrite the mitering in
+the corner).
+The \fIleftIn\fR and \fIrightIn\fR arguments to \fBTk_3DHorizontalBevel\fR
+describe the mitering at the corners; a value of 1 means that the bottom
+edge of the trapezoid will be shorter than the top, 0 means it will
+be longer.
+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
diff --git a/tk/doc/BindTable.3 b/tk/doc/BindTable.3
new file mode 100644
index 00000000000..5c0929893aa
--- /dev/null
+++ b/tk/doc/BindTable.3
@@ -0,0 +1,157 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+Tk_BindingTable
+\fBTk_CreateBindingTable(\fIinterp\fB)\fR
+.sp
+\fBTk_DeleteBindingTable(\fIbindingTable\fB)\fR
+.sp
+unsigned long
+\fBTk_CreateBinding(\fIinterp, bindingTable, object, eventString, script, append\fB)\fR
+.sp
+int
+\fBTk_DeleteBinding(\fIinterp, bindingTable, object, eventString\fB)\fR
+.sp
+char *
+\fBTk_GetBinding(\fIinterp, bindingTable, object, eventString\fB)\fR
+.sp
+\fBTk_GetAllBindings(\fIinterp, bindingTable, object\fB)\fR
+.sp
+\fBTk_DeleteAllBindings(\fIbindingTable, object\fB)\fR
+.sp
+\fBTk_BindEvent(\fIbindingTable, eventPtr, tkwin, numObjects, objectPtr\fB)\fR
+.SH ARGUMENTS
+.AS Tk_BindingTable bindingTable
+.AP Tcl_Interp *interp in
+Interpreter to use when invoking bindings in binding table. Also
+used for returning results and errors from binding procedures.
+.AP Tk_BindingTable bindingTable in
+Token for binding table; must have been returned by some previous
+call to \fBTk_CreateBindingTable\fR.
+.AP ClientData object in
+Identifies object with which binding is associated.
+.AP char *eventString in
+String describing event sequence.
+.AP char *script in
+Tcl script to invoke when binding triggers.
+.AP int append in
+Non-zero means append \fIscript\fR to existing script for binding,
+if any; zero means replace existing script with new one.
+.AP XEvent *eventPtr in
+X event to match against bindings in \fIbindingTable\fR.
+.AP Tk_Window tkwin in
+Identifier for any window on the display where the event occurred.
+Used to find display-related information such as key maps.
+.AP int numObjects in
+Number of object identifiers pointed to by \fIobjectPtr\fR.
+.AP ClientData *objectPtr in
+Points to an array of object identifiers: bindings will be considered
+for each of these objects in order from first to last.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures provide a general-purpose mechanism for creating
+and invoking bindings.
+Bindings are organized in terms of \fIbinding tables\fR.
+A binding table consists of a collection of bindings plus a history
+of recent events.
+Within a binding table, bindings are associated with \fIobjects\fR.
+The meaning of an object is defined by clients of the binding package.
+For example, Tk keeps uses one binding table to hold all of the bindings
+created by the \fBbind\fR command.
+For this table, objects are pointers to strings such as window names, class
+names, or other binding tags such as \fBall\fR.
+Tk also keeps a separate binding table for each canvas widget, which manages
+bindings created by the canvas's \fBbind\fR widget command; within
+this table, an object is either a pointer to the internal structure for a
+canvas item or a Tk_Uid identifying a tag.
+.PP
+The procedure \fBTk_CreateBindingTable\fR creates a new binding
+table and associates \fIinterp\fR with it (when bindings in the
+table are invoked, the scripts will be evaluated in \fIinterp\fR).
+\fBTk_CreateBindingTable\fR returns a token for the table, which
+must be used in calls to other procedures such as \fBTk_CreateBinding\fR
+or \fBTk_BindEvent\fR.
+.PP
+\fBTk_DeleteBindingTable\fR frees all of the state associated
+with a binding table.
+Once it returns the caller should not use the \fIbindingTable\fR
+token again.
+.PP
+\fBTk_CreateBinding\fR adds a new binding to an existing table.
+The \fIobject\fR argument identifies the object with which the
+binding is to be associated, and it may be any one-word value.
+Typically it is a pointer to a string or data structure.
+The \fIeventString\fR argument identifies the event or sequence
+of events for the binding; see the documentation for the
+\fBbind\fR command for a description of its format.
+\fIscript\fR is the Tcl script to be evaluated when the binding
+triggers.
+\fIappend\fR indicates what to do if there already
+exists a binding for \fIobject\fR and \fIeventString\fR: if \fIappend\fR
+is zero then \fIscript\fR replaces the old script; if \fIappend\fR
+is non-zero then the new script is appended to the old one.
+\fBTk_CreateBinding\fR returns an X event mask for all the events
+associated with the bindings.
+This information may be useful to invoke \fBXSelectInput\fR to
+select relevant events, or to disallow the use of certain events
+in bindings.
+If an error occurred while creating the binding (e.g., \fIeventString\fR
+refers to a non-existent event), then 0 is returned and an error
+message is left in \fIinterp->result\fR.
+.PP
+\fBTk_DeleteBinding\fR removes from \fIbindingTable\fR the
+binding given by \fIobject\fR and \fIeventString\fR, if
+such a binding exists.
+\fBTk_DeleteBinding\fR always returns TCL_OK.
+In some cases it may reset \fIinterp->result\fR to the default
+empty value.
+.PP
+\fBTk_GetBinding\fR returns a pointer to the script associated
+with \fIeventString\fR and \fIobject\fR in \fIbindingTable\fR.
+If no such binding exists then NULL is returned and an error
+message is left in \fIinterp->result\fR.
+.PP
+\fBTk_GetAllBindings\fR returns in \fIinterp->result\fR a list
+of all the event strings for which there are bindings in
+\fIbindingTable\fR associated with \fIobject\fR.
+If there are no bindings for \fIobject\fR then an empty
+string is returned in \fIinterp->result\fR.
+.PP
+\fBTk_DeleteAllBindings\fR deletes all of the bindings in
+\fIbindingTable\fR that are associated with \fIobject\fR.
+.PP
+\fBTk_BindEvent\fR is called to process an event.
+It makes a copy of the event in an internal history list associated
+with the binding table, then it checks for bindings that match
+the event.
+\fBTk_BindEvent\fR processes each of the objects pointed to
+by \fIobjectPtr\fR in turn.
+For each object, it finds all the bindings that match the current
+event history, selects the most specific binding using the priority
+mechanism described in the documentation for \fBbind\fR,
+and invokes the script for that binding.
+If there are no matching bindings for a particular object, then
+the object is skipped.
+\fBTk_BindEvent\fR continues through all of the objects, handling
+exceptions such as errors, \fBbreak\fR, and \fBcontinue\fR as
+described in the documentation for \fBbind\fR.
+
+.SH KEYWORDS
+binding, event, object, script
diff --git a/tk/doc/CanvPsY.3 b/tk/doc/CanvPsY.3
new file mode 100644
index 00000000000..9043a083212
--- /dev/null
+++ b/tk/doc/CanvPsY.3
@@ -0,0 +1,122 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+double
+\fBTk_CanvasPsY\fR(\fIcanvas, canvasY\fR)
+.sp
+int
+\fBTk_CanvasPsBitmap\fR(\fIinterp, canvas, bitmap, x, y, width, height\fR)
+.sp
+int
+\fBTk_CanvasPsColor\fR(\fIinterp, canvas, colorPtr\fR)
+.sp
+int
+\fBTk_CanvasPsFont\fR(\fIinterp, canvas, fontStructPtr\fR)
+.sp
+\fBTk_CanvasPsPath\fR(\fIinterp, canvas, coordPtr, numPoints\fR)
+.sp
+int
+\fBTk_CanvasPsStipple\fR(\fIinterp, canvas, bitmap\fR)
+.SH ARGUMENTS
+.AS "unsigned int" *fontStructPtr
+.AP Tk_Canvas canvas in
+A token that identifies a canvas widget for which Postscript is
+being generated.
+.AP double canvasY in
+Y-coordinate in the space of the canvas.
+.AP Tcl_Interp *interp in/out
+A Tcl interpreter; Postscript is appended to its result, or the
+result may be replaced with an error message.
+.AP Pixmap bitmap in
+Bitmap to use for generating Postscript.
+.AP int x in
+X-coordinate within \fIbitmap\fR of left edge of region to output.
+.AP int y in
+Y-coordinate within \fIbitmap\fR of top edge of region to output.
+.AP "int" width in
+Width of region of bitmap to output, in pixels.
+.AP "int" height in
+Height of region of bitmap to output, in pixels.
+.AP XColor *colorPtr in
+Information about color value to set in Postscript.
+.AP XFontStruct *fontStructPtr in
+Font for which Postscript is to be generated.
+.AP double *coordPtr in
+Pointer to an array of coordinates for one or more
+points specified in canvas coordinates.
+The order of values in \fIcoordPtr\fR is x1, y1, x2, y2, x3, y3,
+and so on.
+.AP int numPoints in
+Number of points at \fIcoordPtr\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures are called by canvas type managers to carry out
+common functions related to generating Postscript.
+Most of the procedures take a \fIcanvas\fR argument, which
+refers to a canvas widget for which Postscript is being
+generated.
+.PP
+\fBTk_CanvasY\fR takes as argument a y-coordinate in the space of
+a canvas and returns the value that should be used for that point
+in the Postscript currently being generated for \fIcanvas\fR.
+Y coordinates require transformation because Postscript uses an
+origin at the lower-left corner whereas X uses an origin at the
+upper-left corner.
+Canvas x coordinates can be used directly in Postscript without
+transformation.
+.PP
+\fBTk_CanvasPsBitmap\fR generates Postscript to describe a region
+of a bitmap.
+The Postscript is generated in proper image data format for Postscript,
+i.e., as data between angle brackets, one bit per pixel.
+The Postscript is appended to \fIinterp->result\fR and TCL_OK is returned
+unless an error occurs, in which case TCL_ERROR is returned and
+\fIinterp->result\fR is overwritten with an error message.
+.PP
+\fBTk_CanvasPsColor\fR generates Postscript to set the current color
+to correspond to its \fIcolorPtr\fR argument, taking into account any
+color map specified in the \fBpostscript\fR command.
+It appends the Postscript to \fIinterp->result\fR and returns
+TCL_OK unless an error occurs, in which case TCL_ERROR is returned and
+\fIinterp->result\fR is overwritten with an error message.
+.PP
+\fBTk_CanvasPsFont\fR generates Postscript that sets the current font
+to match \fIfontStructPtr\fR as closely as possible.
+\fBTk_CanvasPsFont\fR takes into account any font map specified
+in the \fBpostscript\fR command, and it does
+the best it can at mapping X fonts to Postscript fonts.
+It appends the Postscript to \fIinterp->result\fR and returns TCL_OK
+unless an error occurs, in which case TCL_ERROR is returned and
+\fIinterp->result\fR is overwritten with an error message.
+.PP
+\fBTk_CanvasPsPath\fR generates Postscript to set the current path
+to the set of points given by \fIcoordPtr\fR and \fInumPoints\fR.
+It appends the resulting Postscript to \fIinterp->result\fR.
+.PP
+\fBTk_CanvasPsStipple\fR generates Postscript that will fill the
+current path in stippled fashion.
+It uses \fIbitmap\fR as the stipple pattern and the current Postscript
+color; ones in the stipple bitmap are drawn in the current color, and
+zeroes are not drawn at all.
+The Postscript is appended to \fIinterp->result\fR and TCL_OK is
+returned, unless an error occurs, in which case TCL_ERROR is returned and
+\fIinterp->result\fR is overwritten with an error message.
+
+.SH KEYWORDS
+bitmap, canvas, color, font, path, Postscript, stipple
diff --git a/tk/doc/CanvTkwin.3 b/tk/doc/CanvTkwin.3
new file mode 100644
index 00000000000..03315faa4ec
--- /dev/null
+++ b/tk/doc/CanvTkwin.3
@@ -0,0 +1,161 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+Tk_Window
+\fBTk_CanvasTkwin\fR(\fIcanvas\fR)
+.sp
+int
+\fBTk_CanvasGetCoord\fR(\fIinterp, canvas, string, doublePtr\fR)
+.sp
+\fBTk_CanvasDrawableCoords\fR(\fIcanvas, x, y, drawableXPtr, drawableYPtr\fR)
+.sp
+\fBTk_CanvasSetStippleOrigin\fR(\fIcanvas, gc\fR)
+.sp
+\fBTk_CanvasWindowCoords\fR(\fIcanvas, x, y, screenXPtr, screenYPtr\fR)
+.sp
+\fBTk_CanvasEventuallyRedraw\fR(\fIcanvas, x1, y1, x2, y2\fR)
+.sp
+Tk_OptionParseProc *\fBTk_CanvasTagsParseProc\fR;
+.sp
+Tk_OptionPrintProc *\fBTk_CanvasTagsPrintProc\fR;
+.SH ARGUMENTS
+.AS Tk_ItemType *drawableXPtr
+.AP Tk_Canvas canvas in
+A token that identifies a canvas widget.
+.AP Tcl_Interp *interp in/out
+Interpreter to use for error reporting.
+.AP char *string in
+Textual description of a canvas coordinate.
+.AP double *doublePtr out
+Points to place to store a converted coordinate.
+.AP double x in
+An x coordinate in the space of the canvas.
+.AP double y in
+A y coordinate in the space of the canvas.
+.AP short *drawableXPtr out
+Pointer to a location in which to store an x coordinate in the space
+of the drawable currently being used to redisplay the canvas.
+.AP short *drawableYPtr out
+Pointer to a location in which to store a y coordinate in the space
+of the drawable currently being used to redisplay the canvas.
+.AP GC gc out
+Graphics context to modify.
+.AP short *screenXPtr out
+Points to a location in which to store the screen coordinate in the
+canvas window that corresponds to \fIx\fR.
+.AP short *screenYPtr out
+Points to a location in which to store the screen coordinate in the
+canvas window that corresponds to \fIy\fR.
+.AP int x1 in
+Left edge of the region that needs redisplay. Only pixels at or to
+the right of this coordinate need to be redisplayed.
+.AP int y1 in
+Top edge of the region that needs redisplay. Only pixels at or below
+this coordinate need to be redisplayed.
+.AP int x2 in
+Right edge of the region that needs redisplay. Only pixels to
+the left of this coordinate need to be redisplayed.
+.AP int y2 in
+Bottom edge of the region that needs redisplay. Only pixels above
+this coordinate need to be redisplayed.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures are called by canvas type managers to perform various
+utility functions.
+.PP
+\fBTk_CanvasTkwin\fR returns the Tk_Window associated with a particular
+canvas.
+.PP
+\fBTk_CanvasGetCoord\fR translates a string specification of a
+coordinate (such as \fB2p\fR or \fB1.6c\fR) into a double-precision
+canvas coordinate.
+If \fIstring\fR is a valid coordinate description then \fBTk_CanvasGetCoord\fR
+stores the corresponding canvas coordinate at *\fIdoublePtr\fR
+and returns TCL_OK.
+Otherwise it stores an error message in \fIinterp->result\fR and
+returns TCL_ERROR.
+.PP
+\fBTk_CanvasDrawableCoords\fR is called by type managers during
+redisplay to compute where to draw things.
+Given \fIx\fR and \fIy\fR coordinates in the space of the
+canvas, \fBTk_CanvasDrawableCoords\fR computes the corresponding
+pixel in the drawable that is currently being used for redisplay;
+it returns those coordinates in *\fIdrawableXPtr\fR and *\fIdrawableYPtr\fR.
+This procedure should not be invoked except during redisplay.
+.PP
+\fBTk_CanvasSetStippleOrigin\fR is also used during redisplay.
+It sets the stipple origin in \fIgc\fR so that stipples drawn
+with \fIgc\fR in the current offscreen pixmap will line up
+with stipples drawn with origin (0,0) in the canvas's actual
+window.
+\fBTk_CanvasSetStippleOrigin\fR is needed in order to guarantee
+that stipple patterns line up properly when the canvas is
+redisplayed in small pieces.
+Redisplays are carried out in double-buffered fashion where a
+piece of the canvas is redrawn in an offscreen pixmap and then
+copied back onto the screen.
+In this approach the stipple origins in graphics contexts need to
+be adjusted during each redisplay to compensate for the position
+of the off-screen pixmap relative to the window.
+If an item is being drawn with stipples, its type manager typically
+calls \fBTk_CanvasSetStippleOrigin\fR just before using \fIgc\fR
+to draw something; after it is finished drawing, the type manager
+calls \fBXSetTSOrigin\fR to restore the origin in \fIgc\fR back to (0,0)
+(the restore is needed because graphics contexts are shared, so
+they cannot be modified permanently).
+.PP
+\fBTk_CanvasWindowCoords\fR is similar to \fBTk_CanvasDrawableCoords\fR
+except that it returns coordinates in the canvas's window on the
+screen, instead of coordinates in an off-screen pixmap.
+.PP
+\fBTk_CanvasEventuallyRedraw\fR may be invoked by a type manager
+to inform Tk that a portion of a canvas needs to be redrawn.
+The \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR arguments
+specify the region that needs to be redrawn, in canvas coordinates.
+Type managers rarely need to invoke \fBTk_CanvasEventuallyRedraw\fR,
+since Tk can normally figure out when an item has changed and make
+the redisplay request on its behalf (this happens, for example
+whenever Tk calls a \fIconfigureProc\fR or \fIscaleProc\fR).
+The only time that a type manager needs to call
+\fBTk_CanvasEventuallyRedraw\fR is if an item has changed on its own
+without being invoked through one of the procedures in its Tk_ItemType;
+this could happen, for example, in an image item if the image is
+modified using image commands.
+.PP
+\fBTk_CanvasTagsParseProc\fR and \fBTk_CanvasTagsPrintProc\fR are
+procedures that handle the \fB\-tags\fR option for canvas items.
+The code of a canvas type manager won't call these procedures
+directly, but will use their addresses to create a \fBTk_CustomOption\fR
+structure for the \fB\-tags\fR option. The code typically looks
+like this:
+.CS
+static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ ...
+ {TK_CONFIG_CUSTOM, "\-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ ...
+};
+.CE
+
+.SH KEYWORDS
+canvas, focus, item type, redisplay, selection, type manager
diff --git a/tk/doc/CanvTxtInfo.3 b/tk/doc/CanvTxtInfo.3
new file mode 100644
index 00000000000..81d069a52dc
--- /dev/null
+++ b/tk/doc/CanvTxtInfo.3
@@ -0,0 +1,104 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+Tk_CanvasTextInfo *
+\fBTk_CanvasGetTextInfo\fR(\fIcanvas\fR)
+.SH ARGUMENTS
+.AS Tk_Canvas canvas
+.AP Tk_Canvas canvas in
+A token that identifies a particular canvas widget.
+.BE
+
+.SH DESCRIPTION
+.PP
+Textual canvas items are somewhat more complicated to manage than
+other items, due to things like the selection and the input focus.
+\fBTk_CanvasGetTextInfo\fR may be invoked by a type manager
+to obtain additional information needed for items that display text.
+The return value from \fBTk_CanvasGetTextInfo\fR is a pointer to
+a structure that is shared between Tk and all the items that display
+text.
+The structure has the following form:
+.CS
+typedef struct Tk_CanvasTextInfo {
+ Tk_3DBorder \fIselBorder\fR;
+ int \fIselBorderWidth\fR;
+ XColor *\fIselFgColorPtr\fR;
+ Tk_Item *\fIselItemPtr\fR;
+ int \fIselectFirst\fR;
+ int \fIselectLast\fR;
+ Tk_Item *\fIanchorItemPtr\fR;
+ int \fIselectAnchor\fR;
+ Tk_3DBorder \fIinsertBorder\fR;
+ int \fIinsertWidth\fR;
+ int \fIinsertBorderWidth\fR;
+ Tk_Item *\fIfocusItemPtr\fR;
+ int \fIgotFocus\fR;
+ int \fIcursorOn\fR;
+} Tk_CanvasTextInfo;
+.CE
+The \fBselBorder\fR field identifies a Tk_3DBorder that should be
+used for drawing the background under selected text.
+\fIselBorderWidth\fR gives the width of the raised border around
+selected text, in pixels.
+\fIselFgColorPtr\fR points to an XColor that describes the foreground
+color to be used when drawing selected text.
+\fIselItemPtr\fR points to the item that is currently selected, or
+NULL if there is no item selected or if the canvas doesn't have the
+selection.
+\fIselectFirst\fR and \fIselectLast\fR give the indices of the first
+and last selected characters in \fIselItemPtr\fR, as returned by the
+\fIindexProc\fR for that item.
+\fIanchorItemPtr\fR points to the item that currently has the selection
+anchor; this is not necessarily the same as \fIselItemPtr\fR.
+\fIselectAnchor\fR is an index that identifies the anchor position
+within \fIanchorItemPtr\fR.
+\fIinsertBorder\fR contains a Tk_3DBorder to use when drawing the
+insertion cursor; \fIinsertWidth\fR gives the total width of the
+insertion cursor in pixels, and \fIinsertBorderWidth\fR gives the
+width of the raised border around the insertion cursor.
+\fIfocusItemPtr\fR identifies the item that currently has the input
+focus, or NULL if there is no such item.
+\fIgotFocus\fR is 1 if the canvas widget has the input focus and
+0 otherwise.
+\fIcursorOn\fR is 1 if the insertion cursor should be drawn in
+\fIfocusItemPtr\fR and 0 if it should not be drawn; this field
+is toggled on and off by Tk to make the cursor blink.
+.PP
+The structure returned by \fBTk_CanvasGetTextInfo\fR
+is shared between Tk and the type managers; typically the type manager
+calls \fBTk_CanvasGetTextInfo\fR once when an item is created and
+then saves the pointer in the item's record.
+Tk will update information in the Tk_CanvasTextInfo; for example,
+a \fBconfigure\fR widget command might change the \fIselBorder\fR
+field, or a \fBselect\fR widget command might change the \fIselectFirst\fR
+field, or Tk might change \fIcursorOn\fR in order to make the insertion
+cursor flash on and off during successive redisplays.
+.PP
+Type managers should treat all of the fields of the Tk_CanvasTextInfo
+structure as read-only, except for \fIselItemPtr\fR, \fIselectFirst\fR,
+\fIselectLast\fR, and \fIselectAnchor\fR.
+Type managers may change \fIselectFirst\fR, \fIselectLast\fR, and
+\fIselectAnchor\fR to adjust for insertions and deletions in the
+item (but only if the item is the current owner of the selection or
+anchor, as determined by \fIselItemPtr\fR or \fIanchorItemPtr\fR).
+If all of the selected text in the item is deleted, the item should
+set \fIselItemPtr\fR to NULL to indicate that there is no longer a
+selection.
+
+.SH KEYWORDS
+canvas, focus, insertion cursor, selection, selection anchor, text
diff --git a/tk/doc/Clipboard.3 b/tk/doc/Clipboard.3
new file mode 100644
index 00000000000..612c17ae0dc
--- /dev/null
+++ b/tk/doc/Clipboard.3
@@ -0,0 +1,80 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+int
+\fBTk_ClipboardClear\fR(\fIinterp, tkwin\fR)
+.sp
+int
+\fBTk_ClipboardAppend\fR(\fIinterp, tkwin, target, format, buffer\fR)
+.SH ARGUMENTS
+.AS Tk_ClipboardClear tkwin
+.AP Tcl_Interp *interp in
+Interpreter to use for reporting errors.
+.AP Tk_Window tkwin in
+Window that determines which display's clipboard to manipulate.
+.AP Atom target in
+Conversion type for this clipboard item; has same meaning as
+\fItarget\fR argument to \fBTk_CreateSelHandler\fR.
+.AP Atom format in
+Representation to use when data is retrieved; has same meaning as
+\fIformat\fR argument to \fBTk_CreateSelHandler\fR.
+.AP char *buffer in
+Null terminated string containing the data to be appended to the clipboard.
+.BE
+
+.SH DESCRIPTION
+.PP
+These two procedures manage the clipboard for Tk.
+The clipboard is typically managed by calling \fBTk_ClipboardClear\fR
+once, then calling \fBTk_ClipboardAppend\fR to add data for any
+number of targets.
+.PP
+\fBTk_ClipboardClear\fR claims the CLIPBOARD selection and frees any
+data items previously stored on the clipboard in this application.
+It normally returns TCL_OK, but if an error occurs it returns
+TCL_ERROR and leaves an error message in \fIinterp->result\fR.
+\fBTk_ClipboardClear\fR must be called before a sequence of
+\fBTk_ClipboardAppend\fR calls can be issued.
+.PP
+\fBTk_ClipboardAppend\fR appends a buffer of data to the clipboard.
+The first buffer for a given \fItarget\fR determines the \fIformat\fR
+for that \fItarget\fR.
+Any successive appends for that \fItarget\fR must have
+the same format or an error will be returned.
+\fBTk_ClipboardAppend\fR returns TCL_OK if the buffer is
+successfully copied onto the clipboard. If the clipboard is not
+currently owned by the application, either
+because \fBTk_ClipboardClear\fR has not been called or because
+ownership of the clipboard has changed since the last call to
+\fBTk_ClipboardClear\fR,
+\fBTk_ClipboardAppend\fR returns TCL_ERROR and leaves an error message in
+\fIinterp->result\fR.
+.PP
+In order to guarantee atomicity, no event handling should occur
+between \fBTk_ClipboardClear\fR and the following
+\fBTk_ClipboardAppend\fR calls (otherwise someone could retrieve
+a partially completed clipboard or claim ownership away from
+this application).
+.PP
+\fBTk_ClipboardClear\fR may invoke callbacks, including arbitrary
+Tcl scripts, as a result of losing the CLIPBOARD selection, so
+any calling function should take care to be reentrant at the point
+\fBTk_ClipboardClear\fR is invoked.
+
+.SH KEYWORDS
+append, clipboard, clear, format, type
diff --git a/tk/doc/ClrSelect.3 b/tk/doc/ClrSelect.3
new file mode 100644
index 00000000000..1de0c1887b0
--- /dev/null
+++ b/tk/doc/ClrSelect.3
@@ -0,0 +1,42 @@
+'\"
+'\" 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$
+'\"
+.so man.macros
+.TH Tk_ClearSelection 3 4.0 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_ClearSelection \- Deselect a selection
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_ClearSelection\fR(\fItkwin, selection\fR)
+.SH ARGUMENTS
+.AS Tk_Window tkwin
+.AP Tk_Window tkwin in
+The selection will be cleared from the display containing this
+window.
+.AP Atom selection in
+The name of selection to be cleared.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_ClearSelection\fR cancels the selection specified by the atom
+\fIselection\fR for the display containing \fItkwin\fR.
+The selection need not be in \fItkwin\fR itself or even in
+\fItkwin\fR's application.
+If there is a window anywhere on \fItkwin\fR's display that
+owns \fIselection\fR, the window will be notified and the
+selection will be cleared.
+If there is no owner for \fIselection\fR on the display, then the
+procedure has no effect.
+
+.SH KEYWORDS
+clear, selection
diff --git a/tk/doc/ConfigWidg.3 b/tk/doc/ConfigWidg.3
new file mode 100644
index 00000000000..7ab3f67ef50
--- /dev/null
+++ b/tk/doc/ConfigWidg.3
@@ -0,0 +1,618 @@
+'\"
+'\" 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$
+'\"
+.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.
+.AP int argc in
+Number of arguments in \fIargv\fR.
+.AP char **argv in
+Command-line options for configuring widget.
+.AP char *widgRec in/out
+Points to widget record structure. Fields in this structure get
+modified by \fBTk_ConfigureWidget\fR to hold configuration information.
+.AP int flags in
+If non-zero, then it specifies an OR-ed combination of flags that
+control the processing of configuration information.
+TK_CONFIG_ARGV_ONLY causes the option database and defaults to be
+ignored, and flag bits TK_CONFIG_USER_BIT and higher are used to
+selectively disable entries in \fIspecs\fR.
+.AP "type name" type in
+The name of the type of a widget record.
+.AP "field name" field in
+The name of a field in records of type \fItype\fR.
+.AP char *argvName in
+The name used on Tcl command lines to refer to a particular option
+(e.g. when creating a widget or invoking the \fBconfigure\fR widget
+command). If non-NULL, then information is returned only for this
+option. If NULL, then information is returned for all available
+options.
+.AP Display *display in
+Display containing widget whose record is being freed; needed in
+order to free up resources.
+.BE
+.SH DESCRIPTION
+.PP
+\fBTk_ConfigureWidget\fR is called to configure various aspects of a
+widget, such as colors, fonts, border width, etc.
+It is intended as a convenience procedure to reduce the amount
+of code that must be written in individual widget managers to
+handle configuration information.
+It is typically
+invoked when widgets are created, and again when the \fBconfigure\fR
+command is invoked for a widget.
+Although intended primarily for widgets, \fBTk_ConfigureWidget\fR
+can be used in other situations where \fIargc-argv\fR information
+is to be used to fill in a record structure, such as configuring
+graphical elements for a canvas widget or entries of a menu.
+.PP
+\fBTk_ConfigureWidget\fR processes
+a table specifying the configuration options that are supported
+(\fIspecs\fR) and a collection of command-line arguments (\fIargc\fR and
+\fIargv\fR) to fill in fields of a record (\fIwidgRec\fR).
+It uses the option database and defaults specified in \fIspecs\fR
+to fill in fields of \fIwidgRec\fR that are not specified in \fIargv\fR.
+\fBTk_ConfigureWidget\fR normally returns the value TCL_OK; in this
+case it does not modify \fIinterp\fR.
+If an error
+occurs then TCL_ERROR is returned and \fBTk_ConfigureWidget\fR will
+leave an error message in \fIinterp->result\fR in the standard Tcl
+fashion.
+In the event of an error return, some of the fields of \fIwidgRec\fR
+could already have been set, if configuration information for them
+was successfully processed before the error occurred.
+The other fields will be set to reasonable initial values so that
+\fBTk_FreeOptions\fR can be called for cleanup.
+.PP
+The \fIspecs\fR array specifies the kinds of configuration options
+expected by the widget. Each of its entries specifies one configuration
+option and has the following structure:
+.CS
+typedef struct {
+ int \fItype\fR;
+ char *\fIargvName\fR;
+ char *\fIdbName\fR;
+ char *\fIdbClass\fR;
+ char *\fIdefValue\fR;
+ int \fIoffset\fR;
+ int \fIspecFlags\fR;
+ Tk_CustomOption *\fIcustomPtr\fR;
+} Tk_ConfigSpec;
+.CE
+The \fItype\fR field indicates what type of configuration option this is
+(e.g. TK_CONFIG_COLOR for a color value, or TK_CONFIG_INT for
+an integer value). The \fItype\fR field indicates how to use the
+value of the option (more on this below).
+The \fIargvName\fR field is a string such as ``\-font'' or ``\-bg'',
+which is compared with the values in \fIargv\fR (if \fIargvName\fR is
+NULL it means this is a grouped entry; see GROUPED ENTRIES below). The
+\fIdbName\fR and \fIdbClass\fR fields are used to look up a value
+for this option in the option database. The \fIdefValue\fR field
+specifies a default value for this configuration option if no
+value is specified in either \fIargv\fR or the option database.
+\fIOffset\fR indicates where in \fIwidgRec\fR to store information
+about this option, and \fIspecFlags\fR contains additional information
+to control the processing of this configuration option (see FLAGS
+below).
+The last field, \fIcustomPtr\fR, is only used if \fItype\fR is
+TK_CONFIG_CUSTOM; see CUSTOM OPTION TYPES below.
+.PP
+\fBTk_ConfigureWidget\fR first processes \fIargv\fR to see which
+(if any) configuration options are specified there. \fIArgv\fR
+must contain an even number of fields; the first of each pair
+of fields must match the \fIargvName\fR of some entry in \fIspecs\fR
+(unique abbreviations are acceptable),
+and the second field of the pair contains the value for that
+configuration option. If there are entries in \fIspec\fR for which
+there were no matching entries in \fIargv\fR,
+\fBTk_ConfigureWidget\fR uses the \fIdbName\fR and \fIdbClass\fR
+fields of the \fIspecs\fR entry to probe the option database; if
+a value is found, then it is used as the value for the option.
+Finally, if no entry is found in the option database, the
+\fIdefValue\fR field of the \fIspecs\fR entry is used as the
+value for the configuration option. If the \fIdefValue\fR is
+NULL, or if the TK_CONFIG_DONT_SET_DEFAULT bit is set in
+\fIflags\fR, then there is no default value and this \fIspecs\fR entry
+will be ignored if no value is specified in \fIargv\fR or the
+option database.
+.PP
+Once a string value has been determined for a configuration option,
+\fBTk_ConfigureWidget\fR translates the string value into a more useful
+form, such as a color if \fItype\fR is TK_CONFIG_COLOR or an integer
+if \fItype\fR is TK_CONFIG_INT. This value is then stored in the
+record pointed to by \fIwidgRec\fR. This record is assumed to
+contain information relevant to the manager of the widget; its exact
+type is unknown to \fBTk_ConfigureWidget\fR. The \fIoffset\fR field
+of each \fIspecs\fR entry indicates where in \fIwidgRec\fR to store
+the information about this configuration option. You should use the
+\fBTk_Offset\fR macro to generate \fIoffset\fR values (see below for
+a description of \fBTk_Offset\fR). The location indicated by
+\fIwidgRec\fR and \fIoffset\fR will be referred to as the ``target''
+in the descriptions below.
+.PP
+The \fItype\fR field of each entry in \fIspecs\fR determines what
+to do with the string value of that configuration option. The
+legal values for \fItype\fR, and the corresponding actions, are:
+.TP
+\fBTK_CONFIG_ACTIVE_CURSOR\fR
+The value
+must be an ASCII string identifying a cursor in a form
+suitable for passing to \fBTk_GetCursor\fR.
+The value is converted to a \fBTk_Cursor\fR by calling
+\fBTk_GetCursor\fR and the result is stored in the target.
+In addition, the resulting cursor is made the active cursor
+for \fItkwin\fR by calling \fBXDefineCursor\fR.
+If TK_CONFIG_NULL_OK is specified in \fIspecFlags\fR then the value
+may be an empty string, in which case the target and \fItkwin\fR's
+active cursor will be set to \fBNone\fR.
+If the previous value of the target
+wasn't \fBNone\fR, then it is freed by passing it to \fBTk_FreeCursor\fR.
+.TP
+\fBTK_CONFIG_ANCHOR\fR
+The value must be an ASCII string identifying an anchor point in one of the ways
+accepted by \fBTk_GetAnchor\fR.
+The string is converted to a \fBTk_Anchor\fR by calling
+\fBTk_GetAnchor\fR and the result is stored in the target.
+.TP
+\fBTK_CONFIG_BITMAP\fR
+The value must be an ASCII string identifying a bitmap in a form
+suitable for passing to \fBTk_GetBitmap\fR. The value is converted
+to a \fBPixmap\fR by calling \fBTk_GetBitmap\fR and the result
+is stored in the target.
+If TK_CONFIG_NULL_OK is specified in \fIspecFlags\fR then the value
+may be an empty string, in which case the target is set to \fBNone\fR.
+If the previous value of the target
+wasn't \fBNone\fR, then it is freed by passing it to \fBTk_FreeBitmap\fR.
+.TP
+\fBTK_CONFIG_BOOLEAN\fR
+The value must be an ASCII string specifying a boolean value. Any
+of the values ``true'', ``yes'', ``on'', or ``1'',
+or an abbreviation of one of these values, means true;
+any of the values ``false'', ``no'', ``off'', or ``0'', or an abbreviation of
+one of these values, means false.
+The target is expected to be an integer; for true values it will
+be set to 1 and for false values it will be set to 0.
+.TP
+\fBTK_CONFIG_BORDER\fR
+The value must be an ASCII string identifying a border color in a form
+suitable for passing to \fBTk_Get3DBorder\fR. The value is converted
+to a (\fBTk_3DBorder *\fR) by calling \fBTk_Get3DBorder\fR and the result
+is stored in the target.
+If TK_CONFIG_NULL_OK is specified in \fIspecFlags\fR then the value
+may be an empty string, in which case the target will be set to NULL.
+If the previous value of the target
+wasn't NULL, then it is freed by passing it to \fBTk_Free3DBorder\fR.
+.TP
+\fBTK_CONFIG_CAP_STYLE\fR
+The value must be
+an ASCII string identifying a cap style in one of the ways
+accepted by \fBTk_GetCapStyle\fR.
+The string is converted to an integer value corresponding
+to the cap style by calling
+\fBTk_GetCapStyle\fR and the result is stored in the target.
+.TP
+\fBTK_CONFIG_COLOR\fR
+The value must be an ASCII string identifying a color in a form
+suitable for passing to \fBTk_GetColor\fR. The value is converted
+to an (\fBXColor *\fR) by calling \fBTk_GetColor\fR and the result
+is stored in the target.
+If TK_CONFIG_NULL_OK is specified in \fIspecFlags\fR then the value
+may be an empty string, in which case the target will be set to \fBNone\fR.
+If the previous value of the target
+wasn't NULL, then it is freed by passing it to \fBTk_FreeColor\fR.
+.TP
+\fBTK_CONFIG_CURSOR\fR
+This option is identical to \fBTK_CONFIG_ACTIVE_CURSOR\fR except
+that the new cursor is not made the active one for \fItkwin\fR.
+.TP
+\fBTK_CONFIG_CUSTOM\fR
+This option allows applications to define new option types.
+The \fIcustomPtr\fR field of the entry points to a structure
+defining the new option type.
+See the section CUSTOM OPTION TYPES below for details.
+.TP
+\fBTK_CONFIG_DOUBLE\fR
+The value must be an ASCII floating-point number in
+the format accepted by \fBstrtol\fR. The string is converted
+to a \fBdouble\fR value, and the value is stored in the
+target.
+.TP
+\fBTK_CONFIG_END\fR
+Marks the end of the table. The last entry in \fIspecs\fR
+must have this type; all of its other fields are ignored and it
+will never match any arguments.
+.TP
+\fBTK_CONFIG_FONT\fR
+The value must be an ASCII string identifying a font in a form
+suitable for passing to \fBTk_GetFontStruct\fR. The value is converted
+to an (\fBXFontStruct *\fR) by calling \fBTk_GetFontStruct\fR and the result
+is stored in the target.
+If TK_CONFIG_NULL_OK is specified in \fIspecFlags\fR then the value
+may be an empty string, in which case the target will be set to NULL.
+If the previous value of the target
+wasn't NULL, then it is freed by passing it to \fBTk_FreeFontStruct\fR.
+.TP
+\fBTK_CONFIG_INT\fR
+The value must be an ASCII integer string
+in the format accepted by \fBstrtol\fR (e.g. ``0''
+and ``0x'' prefixes may be used to specify octal or hexadecimal
+numbers, respectively). The string is converted to an integer
+value and the integer is stored in the target.
+.TP
+\fBTK_CONFIG_JOIN_STYLE\fR
+The value must be
+an ASCII string identifying a join style in one of the ways
+accepted by \fBTk_GetJoinStyle\fR.
+The string is converted to an integer value corresponding
+to the join style by calling
+\fBTk_GetJoinStyle\fR and the result is stored in the target.
+.TP
+\fBTK_CONFIG_JUSTIFY\fR
+The value must be
+an ASCII string identifying a justification method in one of the
+ways accepted by \fBTk_GetJustify\fR.
+The string is converted to a \fBTk_Justify\fR by calling
+\fBTk_GetJustify\fR and the result is stored in the target.
+.TP
+\fBTK_CONFIG_MM\fR
+The value must specify a screen distance in one of the forms acceptable
+to \fBTk_GetScreenMM\fR.
+The string is converted to double-precision floating-point distance
+in millimeters and the value is stored in the target.
+.TP
+\fBTK_CONFIG_PIXELS\fR
+The value must specify screen units in one of the forms acceptable
+to \fBTk_GetPixels\fR.
+The string is converted to an integer distance in pixels and the
+value is stored in the target.
+.TP
+\fBTK_CONFIG_RELIEF\fR
+The value must be an ASCII string identifying a relief in a form
+suitable for passing to \fBTk_GetRelief\fR. The value is converted
+to an integer relief value by calling \fBTk_GetRelief\fR and the result
+is stored in the target.
+.TP
+\fBTK_CONFIG_STRING\fR
+A copy
+of the value is made by allocating memory space with
+\fBmalloc\fR and copying the value into the dynamically-allocated
+space. A pointer to the new string is stored in the target.
+If TK_CONFIG_NULL_OK is specified in \fIspecFlags\fR then the value
+may be an empty string, in which case the target will be set to NULL.
+If the previous value of the target wasn't NULL, then it is
+freed by passing it to \fBfree\fR.
+.TP
+\fBTK_CONFIG_SYNONYM\fR
+This \fItype\fR value identifies special entries in \fIspecs\fR that
+are synonyms for other entries. If an \fIargv\fR value matches the
+\fIargvName\fR of a TK_CONFIG_SYNONYM entry, the entry isn't used
+directly. Instead, \fBTk_ConfigureWidget\fR searches \fIspecs\fR
+for another entry whose \fIargvName\fR is the same as the \fIdbName\fR
+field in the TK_CONFIG_SYNONYM entry; this new entry is used just
+as if its \fIargvName\fR had matched the \fIargv\fR value. The
+synonym mechanism allows multiple \fIargv\fR values to be used for
+a single configuration option, such as ``\-background'' and ``\-bg''.
+.TP
+\fBTK_CONFIG_UID\fR
+The value is translated to a \fBTk_Uid\fR
+(by passing it to \fBTk_GetUid\fR). The resulting value
+is stored in the target.
+If TK_CONFIG_NULL_OK is specified in \fIspecFlags\fR and the value
+is an empty string then the target will be set to NULL.
+.TP
+\fBTK_CONFIG_WINDOW\fR
+The value must be a window path name. It is translated to a
+\fBTk_Window\fR token and the token is stored in the target.
+
+.SH "GROUPED ENTRIES"
+.PP
+In some cases it is useful to generate multiple resources from
+a single configuration value. For example, a color name might
+be used both to generate the background color for a widget (using
+TK_CONFIG_COLOR) and to generate a 3-D border to draw around the
+widget (using TK_CONFIG_BORDER). In cases like this it is possible
+to specify that several consecutive entries in \fIspecs\fR are to
+be treated as a group. The first entry is used to determine a value
+(using its \fIargvName\fR, \fIdbName\fR,
+\fIdbClass\fR, and \fIdefValue\fR fields). The value will be processed
+several times (one for each entry in the group), generating multiple
+different resources and modifying multiple targets within \fIwidgRec\fR.
+Each of the entries after the first must have a NULL value in its
+\fIargvName\fR field; this indicates that the entry is to be grouped
+with the entry that precedes it. Only the \fItype\fR and \fIoffset\fR
+fields are used from these follow-on entries.
+
+.SH "FLAGS"
+.PP
+The \fIflags\fR argument passed to \fBTk_ConfigureWidget\fR is used
+in conjunction with the \fIspecFlags\fR fields in the entries of \fIspecs\fR
+to provide additional control over the processing of configuration
+options. These values are used in three different ways as
+described below.
+.PP
+First, if the \fIflags\fR argument to \fBTk_ConfigureWidget\fR has
+the TK_CONFIG_ARGV_ONLY bit set (i.e., \fIflags\fR | TK_CONFIG_ARGV_ONLY != 0),
+then the option database and
+\fIdefValue\fR fields are not used. In this case, if an entry in
+\fIspecs\fR doesn't match a field in \fIargv\fR then nothing happens:
+the corresponding target isn't modified. This feature is useful
+when the goal is to modify certain configuration options while
+leaving others in their current state, such as when a \fBconfigure\fR
+widget command is being processed.
+.PP
+Second, the \fIspecFlags\fR field of an entry in \fIspecs\fR may be used
+to control the processing of that entry. Each \fIspecFlags\fR
+field may consists of an OR-ed combination of the following values:
+.TP
+\fBTK_CONFIG_COLOR_ONLY\fR
+If this bit is set then the entry will only be considered if the
+display for \fItkwin\fR has more than one bit plane. If the display
+is monochromatic then this \fIspecs\fR entry will be ignored.
+.TP
+\fBTK_CONFIG_MONO_ONLY\fR
+If this bit is set then the entry will only be considered if the
+display for \fItkwin\fR has exactly one bit plane. If the display
+is not monochromatic then this \fIspecs\fR entry will be ignored.
+.TP
+\fBTK_CONFIG_NULL_OK\fR
+This bit is only relevant for some types of entries (see the
+descriptions of the various entry types above).
+If this bit is set, it indicates that an empty string value
+for the field is acceptable and if it occurs then the
+target should be set to NULL or \fBNone\fR, depending
+on the type of the target.
+This flag 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.
+If this bit isn't set then empty strings are processed as strings,
+which generally results in an error.
+.TP
+\fBTK_CONFIG_DONT_SET_DEFAULT\fR
+If this bit is one, it means that the \fIdefValue\fR field of the
+entry should only be used for returning the default value in
+\fBTk_ConfigureInfo\fR.
+In calls to \fBTk_ConfigureWidget\fR no default will be supplied
+for entries with this flag set; it is assumed that the
+caller has already supplied a default value in the target location.
+This flag provides a performance optimization where it is expensive
+to process the default string: the client can compute the default
+once, save the value, and provide it before calling
+\fBTk_ConfigureWidget\fR.
+.TP
+\fBTK_CONFIG_OPTION_SPECIFIED\fR
+This bit is set and cleared by \fBTk_ConfigureWidget\fR. Whenever
+\fBTk_ConfigureWidget\fR returns, this bit will be set in all the
+entries where a value was specified in \fIargv\fR.
+It will be zero in all other entries.
+This bit provides a way for clients to determine which values
+actually changed in a call to \fBTk_ConfigureWidget\fR.
+.PP
+The TK_CONFIG_MONO_ONLY and TK_CONFIG_COLOR_ONLY flags are typically
+used to specify different default values for
+monochrome and color displays. This is done by creating two
+entries in \fIspecs\fR that are identical except for their
+\fIdefValue\fR and \fIspecFlags\fR fields. One entry should have
+the value TK_CONFIG_MONO_ONLY in its \fIspecFlags\fR and the
+default value for monochrome displays in its \fIdefValue\fR; the
+other entry entry should have the value TK_CONFIG_COLOR_ONLY in
+its \fIspecFlags\fR and the appropriate \fIdefValue\fR for
+color displays.
+.PP
+Third, it is possible to use \fIflags\fR and \fIspecFlags\fR
+together to selectively disable some entries. This feature is
+not needed very often. It is useful in cases where several
+similar kinds of widgets are implemented in one place. It allows
+a single \fIspecs\fR table to be created with all the configuration
+options for all the widget types. When processing a particular
+widget type, only entries relevant to that type will be used. This
+effect is achieved by setting the high-order bits (those in positions
+equal to or greater than TK_CONFIG_USER_BIT) in \fIspecFlags\fR
+values or in \fIflags\fR. In order for a particular entry in
+\fIspecs\fR to be used, its high-order bits must match exactly
+the high-order bits of the \fIflags\fR value passed to
+\fBTk_ConfigureWidget\fR. If a \fIspecs\fR table is being used
+for N different widget types, then N of the high-order bits will
+be used. Each \fIspecs\fR entry will have one of more of those
+bits set in its \fIspecFlags\fR field to indicate the widget types
+for which this entry is valid. When calling \fBTk_ConfigureWidget\fR,
+\fIflags\fR will have a single one of these bits set to select the
+entries for the desired widget type. For a working example of
+this feature, see the code in tkButton.c.
+
+.SH TK_OFFSET
+.PP
+The \fBTk_Offset\fR macro is provided as a safe way of generating
+the \fIoffset\fR values for entries in Tk_ConfigSpec 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 TK_CONFIGUREINFO
+.PP
+The \fBTk_ConfigureInfo\fR procedure may be used to obtain
+information about one or all of the options for a given widget.
+Given a token for a window (\fItkwin\fR), a table describing the
+configuration options for a class of widgets (\fIspecs\fR), a
+pointer to a widget record containing the current information for
+a widget (\fIwidgRec\fR), and a NULL \fIargvName\fR argument,
+\fBTk_ConfigureInfo\fR generates a string describing all of the
+configuration options for the window. The string is placed
+in \fIinterp->result\fR. Under normal circumstances
+it returns TCL_OK; if an error occurs then it returns TCL_ERROR
+and \fIinterp->result\fR contains an error message.
+.PP
+If \fIargvName\fR is NULL, then the value left in
+\fIinterp->result\fR by \fBTk_ConfigureInfo\fR
+consists of a list of one or more entries, each of which describes
+one configuration option (i.e. one entry in \fIspecs\fR). Each
+entry in the list will contain either two or five values. If the
+corresponding entry in \fIspecs\fR has type TK_CONFIG_SYNONYM, then
+the list will contain two values: the \fIargvName\fR for the entry
+and the \fIdbName\fR (synonym name). Otherwise the list will contain
+five values: \fIargvName\fR, \fIdbName\fR, \fIdbClass\fR, \fIdefValue\fR,
+and current value. The current value is computed from the appropriate
+field of \fIwidgRec\fR by calling procedures like \fBTk_NameOfColor\fR.
+.PP
+If the \fIargvName\fR argument to \fBTk_ConfigureInfo\fR is non-NULL,
+then it indicates a single option, and information is returned only
+for that option. The string placed in \fIinterp->result\fR will be
+a list containing two or five values as described above; this will
+be identical to the corresponding sublist that would have been returned
+if \fIargvName\fR had been NULL.
+.PP
+The \fIflags\fR argument to \fBTk_ConfigureInfo\fR is used to restrict
+the \fIspecs\fR entries to consider, just as for \fBTk_ConfigureWidget\fR.
+
+.SH TK_CONFIGUREVALUE
+.PP
+\fBTk_ConfigureValue\fR takes arguments similar to \fBTk_ConfigureInfo\fR;
+instead of returning a list of values, it just returns the current value
+of the option given by \fIargvName\fR (\fIargvName\fR must not be NULL).
+The value is returned in \fIinterp->result\fR and TCL_OK is
+normally returned as the procedure's result.
+If an error occurs in \fBTk_ConfigureValue\fR (e.g., \fIargvName\fR is
+not a valid option name), TCL_ERROR is returned and an error message
+is left in \fIinterp->result\fR.
+This procedure is typically called to implement \fBcget\fR widget
+commands.
+
+.SH TK_FREEOPTIONS
+.PP
+The \fBTk_FreeOptions\fR procedure may be invoked during widget cleanup
+to release all of the resources associated with configuration options.
+It scans through \fIspecs\fR and for each entry corresponding to a
+resource that must be explicitly freed (e.g. those with
+type TK_CONFIG_COLOR), it frees the resource in the widget record.
+If the field in the widget record doesn't refer to a resource (e.g.
+it contains a null pointer) then no resource is freed for that
+entry.
+After freeing a resource, \fBTk_FreeOptions\fR sets the
+corresponding field of the widget record to null.
+
+.SH "CUSTOM OPTION TYPES"
+.PP
+Applications can extend the built-in configuration types with additional
+configuration types by writing procedures to parse and print options
+of the a type and creating a structure pointing to those procedures:
+.CS
+typedef struct Tk_CustomOption {
+ Tk_OptionParseProc *\fIparseProc\fR;
+ Tk_OptionPrintProc *\fIprintProc\fR;
+ ClientData \fIclientData\fR;
+} Tk_CustomOption;
+
+typedef int Tk_OptionParseProc(
+ ClientData \fIclientData\fR,
+ Tcl_Interp *\fIinterp\fR,
+ Tk_Window \fItkwin\fR,
+ char *\fIvalue\fR,
+ char *\fIwidgRec\fR,
+ int \fIoffset\fR);
+
+typedef char *Tk_OptionPrintProc(
+ ClientData \fIclientData\fR,
+ Tk_Window \fItkwin\fR,
+ char *\fIwidgRec\fR,
+ int \fIoffset\fR,
+ Tcl_FreeProc **\fIfreeProcPtr\fR);
+.CE
+The Tk_CustomOption structure contains three fields, which are pointers
+to the two procedures and a \fIclientData\fR value to be passed to those
+procedures when they are invoked. The \fIclientData\fR value typically
+points to a structure containing information that is needed by the
+procedures when they are parsing and printing options.
+.PP
+The \fIparseProc\fR procedure is invoked by
+\fBTk_ConfigureWidget\fR to parse a string and store the resulting
+value in the widget record.
+The \fIclientData\fR argument is a copy of the \fIclientData\fR
+field in the Tk_CustomOption structure.
+The \fIinterp\fR argument points to a Tcl interpreter used for
+error reporting. \fITkwin\fR is a copy of the \fItkwin\fR argument
+to \fBTk_ConfigureWidget\fR. The \fIvalue\fR argument is a string
+describing the value for the option; it could have been specified
+explicitly in the call to \fBTk_ConfigureWidget\fR or it could
+come from the option database or a default.
+\fIValue\fR will never be a null pointer but it may point to
+an empty string.
+\fIRecordPtr\fR is the same as the \fIwidgRec\fR argument to
+\fBTk_ConfigureWidget\fR; it points to the start of the widget
+record to modify.
+The last argument, \fIoffset\fR, gives the offset in bytes from the start
+of the widget record to the location where the option value is to
+be placed. The procedure should translate the string to whatever
+form is appropriate for the option and store the value in the widget
+record. It should normally return TCL_OK, but if an error occurs
+in translating the string to a value then it should return TCL_ERROR
+and store an error message in \fIinterp->result\fR.
+.PP
+The \fIprintProc\fR procedure is called
+by \fBTk_ConfigureInfo\fR to produce a string value describing an
+existing option.
+Its \fIclientData\fR, \fItkwin\fR, \fIwidgRec\fR, and \fIoffset\fR
+arguments all have the same meaning as for Tk_OptionParseProc
+procedures.
+The \fIprintProc\fR procedure should examine the option whose value
+is stored at \fIoffset\fR in \fIwidgRec\fR, produce a string describing
+that option, and return a pointer to the string.
+If the string is stored in dynamically-allocated memory, then
+the procedure must set \fI*freeProcPtr\fR to the address of
+a procedure to call to free the string's memory; \fBTk_ConfigureInfo\fR
+will call this procedure when it is finished with the string.
+If the result string is stored in static memory then \fIprintProc\fR
+need not do anything with the \fIfreeProcPtr\fR argument.
+.PP
+Once \fIparseProc\fR and \fIprintProc\fR have been defined and a
+Tk_CustomOption structure has been created for them, options of this
+new type may be manipulated with Tk_ConfigSpec entries whose \fItype\fR
+fields are TK_CONFIG_CUSTOM and whose \fIcustomPtr\fR fields point
+to the Tk_CustomOption structure.
+
+.SH EXAMPLES
+.PP
+Although the explanation of \fBTk_ConfigureWidget\fR is fairly
+complicated, its actual use is pretty straightforward.
+The easiest way to get started is to copy the code
+from an existing widget.
+The library implementation of frames
+(tkFrame.c) has a simple configuration table, and the library
+implementation of buttons (tkButton.c) has a much more complex
+table that uses many of the fancy \fIspecFlags\fR mechanisms.
+
+.SH KEYWORDS
+anchor, bitmap, boolean, border, cap style, color, configuration options,
+cursor, custom, double, font, integer, join style, justify, millimeters,
+pixels, relief, synonym, uid
diff --git a/tk/doc/ConfigWind.3 b/tk/doc/ConfigWind.3
new file mode 100644
index 00000000000..fd1c2c6919e
--- /dev/null
+++ b/tk/doc/ConfigWind.3
@@ -0,0 +1,153 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_ConfigureWindow\fR(\fItkwin, valueMask, valuePtr\fR)
+.sp
+\fBTk_MoveWindow\fR(\fItkwin, x, y\fR)
+.sp
+\fBTk_ResizeWindow\fR(\fItkwin, width, height\fR)
+.sp
+\fBTk_MoveResizeWindow\fR(\fItkwin, x, y, width, height\fR)
+.sp
+\fBTk_SetWindowBorderWidth\fR(\fItkwin, borderWidth\fR)
+.sp
+\fBTk_ChangeWindowAttributes\fR(\fItkwin, valueMask, attsPtr\fR)
+.sp
+\fBTk_SetWindowBackground\fR(\fItkwin, pixel\fR)
+.sp
+\fBTk_SetWindowBackgroundPixmap\fR(\fItkwin, pixmap\fR)
+.sp
+\fBTk_SetWindowBorder\fR(\fItkwin, pixel\fR)
+.sp
+\fBTk_SetWindowBorderPixmap\fR(\fItkwin, pixmap\fR)
+.sp
+\fBTk_SetWindowColormap\fR(\fItkwin, colormap\fR)
+.sp
+\fBTk_DefineCursor\fR(\fItkwin, cursor\fR)
+.sp
+\fBTk_UndefineCursor\fR(\fItkwin\fR)
+.SH ARGUMENTS
+.AS XSetWindowAttributes borderWidth
+.AP Tk_Window tkwin in
+Token for window.
+.AP "unsigned int" valueMask in
+OR-ed mask of values like \fBCWX\fR or \fBCWBorderPixel\fR,
+indicating which fields of \fI*valuePtr\fR or \fI*attsPtr\fR to use.
+.AP XWindowChanges *valuePtr in
+Points to a structure containing new values for the configuration
+parameters selected by \fIvalueMask\fR. Fields not selected
+by \fIvalueMask\fR are ignored.
+.AP int x in
+New x-coordinate for \fItkwin\fR's top left pixel (including
+border, if any) within tkwin's parent.
+.AP int y in
+New y-coordinate for \fItkwin\fR's top left pixel (including
+border, if any) within tkwin's parent.
+.AP "int" width in
+New width for \fItkwin\fR (interior, not including border).
+.AP "int" height in
+New height for \fItkwin\fR (interior, not including border).
+.AP "int" borderWidth in
+New width for \fItkwin\fR's border.
+.AP XSetWindowAttributes *attsPtr in
+Points to a structure containing new values for the attributes
+given by the \fIvalueMask\fR argument. Attributes not selected
+by \fIvalueMask\fR are ignored.
+.AP "unsigned long" pixel in
+New background or border color for window.
+.AP Pixmap pixmap in
+New pixmap to use for background or border of \fItkwin\fR. WARNING:
+cannot necessarily be deleted immediately, as for Xlib calls. See
+note below.
+.AP Colormap colormap in
+New colormap to use for \fItkwin\fR.
+.AP Tk_Cursor cursor in
+New cursor to use for \fItkwin\fR. If \fBNone\fR is specified, then
+\fItkwin\fR will not have its own cursor; it will use the cursor
+of its parent.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures are analogous to the X library procedures
+with similar names, such as \fBXConfigureWindow\fR. Each
+one of the above procedures calls the corresponding X procedure
+and also saves the configuration information in Tk's local
+structure for the window. This allows the information to
+be retrieved quickly by the application (using macros such
+as \fBTk_X\fR and \fBTk_Height\fR) without having to contact
+the X server. In addition, if no X window has actually been
+created for \fItkwin\fR yet, these procedures do not issue
+X operations or cause event handlers to be invoked; they save
+the information in Tk's local
+structure for the window; when the window is created later,
+the saved information will be used to configure the window.
+.PP
+See the X library documentation for details on what these
+procedures do and how they use their arguments.
+.PP
+In the procedures \fBTk_ConfigureWindow\fR, \fBTk_MoveWindow\fR,
+\fBTk_ResizeWindow\fR, \fBTk_MoveResizeWindow\fR, and
+\fBTk_SetWindowBorderWidth\fR,
+if \fItkwin\fR is an internal window then event handlers interested
+in configure events are invoked immediately, before the procedure
+returns. If \fItkwin\fR is a top-level window
+then the event handlers will be invoked later, after X has seen
+the request and returned an event for it.
+.PP
+Applications using Tk should never call procedures like
+\fBXConfigureWindow\fR directly; they should always use the
+corresponding Tk procedures.
+.PP
+The size and location of a window should only be modified by the
+appropriate geometry manager for that window and never by a window
+itself (but see \fBTk_MoveToplevelWindow\fR for moving a top-level
+window).
+.PP
+You may not use \fBTk_ConfigureWindow\fR to change the
+stacking order of a window (\fIvalueMask\fR may not contain the
+\fBCWSibling\fR or \fBCWStackMode\fR bits).
+To change the stacking order, use the procedure \fBTk_RestackWindow\fR.
+.PP
+The procedure \fBTk_SetWindowColormap\fR will automatically add
+\fItkwin\fR to the \fBTK_COLORMAP_WINDOWS\fR property of its
+nearest top-level ancestor if the new colormap is different from
+that of \fItkwin\fR's parent and \fItkwin\fR isn't already in
+the \fBTK_COLORMAP_WINDOWS\fR property.
+
+.SH BUGS
+.PP
+\fBTk_SetWindowBackgroundPixmap\fR and \fBTk_SetWindowBorderPixmap\fR
+differ slightly from their Xlib counterparts in that the \fIpixmap\fR
+argument may not necessarily be deleted immediately after calling
+one of these procedures. This is because \fItkwin\fR's window
+may not exist yet at the time of the call, in which case \fIpixmap\fR
+is merely saved and used later when \fItkwin\fR's window is actually
+created. If you wish to delete \fIpixmap\fR, then call
+\fBTk_MakeWindowExist\fR first to be sure that \fItkwin\fR's window exists
+and \fIpixmap\fR has been passed to the X server.
+.PP
+A similar problem occurs for the \fIcursor\fR argument passed to
+\fBTk_DefineCursor\fR. The solution is the same as for pixmaps above:
+call \fBTk_MakeWindowExist\fR before freeing the cursor.
+
+.SH "SEE ALSO"
+Tk_MoveToplevelWindow, Tk_RestackWindow
+
+.SH KEYWORDS
+attributes, border, color, configure, height, pixel, pixmap, width, window, x, y
diff --git a/tk/doc/CoordToWin.3 b/tk/doc/CoordToWin.3
new file mode 100644
index 00000000000..9cfd2ee5dc9
--- /dev/null
+++ b/tk/doc/CoordToWin.3
@@ -0,0 +1,51 @@
+'\"
+'\" 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$
+'\"
+.so man.macros
+.TH Tk_CoordsToWindow 3 "" Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_CoordsToWindow \- Find window containing a point
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+Tk_Window
+\fBTk_CoordsToWindow\fR(\fIrootX, rootY, tkwin\fR)
+.SH ARGUMENTS
+.AS Tk_Window tkwin
+.AP int rootX in
+X-coordinate (in root window coordinates).
+.AP int rootY in
+Y-coordinate (in root window coordinates).
+.AP Tk_Window tkwin in
+Token for window that identifies application.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_CoordsToWindow\fR locates the window that contains a given point.
+The point is specified in root coordinates with \fIrootX\fR and
+\fIrootY\fR (if a virtual-root window manager is in use then
+\fIrootX\fR and \fIrootY\fR are in the coordinate system of the
+virtual root window).
+The return value from the procedure is a token for the window that
+contains the given point.
+If the point is not in any window, or if the containing window
+is not in the same application as \fItkwin\fR, then NULL is
+returned.
+.PP
+The containing window is decided using the same rules that determine
+which window contains the mouse cursor: if a parent and a child both
+contain the point then the child gets preference, and if two siblings
+both contain the point then the highest one in the stacking order
+(i.e. the one that's visible on the screen) gets preference.
+
+.SH KEYWORDS
+containing, coordinates, root window
diff --git a/tk/doc/CrtErrHdlr.3 b/tk/doc/CrtErrHdlr.3
new file mode 100644
index 00000000000..77495830332
--- /dev/null
+++ b/tk/doc/CrtErrHdlr.3
@@ -0,0 +1,145 @@
+'\"
+'\" 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$
+'\"
+.so man.macros
+.TH Tk_CreateErrorHandler 3 "" Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_CreateErrorHandler, Tk_DeleteErrorHandler \- handle X protocol errors
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+Tk_ErrorHandler
+\fBTk_CreateErrorHandler\fR(\fIdisplay, error, request, minor, proc, clientData\fR)
+.sp
+\fBTk_DeleteErrorHandler\fR(\fIhandler\fR)
+.SH ARGUMENTS
+.AS "Tk_ErrorHandler" clientData
+.AP Display *display in
+Display whose errors are to be handled.
+.AP int error in
+Match only error events with this value in the \fIerror_code\fR
+field. If -1, then match any \fIerror_code\fR value.
+.AP int request in
+Match only error events with this value in the \fIrequest_code\fR
+field. If -1, then match any \fIrequest_code\fR value.
+.AP int minor in
+Match only error events with this value in the \fIminor_code\fR
+field. If -1, then match any \fIminor_code\fR value.
+.AP Tk_ErrorProc *proc in
+Procedure to invoke whenever an error event is received for
+\fIdisplay\fR and matches \fIerror\fR, \fIrequest\fR, and \fIminor\fR.
+NULL means ignore any matching errors.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR.
+.AP Tk_ErrorHandler handler in
+Token for error handler to delete (return value from a previous
+call to \fBTk_CreateErrorHandler\fR).
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_CreateErrorHandler\fR arranges for a particular procedure
+(\fIproc\fR) to be called whenever certain protocol errors occur on a
+particular display (\fIdisplay\fR). Protocol errors occur when
+the X protocol is used incorrectly, such as attempting to map a window
+that doesn't exist. See the Xlib documentation for \fBXSetErrorHandler\fR
+for more information on the kinds of errors that can occur.
+For \fIproc\fR to be invoked
+to handle a particular error, five things must occur:
+.IP [1]
+The error must pertain to \fIdisplay\fR.
+.IP [2]
+Either the \fIerror\fR argument to \fBTk_CreateErrorHandler\fR
+must have been -1, or the \fIerror\fR argument must match
+the \fIerror_code\fR field from the error event.
+.IP [3]
+Either the \fIrequest\fR argument to \fBTk_CreateErrorHandler\fR
+must have been -1, or the \fIrequest\fR argument must match
+the \fIrequest_code\fR field from the error event.
+.IP [4]
+Either the \fIminor\fR argument to \fBTk_CreateErrorHandler\fR
+must have been -1, or the \fIminor\fR argument must match
+the \fIminor_code\fR field from the error event.
+.IP [5]
+The protocol request to which the error pertains must have been
+made when the handler was active (see below for more information).
+.PP
+\fIProc\fR should have arguments and result that match the
+following type:
+.CS
+typedef int Tk_ErrorProc(
+ ClientData \fIclientData\fR,
+ XErrorEvent *\fIerrEventPtr\fR);
+.CE
+The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR
+argument given to \fBTcl_CreateErrorHandler\fR when the callback
+was created. Typically, \fIclientData\fR points to a data
+structure containing application-specific information that is
+needed to deal with the error. \fIErrEventPtr\fR is
+a pointer to the X error event.
+The procedure \fIproc\fR should return an integer value. If it
+returns 0 it means that \fIproc\fR handled the error completely and there
+is no need to take any other action for the error. If it returns
+non-zero it means \fIproc\fR was unable to handle the error.
+.PP
+If a value of NULL is specified for \fIproc\fR, all matching errors
+will be ignored: this will produce the same result as if a procedure
+had been specified that always returns 0.
+.PP
+If more than more than one handler matches a particular error, then
+they are invoked in turn. The handlers will be invoked in reverse
+order of creation: most recently declared handler first.
+If any handler returns 0, then subsequent (older) handlers will
+not be invoked. If no handler returns 0, then Tk invokes X'es
+default error handler, which prints an error message and aborts the
+program. If you wish to have a default handler that deals with errors
+that no other handler can deal with, then declare it first.
+.PP
+The X documentation states that ``the error handler should not call
+any functions (directly or indirectly) on the display that will
+generate protocol requests or that will look for input events.''
+This restriction applies to handlers declared by \fBTk_CreateErrorHandler\fR;
+disobey it at your own risk.
+.PP
+\fBTk_DeleteErrorHandler\fR may be called to delete a
+previously-created error handler. The \fIhandler\fR argument
+identifies the error handler, and should be a value returned by
+a previous call to \fBTk_CreateEventHandler\fR.
+.PP
+A particular error handler applies to errors resulting
+from protocol requests generated between
+the call to \fBTk_CreateErrorHandler\fR and the call to
+\fBTk_DeleteErrorHandler\fR. However, the actual callback
+to \fIproc\fR may not occur until after the \fBTk_DeleteErrorHandler\fR
+call, due to buffering in the client and server.
+If an error event pertains to
+a protocol request made just before calling \fBTk_DeleteErrorHandler\fR,
+then the error event may not have been processed
+before the \fBTk_DeleteErrorHandler\fR
+call. When this situation arises, Tk will save information about
+the handler and
+invoke the handler's \fIproc\fR later when the error event
+finally arrives.
+If an application wishes to delete an error handler and know
+for certain that all relevant errors have been processed,
+it should first call \fBTk_DeleteErrorHandler\fR and then
+call \fBXSync\fR; this will flush out any buffered requests and errors,
+but will result in a performance penalty because
+it requires communication to and from the X server. After the
+\fBXSync\fR call Tk is guaranteed not to call any error
+handlers deleted before the \fBXSync\fR call.
+.PP
+For the Tk error handling mechanism to work properly, it is essential
+that application code never calls \fBXSetErrorHandler\fR directly;
+applications should use only \fBTk_CreateErrorHandler\fR.
+
+.SH KEYWORDS
+callback, error, event, handler
diff --git a/tk/doc/CrtGenHdlr.3 b/tk/doc/CrtGenHdlr.3
new file mode 100644
index 00000000000..c4d6609bfae
--- /dev/null
+++ b/tk/doc/CrtGenHdlr.3
@@ -0,0 +1,84 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_CreateGenericHandler\fR(\fIproc, clientData\fR)
+.sp
+\fBTk_DeleteGenericHandler\fR(\fIproc, clientData\fR)
+.SH ARGUMENTS
+.AS "Tk_GenericProc" clientData
+.AP Tk_GenericProc *proc in
+Procedure to invoke whenever any X event occurs on any display.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_CreateGenericHandler\fR arranges for \fIproc\fR to be
+invoked in the future whenever any X event occurs. This mechanism is
+\fInot\fR intended for dispatching X events on windows managed by Tk
+(you should use \fBTk_CreateEventHandler\fR for this purpose).
+\fBTk_CreateGenericHandler\fR is intended for other purposes, such
+as tracing X events, monitoring events on windows not owned by Tk,
+accessing X-related libraries that were not originally designed for
+use with Tk, and so on.
+.PP
+The callback to \fIproc\fR will be made by \fBTk_HandleEvent\fR;
+this mechanism only works in programs that dispatch events
+through \fBTk_HandleEvent\fR (or through other Tk procedures that
+call \fBTk_HandleEvent\fR, such as \fBTk_DoOneEvent\fR or
+\fBTk_MainLoop\fR).
+.PP
+\fIProc\fR should have arguments and result that match the
+type \fBTk_GenericProc\fR:
+.CS
+typedef int Tk_GenericProc(
+ ClientData \fIclientData\fR,
+ XEvent *\fIeventPtr\fR);
+.CE
+The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR
+argument given to \fBTk_CreateGenericHandler\fR when the callback
+was created. Typically, \fIclientData\fR points to a data
+structure containing application-specific information about
+how to handle events.
+\fIEventPtr\fR is a pointer to the X event.
+.PP
+Whenever an X event is processed by \fBTk_HandleEvent\fR, \fIproc\fR
+is called. The return value from \fIproc\fR is normally 0.
+A non-zero return value indicates that the event is not to be handled
+further; that is, \fIproc\fR has done all processing that is to be
+allowed for the event.
+.PP
+If there are multiple generic event handlers, each one is called
+for each event, in the order in which they were established.
+.PP
+\fBTk_DeleteGenericHandler\fR may be called to delete a
+previously-created generic event handler: it deletes each handler
+it finds that matches the \fIproc\fR and \fIclientData\fR arguments. If
+no such handler exists, then \fBTk_DeleteGenericHandler\fR returns
+without doing anything. Although Tk supports it, it's probably
+a bad idea to have more than one callback with the same
+\fIproc\fR and \fIclientData\fR arguments.
+.PP
+Establishing a generic event handler does nothing to ensure that the
+process will actually receive the X events that the handler wants to
+process.
+For example, it is the caller's responsibility to invoke
+\fBXSelectInput\fR to select the desired events, if that is necessary.
+.SH KEYWORDS
+bind, callback, event, handler
diff --git a/tk/doc/CrtImgType.3 b/tk/doc/CrtImgType.3
new file mode 100644
index 00000000000..7b9063da200
--- /dev/null
+++ b/tk/doc/CrtImgType.3
@@ -0,0 +1,255 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_CreateImageType\fR(\fItypePtr\fR)
+ClientData
+.sp
+.VS
+\fBTk_GetImageMasterData\fR(\fIinterp, name, typePtrPtr\fR)
+.SH ARGUMENTS
+.AS Tk_ImageType *typePtrPtr
+.AP Tk_ImageType *typePtr in
+Structure that defines the new type of image.
+Must be static: a
+pointer to this structure is retained by the image code.
+.AP Tcl_Interp *interp in
+Interpreter in which image was created.
+.AP char *name in
+Name of existing image.
+.AP Tk_ImageType **typePtrPtr out
+Points to word in which to store a pointer to type information for
+the given image, if it exists.
+.VE
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_CreateImageType\fR is invoked to define a new kind of image.
+An image type corresponds to a particular value of the \fItype\fR
+argument for the \fBimage create\fR command. There may exist
+any number of different image types, and new types may be defined
+dynamically by calling \fBTk_CreateImageType\fR.
+For example, there might be one type for 2-color bitmaps,
+another for multi-color images, another for dithered images,
+another for video, and so on.
+.PP
+The code that implements a new image type is called an
+\fIimage manager\fR.
+It consists of a collection of procedures plus three different
+kinds of data structures.
+The first data structure is a Tk_ImageType structure, which contains
+the name of the image type and pointers to five procedures provided
+by the image manager to deal with images of this type:
+.CS
+typedef struct Tk_ImageType {
+ char *\fIname\fR;
+ Tk_ImageCreateProc *\fIcreateProc\fR;
+ Tk_ImageGetProc *\fIgetProc\fR;
+ Tk_ImageDisplayProc *\fIdisplayProc\fR;
+ Tk_ImageFreeProc *\fIfreeProc\fR;
+ Tk_ImageDeleteProc *\fIdeleteProc\fR;
+} Tk_ImageType;
+.CE
+The fields of this structure will be described in later subsections
+of this entry.
+.PP
+The second major data structure manipulated by an image manager
+is called an \fIimage master\fR; it contains overall information
+about a particular image, such as the values of the configuration
+options specified in an \fBimage create\fR command.
+There will usually be one of these structures for each
+invocation of the \fBimage create\fR command.
+.PP
+The third data structure related to images is an \fIimage instance\fR.
+There will usually be one of these structures for each usage of an
+image in a particular widget.
+It is possible for a single image to appear simultaneously
+in multiple widgets, or even multiple times in the same widget.
+Furthermore, different instances may be on different screens
+or displays.
+The image instance data structure describes things that may
+vary from instance to instance, such as colors and graphics
+contexts for redisplay.
+There is usually one instance structure for each \fB\-image\fR
+option specified for a widget or canvas item.
+.PP
+The following subsections describe the fields of a Tk_ImageType
+in more detail.
+
+.SH NAME
+.PP
+\fItypePtr->name\fR provides a name for the image type.
+Once \fBTk_CreateImageType\fR returns, this name may be used
+in \fBimage create\fR commands to create images of the new
+type.
+If there already existed an image type by this name then
+the new image type replaces the old one.
+
+.SH CREATEPROC
+\fItypePtr->createProc\fR provides the address of a procedure for
+Tk to call whenever \fBimage create\fR is invoked to create
+an image of the new type.
+\fItypePtr->createProc\fR must match the following prototype:
+.CS
+typedef int Tk_ImageCreateProc(
+ Tcl_Interp *\fIinterp\fR,
+ char *\fIname\fR,
+ int \fIargc\fR,
+ char **\fIargv\fR,
+ Tk_ImageType *\fItypePtr\fR,
+ Tk_ImageMaster \fImaster\fR,
+ ClientData *\fImasterDataPtr\fR);
+.CE
+The \fIinterp\fR argument is the interpreter in which the \fBimage\fR
+command was invoked, and \fIname\fR is the name for the new image,
+which was either specified explicitly in the \fBimage\fR command
+or generated automatically by the \fBimage\fR command.
+The \fIargc\fR and \fIargv\fR arguments describe all the configuration
+options for the new image (everything after the name argument to
+\fBimage\fR).
+The \fImaster\fR argument is a token that refers to Tk's information
+about this image; the image manager must return this token to
+Tk when invoking the \fBTk_ImageChanged\fR procedure.
+Typically \fIcreateProc\fR will parse \fIargc\fR and \fIargv\fR
+and create an image master data structure for the new image.
+\fIcreateProc\fR may store an arbitrary one-word value at
+*\fImasterDataPtr\fR, which will be passed back to the
+image manager when other callbacks are invoked.
+Typically the value is a pointer to the master data
+structure for the image.
+.PP
+If \fIcreateProc\fR encounters an error, it should leave an error
+message in \fIinterp->result\fR and return \fBTCL_ERROR\fR; otherwise
+it should return \fBTCL_OK\fR.
+.PP
+\fIcreateProc\fR should call \fBTk_ImageChanged\fR in order to set the
+size of the image and request an initial redisplay.
+
+.SH GETPROC
+.PP
+\fItypePtr->getProc\fR is invoked by Tk whenever a widget
+calls \fBTk_GetImage\fR to use a particular image.
+This procedure must match the following prototype:
+.CS
+typedef ClientData Tk_ImageGetProc(
+ Tk_Window \fItkwin\fR,
+ ClientData \fImasterData\fR);
+.CE
+The \fItkwin\fR argument identifies the window in which the
+image will be used and \fImasterData\fR is the value
+returned by \fIcreateProc\fR when the image master was created.
+\fIgetProc\fR will usually create a data structure for the new
+instance, including such things as the resources needed to
+display the image in the given window.
+\fIgetProc\fR returns a one-word token for the instance, which
+is typically the address of the instance data structure.
+Tk will pass this value back to the image manager when invoking
+its \fIdisplayProc\fR and \fIfreeProc\fR procedures.
+
+.SH DISPLAYPROC
+.PP
+\fItypePtr->displayProc\fR is invoked by Tk whenever an image needs
+to be displayed (i.e., whenever a widget calls \fBTk_RedrawImage\fR).
+\fIdisplayProc\fR must match the following prototype:
+.CS
+typedef void Tk_ImageDisplayProc(
+ ClientData \fIinstanceData\fR,
+ Display *\fIdisplay\fR,
+ Drawable \fIdrawable\fR,
+ int \fIimageX\fR,
+ int \fIimageY\fR,
+ int \fIwidth\fR,
+ int \fIheight\fR,
+ int \fIdrawableX\fR,
+ int \fIdrawableY\fR);
+.CE
+The \fIinstanceData\fR will be the same as the value returned by
+\fIgetProc\fR when the instance was created.
+\fIdisplay\fR and \fIdrawable\fR indicate where to display the
+image; \fIdrawable\fR may be a pixmap rather than
+the window specified to \fIgetProc\fR (this is usually the case,
+since most widgets double-buffer their redisplay to get smoother
+visual effects).
+\fIimageX\fR, \fIimageY\fR, \fIwidth\fR, and \fIheight\fR
+identify the region of the image that must be redisplayed.
+This region will always be within the size of the image
+as specified in the most recent call to \fBTk_ImageChanged\fR.
+\fIdrawableX\fR and \fIdrawableY\fR indicate where in \fIdrawable\fR
+the image should be displayed; \fIdisplayProc\fR should display
+the given region of the image so that point (\fIimageX\fR, \fIimageY\fR)
+in the image appears at (\fIdrawableX\fR, \fIdrawableY\fR) in \fIdrawable\fR.
+
+.SH FREEPROC
+.PP
+\fItypePtr->freeProc\fR contains the address of a procedure that
+Tk will invoke when an image instance is released (i.e., when
+\fBTk_FreeImage\fR is invoked).
+This can happen, for example, when a widget is deleted or a image item
+in a canvas is deleted, or when the image displayed in a widget or
+canvas item is changed.
+\fIfreeProc\fR must match the following prototype:
+.CS
+typedef void Tk_ImageFreeProc(
+ ClientData \fIinstanceData\fR,
+ Display *\fIdisplay\fR);
+.CE
+The \fIinstanceData\fR will be the same as the value returned by
+\fIgetProc\fR when the instance was created, and \fIdisplay\fR
+is the display containing the window for the instance.
+\fIfreeProc\fR should release any resources associated with the
+image instance, since the instance will never be used again.
+
+.SH DELETEPROC
+.PP
+\fItypePtr->deleteProc\fR is a procedure that Tk invokes when an
+image is being deleted (i.e. when the \fBimage delete\fR command
+is invoked).
+Before invoking \fIdeleteProc\fR Tk will invoke \fIfreeProc\fR for
+each of the image's instances.
+\fIdeleteProc\fR must match the following prototype:
+.CS
+typedef void Tk_ImageDeleteProc(
+ ClientData \fImasterData\fR);
+.CE
+The \fImasterData\fR argument will be the same as the value
+stored in \fI*masterDataPtr\fR by \fIcreateProc\fR when the
+image was created.
+\fIdeleteProc\fR should release any resources associated with
+the image.
+
+.SH TK_GETIMAGEMASTERDATA
+.VS
+.PP
+The procedure \fBTk_GetImageMasterData\fR may be invoked to retrieve
+information about an image. For example, an image manager can use this
+procedure to locate its image master data for an image.
+If there exists an image named \fIname\fR
+in the interpreter given by \fIinterp\fR, then \fI*typePtrPtr\fR is
+filled in with type information for the image (the \fItypePtr\fR value
+passed to \fBTk_CreateImageType\fR when the image type was registered)
+and the return value is the ClientData value returned by the
+\fIcreateProc\fR when the image was created (this is typically a
+pointer to the image master data structure). If no such image exists
+then NULL is returned and NULL is stored at \fI*typePtrPtr\fR.
+.VE
+
+.SH "SEE ALSO"
+Tk_ImageChanged, Tk_GetImage, Tk_FreeImage, Tk_RedrawImage, Tk_SizeOfImage
+
+.SH KEYWORDS
+image manager, image type, instance, master
diff --git a/tk/doc/CrtItemType.3 b/tk/doc/CrtItemType.3
new file mode 100644
index 00000000000..1dae46b55c9
--- /dev/null
+++ b/tk/doc/CrtItemType.3
@@ -0,0 +1,626 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_CreateItemType\fR(\fItypePtr\fR)
+.sp
+Tk_ItemType *
+\fBTk_GetItemTypes\fR()
+.SH ARGUMENTS
+.AS Tk_ItemType *typePtr
+.AP Tk_ItemType *typePtr in
+Structure that defines the new type of canvas item.
+.BE
+
+.SH INTRODUCTION
+.PP
+\fBTk_CreateItemType\fR is invoked to define a new kind of canvas item
+described by the \fItypePtr\fR argument.
+An item type corresponds to a particular value of the \fItype\fR
+argument to the \fBcreate\fR widget command for canvases, and
+the code that implements a canvas item type is called a \fItype manager\fR.
+Tk defines several built-in item types, such as \fBrectangle\fR
+and \fBtext\fR and \fBimage\fR, but \fBTk_CreateItemType\fR
+allows additional item types to be defined.
+Once \fBTk_CreateItemType\fR returns, the new item type may be used
+in new or existing canvas widgets just like the built-in item
+types.
+.PP
+\fBTk_GetItemTypes\fR returns a pointer to the first in the list
+of all item types currently defined for canvases.
+The entries in the list are linked together through their
+\fInextPtr\fR fields, with the end of the list marked by a
+NULL \fInextPtr\fR.
+.PP
+You may find it easier to understand the rest of this manual entry
+by looking at the code for an existing canvas item type such as
+bitmap (file tkCanvBmap.c) or text (tkCanvText.c).
+The easiest way to create a new type manager is to copy the code
+for an existing type and modify it for the new type.
+.PP
+Tk provides a number of utility procedures for the use of canvas
+type managers, such as \fBTk_CanvasCoords\fR and \fBTk_CanvasPsColor\fR;
+these are described in separate manual entries.
+
+.SH "DATA STRUCTURES"
+.PP
+A type manager consists of a collection of procedures that provide a
+standard set of operations on items of that type.
+The type manager deals with three kinds of data
+structures.
+The first data structure is a Tk_ItemType; it contains
+information such as the name of the type and pointers to
+the standard procedures implemented by the type manager:
+.CS
+typedef struct Tk_ItemType {
+ char *\fIname\fR;
+ int \fIitemSize\fR;
+ Tk_ItemCreateProc *\fIcreateProc\fR;
+ Tk_ConfigSpec *\fIconfigSpecs\fR;
+ Tk_ItemConfigureProc *\fIconfigProc\fR;
+ Tk_ItemCoordProc *\fIcoordProc\fR;
+ Tk_ItemDeleteProc *\fIdeleteProc\fR;
+ Tk_ItemDisplayProc *\fIdisplayProc\fR;
+ int \fIalwaysRedraw\fR;
+ Tk_ItemPointProc *\fIpointProc\fR;
+ Tk_ItemAreaProc *\fIareaProc\fR;
+ Tk_ItemPostscriptProc *\fIpostscriptProc\fR;
+ Tk_ItemScaleProc *\fIscaleProc\fR;
+ Tk_ItemTranslateProc *\fItranslateProc\fR;
+ Tk_ItemIndexProc *\fIindexProc\fR;
+ Tk_ItemCursorProc *\fIicursorProc\fR;
+ Tk_ItemSelectionProc *\fIselectionProc\fR;
+ Tk_ItemInsertProc *\fIinsertProc\fR;
+ Tk_ItemDCharsProc *\fIdCharsProc\fR;
+ Tk_ItemType *\fInextPtr\fR;
+} Tk_ItemType;
+.CE
+.PP
+The fields of a Tk_ItemType structure are described in more detail
+later in this manual entry.
+When \fBTk_CreateItemType\fR is called, its \fItypePtr\fR
+argument must point to a structure with all of the fields initialized
+except \fInextPtr\fR, which Tk sets to link all the types together
+into a list.
+The structure must be in permanent memory (either statically
+allocated or dynamically allocated but never freed); Tk retains
+a pointer to this structure.
+.PP
+The second data structure manipulated by a type manager is an
+\fIitem record\fR.
+For each item in a canvas there exists one item record.
+All of the items of a given type generally have item records with
+the same structure, but different types usually have different
+formats for their item records.
+The first part of each item record is a header with a standard structure
+defined by Tk via the type Tk_Item; the rest of the item
+record is defined by the type manager.
+A type manager must define its item records with a Tk_Item as
+the first field.
+For example, the item record for bitmap items is defined as follows:
+.CS
+typedef struct BitmapItem {
+ Tk_Item \fIheader\fR;
+ double \fIx\fR, \fIy\fR;
+ Tk_Anchor \fIanchor\fR;
+ Pixmap \fIbitmap\fR;
+ XColor *\fIfgColor\fR;
+ XColor *\fIbgColor\fR;
+ GC \fIgc\fR;
+} BitmapItem;
+.CE
+The \fIheader\fR substructure contains information used by Tk
+to manage the item, such as its identifier, its tags, its type,
+and its bounding box.
+The fields starting with \fIx\fR belong to the type manager:
+Tk will never read or write them.
+The type manager should not need to read or write any of the
+fields in the header except for four fields
+whose names are \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR.
+These fields give a bounding box for the items using integer
+canvas coordinates: the item should not cover any pixels
+with x-coordinate lower than \fIx1\fR or y-coordinate
+lower than \fIy1\fR, nor should it cover any pixels with
+x-coordinate greater than or equal to \fIx2\fR or y-coordinate
+greater than or equal to \fIy2\fR.
+It is up to the type manager to keep the bounding box up to
+date as the item is moved and reconfigured.
+.PP
+Whenever Tk calls a procedure in a type manager it passes in a pointer
+to an item record.
+The argument is always passed as a pointer to a Tk_Item; the type
+manager will typically cast this into a pointer to its own specific
+type, such as BitmapItem.
+.PP
+The third data structure used by type managers has type
+Tk_Canvas; it serves as an opaque handle for the canvas widget
+as a whole.
+Type managers need not know anything about the contents of this
+structure.
+A Tk_Canvas handle is typically passed in to the
+procedures of a type manager, and the type manager can pass the
+handle back to library procedures such as Tk_CanvasTkwin
+to fetch information about the canvas.
+
+.SH NAME
+.PP
+This section and the ones that follow describe each of the fields
+in a Tk_ItemType structure in detail.
+The \fIname\fR field provides a string name for the item type.
+Once \fBTk_CreateImageType\fR returns, this name may be used
+in \fBcreate\fR widget commands to create items of the new
+type.
+If there already existed an item type by this name then
+the new item type replaces the old one.
+
+.SH ITEMSIZE
+\fItypePtr->itemSize\fR gives the size in bytes of item records
+of this type, including the Tk_Item header.
+Tk uses this size to allocate memory space for items of the type.
+All of the item records for a given type must have the same size.
+If variable length fields are needed for an item (such as a list
+of points for a polygon), the type manager can allocate a separate
+object of variable length and keep a pointer to it in the item record.
+
+.SH CREATEPROC
+.PP
+\fItypePtr->createProc\fR points to a procedure for
+Tk to call whenever a new item of this type is created.
+\fItypePtr->createProc\fR must match the following prototype:
+.CS
+typedef int Tk_ItemCreateProc(
+ Tcl_Interp *\fIinterp\fR,
+ Tk_Canvas \fIcanvas\fR,
+ Tk_Item *\fIitemPtr\fR,
+ int \fIargc\fR,
+ char **\fIargv\fR);
+.CE
+The \fIinterp\fR argument is the interpreter in which the canvas's
+\fBcreate\fR widget command was invoked, and \fIcanvas\fR is a
+handle for the canvas widget.
+\fIitemPtr\fR is a pointer to a newly-allocated item of
+size \fItypePtr->itemSize\fR.
+Tk has already initialized the item's header (the first
+\fBsizeof(Tk_ItemType)\fR bytes).
+The \fIargc\fR and \fIargv\fR arguments describe all of the
+arguments to the \fBcreate\fR command after the \fItype\fR
+argument.
+For example, in the widget command
+.CS
+\fB\&.c create rectangle 10 20 50 50 \-fill black\fR
+.CE
+\fIargc\fR will be \fB6\fR and \fIargv\fR[0] will contain the
+string \fB10\fR.
+.PP
+\fIcreateProc\fR should use \fIargc\fR and \fIargv\fR to initialize
+the type-specific parts of the item record and set an initial value
+for the bounding box in the item's header.
+It should return a standard Tcl completion code and leave an
+error message in \fIinterp->result\fR if an error occurs.
+If an error occurs Tk will free the item record, so \fIcreateProc\fR
+must be sure to leave the item record in a clean state if it returns an error
+(e.g., it must free any additional memory that it allocated for
+the item).
+
+.SH CONFIGSPECS
+.PP
+Each type manager must provide a standard table describing its
+configuration options, in a form suitable for use with
+\fBTk_ConfigureWidget\fR.
+This table will normally be used by \fItypePtr->createProc\fR
+and \fItypePtr->configProc\fR, but Tk also uses it directly
+to retrieve option information in the \fBitemcget\fR and
+\fBitemconfigure\fR widget commands.
+\fItypePtr->configSpecs\fR must point to the configuration table
+for this type.
+Note: Tk provides a custom option type \fBtk_CanvasTagsOption\fR
+for implementing the \fB\-tags\fR option; see an existing type
+manager for an example of how to use it in \fIconfigSpecs\fR.
+
+.SH CONFIGPROC
+.PP
+\fItypePtr->configProc\fR is called by Tk whenever the
+\fBitemconfigure\fR widget command is invoked to change the
+configuration options for a canvas item.
+This procedure must match the following prototype:
+.CS
+typedef int Tk_ItemConfigureProc(
+ Tcl_Interp *\fIinterp\fR,
+ Tk_Canvas \fIcanvas\fR,
+ Tk_Item *\fIitemPtr\fR,
+ int \fIargc\fR,
+ char **\fIargv\fR,
+ int \fIflags\fR);
+.CE
+The \fIinterp\fR argument identifies the interpreter in which the
+widget command was invoked, \fIcanvas\fR is a handle for the canvas
+widget, and \fIitemPtr\fR is a pointer to the item being configured.
+\fIargc\fR and \fIargv\fR contain the configuration options. For
+example, if the following command is invoked:
+.CS
+\fB\&.c itemconfigure 2 \-fill red \-outline black\fR
+.CE
+\fIargc\fR is \fB4\fR and \fIargv\fR contains the strings \fB\-fill\fR
+through \fBblack\fR.
+\fIargc\fR will always be an even value.
+The \fIflags\fR argument contains flags to pass to \fBTk_ConfigureWidget\fR;
+currently this value is always TK_CONFIG_ARGV_ONLY when Tk
+invokes \fItypePtr->configProc\fR, but the type manager's \fIcreateProc\fR
+procedure will usually invoke \fIconfigProc\fR with different flag values.
+.PP
+\fItypePtr->configProc\fR returns a standard Tcl completion code and
+leaves an error message in \fIinterp->result\fR if an error occurs.
+It must update the item's bounding box to reflect the new configuration
+options.
+
+.SH COORDPROC
+.PP
+\fItypePtr->coordProc\fR is invoked by Tk to implement the \fBcoords\fR
+widget command for an item.
+It must match the following prototype:
+.CS
+typedef int Tk_ItemCoordProc(
+ Tcl_Interp *\fIinterp\fR,
+ Tk_Canvas \fIcanvas\fR,
+ Tk_Item *\fIitemPtr\fR,
+ int \fIargc\fR,
+ char **\fIargv\fR);
+.CE
+The arguments \fIinterp\fR, \fIcanvas\fR, and \fIitemPtr\fR
+all have the standard meanings, and \fIargc\fR and \fIargv\fR
+describe the coordinate arguments.
+For example, if the following widget command is invoked:
+.CS
+\fB\&.c coords 2 30 90\fR
+.CE
+\fIargc\fR will be \fB2\fR and \fBargv\fR will contain the string values
+\fB30\fR and \fB90\fR.
+.PP
+The \fIcoordProc\fR procedure should process the new coordinates,
+update the item appropriately (e.g., it must reset the bounding
+box in the item's header), and return a standard Tcl completion
+code.
+If an error occurs, \fIcoordProc\fR must leave an error message in
+\fIinterp->result\fR.
+
+.SH DELETEPROC
+.PP
+\fItypePtr->deleteProc\fR is invoked by Tk to delete an item
+and free any resources allocated to it.
+It must match the following prototype:
+.CS
+typedef void Tk_ItemDeleteProc(
+ Tk_Canvas \fIcanvas\fR,
+ Tk_Item *\fIitemPtr\fR,
+ Display *\fIdisplay\fR);
+.CE
+The \fIcanvas\fR and \fIitemPtr\fR arguments have the usual
+interpretations, and \fIdisplay\fR identifies the X display containing
+the canvas.
+\fIdeleteProc\fR must free up any resources allocated for the item,
+so that Tk can free the item record.
+\fIdeleteProc\fR should not actually free the item record; this will
+be done by Tk when \fIdeleteProc\fR returns.
+
+.SH "DISPLAYPROC AND ALWAYSREDRAW"
+.PP
+\fItypePtr->displayProc\fR is invoked by Tk to redraw an item
+on the screen.
+It must match the following prototype:
+.CS
+typedef void Tk_ItemDisplayProc(
+ Tk_Canvas \fIcanvas\fR,
+ Tk_Item *\fIitemPtr\fR,
+ Display *\fIdisplay\fR,
+ Drawable \fIdst\fR,
+ int \fIx\fR,
+ int \fIy\fR,
+ int \fIwidth\fR,
+ int \fIheight\fR);
+.CE
+The \fIcanvas\fR and \fIitemPtr\fR arguments have the usual meaning.
+\fIdisplay\fR identifies the display containing the canvas, and
+\fIdst\fR specifies a drawable in which the item should be rendered;
+typically this is an off-screen pixmap, which Tk will copy into
+the canvas's window once all relevant items have been drawn.
+\fIx\fR, \fIy\fR, \fIwidth\fR, and \fIheight\fR specify a rectangular
+region in canvas coordinates, which is the area to be redrawn;
+only information that overlaps this area needs to be redrawn.
+Tk will not call \fIdisplayProc\fR unless the item's bounding box
+overlaps the redraw area, but the type manager may wish to use
+the redraw area to optimize the redisplay of the item.
+.PP
+Because of scrolling and the use of off-screen pixmaps for
+double-buffered redisplay, the item's coordinates in \fIdst\fR
+will not necessarily be the same as those in the canvas.
+\fIdisplayProc\fR should call \fBTk_CanvasDrawableCoords\fR
+to transform coordinates from those of the canvas to those
+of \fIdst\fR.
+.PP
+Normally an item's \fIdisplayProc\fR is only invoked if the item
+overlaps the area being displayed.
+However, if \fItypePtr->alwaysRedraw\fR has a non-zero value, then
+\fIdisplayProc\fR is invoked during every redisplay operation,
+even if the item doesn't overlap the area of redisplay.
+\fIalwaysRedraw\fR should normally be set to 0; it is only
+set to 1 in special cases such as window items that need to be
+unmapped when they are off-screen.
+
+.SH POINTPROC
+.PP
+\fItypePtr->pointProc\fR is invoked by Tk to find out how close
+a given point is to a canvas item.
+Tk uses this procedure for purposes such as locating the item
+under the mouse or finding the closest item to a given point.
+The procedure must match the following prototype:
+.CS
+typedef double Tk_ItemPointProc(
+ Tk_Canvas \fIcanvas\fR,
+ Tk_Item *\fIitemPtr\fR,
+ double *\fIpointPtr\fR);
+.CE
+\fIcanvas\fR and \fIitemPtr\fR have the usual meaning.
+\fIpointPtr\fR points to an array of two numbers giving
+the x and y coordinates of a point.
+\fIpointProc\fR must return a real value giving the distance
+from the point to the item, or 0 if the point lies inside
+the item.
+
+.SH AREAPROC
+.PP
+\fItypePtr->areaProc\fR is invoked by Tk to find out the relationship
+between an item and a rectangular area.
+It must match the following prototype:
+.CS
+typedef int Tk_ItemAreaProc(
+ Tk_Canvas \fIcanvas\fR,
+ Tk_Item *\fIitemPtr\fR,
+ double *\fIrectPtr\fR);
+.CE
+\fIcanvas\fR and \fIitemPtr\fR have the usual meaning.
+\fIrectPtr\fR points to an array of four real numbers;
+the first two give the x and y coordinates of the upper left
+corner of a rectangle, and the second two give the x and y
+coordinates of the lower right corner.
+\fIareaProc\fR must return \-1 if the item lies entirely outside
+the given area, 0 if it lies partially inside and partially
+outside the area, and 1 if it lies entirely inside the area.
+
+.SH POSTSCRIPTPROC
+.PP
+\fItypePtr->postscriptProc\fR is invoked by Tk to generate
+Postcript for an item during the \fBpostscript\fR widget command.
+If the type manager is not capable of generating Postscript then
+\fItypePtr->postscriptProc\fR should be NULL.
+The procedure must match the following prototype:
+.CS
+typedef int Tk_ItemPostscriptProc(
+ Tcl_Interp *\fIinterp\fR,
+ Tk_Canvas \fIcanvas\fR,
+ Tk_Item *\fIitemPtr\fR,
+ int \fIprepass\fR);
+.CE
+The \fIinterp\fR, \fIcanvas\fR, and \fIitemPtr\fR arguments all have
+standard meanings; \fIprepass\fR will be described below.
+If \fIpostscriptProc\fR completes successfully, it should append
+Postscript for the item to the information in \fIinterp->result\fR
+(e.g. by calling \fBTcl_AppendResult\fR, not \fBTcl_SetResult\fR)
+and return TCL_OK.
+If an error occurs, \fIpostscriptProc\fR should clear the result
+and replace its contents with an error message; then it should
+return TCL_ERROR.
+.PP
+Tk provides a collection of utility procedures to simplify
+\fIpostscriptProc\fR.
+For example, \fBTk_CanvasPsColor\fR will generate Postscript to set
+the current color to a given Tk color and \fBTk_CanvasPsFont\fR will
+set up font information.
+When generating Postscript, the type manager is free to change the
+graphics state of the Postscript interpreter, since Tk places
+\fBgsave\fR and \fBgrestore\fR commands around the Postscript for
+the item.
+The type manager can use canvas x coordinates directly in its Postscript,
+but it must call \fBTk_CanvasPsY\fR to convert y coordinates from
+the space of the canvas (where the origin is at the
+upper left) to the space of Postscript (where the origin is at the
+lower left).
+.PP
+In order to generate Postscript that complies with the Adobe Document
+Structuring Conventions, Tk actually generates Postscript in two passes.
+It calls each item's \fIpostscriptProc\fR in each pass.
+The only purpose of the first pass is to collect font information
+(which is done by \fBTk_CanvPsFont\fR); the actual Postscript is
+discarded.
+Tk sets the \fIprepass\fR argument to \fIpostscriptProc\fR to 1
+during the first pass; the type manager can use \fIprepass\fR to skip
+all Postscript generation except for calls to \fBTk_CanvasPsFont\fR.
+During the second pass \fIprepass\fR will be 0, so the type manager
+must generate complete Postscript.
+
+.SH SCALEPROC
+\fItypePtr->scaleProc\fR is invoked by Tk to rescale a canvas item
+during the \fBscale\fR widget command.
+The procedure must match the following prototype:
+.CS
+typedef void Tk_ItemScaleProc(
+ Tk_Canvas \fIcanvas\fR,
+ Tk_Item *\fIitemPtr\fR,
+ double \fIoriginX\fR,
+ double \fIoriginY\fR,
+ double \fIscaleX\fR,
+ double \fIscaleY\fR);
+.CE
+The \fIcanvas\fR and \fIitemPtr\fR arguments have the usual meaning.
+\fIoriginX\fR and \fIoriginY\fR specify an origin relative to which
+the item is to be scaled, and \fIscaleX\fR and \fIscaleY\fR give the
+x and y scale factors.
+The item should adjust its coordinates so that a point in the item
+that used to have coordinates \fIx\fR and \fIy\fR will have new
+coordinates \fIx'\fR and \fIy'\fR, where
+.CS
+\fIx' = originX + scaleX*(x-originX)
+y' = originY + scaleY*(y-originY)\fR
+.CE
+\fIscaleProc\fR must also update the bounding box in the item's
+header.
+
+.SH TRANSLATEPROC
+\fItypePtr->translateProc\fR is invoked by Tk to translate a canvas item
+during the \fBmove\fR widget command.
+The procedure must match the following prototype:
+.CS
+typedef void Tk_ItemTranslateProc(
+ Tk_Canvas \fIcanvas\fR,
+ Tk_Item *\fIitemPtr\fR,
+ double \fIdeltaX\fR,
+ double \fIdeltaY\fR);
+.CE
+The \fIcanvas\fR and \fIitemPtr\fR arguments have the usual meaning,
+and \fIdeltaX\fR and \fIdeltaY\fR give the amounts that should be
+added to each x and y coordinate within the item.
+The type manager should adjust the item's coordinates and
+update the bounding box in the item's header.
+
+.SH INDEXPROC
+\fItypePtr->indexProc\fR is invoked by Tk to translate a string
+index specification into a numerical index, for example during the
+\fBindex\fR widget command.
+It is only relevant for item types that support indexable text;
+\fItypePtr->indexProc\fR may be specified as NULL for non-textual
+item types.
+The procedure must match the following prototype:
+.CS
+typedef int Tk_ItemIndexProc(
+ Tcl_Interp *\fIinterp\fR,
+ Tk_Canvas \fIcanvas\fR,
+ Tk_Item *\fIitemPtr\fR,
+ char \fIindexString\fR,
+ int *\fIindexPtr\fR);
+.CE
+The \fIinterp\fR, \fIcanvas\fR, and \fIitemPtr\fR arguments all
+have the usual meaning.
+\fIindexString\fR contains a textual description of an index,
+and \fIindexPtr\fR points to an integer value that should be
+filled in with a numerical index.
+It is up to the type manager to decide what forms of index
+are supported (e.g., numbers, \fBinsert\fR, \fBsel.first\fR,
+\fBend\fR, etc.).
+\fIindexProc\fR should return a Tcl completion code and set
+\fIinterp->result\fR in the event of an error.
+
+.SH ICURSORPROC
+.PP
+\fItypePtr->icursorProc\fR is invoked by Tk during
+the \fBicursor\fR widget command to set the position of the
+insertion cursor in a textual item.
+It is only relevant for item types that support an insertion cursor;
+\fItypePtr->icursorProc\fR may be specified as NULL for item types
+that don't support an insertion cursor.
+The procedure must match the following prototype:
+.CS
+typedef void Tk_ItemIndexProc(
+ Tk_Canvas \fIcanvas\fR,
+ Tk_Item *\fIitemPtr\fR,
+ int \fIindex\fR);
+.CE
+\fIcanvas\fR and \fIitemPtr\fR have the usual meanings, and
+\fIindex\fR is an index into the item's text, as returned by a
+previous call to \fItypePtr->insertProc\fR.
+The type manager should position the insertion cursor in the
+item just before the character given by \fIindex\fR.
+Whether or not to actually display the insertion cursor is
+determined by other information provided by \fBTk_CanvasGetTextInfo\fR.
+
+.SH SELECTIONPROC
+.PP
+\fItypePtr->selectionProc\fR is invoked by Tk during selection
+retrievals; it must return part or all of the selected text in
+the item (if any).
+It is only relevant for item types that support text;
+\fItypePtr->selectionProc\fR may be specified as NULL for non-textual
+item types.
+The procedure must match the following prototype:
+.CS
+typedef int Tk_ItemSelectionProc(
+ Tk_Canvas \fIcanvas\fR,
+ Tk_Item *\fIitemPtr\fR,
+ int \fIoffset\fR,
+ char *\fIbuffer\fR,
+ int \fImaxBytes\fR);
+.CE
+\fIcanvas\fR and \fIitemPtr\fR have the usual meanings.
+\fIoffset\fR is an offset in bytes into the selection where 0 refers
+to the first byte of the selection; it identifies
+the first character that is to be returned in this call.
+\fIbuffer\fR points to an area of memory in which to store the
+requested bytes, and \fImaxBytes\fR specifies the maximum number
+of bytes to return.
+\fIselectionProc\fR should extract up to \fImaxBytes\fR characters
+from the selection and copy them to \fImaxBytes\fR; it should
+return a count of the number of bytes actually copied, which may
+be less than \fImaxBytes\fR if there aren't \fIoffset+maxBytes\fR bytes
+in the selection.
+
+.SH INSERTPROC
+.PP
+\fItypePtr->insertProc\fR is invoked by Tk during
+the \fBinsert\fR widget command to insert new text into a
+canvas item.
+It is only relevant for item types that support text;
+\fItypePtr->insertProc\fR may be specified as NULL for non-textual
+item types.
+The procedure must match the following prototype:
+.CS
+typedef void Tk_ItemInsertProc(
+ Tk_Canvas \fIcanvas\fR,
+ Tk_Item *\fIitemPtr\fR,
+ int \fIindex\fR,
+ char *\fIstring\fR);
+.CE
+\fIcanvas\fR and \fIitemPtr\fR have the usual meanings.
+\fIindex\fR is an index into the item's text, as returned by a
+previous call to \fItypePtr->insertProc\fR, and \fIstring\fR
+contains new text to insert just before the character given
+by \fIindex\fR.
+The type manager should insert the text and recompute the bounding
+box in the item's header.
+
+.SH DCHARSPROC
+.PP
+\fItypePtr->dCharsProc\fR is invoked by Tk during the \fBdchars\fR
+widget command to delete a range of text from a canvas item.
+It is only relevant for item types that support text;
+\fItypePtr->dCharsProc\fR may be specified as NULL for non-textual
+item types.
+The procedure must match the following prototype:
+.CS
+typedef void Tk_ItemDCharsProc(
+ Tk_Canvas \fIcanvas\fR,
+ Tk_Item *\fIitemPtr\fR,
+ int \fIfirst\fR,
+ int \fIlast\fR);
+.CE
+\fIcanvas\fR and \fIitemPtr\fR have the usual meanings.
+\fIfirst\fR and \fIlast\fR give the indices of the first and last bytes
+to be deleted, as returned by previous calls to \fItypePtr->indexProc\fR.
+The type manager should delete the specified characters and update
+the bounding box in the item's header.
+
+.SH "SEE ALSO"
+Tk_CanvasPsY, Tk_CanvasTextInfo, Tk_CanvasTkwin
+
+.SH KEYWORDS
+canvas, focus, item type, selection, type manager
diff --git a/tk/doc/CrtPhImgFmt.3 b/tk/doc/CrtPhImgFmt.3
new file mode 100644
index 00000000000..7167d47ef51
--- /dev/null
+++ b/tk/doc/CrtPhImgFmt.3
@@ -0,0 +1,235 @@
+'\"
+'\" 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 (paulus@cs.anu.edu.au),
+'\" Department of Computer Science,
+'\" Australian National University.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+\fB#include <tkPhoto.h>\fR
+.sp
+\fBTk_CreatePhotoImageFormat\fR(\fIformatPtr\fR)
+.SH ARGUMENTS
+.AS Tk_PhotoImageFormat *formatPtr
+.AP Tk_PhotoImageFormat *formatPtr in
+Structure that defines the new file format.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_CreatePhotoImageFormat\fR is invoked to define a new file format
+for image data for use with photo images. The code that implements an
+image file format is called an image file format handler, or
+handler for short. The photo image code
+maintains a list of handlers that can be used to read and
+write data to or from a file. Some handlers may also
+support reading image data from a string or converting image data to a
+string format.
+The user can specify which handler to use with the \fB\-format\fR
+image configuration option or the \fB\-format\fR option to the
+\fBread\fR and \fBwrite\fR photo image subcommands.
+.PP
+An image file format handler consists of a collection of procedures
+plus a Tk_PhotoImageFormat structure, which contains the name of the
+image file format and pointers to six procedures provided by the
+handler to deal with files and strings in this format. The
+Tk_PhotoImageFormat structure contains the following fields:
+.CS
+typedef struct Tk_PhotoImageFormat {
+ char *\fIname\fR;
+ Tk_ImageFileMatchProc *\fIfileMatchProc\fR;
+ Tk_ImageStringMatchProc *\fIstringMatchProc\fR;
+ Tk_ImageFileReadProc *\fIfileReadProc\fR;
+ Tk_ImageStringReadProc *\fIstringReadProc\fR;
+ Tk_ImageFileWriteProc *\fIfileWriteProc\fR;
+ Tk_ImageStringWriteProc *\fIstringWriteProc\fR;
+} Tk_PhotoImageFormat;
+.CE
+.PP
+The handler need not provide implementations of all six procedures.
+For example, the procedures that handle string data would not be
+provided for a format in which the image data are stored in binary,
+and could therefore contain null characters. If any procedure is not
+implemented, the corresponding pointer in the Tk_PhotoImageFormat
+structure should be set to NULL. The handler must provide the
+\fIfileMatchProc\fR procedure if it provides the \fIfileReadProc\fR
+procedure, and the \fIstringMatchProc\fR procedure if it provides the
+\fIstringReadProc\fR procedure.
+
+.SH NAME
+.PP
+\fIformatPtr->name\fR provides a name for the image type.
+Once \fBTk_CreatePhotoImageFormat\fR returns, this name may be used
+in the \fB\-format\fR photo image configuration and subcommand option.
+The manual page for the photo image (photo(n)) describes how image
+file formats are chosen based on their names and the value given to
+the \fB\-format\fR option.
+
+.SH FILEMATCHPROC
+\fIformatPtr->fileMatchProc\fR provides the address of a procedure for
+Tk to call when it is searching for an image file format handler
+suitable for reading data in a given file.
+\fIformatPtr->fileMatchProc\fR must match the following prototype:
+.CS
+typedef int Tk_ImageFileMatchProc(
+ Tcl_Channel \fIchan\fR,
+ char *\fIfileName\fR,
+ char *\fIformatString\fR,
+ int *\fIwidthPtr\fR,
+ int *\fIheightPtr\fR);
+.CE
+The \fIfileName\fR argument is the name of the file containing the
+image data, which is open for reading as \fIchan\fR. The
+\fIformatString\fR argument contains the value given for the
+\fB\-format\fR option, or NULL if the option was not specified.
+If the data in the file appears to be in the format supported by this
+handler, the \fIformatPtr->fileMatchProc\fR procedure should store the
+width and height of the image in *\fIwidthPtr\fR and *\fIheightPtr\fR
+respectively, and return 1. Otherwise it should return 0.
+
+.SH STRINGMATCHPROC
+\fIformatPtr->stringMatchProc\fR provides the address of a procedure for
+Tk to call when it is searching for an image file format handler for
+suitable for reading data from a given string.
+\fIformatPtr->stringMatchProc\fR must match the following prototype:
+.CS
+typedef int Tk_ImageStringMatchProc(
+ char *\fIstring\fR,
+ char *\fIformatString\fR,
+ int *\fIwidthPtr\fR,
+ int *\fIheightPtr\fR);
+.CE
+The \fIstring\fR argument points to the string containing the image
+data. The \fIformatString\fR argument contains the value given for
+the \fB\-format\fR option, or NULL if the option was not specified.
+If the data in the string appears to be in the format supported by
+this handler, the \fIformatPtr->stringMatchProc\fR procedure should
+store the width and height of the image in *\fIwidthPtr\fR and
+*\fIheightPtr\fR respectively, and return 1. Otherwise it should
+return 0.
+
+.SH FILEREADPROC
+\fIformatPtr->fileReadProc\fR provides the address of a procedure for
+Tk to call to read data from an image file into a photo image.
+\fIformatPtr->fileReadProc\fR must match the following prototype:
+.CS
+typedef int Tk_ImageFileReadProc(
+ Tcl_Interp *\fIinterp\fR,
+ Tcl_Channel \fIchan\fR,
+ char *\fIfileName\fR,
+ char *\fIformatString\fR,
+ PhotoHandle \fIimageHandle\fR,
+ int \fIdestX\fR, int \fIdestY\fR,
+ int \fIwidth\fR, int \fIheight\fR,
+ int \fIsrcX\fR, int \fIsrcY\fR);
+.CE
+The \fIinterp\fR argument is the interpreter in which the command was
+invoked to read the image; it should be used for reporting errors.
+The image data is in the file named \fIfileName\fR, which is open for
+reading as \fIchan\fR. The \fIformatString\fR argument contains the
+value given for the \fB\-format\fR option, or NULL if the option was
+not specified. The image data in the file, or a subimage of it, is to
+be read into the photo image identified by the handle
+\fIimageHandle\fR. The subimage of the data in the file is of
+dimensions \fIwidth\fR x \fIheight\fR and has its top-left corner at
+coordinates (\fIsrcX\fR,\fIsrcY\fR). It is to be stored in the photo
+image with its top-left corner at coordinates
+(\fIdestX\fR,\fIdestY\fR) using the \fBTk_PhotoPutBlock\fR procedure.
+The return value is a standard Tcl return value.
+
+.SH STRINGREADPROC
+\fIformatPtr->stringReadProc\fR provides the address of a procedure for
+Tk to call to read data from a string into a photo image.
+\fIformatPtr->stringReadProc\fR must match the following prototype:
+.CS
+typedef int Tk_ImageStringReadProc(
+ Tcl_Interp *\fIinterp\fR,
+ char *\fIstring\fR,
+ char *\fIformatString\fR,
+ PhotoHandle \fIimageHandle\fR,
+ int \fIdestX\fR, int \fIdestY\fR,
+ int \fIwidth\fR, int \fIheight\fR,
+ int \fIsrcX\fR, int \fIsrcY\fR);
+.CE
+The \fIinterp\fR argument is the interpreter in which the command was
+invoked to read the image; it should be used for reporting errors.
+The \fIstring\fR argument points to the image data in string form.
+The \fIformatString\fR argument contains the
+value given for the \fB\-format\fR option, or NULL if the option was
+not specified. The image data in the string, or a subimage of it, is to
+be read into the photo image identified by the handle
+\fIimageHandle\fR. The subimage of the data in the string is of
+dimensions \fIwidth\fR x \fIheight\fR and has its top-left corner at
+coordinates (\fIsrcX\fR,\fIsrcY\fR). It is to be stored in the photo
+image with its top-left corner at coordinates
+(\fIdestX\fR,\fIdestY\fR) using the \fBTk_PhotoPutBlock\fR procedure.
+The return value is a standard Tcl return value.
+
+.SH FILEWRITEPROC
+\fIformatPtr->fileWriteProc\fR provides the address of a procedure for
+Tk to call to write data from a photo image to a file.
+\fIformatPtr->fileWriteProc\fR must match the following prototype:
+.CS
+typedef int Tk_ImageFileWriteProc(
+ Tcl_Interp *\fIinterp\fR,
+ char *\fIfileName\fR,
+ char *\fIformatString\fR,
+ Tk_PhotoImageBlock *\fIblockPtr\fR);
+.CE
+The \fIinterp\fR argument is the interpreter in which the command was
+invoked to write the image; it should be used for reporting errors.
+The image data to be written are in memory and are described by the
+Tk_PhotoImageBlock structure pointed to by \fIblockPtr\fR; see the
+manual page FindPhoto(3) for details. The \fIfileName\fR argument
+points to the string giving the name of the file in which to write the
+image data. The \fIformatString\fR argument contains the
+value given for the \fB\-format\fR option, or NULL if the option was
+not specified. The format string can contain extra characters
+after the name of the format. If appropriate, the
+\fIformatPtr->fileWriteProc\fR procedure may interpret these
+characters to specify further details about the image file.
+The return value is a standard Tcl return value.
+
+.SH STRINGWRITEPROC
+\fIformatPtr->stringWriteProc\fR provides the address of a procedure for
+Tk to call to translate image data from a photo image into a string.
+\fIformatPtr->stringWriteProc\fR must match the following prototype:
+.CS
+typedef int Tk_ImageStringWriteProc(
+ Tcl_Interp *\fIinterp\fR,
+ Tcl_DString *\fIdataPtr\fR,
+ char *\fIformatString\fR,
+ Tk_PhotoImageBlock *\fIblockPtr\fR);
+.CE
+The \fIinterp\fR argument is the interpreter in which the command was
+invoked to convert the image; it should be used for reporting errors.
+The image data to be converted are in memory and are described by the
+Tk_PhotoImageBlock structure pointed to by \fIblockPtr\fR; see the
+manual page FindPhoto(3) for details. The data for the string
+should be appended to the dynamic string given by \fIdataPtr\fR.
+The \fIformatString\fR argument contains the
+value given for the \fB\-format\fR option, or NULL if the option was
+not specified. The format string can contain extra characters
+after the name of the format. If appropriate, the
+\fIformatPtr->stringWriteProc\fR procedure may interpret these
+characters to specify further details about the image file.
+The return value is a standard Tcl return value.
+
+.SH "SEE ALSO"
+Tk_FindPhoto, Tk_PhotoPutBlock
+
+.SH KEYWORDS
+photo image, image file
diff --git a/tk/doc/CrtSelHdlr.3 b/tk/doc/CrtSelHdlr.3
new file mode 100644
index 00000000000..91d4dfbfe89
--- /dev/null
+++ b/tk/doc/CrtSelHdlr.3
@@ -0,0 +1,120 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_CreateSelHandler\fR(\fItkwin, selection, target, proc, clientData, format\fR)
+.sp
+\fBTk_DeleteSelHandler\fR(\fItkwin, selection, target\fR)
+.SH ARGUMENTS
+.AS Tk_SelectionProc clientData
+.AP Tk_Window tkwin in
+Window for which \fIproc\fR will provide selection information.
+.AP Atom selection in
+The name of the selection for which \fIproc\fR will provide
+selection information.
+.AP Atom target in
+Form in which \fIproc\fR can provide the selection (e.g. STRING
+or FILE_NAME). Corresponds to \fItype\fR arguments in \fBselection\fR
+commands.
+.AP Tk_SelectionProc *proc in
+Procedure to invoke whenever the selection is owned by \fItkwin\fR
+and the selection contents are requested in the format given by
+\fItarget\fR.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR.
+.AP Atom format in
+If the selection requestor isn't in this process, \fIformat\fR determines
+the representation used to transmit the selection to its
+requestor.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_CreateSelHandler\fR arranges for a particular procedure
+(\fIproc\fR) to be called whenever \fIselection\fR is owned by
+\fItkwin\fR and the selection contents are requested in the
+form given by \fItarget\fR.
+\fITarget\fR should be one of
+the entries defined in the left column of Table 2 of the
+X Inter-Client Communication Conventions Manual (ICCCM) or
+any other form in which an application is willing to present
+the selection. The most common form is STRING.
+.PP
+\fIProc\fR should have arguments and result that match the
+type \fBTk_SelectionProc\fR:
+.CS
+typedef int Tk_SelectionProc(
+ ClientData \fIclientData\fR,
+ int \fIoffset\fR,
+ char *\fIbuffer\fR,
+ int \fImaxBytes\fR);
+.CE
+The \fIclientData\fR parameter to \fIproc\fR is a copy of the
+\fIclientData\fR argument given to \fBTk_CreateSelHandler\fR.
+Typically, \fIclientData\fR points to a data
+structure containing application-specific information that is
+needed to retrieve the selection. \fIOffset\fR specifies an
+offset position into the selection, \fIbuffer\fR specifies a
+location at which to copy information about the selection, and
+\fImaxBytes\fR specifies the amount of space available at
+\fIbuffer\fR. \fIProc\fR should place a NULL-terminated string
+at \fIbuffer\fR containing \fImaxBytes\fR or fewer characters
+(not including the terminating NULL), and it should return a
+count of the number of non-NULL characters stored at
+\fIbuffer\fR. If the selection no longer exists (e.g. it once
+existed but the user deleted the range of characters containing
+it), then \fIproc\fR should return -1.
+.PP
+When transferring large selections, Tk will break them up into
+smaller pieces (typically a few thousand bytes each) for more
+efficient transmission. It will do this by calling \fIproc\fR
+one or more times, using successively higher values of \fIoffset\fR
+to retrieve successive portions of the selection. If \fIproc\fR
+returns a count less than \fImaxBytes\fR it means that the entire
+remainder of the selection has been returned. If \fIproc\fR's return
+value is \fImaxBytes\fR it means there may be additional information
+in the selection, so Tk must make another call to \fIproc\fR to
+retrieve the next portion.
+.PP
+\fIProc\fR always returns selection information in the form of a
+character string. However, the ICCCM allows for information to
+be transmitted from the selection owner to the selection requestor
+in any of several formats, such as a string, an array of atoms, an
+array of integers, etc. The \fIformat\fR argument to
+\fBTk_CreateSelHandler\fR indicates what format should be used to
+transmit the selection to its requestor (see the middle column of
+Table 2 of the ICCCM for examples). If \fIformat\fR is not
+STRING, then Tk will take the value returned by \fIproc\fR and divided
+it into fields separated by white space. If \fIformat\fR is ATOM,
+then Tk will return the selection as an array of atoms, with each
+field in \fIproc\fR's result treated as the name of one atom. For
+any other value of \fIformat\fR, Tk will return the selection as an
+array of 32-bit values where each field of \fIproc\fR's result is
+treated as a number and translated to a 32-bit value. In any event,
+the \fIformat\fR atom is returned to the selection requestor along
+with the contents of the selection.
+.PP
+If \fBTk_CreateSelHandler\fR is called when there already exists a
+handler for \fIselection\fR and \fItarget\fR on \fItkwin\fR, then the
+existing handler is replaced with a new one.
+.PP
+\fBTk_DeleteSelHandler\fR removes the handler given by \fItkwin\fR,
+\fIselection\fR, and \fItarget\fR, if such a handler exists.
+If there is no such handler then it has no effect.
+
+.SH KEYWORDS
+format, handler, selection, target
diff --git a/tk/doc/CrtWindow.3 b/tk/doc/CrtWindow.3
new file mode 100644
index 00000000000..8c1074b7c54
--- /dev/null
+++ b/tk/doc/CrtWindow.3
@@ -0,0 +1,142 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+Tk_Window
+\fBTk_CreateWindow\fR(\fIinterp, parent, name, topLevScreen\fR)
+.sp
+Tk_Window
+\fBTk_CreateWindowFromPath\fR(\fIinterp, tkwin, pathName, topLevScreen\fR)
+.sp
+\fBTk_DestroyWindow\fR(\fItkwin\fR)
+.sp
+\fBTk_MakeWindowExist\fR(\fItkwin\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *topLevScreen
+.AP Tcl_Interp *interp out
+Tcl interpreter to use for error reporting. If no error occurs,
+then \fI*interp\fR isn't modified.
+.AP Tk_Window parent in
+Token for the window that is to serve as the logical parent of
+the new window.
+.AP char *name in
+Name to use for this window. Must be unique among all children of
+the same \fIparent\fR.
+.AP char *topLevScreen in
+Has same format as \fIscreenName\fR. If NULL, then new window is
+created as an internal window. If non-NULL, new window is created as
+a top-level window on screen \fItopLevScreen\fR. If \fItopLevScreen\fR
+is an empty string (``'') then new
+window is created as top-level window of \fIparent\fR's screen.
+.AP Tk_Window tkwin in
+Token for window.
+.AP char *pathName in
+Name of new window, specified as path name within application
+(e.g. \fB.a.b.c\fR).
+.BE
+
+.SH DESCRIPTION
+.PP
+The procedures \fBTk_CreateWindow\fR
+.VS
+and \fBTk_CreateWindowFromPath\fR
+are used to create new windows for
+use in Tk-based applications. Each of the procedures returns a token
+that can be used to manipulate the window in other calls to the Tk
+library. If the window couldn't be created successfully, then NULL
+is returned and \fIinterp->result\fR is modified to hold an error
+message.
+.PP
+Tk supports two different kinds of windows: internal
+windows and top-level windows.
+.VE
+An internal window is an interior window of a Tk application, such as a
+scrollbar or menu bar or button. A top-level window is one that is
+created as a child of a screen's root window, rather than as an
+interior window, but which is logically part of some existing main
+window. Examples of top-level windows are pop-up menus and dialog boxes.
+.PP
+New windows may be created by calling
+\fBTk_CreateWindow\fR. If the \fItopLevScreen\fR argument is
+NULL, then the new window will be an internal window. If
+\fItopLevScreen\fR is non-NULL, then the new window will be a
+top-level window: \fItopLevScreen\fR indicates the name of
+a screen and the new window will be created as a child of the
+root window of \fItopLevScreen\fR. In either case Tk will
+consider the new window to be the logical child of \fIparent\fR:
+the new window's path name will reflect this fact, options may
+be specified for the new window under this assumption, and so on.
+The only difference is that new X window for a top-level window
+will not be a child of \fIparent\fR's X window. For example, a pull-down
+menu's \fIparent\fR would be the button-like window used to invoke it,
+which would in turn be a child of the menu bar window. A dialog box might
+have the application's main window as its parent.
+.PP
+\fBTk_CreateWindowFromPath\fR offers an alternate way of specifying
+new windows. In \fBTk_CreateWindowFromPath\fR the new
+window is specified with a token for any window in the target
+application (\fItkwin\fR), plus a path name for the new window.
+It produces the same effect as \fBTk_CreateWindow\fR and allows
+both top-level and internal windows to be created, depending on
+the value of \fItopLevScreen\fR. In calls to \fBTk_CreateWindowFromPath\fR,
+as in calls to \fBTk_CreateWindow\fR, the parent of the new window
+must exist at the time of the call, but the new window must not
+already exist.
+.PP
+The window creation procedures don't
+actually issue the command to X to create a window.
+Instead, they create a local data structure associated with
+the window and defer the creation of the X window.
+The window will actually be created by the first call to
+\fBTk_MapWindow\fR. Deferred window creation allows various
+aspects of the window (such as its size, background color,
+etc.) to be modified after its creation without incurring
+any overhead in the X server. When the window is finally
+mapped all of the window attributes can be set while creating
+the window.
+.PP
+The value returned by a window-creation procedure is not the
+X token for the window (it can't be, since X hasn't been
+asked to create the window yet). Instead, it is a token
+for Tk's local data structure for the window. Most
+of the Tk library procedures take Tk_Window tokens, rather
+than X identifiers. The actual
+X window identifier can be retrieved from the local
+data structure using the \fBTk_WindowId\fR macro; see
+the manual entry for \fBTk_WindowId\fR for details.
+.PP
+\fBTk_DestroyWindow\fR deletes a window and all the data
+structures associated with it, including any event handlers
+created with \fBTk_CreateEventHandler\fR. In addition,
+\fBTk_DestroyWindow\fR will delete any children of \fItkwin\fR
+recursively (where children are defined in the Tk sense, consisting
+of all windows that were created with the given window as \fIparent\fR).
+If \fItkwin\fR was created by \fBTk_CreateInternalWindow\fR then event
+handlers interested in destroy events
+are invoked immediately. If \fItkwin\fR is a top-level or main window,
+then the event handlers will be invoked later, after X has seen
+the request and returned an event for it.
+.PP
+If a window has been created
+but hasn't been mapped, so no X window exists, it is
+possible to force the creation of the X window by
+calling \fBTk_MakeWindowExist\fR. This procedure issues
+the X commands to instantiate the window given by \fItkwin\fR.
+
+.SH KEYWORDS
+create, deferred creation, destroy, display, internal window,
+screen, top-level window, window
diff --git a/tk/doc/DeleteImg.3 b/tk/doc/DeleteImg.3
new file mode 100644
index 00000000000..9cadd680c1c
--- /dev/null
+++ b/tk/doc/DeleteImg.3
@@ -0,0 +1,35 @@
+'\"
+'\" 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$
+'\"
+.so man.macros
+.TH Tk_DeleteImage 3 4.0 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_DeleteImage \- Destroy an image.
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_DeleteImage\fR(\fIinterp, name\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *interp
+.AP Tcl_Interp *interp in
+Interpreter for which the image was created.
+.AP char *name in
+Name of the image.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_DeleteImage\fR deletes the image given by \fIinterp\fR
+and \fIname\fR, if there is one. All instances of that image
+will redisplay as empty regions. If the given image does not
+exist then the procedure has no effect.
+
+.SH KEYWORDS
+delete image, image manager
diff --git a/tk/doc/DrawFocHlt.3 b/tk/doc/DrawFocHlt.3
new file mode 100644
index 00000000000..ec77a675737
--- /dev/null
+++ b/tk/doc/DrawFocHlt.3
@@ -0,0 +1,40 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_GetPixels(\fItkwin, gc, width, drawable\fB)\fR
+.SH ARGUMENTS
+.AS "Tcl_Interp" *joinPtr
+.AP Tk_Window tkwin in
+Window for which the highlight is being drawn. Used to retrieve
+the window's dimensions, among other things.
+.AP GC gc in
+Graphics context to use for drawing the highlight.
+.AP int width in
+Width of the highlight ring, in pixels.
+.AP Drawable drawable in
+Drawable in which to draw the highlight; usually an offscreen
+pixmap for double buffering.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_DrawFocusHighlight\fR is a utility procedure that draws the
+traversal highlight ring for a widget.
+It is typically invoked by widgets during redisplay.
+
+.SH KEYWORDS
+focus, traversal highlight
diff --git a/tk/doc/EventHndlr.3 b/tk/doc/EventHndlr.3
new file mode 100644
index 00000000000..b17adc20cac
--- /dev/null
+++ b/tk/doc/EventHndlr.3
@@ -0,0 +1,79 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_CreateEventHandler\fR(\fItkwin, mask, proc, clientData\fR)
+.sp
+\fBTk_DeleteEventHandler\fR(\fItkwin, mask, proc, clientData\fR)
+.SH ARGUMENTS
+.AS "unsigned long" clientData
+.AP Tk_Window tkwin in
+Token for window in which events may occur.
+.AP "unsigned long" mask in
+Bit-mask of events (such as \fBButtonPressMask\fR)
+for which \fIproc\fR should be called.
+.AP Tk_EventProc *proc in
+Procedure to invoke whenever an event in \fImask\fR occurs
+in the window given by \fItkwin\fR.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_CreateEventHandler\fR arranges for \fIproc\fR to be
+invoked in the future whenever one of the event types specified
+by \fImask\fR occurs in the window specified by \fItkwin\fR.
+The callback to \fIproc\fR will be made by \fBTk_HandleEvent\fR;
+this mechanism only works in programs that dispatch events
+through \fBTk_HandleEvent\fR (or through other Tk procedures that
+call \fBTk_HandleEvent\fR, such as \fBTk_DoOneEvent\fR or
+\fBTk_MainLoop\fR).
+.PP
+\fIProc\fR should have arguments and result that match the
+type \fBTk_EventProc\fR:
+.CS
+typedef void Tk_EventProc(
+ ClientData \fIclientData\fR,
+ XEvent *\fIeventPtr\fR);
+.CE
+The \fIclientData\fR parameter to \fIproc\fR is a copy of the \fIclientData\fR
+argument given to \fBTk_CreateEventHandler\fR when the callback
+was created. Typically, \fIclientData\fR points to a data
+structure containing application-specific information about
+the window in which the event occurred. \fIEventPtr\fR is
+a pointer to the X event, which will be one of the ones
+specified in the \fImask\fR argument to \fBTk_CreateEventHandler\fR.
+.PP
+\fBTk_DeleteEventHandler\fR may be called to delete a
+previously-created event handler: it deletes the first handler
+it finds that is associated with \fItkwin\fR and matches the
+\fImask\fR, \fIproc\fR, and \fIclientData\fR arguments. If
+no such handler exists, then \fBTk_EventHandler\fR returns
+without doing anything. Although Tk supports it, it's probably
+a bad idea to have more than one callback with the same \fImask\fR,
+\fIproc\fR, and \fIclientData\fR arguments.
+When a window is deleted all of its handlers will be deleted
+automatically; in this case there is no need to call
+\fBTk_DeleteEventHandler\fR.
+.PP
+If multiple handlers are declared for the same type of X event
+on the same window, then the handlers will be invoked in the
+order they were created.
+
+.SH KEYWORDS
+bind, callback, event, handler
diff --git a/tk/doc/FindPhoto.3 b/tk/doc/FindPhoto.3
new file mode 100644
index 00000000000..8cd20f2c534
--- /dev/null
+++ b/tk/doc/FindPhoto.3
@@ -0,0 +1,202 @@
+'\"
+'\" 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 (paulus@cs.anu.edu.au),
+'\" Department of Computer Science,
+'\" Australian National University.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+\fB#include <tkPhoto.h>\fR
+.sp
+Tk_PhotoHandle
+.VS 8.0 br
+\fBTk_FindPhoto\fR(\fIinterp, imageName\fR)
+.VE
+.sp
+void
+\fBTk_PhotoPutBlock\fR(\fIhandle, blockPtr, x, y, width, height\fR)
+.sp
+void
+\fBTk_PhotoPutZoomedBlock\fR(\fIhandle, blockPtr, x, y, width, height,\
+zoomX, zoomY, subsampleX, subsampleY\fR)
+.sp
+int
+\fBTk_PhotoGetImage\fR(\fIhandle, blockPtr\fR)
+.sp
+void
+\fBTk_PhotoBlank\fR(\fIhandle\fR)
+.sp
+void
+\fBTk_PhotoExpand\fR(\fIhandle, width, height\fR)
+.sp
+void
+\fBTk_PhotoGetSize\fR(\fIhandle, widthPtr, heightPtr\fR)
+.sp
+void
+\fBTk_PhotoSetSize\fR(\fIhandle, width, height\fR)
+.SH ARGUMENTS
+.AS Tk_PhotoImageBlock window_path
+.AP Tcl_Interp *interp in
+.VS
+Interpreter in which image was created.
+.VE
+.AP char *imageName in
+Name of the photo image.
+.AP Tk_PhotoHandle handle in
+Opaque handle identifying the photo image to be affected.
+.AP Tk_PhotoImageBlock *blockPtr in
+Specifies the address and storage layout of image data.
+.AP int x in
+Specifies the X coordinate where the top-left corner of the block is
+to be placed within the image.
+.AP int y in
+Specifies the Y coordinate where the top-left corner of the block is
+to be placed within the image.
+.AP int width in
+Specifies the width of the image area to be affected (for
+\fBTk_PhotoPutBlock\fR) or the desired image width (for
+\fBTk_PhotoExpand\fR and \fBTk_PhotoSetSize\fR).
+.AP int height in
+Specifies the height of the image area to be affected (for
+\fBTk_PhotoPutBlock\fR) or the desired image height (for
+\fBTk_PhotoExpand\fR and \fBTk_PhotoSetSize\fR).
+.AP int *widthPtr out
+Pointer to location in which to store the image width.
+.AP int *heightPtr out
+Pointer to location in which to store the image height.
+.AP int subsampleX in
+Specifies the subsampling factor in the X direction for input
+image data.
+.AP int subsampleY in
+Specifies the subsampling factor in the Y direction for input
+image data.
+.AP int zoomX in
+Specifies the zoom factor to be applied in the X direction to pixels
+being written to the photo image.
+.AP int zoomY in
+Specifies the zoom factor to be applied in the Y direction to pixels
+being written to the photo image.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_FindPhoto\fR returns an opaque handle that is used to identify a
+particular photo image to the other procedures. The parameter is the
+name of the image, that is, the name specified to the \fBimage create
+photo\fR command, or assigned by that command if no name was specified.
+.PP
+\fBTk_PhotoPutBlock\fR is used to supply blocks of image data to be
+displayed. The call affects an area of the image of size
+\fIwidth\fR x \fIheight\fR pixels, with its top-left corner at
+coordinates (\fIx\fR,\fIy\fR). All of \fIwidth\fR, \fIheight\fR,
+\fIx\fR, and \fIy\fR must be non-negative.
+If part of this area lies outside the
+current bounds of the image, the image will be expanded to include the
+area, unless the user has specified an explicit image size with the
+\fB\-width\fR and/or \fB\-height\fR widget configuration options
+(see photo(n)); in that
+case the area is silently clipped to the image boundaries.
+.PP
+The \fIblock\fR parameter is a pointer to a
+\fBTk_PhotoImageBlock\fR structure, defined as follows:
+.CS
+typedef struct {
+ unsigned char *\fIpixelPtr\fR;
+ int \fIwidth\fR;
+ int \fIheight\fR;
+ int \fIpitch\fR;
+ int \fIpixelSize\fR;
+ int \fIoffset[3]\fR;
+} Tk_PhotoImageBlock;
+.CE
+The \fIpixelPtr\fR field points to the first pixel, that is, the
+top-left pixel in the block.
+The \fIwidth\fR and \fIheight\fR fields specify the dimensions of the
+block of pixels. The \fIpixelSize\fR field specifies the address
+difference between two horizontally adjacent pixels. Often it is 3
+or 4, but it can have any value. The \fIpitch\fR field specifies the
+address difference between two vertically adjacent pixels. The
+\fIoffset\fR array contains the offsets from the address of a pixel
+to the addresses of the bytes containing the red, green and blue
+components. These are normally 0, 1 and 2, but can have other values,
+e.g., for images that are stored as separate red, green and blue
+planes.
+.PP
+The value given for the \fIwidth\fR and \fIheight\fR parameters to
+\fBTk_PhotoPutBlock\fR do not have to correspond to the values specified
+in \fIblock\fR. If they are smaller, \fBTk_PhotoPutBlock\fR extracts a
+sub-block from the image data supplied. If they are larger, the data
+given are replicated (in a tiled fashion) to fill the specified area.
+These rules operate independently in the horizontal and vertical
+directions.
+.PP
+\fBTk_PhotoPutZoomedBlock\fR works like \fBTk_PhotoPutBlock\fR except that
+the image can be reduced or enlarged for display. The
+\fIsubsampleX\fR and \fIsubsampleY\fR parameters allow the size of the
+image to be reduced by subsampling.
+\fBTk_PhotoPutZoomedBlock\fR will use only pixels from the input image
+whose X coordinates are multiples of \fIsubsampleX\fR, and whose Y
+coordinates are multiples of \fIsubsampleY\fR. For example, an image
+of 512x512 pixels can be reduced to 256x256 by setting
+\fIsubsampleX\fR and \fIsubsampleY\fR to 2.
+.PP
+The \fIzoomX\fR and \fIzoomY\fR parameters allow the image to be
+enlarged by pixel replication. Each pixel of the (possibly subsampled)
+input image will be written to a block \fIzoomX\fR pixels wide and
+\fIzoomY\fR pixels high of the displayed image. Subsampling and
+zooming can be used together for special effects.
+.PP
+\fBTk_PhotoGetImage\fR can be used to retrieve image data from a photo
+image. \fBTk_PhotoGetImage\fR fills
+in the structure pointed to by the \fIblockPtr\fR parameter with values
+that describe the address and layout of the image data that the
+photo image has stored internally. The values are valid
+until the image is destroyed or its size is changed.
+\fBTk_PhotoGetImage\fR returns 1 for compatibility with the
+corresponding procedure in the old photo widget.
+.PP
+\fBTk_PhotoBlank\fR blanks the entire area of the
+photo image. Blank areas of a photo image are transparent.
+.PP
+\fBTk_PhotoExpand\fR requests that the widget's image be expanded to be
+at least \fIwidth\fR x \fIheight\fR pixels in size. The width and/or
+height are unchanged if the user has specified an explicit image width
+or height with the \fB\-width\fR and/or \fB\-height\fR configuration
+options, respectively.
+If the image data
+are being supplied in many small blocks, it is more efficient to use
+\fBTk_PhotoExpand\fR or \fBTk_PhotoSetSize\fR at the beginning rather than
+allowing the image to expand in many small increments as image blocks
+are supplied.
+.PP
+\fBTk_PhotoSetSize\fR specifies the size of the image, as if the user
+had specified the given \fIwidth\fR and \fIheight\fR values to the
+\fB\-width\fR and \fB\-height\fR configuration options. A value of
+zero for \fIwidth\fR or \fIheight\fR does not change the image's width
+or height, but allows the width or height to be changed by subsequent
+calls to \fBTk_PhotoPutBlock\fR, \fBTk_PhotoPutZoomedBlock\fR or
+\fBTk_PhotoExpand\fR.
+.PP
+\fBTk_PhotoGetSize\fR returns the dimensions of the image in
+*\fIwidthPtr\fR and *\fIheightPtr\fR.
+
+.SH CREDITS
+.PP
+The code for the photo image type was developed by Paul Mackerras,
+based on his earlier photo widget code.
+
+.SH KEYWORDS
+photo, image
diff --git a/tk/doc/FontId.3 b/tk/doc/FontId.3
new file mode 100644
index 00000000000..4cfdb410247
--- /dev/null
+++ b/tk/doc/FontId.3
@@ -0,0 +1,95 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+Font
+\fBTk_FontId(\fItkfont\fB)\fR
+.sp
+void
+\fBTk_GetFontMetrics(\fItkfont, fmPtr\fB)\fR
+.sp
+int
+\fBTk_PostscriptFontName(\fItkfont, dsPtr\fB)\fR
+
+.SH ARGUMENTS
+.AS Tk_FontMetrics *dsPtr
+.AP Tk_Font tkfont in
+Opaque font token being queried. Must have been returned by a previous
+call to \fBTk_GetFont\fR.
+.AP Tk_FontMetrics *fmPtr out
+Pointer to structure in which the font metrics for \fItkfont\fR will
+be stored.
+.AP Tcl_DString *dsPtr out
+Pointer to an initialized \fBTcl_DString\fR to which the name of the
+Postscript font that corresponds to \fItkfont\fR will be appended.
+.BE
+
+.SH DESCRIPTION
+.PP
+Given a \fItkfont\fR, \fBTk_FontId\fR returns the token that should be
+selected into an XGCValues structure in order to construct a graphics
+context that can be used to draw text in the specified font.
+.PP
+\fBTk_GetFontMetrics\fR computes the ascent, descent, and linespace of the
+\fItkfont\fR in pixels and stores those values in the structure pointer to by
+\fIfmPtr\fR. These values can be used in computations such as to space
+multiple lines of text, to align the baselines of text in different
+fonts, and to vertically align text in a given region. See the
+documentation for the \fBfont\fR command for definitions of the terms
+ascent, descent, and linespace, used in font metrics.
+.PP
+\fBTk_PostscriptFontName\fR maps a \fItkfont\fR to the corresponding
+Postcript font name that should be used when printing. The return value
+is the size in points of the \fItkfont\fR and the Postscript font name is
+appended to \fIdsPtr\fR. \fIDsPtr\fR must refer to an initialized
+\fBTcl_DString\fR. Given a ``reasonable'' Postscript printer, the
+following screen font families should print correctly:
+.IP
+\fBAvant Garde\fR, \fBArial\fR, \fBBookman\fR, \fBCourier\fR,
+\fBCourier New\fR, \fBGeneva\fR, \fBHelvetica\fR, \fBMonaco\fR,
+\fBNew Century Schoolbook\fR, \fBNew York\fR, \fBPalatino\fR, \fBSymbol\fR,
+\fBTimes\fR, \fBTimes New Roman\fR, \fBZapf Chancery\fR, and
+\fBZapf Dingbats\fR.
+.PP
+Any other font families may not print correctly because the computed
+Postscript font name may be incorrect or not exist on the printer.
+.VS 8.0 br
+.SH DATA STRUCTURES
+The Tk_FontMetrics data structure is used by Tk_GetFontMetrics to return
+information about a font and is defined as follows:
+.CS
+typedef struct Tk_FontMetrics {
+ int ascent;
+ int descent;
+ int linespace;
+} Tk_FontMetrics;
+.CE
+The \fIlinespace\fR field is the amount in pixels that the tallest
+letter sticks up above the baseline, plus any extra blank space added
+by the designer of the font.
+.PP
+The \fIdescent\fR is the largest amount in pixels that any letter
+sticks below the baseline, plus any extra blank space added by the
+designer of the font.
+.PP
+The \fIlinespace\fR is the sum of the ascent and descent. How far
+apart two lines of text in the same font should be placed so that none
+of the characters in one line overlap any of the characters in the
+other line.
+.VE
+.SH KEYWORDS
+font
diff --git a/tk/doc/FreeXId.3 b/tk/doc/FreeXId.3
new file mode 100644
index 00000000000..3399d083225
--- /dev/null
+++ b/tk/doc/FreeXId.3
@@ -0,0 +1,52 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_FreeXId(\fIdisplay, id\fB)\fR
+.SH ARGUMENTS
+.AS Display *display out
+.AP Display *display in
+Display for which \fIid\fR was allocated.
+.AP XID id in
+Identifier of X resource (window, font, pixmap, cursor, graphics
+context, or colormap) that is no longer in use.
+.BE
+
+.SH DESCRIPTION
+.PP
+The default allocator for resource identifiers provided by Xlib is very
+simple-minded and does not allow resource identifiers to be re-used.
+If a long-running application reaches the end of the resource id
+space, it will generate an X protocol error and crash.
+Tk replaces the default id allocator with its own allocator, which
+allows identifiers to be reused.
+In order for this to work, \fBTk_FreeXId\fR must be called to
+tell the allocator about resources that have been freed.
+Tk automatically calls \fBTk_FreeXId\fR whenever it frees a
+resource, so if you use procedures like \fBTk_GetFontStruct\fR,
+\fBTk_GetGC\fR, and \fBTk_GetPixmap\fR then you need not call
+\fBTk_FreeXId\fR.
+However, if you allocate resources directly from Xlib, for example
+by calling \fBXCreatePixmap\fR, then you should call \fBTk_FreeXId\fR
+when you call the corresponding Xlib free procedure, such as
+\fBXFreePixmap\fR.
+If you don't call \fBTk_FreeXId\fR then the resource identifier will
+be lost, which could cause problems if the application runs long enough
+to lose all of the available identifiers.
+
+.SH KEYWORDS
+resource identifier
diff --git a/tk/doc/GeomReq.3 b/tk/doc/GeomReq.3
new file mode 100644
index 00000000000..cf6bf6579fb
--- /dev/null
+++ b/tk/doc/GeomReq.3
@@ -0,0 +1,69 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_GeometryRequest\fR(\fItkwin, reqWidth, reqHeight\fR)
+.sp
+\fBTk_SetInternalBorder\fR(\fItkwin, width\fR)
+.SH ARGUMENTS
+.AS baseHeight clientData
+.AP Tk_Window tkwin in
+Window for which geometry is being requested.
+.AP int reqWidth in
+Desired width for \fItkwin\fR, in pixel units.
+.AP int reqHeight in
+Desired height for \fItkwin\fR, in pixel units.
+.AP int width in
+Space to leave for internal border for \fItkwin\fR, in pixel units.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_GeometryRequest\fR is called by widget code to indicate its
+preference for the dimensions of a particular window. The arguments
+to \fBTk_GeometryRequest\fR are made available to the geometry
+manager for the window, which then decides on the actual geometry
+for the window. Although geometry managers generally try to satisfy
+requests made to \fBTk_GeometryRequest\fR, there is no guarantee that
+this will always be possible. Widget code should not assume that
+a geometry request will be satisfied until it receives a
+\fBConfigureNotify\fR event indicating that the geometry change has
+occurred. Widget code should never call procedures like
+\fBTk_ResizeWindow\fR directly. Instead, it should invoke
+\fBTk_GeometryRequest\fR and leave the final geometry decisions to
+the geometry manager.
+.PP
+If \fItkwin\fR is a top-level window, then the geometry information
+will be passed to the window manager using the standard ICCCM protocol.
+.PP
+\fBTk_SetInternalBorder\fR is called by widget code to indicate that
+the widget has an internal border. This means that the widget draws
+a decorative border inside the window instead of using the standard
+X borders, which are external to the window's area. For example,
+internal borders are used to draw 3-D effects. \fIWidth\fR
+specifies the width of the border in pixels. Geometry managers will
+use this information to avoid placing any children of \fItkwin\fR
+overlapping the outermost \fIwidth\fR pixels of \fItkwin\fR's area.
+.PP
+The information specified in calls to \fBTk_GeometryRequest\fR and
+\fBTk_SetInternalBorder\fR can be retrieved using the macros
+\fBTk_ReqWidth\fR, \fBTk_ReqHeight\fR, and \fBTk_InternalBorderWidth\fR.
+See the \fBTk_WindowId\fR manual entry for details.
+
+.SH KEYWORDS
+geometry, request
diff --git a/tk/doc/GetAnchor.3 b/tk/doc/GetAnchor.3
new file mode 100644
index 00000000000..08af4d15f98
--- /dev/null
+++ b/tk/doc/GetAnchor.3
@@ -0,0 +1,64 @@
+'\"
+'\" 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$
+'\"
+.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.
+
+.SH KEYWORDS
+anchor position
diff --git a/tk/doc/GetBitmap.3 b/tk/doc/GetBitmap.3
new file mode 100644
index 00000000000..282382af765
--- /dev/null
+++ b/tk/doc/GetBitmap.3
@@ -0,0 +1,266 @@
+'\"
+'\" 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$
+'\"
+.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
+a call to \fBTk_DefineBitmap\fR. The following names are pre-defined
+by Tk:
+.RS
+.TP 12
+\fBerror\fR
+The international "don't" symbol: a circle with a diagonal line
+across it.
+.VS "" br
+.TP 12
+\fBgray75\fR
+75% gray: a checkerboard pattern where three out of four bits are on.
+.VE
+.TP 12
+\fBgray50\fR
+50% gray: a checkerboard pattern where every other bit is on.
+.VS "" br
+.TP 12
+\fBgray25\fR
+25% gray: a checkerboard pattern where one out of every four bits is on.
+.VE
+.TP 12
+\fBgray12\fR
+12.5% gray: a pattern where one-eighth of the bits are on, consisting of
+every fourth pixel in every other row.
+.TP 12
+\fBhourglass\fR
+An hourglass symbol.
+.TP 12
+\fBinfo\fR
+A large letter ``i''.
+.TP 12
+\fBquesthead\fR
+The silhouette of a human head, with a question mark in it.
+.TP 12
+\fBquestion\fR
+A large question-mark.
+.TP 12
+\fBwarning\fR
+A large exclamation point.
+.PP
+In addition, the following pre-defined names are available only on the
+\fBMacintosh\fR platform:
+.TP 12
+\fBdocument\fR
+A generic document.
+.TP 12
+\fBstationery\fR
+Document stationery.
+.TP 12
+\fBedition\fR
+The \fIedition\fR symbol.
+.TP 12
+\fBapplication\fR
+Generic application icon.
+.TP 12
+\fBaccessory\fR
+A desk accessory.
+.TP 12
+\fBfolder\fR
+Generic folder icon.
+.TP 12
+\fBpfolder\fR
+A locked folder.
+.TP 12
+\fBtrash\fR
+A trash can.
+.TP 12
+\fBfloppy\fR
+A floppy disk.
+.TP 12
+\fBramdisk\fR
+A floppy disk with chip.
+.TP 12
+\fBcdrom\fR
+A cd disk icon.
+.TP 12
+\fBpreferences\fR
+A folder with prefs symbol.
+.TP 12
+\fBquerydoc\fR
+A database document icon.
+.TP 12
+\fBstop\fR
+A stop sign.
+.TP 12
+\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
diff --git a/tk/doc/GetCapStyl.3 b/tk/doc/GetCapStyl.3
new file mode 100644
index 00000000000..c8c000793a8
--- /dev/null
+++ b/tk/doc/GetCapStyl.3
@@ -0,0 +1,63 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+int
+\fBTk_GetCapStyle(\fIinterp, string, capPtr\fB)\fR
+.sp
+char *
+\fBTk_NameOfCapStyle(\fIcap\fB)\fR
+.SH ARGUMENTS
+.AS "Tcl_Interp" *capPtr
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting.
+.AP char *string in
+String containing name of cap style: one of ```butt'', ``projecting'',
+or ``round''.
+.AP int *capPtr out
+Pointer to location in which to store X cap style corresponding to
+\fIstring\fR.
+.AP int cap in
+Cap style: one of \fBCapButt\fR, \fBCapProjecting\fR, or \fBCapRound\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_GetCapStyle\fR places in \fI*capPtr\fR the X cap style
+corresponding to \fIstring\fR.
+This will be one of the values
+\fBCapButt\fR, \fBCapProjecting\fR, or \fBCapRound\fR.
+Cap styles are typically used in X graphics contexts to indicate
+how the end-points of lines should be capped.
+See the X documentation for information on what each style
+implies.
+.PP
+Under normal circumstances the return value is \fBTCL_OK\fR and
+\fIinterp\fR is unused.
+If \fIstring\fR doesn't contain a valid cap 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*capPtr\fR is unmodified.
+.PP
+\fBTk_NameOfCapStyle\fR is the logical inverse of \fBTk_GetCapStyle\fR.
+Given a cap style such as \fBCapButt\fR it returns a
+statically-allocated string corresponding to \fIcap\fR.
+If \fIcap\fR isn't a legal cap style, then
+``unknown cap style'' is returned.
+
+.SH KEYWORDS
+butt, cap style, projecting, round
diff --git a/tk/doc/GetClrmap.3 b/tk/doc/GetClrmap.3
new file mode 100644
index 00000000000..936dbff568b
--- /dev/null
+++ b/tk/doc/GetClrmap.3
@@ -0,0 +1,73 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+Colormap
+\fBTk_GetColormap(\fIinterp, tkwin, string\fB)\fR
+.sp
+\fBTk_FreeColormap(\fIdisplay, colormap\fB)\fR
+.SH ARGUMENTS
+.AS "Colormap" colormap
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting.
+.AP Tk_Window tkwin in
+Token for window in which colormap will be used.
+.AP char *string in
+Selects a colormap: either \fBnew\fR or the name of a window
+with the same screen and visual as \fItkwin\fR.
+.AP Display *display in
+Display for which \fIcolormap\fR was allocated.
+.AP Colormap colormap in
+Colormap to free; must have been returned by a previous
+call to \fBTk_GetColormap\fR or \fBTk_GetVisual\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures are used to manage colormaps.
+\fBTk_GetColormap\fR returns a colormap suitable for use in \fItkwin\fR.
+If its \fIstring\fR argument is \fBnew\fR then a new colormap is
+created; otherwise \fIstring\fR must be the name of another window
+with the same screen and visual as \fItkwin\fR, and the colormap from that
+window is returned.
+If \fIstring\fR doesn't make sense, or if it refers to a window on
+a different screen from \fItkwin\fR or with
+a different visual than \fItkwin\fR, then \fBTk_GetColormap\fR returns
+\fBNone\fR and leaves an error message in \fIinterp->result\fR.
+.PP
+\fBTk_FreeColormap\fR should be called when a colormap returned by
+\fBTk_GetColormap\fR is no longer needed.
+Tk maintains a reference count for each colormap returned by
+\fBTk_GetColormap\fR, so there should eventually be one call to
+\fBTk_FreeColormap\fR for each call to \fBTk_GetColormap\fR.
+When a colormap's reference count becomes zero, Tk releases the
+X colormap.
+.PP
+\fBTk_GetVisual\fR and \fBTk_GetColormap\fR work together, in that
+a new colormap created by \fBTk_GetVisual\fR may later be returned
+by \fBTk_GetColormap\fR.
+The reference counting mechanism for colormaps includes both procedures,
+so callers of \fBTk_GetVisual\fR must also call \fBTk_FreeColormap\fR
+to release the colormap.
+If \fBTk_GetColormap\fR is called with a \fIstring\fR value of
+\fBnew\fR then the resulting colormap will never
+be returned by \fBTk_GetVisual\fR; however, it can be used in other
+windows by calling \fBTk_GetColormap\fR with the original window's
+name as \fIstring\fR.
+
+.SH KEYWORDS
+colormap
diff --git a/tk/doc/GetColor.3 b/tk/doc/GetColor.3
new file mode 100644
index 00000000000..afd8a74eac1
--- /dev/null
+++ b/tk/doc/GetColor.3
@@ -0,0 +1,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.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.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
diff --git a/tk/doc/GetCursor.3 b/tk/doc/GetCursor.3
new file mode 100644
index 00000000000..d5fb0a574c4
--- /dev/null
+++ b/tk/doc/GetCursor.3
@@ -0,0 +1,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.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.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
diff --git a/tk/doc/GetFont.3 b/tk/doc/GetFont.3
new file mode 100644
index 00000000000..1547db0934b
--- /dev/null
+++ b/tk/doc/GetFont.3
@@ -0,0 +1,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.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.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
diff --git a/tk/doc/GetGC.3 b/tk/doc/GetGC.3
new file mode 100644
index 00000000000..53e120663c7
--- /dev/null
+++ b/tk/doc/GetGC.3
@@ -0,0 +1,74 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+GC
+\fBTk_GetGC\fR(\fItkwin, valueMask, valuePtr\fR)
+.sp
+\fBTk_FreeGC(\fIdisplay, gc\fR)
+.SH ARGUMENTS
+.AS "unsigned long" valueMask
+.AP Tk_Window tkwin in
+Token for window in which the graphics context will be used.
+.AP "unsigned long" valueMask in
+Mask of bits (such as \fBGCForeground\fR or \fBGCStipple\fR)
+indicating which fields of \fI*valuePtr\fR are valid.
+.AP XGCValues *valuePtr in
+Pointer to structure describing the desired values for the
+graphics context.
+.AP Display *display in
+Display for which \fIgc\fR was allocated.
+.AP GC gc in
+X identifier for graphics context that is no longer needed.
+Must have been allocated by \fBTk_GetGC\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_GetGC\fR and \fBTk_FreeGC\fR manage a collection of graphics contexts
+being used by an application. The procedures allow graphics contexts to be
+shared, thereby avoiding the server overhead that would be incurred
+if a separate GC were created for each use. \fBTk_GetGC\fR takes arguments
+describing the desired graphics context and returns an X identifier
+for a GC that fits the description. The graphics context that is returned
+will have default values in all of the fields not specified explicitly
+by \fIvalueMask\fR and \fIvaluePtr\fR.
+.PP
+\fBTk_GetGC\fR maintains a
+database of all the graphics contexts it has created. Whenever possible,
+a call to \fBTk_GetGC\fR will
+return an existing graphics context rather than creating a new one. This
+approach can substantially reduce server overhead, so \fBTk_GetGC\fR
+should generally be used in preference to the Xlib procedure
+\fBXCreateGC\fR, which creates a new graphics context on each call.
+.PP
+Since the return values of \fBTk_GetGC\fR
+are shared, callers should never modify the graphics contexts
+returned by \fBTk_GetGC\fR.
+If a graphics context must be modified dynamically, then it should be
+created by calling \fBXCreateGC\fR instead of \fBTk_GetGC\fR.
+.PP
+When a graphics context
+is no longer needed, \fBTk_FreeGC\fR should be called to release it.
+There should be exactly one call to \fBTk_FreeGC\fR for
+each call to \fBTk_GetGC\fR.
+When a graphics context is no longer in use anywhere (i.e. it has
+been freed as many times as it has been gotten) \fBTk_FreeGC\fR
+will release it to the X server and delete it from the database.
+
+.SH KEYWORDS
+graphics context
diff --git a/tk/doc/GetImage.3 b/tk/doc/GetImage.3
new file mode 100644
index 00000000000..9af712cec2c
--- /dev/null
+++ b/tk/doc/GetImage.3
@@ -0,0 +1,135 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+Tk_Image
+\fBTk_GetImage\fR(\fIinterp, tkwin, name, changeProc, clientData\fR)
+.sp
+\fBTk_RedrawImage\fR(\fIimage, imageX, imageY, width, height, drawable, drawableX, drawableY\fR)
+.sp
+\fBTk_SizeOfImage\fR(\fIimage, widthPtr, heightPtr\fR)
+.sp
+\fBTk_FreeImage\fR(\fIimage\fR)
+.SH ARGUMENTS
+.AS Tk_ImageChangedProc *changeProc
+.AP Tcl_Interp *interp in
+Place to leave error message.
+.AP Tk_Window tkwin in
+Window in which image will be used.
+.AP char *name in
+Name of image.
+.AP Tk_ImageChangedProc *changeProc in
+Procedure for Tk to invoke whenever image content or size changes.
+.AP ClientData clientData in
+One-word value for Tk to pass to \fIchangeProc\fR.
+.AP Tk_Image image in
+Token for image instance; must have been returned by a previous
+call to \fBTk_GetImage\fR.
+.AP int imageX in
+X-coordinate of upper-left corner of region of image to redisplay
+(measured in pixels from the image's upper-left corner).
+.AP int imageY in
+Y-coordinate of upper-left corner of region of image to redisplay
+(measured in pixels from the image's upper-left corner).
+.AP "int" width (in)
+Width of region of image to redisplay.
+.AP "int" height (in)
+Height of region of image to redisplay.
+.AP Drawable drawable in
+Where to display image. Must either be window specified to
+\fBTk_GetImage\fR or a pixmap compatible with that window.
+.AP int drawableX in
+Where to display image in \fIdrawable\fR: this is the x-coordinate
+in \fIdrawable\fR where x-coordinate \fIimageX\fR of the image
+should be displayed.
+.AP int drawableY in
+Where to display image in \fIdrawable\fR: this is the y-coordinate
+in \fIdrawable\fR where y-coordinate \fIimageY\fR of the image
+should be displayed.
+.AP "int" widthPtr out
+Store width of \fIimage\fR (in pixels) here.
+.AP "int" heightPtr out
+Store height of \fIimage\fR (in pixels) here.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures are invoked by widgets that wish to display images.
+\fBTk_GetImage\fR is invoked by a widget when it first decides to
+display an image.
+\fIname\fR gives the name of the desired image and \fItkwin\fR
+identifies the window where the image will be displayed.
+\fBTk_GetImage\fR looks up the image in the table of existing
+images and returns a token for a new instance of the image.
+If the image doesn't exist then \fBTk_GetImage\fR returns NULL
+and leaves an error message in \fIinterp->result\fR.
+.PP
+When a widget wishes to actually display an image it must
+call \fBTk_RedrawWidget\fR, identifying the image (\fIimage\fR),
+a region within the image to redisplay (\fIimageX\fR, \fIimageY\fR,
+\fIwidth\fR, and \fIheight\fR), and a place to display the
+image (\fIdrawable\fR, \fIdrawableX\fR, and \fIdrawableY\fR).
+Tk will then invoke the appropriate image manager, which will
+display the requested portion of the image before returning.
+.PP
+A widget can find out the dimensions of an image by calling
+\fBTk_SizeOfImage\fR: the width and height will be stored
+in the locations given by \fIwidthPtr\fR and \fIheightPtr\fR,
+respectively.
+.PP
+When a widget is finished with an image (e.g., the widget is
+being deleted or it is going to use a different image instead
+of the current one), it must call \fBTk_FreeImage\fR to
+release the image instance.
+The widget should never again use the image token after passing
+it to \fBTk_FreeImage\fR.
+There must be exactly one call to \fBTk_FreeImage\fR for each
+call to \fBTk_GetImage\fR.
+.PP
+If the contents or size of an image changes, then any widgets
+using the image will need to find out about the changes so that
+they can redisplay themselves.
+The \fIchangeProc\fR and \fIclientData\fR arguments to
+\fBTk_GetImage\fR are used for this purpose.
+\fIchangeProc\fR will be called by Tk whenever a change occurs
+in the image; it must match the following prototype:
+.CS
+typedef void Tk_ImageChangedProc(
+ ClientData \fIclientData\fR,
+ int \fIx\fR,
+ int \fIy\fR,
+ int \fIwidth\fR,
+ int \fIheight\fR,
+ int \fIimageWidth\fR,
+ int \fIimageHeight\fR);
+.CE
+The \fIclientData\fR argument to \fIchangeProc\fR is the same as the
+\fIclientData\fR argument to \fBTk_GetImage\fR.
+It is usually a pointer to the widget record for the widget or
+some other data structure managed by the widget.
+The arguments \fIx\fR, \fIy\fR, \fIwidth\fR, and \fIheight\fR
+identify a region within the image that must be redisplayed;
+they are specified in pixels measured from the upper-left
+corner of the image.
+The arguments \fIimageWidth\fR and \fIimageHeight\fR give
+the image's (new) size.
+
+.SH "SEE ALSO"
+Tk_CreateImageType
+
+.SH KEYWORDS
+images, redisplay
diff --git a/tk/doc/GetJoinStl.3 b/tk/doc/GetJoinStl.3
new file mode 100644
index 00000000000..4d02d6f7b80
--- /dev/null
+++ b/tk/doc/GetJoinStl.3
@@ -0,0 +1,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.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+int
+\fBTk_GetJoinStyle(\fIinterp, string, joinPtr\fB)\fR
+.sp
+char *
+\fBTk_NameOfJoinStyle(\fIjoin\fB)\fR
+.SH ARGUMENTS
+.AS "Tcl_Interp" *joinPtr
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting.
+.AP char *string in
+String containing name of join style: one of ``bevel'', ``miter'',
+or ``round''.
+.AP int *joinPtr out
+Pointer to location in which to store X join style corresponding to
+\fIstring\fR.
+.AP int join in
+Join style: one of \fBJoinBevel\fR, \fBJoinMiter\fR, \fBJoinRound\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_GetJoinStyle\fR places in \fI*joinPtr\fR the X join style
+corresponding to \fIstring\fR, which will be one of
+\fBJoinBevel\fR, \fBJoinMiter\fR, or \fBJoinRound\fR.
+Join styles are typically used in X graphics contexts to indicate
+how adjacent line segments should be joined together.
+See the X documentation for information on what each style
+implies.
+.PP
+Under normal circumstances the return value is \fBTCL_OK\fR and
+\fIinterp\fR is unused.
+If \fIstring\fR doesn't contain a valid join 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*joinPtr\fR is unmodified.
+.PP
+\fBTk_NameOfJoinStyle\fR is the logical inverse of \fBTk_GetJoinStyle\fR.
+Given a join style such as \fBJoinBevel\fR it returns a
+statically-allocated string corresponding to \fIjoin\fR.
+If \fIjoin\fR isn't a legal join style, then
+``unknown join style'' is returned.
+
+.SH KEYWORDS
+bevel, join style, miter, round
diff --git a/tk/doc/GetJustify.3 b/tk/doc/GetJustify.3
new file mode 100644
index 00000000000..a119075f10c
--- /dev/null
+++ b/tk/doc/GetJustify.3
@@ -0,0 +1,69 @@
+'\"
+'\" 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$
+'\"
+.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.
+
+.SH KEYWORDS
+center, fill, justification, string
diff --git a/tk/doc/GetOption.3 b/tk/doc/GetOption.3
new file mode 100644
index 00000000000..1838ed4fae5
--- /dev/null
+++ b/tk/doc/GetOption.3
@@ -0,0 +1,46 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+Tk_Uid
+\fBTk_GetOption\fR(\fItkwin, name, class\fR)
+.SH ARGUMENTS
+.AS Tk_Window *class
+.AP Tk_Window tkwin in
+Token for window.
+.AP char *name in
+Name of desired option.
+.AP char *class in
+Class of desired option. Null means there is no class for
+this option; do lookup based on name only.
+.BE
+
+.SH DESCRIPTION
+.PP
+This procedure is invoked to retrieve an option from the database
+associated with \fItkwin\fR's main window. If there is an option
+for \fItkwin\fR that matches the given \fIname\fR or \fIclass\fR,
+then it is returned in the form of a Tk_Uid. If multiple options
+match \fIname\fR and \fIclass\fR, then the highest-priority one
+is returned. If no option matches, then NULL is returned.
+.PP
+\fBTk_GetOption\fR caches options related to \fItkwin\fR so that
+successive calls for the same \fItkwin\fR will execute much more
+quickly than successive calls for different windows.
+
+.SH KEYWORDS
+class, name, option, retrieve
diff --git a/tk/doc/GetPixels.3 b/tk/doc/GetPixels.3
new file mode 100644
index 00000000000..b4f3d389448
--- /dev/null
+++ b/tk/doc/GetPixels.3
@@ -0,0 +1,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.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.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
diff --git a/tk/doc/GetPixmap.3 b/tk/doc/GetPixmap.3
new file mode 100644
index 00000000000..777ba33e482
--- /dev/null
+++ b/tk/doc/GetPixmap.3
@@ -0,0 +1,56 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+Pixmap
+\fBTk_GetPixmap(\fIdisplay, d, width, height, depth\fB)\fR
+.sp
+\fBTk_FreePixmap(\fIdisplay, pixmap\fB)\fR
+.SH ARGUMENTS
+.AS "Drawable" *pixelPtr
+.AP Display *display in
+X display for the pixmap.
+.AP Drawable d in
+Pixmap or window where the new pixmap will be used for drawing.
+.AP "int" width in
+Width of pixmap.
+.AP "int" height in
+Height of pixmap.
+.AP "int" depth in
+Number of bits per pixel in pixmap.
+.AP Pixmap pixmap in
+Pixmap to destroy.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures are identical to the Xlib procedures \fBXCreatePixmap\fR
+and \fBXFreePixmap\fR, except that they have extra code to manage X
+resource identifiers so that identifiers for deleted pixmaps can be
+reused in the future.
+It is important for Tk applications to use these procedures rather
+than \fBXCreatePixmap\fR and \fBXFreePixmap\fR; otherwise long-running
+applications may run out of resource identifiers.
+.PP
+\fBTk_GetPixmap\fR creates a pixmap suitable for drawing in \fId\fR,
+with dimensions given by \fIwidth\fR, \fIheight\fR, and \fIdepth\fR,
+and returns its identifier.
+\fBTk_FreePixmap\fR destroys the pixmap given by \fIpixmap\fR and makes
+its resource identifier available for reuse.
+
+.SH KEYWORDS
+pixmap, resource identifier
diff --git a/tk/doc/GetRelief.3 b/tk/doc/GetRelief.3
new file mode 100644
index 00000000000..cfcde3737cb
--- /dev/null
+++ b/tk/doc/GetRelief.3
@@ -0,0 +1,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.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.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
diff --git a/tk/doc/GetRootCrd.3 b/tk/doc/GetRootCrd.3
new file mode 100644
index 00000000000..9726a382b54
--- /dev/null
+++ b/tk/doc/GetRootCrd.3
@@ -0,0 +1,43 @@
+'\"
+'\" 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$
+'\"
+.so man.macros
+.TH Tk_GetRootCoords 3 "" Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_GetRootCoords \- Compute root-window coordinates of window
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_GetRootCoords\fR(\fItkwin, xPtr, yPtr\fR)
+.SH ARGUMENTS
+.AS Tk_Window tkwin
+.AP Tk_Window tkwin in
+Token for window.
+.AP int *xPtr out
+Pointer to location in which to store root-window x-coordinate
+corresponding to left edge of \fItkwin\fR's border.
+.AP int *yPtr out
+Pointer to location in which to store root-window y-coordinate
+corresponding to top edge of \fItkwin\fR's border.
+.BE
+
+.SH DESCRIPTION
+.PP
+This procedure scans through the structural information maintained
+by Tk to compute the root-window coordinates corresponding to
+the upper-left corner of \fItkwin\fR's border. If \fItkwin\fR has
+no border, then \fBTk_GetRootCoords\fR returns the root-window
+coordinates corresponding to location (0,0) in \fItkwin\fR.
+\fBTk_GetRootCoords\fR is relatively efficient, since it doesn't have to
+communicate with the X server.
+
+.SH KEYWORDS
+coordinates, root window
diff --git a/tk/doc/GetScroll.3 b/tk/doc/GetScroll.3
new file mode 100644
index 00000000000..0a8a0e4dcbc
--- /dev/null
+++ b/tk/doc/GetScroll.3
@@ -0,0 +1,65 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+int
+\fBTk_GetScrollInfo(\fIinterp, argc, argv, dblPtr, intPtr\fB)\fR
+.SH ARGUMENTS
+.AS "Tcl_Interp" *dblPtr
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting.
+.AP int argc in
+Number of strings in \fIargv\fR array.
+.AP char *argv[] in
+Argument strings. These represent the entire widget command, of
+which the first word is typically the widget name and the second
+word is typically \fBxview\fR or \fByview\fR. This procedure parses
+arguments starting with \fIargv\fR[2].
+.AP double *dblPtr out
+Filled in with fraction from \fBmoveto\fR option, if any.
+.AP int *intPtr out
+Filled in with line or page count from \fBscroll\fR option, if any.
+The value may be negative.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_GetScrollInfo\fR parses the arguments expected by widget
+scrolling commands such as \fBxview\fR and \fByview\fR.
+It receives the entire list of words that make up a widget command
+and parses the words starting with \fIargv\fR[2].
+The words starting with \fIargv\fR[2] must have one of the following forms:
+.CS
+\fBmoveto \fIfraction\fR
+\fBscroll \fInumber\fB units\fR
+\fBscroll \fInumber\fB pages\fR
+.CE
+.LP
+Any of the \fBmoveto\fR, \fBscroll\fR, \fBunits\fR, and \fBpages\fR
+keywords may be abbreviated.
+If \fIargv\fR has the \fBmoveto\fR form, \fBTK_SCROLL_MOVETO\fR
+is returned as result and \fI*dblPtr\fR is filled in with the
+\fIfraction\fR argument to the command, which must be a proper real
+value.
+If \fIargv\fR has the \fBscroll\fR form, \fBTK_SCROLL_UNITS\fR
+or \fBTK_SCROLL_PAGES\fR is returned and \fI*intPtr\fR is filled
+in with the \fInumber\fR value, which must be a proper integer.
+If an error occurs in parsing the arguments, \fBTK_SCROLL_ERROR\fR
+is returned and an error message is left in \fIinterp->result\fR.
+
+.SH KEYWORDS
+parse, scrollbar, scrolling command, xview, yview
diff --git a/tk/doc/GetSelect.3 b/tk/doc/GetSelect.3
new file mode 100644
index 00000000000..92c03eb6f19
--- /dev/null
+++ b/tk/doc/GetSelect.3
@@ -0,0 +1,79 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+int
+\fBTk_GetSelection\fR(\fIinterp, tkwin, selection, target, proc, clientData\fR)
+.SH ARGUMENTS
+.AS Tk_GetSelProc clientData
+.AP Tcl_Interp *interp in
+Interpreter to use for reporting errors.
+.AP Tk_Window tkwin in
+Window on whose behalf to retrieve the selection (determines
+display from which to retrieve).
+.AP Atom selection in
+The name of the selection to be retrieved.
+.AP Atom target in
+Form in which to retrieve selection.
+.AP Tk_GetSelProc *proc in
+Procedure to invoke to process pieces of the selection as they
+are retrieved.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_GetSelection\fR retrieves the selection specified by the atom
+\fIselection\fR in the format specified by \fItarget\fR. The
+selection may actually be retrieved in several pieces; as each piece
+is retrieved, \fIproc\fR is called to process the piece. \fIProc\fR
+should have arguments and result that match the type
+\fBTk_GetSelProc\fR:
+.CS
+typedef int Tk_GetSelProc(
+ ClientData \fIclientData\fR,
+ Tcl_Interp *\fIinterp\fR,
+ char *\fIportion\fR);
+.CE
+The \fIclientData\fR and \fIinterp\fR parameters to \fIproc\fR
+will be copies of the corresponding arguments to
+\fBTk_GetSelection\fR. \fIPortion\fR will be a pointer to
+a string containing part or all of the selection. For large
+selections, \fIproc\fR will be called several times with successive
+portions of the selection. The X Inter-Client Communication
+Conventions Manual allows a selection to be returned in formats
+other than strings, e.g. as an array of atoms or integers. If
+this happens, Tk converts the selection back into a string
+before calling \fIproc\fR. If a selection is returned as an
+array of atoms, Tk converts it to a string containing the atom names
+separated by white space. For any other format besides string,
+Tk converts a selection to a string containing hexadecimal
+values separated by white space.
+.PP
+\fBTk_GetSelection\fR returns to its caller when the selection has
+been completely retrieved and processed by \fIproc\fR, or when a
+fatal error has occurred (e.g. the selection owner didn't respond
+promptly). \fBTk_GetSelection\fR normally returns TCL_OK; if
+an error occurs, it returns TCL_ERROR and leaves an error message
+in \fIinterp->result\fR. \fIProc\fR should also return either
+TCL_OK or TCL_ERROR. If \fIproc\fR encounters an error in dealing with the
+selection, it should leave an error message in \fIinterp->result\fR
+and return TCL_ERROR; this will abort the selection retrieval.
+
+.SH KEYWORDS
+format, get, selection retrieval
diff --git a/tk/doc/GetUid.3 b/tk/doc/GetUid.3
new file mode 100644
index 00000000000..77e896771dc
--- /dev/null
+++ b/tk/doc/GetUid.3
@@ -0,0 +1,50 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fB#typedef char *Tk_Uid\fR
+.sp
+Tk_Uid
+\fBTk_GetUid\fR(\fIstring\fR)
+.SH ARGUMENTS
+.AP char *string in
+String for which the corresponding unique identifier is
+desired.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_GetUid\fR returns the unique identifier corresponding
+to \fIstring\fR.
+Unique identifiers are similar to atoms in Lisp, and are used
+in Tk to speed up comparisons and
+searches. A unique identifier (type Tk_Uid) is a string pointer
+and may be used anywhere that a variable of type ``char *''
+could be used. However, there is guaranteed to be exactly
+one unique identifier for any given string value. If \fBTk_GetUid\fR
+is called twice, once with string \fIa\fR and once with string
+\fIb\fR, and if \fIa\fR and \fIb\fR have the same string value
+(strcmp(a, b) == 0), then \fBTk_GetUid\fR will return exactly
+the same Tk_Uid value for each call (Tk_GetUid(a) == Tk_GetUid(b)).
+This means that variables of type
+Tk_Uid may be compared directly (x == y) without having to call
+\fBstrcmp\fR.
+In addition, the return value from \fBTk_GetUid\fR will have the
+same string value as its argument (strcmp(Tk_GetUid(a), a) == 0).
+
+.SH KEYWORDS
+atom, unique identifier
diff --git a/tk/doc/GetVRoot.3 b/tk/doc/GetVRoot.3
new file mode 100644
index 00000000000..9cf7d1bd0f3
--- /dev/null
+++ b/tk/doc/GetVRoot.3
@@ -0,0 +1,49 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_GetVRootGeometry(\fItkwin, xPtr, yPtr, widthPtr, heightPtr\fB)\fR
+.SH ARGUMENTS
+.AS Tk_Window heightPtr
+.AP Tk_Window tkwin in
+Token for window whose virtual root is to be queried.
+.AP int xPtr out
+Points to word in which to store x-offset of virtual root.
+.AP int yPtr out
+Points to word in which to store y-offset of virtual root.
+.AP "int" widthPtr out
+Points to word in which to store width of virtual root.
+.AP "int" heightPtr out
+Points to word in which to store height of virtual root.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTkGetVRootGeometry\fR returns geometry information about the virtual
+root window associated with \fItkwin\fR. The ``associated'' virtual
+root is the one in which \fItkwin\fR's nearest top-level ancestor (or
+\fItkwin\fR itself if it is a top-level window) has
+been reparented by the window manager. This window is identified by
+a \fB__SWM_ROOT\fR or \fB__WM_ROOT\fR property placed on the top-level
+window by the window manager.
+If \fItkwin\fR is not associated with a virtual root (e.g.
+because the window manager doesn't use virtual roots) then *\fIxPtr\fR and
+*\fIyPtr\fR will be set to 0 and *\fIwidthPtr\fR and *\fIheightPtr\fR
+will be set to the dimensions of the screen containing \fItkwin\fR.
+
+.SH KEYWORDS
+geometry, height, location, virtual root, width, window manager
diff --git a/tk/doc/GetVisual.3 b/tk/doc/GetVisual.3
new file mode 100644
index 00000000000..c8a0f2c5e22
--- /dev/null
+++ b/tk/doc/GetVisual.3
@@ -0,0 +1,98 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+Visual *
+\fBTk_GetVisual(\fIinterp, tkwin, string, depthPtr, colormapPtr\fB)\fR
+.SH ARGUMENTS
+.AS "Tcl_Interp" *colormapPtr
+.AP Tcl_Interp *interp in
+Interpreter to use for error reporting.
+.AP Tk_Window tkwin in
+Token for window in which the visual will be used.
+.AP char *string in
+String that identifies the desired visual. See below for
+valid formats.
+.AP int *depthPtr out
+Depth of returned visual gets stored here.
+.AP Colormap *colormapPtr out
+If non-NULL then a suitable colormap for visual is found and its
+identifier is stored here.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_GetVisual\fR takes a string description of a visual and
+finds a suitable X Visual for use in \fItkwin\fR, if there is one.
+It returns a pointer to the X Visual structure for the visual
+and stores the number of bits per pixel for it at \fI*depthPtr\fR.
+If \fIstring\fR is unrecognizable or if no suitable visual could
+be found, then NULL is returned and \fBTk_GetVisual\fR leaves
+an error message in \fIinterp->result\fR.
+If \fIcolormap\fR is non-NULL then \fBTk_GetVisual\fR
+also locates an appropriate colormap for use with the result visual
+and stores its X identifier at \fI*colormapPtr\fR.
+.PP
+The \fIstring\fR argument specifies the desired visual in one
+of the following ways:
+.TP 15
+\fIclass depth\fR
+The string consists of a class name followed by an integer depth,
+with any amount of white space (including none) in between.
+\fIclass\fR selects what sort of visual is desired and must be one of
+\fBdirectcolor\fR, \fBgrayscale\fR, \fBgreyscale\fR, \fBpseudocolor\fR,
+\fBstaticcolor\fR, \fBstaticgray\fR, \fBstaticgrey\fR, or
+\fBtruecolor\fR, or a unique abbreviation.
+\fIdepth\fR specifies how many bits per pixel are needed for the
+visual.
+If possible, \fBTk_GetVisual\fR will return a visual with this depth;
+if there is no visual of the desired depth then \fBTk_GetVisual\fR
+looks first for a visual with greater depth, then one with less
+depth.
+.TP 15
+\fBdefault\fR
+Use the default visual for \fItkwin\fR's screen.
+.TP 15
+\fIpathName\fR
+Use the visual for the window given by \fIpathName\fR.
+\fIpathName\fR must be the name of a window on the same screen
+as \fItkwin\fR.
+.TP 15
+\fInumber\fR
+Use the visual whose X identifier is \fInumber\fR.
+.TP 15
+\fBbest\fR ?\fIdepth\fR?
+Choose the ``best possible'' visual, using the following rules, in
+decreasing order of priority:
+(a) a visual that has exactly the desired depth is best, followed
+by a visual with greater depth than requested (but as little extra
+as possible), followed by a visual with less depth than requested
+(but as great a depth as possible);
+(b) if no \fIdepth\fR is specified, then the deepest available visual
+is chosen;
+(c) \fBpseudocolor\fR is better than \fBtruecolor\fR or \fBdirectcolor\fR,
+which are better than \fBstaticcolor\fR, which is better than
+\fBstaticgray\fR or \fBgrayscale\fR;
+(d) the default visual for the screen is better than any other visual.
+
+.SH CREDITS
+.PP
+The idea for \fBTk_GetVisual\fR, and the first implementation, came
+from Paul Mackerras.
+
+.SH KEYWORDS
+colormap, screen, visual
diff --git a/tk/doc/HandleEvent.3 b/tk/doc/HandleEvent.3
new file mode 100644
index 00000000000..d139eeaf0a5
--- /dev/null
+++ b/tk/doc/HandleEvent.3
@@ -0,0 +1,49 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_HandleEvent\fR(\fIeventPtr\fR)
+.SH ARGUMENTS
+.AS XEvent *eventPtr
+.AP XEvent *eventPtr in
+Pointer to X event to dispatch to relevant handler(s).
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_HandleEvent\fR is a lower-level procedure that deals with window
+events. It is called by \fBTk_ServiceEvent\fR (and indirectly by
+\fBTk_DoOneEvent\fR), and in a few other cases within Tk.
+It makes callbacks to any window event
+handlers (created by calls to \fBTk_CreateEventHandler\fR)
+that match \fIeventPtr\fR and then returns. In some cases
+it may be useful for an application to bypass the Tk event
+queue and call \fBTk_HandleEvent\fR directly instead of
+calling \fBTk_QueueEvent\fR followed by
+\fBTk_ServiceEvent\fR.
+.PP
+This procedure may be invoked recursively. For example,
+it is possible to invoke \fBTk_HandleEvent\fR recursively
+from a handler called by \fBTk_HandleEvent\fR. This sort
+of operation is useful in some modal situations, such
+as when a
+notifier has been popped up and an application wishes to
+wait for the user to click a button in the notifier before
+doing anything else.
+
+.SH KEYWORDS
+callback, event, handler, window
diff --git a/tk/doc/IdToWindow.3 b/tk/doc/IdToWindow.3
new file mode 100644
index 00000000000..0755f35bbb9
--- /dev/null
+++ b/tk/doc/IdToWindow.3
@@ -0,0 +1,36 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+Tk_Window
+\fBTk_IdToWindow\fR(\fIdisplay, window\fR)
+.SH ARGUMENTS
+.AS Tk_Window display
+.AP Display *display in
+X display containing the window.
+.AP Window window in
+X id for window.
+.BE
+
+.SH DESCRIPTION
+.PP
+Given an X window identifier and the X display it corresponds to,
+this procedure returns the corresponding Tk_Window handle.
+If there is no Tk_Window corresponding to \fIwindow\fR then
+NULL is returned.
+
+.SH KEYWORDS
+X window id
diff --git a/tk/doc/ImgChanged.3 b/tk/doc/ImgChanged.3
new file mode 100644
index 00000000000..7588fb8cc4d
--- /dev/null
+++ b/tk/doc/ImgChanged.3
@@ -0,0 +1,69 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_ImageChanged\fR(\fIimageMaster, x, y, width, height, imageWidth, imageHeight\fR)
+.SH ARGUMENTS
+.AS Tk_ImageMaster imageHeight
+.AP Tk_ImageMaster imageMaster in
+Token for image, which was passed to image's \fIcreateProc\fR when
+the image was created.
+.AP int x in
+X-coordinate of upper-left corner of region that needs redisplay (measured
+from upper-left corner of image).
+.AP int y in
+Y-coordinate of upper-left corner of region that needs redisplay (measured
+from upper-left corner of image).
+.AP "int" width in
+Width of region that needs to be redrawn, in pixels.
+.AP "int" height in
+Height of region that needs to be redrawn, in pixels.
+.AP "int" imageWidth in
+Current width of image, in pixels.
+.AP "int" imageHeight in
+Current height of image, in pixels.
+.BE
+
+.SH DESCRIPTION
+.PP
+An image manager calls \fBTk_ImageChanged\fR for an image
+whenever anything happens that requires the image to be redrawn.
+As a result of calling \fBTk_ImageChanged\fR, any widgets using
+the image are notified so that they can redisplay themselves
+appropriately.
+The \fIimageMaster\fR argument identifies the image, and
+\fIx\fR, \fIy\fR, \fIwidth\fR, and \fIheight\fR
+specify a rectangular region within the image that needs to
+be redrawn.
+\fIimageWidth\fR and \fIimageHeight\fR specify the image's (new) size.
+.PP
+An image manager should call \fBTk_ImageChanged\fR during
+its \fIcreateProc\fR to specify the image's initial size and to
+force redisplay if there are existing instances for the image.
+If any of the pixel values in the image should change later on,
+\fBTk_ImageChanged\fR should be called again with \fIx\fR, \fIy\fR,
+\fIwidth\fR, and \fIheight\fR values that cover all the pixels
+that changed.
+If the size of the image should change, then \fBTk_ImageChanged\fR
+must be called to indicate the new size, even if no pixels
+need to be redisplayed.
+
+.SH "SEE ALSO"
+Tk_CreateImageType
+
+.SH KEYWORDS
+images, redisplay, image size changes
diff --git a/tk/doc/InternAtom.3 b/tk/doc/InternAtom.3
new file mode 100644
index 00000000000..0806415cafc
--- /dev/null
+++ b/tk/doc/InternAtom.3
@@ -0,0 +1,58 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+Atom
+\fBTk_InternAtom(\fItkwin, name\fR)
+.sp
+char *
+\fBTk_GetAtomName(\fItkwin, atom\fR)
+.SH ARGUMENTS
+.AS Tk_Window parent
+.AP Tk_Window tkwin in
+Token for window. Used to map atom or name relative to a particular display.
+.AP char *name in
+String name for which atom is desired.
+.AP Atom atom in
+Atom for which corresponding string name is desired.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures are similar to the Xlib procedures
+\fBXInternAtom\fR and \fBXGetAtomName\fR. \fBTk_InternAtom\fR
+returns the atom identifier associated with string given by
+\fIname\fR; the atom identifier is only valid for the display
+associated with \fItkwin\fR.
+\fBTk_GetAtomName\fR returns the string associated
+with \fIatom\fR on \fItkwin\fR's display. The string returned
+by \fBTk_GetAtomName\fR is in Tk's storage: the caller need
+not free this space when finished with the string, and the caller
+should not modify the contents of the returned string.
+If there is no atom \fIatom\fR on \fItkwin\fR's display,
+then \fBTk_GetAtomName\fR returns the string ``?bad atom?''.
+.PP
+Tk caches
+the information returned by \fBTk_InternAtom\fR and \fBTk_GetAtomName\fR
+so that future calls
+for the same information can be serviced from the cache without
+contacting the server. Thus \fBTk_InternAtom\fR and \fBTk_GetAtomName\fR
+are generally much faster than their Xlib counterparts, and they
+should be used in place of the Xlib procedures.
+
+.SH KEYWORDS
+atom, cache, display
diff --git a/tk/doc/MainLoop.3 b/tk/doc/MainLoop.3
new file mode 100644
index 00000000000..2cbe3c9d06b
--- /dev/null
+++ b/tk/doc/MainLoop.3
@@ -0,0 +1,32 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_MainLoop\fR()
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_MainLoop\fR is a procedure that loops repeatedly calling
+\fBTcl_DoOneEvent\fR. It returns only when there are no applications
+left in this process (i.e. no main windows exist anymore). Most
+windowing applications will call \fBTk_MainLoop\fR after
+initialization; the main execution of the application will consist
+entirely of callbacks invoked via \fBTcl_DoOneEvent\fR.
+
+.SH KEYWORDS
+application, event, main loop
diff --git a/tk/doc/MainWin.3 b/tk/doc/MainWin.3
new file mode 100644
index 00000000000..914a13a8f2c
--- /dev/null
+++ b/tk/doc/MainWin.3
@@ -0,0 +1,36 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+Tk_Window
+\fBTk_MainWindow\fR(\fIinterp\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *pathName
+.AP Tcl_Interp *interp in/out
+Interpreter associated with the application.
+.BE
+
+.SH DESCRIPTION
+.PP
+If \fIinterp\fR is associated with a Tk application then \fBTk_MainWindow\fR
+returns the application's main window.
+If there is no Tk application associated with \fIinterp\fR then
+\fBTk_MainWindow\fR returns NULL and leaves an error message
+in \fIinterp->result\fR.
+
+.SH KEYWORDS
+application, main window
diff --git a/tk/doc/MaintGeom.3 b/tk/doc/MaintGeom.3
new file mode 100644
index 00000000000..df1b5e5047b
--- /dev/null
+++ b/tk/doc/MaintGeom.3
@@ -0,0 +1,102 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_MaintainGeometry\fR(\fIslave, master, x, y, width, height\fR)
+.sp
+\fBTk_UnmaintainGeometry\fR(\fIslave, master\fR)
+.SH ARGUMENTS
+.AS Tk_Window master
+.AP Tk_Window slave in
+Window whose geometry is to be controlled.
+.AP Tk_Window master in
+Window relative to which \fIslave\fR's geometry will be controlled.
+.AP int x in
+Desired x-coordinate of \fIslave\fR in \fImaster\fR, measured in pixels
+from the inside of \fImaster\fR's left border to the outside of
+\fIslave\fR's left border.
+.AP int y in
+Desired y-coordinate of \fIslave\fR in \fImaster\fR, measured in pixels
+from the inside of \fImaster\fR's top border to the outside of
+\fIslave\fR's top border.
+.AP int width in
+Desired width for \fIslave\fR, in pixels.
+.AP int height in
+Desired height for \fIslave\fR, in pixels.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_MaintainGeometry\fR and \fBTk_UnmaintainGeometry\fR make it
+easier for geometry managers to deal with slaves whose masters are not
+their parents.
+Three problems arise if the master for a slave is not its parent:
+.IP [1]
+The x- and y-position of the slave must be translated from the
+coordinate system of the master to that of the parent before
+positioning the slave.
+.IP [2]
+If the master window, or any of its ancestors up to the slave's
+parent, is moved, then the slave must be repositioned within its
+parent in order to maintain the correct position relative to the
+master.
+.IP [3]
+If the master or one of its ancestors is mapped or unmapped, then
+the slave must be mapped or unmapped to correspond.
+.LP
+None of these problems is an issue if the parent and master are
+the same. For example, if the master or one of its ancestors
+is unmapped, the slave is automatically removed by the screen
+by X.
+.PP
+\fBTk_MaintainGeometry\fR deals with these problems for slaves
+whose masters aren't their parents.
+\fBTk_MaintainGeometry\fR is typically called by a window manager
+once it has decided where a slave should be positioned relative
+to its master.
+\fBTk_MaintainGeometry\fR translates the coordinates to the
+coordinate system of \fIslave\fR's parent and then moves and
+resizes the slave appropriately.
+Furthermore, it remembers the desired position and creates event
+handlers to monitor the master and all of its ancestors up
+to (but not including) the slave's parent.
+If any of these windows is moved, mapped, or unmapped,
+the slave will be adjusted so that it is mapped only when the
+master is mapped and its geometry relative to the master
+remains as specified by \fIx\fR, \fIy\fR, \fIwidth\fR, and
+\fIheight\fR.
+.PP
+When a window manager relinquishes control over a window, or
+if it decides that it does not want the window to appear on the
+screen under any conditions, it calls \fBTk_UnmaintainGeometry\fR.
+\fBTk_UnmaintainGeometry\fR unmaps the window and cancels any
+previous calls to \fBTk_MaintainGeometry\fR for the
+\fImaster\fR\-\fIslave\fR pair, so that the slave's
+geometry and mapped state are no longer maintained
+automatically.
+\fBTk_UnmaintainGeometry\fR need not be called by a geometry
+manager if the slave, the master, or any of the master's ancestors
+is destroyed: Tk will call it automatically.
+.PP
+If \fBTk_MaintainGeometry\fR is called repeatedly for the same
+\fImaster\fR\-\fIslave\fR pair, the information from the most
+recent call supersedes any older information.
+If \fBTk_UnmaintainGeometry\fR is called for a \fImaster\fR\-\fIslave\fR
+pair that is isn't currently managed, the call has no effect.
+
+.SH KEYWORDS
+geometry manager, map, master, parent, position, slave, unmap
diff --git a/tk/doc/ManageGeom.3 b/tk/doc/ManageGeom.3
new file mode 100644
index 00000000000..50e0c7aa682
--- /dev/null
+++ b/tk/doc/ManageGeom.3
@@ -0,0 +1,94 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_ManageGeometry\fR(\fItkwin, mgrPtr, clientData\fR)
+.SH ARGUMENTS
+.AS Tk_GeometryProc clientData
+.AP Tk_Window tkwin in
+Token for window to be managed.
+.AP Tk_GeomMgr *mgrPtr in
+Pointer to data structure containing information about the
+geometry manager, or NULL to indicate that \fItkwin\fR's geometry
+shouldn't be managed anymore.
+The data structure pointed to by \fImgrPtr\fR must be static:
+Tk keeps a reference to it as long as the window is managed.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to geometry manager callbacks.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_ManageGeometry\fR arranges for a particular geometry manager,
+described by the \fImgrPtr\fR argument, to control the geometry
+of a particular slave window, given by \fItkwin\fR.
+If \fItkwin\fR was previously managed by some other geometry manager,
+the previous manager loses control in favor of the new one.
+If \fImgrPtr\fR is NULL, geometry management is cancelled for
+\fItkwin\fR.
+.PP
+The structure pointed to by \fImgrPtr\fR contains information about
+the geometry manager:
+.CS
+typedef struct {
+ char *\fIname\fR;
+ Tk_GeomRequestProc *\fIrequestProc\fR;
+ Tk_GeomLostSlaveProc *\fIlostSlaveProc\fR;
+} Tk_GeomMgr;
+.CE
+The \fIname\fR field is the textual name for the geometry manager,
+such as \fBpack\fR or \fBplace\fR; this value will be returned
+by the command \fBwinfo manager\fR.
+.PP
+\fIrequestProc\fR is a procedure in the geometry manager that
+will be invoked whenever \fBTk_GeometryRequest\fR is called by the
+slave to change its desired geometry.
+\fIrequestProc\fR should have arguments and results that match the
+type \fBTk_GeomRequestProc\fR:
+.CS
+typedef void Tk_GeomRequestProc(
+ ClientData \fIclientData\fR,
+ Tk_Window \fItkwin\fR);
+.CE
+The parameters to \fIrequestProc\fR will be identical to the
+corresponding parameters passed to \fBTk_ManageGeometry\fR.
+\fIclientData\fR usually points to a data
+structure containing application-specific information about
+how to manage \fItkwin\fR's geometry.
+.PP
+The \fIlostSlaveProc\fR field of \fImgrPtr\fR points to another
+procedure in the geometry manager.
+Tk will invoke \fIlostSlaveProc\fR if some other manager
+calls \fBTk_ManageGeometry\fR to claim
+\fItkwin\fR away from the current geometry manager.
+\fIlostSlaveProc\fR is not invoked if \fBTk_ManageGeometry\fR is
+called with a NULL value for \fImgrPtr\fR (presumably the current
+geometry manager has made this call, so it already knows that the
+window is no longer managed), nor is it called if \fImgrPtr\fR
+is the same as the window's current geometry manager.
+\fIlostSlaveProc\fR should have
+arguments and results that match the following prototype:
+.CS
+typedef void Tk_GeomLostSlaveProc(
+ ClientData \fIclientData\fR,
+ Tk_Window \fItkwin\fR);
+.CE
+The parameters to \fIlostSlaveProc\fR will be identical to the
+corresponding parameters passed to \fBTk_ManageGeometry\fR.
+
+.SH KEYWORDS
+callback, geometry, managed, request, unmanaged
diff --git a/tk/doc/MapWindow.3 b/tk/doc/MapWindow.3
new file mode 100644
index 00000000000..452fb6eab44
--- /dev/null
+++ b/tk/doc/MapWindow.3
@@ -0,0 +1,53 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+Tk_Window
+\fBTk_MapWindow\fR(\fItkwin\fR)
+.sp
+\fBTk_UnmapWindow\fR(\fItkwin\fR)
+.SH ARGUMENTS
+.AS Tk_Window parent
+.AP Tk_Window tkwin in
+Token for window.
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures may be used to map and unmap windows
+managed by Tk. \fBTk_MapWindow\fR maps the window given
+by \fItkwin\fR, and also creates an X window corresponding
+to \fItkwin\fR if it doesn't already exist. See the
+\fBTk_CreateWindow\fR manual entry for information on
+deferred window creation.
+\fBTk_UnmapWindow\fR unmaps \fItkwin\fR's window
+from the screen.
+.PP
+If \fItkwin\fR is a child window (i.e. \fBTk_CreateChildWindow\fR was
+used to create it), then event handlers interested in map and unmap events
+are invoked immediately. If \fItkwin\fR isn't an internal window,
+then the event handlers will be invoked later, after X has seen
+the request and returned an event for it.
+.PP
+These procedures should be used in place of the X procedures
+\fBXMapWindow\fR and \fBXUnmapWindow\fR, since they update
+Tk's local data structure for \fItkwin\fR. Applications
+using Tk should not invoke \fBXMapWindow\fR and \fBXUnmapWindow\fR
+directly.
+
+.SH KEYWORDS
+map, unmap, window
diff --git a/tk/doc/MeasureChar.3 b/tk/doc/MeasureChar.3
new file mode 100644
index 00000000000..86424e61c2d
--- /dev/null
+++ b/tk/doc/MeasureChar.3
@@ -0,0 +1,130 @@
+'\"
+'\" 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$
+'\"
+.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
+space in pixels the given \fIstring\fR needs.
+.PP
+\fBTk_DrawChars\fR draws the \fIstring\fR at the given location in the
+given \fIdrawable\fR.
+.PP
+\fBTk_UnderlineChars\fR underlines the given range of characters in the
+given \fIstring\fR. It doesn't draw the characters (which are assumed to
+have been displayed previously by \fBTk_DrawChars\fR); it just draws the
+underline. This procedure is used to underline a few characters without
+having to construct an underlined font. To produce natively underlined
+text, the appropriate underlined font should be constructed and used.
+
+.SH KEYWORDS
+font
diff --git a/tk/doc/MoveToplev.3 b/tk/doc/MoveToplev.3
new file mode 100644
index 00000000000..b0b076f4ada
--- /dev/null
+++ b/tk/doc/MoveToplev.3
@@ -0,0 +1,55 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_MoveToplevelWindow(\fItkwin, x, y\fB)\fR
+.SH ARGUMENTS
+.AS Tk_Window tkwin
+.AP Tk_Window tkwin in
+Token for top-level window to move.
+.AP int x in
+New x-coordinate for the top-left pixel of \fItkwin\fR's border, or the
+top-left pixel of the decorative border supplied for \fItkwin\fR by the
+window manager, if there is one.
+.AP int y in
+New y-coordinate for the top-left pixel of \fItkwin\fR's border, or the
+top-left pixel of the decorative border supplied for \fItkwin\fR by the
+window manager, if there is one.
+.BE
+
+.SH DESCRIPTION
+.PP
+In general, a window should never set its own position; this should be
+done only by the geometry manger that is responsible for the window.
+For top-level windows the window manager is effectively the geometry
+manager; Tk provides interface code between the application and the
+window manager to convey the application's desires to the geometry
+manager. The desired size for a top-level window is conveyed using
+the usual \fBTk_GeometryRequest\fR mechanism. The procedure
+\fBTk_MoveToplevelWindow\fR may be used by an application to request
+a particular position for a top-level window; this procedure is
+similar in function to the \fBwm geometry\fR Tcl command except that
+negative offsets cannot be specified. It is invoked by widgets such as
+menus that want to appear at a particular place on the screen.
+.PP
+When \fBTk_MoveToplevelWindow\fR is called it doesn't immediately
+pass on the new desired location to the window manager; it defers
+this action until all other outstanding work has been completed,
+using the \fBTk_DoWhenIdle\fR mechanism.
+
+.SH KEYWORDS
+position, top-level window, window manager
diff --git a/tk/doc/Name.3 b/tk/doc/Name.3
new file mode 100644
index 00000000000..3aa86b637ae
--- /dev/null
+++ b/tk/doc/Name.3
@@ -0,0 +1,82 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+Tk_Uid
+\fBTk_Name\fR(\fItkwin\fR)
+.sp
+char *
+\fBTk_PathName\fR(\fItkwin\fR)
+.sp
+Tk_Window
+\fBTk_NameToWindow\fR(\fIinterp, pathName, tkwin\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *pathName
+.AP Tk_Window tkwin in
+Token for window.
+.AP Tcl_Interp *interp out
+Interpreter to use for error reporting.
+.AP char *pathName in
+Character string containing path name of window.
+.BE
+
+.SH DESCRIPTION
+.PP
+Each window managed by Tk has two names, a short name that identifies
+a window among children of the same parent, and a path name that
+identifies the window uniquely among all the windows belonging to the
+same main window. The path name is used more often in Tk than the
+short name; many commands, like \fBbind\fR, expect path names as
+arguments.
+.PP
+The \fBTk_Name\fR macro returns a window's
+short name, which is the same as the \fIname\fR argument
+passed to \fBTk_CreateWindow\fR when
+the window was created. The value is returned
+as a Tk_Uid, which may be used just like a string pointer but also has
+the properties of a unique identifier (see the manual entry for
+\fBTk_GetUid\fR for details).
+.PP
+The \fBTk_PathName\fR macro returns a
+hierarchical name for \fItkwin\fR.
+Path names have a structure similar to file names in Unix but with
+dots between elements instead of slashes: the main window for
+an application has the path name ``.''; its children have names like
+``.a'' and ``.b''; their children have names like ``.a.aa'' and
+``.b.bb''; and so on. A window is considered to be be a child of
+another window for naming purposes if the second window was named
+as the first window's \fIparent\fR when the first window was created.
+This is not always the same as the X window hierarchy. For
+example, a pop-up
+is created as a child of the root window, but its logical parent will
+usually be a window within the application.
+.PP
+The procedure \fBTk_NameToWindow\fR returns the token for a window
+given its path name (the \fIpathName\fR argument) and another window
+belonging to the same main window (\fItkwin\fR). It normally
+returns a token for the named window, but if no such window exists
+\fBTk_NameToWindow\fR leaves an error message in \fIinterp->result\fR
+and returns NULL. The \fItkwin\fR argument to \fBTk_NameToWindow\fR
+is needed because path names are only unique within a single
+application hierarchy. If, for example, a single process has opened
+two main windows, each will have a separate naming hierarchy and the
+same path name might appear in each of the hierarchies. Normally
+\fItkwin\fR is the main window of the desired hierarchy, but this
+need not be the case: any window in the desired hierarchy may be used.
+
+.SH KEYWORDS
+name, path name, token, window
diff --git a/tk/doc/NameOfImg.3 b/tk/doc/NameOfImg.3
new file mode 100644
index 00000000000..94b5f4b3428
--- /dev/null
+++ b/tk/doc/NameOfImg.3
@@ -0,0 +1,34 @@
+'\"
+'\" 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$
+'\"
+.so man.macros
+.TH Tk_NameOfImage 3 4.0 Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_NameOfImage \- Return name of image.
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+char *
+\fBTk_NameOfImage\fR(\fItypePtr\fR)
+.SH ARGUMENTS
+.AS Tk_ImageMaster *masterPtr
+.AP Tk_ImageMaster *masterPtr in
+Token for image, which was passed to image manager's \fIcreateProc\fR when
+the image was created.
+.BE
+
+.SH DESCRIPTION
+.PP
+This procedure is invoked by image managers to find out the name
+of an image. Given the token for the image, it returns the
+string name for the image.
+
+.SH KEYWORDS
+image manager, image name
diff --git a/tk/doc/OwnSelect.3 b/tk/doc/OwnSelect.3
new file mode 100644
index 00000000000..9b2e59d1e14
--- /dev/null
+++ b/tk/doc/OwnSelect.3
@@ -0,0 +1,52 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_OwnSelection\fR(\fItkwin, selection, proc, clientData\fR)
+.SH ARGUMENTS
+.AS Tk_LostSelProc clientData
+.AP Tk_Window tkwin in
+Window that is to become new selection owner.
+.AP Atom selection in
+The name of the selection to be owned, such as XA_PRIMARY.
+.AP Tk_LostSelProc *proc in
+Procedure to invoke when \fItkwin\fR loses selection ownership later.
+.AP ClientData clientData in
+Arbitrary one-word value to pass to \fIproc\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_OwnSelection\fR arranges for \fItkwin\fR to become the
+new owner of the selection specified by the atom
+\fIselection\fR. After this call completes, future requests
+for the selection will be directed to handlers created for
+\fItkwin\fR using \fBTk_CreateSelHandler\fR. When \fItkwin\fR
+eventually loses the selection ownership, \fIproc\fR will be
+invoked so that the window can clean itself up (e.g. by
+unhighlighting the selection). \fIProc\fR should have arguments and
+result that match the type \fBTk_LostSelProc\fR:
+.CS
+typedef void Tk_LostSelProc(ClientData \fIclientData\fR);
+.CE
+The \fIclientData\fR parameter to \fIproc\fR is a copy of the
+\fIclientData\fR argument given to \fBTk_OwnSelection\fR, and is
+usually a pointer to a data structure containing application-specific
+information about \fItkwin\fR.
+
+.SH KEYWORDS
+own, selection owner
diff --git a/tk/doc/ParseArgv.3 b/tk/doc/ParseArgv.3
new file mode 100644
index 00000000000..ba271bcad0a
--- /dev/null
+++ b/tk/doc/ParseArgv.3
@@ -0,0 +1,351 @@
+'\"
+'\" 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$
+'\"
+.so man.macros
+.TH Tk_ParseArgv 3 "" Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_ParseArgv \- process command-line options
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+int
+\fBTk_ParseArgv\fR(\fIinterp, tkwin, argcPtr, argv, argTable, flags\fR)
+.SH ARGUMENTS
+.AS Tk_ArgvInfo *argTable
+.AP Tcl_Interp *interp in
+Interpreter to use for returning error messages.
+.AP Tk_Window tkwin in
+Window to use when arguments specify Tk options. If NULL, then
+no Tk options will be processed.
+.AP int argcPtr in/out
+Pointer to number of arguments in argv; gets modified to hold
+number of unprocessed arguments that remain after the call.
+.AP char **argv in/out
+Command line arguments passed to main program. Modified to
+hold unprocessed arguments that remain after the call.
+.AP Tk_ArgvInfo *argTable in
+Array of argument descriptors, terminated by element with
+type TK_ARGV_END.
+.AP int flags in
+If non-zero, then it specifies one or more flags that control the
+parsing of arguments. Different flags may be OR'ed together.
+The flags currently defined are TK_ARGV_DONT_SKIP_FIRST_ARG,
+TK_ARGV_NO_ABBREV, TK_ARGV_NO_LEFTOVERS, and TK_ARGV_NO_DEFAULTS.
+.BE
+.SH DESCRIPTION
+.PP
+\fBTk_ParseArgv\fR processes an array of command-line arguments according
+to a table describing the kinds of arguments that are expected.
+Each of the arguments in \fIargv\fR is processed in turn: if it matches
+one of the entries in \fIargTable\fR, the argument is processed
+according to that entry and discarded. The arguments that do not
+match anything in \fIargTable\fR are copied down to the beginning
+of \fIargv\fR (retaining their original order) and returned to
+the caller. At the end of the call
+\fBTk_ParseArgv\fR sets \fI*argcPtr\fR to hold the number of
+arguments that are left in \fIargv\fR, and \fIargv[*argcPtr]\fR
+will hold the value NULL. Normally, \fBTk_ParseArgv\fR
+assumes that \fIargv[0]\fR is a command name, so it is treated like
+an argument that doesn't match \fIargTable\fR and returned to the
+caller; however, if the TK_ARGV_DONT_SKIP_FIRST_ARG bit is set in
+\fIflags\fR then \fIargv[0]\fR will be processed just like the other
+elements of \fIargv\fR.
+.PP
+\fBTk_ParseArgv\fR normally returns the value TCL_OK. If an error
+occurs while parsing the arguments, then TCL_ERROR is returned and
+\fBTk_ParseArgv\fR will leave an error message in \fIinterp->result\fR
+in the standard Tcl fashion. In
+the event of an error return, \fI*argvPtr\fR will not have been
+modified, but \fIargv\fR could have been partially modified. The
+possible causes of errors are explained below.
+.PP
+The \fIargTable\fR array specifies the kinds of arguments that are
+expected; each of its entries has the following structure:
+.CS
+typedef struct {
+ char *\fIkey\fR;
+ int \fItype\fR;
+ char *\fIsrc\fR;
+ char *\fIdst\fR;
+ char *\fIhelp\fR;
+} Tk_ArgvInfo;
+.CE
+The \fIkey\fR field is a string such as ``\-display'' or ``\-bg''
+that is compared with the values in \fIargv\fR. \fIType\fR
+indicates how to process an argument that matches \fIkey\fR
+(more on this below). \fISrc\fR and \fIdst\fR are additional
+values used in processing the argument. Their exact usage
+depends on \fItype\fR, but typically \fIsrc\fR indicates
+a value and \fIdst\fR indicates where to store the
+value. The \fBchar *\fR declarations for \fIsrc\fR and \fIdst\fR
+are placeholders: the actual types may be different. Lastly,
+\fIhelp\fR is a string giving a brief description
+of this option; this string is printed when users ask for help
+about command-line options.
+.PP
+When processing an argument in \fIargv\fR, \fBTk_ParseArgv\fR
+compares the argument to each of the \fIkey\fR's in \fIargTable\fR.
+\fBTk_ParseArgv\fR selects the first specifier whose \fIkey\fR matches
+the argument exactly, if such a specifier exists. Otherwise
+\fBTk_ParseArgv\fR selects a specifier for which the argument
+is a unique abbreviation. If the argument is a unique abbreviation
+for more than one specifier, then an error is returned. If there
+is no matching entry in \fIargTable\fR, then the argument is
+skipped and returned to the caller.
+.PP
+Once a matching argument specifier is found, \fBTk_ParseArgv\fR
+processes the argument according to the \fItype\fR field of the
+specifier. The argument that matched \fIkey\fR is called ``the matching
+argument'' in the descriptions below. As part of the processing,
+\fBTk_ParseArgv\fR may also use the next argument in \fIargv\fR
+after the matching argument, which is called ``the following
+argument''. The legal values for \fItype\fR, and the processing
+that they cause, are as follows:
+.TP
+\fBTK_ARGV_END\fR
+Marks the end of the table. The last entry in \fIargTable\fR
+must have this type; all of its other fields are ignored and it
+will never match any arguments.
+.TP
+\fBTK_ARGV_CONSTANT\fR
+\fISrc\fR is treated as an integer and \fIdst\fR is treated
+as a pointer to an integer. \fISrc\fR is stored at \fI*dst\fR.
+The matching argument is discarded.
+.TP
+\fBTK_ARGV_INT\fR
+The following argument must contain an
+integer string in the format accepted by \fBstrtol\fR (e.g. ``0''
+and ``0x'' prefixes may be used to specify octal or hexadecimal
+numbers, respectively). \fIDst\fR is treated as a pointer to an
+integer; the following argument is converted to an integer value
+and stored at \fI*dst\fR. \fISrc\fR is ignored. The matching
+and following arguments are discarded from \fIargv\fR.
+.TP
+\fBTK_ARGV_FLOAT\fR
+The following argument must contain a floating-point number in
+the format accepted by \fBstrtol\fR.
+\fIDst\fR is treated as the address of an double-precision
+floating point value; the following argument is converted to a
+double-precision value and stored at \fI*dst\fR. The matching
+and following arguments are discarded from \fIargv\fR.
+.TP
+\fBTK_ARGV_STRING\fR
+In this form, \fIdst\fR is treated as a pointer to a (char *);
+\fBTk_ParseArgv\fR stores at \fI*dst\fR a pointer to the following
+argument, and discards the matching and following arguments from
+\fIargv\fR. \fISrc\fR is ignored.
+.TP
+\fBTK_ARGV_UID\fR
+This form is similar to TK_ARGV_STRING, except that the argument
+is turned into a Tk_Uid by calling \fBTk_GetUid\fR.
+\fIDst\fR is treated as a pointer to a
+Tk_Uid; \fBTk_ParseArgv\fR stores at \fI*dst\fR the Tk_Uid
+corresponding to the following
+argument, and discards the matching and following arguments from
+\fIargv\fR. \fISrc\fR is ignored.
+.TP
+\fBTK_ARGV_CONST_OPTION\fR
+This form causes a Tk option to be set (as if the \fBoption\fR
+command had been invoked). The \fIsrc\fR field is treated as a
+pointer to a string giving the value of an option, and \fIdst\fR
+is treated as a pointer to the name of the option. The matching
+argument is discarded. If \fItkwin\fR is NULL, then argument
+specifiers of this type are ignored (as if they did not exist).
+.TP
+\fBTK_ARGV_OPTION_VALUE\fR
+This form is similar to TK_ARGV_CONST_OPTION, except that the
+value of the option is taken from the following argument instead
+of from \fIsrc\fR. \fIDst\fR is used as the name of the option.
+\fISrc\fR is ignored. The matching and following arguments
+are discarded. If \fItkwin\fR is NULL, then argument
+specifiers of this type are ignored (as if they did not exist).
+.TP
+\fBTK_ARGV_OPTION_NAME_VALUE\fR
+In this case the following argument is taken as the name of a Tk
+option and the argument after that is taken as the value for that
+option. Both \fIsrc\fR and \fIdst\fR are ignored. All three
+arguments are discarded from \fIargv\fR. If \fItkwin\fR is NULL,
+then argument
+specifiers of this type are ignored (as if they did not exist).
+.TP
+\fBTK_ARGV_HELP\fR
+When this kind of option is encountered, \fBTk_ParseArgv\fR uses the
+\fIhelp\fR fields of \fIargTable\fR to format a message describing
+all the valid arguments. The message is placed in \fIinterp->result\fR
+and \fBTk_ParseArgv\fR returns TCL_ERROR. When this happens, the
+caller normally prints the help message and aborts. If the \fIkey\fR
+field of a TK_ARGV_HELP specifier is NULL, then the specifier will
+never match any arguments; in this case the specifier simply provides
+extra documentation, which will be included when some other
+TK_ARGV_HELP entry causes help information to be returned.
+.TP
+\fBTK_ARGV_REST\fR
+This option is used by programs or commands that allow the last
+several of their options to be the name and/or options for some
+other program. If a \fBTK_ARGV_REST\fR argument is found, then
+\fBTk_ParseArgv\fR doesn't process any
+of the remaining arguments; it returns them all at
+the beginning of \fIargv\fR (along with any other unprocessed arguments).
+In addition, \fBTk_ParseArgv\fR treats \fIdst\fR as the address of an
+integer value, and stores at \fI*dst\fR the index of the first of the
+\fBTK_ARGV_REST\fR options in the returned \fIargv\fR. This allows the
+program to distinguish the \fBTK_ARGV_REST\fR options from other
+unprocessed options that preceded the \fBTK_ARGV_REST\fR.
+.TP
+\fBTK_ARGV_FUNC\fR
+For this kind of argument, \fIsrc\fR is treated as the address of
+a procedure, which is invoked to process the following argument.
+The procedure should have the following structure:
+.RS
+.CS
+int
+\fIfunc\fR(\fIdst\fR, \fIkey\fR, \fInextArg\fR)
+ char *\fIdst\fR;
+ char *\fIkey\fR;
+ char *\fInextArg\fR;
+{
+}
+.CE
+The \fIdst\fR and \fIkey\fR parameters will contain the
+corresponding fields from the \fIargTable\fR entry, and
+\fInextArg\fR will point to the following argument from \fIargv\fR
+(or NULL if there aren't any more arguments left in \fIargv\fR).
+If \fIfunc\fR uses \fInextArg\fR (so that
+\fBTk_ParseArgv\fR should discard it), then it should return 1. Otherwise it
+should return 0 and \fBTkParseArgv\fR will process the following
+argument in the normal fashion. In either event the matching argument
+is discarded.
+.RE
+.TP
+\fBTK_ARGV_GENFUNC\fR
+This form provides a more general procedural escape. It treats
+\fIsrc\fR as the address of a procedure, and passes that procedure
+all of the remaining arguments. The procedure should have the following
+form:
+.RS
+.CS
+int
+\fIgenfunc\fR(dst, interp, key, argc, argv)
+ char *\fIdst\fR;
+ Tcl_Interp *\fIinterp\fR;
+ char *\fIkey\fR;
+ int \fIargc\fR;
+ char **\fIargv\fR;
+{
+}
+.CE
+The \fIdst\fR and \fIkey\fR parameters will contain the
+corresponding fields from the \fIargTable\fR entry. \fIInterp\fR
+will be the same as the \fIinterp\fR argument to \fBTcl_ParseArgv\fR.
+\fIArgc\fR and \fIargv\fR refer to all of the options after the
+matching one. \fIGenfunc\fR should behave in a fashion similar
+to \fBTk_ParseArgv\fR: parse as many of the remaining arguments as it can,
+then return any that are left by compacting them to the beginning of
+\fIargv\fR (starting at \fIargv\fR[0]). \fIGenfunc\fR
+should return a count of how many arguments are left in \fIargv\fR;
+\fBTk_ParseArgv\fR will process them. If \fIgenfunc\fR encounters
+an error then it should leave an error message in \fIinterp->result\fR,
+in the usual Tcl fashion, and return -1; when this happens
+\fBTk_ParseArgv\fR will abort its processing and return TCL_ERROR.
+.RE
+
+.SH "FLAGS"
+.TP
+\fBTK_ARGV_DONT_SKIP_FIRST_ARG\fR
+\fBTk_ParseArgv\fR normally treats \fIargv[0]\fR as a program
+or command name, and returns it to the caller just as if it
+hadn't matched \fIargTable\fR. If this flag is given, then
+\fIargv[0]\fR is not given special treatment.
+.TP
+\fBTK_ARGV_NO_ABBREV\fR
+Normally, \fBTk_ParseArgv\fR accepts unique abbreviations for
+\fIkey\fR values in \fIargTable\fR. If this flag is given then
+only exact matches will be acceptable.
+.TP
+\fBTK_ARGV_NO_LEFTOVERS\fR
+Normally, \fBTk_ParseArgv\fR returns unrecognized arguments to the
+caller. If this bit is set in \fIflags\fR then \fBTk_ParseArgv\fR
+will return an error if it encounters any argument that doesn't
+match \fIargTable\fR. The only exception to this rule is \fIargv[0]\fR,
+which will be returned to the caller with no errors as
+long as TK_ARGV_DONT_SKIP_FIRST_ARG isn't specified.
+.TP
+\fBTK_ARGV_NO_DEFAULTS\fR
+Normally, \fBTk_ParseArgv\fR searches an internal table of
+standard argument specifiers in addition to \fIargTable\fR. If
+this bit is set in \fIflags\fR, then \fBTk_ParseArgv\fR will
+use only \fIargTable\fR and not its default table.
+
+.SH EXAMPLE
+.PP
+Here is an example definition of an \fIargTable\fR and
+some sample command lines that use the options. Note the effect
+on \fIargc\fR and \fIargv\fR; arguments processed by \fBTk_ParseArgv\fR
+are eliminated from \fIargv\fR, and \fIargc\fR
+is updated to reflect reduced number of arguments.
+.CS
+/*
+ * Define and set default values for globals.
+ */
+int debugFlag = 0;
+int numReps = 100;
+char defaultFileName[] = "out";
+char *fileName = defaultFileName;
+Boolean exec = FALSE;
+
+/*
+ * Define option descriptions.
+ */
+Tk_ArgvInfo argTable[] = {
+ {"-X", TK_ARGV_CONSTANT, (char *) 1, (char *) &debugFlag,
+ "Turn on debugging printfs"},
+ {"-N", TK_ARGV_INT, (char *) NULL, (char *) &numReps,
+ "Number of repetitions"},
+ {"-of", TK_ARGV_STRING, (char *) NULL, (char *) &fileName,
+ "Name of file for output"},
+ {"x", TK_ARGV_REST, (char *) NULL, (char *) &exec,
+ "File to exec, followed by any arguments (must be last argument)."},
+ {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
+ (char *) NULL}
+};
+
+main(argc, argv)
+ int argc;
+ char *argv[];
+{
+ \&...
+
+ if (Tk_ParseArgv(interp, tkwin, &argc, argv, argTable, 0) != TCL_OK) {
+ fprintf(stderr, "%s\en", interp->result);
+ exit(1);
+ }
+
+ /*
+ * Remainder of the program.
+ */
+}
+.CE
+.PP
+Note that default values can be assigned to variables named in
+\fIargTable\fR: the variables will only be overwritten if the
+particular arguments are present in \fIargv\fR.
+Here are some example command lines and their effects.
+.CS
+prog -N 200 infile # just sets the numReps variable to 200
+prog -of out200 infile # sets fileName to reference "out200"
+prog -XN 10 infile # sets the debug flag, also sets numReps
+.CE
+In all of the above examples, \fIargc\fR will be set by \fBTk_ParseArgv\fR to 2,
+\fIargv\fR[0] will be ``prog'', \fIargv\fR[1] will be ``infile'',
+and \fIargv\fR[2] will be NULL.
+
+.SH KEYWORDS
+arguments, command line, options
diff --git a/tk/doc/QWinEvent.3 b/tk/doc/QWinEvent.3
new file mode 100644
index 00000000000..35ce8ca6e15
--- /dev/null
+++ b/tk/doc/QWinEvent.3
@@ -0,0 +1,42 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_QueueWindowEvent\fR(\fIeventPtr, position\fR)
+.SH ARGUMENTS
+.AS Tcl_QueuePosition position
+.AP XEvent *eventPtr in
+An event to add to the event queue.
+.AP Tcl_QueuePosition position in
+Where to add the new event in the queue: \fBTCL_QUEUE_TAIL\fR,
+\fBTCL_QUEUE_HEAD\fR, or \fBTCL_QUEUE_MARK\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+This procedure places a window event on Tcl's
+internal event queue for eventual servicing. It creates a
+Tcl_Event structure, copies the event into that structure,
+and calls \fBTcl_QueueEvent\fR to add the event to the queue.
+When the event is eventually removed from the queue it is
+processed just like all window events.
+.PP
+The \fIposition\fR argument to \fBTk_QueueWindowEvent\fR has
+the same significance as for \fBTcl_QueueEvent\fR; see the
+documentation for \fBTcl_QueueEvent\fR for details.
+
+.SH KEYWORDS
+callback, clock, handler, modal timeout
diff --git a/tk/doc/Restack.3 b/tk/doc/Restack.3
new file mode 100644
index 00000000000..6389d09d36f
--- /dev/null
+++ b/tk/doc/Restack.3
@@ -0,0 +1,49 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+int
+\fBTk_RestackWindow\fR(\fItkwin, aboveBelow, other\fR)
+.SH ARGUMENTS
+.AS Tk_Window aboveBelow
+.AP Tk_Window tkwin in
+Token for window to restack.
+.AP int aboveBelow in
+Indicates new position of \fItkwin\fR relative to \fIother\fR;
+must be \fBAbove\fR or \fBBelow\fR.
+.AP Tk_Window other in
+\fITkwin\fR will be repositioned just above or below this window.
+Must be a sibling of \fItkwin\fR or a descendant of a sibling.
+If NULL then \fItkwin\fR is restacked above or below all siblings.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_RestackWindow\fR changes the stacking order of \fIwindow\fR relative
+to its siblings.
+If \fIother\fR is specified as NULL then \fIwindow\fR is repositioned
+at the top or bottom of its stacking order, depending on whether
+\fIaboveBelow\fR is \fBAbove\fR or \fBBelow\fR.
+If \fIother\fR has a non-NULL value then \fIwindow\fR is repositioned
+just above or below \fIother\fR.
+.PP
+The \fIaboveBelow\fR argument must have one of the symbolic values
+\fBAbove\fR or \fBBelow\fR.
+Both of these values are defined by the include file <X11/Xlib.h>.
+
+.SH KEYWORDS
+above, below, obscure, stacking order
diff --git a/tk/doc/RestrictEv.3 b/tk/doc/RestrictEv.3
new file mode 100644
index 00000000000..cb5653fe03a
--- /dev/null
+++ b/tk/doc/RestrictEv.3
@@ -0,0 +1,81 @@
+'\"
+'\" 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$
+'\"
+.so man.macros
+.TH Tk_RestrictEvents 3 "" Tk "Tk Library Procedures"
+.BS
+.SH NAME
+Tk_RestrictEvents \- filter and selectively delay X events
+.SH SYNOPSIS
+.nf
+\fB#include <tk.h>\fR
+.sp
+Tk_RestrictProc *
+\fBTk_RestrictEvents\fR(\fIproc, clientData, prevClientDataPtr\fR)
+.SH ARGUMENTS
+.AS Tk_RestrictProc **prevClientDataPtr
+.AP Tk_RestrictProc *proc in
+Predicate procedure to call to filter incoming X events.
+NULL means do not restrict events at all.
+.AP ClientData clientData in
+Arbitrary argument to pass to \fIproc\fR.
+.AP ClientData *prevClientDataPtr out
+Pointer to place to save argument to previous restrict procedure.
+.BE
+
+.SH DESCRIPTION
+.PP
+This procedure is useful in certain situations where applications
+are only prepared to receive certain X events. After
+\fBTk_RestrictEvents\fR is called, \fBTk_DoOneEvent\fR (and
+hence \fBTk_MainLoop\fR) will filter X input events through
+\fIproc\fR. \fIProc\fR indicates whether a
+given event is to be processed immediately, deferred until some
+later time (e.g. when the event restriction is lifted), or discarded.
+\fIProc\fR
+is a procedure with arguments and result that match
+the type \fBTk_RestrictProc\fR:
+.CS
+typedef Tk_RestrictAction Tk_RestrictProc(
+ ClientData \fIclientData\fR,
+ XEvent *\fIeventPtr\fR);
+.CE
+The \fIclientData\fR argument is a copy of the \fIclientData\fR passed
+to \fBTk_RestrictEvents\fR; it may be used to provide \fIproc\fR with
+information it needs to filter events. The \fIeventPtr\fR points to
+an event under consideration. \fIProc\fR returns a restrict action
+(enumerated type \fBTk_RestrictAction\fR) that indicates what
+\fBTk_DoOneEvent\fR should do with the event. If the return value is
+\fBTK_PROCESS_EVENT\fR, then the event will be handled immediately.
+If the return value is \fBTK_DEFER_EVENT\fR, then the event will be
+left on the event queue for later processing. If the return value is
+\fBTK_DISCARD_EVENT\fR, then the event will be removed from the event
+queue and discarded without being processed.
+.PP
+\fBTk_RestrictEvents\fR uses its return value and \fIprevClientDataPtr\fR
+to return information about the current event restriction procedure
+(a NULL return value means there are currently no restrictions).
+These values may be used to restore the previous restriction state
+when there is no longer any need for the current restriction.
+.PP
+There are very few places where \fBTk_RestrictEvents\fR is needed.
+In most cases, the best way to restrict events is by changing the
+bindings with the \fBbind\fR Tcl command or by calling
+\fBTk_CreateEventHandler\fR and \fBTk_DeleteEventHandler\fR from C.
+The main place where \fBTk_RestrictEvents\fR must be used is when
+performing synchronous actions (for example, if you need to wait
+for a particular event to occur on a particular window but you don't
+want to invoke any handlers for any other events). The ``obvious''
+solution in these situations is to call \fBXNextEvent\fR or
+\fBXWindowEvent\fR, but these procedures cannot be used because
+Tk keeps its own event queue that is separate from the X event
+queue. Instead, call \fBTk_RestrictEvents\fR to set up a filter,
+then call \fBTk_DoOneEvent\fR to retrieve the desired event(s).
+.SH KEYWORDS
+delay, event, filter, restriction
diff --git a/tk/doc/SetAppName.3 b/tk/doc/SetAppName.3
new file mode 100644
index 00000000000..978ab823d17
--- /dev/null
+++ b/tk/doc/SetAppName.3
@@ -0,0 +1,65 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+char *
+\fBTk_SetAppName\fR(\fItkwin, name\fR)
+.SH ARGUMENTS
+.AS Tk_Window parent
+.AP Tk_Window tkwin in
+Token for window in application. Used only to select a particular
+application.
+.AP char *name in
+Name under which to register the application.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_SetAppName\fR associates a name with a given application and
+records that association on the display containing with the application's
+main window.
+After this procedure has been invoked, other applications on the
+display will be able to use the \fBsend\fR command to invoke operations
+in the application.
+If \fIname\fR is already in use by some other application on the
+display, then a new name will be generated by appending
+``\fB #2\fR'' to \fIname\fR; if this name is also in use,
+the number will be incremented until an unused name is found.
+The return value from the procedure is a pointer to the name actually
+used.
+.PP
+If the application already has a name when \fBTk_SetAppName\fR is
+called, then the new name replaces the old name.
+.PP
+\fBTk_SetAppName\fR also adds a \fBsend\fR command to the application's
+interpreter, which can be used to send commands from this application
+to others on any of the displays where the application has windows.
+.PP
+The application's name registration persists until the interpreter is
+deleted or the \fBsend\fR command is deleted from \fIinterp\fR, at which
+point the name is automatically unregistered and the application
+becomes inaccessible via \fBsend\fR.
+The application can be made accessible again by calling \fBTk_SetAppName\fR.
+.PP
+\fBTk_SetAppName\fR is called automatically by \fBTk_Init\fR,
+so applications don't normally need to call it explicitly.
+.PP
+The command \fBtk appname\fR provides Tcl-level access to the
+functionality of \fBTk_SetAppName\fR.
+
+.SH KEYWORDS
+application, name, register, send command
diff --git a/tk/doc/SetClass.3 b/tk/doc/SetClass.3
new file mode 100644
index 00000000000..9b2f9814724
--- /dev/null
+++ b/tk/doc/SetClass.3
@@ -0,0 +1,61 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_SetClass\fR(\fItkwin, class\fR)
+.sp
+Tk_Uid
+\fBTk_Class\fR(\fItkwin\fR)
+.SH ARGUMENTS
+.AS Tk_Window parent
+.AP Tk_Window tkwin in
+Token for window.
+.AP char *class in
+New class name for window.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_SetClass\fR is called to associate a class with a particular
+window. The \fIclass\fR string identifies the type of the
+window; all windows with the same general class of behavior
+(button, menu, etc.) should have the same class. By
+convention all class names start with a capital letter, and
+there exists a Tcl command with the same name as
+each class (except all in lower-case) which can be used to
+create and manipulate windows of that class.
+A window's class string is initialized to NULL
+when the window is created.
+.PP
+For main windows, Tk automatically propagates the name and class
+to the WM_CLASS property used by window managers. This happens
+either when a main window is actually created (e.g. in
+\fBTk_MakeWindowExist\fR), or when \fBTk_SetClass\fR
+is called, whichever occurs later. If a main window has not been
+assigned a class then Tk will not set the WM_CLASS property for
+the window.
+.PP
+\fBTk_Class\fR is a macro that returns the
+current value of \fItkwin\fR's class. The value is returned
+as a Tk_Uid, which may be used just like a string pointer but also has
+the properties of a unique identifier (see the manual entry for
+\fBTk_GetUid\fR for details).
+If \fItkwin\fR has not yet been given a class, then
+\fBTk_Class\fR will return NULL.
+
+.SH KEYWORDS
+class, unique identifier, window, window manager
diff --git a/tk/doc/SetGrid.3 b/tk/doc/SetGrid.3
new file mode 100644
index 00000000000..d867ca4c3ee
--- /dev/null
+++ b/tk/doc/SetGrid.3
@@ -0,0 +1,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.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_SetGrid\fR(\fItkwin, reqWidth, reqHeight, widthInc, heightInc\fR)
+.sp
+\fBTk_UnsetGrid\fR(\fItkwin\fR)
+.SH ARGUMENTS
+.AS Tk_Window heightInc
+.AP Tk_Window tkwin in
+Token for window.
+.AP int reqWidth in
+Width in grid units that corresponds to the pixel dimension \fItkwin\fR
+has requested via \fBTk_GeometryRequest\fR.
+.AP int reqHeight in
+Height in grid units that corresponds to the pixel dimension \fItkwin\fR
+has requested via \fBTk_GeometryRequest\fR.
+.AP int widthInc in
+Width of one grid unit, in pixels.
+.AP int heightInc in
+Height of one grid unit, in pixels.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_SetGrid\fR turns on gridded geometry management for \fItkwin\fR's
+toplevel window and specifies the geometry of the grid.
+\fBTk_SetGrid\fR is typically invoked by a widget when its \fBsetGrid\fR
+option is true.
+It restricts interactive resizing of \fItkwin\fR's toplevel window so
+that the space allocated to the toplevel is equal to its requested
+size plus or minus even multiples of \fIwidthInc\fR and \fIheightInc\fR.
+Furthermore, the \fIreqWidth\fR and \fIreqHeight\fR values are
+passed to the window manager so that it can report the window's
+size in grid units during interactive resizes.
+If \fItkwin\fR's configuration changes (e.g., the size of a grid unit
+changes) then the widget should invoke \fBTk_SetGrid\fR again with the new
+information.
+.PP
+\fBTk_UnsetGrid\fR cancels gridded geometry management for
+\fItkwin\fR's toplevel window.
+.PP
+For each toplevel window there can be at most one internal window
+with gridding enabled.
+If \fBTk_SetGrid\fR or \fBTk_UnsetGrid\fR is invoked when some
+other window is already controlling gridding for \fItkwin\fR's
+toplevel, the calls for the new window have no effect.
+.PP
+See the \fBwm\fR manual entry for additional information on gridded geometry
+management.
+
+.SH KEYWORDS
+grid, window, window manager
diff --git a/tk/doc/SetVisual.3 b/tk/doc/SetVisual.3
new file mode 100644
index 00000000000..8895d3a36f9
--- /dev/null
+++ b/tk/doc/SetVisual.3
@@ -0,0 +1,54 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+int
+\fBTk_SetWindowVisual\fR(\fItkwin, visual, depth, colormap\fR)
+.SH ARGUMENTS
+.AS "Tk_Window int" colormap
+.AP Tk_Window tkwin in
+Token for window.
+.AP Visual *visual in
+New visual type to use for \fItkwin\fR.
+.AP "int" depth in
+Number of bits per pixel desired for \fItkwin\fR.
+.AP Colormap colormap in
+New colormap for \fItkwin\fR, which must be compatible with
+\fIvisual\fR and \fIdepth\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+When Tk creates a new window it assigns it the default visual
+characteristics (visual, depth, and colormap) for its screen.
+\fBTk_SetWindowVisual\fR may be called to change them.
+\fBTk_SetWindowVisual\fR must be called before the window has
+actually been created in X (e.g. before \fBTk_MapWindow\fR or
+\fBTk_MakeWindowExist\fR has been invoked for the window).
+The safest thing is to call \fBTk_SetWindowVisual\fR immediately
+after calling \fBTk_CreateWindow\fR.
+If \fItkwin\fR has already been created before \fBTk_SetWindowVisual\fR
+is called then it returns 0 and doesn't make any changes; otherwise
+it returns 1 to signify that the operation
+completed successfully.
+.PP
+Note: \fBTk_SetWindowVisual\fR should not be called if you just want
+to change a window's colormap without changing its visual or depth;
+call \fBTk_SetWindowColormap\fR instead.
+
+.SH KEYWORDS
+colormap, depth, visual
diff --git a/tk/doc/StrictMotif.3 b/tk/doc/StrictMotif.3
new file mode 100644
index 00000000000..24c99051a2a
--- /dev/null
+++ b/tk/doc/StrictMotif.3
@@ -0,0 +1,41 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+int
+\fBTk_StrictMotif\fR(\fItkwin\fR)
+.SH ARGUMENTS
+.AS Tk_Window tkwin
+.AP Tk_Window tkwin in
+Token for window.
+.BE
+
+.SH DESCRIPTION
+.PP
+This procedure returns the current value of the \fBtk_strictMotif\fR
+variable in the interpreter associated with \fItkwin\fR's application.
+The value is returned as an integer that is either 0 or 1.
+1 means that strict Motif compliance has been requested, so anything
+that is not part of the Motif specification should be avoided.
+0 means that ``Motif-like'' is good enough, and extra features
+are welcome.
+.PP
+This procedure uses a link to the Tcl variable to provide much
+faster access to the variable's value than could be had by calling
+\fBTcl_GetVar\fR.
+
+.SH KEYWORDS
+Motif compliance, tk_strictMotif variable
diff --git a/tk/doc/TextLayout.3 b/tk/doc/TextLayout.3
new file mode 100644
index 00000000000..31665ffce5c
--- /dev/null
+++ b/tk/doc/TextLayout.3
@@ -0,0 +1,270 @@
+'\"
+'\" 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$
+'\"
+.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
+Tk_TextLayout
+\fBTk_ComputeTextLayout(\fItkfont, string, numChars, wrapLength, justify, flags, widthPtr, heightPtr\fB)\fR
+.sp
+void
+\fBTk_FreeTextLayout(\fIlayout\fB)\fR
+.sp
+void
+\fBTk_DrawTextLayout(\fIdisplay, drawable, gc, layout, x, y, firstChar, lastChar\fB)\fR
+.sp
+void
+\fBTk_UnderlineTextLayout(\fIdisplay, drawable, gc, layout, x, y, underline\fB)\fR
+.sp
+int
+\fBTk_PointToChar(\fIlayout, x, y\fB)\fR
+.sp
+int
+\fBTk_CharBbox(\fIlayout, index, xPtr, yPtr, widthPtr, heightPtr\fB)\fR
+.sp
+int
+\fBTk_DistanceToTextLayout(\fIlayout, x, y\fB)\fR
+.sp
+int
+\fBTk_IntersectTextLayout(\fIlayout, x, y, width, height\fB)\fR
+.sp
+void
+\fBTk_TextLayoutToPostscript(\fIinterp, layout\fB)\fR
+
+.SH ARGUMENTS
+.AS Tk_TextLayout "*xPtr, *yPtr"
+.AP Tk_Font tkfont in
+Font to use when constructing and displaying a text layout. The
+\fItkfont\fR must remain valid for the lifetime of the text layout. Must
+have been returned by a previous call to \fBTk_GetFont\fR.
+.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
+newline/return character is encountered.
+.AP Tk_Justify justify in
+How to justify the lines in a multi-line text layout. Possible values
+are TK_JUSTIFY_LEFT, TK_JUSTIFY_CENTER, or TK_JUSTIFY_RIGHT. If the text
+layout only occupies a single line, then \fIjustify\fR is irrelevant.
+.AP int flags in
+Various flag bits OR-ed together. TK_IGNORE_TABS means that tab characters
+should not be expanded to the next tab stop. TK_IGNORE_NEWLINES means that
+newline/return characters should not cause a line break. If either tabs or
+newlines/returns are ignored, then they will be treated as regular
+characters, being measured and displayed in a platform-dependent manner as
+described in \fBTk_MeasureChars\fR, and will not have any special behaviors.
+.AP int *widthPtr out
+If non-NULL, filled with either the width, in pixels, of the widest
+line in the text layout, or the width, in pixels, of the bounding box for the
+character specified by \fIindex\fR.
+.AP int *heightPtr out
+If non-NULL, filled with either the total height, in pixels, of all
+the lines in the text layout, or the height, in pixels, of the bounding
+box for the character specified by \fIindex\fR.
+.AP Tk_TextLayout layout in
+A token that represents the cached layout information about the single-font,
+multi-line, justified piece of text. This token is returned by
+\fBTk_ComputeTextLayout\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 to use for drawing text layout. The font selected in
+this GC must correspond to the \fItkfont\fR used when constructing the
+text layout.
+.AP int "x, y" in
+Point, in pixels, at which to place the upper-left hand corner of the
+text layout when it is being drawn, or the coordinates of a point (with
+respect to the upper-left hand corner of the text layout) to check
+against the text layout.
+.AP int firstChar in
+The index of the first character to draw from the given text layout.
+The number 0 means to draw from the beginning.
+.AP int lastChar in
+The index of the last character up to which to draw. The character
+specified by \fIlastChar\fR itself will not be drawn. A number less
+than 0 means to draw all characters in the text layout.
+.AP int underline in
+Index of the single character to underline in the text layout, or a number
+less than 0 for no underline.
+.AP int index in
+The index of the character whose bounding box is desired. The bounding
+box is computed with respect to the upper-left hand corner of the text layout.
+.AP int "*xPtr, *yPtr" out
+Filled with the upper-left hand corner, in pixels, of the bounding box
+for the character specified by \fIindex\fR. Either or both \fIxPtr\fR
+and \fIyPtr\fR may be NULL, in which case the corresponding value
+is not calculated.
+.AP int "width, height" in
+Specifies the width and height, in pixels, of the rectangular area to
+compare for intersection against the text layout.
+.AP Tcl_Interp *interp out
+Postscript code that will print the text layout is appended to
+\fIinterp->result\fR.
+.BE
+
+.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
+display a single-font, multi-line, justified \fIstring\fR of text and
+returns a Tk_TextLayout token that holds this information. This token is
+used in subsequent calls to procedures such as \fBTk_DrawTextLayout\fR,
+\fBTk_DistanceToTextLayout\fR, and \fBTk_FreeTextLayout\fR. The
+\fIstring\fR and \fItkfont\fR used when computing the layout must remain
+valid for the lifetime of this token.
+.PP
+\fBTk_FreeTextLayout\fR is called to release the storage associated with
+\fIlayout\fR when it is no longer needed. A \fIlayout\fR should not be used
+in any other text layout procedures once it has been released.
+.PP
+\fBTk_DrawTextLayout\fR uses the information in \fIlayout\fR to display a
+single-font, multi-line, justified string of text at the specified location.
+.PP
+\fBTk_UnderlineTextLayout\fR uses the information in \fIlayout\fR to
+display an underline below an individual character. This procedure does
+not draw the text, just the underline. To produce natively underlined
+text, an underlined font should be constructed and used. All characters,
+including tabs, newline/return characters, and spaces at the ends of
+lines, can be underlined using this method. However, the underline will
+never be drawn outside of the computed width of \fIlayout\fR; the
+underline will stop at the edge for any character that would extend
+partially outside of \fIlayout\fR, and the underline will not be visible
+at all for any character that would be located completely outside of the
+layout.
+.PP
+\fBTk_PointToChar\fR uses the information in \fIlayout\fR to determine the
+character closest to the given point. The point is specified with respect
+to the upper-left hand corner of the \fIlayout\fR, which is considered to be
+located at (0, 0). Any point whose \fIy\fR-value is less that 0 will be
+considered closest to the first character in the text layout; any point
+whose \fIy\fR-value is greater than the height of the text layout will be
+considered closest to the last character in the text layout. Any point
+whose \fIx\fR-value is less than 0 will be considered closest to the first
+character on that line; any point whose \fIx\fR-value is greater than the
+width of the text layout will be considered closest to the last character on
+that line. The return value is the index of the character that was closest
+to the point. Given a \fIlayout\fR with no characters, the value 0 will
+always be returned, referring to a hypothetical zero-width placeholder
+character.
+.PP
+\fBTk_CharBBox\fR uses the information in \fIlayout\fR to return the
+bounding box for the character specified by \fIindex\fR. The width of the
+bounding box is the advance width of the character, and does not include any
+left or right bearing. Any character that extends partially outside of
+\fIlayout\fR is considered to be truncated at the edge. Any character
+that would be located completely outside of \fIlayout\fR is considered to
+be zero-width and pegged against the edge. The height of the bounding
+box is the line height for this font, extending from the top of the
+ascent to the bottom of the descent; information about the actual height
+of individual letters is not available. For measurement purposes, a
+\fIlayout\fR that contains no characters is considered to contain a
+single zero-width placeholder character at index 0. If \fIindex\fR was
+not a valid character index, the return value is 0 and \fI*xPtr\fR,
+\fI*yPtr\fR, \fI*widthPtr\fR, and \fI*heightPtr\fR are unmodified.
+Otherwise, if \fIindex\fR did specify a valid, the return value is
+non-zero, and \fI*xPtr\fR, \fI*yPtr\fR, \fI*widthPtr\fR, and
+\fI*heightPtr\fR are filled with the bounding box information for the
+character. If any of \fIxPtr\fR, \fIyPtr\fR, \fIwidthPtr\fR, or
+\fIheightPtr\fR are NULL, the corresponding value is not calculated or
+stored.
+.PP
+\fBTk_DistanceToTextLayout\fR computes the shortest distance in pixels from
+the given point (\fIx, y\fR) to the characters in \fIlayout\fR.
+Newline/return characters and non-displaying space characters that occur at
+the end of individual lines in the text layout are ignored for hit detection
+purposes, but tab characters are not. The return value is 0 if the point
+actually hits the \fIlayout\fR. If the point didn't hit the \fIlayout\fR
+then the return value is the distance in pixels from the point to the
+\fIlayout\fR.
+.PP
+\fBTk_IntersectTextLayout\fR determines whether a \fIlayout\fR lies
+entirely inside, entirely outside, or overlaps a given rectangle.
+Newline/return characters and non-displaying space characters that occur
+at the end of individual lines in the \fIlayout\fR are ignored for
+intersection calculations. The return value is \-1 if the \fIlayout\fR is
+entirely outside of the rectangle, 0 if it overlaps, and 1 if it is
+entirely inside of the rectangle.
+.PP
+\fBTk_TextLayoutToPostscript\fR outputs code consisting of a Postscript
+array of strings that represent the individual lines in \fIlayout\fR. It
+is the responsibility of the caller to take the Postscript array of
+strings and add some Postscript function operate on the array to render
+each of the lines. The code that represents the Postscript array of
+strings is appended to \fIinterp->result\fR.
+.PP
+.SH DISPLAY MODEL
+When measuring a text layout, space characters that occur at the end of a
+line are ignored. The space characters still exist and the insertion point
+can be positioned amongst them, but their additional width is ignored when
+justifying lines or returning the total width of a text layout. All
+end-of-line space characters are considered to be attached to the right edge
+of the line; this behavior is logical for left-justified text and reasonable
+for center-justified text, but not very useful when editing right-justified
+text. Spaces are considered variable width characters; the first space that
+extends past the edge of the text layout is clipped to the edge, and any
+subsequent spaces on the line are considered zero width and pegged against
+the edge. Space characters that occur in the middle of a line of text are
+not suppressed and occupy their normal space width.
+.PP
+Tab characters are not ignored for measurement calculations. If wrapping
+is turned on and there are enough tabs on a line, the next tab will wrap
+to the beginning of the next line. There are some possible strange
+interactions between tabs and justification; tab positions are calculated
+and the line length computed in a left-justified world, and then the
+whole resulting line is shifted so it is centered or right-justified,
+causing the tab columns not to align any more.
+.PP
+When wrapping is turned on, lines may wrap at word breaks (space or tab
+characters) or newline/returns. A dash or hyphen character in the middle
+of a word is not considered a word break. \fBTk_ComputeTextLayout\fR
+always attempts to place at least one word on each line. If it cannot
+because the \fIwrapLength\fR is too small, the word will be broken and as
+much as fits placed on the line and the rest on subsequent line(s). If
+\fIwrapLength\fR is so small that not even one character can fit on a
+given line, the \fIwrapLength\fR is ignored for that line and one
+character will be placed on the line anyhow. When wrapping is turned
+off, only newline/return characters may cause a line break.
+.PP
+When a text layout has been created using an underlined \fItkfont\fR,
+then any space characters that occur at the end of individual lines,
+newlines/returns, and tabs will not be displayed underlined when
+\fBTk_DrawTextLayout\fR is called, because those characters are never
+actually drawn \- they are merely placeholders maintained in the
+\fIlayout\fR.
+.SH KEYWORDS
+font
diff --git a/tk/doc/Tk_Init.3 b/tk/doc/Tk_Init.3
new file mode 100644
index 00000000000..abb86b3a8d1
--- /dev/null
+++ b/tk/doc/Tk_Init.3
@@ -0,0 +1,47 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+int
+\fBTk_Init\fR(\fIinterp\fR)
+.SH ARGUMENTS
+.AS Tcl_Interp *interp
+.AP Tcl_Interp *interp in
+Interpreter in which to load Tk. Tk should not already be loaded
+in this interpreter.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_Init\fR is the package initialization procedure for Tk.
+It is normally invoked by the \fBTcl_AppInit\fR procedure
+for an application or by the \fBload\fR command.
+\fBTk_Init\fR adds all of Tk's commands to \fIinterp\fR
+and creates a new Tk application, including its main window.
+If the initialization is successful \fBTk_Init\fR returns
+\fBTCL_OK\fR; if there is an error it returns \fBTCL_ERROR\fR.
+\fBTk_Init\fR also leaves a result or error message
+in \fIinterp->result\fR.
+.PP
+If there is a variable \fBargv\fR in \fIinterp\fR, \fBTk_Init\fR
+treats the contents of this variable as a list of options for the
+new Tk application.
+The options may have any of the forms documented for the
+\fBwish\fR application (in fact, \fBwish\fR uses Tk_Init to process
+its command-line arguments).
+
+.SH KEYWORDS
+application, initialization, load, main window
diff --git a/tk/doc/Tk_Main.3 b/tk/doc/Tk_Main.3
new file mode 100644
index 00000000000..72f506638ed
--- /dev/null
+++ b/tk/doc/Tk_Main.3
@@ -0,0 +1,61 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+\fBTk_Main\fR(\fIargc, argv, appInitProc\fR)
+.SH ARGUMENTS
+.AS Tcl_AppInitProc *appInitProc
+.AP int argc in
+Number of elements in \fIargv\fR.
+.AP char *argv[] in
+Array of strings containing command-line arguments.
+.AP Tcl_AppInitProc *appInitProc in
+Address of an application-specific initialization procedure.
+The value for this argument is usually \fBTcl_AppInit\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_Main\fR acts as the main program for most Tk-based applications.
+Starting with Tk 4.0 it is not called \fBmain\fR anymore because it
+is part of the Tk library and having a function \fBmain\fR
+in a library (particularly a shared library) causes problems on many
+systems.
+Having \fBmain\fR in the Tk library would also make it hard to use
+Tk in C++ programs, since C++ programs must have special C++
+\fBmain\fR functions.
+.PP
+Normally each application contains a small \fBmain\fR function that does
+nothing but invoke \fBTk_Main\fR.
+\fBTk_Main\fR then does all the work of creating and running a
+\fBwish\fR-like application.
+.PP
+When it is has finished its own initialization, but before
+it processes commands, \fBTk_Main\fR calls the procedure given by
+the \fIappInitProc\fR argument. This procedure provides a ``hook''
+for the application to perform its own initialization, such as defining
+application-specific commands. The procedure must have an interface
+that matches the type \fBTcl_AppInitProc\fR:
+.CS
+typedef int Tcl_AppInitProc(Tcl_Interp *\fIinterp\fR);
+.CE
+\fIAppInitProc\fR is almost always a pointer to \fBTcl_AppInit\fR;
+for more details on this procedure, see the documentation
+for \fBTcl_AppInit\fR.
+
+.SH KEYWORDS
+application-specific initialization, command-line arguments, main program
diff --git a/tk/doc/WindowId.3 b/tk/doc/WindowId.3
new file mode 100644
index 00000000000..fc9e503caee
--- /dev/null
+++ b/tk/doc/WindowId.3
@@ -0,0 +1,151 @@
+'\"
+'\" 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$
+'\"
+.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
+.nf
+\fB#include <tk.h>\fR
+.sp
+Window
+\fBTk_WindowId\fR(\fItkwin\fR)
+.sp
+Tk_Window
+\fBTk_Parent\fR(\fItkwin\fR)
+.sp
+Display *
+\fBTk_Display\fR(\fItkwin\fR)
+.sp
+char *
+\fBTk_DisplayName\fR(\fItkwin\fR)
+.sp
+int
+\fBTk_ScreenNumber\fR(\fItkwin\fR)
+.sp
+Screen *
+\fBTk_Screen\fR(\fItkwin\fR)
+.sp
+int
+\fBTk_X\fR(\fItkwin\fR)
+.sp
+int
+\fBTk_Y\fR(\fItkwin\fR)
+.sp
+int
+\fBTk_Width\fR(\fItkwin\fR)
+.sp
+int
+\fBTk_Height\fR(\fItkwin\fR)
+.sp
+XWindowChanges *
+\fBTk_Changes\fR(\fItkwin\fR)
+.sp
+XSetWindowAttributes *
+\fBTk_Attributes\fR(\fItkwin\fR)
+.sp
+int
+\fBTk_IsMapped\fR(\fItkwin\fR)
+.sp
+int
+\fBTk_IsTopLevel\fR(\fItkwin\fR)
+.sp
+int
+\fBTk_ReqWidth\fR(\fItkwin\fR)
+.sp
+int
+\fBTk_ReqHeight\fR(\fItkwin\fR)
+.sp
+int
+\fBTk_InternalBorderWidth\fR(\fItkwin\fR)
+.sp
+Visual *
+\fBTk_Visual\fR(\fItkwin\fR)
+.sp
+int
+\fBTk_Depth\fR(\fItkwin\fR)
+.sp
+Colormap
+\fBTk_Colormap\fR(\fItkwin\fR)
+.SH ARGUMENTS
+.AS Tk_Window tkwin
+.AP Tk_Window tkwin in
+Token for window.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBTk_WindowID\fR and the other names listed above are
+all macros that return fields from Tk's local data structure
+for \fItkwin\fR. None of these macros requires any
+interaction with the server; it is safe to assume that
+all are fast.
+.PP
+\fBTk_WindowId\fR returns the X identifier for \fItkwin\fR,
+or \fBNULL\fR if no X window has been created for \fItkwin\fR
+yet.
+.PP
+\fBTk_Parent\fR returns Tk's token for the logical parent of
+\fItkwin\fR. The parent is the token that was specified when
+\fItkwin\fR was created, or NULL for main windows.
+.PP
+\fBTk_Display\fR returns a pointer to the Xlib display structure
+corresponding to \fItkwin\fR. \fBTk_DisplayName\fR returns an
+ASCII string identifying \fItkwin\fR's display. \fBTk_ScreenNumber\fR
+returns the index of \fItkwin\fR's screen among all the screens
+of \fItkwin\fR's display. \fBTk_Screen\fR returns a pointer to
+the Xlib structure corresponding to \fItkwin\fR's screen.
+.PP
+\fBTk_X\fR, \fBTk_Y\fR, \fBTk_Width\fR, and \fBTk_Height\fR
+return information about \fItkwin's\fR location within its
+parent and its size. The location information refers to the
+upper-left pixel in the window, or its border if there is one.
+The width and height information refers to the interior size
+of the window, not including any border. \fBTk_Changes\fR
+returns a pointer to a structure containing all of the above
+information plus a few other fields. \fBTk_Attributes\fR
+returns a pointer to an XSetWindowAttributes structure describing
+all of the attributes of the \fItkwin\fR's window, such as background
+pixmap, event mask, and so on (Tk keeps track of all this information
+as it is changed by the application). Note: it is essential that
+applications use Tk procedures like \fBTk_ResizeWindow\fR instead
+of X procedures like \fBXResizeWindow\fR, so that Tk can keep its
+data structures up-to-date.
+.PP
+\fBTk_IsMapped\fR returns a non-zero value if \fItkwin\fR
+is mapped and zero if \fItkwin\fR isn't mapped.
+.PP
+\fBTk_IsTopLevel\fR returns a non-zero value if \fItkwin\fR
+is a top-level window (its X parent is the root window of the
+screen) and zero if \fItkwin\fR isn't a top-level window.
+.PP
+\fBTk_ReqWidth\fR and \fBTk_ReqHeight\fR return information about
+the window's requested size. These values correspond to the last
+call to \fBTk_GeometryRequest\fR for \fItkwin\fR.
+.PP
+\fBTk_InternalBorderWidth\fR returns the width of internal border
+that has been requested for \fItkwin\fR, or 0 if no internal border
+was requested. The return value is simply the last value passed
+to \fBTk_SetInternalBorder\fR for \fItkwin\fR.
+.PP
+\fBTk_Visual\fR, \fBTk_Depth\fR, and \fBTk_Colormap\fR return
+information about the visual characteristics of a window.
+\fBTk_Visual\fR returns the visual type for
+the window, \fBTk_Depth\fR returns the number of bits per pixel,
+and \fBTk_Colormap\fR returns the current
+colormap for the window. The visual characteristics are
+normally set from the defaults for the window's screen, but
+they may be overridden by calling \fBTk_SetWindowVisual\fR.
+
+.SH KEYWORDS
+attributes, colormap, depth, display, height, geometry manager,
+identifier, mapped, requested size, screen, top-level,
+visual, width, window, x, y
diff --git a/tk/doc/bell.n b/tk/doc/bell.n
new file mode 100644
index 00000000000..75db0241f91
--- /dev/null
+++ b/tk/doc/bell.n
@@ -0,0 +1,34 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBbell \fR?\fB\-displayof \fIwindow\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command rings the bell on the display for \fIwindow\fR and
+returns an empty string.
+If the \fB\-displayof\fR option is omitted, the display of the
+application's main window is used by default.
+The command uses the current bell-related settings for the display, which
+may be modified with programs such as \fBxset\fR.
+.PP
+This command also resets the screen saver for the screen. Some
+screen savers will ignore this, but others will reset so that the
+screen becomes visible again.
+
+.SH KEYWORDS
+beep, bell, ring
diff --git a/tk/doc/bind.n b/tk/doc/bind.n
new file mode 100644
index 00000000000..bdaab5784d6
--- /dev/null
+++ b/tk/doc/bind.n
@@ -0,0 +1,523 @@
+'\"
+'\" 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$
+'\"
+.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
+\fBbind\fI tag sequence\fR
+.sp
+\fBbind\fI tag sequence script\fR
+.sp
+\fBbind\fI tag sequence \fB+\fIscript\fR
+.BE
+
+.SH INTRODUCTION
+.PP
+The \fBbind\fR command associates Tcl scripts with X events.
+If all three arguments are specified, \fBbind\fR will
+arrange for \fIscript\fR (a Tcl script) to be evaluated whenever
+the event(s) given by \fIsequence\fR occur in the window(s)
+identified by \fItag\fR.
+If \fIscript\fR is prefixed with a ``+'', then it is appended to
+any existing binding for \fIsequence\fR; otherwise \fIscript\fR replaces
+any existing binding.
+If \fIscript\fR is an empty string then the current binding for
+\fIsequence\fR is destroyed, leaving \fIsequence\fR unbound.
+In all of the cases where a \fIscript\fR argument is provided,
+\fBbind\fR returns an empty string.
+.PP
+If \fIsequence\fR is specified without a \fIscript\fR, then the
+script currently bound to \fIsequence\fR is returned, or
+an empty string is returned if there is no binding for \fIsequence\fR.
+If neither \fIsequence\fR nor \fIscript\fR is specified, then the
+return value is a list whose elements are all the sequences
+for which there exist bindings for \fItag\fR.
+.PP
+The \fItag\fR argument determines which window(s) the binding applies to.
+If \fItag\fR begins with a dot, as in \fB.a.b.c\fR, then it must
+be the path name for a window; otherwise it may be an arbitrary
+string.
+Each window has an associated list of tags, and a binding applies
+to a particular window if its tag is among those specified for
+the window.
+Although the \fBbindtags\fR command may be used to assign an
+arbitrary set of binding tags to a window, the default binding
+tags provide the following behavior:
+.IP
+If a tag is the name of an internal window the binding applies
+to that window.
+.IP
+If the tag is the name of a toplevel window the binding applies
+to the toplevel window and all its internal windows.
+.IP
+If the tag is the name of a class of widgets, such as \fBButton\fR,
+the binding applies to all widgets in that class;
+.IP
+If \fItag\fR has the value \fBall\fR,
+the binding applies to all windows in the application.
+
+.SH "EVENT PATTERNS"
+.PP
+The \fIsequence\fR argument specifies a sequence of one or more
+event patterns, with optional white space between the patterns. Each
+.VS
+event pattern may
+take one of three forms. In the simplest case it is a single
+.VE
+printing ASCII character, such as \fBa\fR or \fB[\fR. The character
+may not be a space character or the character \fB<\fR. This form of
+pattern matches a \fBKeyPress\fR event for the particular
+character. The second form of pattern is longer but more general.
+It has the following syntax:
+.CS
+\fB<\fImodifier-modifier-type-detail\fB>\fR
+.CE
+The entire event pattern is surrounded by angle brackets.
+Inside the angle brackets are zero or more modifiers, an event
+type, and an extra piece of information (\fIdetail\fR) identifying
+a particular button or keysym. Any of the fields may be omitted,
+as long as at least one of \fItype\fR and \fIdetail\fR is present.
+The fields must be separated by white space or dashes.
+.VS
+.PP
+The third form of pattern is used to specify a user-defined, named virtual
+event. It has the following syntax:
+.CS
+\fB<<\fIname\fB>>\fR
+.CE
+The entire virtual event pattern is surrounded by double angle brackets.
+Inside the angle brackets is the user-defined name of the virtual event.
+Modifiers, such as \fBShift\fR or \fBControl\fR, may not be combined with a
+virtual event to modify it. Bindings on a virtual event may be created
+before the virtual event is defined, and if the definition of a virtual
+event changes dynamically, all windows bound to that virtual event will
+respond immediately to the new definition.
+.VE
+.SH "MODIFIERS"
+.PP
+Modifiers consist of any of the following values:
+.DS
+.ta 6c
+\fBControl\fR \fBMod2, M2\fR
+\fBShift\fR \fBMod3, M3\fR
+\fBLock\fR \fBMod4, M4\fR
+\fBButton1, B1\fR \fBMod5, M5\fR
+\fBButton2, B2\fR \fBMeta, M\fR
+\fBButton3, B3\fR \fBAlt\fR
+\fBButton4, B4\fR \fBDouble\fR
+\fBButton5, B5\fR \fBTriple\fR
+\fBMod1, M1\fR
+.DE
+Where more than one value is listed, separated by commas, the values
+are equivalent.
+Most of the modifiers have the obvious X meanings.
+For example, \fBButton1\fR requires that
+button 1 be depressed when the event occurs.
+For a binding to match a given event, the modifiers in the event
+must include all of those specified in the event pattern.
+An event may also contain additional modifiers not specified in
+the binding.
+For example, if button 1 is pressed while the shift and control keys
+are down, the pattern \fB<Control-Button-1>\fR will match
+the event, but \fB<Mod1-Button-1>\fR will not.
+If no modifiers are specified, then any combination of modifiers may
+be present in the event.
+.PP
+\fBMeta\fR and \fBM\fR refer to whichever of the
+\fBM1\fR through \fBM5\fR modifiers is associated with the meta
+key(s) on the keyboard (keysyms \fBMeta_R\fR and \fBMeta_L\fR).
+If there are no meta keys, or if they are not associated with any
+modifiers, then \fBMeta\fR and \fBM\fR will not match any events.
+Similarly, the \fBAlt\fR modifier refers to whichever modifier
+is associated with the alt key(s) on the keyboard (keysyms
+\fBAlt_L\fR and \fBAlt_R\fR).
+.PP
+The \fBDouble\fR and \fBTriple\fR modifiers are a convenience
+for specifying double mouse clicks and other repeated
+events. They cause a particular event pattern to be
+repeated 2 or 3 times, and also place a time and space requirement
+on the sequence: for a sequence of events to match a \fBDouble\fR
+or \fBTriple\fR pattern, all of the events must occur close together
+in time and without substantial mouse motion in between.
+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;
+in the first case, it refers to a button being pressed or released,
+while in the second it refers to some other button that is already
+depressed when the matching event occurs. If a button
+number is given then \fItype\fR may be omitted: if will default
+to \fBButtonPress\fR. For example, the specifier \fB<1>\fR
+is equivalent to \fB<ButtonPress-1>\fR.
+.PP
+If the event type is \fBKeyPress\fR or \fBKeyRelease\fR, then
+\fIdetail\fR may be specified in the form of an X keysym. Keysyms
+are textual specifications for particular keys on the keyboard;
+they include all the alphanumeric ASCII characters (e.g. ``a'' is
+the keysym for the ASCII character ``a''), plus descriptions for
+non-alphanumeric characters (``comma'' is the keysym for the comma
+character), plus descriptions for all the non-ASCII keys on the
+keyboard (``Shift_L'' is the keysm for the left shift key, and
+``F1'' is the keysym for the F1 function key, if it exists). The
+complete list of keysyms is not presented here; it is
+available in other X documentation and may vary from system to
+system.
+If necessary, you can use the \fB%K\fR notation described below
+to print out the keysym name for a particular key.
+If a keysym \fIdetail\fR is given, then the
+\fItype\fR field may be omitted; it will default to \fBKeyPress\fR.
+For example, \fB<Control-comma>\fR is equivalent to
+\fB<Control-KeyPress-comma>\fR.
+
+.SH "BINDING SCRIPTS AND SUBSTITUTIONS"
+.PP
+The \fIscript\fR argument to \fBbind\fR is a Tcl script,
+which will be executed whenever the given event sequence occurs.
+\fICommand\fR will be executed in the same interpreter that the
+\fBbind\fR command was executed in, and it will run at global
+level (only global variables will be accessible).
+If \fIscript\fR contains
+any \fB%\fR characters, then the script will not be
+executed directly. Instead, a new script will be
+generated by replacing each \fB%\fR, and the character following
+it, with information from the current event. The replacement
+depends on the character following the \fB%\fR, as defined in the
+list below. Unless otherwise indicated, the
+replacement string is the decimal value of the given field from
+the current event.
+Some of the substitutions are only valid for
+certain types of events; if they are used for other types of events
+the value substituted is undefined.
+.IP \fB%%\fR 5
+Replaced with a single percent.
+.IP \fB%#\fR 5
+The number of the last client request processed by the server
+(the \fIserial\fR field from the event). Valid for all event
+types.
+.IP \fB%a\fR 5
+The \fIabove\fR field from the event,
+formatted as a hexadecimal number.
+Valid only for \fBConfigure\fR events.
+.IP \fB%b\fR 5
+The number of the button that was pressed or released. Valid only
+for \fBButtonPress\fR and \fBButtonRelease\fR events.
+.IP \fB%c\fR 5
+The \fIcount\fR field from the event. Valid only for \fBExpose\fR events.
+.IP \fB%d\fR 5
+The \fIdetail\fR field from the event. The \fB%d\fR is replaced by
+a string identifying the detail. For \fBEnter\fR,
+\fBLeave\fR, \fBFocusIn\fR, and \fBFocusOut\fR events,
+the string will be one of the following:
+.RS
+.DS
+.ta 6c
+\fBNotifyAncestor NotifyNonlinearVirtual
+NotifyDetailNone NotifyPointer
+NotifyInferior NotifyPointerRoot
+NotifyNonlinear NotifyVirtual\fR
+.DE
+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
+\fBNotifyNormal\fR, \fBNotifyGrab\fR, \fBNotifyUngrab\fR, or
+.VS
+\fBNotifyWhileGrabbed\fR. Valid only for \fBEnter\fR,
+\fBFocusIn\fR, \fBFocusOut\fR, and \fBLeave\fR events.
+.VE
+.IP \fB%o\fR 5
+The \fIoverride_redirect\fR field from the event. Valid only for
+\fBMap\fR, \fBReparent\fR, and \fBConfigure\fR events.
+.IP \fB%p\fR 5
+The \fIplace\fR field from the event, substituted as one of the
+strings \fBPlaceOnTop\fR or \fBPlaceOnBottom\fR. Valid only
+for \fBCirculate\fR events.
+.IP \fB%s\fR 5
+The \fIstate\fR field from the event. For \fBButtonPress\fR,
+\fBButtonRelease\fR, \fBEnter\fR, \fBKeyPress\fR, \fBKeyRelease\fR,
+\fBLeave\fR, and \fBMotion\fR events, a decimal string
+is substituted. For \fBVisibility\fR, one of the strings
+\fBVisibilityUnobscured\fR, \fBVisibilityPartiallyObscured\fR,
+and \fBVisibilityFullyObscured\fR is substituted.
+.IP \fB%t\fR 5
+The \fItime\fR field from the event. Valid only for events that
+contain a \fItime\fR field.
+.IP \fB%w\fR 5
+The \fIwidth\fR field from the event. Valid only for
+.VS
+\fBConfigure\fR and \fBExpose\fR events.
+.VE
+.IP \fB%x\fR 5
+The \fIx\fR field from the event. Valid only for events containing
+an \fIx\fR field.
+.IP \fB%y\fR 5
+The \fIy\fR field from the event. Valid only for events containing
+a \fIy\fR field.
+.IP \fB%A\fR 5
+Substitutes the ASCII character corresponding to the event, or
+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
+number. Valid only for \fBKeyPress\fR and \fBKeyRelease\fR events.
+.IP \fB%R\fR 5
+The \fIroot\fR window identifier from the event. Valid only for
+events containing a \fIroot\fR field.
+.IP \fB%S\fR 5
+The \fIsubwindow\fR window identifier from the event,
+formatted as a hexadecimal number.
+Valid only for events containing a \fIsubwindow\fR field.
+.IP \fB%T\fR 5
+The \fItype\fR field from the event. Valid for all event types.
+.IP \fB%W\fR 5
+The path name of the window to which the event was reported (the
+\fIwindow\fR field from the event). Valid for all event types.
+.IP \fB%X\fR 5
+The \fIx_root\fR field from the event.
+If a virtual-root window manager is being used then the substituted
+value is the corresponding x-coordinate in the virtual root.
+Valid only for
+\fBButtonPress\fR, \fBButtonRelease\fR, \fBKeyPress\fR, \fBKeyRelease\fR,
+and \fBMotion\fR events.
+.IP \fB%Y\fR 5
+The \fIy_root\fR field from the event.
+If a virtual-root window manager is being used then the substituted
+value is the corresponding y-coordinate in the virtual root.
+Valid only for
+\fBButtonPress\fR, \fBButtonRelease\fR, \fBKeyPress\fR, \fBKeyRelease\fR,
+and \fBMotion\fR events.
+.LP
+The replacement string for a %-replacement is formatted as a proper
+Tcl list element.
+This means that it will be surrounded with braces
+if it contains spaces, or special characters such as \fB$\fR and
+\fB{\fR may be preceded by backslashes.
+This guarantees that the string will be passed through the Tcl
+parser when the binding script is evaluated.
+Most replacements are numbers or well-defined strings such
+as \fBAbove\fR; for these replacements no special formatting
+is ever necessary.
+The most common case where reformatting occurs is for the \fB%A\fR
+substitution. For example, if \fIscript\fR is
+.CS
+\fBinsert\0%A\fR
+.CE
+and the character typed is an open square bracket, then the script
+actually executed will be
+.CS
+\fBinsert\0\e[\fR
+.CE
+This will cause the \fBinsert\fR to receive the original replacement
+string (open square bracket) as its first argument.
+If the extra backslash hadn't been added, Tcl would not have been
+able to parse the script correctly.
+
+.SH MULTIPLE MATCHES
+.PP
+It is possible for several bindings to match a given X event.
+If the bindings are associated with different \fItag\fR's,
+then each of the bindings will be executed, in order.
+By default, a binding for the widget will be executed first, followed
+by a class binding, a binding for its toplevel, and
+an \fBall\fR binding.
+The \fBbindtags\fR command may be used to change this order for
+a particular window or to associate additional binding tags with
+the window.
+.PP
+The \fBcontinue\fR and \fBbreak\fR commands may be used inside a
+binding script to control the processing of matching scripts.
+If \fBcontinue\fR is invoked, then the current binding script
+is terminated but Tk will continue processing binding scripts
+associated with other \fItag\fR's.
+If the \fBbreak\fR command is invoked within a binding script,
+then that script terminates and no other scripts will be invoked
+for the event.
+.VS
+.PP
+If more than one binding matches a particular event and they
+have the same \fItag\fR, then the most specific binding
+is chosen and its script is evaluated.
+The following tests are applied, in order, to determine which of
+several matching sequences is more specific:
+(a) an event pattern that specifies a specific button or key is more specific
+than one that doesn't;
+(b) a longer sequence (in terms of number
+of events matched) is more specific than a shorter sequence;
+(c) if the modifiers specified in one pattern are a subset of the
+modifiers in another pattern, then the pattern with more modifiers
+is more specific.
+.VS
+(d) a virtual event whose physical pattern matches the sequence is less
+specific than the same physical pattern that is not associated with a
+virtual event.
+(e) given a sequence that matches two or more virtual events, one
+of the virtual events will be chosen, but the order is undefined.
+.PP
+If the matching sequences contain more than one event, then tests
+(c)-(e) are applied in order from the most recent event to the least recent
+event in the sequences. If these tests fail to determine a winner, then the
+most recently registered sequence is the winner.
+.PP
+If there are two (or more) virtual events that are both triggered by the
+same sequence, and both of those virtual events are bound to the same window
+tag, then only one of the virtual events will be triggered, and it will
+be picked at random:
+.CS
+event add <<Paste>> <Control-y>
+event add <<Paste>> <Button-2>
+event add <<Scroll>> <Button-2>
+bind Entry <<Paste>> {puts Paste}
+bind Entry <<Scroll>> {puts Scroll}
+.CE
+If the user types Control-y, the \fB<<Paste>>\fR binding
+will be invoked, but if the user presses button 2 then one of
+either the \fB<<Paste>>\fR or the \fB<<Scroll>>\fR bindings will
+be invoked, but exactly which one gets invoked is undefined.
+.VE
+.PP
+If an X event does not match any of the existing bindings, then the
+event is ignored.
+An unbound event is not considered to be an error.
+
+.SH "MULTI-EVENT SEQUENCES AND IGNORED EVENTS"
+.PP
+When a \fIsequence\fR specified in a \fBbind\fR command contains
+more than one event pattern, then its script is executed whenever
+the recent events (leading up to and including the current event)
+match the given sequence. This means, for example, that if button 1 is
+clicked repeatedly the sequence \fB<Double-ButtonPress-1>\fR will match
+each button press but the first.
+If extraneous events that would prevent a match occur in the middle
+of an event sequence then the extraneous events are
+ignored unless they are \fBKeyPress\fR or \fBButtonPress\fR events.
+For example, \fB<Double-ButtonPress-1>\fR will match a sequence of
+presses of button 1, even though there will be \fBButtonRelease\fR
+events (and possibly \fBMotion\fR events) between the
+\fBButtonPress\fR events.
+Furthermore, a \fBKeyPress\fR event may be preceded by any number
+of other \fBKeyPress\fR events for modifier keys without the
+modifier keys preventing a match.
+For example, the event sequence \fBaB\fR will match a press of the
+\fBa\fR key, a release of the \fBa\fR key, a press of the \fBShift\fR
+key, and a press of the \fBb\fR key: the press of \fBShift\fR is
+ignored because it is a modifier key.
+Finally, if several \fBMotion\fR events occur in a row, only
+the last one is used for purposes of matching binding sequences.
+
+.SH ERRORS
+.PP
+If an error occurs in executing the script for a binding then the
+\fBbgerror\fR mechanism is used to report the error.
+The \fBbgerror\fR command will be executed at global level
+(outside the context of any Tcl procedure).
+
+.SH "SEE ALSO"
+bgerror
+
+.SH KEYWORDS
+form, manual
diff --git a/tk/doc/bindtags.n b/tk/doc/bindtags.n
new file mode 100644
index 00000000000..20e5291f459
--- /dev/null
+++ b/tk/doc/bindtags.n
@@ -0,0 +1,81 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBbindtags \fIwindow \fR?\fItagList\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+When a binding is created with the \fBbind\fR command, it is
+associated either with a particular window such as \fB.a.b.c\fR,
+a class name such as \fBButton\fR, the keyword \fBall\fR, or any
+other string.
+All of these forms are called \fIbinding tags\fR.
+Each window contains a list of binding tags that determine how
+events are processed for the window.
+When an event occurs in a window, it is applied to each of the
+window's tags in order: for each tag, the most specific binding
+that matches the given tag and event is executed.
+See the \fBbind\fR command for more information on the matching
+process.
+.PP
+By default, each window has four binding tags consisting of the
+name of the window, the window's class name, the name of the window's
+nearest toplevel ancestor, and \fBall\fR, in that order.
+Toplevel windows have only three tags by default, since the toplevel
+name is the same as that of the window.
+The \fBbindtags\fR command allows the binding tags for a window to be
+read and modified.
+.PP
+If \fBbindtags\fR is invoked with only one argument, then the
+current set of binding tags for \fIwindow\fR is returned as a list.
+If the \fItagList\fR argument is specified to \fBbindtags\fR,
+then it must be a proper list; the tags for \fIwindow\fR are changed
+to the elements of the list.
+The elements of \fItagList\fR may be arbitrary strings; however,
+any tag starting with a dot is treated as the name of a window; if
+no window by that name exists at the time an event is processed,
+then the tag is ignored for that event.
+The order of the elements in \fItagList\fR determines the order in
+which binding scripts are executed in response to events.
+For example, the command
+.CS
+\fBbindtags .b {all . Button .b}\fR
+.CE
+reverses the order in which binding scripts will be evaluated for
+a button named \fB.b\fR so that \fBall\fR bindings are invoked
+first, following by bindings for \fB.b\fR's toplevel (``.''), followed by
+class bindings, followed by bindings for \fB.b\fR.
+If \fItagList\fR is an empty list then the binding tags for \fIwindow\fR
+are returned to the default state described above.
+.PP
+The \fBbindtags\fR command may be used to introduce arbitrary
+additional binding tags for a window, or to remove standard tags.
+For example, the command
+.CS
+\fBbindtags .b {.b TrickyButton . all}\fR
+.CE
+replaces the \fBButton\fR tag for \fB.b\fR with \fBTrickyButton\fR.
+This means that the default widget bindings for buttons, which are
+associated with the \fBButton\fR tag, will no longer apply to \fB.b\fR,
+but any bindings associated with \fBTrickyButton\fR (perhaps some
+new button behavior) will apply.
+
+.SH "SEE ALSO"
+bind
+
+.SH KEYWORDS
+binding, event, tag
diff --git a/tk/doc/bitmap.n b/tk/doc/bitmap.n
new file mode 100644
index 00000000000..0fa1c5afda9
--- /dev/null
+++ b/tk/doc/bitmap.n
@@ -0,0 +1,114 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBimage create bitmap \fR?\fIname\fR? ?\fIoptions\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+A bitmap is an image whose pixels can display either of two colors
+or be transparent.
+A bitmap image is defined by four things: a background color,
+a foreground color, and two bitmaps, called the \fIsource\fR
+and the \fImask\fR.
+Each of the bitmaps specifies 0/1 values for a rectangular
+array of pixels, and the two bitmaps must have the same
+dimensions.
+For pixels where the mask is zero, the image displays nothing,
+producing a transparent effect.
+For other pixels, the image displays the foreground color if
+the source data is one and the background color if the source
+data is zero.
+
+.SH "CREATING BITMAPS"
+.PP
+Like all images, bitmaps are created using the \fBimage create\fR
+command.
+Bitmaps support the following \fIoptions\fR:
+.TP
+\fB\-background \fIcolor\fR
+Specifies a background color for the image in any of the standard
+ways accepted by Tk. If this option is set to an empty string
+then the background pixels will be transparent. This effect
+is achieved by using the source bitmap as the mask bitmap, ignoring
+any \fB\-maskdata\fR or \fB\-maskfile\fR options.
+.TP
+\fB\-data \fIstring\fR
+Specifies the contents of the source bitmap as a string.
+The string must adhere to X11 bitmap format (e.g., as generated
+by the \fBbitmap\fR program).
+If both the \fB\-data\fR and \fB\-file\fR options are specified,
+the \fB\-data\fR option takes precedence.
+.TP
+\fB\-file \fIname\fR
+\fIname\fR gives the name of a file whose contents define the
+source bitmap.
+The file must adhere to X11 bitmap format (e.g., as generated
+by the \fBbitmap\fR program).
+.TP
+\fB\-foreground \fIcolor\fR
+Specifies a foreground color for the image in any of the standard
+ways accepted by Tk.
+.TP
+\fB\-maskdata \fIstring\fR
+Specifies the contents of the mask as a string.
+The string must adhere to X11 bitmap format (e.g., as generated
+by the \fBbitmap\fR program).
+If both the \fB\-maskdata\fR and \fB\-maskfile\fR options are specified,
+the \fB\-maskdata\fR option takes precedence.
+.TP
+\fB\-maskfile \fIname\fR
+\fIname\fR gives the name of a file whose contents define the
+mask.
+The file must adhere to X11 bitmap format (e.g., as generated
+by the \fBbitmap\fR program).
+
+.SH "IMAGE COMMAND"
+.PP
+When a bitmap image is created, Tk also creates a new command
+whose name is the same as the image.
+This command may be used to invoke various operations
+on the image.
+It has the following general form:
+.CS
+\fIimageName option \fR?\fIarg arg ...\fR?
+.CE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for bitmap images:
+.TP
+\fIimageName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the
+\fBimage create bitmap\fR command.
+.TP
+\fIimageName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options for the image.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIimageName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the
+\fBimage create bitmap\fR command.
+
+.SH KEYWORDS
+bitmap, image
diff --git a/tk/doc/button.n b/tk/doc/button.n
new file mode 100644
index 00000000000..dc95b5da3c6
--- /dev/null
+++ b/tk/doc/button.n
@@ -0,0 +1,176 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBbutton\fR \fIpathName \fR?\fIoptions\fR?
+.SO
+\-activebackground \-cursor \-highlightthickness \-takefocus
+\-activeforeground \-disabledforeground \-image \-text
+\-anchor \-font \-justify \-textvariable
+\-background \-foreground \-padx \-underline
+\-bitmap \-highlightbackground \-pady \-wraplength
+\-borderwidth \-highlightcolor \-relief
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-command command Command
+Specifies a Tcl command to associate with the button. This command
+is typically invoked when mouse button 1 is released over the button
+window.
+.OP \-default default Default
+.VS
+Specifies one of three states for the default ring: \fBnormal\fR,
+\fBactive\fR, or \fBdisabled\fR. In active state, the button is drawn
+with the platform specific appearance for a default button. In normal
+state, the button is drawn with the platform specific appearance for a
+non-default button, leaving enough space to draw the default button
+appearance. The normal and active states will result in buttons of
+the same size. In disabled state, the button is drawn with the
+non-default button appearance without leaving space for the default
+appearance. The disabled state may result in a smaller button than
+the active state.
+ring.
+.VE
+.OP \-height height Height
+Specifies a desired height for the button.
+If an image or bitmap is being displayed in the button then the value is in
+screen units (i.e. any of the forms acceptable to \fBTk_GetPixels\fR);
+for text it is in lines of text.
+If this option isn't specified, the button's desired height is computed
+from the size of the image or bitmap or text being displayed in it.
+.OP \-state state State
+Specifies one of three states for the button: \fBnormal\fR, \fBactive\fR,
+or \fBdisabled\fR. In normal state the button is displayed using the
+\fBforeground\fR and \fBbackground\fR options. The active state is
+typically used when the pointer is over the button. In active state
+the button is displayed using the \fBactiveForeground\fR and
+\fBactiveBackground\fR options. Disabled state means that the button
+should be insensitive: the default bindings will refuse to activate
+the widget and will ignore mouse button presses.
+In this state the \fBdisabledForeground\fR and
+\fBbackground\fR options determine how the button is displayed.
+.OP \-width width Width
+Specifies a desired width for the button.
+If an image or bitmap is being displayed in the button then the value is in
+screen units (i.e. any of the forms acceptable to \fBTk_GetPixels\fR);
+for text it is in characters.
+If this option isn't specified, the button's desired width is computed
+from the size of the image or bitmap or text being displayed in it.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBbutton\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a button widget.
+Additional
+options, described above, may be specified on the command line
+or in the option database
+to configure aspects of the button such as its colors, font,
+text, and initial relief. The \fBbutton\fR command returns its
+\fIpathName\fR argument. At the time this command is invoked,
+there must not exist a window named \fIpathName\fR, but
+\fIpathName\fR's parent must exist.
+.PP
+A button is a widget that displays a textual string, bitmap or image.
+If text is displayed, it must all be in a single font, but it
+can occupy multiple lines on the screen (if it contains newlines
+or if wrapping occurs because of the \fBwrapLength\fR option) and
+one of the characters may optionally be underlined using the
+\fBunderline\fR option.
+It can display itself in either of three different ways, according
+to
+the \fBstate\fR option;
+it can be made to appear raised, sunken, or flat;
+and it can be made to flash. When a user invokes the
+button (by pressing mouse button 1 with the cursor over the
+button), then the Tcl command specified in the \fB\-command\fR
+option is invoked.
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBbutton\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.CS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.CE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for button widgets:
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBbutton\fR
+command.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBbutton\fR
+command.
+.TP
+\fIpathName \fBflash\fR
+Flash the button. This is accomplished by redisplaying the button
+several times, alternating between active and normal colors. At
+the end of the flash the button is left in the same normal/active
+state as when the command was invoked.
+This command is ignored if the button's state is \fBdisabled\fR.
+.TP
+\fIpathName \fBinvoke\fR
+Invoke the Tcl command associated with the button, if there is one.
+The return value is the return value from the Tcl command, or an
+empty string if there is no command associated with the button.
+This command is ignored if the button's state is \fBdisabled\fR.
+
+.SH "DEFAULT BINDINGS"
+.PP
+Tk automatically creates class bindings for buttons that give them
+default behavior:
+.IP [1]
+A button activates whenever the mouse passes over it and deactivates
+whenever the mouse leaves the button.
+.VS
+Under Windows, this binding is only active when mouse button 1 has
+been pressed over the button.
+.VE
+.IP [2]
+A button's relief is changed to sunken whenever mouse button 1 is
+pressed over the button, and the relief is restored to its original
+value when button 1 is later released.
+.IP [3]
+If mouse button 1 is pressed over a button and later released over
+the button, the button is invoked. However, if the mouse is not
+over the button when button 1 is released, then no invocation occurs.
+.IP [4]
+When a button has the input focus, the space key causes the button
+to be invoked.
+.PP
+If the button's state is \fBdisabled\fR then none of the above
+actions occur: the button is completely non-responsive.
+.PP
+The behavior of buttons can be changed by defining new bindings for
+individual widgets or by redefining the class bindings.
+
+.SH KEYWORDS
+button, widget
diff --git a/tk/doc/canvas.n b/tk/doc/canvas.n
new file mode 100644
index 00000000000..a1120bea1f0
--- /dev/null
+++ b/tk/doc/canvas.n
@@ -0,0 +1,1577 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBcanvas\fR \fIpathName \fR?\fIoptions\fR?
+.SO
+\-background \-highlightthickness \-insertwidth \-takefocus
+\-borderwidth \-insertbackground \-relief \-xscrollcommand
+\-cursor \-insertborderwidth \-selectbackground \-yscrollcommand
+\-highlightbackground \-insertofftime \-selectborderwidth
+\-highlightcolor \-insertontime \-selectforeground
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-closeenough closeEnough CloseEnough
+Specifies a floating-point value indicating how close the mouse cursor
+must be to an item before it is considered to be ``inside'' the item.
+Defaults to 1.0.
+.OP \-confine confine Confine
+Specifies a boolean value that indicates whether or not it should be
+allowable to set the canvas's view outside the region defined by the
+\fBscrollRegion\fR argument.
+Defaults to true, which means that the view will
+be constrained within the scroll region.
+.OP \-height height Height
+Specifies a desired window height that the canvas widget should request from
+its geometry manager. The value may be specified in any
+of the forms described in the COORDINATES section below.
+.OP \-scrollregion scrollRegion ScrollRegion
+Specifies a list with four coordinates describing the left, top, right, and
+bottom coordinates of a rectangular region.
+This region is used for scrolling purposes and is considered to be
+the boundary of the information in the canvas.
+Each of the coordinates may be specified
+in any of the forms given in the COORDINATES section below.
+.OP \-width width width
+Specifies a desired window width that the canvas widget should request from
+its geometry manager. The value may be specified in any
+of the forms described in the COORDINATES section below.
+.br
+.OP \-xscrollincrement xScrollIncrement ScrollIncrement
+Specifies an increment for horizontal scrolling, in any of the usual forms
+permitted for screen distances. If the value of this option is greater
+than zero, the horizontal view in the window will be constrained so that
+the canvas x coordinate at the left edge of the window is always an even
+multiple of \fBxScrollIncrement\fR; furthermore, the units for scrolling
+(e.g., the change in view when the left and right arrows of a scrollbar
+are selected) will also be \fBxScrollIncrement\fR. If the value of
+this option is less than or equal to zero, then horizontal scrolling
+is unconstrained.
+.OP \-yscrollincrement yScrollIncrement ScrollIncrement
+Specifies an increment for vertical scrolling, in any of the usual forms
+permitted for screen distances. If the value of this option is greater
+than zero, the vertical view in the window will be constrained so that
+the canvas y coordinate at the top edge of the window is always an even
+multiple of \fByScrollIncrement\fR; furthermore, the units for scrolling
+(e.g., the change in view when the top and bottom arrows of a scrollbar
+are selected) will also be \fByScrollIncrement\fR. If the value of
+this option is less than or equal to zero, then vertical scrolling
+is unconstrained.
+.BE
+
+.SH INTRODUCTION
+.PP
+The \fBcanvas\fR command creates a new window (given
+by the \fIpathName\fR argument) and makes it into a canvas widget.
+Additional options, described above, may be specified on the
+command line or in the option database
+to configure aspects of the canvas such as its colors and 3-D relief.
+The \fBcanvas\fR command returns its
+\fIpathName\fR argument. At the time this command is invoked,
+there must not exist a window named \fIpathName\fR, but
+\fIpathName\fR's parent must exist.
+.PP
+Canvas widgets implement structured graphics.
+A canvas displays any number of \fIitems\fR, which may be things like
+rectangles, circles, lines, and text.
+Items may be manipulated (e.g. moved or re-colored) and commands may
+be associated with items in much the same way that the \fBbind\fR
+command allows commands to be bound to widgets. For example,
+a particular command may be associated with the <Button-1> event
+so that the command is invoked whenever button 1 is pressed with
+the mouse cursor over an item.
+This means that items in a canvas can have behaviors defined by
+the Tcl scripts bound to them.
+
+.SH "DISPLAY LIST"
+.PP
+The items in a canvas are ordered for purposes of display,
+with the first item in the display list being displayed
+first, followed by the next item in the list, and so on.
+Items later in the display list obscure those that are
+earlier in the display list and are sometimes referred to
+as being ``on top'' of earlier items.
+When a new item is created it is placed at the end of the
+display list, on top of everything else.
+Widget commands may be used to re-arrange the order of the
+display list.
+.PP
+Window items are an exception to the above rules. The underlying
+window systems require them always to be drawn on top of other items.
+In addition, the stacking order of window items
+is not affected by any of the canvas widget commands; you must use
+the \fBraise\fR and \fBlower\fR Tk commands instead.
+
+.SH "ITEM IDS AND TAGS"
+.PP
+Items in a canvas widget may be named in either of two ways:
+by id or by tag.
+Each item has a unique identifying number which is assigned to
+that item when it is created. The id of an item never changes
+and id numbers are never re-used within the lifetime of a
+canvas widget.
+.PP
+Each item may also have any number of \fItags\fR associated
+with it. A tag is just a string of characters, and it may
+take any form except that of an integer.
+For example, ``x123'' is OK but ``123'' isn't.
+The same tag may be associated with many different items.
+This is commonly done to group items in various interesting
+ways; for example, all selected items might be given the
+tag ``selected''.
+.PP
+The tag \fBall\fR is implicitly associated with every item
+in the canvas; it may be used to invoke operations on
+all the items in the canvas.
+.PP
+The tag \fBcurrent\fR is managed automatically by Tk;
+it applies to the \fIcurrent item\fR, which is the
+topmost item whose drawn area covers the position of
+the mouse cursor.
+If the mouse is not in the canvas widget or is not over
+an item, then no item has the \fBcurrent\fR tag.
+.PP
+When specifying items in canvas widget commands, if the
+specifier is an integer then it is assumed to refer to
+the single item with that id.
+If the specifier is not an integer, then it is assumed to
+refer to all of the items in the canvas that have a tag
+matching the specifier.
+The symbol \fItagOrId\fR is used below to indicate that
+an argument specifies either an id that selects a single
+item or a tag that selects zero or more items.
+Some widget commands only operate on a single item at a
+time; if \fItagOrId\fR is specified in a way that
+names multiple items, then the normal behavior is for
+the command to use the first (lowest) of these items in
+the display list that is suitable for the command.
+Exceptions are noted in the widget command descriptions
+below.
+
+.SH "COORDINATES"
+.PP
+All coordinates related to canvases are stored as floating-point
+numbers.
+Coordinates and distances are specified in screen units,
+which are floating-point numbers optionally followed
+by one of several letters.
+If no letter is supplied then the distance is in pixels.
+If the letter is \fBm\fR then the distance is in millimeters on
+the screen; if it is \fBc\fR then the distance is in centimeters;
+\fBi\fR means inches, and \fBp\fR means printers points (1/72 inch).
+Larger y-coordinates refer to points lower on the screen; larger
+x-coordinates refer to points farther to the right.
+
+.SH TRANSFORMATIONS
+.PP
+Normally the origin of the canvas coordinate system is at the
+upper-left corner of the window containing the canvas.
+It is possible to adjust the origin of the canvas
+coordinate system relative to the origin of the window using the
+\fBxview\fR and \fByview\fR widget commands; this is typically used
+for scrolling.
+Canvases do not support scaling or rotation of the canvas coordinate
+system relative to the window coordinate system.
+.PP
+Individual items may be moved or scaled using widget commands
+described below, but they may not be rotated.
+
+.SH "INDICES"
+.PP
+Text items support the notion of an \fIindex\fR for identifying
+particular positions within the item.
+Indices are used for commands such as inserting text, deleting
+a range of characters, and setting the insertion cursor position.
+An index may be specified in any of a number of ways, and
+different types of items may support different forms for
+specifying indices.
+Text items support the following forms for an index; if you
+define new types of text-like items, it would be advisable to
+support as many of these forms as practical.
+Note that it is possible to refer to the character just after
+the last one in the text item; this is necessary for such
+tasks as inserting new text at the end of the item.
+.TP 10
+\fInumber\fR
+A decimal number giving the position of the desired character
+within the text item.
+0 refers to the first character, 1 to the next character, and
+so on.
+A number less than 0 is treated as if it were zero, and a
+number greater than the length of the text item is treated
+as if it were equal to the length of the text item.
+.TP 10
+\fBend\fR
+Refers to the character just after the last one in the item
+(same as the number of characters in the item).
+.TP 10
+\fBinsert\fR
+Refers to the character just before which the insertion cursor
+is drawn in this item.
+.TP 10
+\fBsel.first\fR
+Refers to the first selected character in the item.
+If the selection isn't in this item then this form is illegal.
+.TP 10
+\fBsel.last\fR
+Refers to the last selected character in the item.
+If the selection isn't in this item then this form is illegal.
+.TP 10
+\fB@\fIx,y\fR
+Refers to the character at the point given by \fIx\fR and
+\fIy\fR, where \fIx\fR and \fIy\fR are specified in the coordinate
+system of the canvas.
+If \fIx\fR and \fIy\fR lie outside the coordinates covered by the
+text item, then they refer to the first or last character in the
+line that is closest to the given point.
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBcanvas\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.CS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.CE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command.
+The following widget commands are possible for canvas widgets:
+.TP
+\fIpathName \fBaddtag \fItag searchSpec \fR?\fIarg arg ...\fR?
+For each item that meets the constraints specified by
+\fIsearchSpec\fR and the \fIarg\fRs, add
+\fItag\fR to the list of tags associated with the item if it
+isn't already present on that list.
+It is possible that no items will satisfy the constraints
+given by \fIsearchSpec\fR and \fIarg\fRs, in which case the
+command has no effect.
+This command returns an empty string as result.
+\fISearchSpec\fR and \fIarg\fR's may take any of the following
+forms:
+.RS
+.TP
+\fBabove \fItagOrId\fR
+Selects the item just after (above) the one given by \fItagOrId\fR
+in the display list.
+If \fItagOrId\fR denotes more than one item, then the last (topmost)
+of these items in the display list is used.
+.TP
+\fBall\fR
+Selects all the items in the canvas.
+.TP
+\fBbelow \fItagOrId\fR
+Selects the item just before (below) the one given by \fItagOrId\fR
+in the display list.
+If \fItagOrId\fR denotes more than one item, then the first (lowest)
+of these items in the display list is used.
+.TP
+\fBclosest \fIx y \fR?\fIhalo\fR? ?\fIstart\fR?
+Selects the item closest to the point given by \fIx\fR and \fIy\fR.
+If more than one item is at the same closest distance (e.g. two
+items overlap the point), then the top-most of these items (the
+last one in the display list) is used.
+If \fIhalo\fR is specified, then it must be a non-negative
+value.
+Any item closer than \fIhalo\fR to the point is considered to
+overlap it.
+The \fIstart\fR argument may be used to step circularly through
+all the closest items.
+If \fIstart\fR is specified, it names an item using a tag or id
+(if by tag, it selects the first item in the display list with
+the given tag).
+Instead of selecting the topmost closest item, this form will
+select the topmost closest item that is below \fIstart\fR in
+the display list; if no such item exists, then the selection
+behaves as if the \fIstart\fR argument had not been specified.
+.TP
+\fBenclosed\fR \fIx1\fR \fIy1\fR \fIx2\fR \fIy2\fR
+Selects all the items completely enclosed within the rectangular
+region given by \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR.
+\fIX1\fR must be no greater then \fIx2\fR and \fIy1\fR must be
+no greater than \fIy2\fR.
+.TP
+\fBoverlapping\fR \fIx1\fR \fIy1\fR \fIx2\fR \fIy2\fR
+Selects all the items that overlap or are enclosed within the
+rectangular region given by \fIx1\fR, \fIy1\fR, \fIx2\fR,
+and \fIy2\fR.
+\fIX1\fR must be no greater then \fIx2\fR and \fIy1\fR must be
+no greater than \fIy2\fR.
+.TP
+\fBwithtag \fItagOrId\fR
+Selects all the items given by \fItagOrId\fR.
+.RE
+.TP
+\fIpathName \fBbbox \fItagOrId\fR ?\fItagOrId tagOrId ...\fR?
+Returns a list with four elements giving an approximate bounding box
+for all the items named by the \fItagOrId\fR arguments.
+The list has the form ``\fIx1 y1 x2 y2\fR'' such that the drawn
+areas of all the named elements are within the region bounded by
+\fIx1\fR on the left, \fIx2\fR on the right, \fIy1\fR on the top,
+and \fIy2\fR on the bottom.
+The return value may overestimate the actual bounding box by
+a few pixels.
+If no items match any of the \fItagOrId\fR arguments or if the
+matching items have empty bounding boxes (i.e. they have nothing
+to display)
+then an empty string is returned.
+.TP
+\fIpathName \fBbind \fItagOrId\fR ?\fIsequence\fR? ?\fIcommand\fR?
+This command associates \fIcommand\fR with all the items given by
+\fItagOrId\fR such that whenever the event sequence given by
+\fIsequence\fR occurs for one of the items the command will
+be invoked.
+This widget command is similar to the \fBbind\fR command except that
+it operates on items in a canvas rather than entire widgets.
+See the \fBbind\fR manual entry for complete details
+on the syntax of \fIsequence\fR and the substitutions performed
+on \fIcommand\fR before invoking it.
+If all arguments are specified then a new binding is created, replacing
+any existing binding for the same \fIsequence\fR and \fItagOrId\fR
+(if the first character of \fIcommand\fR is ``+'' then \fIcommand\fR
+augments an existing binding rather than replacing it).
+In this case the return value is an empty string.
+If \fIcommand\fR is omitted then the command returns the \fIcommand\fR
+associated with \fItagOrId\fR and \fIsequence\fR (an error occurs
+if there is no such binding).
+If both \fIcommand\fR and \fIsequence\fR are omitted then the command
+returns a list of all the sequences for which bindings have been
+defined for \fItagOrId\fR.
+.RS
+.PP
+.VS
+The only events for which bindings may be specified are those related to
+the mouse and keyboard (such as \fBEnter\fR, \fBLeave\fR,
+\fBButtonPress\fR, \fBMotion\fR, and \fBKeyPress\fR) or virtual events.
+The handling of events in canvases uses the current item defined in ITEM
+IDS AND TAGS above. \fBEnter\fR and \fBLeave\fR events trigger for an
+item when it becomes the current item or ceases to be the current item;
+note that these events are different than \fBEnter\fR and \fBLeave\fR
+events for windows. Mouse-related events are directed to the current
+item, if any. Keyboard-related events are directed to the focus item, if
+any (see the \fBfocus\fR widget command below for more on this). If a
+virtual event is used in a binding, that binding can trigger only if the
+virtual event is defined by an underlying mouse-related or
+keyboard-related event.
+.VE
+.PP
+It is possible for multiple bindings to match a particular event.
+This could occur, for example, if one binding is associated with the
+item's id and another is associated with one of the item's tags.
+When this occurs, all of the matching bindings are invoked.
+A binding associated with the \fBall\fR tag is invoked first,
+followed by one binding for each of the item's tags (in order),
+followed by a binding associated with the item's id.
+If there are multiple matching bindings for a single tag,
+then only the most specific binding is invoked.
+A \fBcontinue\fR command in a binding script terminates that
+script, and a \fBbreak\fR command terminates that script
+and skips any remaining scripts for the event, just as for the
+\fBbind\fR command.
+.PP
+If bindings have been created for a canvas window using the \fBbind\fR
+command, then they are invoked in addition to bindings created for
+the canvas's items using the \fBbind\fR widget command.
+The bindings for items will be invoked before any of the bindings
+for the window as a whole.
+.RE
+.TP
+\fIpathName \fBcanvasx \fIscreenx\fR ?\fIgridspacing\fR?
+Given a window x-coordinate in the canvas \fIscreenx\fR, this command returns
+the canvas x-coordinate that is displayed at that location.
+If \fIgridspacing\fR is specified, then the canvas coordinate is
+rounded to the nearest multiple of \fIgridspacing\fR units.
+.TP
+\fIpathName \fBcanvasy \fIscreeny\fR ?\fIgridspacing\fR?
+Given a window y-coordinate in the canvas \fIscreeny\fR this command returns
+the canvas y-coordinate that is displayed at that location.
+If \fIgridspacing\fR is specified, then the canvas coordinate is
+rounded to the nearest multiple of \fIgridspacing\fR units.
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBcanvas\fR
+command.
+.TP
+\fIpathName \fBconfigure ?\fIoption\fR? ?\fIvalue\fR? ?\fIoption value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBcanvas\fR
+command.
+.TP
+\fIpathName\fR \fBcoords \fItagOrId \fR?\fIx0 y0 ...\fR?
+Query or modify the coordinates that define an item.
+If no coordinates are specified, this command returns a list
+whose elements are the coordinates of the item named by
+\fItagOrId\fR.
+If coordinates are specified, then they replace the current
+coordinates for the named item.
+If \fItagOrId\fR refers to multiple items, then
+the first one in the display list is used.
+.TP
+\fIpathName \fBcreate \fItype x y \fR?\fIx y ...\fR? ?\fIoption value ...\fR?
+Create a new item in \fIpathName\fR of type \fItype\fR.
+The exact format of the arguments after \fBtype\fR depends
+on \fBtype\fR, but usually they consist of the coordinates for
+one or more points, followed by specifications for zero or
+more item options.
+See the subsections on individual item types below for more
+on the syntax of this command.
+This command returns the id for the new item.
+.TP
+\fIpathName \fBdchars \fItagOrId first \fR?\fIlast\fR?
+For each item given by \fItagOrId\fR, delete the characters
+in the range given by \fIfirst\fR and \fIlast\fR,
+inclusive.
+If some of the items given by \fItagOrId\fR don't support
+text operations, then they are ignored.
+\fIFirst\fR and \fIlast\fR are indices of characters
+within the item(s) as described in INDICES above.
+If \fIlast\fR is omitted, it defaults to \fIfirst\fR.
+This command returns an empty string.
+.TP
+\fIpathName \fBdelete \fR?\fItagOrId tagOrId ...\fR?
+Delete each of the items given by each \fItagOrId\fR, and return
+an empty string.
+.TP
+\fIpathName \fBdtag \fItagOrId \fR?\fItagToDelete\fR?
+For each of the items given by \fItagOrId\fR, delete the
+tag given by \fItagToDelete\fR from the list of those
+associated with the item.
+If an item doesn't have the tag \fItagToDelete\fR then
+the item is unaffected by the command.
+If \fItagToDelete\fR is omitted then it defaults to \fItagOrId\fR.
+This command returns an empty string.
+.TP
+\fIpathName \fBfind \fIsearchCommand \fR?\fIarg arg ...\fR?
+This command returns a list consisting of all the items that
+meet the constraints specified by \fIsearchCommand\fR and
+\fIarg\fR's.
+\fISearchCommand\fR and \fIargs\fR have any of the forms
+accepted by the \fBaddtag\fR command.
+The items are returned in stacking order, with the lowest item first.
+.TP
+\fIpathName \fBfocus \fR?\fItagOrId\fR?
+Set the keyboard focus for the canvas widget to the item given by
+\fItagOrId\fR.
+If \fItagOrId\fR refers to several items, then the focus is set
+to the first such item in the display list that supports the
+insertion cursor.
+If \fItagOrId\fR doesn't refer to any items, or if none of them
+support the insertion cursor, then the focus isn't changed.
+If \fItagOrId\fR is an empty
+string, then the focus item is reset so that no item has the focus.
+If \fItagOrId\fR is not specified then the command returns the
+id for the item that currently has the focus, or an empty string
+if no item has the focus.
+.RS
+.PP
+Once the focus has been set to an item, the item will display
+the insertion cursor and all keyboard events will be directed
+to that item.
+The focus item within a canvas and the focus window on the
+screen (set with the \fBfocus\fR command) are totally independent:
+a given item doesn't actually have the input focus unless (a)
+its canvas is the focus window and (b) the item is the focus item
+within the canvas.
+In most cases it is advisable to follow the \fBfocus\fR widget
+command with the \fBfocus\fR command to set the focus window to
+the canvas (if it wasn't there already).
+.RE
+.TP
+\fIpathName \fBgettags\fR \fItagOrId\fR
+Return a list whose elements are the tags associated with the
+item given by \fItagOrId\fR.
+If \fItagOrId\fR refers to more than one item, then the tags
+are returned from the first such item in the display list.
+If \fItagOrId\fR doesn't refer to any items, or if the item
+contains no tags, then an empty string is returned.
+.TP
+\fIpathName \fBicursor \fItagOrId index\fR
+Set the position of the insertion cursor for the item(s)
+given by \fItagOrId\fR
+to just before the character whose position is given by \fIindex\fR.
+If some or all of the items given by \fItagOrId\fR don't support
+an insertion cursor then this command has no effect on them.
+See INDICES above for a description of the
+legal forms for \fIindex\fR.
+Note: the insertion cursor is only displayed in an item if
+that item currently has the keyboard focus (see the widget
+command \fBfocus\fR, below), but the cursor position may
+be set even when the item doesn't have the focus.
+This command returns an empty string.
+.TP
+\fIpathName \fBindex \fItagOrId index\fR
+This command returns a decimal string giving the numerical index
+within \fItagOrId\fR corresponding to \fIindex\fR.
+\fIIndex\fR gives a textual description of the desired position
+as described in INDICES above.
+The return value is guaranteed to lie between 0 and the number
+of characters within the item, inclusive.
+If \fItagOrId\fR refers to multiple items, then the index
+is processed in the first of these items that supports indexing
+operations (in display list order).
+.TP
+\fIpathName \fBinsert \fItagOrId beforeThis string\fR
+For each of the items given by \fItagOrId\fR, if the item supports
+text insertion then \fIstring\fR is inserted into the item's
+text just before the character whose index is \fIbeforeThis\fR.
+See INDICES above for information about the forms allowed
+for \fIbeforeThis\fR.
+This command returns an empty string.
+.TP
+\fIpathName \fBitemcget\fR \fItagOrId\fR \fIoption\fR
+Returns the current value of the configuration option for the
+item given by \fItagOrId\fR whose name is \fIoption\fR.
+This command is similar to the \fBcget\fR widget command except that
+it applies to a particular item rather than the widget as a whole.
+\fIOption\fR may have any of the values accepted by the \fBcreate\fR
+widget command when the item was created.
+If \fItagOrId\fR is a tag that refers to more than one item,
+the first (lowest) such item is used.
+.TP
+\fIpathName \fBitemconfigure \fItagOrId\fR ?\fIoption\fR? ?\fIvalue\fR? ?\fIoption value ...\fR?
+This command is similar to the \fBconfigure\fR widget command except
+that it modifies item-specific options for the items given by
+\fItagOrId\fR instead of modifying options for the overall
+canvas widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for the first item given by \fItagOrId\fR
+(see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s) in
+each of the items given by \fItagOrId\fR; in
+this case the command returns an empty string.
+The \fIoption\fRs and \fIvalue\fRs are the same as those permissible
+in the \fBcreate\fR widget command when the item(s) were created;
+see the sections describing individual item types below for details
+on the legal options.
+.TP
+\fIpathName \fBlower \fItagOrId \fR?\fIbelowThis\fR?
+Move all of the items given by \fItagOrId\fR to a new position
+in the display list just before the item given by \fIbelowThis\fR.
+If \fItagOrId\fR refers to more than one item then all are moved
+but the relative order of the moved items will not be changed.
+\fIBelowThis\fR is a tag or id; if it refers to more than one
+item then the first (lowest) of these items in the display list is used
+as the destination location for the moved items.
+Note: this command has no effect on window items. Window items always
+obscure other item types, and the stacking order of window items is
+determined by the \fBraise\fR and \fBlower\fR commands, not the
+\fBraise\fR and \fBlower\fR widget commands for canvases.
+This command returns an empty string.
+.TP
+\fIpathName \fBmove \fItagOrId xAmount yAmount\fR
+Move each of the items given by \fItagOrId\fR in the canvas coordinate
+space by adding \fIxAmount\fR to the x-coordinate of each point
+associated with the item and \fIyAmount\fR to the y-coordinate of
+each point associated with the item.
+This command returns an empty string.
+.TP
+\fIpathName \fBpostscript \fR?\fIoption value option value ...\fR?
+Generate a Postscript representation for part or all of the canvas.
+If the \fB\-file\fR option is specified then the Postscript is written
+to a file and an empty string is returned; otherwise the Postscript
+is returned as the result of the command.
+.VS
+If the interpreter that owns the canvas is marked as safe, the operation
+will fail because safe interpreters are not allowed to write files.
+If the \fB\-channel\fR option is specified, the argument denotes the name
+of a channel already opened for writing. The Postscript is written to
+that channel, and the channel is left open for further writing at the end
+of the operation.
+.VE
+The Postscript is created in Encapsulated Postscript form using
+version 3.0 of the Document Structuring Conventions.
+Note: by default Postscript is only generated for information that
+appears in the canvas's window on the screen. If the canvas is
+freshly created it may still have its initial size of 1x1 pixel
+so nothing will appear in the Postscript. To get around this problem
+either invoke the "update" command to wait for the canvas window
+to reach its final size, or else use the \fB\-width\fR and \fB\-height\fR
+options to specify the area of the canvas to print.
+The \fIoption\fR\-\fIvalue\fR argument pairs provide additional
+information to control the generation of Postscript. The following
+options are supported:
+.RS
+.TP
+\fB\-colormap \fIvarName\fR
+\fIVarName\fR must be the name of an array variable
+that specifies a color mapping to use in the Postscript.
+Each element of \fIvarName\fR must consist of Postscript
+code to set a particular color value (e.g. ``\fB1.0 1.0 0.0 setrgbcolor\fR'').
+When outputting color information in the Postscript, Tk checks
+to see if there is an element of \fIvarName\fR with the same
+name as the color.
+If so, Tk uses the value of the element as the Postscript command
+to set the color.
+If this option hasn't been specified, or if there isn't an entry
+in \fIvarName\fR for a given color, then Tk uses the red, green,
+and blue intensities from the X color.
+.TP
+\fB\-colormode \fImode\fR
+Specifies how to output color information. \fIMode\fR must be either
+\fBcolor\fR (for full color output), \fBgray\fR (convert all colors
+to their gray-scale equivalents) or \fBmono\fR (convert all colors
+to black or white).
+.TP
+\fB\-file \fIfileName\fR
+Specifies the name of the file in which to write the Postscript.
+If this option isn't specified then the Postscript is returned as the
+result of the command instead of being written to a file.
+.TP
+\fB\-fontmap \fIvarName\fR
+\fIVarName\fR must be the name of an array variable
+that specifies a font mapping to use in the Postscript.
+Each element of \fIvarName\fR must consist of a Tcl list with
+two elements, which are the name and point size of a Postscript font.
+When outputting Postscript commands for a particular font, Tk
+checks to see if \fIvarName\fR contains an element with the same
+name as the font.
+If there is such an element, then the font information contained in
+that element is used in the Postscript.
+Otherwise Tk attempts to guess what Postscript font to use.
+Tk's guesses generally only work for well-known fonts such as
+Times and Helvetica and Courier, and only if the X font name does not
+omit any dashes up through the point size.
+For example, \fB\-*\-Courier\-Bold\-R\-Normal\-\-*\-120\-*\fR will work but
+\fB*Courier\-Bold\-R\-Normal*120*\fR will not; Tk needs the dashes to
+parse the font name).
+.TP
+\fB\-height \fIsize\fR
+Specifies the height of the area of the canvas to print.
+Defaults to the height of the canvas window.
+.TP
+\fB\-pageanchor \fIanchor\fR
+Specifies which point of the printed area of the canvas should appear over
+the positioning point on the page (which is given by the \fB\-pagex\fR
+and \fB\-pagey\fR options).
+For example, \fB\-pageanchor n\fR means that the top center of the
+area of the canvas being printed (as it appears in the canvas window)
+should be over the positioning point. Defaults to \fBcenter\fR.
+.TP
+\fB\-pageheight \fIsize\fR
+Specifies that the Postscript should be scaled in both x and y so
+that the printed area is \fIsize\fR high on the Postscript page.
+\fISize\fR consists of a floating-point number followed by
+\fBc\fR for centimeters, \fBi\fR for inches, \fBm\fR for millimeters,
+or \fBp\fR or nothing for printer's points (1/72 inch).
+Defaults to the height of the printed area on the screen.
+If both \fB\-pageheight\fR and \fB\-pagewidth\fR are specified then
+the scale factor from \fB\-pagewidth\fR is used (non-uniform scaling
+is not implemented).
+.TP
+\fB\-pagewidth \fIsize\fR
+Specifies that the Postscript should be scaled in both x and y so
+that the printed area is \fIsize\fR wide on the Postscript page.
+\fISize\fR has the same form as for \fB\-pageheight\fR.
+Defaults to the width of the printed area on the screen.
+If both \fB\-pageheight\fR and \fB\-pagewidth\fR are specified then
+the scale factor from \fB\-pagewidth\fR is used (non-uniform scaling
+is not implemented).
+.TP
+\fB\-pagex \fIposition\fR
+\fIPosition\fR gives the x-coordinate of the positioning point on
+the Postscript page, using any of the forms allowed for \fB\-pageheight\fR.
+Used in conjunction with the \fB\-pagey\fR and \fB\-pageanchor\fR options
+to determine where the printed area appears on the Postscript page.
+Defaults to the center of the page.
+.TP
+\fB\-pagey \fIposition\fR
+\fIPosition\fR gives the y-coordinate of the positioning point on
+the Postscript page, using any of the forms allowed for \fB\-pageheight\fR.
+Used in conjunction with the \fB\-pagex\fR and \fB\-pageanchor\fR options
+to determine where the printed area appears on the Postscript page.
+Defaults to the center of the page.
+.TP
+\fB\-rotate \fIboolean\fR
+\fIBoolean\fR specifies whether the printed area is to be rotated 90
+degrees.
+In non-rotated output the x-axis of the printed area runs along
+the short dimension of the page (``portrait'' orientation);
+in rotated output the x-axis runs along the long dimension of the
+page (``landscape'' orientation).
+Defaults to non-rotated.
+.TP
+\fB\-width \fIsize\fR
+Specifies the width of the area of the canvas to print.
+Defaults to the width of the canvas window.
+.TP
+\fB\-x \fIposition\fR
+Specifies the x-coordinate of the left edge of the area of the
+canvas that is to be printed, in canvas coordinates, not window
+coordinates.
+Defaults to the coordinate of the left edge of the window.
+.TP
+\fB\-y \fIposition\fR
+Specifies the y-coordinate of the top edge of the area of the
+canvas that is to be printed, in canvas coordinates, not window
+coordinates.
+Defaults to the coordinate of the top edge of the window.
+.RE
+.TP
+\fIpathName \fBraise \fItagOrId \fR?\fIaboveThis\fR?
+Move all of the items given by \fItagOrId\fR to a new position
+in the display list just after the item given by \fIaboveThis\fR.
+If \fItagOrId\fR refers to more than one item then all are moved
+but the relative order of the moved items will not be changed.
+\fIAboveThis\fR is a tag or id; if it refers to more than one
+item then the last (topmost) of these items in the display list is used
+as the destination location for the moved items.
+Note: this command has no effect on window items. Window items always
+obscure other item types, and the stacking order of window items is
+determined by the \fBraise\fR and \fBlower\fR commands, not the
+\fBraise\fR and \fBlower\fR widget commands for canvases.
+This command returns an empty string.
+.TP
+\fIpathName \fBscale \fItagOrId xOrigin yOrigin xScale yScale\fR
+Rescale all of the items given by \fItagOrId\fR in canvas coordinate
+space.
+\fIXOrigin\fR and \fIyOrigin\fR identify the origin for the scaling
+operation and \fIxScale\fR and \fIyScale\fR identify the scale
+factors for x- and y-coordinates, respectively (a scale factor of
+1.0 implies no change to that coordinate).
+For each of the points defining each item, the x-coordinate is
+adjusted to change the distance from \fIxOrigin\fR by a factor
+of \fIxScale\fR.
+Similarly, each y-coordinate is adjusted to change the distance
+from \fIyOrigin\fR by a factor of \fIyScale\fR.
+This command returns an empty string.
+.TP
+\fIpathName \fBscan\fR \fIoption args\fR
+This command is used to implement scanning on canvases. It has
+two forms, depending on \fIoption\fR:
+.RS
+.TP
+\fIpathName \fBscan mark \fIx y\fR
+Records \fIx\fR and \fIy\fR and the canvas's current view; used
+in conjunction with later \fBscan dragto\fR commands.
+Typically this command is associated with a mouse button press in
+the widget and \fIx\fR and \fIy\fR are the coordinates of the
+mouse. It returns an empty string.
+.TP
+\fIpathName \fBscan dragto \fIx y\fR.
+This command computes the difference between its \fIx\fR and \fIy\fR
+arguments (which are typically mouse coordinates) and the \fIx\fR and
+\fIy\fR arguments to the last \fBscan mark\fR command for the widget.
+It then adjusts the view by 10 times the
+difference in coordinates. This command is typically associated
+with mouse motion events in the widget, to produce the effect of
+dragging the canvas at high speed through its window. The return
+value is an empty string.
+.RE
+.TP
+\fIpathName \fBselect \fIoption\fR ?\fItagOrId arg\fR?
+Manipulates the selection in one of several ways, depending on
+\fIoption\fR.
+The command may take any of the forms described below.
+In all of the descriptions below, \fItagOrId\fR must refer to
+an item that supports indexing and selection; if it refers to
+multiple items then the first of
+these that supports indexing and the selection is used.
+\fIIndex\fR gives a textual description of a position
+within \fItagOrId\fR, as described in INDICES above.
+.RS
+.TP
+\fIpathName \fBselect adjust \fItagOrId index\fR
+Locate the end of the selection in \fItagOrId\fR nearest
+to the character given by \fIindex\fR, and adjust that
+end of the selection to be at \fIindex\fR (i.e. including
+but not going beyond \fIindex\fR).
+The other end of the selection is made the anchor point
+for future \fBselect to\fR commands.
+If the selection isn't currently in \fItagOrId\fR then
+this command behaves the same as the \fBselect to\fR widget
+command.
+Returns an empty string.
+.TP
+\fIpathName \fBselect clear\fR
+Clear the selection if it is in this widget.
+If the selection isn't in this widget then the command
+has no effect.
+Returns an empty string.
+.TP
+\fIpathName \fBselect from \fItagOrId index\fR
+Set the selection anchor point for the widget to be just
+before the character
+given by \fIindex\fR in the item given by \fItagOrId\fR.
+This command doesn't change the selection; it just sets
+the fixed end of the selection for future \fBselect to\fR
+commands.
+Returns an empty string.
+.TP
+\fIpathName \fBselect item\fR
+Returns the id of the selected item, if the selection is in an
+item in this canvas.
+If the selection is not in this canvas then an empty string
+is returned.
+.TP
+\fIpathName \fBselect to \fItagOrId index\fR
+Set the selection to consist of those characters of \fItagOrId\fR
+between the selection anchor point and
+\fIindex\fR.
+The new selection will include the character given by \fIindex\fR;
+it will include the character given by the anchor point only if
+\fIindex\fR is greater than or equal to the anchor point.
+The anchor point is determined by the most recent \fBselect adjust\fR
+or \fBselect from\fR command for this widget.
+If the selection anchor point for the widget isn't currently in
+\fItagOrId\fR, then it is set to the same character given
+by \fIindex\fR.
+Returns an empty string.
+.RE
+.TP
+\fIpathName \fBtype\fI tagOrId\fR
+Returns the type of the item given by \fItagOrId\fR, such as
+\fBrectangle\fR or \fBtext\fR.
+If \fItagOrId\fR refers to more than one item, then the type
+of the first item in the display list is returned.
+If \fItagOrId\fR doesn't refer to any items at all then
+an empty string is returned.
+.TP
+\fIpathName \fBxview \fR?\fIargs\fR?
+This command is used to query and change the horizontal position of the
+information displayed in the canvas's window.
+It can take any of the following forms:
+.RS
+.TP
+\fIpathName \fBxview\fR
+Returns a list containing two elements.
+Each element is a real fraction between 0 and 1; together they describe
+the horizontal span that is visible in the window.
+For example, if the first element is .2 and the second element is .6,
+20% of the canvas's area (as defined by the \fB\-scrollregion\fR option)
+is off-screen to the left, the middle 40% is visible
+in the window, and 40% of the canvas is off-screen to the right.
+These are the same values passed to scrollbars via the \fB\-xscrollcommand\fR
+option.
+.TP
+\fIpathName \fBxview moveto\fI fraction\fR
+Adjusts the view in the window so that \fIfraction\fR of the
+total width of the canvas is off-screen to the left.
+\fIFraction\fR must be a fraction between 0 and 1.
+.TP
+\fIpathName \fBxview scroll \fInumber what\fR
+This command shifts the view in the window left or right according to
+\fInumber\fR and \fIwhat\fR.
+\fINumber\fR must be an integer.
+\fIWhat\fR must be either \fBunits\fR or \fBpages\fR or an abbreviation
+of one of these.
+If \fIwhat\fR is \fBunits\fR, the view adjusts left or right in units
+of the \fBxScrollIncrement\fR option, if it is greater than zero,
+or in units of one-tenth the window's width otherwise.
+If \fIwhat is \fBpages\fR then the view
+adjusts in units of nine-tenths the window's width.
+If \fInumber\fR is negative then information farther to the left
+becomes visible; if it is positive then information farther to the right
+becomes visible.
+.RE
+.TP
+\fIpathName \fByview \fI?args\fR?
+This command is used to query and change the vertical position of the
+information displayed in the canvas's window.
+It can take any of the following forms:
+.RS
+.TP
+\fIpathName \fByview\fR
+Returns a list containing two elements.
+Each element is a real fraction between 0 and 1; together they describe
+the vertical span that is visible in the window.
+For example, if the first element is .6 and the second element is 1.0,
+the lowest 40% of the canvas's area (as defined by the \fB\-scrollregion\fR
+option) is visible in the window.
+These are the same values passed to scrollbars via the \fB\-yscrollcommand\fR
+option.
+.TP
+\fIpathName \fByview moveto\fI fraction\fR
+Adjusts the view in the window so that \fIfraction\fR of the canvas's
+area is off-screen to the top.
+\fIFraction\fR is a fraction between 0 and 1.
+.TP
+\fIpathName \fByview scroll \fInumber what\fR
+This command adjusts the view in the window up or down according to
+\fInumber\fR and \fIwhat\fR.
+\fINumber\fR must be an integer.
+\fIWhat\fR must be either \fBunits\fR or \fBpages\fR.
+If \fIwhat\fR is \fBunits\fR, the view adjusts up or down in units
+of the \fByScrollIncrement\fR option, if it is greater than zero,
+or in units of one-tenth the window's height otherwise.
+If \fIwhat\fR is \fBpages\fR then
+the view adjusts in units of nine-tenths the window's height.
+If \fInumber\fR is negative then higher information becomes
+visible; if it is positive then lower information
+becomes visible.
+.RE
+
+.SH "OVERVIEW OF ITEM TYPES"
+.PP
+The sections below describe the various types of items supported
+by canvas widgets. Each item type is characterized by two things:
+first, the form of the \fBcreate\fR command used to create
+instances of the type; and second, a set of configuration options
+for items of that type, which may be used in the
+\fBcreate\fR and \fBitemconfigure\fR widget commands.
+Most items don't support indexing or selection or the commands
+related to them, such as \fBindex\fR and \fBinsert\fR.
+Where items do support these facilities, it is noted explicitly
+in the descriptions below (at present, only text items provide
+this support).
+
+.SH "ARC ITEMS"
+.PP
+Items of type \fBarc\fR appear on the display as arc-shaped regions.
+An arc is a section of an oval delimited by two angles (specified
+by the \fB\-start\fR and \fB\-extent\fR options) and displayed in
+one of several ways (specified by the \fB\-style\fR option).
+Arcs are created with widget commands of the following form:
+.CS
+\fIpathName \fBcreate arc \fIx1 y1 x2 y2 \fR?\fIoption value option value ...\fR?
+.CE
+The arguments \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR give
+the coordinates of two diagonally opposite corners of a
+rectangular region enclosing the oval that defines the arc.
+After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR
+pairs, each of which sets one of the configuration options
+for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be
+used in \fBitemconfigure\fR widget commands to change the item's
+configuration.
+The following options are supported for arcs:
+.TP
+\fB\-extent \fIdegrees\fR
+Specifies the size of the angular range occupied by the arc.
+The arc's range extends for \fIdegrees\fR degrees counter-clockwise
+from the starting angle given by the \fB\-start\fR option.
+\fIDegrees\fR may be negative.
+If it is greater than 360 or less than -360, then \fIdegrees\fR
+modulo 360 is used as the extent.
+.TP
+\fB\-fill \fIcolor\fR
+Fill the region of the arc with \fIcolor\fR.
+\fIColor\fR may have any of the forms accepted by \fBTk_GetColor\fR.
+If \fIcolor\fR is an empty string (the default), then
+then the arc will not be filled.
+.TP
+\fB\-outline \fIcolor\fR
+\fIColor\fR specifies a color to use for drawing the arc's
+outline; it may have any of the forms accepted by \fBTk_GetColor\fR.
+This option defaults to \fBblack\fR. If \fIcolor\fR is specified
+as an empty string then no outline is drawn for the arc.
+.TP
+\fB\-outlinestipple \fIbitmap\fR
+Indicates that the outline for the arc should be drawn with a stipple pattern;
+\fIbitmap\fR specifies the stipple pattern to use, in any of the
+forms accepted by \fBTk_GetBitmap\fR.
+If the \fB\-outline\fR option hasn't been specified then this option
+has no effect.
+If \fIbitmap\fR is an empty string (the default), then the outline is drawn
+in a solid fashion.
+.TP
+\fB\-start \fIdegrees\fR
+Specifies the beginning of the angular range occupied by the
+arc.
+\fIDegrees\fR is given in units of degrees measured counter-clockwise
+from the 3-o'clock position; it may be either positive or negative.
+.TP
+\fB\-stipple \fIbitmap\fR
+Indicates that the arc should be filled in a stipple pattern;
+\fIbitmap\fR specifies the stipple pattern to use, in any of the
+forms accepted by \fBTk_GetBitmap\fR.
+If the \fB\-fill\fR option hasn't been specified then this option
+has no effect.
+If \fIbitmap\fR is an empty string (the default), then filling is done
+in a solid fashion.
+.TP
+\fB\-style \fItype\fR
+Specifies how to draw the arc. If \fItype\fR is \fBpieslice\fR
+(the default) then the arc's region is defined by a section
+of the oval's perimeter plus two line segments, one between the center
+of the oval and each end of the perimeter section.
+If \fItype\fR is \fBchord\fR then the arc's region is defined
+by a section of the oval's perimeter plus a single line segment
+connecting the two end points of the perimeter section.
+If \fItype\fR is \fBarc\fR then the arc's region consists of
+a section of the perimeter alone.
+In this last case the \fB\-fill\fR option is ignored.
+.TP
+\fB\-tags \fItagList\fR
+Specifies a set of tags to apply to the item.
+\fITagList\fR consists of a list of tag names, which replace any
+existing tags for the item.
+\fITagList\fR may be an empty list.
+.TP
+\fB\-width \fIoutlineWidth\fR
+Specifies the width of the outline to be drawn around
+the arc's region, in any of the forms described in the COORDINATES
+section above.
+If the \fB\-outline\fR option has been specified as an empty string
+then this option has no effect.
+Wide outlines will be drawn centered on the edges of the arc's region.
+This option defaults to 1.0.
+
+.SH "BITMAP ITEMS"
+.PP
+Items of type \fBbitmap\fR appear on the display as images with
+two colors, foreground and background.
+Bitmaps are created with widget commands of the following form:
+.CS
+\fIpathName \fBcreate bitmap \fIx y \fR?\fIoption value option value ...\fR?
+.CE
+The arguments \fIx\fR and \fIy\fR specify the coordinates of a
+point used to position the bitmap on the display (see the \fB\-anchor\fR
+option below for more information on how bitmaps are displayed).
+After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR
+pairs, each of which sets one of the configuration options
+for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be
+used in \fBitemconfigure\fR widget commands to change the item's
+configuration.
+The following options are supported for bitmaps:
+.TP
+\fB\-anchor \fIanchorPos\fR
+\fIAnchorPos\fR tells how to position the bitmap relative to the
+positioning point for the item; it may have any of the forms
+accepted by \fBTk_GetAnchor\fR. For example, if \fIanchorPos\fR
+is \fBcenter\fR then the bitmap is centered on the point; if
+\fIanchorPos\fR is \fBn\fR then the bitmap will be drawn so that
+its top center point is at the positioning point.
+This option defaults to \fBcenter\fR.
+.TP
+\fB\-background \fIcolor\fR
+Specifies a color to use for each of the bitmap pixels
+whose value is 0.
+\fIColor\fR may have any of the forms accepted by \fBTk_GetColor\fR.
+If this option isn't specified, or if it is specified as an empty
+string, then nothing is displayed where the bitmap pixels are 0; this
+produces a transparent effect.
+.TP
+\fB\-bitmap \fIbitmap\fR
+Specifies the bitmap to display in the item.
+\fIBitmap\fR may have any of the forms accepted by \fBTk_GetBitmap\fR.
+.TP
+\fB\-foreground \fIcolor\fR
+Specifies a color to use for each of the bitmap pixels
+whose value is 1.
+\fIColor\fR may have any of the forms accepted by \fBTk_GetColor\fR and
+defaults to \fBblack\fR.
+.TP
+\fB\-tags \fItagList\fR
+Specifies a set of tags to apply to the item.
+\fITagList\fR consists of a list of tag names, which replace any
+existing tags for the item.
+\fITagList\fR may be an empty list.
+
+.SH "IMAGE ITEMS"
+.PP
+Items of type \fBimage\fR are used to display images on a
+canvas.
+Images are created with widget commands of the following form:
+.CS
+\fIpathName \fBcreate image \fIx y \fR?\fIoption value option value ...\fR?
+.CE
+The arguments \fIx\fR and \fIy\fR specify the coordinates of a
+point used to position the image on the display (see the \fB\-anchor\fR
+option below for more information).
+After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR
+pairs, each of which sets one of the configuration options
+for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be
+used in \fBitemconfigure\fR widget commands to change the item's
+configuration.
+The following options are supported for images:
+.TP
+\fB\-anchor \fIanchorPos\fR
+\fIAnchorPos\fR tells how to position the image relative to the
+positioning point for the item; it may have any of the forms
+accepted by \fBTk_GetAnchor\fR. For example, if \fIanchorPos\fR
+is \fBcenter\fR then the image is centered on the point; if
+\fIanchorPos\fR is \fBn\fR then the image will be drawn so that
+its top center point is at the positioning point.
+This option defaults to \fBcenter\fR.
+.TP
+\fB\-image \fIname\fR
+Specifies the name of the image to display in the item.
+This image must have been created previously with the
+\fBimage create\fR command.
+.TP
+\fB\-tags \fItagList\fR
+Specifies a set of tags to apply to the item.
+\fITagList\fR consists of a list of tag names, which replace any
+existing tags for the item; it may be an empty list.
+
+.SH "LINE ITEMS"
+.PP
+Items of type \fBline\fR appear on the display as one or more connected
+line segments or curves.
+Lines are created with widget commands of the following form:
+.CS
+\fIpathName \fBcreate line \fIx1 y1... xn yn \fR?\fIoption value option value ...\fR?
+.CE
+The arguments \fIx1\fR through \fIyn\fR give
+the coordinates for a series of two or more points that describe
+a series of connected line segments.
+After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR
+pairs, each of which sets one of the configuration options
+for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be
+used in \fBitemconfigure\fR widget commands to change the item's
+configuration.
+The following options are supported for lines:
+.TP
+\fB\-arrow \fIwhere\fR
+Indicates whether or not arrowheads are to be drawn at one or both
+ends of the line.
+\fIWhere\fR must have one of the values \fBnone\fR (for no arrowheads),
+\fBfirst\fR (for an arrowhead at the first point of the line),
+\fBlast\fR (for an arrowhead at the last point of the line), or
+\fBboth\fR (for arrowheads at both ends).
+This option defaults to \fBnone\fR.
+.TP
+\fB\-arrowshape \fIshape\fR
+This option indicates how to draw arrowheads.
+The \fIshape\fR argument must be a list with three elements, each
+specifying a distance in any of the forms described in
+the COORDINATES section above.
+The first element of the list gives the distance along the line
+from the neck of the arrowhead to its tip.
+The second element gives the distance along the line from the
+trailing points of the arrowhead to the tip, and the third
+element gives the distance from the outside edge of the line to the
+trailing points.
+If this option isn't specified then Tk picks a ``reasonable'' shape.
+.TP
+\fB\-capstyle \fIstyle\fR
+Specifies the ways in which caps are to be drawn at the endpoints
+of the line.
+\fIStyle\fR may have any of the forms accepted by \fBTk_GetCapStyle\fR
+(\fBbutt\fR, \fBprojecting\fR, or \fBround\fR).
+If this option isn't specified then it defaults to \fBbutt\fR.
+Where arrowheads are drawn the cap style is ignored.
+.TP
+\fB\-fill \fIcolor\fR
+\fIColor\fR specifies a color to use for drawing the line; it may have
+any of the forms acceptable to \fBTk_GetColor\fR. It may also be an
+empty string, in which case the line will be transparent.
+This option defaults to \fBblack\fR.
+.TP
+\fB\-joinstyle \fIstyle\fR
+Specifies the ways in which joints are to be drawn at the vertices
+of the line.
+\fIStyle\fR may have any of the forms accepted by \fBTk_GetCapStyle\fR
+(\fBbevel\fR, \fBmiter\fR, or \fBround\fR).
+If this option isn't specified then it defaults to \fBmiter\fR.
+If the line only contains two points then this option is
+irrelevant.
+.TP
+\fB\-smooth \fIboolean\fR
+\fIBoolean\fR must have one of the forms accepted by \fBTk_GetBoolean\fR.
+It indicates whether or not the line should be drawn as a curve.
+If so, the line is rendered as a set of parabolic splines: one spline
+is drawn for the first and second line segments, one for the second
+and third, and so on. Straight-line segments can be generated within
+a curve by duplicating the end-points of the desired line segment.
+.TP
+\fB\-splinesteps \fInumber\fR
+Specifies the degree of smoothness desired for curves: each spline
+will be approximated with \fInumber\fR line segments. This
+option is ignored unless the \fB\-smooth\fR option is true.
+.TP
+\fB\-stipple \fIbitmap\fR
+Indicates that the line should be filled in a stipple pattern;
+\fIbitmap\fR specifies the stipple pattern to use, in any of the
+forms accepted by \fBTk_GetBitmap\fR.
+If \fIbitmap\fR is an empty string (the default), then filling is
+done in a solid fashion.
+.TP
+\fB\-tags \fItagList\fR
+Specifies a set of tags to apply to the item.
+\fITagList\fR consists of a list of tag names, which replace any
+existing tags for the item.
+\fITagList\fR may be an empty list.
+.TP
+\fB\-width \fIlineWidth\fR
+\fILineWidth\fR specifies the width of the line, in any of the forms
+described in the COORDINATES section above.
+Wide lines will be drawn centered on the path specified by the
+points.
+If this option isn't specified then it defaults to 1.0.
+
+.SH "OVAL ITEMS"
+.PP
+Items of type \fBoval\fR appear as circular or oval regions on
+the display. Each oval may have an outline, a fill, or
+both. Ovals are created with widget commands of the
+following form:
+.CS
+\fIpathName \fBcreate oval \fIx1 y1 x2 y2 \fR?\fIoption value option value ...\fR?
+.CE
+The arguments \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR give
+the coordinates of two diagonally opposite corners of a
+rectangular region enclosing the oval.
+The oval will include the top and left edges of the rectangle
+not the lower or right edges.
+If the region is square then the resulting oval is circular;
+otherwise it is elongated in shape.
+After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR
+pairs, each of which sets one of the configuration options
+for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be
+used in \fBitemconfigure\fR widget commands to change the item's
+configuration.
+The following options are supported for ovals:
+.TP
+\fB\-fill \fIcolor\fR
+Fill the area of the oval with \fIcolor\fR.
+\fIColor\fR may have any of the forms accepted by \fBTk_GetColor\fR.
+If \fIcolor\fR is an empty string (the default), then
+then the oval will not be filled.
+.TP
+\fB\-outline \fIcolor\fR
+\fIColor\fR specifies a color to use for drawing the oval's
+outline; it may have any of the forms accepted by \fBTk_GetColor\fR.
+This option defaults to \fBblack\fR.
+If \fIcolor\fR is an empty string then no outline will be
+drawn for the oval.
+.TP
+\fB\-stipple \fIbitmap\fR
+Indicates that the oval should be filled in a stipple pattern;
+\fIbitmap\fR specifies the stipple pattern to use, in any of the
+forms accepted by \fBTk_GetBitmap\fR.
+If the \fB\-fill\fR option hasn't been specified then this option
+has no effect.
+If \fIbitmap\fR is an empty string (the default), then filling is done
+in a solid fashion.
+.TP
+\fB\-tags \fItagList\fR
+Specifies a set of tags to apply to the item.
+\fITagList\fR consists of a list of tag names, which replace any
+existing tags for the item.
+\fITagList\fR may be an empty list.
+.TP
+\fB\-width \fIoutlineWidth\fR
+\fIoutlineWidth\fR specifies the width of the outline to be drawn around
+the oval, in any of the forms described in the COORDINATES section above.
+If the \fB\-outline\fR option hasn't been specified then this option
+has no effect.
+Wide outlines are drawn centered on the oval path defined by
+\fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR.
+This option defaults to 1.0.
+
+.SH "POLYGON ITEMS"
+.PP
+Items of type \fBpolygon\fR appear as polygonal or curved filled regions
+on the display.
+Polygons are created with widget commands of the following form:
+.CS
+\fIpathName \fBcreate polygon \fIx1 y1 ... xn yn \fR?\fIoption value option value ...\fR?
+.CE
+The arguments \fIx1\fR through \fIyn\fR specify the coordinates for
+three or more points that define a closed polygon.
+The first and last points may be the same; whether they are or not,
+Tk will draw the polygon as a closed polygon.
+After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR
+pairs, each of which sets one of the configuration options
+for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be
+used in \fBitemconfigure\fR widget commands to change the item's
+configuration.
+The following options are supported for polygons:
+.TP
+\fB\-fill \fIcolor\fR
+\fIColor\fR specifies a color to use for filling the area of the
+polygon; it may have any of the forms acceptable to \fBTk_GetColor\fR.
+If \fIcolor\fR is an empty string then the polygon will be
+transparent.
+This option defaults to \fBblack\fR.
+.TP
+\fB\-outline \fIcolor\fR
+\fIColor\fR specifies a color to use for drawing the polygon's
+outline; it may have any of the forms accepted by \fBTk_GetColor\fR.
+If \fIcolor\fR is an empty string then no outline will be
+drawn for the polygon.
+This option defaults to empty (no outline).
+.TP
+\fB\-smooth \fIboolean\fR
+\fIBoolean\fR must have one of the forms accepted by \fBTk_GetBoolean\fR
+It indicates whether or not the polygon should be drawn with a
+curved perimeter.
+If so, the outline of the polygon becomes a set of parabolic splines,
+one spline for the first and second line segments, one for the second
+and third, and so on. Straight-line segments can be generated in a
+smoothed polygon by duplicating the end-points of the desired line segment.
+.TP
+\fB\-splinesteps \fInumber\fR
+Specifies the degree of smoothness desired for curves: each spline
+will be approximated with \fInumber\fR line segments. This
+option is ignored unless the \fB\-smooth\fR option is true.
+.TP
+\fB\-stipple \fIbitmap\fR
+Indicates that the polygon should be filled in a stipple pattern;
+\fIbitmap\fR specifies the stipple pattern to use, in any of the
+forms accepted by \fBTk_GetBitmap\fR.
+If \fIbitmap\fR is an empty string (the default), then filling is
+done in a solid fashion.
+.TP
+\fB\-tags \fItagList\fR
+Specifies a set of tags to apply to the item.
+\fITagList\fR consists of a list of tag names, which replace any
+existing tags for the item.
+\fITagList\fR may be an empty list.
+.TP
+\fB\-width \fIoutlineWidth\fR
+\fIOutlineWidth\fR specifies the width of the outline to be drawn around
+the polygon, in any of the forms described in the COORDINATES section above.
+If the \fB\-outline\fR option hasn't been specified then this option
+has no effect. This option defaults to 1.0.
+.PP
+Polygon items are different from other items such as rectangles, ovals
+and arcs in that interior points are considered to be ``inside'' a
+polygon (e.g. for purposes of the \fBfind closest\fR and
+\fBfind overlapping\fR widget commands) even if it is not filled.
+For most other item types, an
+interior point is considered to be inside the item only if the item
+is filled or if it has neither a fill nor an outline. If you would
+like an unfilled polygon whose interior points are not considered
+to be inside the polygon, use a line item instead.
+
+.SH "RECTANGLE ITEMS"
+.PP
+Items of type \fBrectangle\fR appear as rectangular regions on
+the display. Each rectangle may have an outline, a fill, or
+both. Rectangles are created with widget commands of the
+following form:
+.CS
+\fIpathName \fBcreate rectangle \fIx1 y1 x2 y2 \fR?\fIoption value option value ...\fR?
+.CE
+The arguments \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR give
+the coordinates of two diagonally opposite corners of the rectangle
+(the rectangle will include its upper and left edges but not
+its lower or right edges).
+After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR
+pairs, each of which sets one of the configuration options
+for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be
+used in \fBitemconfigure\fR widget commands to change the item's
+configuration.
+The following options are supported for rectangles:
+.TP
+\fB\-fill \fIcolor\fR
+Fill the area of the rectangle with \fIcolor\fR, which may be
+specified in any of the forms accepted by \fBTk_GetColor\fR.
+If \fIcolor\fR is an empty string (the default),
+then the rectangle will not be filled.
+.TP
+\fB\-outline \fIcolor\fR
+Draw an outline around the edge of the rectangle in \fIcolor\fR.
+\fIColor\fR may have any of the forms accepted by \fBTk_GetColor\fR.
+This option defaults to \fBblack\fR.
+If \fIcolor\fR is an empty string then no outline will be
+drawn for the rectangle.
+.TP
+\fB\-stipple \fIbitmap\fR
+Indicates that the rectangle should be filled in a stipple pattern;
+\fIbitmap\fR specifies the stipple pattern to use, in any of the
+forms accepted by \fBTk_GetBitmap\fR.
+If the \fB\-fill\fR option hasn't been specified then this option
+has no effect.
+If \fIbitmap\fR is an empty string (the default), then filling
+is done in a solid fashion.
+.TP
+\fB\-tags \fItagList\fR
+Specifies a set of tags to apply to the item.
+\fITagList\fR consists of a list of tag names, which replace any
+existing tags for the item.
+\fITagList\fR may be an empty list.
+.TP
+\fB\-width \fIoutlineWidth\fR
+\fIOutlineWidth\fR specifies the width of the outline to be drawn around
+the rectangle, in any of the forms described in the COORDINATES section above.
+If the \fB\-outline\fR option hasn't been specified then this option
+has no effect.
+Wide outlines are drawn centered on the rectangular path
+defined by \fIx1\fR, \fIy1\fR, \fIx2\fR, and \fIy2\fR.
+This option defaults to 1.0.
+
+.SH "TEXT ITEMS"
+.PP
+A text item displays a string of characters on the screen in one
+or more lines.
+Text items support indexing and selection, along with the
+following text-related canvas widget commands: \fBdchars\fR,
+\fBfocus\fR, \fBicursor\fR, \fBindex\fR, \fBinsert\fR,
+\fBselect\fR.
+Text items are created with widget commands of the following
+form:
+.CS
+\fIpathName \fBcreate text \fIx y \fR?\fIoption value option value ...\fR?
+.CE
+The arguments \fIx\fR and \fIy\fR specify the coordinates of a
+point used to position the text on the display (see the options
+below for more information on how text is displayed).
+After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR
+pairs, each of which sets one of the configuration options
+for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be
+used in \fBitemconfigure\fR widget commands to change the item's
+configuration.
+The following options are supported for text items:
+.TP
+\fB\-anchor \fIanchorPos\fR
+\fIAnchorPos\fR tells how to position the text relative to the
+positioning point for the text; it may have any of the forms
+accepted by \fBTk_GetAnchor\fR. For example, if \fIanchorPos\fR
+is \fBcenter\fR then the text is centered on the point; if
+\fIanchorPos\fR is \fBn\fR then the text will be drawn such that
+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.
+.TP
+\fB\-justify \fIhow\fR
+Specifies how to justify the text within its bounding region.
+\fIHow\fR must be one of the values \fBleft\fR, \fBright\fR,
+or \fBcenter\fR.
+This option will only matter if the text is displayed as multiple
+lines.
+If the option is omitted, it defaults to \fBleft\fR.
+.TP
+\fB\-stipple \fIbitmap\fR
+Indicates that the text should be drawn in a stippled pattern
+rather than solid;
+\fIbitmap\fR specifies the stipple pattern to use, in any of the
+forms accepted by \fBTk_GetBitmap\fR.
+If \fIbitmap\fR is an empty string (the default) then the text
+is drawn in a solid fashion.
+.TP
+\fB\-tags \fItagList\fR
+Specifies a set of tags to apply to the item.
+\fITagList\fR consists of a list of tag names, which replace any
+existing tags for the item.
+\fITagList\fR may be an empty list.
+.TP
+\fB\-text \fIstring\fR
+\fIString\fR specifies the characters to be displayed in the text item.
+Newline characters cause line breaks.
+The characters in the item may also be changed with the
+\fBinsert\fR and \fBdelete\fR widget commands.
+This option defaults to an empty string.
+.TP
+\fB\-width \fIlineLength\fR
+Specifies a maximum line length for the text, in any of the forms
+described in the COORDINATES section above.
+If this option is zero (the default) the text is broken into
+lines only at newline characters.
+However, if this option is non-zero then any line that would
+be longer than \fIlineLength\fR is broken just before a space
+character to make the line shorter than \fIlineLength\fR; the
+space character is treated as if it were a newline
+character.
+
+.SH "WINDOW ITEMS"
+.PP
+Items of type \fBwindow\fR cause a particular window to be displayed
+at a given position on the canvas.
+Window items are created with widget commands of the following form:
+.CS
+\fIpathName \fBcreate window \fIx y \fR?\fIoption value option value ...\fR?
+.CE
+The arguments \fIx\fR and \fIy\fR specify the coordinates of a
+point used to position the window on the display (see the \fB\-anchor\fR
+option below for more information on how bitmaps are displayed).
+After the coordinates there may be any number of \fIoption\fR\-\fIvalue\fR
+pairs, each of which sets one of the configuration options
+for the item. These same \fIoption\fR\-\fIvalue\fR pairs may be
+used in \fBitemconfigure\fR widget commands to change the item's
+configuration.
+The following options are supported for window items:
+.TP
+\fB\-anchor \fIanchorPos\fR
+\fIAnchorPos\fR tells how to position the window relative to the
+positioning point for the item; it may have any of the forms
+accepted by \fBTk_GetAnchor\fR. For example, if \fIanchorPos\fR
+is \fBcenter\fR then the window is centered on the point; if
+\fIanchorPos\fR is \fBn\fR then the window will be drawn so that
+its top center point is at the positioning point.
+This option defaults to \fBcenter\fR.
+.TP
+\fB\-height \fIpixels\fR
+Specifies the height to assign to the item's window.
+\fIPixels\fR may have any of the
+forms described in the COORDINATES section above.
+If this option isn't specified, or if it is specified as an empty
+string, then the window is given whatever height it requests internally.
+.TP
+\fB\-tags \fItagList\fR
+Specifies a set of tags to apply to the item.
+\fITagList\fR consists of a list of tag names, which replace any
+existing tags for the item.
+\fITagList\fR may be an empty list.
+.TP
+\fB\-width \fIpixels\fR
+Specifies the width to assign to the item's window.
+\fIPixels\fR may have any of the
+forms described in the COORDINATES section above.
+If this option isn't specified, or if it is specified as an empty
+string, then the window is given whatever width it requests internally.
+.TP
+\fB\-window \fIpathName\fR
+Specifies the window to associate with this item.
+The window specified by \fIpathName\fR must either be a child of
+the canvas widget or a child of some ancestor of the canvas widget.
+\fIPathName\fR may not refer to a top-level window.
+.PP
+Note: due to restrictions in the ways that windows are managed, it is not
+possible to draw other graphical items (such as lines and images) on top
+of window items. A window item always obscures any graphics that
+overlap it, regardless of their order in the display list.
+
+.SH "APPLICATION-DEFINED ITEM TYPES"
+.PP
+It is possible for individual applications to define new item
+types for canvas widgets using C code.
+See the documentation for \fBTk_CreateItemType\fR.
+
+.SH BINDINGS
+.PP
+In the current implementation, new canvases are not given any
+default behavior: you'll have to execute explicit Tcl commands
+to give the canvas its behavior.
+
+.SH CREDITS
+.PP
+Tk's canvas widget is a blatant ripoff of ideas from Joel Bartlett's
+\fIezd\fR program. \fIEzd\fR provides structured graphics in a Scheme
+environment and preceded canvases by a year or two. Its simple
+mechanisms for placing and animating graphical objects inspired the
+functions of canvases.
+
+.SH KEYWORDS
+canvas, widget
diff --git a/tk/doc/checkbutton.n b/tk/doc/checkbutton.n
new file mode 100644
index 00000000000..1867dbf52db
--- /dev/null
+++ b/tk/doc/checkbutton.n
@@ -0,0 +1,238 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBcheckbutton\fI pathName \fR?\fIoptions\fR?
+.SO
+\-activebackground \-cursor \-highlightthickness \-takefocus
+\-activeforeground \-disabledforeground \-image \-text
+\-anchor \-font \-justify \-textvariable
+\-background \-foreground \-padx \-underline
+\-bitmap \-highlightbackground \-pady \-wraplength
+\-borderwidth \-highlightcolor \-relief
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-command command Command
+Specifies a Tcl command to associate with the button. This command
+is typically invoked when mouse button 1 is released over the button
+window. The button's global variable (\fB\-variable\fR option) will
+be updated before the command is invoked.
+.OP \-height height Height
+Specifies a desired height for the button.
+If an image or bitmap is being displayed in the button then the value is in
+screen units (i.e. any of the forms acceptable to \fBTk_GetPixels\fR);
+for text it is in lines of text.
+If this option isn't specified, the button's desired height is computed
+from the size of the image or bitmap or text being displayed in it.
+.OP \-indicatoron indicatorOn IndicatorOn
+Specifies whether or not the indicator should be drawn. Must be a
+proper boolean value. If false, the \fBrelief\fR option is
+ignored and the widget's relief is always sunken if the widget is
+selected and raised otherwise.
+.OP \-offvalue offValue Value
+Specifies value to store in the button's associated variable whenever
+this button is deselected. Defaults to ``0''.
+.OP \-onvalue onValue Value
+Specifies value to store in the button's associated variable whenever
+this button is selected. Defaults to ``1''.
+.OP \-selectcolor selectColor Background
+Specifies a background color to use when the button is selected.
+If \fBindicatorOn\fR is true then the color applies to the indicator.
+Under Windows, this color is used as the background for the indicator
+regardless of the select state.
+If \fBindicatorOn\fR is false, this color is used as the background
+for the entire widget, in place of \fBbackground\fR or \fBactiveBackground\fR,
+whenever the widget is selected.
+If specified as an empty string then no special color is used for
+displaying when the widget is selected.
+.OP \-selectimage selectImage SelectImage
+Specifies an image to display (in place of the \fBimage\fR option)
+when the checkbutton is selected.
+This option is ignored unless the \fBimage\fR option has been
+specified.
+.OP \-state state State
+Specifies one of three states for the checkbutton: \fBnormal\fR, \fBactive\fR,
+or \fBdisabled\fR. In normal state the checkbutton is displayed using the
+\fBforeground\fR and \fBbackground\fR options. The active state is
+typically used when the pointer is over the checkbutton. In active state
+the checkbutton is displayed using the \fBactiveForeground\fR and
+\fBactiveBackground\fR options. Disabled state means that the checkbutton
+should be insensitive: the default bindings will refuse to activate
+the widget and will ignore mouse button presses.
+In this state the \fBdisabledForeground\fR and
+\fBbackground\fR options determine how the checkbutton is displayed.
+.OP \-variable variable Variable
+Specifies name of global variable to set to indicate whether
+or not this button is selected. Defaults to the name of the
+button within its parent (i.e. the last element of the button
+window's path name).
+.OP \-width width Width
+Specifies a desired width for the button.
+If an image or bitmap is being displayed in the button then the value is in
+screen units (i.e. any of the forms acceptable to \fBTk_GetPixels\fR);
+for text it is in characters.
+If this option isn't specified, the button's desired width is computed
+from the size of the image or bitmap or text being displayed in it.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBcheckbutton\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a checkbutton widget.
+Additional
+options, described above, may be specified on the command line
+or in the option database
+to configure aspects of the checkbutton such as its colors, font,
+text, and initial relief. The \fBcheckbutton\fR command returns its
+\fIpathName\fR argument. At the time this command is invoked,
+there must not exist a window named \fIpathName\fR, but
+\fIpathName\fR's parent must exist.
+.PP
+A checkbutton is a widget
+that displays a textual string, bitmap or image
+and a square called an \fIindicator\fR.
+If text is displayed, it must all be in a single font, but it
+can occupy multiple lines on the screen (if it contains newlines
+or if wrapping occurs because of the \fBwrapLength\fR option) and
+one of the characters may optionally be underlined using the
+\fBunderline\fR option.
+A checkbutton has
+all of the behavior of a simple button, including the
+following: it can display itself in either of three different
+ways, according to the \fBstate\fR option;
+it can be made to appear
+raised, sunken, or flat; it can be made to flash; and it invokes
+a Tcl command whenever mouse button 1 is clicked over the
+checkbutton.
+.PP
+In addition, checkbuttons can be \fIselected\fR.
+If a checkbutton is selected then the indicator is normally
+.VS
+drawn with a selected appearance, and
+a Tcl variable associated with the checkbutton is set to a particular
+value (normally 1).
+Under Unix, the indicator is drawn with a sunken relief and a special
+color. Under Windows, the indicator is drawn with a check mark inside.
+If the checkbutton is not selected, then the indicator is drawn with a
+deselected appearance, and the associated variable is
+set to a different value (typically 0).
+Under Unix, the indicator is drawn with a raised relief and no special
+color. Under Windows, the indicator is drawn without a check mark inside.
+.VE
+By default, the name of the variable associated with a checkbutton is the
+same as the \fIname\fR used to create the checkbutton.
+The variable name, and the ``on'' and ``off'' values stored in it,
+may be modified with options on the command line or in the option
+database.
+Configuration options may also be used to modify the way the
+indicator is displayed (or whether it is displayed at all).
+By default a checkbutton is configured to select and deselect
+itself on alternate button clicks.
+In addition, each checkbutton monitors its associated variable and
+automatically selects and deselects itself when the variables value
+changes to and from the button's ``on'' value.
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBcheckbutton\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.CS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.CE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for checkbutton widgets:
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBcheckbutton\fR
+command.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBcheckbutton\fR
+command.
+.TP
+\fIpathName \fBdeselect\fR
+Deselects the checkbutton and sets the associated variable to its ``off''
+value.
+.TP
+\fIpathName \fBflash\fR
+Flashes the checkbutton. This is accomplished by redisplaying the checkbutton
+several times, alternating between active and normal colors. At
+the end of the flash the checkbutton is left in the same normal/active
+state as when the command was invoked.
+This command is ignored if the checkbutton's state is \fBdisabled\fR.
+.TP
+\fIpathName \fBinvoke\fR
+Does just what would have happened if the user invoked the checkbutton
+with the mouse: toggle the selection state of the button and invoke
+the Tcl command associated with the checkbutton, if there is one.
+The return value is the return value from the Tcl command, or an
+empty string if there is no command associated with the checkbutton.
+This command is ignored if the checkbutton's state is \fBdisabled\fR.
+.TP
+\fIpathName \fBselect\fR
+Selects the checkbutton and sets the associated variable to its ``on''
+value.
+.TP
+\fIpathName \fBtoggle\fR
+Toggles the selection state of the button, redisplaying it and
+modifying its associated variable to reflect the new state.
+
+.SH BINDINGS
+.PP
+Tk automatically creates class bindings for checkbuttons that give them
+the following default behavior:
+.VS
+.IP [1]
+On Unix systems, a checkbutton activates whenever the mouse passes
+over it and deactivates whenever the mouse leaves the checkbutton. On
+Mac and Windows systems, when mouse button 1 is pressed over a
+checkbutton, the button activates whenever the mouse pointer is inside
+the button, and deactivates whenever the mouse pointer leaves the
+button.
+.VE
+.IP [2]
+When mouse button 1 is pressed over a checkbutton, it is invoked (its
+selection state toggles and the command associated with the button is
+invoked, if there is one).
+.VS
+.IP [3]
+When a checkbutton has the input focus, the space key causes the checkbutton
+to be invoked. Under Windows, there are additional key bindings; plus
+(+) and equal (=) select the button, and minus (-) deselects the button.
+.VE
+.PP
+If the checkbutton's state is \fBdisabled\fR then none of the above
+actions occur: the checkbutton is completely non-responsive.
+.PP
+The behavior of checkbuttons can be changed by defining new bindings for
+individual widgets or by redefining the class bindings.
+
+.SH KEYWORDS
+checkbutton, widget
diff --git a/tk/doc/chooseColor.n b/tk/doc/chooseColor.n
new file mode 100644
index 00000000000..18b5feffe2f
--- /dev/null
+++ b/tk/doc/chooseColor.n
@@ -0,0 +1,49 @@
+'\"
+'\" 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$
+'\"
+.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.
+.PP
+.SH SYNOPSIS
+\fBtk_chooseColor \fR?\fIoption value ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The procedure \fBtk_chooseColor\fR pops up a dialog box for the
+user to select a color. The following \fIoption\-value\fR pairs are
+possible as command line arguments:
+.TP
+\fB\-initialcolor\fR \fIcolor\fR
+Specifies the color to display in the color dialog when it pops
+up. \fIcolor\fR must be in a form acceptable to the \fBTk_GetColor\fR
+function.
+.TP
+\fB\-parent\fR \fIwindow\fR
+Makes \fIwindow\fR the logical parent of the color dialog. The color
+dialog is displayed on top of its parent window.
+.TP
+\fB\-title\fR \fItitleString\fR
+Specifies a string to display as the title of the dialog box. If this
+option is not specified, then a default title will be displayed.
+.LP
+If the user selects a color, \fBtk_chooseColor\fR will return the
+name of the color in a form acceptable to \fBTk_GetColor\fR. If the
+user cancels the operation, both commands will return the empty
+string.
+.SH EXAMPLE
+.CS
+button .b \-fg [tk_chooseColor \-initialcolor gray \-title "Choose color"]
+.CE
+
+.SH KEYWORDS
+color selection dialog
diff --git a/tk/doc/clipboard.n b/tk/doc/clipboard.n
new file mode 100644
index 00000000000..eea65467772
--- /dev/null
+++ b/tk/doc/clipboard.n
@@ -0,0 +1,81 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBclipboard \fIoption\fR ?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command provides a Tcl interface to the Tk clipboard,
+which stores data for later retrieval using the selection mechanism.
+In order to copy data into the clipboard, \fBclipboard clear\fR must
+be called, followed by a sequence of one or more calls to \fBclipboard
+append\fR. To ensure that the clipboard is updated atomically, all
+appends should be completed before returning to the event loop.
+.PP
+The first argument to \fBclipboard\fR determines the format of the
+rest of the arguments and the behavior of the command. The following
+forms are currently supported:
+.PP
+.TP
+\fBclipboard clear\fR ?\fB\-displayof\fR \fIwindow\fR?
+Claims ownership of the clipboard on \fIwindow\fR's display and removes
+any previous contents. \fIWindow\fR defaults to ``.''. Returns an
+empty string.
+.TP
+\fBclipboard append\fR ?\fB\-displayof\fR \fIwindow\fR? ?\fB\-format\fR \fIformat\fR? ?\fB\-type\fR \fItype\fR? ?\fB\-\|\-\fR? \fIdata\fR
+Appends \fIdata\fR to the clipboard on \fIwindow\fR's
+display in the form given by \fItype\fR with the representation given
+by \fIformat\fR and claims ownership of the clipboard on \fIwindow\fR's
+display.
+.RS
+.PP
+\fIType\fR specifies the form in which the selection is to be returned
+(the desired ``target'' for conversion, in ICCCM terminology), and
+should be an atom name such as STRING or FILE_NAME; see the
+Inter-Client Communication Conventions Manual for complete details.
+\fIType\fR defaults to STRING.
+.PP
+The \fIformat\fR argument specifies the representation that should be
+used to transmit the selection to the requester (the second column of
+Table 2 of the ICCCM), and defaults to STRING. If \fIformat\fR is
+STRING, the selection is transmitted as 8-bit ASCII characters. If
+\fIformat\fR is ATOM, then the \fIdata\fR is
+divided into fields separated by white space; each field is converted
+to its atom value, and the 32-bit atom value is transmitted instead of
+the atom name. For any other \fIformat\fR, \fIdata\fR is divided
+into fields separated by white space and each
+field is converted to a 32-bit integer; an array of integers is
+transmitted to the selection requester. Note that strings passed to
+\fBclipboard append\fR are concatenated before conversion, so the
+caller must take care to ensure appropriate spacing across string
+boundaries. All items appended to the clipboard with the same
+\fItype\fR must have the same \fIformat\fR.
+.PP
+The \fIformat\fR argument is needed only for compatibility with
+clipboard requesters that don't use Tk. If the Tk toolkit is being
+used to retrieve the CLIPBOARD selection then the value is converted back to
+a string at the requesting end, so \fIformat\fR is
+irrelevant.
+.PP
+A \fB\-\|\-\fR argument may be specified to mark the end of options: the
+next argument will always be used as \fIdata\fR.
+This feature may be convenient if, for example, \fIdata\fR starts
+with a \fB\-\fR.
+.RE
+
+.SH KEYWORDS
+clear, format, clipboard, append, selection, type
diff --git a/tk/doc/destroy.n b/tk/doc/destroy.n
new file mode 100644
index 00000000000..f144ad86ebd
--- /dev/null
+++ b/tk/doc/destroy.n
@@ -0,0 +1,34 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBdestroy \fR?\fIwindow window ...\fR?
+.BE
+
+.SH DESCRIPTION
+.VS
+.PP
+This command deletes the windows given by the
+\fIwindow\fR arguments, plus all of their descendants.
+If a \fIwindow\fR ``.'' is deleted then the entire application
+will be destroyed.
+The \fIwindow\fRs are destroyed in order, and if an error occurs
+in destroying a window the command aborts without destroying the
+remaining windows.
+No error is returned if \fIwindow\fR does not exist.
+.VE
+
+.SH KEYWORDS
+application, destroy, window
diff --git a/tk/doc/dialog.n b/tk/doc/dialog.n
new file mode 100644
index 00000000000..bd30e197b14
--- /dev/null
+++ b/tk/doc/dialog.n
@@ -0,0 +1,65 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBtk_dialog \fIwindow title text bitmap default string string ...\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+This procedure is part of the Tk script library.
+Its arguments describe a dialog box:
+.TP
+\fIwindow\fR
+Name of top-level window to use for dialog. Any existing window
+by this name is destroyed.
+.TP
+\fItitle\fR
+Text to appear in the window manager's title bar for the dialog.
+.TP
+\fItext\fR
+Message to appear in the top portion of the dialog box.
+.TP
+\fIbitmap\fR
+If non-empty, specifies a bitmap to display in the top portion of
+the dialog, to the left of the text.
+If this is an empty string then no bitmap is displayed in the dialog.
+.TP
+\fIdefault\fR
+If this is an integer greater than or equal to zero, then it gives
+the index of the button that is to be the default button for the dialog
+(0 for the leftmost button, and so on).
+If less than zero or an empty string then there won't be any default
+button.
+.TP
+\fIstring\fR
+There will be one button for each of these arguments.
+Each \fIstring\fR specifies text to display in a button,
+in order from left to right.
+.PP
+After creating a dialog box, \fBtk_dialog\fR waits for the user to
+select one of the buttons either by clicking on the button with the
+mouse or by typing return to invoke the default button (if any).
+Then it returns the index of the selected button: 0 for the leftmost
+button, 1 for the button next to it, and so on.
+If the dialog's window is destroyed before the user selects one
+of the buttons, then -1 is returned.
+.PP
+While waiting for the user to respond, \fBtk_dialog\fR sets a local
+grab. This prevents the user from interacting with the application
+in any way except to invoke the dialog box.
+
+.SH KEYWORDS
+bitmap, dialog, modal
diff --git a/tk/doc/entry.n b/tk/doc/entry.n
new file mode 100644
index 00000000000..c9ca3f0ff34
--- /dev/null
+++ b/tk/doc/entry.n
@@ -0,0 +1,417 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBentry\fR \fIpathName \fR?\fIoptions\fR?
+.SO
+\-background \-highlightbackground \-insertontime \-selectforeground
+\-borderwidth \-highlightcolor \-insertwidth \-takefocus
+\-cursor \-highlightthickness \-justify \-textvariable
+\-exportselection \-insertbackground \-relief \-xscrollcommand
+\-font \-insertborderwidth \-selectbackground
+\-foreground \-insertofftime \-selectborderwidth
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-show show Show
+If this option is specified, then the true contents of the entry
+are not displayed in the window.
+Instead, each character in the entry's value will be displayed as
+the first character in the value of this option, such as ``*''.
+This is useful, for example, if the entry is to be used to enter
+a password.
+If characters in the entry are selected and copied elsewhere, the
+information copied will be what is displayed, not the true contents
+of the entry.
+.OP \-state state State
+Specifies one of two states for the entry: \fBnormal\fR or \fBdisabled\fR.
+If the entry is disabled then the value may not be changed using widget
+commands and no insertion cursor will be displayed, even if the input focus is
+in the widget.
+.OP \-width width Width
+Specifies an integer value indicating the desired width of the entry window,
+in average-size characters of the widget's font.
+If the value is less than or equal to zero, the widget picks a
+size just large enough to hold its current text.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBentry\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into an entry widget.
+Additional options, described above, may be specified on the
+command line or in the option database
+to configure aspects of the entry such as its colors, font,
+and relief. The \fBentry\fR command returns its
+\fIpathName\fR argument. At the time this command is invoked,
+there must not exist a window named \fIpathName\fR, but
+\fIpathName\fR's parent must exist.
+.PP
+An entry is a widget that displays a one-line text string and
+allows that string to be edited using widget commands described below, which
+are typically bound to keystrokes and mouse actions.
+When first created, an entry's string is empty.
+A portion of the entry may be selected as described below.
+If an entry is exporting its selection (see the \fBexportSelection\fR
+option), then it will observe the standard X11 protocols for handling the
+selection; entry selections are available as type \fBSTRING\fR.
+Entries also observe the standard Tk rules for dealing with the
+input focus. When an entry has the input focus it displays an
+\fIinsertion cursor\fR to indicate where new characters will be
+inserted.
+.PP
+Entries are capable of displaying strings that are too long to
+fit entirely within the widget's window. In this case, only a
+portion of the string will be displayed; commands described below
+may be used to change the view in the window. Entries use
+the standard \fBxScrollCommand\fR mechanism for interacting with
+scrollbars (see the description of the \fBxScrollCommand\fR option
+for details). They also support scanning, as described below.
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBentry\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.CS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.CE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command.
+.PP
+Many of the widget commands for entries take one or more indices as
+arguments. An index specifies a particular character in the entry's
+string, in any of the following ways:
+.TP 12
+\fInumber\fR
+Specifies the character as a numerical index, where 0 corresponds
+to the first character in the string.
+.TP 12
+\fBanchor\fR
+Indicates the anchor point for the selection, which is set with the
+\fBselect from\fR and \fBselect adjust\fR widget commands.
+.TP 12
+\fBend\fR
+Indicates the character just after the last one in the entry's string.
+This is equivalent to specifying a numerical index equal to the length
+of the entry's string.
+.TP 12
+\fBinsert\fR
+Indicates the character adjacent to and immediately following the
+insertion cursor.
+.TP 12
+\fBsel.first\fR
+Indicates the first character in the selection. It is an error to
+use this form if the selection isn't in the entry window.
+.TP 12
+\fBsel.last\fR
+Indicates the character just after the last one in the selection.
+It is an error to use this form if the selection isn't in the
+entry window.
+.TP 12
+\fB@\fInumber\fR
+In this form, \fInumber\fR is treated as an x-coordinate in the
+entry's window; the character spanning that x-coordinate is used.
+For example, ``\fB@0\fR'' indicates the left-most character in the
+window.
+.LP
+Abbreviations may be used for any of the forms above, e.g. ``\fBe\fR''
+or ``\fBsel.f\fR''. In general, out-of-range indices are automatically
+rounded to the nearest legal value.
+.PP
+The following commands are possible for entry widgets:
+.TP
+\fIpathName \fBbbox \fIindex\fR
+Returns a list of four numbers describing the bounding box of the
+character given by \fIindex\fR.
+The first two elements of the list give the x and y coordinates of
+the upper-left corner of the screen area covered by the character
+(in pixels relative to the widget) and the last two elements give
+the width and height of the character, in pixels.
+The bounding box may refer to a region outside the visible area
+of the window.
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBentry\fR
+command.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBentry\fR
+command.
+.TP
+\fIpathName \fBdelete \fIfirst \fR?\fIlast\fR?
+Delete one or more elements of the entry.
+\fIFirst\fR is the index of the first character to delete, and
+\fIlast\fR is the index of the character just after the last
+one to delete.
+If \fIlast\fR isn't specified it defaults to \fIfirst\fR+1,
+i.e. a single character is deleted.
+This command returns an empty string.
+.TP
+\fIpathName \fBget\fR
+Returns the entry's string.
+.TP
+\fIpathName \fBicursor \fIindex\fR
+Arrange for the insertion cursor to be displayed just before the character
+given by \fIindex\fR. Returns an empty string.
+.TP
+\fIpathName \fBindex\fI index\fR
+Returns the numerical index corresponding to \fIindex\fR.
+.TP
+\fIpathName \fBinsert \fIindex string\fR
+Insert the characters of \fIstring\fR just before the character
+indicated by \fIindex\fR. Returns an empty string.
+.TP
+\fIpathName \fBscan\fR \fIoption args\fR
+This command is used to implement scanning on entries. It has
+two forms, depending on \fIoption\fR:
+.RS
+.TP
+\fIpathName \fBscan mark \fIx\fR
+Records \fIx\fR and the current view in the entry window; used in
+conjunction with later \fBscan dragto\fR commands. Typically this
+command is associated with a mouse button press in the widget. It
+returns an empty string.
+.TP
+\fIpathName \fBscan dragto \fIx\fR
+This command computes the difference between its \fIx\fR argument
+and the \fIx\fR argument to the last \fBscan mark\fR command for
+the widget. It then adjusts the view left or right by 10 times the
+difference in x-coordinates. This command is typically associated
+with mouse motion events in the widget, to produce the effect of
+dragging the entry at high speed through the window. The return
+value is an empty string.
+.RE
+.TP
+\fIpathName \fBselection \fIoption arg\fR
+This command is used to adjust the selection within an entry. It
+has several forms, depending on \fIoption\fR:
+.RS
+.TP
+\fIpathName \fBselection adjust \fIindex\fR
+Locate the end of the selection nearest to the character given by
+\fIindex\fR, and adjust that end of the selection to be at \fIindex\fR
+(i.e including but not going beyond \fIindex\fR). The other
+end of the selection is made the anchor point for future
+\fBselect to\fR commands. If the selection
+isn't currently in the entry, then a new selection is created to
+include the characters between \fIindex\fR and the most recent
+selection anchor point, inclusive.
+Returns an empty string.
+.TP
+\fIpathName \fBselection clear\fR
+Clear the selection if it is currently in this widget. If the
+selection isn't in this widget then the command has no effect.
+Returns an empty string.
+.TP
+\fIpathName \fBselection from \fIindex\fR
+Set the selection anchor point to just before the character
+given by \fIindex\fR. Doesn't change the selection.
+Returns an empty string.
+.TP
+\fIpathName \fBselection present\fR
+Returns 1 if there is are characters selected in the entry,
+0 if nothing is selected.
+.TP
+\fIpathName \fBselection range \fIstart\fR \fIend\fR
+Sets the selection to include the characters starting with
+the one indexed by \fIstart\fR and ending with the one just
+before \fIend\fR.
+If \fIend\fR refers to the same character as \fIstart\fR or an
+earlier one, then the entry's selection is cleared.
+.TP
+\fIpathName \fBselection to \fIindex\fR
+If \fIindex\fR is before the anchor point, set the selection
+to the characters from \fIindex\fR up to but not including
+the anchor point.
+If \fIindex\fR is the same as the anchor point, do nothing.
+If \fIindex\fR is after the anchor point, set the selection
+to the characters from the anchor point up to but not including
+\fIindex\fR.
+The anchor point is determined by the most recent \fBselect from\fR
+or \fBselect adjust\fR command in this widget.
+If the selection isn't in this widget then a new selection is
+created using the most recent anchor point specified for the widget.
+Returns an empty string.
+.RE
+.TP
+\fIpathName \fBxview \fIargs\fR
+This command is used to query and change the horizontal position of the
+text in the widget's window. It can take any of the following
+forms:
+.RS
+.TP
+\fIpathName \fBxview\fR
+Returns a list containing two elements.
+Each element is a real fraction between 0 and 1; together they describe
+the horizontal span that is visible in the window.
+For example, if the first element is .2 and the second element is .6,
+20% of the entry's text is off-screen to the left, the middle 40% is visible
+in the window, and 40% of the text is off-screen to the right.
+These are the same values passed to scrollbars via the \fB\-xscrollcommand\fR
+option.
+.TP
+\fIpathName \fBxview\fR \fIindex\fR
+Adjusts the view in the window so that the character given by \fIindex\fR
+is displayed at the left edge of the window.
+.TP
+\fIpathName \fBxview moveto\fI fraction\fR
+Adjusts the view in the window so that the character \fIfraction\fR of the
+way through the text appears at the left edge of the window.
+\fIFraction\fR must be a fraction between 0 and 1.
+.TP
+\fIpathName \fBxview scroll \fInumber what\fR
+This command shifts the view in the window left or right according to
+\fInumber\fR and \fIwhat\fR.
+\fINumber\fR must be an integer.
+\fIWhat\fR must be either \fBunits\fR or \fBpages\fR or an abbreviation
+of one of these.
+If \fIwhat\fR is \fBunits\fR, the view adjusts left or right by
+\fInumber\fR average-width characters on the display; if it is
+\fBpages\fR then the view adjusts by \fInumber\fR screenfuls.
+If \fInumber\fR is negative then characters farther to the left
+become visible; if it is positive then characters farther to the right
+become visible.
+.RE
+
+.SH "DEFAULT BINDINGS"
+.PP
+Tk automatically creates class bindings for entries that give them
+the following default behavior.
+In the descriptions below, ``word'' refers to a contiguous group
+of letters, digits, or ``_'' characters, or any single character
+other than these.
+.IP [1]
+Clicking mouse button 1 positions the insertion cursor
+just before the character underneath the mouse cursor, sets the
+input focus to this widget, and clears any selection in the widget.
+Dragging with mouse button 1 strokes out a selection between
+the insertion cursor and the character under the mouse.
+.IP [2]
+Double-clicking with mouse button 1 selects the word under the mouse
+and positions the insertion cursor at the beginning of the word.
+Dragging after a double click will stroke out a selection consisting
+of whole words.
+.IP [3]
+Triple-clicking with mouse button 1 selects all of the text in the
+entry and positions the insertion cursor before the first character.
+.IP [4]
+The ends of the selection can be adjusted by dragging with mouse
+button 1 while the Shift key is down; this will adjust the end
+of the selection that was nearest to the mouse cursor when button
+1 was pressed.
+If the button is double-clicked before dragging then the selection
+will be adjusted in units of whole words.
+.IP [5]
+Clicking mouse button 1 with the Control key down will position the
+insertion cursor in the entry without affecting the selection.
+.IP [6]
+If any normal printing characters are typed in an entry, they are
+inserted at the point of the insertion cursor.
+.IP [7]
+The view in the entry can be adjusted by dragging with mouse button 2.
+If mouse button 2 is clicked without moving the mouse, the selection
+is copied into the entry at the position of the mouse cursor.
+.IP [8]
+If the mouse is dragged out of the entry on the left or right sides
+while button 1 is pressed, the entry will automatically scroll to
+make more text visible (if there is more text off-screen on the side
+where the mouse left the window).
+.IP [9]
+The Left and Right keys move the insertion cursor one character to the
+left or right; they also clear any selection in the entry and set
+the selection anchor.
+If Left or Right is typed with the Shift key down, then the insertion
+cursor moves and the selection is extended to include the new character.
+Control-Left and Control-Right move the insertion cursor by words, and
+Control-Shift-Left and Control-Shift-Right move the insertion cursor
+by words and also extend the selection.
+Control-b and Control-f behave the same as Left and Right, respectively.
+Meta-b and Meta-f behave the same as Control-Left and Control-Right,
+respectively.
+.IP [10]
+The Home key, or Control-a, will move the insertion cursor to the
+beginning of the entry and clear any selection in the entry.
+Shift-Home moves the insertion cursor to the beginning of the entry
+and also extends the selection to that point.
+.IP [11]
+The End key, or Control-e, will move the insertion cursor to the
+end of the entry and clear any selection in the entry.
+Shift-End moves the cursor to the end and extends the selection
+to that point.
+.IP [12]
+The Select key and Control-Space set the selection anchor to the position
+of the insertion cursor. They don't affect the current selection.
+Shift-Select and Control-Shift-Space adjust the selection to the
+current position of the insertion cursor, selecting from the anchor
+to the insertion cursor if there was not any selection previously.
+.IP [13]
+Control-/ selects all the text in the entry.
+.IP [14]
+Control-\e clears any selection in the entry.
+.IP [15]
+The F16 key (labelled Copy on many Sun workstations) or Meta-w
+copies the selection in the widget to the clipboard, if there is a selection.
+.IP [16]
+The F20 key (labelled Cut on many Sun workstations) or Control-w
+copies the selection in the widget to the clipboard and deletes
+the selection.
+If there is no selection in the widget then these keys have no effect.
+.IP [17]
+The F18 key (labelled Paste on many Sun workstations) or Control-y
+inserts the contents of the clipboard at the position of the
+insertion cursor.
+.IP [18]
+The Delete key deletes the selection, if there is one in the entry.
+If there is no selection, it deletes the character to the right of
+the insertion cursor.
+.IP [19]
+The BackSpace key and Control-h delete the selection, if there is one
+in the entry.
+If there is no selection, it deletes the character to the left of
+the insertion cursor.
+.IP [20]
+Control-d deletes the character to the right of the insertion cursor.
+.IP [21]
+Meta-d deletes the word to the right of the insertion cursor.
+.IP [22]
+Control-k deletes all the characters to the right of the insertion
+cursor.
+.IP [23]
+Control-t reverses the order of the two characters to the right of
+the insertion cursor.
+.PP
+If the entry is disabled using the \fB\-state\fR option, then the entry's
+view can still be adjusted and text in the entry can still be selected,
+but no insertion cursor will be displayed and no text modifications will
+take place.
+.PP
+The behavior of entries can be changed by defining new bindings for
+individual widgets or by redefining the class bindings.
+
+.SH KEYWORDS
+entry, widget
diff --git a/tk/doc/event.n b/tk/doc/event.n
new file mode 100644
index 00000000000..49633bfebb2
--- /dev/null
+++ b/tk/doc/event.n
@@ -0,0 +1,352 @@
+'\"
+'\" 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$
+'\"
+.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
+
+.SH DESCRIPTION
+.PP
+The \fBevent\fR command provides several facilities for dealing with
+window system events, such as defining virtual events and synthesizing
+events. The command has several different forms, determined by the
+first argument. The following forms are currently supported:
+.TP
+\fBevent add <<\fIvirtual\fB>>\fI sequence \fR?\fIsequence ...\fR?
+Associates the virtual event \fIvirtual\fR with the physical
+event sequence(s) given by the \fIsequence\fR arguments, so that
+the virtual event will trigger whenever any one of the \fIsequence\fRs
+occurs.
+\fIVirtual\fR may be any string value and \fIsequence\fR may have
+any of the values allowed for the \fIsequence\fR argument to the
+\fBbind\fR command.
+If \fIvirtual\fR is already defined, the new physical event sequences
+add to the existing sequences for the event.
+.TP
+\fBevent delete <<\fIvirtual\fB>> \fR?\fIsequence\fR \fIsequence ...\fR?
+Deletes each of the \fIsequence\fRs from those associated with
+the virtual event given by \fIvirtual\fR.
+\fIVirtual\fR may be any string value and \fIsequence\fR may have
+any of the values allowed for the \fIsequence\fR argument to the
+\fBbind\fR command.
+Any \fIsequence\fRs not currently associated with \fIvirtual\fR
+are ignored.
+If no \fIsequence\fR argument is provided, all physical event sequences
+are removed for \fIvirtual\fR, so that the virtual event will not
+trigger anymore.
+.TP
+\fBevent generate \fIwindow event \fR?\fIoption value option value ...\fR?
+Generates a window event and arranges for it to be processed just as if
+it had come from the window system.
+\fIWindow\fR gives the path name of the window for which the event
+.VS
+will be generated; it may also be an identifier (such as returned by
+\fBwinfo id\fR) as long as it is for a window in the current application.
+.VE
+\fIEvent\fR provides a basic description of
+the event, such as \fB<Shift-Button-2>\fR or \fB<<Paste>>\fR.
+\fIEvent\fR may have any of the forms allowed for the \fIsequence\fR
+argument of the \fBbind\fR command except that it must consist
+of a single event pattern, not a sequence.
+\fIOption-value\fR pairs may be used to specify additional
+attributes of the event, such as the x and y mouse position; see
+EVENT FIELDS below. If the \fB\-when\fR option is not specified, the
+event is processed immediately: all of the handlers for the event
+will complete before the \fBevent generate\fR command returns.
+If the \fB\-when\fR option is specified then it determines when the
+event is processed.
+.TP
+\fBevent info \fR?<<\fIvirtual\fB>>\fR?
+Returns information about virtual events.
+If the \fB<<\fIvirtual\fB>>\fR argument is omitted, the return value
+is a list of all the virtual events that are currently defined.
+If \fB<<\fIvirtual\fB>>\fR is specified then the return value is
+a list whose elements are the physical event sequences currently
+defined for the given virtual event; if the virtual event is
+not defined then an empty string is returned.
+
+.SH "EVENT FIELDS"
+.PP
+The following options are supported for the \fBevent generate\fR
+command. These correspond to the ``%'' expansions
+allowed in binding scripts for the \fBbind\fR command.
+.TP
+\fB\-above\fI window\fR
+\fIWindow\fR specifies the \fIabove\fR field for the event,
+either as a window path name or as an integer window id.
+Valid for \fBConfigure\fR events.
+Corresponds to the \fB%a\fR substitution for binding scripts.
+.TP
+\fB\-borderwidth\fI size\fR
+\fISize\fR must be a screen distance; it specifies the
+\fIborder_width\fR field for the event.
+Valid for \fBConfigure\fR events.
+Corresponds to the \fB%B\fR substitution for binding scripts.
+.TP
+\fB\-button\fI number\fR
+\fINumber\fR must be an integer; it specifies the \fIdetail\fR field
+for a \fBButtonPress\fR or \fBButtonRelease\fR event, overriding
+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
+\fBNotifyAncestor NotifyNonlinearVirtual
+NotifyDetailNone NotifyPointer
+NotifyInferior NotifyPointerRoot
+NotifyNonlinear NotifyVirtual\fR
+.DE
+Valid for \fBEnter\fR, \fBLeave\fR, \fBFocusIn\fR and
+\fBFocusOut\fR events.
+Corresponds to the \fB%d\fR substitution for binding scripts.
+.RE
+.TP
+\fB\-focus\fI boolean\fR
+\fIBoolean\fR must be a boolean value; it specifies the \fIfocus\fR
+field for the event.
+Valid for \fBEnter\fR and \fBLeave\fR events.
+Corresponds to the \fB%f\fR substitution for binding scripts.
+.TP
+\fB\-height\fI size\fR
+\fISize\fR must be a screen distance; it specifies the \fIheight\fR
+field for the event. Valid for \fBConfigure\fR events.
+Corresponds to the \fB%h\fR substitution for binding scripts.
+.TP
+\fB\-keycode\fI number\fR
+\fINumber\fR must be an integer; it specifies the \fIkeycode\fR
+field for the event.
+Valid for \fBKeyPress\fR and \fBKeyRelease\fR events.
+Corresponds to the \fB%k\fR substitution for binding scripts.
+.TP
+\fB\-keysym\fI name\fR
+\fIName\fR must be the name of a valid keysym, such as \fBg\fR,
+\fBspace\fR, or \fBReturn\fR; its corresponding
+keycode value is used as the \fIkeycode\fR field for event, overriding
+any detail specified in the base \fIevent\fR argument.
+Valid for \fBKeyPress\fR and \fBKeyRelease\fR events.
+Corresponds to the \fB%K\fR substitution for binding scripts.
+.TP
+\fB\-mode\fI notify\fR
+\fINotify\fR specifies the \fImode\fR field for the event and must be
+one of \fBNotifyNormal\fR, \fBNotifyGrab\fR, \fBNotifyUngrab\fR, or
+\fBNotifyWhileGrabbed\fR.
+Valid for \fBEnter\fR, \fBLeave\fR, \fBFocusIn\fR, and
+\fBFocusOut\fR events.
+Corresponds to the \fB%m\fR substitution for binding scripts.
+.TP
+\fB\-override\fI boolean\fR
+\fIBoolean\fR must be a boolean value; it specifies the
+\fIoverride_redirect\fR field for the event.
+Valid for \fBMap\fR, \fBReparent\fR, and \fBConfigure\fR events.
+Corresponds to the \fB%o\fR substitution for binding scripts.
+.TP
+\fB\-place\fI where\fR
+\fIWhere\fR specifies the \fIplace\fR field for the event; it must be
+either \fBPlaceOnTop\fR or \fBPlaceOnBottom\fR.
+Valid for \fBCirculate\fR events.
+Corresponds to the \fB%p\fR substitution for binding scripts.
+.TP
+\fB\-root\fI window\fR
+\fIWindow\fR must be either a window path name or an integer window
+identifier; it specifies the \fIroot\fR field for the event.
+Valid for \fBKeyPress\fR, \fBKeyRelease\fR, \fBButtonPress\fR,
+\fBButtonRelease\fR, \fBEnter\fR, \fBLeave\fR, and \fBMotion\fR
+events.
+Corresponds to the \fB%R\fR substitution for binding scripts.
+.TP
+\fB\-rootx\fI coord\fR
+\fICoord\fR must be a screen distance; it specifies the \fIx_root\fR
+field for the event.
+Valid for \fBKeyPress\fR, \fBKeyRelease\fR, \fBButtonPress\fR,
+\fBButtonRelease\fR, \fBEnter\fR, \fBLeave\fR, and \fBMotion\fR
+events. Corresponds to the \fB%X\fR substitution for binding scripts.
+.TP
+\fB\-rooty\fI coord\fR
+\fICoord\fR must be a screen distance; it specifies th \fIy_root\fR
+field for the event.
+Valid for \fBKeyPress\fR, \fBKeyRelease\fR, \fBButtonPress\fR,
+\fBButtonRelease\fR, \fBEnter\fR, \fBLeave\fR, and \fBMotion\fR
+events.
+Corresponds to the \fB%Y\fR substitution for binding scripts.
+.TP
+\fB\-sendevent\fI boolean\fR
+\fBBoolean\fR must be a boolean value; it specifies the \fIsend_event\fR
+field for the event. Valid for all events. Corresponds to the
+\fB%E\fR substitution for binding scripts.
+.TP
+\fB\-serial\fI number\fR
+\fINumber\fR must be an integer; it specifies the \fIserial\fR field
+for the event. Valid for all events.
+Corresponds to the \fB%#\fR substitution for binding scripts.
+.TP
+\fB\-state\fI state\fR
+\fIState\fR specifies the \fIstate\fR field for the event.
+For \fBKeyPress\fR, \fBKeyRelease\fR, \fBButtonPress\fR,
+\fBButtonRelease\fR, \fBEnter\fR, \fBLeave\fR, and \fBMotion\fR events
+it must be an integer value.
+For \fBVisibility\fR events it must be one of \fBVisibilityUnobscured\fR,
+\fBVisibilityPartiallyObscured\fR, or \fBVisibilityFullyObscured\fR.
+This option overrides any modifiers such as \fBMeta\fR or \fBControl\fR
+specified in the base \fIevent\fR.
+Corresponds to the \fB%s\fR substitution for binding scripts.
+.TP
+\fB\-subwindow\fI window\fR
+\fIWindow\fR specifies the \fIsubwindow\fR field for the event, either
+as a path name for a Tk widget or as an integer window identifier.
+Valid for \fBKeyPress\fR, \fBKeyRelease\fR, \fBButtonPress\fR,
+\fBButtonRelease\fR, \fBEnter\fR, \fBLeave\fR, and \fBMotion\fR events.
+Similar to \fB%S\fR substitution for binding scripts.
+.TP
+\fB\-time\fI integer\fR
+\fIInteger\fR must be an integer value; it specifies the \fItime\fR field
+for the event.
+Valid for \fBKeyPress\fR, \fBKeyRelease\fR, \fBButtonPress\fR,
+\fBButtonRelease\fR, \fBEnter\fR, \fBLeave\fR, \fBMotion\fR,
+and \fBProperty\fR events.
+Corresponds to the \fB%t\fR substitution for binding scripts.
+.TP
+\fB\-width\fI size\fR
+\fISize\fR must be a screen distance; it specifies the \fIwidth\fR field
+for the event.
+Valid for \fBConfigure\fR events.
+Corresponds to the \fB%w\fR substitution for binding scripts.
+.TP
+\fB\-when\fI when\fR
+\fIWhen\fR determines when the event will be processed; it must have one
+of the following values:
+.RS
+.IP \fBnow\fR 10
+Process the event immediately, before the command returns.
+This also happens if the \fB\-when\fR option is omitted.
+.IP \fBtail\fR 10
+Place the event on Tcl's event queue behind any events already
+queued for this application.
+.IP \fBhead\fR 10
+Place the event at the front of Tcl's event queue, so that it
+will be handled before any other events already queued.
+.IP \fBmark\fR 10
+Place the event at the front of Tcl's event queue but behind any
+other events already queued with \fB\-when mark\fR.
+This option is useful when generating a series of events that should
+be processed in order but at the front of the queue.
+.RE
+.TP
+\fB\-x\fI coord\fR
+\fICoord\fR must be a screen distance; it specifies the \fIx\fR field
+for the event.
+Valid for \fBKeyPress\fR, \fBKeyRelease\fR, \fBButtonPress\fR,
+\fBButtonRelease\fR, \fBMotion\fR, \fBEnter\fR, \fBLeave\fR,
+\fBExpose\fR, \fBConfigure\fR, \fBGravity\fR, and \fBReparent\fR
+events.
+Corresponds to the the \fB%x\fR substitution for binding scripts.
+.TP
+\fB\-y\fI coord\fR
+\fICoord\fR must be a screen distance; it specifies the \fIy\fR
+field for the event.
+Valid for \fBKeyPress\fR, \fBKeyRelease\fR, \fBButtonPress\fR,
+\fBButtonRelease\fR, \fBMotion\fR, \fBEnter\fR, \fBLeave\fR,
+\fBExpose\fR, \fBConfigure\fR, \fBGravity\fR, and \fBReparent\fR
+events.
+Corresponds to the the \fB%y\fR substitution for binding scripts.
+.PP
+Any options that are not specified when generating an event are filled
+with the value 0, except for \fIserial\fR, which is filled with the
+next X event serial number.
+
+.SH "VIRTUAL EVENT EXAMPLES"
+.PP
+In order for a virtual event binding to trigger, two things must
+happen. First, the virtual event must be defined with the
+\fBevent add\fR command. Second, a binding must be created for
+the virtual event with the \fBbind\fR command.
+Consider the following virtual event definitions:
+.CS
+event add <<Paste>> <Control-y>
+event add <<Paste>> <Button-2>
+event add <<Save>> <Control-X><Control-S>
+event add <<Save>> <Shift-F12>
+.CE
+In the \fBbind\fR command, a virtual event can be bound like any other
+builtin event type as follows:
+.CS
+bind Entry <<Paste>> {%W insert [selection get]}
+.CE
+The double angle brackets are used to specify that a virtual event is being
+bound. If the user types Control-y or presses button 2, or if
+a \fB<<Paste>>\fR virtual event is synthesized with \fBevent generate\fR,
+then the \fB<<Paste>>\fR binding will be invoked.
+.PP
+If a virtual binding has the exact same sequence as a separate
+physical binding, then the physical binding will take precedence.
+Consider the following example:
+.CS
+event add <<Paste>> <Control-y> <Meta-Control-y>
+bind Entry <Control-y> {puts Control-y}
+bind Entry <<Paste>> {puts Paste}
+.CE
+When the user types Control-y the \fB<Control-y>\fR binding
+will be invoked, because a physical event is considered
+more specific than a virtual event, all other things being equal.
+However, when the user types Meta-Control-y the
+\fB<<Paste>>\fR binding will be invoked, because the
+\fBMeta\fR modifier in the physical pattern associated with the
+virtual binding is more specific than the \fB<Control-y\fR> sequence for
+the physical event.
+.PP
+Bindings on a virtual event may be created before the virtual event exists.
+Indeed, the virtual event never actually needs to be defined, for instance,
+on platforms where the specific virtual event would meaningless or
+ungeneratable.
+.PP
+When a definition of a virtual event changes at run time, all windows
+will respond immediately to the new definition.
+Starting from the preceding example, if the following code is executed:
+.CS
+bind <Entry> <Control-y> {}
+event add <<Paste>> <Key-F6>
+.CE
+the behavior will change such in two ways. First, the shadowed
+\fB<<Paste>>\fR binding will emerge.
+Typing Control-y will no longer invoke the \fB<Control-y>\fR binding,
+but instead invoke the virtual event \fB<<Paste>>\fR. Second,
+pressing the F6 key will now also invoke the \fB<<Paste>>\fR binding.
+
+.SH "SEE ALSO"
+bind
+
+.SH KEYWORDS
+event, binding, define, handle, virtual event
diff --git a/tk/doc/focus.n b/tk/doc/focus.n
new file mode 100644
index 00000000000..496563c943f
--- /dev/null
+++ b/tk/doc/focus.n
@@ -0,0 +1,113 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBfocus\fR
+.sp
+\fBfocus \fIwindow\fR
+.sp
+\fBfocus \fIoption\fR ?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBfocus\fR command is used to manage the Tk input focus.
+At any given time, one window on each display is designated as
+the \fIfocus window\fR; any key press or key release events for the
+display are sent to that window.
+It is normally up to the window manager to redirect the focus among the
+top-level windows of a display. For example, some window managers
+automatically set the input focus to a top-level window whenever
+the mouse enters it; others redirect the input focus only when
+the user clicks on a window.
+Usually the window manager will set the focus
+only to top-level windows, leaving it up to the application to
+redirect the focus among the children of the top-level.
+.PP
+Tk remembers one focus window for each top-level (the most recent
+descendant of that top-level to receive the focus); when the window
+manager gives the focus
+to a top-level, Tk automatically redirects it to the remembered
+window. Within a top-level Tk uses an \fIexplicit\fR focus model
+by default. Moving the mouse within a top-level does not normally
+change the focus; the focus changes only when a widget
+decides explicitly to claim the focus (e.g., because of a button
+click), or when the user types a key such as Tab that moves the
+focus.
+.PP
+The Tcl procedure \fBtk_focusFollowsMouse\fR may be invoked to
+create an \fIimplicit\fR focus model: it reconfigures Tk so that
+the focus is set to a window whenever the mouse enters it.
+The Tcl procedures \fBtk_focusNext\fR and \fBtk_focusPrev\fR
+implement a focus order among the windows of a top-level; they
+are used in the default bindings for Tab and Shift-Tab, among other
+things.
+.PP
+The \fBfocus\fR command can take any of the following forms:
+.TP
+\fBfocus\fR
+Returns the path name of the focus window on the display containing
+the application's main window, or an empty string if no window in
+this application has the focus on that display. Note: it is
+better to specify the display explicitly using \fB\-displayof\fR
+(see below) so that the code will work in applications using multiple
+displays.
+.TP
+\fBfocus \fIwindow\fR
+If the application currently has the input focus on \fIwindow\fR's
+display, this command resets the input focus for \fIwindow\fR's display
+to \fIwindow\fR and returns an empty string.
+If the application doesn't currently have the input focus on
+\fIwindow\fR's display, \fIwindow\fR will be remembered as the focus
+for its top-level; the next time the focus arrives at the top-level,
+Tk will redirect it to \fIwindow\fR.
+If \fIwindow\fR is an empty string then the command does nothing.
+.TP
+\fBfocus \-displayof\fR \fIwindow\fR
+Returns the name of the focus window on the display containing \fIwindow\fR.
+If the focus window for \fIwindow\fR's display isn't in this
+application, the return value is an empty string.
+.TP
+\fBfocus \-force \fIwindow\fR
+Sets the focus of \fIwindow\fR's display to \fIwindow\fR, even if
+the application doesn't currently have the input focus for the display.
+This command should be used sparingly, if at all.
+In normal usage, an application should not claim the focus for
+itself; instead, it should wait for the window manager to give it
+the focus.
+If \fIwindow\fR is an empty string then the command does nothing.
+.TP
+\fBfocus \-lastfor\fR \fIwindow\fR
+Returns the name of the most recent window to have the input focus
+among all the windows in the same top-level as \fIwindow\fR.
+If no window in that top-level has ever had the input focus, or
+if the most recent focus window has been deleted, then the name
+of the top-level is returned. The return value is the window that
+will receive the input focus the next time the window manager gives
+the focus to the top-level.
+
+.SH "QUIRKS"
+.PP
+When an internal window receives the input focus, Tk doesn't actually
+set the X focus to that window; as far as X is concerned, the focus
+will stay on the top-level window containing the window with the focus.
+However, Tk generates FocusIn and FocusOut events just as if the X
+focus were on the internal window. This approach gets around a
+number of problems that would occur if the X focus were actually moved;
+the fact that the X focus is on the top-level is invisible unless
+you use C code to query the X server directly.
+
+.SH KEYWORDS
+events, focus, keyboard, top-level, window manager
diff --git a/tk/doc/focusNext.n b/tk/doc/focusNext.n
new file mode 100644
index 00000000000..a98e0fc56ad
--- /dev/null
+++ b/tk/doc/focusNext.n
@@ -0,0 +1,60 @@
+'\"
+'\" 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$
+'\"
+.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.
+.SH SYNOPSIS
+\fBtk_focusNext \fIwindow\fR
+.sp
+\fBtk_focusPrev \fIwindow\fR
+.sp
+\fBtk_focusFollowsMouse\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBtk_focusNext\fR is a utility procedure used for keyboard traversal.
+It returns the ``next'' window after \fIwindow\fR in focus order.
+The focus order is determined by
+the stacking order of windows and the structure of the window hierarchy.
+Among siblings, the focus order is the same as the stacking order, with the
+lowest window being first.
+If a window has children, the window is visited first, followed by
+its children (recursively), followed by its next sibling.
+Top-level windows other than \fIwindow\fR are skipped, so that
+\fBtk_focusNext\fR never returns a window in a different top-level
+from \fIwindow\fR.
+.PP
+After computing the next window, \fBtk_focusNext\fR examines the
+window's \fB\-takefocus\fR option to see whether it should be skipped.
+If so, \fBtk_focusNext\fR continues on to the next window in the focus
+order, until it eventually finds a window that will accept the focus
+or returns back to \fIwindow\fR.
+.PP
+\fBtk_focusPrev\fR is similar to \fBtk_focusNext\fR except that it
+returns the window just before \fIwindow\fR in the focus order.
+.PP
+\fBtk_focusFollowsMouse\fR changes the focus model for the application
+to an implicit one where the window under the mouse gets the focus.
+After this procedure is called, whenever the mouse enters a window
+Tk will automatically give it the input focus.
+The \fBfocus\fR command may be used to move the focus to a window
+other than the one under the mouse, but as soon as the mouse moves
+into a new window the focus will jump to that window.
+Note: at present there is no built-in support for returning the
+application to an explicit focus model; to do this you'll have
+to write a script that deletes the bindings created by
+\fBtk_focusFollowsMouse\fR.
+
+.SH KEYWORDS
+focus, keyboard traversal, top-level
diff --git a/tk/doc/font.n b/tk/doc/font.n
new file mode 100644
index 00000000000..b7d4b94c340
--- /dev/null
+++ b/tk/doc/font.n
@@ -0,0 +1,285 @@
+'\"
+'\" 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$
+'\"
+.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.
+.SH SYNOPSIS
+\fBfont\fI option \fR?\fIarg arg ...\fR?
+.BE
+.SH DESCRIPTION
+.PP
+The \fBfont\fR command provides several facilities for dealing with
+fonts, such as defining named fonts and inspecting the actual attributes of
+a font. The command has several different forms, determined by the
+first argument. The following forms are currently supported:
+.TP
+\fBfont actual \fIfont\fR ?\fB\-displayof \fIwindow\fR? ?\fIoption\fR?
+.
+Returns information about the the actual attributes that are obtained when
+\fIfont\fR is used on \fIwindow\fR's display; the actual attributes obtained
+may differ from the attributes requested due to platform-dependant
+limitations, such as the availability of font families and pointsizes.
+\fIfont\fR is a font description; see FONT DESCRIPTIONS below. If the
+\fIwindow\fR argument is omitted, it defaults to the main window. If
+\fIoption\fR is specified, returns the value of that attribute; if it is
+omitted, the return value is a list of all the attributes and their values.
+See FONT OPTIONS below for a list of the possible attributes.
+.TP
+\fBfont configure \fIfontname\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+.
+Query or modify the desired attributes for the named font called
+\fIfontname\fR. If no \fIoption\fR is specified, returns a list describing
+all the options and their values for \fIfontname\fR. If a single \fIoption\fR
+is specified with no \fIvalue\fR, then returns the current value of that
+attribute. If one or more \fIoption\fR\-\fIvalue\fR pairs are specified,
+then the command modifies the given named font to have the given values; in
+this case, all widgets using that font will redisplay themselves using the
+new attributes for the font. See FONT OPTIONS below for a list of the
+possible attributes.
+.TP
+\fBfont create\fR ?\fIfontname\fR? ?\fIoption value ...\fR?
+.
+Creates a new named font and returns its name. \fIfontname\fR specifies the
+name for the font; if it is omitted, then Tk generates a new name of the
+form \fBfont\fIx\fR, where \fIx\fR is an integer. There may be any number
+of \fIoption\fR\-\fIvalue\fR pairs, which provide the desired attributes for
+the new named font. See FONT OPTIONS below for a list of the possible
+attributes.
+.TP
+\fBfont delete\fR \fIfontname\fR ?\fIfontname ...\fR?
+.
+Delete the specified named fonts. If there are widgets using the named font,
+the named font won't actually be deleted until all the instances are
+released. Those widgets will continue to display using the last known values
+for the named font. If a deleted named font is subsequently recreated with
+another call to \fBfont create\fR, the widgets will use the new named font
+and redisplay themselves using the new attributes of that font.
+.TP
+\fBfont families\fR ?\fB\-displayof \fIwindow\fR?
+.
+The return value is a list of the case-insensitive names of all font families
+that exist on \fIwindow\fR's display. If the \fIwindow\fR argument is
+omitted, it defaults to the main window.
+.TP
+\fBfont measure \fIfont\fR ?\fB\-displayof \fIwindow\fR? \fItext\fR
+.
+Measures the amount of space the string \fItext\fR would use in the given
+\fIfont\fR when displayed in \fIwindow\fR. \fIfont\fR is a font description;
+see FONT DESCRIPTIONS below. If the \fIwindow\fR argument is omitted, it
+defaults to the main window. The return value is the total width in pixels
+of \fItext\fR, not including the extra pixels used by highly exagerrated
+characters such as cursive ``f''. If the string contains newlines or tabs,
+those characters are not expanded or treated specially when measuring the
+string.
+.TP
+\fBfont metrics \fIfont\fR ?\fB\-displayof \fIwindow\fR? ?\fIoption\fR?
+.
+Returns information about the metrics (the font-specific data), for
+\fIfont\fR when it is used on \fIwindow\fR's display. \fIfont\fR is a font
+description; see FONT DESCRIPTIONS below. If the \fIwindow\fR argument is
+omitted, it defaults to the main window. If \fIoption\fR is specified,
+returns the value of that metric; if it is omitted, the return value is a
+list of all the metrics and their values. See FONT METRICS below for a list
+of the possible metrics.
+.TP
+\fBfont names\fR
+The return value is a list of all the named fonts that are currently defined.
+.SH "FONT DESCRIPTION"
+.PP
+The following formats are accepted as a font description anywhere
+\fIfont\fR is specified as an argument above; these same forms are also
+permitted when specifying the \fB\-font\fR option for widgets.
+.TP
+[1] \fIfontname\fR
+.
+The name of a named font, created using the \fBfont create\fR command. When
+a widget uses a named font, it is guaranteed that this will never cause an
+error, as long as the named font exists, no matter what potentially invalid
+or meaningless set of attributes the named font has. If the named font
+cannot be displayed with exactly the specified attributes, some other close
+font will be substituted automatically.
+.TP
+[2] \fIsystemfont\fR
+.
+The platform-specific name of a font, interpreted by the graphics server.
+This also includes, under X, an XLFD (see [4]) for which a single ``\fB*\fR''
+character was used to elide more than one field in the middle of the
+name. See PLATFORM-SPECIFIC issues for a list of the system fonts.
+.VS 8.0 br
+.TP
+[3] \fIfamily \fR?\fIsize\fR? ?\fIstyle\fR? ?\fIstyle ...\fR?
+.
+A properly formed list whose first element is the desired font
+\fIfamily\fR and whose optional second element is the desired \fIsize\fR.
+The interpretation of the \fIsize\fR attribute follows the same rules
+described for \fB\-size\fR in FONT OPTIONS below. Any additional optional
+arguments following the \fIsize\fR are font \fIstyle\fRs. Possible values
+for the \fIstyle\fR arguments are as follows:
+.RS
+.DS
+.ta 3c 6c 9c
+\fBnormal bold roman italic
+underline overstrike\fR
+.DE
+.RE
+.TP
+[4] X-font names (XLFD)
+.
+A Unix-centric font name of the form
+\fI-foundry-family-weight-slant-setwidth-addstyle-pixel-point-resx-resy-spacing-width-charset-encoding\fR.
+The ``\fB*\fR'' character may be used to skip individual fields that the
+user does not care about. There must be exactly one ``\fB*\fR'' for each
+field skipped, except that a ``\fB*\fR'' at the end of the XLFD skips any
+remaining fields; the shortest valid XLFD is simply ``\fB*\fR'', signifying
+all fields as defaults. Any fields that were skipped are given default
+values. For compatibility, an XLFD always chooses a font of the specified
+pixel size (not point size); although this interpretation is not strictly
+correct, all existing applications using XLFDs assumed that one ``point''
+was in fact one pixel and would display incorrectly (generally larger) if
+the correct size font were actually used.
+.VE
+.TP
+[5] \fIoption value \fR?\fIoption value ...\fR?
+.
+A properly formed list of \fIoption\fR\-\fIvalue\fR pairs that specify
+the desired attributes of the font, in the same format used when defining
+a named font; see FONT OPTIONS below.
+.LP
+When font description \fIfont\fR is used, the system attempts to parse the
+description according to each of the above five rules, in the order specified.
+Cases [1] and [2] must match the name of an existing named font or of a
+system font. Cases [3], [4], and [5] are accepted on all
+platforms and the closest available font will be used. In some situations
+it may not be possible to find any close font (e.g., the font family was
+a garbage value); in that case, some system-dependant default font is
+chosen. If the font description does not match any of the above patterns,
+an error is generated.
+.SH "FONT METRICS"
+.
+The following options are used by the \fBfont metrics\fR command to query
+font-specific data determined when the font was created. These properties are
+for the whole font itself and not for individual characters drawn in that
+font. In the following definitions, the ``baseline'' of a font is the
+horizontal line where the bottom of most letters line up; certain letters,
+such as lower-case ``g'' stick below the baseline.
+.TP
+\fB\-ascent \0\fR
+.
+The amount in pixels that the tallest letter sticks up above the baseline of
+the font, plus any extra blank space added by the designer of the font.
+.TP
+\fB\-descent \0\fR
+.
+The largest amount in pixels that any letter sticks down below the baseline
+of the font, plus any extra blank space added by the designer of the font.
+.TP
+\fB\-linespace\fR
+.
+Returns how far apart vertically in pixels two lines of text using the same
+font should be placed so that none of the characters in one line overlap any
+of the characters in the other line. This is generally the sum of the ascent
+above the baseline line plus the descent below the baseline.
+.TP
+\fB\-fixed \0\fR
+.
+Returns a boolean flag that is ``\fB1\fR'' if this is a fixed-width font,
+where each normal character is the the same width as all the other
+characters, or is ``\fB0\fR'' if this is a proportionally-spaced font, where
+individual characters have different widths. The widths of control
+characters, tab characters, and other non-printing characters are not
+included when calculating this value.
+.SH "FONT OPTIONS"
+The following options are supported on all platforms, and are used when
+constructing a named font or when specifying a font using style [5] as
+above:
+.TP
+\fB\-family \fIname\fR
+.
+The case-insensitive font family name. Tk guarantees to support the font
+families named \fBCourier\fR (a monospaced ``typewriter'' font), \fBTimes\fR
+(a serifed ``newspaper'' font), and \fBHelvetica\fR (a sans-serif
+``European'' font). The most closely matching native font family will
+automatically be substituted when one of the above font families is used.
+The \fIname\fR may also be the name of a native, platform-specific font
+family; in that case it will work as desired on one platform but may not
+display correctly on other platforms. If the family is unspecified or
+unrecognized, a platform-specific default font will be chosen.
+.VS
+.TP
+\fB\-size \fIsize\fR
+.
+The desired size of the font. If the \fIsize\fR argument is a positive
+number, it is interpreted as a size in points. If \fIsize\fR is a negative
+number, its absolute value is interpreted as a size in pixels. If a
+font cannot be displayed at the specified size, a nearby size will be
+chosen. If \fIsize\fR is unspecified or zero, a platform-dependent default
+size will be chosen.
+.RS
+.PP
+Sizes should normally be specified in points so the application will remain
+the same ruler size on the screen, even when changing screen resolutions or
+moving scripts across platforms. However, specifying pixels is useful in
+certain circumstances such as when a piece of text must line up with respect
+to a fixed-size bitmap. The mapping between points and pixels is set when
+the application starts, based on properties of the installed monitor, but it
+can be overridden by calling the \fBtk scaling\fR command.
+.RE
+.VE
+.TP
+\fB\-weight \fIweight\fR
+.
+The nominal thickness of the characters in the font. The value
+\fBnormal\fR specifies a normal weight font, while \fBbold\fR specifies a
+bold font. The closest available weight to the one specified will
+be chosen. The default weight is \fBnormal\fR.
+.TP
+\fB\-slant \fIslant\fR
+The amount the characters in the font are slanted away from the
+vertical. Valid values for slant are \fBroman\fR and \fBitalic\fR.
+A roman font is the normal, upright appearance of a font, while
+an italic font is one that is tilted some number of degrees from upright.
+The closest available slant to the one specified will be chosen.
+The default slant is \fBroman\fR.
+.TP
+\fB\-underline \fIboolean\fR
+The value is a boolean flag that specifies whether characters in this
+font should be underlined. The default value for underline is \fBfalse\fR.
+.TP
+\fB\-overstrike \fIboolean\fR
+The value is a boolean flag that specifies whether a horizontal line should
+be drawn through the middle of characters in this font. The default value
+for overstrike is \fBfalse\fR.
+
+.SH "PLATFORM-SPECIFIC ISSUES"
+.LP
+The following named system fonts are supported:
+.RS
+.TP
+X Windows:
+All valid X font names, including those listed by xlsfonts(1), are available.
+.TP
+MS Windows:
+.DS
+\fBsystem ansi device
+systemfixed ansifixed oemfixed\fR
+.DE
+.TP
+Macintosh:
+.DS
+\fBsystem application\fR
+.DE
+.RE
+.SH "SEE ALSO"
+options
+
+.SH KEYWORDS
+font
diff --git a/tk/doc/frame.n b/tk/doc/frame.n
new file mode 100644
index 00000000000..6d8bf9901f4
--- /dev/null
+++ b/tk/doc/frame.n
@@ -0,0 +1,134 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBframe\fR \fIpathName\fR ?\fIoptions\fR?
+.SO
+\-borderwidth \-highlightbackground \-highlightthickness \-takefocus
+\-cursor \-highlightcolor \-relief
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-background background Background
+This option is the same as the standard \fBbackground\fR option
+except that its value may also be specified as an empty string.
+In this case, the widget will display no background or border, and
+no colors will be consumed from its colormap for its background
+and border.
+.OP \-class class Class
+Specifies a class for the window.
+This class will be used when querying the option database for
+the window's other options, and it will also be used later for
+other purposes such as bindings.
+The \fBclass\fR option may not be changed with the \fBconfigure\fR
+widget command.
+.OP \-colormap colormap Colormap
+Specifies a colormap to use for the window.
+The value may be either \fBnew\fR, in which case a new colormap is
+created for the window and its children, or the name of another
+window (which must be on the same screen and have the same visual
+as \fIpathName\fR), in which case the new window will use the colormap
+from the specified window.
+If the \fBcolormap\fR option is not specified, the new window
+uses the same colormap as its parent.
+This option may not be changed with the \fBconfigure\fR
+widget command.
+.VS "" br
+.OP \-container container Container
+The value must be a boolean. If true, it means that this window will
+be used as a container in which some other application will be embedded
+(for example, a Tk toplevel can be embedded using the \fB\-use\fR option).
+The window will support the appropriate window manager protocols for
+things like geometry requests. The window should not have any
+children of its own in this application.
+This option may not be changed with the \fBconfigure\fR
+widget command.
+.VE
+.OP \-height height Height
+Specifies the desired height for the window in any of the forms
+acceptable to \fBTk_GetPixels\fR.
+If this option is less than or equal to zero then the window will
+not request any size at all.
+.OP \-visual visual Visual
+Specifies visual information for the new window in any of the
+forms accepted by \fBTk_GetVisual\fR.
+If this option is not specified, the new window will use the same
+visual as its parent.
+The \fBvisual\fR option may not be modified with the \fBconfigure\fR
+widget command.
+.OP \-width width Width
+Specifies the desired width for the window in any of the forms
+acceptable to \fBTk_GetPixels\fR.
+If this option is less than or equal to zero then the window will
+not request any size at all.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBframe\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a frame widget.
+Additional
+options, described above, may be specified on the command line
+or in the option database
+to configure aspects of the frame such as its background color
+and relief. The \fBframe\fR command returns the
+path name of the new window.
+.PP
+A frame is a simple widget. Its primary purpose is to act as a
+spacer or container for complex window layouts. The only features
+of a frame are its background color and an optional 3-D border to make the
+frame appear raised or sunken.
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBframe\fR command creates a new Tcl command whose
+name is the same as the path name of the frame's window. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.CS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.CE
+\fIPathName\fR is the name of the command, which is the same as
+the frame widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for frame widgets:
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBframe\fR
+command.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBframe\fR
+command.
+
+.SH BINDINGS
+.PP
+When a new frame is created, it has no default event bindings:
+frames are not intended to be interactive.
+
+.SH KEYWORDS
+frame, widget
diff --git a/tk/doc/getOpenFile.n b/tk/doc/getOpenFile.n
new file mode 100644
index 00000000000..5c455214f16
--- /dev/null
+++ b/tk/doc/getOpenFile.n
@@ -0,0 +1,157 @@
+'\"
+'\" 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$
+'\"
+.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.
+.PP
+.PP
+.SH SYNOPSIS
+\fBtk_getOpenFile \fR?\fIoption value ...\fR?
+.br
+\fBtk_getSaveFile \fR?\fIoption value ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The procedures \fBtk_getOpenFile\fR and \fBtk_getSaveFile\fR pop up a
+dialog box for the user to select a file to open or save. The
+\fBtk_getOpenFile\fR command is usually associated with the \fBOpen\fR
+command in the \fBFile\fR menu. Its purpose is for the user to select an
+existing file \fIonly\fR. If the user enters an non-existent file, the
+dialog box gives the user an error prompt and requires the user to give
+an alternative selection. If an application allows the user to create
+new files, it should do so by providing a separate \fBNew\fR menu command.
+.PP
+The \fBtk_getSaveFile\fR command is usually associated with the \fBSave
+as\fR command in the \fBFile\fR menu. If the user enters a file that
+already exists, the dialog box prompts the user for confirmation
+whether the existing file should be overwritten or not.
+.PP
+The following \fIoption\-value\fR pairs are possible as command line
+arguments to these two commands:
+.TP
+\fB\-defaultextension\fR \fIextension\fR
+Specifies a string that will be appended to the filename if the user
+enters a filename without an extension. The defaut value is the empty
+string, which means no extension will be appended to the filename in
+any case. This option is ignored on the Macintosh platform, which
+does not require extensions to filenames.
+.TP
+\fB\-filetypes\fR \fIfilePatternList\fR
+If a \fBFile types\fR listbox exists in the file dialog on the particular
+platform, this option gives the \fIfiletype\fRs in this listbox. When
+the user choose a filetype in the listbox, only the files of that type
+are listed. If this option is unspecified, or if it is set to the
+empty list, or if the \fBFile types\fR listbox is not supported by the
+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
+dialog is displayed on top of its parent window.
+.TP
+\fB\-title\fR \fItitleString\fR
+Specifies a string to display as the title of the dialog box. If this
+option is not specified, then a default title is displayed. This
+option is ignored on the Macintosh platform.
+.PP
+If the user selects a file, both \fBtk_getOpenFile\fR and
+\fBtk_getSaveFile\fR return the full pathname of this file. If the
+user cancels the operation, both commands return the empty string.
+.SH "SPECIFYING FILE PATTERNS"
+
+The \fIfilePatternList\fR value given by the \fB\-filetypes\fR option
+is a list of file patterns. Each file pattern is a list of the
+form
+.CS
+\fItypeName\fR {\fIextension\fR ?\fIextension ...\fR?} ?{\fImacType\fR ?\fImacType ...\fR?}?
+.CE
+\fItypeName\fR is the name of the file type described by this
+file pattern and is the text string that appears in the \fBFile types\fR
+listbox. \fIextension\fR is a file extension for this file pattern.
+\fImacType\fR is a four-character Macintosh file type. The list of
+\fImacType\fRs is optional and may be omitted for applications that do
+not need to execute on the Macintosh platform.
+.PP
+Several file patterns may have the same \fItypeName,\fR in which case
+they refer to the same file type and share the same entry in the
+listbox. When the user selects an entry in the listbox, all the files
+that match at least one of the file patterns corresponding
+to that entry are listed. Usually, each file pattern corresponds to a
+distinct type of file. The use of more than one file patterns for one
+type of file is necessary on the Macintosh platform only.
+.PP
+On the Macintosh platform, a file matches a file pattern if its
+name matches at least one of the \fIextension\fR(s) AND it
+belongs to at least one of the \fImacType\fR(s) of the
+file pattern. For example, the \fBC Source Files\fR file pattern in the
+sample code matches with files that have a \fB\.c\fR extension AND
+belong to the \fImacType\fR \fBTEXT\fR. To use the OR rule instead,
+you can use two file patterns, one with the \fIextensions\fR only and
+the other with the \fImacType\fR only. The \fBGIF Files\fR file type
+in the sample code matches files that EITHER have a \fB\.gif\fR
+extension OR belong to the \fImacType\fR \fBGIFF\fR.
+.PP
+On the Unix and Windows platforms, a file matches a file pattern
+if its name matches at at least one of the \fIextension\fR(s) of
+the file pattern. The \fImacType\fRs are ignored.
+.SH "SPECIFYING EXTENSIONS"
+.PP
+On the Unix and Macintosh platforms, extensions are matched using
+glob-style pattern matching. On the Windows platforms, extensions are
+matched by the underlying operating system. The types of possible
+extensions are: (1) the special extension * matches any
+file; (2) the special extension "" matches any files that
+do not have an extension (i.e., the filename contains no full stop
+character); (3) any character string that does not contain any wild
+card characters (* and ?).
+.PP
+Due to the different pattern matching rules on the various platforms,
+to ensure portability, wild card characters are not allowed in the
+extensions, except as in the special extension *. Extensions
+without a full stop character (e.g, ~) are allowed but may not
+work on all platforms.
+
+.SH EXAMPLE
+.CS
+set types {
+ {{Text Files} {.txt} }
+ {{TCL Scripts} {.tcl} }
+ {{C Source Files} {.c} TEXT}
+ {{GIF Files} {.gif} }
+ {{GIF Files} {} GIFF}
+ {{All Files} * }
+}
+set filename [tk_getOpenFile -filetypes $types]
+
+if {$filename != ""} {
+ # Open the file ...
+}
+.CE
+
+.SH KEYWORDS
+file selection dialog
diff --git a/tk/doc/grab.n b/tk/doc/grab.n
new file mode 100644
index 00000000000..2d261d9c723
--- /dev/null
+++ b/tk/doc/grab.n
@@ -0,0 +1,122 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBgrab \fR?\fB\-global\fR? \fIwindow\fR
+.sp
+\fBgrab \fIoption \fR?\fIarg arg \fR...?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command implements simple pointer and keyboard grabs for Tk.
+Tk's grabs are different than the grabs
+described in the Xlib documentation.
+When a grab is set for a particular window, Tk restricts all pointer
+events to the grab window and its descendants in Tk's window hierarchy.
+Whenever the pointer is within the grab window's subtree, the pointer
+will behave exactly the same as if there had been no grab at all
+and all events will be reported in the normal fashion.
+When the pointer is outside \fIwindow\fR's tree, button presses and
+releases and
+mouse motion events are reported to \fIwindow\fR, and window entry
+and window exit events are ignored.
+The grab subtree ``owns'' the pointer:
+windows outside the grab subtree will be visible on the screen
+but they will be insensitive until the grab is released.
+The tree of windows underneath the grab window can include top-level
+windows, in which case all of those top-level windows
+and their descendants will continue to receive mouse events
+during the grab.
+.PP
+Two forms of grabs are possible: local and global.
+A local grab affects only the grabbing application: events will
+be reported to other applications as if the grab had never occurred.
+Grabs are local by default.
+A global grab locks out all applications on the screen,
+so that only the given subtree of the grabbing application will be
+sensitive to pointer events (mouse button presses, mouse button releases,
+pointer motions, window entries, and window exits).
+During global grabs the window manager will not receive pointer
+events either.
+.PP
+During local grabs, keyboard events (key presses and key releases)
+are delivered as usual: the window
+manager controls which application receives keyboard events, and
+if they are sent to any window in the grabbing application then they are
+redirected to the focus window.
+During a global grab Tk grabs the keyboard so that all keyboard events
+are always sent to the grabbing application.
+The \fBfocus\fR command is still used to determine which window in the
+application receives the keyboard events.
+The keyboard grab is released when the grab is released.
+.PP
+Grabs apply to particular displays. If an application has windows
+on multiple displays then it can establish a separate grab on each
+display.
+The grab on a particular display affects only the windows on
+that display.
+It is possible for different applications on a single display to have
+simultaneous local grabs, but only one application can have a global
+grab on a given display at once.
+.PP
+The \fBgrab\fR command can take any of the following forms:
+.TP
+\fBgrab \fR?\fB\-global\fR? \fIwindow\fR
+Same as \fBgrab set\fR, described below.
+.TP
+\fBgrab current \fR?\fIwindow\fR?
+If \fIwindow\fR is specified, returns the name of the current grab
+window in this application for \fIwindow\fR's display, or an empty
+string if there is no such window.
+If \fIwindow\fR is omitted, the command returns a list whose elements
+are all of the windows grabbed by this application for all displays,
+or an empty string if the application has no grabs.
+.TP
+\fBgrab release \fIwindow\fR
+Releases the grab on \fIwindow\fR if there is one, otherwise does
+nothing. Returns an empty string.
+.TP
+\fBgrab set \fR?\fB\-global\fR? \fIwindow\fR
+Sets a grab on \fIwindow\fR. If \fB\-global\fR is specified then the
+grab is global, otherwise it is local.
+If a grab was already in effect for this application on
+\fIwindow\fR's display then it is automatically released.
+If there is already a grab on \fIwindow\fR and it has the same
+global/local form as the requested grab, then the command
+does nothing. Returns an empty string.
+.TP
+\fBgrab status \fIwindow\fR
+Returns \fBnone\fR if no grab is currently set on \fIwindow\fR,
+\fBlocal\fR if a local grab is set on \fIwindow\fR, and
+\fBglobal\fR if a global grab is set.
+
+.SH BUGS
+.PP
+It took an incredibly complex and gross implementation to produce
+the simple grab effect described above.
+Given the current implementation, it isn't safe for applications
+to use the Xlib grab facilities at all except through the Tk grab
+procedures.
+If applications try to manipulate X's grab mechanisms directly,
+things will probably break.
+.PP
+If a single process is managing several different Tk applications,
+only one of those applications can have a local grab for a given
+display at any given time. If the applications are in different
+processes, this restriction doesn't exist.
+
+.SH KEYWORDS
+grab, keyboard events, pointer events, window
diff --git a/tk/doc/grid.n b/tk/doc/grid.n
new file mode 100644
index 00000000000..517efa3cbc0
--- /dev/null
+++ b/tk/doc/grid.n
@@ -0,0 +1,337 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBgrid \fIoption arg \fR?\fIarg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBgrid\fR command is used to communicate with the grid
+geometry manager that arranges widgets in rows and columns inside
+of another window, called the geometry master (or master window).
+The \fBgrid\fR command can have any of several forms, depending
+on the \fIoption\fR argument:
+.TP
+\fBgrid \fIslave \fR?\fIslave ...\fR? ?\fIoptions\fR?
+If the first argument to \fBgrid\fR is a window name (any value
+starting with ``.''), then the command is processed in the same
+way as \fBgrid configure\fR.
+.TP
+\fBgrid bbox \fImaster\fR ?\fIcolumn row\fR? ?\fIcolumn2 row2\fR?
+With no arguments,
+the bounding box (in pixels) of the grid is returned.
+The return value consists of 4 integers. The first two are the pixel
+offset from the master window (x then y) of the top-left corner of the
+grid, and the second two integers are the width and height of the grid,
+also in pixels. If a single \fIcolumn\fP and \fIrow\fP is specified on
+the command line, then the bounding box for that cell is returned, where the
+top left cell is numbered from zero. If both \fIcolumn\fP and \fIrow\fP
+arguments are specified, then the bounding box spanning the rows and columns
+indicated is returned.
+.TP
+\fBgrid columnconfigure \fImaster index \fR?\fI\-option value...\fR?
+Query or set the column properties of the \fIindex\fP column of the
+geometry master, \fImaster\fP.
+The valid options are \fB\-minsize\fP, \fB\-weight\fP and \fB-pad\fP.
+.VS
+If one or more options are provided, then \fIindex\fP may be given as
+a list of column indeces to which the configuration options will operate on.
+.VE
+The \fB\-minsize\fP option sets the minimum size, in screen units,
+that will be permitted for this column.
+The \fB\-weight\fP option (an integer value)
+sets the relative weight for apportioning
+any extra spaces among
+columns.
+A weight of zero (0) indicates the column will not deviate from its requested
+size. A column whose weight is two will grow at twice the rate as a column
+of weight one when extra space is allocated to the layout.
+The \fB-pad\fP option specifies the number of screen units that will be
+added to the largest window contained completely in that column when the
+grid geometry manager requests a size from the containing window.
+If only an option is specified, with no value,
+the current value of that option is returned.
+If only the master window and index is specified, all the current settings
+are returned in an list of "-option value" pairs.
+.TP
+\fBgrid configure \fIslave \fR?\fIslave ...\fR? ?\fIoptions\fR?
+The arguments consist of the names of one or more slave windows
+followed by pairs of arguments that specify how
+to manage the slaves.
+The characters \fB\-\fP, \fBx\fP and \fB^\fP,
+can be specified instead of a window name to alter the default
+location of a \fIslave\fP, as described in the ``RELATIVE PLACEMENT''
+section, below.
+The following options are supported:
+.RS
+.TP
+\fB\-column \fIn\fR
+Insert the slave so that it occupies the \fIn\fPth column in the grid.
+Column numbers start with 0. If this option is not supplied, then the
+slave is arranged just to the right of previous slave specified on this
+call to \fIgrid\fP, or column "0" if it is the first slave. For each
+\fBx\fP that immediately precedes the \fIslave\fP, the column position
+is incremented by one. Thus the \fBx\fP represents a blank column
+for this row in the grid.
+.TP
+\fB\-columnspan \fIn\fR
+Insert the slave so that it occupies \fIn\fP columns in the grid.
+The default is one column, unless the window name is followed by a
+\fB\-\fP, in which case the columnspan is incremented once for each immediately
+following \fB\-\fP.
+.TP
+\fB\-in \fIother\fR
+Insert the slave(s) in the master
+window given by \fIother\fR. The default is the first slave's
+parent window.
+.TP
+\fB\-ipadx \fIamount\fR
+The \fIamount\fR specifies how much horizontal internal padding to
+leave on each side of the slave(s). This is space is added
+inside the slave(s) border.
+The \fIamount\fR must be a valid screen distance, such as \fB2\fR or \fB.5c\fR.
+It defaults to 0.
+.TP
+\fB\-ipady \fIamount\fR
+The \fIamount\fR specifies how much vertical internal padding to
+leave on on the top and bottom of the slave(s).
+This space is added inside the slave(s) border.
+The \fIamount\fR defaults to 0.
+.TP
+\fB\-padx \fIamount\fR
+The \fIamount\fR specifies how much horizontal external padding to
+leave on each side of the slave(s), in screen units.
+The \fIamount\fR defaults to 0.
+This space is added outside the slave(s) border.
+.TP
+\fB\-pady \fIamount\fR
+The \fIamount\fR specifies how much vertical external padding to
+leave on the top and bottom of the slave(s), in screen units.
+The \fIamount\fR defaults to 0.
+This space is added outside the slave(s) border.
+.TP
+\fB\-row \fIn\fR
+Insert the slave so that it occupies the \fIn\fPth row in the grid.
+Row numbers start with 0. If this option is not supplied, then the
+slave is arranged on the same row as the previous slave specified on this
+call to \fBgrid\fP, or the first unoccupied row if this is the first slave.
+.TP
+\fB\-rowspan \fIn\fR
+Insert the slave so that it occupies \fIn\fP rows in the grid.
+The default is one row. If the next \fBgrid\fP command contains
+\fB^\fP characters instead of \fIslaves\fP that line up with the columns
+of this \fIslave\fP, then the \fBrowspan\fP of this \fIslave\fP is
+extended by one.
+.TP
+\fB\-sticky \fIstyle\fR
+If a slave's cell is larger than its requested dimensions, this
+option may be used to position (or stretch) the slave within its cell.
+\fIStyle\fR is a string that contains zero or more of the characters
+\fBn\fP, \fBs\fP, \fBe\fP or \fBw\fP.
+The string can optionally contains spaces or
+commas, but they are ignored. Each letter refers to a side (north, south,
+east, or west) that the slave will "stick" to. If both \fBn\fP and \fBs\fP (or
+\fBe\fP and \fBw\fP) are specified, the slave will be stretched to fill the entire
+height (or width) of its cavity. The \fBsticky\fP option subsumes the
+combination of \fB\-anchor\fP and \fB\-fill\fP that is used by \fBpack\fP.
+The default is \fB{}\fP, which causes the slave to be centered in its cavity,
+at its requested size.
+.LP
+If any of the slaves are already managed by the geometry manager
+then any unspecified options for them retain their previous values rather
+than receiving default values.
+.RE
+.TP
+\fBgrid forget \fIslave \fR?\fIslave ...\fR?
+Removes each of the \fIslave\fRs from grid for its
+master and unmaps their windows.
+The slaves will no longer be managed by the grid geometry manager.
+The configuration options for that window are forgotten, so that if the
+slave is managed once more by the grid geometry manager, the initial
+default settings are used.
+.TP
+\fBgrid info \fIslave\fR
+Returns a list whose elements are the current configuration state of
+the slave given by \fIslave\fR in the same option-value form that
+might be specified to \fBgrid configure\fR.
+The first two elements of the list are ``\fB\-in \fImaster\fR'' where
+\fImaster\fR is the slave's master.
+.TP
+\fBgrid location \fImaster x y\fR
+Given \fIx\fP and \fIy\fP values in screen units relative to the master window,
+the column and row number at that \fIx\fP and \fIy\fP location is returned.
+For locations that are above or to the left of the grid, \fB-1\fP is returned.
+.TP
+\fBgrid propagate \fImaster\fR ?\fIboolean\fR?
+If \fIboolean\fR has a true boolean value such as \fB1\fR or \fBon\fR
+then propagation is enabled for \fImaster\fR, which must be a window
+name (see ``GEOMETRY PROPAGATION'' below).
+If \fIboolean\fR has a false boolean value then propagation is
+disabled for \fImaster\fR.
+In either of these cases an empty string is returned.
+If \fIboolean\fR is omitted then the command returns \fB0\fR or
+\fB1\fR to indicate whether propagation is currently enabled
+for \fImaster\fR.
+Propagation is enabled by default.
+.TP
+\fBgrid rowconfigure \fImaster index \fR?\fI\-option value...\fR?
+Query or set the row properties of the \fIindex\fP row of the
+geometry master, \fImaster\fP.
+The valid options are \fB\-minsize\fP, \fB\-weight\fP and \fB-pad\fP.
+.VS
+If one or more options are provided, then \fIindex\fP may be given as
+a list of row indeces to which the configuration options will operate on.
+.VE
+The \fB\-minsize\fP option sets the minimum size, in screen units,
+that will be permitted for this row.
+The \fB\-weight\fP option (an integer value)
+sets the relative weight for apportioning
+any extra spaces among
+rows.
+A weight of zero (0) indicates the row will not deviate from its requested
+size. A row whose weight is two will grow at twice the rate as a row
+of weight one when extra space is allocated to the layout.
+The \fB-pad\fP option specifies the number of screen units that will be
+added to the largest window contained completely in that row when the
+grid geometry manager requests a size from the containing window.
+If only an option is specified, with no value,
+the current value of that option is returned.
+If only the master window and index is specified, all the current settings
+are returned in an list of "-option value" pairs.
+.TP
+\fBgrid remove \fIslave \fR?\fIslave ...\fR?
+Removes each of the \fIslave\fRs from grid for its
+master and unmaps their windows.
+The slaves will no longer be managed by the grid geometry manager.
+However, the configuration options for that window are remembered,
+so that if the
+slave is managed once more by the grid geometry manager, the previous
+values are retained.
+.TP
+\fBgrid size \fImaster\fR
+Returns the size of the grid (in columns then rows) for \fImaster\fP.
+The size is determined either by the \fIslave\fP occupying the largest
+row or column, or the largest column or row with a \fBminsize\fP,
+\fBweight\fP, or \fBpad\fP that is non-zero.
+.TP
+\fBgrid slaves \fImaster\fR ?\fI\-option value\fR?
+If no options are supplied, a list of all of the slaves in \fImaster\fR
+are returned, most recently manages first.
+\fIOption\fP can be either \fB\-row\fP or \fB\-column\fP which
+causes only the slaves in the row (or column) specified by \fIvalue\fP
+to be returned.
+.SH "RELATIVE PLACEMENT"
+.PP
+The \fBgrid\fP command contains a limited set of capabilities that
+permit layouts to be created without specifying the row and column
+information for each slave. This permits slaves to be rearranged,
+added, or removed without the need to explicitly specify row and
+column information.
+When no column or row information is specified for a \fIslave\fP,
+default values are chosen for
+\fBcolumn\fP, \fBrow\fP, \fBcolumnspan\fP and \fBrowspan\fP
+at the time the \fIslave\fP is managed. The values are chosen
+based upon the current layout of the grid, the position of the \fIslave\fP
+relative to other \fIslave\fPs in the same grid command, and the presence
+of the characters \fB\-\fP, \fB^\fP, and \fB^\fP in \fBgrid\fP
+command where \fIslave\fP names are normally expected.
+.RS
+.TP
+\fB\-\fP
+This increases the columnspan of the \fIslave\fP to the left. Several
+\fB\-\fP's in a row will successively increase the columnspan. A \fB\-\fP
+may not follow a \fB^\fP or a \fBx\fP.
+.TP
+\fBx\fP
+This leaves an empty column between the \fIslave\fP on the left and
+the \fIslave\fP on the right.
+.TP
+\fB^\fP
+This extends the \fBrowspan\fP of the \fIslave\fP above the \fB^\fP's
+in the grid. The number of \fB^\fP's in a row must match the number of
+columns spanned by the \fIslave\fP above it.
+.RE
+.SH "THE GRID ALGORITHM"
+.PP
+The grid geometry manager lays out its slaves in three steps.
+In the first step, the minimum size needed to fit all of the slaves
+is computed, then (if propagation is turned on), a request is made
+of the master window to become that size.
+In the second step, the requested size is compared against the actual size
+of the master. If the sizes are different, then spaces is added to or taken
+away from the layout as needed.
+For the final step, each slave is positioned in its row(s) and column(s)
+based on the setting of its \fIsticky\fP flag.
+.PP
+To compute the minimum size of a layout, the grid geometry manager
+first looks at all slaves whose columnspan and rowspan values are one,
+and computes the nominal size of each row or column to be either the
+\fIminsize\fP for that row or column, or the sum of the \fIpad\fPding
+plus the size of the largest slave, whichever is greater. Then the
+slaves whose rowspans or columnspans are greater than one are
+examined. If a group of rows or columns need to be increased in size
+in order to accommodate these slaves, then extra space is added to each
+row or column in the group according to its \fIweight\fP. For each
+group whose weights are all zero, the additional space is apportioned
+equally.
+.PP
+For masters whose size is larger than the requested layout, the additional
+space is apportioned according to the row and column weights. If all of
+the weights are zero, the layout is centered within its master.
+For masters whose size is smaller than the requested layout, space is taken
+away from columns and rows according to their weights. However, once a
+column or row shrinks to its minsize, its weight is taken to be zero.
+If more space needs to be removed from a layout than would be permitted, as
+when all the rows or columns are at there minimum sizes, the layout is
+clipped on the bottom and right.
+.SH "GEOMETRY PROPAGATION"
+.PP
+The grid geometry manager normally computes how large a master must be to
+just exactly meet the needs of its slaves, and it sets the
+requested width and height of the master to these dimensions.
+This causes geometry information to propagate up through a
+window hierarchy to a top-level window so that the entire
+sub-tree sizes itself to fit the needs of the leaf windows.
+However, the \fBgrid propagate\fR command may be used to
+turn off propagation for one or more masters.
+If propagation is disabled then grid will not set
+the requested width and height of the master window.
+This may be useful if, for example, you wish for a master
+window to have a fixed size that you specify.
+
+.SH "RESTRICTIONS ON MASTER WINDOWS"
+.PP
+The master for each slave must either be the slave's parent
+(the default) or a descendant of the slave's parent.
+This restriction is necessary to guarantee that the
+slave can be placed over any part of its master that is
+visible without danger of the slave being clipped by its parent.
+In addition, all slaves in one call to \fBgrid\fP must have the same master.
+.SH "STACKING ORDER"
+.PP
+If the master for a slave is not its parent then you must make sure
+that the slave is higher in the stacking order than the master.
+Otherwise the master will obscure the slave and it will appear as
+if the slave hasn't been managed correctly.
+The easiest way to make sure the slave is higher than the master is
+to create the master window first: the most recently created window
+will be highest in the stacking order.
+.SH CREDITS
+.PP
+The \fBgrid\fP command is based on ideas taken from the \fIGridBag\fP
+geometry manager written by Doug. Stein, and the \fBblt_table\fR geometry
+manager, written by George Howlett.
+.SH KEYWORDS
+geometry manager, location, grid, cell, propagation, size, pack
diff --git a/tk/doc/image.n b/tk/doc/image.n
new file mode 100644
index 00000000000..e998293c52d
--- /dev/null
+++ b/tk/doc/image.n
@@ -0,0 +1,90 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBimage\fR \fIoption \fR?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBimage\fR command is used to create, delete, and query images.
+It can take several different forms, depending on the
+\fIoption\fR argument. The legal forms are:
+.TP
+\fBimage create \fItype \fR?\fIname\fR? ?\fIoption value ...\fR?
+Creates a new image and returns its name.
+\fItype\fR specifies the type of the image, which must be one of
+the types currently defined (e.g., \fBbitmap\fR).
+\fIname\fR specifies the name for the image; if it is omitted then
+Tk picks a name of the form \fBimage\fIx\fR, where \fIx\fR is
+an integer.
+There may be any number of \fIoption\fR\-\fIvalue\fR pairs,
+which provide configuration options for the new image.
+The legal set of options is defined separately for each image
+type; see below for details on the options for built-in image types.
+If an image already exists by the given name then it is replaced
+with the new image and any instances of that image will redisplay
+with the new contents.
+.TP
+\fBimage delete \fR?\fIname name\fR ...?
+Deletes each of the named images and returns an empty string.
+If there are instances of the images displayed in widgets,
+the images won't actually be deleted until all of the instances
+are released.
+However, the association between the instances and the image
+manager will be dropped.
+Existing instances will retain their sizes but redisplay as
+empty areas.
+If a deleted image is recreated with another call to \fBimage create\fR,
+the existing instances will use the new image.
+.TP
+\fBimage height \fIname\fR
+Returns a decimal string giving the height of image \fIname\fR
+in pixels.
+.TP
+\fBimage names\fR
+Returns a list containing the names of all existing images.
+.TP
+\fBimage type \fIname\fR
+Returns the type of image \fIname\fR (the value of the \fItype\fR
+argument to \fBimage create\fR when the image was created).
+.TP
+\fBimage types\fR
+Returns a list whose elements are all of the valid image types
+(i.e., all of the values that may be supplied for the \fItype\fR
+argument to \fBimage create\fR).
+.TP
+\fBimage width \fIname\fR
+Returns a decimal string giving the width of image \fIname\fR
+in pixels.
+
+.SH "BUILT-IN IMAGE TYPES"
+.PP
+The following image types are defined by Tk so they will be available
+in any Tk application.
+Individual applications or extensions may define additional types.
+.TP
+\fBbitmap\fR
+Each pixel in the image displays a foreground color, a background
+color, or nothing.
+See the \fBbitmap\fR manual entry for more information.
+.TP
+\fBphoto\fR
+Displays a variety of full-color images, using dithering to
+approximate colors on displays with limited color capabilities.
+See the \fBphoto\fR manual entry for more information.
+
+.SH KEYWORDS
+height, image, types of images, width
diff --git a/tk/doc/label.n b/tk/doc/label.n
new file mode 100644
index 00000000000..4abc312bac4
--- /dev/null
+++ b/tk/doc/label.n
@@ -0,0 +1,103 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBlabel\fR \fIpathName \fR?\fIoptions\fR?
+.SO
+\-anchor \-font \-image \-takefocus
+\-background \-foreground \-justify \-text
+\-bitmap \-highlightbackground \-padx \-textvariable
+\-borderwidth \-highlightcolor \-pady \-underline
+\-cursor \-highlightthickness \-relief \-wraplength
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-height height Height
+Specifies a desired height for the label.
+If an image or bitmap is being displayed in the label then the value is in
+screen units (i.e. any of the forms acceptable to \fBTk_GetPixels\fR);
+for text it is in lines of text.
+If this option isn't specified, the label's desired height is computed
+from the size of the image or bitmap or text being displayed in it.
+.OP \-width width Width
+Specifies a desired width for the label.
+If an image or bitmap is being displayed in the label then the value is in
+screen units (i.e. any of the forms acceptable to \fBTk_GetPixels\fR);
+for text it is in characters.
+If this option isn't specified, the label's desired width is computed
+from the size of the image or bitmap or text being displayed in it.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBlabel\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a label widget.
+Additional
+options, described above, may be specified on the command line
+or in the option database
+to configure aspects of the label such as its colors, font,
+text, and initial relief. The \fBlabel\fR command returns its
+\fIpathName\fR argument. At the time this command is invoked,
+there must not exist a window named \fIpathName\fR, but
+\fIpathName\fR's parent must exist.
+.PP
+A label is a widget that displays a textual string, bitmap or image.
+If text is displayed, it must all be in a single font, but it
+can occupy multiple lines on the screen (if it contains newlines
+or if wrapping occurs because of the \fBwrapLength\fR option) and
+one of the characters may optionally be underlined using the
+\fBunderline\fR option.
+The label can be manipulated in a few simple ways, such as
+changing its relief or text, using the commands described below.
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBlabel\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.CS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.CE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for label widgets:
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBlabel\fR
+command.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBlabel\fR
+command.
+
+.SH BINDINGS
+.PP
+When a new label is created, it has no default event bindings:
+labels are not intended to be interactive.
+
+.SH KEYWORDS
+label, widget
diff --git a/tk/doc/license.terms b/tk/doc/license.terms
new file mode 100644
index 00000000000..03ca6fcb319
--- /dev/null
+++ b/tk/doc/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., and other parties. The following
+terms apply to all files associated with the software unless explicitly
+disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
diff --git a/tk/doc/listbox.n b/tk/doc/listbox.n
new file mode 100644
index 00000000000..7610e3ad344
--- /dev/null
+++ b/tk/doc/listbox.n
@@ -0,0 +1,491 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBlistbox\fR \fIpathName \fR?\fIoptions\fR?
+.SO
+\-background \-foreground \-relief \-takefocus
+\-borderwidth \-height \-selectbackground \-width
+\-cursor \-highlightbackground \-selectborderwidth \-xscrollcommand
+\-exportselection \-highlightcolor \-selectforeground \-yscrollcommand
+\-font \-highlightthickness \-setgrid
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-height height Height
+Specifies the desired height for the window, in lines.
+If zero or less, then the desired height for the window is made just
+large enough to hold all the elements in the listbox.
+.OP \-selectmode selectMode SelectMode
+Specifies one of several styles for manipulating the selection.
+The value of the option may be arbitrary, but the default bindings
+expect it to be either \fBsingle\fR, \fBbrowse\fR, \fBmultiple\fR,
+or \fBextended\fR; the default value is \fBbrowse\fR.
+.OP \-width width Width
+Specifies the desired width for the window in characters.
+If the font doesn't have a uniform width then the width of the
+character ``0'' is used in translating from character units to
+screen units.
+If zero or less, then the desired width for the window is made just
+large enough to hold all the elements in the listbox.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBlistbox\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a listbox widget.
+Additional
+options, described above, may be specified on the command line
+or in the option database
+to configure aspects of the listbox such as its colors, font,
+text, and relief. The \fBlistbox\fR command returns its
+\fIpathName\fR argument. At the time this command is invoked,
+there must not exist a window named \fIpathName\fR, but
+\fIpathName\fR's parent must exist.
+.PP
+A listbox is a widget that displays a list of strings, one per line.
+When first created, a new listbox has no elements.
+Elements may be added or deleted using widget commands described
+below. In addition, one or more elements may be selected as described
+below.
+If a listbox is exporting its selection (see \fBexportSelection\fR
+option), then it will observe the standard X11 protocols
+for handling the selection.
+Listbox selections are available as type \fBSTRING\fR;
+the value of the selection will be the text of the selected elements, with
+newlines separating the elements.
+.PP
+It is not necessary for all the elements to be
+displayed in the listbox window at once; commands described below
+may be used to change the view in the window. Listboxes allow
+scrolling in both directions using the standard \fBxScrollCommand\fR
+and \fByScrollCommand\fR options.
+They also support scanning, as described below.
+
+.SH "INDICES"
+.PP
+Many of the widget commands for listboxes take one or more indices
+as arguments.
+An index specifies a particular element of the listbox, in any of
+the following ways:
+.TP 12
+\fInumber\fR
+Specifies the element as a numerical index, where 0 corresponds
+to the first element in the listbox.
+.TP 12
+\fBactive\fR
+Indicates the element that has the location cursor. This element
+will be displayed with an underline when the listbox has the
+keyboard focus, and it is specified with the \fBactivate\fR
+widget command.
+.TP 12
+\fBanchor\fR
+Indicates the anchor point for the selection, which is set with the
+\fBselection anchor\fR widget command.
+.TP 12
+\fBend\fR
+Indicates the end of the listbox.
+.VS 8.0
+For most commands this refers to the last element in the listbox,
+but for a few commands such as \fBindex\fR and \fBinsert\fR
+it refers to the element just after the last one.
+.VE
+.TP 12
+\fB@\fIx\fB,\fIy\fR
+Indicates the element that covers the point in the listbox window
+specified by \fIx\fR and \fIy\fR (in pixel coordinates). If no
+element covers that point, then the closest element to that
+point is used.
+.LP
+In the widget command descriptions below, arguments named \fIindex\fR,
+\fIfirst\fR, and \fIlast\fR always contain text indices in one of
+the above forms.
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBlistbox\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.CS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.CE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for listbox widgets:
+.TP
+\fIpathName \fBactivate\fR \fIindex\fR
+Sets the active element to the one indicated by \fIindex\fR.
+.VS 8.0
+If \fIindex\fR is outside the range of elements in the listbox
+then the closest element is activated.
+.VE
+The active element is drawn with an underline when the widget
+has the input focus, and its index may be retrieved with the
+index \fBactive\fR.
+.TP
+\fIpathName \fBbbox\fR \fIindex\fR
+Returns a list of four numbers describing the bounding box of
+the text in the element given by \fIindex\fR.
+The first two elements of the list give the x and y coordinates
+of the upper-left corner of the screen area covered by the text
+(specified in pixels relative to the widget) and the last two
+elements give the width and height of the area, in pixels.
+If no part of the element given by \fIindex\fR is visible on the
+screen,
+.VS 8.0
+or if \fIindex\fR refers to a non-existent element,
+.VE
+then the result is an empty string; if the element is
+partially visible, the result gives the full area of the element,
+including any parts that are not visible.
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBlistbox\fR
+command.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBlistbox\fR
+command.
+.TP
+\fIpathName \fBcurselection\fR
+Returns a list containing the numerical indices of
+all of the elements in the listbox that are currently selected.
+If there are no elements selected in the listbox then an empty
+string is returned.
+.TP
+\fIpathName \fBdelete \fIfirst \fR?\fIlast\fR?
+Deletes one or more elements of the listbox. \fIFirst\fR and \fIlast\fR
+are indices specifying the first and last elements in the range
+to delete. If \fIlast\fR isn't specified it defaults to
+\fIfirst\fR, i.e. a single element is deleted.
+.TP
+\fIpathName \fBget \fIfirst\fR ?\fIlast\fR?
+If \fIlast\fR is omitted, returns the contents of the listbox
+element indicated by \fIfirst\fR,
+.VS 8.0
+or an empty string if \fIfirst\fR refers to a non-existent element.
+.VE
+If \fIlast\fR is specified, the command returns a list whose elements
+are all of the listbox elements between \fIfirst\fR and \fIlast\fR,
+inclusive.
+Both \fIfirst\fR and \fIlast\fR may have any of the standard
+forms for indices.
+.TP
+\fIpathName \fBindex \fIindex\fR
+Returns the integer index value that corresponds to \fIindex\fR.
+.VS 8.0
+If \fIindex\fR is \fBend\fR the return value is a count of the number
+of elements in the listbox (not the index of the last element).
+.VE
+.TP
+\fIpathName \fBinsert \fIindex \fR?\fIelement element ...\fR?
+Inserts zero or more new elements in the list just before the
+element given by \fIindex\fR. If \fIindex\fR is specified as
+\fBend\fR then the new elements are added to the end of the
+list. Returns an empty string.
+.TP
+\fIpathName \fBnearest \fIy\fR
+Given a y-coordinate within the listbox window, this command returns
+the index of the (visible) listbox element nearest to that y-coordinate.
+.TP
+\fIpathName \fBscan\fR \fIoption args\fR
+This command is used to implement scanning on listboxes. It has
+two forms, depending on \fIoption\fR:
+.RS
+.TP
+\fIpathName \fBscan mark \fIx y\fR
+Records \fIx\fR and \fIy\fR and the current view in the listbox
+window; used in conjunction with later \fBscan dragto\fR commands.
+Typically this command is associated with a mouse button press in
+the widget. It returns an empty string.
+.TP
+\fIpathName \fBscan dragto \fIx y\fR.
+This command computes the difference between its \fIx\fR and \fIy\fR
+arguments and the \fIx\fR and \fIy\fR arguments to the last
+\fBscan mark\fR command for the widget.
+It then adjusts the view by 10 times the
+difference in coordinates. This command is typically associated
+with mouse motion events in the widget, to produce the effect of
+dragging the list at high speed through the window. The return
+value is an empty string.
+.RE
+.TP
+\fIpathName \fBsee \fIindex\fR
+Adjust the view in the listbox so that the element given by \fIindex\fR
+is visible.
+If the element is already visible then the command has no effect;
+if the element is near one edge of the window then the listbox
+scrolls to bring the element into view at the edge; otherwise
+the listbox scrolls to center the element.
+.TP
+\fIpathName \fBselection \fIoption arg\fR
+This command is used to adjust the selection within a listbox. It
+has several forms, depending on \fIoption\fR:
+.RS
+.TP
+\fIpathName \fBselection anchor \fIindex\fR
+Sets the selection anchor to the element given by \fIindex\fR.
+.VS 8.0
+If \fIindex\fR refers to a non-existent element, then the closest
+element is used.
+.VE
+The selection anchor is the end of the selection that is fixed
+while dragging out a selection with the mouse.
+The index \fBanchor\fR may be used to refer to the anchor
+element.
+.TP
+\fIpathName \fBselection clear \fIfirst \fR?\fIlast\fR?
+If any of the elements between \fIfirst\fR and \fIlast\fR
+(inclusive) are selected, they are deselected.
+The selection state is not changed for elements outside
+this range.
+.TP
+\fIpathName \fBselection includes \fIindex\fR
+Returns 1 if the element indicated by \fIindex\fR is currently
+selected, 0 if it isn't.
+.TP
+\fIpathName \fBselection set \fIfirst \fR?\fIlast\fR?
+Selects all of the elements in the range between
+\fIfirst\fR and \fIlast\fR, inclusive, without affecting
+the selection state of elements outside that range.
+.RE
+.TP
+\fIpathName \fBsize\fR
+Returns a decimal string indicating the total number of elements
+in the listbox.
+.TP
+\fIpathName \fBxview \fIargs\fR
+This command is used to query and change the horizontal position of the
+information in the widget's window. It can take any of the following
+forms:
+.RS
+.TP
+\fIpathName \fBxview\fR
+Returns a list containing two elements.
+Each element is a real fraction between 0 and 1; together they describe
+the horizontal span that is visible in the window.
+For example, if the first element is .2 and the second element is .6,
+20% of the listbox's text is off-screen to the left, the middle 40% is visible
+in the window, and 40% of the text is off-screen to the right.
+These are the same values passed to scrollbars via the \fB\-xscrollcommand\fR
+option.
+.TP
+\fIpathName \fBxview\fR \fIindex\fR
+Adjusts the view in the window so that the character position given by
+\fIindex\fR is displayed at the left edge of the window.
+Character positions are defined by the width of the character \fB0\fR.
+.TP
+\fIpathName \fBxview moveto\fI fraction\fR
+Adjusts the view in the window so that \fIfraction\fR of the
+total width of the listbox text is off-screen to the left.
+\fIfraction\fR must be a fraction between 0 and 1.
+.TP
+\fIpathName \fBxview scroll \fInumber what\fR
+This command shifts the view in the window left or right according to
+\fInumber\fR and \fIwhat\fR.
+\fINumber\fR must be an integer.
+\fIWhat\fR must be either \fBunits\fR or \fBpages\fR or an abbreviation
+of one of these.
+If \fIwhat\fR is \fBunits\fR, the view adjusts left or right by
+\fInumber\fR character units (the width of the \fB0\fR character)
+on the display; if it is \fBpages\fR then the view adjusts by
+\fInumber\fR screenfuls.
+If \fInumber\fR is negative then characters farther to the left
+become visible; if it is positive then characters farther to the right
+become visible.
+.RE
+.TP
+\fIpathName \fByview \fI?args\fR?
+This command is used to query and change the vertical position of the
+text in the widget's window.
+It can take any of the following forms:
+.RS
+.TP
+\fIpathName \fByview\fR
+Returns a list containing two elements, both of which are real fractions
+between 0 and 1.
+The first element gives the position of the listbox element at the
+top of the window, relative to the listbox as a whole (0.5 means
+it is halfway through the listbox, for example).
+The second element gives the position of the listbox element just after
+the last one in the window, relative to the listbox as a whole.
+These are the same values passed to scrollbars via the \fB\-yscrollcommand\fR
+option.
+.TP
+\fIpathName \fByview\fR \fIindex\fR
+Adjusts the view in the window so that the element given by
+\fIindex\fR is displayed at the top of the window.
+.TP
+\fIpathName \fByview moveto\fI fraction\fR
+Adjusts the view in the window so that the element given by \fIfraction\fR
+appears at the top of the window.
+\fIFraction\fR is a fraction between 0 and 1; 0 indicates the first
+element in the listbox, 0.33 indicates the element one-third the
+way through the listbox, and so on.
+.TP
+\fIpathName \fByview scroll \fInumber what\fR
+This command adjusts the view in the window up or down according to
+\fInumber\fR and \fIwhat\fR.
+\fINumber\fR must be an integer.
+\fIWhat\fR must be either \fBunits\fR or \fBpages\fR.
+If \fIwhat\fR is \fBunits\fR, the view adjusts up or down by
+\fInumber\fR lines; if it is \fBpages\fR then
+the view adjusts by \fInumber\fR screenfuls.
+If \fInumber\fR is negative then earlier elements
+become visible; if it is positive then later elements
+become visible.
+.RE
+
+.SH "DEFAULT BINDINGS"
+.PP
+Tk automatically creates class bindings for listboxes that give them
+Motif-like behavior. Much of the behavior of a listbox is determined
+by its \fBselectMode\fR option, which selects one of four ways
+of dealing with the selection.
+.PP
+If the selection mode is \fBsingle\fR or \fBbrowse\fR, at most one
+element can be selected in the listbox at once.
+In both modes, clicking button 1 on an element selects
+it and deselects any other selected item.
+In \fBbrowse\fR mode it is also possible to drag the selection
+with button 1.
+.PP
+If the selection mode is \fBmultiple\fR or \fBextended\fR,
+any number of elements may be selected at once, including discontiguous
+ranges. In \fBmultiple\fR mode, clicking button 1 on an element
+toggles its selection state without affecting any other elements.
+In \fBextended\fR mode, pressing button 1 on an element selects
+it, deselects everything else, and sets the anchor to the element
+under the mouse; dragging the mouse with button 1
+down extends the selection to include all the elements between
+the anchor and the element under the mouse, inclusive.
+.PP
+Most people will probably want to use \fBbrowse\fR mode for
+single selections and \fBextended\fR mode for multiple selections;
+the other modes appear to be useful only in special situations.
+.PP
+In addition to the above behavior, the following additional behavior
+is defined by the default bindings:
+.IP [1]
+In \fBextended\fR mode, the selected range can be adjusted by pressing
+button 1 with the Shift key down: this modifies the selection to
+consist of the elements between the anchor and the element under
+the mouse, inclusive.
+The un-anchored end of this new selection can also be dragged with
+the button down.
+.IP [2]
+In \fBextended\fR mode, pressing button 1 with the Control key down
+starts a toggle operation: the anchor is set to the element under
+the mouse, and its selection state is reversed. The selection state
+of other elements isn't changed.
+If the mouse is dragged with button 1 down, then the selection state
+of all elements between the anchor and the element under the mouse
+is set to match that of the anchor element; the selection state of
+all other elements remains what it was before the toggle operation
+began.
+.IP [3]
+If the mouse leaves the listbox window with button 1 down, the window
+scrolls away from the mouse, making information visible that used
+to be off-screen on the side of the mouse.
+The scrolling continues until the mouse re-enters the window, the
+button is released, or the end of the listbox is reached.
+.IP [4]
+Mouse button 2 may be used for scanning.
+If it is pressed and dragged over the listbox, the contents of
+the listbox drag at high speed in the direction the mouse moves.
+.IP [5]
+If the Up or Down key is pressed, the location cursor (active
+element) moves up or down one element.
+If the selection mode is \fBbrowse\fR or \fBextended\fR then the
+new active element is also selected and all other elements are
+deselected.
+In \fBextended\fR mode the new active element becomes the
+selection anchor.
+.IP [6]
+In \fBextended\fR mode, Shift-Up and Shift-Down move the location
+cursor (active element) up or down one element and also extend
+the selection to that element in a fashion similar to dragging
+with mouse button 1.
+.IP [7]
+The Left and Right keys scroll the listbox view left and right
+by the width of the character \fB0\fR.
+Control-Left and Control-Right scroll the listbox view left and
+right by the width of the window.
+Control-Prior and Control-Next also scroll left and right by
+the width of the window.
+.IP [8]
+The Prior and Next keys scroll the listbox view up and down
+by one page (the height of the window).
+.IP [9]
+The Home and End keys scroll the listbox horizontally to
+the left and right edges, respectively.
+.IP [10]
+Control-Home sets the location cursor to the the first element in
+the listbox, selects that element, and deselects everything else
+in the listbox.
+.IP [11]
+Control-End sets the location cursor to the the last element in
+the listbox, selects that element, and deselects everything else
+in the listbox.
+.IP [12]
+In \fBextended\fR mode, Control-Shift-Home extends the selection
+to the first element in the listbox and Control-Shift-End extends
+the selection to the last element.
+.IP [13]
+In \fBmultiple\fR mode, Control-Shift-Home moves the location cursor
+to the first element in the listbox and Control-Shift-End moves
+the location cursor to the last element.
+.IP [14]
+The space and Select keys make a selection at the location cursor
+(active element) just as if mouse button 1 had been pressed over
+this element.
+.IP [15]
+In \fBextended\fR mode, Control-Shift-space and Shift-Select
+extend the selection to the active element just as if button 1
+had been pressed with the Shift key down.
+.IP [16]
+In \fBextended\fR mode, the Escape key cancels the most recent
+selection and restores all the elements in the selected range
+to their previous selection state.
+.IP [17]
+Control-slash selects everything in the widget, except in
+\fBsingle\fR and \fBbrowse\fR modes, in which case it selects
+the active element and deselects everything else.
+.IP [18]
+Control-backslash deselects everything in the widget, except in
+\fBbrowse\fR mode where it has no effect.
+.IP [19]
+The F16 key (labelled Copy on many Sun workstations) or Meta-w
+copies the selection in the widget to the clipboard, if there is
+a selection.
+
+.PP
+The behavior of listboxes can be changed by defining new bindings for
+individual widgets or by redefining the class bindings.
+
+.SH KEYWORDS
+listbox, widget
diff --git a/tk/doc/loadTk.n b/tk/doc/loadTk.n
new file mode 100644
index 00000000000..b34ce06868c
--- /dev/null
+++ b/tk/doc/loadTk.n
@@ -0,0 +1,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$
+'\"
+.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
diff --git a/tk/doc/lower.n b/tk/doc/lower.n
new file mode 100644
index 00000000000..8738c23e465
--- /dev/null
+++ b/tk/doc/lower.n
@@ -0,0 +1,38 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBlower \fIwindow \fR?\fIbelowThis\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+If the \fIbelowThis\fR argument is omitted then the command lowers
+\fIwindow\fR so that it is below all of its siblings in the stacking
+order (it will be obscured by any siblings that overlap it and
+will not obscure any siblings).
+If \fIbelowThis\fR is specified then it must be the path name of
+a window that is either a sibling of \fIwindow\fR or the descendant
+of a sibling of \fIwindow\fR.
+In this case the \fBlower\fR command will insert
+\fIwindow\fR into the stacking order just below \fIbelowThis\fR
+(or the ancestor of \fIbelowThis\fR that is a sibling of \fIwindow\fR);
+this could end up either raising or lowering \fIwindow\fR.
+
+.SH "SEE ALSO"
+raise
+
+.SH KEYWORDS
+lower, obscure, stacking order
diff --git a/tk/doc/man.macros b/tk/doc/man.macros
new file mode 100644
index 00000000000..6f3016f492f
--- /dev/null
+++ b/tk/doc/man.macros
@@ -0,0 +1,236 @@
+'\" The definitions below are for supplemental macros used in Tcl/Tk
+'\" manual entries.
+'\"
+'\" .AP type name in/out ?indent?
+'\" Start paragraph describing an argument to a library procedure.
+'\" type is type of argument (int, etc.), in/out is either "in", "out",
+'\" or "in/out" to describe whether procedure reads or modifies arg,
+'\" and indent is equivalent to second arg of .IP (shouldn't ever be
+'\" needed; use .AS below instead)
+'\"
+'\" .AS ?type? ?name?
+'\" Give maximum sizes of arguments for setting tab stops. Type and
+'\" name are examples of largest possible arguments that will be passed
+'\" to .AP later. If args are omitted, default tab stops are used.
+'\"
+'\" .BS
+'\" Start box enclosure. From here until next .BE, everything will be
+'\" enclosed in one large box.
+'\"
+'\" .BE
+'\" End of box enclosure.
+'\"
+'\" .CS
+'\" Begin code excerpt.
+'\"
+'\" .CE
+'\" End code excerpt.
+'\"
+'\" .VS ?version? ?br?
+'\" Begin vertical sidebar, for use in marking newly-changed parts
+'\" of man pages. The first argument is ignored and used for recording
+'\" the version when the .VS was added, so that the sidebars can be
+'\" found and removed when they reach a certain age. If another argument
+'\" is present, then a line break is forced before starting the sidebar.
+'\"
+'\" .VE
+'\" End of vertical sidebar.
+'\"
+'\" .DS
+'\" Begin an indented unfilled display.
+'\"
+'\" .DE
+'\" End of indented unfilled display.
+'\"
+'\" .SO
+'\" Start of list of standard options for a Tk widget. The
+'\" options follow on successive lines, in four columns separated
+'\" by tabs.
+'\"
+'\" .SE
+'\" End of list of standard options for a Tk widget.
+'\"
+'\" .OP cmdName dbName dbClass
+'\" Start of description of a specific option. cmdName gives the
+'\" option's name as specified in the class command, dbName gives
+'\" the option's name in the option database, and dbClass gives
+'\" the option's class in the option database.
+'\"
+'\" .UL arg1 arg2
+'\" Print arg1 underlined, then print arg2 normally.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+'\" # Set up traps and other miscellaneous stuff for Tcl/Tk man pages.
+.if t .wh -1.3i ^B
+.nr ^l \n(.l
+.ad b
+'\" # Start an argument description
+.de AP
+.ie !"\\$4"" .TP \\$4
+.el \{\
+. ie !"\\$2"" .TP \\n()Cu
+. el .TP 15
+.\}
+.ie !"\\$3"" \{\
+.ta \\n()Au \\n()Bu
+\&\\$1 \\fI\\$2\\fP (\\$3)
+.\".b
+.\}
+.el \{\
+.br
+.ie !"\\$2"" \{\
+\&\\$1 \\fI\\$2\\fP
+.\}
+.el \{\
+\&\\fI\\$1\\fP
+.\}
+.\}
+..
+'\" # define tabbing values for .AP
+.de AS
+.nr )A 10n
+.if !"\\$1"" .nr )A \\w'\\$1'u+3n
+.nr )B \\n()Au+15n
+.\"
+.if !"\\$2"" .nr )B \\w'\\$2'u+\\n()Au+3n
+.nr )C \\n()Bu+\\w'(in/out)'u+2n
+..
+.AS Tcl_Interp Tcl_CreateInterp in/out
+'\" # BS - start boxed text
+'\" # ^y = starting y location
+'\" # ^b = 1
+.de BS
+.br
+.mk ^y
+.nr ^b 1u
+.if n .nf
+.if n .ti 0
+.if n \l'\\n(.lu\(ul'
+.if n .fi
+..
+'\" # BE - end boxed text (draw box now)
+.de BE
+.nf
+.ti 0
+.mk ^t
+.ie n \l'\\n(^lu\(ul'
+.el \{\
+.\" Draw four-sided box normally, but don't draw top of
+.\" box if the box started on an earlier page.
+.ie !\\n(^b-1 \{\
+\h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.el \}\
+\h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\l'|0u-1.5n\(ul'
+.\}
+.\}
+.fi
+.br
+.nr ^b 0
+..
+'\" # VS - start vertical sidebar
+'\" # ^Y = starting y location
+'\" # ^v = 1 (for troff; for nroff this doesn't matter)
+.de VS
+.if !"\\$2"" .br
+.mk ^Y
+.ie n 'mc \s12\(br\s0
+.el .nr ^v 1u
+..
+'\" # VE - end of vertical sidebar
+.de VE
+.ie n 'mc
+.el \{\
+.ev 2
+.nf
+.ti 0
+.mk ^t
+\h'|\\n(^lu+3n'\L'|\\n(^Yu-1v\(bv'\v'\\n(^tu+1v-\\n(^Yu'\h'-|\\n(^lu+3n'
+.sp -1
+.fi
+.ev
+.\}
+.nr ^v 0
+..
+'\" # Special macro to handle page bottom: finish off current
+'\" # box/sidebar if in box/sidebar mode, then invoked standard
+'\" # page bottom macro.
+.de ^B
+.ev 2
+'ti 0
+'nf
+.mk ^t
+.if \\n(^b \{\
+.\" Draw three-sided box if this is the box's first page,
+.\" draw two sides but no top otherwise.
+.ie !\\n(^b-1 \h'-1.5n'\L'|\\n(^yu-1v'\l'\\n(^lu+3n\(ul'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.el \h'-1.5n'\L'|\\n(^yu-1v'\h'\\n(^lu+3n'\L'\\n(^tu+1v-\\n(^yu'\h'|0u'\c
+.\}
+.if \\n(^v \{\
+.nr ^x \\n(^tu+1v-\\n(^Yu
+\kx\h'-\\nxu'\h'|\\n(^lu+3n'\ky\L'-\\n(^xu'\v'\\n(^xu'\h'|0u'\c
+.\}
+.bp
+'fi
+.ev
+.if \\n(^b \{\
+.mk ^y
+.nr ^b 2
+.\}
+.if \\n(^v \{\
+.mk ^Y
+.\}
+..
+'\" # DS - begin display
+.de DS
+.RS
+.nf
+.sp
+..
+'\" # DE - end display
+.de DE
+.fi
+.RE
+.sp
+..
+'\" # SO - start of list of standard options
+.de SO
+.SH "STANDARD OPTIONS"
+.LP
+.nf
+.ta 4c 8c 12c
+.ft B
+..
+'\" # SE - end of list of standard options
+.de SE
+.fi
+.ft R
+.LP
+See the \\fBoptions\\fR manual entry for details on the standard options.
+..
+'\" # OP - start of full description for a single option
+.de OP
+.LP
+.nf
+.ta 4c
+Command-Line Name: \\fB\\$1\\fR
+Database Name: \\fB\\$2\\fR
+Database Class: \\fB\\$3\\fR
+.fi
+.IP
+..
+'\" # CS - begin code excerpt
+.de CS
+.RS
+.nf
+.ta .25i .5i .75i 1i
+..
+'\" # CE - end code excerpt
+.de CE
+.fi
+.RE
+..
+.de UL
+\\$1\l'|0\(ul'\\$2
+..
diff --git a/tk/doc/menu.n b/tk/doc/menu.n
new file mode 100644
index 00000000000..d593ea2eef0
--- /dev/null
+++ b/tk/doc/menu.n
@@ -0,0 +1,757 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBmenu\fR \fIpathName \fR?\fIoptions\fR?
+.SO
+\-activebackground \-background \-disabledforeground \-relief
+\-activeborderwidth \-borderwidth \-font \-takefocus
+\-activeforeground \-cursor \-foreground
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.VS
+.OP \-postcommand postCommand Command
+If this option is specified then it provides a Tcl command to execute
+each time the menu is posted. The command is invoked by the \fBpost\fR
+widget command before posting the menu. Note that in 8.0 on Macintosh
+and Windows, all commands in a menu systems are executed before any
+are posted. This is due to the limitations in the individual platforms'
+menu managers.
+.VE
+.OP \-selectcolor selectColor Background
+For menu entries that are check buttons or radio buttons, this option
+specifies the color to display in the indicator when the check button
+or radio button is selected.
+.OP \-tearoff tearOff TearOff
+This option must have a proper boolean value, which specifies
+whether or not the menu should include a tear-off entry at the
+top. If so, it will exist as entry 0 of the menu and the other
+entries will number starting at 1. The default
+menu bindings arrange for the menu to be torn off when the tear-off
+entry is invoked.
+.OP \-tearoffcommand tearOffCommand TearOffCommand
+If this option has a non-empty value, then it specifies a Tcl command
+to invoke whenever the menu is torn off. The actual command will
+consist of the value of this option, followed by a space, followed
+by the name of the menu window, followed by a space, followed by
+the name of the name of the torn off menu window. For example, if
+the option's is ``\fBa b\fR'' and menu \fB.x.y\fR is torn off to
+create a new menu \fB.x.tearoff1\fR, then the command
+``\fBa b .x.y .x.tearoff1\fR'' will be invoked.
+.VS
+.OP \-title title Title
+The string will be used to title the window created when this menu is
+torn off. If the title is NULL, then the window will have the title
+of the menubutton or the text of the cascade item from which this menu
+was invoked.
+.OP \-type type Type
+This option can be one of \fBmenubar\fR, \fBtearoff\fR, or
+\fBnormal\fR, and is set when the menu is created. While the string
+returned by the configuration database will change if this option is
+changed, this does not affect the menu widget's behavior. This is used
+by the cloning mechanism and is not normally set outside of the Tk
+library.
+.VE
+.BE
+
+.SH INTRODUCTION
+.PP
+The \fBmenu\fR command creates a new top-level window (given
+by the \fIpathName\fR argument) and makes it into a menu widget.
+Additional
+options, described above, may be specified on the command line
+or in the option database
+to configure aspects of the menu such as its colors and font.
+The \fBmenu\fR command returns its
+\fIpathName\fR argument. At the time this command is invoked,
+there must not exist a window named \fIpathName\fR, but
+\fIpathName\fR's parent must exist.
+.PP
+.VS
+A menu is a widget that displays a collection of one-line entries arranged
+in one or more columns. There exist several different types of entries,
+each with different properties. Entries of different types may be
+combined in a single menu. Menu entries are not the same as
+entry widgets. In fact, menu entries are not even distinct widgets;
+the entire menu is one widget.
+.VE
+.PP
+Menu entries are displayed with up to three separate fields.
+The main field is a label in the form of a text string,
+a bitmap, or an image, controlled by the \fB\-label\fR,
+\fB\-bitmap\fR, and \fB\-image\fR options for the entry.
+If the \fB\-accelerator\fR option is specified for an entry then a second
+textual field is displayed to the right of the label. The accelerator
+typically describes a keystroke sequence that may be typed in the
+application to cause the same result as invoking the menu entry.
+The third field is an \fIindicator\fR. The indicator is present only for
+checkbutton or radiobutton entries. It indicates whether the entry
+is selected or not, and is displayed to the left of the entry's
+string.
+.PP
+In normal use, an entry becomes active (displays itself differently)
+whenever the mouse pointer is over the entry. If a mouse
+button is released over the entry then the entry is \fIinvoked\fR.
+The effect of invocation is different for each type of entry;
+these effects are described below in the sections on individual
+entries.
+.PP
+Entries may be \fIdisabled\fR, which causes their labels
+and accelerators to be displayed
+with dimmer colors.
+The default menu bindings will not allow
+a disabled entry to be activated or invoked.
+Disabled entries may be re-enabled, at which point it becomes
+possible to activate and invoke them again.
+.VS
+.PP
+Whenever a menu's active entry is changed, a <<MenuSelect>> virtual
+event is send to the menu. The active item can then be queried from
+the menu, and an action can be taken, such as setting
+context-sensitive help text for the entry.
+.VE
+
+.SH "COMMAND ENTRIES"
+.PP
+The most common kind of menu entry is a command entry, which
+behaves much like a button widget. When a command entry is
+invoked, a Tcl command is executed. The Tcl
+command is specified with the \fB\-command\fR option.
+
+.SH "SEPARATOR ENTRIES"
+.PP
+A separator is an entry that is displayed as a horizontal dividing
+line. A separator may not be activated or invoked, and it has
+no behavior other than its display appearance.
+
+.SH "CHECKBUTTON ENTRIES"
+.PP
+A checkbutton menu entry behaves much like a checkbutton widget.
+When it is invoked it toggles back and forth between the selected
+and deselected states. When the entry is selected, a particular
+value is stored in a particular global variable (as determined by
+the \fB\-onvalue\fR and \fB\-variable\fR options for the entry); when
+the entry is deselected another value (determined by the
+\fB\-offvalue\fR option) is stored in the global variable.
+An indicator box is displayed to the left of the label in a checkbutton
+entry. If the entry is selected then the indicator's center is displayed
+in the color given by the \fB-selectcolor\fR option for the entry;
+otherwise the indicator's center is displayed in the background color for
+the menu. If a \fB\-command\fR option is specified for a checkbutton
+entry, then its value is evaluated as a Tcl command each time the entry
+is invoked; this happens after toggling the entry's
+selected state.
+
+.SH "RADIOBUTTON ENTRIES"
+.PP
+A radiobutton menu entry behaves much like a radiobutton widget.
+Radiobutton entries are organized in groups of which only one
+entry may be selected at a time. Whenever a particular entry
+becomes selected it stores a particular value into a particular
+global variable (as determined by the \fB\-value\fR and
+\fB\-variable\fR options for the entry). This action
+causes any previously-selected entry in the same group
+to deselect itself.
+Once an entry has become selected, any change to the entry's
+associated variable will cause the entry to deselect itself.
+Grouping of radiobutton entries is determined by their
+associated variables: if two entries have the same associated
+variable then they are in the same group.
+An indicator diamond is displayed to the left of the label in each
+radiobutton entry. If the entry is selected then the indicator's
+center is displayed in the color given by the \fB\-selectcolor\fR option
+for the entry;
+otherwise the indicator's center is displayed in the background color for
+the menu. If a \fB\-command\fR option is specified for a radiobutton
+entry, then its value is evaluated as a Tcl command each time the entry
+is invoked; this happens after selecting the entry.
+
+.SH "CASCADE ENTRIES"
+.PP
+A cascade entry is one with an associated menu (determined
+by the \fB\-menu\fR option). Cascade entries allow the construction
+of cascading menus.
+The \fBpostcascade\fR widget command can be used to post and unpost
+the associated menu just next to of the cascade entry.
+The associated menu must be a child of the menu containing
+the cascade entry (this is needed in order for menu traversal to
+work correctly).
+.PP
+A cascade entry posts its associated menu by invoking a
+Tcl command of the form
+.CS
+\fImenu\fB post \fIx y\fR
+.CE
+where \fImenu\fR is the path name of the associated menu, and \fIx\fR
+and \fIy\fR are the root-window coordinates of the upper-right
+corner of the cascade entry.
+.VS
+On Unix, the lower-level menu is unposted by executing a Tcl command with
+the form
+.CS
+\fImenu\fB unpost\fR
+.CE
+where \fImenu\fR is the name of the associated menu.
+On other platforms, the platform's native code takes care of unposting the
+menu.
+.VE
+.PP
+.VS
+If a \fB\-command\fR option is specified for a cascade entry then it is
+evaluated as a Tcl command whenever the entry is invoked. This is not
+supported on Windows.
+.VE
+
+.SH "TEAR-OFF ENTRIES"
+.PP
+A tear-off entry appears at the top of the menu if enabled with the
+\fBtearOff\fR option. It is not like other menu entries in that
+it cannot be created with the \fBadd\fR widget command and
+cannot be deleted with the \fBdelete\fR widget command.
+When a tear-off entry is created it appears as a dashed line at
+the top of the menu. Under the default bindings, invoking the
+tear-off entry causes a torn-off copy to be made of the menu and
+all of its submenus.
+
+.VS
+.SH "MENUBARS"
+.PP
+Any menu can be set as a menubar for a toplevel window (see
+\fBtoplevel\fR command for syntax). On the Macintosh, whenever the
+toplevel is in front, this menu's cascade items will appear in the
+menubar across the top of the main monitor. On Windows and Unix, this
+menu's items will be displayed in a menubar accross the top of the
+window. These menus will behave according to the interface guidelines
+of their platforms. For every menu set as a menubar, a clone menu is
+made. See the \fBCLONES\fR section for more information.
+.VE
+
+.VS
+.SH "SPECIAL MENUS IN MENUBARS"
+.PP
+Certain menus in a menubar will be treated specially. On the Macintosh,
+access to the special Apple and Help menus is provided. On Windows,
+access to the Windows System menu in each window is provided. On X Windows,
+a special right-justified help menu is provided. In all cases, these
+menus must be created with the command name of the menubar menu concatenated
+with the special name. So for a menubar named .menubar, on the Macintosh,
+the special menus would be .menubar.apple and .menubar.help; on Windows,
+the special menu would be .menubar.system; on X Windows, the help
+menu would be .menubar.help.
+.PP
+When Tk sees an Apple menu on the Macintosh, that menu's contents make
+up the first items of the Apple menu on the screen whenever the window
+containing the menubar is in front. The menu is the
+first one that the user sees and has a title which is an Apple logo.
+After all of the Tk-defined items, the menu will have a separator,
+followed by all of the items in the user's Apple Menu Items folder.
+Since the System uses a different menu definition procedure for
+the Apple menu than Tk uses for its menus, and the system APIs do
+not fully support everything Tk tries to do, the menu item will only
+have its text displayed. No font attributes, images, bitmaps, or colors
+will be displayed. In addition, a menu with a tearoff item will have
+the tearoff item displayed as "(TearOff)".
+.PP
+When Tk see a Help menu on the Macintosh, the menu's contents are
+appended to the standard help menu on the right of the user's menubar
+whenever the user's menubar is in front. The first items in the menu
+are provided by Apple. Similar to the Apple Menu, cusomization in this
+menu is limited to what the system provides.
+.PP
+When Tk sees a System menu on Windows, its items are appended to the
+system menu that the menubar is attached to. This menu has an icon
+representing a spacebar, and can be invoked with the mouse or by typing
+Alt+Spacebar. Due to limitations in the Windows API, any font changes,
+colors, images, bitmaps, or tearoff images will not appear in the
+system menu.
+.PP
+When Tk see a Help menu on X Windows, the menu is moved to be last in
+the menubar and is right justified.
+.VE
+
+.VS
+.SH "CLONES"
+.PP
+When a menu is set as a menubar for a toplevel window, or when a menu
+is torn off, a clone of the menu is made. This clone is a menu widget
+in its own right, but it is a child of the original. Changes in the
+configuration of the original are reflected in the
+clone. Additionally, any cascades that are pointed to are also cloned
+so that menu traversal will work right. Clones are destroyed when
+either the tearoff or menubar goes away, or when the original menu is
+destroyed.
+.VE
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBmenu\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.CS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.CE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command.
+.PP
+Many of the widget commands for a menu take as one argument an
+indicator of which entry of the menu to operate on. These
+indicators are called \fIindex\fRes and may be specified in
+any of the following forms:
+.TP 12
+\fInumber\fR
+Specifies the entry numerically, where 0 corresponds
+to the top-most entry of the menu, 1 to the entry below it, and
+so on.
+.TP 12
+\fBactive\fR
+Indicates the entry that is currently active. If no entry is
+active then this form is equivalent to \fBnone\fR. This form may
+not be abbreviated.
+.TP 12
+\fBend\fR
+Indicates the bottommost entry in the menu. If there are no
+entries in the menu then this form is equivalent to \fBnone\fR.
+This form may not be abbreviated.
+.TP 12
+\fBlast\fR
+Same as \fBend\fR.
+.TP 12
+\fBnone\fR
+Indicates ``no entry at all''; this is used most commonly with
+the \fBactivate\fR option to deactivate all the entries in the
+menu. In most cases the specification of \fBnone\fR causes
+nothing to happen in the widget command.
+This form may not be abbreviated.
+.TP 12
+\fB@\fInumber\fR
+In this form, \fInumber\fR is treated as a y-coordinate in the
+menu's window; the entry closest to that y-coordinate is used.
+For example, ``\fB@0\fR'' indicates the top-most entry in the
+window.
+.TP 12
+\fIpattern\fR
+If the index doesn't satisfy one of the above forms then this
+form is used. \fIPattern\fR is pattern-matched against the label of
+each entry in the menu, in order from the top down, until a
+matching entry is found. The rules of \fBTcl_StringMatch\fR
+are used.
+.PP
+The following widget commands are possible for menu widgets:
+.TP
+\fIpathName \fBactivate \fIindex\fR
+Change the state of the entry indicated by \fIindex\fR to \fBactive\fR
+and redisplay it using its active colors.
+Any previously-active entry is deactivated. If \fIindex\fR
+is specified as \fBnone\fR, or if the specified entry is
+disabled, then the menu ends up with no active entry.
+Returns an empty string.
+.TP
+\fIpathName \fBadd \fItype \fR?\fIoption value option value ...\fR?
+Add a new entry to the bottom of the menu. The new entry's type
+is given by \fItype\fR and must be one of \fBcascade\fR,
+\fBcheckbutton\fR, \fBcommand\fR, \fBradiobutton\fR, or \fBseparator\fR,
+or a unique abbreviation of one of the above. If additional arguments
+are present, they specify any of the following options:
+.RS
+.TP
+\fB\-activebackground \fIvalue\fR
+Specifies a background color to use for displaying this entry when it
+is active.
+If this option is specified as an empty string (the default), then the
+\fBactiveBackground\fR option for the overall menu is used.
+If the \fBtk_strictMotif\fR variable has been set to request strict
+Motif compliance, then this option is ignored and the \fB\-background\fR
+option is used in its place.
+This option is not available for separator or tear-off entries.
+.TP
+\fB\-activeforeground \fIvalue\fR
+Specifies a foreground color to use for displaying this entry when it
+is active.
+If this option is specified as an empty string (the default), then the
+\fBactiveForeground\fR option for the overall menu is used.
+This option is not available for separator or tear-off entries.
+.TP
+\fB\-accelerator \fIvalue\fR
+Specifies a string to display at the right side of the menu entry.
+Normally describes an accelerator keystroke sequence that may be
+typed to invoke the same function as the menu entry. This option
+is not available for separator or tear-off entries.
+.TP
+\fB\-background \fIvalue\fR
+Specifies a background color to use for displaying this entry when it
+is in the normal state (neither active nor disabled).
+If this option is specified as an empty string (the default), then the
+\fBbackground\fR option for the overall menu is used.
+This option is not available for separator or tear-off entries.
+.TP
+\fB\-bitmap \fIvalue\fR
+Specifies a bitmap to display in the menu instead of a textual
+label, in any of the forms accepted by \fBTk_GetBitmap\fR.
+This option overrides the \fB\-label\fR option but may be reset
+to an empty string to enable a textual label to be displayed.
+If a \fB\-image\fR option has been specified, it overrides
+\fB\-bitmap\fR.
+This option is not available for separator or tear-off entries.
+.VS
+.TP
+\fB\-columnbreak \fIvalue\fR
+When this option is zero, the appears below the previous entry. When
+this option is one, the menu appears at the top of a new column in the
+menu.
+.VE
+.TP
+\fB\-command \fIvalue\fR
+Specifies a Tcl command to execute when the menu entry is invoked.
+Not available for separator or tear-off entries.
+.TP
+\fB\-font \fIvalue\fR
+Specifies the font to use when drawing the label or accelerator
+string in this entry.
+If this option is specified as an empty string (the default) then
+the \fBfont\fR option for the overall menu is used.
+This option is not available for separator or tear-off entries.
+.TP
+\fB\-foreground \fIvalue\fR
+Specifies a foreground color to use for displaying this entry when it
+is in the normal state (neither active nor disabled).
+If this option is specified as an empty string (the default), then the
+\fBforeground\fR option for the overall menu is used.
+This option is not available for separator or tear-off entries.
+.VS
+.TP
+\fB\-hidemargin \fIvalue\fR
+Specifies whether the standard margins should be drawn for this menu
+entry. This is useful when creating palette with images in them, i.e.,
+color palettes, pattern palettes, etc. 1 indicates that the margin for
+the entry is hidden; 0 means that the margin is used.
+.VE
+.TP
+\fB\-image \fIvalue\fR
+Specifies an image to display in the menu instead of a text string
+or bitmap
+The image must have been created by some previous invocation of
+\fBimage create\fR.
+This option overrides the \fB\-label\fR and \fB\-bitmap\fR options
+but may be reset to an empty string to enable a textual or
+bitmap label to be displayed.
+This option is not available for separator or tear-off entries.
+.TP
+\fB\-indicatoron \fIvalue\fR
+Available only for checkbutton and radiobutton entries.
+\fIValue\fR is a boolean that determines whether or not the
+indicator should be displayed.
+.TP
+\fB\-label \fIvalue\fR
+Specifies a string to display as an identifying label in the menu
+entry. Not available for separator or tear-off entries.
+.TP
+\fB\-menu \fIvalue\fR
+Available only for cascade entries. Specifies the path name of
+the submenu associated with this entry.
+The submenu must be a child of the menu.
+.TP
+\fB\-offvalue \fIvalue\fR
+Available only for checkbutton entries. Specifies the value to
+store in the entry's associated variable when the entry is
+deselected.
+.TP
+\fB\-onvalue \fIvalue\fR
+Available only for checkbutton entries. Specifies the value to
+store in the entry's associated variable when the entry is selected.
+.TP
+\fB\-selectcolor \fIvalue\fR
+Available only for checkbutton and radiobutton entries.
+Specifies the color to display in the indicator when the entry is
+selected.
+If the value is an empty string (the default) then the \fBselectColor\fR
+option for the menu determines the indicator color.
+.TP
+\fB\-selectimage \fIvalue\fR
+Available only for checkbutton and radiobutton entries.
+Specifies an image to display in the entry (in place of
+the \fB\-image\fR option) when it is selected.
+\fIValue\fR is the name of an image, which must have been created
+by some previous invocation of \fBimage create\fR.
+This option is ignored unless the \fB\-image\fR option has
+been specified.
+.TP
+\fB\-state \fIvalue\fR
+Specifies one of three states for the entry: \fBnormal\fR, \fBactive\fR,
+or \fBdisabled\fR. In normal state the entry is displayed using the
+\fBforeground\fR option for the menu and the \fBbackground\fR
+option from the entry or the menu.
+The active state is typically used when the pointer is over the entry.
+In active state the entry is displayed using the \fBactiveForeground\fR
+option for the menu along with the \fBactivebackground\fR option from
+the entry. Disabled state means that the entry
+should be insensitive: the default bindings will refuse to activate
+or invoke the entry.
+In this state the entry is displayed according to the
+\fBdisabledForeground\fR option for the menu and the
+\fBbackground\fR option from the entry.
+This option is not available for separator entries.
+.TP
+\fB\-underline \fIvalue\fR
+Specifies the integer index of a character to underline in the entry.
+This option is also queried by the default bindings and used to
+implement keyboard traversal.
+0 corresponds to the first character of the text displayed in the entry,
+1 to the next character, and so on.
+If a bitmap or image is displayed in the entry then this option is ignored.
+This option is not available for separator or tear-off entries.
+.TP
+\fB\-value \fIvalue\fR
+Available only for radiobutton entries. Specifies the value to
+store in the entry's associated variable when the entry is selected.
+If an empty string is specified, then the \fB\-label\fR option
+for the entry as the value to store in the variable.
+.TP
+\fB\-variable \fIvalue\fR
+Available only for checkbutton and radiobutton entries. Specifies
+the name of a global value to set when the entry is selected.
+For checkbutton entries the variable is also set when the entry
+is deselected. For radiobutton entries, changing the variable
+causes the currently-selected entry to deselect itself.
+.LP
+The \fBadd\fR widget command returns an empty string.
+.RE
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBmenu\fR
+command.
+.VS
+.TP
+\fIpathName\fR \fBclone\fR \fInewPathname ?cloneType?\fR
+Makes a clone of the current menu named \fInewPathName\fR. This clone
+is a menu in its own right, but any changes to the clone are
+propogated to the original menu and vice versa. \fIcloneType\fR can be
+\fBnormal\fR, \fBmenubar\fR, or \fBtearoff\fR. Should not normally be
+called outside of the Tk library. See the \fBCLONES\fR section for
+more information.
+.VE
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBmenu\fR
+command.
+.TP
+\fIpathName \fBdelete \fIindex1\fR ?\fIindex2\fR?
+Delete all of the menu entries between \fIindex1\fR and
+\fIindex2\fR inclusive.
+If \fIindex2\fR is omitted then it defaults to \fIindex1\fR.
+Attempts to delete a tear-off menu entry are ignored (instead, you
+should change the \fBtearOff\fR option to remove the tear-off entry).
+.TP
+\fIpathName \fBentrycget\fR \fIindex option\fR
+Returns the current value of a configuration option for
+the entry given by \fIindex\fR.
+\fIOption\fR may have any of the values accepted by the \fBadd\fR
+widget command.
+.TP
+\fIpathName \fBentryconfigure \fIindex \fR?\fIoptions\fR?
+This command is similar to the \fBconfigure\fR command, except that
+it applies to the options for an individual entry, whereas \fBconfigure\fR
+applies to the options for the menu as a whole.
+\fIOptions\fR may have any of the values accepted by the \fBadd\fR
+widget command. If \fIoptions\fR are specified, options are modified
+as indicated
+in the command and the command returns an empty string.
+If no \fIoptions\fR are specified, returns a list describing
+the current options for entry \fIindex\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list).
+.TP
+\fIpathName \fBindex \fIindex\fR
+Returns the numerical index corresponding to \fIindex\fR, or
+\fBnone\fR if \fIindex\fR was specified as \fBnone\fR.
+.TP
+\fIpathName \fBinsert \fIindex\fR \fItype \fR?\fIoption value option value ...\fR?
+Same as the \fBadd\fR widget command except that it inserts the new
+entry just before the entry given by \fIindex\fR, instead of appending
+to the end of the menu. The \fItype\fR, \fIoption\fR, and \fIvalue\fR
+arguments have the same interpretation as for the \fBadd\fR widget
+command. It is not possible to insert new menu entries before the
+tear-off entry, if the menu has one.
+.TP
+\fIpathName \fBinvoke \fIindex\fR
+Invoke the action of the menu entry. See the sections on the
+individual entries above for details on what happens. If the
+menu entry is disabled then nothing happens. If the
+entry has a command associated with it then the result of that
+command is returned as the result of the \fBinvoke\fR widget
+command. Otherwise the result is an empty string. Note: invoking
+a menu entry does not automatically unpost the menu; the default
+bindings normally take care of this before invoking the \fBinvoke\fR
+widget command.
+.TP
+\fIpathName \fBpost \fIx y\fR
+Arrange for the menu to be displayed on the screen at the root-window
+coordinates given by \fIx\fR and \fIy\fR. These coordinates are
+adjusted if necessary to guarantee that the entire menu is visible on
+the screen. This command normally returns an empty string.
+If the \fBpostCommand\fR option has been specified, then its value is
+executed as a Tcl script before posting the menu and the result of
+that script is returned as the result of the \fBpost\fR widget
+command.
+If an error returns while executing the command, then the error is
+returned without posting the menu.
+.TP
+\fIpathName \fBpostcascade \fIindex\fR
+Posts the submenu associated with the cascade entry given by
+\fIindex\fR, and unposts any previously posted submenu.
+If \fIindex\fR doesn't correspond to a cascade entry,
+or if \fIpathName\fR isn't posted,
+the command has no effect except to unpost any currently posted
+submenu.
+.TP
+\fIpathName \fBtype \fIindex\fR
+Returns the type of the menu entry given by \fIindex\fR.
+This is the \fItype\fR argument passed to the \fBadd\fR widget
+command when the entry was created, such as \fBcommand\fR
+or \fBseparator\fR, or \fBtearoff\fR for a tear-off entry.
+.TP
+.VS
+\fIpathName \fBunpost\fR
+Unmap the window so that it is no longer displayed. If a
+lower-level cascaded menu is posted, unpost that menu. Returns an
+empty string. This subcommand does not work on Windows and the
+Macintosh, as those platforms have their own way of unposting menus.
+.VE
+.TP
+\fIpathName \fByposition \fIindex\fR
+Returns a decimal string giving the y-coordinate within the menu
+window of the topmost pixel in the entry specified by \fIindex\fR.
+
+.SH "MENU CONFIGURATIONS"
+.PP
+The default bindings support four different ways of using menus:
+.VS
+.TP
+\fBPulldown Menus in Menubar\fR
+This is the most command case. You create a menu widget that will become the
+menu bar. You then add cascade entries to this menu, specifying the
+pull down menus you wish to use in your menu bar. You then create all
+of the pulldowns. Once you have done this, specify the menu using the
+\fB-menu\fR option of the toplevel's widget command. See the
+\fBtoplevel\fR manual entry for details.
+.VE
+.TP
+\fBPulldown Menus in Menu Buttons\fR
+This is the compatable way to do menu bars. You create one menubutton
+widget for each top-level menu, and typically you arrange a series of
+menubuttons in a row in a menubar window. You also create the top-level menus
+and any cascaded submenus, and tie them together with \fB\-menu\fR
+options in menubuttons and cascade menu entries. The top-level menu must
+be a child of the menubutton, and each submenu must be a child of the
+menu that refers to it. Once you have done this, the default bindings
+will allow users to traverse and invoke the tree of menus via its
+menubutton; see the \fBmenubutton\fR manual entry for details.
+.TP
+\fBPopup Menus\fR
+Popup menus typically post in response to a mouse button press or
+keystroke. You create the popup menus and any cascaded submenus,
+then you call the \fBtk_popup\fR procedure at the appropriate time
+to post the top-level menu.
+.TP
+\fBOption Menus\fR
+An option menu consists of a menubutton with an associated menu
+that allows you to select one of several values. The current value
+is displayed in the menubutton and is also stored in a global
+variable. Use the \fBtk_optionMenu\fR procedure to create option
+menubuttons and their menus.
+.TP
+\fBTorn-off Menus\fR
+You create a torn-off menu by invoking the tear-off entry at
+the top of an existing menu. The default bindings will create a new menu
+that is a copy of the original menu and leave it permanently
+posted as a top-level window. The torn-off menu behaves just
+the same as the original menu.
+
+.SH "DEFAULT BINDINGS"
+.PP
+Tk automatically creates class bindings for menus that give them
+the following default behavior:
+.IP [1]
+When the mouse enters a menu, the entry underneath the mouse
+cursor activates; as the mouse moves around the menu, the active
+entry changes to track the mouse.
+.IP [2]
+When the mouse leaves a menu all of the entries in the menu
+deactivate, except in the special case where the mouse moves from
+a menu to a cascaded submenu.
+.IP [3]
+When a button is released over a menu, the active entry (if any) is invoked.
+The menu also unposts unless it is a torn-off menu.
+.IP [4]
+The Space and Return keys invoke the active entry and
+unpost the menu.
+.IP [5]
+If any of the entries in a menu have letters underlined with
+with \fB\-underline\fR option, then pressing one of the underlined
+letters (or its upper-case or lower-case equivalent) invokes that
+entry and unposts the menu.
+.IP [6]
+The Escape key aborts a menu selection in progress without invoking any
+entry. It also unposts the menu unless it is a torn-off menu.
+.IP [7]
+The Up and Down keys activate the next higher or lower entry
+in the menu. When one end of the menu is reached, the active
+entry wraps around to the other end.
+.IP [8]
+The Left key moves to the next menu to the left.
+If the current menu is a cascaded submenu, then the submenu is
+unposted and the current menu entry becomes the cascade entry
+in the parent.
+If the current menu is a top-level menu posted from a
+menubutton, then the current menubutton is unposted and the
+next menubutton to the left is posted.
+Otherwise the key has no effect.
+The left-right order of menubuttons is determined by their stacking
+order: Tk assumes that the lowest menubutton (which by default
+is the first one created) is on the left.
+.IP [9]
+The Right key moves to the next menu to the right.
+If the current entry is a cascade entry, then the submenu is
+posted and the current menu entry becomes the first entry
+in the submenu.
+Otherwise, if the current menu was posted from a
+menubutton, then the current menubutton is unposted and the
+next menubutton to the right is posted.
+.PP
+Disabled menu entries are non-responsive: they don't activate and
+they ignore mouse button presses and releases.
+.PP
+The behavior of menus can be changed by defining new bindings for
+individual widgets or by redefining the class bindings.
+
+.SH BUGS
+.PP
+At present it isn't possible to use the
+option database to specify values for the options to individual
+entries.
+
+.SH KEYWORDS
+menu, widget
diff --git a/tk/doc/menubar.n b/tk/doc/menubar.n
new file mode 100644
index 00000000000..59fc252860e
--- /dev/null
+++ b/tk/doc/menubar.n
@@ -0,0 +1,33 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBtk_menuBar \fIframe \fR?\fImenu menu ...\fR?
+.sp
+\fBtk_bindForTraversal \fIarg arg ... \fR
+.BE
+
+.SH DESCRIPTION
+.PP
+These procedures were used in Tk 3.6 and earlier releases to help
+manage pulldown menus and to implement keyboard traversal of menus.
+In Tk 4.0 and later releases they are no
+longer needed. Stubs for these procedures have been retained for
+backward compatibility, but they have no effect. You should remove
+calls to these procedures from your code, since eventually the
+procedures will go away.
+
+.SH KEYWORDS
+keyboard traversal, menu, menu bar, post
diff --git a/tk/doc/menubutton.n b/tk/doc/menubutton.n
new file mode 100644
index 00000000000..da1a3291174
--- /dev/null
+++ b/tk/doc/menubutton.n
@@ -0,0 +1,193 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBmenubutton\fR \fIpathName \fR?\fIoptions\fR?
+.SO
+\-activebackground \-cursor \-highlightthickness \-takefocus
+\-activeforeground \-disabledforeground \-image \-text
+\-anchor \-font \-justify \-textvariable
+\-background \-foreground \-padx \-underline
+\-bitmap \-highlightbackground \-pady \-wraplength
+\-borderwidth \-highlightcolor \-relief
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.VS
+.OP \-direction direction Height
+Specifies where the menu is going to be popup up. \fBabove\fR tries to
+pop the menu above the menubutton. \fBbelow\fR tries to pop the menu
+below the menubutton. \fBleft\fR tries to pop the menu to the left of
+the menubutton. \fBright\fR tries to pop the menu to the right of the
+menu button. \fBflush\fR pops the menu directly over the menubutton.
+.VE
+.OP \-height height Height
+Specifies a desired height for the menubutton.
+If an image or bitmap is being displayed in the menubutton then the value is in
+screen units (i.e. any of the forms acceptable to \fBTk_GetPixels\fR);
+for text it is in lines of text.
+If this option isn't specified, the menubutton's desired height is computed
+from the size of the image or bitmap or text being displayed in it.
+.OP \-indicatoron indicatorOn IndicatorOn
+The value must be a proper boolean value. If it is true then
+a small indicator rectangle will be displayed on the right side
+of the menubutton and the default menu bindings will treat this
+as an option menubutton. If false then no indicator will be
+displayed.
+.OP \-menu menu MenuName
+Specifies the path name of the menu associated with this menubutton.
+The menu must be a child of the menubutton.
+.OP \-state state State
+Specifies one of three states for the menubutton: \fBnormal\fR, \fBactive\fR,
+or \fBdisabled\fR. In normal state the menubutton is displayed using the
+\fBforeground\fR and \fBbackground\fR options. The active state is
+typically used when the pointer is over the menubutton. In active state
+the menubutton is displayed using the \fBactiveForeground\fR and
+\fBactiveBackground\fR options. Disabled state means that the menubutton
+should be insensitive: the default bindings will refuse to activate
+the widget and will ignore mouse button presses.
+In this state the \fBdisabledForeground\fR and
+\fBbackground\fR options determine how the button is displayed.
+.OP \-width width Width
+Specifies a desired width for the menubutton.
+If an image or bitmap is being displayed in the menubutton then the value is in
+screen units (i.e. any of the forms acceptable to \fBTk_GetPixels\fR);
+for text it is in characters.
+If this option isn't specified, the menubutton's desired width is computed
+from the size of the image or bitmap or text being displayed in it.
+.BE
+
+.SH INTRODUCTION
+.PP
+The \fBmenubutton\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a menubutton widget.
+Additional
+options, described above, may be specified on the command line
+or in the option database
+to configure aspects of the menubutton such as its colors, font,
+text, and initial relief. The \fBmenubutton\fR command returns its
+\fIpathName\fR argument. At the time this command is invoked,
+there must not exist a window named \fIpathName\fR, but
+\fIpathName\fR's parent must exist.
+.PP
+A menubutton is a widget that displays a textual string, bitmap, or image
+and is associated with a menu widget.
+If text is displayed, it must all be in a single font, but it
+can occupy multiple lines on the screen (if it contains newlines
+or if wrapping occurs because of the \fBwrapLength\fR option) and
+one of the characters may optionally be underlined using the
+\fBunderline\fR option. In normal usage, pressing
+mouse button 1 over the menubutton causes the associated menu to
+be posted just underneath the menubutton. If the mouse is moved over
+the menu before releasing the mouse button, the button release
+causes the underlying menu entry to be invoked. When the button
+is released, the menu is unposted.
+.PP
+Menubuttons are typically organized into groups called menu bars
+that allow scanning:
+if the mouse button is pressed over one menubutton (causing it
+to post its menu) and the mouse is moved over another menubutton
+in the same menu bar without releasing the mouse button, then the
+menu of the first menubutton is unposted and the menu of the
+new menubutton is posted instead.
+.PP
+There are several interactions between menubuttons and menus; see
+the \fBmenu\fR manual entry for information on various menu configurations,
+such as pulldown menus and option menus.
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBmenubutton\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.CS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.CE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for menubutton widgets:
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBmenubutton\fR
+command.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBmenubutton\fR
+command.
+
+.SH "DEFAULT BINDINGS"
+.PP
+Tk automatically creates class bindings for menubuttons that give them
+the following default behavior:
+.IP [1]
+A menubutton activates whenever the mouse passes over it and deactivates
+whenever the mouse leaves it.
+.IP [2]
+Pressing mouse button 1 over a menubutton posts the menubutton:
+its relief changes to raised and its associated menu is posted
+under the menubutton. If the mouse is dragged down into the menu
+with the button still down, and if the mouse button is then
+released over an entry in the menu, the menubutton is unposted
+and the menu entry is invoked.
+.IP [3]
+If button 1 is pressed over a menubutton and then released over that
+menubutton, the menubutton stays posted: you can still move the mouse
+over the menu and click button 1 on an entry to invoke it.
+Once a menu entry has been invoked, the menubutton unposts itself.
+.IP [4]
+If button 1 is pressed over a menubutton and then dragged over some
+other menubutton, the original menubutton unposts itself and the
+new menubutton posts.
+.IP [5]
+If button 1 is pressed over a menubutton and released outside
+any menubutton or menu, the menubutton unposts without invoking
+any menu entry.
+.IP [6]
+When a menubutton is posted, its associated menu claims the input
+focus to allow keyboard traversal of the menu and its submenus.
+See the \fBmenu\fR manual entry for details on these bindings.
+.IP [7]
+If the \fBunderline\fR option has been specified for a menubutton
+then keyboard traversal may be used to post the menubutton:
+Alt+\fIx\fR, where \fIx\fR is the underlined character (or its
+lower-case or upper-case equivalent), may be typed in any window
+under the menubutton's toplevel to post the menubutton.
+.IP [8]
+The F10 key may be typed in any window to post the first menubutton
+under its toplevel window that isn't disabled.
+.IP [9]
+If a menubutton has the input focus, the space and return keys
+post the menubutton.
+.PP
+If the menubutton's state is \fBdisabled\fR then none of the above
+actions occur: the menubutton is completely non-responsive.
+.PP
+The behavior of menubuttons can be changed by defining new bindings for
+individual widgets or by redefining the class bindings.
+
+.SH KEYWORDS
+menubutton, widget
diff --git a/tk/doc/message.n b/tk/doc/message.n
new file mode 100644
index 00000000000..a236741c419
--- /dev/null
+++ b/tk/doc/message.n
@@ -0,0 +1,147 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBmessage\fR \fIpathName \fR?\fIoptions\fR?
+.SO
+\-anchor \-font \-highlightthickness \-takefocus
+\-background \-foreground \-padx \-text
+\-borderwidth \-highlightbackground \-pady \-textvariable
+\-cursor \-highlightcolor \-relief \-width
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-aspect aspect Aspect
+Specifies a non-negative integer value indicating desired
+aspect ratio for the text. The aspect ratio is specified as
+100*width/height. 100 means the text should
+be as wide as it is tall, 200 means the text should
+be twice as wide as it is tall, 50 means the text should
+be twice as tall as it is wide, and so on.
+Used to choose line length for text if \fBwidth\fR option
+isn't specified.
+Defaults to 150.
+.OP \-justify justify Justify
+Specifies how to justify lines of text.
+Must be one of \fBleft\fR, \fBcenter\fR, or \fBright\fR. Defaults
+to \fBleft\fR.
+This option works together with the \fBanchor\fR, \fBaspect\fR,
+\fBpadX\fR, \fBpadY\fR, and \fBwidth\fR options to provide a variety
+of arrangements of the text within the window.
+The \fBaspect\fR and \fBwidth\fR options determine the amount of
+screen space needed to display the text.
+The \fBanchor\fR, \fBpadX\fR, and \fBpadY\fR options determine where this
+rectangular area is displayed within the widget's window, and the
+\fBjustify\fR option determines how each line is displayed within that
+rectangular region.
+For example, suppose \fBanchor\fR is \fBe\fR and \fBjustify\fR is
+\fBleft\fR, and that the message window is much larger than needed
+for the text.
+The the text will displayed so that the left edges of all the lines
+line up and the right edge of the longest line is \fBpadX\fR from
+the right side of the window; the entire text block will be centered
+in the vertical span of the window.
+.OP \-width width Width
+Specifies the length of lines in the window.
+The value may have any of the forms acceptable to \fBTk_GetPixels\fR.
+If this option has a value greater than zero then the \fBaspect\fR
+option is ignored and the \fBwidth\fR option determines the line
+length.
+If this option has a value less than or equal to zero, then
+the \fBaspect\fR option determines the line length.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBmessage\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a message widget.
+Additional
+options, described above, may be specified on the command line
+or in the option database
+to configure aspects of the message such as its colors, font,
+text, and initial relief. The \fBmessage\fR command returns its
+\fIpathName\fR argument. At the time this command is invoked,
+there must not exist a window named \fIpathName\fR, but
+\fIpathName\fR's parent must exist.
+.PP
+A message is a widget that displays a textual string. A message
+widget has three special features. First, it breaks up
+its string into lines in order to produce a given aspect ratio
+for the window. The line breaks are chosen at word boundaries
+wherever possible (if not even a single word would fit on a
+line, then the word will be split across lines). Newline characters
+in the string will force line breaks; they can be used, for example,
+to leave blank lines in the display.
+.PP
+The second feature of a message widget is justification. The text
+may be displayed left-justified (each line starts at the left side of
+the window), centered on a line-by-line basis, or right-justified
+(each line ends at the right side of the window).
+.PP
+The third feature of a message widget is that it handles control
+characters and non-printing characters specially. Tab characters
+are replaced with enough blank space to line up on the next
+8-character boundary. Newlines cause line breaks. Other control
+characters (ASCII code less than 0x20) and characters not defined
+in the font are displayed as a four-character sequence \fB\ex\fIhh\fR where
+\fIhh\fR is the two-digit hexadecimal number corresponding to
+the character. In the unusual case where the font doesn't contain
+all of the characters in ``0123456789abcdef\ex'' then control
+characters and undefined characters are not displayed at all.
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBmessage\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.CS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.CE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for message widgets:
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBmessage\fR
+command.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBmessage\fR
+command.
+
+.SH "DEFAULT BINDINGS"
+.PP
+When a new message is created, it has no default event bindings:
+messages are intended for output purposes only.
+
+.SH BUGS
+.PP
+Tabs don't work very well with text that is centered or right-justified.
+The most common result is that the line is justified wrong.
+
+.SH KEYWORDS
+message, widget
diff --git a/tk/doc/messageBox.n b/tk/doc/messageBox.n
new file mode 100644
index 00000000000..06df6e47aff
--- /dev/null
+++ b/tk/doc/messageBox.n
@@ -0,0 +1,90 @@
+'\"
+'\" 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$
+'\"
+.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.
+.SH SYNOPSIS
+\fBtk_messageBox \fR?\fIoption value ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This procedure creates and displays a message window with an
+application-specified message, an icon and a set of buttons. Each of
+the buttons in the message window is identified by a unique symbolic
+name (see the \fB\-type\fR options). After the message window is
+popped up, \fBtk_messageBox\fR waits for the user to select one of the
+buttons. Then it returns the symbolic name of the selected button.
+
+The following option-value pairs are supported:
+.TP
+\fB\-default\fR \fIname\fR
+\fIName\fR gives the symbolic name of the default button for
+this message window ('ok', 'cancel', and so on). See \fB\-type\fR
+for a list of the symbolic names. If the message box has just one
+button it will automatically be made the default, otherwise if this
+option is not specified, there won't be any default button.
+.TP
+\fB\-icon\fR \fIiconImage\fR
+Specifies an icon to display. \fIIconImage\fR must be one of the
+following: \fBerror\fR, \fBinfo\fR, \fBquestion\fR or
+\fBwarning\fR. If this option is not specified, then no icon will be
+displayed.
+.TP
+\fB\-message\fR \fIstring\fR
+Specifies the message to display in this message box.
+.TP
+\fB\-parent\fR \fIwindow\fR
+Makes \fIwindow\fR the logical parent of the message box. The message
+box is displayed on top of its parent window.
+.TP
+\fB\-title\fR \fItitleString\fR
+Specifies a string to display as the title of the message box. The
+default value is an empty string.
+.TP
+\fB\-type\fR \fIpredefinedType\fR
+Arranges for a predefined set of buttons to be displayed. The
+following values are possible for \fIpredefinedType\fR:
+.RS
+.TP 18
+\fBabortretryignore\fR
+Displays three buttons whose symbolic names are \fBabort\fR,
+\fBretry\fR and \fBignore\fR.
+.TP 18
+\fBok\fR
+Displays one button whose symbolic name is \fBok\fR.
+.TP 18
+\fBokcancel\fR
+Displays two buttons whose symbolic names are \fBok\fR and \fBcancel\fR.
+.TP 18
+\fBretrycancel\fR
+Displays two buttons whose symbolic names are \fBretry\fR and \fBcancel\fR.
+.TP 18
+\fByesno\fR
+Displays two buttons whose symbolic names are \fByes\fR and \fBno\fR.
+.TP 18
+\fByesnocancel\fR
+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
diff --git a/tk/doc/option.n b/tk/doc/option.n
new file mode 100644
index 00000000000..8f0dd6ad5de
--- /dev/null
+++ b/tk/doc/option.n
@@ -0,0 +1,91 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBoption add \fIpattern value \fR?\fIpriority\fR?
+.sp
+\fBoption clear\fR
+.sp
+\fBoption get \fIwindow name class\fR
+.sp
+\fBoption readfile \fIfileName \fR?\fIpriority\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBoption\fR command allows you to add entries to the Tk option
+database or to retrieve options from the database. The \fBadd\fR
+form of the command adds a new option to the database.
+\fIPattern\fR contains
+the option being specified, and consists of names and/or classes
+separated by asterisks or dots, in the usual X format. \fIValue\fR
+contains a text string to associate with \fIpattern\fR; this is the
+value that will be returned in calls to \fBTk_GetOption\fR or by
+invocations of the \fBoption get\fR command. If \fIpriority\fR
+is specified, it indicates the priority level for this option (see
+below for legal values); it defaults to \fBinteractive\fR.
+This command always returns an empty string.
+.PP
+The \fBoption clear\fR command clears the option database. Default
+options (from the
+\fBRESOURCE_MANAGER\fR property or the \fB.Xdefaults\fR
+file) will be reloaded automatically the next time an
+option is added to the database or removed from it. This command
+always returns an empty string.
+.PP
+The \fBoption get\fR command returns the value of the option
+specified for \fIwindow\fR
+under \fIname\fR and \fIclass\fR. If several entries in the option
+database match \fIwindow\fR, \fIname\fR, and \fIclass\fR, then
+the command returns whichever was created with highest
+\fIpriority\fR level. If there are several matching
+entries at the same priority level, then it returns whichever entry
+was most recently entered into the option database. If there are
+no matching entries, then the empty string is returned.
+.PP
+The \fBreadfile\fR form of the command reads \fIfileName\fR,
+which should have the standard format for an
+X resource database such as \fB.Xdefaults\fR, and adds all the
+options specified in that file to the option database. If \fIpriority\fR
+is specified, it indicates the priority level at which to enter the
+options; \fIpriority\fR defaults to \fBinteractive\fR.
+.PP
+The \fIpriority\fR arguments to the \fBoption\fR command are
+normally specified symbolically using one of the following values:
+.TP
+\fBwidgetDefault\fR
+Level 20. Used for default values hard-coded into widgets.
+.TP
+\fBstartupFile\fR
+Level 40. Used for options specified in application-specific
+startup files.
+.TP
+\fBuserDefault\fR
+Level 60. Used for options specified in user-specific defaults
+files, such as \fB.Xdefaults\fR, resource databases loaded into
+the X server, or user-specific startup files.
+.TP
+\fBinteractive\fR
+Level 80. Used for options specified interactively after the application
+starts running. If \fIpriority\fR isn't specified, it defaults to
+this level.
+.LP
+Any of the above keywords may be abbreviated. In addition, priorities
+may be specified numerically using integers between 0 and 100,
+inclusive. The numeric form is probably a bad idea except for new priority
+levels other than the ones given above.
+
+.SH KEYWORDS
+database, option, priority, retrieve
diff --git a/tk/doc/optionMenu.n b/tk/doc/optionMenu.n
new file mode 100644
index 00000000000..9dd7147ed16
--- /dev/null
+++ b/tk/doc/optionMenu.n
@@ -0,0 +1,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$
+'\"
+.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
+.SH SYNOPSIS
+\fBtk_optionMenu \fIw varName value \fR?\fIvalue value ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This procedure creates an option menubutton whose name is \fIw\fR,
+plus an associated menu.
+Together they allow the user to select one of the values
+given by the \fIvalue\fR arguments.
+The current value will be stored in the global variable whose
+name is given by \fIvarName\fR and it will also be displayed as the label
+in the option menubutton.
+The user can click on the menubutton to display a menu containing
+all of the \fIvalue\fRs and thereby select a new value.
+Once a new value is selected, it will be stored in the variable
+and appear in the option menubutton.
+The current value can also be changed by setting the variable.
+.PP
+The return value from \fBtk_optionMenu\fR is the name of the menu
+associated with \fIw\fR, so that the caller can change its configuration
+options or manipulate it in other ways.
+
+.SH KEYWORDS
+option menu
diff --git a/tk/doc/options.n b/tk/doc/options.n
new file mode 100644
index 00000000000..11f9ea78756
--- /dev/null
+++ b/tk/doc/options.n
@@ -0,0 +1,328 @@
+'\"
+'\" 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$
+'\"
+.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
+.BE
+
+.SH DESCRIPTION
+This manual entry describes the common configuration options supported
+by widgets in the Tk toolkit. Every widget does not necessarily support
+every option (see the manual entries for individual widgets for a list
+of the standard options supported by that widget), but if a widget does
+support an option with one of the names listed below, then the option
+has exactly the effect described below.
+.PP
+In the descriptions below, ``Command-Line Name'' refers to the
+switch used in class commands and \fBconfigure\fR widget commands to
+set this value. For example, if an option's command-line switch is
+\fB\-foreground\fR and there exists a widget \fB.a.b.c\fR, then the
+command
+.CS
+\&\fB.a.b.c\0\0configure\0\0\-foreground black\fR
+.CE
+may be used to specify the value \fBblack\fR for the option in the
+the widget \fB.a.b.c\fR. Command-line switches may be abbreviated,
+as long as the abbreviation is unambiguous.
+``Database Name'' refers to the option's name in the option database (e.g.
+in .Xdefaults files). ``Database Class'' refers to the option's class value
+in the option database.
+.OP \-activebackground activeBackground Foreground
+Specifies background color to use when drawing active elements.
+An element (a widget or portion of a widget) is active if the
+mouse cursor is positioned over the element and pressing a mouse button
+will cause some action to occur.
+If strict Motif compliance has been requested by setting the
+\fBtk_strictMotif\fR variable, this option will normally be
+ignored; the normal background color will be used instead.
+.VS
+For some elements on Windows and Macintosh systems, the active color
+will only be used while mouse button 1 is pressed over the element.
+.VE
+.OP \-activeborderwidth activeBorderWidth BorderWidth
+Specifies a non-negative value indicating
+the width of the 3-D border drawn around active elements. See above for
+definition of active elements.
+The value may have any of the forms acceptable to \fBTk_GetPixels\fR.
+This option is typically only available in widgets displaying more
+than one element at a time (e.g. menus but not buttons).
+.OP \-activeforeground activeForeground Background
+Specifies foreground color to use when drawing active elements.
+See above for definition of active elements.
+.OP \-anchor anchor Anchor
+Specifies how the information in a widget (e.g. text or a bitmap)
+is to be displayed in the widget.
+Must be one of the values \fBn\fR, \fBne\fR, \fBe\fR, \fBse\fR,
+\fBs\fR, \fBsw\fR, \fBw\fR, \fBnw\fR, or \fBcenter\fR.
+For example, \fBnw\fR means display the information such that its
+top-left corner is at the top-left corner of the widget.
+.OP "\-background or \-bg" background Background
+Specifies the normal background color to use when displaying the
+widget.
+.OP \-bitmap bitmap Bitmap
+Specifies a bitmap to display in the widget, in any of the forms
+acceptable to \fBTk_GetBitmap\fR.
+The exact way in which the bitmap is displayed may be affected by
+other options such as \fBanchor\fR or \fBjustify\fR.
+Typically, if this option is specified then it overrides other
+options that specify a textual value to display in the widget;
+the \fBbitmap\fR option may be reset to an empty string to re-enable
+a text display.
+In widgets that support both \fBbitmap\fR and \fBimage\fR options,
+\fBimage\fR will usually override \fBbitmap\fR.
+.OP "\-borderwidth or \-bd" borderWidth BorderWidth
+Specifies a non-negative value indicating the width
+of the 3-D border to draw around the outside of the widget (if such a
+border is being drawn; the \fBrelief\fR option typically determines
+this). The value may also be used when drawing 3-D effects in the
+interior of the widget.
+The value may have any of the forms acceptable to \fBTk_GetPixels\fR.
+.OP \-cursor cursor Cursor
+Specifies the mouse cursor to be used for the widget.
+The value may have any of the forms acceptable to \fBTk_GetCursor\fR.
+.OP \-disabledforeground disabledForeground DisabledForeground
+Specifies foreground color to use when drawing a disabled element.
+If the option is specified as an empty string (which is typically the
+case on monochrome displays), disabled elements are drawn with the
+normal foreground color but they are dimmed by drawing them
+with a stippled fill pattern.
+.OP \-exportselection exportSelection ExportSelection
+Specifies whether or not a selection in the widget should also be
+the X selection.
+The value may have any of the forms accepted by \fBTcl_GetBoolean\fR,
+such as \fBtrue\fR, \fBfalse\fR, \fB0\fR, \fB1\fR, \fByes\fR, or \fBno\fR.
+If the selection is exported, then selecting in the widget deselects
+the current X selection, selecting outside the widget deselects any
+widget selection, and the widget will respond to selection retrieval
+requests when it has a selection. The default is usually for widgets
+to export selections.
+.OP \-font font Font
+Specifies the font to use when drawing text inside the widget.
+.OP "\-foreground or \-fg" foreground Foreground
+Specifies the normal foreground color to use when displaying the widget.
+.OP \-highlightbackground highlightBackground HighlightBackground
+Specifies the color to display in the traversal highlight region when
+the widget does not have the input focus.
+.OP \-highlightcolor highlightColor HighlightColor
+Specifies the color to use for the traversal highlight rectangle that is
+drawn around the widget when it has the input focus.
+.OP \-highlightthickness highlightThickness HighlightThickness
+Specifies a non-negative value indicating the width of the highlight
+rectangle to draw around the outside of the widget when it has the
+input focus.
+The value may have any of the forms acceptable to \fBTk_GetPixels\fR.
+If the value is zero, no focus highlight is drawn around the widget.
+.OP \-image image Image
+Specifies an image to display in the widget, which must have been
+created with the \fBimage create\fR command.
+Typically, if the \fBimage\fR option is specified then it overrides other
+options that specify a bitmap or textual value to display in the widget;
+the \fBimage\fR option may be reset to an empty string to re-enable
+a bitmap or text display.
+.OP \-insertbackground insertBackground Foreground
+Specifies the color to use as background in the area covered by the
+insertion cursor. This color will normally override either the normal
+background for the widget (or the selection background if the insertion
+cursor happens to fall in the selection).
+.OP \-insertborderwidth insertBorderWidth BorderWidth
+Specifies a non-negative value indicating the width
+of the 3-D border to draw around the insertion cursor.
+The value may have any of the forms acceptable to \fBTk_GetPixels\fR.
+.OP \-insertofftime insertOffTime OffTime
+Specifies a non-negative integer value indicating the number of
+milliseconds the insertion cursor should remain ``off'' in each blink cycle.
+If this option is zero then the cursor doesn't blink: it is on
+all the time.
+.OP \-insertontime insertOnTime OnTime
+Specifies a non-negative integer value indicating the number of
+milliseconds the insertion cursor should remain ``on'' in each blink cycle.
+.OP \-insertwidth insertWidth InsertWidth
+Specifies a value indicating the total width of the insertion cursor.
+The value may have any of the forms acceptable to \fBTk_GetPixels\fR.
+If a border has been specified for the insertion
+cursor (using the \fBinsertBorderWidth\fR option), the border
+will be drawn inside the width specified by the \fBinsertWidth\fR
+option.
+.OP \-jump jump Jump
+For widgets with a slider that can be dragged to adjust a value,
+such as scrollbars, this option determines when
+notifications are made about changes in the value.
+The option's value must be a boolean of the form accepted by
+\fBTcl_GetBoolean\fR.
+If the value is false, updates are made continuously as the
+slider is dragged.
+If the value is true, updates are delayed until the mouse button
+is released to end the drag; at that point a single notification
+is made (the value ``jumps'' rather than changing smoothly).
+.OP \-justify justify Justify
+When there are multiple lines of text displayed in a widget, this
+option determines how the lines line up with each other.
+Must be one of \fBleft\fR, \fBcenter\fR, or \fBright\fR.
+\fBLeft\fR means that the lines' left edges all line up, \fBcenter\fR
+means that the lines' centers are aligned, and \fBright\fR means
+that the lines' right edges line up.
+.OP \-orient orient Orient
+For widgets that can lay themselves out with either a horizontal
+or vertical orientation, such as scrollbars, this option specifies
+which orientation should be used. Must be either \fBhorizontal\fR
+or \fBvertical\fR or an abbreviation of one of these.
+.OP \-padx padX Pad
+Specifies a non-negative value indicating how much extra space
+to request for the widget in the X-direction.
+The value may have any of the forms acceptable to \fBTk_GetPixels\fR.
+When computing how large a window it needs, the widget will
+add this amount to the width it would normally need (as determined
+by the width of the things displayed in the widget); if the geometry
+manager can satisfy this request, the widget will end up with extra
+internal space to the left and/or right of what it displays inside.
+Most widgets only use this option for padding text: if they are
+displaying a bitmap or image, then they usually ignore padding
+options.
+.OP \-pady padY Pad
+Specifies a non-negative value indicating how much extra space
+to request for the widget in the Y-direction.
+The value may have any of the forms acceptable to \fBTk_GetPixels\fR.
+When computing how large a window it needs, the widget will add
+this amount to the height it would normally need (as determined by
+the height of the things displayed in the widget); if the geometry
+manager can satisfy this request, the widget will end up with extra
+internal space above and/or below what it displays inside.
+Most widgets only use this option for padding text: if they are
+displaying a bitmap or image, then they usually ignore padding
+options.
+.OP \-relief relief Relief
+Specifies the 3-D effect desired for the widget. Acceptable
+values are \fBraised\fR, \fBsunken\fR, \fBflat\fR, \fBridge\fR,
+\fBsolid\fR, and \fBgroove\fR.
+The value
+indicates how the interior of the widget should appear relative
+to its exterior; for example, \fBraised\fR means the interior of
+the widget should appear to protrude from the screen, relative to
+the exterior of the widget.
+.OP \-repeatdelay repeatDelay RepeatDelay
+Specifies the number of milliseconds a button or key must be held
+down before it begins to auto-repeat. Used, for example, on the
+up- and down-arrows in scrollbars.
+.OP \-repeatinterval repeatInterval RepeatInterval
+Used in conjunction with \fBrepeatDelay\fR: once auto-repeat
+begins, this option determines the number of milliseconds between
+auto-repeats.
+.OP \-selectbackground selectBackground Foreground
+Specifies the background color to use when displaying selected
+items.
+.OP \-selectborderwidth selectBorderWidth BorderWidth
+Specifies a non-negative value indicating the width
+of the 3-D border to draw around selected items.
+The value may have any of the forms acceptable to \fBTk_GetPixels\fR.
+.OP \-selectforeground selectForeground Background
+Specifies the foreground color to use when displaying selected
+items.
+.OP \-setgrid setGrid SetGrid
+Specifies a boolean value that determines whether this widget controls the
+resizing grid for its top-level window.
+This option is typically used in text widgets, where the information
+in the widget has a natural size (the size of a character) and it makes
+sense for the window's dimensions to be integral numbers of these units.
+These natural window sizes form a grid.
+If the \fBsetGrid\fR option is set to true then the widget will
+communicate with the window manager so that when the user interactively
+resizes the top-level window that contains the widget, the dimensions of
+the window will be displayed to the user in grid units and the window
+size will be constrained to integral numbers of grid units.
+See the section GRIDDED GEOMETRY MANAGEMENT in the \fBwm\fR manual
+entry for more details.
+.OP \-takefocus takeFocus TakeFocus
+Determines whether the window accepts the focus during keyboard
+traversal (e.g., Tab and Shift-Tab).
+Before setting the focus to a window, the traversal scripts
+consult the value of the \fBtakeFocus\fR option.
+A value of \fB0\fR means that the window should be skipped entirely
+during keyboard traversal.
+\fB1\fR means that the window should receive the input
+focus as long as it is viewable (it and all of its ancestors are mapped).
+An empty value for the option means that the traversal scripts make
+the decision about whether or not to focus on the window: the current
+algorithm is to skip the window if it is
+disabled, if it has no key bindings, or if it is not viewable.
+If the value has any other form, then the traversal scripts take
+the value, append the name of the window to it (with a separator space),
+and evaluate the resulting string as a Tcl script.
+The script must return \fB0\fR, \fB1\fR, or an empty string: a
+\fB0\fR or \fB1\fR value specifies whether the window will receive
+the input focus, and an empty string results in the default decision
+described above.
+Note: this interpretation of the option is defined entirely by
+the Tcl scripts that implement traversal: the widget implementations
+ignore the option entirely, so you can change its meaning if you
+redefine the keyboard traversal scripts.
+.OP \-text text Text
+Specifies a string to be displayed inside the widget. The way in which
+the string is displayed depends on the particular widget and may be
+determined by other options, such as \fBanchor\fR or \fBjustify\fR.
+.OP \-textvariable textVariable Variable
+Specifies the name of a variable. The value of the variable is a text
+string to be displayed inside the widget; if the variable value changes
+then the widget will automatically update itself to reflect the new value.
+The way in which the string is displayed in the widget depends on the
+particular widget and may be determined by other options, such as
+\fBanchor\fR or \fBjustify\fR.
+.OP \-troughcolor troughColor Background
+Specifies the color to use for the rectangular trough areas
+in widgets such as scrollbars and scales.
+.OP \-underline underline Underline
+Specifies the integer index of a character to underline in the widget.
+This option is used by the default bindings to implement keyboard
+traversal for menu buttons and menu entries.
+0 corresponds to the first character of the text displayed in the
+widget, 1 to the next character, and so on.
+.OP \-wraplength wrapLength WrapLength
+For widgets that can perform word-wrapping, this option specifies
+the maximum line length.
+Lines that would exceed this length are wrapped onto the next line,
+so that no line is longer than the specified length.
+The value may be specified in any of the standard forms for
+screen distances.
+If this value is less than or equal to 0 then no wrapping is done: lines
+will break only at newline characters in the text.
+.OP \-xscrollcommand xScrollCommand ScrollCommand
+Specifies the prefix for a command used to communicate with horizontal
+scrollbars.
+When the view in the widget's window changes (or
+whenever anything else occurs that could change the display in a
+scrollbar, such as a change in the total size of the widget's
+contents), the widget will
+generate a Tcl command by concatenating the scroll command and
+two numbers.
+Each of the numbers is a fraction between 0 and 1, which indicates
+a position in the document. 0 indicates the beginning of the document,
+1 indicates the end, .333 indicates a position one third the way through
+the document, and so on.
+The first fraction indicates the first information in the document
+that is visible in the window, and the second fraction indicates
+the information just after the last portion that is visible.
+The command is
+then passed to the Tcl interpreter for execution. Typically the
+\fBxScrollCommand\fR option consists of the path name of a scrollbar
+widget followed by ``set'', e.g. ``.x.scrollbar set'': this will cause
+the scrollbar to be updated whenever the view in the window changes.
+If this option is not specified, then no command will be executed.
+.OP \-yscrollcommand yScrollCommand ScrollCommand
+Specifies the prefix for a command used to communicate with vertical
+scrollbars. This option is treated in the same way as the
+\fBxScrollCommand\fR option, except that it is used for vertical
+scrollbars and is provided by widgets that support vertical scrolling.
+See the description of \fBxScrollCommand\fR for details
+on how this option is used.
+
+.SH KEYWORDS
+class, name, standard option, switch
diff --git a/tk/doc/pack-old.n b/tk/doc/pack-old.n
new file mode 100644
index 00000000000..902fcc5970e
--- /dev/null
+++ b/tk/doc/pack-old.n
@@ -0,0 +1,196 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBpack after \fIsibling \fIwindow options\fR ?\fIwindow options \fR...?
+.sp
+\fBpack append \fIparent \fIwindow options\fR ?\fIwindow options \fR...?
+.sp
+\fBpack before \fIsibling \fIwindow options\fR ?\fIwindow options \fR...?
+.sp
+\fBpack unpack \fIwindow\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+\fINote: this manual entry describes the syntax for the \fBpack\fI
+command as it existed before Tk version 3.3.
+Although this syntax continues to be supported for backward
+compatibility, it is obsolete and should not be used anymore.
+At some point in the future it may cease to be supported.\fR
+.PP
+The packer is a geometry manager that arranges the
+children of a parent by packing them in order around the edges of
+the parent. The first child is placed against one side of
+the window, occupying the entire span of the window along that
+side. This reduces the space remaining for other children as
+if the side had been moved in by the size of the first child.
+Then the next child is placed against one side of the remaining
+cavity, and so on until all children have been placed or there
+is no space left in the cavity.
+.PP
+The \fBbefore\fR, \fBafter\fR, and \fBappend\fR forms of the \fBpack\fR
+command are used to insert one or more children into the packing order
+for their parent. The \fBbefore\fR form inserts the children before
+window \fIsibling\fR in the order; all of the other windows must be
+siblings of \fIsibling\fR. The \fBafter\fR form inserts the windows
+after \fIsibling\fR, and the \fBappend\fR form appends one or more
+windows to the end of the packing order for \fIparent\fR. If a
+\fIwindow\fR named in any of these commands is already packed in
+its parent, it is removed from its current position in the packing
+order and repositioned as indicated by the command. All of these
+commands return an empty string as result.
+.PP
+The \fBunpack\fR form of the \fBpack\fR command removes \fIwindow\fR
+from the packing order of its parent and unmaps it. After the
+execution of this command the packer will no longer manage
+\fIwindow\fR's geometry.
+.PP
+The placement of each child is actually a four-step process;
+the \fIoptions\fR argument following each \fIwindow\fR consists of
+a list of one or more fields that govern the placement of that
+window. In the discussion below, the term \fIcavity\fR refers
+to the space left in a parent when a particular child is placed
+(i.e. all the space that wasn't claimed by earlier children in
+the packing order). The term \fIparcel\fR refers to the space
+allocated to a particular child; this is not necessarily the
+same as the child window's final geometry.
+.PP
+The first step in placing a child is to determine which side of
+the cavity it will lie against. Any one of the following options
+may be used to specify a side:
+.TP
+\fBtop\fR
+Position the child's parcel against the top of the cavity,
+occupying the full width of the cavity.
+.TP
+\fBbottom\fR
+Position the child's parcel against the bottom of the cavity,
+occupying the full width of the cavity.
+.TP
+\fBleft\fR
+Position the child's parcel against the left side of the cavity,
+occupying the full height of the cavity.
+.TP
+\fBright\fR
+Position the child's parcel against the right side of the cavity,
+occupying the full height of the cavity.
+.LP
+At most one of these options should be specified for any given window.
+If no side is specified, then the default is \fBtop\fR.
+.PP
+The second step is to decide on a parcel for the child. For \fBtop\fR
+and \fBbottom\fR windows, the desired parcel width is normally the cavity
+width and the desired parcel height is the window's requested height,
+as passed to \fBTk_GeometryRequest\fR. For \fBleft\fR and \fBright\fR
+windows, the desired parcel height is normally the cavity height and the
+desired width is the window's requested width. However, extra
+space may be requested for the window using any of the following
+options:
+.TP 12
+\fBpadx \fInum\fR
+Add \fInum\fR pixels to the window's requested width before computing
+the parcel size as described above.
+.TP 12
+\fBpady \fInum\fR
+Add \fInum\fR pixels to the window's requested height before computing
+the parcel size as described above.
+.TP 12
+\fBexpand\fR
+This option requests that the window's parcel absorb any extra space left over
+in the parent's cavity after packing all the children.
+The amount of space left over depends on the sizes requested by the
+other children, and may be zero. If several windows have all specified
+\fBexpand\fR then the extra width will be divided equally among all the
+\fBleft\fR and \fBright\fR windows that specified \fBexpand\fR and
+the extra height will be divided equally among all the \fBtop\fR and
+\fBbottom\fR windows that specified \fBexpand\fR.
+.LP
+If the desired width or height for a parcel is larger than the corresponding
+dimension of the cavity, then the cavity's dimension is used instead.
+.PP
+The third step in placing the window is to decide on the window's
+width and height. The default is for the window to receive either
+its requested width and height or the those of the parcel, whichever
+is smaller. If the parcel is larger than the window's requested
+size, then the following options may be used to expand the
+window to partially or completely fill the parcel:
+.TP
+\fBfill\fR
+Set the window's size to equal the parcel size.
+.TP
+\fBfillx\fR
+Increase the window's width to equal the parcel's width, but retain
+the window's requested height.
+.TP
+\fBfilly\fR
+Increase the window's height to equal the parcel's height, but retain
+the window's requested width.
+.PP
+The last step is to decide the window's location within its parcel.
+If the window's size equals the parcel's size, then the window simply
+fills the entire parcel. If the parcel is larger than the window,
+then one of
+the following options may be used to specify where the window should
+be positioned within its parcel:
+.TP 15
+\fBframe center\fR
+Center the window in its parcel. This is the default if no framing
+option is specified.
+.TP 15
+\fBframe n\fR
+Position the window with its top edge centered on the top edge of
+the parcel.
+.TP 15
+\fBframe ne\fR
+Position the window with its upper-right corner at the upper-right corner
+of the parcel.
+.TP 15
+\fBframe e\fR
+Position the window with its right edge centered on the right edge of
+the parcel.
+.TP 15
+\fBframe se\fR
+Position the window with its lower-right corner at the lower-right corner
+of the parcel.
+.TP 15
+\fBframe s\fR
+Position the window with its bottom edge centered on the bottom edge of
+the parcel.
+.TP 15
+\fBframe sw\fR
+Position the window with its lower-left corner at the lower-left corner
+of the parcel.
+.TP 15
+\fBframe w\fR
+Position the window with its left edge centered on the left edge of
+the parcel.
+.TP 15
+\fBframe nw\fR
+Position the window with its upper-left corner at the upper-left corner
+of the parcel.
+.PP
+The packer manages the mapped/unmapped state of all the packed
+children windows. It automatically maps the windows when it packs
+them, and it unmaps any windows for which there was no space left
+in the cavity.
+.PP
+The packer makes geometry requests on behalf of the parent windows
+it manages. For each parent window it requests a size large enough
+to accommodate all the options specified by all the packed children,
+such that zero space would be leftover for \fBexpand\fR options.
+
+.SH KEYWORDS
+geometry manager, location, packer, parcel, size
diff --git a/tk/doc/pack.n b/tk/doc/pack.n
new file mode 100644
index 00000000000..1ead2ff4d9d
--- /dev/null
+++ b/tk/doc/pack.n
@@ -0,0 +1,266 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBpack \fIoption arg \fR?\fIarg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBpack\fR command is used to communicate with the packer,
+a geometry manager that arranges the children of a parent by
+packing them in order around the edges of the parent.
+The \fBpack\fR command can have any of several forms, depending
+on the \fIoption\fR argument:
+.TP
+\fBpack \fIslave \fR?\fIslave ...\fR? ?\fIoptions\fR?
+If the first argument to \fBpack\fR is a window name (any value
+starting with ``.''), then the command is processed in the same
+way as \fBpack configure\fR.
+.TP
+\fBpack configure \fIslave \fR?\fIslave ...\fR? ?\fIoptions\fR?
+The arguments consist of the names of one or more slave windows
+followed by pairs of arguments that specify how
+to manage the slaves.
+See ``THE PACKER ALGORITHM'' below for details on how the options
+are used by the packer.
+The following options are supported:
+.RS
+.TP
+\fB\-after \fIother\fR
+\fIOther\fR must the name of another window.
+Use its master as the master for the slaves, and insert
+the slaves just after \fIother\fR in the packing order.
+.TP
+\fB\-anchor \fIanchor\fR
+\fIAnchor\fR must be a valid anchor position such as \fBn\fR
+or \fBsw\fR; it specifies where to position each slave in its
+parcel.
+Defaults to \fBcenter\fR.
+.TP
+\fB\-before \fIother\fR
+\fIOther\fR must the name of another window.
+Use its master as the master for the slaves, and insert
+the slaves just before \fIother\fR in the packing order.
+.TP
+\fB\-expand \fIboolean\fR
+Specifies whether the slaves should be expanded to consume
+extra space in their master.
+\fIBoolean\fR may have any proper boolean value, such as \fB1\fR
+or \fBno\fR.
+Defaults to 0.
+.TP
+\fB\-fill \fIstyle\fR
+If a slave's parcel is larger than its requested dimensions, this
+option may be used to stretch the slave.
+\fIStyle\fR must have one of the following values:
+.RS
+.TP
+\fBnone\fR
+Give the slave its requested dimensions plus any internal padding
+requested with \fB\-ipadx\fR or \fB\-ipady\fR. This is the default.
+.TP
+\fBx\fR
+Stretch the slave horizontally to fill the entire width of its
+parcel (except leave external padding as specified by \fB\-padx\fR).
+.TP
+\fBy\fR
+Stretch the slave vertically to fill the entire height of its
+parcel (except leave external padding as specified by \fB\-pady\fR).
+.TP
+\fBboth\fR
+Stretch the slave both horizontally and vertically.
+.RE
+.TP
+\fB\-in \fIother\fR
+Insert the slave(s) at the end of the packing order for the master
+window given by \fIother\fR.
+.TP
+\fB\-ipadx \fIamount\fR
+\fIAmount\fR specifies how much horizontal internal padding to
+leave on each side of the slave(s).
+\fIAmount\fR must be a valid screen distance, such as \fB2\fR or \fB.5c\fR.
+It defaults to 0.
+.TP
+\fB\-ipady \fIamount\fR
+\fIAmount\fR specifies how much vertical internal padding to
+leave on each side of the slave(s).
+\fIAmount\fR defaults to 0.
+.TP
+\fB\-padx \fIamount\fR
+\fIAmount\fR specifies how much horizontal external padding to
+leave on each side of the slave(s).
+\fIAmount\fR defaults to 0.
+.TP
+\fB\-pady \fIamount\fR
+\fIAmount\fR specifies how much vertical external padding to
+leave on each side of the slave(s).
+\fIAmount\fR defaults to 0.
+.TP
+\fB\-side \fIside\fR
+Specifies which side of the master the slave(s) will be packed against.
+Must be \fBleft\fR, \fBright\fR, \fBtop\fR, or \fBbottom\fR.
+Defaults to \fBtop\fR.
+.LP
+If no \fB\-in\fR, \fB\-after\fR or \fB\-before\fR option is specified
+then each of the slaves will be inserted at the end of the packing list
+for its parent unless it is already managed by the packer (in which
+case it will be left where it is).
+If one of these options is specified then all the slaves will be
+inserted at the specified point.
+If any of the slaves are already managed by the geometry manager
+then any unspecified options for them retain their previous values rather
+than receiving default values.
+.RE
+.TP
+\fBpack forget \fIslave \fR?\fIslave ...\fR?
+Removes each of the \fIslave\fRs from the packing order for its
+master and unmaps their windows.
+The slaves will no longer be managed by the packer.
+.TP
+\fBpack info \fIslave\fR
+Returns a list whose elements are the current configuration state of
+the slave given by \fIslave\fR in the same option-value form that
+might be specified to \fBpack configure\fR.
+The first two elements of the list are ``\fB\-in \fImaster\fR'' where
+\fImaster\fR is the slave's master.
+.TP
+\fBpack propagate \fImaster\fR ?\fIboolean\fR?
+If \fIboolean\fR has a true boolean value such as \fB1\fR or \fBon\fR
+then propagation is enabled for \fImaster\fR, which must be a window
+name (see ``GEOMETRY PROPAGATION'' below).
+If \fIboolean\fR has a false boolean value then propagation is
+disabled for \fImaster\fR.
+In either of these cases an empty string is returned.
+If \fIboolean\fR is omitted then the command returns \fB0\fR or
+\fB1\fR to indicate whether propagation is currently enabled
+for \fImaster\fR.
+Propagation is enabled by default.
+.TP
+\fBpack slaves \fImaster\fR
+Returns a list of all of the slaves in the packing order for \fImaster\fR.
+The order of the slaves in the list is the same as their order in
+the packing order.
+If \fImaster\fR has no slaves then an empty string is returned.
+
+.SH "THE PACKER ALGORITHM"
+.PP
+For each master the packer maintains an ordered list of slaves
+called the \fIpacking list\fR.
+The \fB\-in\fR, \fB\-after\fR, and \fB\-before\fR configuration
+options are used to specify the master for each slave and the slave's
+position in the packing list.
+If none of these options is given for a slave then the slave
+is added to the end of the packing list for its parent.
+.PP
+The packer arranges the slaves for a master by scanning the
+packing list in order.
+At the time it processes each slave, a rectangular area within
+the master is still unallocated.
+This area is called the \fIcavity\fR; for the first slave it
+is the entire area of the master.
+.PP
+For each slave the packer carries out the following steps:
+.IP [1]
+The packer allocates a rectangular \fIparcel\fR for the slave
+along the side of the cavity given by the slave's \fB\-side\fR option.
+If the side is top or bottom then the width of the parcel is
+the width of the cavity and its height is the requested height
+of the slave plus the \fB\-ipady\fR and \fB\-pady\fR options.
+For the left or right side the height of the parcel is
+the height of the cavity and the width is the requested width
+of the slave plus the \fB\-ipadx\fR and \fB\-padx\fR options.
+The parcel may be enlarged further because of the \fB\-expand\fR
+option (see ``EXPANSION'' below)
+.IP [2]
+The packer chooses the dimensions of the slave.
+The width will normally be the slave's requested width plus
+twice its \fB\-ipadx\fR option and the height will normally be
+the slave's requested height plus twice its \fB\-ipady\fR
+option.
+However, if the \fB\-fill\fR option is \fBx\fR or \fBboth\fR
+then the width of the slave is expanded to fill the width of the parcel,
+minus twice the \fB\-padx\fR option.
+If the \fB\-fill\fR option is \fBy\fR or \fBboth\fR
+then the height of the slave is expanded to fill the width of the parcel,
+minus twice the \fB\-pady\fR option.
+.IP [3]
+The packer positions the slave over its parcel.
+If the slave is smaller than the parcel then the \fB\-anchor\fR
+option determines where in the parcel the slave will be placed.
+If \fB\-padx\fR or \fB\-pady\fR is non-zero, then the given
+amount of external padding will always be left between the
+slave and the edges of the parcel.
+.PP
+Once a given slave has been packed, the area of its parcel
+is subtracted from the cavity, leaving a smaller rectangular
+cavity for the next slave.
+If a slave doesn't use all of its parcel, the unused space
+in the parcel will not be used by subsequent slaves.
+If the cavity should become too small to meet the needs of
+a slave then the slave will be given whatever space is
+left in the cavity.
+If the cavity shrinks to zero size, then all remaining slaves
+on the packing list will be unmapped from the screen until
+the master window becomes large enough to hold them again.
+
+.SH "EXPANSION"
+.PP
+If a master window is so large that there will be extra space
+left over after all of its slaves have been packed, then the
+extra space is distributed uniformly among all of the slaves
+for which the \fB\-expand\fR option is set.
+Extra horizontal space is distributed among the expandable
+slaves whose \fB\-side\fR is \fBleft\fR or \fBright\fR,
+and extra vertical space is distributed among the expandable
+slaves whose \fB\-side\fR is \fBtop\fR or \fBbottom\fR.
+
+.SH "GEOMETRY PROPAGATION"
+.PP
+The packer normally computes how large a master must be to
+just exactly meet the needs of its slaves, and it sets the
+requested width and height of the master to these dimensions.
+This causes geometry information to propagate up through a
+window hierarchy to a top-level window so that the entire
+sub-tree sizes itself to fit the needs of the leaf windows.
+However, the \fBpack propagate\fR command may be used to
+turn off propagation for one or more masters.
+If propagation is disabled then the packer will not set
+the requested width and height of the packer.
+This may be useful if, for example, you wish for a master
+window to have a fixed size that you specify.
+
+.SH "RESTRICTIONS ON MASTER WINDOWS"
+.PP
+The master for each slave must either be the slave's parent
+(the default) or a descendant of the slave's parent.
+This restriction is necessary to guarantee that the
+slave can be placed over any part of its master that is
+visible without danger of the slave being clipped by its parent.
+
+.SH "PACKING ORDER"
+.PP
+If the master for a slave is not its parent then you must make sure
+that the slave is higher in the stacking order than the master.
+Otherwise the master will obscure the slave and it will appear as
+if the slave hasn't been packed correctly.
+The easiest way to make sure the slave is higher than the master is
+to create the master window first: the most recently created window
+will be highest in the stacking order.
+Or, you can use the \fBraise\fR and \fBlower\fR commands to change
+the stacking order of either the master or the slave.
+
+.SH KEYWORDS
+geometry manager, location, packer, parcel, propagation, size
diff --git a/tk/doc/palette.n b/tk/doc/palette.n
new file mode 100644
index 00000000000..a0a3433e362
--- /dev/null
+++ b/tk/doc/palette.n
@@ -0,0 +1,73 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBtk_setPalette \fIbackground\fR
+.sp
+\fBtk_setPalette \fIname value \fR?\fIname value ...\fR?
+.sp
+\fBtk_bisque\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBtk_setPalette\fR procedure changes the color scheme for Tk.
+It does this by modifying the colors of existing widgets and by changing
+the option database so that future widgets will use the new color scheme.
+If \fBtk_setPalette\fR is invoked with a single argument, the
+argument is the name of a color to use as the normal background
+color; \fBtk_setPalette\fR will compute a complete color palette
+from this background color.
+Alternatively, the arguments to \fBtk_setPalette\fR may consist of any number
+of \fIname\fR\-\fIvalue\fR pairs, where the first argument of the pair
+is the name of an option in the Tk option database and the second
+argument is the new value to use for that option. The following
+database names are currently supported:
+.DS L
+.ta 4c 8c
+\fBactiveBackground foreground selectColor
+activeForeground highlightBackground selectBackground
+background highlightColor selectForeground
+disabledForeground insertBackground troughColor\fR
+.DE
+\fBtk_setPalette\fR tries to compute reasonable defaults for any
+options that you don't specify. You can specify options other
+than the above ones and Tk will change those options on widgets as
+well. This feature may be useful if you are using custom widgets with
+additional color options.
+.PP
+Once it has computed the new value to use for each of the color options,
+\fBtk_setPalette\fR scans the widget hierarchy to modify the options
+of all existing widgets. For each widget, it checks to see if any
+of the above options is defined for the widget. If so, and if the
+option's current value is the default, then the value is changed; if
+the option has a value other than the default, \fBtk_setPalette\fR
+will not change it. The default for an option is the one provided by
+the widget (\fB[lindex [$w configure $option] 3]\fR) unless
+\fBtk_setPalette\fR has been run previously, in which case it is the
+value specified in the previous invocation of \fBtk_setPalette\fR.
+.PP
+After modifying all the widgets in the application, \fBtk_setPalette\fR
+adds options to the option database to change the defaults for
+widgets created in the future. The new options are added at
+priority \fBwidgetDefault\fR, so they will be overridden by options
+from the .Xdefaults file or options specified on the command-line
+that creates a widget.
+.PP
+The procedure \fBtk_bisque\fR is provided for backward compatibility:
+it restores the application's colors to the light brown (``bisque'')
+color scheme used in Tk 3.6 and earlier versions.
+
+.SH KEYWORDS
+bisque, color, palette
diff --git a/tk/doc/photo.n b/tk/doc/photo.n
new file mode 100644
index 00000000000..bb0391a9eda
--- /dev/null
+++ b/tk/doc/photo.n
@@ -0,0 +1,344 @@
+'\"
+'\" 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 (paulus@cs.anu.edu.au),
+'\" Department of Computer Science,
+'\" Australian National University.
+'\"
+'\" RCS: @(#) $Id$
+'\"
+.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
+.SH SYNOPSIS
+\fBimage create photo \fR?\fIname\fR? ?\fIoptions\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+A photo is an image whose pixels can display any color or be
+transparent. A photo image is stored internally in full color (24
+bits per pixel), and is displayed using dithering if necessary. Image
+data for a photo image can be obtained from a file or a string, or it
+can be supplied from
+C code through a procedural interface. At present, only GIF and PPM/PGM
+formats are supported, but an interface exists to allow additional
+image file formats to be added easily. A photo image is transparent
+in regions where no image data has been supplied.
+
+.SH "CREATING PHOTOS"
+.PP
+Like all images, photos are created using the \fBimage create\fR
+command.
+Photos support the following \fIoptions\fR:
+.TP
+\fB\-data \fIstring\fR
+Specifies the contents of the image as a string. The format of the
+string must be one of those for which there is an image file format
+handler that will accept string data. If both the \fB\-data\fR
+and \fB\-file\fR options are specified, the \fB\-file\fR option takes
+precedence.
+.TP
+\fB\-format \fIformat-name\fR
+Specifies the name of the file format for the data specified with the
+\fB\-data\fR or \fB\-file\fR option.
+.TP
+\fB\-file \fIname\fR
+\fIname\fR gives the name of a file that is to be read to supply data
+for the photo image. The file format must be one of those for which
+there is an image file format handler that can read data.
+.TP
+\fB\-gamma \fIvalue\fR
+Specifies that the colors allocated for displaying this image in a
+window should be corrected for a non-linear display with the specified
+gamma exponent value. (The intensity produced by most
+CRT displays is a power function of the input value, to a good
+approximation; gamma is the exponent and is typically around 2).
+The value specified must be greater than zero. The default
+value is one (no correction). In general, values greater than one
+will make the image lighter, and values less than one will make it
+darker.
+.TP
+\fB\-height \fInumber\fR
+Specifies the height of the image, in pixels. This option is useful
+primarily in situations where the user wishes to build up the contents
+of the image piece by piece. A value of zero (the default) allows the
+image to expand or shrink vertically to fit the data stored in it.
+.TP
+\fB\-palette \fIpalette-spec\fR
+Specifies the resolution of the color cube to be allocated for
+displaying this image, and thus the number of colors used from the
+colormaps of the windows where it is displayed. The
+\fIpalette-spec\fR string may be either a single decimal number,
+specifying the number of shades of gray to use, or three decimal
+numbers separated by slashes (/), specifying the number of shades of
+red, green and blue to use, respectively. If the first form (a single
+number) is used, the image will be displayed in monochrome (i.e.,
+grayscale).
+.TP
+\fB\-width \fInumber\fR
+Specifies the width of the image, in pixels. This option is useful
+primarily in situations where the user wishes to build up the contents
+of the image piece by piece. A value of zero (the default) allows the
+image to expand or shrink horizontally to fit the data stored in it.
+
+.SH "IMAGE COMMAND"
+.PP
+When a photo image is created, Tk also creates a new command
+whose name is the same as the image.
+This command may be used to invoke various operations
+on the image.
+It has the following general form:
+.CS
+\fIimageName option \fR?\fIarg arg ...\fR?
+.CE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command.
+.PP
+Those options that write data to the image generally expand the size
+of the image, if necessary, to accommodate the data written to the
+image, unless the user has specified non-zero values for the
+\fB\-width\fR and/or \fB\-height\fR configuration options, in which
+case the width and/or height, respectively, of the image will not be
+changed.
+.PP
+The following commands are possible for photo images:
+.TP
+\fIimageName \fBblank\fR
+Blank the image; that is, set the entire image to have no data, so it
+will be displayed as transparent, and the background of whatever
+window it is displayed in will show through.
+.TP
+\fIimageName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the
+\fBimage create photo\fR command.
+.TP
+\fIimageName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options for the image.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIimageName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the
+\fBimage create photo\fR command.
+.TP
+\fIimageName \fBcopy\fR \fIsourceImage\fR ?\fIoption value(s) ...\fR?
+Copies a region from the image called \fIsourceImage\fR (which must
+be a photo image) to the image called \fIimageName\fR, possibly with
+pixel zooming and/or subsampling. If no options are specified, this
+command copies the whole of \fIsourceImage\fR into \fIimageName\fR,
+starting at coordinates (0,0) in \fIimageName\fR. The following
+options may be specified:
+.RS
+.TP
+\fB\-from \fIx1 y1 x2 y2\fR
+Specifies a rectangular sub-region of the source image to be copied.
+(\fIx1,y1\fR) and (\fIx2,y2\fR) specify diagonally opposite corners of
+the rectangle. If \fIx2\fR and \fIy2\fR are not specified, the
+default value is the bottom-right corner of the source image. The
+pixels copied will include the left and top edges of the specified
+rectangle but not the bottom or right edges. If the \fB\-from\fR
+option is not given, the default is the whole source image.
+.TP
+\fB\-to \fIx1 y1 x2 y2\fR
+Specifies a rectangular sub-region of the destination image to be
+affected. (\fIx1,y1\fR) and (\fIx2,y2\fR) specify diagonally opposite
+corners of the rectangle. If \fIx2\fR and \fIy2\fR are not specified,
+the default value is (\fIx1,y1\fR) plus the size of the source
+region (after subsampling and zooming, if specified). If \fIx2\fR and
+\fIy2\fR are specified, the source region will be replicated if
+necessary to fill the destination region in a tiled fashion.
+.TP
+\fB\-shrink\fR
+Specifies that the size of the destination image should be reduced, if
+necessary, so that the region being copied into is at the bottom-right
+corner of the image. This option will not affect the width or height
+of the image if the user has specified a non-zero value for the
+\fB\-width\fR or \fB\-height\fR configuration option, respectively.
+.TP
+\fB\-zoom \fIx y\fR
+Specifies that the source region should be magnified by a factor of
+\fIx\fR in the X direction and \fIy\fR in the Y direction. If \fIy\fR
+is not given, the default value is the same as \fIx\fR. With this
+option, each pixel in the source image will be expanded into a block
+of \fIx\fR x \fIy\fR pixels in the destination image, all the same
+color. \fIx\fR and \fIy\fR must be greater than 0.
+.TP
+\fB\-subsample \fIx y\fR
+Specifies that the source image should be reduced in size by using
+only every \fIx\fRth pixel in the X direction and \fIy\fRth pixel in
+the Y direction. Negative values will cause the image to be flipped
+about the Y or X axes, respectively. If \fIy\fR is not given, the
+default value is the same as \fIx\fR.
+.RE
+.TP
+\fIimageName \fBget\fR \fIx y\fR
+Returns the color of the pixel at coordinates (\fIx\fR,\fIy\fR) in the
+image as a list of three integers between 0 and 255, representing the
+red, green and blue components respectively.
+.TP
+\fIimageName \fBput \fIdata\fR ?\fB\-to\fI x1 y1 x2 y2\fR?
+Sets pixels in \fIimageName\fR to the colors specified in \fIdata\fR.
+\fIdata\fR is used to form a two-dimensional array of pixels that are
+then copied into the \fIimageName\fR. \fIdata\fR is structured as a
+list of horizontal rows, from top to bottom, each of which is a list
+of colors, listed from left to right. Each color may be specified by name
+(e.g., blue) or in hexadecimal form (e.g., #2376af). The
+\fB\-to\fR option can be used to specify the area of \fIimageName\fR to be
+affected. If only \fIx1\fR and \fIy1\fR are given, the area affected
+has its top-left corner at (\fIx1,y1\fR) and is the same size as the
+array given in \fIdata\fR. If all four coordinates are given, they
+specify diagonally opposite corners of the affected rectangle, and the
+array given in \fIdata\fR will be replicated as necessary in the X and
+Y directions to fill the rectangle.
+.TP
+\fIimageName \fBread\fR \fIfilename\fR ?\fIoption value(s) ...\fR?
+Reads image data from the file named \fIfilename\fR into the image.
+This command first searches the list of
+image file format handlers for a handler that can interpret the data
+in \fIfilename\fR, and then reads the image in \fIfilename\fR into
+\fIimageName\fR (the destination image). The following options may be
+specified:
+.RS
+.TP
+\fB\-format \fIformat-name\fR
+Specifies the format of the image data in \fIfilename\fR.
+Specifically, only image file format handlers whose names begin with
+\fIformat-name\fR will be used while searching for an image data
+format handler to read the data.
+.TP
+\fB\-from \fIx1 y1 x2 y2\fR
+Specifies a rectangular sub-region of the image file data to be copied
+to the destination image. If only \fIx1\fR and \fIy1\fR are
+specified, the region extends from (\fIx1,y1\fR) to the bottom-right
+corner of the image in the image file. If all four coordinates are
+specified, they specify diagonally opposite corners or the region.
+The default, if this option is not specified, is the whole of the
+image in the image file.
+.TP
+\fB\-shrink\fR
+If this option, the size of \fIimageName\fR will be reduced, if
+necessary, so that the region into which the image file data are read
+is at the bottom-right corner of the \fIimageName\fR. This option
+will not affect the width or height of the image if the user has
+specified a non-zero value for the \fB\-width\fR or \fB\-height\fR
+configuration option, respectively.
+.TP
+\fB\-to \fIx y\fR
+Specifies the coordinates of the top-left corner of the region of
+\fIimageName\fR into which data from \fIfilename\fR are to be read.
+The default is (0,0).
+.RE
+.TP
+\fIimageName \fBredither\fR
+The dithering algorithm used in displaying photo images propagates
+quantization errors from one pixel to its neighbors.
+If the image data for \fIimageName\fR is supplied in pieces, the
+dithered image may not be exactly correct. Normally the difference is
+not noticeable, but if it is a problem, this command can be used to
+recalculate the dithered image in each window where the image is
+displayed.
+.TP
+\fIimageName \fBwrite \fIfilename\fR ?\fIoption value(s) ...\fR?
+Writes image data from \fIimageName\fR to a file named \fIfilename\fR.
+The following options may be specified:
+.RS
+.TP
+\fB\-format\fI format-name\fR
+Specifies the name of the image file format handler to be used to
+write the data to the file. Specifically, this subcommand searches
+for the first handler whose name matches a initial substring of
+\fIformat-name\fR and which has the capability to write an image
+file. If this option is not given, this subcommand uses the first
+handler that has the capability to write an image file.
+.TP
+\fB\-from \fIx1 y1 x2 y2\fR
+Specifies a rectangular region of \fIimageName\fR to be written to the
+image file. If only \fIx1\fR and \fIy1\fR are specified, the region
+extends from \fI(x1,y1)\fR to the bottom-right corner of
+\fIimageName\fR. If all four coordinates are given, they specify
+diagonally opposite corners of the rectangular region. The default,
+if this option is not given, is the whole image.
+.RE
+.SH "IMAGE FORMATS"
+.PP
+The photo image code is structured to allow handlers for additional
+image file formats to be added easily. The photo image code maintains
+a list of these handlers. Handlers are added to the list by
+registering them with a call to \fBTk_CreatePhotoImageFormat\fR. The
+standard Tk distribution comes with handlers for PPM/PGM and GIF formats,
+which are automatically registered on initialization.
+.PP
+When reading an image file or processing
+string data specified with the \fB\-data\fR configuration option, the
+photo image code invokes each handler in turn until one is
+found that claims to be able to read the data in the file or string.
+Usually this will find the correct handler, but if it doesn't, the
+user may give a format name with the \fB\-format\fR option to specify
+which handler to use. In fact the photo image code will try those
+handlers whose names begin with the string specified for the
+\fB\-format\fR option (the comparison is case-insensitive). For
+example, if the user specifies \fB\-format gif\fR, then a handler
+named GIF87 or GIF89 may be invoked, but a handler
+named JPEG may not (assuming that such handlers had been
+registered).
+.PP
+When writing image data to a file, the processing of the
+\fB\-format\fR option is slightly different: the string value given
+for the \fB\-format\fR option must begin with the complete name of the
+requested handler, and may contain additional information following
+that, which the handler can use, for example, to specify which variant
+to use of the formats supported by the handler.
+
+.SH "COLOR ALLOCATION"
+.PP
+When a photo image is displayed in a window, the photo image code
+allocates colors to use to display the image and dithers the image, if
+necessary, to display a reasonable approximation to the image using
+the colors that are available. The colors are allocated as a color
+cube, that is, the number of colors allocated is the product of the
+number of shades of red, green and blue.
+.PP
+Normally, the number of
+colors allocated is chosen based on the depth of the window. For
+example, in an 8-bit PseudoColor window, the photo image code will
+attempt to allocate seven shades of red, seven shades of green and
+four shades of blue, for a total of 198 colors. In a 1-bit StaticGray
+(monochrome) window, it will allocate two colors, black and white. In
+a 24-bit DirectColor or TrueColor window, it will allocate 256 shades
+each of red, green and blue. Fortunately, because of the way that
+pixel values can be combined in DirectColor and TrueColor windows,
+this only requires 256 colors to be allocated. If not all of the
+colors can be allocated, the photo image code reduces the number of
+shades of each primary color and tries again.
+.PP
+The user can exercise some control over the number of colors that a
+photo image uses with the \fB\-palette\fR configuration option. If
+this option is used, it specifies the maximum number of shades of
+each primary color to try to allocate. It can also be used to force
+the image to be displayed in shades of gray, even on a color display,
+by giving a single number rather than three numbers separated by
+slashes.
+
+.SH CREDITS
+.PP
+The photo image type was designed and implemented by Paul Mackerras,
+based on his earlier photo widget and some suggestions from
+John Ousterhout.
+
+.SH KEYWORDS
+photo, image, color
diff --git a/tk/doc/place.n b/tk/doc/place.n
new file mode 100644
index 00000000000..040962a7e58
--- /dev/null
+++ b/tk/doc/place.n
@@ -0,0 +1,237 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBplace \fIwindow option value \fR?\fIoption value ...\fR?
+.sp
+\fBplace configure \fIwindow option value \fR?\fIoption value ...\fR?
+.sp
+\fBplace forget \fIwindow\fR
+.sp
+\fBplace info \fIwindow\fR
+.sp
+\fBplace slaves \fIwindow\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+The placer is a geometry manager for Tk.
+It provides simple fixed placement of windows, where you specify
+the exact size and location of one window, called the \fIslave\fR,
+within another window, called the \fImaster\fR.
+The placer also provides rubber-sheet placement, where you specify the
+size and location of the slave in terms of the dimensions of
+the master, so that the slave changes size and location
+in response to changes in the size of the master.
+Lastly, the placer allows you to mix these styles of placement so
+that, for example, the slave has a fixed width and height but is
+centered inside the master.
+.PP
+If the first argument to the \fBplace\fR command is a window path
+name or \fBconfigure\fR then the command arranges for the placer
+to manage the geometry of a slave whose path name is \fIwindow\fR.
+The remaining arguments consist of one or more \fIoption\-value\fR
+pairs that specify the way in which \fIwindow\fR's
+geometry is managed.
+If the placer is already managing \fIwindow\fR, then the
+\fIoption\-value\fR pairs modify the configuration for \fIwindow\fR.
+In this form the \fBplace\fR command returns an empty string as result.
+The following \fIoption\-value\fR pairs are supported:
+.TP
+\fB\-in \fImaster\fR
+\fIMaster\fR specifes the path name of the window relative
+to which \fIwindow\fR is to be placed.
+\fIMaster\fR must either be \fIwindow\fR's parent or a descendant
+of \fIwindow\fR's parent.
+In addition, \fImaster\fR and \fIwindow\fR must both be descendants
+of the same top-level window.
+These restrictions are necessary to guarantee
+that \fIwindow\fR is visible whenever \fImaster\fR is visible.
+If this option isn't specified then the master defaults to
+\fIwindow\fR's parent.
+.TP
+\fB\-x \fIlocation\fR
+\fILocation\fR specifies the x-coordinate within the master window
+of the anchor point for \fIwindow\fR.
+The location is specified in screen units (i.e. any of the forms
+accepted by \fBTk_GetPixels\fR) and need not lie within the bounds
+of the master window.
+.TP
+\fB\-relx \fIlocation\fR
+\fILocation\fR specifies the x-coordinate within the master window
+of the anchor point for \fIwindow\fR.
+In this case the location is specified in a relative fashion
+as a floating-point number: 0.0 corresponds to the left edge
+of the master and 1.0 corresponds to the right edge of the master.
+\fILocation\fR need not be in the range 0.0\-1.0.
+If both \fB\-x\fR and \fB\-relx\fR are specified for a slave
+then their values are summed. For example, \fB\-relx 0.5 \-x \-2\fR
+positions the left edge of the slave 2 pixels to the left of the
+center of its master.
+.TP
+\fB\-y \fIlocation\fR
+\fILocation\fR specifies the y-coordinate within the master window
+of the anchor point for \fIwindow\fR.
+The location is specified in screen units (i.e. any of the forms
+accepted by \fBTk_GetPixels\fR) and need not lie within the bounds
+of the master window.
+.TP
+\fB\-rely \fIlocation\fR
+\fILocation\fR specifies the y-coordinate within the master window
+of the anchor point for \fIwindow\fR.
+In this case the value is specified in a relative fashion
+as a floating-point number: 0.0 corresponds to the top edge
+of the master and 1.0 corresponds to the bottom edge of the master.
+\fILocation\fR need not be in the range 0.0\-1.0.
+If both \fB\-y\fR and \fB\-rely\fR are specified for a slave
+then their values are summed. For example, \fB\-rely 0.5 \-x 3\fR
+positions the top edge of the slave 3 pixels below the
+center of its master.
+.TP
+\fB\-anchor \fIwhere\fR
+\fIWhere\fR specifies which point of \fIwindow\fR is to be positioned
+at the (x,y) location selected by the \fB\-x\fR, \fB\-y\fR,
+\fB\-relx\fR, and \fB\-rely\fR options.
+The anchor point is in terms of the outer area of \fIwindow\fR
+including its border, if any.
+Thus if \fIwhere\fR is \fBse\fR then the lower-right corner of
+\fIwindow\fR's border will appear at the given (x,y) location
+in the master.
+The anchor position defaults to \fBnw\fR.
+.TP
+\fB\-width \fIsize\fR
+\fISize\fR specifies the width for \fIwindow\fR in screen units
+(i.e. any of the forms accepted by \fBTk_GetPixels\fR).
+The width will be the outer width of \fIwindow\fR including its
+border, if any.
+If \fIsize\fR is an empty string, or if no \fB\-width\fR
+or \fB\-relwidth\fR option is specified, then the width requested
+internally by the window will be used.
+.TP
+\fB\-relwidth \fIsize\fR
+\fISize\fR specifies the width for \fIwindow\fR.
+In this case the width is specified as a floating-point number
+relative to the width of the master: 0.5 means \fIwindow\fR will
+be half as wide as the master, 1.0 means \fIwindow\fR will have
+the same width as the master, and so on.
+If both \fB\-width\fR and \fB\-relwidth\fR are specified for a slave,
+their values are summed. For example, \fB\-relwidth 1.0 \-width 5\fR
+makes the slave 5 pixels wider than the master.
+.TP
+\fB\-height \fIsize\fR
+\fISize\fR specifies the height for \fIwindow\fR in screen units
+(i.e. any of the forms accepted by \fBTk_GetPixels\fR).
+The height will be the outer dimension of \fIwindow\fR including its
+border, if any.
+If \fIsize\fR is an empty string, or if no \fB\-height\fR or
+\fB\-relheight\fR option is specified, then the height requested
+internally by the window will be used.
+.TP
+\fB\-relheight \fIsize\fR
+\fISize\fR specifies the height for \fIwindow\fR.
+In this case the height is specified as a floating-point number
+relative to the height of the master: 0.5 means \fIwindow\fR will
+be half as high as the master, 1.0 means \fIwindow\fR will have
+the same height as the master, and so on.
+If both \fB\-height\fR and \fB\-relheight\fR are specified for a slave,
+their values are summed. For example, \fB\-relheight 1.0 \-height \-2\fR
+makes the slave 2 pixels shorter than the master.
+.TP
+\fB\-bordermode \fImode\fR
+\fIMode\fR determines the degree to which borders within the
+master are used in determining the placement of the slave.
+The default and most common value is \fBinside\fR.
+In this case the placer considers the area of the master to
+be the innermost area of the master, inside any border:
+an option of \fB\-x 0\fR corresponds to an x-coordinate just
+inside the border and an option of \fB\-relwidth 1.0\fR
+means \fIwindow\fR will fill the area inside the master's
+border.
+If \fImode\fR is \fBoutside\fR then the placer considers
+the area of the master to include its border;
+this mode is typically used when placing \fIwindow\fR
+outside its master, as with the options \fB\-x 0 \-y 0 \-anchor ne\fR.
+Lastly, \fImode\fR may be specified as \fBignore\fR, in which
+case borders are ignored: the area of the master is considered
+to be its official X area, which includes any internal border but
+no external border. A bordermode of \fBignore\fR is probably
+not very useful.
+.PP
+If the same value is specified separately with
+two different options, such as \fB\-x\fR and \fB\-relx\fR, then
+the most recent option is used and the older one is ignored.
+.PP
+The \fBplace slaves\fR command returns a list of all the slave
+windows for which \fIwindow\fR is the master.
+If there are no slaves for \fIwindow\fR then an empty string is
+returned.
+.PP
+The \fBplace forget\fR command causes the placer to stop managing
+the geometry of \fIwindow\fR. As a side effect of this command
+\fIwindow\fR will be unmapped so that it doesn't appear on the
+screen.
+If \fIwindow\fR isn't currently managed by the placer then the
+command has no effect.
+\fBPlace forget\fR returns an empty string as result.
+.PP
+The \fBplace info\fR command returns a list giving the current
+configuration of \fIwindow\fR.
+The list consists of \fIoption\-value\fR pairs in exactly the
+same form as might be specified to the \fBplace configure\fR
+command.
+If the configuration of a window has been retrieved with
+\fBplace info\fR, that configuration can be restored later by
+first using \fBplace forget\fR to erase any existing information
+for the window and then invoking \fBplace configure\fR with
+the saved information.
+
+.SH "FINE POINTS"
+.PP
+It is not necessary for the master window to be the parent
+of the slave window.
+This feature is useful in at least two situations.
+First, for complex window layouts it means you can create a
+hierarchy of subwindows whose only purpose
+is to assist in the layout of the parent.
+The ``real children'' of the parent (i.e. the windows that
+are significant for the application's user interface) can be
+children of the parent yet be placed inside the windows
+of the geometry-management hierarchy.
+This means that the path names of the ``real children''
+don't reflect the geometry-management hierarchy and users
+can specify options for the real children
+without being aware of the structure of the geometry-management
+hierarchy.
+.PP
+A second reason for having a master different than the slave's
+parent is to tie two siblings together.
+For example, the placer can be used to force a window always to
+be positioned centered just below one of its
+siblings by specifying the configuration
+.CS
+\fB\-in \fIsibling\fB \-relx 0.5 \-rely 1.0 \-anchor n \-bordermode outside\fR
+.CE
+Whenever the sibling is repositioned in the future, the slave
+will be repositioned as well.
+.PP
+Unlike many other geometry managers (such as the packer)
+the placer does not make any attempt to manipulate the geometry of
+the master windows or the parents of slave windows (i.e. it doesn't
+set their requested sizes).
+To control the sizes of these windows, make them windows like
+frames and canvases that provide configuration options for this purpose.
+
+.SH KEYWORDS
+geometry manager, height, location, master, place, rubber sheet, slave, width
diff --git a/tk/doc/popup.n b/tk/doc/popup.n
new file mode 100644
index 00000000000..8f574c85ead
--- /dev/null
+++ b/tk/doc/popup.n
@@ -0,0 +1,33 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBtk_popup \fImenu x y \fR?\fIentry\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This procedure posts a menu at a given position on the screen and
+configures Tk so that the menu and its cascaded children can be
+traversed with the mouse or the keyboard.
+\fIMenu\fR is the name of a menu widget and \fIx\fR and \fIy\fR
+are the root coordinates at which to display the menu.
+If \fIentry\fR is omitted or an empty string, the
+menu's upper left corner is positioned at the given point.
+Otherwise \fIentry\fR gives the index of an entry in \fImenu\fR and
+the menu will be positioned so that the entry is positioned over
+the given point.
+
+.SH KEYWORDS
+menu, popup
diff --git a/tk/doc/radiobutton.n b/tk/doc/radiobutton.n
new file mode 100644
index 00000000000..7b32b8dc62d
--- /dev/null
+++ b/tk/doc/radiobutton.n
@@ -0,0 +1,233 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBradiobutton\fR \fIpathName \fR?\fIoptions\fR?
+.SO
+\-activebackground \-cursor \-highlightthickness \-takefocus
+\-activeforeground \-disabledforeground \-image \-text
+\-anchor \-font \-justify \-textvariable
+\-background \-foreground \-padx \-underline
+\-bitmap \-highlightbackground \-pady \-wraplength
+\-borderwidth \-highlightcolor \-relief
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-command command Command
+Specifies a Tcl command to associate with the button. This command
+is typically invoked when mouse button 1 is released over the button
+window. The button's global variable (\fB\-variable\fR option) will
+be updated before the command is invoked.
+.OP \-height height Height
+Specifies a desired height for the button.
+If an image or bitmap is being displayed in the button then the value is in
+screen units (i.e. any of the forms acceptable to \fBTk_GetPixels\fR);
+for text it is in lines of text.
+If this option isn't specified, the button's desired height is computed
+from the size of the image or bitmap or text being displayed in it.
+.OP \-indicatoron indicatorOn IndicatorOn
+Specifies whether or not the indicator should be drawn. Must be a
+proper boolean value. If false, the \fBrelief\fR option is
+ignored and the widget's relief is always sunken if the widget is
+selected and raised otherwise.
+.OP \-selectcolor selectColor Background
+Specifies a background color to use when the button is selected.
+If \fBindicatorOn\fR is true then the color applies to the indicator.
+Under Windows, this color is used as the background for the indicator
+regardless of the select state.
+If \fBindicatorOn\fR is false, this color is used as the background
+for the entire widget, in place of \fBbackground\fR or \fBactiveBackground\fR,
+whenever the widget is selected.
+If specified as an empty string then no special color is used for
+displaying when the widget is selected.
+.OP \-selectimage selectImage SelectImage
+Specifies an image to display (in place of the \fBimage\fR option)
+when the radiobutton is selected.
+This option is ignored unless the \fBimage\fR option has been
+specified.
+.OP \-state state State
+Specifies one of three states for the radiobutton: \fBnormal\fR, \fBactive\fR,
+or \fBdisabled\fR. In normal state the radiobutton is displayed using the
+\fBforeground\fR and \fBbackground\fR options. The active state is
+typically used when the pointer is over the radiobutton. In active state
+the radiobutton is displayed using the \fBactiveForeground\fR and
+\fBactiveBackground\fR options. Disabled state means that the radiobutton
+should be insensitive: the default bindings will refuse to activate
+the widget and will ignore mouse button presses.
+In this state the \fBdisabledForeground\fR and
+\fBbackground\fR options determine how the radiobutton is displayed.
+.OP \-value value Value
+Specifies value to store in the button's associated variable whenever
+this button is selected.
+.OP \-variable variable Variable
+Specifies name of global variable to set whenever this button is
+selected. Changes in this variable also cause the button to select
+or deselect itself.
+Defaults to the value \fBselectedButton\fR.
+.OP \-width width Width
+Specifies a desired width for the button.
+If an image or bitmap is being displayed in the button, the value is in
+screen units (i.e. any of the forms acceptable to \fBTk_GetPixels\fR);
+for text it is in characters.
+If this option isn't specified, the button's desired width is computed
+from the size of the image or bitmap or text being displayed in it.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBradiobutton\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a radiobutton widget.
+Additional
+options, described above, may be specified on the command line
+or in the option database
+to configure aspects of the radiobutton such as its colors, font,
+text, and initial relief. The \fBradiobutton\fR command returns its
+\fIpathName\fR argument. At the time this command is invoked,
+there must not exist a window named \fIpathName\fR, but
+\fIpathName\fR's parent must exist.
+.PP
+.VS
+A radiobutton is a widget that displays a textual string, bitmap or image
+and a diamond or circle called an \fIindicator\fR.
+.VE
+If text is displayed, it must all be in a single font, but it
+can occupy multiple lines on the screen (if it contains newlines
+or if wrapping occurs because of the \fBwrapLength\fR option) and
+one of the characters may optionally be underlined using the
+\fBunderline\fR option. A radiobutton has
+all of the behavior of a simple button: it can display itself in either
+of three different ways, according to the \fBstate\fR option;
+it can be made to appear
+raised, sunken, or flat; it can be made to flash; and it invokes
+a Tcl command whenever mouse button 1 is clicked over the
+check button.
+.PP
+In addition, radiobuttons can be \fIselected\fR.
+If a radiobutton is selected, the indicator is normally
+.VS
+drawn with a selected appearance, and
+a Tcl variable associated with the radiobutton is set to a particular
+value (normally 1).
+Under Unix, the indicator is drawn with a sunken relief and a special
+color. Under Windows, the indicator is drawn with a round mark inside.
+If the radiobutton is not selected, then the indicator is drawn with a
+deselected appearance, and the associated variable is
+set to a different value (typically 0).
+Under Unix, the indicator is drawn with a raised relief and no special
+color. Under Windows, the indicator is drawn without a round mark inside.
+.VE
+Typically, several radiobuttons share a single variable and the
+value of the variable indicates which radiobutton is to be selected.
+When a radiobutton is selected it sets the value of the variable to
+indicate that fact; each radiobutton also monitors the value of
+the variable and automatically selects and deselects itself when the
+variable's value changes.
+By default the variable \fBselectedButton\fR
+is used; its contents give the name of the button that is
+selected, or the empty string if no button associated with that
+variable is selected.
+The name of the variable for a radiobutton,
+plus the variable to be stored into it, may be modified with options
+on the command line or in the option database.
+Configuration options may also be used to modify the way the
+indicator is displayed (or whether it is displayed at all).
+By default a radiobutton is configured to select itself on button clicks.
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBradiobutton\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.CS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.CE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for radiobutton widgets:
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBradiobutton\fR
+command.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBradiobutton\fR
+command.
+.TP
+\fIpathName \fBdeselect\fR
+Deselects the radiobutton and sets the associated variable to an
+empty string.
+If this radiobutton was not currently selected, the command has
+no effect.
+.TP
+\fIpathName \fBflash\fR
+Flashes the radiobutton. This is accomplished by redisplaying the radiobutton
+several times, alternating between active and normal colors. At
+the end of the flash the radiobutton is left in the same normal/active
+state as when the command was invoked.
+This command is ignored if the radiobutton's state is \fBdisabled\fR.
+.TP
+\fIpathName \fBinvoke\fR
+Does just what would have happened if the user invoked the radiobutton
+with the mouse: selects the button and invokes
+its associated Tcl command, if there is one.
+The return value is the return value from the Tcl command, or an
+empty string if there is no command associated with the radiobutton.
+This command is ignored if the radiobutton's state is \fBdisabled\fR.
+.TP
+\fIpathName \fBselect\fR
+Selects the radiobutton and sets the associated variable to the
+value corresponding to this widget.
+
+.SH BINDINGS
+.PP
+Tk automatically creates class bindings for radiobuttons that give them
+the following default behavior:
+.VS
+.IP [1]
+On Unix systems, a radiobutton activates whenever the mouse passes
+over it and deactivates whenever the mouse leaves the radiobutton. On
+Mac and Windows systems, when mouse button 1 is pressed over a
+radiobutton, the button activates whenever the mouse pointer is inside
+the button, and deactivates whenever the mouse pointer leaves the
+button.
+.VE
+.IP [2]
+When mouse button 1 is pressed over a radiobutton it is invoked (it
+becomes selected and the command associated with the button is
+invoked, if there is one).
+.IP [3]
+When a radiobutton has the input focus, the space key causes the radiobutton
+to be invoked.
+.PP
+If the radiobutton's state is \fBdisabled\fR then none of the above
+actions occur: the radiobutton is completely non-responsive.
+.PP
+The behavior of radiobuttons can be changed by defining new bindings for
+individual widgets or by redefining the class bindings.
+
+.SH KEYWORDS
+radiobutton, widget
diff --git a/tk/doc/raise.n b/tk/doc/raise.n
new file mode 100644
index 00000000000..550e0914eba
--- /dev/null
+++ b/tk/doc/raise.n
@@ -0,0 +1,38 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBraise \fIwindow \fR?\fIaboveThis\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+If the \fIaboveThis\fR argument is omitted then the command raises
+\fIwindow\fR so that it is above all of its siblings in the stacking
+order (it will not be obscured by any siblings and will obscure
+any siblings that overlap it).
+If \fIaboveThis\fR is specified then it must be the path name of
+a window that is either a sibling of \fIwindow\fR or the descendant
+of a sibling of \fIwindow\fR.
+In this case the \fBraise\fR command will insert
+\fIwindow\fR into the stacking order just above \fIaboveThis\fR
+(or the ancestor of \fIaboveThis\fR that is a sibling of \fIwindow\fR);
+this could end up either raising or lowering \fIwindow\fR.
+
+.SH "SEE ALSO"
+lower
+
+.SH KEYWORDS
+obscure, raise, stacking order
diff --git a/tk/doc/scale.n b/tk/doc/scale.n
new file mode 100644
index 00000000000..720971a97bc
--- /dev/null
+++ b/tk/doc/scale.n
@@ -0,0 +1,246 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBscale\fR \fIpathName \fR?\fIoptions\fR?
+.SO
+\-activebackground \-font \-highlightthickness \-repeatinterval
+\-background \-foreground \-orient \-takefocus
+\-borderwidth \-highlightbackground \-relief \-troughcolor
+\-cursor \-highlightcolor \-repeatdelay
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-bigincrement bigIncrement BigIncrement
+Some interactions with the scale cause its value to change by
+``large'' increments; this option specifies the size of the
+large increments. If specified as 0, the large increments default
+to 1/10 the range of the scale.
+.OP \-command command Command
+Specifies the prefix of a Tcl command to invoke whenever the scale's
+value is changed via a widget command.
+The actual command consists
+of this option followed by a space and a real number indicating the
+new value of the scale.
+.OP \-digits digits Digits
+An integer specifying how many significant digits should be retained
+when converting the value of the scale to a string.
+If the number is less than or equal to zero, then the scale picks
+the smallest value that guarantees that every possible slider
+position prints as a different string.
+.OP \-from from From
+A real value corresponding to the left or top end of the scale.
+.OP \-label label Label
+A string to display as a label for the scale. For
+vertical scales the label is displayed just to the right of the
+top end of the scale. For horizontal scales the label is displayed
+just above the left end of the scale. If the option is specified
+as an empty string, no label is displayed.
+.OP \-length length Length
+Specifies the desired long dimension of the scale in screen units
+(i.e. any of the forms acceptable to \fBTk_GetPixels\fR).
+For vertical scales this is the scale's height; for horizontal scales
+it is the scale's width.
+.OP \-resolution resolution Resolution
+A real value specifying the resolution for the scale.
+If this value is greater than zero then the scale's value will always be
+rounded to an even multiple of this value, as will tick marks and
+the endpoints of the scale. If the value is less than zero then no
+rounding occurs. Defaults to 1 (i.e., the value will be integral).
+.OP \-showvalue showValue ShowValue
+Specifies a boolean value indicating whether or not the current
+value of the scale is to be displayed.
+.OP \-sliderlength sliderLength SliderLength
+Specfies the size of the slider, measured in screen units along the slider's
+long dimension. The value may be specified in any of the forms acceptable
+to \fBTk_GetPixels\fR.
+.OP \-sliderrelief sliderRelief SliderRelief
+Specifies the relief to use when drawing the slider, such as \fBraised\fR
+or \fBsunken\fR.
+.OP \-state state State
+Specifies one of three states for the scale: \fBnormal\fR,
+\fBactive\fR, or \fBdisabled\fR.
+If the scale is disabled then the value may not be changed and the scale
+won't activate.
+If the scale is active, the slider is displayed using the color
+specified by the \fBactiveBackground\fR option.
+.OP \-tickinterval tickInterval TickInterval
+Must be a real value.
+Determines the spacing between numerical
+tick marks displayed below or to the left of the slider.
+If 0, no tick marks will be displayed.
+.OP \-to to To
+Specifies a real value corresponding
+to the right or bottom end of the scale.
+This value may be either less than or greater than the \fBfrom\fR option.
+.OP \-variable variable Variable
+Specifies the name of a global variable to link to the scale. Whenever the
+value of the variable changes, the scale will update to reflect this
+value.
+Whenever the scale is manipulated interactively, the variable
+will be modified to reflect the scale's new value.
+.OP \-width width Width
+Specifies the desired narrow dimension of the trough in screen units
+(i.e. any of the forms acceptable to \fBTk_GetPixels\fR).
+For vertical scales this is the trough's width; for horizontal scales
+this is the trough's height.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBscale\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a scale widget.
+Additional
+options, described above, may be specified on the command line
+or in the option database
+to configure aspects of the scale such as its colors, orientation,
+and relief. The \fBscale\fR command returns its
+\fIpathName\fR argument. At the time this command is invoked,
+there must not exist a window named \fIpathName\fR, but
+\fIpathName\fR's parent must exist.
+.PP
+A scale is a widget that displays a rectangular \fItrough\fR and a
+small \fIslider\fR. The trough corresponds to a range
+of real values (determined by the \fBfrom\fR, \fBto\fR, and
+\fBresolution\fR options),
+and the position of the slider selects a particular real value.
+The slider's position (and hence the scale's value) may be adjusted
+with the mouse or keyboard as described in the BINDINGS
+section below. Whenever the scale's value is changed, a Tcl
+command is invoked (using the \fBcommand\fR option) to notify
+other interested widgets of the change.
+In addition, the value
+of the scale can be linked to a Tcl variable (using the \fBvariable\fR
+option), so that changes in either are reflected in the other.
+.PP
+Three annotations may be displayed in a scale widget: a label
+appearing at the top right of the widget (top left for horizontal
+scales), a number displayed just to the left of the slider
+(just above the slider for horizontal scales), and a collection
+of numerical tick marks just to the left of the current value
+(just below the trough for horizontal scales). Each of these three
+annotations may be enabled or disabled using the
+configuration options.
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBscale\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.CS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.CE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for scale widgets:
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBscale\fR
+command.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBscale\fR
+command.
+.TP
+\fIpathName \fBcoords \fR?\fIvalue\fR?
+Returns a list whose elements are the x and y coordinates of
+the point along the centerline of the trough that corresponds
+to \fIvalue\fR.
+If \fIvalue\fR is omitted then the scale's current value is used.
+.TP
+\fIpathName \fBget\fR ?\fIx y\fR?
+If \fIx\fR and \fIy\fR are omitted, returns the current value
+of the scale. If \fIx\fR and \fIy\fR are specified, they give
+pixel coordinates within the widget; the command returns
+the scale value corresponding to the given pixel.
+Only one of \fIx\fR or \fIy\fR is used: for horizontal scales
+\fIy\fR is ignored, and for vertical scales \fIx\fR is ignored.
+.TP
+\fIpathName \fBidentify\fR \fIx y\fR
+Returns a string indicating what part of the scale lies under
+the coordinates given by \fIx\fR and \fIy\fR.
+A return value of \fBslider\fR means that the point is over
+the slider; \fBtrough1\fR means that the point is over the
+portion of the slider above or to the left of the slider;
+and \fBtrough2\fR means that the point is over the portion
+of the slider below or to the right of the slider.
+If the point isn't over one of these elements, an empty string
+is returned.
+.TP
+\fIpathName \fBset\fR \fIvalue\fR
+This command is invoked to change the current value of the scale,
+and hence the position at which the slider is displayed. \fIValue\fR
+gives the new value for the scale.
+The command has no effect if the scale is disabled.
+
+.SH BINDINGS
+.PP
+Tk automatically creates class bindings for scales that give them
+the following default behavior.
+Where the behavior is different for vertical and horizontal scales,
+the horizontal behavior is described in parentheses.
+.IP [1]
+If button 1 is pressed in the trough, the scale's value will
+be incremented or decremented by the value of the \fBresolution\fR
+option so that the slider moves in the direction of the cursor.
+If the button is held down, the action auto-repeats.
+.IP [2]
+If button 1 is pressed over the slider, the slider can be dragged
+with the mouse.
+.IP [3]
+If button 1 is pressed in the trough with the Control key down,
+the slider moves all the way to the end of its range, in the
+direction towards the mouse cursor.
+.IP [4]
+If button 2 is pressed, the scale's value is set to the mouse
+position. If the mouse is dragged with button 2 down, the scale's
+value changes with the drag.
+.IP [5]
+The Up and Left keys move the slider up (left) by the value
+of the \fBresolution\fR option.
+.IP [6]
+The Down and Right keys move the slider down (right) by the value
+of the \fBresolution\fR option.
+.IP [7]
+Control-Up and Control-Left move the slider up (left) by the
+value of the \fBbigIncrement\fR option.
+.IP [8]
+Control-Down and Control-Right move the slider down (right) by the
+value of the \fBbigIncrement\fR option.
+.IP [9]
+Home moves the slider to the top (left) end of its range.
+.IP [10]
+End moves the slider to the bottom (right) end of its range.
+.PP
+If the scale is disabled using the \fBstate\fR option then
+none of the above bindings have any effect.
+.PP
+The behavior of scales can be changed by defining new bindings for
+individual widgets or by redefining the class bindings.
+
+.SH KEYWORDS
+scale, slider, trough, widget
diff --git a/tk/doc/scrollbar.n b/tk/doc/scrollbar.n
new file mode 100644
index 00000000000..73cc0b767d8
--- /dev/null
+++ b/tk/doc/scrollbar.n
@@ -0,0 +1,340 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBscrollbar\fR \fIpathName \fR?\fIoptions\fR?
+.SO
+\-activebackground \-highlightbackground \-orient \-takefocus
+\-background \-highlightcolor \-relief \-troughcolor
+\-borderwidth \-highlightthickness \-repeatdelay
+\-cursor \-jump \-repeatinterval
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-activerelief activeRelief ActiveRelief
+Specifies the relief to use when displaying the element that is
+active, if any.
+Elements other than the active element are always displayed with
+a raised relief.
+.OP \-command command Command
+Specifies the prefix of a Tcl command to invoke to change the view
+in the widget associated with the scrollbar. When a user requests
+a view change by manipulating the scrollbar, a Tcl command is
+invoked. The actual command consists of this option followed by
+additional information as described later. This option almost always has
+a value such as \fB.t xview\fR or \fB.t yview\fR, consisting of the
+name of a widget and either \fBxview\fR (if the scrollbar is for
+horizontal scrolling) or \fByview\fR (for vertical scrolling).
+All scrollable widgets have \fBxview\fR and \fByview\fR commands
+that take exactly the additional arguments appended by the scrollbar
+as described in SCROLLING COMMANDS below.
+.OP \-elementborderwidth elementBorderWidth BorderWidth
+Specifies the width of borders drawn around the internal elements
+of the scrollbar (the two arrows and the slider). The value may
+have any of the forms acceptable to \fBTk_GetPixels\fR.
+If this value is less than zero, the value of the \fBborderWidth\fR
+option is used in its place.
+.OP \-width width Width
+Specifies the desired narrow dimension of the scrollbar window,
+not including 3-D border, if any. For vertical
+scrollbars this will be the width and for horizontal scrollbars
+this will be the height.
+The value may have any of the forms acceptable to \fBTk_GetPixels\fR.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBscrollbar\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a scrollbar widget.
+Additional options, described above, may be specified on the command
+line or in the option database to configure aspects of the scrollbar
+such as its colors, orientation, and relief.
+The \fBscrollbar\fR command returns its \fIpathName\fR argument.
+At the time this command is invoked, there must not exist a window
+named \fIpathName\fR, but \fIpathName\fR's parent must exist.
+.PP
+A scrollbar is a widget that displays two arrows, one at each end of
+the scrollbar, and a \fIslider\fR in the middle portion of the
+scrollbar.
+It provides information about what is visible in an \fIassociated window\fR
+that displays an document of some sort (such as a file being edited or
+a drawing).
+The position and size of the slider indicate which portion of the
+document is visible in the associated window. For example, if the
+slider in a vertical scrollbar covers the top third of the area
+between the two arrows, it means that the associated window displays
+the top third of its document.
+.PP
+Scrollbars can be used to adjust the view in the associated window
+by clicking or dragging with the mouse. See the BINDINGS section
+below for details.
+
+.SH "ELEMENTS"
+.PP
+A scrollbar displays five elements, which are referred to in the
+widget commands for the scrollbar:
+.TP 10
+\fBarrow1\fR
+The top or left arrow in the scrollbar.
+.TP 10
+\fBtrough1\fR
+The region between the slider and \fBarrow1\fR.
+.TP 10
+\fBslider\fR
+The rectangle that indicates what is visible in the associated widget.
+.TP 10
+\fBtrough2\fR
+The region between the slider and \fBarrow2\fR.
+.TP 10
+\fBarrow2\fR
+The bottom or right arrow in the scrollbar.
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBscrollbar\fR command creates a new Tcl command whose
+name is \fIpathName\fR. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.CS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.CE
+\fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for scrollbar widgets:
+.TP
+\fIpathName \fBactivate \fR?\fIelement\fR?
+Marks the element indicated by \fIelement\fR as active, which
+causes it to be displayed as specified by the \fBactiveBackground\fR
+and \fBactiveRelief\fR options.
+The only element values understood by this command are \fBarrow1\fR,
+\fBslider\fR, or \fBarrow2\fR.
+If any other value is specified then no element of the scrollbar
+will be active.
+If \fIelement\fR is not specified, the command returns
+the name of the element that is currently active, or an empty string
+if no element is active.
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBscrollbar\fR
+command.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBscrollbar\fR
+command.
+.TP
+\fIpathName \fBdelta \fIdeltaX deltaY\fR
+Returns a real number indicating the fractional change in
+the scrollbar setting that corresponds to a given change
+in slider position. For example, if the scrollbar is horizontal,
+the result indicates how much the scrollbar setting must change
+to move the slider \fIdeltaX\fR pixels to the right (\fIdeltaY\fR is
+ignored in this case).
+If the scrollbar is vertical, the result indicates how much the
+scrollbar setting must change to move the slider \fIdeltaY\fR pixels
+down. The arguments and the result may be zero or negative.
+.TP
+\fIpathName \fBfraction \fIx y\fR
+Returns a real number between 0 and 1 indicating where the point
+given by \fIx\fR and \fIy\fR lies in the trough area of the scrollbar.
+The value 0 corresponds to the top or left of the trough, the
+value 1 corresponds to the bottom or right, 0.5 corresponds to
+the middle, and so on.
+\fIX\fR and \fIy\fR must be pixel coordinates relative to the scrollbar
+widget.
+If \fIx\fR and \fIy\fR refer to a point outside the trough, the closest
+point in the trough is used.
+.TP
+\fIpathName \fBget\fR
+Returns the scrollbar settings in the form of a list whose
+elements are the arguments to the most recent \fBset\fR widget command.
+.TP
+\fIpathName \fBidentify\fR \fIx y\fR
+Returns the name of the element under the point given by \fIx\fR and
+\fIy\fR (such as \fBarrow1\fR), or an empty string if the point does
+not lie in any element of the scrollbar.
+\fIX\fR and \fIy\fR must be pixel coordinates relative to the scrollbar
+widget.
+.TP
+\fIpathName \fBset\fR \fIfirst last\fR
+This command is invoked by the scrollbar's associated widget to
+tell the scrollbar about the current view in the widget.
+The command takes two arguments, each of which is a real fraction
+between 0 and 1.
+The fractions describe the range of the document that is visible in
+the associated widget.
+For example, if \fIfirst\fR is 0.2 and \fIlast\fR is 0.4, it means
+that the first part of the document visible in the window is 20%
+of the way through the document, and the last visible part is 40%
+of the way through.
+
+.SH "SCROLLING COMMANDS"
+.PP
+When the user interacts with the scrollbar, for example by dragging
+the slider, the scrollbar notifies the associated widget that it
+must change its view.
+The scrollbar makes the notification by evaluating a Tcl command
+generated from the scrollbar's \fB\-command\fR option.
+The command may take any of the following forms.
+In each case, \fIprefix\fR is the contents of the
+\fB\-command\fR option, which usually has a form like \fB.t yview\fR
+.TP
+\fIprefix \fBmoveto \fIfraction\fR
+\fIFraction\fR is a real number between 0 and 1.
+The widget should adjust its view so that the point given
+by \fIfraction\fR appears at the beginning of the widget.
+If \fIfraction\fR is 0 it refers to the beginning of the
+document. 1.0 refers to the end of the document, 0.333
+refers to a point one-third of the way through the document,
+and so on.
+.TP
+\fIprefix \fBscroll \fInumber \fBunits\fR
+The widget should adjust its view by \fInumber\fR units.
+The units are defined in whatever way makes sense for the widget,
+such as characters or lines in a text widget.
+\fINumber\fR is either 1, which means one unit should scroll off
+the top or left of the window, or \-1, which means that one unit
+should scroll off the bottom or right of the window.
+.TP
+\fIprefix \fBscroll \fInumber \fBpages\fR
+The widget should adjust its view by \fInumber\fR pages.
+It is up to the widget to define the meaning of a page; typically
+it is slightly less than what fits in the window, so that there
+is a slight overlap between the old and new views.
+\fINumber\fR is either 1, which means the next page should
+become visible, or \-1, which means that the previous page should
+become visible.
+
+.SH "OLD COMMAND SYNTAX"
+.PP
+In versions of Tk before 4.0, the \fBset\fR and \fBget\fR widget
+commands used a different form.
+This form is still supported for backward compatibility, but it
+is deprecated.
+In the old command syntax, the \fBset\fR widget command has the
+following form:
+.TP
+\fIpathName \fBset\fR \fItotalUnits windowUnits firstUnit lastUnit\fR
+In this form the arguments are all integers.
+\fITotalUnits\fR gives the total size of the object being displayed in the
+associated widget. The meaning of one unit depends on the associated
+widget; for example, in a text editor widget units might
+correspond to lines of
+text. \fIWindowUnits\fR indicates the total number of units that
+can fit in the associated window at one time. \fIFirstUnit\fR
+and \fIlastUnit\fR give the indices of the first and last units
+currently visible in the associated window (zero corresponds to the
+first unit of the object).
+.LP
+Under the old syntax the \fBget\fR widget command returns a list
+of four integers, consisting of the \fItotalUnits\fR, \fIwindowUnits\fR,
+\fIfirstUnit\fR, and \fIlastUnit\fR values from the last \fBset\fR
+widget command.
+.PP
+The commands generated by scrollbars also have a different form
+when the old syntax is being used:
+.TP
+\fIprefix\fR \fIunit\fR
+\fIUnit\fR is an integer that indicates what should appear at
+the top or left of the associated widget's window.
+It has the same meaning as the \fIfirstUnit\fR and \fIlastUnit\fR
+arguments to the \fBset\fR widget command.
+.LP
+The most recent \fBset\fR widget command determines whether or not
+to use the old syntax.
+If it is given two real arguments then the new syntax will be
+used in the future, and if it is given four integer arguments then
+the old syntax will be used.
+
+.SH BINDINGS
+Tk automatically creates class bindings for scrollbars that give them
+the following default behavior.
+If the behavior is different for vertical and horizontal scrollbars,
+the horizontal behavior is described in parentheses.
+
+.IP [1]
+Pressing button 1 over \fBarrow1\fR causes the view in the
+associated widget to shift up (left) by one unit so that the
+document appears to move down (right) one unit.
+If the button is held down, the action auto-repeats.
+.IP [2]
+Pressing button 1 over \fBtrough1\fR causes the view in the
+associated widget to shift up (left) by one screenful so that the
+document appears to move down (right) one screenful.
+If the button is held down, the action auto-repeats.
+.IP [3]
+Pressing button 1 over the slider and dragging causes the view
+to drag with the slider.
+If the \fBjump\fR option is true, then the view doesn't drag along
+with the slider; it changes only when the mouse button is released.
+.IP [4]
+Pressing button 1 over \fBtrough2\fR causes the view in the
+associated widget to shift down (right) by one screenful so that the
+document appears to move up (left) one screenful.
+If the button is held down, the action auto-repeats.
+.IP [5]
+Pressing button 1 over \fBarrow2\fR causes the view in the
+associated widget to shift down (right) by one unit so that the
+document appears to move up (left) one unit.
+If the button is held down, the action auto-repeats.
+.IP [6]
+If button 2 is pressed over the trough or the slider, it sets
+the view to correspond to the mouse position; dragging the
+mouse with button 2 down causes the view to drag with the mouse.
+If button 2 is pressed over one of the arrows, it causes the
+same behavior as pressing button 1.
+.IP [7]
+If button 1 is pressed with the Control key down, then if the
+mouse is over \fBarrow1\fR or \fBtrough1\fR the view changes
+to the very top (left) of the document; if the mouse is over
+\fBarrow2\fR or \fBtrough2\fR the view changes
+to the very bottom (right) of the document; if the mouse is
+anywhere else then the button press has no effect.
+.IP [8]
+In vertical scrollbars the Up and Down keys have the same behavior
+as mouse clicks over \fBarrow1\fR and \fBarrow2\fR, respectively.
+In horizontal scrollbars these keys have no effect.
+.IP [9]
+In vertical scrollbars Control-Up and Control-Down have the same
+behavior as mouse clicks over \fBtrough1\fR and \fBtrough2\fR, respectively.
+In horizontal scrollbars these keys have no effect.
+.IP [10]
+In horizontal scrollbars the Up and Down keys have the same behavior
+as mouse clicks over \fBarrow1\fR and \fBarrow2\fR, respectively.
+In vertical scrollbars these keys have no effect.
+.IP [11]
+In horizontal scrollbars Control-Up and Control-Down have the same
+behavior as mouse clicks over \fBtrough1\fR and \fBtrough2\fR, respectively.
+In vertical scrollbars these keys have no effect.
+.IP [12]
+The Prior and Next keys have the same behavior
+as mouse clicks over \fBtrough1\fR and \fBtrough2\fR, respectively.
+.IP [13]
+The Home key adjusts the view to the top (left edge) of the document.
+.IP [14]
+The End key adjusts the view to the bottom (right edge) of the document.
+
+.SH KEYWORDS
+scrollbar, widget
diff --git a/tk/doc/selection.n b/tk/doc/selection.n
new file mode 100644
index 00000000000..e25af000fac
--- /dev/null
+++ b/tk/doc/selection.n
@@ -0,0 +1,128 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBselection \fIoption\fR ?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command provides a Tcl interface to the X selection mechanism and
+implements the full selection functionality described in the
+X Inter-Client Communication Conventions Manual (ICCCM).
+.PP
+The first argument to \fBselection\fR determines the format of the
+rest of the arguments and the behavior of the command. The following
+forms are currently supported:
+.PP
+.TP
+\fBselection clear\fR ?\fB\-displayof\fR \fIwindow\fR? ?\fB\-selection\fR \fIselection\fR?
+If \fIselection\fR exists anywhere on \fIwindow\fR's display, clear it
+so that no window owns the selection anymore. \fISelection\fR
+specifies the X selection that should be cleared, and should be an
+atom name such as PRIMARY or CLIPBOARD; see the Inter-Client
+Communication Conventions Manual for complete details.
+\fISelection\fR defaults to PRIMARY and \fIwindow\fR defaults to ``.''.
+Returns an empty string.
+.TP
+\fBselection get\fR ?\fB\-displayof\fR \fIwindow\fR? ?\fB\-selection\fR \fIselection\fR? ?\fB\-type\fR \fItype\fR?
+Retrieves the value of \fIselection\fR from \fIwindow\fR's display and
+returns it as a result. \fISelection\fR defaults to PRIMARY and
+\fIwindow\fR defaults to ``.''.
+\fIType\fR specifies the form in which the selection is to be returned
+(the desired ``target'' for conversion, in ICCCM terminology), and
+should be an atom name such as STRING or FILE_NAME; see the
+Inter-Client Communication Conventions Manual for complete details.
+\fIType\fR defaults to STRING. The selection owner may choose to
+return the selection in any of several different representation
+formats, such as STRING, ATOM, INTEGER, etc. (this format is different
+than the selection type; see the ICCCM for all the confusing details).
+If the selection is returned in a non-string format, such as INTEGER
+or ATOM, the \fBselection\fR command converts it to string format as a
+collection of fields separated by spaces: atoms are converted to their
+textual names, and anything else is converted to hexadecimal integers.
+.TP
+\fBselection handle\fR ?\fB\-selection\fR \fIselection\fR? ?\fB\-type\fR \fItype\fR? ?\fB\-format\fR \fIformat\fR? \fIwindow command\fR
+Creates a handler for selection requests, such that \fIcommand\fR will
+be executed whenever \fIselection\fR is owned by \fIwindow\fR and
+someone attempts to retrieve it in the form given by \fItype\fR
+(e.g. \fItype\fR is specified in the \fBselection get\fR command).
+\fISelection\fR defaults to PRIMARY, \fItype\fR defaults to STRING, and
+\fIformat\fR defaults to STRING. If \fIcommand\fR is an empty string
+then any existing handler for \fIwindow\fR, \fItype\fR, and
+\fIselection\fR is removed.
+.RS
+.PP
+When \fIselection\fR is requested, \fIwindow\fR is the selection owner,
+and \fItype\fR is the requested type, \fIcommand\fR will be executed
+as a Tcl command with two additional numbers appended to it
+(with space separators).
+The two additional numbers
+are \fIoffset\fR and \fImaxBytes\fR: \fIoffset\fR specifies a starting
+character position in the selection and \fImaxBytes\fR gives the maximum
+number of bytes to retrieve. The command should return a value consisting
+of at most \fImaxBytes\fR of the selection, starting at position
+\fIoffset\fR. For very large selections (larger than \fImaxBytes\fR)
+the selection will be retrieved using several invocations of \fIcommand\fR
+with increasing \fIoffset\fR values. If \fIcommand\fR returns a string
+whose length is less than \fImaxBytes\fR, the return value is assumed to
+include all of the remainder of the selection; if the length of
+\fIcommand\fR's result is equal to \fImaxBytes\fR then
+\fIcommand\fR will be invoked again, until it eventually
+returns a result shorter than \fImaxBytes\fR. The value of \fImaxBytes\fR
+will always be relatively large (thousands of bytes).
+.PP
+If \fIcommand\fR returns an error then the selection retrieval is rejected
+just as if the selection didn't exist at all.
+.PP
+The \fIformat\fR argument specifies the representation that should be
+used to transmit the selection to the requester (the second column of
+Table 2 of the ICCCM), and defaults to STRING. If \fIformat\fR is
+STRING, the selection is transmitted as 8-bit ASCII characters (i.e.
+just in the form returned by \fIcommand\fR). If \fIformat\fR is
+ATOM, then the return value from \fIcommand\fR is divided into fields
+separated by white space; each field is converted to its atom value,
+and the 32-bit atom value is transmitted instead of the atom name.
+For any other \fIformat\fR, the return value from \fIcommand\fR is
+divided into fields separated by white space and each field is
+converted to a 32-bit integer; an array of integers is transmitted
+to the selection requester.
+.PP
+The \fIformat\fR argument is needed only for compatibility with
+selection requesters that don't use Tk. If Tk is being
+used to retrieve the selection then the value is converted back to
+a string at the requesting end, so \fIformat\fR is
+irrelevant.
+.RE
+.TP
+\fBselection own\fR ?\fB\-displayof\fR \fIwindow\fR? ?\fB\-selection\fR \fIselection\fR?
+.TP
+\fBselection own\fR ?\fB\-command\fR \fIcommand\fR? ?\fB\-selection\fR \fIselection\fR? \fIwindow\fR
+The first form of \fBselection own\fR returns the path name of the
+window in this application that owns \fIselection\fR on the display
+containing \fIwindow\fR, or an empty string if no window in this
+application owns the selection. \fISelection\fR defaults to PRIMARY and
+\fIwindow\fR defaults to ``.''.
+.PP
+The second form of \fBselection own\fR causes \fIwindow\fR to become
+the new owner of \fIselection\fR on \fIwindow\fR's display, returning
+an empty string as result. The existing owner, if any, is notified
+that it has lost the selection.
+If \fIcommand\fR is specified, it is a Tcl script to execute when
+some other window claims ownership of the selection away from
+\fIwindow\fR. \fISelection\fR defaults to PRIMARY.
+
+.SH KEYWORDS
+clear, format, handler, ICCCM, own, selection, target, type
diff --git a/tk/doc/send.n b/tk/doc/send.n
new file mode 100644
index 00000000000..410eec6fcab
--- /dev/null
+++ b/tk/doc/send.n
@@ -0,0 +1,92 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBsend ?\fIoptions\fR? \fIapp cmd \fR?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+This command arranges for \fIcmd\fR (and \fIarg\fRs) to be executed in the
+application named by \fIapp\fR. It returns the result or
+error from that command execution.
+\fIApp\fR may be the name of any application whose main window is
+on the display containing the sender's main window; it need not
+be within the same process.
+If no \fIarg\fR arguments are present, then the command to be executed is
+contained entirely within the \fIcmd\fR argument. If one or
+more \fIarg\fRs are present, they are concatenated to form the
+command to be executed, just as for the \fBeval\fR command.
+.PP
+If the initial arguments of the command begin with ``\-''
+they are treated as options. The following options are
+currently defined:
+.TP
+\fB\-async\fR
+Requests asynchronous invocation. In this case the \fBsend\fR
+command will complete immediately without waiting for \fIcmd\fR
+to complete in the target application; no result will be available
+and errors in the sent command will be ignored.
+If the target application is in the same process as the sending
+application then the \fB\-async\fR option is ignored.
+.TP
+\fB\-displayof\fR \fIpathName\fR
+Specifies that the target application's main window is on the display
+of the window given by \fIpathName\fR, instead of the display containing
+the application's main window.
+.TP
+\fB\-\|\-\fR
+Serves no purpose except to terminate the list of options. This
+option is needed only if \fIapp\fR could contain a leading ``\-''
+character.
+
+.SH "APPLICATION NAMES"
+.PP
+The name of an application is set initially from the name of the
+program or script that created the application.
+You can query and change the name of an application with the
+\fBtk appname\fR command.
+
+.SH "DISABLING SENDS"
+.PP
+If the \fBsend\fR command is removed from an application (e.g.
+with the command \fBrename send {}\fR) then the application
+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
diff --git a/tk/doc/text.n b/tk/doc/text.n
new file mode 100644
index 00000000000..9e310f13a3b
--- /dev/null
+++ b/tk/doc/text.n
@@ -0,0 +1,1621 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBtext\fR \fIpathName \fR?\fIoptions\fR?
+.SO
+\-background \-highlightbackground \-insertontime \-selectborderwidth
+\-borderwidth \-highlightcolor \-insertwidth \-selectforeground
+\-cursor \-highlightthickness \-padx \-setgrid
+\-exportselection \-insertbackground \-pady \-takefocus
+\-font \-insertborderwidth \-relief \-xscrollcommand
+\-foreground \-insertofftime \-selectbackground \-yscrollcommand
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-height height Height
+Specifies the desired height for the window, in units of characters
+in the font given by the \fB\-font\fR option.
+Must be at least one.
+.OP \-spacing1 spacing1 Spacing1
+Requests additional space above each text line in the widget,
+using any of the standard forms for screen distances.
+If a line wraps, this option only applies to the first line
+on the display.
+This option may be overriden with \fB\-spacing1\fR options in
+tags.
+.OP \-spacing2 spacing2 Spacing2
+For lines that wrap (so that they cover more than one line on the
+display) this option specifies additional space to provide between
+the display lines that represent a single line of text.
+The value may have any of the standard forms for screen distances.
+This option may be overriden with \fB\-spacing2\fR options in
+tags.
+.OP \-spacing3 spacing3 Spacing3
+Requests additional space below each text line in the widget,
+using any of the standard forms for screen distances.
+If a line wraps, this option only applies to the last line
+on the display.
+This option may be overriden with \fB\-spacing3\fR options in
+tags.
+.OP \-state state State
+Specifies one of two states for the text: \fBnormal\fR or \fBdisabled\fR.
+If the text is disabled then characters may not be inserted or deleted
+and no insertion cursor will be displayed, even if the input focus is
+in the widget.
+.OP \-tabs tabs Tabs
+Specifies a set of tab stops for the window. The option's value consists
+of a list of screen distances giving the positions of the tab stops. Each
+position may optionally be followed in the next list element
+by one of the keywords \fBleft\fR, \fBright\fR, \fBcenter\fR,
+or \fBnumeric\fR, which specifies how to justify
+text relative to the tab stop. \fBLeft\fR is the default; it causes
+the text following the tab character to be positioned with its left edge
+at the tab position. \fBRight\fR means that the right edge of the text
+following the tab character is positioned at the tab position, and
+\fBcenter\fR means that the text is centered at the tab position.
+\fBNumeric\fR means that the decimal point in the text is positioned
+at the tab position; if there is no decimal point then the least
+significant digit of the number is positioned just to the left of the
+tab position; if there is no number in the text then the text is
+right-justified at the tab position.
+For example, \fB\-tabs {2c left 4c 6c center}\fR creates three
+tab stops at two-centimeter intervals; the first two use left
+justification and the third uses center justification.
+If the list of tab stops does not have enough elements to cover all
+of the tabs in a text line, then Tk extrapolates new tab stops using
+the spacing and alignment from the last tab stop in the list.
+The value of the \fBtabs\fR option may be overridden by \fB\-tabs\fR
+options in tags.
+If no \fB\-tabs\fR option is specified, or if it is specified as
+an empty list, then Tk uses default tabs spaced every eight
+(average size) characters.
+.OP \-width width Width
+Specifies the desired width for the window in units of characters
+in the font given by the \fB\-font\fR option.
+If the font doesn't have a uniform width then the width of the
+character ``0'' is used in translating from character units to
+screen units.
+.OP \-wrap wrap Wrap
+Specifies how to handle lines in the text that are too long to be
+displayed in a single line of the text's window.
+The value must be \fBnone\fR or \fBchar\fR or \fBword\fR.
+A wrap mode of \fBnone\fR means that each line of text appears as
+exactly one line on the screen; extra characters that don't fit
+on the screen are not displayed.
+In the other modes each line of text will be broken up into several
+screen lines if necessary to keep all the characters visible.
+In \fBchar\fR mode a screen line break may occur after any character;
+in \fBword\fR mode a line break will only be made at word boundaries.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBtext\fR command creates a new window (given by the
+\fIpathName\fR argument) and makes it into a text widget.
+Additional
+options, described above, may be specified on the command line
+or in the option database
+to configure aspects of the text such as its default background color
+and relief. The \fBtext\fR command returns the
+path name of the new window.
+.PP
+A text widget displays one or more lines of text and allows that
+text to be edited.
+.VS
+Text widgets support four different kinds of annotations on the
+text, called tags, marks, embedded windows or embedded images.
+.VE
+Tags allow different portions of the text
+to be displayed with different fonts and colors.
+In addition, Tcl commands can be associated with tags so
+that scripts are invoked when particular actions such as keystrokes
+and mouse button presses occur in particular ranges of the text.
+See TAGS below for more details.
+.PP
+The second form of annotation consists of marks, which are floating
+markers in the text.
+Marks are used to keep track of various interesting positions in the
+text as it is edited.
+See MARKS below for more details.
+.PP
+The third form of annotation allows arbitrary windows to be
+embedded in a text widget.
+See EMBEDDED WINDOWS below for more details.
+.PP
+.VS
+The fourth form of annotation allows Tk images to be embedded in a text
+widget.
+See EMBEDDED IMAGES below for more details.
+.VE
+
+.SH INDICES
+.PP
+Many of the widget commands for texts take one or more indices
+as arguments.
+An index is a string used to indicate a particular place within
+a text, such as a place to insert characters or one endpoint of a
+range of characters to delete.
+Indices have the syntax
+.CS
+\fIbase modifier modifier modifier ...\fR
+.CE
+Where \fIbase\fR gives a starting point and the \fImodifier\fRs
+adjust the index from the starting point (e.g. move forward or
+backward one character). Every index must contain a \fIbase\fR,
+but the \fImodifier\fRs are optional.
+.PP
+The \fIbase\fR for an index must have one of the following forms:
+.TP 12
+\fIline\fB.\fIchar\fR
+Indicates \fIchar\fR'th character on line \fIline\fR.
+Lines are numbered from 1 for consistency with other UNIX programs
+that use this numbering scheme.
+Within a line, characters are numbered from 0.
+If \fIchar\fR is \fBend\fR then it refers to the newline character
+that ends the line.
+.TP 12
+\fB@\fIx\fB,\fIy\fR
+Indicates the character that covers the pixel whose x and y coordinates
+within the text's window are \fIx\fR and \fIy\fR.
+.TP 12
+\fBend\fR
+Indicates the end of the text (the character just after the last
+newline).
+.TP 12
+\fImark\fR
+Indicates the character just after the mark whose name is \fImark\fR.
+.TP 12
+\fItag\fB.first\fR
+Indicates the first character in the text that has been tagged with
+\fItag\fR.
+This form generates an error if no characters are currently tagged
+with \fItag\fR.
+.TP 12
+\fItag\fB.last\fR
+Indicates the character just after the last one in the text that has
+been tagged with \fItag\fR.
+This form generates an error if no characters are currently tagged
+with \fItag\fR.
+.TP 12
+\fIpathName\fR
+Indicates the position of the embedded window whose name is
+\fIpathName\fR.
+This form generates an error if there is no embedded window
+by the given name.
+.TP 12
+.VS
+\fIimageName\fR
+Indicates the position of the embedded image whose name is
+\fIimageName\fR.
+This form generates an error if there is no embedded image
+by the given name.
+.VE
+.PP
+If the \fIbase\fP could match more than one of the above forms, such
+as a \fImark\fP and \fIimageName\fP both having the same value, then
+the form earlier in the above list takes precedence.
+If modifiers follow the base index, each one of them must have one
+of the forms listed below. Keywords such as \fBchars\fR and \fBwordend\fR
+may be abbreviated as long as the abbreviation is unambiguous.
+.TP
+\fB+ \fIcount\fB chars\fR
+Adjust the index forward by \fIcount\fR characters, moving to later
+lines in the text if necessary. If there are fewer than \fIcount\fR
+characters in the text after the current index, then set the index
+to the last character in the text.
+Spaces on either side of \fIcount\fR are optional.
+.TP
+\fB\- \fIcount\fB chars\fR
+Adjust the index backward by \fIcount\fR characters, moving to earlier
+lines in the text if necessary. If there are fewer than \fIcount\fR
+characters in the text before the current index, then set the index
+to the first character in the text.
+Spaces on either side of \fIcount\fR are optional.
+.TP
+\fB+ \fIcount\fB lines\fR
+Adjust the index forward by \fIcount\fR lines, retaining the same
+character position within the line. If there are fewer than \fIcount\fR
+lines after the line containing the current index, then set the index
+to refer to the same character position on the last line of the text.
+Then, if the line is not long enough to contain a character at the indicated
+character position, adjust the character position to refer to the last
+character of the line (the newline).
+Spaces on either side of \fIcount\fR are optional.
+.TP
+\fB\- \fIcount\fB lines\fR
+Adjust the index backward by \fIcount\fR lines, retaining the same
+character position within the line. If there are fewer than \fIcount\fR
+lines before the line containing the current index, then set the index
+to refer to the same character position on the first line of the text.
+Then, if the line is not long enough to contain a character at the indicated
+character position, adjust the character position to refer to the last
+character of the line (the newline).
+Spaces on either side of \fIcount\fR are optional.
+.TP
+\fBlinestart\fR
+Adjust the index to refer to the first character on the line.
+.TP
+\fBlineend\fR
+Adjust the index to refer to the last character on the line (the newline).
+.TP
+\fBwordstart\fR
+Adjust the index to refer to the first character of the word containing
+the current index. A word consists of any number of adjacent characters
+that are letters, digits, or underscores, or a single character that
+is not one of these.
+.TP
+\fBwordend\fR
+Adjust the index to refer to the character just after the last one of the
+word containing the current index. If the current index refers to the last
+character of the text then it is not modified.
+.PP
+If more than one modifier is present then they are applied in
+left-to-right order. For example, the index ``\fBend \- 1 chars\fR''
+refers to the next-to-last character in the text and
+``\fBinsert wordstart \- 1 c\fR'' refers to the character just before
+the first one in the word containing the insertion cursor.
+
+.SH TAGS
+.PP
+The first form of annotation in text widgets is a tag.
+A tag is a textual string that is associated with some of the characters
+in a text.
+Tags may contain arbitrary characters, but it is probably best to
+avoid using the the characters `` '' (space), \fB+\fR, or \fB\-\fR:
+these characters have special meaning in indices, so tags containing
+them can't be used as indices.
+There may be any number of tags associated with characters in a
+text.
+Each tag may refer to a single character, a range of characters, or
+several ranges of characters.
+An individual character may have any number of tags associated with it.
+.PP
+A priority order is defined among tags, and this order is used in
+implementing some of the tag-related functions described below.
+When a tag is defined (by associating it with characters or setting
+its display options or binding commands to it), it is given
+a priority higher than any existing tag.
+The priority order of tags may be redefined using the
+``\fIpathName \fBtag raise\fR'' and ``\fIpathName \fBtag lower\fR''
+widget commands.
+.PP
+Tags serve three purposes in text widgets.
+First, they control the way information is displayed on the screen.
+By default, characters are displayed as determined by the
+\fBbackground\fR, \fBfont\fR, and \fBforeground\fR options for the
+text widget.
+However, display options may be associated with individual tags
+using the ``\fIpathName \fBtag configure\fR'' widget command.
+If a character has been tagged, then the display options associated
+with the tag override the default display style.
+The following options are currently supported for tags:
+.TP
+\fB\-background \fIcolor\fR
+\fIColor\fR specifies the background color to use for characters
+associated with the tag.
+It may have any of the forms accepted by \fBTk_GetColor\fR.
+.TP
+\fB\-bgstipple \fIbitmap\fR
+\fIBitmap\fR specifies a bitmap that is used as a stipple pattern
+for the background.
+It may have any of the forms accepted by \fBTk_GetBitmap\fR.
+If \fIbitmap\fR hasn't been specified, or if it is specified
+as an empty string, then a solid fill will be used for the
+background.
+.TP
+\fB\-borderwidth \fIpixels\fR
+\fIPixels\fR specifies the width of a 3-D border to draw around
+the background.
+It may have any of the forms accepted by \fBTk_GetPixels\fR.
+This option is used in conjunction with the \fB\-relief\fR
+option to give a 3-D appearance to the background for characters;
+it is ignored unless the \fB\-background\fR option
+has been set for the tag.
+.TP
+\fB\-fgstipple \fIbitmap\fR
+\fIBitmap\fR specifies a bitmap that is used as a stipple pattern
+when drawing text and other foreground information such as
+underlines.
+It may have any of the forms accepted by \fBTk_GetBitmap\fR.
+If \fIbitmap\fR hasn't been specified, or if it is specified
+as an empty string, then a solid fill will be used.
+.TP
+\fB\-font \fIfontName\fR
+\fIFontName\fR is the name of a font to use for drawing characters.
+It may have any of the forms accepted by \fBTk_GetFontStruct\fR.
+.TP
+\fB\-foreground \fIcolor\fR
+\fIColor\fR specifies the color to use when drawing text and other
+foreground information such as underlines.
+It may have any of the forms accepted by \fBTk_GetColor\fR.
+.TP
+\fB\-justify \fIjustify\fR
+If the first character of a display line has a tag for which this
+option has been specified, then \fIjustify\fR determines how to
+justify the line.
+It must be one of \fBleft\fR, \fBright\fR, or \fBcenter\fR.
+If a line wraps, then the justification for each line on the
+display is determined by the first character of that display line.
+.TP
+\fB\-lmargin1 \fIpixels\fR
+If the first character of a text line has a tag for which this
+option has been specified, then \fIpixels\fR specifies how
+much the line should be indented from the left edge of the
+window.
+\fIPixels\fR may have any of the standard forms for screen
+distances.
+If a line of text wraps, this option only applies to the
+first line on the display; the \fB\-lmargin2\fR option controls
+the indentation for subsequent lines.
+.TP
+\fB\-lmargin2 \fIpixels\fR
+If the first character of a display line has a tag for which this
+option has been specified, and if the display line is not the
+first for its text line (i.e., the text line has wrapped), then
+\fIpixels\fR specifies how much the line should be indented from
+the left edge of the window.
+\fIPixels\fR may have any of the standard forms for screen
+distances.
+This option is only used when wrapping is enabled, and it only
+applies to the second and later display lines for a text line.
+.TP
+\fB\-offset \fIpixels\fR
+\fIPixels\fR specifies an amount by which the text's baseline
+should be offset vertically from the baseline of the overall
+line, in pixels.
+For example, a positive offset can be used for superscripts
+and a negative offset can be used for subscripts.
+\fIPixels\fR may have any of the standard forms for screen
+distances.
+.TP
+\fB\-overstrike \fIboolean\fR
+Specifies whether or not to draw a horizontal rule through
+the middle of characters.
+\fIBoolean\fR may have any of the forms accepted by \fBTk_GetBoolean\fR.
+.TP
+\fB\-relief \fIrelief\fR
+\fIRelief\fR specifies the 3-D relief to use for drawing backgrounds,
+in any of the forms accepted by \fBTk_GetRelief\fR.
+This option is used in conjunction with the \fB\-borderwidth\fR
+option to give a 3-D appearance to the background for characters;
+it is ignored unless the \fB\-background\fR option
+has been set for the tag.
+.TP
+\fB\-rmargin \fIpixels\fR
+If the first character of a display line has a tag for which this
+option has been specified, then \fIpixels\fR specifies how wide
+a margin to leave between the end of the line and the right
+edge of the window.
+\fIPixels\fR may have any of the standard forms for screen
+distances.
+This option is only used when wrapping is enabled.
+If a text line wraps, the right margin for each line on the
+display is determined by the first character of that display
+line.
+.TP
+\fB\-spacing1 \fIpixels\fR
+\fIPixels\fR specifies how much additional space should be
+left above each text line, using any of the standard forms for
+screen distances.
+If a line wraps, this option only applies to the first
+line on the display.
+.TP
+\fB\-spacing2 \fIpixels\fR
+For lines that wrap, this option specifies how much additional
+space to leave between the display lines for a single text line.
+\fIPixels\fR may have any of the standard forms for screen
+distances.
+.TP
+\fB\-spacing3 \fIpixels\fR
+\fIPixels\fR specifies how much additional space should be
+left below each text line, using any of the standard forms for
+screen distances.
+If a line wraps, this option only applies to the last
+line on the display.
+.TP
+\fB\-tabs \fItabList\fR
+\fITabList\fR specifies a set of tab stops in the same form
+as for the \fB\-tabs\fR option for the text widget. This
+option only applies to a display line if it applies to the
+first character on that display line.
+If this option is specified as an empty string, it cancels
+the option, leaving it unspecified for the tag (the default).
+If the option is specified as a non-empty string that is
+an empty list, such as \fB\-tags\0{\0}\fR, then it requests
+default 8-character tabs as described for the \fBtags\fR
+widget option.
+.TP
+\fB\-underline \fIboolean\fR
+\fIBoolean\fR specifies whether or not to draw an underline underneath
+characters.
+It may have any of the forms accepted by \fBTk_GetBoolean\fR.
+.TP
+\fB\-wrap \fImode\fR
+\fIMode\fR specifies how to handle lines that are wider than the
+text's window.
+It has the same legal values as the \fB\-wrap\fR option
+for the text widget: \fBnone\fR, \fBchar\fR, or \fBword\fR.
+If this tag option is specified, it overrides the \fB\-wrap\fR option
+for the text widget.
+.PP
+If a character has several tags associated with it, and if their
+display options conflict, then the options of the highest priority
+tag are used.
+If a particular display option hasn't been specified for a
+particular tag, or if it is specified as an empty string, then
+that option will never be used; the next-highest-priority
+tag's option will used instead.
+If no tag specifies a particular display option, then the default
+style for the widget will be used.
+.PP
+The second purpose for tags is event bindings.
+You can associate bindings with a tag in much the same way you can
+associate bindings with a widget class: whenever particular X
+events occur on characters with the given tag, a given
+Tcl command will be executed.
+Tag bindings can be used to give behaviors to ranges of characters;
+among other things, this allows hypertext-like
+features to be implemented.
+For details, see the description of the \fBtag bind\fR widget
+command below.
+.PP
+The third use for tags is in managing the selection.
+See THE SELECTION below.
+
+.SH MARKS
+.PP
+The second form of annotation in text widgets is a mark.
+Marks are used for remembering particular places in a text.
+They are something like tags, in that they have names and
+they refer to places in the file, but a mark isn't associated
+with particular characters.
+Instead, a mark is associated with the gap between two characters.
+Only a single position may be associated with a mark at any given
+time.
+If the characters around a mark are deleted the mark will still
+remain; it will just have new neighbor characters.
+In contrast, if the characters containing a tag are deleted then
+the tag will no longer have an association with characters in
+the file.
+Marks may be manipulated with the ``\fIpathName \fBmark\fR'' widget
+command, and their current locations may be determined by using the
+mark name as an index in widget commands.
+.PP
+Each mark also has a \fIgravity\fR, which is either \fBleft\fR or
+\fBright\fR.
+The gravity for a mark specifies what happens to the mark when
+text is inserted at the point of the mark.
+If a mark has left gravity, then the mark is treated as if it
+were attached to the character on its left, so the mark will
+remain to the left of any text inserted at the mark position.
+If the mark has right gravity, new text inserted at the mark
+position will appear to the right of the mark. The gravity
+for a mark defaults to \fBright\fR.
+.PP
+The name space for marks is different from that for tags: the
+same name may be used for both a mark and a tag, but they will refer
+to different things.
+.PP
+Two marks have special significance.
+First, the mark \fBinsert\fR is associated with the insertion cursor,
+as described under THE INSERTION CURSOR below.
+Second, the mark \fBcurrent\fR is associated with the character
+closest to the mouse and is adjusted automatically to track the
+mouse position and any changes to the text in the widget (one
+exception: \fBcurrent\fR is not updated in response to mouse
+motions if a mouse button is down; the update will be deferred
+until all mouse buttons have been released).
+Neither of these special marks may be deleted.
+
+.SH EMBEDDED WINDOWS
+.PP
+The third form of annotation in text widgets is an embedded window.
+Each embedded window annotation causes a window to be displayed
+at a particular point in the text.
+There may be any number of embedded windows in a text widget,
+and any widget may be used as an embedded window (subject to the
+usual rules for geometry management, which require the text window
+to be the parent of the embedded window or a descendant of its
+parent).
+The embedded window's position on the screen will be updated as the
+text is modified or scrolled, and it will be mapped and unmapped as
+it moves into and out of the visible area of the text widget.
+Each embedded window occupies one character's worth of index space
+in the text widget, and it may be referred to either by the name
+of its embedded window or by its position in the widget's
+index space.
+If the range of text containing the embedded window is deleted then
+the window is destroyed.
+.PP
+When an embedded window is added to a text widget with the
+\fBwindow create\fR widget command, several configuration
+options may be associated with it.
+These options may be modified later with the \fBwindow configure\fR
+widget command.
+The following options are currently supported:
+.TP
+\fB\-align \fIwhere\fR
+If the window is not as tall as the line in which it is displayed,
+this option determines where the window is displayed in the line.
+\fIWhere\fR must have one of the values \fBtop\fR (align the top of the window
+with the top of the line), \fBcenter\fR (center the window
+within the range of the line), \fBbottom\fR (align the bottom of the
+window with the bottom of the line's area),
+or \fBbaseline\fR (align the bottom of the window with the baseline
+of the line).
+.TP
+\fB\-create \fIscript\fR
+Specifies a Tcl script that may be evaluated to create the window
+for the annotation.
+If no \fB\-window\fR option has been specified for the annotation
+this script will be evaluated when the annotation is about to
+be displayed on the screen.
+\fIScript\fR must create a window for the annotation and return
+the name of that window as its result.
+If the annotation's window should ever be deleted, \fIscript\fR
+will be evaluated again the next time the annotation is displayed.
+.TP
+\fB\-padx \fIpixels\fR
+\fIPixels\fR specifies the amount of extra space to leave on
+each side of the embedded window.
+It may have any of the usual forms defined for a screen distance.
+.TP
+\fB\-pady \fIpixels\fR
+\fIPixels\fR specifies the amount of extra space to leave on
+the top and on the bottom of the embedded window.
+It may have any of the usual forms defined for a screen distance.
+.TP
+\fB\-stretch \fIboolean\fR
+If the requested height of the embedded window is less than the
+height of the line in which it is displayed, this option can be
+used to specify whether the window should be stretched vertically
+to fill its line.
+If the \fB\-pady\fR option has been specified as well, then the
+requested padding will be retained even if the window is
+stretched.
+.TP
+\fB\-window \fIpathName\fR
+Specifies the name of a window to display in the annotation.
+
+.VS
+.SH EMBEDDED IMAGES
+.PP
+The final form of annotation in text widgets is an embedded image.
+Each embedded image annotation causes an image to be displayed
+at a particular point in the text.
+There may be any number of embedded images in a text widget,
+and a particular image may be embedded in multiple places in the same
+text widget.
+The embedded image's position on the screen will be updated as the
+text is modified or scrolled.
+Each embedded image occupies one character's worth of index space
+in the text widget, and it may be referred to either by
+its position in the widget's index space, or the name it is assigned
+when the image is inserted into the text widget widh \fBimage create\fP.
+If the range of text containing the embedded image is deleted then
+that copy of the image is removed from the screen.
+.PP
+When an embedded image is added to a text widget with the \fBimage
+create\fR widget command, a name unique to this instance of the image
+is returned. This name may then be used to refer to this image
+instance. The name is taken to be the value of the \fB-name\fP option
+(described below). If the \fB-name\fP option is not provided, the
+\fB-image\fP name is used instead. If the \fIimageName\fP is already
+in use in the text widget, then \fB#\fInn\fR is added to the end of the
+\fIimageName\fP, where \fInn\fP is an arbitrary integer. This insures
+the \fIimageName\fP is unique.
+Once this name is assigned to this instance of the image, it does not
+change, even though the \fB-image\fP or \fB-name\fP values can be changed
+with \fBimage configure\fP.
+.PP
+When an embedded image is added to a text widget with the
+\fBimage create\fR widget command, several configuration
+options may be associated with it.
+These options may be modified later with the \fBimage configure\fR
+widget command.
+The following options are currently supported:
+.TP
+\fB\-align \fIwhere\fR
+If the image is not as tall as the line in which it is displayed,
+this option determines where the image is displayed in the line.
+\fIWhere\fR must have one of the values \fBtop\fR (align the top of the image
+with the top of the line), \fBcenter\fR (center the image
+within the range of the line), \fBbottom\fR (align the bottom of the
+image with the bottom of the line's area),
+or \fBbaseline\fR (align the bottom of the image with the baseline
+of the line).
+.TP
+\fB\-image \fIimage\fR
+Specifies the name of the Tk image to display in the annotation.
+If \fIimage\fP is not a valid Tk image, then an error is returned.
+.TP
+\fB\-name \fIImageName\fR
+Specifies the name by which this image instance may be referenced in
+the text widget. If \fIImageName\fP is not supplied, then the
+name of the Tk image is used instead.
+If the \fIimageName\fP is already in use, \fI#nn\fP is appended to
+the end of the name as described above.
+.TP
+\fB\-padx \fIpixels\fR
+\fIPixels\fR specifies the amount of extra space to leave on
+each side of the embedded image.
+It may have any of the usual forms defined for a screen distance.
+.TP
+\fB\-pady \fIpixels\fR
+\fIPixels\fR specifies the amount of extra space to leave on
+the top and on the bottom of the embedded image.
+It may have any of the usual forms defined for a screen distance.
+.VE
+
+.SH THE SELECTION
+.PP
+Selection support is implemented via tags.
+If the \fBexportSelection\fR option for the text widget is true
+then the \fBsel\fR tag will be associated with the selection:
+.IP [1]
+Whenever characters are tagged with \fBsel\fR the text widget
+will claim ownership of the selection.
+.IP [2]
+Attempts to retrieve the
+selection will be serviced by the text widget, returning all the
+characters with the \fBsel\fR tag.
+.IP [3]
+If the selection is claimed away by another application or by another
+window within this application, then the \fBsel\fR tag will be removed
+from all characters in the text.
+.PP
+The \fBsel\fR tag is automatically defined when a text widget is
+created, and it may not be deleted with the ``\fIpathName \fBtag delete\fR''
+widget command. Furthermore, the \fBselectBackground\fR,
+\fBselectBorderWidth\fR, and \fBselectForeground\fR options for
+the text widget are tied to the \fB\-background\fR,
+\fB\-borderwidth\fR, and \fB\-foreground\fR options for the \fBsel\fR
+tag: changes in either will automatically be reflected in the
+other.
+
+.SH THE INSERTION CURSOR
+.PP
+The mark named \fBinsert\fR has special significance in text widgets.
+It is defined automatically when a text widget is created and it
+may not be unset with the ``\fIpathName \fBmark unset\fR'' widget
+command.
+The \fBinsert\fR mark represents the position of the insertion
+cursor, and the insertion cursor will automatically be drawn at
+this point whenever the text widget has the input focus.
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBtext\fR command creates a new Tcl command whose
+name is the same as the path name of the text's window. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.CS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.CE
+\fIPathName\fR is the name of the command, which is the same as
+the text widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for text widgets:
+.TP
+\fIpathName \fBbbox \fIindex\fR
+Returns a list of four elements describing the screen area
+of the character given by \fIindex\fR.
+The first two elements of the list give the x and y coordinates
+of the upper-left corner of the area occupied by the
+character, and the last two elements give the width and height
+of the area.
+If the character is only partially visible on the screen, then
+the return value reflects just the visible part.
+If the character is not visible on the screen then the return
+value is an empty list.
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBtext\fR
+command.
+.TP
+\fIpathName \fBcompare\fR \fIindex1 op index2\fR
+Compares the indices given by \fIindex1\fR and \fIindex2\fR according
+to the relational operator given by \fIop\fR, and returns 1 if
+the relationship is satisfied and 0 if it isn't.
+\fIOp\fR must be one of the operators <, <=, ==, >=, >, or !=.
+If \fIop\fR is == then 1 is returned if the two indices refer to
+the same character, if \fIop\fR is < then 1 is returned if \fIindex1\fR
+refers to an earlier character in the text than \fIindex2\fR, and
+so on.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? \fI?value option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBtext\fR
+command.
+.TP
+\fIpathName \fBdebug \fR?\fIboolean\fR?
+If \fIboolean\fR is specified, then it must have one of the true or
+false values accepted by Tcl_GetBoolean.
+If the value is a true one then internal consistency checks will be
+turned on in the B-tree code associated with text widgets.
+If \fIboolean\fR has a false value then the debugging checks will
+be turned off.
+In either case the command returns an empty string.
+If \fIboolean\fR is not specified then the command returns \fBon\fR
+or \fBoff\fR to indicate whether or not debugging is turned on.
+There is a single debugging switch shared by all text widgets: turning
+debugging on or off in any widget turns it on or off for all widgets.
+For widgets with large amounts of text, the consistency checks may
+cause a noticeable slow-down.
+.TP
+\fIpathName \fBdelete \fIindex1 \fR?\fIindex2\fR?
+Delete a range of characters from the text.
+If both \fIindex1\fR and \fIindex2\fR are specified, then delete
+all the characters starting with the one given by \fIindex1\fR
+and stopping just before \fIindex2\fR (i.e. the character at
+\fIindex2\fR is not deleted).
+If \fIindex2\fR doesn't specify a position later in the text
+than \fIindex1\fR then no characters are deleted.
+If \fIindex2\fR isn't specified then the single character at
+\fIindex1\fR is deleted.
+It is not allowable to delete characters in a way that would leave
+the text without a newline as the last character.
+The command returns an empty string.
+.TP
+\fIpathName \fBdlineinfo \fIindex\fR
+Returns a list with five elements describing the area occupied
+by the display line containing \fIindex\fR.
+The first two elements of the list give the x and y coordinates
+of the upper-left corner of the area occupied by the
+line, the third and fourth elements give the width and height
+of the area, and the fifth element gives the position of the baseline
+for the line, measured down from the top of the area.
+All of this information is measured in pixels.
+If the current wrap mode is \fBnone\fR and the line extends beyond
+the boundaries of the window,
+the area returned reflects the entire area of the line, including the
+portions that are out of the window.
+If the line is shorter than the full width of the window then the
+area returned reflects just the portion of the line that is occupied
+by characters and embedded windows.
+If the display line containing \fIindex\fR is not visible on
+the screen then the return value is an empty list.
+.TP
+\fIpathName \fBdump \fR?\fIswitches\fR? \fIindex1 \fR?\fIindex2\fR?
+Return the contents of the text widget from \fIindex1\fR up to,
+but not including \fIindex2\fR,
+including the text and
+information about marks, tags, and embedded windows.
+If \fIindex2\fR is not specified, then it defaults to
+one character past \fIindex1\fR. The information is returned
+in the following format:
+.LP
+.RS
+\fIkey1 value1 index1 key2 value2 index2\fR ...
+.LP
+The possible \fIkey\fP values are \fBtext\fP, \fBmark\fP,
+\fBtagon\fP, \fBtagoff\fP, and \fBwindow\fP. The corresponding
+\fIvalue\fP is the text, mark name, tag name, or window name.
+The \fIindex\fP information is the index of the
+start of the text, the mark, the tag transition, or the window.
+One or more of the following switches (or abbreviations thereof)
+may be specified to control the dump:
+.TP
+\fB\-all\fR
+Return information about all elements: text, marks, tags, and windows.
+This is the default.
+.TP
+\fB\-command \fIcommand\fR
+Instead of returning the information as the result of the dump operation,
+invoke the \fIcommand\fR on each element of the text widget within the range.
+The command has three arguments appended to it before it is evaluated:
+the \fIkey\fP, \fIvalue\fP, and \fIindex\fP.
+.TP
+\fB\-mark\fR
+Include information about marks in the dump results.
+.TP
+\fB\-tag\fR
+Include information about tag transitions in the dump results. Tag information is
+returned as \fBtagon\fP and \fBtagoff\fP elements that indicate the
+begin and end of each range of each tag, respectively.
+.TP
+\fB\-text\fR
+Include information about text in the dump results. The value is the
+text up to the next element or the end of range indicated by \fIindex2\fR.
+A text element does not span newlines. A multi-line block of text that
+contains no marks or tag transitions will still be dumped as a set
+of text seqments that each end with a newline. The newline is part
+of the value.
+.TP
+\fB\-window\fR
+Include information about embedded windows in the dump results.
+The value of a window is its Tk pathname, unless the window
+has not been created yet. (It must have a create script.)
+In this case an empty string is returned, and you must query the
+window by its index position to get more information.
+.RE
+.TP
+\fIpathName \fBget \fIindex1 \fR?\fIindex2\fR?
+Return a range of characters from the text.
+The return value will be all the characters in the text starting
+with the one whose index is \fIindex1\fR and ending just before
+the one whose index is \fIindex2\fR (the character at \fIindex2\fR
+will not be returned).
+If \fIindex2\fR is omitted then the single character at \fIindex1\fR
+is returned.
+If there are no characters in the specified range (e.g. \fIindex1\fR
+is past the end of the file or \fIindex2\fR is less than or equal
+to \fIindex1\fR) then an empty string is returned.
+If the specified range contains embedded windows, no information
+about them is included in the returned string.
+.TP
+\fIpathName \fBimage \fIoption \fR?\fIarg arg ...\fR?
+This command is used to manipulate embedded images.
+The behavior of the command depends on the \fIoption\fR argument
+that follows the \fBtag\fR argument.
+The following forms of the command are currently supported:
+.RS
+.TP
+\fIpathName \fBimage cget\fR \fIindex option\fR
+Returns the value of a configuration option for an embedded image.
+\fIIndex\fR identifies the embedded image, and \fIoption\fR
+specifies a particular configuration option, which must be one of
+the ones listed in the section EMBEDDED IMAGES.
+.TP
+\fIpathName \fBimage configure \fIindex\fR ?\fIoption value ...\fR?
+Query or modify the configuration options for an embedded image.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for the embedded image at \fIindex\fR
+(see \fBTk_ConfigureInfo\fR for information on the format of this list).
+If \fIoption\fR is specified with no \fIvalue\fR, then the command
+returns a list describing the one named option (this list will be
+identical to the corresponding sublist of the value returned if no
+\fIoption\fR is specified).
+If one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given option(s) to have the given value(s); in
+this case the command returns an empty string.
+See EMBEDDED IMAGES for information on the options that
+are supported.
+.TP
+\fIpathName \fBimage create \fIindex\fR ?\fIoption value ...\fR?
+This command creates a new image annotation, which will appear
+in the text at the position given by \fIindex\fR.
+Any number of \fIoption\-value\fR pairs may be specified to
+configure the annotation.
+Returns a unique identifier that may be used as an index to refer to
+this image.
+See EMBEDDED IMAGES for information on the options that
+are supported, and a description of the identifier returned.
+.TP
+\fIpathName \fBimage names\fR
+Returns a list whose elements are the names of all image instances currently
+embedded in \fIwindow\fR.
+.RE
+.TP
+\fIpathName \fBindex \fIindex\fR
+Returns the position corresponding to \fIindex\fR in the form
+\fIline.char\fR where \fIline\fR is the line number and \fIchar\fR
+is the character number.
+\fIIndex\fR may have any of the forms described under INDICES above.
+.TP
+\fIpathName \fBinsert \fIindex chars \fR?\fItagList chars tagList ...\fR?
+Inserts all of the \fIchars\fR arguments just before the character at
+\fIindex\fR.
+If \fIindex\fR refers to the end of the text (the character after
+the last newline) then the new text is inserted just before the
+last newline instead.
+If there is a single \fIchars\fR argument and no \fItagList\fR, then
+the new text will receive any tags that are present on both the
+character before and the character after the insertion point; if a tag
+is present on only one of these characters then it will not be
+applied to the new text.
+If \fItagList\fR is specified then it consists of a list of
+tag names; the new characters will receive all of the tags in
+this list and no others, regardless of the tags present around
+the insertion point.
+If multiple \fIchars\fR\-\fItagList\fR argument pairs are present,
+they produce the same effect as if a separate \fBinsert\fR widget
+command had been issued for each pair, in order.
+The last \fItagList\fR argument may be omitted.
+.TP
+\fIpathName \fBmark \fIoption \fR?\fIarg arg ...\fR?
+This command is used to manipulate marks. The exact behavior of
+the command depends on the \fIoption\fR argument that follows
+the \fBmark\fR argument. The following forms of the command
+are currently supported:
+.RS
+.TP
+\fIpathName \fBmark gravity \fImarkName\fR ?\fIdirection\fR?
+If \fIdirection\fR is not specified, returns \fBleft\fR or \fBright\fR
+to indicate which of its adjacent characters \fImarkName\fR is attached
+to.
+If \fIdirection\fR is specified, it must be \fBleft\fR or \fBright\fR;
+the gravity of \fImarkName\fR is set to the given value.
+.TP
+\fIpathName \fBmark names\fR
+Returns a list whose elements are the names of all the marks that
+are currently set.
+.TP
+\fIpathName \fBmark next \fIindex\fR
+Returns the name of the next mark at or after \fIindex\fR.
+If \fIindex\fR is specified in numerical form, then the search for
+the next mark begins at that index.
+If \fIindex\fR is the name of a mark, then the search for
+the next mark begins immediately after that mark.
+This can still return a mark at the same position if
+there are multiple marks at the same index.
+These semantics mean that the \fBmark next\fP operation can be used to
+step through all the marks in a text widget in the same order
+as the mark information returned by the \fBdump\fP operation.
+If a mark has been set to the special \fBend\fP index,
+then it appears to be \fIafter\fP \fBend\fP with respect to the \fBmark next\fP operation.
+An empty string is returned if there are no marks after \fIindex\fR.
+.TP
+\fIpathName \fBmark previous \fIindex\fR
+Returns the name of the mark at or before \fIindex\fR.
+If \fIindex\fR is specified in numerical form, then the search for
+the previous mark begins with the character just before that index.
+If \fIindex\fR is the name of a mark, then the search for
+the next mark begins immediately before that mark.
+This can still return a mark at the same position if
+there are multiple marks at the same index.
+These semantics mean that the \fBmark previous\fP operation can be used to
+step through all the marks in a text widget in the reverse order
+as the mark information returned by the \fBdump\fP operation.
+An empty string is returned if there are no marks before \fIindex\fR.
+.TP
+\fIpathName \fBmark set \fImarkName index\fR
+Sets the mark named \fImarkName\fR to a position just before the
+character at \fIindex\fR.
+If \fImarkName\fR already exists, it is moved from its old position;
+if it doesn't exist, a new mark is created.
+This command returns an empty string.
+.TP
+\fIpathName \fBmark unset \fImarkName \fR?\fImarkName markName ...\fR?
+Remove the mark corresponding to each of the \fImarkName\fR arguments.
+The removed marks will not be usable in indices and will not be
+returned by future calls to ``\fIpathName \fBmark names\fR''.
+This command returns an empty string.
+.RE
+.TP
+\fIpathName \fBscan\fR \fIoption args\fR
+This command is used to implement scanning on texts. It has
+two forms, depending on \fIoption\fR:
+.RS
+.TP
+\fIpathName \fBscan mark \fIx y\fR
+Records \fIx\fR and \fIy\fR and the current view in the text window,
+for use in conjunction with later \fBscan dragto\fR commands.
+Typically this command is associated with a mouse button press in
+the widget. It returns an empty string.
+.TP
+\fIpathName \fBscan dragto \fIx y\fR
+This command computes the difference between its \fIx\fR and \fIy\fR
+arguments and the \fIx\fR and \fIy\fR arguments to the last
+\fBscan mark\fR command for the widget.
+It then adjusts the view by 10 times the difference in coordinates.
+This command is typically associated
+with mouse motion events in the widget, to produce the effect of
+dragging the text at high speed through the window. The return
+value is an empty string.
+.RE
+.TP
+\fIpathName \fBsearch \fR?\fIswitches\fR? \fIpattern index \fR?\fIstopIndex\fR?
+Searches the text in \fIpathName\fR starting at \fIindex\fR for a range
+of characters that matches \fIpattern\fR.
+If a match is found, the index of the first character in the match is
+returned as result; otherwise an empty string is returned.
+One or more of the following switches (or abbreviations thereof)
+may be specified to control the search:
+.RS
+.TP
+\fB\-forwards\fR
+The search will proceed forward through the text, finding the first
+matching range starting at or after the position given by \fIindex\fR.
+This is the default.
+.TP
+\fB\-backwards\fR
+The search will proceed backward through the text, finding the
+matching range closest to \fIindex\fR whose first character
+is before \fIindex\fR.
+.TP
+\fB\-exact\fR
+Use exact matching: the characters in the matching range must be
+identical to those in \fIpattern\fR.
+This is the default.
+.TP
+\fB\-regexp\fR
+Treat \fIpattern\fR as a regular expression and match it against
+the text using the rules for regular expressions (see the \fBregexp\fR
+command for details).
+.TP
+\fB\-nocase\fR
+Ignore case differences between the pattern and the text.
+.TP
+\fB\-count\fI varName\fR
+The argument following \fB\-count\fR gives the name of a variable;
+if a match is found, the number of characters in the matching
+range will be stored in the variable.
+.TP
+\fB\-\|\-\fR
+This switch has no effect except to terminate the list of switches:
+the next argument will be treated as \fIpattern\fR even if it starts
+with \fB\-\fR.
+.LP
+The matching range must be entirely within a single line of text.
+For regular expression matching the newlines are removed from the ends
+of the lines before matching: use the \fB$\fR feature in regular
+expressions to match the end of a line.
+For exact matching the newlines are retained.
+If \fIstopIndex\fR is specified, the search stops at that index:
+for forward searches, no match at or after \fIstopIndex\fR will
+be considered; for backward searches, no match earlier in the
+text than \fIstopIndex\fR will be considered.
+If \fIstopIndex\fR is omitted, the entire text will be searched:
+when the beginning or end of the text is reached, the search
+continues at the other end until the starting location is reached
+again; if \fIstopIndex\fR is specified, no wrap-around will occur.
+.RE
+.TP
+\fIpathName \fBsee \fIindex\fR
+Adjusts the view in the window so that the character given by \fIindex\fR
+is completely visible.
+If \fIindex\fR is already visible then the command does nothing.
+If \fIindex\fR is a short distance out of view, the command
+adjusts the view just enough to make \fIindex\fR visible at the
+edge of the window.
+If \fIindex\fR is far out of view, then the command centers
+\fIindex\fR in the window.
+.TP
+\fIpathName \fBtag \fIoption \fR?\fIarg arg ...\fR?
+This command is used to manipulate tags. The exact behavior of the
+command depends on the \fIoption\fR argument that follows the
+\fBtag\fR argument. The following forms of the command are currently
+supported:
+.RS
+.TP
+\fIpathName \fBtag add \fItagName index1 \fR?\fIindex2 index1 index2 ...\fR?
+Associate the tag \fItagName\fR with all of the characters starting
+with \fIindex1\fR and ending just before
+\fIindex2\fR (the character at \fIindex2\fR isn't tagged).
+A single command may contain any number of \fIindex1\fR\-\fIindex2\fR
+pairs.
+If the last \fIindex2\fR is omitted then the single character at
+\fIindex1\fR is tagged.
+If there are no characters in the specified range (e.g. \fIindex1\fR
+is past the end of the file or \fIindex2\fR is less than or equal
+to \fIindex1\fR) then the command has no effect.
+.TP
+\fIpathName \fBtag bind \fItagName\fR ?\fIsequence\fR? ?\fIscript\fR?
+This command associates \fIscript\fR with the tag given by
+\fItagName\fR.
+Whenever the event sequence given by \fIsequence\fR occurs for a
+character that has been tagged with \fItagName\fR,
+the script will be invoked.
+This widget command is similar to the \fBbind\fR command except that
+it operates on characters in a text rather than entire widgets.
+See the \fBbind\fR manual entry for complete details
+on the syntax of \fIsequence\fR and the substitutions performed
+on \fIscript\fR before invoking it.
+If all arguments are specified then a new binding is created, replacing
+any existing binding for the same \fIsequence\fR and \fItagName\fR
+(if the first character of \fIscript\fR is ``+'' then \fIscript\fR
+augments an existing binding rather than replacing it).
+In this case the return value is an empty string.
+If \fIscript\fR is omitted then the command returns the \fIscript\fR
+associated with \fItagName\fR and \fIsequence\fR (an error occurs
+if there is no such binding).
+If both \fIscript\fR and \fIsequence\fR are omitted then the command
+returns a list of all the sequences for which bindings have been
+defined for \fItagName\fR.
+.RS
+.PP
+.VS
+The only events for which bindings may be specified are those related
+to the mouse and keyboard (such as \fBEnter\fR, \fBLeave\fR,
+\fBButtonPress\fR, \fBMotion\fR, and \fBKeyPress\fR) or virtual events.
+Event bindings for a text widget use the \fBcurrent\fR mark described
+under MARKS above. An \fBEnter\fR event triggers for a tag when the tag
+first becomes present on the current character, and a \fBLeave\fR event
+triggers for a tag when it ceases to be present on the current character.
+\fBEnter\fR and \fBLeave\fR events can happen either because the
+\fBcurrent\fR mark moved or because the character at that position
+changed. Note that these events are different than \fBEnter\fR and
+\fBLeave\fR events for windows. Mouse and keyboard events are directed
+to the current character. If a virtual event is used in a binding, that
+binding can trigger only if the virtual event is defined by an underlying
+mouse-related or keyboard-related event.
+.VE
+.PP
+It is possible for the current character to have multiple tags,
+and for each of them to have a binding for a particular event
+sequence.
+When this occurs, one binding is invoked for each tag, in order
+from lowest-priority to highest priority.
+If there are multiple matching bindings for a single tag, then
+the most specific binding is chosen (see the manual entry for
+the \fBbind\fR command for details).
+\fBcontinue\fR and \fBbreak\fR commands within binding scripts
+are processed in the same way as for bindings created with
+the \fBbind\fR command.
+.PP
+If bindings are created for the widget as a whole using the
+\fBbind\fR command, then those bindings will supplement the
+tag bindings.
+The tag bindings will be invoked first, followed by bindings
+for the window as a whole.
+.RE
+.TP
+\fIpathName \fBtag cget\fR \fItagName option\fR
+This command returns the current value of the option named \fIoption\fR
+associated with the tag given by \fItagName\fR.
+\fIOption\fR may have any of the values accepted by the \fBtag configure\fR
+widget command.
+.TP
+\fIpathName \fBtag configure \fItagName\fR ?\fIoption\fR? ?\fIvalue\fR? ?\fIoption value ...\fR?
+This command is similar to the \fBconfigure\fR widget command except
+that it modifies options associated with the tag given by \fItagName\fR
+instead of modifying options for the overall text widget.
+If no \fIoption\fR is specified, the command returns a list describing
+all of the available options for \fItagName\fR (see \fBTk_ConfigureInfo\fR
+for information on the format of this list).
+If \fIoption\fR is specified with no \fIvalue\fR, then the command returns
+a list describing the one named option (this list will be identical to
+the corresponding sublist of the value returned if no \fIoption\fR
+is specified).
+If one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given option(s) to have the given value(s) in \fItagName\fR;
+in this case the command returns an empty string.
+See TAGS above for details on the options available for tags.
+.TP
+\fIpathName \fBtag delete \fItagName \fR?\fItagName ...\fR?
+Deletes all tag information for each of the \fItagName\fR
+arguments.
+The command removes the tags from all characters in the file
+and also deletes any other information associated with the tags,
+such as bindings and display information.
+The command returns an empty string.
+.TP
+\fIpathName\fB tag lower \fItagName \fR?\fIbelowThis\fR?
+Changes the priority of tag \fItagName\fR so that it is just lower
+in priority than the tag whose name is \fIbelowThis\fR.
+If \fIbelowThis\fR is omitted, then \fItagName\fR's priority
+is changed to make it lowest priority of all tags.
+.TP
+\fIpathName \fBtag names \fR?\fIindex\fR?
+Returns a list whose elements are the names of all the tags that
+are active at the character position given by \fIindex\fR.
+If \fIindex\fR is omitted, then the return value will describe
+all of the tags that exist for the text (this includes all tags
+that have been named in a ``\fIpathName \fBtag\fR'' widget
+command but haven't been deleted by a ``\fIpathName \fBtag delete\fR''
+widget command, even if no characters are currently marked with
+the tag).
+The list will be sorted in order from lowest priority to highest
+priority.
+.TP
+\fIpathName \fBtag nextrange \fItagName index1 \fR?\fIindex2\fR?
+This command searches the text for a range of characters tagged
+with \fItagName\fR where the first character of the range is
+no earlier than the character at \fIindex1\fR and no later than
+the character just before \fIindex2\fR (a range starting at
+\fIindex2\fR will not be considered).
+If several matching ranges exist, the first one is chosen.
+The command's return value is a list containing
+two elements, which are the index of the first character of the
+range and the index of the character just after the last one in
+the range.
+If no matching range is found then the return value is an
+empty string.
+If \fIindex2\fR is not given then it defaults to the end of the text.
+.TP
+\fIpathName \fBtag prevrange \fItagName index1 \fR?\fIindex2\fR?
+This command searches the text for a range of characters tagged
+with \fItagName\fR where the first character of the range is
+before the character at \fIindex1\fR and no earlier than
+the character at \fIindex2\fR (a range starting at
+\fIindex2\fR will be considered).
+If several matching ranges exist, the one closest to \fIindex1\fR is chosen.
+The command's return value is a list containing
+two elements, which are the index of the first character of the
+range and the index of the character just after the last one in
+the range.
+If no matching range is found then the return value is an
+empty string.
+If \fIindex2\fR is not given then it defaults to the beginning of the text.
+.TP
+\fIpathName\fB tag raise \fItagName \fR?\fIaboveThis\fR?
+Changes the priority of tag \fItagName\fR so that it is just higher
+in priority than the tag whose name is \fIaboveThis\fR.
+If \fIaboveThis\fR is omitted, then \fItagName\fR's priority
+is changed to make it highest priority of all tags.
+.TP
+\fIpathName \fBtag ranges \fItagName\fR
+Returns a list describing all of the ranges of text that have been
+tagged with \fItagName\fR.
+The first two elements of the list describe the first tagged range
+in the text, the next two elements describe the second range, and
+so on.
+The first element of each pair contains the index of the first
+character of the range, and the second element of the pair contains
+the index of the character just after the last one in the
+range.
+If there are no characters tagged with \fItag\fR then an
+empty string is returned.
+.TP
+\fIpathName \fBtag remove \fItagName index1 \fR?\fIindex2 index1 index2 ...\fR?
+Remove the tag \fItagName\fR from all of the characters starting
+at \fIindex1\fR and ending just before
+\fIindex2\fR (the character at \fIindex2\fR isn't affected).
+A single command may contain any number of \fIindex1\fR\-\fIindex2\fR
+pairs.
+If the last \fIindex2\fR is omitted then the single character at
+\fIindex1\fR is tagged.
+If there are no characters in the specified range (e.g. \fIindex1\fR
+is past the end of the file or \fIindex2\fR is less than or equal
+to \fIindex1\fR) then the command has no effect.
+This command returns an empty string.
+.RE
+.TP
+\fIpathName \fBwindow \fIoption \fR?\fIarg arg ...\fR?
+This command is used to manipulate embedded windows.
+The behavior of the command depends on the \fIoption\fR argument
+that follows the \fBtag\fR argument.
+The following forms of the command are currently supported:
+.RS
+.TP
+\fIpathName \fBwindow cget\fR \fIindex option\fR
+Returns the value of a configuration option for an embedded window.
+\fIIndex\fR identifies the embedded window, and \fIoption\fR
+specifies a particular configuration option, which must be one of
+the ones listed in the section EMBEDDED WINDOWS.
+.TP
+\fIpathName \fBwindow configure \fIindex\fR ?\fIoption value ...\fR?
+Query or modify the configuration options for an embedded window.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for the embedded window at \fIindex\fR
+(see \fBTk_ConfigureInfo\fR for information on the format of this list).
+If \fIoption\fR is specified with no \fIvalue\fR, then the command
+returns a list describing the one named option (this list will be
+identical to the corresponding sublist of the value returned if no
+\fIoption\fR is specified).
+If one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given option(s) to have the given value(s); in
+this case the command returns an empty string.
+See EMBEDDED WINDOWS for information on the options that
+are supported.
+.TP
+\fIpathName \fBwindow create \fIindex\fR ?\fIoption value ...\fR?
+This command creates a new window annotation, which will appear
+in the text at the position given by \fIindex\fR.
+Any number of \fIoption\-value\fR pairs may be specified to
+configure the annotation.
+See EMBEDDED WINDOWS for information on the options that
+are supported.
+Returns an empty string.
+.TP
+\fIpathName \fBwindow names\fR
+Returns a list whose elements are the names of all windows currently
+embedded in \fIwindow\fR.
+.RE
+.TP
+\fIpathName \fBxview \fIoption args\fR
+This command is used to query and change the horizontal position of the
+text in the widget's window. It can take any of the following
+forms:
+.RS
+.TP
+\fIpathName \fBxview\fR
+Returns a list containing two elements.
+Each element is a real fraction between 0 and 1; together they describe
+the portion of the document's horizontal span that is visible in
+the window.
+For example, if the first element is .2 and the second element is .6,
+20% of the text is off-screen to the left, the middle 40% is visible
+in the window, and 40% of the text is off-screen to the right.
+The fractions refer only to the lines that are actually visible in the
+window: if the lines in the window are all very short, so that they
+are entirely visible, the returned fractions will be 0 and 1,
+even if there are other lines in the text that are
+much wider than the window.
+These are the same values passed to scrollbars via the \fB\-xscrollcommand\fR
+option.
+.TP
+\fIpathName \fBxview moveto\fI fraction\fR
+Adjusts the view in the window so that \fIfraction\fR of the horizontal
+span of the text is off-screen to the left.
+\fIFraction\fR is a fraction between 0 and 1.
+.TP
+\fIpathName \fBxview scroll \fInumber what\fR
+This command shifts the view in the window left or right according to
+\fInumber\fR and \fIwhat\fR.
+\fINumber\fR must be an integer.
+\fIWhat\fR must be either \fBunits\fR or \fBpages\fR or an abbreviation
+of one of these.
+If \fIwhat\fR is \fBunits\fR, the view adjusts left or right by
+\fInumber\fR average-width characters on the display; if it is
+\fBpages\fR then the view adjusts by \fInumber\fR screenfuls.
+If \fInumber\fR is negative then characters farther to the left
+become visible; if it is positive then characters farther to the right
+become visible.
+.RE
+.TP
+\fIpathName \fByview \fI?args\fR?
+This command is used to query and change the vertical position of the
+text in the widget's window.
+It can take any of the following forms:
+.RS
+.TP
+\fIpathName \fByview\fR
+Returns a list containing two elements, both of which are real fractions
+between 0 and 1.
+The first element gives the position of the first character in the
+top line in the window, relative to the text as a whole (0.5 means
+it is halfway through the text, for example).
+The second element gives the position of the character just after
+the last one in the bottom line of the window,
+relative to the text as a whole.
+These are the same values passed to scrollbars via the \fB\-yscrollcommand\fR
+option.
+.TP
+\fIpathName \fByview moveto\fI fraction\fR
+Adjusts the view in the window so that the character given by \fIfraction\fR
+appears on the top line of the window.
+\fIFraction\fR is a fraction between 0 and 1; 0 indicates the first
+character in the text, 0.33 indicates the character one-third the
+way through the text, and so on.
+.TP
+\fIpathName \fByview scroll \fInumber what\fR
+This command adjust the view in the window up or down according to
+\fInumber\fR and \fIwhat\fR.
+\fINumber\fR must be an integer.
+\fIWhat\fR must be either \fBunits\fR or \fBpages\fR.
+If \fIwhat\fR is \fBunits\fR, the view adjusts up or down by
+\fInumber\fR lines on the display; if it is \fBpages\fR then
+the view adjusts by \fInumber\fR screenfuls.
+If \fInumber\fR is negative then earlier positions in the text
+become visible; if it is positive then later positions in the text
+become visible.
+.TP
+\fIpathName \fByview \fR?\fB\-pickplace\fR? \fIindex\fR
+Changes the view in the widget's window to make \fIindex\fR visible.
+If the \fB\-pickplace\fR option isn't specified then \fIindex\fR will
+appear at the top of the window.
+If \fB\-pickplace\fR is specified then the widget chooses where
+\fIindex\fR appears in the window:
+.RS
+.IP [1]
+If \fIindex\fR is already visible somewhere in the window then the
+command does nothing.
+.IP [2]
+If \fIindex\fR is only a few lines off-screen above the window then
+it will be positioned at the top of the window.
+.IP [3]
+If \fIindex\fR is only a few lines off-screen below the window then
+it will be positioned at the bottom of the window.
+.IP [4]
+Otherwise, \fIindex\fR will be centered in the window.
+.LP
+The \fB\-pickplace\fR option has been obsoleted by the \fBsee\fR widget
+command (\fBsee\fR handles both x- and y-motion to make a location
+visible, whereas \fB\-pickplace\fR only handles motion in y).
+.RE
+.TP
+\fIpathName \fByview \fInumber\fR
+This command makes the first character on the line after
+the one given by \fInumber\fR visible at the top of the window.
+\fINumber\fR must be an integer.
+This command used to be used for scrolling, but now it is obsolete.
+.RE
+
+.SH BINDINGS
+.PP
+Tk automatically creates class bindings for texts that give them
+the following default behavior.
+In the descriptions below, ``word'' refers to a contiguous group
+of letters, digits, or ``_'' characters, or any single character
+other than these.
+.IP [1]
+Clicking mouse button 1 positions the insertion cursor
+just before the character underneath the mouse cursor, sets the
+input focus to this widget, and clears any selection in the widget.
+Dragging with mouse button 1 strokes out a selection between
+the insertion cursor and the character under the mouse.
+.IP [2]
+Double-clicking with mouse button 1 selects the word under the mouse
+and positions the insertion cursor at the beginning of the word.
+Dragging after a double click will stroke out a selection consisting
+of whole words.
+.IP [3]
+Triple-clicking with mouse button 1 selects the line under the mouse
+and positions the insertion cursor at the beginning of the line.
+Dragging after a triple click will stroke out a selection consisting
+of whole lines.
+.IP [4]
+The ends of the selection can be adjusted by dragging with mouse
+button 1 while the Shift key is down; this will adjust the end
+of the selection that was nearest to the mouse cursor when button
+1 was pressed.
+If the button is double-clicked before dragging then the selection
+will be adjusted in units of whole words; if it is triple-clicked
+then the selection will be adjusted in units of whole lines.
+.IP [5]
+Clicking mouse button 1 with the Control key down will reposition the
+insertion cursor without affecting the selection.
+.IP [6]
+If any normal printing characters are typed, they are
+inserted at the point of the insertion cursor.
+.IP [7]
+The view in the widget can be adjusted by dragging with mouse button 2.
+If mouse button 2 is clicked without moving the mouse, the selection
+is copied into the text at the position of the mouse cursor.
+The Insert key also inserts the selection, but at the position of
+the insertion cursor.
+.IP [8]
+If the mouse is dragged out of the widget
+while button 1 is pressed, the entry will automatically scroll to
+make more text visible (if there is more text off-screen on the side
+where the mouse left the window).
+.IP [9]
+The Left and Right keys move the insertion cursor one character to the
+left or right; they also clear any selection in the text.
+If Left or Right is typed with the Shift key down, then the insertion
+cursor moves and the selection is extended to include the new character.
+Control-Left and Control-Right move the insertion cursor by words, and
+Control-Shift-Left and Control-Shift-Right move the insertion cursor
+by words and also extend the selection.
+Control-b and Control-f behave the same as Left and Right, respectively.
+Meta-b and Meta-f behave the same as Control-Left and Control-Right,
+respectively.
+.IP [10]
+The Up and Down keys move the insertion cursor one line up or
+down and clear any selection in the text.
+If Up or Right is typed with the Shift key down, then the insertion
+cursor moves and the selection is extended to include the new character.
+Control-Up and Control-Down move the insertion cursor by paragraphs (groups
+of lines separated by blank lines), and
+Control-Shift-Up and Control-Shift-Down move the insertion cursor
+by paragraphs and also extend the selection.
+Control-p and Control-n behave the same as Up and Down, respectively.
+.IP [11]
+The Next and Prior keys move the insertion cursor forward or backwards
+by one screenful and clear any selection in the text.
+If the Shift key is held down while Next or Prior is typed, then
+the selection is extended to include the new character.
+Control-v moves the view down one screenful without moving the
+insertion cursor or adjusting the selection.
+.IP [12]
+Control-Next and Control-Prior scroll the view right or left by one page
+without moving the insertion cursor or affecting the selection.
+.IP [13]
+Home and Control-a move the insertion cursor to the
+beginning of its line and clear any selection in the widget.
+Shift-Home moves the insertion cursor to the beginning of the line
+and also extends the selection to that point.
+.IP [14]
+End and Control-e move the insertion cursor to the
+end of the line and clear any selection in the widget.
+Shift-End moves the cursor to the end of the line and extends the selection
+to that point.
+.IP [15]
+Control-Home and Meta-< move the insertion cursor to the beginning of
+the text and clear any selection in the widget.
+Control-Shift-Home moves the insertion cursor to the beginning of the text
+and also extends the selection to that point.
+.IP [16]
+Control-End and Meta-> move the insertion cursor to the end of the
+text and clear any selection in the widget.
+Control-Shift-End moves the cursor to the end of the text and extends
+the selection to that point.
+.IP [17]
+The Select key and Control-Space set the selection anchor to the position
+of the insertion cursor. They don't affect the current selection.
+Shift-Select and Control-Shift-Space adjust the selection to the
+current position of the insertion cursor, selecting from the anchor
+to the insertion cursor if there was not any selection previously.
+.IP [18]
+Control-/ selects the entire contents of the widget.
+.IP [19]
+Control-\e clears any selection in the widget.
+.IP [20]
+The F16 key (labelled Copy on many Sun workstations) or Meta-w
+copies the selection in the widget to the clipboard, if there is a selection.
+.IP [21]
+The F20 key (labelled Cut on many Sun workstations) or Control-w
+copies the selection in the widget to the clipboard and deletes
+the selection.
+If there is no selection in the widget then these keys have no effect.
+.IP [22]
+The F18 key (labelled Paste on many Sun workstations) or Control-y
+inserts the contents of the clipboard at the position of the
+insertion cursor.
+.IP [23]
+The Delete key deletes the selection, if there is one in the widget.
+If there is no selection, it deletes the character to the right of
+the insertion cursor.
+.IP [24]
+Backspace and Control-h delete the selection, if there is one
+in the widget.
+If there is no selection, they delete the character to the left of
+the insertion cursor.
+.IP [25]
+Control-d deletes the character to the right of the insertion cursor.
+.IP [26]
+Meta-d deletes the word to the right of the insertion cursor.
+.IP [27]
+Control-k deletes from the insertion cursor to the end of its line;
+if the insertion cursor is already at the end of a line, then
+Control-k deletes the newline character.
+.IP [28]
+Control-o opens a new line by inserting a newline character in
+front of the insertion cursor without moving the insertion cursor.
+.IP [29]
+Meta-backspace and Meta-Delete delete the word to the left of the
+insertion cursor.
+.IP [30]
+Control-x deletes whatever is selected in the text widget.
+.IP [31]
+Control-t reverses the order of the two characters to the right of
+the insertion cursor.
+.PP
+If the widget is disabled using the \fB\-state\fR option, then its
+view can still be adjusted and text can still be selected,
+but no insertion cursor will be displayed and no text modifications will
+take place.
+.PP
+The behavior of texts can be changed by defining new bindings for
+individual widgets or by redefining the class bindings.
+
+.SH "PERFORMANCE ISSUES"
+.PP
+Text widgets should run efficiently under a variety
+of conditions. The text widget uses about 2-3 bytes of
+main memory for each byte of text, so texts containing a megabyte
+or more should be practical on most workstations.
+Text is represented internally with a modified B-tree structure
+that makes operations relatively efficient even with large texts.
+Tags are included in the B-tree structure in a way that allows
+tags to span large ranges or have many disjoint smaller ranges
+without loss of efficiency.
+Marks are also implemented in a way that allows large numbers of
+marks.
+In most cases it is fine to have large numbers of unique tags,
+or a tag that has many distinct ranges.
+.PP
+One performance problem can arise if you have hundreds or thousands
+of different tags that all have the following characteristics:
+the first and last ranges of each tag are near the beginning and
+end of the text, respectively,
+or a single tag range covers most of the text widget.
+The cost of adding and deleting tags like this is proportional
+to the number of other tags with the same properties.
+In contrast, there is no problem with having thousands of distinct
+tags if their overall ranges are localized and spread uniformly throughout
+the text.
+.PP
+Very long text lines can be expensive,
+especially if they have many marks and tags within them.
+.PP
+The display line with the insert cursor is redrawn each time the
+cursor blinks, which causes a steady stream of graphics traffic.
+Set the \fBinsertOffTime\fP attribute to 0 avoid this.
+.SH KEYWORDS
+text, widget
diff --git a/tk/doc/tk.n b/tk/doc/tk.n
new file mode 100644
index 00000000000..b31533ae0c9
--- /dev/null
+++ b/tk/doc/tk.n
@@ -0,0 +1,72 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBtk\fR \fIoption \fR?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBtk\fR command provides access to miscellaneous
+elements of Tk's internal state.
+Most of the information manipulated by this command pertains to the
+application as a whole, or to a screen or display, rather than to a
+particular window.
+The command can take any of a number of different forms
+depending on the \fIoption\fR argument. The legal forms are:
+.TP
+\fBtk appname \fR?\fInewName\fR?
+If \fInewName\fR isn't specified, this command returns the name
+of the application (the name that may be used in \fBsend\fR
+commands to communicate with the application).
+If \fInewName\fR is specified, then the name of the application
+is changed to \fInewName\fR.
+If the given name is already in use, then a suffix of the form
+``\fB #2\fR'' or ``\fB #3\fR'' is appended in order to make the name unique.
+The command's result is the name actually chosen.
+\fInewName\fR should not start with a capital letter.
+This will interfere with option processing, since names starting with
+capitals are assumed to be classes; as a result, Tk may not
+be able to find some options for the application.
+If sends have been disabled by deleting the \fBsend\fR command,
+this command will reenable them and recreate the \fBsend\fR
+command.
+.VS
+.TP
+\fBtk scaling \fR?\fB\-displayof \fIwindow\fR? ?\fInumber\fR?
+.
+Sets and queries the current scaling factor used by Tk to convert between
+physical units (for example, points, inches, or millimeters) and pixels. The
+\fInumber\fR argument is a floating point number that specifies the number of
+pixels per point on \fIwindow\fR's display. If the \fIwindow\fR argument is
+omitted, it defaults to the main window. If the \fInumber\fR argument is
+omitted, the current value of the scaling factor is returned.
+.RS
+.PP
+A ``point'' is a unit of measurement equal to 1/72 inch. A scaling factor
+of 1.0 corresponds to 1 pixel per point, which is equivalent to a standard
+72 dpi monitor. A scaling factor of 1.25 would mean 1.25 pixels per point,
+which is the setting for a 90 dpi monitor; setting the scaling factor to
+1.25 on a 72 dpi monitor would cause everything in the application to be
+displayed 1.25 times as large as normal. The initial value for the scaling
+factor is set when the application starts, based on properties of the
+installed monitor, but it can be changed at any time. Measurements made
+after the scaling factor is changed will use the new scaling factor, but it
+is undefined whether existing widgets will resize themselves dynamically to
+accomodate the new scaling factor.
+.RE
+.VE
+.SH KEYWORDS
+application name, send
diff --git a/tk/doc/tkerror.n b/tk/doc/tkerror.n
new file mode 100644
index 00000000000..9ccee96b1bc
--- /dev/null
+++ b/tk/doc/tkerror.n
@@ -0,0 +1,38 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBtkerror \fImessage\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+Note: as of Tk 4.1 the \fBtkerror\fR command has been renamed to
+\fBbgerror\fR because the event loop (which is what usually invokes
+it) is now part of Tcl. For backward compatibility
+the \fBbgerror\fR provided by the current Tk version still
+tries to call \fBtkerror\fR if there is one (or an auto loadable one),
+so old script defining that error handler should still work, but you
+should anyhow modify your scripts to use \fBbgerror\fR instead
+of \fBtkerror\fR because that support for the old name might vanish
+in the near future. If that call fails, \fBbgerror\fR
+posts a dialog showing the error and offering to see the stack trace
+to the user. If you want your own error management you should
+directly override \fBbgerror\fR instead of \fBtkerror\fR.
+Documentation for \fBbgerror\fR is available as part of Tcl's
+documentation.
+
+.SH KEYWORDS
+background error, reporting
diff --git a/tk/doc/tkvars.n b/tk/doc/tkvars.n
new file mode 100644
index 00000000000..22d2c292e0b
--- /dev/null
+++ b/tk/doc/tkvars.n
@@ -0,0 +1,72 @@
+'\"
+'\" 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$
+'\"
+.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
+.BE
+
+.SH DESCRIPTION
+.PP
+The following Tcl variables are either set or used by Tk at various times
+in its execution:
+.TP 15
+\fBtk_library\fR
+This variable holds the file name for a directory containing a library
+of Tcl scripts related to Tk. These scripts include an initialization
+file that is normally processed whenever a Tk application starts up,
+plus other files containing procedures that implement default behaviors
+for widgets.
+The initial value of \fBtcl_library\fR is set when Tk is added to
+an interpreter; this is done by searching several different directories
+until one is found that contains an appropriate Tk startup script.
+If the \fBTK_LIBRARY\fR environment variable exists, then
+the directory it names is checked first.
+If \fBTK_LIBRARY\fR isn't set or doesn't refer to an appropriate
+directory, then Tk checks several other directories based on a
+compiled-in default location, the location of the Tcl library directory,
+the location of the binary containing the application, and the current
+working directory.
+The variable can be modified by an application to switch to a different
+library.
+.TP
+\fBtk_patchLevel\fR
+Contains a decimal integer giving the current patch level for Tk.
+The patch level is incremented for each new release or patch, and
+it uniquely identifies an official version of Tk.
+.TP
+\fBtkPriv\fR
+This variable is an array containing several pieces of information
+that are private to Tk. The elements of \fBtkPriv\fR are used by
+Tk library procedures and default bindings.
+They should not be accessed by any code outside Tk.
+.TP
+\fBtk_strictMotif\fR
+This variable is set to zero by default.
+If an application sets it to one, then Tk attempts to adhere as
+closely as possible to Motif look-and-feel standards.
+For example, active elements such as buttons and scrollbar
+sliders will not change color when the pointer passes over them.
+.TP 15
+\fBtk_version\fR
+Tk sets this variable in the interpreter for each application.
+The variable holds the current version number of the Tk
+library in the form \fImajor\fR.\fIminor\fR. \fIMajor\fR and
+\fIminor\fR are integers. The major version number increases in
+any Tk release that includes changes that are not backward compatible
+(i.e. whenever existing Tk applications and scripts may have to change to
+work with the new release). The minor version number increases with
+each new release of Tk, except that it resets to zero whenever the
+major version number changes.
+
+.SH KEYWORDS
+variables, version
diff --git a/tk/doc/tkwait.n b/tk/doc/tkwait.n
new file mode 100644
index 00000000000..0c39f384975
--- /dev/null
+++ b/tk/doc/tkwait.n
@@ -0,0 +1,51 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBtkwait variable \fIname\fR
+.sp
+\fBtkwait visibility \fIname\fR
+.sp
+\fBtkwait window \fIname\fR
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBtkwait\fR command waits for one of several things to happen,
+then it returns without taking any other actions.
+The return value is always an empty string.
+If the first argument is \fBvariable\fR (or any abbreviation of
+it) then the second argument is the name of a global variable and the
+command waits for that variable to be modified.
+If the first argument is \fBvisibility\fR (or any abbreviation
+of it) then the second argument is the name of a window and the
+\fBtkwait\fR command waits for a change in its
+visibility state (as indicated by the arrival of a VisibilityNotify
+event). This form is typically used to wait for a newly-created
+window to appear on the screen before taking some action.
+If the first argument is \fBwindow\fR (or any abbreviation
+of it) then the second argument is the name of a window and the
+\fBtkwait\fR command waits for that window to be destroyed.
+This form is typically used to wait for a user to finish interacting
+with a dialog box before using the result of that interaction.
+.PP
+While the \fBtkwait\fR command is waiting it processes events in
+the normal fashion, so the application will continue to respond
+to user interactions.
+If an event handler invokes \fBtkwait\fR again, the nested call
+to \fBtkwait\fR must complete before the outer call can complete.
+
+.SH KEYWORDS
+variable, visibility, wait, window
diff --git a/tk/doc/toplevel.n b/tk/doc/toplevel.n
new file mode 100644
index 00000000000..9b980300d85
--- /dev/null
+++ b/tk/doc/toplevel.n
@@ -0,0 +1,163 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBtoplevel\fR \fIpathName \fR?\fIoptions\fR?
+.SO
+\-borderwidth \-highlightbackground \-highlightthickness \-takefocus
+\-cursor \-highlightcolor \-relief
+.SE
+.SH "WIDGET-SPECIFIC OPTIONS"
+.OP \-background background Background
+This option is the same as the standard \fBbackground\fR option
+except that its value may also be specified as an empty string.
+In this case, the widget will display no background or border, and
+no colors will be consumed from its colormap for its background
+and border.
+.OP \-class class Class
+Specifies a class for the window.
+This class will be used when querying the option database for
+the window's other options, and it will also be used later for
+other purposes such as bindings.
+The \fBclass\fR option may not be changed with the \fBconfigure\fR
+widget command.
+.OP \-colormap colormap Colormap
+Specifies a colormap to use for the window.
+The value may be either \fBnew\fR, in which case a new colormap is
+created for the window and its children, or the name of another
+window (which must be on the same screen and have the same visual
+as \fIpathName\fR), in which case the new window will use the colormap
+from the specified window.
+If the \fBcolormap\fR option is not specified, the new window
+uses the default colormap of its screen.
+This option may not be changed with the \fBconfigure\fR
+widget command.
+.VS 8.0 br
+.OP \-container container Container
+The value must be a boolean. If true, it means that this window will
+be used as a container in which some other application will be embedded
+(for example, a Tk toplevel can be embedded using the \fB\-use\fR option).
+The window will support the appropriate window manager protocols for
+things like geometry requests. The window should not have any
+children of its own in this application.
+This option may not be changed with the \fBconfigure\fR
+widget command.
+.VE
+.OP \-height height Height
+Specifies the desired height for the window in any of the forms
+acceptable to \fBTk_GetPixels\fR.
+If this option is less than or equal to zero then the window will
+not request any size at all.
+.VS 8.0 br
+.OP \-menu menu Menu
+Specifies a menu widget to be used as a menubar. On the Macintosh, the
+menubar will be displayed accross the top of the main monitor. On
+Microsoft Windows and all UNIX platforms, the menu will appear accross
+the toplevel window as part of the window dressing maintained by the
+window manager.
+.VE
+.OP \-screen "" ""
+Specifies the screen on which to place the new window.
+Any valid screen name may be used, even one associated with a
+different display.
+Defaults to the same screen as its parent.
+This option is special in that it may not be specified via the option
+database, and it may not be modified with the \fBconfigure\fR
+widget command.
+.VS 8.0 br
+.OP \-use use Use
+This option is used for embedding. If the value isn't an empty string,
+it must be the the window identifier of a container window, specified as
+a hexadecimal string like the ones returned by the \fBwinfo id\fR
+command. The toplevel widget will be created as a child of the given
+container instead of the root window for the screen. If the container
+window is in a Tk application, it must be a frame or toplevel widget for
+which the \fB\-container\fR option was specified.
+This option may not be changed with the \fBconfigure\fR
+widget command.
+.VE
+.OP \-visual visual Visual
+Specifies visual information for the new window in any of the
+forms accepted by \fBTk_GetVisual\fR.
+If this option is not specified, the new window will use the default
+visual for its screen.
+The \fBvisual\fR option may not be modified with the \fBconfigure\fR
+widget command.
+.OP \-width width Width
+Specifies the desired width for the window in any of the forms
+acceptable to \fBTk_GetPixels\fR.
+If this option is less than or equal to zero then the window will
+not request any size at all.
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBtoplevel\fR command creates a new toplevel widget (given
+by the \fIpathName\fR argument). Additional
+options, described above, may be specified on the command line
+or in the option database
+to configure aspects of the toplevel such as its background color
+and relief. The \fBtoplevel\fR command returns the
+path name of the new window.
+.PP
+A toplevel is similar to a frame except that it is created as a
+top-level window: its X parent is the root window of a screen
+rather than the logical parent from its path name. The primary
+purpose of a toplevel is to serve as a container for dialog boxes
+and other collections of widgets. The only visible features
+of a toplevel are its background color and an optional 3-D border
+to make the toplevel appear raised or sunken.
+
+.SH "WIDGET COMMAND"
+.PP
+The \fBtoplevel\fR command creates a new Tcl command whose
+name is the same as the path name of the toplevel's window. This
+command may be used to invoke various
+operations on the widget. It has the following general form:
+.CS
+\fIpathName option \fR?\fIarg arg ...\fR?
+.CE
+\fIPathName\fR is the name of the command, which is the same as
+the toplevel widget's path name. \fIOption\fR and the \fIarg\fRs
+determine the exact behavior of the command. The following
+commands are possible for toplevel widgets:
+.TP
+\fIpathName \fBcget\fR \fIoption\fR
+Returns the current value of the configuration option given
+by \fIoption\fR.
+\fIOption\fR may have any of the values accepted by the \fBtoplevel\fR
+command.
+.TP
+\fIpathName \fBconfigure\fR ?\fIoption\fR? ?\fIvalue option value ...\fR?
+Query or modify the configuration options of the widget.
+If no \fIoption\fR is specified, returns a list describing all of
+the available options for \fIpathName\fR (see \fBTk_ConfigureInfo\fR for
+information on the format of this list). If \fIoption\fR is specified
+with no \fIvalue\fR, then the command returns a list describing the
+one named option (this list will be identical to the corresponding
+sublist of the value returned if no \fIoption\fR is specified). If
+one or more \fIoption\-value\fR pairs are specified, then the command
+modifies the given widget option(s) to have the given value(s); in
+this case the command returns an empty string.
+\fIOption\fR may have any of the values accepted by the \fBtoplevel\fR
+command.
+
+.SH BINDINGS
+.PP
+When a new toplevel is created, it has no default event bindings:
+toplevels are not intended to be interactive.
+
+.SH KEYWORDS
+toplevel, widget
diff --git a/tk/doc/winfo.n b/tk/doc/winfo.n
new file mode 100644
index 00000000000..5272c09adb6
--- /dev/null
+++ b/tk/doc/winfo.n
@@ -0,0 +1,330 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBwinfo\fR \fIoption \fR?\fIarg arg ...\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBwinfo\fR command is used to retrieve information about windows
+managed by Tk. It can take any of a number of different forms,
+depending on the \fIoption\fR argument. The legal forms are:
+.TP
+\fBwinfo atom \fR?\fB\-displayof \fIwindow\fR? \fIname\fR
+Returns a decimal string giving the integer identifier for the
+atom whose name is \fIname\fR. If no atom exists with the name
+\fIname\fR then a new one is created.
+If the \fB\-displayof\fR option is given then the atom is looked
+up on the display of \fIwindow\fR; otherwise it is looked up on
+the display of the application's main window.
+.TP
+\fBwinfo atomname \fR?\fB\-displayof \fIwindow\fR? \fIid\fR
+Returns the textual name for the atom whose integer identifier is
+\fIid\fR.
+If the \fB\-displayof\fR option is given then the identifier is looked
+up on the display of \fIwindow\fR; otherwise it is looked up on
+the display of the application's main window.
+This command is the inverse of the \fBwinfo atom\fR command.
+It generates an error if no such atom exists.
+.TP
+\fBwinfo cells \fIwindow\fR
+Returns a decimal string giving the number of cells in the
+color map for \fIwindow\fR.
+.TP
+\fBwinfo children \fIwindow\fR
+Returns a list containing the path names of all the children
+of \fIwindow\fR. The list is in stacking order, with the lowest
+window first. Top-level windows are returned as children
+of their logical parents.
+.TP
+\fBwinfo class \fIwindow\fR
+Returns the class name for \fIwindow\fR.
+.TP
+\fBwinfo colormapfull \fIwindow\fR
+Returns 1 if the colormap for \fIwindow\fR is known to be full, 0
+otherwise. The colormap for a window is ``known'' to be full if the last
+attempt to allocate a new color on that window failed and this
+application hasn't freed any colors in the colormap since the
+failed allocation.
+.TP
+\fBwinfo containing \fR?\fB\-displayof \fIwindow\fR? \fIrootX rootY\fR
+Returns the path name for the window containing the point given
+by \fIrootX\fR and \fIrootY\fR.
+\fIRootX\fR and \fIrootY\fR are specified in screen units (i.e.
+any form acceptable to \fBTk_GetPixels\fR) in the coordinate
+system of the root window (if a virtual-root window manager is in
+use then the coordinate system of the virtual root window is used).
+If the \fB\-displayof\fR option is given then the coordinates refer
+to the screen containing \fIwindow\fR; otherwise they refer to the
+screen of the application's main window.
+If no window in this application contains the point then an empty
+string is returned.
+In selecting the containing window, children are given higher priority
+than parents and among siblings the highest one in the stacking order is
+chosen.
+.TP
+\fBwinfo depth \fIwindow\fR
+Returns a decimal string giving the depth of \fIwindow\fR (number
+of bits per pixel).
+.TP
+\fBwinfo exists \fIwindow\fR
+Returns 1 if there exists a window named \fIwindow\fR, 0 if no such
+window exists.
+.TP
+\fBwinfo fpixels \fIwindow\fR \fInumber\fR
+Returns a floating-point value giving the number of pixels
+in \fIwindow\fR corresponding to the distance given by \fInumber\fR.
+\fINumber\fR may be specified in any of the forms acceptable
+to \fBTk_GetScreenMM\fR, such as ``2.0c'' or ``1i''.
+The return value may be fractional; for an integer value, use
+\fBwinfo pixels\fR.
+.TP
+\fBwinfo geometry \fIwindow\fR
+Returns the geometry for \fIwindow\fR, in the form
+\fIwidth\fBx\fIheight\fB+\fIx\fB+\fIy\fR. All dimensions are
+in pixels.
+.TP
+\fBwinfo height \fIwindow\fR
+Returns a decimal string giving \fIwindow\fR's height in pixels.
+When a window is first created its height will be 1 pixel; the
+height will eventually be changed by a geometry manager to fulfill
+the window's needs.
+If you need the true height immediately after creating a widget,
+invoke \fBupdate\fR to force the geometry manager to arrange it,
+or use \fBwinfo reqheight\fR to get the window's requested height
+instead of its actual height.
+.TP
+\fBwinfo id \fIwindow\fR
+.VS
+Returns a hexadecimal string giving a low-level platform-specific
+identifier for \fIwindow\fR. On Unix platforms, this is the X
+window identifier. Under Windows, this is the Windows
+HWND. On the Macintosh the value has no meaning outside Tk.
+.VE
+.TP
+\fBwinfo interps \fR?\fB\-displayof \fIwindow\fR?
+Returns a list whose members are the names of all Tcl interpreters
+(e.g. all Tk-based applications) currently registered for a particular display.
+If the \fB\-displayof\fR option is given then the return value refers
+to the display of \fIwindow\fR; otherwise it refers to
+the display of the application's main window.
+.TP
+\fBwinfo ismapped \fIwindow\fR
+Returns \fB1\fR if \fIwindow\fR is currently mapped, \fB0\fR otherwise.
+.TP
+\fBwinfo manager \fIwindow\fR
+Returns the name of the geometry manager currently
+responsible for \fIwindow\fR, or an empty string if \fIwindow\fR
+isn't managed by any geometry manager.
+The name is usually the name of the Tcl command for the geometry
+manager, such as \fBpack\fR or \fBplace\fR.
+If the geometry manager is a widget, such as canvases or text, the
+name is the widget's class command, such as \fBcanvas\fR.
+.TP
+\fBwinfo name \fIwindow\fR
+Returns \fIwindow\fR's name (i.e. its name within its parent, as opposed
+to its full path name).
+The command \fBwinfo name .\fR will return the name of the application.
+.TP
+\fBwinfo parent \fIwindow\fR
+Returns the path name of \fIwindow\fR's parent, or an empty string
+if \fIwindow\fR is the main window of the application.
+.TP
+\fBwinfo pathname \fR?\fB\-displayof \fIwindow\fR? \fIid\fR
+Returns the path name of the window whose X identifier is \fIid\fR.
+\fIId\fR must be a decimal, hexadecimal, or octal integer and must
+correspond to a window in the invoking application.
+If the \fB\-displayof\fR option is given then the identifier is looked
+up on the display of \fIwindow\fR; otherwise it is looked up on
+the display of the application's main window.
+.TP
+\fBwinfo pixels \fIwindow\fR \fInumber\fR
+Returns the number of pixels in \fIwindow\fR corresponding
+to the distance given by \fInumber\fR.
+\fINumber\fR may be specified in any of the forms acceptable
+to \fBTk_GetPixels\fR, such as ``2.0c'' or ``1i''.
+The result is rounded to the nearest integer value; for a
+fractional result, use \fBwinfo fpixels\fR.
+.TP
+\fBwinfo pointerx \fIwindow\fR
+If the mouse pointer is on the same screen as \fIwindow\fR, returns the
+pointer's x coordinate, measured in pixels in the screen's root window.
+If a virtual root window is in use on the screen, the position is
+measured in the virtual root.
+If the mouse pointer isn't on the same screen as \fIwindow\fR then
+-1 is returned.
+.TP
+\fBwinfo pointerxy \fIwindow\fR
+If the mouse pointer is on the same screen as \fIwindow\fR, returns a list
+with two elements, which are the pointer's x and y coordinates measured
+in pixels in the screen's root window.
+If a virtual root window is in use on the screen, the position
+is computed in the virtual root.
+If the mouse pointer isn't on the same screen as \fIwindow\fR then
+both of the returned coordinates are -1.
+.TP
+\fBwinfo pointery \fIwindow\fR
+If the mouse pointer is on the same screen as \fIwindow\fR, returns the
+pointer's y coordinate, measured in pixels in the screen's root window.
+If a virtual root window is in use on the screen, the position
+is computed in the virtual root.
+If the mouse pointer isn't on the same screen as \fIwindow\fR then
+-1 is returned.
+.TP
+\fBwinfo reqheight \fIwindow\fR
+Returns a decimal string giving \fIwindow\fR's requested height,
+in pixels. This is the value used by \fIwindow\fR's geometry
+manager to compute its geometry.
+.TP
+\fBwinfo reqwidth \fIwindow\fR
+Returns a decimal string giving \fIwindow\fR's requested width,
+in pixels. This is the value used by \fIwindow\fR's geometry
+manager to compute its geometry.
+.TP
+\fBwinfo rgb \fIwindow color\fR
+Returns a list containing three decimal values, which are the
+red, green, and blue intensities that correspond to \fIcolor\fR in
+the window given by \fIwindow\fR. \fIColor\fR
+may be specified in any of the forms acceptable for a color
+option.
+.TP
+\fBwinfo rootx \fIwindow\fR
+Returns a decimal string giving the x-coordinate, in the root
+window of the screen, of the
+upper-left corner of \fIwindow\fR's border (or \fIwindow\fR if it
+has no border).
+.TP
+\fBwinfo rooty \fIwindow\fR
+Returns a decimal string giving the y-coordinate, in the root
+window of the screen, of the
+upper-left corner of \fIwindow\fR's border (or \fIwindow\fR if it
+has no border).
+.TP
+\fBwinfo screen \fIwindow\fR
+Returns the name of the screen associated with \fIwindow\fR, in
+the form \fIdisplayName\fR.\fIscreenIndex\fR.
+.TP
+\fBwinfo screencells \fIwindow\fR
+Returns a decimal string giving the number of cells in the default
+color map for \fIwindow\fR's screen.
+.TP
+\fBwinfo screendepth \fIwindow\fR
+Returns a decimal string giving the depth of the root window
+of \fIwindow\fR's screen (number of bits per pixel).
+.TP
+\fBwinfo screenheight \fIwindow\fR
+Returns a decimal string giving the height of \fIwindow\fR's screen,
+in pixels.
+.TP
+\fBwinfo screenmmheight \fIwindow\fR
+Returns a decimal string giving the height of \fIwindow\fR's screen,
+in millimeters.
+.TP
+\fBwinfo screenmmwidth \fIwindow\fR
+Returns a decimal string giving the width of \fIwindow\fR's screen,
+in millimeters.
+.TP
+\fBwinfo screenvisual \fIwindow\fR
+Returns one of the following strings to indicate the default visual
+class for \fIwindow\fR's screen: \fBdirectcolor\fR, \fBgrayscale\fR,
+\fBpseudocolor\fR, \fBstaticcolor\fR, \fBstaticgray\fR, or
+\fBtruecolor\fR.
+.TP
+\fBwinfo screenwidth \fIwindow\fR
+Returns a decimal string giving the width of \fIwindow\fR's screen,
+in pixels.
+.TP
+\fBwinfo server \fIwindow\fR
+Returns a string containing information about the server for
+\fIwindow\fR's display. The exact format of this string may vary
+from platform to platform. For X servers the string
+has the form ``\fBX\fImajor\fBR\fIminor vendor vendorVersion\fR''
+where \fImajor\fR and \fIminor\fR are the version and revision
+numbers provided by the server (e.g., \fBX11R5\fR), \fIvendor\fR
+is the name of the vendor for the server, and \fIvendorRelease\fR
+is an integer release number provided by the server.
+.TP
+\fBwinfo toplevel \fIwindow\fR
+Returns the path name of the top-level window containing \fIwindow\fR.
+.TP
+\fBwinfo viewable \fIwindow\fR
+Returns 1 if \fIwindow\fR and all of its ancestors up through the
+nearest toplevel window are mapped. Returns 0 if any of these
+windows are not mapped.
+.TP
+\fBwinfo visual \fIwindow\fR
+Returns one of the following strings to indicate the visual
+class for \fIwindow\fR: \fBdirectcolor\fR, \fBgrayscale\fR,
+\fBpseudocolor\fR, \fBstaticcolor\fR, \fBstaticgray\fR, or
+\fBtruecolor\fR.
+.TP
+\fBwinfo visualid \fIwindow\fR
+Returns the X identifier for the visual for \fIwindow\fR.
+.TP
+\fBwinfo visualsavailable \fIwindow\fR ?\fBincludeids\fR?
+Returns a list whose elements describe the visuals available for
+\fIwindow\fR's screen.
+Each element consists of a visual class followed by an integer depth.
+The class has the same form as returned by \fBwinfo visual\fR.
+The depth gives the number of bits per pixel in the visual.
+In addition, if the \fBincludeids\fR argument is provided, then the
+depth is followed by the X identifier for the visual.
+.TP
+\fBwinfo vrootheight \fIwindow\fR
+Returns the height of the virtual root window associated with \fIwindow\fR
+if there is one; otherwise returns the height of \fIwindow\fR's screen.
+.TP
+\fBwinfo vrootwidth \fIwindow\fR
+Returns the width of the virtual root window associated with \fIwindow\fR
+if there is one; otherwise returns the width of \fIwindow\fR's screen.
+.TP
+\fBwinfo vrootx \fIwindow\fR
+Returns the x-offset of the virtual root window associated with \fIwindow\fR,
+relative to the root window of its screen.
+This is normally either zero or negative.
+Returns 0 if there is no virtual root window for \fIwindow\fR.
+.TP
+\fBwinfo vrooty \fIwindow\fR
+Returns the y-offset of the virtual root window associated with \fIwindow\fR,
+relative to the root window of its screen.
+This is normally either zero or negative.
+Returns 0 if there is no virtual root window for \fIwindow\fR.
+.TP
+\fBwinfo width \fIwindow\fR
+Returns a decimal string giving \fIwindow\fR's width in pixels.
+When a window is first created its width will be 1 pixel; the
+width will eventually be changed by a geometry manager to fulfill
+the window's needs.
+If you need the true width immediately after creating a widget,
+invoke \fBupdate\fR to force the geometry manager to arrange it,
+or use \fBwinfo reqwidth\fR to get the window's requested width
+instead of its actual width.
+.TP
+\fBwinfo x \fIwindow\fR
+Returns a decimal string giving the x-coordinate, in \fIwindow\fR's
+parent, of the
+upper-left corner of \fIwindow\fR's border (or \fIwindow\fR if it
+has no border).
+.TP
+\fBwinfo y \fIwindow\fR
+Returns a decimal string giving the y-coordinate, in \fIwindow\fR's
+parent, of the
+upper-left corner of \fIwindow\fR's border (or \fIwindow\fR if it
+has no border).
+
+.SH KEYWORDS
+atom, children, class, geometry, height, identifier, information, interpreters,
+mapped, parent, path name, screen, virtual root, width, window
diff --git a/tk/doc/wish.1 b/tk/doc/wish.1
new file mode 100644
index 00000000000..4afc2be5dff
--- /dev/null
+++ b/tk/doc/wish.1
@@ -0,0 +1,186 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBwish\fR ?\fIfileName arg arg ...\fR?
+.SH OPTIONS
+.IP "\fB\-colormap \fInew\fR" 20
+Specifies that the window should have a new private colormap instead of
+using the default colormap for the screen.
+.IP "\fB\-display \fIdisplay\fR" 20
+Display (and screen) on which to display window.
+.IP "\fB\-geometry \fIgeometry\fR" 20
+Initial geometry to use for window. If this option is specified, its
+value is stored in the \fBgeometry\fR global variable of the application's
+Tcl interpreter.
+.IP "\fB\-name \fIname\fR" 20
+Use \fIname\fR as the title to be displayed in the window, and
+as the name of the interpreter for \fBsend\fR commands.
+.IP "\fB\-sync\fR" 20
+Execute all X server commands synchronously, so that errors
+are reported immediately. This will result in much slower
+execution, but it is useful for debugging.
+.VS 8.0 br
+.IP "\fB\-use\fR \fIid\fR" 20
+Specifies that the main window for the application is to be embedded in
+the window whose identifier is \fIid\fR, instead of being created as an
+independent toplevel window. \fIId\fR must be specified in the same
+way as the value for the \fB\-use\fR option for toplevel widgets (i.e.
+it has a form like that returned by the \fBwinfo id\fR command).
+.VE
+.IP "\fB\-visual \fIvisual\fR" 20
+Specifies the visual to use for the window.
+\fIVisual\fR may have any of the forms supported by the \fBTk_GetVisual\fR
+procedure.
+.IP "\fB\-\|\-\fR" 20
+Pass all remaining arguments through to the script's \fBargv\fR
+variable without interpreting them.
+This provides a mechanism for passing arguments such as \fB\-name\fR
+to a script instead of having \fBwish\fR interpret them.
+.BE
+
+.SH DESCRIPTION
+.PP
+\fBWish\fR is a simple program consisting of the Tcl command
+language, the Tk toolkit, and a main program that reads commands
+from standard input or from a file.
+It creates a main window and then processes Tcl commands.
+If \fBwish\fR is invoked with no arguments, or with a first argument
+that starts with ``\-'', then it reads Tcl commands interactively from
+standard input.
+It will continue processing commands until all windows have been
+deleted or until end-of-file is reached on standard input.
+If there exists a file \fB.wishrc\fR in the home directory of
+the user, \fBwish\fR evaluates the file as a Tcl script
+just before reading the first command from standard input.
+.PP
+If \fBwish\fR is invoked with an initial \fIfileName\fR argument, then
+\fIfileName\fR is treated as the name of a script file.
+\fBWish\fR will evaluate the script in \fIfileName\fR (which
+presumably creates a user interface), then it will respond to events
+until all windows have been deleted.
+Commands will not be read from standard input.
+There is no automatic evaluation of \fB.wishrc\fR in this
+case, but the script file can always \fBsource\fR it if desired.
+
+.SH "OPTIONS"
+.PP
+\fBWish\fR automatically processes all of the command-line options
+described in the \fBOPTIONS\fR summary above.
+Any other command-line arguments besides these are passed through
+to the application using the \fBargc\fR and \fBargv\fR variables
+described later.
+
+.SH "APPLICATION NAME AND CLASS"
+.PP
+The name of the application, which is used for purposes such as
+\fBsend\fR commands, is taken from the \fB\-name\fR option,
+if it is specified; otherwise it is taken from \fIfileName\fR,
+if it is specified, or from the command name by which
+\fBwish\fR was invoked. In the last two cases, if the name contains a ``/''
+character, then only the characters after the last slash are used
+as the application name.
+.PP
+The class of the application, which is used for purposes such as
+specifying options with a \fBRESOURCE_MANAGER\fR property or .Xdefaults
+file, is the same as its name except that the first letter is
+capitalized.
+
+.SH "VARIABLES"
+.PP
+\fBWish\fR sets the following Tcl variables:
+.TP 15
+\fBargc\fR
+Contains a count of the number of \fIarg\fR arguments (0 if none),
+not including the options described above.
+.TP 15
+\fBargv\fR
+Contains a Tcl list whose elements are the \fIarg\fR arguments
+that follow a \fB\-\|\-\fR option or don't match any of the
+options described in OPTIONS above, in order, or an empty string
+if there are no such arguments.
+.TP 15
+\fBargv0\fR
+Contains \fIfileName\fR if it was specified.
+Otherwise, contains the name by which \fBwish\fR was invoked.
+.TP 15
+\fBgeometry\fR
+If the \fB\-geometry\fR option is specified, \fBwish\fR copies its
+value into this variable. If the variable still exists after
+\fIfileName\fR has been evaluated, \fBwish\fR uses the value of
+the variable in a \fBwm geometry\fR command to set the main
+window's geometry.
+.TP 15
+\fBtcl_interactive\fR
+Contains 1 if \fBwish\fR is reading commands interactively (\fIfileName\fR
+was not specified and standard input is a terminal-like
+device), 0 otherwise.
+
+.SH "SCRIPT FILES"
+.PP
+If you create a Tcl script in a file whose first line is
+.CS
+\fB#!/usr/local/bin/wish\fR
+.CE
+then you can invoke the script file directly from your shell if
+you mark it as executable.
+This assumes that \fBwish\fR has been installed in the default
+location in /usr/local/bin; if it's installed somewhere else
+then you'll have to modify the above line to match.
+Many UNIX systems do not allow the \fB#!\fR line to exceed about
+30 characters in length, so be sure that the \fBwish\fR executable
+can be accessed with a short file name.
+.PP
+An even better approach is to start your script files with the
+following three lines:
+.CS
+\fB#!/bin/sh
+# the next line restarts using wish \e
+exec wish "$0" "$@"\fR
+.CE
+This approach has three advantages over the approach in the previous
+paragraph. First, the location of the \fBwish\fR binary doesn't have
+to be hard-wired into the script: it can be anywhere in your shell
+search path. Second, it gets around the 30-character file name limit
+in the previous approach.
+Third, this approach will work even if \fBwish\fR is
+itself a shell script (this is done on some systems in order to
+handle multiple architectures or operating systems: the \fBwish\fR
+script selects one of several binaries to run). The three lines
+cause both \fBsh\fR and \fBwish\fR to process the script, but the
+\fBexec\fR is only executed by \fBsh\fR.
+\fBsh\fR processes the script first; it treats the second
+line as a comment and executes the third line.
+The \fBexec\fR statement cause the shell to stop processing and
+instead to start up \fBwish\fR to reprocess the entire script.
+When \fBwish\fR starts up, it treats all three lines as comments,
+since the backslash at the end of the second line causes the third
+line to be treated as part of the comment on the second line.
+
+.SH PROMPTS
+.PP
+When \fBwish\fR is invoked interactively it normally prompts for each
+command with ``\fB% \fR''. You can change the prompt by setting the
+variables \fBtcl_prompt1\fR and \fBtcl_prompt2\fR. If variable
+\fBtcl_prompt1\fR exists then it must consist of a Tcl script
+to output a prompt; instead of outputting a prompt \fBwish\fR
+will evaluate the script in \fBtcl_prompt1\fR.
+The variable \fBtcl_prompt2\fR is used in a similar way when
+a newline is typed but the current command isn't yet complete;
+if \fBtcl_prompt2\fR isn't set then no prompt is output for
+incomplete commands.
+
+.SH KEYWORDS
+shell, toolkit
diff --git a/tk/doc/wm.n b/tk/doc/wm.n
new file mode 100644
index 00000000000..6fc6f7c16e1
--- /dev/null
+++ b/tk/doc/wm.n
@@ -0,0 +1,503 @@
+'\"
+'\" 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$
+'\"
+.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
+.SH SYNOPSIS
+\fBwm\fR \fIoption window \fR?\fIargs\fR?
+.BE
+
+.SH DESCRIPTION
+.PP
+The \fBwm\fR command is used to interact with window managers in
+order to control such things as the title for a window, its geometry,
+or the increments in terms of which it may be resized. The \fBwm\fR
+command can take any of a number of different forms, depending on
+the \fIoption\fR argument. All of the forms expect at least one
+additional argument, \fIwindow\fR, which must be the path name of a
+top-level window.
+.PP
+The legal forms for the \fBwm\fR command are:
+.TP
+\fBwm aspect \fIwindow\fR ?\fIminNumer minDenom maxNumer maxDenom\fR?
+If \fIminNumer\fR, \fIminDenom\fR, \fImaxNumer\fR, and \fImaxDenom\fR
+are all specified, then they will be passed to the window manager
+and the window manager should use them to enforce a range of
+acceptable aspect ratios for \fIwindow\fR. The aspect ratio of
+\fIwindow\fR (width/length) will be constrained to lie
+between \fIminNumer\fR/\fIminDenom\fR and \fImaxNumer\fR/\fImaxDenom\fR.
+If \fIminNumer\fR etc. are all specified as empty strings, then
+any existing aspect ratio restrictions are removed.
+If \fIminNumer\fR etc. are specified, then the command returns an
+empty string. Otherwise, it returns
+a Tcl list containing four elements, which are the current values
+of \fIminNumer\fR, \fIminDenom\fR, \fImaxNumer\fR, and \fImaxDenom\fR
+(if no aspect restrictions are in effect, then an empty string is
+returned).
+.TP
+\fBwm client \fIwindow\fR ?\fIname\fR?
+If \fIname\fR is specified, this command stores \fIname\fR (which
+should be the name of
+the host on which the application is executing) in \fIwindow\fR's
+\fBWM_CLIENT_MACHINE\fR property for use by the window manager or
+session manager.
+The command returns an empty string in this case.
+If \fIname\fR isn't specified, the command returns the last name
+set in a \fBwm client\fR command for \fIwindow\fR.
+If \fIname\fR is specified as an empty string, the command deletes the
+\fBWM_CLIENT_MACHINE\fR property from \fIwindow\fR.
+.TP
+\fBwm colormapwindows \fIwindow\fR ?\fIwindowList\fR?
+This command is used to manipulate the \fBWM_COLORMAP_WINDOWS\fR
+property, which provides information to the window managers about
+windows that have private colormaps.
+If \fIwindowList\fR isn't specified, the command returns a list
+whose elements are the names of the windows in the \fBWM_COLORMAP_WINDOWS\fR
+property.
+If \fIwindowList\fR is specified, it consists of a list of window
+path names; the command overwrites the \fBWM_COLORMAP_WINDOWS\fR
+property with the given windows and returns an empty string.
+The \fBWM_COLORMAP_WINDOWS\fR property should normally contain a
+list of the internal windows within \fIwindow\fR whose colormaps differ
+from their parents.
+The order of the windows in the property indicates a priority order:
+the window manager will attempt to install as many colormaps as possible
+from the head of this list when \fIwindow\fR gets the colormap focus.
+If \fIwindow\fR is not included among the windows in \fIwindowList\fR,
+Tk implicitly adds it at the end of the \fBWM_COLORMAP_WINDOWS\fR
+property, so that its colormap is lowest in priority.
+If \fBwm colormapwindows\fR is not invoked, Tk will automatically set
+the property for each top-level window to all the internal windows
+whose colormaps differ from their parents, followed by the top-level
+itself; the order of the internal windows is undefined.
+See the ICCCM documentation for more information on the
+\fBWM_COLORMAP_WINDOWS\fR property.
+.TP
+\fBwm command \fIwindow\fR ?\fIvalue\fR?
+If \fIvalue\fR is specified, this command stores \fIvalue\fR in \fIwindow\fR's
+\fBWM_COMMAND\fR property for use by the window manager or
+session manager and returns an empty string.
+\fIValue\fR must have proper list structure; the elements should
+contain the words of the command used to invoke the application.
+If \fIvalue\fR isn't specified then the command returns the last value
+set in a \fBwm command\fR command for \fIwindow\fR.
+If \fIvalue\fR is specified as an empty string, the command
+deletes the \fBWM_COMMAND\fR property from \fIwindow\fR.
+.TP
+\fBwm deiconify \fIwindow\fR
+Arrange for \fIwindow\fR to be displayed in normal (non-iconified) form.
+This is done by mapping the window. If the window has never been
+mapped then this command will not map the window, but it will ensure
+that when the window is first mapped it will be displayed
+in de-iconified form. Returns an empty string.
+.TP
+\fBwm focusmodel \fIwindow\fR ?\fBactive\fR|\fBpassive\fR?
+If \fBactive\fR or \fBpassive\fR is supplied as an optional argument
+to the command, then it specifies the focus model for \fIwindow\fR.
+In this case the command returns an empty string. If no additional
+argument is supplied, then the command returns the current focus
+model for \fIwindow\fR.
+An \fBactive\fR focus model means that \fIwindow\fR will claim the
+input focus for itself or its descendants, even at times when
+the focus is currently in some other application. \fBPassive\fR means that
+\fIwindow\fR will never claim the focus for itself: the window manager
+should give the focus to \fIwindow\fR at appropriate times. However,
+once the focus has been given to \fIwindow\fR or one of its descendants,
+the application may re-assign the focus among \fIwindow\fR's descendants.
+The focus model defaults to \fBpassive\fR, and Tk's \fBfocus\fR command
+assumes a passive model of focusing.
+.TP
+\fBwm frame \fIwindow\fR
+.VS
+If \fIwindow\fR has been reparented by the window manager into a
+decorative frame, the command returns the platform specific window
+identifier for the outermost frame that contains \fIwindow\fR (the
+window whose parent is the root or virtual root). If \fIwindow\fR
+hasn't been reparented by the window manager then the command returns
+the platform specific window identifier for \fIwindow\fR.
+.VE
+.TP
+\fBwm geometry \fIwindow\fR ?\fInewGeometry\fR?
+If \fInewGeometry\fR is specified, then the geometry of \fIwindow\fR
+is changed and an empty string is returned. Otherwise the current
+geometry for \fIwindow\fR is returned (this is the most recent
+geometry specified either by manual resizing or
+in a \fBwm geometry\fR command). \fINewGeometry\fR has
+the form \fB=\fIwidth\fBx\fIheight\fB\(+-\fIx\fB\(+-\fIy\fR, where
+any of \fB=\fR, \fIwidth\fBx\fIheight\fR, or \fB\(+-\fIx\fB\(+-\fIy\fR
+may be omitted. \fIWidth\fR and \fIheight\fR are positive integers
+specifying the desired dimensions of \fIwindow\fR. If \fIwindow\fR
+is gridded (see GRIDDED GEOMETRY MANAGEMENT below) then the dimensions
+are specified in grid units; otherwise they are specified in pixel
+units. \fIX\fR and \fIy\fR specify the desired location of
+\fIwindow\fR on the screen, in pixels.
+If \fIx\fR is preceded by \fB+\fR, it specifies
+the number of pixels between the left edge of the screen and the left
+edge of \fIwindow\fR's border; if preceded by \fB\-\fR then
+\fIx\fR specifies the number of pixels
+between the right edge of the screen and the right edge of \fIwindow\fR's
+border. If \fIy\fR is preceded by \fB+\fR then it specifies the
+number of pixels between the top of the screen and the top
+of \fIwindow\fR's border; if \fIy\fR is preceded by \fB\-\fR then
+it specifies the number of pixels between the bottom of \fIwindow\fR's
+border and the bottom of the screen.
+If \fInewGeometry\fR is specified as an empty string then any
+existing user-specified geometry for \fIwindow\fR is cancelled, and
+the window will revert to the size requested internally by its
+widgets.
+.TP
+\fBwm grid \fIwindow\fR ?\fIbaseWidth baseHeight widthInc heightInc\fR?
+This command indicates that \fIwindow\fR is to be managed as a
+gridded window.
+It also specifies the relationship between grid units and pixel units.
+\fIBaseWidth\fR and \fIbaseHeight\fR specify the number of grid
+units corresponding to the pixel dimensions requested internally
+by \fIwindow\fR using \fBTk_GeometryRequest\fR. \fIWidthInc\fR
+and \fIheightInc\fR specify the number of pixels in each horizontal
+and vertical grid unit.
+These four values determine a range of acceptable sizes for
+\fIwindow\fR, corresponding to grid-based widths and heights
+that are non-negative integers.
+Tk will pass this information to the window manager; during
+manual resizing, the window manager will restrict the window's size
+to one of these acceptable sizes.
+Furthermore, during manual resizing the window manager will display
+the window's current size in terms of grid units rather than pixels.
+If \fIbaseWidth\fR etc. are all specified as empty strings, then
+\fIwindow\fR will no longer be managed as a gridded window. If
+\fIbaseWidth\fR etc. are specified then the return value is an
+empty string.
+Otherwise the return value is a Tcl list containing
+four elements corresponding to the current \fIbaseWidth\fR,
+\fIbaseHeight\fR, \fIwidthInc\fR, and \fIheightInc\fR; if
+\fIwindow\fR is not currently gridded, then an empty string
+is returned.
+Note: this command should not be needed very often, since the
+\fBTk_SetGrid\fR library procedure and the \fBsetGrid\fR option
+provide easier access to the same functionality.
+.TP
+\fBwm group \fIwindow\fR ?\fIpathName\fR?
+If \fIpathName\fR is specified, it gives the path name for the leader of
+a group of related windows. The window manager may use this information,
+for example, to unmap all of the windows in a group when the group's
+leader is iconified. \fIPathName\fR may be specified as an empty string to
+remove \fIwindow\fR from any group association. If \fIpathName\fR is
+specified then the command returns an empty string; otherwise it
+returns the path name of \fIwindow\fR's current group leader, or an empty
+string if \fIwindow\fR isn't part of any group.
+.TP
+\fBwm iconbitmap \fIwindow\fR ?\fIbitmap\fR?
+If \fIbitmap\fR is specified, then it names a bitmap in the standard
+forms accepted by Tk (see the \fBTk_GetBitmap\fR manual entry for details).
+This bitmap is passed to the window manager to be displayed in
+\fIwindow\fR's icon, and the command returns an empty string. If
+an empty string is specified for \fIbitmap\fR, then any current icon
+bitmap is cancelled for \fIwindow\fR.
+If \fIbitmap\fR is specified then the command returns an empty string.
+Otherwise it returns the name of
+the current icon bitmap associated with \fIwindow\fR, or an empty
+string if \fIwindow\fR has no icon bitmap.
+.TP
+\fBwm iconify \fIwindow\fR
+Arrange for \fIwindow\fR to be iconified. It \fIwindow\fR hasn't
+yet been mapped for the first time, this command will arrange for
+it to appear in the iconified state when it is eventually mapped.
+.TP
+\fBwm iconmask \fIwindow\fR ?\fIbitmap\fR?
+If \fIbitmap\fR is specified, then it names a bitmap in the standard
+forms accepted by Tk (see the \fBTk_GetBitmap\fR manual entry for details).
+This bitmap is passed to the window manager to be used as a mask
+in conjunction with the \fBiconbitmap\fR option: where the mask
+has zeroes no icon will be displayed; where it has ones, the bits
+from the icon bitmap will be displayed. If
+an empty string is specified for \fIbitmap\fR then any current icon
+mask is cancelled for \fIwindow\fR (this is equivalent to specifying
+a bitmap of all ones). If \fIbitmap\fR is specified
+then the command returns an empty string. Otherwise it
+returns the name of the current icon mask associated with
+\fIwindow\fR, or an empty string if no mask is in effect.
+.TP
+\fBwm iconname \fIwindow\fR ?\fInewName\fR?
+If \fInewName\fR is specified, then it is passed to the window
+manager; the window manager should display \fInewName\fR inside
+the icon associated with \fIwindow\fR. In this case an empty
+string is returned as result. If \fInewName\fR isn't specified
+then the command returns the current icon name for \fIwindow\fR,
+or an empty string if no icon name has been specified (in this
+case the window manager will normally display the window's title,
+as specified with the \fBwm title\fR command).
+.TP
+\fBwm iconposition \fIwindow\fR ?\fIx y\fR?
+If \fIx\fR and \fIy\fR are specified, they are passed to the window
+manager as a hint about where to position the icon for \fIwindow\fR.
+In this case an empty string is returned. If \fIx\fR and \fIy\fR are
+specified as empty strings then any existing icon position hint is cancelled.
+If neither \fIx\fR nor \fIy\fR is specified, then the command returns
+a Tcl list containing two values, which are the current icon position
+hints (if no hints are in effect then an empty string is returned).
+.TP
+\fBwm iconwindow \fIwindow\fR ?\fIpathName\fR?
+If \fIpathName\fR is specified, it is the path name for a window to
+use as icon for \fIwindow\fR: when \fIwindow\fR is iconified then
+\fIpathName\fR will be mapped to serve as icon, and when \fIwindow\fR
+is de-iconified then \fIpathName\fR will be unmapped again. If
+\fIpathName\fR is specified as an empty string then any existing
+icon window association for \fIwindow\fR will be cancelled. If
+the \fIpathName\fR argument is specified then an empty string is
+returned. Otherwise the command returns the path name of the
+current icon window for \fIwindow\fR, or an empty string if there
+is no icon window currently specified for \fIwindow\fR.
+Button press events are disabled for \fIwindow\fR as long as it is
+an icon window; this is needed in order to allow window managers
+to ``own'' those events.
+Note: not all window managers support the notion of an icon window.
+.TP
+\fBwm maxsize \fIwindow\fR ?\fIwidth height\fR?
+If \fIwidth\fR and \fIheight\fR are specified, they give
+the maximum permissible dimensions for \fIwindow\fR.
+For gridded windows the dimensions are specified in
+grid units; otherwise they are specified in pixel units.
+The window manager will restrict the window's dimensions to be
+less than or equal to \fIwidth\fR and \fIheight\fR.
+If \fIwidth\fR and \fIheight\fR are
+specified, then the command returns an empty string. Otherwise
+it returns a Tcl list with two elements, which are the
+maximum width and height currently in effect.
+The maximum size defaults to the size of the screen.
+If resizing has been disabled with the \fBwm resizable\fR command,
+then this command has no effect.
+See the sections on geometry management below for more information.
+.TP
+\fBwm minsize \fIwindow\fR ?\fIwidth height\fR?
+If \fIwidth\fR and \fIheight\fR are specified, they give the
+minimum permissible dimensions for \fIwindow\fR.
+For gridded windows the dimensions are specified in
+grid units; otherwise they are specified in pixel units.
+The window manager will restrict the window's dimensions to be
+greater than or equal to \fIwidth\fR and \fIheight\fR.
+If \fIwidth\fR and \fIheight\fR are
+specified, then the command returns an empty string. Otherwise
+it returns a Tcl list with two elements, which are the
+minimum width and height currently in effect.
+The minimum size defaults to one pixel in each dimension.
+If resizing has been disabled with the \fBwm resizable\fR command,
+then this command has no effect.
+See the sections on geometry management below for more information.
+.TP
+\fBwm overrideredirect \fIwindow\fR ?\fIboolean\fR?
+If \fIboolean\fR is specified, it must have a proper boolean form and
+the override-redirect flag for \fIwindow\fR is set to that value.
+If \fIboolean\fR is not specified then \fB1\fR or \fB0\fR is
+returned to indicate whether or not the override-redirect flag
+is currently set for \fIwindow\fR.
+Setting the override-redirect flag for a window causes
+it to be ignored by the window manager; among other things, this means
+that the window will not be reparented from the root window into a
+decorative frame and the user will not be able to manipulate the
+window using the normal window manager mechanisms.
+.TP
+\fBwm positionfrom \fIwindow\fR ?\fIwho\fR?
+If \fIwho\fR is specified, it must be either \fBprogram\fR or
+\fBuser\fR, or an abbreviation of one of these two. It indicates
+whether \fIwindow\fR's current position was requested by the
+program or by the user. Many window managers ignore program-requested
+initial positions and ask the user to manually position the window; if
+\fBuser\fR is specified then the window manager should position the
+window at the given place without asking the user for assistance.
+If \fIwho\fR is specified as an empty string, then the current position
+source is cancelled.
+If \fIwho\fR is specified, then the command returns an empty string.
+Otherwise it returns \fBuser\fR or \fBwindow\fR to indicate the
+source of the window's current position, or an empty string if
+no source has been specified yet. Most window managers interpret
+``no source'' as equivalent to \fBprogram\fR.
+Tk will automatically set the position source to \fBuser\fR
+when a \fBwm geometry\fR command is invoked, unless the source has
+been set explicitly to \fBprogram\fR.
+.TP
+\fBwm protocol \fIwindow\fR ?\fIname\fR? ?\fIcommand\fR?
+This command is used to manage window manager protocols such as
+\fBWM_DELETE_WINDOW\fR.
+\fIName\fR is the name of an atom corresponding to a window manager
+protocol, such as \fBWM_DELETE_WINDOW\fR or \fBWM_SAVE_YOURSELF\fR
+or \fBWM_TAKE_FOCUS\fR.
+If both \fIname\fR and \fIcommand\fR are specified, then \fIcommand\fR
+is associated with the protocol specified by \fIname\fR.
+\fIName\fR will be added to \fIwindow\fR's \fBWM_PROTOCOLS\fR
+property to tell the window manager that the application has a
+protocol handler for \fIname\fR, and \fIcommand\fR will
+be invoked in the future whenever the window manager sends a
+message to the client for that protocol.
+In this case the command returns an empty string.
+If \fIname\fR is specified but \fIcommand\fR isn't, then the current
+command for \fIname\fR is returned, or an empty string if there
+is no handler defined for \fIname\fR.
+If \fIcommand\fR is specified as an empty string then the current
+handler for \fIname\fR is deleted and it is removed from the
+\fBWM_PROTOCOLS\fR property on \fIwindow\fR; an empty string is
+returned.
+Lastly, if neither \fIname\fR nor \fIcommand\fR is specified, the
+command returns a list of all the protocols for which handlers
+are currently defined for \fIwindow\fR.
+.RS
+.PP
+Tk always defines a protocol handler for \fBWM_DELETE_WINDOW\fR, even if
+you haven't asked for one with \fBwm protocol\fR.
+If a \fBWM_DELETE_WINDOW\fR message arrives when you haven't defined
+a handler, then Tk handles the message by destroying the window for
+which it was received.
+.RE
+.TP
+\fBwm resizable \fIwindow\fR ?\fIwidth height\fR?
+This command controls whether or not the user may interactively
+resize a top-level window. If \fIwidth\fR and \fIheight\fR are
+specified, they are boolean values that determine whether the
+width and height of \fIwindow\fR may be modified by the user.
+In this case the command returns an empty string.
+If \fIwidth\fR and \fIheight\fR are omitted then the command
+returns a list with two 0/1 elements that indicate whether the
+width and height of \fIwindow\fR are currently resizable.
+By default, windows are resizable in both dimensions.
+If resizing is disabled, then the window's size will be the size
+from the most recent interactive resize or \fBwm geometry\fR
+command. If there has been no such operation then
+the window's natural size will be used.
+.TP
+\fBwm sizefrom \fIwindow\fR ?\fIwho\fR?
+If \fIwho\fR is specified, it must be either \fBprogram\fR or
+\fBuser\fR, or an abbreviation of one of these two. It indicates
+whether \fIwindow\fR's current size was requested by the
+program or by the user. Some window managers ignore program-requested
+sizes and ask the user to manually size the window; if
+\fBuser\fR is specified then the window manager should give the
+window its specified size without asking the user for assistance.
+If \fIwho\fR is specified as an empty string, then the current size
+source is cancelled.
+If \fIwho\fR is specified, then the command returns an empty string.
+Otherwise it returns \fBuser\fR or \fBwindow\fR to indicate the
+source of the window's current size, or an empty string if
+no source has been specified yet. Most window managers interpret
+``no source'' as equivalent to \fBprogram\fR.
+.TP
+\fBwm state \fIwindow\fR
+Returns the current state of \fIwindow\fR: either \fBnormal\fR,
+\fBiconic\fR, \fBwithdrawn\fR, or \fBicon\fR. The difference
+between \fBiconic\fR and \fBicon\fR is that \fBiconic\fR refers
+to a window that has been iconified (e.g., with the \fBwm iconify\fR
+command) while \fBicon\fR refers to a window whose only purpose is
+to serve as the icon for some other window (via the \fBwm iconwindow\fR
+command).
+.TP
+\fBwm title \fIwindow\fR ?\fIstring\fR?
+If \fIstring\fR is specified, then it will be passed to the window
+manager for use as the title for \fIwindow\fR (the window manager
+should display this string in \fIwindow\fR's title bar). In this
+case the command returns an empty string. If \fIstring\fR isn't
+specified then the command returns the current title for the
+\fIwindow\fR. The title for a window defaults to its name.
+.TP
+\fBwm transient \fIwindow\fR ?\fImaster\fR?
+If \fImaster\fR is specified, then the window manager is informed
+that \fIwindow\fR is a transient window (e.g. pull-down menu) working
+on behalf of \fImaster\fR (where \fImaster\fR is the
+path name for a top-level window). Some window managers will use
+this information to manage \fIwindow\fR specially. If \fImaster\fR
+is specified as an empty string then \fIwindow\fR is marked as not
+being a transient window any more. If \fImaster\fR is specified,
+then the command returns an empty string. Otherwise the command
+returns the path name of \fIwindow\fR's current master, or an
+empty string if \fIwindow\fR isn't currently a transient window.
+.TP
+\fBwm withdraw \fIwindow\fR
+Arranges for \fIwindow\fR to be withdrawn from the screen. This
+causes the window to be unmapped and forgotten about by the window
+manager. If the window
+has never been mapped, then this command
+causes the window to be mapped in the withdrawn state. Not all
+window managers appear to know how to handle windows that are
+mapped in the withdrawn state.
+Note: it sometimes seems to be necessary to withdraw a
+window and then re-map it (e.g. with \fBwm deiconify\fR) to get some
+window managers to pay attention to changes in window attributes
+such as group.
+
+.SH "GEOMETRY MANAGEMENT"
+.PP
+By default a top-level window appears on the screen in its
+\fInatural size\fR, which is the one determined internally by its
+widgets and geometry managers.
+If the natural size of a top-level window changes, then the window's size
+changes to match.
+A top-level window can be given a size other than its natural size in two ways.
+First, the user can resize the window manually using the facilities
+of the window manager, such as resize handles.
+Second, the application can request a particular size for a
+top-level window using the \fBwm geometry\fR command.
+These two cases are handled identically by Tk; in either case,
+the requested size overrides the natural size.
+You can return the window to its natural by invoking \fBwm geometry\fR
+with an empty \fIgeometry\fR string.
+.PP
+Normally a top-level window can have any size from one pixel in each
+dimension up to the size of its screen.
+However, you can use the \fBwm minsize\fR and \fBwm maxsize\fR commands
+to limit the range of allowable sizes.
+The range set by \fBwm minsize\fR and \fBwm maxsize\fR applies to
+all forms of resizing, including the window's natural size as
+well as manual resizes and the \fBwm geometry\fR command.
+You can also use the command \fBwm resizable\fR to completely
+disable interactive resizing in one or both dimensions.
+
+.SH "GRIDDED GEOMETRY MANAGEMENT"
+.PP
+Gridded geometry management occurs when one of the widgets of an
+application supports a range of useful sizes.
+This occurs, for example, in a text editor where the scrollbars,
+menus, and other adornments are fixed in size but the edit widget
+can support any number of lines of text or characters per line.
+In this case, it is usually desirable to let the user specify the
+number of lines or characters-per-line, either with the
+\fBwm geometry\fR command or by interactively resizing the window.
+In the case of text, and in other interesting cases also, only
+discrete sizes of the window make sense, such as integral numbers
+of lines and characters-per-line; arbitrary pixel sizes are not useful.
+.PP
+Gridded geometry management provides support for this kind of
+application.
+Tk (and the window manager) assume that there is a grid of some
+sort within the application and that the application should be
+resized in terms of \fIgrid units\fR rather than pixels.
+Gridded geometry management is typically invoked by turning on
+the \fBsetGrid\fR option for a widget; it can also be invoked
+with the \fBwm grid\fR command or by calling \fBTk_SetGrid\fR.
+In each of these approaches the particular widget (or sometimes
+code in the application as a whole) specifies the relationship between
+integral grid sizes for the window and pixel sizes.
+To return to non-gridded geometry management, invoke
+\fBwm grid\fR with empty argument strings.
+.PP
+When gridded geometry management is enabled then all the dimensions specified
+in \fBwm minsize\fR, \fBwm maxsize\fR, and \fBwm geometry\fR commands
+are treated as grid units rather than pixel units.
+Interactive resizing is also carried out in even numbers of grid units
+rather than pixels.
+
+.SH BUGS
+.PP
+Most existing window managers appear to have bugs that affect the
+operation of the \fBwm\fR command. For example, some changes won't
+take effect if the window is already active: the window will have
+to be withdrawn and de-iconified in order to make the change happen.
+
+.SH KEYWORDS
+aspect ratio, deiconify, focus model, geometry, grid, group, icon, iconify, increments, position, size, title, top-level window, units, window manager
diff --git a/tk/generic/README b/tk/generic/README
new file mode 100644
index 00000000000..1a77e83f9f3
--- /dev/null
+++ b/tk/generic/README
@@ -0,0 +1,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$
diff --git a/tk/generic/default.h b/tk/generic/default.h
new file mode 100644
index 00000000000..1315608f33a
--- /dev/null
+++ b/tk/generic/default.h
@@ -0,0 +1,29 @@
+/*
+ * 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$
+ */
+
+#ifndef _DEFAULT
+#define _DEFAULT
+
+#if defined(__WIN32__) || defined(_WIN32)
+# include "tkWinDefault.h"
+#else
+# if defined(MAC_TCL)
+# include "tkMacDefault.h"
+# else
+# include "tkUnixDefault.h"
+# endif
+#endif
+
+#endif /* _DEFAULT */
diff --git a/tk/generic/ks_names.h b/tk/generic/ks_names.h
new file mode 100644
index 00000000000..759becc7b06
--- /dev/null
+++ b/tk/generic/ks_names.h
@@ -0,0 +1,921 @@
+/*
+ * This file is generated from $(INCLUDESRC)/keysymdef.h. Do not edit.
+ * RCS: $Id$
+ */
+{ "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 },
+{ "Find", 0xFF68 },
+{ "Cancel", 0xFF69 },
+{ "Help", 0xFF6A },
+{ "Break", 0xFF6B },
+{ "Mode_switch", 0xFF7E },
+{ "script_switch", 0xFF7E },
+{ "Num_Lock", 0xFF7F },
+{ "KP_Space", 0xFF80 },
+{ "KP_Tab", 0xFF89 },
+{ "KP_Enter", 0xFF8D },
+{ "KP_F1", 0xFF91 },
+{ "KP_F2", 0xFF92 },
+{ "KP_F3", 0xFF93 },
+{ "KP_F4", 0xFF94 },
+{ "KP_Equal", 0xFFBD },
+{ "KP_Multiply", 0xFFAA },
+{ "KP_Add", 0xFFAB },
+{ "KP_Separator", 0xFFAC },
+{ "KP_Subtract", 0xFFAD },
+{ "KP_Decimal", 0xFFAE },
+{ "KP_Divide", 0xFFAF },
+{ "KP_0", 0xFFB0 },
+{ "KP_1", 0xFFB1 },
+{ "KP_2", 0xFFB2 },
+{ "KP_3", 0xFFB3 },
+{ "KP_4", 0xFFB4 },
+{ "KP_5", 0xFFB5 },
+{ "KP_6", 0xFFB6 },
+{ "KP_7", 0xFFB7 },
+{ "KP_8", 0xFFB8 },
+{ "KP_9", 0xFFB9 },
+{ "F1", 0xFFBE },
+{ "F2", 0xFFBF },
+{ "F3", 0xFFC0 },
+{ "F4", 0xFFC1 },
+{ "F5", 0xFFC2 },
+{ "F6", 0xFFC3 },
+{ "F7", 0xFFC4 },
+{ "F8", 0xFFC5 },
+{ "F9", 0xFFC6 },
+{ "F10", 0xFFC7 },
+{ "F11", 0xFFC8 },
+{ "L1", 0xFFC8 },
+{ "F12", 0xFFC9 },
+{ "L2", 0xFFC9 },
+{ "F13", 0xFFCA },
+{ "L3", 0xFFCA },
+{ "F14", 0xFFCB },
+{ "L4", 0xFFCB },
+{ "F15", 0xFFCC },
+{ "L5", 0xFFCC },
+{ "F16", 0xFFCD },
+{ "L6", 0xFFCD },
+{ "F17", 0xFFCE },
+{ "L7", 0xFFCE },
+{ "F18", 0xFFCF },
+{ "L8", 0xFFCF },
+{ "F19", 0xFFD0 },
+{ "L9", 0xFFD0 },
+{ "F20", 0xFFD1 },
+{ "L10", 0xFFD1 },
+{ "F21", 0xFFD2 },
+{ "R1", 0xFFD2 },
+{ "F22", 0xFFD3 },
+{ "R2", 0xFFD3 },
+{ "F23", 0xFFD4 },
+{ "R3", 0xFFD4 },
+{ "F24", 0xFFD5 },
+{ "R4", 0xFFD5 },
+{ "F25", 0xFFD6 },
+{ "R5", 0xFFD6 },
+{ "F26", 0xFFD7 },
+{ "R6", 0xFFD7 },
+{ "F27", 0xFFD8 },
+{ "R7", 0xFFD8 },
+{ "F28", 0xFFD9 },
+{ "R8", 0xFFD9 },
+{ "F29", 0xFFDA },
+{ "R9", 0xFFDA },
+{ "F30", 0xFFDB },
+{ "R10", 0xFFDB },
+{ "F31", 0xFFDC },
+{ "R11", 0xFFDC },
+{ "F32", 0xFFDD },
+{ "R12", 0xFFDD },
+{ "R13", 0xFFDE },
+{ "F33", 0xFFDE },
+{ "F34", 0xFFDF },
+{ "R14", 0xFFDF },
+{ "F35", 0xFFE0 },
+{ "R15", 0xFFE0 },
+{ "Shift_L", 0xFFE1 },
+{ "Shift_R", 0xFFE2 },
+{ "Control_L", 0xFFE3 },
+{ "Control_R", 0xFFE4 },
+{ "Caps_Lock", 0xFFE5 },
+{ "Shift_Lock", 0xFFE6 },
+{ "Meta_L", 0xFFE7 },
+{ "Meta_R", 0xFFE8 },
+{ "Alt_L", 0xFFE9 },
+{ "Alt_R", 0xFFEA },
+{ "Super_L", 0xFFEB },
+{ "Super_R", 0xFFEC },
+{ "Hyper_L", 0xFFED },
+{ "Hyper_R", 0xFFEE },
+{ "space", 0x020 },
+{ "exclam", 0x021 },
+{ "quotedbl", 0x022 },
+{ "numbersign", 0x023 },
+{ "dollar", 0x024 },
+{ "percent", 0x025 },
+{ "ampersand", 0x026 },
+{ "quoteright", 0x027 },
+{ "parenleft", 0x028 },
+{ "parenright", 0x029 },
+{ "asterisk", 0x02a },
+{ "plus", 0x02b },
+{ "comma", 0x02c },
+{ "minus", 0x02d },
+{ "period", 0x02e },
+{ "slash", 0x02f },
+{ "0", 0x030 },
+{ "1", 0x031 },
+{ "2", 0x032 },
+{ "3", 0x033 },
+{ "4", 0x034 },
+{ "5", 0x035 },
+{ "6", 0x036 },
+{ "7", 0x037 },
+{ "8", 0x038 },
+{ "9", 0x039 },
+{ "colon", 0x03a },
+{ "semicolon", 0x03b },
+{ "less", 0x03c },
+{ "equal", 0x03d },
+{ "greater", 0x03e },
+{ "question", 0x03f },
+{ "at", 0x040 },
+{ "A", 0x041 },
+{ "B", 0x042 },
+{ "C", 0x043 },
+{ "D", 0x044 },
+{ "E", 0x045 },
+{ "F", 0x046 },
+{ "G", 0x047 },
+{ "H", 0x048 },
+{ "I", 0x049 },
+{ "J", 0x04a },
+{ "K", 0x04b },
+{ "L", 0x04c },
+{ "M", 0x04d },
+{ "N", 0x04e },
+{ "O", 0x04f },
+{ "P", 0x050 },
+{ "Q", 0x051 },
+{ "R", 0x052 },
+{ "S", 0x053 },
+{ "T", 0x054 },
+{ "U", 0x055 },
+{ "V", 0x056 },
+{ "W", 0x057 },
+{ "X", 0x058 },
+{ "Y", 0x059 },
+{ "Z", 0x05a },
+{ "bracketleft", 0x05b },
+{ "backslash", 0x05c },
+{ "bracketright", 0x05d },
+{ "asciicircum", 0x05e },
+{ "underscore", 0x05f },
+{ "quoteleft", 0x060 },
+{ "a", 0x061 },
+{ "b", 0x062 },
+{ "c", 0x063 },
+{ "d", 0x064 },
+{ "e", 0x065 },
+{ "f", 0x066 },
+{ "g", 0x067 },
+{ "h", 0x068 },
+{ "i", 0x069 },
+{ "j", 0x06a },
+{ "k", 0x06b },
+{ "l", 0x06c },
+{ "m", 0x06d },
+{ "n", 0x06e },
+{ "o", 0x06f },
+{ "p", 0x070 },
+{ "q", 0x071 },
+{ "r", 0x072 },
+{ "s", 0x073 },
+{ "t", 0x074 },
+{ "u", 0x075 },
+{ "v", 0x076 },
+{ "w", 0x077 },
+{ "x", 0x078 },
+{ "y", 0x079 },
+{ "z", 0x07a },
+{ "braceleft", 0x07b },
+{ "bar", 0x07c },
+{ "braceright", 0x07d },
+{ "asciitilde", 0x07e },
+{ "nobreakspace", 0x0a0 },
+{ "exclamdown", 0x0a1 },
+{ "cent", 0x0a2 },
+{ "sterling", 0x0a3 },
+{ "currency", 0x0a4 },
+{ "yen", 0x0a5 },
+{ "brokenbar", 0x0a6 },
+{ "section", 0x0a7 },
+{ "diaeresis", 0x0a8 },
+{ "copyright", 0x0a9 },
+{ "ordfeminine", 0x0aa },
+{ "guillemotleft", 0x0ab },
+{ "notsign", 0x0ac },
+{ "hyphen", 0x0ad },
+{ "registered", 0x0ae },
+{ "macron", 0x0af },
+{ "degree", 0x0b0 },
+{ "plusminus", 0x0b1 },
+{ "twosuperior", 0x0b2 },
+{ "threesuperior", 0x0b3 },
+{ "acute", 0x0b4 },
+{ "mu", 0x0b5 },
+{ "paragraph", 0x0b6 },
+{ "periodcentered", 0x0b7 },
+{ "cedilla", 0x0b8 },
+{ "onesuperior", 0x0b9 },
+{ "masculine", 0x0ba },
+{ "guillemotright", 0x0bb },
+{ "onequarter", 0x0bc },
+{ "onehalf", 0x0bd },
+{ "threequarters", 0x0be },
+{ "questiondown", 0x0bf },
+{ "Agrave", 0x0c0 },
+{ "Aacute", 0x0c1 },
+{ "Acircumflex", 0x0c2 },
+{ "Atilde", 0x0c3 },
+{ "Adiaeresis", 0x0c4 },
+{ "Aring", 0x0c5 },
+{ "AE", 0x0c6 },
+{ "Ccedilla", 0x0c7 },
+{ "Egrave", 0x0c8 },
+{ "Eacute", 0x0c9 },
+{ "Ecircumflex", 0x0ca },
+{ "Ediaeresis", 0x0cb },
+{ "Igrave", 0x0cc },
+{ "Iacute", 0x0cd },
+{ "Icircumflex", 0x0ce },
+{ "Idiaeresis", 0x0cf },
+{ "Eth", 0x0d0 },
+{ "Ntilde", 0x0d1 },
+{ "Ograve", 0x0d2 },
+{ "Oacute", 0x0d3 },
+{ "Ocircumflex", 0x0d4 },
+{ "Otilde", 0x0d5 },
+{ "Odiaeresis", 0x0d6 },
+{ "multiply", 0x0d7 },
+{ "Ooblique", 0x0d8 },
+{ "Ugrave", 0x0d9 },
+{ "Uacute", 0x0da },
+{ "Ucircumflex", 0x0db },
+{ "Udiaeresis", 0x0dc },
+{ "Yacute", 0x0dd },
+{ "Thorn", 0x0de },
+{ "ssharp", 0x0df },
+{ "agrave", 0x0e0 },
+{ "aacute", 0x0e1 },
+{ "acircumflex", 0x0e2 },
+{ "atilde", 0x0e3 },
+{ "adiaeresis", 0x0e4 },
+{ "aring", 0x0e5 },
+{ "ae", 0x0e6 },
+{ "ccedilla", 0x0e7 },
+{ "egrave", 0x0e8 },
+{ "eacute", 0x0e9 },
+{ "ecircumflex", 0x0ea },
+{ "ediaeresis", 0x0eb },
+{ "igrave", 0x0ec },
+{ "iacute", 0x0ed },
+{ "icircumflex", 0x0ee },
+{ "idiaeresis", 0x0ef },
+{ "eth", 0x0f0 },
+{ "ntilde", 0x0f1 },
+{ "ograve", 0x0f2 },
+{ "oacute", 0x0f3 },
+{ "ocircumflex", 0x0f4 },
+{ "otilde", 0x0f5 },
+{ "odiaeresis", 0x0f6 },
+{ "division", 0x0f7 },
+{ "oslash", 0x0f8 },
+{ "ugrave", 0x0f9 },
+{ "uacute", 0x0fa },
+{ "ucircumflex", 0x0fb },
+{ "udiaeresis", 0x0fc },
+{ "yacute", 0x0fd },
+{ "thorn", 0x0fe },
+{ "ydiaeresis", 0x0ff },
+{ "Aogonek", 0x1a1 },
+{ "breve", 0x1a2 },
+{ "Lstroke", 0x1a3 },
+{ "Lcaron", 0x1a5 },
+{ "Sacute", 0x1a6 },
+{ "Scaron", 0x1a9 },
+{ "Scedilla", 0x1aa },
+{ "Tcaron", 0x1ab },
+{ "Zacute", 0x1ac },
+{ "Zcaron", 0x1ae },
+{ "Zabovedot", 0x1af },
+{ "aogonek", 0x1b1 },
+{ "ogonek", 0x1b2 },
+{ "lstroke", 0x1b3 },
+{ "lcaron", 0x1b5 },
+{ "sacute", 0x1b6 },
+{ "caron", 0x1b7 },
+{ "scaron", 0x1b9 },
+{ "scedilla", 0x1ba },
+{ "tcaron", 0x1bb },
+{ "zacute", 0x1bc },
+{ "doubleacute", 0x1bd },
+{ "zcaron", 0x1be },
+{ "zabovedot", 0x1bf },
+{ "Racute", 0x1c0 },
+{ "Abreve", 0x1c3 },
+{ "Cacute", 0x1c6 },
+{ "Ccaron", 0x1c8 },
+{ "Eogonek", 0x1ca },
+{ "Ecaron", 0x1cc },
+{ "Dcaron", 0x1cf },
+{ "Nacute", 0x1d1 },
+{ "Ncaron", 0x1d2 },
+{ "Odoubleacute", 0x1d5 },
+{ "Rcaron", 0x1d8 },
+{ "Uring", 0x1d9 },
+{ "Udoubleacute", 0x1db },
+{ "Tcedilla", 0x1de },
+{ "racute", 0x1e0 },
+{ "abreve", 0x1e3 },
+{ "cacute", 0x1e6 },
+{ "ccaron", 0x1e8 },
+{ "eogonek", 0x1ea },
+{ "ecaron", 0x1ec },
+{ "dcaron", 0x1ef },
+{ "nacute", 0x1f1 },
+{ "ncaron", 0x1f2 },
+{ "odoubleacute", 0x1f5 },
+{ "udoubleacute", 0x1fb },
+{ "rcaron", 0x1f8 },
+{ "uring", 0x1f9 },
+{ "tcedilla", 0x1fe },
+{ "abovedot", 0x1ff },
+{ "Hstroke", 0x2a1 },
+{ "Hcircumflex", 0x2a6 },
+{ "Iabovedot", 0x2a9 },
+{ "Gbreve", 0x2ab },
+{ "Jcircumflex", 0x2ac },
+{ "hstroke", 0x2b1 },
+{ "hcircumflex", 0x2b6 },
+{ "idotless", 0x2b9 },
+{ "gbreve", 0x2bb },
+{ "jcircumflex", 0x2bc },
+{ "Cabovedot", 0x2c5 },
+{ "Ccircumflex", 0x2c6 },
+{ "Gabovedot", 0x2d5 },
+{ "Gcircumflex", 0x2d8 },
+{ "Ubreve", 0x2dd },
+{ "Scircumflex", 0x2de },
+{ "cabovedot", 0x2e5 },
+{ "ccircumflex", 0x2e6 },
+{ "gabovedot", 0x2f5 },
+{ "gcircumflex", 0x2f8 },
+{ "ubreve", 0x2fd },
+{ "scircumflex", 0x2fe },
+{ "kappa", 0x3a2 },
+{ "Rcedilla", 0x3a3 },
+{ "Itilde", 0x3a5 },
+{ "Lcedilla", 0x3a6 },
+{ "Emacron", 0x3aa },
+{ "Gcedilla", 0x3ab },
+{ "Tslash", 0x3ac },
+{ "rcedilla", 0x3b3 },
+{ "itilde", 0x3b5 },
+{ "lcedilla", 0x3b6 },
+{ "emacron", 0x3ba },
+{ "gacute", 0x3bb },
+{ "tslash", 0x3bc },
+{ "ENG", 0x3bd },
+{ "eng", 0x3bf },
+{ "Amacron", 0x3c0 },
+{ "Iogonek", 0x3c7 },
+{ "Eabovedot", 0x3cc },
+{ "Imacron", 0x3cf },
+{ "Ncedilla", 0x3d1 },
+{ "Omacron", 0x3d2 },
+{ "Kcedilla", 0x3d3 },
+{ "Uogonek", 0x3d9 },
+{ "Utilde", 0x3dd },
+{ "Umacron", 0x3de },
+{ "amacron", 0x3e0 },
+{ "iogonek", 0x3e7 },
+{ "eabovedot", 0x3ec },
+{ "imacron", 0x3ef },
+{ "ncedilla", 0x3f1 },
+{ "omacron", 0x3f2 },
+{ "kcedilla", 0x3f3 },
+{ "uogonek", 0x3f9 },
+{ "utilde", 0x3fd },
+{ "umacron", 0x3fe },
+{ "overline", 0x47e },
+{ "kana_fullstop", 0x4a1 },
+{ "kana_openingbracket", 0x4a2 },
+{ "kana_closingbracket", 0x4a3 },
+{ "kana_comma", 0x4a4 },
+{ "kana_middledot", 0x4a5 },
+{ "kana_WO", 0x4a6 },
+{ "kana_a", 0x4a7 },
+{ "kana_i", 0x4a8 },
+{ "kana_u", 0x4a9 },
+{ "kana_e", 0x4aa },
+{ "kana_o", 0x4ab },
+{ "kana_ya", 0x4ac },
+{ "kana_yu", 0x4ad },
+{ "kana_yo", 0x4ae },
+{ "kana_tu", 0x4af },
+{ "prolongedsound", 0x4b0 },
+{ "kana_A", 0x4b1 },
+{ "kana_I", 0x4b2 },
+{ "kana_U", 0x4b3 },
+{ "kana_E", 0x4b4 },
+{ "kana_O", 0x4b5 },
+{ "kana_KA", 0x4b6 },
+{ "kana_KI", 0x4b7 },
+{ "kana_KU", 0x4b8 },
+{ "kana_KE", 0x4b9 },
+{ "kana_KO", 0x4ba },
+{ "kana_SA", 0x4bb },
+{ "kana_SHI", 0x4bc },
+{ "kana_SU", 0x4bd },
+{ "kana_SE", 0x4be },
+{ "kana_SO", 0x4bf },
+{ "kana_TA", 0x4c0 },
+{ "kana_TI", 0x4c1 },
+{ "kana_TU", 0x4c2 },
+{ "kana_TE", 0x4c3 },
+{ "kana_TO", 0x4c4 },
+{ "kana_NA", 0x4c5 },
+{ "kana_NI", 0x4c6 },
+{ "kana_NU", 0x4c7 },
+{ "kana_NE", 0x4c8 },
+{ "kana_NO", 0x4c9 },
+{ "kana_HA", 0x4ca },
+{ "kana_HI", 0x4cb },
+{ "kana_HU", 0x4cc },
+{ "kana_HE", 0x4cd },
+{ "kana_HO", 0x4ce },
+{ "kana_MA", 0x4cf },
+{ "kana_MI", 0x4d0 },
+{ "kana_MU", 0x4d1 },
+{ "kana_ME", 0x4d2 },
+{ "kana_MO", 0x4d3 },
+{ "kana_YA", 0x4d4 },
+{ "kana_YU", 0x4d5 },
+{ "kana_YO", 0x4d6 },
+{ "kana_RA", 0x4d7 },
+{ "kana_RI", 0x4d8 },
+{ "kana_RU", 0x4d9 },
+{ "kana_RE", 0x4da },
+{ "kana_RO", 0x4db },
+{ "kana_WA", 0x4dc },
+{ "kana_N", 0x4dd },
+{ "voicedsound", 0x4de },
+{ "semivoicedsound", 0x4df },
+{ "kana_switch", 0xFF7E },
+{ "Arabic_comma", 0x5ac },
+{ "Arabic_semicolon", 0x5bb },
+{ "Arabic_question_mark", 0x5bf },
+{ "Arabic_hamza", 0x5c1 },
+{ "Arabic_maddaonalef", 0x5c2 },
+{ "Arabic_hamzaonalef", 0x5c3 },
+{ "Arabic_hamzaonwaw", 0x5c4 },
+{ "Arabic_hamzaunderalef", 0x5c5 },
+{ "Arabic_hamzaonyeh", 0x5c6 },
+{ "Arabic_alef", 0x5c7 },
+{ "Arabic_beh", 0x5c8 },
+{ "Arabic_tehmarbuta", 0x5c9 },
+{ "Arabic_teh", 0x5ca },
+{ "Arabic_theh", 0x5cb },
+{ "Arabic_jeem", 0x5cc },
+{ "Arabic_hah", 0x5cd },
+{ "Arabic_khah", 0x5ce },
+{ "Arabic_dal", 0x5cf },
+{ "Arabic_thal", 0x5d0 },
+{ "Arabic_ra", 0x5d1 },
+{ "Arabic_zain", 0x5d2 },
+{ "Arabic_seen", 0x5d3 },
+{ "Arabic_sheen", 0x5d4 },
+{ "Arabic_sad", 0x5d5 },
+{ "Arabic_dad", 0x5d6 },
+{ "Arabic_tah", 0x5d7 },
+{ "Arabic_zah", 0x5d8 },
+{ "Arabic_ain", 0x5d9 },
+{ "Arabic_ghain", 0x5da },
+{ "Arabic_tatweel", 0x5e0 },
+{ "Arabic_feh", 0x5e1 },
+{ "Arabic_qaf", 0x5e2 },
+{ "Arabic_kaf", 0x5e3 },
+{ "Arabic_lam", 0x5e4 },
+{ "Arabic_meem", 0x5e5 },
+{ "Arabic_noon", 0x5e6 },
+{ "Arabic_heh", 0x5e7 },
+{ "Arabic_waw", 0x5e8 },
+{ "Arabic_alefmaksura", 0x5e9 },
+{ "Arabic_yeh", 0x5ea },
+{ "Arabic_fathatan", 0x5eb },
+{ "Arabic_dammatan", 0x5ec },
+{ "Arabic_kasratan", 0x5ed },
+{ "Arabic_fatha", 0x5ee },
+{ "Arabic_damma", 0x5ef },
+{ "Arabic_kasra", 0x5f0 },
+{ "Arabic_shadda", 0x5f1 },
+{ "Arabic_sukun", 0x5f2 },
+{ "Arabic_switch", 0xFF7E },
+{ "Serbian_dje", 0x6a1 },
+{ "Macedonia_gje", 0x6a2 },
+{ "Cyrillic_io", 0x6a3 },
+{ "Ukranian_je", 0x6a4 },
+{ "Macedonia_dse", 0x6a5 },
+{ "Ukranian_i", 0x6a6 },
+{ "Ukranian_yi", 0x6a7 },
+{ "Serbian_je", 0x6a8 },
+{ "Serbian_lje", 0x6a9 },
+{ "Serbian_nje", 0x6aa },
+{ "Serbian_tshe", 0x6ab },
+{ "Macedonia_kje", 0x6ac },
+{ "Byelorussian_shortu", 0x6ae },
+{ "Serbian_dze", 0x6af },
+{ "numerosign", 0x6b0 },
+{ "Serbian_DJE", 0x6b1 },
+{ "Macedonia_GJE", 0x6b2 },
+{ "Cyrillic_IO", 0x6b3 },
+{ "Ukranian_JE", 0x6b4 },
+{ "Macedonia_DSE", 0x6b5 },
+{ "Ukranian_I", 0x6b6 },
+{ "Ukranian_YI", 0x6b7 },
+{ "Serbian_JE", 0x6b8 },
+{ "Serbian_LJE", 0x6b9 },
+{ "Serbian_NJE", 0x6ba },
+{ "Serbian_TSHE", 0x6bb },
+{ "Macedonia_KJE", 0x6bc },
+{ "Byelorussian_SHORTU", 0x6be },
+{ "Serbian_DZE", 0x6bf },
+{ "Cyrillic_yu", 0x6c0 },
+{ "Cyrillic_a", 0x6c1 },
+{ "Cyrillic_be", 0x6c2 },
+{ "Cyrillic_tse", 0x6c3 },
+{ "Cyrillic_de", 0x6c4 },
+{ "Cyrillic_ie", 0x6c5 },
+{ "Cyrillic_ef", 0x6c6 },
+{ "Cyrillic_ghe", 0x6c7 },
+{ "Cyrillic_ha", 0x6c8 },
+{ "Cyrillic_i", 0x6c9 },
+{ "Cyrillic_shorti", 0x6ca },
+{ "Cyrillic_ka", 0x6cb },
+{ "Cyrillic_el", 0x6cc },
+{ "Cyrillic_em", 0x6cd },
+{ "Cyrillic_en", 0x6ce },
+{ "Cyrillic_o", 0x6cf },
+{ "Cyrillic_pe", 0x6d0 },
+{ "Cyrillic_ya", 0x6d1 },
+{ "Cyrillic_er", 0x6d2 },
+{ "Cyrillic_es", 0x6d3 },
+{ "Cyrillic_te", 0x6d4 },
+{ "Cyrillic_u", 0x6d5 },
+{ "Cyrillic_zhe", 0x6d6 },
+{ "Cyrillic_ve", 0x6d7 },
+{ "Cyrillic_softsign", 0x6d8 },
+{ "Cyrillic_yeru", 0x6d9 },
+{ "Cyrillic_ze", 0x6da },
+{ "Cyrillic_sha", 0x6db },
+{ "Cyrillic_e", 0x6dc },
+{ "Cyrillic_shcha", 0x6dd },
+{ "Cyrillic_che", 0x6de },
+{ "Cyrillic_hardsign", 0x6df },
+{ "Cyrillic_YU", 0x6e0 },
+{ "Cyrillic_A", 0x6e1 },
+{ "Cyrillic_BE", 0x6e2 },
+{ "Cyrillic_TSE", 0x6e3 },
+{ "Cyrillic_DE", 0x6e4 },
+{ "Cyrillic_IE", 0x6e5 },
+{ "Cyrillic_EF", 0x6e6 },
+{ "Cyrillic_GHE", 0x6e7 },
+{ "Cyrillic_HA", 0x6e8 },
+{ "Cyrillic_I", 0x6e9 },
+{ "Cyrillic_SHORTI", 0x6ea },
+{ "Cyrillic_KA", 0x6eb },
+{ "Cyrillic_EL", 0x6ec },
+{ "Cyrillic_EM", 0x6ed },
+{ "Cyrillic_EN", 0x6ee },
+{ "Cyrillic_O", 0x6ef },
+{ "Cyrillic_PE", 0x6f0 },
+{ "Cyrillic_YA", 0x6f1 },
+{ "Cyrillic_ER", 0x6f2 },
+{ "Cyrillic_ES", 0x6f3 },
+{ "Cyrillic_TE", 0x6f4 },
+{ "Cyrillic_U", 0x6f5 },
+{ "Cyrillic_ZHE", 0x6f6 },
+{ "Cyrillic_VE", 0x6f7 },
+{ "Cyrillic_SOFTSIGN", 0x6f8 },
+{ "Cyrillic_YERU", 0x6f9 },
+{ "Cyrillic_ZE", 0x6fa },
+{ "Cyrillic_SHA", 0x6fb },
+{ "Cyrillic_E", 0x6fc },
+{ "Cyrillic_SHCHA", 0x6fd },
+{ "Cyrillic_CHE", 0x6fe },
+{ "Cyrillic_HARDSIGN", 0x6ff },
+{ "Greek_ALPHAaccent", 0x7a1 },
+{ "Greek_EPSILONaccent", 0x7a2 },
+{ "Greek_ETAaccent", 0x7a3 },
+{ "Greek_IOTAaccent", 0x7a4 },
+{ "Greek_IOTAdiaeresis", 0x7a5 },
+{ "Greek_IOTAaccentdiaeresis", 0x7a6 },
+{ "Greek_OMICRONaccent", 0x7a7 },
+{ "Greek_UPSILONaccent", 0x7a8 },
+{ "Greek_UPSILONdieresis", 0x7a9 },
+{ "Greek_UPSILONaccentdieresis", 0x7aa },
+{ "Greek_OMEGAaccent", 0x7ab },
+{ "Greek_alphaaccent", 0x7b1 },
+{ "Greek_epsilonaccent", 0x7b2 },
+{ "Greek_etaaccent", 0x7b3 },
+{ "Greek_iotaaccent", 0x7b4 },
+{ "Greek_iotadieresis", 0x7b5 },
+{ "Greek_iotaaccentdieresis", 0x7b6 },
+{ "Greek_omicronaccent", 0x7b7 },
+{ "Greek_upsilonaccent", 0x7b8 },
+{ "Greek_upsilondieresis", 0x7b9 },
+{ "Greek_upsilonaccentdieresis", 0x7ba },
+{ "Greek_omegaaccent", 0x7bb },
+{ "Greek_ALPHA", 0x7c1 },
+{ "Greek_BETA", 0x7c2 },
+{ "Greek_GAMMA", 0x7c3 },
+{ "Greek_DELTA", 0x7c4 },
+{ "Greek_EPSILON", 0x7c5 },
+{ "Greek_ZETA", 0x7c6 },
+{ "Greek_ETA", 0x7c7 },
+{ "Greek_THETA", 0x7c8 },
+{ "Greek_IOTA", 0x7c9 },
+{ "Greek_KAPPA", 0x7ca },
+{ "Greek_LAMBDA", 0x7cb },
+{ "Greek_MU", 0x7cc },
+{ "Greek_NU", 0x7cd },
+{ "Greek_XI", 0x7ce },
+{ "Greek_OMICRON", 0x7cf },
+{ "Greek_PI", 0x7d0 },
+{ "Greek_RHO", 0x7d1 },
+{ "Greek_SIGMA", 0x7d2 },
+{ "Greek_TAU", 0x7d4 },
+{ "Greek_UPSILON", 0x7d5 },
+{ "Greek_PHI", 0x7d6 },
+{ "Greek_CHI", 0x7d7 },
+{ "Greek_PSI", 0x7d8 },
+{ "Greek_OMEGA", 0x7d9 },
+{ "Greek_alpha", 0x7e1 },
+{ "Greek_beta", 0x7e2 },
+{ "Greek_gamma", 0x7e3 },
+{ "Greek_delta", 0x7e4 },
+{ "Greek_epsilon", 0x7e5 },
+{ "Greek_zeta", 0x7e6 },
+{ "Greek_eta", 0x7e7 },
+{ "Greek_theta", 0x7e8 },
+{ "Greek_iota", 0x7e9 },
+{ "Greek_kappa", 0x7ea },
+{ "Greek_lambda", 0x7eb },
+{ "Greek_mu", 0x7ec },
+{ "Greek_nu", 0x7ed },
+{ "Greek_xi", 0x7ee },
+{ "Greek_omicron", 0x7ef },
+{ "Greek_pi", 0x7f0 },
+{ "Greek_rho", 0x7f1 },
+{ "Greek_sigma", 0x7f2 },
+{ "Greek_finalsmallsigma", 0x7f3 },
+{ "Greek_tau", 0x7f4 },
+{ "Greek_upsilon", 0x7f5 },
+{ "Greek_phi", 0x7f6 },
+{ "Greek_chi", 0x7f7 },
+{ "Greek_psi", 0x7f8 },
+{ "Greek_omega", 0x7f9 },
+{ "Greek_switch", 0xFF7E },
+{ "leftradical", 0x8a1 },
+{ "topleftradical", 0x8a2 },
+{ "horizconnector", 0x8a3 },
+{ "topintegral", 0x8a4 },
+{ "botintegral", 0x8a5 },
+{ "vertconnector", 0x8a6 },
+{ "topleftsqbracket", 0x8a7 },
+{ "botleftsqbracket", 0x8a8 },
+{ "toprightsqbracket", 0x8a9 },
+{ "botrightsqbracket", 0x8aa },
+{ "topleftparens", 0x8ab },
+{ "botleftparens", 0x8ac },
+{ "toprightparens", 0x8ad },
+{ "botrightparens", 0x8ae },
+{ "leftmiddlecurlybrace", 0x8af },
+{ "rightmiddlecurlybrace", 0x8b0 },
+{ "topleftsummation", 0x8b1 },
+{ "botleftsummation", 0x8b2 },
+{ "topvertsummationconnector", 0x8b3 },
+{ "botvertsummationconnector", 0x8b4 },
+{ "toprightsummation", 0x8b5 },
+{ "botrightsummation", 0x8b6 },
+{ "rightmiddlesummation", 0x8b7 },
+{ "lessthanequal", 0x8bc },
+{ "notequal", 0x8bd },
+{ "greaterthanequal", 0x8be },
+{ "integral", 0x8bf },
+{ "therefore", 0x8c0 },
+{ "variation", 0x8c1 },
+{ "infinity", 0x8c2 },
+{ "nabla", 0x8c5 },
+{ "approximate", 0x8c8 },
+{ "similarequal", 0x8c9 },
+{ "ifonlyif", 0x8cd },
+{ "implies", 0x8ce },
+{ "identical", 0x8cf },
+{ "radical", 0x8d6 },
+{ "includedin", 0x8da },
+{ "includes", 0x8db },
+{ "intersection", 0x8dc },
+{ "union", 0x8dd },
+{ "logicaland", 0x8de },
+{ "logicalor", 0x8df },
+{ "partialderivative", 0x8ef },
+{ "function", 0x8f6 },
+{ "leftarrow", 0x8fb },
+{ "uparrow", 0x8fc },
+{ "rightarrow", 0x8fd },
+{ "downarrow", 0x8fe },
+{ "blank", 0x9df },
+{ "soliddiamond", 0x9e0 },
+{ "checkerboard", 0x9e1 },
+{ "ht", 0x9e2 },
+{ "ff", 0x9e3 },
+{ "cr", 0x9e4 },
+{ "lf", 0x9e5 },
+{ "nl", 0x9e8 },
+{ "vt", 0x9e9 },
+{ "lowrightcorner", 0x9ea },
+{ "uprightcorner", 0x9eb },
+{ "upleftcorner", 0x9ec },
+{ "lowleftcorner", 0x9ed },
+{ "crossinglines", 0x9ee },
+{ "horizlinescan1", 0x9ef },
+{ "horizlinescan3", 0x9f0 },
+{ "horizlinescan5", 0x9f1 },
+{ "horizlinescan7", 0x9f2 },
+{ "horizlinescan9", 0x9f3 },
+{ "leftt", 0x9f4 },
+{ "rightt", 0x9f5 },
+{ "bott", 0x9f6 },
+{ "topt", 0x9f7 },
+{ "vertbar", 0x9f8 },
+{ "emspace", 0xaa1 },
+{ "enspace", 0xaa2 },
+{ "em3space", 0xaa3 },
+{ "em4space", 0xaa4 },
+{ "digitspace", 0xaa5 },
+{ "punctspace", 0xaa6 },
+{ "thinspace", 0xaa7 },
+{ "hairspace", 0xaa8 },
+{ "emdash", 0xaa9 },
+{ "endash", 0xaaa },
+{ "signifblank", 0xaac },
+{ "ellipsis", 0xaae },
+{ "doubbaselinedot", 0xaaf },
+{ "onethird", 0xab0 },
+{ "twothirds", 0xab1 },
+{ "onefifth", 0xab2 },
+{ "twofifths", 0xab3 },
+{ "threefifths", 0xab4 },
+{ "fourfifths", 0xab5 },
+{ "onesixth", 0xab6 },
+{ "fivesixths", 0xab7 },
+{ "careof", 0xab8 },
+{ "figdash", 0xabb },
+{ "leftanglebracket", 0xabc },
+{ "decimalpoint", 0xabd },
+{ "rightanglebracket", 0xabe },
+{ "marker", 0xabf },
+{ "oneeighth", 0xac3 },
+{ "threeeighths", 0xac4 },
+{ "fiveeighths", 0xac5 },
+{ "seveneighths", 0xac6 },
+{ "trademark", 0xac9 },
+{ "signaturemark", 0xaca },
+{ "trademarkincircle", 0xacb },
+{ "leftopentriangle", 0xacc },
+{ "rightopentriangle", 0xacd },
+{ "emopencircle", 0xace },
+{ "emopenrectangle", 0xacf },
+{ "leftsinglequotemark", 0xad0 },
+{ "rightsinglequotemark", 0xad1 },
+{ "leftdoublequotemark", 0xad2 },
+{ "rightdoublequotemark", 0xad3 },
+{ "prescription", 0xad4 },
+{ "minutes", 0xad6 },
+{ "seconds", 0xad7 },
+{ "latincross", 0xad9 },
+{ "hexagram", 0xada },
+{ "filledrectbullet", 0xadb },
+{ "filledlefttribullet", 0xadc },
+{ "filledrighttribullet", 0xadd },
+{ "emfilledcircle", 0xade },
+{ "emfilledrect", 0xadf },
+{ "enopencircbullet", 0xae0 },
+{ "enopensquarebullet", 0xae1 },
+{ "openrectbullet", 0xae2 },
+{ "opentribulletup", 0xae3 },
+{ "opentribulletdown", 0xae4 },
+{ "openstar", 0xae5 },
+{ "enfilledcircbullet", 0xae6 },
+{ "enfilledsqbullet", 0xae7 },
+{ "filledtribulletup", 0xae8 },
+{ "filledtribulletdown", 0xae9 },
+{ "leftpointer", 0xaea },
+{ "rightpointer", 0xaeb },
+{ "club", 0xaec },
+{ "diamond", 0xaed },
+{ "heart", 0xaee },
+{ "maltesecross", 0xaf0 },
+{ "dagger", 0xaf1 },
+{ "doubledagger", 0xaf2 },
+{ "checkmark", 0xaf3 },
+{ "ballotcross", 0xaf4 },
+{ "musicalsharp", 0xaf5 },
+{ "musicalflat", 0xaf6 },
+{ "malesymbol", 0xaf7 },
+{ "femalesymbol", 0xaf8 },
+{ "telephone", 0xaf9 },
+{ "telephonerecorder", 0xafa },
+{ "phonographcopyright", 0xafb },
+{ "caret", 0xafc },
+{ "singlelowquotemark", 0xafd },
+{ "doublelowquotemark", 0xafe },
+{ "cursor", 0xaff },
+{ "leftcaret", 0xba3 },
+{ "rightcaret", 0xba6 },
+{ "downcaret", 0xba8 },
+{ "upcaret", 0xba9 },
+{ "overbar", 0xbc0 },
+{ "downtack", 0xbc2 },
+{ "upshoe", 0xbc3 },
+{ "downstile", 0xbc4 },
+{ "underbar", 0xbc6 },
+{ "jot", 0xbca },
+{ "quad", 0xbcc },
+{ "uptack", 0xbce },
+{ "circle", 0xbcf },
+{ "upstile", 0xbd3 },
+{ "downshoe", 0xbd6 },
+{ "rightshoe", 0xbd8 },
+{ "leftshoe", 0xbda },
+{ "lefttack", 0xbdc },
+{ "righttack", 0xbfc },
+{ "hebrew_aleph", 0xce0 },
+{ "hebrew_beth", 0xce1 },
+{ "hebrew_gimmel", 0xce2 },
+{ "hebrew_daleth", 0xce3 },
+{ "hebrew_he", 0xce4 },
+{ "hebrew_waw", 0xce5 },
+{ "hebrew_zayin", 0xce6 },
+{ "hebrew_het", 0xce7 },
+{ "hebrew_teth", 0xce8 },
+{ "hebrew_yod", 0xce9 },
+{ "hebrew_finalkaph", 0xcea },
+{ "hebrew_kaph", 0xceb },
+{ "hebrew_lamed", 0xcec },
+{ "hebrew_finalmem", 0xced },
+{ "hebrew_mem", 0xcee },
+{ "hebrew_finalnun", 0xcef },
+{ "hebrew_nun", 0xcf0 },
+{ "hebrew_samekh", 0xcf1 },
+{ "hebrew_ayin", 0xcf2 },
+{ "hebrew_finalpe", 0xcf3 },
+{ "hebrew_pe", 0xcf4 },
+{ "hebrew_finalzadi", 0xcf5 },
+{ "hebrew_zadi", 0xcf6 },
+{ "hebrew_kuf", 0xcf7 },
+{ "hebrew_resh", 0xcf8 },
+{ "hebrew_shin", 0xcf9 },
+{ "hebrew_taf", 0xcfa },
+{ "Hebrew_switch", 0xFF7E },
diff --git a/tk/generic/tk.h b/tk/generic/tk.h
new file mode 100644
index 00000000000..5d1a05603dc
--- /dev/null
+++ b/tk/generic/tk.h
@@ -0,0 +1,1565 @@
+/*
+ * 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.
+ * 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$
+ */
+
+#ifndef _TK
+#define _TK
+
+/*
+ * When version numbers change here, you must also go into the following files
+ * and update the version numbers:
+ *
+ * README
+ * unix/configure.in
+ * win/makefile.bc (Not for patch release updates)
+ * win/makefile.vc (Not for patch release updates)
+ * win/README
+ * 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 4
+
+#define TK_VERSION "8.0"
+#define TK_PATCH_LEVEL "8.0.4"
+
+/*
+ * 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
+
+#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_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
+/* CYGNUS LOCAL: Support -version argument. */
+#define TK_ARGV_VERSION 27
+#define TK_ARGV_END 28
+
+/*
+ * 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));
+
+typedef struct Tk_CustomOption {
+ Tk_OptionParseProc *parseProc; /* Procedure to call to parse an
+ * option and store it in converted
+ * form. */
+ Tk_OptionPrintProc *printProc; /* Procedure to return a printable
+ * string describing an existing
+ * option. */
+ ClientData clientData; /* Arbitrary one-word value used by
+ * option parser: passed to
+ * parseProc and printProc. */
+} Tk_CustomOption;
+
+/*
+ * Structure used to specify information for Tk_ConfigureWidget. Each
+ * structure gives complete information for one option, including
+ * how the option is specified on the command line, where it appears
+ * in the option database, etc.
+ */
+
+typedef struct Tk_ConfigSpec {
+ int type; /* Type of option, such as TK_CONFIG_COLOR;
+ * see definitions below. Last option in
+ * table must have type TK_CONFIG_END. */
+ char *argvName; /* Switch used to specify option in argv.
+ * NULL means this spec is part of a group. */
+ 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 or database. */
+ int offset; /* Where in widget record to store value;
+ * use Tk_Offset macro to generate values
+ * for this. */
+ int specFlags; /* Any combination of the values defined
+ * below; other bits are used internally
+ * by tkConfig.c. */
+ Tk_CustomOption *customPtr; /* If type is TK_CONFIG_CUSTOM then this is
+ * a pointer to info about how to parse and
+ * print the option. Otherwise it is
+ * irrelevant. */
+} 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 {
+ TK_DEFER_EVENT, TK_PROCESS_EVENT, TK_DISCARD_EVENT
+} Tk_RestrictAction;
+
+/*
+ * Priority levels to pass to Tk_AddOption:
+ */
+
+#define TK_WIDGET_DEFAULT_PRIO 20
+#define TK_STARTUP_FILE_PRIO 40
+#define TK_USER_DEFAULT_PRIO 60
+#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
+#define TK_3D_DARK_GC 3
+
+/*
+ * Special EnterNotify/LeaveNotify "mode" for use in events
+ * generated by tkShare.c. Pick a high enough value that it's
+ * unlikely to conflict with existing values (like NotifyNormal)
+ * or any new values defined in the future.
+ */
+
+#define TK_NOTIFY_SHARE 20
+
+/*
+ * Enumerated type for describing a point by which to anchor something:
+ */
+
+typedef enum {
+ TK_ANCHOR_N, TK_ANCHOR_NE, TK_ANCHOR_E, TK_ANCHOR_SE,
+ TK_ANCHOR_S, TK_ANCHOR_SW, TK_ANCHOR_W, TK_ANCHOR_NW,
+ TK_ANCHOR_CENTER
+} Tk_Anchor;
+
+/*
+ * Enumerated type for describing a style of justification:
+ */
+
+typedef enum {
+ TK_JUSTIFY_LEFT, TK_JUSTIFY_RIGHT, TK_JUSTIFY_CENTER
+} Tk_Justify;
+
+/*
+ * The following structure is used by Tk_GetFontMetrics() to return
+ * information about the properties of a Tk_Font.
+ */
+
+typedef struct Tk_FontMetrics {
+ int ascent; /* The amount in pixels that the tallest
+ * letter sticks up above the baseline, plus
+ * any extra blank space added by the designer
+ * of the font. */
+ int descent; /* The largest amount in pixels that any
+ * letter sticks below the baseline, plus any
+ * extra blank space added by the designer of
+ * the font. */
+ int linespace; /* The sum of the ascent and descent. How
+ * far apart two lines of text in the same
+ * font should be placed so that none of the
+ * characters in one line overlap any of the
+ * characters in the other line. */
+} Tk_FontMetrics;
+
+/*
+ * Flags passed to Tk_MeasureChars:
+ */
+
+#define TK_WHOLE_WORDS 1
+#define TK_AT_LEAST_ONE 2
+#define TK_PARTIAL_OK 4
+
+/*
+ * Flags passed to Tk_ComputeTextLayout:
+ */
+
+#define TK_IGNORE_TABS 8
+#define TK_IGNORE_NEWLINES 16
+
+/*
+ * Each geometry manager (the packer, the placer, etc.) is represented
+ * by a structure of the following form, which indicates procedures
+ * to invoke in the geometry manager to carry out certain functions.
+ */
+
+typedef void (Tk_GeomRequestProc) _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+typedef void (Tk_GeomLostSlaveProc) _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+
+typedef struct Tk_GeomMgr {
+ char *name; /* Name of the geometry manager (command
+ * used to invoke it, or name of widget
+ * class that allows embedded widgets). */
+ Tk_GeomRequestProc *requestProc;
+ /* Procedure to invoke when a slave's
+ * requested geometry changes. */
+ Tk_GeomLostSlaveProc *lostSlaveProc;
+ /* Procedure to invoke when a slave is
+ * taken away from one geometry manager
+ * by another. NULL means geometry manager
+ * doesn't care when slaves are lost. */
+} Tk_GeomMgr;
+
+/*
+ * Result values returned by Tk_GetScrollInfo:
+ */
+
+#define TK_SCROLL_MOVETO 1
+#define TK_SCROLL_PAGES 2
+#define TK_SCROLL_UNITS 3
+#define TK_SCROLL_ERROR 4
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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
+ * of the detail field for a virtual event so that it holds the name of the
+ * virtual event being triggered.
+ */
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* True if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window event; /* Window on which event was requested. */
+ Window root; /* root window that the event occured on */
+ Window subwindow; /* child window */
+ Time time; /* milliseconds */
+ 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 */
+ Tk_Uid name; /* Name of virtual event. */
+ Bool same_screen; /* same screen flag */
+} XVirtualEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* True if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window window; /* Window in which event occurred. */
+} XActivateDeactivateEvent;
+typedef XActivateDeactivateEvent XActivateEvent;
+typedef XActivateDeactivateEvent XDeactivateEvent;
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Macros for querying Tk_Window structures. See the
+ * manual entries for documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+#define Tk_Display(tkwin) (((Tk_FakeWin *) (tkwin))->display)
+#define Tk_ScreenNumber(tkwin) (((Tk_FakeWin *) (tkwin))->screenNum)
+#define Tk_Screen(tkwin) (ScreenOfDisplay(Tk_Display(tkwin), \
+ Tk_ScreenNumber(tkwin)))
+#define Tk_Depth(tkwin) (((Tk_FakeWin *) (tkwin))->depth)
+#define Tk_Visual(tkwin) (((Tk_FakeWin *) (tkwin))->visual)
+#define Tk_WindowId(tkwin) (((Tk_FakeWin *) (tkwin))->window)
+#define Tk_PathName(tkwin) (((Tk_FakeWin *) (tkwin))->pathName)
+#define Tk_Name(tkwin) (((Tk_FakeWin *) (tkwin))->nameUid)
+#define Tk_Class(tkwin) (((Tk_FakeWin *) (tkwin))->classUid)
+#define Tk_X(tkwin) (((Tk_FakeWin *) (tkwin))->changes.x)
+#define Tk_Y(tkwin) (((Tk_FakeWin *) (tkwin))->changes.y)
+#define Tk_Width(tkwin) (((Tk_FakeWin *) (tkwin))->changes.width)
+#define Tk_Height(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->changes.height)
+#define Tk_Changes(tkwin) (&((Tk_FakeWin *) (tkwin))->changes)
+#define Tk_Attributes(tkwin) (&((Tk_FakeWin *) (tkwin))->atts)
+#define Tk_IsEmbedded(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_EMBEDDED)
+#define Tk_IsContainer(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_CONTAINER)
+#define Tk_IsMapped(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_MAPPED)
+#define Tk_IsTopLevel(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->flags & TK_TOP_LEVEL)
+#define Tk_ReqWidth(tkwin) (((Tk_FakeWin *) (tkwin))->reqWidth)
+#define Tk_ReqHeight(tkwin) (((Tk_FakeWin *) (tkwin))->reqHeight)
+#define Tk_InternalBorderWidth(tkwin) \
+ (((Tk_FakeWin *) (tkwin))->internalBorderWidth)
+#define Tk_Parent(tkwin) (((Tk_FakeWin *) (tkwin))->parentPtr)
+#define Tk_Colormap(tkwin) (((Tk_FakeWin *) (tkwin))->atts.colormap)
+
+/*
+ * The structure below is needed by the macros above so that they can
+ * access the fields of a Tk_Window. The fields not needed by the macros
+ * are declared as "dummyX". The structure has its own type in order to
+ * prevent applications from accessing Tk_Window fields except using
+ * official macros. WARNING!! The structure definition must be kept
+ * consistent with the TkWindow structure in tkInt.h. If you change one,
+ * then change the other. See the declaration in tkInt.h for
+ * documentation on what the fields are used for internally.
+ */
+
+typedef struct Tk_FakeWin {
+ Display *display;
+ char *dummy1;
+ int screenNum;
+ Visual *visual;
+ int depth;
+ Window window;
+ char *dummy2;
+ char *dummy3;
+ Tk_Window parentPtr;
+ char *dummy4;
+ char *dummy5;
+ char *pathName;
+ Tk_Uid nameUid;
+ Tk_Uid classUid;
+ XWindowChanges changes;
+ unsigned int dummy6;
+ XSetWindowAttributes atts;
+ unsigned long dummy7;
+ unsigned int flags;
+ char *dummy8;
+#ifdef TK_USE_INPUT_METHODS
+ XIC dummy9;
+#endif /* TK_USE_INPUT_METHODS */
+ ClientData *dummy10;
+ int dummy11;
+ int dummy12;
+ char *dummy13;
+ char *dummy14;
+ ClientData dummy15;
+ int reqWidth, reqHeight;
+ int internalBorderWidth;
+ char *dummy16;
+ char *dummy17;
+ ClientData dummy18;
+ char *dummy19;
+} Tk_FakeWin;
+
+/*
+ * Flag values for TkWindow (and Tk_FakeWin) structures are:
+ *
+ * TK_MAPPED: 1 means window is currently mapped,
+ * 0 means unmapped.
+ * TK_TOP_LEVEL: 1 means this is a top-level window (it
+ * was or will be created as a child of
+ * a root window).
+ * TK_ALREADY_DEAD: 1 means the window is in the process of
+ * being destroyed already.
+ * TK_NEED_CONFIG_NOTIFY: 1 means that the window has been reconfigured
+ * before it was made to exist. At the time of
+ * making it exist a ConfigureNotify event needs
+ * to be generated.
+ * TK_GRAB_FLAG: Used to manage grabs. See tkGrab.c for
+ * details.
+ * TK_CHECKED_IC: 1 means we've already tried to get an input
+ * context for this window; if the ic field
+ * is NULL it means that there isn't a context
+ * for the field.
+ * TK_DONT_DESTROY_WINDOW: 1 means that Tk_DestroyWindow should not
+ * invoke XDestroyWindow to destroy this widget's
+ * X window. The flag is set when the window
+ * has already been destroyed elsewhere (e.g.
+ * by another application) or when it will be
+ * destroyed later (e.g. by destroying its
+ * parent).
+ * TK_WM_COLORMAP_WINDOW: 1 means that this window has at some time
+ * appeared in the WM_COLORMAP_WINDOWS property
+ * for its toplevel, so we have to remove it
+ * from that property if the window is
+ * deleted and the toplevel isn't.
+ * TK_EMBEDDED: 1 means that this window (which must be a
+ * toplevel) is not a free-standing window but
+ * rather is embedded in some other application.
+ * TK_CONTAINER: 1 means that this window is a container, and
+ * that some other application (either in
+ * this process or elsewhere) may be
+ * embedding itself inside the window.
+ * TK_BOTH_HALVES: 1 means that this window is used for
+ * application embedding (either as
+ * container or embedded application), and
+ * both the containing and embedded halves
+ * are associated with windows in this
+ * particular process.
+ * TK_DEFER_MODAL: 1 means that this window has deferred a modal
+ * loop until all of the bindings for the current
+ * event have been invoked.
+ * TK_WRAPPER: 1 means that this window is the extra
+ * wrapper window created around a toplevel
+ * to hold the menubar under Unix. See
+ * tkUnixWm.c for more information.
+ * TK_REPARENTED: 1 means that this window has been reparented
+ * so that as far as the window system is
+ * concerned it isn't a child of its Tk
+ * parent. Initially this is used only for
+ * special Unix menubar windows.
+ */
+
+
+#define TK_MAPPED 1
+#define TK_TOP_LEVEL 2
+#define TK_ALREADY_DEAD 4
+#define TK_NEED_CONFIG_NOTIFY 8
+#define TK_GRAB_FLAG 0x10
+#define TK_CHECKED_IC 0x20
+#define TK_DONT_DESTROY_WINDOW 0x40
+#define TK_WM_COLORMAP_WINDOW 0x80
+#define TK_EMBEDDED 0x100
+#define TK_CONTAINER 0x200
+#define TK_BOTH_HALVES 0x400
+#define TK_DEFER_MODAL 0x800
+#define TK_WRAPPER 0x1000
+#define TK_REPARENTED 0x2000
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Procedure prototypes and structures used for defining new canvas
+ * items:
+ *
+ *--------------------------------------------------------------
+ */
+
+/*
+ * For each item in a canvas widget there exists one record with
+ * the following structure. Each actual item is represented by
+ * a record with the following stuff at its beginning, plus additional
+ * type-specific stuff after that.
+ */
+
+#define TK_TAG_SPACE 3
+
+typedef struct Tk_Item {
+ int id; /* Unique identifier for this item
+ * (also serves as first tag for
+ * item). */
+ struct Tk_Item *nextPtr; /* Next in display list of all
+ * items in this canvas. Later items
+ * in list are drawn on top of earlier
+ * ones. */
+ Tk_Uid staticTagSpace[TK_TAG_SPACE];/* Built-in space for limited # of
+ * tags. */
+ Tk_Uid *tagPtr; /* Pointer to array of tags. Usually
+ * points to staticTagSpace, but
+ * may point to malloc-ed space if
+ * there are lots of tags. */
+ int tagSpace; /* Total amount of tag space available
+ * at tagPtr. */
+ int numTags; /* Number of tag slots actually used
+ * at *tagPtr. */
+ struct Tk_ItemType *typePtr; /* Table of procedures that implement
+ * 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.
+ *------------------------------------------------------------------
+ */
+} Tk_Item;
+
+/*
+ * Records of the following type are used to describe a type of
+ * item (e.g. lines, circles, etc.) that can form part of a
+ * canvas widget.
+ */
+
+typedef int Tk_ItemCreateProc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv));
+typedef int Tk_ItemConfigureProc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+typedef int Tk_ItemCoordProc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv));
+typedef void Tk_ItemDeleteProc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+typedef void Tk_ItemDisplayProc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+typedef double Tk_ItemPointProc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr));
+typedef int Tk_ItemAreaProc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+typedef int Tk_ItemPostscriptProc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+typedef void Tk_ItemScaleProc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+typedef void Tk_ItemTranslateProc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+typedef int Tk_ItemIndexProc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, char *indexString,
+ int *indexPtr));
+typedef void Tk_ItemCursorProc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int index));
+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
+ * this type. */
+ Tk_ConfigSpec *configSpecs; /* Pointer to array of configuration
+ * specs for this type. Used for
+ * returning configuration info. */
+ Tk_ItemConfigureProc *configProc; /* Procedure to call to change
+ * configuration options. */
+ Tk_ItemCoordProc *coordProc; /* Procedure to call to get and set
+ * the item's coordinates. */
+ Tk_ItemDeleteProc *deleteProc; /* Procedure to delete existing item of
+ * this type. */
+ Tk_ItemDisplayProc *displayProc; /* Procedure to display items of
+ * this type. */
+ int alwaysRedraw; /* Non-zero means displayProc should
+ * be called even when the item has
+ * been moved off-screen. */
+ Tk_ItemPointProc *pointProc; /* Computes distance from item to
+ * a given point. */
+ Tk_ItemAreaProc *areaProc; /* Computes whether item is inside,
+ * outside, or overlapping an area. */
+ Tk_ItemPostscriptProc *postscriptProc;
+ /* Procedure to write a Postscript
+ * description for items of this
+ * type. */
+ Tk_ItemScaleProc *scaleProc; /* Procedure to rescale items of
+ * this type. */
+ Tk_ItemTranslateProc *translateProc;/* Procedure to translate items of
+ * this type. */
+ Tk_ItemIndexProc *indexProc; /* Procedure to determine index of
+ * indicated character. NULL if
+ * item doesn't support indexing. */
+ Tk_ItemCursorProc *icursorProc; /* Procedure to set insert cursor pos.
+ * to just before a given position. */
+ Tk_ItemSelectionProc *selectionProc;/* Procedure to return selection (in
+ * STRING format) when it is in this
+ * 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;
+
+/*
+ * 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,
+ * or NULL if no such item. Read-only to
+ * items. */
+ int gotFocus; /* Non-zero means that the canvas widget has
+ * the input focus. Read-only to items.*/
+ int cursorOn; /* Non-zero means that an insertion cursor
+ * should be displayed in focusItemPtr.
+ * Read-only to items.*/
+} Tk_CanvasTextInfo;
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Procedure prototypes and structures used for managing images:
+ *
+ *--------------------------------------------------------------
+ */
+
+typedef struct Tk_ImageType Tk_ImageType;
+typedef int (Tk_ImageCreateProc) _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, int objc, Tcl_Obj *CONST objv[], Tk_ImageType *typePtr,
+ Tk_ImageMaster master, ClientData *masterDataPtr));
+typedef ClientData (Tk_ImageGetProc) _ANSI_ARGS_((Tk_Window tkwin,
+ ClientData masterData));
+typedef void (Tk_ImageDisplayProc) _ANSI_ARGS_((ClientData instanceData,
+ Display *display, Drawable drawable, int imageX, int imageY,
+ int width, int height, int drawableX, int drawableY));
+typedef void (Tk_ImageFreeProc) _ANSI_ARGS_((ClientData instanceData,
+ Display *display));
+typedef void (Tk_ImageDeleteProc) _ANSI_ARGS_((ClientData masterData));
+typedef void (Tk_ImageChangedProc) _ANSI_ARGS_((ClientData clientData,
+ int x, int y, int width, int height, int imageWidth,
+ int imageHeight));
+
+/*
+ * The following structure represents a particular type of image
+ * (bitmap, xpm image, etc.). It provides information common to
+ * all images of that type, such as the type name and a collection
+ * of procedures in the image manager that respond to various
+ * events. Each image manager is represented by one of these
+ * structures.
+ */
+
+struct Tk_ImageType {
+ char *name; /* Name of image type. */
+ Tk_ImageCreateProc *createProc;
+ /* Procedure to call to create a new image
+ * of this type. */
+ Tk_ImageGetProc *getProc; /* Procedure to call the first time
+ * Tk_GetImage is called in a new way
+ * (new visual or screen). */
+ Tk_ImageDisplayProc *displayProc;
+ /* Call to draw image, in response to
+ * Tk_RedrawImage calls. */
+ Tk_ImageFreeProc *freeProc; /* Procedure to call whenever Tk_FreeImage
+ * is called to release an instance of an
+ * image. */
+ Tk_ImageDeleteProc *deleteProc;
+ /* Procedure to call to delete image. It
+ * 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".
+ *
+ *--------------------------------------------------------------
+ */
+
+/*
+ * The following type is used to identify a particular photo image
+ * to be manipulated:
+ */
+
+typedef void *Tk_PhotoHandle;
+
+/*
+ * The following structure describes a block of pixels in memory:
+ */
+
+typedef struct Tk_PhotoImageBlock {
+ unsigned char *pixelPtr; /* Pointer to the first pixel. */
+ int width; /* Width of block, in pixels. */
+ int height; /* Height of block, in pixels. */
+ 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:
+ */
+
+typedef struct Tk_PhotoImageFormat Tk_PhotoImageFormat;
+typedef int (Tk_ImageFileMatchProc) _ANSI_ARGS_((Tcl_Channel chan,
+ char *fileName, char *formatString, int *widthPtr, int *heightPtr));
+typedef int (Tk_ImageStringMatchProc) _ANSI_ARGS_((Tcl_Obj *dataObj,
+ char *formatString, int *widthPtr, int *heightPtr));
+typedef int (Tk_ImageFileReadProc) _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Channel chan, char *fileName, char *formatString,
+ Tk_PhotoHandle imageHandle, int destX, int destY,
+ int width, int height, int srcX, int srcY));
+typedef int (Tk_ImageStringReadProc) _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *dataObj, char *formatString, Tk_PhotoHandle imageHandle,
+ int destX, int destY, int width, int height, int srcX, int srcY));
+typedef int (Tk_ImageFileWriteProc) _ANSI_ARGS_((Tcl_Interp *interp,
+ char *fileName, char *formatString, Tk_PhotoImageBlock *blockPtr));
+typedef int (Tk_ImageStringWriteProc) _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_DString *dataPtr, char *formatString,
+ Tk_PhotoImageBlock *blockPtr));
+
+/*
+ * The following structure represents a particular file format for
+ * storing images (e.g., PPM, GIF, JPEG, etc.). It provides information
+ * to allow image files of that format to be recognized and read into
+ * a photo image.
+ */
+
+struct Tk_PhotoImageFormat {
+ char *name; /* Name of image file format */
+ Tk_ImageFileMatchProc *fileMatchProc;
+ /* Procedure to call to determine whether
+ * an image file matches this format. */
+ Tk_ImageStringMatchProc *stringMatchProc;
+ /* Procedure to call to determine whether
+ * the data in a string matches this format. */
+ Tk_ImageFileReadProc *fileReadProc;
+ /* Procedure to call to read data from
+ * an image file into a photo image. */
+ Tk_ImageStringReadProc *stringReadProc;
+ /* Procedure to call to read data from
+ * a string into a photo image. */
+ Tk_ImageFileWriteProc *fileWriteProc;
+ /* Procedure to call to write data from
+ * a photo image to a file. */
+ Tk_ImageStringWriteProc *stringWriteProc;
+ /* Procedure to call to obtain a string
+ * representation of the data in a photo
+ * image.*/
+ struct Tk_PhotoImageFormat *nextPtr;
+ /* Next in list of all photo image formats
+ * currently known. Filled in by Tk, not
+ * by image format handler. */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * The definitions below provide backward compatibility for
+ * functions and types related to event handling that used to
+ * be in Tk but have moved to Tcl.
+ *
+ *--------------------------------------------------------------
+ */
+
+#define TK_READABLE TCL_READABLE
+#define TK_WRITABLE TCL_WRITABLE
+#define TK_EXCEPTION TCL_EXCEPTION
+
+#define TK_DONT_WAIT TCL_DONT_WAIT
+#define TK_X_EVENTS TCL_WINDOW_EVENTS
+#define TK_WINDOW_EVENTS TCL_WINDOW_EVENTS
+#define TK_FILE_EVENTS TCL_FILE_EVENTS
+#define TK_TIMER_EVENTS TCL_TIMER_EVENTS
+#define TK_IDLE_EVENTS TCL_IDLE_EVENTS
+#define TK_ALL_EVENTS TCL_ALL_EVENTS
+
+#define Tk_IdleProc Tcl_IdleProc
+#define Tk_FileProc Tcl_FileProc
+#define Tk_TimerProc Tcl_TimerProc
+#define Tk_TimerToken Tcl_TimerToken
+
+#define Tk_BackgroundError Tcl_BackgroundError
+#define Tk_CancelIdleCall Tcl_CancelIdleCall
+#define Tk_CreateFileHandler Tcl_CreateFileHandler
+#define Tk_CreateTimerHandler Tcl_CreateTimerHandler
+#define Tk_DeleteFileHandler Tcl_DeleteFileHandler
+#define Tk_DeleteTimerHandler Tcl_DeleteTimerHandler
+#define Tk_DoOneEvent Tcl_DoOneEvent
+#define Tk_DoWhenIdle Tcl_DoWhenIdle
+#define Tk_Sleep Tcl_Sleep
+
+#define Tk_EventuallyFree Tcl_EventuallyFree
+#define Tk_FreeProc Tcl_FreeProc
+#define Tk_Preserve Tcl_Preserve
+#define Tk_Release Tcl_Release
+#define Tk_FileeventCmd Tcl_FileEventCmd
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Additional procedure types defined by Tk.
+ *
+ *--------------------------------------------------------------
+ */
+
+typedef int (Tk_ErrorProc) _ANSI_ARGS_((ClientData clientData,
+ XErrorEvent *errEventPtr));
+typedef void (Tk_EventProc) _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+typedef int (Tk_GenericProc) _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+typedef int (Tk_GetSelProc) _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, char *portion));
+typedef void (Tk_LostSelProc) _ANSI_ARGS_((ClientData clientData));
+typedef Tk_RestrictAction (Tk_RestrictProc) _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+typedef int (Tk_SelectionProc) _ANSI_ARGS_((ClientData clientData,
+ int offset, char *buffer, int maxBytes));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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));
+/* CYGNUS LOCAL. */
+EXTERN GC Tk_GetGCColor _ANSI_ARGS_((Tk_Window tkwin,
+ unsigned long valueMask, XGCValues *valuePtr,
+ XColor *foreground, XColor *background));
+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_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_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_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_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, Tcl_Obj *CONST objv[]));
+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 */
+
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TK */
diff --git a/tk/generic/tk3d.c b/tk/generic/tk3d.c
new file mode 100644
index 00000000000..62139b5e333
--- /dev/null
+++ b/tk/generic/tk3d.c
@@ -0,0 +1,950 @@
+/*
+ * 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$
+ */
+
+#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_GetGCColor(tkwin, GCForeground, &gcValues,
+ borderPtr->bgColorPtr, NULL);
+ }
+ return (Tk_3DBorder) borderPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_Draw3DRectangle --
+ *
+ * Draw a 3-D border at a given place in a given window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A 3-D border will be drawn in the indicated drawable.
+ * The outside edges of the border will be determined by x,
+ * y, width, and height. The inside edges of the border
+ * will be determined by the borderWidth argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_Draw3DRectangle(tkwin, drawable, border, x, y, width, height,
+ borderWidth, relief)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Drawable drawable; /* X window or pixmap in which to draw. */
+ Tk_3DBorder border; /* Token for border to draw. */
+ int x, y, width, height; /* Outside area of region in
+ * which border will be drawn. */
+ int borderWidth; /* Desired width for border, in
+ * pixels. */
+ int relief; /* Type of relief: TK_RELIEF_RAISED,
+ * TK_RELIEF_SUNKEN, TK_RELIEF_GROOVE, etc. */
+{
+ if (width < 2*borderWidth) {
+ borderWidth = width/2;
+ }
+ if (height < 2*borderWidth) {
+ borderWidth = height/2;
+ }
+ Tk_3DVerticalBevel(tkwin, drawable, border, x, y, borderWidth, height,
+ 1, relief);
+ Tk_3DVerticalBevel(tkwin, drawable, border, x+width-borderWidth, y,
+ borderWidth, height, 0, relief);
+ Tk_3DHorizontalBevel(tkwin, drawable, border, x, y, width, borderWidth,
+ 1, 1, 1, relief);
+ Tk_3DHorizontalBevel(tkwin, drawable, border, x, y+height-borderWidth,
+ width, borderWidth, 0, 0, 0, relief);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOf3DBorder --
+ *
+ * Given a border, return a textual string identifying the
+ * border's color.
+ *
+ * Results:
+ * The return value is the string that was used to create
+ * the border.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_NameOf3DBorder(border)
+ Tk_3DBorder border; /* Token for border. */
+{
+ TkBorder *borderPtr = (TkBorder *) border;
+
+ return ((BorderKey *) borderPtr->hashPtr->key.words)->colorName;
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
+ * Tk_3DBorderColor --
+ *
+ * Given a 3D border, return the X color used for the "flat"
+ * surfaces.
+ *
+ * Results:
+ * Returns the color used drawing flat surfaces with the border.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------------
+ */
+XColor *
+Tk_3DBorderColor(border)
+ Tk_3DBorder border; /* Border whose color is wanted. */
+{
+ return(((TkBorder *) border)->bgColorPtr);
+}
+
+/*
+ *--------------------------------------------------------------------
+ *
+ * Tk_3DBorderGC --
+ *
+ * Given a 3D border, returns one of the graphics contexts used to
+ * draw the border.
+ *
+ * Results:
+ * Returns the graphics context given by the "which" argument.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------------
+ */
+GC
+Tk_3DBorderGC(tkwin, border, which)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Tk_3DBorder border; /* Border whose GC is wanted. */
+ int which; /* Selects one of the border's 3 GC's:
+ * TK_3D_FLAT_GC, TK_3D_LIGHT_GC, or
+ * TK_3D_DARK_GC. */
+{
+ TkBorder * borderPtr = (TkBorder *) border;
+
+ if ((borderPtr->lightGC == None) && (which != TK_3D_FLAT_GC)) {
+ TkpGetShadows(borderPtr, tkwin);
+ }
+ if (which == TK_3D_FLAT_GC) {
+ return borderPtr->bgGC;
+ } else if (which == TK_3D_LIGHT_GC) {
+ return borderPtr->lightGC;
+ } else if (which == TK_3D_DARK_GC){
+ return borderPtr->darkGC;
+ }
+ panic("bogus \"which\" value in Tk_3DBorderGC");
+
+ /*
+ * The code below will never be executed, but it's needed to
+ * keep compilers happy.
+ */
+
+ return (GC) None;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_Free3DBorder --
+ *
+ * This procedure is called when a 3D border is no longer
+ * needed. It frees the resources associated with the
+ * border. After this call, the caller should never again
+ * use the "border" token.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources are freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+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
+ * 3-D border.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Tkwin's background gets modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetBackgroundFromBorder(tkwin, border)
+ 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
+ * relief value, or an error.
+ *
+ * Results:
+ * A standard Tcl return value. If all goes well then
+ * *reliefPtr is filled in with one of the values
+ * TK_RELIEF_RAISED, TK_RELIEF_FLAT, or TK_RELIEF_SUNKEN.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetRelief(interp, name, reliefPtr)
+ Tcl_Interp *interp; /* For error messages. */
+ char *name; /* Name of a relief type. */
+ int *reliefPtr; /* Where to store converted relief. */
+{
+ char c;
+ size_t length;
+
+ c = name[0];
+ length = strlen(name);
+ if ((c == 'f') && (strncmp(name, "flat", length) == 0)) {
+ *reliefPtr = TK_RELIEF_FLAT;
+ } else if ((c == 'g') && (strncmp(name, "groove", length) == 0)
+ && (length >= 2)) {
+ *reliefPtr = TK_RELIEF_GROOVE;
+ } else if ((c == 'r') && (strncmp(name, "raised", length) == 0)
+ && (length >= 2)) {
+ *reliefPtr = TK_RELIEF_RAISED;
+ } 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfRelief --
+ *
+ * Given a relief value, produce a string describing that
+ * relief value.
+ *
+ * Results:
+ * The return value is a static string that is equivalent
+ * to relief.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_NameOfRelief(relief)
+ int relief; /* One of TK_RELIEF_FLAT, TK_RELIEF_RAISED,
+ * or TK_RELIEF_SUNKEN. */
+{
+ if (relief == TK_RELIEF_FLAT) {
+ return "flat";
+ } else if (relief == TK_RELIEF_SUNKEN) {
+ return "sunken";
+ } else if (relief == TK_RELIEF_RAISED) {
+ return "raised";
+ } else if (relief == TK_RELIEF_GROOVE) {
+ return "groove";
+ } else if (relief == TK_RELIEF_RIDGE) {
+ return "ridge";
+ } else if (relief == TK_RELIEF_SOLID) {
+ return "solid";
+ } else {
+ return "unknown relief";
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_Draw3DPolygon --
+ *
+ * Draw a border with 3-D appearance around the edge of a
+ * given polygon.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information is drawn in "drawable" in the form of a
+ * 3-D border borderWidth units width wide on the left
+ * of the trajectory given by pointPtr and numPoints (or
+ * -borderWidth units wide on the right side, if borderWidth
+ * is negative).
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_Draw3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
+ borderWidth, leftRelief)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Drawable drawable; /* X window or pixmap in which to draw. */
+ Tk_3DBorder border; /* Token for border to draw. */
+ XPoint *pointPtr; /* Array of points describing
+ * polygon. All points must be
+ * absolute (CoordModeOrigin). */
+ int numPoints; /* Number of points at *pointPtr. */
+ int borderWidth; /* Width of border, measured in
+ * pixels to the left of the polygon's
+ * trajectory. May be negative. */
+ int leftRelief; /* TK_RELIEF_RAISED or
+ * TK_RELIEF_SUNKEN: indicates how
+ * stuff to left of trajectory looks
+ * relative to stuff on right. */
+{
+ XPoint poly[4], b1, b2, newB1, newB2;
+ XPoint perp, c, shift1, shift2; /* Used for handling parallel lines. */
+ register XPoint *p1Ptr, *p2Ptr;
+ TkBorder *borderPtr = (TkBorder *) border;
+ GC gc;
+ int i, lightOnLeft, dx, dy, parallel, pointsSeen;
+ Display *display = Tk_Display(tkwin);
+
+ if (borderPtr->lightGC == None) {
+ TkpGetShadows(borderPtr, tkwin);
+ }
+
+ /*
+ * Handle grooves and ridges with recursive calls.
+ */
+
+ if ((leftRelief == TK_RELIEF_GROOVE) || (leftRelief == TK_RELIEF_RIDGE)) {
+ int halfWidth;
+
+ halfWidth = borderWidth/2;
+ Tk_Draw3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
+ halfWidth, (leftRelief == TK_RELIEF_GROOVE) ? TK_RELIEF_RAISED
+ : TK_RELIEF_SUNKEN);
+ Tk_Draw3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
+ -halfWidth, (leftRelief == TK_RELIEF_GROOVE) ? TK_RELIEF_SUNKEN
+ : TK_RELIEF_RAISED);
+ return;
+ }
+
+ /*
+ * If the polygon is already closed, drop the last point from it
+ * (we'll close it automatically).
+ */
+
+ p1Ptr = &pointPtr[numPoints-1];
+ p2Ptr = &pointPtr[0];
+ if ((p1Ptr->x == p2Ptr->x) && (p1Ptr->y == p2Ptr->y)) {
+ numPoints--;
+ }
+
+ /*
+ * The loop below is executed once for each vertex in the polgon.
+ * At the beginning of each iteration things look like this:
+ *
+ * poly[1] /
+ * * /
+ * | /
+ * b1 * poly[0] (pointPtr[i-1])
+ * | |
+ * | |
+ * | |
+ * | |
+ * | |
+ * | | *p1Ptr *p2Ptr
+ * b2 *--------------------*
+ * |
+ * |
+ * x-------------------------
+ *
+ * The job of this iteration is to do the following:
+ * (a) Compute x (the border corner corresponding to
+ * pointPtr[i]) and put it in poly[2]. As part of
+ * this, compute a new b1 and b2 value for the next
+ * side of the polygon.
+ * (b) Put pointPtr[i] into poly[3].
+ * (c) Draw the polygon given by poly[0..3].
+ * (d) Advance poly[0], poly[1], b1, and b2 for the
+ * next side of the polygon.
+ */
+
+ /*
+ * The above situation doesn't first come into existence until
+ * two points have been processed; the first two points are
+ * used to "prime the pump", so some parts of the processing
+ * are ommitted for these points. The variable "pointsSeen"
+ * keeps track of the priming process; it has to be separate
+ * from i in order to be able to ignore duplicate points in the
+ * polygon.
+ */
+
+ pointsSeen = 0;
+ for (i = -2, p1Ptr = &pointPtr[numPoints-2], p2Ptr = p1Ptr+1;
+ i < numPoints; i++, p1Ptr = p2Ptr, p2Ptr++) {
+ if ((i == -1) || (i == numPoints-1)) {
+ p2Ptr = pointPtr;
+ }
+ if ((p2Ptr->x == p1Ptr->x) && (p2Ptr->y == p1Ptr->y)) {
+ /*
+ * Ignore duplicate points (they'd cause core dumps in
+ * ShiftLine calls below).
+ */
+ continue;
+ }
+ ShiftLine(p1Ptr, p2Ptr, borderWidth, &newB1);
+ newB2.x = newB1.x + (p2Ptr->x - p1Ptr->x);
+ newB2.y = newB1.y + (p2Ptr->y - p1Ptr->y);
+ poly[3] = *p1Ptr;
+ parallel = 0;
+ if (pointsSeen >= 1) {
+ parallel = Intersect(&newB1, &newB2, &b1, &b2, &poly[2]);
+
+ /*
+ * If two consecutive segments of the polygon are parallel,
+ * then things get more complex. Consider the following
+ * diagram:
+ *
+ * poly[1]
+ * *----b1-----------b2------a
+ * \
+ * \
+ * *---------*----------* b
+ * poly[0] *p2Ptr *p1Ptr /
+ * /
+ * --*--------*----c
+ * newB1 newB2
+ *
+ * Instead of using x and *p1Ptr for poly[2] and poly[3], as
+ * in the original diagram, use a and b as above. Then instead
+ * of using x and *p1Ptr for the new poly[0] and poly[1], use
+ * b and c as above.
+ *
+ * Do the computation in three stages:
+ * 1. Compute a point "perp" such that the line p1Ptr-perp
+ * is perpendicular to p1Ptr-p2Ptr.
+ * 2. Compute the points a and c by intersecting the lines
+ * b1-b2 and newB1-newB2 with p1Ptr-perp.
+ * 3. Compute b by shifting p1Ptr-perp to the right and
+ * intersecting it with p1Ptr-p2Ptr.
+ */
+
+ if (parallel) {
+ perp.x = p1Ptr->x + (p2Ptr->y - p1Ptr->y);
+ perp.y = p1Ptr->y - (p2Ptr->x - p1Ptr->x);
+ (void) Intersect(p1Ptr, &perp, &b1, &b2, &poly[2]);
+ (void) Intersect(p1Ptr, &perp, &newB1, &newB2, &c);
+ ShiftLine(p1Ptr, &perp, borderWidth, &shift1);
+ shift2.x = shift1.x + (perp.x - p1Ptr->x);
+ shift2.y = shift1.y + (perp.y - p1Ptr->y);
+ (void) Intersect(p1Ptr, p2Ptr, &shift1, &shift2, &poly[3]);
+ }
+ }
+ if (pointsSeen >= 2) {
+ dx = poly[3].x - poly[0].x;
+ dy = poly[3].y - poly[0].y;
+ if (dx > 0) {
+ lightOnLeft = (dy <= dx);
+ } else {
+ lightOnLeft = (dy < dx);
+ }
+ if (lightOnLeft ^ (leftRelief == TK_RELIEF_RAISED)) {
+ gc = borderPtr->lightGC;
+ } else {
+ gc = borderPtr->darkGC;
+ }
+ XFillPolygon(display, drawable, gc, poly, 4, Convex,
+ CoordModeOrigin);
+ }
+ b1.x = newB1.x;
+ b1.y = newB1.y;
+ b2.x = newB2.x;
+ b2.y = newB2.y;
+ poly[0].x = poly[3].x;
+ poly[0].y = poly[3].y;
+ if (parallel) {
+ poly[1].x = c.x;
+ poly[1].y = c.y;
+ } else if (pointsSeen >= 1) {
+ poly[1].x = poly[2].x;
+ poly[1].y = poly[2].y;
+ }
+ pointsSeen++;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Fill3DRectangle --
+ *
+ * Fill a rectangular area, supplying a 3D border if desired.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets drawn on the screen.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_Fill3DRectangle(tkwin, drawable, border, x, y, width,
+ height, borderWidth, relief)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Drawable drawable; /* X window or pixmap in which to draw. */
+ Tk_3DBorder border; /* Token for border to draw. */
+ int x, y, width, height; /* Outside area of rectangular region. */
+ int borderWidth; /* Desired width for border, in
+ * pixels. Border will be *inside* region. */
+ int relief; /* Indicates 3D effect: TK_RELIEF_FLAT,
+ * TK_RELIEF_RAISED, or TK_RELIEF_SUNKEN. */
+{
+ register TkBorder *borderPtr = (TkBorder *) border;
+ int doubleBorder;
+
+ /*
+ * This code is slightly tricky because it only draws the background
+ * in areas not covered by the 3D border. This avoids flashing
+ * effects on the screen for the border region.
+ */
+
+ if (relief == TK_RELIEF_FLAT) {
+ borderWidth = 0;
+ }
+ doubleBorder = 2*borderWidth;
+
+ if ((width > doubleBorder) && (height > doubleBorder)) {
+ XFillRectangle(Tk_Display(tkwin), drawable, borderPtr->bgGC,
+ x + borderWidth, y + borderWidth,
+ (unsigned int) (width - doubleBorder),
+ (unsigned int) (height - doubleBorder));
+ }
+ if (borderWidth) {
+ Tk_Draw3DRectangle(tkwin, drawable, border, x, y, width,
+ height, borderWidth, relief);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Fill3DPolygon --
+ *
+ * Fill a polygonal area, supplying a 3D border if desired.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets drawn on the screen.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_Fill3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
+ borderWidth, leftRelief)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Drawable drawable; /* X window or pixmap in which to draw. */
+ Tk_3DBorder border; /* Token for border to draw. */
+ XPoint *pointPtr; /* Array of points describing
+ * polygon. All points must be
+ * absolute (CoordModeOrigin). */
+ int numPoints; /* Number of points at *pointPtr. */
+ int borderWidth; /* Width of border, measured in
+ * pixels to the left of the polygon's
+ * trajectory. May be negative. */
+ int leftRelief; /* Indicates 3D effect of left side of
+ * trajectory relative to right:
+ * TK_RELIEF_FLAT, TK_RELIEF_RAISED,
+ * or TK_RELIEF_SUNKEN. */
+{
+ register TkBorder *borderPtr = (TkBorder *) border;
+
+ XFillPolygon(Tk_Display(tkwin), drawable, borderPtr->bgGC,
+ pointPtr, numPoints, Complex, CoordModeOrigin);
+ if (leftRelief != TK_RELIEF_FLAT) {
+ Tk_Draw3DPolygon(tkwin, drawable, border, pointPtr, numPoints,
+ borderWidth, leftRelief);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * BorderInit --
+ *
+ * Initialize the structures used for border management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *-------------------------------------------------------------
+ */
+
+static void
+BorderInit()
+{
+ initialized = 1;
+ Tcl_InitHashTable(&borderTable, sizeof(BorderKey)/sizeof(int));
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ShiftLine --
+ *
+ * Given two points on a line, compute a point on a
+ * new line that is parallel to the given line and
+ * a given distance away from it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ShiftLine(p1Ptr, p2Ptr, distance, p3Ptr)
+ XPoint *p1Ptr; /* First point on line. */
+ XPoint *p2Ptr; /* Second point on line. */
+ int distance; /* New line is to be this many
+ * units to the left of original
+ * line, when looking from p1 to
+ * p2. May be negative. */
+ XPoint *p3Ptr; /* Store coords of point on new
+ * line here. */
+{
+ int dx, dy, dxNeg, dyNeg;
+
+ /*
+ * The table below is used for a quick approximation in
+ * computing the new point. An index into the table
+ * is 128 times the slope of the original line (the slope
+ * must always be between 0 and 1). The value of the table
+ * entry is 128 times the amount to displace the new line
+ * in y for each unit of perpendicular distance. In other
+ * words, the table maps from the tangent of an angle to
+ * the inverse of its cosine. If the slope of the original
+ * line is greater than 1, then the displacement is done in
+ * x rather than in y.
+ */
+
+ static int shiftTable[129];
+
+ /*
+ * Initialize the table if this is the first time it is
+ * used.
+ */
+
+ if (shiftTable[0] == 0) {
+ int i;
+ double tangent, cosine;
+
+ for (i = 0; i <= 128; i++) {
+ tangent = i/128.0;
+ cosine = 128/cos(atan(tangent)) + .5;
+ shiftTable[i] = (int) cosine;
+ }
+ }
+
+ *p3Ptr = *p1Ptr;
+ dx = p2Ptr->x - p1Ptr->x;
+ dy = p2Ptr->y - p1Ptr->y;
+ if (dy < 0) {
+ dyNeg = 1;
+ dy = -dy;
+ } else {
+ dyNeg = 0;
+ }
+ if (dx < 0) {
+ dxNeg = 1;
+ dx = -dx;
+ } else {
+ dxNeg = 0;
+ }
+ if (dy <= dx) {
+ dy = ((distance * shiftTable[(dy<<7)/dx]) + 64) >> 7;
+ if (!dxNeg) {
+ dy = -dy;
+ }
+ p3Ptr->y += dy;
+ } else {
+ dx = ((distance * shiftTable[(dx<<7)/dy]) + 64) >> 7;
+ if (dyNeg) {
+ dx = -dx;
+ }
+ p3Ptr->x += dx;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Intersect --
+ *
+ * Find the intersection point between two lines.
+ *
+ * Results:
+ * Under normal conditions 0 is returned and the point
+ * at *iPtr is filled in with the intersection between
+ * the two lines. If the two lines are parallel, then
+ * -1 is returned and *iPtr isn't modified.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+Intersect(a1Ptr, a2Ptr, b1Ptr, b2Ptr, iPtr)
+ XPoint *a1Ptr; /* First point of first line. */
+ XPoint *a2Ptr; /* Second point of first line. */
+ XPoint *b1Ptr; /* First point of second line. */
+ XPoint *b2Ptr; /* Second point of second line. */
+ XPoint *iPtr; /* Filled in with intersection point. */
+{
+ int dxadyb, dxbdya, dxadxb, dyadyb, p, q;
+
+ /*
+ * The code below is just a straightforward manipulation of two
+ * equations of the form y = (x-x1)*(y2-y1)/(x2-x1) + y1 to solve
+ * for the x-coordinate of intersection, then the y-coordinate.
+ */
+
+ dxadyb = (a2Ptr->x - a1Ptr->x)*(b2Ptr->y - b1Ptr->y);
+ dxbdya = (b2Ptr->x - b1Ptr->x)*(a2Ptr->y - a1Ptr->y);
+ dxadxb = (a2Ptr->x - a1Ptr->x)*(b2Ptr->x - b1Ptr->x);
+ dyadyb = (a2Ptr->y - a1Ptr->y)*(b2Ptr->y - b1Ptr->y);
+
+ if (dxadyb == dxbdya) {
+ return -1;
+ }
+ p = (a1Ptr->x*dxbdya - b1Ptr->x*dxadyb + (b1Ptr->y - a1Ptr->y)*dxadxb);
+ q = dxbdya - dxadyb;
+ if (q < 0) {
+ p = -p;
+ q = -q;
+ }
+ if (p < 0) {
+ iPtr->x = - ((-p + q/2)/q);
+ } else {
+ iPtr->x = (p + q/2)/q;
+ }
+ p = (a1Ptr->y*dxadyb - b1Ptr->y*dxbdya + (b1Ptr->x - a1Ptr->x)*dyadyb);
+ q = dxadyb - dxbdya;
+ if (q < 0) {
+ p = -p;
+ q = -q;
+ }
+ if (p < 0) {
+ iPtr->y = - ((-p + q/2)/q);
+ } else {
+ iPtr->y = (p + q/2)/q;
+ }
+ return 0;
+}
diff --git a/tk/generic/tk3d.h b/tk/generic/tk3d.h
new file mode 100644
index 00000000000..71115f2cf5f
--- /dev/null
+++ b/tk/generic/tk3d.h
@@ -0,0 +1,87 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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 {
+ 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
+ * (must free this when deleting structure).
+ * NULL means shadows haven't been allocated
+ * yet. */
+ Pixmap shadow; /* Stipple pattern to use for drawing
+ * shadows areas. Used for displays with
+ * <= 64 colors or where colormap has filled
+ * up. */
+ GC bgGC; /* Used (if necessary) to draw areas in
+ * the background color. */
+ GC darkGC; /* Used to draw darker parts of the
+ * 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));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TK3D */
diff --git a/tk/generic/tkArgv.c b/tk/generic/tkArgv.c
new file mode 100644
index 00000000000..b44939ed7c4
--- /dev/null
+++ b/tk/generic/tkArgv.c
@@ -0,0 +1,439 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tk.h"
+
+/*
+ * Default table of argument descriptors. These are normally available
+ * in every application.
+ */
+
+static Tk_ArgvInfo defaultTable[] = {
+ {"-help", TK_ARGV_HELP, (char *) NULL, (char *) NULL,
+ "Print summary of command-line options and abort"},
+ {"-version", TK_ARGV_VERSION, (char *) NULL, (char *) NULL,
+ "Print version number and abort"},
+ {NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
+ (char *) NULL}
+};
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void PrintUsage _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_ArgvInfo *argTable, int flags));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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,
+ * or procedures may be called. It all depends on the arguments
+ * and their entries in argTable. See the user documentation
+ * for details.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ParseArgv(interp, tkwin, argcPtr, argv, argTable, flags)
+ Tcl_Interp *interp; /* Place to store error message. */
+ Tk_Window tkwin; /* Window to use for setting Tk options.
+ * NULL means ignore Tk option specs. */
+ int *argcPtr; /* Number of arguments in argv. Modified
+ * to hold # args left in argv at end. */
+ char **argv; /* Array of arguments. Modified to hold
+ * those that couldn't be processed here. */
+ Tk_ArgvInfo *argTable; /* Array of option descriptions */
+ int flags; /* Or'ed combination of various flag bits,
+ * such as TK_ARGV_NO_DEFAULTS. */
+{
+ register Tk_ArgvInfo *infoPtr;
+ /* Pointer to the current entry in the
+ * table of argument descriptions. */
+ Tk_ArgvInfo *matchPtr; /* Descriptor that matches current argument. */
+ char *curArg; /* Current argument */
+ register char c; /* Second character of current arg (used for
+ * quick check for matching; use 2nd char.
+ * because first char. will almost always
+ * be '-'). */
+ int srcIndex; /* Location from which to read next argument
+ * from argv. */
+ int dstIndex; /* Index into argv to which next unused
+ * argument should be copied (never greater
+ * than srcIndex). */
+ int argc; /* # arguments in argv still to process. */
+ size_t length; /* Number of characters in current argument. */
+ int i;
+
+ if (flags & TK_ARGV_DONT_SKIP_FIRST_ARG) {
+ srcIndex = dstIndex = 0;
+ argc = *argcPtr;
+ } else {
+ srcIndex = dstIndex = 1;
+ argc = *argcPtr-1;
+ }
+
+ while (argc > 0) {
+ curArg = argv[srcIndex];
+ srcIndex++;
+ argc--;
+ length = strlen(curArg);
+ if (length > 0) {
+ c = curArg[1];
+ } else {
+ c = 0;
+ }
+
+ /*
+ * Loop throught the argument descriptors searching for one with
+ * the matching key string. If found, leave a pointer to it in
+ * matchPtr.
+ */
+
+ matchPtr = NULL;
+ for (i = 0; i < 2; i++) {
+ if (i == 0) {
+ infoPtr = argTable;
+ } else {
+ infoPtr = defaultTable;
+ }
+ for (; (infoPtr != NULL) && (infoPtr->type != TK_ARGV_END);
+ infoPtr++) {
+ if (infoPtr->key == NULL) {
+ continue;
+ }
+ if ((infoPtr->key[1] != c)
+ || (strncmp(infoPtr->key, curArg, length) != 0)) {
+ continue;
+ }
+ if ((tkwin == NULL)
+ && ((infoPtr->type == TK_ARGV_CONST_OPTION)
+ || (infoPtr->type == TK_ARGV_OPTION_VALUE)
+ || (infoPtr->type == TK_ARGV_OPTION_NAME_VALUE))) {
+ continue;
+ }
+ if (infoPtr->key[length] == 0) {
+ matchPtr = infoPtr;
+ goto gotMatch;
+ }
+ if (flags & TK_ARGV_NO_ABBREV) {
+ continue;
+ }
+ if (matchPtr != NULL) {
+ Tcl_AppendResult(interp, "ambiguous option \"", curArg,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ matchPtr = infoPtr;
+ }
+ }
+ if (matchPtr == NULL) {
+
+ /*
+ * Unrecognized argument. Just copy it down, unless the caller
+ * prefers an error to be registered.
+ */
+
+ if (flags & TK_ARGV_NO_LEFTOVERS) {
+ Tcl_AppendResult(interp, "unrecognized argument \"",
+ curArg, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ argv[dstIndex] = curArg;
+ dstIndex++;
+ continue;
+ }
+
+ /*
+ * Take the appropriate action based on the option type
+ */
+
+ gotMatch:
+ infoPtr = matchPtr;
+ switch (infoPtr->type) {
+ case TK_ARGV_CONSTANT:
+ *((int *) infoPtr->dst) = (int) infoPtr->src;
+ break;
+ case TK_ARGV_INT:
+ if (argc == 0) {
+ goto missingArg;
+ } else {
+ char *endPtr;
+
+ *((int *) infoPtr->dst) =
+ strtol(argv[srcIndex], &endPtr, 0);
+ if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) {
+ Tcl_AppendResult(interp, "expected integer argument ",
+ "for \"", infoPtr->key, "\" but got \"",
+ argv[srcIndex], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ srcIndex++;
+ argc--;
+ }
+ break;
+ case TK_ARGV_STRING:
+ if (argc == 0) {
+ goto missingArg;
+ } else {
+ *((char **)infoPtr->dst) = argv[srcIndex];
+ srcIndex++;
+ argc--;
+ }
+ break;
+ case TK_ARGV_UID:
+ if (argc == 0) {
+ goto missingArg;
+ } else {
+ *((Tk_Uid *)infoPtr->dst) = Tk_GetUid(argv[srcIndex]);
+ srcIndex++;
+ argc--;
+ }
+ break;
+ case TK_ARGV_REST:
+ *((int *) infoPtr->dst) = dstIndex;
+ goto argsDone;
+ case TK_ARGV_FLOAT:
+ if (argc == 0) {
+ goto missingArg;
+ } else {
+ char *endPtr;
+
+ *((double *) infoPtr->dst) =
+ strtod(argv[srcIndex], &endPtr);
+ if ((endPtr == argv[srcIndex]) || (*endPtr != 0)) {
+ Tcl_AppendResult(interp, "expected floating-point ",
+ "argument for \"", infoPtr->key,
+ "\" but got \"", argv[srcIndex], "\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ srcIndex++;
+ argc--;
+ }
+ break;
+ case TK_ARGV_FUNC: {
+ typedef int (ArgvFunc)_ANSI_ARGS_((char *, char *, char *));
+ ArgvFunc *handlerProc;
+
+ handlerProc = (ArgvFunc *) infoPtr->src;
+ if ((*handlerProc)(infoPtr->dst, infoPtr->key,
+ argv[srcIndex])) {
+ srcIndex += 1;
+ argc -= 1;
+ }
+ break;
+ }
+ case TK_ARGV_GENFUNC: {
+ typedef int (ArgvGenFunc)_ANSI_ARGS_((char *, Tcl_Interp *,
+ char *, int, char **));
+ ArgvGenFunc *handlerProc;
+
+ handlerProc = (ArgvGenFunc *) infoPtr->src;
+ argc = (*handlerProc)(infoPtr->dst, interp, infoPtr->key,
+ argc, argv+srcIndex);
+ if (argc < 0) {
+ return TCL_ERROR;
+ }
+ break;
+ }
+ case TK_ARGV_HELP:
+ PrintUsage (interp, argTable, flags);
+ return TCL_ERROR;
+ case TK_ARGV_CONST_OPTION:
+ Tk_AddOption(tkwin, infoPtr->dst, infoPtr->src,
+ TK_INTERACTIVE_PRIO);
+ break;
+ case TK_ARGV_OPTION_VALUE:
+ if (argc < 1) {
+ goto missingArg;
+ }
+ Tk_AddOption(tkwin, infoPtr->dst, argv[srcIndex],
+ TK_INTERACTIVE_PRIO);
+ srcIndex++;
+ argc--;
+ break;
+ case TK_ARGV_OPTION_NAME_VALUE:
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "\"", curArg,
+ "\" option requires two following arguments",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tk_AddOption(tkwin, argv[srcIndex], argv[srcIndex+1],
+ TK_INTERACTIVE_PRIO);
+ srcIndex += 2;
+ argc -= 2;
+ break;
+ case TK_ARGV_VERSION:
+ Tcl_AppendResult(interp, "Tk version ", TK_VERSION, "-foundry-971110",
+ (char *) NULL);
+ return TCL_ERROR;
+ 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.
+ */
+
+ argsDone:
+ while (argc) {
+ argv[dstIndex] = argv[srcIndex];
+ srcIndex++;
+ dstIndex++;
+ argc--;
+ }
+ argv[dstIndex] = (char *) NULL;
+ *argcPtr = dstIndex;
+ return TCL_OK;
+
+ missingArg:
+ Tcl_AppendResult(interp, "\"", curArg,
+ "\" option requires an additional argument", (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PrintUsage(interp, argTable, flags)
+ Tcl_Interp *interp; /* Place information in this interp's
+ * result area. */
+ Tk_ArgvInfo *argTable; /* Array of command-specific argument
+ * descriptions. */
+ int flags; /* If the TK_ARGV_NO_DEFAULTS bit is set
+ * 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;
+ for (i = 0; i < 2; i++) {
+ for (infoPtr = i ? defaultTable : argTable;
+ infoPtr->type != TK_ARGV_END; infoPtr++) {
+ int length;
+ if (infoPtr->key == NULL) {
+ continue;
+ }
+ length = strlen(infoPtr->key);
+ if (length > width) {
+ width = length;
+ }
+ }
+ }
+
+ Tcl_AppendResult(interp, "Command-specific options:", (char *) NULL);
+ for (i = 0; ; i++) {
+ for (infoPtr = i ? defaultTable : argTable;
+ infoPtr->type != TK_ARGV_END; infoPtr++) {
+ if ((infoPtr->type == TK_ARGV_HELP) && (infoPtr->key == NULL)) {
+ Tcl_AppendResult(interp, "\n", infoPtr->help, (char *) NULL);
+ continue;
+ }
+ Tcl_AppendResult(interp, "\n ", infoPtr->key, ":", (char *) NULL);
+ numSpaces = width + 1 - strlen(infoPtr->key);
+ while (numSpaces > 0) {
+ if (numSpaces >= NUM_SPACES) {
+ Tcl_AppendResult(interp, spaces, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, spaces+NUM_SPACES-numSpaces,
+ (char *) NULL);
+ }
+ numSpaces -= NUM_SPACES;
+ }
+ Tcl_AppendResult(interp, infoPtr->help, (char *) NULL);
+ switch (infoPtr->type) {
+ case TK_ARGV_INT: {
+ sprintf(tmp, "%d", *((int *) infoPtr->dst));
+ Tcl_AppendResult(interp, "\n\t\tDefault value: ",
+ tmp, (char *) NULL);
+ break;
+ }
+ case TK_ARGV_FLOAT: {
+ sprintf(tmp, "%g", *((double *) infoPtr->dst));
+ Tcl_AppendResult(interp, "\n\t\tDefault value: ",
+ tmp, (char *) NULL);
+ break;
+ }
+ case TK_ARGV_STRING: {
+ char *string;
+
+ string = *((char **) infoPtr->dst);
+ if (string != NULL) {
+ Tcl_AppendResult(interp, "\n\t\tDefault value: \"",
+ string, "\"", (char *) NULL);
+ }
+ break;
+ }
+ default: {
+ break;
+ }
+ }
+ }
+
+ if ((flags & TK_ARGV_NO_DEFAULTS) || (i > 0)) {
+ break;
+ }
+ Tcl_AppendResult(interp, "\nGeneric options for all commands:",
+ (char *) NULL);
+ }
+}
diff --git a/tk/generic/tkAtom.c b/tk/generic/tkAtom.c
new file mode 100644
index 00000000000..7bd2a1e80ff
--- /dev/null
+++ b/tk/generic/tkAtom.c
@@ -0,0 +1,217 @@
+/*
+ * tkAtom.c --
+ *
+ * This file manages a cache of X Atoms in order to avoid
+ * interactions with the X server. It's much like the Xmu
+ * routines, except it has a cleaner interface (caller
+ * doesn't have to provide permanent storage for atom names,
+ * for example).
+ *
+ * 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$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The following are a list of the predefined atom strings.
+ * They should match those found in xatom.h
+ */
+
+static char * atomNameArray[] = {
+ "PRIMARY", "SECONDARY", "ARC",
+ "ATOM", "BITMAP", "CARDINAL",
+ "COLORMAP", "CURSOR", "CUT_BUFFER0",
+ "CUT_BUFFER1", "CUT_BUFFER2", "CUT_BUFFER3",
+ "CUT_BUFFER4", "CUT_BUFFER5", "CUT_BUFFER6",
+ "CUT_BUFFER7", "DRAWABLE", "FONT",
+ "INTEGER", "PIXMAP", "POINT",
+ "RECTANGLE", "RESOURCE_MANAGER", "RGB_COLOR_MAP",
+ "RGB_BEST_MAP", "RGB_BLUE_MAP", "RGB_DEFAULT_MAP",
+ "RGB_GRAY_MAP", "RGB_GREEN_MAP", "RGB_RED_MAP",
+ "STRING", "VISUALID", "WINDOW",
+ "WM_COMMAND", "WM_HINTS", "WM_CLIENT_MACHINE",
+ "WM_ICON_NAME", "WM_ICON_SIZE", "WM_NAME",
+ "WM_NORMAL_HINTS", "WM_SIZE_HINTS", "WM_ZOOM_HINTS",
+ "MIN_SPACE", "NORM_SPACE", "MAX_SPACE",
+ "END_SPACE", "SUPERSCRIPT_X", "SUPERSCRIPT_Y",
+ "SUBSCRIPT_X", "SUBSCRIPT_Y", "UNDERLINE_POSITION",
+ "UNDERLINE_THICKNESS", "STRIKEOUT_ASCENT", "STRIKEOUT_DESCENT",
+ "ITALIC_ANGLE", "X_HEIGHT", "QUAD_WIDTH",
+ "WEIGHT", "POINT_SIZE", "RESOLUTION",
+ "COPYRIGHT", "NOTICE", "FONT_NAME",
+ "FAMILY_NAME", "FULL_NAME", "CAP_HEIGHT",
+ "WM_CLASS", "WM_TRANSIENT_FOR",
+ (char *) NULL
+};
+
+/*
+ * Forward references to procedures defined in this file:
+ */
+
+static void AtomInit _ANSI_ARGS_((TkDisplay *dispPtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_InternAtom --
+ *
+ * Given a string, produce the equivalent X atom. This
+ * procedure is equivalent to XInternAtom, except that it
+ * keeps a local cache of atoms. Once a name is known,
+ * the server need not be contacted again for that name.
+ *
+ * Results:
+ * The return value is the Atom corresponding to name.
+ *
+ * Side effects:
+ * A new entry may be added to the local atom cache.
+ *
+ *--------------------------------------------------------------
+ */
+
+Atom
+Tk_InternAtom(tkwin, name)
+ Tk_Window tkwin; /* Window token; map name to atom
+ * for this window's display. */
+ char *name; /* Name to turn into atom. */
+{
+ register TkDisplay *dispPtr;
+ register Tcl_HashEntry *hPtr;
+ int new;
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if (!dispPtr->atomInit) {
+ AtomInit(dispPtr);
+ }
+
+ hPtr = Tcl_CreateHashEntry(&dispPtr->nameTable, name, &new);
+ if (new) {
+ Tcl_HashEntry *hPtr2;
+ Atom atom;
+
+ atom = XInternAtom(dispPtr->display, name, False);
+ Tcl_SetHashValue(hPtr, atom);
+ hPtr2 = Tcl_CreateHashEntry(&dispPtr->atomTable, (char *) atom,
+ &new);
+ Tcl_SetHashValue(hPtr2, Tcl_GetHashKey(&dispPtr->nameTable, hPtr));
+ }
+ return (Atom) Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetAtomName --
+ *
+ * This procedure is equivalent to XGetAtomName except that
+ * it uses the local atom cache to avoid contacting the
+ * server.
+ *
+ * Results:
+ * The return value is a character string corresponding to
+ * the atom given by "atom". This string's storage space
+ * is static: it need not be freed by the caller, and should
+ * not be modified by the caller. If "atom" doesn't exist
+ * on tkwin's display, then the string "?bad atom?" is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_GetAtomName(tkwin, atom)
+ Tk_Window tkwin; /* Window token; map atom to name
+ * relative to this window's
+ * display. */
+ Atom atom; /* Atom whose name is wanted. */
+{
+ register TkDisplay *dispPtr;
+ register Tcl_HashEntry *hPtr;
+
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ if (!dispPtr->atomInit) {
+ AtomInit(dispPtr);
+ }
+
+ hPtr = Tcl_FindHashEntry(&dispPtr->atomTable, (char *) atom);
+ if (hPtr == NULL) {
+ char *name;
+ Tk_ErrorHandler handler;
+ int new, mustFree;
+
+ handler= Tk_CreateErrorHandler(dispPtr->display, BadAtom,
+ -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ name = XGetAtomName(dispPtr->display, atom);
+ mustFree = 1;
+ if (name == NULL) {
+ name = "?bad atom?";
+ mustFree = 0;
+ }
+ Tk_DeleteErrorHandler(handler);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->nameTable, (char *) name,
+ &new);
+ Tcl_SetHashValue(hPtr, atom);
+ if (mustFree) {
+ XFree(name);
+ }
+ name = Tcl_GetHashKey(&dispPtr->nameTable, hPtr);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->atomTable, (char *) atom,
+ &new);
+ Tcl_SetHashValue(hPtr, name);
+ }
+ return (char *) Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AtomInit --
+ *
+ * Initialize atom-related information for a display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Tables get initialized, etc. etc..
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+AtomInit(dispPtr)
+ register TkDisplay *dispPtr; /* Display to initialize. */
+{
+ Tcl_HashEntry *hPtr;
+ Atom atom;
+
+ dispPtr->atomInit = 1;
+ Tcl_InitHashTable(&dispPtr->nameTable, TCL_STRING_KEYS);
+ Tcl_InitHashTable(&dispPtr->atomTable, TCL_ONE_WORD_KEYS);
+
+ for (atom = 1; atom <= XA_LAST_PREDEFINED; atom++) {
+ hPtr = Tcl_FindHashEntry(&dispPtr->atomTable, (char *) atom);
+ if (hPtr == NULL) {
+ char *name;
+ int new;
+
+ name = atomNameArray[atom - 1];
+ hPtr = Tcl_CreateHashEntry(&dispPtr->nameTable, (char *) name,
+ &new);
+ Tcl_SetHashValue(hPtr, atom);
+ name = Tcl_GetHashKey(&dispPtr->nameTable, hPtr);
+ hPtr = Tcl_CreateHashEntry(&dispPtr->atomTable, (char *) atom,
+ &new);
+ Tcl_SetHashValue(hPtr, name);
+ }
+ }
+}
diff --git a/tk/generic/tkBind.c b/tk/generic/tkBind.c
new file mode 100644
index 00000000000..38a39b7e5b1
--- /dev/null
+++ b/tk/generic/tkBind.c
@@ -0,0 +1,4552 @@
+/*
+ * 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.
+ * 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$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * File structure:
+ *
+ * Structure definitions and static variables.
+ *
+ * Init/Free this package.
+ *
+ * Tcl "bind" command (actually located in tkCmds.c).
+ * "bind" command implementation.
+ * "bind" implementation helpers.
+ *
+ * Tcl "event" command.
+ * "event" command implementation.
+ * "event" implementation helpers.
+ *
+ * Package-specific common helpers.
+ *
+ * Non-package-specific helpers.
+ */
+
+
+/*
+ * The following union is used to hold the detail information from an
+ * XEvent (including Tk's XVirtualEvent extension).
+ */
+typedef union {
+ KeySym keySym; /* KeySym that corresponds to xkey.keycode. */
+ int button; /* Button that was pressed (xbutton.button). */
+ Tk_Uid name; /* Tk_Uid of virtual event. */
+ ClientData clientData; /* Used when type of Detail is unknown, and to
+ * ensure that all bytes of Detail are initialized
+ * when this structure is used in a hash key. */
+} Detail;
+
+/*
+ * The structure below represents a binding table. A binding table
+ * represents a domain in which event bindings may occur. It includes
+ * a space of objects relative to which events occur (usually windows,
+ * but not always), a history of recent events in the domain, and
+ * a set of mappings that associate particular Tcl commands with sequences
+ * of events in the domain. Multiple binding tables may exist at once,
+ * either because there are multiple applications open, or because there
+ * are multiple domains within an application with separate event
+ * bindings for each (for example, each canvas widget has a separate
+ * binding table for associating events with the items in the canvas).
+ *
+ * Note: it is probably a bad idea to reduce EVENT_BUFFER_SIZE much
+ * below 30. To see this, consider a triple mouse button click while
+ * the Shift key is down (and auto-repeating). There may be as many
+ * as 3 auto-repeat events after each mouse button press or release
+ * (see the first large comment block within Tk_BindEvent for more on
+ * this), for a total of 20 events to cover the three button presses
+ * and two intervening releases. If you reduce EVENT_BUFFER_SIZE too
+ * much, shift multi-clicks will be lost.
+ *
+ */
+
+#define EVENT_BUFFER_SIZE 30
+typedef struct BindingTable {
+ XEvent eventRing[EVENT_BUFFER_SIZE];/* Circular queue of recent events
+ * (higher indices are for more recent
+ * events). */
+ Detail detailRing[EVENT_BUFFER_SIZE];/* "Detail" information (keySym,
+ * button, Tk_Uid, or 0) for each
+ * entry in eventRing. */
+ int curEvent; /* Index in eventRing of most recent
+ * event. Newer events have higher
+ * indices. */
+ Tcl_HashTable patternTable; /* Used to map from an event to a
+ * list of patterns that may match that
+ * event. Keys are PatternTableKey
+ * structs, values are (PatSeq *). */
+ Tcl_HashTable objectTable; /* Used to map from an object to a
+ * list of patterns associated with
+ * that object. Keys are ClientData,
+ * values are (PatSeq *). */
+ Tcl_Interp *interp; /* Interpreter in which commands are
+ * executed. */
+} BindingTable;
+
+/*
+ * The following structure represents virtual event table. A virtual event
+ * table provides a way to map from platform-specific physical events such
+ * as button clicks or key presses to virtual events such as <<Paste>>,
+ * <<Close>>, or <<ScrollWindow>>.
+ *
+ * A virtual event is usually never part of the event stream, but instead is
+ * synthesized inline by matching low-level events. However, a virtual
+ * event may be generated by platform-specific code or by Tcl scripts. In
+ * that case, no lookup of the virtual event will need to be done using
+ * this table, because the virtual event is actually in the event stream.
+ */
+
+typedef struct VirtualEventTable {
+ Tcl_HashTable patternTable; /* Used to map from a physical event to
+ * a list of patterns that may match that
+ * event. Keys are PatternTableKey
+ * structs, values are (PatSeq *). */
+ Tcl_HashTable nameTable; /* Used to map a virtual event name to
+ * the array of physical events that can
+ * trigger it. Keys are the Tk_Uid names
+ * of the virtual events, values are
+ * PhysicalsOwned structs. */
+} VirtualEventTable;
+
+/*
+ * The following structure is used as a key in a patternTable for both
+ * binding tables and a virtual event tables.
+ *
+ * In a binding table, the object field corresponds to the binding tag
+ * for the widget whose bindings are being accessed.
+ *
+ * In a virtual event table, the object field is always NULL. Virtual
+ * events are a global definiton and are not tied to a particular
+ * binding tag.
+ *
+ * The same key is used for both types of pattern tables so that the
+ * helper functions that traverse and match patterns will work for both
+ * binding tables and virtual event tables.
+ */
+typedef struct PatternTableKey {
+ ClientData object; /* For binding table, identifies the binding
+ * tag of the object (or class of objects)
+ * relative to which the event occurred.
+ * For virtual event table, always NULL. */
+ int type; /* Type of event (from X). */
+ Detail detail; /* Additional information, such as keysym,
+ * button, Tk_Uid, or 0 if nothing
+ * additional. */
+} PatternTableKey;
+
+/*
+ * The following structure defines a pattern, which is matched against X
+ * events as part of the process of converting X events into Tcl commands.
+ */
+
+typedef struct Pattern {
+ int eventType; /* Type of X event, e.g. ButtonPress. */
+ int needMods; /* Mask of modifiers that must be
+ * present (0 means no modifiers are
+ * required). */
+ Detail detail; /* Additional information that must
+ * match event. Normally this is 0,
+ * meaning no additional information
+ * must match. For KeyPress and
+ * KeyRelease events, a keySym may
+ * be specified to select a
+ * particular keystroke (0 means any
+ * keystrokes). For button events,
+ * specifies a particular button (0
+ * means any buttons are OK). For virtual
+ * events, specifies the Tk_Uid of the
+ * virtual event name (never 0). */
+} Pattern;
+
+/*
+ * The following structure defines a pattern sequence, which consists of one
+ * or more patterns. In order to trigger, a pattern sequence must match
+ * the most recent X events (first pattern to most recent event, next
+ * pattern to next event, and so on). It is used as the hash value in a
+ * patternTable for both binding tables and virtual event tables.
+ *
+ * In a binding table, it is the sequence of physical events that make up
+ * a binding for an object.
+ *
+ * In a virtual event table, it is the sequence of physical events that
+ * define a virtual event.
+ *
+ * The same structure is used for both types of pattern tables so that the
+ * helper functions that traverse and match patterns will work for both
+ * binding tables and virtual event tables.
+ */
+
+typedef struct PatSeq {
+ int numPats; /* Number of patterns in sequence (usually
+ * 1). */
+ TkBindEvalProc *eventProc; /* The procedure that will be invoked on
+ * the clientData when this pattern sequence
+ * matches. */
+ TkBindFreeProc *freeProc; /* The procedure that will be invoked to
+ * release the clientData when this pattern
+ * sequence is freed. */
+ ClientData clientData; /* Arbitray data passed to eventProc and
+ * freeProc when sequence matches. */
+ int flags; /* Miscellaneous flag values; see below for
+ * definitions. */
+ int refCount; /* Number of times that this binding is in
+ * the midst of executing. If greater than 1,
+ * then a recursive invocation is happening.
+ * Only when this is zero can the binding
+ * actually be freed. */
+ struct PatSeq *nextSeqPtr; /* Next in list of all pattern sequences
+ * that have the same initial pattern. NULL
+ * means end of list. */
+ Tcl_HashEntry *hPtr; /* Pointer to hash table entry for the
+ * initial pattern. This is the head of the
+ * list of which nextSeqPtr forms a part. */
+ struct VirtualOwners *voPtr;/* In a binding table, always NULL. In a
+ * virtual event table, identifies the array
+ * of virtual events that can be triggered by
+ * this event. */
+ struct PatSeq *nextObjPtr; /* In a binding table, next in list of all
+ * pattern sequences for the same object (NULL
+ * for end of list). Needed to implement
+ * Tk_DeleteAllBindings. In a virtual event
+ * table, always NULL. */
+ Pattern pats[1]; /* Array of "numPats" patterns. Only one
+ * element is declared here but in actuality
+ * enough space will be allocated for "numPats"
+ * patterns. To match, pats[0] must match
+ * event n, pats[1] must match event n-1, etc.
+ */
+} PatSeq;
+
+/*
+ * Flag values for PatSeq structures:
+ *
+ * PAT_NEARBY 1 means that all of the events matching
+ * this sequence must occur with nearby X
+ * and Y mouse coordinates and close in time.
+ * This is typically used to restrict multiple
+ * button presses.
+ * MARKED_DELETED 1 means that this binding has been marked as deleted
+ * and removed from the binding table, but its memory
+ * could not be released because it was already queued for
+ * execution. When the binding is actually about to be
+ * executed, this flag will be checked and the binding
+ * skipped if set.
+ */
+
+#define PAT_NEARBY 0x1
+#define MARKED_DELETED 0x2
+
+/*
+ * Constants that define how close together two events must be
+ * in milliseconds or pixels to meet the PAT_NEARBY constraint:
+ */
+
+#define NEARBY_PIXELS 5
+#define NEARBY_MS 500
+
+
+/*
+ * The following structure keeps track of all the virtual events that are
+ * associated with a particular physical event. It is pointed to by the
+ * voPtr field in a PatSeq in the patternTable of a virtual event table.
+ */
+
+typedef struct VirtualOwners {
+ int numOwners; /* Number of virtual events to trigger. */
+ Tcl_HashEntry *owners[1]; /* Array of pointers to entries in
+ * nameTable. Enough space will
+ * actually be allocated for numOwners
+ * hash entries. */
+} VirtualOwners;
+
+/*
+ * The following structure is used in the nameTable of a virtual event
+ * table to associate a virtual event with all the physical events that can
+ * trigger it.
+ */
+typedef struct PhysicalsOwned {
+ int numOwned; /* Number of physical events owned. */
+ PatSeq *patSeqs[1]; /* Array of pointers to physical event
+ * patterns. Enough space will actually
+ * be allocated to hold numOwned. */
+} PhysicalsOwned;
+
+/*
+ * One of the following structures exists for each interpreter. This
+ * structure keeps track of the current display and screen in the
+ * interpreter, so that a script can be invoked whenever the display/screen
+ * changes (the script does things like point tkPriv at a display-specific
+ * structure).
+ */
+
+typedef struct {
+ TkDisplay *curDispPtr; /* Display for last binding command invoked
+ * in this application. */
+ int curScreenIndex; /* Index of screen for last binding command. */
+ int bindingDepth; /* Number of active instances of Tk_BindEvent
+ * in this application. */
+} ScreenInfo;
+
+/*
+ * The following structure is used to keep track of all the C bindings that
+ * are awaiting invocation and whether the window they refer to has been
+ * destroyed. If the window is destroyed, then all pending callbacks for
+ * that window will be cancelled. The Tcl bindings will still all be
+ * invoked, however.
+ */
+
+typedef struct PendingBinding {
+ struct PendingBinding *nextPtr;
+ /* Next in chain of pending bindings, in
+ * case a recursive binding evaluation is in
+ * progress. */
+ Tk_Window tkwin; /* The window that the following bindings
+ * depend upon. */
+ int deleted; /* Set to non-zero by window cleanup code
+ * if tkwin is deleted. */
+ PatSeq *matchArray[5]; /* Array of pending C bindings. The actual
+ * size of this depends on how many C bindings
+ * matched the event passed to Tk_BindEvent.
+ * THIS FIELD MUST BE THE LAST IN THE
+ * STRUCTURE. */
+} PendingBinding;
+
+/*
+ * The following structure keeps track of all the information local to
+ * the binding package on a per interpreter basis.
+ */
+
+typedef struct BindInfo {
+ VirtualEventTable virtualEventTable;
+ /* The virtual events that exist in this
+ * 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
+ * fast so this stuff isn't needed. The #define REDO_KEYSYM_LOOKUP
+ * is normally undefined, so that XStringToKeysym gets used. It
+ * can be set in the Makefile to enable the use of the hash table
+ * below.
+ */
+
+#ifdef REDO_KEYSYM_LOOKUP
+typedef struct {
+ char *name; /* Name of keysym. */
+ KeySym value; /* Numeric identifier for keysym. */
+} KeySymInfo;
+static KeySymInfo keyArray[] = {
+#ifndef lint
+#include "ks_names.h"
+#endif
+ {(char *) NULL, 0}
+};
+static Tcl_HashTable keySymTable; /* keyArray hashed by keysym value. */
+static Tcl_HashTable nameTable; /* keyArray hashed by keysym name. */
+#endif /* REDO_KEYSYM_LOOKUP */
+
+/*
+ * 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.
+ */
+
+typedef struct {
+ char *name; /* Name of modifier. */
+ int mask; /* Button/modifier mask value, * such as Button1Mask. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+} ModInfo;
+
+/*
+ * Flags for ModInfo structures:
+ *
+ * DOUBLE - Non-zero means duplicate this event,
+ * e.g. for double-clicks.
+ * TRIPLE - Non-zero means triplicate this event,
+ * e.g. for triple-clicks.
+ */
+
+#define DOUBLE 1
+#define TRIPLE 2
+
+/*
+ * The following special modifier mask bits are defined, to indicate
+ * logical modifiers such as Meta and Alt that may float among the
+ * actual modifier bits.
+ */
+
+#define META_MASK (AnyModifier<<1)
+#define ALT_MASK (AnyModifier<<2)
+
+static ModInfo modArray[] = {
+ {"Control", ControlMask, 0},
+ {"Shift", ShiftMask, 0},
+ {"Lock", LockMask, 0},
+ {"Meta", META_MASK, 0},
+ {"M", META_MASK, 0},
+ {"Alt", ALT_MASK, 0},
+ {"B1", Button1Mask, 0},
+ {"Button1", Button1Mask, 0},
+ {"B2", Button2Mask, 0},
+ {"Button2", Button2Mask, 0},
+ {"B3", Button3Mask, 0},
+ {"Button3", Button3Mask, 0},
+ {"B4", Button4Mask, 0},
+ {"Button4", Button4Mask, 0},
+ {"B5", Button5Mask, 0},
+ {"Button5", Button5Mask, 0},
+ {"Mod1", Mod1Mask, 0},
+ {"M1", Mod1Mask, 0},
+ {"Command", Mod1Mask, 0},
+ {"Mod2", Mod2Mask, 0},
+ {"M2", Mod2Mask, 0},
+ {"Option", Mod2Mask, 0},
+ {"Mod3", Mod3Mask, 0},
+ {"M3", Mod3Mask, 0},
+ {"Mod4", Mod4Mask, 0},
+ {"M4", Mod4Mask, 0},
+ {"Mod5", Mod5Mask, 0},
+ {"M5", Mod5Mask, 0},
+ {"Double", 0, DOUBLE},
+ {"Triple", 0, TRIPLE},
+ {"Any", 0, 0}, /* Ignored: historical relic. */
+ {NULL, 0, 0}
+};
+static Tcl_HashTable modTable;
+
+/*
+ * This module also keeps a hash table mapping from event names
+ * to information about those events. The structure, an array
+ * to use to initialize the hash table, and the hash table are
+ * all defined below.
+ */
+
+typedef struct {
+ char *name; /* Name of event. */
+ int type; /* Event type for X, such as
+ * ButtonPress. */
+ int eventMask; /* Mask bits (for XSelectInput)
+ * for this event type. */
+} EventInfo;
+
+/*
+ * Note: some of the masks below are an OR-ed combination of
+ * several masks. This is necessary because X doesn't report
+ * up events unless you also ask for down events. Also, X
+ * doesn't report button state in motion events unless you've
+ * asked about button events.
+ */
+
+static EventInfo eventArray[] = {
+ {"Key", KeyPress, KeyPressMask},
+ {"KeyPress", KeyPress, KeyPressMask},
+ {"KeyRelease", KeyRelease, KeyPressMask|KeyReleaseMask},
+ {"Button", ButtonPress, ButtonPressMask},
+ {"ButtonPress", ButtonPress, ButtonPressMask},
+ {"ButtonRelease", ButtonRelease,
+ ButtonPressMask|ButtonReleaseMask},
+ {"Motion", MotionNotify,
+ ButtonPressMask|PointerMotionMask},
+ {"Enter", EnterNotify, EnterWindowMask},
+ {"Leave", LeaveNotify, LeaveWindowMask},
+ {"FocusIn", FocusIn, FocusChangeMask},
+ {"FocusOut", FocusOut, FocusChangeMask},
+ {"Expose", Expose, ExposureMask},
+ {"Visibility", VisibilityNotify, VisibilityChangeMask},
+ {"Destroy", DestroyNotify, StructureNotifyMask},
+ {"Unmap", UnmapNotify, StructureNotifyMask},
+ {"Map", MapNotify, StructureNotifyMask},
+ {"Reparent", ReparentNotify, StructureNotifyMask},
+ {"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
+ * fields (e.g. "state") appear at different places in different
+ * types of events. The classification masks can be used to figure
+ * out quickly where to extract information from events.
+ */
+
+#define KEY 0x1
+#define BUTTON 0x2
+#define MOTION 0x4
+#define CROSSING 0x8
+#define FOCUS 0x10
+#define EXPOSE 0x20
+#define VISIBILITY 0x40
+#define CREATE 0x80
+#define DESTROY 0x100
+#define UNMAP 0x200
+#define MAP 0x400
+#define REPARENT 0x800
+#define CONFIG 0x1000
+#define GRAVITY 0x2000
+#define CIRC 0x4000
+#define PROP 0x8000
+#define COLORMAP 0x10000
+#define VIRTUAL 0x20000
+#define ACTIVATE 0x40000
+
+#define KEY_BUTTON_MOTION_VIRTUAL (KEY|BUTTON|MOTION|VIRTUAL)
+
+static int flagArray[TK_LASTEVENT] = {
+ /* Not used */ 0,
+ /* Not used */ 0,
+ /* KeyPress */ KEY,
+ /* KeyRelease */ KEY,
+ /* ButtonPress */ BUTTON,
+ /* ButtonRelease */ BUTTON,
+ /* MotionNotify */ MOTION,
+ /* EnterNotify */ CROSSING,
+ /* LeaveNotify */ CROSSING,
+ /* FocusIn */ FOCUS,
+ /* FocusOut */ FOCUS,
+ /* KeymapNotify */ 0,
+ /* Expose */ EXPOSE,
+ /* GraphicsExpose */ EXPOSE,
+ /* NoExpose */ 0,
+ /* VisibilityNotify */ VISIBILITY,
+ /* CreateNotify */ CREATE,
+ /* DestroyNotify */ DESTROY,
+ /* UnmapNotify */ UNMAP,
+ /* MapNotify */ MAP,
+ /* MapRequest */ 0,
+ /* ReparentNotify */ REPARENT,
+ /* ConfigureNotify */ CONFIG,
+ /* ConfigureRequest */ 0,
+ /* GravityNotify */ GRAVITY,
+ /* ResizeRequest */ 0,
+ /* CirculateNotify */ CIRC,
+ /* CirculateRequest */ 0,
+ /* PropertyNotify */ PROP,
+ /* SelectionClear */ 0,
+ /* SelectionRequest */ 0,
+ /* SelectionNotify */ 0,
+ /* ColormapNotify */ COLORMAP,
+ /* ClientMessage */ 0,
+ /* MappingNotify */ 0,
+ /* VirtualEvent */ VIRTUAL,
+ /* Activate */ ACTIVATE,
+ /* Deactivate */ ACTIVATE,
+ /* MouseWheel */ KEY
+};
+
+/*
+ * 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.
+ */
+
+static TkStateMap notifyMode[] = {
+ {NotifyNormal, "NotifyNormal"},
+ {NotifyGrab, "NotifyGrab"},
+ {NotifyUngrab, "NotifyUngrab"},
+ {NotifyWhileGrabbed, "NotifyWhileGrabbed"},
+ {-1, NULL}
+};
+
+static TkStateMap notifyDetail[] = {
+ {NotifyAncestor, "NotifyAncestor"},
+ {NotifyVirtual, "NotifyVirtual"},
+ {NotifyInferior, "NotifyInferior"},
+ {NotifyNonlinear, "NotifyNonlinear"},
+ {NotifyNonlinearVirtual, "NotifyNonlinearVirtual"},
+ {NotifyPointer, "NotifyPointer"},
+ {NotifyPointerRoot, "NotifyPointerRoot"},
+ {NotifyDetailNone, "NotifyDetailNone"},
+ {-1, NULL}
+};
+
+static TkStateMap circPlace[] = {
+ {PlaceOnTop, "PlaceOnTop"},
+ {PlaceOnBottom, "PlaceOnBottom"},
+ {-1, NULL}
+};
+
+static TkStateMap visNotify[] = {
+ {VisibilityUnobscured, "VisibilityUnobscured"},
+ {VisibilityPartiallyObscured, "VisibilityPartiallyObscured"},
+ {VisibilityFullyObscured, "VisibilityFullyObscured"},
+ {-1, NULL}
+};
+
+/*
+ * Prototypes for local procedures defined in this file:
+ */
+
+static void ChangeScreen _ANSI_ARGS_((Tcl_Interp *interp,
+ char *dispName, int screenIndex));
+static int CreateVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
+ VirtualEventTable *vetPtr, char *virtString,
+ char *eventString));
+static int DeleteVirtualEvent _ANSI_ARGS_((Tcl_Interp *interp,
+ VirtualEventTable *vetPtr, char *virtString,
+ char *eventString));
+static void DeleteVirtualEventTable _ANSI_ARGS_((
+ VirtualEventTable *vetPtr));
+static void ExpandPercents _ANSI_ARGS_((TkWindow *winPtr,
+ char *before, XEvent *eventPtr, KeySym keySym,
+ Tcl_DString *dsPtr));
+static void FreeTclBinding _ANSI_ARGS_((ClientData clientData));
+static PatSeq * FindSequence _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_HashTable *patternTablePtr, ClientData object,
+ char *eventString, int create, int allowVirtual,
+ unsigned long *maskPtr));
+static void GetAllVirtualEvents _ANSI_ARGS_((Tcl_Interp *interp,
+ VirtualEventTable *vetPtr));
+static char * GetField _ANSI_ARGS_((char *p, char *copy, int size));
+static KeySym GetKeySym _ANSI_ARGS_((TkDisplay *dispPtr,
+ XEvent *eventPtr));
+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.
+ */
+
+#define EvalTclBinding ((TkBindEvalProc *) 1)
+
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkBindInit --
+ *
+ * This procedure is called when an application is created. It
+ * initializes all the structures used by bindings and virtual
+ * events. It must be called before any other functions in this
+ * file are called.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkBindInit(mainPtr)
+ TkMainInfo *mainPtr; /* The newly created application. */
+{
+ BindInfo *bindInfoPtr;
+
+ if (sizeof(XEvent) < sizeof(XVirtualEvent)) {
+ panic("TkBindInit: virtual events can't be supported");
+ }
+
+ /*
+ * 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);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkBindFree --
+ *
+ * This procedure is called when an application is deleted. It
+ * deletes all the structures used by bindings and virtual events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkBindFree(mainPtr)
+ TkMainInfo *mainPtr; /* The newly created application. */
+{
+ BindInfo *bindInfoPtr;
+
+ Tk_DeleteBindingTable(mainPtr->bindingTable);
+ mainPtr->bindingTable = NULL;
+
+ bindInfoPtr = (BindInfo *) mainPtr->bindInfo;
+ DeleteVirtualEventTable(&bindInfoPtr->virtualEventTable);
+ mainPtr->bindInfo = NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateBindingTable --
+ *
+ * Set up a new domain in which event bindings may be created.
+ *
+ * Results:
+ * The return value is a token for the new table, which must
+ * be passed to procedures like Tk_CreatBinding.
+ *
+ * Side effects:
+ * Memory is allocated for the new table.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_BindingTable
+Tk_CreateBindingTable(interp)
+ Tcl_Interp *interp; /* Interpreter to associate with the binding
+ * table: commands are executed in this
+ * interpreter. */
+{
+ BindingTable *bindPtr;
+ int i;
+
+ /*
+ * Create and initialize a new binding table.
+ */
+
+ bindPtr = (BindingTable *) ckalloc(sizeof(BindingTable));
+ for (i = 0; i < EVENT_BUFFER_SIZE; i++) {
+ bindPtr->eventRing[i].type = -1;
+ }
+ bindPtr->curEvent = 0;
+ Tcl_InitHashTable(&bindPtr->patternTable,
+ sizeof(PatternTableKey)/sizeof(int));
+ Tcl_InitHashTable(&bindPtr->objectTable, TCL_ONE_WORD_KEYS);
+ bindPtr->interp = interp;
+ return (Tk_BindingTable) bindPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteBindingTable --
+ *
+ * Destroy a binding table and free up all its memory.
+ * The caller should not use bindingTable again after
+ * this procedure returns.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteBindingTable(bindingTable)
+ Tk_BindingTable bindingTable; /* Token for the binding table to
+ * destroy. */
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr, *nextPtr;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+
+ /*
+ * Find and delete all of the patterns associated with the binding
+ * table.
+ */
+
+ for (hPtr = Tcl_FirstHashEntry(&bindPtr->patternTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ psPtr != NULL; psPtr = nextPtr) {
+ nextPtr = psPtr->nextSeqPtr;
+ psPtr->flags |= MARKED_DELETED;
+ if (psPtr->refCount == 0) {
+ if (psPtr->freeProc != NULL) {
+ (*psPtr->freeProc)(psPtr->clientData);
+ }
+ ckfree((char *) psPtr);
+ }
+ }
+ }
+
+ /*
+ * Clean up the rest of the information associated with the
+ * binding table.
+ */
+
+ Tcl_DeleteHashTable(&bindPtr->patternTable);
+ Tcl_DeleteHashTable(&bindPtr->objectTable);
+ ckfree((char *) bindPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateBinding --
+ *
+ * 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
+ * replaced.
+ * The new binding may cause future calls to Tk_BindEvent to
+ * behave differently than they did previously.
+ *
+ *--------------------------------------------------------------
+ */
+
+unsigned long
+Tk_CreateBinding(interp, bindingTable, object, eventString, command, append)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_BindingTable bindingTable;
+ /* Table in which to create binding. */
+ ClientData object; /* Token for object with which binding is
+ * associated. */
+ char *eventString; /* String describing event sequence that
+ * triggers binding. */
+ char *command; /* Contains Tcl command to execute when
+ * binding triggers. */
+ int append; /* 0 means replace any existing binding for
+ * eventString; 1 means append to that
+ * binding. If the existing binding is for a
+ * callback function and not a Tcl command
+ * string, the existing binding will always be
+ * replaced. */
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr;
+ unsigned long eventMask;
+ char *new, *old;
+
+ psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+ 1, 1, &eventMask);
+ if (psPtr == NULL) {
+ return 0;
+ }
+ if (psPtr->eventProc == NULL) {
+ int new;
+ Tcl_HashEntry *hPtr;
+
+ /*
+ * This pattern sequence was just created.
+ * Link the pattern into the list associated with the object, so
+ * that if the object goes away, these bindings will all
+ * automatically be deleted.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object,
+ &new);
+ if (new) {
+ psPtr->nextObjPtr = NULL;
+ } else {
+ psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ }
+ Tcl_SetHashValue(hPtr, psPtr);
+ } else if (psPtr->eventProc != EvalTclBinding) {
+ /*
+ * Free existing procedural binding.
+ */
+
+ if (psPtr->freeProc != NULL) {
+ (*psPtr->freeProc)(psPtr->clientData);
+ }
+ psPtr->clientData = NULL;
+ append = 0;
+ }
+
+ old = (char *) psPtr->clientData;
+ if ((append != 0) && (old != NULL)) {
+ int length;
+
+ length = strlen(old) + strlen(command) + 2;
+ new = (char *) ckalloc((unsigned) length);
+ sprintf(new, "%s\n%s", old, command);
+ } else {
+ new = (char *) ckalloc((unsigned) strlen(command) + 1);
+ strcpy(new, command);
+ }
+ if (old != NULL) {
+ ckfree(old);
+ }
+ psPtr->eventProc = EvalTclBinding;
+ psPtr->freeProc = FreeTclBinding;
+ psPtr->clientData = (ClientData) new;
+ return eventMask;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkCreateBindingProcedure --
+ *
+ * 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
+ * replaced.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+unsigned long
+TkCreateBindingProcedure(interp, bindingTable, object, eventString,
+ eventProc, freeProc, clientData)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_BindingTable bindingTable;
+ /* Table in which to create binding. */
+ ClientData object; /* Token for object with which binding is
+ * associated. */
+ char *eventString; /* String describing event sequence that
+ * triggers binding. */
+ TkBindEvalProc *eventProc; /* Procedure to invoke when binding
+ * triggers. Must not be NULL. */
+ TkBindFreeProc *freeProc; /* Procedure to invoke when binding is
+ * freed. May be NULL for no procedure. */
+ ClientData clientData; /* Arbitrary ClientData to pass to eventProc
+ * and freeProc. */
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr;
+ unsigned long eventMask;
+
+ psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+ 1, 1, &eventMask);
+ if (psPtr == NULL) {
+ return 0;
+ }
+ if (psPtr->eventProc == NULL) {
+ int new;
+ Tcl_HashEntry *hPtr;
+
+ /*
+ * This pattern sequence was just created.
+ * Link the pattern into the list associated with the object, so
+ * that if the object goes away, these bindings will all
+ * automatically be deleted.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&bindPtr->objectTable, (char *) object,
+ &new);
+ if (new) {
+ psPtr->nextObjPtr = NULL;
+ } else {
+ psPtr->nextObjPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ }
+ Tcl_SetHashValue(hPtr, psPtr);
+ } else {
+
+ /*
+ * Free existing callback.
+ */
+
+ if (psPtr->freeProc != NULL) {
+ (*psPtr->freeProc)(psPtr->clientData);
+ }
+ }
+
+ psPtr->eventProc = eventProc;
+ psPtr->freeProc = freeProc;
+ psPtr->clientData = clientData;
+ return eventMask;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_DeleteBinding(interp, bindingTable, object, eventString)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_BindingTable bindingTable; /* Table in which to delete binding. */
+ ClientData object; /* Token for object with which binding
+ * is associated. */
+ char *eventString; /* String describing event sequence
+ * that triggers binding. */
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr, *prevPtr;
+ unsigned long eventMask;
+ Tcl_HashEntry *hPtr;
+
+ psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+ 0, 1, &eventMask);
+ if (psPtr == NULL) {
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+ }
+
+ /*
+ * Unlink the binding from the list for its object, then from the
+ * list for its pattern.
+ */
+
+ hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
+ if (hPtr == NULL) {
+ panic("Tk_DeleteBinding couldn't find object table entry");
+ }
+ prevPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ if (prevPtr == psPtr) {
+ Tcl_SetHashValue(hPtr, psPtr->nextObjPtr);
+ } else {
+ for ( ; ; prevPtr = prevPtr->nextObjPtr) {
+ if (prevPtr == NULL) {
+ panic("Tk_DeleteBinding couldn't find on object list");
+ }
+ if (prevPtr->nextObjPtr == psPtr) {
+ prevPtr->nextObjPtr = psPtr->nextObjPtr;
+ break;
+ }
+ }
+ }
+ prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
+ if (prevPtr == psPtr) {
+ if (psPtr->nextSeqPtr == NULL) {
+ Tcl_DeleteHashEntry(psPtr->hPtr);
+ } else {
+ Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
+ }
+ } else {
+ for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
+ if (prevPtr == NULL) {
+ panic("Tk_DeleteBinding couldn't find on hash chain");
+ }
+ if (prevPtr->nextSeqPtr == psPtr) {
+ prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
+ break;
+ }
+ }
+ }
+
+ psPtr->flags |= MARKED_DELETED;
+ if (psPtr->refCount == 0) {
+ if (psPtr->freeProc != NULL) {
+ (*psPtr->freeProc)(psPtr->clientData);
+ }
+ ckfree((char *) psPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetBinding --
+ *
+ * Return the command associated with a given event string.
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_GetBinding(interp, bindingTable, object, eventString)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_BindingTable bindingTable; /* Table in which to look for
+ * binding. */
+ ClientData object; /* Token for object with which binding
+ * is associated. */
+ char *eventString; /* String describing event sequence
+ * that triggers binding. */
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr;
+ unsigned long eventMask;
+
+ psPtr = FindSequence(interp, &bindPtr->patternTable, object, eventString,
+ 0, 1, &eventMask);
+ if (psPtr == NULL) {
+ return NULL;
+ }
+ if (psPtr->eventProc == EvalTclBinding) {
+ return (char *) psPtr->clientData;
+ }
+ return "";
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_GetAllBindings(interp, bindingTable, object)
+ Tcl_Interp *interp; /* Interpreter returning result or
+ * error. */
+ Tk_BindingTable bindingTable; /* Table in which to look for
+ * bindings. */
+ ClientData object; /* Token for object. */
+
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr;
+ Tcl_HashEntry *hPtr;
+ Tcl_DString ds;
+
+ hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
+ if (hPtr == NULL) {
+ return;
+ }
+ Tcl_DStringInit(&ds);
+ for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
+ psPtr = psPtr->nextObjPtr) {
+ /*
+ * For each binding, output information about each of the
+ * patterns in its sequence.
+ */
+
+ Tcl_DStringSetLength(&ds, 0);
+ GetPatternString(psPtr, &ds);
+ Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
+ }
+ Tcl_DStringFree(&ds);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteAllBindings --
+ *
+ * Remove all bindings associated with a given object in a
+ * given binding table.
+ *
+ * Results:
+ * All bindings associated with object are removed from
+ * bindingTable.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteAllBindings(bindingTable, object)
+ Tk_BindingTable bindingTable; /* Table in which to delete
+ * bindings. */
+ ClientData object; /* Token for object. */
+{
+ BindingTable *bindPtr = (BindingTable *) bindingTable;
+ PatSeq *psPtr, *prevPtr;
+ PatSeq *nextPtr;
+ Tcl_HashEntry *hPtr;
+
+ hPtr = Tcl_FindHashEntry(&bindPtr->objectTable, (char *) object);
+ if (hPtr == NULL) {
+ return;
+ }
+ for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
+ psPtr = nextPtr) {
+ nextPtr = psPtr->nextObjPtr;
+
+ /*
+ * Be sure to remove each binding from its hash chain in the
+ * pattern table. If this is the last pattern in the chain,
+ * then delete the hash entry too.
+ */
+
+ prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
+ if (prevPtr == psPtr) {
+ if (psPtr->nextSeqPtr == NULL) {
+ Tcl_DeleteHashEntry(psPtr->hPtr);
+ } else {
+ Tcl_SetHashValue(psPtr->hPtr, psPtr->nextSeqPtr);
+ }
+ } else {
+ for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
+ if (prevPtr == NULL) {
+ panic("Tk_DeleteAllBindings couldn't find on hash chain");
+ }
+ if (prevPtr->nextSeqPtr == psPtr) {
+ prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
+ break;
+ }
+ }
+ }
+ psPtr->flags |= MARKED_DELETED;
+
+ if (psPtr->refCount == 0) {
+ if (psPtr->freeProc != NULL) {
+ (*psPtr->freeProc)(psPtr->clientData);
+ }
+ ckfree((char *) psPtr);
+ }
+ }
+ Tcl_DeleteHashEntry(hPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_BindEvent --
+ *
+ * This procedure is invoked to process an X event. The
+ * event is added to those recorded for the binding table.
+ * Then each of the objects at *objectPtr is checked in
+ * order to see if it has a binding that matches the recent
+ * events. If so, the most specific binding is invoked for
+ * each object.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the command associated with the matching binding.
+ *
+ * All Tcl bindings scripts for each object are accumulated before
+ * the first binding is evaluated. If the action of a Tcl binding
+ * is to change or delete a binding, or delete the window associated
+ * with the binding, all the original Tcl binding scripts will still
+ * fire. Contrast this with C binding procedures. If a pending C
+ * binding (one that hasn't fired yet, but is queued to be fired for
+ * this window) is deleted, it will not be called, and if it is
+ * changed, then the new binding procedure will be called. If the
+ * window itself is deleted, no further C binding procedures will be
+ * called for this window. When both Tcl binding scripts and C binding
+ * procedures are interleaved, the above rules still apply.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_BindEvent(bindingTable, eventPtr, tkwin, numObjects, objectPtr)
+ Tk_BindingTable bindingTable; /* Table in which to look for
+ * bindings. */
+ XEvent *eventPtr; /* What actually happened. */
+ Tk_Window tkwin; /* Window on display where event
+ * occurred (needed in order to
+ * 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;
+ char *p, *end;
+ PendingBinding *pendingPtr;
+ PendingBinding staticPending;
+ TkWindow *winPtr = (TkWindow *)tkwin;
+ PatternTableKey key;
+
+ /*
+ * Ignore events on windows that don't have names: these are windows
+ * like wrapper windows that shouldn't be visible to the
+ * application.
+ */
+
+ if (winPtr->pathName == NULL) {
+ return;
+ }
+
+ /*
+ * Ignore the event completely if it is an Enter, Leave, FocusIn,
+ * or FocusOut event with detail NotifyInferior. The reason for
+ * ignoring these events is that we don't want transitions between
+ * a window and its children to visible to bindings on the parent:
+ * this would cause problems for mega-widgets, since the internal
+ * structure of a mega-widget isn't supposed to be visible to
+ * people watching the parent.
+ */
+
+ if ((eventPtr->type == EnterNotify) || (eventPtr->type == LeaveNotify)) {
+ if (eventPtr->xcrossing.detail == NotifyInferior) {
+ return;
+ }
+ }
+ if ((eventPtr->type == FocusIn) || (eventPtr->type == FocusOut)) {
+ if (eventPtr->xfocus.detail == NotifyInferior) {
+ return;
+ }
+ }
+
+ bindPtr = (BindingTable *) bindingTable;
+ dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo;
+
+ /*
+ * Add the new event to the ring of saved events for the
+ * binding table. Two tricky points:
+ *
+ * 1. Combine consecutive MotionNotify events. Do this by putting
+ * the new event *on top* of the previous event.
+ * 2. If a modifier key is held down, it auto-repeats to generate
+ * continuous KeyPress and KeyRelease events. These can flush
+ * the event ring so that valuable information is lost (such
+ * as repeated button clicks). To handle this, check for the
+ * special case of a modifier KeyPress arriving when the previous
+ * two events are a KeyRelease and KeyPress of the same key.
+ * If this happens, mark the most recent event (the KeyRelease)
+ * invalid and put the new event on top of the event before that
+ * (the KeyPress).
+ */
+
+ if ((eventPtr->type == MotionNotify)
+ && (bindPtr->eventRing[bindPtr->curEvent].type == MotionNotify)) {
+ /*
+ * Don't advance the ring pointer.
+ */
+ } else if (eventPtr->type == KeyPress) {
+ int i;
+ for (i = 0; ; i++) {
+ if (i >= dispPtr->numModKeyCodes) {
+ goto advanceRingPointer;
+ }
+ if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
+ break;
+ }
+ }
+ ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
+ if ((ringPtr->type != KeyRelease)
+ || (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
+ goto advanceRingPointer;
+ }
+ if (bindPtr->curEvent <= 0) {
+ i = EVENT_BUFFER_SIZE - 1;
+ } else {
+ i = bindPtr->curEvent - 1;
+ }
+ ringPtr = &bindPtr->eventRing[i];
+ if ((ringPtr->type != KeyPress)
+ || (ringPtr->xkey.keycode != eventPtr->xkey.keycode)) {
+ goto advanceRingPointer;
+ }
+ bindPtr->eventRing[bindPtr->curEvent].type = -1;
+ bindPtr->curEvent = i;
+ } else {
+ advanceRingPointer:
+ bindPtr->curEvent++;
+ if (bindPtr->curEvent >= EVENT_BUFFER_SIZE) {
+ bindPtr->curEvent = 0;
+ }
+ }
+ ringPtr = &bindPtr->eventRing[bindPtr->curEvent];
+ memcpy((VOID *) ringPtr, (VOID *) eventPtr, sizeof(XEvent));
+ detail.clientData = 0;
+ flags = flagArray[ringPtr->type];
+ if (flags & KEY) {
+ detail.keySym = GetKeySym(dispPtr, ringPtr);
+ if (detail.keySym == NoSymbol) {
+ detail.keySym = 0;
+ }
+ } else if (flags & BUTTON) {
+ detail.button = ringPtr->xbutton.button;
+ } else if (flags & VIRTUAL) {
+ detail.name = ((XVirtualEvent *) ringPtr)->name;
+ }
+ bindPtr->detailRing[bindPtr->curEvent] = detail;
+
+ /*
+ * Find out if there are any virtual events that correspond to this
+ * physical event (or sequence of physical events).
+ */
+
+ vMatchDetailList = NULL;
+ vMatchNoDetailList = NULL;
+ memset(&key, 0, sizeof(key));
+
+ if (ringPtr->type != VirtualEvent) {
+ Tcl_HashTable *veptPtr;
+ Tcl_HashEntry *hPtr;
+
+ veptPtr = &bindInfoPtr->virtualEventTable.patternTable;
+
+ key.object = NULL;
+ key.type = ringPtr->type;
+ key.detail = detail;
+
+ hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
+ if (hPtr != NULL) {
+ vMatchDetailList = (PatSeq *) Tcl_GetHashValue(hPtr);
+ }
+
+ if (key.detail.clientData != 0) {
+ key.detail.clientData = 0;
+ hPtr = Tcl_FindHashEntry(veptPtr, (char *) &key);
+ if (hPtr != NULL) {
+ vMatchNoDetailList = (PatSeq *) Tcl_GetHashValue(hPtr);
+ }
+ }
+ }
+
+ /*
+ * Loop over all the binding tags, finding the binding script or
+ * callback for each one. Append all of the binding scripts, with
+ * %-sequences expanded, to "scripts", with null characters separating
+ * the scripts for each object. Append all the callbacks to the array
+ * of pending callbacks.
+ */
+
+ pendingPtr = &staticPending;
+ matchCount = 0;
+ matchSpace = sizeof(staticPending.matchArray) / sizeof(PatSeq *);
+ Tcl_DStringInit(&scripts);
+
+ for ( ; numObjects > 0; numObjects--, objectPtr++) {
+ PatSeq *matchPtr, *sourcePtr;
+ Tcl_HashEntry *hPtr;
+
+ matchPtr = NULL;
+ sourcePtr = NULL;
+
+ /*
+ * Match the new event against those recorded in the pattern table,
+ * saving the longest matching pattern. For events with details
+ * (button and key events), look for a binding for the specific
+ * key or button. First see if the event matches a physical event
+ * that the object is interested in, then look for a virtual event.
+ */
+
+ key.object = *objectPtr;
+ key.type = ringPtr->type;
+ key.detail = detail;
+ hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
+ if (hPtr != NULL) {
+ matchPtr = MatchPatterns(dispPtr, bindPtr,
+ (PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL,
+ &sourcePtr);
+ }
+
+ if (vMatchDetailList != NULL) {
+ matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchDetailList,
+ matchPtr, objectPtr, &sourcePtr);
+ }
+
+ /*
+ * If no match was found, look for a binding for all keys or buttons
+ * (detail of 0). Again, first match on a virtual event.
+ */
+
+ if ((detail.clientData != 0) && (matchPtr == NULL)) {
+ key.detail.clientData = 0;
+ hPtr = Tcl_FindHashEntry(&bindPtr->patternTable, (char *) &key);
+ if (hPtr != NULL) {
+ matchPtr = MatchPatterns(dispPtr, bindPtr,
+ (PatSeq *) Tcl_GetHashValue(hPtr), matchPtr, NULL,
+ &sourcePtr);
+ }
+
+ if (vMatchNoDetailList != NULL) {
+ matchPtr = MatchPatterns(dispPtr, bindPtr, vMatchNoDetailList,
+ matchPtr, objectPtr, &sourcePtr);
+ }
+
+ }
+
+ if (matchPtr != NULL) {
+ if (sourcePtr->eventProc == NULL) {
+ panic("Tk_BindEvent: missing command");
+ }
+ if (sourcePtr->eventProc == EvalTclBinding) {
+ ExpandPercents(winPtr, (char *) sourcePtr->clientData,
+ 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;
+ }
+ sourcePtr->refCount++;
+ pendingPtr->matchArray[matchCount] = sourcePtr;
+ matchCount++;
+ }
+ /*
+ * A "" is added to the scripts string to separate the
+ * various scripts that should be invoked.
+ */
+
+ Tcl_DStringAppend(&scripts, "", 1);
+ }
+ }
+ if (Tcl_DStringLength(&scripts) == 0) {
+ return;
+ }
+
+ /*
+ * 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
+ * local variable in order to restore the result.
+ */
+
+ interp = bindPtr->interp;
+ Tcl_DStringInit(&savedResult);
+
+ /*
+ * Save information about the current screen, then invoke a script
+ * if the screen has changed.
+ */
+
+ Tcl_DStringGetResult(interp, &savedResult);
+ screenPtr = &bindInfoPtr->screenInfo;
+ oldDispPtr = screenPtr->curDispPtr;
+ oldScreen = screenPtr->curScreenIndex;
+ if ((dispPtr != screenPtr->curDispPtr)
+ || (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++;
+ code = TCL_OK;
+ if ((pendingPtr->deleted == 0)
+ && ((psPtr->flags & MARKED_DELETED) == 0)) {
+ code = (*psPtr->eventProc)(psPtr->clientData, interp, eventPtr,
+ tkwin, detail.keySym);
+ }
+ psPtr->refCount--;
+ if ((psPtr->refCount == 0) && (psPtr->flags & MARKED_DELETED)) {
+ if (psPtr->freeProc != NULL) {
+ (*psPtr->freeProc)(psPtr->clientData);
+ }
+ 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;
+ } else {
+ Tcl_AddErrorInfo(interp, "\n (command bound to event)");
+ Tcl_BackgroundError(interp);
+ break;
+ }
+ }
+ }
+
+ if (matchCount > 0 && !pendingPtr->deleted) {
+ /*
+ * Restore the original modal flag value and invoke the modal loop
+ * if needed.
+ */
+
+ deferModal = winPtr->flags & TK_DEFER_MODAL;
+ 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 --
+ *
+ * This procedure is invoked when it is determined that a window is
+ * dead. It cleans up bind-related information about the window
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Any pending C bindings for this window are cancelled.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkBindDeadWindow(winPtr)
+ TkWindow *winPtr; /* The window that is being deleted. */
+{
+ BindInfo *bindInfoPtr;
+ PendingBinding *curPtr;
+
+ bindInfoPtr = (BindInfo *) winPtr->mainPtr->bindInfo;
+ curPtr = bindInfoPtr->pendingList;
+ while (curPtr != NULL) {
+ if (curPtr->tkwin == (Tk_Window) winPtr) {
+ curPtr->deleted = 1;
+ }
+ curPtr = curPtr->nextPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MatchPatterns --
+ *
+ * Given a list of pattern sequences and a list of recent events,
+ * return the pattern sequence that best matches the event list,
+ * if there is one.
+ *
+ * This procedure is used in two different ways. In the simplest
+ * use, "object" is NULL and psPtr is a list of pattern sequences,
+ * each of which corresponds to a binding. In this case, the
+ * procedure finds the pattern sequences that match the event list
+ * and returns the most specific of those, if there is more than one.
+ *
+ * In the second case, psPtr is a list of pattern sequences, each
+ * of which corresponds to a definition for a virtual binding.
+ * In order for one of these sequences to "match", it must match
+ * the events (as above) but in addition there must be a binding
+ * for its associated virtual event on the current object. The
+ * "object" argument indicates which object the binding must be for.
+ *
+ * Results:
+ * The return value is NULL if bestPtr is NULL and no pattern matches
+ * the recent events from bindPtr. Otherwise the return value is
+ * the most specific pattern sequence among bestPtr and all those
+ * at psPtr that match the event list and object. If a pattern
+ * sequence other than bestPtr is returned, then *bestCommandPtr
+ * is filled in with a pointer to the command from the best sequence.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+static PatSeq *
+MatchPatterns(dispPtr, bindPtr, psPtr, bestPtr, objectPtr, sourcePtrPtr)
+ TkDisplay *dispPtr; /* Display from which the event came. */
+ BindingTable *bindPtr; /* Information about binding table, such as
+ * ring of recent events. */
+ PatSeq *psPtr; /* List of pattern sequences. */
+ PatSeq *bestPtr; /* The best match seen so far, from a
+ * previous call to this procedure. NULL
+ * means no prior best match. */
+ ClientData *objectPtr; /* If NULL, the sequences at psPtr
+ * correspond to "normal" bindings. If
+ * non-NULL, the sequences at psPtr correspond
+ * to virtual bindings; in order to match each
+ * sequence must correspond to a virtual
+ * binding for which a binding exists for
+ * object in bindPtr. */
+ PatSeq **sourcePtrPtr; /* Filled with the pattern sequence that
+ * contains the eventProc and clientData
+ * associated with the best match. If this
+ * differs from the return value, it is the
+ * virtual event that most closely matched the
+ * return value (a physical event). Not
+ * modified unless a result other than bestPtr
+ * is returned. */
+{
+ PatSeq *matchPtr, *bestSourcePtr, *sourcePtr;
+
+ bestSourcePtr = *sourcePtrPtr;
+
+ /*
+ * Iterate over all the pattern sequences.
+ */
+
+ for ( ; psPtr != NULL; psPtr = psPtr->nextSeqPtr) {
+ XEvent *eventPtr;
+ Pattern *patPtr;
+ Window window;
+ Detail *detailPtr;
+ int patCount, ringCount, flags, state;
+ int modMask;
+
+ /*
+ * Iterate over all the patterns in a sequence to be
+ * sure that they all match.
+ */
+
+ eventPtr = &bindPtr->eventRing[bindPtr->curEvent];
+ detailPtr = &bindPtr->detailRing[bindPtr->curEvent];
+ window = eventPtr->xany.window;
+ patPtr = psPtr->pats;
+ patCount = psPtr->numPats;
+ ringCount = EVENT_BUFFER_SIZE;
+ while (patCount > 0) {
+ if (ringCount <= 0) {
+ goto nextSequence;
+ }
+ if (eventPtr->xany.type != patPtr->eventType) {
+ /*
+ * Most of the event types are considered superfluous
+ * in that they are ignored if they occur in the middle
+ * of a pattern sequence and have mismatching types. The
+ * only ones that cannot be ignored are ButtonPress and
+ * ButtonRelease events (if the next event in the pattern
+ * is a KeyPress or KeyRelease) and KeyPress and KeyRelease
+ * events (if the next pattern event is a ButtonPress or
+ * ButtonRelease). Here are some tricky cases to consider:
+ * 1. Double-Button or Double-Key events.
+ * 2. Double-ButtonRelease or Double-KeyRelease events.
+ * 3. The arrival of various events like Enter and Leave
+ * and FocusIn and GraphicsExpose between two button
+ * presses or key presses.
+ * 4. Modifier keys like Shift and Control shouldn't
+ * generate conflicts with button events.
+ */
+
+ if ((patPtr->eventType == KeyPress)
+ || (patPtr->eventType == KeyRelease)) {
+ if ((eventPtr->xany.type == ButtonPress)
+ || (eventPtr->xany.type == ButtonRelease)) {
+ goto nextSequence;
+ }
+ } else if ((patPtr->eventType == ButtonPress)
+ || (patPtr->eventType == ButtonRelease)) {
+ if ((eventPtr->xany.type == KeyPress)
+ || (eventPtr->xany.type == KeyRelease)) {
+ int i;
+
+ /*
+ * Ignore key events if they are modifier keys.
+ */
+
+ for (i = 0; i < dispPtr->numModKeyCodes; i++) {
+ if (dispPtr->modKeyCodes[i]
+ == eventPtr->xkey.keycode) {
+ /*
+ * This key is a modifier key, so ignore it.
+ */
+ goto nextEvent;
+ }
+ }
+ goto nextSequence;
+ }
+ }
+ goto nextEvent;
+ }
+ if (eventPtr->xany.window != window) {
+ goto nextSequence;
+ }
+
+ /*
+ * Note: it's important for the keysym check to go before
+ * the modifier check, so we can ignore unwanted modifier
+ * keys before choking on the modifier check.
+ */
+
+ if ((patPtr->detail.clientData != 0)
+ && (patPtr->detail.clientData != detailPtr->clientData)) {
+ /*
+ * The detail appears not to match. However, if the event
+ * is a KeyPress for a modifier key then just ignore the
+ * event. Otherwise event sequences like "aD" never match
+ * because the shift key goes down between the "a" and the
+ * "D".
+ */
+
+ if (eventPtr->xany.type == KeyPress) {
+ int i;
+
+ for (i = 0; i < dispPtr->numModKeyCodes; i++) {
+ if (dispPtr->modKeyCodes[i] == eventPtr->xkey.keycode) {
+ goto nextEvent;
+ }
+ }
+ }
+ goto nextSequence;
+ }
+ flags = flagArray[eventPtr->type];
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ state = eventPtr->xkey.state;
+ } else if (flags & CROSSING) {
+ state = eventPtr->xcrossing.state;
+ } else {
+ state = 0;
+ }
+ if (patPtr->needMods != 0) {
+ modMask = patPtr->needMods;
+ if ((modMask & META_MASK) && (dispPtr->metaModMask != 0)) {
+ modMask = (modMask & ~META_MASK) | dispPtr->metaModMask;
+ }
+ if ((modMask & ALT_MASK) && (dispPtr->altModMask != 0)) {
+ modMask = (modMask & ~ALT_MASK) | dispPtr->altModMask;
+ }
+ if ((state & modMask) != modMask) {
+ goto nextSequence;
+ }
+ }
+ if (psPtr->flags & PAT_NEARBY) {
+ XEvent *firstPtr;
+ int timeDiff;
+
+ firstPtr = &bindPtr->eventRing[bindPtr->curEvent];
+ timeDiff = (Time) firstPtr->xkey.time - eventPtr->xkey.time;
+ if ((firstPtr->xkey.x_root
+ < (eventPtr->xkey.x_root - NEARBY_PIXELS))
+ || (firstPtr->xkey.x_root
+ > (eventPtr->xkey.x_root + NEARBY_PIXELS))
+ || (firstPtr->xkey.y_root
+ < (eventPtr->xkey.y_root - NEARBY_PIXELS))
+ || (firstPtr->xkey.y_root
+ > (eventPtr->xkey.y_root + NEARBY_PIXELS))
+ || (timeDiff > NEARBY_MS)) {
+ goto nextSequence;
+ }
+ }
+ patPtr++;
+ patCount--;
+ nextEvent:
+ if (eventPtr == bindPtr->eventRing) {
+ eventPtr = &bindPtr->eventRing[EVENT_BUFFER_SIZE-1];
+ detailPtr = &bindPtr->detailRing[EVENT_BUFFER_SIZE-1];
+ } else {
+ eventPtr--;
+ detailPtr--;
+ }
+ ringCount--;
+ }
+
+ matchPtr = psPtr;
+ sourcePtr = psPtr;
+
+ if (objectPtr != NULL) {
+ int iVirt;
+ VirtualOwners *voPtr;
+ PatternTableKey key;
+
+ /*
+ * The sequence matches the physical constraints.
+ * Is this object interested in any of the virtual events
+ * that correspond to this sequence?
+ */
+
+ voPtr = psPtr->voPtr;
+
+ memset(&key, 0, sizeof(key));
+ key.object = *objectPtr;
+ key.type = VirtualEvent;
+ key.detail.clientData = 0;
+
+ for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) {
+ Tcl_HashEntry *hPtr = voPtr->owners[iVirt];
+
+ key.detail.name = (Tk_Uid) Tcl_GetHashKey(hPtr->tablePtr,
+ hPtr);
+ hPtr = Tcl_FindHashEntry(&bindPtr->patternTable,
+ (char *) &key);
+ if (hPtr != NULL) {
+
+ /*
+ * This tag is interested in this virtual event and its
+ * corresponding physical event is a good match with the
+ * virtual event's definition.
+ */
+
+ PatSeq *virtMatchPtr;
+
+ virtMatchPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ if ((virtMatchPtr->numPats != 1)
+ || (virtMatchPtr->nextSeqPtr != NULL)) {
+ panic("MatchPattern: badly constructed virtual event");
+ }
+ sourcePtr = virtMatchPtr;
+ goto match;
+ }
+ }
+
+ /*
+ * The physical event matches a virtual event's definition, but
+ * the tag isn't interested in it.
+ */
+ goto nextSequence;
+ }
+ match:
+
+ /*
+ * This sequence matches. If we've already got another match,
+ * pick whichever is most specific. Detail is most important,
+ * then needMods.
+ */
+
+ if (bestPtr != NULL) {
+ Pattern *patPtr2;
+ int i;
+
+ if (matchPtr->numPats != bestPtr->numPats) {
+ if (bestPtr->numPats > matchPtr->numPats) {
+ goto nextSequence;
+ } else {
+ goto newBest;
+ }
+ }
+ for (i = 0, patPtr = matchPtr->pats, patPtr2 = bestPtr->pats;
+ i < matchPtr->numPats; i++, patPtr++, patPtr2++) {
+ if (patPtr->detail.clientData != patPtr2->detail.clientData) {
+ if (patPtr->detail.clientData == 0) {
+ goto nextSequence;
+ } else {
+ goto newBest;
+ }
+ }
+ if (patPtr->needMods != patPtr2->needMods) {
+ if ((patPtr->needMods & patPtr2->needMods)
+ == patPtr->needMods) {
+ goto nextSequence;
+ } else if ((patPtr->needMods & patPtr2->needMods)
+ == patPtr2->needMods) {
+ goto newBest;
+ }
+ }
+ }
+ /*
+ * Tie goes to current best pattern.
+ *
+ * (1) For virtual vs. virtual, the least recently defined
+ * virtual wins, because virtuals are examined in order of
+ * definition. This order is _not_ guaranteed in the
+ * documentation.
+ *
+ * (2) For virtual vs. physical, the physical wins because all
+ * the physicals are examined before the virtuals. This order
+ * is guaranteed in the documentation.
+ *
+ * (3) For physical vs. physical pattern, the most recently
+ * defined physical wins, because physicals are examined in
+ * reverse order of definition. This order is guaranteed in
+ * the documentation.
+ */
+
+ goto nextSequence;
+ }
+ newBest:
+ bestPtr = matchPtr;
+ bestSourcePtr = sourcePtr;
+
+ nextSequence: continue;
+ }
+
+ *sourcePtrPtr = bestSourcePtr;
+ return bestPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ExpandPercents --
+ *
+ * Given a command and an event, produce a new command
+ * by replacing % constructs in the original command
+ * with information from the X event.
+ *
+ * Results:
+ * The new expanded command is appended to the dynamic string
+ * given by dsPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ExpandPercents(winPtr, before, eventPtr, keySym, dsPtr)
+ TkWindow *winPtr; /* Window where event occurred: needed to
+ * get input context. */
+ char *before; /* Command containing percent expressions
+ * to be replaced. */
+ XEvent *eventPtr; /* X event containing information to be
+ * used in % replacements. */
+ KeySym keySym; /* KeySym: only relevant for KeyPress and
+ * KeyRelease events). */
+ Tcl_DString *dsPtr; /* Dynamic string in which to append new
+ * 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) {
+ /*
+ * Find everything up to the next % character and append it
+ * to the result string.
+ */
+
+ for (string = before; (*string != 0) && (*string != '%'); string++) {
+ /* Empty loop body. */
+ }
+ if (string != before) {
+ Tcl_DStringAppend(dsPtr, before, string-before);
+ before = string;
+ }
+ if (*before == 0) {
+ break;
+ }
+
+ /*
+ * There's a percent sequence here. Process it.
+ */
+
+ 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;
+ }
+ goto doNumber;
+ case 'd':
+ if (flags & (CROSSING|FOCUS)) {
+ if (flags & FOCUS) {
+ number = eventPtr->xfocus.detail;
+ } else {
+ number = eventPtr->xcrossing.detail;
+ }
+ string = TkFindStateString(notifyDetail, number);
+ }
+ goto doString;
+ case 'f':
+ number = eventPtr->xcrossing.focus;
+ goto doNumber;
+ case 'h':
+ if (flags & EXPOSE) {
+ number = eventPtr->xexpose.height;
+ } else if (flags & (CONFIG)) {
+ number = eventPtr->xconfigure.height;
+ }
+ goto doNumber;
+ case 'k':
+ number = eventPtr->xkey.keycode;
+ goto doNumber;
+ case 'm':
+ if (flags & CROSSING) {
+ number = eventPtr->xcrossing.mode;
+ } else if (flags & FOCUS) {
+ number = eventPtr->xfocus.mode;
+ }
+ string = TkFindStateString(notifyMode, number);
+ goto doString;
+ case 'o':
+ if (flags & CREATE) {
+ number = eventPtr->xcreatewindow.override_redirect;
+ } else if (flags & MAP) {
+ number = eventPtr->xmap.override_redirect;
+ } else if (flags & REPARENT) {
+ number = eventPtr->xreparent.override_redirect;
+ } else if (flags & CONFIG) {
+ number = eventPtr->xconfigure.override_redirect;
+ }
+ goto doNumber;
+ case 'p':
+ string = TkFindStateString(circPlace, eventPtr->xcirculate.place);
+ goto doString;
+ case 's':
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ number = eventPtr->xkey.state;
+ } else if (flags & CROSSING) {
+ number = eventPtr->xcrossing.state;
+ } else if (flags & VISIBILITY) {
+ string = TkFindStateString(visNotify,
+ eventPtr->xvisibility.state);
+ goto doString;
+ }
+ goto doNumber;
+ case 't':
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ number = (int) eventPtr->xkey.time;
+ } else if (flags & CROSSING) {
+ number = (int) eventPtr->xcrossing.time;
+ } else if (flags & PROP) {
+ number = (int) eventPtr->xproperty.time;
+ }
+ goto doNumber;
+ case 'v':
+ number = eventPtr->xconfigurerequest.value_mask;
+ goto doNumber;
+ case 'w':
+ if (flags & EXPOSE) {
+ number = eventPtr->xexpose.width;
+ } else if (flags & CONFIG) {
+ number = eventPtr->xconfigure.width;
+ }
+ goto doNumber;
+ case 'x':
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ number = eventPtr->xkey.x;
+ } else if (flags & CROSSING) {
+ number = eventPtr->xcrossing.x;
+ } else if (flags & EXPOSE) {
+ number = eventPtr->xexpose.x;
+ } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+ number = eventPtr->xcreatewindow.x;
+ } else if (flags & REPARENT) {
+ number = eventPtr->xreparent.x;
+ }
+ goto doNumber;
+ case 'y':
+ if (flags & (KEY_BUTTON_MOTION_VIRTUAL)) {
+ number = eventPtr->xkey.y;
+ } else if (flags & EXPOSE) {
+ number = eventPtr->xexpose.y;
+ } else if (flags & (CREATE|CONFIG|GRAVITY)) {
+ number = eventPtr->xcreatewindow.y;
+ } else if (flags & REPARENT) {
+ number = eventPtr->xreparent.y;
+ } 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 '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;
+
+ name = TkKeysymToString(keySym);
+ if (name != NULL) {
+ string = name;
+ }
+ }
+ goto doString;
+ case 'N':
+ number = (int) keySym;
+ goto doNumber;
+ case 'R':
+ TkpPrintWindowId(numStorage, eventPtr->xkey.root);
+ string = numStorage;
+ goto doString;
+ case 'S':
+ TkpPrintWindowId(numStorage, eventPtr->xkey.subwindow);
+ string = numStorage;
+ goto doString;
+ case 'T':
+ number = eventPtr->type;
+ goto doNumber;
+ case 'W': {
+ Tk_Window tkwin;
+
+ tkwin = Tk_IdToWindow(eventPtr->xany.display,
+ eventPtr->xany.window);
+ if (tkwin != NULL) {
+ string = Tk_PathName(tkwin);
+ } else {
+ string = "??";
+ }
+ goto doString;
+ }
+ case 'X': {
+ Tk_Window tkwin;
+ int x, y;
+ int width, height;
+
+ number = eventPtr->xkey.x_root;
+ tkwin = Tk_IdToWindow(eventPtr->xany.display,
+ eventPtr->xany.window);
+ if (tkwin != NULL) {
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ number -= x;
+ }
+ goto doNumber;
+ }
+ case 'Y': {
+ Tk_Window tkwin;
+ int x, y;
+ int width, height;
+
+ number = eventPtr->xkey.y_root;
+ tkwin = Tk_IdToWindow(eventPtr->xany.display,
+ eventPtr->xany.window);
+ if (tkwin != NULL) {
+ Tk_GetVRootGeometry(tkwin, &x, &y, &width, &height);
+ number -= y;
+ }
+ goto doNumber;
+ }
+ default:
+ numStorage[0] = before[1];
+ numStorage[1] = '\0';
+ string = numStorage;
+ goto doString;
+ }
+
+ doNumber:
+ sprintf(numStorage, "%d", number);
+ string = numStorage;
+
+ doString:
+ spaceNeeded = Tcl_ScanElement(string, &cvtFlags);
+ length = Tcl_DStringLength(dsPtr);
+ 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 --
+ *
+ * This procedure is invoked whenever the current screen changes
+ * in an application. It invokes a Tcl procedure named
+ * "tkScreenChanged", passing it the screen name as argument.
+ * tkScreenChanged does things like making the tkPriv variable
+ * point to an array for the current display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on what tkScreenChanged does. If an error occurs
+ * them tkError will be invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChangeScreen(interp, dispName, screenIndex)
+ 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));
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (changing screen in event binding)");
+ Tcl_BackgroundError(interp);
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_EventCmd --
+ *
+ * This procedure is invoked to process the "event" Tcl command.
+ * It is used to define and generate events.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * 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;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * InitVirtualEventTable --
+ *
+ * Given storage for a virtual event table, set up the fields to
+ * prepare a new domain in which virtual events may be defined.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * *vetPtr is now initialized.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+InitVirtualEventTable(vetPtr)
+ VirtualEventTable *vetPtr; /* Pointer to virtual event table. Memory
+ * is supplied by the caller. */
+{
+ Tcl_InitHashTable(&vetPtr->patternTable,
+ sizeof(PatternTableKey) / sizeof(int));
+ Tcl_InitHashTable(&vetPtr->nameTable, TCL_ONE_WORD_KEYS);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * DeleteVirtualEventTable --
+ *
+ * Delete the contents of a virtual event table. The caller is
+ * responsible for freeing any memory used by the table itself.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+DeleteVirtualEventTable(vetPtr)
+ VirtualEventTable *vetPtr; /* The virtual event table to delete. */
+{
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ PatSeq *psPtr, *nextPtr;
+
+ hPtr = Tcl_FirstHashEntry(&vetPtr->patternTable, &search);
+ for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ psPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ for ( ; psPtr != NULL; psPtr = nextPtr) {
+ nextPtr = psPtr->nextSeqPtr;
+ ckfree((char *) psPtr->voPtr);
+ ckfree((char *) psPtr);
+ }
+ }
+ Tcl_DeleteHashTable(&vetPtr->patternTable);
+
+ hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
+ for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ ckfree((char *) Tcl_GetHashValue(hPtr));
+ }
+ Tcl_DeleteHashTable(&vetPtr->nameTable);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateVirtualEvent --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CreateVirtualEvent(interp, vetPtr, virtString, eventString)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ VirtualEventTable *vetPtr;/* Table in which to augment virtual event. */
+ char *virtString; /* Name of new virtual event. */
+ char *eventString; /* String describing physical event that
+ * triggers virtual event. */
+{
+ PatSeq *psPtr;
+ int dummy;
+ Tcl_HashEntry *vhPtr;
+ unsigned long eventMask;
+ PhysicalsOwned *poPtr;
+ VirtualOwners *voPtr;
+ Tk_Uid virtUid;
+
+ virtUid = GetVirtualEventUid(interp, virtString);
+ if (virtUid == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Find/create physical event
+ */
+
+ psPtr = FindSequence(interp, &vetPtr->patternTable, NULL, eventString,
+ 1, 0, &eventMask);
+ if (psPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Find/create virtual event.
+ */
+
+ vhPtr = Tcl_CreateHashEntry(&vetPtr->nameTable, virtUid, &dummy);
+
+ /*
+ * Make virtual event own the physical event.
+ */
+
+ poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
+ if (poPtr == NULL) {
+ poPtr = (PhysicalsOwned *) ckalloc(sizeof(PhysicalsOwned));
+ poPtr->numOwned = 0;
+ } else {
+ /*
+ * See if this virtual event is already defined for this physical
+ * event and just return if it is.
+ */
+
+ int i;
+ for (i = 0; i < poPtr->numOwned; i++) {
+ if (poPtr->patSeqs[i] == psPtr) {
+ return TCL_OK;
+ }
+ }
+ poPtr = (PhysicalsOwned *) ckrealloc((char *) poPtr,
+ sizeof(PhysicalsOwned) + poPtr->numOwned * sizeof(PatSeq *));
+ }
+ Tcl_SetHashValue(vhPtr, (ClientData) poPtr);
+ poPtr->patSeqs[poPtr->numOwned] = psPtr;
+ poPtr->numOwned++;
+
+ /*
+ * Make physical event so it can trigger the virtual event.
+ */
+
+ voPtr = psPtr->voPtr;
+ if (voPtr == NULL) {
+ voPtr = (VirtualOwners *) ckalloc(sizeof(VirtualOwners));
+ voPtr->numOwners = 0;
+ } else {
+ voPtr = (VirtualOwners *) ckrealloc((char *) voPtr,
+ sizeof(VirtualOwners)
+ + voPtr->numOwners * sizeof(Tcl_HashEntry *));
+ }
+ psPtr->voPtr = voPtr;
+ voPtr->owners[voPtr->numOwners] = vhPtr;
+ voPtr->numOwners++;
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteVirtualEvent --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+DeleteVirtualEvent(interp, vetPtr, virtString, eventString)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ VirtualEventTable *vetPtr;/* Table in which to delete event. */
+ char *virtString; /* String describing event sequence that
+ * triggers binding. */
+ char *eventString; /* The event sequence that should be deleted,
+ * or NULL to delete all event sequences for
+ * the entire virtual event. */
+{
+ int iPhys;
+ Tk_Uid virtUid;
+ Tcl_HashEntry *vhPtr;
+ PhysicalsOwned *poPtr;
+ PatSeq *eventPSPtr;
+
+ virtUid = GetVirtualEventUid(interp, virtString);
+ if (virtUid == NULL) {
+ return TCL_ERROR;
+ }
+
+ vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid);
+ if (vhPtr == NULL) {
+ return TCL_OK;
+ }
+ poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
+
+ eventPSPtr = NULL;
+ if (eventString != NULL) {
+ unsigned long eventMask;
+
+ /*
+ * Delete only the specific physical event associated with the
+ * virtual event. If the physical event doesn't already exist, or
+ * 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;
+ VirtualOwners *voPtr;
+
+ /*
+ * Remove association between this physical event and the given
+ * virtual event that it triggers.
+ */
+
+ voPtr = psPtr->voPtr;
+ for (iVirt = 0; iVirt < voPtr->numOwners; iVirt++) {
+ if (voPtr->owners[iVirt] == vhPtr) {
+ break;
+ }
+ }
+ if (iVirt == voPtr->numOwners) {
+ panic("DeleteVirtualEvent: couldn't find owner");
+ }
+ voPtr->numOwners--;
+ if (voPtr->numOwners == 0) {
+ /*
+ * Removed last reference to this physical event, so
+ * remove it from physical->virtual map.
+ */
+ PatSeq *prevPtr = (PatSeq *) Tcl_GetHashValue(psPtr->hPtr);
+ if (prevPtr == psPtr) {
+ if (psPtr->nextSeqPtr == NULL) {
+ Tcl_DeleteHashEntry(psPtr->hPtr);
+ } else {
+ Tcl_SetHashValue(psPtr->hPtr,
+ psPtr->nextSeqPtr);
+ }
+ } else {
+ for ( ; ; prevPtr = prevPtr->nextSeqPtr) {
+ if (prevPtr == NULL) {
+ panic("Tk_DeleteVirtualEvent couldn't find on hash chain");
+ }
+ if (prevPtr->nextSeqPtr == psPtr) {
+ prevPtr->nextSeqPtr = psPtr->nextSeqPtr;
+ break;
+ }
+ }
+ }
+ ckfree((char *) psPtr->voPtr);
+ ckfree((char *) psPtr);
+ } else {
+ /*
+ * This physical event still triggers some other virtual
+ * event(s). Consolidate the list of virtual owners for
+ * this physical event so it no longer triggers the
+ * given virtual event.
+ */
+ voPtr->owners[iVirt] = voPtr->owners[voPtr->numOwners];
+ }
+
+ /*
+ * Now delete the virtual event's reference to the physical
+ * event.
+ */
+
+ poPtr->numOwned--;
+ if (eventPSPtr != NULL && poPtr->numOwned != 0) {
+ /*
+ * Just deleting this one physical event. Consolidate list
+ * of owned physical events and return.
+ */
+
+ poPtr->patSeqs[iPhys] = poPtr->patSeqs[poPtr->numOwned];
+ return TCL_OK;
+ }
+ }
+ }
+
+ if (poPtr->numOwned == 0) {
+ /*
+ * All the physical events for this virtual event were deleted,
+ * either because there was only one associated physical event or
+ * because the caller was deleting the entire virtual event. Now
+ * the virtual event itself should be deleted.
+ */
+
+ ckfree((char *) poPtr);
+ Tcl_DeleteHashEntry(vhPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+GetVirtualEvent(interp, vetPtr, virtString)
+ Tcl_Interp *interp; /* Interpreter for reporting. */
+ VirtualEventTable *vetPtr;/* Table in which to look for event. */
+ char *virtString; /* String describing virtual event. */
+{
+ Tcl_HashEntry *vhPtr;
+ Tcl_DString ds;
+ int iPhys;
+ PhysicalsOwned *poPtr;
+ Tk_Uid virtUid;
+
+ virtUid = GetVirtualEventUid(interp, virtString);
+ if (virtUid == NULL) {
+ return TCL_ERROR;
+ }
+
+ vhPtr = Tcl_FindHashEntry(&vetPtr->nameTable, virtUid);
+ if (vhPtr == NULL) {
+ return TCL_OK;
+ }
+
+ Tcl_DStringInit(&ds);
+
+ poPtr = (PhysicalsOwned *) Tcl_GetHashValue(vhPtr);
+ for (iPhys = 0; iPhys < poPtr->numOwned; iPhys++) {
+ Tcl_DStringSetLength(&ds, 0);
+ GetPatternString(poPtr->patSeqs[iPhys], &ds);
+ Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
+ }
+ Tcl_DStringFree(&ds);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+GetAllVirtualEvents(interp, vetPtr)
+ Tcl_Interp *interp; /* Interpreter returning result. */
+ VirtualEventTable *vetPtr;/* Table containing events. */
+{
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ Tcl_DString ds;
+
+ Tcl_DStringInit(&ds);
+
+ hPtr = Tcl_FirstHashEntry(&vetPtr->nameTable, &search);
+ for ( ; hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_DStringSetLength(&ds, 0);
+ Tcl_DStringAppend(&ds, "<<", 2);
+ Tcl_DStringAppend(&ds, Tcl_GetHashKey(hPtr->tablePtr, hPtr), -1);
+ Tcl_DStringAppend(&ds, ">>", 2);
+ Tcl_AppendElement(interp, Tcl_DStringValue(&ds));
+ }
+
+ Tcl_DStringFree(&ds);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * HandleEventGenerate --
+ *
+ * Helper function for the "event generate" command. Generate and
+ * process an XEvent, constructed from information parsed from the
+ * event description string and its optional arguments.
+ *
+ * argv[0] contains name of the target window.
+ * argv[1] contains pattern string for one event (e.g, <Control-v>).
+ * argv[2..argc-1] contains -field/option pairs for specifying
+ * additional detail in the generated event.
+ *
+ * Either virtual or physical events can be generated this way.
+ * The event description string must contain the specification
+ * for only one event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When constructing the event,
+ * event.xany.serial is filled with the current X serial number.
+ * event.xany.window is filled with the target window.
+ * event.xany.display is filled with the target window's display.
+ * Any other fields in eventPtr which are not specified by the pattern
+ * string or the optional arguments, are set to 0.
+ *
+ * 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, argc, argv)
+ Tcl_Interp *interp; /* Interp for error messages and name lookup. */
+ Tk_Window mainwin; /* 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], mainwin);
+ 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(mainwin), (Window) i);
+ if ((tkwin == NULL) || (((TkWindow *) mainwin)->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) && (event.xany.type != MouseWheelEvent)) {
+ /*
+ * 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, mainwin);
+ 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, "-delta") == 0) {
+ if (Tcl_GetInt(interp, value, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((flags & KEY) && (event.xkey.type == MouseWheelEvent)) {
+ event.xkey.keycode = 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.type != MouseWheelEvent)) {
+ 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.type != MouseWheelEvent)) {
+ 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, mainwin);
+ 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, mainwin);
+ 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, mainwin);
+ 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.
+ *
+ *-------------------------------------------------------------------------
+ */
+static Tk_Uid
+GetVirtualEventUid(interp, virtString)
+ Tcl_Interp *interp;
+ char *virtString;
+{
+ Tk_Uid uid;
+ int length;
+
+ length = strlen(virtString);
+
+ if (length < 5 || virtString[0] != '<' || virtString[1] != '<' ||
+ virtString[length - 2] != '>' || virtString[length - 1] != '>') {
+ Tcl_AppendResult(interp, "virtual event \"", virtString,
+ "\" is badly formed", (char *) NULL);
+ return NULL;
+ }
+ virtString[length - 2] = '\0';
+ uid = Tk_GetUid(virtString + 2);
+ virtString[length - 2] = '>';
+
+ return uid;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindSequence --
+ *
+ * Find the entry in the pattern table that corresponds to a
+ * particular pattern string, and return a pointer to that
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static PatSeq *
+FindSequence(interp, patternTablePtr, object, eventString, create,
+ allowVirtual, maskPtr)
+ Tcl_Interp *interp; /* Interpreter to use for error
+ * reporting. */
+ Tcl_HashTable *patternTablePtr; /* Table to use for lookup. */
+ ClientData object; /* For binding table, token for object with
+ * which binding is associated.
+ * For virtual event table, NULL. */
+ char *eventString; /* String description of pattern to
+ * match on. See user documentation
+ * for details. */
+ int create; /* 0 means don't create the entry if
+ * it doesn't already exist. Non-zero
+ * means create. */
+ int allowVirtual; /* 0 means that virtual events are not
+ * allowed in the sequence. Non-zero
+ * otherwise. */
+ unsigned long *maskPtr; /* *maskPtr is filled in with the event
+ * types on which this pattern sequence
+ * depends. */
+{
+
+ Pattern pats[EVENT_BUFFER_SIZE];
+ int numPats, virtualFound;
+ char *p;
+ Pattern *patPtr;
+ PatSeq *psPtr;
+ Tcl_HashEntry *hPtr;
+ int flags, count, new;
+ size_t sequenceSize;
+ unsigned long eventMask;
+ PatternTableKey key;
+
+ /*
+ *-------------------------------------------------------------
+ * Step 1: parse the pattern string to produce an array
+ * of Patterns. The array is generated backwards, so
+ * that the lowest-indexed pattern corresponds to the last
+ * event that must occur.
+ *-------------------------------------------------------------
+ */
+
+ p = eventString;
+ flags = 0;
+ eventMask = 0;
+ virtualFound = 0;
+
+ patPtr = &pats[EVENT_BUFFER_SIZE-1];
+ for (numPats = 0; numPats < EVENT_BUFFER_SIZE; numPats++, patPtr--) {
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (*p == '\0') {
+ break;
+ }
+
+ 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.
+ */
+
+ if ((count > 1) && (numPats < EVENT_BUFFER_SIZE-1)) {
+ flags |= PAT_NEARBY;
+ patPtr[-1] = patPtr[0];
+ patPtr--;
+ numPats++;
+ if ((count == 3) && (numPats < EVENT_BUFFER_SIZE-1)) {
+ patPtr[-1] = patPtr[0];
+ patPtr--;
+ numPats++;
+ }
+ }
+ }
+
+ /*
+ *-------------------------------------------------------------
+ * 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;
+ key.detail = patPtr->detail;
+ hPtr = Tcl_CreateHashEntry(patternTablePtr, (char *) &key, &new);
+ sequenceSize = numPats*sizeof(Pattern);
+ if (!new) {
+ for (psPtr = (PatSeq *) Tcl_GetHashValue(hPtr); psPtr != NULL;
+ psPtr = psPtr->nextSeqPtr) {
+ if ((numPats == psPtr->numPats)
+ && ((flags & PAT_NEARBY) == (psPtr->flags & PAT_NEARBY))
+ && (memcmp((char *) patPtr, (char *) psPtr->pats,
+ sequenceSize) == 0)) {
+ goto done;
+ }
+ }
+ }
+ 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;
+ psPtr->clientData = NULL;
+ psPtr->flags = flags;
+ psPtr->refCount = 0;
+ psPtr->nextSeqPtr = (PatSeq *) Tcl_GetHashValue(hPtr);
+ psPtr->hPtr = hPtr;
+ psPtr->voPtr = NULL;
+ psPtr->nextObjPtr = NULL;
+ Tcl_SetHashValue(hPtr, psPtr);
+
+ memcpy((VOID *) psPtr->pats, (VOID *) patPtr, sequenceSize);
+
+ done:
+ *maskPtr = eventMask;
+ return psPtr;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ParseEventDescription --
+ *
+ * Fill Pattern buffer with information about event from
+ * event string.
+ *
+ * Results:
+ * Leaves error message in interp and returns 0 if there was an
+ * error due to a badly formed event string. Returns 1 if proper
+ * event was specified, 2 if Double modifier was used in event
+ * string, or 3 if Triple was used.
+ *
+ * Side effects:
+ * On exit, eventStringPtr points to rest of event string (after the
+ * closing '>', so that this procedure can be called repeatedly to
+ * parse all the events in the entire sequence.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+ParseEventDescription(interp, eventStringPtr, patPtr,
+ eventMaskPtr)
+ Tcl_Interp *interp; /* For error messages. */
+ char **eventStringPtr; /* On input, holds a pointer to start of
+ * event string. On exit, gets pointer to
+ * rest of string after parsed event. */
+ Pattern *patPtr; /* Filled with the pattern parsed from the
+ * event string. */
+ unsigned long *eventMaskPtr;/* Filled with event mask of matched event. */
+
+{
+ char *p;
+ unsigned long eventMask;
+ int count, eventFlags;
+#define FIELD_SIZE 48
+ char field[FIELD_SIZE];
+ Tcl_HashEntry *hPtr;
+
+ p = *eventStringPtr;
+
+ patPtr->eventType = -1;
+ patPtr->needMods = 0;
+ patPtr->detail.clientData = 0;
+
+ eventMask = 0;
+ count = 1;
+
+ /*
+ * Handle simple ASCII characters.
+ */
+
+ if (*p != '<') {
+ char string[2];
+
+ patPtr->eventType = KeyPress;
+ eventMask = KeyPressMask;
+ 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;
+ }
+
+ /*
+ * A fancier event description. This can be either a virtual event
+ * or a physical event.
+ *
+ * A virtual event description consists of:
+ *
+ * 1. double open angle brackets.
+ * 2. virtual event name.
+ * 3. double close angle brackets.
+ *
+ * A physical event description consists of:
+ *
+ * 1. open angle bracket.
+ * 2. any number of modifiers, each followed by spaces
+ * or dashes.
+ * 3. an optional event name.
+ * 4. an option button or keysym name. Either this or
+ * item 3 *must* be present; if both are present
+ * then they are separated by spaces or dashes.
+ * 5. a close angle bracket.
+ */
+
+ p++;
+ if (*p == '<') {
+ /*
+ * 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 = '>';
+
+ p += 2;
+ goto end;
+ }
+
+ while (1) {
+ ModInfo *modPtr;
+ p = GetField(p, field, FIELD_SIZE);
+ if (*p == '>') {
+ /*
+ * This solves the problem of, e.g., <Control-M> being
+ * misinterpreted as Control + Meta + missing keysym
+ * instead of Control + KeyPress + M.
+ */
+ break;
+ }
+ hPtr = Tcl_FindHashEntry(&modTable, field);
+ if (hPtr == NULL) {
+ break;
+ }
+ modPtr = (ModInfo *) Tcl_GetHashValue(hPtr);
+ patPtr->needMods |= modPtr->mask;
+ if (modPtr->flags & (DOUBLE|TRIPLE)) {
+ if (modPtr->flags & DOUBLE) {
+ count = 2;
+ } else {
+ count = 3;
+ }
+ }
+ while ((*p == '-') || isspace(UCHAR(*p))) {
+ p++;
+ }
+ }
+
+ eventFlags = 0;
+ hPtr = Tcl_FindHashEntry(&eventTable, field);
+ if (hPtr != NULL) {
+ EventInfo *eiPtr;
+ eiPtr = (EventInfo *) Tcl_GetHashValue(hPtr);
+
+ patPtr->eventType = eiPtr->type;
+ eventFlags = flagArray[eiPtr->type];
+ eventMask = eiPtr->eventMask;
+ while ((*p == '-') || isspace(UCHAR(*p))) {
+ p++;
+ }
+ p = GetField(p, field, FIELD_SIZE);
+ }
+ if (*field != '\0') {
+ if ((*field >= '1') && (*field <= '5') && (field[1] == '\0')) {
+ if (eventFlags == 0) {
+ patPtr->eventType = ButtonPress;
+ eventMask = ButtonPressMask;
+ } else if (eventFlags & KEY) {
+ goto getKeysym;
+ } else if ((eventFlags & BUTTON) == 0) {
+ Tcl_AppendResult(interp, "specified button \"", field,
+ "\" for non-button event", (char *) NULL);
+ return 0;
+ }
+ patPtr->detail.button = (*field - '0');
+ } else {
+ getKeysym:
+ patPtr->detail.keySym = TkStringToKeysym(field);
+ if (patPtr->detail.keySym == NoSymbol) {
+ Tcl_AppendResult(interp, "bad event type or keysym \"",
+ field, "\"", (char *) NULL);
+ return 0;
+ }
+ if (eventFlags == 0) {
+ patPtr->eventType = KeyPress;
+ eventMask = KeyPressMask;
+ } 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;
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetField --
+ *
+ * Used to parse pattern descriptions. Copies up to
+ * size characters from p to copy, stopping at end of
+ * string, space, "-", ">", or whenever size is
+ * exceeded.
+ *
+ * Results:
+ * The return value is a pointer to the character just
+ * after the last one copied (usually "-" or space or
+ * ">", but could be anything if size was exceeded).
+ * Also places NULL-terminated string (up to size
+ * character, including NULL), at copy.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+GetField(p, copy, size)
+ char *p; /* Pointer to part of pattern. */
+ char *copy; /* Place to copy field. */
+ int size; /* Maximum number of characters to
+ * copy. */
+{
+ while ((*p != '\0') && !isspace(UCHAR(*p)) && (*p != '>')
+ && (*p != '-') && (size > 1)) {
+ *copy = *p;
+ p++;
+ copy++;
+ size--;
+ }
+ *copy = '\0';
+ return p;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetPatternString --
+ *
+ * Produce a string version of the given event, for displaying to
+ * the user.
+ *
+ * Results:
+ * The string is left in dsPtr.
+ *
+ * Side effects:
+ * It is the caller's responsibility to initialize the DString before
+ * and to free it after calling this procedure.
+ *
+ *---------------------------------------------------------------------------
+ */
+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.
+ */
+
+ for (patsLeft = psPtr->numPats, patPtr = &psPtr->pats[psPtr->numPats - 1];
+ patsLeft > 0; patsLeft--, patPtr--) {
+
+ /*
+ * Check for simple case of an ASCII character.
+ */
+
+ if ((patPtr->eventType == KeyPress)
+ && ((psPtr->flags & PAT_NEARBY) == 0)
+ && (patPtr->needMods == 0)
+ && (patPtr->detail.keySym < 128)
+ && isprint(UCHAR(patPtr->detail.keySym))
+ && (patPtr->detail.keySym != '<')
+ && (patPtr->detail.keySym != ' ')) {
+
+ c = (char) patPtr->detail.keySym;
+ Tcl_DStringAppend(dsPtr, &c, 1);
+ continue;
+ }
+
+ /*
+ * Check for virtual event.
+ */
+
+ if (patPtr->eventType == VirtualEvent) {
+ Tcl_DStringAppend(dsPtr, "<<", 2);
+ Tcl_DStringAppend(dsPtr, patPtr->detail.name, -1);
+ Tcl_DStringAppend(dsPtr, ">>", 2);
+ continue;
+ }
+
+ /*
+ * It's a more general event specification. First check
+ * for "Double" or "Triple", then modifiers, then event type,
+ * then keysym or button detail.
+ */
+
+ Tcl_DStringAppend(dsPtr, "<", 1);
+ if ((psPtr->flags & PAT_NEARBY) && (patsLeft > 1)
+ && (memcmp((char *) patPtr, (char *) (patPtr-1),
+ sizeof(Pattern)) == 0)) {
+ patsLeft--;
+ patPtr--;
+ if ((patsLeft > 1) && (memcmp((char *) patPtr,
+ (char *) (patPtr-1), sizeof(Pattern)) == 0)) {
+ patsLeft--;
+ patPtr--;
+ Tcl_DStringAppend(dsPtr, "Triple-", 7);
+ } else {
+ Tcl_DStringAppend(dsPtr, "Double-", 7);
+ }
+ }
+ for (needMods = patPtr->needMods, modPtr = modArray;
+ needMods != 0; modPtr++) {
+ if (modPtr->mask & needMods) {
+ needMods &= ~modPtr->mask;
+ Tcl_DStringAppend(dsPtr, modPtr->name, -1);
+ Tcl_DStringAppend(dsPtr, "-", 1);
+ }
+ }
+ for (eiPtr = eventArray; eiPtr->name != NULL; eiPtr++) {
+ if (eiPtr->type == patPtr->eventType) {
+ Tcl_DStringAppend(dsPtr, eiPtr->name, -1);
+ if (patPtr->detail.clientData != 0) {
+ Tcl_DStringAppend(dsPtr, "-", 1);
+ }
+ break;
+ }
+ }
+
+ if (patPtr->detail.clientData != 0) {
+ if ((patPtr->eventType == KeyPress)
+ || (patPtr->eventType == KeyRelease)) {
+ char *string;
+
+ string = TkKeysymToString(patPtr->detail.keySym);
+ if (string != NULL) {
+ Tcl_DStringAppend(dsPtr, string, -1);
+ }
+ } else {
+ sprintf(buffer, "%d", patPtr->detail.button);
+ Tcl_DStringAppend(dsPtr, buffer, -1);
+ }
+ }
+ Tcl_DStringAppend(dsPtr, ">", 1);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetKeySym --
+ *
+ * Given an X KeyPress or KeyRelease event, map the
+ * keycode in the event into a KeySym.
+ *
+ * Results:
+ * The return value is the KeySym corresponding to
+ * eventPtr, or NoSymbol if no matching Keysym could be
+ * found.
+ *
+ * Side effects:
+ * In the first call for a given display, keycode-to-
+ * KeySym maps get loaded.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static KeySym
+GetKeySym(dispPtr, eventPtr)
+ TkDisplay *dispPtr; /* Display in which to
+ * map keycode. */
+ XEvent *eventPtr; /* Description of X event. */
+{
+ KeySym sym;
+ int index;
+
+ /*
+ * Refresh the mapping information if it's stale
+ */
+
+ if (dispPtr->bindInfoStale) {
+ InitKeymapInfo(dispPtr);
+ }
+
+ /*
+ * Figure out which of the four slots in the keymap vector to
+ * use for this key. Refer to Xlib documentation for more info
+ * on how this computation works.
+ */
+
+ index = 0;
+ if (eventPtr->xkey.state & dispPtr->modeModMask) {
+ index = 2;
+ }
+ if ((eventPtr->xkey.state & ShiftMask)
+ || ((dispPtr->lockUsage != LU_IGNORE)
+ && (eventPtr->xkey.state & LockMask))) {
+ index += 1;
+ }
+ sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode, index);
+
+ /*
+ * Special handling: if the key was shifted because of Lock, but
+ * lock is only caps lock, not shift lock, and the shifted keysym
+ * isn't upper-case alphabetic, then switch back to the unshifted
+ * keysym.
+ */
+
+ if ((index & 1) && !(eventPtr->xkey.state & ShiftMask)
+ && (dispPtr->lockUsage == LU_CAPS)) {
+ if (!(((sym >= XK_A) && (sym <= XK_Z))
+ || ((sym >= XK_Agrave) && (sym <= XK_Odiaeresis))
+ || ((sym >= XK_Ooblique) && (sym <= XK_Thorn)))) {
+ index &= ~1;
+ sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode,
+ index);
+ }
+ }
+
+ /*
+ * Another bit of special handling: if this is a shifted key and there
+ * is no keysym defined, then use the keysym for the unshifted key.
+ */
+
+ if ((index & 1) && (sym == NoSymbol)) {
+ sym = XKeycodeToKeysym(dispPtr->display, eventPtr->xkey.keycode,
+ index & ~1);
+ }
+ return sym;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * InitKeymapInfo --
+ *
+ * This procedure is invoked to scan keymap information
+ * to recompute stuff that's important for binding, such
+ * as the modifier key (if any) that corresponds to "mode
+ * switch".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Keymap-related information in dispPtr is updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+InitKeymapInfo(dispPtr)
+ TkDisplay *dispPtr; /* Display for which to recompute keymap
+ * information. */
+{
+ XModifierKeymap *modMapPtr;
+ KeyCode *codePtr;
+ KeySym keysym;
+ int count, i, j, max, arraySize;
+#define KEYCODE_ARRAY_SIZE 20
+
+ dispPtr->bindInfoStale = 0;
+ modMapPtr = XGetModifierMapping(dispPtr->display);
+
+ /*
+ * Check the keycodes associated with the Lock modifier. If
+ * any of them is associated with the XK_Shift_Lock modifier,
+ * then Lock has to be interpreted as Shift Lock, not Caps Lock.
+ */
+
+ dispPtr->lockUsage = LU_IGNORE;
+ codePtr = modMapPtr->modifiermap + modMapPtr->max_keypermod*LockMapIndex;
+ for (count = modMapPtr->max_keypermod; count > 0; count--, codePtr++) {
+ if (*codePtr == 0) {
+ continue;
+ }
+ keysym = XKeycodeToKeysym(dispPtr->display, *codePtr, 0);
+ if (keysym == XK_Shift_Lock) {
+ dispPtr->lockUsage = LU_SHIFT;
+ break;
+ }
+ if (keysym == XK_Caps_Lock) {
+ dispPtr->lockUsage = LU_CAPS;
+ break;
+ }
+ }
+
+ /*
+ * Look through the keycodes associated with modifiers to see if
+ * the the "mode switch", "meta", or "alt" keysyms are associated
+ * with any modifiers. If so, remember their modifier mask bits.
+ */
+
+ dispPtr->modeModMask = 0;
+ dispPtr->metaModMask = 0;
+ dispPtr->altModMask = 0;
+ codePtr = modMapPtr->modifiermap;
+ max = 8*modMapPtr->max_keypermod;
+ for (i = 0; i < max; i++, codePtr++) {
+ if (*codePtr == 0) {
+ continue;
+ }
+ keysym = XKeycodeToKeysym(dispPtr->display, *codePtr, 0);
+ if (keysym == XK_Mode_switch) {
+ dispPtr->modeModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
+ }
+ if ((keysym == XK_Meta_L) || (keysym == XK_Meta_R)) {
+ dispPtr->metaModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
+ }
+ if ((keysym == XK_Alt_L) || (keysym == XK_Alt_R)) {
+ dispPtr->altModMask |= ShiftMask << (i/modMapPtr->max_keypermod);
+ }
+ }
+
+ /*
+ * Create an array of the keycodes for all modifier keys.
+ */
+
+ if (dispPtr->modKeyCodes != NULL) {
+ ckfree((char *) dispPtr->modKeyCodes);
+ }
+ dispPtr->numModKeyCodes = 0;
+ arraySize = KEYCODE_ARRAY_SIZE;
+ dispPtr->modKeyCodes = (KeyCode *) ckalloc((unsigned)
+ (KEYCODE_ARRAY_SIZE * sizeof(KeyCode)));
+ for (i = 0, codePtr = modMapPtr->modifiermap; i < max; i++, codePtr++) {
+ if (*codePtr == 0) {
+ continue;
+ }
+
+ /*
+ * Make sure that the keycode isn't already in the array.
+ */
+
+ for (j = 0; j < dispPtr->numModKeyCodes; j++) {
+ if (dispPtr->modKeyCodes[j] == *codePtr) {
+ goto nextModCode;
+ }
+ }
+ if (dispPtr->numModKeyCodes >= arraySize) {
+ KeyCode *new;
+
+ /*
+ * Ran out of space in the array; grow it.
+ */
+
+ arraySize *= 2;
+ new = (KeyCode *) ckalloc((unsigned)
+ (arraySize * sizeof(KeyCode)));
+ memcpy((VOID *) new, (VOID *) dispPtr->modKeyCodes,
+ (dispPtr->numModKeyCodes * sizeof(KeyCode)));
+ ckfree((char *) dispPtr->modKeyCodes);
+ dispPtr->modKeyCodes = new;
+ }
+ dispPtr->modKeyCodes[dispPtr->numModKeyCodes] = *codePtr;
+ dispPtr->numModKeyCodes++;
+ nextModCode: continue;
+ }
+ XFreeModifiermap(modMapPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * EvalTclBinding --
+ *
+ * The procedure that is invoked by Tk_BindEvent when a Tcl binding
+ * is fired.
+ *
+ * Results:
+ * A standard Tcl result code, the result of globally evaluating the
+ * percent-substitued binding string.
+ *
+ * Side effects:
+ * Normal side effects due to eval.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+FreeTclBinding(clientData)
+ ClientData clientData;
+{
+ ckfree((char *) clientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkStringToKeysym --
+ *
+ * This procedure finds the keysym associated with a given keysym
+ * name.
+ *
+ * Results:
+ * The return value is the keysym that corresponds to name, or
+ * NoSymbol if there is no such keysym.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+KeySym
+TkStringToKeysym(name)
+ char *name; /* Name of a keysym. */
+{
+#ifdef REDO_KEYSYM_LOOKUP
+ Tcl_HashEntry *hPtr;
+ KeySym keysym;
+
+ hPtr = Tcl_FindHashEntry(&keySymTable, name);
+ if (hPtr != NULL) {
+ return (KeySym) Tcl_GetHashValue(hPtr);
+ }
+ if (strlen(name) == 1) {
+ keysym = (KeySym) (unsigned char) name[0];
+ if (TkKeysymToString(keysym) != NULL) {
+ return keysym;
+ }
+ }
+#endif /* REDO_KEYSYM_LOOKUP */
+ return XStringToKeysym(name);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkKeysymToString --
+ *
+ * This procedure finds the keysym name associated with a given
+ * keysym.
+ *
+ * Results:
+ * The return value is a pointer to a static string containing
+ * the name of the given keysym, or NULL if there is no known name.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkKeysymToString(keysym)
+ KeySym keysym;
+{
+#ifdef REDO_KEYSYM_LOOKUP
+ Tcl_HashEntry *hPtr;
+
+ hPtr = Tcl_FindHashEntry(&nameTable, (char *)keysym);
+ if (hPtr != NULL) {
+ return (char *) Tcl_GetHashValue(hPtr);
+ }
+#endif /* REDO_KEYSYM_LOOKUP */
+ return XKeysymToString(keysym);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCopyAndGlobalEval --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkCopyAndGlobalEval(interp, script)
+ Tcl_Interp *interp; /* Interpreter in which to evaluate
+ * script. */
+ char *script; /* Script to evaluate. */
+{
+ Tcl_DString buffer;
+ int code;
+
+ Tcl_DStringInit(&buffer);
+ Tcl_DStringAppend(&buffer, script, -1);
+ code = Tcl_GlobalEval(interp, Tcl_DStringValue(&buffer));
+ Tcl_DStringFree(&buffer);
+ return code;
+}
+
+
diff --git a/tk/generic/tkBitmap.c b/tk/generic/tkBitmap.c
new file mode 100644
index 00000000000..431fa56db42
--- /dev/null
+++ b/tk/generic/tkBitmap.c
@@ -0,0 +1,630 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The includes below are for pre-defined bitmaps.
+ *
+ * Platform-specific issue: Windows complains when the bitmaps are
+ * included, because an array of characters is being initialized with
+ * integers as elements. For lint purposes, the following pragmas
+ * temporarily turn off that warning message.
+ */
+
+#if defined(__WIN32__) || defined(_WIN32)
+#pragma warning (disable : 4305)
+#endif
+
+#include "error.bmp"
+#include "gray12.bmp"
+#include "gray25.bmp"
+#include "gray50.bmp"
+#include "gray75.bmp"
+#include "hourglass.bmp"
+#include "info.bmp"
+#include "questhead.bmp"
+#include "question.bmp"
+#include "warning.bmp"
+
+#if defined(__WIN32__) || defined(_WIN32)
+#pragma warning (default : 4305)
+#endif
+
+/*
+ * 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 = TkReadBitmapFile(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,
+ &width, &height);
+
+ if (bitmap == None) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "bitmap \"", string,
+ "\" not defined", (char *) NULL);
+ }
+ goto error;
+ }
+ } else {
+ predefPtr = (TkPredefBitmap *) Tcl_GetHashValue(predefHashPtr);
+ width = predefPtr->width;
+ height = predefPtr->height;
+ if (predefPtr->native) {
+ 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;
+ predefPtr->width = width;
+ predefPtr->height = height;
+ predefPtr->native = 0;
+ Tcl_SetHashValue(predefHashPtr, predefPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfBitmap --
+ *
+ * Given a bitmap, return a textual string identifying the
+ * bitmap.
+ *
+ * Results:
+ * The return value is the string name associated with bitmap.
+ *
+ * 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 --
+ *
+ * Given a bitmap managed by this module, returns the width
+ * and height of the bitmap.
+ *
+ * Results:
+ * The words at *widthPtr and *heightPtr are filled in with
+ * the dimenstions of bitmap.
+ *
+ * Side effects:
+ * If bitmap isn't managed by this module then the procedure
+ * panics..
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+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
+ * Tk_GetBitmap or TkGetBitmapFromData.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with bitmap is decremented, and
+ * it is officially deallocated if no-one is using it anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+Pixmap
+Tk_GetBitmapFromData(interp, tkwin, source, width, height)
+ 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
diff --git a/tk/generic/tkButton.c b/tk/generic/tkButton.c
new file mode 100644
index 00000000000..b493be03a0c
--- /dev/null
+++ b/tk/generic/tkButton.c
@@ -0,0 +1,1358 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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",
+ * "radiobutton", and "checkbutton" Tcl commands. See the
+ * user documentation for details on what they do.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * 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 --
+ *
+ * This procedure does all the real work of implementing 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+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 --
+ *
+ * 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
+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 --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Button will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkButtonWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+ TkButton *butPtr;
+
+ butPtr = (TkButton *) instanceData;
+
+ /*
+ * Recompute GCs.
+ */
+
+ gcValues.font = Tk_FontId(butPtr->tkfont);
+ gcValues.foreground = butPtr->normalFg->pixel;
+ gcValues.background = Tk_3DBorderColor(butPtr->normalBorder)->pixel;
+
+ /*
+ * Note: GraphicsExpose events are disabled in normalTextGC because it's
+ * used to copy stuff from an off-screen pixmap onto the screen (we know
+ * that there's no problem with obscured areas).
+ */
+
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures;
+ newGC = Tk_GetGCColor(butPtr->tkwin, mask, &gcValues,
+ butPtr->normalFg,
+ Tk_3DBorderColor(butPtr->normalBorder));
+ 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_GetGCColor(butPtr->tkwin, mask, &gcValues,
+ butPtr->activeFg,
+ Tk_3DBorderColor(butPtr->activeBorder));
+ if (butPtr->activeTextGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->activeTextGC);
+ }
+ butPtr->activeTextGC = newGC;
+ }
+
+ if (butPtr->type != TYPE_LABEL) {
+ XColor *foreground, *background;
+
+ gcValues.font = Tk_FontId(butPtr->tkfont);
+ background = Tk_3DBorderColor(butPtr->normalBorder);
+ gcValues.background = background->pixel;
+ if ((butPtr->disabledFg != NULL) && (butPtr->imageString == NULL)) {
+ foreground = butPtr->disabledFg;
+ gcValues.foreground = foreground->pixel;
+ mask = GCForeground | GCBackground | GCFont;
+ } else {
+ foreground = background;
+ background = NULL;
+ 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;
+ }
+ }
+ newGC = Tk_GetGCColor(butPtr->tkwin, mask, &gcValues, foreground,
+ background);
+ if (butPtr->disabledGC != None) {
+ Tk_FreeGC(butPtr->display, butPtr->disabledGC);
+ }
+ butPtr->disabledGC = newGC;
+ }
+
+ if (butPtr->copyGC == None) {
+ butPtr->copyGC = Tk_GetGC(butPtr->tkwin, 0, &gcValues);
+ }
+
+ TkpComputeButtonGeometry(butPtr);
+
+ /*
+ * Lastly, arrange for the button to be redisplayed.
+ */
+
+ if (Tk_IsMapped(butPtr->tkwin) && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on buttons.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ButtonEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkButton *butPtr = (TkButton *) clientData;
+ if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
+ goto redraw;
+ } else if (eventPtr->type == ConfigureNotify) {
+ /*
+ * 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;
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ butPtr->flags &= ~GOT_FOCUS;
+ if (butPtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ }
+ return;
+
+ redraw:
+ if ((butPtr->tkwin != NULL) && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ButtonCmdDeletedProc --
+ *
+ * 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
+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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonVarProc --
+ *
+ * This procedure is invoked when someone changes the
+ * state variable associated with a radio button. Depending
+ * on the new value of the button's variable, the button
+ * may be selected or deselected.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The button may become selected or deselected.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+ButtonVarProc(clientData, interp, name1, name2, flags)
+ 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 {
+ return (char *) NULL;
+ }
+
+ redisplay:
+ if ((butPtr->tkwin != NULL) && Tk_IsMapped(butPtr->tkwin)
+ && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+ return (char *) NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ButtonTextVarProc --
+ *
+ * This procedure is invoked when someone changes the variable
+ * whose contents are to be displayed in a button.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The text displayed in the button will change to match the
+ * variable.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ButtonImageProc(clientData, x, y, width, height, imgWidth, imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ register TkButton *butPtr = (TkButton *) clientData;
+
+ if (butPtr->tkwin != NULL) {
+ TkpComputeButtonGeometry(butPtr);
+ if (Tk_IsMapped(butPtr->tkwin) && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ButtonSelectImageProc(clientData, x, y, width, height, imgWidth, imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ register TkButton *butPtr = (TkButton *) clientData;
+
+ /*
+ * Don't recompute geometry: it's controlled by the primary image.
+ */
+
+ if ((butPtr->flags & SELECTED) && (butPtr->tkwin != NULL)
+ && Tk_IsMapped(butPtr->tkwin)
+ && !(butPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayButton, (ClientData) butPtr);
+ butPtr->flags |= REDRAW_PENDING;
+ }
+}
diff --git a/tk/generic/tkButton.h b/tk/generic/tkButton.h
new file mode 100644
index 00000000000..6236fc74c30
--- /dev/null
+++ b/tk/generic/tkButton.h
@@ -0,0 +1,249 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TKBUTTON
+#define _TKBUTTON
+
+#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
+ * 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
+ * numbers is significant: greater means more features and is
+ * used in the code.
+ */
+
+#define TYPE_LABEL 0
+#define TYPE_BUTTON 1
+#define TYPE_CHECK_BUTTON 2
+#define TYPE_RADIO_BUTTON 3
+
+/*
+ * Flag bits for buttons:
+ *
+ * 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));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKBUTTON */
diff --git a/tk/generic/tkCanvArc.c b/tk/generic/tkCanvArc.c
new file mode 100644
index 00000000000..cec4ef2b5fb
--- /dev/null
+++ b/tk/generic/tkCanvArc.c
@@ -0,0 +1,1717 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The structure below defines the record for each arc item.
+ */
+
+typedef struct ArcItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ double bbox[4]; /* Coordinates (x1, y1, x2, y2) of bounding
+ * box for oval of which arc is a piece. */
+ double start; /* Angle at which arc begins, in degrees
+ * between 0 and 360. */
+ double extent; /* Extent of arc (angular distance from
+ * start to end of arc) in degrees between
+ * -360 and 360. */
+ double *outlinePtr; /* Points to (x,y) coordinates for points
+ * that define one or two closed polygons
+ * representing the portion of the outline
+ * that isn't part of the arc (the V-shape
+ * for a pie slice or a line-like segment
+ * for a chord). Malloc'ed. */
+ int numOutlinePoints; /* Number of points at outlinePtr. Zero
+ * means no space allocated. */
+ int width; /* Width of outline (in pixels). */
+ XColor *outlineColor; /* Color for outline. NULL means don't
+ * draw outline. */
+ XColor *fillColor; /* Color for filling arc (used for drawing
+ * outline too when style is "arc"). NULL
+ * means don't fill arc. */
+ Pixmap fillStipple; /* Stipple bitmap for filling item. */
+ Pixmap outlineStipple; /* Stipple bitmap for outline. */
+ Tk_Uid style; /* How to draw arc: arc, chord, or pieslice. */
+ GC outlineGC; /* Graphics context for outline. */
+ GC fillGC; /* Graphics context for filling item. */
+ double center1[2]; /* Coordinates of center of arc outline at
+ * start (see ComputeArcOutline). */
+ double center2[2]; /* Coordinates of center of arc outline at
+ * start+extent (see ComputeArcOutline). */
+} ArcItem;
+
+/*
+ * The definitions below define the sizes of the polygons used to
+ * display outline information for various styles of arcs:
+ */
+
+#define CHORD_OUTLINE_PTS 7
+#define PIE_OUTLINE1_PTS 6
+#define PIE_OUTLINE2_PTS 7
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_DOUBLE, "-extent", (char *) NULL, (char *) NULL,
+ "90", Tk_Offset(ArcItem, extent), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, fillColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-outline", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(ArcItem, outlineColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-outlinestipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, outlineStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_DOUBLE, "-start", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(ArcItem, start), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ArcItem, fillStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_UID, "-style", (char *) NULL, (char *) NULL,
+ "pieslice", Tk_Offset(ArcItem, style), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "1", Tk_Offset(ArcItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static void ComputeArcBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ ArcItem *arcPtr));
+static int ConfigureArc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+static int CreateArc _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, char **argv));
+static void DeleteArc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayArc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static int ArcCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv));
+static int ArcToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double ArcToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *coordPtr));
+static int ArcToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static void ScaleArc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslateArc _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+static int AngleInRange _ANSI_ARGS_((double x, double y,
+ double start, double extent));
+static void ComputeArcOutline _ANSI_ARGS_((ArcItem *arcPtr));
+static int HorizLineToArc _ANSI_ARGS_((double x1, double x2,
+ double y, double rx, double ry,
+ double start, double extent));
+static int VertLineToArc _ANSI_ARGS_((double x, double y1,
+ double y2, double rx, double ry,
+ double start, double extent));
+
+/*
+ * The structures below defines the arc item types by means of procedures
+ * that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkArcType = {
+ "arc", /* name */
+ sizeof(ArcItem), /* itemSize */
+ CreateArc, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureArc, /* configureProc */
+ ArcCoords, /* coordProc */
+ DeleteArc, /* deleteProc */
+ DisplayArc, /* displayProc */
+ 0, /* alwaysRedraw */
+ ArcToPoint, /* pointProc */
+ ArcToArea, /* areaProc */
+ ArcToPostscript, /* postscriptProc */
+ ScaleArc, /* scaleProc */
+ TranslateArc, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* icursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) NULL, /* insertProc */
+ (Tk_ItemDCharsProc *) NULL, /* dTextProc */
+ (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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateArc(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 arc. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+
+ if (argc < 4) {
+ 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.
+ */
+
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &arcPtr->bbox[0]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1],
+ &arcPtr->bbox[1]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[2],
+ &arcPtr->bbox[2]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[3],
+ &arcPtr->bbox[3]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+
+ if (ConfigureArc(interp, canvas, itemPtr, argc-4, argv+4, 0) != TCL_OK) {
+ DeleteArc(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ArcCoords(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, ... */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ char c0[TCL_DOUBLE_SPACE], c1[TCL_DOUBLE_SPACE];
+ char c2[TCL_DOUBLE_SPACE], c3[TCL_DOUBLE_SPACE];
+
+ if (argc == 0) {
+ Tcl_PrintDouble(interp, arcPtr->bbox[0], c0);
+ Tcl_PrintDouble(interp, arcPtr->bbox[1], c1);
+ Tcl_PrintDouble(interp, arcPtr->bbox[2], c2);
+ Tcl_PrintDouble(interp, arcPtr->bbox[3], c3);
+ Tcl_AppendResult(interp, c0, " ", c1, " ", c2, " ", c3,
+ (char *) NULL);
+ } else if (argc == 4) {
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0],
+ &arcPtr->bbox[0]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1],
+ &arcPtr->bbox[1]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[2],
+ &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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureArc(interp, canvas, itemPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Arc item to reconfigure. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+ int i;
+ Tk_Window tkwin;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
+ (char *) arcPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as
+ * style and graphics contexts.
+ */
+
+ i = (int) (arcPtr->start/360.0);
+ 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) {
+ newGC = None;
+ } else {
+ gcValues.foreground = arcPtr->outlineColor->pixel;
+ gcValues.cap_style = CapButt;
+ gcValues.line_width = arcPtr->width;
+ mask = GCForeground|GCCapStyle|GCLineWidth;
+ if (arcPtr->outlineStipple != None) {
+ gcValues.stipple = arcPtr->outlineStipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ newGC = Tk_GetGCColor(tkwin, mask, &gcValues, arcPtr->outlineColor,
+ NULL);
+ }
+ 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;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ newGC = Tk_GetGCColor(tkwin, mask, &gcValues, arcPtr->fillColor, NULL);
+ }
+ if (arcPtr->fillGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), arcPtr->fillGC);
+ }
+ arcPtr->fillGC = newGC;
+
+ ComputeArcBbox(canvas, arcPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteArc --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a arc item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteArc(canvas, itemPtr, display)
+ Tk_Canvas canvas; /* Info about overall canvas. */
+ Tk_Item *itemPtr; /* Item that is being deleted. */
+ Display *display; /* Display containing window for
+ * canvas. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+
+ if (arcPtr->numOutlinePoints != 0) {
+ ckfree((char *) arcPtr->outlinePtr);
+ }
+ if (arcPtr->outlineColor != NULL) {
+ Tk_FreeColor(arcPtr->outlineColor);
+ }
+ if (arcPtr->fillColor != NULL) {
+ Tk_FreeColor(arcPtr->fillColor);
+ }
+ if (arcPtr->fillStipple != None) {
+ Tk_FreeBitmap(display, arcPtr->fillStipple);
+ }
+ if (arcPtr->outlineStipple != None) {
+ Tk_FreeBitmap(display, arcPtr->outlineStipple);
+ }
+ if (arcPtr->outlineGC != None) {
+ Tk_FreeGC(display, arcPtr->outlineGC);
+ }
+ if (arcPtr->fillGC != None) {
+ Tk_FreeGC(display, arcPtr->fillGC);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeArcBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of an arc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ComputeArcBbox(canvas, arcPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ ArcItem *arcPtr; /* Item whose bbox is to be
+ * recomputed. */
+{
+ double tmp, center[2], point[2];
+
+ /*
+ * Make sure that the first coordinates are the lowest ones.
+ */
+
+ if (arcPtr->bbox[1] > arcPtr->bbox[3]) {
+ double tmp;
+ tmp = arcPtr->bbox[3];
+ arcPtr->bbox[3] = arcPtr->bbox[1];
+ arcPtr->bbox[1] = tmp;
+ }
+ if (arcPtr->bbox[0] > arcPtr->bbox[2]) {
+ double tmp;
+ tmp = arcPtr->bbox[2];
+ arcPtr->bbox[2] = arcPtr->bbox[0];
+ arcPtr->bbox[0] = tmp;
+ }
+
+ ComputeArcOutline(arcPtr);
+
+ /*
+ * To compute the bounding box, start with the the bbox formed
+ * by the two endpoints of the arc. Then add in the center of
+ * the arc's oval (if relevant) and the 3-o'clock, 6-o'clock,
+ * 9-o'clock, and 12-o'clock positions, if they are relevant.
+ */
+
+ 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 == pieSliceUid) {
+ TkIncludePoint((Tk_Item *) arcPtr, center);
+ }
+
+ tmp = -arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ point[0] = arcPtr->bbox[2];
+ point[1] = center[1];
+ TkIncludePoint((Tk_Item *) arcPtr, point);
+ }
+ tmp = 90.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ point[0] = center[0];
+ point[1] = arcPtr->bbox[1];
+ TkIncludePoint((Tk_Item *) arcPtr, point);
+ }
+ tmp = 180.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ point[0] = arcPtr->bbox[0];
+ point[1] = center[1];
+ TkIncludePoint((Tk_Item *) arcPtr, point);
+ }
+ tmp = 270.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ point[0] = center[0];
+ point[1] = arcPtr->bbox[3];
+ TkIncludePoint((Tk_Item *) arcPtr, point);
+ }
+
+ /*
+ * Lastly, expand by the width of the arc (if the arc's outline is
+ * being drawn) and add one extra pixel just for safety.
+ */
+
+ if (arcPtr->outlineColor == NULL) {
+ tmp = 1;
+ } else {
+ tmp = (arcPtr->width + 1)/2 + 1;
+ }
+ arcPtr->header.x1 -= (int) tmp;
+ arcPtr->header.y1 -= (int) tmp;
+ arcPtr->header.x2 += (int) tmp;
+ arcPtr->header.y2 += (int) tmp;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayArc --
+ *
+ * This procedure is invoked to draw an arc item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayArc(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). */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ short x1, y1, x2, y2;
+ int start, extent;
+
+ /*
+ * Compute the screen coordinates of the bounding box for the item,
+ * plus integer values for the angles.
+ */
+
+ Tk_CanvasDrawableCoords(canvas, arcPtr->bbox[0], arcPtr->bbox[1],
+ &x1, &y1);
+ Tk_CanvasDrawableCoords(canvas, arcPtr->bbox[2], arcPtr->bbox[3],
+ &x2, &y2);
+ if (x2 <= x1) {
+ x2 = x1+1;
+ }
+ if (y2 <= y1) {
+ y2 = y1+1;
+ }
+ start = (int) ((64*arcPtr->start) + 0.5);
+ extent = (int) ((64*arcPtr->extent) + 0.5);
+
+ /*
+ * Display filled arc first (if wanted), then outline. If the extent
+ * is zero then don't invoke XFillArc or XDrawArc, since this causes
+ * some window servers to crash and should be a no-op anyway.
+ */
+
+ if ((arcPtr->fillGC != None) && (extent != 0)) {
+ if (arcPtr->fillStipple != None) {
+ Tk_CanvasSetStippleOrigin(canvas, arcPtr->fillGC);
+ }
+ XFillArc(display, drawable, arcPtr->fillGC, x1, y1, (unsigned) (x2-x1),
+ (unsigned) (y2-y1), start, extent);
+ if (arcPtr->fillStipple != None) {
+ XSetTSOrigin(display, arcPtr->fillGC, 0, 0);
+ }
+ }
+ if (arcPtr->outlineGC != None) {
+ if (arcPtr->outlineStipple != None) {
+ Tk_CanvasSetStippleOrigin(canvas, arcPtr->outlineGC);
+ }
+ if (extent != 0) {
+ XDrawArc(display, drawable, arcPtr->outlineGC, x1, y1,
+ (unsigned) (x2-x1), (unsigned) (y2-y1), start, extent);
+ }
+
+ /*
+ * If the outline width is very thin, don't use polygons to draw
+ * the linear parts of the outline (this often results in nothing
+ * being displayed); just draw lines instead.
+ */
+
+ 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);
+ }
+ }
+ if (arcPtr->outlineStipple != None) {
+ XSetTSOrigin(display, arcPtr->outlineGC, 0, 0);
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArcToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * arc, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are coordPtr[0] and coordPtr[1] is inside the arc. If the
+ * point isn't inside the arc then the return value is the
+ * distance from the point to the arc. If itemPtr is filled,
+ * then anywhere in the interior is considered "inside"; if
+ * itemPtr isn't filled, then "inside" means only the area
+ * occupied by the outline.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+ArcToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ double vertex[2], pointAngle, diff, dist, newDist;
+ double poly[8], polyDist, width, t1, t2;
+ int filled, angleInRange;
+
+ /*
+ * See if the point is within the angular range of the arc.
+ * Remember, X angles are backwards from the way we'd normally
+ * think of them. Also, compensate for any eccentricity of
+ * the oval.
+ */
+
+ vertex[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0;
+ vertex[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0;
+ t1 = (pointPtr[1] - vertex[1])/(arcPtr->bbox[3] - arcPtr->bbox[1]);
+ t2 = (pointPtr[0] - vertex[0])/(arcPtr->bbox[2] - arcPtr->bbox[0]);
+ if ((t1 == 0.0) && (t2 == 0.0)) {
+ pointAngle = 0;
+ } else {
+ pointAngle = -atan2(t1, t2)*180/PI;
+ }
+ diff = pointAngle - arcPtr->start;
+ diff -= ((int) (diff/360.0) * 360.0);
+ if (diff < 0) {
+ diff += 360.0;
+ }
+ angleInRange = (diff <= arcPtr->extent) ||
+ ((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],
+ pointPtr[1] - arcPtr->center2[1]);
+ if (newDist < dist) {
+ return newDist;
+ }
+ return dist;
+ }
+
+ if ((arcPtr->fillGC != None) || (arcPtr->outlineGC == None)) {
+ filled = 1;
+ } else {
+ filled = 0;
+ }
+ 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);
+ newDist = TkLineToPoint(vertex, arcPtr->center2, pointPtr);
+ }
+ if (newDist < dist) {
+ dist = newDist;
+ }
+ if (angleInRange) {
+ newDist = TkOvalToPoint(arcPtr->bbox, width, filled, pointPtr);
+ if (newDist < dist) {
+ dist = newDist;
+ }
+ }
+ return dist;
+ }
+
+ /*
+ * This is a chord-style arc. We have to deal specially with the
+ * triangular piece that represents the difference between a
+ * chord-style arc and a pie-slice arc (for small angles this piece
+ * is excluded here where it would be included for pie slices;
+ * for large angles the piece is included here but would be
+ * excluded for pie slices).
+ */
+
+ if (width > 1.0) {
+ dist = TkPolygonToPoint(arcPtr->outlinePtr, CHORD_OUTLINE_PTS,
+ pointPtr);
+ } else {
+ dist = TkLineToPoint(arcPtr->center1, arcPtr->center2, pointPtr);
+ }
+ poly[0] = poly[6] = vertex[0];
+ poly[1] = poly[7] = vertex[1];
+ poly[2] = arcPtr->center1[0];
+ poly[3] = arcPtr->center1[1];
+ poly[4] = arcPtr->center2[0];
+ poly[5] = arcPtr->center2[1];
+ polyDist = TkPolygonToPoint(poly, 4, pointPtr);
+ if (angleInRange) {
+ if ((arcPtr->extent < -180.0) || (arcPtr->extent > 180.0)
+ || (polyDist > 0.0)) {
+ newDist = TkOvalToPoint(arcPtr->bbox, width, filled, pointPtr);
+ if (newDist < dist) {
+ dist = newDist;
+ }
+ }
+ } else {
+ if ((arcPtr->extent < -180.0) || (arcPtr->extent > 180.0)) {
+ if (filled && (polyDist < dist)) {
+ dist = polyDist;
+ }
+ }
+ }
+ return dist;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArcToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given area.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ArcToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against arc. */
+ double *rectPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ double rx, ry; /* Radii for transformed oval: these define
+ * an oval centered at the origin. */
+ double tRect[4]; /* Transformed version of x1, y1, x2, y2,
+ * for coord. system where arc is centered
+ * on the origin. */
+ double center[2], width, angle, tmp;
+ double points[20], *pointPtr;
+ int numPoints, filled;
+ int inside; /* Non-zero means every test so far suggests
+ * that arc is inside rectangle. 0 means
+ * every test so far shows arc to be outside
+ * of rectangle. */
+ int newInside;
+
+ if ((arcPtr->fillGC != None) || (arcPtr->outlineGC == None)) {
+ filled = 1;
+ } else {
+ filled = 0;
+ }
+ if (arcPtr->outlineGC == None) {
+ width = 0.0;
+ } else {
+ width = arcPtr->width;
+ }
+
+ /*
+ * Transform both the arc and the rectangle so that the arc's oval
+ * is centered on the origin.
+ */
+
+ center[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0;
+ center[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0;
+ tRect[0] = rectPtr[0] - center[0];
+ tRect[1] = rectPtr[1] - center[1];
+ tRect[2] = rectPtr[2] - center[0];
+ tRect[3] = rectPtr[3] - center[1];
+ rx = arcPtr->bbox[2] - center[0] + width/2.0;
+ ry = arcPtr->bbox[3] - center[1] + width/2.0;
+
+ /*
+ * Find the extreme points of the arc and see whether these are all
+ * inside the rectangle (in which case we're done), partly in and
+ * partly out (in which case we're done), or all outside (in which
+ * case we have more work to do). The extreme points include the
+ * following, which are checked in order:
+ *
+ * 1. The outside points of the arc, corresponding to start and
+ * extent.
+ * 2. The center of the arc (but only in pie-slice mode).
+ * 3. The 12, 3, 6, and 9-o'clock positions (but only if the arc
+ * includes those angles).
+ */
+
+ pointPtr = points;
+ angle = -arcPtr->start*(PI/180.0);
+ pointPtr[0] = rx*cos(angle);
+ 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;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ pointPtr[0] = rx;
+ pointPtr[1] = 0.0;
+ numPoints++;
+ pointPtr += 2;
+ }
+ tmp = 90.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ pointPtr[0] = 0.0;
+ pointPtr[1] = -ry;
+ numPoints++;
+ pointPtr += 2;
+ }
+ tmp = 180.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ pointPtr[0] = -rx;
+ pointPtr[1] = 0.0;
+ numPoints++;
+ pointPtr += 2;
+ }
+ tmp = 270.0 - arcPtr->start;
+ if (tmp < 0) {
+ tmp += 360.0;
+ }
+ if ((tmp < arcPtr->extent) || ((tmp-360) > arcPtr->extent)) {
+ pointPtr[0] = 0.0;
+ pointPtr[1] = ry;
+ numPoints++;
+ }
+
+ /*
+ * Now that we've located the extreme points, loop through them all
+ * to see which are inside the rectangle.
+ */
+
+ inside = (points[0] > tRect[0]) && (points[0] < tRect[2])
+ && (points[1] > tRect[1]) && (points[1] < tRect[3]);
+ for (pointPtr = points+2; numPoints > 1; pointPtr += 2, numPoints--) {
+ newInside = (pointPtr[0] > tRect[0]) && (pointPtr[0] < tRect[2])
+ && (pointPtr[1] > tRect[1]) && (pointPtr[1] < tRect[3]);
+ if (newInside != inside) {
+ return 0;
+ }
+ }
+
+ if (inside) {
+ return 1;
+ }
+
+ /*
+ * 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,
+ rectPtr) != -1) {
+ return 0;
+ }
+ }
+ }
+
+ /*
+ * Next check for overlap between each of the four sides and the
+ * outer perimiter of the arc. If the arc isn't filled, then also
+ * check the inner perimeter of the arc.
+ */
+
+ if (HorizLineToArc(tRect[0], tRect[2], tRect[1], rx, ry, arcPtr->start,
+ arcPtr->extent)
+ || HorizLineToArc(tRect[0], tRect[2], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)
+ || VertLineToArc(tRect[0], tRect[1], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)
+ || VertLineToArc(tRect[2], tRect[1], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)) {
+ return 0;
+ }
+ if ((width > 1.0) && !filled) {
+ rx -= width;
+ ry -= width;
+ if (HorizLineToArc(tRect[0], tRect[2], tRect[1], rx, ry, arcPtr->start,
+ arcPtr->extent)
+ || HorizLineToArc(tRect[0], tRect[2], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)
+ || VertLineToArc(tRect[0], tRect[1], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)
+ || VertLineToArc(tRect[2], tRect[1], tRect[3], rx, ry,
+ arcPtr->start, arcPtr->extent)) {
+ return 0;
+ }
+ }
+
+ /*
+ * The arc still appears to be totally disjoint from the rectangle,
+ * but it's also possible that the rectangle is totally inside the arc.
+ * Do one last check, which is to check one point of the rectangle
+ * to see if it's inside the arc. If it is, we've got overlap. If
+ * it isn't, the arc's really outside the rectangle.
+ */
+
+ if (ArcToPoint(canvas, itemPtr, rectPtr) == 0.0) {
+ return 0;
+ }
+ return -1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleArc --
+ *
+ * This procedure is invoked to rescale an arc item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The arc referred to by itemPtr is rescaled so that the
+ * following transformation is applied to all point
+ * coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleArc(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing arc. */
+ Tk_Item *itemPtr; /* Arc 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. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+
+ arcPtr->bbox[0] = originX + scaleX*(arcPtr->bbox[0] - originX);
+ arcPtr->bbox[1] = originY + scaleY*(arcPtr->bbox[1] - originY);
+ arcPtr->bbox[2] = originX + scaleX*(arcPtr->bbox[2] - originX);
+ arcPtr->bbox[3] = originY + scaleY*(arcPtr->bbox[3] - originY);
+ ComputeArcBbox(canvas, arcPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateArc --
+ *
+ * This procedure is called to move an arc by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the arc is offset by (xDelta, yDelta), and
+ * the bounding box is updated in the generic part of the item
+ * structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateArc(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. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+
+ arcPtr->bbox[0] += deltaX;
+ arcPtr->bbox[1] += deltaY;
+ arcPtr->bbox[2] += deltaX;
+ arcPtr->bbox[3] += deltaY;
+ ComputeArcBbox(canvas, arcPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeArcOutline --
+ *
+ * This procedure creates a polygon describing everything in
+ * the outline for an arc except what's in the curved part.
+ * For a "pie slice" arc this is a V-shaped chunk, and for
+ * a "chord" arc this is a linear chunk (with cutaway corners).
+ * For "arc" arcs, this stuff isn't relevant.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The information at arcPtr->outlinePtr gets modified, and
+ * storage for arcPtr->outlinePtr may be allocated or freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeArcOutline(arcPtr)
+ ArcItem *arcPtr; /* Information about arc. */
+{
+ double sin1, cos1, sin2, cos2, angle, halfWidth;
+ double boxWidth, boxHeight;
+ double vertex[2], corner1[2], corner2[2];
+ double *outlinePtr;
+
+ /*
+ * Make sure that the outlinePtr array is large enough to hold
+ * either a chord or pie-slice outline.
+ */
+
+ if (arcPtr->numOutlinePoints == 0) {
+ arcPtr->outlinePtr = (double *) ckalloc((unsigned)
+ (26 * sizeof(double)));
+ arcPtr->numOutlinePoints = 22;
+ }
+ outlinePtr = arcPtr->outlinePtr;
+
+ /*
+ * First compute the two points that lie at the centers of
+ * the ends of the curved arc segment, which are marked with
+ * X's in the figure below:
+ *
+ *
+ * * * *
+ * * *
+ * * * * *
+ * * * * *
+ * * * * *
+ * X * * X
+ *
+ * The code is tricky because the arc can be ovular in shape.
+ * It computes the position for a unit circle, and then
+ * scales to fit the shape of the arc's bounding box.
+ *
+ * Also, watch out because angles go counter-clockwise like you
+ * might expect, but the y-coordinate system is inverted. To
+ * handle this, just negate the angles in all the computations.
+ */
+
+ boxWidth = arcPtr->bbox[2] - arcPtr->bbox[0];
+ boxHeight = arcPtr->bbox[3] - arcPtr->bbox[1];
+ angle = -arcPtr->start*PI/180.0;
+ sin1 = sin(angle);
+ cos1 = cos(angle);
+ angle -= arcPtr->extent*PI/180.0;
+ sin2 = sin(angle);
+ cos2 = cos(angle);
+ vertex[0] = (arcPtr->bbox[0] + arcPtr->bbox[2])/2.0;
+ vertex[1] = (arcPtr->bbox[1] + arcPtr->bbox[3])/2.0;
+ arcPtr->center1[0] = vertex[0] + cos1*boxWidth/2.0;
+ arcPtr->center1[1] = vertex[1] + sin1*boxHeight/2.0;
+ arcPtr->center2[0] = vertex[0] + cos2*boxWidth/2.0;
+ arcPtr->center2[1] = vertex[1] + sin2*boxHeight/2.0;
+
+ /*
+ * Next compute the "outermost corners" of the arc, which are
+ * marked with X's in the figure below:
+ *
+ * * * *
+ * * *
+ * * * * *
+ * * * * *
+ * X * * X
+ * * *
+ *
+ * The code below is tricky because it has to handle eccentricity
+ * in the shape of the oval. The key in the code below is to
+ * realize that the slope of the line from arcPtr->center1 to corner1
+ * is (boxWidth*sin1)/(boxHeight*cos1), and similarly for arcPtr->center2
+ * and corner2. These formulas can be computed from the formula for
+ * the oval.
+ */
+
+ halfWidth = arcPtr->width/2.0;
+ if (((boxWidth*sin1) == 0.0) && ((boxHeight*cos1) == 0.0)) {
+ angle = 0.0;
+ } else {
+ angle = atan2(boxWidth*sin1, boxHeight*cos1);
+ }
+ corner1[0] = arcPtr->center1[0] + cos(angle)*halfWidth;
+ corner1[1] = arcPtr->center1[1] + sin(angle)*halfWidth;
+ if (((boxWidth*sin2) == 0.0) && ((boxHeight*cos2) == 0.0)) {
+ angle = 0.0;
+ } else {
+ angle = atan2(boxWidth*sin2, boxHeight*cos2);
+ }
+ corner2[0] = arcPtr->center2[0] + cos(angle)*halfWidth;
+ corner2[1] = arcPtr->center2[1] + sin(angle)*halfWidth;
+
+ /*
+ * 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:
+ *
+ * _____________________
+ * | \
+ * | \
+ * X Y Z
+ * | /
+ * |_____________________/
+ *
+ */
+
+ TkGetButtPoints(arcPtr->center1, vertex, (double) arcPtr->width, 0,
+ outlinePtr, outlinePtr+2);
+ outlinePtr[4] = arcPtr->center1[0] + outlinePtr[2] - vertex[0];
+ outlinePtr[5] = arcPtr->center1[1] + outlinePtr[3] - vertex[1];
+ outlinePtr[6] = corner1[0];
+ outlinePtr[7] = corner1[1];
+ outlinePtr[8] = arcPtr->center1[0] + outlinePtr[0] - vertex[0];
+ outlinePtr[9] = arcPtr->center1[1] + outlinePtr[1] - vertex[1];
+ outlinePtr[10] = outlinePtr[0];
+ outlinePtr[11] = outlinePtr[1];
+
+ /*
+ * The second arm has a shape like this:
+ *
+ *
+ * ______________________
+ * / \
+ * / \
+ * Z Y X /
+ * \ /
+ * \______________________/
+ *
+ * Similar to above X is the center of the oval/circle, Y is
+ * arcPtr->center2, and Z is corner2. The extra jog out to the left
+ * of X is needed in or to produce a butted joint with the
+ * first arm; the corner to the right of X is one of the
+ * first two points of the first arm, depending on extent.
+ */
+
+ TkGetButtPoints(arcPtr->center2, vertex, (double) arcPtr->width, 0,
+ outlinePtr+12, outlinePtr+16);
+ if ((arcPtr->extent > 180) ||
+ ((arcPtr->extent < 0) && (arcPtr->extent > -180))) {
+ outlinePtr[14] = outlinePtr[0];
+ outlinePtr[15] = outlinePtr[1];
+ } else {
+ outlinePtr[14] = outlinePtr[2];
+ outlinePtr[15] = outlinePtr[3];
+ }
+ outlinePtr[18] = arcPtr->center2[0] + outlinePtr[16] - vertex[0];
+ outlinePtr[19] = arcPtr->center2[1] + outlinePtr[17] - vertex[1];
+ outlinePtr[20] = corner2[0];
+ outlinePtr[21] = corner2[1];
+ outlinePtr[22] = arcPtr->center2[0] + outlinePtr[12] - vertex[0];
+ outlinePtr[23] = arcPtr->center2[1] + outlinePtr[13] - vertex[1];
+ outlinePtr[24] = outlinePtr[12];
+ outlinePtr[25] = outlinePtr[13];
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * HorizLineToArc --
+ *
+ * Determines whether a horizontal line segment intersects
+ * a given arc.
+ *
+ * Results:
+ * The return value is 1 if the given line intersects the
+ * infinitely-thin arc section defined by rx, ry, start,
+ * and extent, and 0 otherwise. Only the perimeter of the
+ * arc is checked: interior areas (e.g. pie-slice or chord)
+ * are not checked.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+HorizLineToArc(x1, x2, y, rx, ry, start, extent)
+ double x1, x2; /* X-coords of endpoints of line segment.
+ * X1 must be <= x2. */
+ double y; /* Y-coordinate of line segment. */
+ double rx, ry; /* These x- and y-radii define an oval
+ * centered at the origin. */
+ double start, extent; /* Angles that define extent of arc, in
+ * the standard fashion for this module. */
+{
+ double tmp;
+ double tx, ty; /* Coordinates of intersection point in
+ * transformed coordinate system. */
+ double x;
+
+ /*
+ * Compute the x-coordinate of one possible intersection point
+ * between the arc and the line. Use a transformed coordinate
+ * system where the oval is a unit circle centered at the origin.
+ * Then scale back to get actual x-coordinate.
+ */
+
+ ty = y/ry;
+ tmp = 1 - ty*ty;
+ if (tmp < 0) {
+ return 0;
+ }
+ tx = sqrt(tmp);
+ x = tx*rx;
+
+ /*
+ * Test both intersection points.
+ */
+
+ if ((x >= x1) && (x <= x2) && AngleInRange(tx, ty, start, extent)) {
+ return 1;
+ }
+ if ((-x >= x1) && (-x <= x2) && AngleInRange(-tx, ty, start, extent)) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * VertLineToArc --
+ *
+ * Determines whether a vertical line segment intersects
+ * a given arc.
+ *
+ * Results:
+ * The return value is 1 if the given line intersects the
+ * infinitely-thin arc section defined by rx, ry, start,
+ * and extent, and 0 otherwise. Only the perimeter of the
+ * arc is checked: interior areas (e.g. pie-slice or chord)
+ * are not checked.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+VertLineToArc(x, y1, y2, rx, ry, start, extent)
+ double x; /* X-coordinate of line segment. */
+ double y1, y2; /* Y-coords of endpoints of line segment.
+ * Y1 must be <= y2. */
+ double rx, ry; /* These x- and y-radii define an oval
+ * centered at the origin. */
+ double start, extent; /* Angles that define extent of arc, in
+ * the standard fashion for this module. */
+{
+ double tmp;
+ double tx, ty; /* Coordinates of intersection point in
+ * transformed coordinate system. */
+ double y;
+
+ /*
+ * Compute the y-coordinate of one possible intersection point
+ * between the arc and the line. Use a transformed coordinate
+ * system where the oval is a unit circle centered at the origin.
+ * Then scale back to get actual y-coordinate.
+ */
+
+ tx = x/rx;
+ tmp = 1 - tx*tx;
+ if (tmp < 0) {
+ return 0;
+ }
+ ty = sqrt(tmp);
+ y = ty*ry;
+
+ /*
+ * Test both intersection points.
+ */
+
+ if ((y > y1) && (y < y2) && AngleInRange(tx, ty, start, extent)) {
+ return 1;
+ }
+ if ((-y > y1) && (-y < y2) && AngleInRange(tx, -ty, start, extent)) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AngleInRange --
+ *
+ * Determine whether the angle from the origin to a given
+ * point is within a given range.
+ *
+ * Results:
+ * The return value is 1 if the angle from (0,0) to (x,y)
+ * is in the range given by start and extent, where angles
+ * are interpreted in the standard way for ovals (meaning
+ * backwards from normal interpretation). Otherwise the
+ * return value is 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+AngleInRange(x, y, start, extent)
+ double x, y; /* Coordinate of point; angle measured
+ * from origin to here, relative to x-axis. */
+ double start; /* First angle, degrees, >=0, <=360. */
+ double extent; /* Size of arc in degrees >=-360, <=360. */
+{
+ double diff;
+
+ if ((x == 0.0) && (y == 0.0)) {
+ return 1;
+ }
+ diff = -atan2(y, x);
+ diff = diff*(180.0/PI) - start;
+ while (diff > 360.0) {
+ diff -= 360.0;
+ }
+ while (diff < 0.0) {
+ diff += 360.0;
+ }
+ if (extent >= 0) {
+ return diff <= extent;
+ }
+ return (diff-360.0) >= extent;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArcToPostscript --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ArcToPostscript(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. */
+{
+ ArcItem *arcPtr = (ArcItem *) itemPtr;
+ char buffer[400];
+ double y1, y2, ang1, ang2;
+
+ y1 = Tk_CanvasPsY(canvas, arcPtr->bbox[1]);
+ y2 = Tk_CanvasPsY(canvas, arcPtr->bbox[3]);
+ ang1 = arcPtr->start;
+ ang2 = ang1 + arcPtr->extent;
+ if (ang2 < ang1) {
+ ang1 = ang2;
+ ang2 = arcPtr->start;
+ }
+
+ /*
+ * If the arc is filled, output Postscript for the interior region
+ * of the arc.
+ */
+
+ 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);
+ }
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, arcPtr->fillColor) != TCL_OK) {
+ return TCL_ERROR;
+ };
+ if (arcPtr->fillStipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, arcPtr->fillStipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (arcPtr->outlineGC != None) {
+ Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ }
+
+ /*
+ * If there's an outline for the arc, draw it.
+ */
+
+ if (arcPtr->outlineGC != 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);
+ sprintf(buffer, "0 0 1 %.15g %.15g arc\nsetmatrix\n", ang1, ang2);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ sprintf(buffer, "%d setlinewidth\n0 setlinecap\n", arcPtr->width);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, arcPtr->outlineColor)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (arcPtr->outlineStipple != None) {
+ Tcl_AppendResult(interp, "StrokeClip ", (char *) NULL);
+ 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) {
+ return TCL_ERROR;
+ }
+ if (arcPtr->outlineStipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas,
+ arcPtr->outlineStipple) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
+ Tk_CanvasPsPath(interp, canvas,
+ arcPtr->outlinePtr + 2*PIE_OUTLINE1_PTS,
+ PIE_OUTLINE2_PTS);
+ }
+ if (Tk_CanvasPsColor(interp, canvas, arcPtr->outlineColor)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (arcPtr->outlineStipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas,
+ arcPtr->outlineStipple) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ }
+ }
+
+ return TCL_OK;
+}
diff --git a/tk/generic/tkCanvBmap.c b/tk/generic/tkCanvBmap.c
new file mode 100644
index 00000000000..74087e2db57
--- /dev/null
+++ b/tk/generic/tkCanvBmap.c
@@ -0,0 +1,801 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each bitmap item.
+ */
+
+typedef struct BitmapItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ double x, y; /* Coordinates of positioning point for
+ * bitmap. */
+ Tk_Anchor anchor; /* Where to anchor bitmap relative to
+ * (x,y). */
+ Pixmap bitmap; /* Bitmap to display in window. */
+ XColor *fgColor; /* Foreground color to use for bitmap. */
+ XColor *bgColor; /* Background color to use for bitmap. */
+ GC gc; /* Graphics context to use for drawing
+ * bitmap on screen. */
+} BitmapItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
+ "center", Tk_Offset(BitmapItem, anchor), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_COLOR, "-background", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapItem, bgColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-bitmap", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapItem, bitmap), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(BitmapItem, fgColor), 0},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static int BitmapCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv));
+static int BitmapToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double BitmapToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *coordPtr));
+static int BitmapToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static void ComputeBitmapBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ BitmapItem *bmapPtr));
+static int ConfigureBitmap _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+static int tkCreateBitmap _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, char **argv));
+static void DeleteBitmap _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayBitmap _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static void ScaleBitmap _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslateBitmap _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+
+/*
+ * The structures below defines the bitmap item type in terms of
+ * procedures that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkBitmapType = {
+ "bitmap", /* name */
+ sizeof(BitmapItem), /* itemSize */
+ tkCreateBitmap, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureBitmap, /* configureProc */
+ BitmapCoords, /* coordProc */
+ DeleteBitmap, /* deleteProc */
+ DisplayBitmap, /* displayProc */
+ 0, /* alwaysRedraw */
+ BitmapToPoint, /* pointProc */
+ BitmapToArea, /* areaProc */
+ BitmapToPostscript, /* postscriptProc */
+ ScaleBitmap, /* scaleProc */
+ TranslateBitmap, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* icursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) NULL, /* insertProc */
+ (Tk_ItemDCharsProc *) NULL, /* dTextProc */
+ (Tk_ItemType *) NULL /* nextPtr */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * tkCreateBitmap --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+tkCreateBitmap(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. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) 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;
+ }
+
+ /*
+ * Initialize item's record.
+ */
+
+ bmapPtr->anchor = TK_ANCHOR_CENTER;
+ bmapPtr->bitmap = None;
+ bmapPtr->fgColor = NULL;
+ bmapPtr->bgColor = NULL;
+ bmapPtr->gc = None;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &bmapPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1], &bmapPtr->y)
+ != TCL_OK)) {
+ return TCL_ERROR;
+ }
+
+ if (ConfigureBitmap(interp, canvas, itemPtr, argc-2, argv+2, 0) != TCL_OK) {
+ DeleteBitmap(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+BitmapCoords(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, ... */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ char x[TCL_DOUBLE_SPACE], y[TCL_DOUBLE_SPACE];
+
+ if (argc == 0) {
+ Tcl_PrintDouble(interp, bmapPtr->x, x);
+ Tcl_PrintDouble(interp, bmapPtr->y, y);
+ Tcl_AppendResult(interp, x, " ", y, (char *) NULL);
+ } else if (argc == 2) {
+ 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureBitmap(interp, canvas, itemPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Bitmap item to reconfigure. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC;
+ Tk_Window tkwin;
+ unsigned long mask;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
+ (char *) bmapPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as those
+ * that determine the graphics context.
+ */
+
+ gcValues.foreground = bmapPtr->fgColor->pixel;
+ mask = GCForeground;
+ if (bmapPtr->bgColor != NULL) {
+ gcValues.background = bmapPtr->bgColor->pixel;
+ mask |= GCBackground;
+ } else {
+ gcValues.clip_mask = bmapPtr->bitmap;
+ mask |= GCClipMask;
+ }
+ newGC = Tk_GetGCColor(tkwin, mask, &gcValues, bmapPtr->fgColor,
+ bmapPtr->bgColor);
+ if (bmapPtr->gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), bmapPtr->gc);
+ }
+ bmapPtr->gc = newGC;
+
+ ComputeBitmapBbox(canvas, bmapPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteBitmap --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a bitmap item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteBitmap(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. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ if (bmapPtr->bitmap != None) {
+ Tk_FreeBitmap(display, bmapPtr->bitmap);
+ }
+ if (bmapPtr->fgColor != NULL) {
+ Tk_FreeColor(bmapPtr->fgColor);
+ }
+ if (bmapPtr->bgColor != NULL) {
+ Tk_FreeColor(bmapPtr->bgColor);
+ }
+ if (bmapPtr->gc != NULL) {
+ Tk_FreeGC(display, bmapPtr->gc);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeBitmapBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a bitmap item.
+ * This procedure is where the child bitmap's placement is
+ * computed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ComputeBitmapBbox(canvas, bmapPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ BitmapItem *bmapPtr; /* Item whose bbox is to be
+ * recomputed. */
+{
+ int width, height;
+ int x, y;
+
+ x = (int) (bmapPtr->x + ((bmapPtr->x >= 0) ? 0.5 : - 0.5));
+ y = (int) (bmapPtr->y + ((bmapPtr->y >= 0) ? 0.5 : - 0.5));
+
+ if (bmapPtr->bitmap == None) {
+ bmapPtr->header.x1 = bmapPtr->header.x2 = x;
+ bmapPtr->header.y1 = bmapPtr->header.y2 = y;
+ return;
+ }
+
+ /*
+ * Compute location and size of bitmap, using anchor information.
+ */
+
+ Tk_SizeOfBitmap(Tk_Display(Tk_CanvasTkwin(canvas)), bmapPtr->bitmap,
+ &width, &height);
+ switch (bmapPtr->anchor) {
+ case TK_ANCHOR_N:
+ x -= width/2;
+ break;
+ case TK_ANCHOR_NE:
+ x -= width;
+ break;
+ case TK_ANCHOR_E:
+ x -= width;
+ y -= height/2;
+ break;
+ case TK_ANCHOR_SE:
+ x -= width;
+ y -= height;
+ break;
+ case TK_ANCHOR_S:
+ x -= width/2;
+ y -= height;
+ break;
+ case TK_ANCHOR_SW:
+ y -= height;
+ break;
+ case TK_ANCHOR_W:
+ y -= height/2;
+ break;
+ case TK_ANCHOR_NW:
+ break;
+ case TK_ANCHOR_CENTER:
+ x -= width/2;
+ y -= height/2;
+ break;
+ }
+
+ /*
+ * Store the information in the item header.
+ */
+
+ bmapPtr->header.x1 = x;
+ bmapPtr->header.y1 = y;
+ bmapPtr->header.x2 = x + width;
+ bmapPtr->header.y2 = y + height;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayBitmap --
+ *
+ * This procedure is invoked to draw a bitmap item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayBitmap(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). */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ int bmapX, bmapY, bmapWidth, bmapHeight;
+ short drawableX, drawableY;
+
+ /*
+ * If the area being displayed doesn't cover the whole bitmap,
+ * then only redisplay the part of the bitmap that needs
+ * redisplay.
+ */
+
+ if (bmapPtr->bitmap != None) {
+ if (x > bmapPtr->header.x1) {
+ bmapX = x - bmapPtr->header.x1;
+ bmapWidth = bmapPtr->header.x2 - x;
+ } else {
+ bmapX = 0;
+ if ((x+width) < bmapPtr->header.x2) {
+ bmapWidth = x + width - bmapPtr->header.x1;
+ } else {
+ bmapWidth = bmapPtr->header.x2 - bmapPtr->header.x1;
+ }
+ }
+ if (y > bmapPtr->header.y1) {
+ bmapY = y - bmapPtr->header.y1;
+ bmapHeight = bmapPtr->header.y2 - y;
+ } else {
+ bmapY = 0;
+ if ((y+height) < bmapPtr->header.y2) {
+ bmapHeight = y + height - bmapPtr->header.y1;
+ } else {
+ bmapHeight = bmapPtr->header.y2 - bmapPtr->header.y1;
+ }
+ }
+ Tk_CanvasDrawableCoords(canvas,
+ (double) (bmapPtr->header.x1 + bmapX),
+ (double) (bmapPtr->header.y1 + bmapY),
+ &drawableX, &drawableY);
+
+ /*
+ * Must modify the mask origin within the graphics context
+ * to line up with the bitmap's origin (in order to make
+ * bitmaps with "-background {}" work right).
+ */
+
+ XSetClipOrigin(display, bmapPtr->gc, drawableX - bmapX,
+ drawableY - bmapY);
+ XCopyPlane(display, bmapPtr->bitmap, drawable,
+ bmapPtr->gc, bmapX, bmapY, (unsigned int) bmapWidth,
+ (unsigned int) bmapHeight, drawableX, drawableY, 1);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * BitmapToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * rectangle, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are coordPtr[0] and coordPtr[1] is inside the bitmap. If the
+ * point isn't inside the bitmap then the return value is the
+ * distance from the point to the bitmap.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+BitmapToPoint(canvas, itemPtr, coordPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *coordPtr; /* Pointer to x and y coordinates. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+ double x1, x2, y1, y2, xDiff, yDiff;
+
+ x1 = bmapPtr->header.x1;
+ y1 = bmapPtr->header.y1;
+ x2 = bmapPtr->header.x2;
+ y2 = bmapPtr->header.y2;
+
+ /*
+ * Point is outside rectangle.
+ */
+
+ if (coordPtr[0] < x1) {
+ xDiff = x1 - coordPtr[0];
+ } else if (coordPtr[0] > x2) {
+ xDiff = coordPtr[0] - x2;
+ } else {
+ xDiff = 0;
+ }
+
+ if (coordPtr[1] < y1) {
+ yDiff = y1 - coordPtr[1];
+ } else if (coordPtr[1] > y2) {
+ yDiff = coordPtr[1] - y2;
+ } else {
+ yDiff = 0;
+ }
+
+ return hypot(xDiff, yDiff);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * BitmapToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+BitmapToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against rectangle. */
+ double *rectPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ if ((rectPtr[2] <= bmapPtr->header.x1)
+ || (rectPtr[0] >= bmapPtr->header.x2)
+ || (rectPtr[3] <= bmapPtr->header.y1)
+ || (rectPtr[1] >= bmapPtr->header.y2)) {
+ return -1;
+ }
+ if ((rectPtr[0] <= bmapPtr->header.x1)
+ && (rectPtr[1] <= bmapPtr->header.y1)
+ && (rectPtr[2] >= bmapPtr->header.x2)
+ && (rectPtr[3] >= bmapPtr->header.y2)) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleBitmap --
+ *
+ * This procedure is invoked to rescale a bitmap item in a
+ * canvas. It is one of the standard item procedures for
+ * bitmap items, and is invoked by the generic canvas code.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The item referred to by itemPtr is rescaled so that the
+ * following transformation is applied to all point coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleBitmap(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 item. */
+ double scaleX; /* Amount to scale in X direction. */
+ double scaleY; /* Amount to scale in Y direction. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ bmapPtr->x = originX + scaleX*(bmapPtr->x - originX);
+ bmapPtr->y = originY + scaleY*(bmapPtr->y - originY);
+ ComputeBitmapBbox(canvas, bmapPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateBitmap --
+ *
+ * This procedure is called to move an item by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the item is offset by (xDelta, yDelta), and
+ * the bounding box is updated in the generic part of the item
+ * structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateBitmap(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. */
+{
+ BitmapItem *bmapPtr = (BitmapItem *) itemPtr;
+
+ bmapPtr->x += deltaX;
+ bmapPtr->y += deltaY;
+ ComputeBitmapBbox(canvas, bmapPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * BitmapToPostscript --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+BitmapToPostscript(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. */
+{
+ 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,
+ * taking into account the anchor position for the bitmp.
+ */
+
+ x = bmapPtr->x;
+ y = Tk_CanvasPsY(canvas, bmapPtr->y);
+ Tk_SizeOfBitmap(Tk_Display(Tk_CanvasTkwin(canvas)), bmapPtr->bitmap,
+ &width, &height);
+ switch (bmapPtr->anchor) {
+ case TK_ANCHOR_NW: y -= height; break;
+ case TK_ANCHOR_N: x -= width/2.0; y -= height; break;
+ case TK_ANCHOR_NE: x -= width; y -= height; break;
+ case TK_ANCHOR_E: x -= width; y -= height/2.0; break;
+ case TK_ANCHOR_SE: x -= width; break;
+ case TK_ANCHOR_S: x -= width/2.0; break;
+ case TK_ANCHOR_SW: break;
+ case TK_ANCHOR_W: y -= height/2.0; break;
+ case TK_ANCHOR_CENTER: x -= width/2.0; y -= height/2.0; break;
+ }
+
+ /*
+ * 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);
+ }
+
+ /*
+ * Draw the bitmap, if there is a foreground color. If the bitmap
+ * is very large, then chop it up into multiple bitmaps, each
+ * consisting of one or more rows. This is needed because Postscript
+ * can't handle single strings longer than 64 KBytes long.
+ */
+
+ if (bmapPtr->fgColor != NULL) {
+ if (Tk_CanvasPsColor(interp, canvas, bmapPtr->fgColor) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (width > 60000) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "can't generate Postscript",
+ " for bitmaps more than 60000 pixels wide",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ rowsAtOnce = 60000/width;
+ if (rowsAtOnce < 1) {
+ rowsAtOnce = 1;
+ }
+ sprintf(buffer, "%.15g %.15g translate\n", x, y+height);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ for (curRow = 0; curRow < height; curRow += rowsAtOnce) {
+ rowsThisTime = rowsAtOnce;
+ if (rowsThisTime > (height - curRow)) {
+ rowsThisTime = height - curRow;
+ }
+ sprintf(buffer, "0 -%.15g translate\n%d %d true matrix {\n",
+ (double) rowsThisTime, width, rowsThisTime);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ if (Tk_CanvasPsBitmap(interp, canvas, bmapPtr->bitmap,
+ 0, curRow, width, rowsThisTime) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, "\n} imagemask\n", (char *) NULL);
+ }
+ }
+ return TCL_OK;
+}
diff --git a/tk/generic/tkCanvImg.c b/tk/generic/tkCanvImg.c
new file mode 100644
index 00000000000..eb3df385c6b
--- /dev/null
+++ b/tk/generic/tkCanvImg.c
@@ -0,0 +1,677 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each image item.
+ */
+
+typedef struct ImageItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_Canvas canvas; /* Canvas containing the image. */
+ double x, y; /* Coordinates of positioning point for
+ * image. */
+ Tk_Anchor anchor; /* Where to anchor image relative to
+ * (x,y). */
+ char *imageString; /* String describing -image option (malloc-ed).
+ * NULL means no image right now. */
+ Tk_Image image; /* Image to display in window, or NULL if
+ * no image at present. */
+} ImageItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
+ "center", Tk_Offset(ImageItem, anchor), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_STRING, "-image", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(ImageItem, imageString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static void ImageChangedProc _ANSI_ARGS_((ClientData clientData,
+ int x, int y, int width, int height, int imgWidth,
+ int imgHeight));
+static int ImageCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv));
+static int ImageToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double ImageToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *coordPtr));
+static void ComputeImageBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ ImageItem *imgPtr));
+static int ConfigureImage _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+static int CreateImage _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, char **argv));
+static void DeleteImage _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayImage _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static void ScaleImage _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslateImage _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+
+/*
+ * The structures below defines the image item type in terms of
+ * procedures that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkImageType = {
+ "image", /* name */
+ sizeof(ImageItem), /* itemSize */
+ CreateImage, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureImage, /* configureProc */
+ ImageCoords, /* coordProc */
+ DeleteImage, /* deleteProc */
+ DisplayImage, /* displayProc */
+ 0, /* alwaysRedraw */
+ ImageToPoint, /* pointProc */
+ ImageToArea, /* areaProc */
+ (Tk_ItemPostscriptProc *) NULL, /* postscriptProc */
+ ScaleImage, /* scaleProc */
+ TranslateImage, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* icursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) NULL, /* insertProc */
+ (Tk_ItemDCharsProc *) NULL, /* dTextProc */
+ (Tk_ItemType *) NULL /* nextPtr */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateImage --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateImage(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. */
+{
+ ImageItem *imgPtr = (ImageItem *) 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;
+ }
+
+ /*
+ * Initialize item's record.
+ */
+
+ imgPtr->canvas = canvas;
+ imgPtr->anchor = TK_ANCHOR_CENTER;
+ imgPtr->imageString = NULL;
+ imgPtr->image = NULL;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &imgPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1], &imgPtr->y)
+ != TCL_OK)) {
+ return TCL_ERROR;
+ }
+
+ if (ConfigureImage(interp, canvas, itemPtr, argc-2, argv+2, 0) != TCL_OK) {
+ DeleteImage(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ImageCoords(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, ... */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+ char x[TCL_DOUBLE_SPACE], y[TCL_DOUBLE_SPACE];
+
+ if (argc == 0) {
+ Tcl_PrintDouble(interp, imgPtr->x, x);
+ Tcl_PrintDouble(interp, imgPtr->y, y);
+ Tcl_AppendResult(interp, x, " ", y, (char *) NULL);
+ } else if (argc == 2) {
+ 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureImage(interp, canvas, itemPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Image item to reconfigure. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+ Tk_Window tkwin;
+ Tk_Image image;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc,
+ argv, (char *) imgPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the image. Save the old image around and don't free it
+ * until after the new one is allocated. This keeps the reference
+ * count from going to zero so the image doesn't have to be recreated
+ * if it hasn't changed.
+ */
+
+ if (imgPtr->imageString != NULL) {
+ image = Tk_GetImage(interp, tkwin, imgPtr->imageString,
+ ImageChangedProc, (ClientData) imgPtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (imgPtr->image != NULL) {
+ Tk_FreeImage(imgPtr->image);
+ }
+ imgPtr->image = image;
+ ComputeImageBbox(canvas, imgPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteImage --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a image item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteImage(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. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ if (imgPtr->imageString != NULL) {
+ ckfree(imgPtr->imageString);
+ }
+ if (imgPtr->image != NULL) {
+ Tk_FreeImage(imgPtr->image);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeImageBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a image item.
+ * This procedure is where the child image's placement is
+ * computed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ComputeImageBbox(canvas, imgPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ ImageItem *imgPtr; /* Item whose bbox is to be
+ * recomputed. */
+{
+ int width, height;
+ int x, y;
+
+ x = (int) (imgPtr->x + ((imgPtr->x >= 0) ? 0.5 : - 0.5));
+ y = (int) (imgPtr->y + ((imgPtr->y >= 0) ? 0.5 : - 0.5));
+
+ if (imgPtr->image == None) {
+ imgPtr->header.x1 = imgPtr->header.x2 = x;
+ imgPtr->header.y1 = imgPtr->header.y2 = y;
+ return;
+ }
+
+ /*
+ * Compute location and size of image, using anchor information.
+ */
+
+ Tk_SizeOfImage(imgPtr->image, &width, &height);
+ switch (imgPtr->anchor) {
+ case TK_ANCHOR_N:
+ x -= width/2;
+ break;
+ case TK_ANCHOR_NE:
+ x -= width;
+ break;
+ case TK_ANCHOR_E:
+ x -= width;
+ y -= height/2;
+ break;
+ case TK_ANCHOR_SE:
+ x -= width;
+ y -= height;
+ break;
+ case TK_ANCHOR_S:
+ x -= width/2;
+ y -= height;
+ break;
+ case TK_ANCHOR_SW:
+ y -= height;
+ break;
+ case TK_ANCHOR_W:
+ y -= height/2;
+ break;
+ case TK_ANCHOR_NW:
+ break;
+ case TK_ANCHOR_CENTER:
+ x -= width/2;
+ y -= height/2;
+ break;
+ }
+
+ /*
+ * Store the information in the item header.
+ */
+
+ imgPtr->header.x1 = x;
+ imgPtr->header.y1 = y;
+ imgPtr->header.x2 = x + width;
+ imgPtr->header.y2 = y + height;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayImage --
+ *
+ * This procedure is invoked to draw a image item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayImage(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). */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+ short drawableX, drawableY;
+
+ if (imgPtr->image == NULL) {
+ return;
+ }
+
+ /*
+ * Translate the coordinates to those of the image, then redisplay it.
+ */
+
+ Tk_CanvasDrawableCoords(canvas, (double) x, (double) y,
+ &drawableX, &drawableY);
+ Tk_RedrawImage(imgPtr->image, x - imgPtr->header.x1, y - imgPtr->header.y1,
+ width, height, drawable, drawableX, drawableY);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ImageToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * rectangle, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are coordPtr[0] and coordPtr[1] is inside the image. If the
+ * point isn't inside the image then the return value is the
+ * distance from the point to the image.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static double
+ImageToPoint(canvas, itemPtr, coordPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *coordPtr; /* Pointer to x and y coordinates. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+ double x1, x2, y1, y2, xDiff, yDiff;
+
+ x1 = imgPtr->header.x1;
+ y1 = imgPtr->header.y1;
+ x2 = imgPtr->header.x2;
+ y2 = imgPtr->header.y2;
+
+ /*
+ * Point is outside rectangle.
+ */
+
+ if (coordPtr[0] < x1) {
+ xDiff = x1 - coordPtr[0];
+ } else if (coordPtr[0] > x2) {
+ xDiff = coordPtr[0] - x2;
+ } else {
+ xDiff = 0;
+ }
+
+ if (coordPtr[1] < y1) {
+ yDiff = y1 - coordPtr[1];
+ } else if (coordPtr[1] > y2) {
+ yDiff = coordPtr[1] - y2;
+ } else {
+ yDiff = 0;
+ }
+
+ return hypot(xDiff, yDiff);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ImageToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ImageToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against rectangle. */
+ double *rectPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ if ((rectPtr[2] <= imgPtr->header.x1)
+ || (rectPtr[0] >= imgPtr->header.x2)
+ || (rectPtr[3] <= imgPtr->header.y1)
+ || (rectPtr[1] >= imgPtr->header.y2)) {
+ return -1;
+ }
+ if ((rectPtr[0] <= imgPtr->header.x1)
+ && (rectPtr[1] <= imgPtr->header.y1)
+ && (rectPtr[2] >= imgPtr->header.x2)
+ && (rectPtr[3] >= imgPtr->header.y2)) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleImage --
+ *
+ * This procedure is invoked to rescale an item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The item referred to by itemPtr is rescaled so that the
+ * following transformation is applied to all point coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleImage(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. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ imgPtr->x = originX + scaleX*(imgPtr->x - originX);
+ imgPtr->y = originY + scaleY*(imgPtr->y - originY);
+ ComputeImageBbox(canvas, imgPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateImage --
+ *
+ * This procedure is called to move an item by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the item is offset by (xDelta, yDelta), and
+ * the bounding box is updated in the generic part of the item
+ * structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateImage(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. */
+{
+ ImageItem *imgPtr = (ImageItem *) itemPtr;
+
+ imgPtr->x += deltaX;
+ imgPtr->y += deltaY;
+ ComputeImageBbox(canvas, imgPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageChangedProc --
+ *
+ * This procedure is invoked by the image code whenever the manager
+ * for an image does something that affects the image's size or
+ * how it is displayed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the canvas to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageChangedProc(clientData, x, y, width, height, imgWidth, imgHeight)
+ ClientData clientData; /* Pointer to canvas item for image. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ ImageItem *imgPtr = (ImageItem *) clientData;
+
+ /*
+ * If the image's size changed and it's not anchored at its
+ * northwest corner then just redisplay the entire area of the
+ * image. This is a bit over-conservative, but we need to do
+ * something because a size change also means a position change.
+ */
+
+ if (((imgPtr->header.x2 - imgPtr->header.x1) != imgWidth)
+ || ((imgPtr->header.y2 - imgPtr->header.y1) != imgHeight)) {
+ x = y = 0;
+ width = imgWidth;
+ height = imgHeight;
+ Tk_CanvasEventuallyRedraw(imgPtr->canvas, imgPtr->header.x1,
+ imgPtr->header.y1, imgPtr->header.x2, imgPtr->header.y2);
+ }
+ ComputeImageBbox(imgPtr->canvas, imgPtr);
+ Tk_CanvasEventuallyRedraw(imgPtr->canvas, imgPtr->header.x1 + x,
+ imgPtr->header.y1 + y, (int) (imgPtr->header.x1 + x + width),
+ (int) (imgPtr->header.y1 + y + height));
+}
diff --git a/tk/generic/tkCanvLine.c b/tk/generic/tkCanvLine.c
new file mode 100644
index 00000000000..2125446742d
--- /dev/null
+++ b/tk/generic/tkCanvLine.c
@@ -0,0 +1,1623 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * The structure below defines the record for each line item.
+ */
+
+typedef struct LineItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_Canvas canvas; /* Canvas containing item. Needed for
+ * parsing arrow shapes. */
+ int numPoints; /* Number of points in line (always >= 2). */
+ double *coordPtr; /* Pointer to malloc-ed array containing
+ * x- and y-coords of all points in line.
+ * X-coords are even-valued indices, y-coords
+ * are corresponding odd-valued indices. If
+ * the line has arrowheads then the first
+ * and last points have been adjusted to refer
+ * to the necks of the arrowheads rather than
+ * their tips. The actual endpoints are
+ * stored in the *firstArrowPtr and
+ * *lastArrowPtr, if they exist. */
+ int width; /* Width of line. */
+ XColor *fg; /* Foreground color for line. */
+ Pixmap fillStipple; /* Stipple bitmap for filling line. */
+ int capStyle; /* Cap style for line. */
+ int joinStyle; /* Join style for line. */
+ GC gc; /* Graphics context for filling line. */
+ GC arrowGC; /* Graphics context for drawing arrowheads. */
+ Tk_Uid arrow; /* Indicates whether or not to draw arrowheads:
+ * "none", "first", "last", or "both". */
+ float arrowShapeA; /* Distance from tip of arrowhead to center. */
+ float arrowShapeB; /* Distance from tip of arrowhead to trailing
+ * point, measured along shaft. */
+ float arrowShapeC; /* Distance of trailing points from outside
+ * edge of shaft. */
+ double *firstArrowPtr; /* Points to array of PTS_IN_ARROW points
+ * describing polygon for arrowhead at first
+ * point in line. First point of arrowhead
+ * is tip. Malloc'ed. NULL means no arrowhead
+ * at first point. */
+ double *lastArrowPtr; /* Points to polygon for arrowhead at last
+ * point in line (PTS_IN_ARROW points, first
+ * of which is tip). Malloc'ed. NULL means
+ * no arrowhead at last point. */
+ int smooth; /* Non-zero means draw line smoothed (i.e.
+ * with Bezier splines). */
+ int splineSteps; /* Number of steps in each spline segment. */
+} LineItem;
+
+/*
+ * Number of points in an arrowHead:
+ */
+
+#define PTS_IN_ARROW 6
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static int ArrowheadPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, LineItem *linePtr,
+ double *arrowPtr));
+static void ComputeLineBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ LineItem *linePtr));
+static int ConfigureLine _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+static int ConfigureArrows _ANSI_ARGS_((Tk_Canvas canvas,
+ LineItem *linePtr));
+static int CreateLine _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, char **argv));
+static void DeleteLine _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayLine _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static int LineCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ int argc, char **argv));
+static int LineToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double LineToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *coordPtr));
+static int LineToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static int ParseArrowShape _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin, char *value,
+ char *recordPtr, int offset));
+static char * PrintArrowShape _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *recordPtr, int offset,
+ Tcl_FreeProc **freeProcPtr));
+static void ScaleLine _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslateLine _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+
+/*
+ * Information used for parsing configuration specs. If you change any
+ * of the default strings, be sure to change the corresponding default
+ * values in CreateLine.
+ */
+
+static Tk_CustomOption arrowShapeOption = {ParseArrowShape,
+ PrintArrowShape, (ClientData) NULL};
+static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_UID, "-arrow", (char *) NULL, (char *) NULL,
+ "none", Tk_Offset(LineItem, arrow), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-arrowshape", (char *) NULL, (char *) NULL,
+ "8 10 3", Tk_Offset(LineItem, arrowShapeA),
+ TK_CONFIG_DONT_SET_DEFAULT, &arrowShapeOption},
+ {TK_CONFIG_CAP_STYLE, "-capstyle", (char *) NULL, (char *) NULL,
+ "butt", Tk_Offset(LineItem, capStyle), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(LineItem, fg), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_JOIN_STYLE, "-joinstyle", (char *) NULL, (char *) NULL,
+ "round", Tk_Offset(LineItem, joinStyle), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_BOOLEAN, "-smooth", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(LineItem, smooth), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_INT, "-splinesteps", (char *) NULL, (char *) NULL,
+ "12", Tk_Offset(LineItem, splineSteps), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(LineItem, fillStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "1", Tk_Offset(LineItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * The structures below defines the line item type by means
+ * of procedures that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkLineType = {
+ "line", /* name */
+ sizeof(LineItem), /* itemSize */
+ CreateLine, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureLine, /* configureProc */
+ LineCoords, /* coordProc */
+ DeleteLine, /* deleteProc */
+ DisplayLine, /* displayProc */
+ 0, /* alwaysRedraw */
+ LineToPoint, /* pointProc */
+ LineToArea, /* areaProc */
+ LineToPostscript, /* postscriptProc */
+ ScaleLine, /* scaleProc */
+ TranslateLine, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateLine(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 line. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ int i;
+
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
+ itemPtr->typePtr->name, " x1 y1 x2 y2 ?x3 y3 ...? ?options?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Carry out initialization that is needed to set defaults and to
+ * allow proper cleanup after errors during the the remainder of
+ * this procedure.
+ */
+
+ linePtr->canvas = canvas;
+ linePtr->numPoints = 0;
+ linePtr->coordPtr = NULL;
+ 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;
+
+ /*
+ * Count the number of points and then parse them into a point
+ * array. Leading arguments are assumed to be points if they
+ * start with a digit or a minus sign followed by a digit.
+ */
+
+ for (i = 4; i < (argc-1); i+=2) {
+ if ((!isdigit(UCHAR(argv[i][0]))) &&
+ ((argv[i][0] != '-')
+ || ((argv[i][1] != '.') && !isdigit(UCHAR(argv[i][1]))))) {
+ break;
+ }
+ }
+ if (LineCoords(interp, canvas, itemPtr, i, argv) != TCL_OK) {
+ goto error;
+ }
+ if (ConfigureLine(interp, canvas, itemPtr, argc-i, argv+i, 0) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeleteLine(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+LineCoords(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, ... */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ char buffer[TCL_DOUBLE_SPACE];
+ int i, numPoints;
+
+ if (argc == 0) {
+ double *coordPtr;
+ int numCoords;
+
+ numCoords = 2*linePtr->numPoints;
+ if (linePtr->firstArrowPtr != NULL) {
+ coordPtr = linePtr->firstArrowPtr;
+ } else {
+ coordPtr = linePtr->coordPtr;
+ }
+ for (i = 0; i < numCoords; i++, coordPtr++) {
+ if (i == 2) {
+ coordPtr = linePtr->coordPtr+2;
+ }
+ if ((linePtr->lastArrowPtr != NULL) && (i == (numCoords-2))) {
+ coordPtr = linePtr->lastArrowPtr;
+ }
+ Tcl_PrintDouble(interp, *coordPtr, buffer);
+ Tcl_AppendElement(interp, buffer);
+ }
+ } else if (argc < 4) {
+ Tcl_AppendResult(interp,
+ "too few coordinates for line: must have at least 4",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else if (argc & 1) {
+ Tcl_AppendResult(interp,
+ "odd number of coordinates specified for line",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ numPoints = argc/2;
+ if (linePtr->numPoints != numPoints) {
+ if (linePtr->coordPtr != NULL) {
+ ckfree((char *) linePtr->coordPtr);
+ }
+ linePtr->coordPtr = (double *) ckalloc((unsigned)
+ (sizeof(double) * argc));
+ linePtr->numPoints = numPoints;
+ }
+ for (i = argc-1; i >= 0; i--) {
+ if (Tk_CanvasGetCoord(interp, canvas, argv[i],
+ &linePtr->coordPtr[i]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Update arrowheads by throwing away any existing arrow-head
+ * information and calling ConfigureArrows to recompute it.
+ */
+
+ if (linePtr->firstArrowPtr != NULL) {
+ 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureLine(interp, canvas, itemPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Line item to reconfigure. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Arguments describing things to configure. */
+ 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;
+ }
+
+ /*
+ * A few of the options require additional processing, such as
+ * graphics contexts.
+ */
+
+ if (linePtr->fg == NULL) {
+ newGC = arrowGC = None;
+ } else {
+ gcValues.foreground = linePtr->fg->pixel;
+ gcValues.join_style = linePtr->joinStyle;
+ if (linePtr->width < 0) {
+ linePtr->width = 1;
+ }
+ gcValues.line_width = linePtr->width;
+ mask = GCForeground|GCJoinStyle|GCLineWidth;
+ if (linePtr->fillStipple != None) {
+ gcValues.stipple = linePtr->fillStipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ if (linePtr->arrow == noneUid) {
+ gcValues.cap_style = linePtr->capStyle;
+ mask |= GCCapStyle;
+ }
+ newGC = Tk_GetGCColor(tkwin, mask, &gcValues, linePtr->fg, NULL);
+ gcValues.line_width = 0;
+ arrowGC = Tk_GetGCColor(tkwin, mask, &gcValues, linePtr->fg, NULL);
+ }
+ if (linePtr->gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), linePtr->gc);
+ }
+ if (linePtr->arrowGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), linePtr->arrowGC);
+ }
+ linePtr->gc = newGC;
+ linePtr->arrowGC = arrowGC;
+
+ /*
+ * Keep spline parameters within reasonable limits.
+ */
+
+ if (linePtr->splineSteps < 1) {
+ linePtr->splineSteps = 1;
+ } else if (linePtr->splineSteps > 100) {
+ linePtr->splineSteps = 100;
+ }
+
+ /*
+ * Setup arrowheads, if needed. If arrowheads are turned off,
+ * restore the line's endpoints (they were shortened when the
+ * arrowheads were added).
+ */
+
+ 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);
+ }
+
+ /*
+ * Recompute bounding box for line.
+ */
+
+ ComputeLineBbox(canvas, linePtr);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteLine --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a line item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteLine(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. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+
+ if (linePtr->coordPtr != NULL) {
+ ckfree((char *) linePtr->coordPtr);
+ }
+ if (linePtr->fg != NULL) {
+ Tk_FreeColor(linePtr->fg);
+ }
+ if (linePtr->fillStipple != None) {
+ Tk_FreeBitmap(display, linePtr->fillStipple);
+ }
+ if (linePtr->gc != None) {
+ Tk_FreeGC(display, linePtr->gc);
+ }
+ if (linePtr->arrowGC != None) {
+ Tk_FreeGC(display, linePtr->arrowGC);
+ }
+ if (linePtr->firstArrowPtr != NULL) {
+ ckfree((char *) linePtr->firstArrowPtr);
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ ckfree((char *) linePtr->lastArrowPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeLineBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a line.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeLineBbox(canvas, linePtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ LineItem *linePtr; /* Item whose bbos is to be
+ * recomputed. */
+{
+ double *coordPtr;
+ int i, width;
+
+ coordPtr = linePtr->coordPtr;
+ linePtr->header.x1 = linePtr->header.x2 = (int) *coordPtr;
+ linePtr->header.y1 = linePtr->header.y2 = (int) coordPtr[1];
+
+ /*
+ * Compute the bounding box of all the points in the line,
+ * then expand in all directions by the line's width to take
+ * care of butting or rounded corners and projecting or
+ * rounded caps. This expansion is an overestimate (worst-case
+ * is square root of two over two) but it's simple. Don't do
+ * anything special for curves. This causes an additional
+ * overestimate in the bounding box, but is faster.
+ */
+
+ for (i = 1, coordPtr = linePtr->coordPtr+2; i < linePtr->numPoints;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) linePtr, coordPtr);
+ }
+ width = linePtr->width;
+ if (width < 1) {
+ width = 1;
+ }
+ linePtr->header.x1 -= width;
+ linePtr->header.x2 += width;
+ linePtr->header.y1 -= width;
+ linePtr->header.y2 += width;
+
+ /*
+ * For mitered lines, make a second pass through all the points.
+ * Compute the locations of the two miter vertex points and add
+ * those into the bounding box.
+ */
+
+ if (linePtr->joinStyle == JoinMiter) {
+ for (i = linePtr->numPoints, coordPtr = linePtr->coordPtr; i >= 3;
+ i--, coordPtr += 2) {
+ double miter[4];
+ int j;
+
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ (double) width, miter, miter+2)) {
+ for (j = 0; j < 4; j += 2) {
+ TkIncludePoint((Tk_Item *) linePtr, miter+j);
+ }
+ }
+ }
+ }
+
+ /*
+ * 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);
+ }
+ }
+ }
+
+ /*
+ * Add one more pixel of fudge factor just to be safe (e.g.
+ * X may round differently than we do).
+ */
+
+ linePtr->header.x1 -= 1;
+ linePtr->header.x2 += 1;
+ linePtr->header.y1 -= 1;
+ linePtr->header.y2 += 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayLine --
+ *
+ * This procedure is invoked to draw a line item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayLine(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). */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ XPoint staticPoints[MAX_STATIC_POINTS];
+ XPoint *pointPtr;
+ XPoint *pPtr;
+ double *coordPtr;
+ int i, numPoints;
+
+ if (linePtr->gc == None) {
+ return;
+ }
+
+ /*
+ * Build up an array of points in screen coordinates. Use a
+ * static array unless the line has an enormous number of points;
+ * in this case, dynamically allocate an array. For smoothed lines,
+ * generate the curve points on each redisplay.
+ */
+
+ if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
+ numPoints = 1 + linePtr->numPoints*linePtr->splineSteps;
+ } else {
+ numPoints = linePtr->numPoints;
+ }
+
+ if (numPoints <= MAX_STATIC_POINTS) {
+ pointPtr = staticPoints;
+ } else {
+ pointPtr = (XPoint *) ckalloc((unsigned) (numPoints * sizeof(XPoint)));
+ }
+
+ if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
+ numPoints = TkMakeBezierCurve(canvas, linePtr->coordPtr,
+ linePtr->numPoints, linePtr->splineSteps, pointPtr,
+ (double *) NULL);
+ } else {
+ for (i = 0, coordPtr = linePtr->coordPtr, pPtr = pointPtr;
+ i < linePtr->numPoints; i += 1, coordPtr += 2, pPtr++) {
+ Tk_CanvasDrawableCoords(canvas, coordPtr[0], coordPtr[1],
+ &pPtr->x, &pPtr->y);
+ }
+ }
+
+ /*
+ * Display line, the free up line storage if it was dynamically
+ * allocated. 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 (linePtr->fillStipple != None) {
+ Tk_CanvasSetStippleOrigin(canvas, linePtr->gc);
+ Tk_CanvasSetStippleOrigin(canvas, linePtr->arrowGC);
+ }
+ XDrawLines(display, drawable, linePtr->gc, pointPtr, numPoints,
+ CoordModeOrigin);
+ if (pointPtr != staticPoints) {
+ ckfree((char *) pointPtr);
+ }
+
+ /*
+ * Display arrowheads, if they are wanted.
+ */
+
+ if (linePtr->firstArrowPtr != NULL) {
+ TkFillPolygon(canvas, linePtr->firstArrowPtr, PTS_IN_ARROW,
+ display, drawable, linePtr->gc, NULL);
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ TkFillPolygon(canvas, linePtr->lastArrowPtr, PTS_IN_ARROW,
+ display, drawable, linePtr->gc, NULL);
+ }
+ if (linePtr->fillStipple != None) {
+ XSetTSOrigin(display, linePtr->gc, 0, 0);
+ XSetTSOrigin(display, linePtr->arrowGC, 0, 0);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LineToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * line, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are pointPtr[0] and pointPtr[1] is inside the line. If the
+ * point isn't inside the line then the return value is the
+ * distance from the point to the line.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+LineToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ 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;
+
+ /*
+ * Handle smoothed lines by generating an expanded set of points
+ * against which to do the check.
+ */
+
+ if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
+ numPoints = 1 + linePtr->numPoints*linePtr->splineSteps;
+ if (numPoints <= MAX_STATIC_POINTS) {
+ linePoints = staticSpace;
+ } else {
+ linePoints = (double *) ckalloc((unsigned)
+ (2*numPoints*sizeof(double)));
+ }
+ 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.
+ */
+
+ changedMiterToBevel = 0;
+ for (count = numPoints, coordPtr = linePoints; count >= 2;
+ count--, coordPtr += 2) {
+
+ /*
+ * If rounding is done around the first point then compute
+ * 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.
+ */
+
+ if ((linePtr->joinStyle == JoinBevel) || changedMiterToBevel) {
+ 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;
+ }
+ 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;
+ }
+ }
+ }
+
+ done:
+ if ((linePoints != staticSpace) && (linePoints != linePtr->coordPtr)) {
+ ckfree((char *) linePoints);
+ }
+ return bestDist;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LineToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the
+ * area, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+LineToArea(canvas, itemPtr, rectPtr)
+ 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.
+ */
+
+ if ((linePtr->smooth) && (linePtr->numPoints > 2)) {
+ numPoints = 1 + linePtr->numPoints*linePtr->splineSteps;
+ if (numPoints <= MAX_STATIC_POINTS) {
+ linePoints = staticSpace;
+ } else {
+ linePoints = (double *) ckalloc((unsigned)
+ (2*numPoints*sizeof(double)));
+ }
+ numPoints = TkMakeBezierCurve(canvas, linePtr->coordPtr,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ linePoints);
+ } else {
+ 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;
+ }
+ }
+ }
+
+ done:
+ if ((linePoints != staticSpace) && (linePoints != linePtr->coordPtr)) {
+ ckfree((char *) linePoints);
+ }
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleLine --
+ *
+ * This procedure is invoked to rescale a line item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The line referred to by itemPtr is rescaled so that the
+ * following transformation is applied to all point
+ * coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleLine(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing line. */
+ Tk_Item *itemPtr; /* Line 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. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ double *coordPtr;
+ int i;
+
+ /*
+ * Delete any arrowheads before scaling all the points (so that
+ * the end-points of the line get restored).
+ */
+
+ if (linePtr->firstArrowPtr != NULL) {
+ linePtr->coordPtr[0] = linePtr->firstArrowPtr[0];
+ linePtr->coordPtr[1] = linePtr->firstArrowPtr[1];
+ ckfree((char *) linePtr->firstArrowPtr);
+ linePtr->firstArrowPtr = NULL;
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ 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;
+ }
+ 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);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateLine --
+ *
+ * This procedure is called to move a line by a given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the line is offset by (xDelta, yDelta), and
+ * the bounding box is updated in the generic part of the item
+ * structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateLine(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. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ double *coordPtr;
+ int i;
+
+ for (i = 0, coordPtr = linePtr->coordPtr; i < linePtr->numPoints;
+ i++, coordPtr += 2) {
+ coordPtr[0] += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ if (linePtr->firstArrowPtr != NULL) {
+ for (i = 0, coordPtr = linePtr->firstArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ coordPtr[0] += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ for (i = 0, coordPtr = linePtr->lastArrowPtr; i < PTS_IN_ARROW;
+ i++, coordPtr += 2) {
+ coordPtr[0] += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ }
+ ComputeLineBbox(canvas, linePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ParseArrowShape --
+ *
+ * This procedure is called back during option parsing to
+ * parse arrow shape information.
+ *
+ * Results:
+ * The return value is a standard Tcl result: TCL_OK means
+ * that the arrow shape information was parsed ok, and
+ * TCL_ERROR means it couldn't be parsed.
+ *
+ * Side effects:
+ * Arrow information in recordPtr is updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ParseArrowShape(clientData, interp, tkwin, value, recordPtr, offset)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Window tkwin; /* Not used. */
+ char *value; /* Textual specification of arrow shape. */
+ char *recordPtr; /* Pointer to item record in which to
+ * store arrow information. */
+ int offset; /* Offset of shape information in widget
+ * record. */
+{
+ LineItem *linePtr = (LineItem *) recordPtr;
+ double a, b, c;
+ int argc;
+ char **argv = NULL;
+
+ if (offset != Tk_Offset(LineItem, arrowShapeA)) {
+ panic("ParseArrowShape received bogus offset");
+ }
+
+ if (Tcl_SplitList(interp, value, &argc, &argv) != TCL_OK) {
+ syntaxError:
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad arrow shape \"", value,
+ "\": must be list with three numbers", (char *) NULL);
+ if (argv != NULL) {
+ ckfree((char *) argv);
+ }
+ return TCL_ERROR;
+ }
+ if (argc != 3) {
+ goto syntaxError;
+ }
+ if ((Tk_CanvasGetCoord(interp, linePtr->canvas, argv[0], &a) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, linePtr->canvas, argv[1], &b)
+ != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, linePtr->canvas, argv[2], &c)
+ != TCL_OK)) {
+ goto syntaxError;
+ }
+ linePtr->arrowShapeA = (float)a;
+ linePtr->arrowShapeB = (float)b;
+ linePtr->arrowShapeC = (float)c;
+ ckfree((char *) argv);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PrintArrowShape --
+ *
+ * This procedure is a callback invoked by the configuration
+ * code to return a printable value describing an arrow shape.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+PrintArrowShape(clientData, tkwin, recordPtr, offset, freeProcPtr)
+ ClientData clientData; /* Not used. */
+ Tk_Window tkwin; /* Window associated with linePtr's widget. */
+ char *recordPtr; /* Pointer to item record containing current
+ * shape information. */
+ int offset; /* Offset of arrow information in record. */
+ Tcl_FreeProc **freeProcPtr; /* Store address of procedure to call to
+ * free string here. */
+{
+ LineItem *linePtr = (LineItem *) recordPtr;
+ char *buffer;
+
+ buffer = (char *) ckalloc(120);
+ sprintf(buffer, "%.5g %.5g %.5g", linePtr->arrowShapeA,
+ linePtr->arrowShapeB, linePtr->arrowShapeC);
+ *freeProcPtr = TCL_DYNAMIC;
+ return buffer;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ConfigureArrows --
+ *
+ * If arrowheads have been requested for a line, this
+ * procedure makes arrangements for the arrowheads.
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * Information in linePtr is set up for one or two arrowheads.
+ * the firstArrowPtr and lastArrowPtr polygons are allocated
+ * and initialized, if need be, and the end points of the line
+ * are adjusted so that a thick line doesn't stick out past
+ * the arrowheads.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConfigureArrows(canvas, linePtr)
+ Tk_Canvas canvas; /* Canvas in which arrows will be
+ * displayed (interp and tkwin
+ * fields are needed). */
+ LineItem *linePtr; /* Item to configure for arrows. */
+{
+ double *poly, *coordPtr;
+ double dx, dy, length, sinTheta, cosTheta, temp;
+ double fracHeight; /* Line width as fraction of
+ * arrowhead width. */
+ double backup; /* Distance to backup end points
+ * so the line ends in the middle
+ * of the arrowhead. */
+ double vertX, vertY; /* Position of arrowhead vertex. */
+ double shapeA, shapeB, shapeC; /* Adjusted coordinates (see
+ * explanation below). */
+
+ /*
+ * The code below makes a tiny increase in the shape parameters
+ * for the line. This is a bit of a hack, but it seems to result
+ * in displays that more closely approximate the specified parameters.
+ * Without the adjustment, the arrows come out smaller than expected.
+ */
+
+ shapeA = linePtr->arrowShapeA + 0.001;
+ shapeB = linePtr->arrowShapeB + 0.001;
+ shapeC = linePtr->arrowShapeC + linePtr->width/2.0 + 0.001;
+
+ /*
+ * 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;
+ }
+ dx = poly[0] - linePtr->coordPtr[2];
+ dy = poly[1] - linePtr->coordPtr[3];
+ length = hypot(dx, dy);
+ if (length == 0) {
+ sinTheta = cosTheta = 0.0;
+ } else {
+ sinTheta = dy/length;
+ cosTheta = dx/length;
+ }
+ vertX = poly[0] - shapeA*cosTheta;
+ vertY = poly[1] - shapeA*sinTheta;
+ temp = shapeC*sinTheta;
+ poly[2] = poly[0] - shapeB*cosTheta + temp;
+ poly[8] = poly[2] - 2*temp;
+ temp = shapeC*cosTheta;
+ poly[3] = poly[1] - shapeB*sinTheta - temp;
+ poly[9] = poly[3] + 2*temp;
+ poly[4] = poly[2]*fracHeight + vertX*(1.0-fracHeight);
+ poly[5] = poly[3]*fracHeight + vertY*(1.0-fracHeight);
+ poly[6] = poly[8]*fracHeight + vertX*(1.0-fracHeight);
+ poly[7] = poly[9]*fracHeight + vertY*(1.0-fracHeight);
+
+ /*
+ * Polygon done. Now move the first point towards the second so
+ * that the corners at the end of the line are inside the
+ * arrowhead.
+ */
+
+ linePtr->coordPtr[0] = poly[0] - backup*cosTheta;
+ 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];
+ linePtr->lastArrowPtr = poly;
+ }
+ dx = poly[0] - coordPtr[0];
+ dy = poly[1] - coordPtr[1];
+ length = hypot(dx, dy);
+ if (length == 0) {
+ sinTheta = cosTheta = 0.0;
+ } else {
+ sinTheta = dy/length;
+ cosTheta = dx/length;
+ }
+ vertX = poly[0] - shapeA*cosTheta;
+ vertY = poly[1] - shapeA*sinTheta;
+ temp = shapeC*sinTheta;
+ poly[2] = poly[0] - shapeB*cosTheta + temp;
+ poly[8] = poly[2] - 2*temp;
+ temp = shapeC*cosTheta;
+ poly[3] = poly[1] - shapeB*sinTheta - temp;
+ poly[9] = poly[3] + 2*temp;
+ poly[4] = poly[2]*fracHeight + vertX*(1.0-fracHeight);
+ poly[5] = poly[3]*fracHeight + vertY*(1.0-fracHeight);
+ poly[6] = poly[8]*fracHeight + vertX*(1.0-fracHeight);
+ poly[7] = poly[9]*fracHeight + vertY*(1.0-fracHeight);
+ coordPtr[2] = poly[0] - backup*cosTheta;
+ coordPtr[3] = poly[1] - backup*sinTheta;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * LineToPostscript --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+LineToPostscript(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. */
+{
+ LineItem *linePtr = (LineItem *) itemPtr;
+ char buffer[200];
+ char *style;
+
+ if (linePtr->fg == NULL) {
+ return TCL_OK;
+ }
+
+ /*
+ * Generate a path for the line's center-line (do this differently
+ * for straight lines and smoothed lines).
+ */
+
+ if ((!linePtr->smooth) || (linePtr->numPoints <= 2)) {
+ Tk_CanvasPsPath(interp, canvas, linePtr->coordPtr, linePtr->numPoints);
+ } else {
+ if (linePtr->fillStipple == None) {
+ TkMakeBezierPostscript(interp, canvas, linePtr->coordPtr,
+ linePtr->numPoints);
+ } else {
+ /*
+ * Special hack: Postscript printers don't appear to be able
+ * to turn a path drawn with "curveto"s into a clipping path
+ * without exceeding resource limits, so TkMakeBezierPostscript
+ * won't work for stippled curves. Instead, generate all of
+ * the intermediate points here and output them into the
+ * Postscript file with "lineto"s instead.
+ */
+
+ double staticPoints[2*MAX_STATIC_POINTS];
+ double *pointPtr;
+ int numPoints;
+
+ numPoints = 1 + linePtr->numPoints*linePtr->splineSteps;
+ pointPtr = staticPoints;
+ if (numPoints > MAX_STATIC_POINTS) {
+ pointPtr = (double *) ckalloc((unsigned)
+ (numPoints * 2 * sizeof(double)));
+ }
+ numPoints = TkMakeBezierCurve(canvas, linePtr->coordPtr,
+ linePtr->numPoints, linePtr->splineSteps, (XPoint *) NULL,
+ pointPtr);
+ Tk_CanvasPsPath(interp, canvas, pointPtr, numPoints);
+ if (pointPtr != staticPoints) {
+ ckfree((char *) pointPtr);
+ }
+ }
+ }
+
+ /*
+ * Set other line-drawing parameters and stroke out the line.
+ */
+
+ sprintf(buffer, "%d setlinewidth\n", linePtr->width);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ style = "0 setlinecap\n";
+ if (linePtr->capStyle == CapRound) {
+ style = "1 setlinecap\n";
+ } else if (linePtr->capStyle == CapProjecting) {
+ style = "2 setlinecap\n";
+ }
+ Tcl_AppendResult(interp, style, (char *) NULL);
+ style = "0 setlinejoin\n";
+ if (linePtr->joinStyle == JoinRound) {
+ style = "1 setlinejoin\n";
+ } else if (linePtr->joinStyle == JoinBevel) {
+ style = "2 setlinejoin\n";
+ }
+ Tcl_AppendResult(interp, style, (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, linePtr->fg) != TCL_OK) {
+ return TCL_ERROR;
+ };
+ if (linePtr->fillStipple != None) {
+ Tcl_AppendResult(interp, "StrokeClip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, linePtr->fillStipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "stroke\n", (char *) NULL);
+ }
+
+ /*
+ * Output polygons for the arrowheads, if there are any.
+ */
+
+ if (linePtr->firstArrowPtr != NULL) {
+ if (linePtr->fillStipple != None) {
+ Tcl_AppendResult(interp, "grestore gsave\n",
+ (char *) NULL);
+ }
+ if (ArrowheadPostscript(interp, canvas, linePtr,
+ linePtr->firstArrowPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (linePtr->lastArrowPtr != NULL) {
+ if (linePtr->fillStipple != None) {
+ Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
+ }
+ if (ArrowheadPostscript(interp, canvas, linePtr,
+ linePtr->lastArrowPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArrowheadPostscript --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ArrowheadPostscript(interp, canvas, linePtr, arrowPtr)
+ Tcl_Interp *interp; /* Leave Postscript or error message
+ * here. */
+ Tk_Canvas canvas; /* Information about overall canvas. */
+ LineItem *linePtr; /* Line item for which Postscript is
+ * being generated. */
+ double *arrowPtr; /* Pointer to first of five points
+ * describing arrowhead polygon. */
+{
+ Tk_CanvasPsPath(interp, canvas, arrowPtr, PTS_IN_ARROW);
+ if (linePtr->fillStipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, linePtr->fillStipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ return TCL_OK;
+}
diff --git a/tk/generic/tkCanvPoly.c b/tk/generic/tkCanvPoly.c
new file mode 100644
index 00000000000..79c7b6c50b4
--- /dev/null
+++ b/tk/generic/tkCanvPoly.c
@@ -0,0 +1,1000 @@
+/*
+ * 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$
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * The structure below defines the record for each polygon item.
+ */
+
+typedef struct PolygonItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ int numPoints; /* Number of points in polygon (always >= 3).
+ * Polygon is always closed. */
+ int pointsAllocated; /* Number of points for which space is
+ * allocated at *coordPtr. */
+ double *coordPtr; /* Pointer to malloc-ed array containing
+ * x- and y-coords of all points in polygon.
+ * X-coords are even-valued indices, y-coords
+ * are corresponding odd-valued indices. */
+ int width; /* Width of outline. */
+ XColor *outlineColor; /* Color for outline. */
+ GC outlineGC; /* Graphics context for drawing outline. */
+ XColor *fillColor; /* Foreground color for polygon. */
+ Pixmap fillStipple; /* Stipple bitmap for filling polygon. */
+ GC fillGC; /* Graphics context for filling polygon. */
+ int smooth; /* Non-zero means draw shape smoothed (i.e.
+ * with Bezier splines). */
+ int splineSteps; /* Number of steps in each spline segment. */
+ int autoClosed; /* Zero means the given polygon was closed,
+ one means that we auto closed it. */
+} PolygonItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(PolygonItem, fillColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-outline", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, outlineColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-smooth", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(PolygonItem, smooth), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_INT, "-splinesteps", (char *) NULL, (char *) NULL,
+ "12", Tk_Offset(PolygonItem, splineSteps), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PolygonItem, fillStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "1", Tk_Offset(PolygonItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static void ComputePolygonBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ PolygonItem *polyPtr));
+static int ConfigurePolygon _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+static int CreatePolygon _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, char **argv));
+static void DeletePolygon _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayPolygon _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static int PolygonCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ int argc, char **argv));
+static int PolygonToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double PolygonToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr));
+static int PolygonToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static void ScalePolygon _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslatePolygon _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+
+/*
+ * The structures below defines the polygon item type by means
+ * of procedures that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkPolygonType = {
+ "polygon", /* name */
+ sizeof(PolygonItem), /* itemSize */
+ CreatePolygon, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigurePolygon, /* configureProc */
+ PolygonCoords, /* coordProc */
+ DeletePolygon, /* deleteProc */
+ DisplayPolygon, /* displayProc */
+ 0, /* alwaysRedraw */
+ PolygonToPoint, /* pointProc */
+ PolygonToArea, /* areaProc */
+ PolygonToPostscript, /* postscriptProc */
+ ScalePolygon, /* scaleProc */
+ TranslatePolygon, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (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
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreatePolygon --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreatePolygon(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 polygon. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ int i;
+
+ if (argc < 6) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ Tk_PathName(Tk_CanvasTkwin(canvas)), " create ",
+ itemPtr->typePtr->name,
+ " x1 y1 x2 y2 x3 y3 ?x4 y4 ...? ?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.
+ */
+
+ polyPtr->numPoints = 0;
+ polyPtr->pointsAllocated = 0;
+ polyPtr->coordPtr = NULL;
+ polyPtr->width = 1;
+ polyPtr->outlineColor = NULL;
+ polyPtr->outlineGC = None;
+ polyPtr->fillColor = NULL;
+ polyPtr->fillStipple = None;
+ polyPtr->fillGC = None;
+ polyPtr->smooth = 0;
+ polyPtr->splineSteps = 12;
+ polyPtr->autoClosed = 0;
+
+ /*
+ * Count the number of points and then parse them into a point
+ * array. Leading arguments are assumed to be points if they
+ * start with a digit or a minus sign followed by a digit.
+ */
+
+ for (i = 4; i < (argc-1); i+=2) {
+ if ((!isdigit(UCHAR(argv[i][0]))) &&
+ ((argv[i][0] != '-') || (!isdigit(UCHAR(argv[i][1]))))) {
+ break;
+ }
+ }
+ if (PolygonCoords(interp, canvas, itemPtr, i, argv) != TCL_OK) {
+ goto error;
+ }
+
+ if (ConfigurePolygon(interp, canvas, itemPtr, argc-i, argv+i, 0)
+ == TCL_OK) {
+ return TCL_OK;
+ }
+
+ error:
+ DeletePolygon(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+PolygonCoords(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, ... */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ char buffer[TCL_DOUBLE_SPACE];
+ int i, numPoints;
+
+ if (argc == 0) {
+ /*
+ * Print the coords used to create the polygon. If we auto
+ * closed the polygon then we don't report the last point.
+ */
+ for (i = 0; i < 2*(polyPtr->numPoints - polyPtr->autoClosed); i++) {
+ Tcl_PrintDouble(interp, polyPtr->coordPtr[i], buffer);
+ Tcl_AppendElement(interp, buffer);
+ }
+ } else if (argc < 6) {
+ Tcl_AppendResult(interp,
+ "too few coordinates for polygon: must have at least 6",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else if (argc & 1) {
+ Tcl_AppendResult(interp,
+ "odd number of coordinates specified for polygon",
+ (char *) NULL);
+ return TCL_ERROR;
+ } else {
+ numPoints = argc/2;
+ if (polyPtr->pointsAllocated <= numPoints) {
+ if (polyPtr->coordPtr != NULL) {
+ ckfree((char *) polyPtr->coordPtr);
+ }
+
+ /*
+ * One extra point gets allocated here, just in case we have
+ * to add another point to close the polygon.
+ */
+
+ polyPtr->coordPtr = (double *) ckalloc((unsigned)
+ (sizeof(double) * (argc+2)));
+ polyPtr->pointsAllocated = numPoints+1;
+ }
+ for (i = argc-1; i >= 0; i--) {
+ if (Tk_CanvasGetCoord(interp, canvas, argv[i],
+ &polyPtr->coordPtr[i]) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ polyPtr->numPoints = numPoints;
+ polyPtr->autoClosed = 0;
+
+ /*
+ * Close the polygon if it isn't already closed.
+ */
+
+ if ((polyPtr->coordPtr[argc-2] != polyPtr->coordPtr[0])
+ || (polyPtr->coordPtr[argc-1] != polyPtr->coordPtr[1])) {
+ polyPtr->autoClosed = 1;
+ polyPtr->numPoints++;
+ polyPtr->coordPtr[argc] = polyPtr->coordPtr[0];
+ polyPtr->coordPtr[argc+1] = polyPtr->coordPtr[1];
+ }
+ ComputePolygonBbox(canvas, polyPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigurePolygon(interp, canvas, itemPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Polygon item to reconfigure. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+ Tk_Window tkwin;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
+ (char *) polyPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as
+ * graphics contexts.
+ */
+
+ if (polyPtr->width < 1) {
+ polyPtr->width = 1;
+ }
+ if (polyPtr->outlineColor == NULL) {
+ newGC = None;
+ } else {
+ gcValues.foreground = polyPtr->outlineColor->pixel;
+ gcValues.line_width = polyPtr->width;
+ gcValues.cap_style = CapRound;
+ gcValues.join_style = JoinRound;
+ mask = GCForeground|GCLineWidth|GCCapStyle|GCJoinStyle;
+ newGC = Tk_GetGCColor(tkwin, mask, &gcValues, polyPtr->outlineColor,
+ NULL);
+ }
+ if (polyPtr->outlineGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), polyPtr->outlineGC);
+ }
+ polyPtr->outlineGC = newGC;
+
+ if (polyPtr->fillColor == NULL) {
+ newGC = None;
+ } else {
+ gcValues.foreground = polyPtr->fillColor->pixel;
+ mask = GCForeground;
+ if (polyPtr->fillStipple != None) {
+ gcValues.stipple = polyPtr->fillStipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ newGC = Tk_GetGCColor(tkwin, mask, &gcValues, polyPtr->fillColor,
+ NULL);
+ }
+ if (polyPtr->fillGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), polyPtr->fillGC);
+ }
+ polyPtr->fillGC = newGC;
+
+ /*
+ * Keep spline parameters within reasonable limits.
+ */
+
+ if (polyPtr->splineSteps < 1) {
+ polyPtr->splineSteps = 1;
+ } else if (polyPtr->splineSteps > 100) {
+ polyPtr->splineSteps = 100;
+ }
+
+ ComputePolygonBbox(canvas, polyPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeletePolygon --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a polygon item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeletePolygon(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. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+
+ if (polyPtr->coordPtr != NULL) {
+ ckfree((char *) polyPtr->coordPtr);
+ }
+ if (polyPtr->fillColor != NULL) {
+ Tk_FreeColor(polyPtr->fillColor);
+ }
+ if (polyPtr->fillStipple != None) {
+ Tk_FreeBitmap(display, polyPtr->fillStipple);
+ }
+ if (polyPtr->outlineColor != NULL) {
+ Tk_FreeColor(polyPtr->outlineColor);
+ }
+ if (polyPtr->outlineGC != None) {
+ Tk_FreeGC(display, polyPtr->outlineGC);
+ }
+ if (polyPtr->fillGC != None) {
+ Tk_FreeGC(display, polyPtr->fillGC);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputePolygonBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a polygon.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputePolygonBbox(canvas, polyPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ PolygonItem *polyPtr; /* Item whose bbox is to be
+ * recomputed. */
+{
+ double *coordPtr;
+ int i;
+
+ coordPtr = polyPtr->coordPtr;
+ polyPtr->header.x1 = polyPtr->header.x2 = (int) *coordPtr;
+ polyPtr->header.y1 = polyPtr->header.y2 = (int) coordPtr[1];
+
+ for (i = 1, coordPtr = polyPtr->coordPtr+2; i < polyPtr->numPoints;
+ i++, coordPtr += 2) {
+ TkIncludePoint((Tk_Item *) polyPtr, coordPtr);
+ }
+
+ /*
+ * Expand bounding box in all directions to account for the outline,
+ * which can stick out beyond the polygon. Add one extra pixel of
+ * fudge, just in case X rounds differently than we do.
+ */
+
+ i = (polyPtr->width+1)/2 + 1;
+ polyPtr->header.x1 -= i;
+ polyPtr->header.x2 += i;
+ polyPtr->header.y1 -= i;
+ polyPtr->header.y2 += i;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkFillPolygon --
+ *
+ * This procedure is invoked to convert a polygon to screen
+ * coordinates and display it using a particular GC.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkFillPolygon(canvas, coordPtr, numPoints, display, drawable, gc, outlineGC)
+ Tk_Canvas canvas; /* Canvas whose coordinate system
+ * is to be used for drawing. */
+ double *coordPtr; /* Array of coordinates for polygon:
+ * x1, y1, x2, y2, .... */
+ int numPoints; /* Twice this many coordinates are
+ * present at *coordPtr. */
+ Display *display; /* Display on which to draw polygon. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * polygon. */
+ GC gc; /* Graphics context for drawing. */
+ GC outlineGC; /* If not None, use this to draw an
+ * outline around the polygon after
+ * filling it. */
+{
+ XPoint staticPoints[MAX_STATIC_POINTS];
+ XPoint *pointPtr;
+ XPoint *pPtr;
+ int i;
+
+ /*
+ * Build up an array of points in screen coordinates. Use a
+ * static array unless the polygon has an enormous number of points;
+ * in this case, dynamically allocate an array.
+ */
+
+ if (numPoints <= MAX_STATIC_POINTS) {
+ pointPtr = staticPoints;
+ } else {
+ pointPtr = (XPoint *) ckalloc((unsigned) (numPoints * sizeof(XPoint)));
+ }
+
+ for (i = 0, pPtr = pointPtr; i < numPoints; i += 1, coordPtr += 2, pPtr++) {
+ Tk_CanvasDrawableCoords(canvas, coordPtr[0], coordPtr[1], &pPtr->x,
+ &pPtr->y);
+ }
+
+ /*
+ * Display polygon, then free up polygon storage if it was dynamically
+ * allocated.
+ */
+
+ if (gc != None) {
+ XFillPolygon(display, drawable, gc, pointPtr, numPoints, Complex,
+ CoordModeOrigin);
+ }
+ if (outlineGC != None) {
+ XDrawLines(display, drawable, outlineGC, pointPtr,
+ numPoints, CoordModeOrigin);
+ }
+ if (pointPtr != staticPoints) {
+ ckfree((char *) pointPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayPolygon --
+ *
+ * This procedure is invoked to draw a polygon item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayPolygon(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). */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+
+ if ((polyPtr->fillGC == None) && (polyPtr->outlineGC == 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 ((polyPtr->fillStipple != None) && (polyPtr->fillGC != None)) {
+ Tk_CanvasSetStippleOrigin(canvas, polyPtr->fillGC);
+ }
+
+ if (!polyPtr->smooth) {
+ TkFillPolygon(canvas, polyPtr->coordPtr, polyPtr->numPoints,
+ display, drawable, polyPtr->fillGC, polyPtr->outlineGC);
+ } else {
+ int numPoints;
+ XPoint staticPoints[MAX_STATIC_POINTS];
+ XPoint *pointPtr;
+
+ /*
+ * This is a smoothed polygon. Display using a set of generated
+ * spline points rather than the original points.
+ */
+
+ numPoints = 1 + polyPtr->numPoints*polyPtr->splineSteps;
+ if (numPoints <= MAX_STATIC_POINTS) {
+ pointPtr = staticPoints;
+ } else {
+ pointPtr = (XPoint *) ckalloc((unsigned)
+ (numPoints * sizeof(XPoint)));
+ }
+ numPoints = TkMakeBezierCurve(canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps, pointPtr,
+ (double *) NULL);
+ if (polyPtr->fillGC != None) {
+ XFillPolygon(display, drawable, polyPtr->fillGC, pointPtr,
+ numPoints, Complex, CoordModeOrigin);
+ }
+ if (polyPtr->outlineGC != None) {
+ XDrawLines(display, drawable, polyPtr->outlineGC, pointPtr,
+ numPoints, CoordModeOrigin);
+ }
+ if (pointPtr != staticPoints) {
+ ckfree((char *) pointPtr);
+ }
+ }
+ if ((polyPtr->fillStipple != None) && (polyPtr->fillGC != None)) {
+ XSetTSOrigin(display, polyPtr->fillGC, 0, 0);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * polygon, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are pointPtr[0] and pointPtr[1] is inside the polygon. If the
+ * point isn't inside the polygon then the return value is the
+ * distance from the point to the polygon.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+PolygonToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ double *coordPtr, distance;
+ double staticSpace[2*MAX_STATIC_POINTS];
+ int numPoints;
+
+ if (!polyPtr->smooth) {
+ distance = TkPolygonToPoint(polyPtr->coordPtr, polyPtr->numPoints,
+ pointPtr);
+ } else {
+ /*
+ * Smoothed polygon. Generate a new set of points and use them
+ * for comparison.
+ */
+
+ numPoints = 1 + polyPtr->numPoints*polyPtr->splineSteps;
+ if (numPoints <= MAX_STATIC_POINTS) {
+ coordPtr = staticSpace;
+ } else {
+ coordPtr = (double *) ckalloc((unsigned)
+ (2*numPoints*sizeof(double)));
+ }
+ numPoints = TkMakeBezierCurve(canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL,
+ coordPtr);
+ distance = TkPolygonToPoint(coordPtr, numPoints, pointPtr);
+ if (coordPtr != staticSpace) {
+ ckfree((char *) coordPtr);
+ }
+ }
+ if (polyPtr->outlineColor != NULL) {
+ distance -= polyPtr->width/2.0;
+ if (distance < 0) {
+ distance = 0;
+ }
+ }
+ return distance;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+PolygonToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against polygon. */
+ double *rectPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ double *coordPtr, rect2[4], halfWidth;
+ double staticSpace[2*MAX_STATIC_POINTS];
+ int numPoints, result;
+
+ /*
+ * Handle smoothed polygons by generating an expanded set of points
+ * against which to do the check.
+ */
+
+ if (polyPtr->smooth) {
+ numPoints = 1 + polyPtr->numPoints*polyPtr->splineSteps;
+ if (numPoints <= MAX_STATIC_POINTS) {
+ coordPtr = staticSpace;
+ } else {
+ coordPtr = (double *) ckalloc((unsigned)
+ (2*numPoints*sizeof(double)));
+ }
+ numPoints = TkMakeBezierCurve(canvas, polyPtr->coordPtr,
+ polyPtr->numPoints, polyPtr->splineSteps, (XPoint *) NULL,
+ coordPtr);
+ } else {
+ numPoints = polyPtr->numPoints;
+ coordPtr = polyPtr->coordPtr;
+ }
+
+ if (polyPtr->width <= 1) {
+ /*
+ * The outline of the polygon doesn't stick out, so we can
+ * do a simple check.
+ */
+
+ result = TkPolygonToArea(coordPtr, numPoints, rectPtr);
+ } else {
+ /*
+ * The polygon has a wide outline, so the check is more complicated.
+ * First, check the line segments to see if they overlap the area.
+ */
+
+ result = TkThickPolyLineToArea(coordPtr, numPoints,
+ (double) polyPtr->width, CapRound, JoinRound, rectPtr);
+ if (result >= 0) {
+ goto done;
+ }
+
+ /*
+ * There is no overlap between the polygon's outline and the
+ * rectangle. This means either the rectangle is entirely outside
+ * the polygon or entirely inside. To tell the difference,
+ * see whether the polygon (with 0 outline width) overlaps the
+ * rectangle bloated by half the outline width.
+ */
+
+ halfWidth = polyPtr->width/2.0;
+ rect2[0] = rectPtr[0] - halfWidth;
+ rect2[1] = rectPtr[1] - halfWidth;
+ rect2[2] = rectPtr[2] + halfWidth;
+ rect2[3] = rectPtr[3] + halfWidth;
+ if (TkPolygonToArea(coordPtr, numPoints, rect2) == -1) {
+ result = -1;
+ } else {
+ result = 0;
+ }
+ }
+
+ done:
+ if ((coordPtr != staticSpace) && (coordPtr != polyPtr->coordPtr)) {
+ ckfree((char *) coordPtr);
+ }
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScalePolygon --
+ *
+ * This procedure is invoked to rescale a polygon item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The polygon referred to by itemPtr is rescaled so that the
+ * following transformation is applied to all point
+ * coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScalePolygon(canvas, itemPtr, originX, originY, scaleX, scaleY)
+ Tk_Canvas canvas; /* Canvas containing polygon. */
+ Tk_Item *itemPtr; /* Polygon 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. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ double *coordPtr;
+ int i;
+
+ for (i = 0, coordPtr = polyPtr->coordPtr; i < polyPtr->numPoints;
+ i++, coordPtr += 2) {
+ *coordPtr = originX + scaleX*(*coordPtr - originX);
+ coordPtr[1] = originY + scaleY*(coordPtr[1] - originY);
+ }
+ ComputePolygonBbox(canvas, polyPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslatePolygon --
+ *
+ * This procedure is called to move a polygon by a given
+ * amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the polygon is offset by (xDelta, yDelta),
+ * and the bounding box is updated in the generic part of the
+ * item structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslatePolygon(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. */
+{
+ PolygonItem *polyPtr = (PolygonItem *) itemPtr;
+ double *coordPtr;
+ int i;
+
+ for (i = 0, coordPtr = polyPtr->coordPtr; i < polyPtr->numPoints;
+ i++, coordPtr += 2) {
+ *coordPtr += deltaX;
+ coordPtr[1] += deltaY;
+ }
+ ComputePolygonBbox(canvas, polyPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PolygonToPostscript --
+ *
+ * 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) {
+ if (!polyPtr->smooth) {
+ Tk_CanvasPsPath(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints);
+ } else {
+ TkMakeBezierPostscript(interp, canvas, polyPtr->coordPtr,
+ polyPtr->numPoints);
+ }
+ if (Tk_CanvasPsColor(interp, canvas, polyPtr->fillColor) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (polyPtr->fillStipple != None) {
+ Tcl_AppendResult(interp, "eoclip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, polyPtr->fillStipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (polyPtr->outlineColor != NULL) {
+ Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
+ }
+ } else {
+ Tcl_AppendResult(interp, "eofill\n", (char *) NULL);
+ }
+ }
+
+ /*
+ * 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);
+ }
+
+ sprintf(string, "%d setlinewidth\n", polyPtr->width);
+ Tcl_AppendResult(interp, string,
+ "1 setlinecap\n1 setlinejoin\n", (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, polyPtr->outlineColor)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, "stroke\n", (char *) NULL);
+ }
+ return TCL_OK;
+}
diff --git a/tk/generic/tkCanvPs.c b/tk/generic/tkCanvPs.c
new file mode 100644
index 00000000000..eb45f87b80b
--- /dev/null
+++ b/tk/generic/tkCanvPs.c
@@ -0,0 +1,1386 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkCanvas.h"
+#include "tkPort.h"
+
+/*
+ * See tkCanvas.h for key data structures used to implement canvases.
+ */
+
+/*
+ * One of the following structures is created to keep track of Postscript
+ * output being generated. It consists mostly of information provided on
+ * the widget command line.
+ */
+
+typedef struct TkPostscriptInfo {
+ int x, y, width, height; /* Area to print, in canvas pixel
+ * coordinates. */
+ int x2, y2; /* x+width and y+height. */
+ char *pageXString; /* String value of "-pagex" option or NULL. */
+ char *pageYString; /* String value of "-pagey" option or NULL. */
+ double pageX, pageY; /* Postscript coordinates (in points)
+ * corresponding to pageXString and
+ * pageYString. Don't forget that y-values
+ * grow upwards for Postscript! */
+ char *pageWidthString; /* Printed width of output. */
+ char *pageHeightString; /* Printed height of output. */
+ double scale; /* Scale factor for conversion: each pixel
+ * maps into this many points. */
+ Tk_Anchor pageAnchor; /* How to anchor bbox on Postscript page. */
+ int rotate; /* Non-zero means output should be rotated
+ * on page (landscape mode). */
+ char *fontVar; /* If non-NULL, gives name of global variable
+ * containing font mapping information.
+ * Malloc'ed. */
+ char *colorVar; /* If non-NULL, give name of global variable
+ * containing color mapping information.
+ * Malloc'ed. */
+ char *colorMode; /* Mode for handling colors: "monochrome",
+ * "gray", or "color". Malloc'ed. */
+ int colorLevel; /* Numeric value corresponding to colorMode:
+ * 0 for mono, 1 for gray, 2 for color. */
+ char *fileName; /* Name of file in which to write Postscript;
+ * NULL means return Postscript info as
+ * result. Malloc'ed. */
+ char *channelName; /* If -channel is specified, the name of
+ * the channel to use. */
+ Tcl_Channel chan; /* Open channel corresponding to fileName. */
+ Tcl_HashTable fontTable; /* Hash table containing names of all font
+ * families used in output. The hash table
+ * values are not used. */
+ int prepass; /* Non-zero means that we're currently in
+ * the pre-pass that collects font information,
+ * so the Postscript generated isn't
+ * relevant. */
+} TkPostscriptInfo;
+
+/*
+ * The table below provides a template that's used to process arguments
+ * to the canvas "postscript" command and fill in TkPostscriptInfo
+ * structures.
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_STRING, "-colormap", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, colorVar), 0},
+ {TK_CONFIG_STRING, "-colormode", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, colorMode), 0},
+ {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, fileName), 0},
+ {TK_CONFIG_STRING, "-channel", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, channelName), 0},
+ {TK_CONFIG_STRING, "-fontmap", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, fontVar), 0},
+ {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, height), 0},
+ {TK_CONFIG_ANCHOR, "-pageanchor", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageAnchor), 0},
+ {TK_CONFIG_STRING, "-pageheight", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageHeightString), 0},
+ {TK_CONFIG_STRING, "-pagewidth", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageWidthString), 0},
+ {TK_CONFIG_STRING, "-pagex", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageXString), 0},
+ {TK_CONFIG_STRING, "-pagey", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, pageYString), 0},
+ {TK_CONFIG_BOOLEAN, "-rotate", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, rotate), 0},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TkPostscriptInfo, width), 0},
+ {TK_CONFIG_PIXELS, "-x", (char *) NULL, (char *) NULL,
+ "", 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.
+ */
+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$\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));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkCanvPostscriptCmd --
+ *
+ * This procedure is invoked to process the "postscript" options
+ * of the widget command for canvas widgets. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TkCanvPostscriptCmd(canvasPtr, interp, argc, argv)
+ TkCanvas *canvasPtr; /* Information about canvas widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. Caller has
+ * already parsed this command enough
+ * to know that argv[1] is
+ * "postscript". */
+{
+ TkPostscriptInfo psInfo, *oldInfoPtr;
+ int result;
+ Tk_Item *itemPtr;
+#define STRING_LENGTH 400
+ char string[STRING_LENGTH+1], *p;
+ time_t now;
+ size_t length;
+ int deltaX = 0, deltaY = 0; /* Offset of lower-left corner of
+ * area to be marked up, measured
+ * in canvas units from the positioning
+ * 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.
+ *----------------------------------------------------------------
+ */
+
+ oldInfoPtr = canvasPtr->psInfoPtr;
+ canvasPtr->psInfoPtr = &psInfo;
+ psInfo.x = canvasPtr->xOrigin;
+ psInfo.y = canvasPtr->yOrigin;
+ psInfo.width = -1;
+ psInfo.height = -1;
+ psInfo.pageXString = NULL;
+ psInfo.pageYString = NULL;
+ psInfo.pageX = 72*4.25;
+ psInfo.pageY = 72*5.5;
+ psInfo.pageWidthString = NULL;
+ psInfo.pageHeightString = NULL;
+ psInfo.scale = 1.0;
+ psInfo.pageAnchor = TK_ANCHOR_CENTER;
+ psInfo.rotate = 0;
+ psInfo.fontVar = NULL;
+ psInfo.colorVar = NULL;
+ psInfo.colorMode = NULL;
+ psInfo.colorLevel = 0;
+ psInfo.fileName = NULL;
+ psInfo.channelName = NULL;
+ psInfo.chan = NULL;
+ psInfo.prepass = 0;
+ Tcl_InitHashTable(&psInfo.fontTable, TCL_STRING_KEYS);
+ result = Tk_ConfigureWidget(canvasPtr->interp, canvasPtr->tkwin,
+ configSpecs, argc-2, argv+2, (char *) &psInfo,
+ TK_CONFIG_ARGV_ONLY);
+ if (result != TCL_OK) {
+ goto cleanup;
+ }
+
+ if (psInfo.width == -1) {
+ psInfo.width = Tk_Width(canvasPtr->tkwin);
+ }
+ if (psInfo.height == -1) {
+ psInfo.height = Tk_Height(canvasPtr->tkwin);
+ }
+ psInfo.x2 = psInfo.x + psInfo.width;
+ psInfo.y2 = psInfo.y + psInfo.height;
+
+ if (psInfo.pageXString != NULL) {
+ if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageXString,
+ &psInfo.pageX) != TCL_OK) {
+ goto cleanup;
+ }
+ }
+ if (psInfo.pageYString != NULL) {
+ if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageYString,
+ &psInfo.pageY) != TCL_OK) {
+ goto cleanup;
+ }
+ }
+ if (psInfo.pageWidthString != NULL) {
+ if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageWidthString,
+ &psInfo.scale) != TCL_OK) {
+ goto cleanup;
+ }
+ psInfo.scale /= psInfo.width;
+ } else if (psInfo.pageHeightString != NULL) {
+ if (GetPostscriptPoints(canvasPtr->interp, psInfo.pageHeightString,
+ &psInfo.scale) != TCL_OK) {
+ goto cleanup;
+ }
+ psInfo.scale /= psInfo.height;
+ } else {
+ psInfo.scale = (72.0/25.4)*WidthMMOfScreen(Tk_Screen(canvasPtr->tkwin));
+ psInfo.scale /= WidthOfScreen(Tk_Screen(canvasPtr->tkwin));
+ }
+ switch (psInfo.pageAnchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_SW:
+ deltaX = 0;
+ break;
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_S:
+ deltaX = -psInfo.width/2;
+ break;
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_E:
+ case TK_ANCHOR_SE:
+ deltaX = -psInfo.width;
+ break;
+ }
+ switch (psInfo.pageAnchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ deltaY = - psInfo.height;
+ break;
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_E:
+ deltaY = -psInfo.height/2;
+ break;
+ case TK_ANCHOR_SW:
+ case TK_ANCHOR_S:
+ case TK_ANCHOR_SE:
+ deltaY = 0;
+ break;
+ }
+
+ if (psInfo.colorMode == NULL) {
+ psInfo.colorLevel = 2;
+ } else {
+ length = strlen(psInfo.colorMode);
+ if (strncmp(psInfo.colorMode, "monochrome", length) == 0) {
+ psInfo.colorLevel = 0;
+ } else if (strncmp(psInfo.colorMode, "gray", length) == 0) {
+ psInfo.colorLevel = 1;
+ } else if (strncmp(psInfo.colorMode, "color", length) == 0) {
+ psInfo.colorLevel = 2;
+ } else {
+ Tcl_AppendResult(canvasPtr->interp, "bad color mode \"",
+ psInfo.colorMode, "\": must be monochrome, ",
+ "gray, or color", (char *) NULL);
+ goto cleanup;
+ }
+ }
+
+ if (psInfo.fileName != NULL) {
+
+ /*
+ * Check that -file and -channel are not both specified.
+ */
+
+ if (psInfo.channelName != NULL) {
+ Tcl_AppendResult(canvasPtr->interp, "can't specify both -file",
+ " and -channel", (char *) NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+
+ /*
+ * Check that we are not in a safe interpreter. If we are, disallow
+ * the -file specification.
+ */
+
+ if (Tcl_IsSafe(canvasPtr->interp)) {
+ Tcl_AppendResult(canvasPtr->interp, "can't specify -file in a",
+ " safe interpreter", (char *) NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+
+ p = Tcl_TranslateFileName(canvasPtr->interp, psInfo.fileName, &buffer);
+ if (p == NULL) {
+ goto cleanup;
+ }
+ psInfo.chan = Tcl_OpenFileChannel(canvasPtr->interp, p, "w", 0666);
+ Tcl_DStringFree(&buffer);
+ if (psInfo.chan == NULL) {
+ goto cleanup;
+ }
+ }
+
+ if (psInfo.channelName != NULL) {
+ int mode;
+
+ /*
+ * Check that the channel is found in this interpreter and that it
+ * is open for writing.
+ */
+
+ psInfo.chan = Tcl_GetChannel(canvasPtr->interp, psInfo.channelName,
+ &mode);
+ if (psInfo.chan == (Tcl_Channel) NULL) {
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ if ((mode & TCL_WRITABLE) == 0) {
+ Tcl_AppendResult(canvasPtr->interp, "channel \"",
+ psInfo.channelName, "\" wasn't opened for writing",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto cleanup;
+ }
+ }
+
+ /*
+ *--------------------------------------------------------
+ * Make a pre-pass over all of the items, generating Postscript
+ * and then throwing it away. The purpose of this pass is just
+ * to collect information about all the fonts in use, so that
+ * we can output font information in the proper form required
+ * by the Document Structuring Conventions.
+ *--------------------------------------------------------
+ */
+
+ psInfo.prepass = 1;
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
+ || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
+ continue;
+ }
+ if (itemPtr->typePtr->postscriptProc == NULL) {
+ continue;
+ }
+ result = (*itemPtr->typePtr->postscriptProc)(canvasPtr->interp,
+ (Tk_Canvas) canvasPtr, itemPtr, 1);
+ Tcl_ResetResult(canvasPtr->interp);
+ if (result != TCL_OK) {
+ /*
+ * An error just occurred. Just skip out of this loop.
+ * There's no need to report the error now; it can be
+ * reported later (errors can happen later that don't
+ * happen now, so we still have to check for errors later
+ * anyway).
+ */
+ break;
+ }
+ }
+ psInfo.prepass = 0;
+
+ /*
+ *--------------------------------------------------------
+ * 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)
+ + 1.0));
+ } else {
+ sprintf(string, "%d %d %d %d",
+ (int) (psInfo.pageX - psInfo.scale*(deltaY + psInfo.height)),
+ (int) (psInfo.pageY + psInfo.scale*deltaX),
+ (int) (psInfo.pageX - psInfo.scale*deltaY + 1.0),
+ (int) (psInfo.pageY + psInfo.scale*(deltaX + psInfo.width)
+ + 1.0));
+ }
+ Tcl_AppendResult(canvasPtr->interp, "%%BoundingBox: ", string,
+ "\n", (char *) NULL);
+ Tcl_AppendResult(canvasPtr->interp, "%%Pages: 1\n",
+ "%%DocumentData: Clean7Bit\n", (char *) NULL);
+ Tcl_AppendResult(canvasPtr->interp, "%%Orientation: ",
+ psInfo.rotate ? "Landscape\n" : "Portrait\n", (char *) NULL);
+ p = "%%DocumentNeededResources: font ";
+ for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendResult(canvasPtr->interp, p,
+ 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, canvasPtr->interp->result, -1);
+ Tcl_ResetResult(canvasPtr->interp);
+ }
+
+ /*
+ *-----------------------------------------------------------
+ * Document setup: set the color level and include fonts.
+ *-----------------------------------------------------------
+ */
+
+ sprintf(string, "/CL %d def\n", psInfo.colorLevel);
+ Tcl_AppendResult(canvasPtr->interp, "%%BeginSetup\n", string,
+ (char *) NULL);
+ for (hPtr = Tcl_FirstHashEntry(&psInfo.fontTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendResult(canvasPtr->interp, "%%IncludeResource: font ",
+ Tcl_GetHashKey(&psInfo.fontTable, hPtr), "\n", (char *) NULL);
+ }
+ Tcl_AppendResult(canvasPtr->interp, "%%EndSetup\n\n", (char *) NULL);
+
+ /*
+ *-----------------------------------------------------------
+ * Page setup: move to page positioning point, rotate if
+ * needed, set scale factor, offset for proper anchor position,
+ * and set clip region.
+ *-----------------------------------------------------------
+ */
+
+ Tcl_AppendResult(canvasPtr->interp, "%%Page: 1 1\n", "save\n",
+ (char *) NULL);
+ sprintf(string, "%.1f %.1f translate\n", psInfo.pageX, psInfo.pageY);
+ Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
+ if (psInfo.rotate) {
+ Tcl_AppendResult(canvasPtr->interp, "90 rotate\n", (char *) NULL);
+ }
+ sprintf(string, "%.4g %.4g scale\n", psInfo.scale, psInfo.scale);
+ Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
+ sprintf(string, "%d %d translate\n", deltaX - psInfo.x, deltaY);
+ Tcl_AppendResult(canvasPtr->interp, string, (char *) NULL);
+ sprintf(string, "%d %.15g moveto %d %.15g lineto %d %.15g lineto %d %.15g",
+ 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.
+ *---------------------------------------------------------------------
+ */
+
+ result = TCL_OK;
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if ((itemPtr->x1 >= psInfo.x2) || (itemPtr->x2 < psInfo.x)
+ || (itemPtr->y1 >= psInfo.y2) || (itemPtr->y2 < psInfo.y)) {
+ continue;
+ }
+ 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.
+ */
+
+ cleanup:
+ if (psInfo.pageXString != NULL) {
+ ckfree(psInfo.pageXString);
+ }
+ if (psInfo.pageYString != NULL) {
+ ckfree(psInfo.pageYString);
+ }
+ if (psInfo.pageWidthString != NULL) {
+ ckfree(psInfo.pageWidthString);
+ }
+ if (psInfo.pageHeightString != NULL) {
+ ckfree(psInfo.pageHeightString);
+ }
+ if (psInfo.fontVar != NULL) {
+ ckfree(psInfo.fontVar);
+ }
+ if (psInfo.colorVar != NULL) {
+ ckfree(psInfo.colorVar);
+ }
+ if (psInfo.colorMode != NULL) {
+ ckfree(psInfo.colorMode);
+ }
+ if (psInfo.fileName != NULL) {
+ ckfree(psInfo.fileName);
+ }
+ if ((psInfo.chan != NULL) && (psInfo.channelName == NULL)) {
+ Tcl_Close(canvasPtr->interp, psInfo.chan);
+ }
+ if (psInfo.channelName != NULL) {
+ ckfree(psInfo.channelName);
+ }
+ Tcl_DeleteHashTable(&psInfo.fontTable);
+ canvasPtr->psInfoPtr = oldInfoPtr;
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsColor --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasPsColor(interp, canvas, colorPtr)
+ Tcl_Interp *interp; /* Interpreter for returning Postscript
+ * or error message. */
+ Tk_Canvas canvas; /* Information about canvas. */
+ XColor *colorPtr; /* Information about color. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
+ int tmp;
+ double red, green, blue;
+ char string[200];
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * If there is a color map defined, then look up the color's name
+ * in the map and use the Postscript commands found there, if there
+ * are any.
+ */
+
+ if (psInfoPtr->colorVar != NULL) {
+ char *cmdString;
+
+ cmdString = Tcl_GetVar2(interp, psInfoPtr->colorVar,
+ Tk_NameOfColor(colorPtr), 0);
+ if (cmdString != NULL) {
+ Tcl_AppendResult(interp, cmdString, "\n", (char *) NULL);
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * No color map entry for this color. Grab the color's intensities
+ * and output Postscript commands for them. Special note: X uses
+ * a range of 0-65535 for intensities, but most displays only use
+ * a range of 0-255, which maps to (0, 256, 512, ... 65280) in the
+ * X scale. This means that there's no way to get perfect white,
+ * since the highest intensity is only 65280 out of 65535. To
+ * work around this problem, rescale the X intensity to a 0-255
+ * scale and use that as the basis for the Postscript colors. This
+ * scheme still won't work if the display only uses 4 bits per color,
+ * but most diplays use at least 8 bits.
+ */
+
+ tmp = colorPtr->red;
+ red = ((double) (tmp >> 8))/255.0;
+ tmp = colorPtr->green;
+ green = ((double) (tmp >> 8))/255.0;
+ tmp = colorPtr->blue;
+ blue = ((double) (tmp >> 8))/255.0;
+ sprintf(string, "%.3f %.3f %.3f setrgbcolor AdjustColor\n",
+ red, green, blue);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsFont --
+ *
+ * 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.
+ */
+
+ Tcl_DStringInit(&ds);
+
+ if (psInfoPtr->fontVar != NULL) {
+ char *list, **argv;
+ int argc;
+ double size;
+ char *name;
+
+ name = Tk_NameOfFont(tkfont);
+ list = Tcl_GetVar2(interp, psInfoPtr->fontVar, name, 0);
+ if (list != NULL) {
+ if (Tcl_SplitList(interp, list, &argc, &argv) != TCL_OK) {
+ badMapEntry:
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad font map entry for \"", name,
+ "\": \"", list, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc != 2) {
+ goto badMapEntry;
+ }
+ size = strtod(argv[1], &end);
+ if ((size <= 0) || (*end != 0)) {
+ goto badMapEntry;
+ }
+
+ Tcl_DStringAppend(&ds, argv[0], -1);
+ points = (int) size;
+
+ ckfree((char *) argv);
+ goto findfont;
+ }
+ }
+
+ points = Tk_PostscriptFontName(tkfont, &ds);
+
+ findfont:
+ sprintf(pointString, "%d", points);
+ Tcl_AppendResult(interp, "/", Tcl_DStringValue(&ds), " findfont ",
+ pointString, " scalefont ", (char *) NULL);
+ if (strncasecmp(Tcl_DStringValue(&ds), "Symbol", 7) != 0) {
+ Tcl_AppendResult(interp, "ISOEncode ", (char *) NULL);
+ }
+ Tcl_AppendResult(interp, "setfont\n", (char *) NULL);
+ Tcl_CreateHashEntry(&psInfoPtr->fontTable, Tcl_DStringValue(&ds), &i);
+ Tcl_DStringFree(&ds);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsBitmap --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasPsBitmap(interp, canvas, bitmap, startX, startY, width, height)
+ Tcl_Interp *interp; /* Interpreter for returning Postscript
+ * or error message. */
+ Tk_Canvas canvas; /* Information about canvas. */
+ Pixmap bitmap; /* Bitmap for which to generate
+ * Postscript. */
+ int startX, startY; /* Coordinates of upper-left corner
+ * of rectangular region to output. */
+ int width, height; /* Height of rectangular region. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ TkPostscriptInfo *psInfoPtr = canvasPtr->psInfoPtr;
+ XImage *imagePtr;
+ int charsInLine, x, y, lastX, lastY, value, mask;
+ unsigned int totalWidth, totalHeight;
+ char string[100];
+ Window dummyRoot;
+ int dummyX, dummyY;
+ unsigned dummyBorderwidth, dummyDepth;
+
+ if (psInfoPtr->prepass) {
+ return TCL_OK;
+ }
+
+ /*
+ * The following call should probably be a call to Tk_SizeOfBitmap
+ * instead, but it seems that we are occasionally invoked by custom
+ * item types that create their own bitmaps without registering them
+ * with Tk. XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
+ * it shouldn't matter here.
+ */
+
+ XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot,
+ (int *) &dummyX, (int *) &dummyY, (unsigned int *) &totalWidth,
+ (unsigned int *) &totalHeight, &dummyBorderwidth, &dummyDepth);
+ imagePtr = XGetImage(Tk_Display(canvasPtr->tkwin), bitmap, 0, 0,
+ totalWidth, totalHeight, 1, XYPixmap);
+ Tcl_AppendResult(interp, "<", (char *) NULL);
+ mask = 0x80;
+ value = 0;
+ charsInLine = 0;
+ lastX = startX + width - 1;
+ lastY = startY + height - 1;
+ for (y = lastY; y >= startY; y--) {
+ for (x = startX; x <= lastX; x++) {
+ if (XGetPixel(imagePtr, x, y)) {
+ value |= mask;
+ }
+ mask >>= 1;
+ if (mask == 0) {
+ sprintf(string, "%02x", value);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ mask = 0x80;
+ value = 0;
+ charsInLine += 2;
+ if (charsInLine >= 60) {
+ Tcl_AppendResult(interp, "\n", (char *) NULL);
+ charsInLine = 0;
+ }
+ }
+ }
+ if (mask != 0x80) {
+ sprintf(string, "%02x", value);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ mask = 0x80;
+ value = 0;
+ charsInLine += 2;
+ }
+ }
+ Tcl_AppendResult(interp, ">", (char *) NULL);
+ XDestroyImage(imagePtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsStipple --
+ *
+ * This procedure is called by individual canvas items when
+ * they have created a path that they'd like to be filled with
+ * 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;
+ }
+
+ /*
+ * The following call should probably be a call to Tk_SizeOfBitmap
+ * instead, but it seems that we are occasionally invoked by custom
+ * item types that create their own bitmaps without registering them
+ * with Tk. XGetGeometry is a bit slower than Tk_SizeOfBitmap, but
+ * it shouldn't matter here.
+ */
+
+ XGetGeometry(Tk_Display(Tk_CanvasTkwin(canvas)), bitmap, &dummyRoot,
+ (int *) &dummyX, (int *) &dummyY, (unsigned *) &width,
+ (unsigned *) &height, &dummyBorderwidth, &dummyDepth);
+ sprintf(string, "%d %d ", width, height);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ if (Tk_CanvasPsBitmap(interp, (Tk_Canvas) canvasPtr, bitmap, 0, 0,
+ width, height) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ Tcl_AppendResult(interp, " StippleFill\n", (char *) NULL);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasPsY --
+ *
+ * Given a y-coordinate in canvas coordinates, this procedure
+ * returns a y-coordinate to use for Postscript output.
+ *
+ * Results:
+ * Returns the Postscript coordinate that corresponds to
+ * "y".
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+double
+Tk_CanvasPsY(canvas, y)
+ Tk_Canvas canvas; /* Token for canvas on whose behalf
+ * Postscript is being generated. */
+ double y; /* Y-coordinate in canvas coords. */
+{
+ TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr;
+
+ return psInfoPtr->y2 - y;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CanvasPsPath(interp, canvas, coordPtr, numPoints)
+ Tcl_Interp *interp; /* Put generated Postscript in this
+ * interpreter's result field. */
+ Tk_Canvas canvas; /* Canvas on whose behalf Postscript
+ * is being generated. */
+ double *coordPtr; /* Pointer to first in array of
+ * 2*numPoints coordinates giving
+ * points for path. */
+ int numPoints; /* Number of points at *coordPtr. */
+{
+ TkPostscriptInfo *psInfoPtr = ((TkCanvas *) canvas)->psInfoPtr;
+ char buffer[200];
+
+ if (psInfoPtr->prepass) {
+ return;
+ }
+ sprintf(buffer, "%.15g %.15g moveto\n", coordPtr[0],
+ Tk_CanvasPsY(canvas, coordPtr[1]));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ for (numPoints--, coordPtr += 2; numPoints > 0;
+ numPoints--, coordPtr += 2) {
+ sprintf(buffer, "%.15g %.15g lineto\n", coordPtr[0],
+ Tk_CanvasPsY(canvas, coordPtr[1]));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetPostscriptPoints --
+ *
+ * Given a string, returns the number of Postscript points
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetPostscriptPoints(interp, string, doublePtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ char *string; /* String describing a screen distance. */
+ double *doublePtr; /* Place to store converted result. */
+{
+ char *end;
+ double d;
+
+ d = strtod(string, &end);
+ if (end == string) {
+ error:
+ Tcl_AppendResult(interp, "bad distance \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ switch (*end) {
+ case 'c':
+ d *= 72.0/2.54;
+ end++;
+ break;
+ case 'i':
+ d *= 72.0;
+ end++;
+ break;
+ case 'm':
+ d *= 72.0/25.4;
+ end++;
+ break;
+ case 0:
+ break;
+ case 'p':
+ end++;
+ break;
+ default:
+ goto error;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ if (*end != 0) {
+ goto error;
+ }
+ *doublePtr = d;
+ return TCL_OK;
+}
diff --git a/tk/generic/tkCanvText.c b/tk/generic/tkCanvText.c
new file mode 100644
index 00000000000..fc1dc4c0190
--- /dev/null
+++ b/tk/generic/tkCanvText.c
@@ -0,0 +1,1314 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkCanvas.h"
+#include "tkPort.h"
+#include "default.h"
+
+/*
+ * The structure below defines the record for each text item.
+ */
+
+typedef struct TextItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ Tk_CanvasTextInfo *textInfoPtr;
+ /* Pointer to a structure containing
+ * information about the selection and
+ * insertion cursor. The structure is owned
+ * 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. */
+ GC gc; /* Graphics context for drawing text. */
+ GC selTextGC; /* Graphics context for selected text. */
+ GC cursorOffGC; /* If not None, this gives a graphics context
+ * to use to draw the insertion cursor when
+ * it's off. Used if the selection and
+ * insertion cursor colors are the same. */
+} TextItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+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},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_STRING, "-text", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(TextItem, text), 0},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(TextItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static void ComputeTextBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ TextItem *textPtr));
+static int ConfigureText _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+static int CreateText _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, char **argv));
+static void DeleteText _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayCanvText _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static int GetSelText _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int offset, char *buffer,
+ int maxBytes));
+static int GetTextIndex _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ char *indexString, int *indexPtr));
+static void ScaleText _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void SetTextCursor _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int index));
+static int TextCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr,
+ int argc, char **argv));
+static void TextDeleteChars _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int first, int last));
+static void TextInsert _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, int beforeThis, char *string));
+static int TextToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double TextToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr));
+static int TextToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static void TranslateText _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+
+/*
+ * 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;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &textPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1], &textPtr->y)
+ != TCL_OK)) {
+ return TCL_ERROR;
+ }
+
+ if (ConfigureText(interp, canvas, itemPtr, argc-2, argv+2, 0) != TCL_OK) {
+ DeleteText(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureText(interp, canvas, itemPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Rectangle item to reconfigure. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ TextItem *textPtr = (TextItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC, newSelGC;
+ unsigned long mask;
+ Tk_Window tkwin;
+ Tk_CanvasTextInfo *textInfoPtr = textPtr->textInfoPtr;
+ XColor *selBgColorPtr;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
+ (char *) textPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as
+ * graphics contexts.
+ */
+
+ newGC = newSelGC = None;
+ if ((textPtr->color != NULL) && (textPtr->tkfont != NULL)) {
+ gcValues.foreground = textPtr->color->pixel;
+ gcValues.font = Tk_FontId(textPtr->tkfont);
+ mask = GCForeground|GCFont;
+ if (textPtr->stipple != None) {
+ gcValues.stipple = textPtr->stipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCForeground|GCStipple|GCFillStyle;
+ }
+ newGC = Tk_GetGCColor(tkwin, mask, &gcValues, textPtr->color, NULL);
+ gcValues.foreground = textInfoPtr->selFgColorPtr->pixel;
+ newSelGC = Tk_GetGCColor(tkwin, mask, &gcValues,
+ textInfoPtr->selFgColorPtr, NULL);
+ }
+ if (textPtr->gc != None) {
+ Tk_FreeGC(Tk_Display(tkwin), textPtr->gc);
+ }
+ textPtr->gc = newGC;
+ if (textPtr->selTextGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), textPtr->selTextGC);
+ }
+ textPtr->selTextGC = newSelGC;
+
+ selBgColorPtr = Tk_3DBorderColor(textInfoPtr->selBorder);
+ if (Tk_3DBorderColor(textInfoPtr->insertBorder)->pixel
+ == selBgColorPtr->pixel) {
+ if (selBgColorPtr->pixel == BlackPixelOfScreen(Tk_Screen(tkwin))) {
+ gcValues.foreground = WhitePixelOfScreen(Tk_Screen(tkwin));
+ } else {
+ gcValues.foreground = BlackPixelOfScreen(Tk_Screen(tkwin));
+ }
+ newGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ } else {
+ newGC = None;
+ }
+ if (textPtr->cursorOffGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), textPtr->cursorOffGC);
+ }
+ textPtr->cursorOffGC = newGC;
+
+
+ /*
+ * 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;
+ }
+
+ ComputeTextBbox(canvas, textPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteText --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a text item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * 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);
+ if (textPtr->stipple != None) {
+ Tk_FreeBitmap(display, textPtr->stipple);
+ }
+ if (textPtr->text != NULL) {
+ ckfree(textPtr->text);
+ }
+
+ Tk_FreeTextLayout(textPtr->textLayout);
+ if (textPtr->gc != None) {
+ Tk_FreeGC(display, textPtr->gc);
+ }
+ if (textPtr->selTextGC != None) {
+ Tk_FreeGC(display, textPtr->selTextGC);
+ }
+ if (textPtr->cursorOffGC != None) {
+ Tk_FreeGC(display, textPtr->cursorOffGC);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeTextBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a text item.
+ * In addition, it recomputes all of the geometry information
+ * used to display a text item or check for mouse hits.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr, and the linePtr structure is regenerated
+ * 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,
+ textPtr->justify, 0, &width, &height);
+
+ /*
+ * Use overall geometry information to compute the top-left corner
+ * of the bounding box for the text item.
+ */
+
+ leftX = (int) (textPtr->x + 0.5);
+ topY = (int) (textPtr->y + 0.5);
+ switch (textPtr->anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ break;
+
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_E:
+ topY -= height / 2;
+ break;
+
+ case TK_ANCHOR_SW:
+ case TK_ANCHOR_S:
+ case TK_ANCHOR_SE:
+ topY -= height;
+ break;
+ }
+ switch (textPtr->anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_SW:
+ break;
+
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_S:
+ leftX -= width / 2;
+ break;
+
+ case TK_ANCHOR_NE:
+ case TK_ANCHOR_E:
+ case TK_ANCHOR_SE:
+ leftX -= width;
+ break;
+ }
+
+ textPtr->leftEdge = leftX;
+ textPtr->rightEdge = leftX + width;
+
+ /*
+ * Last of all, update the bounding box for the item. The item's
+ * bounding box includes the bounding box of all its lines, plus
+ * an extra fudge factor for the cursor border (which could
+ * potentially be quite large).
+ */
+
+ textInfoPtr = textPtr->textInfoPtr;
+ fudge = (textInfoPtr->insertWidth + 1) / 2;
+ if (textInfoPtr->selBorderWidth > fudge) {
+ fudge = textInfoPtr->selBorderWidth;
+ }
+ textPtr->header.x1 = leftX - fudge;
+ textPtr->header.y1 = topY;
+ textPtr->header.x2 = leftX + width + fudge;
+ textPtr->header.y2 = topY + height;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayCanvText --
+ *
+ * This procedure is invoked to draw a text item in a given
+ * drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * 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),
+ &drawableX, &drawableY);
+ Tk_Fill3DRectangle(Tk_CanvasTkwin(canvas), drawable,
+ textInfoPtr->selBorder, drawableX, drawableY,
+ width + 2 * textInfoPtr->selBorderWidth,
+ height, textInfoPtr->selBorderWidth, TK_RELIEF_RAISED);
+ x = 0;
+ }
+ }
+ }
+
+ /*
+ * If the insertion point should be displayed, then draw a special
+ * background for the cursor before drawing the text. Note: if
+ * we're the cursor item but the cursor is turned off, then redraw
+ * background over the area of the cursor. This guarantees that
+ * the selection won't make the cursor invisible on mono displays,
+ * where both are drawn in the same color.
+ */
+
+ if ((textInfoPtr->focusItemPtr == itemPtr) && (textInfoPtr->gotFocus)) {
+ if (Tk_CharBbox(textPtr->textLayout, textPtr->insertPos,
+ &x, &y, NULL, &height)) {
+ Tk_CanvasDrawableCoords(canvas,
+ (double) (textPtr->leftEdge + x
+ - (textInfoPtr->insertWidth / 2)),
+ (double) (textPtr->header.y1 + y),
+ &drawableX, &drawableY);
+ if (textInfoPtr->cursorOn) {
+ Tk_Fill3DRectangle(Tk_CanvasTkwin(canvas), drawable,
+ textInfoPtr->insertBorder,
+ drawableX, drawableY,
+ textInfoPtr->insertWidth, height,
+ textInfoPtr->insertBorderWidth, TK_RELIEF_RAISED);
+ } else if (textPtr->cursorOffGC != None) {
+ /*
+ * Redraw the background over the area of the cursor,
+ * even though the cursor is turned off. This
+ * guarantees that the selection won't make the cursor
+ * invisible on mono displays, where both may be drawn
+ * in the same color.
+ */
+
+ XFillRectangle(display, drawable, textPtr->cursorOffGC,
+ drawableX, drawableY,
+ (unsigned) textInfoPtr->insertWidth,
+ (unsigned) height);
+ }
+ }
+ }
+
+
+ /*
+ * Display the text in two pieces: draw the entire text item, then
+ * draw the selected text on top of it. The selected text then
+ * will only need to be drawn if it has different attributes (such
+ * as foreground color) than regular text.
+ */
+
+ 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);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextInsert --
+ *
+ * Insert characters into a text item at a given position.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The text in the given item is modified. The cursor and
+ * 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);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextDeleteChars --
+ *
+ * Delete one or more characters from a text item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Characters between "first" and "last", inclusive, get
+ * deleted from itemPtr, and things like the selection
+ * position get updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * text item, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are pointPtr[0] and pointPtr[1] is inside the text item. If
+ * the point isn't inside the text item then the return value
+ * is the distance from the point to the text item.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static double
+TextToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ TextItem *textPtr;
+
+ textPtr = (TextItem *) itemPtr;
+ return (double) Tk_DistanceToTextLayout(textPtr->textLayout,
+ (int) pointPtr[0] - textPtr->leftEdge,
+ (int) pointPtr[1] - textPtr->header.y1);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+TextToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Item to check against rectangle. */
+ double *rectPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ TextItem *textPtr;
+
+ textPtr = (TextItem *) itemPtr;
+ return Tk_IntersectTextLayout(textPtr->textLayout,
+ (int) (rectPtr[0] + 0.5) - textPtr->leftEdge,
+ (int) (rectPtr[1] + 0.5) - textPtr->header.y1,
+ (int) (rectPtr[2] - rectPtr[0] + 0.5),
+ (int) (rectPtr[3] - rectPtr[1] + 0.5));
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleText --
+ *
+ * This procedure is invoked to rescale a text item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Scales the position of the text, but not the size
+ * of the font for the text.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateText --
+ *
+ * This procedure is called to move a text item by a
+ * given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the text item is offset by (xDelta, yDelta),
+ * and the bounding box is updated in the generic part of the
+ * 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;
+
+ p = string+1;
+ tmp = strtod(p, &end);
+ if ((end == p) || (*end != ',')) {
+ goto badIndex;
+ }
+ x = (int) ((tmp < 0) ? tmp - 0.5 : tmp + 0.5);
+ p = end+1;
+ tmp = strtod(p, &end);
+ if ((end == p) || (*end != 0)) {
+ goto badIndex;
+ }
+ y = (int) ((tmp < 0) ? tmp - 0.5 : tmp + 0.5);
+ *indexPtr = Tk_PointToChar(textPtr->textLayout,
+ x + canvasPtr->scrollX1 - textPtr->leftEdge,
+ y + canvasPtr->scrollY1 - textPtr->header.y1);
+ } else if (Tcl_GetInt(interp, string, indexPtr) == TCL_OK) {
+ 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);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SetTextCursor --
+ *
+ * Set the position of the insertion cursor in this item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor position will change.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* 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;
+ } else {
+ textPtr->insertPos = index;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetSelText --
+ *
+ * This procedure is invoked to return the selected portion
+ * of a text item. It is only called when this item has
+ * the selection.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored
+ * at buffer. Buffer is filled (or partially filled) with a
+ * NULL-terminated string containing part or all of the selection,
+ * as given by offset and maxBytes.
+ *
+ * Side effects:
+ * 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];
+
+ if (textPtr->color == NULL) {
+ return TCL_OK;
+ }
+
+ if (Tk_CanvasPsFont(interp, canvas, textPtr->tkfont) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (prepass != 0) {
+ return TCL_OK;
+ }
+ if (Tk_CanvasPsColor(interp, canvas, textPtr->color) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (textPtr->stipple != None) {
+ Tcl_AppendResult(interp, "/StippleText {\n ",
+ (char *) NULL);
+ Tk_CanvasPsStipple(interp, canvas, textPtr->stipple);
+ Tcl_AppendResult(interp, "} bind def\n", (char *) NULL);
+ }
+
+ sprintf(buffer, "%.15g %.15g [\n", textPtr->x,
+ Tk_CanvasPsY(canvas, textPtr->y));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+
+ Tk_TextLayoutToPostscript(interp, textPtr->textLayout);
+
+ x = 0; y = 0; justify = NULL; /* lint. */
+ switch (textPtr->anchor) {
+ case TK_ANCHOR_NW: x = 0; y = 0; break;
+ case TK_ANCHOR_N: x = 1; y = 0; break;
+ case TK_ANCHOR_NE: x = 2; y = 0; break;
+ case TK_ANCHOR_E: x = 2; y = 1; break;
+ case TK_ANCHOR_SE: x = 2; y = 2; break;
+ case TK_ANCHOR_S: x = 1; y = 2; break;
+ case TK_ANCHOR_SW: x = 0; y = 2; break;
+ case TK_ANCHOR_W: x = 0; y = 1; break;
+ case TK_ANCHOR_CENTER: x = 1; y = 1; break;
+ }
+ switch (textPtr->justify) {
+ case TK_JUSTIFY_LEFT: justify = "0"; break;
+ case TK_JUSTIFY_CENTER: justify = "0.5";break;
+ case TK_JUSTIFY_RIGHT: justify = "1"; break;
+ }
+
+ Tk_GetFontMetrics(textPtr->tkfont, &fm);
+ sprintf(buffer, "] %d %g %g %s %s DrawText\n",
+ fm.linespace, x / -2.0, y / 2.0, justify,
+ ((textPtr->stipple == None) ? "false" : "true"));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+
+ return TCL_OK;
+}
diff --git a/tk/generic/tkCanvUtil.c b/tk/generic/tkCanvUtil.c
new file mode 100644
index 00000000000..a78ae194ec0
--- /dev/null
+++ b/tk/generic/tkCanvUtil.c
@@ -0,0 +1,376 @@
+/*
+ * 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$
+ */
+
+#include "tk.h"
+#include "tkCanvas.h"
+#include "tkPort.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasTkwin --
+ *
+ * Given a token for a canvas, this procedure returns the
+ * widget that represents the canvas.
+ *
+ * Results:
+ * The return value is a handle for the widget.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_CanvasTkwin(canvas)
+ Tk_Canvas canvas; /* Token for the canvas. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ return canvasPtr->tkwin;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasDrawableCoords --
+ *
+ * Given an (x,y) coordinate pair within a canvas, this procedure
+ * returns the corresponding coordinates at which the point should
+ * be drawn in the drawable used for display.
+ *
+ * Results:
+ * There is no return value. The values at *drawableXPtr and
+ * *drawableYPtr are filled in with the coordinates at which
+ * x and y should be drawn. These coordinates are clipped
+ * to fit within a "short", since this is what X uses in
+ * most cases for drawing.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CanvasDrawableCoords(canvas, x, y, drawableXPtr, drawableYPtr)
+ Tk_Canvas canvas; /* Token for the canvas. */
+ double x, y; /* Coordinates in canvas space. */
+ short *drawableXPtr, *drawableYPtr; /* Screen coordinates are stored
+ * here. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ double tmp;
+
+ tmp = x - canvasPtr->drawableXOrigin;
+ if (tmp > 0) {
+ tmp += 0.5;
+ } else {
+ tmp -= 0.5;
+ }
+ if (tmp > 32767) {
+ *drawableXPtr = 32767;
+ } else if (tmp < -32768) {
+ *drawableXPtr = -32768;
+ } else {
+ *drawableXPtr = (short) tmp;
+ }
+
+ tmp = y - canvasPtr->drawableYOrigin;
+ if (tmp > 0) {
+ tmp += 0.5;
+ } else {
+ tmp -= 0.5;
+ }
+ if (tmp > 32767) {
+ *drawableYPtr = 32767;
+ } else if (tmp < -32768) {
+ *drawableYPtr = -32768;
+ } else {
+ *drawableYPtr = (short) tmp;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasWindowCoords --
+ *
+ * Given an (x,y) coordinate pair within a canvas, this procedure
+ * returns the corresponding coordinates in the canvas's window.
+ *
+ * Results:
+ * There is no return value. The values at *screenXPtr and
+ * *screenYPtr are filled in with the coordinates at which
+ * (x,y) appears in the canvas's window. These coordinates
+ * are clipped to fit within a "short", since this is what X
+ * uses in most cases for drawing.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CanvasWindowCoords(canvas, x, y, screenXPtr, screenYPtr)
+ Tk_Canvas canvas; /* Token for the canvas. */
+ double x, y; /* Coordinates in canvas space. */
+ short *screenXPtr, *screenYPtr; /* Screen coordinates are stored
+ * here. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ double tmp;
+
+ tmp = x - canvasPtr->xOrigin;
+ if (tmp > 0) {
+ tmp += 0.5;
+ } else {
+ tmp -= 0.5;
+ }
+ if (tmp > 32767) {
+ *screenXPtr = 32767;
+ } else if (tmp < -32768) {
+ *screenXPtr = -32768;
+ } else {
+ *screenXPtr = (short) tmp;
+ }
+
+ tmp = y - canvasPtr->yOrigin;
+ if (tmp > 0) {
+ tmp += 0.5;
+ } else {
+ tmp -= 0.5;
+ }
+ if (tmp > 32767) {
+ *screenYPtr = 32767;
+ } else if (tmp < -32768) {
+ *screenYPtr = -32768;
+ } else {
+ *screenYPtr = (short) tmp;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasGetCoord --
+ *
+ * Given a string, returns a floating-point canvas coordinate
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasGetCoord(interp, canvas, string, doublePtr)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Canvas canvas; /* Canvas to which coordinate applies. */
+ char *string; /* Describes coordinate (any screen
+ * coordinate form may be used here). */
+ double *doublePtr; /* Place to store converted coordinate. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ if (Tk_GetScreenMM(canvasPtr->interp, canvasPtr->tkwin, string,
+ doublePtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ *doublePtr *= canvasPtr->pixelsPerMM;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasSetStippleOrigin --
+ *
+ * This procedure sets the stipple origin in a graphics context
+ * so that stipples drawn with the GC will line up with other
+ * stipples previously drawn in the canvas.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The graphics context is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CanvasSetStippleOrigin(canvas, gc)
+ Tk_Canvas canvas; /* Token for a canvas. */
+ GC gc; /* Graphics context that is about to be
+ * used to draw a stippled pattern as
+ * part of redisplaying the canvas. */
+
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+
+ XSetTSOrigin(canvasPtr->display, gc, -canvasPtr->drawableXOrigin,
+ -canvasPtr->drawableYOrigin);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CanvasGetTextInfo --
+ *
+ * This procedure returns a pointer to a structure containing
+ * information about the selection and insertion cursor for
+ * a canvas widget. Items such as text items save the pointer
+ * and use it to share access to the information with the generic
+ * canvas code.
+ *
+ * Results:
+ * The return value is a pointer to the structure holding text
+ * information for the canvas. Most of the fields should not
+ * be modified outside the generic canvas code; see the user
+ * documentation for details.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_CanvasTextInfo *
+Tk_CanvasGetTextInfo(canvas)
+ Tk_Canvas canvas; /* Token for the canvas widget. */
+{
+ return &((TkCanvas *) canvas)->textInfo;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasTagsParseProc --
+ *
+ * This procedure is invoked during option processing to handle
+ * "-tags" options for canvas items.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The tags for a given item get replaced by those indicated
+ * in the value argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_CanvasTagsParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* Not used.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ char *value; /* Value of option (list of tag
+ * names). */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Offset into item (ignored). */
+{
+ register Tk_Item *itemPtr = (Tk_Item *) widgRec;
+ int argc, i;
+ char **argv;
+ Tk_Uid *newPtr;
+
+ /*
+ * Break the value up into the individual tag names.
+ */
+
+ if (Tcl_SplitList(interp, value, &argc, &argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Make sure that there's enough space in the item to hold the
+ * tag names.
+ */
+
+ if (itemPtr->tagSpace < argc) {
+ newPtr = (Tk_Uid *) ckalloc((unsigned) (argc * sizeof(Tk_Uid)));
+ for (i = itemPtr->numTags-1; i >= 0; i--) {
+ newPtr[i] = itemPtr->tagPtr[i];
+ }
+ if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
+ ckfree((char *) itemPtr->tagPtr);
+ }
+ itemPtr->tagPtr = newPtr;
+ itemPtr->tagSpace = argc;
+ }
+ itemPtr->numTags = argc;
+ for (i = 0; i < argc; i++) {
+ itemPtr->tagPtr[i] = Tk_GetUid(argv[i]);
+ }
+ ckfree((char *) argv);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasTagsPrintProc --
+ *
+ * This procedure is invoked by the Tk configuration code
+ * to produce a printable string for the "-tags" configuration
+ * option for canvas items.
+ *
+ * Results:
+ * The return value is a string describing all the tags for
+ * the item referred to by "widgRec". In addition, *freeProcPtr
+ * is filled in with the address of a procedure to call to free
+ * the result string when it's no longer needed (or NULL to
+ * indicate that the string doesn't need to be freed).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_CanvasTagsPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Window containing canvas widget. */
+ char *widgRec; /* Pointer to record for item. */
+ int offset; /* Ignored. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ register Tk_Item *itemPtr = (Tk_Item *) widgRec;
+
+ if (itemPtr->numTags == 0) {
+ *freeProcPtr = (Tcl_FreeProc *) NULL;
+ return "";
+ }
+ if (itemPtr->numTags == 1) {
+ *freeProcPtr = (Tcl_FreeProc *) NULL;
+ return (char *) itemPtr->tagPtr[0];
+ }
+ *freeProcPtr = TCL_DYNAMIC;
+ return Tcl_Merge(itemPtr->numTags, (char **) itemPtr->tagPtr);
+}
diff --git a/tk/generic/tkCanvWind.c b/tk/generic/tkCanvWind.c
new file mode 100644
index 00000000000..1aa81620210
--- /dev/null
+++ b/tk/generic/tkCanvWind.c
@@ -0,0 +1,862 @@
+/*
+ * 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$
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.h"
+
+/*
+ * The structure below defines the record for each window item.
+ */
+
+typedef struct WindowItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ double x, y; /* Coordinates of positioning point for
+ * window. */
+ Tk_Window tkwin; /* Window associated with item. NULL means
+ * window has been destroyed. */
+ int width; /* Width to use for window (<= 0 means use
+ * window's requested width). */
+ int height; /* Width to use for window (<= 0 means use
+ * window's requested width). */
+ Tk_Anchor anchor; /* Where to anchor window relative to
+ * (x,y). */
+ Tk_Canvas canvas; /* Canvas containing this item. */
+} WindowItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", (char *) NULL, (char *) NULL,
+ "center", Tk_Offset(WindowItem, anchor), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_PIXELS, "-height", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(WindowItem, height), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(WindowItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_WINDOW, "-window", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(WindowItem, tkwin), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static void ComputeWindowBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ WindowItem *winItemPtr));
+static int ConfigureWinItem _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+static int CreateWinItem _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, char **argv));
+static void DeleteWinItem _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayWinItem _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static void ScaleWinItem _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslateWinItem _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+static int WinItemCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv));
+static void WinItemLostSlaveProc _ANSI_ARGS_((
+ ClientData clientData, Tk_Window tkwin));
+static void WinItemRequestProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void WinItemStructureProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static int WinItemToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *rectPtr));
+static double WinItemToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr));
+
+/*
+ * The structure below defines the window item type by means of procedures
+ * that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkWindowType = {
+ "window", /* name */
+ sizeof(WindowItem), /* itemSize */
+ CreateWinItem, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureWinItem, /* configureProc */
+ WinItemCoords, /* coordProc */
+ DeleteWinItem, /* deleteProc */
+ DisplayWinItem, /* displayProc */
+ 1, /* alwaysRedraw */
+ WinItemToPoint, /* pointProc */
+ WinItemToArea, /* areaProc */
+ (Tk_ItemPostscriptProc *) NULL, /* postscriptProc */
+ ScaleWinItem, /* scaleProc */
+ TranslateWinItem, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* cursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) NULL, /* insertProc */
+ (Tk_ItemDCharsProc *) NULL, /* dTextProc */
+ (Tk_ItemType *) NULL /* nextPtr */
+};
+
+
+/*
+ * The structure below defines the official type record for the
+ * placer:
+ */
+
+static Tk_GeomMgr canvasGeomType = {
+ "canvas", /* name */
+ WinItemRequestProc, /* requestProc */
+ WinItemLostSlaveProc, /* lostSlaveProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateWinItem --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateWinItem(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. */
+{
+ WindowItem *winItemPtr = (WindowItem *) 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;
+ }
+
+ /*
+ * Initialize item's record.
+ */
+
+ winItemPtr->tkwin = NULL;
+ winItemPtr->width = 0;
+ winItemPtr->height = 0;
+ winItemPtr->anchor = TK_ANCHOR_CENTER;
+ winItemPtr->canvas = canvas;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0], &winItemPtr->x) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1],
+ &winItemPtr->y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+
+ if (ConfigureWinItem(interp, canvas, itemPtr, argc-2, argv+2, 0)
+ != TCL_OK) {
+ DeleteWinItem(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+WinItemCoords(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, ... */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ char x[TCL_DOUBLE_SPACE], y[TCL_DOUBLE_SPACE];
+
+ if (argc == 0) {
+ Tcl_PrintDouble(interp, winItemPtr->x, x);
+ Tcl_PrintDouble(interp, winItemPtr->y, y);
+ Tcl_AppendResult(interp, x, " ", y, (char *) NULL);
+ } else if (argc == 2) {
+ 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureWinItem(interp, canvas, itemPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Window item to reconfigure. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ Tk_Window oldWindow;
+ Tk_Window canvasTkwin;
+
+ oldWindow = winItemPtr->tkwin;
+ canvasTkwin = Tk_CanvasTkwin(canvas);
+ if (Tk_ConfigureWidget(interp, canvasTkwin, configSpecs, argc, argv,
+ (char *) winItemPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing.
+ */
+
+ if (oldWindow != winItemPtr->tkwin) {
+ if (oldWindow != NULL) {
+ Tk_DeleteEventHandler(oldWindow, StructureNotifyMask,
+ WinItemStructureProc, (ClientData) winItemPtr);
+ Tk_ManageGeometry(oldWindow, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ Tk_UnmaintainGeometry(oldWindow, canvasTkwin);
+ Tk_UnmapWindow(oldWindow);
+ }
+ if (winItemPtr->tkwin != NULL) {
+ Tk_Window ancestor, parent;
+
+ /*
+ * Make sure that the canvas is either the parent of the
+ * window associated with the item or a descendant of that
+ * parent. Also, don't allow a top-level window to be
+ * managed inside a canvas.
+ */
+
+ parent = Tk_Parent(winItemPtr->tkwin);
+ for (ancestor = canvasTkwin; ;
+ ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (((Tk_FakeWin *) (ancestor))->flags & TK_TOP_LEVEL) {
+ badWindow:
+ Tcl_AppendResult(interp, "can't use ",
+ Tk_PathName(winItemPtr->tkwin),
+ " in a window item of this canvas", (char *) NULL);
+ winItemPtr->tkwin = NULL;
+ return TCL_ERROR;
+ }
+ }
+ if (((Tk_FakeWin *) (winItemPtr->tkwin))->flags & TK_TOP_LEVEL) {
+ goto badWindow;
+ }
+ if (winItemPtr->tkwin == canvasTkwin) {
+ goto badWindow;
+ }
+ Tk_CreateEventHandler(winItemPtr->tkwin, StructureNotifyMask,
+ WinItemStructureProc, (ClientData) winItemPtr);
+ Tk_ManageGeometry(winItemPtr->tkwin, &canvasGeomType,
+ (ClientData) winItemPtr);
+ }
+ }
+
+ ComputeWindowBbox(canvas, winItemPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteWinItem --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a window item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteWinItem(canvas, itemPtr, display)
+ Tk_Canvas canvas; /* Overall info about widget. */
+ Tk_Item *itemPtr; /* Item that is being deleted. */
+ Display *display; /* Display containing window for
+ * canvas. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ Tk_Window canvasTkwin = Tk_CanvasTkwin(canvas);
+
+ if (winItemPtr->tkwin != NULL) {
+ Tk_DeleteEventHandler(winItemPtr->tkwin, StructureNotifyMask,
+ WinItemStructureProc, (ClientData) winItemPtr);
+ Tk_ManageGeometry(winItemPtr->tkwin, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ if (canvasTkwin != Tk_Parent(winItemPtr->tkwin)) {
+ Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin);
+ }
+ Tk_UnmapWindow(winItemPtr->tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeWindowBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a window item.
+ * This procedure is where the child window's placement is
+ * computed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeWindowBbox(canvas, winItemPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ WindowItem *winItemPtr; /* Item whose bbox is to be
+ * recomputed. */
+{
+ int width, height, x, y;
+
+ x = (int) (winItemPtr->x + ((winItemPtr->x >= 0) ? 0.5 : - 0.5));
+ y = (int) (winItemPtr->y + ((winItemPtr->y >= 0) ? 0.5 : - 0.5));
+
+ if (winItemPtr->tkwin == NULL) {
+ /*
+ * There is no window for this item yet. Just give it a 1x1
+ * bounding box. Don't give it a 0x0 bounding box; there are
+ * strange cases where this bounding box might be used as the
+ * dimensions of the window, and 0x0 causes problems under X.
+ */
+
+ winItemPtr->header.x1 = x;
+ winItemPtr->header.x2 = winItemPtr->header.x1 + 1;
+ winItemPtr->header.y1 = y;
+ winItemPtr->header.y2 = winItemPtr->header.y1 + 1;
+ return;
+ }
+
+ /*
+ * Compute dimensions of window.
+ */
+
+ width = winItemPtr->width;
+ if (width <= 0) {
+ width = Tk_ReqWidth(winItemPtr->tkwin);
+ if (width <= 0) {
+ width = 1;
+ }
+ }
+ height = winItemPtr->height;
+ if (height <= 0) {
+ height = Tk_ReqHeight(winItemPtr->tkwin);
+ if (height <= 0) {
+ height = 1;
+ }
+ }
+
+ /*
+ * Compute location of window, using anchor information.
+ */
+
+ switch (winItemPtr->anchor) {
+ case TK_ANCHOR_N:
+ x -= width/2;
+ break;
+ case TK_ANCHOR_NE:
+ x -= width;
+ break;
+ case TK_ANCHOR_E:
+ x -= width;
+ y -= height/2;
+ break;
+ case TK_ANCHOR_SE:
+ x -= width;
+ y -= height;
+ break;
+ case TK_ANCHOR_S:
+ x -= width/2;
+ y -= height;
+ break;
+ case TK_ANCHOR_SW:
+ y -= height;
+ break;
+ case TK_ANCHOR_W:
+ y -= height/2;
+ break;
+ case TK_ANCHOR_NW:
+ break;
+ case TK_ANCHOR_CENTER:
+ x -= width/2;
+ y -= height/2;
+ break;
+ }
+
+ /*
+ * Store the information in the item header.
+ */
+
+ winItemPtr->header.x1 = x;
+ winItemPtr->header.y1 = y;
+ winItemPtr->header.x2 = x + width;
+ winItemPtr->header.y2 = y + height;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayWinItem --
+ *
+ * This procedure is invoked to "draw" a window item in a given
+ * drawable. Since the window draws itself, we needn't do any
+ * actual redisplay here. However, this procedure takes care
+ * of actually repositioning the child window so that it occupies
+ * the correct screen position.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The child window's position may get changed. Note: this
+ * procedure gets called both when a window needs to be displayed
+ * and when it ceases to be visible on the screen (e.g. it was
+ * scrolled or moved off-screen or the enclosing canvas is
+ * unmapped).
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayWinItem(canvas, itemPtr, display, drawable, regionX, regionY,
+ regionWidth, regionHeight)
+ 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 regionX, regionY, regionWidth, regionHeight;
+ /* Describes region of canvas that
+ * must be redisplayed (not used). */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ int width, height;
+ short x, y;
+ Tk_Window canvasTkwin = Tk_CanvasTkwin(canvas);
+
+ if (winItemPtr->tkwin == NULL) {
+ return;
+ }
+
+ Tk_CanvasWindowCoords(canvas, (double) winItemPtr->header.x1,
+ (double) winItemPtr->header.y1, &x, &y);
+ width = winItemPtr->header.x2 - winItemPtr->header.x1;
+ height = winItemPtr->header.y2 - winItemPtr->header.y1;
+
+ /*
+ * If the window is completely out of the visible area of the canvas
+ * then unmap it. This code used not to be present (why unmap the
+ * window if it isn't visible anyway?) but this could cause the
+ * window to suddenly reappear if the canvas window got resized.
+ */
+
+ if (((x + width) <= 0) || ((y + height) <= 0)
+ || (x >= Tk_Width(canvasTkwin)) || (y >= Tk_Height(canvasTkwin))) {
+ if (canvasTkwin == Tk_Parent(winItemPtr->tkwin)) {
+ Tk_UnmapWindow(winItemPtr->tkwin);
+ } else {
+ Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin);
+ }
+ return;
+ }
+
+ /*
+ * Reposition and map the window (but in different ways depending
+ * on whether the canvas is the window's parent).
+ */
+
+ if (canvasTkwin == Tk_Parent(winItemPtr->tkwin)) {
+ if ((x != Tk_X(winItemPtr->tkwin)) || (y != Tk_Y(winItemPtr->tkwin))
+ || (width != Tk_Width(winItemPtr->tkwin))
+ || (height != Tk_Height(winItemPtr->tkwin))) {
+ Tk_MoveResizeWindow(winItemPtr->tkwin, x, y, width, height);
+ }
+ Tk_MapWindow(winItemPtr->tkwin);
+ } else {
+ Tk_MaintainGeometry(winItemPtr->tkwin, canvasTkwin, x, y,
+ width, height);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * rectangle, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are coordPtr[0] and coordPtr[1] is inside the window. If the
+ * point isn't inside the window then the return value is the
+ * distance from the point to the window.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static double
+WinItemToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+ double x1, x2, y1, y2, xDiff, yDiff;
+
+ x1 = winItemPtr->header.x1;
+ y1 = winItemPtr->header.y1;
+ x2 = winItemPtr->header.x2;
+ y2 = winItemPtr->header.y2;
+
+ /*
+ * Point is outside rectangle.
+ */
+
+ if (pointPtr[0] < x1) {
+ xDiff = x1 - pointPtr[0];
+ } else if (pointPtr[0] >= x2) {
+ xDiff = pointPtr[0] + 1 - x2;
+ } else {
+ xDiff = 0;
+ }
+
+ if (pointPtr[1] < y1) {
+ yDiff = y1 - pointPtr[1];
+ } else if (pointPtr[1] >= y2) {
+ yDiff = pointPtr[1] + 1 - y2;
+ } else {
+ yDiff = 0;
+ }
+
+ return hypot(xDiff, yDiff);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+WinItemToArea(canvas, itemPtr, rectPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against rectangle. */
+ double *rectPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+
+ if ((rectPtr[2] <= winItemPtr->header.x1)
+ || (rectPtr[0] >= winItemPtr->header.x2)
+ || (rectPtr[3] <= winItemPtr->header.y1)
+ || (rectPtr[1] >= winItemPtr->header.y2)) {
+ return -1;
+ }
+ if ((rectPtr[0] <= winItemPtr->header.x1)
+ && (rectPtr[1] <= winItemPtr->header.y1)
+ && (rectPtr[2] >= winItemPtr->header.x2)
+ && (rectPtr[3] >= winItemPtr->header.y2)) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleWinItem --
+ *
+ * This procedure is invoked to rescale a rectangle or oval
+ * item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The rectangle or oval referred to by itemPtr is rescaled
+ * so that the following transformation is applied to all
+ * point coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleWinItem(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. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+
+ winItemPtr->x = originX + scaleX*(winItemPtr->x - originX);
+ winItemPtr->y = originY + scaleY*(winItemPtr->y - originY);
+ if (winItemPtr->width > 0) {
+ winItemPtr->width = (int) (scaleX*winItemPtr->width);
+ }
+ if (winItemPtr->height > 0) {
+ winItemPtr->height = (int) (scaleY*winItemPtr->height);
+ }
+ ComputeWindowBbox(canvas, winItemPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateWinItem --
+ *
+ * This procedure is called to move a rectangle or oval by a
+ * given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the rectangle or oval is offset by
+ * (xDelta, yDelta), and the bounding box is updated in the
+ * generic part of the item structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateWinItem(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. */
+{
+ WindowItem *winItemPtr = (WindowItem *) itemPtr;
+
+ winItemPtr->x += deltaX;
+ winItemPtr->y += deltaY;
+ ComputeWindowBbox(canvas, winItemPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemStructureProc --
+ *
+ * This procedure is invoked whenever StructureNotify events
+ * occur for a window that's managed as part of a canvas window
+ * item. This procudure's only purpose is to clean up when
+ * windows are deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is disassociated from the window item when it is
+ * deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+WinItemStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to record describing window item. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ WindowItem *winItemPtr = (WindowItem *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ winItemPtr->tkwin = NULL;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemRequestProc --
+ *
+ * This procedure is invoked whenever a window that's associated
+ * with a window canvas item changes its requested dimensions.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size and location on the screen of the window may change,
+ * depending on the options specified for the window item.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+WinItemRequestProc(clientData, tkwin)
+ ClientData clientData; /* Pointer to record for window item. */
+ Tk_Window tkwin; /* Window that changed its desired
+ * size. */
+{
+ WindowItem *winItemPtr = (WindowItem *) clientData;
+
+ ComputeWindowBbox(winItemPtr->canvas, winItemPtr);
+ DisplayWinItem(winItemPtr->canvas, (Tk_Item *) winItemPtr,
+ (Display *) NULL, (Drawable) None, 0, 0, 0, 0);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * WinItemLostSlaveProc --
+ *
+ * This procedure is invoked by Tk whenever some other geometry
+ * claims control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all canvas-related information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+WinItemLostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* WindowItem structure for slave window that
+ * was stolen away. */
+ Tk_Window tkwin; /* Tk's handle for the slave window. */
+{
+ WindowItem *winItemPtr = (WindowItem *) clientData;
+ Tk_Window canvasTkwin = Tk_CanvasTkwin(winItemPtr->canvas);
+
+ Tk_DeleteEventHandler(winItemPtr->tkwin, StructureNotifyMask,
+ WinItemStructureProc, (ClientData) winItemPtr);
+ if (canvasTkwin != Tk_Parent(winItemPtr->tkwin)) {
+ Tk_UnmaintainGeometry(winItemPtr->tkwin, canvasTkwin);
+ }
+ Tk_UnmapWindow(winItemPtr->tkwin);
+ winItemPtr->tkwin = NULL;
+}
diff --git a/tk/generic/tkCanvas.c b/tk/generic/tkCanvas.c
new file mode 100644
index 00000000000..9455014c030
--- /dev/null
+++ b/tk/generic/tkCanvas.c
@@ -0,0 +1,3829 @@
+/*
+ * 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.
+ * 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$
+ */
+
+#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.
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_CANVAS_BG_COLOR, Tk_Offset(TkCanvas, bgBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_CANVAS_BG_MONO, Tk_Offset(TkCanvas, 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",
+ DEF_CANVAS_BORDER_WIDTH, Tk_Offset(TkCanvas, borderWidth), 0},
+ {TK_CONFIG_DOUBLE, "-closeenough", "closeEnough", "CloseEnough",
+ DEF_CANVAS_CLOSE_ENOUGH, Tk_Offset(TkCanvas, closeEnough), 0},
+ {TK_CONFIG_BOOLEAN, "-confine", "confine", "Confine",
+ DEF_CANVAS_CONFINE, Tk_Offset(TkCanvas, confine), 0},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_CANVAS_CURSOR, Tk_Offset(TkCanvas, cursor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-height", "height", "Height",
+ DEF_CANVAS_HEIGHT, Tk_Offset(TkCanvas, height), 0},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_CANVAS_HIGHLIGHT_BG,
+ Tk_Offset(TkCanvas, highlightBgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_CANVAS_HIGHLIGHT, Tk_Offset(TkCanvas, highlightColorPtr), 0},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_CANVAS_HIGHLIGHT_WIDTH, Tk_Offset(TkCanvas, highlightWidth), 0},
+ {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground",
+ DEF_CANVAS_INSERT_BG, Tk_Offset(TkCanvas, textInfo.insertBorder), 0},
+ {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
+ DEF_CANVAS_INSERT_BD_COLOR,
+ Tk_Offset(TkCanvas, textInfo.insertBorderWidth), TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
+ DEF_CANVAS_INSERT_BD_MONO,
+ Tk_Offset(TkCanvas, textInfo.insertBorderWidth), TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime",
+ DEF_CANVAS_INSERT_OFF_TIME, Tk_Offset(TkCanvas, insertOffTime), 0},
+ {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime",
+ DEF_CANVAS_INSERT_ON_TIME, Tk_Offset(TkCanvas, insertOnTime), 0},
+ {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
+ DEF_CANVAS_INSERT_WIDTH, Tk_Offset(TkCanvas, textInfo.insertWidth), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_CANVAS_RELIEF, Tk_Offset(TkCanvas, relief), 0},
+ {TK_CONFIG_STRING, "-scrollregion", "scrollRegion", "ScrollRegion",
+ DEF_CANVAS_SCROLL_REGION, Tk_Offset(TkCanvas, regionString),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_CANVAS_SELECT_COLOR, Tk_Offset(TkCanvas, textInfo.selBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_CANVAS_SELECT_MONO, Tk_Offset(TkCanvas, textInfo.selBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
+ DEF_CANVAS_SELECT_BD_COLOR,
+ Tk_Offset(TkCanvas, textInfo.selBorderWidth), TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
+ DEF_CANVAS_SELECT_BD_MONO, Tk_Offset(TkCanvas, textInfo.selBorderWidth),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_CANVAS_SELECT_FG_COLOR, Tk_Offset(TkCanvas, textInfo.selFgColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_CANVAS_SELECT_FG_MONO, Tk_Offset(TkCanvas, textInfo.selFgColorPtr),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_CANVAS_TAKE_FOCUS, Tk_Offset(TkCanvas, takeFocus),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-width", "width", "Width",
+ DEF_CANVAS_WIDTH, Tk_Offset(TkCanvas, width), 0},
+ {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_CANVAS_X_SCROLL_CMD, Tk_Offset(TkCanvas, xScrollCmd),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-xscrollincrement", "xScrollIncrement",
+ "ScrollIncrement",
+ DEF_CANVAS_X_SCROLL_INCREMENT, Tk_Offset(TkCanvas, xScrollIncrement),
+ 0},
+ {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ DEF_CANVAS_Y_SCROLL_CMD, Tk_Offset(TkCanvas, yScrollCmd),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-yscrollincrement", "yScrollIncrement",
+ "ScrollIncrement",
+ DEF_CANVAS_Y_SCROLL_INCREMENT, Tk_Offset(TkCanvas, yScrollIncrement),
+ 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * List of all the item types known at present:
+ */
+
+static Tk_ItemType *typeList = NULL; /* NULL means initialization hasn't
+ * been done yet. */
+
+/*
+ * 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));
+static void CanvasCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void CanvasDoEvent _ANSI_ARGS_((TkCanvas *canvasPtr,
+ XEvent *eventPtr));
+static void CanvasEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int CanvasFetchSelection _ANSI_ARGS_((
+ ClientData clientData, int offset,
+ char *buffer, int maxBytes));
+static Tk_Item * CanvasFindClosest _ANSI_ARGS_((TkCanvas *canvasPtr,
+ double coords[2]));
+static void CanvasFocusProc _ANSI_ARGS_((TkCanvas *canvasPtr,
+ int gotFocus));
+static void CanvasLostSelection _ANSI_ARGS_((
+ ClientData clientData));
+static void CanvasSelectTo _ANSI_ARGS_((TkCanvas *canvasPtr,
+ Tk_Item *itemPtr, int index));
+static void CanvasSetOrigin _ANSI_ARGS_((TkCanvas *canvasPtr,
+ int xOrigin, int yOrigin));
+static void CanvasUpdateScrollbars _ANSI_ARGS_((
+ TkCanvas *canvasPtr));
+static int CanvasWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void CanvasWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static int ConfigureCanvas _ANSI_ARGS_((Tcl_Interp *interp,
+ TkCanvas *canvasPtr, int argc, char **argv,
+ int flags));
+static void DestroyCanvas _ANSI_ARGS_((char *memPtr));
+static void DisplayCanvas _ANSI_ARGS_((ClientData clientData));
+static void DoItem _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Item *itemPtr, Tk_Uid tag));
+static int FindItems _ANSI_ARGS_((Tcl_Interp *interp,
+ TkCanvas *canvasPtr, int argc, char **argv,
+ char *newTag, char *cmdName, char *option));
+static int FindArea _ANSI_ARGS_((Tcl_Interp *interp,
+ TkCanvas *canvasPtr, char **argv, Tk_Uid uid,
+ int enclosed));
+static double GridAlign _ANSI_ARGS_((double coord, double spacing));
+static void InitCanvas _ANSI_ARGS_((void));
+static Tk_Item * NextItem _ANSI_ARGS_((TagSearch *searchPtr));
+static void PickCurrentItem _ANSI_ARGS_((TkCanvas *canvasPtr,
+ XEvent *eventPtr));
+static void PrintScrollFractions _ANSI_ARGS_((int screen1,
+ int screen2, int object1, int object2,
+ char *string));
+static void RelinkItems _ANSI_ARGS_((TkCanvas *canvasPtr,
+ char *tag, Tk_Item *prevPtr));
+static Tk_Item * StartTagSearch _ANSI_ARGS_((TkCanvas *canvasPtr,
+ char *tag, TagSearch *searchPtr));
+
+/*
+ * The structure below defines canvas class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static TkClassProcs canvasClass = {
+ NULL, /* createProc. */
+ CanvasWorldChanged, /* geometryProc. */
+ NULL /* modalProc. */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasCmd --
+ *
+ * This procedure is invoked to process the "canvas" 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_CanvasCmd(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;
+ TkCanvas *canvasPtr;
+ Tk_Window new;
+
+ if (typeList == NULL) {
+ InitCanvas();
+ }
+
+ 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 fields that won't be initialized by ConfigureCanvas,
+ * or which ConfigureCanvas expects to have reasonable values
+ * (e.g. resource pointers).
+ */
+
+ canvasPtr = (TkCanvas *) ckalloc(sizeof(TkCanvas));
+ canvasPtr->tkwin = new;
+ canvasPtr->display = Tk_Display(new);
+ canvasPtr->interp = interp;
+ canvasPtr->widgetCmd = Tcl_CreateCommand(interp,
+ Tk_PathName(canvasPtr->tkwin), CanvasWidgetCmd,
+ (ClientData) canvasPtr, CanvasCmdDeletedProc);
+ canvasPtr->firstItemPtr = NULL;
+ canvasPtr->lastItemPtr = NULL;
+ canvasPtr->borderWidth = 0;
+ canvasPtr->bgBorder = NULL;
+ canvasPtr->relief = TK_RELIEF_FLAT;
+ canvasPtr->highlightWidth = 0;
+ canvasPtr->highlightBgColorPtr = NULL;
+ canvasPtr->highlightColorPtr = NULL;
+ canvasPtr->inset = 0;
+ canvasPtr->pixmapGC = None;
+ canvasPtr->width = None;
+ canvasPtr->height = None;
+ canvasPtr->confine = 0;
+ canvasPtr->textInfo.selBorder = NULL;
+ canvasPtr->textInfo.selBorderWidth = 0;
+ canvasPtr->textInfo.selFgColorPtr = NULL;
+ canvasPtr->textInfo.selItemPtr = NULL;
+ canvasPtr->textInfo.selectFirst = -1;
+ canvasPtr->textInfo.selectLast = -1;
+ canvasPtr->textInfo.anchorItemPtr = NULL;
+ canvasPtr->textInfo.selectAnchor = 0;
+ canvasPtr->textInfo.insertBorder = NULL;
+ canvasPtr->textInfo.insertWidth = 0;
+ canvasPtr->textInfo.insertBorderWidth = 0;
+ canvasPtr->textInfo.focusItemPtr = NULL;
+ canvasPtr->textInfo.gotFocus = 0;
+ canvasPtr->textInfo.cursorOn = 0;
+ canvasPtr->insertOnTime = 0;
+ canvasPtr->insertOffTime = 0;
+ canvasPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ canvasPtr->xOrigin = canvasPtr->yOrigin = 0;
+ canvasPtr->drawableXOrigin = canvasPtr->drawableYOrigin = 0;
+ canvasPtr->bindingTable = NULL;
+ canvasPtr->currentItemPtr = NULL;
+ canvasPtr->newCurrentPtr = NULL;
+ canvasPtr->closeEnough = 0.0;
+ canvasPtr->pickEvent.type = LeaveNotify;
+ canvasPtr->pickEvent.xcrossing.x = 0;
+ canvasPtr->pickEvent.xcrossing.y = 0;
+ canvasPtr->state = 0;
+ canvasPtr->xScrollCmd = NULL;
+ canvasPtr->yScrollCmd = NULL;
+ canvasPtr->scrollX1 = 0;
+ canvasPtr->scrollY1 = 0;
+ canvasPtr->scrollX2 = 0;
+ canvasPtr->scrollY2 = 0;
+ canvasPtr->regionString = NULL;
+ canvasPtr->xScrollIncrement = 0;
+ canvasPtr->yScrollIncrement = 0;
+ canvasPtr->scanX = 0;
+ canvasPtr->scanXOrigin = 0;
+ canvasPtr->scanY = 0;
+ canvasPtr->scanYOrigin = 0;
+ canvasPtr->hotPtr = NULL;
+ canvasPtr->hotPrevPtr = NULL;
+ 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;
+ }
+
+ interp->result = Tk_PathName(canvasPtr->tkwin);
+ return TCL_OK;
+
+ error:
+ Tk_DestroyWindow(canvasPtr->tkwin);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasWidgetCmd --
+ *
+ * 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
+CanvasWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about canvas
+ * widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+ size_t length;
+ int c, result;
+ Tk_Item *itemPtr = NULL; /* Initialization needed only to
+ * prevent compiler warning. */
+ TagSearch search;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) canvasPtr);
+ result = TCL_OK;
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'a') && (strncmp(argv[1], "addtag", length) == 0)) {
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " addtags tag searchCommand ?arg arg ...?\"",
+ (char *) NULL);
+ goto error;
+ }
+ result = FindItems(interp, canvasPtr, argc-3, argv+3, argv[2], argv[0],
+ " addtag tag");
+ } else if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)
+ && (length >= 2)) {
+ int i, gotAny;
+ int x1 = 0, y1 = 0, x2 = 0, y2 = 0; /* Initializations needed
+ * only to prevent compiler
+ * warnings. */
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " bbox tagOrId ?tagOrId ...?\"",
+ (char *) NULL);
+ goto error;
+ }
+ gotAny = 0;
+ for (i = 2; i < argc; i++) {
+ for (itemPtr = StartTagSearch(canvasPtr, argv[i], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ if ((itemPtr->x1 >= itemPtr->x2)
+ || (itemPtr->y1 >= itemPtr->y2)) {
+ continue;
+ }
+ if (!gotAny) {
+ x1 = itemPtr->x1;
+ y1 = itemPtr->y1;
+ x2 = itemPtr->x2;
+ y2 = itemPtr->y2;
+ gotAny = 1;
+ } else {
+ if (itemPtr->x1 < x1) {
+ x1 = itemPtr->x1;
+ }
+ if (itemPtr->y1 < y1) {
+ y1 = itemPtr->y1;
+ }
+ if (itemPtr->x2 > x2) {
+ x2 = itemPtr->x2;
+ }
+ 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 \"",
+ argv[0], " bind tagOrId ?sequence? ?command?\"",
+ (char *) NULL);
+ goto error;
+ }
+
+ /*
+ * Figure out what object to use for the binding (individual
+ * 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:
+ object = (ClientData) Tk_GetUid(argv[2]);
+ }
+
+ /*
+ * Make a binding table if the canvas doesn't already have
+ * one.
+ */
+
+ if (canvasPtr->bindingTable == NULL) {
+ canvasPtr->bindingTable = Tk_CreateBindingTable(interp);
+ }
+
+ if (argc == 5) {
+ int append = 0;
+ unsigned long mask;
+
+ if (argv[4][0] == 0) {
+ result = Tk_DeleteBinding(interp, canvasPtr->bindingTable,
+ object, argv[3]);
+ goto done;
+ }
+ if (argv[4][0] == '+') {
+ argv[4]++;
+ append = 1;
+ }
+ mask = Tk_CreateBinding(interp, canvasPtr->bindingTable,
+ object, argv[3], argv[4], append);
+ if (mask == 0) {
+ goto error;
+ }
+ if (mask & (unsigned) ~(ButtonMotionMask|Button1MotionMask
+ |Button2MotionMask|Button3MotionMask|Button4MotionMask
+ |Button5MotionMask|ButtonPressMask|ButtonReleaseMask
+ |EnterWindowMask|LeaveWindowMask|KeyPressMask
+ |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) {
+ Tk_DeleteBinding(interp, canvasPtr->bindingTable,
+ object, argv[3]);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "requested illegal events; ",
+ "only key, button, motion, enter, leave, and virtual ",
+ "events may be used", (char *) NULL);
+ goto error;
+ }
+ } 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;
+ }
+ result = Tk_ConfigureValue(interp, canvasPtr->tkwin, configSpecs,
+ (char *) canvasPtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 3)) {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, canvasPtr->tkwin, configSpecs,
+ (char *) canvasPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, canvasPtr->tkwin, configSpecs,
+ (char *) canvasPtr, argv[2], 0);
+ } else {
+ result = ConfigureCanvas(interp, canvasPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ } else if ((c == 'c') && (strncmp(argv[1], "coords", length) == 0)
+ && (length >= 3)) {
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " coords tagOrId ?x y x y ...?\"",
+ (char *) NULL);
+ goto error;
+ }
+ itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ if (itemPtr != NULL) {
+ if (argc != 3) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ }
+ if (itemPtr->typePtr->coordProc != NULL) {
+ result = (*itemPtr->typePtr->coordProc)(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, argc-3, argv+3);
+ }
+ if (argc != 3) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ }
+ }
+ } else if ((c == 'c') && (strncmp(argv[1], "create", length) == 0)
+ && (length >= 2)) {
+ Tk_ItemType *typePtr;
+ Tk_ItemType *matchPtr = NULL;
+ Tk_Item *itemPtr;
+ 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];
+ length = strlen(argv[2]);
+ for (typePtr = typeList; typePtr != NULL; typePtr = typePtr->nextPtr) {
+ if ((c == typePtr->name[0])
+ && (strncmp(argv[2], typePtr->name, length) == 0)) {
+ if (matchPtr != NULL) {
+ badType:
+ Tcl_AppendResult(interp,
+ "unknown or ambiguous item type \"",
+ argv[2], "\"", (char *) NULL);
+ goto error;
+ }
+ matchPtr = typePtr;
+ }
+ }
+ if (matchPtr == NULL) {
+ goto badType;
+ }
+ typePtr = matchPtr;
+ itemPtr = (Tk_Item *) ckalloc((unsigned) typePtr->itemSize);
+ itemPtr->id = canvasPtr->nextId;
+ canvasPtr->nextId++;
+ itemPtr->tagPtr = itemPtr->staticTagSpace;
+ itemPtr->tagSpace = TK_TAG_SPACE;
+ itemPtr->numTags = 0;
+ 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(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?\"",
+ (char *) NULL);
+ goto error;
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ if ((itemPtr->typePtr->indexProc == NULL)
+ || (itemPtr->typePtr->dCharsProc == NULL)) {
+ continue;
+ }
+ if ((*itemPtr->typePtr->indexProc)(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, argv[3], &first) != TCL_OK) {
+ goto error;
+ }
+ if (argc == 5) {
+ if ((*itemPtr->typePtr->indexProc)(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, argv[4], &last)
+ != TCL_OK) {
+ goto error;
+ }
+ } else {
+ last = first;
+ }
+
+ /*
+ * Redraw both item's old and new areas: it's possible
+ * that a delete could result in a new area larger than
+ * the old area.
+ */
+
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ (*itemPtr->typePtr->dCharsProc)((Tk_Canvas) canvasPtr,
+ 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) {
+ canvasPtr->newCurrentPtr = NULL;
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ if (itemPtr == canvasPtr->textInfo.focusItemPtr) {
+ canvasPtr->textInfo.focusItemPtr = NULL;
+ }
+ if (itemPtr == canvasPtr->textInfo.selItemPtr) {
+ canvasPtr->textInfo.selItemPtr = NULL;
+ }
+ if ((itemPtr == canvasPtr->hotPtr)
+ || (itemPtr == canvasPtr->hotPrevPtr)) {
+ canvasPtr->hotPtr = NULL;
+ }
+ }
+ }
+ } else if ((c == 'd') && (strncmp(argv[1], "dtag", length) == 0)
+ && (length >= 2)) {
+ Tk_Uid tag;
+ int i;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " dtag tagOrId ?tagToDelete?\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (argc == 4) {
+ tag = Tk_GetUid(argv[3]);
+ } else {
+ tag = Tk_GetUid(argv[2]);
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ for (i = itemPtr->numTags-1; i >= 0; i--) {
+ if (itemPtr->tagPtr[i] == tag) {
+ itemPtr->tagPtr[i] = itemPtr->tagPtr[itemPtr->numTags-1];
+ itemPtr->numTags--;
+ }
+ }
+ }
+ } else if ((c == 'f') && (strncmp(argv[1], "find", length) == 0)
+ && (length >= 2)) {
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " find searchCommand ?arg arg ...?\"",
+ (char *) NULL);
+ goto error;
+ }
+ result = FindItems(interp, canvasPtr, argc-2, argv+2, (char *) NULL,
+ argv[0]," find");
+ } else if ((c == 'f') && (strncmp(argv[1], "focus", length) == 0)
+ && (length >= 2)) {
+ if (argc > 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ 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);
+ }
+ if (argv[2][0] == 0) {
+ canvasPtr->textInfo.focusItemPtr = NULL;
+ goto done;
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ if (itemPtr->typePtr->icursorProc != NULL) {
+ break;
+ }
+ }
+ if (itemPtr == NULL) {
+ goto done;
+ }
+ canvasPtr->textInfo.focusItemPtr = itemPtr;
+ if (canvasPtr->textInfo.gotFocus) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ }
+ } else if ((c == 'g') && (strncmp(argv[1], "gettags", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " gettags tagOrId\"", (char *) NULL);
+ goto error;
+ }
+ itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ if (itemPtr != NULL) {
+ int i;
+ for (i = 0; i < itemPtr->numTags; i++) {
+ Tcl_AppendElement(interp, (char *) itemPtr->tagPtr[i]);
+ }
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "icursor", length) == 0)
+ && (length >= 2)) {
+ int index;
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " icursor tagOrId index\"",
+ (char *) NULL);
+ goto error;
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ if ((itemPtr->typePtr->indexProc == NULL)
+ || (itemPtr->typePtr->icursorProc == NULL)) {
+ goto done;
+ }
+ if ((*itemPtr->typePtr->indexProc)(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, argv[3], &index) != TCL_OK) {
+ goto error;
+ }
+ (*itemPtr->typePtr->icursorProc)((Tk_Canvas) canvasPtr, itemPtr,
+ index);
+ if ((itemPtr == canvasPtr->textInfo.focusItemPtr)
+ && (canvasPtr->textInfo.cursorOn)) {
+ 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;
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ if (itemPtr->typePtr->indexProc != NULL) {
+ break;
+ }
+ }
+ if (itemPtr == NULL) {
+ Tcl_AppendResult(interp, "can't find an indexable item \"",
+ 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\"",
+ (char *) NULL);
+ goto error;
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ if ((itemPtr->typePtr->indexProc == NULL)
+ || (itemPtr->typePtr->insertProc == NULL)) {
+ continue;
+ }
+ if ((*itemPtr->typePtr->indexProc)(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, argv[3], &beforeThis) != TCL_OK) {
+ goto error;
+ }
+
+ /*
+ * Redraw both item's old and new areas: it's possible
+ * that an insertion could result in a new area either
+ * larger or smaller than the old area.
+ */
+
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ (*itemPtr->typePtr->insertProc)((Tk_Canvas) canvasPtr,
+ itemPtr, beforeThis, argv[4]);
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, itemPtr->x1,
+ itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "itemcget", length) == 0)
+ && (length >= 6)) {
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " itemcget tagOrId option\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ if (itemPtr != NULL) {
+ result = Tk_ConfigureValue(canvasPtr->interp, canvasPtr->tkwin,
+ itemPtr->typePtr->configSpecs, (char *) itemPtr,
+ argv[3], 0);
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "itemconfigure", length) == 0)
+ && (length >= 6)) {
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " itemconfigure tagOrId ?option value ...?\"",
+ (char *) NULL);
+ goto error;
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[2], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ if (argc == 3) {
+ result = Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin,
+ itemPtr->typePtr->configSpecs, (char *) itemPtr,
+ (char *) NULL, 0);
+ } else if (argc == 4) {
+ result = Tk_ConfigureInfo(canvasPtr->interp, canvasPtr->tkwin,
+ itemPtr->typePtr->configSpecs, (char *) itemPtr,
+ argv[3], 0);
+ } else {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ result = (*itemPtr->typePtr->configProc)(interp,
+ (Tk_Canvas) canvasPtr, itemPtr, argc-3, argv+3,
+ TK_CONFIG_ARGV_ONLY);
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ 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);
+ goto error;
+ }
+ if ((Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[3],
+ &xAmount) != TCL_OK) || (Tk_CanvasGetCoord(interp,
+ (Tk_Canvas) canvasPtr, argv[4], &yAmount) != TCL_OK)) {
+ 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->translateProc)((Tk_Canvas) canvasPtr,
+ itemPtr, xAmount, yAmount);
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ } else if ((c == 'p') && (strncmp(argv[1], "postscript", length) == 0)) {
+ result = TkCanvPostscriptCmd(canvasPtr, interp, argc, argv);
+ } else if ((c == 'r') && (strncmp(argv[1], "raise", length) == 0)) {
+ Tk_Item *prevPtr;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " raise tagOrId ?aboveThis?\"",
+ (char *) NULL);
+ goto error;
+ }
+
+ /*
+ * First find the item just after which we'll insert the
+ * named items.
+ */
+
+ if (argc == 3) {
+ prevPtr = canvasPtr->lastItemPtr;
+ } else {
+ prevPtr = NULL;
+ for (itemPtr = StartTagSearch(canvasPtr, argv[3], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ prevPtr = itemPtr;
+ }
+ if (prevPtr == NULL) {
+ Tcl_AppendResult(interp, "tagOrId \"", argv[3],
+ "\" doesn't match any items", (char *) NULL);
+ goto error;
+ }
+ }
+ RelinkItems(canvasPtr, argv[2], prevPtr);
+ } else if ((c == 's') && (strncmp(argv[1], "scale", length) == 0)
+ && (length >= 3)) {
+ double xOrigin, yOrigin, xScale, yScale;
+
+ if (argc != 7) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " scale tagOrId xOrigin yOrigin xScale yScale\"",
+ (char *) NULL);
+ goto error;
+ }
+ if ((Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr,
+ argv[3], &xOrigin) != TCL_OK)
+ || (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,
+ itemPtr, xOrigin, yOrigin, xScale, yScale);
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ canvasPtr->flags |= REPICK_NEEDED;
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "scan", length) == 0)
+ && (length >= 3)) {
+ int x, y;
+
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " scan mark|dragto x y\"", (char *) NULL);
+ goto error;
+ }
+ if ((Tcl_GetInt(interp, argv[3], &x) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[4], &y) != TCL_OK)){
+ goto error;
+ }
+ if ((argv[2][0] == 'm')
+ && (strncmp(argv[2], "mark", strlen(argv[2])) == 0)) {
+ canvasPtr->scanX = x;
+ canvasPtr->scanXOrigin = canvasPtr->xOrigin;
+ canvasPtr->scanY = y;
+ canvasPtr->scanYOrigin = canvasPtr->yOrigin;
+ } else if ((argv[2][0] == 'd')
+ && (strncmp(argv[2], "dragto", strlen(argv[2])) == 0)) {
+ int newXOrigin, newYOrigin, tmp;
+
+ /*
+ * Compute a new view origin for the canvas, amplifying the
+ * mouse motion.
+ */
+
+ tmp = canvasPtr->scanXOrigin - 10*(x - canvasPtr->scanX)
+ - canvasPtr->scrollX1;
+ newXOrigin = canvasPtr->scrollX1 + tmp;
+ tmp = canvasPtr->scanYOrigin - 10*(y - canvasPtr->scanY)
+ - canvasPtr->scrollY1;
+ newYOrigin = canvasPtr->scrollY1 + tmp;
+ CanvasSetOrigin(canvasPtr, newXOrigin, newYOrigin);
+ } else {
+ Tcl_AppendResult(interp, "bad scan option \"", argv[2],
+ "\": must be mark or dragto", (char *) NULL);
+ goto error;
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "select", length) == 0)
+ && (length >= 2)) {
+ int index;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " select option ?tagOrId? ?arg?\"", (char *) NULL);
+ goto error;
+ }
+ if (argc >= 4) {
+ for (itemPtr = StartTagSearch(canvasPtr, argv[3], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ if ((itemPtr->typePtr->indexProc != NULL)
+ && (itemPtr->typePtr->selectionProc != NULL)){
+ break;
+ }
+ }
+ if (itemPtr == NULL) {
+ Tcl_AppendResult(interp,
+ "can't find an indexable and selectable item \"",
+ argv[3], "\"", (char *) NULL);
+ goto error;
+ }
+ }
+ if (argc == 5) {
+ if ((*itemPtr->typePtr->indexProc)(interp, (Tk_Canvas) canvasPtr,
+ itemPtr, argv[4], &index) != TCL_OK) {
+ goto error;
+ }
+ }
+ length = strlen(argv[2]);
+ c = argv[2][0];
+ if ((c == 'a') && (strncmp(argv[2], "adjust", length) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " select adjust tagOrId index\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (canvasPtr->textInfo.selItemPtr == itemPtr) {
+ if (index < (canvasPtr->textInfo.selectFirst
+ + canvasPtr->textInfo.selectLast)/2) {
+ canvasPtr->textInfo.selectAnchor =
+ canvasPtr->textInfo.selectLast + 1;
+ } else {
+ canvasPtr->textInfo.selectAnchor =
+ canvasPtr->textInfo.selectFirst;
+ }
+ }
+ CanvasSelectTo(canvasPtr, itemPtr, index);
+ } else if ((c == 'c') && (argv[2] != NULL)
+ && (strncmp(argv[2], "clear", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " select clear\"", (char *) NULL);
+ goto error;
+ }
+ if (canvasPtr->textInfo.selItemPtr != NULL) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.selItemPtr->x1,
+ canvasPtr->textInfo.selItemPtr->y1,
+ canvasPtr->textInfo.selItemPtr->x2,
+ canvasPtr->textInfo.selItemPtr->y2);
+ canvasPtr->textInfo.selItemPtr = NULL;
+ }
+ goto done;
+ } else if ((c == 'f') && (strncmp(argv[2], "from", length) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " select from tagOrId index\"",
+ (char *) NULL);
+ goto error;
+ }
+ canvasPtr->textInfo.anchorItemPtr = itemPtr;
+ canvasPtr->textInfo.selectAnchor = index;
+ } 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;
+ }
+ CanvasSelectTo(canvasPtr, itemPtr, index);
+ } else {
+ Tcl_AppendResult(interp, "bad select option \"", argv[2],
+ "\": must be adjust, clear, from, item, or to",
+ (char *) NULL);
+ goto error;
+ }
+ } else if ((c == 't') && (strncmp(argv[1], "type", length) == 0)) {
+ 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
+ + (int) (fraction * (canvasPtr->scrollX2
+ - canvasPtr->scrollX1) + 0.5);
+ break;
+ case TK_SCROLL_PAGES:
+ newX = (int) (canvasPtr->xOrigin + count * .9
+ * (Tk_Width(canvasPtr->tkwin) - 2*canvasPtr->inset));
+ break;
+ case TK_SCROLL_UNITS:
+ if (canvasPtr->xScrollIncrement > 0) {
+ newX = canvasPtr->xOrigin
+ + count*canvasPtr->xScrollIncrement;
+ } else {
+ newX = (int) (canvasPtr->xOrigin + count * .1
+ * (Tk_Width(canvasPtr->tkwin)
+ - 2*canvasPtr->inset));
+ }
+ break;
+ }
+ CanvasSetOrigin(canvasPtr, newX, canvasPtr->yOrigin);
+ }
+ } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0)) {
+ int count, type;
+ int newY = 0; /* Initialization needed only to prevent
+ * 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
+ + (int) (fraction*(canvasPtr->scrollY2
+ - canvasPtr->scrollY1) + 0.5);
+ break;
+ case TK_SCROLL_PAGES:
+ newY = (int) (canvasPtr->yOrigin + count * .9
+ * (Tk_Height(canvasPtr->tkwin)
+ - 2*canvasPtr->inset));
+ break;
+ case TK_SCROLL_UNITS:
+ if (canvasPtr->yScrollIncrement > 0) {
+ newY = canvasPtr->yOrigin
+ + count*canvasPtr->yScrollIncrement;
+ } else {
+ newY = (int) (canvasPtr->yOrigin + count * .1
+ * (Tk_Height(canvasPtr->tkwin)
+ - 2*canvasPtr->inset));
+ }
+ break;
+ }
+ CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, newY);
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be addtag, bbox, bind, ",
+ "canvasx, canvasy, cget, configure, coords, create, ",
+ "dchars, delete, dtag, find, focus, ",
+ "gettags, icursor, index, insert, itemcget, itemconfigure, ",
+ "lower, move, postscript, raise, scale, scan, ",
+ "select, type, xview, or yview",
+ (char *) NULL);
+ goto error;
+ }
+ done:
+ Tcl_Release((ClientData) canvasPtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) canvasPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyCanvas --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a canvas at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the canvas is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyCanvas(memPtr)
+ char *memPtr; /* Info about canvas widget. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) memPtr;
+ Tk_Item *itemPtr;
+
+ /*
+ * Free up all of the items in the canvas.
+ */
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = canvasPtr->firstItemPtr) {
+ canvasPtr->firstItemPtr = itemPtr->nextPtr;
+ (*itemPtr->typePtr->deleteProc)((Tk_Canvas) canvasPtr, itemPtr,
+ canvasPtr->display);
+ if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
+ ckfree((char *) itemPtr->tagPtr);
+ }
+ ckfree((char *) itemPtr);
+ }
+
+ /*
+ * 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);
+ }
+ Tk_FreeOptions(configSpecs, (char *) canvasPtr, canvasPtr->display, 0);
+ ckfree((char *) canvasPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureCanvas --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureCanvas(interp, canvasPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ TkCanvas *canvasPtr; /* 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. */
+{
+ XGCValues gcValues;
+ GC new;
+
+ if (Tk_ConfigureWidget(interp, canvasPtr->tkwin, configSpecs,
+ argc, argv, (char *) canvasPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few options need special processing, such as setting the
+ * background from a 3-D border and creating a GC for copying
+ * bits to the screen.
+ */
+
+ Tk_SetBackgroundFromBorder(canvasPtr->tkwin, canvasPtr->bgBorder);
+
+ if (canvasPtr->highlightWidth < 0) {
+ canvasPtr->highlightWidth = 0;
+ }
+ canvasPtr->inset = canvasPtr->borderWidth + canvasPtr->highlightWidth;
+
+ gcValues.function = GXcopy;
+ gcValues.foreground = Tk_3DBorderColor(canvasPtr->bgBorder)->pixel;
+ gcValues.graphics_exposures = False;
+ new = Tk_GetGCColor(canvasPtr->tkwin,
+ GCFunction|GCForeground|GCGraphicsExposures, &gcValues,
+ Tk_3DBorderColor(canvasPtr->bgBorder), NULL);
+ if (canvasPtr->pixmapGC != None) {
+ Tk_FreeGC(canvasPtr->display, canvasPtr->pixmapGC);
+ }
+ canvasPtr->pixmapGC = new;
+
+ /*
+ * Reset the desired dimensions for the window.
+ */
+
+ Tk_GeometryRequest(canvasPtr->tkwin, canvasPtr->width + 2*canvasPtr->inset,
+ canvasPtr->height + 2*canvasPtr->inset);
+
+ /*
+ * Restart the cursor timing sequence in case the on-time or off-time
+ * just changed.
+ */
+
+ if (canvasPtr->textInfo.gotFocus) {
+ CanvasFocusProc(canvasPtr, 1);
+ }
+
+ /*
+ * Recompute the scroll region.
+ */
+
+ canvasPtr->scrollX1 = 0;
+ canvasPtr->scrollY1 = 0;
+ canvasPtr->scrollX2 = 0;
+ canvasPtr->scrollY2 = 0;
+ if (canvasPtr->regionString != NULL) {
+ int argc2;
+ char **argv2;
+
+ if (Tcl_SplitList(canvasPtr->interp, canvasPtr->regionString,
+ &argc2, &argv2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (argc2 != 4) {
+ Tcl_AppendResult(interp, "bad scrollRegion \"",
+ canvasPtr->regionString, "\"", (char *) NULL);
+ badRegion:
+ ckfree(canvasPtr->regionString);
+ ckfree((char *) argv2);
+ canvasPtr->regionString = NULL;
+ return TCL_ERROR;
+ }
+ if ((Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
+ argv2[0], &canvasPtr->scrollX1) != TCL_OK)
+ || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
+ argv2[1], &canvasPtr->scrollY1) != TCL_OK)
+ || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
+ argv2[2], &canvasPtr->scrollX2) != TCL_OK)
+ || (Tk_GetPixels(canvasPtr->interp, canvasPtr->tkwin,
+ argv2[3], &canvasPtr->scrollY2) != TCL_OK)) {
+ goto badRegion;
+ }
+ ckfree((char *) argv2);
+ }
+
+ /*
+ * Reset the canvas's origin (this is a no-op unless confine
+ * mode has just been turned on or the scroll region has changed).
+ */
+
+ CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, canvasPtr->yOrigin);
+ canvasPtr->flags |= UPDATE_SCROLLBARS|REDRAW_BORDERS;
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->xOrigin, canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * CanvasWorldChanged --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Configures all items in the canvas with a empty argc/argv, for
+ * the side effect of causing all the items to recompute their
+ * geometry and to be redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+CanvasWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ TkCanvas *canvasPtr;
+ Tk_Item *itemPtr;
+ int result;
+
+ canvasPtr = (TkCanvas *) instanceData;
+ itemPtr = canvasPtr->firstItemPtr;
+ for ( ; itemPtr != NULL; itemPtr = itemPtr->nextPtr) {
+ result = (*itemPtr->typePtr->configProc)(canvasPtr->interp,
+ (Tk_Canvas) canvasPtr, itemPtr, 0, NULL,
+ TK_CONFIG_ARGV_ONLY);
+ if (result != TCL_OK) {
+ Tcl_ResetResult(canvasPtr->interp);
+ }
+ }
+ canvasPtr->flags |= REPICK_NEEDED;
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->xOrigin, canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayCanvas --
+ *
+ * This procedure redraws the contents of a canvas window.
+ * It is invoked as a do-when-idle handler, so it only runs
+ * when there's nothing else for the application to do.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayCanvas(clientData)
+ ClientData clientData; /* Information about widget. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+ Tk_Window tkwin = canvasPtr->tkwin;
+ Tk_Item *itemPtr;
+ Pixmap pixmap;
+ int screenX1, screenX2, screenY1, screenY2, width, height;
+
+ if (canvasPtr->tkwin == NULL) {
+ return;
+ }
+ if (!Tk_IsMapped(tkwin)) {
+ goto done;
+ }
+
+ /*
+ * Choose a new current item if that is needed (this could cause
+ * event handlers to be invoked).
+ */
+
+ while (canvasPtr->flags & REPICK_NEEDED) {
+ Tcl_Preserve((ClientData) canvasPtr);
+ canvasPtr->flags &= ~REPICK_NEEDED;
+ PickCurrentItem(canvasPtr, &canvasPtr->pickEvent);
+ tkwin = canvasPtr->tkwin;
+ Tcl_Release((ClientData) canvasPtr);
+ if (tkwin == NULL) {
+ return;
+ }
+ }
+
+ /*
+ * Compute the intersection between the area that needs redrawing
+ * and the area that's visible on the screen.
+ */
+
+ if ((canvasPtr->redrawX1 < canvasPtr->redrawX2)
+ && (canvasPtr->redrawY1 < canvasPtr->redrawY2)) {
+ screenX1 = canvasPtr->xOrigin + canvasPtr->inset;
+ screenY1 = canvasPtr->yOrigin + canvasPtr->inset;
+ screenX2 = canvasPtr->xOrigin + Tk_Width(tkwin) - canvasPtr->inset;
+ screenY2 = canvasPtr->yOrigin + Tk_Height(tkwin) - canvasPtr->inset;
+ if (canvasPtr->redrawX1 > screenX1) {
+ screenX1 = canvasPtr->redrawX1;
+ }
+ if (canvasPtr->redrawY1 > screenY1) {
+ screenY1 = canvasPtr->redrawY1;
+ }
+ if (canvasPtr->redrawX2 < screenX2) {
+ screenX2 = canvasPtr->redrawX2;
+ }
+ if (canvasPtr->redrawY2 < screenY2) {
+ screenY2 = canvasPtr->redrawY2;
+ }
+ if ((screenX1 >= screenX2) || (screenY1 >= screenY2)) {
+ goto borders;
+ }
+
+ /*
+ * Redrawing is done in a temporary pixmap that is allocated
+ * here and freed at the end of the procedure. All drawing
+ * is done to the pixmap, and the pixmap is copied to the
+ * screen at the end of the procedure. The temporary pixmap
+ * serves two purposes:
+ *
+ * 1. It provides a smoother visual effect (no clearing and
+ * gradual redraw will be visible to users).
+ * 2. It allows us to redraw only the objects that overlap
+ * the redraw area. Otherwise incorrect results could
+ * occur from redrawing things that stick outside of
+ * the redraw area (we'd have to redraw everything in
+ * order to make the overlaps look right).
+ *
+ * Some tricky points about the pixmap:
+ *
+ * 1. We only allocate a large enough pixmap to hold the
+ * area that has to be redisplayed. This saves time in
+ * in the X server for large objects that cover much
+ * more than the area being redisplayed: only the area
+ * of the pixmap will actually have to be redrawn.
+ * 2. Some X servers (e.g. the one for DECstations) have troubles
+ * with characters that overlap an edge of the pixmap (on the
+ * DEC servers, as of 8/18/92, such characters are drawn one
+ * pixel too far to the right). To handle this problem,
+ * make the pixmap a bit larger than is absolutely needed
+ * so that for normal-sized fonts the characters that overlap
+ * the edge of the pixmap will be outside the area we care
+ * about.
+ */
+
+ canvasPtr->drawableXOrigin = screenX1 - 30;
+ canvasPtr->drawableYOrigin = screenY1 - 30;
+ pixmap = Tk_GetPixmap(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ (screenX2 + 30 - canvasPtr->drawableXOrigin),
+ (screenY2 + 30 - canvasPtr->drawableYOrigin),
+ Tk_Depth(tkwin));
+
+ /*
+ * Clear the area to be redrawn.
+ */
+
+ width = screenX2 - screenX1;
+ height = screenY2 - screenY1;
+
+ XFillRectangle(Tk_Display(tkwin), pixmap, canvasPtr->pixmapGC,
+ screenX1 - canvasPtr->drawableXOrigin,
+ screenY1 - canvasPtr->drawableYOrigin, (unsigned int) width,
+ (unsigned int) height);
+
+ /*
+ * Scan through the item list, redrawing those items that need it.
+ * An item must be redraw if either (a) it intersects the smaller
+ * on-screen area or (b) it intersects the full canvas area and its
+ * type requests that it be redrawn always (e.g. so subwindows can
+ * be unmapped when they move off-screen).
+ */
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if ((itemPtr->x1 >= screenX2)
+ || (itemPtr->y1 >= screenY2)
+ || (itemPtr->x2 < screenX1)
+ || (itemPtr->y2 < screenY1)) {
+ if (!itemPtr->typePtr->alwaysRedraw
+ || (itemPtr->x1 >= canvasPtr->redrawX2)
+ || (itemPtr->y1 >= canvasPtr->redrawY2)
+ || (itemPtr->x2 < canvasPtr->redrawX1)
+ || (itemPtr->y2 < canvasPtr->redrawY1)) {
+ continue;
+ }
+ }
+ (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr, itemPtr,
+ canvasPtr->display, pixmap, screenX1, screenY1, width,
+ height);
+ }
+
+ /*
+ * Copy from the temporary pixmap to the screen, then free up
+ * the temporary pixmap.
+ */
+
+ XCopyArea(Tk_Display(tkwin), pixmap, Tk_WindowId(tkwin),
+ canvasPtr->pixmapGC,
+ screenX1 - canvasPtr->drawableXOrigin,
+ screenY1 - canvasPtr->drawableYOrigin,
+ (unsigned) (screenX2 - screenX1),
+ (unsigned) (screenY2 - screenY1),
+ screenX1 - canvasPtr->xOrigin, screenY1 - canvasPtr->yOrigin);
+ Tk_FreePixmap(Tk_Display(tkwin), pixmap);
+ }
+
+ /*
+ * Draw the window borders, if needed.
+ */
+
+ borders:
+ if (canvasPtr->flags & REDRAW_BORDERS) {
+ canvasPtr->flags &= ~REDRAW_BORDERS;
+ if (canvasPtr->borderWidth > 0) {
+ Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin),
+ canvasPtr->bgBorder, canvasPtr->highlightWidth,
+ canvasPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*canvasPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*canvasPtr->highlightWidth,
+ canvasPtr->borderWidth, canvasPtr->relief);
+ }
+ if (canvasPtr->highlightWidth != 0) {
+ GC gc;
+
+ if (canvasPtr->textInfo.gotFocus) {
+ gc = Tk_GCForColor(canvasPtr->highlightColorPtr,
+ Tk_WindowId(tkwin));
+ } else {
+ gc = Tk_GCForColor(canvasPtr->highlightBgColorPtr,
+ Tk_WindowId(tkwin));
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, canvasPtr->highlightWidth,
+ Tk_WindowId(tkwin));
+ }
+ }
+
+ done:
+ canvasPtr->flags &= ~REDRAW_PENDING;
+ canvasPtr->redrawX1 = canvasPtr->redrawX2 = 0;
+ canvasPtr->redrawY1 = canvasPtr->redrawY2 = 0;
+ if (canvasPtr->flags & UPDATE_SCROLLBARS) {
+ CanvasUpdateScrollbars(canvasPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on canvases.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+
+ if (eventPtr->type == Expose) {
+ int x, y;
+
+ x = eventPtr->xexpose.x + canvasPtr->xOrigin;
+ y = eventPtr->xexpose.y + canvasPtr->yOrigin;
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, x, y,
+ x + eventPtr->xexpose.width,
+ y + eventPtr->xexpose.height);
+ if ((eventPtr->xexpose.x < canvasPtr->inset)
+ || (eventPtr->xexpose.y < canvasPtr->inset)
+ || ((eventPtr->xexpose.x + eventPtr->xexpose.width)
+ > (Tk_Width(canvasPtr->tkwin) - canvasPtr->inset))
+ || ((eventPtr->xexpose.y + eventPtr->xexpose.height)
+ > (Tk_Height(canvasPtr->tkwin) - canvasPtr->inset))) {
+ canvasPtr->flags |= REDRAW_BORDERS;
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ if (canvasPtr->tkwin != NULL) {
+ canvasPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(canvasPtr->interp,
+ canvasPtr->widgetCmd);
+ }
+ if (canvasPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayCanvas, (ClientData) canvasPtr);
+ }
+ Tcl_EventuallyFree((ClientData) canvasPtr, DestroyCanvas);
+ } else if (eventPtr->type == ConfigureNotify) {
+ canvasPtr->flags |= UPDATE_SCROLLBARS;
+
+ /*
+ * The call below is needed in order to recenter the canvas if
+ * it's confined and its scroll region is smaller than the window.
+ */
+
+ CanvasSetOrigin(canvasPtr, canvasPtr->xOrigin, canvasPtr->yOrigin);
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr, canvasPtr->xOrigin,
+ canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+ canvasPtr->flags |= REDRAW_BORDERS;
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ CanvasFocusProc(canvasPtr, 1);
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ CanvasFocusProc(canvasPtr, 0);
+ }
+ } else if (eventPtr->type == UnmapNotify) {
+ Tk_Item *itemPtr;
+
+ /*
+ * Special hack: if the canvas is unmapped, then must notify
+ * all items with "alwaysRedraw" set, so that they know that
+ * they are no longer displayed.
+ */
+
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if (itemPtr->typePtr->alwaysRedraw) {
+ (*itemPtr->typePtr->displayProc)((Tk_Canvas) canvasPtr,
+ itemPtr, canvasPtr->display, None, 0, 0, 0, 0);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasCmdDeletedProc --
+ *
+ * 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
+CanvasCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+ Tk_Window tkwin = canvasPtr->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) {
+ canvasPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CanvasEventuallyRedraw --
+ *
+ * Arrange for part or all of a canvas widget to redrawn at
+ * some convenient time in the future.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The screen will eventually be refreshed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CanvasEventuallyRedraw(canvas, x1, y1, x2, y2)
+ Tk_Canvas canvas; /* Information about widget. */
+ int x1, y1; /* Upper left corner of area to redraw.
+ * Pixels on edge are redrawn. */
+ int x2, y2; /* Lower right corner of area to redraw.
+ * Pixels on edge are not redrawn. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) canvas;
+ if ((x1 == x2) || (y1 == y2)) {
+ return;
+ }
+ if (canvasPtr->flags & REDRAW_PENDING) {
+ if (x1 <= canvasPtr->redrawX1) {
+ canvasPtr->redrawX1 = x1;
+ }
+ if (y1 <= canvasPtr->redrawY1) {
+ canvasPtr->redrawY1 = y1;
+ }
+ if (x2 >= canvasPtr->redrawX2) {
+ canvasPtr->redrawX2 = x2;
+ }
+ if (y2 >= canvasPtr->redrawY2) {
+ canvasPtr->redrawY2 = y2;
+ }
+ } else {
+ canvasPtr->redrawX1 = x1;
+ canvasPtr->redrawY1 = y1;
+ canvasPtr->redrawX2 = x2;
+ canvasPtr->redrawY2 = y2;
+ Tcl_DoWhenIdle(DisplayCanvas, (ClientData) canvasPtr);
+ canvasPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateItemType --
+ *
+ * This procedure may be invoked to add a new kind of canvas
+ * element to the core item types supported by Tk.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * From now on, the new item type will be useable in canvas
+ * widgets (e.g. typePtr->name can be used as the item type
+ * in "create" widget commands). If there was already a
+ * type with the same name as in typePtr, it is replaced with
+ * the new type.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CreateItemType(typePtr)
+ Tk_ItemType *typePtr; /* Information about item type;
+ * storage must be statically
+ * allocated (must live forever). */
+{
+ Tk_ItemType *typePtr2, *prevPtr;
+
+ if (typeList == NULL) {
+ InitCanvas();
+ }
+
+ /*
+ * If there's already an item type with the given name, remove it.
+ */
+
+ for (typePtr2 = typeList, prevPtr = NULL; typePtr2 != NULL;
+ prevPtr = typePtr2, typePtr2 = typePtr2->nextPtr) {
+ if (strcmp(typePtr2->name, typePtr->name) == 0) {
+ if (prevPtr == NULL) {
+ typeList = typePtr2->nextPtr;
+ } else {
+ prevPtr->nextPtr = typePtr2->nextPtr;
+ }
+ break;
+ }
+ }
+ typePtr->nextPtr = typeList;
+ typeList = typePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetItemTypes --
+ *
+ * This procedure returns a pointer to the list of all item
+ * types.
+ *
+ * Results:
+ * The return value is a pointer to the first in the list
+ * of item types currently supported by canvases.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_ItemType *
+Tk_GetItemTypes()
+{
+ if (typeList == NULL) {
+ InitCanvas();
+ }
+ return typeList;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * InitCanvas --
+ *
+ * This procedure is invoked to perform once-only-ever
+ * initialization for the module, such as setting up
+ * the type table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+InitCanvas()
+{
+ if (typeList != NULL) {
+ return;
+ }
+ typeList = &tkRectangleType;
+ tkRectangleType.nextPtr = &tkTextType;
+ tkTextType.nextPtr = &tkLineType;
+ 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 --
+ *
+ * This procedure is called to initiate an enumeration of
+ * all items in a given canvas that contain a given tag.
+ *
+ * Results:
+ * The return value is a pointer to the first item in
+ * canvasPtr that matches tag, or NULL if there is no
+ * such item. The information at *searchPtr is initialized
+ * such that successive calls to NextItem will return
+ * successive items that match tag.
+ *
+ * Side effects:
+ * SearchPtr is linked into a list of searches in progress
+ * on canvasPtr, so that elements can safely be deleted
+ * while the search is in progress. EndTagSearch must be
+ * called at the end of the search to unlink searchPtr from
+ * this list.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Tk_Item *
+StartTagSearch(canvasPtr, tag, searchPtr)
+ 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;
+
+ /*
+ * 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;
+
+ 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)) {
+ 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 == allUid) {
+
+ /*
+ * 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * NextItem --
+ *
+ * This procedure returns successive items that match a given
+ * tag; it should be called only after StartTagSearch has been
+ * used to begin a search.
+ *
+ * Results:
+ * The return value is a pointer to the next item that matches
+ * the tag specified to StartTagSearch, or NULL if no such
+ * item exists. *SearchPtr is updated so that the next call
+ * to this procedure will return the next item.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+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 interp->result; otherwise tag is added to itemPtr's
+ * list of tags.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DoItem(interp, itemPtr, tag)
+ Tcl_Interp *interp; /* Interpreter in which to (possibly)
+ * record item id. */
+ Tk_Item *itemPtr; /* Item to (possibly) modify. */
+ Tk_Uid tag; /* Tag to add to those already
+ * present for item, or NULL. */
+{
+ Tk_Uid *tagPtr;
+ 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--) {
+ if (tag == *tagPtr) {
+ return;
+ }
+ }
+
+ /*
+ * Grow the tag space if there's no more room left in the current
+ * block.
+ */
+
+ if (itemPtr->tagSpace == itemPtr->numTags) {
+ Tk_Uid *newTagPtr;
+
+ itemPtr->tagSpace += 5;
+ newTagPtr = (Tk_Uid *) ckalloc((unsigned)
+ (itemPtr->tagSpace * sizeof(Tk_Uid)));
+ memcpy((VOID *) newTagPtr, (VOID *) itemPtr->tagPtr,
+ (itemPtr->numTags * sizeof(Tk_Uid)));
+ if (itemPtr->tagPtr != itemPtr->staticTagSpace) {
+ ckfree((char *) itemPtr->tagPtr);
+ }
+ itemPtr->tagPtr = newTagPtr;
+ tagPtr = &itemPtr->tagPtr[itemPtr->numTags];
+ }
+
+ /*
+ * Add in the new tag.
+ */
+
+ *tagPtr = tag;
+ itemPtr->numTags++;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FindItems --
+ *
+ * This procedure does all the work of implementing the
+ * "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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+FindItems(interp, canvasPtr, argc, argv, newTag, cmdName, option)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ TkCanvas *canvasPtr; /* Canvas whose items are to be
+ * searched. */
+ int argc; /* Number of entries in argv. Must be
+ * 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;
+ size_t length;
+ TagSearch search;
+ Tk_Item *itemPtr;
+ Tk_Uid uid;
+
+ if (newTag != NULL) {
+ uid = Tk_GetUid(newTag);
+ } else {
+ uid = NULL;
+ }
+ c = argv[0][0];
+ length = strlen(argv[0]);
+ if ((c == 'a') && (strncmp(argv[0], "above", length) == 0)
+ && (length >= 2)) {
+ Tk_Item *lastPtr = NULL;
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ cmdName, option, " above tagOrId", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[1], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ lastPtr = itemPtr;
+ }
+ if ((lastPtr != NULL) && (lastPtr->nextPtr != NULL)) {
+ DoItem(interp, lastPtr->nextPtr, uid);
+ }
+ } else if ((c == 'a') && (strncmp(argv[0], "all", length) == 0)
+ && (length >= 2)) {
+ if (argc != 1) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ cmdName, option, " all", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ 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;
+
+ if ((argc < 3) || (argc > 5)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ cmdName, option, " closest x y ?halo? ?start?",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[1],
+ &coords[0]) != TCL_OK) || (Tk_CanvasGetCoord(interp,
+ (Tk_Canvas) canvasPtr, argv[2], &coords[1]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (argc > 3) {
+ if (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[3],
+ &halo) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (halo < 0.0) {
+ Tcl_AppendResult(interp, "can't have negative halo value \"",
+ argv[3], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ halo = 0.0;
+ }
+
+ /*
+ * Find the item at which to start the search.
+ */
+
+ startPtr = canvasPtr->firstItemPtr;
+ if (argc == 5) {
+ itemPtr = StartTagSearch(canvasPtr, argv[4], &search);
+ if (itemPtr != NULL) {
+ startPtr = itemPtr;
+ }
+ }
+
+ /*
+ * The code below is optimized so that it can eliminate most
+ * items without having to call their item-specific procedures.
+ * This is done by keeping a bounding box (x1, y1, x2, y2) that
+ * an item's bbox must overlap if the item is to have any
+ * chance of being closer than the closest so far.
+ */
+
+ itemPtr = startPtr;
+ if (itemPtr == NULL) {
+ return TCL_OK;
+ }
+ closestDist = (*itemPtr->typePtr->pointProc)((Tk_Canvas) canvasPtr,
+ itemPtr, coords) - halo;
+ if (closestDist < 0.0) {
+ closestDist = 0.0;
+ }
+ while (1) {
+ double newDist;
+
+ /*
+ * Update the bounding box using itemPtr, which is the
+ * new closest item.
+ */
+
+ x1 = (int) (coords[0] - closestDist - halo - 1);
+ y1 = (int) (coords[1] - closestDist - halo - 1);
+ x2 = (int) (coords[0] + closestDist + halo + 1);
+ y2 = (int) (coords[1] + closestDist + halo + 1);
+ closestPtr = itemPtr;
+
+ /*
+ * Search for an item that beats the current closest one.
+ * Work circularly through the canvas's item list until
+ * getting back to the starting item.
+ */
+
+ while (1) {
+ itemPtr = itemPtr->nextPtr;
+ if (itemPtr == NULL) {
+ itemPtr = canvasPtr->firstItemPtr;
+ }
+ if (itemPtr == startPtr) {
+ DoItem(interp, closestPtr, uid);
+ return TCL_OK;
+ }
+ if ((itemPtr->x1 >= x2) || (itemPtr->x2 <= x1)
+ || (itemPtr->y1 >= y2) || (itemPtr->y2 <= y1)) {
+ continue;
+ }
+ newDist = (*itemPtr->typePtr->pointProc)((Tk_Canvas) canvasPtr,
+ itemPtr, coords) - halo;
+ if (newDist < 0.0) {
+ newDist = 0.0;
+ }
+ if (newDist <= closestDist) {
+ closestDist = newDist;
+ break;
+ }
+ }
+ }
+ } else if ((c == 'e') && (strncmp(argv[0], "enclosed", length) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ cmdName, option, " enclosed x1 y1 x2 y2", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return FindArea(interp, canvasPtr, argv+1, uid, 1);
+ } else if ((c == 'o') && (strncmp(argv[0], "overlapping", length) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ cmdName, option, " overlapping x1 y1 x2 y2",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return FindArea(interp, canvasPtr, argv+1, uid, 0);
+ } else if ((c == 'w') && (strncmp(argv[0], "withtag", length) == 0)) {
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ cmdName, option, " withtag tagOrId", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (itemPtr = StartTagSearch(canvasPtr, argv[1], &search);
+ itemPtr != NULL; itemPtr = NextItem(&search)) {
+ DoItem(interp, itemPtr, uid);
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad search command \"", argv[0],
+ "\": must be above, all, below, closest, enclosed, ",
+ "overlapping, or withtag", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FindArea --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+FindArea(interp, canvasPtr, argv, uid, enclosed)
+ Tcl_Interp *interp; /* Interpreter for error reporting
+ * and result storing. */
+ TkCanvas *canvasPtr; /* Canvas whose items are to be
+ * 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;
+
+ if ((Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[0],
+ &rect[0]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[1],
+ &rect[1]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[2],
+ &rect[2]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, (Tk_Canvas) canvasPtr, argv[3],
+ &rect[3]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if (rect[0] > rect[2]) {
+ tmp = rect[0]; rect[0] = rect[2]; rect[2] = tmp;
+ }
+ if (rect[1] > rect[3]) {
+ tmp = rect[1]; rect[1] = rect[3]; rect[3] = tmp;
+ }
+
+ /*
+ * Use an integer bounding box for a quick test, to avoid
+ * calling item-specific code except for items that are close.
+ */
+
+ x1 = (int) (rect[0]-1.0);
+ y1 = (int) (rect[1]-1.0);
+ x2 = (int) (rect[2]+1.0);
+ y2 = (int) (rect[3]+1.0);
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if ((itemPtr->x1 >= x2) || (itemPtr->x2 <= x1)
+ || (itemPtr->y1 >= y2) || (itemPtr->y2 <= y1)) {
+ continue;
+ }
+ if ((*itemPtr->typePtr->areaProc)((Tk_Canvas) canvasPtr, itemPtr, rect)
+ >= enclosed) {
+ DoItem(interp, itemPtr, uid);
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RelinkItems --
+ *
+ * Move one or more items to a different place in the
+ * display order for a canvas.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The items identified by "tag" are moved so that they
+ * are all together in the display list and immediately
+ * after prevPtr. The order of the moved items relative
+ * to each other is not changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+RelinkItems(canvasPtr, tag, prevPtr)
+ TkCanvas *canvasPtr; /* Canvas to be modified. */
+ char *tag; /* Tag identifying items to be moved
+ * in the redisplay list. */
+ Tk_Item *prevPtr; /* Reposition the items so that they
+ * go just after this item (NULL means
+ * put at beginning of list). */
+{
+ Tk_Item *itemPtr;
+ TagSearch search;
+ Tk_Item *firstMovePtr, *lastMovePtr;
+
+ /*
+ * Find all of the items to be moved and remove them from
+ * the list, making an auxiliary list running from firstMovePtr
+ * to lastMovePtr. Record their areas for redisplay.
+ */
+
+ firstMovePtr = lastMovePtr = NULL;
+ for (itemPtr = StartTagSearch(canvasPtr, tag, &search);
+ 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;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasBindProc --
+ *
+ * This procedure is invoked by the Tk dispatcher to handle
+ * events associated with bindings on items.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the command invoked as part of the binding
+ * (if there was any).
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasBindProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to canvas structure. */
+ XEvent *eventPtr; /* Pointer to X event that just
+ * happened. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+
+ Tcl_Preserve((ClientData) canvasPtr);
+
+ /*
+ * This code below keeps track of the current modifier state in
+ * canvasPtr>state. This information is used to defer repicks of
+ * the current item while buttons are down.
+ */
+
+ if ((eventPtr->type == ButtonPress) || (eventPtr->type == ButtonRelease)) {
+ int mask;
+
+ switch (eventPtr->xbutton.button) {
+ case Button1:
+ mask = Button1Mask;
+ break;
+ case Button2:
+ mask = Button2Mask;
+ break;
+ case Button3:
+ mask = Button3Mask;
+ break;
+ case Button4:
+ mask = Button4Mask;
+ break;
+ case Button5:
+ mask = Button5Mask;
+ break;
+ default:
+ mask = 0;
+ break;
+ }
+
+ /*
+ * For button press events, repick the current item using the
+ * button state before the event, then process the event. For
+ * button release events, first process the event, then repick
+ * the current item using the button state *after* the event
+ * (the button has logically gone up before we change the
+ * current item).
+ */
+
+ if (eventPtr->type == ButtonPress) {
+ /*
+ * On a button press, first repick the current item using
+ * the button state before the event, the process the event.
+ */
+
+ canvasPtr->state = eventPtr->xbutton.state;
+ PickCurrentItem(canvasPtr, eventPtr);
+ canvasPtr->state ^= mask;
+ CanvasDoEvent(canvasPtr, eventPtr);
+ } else {
+ /*
+ * Button release: first process the event, with the button
+ * still considered to be down. Then repick the current
+ * item under the assumption that the button is no longer down.
+ */
+
+ canvasPtr->state = eventPtr->xbutton.state;
+ CanvasDoEvent(canvasPtr, eventPtr);
+ eventPtr->xbutton.state ^= mask;
+ canvasPtr->state = eventPtr->xbutton.state;
+ PickCurrentItem(canvasPtr, eventPtr);
+ eventPtr->xbutton.state ^= mask;
+ }
+ goto done;
+ } else if ((eventPtr->type == EnterNotify)
+ || (eventPtr->type == LeaveNotify)) {
+ canvasPtr->state = eventPtr->xcrossing.state;
+ PickCurrentItem(canvasPtr, eventPtr);
+ goto done;
+ } else if (eventPtr->type == MotionNotify) {
+ canvasPtr->state = eventPtr->xmotion.state;
+ PickCurrentItem(canvasPtr, eventPtr);
+ }
+ CanvasDoEvent(canvasPtr, eventPtr);
+
+ done:
+ Tcl_Release((ClientData) canvasPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PickCurrentItem --
+ *
+ * Find the topmost item in a canvas that contains a given
+ * location and mark the the current item. If the current
+ * item has changed, generate a fake exit event on the old
+ * current item and a fake enter event on the new current
+ * item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The current item for canvasPtr may change. If it does,
+ * then the commands associated with item entry and exit
+ * could do just about anything. A binding script could
+ * delete the canvas, so callers should protect themselves
+ * with Tcl_Preserve and Tcl_Release.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+PickCurrentItem(canvasPtr, eventPtr)
+ TkCanvas *canvasPtr; /* Canvas widget in which to select
+ * current item. */
+ XEvent *eventPtr; /* Event describing location of
+ * mouse cursor. Must be EnterWindow,
+ * LeaveWindow, ButtonRelease, or
+ * MotionNotify. */
+{
+ double coords[2];
+ int buttonDown;
+
+ /*
+ * Check whether or not a button is down. If so, we'll log entry
+ * and exit into and out of the current item, but not entry into
+ * any other item. This implements a form of grabbing equivalent
+ * to what the X server does for windows.
+ */
+
+ buttonDown = canvasPtr->state
+ & (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask);
+ if (!buttonDown) {
+ canvasPtr->flags &= ~LEFT_GRABBED_ITEM;
+ }
+
+ /*
+ * Save information about this event in the canvas. The event in
+ * the canvas is used for two purposes:
+ *
+ * 1. Event bindings: if the current item changes, fake events are
+ * generated to allow item-enter and item-leave bindings to trigger.
+ * 2. Reselection: if the current item gets deleted, can use the
+ * saved event to find a new current item.
+ * Translate MotionNotify events into EnterNotify events, since that's
+ * what gets reported to item handlers.
+ */
+
+ if (eventPtr != &canvasPtr->pickEvent) {
+ if ((eventPtr->type == MotionNotify)
+ || (eventPtr->type == ButtonRelease)) {
+ canvasPtr->pickEvent.xcrossing.type = EnterNotify;
+ canvasPtr->pickEvent.xcrossing.serial = eventPtr->xmotion.serial;
+ canvasPtr->pickEvent.xcrossing.send_event
+ = eventPtr->xmotion.send_event;
+ canvasPtr->pickEvent.xcrossing.display = eventPtr->xmotion.display;
+ canvasPtr->pickEvent.xcrossing.window = eventPtr->xmotion.window;
+ canvasPtr->pickEvent.xcrossing.root = eventPtr->xmotion.root;
+ canvasPtr->pickEvent.xcrossing.subwindow = None;
+ canvasPtr->pickEvent.xcrossing.time = eventPtr->xmotion.time;
+ canvasPtr->pickEvent.xcrossing.x = eventPtr->xmotion.x;
+ canvasPtr->pickEvent.xcrossing.y = eventPtr->xmotion.y;
+ canvasPtr->pickEvent.xcrossing.x_root = eventPtr->xmotion.x_root;
+ canvasPtr->pickEvent.xcrossing.y_root = eventPtr->xmotion.y_root;
+ canvasPtr->pickEvent.xcrossing.mode = NotifyNormal;
+ canvasPtr->pickEvent.xcrossing.detail = NotifyNonlinear;
+ canvasPtr->pickEvent.xcrossing.same_screen
+ = eventPtr->xmotion.same_screen;
+ canvasPtr->pickEvent.xcrossing.focus = False;
+ canvasPtr->pickEvent.xcrossing.state = eventPtr->xmotion.state;
+ } else {
+ canvasPtr->pickEvent = *eventPtr;
+ }
+ }
+
+ /*
+ * If this is a recursive call (there's already a partially completed
+ * call pending on the stack; it's in the middle of processing a
+ * Leave event handler for the old current item) then just return;
+ * the pending call will do everything that's needed.
+ */
+
+ if (canvasPtr->flags & REPICK_IN_PROGRESS) {
+ return;
+ }
+
+ /*
+ * A LeaveNotify event automatically means that there's no current
+ * object, so the check for closest item can be skipped.
+ */
+
+ coords[0] = canvasPtr->pickEvent.xcrossing.x + canvasPtr->xOrigin;
+ coords[1] = canvasPtr->pickEvent.xcrossing.y + canvasPtr->yOrigin;
+ if (canvasPtr->pickEvent.type != LeaveNotify) {
+ canvasPtr->newCurrentPtr = CanvasFindClosest(canvasPtr, coords);
+ } else {
+ canvasPtr->newCurrentPtr = NULL;
+ }
+
+ if ((canvasPtr->newCurrentPtr == canvasPtr->currentItemPtr)
+ && !(canvasPtr->flags & LEFT_GRABBED_ITEM)) {
+ /*
+ * Nothing to do: the current item hasn't changed.
+ */
+
+ return;
+ }
+
+ /*
+ * Simulate a LeaveNotify event on the previous current item and
+ * an EnterNotify event on the new current item. Remove the "current"
+ * tag from the previous current item and place it on the new current
+ * item.
+ */
+
+ if ((canvasPtr->newCurrentPtr != canvasPtr->currentItemPtr)
+ && (canvasPtr->currentItemPtr != NULL)
+ && !(canvasPtr->flags & LEFT_GRABBED_ITEM)) {
+ XEvent event;
+ Tk_Item *itemPtr = canvasPtr->currentItemPtr;
+ int i;
+
+ event = canvasPtr->pickEvent;
+ event.type = LeaveNotify;
+
+ /*
+ * If the event's detail happens to be NotifyInferior the
+ * binding mechanism will discard the event. To be consistent,
+ * always use NotifyAncestor.
+ */
+
+ event.xcrossing.detail = NotifyAncestor;
+ canvasPtr->flags |= REPICK_IN_PROGRESS;
+ CanvasDoEvent(canvasPtr, &event);
+ canvasPtr->flags &= ~REPICK_IN_PROGRESS;
+
+ /*
+ * 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;
+ }
+ }
+ }
+
+ /*
+ * Note: during CanvasDoEvent above, it's possible that
+ * canvasPtr->newCurrentPtr got reset to NULL because the
+ * item was deleted.
+ */
+ }
+ if ((canvasPtr->newCurrentPtr != canvasPtr->currentItemPtr) && buttonDown) {
+ canvasPtr->flags |= LEFT_GRABBED_ITEM;
+ return;
+ }
+
+ /*
+ * Special note: it's possible that canvasPtr->newCurrentPtr ==
+ * canvasPtr->currentItemPtr here. This can happen, for example,
+ * if LEFT_GRABBED_ITEM was set.
+ */
+
+ 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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasFindClosest --
+ *
+ * Given x and y coordinates, find the topmost canvas item that
+ * is "close" to the coordinates.
+ *
+ * Results:
+ * The return value is a pointer to the topmost item that is
+ * close to (x,y), or NULL if no item is close.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_Item *
+CanvasFindClosest(canvasPtr, coords)
+ TkCanvas *canvasPtr; /* Canvas widget to search. */
+ double coords[2]; /* Desired x,y position in canvas,
+ * not screen, coordinates.) */
+{
+ Tk_Item *itemPtr;
+ Tk_Item *bestPtr;
+ int x1, y1, x2, y2;
+
+ x1 = (int) (coords[0] - canvasPtr->closeEnough);
+ y1 = (int) (coords[1] - canvasPtr->closeEnough);
+ x2 = (int) (coords[0] + canvasPtr->closeEnough);
+ y2 = (int) (coords[1] + canvasPtr->closeEnough);
+
+ bestPtr = NULL;
+ for (itemPtr = canvasPtr->firstItemPtr; itemPtr != NULL;
+ itemPtr = itemPtr->nextPtr) {
+ if ((itemPtr->x1 > x2) || (itemPtr->x2 < x1)
+ || (itemPtr->y1 > y2) || (itemPtr->y2 < y1)) {
+ continue;
+ }
+ if ((*itemPtr->typePtr->pointProc)((Tk_Canvas) canvasPtr,
+ itemPtr, coords) <= canvasPtr->closeEnough) {
+ bestPtr = itemPtr;
+ }
+ }
+ return bestPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasDoEvent --
+ *
+ * This procedure is called to invoke binding processing
+ * for a new event that is associated with the current item
+ * for a canvas.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the bindings for the canvas. A binding script
+ * could delete the canvas, so callers should protect themselves
+ * with Tcl_Preserve and Tcl_Release.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasDoEvent(canvasPtr, eventPtr)
+ TkCanvas *canvasPtr; /* Canvas widget in which event
+ * occurred. */
+ XEvent *eventPtr; /* Real or simulated X event that
+ * is to be processed. */
+{
+#define NUM_STATIC 3
+ ClientData staticObjects[NUM_STATIC];
+ ClientData *objectPtr;
+ int numObjects, i;
+ Tk_Item *itemPtr;
+
+ if (canvasPtr->bindingTable == NULL) {
+ return;
+ }
+
+ itemPtr = canvasPtr->currentItemPtr;
+ if ((eventPtr->type == KeyPress) || (eventPtr->type == KeyRelease)) {
+ itemPtr = canvasPtr->textInfo.focusItemPtr;
+ }
+ if (itemPtr == NULL) {
+ return;
+ }
+
+ /*
+ * Set up an array with all the relevant objects for processing
+ * this event. The relevant objects are (a) the event's item,
+ * (b) the tags associated with the event's item, and (c) the
+ * tag "all". If there are a lot of tags then malloc an array
+ * to hold all of the objects.
+ */
+
+ 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
+ * it was malloc-ed.
+ */
+
+ if (canvasPtr->tkwin != NULL) {
+ Tk_BindEvent(canvasPtr->bindingTable, eventPtr, canvasPtr->tkwin,
+ numObjects, objectPtr);
+ }
+ if (objectPtr != staticObjects) {
+ ckfree((char *) objectPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasBlinkProc --
+ *
+ * This procedure is called as a timer handler to blink the
+ * insertion cursor off and on.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor gets turned on or off, redisplay gets invoked,
+ * and this procedure reschedules itself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasBlinkProc(clientData)
+ ClientData clientData; /* Pointer to record describing entry. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+
+ if (!canvasPtr->textInfo.gotFocus || (canvasPtr->insertOffTime == 0)) {
+ return;
+ }
+ if (canvasPtr->textInfo.cursorOn) {
+ canvasPtr->textInfo.cursorOn = 0;
+ canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ canvasPtr->insertOffTime, CanvasBlinkProc,
+ (ClientData) canvasPtr);
+ } else {
+ canvasPtr->textInfo.cursorOn = 1;
+ canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ canvasPtr->insertOnTime, CanvasBlinkProc,
+ (ClientData) canvasPtr);
+ }
+ if (canvasPtr->textInfo.focusItemPtr != NULL) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.focusItemPtr->x1,
+ canvasPtr->textInfo.focusItemPtr->y1,
+ canvasPtr->textInfo.focusItemPtr->x2,
+ canvasPtr->textInfo.focusItemPtr->y2);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasFocusProc --
+ *
+ * This procedure is called whenever a canvas gets or loses the
+ * input focus. It's also called whenever the window is
+ * reconfigured while it has the focus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor gets turned on or off.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasFocusProc(canvasPtr, gotFocus)
+ TkCanvas *canvasPtr; /* Canvas that just got or lost focus. */
+ int gotFocus; /* 1 means window is getting focus, 0 means
+ * it's losing it. */
+{
+ Tcl_DeleteTimerHandler(canvasPtr->insertBlinkHandler);
+ if (gotFocus) {
+ canvasPtr->textInfo.gotFocus = 1;
+ canvasPtr->textInfo.cursorOn = 1;
+ if (canvasPtr->insertOffTime != 0) {
+ canvasPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ canvasPtr->insertOffTime, CanvasBlinkProc,
+ (ClientData) canvasPtr);
+ }
+ } else {
+ canvasPtr->textInfo.gotFocus = 0;
+ canvasPtr->textInfo.cursorOn = 0;
+ canvasPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ }
+ if (canvasPtr->textInfo.focusItemPtr != NULL) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.focusItemPtr->x1,
+ canvasPtr->textInfo.focusItemPtr->y1,
+ canvasPtr->textInfo.focusItemPtr->x2,
+ canvasPtr->textInfo.focusItemPtr->y2);
+ }
+ if (canvasPtr->highlightWidth > 0) {
+ canvasPtr->flags |= REDRAW_BORDERS;
+ if (!(canvasPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayCanvas, (ClientData) canvasPtr);
+ canvasPtr->flags |= REDRAW_PENDING;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasSelectTo --
+ *
+ * Modify the selection by moving its un-anchored end. This could
+ * make the selection either larger or smaller.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The selection changes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasSelectTo(canvasPtr, itemPtr, index)
+ TkCanvas *canvasPtr; /* Information about widget. */
+ Tk_Item *itemPtr; /* Item that is to hold selection. */
+ int index; /* Index of element that is to become the
+ * "other" end of the selection. */
+{
+ int oldFirst, oldLast;
+ Tk_Item *oldSelPtr;
+
+ oldFirst = canvasPtr->textInfo.selectFirst;
+ oldLast = canvasPtr->textInfo.selectLast;
+ oldSelPtr = canvasPtr->textInfo.selItemPtr;
+
+ /*
+ * Grab the selection if we don't own it already.
+ */
+
+ if (canvasPtr->textInfo.selItemPtr == NULL) {
+ Tk_OwnSelection(canvasPtr->tkwin, XA_PRIMARY, CanvasLostSelection,
+ (ClientData) canvasPtr);
+ } else if (canvasPtr->textInfo.selItemPtr != itemPtr) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.selItemPtr->x1,
+ canvasPtr->textInfo.selItemPtr->y1,
+ canvasPtr->textInfo.selItemPtr->x2,
+ canvasPtr->textInfo.selItemPtr->y2);
+ }
+ canvasPtr->textInfo.selItemPtr = itemPtr;
+
+ if (canvasPtr->textInfo.anchorItemPtr != itemPtr) {
+ canvasPtr->textInfo.anchorItemPtr = itemPtr;
+ canvasPtr->textInfo.selectAnchor = index;
+ }
+ if (canvasPtr->textInfo.selectAnchor <= index) {
+ canvasPtr->textInfo.selectFirst = canvasPtr->textInfo.selectAnchor;
+ canvasPtr->textInfo.selectLast = index;
+ } else {
+ canvasPtr->textInfo.selectFirst = index;
+ canvasPtr->textInfo.selectLast = canvasPtr->textInfo.selectAnchor - 1;
+ }
+ if ((canvasPtr->textInfo.selectFirst != oldFirst)
+ || (canvasPtr->textInfo.selectLast != oldLast)
+ || (itemPtr != oldSelPtr)) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ itemPtr->x1, itemPtr->y1, itemPtr->x2, itemPtr->y2);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasFetchSelection --
+ *
+ * This procedure is invoked by Tk to return part or all of
+ * the selection, when the selection is in a canvas widget.
+ * This procedure always returns the selection as a STRING.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored
+ * at buffer. Buffer is filled (or partially filled) with a
+ * NULL-terminated string containing part or all of the selection,
+ * as given by offset and maxBytes.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CanvasFetchSelection(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Information about canvas 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. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+
+ if (canvasPtr->textInfo.selItemPtr == NULL) {
+ return -1;
+ }
+ if (canvasPtr->textInfo.selItemPtr->typePtr->selectionProc == NULL) {
+ return -1;
+ }
+ return (*canvasPtr->textInfo.selItemPtr->typePtr->selectionProc)(
+ (Tk_Canvas) canvasPtr, canvasPtr->textInfo.selItemPtr, offset,
+ buffer, maxBytes);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CanvasLostSelection --
+ *
+ * This procedure is called back by Tk when the selection is
+ * grabbed away from a canvas widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The existing selection is unhighlighted, and the window is
+ * marked as not containing a selection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CanvasLostSelection(clientData)
+ ClientData clientData; /* Information about entry widget. */
+{
+ TkCanvas *canvasPtr = (TkCanvas *) clientData;
+
+ if (canvasPtr->textInfo.selItemPtr != NULL) {
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->textInfo.selItemPtr->x1,
+ canvasPtr->textInfo.selItemPtr->y1,
+ canvasPtr->textInfo.selItemPtr->x2,
+ canvasPtr->textInfo.selItemPtr->y2);
+ }
+ canvasPtr->textInfo.selItemPtr = NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GridAlign --
+ *
+ * Given a coordinate and a grid spacing, this procedure
+ * computes the location of the nearest grid line to the
+ * coordinate.
+ *
+ * Results:
+ * The return value is the location of the grid line nearest
+ * to coord.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static double
+GridAlign(coord, spacing)
+ double coord; /* Coordinate to grid-align. */
+ double spacing; /* Spacing between grid lines. If <= 0
+ * then no alignment is done. */
+{
+ if (spacing <= 0.0) {
+ return coord;
+ }
+ if (coord < 0) {
+ return -((int) ((-coord)/spacing + 0.5)) * spacing;
+ }
+ return ((int) (coord/spacing + 0.5)) * spacing;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PrintScrollFractions --
+ *
+ * Given the range that's visible in the window and the "100%
+ * range" for what's in the canvas, print a string containing
+ * the scroll fractions. This procedure is used for both x
+ * and y scrolling.
+ *
+ * Results:
+ * The memory pointed to by string is modified to hold
+ * two real numbers containing the scroll fractions (between
+ * 0 and 1) corresponding to the other arguments.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+PrintScrollFractions(screen1, screen2, object1, object2, string)
+ int screen1; /* Lowest coordinate visible in the window. */
+ int screen2; /* Highest coordinate visible in the window. */
+ int object1; /* Lowest coordinate in the object. */
+ int object2; /* Highest coordinate in the object. */
+ char *string; /* Two real numbers get printed here. Must
+ * have enough storage for two %g
+ * conversions. */
+{
+ double range, f1, f2;
+
+ range = object2 - object1;
+ if (range <= 0) {
+ f1 = 0;
+ f2 = 1.0;
+ } else {
+ f1 = (screen1 - object1)/range;
+ if (f1 < 0) {
+ f1 = 0.0;
+ }
+ f2 = (screen2 - object1)/range;
+ if (f2 > 1.0) {
+ f2 = 1.0;
+ }
+ if (f2 < f1) {
+ f2 = f1;
+ }
+ }
+ sprintf(string, "%g %g", f1, f2);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasUpdateScrollbars --
+ *
+ * This procedure is invoked whenever a canvas has changed in
+ * a way that requires scrollbars to be redisplayed (e.g. the
+ * view in the canvas has changed).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there are scrollbars associated with the canvas, then
+ * their scrolling commands are invoked to cause them to
+ * redisplay. If errors occur, additional Tcl commands may
+ * be invoked to process the errors.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasUpdateScrollbars(canvasPtr)
+ TkCanvas *canvasPtr; /* Information about canvas. */
+{
+ int result;
+ char buffer[200];
+ Tcl_Interp *interp;
+ int xOrigin, yOrigin, inset, width, height, scrollX1, scrollX2,
+ scrollY1, scrollY2;
+ char *xScrollCmd, *yScrollCmd;
+
+ /*
+ * Save all the relevant values from the canvasPtr, because it might be
+ * deleted as part of either of the two calls to Tcl_VarEval below.
+ */
+
+ interp = canvasPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ xScrollCmd = canvasPtr->xScrollCmd;
+ if (xScrollCmd != (char *) NULL) {
+ Tcl_Preserve((ClientData) xScrollCmd);
+ }
+ yScrollCmd = canvasPtr->yScrollCmd;
+ if (yScrollCmd != (char *) NULL) {
+ Tcl_Preserve((ClientData) yScrollCmd);
+ }
+ xOrigin = canvasPtr->xOrigin;
+ yOrigin = canvasPtr->yOrigin;
+ inset = canvasPtr->inset;
+ width = Tk_Width(canvasPtr->tkwin);
+ height = Tk_Height(canvasPtr->tkwin);
+ scrollX1 = canvasPtr->scrollX1;
+ scrollX2 = canvasPtr->scrollX2;
+ scrollY1 = canvasPtr->scrollY1;
+ scrollY2 = canvasPtr->scrollY2;
+ canvasPtr->flags &= ~UPDATE_SCROLLBARS;
+ if (canvasPtr->xScrollCmd != NULL) {
+ PrintScrollFractions(xOrigin + inset, xOrigin + width - inset,
+ scrollX1, scrollX2, buffer);
+ result = Tcl_VarEval(interp, xScrollCmd, " ", buffer, (char *) NULL);
+ if (result != TCL_OK) {
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_ResetResult(interp);
+ Tcl_Release((ClientData) xScrollCmd);
+ }
+
+ if (yScrollCmd != NULL) {
+ PrintScrollFractions(yOrigin + inset, yOrigin + height - inset,
+ scrollY1, scrollY2, buffer);
+ result = Tcl_VarEval(interp, yScrollCmd, " ", buffer, (char *) NULL);
+ if (result != TCL_OK) {
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_ResetResult(interp);
+ Tcl_Release((ClientData) yScrollCmd);
+ }
+ Tcl_Release((ClientData) interp);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CanvasSetOrigin --
+ *
+ * This procedure is invoked to change the mapping between
+ * canvas coordinates and screen coordinates in the canvas
+ * window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The canvas will be redisplayed to reflect the change in
+ * view. In addition, scrollbars will be updated if there
+ * are any.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CanvasSetOrigin(canvasPtr, xOrigin, yOrigin)
+ TkCanvas *canvasPtr; /* Information about canvas. */
+ int xOrigin; /* New X origin for canvas (canvas x-coord
+ * corresponding to left edge of canvas
+ * window). */
+ int yOrigin; /* New Y origin for canvas (canvas y-coord
+ * corresponding to top edge of canvas
+ * window). */
+{
+ int left, right, top, bottom, delta;
+
+ /*
+ * If scroll increments have been set, round the window origin
+ * to the nearest multiple of the increments. Remember, the
+ * origin is the place just inside the borders, not the upper
+ * left corner.
+ */
+
+ if (canvasPtr->xScrollIncrement > 0) {
+ if (xOrigin >= 0) {
+ xOrigin += canvasPtr->xScrollIncrement/2;
+ xOrigin -= (xOrigin + canvasPtr->inset)
+ % canvasPtr->xScrollIncrement;
+ } else {
+ xOrigin = (-xOrigin) + canvasPtr->xScrollIncrement/2;
+ xOrigin = -(xOrigin - (xOrigin - canvasPtr->inset)
+ % canvasPtr->xScrollIncrement);
+ }
+ }
+ if (canvasPtr->yScrollIncrement > 0) {
+ if (yOrigin >= 0) {
+ yOrigin += canvasPtr->yScrollIncrement/2;
+ yOrigin -= (yOrigin + canvasPtr->inset)
+ % canvasPtr->yScrollIncrement;
+ } else {
+ yOrigin = (-yOrigin) + canvasPtr->yScrollIncrement/2;
+ yOrigin = -(yOrigin - (yOrigin - canvasPtr->inset)
+ % canvasPtr->yScrollIncrement);
+ }
+ }
+
+ /*
+ * Adjust the origin if necessary to keep as much as possible of the
+ * canvas in the view. The variables left, right, etc. keep track of
+ * how much extra space there is on each side of the view before it
+ * will stick out past the scroll region. If one side sticks out past
+ * the edge of the scroll region, adjust the view to bring that side
+ * back to the edge of the scrollregion (but don't move it so much that
+ * the other side sticks out now). If scroll increments are in effect,
+ * be sure to adjust only by full increments.
+ */
+
+ if ((canvasPtr->confine) && (canvasPtr->regionString != NULL)) {
+ left = xOrigin + canvasPtr->inset - canvasPtr->scrollX1;
+ right = canvasPtr->scrollX2
+ - (xOrigin + Tk_Width(canvasPtr->tkwin) - canvasPtr->inset);
+ top = yOrigin + canvasPtr->inset - canvasPtr->scrollY1;
+ bottom = canvasPtr->scrollY2
+ - (yOrigin + Tk_Height(canvasPtr->tkwin) - canvasPtr->inset);
+ if ((left < 0) && (right > 0)) {
+ delta = (right > -left) ? -left : right;
+ if (canvasPtr->xScrollIncrement > 0) {
+ delta -= delta % canvasPtr->xScrollIncrement;
+ }
+ xOrigin += delta;
+ } else if ((right < 0) && (left > 0)) {
+ delta = (left > -right) ? -right : left;
+ if (canvasPtr->xScrollIncrement > 0) {
+ delta -= delta % canvasPtr->xScrollIncrement;
+ }
+ xOrigin -= delta;
+ }
+ if ((top < 0) && (bottom > 0)) {
+ delta = (bottom > -top) ? -top : bottom;
+ if (canvasPtr->yScrollIncrement > 0) {
+ delta -= delta % canvasPtr->yScrollIncrement;
+ }
+ yOrigin += delta;
+ } else if ((bottom < 0) && (top > 0)) {
+ delta = (top > -bottom) ? -bottom : top;
+ if (canvasPtr->yScrollIncrement > 0) {
+ delta -= delta % canvasPtr->yScrollIncrement;
+ }
+ yOrigin -= delta;
+ }
+ }
+
+ if ((xOrigin == canvasPtr->xOrigin) && (yOrigin == canvasPtr->yOrigin)) {
+ return;
+ }
+
+ /*
+ * Tricky point: must redisplay not only everything that's visible
+ * in the window's final configuration, but also everything that was
+ * visible in the initial configuration. This is needed because some
+ * item types, like windows, need to know when they move off-screen
+ * so they can explicitly undisplay themselves.
+ */
+
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->xOrigin, canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+ canvasPtr->xOrigin = xOrigin;
+ canvasPtr->yOrigin = yOrigin;
+ canvasPtr->flags |= UPDATE_SCROLLBARS;
+ Tk_CanvasEventuallyRedraw((Tk_Canvas) canvasPtr,
+ canvasPtr->xOrigin, canvasPtr->yOrigin,
+ canvasPtr->xOrigin + Tk_Width(canvasPtr->tkwin),
+ canvasPtr->yOrigin + Tk_Height(canvasPtr->tkwin));
+}
diff --git a/tk/generic/tkCanvas.h b/tk/generic/tkCanvas.h
new file mode 100644
index 00000000000..3899225a5fd
--- /dev/null
+++ b/tk/generic/tkCanvas.h
@@ -0,0 +1,259 @@
+/*
+ * 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$
+ */
+
+#ifndef _TKCANVAS
+#define _TKCANVAS
+
+#ifndef _TK
+#include "tk.h"
+#endif
+
+/*
+ * The record below describes a canvas widget. It is made available
+ * to the item procedures so they can access certain shared fields such
+ * as the overall displacement and scale factor for the canvas.
+ */
+
+typedef struct TkCanvas {
+ Tk_Window tkwin; /* Window that embodies the canvas. 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, to release resources after
+ * tkwin has already gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with canvas. */
+ Tcl_Command widgetCmd; /* Token for canvas's widget command. */
+ Tk_Item *firstItemPtr; /* First in list of all items in canvas,
+ * or NULL if canvas empty. */
+ Tk_Item *lastItemPtr; /* Last in list of all items in canvas,
+ * or NULL if canvas empty. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ int borderWidth; /* Width of 3-D border around window. */
+ Tk_3DBorder bgBorder; /* Used for canvas background. */
+ 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. */
+ GC pixmapGC; /* Used to copy bits from a pixmap to the
+ * screen and also to clear the pixmap. */
+ int width, height; /* Dimensions to request for canvas window,
+ * specified in pixels. */
+ int redrawX1, redrawY1; /* Upper left corner of area to redraw,
+ * in pixel coordinates. Border pixels
+ * are included. Only valid if
+ * REDRAW_PENDING flag is set. */
+ int redrawX2, redrawY2; /* Lower right corner of area to redraw,
+ * in integer canvas coordinates. Border
+ * pixels will *not* be redrawn. */
+ int confine; /* Non-zero means constrain view to keep
+ * as much of canvas visible as possible. */
+
+ /*
+ * Information used to manage the selection and insertion cursor:
+ */
+
+ Tk_CanvasTextInfo textInfo; /* Contains lots of fields; see tk.h for
+ * details. This structure is shared with
+ * the code that implements individual items. */
+ int insertOnTime; /* Number of milliseconds cursor should spend
+ * in "on" state for each blink. */
+ int insertOffTime; /* Number of milliseconds cursor should spend
+ * in "off" state for each blink. */
+ Tcl_TimerToken insertBlinkHandler;
+ /* Timer handler used to blink cursor on and
+ * off. */
+
+ /*
+ * Transformation applied to canvas as a whole: to compute screen
+ * coordinates (X,Y) from canvas coordinates (x,y), do the following:
+ *
+ * X = x - xOrigin;
+ * Y = y - yOrigin;
+ */
+
+ int xOrigin, yOrigin; /* Canvas coordinates corresponding to
+ * upper-left corner of window, given in
+ * canvas pixel units. */
+ int drawableXOrigin, drawableYOrigin;
+ /* During redisplay, these fields give the
+ * canvas coordinates corresponding to
+ * the upper-left corner of the drawable
+ * where items are actually being drawn
+ * (typically a pixmap smaller than the
+ * whole window). */
+
+ /*
+ * Information used for event bindings associated with items.
+ */
+
+ Tk_BindingTable bindingTable;
+ /* Table of all bindings currently defined
+ * for this canvas. NULL means that no
+ * bindings exist, so the table hasn't been
+ * created. Each "object" used for this
+ * table is either a Tk_Uid for a tag or
+ * the address of an item named by id. */
+ Tk_Item *currentItemPtr; /* The item currently containing the mouse
+ * pointer, or NULL if none. */
+ Tk_Item *newCurrentPtr; /* The item that is about to become the
+ * current one, or NULL. This field is
+ * used to detect deletions of the new
+ * current item pointer that occur during
+ * Leave processing of the previous current
+ * item. */
+ double closeEnough; /* The mouse is assumed to be inside an
+ * item if it is this close to it. */
+ XEvent pickEvent; /* The event upon which the current choice
+ * of currentItem is based. Must be saved
+ * so that if the currentItem is deleted,
+ * can pick another. */
+ int state; /* Last known modifier state. Used to
+ * defer picking a new current object
+ * while buttons are down. */
+
+ /*
+ * Information used for managing scrollbars:
+ */
+
+ char *xScrollCmd; /* Command prefix for communicating with
+ * horizontal scrollbar. NULL means no
+ * horizontal scrollbar. Malloc'ed*/
+ char *yScrollCmd; /* Command prefix for communicating with
+ * vertical scrollbar. NULL means no
+ * vertical scrollbar. Malloc'ed*/
+ int scrollX1, scrollY1, scrollX2, scrollY2;
+ /* These four coordinates define the region
+ * that is the 100% area for scrolling (i.e.
+ * these numbers determine the size and
+ * location of the sliders on scrollbars).
+ * Units are pixels in canvas coords. */
+ char *regionString; /* The option string from which scrollX1
+ * etc. are derived. Malloc'ed. */
+ int xScrollIncrement; /* If >0, defines a grid for horizontal
+ * scrolling. This is the size of the "unit",
+ * and the left edge of the screen will always
+ * lie on an even unit boundary. */
+ int yScrollIncrement; /* If >0, defines a grid for horizontal
+ * scrolling. This is the size of the "unit",
+ * and the left edge of the screen will always
+ * lie on an even unit boundary. */
+
+ /*
+ * Information used for scanning:
+ */
+
+ int scanX; /* X-position at which scan started (e.g.
+ * button was pressed here). */
+ int scanXOrigin; /* Value of xOrigin field when scan started. */
+ int scanY; /* Y-position at which scan started (e.g.
+ * button was pressed here). */
+ int scanYOrigin; /* Value of yOrigin field when scan started. */
+
+ /*
+ * Information used to speed up searches by remembering the last item
+ * created or found with an item id search.
+ */
+
+ Tk_Item *hotPtr; /* Pointer to "hot" item (one that's been
+ * recently used. NULL means there's no
+ * hot item. */
+ Tk_Item *hotPrevPtr; /* Pointer to predecessor to hotPtr (NULL
+ * means item is first in list). This is
+ * only a hint and may not really be hotPtr's
+ * predecessor. */
+
+ /*
+ * 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. */
+ double pixelsPerMM; /* Scale factor between MM and pixels;
+ * used when converting coordinates. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+ 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
+ * canvas.
+ * REDRAW_BORDERS - 1 means that the borders need to be redrawn
+ * during the next redisplay operation.
+ * REPICK_NEEDED - 1 means DisplayCanvas should pick a new
+ * current item before redrawing the canvas.
+ * GOT_FOCUS - 1 means the focus is currently in this
+ * widget, so should draw the insertion cursor
+ * and traversal highlight.
+ * CURSOR_ON - 1 means the insertion cursor is in the "on"
+ * phase of its blink cycle. 0 means either
+ * we don't have the focus or the cursor is in
+ * the "off" phase of its cycle.
+ * UPDATE_SCROLLBARS - 1 means the scrollbars should get updated
+ * as part of the next display operation.
+ * LEFT_GRABBED_ITEM - 1 means that the mouse left the current
+ * item while a grab was in effect, so we
+ * didn't change canvasPtr->currentItemPtr.
+ * REPICK_IN_PROGRESS - 1 means PickCurrentItem is currently
+ * executing. If it should be called recursively,
+ * it should simply return immediately.
+ */
+
+#define REDRAW_PENDING 1
+#define REDRAW_BORDERS 2
+#define REPICK_NEEDED 4
+#define GOT_FOCUS 8
+#define CURSOR_ON 0x10
+#define UPDATE_SCROLLBARS 0x20
+#define LEFT_GRABBED_ITEM 0x40
+#define REPICK_IN_PROGRESS 0x100
+
+/*
+ * Canvas-related procedures that are shared among Tk modules but not
+ * exported to the outside world:
+ */
+
+extern int TkCanvPostscriptCmd _ANSI_ARGS_((TkCanvas *canvasPtr,
+ Tcl_Interp *interp, int argc, char **argv));
+
+#endif /* _TKCANVAS */
diff --git a/tk/generic/tkClipboard.c b/tk/generic/tkClipboard.c
new file mode 100644
index 00000000000..c50a80e7c8a
--- /dev/null
+++ b/tk/generic/tkClipboard.c
@@ -0,0 +1,606 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkSelect.h"
+
+/*
+ * Prototypes for procedures used only in this file:
+ */
+
+static int ClipboardAppHandler _ANSI_ARGS_((ClientData clientData,
+ int offset, char *buffer, int maxBytes));
+static int ClipboardHandler _ANSI_ARGS_((ClientData clientData,
+ int offset, char *buffer, int maxBytes));
+static int ClipboardWindowHandler _ANSI_ARGS_((
+ ClientData clientData, int offset, char *buffer,
+ int maxBytes));
+static void ClipboardLostSel _ANSI_ARGS_((ClientData clientData));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClipboardHandler --
+ *
+ * This procedure acts as selection handler for the
+ * clipboard manager. It extracts the required chunk of
+ * data from the buffer chain for a given selection target.
+ *
+ * Results:
+ * The return value is a count of the number of bytes
+ * actually stored at buffer.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClipboardHandler(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Information about data to fetch. */
+ int offset; /* Return selection bytes starting at this
+ * offset. */
+ char *buffer; /* Place to store converted selection. */
+ int maxBytes; /* Maximum # of bytes to store at buffer. */
+{
+ TkClipboardTarget *targetPtr = (TkClipboardTarget*) clientData;
+ TkClipboardBuffer *cbPtr;
+ char *srcPtr, *destPtr;
+ int count = 0;
+ int scanned = 0;
+ size_t length, freeCount;
+
+ /*
+ * Skip to buffer containing offset byte
+ */
+
+ for (cbPtr = targetPtr->firstBufferPtr; ; cbPtr = cbPtr->nextPtr) {
+ if (cbPtr == NULL) {
+ return 0;
+ }
+ if (scanned + cbPtr->length > offset) {
+ break;
+ }
+ scanned += cbPtr->length;
+ }
+
+ /*
+ * Copy up to maxBytes or end of list, switching buffers as needed.
+ */
+
+ freeCount = maxBytes;
+ srcPtr = cbPtr->buffer + (offset - scanned);
+ destPtr = buffer;
+ length = cbPtr->length - (offset - scanned);
+ while (1) {
+ if (length > freeCount) {
+ strncpy(destPtr, srcPtr, freeCount);
+ return maxBytes;
+ } else {
+ strncpy(destPtr, srcPtr, length);
+ destPtr += length;
+ count += length;
+ freeCount -= length;
+ }
+ cbPtr = cbPtr->nextPtr;
+ if (cbPtr == NULL) {
+ break;
+ }
+ srcPtr = cbPtr->buffer;
+ length = cbPtr->length;
+ }
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClipboardAppHandler --
+ *
+ * This procedure acts as selection handler for retrievals of type
+ * TK_APPLICATION. It returns the name of the application that
+ * owns the clipboard. Note: we can't use the default Tk
+ * selection handler for this selection type, because the clipboard
+ * window isn't a "real" window and doesn't have the necessary
+ * information.
+ *
+ * Results:
+ * The return value is a count of the number of bytes
+ * actually stored at buffer.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClipboardAppHandler(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Pointer to TkDisplay structure. */
+ int offset; /* Return selection bytes starting at this
+ * offset. */
+ char *buffer; /* Place to store converted selection. */
+ int maxBytes; /* Maximum # of bytes to store at buffer. */
+{
+ TkDisplay *dispPtr = (TkDisplay *) clientData;
+ size_t length;
+ char *p;
+
+ p = dispPtr->clipboardAppPtr->winPtr->nameUid;
+ length = strlen(p);
+ length -= offset;
+ if (length <= 0) {
+ return 0;
+ }
+ if (length > (size_t) maxBytes) {
+ length = maxBytes;
+ }
+ strncpy(buffer, p, length);
+ return length;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClipboardWindowHandler --
+ *
+ * This procedure acts as selection handler for retrievals of
+ * type TK_WINDOW. Since the clipboard doesn't correspond to
+ * any particular window, we just return ".". We can't use Tk's
+ * default handler for this selection type, because the clipboard
+ * window isn't a valid window.
+ *
+ * Results:
+ * The return value is 1, the number of non-null bytes stored
+ * at buffer.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ClipboardWindowHandler(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Not used. */
+ int offset; /* Return selection bytes starting at this
+ * offset. */
+ char *buffer; /* Place to store converted selection. */
+ int maxBytes; /* Maximum # of bytes to store at buffer. */
+{
+ buffer[0] = '.';
+ buffer[1] = 0;
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ClipboardLostSel --
+ *
+ * This procedure is invoked whenever clipboard ownership is
+ * claimed by another window. It just sets a flag so that we
+ * know the clipboard was taken away.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The clipboard is marked as inactive.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ClipboardLostSel(clientData)
+ ClientData clientData; /* Pointer to TkDisplay structure. */
+{
+ TkDisplay *dispPtr = (TkDisplay*) clientData;
+
+ dispPtr->clipboardActive = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ClipboardClear --
+ *
+ * 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
+ * calls. This procedure may cause a user-defined LostSel command
+ * to be invoked when the CLIPBOARD is claimed, so any calling
+ * function should be reentrant at the point Tk_ClipboardClear is
+ * invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ClipboardClear(interp, tkwin)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tk_Window tkwin; /* Window in application that is clearing
+ * clipboard; identifies application and
+ * display. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkClipboardTarget *targetPtr, *nextTargetPtr;
+ TkClipboardBuffer *cbPtr, *nextCbPtr;
+
+ if (dispPtr->clipWindow == NULL) {
+ int result;
+
+ result = TkClipInit(interp, dispPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+
+ /*
+ * Discard any existing clipboard data and delete the selection
+ * handler(s) associated with that data.
+ */
+
+ for (targetPtr = dispPtr->clipTargetPtr; targetPtr != NULL;
+ targetPtr = nextTargetPtr) {
+ for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL;
+ cbPtr = nextCbPtr) {
+ ckfree(cbPtr->buffer);
+ nextCbPtr = cbPtr->nextPtr;
+ ckfree((char *) cbPtr);
+ }
+ nextTargetPtr = targetPtr->nextPtr;
+ Tk_DeleteSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ targetPtr->type);
+ ckfree((char *) targetPtr);
+ }
+ dispPtr->clipTargetPtr = NULL;
+
+ /*
+ * Reclaim the clipboard selection if we lost it.
+ */
+
+ if (!dispPtr->clipboardActive) {
+ Tk_OwnSelection(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ ClipboardLostSel, (ClientData) dispPtr);
+ dispPtr->clipboardActive = 1;
+ }
+ dispPtr->clipboardAppPtr = winPtr->mainPtr;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ClipboardAppend --
+ *
+ * Append a buffer of data to the clipboard. The first buffer of
+ * a given type determines the format for that type. Any successive
+ * appends to that type must have the same format or an error will
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_ClipboardAppend(interp, tkwin, type, format, buffer)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Window tkwin; /* Window that selects a display. */
+ Atom type; /* The desired conversion type for this
+ * clipboard item, e.g. STRING or LENGTH. */
+ Atom format; /* Format in which the selection
+ * information should be returned to
+ * the requestor. */
+ char* buffer; /* NULL terminated string containing the data
+ * to be added to the clipboard. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkClipboardTarget *targetPtr;
+ TkClipboardBuffer *cbPtr;
+
+ /*
+ * If this application doesn't already own the clipboard, clear
+ * the clipboard. If we don't own the clipboard selection, claim it.
+ */
+
+ if (dispPtr->clipboardAppPtr != winPtr->mainPtr) {
+ Tk_ClipboardClear(interp, tkwin);
+ } else if (!dispPtr->clipboardActive) {
+ Tk_OwnSelection(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ ClipboardLostSel, (ClientData) dispPtr);
+ dispPtr->clipboardActive = 1;
+ }
+
+ /*
+ * Check to see if the specified target is already present on the
+ * clipboard. If it isn't, we need to create a new target; otherwise,
+ * we just append the new buffer to the clipboard list.
+ */
+
+ for (targetPtr = dispPtr->clipTargetPtr; targetPtr != NULL;
+ targetPtr = targetPtr->nextPtr) {
+ if (targetPtr->type == type)
+ break;
+ }
+ if (targetPtr == NULL) {
+ targetPtr = (TkClipboardTarget*) ckalloc(sizeof(TkClipboardTarget));
+ targetPtr->type = type;
+ targetPtr->format = format;
+ targetPtr->firstBufferPtr = targetPtr->lastBufferPtr = NULL;
+ targetPtr->nextPtr = dispPtr->clipTargetPtr;
+ dispPtr->clipTargetPtr = targetPtr;
+ Tk_CreateSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ type, ClipboardHandler, (ClientData) targetPtr, format);
+ } else if (targetPtr->format != format) {
+ Tcl_AppendResult(interp, "format \"", Tk_GetAtomName(tkwin, format),
+ "\" does not match current format \"",
+ Tk_GetAtomName(tkwin, targetPtr->format),"\" for ",
+ Tk_GetAtomName(tkwin, type), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Append a new buffer to the buffer chain.
+ */
+
+ cbPtr = (TkClipboardBuffer*) ckalloc(sizeof(TkClipboardBuffer));
+ cbPtr->nextPtr = NULL;
+ if (targetPtr->lastBufferPtr != NULL) {
+ targetPtr->lastBufferPtr->nextPtr = cbPtr;
+ } else {
+ targetPtr->firstBufferPtr = cbPtr;
+ }
+ targetPtr->lastBufferPtr = cbPtr;
+
+ cbPtr->length = strlen(buffer);
+ cbPtr->buffer = (char *) ckalloc((unsigned) (cbPtr->length + 1));
+ strcpy(cbPtr->buffer, buffer);
+
+ TkSelUpdateClipboard((TkWindow*)(dispPtr->clipWindow), targetPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ClipboardCmd --
+ *
+ * This procedure is invoked to process the "clipboard" 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_ClipboardCmd(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;
+ char *path = NULL;
+ size_t length;
+ int count;
+ char c;
+ 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 == 'a') && (strncmp(argv[1], "append", length) == 0)) {
+ Atom target, format;
+ char *targetName = NULL;
+ char *formatName = NULL;
+
+ for (count = argc-2, args = argv+2; count > 1; count -= 2, args += 2) {
+ if (args[0][0] != '-') {
+ break;
+ }
+ c = args[0][1];
+ length = strlen(args[0]);
+ if ((c == '-') && (length == 2)) {
+ args++;
+ count--;
+ break;
+ }
+ if ((c == 'd') && (strncmp(args[0], "-displayof", length) == 0)) {
+ path = args[1];
+ } else if ((c == 'f')
+ && (strncmp(args[0], "-format", length) == 0)) {
+ formatName = args[1];
+ } else if ((c == 't')
+ && (strncmp(args[0], "-type", length) == 0)) {
+ targetName = args[1];
+ } else {
+ Tcl_AppendResult(interp, "unknown option \"", args[0],
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (count != 1) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " append ?options? data\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (targetName != NULL) {
+ target = Tk_InternAtom(tkwin, targetName);
+ } else {
+ target = XA_STRING;
+ }
+ if (formatName != NULL) {
+ format = Tk_InternAtom(tkwin, formatName);
+ } else {
+ format = XA_STRING;
+ }
+ return Tk_ClipboardAppend(interp, tkwin, target, format, args[0]);
+ } else 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] != '-') {
+ break;
+ }
+ if (count < 2) {
+ Tcl_AppendResult(interp, "value for \"", *args,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = args[0][1];
+ length = strlen(args[0]);
+ if ((c == 'd') && (strncmp(args[0], "-displayof", length) == 0)) {
+ path = args[1];
+ } else {
+ Tcl_AppendResult(interp, "unknown option \"", args[0],
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (count > 0) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " clear ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (path != NULL) {
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkClipInit(interp, dispPtr)
+ Tcl_Interp *interp; /* Interpreter to use for error
+ * reporting. */
+ register TkDisplay *dispPtr;/* Display to initialize. */
+{
+ XSetWindowAttributes atts;
+
+ dispPtr->clipTargetPtr = NULL;
+ dispPtr->clipboardActive = 0;
+ dispPtr->clipboardAppPtr = NULL;
+
+ /*
+ * Create the window used for clipboard ownership and selection retrieval,
+ * and set up an event handler for it.
+ */
+
+ dispPtr->clipWindow = Tk_CreateWindow(interp, (Tk_Window) NULL,
+ "_clip", DisplayString(dispPtr->display));
+ if (dispPtr->clipWindow == NULL) {
+ return TCL_ERROR;
+ }
+ atts.override_redirect = True;
+ Tk_ChangeWindowAttributes(dispPtr->clipWindow, CWOverrideRedirect, &atts);
+ Tk_MakeWindowExist(dispPtr->clipWindow);
+
+ if (dispPtr->multipleAtom == None) {
+ /*
+ * Need to invoke selection initialization to make sure that
+ * atoms we depend on below are defined.
+ */
+
+ TkSelInit(dispPtr->clipWindow);
+ }
+
+ /*
+ * Create selection handlers for types TK_APPLICATION and TK_WINDOW
+ * on this window. Can't use the default handlers for these types
+ * because this isn't a full-fledged window.
+ */
+
+ Tk_CreateSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ dispPtr->applicationAtom, ClipboardAppHandler,
+ (ClientData) dispPtr, XA_STRING);
+ Tk_CreateSelHandler(dispPtr->clipWindow, dispPtr->clipboardAtom,
+ dispPtr->windowAtom, ClipboardWindowHandler,
+ (ClientData) dispPtr, XA_STRING);
+ return TCL_OK;
+}
diff --git a/tk/generic/tkCmds.c b/tk/generic/tkCmds.c
new file mode 100644
index 00000000000..b64c9809f03
--- /dev/null
+++ b/tk/generic/tkCmds.c
@@ -0,0 +1,1649 @@
+/*
+ * 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.
+ * 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$
+ */
+
+#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_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. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ int index;
+ char *string;
+ static char *optionStrings[] = {
+ "-displayof", NULL
+ };
+
+ if ((objc != 1) && (objc != 3)) {
+ Tcl_WrongNumArgs(interp, 1, objv, "?-displayof window?");
+ return TCL_ERROR;
+ }
+
+ if (objc == 3) {
+ if (Tcl_GetIndexFromObj(interp, objv[1], optionStrings, "option", 0,
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ XBell(Tk_Display(tkwin), 0);
+ XForceScreenSaver(Tk_Display(tkwin), ScreenSaverReset);
+ XFlush(Tk_Display(tkwin));
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_BindCmd --
+ *
+ * This procedure is invoked to process the "bind" 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_BindCmd(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;
+ ClientData object;
+
+ if ((argc < 2) || (argc > 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " window ?pattern? ?command?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argv[1][0] == '.') {
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ object = (ClientData) winPtr->pathName;
+ } else {
+ winPtr = (TkWindow *) clientData;
+ object = (ClientData) Tk_GetUid(argv[1]);
+ }
+
+ if (argc == 4) {
+ int append = 0;
+ unsigned long mask;
+
+ if (argv[3][0] == 0) {
+ return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable,
+ object, argv[2]);
+ }
+ if (argv[3][0] == '+') {
+ argv[3]++;
+ append = 1;
+ }
+ mask = Tk_CreateBinding(interp, winPtr->mainPtr->bindingTable,
+ object, argv[2], argv[3], append);
+ if (mask == 0) {
+ return TCL_ERROR;
+ }
+ } else if (argc == 3) {
+ char *command;
+
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBindEventProc --
+ *
+ * This procedure is invoked by Tk_HandleEvent for each event; it
+ * causes any appropriate bindings for that event to be invoked.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on what bindings have been established with the "bind"
+ * command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ }
+
+ objPtr = objects;
+ if (winPtr->numTags != 0) {
+ /*
+ * Make a copy of the tags for the window, replacing window names
+ * with pointers to the pathName from the appropriate window.
+ */
+
+ if (winPtr->numTags > MAX_OBJS) {
+ objPtr = (ClientData *) ckalloc((unsigned)
+ (winPtr->numTags * sizeof(ClientData)));
+ }
+ for (i = 0; i < winPtr->numTags; i++) {
+ p = (char *) winPtr->tagPtr[i];
+ if (*p == '.') {
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->nameTable, p);
+ if (hPtr != NULL) {
+ p = ((TkWindow *) Tcl_GetHashValue(hPtr))->pathName;
+ } else {
+ p = NULL;
+ }
+ }
+ objPtr[i] = (ClientData) p;
+ }
+ count = winPtr->numTags;
+ } else {
+ objPtr[0] = (ClientData) winPtr->pathName;
+ objPtr[1] = (ClientData) winPtr->classUid;
+ for (topLevPtr = winPtr;
+ (topLevPtr != NULL) && !(topLevPtr->flags & TK_TOP_LEVEL);
+ topLevPtr = topLevPtr->parentPtr) {
+ /* Empty loop body. */
+ }
+ 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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_BindtagsCmd --
+ *
+ * This procedure is invoked to process the "bindtags" 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_BindtagsCmd(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, *winPtr2;
+ int i, tagArgc;
+ char *p, **tagArgv;
+
+ if ((argc < 2) || (argc > 3)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " window ?tags?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (argc == 2) {
+ if (winPtr->numTags == 0) {
+ Tcl_AppendElement(interp, winPtr->pathName);
+ Tcl_AppendElement(interp, winPtr->classUid);
+ for (winPtr2 = winPtr;
+ (winPtr2 != NULL) && !(winPtr2->flags & TK_TOP_LEVEL);
+ winPtr2 = winPtr2->parentPtr) {
+ /* Empty loop body. */
+ }
+ if ((winPtr != winPtr2) && (winPtr2 != NULL)) {
+ Tcl_AppendElement(interp, winPtr2->pathName);
+ }
+ Tcl_AppendElement(interp, "all");
+ } else {
+ for (i = 0; i < winPtr->numTags; i++) {
+ Tcl_AppendElement(interp, (char *) winPtr->tagPtr[i]);
+ }
+ }
+ return TCL_OK;
+ }
+ if (winPtr->tagPtr != NULL) {
+ TkFreeBindingTags(winPtr);
+ }
+ if (argv[2][0] == 0) {
+ return TCL_OK;
+ }
+ if (Tcl_SplitList(interp, argv[2], &tagArgc, &tagArgv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ winPtr->numTags = tagArgc;
+ winPtr->tagPtr = (ClientData *) ckalloc((unsigned)
+ (tagArgc * sizeof(ClientData)));
+ for (i = 0; i < tagArgc; i++) {
+ p = tagArgv[i];
+ if (p[0] == '.') {
+ char *copy;
+
+ /*
+ * Handle names starting with "." specially: store a malloc'ed
+ * string, rather than a Uid; at event time we'll look up the
+ * name in the window table and use the corresponding window,
+ * if there is one.
+ */
+
+ copy = (char *) ckalloc((unsigned) (strlen(p) + 1));
+ strcpy(copy, p);
+ winPtr->tagPtr[i] = (ClientData) copy;
+ } else {
+ winPtr->tagPtr[i] = (ClientData) Tk_GetUid(p);
+ }
+ }
+ ckfree((char *) tagArgv);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFreeBindingTags --
+ *
+ * This procedure is called to free all of the binding tags
+ * associated with a window; typically it is only invoked where
+ * there are window-specific tags.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Any binding tags for winPtr are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFreeBindingTags(winPtr)
+ TkWindow *winPtr; /* Window whose tags are to be released. */
+{
+ int i;
+ char *p;
+
+ for (i = 0; i < winPtr->numTags; i++) {
+ p = (char *) (winPtr->tagPtr[i]);
+ if (*p == '.') {
+ /*
+ * Names starting with "." are malloced rather than Uids, so
+ * they have to be freed.
+ */
+
+ ckfree(p);
+ }
+ }
+ ckfree((char *) winPtr->tagPtr);
+ winPtr->numTags = 0;
+ winPtr->tagPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DestroyCmd --
+ *
+ * This procedure is invoked to process the "destroy" 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_DestroyCmd(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 window;
+ Tk_Window tkwin = (Tk_Window) clientData;
+ int i;
+
+ for (i = 1; i < argc; i++) {
+ window = Tk_NameToWindow(interp, argv[i], tkwin);
+ if (window == NULL) {
+ Tcl_ResetResult(interp);
+ continue;
+ }
+ Tk_DestroyWindow(window);
+ if (window == tkwin) {
+ /*
+ * We just deleted the main window for the application! This
+ * makes it impossible to do anything more (tkwin isn't
+ * valid anymore).
+ */
+
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_LowerCmd --
+ *
+ * This procedure is invoked to process the "lower" 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_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);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_RaiseCmd --
+ *
+ * This procedure is invoked to process the "raise" 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_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);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_TkObjCmd --
+ *
+ * This procedure is invoked to process the "tk" 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_TkObjCmd(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;
+ static char *optionStrings[] = {
+ "appname", "scaling", NULL
+ };
+ enum options {
+ TK_APPNAME, TK_SCALING
+ };
+
+ tkwin = (Tk_Window) clientData;
+
+ 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 TK_APPNAME: {
+ TkWindow *winPtr;
+ char *string;
+
+ winPtr = (TkWindow *) tkwin;
+
+ if (objc > 3) {
+ 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;
+
+ screenPtr = Tk_Screen(tkwin);
+
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip == 2) {
+ d = 25.4 / 72;
+ d *= WidthOfScreen(screenPtr);
+ d /= WidthMMOfScreen(screenPtr);
+ Tcl_SetDoubleObj(Tcl_GetObjResult(interp), d);
+ } else if (objc - skip == 3) {
+ if (Tcl_GetDoubleFromObj(interp, objv[2 + skip], &d) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ d = (25.4 / 72) / d;
+ width = (int) (d * WidthOfScreen(screenPtr) + 0.5);
+ if (width <= 0) {
+ width = 1;
+ }
+ height = (int) (d * HeightOfScreen(screenPtr) + 0.5);
+ if (height <= 0) {
+ height = 1;
+ }
+ WidthMMOfScreen(screenPtr) = width;
+ HeightMMOfScreen(screenPtr) = height;
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-displayof window? ?factor?");
+ return TCL_ERROR;
+ }
+ break;
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_TkwaitCmd --
+ *
+ * This procedure is invoked to process the "tkwait" 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_TkwaitCmd(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;
+ int c, done;
+ size_t length;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " variable|visibility|window name\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'v') && (strncmp(argv[1], "variable", length) == 0)
+ && (length >= 2)) {
+ if (Tcl_TraceVar(interp, argv[2],
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ WaitVariableProc, (ClientData) &done) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ done = 0;
+ while (!done) {
+ Tcl_DoOneEvent(0);
+ }
+ Tcl_UntraceVar(interp, argv[2],
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ WaitVariableProc, (ClientData) &done);
+ } else if ((c == 'v') && (strncmp(argv[1], "visibility", length) == 0)
+ && (length >= 2)) {
+ Tk_Window window;
+
+ window = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (window == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_CreateEventHandler(window, VisibilityChangeMask|StructureNotifyMask,
+ WaitVisibilityProc, (ClientData) &done);
+ done = 0;
+ while (!done) {
+ Tcl_DoOneEvent(0);
+ }
+ if (done != 1) {
+ /*
+ * Note that we do not delete the event handler because it
+ * was deleted automatically when the window was destroyed.
+ */
+
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "window \"", argv[2],
+ "\" was deleted before its visibility changed",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tk_DeleteEventHandler(window, VisibilityChangeMask|StructureNotifyMask,
+ WaitVisibilityProc, (ClientData) &done);
+ } else if ((c == 'w') && (strncmp(argv[1], "window", length) == 0)) {
+ Tk_Window window;
+
+ window = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (window == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_CreateEventHandler(window, StructureNotifyMask,
+ WaitWindowProc, (ClientData) &done);
+ done = 0;
+ while (!done) {
+ Tcl_DoOneEvent(0);
+ }
+ /*
+ * Note: there's no need to delete the event handler. It was
+ * deleted automatically when the window was destroyed.
+ */
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be variable, visibility, or window", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Clear out the interpreter's result, since it may have been set
+ * by event handlers.
+ */
+
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+
+ /* ARGSUSED */
+static char *
+WaitVariableProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Pointer to integer to set to 1. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ char *name1; /* Name of variable. */
+ char *name2; /* Second part of variable name. */
+ int flags; /* Information about what happened. */
+{
+ int *donePtr = (int *) clientData;
+
+ *donePtr = 1;
+ return (char *) NULL;
+}
+
+ /*ARGSUSED*/
+static void
+WaitVisibilityProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to integer to set to 1. */
+ XEvent *eventPtr; /* Information about event (not used). */
+{
+ int *donePtr = (int *) clientData;
+
+ if (eventPtr->type == VisibilityNotify) {
+ *donePtr = 1;
+ }
+ if (eventPtr->type == DestroyNotify) {
+ *donePtr = 2;
+ }
+}
+
+static void
+WaitWindowProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to integer to set to 1. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ int *donePtr = (int *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ *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;
+ }
+ }
+
+ /*
+ * Must clear the interpreter's result because event handlers could
+ * have executed commands.
+ */
+
+ Tcl_ResetResult(interp);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_WinfoObjCmd --
+ *
+ * This procedure is invoked to process the "winfo" 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_WinfoObjCmd(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, 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"},
+ {StaticGray, "staticgray"},
+ {-1, NULL}
+ };
+ static char *optionStrings[] = {
+ "cells", "children", "class", "colormapfull",
+ "depth", "geometry", "height", "id",
+ "ismapped", "manager", "name", "parent",
+ "pointerx", "pointery", "pointerxy", "reqheight",
+ "reqwidth", "rootx", "rooty", "screen",
+ "screencells", "screendepth", "screenheight", "screenwidth",
+ "screenmmheight","screenmmwidth","screenvisual","server",
+ "toplevel", "viewable", "visual", "visualid",
+ "vrootheight", "vrootwidth", "vrootx", "vrooty",
+ "width", "x", "y",
+
+ "atom", "atomname", "containing", "interps",
+ "pathname",
+
+ "exists", "fpixels", "pixels", "rgb",
+ "visualsavailable",
+
+ NULL
+ };
+ enum options {
+ WIN_CELLS, WIN_CHILDREN, WIN_CLASS, WIN_COLORMAPFULL,
+ WIN_DEPTH, WIN_GEOMETRY, WIN_HEIGHT, WIN_ID,
+ WIN_ISMAPPED, WIN_MANAGER, WIN_NAME, WIN_PARENT,
+ WIN_POINTERX, WIN_POINTERY, WIN_POINTERXY, WIN_REQHEIGHT,
+ WIN_REQWIDTH, WIN_ROOTX, WIN_ROOTY, WIN_SCREEN,
+ WIN_SCREENCELLS,WIN_SCREENDEPTH,WIN_SCREENHEIGHT,WIN_SCREENWIDTH,
+ WIN_SCREENMMHEIGHT,WIN_SCREENMMWIDTH,WIN_SCREENVISUAL,WIN_SERVER,
+ WIN_TOPLEVEL, WIN_VIEWABLE, WIN_VISUAL, WIN_VISUALID,
+ WIN_VROOTHEIGHT,WIN_VROOTWIDTH, WIN_VROOTX, WIN_VROOTY,
+ WIN_WIDTH, WIN_X, WIN_Y,
+
+ WIN_ATOM, WIN_ATOMNAME, WIN_CONTAINING, WIN_INTERPS,
+ WIN_PATHNAME,
+
+ WIN_EXISTS, WIN_FPIXELS, WIN_PIXELS, WIN_RGB,
+ WIN_VISUALSAVAILABLE
+ };
+
+ tkwin = (Tk_Window) clientData;
+
+ 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;
+ }
+
+ if (index < WIN_ATOM) {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "window");
+ return TCL_ERROR;
+ }
+ 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;
+ }
+ case WIN_POINTERY: {
+ useX = 0;
+ useY = 1;
+ goto pointerxy;
+ }
+ case WIN_POINTERXY: {
+ useX = 1;
+ useY = 1;
+
+ pointerxy:
+ 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;
+ }
+ if (objc - skip != 4) {
+ Tcl_WrongNumArgs(interp, 2, objv,
+ "?-displayof window? rootX rootY");
+ return TCL_ERROR;
+ }
+ objv += skip;
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ if (Tk_GetPixels(interp, tkwin, string, &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ 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);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
+ return TCL_ERROR;
+ }
+ result = TkGetInterpNames(interp, tkwin);
+ return result;
+ }
+ case WIN_PATHNAME: {
+ int 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;
+ }
+ string = Tcl_GetStringFromObj(objv[2 + skip], NULL);
+ 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;
+ } else {
+ Tcl_WrongNumArgs(interp, 2, objv, "window ?includeids?");
+ return TCL_ERROR;
+ }
+
+ string = Tcl_GetStringFromObj(objv[2], NULL);
+ tkwin = Tk_NameToWindow(interp, string, tkwin);
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetDisplayOf --
+ *
+ * Parses a "-displayof window" option for various commands. If
+ * present, the literal "-displayof" should be in objv[0] and the
+ * window name in objv[1].
+ *
+ * Results:
+ * The return value is 0 if the argument strings did not contain
+ * the "-displayof" option. The return value is 2 if the
+ * argument strings contained both the "-displayof" option and
+ * a valid window name. Otherwise, the return value is -1 if
+ * the window name was missing or did not specify a valid window.
+ *
+ * If the return value was 2, *tkwinPtr is filled with the
+ * token for the window specified on the command line. If the
+ * return value was -1, an error message is left in interp's
+ * result object.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkGetDisplayOf(interp, objc, objv, tkwinPtr)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ int objc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. If it is present,
+ * "-displayof" should be in objv[0] and
+ * objv[1] the name of a window. */
+ Tk_Window *tkwinPtr; /* On input, contains main window of
+ * application associated with interp. On
+ * output, filled with window specified as
+ * option to "-displayof" argument, or
+ * unmodified if "-displayof" argument was not
+ * present. */
+{
+ char *string;
+ int length;
+
+ if (objc < 1) {
+ return 0;
+ }
+ string = Tcl_GetStringFromObj(objv[0], &length);
+ if ((length >= 2) && (strncmp(string, "-displayof", (unsigned) length) == 0)) {
+ if (objc < 2) {
+ Tcl_SetStringObj(Tcl_GetObjResult(interp),
+ "value for \"-displayof\" missing", -1);
+ return -1;
+ }
+ string = Tcl_GetStringFromObj(objv[1], NULL);
+ *tkwinPtr = Tk_NameToWindow(interp, string, *tkwinPtr);
+ if (*tkwinPtr == NULL) {
+ return -1;
+ }
+ return 2;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDeadAppCmd --
+ *
+ * If an application has been deleted then all Tk commands will be
+ * re-bound to this procedure.
+ *
+ * Results:
+ * A standard Tcl error is reported to let the user know that
+ * the application is dead.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TkDeadAppCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Dummy. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ Tcl_AppendResult(interp, "can't invoke \"", argv[0],
+ "\" command: application has been destroyed", (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetToplevel --
+ *
+ * Retrieves the toplevel window which is the nearest ancestor of
+ * of the specified window.
+ *
+ * Results:
+ * Returns the toplevel window or NULL if the window has no
+ * ancestor which is a toplevel.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkWindow *
+GetToplevel(tkwin)
+ Tk_Window tkwin; /* Window for which the toplevel should be
+ * deterined. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+
+ while (!(winPtr->flags & TK_TOP_LEVEL)) {
+ winPtr = winPtr->parentPtr;
+ if (winPtr == NULL) {
+ return NULL;
+ }
+ }
+ return winPtr;
+}
diff --git a/tk/generic/tkColor.c b/tk/generic/tkColor.c
new file mode 100644
index 00000000000..c5844781015
--- /dev/null
+++ b/tk/generic/tkColor.c
@@ -0,0 +1,524 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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));
+
+/* CYGNUS LOCAL. */
+
+/* A linked list of GC structures. */
+
+struct TkGCList {
+ /* Next item on list. */
+ TkGCList *next;
+ /* The display for the GC. */
+ Display *display;
+ /* The GC. */
+ GC gc;
+ /* GCForeground or GCBackground. */
+ unsigned long mask;
+};
+
+/* END CYGNUS LOCAL */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ tkColPtr->gcList = NULL;
+ Tcl_SetHashValue(nameHashPtr, tkColPtr);
+
+ return &tkColPtr->color;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetColorByValue --
+ *
+ * Given a desired set of red-green-blue intensities for a color,
+ * locate a pixel value to use to draw that color in a given
+ * window.
+ *
+ * Results:
+ * The return value is a pointer to an XColor structure that
+ * indicates the closest red, blue, and green intensities available
+ * to those specified in colorPtr, and also specifies a pixel
+ * value to use to draw in that color.
+ *
+ * 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_GetColorByValue(tkwin, colorPtr)
+ Tk_Window tkwin; /* Window where color will be used. */
+ XColor *colorPtr; /* Red, green, and blue fields indicate
+ * 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;
+ tkColPtr->gcList = NULL;
+ Tcl_SetHashValue(valueHashPtr, tkColPtr);
+ return &tkColPtr->color;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfColor --
+ *
+ * Given a color, return a textual string identifying
+ * the color.
+ *
+ * Results:
+ * If colorPtr was created by Tk_GetColor, then the return
+ * value is the "string" that was used to create it.
+ * Otherwise the return value is a string that could have
+ * been passed to Tk_GetColor to allocate that color. The
+ * storage for the returned string is only guaranteed to
+ * persist up until the next call to this procedure.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+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 --
+ *
+ * Given a color allocated from this module, this procedure
+ * returns a GC that can be used for simple drawing with that
+ * color.
+ *
+ * Results:
+ * The return value is a GC with color set as its foreground
+ * color and all other fields defaulted. This GC is only valid
+ * as long as the color exists; it is freed automatically when
+ * the last reference to the color is freed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+GC
+Tk_GCForColor(colorPtr, drawable)
+ XColor *colorPtr; /* Color for which a GC is desired. Must
+ * have been allocated by Tk_GetColor or
+ * Tk_GetColorByName. */
+ Drawable drawable; /* Drawable in which the color will be
+ * used (must have same screen and depth
+ * as the one for which the color was
+ * allocated). */
+{
+ TkColor *tkColPtr = (TkColor *) colorPtr;
+ XGCValues gcValues;
+
+ /*
+ * Do a quick sanity check to make sure this color was really
+ * allocated by Tk_GetColor.
+ */
+
+ if (tkColPtr->magic != COLOR_MAGIC) {
+ panic("Tk_GCForColor called with bogus color");
+ }
+
+ if (tkColPtr->gc == None) {
+ gcValues.foreground = tkColPtr->color.pixel;
+ tkColPtr->gc = XCreateGC(DisplayOfScreen(tkColPtr->screen),
+ drawable, GCForeground, &gcValues);
+ }
+ return tkColPtr->gc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeColor --
+ *
+ * This procedure is called to release a color allocated by
+ * Tk_GetColor.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with colorPtr is deleted, and
+ * the color is released to X if there are no remaining uses
+ * for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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));
+}
+
+/* CYGNUS LOCAL: Call a function on every named color. This is used
+ on Windows to change the colors when the user changes them via the
+ control panel. */
+
+void
+TkMapOverColors(func)
+ void (*func) _ANSI_ARGS_((TkColor *));
+{
+ Tcl_HashEntry *nameHashPtr;
+ Tcl_HashSearch search;
+ TkColor *tkColPtr;
+
+ nameHashPtr = Tcl_FirstHashEntry(&nameTable, &search);
+ while (nameHashPtr != NULL) {
+ tkColPtr = (TkColor *) Tcl_GetHashValue(nameHashPtr);
+ (*func)(tkColPtr);
+ nameHashPtr = Tcl_NextHashEntry(&search);
+ }
+}
+
+/* CYGNUS LOCAL: For each color, we keep a list of GCs that use that
+ color as the foreground or background. This is so that we can
+ change them on Windows when the user changes the system colors. */
+
+void
+TkRegisterColorGC(colorPtr, display, gc, valueMask)
+ XColor *colorPtr;
+ Display *display;
+ GC gc;
+ unsigned long valueMask;
+{
+ TkColor *tkColPtr = (TkColor *) colorPtr;
+ TkGCList *gcListPtr;
+
+ if (tkColPtr->magic != COLOR_MAGIC) {
+ return;
+ }
+
+ gcListPtr = (TkGCList *) ckalloc(sizeof(TkGCList));
+ gcListPtr->display = display;
+ gcListPtr->gc = gc;
+ gcListPtr->mask = valueMask;
+ gcListPtr->next = tkColPtr->gcList;
+ tkColPtr->gcList = gcListPtr;
+
+ /* Each GC added to the list counts as a reference to the color,
+ so that we don't free the color before freeing the GC. */
+
+ tkColPtr->refCount++;
+}
+
+/* This is called when a GC with a registered color is deleted. */
+
+void
+TkDeregisterColorGC(colorPtr, gc, valueMask)
+ XColor *colorPtr;
+ GC gc;
+ unsigned long valueMask;
+{
+ TkColor *tkColPtr = (TkColor *) colorPtr;
+ TkGCList **gcListPtrPtr, *gcListPtr;
+
+ if (tkColPtr->magic != COLOR_MAGIC) {
+ return;
+ }
+
+ for (gcListPtrPtr = &tkColPtr->gcList;
+ *gcListPtrPtr != NULL;
+ gcListPtrPtr = &(*gcListPtrPtr)->next) {
+ if ((*gcListPtrPtr)->gc == gc && (*gcListPtrPtr)->mask == valueMask) {
+ gcListPtr = *gcListPtrPtr;
+ *gcListPtrPtr = gcListPtr->next;
+ ckfree((char *) gcListPtr);
+ Tk_FreeColor((XColor *) tkColPtr);
+ break;
+ }
+ }
+}
+
+/* This is called when a color is changed by the user on Windows. */
+
+void
+TkColorChanged(tkColPtr)
+ TkColor *tkColPtr;
+{
+ TkGCList *gcListPtr;
+ XGCValues gcValues;
+
+ for (gcListPtr = tkColPtr->gcList;
+ gcListPtr != NULL;
+ gcListPtr = gcListPtr->next) {
+ if (gcListPtr->mask == GCForeground) {
+ gcValues.foreground = tkColPtr->color.pixel;
+ } else {
+ gcValues.background = tkColPtr->color.pixel;
+ }
+
+ XChangeGC(gcListPtr->display, gcListPtr->gc, gcListPtr->mask,
+ &gcValues);
+ }
+
+ if (tkColPtr->gc != None) {
+ gcValues.foreground = tkColPtr->color.pixel;
+ XChangeGC(DisplayOfScreen(tkColPtr->screen), tkColPtr->gc,
+ GCForeground, &gcValues);
+ }
+}
diff --git a/tk/generic/tkColor.h b/tk/generic/tkColor.h
new file mode 100644
index 00000000000..8a72d7eb9e3
--- /dev/null
+++ b/tk/generic/tkColor.h
@@ -0,0 +1,77 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#ifndef _TKCOLOR
+#define _TKCOLOR
+
+#include <tkInt.h>
+
+#ifdef BUILD_tk
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/* CYGNUS LOCAL. */
+typedef struct TkGCList TkGCList;
+
+/*
+ * 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). */
+ /* CYGNUS LOCAL */
+ TkGCList *gcList; /* List of GCs which use this color. */
+} 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));
+
+/* CYGNUS LOCAL. */
+EXTERN void TkMapOverColors _ANSI_ARGS_((void (*) (TkColor *)));
+EXTERN void TkColorChanged _ANSI_ARGS_((TkColor *));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKCOLOR */
diff --git a/tk/generic/tkConfig.c b/tk/generic/tkConfig.c
new file mode 100644
index 00000000000..4efac5e9089
--- /dev/null
+++ b/tk/generic/tkConfig.c
@@ -0,0 +1,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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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;
+ }
+ }
+ }
+}
diff --git a/tk/generic/tkConsole.c b/tk/generic/tkConsole.c
new file mode 100644
index 00000000000..2294368e1ca
--- /dev/null
+++ b/tk/generic/tkConsole.c
@@ -0,0 +1,616 @@
+/*
+ * 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$
+ */
+
+#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));
+static void ConsoleEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int InterpreterCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+static int ConsoleInput _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toRead, int *errorCode));
+static int ConsoleOutput _ANSI_ARGS_((ClientData instanceData,
+ char *buf, int toWrite, int *errorCode));
+static int ConsoleClose _ANSI_ARGS_((ClientData instanceData,
+ Tcl_Interp *interp));
+static void ConsoleWatch _ANSI_ARGS_((ClientData instanceData,
+ int mask));
+static int ConsoleHandle _ANSI_ARGS_((ClientData instanceData,
+ int direction, ClientData *handlePtr));
+
+/*
+ * This structure describes the channel type structure for file based IO:
+ */
+
+static Tcl_ChannelType consoleChannelType = {
+ "console", /* Type name. */
+ NULL, /* Always non-blocking.*/
+ ConsoleClose, /* Close proc. */
+ ConsoleInput, /* Input proc. */
+ ConsoleOutput, /* Output proc. */
+ NULL, /* Seek proc. */
+ NULL, /* Set option proc. */
+ NULL, /* Get option proc. */
+ 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 --
+ *
+ * Initialize the console. This code actually creates a new
+ * application and associated interpreter. This effectivly hides
+ * the implementation from the main application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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();
+ if (consoleInterp == NULL) {
+ goto error;
+ }
+
+ /*
+ * Initialized Tcl and Tk.
+ */
+
+ 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;
+ Tcl_CreateCommand(interp, "console", ConsoleCmd, (ClientData) info,
+ (Tcl_CmdDeleteProc *) ConsoleDeleteProc);
+ Tcl_CreateCommand(consoleInterp, "consoleinterp", InterpreterCmd,
+ (ClientData) info, (Tcl_CmdDeleteProc *) NULL);
+
+ Tk_CreateEventHandler(mainWindow, StructureNotifyMask, ConsoleEventProc,
+ (ClientData) info);
+
+ Tcl_Preserve((ClientData) consoleInterp);
+ if (Tcl_Eval(consoleInterp, initCmd) == TCL_ERROR) {
+ /* goto error; -- no problem for now... */
+ printf("Eval error: %s", consoleInterp->result);
+ }
+ Tcl_Release((ClientData) consoleInterp);
+ return TCL_OK;
+
+ error:
+ if (consoleInterp != NULL) {
+ Tcl_DeleteInterp(consoleInterp);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleOutput--
+ *
+ * Writes the given output on the IO channel. Returns count of how
+ * many characters were actually written, and an error indication.
+ *
+ * Results:
+ * A count of how many characters were written is returned and an
+ * error indication is returned in an output argument.
+ *
+ * Side effects:
+ * Writes output on the actual channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleInput --
+ *
+ * Read input from the console. Not currently implemented.
+ *
+ * Results:
+ * Always returns EOF.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleInput(instanceData, buf, bufSize, errorCode)
+ ClientData instanceData; /* Unused. */
+ char *buf; /* Where to store data read. */
+ int bufSize; /* How much space is available
+ * in the buffer? */
+ int *errorCode; /* Where to store error code. */
+{
+ return 0; /* Always return EOF. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleClose --
+ *
+ * Closes the IO channel.
+ *
+ * Results:
+ * Always returns 0 (success).
+ *
+ * Side effects:
+ * Frees the dummy file associated with the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleClose(instanceData, interp)
+ ClientData instanceData; /* Unused. */
+ Tcl_Interp *interp; /* Unused. */
+{
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleWatch --
+ *
+ * Called by the notifier to set up the console device so that
+ * events will be noticed. Since there are no events on the
+ * console, this routine just returns without doing anything.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ConsoleWatch(instanceData, mask)
+ ClientData instanceData; /* Device ID for the channel. */
+ int mask; /* OR-ed combination of
+ * TCL_READABLE, TCL_WRITABLE and
+ * TCL_EXCEPTION, for the events
+ * we are interested in. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleHandle --
+ *
+ * Invoked by the generic IO layer to get a handle from a channel.
+ * Because console channels are not devices, this function always
+ * fails.
+ *
+ * Results:
+ * Always returns TCL_ERROR.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ConsoleHandle(instanceData, direction, handlePtr)
+ ClientData instanceData; /* Device ID for the channel. */
+ int direction; /* TCL_READABLE or TCL_WRITABLE to indicate
+ * which direction of the channel is being
+ * requested. */
+ ClientData *handlePtr; /* Where to store handle */
+{
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleCmd --
+ *
+ * The console command implements a Tcl interface to the various console
+ * options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConsoleCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InterpreterCmd --
+ *
+ * This command allows the console interp to communicate with the
+ * main interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InterpreterCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Not used. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+ char c;
+ int length;
+ int result;
+ Tcl_Interp *otherInterp;
+
+ 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]);
+ otherInterp = info->interp;
+ 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;
+ }
+ Tcl_Release((ClientData) otherInterp);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleDeleteProc --
+ *
+ * If the console command is deleted we destroy the console window
+ * and all associated data structures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new console it created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+ConsoleDeleteProc(clientData)
+ ClientData clientData;
+{
+ ConsoleInfo *info = (ConsoleInfo *) clientData;
+
+ Tcl_DeleteInterp(info->consoleInterp);
+ info->consoleInterp = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConsoleEventProc --
+ *
+ * This event procedure is registered on the main window of the
+ * slave interpreter. If the user or a running script causes the
+ * main window to be destroyed, then we need to inform the console
+ * interpreter by invoking "tkConsoleExit".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Invokes the "tkConsoleExit" procedure in the console interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkConsolePrint --
+ *
+ * Prints to the give text to the console. Given the main interp
+ * this functions find the appropiate console interp and forwards
+ * the text to be added to that console.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkConsolePrint(interp, devId, buffer, size)
+ Tcl_Interp *interp; /* Main interpreter. */
+ int devId; /* TCL_STDOUT for stdout, TCL_STDERR for
+ * stderr. */
+ char *buffer; /* Text buffer. */
+ long size; /* Size of text buffer. */
+{
+ Tcl_DString command, output;
+ Tcl_CmdInfo cmdInfo;
+ char *cmd;
+ ConsoleInfo *info;
+ Tcl_Interp *consoleInterp;
+ int result;
+
+ if (interp == NULL) {
+ return;
+ }
+
+ if (devId == TCL_STDERR) {
+ cmd = "tkConsoleOutput stderr ";
+ } else {
+ cmd = "tkConsoleOutput stdout ";
+ }
+
+ result = Tcl_GetCommandInfo(interp, "console", &cmdInfo);
+ if (result == 0) {
+ return;
+ }
+ info = (ConsoleInfo *) cmdInfo.clientData;
+
+ Tcl_DStringInit(&output);
+ Tcl_DStringAppend(&output, buffer, size);
+
+ Tcl_DStringInit(&command);
+ Tcl_DStringAppend(&command, cmd, strlen(cmd));
+ Tcl_DStringAppendElement(&command, output.string);
+
+ consoleInterp = info->consoleInterp;
+ Tcl_Preserve((ClientData) consoleInterp);
+ Tcl_Eval(consoleInterp, command.string);
+ Tcl_Release((ClientData) consoleInterp);
+
+ Tcl_DStringFree(&command);
+ Tcl_DStringFree(&output);
+}
diff --git a/tk/generic/tkCursor.c b/tk/generic/tkCursor.c
new file mode 100644
index 00000000000..31d2d1ca736
--- /dev/null
+++ b/tk/generic/tkCursor.c
@@ -0,0 +1,384 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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
+ * to Tk_FreeCursor, so that the database can be cleaned up when cursors
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Cursor
+Tk_GetCursorFromData(interp, tkwin, source, mask, width, height,
+ xHot, yHot, fg, bg)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tk_Window tkwin; /* Window in which cursor will be used. */
+ char *source; /* Bitmap data for cursor shape. */
+ 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.
+ */
+
+ if (XParseColor(dataKey.display, Tk_Colormap(tkwin), fg, &fgColor) == 0) {
+ Tcl_AppendResult(interp, "invalid color name \"", fg, "\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (XParseColor(dataKey.display, Tk_Colormap(tkwin), bg, &bgColor) == 0) {
+ Tcl_AppendResult(interp, "invalid color name \"", bg, "\"",
+ (char *) NULL);
+ goto error;
+ }
+
+ 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfCursor --
+ *
+ * Given a cursor, return a textual string identifying it.
+ *
+ * Results:
+ * If cursor was created by Tk_GetCursor, then the return
+ * value is the "string" that was used to create it.
+ * Otherwise the return value is a string giving the X
+ * identifier for the cursor. The storage for the returned
+ * string is only guaranteed to persist up until the next
+ * call to this procedure.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+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 --
+ *
+ * This procedure is called to release a cursor allocated by
+ * Tk_GetCursor or TkGetCursorFromData.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with cursor is decremented, and
+ * it is officially deallocated if no-one is using it anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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));
+}
diff --git a/tk/generic/tkEntry.c b/tk/generic/tkEntry.c
new file mode 100644
index 00000000000..86da2fd92e2
--- /dev/null
+++ b/tk/generic/tkEntry.c
@@ -0,0 +1,2318 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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. */
+ int borderWidth; /* Width of 3-D border around window. */
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ int exportSelection; /* Non-zero means tie internal entry selection
+ * to X selection. */
+ Tk_Font tkfont; /* Information about text font, or NULL. */
+ XColor *fgColorPtr; /* Text color in normal mode. */
+ XColor *highlightBgColorPtr;/* Color for drawing traversal highlight
+ * area when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ 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 insertBorder; /* Used to draw vertical bar for insertion
+ * cursor. */
+ int insertBorderWidth; /* Width of 3-D border around insert cursor. */
+ int insertOffTime; /* Number of milliseconds cursor should spend
+ * in "off" state for each blink. */
+ int insertOnTime; /* Number of milliseconds cursor should spend
+ * in "on" state for each blink. */
+ int insertWidth; /* Total width of insert cursor. */
+ Tk_Justify justify; /* Justification to use for text within
+ * window. */
+ int relief; /* 3-D effect: TK_RELIEF_RAISED, etc. */
+ 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. */
+ int flags; /* Miscellaneous flags; see below for
+ * definitions. */
+} Entry;
+
+/*
+ * Assigned bits of "flags" fields of Entry structures, and what those
+ * bits mean:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler has
+ * already been queued to redisplay the entry.
+ * BORDER_NEEDED: Non-zero means 3-D border must be redrawn
+ * around window during redisplay. Normally
+ * only text portion needs to be redrawn.
+ * CURSOR_ON: Non-zero means insert cursor is displayed at
+ * present. 0 means it isn't displayed.
+ * GOT_FOCUS: Non-zero means this window has the input
+ * focus.
+ * UPDATE_SCROLLBAR: Non-zero means scrollbar should be updated
+ * during next redisplay operation.
+ * GOT_SELECTION: Non-zero means we've claimed the selection.
+ */
+
+#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));
+static void EntryComputeGeometry _ANSI_ARGS_((Entry *entryPtr));
+static void EntryEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void EntryFocusProc _ANSI_ARGS_ ((Entry *entryPtr,
+ int gotFocus));
+static int EntryFetchSelection _ANSI_ARGS_((ClientData clientData,
+ int offset, char *buffer, int maxBytes));
+static void EntryLostSelection _ANSI_ARGS_((
+ ClientData clientData));
+static void EventuallyRedraw _ANSI_ARGS_((Entry *entryPtr));
+static void EntryScanTo _ANSI_ARGS_((Entry *entryPtr, int y));
+static void EntrySetValue _ANSI_ARGS_((Entry *entryPtr,
+ char *value));
+static void EntrySelectTo _ANSI_ARGS_((
+ Entry *entryPtr, int index));
+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));
+
+/*
+ * The structure below defines entry class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static TkClassProcs entryClass = {
+ NULL, /* createProc. */
+ EntryWorldChanged, /* geometryProc. */
+ 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;
+ entryPtr->scanMarkIndex = 0;
+
+ entryPtr->normalBorder = NULL;
+ entryPtr->borderWidth = 0;
+ entryPtr->cursor = None;
+ entryPtr->exportSelection = 1;
+ entryPtr->tkfont = NULL;
+ entryPtr->fgColorPtr = NULL;
+ entryPtr->highlightBgColorPtr = NULL;
+ entryPtr->highlightColorPtr = NULL;
+ entryPtr->highlightWidth = 0;
+ entryPtr->insertBorder = NULL;
+ entryPtr->insertBorderWidth = 0;
+ entryPtr->insertOffTime = 0;
+ entryPtr->insertOnTime = 0;
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyEntry --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of an entry at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the entry is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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.
+ */
+
+ if (entryPtr->textVarName != NULL) {
+ char *value;
+
+ value = Tcl_GetVar(interp, entryPtr->textVarName, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ EntryValueChanged(entryPtr);
+ } else {
+ 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 --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Entry will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+EntryWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC gc;
+ unsigned long mask;
+ Entry *entryPtr;
+
+ entryPtr = (Entry *) instanceData;
+
+ entryPtr->avgWidth = Tk_TextWidth(entryPtr->tkfont, "0", 1);
+ if (entryPtr->avgWidth == 0) {
+ entryPtr->avgWidth = 1;
+ }
+
+ gcValues.foreground = entryPtr->fgColorPtr->pixel;
+ gcValues.font = Tk_FontId(entryPtr->tkfont);
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCFont | GCGraphicsExposures;
+ gc = Tk_GetGCColor(entryPtr->tkwin, mask, &gcValues, entryPtr->fgColorPtr,
+ NULL);
+ if (entryPtr->textGC != None) {
+ Tk_FreeGC(entryPtr->display, entryPtr->textGC);
+ }
+ entryPtr->textGC = gc;
+
+ gcValues.foreground = entryPtr->selFgColorPtr->pixel;
+ gcValues.font = Tk_FontId(entryPtr->tkfont);
+ mask = GCForeground | GCFont;
+ gc = Tk_GetGCColor(entryPtr->tkwin, mask, &gcValues,
+ entryPtr->selFgColorPtr, NULL);
+ if (entryPtr->selTextGC != None) {
+ Tk_FreeGC(entryPtr->display, entryPtr->selTextGC);
+ }
+ entryPtr->selTextGC = gc;
+
+ /*
+ * Recompute the window's geometry and arrange for it to be
+ * redisplayed.
+ */
+
+ EntryComputeGeometry(entryPtr);
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EventuallyRedraw(entryPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayEntry --
+ *
+ * This procedure redraws the contents of an entry window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+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);
+
+ /*
+ * Update the scrollbar if that's needed.
+ */
+
+ if (entryPtr->flags & UPDATE_SCROLLBAR) {
+ entryPtr->flags &= ~UPDATE_SCROLLBAR;
+ EntryUpdateScrollbar(entryPtr);
+ }
+
+ /*
+ * In order to avoid screen flashes, this procedure redraws the
+ * textual area of the entry into off-screen memory, then copies
+ * it back on-screen in a single operation. This means there's
+ * no point in time where the on-screen image has been cleared.
+ */
+
+ pixmap = Tk_GetPixmap(entryPtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+
+ /*
+ * Compute x-coordinate of the pixel just after last visible
+ * one, plus vertical position of baseline of text.
+ */
+
+ xBound = Tk_Width(tkwin) - entryPtr->inset;
+ baseY = (Tk_Height(tkwin) + fm.ascent - fm.descent) / 2;
+
+ /*
+ * On Windows and Mac, we need to hide the selection whenever we
+ * don't have the focus.
+ */
+
+#ifdef ALWAYS_SHOW_SELECTION
+ showSelection = 1;
+#else
+ showSelection = (entryPtr->flags & GOT_FOCUS);
+#endif
+
+ /*
+ * 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) {
+ int idx = entryPtr->numChars >= 1 ? entryPtr->numChars - 1 : 0;
+ Tk_CharBbox(entryPtr->textLayout, idx,
+ &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);
+ } else {
+ gc = Tk_GCForColor(entryPtr->highlightBgColorPtr, pixmap);
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, entryPtr->highlightWidth, pixmap);
+ }
+
+ /*
+ * Everything's been redisplayed; now copy the pixmap onto the screen
+ * and free up the pixmap.
+ */
+
+ XCopyArea(entryPtr->display, pixmap, Tk_WindowId(tkwin), entryPtr->textGC,
+ 0, 0, (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin),
+ 0, 0);
+ Tk_FreePixmap(entryPtr->display, pixmap);
+ entryPtr->flags &= ~BORDER_NEEDED;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryComputeGeometry --
+ *
+ * This procedure is invoked to recompute information about where
+ * in its window an entry's string will be displayed. It also
+ * computes the requested size for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The leftX and tabOrigin fields are recomputed for entryPtr,
+ * and leftIndex may be adjusted. Tk_GeometryRequest is called
+ * 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
+ * window unless the entire window is full.
+ */
+
+ overflow = totalLength - (Tk_Width(entryPtr->tkwin) - 2*entryPtr->inset);
+ if (overflow <= 0) {
+ entryPtr->leftIndex = 0;
+ if (entryPtr->justify == TK_JUSTIFY_LEFT) {
+ entryPtr->leftX = entryPtr->inset;
+ } else if (entryPtr->justify == TK_JUSTIFY_RIGHT) {
+ entryPtr->leftX = Tk_Width(entryPtr->tkwin) - entryPtr->inset
+ - totalLength;
+ } else {
+ entryPtr->leftX = (Tk_Width(entryPtr->tkwin) - totalLength)/2;
+ }
+ entryPtr->layoutX = entryPtr->leftX;
+ } else {
+ /*
+ * The whole string can't fit in the window. Compute the
+ * maximum number of characters that may be off-screen to
+ * the left without leaving empty space on the right of the
+ * 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) {
+ width = entryPtr->prefWidth*entryPtr->avgWidth + 2*entryPtr->inset;
+ } else {
+ if (totalLength == 0) {
+ width = entryPtr->avgWidth + 2*entryPtr->inset;
+ } else {
+ width = totalLength + 2*entryPtr->inset;
+ }
+ }
+ Tk_GeometryRequest(entryPtr->tkwin, width, height);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InsertChars --
+ *
+ * Add new characters to an entry widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteChars --
+ *
+ * Remove one or more characters from an entry widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory gets freed, the entry gets modified and (eventually)
+ * 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryValueChanged --
+ *
+ * This procedure is invoked when characters are inserted into
+ * an entry or deleted from it. It updates the entry's associated
+ * variable, if there is one, and does other bookkeeping such
+ * as arranging for redisplay.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EntryValueChanged(entryPtr)
+ Entry *entryPtr; /* Entry whose value just changed. */
+{
+ char *newValue;
+
+ if (entryPtr->textVarName == NULL) {
+ newValue = NULL;
+ } else {
+ newValue = Tcl_SetVar(entryPtr->interp, entryPtr->textVarName,
+ entryPtr->string, TCL_GLOBAL_ONLY);
+ }
+
+ if ((newValue != NULL) && (strcmp(newValue, entryPtr->string) != 0)) {
+ /*
+ * The value of the variable is different than what we asked for.
+ * This means that a trace on the variable modified it. In this
+ * case our trace procedure wasn't invoked since the modification
+ * came while a trace was already active on the variable. So,
+ * update our value to reflect the variable's latest value.
+ */
+
+ EntrySetValue(entryPtr, newValue);
+ } else {
+ /*
+ * Arrange for redisplay.
+ */
+
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntrySetValue --
+ *
+ * Replace the contents of a text entry with a given value. This
+ * procedure is invoked when updating the entry from the entry's
+ * associated variable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The string displayed in the entry will change. The selection,
+ * insertion point, and view may have to be adjusted to keep them
+ * within the bounds of the new string. Note: this procedure does
+ * *not* update the entry's associated variable, since that could
+ * 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;
+ }
+
+ entryPtr->flags |= UPDATE_SCROLLBAR;
+ EntryComputeGeometry(entryPtr);
+ EventuallyRedraw(entryPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EntryEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on entryes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EntryEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ 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) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ EntryFocusProc(entryPtr, 1);
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ EntryFocusProc(entryPtr, 0);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryCmdDeletedProc --
+ *
+ * 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
+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;
+ }
+ } else if (string[0] == 'e') {
+ if (strncmp(string, "end", length) == 0) {
+ *indexPtr = entryPtr->numChars;
+ } else {
+ goto badIndex;
+ }
+ } 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)) {
+ x = Tk_Width(entryPtr->tkwin) - entryPtr->inset - 1;
+ roundUp = 1;
+ }
+ *indexPtr = Tk_PointToChar(entryPtr->textLayout,
+ x - entryPtr->layoutX, 0);
+
+ /*
+ * Special trick: if the x-position was off-screen to the right,
+ * round the index up to refer to the character just after the
+ * last visible one on the screen. This is needed to enable the
+ * last character to be selected, for example.
+ */
+
+ if (roundUp && (*indexPtr < entryPtr->numChars)) {
+ *indexPtr += 1;
+ }
+ } else {
+ if (Tcl_GetInt(interp, string, indexPtr) != TCL_OK) {
+ goto badIndex;
+ }
+ if (*indexPtr < 0){
+ *indexPtr = 0;
+ } else if (*indexPtr > entryPtr->numChars) {
+ *indexPtr = entryPtr->numChars;
+ }
+ }
+ if(*indexPtr > entryPtr->numChars)
+ *indexPtr = entryPtr->numChars;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryScanTo --
+ *
+ * Given a y-coordinate (presumably of the curent mouse location)
+ * drag the view in the window to implement the scan operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * 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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntrySelectTo --
+ *
+ * Modify the selection by moving its un-anchored end. This could
+ * make the selection either larger or smaller.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * 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.
+ */
+
+ if (!(entryPtr->flags & GOT_SELECTION) && (entryPtr->exportSelection)) {
+ Tk_OwnSelection(entryPtr->tkwin, XA_PRIMARY, EntryLostSelection,
+ (ClientData) entryPtr);
+ entryPtr->flags |= GOT_SELECTION;
+ }
+
+ /*
+ * Pick new starting and ending points for the selection.
+ */
+
+ if (entryPtr->selectAnchor > entryPtr->numChars) {
+ entryPtr->selectAnchor = entryPtr->numChars;
+ }
+ if (entryPtr->selectAnchor <= index) {
+ newFirst = entryPtr->selectAnchor;
+ newLast = index;
+ } else {
+ newFirst = index;
+ newLast = entryPtr->selectAnchor;
+ if (newLast < 0) {
+ newFirst = newLast = -1;
+ }
+ }
+ if ((entryPtr->selectFirst == newFirst)
+ && (entryPtr->selectLast == newLast)) {
+ return;
+ }
+ entryPtr->selectFirst = newFirst;
+ entryPtr->selectLast = newLast;
+ EventuallyRedraw(entryPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryFetchSelection --
+ *
+ * This procedure is called back by Tk when the selection is
+ * requested by someone. It returns part or all of the selection
+ * in a buffer provided by the caller.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored
+ * at buffer. Buffer is filled (or partially filled) with a
+ * NULL-terminated string containing part or all of the selection,
+ * as given by offset and maxBytes.
+ *
+ * Side effects:
+ * 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 --
+ *
+ * This procedure is called back by Tk when the selection is
+ * grabbed away from an entry widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The existing selection is unhighlighted, and the window is
+ * 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
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EventuallyRedraw --
+ *
+ * Ensure that an entry is eventually redrawn on the display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets redisplayed. Right now we don't do selective
+ * redisplays: the whole window will be redrawn. This doesn't
+ * seem to hurt performance noticeably, but if it does then this
+ * 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
+ * will be redrawn. This doesn't seem to hurt performance noticeably,
+ * but if it does then this could be changed.
+ */
+
+ if (!(entryPtr->flags & REDRAW_PENDING)) {
+ entryPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayEntry, (ClientData) entryPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryVisibleRange --
+ *
+ * Return information about the range of the entry that is
+ * currently visible.
+ *
+ * Results:
+ * *firstPtr and *lastPtr are modified to hold fractions between
+ * 0 and 1 identifying the range of characters visible in the
+ * entry.
+ *
+ * Side effects:
+ * 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 --
+ *
+ * This procedure is invoked whenever information has changed in
+ * an entry in a way that would invalidate a scrollbar display.
+ * If there is an associated scrollbar, then this procedure updates
+ * it by invoking a Tcl command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Tcl command is invoked, and an additional command may be
+ * invoked to process errors in the command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ }
+
+ interp = entryPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ EntryVisibleRange(entryPtr, &first, &last);
+ sprintf(args, " %g %g", first, last);
+ code = Tcl_VarEval(interp, entryPtr->scrollCmd, args, (char *) NULL);
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (horizontal scrolling command executed by entry)");
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ Tcl_Release((ClientData) interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryBlinkProc --
+ *
+ * This procedure is called as a timer handler to blink the
+ * insertion cursor off and on.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor gets turned on or off, redisplay gets invoked,
+ * and this procedure reschedules itself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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(
+ entryPtr->insertOffTime, EntryBlinkProc, (ClientData) entryPtr);
+ } else {
+ entryPtr->flags |= CURSOR_ON;
+ entryPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ entryPtr->insertOnTime, EntryBlinkProc, (ClientData) entryPtr);
+ }
+ EventuallyRedraw(entryPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EntryFocusProc --
+ *
+ * This procedure is called whenever the entry gets or loses the
+ * input focus. It's also called whenever the window is reconfigured
+ * while it has the focus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * 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) {
+ entryPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ entryPtr->insertOnTime, EntryBlinkProc,
+ (ClientData) entryPtr);
+ }
+ } else {
+ entryPtr->flags &= ~(GOT_FOCUS | CURSOR_ON);
+ entryPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ }
+ EventuallyRedraw(entryPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EntryTextVarProc --
+ *
+ * This procedure is invoked when someone changes the variable
+ * whose contents are to be displayed in an entry.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The text displayed in the entry will change to match the
+ * variable.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+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.
+ */
+
+ if (flags & TCL_TRACE_UNSETS) {
+ if ((flags & TCL_TRACE_DESTROYED) && !(flags & TCL_INTERP_DESTROYED)) {
+ Tcl_SetVar(interp, entryPtr->textVarName, entryPtr->string,
+ TCL_GLOBAL_ONLY);
+ Tcl_TraceVar(interp, entryPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ EntryTextVarProc, clientData);
+ }
+ return (char *) NULL;
+ }
+
+ /*
+ * Update the entry's text with the value of the variable, unless
+ * the entry already has that value (this happens when the variable
+ * changes value because we changed it because someone typed in
+ * the entry).
+ */
+
+ value = Tcl_GetVar(interp, entryPtr->textVarName, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ value = "";
+ }
+ if (strcmp(value, entryPtr->string) != 0) {
+ EntrySetValue(entryPtr, value);
+ }
+ return (char *) NULL;
+}
diff --git a/tk/generic/tkError.c b/tk/generic/tkError.c
new file mode 100644
index 00000000000..77909331a6f
--- /dev/null
+++ b/tk/generic/tkError.c
@@ -0,0 +1,307 @@
+/*
+ * tkError.c --
+ *
+ * This file provides a high-performance mechanism for
+ * selectively dealing with errors that occur in talking
+ * to the X server. This is useful, for example, when
+ * communicating with a window that may not exist.
+ *
+ * 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$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The default X error handler gets saved here, so that it can
+ * be invoked if an error occurs that we can't handle.
+ */
+
+static int (*defaultHandler) _ANSI_ARGS_((Display *display,
+ XErrorEvent *eventPtr)) = NULL;
+
+
+/*
+ * Forward references to procedures declared later in this file:
+ */
+
+static int ErrorProc _ANSI_ARGS_((Display *display,
+ XErrorEvent *errEventPtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateErrorHandler --
+ *
+ * Arrange for all a given procedure to be invoked whenever
+ * certain errors occur.
+ *
+ * Results:
+ * The return value is a token identifying the handler;
+ * it must be passed to Tk_DeleteErrorHandler to delete the
+ * handler.
+ *
+ * Side effects:
+ * If an X error occurs that matches the error, request,
+ * and minor arguments, then errorProc will be invoked.
+ * ErrorProc should have the following structure:
+ *
+ * int
+ * errorProc(clientData, errorEventPtr)
+ * caddr_t clientData;
+ * XErrorEvent *errorEventPtr;
+ * {
+ * }
+ *
+ * The clientData argument will be the same as the clientData
+ * argument to this procedure, and errorEvent will describe
+ * the error. If errorProc returns 0, it means that it
+ * completely "handled" the error: no further processing
+ * should be done. If errorProc returns 1, it means that it
+ * didn't know how to deal with the error, so we should look
+ * for other error handlers, or invoke the default error
+ * handler if no other handler returns zero. Handlers are
+ * invoked in order of age: youngest handler first.
+ *
+ * Note: errorProc will only be called for errors associated
+ * with X requests made AFTER this call, but BEFORE the handler
+ * is deleted by calling Tk_DeleteErrorHandler.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_ErrorHandler
+Tk_CreateErrorHandler(display, error, request, minorCode, errorProc, clientData)
+ Display *display; /* Display for which to handle
+ * errors. */
+ int error; /* Consider only errors with this
+ * error_code (-1 means consider
+ * all errors). */
+ int request; /* Consider only errors with this
+ * major request code (-1 means
+ * consider all major codes). */
+ int minorCode; /* Consider only errors with this
+ * minor request code (-1 means
+ * consider all minor codes). */
+ Tk_ErrorProc *errorProc; /* Procedure to invoke when a
+ * matching error occurs. NULL means
+ * just ignore matching errors. */
+ ClientData clientData; /* Arbitrary value to pass to
+ * errorProc. */
+{
+ register TkErrorHandler *errorPtr;
+ register TkDisplay *dispPtr;
+
+ /*
+ * Find the display. If Tk doesn't know about this display then
+ * it's an error: panic.
+ */
+
+ dispPtr = TkGetDisplay(display);
+ if (dispPtr == NULL) {
+ panic("Unknown display passed to Tk_CreateErrorHandler");
+ }
+
+ /*
+ * Make sure that X calls us whenever errors occur.
+ */
+
+ if (defaultHandler == NULL) {
+ defaultHandler = XSetErrorHandler(ErrorProc);
+ }
+
+ /*
+ * Create the handler record.
+ */
+
+ errorPtr = (TkErrorHandler *) ckalloc(sizeof(TkErrorHandler));
+ errorPtr->dispPtr = dispPtr;
+ errorPtr->firstRequest = NextRequest(display);
+ errorPtr->lastRequest = (unsigned) -1;
+ errorPtr->error = error;
+ errorPtr->request = request;
+ errorPtr->minorCode = minorCode;
+ errorPtr->errorProc = errorProc;
+ errorPtr->clientData = clientData;
+ errorPtr->nextPtr = dispPtr->errorPtr;
+ dispPtr->errorPtr = errorPtr;
+
+ return (Tk_ErrorHandler) errorPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteErrorHandler --
+ *
+ * Do not use an error handler anymore.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The handler denoted by the "handler" argument will not
+ * be invoked for any X errors associated with requests
+ * made after this call. However, if errors arrive later
+ * for requests made BEFORE this call, then the handler
+ * will still be invoked. Call XSync if you want to be
+ * sure that all outstanding errors have been received
+ * and processed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteErrorHandler(handler)
+ Tk_ErrorHandler handler; /* Token for handler to delete;
+ * was previous return value from
+ * Tk_CreateErrorHandler. */
+{
+ register TkErrorHandler *errorPtr = (TkErrorHandler *) handler;
+ register TkDisplay *dispPtr = errorPtr->dispPtr;
+
+ errorPtr->lastRequest = NextRequest(dispPtr->display) - 1;
+
+ /*
+ * Every once-in-a-while, cleanup handlers that are no longer
+ * active. We probably won't be able to free the handler that
+ * was just deleted (need to wait for any outstanding requests to
+ * be processed by server), but there may be previously-deleted
+ * handlers that are now ready for garbage collection. To reduce
+ * the cost of the cleanup, let a few dead handlers pile up, then
+ * clean them all at once. This adds a bit of overhead to errors
+ * that might occur while the dead handlers are hanging around,
+ * but reduces the overhead of scanning the list to clean up
+ * (particularly if there are many handlers that stay around
+ * forever).
+ */
+
+ dispPtr->deleteCount += 1;
+ if (dispPtr->deleteCount >= 10) {
+ register TkErrorHandler *prevPtr;
+ TkErrorHandler *nextPtr;
+ int lastSerial;
+
+ dispPtr->deleteCount = 0;
+ lastSerial = LastKnownRequestProcessed(dispPtr->display);
+ errorPtr = dispPtr->errorPtr;
+ for (prevPtr = NULL; errorPtr != NULL; errorPtr = nextPtr) {
+ nextPtr = errorPtr->nextPtr;
+ if ((errorPtr->lastRequest != (unsigned long) -1)
+ && (errorPtr->lastRequest <= (unsigned long) lastSerial)) {
+ if (prevPtr == NULL) {
+ dispPtr->errorPtr = nextPtr;
+ } else {
+ prevPtr->nextPtr = nextPtr;
+ }
+ ckfree((char *) errorPtr);
+ continue;
+ }
+ prevPtr = errorPtr;
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ErrorProc --
+ *
+ * This procedure is invoked by the X system when error
+ * events arrive.
+ *
+ * Results:
+ * If it returns, the return value is zero. However,
+ * it is possible that one of the error handlers may
+ * just exit.
+ *
+ * Side effects:
+ * This procedure does two things. First, it uses the
+ * serial # in the error event to eliminate handlers whose
+ * expiration serials are now in the past. Second, it
+ * invokes any handlers that want to deal with the error.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ErrorProc(display, errEventPtr)
+ Display *display; /* Display for which error
+ * occurred. */
+ register XErrorEvent *errEventPtr; /* Information about error. */
+{
+ register TkDisplay *dispPtr;
+ register TkErrorHandler *errorPtr;
+
+ /*
+ * See if we know anything about the display. If not, then
+ * invoke the default error handler.
+ */
+
+ dispPtr = TkGetDisplay(display);
+ if (dispPtr == NULL) {
+ goto couldntHandle;
+ }
+
+ /*
+ * Otherwise invoke any relevant handlers for the error, in order.
+ */
+
+ for (errorPtr = dispPtr->errorPtr; errorPtr != NULL;
+ errorPtr = errorPtr->nextPtr) {
+ if ((errorPtr->firstRequest > errEventPtr->serial)
+ || ((errorPtr->error != -1)
+ && (errorPtr->error != errEventPtr->error_code))
+ || ((errorPtr->request != -1)
+ && (errorPtr->request != errEventPtr->request_code))
+ || ((errorPtr->minorCode != -1)
+ && (errorPtr->minorCode != errEventPtr->minor_code))
+ || ((errorPtr->lastRequest != (unsigned long) -1)
+ && (errorPtr->lastRequest < errEventPtr->serial))) {
+ continue;
+ }
+ if (errorPtr->errorProc == NULL) {
+ return 0;
+ } else {
+ if ((*errorPtr->errorProc)(errorPtr->clientData,
+ errEventPtr) == 0) {
+ return 0;
+ }
+ }
+ }
+
+ /*
+ * See if the error is a BadWindow error. If so, and it refers
+ * to a window that still exists in our window table, then ignore
+ * the error. Errors like this can occur if a window owned by us
+ * is deleted by someone externally, like a window manager. We'll
+ * ignore the errors at least long enough to clean up internally and
+ * remove the entry from the window table.
+ *
+ * NOTE: For embedding, we must also check whether the window was
+ * recently deleted. If so, it may be that Tk generated operations on
+ * windows that were deleted by the container. Now we are getting
+ * the errors (BadWindow) after Tk already deleted the window itself.
+ */
+
+ if ((errEventPtr->error_code == BadWindow) &&
+ ((Tk_IdToWindow(display, (Window) errEventPtr->resourceid) !=
+ NULL) ||
+ (TkpWindowWasRecentlyDeleted((Window) errEventPtr->resourceid,
+ dispPtr)))) {
+ return 0;
+ }
+
+ /*
+ * We couldn't handle the error. Use the default handler.
+ */
+
+ couldntHandle:
+ return (*defaultHandler)(display, errEventPtr);
+}
diff --git a/tk/generic/tkEvent.c b/tk/generic/tkEvent.c
new file mode 100644
index 00000000000..2d10dccc69c
--- /dev/null
+++ b/tk/generic/tkEvent.c
@@ -0,0 +1,1043 @@
+/*
+ * 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$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+#include <signal.h>
+
+/*
+ * There's a potential problem if a handler is deleted while it's
+ * current (i.e. its procedure is executing), since Tk_HandleEvent
+ * will need to read the handler's "nextPtr" field when the procedure
+ * returns. To handle this problem, structures of the type below
+ * indicate the next handler to be processed for any (recursively
+ * nested) dispatches in progress. The nextHandler fields get
+ * updated if the handlers pointed to are deleted. Tk_HandleEvent
+ * also needs to know if the entire window gets deleted; the winPtr
+ * field is set to zero if that particular window gets deleted.
+ */
+
+typedef struct InProgress {
+ XEvent *eventPtr; /* Event currently being handled. */
+ 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. */
+ XEvent event; /* The X event. */
+} TkWindowEvent;
+
+/*
+ * Array of event masks corresponding to each X event:
+ */
+
+static unsigned long eventMasks[TK_LASTEVENT] = {
+ 0,
+ 0,
+ KeyPressMask, /* KeyPress */
+ KeyReleaseMask, /* KeyRelease */
+ ButtonPressMask, /* ButtonPress */
+ ButtonReleaseMask, /* ButtonRelease */
+ PointerMotionMask|PointerMotionHintMask|ButtonMotionMask
+ |Button1MotionMask|Button2MotionMask|Button3MotionMask
+ |Button4MotionMask|Button5MotionMask,
+ /* MotionNotify */
+ EnterWindowMask, /* EnterNotify */
+ LeaveWindowMask, /* LeaveNotify */
+ FocusChangeMask, /* FocusIn */
+ FocusChangeMask, /* FocusOut */
+ KeymapStateMask, /* KeymapNotify */
+ ExposureMask, /* Expose */
+ ExposureMask, /* GraphicsExpose */
+ ExposureMask, /* NoExpose */
+ VisibilityChangeMask, /* VisibilityNotify */
+ SubstructureNotifyMask, /* CreateNotify */
+ StructureNotifyMask, /* DestroyNotify */
+ StructureNotifyMask, /* UnmapNotify */
+ StructureNotifyMask, /* MapNotify */
+ SubstructureRedirectMask, /* MapRequest */
+ StructureNotifyMask, /* ReparentNotify */
+ StructureNotifyMask, /* ConfigureNotify */
+ SubstructureRedirectMask, /* ConfigureRequest */
+ StructureNotifyMask, /* GravityNotify */
+ ResizeRedirectMask, /* ResizeRequest */
+ StructureNotifyMask, /* CirculateNotify */
+ SubstructureRedirectMask, /* CirculateRequest */
+ PropertyChangeMask, /* PropertyNotify */
+ 0, /* SelectionClear */
+ 0, /* SelectionRequest */
+ 0, /* SelectionNotify */
+ ColormapChangeMask, /* ColormapNotify */
+ 0, /* ClientMessage */
+ 0, /* Mapping Notify */
+ VirtualEventMask, /* VirtualEvents */
+ ActivateMask, /* ActivateNotify */
+ ActivateMask, /* DeactivateNotify */
+ MouseWheelMask /* MouseWheelEvent */
+};
+
+/*
+ * 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));
+static int WindowEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+ int flags));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateEventHandler --
+ *
+ * Arrange for a given procedure to be invoked whenever
+ * events from a given class occur in a given window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * From now on, whenever an event of the type given by
+ * mask occurs for token and is processed by Tk_HandleEvent,
+ * proc will be called. See the manual entry for details
+ * of the calling sequence and return value for proc.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CreateEventHandler(token, mask, proc, clientData)
+ Tk_Window token; /* Token for window in which to
+ * create handler. */
+ unsigned long mask; /* Events for which proc should
+ * be called. */
+ Tk_EventProc *proc; /* Procedure to call for each
+ * selected event */
+ ClientData clientData; /* Arbitrary data to pass to proc. */
+{
+ register TkEventHandler *handlerPtr;
+ register TkWindow *winPtr = (TkWindow *) token;
+ int found;
+
+ /*
+ * Skim through the list of existing handlers to (a) compute the
+ * overall event mask for the window (so we can pass this new
+ * value to the X system) and (b) see if there's already a handler
+ * declared with the same callback and clientData (if so, just
+ * change the mask). If no existing handler matches, then create
+ * a new handler.
+ */
+
+ found = 0;
+ if (winPtr->handlerList == NULL) {
+ handlerPtr = (TkEventHandler *) ckalloc(
+ (unsigned) sizeof(TkEventHandler));
+ winPtr->handlerList = handlerPtr;
+ goto initHandler;
+ } else {
+ for (handlerPtr = winPtr->handlerList; ;
+ handlerPtr = handlerPtr->nextPtr) {
+ if ((handlerPtr->proc == proc)
+ && (handlerPtr->clientData == clientData)) {
+ handlerPtr->mask = mask;
+ found = 1;
+ }
+ if (handlerPtr->nextPtr == NULL) {
+ break;
+ }
+ }
+ }
+
+ /*
+ * Create a new handler if no matching old handler was found.
+ */
+
+ if (!found) {
+ handlerPtr->nextPtr = (TkEventHandler *)
+ ckalloc(sizeof(TkEventHandler));
+ handlerPtr = handlerPtr->nextPtr;
+ initHandler:
+ handlerPtr->mask = mask;
+ handlerPtr->proc = proc;
+ handlerPtr->clientData = clientData;
+ handlerPtr->nextPtr = NULL;
+ }
+
+ /*
+ * No need to call XSelectInput: Tk always selects on all events
+ * for all windows (needed to support bindings on classes and "all").
+ */
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DeleteEventHandler --
+ *
+ * Delete a previously-created handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there existed a handler as described by the
+ * parameters, the handler is deleted so that proc
+ * will not be invoked again.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_DeleteEventHandler(token, mask, proc, clientData)
+ Tk_Window token; /* Same as corresponding arguments passed */
+ unsigned long mask; /* previously to Tk_CreateEventHandler. */
+ 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; ;
+ prevPtr = handlerPtr, handlerPtr = handlerPtr->nextPtr) {
+ if (handlerPtr == NULL) {
+ return;
+ }
+ if ((handlerPtr->mask == mask) && (handlerPtr->proc == proc)
+ && (handlerPtr->clientData == clientData)) {
+ break;
+ }
+ }
+
+ /*
+ * 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.
+ */
+
+ if (prevPtr == NULL) {
+ winPtr->handlerList = handlerPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = handlerPtr->nextPtr;
+ }
+ ckfree((char *) handlerPtr);
+
+
+ /*
+ * No need to call XSelectInput: Tk always selects on all events
+ * for all windows (needed to support bindings on classes and "all").
+ */
+}
+
+/*--------------------------------------------------------------
+ *
+ * Tk_CreateGenericHandler --
+ *
+ * Register a procedure to be called on each X event, regardless
+ * of display or window. Generic handlers are useful for capturing
+ * events that aren't associated with windows, or events for windows
+ * not managed by Tk.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * From now on, whenever an X event is given to Tk_HandleEvent,
+ * invoke proc, giving it clientData and the event as arguments.
+ *
+ *--------------------------------------------------------------
+ */
+
+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 --
+ *
+ * Delete a previously-created generic handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side Effects:
+ * If there existed a handler as described by the parameters,
+ * that handler is logically deleted so that proc will not be
+ * invoked again. The physical deletion happens in the event
+ * loop in Tk_HandleEvent.
+ *
+ *--------------------------------------------------------------
+ */
+
+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
+ * been registered for the event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the handlers.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_HandleEvent(eventPtr)
+ XEvent *eventPtr; /* Event to dispatch. */
+{
+ register TkEventHandler *handlerPtr;
+ register GenericHandler *genericPtr;
+ 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;
+ }
+
+ /*
+ * If the event is a MappingNotify event, find its display and
+ * refresh the keyboard mapping information for the display.
+ * After that there's nothing else to do with the event, so just
+ * quit.
+ */
+
+ if (eventPtr->type == MappingNotify) {
+ dispPtr = TkGetDisplay(eventPtr->xmapping.display);
+ if (dispPtr != NULL) {
+ XRefreshKeyboardMapping(&eventPtr->xmapping);
+ dispPtr->bindInfoStale = 1;
+ }
+ return;
+ }
+
+ /*
+ * Events selected by StructureNotify require special handling.
+ * They look the same as those selected by SubstructureNotify.
+ * The only difference is whether the "event" and "window" fields
+ * are the same. Compare the two fields and convert StructureNotify
+ * to SubstructureNotify if necessary.
+ */
+
+ handlerWindow = eventPtr->xany.window;
+ mask = eventMasks[eventPtr->xany.type];
+ if (mask == StructureNotifyMask) {
+ if (eventPtr->xmap.event != eventPtr->xmap.window) {
+ mask = SubstructureNotifyMask;
+ handlerWindow = eventPtr->xmap.event;
+ }
+ }
+ winPtr = (TkWindow *) Tk_IdToWindow(eventPtr->xany.display, handlerWindow);
+ if (winPtr == NULL) {
+
+ /*
+ * There isn't a TkWindow structure for this window.
+ * However, if the event is a PropertyNotify event then call
+ * the selection manager (it deals beneath-the-table with
+ * certain properties).
+ */
+
+ if (eventPtr->type == PropertyNotify) {
+ TkSelPropProc(eventPtr);
+ }
+ return;
+ }
+
+ /*
+ * Once a window has started getting deleted, don't process any more
+ * events for it except for the DestroyNotify event. This check is
+ * needed because a DestroyNotify handler could re-invoke the event
+ * loop, causing other pending events to be handled for the window
+ * (the window doesn't get totally expunged from our tables until
+ * after the DestroyNotify event has been completely handled).
+ */
+
+ if ((winPtr->flags & TK_ALREADY_DEAD)
+ && (eventPtr->type != DestroyNotify)) {
+ return;
+ }
+
+ if (winPtr->mainPtr != NULL) {
+
+ /*
+ * Protect interpreter for this window from possible deletion
+ * while we are dealing with the event for this window. Thus,
+ * widget writers do not have to worry about protecting the
+ * interpreter in their own code.
+ */
+
+ interp = winPtr->mainPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+
+ /*
+ * Call focus-related code to look at FocusIn, FocusOut, Enter,
+ * and Leave events; depending on its return value, ignore the
+ * event.
+ */
+
+ if ((mask & (FocusChangeMask|EnterWindowMask|LeaveWindowMask))
+ && !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;
+ }
+ }
+
+ /*
+ * Call a grab-related procedure to do special processing on
+ * pointer events.
+ */
+
+ if (mask & (ButtonPressMask|ButtonReleaseMask|PointerMotionMask
+ |EnterWindowMask|LeaveWindowMask)) {
+ if (mask & (ButtonPressMask|ButtonReleaseMask)) {
+ winPtr->dispPtr->lastEventTime = eventPtr->xbutton.time;
+ } else if (mask & PointerMotionMask) {
+ winPtr->dispPtr->lastEventTime = eventPtr->xmotion.time;
+ } else {
+ winPtr->dispPtr->lastEventTime = eventPtr->xcrossing.time;
+ }
+ if (TkPointerEvent(eventPtr, winPtr) == 0) {
+ goto done;
+ }
+ }
+ }
+
+#ifdef TK_USE_INPUT_METHODS
+ /*
+ * Pass the event to the input method(s), if there are any, and
+ * discard the event if the input method(s) insist. Create the
+ * input context for the window if it hasn't already been done
+ * (XFilterEvent needs this context).
+ */
+
+ if (!(winPtr->flags & TK_CHECKED_IC)) {
+ if (winPtr->dispPtr->inputMethod != NULL) {
+ winPtr->inputContext = XCreateIC(
+ winPtr->dispPtr->inputMethod, XNInputStyle,
+ XIMPreeditNothing|XIMStatusNothing,
+ XNClientWindow, winPtr->window,
+ XNFocusWindow, winPtr->window, NULL);
+ }
+ winPtr->flags |= TK_CHECKED_IC;
+ }
+ if (XFilterEvent(eventPtr, None)) {
+ goto done;
+ }
+#endif /* TK_USE_INPUT_METHODS */
+
+ /*
+ * For events where it hasn't already been done, update the current
+ * time in the display.
+ */
+
+ if (eventPtr->type == PropertyNotify) {
+ winPtr->dispPtr->lastEventTime = eventPtr->xproperty.time;
+ }
+
+ /*
+ * 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 ==
+ Tk_InternAtom((Tk_Window) winPtr, "WM_PROTOCOLS"))) {
+ TkWmProtocolEventProc(winPtr, eventPtr);
+ }
+ } else {
+ for (handlerPtr = winPtr->handlerList; handlerPtr != NULL; ) {
+ if ((handlerPtr->mask & mask) != 0) {
+ ip.nextHandler = handlerPtr->nextPtr;
+ (*(handlerPtr->proc))(handlerPtr->clientData, eventPtr);
+ handlerPtr = ip.nextHandler;
+ } else {
+ handlerPtr = handlerPtr->nextPtr;
+ }
+ }
+
+ /*
+ * Pass the event to the "bind" command mechanism. But, don't
+ * do this for SubstructureNotify events. The "bind" command
+ * doesn't support them anyway, and it's easier to filter out
+ * 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.
+ */
+
+ if (interp != (Tcl_Interp *) NULL) {
+ Tcl_Release((ClientData) interp);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkEventDeadWindow --
+ *
+ * This procedure is invoked when it is determined that
+ * a window is dead. It cleans up event-related information
+ * about the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Various things get cleaned up and recycled.
+ *
+ *--------------------------------------------------------------
+ */
+
+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;
+ }
+ }
+ ckfree((char *) handlerPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCurrentTime --
+ *
+ * Try to deduce the current time. "Current time" means the time
+ * of the event that led to the current code being executed, which
+ * means the time in the most recently-nested invocation of
+ * Tk_HandleEvent.
+ *
+ * Results:
+ * The return value is the time from the current event, or
+ * CurrentTime if there is no current event or if the current
+ * event contains no time.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ case MotionNotify:
+ return eventPtr->xmotion.time;
+ case EnterNotify:
+ case LeaveNotify:
+ return eventPtr->xcrossing.time;
+ case PropertyNotify:
+ return eventPtr->xproperty.time;
+ }
+ return dispPtr->lastEventTime;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_RestrictEvents --
+ *
+ * This procedure is used to globally restrict the set of events
+ * that will be dispatched. The restriction is done by filtering
+ * all incoming X events through a procedure that determines
+ * whether they are to be processed immediately, deferred, or
+ * discarded.
+ *
+ * Results:
+ * The return value is the previous restriction procedure in effect,
+ * if there was one, or NULL if there wasn't.
+ *
+ * Side effects:
+ * From now on, proc will be called to determine whether to process,
+ * defer or discard each incoming X event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_RestrictProc *
+Tk_RestrictEvents(proc, arg, prevArgPtr)
+ 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 --
+ *
+ * Given an X-style window event, this procedure adds it to the
+ * Tcl event queue at the given position. This procedure also
+ * performs mouse motion event collapsing if possible.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Adds stuff to the event queue, which will eventually be
+ * processed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_QueueWindowEvent(eventPtr, position)
+ XEvent *eventPtr; /* Event to add to queue. This
+ * procedures copies it before adding
+ * it to the queue. */
+ Tcl_QueuePosition position; /* Where to put it on the queue:
+ * TCL_QUEUE_TAIL, TCL_QUEUE_HEAD,
+ * or TCL_QUEUE_MARK. */
+{
+ 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;
+ }
+ }
+
+ if ((dispPtr->delayedMotionPtr != NULL) && (position == TCL_QUEUE_TAIL)) {
+ if ((eventPtr->type == MotionNotify) && (eventPtr->xmotion.window
+ == dispPtr->delayedMotionPtr->event.xmotion.window)) {
+ /*
+ * The new event is a motion event in the same window as the
+ * saved motion event. Just replace the saved event with the
+ * new one.
+ */
+
+ dispPtr->delayedMotionPtr->event = *eventPtr;
+ return;
+ } else if ((eventPtr->type != GraphicsExpose)
+ && (eventPtr->type != NoExpose)
+ && (eventPtr->type != Expose)) {
+ /*
+ * The new event may conflict with the saved motion event. Queue
+ * the saved motion event now so that it will be processed before
+ * the new event.
+ */
+
+ Tcl_QueueEvent(&dispPtr->delayedMotionPtr->header, position);
+ dispPtr->delayedMotionPtr = NULL;
+ Tcl_CancelIdleCall(DelayedMotionProc, (ClientData) dispPtr);
+ }
+ }
+
+ wevPtr = (TkWindowEvent *) ckalloc(sizeof(TkWindowEvent));
+ wevPtr->header.proc = WindowEventProc;
+ wevPtr->event = *eventPtr;
+ if ((eventPtr->type == MotionNotify) && (position == TCL_QUEUE_TAIL)) {
+ /*
+ * The new event is a motion event so don't queue it immediately;
+ * save it around in case another motion event arrives that it can
+ * be collapsed with.
+ */
+
+ if (dispPtr->delayedMotionPtr != NULL) {
+ panic("Tk_QueueWindowEvent found unexpected delayed motion event");
+ }
+ dispPtr->delayedMotionPtr = wevPtr;
+ Tcl_DoWhenIdle(DelayedMotionProc, (ClientData) dispPtr);
+ } else {
+ Tcl_QueueEvent(&wevPtr->header, position);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkQueueEventForAllChildren --
+ *
+ * Given an XEvent, recursively queue the event for this window and
+ * all non-toplevel children of the given window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Events queued.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkQueueEventForAllChildren(winPtr, eventPtr)
+ TkWindow *winPtr; /* Window to which event is sent. */
+ XEvent *eventPtr; /* The event to be sent. */
+{
+ TkWindow *childPtr;
+
+ eventPtr->xany.window = winPtr->window;
+ Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_TAIL);
+
+ childPtr = winPtr->childList;
+ while (childPtr != NULL) {
+ if (!Tk_IsTopLevel(childPtr)) {
+ TkQueueEventForAllChildren(childPtr, eventPtr);
+ }
+ childPtr = childPtr->nextPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WindowEventProc --
+ *
+ * This procedure is called by Tcl_DoOneEvent when a window event
+ * reaches the front of the event queue. This procedure is responsible
+ * for actually handling the event.
+ *
+ * Results:
+ * Returns 1 if the event was handled, meaning it should be removed
+ * from the queue. Returns 0 if the event was not handled, meaning
+ * it should stay on the queue. The event isn't handled if the
+ * TCL_WINDOW_EVENTS bit isn't set in flags, if a restrict proc
+ * prevents the event from being handled.
+ *
+ * Side effects:
+ * Whatever the event handlers for the event do.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+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.
+ */
+ return 1;
+ }
+ }
+ }
+ Tk_HandleEvent(&wevPtr->event);
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DelayedMotionProc --
+ *
+ * This procedure is invoked as an idle handler when a mouse motion
+ * event has been delayed. It queues the delayed event so that it
+ * will finally be serviced.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The delayed mouse motion event gets added to the Tcl event
+ * queue for servicing.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DelayedMotionProc(clientData)
+ ClientData clientData; /* Pointer to display containing a delayed
+ * motion event to be serviced. */
+{
+ TkDisplay *dispPtr = (TkDisplay *) clientData;
+
+ if (dispPtr->delayedMotionPtr == NULL) {
+ panic("DelayedMotionProc found no delayed mouse motion event");
+ }
+ Tcl_QueueEvent(&dispPtr->delayedMotionPtr->header, TCL_QUEUE_TAIL);
+ dispPtr->delayedMotionPtr = NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MainLoop --
+ *
+ * Call Tcl_DoOneEvent over and over again in an infinite
+ * loop as long as there exist any main windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arbitrary; depends on handlers for events.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_MainLoop()
+{
+ while (Tk_GetNumMainWindows() > 0) {
+ Tcl_DoOneEvent(0);
+ }
+}
diff --git a/tk/generic/tkFileFilter.c b/tk/generic/tkFileFilter.c
new file mode 100644
index 00000000000..258f6fdf604
--- /dev/null
+++ b/tk/generic/tkFileFilter.c
@@ -0,0 +1,486 @@
+/*
+ * 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$
+ *
+ */
+
+#include "tkInt.h"
+#include "tkFileFilter.h"
+
+static int AddClause _ANSI_ARGS_((
+ Tcl_Interp * interp, FileFilter * filterPtr,
+ char * patternsStr, char * ostypesStr,
+ int isWindows));
+static void FreeClauses _ANSI_ARGS_((FileFilter * filterPtr));
+static void FreeGlobPatterns _ANSI_ARGS_((
+ FileFilterClause * clausePtr));
+static void FreeMacFileTypes _ANSI_ARGS_((
+ FileFilterClause * clausePtr));
+static FileFilter * GetFilter _ANSI_ARGS_((FileFilterList * flistPtr,
+ char * name));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkInitFileFilters --
+ *
+ * Initializes a FileFilterList data structure. A FileFilterList
+ * must be initialized EXACTLY ONCE before any calls to
+ * TkGetFileFilters() is made. The usual flow of control is:
+ * TkInitFileFilters(&flist);
+ * TkGetFileFilters(&flist, ...);
+ * TkGetFileFilters(&flist, ...);
+ * ...
+ * TkFreeFileFilters(&flist);
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields in flistPtr are initialized.
+ *----------------------------------------------------------------------
+ */
+
+void
+TkInitFileFilters(flistPtr)
+ FileFilterList * flistPtr; /* The structure to be initialized. */
+{
+ flistPtr->filters = NULL;
+ flistPtr->filtersTail = NULL;
+ flistPtr->numFilters = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetFileFilters --
+ *
+ * This function is called by the Mac and Windows implementation
+ * of tk_getOpenFile and tk_getSaveFile to translate the string
+ * value of the -filetypes option of into an easy-to-parse C
+ * structure (flistPtr). The caller of this function will then use
+ * flistPtr to perform filetype matching in a platform specific way.
+ *
+ * flistPtr must be initialized (See comments in TkInitFileFilters).
+ *
+ * Results:
+ * A standard TCL return value.
+ *
+ * Side effects:
+ * The fields in flistPtr are changed according to string.
+ *----------------------------------------------------------------------
+ */
+int
+TkGetFileFilters(interp, flistPtr, string, isWindows)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ FileFilterList * flistPtr; /* Stores the list of file filters. */
+ char * string; /* Value of the -filetypes option. */
+ int isWindows; /* True if we are running on Windows. */
+{
+ int listArgc;
+ char ** listArgv = NULL;
+ char ** typeInfo = NULL;
+ int code = TCL_OK;
+ int i;
+
+ if (Tcl_SplitList(interp, string, &listArgc, &listArgv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (listArgc == 0) {
+ goto done;
+ }
+
+ /*
+ * Free the filter information that have been allocated the previous
+ * time -- the -filefilters option may have been used more than once in
+ * the command line.
+ */
+ TkFreeFileFilters(flistPtr);
+
+ for (i = 0; i<listArgc; i++) {
+ /*
+ * Each file type should have two or three elements: the first one
+ * is the name of the type and the second is the filter of the type.
+ * The third is the Mac OSType ID, but we don't care about them here.
+ */
+ int count;
+ FileFilter * filterPtr;
+
+ if (Tcl_SplitList(interp, listArgv[i], &count, &typeInfo) != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ if (count != 2 && count != 3) {
+ Tcl_AppendResult(interp, "bad file type \"", listArgv[i], "\", ",
+ "should be \"typeName {extension ?extensions ...?} ",
+ "?{macType ?macTypes ...?}?\"", NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+
+ filterPtr = GetFilter(flistPtr, typeInfo[0]);
+
+ if (count == 2) {
+ code = AddClause(interp, filterPtr, typeInfo[1], NULL,
+ isWindows);
+ } else {
+ code = AddClause(interp, filterPtr, typeInfo[1], typeInfo[2],
+ isWindows);
+ }
+ if (code != TCL_OK) {
+ goto done;
+ }
+
+ if (typeInfo) {
+ ckfree((char*)typeInfo);
+ }
+ typeInfo = NULL;
+ }
+
+ done:
+ if (typeInfo) {
+ ckfree((char*)typeInfo);
+ }
+ if (listArgv) {
+ ckfree((char*)listArgv);
+ }
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFreeFileFilters --
+ *
+ * Frees the malloc'ed file filter information.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields allocated by TkGetFileFilters() are freed.
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFreeFileFilters(flistPtr)
+ FileFilterList * flistPtr; /* List of file filters to free */
+{
+ FileFilter * filterPtr, *toFree;
+
+ filterPtr=flistPtr->filters;
+ while (filterPtr) {
+ toFree = filterPtr;
+ filterPtr=filterPtr->next;
+ FreeClauses(toFree);
+ ckfree((char*)toFree->name);
+ ckfree((char*)toFree);
+ }
+ flistPtr->filters = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AddClause --
+ *
+ * Add one FileFilterClause to filterPtr.
+ *
+ * Results:
+ * A standard TCL result.
+ *
+ * Side effects:
+ * The list of filter clauses are updated in filterPtr.
+ *----------------------------------------------------------------------
+ */
+
+static int AddClause(interp, filterPtr, patternsStr, ostypesStr, isWindows)
+ Tcl_Interp * interp; /* Interpreter to use for error reporting. */
+ FileFilter * filterPtr; /* Stores the new filter clause */
+ char * patternsStr; /* A TCL list of glob patterns. */
+ char * ostypesStr; /* A TCL list of Mac OSType strings. */
+ int isWindows; /* True if we are running on Windows; False
+ * if we are running on the Mac; Glob
+ * patterns need to be processed differently
+ * on these two platforms */
+{
+ char ** globList = NULL;
+ int globCount;
+ char ** ostypeList = NULL;
+ int ostypeCount;
+ FileFilterClause * clausePtr;
+ int i;
+ int code = TCL_OK;
+
+ if (Tcl_SplitList(interp, patternsStr, &globCount, &globList)!= TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ if (ostypesStr != NULL) {
+ if (Tcl_SplitList(interp, ostypesStr, &ostypeCount, &ostypeList)
+ != TCL_OK) {
+ code = TCL_ERROR;
+ goto done;
+ }
+ for (i=0; i<ostypeCount; i++) {
+ if (strlen(ostypeList[i]) != 4) {
+ Tcl_AppendResult(interp, "bad Macintosh file type \"",
+ ostypeList[i], "\"", NULL);
+ code = TCL_ERROR;
+ goto done;
+ }
+ }
+ }
+
+ /*
+ * Add the clause into the list of clauses
+ */
+
+ clausePtr = (FileFilterClause*)ckalloc(sizeof(FileFilterClause));
+ clausePtr->patterns = NULL;
+ clausePtr->patternsTail = NULL;
+ clausePtr->macTypes = NULL;
+ clausePtr->macTypesTail = NULL;
+
+ if (filterPtr->clauses == NULL) {
+ filterPtr->clauses = filterPtr->clausesTail = clausePtr;
+ } else {
+ filterPtr->clausesTail->next = clausePtr;
+ filterPtr->clausesTail = clausePtr;
+ }
+ clausePtr->next = NULL;
+
+ if (globCount > 0 && globList != NULL) {
+ for (i=0; i<globCount; i++) {
+ GlobPattern * globPtr = (GlobPattern*)ckalloc(sizeof(GlobPattern));
+ int len;
+
+ len = (strlen(globList[i]) + 1) * sizeof(char);
+
+ if (globList[i][0] && globList[i][0] != '*') {
+ /*
+ * Prepend a "*" to patterns that do not have a leading "*"
+ */
+ globPtr->pattern = (char*)ckalloc(len+1);
+ globPtr->pattern[0] = '*';
+ strcpy(globPtr->pattern+1, globList[i]);
+ }
+ else if (isWindows) {
+ if (strcmp(globList[i], "*") == 0) {
+ globPtr->pattern = (char*)ckalloc(4*sizeof(char));
+ strcpy(globPtr->pattern, "*.*");
+ }
+ else if (strcmp(globList[i], "") == 0) {
+ /*
+ * An empty string means "match all files with no
+ * extensions"
+ * BUG: "*." actually matches with all files on Win95
+ */
+ globPtr->pattern = (char*)ckalloc(3*sizeof(char));
+ strcpy(globPtr->pattern, "*.");
+ }
+ else {
+ globPtr->pattern = (char*)ckalloc(len);
+ strcpy(globPtr->pattern, globList[i]);
+ }
+ } else {
+ globPtr->pattern = (char*)ckalloc(len);
+ strcpy(globPtr->pattern, globList[i]);
+ }
+
+ /*
+ * Add the glob pattern into the list of patterns.
+ */
+
+ if (clausePtr->patterns == NULL) {
+ clausePtr->patterns = clausePtr->patternsTail = globPtr;
+ } else {
+ clausePtr->patternsTail->next = globPtr;
+ clausePtr->patternsTail = globPtr;
+ }
+ globPtr->next = NULL;
+ }
+ }
+ if (ostypeCount > 0 && ostypeList != NULL) {
+ for (i=0; i<ostypeCount; i++) {
+ MacFileType * mfPtr = (MacFileType*)ckalloc(sizeof(MacFileType));
+
+ memcpy(&mfPtr->type, ostypeList[i], sizeof(OSType));
+
+ /*
+ * Add the Mac type pattern into the list of Mac types
+ */
+ if (clausePtr->macTypes == NULL) {
+ clausePtr->macTypes = clausePtr->macTypesTail = mfPtr;
+ } else {
+ clausePtr->macTypesTail->next = mfPtr;
+ clausePtr->macTypesTail = mfPtr;
+ }
+ mfPtr->next = NULL;
+ }
+ }
+
+ done:
+ if (globList) {
+ ckfree((char*)globList);
+ }
+ if (ostypeList) {
+ ckfree((char*)ostypeList);
+ }
+
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetFilter --
+ *
+ * Add one FileFilter to flistPtr.
+ *
+ * Results:
+ * A standard TCL result.
+ *
+ * Side effects:
+ * The list of filters are updated in flistPtr.
+ *----------------------------------------------------------------------
+ */
+
+static FileFilter * GetFilter(flistPtr, name)
+ FileFilterList * flistPtr; /* The FileFilterList that contains the
+ * newly created filter */
+ char * name; /* Name of the filter. It is usually displayed
+ * in the "File Types" listbox in the file
+ * dialogs. */
+{
+ FileFilter * filterPtr;
+
+ for (filterPtr=flistPtr->filters; filterPtr; filterPtr=filterPtr->next) {
+ if (strcmp(filterPtr->name, name)==0) {
+ return filterPtr;
+ }
+ }
+
+ filterPtr = (FileFilter*)ckalloc(sizeof(FileFilter));
+ filterPtr->clauses = NULL;
+ filterPtr->clausesTail = NULL;
+ filterPtr->name = (char*)ckalloc((strlen(name)+1) * sizeof(char));
+ strcpy(filterPtr->name, name);
+
+ if (flistPtr->filters == NULL) {
+ flistPtr->filters = flistPtr->filtersTail = filterPtr;
+ } else {
+ flistPtr->filtersTail->next = filterPtr;
+ flistPtr->filtersTail = filterPtr;
+ }
+ filterPtr->next = NULL;
+
+ ++flistPtr->numFilters;
+ return filterPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeClauses --
+ *
+ * Frees the malloc'ed file type clause
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The list of clauses in filterPtr->clauses are freed.
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeClauses(filterPtr)
+ FileFilter * filterPtr; /* FileFilter whose clauses are to be freed */
+{
+ FileFilterClause * clausePtr, * toFree;
+
+ clausePtr = filterPtr->clauses;
+ while (clausePtr) {
+ toFree = clausePtr;
+ clausePtr=clausePtr->next;
+ FreeGlobPatterns(toFree);
+ FreeMacFileTypes(toFree);
+ ckfree((char*)toFree);
+ }
+ filterPtr->clauses = NULL;
+ filterPtr->clausesTail = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeGlobPatterns --
+ *
+ * Frees the malloc'ed glob patterns in a clause
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The list of glob patterns in clausePtr->patterns are freed.
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeGlobPatterns(clausePtr)
+ FileFilterClause * clausePtr;/* The clause whose patterns are to be freed*/
+{
+ GlobPattern * globPtr, * toFree;
+
+ globPtr = clausePtr->patterns;
+ while (globPtr) {
+ toFree = globPtr;
+ globPtr=globPtr->next;
+
+ ckfree((char*)toFree->pattern);
+ ckfree((char*)toFree);
+ }
+ clausePtr->patterns = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeMacFileTypes --
+ *
+ * Frees the malloc'ed Mac file types in a clause
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The list of Mac file types in clausePtr->macTypes are freed.
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeMacFileTypes(clausePtr)
+ FileFilterClause * clausePtr; /* The clause whose mac types are to be
+ * freed */
+{
+ MacFileType * mfPtr, * toFree;
+
+ mfPtr = clausePtr->macTypes;
+ while (mfPtr) {
+ toFree = mfPtr;
+ mfPtr=mfPtr->next;
+ ckfree((char*)toFree);
+ }
+ clausePtr->macTypes = NULL;
+}
diff --git a/tk/generic/tkFileFilter.h b/tk/generic/tkFileFilter.h
new file mode 100644
index 00000000000..1550d76b45b
--- /dev/null
+++ b/tk/generic/tkFileFilter.h
@@ -0,0 +1,92 @@
+/*
+ * 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$
+ *
+ */
+
+#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 "*.*"
+ */
+} GlobPattern;
+
+typedef struct MacFileType {
+ struct MacFileType * next; /* Chains to the next mac file type
+ * in a mac file type list */
+ OSType type; /* Mac file type, such as 'TEXT' or
+ * 'GIFF' */
+} MacFileType;
+
+typedef struct FileFilterClause {
+ struct FileFilterClause * next; /* Chains to the next clause in
+ * a clause list */
+ GlobPattern * patterns; /* Head of glob pattern type list */
+ GlobPattern * patternsTail; /* Tail of glob pattern type list */
+ MacFileType * macTypes; /* Head of mac file type list */
+ MacFileType * macTypesTail; /* Tail of mac file type list */
+} FileFilterClause;
+
+typedef struct FileFilter {
+ struct FileFilter * next; /* Chains to the next filter
+ * in a filter list */
+ char * name; /* Name of the file filter,
+ * such as "Text Documents" */
+ FileFilterClause * clauses; /* Head of the clauses list */
+ FileFilterClause * clausesTail; /* Tail of the clauses list */
+} FileFilter;
+
+/*----------------------------------------------------------------------
+ * FileFilterList --
+ *
+ * The routine TkGetFileFilters() translates the string value of the
+ * -filefilters option into a FileFilterList structure, which consists
+ * of a list of file filters.
+ *
+ * Each file filter consists of one or more clauses. Each clause has
+ * one or more glob patterns and/or one or more Mac file types
+ *----------------------------------------------------------------------
+ */
+
+typedef struct FileFilterList {
+ FileFilter * filters; /* Head of the filter list */
+ FileFilter * filtersTail; /* Tail of the filter list */
+ int numFilters; /* number of filters in the list */
+} FileFilterList;
+
+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
diff --git a/tk/generic/tkFocus.c b/tk/generic/tkFocus.c
new file mode 100644
index 00000000000..4cd35ce9fe2
--- /dev/null
+++ b/tk/generic/tkFocus.c
@@ -0,0 +1,999 @@
+/*
+ * 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$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+
+/*
+ * For each top-level window that has ever received the focus, there
+ * is a record of the following type:
+ */
+
+typedef struct TkToplevelFocusInfo {
+ TkWindow *topLevelPtr; /* Information about top-level window. */
+ TkWindow *focusWinPtr; /* The next time the focus comes to this
+ * top-level, it will be given to this
+ * window. */
+ struct TkToplevelFocusInfo *nextPtr;
+ /* Next in list of all toplevel focus records
+ * for a given application. */
+} ToplevelFocusInfo;
+
+/*
+ * One of the following structures exists for each display used by
+ * each application. These are linked together from the TkMainInfo
+ * structure. These structures are needed because it isn't
+ * sufficient to store a single piece of focus information in each
+ * display or in each application: we need the cross-product.
+ * There needs to be separate information for each display, because
+ * it's possible to have multiple focus windows active simultaneously
+ * on different displays. There also needs to be separate information
+ * for each application, because of embedding: if an embedded
+ * application has the focus, its container application also has
+ * the focus. Thus we keep a list of structures for each application:
+ * the same display can appear in structures for several applications
+ * at once.
+ */
+
+typedef struct TkDisplayFocusInfo {
+ TkDisplay *dispPtr; /* Display that this information pertains
+ * to. */
+ struct TkWindow *focusWinPtr;
+ /* Window that currently has the focus for
+ * this application on this display, or NULL
+ * if none. */
+ struct TkWindow *focusOnMapPtr;
+ /* This points to a toplevel window that is
+ * supposed to receive the X input focus as
+ * soon as it is mapped (needed to handle the
+ * fact that X won't allow the focus on an
+ * unmapped window). NULL means no delayed
+ * focus op in progress for this display. */
+ int forceFocus; /* Associated with focusOnMapPtr: non-zero
+ * means claim the focus even if some other
+ * application currently has it. */
+ unsigned long focusSerial; /* Serial number of last request this
+ * application made to change the focus on
+ * this display. Used to identify stale
+ * 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.
+ */
+
+#define GENERATED_EVENT_MAGIC ((Bool) 0x547321ac)
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+
+static DisplayFocusInfo *FindDisplayFocusInfo _ANSI_ARGS_((TkMainInfo *mainPtr,
+ TkDisplay *dispPtr));
+static void FocusMapProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkFocusFilterEvent --
+ *
+ * This procedure is invoked by Tk_HandleEvent when it encounters
+ * a FocusIn, FocusOut, Enter, or Leave event.
+ *
+ * Results:
+ * A return value of 1 means that Tk_HandleEvent should process
+ * the event normally (i.e. event handlers should be invoked).
+ * A return value of 0 means that this event should be ignored.
+ *
+ * Side effects:
+ * Additional events may be generated, and the focus may switch.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkFocusFilterEvent(winPtr, eventPtr)
+ TkWindow *winPtr; /* Window that focus event is directed to. */
+ XEvent *eventPtr; /* FocusIn, FocusOut, Enter, or Leave
+ * event. */
+{
+ /*
+ * Design notes: the window manager and X server work together to
+ * transfer the focus among top-level windows. This procedure takes
+ * care of transferring the focus from a top-level or wrapper window
+ * to the actual window within that top-level that has the focus.
+ * We do this by synthesizing X events to move the focus around.
+ * None of the FocusIn and FocusOut events generated by X are ever
+ * used outside of this procedure; only the synthesized events get
+ * through to the rest of the application. At one point (e.g.
+ * Tk4.0b1) Tk used to call X to move the focus from a top-level to
+ * one of its descendants, then just pass through the events
+ * generated by X. This approach didn't work very well, for a
+ * variety of reasons. For example, if X generates the events they
+ * go at the back of the event queue, which could cause problems if
+ * other things have already happened, such as moving the focus to
+ * yet another window.
+ */
+
+ ToplevelFocusInfo *tlFocusPtr;
+ DisplayFocusInfo *displayFocusPtr;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkWindow *newFocusPtr;
+ int retValue, delta;
+
+ /*
+ * If this was a generated event, just turn off the generated
+ * flag and pass the event through to Tk bindings.
+ */
+
+ if (eventPtr->xfocus.send_event == GENERATED_EVENT_MAGIC) {
+ eventPtr->xfocus.send_event = 0;
+ return 1;
+ }
+
+ /*
+ * Check for special events generated by embedded applications to
+ * request the input focus. If this is one of those events, make
+ * the change in focus and return without any additional processing
+ * of the event (note: the "detail" field of the event indicates
+ * whether to claim the focus even if we don't already have it).
+ */
+
+ if ((eventPtr->xfocus.mode == EMBEDDED_APP_WANTS_FOCUS)
+ && (eventPtr->type == FocusIn)) {
+ SetFocus(winPtr, eventPtr->xfocus.detail);
+ return 0;
+ }
+
+ /*
+ * This was not a generated event. We'll return 1 (so that the
+ * event will be processed) if it's an Enter or Leave event, and
+ * 0 (so that the event won't be processed) if it's a FocusIn or
+ * FocusOut event.
+ */
+
+ retValue = 0;
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+ if (eventPtr->type == FocusIn) {
+ /*
+ * Skip FocusIn events that cause confusion
+ * NotifyVirtual and NotifyNonlinearVirtual - Virtual events occur
+ * on windows in between the origin and destination of the
+ * focus change. For FocusIn we may see this when focus
+ * goes into an embedded child. We don't care about this,
+ * although we may end up getting a NotifyPointer later.
+ * NotifyInferior - focus is coming to us from an embedded child.
+ * When focus is on an embeded focus, we still think we have
+ * the focus, too, so this message doesn't change our state.
+ * NotifyPointerRoot - should never happen because this is sent
+ * to the root window.
+ *
+ * Interesting FocusIn events are
+ * NotifyAncestor - focus is coming from our parent, probably the root.
+ * NotifyNonlinear - focus is coming from a different branch, probably
+ * another toplevel.
+ * NotifyPointer - implicit focus because of the mouse position.
+ * This is only interesting on toplevels, when it means that the
+ * focus has been set to the root window but the mouse is over
+ * this toplevel. We take the focus implicitly (probably no
+ * window manager)
+ */
+
+ if ((eventPtr->xfocus.detail == NotifyVirtual)
+ || (eventPtr->xfocus.detail == NotifyNonlinearVirtual)
+ || (eventPtr->xfocus.detail == NotifyPointerRoot)
+ || (eventPtr->xfocus.detail == NotifyInferior)) {
+ return retValue;
+ }
+ } else if (eventPtr->type == FocusOut) {
+ /*
+ * Skip FocusOut events that cause confusion.
+ * NotifyPointer - the pointer is in us or a child, and we are losing
+ * focus because of an XSetInputFocus. Other focus events
+ * will set our state properly.
+ * NotifyPointerRoot - should never happen because this is sent
+ * to the root window.
+ * NotifyInferior - focus leaving us for an embedded child. We
+ * retain a notion of focus when an embedded child has focus.
+ *
+ * Interesting events are:
+ * NotifyAncestor - focus is going to root.
+ * NotifyNonlinear - focus is going to another branch, probably
+ * another toplevel.
+ * NotifyVirtual, NotifyNonlinearVirtual - focus is passing through,
+ * and we need to make sure we track this.
+ */
+
+ if ((eventPtr->xfocus.detail == NotifyPointer)
+ || (eventPtr->xfocus.detail == NotifyPointerRoot)
+ || (eventPtr->xfocus.detail == NotifyInferior)) {
+ return retValue;
+ }
+ } else {
+ retValue = 1;
+ if (eventPtr->xcrossing.detail == NotifyInferior) {
+ return retValue;
+ }
+ }
+
+ /*
+ * If winPtr isn't a top-level window than just ignore the event.
+ */
+
+ winPtr = TkWmFocusToplevel(winPtr);
+ if (winPtr == NULL) {
+ return retValue;
+ }
+
+ /*
+ * If there is a grab in effect and this window is outside the
+ * grabbed tree, then ignore the event.
+ */
+
+ if (TkGrabState(winPtr) == TK_GRAB_EXCLUDED) {
+ return retValue;
+ }
+
+ /*
+ * It is possible that there were outstanding FocusIn and FocusOut
+ * events on their way to us at the time the focus was changed
+ * internally with the "focus" command. If so, these events could
+ * potentially cause us to lose the focus (switch it to the window
+ * of the last FocusIn event) even though the focus change occurred
+ * after those events. The following code detects this and ignores
+ * the stale events.
+ *
+ * Note: the focusSerial is only generated by TkpChangeFocus,
+ * whereas in Tk 4.2 there was always a nop marker generated.
+ */
+
+ delta = eventPtr->xfocus.serial - displayFocusPtr->focusSerial;
+ if (delta < 0) {
+ return retValue;
+ }
+
+ /*
+ * Find the ToplevelFocusInfo structure for the window, and make a new one
+ * if there isn't one already.
+ */
+
+ for (tlFocusPtr = winPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL;
+ tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (tlFocusPtr->topLevelPtr == winPtr) {
+ break;
+ }
+ }
+ if (tlFocusPtr == NULL) {
+ tlFocusPtr = (ToplevelFocusInfo *) ckalloc(sizeof(ToplevelFocusInfo));
+ tlFocusPtr->topLevelPtr = tlFocusPtr->focusWinPtr = winPtr;
+ tlFocusPtr->nextPtr = winPtr->mainPtr->tlFocusPtr;
+ winPtr->mainPtr->tlFocusPtr = tlFocusPtr;
+ }
+ newFocusPtr = tlFocusPtr->focusWinPtr;
+
+ if (eventPtr->type == FocusIn) {
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr, newFocusPtr);
+ displayFocusPtr->focusWinPtr = newFocusPtr;
+ dispPtr->focusPtr = newFocusPtr;
+
+ /*
+ * NotifyPointer gets set when the focus has been set to the root window
+ * but we have the pointer. We'll treat this like an implicit
+ * focus in event so that upon Leave events we release focus.
+ */
+
+ if (!(winPtr->flags & TK_EMBEDDED)) {
+ if (eventPtr->xfocus.detail == NotifyPointer) {
+ dispPtr->implicitWinPtr = winPtr;
+ } else {
+ dispPtr->implicitWinPtr = NULL;
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr, (TkWindow *) NULL);
+
+ /*
+ * Reset dispPtr->focusPtr, but only if it currently is the same
+ * as this application's focusWinPtr: this check is needed to
+ * handle embedded applications in the same process.
+ */
+
+ if (dispPtr->focusPtr == displayFocusPtr->focusWinPtr) {
+ dispPtr->focusPtr = NULL;
+ }
+ displayFocusPtr->focusWinPtr = NULL;
+ } else if (eventPtr->type == EnterNotify) {
+ /*
+ * If there is no window manager, or if the window manager isn't
+ * moving the focus around (e.g. the disgusting "NoTitleFocus"
+ * option has been selected in twm), then we won't get FocusIn
+ * or FocusOut events. Instead, the "focus" field will be set
+ * in an Enter event to indicate that we've already got the focus
+ * when the mouse enters the window (even though we didn't get
+ * a FocusIn event). Watch for this and grab the focus when it
+ * happens. Note: if this is an embedded application then don't
+ * accept the focus implicitly like this; the container
+ * 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;
+ dispPtr->focusPtr = newFocusPtr;
+ }
+ } else if (eventPtr->type == LeaveNotify) {
+ /*
+ * If the pointer just left a window for which we automatically
+ * claimed the focus on enter, move the focus back to the root
+ * window, where it was before we claimed it above. Note:
+ * dispPtr->implicitWinPtr may not be the same as
+ * displayFocusPtr->focusWinPtr (e.g. because the "focus"
+ * command was used to redirect the focus after it arrived at
+ * 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;
+ dispPtr->implicitWinPtr = NULL;
+ }
+ }
+ return retValue;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetFocus --
+ *
+ * This procedure is invoked to change the focus window for a
+ * given display in a given application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Event handlers may be invoked to process the change of
+ * focus.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SetFocus(winPtr, force)
+ TkWindow *winPtr; /* Window that is to be the new focus for
+ * its display and application. */
+ int force; /* If non-zero, set the X focus to this
+ * window even if the application doesn't
+ * currently have the X focus. */
+{
+ ToplevelFocusInfo *tlFocusPtr;
+ DisplayFocusInfo *displayFocusPtr;
+ TkWindow *topLevelPtr;
+ int allMapped, serial;
+
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+ /* CYGNUS LOCAL: We can't just return if force is set. */
+ 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.
+ */
+
+ allMapped = 1;
+ for (topLevelPtr = winPtr; ; topLevelPtr = topLevelPtr->parentPtr) {
+ if (topLevelPtr == NULL) {
+ /*
+ * The window is being deleted. No point in worrying about
+ * giving it the focus.
+ */
+ return;
+ }
+ if (!(topLevelPtr->flags & TK_MAPPED)) {
+ allMapped = 0;
+ }
+ if (topLevelPtr->flags & TK_TOP_LEVEL) {
+ break;
+ }
+ }
+
+ /*
+ * If the new focus window isn't mapped, then we can't focus on it
+ * (X will generate an error, for example). Instead, create an
+ * event handler that will set the focus to this window once it gets
+ * mapped. At the same time, delete any old handler that might be
+ * around; it's no longer relevant.
+ */
+
+ if (displayFocusPtr->focusOnMapPtr != NULL) {
+ Tk_DeleteEventHandler(
+ (Tk_Window) displayFocusPtr->focusOnMapPtr,
+ StructureNotifyMask, FocusMapProc,
+ (ClientData) displayFocusPtr->focusOnMapPtr);
+ displayFocusPtr->focusOnMapPtr = NULL;
+ }
+ if (!allMapped) {
+ Tk_CreateEventHandler((Tk_Window) winPtr,
+ VisibilityChangeMask, FocusMapProc,
+ (ClientData) winPtr);
+ displayFocusPtr->focusOnMapPtr = winPtr;
+ displayFocusPtr->forceFocus = force;
+ return;
+ }
+
+ for (tlFocusPtr = winPtr->mainPtr->tlFocusPtr; tlFocusPtr != NULL;
+ tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (tlFocusPtr->topLevelPtr == topLevelPtr) {
+ break;
+ }
+ }
+ if (tlFocusPtr == NULL) {
+ tlFocusPtr = (ToplevelFocusInfo *) ckalloc(sizeof(ToplevelFocusInfo));
+ tlFocusPtr->topLevelPtr = topLevelPtr;
+ tlFocusPtr->nextPtr = winPtr->mainPtr->tlFocusPtr;
+ winPtr->mainPtr->tlFocusPtr = tlFocusPtr;
+ }
+ tlFocusPtr->focusWinPtr = winPtr;
+
+ /*
+ * Reset the window system's focus window and generate focus events,
+ * with two special cases:
+ *
+ * 1. If the application is embedded and doesn't currently have the
+ * focus, don't set the focus directly. Instead, see if the
+ * embedding code can claim the focus from the enclosing
+ * container.
+ * 2. Otherwise, if the application doesn't currently have the
+ * focus, don't change the window system's focus unless it was
+ * already in this application or "force" was specified.
+ */
+
+ if ((topLevelPtr->flags & TK_EMBEDDED)
+ && (displayFocusPtr->focusWinPtr == NULL)) {
+ TkpClaimFocus(topLevelPtr, force);
+ } else if ((displayFocusPtr->focusWinPtr != NULL) || force) {
+ /*
+ * Generate events to shift focus between Tk windows.
+ * We do this regardless of what TkpChangeFocus does with
+ * the real X focus so that Tk widgets track focus commands
+ * when there is no window manager. GenerateFocusEvents will
+ * set up a serial number marker so we discard focus events
+ * that are triggered by the ChangeFocus.
+ */
+
+ serial = TkpChangeFocus(TkpGetWrapperWindow(topLevelPtr), force);
+ if (serial != 0) {
+ displayFocusPtr->focusSerial = serial;
+ }
+ GenerateFocusEvents(displayFocusPtr->focusWinPtr, winPtr);
+ displayFocusPtr->focusWinPtr = winPtr;
+ winPtr->dispPtr->focusPtr = winPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetFocusWin --
+ *
+ * Given a window, this procedure returns the current focus
+ * window for its application and display.
+ *
+ * Results:
+ * The return value is a pointer to the window that currently
+ * has the input focus for the specified application and
+ * display, or NULL if none.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkGetFocusWin(winPtr)
+ TkWindow *winPtr; /* Window that selects an application
+ * and a display. */
+{
+ DisplayFocusInfo *displayFocusPtr;
+
+ if (winPtr == NULL) {
+ return (TkWindow *) NULL;
+ }
+
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+ return displayFocusPtr->focusWinPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFocusKeyEvent --
+ *
+ * Given a window and a key press or release event that arrived for
+ * the window, use information about the keyboard focus to compute
+ * which window should really get the event. In addition, update
+ * the event to refer to its new window.
+ *
+ * Results:
+ * The return value is a pointer to the window that has the input
+ * focus in winPtr's application, or NULL if winPtr's application
+ * doesn't have the input focus. If a non-NULL value is returned,
+ * eventPtr will be updated to refer properly to the focus window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkFocusKeyEvent(winPtr, eventPtr)
+ TkWindow *winPtr; /* Window that selects an application
+ * and a display. */
+ XEvent *eventPtr; /* X event to redirect (should be KeyPress
+ * or KeyRelease). */
+{
+ DisplayFocusInfo *displayFocusPtr;
+ TkWindow *focusWinPtr;
+ int focusX, focusY, vRootX, vRootY, vRootWidth, vRootHeight;
+
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+ focusWinPtr = displayFocusPtr->focusWinPtr;
+
+ /*
+ * The code below is a debugging aid to make sure that dispPtr->focusPtr
+ * is kept properly in sync with the "truth", which is the value in
+ * displayFocusPtr->focusWinPtr.
+ */
+
+#ifdef TCL_MEM_DEBUG
+ if (focusWinPtr != winPtr->dispPtr->focusPtr) {
+ printf("TkFocusKeyEvent found dispPtr->focusPtr out of sync:\n");
+ printf("expected %s, got %s\n",
+ (focusWinPtr != NULL) ? focusWinPtr->pathName : "??",
+ (winPtr->dispPtr->focusPtr != NULL) ?
+ winPtr->dispPtr->focusPtr->pathName : "??");
+ }
+#endif
+
+ if ((focusWinPtr != NULL) && (focusWinPtr->mainPtr == winPtr->mainPtr)) {
+ /*
+ * Map the x and y coordinates to make sense in the context of
+ * the focus window, if possible (make both -1 if the map-from
+ * and map-to windows don't share the same screen).
+ */
+
+ if ((focusWinPtr->display != winPtr->display)
+ || (focusWinPtr->screenNum != winPtr->screenNum)) {
+ eventPtr->xkey.x = -1;
+ eventPtr->xkey.y = -1;
+ } else {
+ Tk_GetVRootGeometry((Tk_Window) focusWinPtr, &vRootX, &vRootY,
+ &vRootWidth, &vRootHeight);
+ Tk_GetRootCoords((Tk_Window) focusWinPtr, &focusX, &focusY);
+ eventPtr->xkey.x = eventPtr->xkey.x_root - vRootX - focusX;
+ eventPtr->xkey.y = eventPtr->xkey.y_root - vRootY - focusY;
+ }
+ eventPtr->xkey.window = focusWinPtr->window;
+ return focusWinPtr;
+ }
+
+ /*
+ * The event doesn't belong to us. Perhaps, due to embedding, it
+ * really belongs to someone else. Give the embedding code a chance
+ * to redirect the event.
+ */
+
+ TkpRedirectKeyEvent(winPtr, eventPtr);
+ return (TkWindow *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFocusDeadWindow --
+ *
+ * This procedure is invoked when it is determined that
+ * a window is dead. It cleans up focus-related information
+ * about the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Various things get cleaned up and recycled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFocusDeadWindow(winPtr)
+ register TkWindow *winPtr; /* Information about the window
+ * that is being deleted. */
+{
+ ToplevelFocusInfo *tlFocusPtr, *prevPtr;
+ DisplayFocusInfo *displayFocusPtr;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+
+ /*
+ * Search for focus records that refer to this window either as
+ * the top-level window or the current focus window.
+ */
+
+ displayFocusPtr = FindDisplayFocusInfo(winPtr->mainPtr, winPtr->dispPtr);
+ for (prevPtr = NULL, tlFocusPtr = winPtr->mainPtr->tlFocusPtr;
+ tlFocusPtr != NULL;
+ prevPtr = tlFocusPtr, tlFocusPtr = tlFocusPtr->nextPtr) {
+ if (winPtr == tlFocusPtr->topLevelPtr) {
+ /*
+ * 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;
+ }
+ if (displayFocusPtr->focusWinPtr == tlFocusPtr->focusWinPtr) {
+ displayFocusPtr->focusWinPtr = NULL;
+ dispPtr->focusPtr = NULL;
+ }
+ if (prevPtr == NULL) {
+ winPtr->mainPtr->tlFocusPtr = tlFocusPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = tlFocusPtr->nextPtr;
+ }
+ ckfree((char *) tlFocusPtr);
+ break;
+ } else if (winPtr == tlFocusPtr->focusWinPtr) {
+ /*
+ * 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;
+ dispPtr->focusPtr = tlFocusPtr->topLevelPtr;
+ }
+ break;
+ }
+ }
+
+ if (displayFocusPtr->focusOnMapPtr == winPtr) {
+ displayFocusPtr->focusOnMapPtr = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateFocusEvents --
+ *
+ * This procedure is called to create FocusIn and FocusOut events to
+ * move the input focus from one window to another.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * FocusIn and FocusOut events are generated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GenerateFocusEvents(sourcePtr, destPtr)
+ TkWindow *sourcePtr; /* Window that used to have the focus (may
+ * be NULL). */
+ TkWindow *destPtr; /* New window to have the focus (may be
+ * NULL). */
+
+{
+ XEvent event;
+ TkWindow *winPtr;
+
+ winPtr = sourcePtr;
+ if (winPtr == NULL) {
+ winPtr = destPtr;
+ if (winPtr == NULL) {
+ return;
+ }
+ }
+
+ event.xfocus.serial = LastKnownRequestProcessed(winPtr->display);
+ event.xfocus.send_event = GENERATED_EVENT_MAGIC;
+ event.xfocus.display = winPtr->display;
+ event.xfocus.mode = NotifyNormal;
+ TkInOutEvents(&event, sourcePtr, destPtr, FocusOut, FocusIn,
+ TCL_QUEUE_MARK);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FocusMapProc --
+ *
+ * This procedure is called as an event handler for VisibilityNotify
+ * events, if a window receives the focus at a time when its
+ * toplevel isn't mapped. The procedure is needed because X
+ * won't allow the focus to be set to an unmapped window; we
+ * detect when the toplevel is mapped and set the focus to it then.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If this is a map event, the focus gets set to the toplevel
+ * given by clientData.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FocusMapProc(clientData, eventPtr)
+ ClientData clientData; /* Toplevel window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ 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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindDisplayFocusInfo --
+ *
+ * Given an application and a display, this procedure locate the
+ * focus record for that combination. If no such record exists,
+ * it creates a new record and initializes it.
+ *
+ * Results:
+ * The return value is a pointer to the record.
+ *
+ * Side effects:
+ * A new record will be allocated if there wasn't one already.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DisplayFocusInfo *
+FindDisplayFocusInfo(mainPtr, dispPtr)
+ TkMainInfo *mainPtr; /* Record that identifies a particular
+ * application. */
+ TkDisplay *dispPtr; /* Display whose focus information is
+ * needed. */
+{
+ DisplayFocusInfo *displayFocusPtr;
+
+ for (displayFocusPtr = mainPtr->displayFocusPtr;
+ displayFocusPtr != NULL;
+ displayFocusPtr = displayFocusPtr->nextPtr) {
+ if (displayFocusPtr->dispPtr == dispPtr) {
+ return displayFocusPtr;
+ }
+ }
+
+ /*
+ * The record doesn't exist yet. Make a new one.
+ */
+
+ displayFocusPtr = (DisplayFocusInfo *) ckalloc(sizeof(DisplayFocusInfo));
+ displayFocusPtr->dispPtr = dispPtr;
+ displayFocusPtr->focusWinPtr = NULL;
+ displayFocusPtr->focusOnMapPtr = NULL;
+ displayFocusPtr->forceFocus = 0;
+ displayFocusPtr->focusSerial = 0;
+ displayFocusPtr->nextPtr = mainPtr->displayFocusPtr;
+ mainPtr->displayFocusPtr = displayFocusPtr;
+ return displayFocusPtr;
+}
diff --git a/tk/generic/tkFont.c b/tk/generic/tkFont.c
new file mode 100644
index 00000000000..018199f6c2b
--- /dev/null
+++ b/tk/generic/tkFont.c
@@ -0,0 +1,3040 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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 {
+ int refCount; /* Number of users of named font. */
+ int deletePending; /* Non-zero if font should be deleted when
+ * last reference goes away. */
+ TkFontAttributes fa; /* Desired attributes for named font. */
+} NamedFont;
+
+/*
+ * The following two structures are used to keep track of string
+ * measurement information when using the text layout facilities.
+ *
+ * A LayoutChunk represents a contiguous range of text that can be measured
+ * and displayed by low-level text calls. In general, chunks will be
+ * delimited by newlines and tabs. Low-level, platform-specific things
+ * like kerning and non-integer character widths may occur between the
+ * characters in a single chunk, but not between characters in different
+ * chunks.
+ *
+ * A TextLayout is a collection of LayoutChunks. It can be displayed with
+ * respect to any origin. It is the implementation of the Tk_TextLayout
+ * 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. */
+ int x, y; /* The origin of the first character in this
+ * chunk with respect to the upper-left hand
+ * corner of the TextLayout. */
+ int totalWidth; /* Width in pixels of this chunk. Used
+ * when hit testing the invisible spaces at
+ * the end of a chunk. */
+ int displayWidth; /* Width in pixels of the displayable
+ * characters in this chunk. Can be less than
+ * width if extra space characters were
+ * absorbed by the end of the chunk. */
+} LayoutChunk;
+
+typedef struct TextLayout {
+ Tk_Font tkfont; /* The font used when laying out the text. */
+ CONST char *string; /* The string that was layed out. */
+ int width; /* The maximum width of all lines in the
+ * text layout. */
+ int numChunks; /* Number of chunks actually used in
+ * following array. */
+ LayoutChunk chunks[1]; /* Array of chunks. The actual size will
+ * be maxChunks. THIS FIELD MUST BE THE LAST
+ * IN THE STRUCTURE. */
+} TextLayout;
+
+/*
+ * The following structures are used as two-way maps between the values for
+ * the fields in the TkFontAttributes structure and the strings used in
+ * Tcl, when parsing both option-value format and style-list format font
+ * name strings.
+ */
+
+static TkStateMap weightMap[] = {
+ {TK_FW_NORMAL, "normal"},
+ {TK_FW_BOLD, "bold"},
+ {TK_FW_UNKNOWN, NULL}
+};
+
+static TkStateMap slantMap[] = {
+ {TK_FS_ROMAN, "roman"},
+ {TK_FS_ITALIC, "italic"},
+ {TK_FS_UNKNOWN, NULL}
+};
+
+static TkStateMap underlineMap[] = {
+ {1, "underline"},
+ {0, NULL}
+};
+
+static TkStateMap overstrikeMap[] = {
+ {1, "overstrike"},
+ {0, NULL}
+};
+
+/*
+ * The following structures are used when parsing XLFD's into a set of
+ * TkFontAttributes.
+ */
+
+static TkStateMap xlfdWeightMap[] = {
+ {TK_FW_NORMAL, "normal"},
+ {TK_FW_NORMAL, "medium"},
+ {TK_FW_NORMAL, "book"},
+ {TK_FW_NORMAL, "light"},
+ {TK_FW_BOLD, "bold"},
+ {TK_FW_BOLD, "demi"},
+ {TK_FW_BOLD, "demibold"},
+ {TK_FW_NORMAL, NULL} /* Assume anything else is "normal". */
+};
+
+static TkStateMap xlfdSlantMap[] = {
+ {TK_FS_ROMAN, "r"},
+ {TK_FS_ITALIC, "i"},
+ {TK_FS_OBLIQUE, "o"},
+ {TK_FS_ROMAN, NULL} /* Assume anything else is "roman". */
+};
+
+static TkStateMap xlfdSetwidthMap[] = {
+ {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",
+ "-size",
+ "-weight",
+ "-slant",
+ "-underline",
+ "-overstrike",
+ NULL
+};
+
+#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 --
+ *
+ * This procedure is called when an application is deleted. It
+ * deletes all the structures that were used by the font package
+ * for this application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+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));
+ hPtr = Tcl_NextHashEntry(&search);
+ }
+ Tcl_DeleteHashTable(&fiPtr->namedTable);
+ if (fiPtr->updatePending != 0) {
+ Tcl_CancelIdleCall(TheWorldHasChanged, (ClientData) fiPtr);
+ }
+ ckfree((char *) fiPtr);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FontObjCmd --
+ *
+ * This procedure is implemented to process the "font" 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_FontObjCmd(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;
+ TkFontInfo *fiPtr;
+ static char *optionStrings[] = {
+ "actual", "configure", "create", "delete",
+ "families", "measure", "metrics", "names",
+ NULL
+ };
+ enum options {
+ FONT_ACTUAL, FONT_CONFIGURE, FONT_CREATE, FONT_DELETE,
+ FONT_FAMILIES, FONT_MEASURE, FONT_METRICS, FONT_NAMES
+ };
+
+ tkwin = (Tk_Window) clientData;
+ fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
+
+ 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 FONT_ACTUAL: {
+ int skip, result;
+ Tk_Font tkfont;
+ Tcl_Obj *objPtr;
+ CONST TkFontAttributes *faPtr;
+
+ 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;
+ faPtr = GetFontAttributes(tkfont);
+ objPtr = NULL;
+ if (objc > 3) {
+ objPtr = objv[3];
+ }
+ result = GetAttributeInfoObj(interp, faPtr, objPtr);
+ Tk_FreeFont(tkfont);
+ return result;
+ }
+ case FONT_CONFIGURE: {
+ int result;
+ char *string;
+ Tcl_Obj *objPtr;
+ 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 {
+ Tcl_DeleteHashEntry(namedHashPtr);
+ ckfree((char *) nfPtr);
+ }
+ }
+ break;
+ }
+ case FONT_FAMILIES: {
+ int skip;
+
+ skip = TkGetDisplayOf(interp, objc - 2, objv + 2, &tkwin);
+ if (skip < 0) {
+ return TCL_ERROR;
+ }
+ if (objc - skip != 2) {
+ Tcl_WrongNumArgs(interp, 2, objv, "?-displayof window?");
+ return TCL_ERROR;
+ }
+ 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
+ * warning. */
+ switch (index) {
+ case 0: i = fmPtr->ascent; break;
+ case 1: i = fmPtr->descent; break;
+ case 2: i = fmPtr->ascent + fmPtr->descent; break;
+ case 3: i = fmPtr->fixed; break;
+ }
+ 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
+TheWorldHasChanged(clientData)
+ ClientData clientData; /* Info about application's fonts. */
+{
+ TkFontInfo *fiPtr;
+
+ fiPtr = (TkFontInfo *) clientData;
+ fiPtr->updatePending = 0;
+
+ RecomputeWidgets(fiPtr->mainPtr->winPtr);
+}
+
+static void
+RecomputeWidgets(winPtr)
+ TkWindow *winPtr; /* Window to which command is sent. */
+{
+ if ((winPtr->classProcsPtr != NULL)
+ && (winPtr->classProcsPtr->geometryProc != NULL)) {
+ (*winPtr->classProcsPtr->geometryProc)(winPtr->instanceData);
+ }
+ for (winPtr = winPtr->childList; winPtr != NULL; winPtr = winPtr->nextPtr) {
+ 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;
+ nfPtr->refCount = 0;
+ nfPtr->deletePending = 0;
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetFont --
+ *
+ * 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
+ * information to set a reasonable tab width).
+ */
+
+ if (fontPtr->tabWidth == 0) {
+ fontPtr->tabWidth = 1;
+ }
+
+ /*
+ * 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.
+ *
+ * Results:
+ * The return value is the description that was passed to
+ * Tk_GetFont() to create the font. The storage for the returned
+ * string is only guaranteed to persist until the font is deleted.
+ * The caller should not modify this string.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+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 --
+ *
+ * Called to release a font allocated by Tk_GetFont().
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with font is decremented, and
+ * only deallocated when no one is using it.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+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 --
+ *
+ * Given a font, return an opaque handle that should be selected
+ * into the XGCValues structure in order to get the constructed
+ * gc to use this font. This procedure would go away if the
+ * XGCValues structure were replaced with a TkGCValues structure.
+ *
+ * Results:
+ * As above.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Font
+Tk_FontId(tkfont)
+ Tk_Font tkfont; /* Font that is going to be selected into GC. */
+{
+ TkFont *fontPtr;
+
+ fontPtr = (TkFont *) tkfont;
+ return fontPtr->fid;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_GetFontMetrics --
+ *
+ * Returns overall ascent and descent metrics for the given font.
+ * These values can be used to space multiple lines of text and
+ * to align the baselines of text in different fonts.
+ *
+ * Results:
+ * If *heightPtr is non-NULL, it is filled with the overall height
+ * of the font, which is the sum of the ascent and descent.
+ * If *ascentPtr or *descentPtr is non-NULL, they are filled with
+ * the ascent and/or descent information for the font.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+void
+Tk_GetFontMetrics(tkfont, fmPtr)
+ Tk_Font tkfont; /* Font in which metrics are calculated. */
+ Tk_FontMetrics *fmPtr; /* Pointer to structure in which font
+ * metrics for tkfont will be stored. */
+{
+ TkFont *fontPtr;
+
+ fontPtr = (TkFont *) tkfont;
+ fmPtr->ascent = fontPtr->fm.ascent;
+ fmPtr->descent = fontPtr->fm.descent;
+ fmPtr->linespace = fontPtr->fm.ascent + fontPtr->fm.descent;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_PostscriptFontName --
+ *
+ * Given a Tk_Font, return the name of the corresponding Postscript
+ * font.
+ *
+ * Results:
+ * The return value is the pointsize of the given Tk_Font.
+ * The name of the Postscript font is appended to dsPtr.
+ *
+ * Side effects:
+ * If the font does not exist on the printer, the print job will
+ * fail at print time. Given a "reasonable" Postscript printer,
+ * the following Tk_Font font families should print correctly:
+ *
+ * Avant Garde, Arial, Bookman, Courier, Courier New, Geneva,
+ * Helvetica, Monaco, New Century Schoolbook, New York,
+ * Palatino, Symbol, Times, Times New Roman, Zapf Chancery,
+ * and Zapf Dingbats.
+ *
+ * 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. */
+{
+ TkFont *fontPtr;
+ char *family, *weightString, *slantString;
+ char *src, *dest;
+ int upper, len;
+
+ len = Tcl_DStringLength(dsPtr);
+ fontPtr = (TkFont *) tkfont;
+
+ /*
+ * Convert the case-insensitive Tk_Font family name to the
+ * case-sensitive Postscript family name. Take out any spaces and
+ * capitalize the first letter of each word.
+ */
+
+ family = fontPtr->fa.family;
+ if (strncasecmp(family, "itc ", 4) == 0) {
+ family = family + 4;
+ }
+ if ((strcasecmp(family, "Arial") == 0)
+ || (strcasecmp(family, "Geneva") == 0)) {
+ family = "Helvetica";
+ } else if ((strcasecmp(family, "Times New Roman") == 0)
+ || (strcasecmp(family, "New York") == 0)) {
+ family = "Times";
+ } else if ((strcasecmp(family, "Courier New") == 0)
+ || (strcasecmp(family, "Monaco") == 0)) {
+ family = "Courier";
+ } 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);
+ family = Tcl_DStringValue(dsPtr) + len;
+ }
+
+ if (strcasecmp(family, "NewCenturySchoolbook") == 0) {
+ Tcl_DStringSetLength(dsPtr, len);
+ Tcl_DStringAppend(dsPtr, "NewCenturySchlbk", -1);
+ family = Tcl_DStringValue(dsPtr) + len;
+ }
+
+ /*
+ * Get the string to use for the weight.
+ */
+
+ weightString = NULL;
+ if (fontPtr->fa.weight == TK_FW_NORMAL) {
+ if (strcmp(family, "Bookman") == 0) {
+ weightString = "Light";
+ } else if (strcmp(family, "AvantGarde") == 0) {
+ weightString = "Book";
+ } else if (strcmp(family, "ZapfChancery") == 0) {
+ weightString = "Medium";
+ }
+ } else {
+ if ((strcmp(family, "Bookman") == 0)
+ || (strcmp(family, "AvantGarde") == 0)) {
+ weightString = "Demi";
+ } else {
+ weightString = "Bold";
+ }
+ }
+
+ /*
+ * Get the string to use for the slant.
+ */
+
+ slantString = NULL;
+ if (fontPtr->fa.slant == TK_FS_ROMAN) {
+ ;
+ } else {
+ if ((strcmp(family, "Helvetica") == 0)
+ || (strcmp(family, "Courier") == 0)
+ || (strcmp(family, "AvantGarde") == 0)) {
+ slantString = "Oblique";
+ } else {
+ slantString = "Italic";
+ }
+ }
+
+ /*
+ * The string "Roman" needs to be added to some fonts that are not bold
+ * and not italic.
+ */
+
+ if ((slantString == NULL) && (weightString == NULL)) {
+ if ((strcmp(family, "Times") == 0)
+ || (strcmp(family, "NewCenturySchlbk") == 0)
+ || (strcmp(family, "Palatino") == 0)) {
+ Tcl_DStringAppend(dsPtr, "-Roman", -1);
+ }
+ } else {
+ Tcl_DStringAppend(dsPtr, "-", -1);
+ if (weightString != NULL) {
+ Tcl_DStringAppend(dsPtr, weightString, -1);
+ }
+ if (slantString != NULL) {
+ Tcl_DStringAppend(dsPtr, slantString, -1);
+ }
+ }
+
+ return fontPtr->fa.pointsize;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_TextWidth --
+ *
+ * A wrapper function for the more complicated interface of
+ * Tk_MeasureChars. Computes how much space the given
+ * simple string needs.
+ *
+ * Results:
+ * The return value is the width (in pixels) of the given string.
+ *
+ * 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 --
+ *
+ * This procedure draws an underline for a given range of characters
+ * in a given string. It doesn't draw the characters (which are
+ * assumed to have been displayed previously); it just draws the
+ * underline. This procedure would mainly be used to quickly
+ * underline a few characters without having to construct an
+ * underlined font. To produce properly underlined text, the
+ * appropriate underlined font should be constructed and used.
+ *
+ * Results:
+ * None.
+ *
+ * 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);
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_ComputeTextLayout --
+ *
+ * Computes the amount of screen space needed to display a
+ * multi-line, justified string of text. Records all the
+ * measurements that were done to determine to size and
+ * positioning of the individual lines of text; this information
+ * can be used by the Tk_DrawTextLayout() procedure to
+ * display the text quickly (without remeasuring it).
+ *
+ * This procedure is useful for simple widgets that want to
+ * display single-font, multi-line text and want Tk to handle the
+ * details.
+ *
+ * Results:
+ * The return value is a Tk_TextLayout token that holds the
+ * measurement information for the given string. The token is
+ * only valid for the given string. If the string is freed,
+ * the token is no longer valid and must also be freed. To free
+ * the token, call Tk_FreeTextLayout().
+ *
+ * The dimensions of the screen area needed to display the text
+ * are stored in *widthPtr and *heightPtr.
+ *
+ * Side effects:
+ * Memory is allocated to hold the measurement information.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+Tk_TextLayout
+Tk_ComputeTextLayout(tkfont, string, numChars, wrapLength, justify, flags,
+ widthPtr, heightPtr)
+ Tk_Font tkfont; /* Font that will be used to display text. */
+ CONST char *string; /* String whose dimensions are to be
+ * computed. */
+ int numChars; /* Number of characters to consider from
+ * string, or < 0 for strlen(). */
+ int wrapLength; /* Longest permissible line length, in
+ * pixels. <= 0 means no automatic wrapping:
+ * just let lines get as long as needed. */
+ Tk_Justify justify; /* How to justify lines. */
+ int flags; /* Flag bits OR-ed together.
+ * TK_IGNORE_TABS means that tab characters
+ * should not be expanded. TK_IGNORE_NEWLINES
+ * 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;
+ }
+ }
+ if (!(flags & TK_IGNORE_TABS)) {
+ if (*special == '\t') {
+ break;
+ }
+ }
+ }
+ }
+
+ /*
+ * 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,
+ baseline)->numDisplayChars = -1;
+ start++;
+ if ((start < end) &&
+ ((wrapLength <= 0) || (newX <= wrapLength))) {
+ /*
+ * More chars can still fit on this line.
+ */
+
+ curX = newX;
+ flags &= ~TK_AT_LEAST_ONE;
+ continue;
+ }
+ } else {
+ NewChunk(&layoutPtr, &maxChunks, start, 1, curX, 1000000000,
+ baseline)->numDisplayChars = -1;
+ start++;
+ goto wrapLine;
+ }
+ }
+
+ /*
+ * 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;
+
+ /*
+ * Save current line length, then move current position to start of
+ * next line.
+ */
+
+ if (curX > maxWidth) {
+ maxWidth = curX;
+ }
+
+ /*
+ * 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;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_FreeTextLayout --
+ *
+ * This procedure is called to release the storage associated with
+ * a Tk_TextLayout when it is no longer needed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_FreeTextLayout(textLayout)
+ Tk_TextLayout textLayout; /* The text layout to be released. */
+{
+ TextLayout *layoutPtr;
+
+ layoutPtr = (TextLayout *) textLayout;
+ if (layoutPtr != NULL) {
+ ckfree((char *) layoutPtr);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_DrawTextLayout --
+ *
+ * Use the information in the Tk_TextLayout token to display a
+ * multi-line, justified string of text.
+ *
+ * This procedure is useful for simple widgets that need to
+ * display single-font, multi-line text and want Tk to handle
+ * the details.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Text drawn on the screen.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_DrawTextLayout(display, drawable, gc, layout, x, y, firstChar, lastChar)
+ Display *display; /* Display on which to draw. */
+ Drawable drawable; /* Window or pixmap in which to draw. */
+ GC gc; /* Graphics context to use for drawing text. */
+ Tk_TextLayout layout; /* Layout information, from a previous call
+ * to Tk_ComputeTextLayout(). */
+ int x, y; /* Upper-left hand corner of rectangle in
+ * which to draw (pixels). */
+ int firstChar; /* The index of the first character to draw
+ * from the given text item. 0 specfies the
+ * 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;
+ }
+ chunkPtr++;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_UnderlineTextLayout --
+ *
+ * Use the information in the Tk_TextLayout token to display an
+ * underline below an individual character. This procedure does
+ * not draw the text, just the underline.
+ *
+ * This procedure is useful for simple widgets that need to
+ * display single-font, multi-line text with an individual
+ * character underlined and want Tk to handle the details.
+ * To display larger amounts of underlined text, construct
+ * and use an underlined font.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Underline drawn on the screen.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+Tk_UnderlineTextLayout(display, drawable, gc, layout, x, y, underline)
+ Display *display; /* Display on which to draw. */
+ Drawable drawable; /* Window or pixmap in which to draw. */
+ GC gc; /* Graphics context to use for drawing text. */
+ Tk_TextLayout layout; /* Layout information, from a previous call
+ * to Tk_ComputeTextLayout(). */
+ int x, y; /* Upper-left hand corner of rectangle in
+ * which to draw (pixels). */
+ int underline; /* Index of the single character to
+ * underline, or -1 for no underline. */
+{
+ TextLayout *layoutPtr;
+ TkFont *fontPtr;
+ int xx, yy, width, height;
+
+ if ((Tk_CharBbox(layout, underline, &xx, &yy, &width, &height) != 0)
+ && (width != 0)) {
+ layoutPtr = (TextLayout *) layout;
+ fontPtr = (TkFont *) layoutPtr->tkfont;
+
+ XFillRectangle(display, drawable, gc, x + xx,
+ y + yy + fontPtr->fm.ascent + fontPtr->underlinePos,
+ (unsigned int) width, (unsigned int) fontPtr->underlineHeight);
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_PointToChar --
+ *
+ * Use the information in the Tk_TextLayout token to determine the
+ * character closest to the given point. The point must be
+ * specified with respect to the upper-left hand corner of the
+ * text layout, which is considered to be located at (0, 0).
+ *
+ * Any point whose y-value is less that 0 will be considered closest
+ * to the first character in the text layout; any point whose y-value
+ * is greater than the height of the text layout will be considered
+ * closest to the last character in the text layout.
+ *
+ * Any point whose x-value is less than 0 will be considered closest
+ * to the first character on that line; any point whose x-value is
+ * greater than the width of the text layout will be considered
+ * closest to the last character on that line.
+ *
+ * Results:
+ * The return value is the index of the character that was
+ * closest to the point. Given a text layout with no characters,
+ * the value 0 will always be returned, referring to a hypothetical
+ * zero-width placeholder character.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_PointToChar(layout, x, y)
+ Tk_TextLayout layout; /* Layout information, from a previous call
+ * to Tk_ComputeTextLayout(). */
+ 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.
+ */
+
+ x = INT_MAX;
+ }
+
+ /*
+ * Examine all chunks on this line to see which one contains
+ * the specified point.
+ */
+
+ lastPtr = chunkPtr;
+ while ((i < layoutPtr->numChunks) && (chunkPtr->y == baseline)) {
+ if (x < chunkPtr->x + chunkPtr->totalWidth) {
+ /*
+ * Point falls on one of the characters in this chunk.
+ */
+
+ 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.
+ */
+
+ return (lastPtr->start + lastPtr->numChars) - layoutPtr->string;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_CharBbox --
+ *
+ * Use the information in the Tk_TextLayout token to return the
+ * bounding box for the character specified by index.
+ *
+ * The width of the bounding box is the advance width of the
+ * character, and does not include and left- or right-bearing.
+ * Any character that extends partially outside of the
+ * text layout is considered to be truncated at the edge. Any
+ * character which is located completely outside of the text
+ * layout is considered to be zero-width and pegged against
+ * the edge.
+ *
+ * The height of the bounding box is the line height for this font,
+ * extending from the top of the ascent to the bottom of the
+ * descent. Information about the actual height of the individual
+ * letter is not available.
+ *
+ * A text layout that contains no characters is considered to
+ * contain a single zero-width placeholder character.
+ *
+ * Results:
+ * The return value is 0 if the index did not specify a character
+ * in the text layout, or non-zero otherwise. In that case,
+ * *bbox is filled with the bounding box of the character.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_CharBbox(layout, index, xPtr, yPtr, widthPtr, heightPtr)
+ Tk_TextLayout layout; /* Layout information, from a previous call to
+ * Tk_ComputeTextLayout(). */
+ int index; /* The index of the character whose bbox is
+ * desired. */
+ int *xPtr, *yPtr; /* Filled with the upper-left hand corner, in
+ * pixels, of the bounding box for the character
+ * specified by index, if non-NULL. */
+ int *widthPtr, *heightPtr;
+ /* Filled with the width and height of the
+ * bounding box for the character specified by
+ * index, if non-NULL. */
+{
+ TextLayout *layoutPtr;
+ LayoutChunk *chunkPtr;
+ int i, x, w;
+ Tk_Font tkfont;
+ TkFont *fontPtr;
+
+ if (index < 0) {
+ if (xPtr)
+ *xPtr = 0;
+ if (yPtr)
+ *yPtr = 0;
+ if (widthPtr)
+ *widthPtr = 0;
+ if (heightPtr)
+ *heightPtr = 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) {
+ /*
+ * Special case to get location just past last char in layout.
+ */
+
+ chunkPtr--;
+ x = chunkPtr->x + chunkPtr->totalWidth;
+ w = 0;
+ } else {
+ return 0;
+ }
+
+ /*
+ * Ensure that the bbox lies within the text layout. This forces all
+ * chars that extend off the right edge of the text layout to have
+ * truncated widths, and all chars that are completely off the right
+ * edge of the text layout to peg to the edge and have 0 width.
+ */
+ check:
+ if (yPtr != NULL) {
+ *yPtr = chunkPtr->y - fontPtr->fm.ascent;
+ }
+ if (heightPtr != NULL) {
+ *heightPtr = fontPtr->fm.ascent + fontPtr->fm.descent;
+ }
+
+ if (x > layoutPtr->width) {
+ x = layoutPtr->width;
+ }
+ if (xPtr != NULL) {
+ *xPtr = x;
+ }
+ if (widthPtr != NULL) {
+ if (x + w > layoutPtr->width) {
+ w = layoutPtr->width - x;
+ }
+ *widthPtr = w;
+ }
+
+ return 1;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_DistanceToTextLayout --
+ *
+ * Computes the distance in pixels from the given point to the
+ * given text layout. Non-displaying space characters that occur
+ * at the end of individual lines in the text layout are ignored
+ * for hit detection purposes.
+ *
+ * Results:
+ * The return value is 0 if the point (x, y) is inside the text
+ * layout. If the point isn't inside the text layout then the
+ * return value is the distance in pixels from the point to the
+ * text item.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_DistanceToTextLayout(layout, x, y)
+ Tk_TextLayout layout; /* Layout information, from a previous call
+ * to Tk_ComputeTextLayout(). */
+ int x, y; /* Coordinates of point to check, with
+ * respect to the upper-left corner of the
+ * text layout (in pixels). */
+{
+ int i, x1, x2, y1, y2, xDiff, yDiff, dist, minDist, ascent, descent;
+ LayoutChunk *chunkPtr;
+ TextLayout *layoutPtr;
+ TkFont *fontPtr;
+
+ layoutPtr = (TextLayout *) layout;
+ fontPtr = (TkFont *) layoutPtr->tkfont;
+ ascent = fontPtr->fm.ascent;
+ descent = fontPtr->fm.descent;
+
+ minDist = 0;
+ chunkPtr = layoutPtr->chunks;
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ if (chunkPtr->start[0] == '\n') {
+ /*
+ * Newline characters are not counted when computing distance
+ * (but tab characters would still be considered).
+ */
+
+ chunkPtr++;
+ continue;
+ }
+
+ x1 = chunkPtr->x;
+ y1 = chunkPtr->y - ascent;
+ x2 = chunkPtr->x + chunkPtr->displayWidth;
+ y2 = chunkPtr->y + descent;
+
+ if (x < x1) {
+ xDiff = x1 - x;
+ } else if (x >= x2) {
+ xDiff = x - x2 + 1;
+ } else {
+ xDiff = 0;
+ }
+
+ if (y < y1) {
+ yDiff = y1 - y;
+ } else if (y >= y2) {
+ yDiff = y - y2 + 1;
+ } else {
+ yDiff = 0;
+ }
+ if ((xDiff == 0) && (yDiff == 0)) {
+ return 0;
+ }
+ dist = (int) hypot((double) xDiff, (double) yDiff);
+ if ((dist < minDist) || (minDist == 0)) {
+ minDist = dist;
+ }
+ chunkPtr++;
+ }
+ return minDist;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_IntersectTextLayout --
+ *
+ * Determines whether a text layout lies entirely inside,
+ * entirely outside, or overlaps a given rectangle. Non-displaying
+ * space characters that occur at the end of individual lines in
+ * the text layout are ignored for intersection calculations.
+ *
+ * Results:
+ * The return value is -1 if the text layout is entirely outside of
+ * the rectangle, 0 if it overlaps, and 1 if it is entirely inside
+ * of the rectangle.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+int
+Tk_IntersectTextLayout(layout, x, y, width, height)
+ Tk_TextLayout layout; /* Layout information, from a previous call
+ * to Tk_ComputeTextLayout(). */
+ int x, y; /* Upper-left hand corner, in pixels, of
+ * rectangular area to compare with text
+ * layout. Coordinates are with respect to
+ * the upper-left hand corner of the text
+ * layout itself. */
+ int width, height; /* The width and height of the above
+ * rectangular area, in pixels. */
+{
+ int result, i, x1, y1, x2, y2;
+ TextLayout *layoutPtr;
+ LayoutChunk *chunkPtr;
+ TkFont *fontPtr;
+ int left, top, right, bottom;
+
+ /*
+ * Scan the chunks one at a time, seeing whether each is entirely in,
+ * entirely out, or overlapping the rectangle. If an overlap is
+ * detected, return immediately; otherwise wait until all chunks have
+ * been processed and see if they were all inside or all outside.
+ */
+
+ layoutPtr = (TextLayout *) layout;
+ chunkPtr = layoutPtr->chunks;
+ fontPtr = (TkFont *) layoutPtr->tkfont;
+
+ left = x;
+ top = y;
+ right = x + width;
+ bottom = y + height;
+
+ result = 0;
+ for (i = 0; i < layoutPtr->numChunks; i++) {
+ if (chunkPtr->start[0] == '\n') {
+ /*
+ * Newline characters are not counted when computing area
+ * intersection (but tab characters would still be considered).
+ */
+
+ chunkPtr++;
+ continue;
+ }
+
+ x1 = chunkPtr->x;
+ y1 = chunkPtr->y - fontPtr->fm.ascent;
+ x2 = chunkPtr->x + chunkPtr->displayWidth;
+ y2 = chunkPtr->y + fontPtr->fm.descent;
+
+ if ((right < x1) || (left >= x2)
+ || (bottom < y1) || (top >= y2)) {
+ if (result == 1) {
+ return 0;
+ }
+ result = -1;
+ } else if ((x1 < left) || (x2 >= right)
+ || (y1 < top) || (y2 >= bottom)) {
+ return 0;
+ } else if (result == -1) {
+ return 0;
+ } else {
+ result = 1;
+ }
+ chunkPtr++;
+ }
+ return result;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * Tk_TextLayoutToPostscript --
+ *
+ * Outputs the contents of a text layout in Postscript format.
+ * The set of lines in the text layout will be rendered by the user
+ * supplied Postscript function. The function should be of the form:
+ *
+ * justify x y string function --
+ *
+ * Justify is -1, 0, or 1, depending on whether the following string
+ * should be left, center, or right justified, x and y is the
+ * location for the origin of the string, string is the sequence
+ * of characters to be printed, and function is the name of the
+ * caller-provided function; the function should leave nothing
+ * on the stack.
+ *
+ * The meaning of the origin of the string (x and y) depends on
+ * the justification. For left justification, x is where the
+ * left edge of the string should appear. For center justification,
+ * x is where the center of the string should appear. And for right
+ * justification, x is where the right edge of the string should
+ * appear. This behavior is necessary because, for example, right
+ * 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
+ * Postscript as part of this sequence.
+ */
+
+ sprintf(buf + used, "\\%03o", c);
+ used += 4;
+ } else {
+ buf[used++] = c;
+ }
+ if (used >= MAXUSE) {
+ buf[used] = '\0';
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ used = 0;
+ }
+ }
+ }
+ if (used >= MAXUSE) {
+ /*
+ * If there are a whole bunch of returns or tabs in a row,
+ * then buf[] could get filled up.
+ */
+
+ buf[used] = '\0';
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ used = 0;
+ }
+ chunkPtr++;
+ }
+ buf[used++] = ')';
+ buf[used++] = '\n';
+ 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
+ * error message will be left in interp's result object.
+ *
+ * Side effects:
+ * The fields of the font attributes structure get filled in with
+ * information from argc/argv. If an error occurs while parsing,
+ * the font attributes structure will contain all modifications
+ * specified in the command line options up to the point of the
+ * error.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+ConfigAttributesObj(interp, tkwin, objc, objv, faPtr)
+ Tcl_Interp *interp; /* Interp for error return. */
+ Tk_Window tkwin; /* For display on which font will be used. */
+ 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;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * GetAttributeInfoObj --
+ *
+ * Return information about the font attributes as a Tcl list.
+ *
+ * Results:
+ * The return value is TCL_OK if the objPtr was non-NULL and
+ * specified a valid font attribute, TCL_ERROR otherwise. If TCL_OK
+ * is returned, the interp's result object is modified to hold a
+ * description of either the current value of a single option, or a
+ * list of all options and their current values for the given font
+ * attributes. If TCL_ERROR is returned, the interp's result is
+ * set to an error message describing that the objPtr did not refer
+ * to a valid option.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+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];
+ }
+ field[XLFD_ADD_STYLE] = NULL;
+ i++;
+ }
+ }
+
+ /*
+ * Bail if we don't have enough of the fields (up to pointsize).
+ */
+
+ if (i < XLFD_FAMILY) {
+ Tcl_DStringFree(&ds);
+ return TCL_ERROR;
+ }
+
+ 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.
+ */
+
+ if (FieldSpecified(field[XLFD_PIXEL_SIZE])) {
+ if (field[XLFD_PIXEL_SIZE][0] == '[') {
+ /*
+ * Some X fonts have the pixel size specified as follows:
+ *
+ * [ 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;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * FieldSpecified --
+ *
+ * Helper function for TkParseXLFD(). Determines if a field in the
+ * XLFD was set to a non-null, non-don't-care value.
+ *
+ * Results:
+ * The return value is 0 if the field in the XLFD was not set and
+ * should be ignored, non-zero otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+FieldSpecified(field)
+ CONST char *field; /* The field of the XLFD to check. Strictly
+ * speaking, only when the string is "*" does it mean
+ * don't-care. However, an unspecified or question
+ * mark is also interpreted as don't-care. */
+{
+ char ch;
+
+ if (field == NULL) {
+ return 0;
+ }
+ 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;
+}
+
+/* CYGNUS LOCAL: This routine is called on Windows to update a named
+ font to a possibly new set of font attributes. */
+
+void
+TkUpdateFonts(tkwin, changed)
+ Tk_Window tkwin;
+ int (*changed) _ANSI_ARGS_((TkFontAttributes *faPtr));
+{
+ TkFontInfo *fiPtr;
+ Tcl_HashEntry *namedHashPtr;
+ Tcl_HashSearch search;
+ NamedFont *nfPtr;
+
+ fiPtr = ((TkWindow *) tkwin)->mainPtr->fontInfoPtr;
+
+ namedHashPtr = Tcl_FirstHashEntry(&fiPtr->namedTable, &search);
+ while (namedHashPtr != NULL) {
+ nfPtr = (NamedFont *) Tcl_GetHashValue(namedHashPtr);
+ if ((*changed)(&nfPtr->fa)) {
+ UpdateDependantFonts(fiPtr, tkwin, namedHashPtr);
+ }
+ namedHashPtr = Tcl_NextHashEntry(&search);
+ }
+}
diff --git a/tk/generic/tkFont.h b/tk/generic/tkFont.h
new file mode 100644
index 00000000000..7bd9928fbea
--- /dev/null
+++ b/tk/generic/tkFont.h
@@ -0,0 +1,220 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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. 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;
+
+/*
+ * Possible values for the "weight" field in a TkFontAttributes structure.
+ * Weight is a subjective term and depends on what the company that created
+ * the font considers bold.
+ */
+
+#define TK_FW_NORMAL 0
+#define TK_FW_BOLD 1
+
+#define TK_FW_UNKNOWN -1 /* Unknown weight. This value is used for
+ * error checking and is never actually stored
+ * in the weight field. */
+
+/*
+ * Possible values for the "slant" field in a TkFontAttributes structure.
+ */
+
+#define TK_FS_ROMAN 0
+#define TK_FS_ITALIC 1
+#define TK_FS_OBLIQUE 2 /* This value is only used when parsing X
+ * font names to determine the closest
+ * match. It is only stored in the
+ * XLFDAttributes structure, never in the
+ * slant field of the TkFontAttributes. */
+
+#define TK_FS_UNKNOWN -1 /* Unknown slant. This value is used for
+ * error checking and is never actually stored
+ * in the slant field. */
+
+/*
+ * The following structure keeps track of the metrics for an instantiated
+ * font. The metrics are the physical properties of the font itself.
+ */
+
+typedef struct TkFontMetrics {
+ int ascent; /* From baseline to top of font. */
+ int descent; /* From baseline to bottom of font. */
+ int maxWidth; /* Width of widest character in font. */
+ int fixed; /* Non-zero if this is a fixed-width font,
+ * 0 otherwise. */
+} TkFontMetrics;
+
+/*
+ * The following structure is used to keep track of the generic information
+ * about a font. Each platform-specific font is represented by a structure
+ * with the following structure at its beginning, plus any platform-
+ * specific stuff after that.
+ */
+
+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));
+
+/* CYGNUS LOCAL */
+EXTERN void TkUpdateFonts _ANSI_ARGS_((Tk_Window tkwin,
+ int (*changed) (TkFontAttributes *faPtr)));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKFONT */
diff --git a/tk/generic/tkFrame.c b/tk/generic/tkFrame.c
new file mode 100644
index 00000000000..ded4e4ca4bd
--- /dev/null
+++ b/tk/generic/tkFrame.c
@@ -0,0 +1,939 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "default.h"
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * A data structure of the following type is kept for each
+ * frame that currently exists for this process:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the frame. 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 widget. Used
+ * to delete widget command. */
+ Tcl_Command widgetCmd; /* Token for frame's widget command. */
+ char *className; /* Class name for widget (from configuration
+ * option). Malloc-ed. */
+ int mask; /* Either FRAME or TOPLEVEL; used to select
+ * which configuration options are valid for
+ * widget. */
+ char *screenName; /* Screen on which widget is created. Non-null
+ * only for top-levels. Malloc-ed, may be
+ * NULL. */
+ char *visualName; /* Textual description of visual for window,
+ * from -visual option. Malloc-ed, may be
+ * NULL. */
+ char *colormapName; /* Textual description of colormap for window,
+ * from -colormap option. Malloc-ed, may be
+ * NULL. */
+ char *menuName; /* Textual description of menu to use for
+ * menubar. Malloc-ed, may be NULL. */
+ Colormap colormap; /* If not None, identifies a colormap
+ * allocated for this window, which must be
+ * freed when the window is deleted. */
+ Tk_3DBorder border; /* Structure used to draw 3-D border and
+ * background. NULL means no background
+ * or border. */
+ int borderWidth; /* Width of 3-D border (if any). */
+ 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. */
+ XColor *highlightBgColorPtr;
+ /* Color for drawing traversal highlight
+ * area when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ int width; /* Width to request for window. <= 0 means
+ * don't request any size. */
+ int height; /* Height to request for window. <= 0 means
+ * don't request any size. */
+ 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 isContainer; /* 1 means this window is a container, 0 means
+ * that it isn't. */
+ char *useThis; /* If the window is embedded, this points to
+ * the name of the window in which it is
+ * embedded (malloc'ed). For non-embedded
+ * windows this is NULL. */
+ int flags; /* Various flags; see below for
+ * definitions. */
+} Frame;
+
+/*
+ * Flag bits for frames:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler
+ * has already been queued to redraw
+ * this window.
+ * GOT_FOCUS: Non-zero means this widget currently
+ * has the input focus.
+ */
+
+#define REDRAW_PENDING 1
+#define GOT_FOCUS 4
+
+/*
+ * The following flag bits are used so that there can be separate
+ * defaults for some configuration options for frames and toplevels.
+ */
+
+#define FRAME TK_CONFIG_USER_BIT
+#define TOPLEVEL (TK_CONFIG_USER_BIT << 1)
+#define BOTH (FRAME | TOPLEVEL)
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_FRAME_BG_COLOR, Tk_Offset(Frame, border),
+ BOTH|TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_FRAME_BG_MONO, Tk_Offset(Frame, border),
+ BOTH|TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_SYNONYM, "-bd", "borderWidth", (char *) NULL,
+ (char *) NULL, 0, BOTH},
+ {TK_CONFIG_SYNONYM, "-bg", "background", (char *) NULL,
+ (char *) NULL, 0, BOTH},
+ {TK_CONFIG_PIXELS, "-borderwidth", "borderWidth", "BorderWidth",
+ DEF_FRAME_BORDER_WIDTH, Tk_Offset(Frame, borderWidth), BOTH},
+ {TK_CONFIG_STRING, "-class", "class", "Class",
+ DEF_FRAME_CLASS, Tk_Offset(Frame, className), FRAME},
+ {TK_CONFIG_STRING, "-class", "class", "Class",
+ DEF_TOPLEVEL_CLASS, Tk_Offset(Frame, className), TOPLEVEL},
+ {TK_CONFIG_STRING, "-colormap", "colormap", "Colormap",
+ DEF_FRAME_COLORMAP, Tk_Offset(Frame, colormapName),
+ BOTH|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-container", "container", "Container",
+ DEF_FRAME_CONTAINER, Tk_Offset(Frame, isContainer), BOTH},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_FRAME_CURSOR, Tk_Offset(Frame, cursor), BOTH|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-height", "height", "Height",
+ DEF_FRAME_HEIGHT, Tk_Offset(Frame, height), BOTH},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_FRAME_HIGHLIGHT_BG,
+ Tk_Offset(Frame, highlightBgColorPtr), BOTH},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_FRAME_HIGHLIGHT, Tk_Offset(Frame, highlightColorPtr), BOTH},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_FRAME_HIGHLIGHT_WIDTH, Tk_Offset(Frame, highlightWidth), BOTH},
+ {TK_CONFIG_STRING, "-menu", "menu", "Menu",
+ DEF_TOPLEVEL_MENU, Tk_Offset(Frame, menuName),
+ TOPLEVEL|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_FRAME_RELIEF, Tk_Offset(Frame, relief), BOTH},
+ {TK_CONFIG_STRING, "-screen", "screen", "Screen",
+ DEF_TOPLEVEL_SCREEN, Tk_Offset(Frame, screenName),
+ TOPLEVEL|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_FRAME_TAKE_FOCUS, Tk_Offset(Frame, takeFocus),
+ BOTH|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-use", "use", "Use",
+ DEF_FRAME_USE, Tk_Offset(Frame, useThis), TOPLEVEL|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-visual", "visual", "Visual",
+ DEF_FRAME_VISUAL, Tk_Offset(Frame, visualName),
+ BOTH|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-width", "width", "Width",
+ DEF_FRAME_WIDTH, Tk_Offset(Frame, width), BOTH},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int ConfigureFrame _ANSI_ARGS_((Tcl_Interp *interp,
+ Frame *framePtr, int argc, char **argv,
+ int flags));
+static void DestroyFrame _ANSI_ARGS_((char *memPtr));
+static void DisplayFrame _ANSI_ARGS_((ClientData clientData));
+static void FrameCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void FrameEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int FrameWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void MapFrame _ANSI_ARGS_((ClientData clientData));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_FrameCmd, Tk_ToplevelCmd --
+ *
+ * These procedures are invoked to process the "frame" and
+ * "toplevel" Tcl commands. See the user documentation for
+ * details on what they do.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation. These procedures are just wrappers;
+ * they call ButtonCreate to do all of the real work.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_FrameCmd(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 TkCreateFrame(clientData, interp, argc, argv, 0, (char *) NULL);
+}
+
+int
+Tk_ToplevelCmd(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 TkCreateFrame(clientData, interp, argc, argv, 1, (char *) NULL);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkFrameCreate --
+ *
+ * This procedure is invoked to process the "frame" and "toplevel"
+ * Tcl commands; it is also invoked directly by Tk_Init to create
+ * a new main window. See the user documentation for the "frame"
+ * and "toplevel" commands for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkCreateFrame(clientData, interp, argc, argv, toplevel, appName)
+ ClientData clientData; /* Main window associated with interpreter.
+ * If we're called by Tk_Init to create a
+ * new application, then this is NULL. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+ int toplevel; /* Non-zero means create a toplevel window,
+ * zero means create a frame. */
+ char *appName; /* Should only be non-NULL if clientData is
+ * NULL: gives the base name to use for the
+ * new application. */
+{
+ Tk_Window tkwin = (Tk_Window) clientData;
+ Frame *framePtr;
+ Tk_Window new;
+ char *className, *screenName, *visualName, *colormapName, *arg, *useOption;
+ int i, c, length, depth;
+ unsigned int mask;
+ Colormap colormap;
+ Visual *visual;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " pathName ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Pre-process the argument list. Scan through it to find any
+ * "-class", "-screen", "-visual", and "-colormap" options. These
+ * arguments need to be processed specially, before the window
+ * is configured using the usual Tk mechanisms.
+ */
+
+ className = colormapName = screenName = visualName = useOption = NULL;
+ colormap = None;
+ for (i = 2; i < argc; i += 2) {
+ arg = argv[i];
+ length = strlen(arg);
+ if (length < 2) {
+ continue;
+ }
+ c = arg[1];
+ if ((c == 'c') && (strncmp(arg, "-class", strlen(arg)) == 0)
+ && (length >= 3)) {
+ className = argv[i+1];
+ } else if ((c == 'c')
+ && (strncmp(arg, "-colormap", strlen(arg)) == 0)) {
+ colormapName = argv[i+1];
+ } else if ((c == 's') && toplevel
+ && (strncmp(arg, "-screen", strlen(arg)) == 0)) {
+ screenName = argv[i+1];
+ } else if ((c == 'u') && toplevel
+ && (strncmp(arg, "-use", strlen(arg)) == 0)) {
+ useOption = argv[i+1];
+ } else if ((c == 'v')
+ && (strncmp(arg, "-visual", strlen(arg)) == 0)) {
+ visualName = argv[i+1];
+ }
+ }
+
+ /*
+ * Create the window, and deal with the special options -use,
+ * -classname, -colormap, -screenname, and -visual. These options
+ * must be handle before calling ConfigureFrame below, and they must
+ * also be processed in a particular order, for the following
+ * reasons:
+ * 1. Must set the window's class before calling ConfigureFrame,
+ * so that unspecified options are looked up in the option
+ * database using the correct class.
+ * 2. Must set visual information before calling ConfigureFrame
+ * so that colors are allocated in a proper colormap.
+ * 3. Must call TkpUseWindow before setting non-default visual
+ * information, since TkpUseWindow changes the defaults.
+ */
+
+ if (screenName == NULL) {
+ screenName = (toplevel) ? "" : NULL;
+ }
+ if (tkwin != NULL) {
+ new = Tk_CreateWindowFromPath(interp, tkwin, argv[1], screenName);
+ } else {
+ /*
+ * We were called from Tk_Init; create a new application.
+ */
+
+ if (appName == NULL) {
+ panic("TkCreateFrame didn't get application name");
+ }
+ new = TkCreateMainWindow(interp, screenName, appName);
+ }
+ if (new == NULL) {
+ goto error;
+ }
+ if (className == NULL) {
+ className = Tk_GetOption(new, "class", "Class");
+ if (className == NULL) {
+ className = (toplevel) ? "Toplevel" : "Frame";
+ }
+ }
+ Tk_SetClass(new, className);
+ if (useOption == NULL) {
+ useOption = Tk_GetOption(new, "use", "Use");
+ }
+ if (useOption != NULL) {
+ if (TkpUseWindow(interp, new, useOption) != TCL_OK) {
+ goto error;
+ }
+ }
+ if (visualName == NULL) {
+ visualName = Tk_GetOption(new, "visual", "Visual");
+ }
+ if (colormapName == NULL) {
+ colormapName = Tk_GetOption(new, "colormap", "Colormap");
+ }
+ if (visualName != NULL) {
+ visual = Tk_GetVisual(interp, new, visualName, &depth,
+ (colormapName == NULL) ? &colormap : (Colormap *) NULL);
+ if (visual == NULL) {
+ goto error;
+ }
+ Tk_SetWindowVisual(new, visual, depth, colormap);
+ }
+ if (colormapName != NULL) {
+ colormap = Tk_GetColormap(interp, new, colormapName);
+ if (colormap == None) {
+ goto error;
+ }
+ Tk_SetWindowColormap(new, colormap);
+ }
+
+ /*
+ * For top-level windows, provide an initial geometry request of
+ * 200x200, just so the window looks nicer on the screen if it
+ * doesn't request a size for itself.
+ */
+
+ if (toplevel) {
+ Tk_GeometryRequest(new, 200, 200);
+ }
+
+ /*
+ * Create the widget record, process configuration options, and
+ * create event handlers. Then fill in a few additional fields
+ * in the widget record from the special options.
+ */
+
+ framePtr = (Frame *) ckalloc(sizeof(Frame));
+ framePtr->tkwin = new;
+ framePtr->display = Tk_Display(new);
+ framePtr->interp = interp;
+ framePtr->widgetCmd = Tcl_CreateCommand(interp,
+ Tk_PathName(new), FrameWidgetCmd,
+ (ClientData) framePtr, FrameCmdDeletedProc);
+ framePtr->className = NULL;
+ framePtr->mask = (toplevel) ? TOPLEVEL : FRAME;
+ framePtr->screenName = NULL;
+ framePtr->visualName = NULL;
+ framePtr->colormapName = NULL;
+ framePtr->colormap = colormap;
+ framePtr->border = NULL;
+ framePtr->borderWidth = 0;
+ framePtr->relief = TK_RELIEF_FLAT;
+ framePtr->highlightWidth = 0;
+ framePtr->highlightBgColorPtr = NULL;
+ framePtr->highlightColorPtr = NULL;
+ framePtr->width = 0;
+ framePtr->height = 0;
+ framePtr->cursor = None;
+ framePtr->takeFocus = NULL;
+ framePtr->isContainer = 0;
+ framePtr->useThis = NULL;
+ framePtr->flags = 0;
+ framePtr->menuName = NULL;
+
+ /*
+ * Store backreference to frame widget in window structure.
+ */
+ TkSetClassProcs(new, NULL, (ClientData) framePtr);
+
+ mask = ExposureMask | StructureNotifyMask | FocusChangeMask;
+ if (toplevel) {
+ mask |= ActivateMask;
+ }
+ Tk_CreateEventHandler(new, mask, FrameEventProc, (ClientData) framePtr);
+ if (ConfigureFrame(interp, framePtr, argc-2, argv+2, 0) != TCL_OK) {
+ goto error;
+ }
+ if ((framePtr->isContainer)) {
+ if (framePtr->useThis == NULL) {
+ TkpMakeContainer(framePtr->tkwin);
+ } else {
+ Tcl_AppendResult(interp,"A window cannot have both the -use ",
+ "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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FrameWidgetCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a frame widget. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+FrameWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about frame widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register Frame *framePtr = (Frame *) clientData;
+ int result;
+ size_t length;
+ int c, i;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) framePtr);
+ 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;
+ goto done;
+ }
+ result = Tk_ConfigureValue(interp, framePtr->tkwin, configSpecs,
+ (char *) framePtr, argv[2], framePtr->mask);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, framePtr->tkwin, configSpecs,
+ (char *) framePtr, (char *) NULL, framePtr->mask);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, framePtr->tkwin, configSpecs,
+ (char *) framePtr, argv[2], framePtr->mask);
+ } else {
+ /*
+ * Don't allow the options -class, -colormap, -container,
+ * -newcmap, -screen, -use, or -visual to be changed.
+ */
+
+ for (i = 2; i < argc; i++) {
+ length = strlen(argv[i]);
+ if (length < 2) {
+ continue;
+ }
+ c = argv[i][1];
+ if (((c == 'c') && (strncmp(argv[i], "-class", length) == 0)
+ && (length >= 2))
+ || ((c == 'c') && (framePtr->mask == TOPLEVEL)
+ && (strncmp(argv[i], "-colormap", length) == 0)
+ && (length >= 3))
+ || ((c == 'c')
+ && (strncmp(argv[i], "-container", length) == 0)
+ && (length >= 3))
+ || ((c == 's') && (framePtr->mask == TOPLEVEL)
+ && (strncmp(argv[i], "-screen", length) == 0))
+ || ((c == 'u') && (framePtr->mask == TOPLEVEL)
+ && (strncmp(argv[i], "-use", length) == 0))
+ || ((c == 'v') && (framePtr->mask == TOPLEVEL)
+ && (strncmp(argv[i], "-visual", length) == 0))) {
+ Tcl_AppendResult(interp, "can't modify ", argv[i],
+ " option after widget is created", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+ result = ConfigureFrame(interp, framePtr, 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;
+ }
+
+ done:
+ Tcl_Release((ClientData) framePtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyFrame --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a frame at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the frame is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyFrame(memPtr)
+ char *memPtr; /* Info about frame widget. */
+{
+ register Frame *framePtr = (Frame *) memPtr;
+
+ Tk_FreeOptions(configSpecs, (char *) framePtr, framePtr->display,
+ framePtr->mask);
+ if (framePtr->colormap != None) {
+ Tk_FreeColormap(framePtr->display, framePtr->colormap);
+ }
+ ckfree((char *) framePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureFrame --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureFrame(interp, framePtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register Frame *framePtr; /* 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. */
+{
+ char *oldMenuName;
+
+ /*
+ * Need the old menubar name for the menu code to delete it.
+ */
+
+ if (framePtr->menuName == NULL) {
+ oldMenuName = NULL;
+ } else {
+ oldMenuName = ckalloc(strlen(framePtr->menuName) + 1);
+ strcpy(oldMenuName, framePtr->menuName);
+ }
+
+ if (Tk_ConfigureWidget(interp, framePtr->tkwin, configSpecs,
+ argc, argv, (char *) framePtr, flags | framePtr->mask) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (((oldMenuName == NULL) && (framePtr->menuName != NULL))
+ || ((oldMenuName != NULL) && (framePtr->menuName == NULL))
+ || ((oldMenuName != NULL) && (framePtr->menuName != NULL)
+ && strcmp(oldMenuName, framePtr->menuName) != 0)) {
+ TkSetWindowMenuBar(interp, framePtr->tkwin, oldMenuName,
+ framePtr->menuName);
+ }
+
+ if (framePtr->border != NULL) {
+ Tk_SetBackgroundFromBorder(framePtr->tkwin, framePtr->border);
+ } else {
+ Tk_SetWindowBackgroundPixmap(framePtr->tkwin, None);
+ }
+
+ if (framePtr->highlightWidth < 0) {
+ framePtr->highlightWidth = 0;
+ }
+ Tk_SetInternalBorder(framePtr->tkwin,
+ framePtr->borderWidth + framePtr->highlightWidth);
+ if ((framePtr->width > 0) || (framePtr->height > 0)) {
+ Tk_GeometryRequest(framePtr->tkwin, framePtr->width,
+ framePtr->height);
+ }
+
+ if (oldMenuName != NULL) {
+ ckfree(oldMenuName);
+ }
+
+ if (Tk_IsMapped(framePtr->tkwin)) {
+ if (!(framePtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayFrame, (ClientData) framePtr);
+ }
+ framePtr->flags |= REDRAW_PENDING;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayFrame --
+ *
+ * This procedure is invoked to display a frame widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the frame in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayFrame(clientData)
+ ClientData clientData; /* Information about widget. */
+{
+ register Frame *framePtr = (Frame *) clientData;
+ register Tk_Window tkwin = framePtr->tkwin;
+ GC gc;
+
+ framePtr->flags &= ~REDRAW_PENDING;
+ if ((framePtr->tkwin == NULL) || !Tk_IsMapped(tkwin)
+ || framePtr->isContainer) {
+ return;
+ }
+
+ if (framePtr->border != NULL) {
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin),
+ framePtr->border, framePtr->highlightWidth,
+ framePtr->highlightWidth,
+ Tk_Width(tkwin) - 2*framePtr->highlightWidth,
+ Tk_Height(tkwin) - 2*framePtr->highlightWidth,
+ framePtr->borderWidth, framePtr->relief);
+ }
+ if (framePtr->highlightWidth != 0) {
+ if (framePtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(framePtr->highlightColorPtr,
+ Tk_WindowId(tkwin));
+ } else {
+ gc = Tk_GCForColor(framePtr->highlightBgColorPtr,
+ Tk_WindowId(tkwin));
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, framePtr->highlightWidth,
+ Tk_WindowId(tkwin));
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * FrameEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher on
+ * structure changes to a frame. For frames with 3D
+ * borders, this procedure is also invoked for exposures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+FrameEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ register XEvent *eventPtr; /* Information about event. */
+{
+ register Frame *framePtr = (Frame *) clientData;
+
+ if (((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0))
+ || (eventPtr->type == ConfigureNotify)) {
+ goto redraw;
+ } else if (eventPtr->type == DestroyNotify) {
+ if (framePtr->menuName != NULL) {
+ TkSetWindowMenuBar(framePtr->interp, framePtr->tkwin,
+ framePtr->menuName, NULL);
+ ckfree(framePtr->menuName);
+ framePtr->menuName = NULL;
+ }
+ if (framePtr->tkwin != NULL) {
+
+ /*
+ * If this window is a container, then this event could be
+ * coming from the embedded application, in which case
+ * Tk_DestroyWindow hasn't been called yet. When Tk_DestroyWindow
+ * is called later, then another destroy event will be generated.
+ * We need to be sure we ignore the second event, since the frame
+ * could be gone by then. To do so, delete the event handler
+ * explicitly (normally it's done implicitly by Tk_DestroyWindow).
+ */
+
+ Tk_DeleteEventHandler(framePtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ FrameEventProc, (ClientData) framePtr);
+ framePtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(framePtr->interp, framePtr->widgetCmd);
+ }
+ if (framePtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayFrame, (ClientData) framePtr);
+ }
+ Tcl_CancelIdleCall(MapFrame, (ClientData) framePtr);
+ Tcl_EventuallyFree((ClientData) framePtr, DestroyFrame);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ framePtr->flags |= GOT_FOCUS;
+ if (framePtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ framePtr->flags &= ~GOT_FOCUS;
+ if (framePtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ } else if (eventPtr->type == ActivateNotify) {
+ TkpSetMainMenubar(framePtr->interp, framePtr->tkwin,
+ framePtr->menuName);
+ }
+ return;
+
+ redraw:
+ if ((framePtr->tkwin != NULL) && !(framePtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayFrame, (ClientData) framePtr);
+ framePtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FrameCmdDeletedProc --
+ *
+ * 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
+FrameCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ Frame *framePtr = (Frame *) clientData;
+ Tk_Window tkwin = framePtr->tkwin;
+
+ if (framePtr->menuName != NULL) {
+ TkSetWindowMenuBar(framePtr->interp, framePtr->tkwin,
+ framePtr->menuName, NULL);
+ ckfree(framePtr->menuName);
+ framePtr->menuName = NULL;
+ }
+
+ /*
+ * 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) {
+ framePtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MapFrame --
+ *
+ * This procedure is invoked as a when-idle handler to map a
+ * newly-created top-level frame.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The frame given by the clientData argument is mapped.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MapFrame(clientData)
+ ClientData clientData; /* Pointer to frame structure. */
+{
+ Frame *framePtr = (Frame *) clientData;
+
+ /*
+ * Wait for all other background events to be processed before
+ * mapping window. This ensures that the window's correct geometry
+ * will have been determined before it is first mapped, so that the
+ * window manager doesn't get a false idea of its desired geometry.
+ */
+
+ Tcl_Preserve((ClientData) framePtr);
+ while (1) {
+ if (Tcl_DoOneEvent(TCL_IDLE_EVENTS) == 0) {
+ break;
+ }
+
+ /*
+ * After each event, make sure that the window still exists
+ * and quit if the window has been destroyed.
+ */
+
+ if (framePtr->tkwin == NULL) {
+ Tcl_Release((ClientData) framePtr);
+ return;
+ }
+ }
+ Tk_MapWindow(framePtr->tkwin);
+ Tcl_Release((ClientData) framePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkInstallFrameMenu --
+ *
+ * This function is needed when a Windows HWND is created
+ * and a menubar has been set to the window with a system
+ * menu. It notifies the menu package so that the system
+ * menu can be rebuilt.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The system menu (if any) is created for the menubar
+ * associated with this frame.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkInstallFrameMenu(tkwin)
+ Tk_Window tkwin; /* The window that was just created. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (winPtr->mainPtr != NULL) {
+ Frame *framePtr;
+ framePtr = (Frame*) winPtr->instanceData;
+ TkpMenuNotifyToplevelCreate(winPtr->mainPtr->interp,
+ framePtr->menuName);
+ }
+}
diff --git a/tk/generic/tkGC.c b/tk/generic/tkGC.c
new file mode 100644
index 00000000000..9d1c6949009
--- /dev/null
+++ b/tk/generic/tkGC.c
@@ -0,0 +1,431 @@
+/*
+ * 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$
+ */
+
+#include "tkPort.h"
+#include "tk.h"
+
+/* CYGNUS LOCAL, for TkRegisterColorGC. */
+#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). */
+ /* CYGNUS LOCAL. */
+ XColor *foreground; /* Foreground color. */
+ XColor *background; /* Background color. */
+} 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. */
+ /* CYGNUS LOCAL. */
+ XColor *foreground; /* Foreground color. */
+ XColor *background; /* Background color. */
+} 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
+ * a read-only graphics context with the desired values.
+ *
+ * Results:
+ * The return value is the X identifer for the desired graphics
+ * context. The caller should never modify this GC, and should
+ * call Tk_FreeGC when the GC is no longer needed.
+ *
+ * Side effects:
+ * The GC is added to an internal database with a reference count.
+ * For each call to this procedure, there should eventually be a call
+ * to Tk_FreeGC, so that the database can be cleaned up when GC's
+ * aren't needed anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+/* CYGNUS LOCAL: Rename this to Tk_GetGCColor. The new Tk_GetGC is
+ below. */
+
+GC
+Tk_GetGCColor(tkwin, valueMask, valuePtr, foreground, background)
+ Tk_Window tkwin; /* Window in which GC will be used. */
+ register unsigned long valueMask;
+ /* 1 bits correspond to values specified
+ * in *valuesPtr; other values are set
+ * from defaults. */
+ register XGCValues *valuePtr;
+ /* Values are specified here for bits set
+ * in valueMask. */
+ /* CYGNUS LOCAL. */
+ XColor *foreground; /* Foreground color. */
+ XColor *background; /* Background color. */
+{
+ ValueKey valueKey;
+ IdKey idKey;
+ Tcl_HashEntry *valueHashPtr, *idHashPtr;
+ register TkGC *gcPtr;
+ int new;
+ Drawable d, freeDrawable;
+
+ if (!initialized) {
+ GCInit();
+ }
+
+#if !defined(__WIN32__) && !defined(_WIN32)
+ /* CYGNUS LOCAL. We only care about special foreground and
+ background colors on Windows. If we are on some other
+ platform, just ignore them. If we don't do this, we may
+ allocate an unnecessary GC if we have two colors with different
+ names but the same pixel value. */
+ foreground = NULL;
+ background = NULL;
+#endif
+
+ /*
+ * Must zero valueKey at start to clear out pad bytes that may be
+ * part of structure on some systems.
+ */
+
+ memset((VOID *) &valueKey, 0, sizeof(valueKey));
+
+ /*
+ * First, check to see if there's already a GC that will work
+ * for this request (exact matches only, sorry).
+ */
+
+ if (valueMask & GCFunction) {
+ valueKey.values.function = valuePtr->function;
+ } else {
+ valueKey.values.function = GXcopy;
+ }
+ if (valueMask & GCPlaneMask) {
+ valueKey.values.plane_mask = valuePtr->plane_mask;
+ } else {
+ valueKey.values.plane_mask = (unsigned) ~0;
+ }
+ if (valueMask & GCForeground) {
+ valueKey.values.foreground = valuePtr->foreground;
+ } else {
+ valueKey.values.foreground = 0;
+ }
+ if (valueMask & GCBackground) {
+ valueKey.values.background = valuePtr->background;
+ } else {
+ valueKey.values.background = 1;
+ }
+ if (valueMask & GCLineWidth) {
+ valueKey.values.line_width = valuePtr->line_width;
+ } else {
+ valueKey.values.line_width = 0;
+ }
+ if (valueMask & GCLineStyle) {
+ valueKey.values.line_style = valuePtr->line_style;
+ } else {
+ valueKey.values.line_style = LineSolid;
+ }
+ if (valueMask & GCCapStyle) {
+ valueKey.values.cap_style = valuePtr->cap_style;
+ } else {
+ valueKey.values.cap_style = CapButt;
+ }
+ if (valueMask & GCJoinStyle) {
+ valueKey.values.join_style = valuePtr->join_style;
+ } else {
+ valueKey.values.join_style = JoinMiter;
+ }
+ if (valueMask & GCFillStyle) {
+ valueKey.values.fill_style = valuePtr->fill_style;
+ } else {
+ valueKey.values.fill_style = FillSolid;
+ }
+ if (valueMask & GCFillRule) {
+ valueKey.values.fill_rule = valuePtr->fill_rule;
+ } else {
+ valueKey.values.fill_rule = EvenOddRule;
+ }
+ if (valueMask & GCArcMode) {
+ valueKey.values.arc_mode = valuePtr->arc_mode;
+ } else {
+ valueKey.values.arc_mode = ArcPieSlice;
+ }
+ if (valueMask & GCTile) {
+ valueKey.values.tile = valuePtr->tile;
+ } else {
+ valueKey.values.tile = None;
+ }
+ if (valueMask & GCStipple) {
+ valueKey.values.stipple = valuePtr->stipple;
+ } else {
+ valueKey.values.stipple = None;
+ }
+ if (valueMask & GCTileStipXOrigin) {
+ valueKey.values.ts_x_origin = valuePtr->ts_x_origin;
+ } else {
+ valueKey.values.ts_x_origin = 0;
+ }
+ if (valueMask & GCTileStipYOrigin) {
+ valueKey.values.ts_y_origin = valuePtr->ts_y_origin;
+ } else {
+ valueKey.values.ts_y_origin = 0;
+ }
+ if (valueMask & GCFont) {
+ valueKey.values.font = valuePtr->font;
+ } else {
+ valueKey.values.font = None;
+ }
+ if (valueMask & GCSubwindowMode) {
+ valueKey.values.subwindow_mode = valuePtr->subwindow_mode;
+ } else {
+ valueKey.values.subwindow_mode = ClipByChildren;
+ }
+ if (valueMask & GCGraphicsExposures) {
+ valueKey.values.graphics_exposures = valuePtr->graphics_exposures;
+ } else {
+ valueKey.values.graphics_exposures = True;
+ }
+ if (valueMask & GCClipXOrigin) {
+ valueKey.values.clip_x_origin = valuePtr->clip_x_origin;
+ } else {
+ valueKey.values.clip_x_origin = 0;
+ }
+ if (valueMask & GCClipYOrigin) {
+ valueKey.values.clip_y_origin = valuePtr->clip_y_origin;
+ } else {
+ valueKey.values.clip_y_origin = 0;
+ }
+ if (valueMask & GCClipMask) {
+ valueKey.values.clip_mask = valuePtr->clip_mask;
+ } else {
+ valueKey.values.clip_mask = None;
+ }
+ if (valueMask & GCDashOffset) {
+ valueKey.values.dash_offset = valuePtr->dash_offset;
+ } else {
+ valueKey.values.dash_offset = 0;
+ }
+ if (valueMask & GCDashList) {
+ 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);
+
+ /* CYGNUS LOCAL. Set colors. */
+ valueKey.foreground = foreground;
+ valueKey.background = background;
+
+ valueHashPtr = Tcl_CreateHashEntry(&valueTable, (char *) &valueKey, &new);
+ if (!new) {
+ gcPtr = (TkGC *) Tcl_GetHashValue(valueHashPtr);
+ gcPtr->refCount++;
+ return gcPtr->gc;
+ }
+
+ /*
+ * No GC is currently available for this set of values. Allocate a
+ * new GC and add a new structure to the database.
+ */
+
+ gcPtr = (TkGC *) ckalloc(sizeof(TkGC));
+
+ /*
+ * Find or make a drawable to use to specify the screen and depth
+ * of the GC. We may have to make a small pixmap, to avoid doing
+ * Tk_MakeWindowExist on the window.
+ */
+
+ freeDrawable = None;
+ if (Tk_WindowId(tkwin) != None) {
+ d = Tk_WindowId(tkwin);
+ } else if (valueKey.depth ==
+ DefaultDepth(valueKey.display, valueKey.screenNum)) {
+ d = RootWindow(valueKey.display, valueKey.screenNum);
+ } else {
+ d = Tk_GetPixmap(valueKey.display,
+ RootWindow(valueKey.display, valueKey.screenNum),
+ 1, 1, valueKey.depth);
+ 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);
+ }
+
+ /* CYGNUS LOCAL. Record and register the colors. */
+ gcPtr->foreground = foreground;
+ gcPtr->background = background;
+ if (foreground != NULL) {
+ TkRegisterColorGC(foreground, valueKey.display, gcPtr->gc,
+ GCForeground);
+ }
+ if (background != NULL) {
+ TkRegisterColorGC(background, valueKey.display, gcPtr->gc,
+ GCBackground);
+ }
+
+ return gcPtr->gc;
+}
+
+/* CYGNUS LOCAL. Tk_GetGC now just calls Tk_GetGCColor. */
+
+GC
+Tk_GetGC(tkwin, valueMask, valuePtr)
+ Tk_Window tkwin; /* Window in which GC will be used. */
+ register unsigned long valueMask;
+ /* 1 bits correspond to values specified
+ * in *valuesPtr; other values are set
+ * from defaults. */
+ register XGCValues *valuePtr;
+ /* Values are specified here for bits set
+ * in valueMask. */
+{
+ return Tk_GetGCColor(tkwin, valueMask, valuePtr, NULL, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeGC --
+ *
+ * This procedure is called to release a graphics context allocated by
+ * Tk_GetGC.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The reference count associated with gc is decremented, and
+ * gc is officially deallocated if no-one is using it anymore.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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) {
+ /* CYGNUS LOCAL: Deregister the colors. */
+ if (gcPtr->foreground != NULL) {
+ TkDeregisterColorGC(gcPtr->foreground, gcPtr->gc,
+ GCForeground);
+ }
+ if (gcPtr->background != NULL) {
+ TkDeregisterColorGC(gcPtr->background, gcPtr->gc,
+ GCBackground);
+ }
+
+ Tk_FreeXId(gcPtr->display, (XID) XGContextFromGC(gcPtr->gc));
+ XFreeGC(gcPtr->display, gcPtr->gc);
+ Tcl_DeleteHashEntry(gcPtr->valueHashPtr);
+ Tcl_DeleteHashEntry(idHashPtr);
+ ckfree((char *) gcPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GCInit --
+ *
+ * Initialize the structures used for GC management.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Read the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GCInit()
+{
+ initialized = 1;
+ Tcl_InitHashTable(&valueTable, sizeof(ValueKey)/sizeof(int));
+ Tcl_InitHashTable(&idTable, sizeof(IdKey)/sizeof(int));
+}
diff --git a/tk/generic/tkGeometry.c b/tk/generic/tkGeometry.c
new file mode 100644
index 00000000000..3545c4b7c4e
--- /dev/null
+++ b/tk/generic/tkGeometry.c
@@ -0,0 +1,582 @@
+/*
+ * 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$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * Data structures of the following type are used by Tk_MaintainGeometry.
+ * For each slave managed by Tk_MaintainGeometry, there is one of these
+ * structures associated with its master.
+ */
+
+typedef struct MaintainSlave {
+ Tk_Window slave; /* The slave window being positioned. */
+ Tk_Window master; /* The master that determines slave's
+ * position; it must be a descendant of
+ * slave's parent. */
+ int x, y; /* Desired position of slave relative to
+ * master. */
+ int width, height; /* Desired dimensions of slave. */
+ struct MaintainSlave *nextPtr;
+ /* Next in list of Maintains associated
+ * with master. */
+} MaintainSlave;
+
+/*
+ * For each window that has been specified as a master to
+ * Tk_MaintainGeometry, there is a structure of the following type:
+ */
+
+typedef struct MaintainMaster {
+ Tk_Window ancestor; /* The lowest ancestor of this window
+ * for which we have *not* created a
+ * StructureNotify handler. May be the
+ * same as the window itself. */
+ 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));
+static void MaintainSlaveProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ManageGeometry --
+ *
+ * Arrange for a particular procedure to manage the geometry
+ * of a given slave window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Proc becomes the new geometry manager for tkwin, replacing
+ * any previous geometry manager. The geometry manager will
+ * be notified (by calling procedures in *mgrPtr) when interesting
+ * things happen in the future. If there was an existing geometry
+ * manager for tkwin different from the new one, it is notified
+ * by calling its lostSlaveProc.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_ManageGeometry(tkwin, mgrPtr, clientData)
+ Tk_Window tkwin; /* Window whose geometry is to
+ * be managed by proc. */
+ Tk_GeomMgr *mgrPtr; /* Static structure describing the
+ * geometry manager. This structure
+ * must never go away. */
+ ClientData clientData; /* Arbitrary one-word argument to
+ * pass to geometry manager procedures. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if ((winPtr->geomMgrPtr != NULL) && (mgrPtr != NULL)
+ && ((winPtr->geomMgrPtr != mgrPtr)
+ || (winPtr->geomData != clientData))
+ && (winPtr->geomMgrPtr->lostSlaveProc != NULL)) {
+ (*winPtr->geomMgrPtr->lostSlaveProc)(winPtr->geomData, tkwin);
+ }
+
+ winPtr->geomMgrPtr = mgrPtr;
+ winPtr->geomData = clientData;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GeometryRequest --
+ *
+ * This procedure is invoked by widget code to indicate
+ * its preferences about the size of a window it manages.
+ * In general, widget code should call this procedure
+ * rather than Tk_ResizeWindow.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The geometry manager for tkwin (if any) is invoked to
+ * handle the request. If possible, it will reconfigure
+ * tkwin and/or other windows to satisfy the request. The
+ * caller gets no indication of success or failure, but it
+ * will get X events if the window size was actually
+ * changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_GeometryRequest(tkwin, reqWidth, reqHeight)
+ Tk_Window tkwin; /* Window that geometry information
+ * pertains to. */
+ int reqWidth, reqHeight; /* Minimum desired dimensions for
+ * window, in pixels. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ /*
+ * X gets very upset if a window requests a width or height of
+ * zero, so rounds requested sizes up to at least 1.
+ */
+
+ if (reqWidth <= 0) {
+ reqWidth = 1;
+ }
+ if (reqHeight <= 0) {
+ reqHeight = 1;
+ }
+ if ((reqWidth == winPtr->reqWidth) && (reqHeight == winPtr->reqHeight)) {
+ return;
+ }
+ winPtr->reqWidth = reqWidth;
+ winPtr->reqHeight = reqHeight;
+ if ((winPtr->geomMgrPtr != NULL)
+ && (winPtr->geomMgrPtr->requestProc != NULL)) {
+ (*winPtr->geomMgrPtr->requestProc)(winPtr->geomData, tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetInternalBorder --
+ *
+ * Notify relevant geometry managers that a window has an internal
+ * border of a given width and that child windows should not be
+ * placed on that border.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The border width is recorded for the window, and all geometry
+ * managers of all children are notified so that can re-layout, if
+ * necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetInternalBorder(tkwin, width)
+ Tk_Window tkwin; /* Window that will have internal border. */
+ int width; /* Width of internal border, in pixels. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (width == winPtr->internalBorderWidth) {
+ return;
+ }
+ if (width < 0) {
+ width = 0;
+ }
+ winPtr->internalBorderWidth = width;
+
+ /*
+ * All the slaves for which this is the master window must now be
+ * repositioned to take account of the new internal border width.
+ * To signal all the geometry managers to do this, just resize the
+ * window to its current size. The ConfigureNotify event will
+ * cause geometry managers to recompute everything.
+ */
+
+ Tk_ResizeWindow(tkwin, Tk_Width(tkwin), Tk_Height(tkwin));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MaintainGeometry --
+ *
+ * This procedure is invoked by geometry managers to handle slaves
+ * whose master's are not their parents. It translates the desired
+ * geometry for the slave into the coordinate system of the parent
+ * and respositions the slave if it isn't already at the right place.
+ * Furthermore, it sets up event handlers so that if the master (or
+ * any of its ancestors up to the slave's parent) is mapped, unmapped,
+ * or moved, then the slave will be adjusted to match.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Event handlers are created and state is allocated to keep track
+ * of slave. Note: if slave was already managed for master by
+ * Tk_MaintainGeometry, then the previous information is replaced
+ * with the new information. The caller must eventually call
+ * Tk_UnmaintainGeometry to eliminate the correspondence (or, the
+ * state is automatically freed when either window is destroyed).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_MaintainGeometry(slave, master, x, y, width, height)
+ Tk_Window slave; /* Slave for geometry management. */
+ Tk_Window master; /* Master for slave; must be a descendant
+ * of slave's parent. */
+ int x, y; /* Desired position of slave within master. */
+ 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;
+ Tcl_SetHashValue(hPtr, masterPtr);
+ }
+
+ /*
+ * Create a MaintainSlave structure for the slave if there isn't
+ * already one.
+ */
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ if (slavePtr->slave == slave) {
+ goto gotSlave;
+ }
+ }
+ slavePtr = (MaintainSlave *) ckalloc(sizeof(MaintainSlave));
+ slavePtr->slave = slave;
+ slavePtr->master = master;
+ slavePtr->nextPtr = masterPtr->slavePtr;
+ masterPtr->slavePtr = slavePtr;
+ Tk_CreateEventHandler(slave, StructureNotifyMask, MaintainSlaveProc,
+ (ClientData) slavePtr);
+
+ /*
+ * Make sure that there are event handlers registered for all
+ * the windows between master and slave's parent (including master
+ * but not slave's parent). There may already be handlers for master
+ * and some of its ancestors (masterPtr->ancestor tells how many).
+ */
+
+ for (ancestor = master; ancestor != parent;
+ ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == masterPtr->ancestor) {
+ Tk_CreateEventHandler(ancestor, StructureNotifyMask,
+ MaintainMasterProc, (ClientData) masterPtr);
+ masterPtr->ancestor = Tk_Parent(ancestor);
+ }
+ }
+
+ /*
+ * Fill in up-to-date information in the structure, then update the
+ * window if it's not currently in the right place or state.
+ */
+
+ gotSlave:
+ slavePtr->x = x;
+ slavePtr->y = y;
+ slavePtr->width = width;
+ slavePtr->height = height;
+ map = 1;
+ for (ancestor = slavePtr->master; ; ancestor = Tk_Parent(ancestor)) {
+ if (!Tk_IsMapped(ancestor) && (ancestor != parent)) {
+ map = 0;
+ }
+ if (ancestor == parent) {
+ if ((x != Tk_X(slavePtr->slave))
+ || (y != Tk_Y(slavePtr->slave))
+ || (width != Tk_Width(slavePtr->slave))
+ || (height != Tk_Height(slavePtr->slave))) {
+ Tk_MoveResizeWindow(slavePtr->slave, x, y, width, height);
+ }
+ if (map) {
+ Tk_MapWindow(slavePtr->slave);
+ } else {
+ Tk_UnmapWindow(slavePtr->slave);
+ }
+ break;
+ }
+ x += Tk_X(ancestor) + Tk_Changes(ancestor)->border_width;
+ y += Tk_Y(ancestor) + Tk_Changes(ancestor)->border_width;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_UnmaintainGeometry --
+ *
+ * This procedure cancels a previous Tk_MaintainGeometry call,
+ * so that the relationship between slave and master is no longer
+ * maintained.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The slave is unmapped and state is released, so that slave won't
+ * track master any more. If we weren't previously managing slave
+ * relative to master, then this procedure has no effect.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_UnmaintainGeometry(slave, master)
+ Tk_Window slave; /* Slave for geometry management. */
+ 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;
+ } else {
+ for (prevPtr = slavePtr, slavePtr = slavePtr->nextPtr; ;
+ prevPtr = slavePtr, slavePtr = slavePtr->nextPtr) {
+ if (slavePtr == NULL) {
+ return;
+ }
+ if (slavePtr->slave == slave) {
+ prevPtr->nextPtr = slavePtr->nextPtr;
+ break;
+ }
+ }
+ }
+ Tk_DeleteEventHandler(slavePtr->slave, StructureNotifyMask,
+ MaintainSlaveProc, (ClientData) slavePtr);
+ ckfree((char *) slavePtr);
+ if (masterPtr->slavePtr == NULL) {
+ if (masterPtr->ancestor != NULL) {
+ for (ancestor = master; ; ancestor = Tk_Parent(ancestor)) {
+ Tk_DeleteEventHandler(ancestor, StructureNotifyMask,
+ MaintainMasterProc, (ClientData) masterPtr);
+ if (ancestor == masterPtr->ancestor) {
+ break;
+ }
+ }
+ }
+ if (masterPtr->checkScheduled) {
+ Tcl_CancelIdleCall(MaintainCheckProc, (ClientData) masterPtr);
+ }
+ Tcl_DeleteHashEntry(hPtr);
+ ckfree((char *) masterPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MaintainMasterProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher in
+ * response to StructureNotify events on the master or one
+ * of its ancestors, on behalf of Tk_MaintainGeometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * It schedules a call to MaintainCheckProc, which will eventually
+ * caused the postions and mapped states to be recalculated for all
+ * the maintained slaves of the master. Or, if the master window is
+ * being deleted then state is cleaned up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MaintainMasterProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to MaintainMaster structure
+ * for the master window. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ MaintainMaster *masterPtr = (MaintainMaster *) clientData;
+ MaintainSlave *slavePtr;
+ int done;
+
+ if ((eventPtr->type == ConfigureNotify)
+ || (eventPtr->type == MapNotify)
+ || (eventPtr->type == UnmapNotify)) {
+ if (!masterPtr->checkScheduled) {
+ masterPtr->checkScheduled = 1;
+ Tcl_DoWhenIdle(MaintainCheckProc, (ClientData) masterPtr);
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ /*
+ * Delete all of the state associated with this master, but
+ * be careful not to use masterPtr after the last slave is
+ * deleted, since its memory will have been freed.
+ */
+
+ done = 0;
+ do {
+ slavePtr = masterPtr->slavePtr;
+ if (slavePtr->nextPtr == NULL) {
+ done = 1;
+ }
+ Tk_UnmaintainGeometry(slavePtr->slave, slavePtr->master);
+ } while (!done);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MaintainSlaveProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher in
+ * response to StructureNotify events on a slave being managed
+ * by Tk_MaintainGeometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If the event is a DestroyNotify event then the Maintain state
+ * and event handlers for this slave are deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MaintainSlaveProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to MaintainSlave structure
+ * for master-slave pair. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ MaintainSlave *slavePtr = (MaintainSlave *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ Tk_UnmaintainGeometry(slavePtr->slave, slavePtr->master);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MaintainCheckProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher as an
+ * idle handler, when a master or one of its ancestors has been
+ * reconfigured, mapped, or unmapped. Its job is to scan all of
+ * the slaves for the master and reposition them, map them, or
+ * unmap them as needed to maintain their geometry relative to
+ * the master.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Slaves can get repositioned, mapped, or unmapped.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MaintainCheckProc(clientData)
+ ClientData clientData; /* Pointer to MaintainMaster structure
+ * for the master window. */
+{
+ MaintainMaster *masterPtr = (MaintainMaster *) clientData;
+ MaintainSlave *slavePtr;
+ Tk_Window ancestor, parent;
+ int x, y, map;
+
+ masterPtr->checkScheduled = 0;
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ parent = Tk_Parent(slavePtr->slave);
+ x = slavePtr->x;
+ y = slavePtr->y;
+ map = 1;
+ for (ancestor = slavePtr->master; ; ancestor = Tk_Parent(ancestor)) {
+ if (!Tk_IsMapped(ancestor) && (ancestor != parent)) {
+ map = 0;
+ }
+ if (ancestor == parent) {
+ if ((x != Tk_X(slavePtr->slave))
+ || (y != Tk_Y(slavePtr->slave))) {
+ Tk_MoveWindow(slavePtr->slave, x, y);
+ }
+ if (map) {
+ Tk_MapWindow(slavePtr->slave);
+ } else {
+ Tk_UnmapWindow(slavePtr->slave);
+ }
+ break;
+ }
+ x += Tk_X(ancestor) + Tk_Changes(ancestor)->border_width;
+ y += Tk_Y(ancestor) + Tk_Changes(ancestor)->border_width;
+ }
+ }
+}
diff --git a/tk/generic/tkGet.c b/tk/generic/tkGet.c
new file mode 100644
index 00000000000..020a39005ae
--- /dev/null
+++ b/tk/generic/tkGet.c
@@ -0,0 +1,586 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetAnchor(interp, string, anchorPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ char *string; /* String describing a direction. */
+ Tk_Anchor *anchorPtr; /* Where to store Tk_Anchor corresponding
+ * to string. */
+{
+ switch (string[0]) {
+ case 'n':
+ if (string[1] == 0) {
+ *anchorPtr = TK_ANCHOR_N;
+ return TCL_OK;
+ } else if ((string[1] == 'e') && (string[2] == 0)) {
+ *anchorPtr = TK_ANCHOR_NE;
+ return TCL_OK;
+ } else if ((string[1] == 'w') && (string[2] == 0)) {
+ *anchorPtr = TK_ANCHOR_NW;
+ return TCL_OK;
+ }
+ goto error;
+ case 's':
+ if (string[1] == 0) {
+ *anchorPtr = TK_ANCHOR_S;
+ return TCL_OK;
+ } else if ((string[1] == 'e') && (string[2] == 0)) {
+ *anchorPtr = TK_ANCHOR_SE;
+ return TCL_OK;
+ } else if ((string[1] == 'w') && (string[2] == 0)) {
+ *anchorPtr = TK_ANCHOR_SW;
+ return TCL_OK;
+ } else {
+ goto error;
+ }
+ case 'e':
+ if (string[1] == 0) {
+ *anchorPtr = TK_ANCHOR_E;
+ return TCL_OK;
+ }
+ goto error;
+ case 'w':
+ if (string[1] == 0) {
+ *anchorPtr = TK_ANCHOR_W;
+ return TCL_OK;
+ }
+ goto error;
+ case 'c':
+ if (strncmp(string, "center", strlen(string)) == 0) {
+ *anchorPtr = TK_ANCHOR_CENTER;
+ return TCL_OK;
+ }
+ goto error;
+ }
+
+ error:
+ Tcl_AppendResult(interp, "bad anchor position \"", string,
+ "\": must be n, ne, e, se, s, sw, w, nw, or center",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfAnchor --
+ *
+ * Given a Tk_Anchor, return the string that corresponds
+ * to it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_NameOfAnchor(anchor)
+ Tk_Anchor anchor; /* Anchor for which identifying string
+ * is desired. */
+{
+ switch (anchor) {
+ case TK_ANCHOR_N: return "n";
+ case TK_ANCHOR_NE: return "ne";
+ case TK_ANCHOR_E: return "e";
+ case TK_ANCHOR_SE: return "se";
+ case TK_ANCHOR_S: return "s";
+ case TK_ANCHOR_SW: return "sw";
+ case TK_ANCHOR_W: return "w";
+ case TK_ANCHOR_NW: return "nw";
+ case TK_ANCHOR_CENTER: return "center";
+ }
+ return "unknown anchor position";
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetJoinStyle --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetJoinStyle(interp, string, joinPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ char *string; /* String describing a justification style. */
+ int *joinPtr; /* Where to store join style corresponding
+ * to string. */
+{
+ int c;
+ size_t length;
+
+ c = string[0];
+ length = strlen(string);
+
+ if ((c == 'b') && (strncmp(string, "bevel", length) == 0)) {
+ *joinPtr = JoinBevel;
+ return TCL_OK;
+ }
+ if ((c == 'm') && (strncmp(string, "miter", length) == 0)) {
+ *joinPtr = JoinMiter;
+ return TCL_OK;
+ }
+ if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
+ *joinPtr = JoinRound;
+ return TCL_OK;
+ }
+
+ Tcl_AppendResult(interp, "bad join style \"", string,
+ "\": must be bevel, miter, or round",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfJoinStyle --
+ *
+ * Given a Tk_JoinStyle, return the string that corresponds
+ * to it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_NameOfJoinStyle(join)
+ int join; /* Join style for which identifying string
+ * is desired. */
+{
+ switch (join) {
+ case JoinBevel: return "bevel";
+ case JoinMiter: return "miter";
+ case JoinRound: return "round";
+ }
+ return "unknown join style";
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetCapStyle --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetCapStyle(interp, string, capPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ char *string; /* String describing a justification style. */
+ int *capPtr; /* Where to store cap style corresponding
+ * to string. */
+{
+ int c;
+ size_t length;
+
+ c = string[0];
+ length = strlen(string);
+
+ if ((c == 'b') && (strncmp(string, "butt", length) == 0)) {
+ *capPtr = CapButt;
+ return TCL_OK;
+ }
+ if ((c == 'p') && (strncmp(string, "projecting", length) == 0)) {
+ *capPtr = CapProjecting;
+ return TCL_OK;
+ }
+ if ((c == 'r') && (strncmp(string, "round", length) == 0)) {
+ *capPtr = CapRound;
+ return TCL_OK;
+ }
+
+ Tcl_AppendResult(interp, "bad cap style \"", string,
+ "\": must be butt, projecting, or round",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfCapStyle --
+ *
+ * Given a Tk_CapStyle, return the string that corresponds
+ * to it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_NameOfCapStyle(cap)
+ int cap; /* Cap style for which identifying string
+ * is desired. */
+{
+ 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetJustify(interp, string, justifyPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ char *string; /* String describing a justification style. */
+ Tk_Justify *justifyPtr; /* Where to store Tk_Justify corresponding
+ * to string. */
+{
+ int c;
+ size_t length;
+
+ c = string[0];
+ length = strlen(string);
+
+ if ((c == 'l') && (strncmp(string, "left", length) == 0)) {
+ *justifyPtr = TK_JUSTIFY_LEFT;
+ return TCL_OK;
+ }
+ if ((c == 'r') && (strncmp(string, "right", length) == 0)) {
+ *justifyPtr = TK_JUSTIFY_RIGHT;
+ return TCL_OK;
+ }
+ if ((c == 'c') && (strncmp(string, "center", length) == 0)) {
+ *justifyPtr = TK_JUSTIFY_CENTER;
+ return TCL_OK;
+ }
+
+ Tcl_AppendResult(interp, "bad justification \"", string,
+ "\": must be left, right, or center",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_NameOfJustify --
+ *
+ * Given a Tk_Justify, return the string that corresponds
+ * to it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_NameOfJustify(justify)
+ Tk_Justify justify; /* Justification style for which
+ * identifying string is desired. */
+{
+ switch (justify) {
+ case TK_JUSTIFY_LEFT: return "left";
+ case TK_JUSTIFY_RIGHT: return "right";
+ case TK_JUSTIFY_CENTER: return "center";
+ }
+ return "unknown justification style";
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetUid --
+ *
+ * Given a string, this procedure returns a unique identifier
+ * for the string.
+ *
+ * Results:
+ * This procedure returns a Tk_Uid corresponding to the "string"
+ * argument. The Tk_Uid has a string value identical to string
+ * (strcmp will return 0), but it's guaranteed that any other
+ * calls to this procedure with a string equal to "string" will
+ * return exactly the same result (i.e. can compare Tk_Uid
+ * *values* directly, without having to call strcmp on what they
+ * point to).
+ *
+ * Side effects:
+ * New information may be entered into the identifier table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetScreenMM(interp, tkwin, string, doublePtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ Tk_Window tkwin; /* Window whose screen determines conversion
+ * from centimeters and other absolute
+ * units. */
+ char *string; /* String describing a screen distance. */
+ double *doublePtr; /* Place to store converted result. */
+{
+ char *end;
+ double d;
+
+ d = strtod(string, &end);
+ if (end == string) {
+ error:
+ Tcl_AppendResult(interp, "bad screen distance \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ switch (*end) {
+ case 0:
+ d /= WidthOfScreen(Tk_Screen(tkwin));
+ d *= WidthMMOfScreen(Tk_Screen(tkwin));
+ break;
+ case 'c':
+ d *= 10;
+ end++;
+ break;
+ case 'i':
+ d *= 25.4;
+ end++;
+ break;
+ case 'm':
+ end++;
+ break;
+ case 'p':
+ d *= 25.4/72.0;
+ end++;
+ break;
+ default:
+ goto error;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ if (*end != 0) {
+ goto error;
+ }
+ *doublePtr = d;
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetPixels --
+ *
+ * Given a string, returns the number of pixels 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
+ * rounded pixel distance is stored at *intPtr; otherwise
+ * TCL_ERROR is returned and an error message is left in
+ * interp->result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+Tk_GetPixels(interp, tkwin, string, intPtr)
+ Tcl_Interp *interp; /* Use this for error reporting. */
+ Tk_Window tkwin; /* Window whose screen determines conversion
+ * from centimeters and other absolute
+ * units. */
+ char *string; /* String describing a justification style. */
+ int *intPtr; /* Place to store converted result. */
+{
+ char *end;
+ double d;
+
+ d = strtod(string, &end);
+ if (end == string) {
+ error:
+ Tcl_AppendResult(interp, "bad screen distance \"", string,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ switch (*end) {
+ case 0:
+ break;
+ case 'c':
+ d *= 10*WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ end++;
+ break;
+ case 'i':
+ d *= 25.4*WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ end++;
+ break;
+ case 'm':
+ d *= WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ end++;
+ break;
+ case 'p':
+ d *= (25.4/72.0)*WidthOfScreen(Tk_Screen(tkwin));
+ d /= WidthMMOfScreen(Tk_Screen(tkwin));
+ end++;
+ break;
+ default:
+ goto error;
+ }
+ while ((*end != '\0') && isspace(UCHAR(*end))) {
+ end++;
+ }
+ if (*end != 0) {
+ goto error;
+ }
+ if (d < 0) {
+ *intPtr = (int) (d - 0.5);
+ } else {
+ *intPtr = (int) (d + 0.5);
+ }
+ return TCL_OK;
+}
diff --git a/tk/generic/tkGrab.c b/tk/generic/tkGrab.c
new file mode 100644
index 00000000000..8be4b9f24f8
--- /dev/null
+++ b/tk/generic/tkGrab.c
@@ -0,0 +1,1535 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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.
+ *
+ * The current grab window specifies the point in the Tk window
+ * heirarchy above which pointer events will not be reported. Any
+ * window within the subtree below the grab window will continue to
+ * receive events as normal. Events outside of the grab tree will be
+ * reported to the grab window.
+ *
+ * If the current restrict window is set, then all pointer events will
+ * be reported only to the restrict window. The restrict window is
+ * normally set during an automatic button grab.
+ *
+ * The mouse capture state specifies whether the window system will
+ * report mouse events outside of any Tk toplevels. This is set
+ * during a global grab or an automatic button grab.
+ *
+ * The transitions between different states is given in the following
+ * table:
+ *
+ * Event\State U B G GB
+ * ----------- -- -- -- --
+ * FirstPress B B GB GB
+ * Press B B G GB
+ * Release U B G GB
+ * LastRelease U U G G
+ * Grab G G G G
+ * Ungrab U B U U
+ *
+ * Note: U=Ungrabbed, B=Button, G=Grabbed, GB=Grab and Button
+ *
+ * In addition, the following conditions are always true:
+ *
+ * State\Variable Grab Restrict Capture
+ * -------------- ---- -------- -------
+ * Ungrabbed 0 0 0
+ * Button 0 1 1
+ * Grabbed 1 0 b/g
+ * Grab and Button 1 1 1
+ *
+ * Note: 0 means variable is set to NULL, 1 means variable is set to
+ * some window, b/g means the variable is set to a window if a button
+ * is currently down or a global grab is in effect.
+ *
+ * The final complication to all of this is enter and leave events.
+ * In order to correctly handle all of the various cases, Tk cannot
+ * rely on X enter/leave events in all situations. The following
+ * describes the correct sequence of enter and leave events that
+ * should be observed by Tk scripts:
+ *
+ * Event(state) Enter/Leave From -> To
+ * ------------ ----------------------
+ * LastRelease(B | GB): restrict window -> anc(grab window, event window)
+ * Grab(U | B): event window -> anc(grab window, event window)
+ * Grab(G): anc(old grab window, event window) ->
+ * anc(new grab window, event window)
+ * Grab(GB): restrict window -> anc(new grab window, event window)
+ * Ungrab(G): anc(grab window, event window) -> event window
+ * Ungrab(GB): restrict window -> event window
+ *
+ * Note: anc(x,y) returns the least ancestor of y that is in the tree
+ * of x, terminating at toplevels.
+ */
+
+/*
+ * The following structure is used to pass information to
+ * GrabRestrictProc from EatGrabEvents.
+ */
+
+typedef struct {
+ Display *display; /* Display from which to discard events. */
+ unsigned int serial; /* Serial number with which to compare. */
+} GrabInfo;
+
+/*
+ * Bit definitions for grabFlags field of TkDisplay structures:
+ *
+ * GRAB_GLOBAL 1 means this is a global grab (we grabbed via
+ * the server so all applications are locked out).
+ * 0 means this is a local grab that affects
+ * only this application.
+ * GRAB_TEMP_GLOBAL 1 means we've temporarily grabbed via the
+ * server because a button is down and we want
+ * to make sure that we get the button-up
+ * event. The grab will be released when the
+ * last mouse button goes up.
+ */
+
+#define GRAB_GLOBAL 1
+#define GRAB_TEMP_GLOBAL 4
+
+/*
+ * The following structure is a Tcl_Event that triggers a change in
+ * the grabWinPtr field of a display. This event guarantees that
+ * the change occurs in the proper order relative to enter and leave
+ * events.
+ */
+
+typedef struct NewGrabWinEvent {
+ Tcl_Event header; /* Standard information for all Tcl events. */
+ TkDisplay *dispPtr; /* Display whose grab window is to change. */
+ Window grabWindow; /* New grab window for display. This is
+ * recorded instead of a (TkWindow *) because
+ * it will allow us to detect cases where
+ * the window is destroyed before this event
+ * is processed. */
+} NewGrabWinEvent;
+
+/*
+ * The following magic value is stored in the "send_event" field of
+ * EnterNotify and LeaveNotify events that are generated in this
+ * file. This allows us to separate "real" events coming from the
+ * server from those that we generated.
+ */
+
+#define GENERATED_EVENT_MAGIC ((Bool) 0x147321ac)
+
+/*
+ * 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 buttonStates[] = {
+ Button1Mask, Button2Mask, Button3Mask, Button4Mask, Button5Mask
+};
+
+/*
+ * Forward declarations for procedures declared later in this file:
+ */
+
+static void EatGrabEvents _ANSI_ARGS_((TkDisplay *dispPtr,
+ unsigned int serial));
+static TkWindow * FindCommonAncestor _ANSI_ARGS_((TkWindow *winPtr1,
+ TkWindow *winPtr2, int *countPtr1,
+ int *countPtr2));
+static Tk_RestrictAction GrabRestrictProc _ANSI_ARGS_((ClientData arg,
+ XEvent *eventPtr));
+static int GrabWinEventProc _ANSI_ARGS_((Tcl_Event *evPtr,
+ int flags));
+static void MovePointer2 _ANSI_ARGS_((TkWindow *sourcePtr,
+ TkWindow *destPtr, int mode, int leaveEvents,
+ int EnterEvents));
+static void QueueGrabWindowChange _ANSI_ARGS_((TkDisplay *dispPtr,
+ TkWindow *grabWinPtr));
+static void ReleaseButtonGrab _ANSI_ARGS_((TkDisplay *dispPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GrabCmd --
+ *
+ * This procedure is invoked to process the "grab" 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_GrabCmd(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 globalGrab, c;
+ Tk_Window tkwin;
+ TkDisplay *dispPtr;
+ size_t length;
+
+ if (argc < 2) {
+ badArgs:
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " ?-global? window\" or \"", argv[0],
+ " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if (c == '.') {
+ if (argc != 2) {
+ goto badArgs;
+ }
+ tkwin = Tk_NameToWindow(interp, argv[1], (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_Grab(interp, tkwin, 0);
+ } else if ((c == '-') && (strncmp(argv[1], "-global", length) == 0)
+ && (length >= 2)) {
+ if (argc != 3) {
+ goto badArgs;
+ }
+ tkwin = Tk_NameToWindow(interp, argv[2], (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_Grab(interp, tkwin, 1);
+ } else if ((c == 'c') && (strncmp(argv[1], "current", length) == 0)) {
+ if (argc > 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " current ?window?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ 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);
+ }
+ }
+ }
+ return TCL_OK;
+ } else if ((c == 'r') && (strncmp(argv[1], "release", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " release window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, argv[2], (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ Tcl_ResetResult(interp);
+ } else {
+ Tk_Ungrab(tkwin);
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "set", length) == 0)
+ && (length >= 2)) {
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " set ?-global? window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 3) {
+ globalGrab = 0;
+ tkwin = Tk_NameToWindow(interp, argv[2], (Tk_Window) clientData);
+ } else {
+ globalGrab = 1;
+ length = strlen(argv[2]);
+ if ((strncmp(argv[2], "-global", length) != 0) || (length < 2)) {
+ Tcl_AppendResult(interp, "bad argument \"", argv[2],
+ "\": must be \"", argv[0], " set ?-global? window\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, argv[3], (Tk_Window) clientData);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_Grab(interp, tkwin, globalGrab);
+ } else if ((c == 's') && (strncmp(argv[1], "status", length) == 0)
+ && (length >= 2)) {
+ TkWindow *winPtr;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " status window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ 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;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Grab --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_Grab(interp, tkwin, grabGlobal)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Window tkwin; /* Window on whose behalf the pointer
+ * is to be grabbed. */
+ int grabGlobal; /* Non-zero means issue a grab to the
+ * server so that no other application
+ * gets mouse or keyboard events.
+ * Zero means the grab only applies
+ * within this application. */
+{
+ int grabResult, numTries;
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkWindow *winPtr2;
+ unsigned int serial;
+
+ ReleaseButtonGrab(dispPtr);
+ 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) {
+ Window dummy1, dummy2;
+ int dummy3, dummy4, dummy5, dummy6;
+ unsigned int state;
+
+ /*
+ * Local grab. However, if any mouse buttons are down, turn
+ * it into a global grab temporarily, until the last button
+ * goes up. This does two things: (a) it makes sure that we
+ * see the button-up event; and (b) it allows us to track mouse
+ * motion among all of the windows of this application.
+ */
+
+ dispPtr->grabFlags &= ~(GRAB_GLOBAL|GRAB_TEMP_GLOBAL);
+ XQueryPointer(dispPtr->display, winPtr->window, &dummy1,
+ &dummy2, &dummy3, &dummy4, &dummy5, &dummy6, &state);
+ if ((state & ALL_BUTTONS) != 0) {
+ dispPtr->grabFlags |= GRAB_TEMP_GLOBAL;
+ goto setGlobalGrab;
+ }
+ } else {
+ dispPtr->grabFlags |= GRAB_GLOBAL;
+ setGlobalGrab:
+
+ /*
+ * Tricky point: must ungrab before grabbing. This is needed
+ * in case there is a button auto-grab already in effect. If
+ * there is, and the mouse has moved to a different window, X
+ * won't generate enter and leave events to move the mouse if
+ * we grab without ungrabbing.
+ */
+
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ serial = NextRequest(dispPtr->display);
+
+ /*
+ * Another tricky point: there are races with some window
+ * managers that can cause grabs to fail because the window
+ * manager hasn't released its grab quickly enough. To work
+ * around this problem, retry a few times after AlreadyGrabbed
+ * errors to give the grab release enough time to register with
+ * the server.
+ */
+
+ grabResult = 0; /* Needed only to prevent gcc
+ * compiler warnings. */
+ for (numTries = 0; numTries < 10; numTries++) {
+ grabResult = XGrabPointer(dispPtr->display, winPtr->window,
+ True, ButtonPressMask|ButtonReleaseMask|ButtonMotionMask
+ |PointerMotionMask, GrabModeAsync, GrabModeAsync, None,
+ None, CurrentTime);
+ if (grabResult != AlreadyGrabbed) {
+ 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;
+ }
+ grabResult = XGrabKeyboard(dispPtr->display, Tk_WindowId(tkwin),
+ False, GrabModeAsync, GrabModeAsync, CurrentTime);
+ if (grabResult != 0) {
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ goto grabError;
+ }
+
+ /*
+ * Eat up any grab-related events generated by the server for the
+ * grab. There are several reasons for doing this:
+ *
+ * 1. We have to synthesize the events for local grabs anyway, since
+ * the server doesn't participate in them.
+ * 2. The server doesn't always generate the right events for global
+ * grabs (e.g. it generates events even if the current window is
+ * in the grab tree, which we don't want).
+ * 3. We want all the grab-related events to be processed immediately
+ * (before other events that are already queued); events coming
+ * from the server will be in the wrong place, but events we
+ * synthesize here will go to the front of the queue.
+ */
+
+ EatGrabEvents(dispPtr, serial);
+ }
+
+ /*
+ * Synthesize leave events to move the pointer from its current window
+ * up to the lowest ancestor that it has in common with the grab window.
+ * However, only do this if the pointer is outside the grab window's
+ * subtree but inside the grab window's application.
+ */
+
+ if ((dispPtr->serverWinPtr != NULL)
+ && (dispPtr->serverWinPtr->mainPtr == winPtr->mainPtr)) {
+ for (winPtr2 = dispPtr->serverWinPtr; ; winPtr2 = winPtr2->parentPtr) {
+ if (winPtr2 == winPtr) {
+ break;
+ }
+ if (winPtr2 == NULL) {
+ MovePointer2(dispPtr->serverWinPtr, winPtr, NotifyGrab, 1, 0);
+ break;
+ }
+ }
+ }
+ QueueGrabWindowChange(dispPtr, winPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_Ungrab --
+ *
+ * Releases a grab on the mouse pointer and keyboard, if there
+ * is one set on the specified window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Pointer and keyboard events will start being delivered to other
+ * windows again.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_Ungrab(tkwin)
+ Tk_Window tkwin; /* Window whose grab should be
+ * released. */
+{
+ TkDisplay *dispPtr;
+ TkWindow *grabWinPtr, *winPtr;
+ unsigned int serial;
+
+ grabWinPtr = (TkWindow *) tkwin;
+ dispPtr = grabWinPtr->dispPtr;
+ if (grabWinPtr != dispPtr->eventualGrabWinPtr) {
+ return;
+ }
+ ReleaseButtonGrab(dispPtr);
+ QueueGrabWindowChange(dispPtr, (TkWindow *) NULL);
+ if (dispPtr->grabFlags & (GRAB_GLOBAL|GRAB_TEMP_GLOBAL)) {
+ dispPtr->grabFlags &= ~(GRAB_GLOBAL|GRAB_TEMP_GLOBAL);
+ serial = NextRequest(dispPtr->display);
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ XUngrabKeyboard(dispPtr->display, CurrentTime);
+ EatGrabEvents(dispPtr, serial);
+ }
+
+ /*
+ * Generate events to move the pointer back to the window where it
+ * really is. Some notes:
+ * 1. As with grabs, only do this if the "real" window is not a
+ * descendant of the grab window, since in this case the pointer
+ * is already where it's supposed to be.
+ * 2. If the "real" window is in some other application then don't
+ * generate any events at all, since everything's already been
+ * reported correctly.
+ * 3. Only generate enter events. Don't generate leave events,
+ * because we never told the lower-level windows that they
+ * had the pointer in the first place.
+ */
+
+ for (winPtr = dispPtr->serverWinPtr; ; winPtr = winPtr->parentPtr) {
+ if (winPtr == grabWinPtr) {
+ break;
+ }
+ if (winPtr == NULL) {
+ if ((dispPtr->serverWinPtr == NULL) ||
+ (dispPtr->serverWinPtr->mainPtr == grabWinPtr->mainPtr)) {
+ MovePointer2(grabWinPtr, dispPtr->serverWinPtr,
+ NotifyUngrab, 0, 1);
+ }
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReleaseButtonGrab --
+ *
+ * This procedure is called to release a simulated button grab, if
+ * there is one in effect. A button grab is present whenever
+ * dispPtr->buttonWinPtr is non-NULL or when the GRAB_TEMP_GLOBAL
+ * flag is set.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * DispPtr->buttonWinPtr is reset to NULL, and enter and leave
+ * events are generated if necessary to move the pointer from
+ * the button grab window to its current window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReleaseButtonGrab(dispPtr)
+ register TkDisplay *dispPtr; /* Display whose button grab is to be
+ * released. */
+{
+ unsigned int serial;
+
+ if (dispPtr->buttonWinPtr != NULL) {
+ if (dispPtr->buttonWinPtr != dispPtr->serverWinPtr) {
+ MovePointer2(dispPtr->buttonWinPtr, dispPtr->serverWinPtr,
+ NotifyUngrab, 1, 1);
+ }
+ dispPtr->buttonWinPtr = NULL;
+ }
+ if (dispPtr->grabFlags & GRAB_TEMP_GLOBAL) {
+ dispPtr->grabFlags &= ~GRAB_TEMP_GLOBAL;
+ serial = NextRequest(dispPtr->display);
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ XUngrabKeyboard(dispPtr->display, CurrentTime);
+ EatGrabEvents(dispPtr, serial);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPointerEvent --
+ *
+ * This procedure is called for each pointer-related event, before
+ * the event has been processed. It does various things to make
+ * grabs work correctly.
+ *
+ * Results:
+ * If the return value is 1 it means the event should be processed
+ * (event handlers should be invoked). If the return value is 0
+ * it means the event should be ignored in order to make grabs
+ * work correctly. In some cases this procedure modifies the event.
+ *
+ * Side effects:
+ * Grab state information may be updated. New events may also be
+ * pushed back onto the event queue to replace or augment the
+ * one passed in here.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkPointerEvent(eventPtr, winPtr)
+ register XEvent *eventPtr; /* Pointer to the event. */
+ TkWindow *winPtr; /* Tk's information for window
+ * where event was reported. */
+{
+ register TkWindow *winPtr2;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ unsigned int serial;
+ int outsideGrabTree = 0;
+ int ancestorOfGrab = 0;
+ int appGrabbed = 0; /* Non-zero means event is being
+ * reported to an application that is
+ * affected by the grab. */
+
+ /*
+ * Collect information about the grab (if any).
+ */
+
+ switch (TkGrabState(winPtr)) {
+ case TK_GRAB_IN_TREE:
+ appGrabbed = 1;
+ break;
+ case TK_GRAB_ANCESTOR:
+ appGrabbed = 1;
+ outsideGrabTree = 1;
+ ancestorOfGrab = 1;
+ break;
+ case TK_GRAB_EXCLUDED:
+ appGrabbed = 1;
+ outsideGrabTree = 1;
+ break;
+ }
+
+ if ((eventPtr->type == EnterNotify) || (eventPtr->type == LeaveNotify)) {
+ /*
+ * Keep track of what window the mouse is *really* over.
+ * Any events that we generate have a special send_event value,
+ * which is detected below and used to ignore the event for
+ * purposes of setting serverWinPtr.
+ */
+
+ if (eventPtr->xcrossing.send_event != GENERATED_EVENT_MAGIC) {
+ if ((eventPtr->type == LeaveNotify) &&
+ (winPtr->flags & TK_TOP_LEVEL)) {
+ dispPtr->serverWinPtr = NULL;
+ } else {
+ dispPtr->serverWinPtr = winPtr;
+ }
+ }
+
+ /*
+ * When a grab is active, X continues to report enter and leave
+ * events for windows outside the tree of the grab window:
+ * 1. Detect these events and ignore them except for
+ * windows above the grab window.
+ * 2. Allow Enter and Leave events to pass through the
+ * windows above the grab window, but never let them
+ * end up with the pointer *in* one of those windows.
+ */
+
+ if (dispPtr->grabWinPtr != NULL) {
+ if (outsideGrabTree && appGrabbed) {
+ if (!ancestorOfGrab) {
+ return 0;
+ }
+ switch (eventPtr->xcrossing.detail) {
+ case NotifyInferior:
+ return 0;
+ case NotifyAncestor:
+ eventPtr->xcrossing.detail = NotifyVirtual;
+ break;
+ case NotifyNonlinear:
+ eventPtr->xcrossing.detail = NotifyNonlinearVirtual;
+ break;
+ }
+ }
+
+ /*
+ * Make buttons have the same grab-like behavior inside a grab
+ * as they do outside a grab: do this by ignoring enter and
+ * leave events except for the window in which the button was
+ * pressed.
+ */
+
+ if ((dispPtr->buttonWinPtr != NULL)
+ && (winPtr != dispPtr->buttonWinPtr)) {
+ return 0;
+ }
+ }
+ return 1;
+ }
+
+ if (!appGrabbed) {
+ return 1;
+ }
+
+ if (eventPtr->type == MotionNotify) {
+ /*
+ * When grabs are active, X reports motion events relative to the
+ * window under the pointer. Instead, it should report the events
+ * relative to the window the button went down in, if there is a
+ * button down. Otherwise, if the pointer window is outside the
+ * subtree of the grab window, the events should be reported
+ * relative to the grab window. Otherwise, the event should be
+ * reported to the pointer window.
+ */
+
+ winPtr2 = winPtr;
+ if (dispPtr->buttonWinPtr != NULL) {
+ winPtr2 = dispPtr->buttonWinPtr;
+ } else if (outsideGrabTree || (dispPtr->serverWinPtr == NULL)) {
+ winPtr2 = dispPtr->grabWinPtr;
+ }
+ if (winPtr2 != winPtr) {
+ TkChangeEventWindow(eventPtr, winPtr2);
+ Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_HEAD);
+ return 0;
+ }
+ return 1;
+ }
+
+ /*
+ * Process ButtonPress and ButtonRelease events:
+ * 1. Keep track of whether a button is down and what window it
+ * went down in.
+ * 2. If the first button goes down outside the grab tree, pretend
+ * it went down in the grab window. Note: it's important to
+ * redirect events to the grab window like this in order to make
+ * things like menus work, where button presses outside the
+ * grabbed menu need to be seen. An application can always
+ * ignore the events if they occur outside its window.
+ * 3. If a button press or release occurs outside the window where
+ * the first button was pressed, retarget the event so it's reported
+ * to the window where the first button was pressed.
+ * 4. If the last button is released in a window different than where
+ * the first button was pressed, generate Enter/Leave events to
+ * move the mouse from the button window to its current window.
+ * 5. If the grab is set at a time when a button is already down, or
+ * if the window where the button was pressed was deleted, then
+ * dispPtr->buttonWinPtr will stay NULL. Just forget about the
+ * auto-grab for the button press; events will go to whatever
+ * window contains the pointer. If this window isn't in the grab
+ * tree then redirect events to the grab window.
+ * 6. When a button is pressed during a local grab, the X server sets
+ * a grab of its own, since it doesn't even know about our local
+ * grab. This causes enter and leave events no longer to be
+ * generated in the same way as for global grabs. To eliminate this
+ * problem, set a temporary global grab when the first button goes
+ * down and release it when the last button comes up.
+ */
+
+ if ((eventPtr->type == ButtonPress) || (eventPtr->type == ButtonRelease)) {
+ winPtr2 = dispPtr->buttonWinPtr;
+ if (winPtr2 == NULL) {
+ if (outsideGrabTree) {
+ winPtr2 = dispPtr->grabWinPtr; /* Note 5. */
+ } else {
+ winPtr2 = winPtr; /* Note 5. */
+ }
+ }
+ if (eventPtr->type == ButtonPress) {
+ if ((eventPtr->xbutton.state & ALL_BUTTONS) == 0) {
+ if (outsideGrabTree) {
+ TkChangeEventWindow(eventPtr, dispPtr->grabWinPtr);
+ Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_HEAD);
+ return 0; /* Note 2. */
+ }
+ if (!(dispPtr->grabFlags & GRAB_GLOBAL)) { /* Note 6. */
+ serial = NextRequest(dispPtr->display);
+ if (XGrabPointer(dispPtr->display,
+ dispPtr->grabWinPtr->window, True,
+ ButtonPressMask|ButtonReleaseMask|ButtonMotionMask,
+ GrabModeAsync, GrabModeAsync, None, None,
+ CurrentTime) == 0) {
+ EatGrabEvents(dispPtr, serial);
+ if (XGrabKeyboard(dispPtr->display, winPtr->window,
+ False, GrabModeAsync, GrabModeAsync,
+ CurrentTime) == 0) {
+ dispPtr->grabFlags |= GRAB_TEMP_GLOBAL;
+ } else {
+ XUngrabPointer(dispPtr->display, CurrentTime);
+ }
+ }
+ }
+ dispPtr->buttonWinPtr = winPtr;
+ return 1;
+ }
+ } else {
+ if ((eventPtr->xbutton.state & ALL_BUTTONS)
+ == buttonStates[eventPtr->xbutton.button - Button1]) {
+ ReleaseButtonGrab(dispPtr); /* Note 4. */
+ }
+ }
+ if (winPtr2 != winPtr) {
+ TkChangeEventWindow(eventPtr, winPtr2);
+ Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_HEAD);
+ return 0; /* Note 3. */
+ }
+ }
+
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkChangeEventWindow --
+ *
+ * Given an event and a new window to which the event should be
+ * retargeted, modify fields of the event so that the event is
+ * properly retargeted to the new window.
+ *
+ * Results:
+ * The following fields of eventPtr are modified: window,
+ * subwindow, x, y, same_screen.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkChangeEventWindow(eventPtr, winPtr)
+ register XEvent *eventPtr; /* Event to retarget. Must have
+ * type ButtonPress, ButtonRelease, KeyPress,
+ * KeyRelease, MotionNotify, EnterNotify,
+ * or LeaveNotify. */
+ TkWindow *winPtr; /* New target window for event. */
+{
+ int x, y, sameScreen, bd;
+ register TkWindow *childPtr;
+
+ eventPtr->xmotion.window = Tk_WindowId(winPtr);
+ if (eventPtr->xmotion.root ==
+ RootWindow(winPtr->display, winPtr->screenNum)) {
+ Tk_GetRootCoords((Tk_Window) winPtr, &x, &y);
+ eventPtr->xmotion.x = eventPtr->xmotion.x_root - x;
+ eventPtr->xmotion.y = eventPtr->xmotion.y_root - y;
+ eventPtr->xmotion.subwindow = None;
+ for (childPtr = winPtr->childList; childPtr != NULL;
+ childPtr = childPtr->nextPtr) {
+ if (childPtr->flags & TK_TOP_LEVEL) {
+ continue;
+ }
+ x = eventPtr->xmotion.x - childPtr->changes.x;
+ y = eventPtr->xmotion.y - childPtr->changes.y;
+ bd = childPtr->changes.border_width;
+ if ((x >= -bd) && (y >= -bd)
+ && (x < (childPtr->changes.width + bd))
+ && (y < (childPtr->changes.height + bd))) {
+ eventPtr->xmotion.subwindow = childPtr->window;
+ }
+ }
+ sameScreen = 1;
+ } else {
+ eventPtr->xmotion.x = 0;
+ eventPtr->xmotion.y = 0;
+ eventPtr->xmotion.subwindow = None;
+ sameScreen = 0;
+ }
+ if (eventPtr->type == MotionNotify) {
+ eventPtr->xmotion.same_screen = sameScreen;
+ } else {
+ eventPtr->xbutton.same_screen = sameScreen;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkInOutEvents --
+ *
+ * This procedure synthesizes EnterNotify and LeaveNotify events
+ * to correctly transfer the pointer from one window to another.
+ * It can also be used to generate FocusIn and FocusOut events
+ * to move the input focus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Synthesized events may be pushed back onto the event queue.
+ * The event pointed to by eventPtr is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkInOutEvents(eventPtr, sourcePtr, destPtr, leaveType, enterType, position)
+ XEvent *eventPtr; /* A template X event. Must have all fields
+ * properly set except for type, window,
+ * subwindow, x, y, detail, and same_screen
+ * (Not all of these fields are valid for
+ * FocusIn/FocusOut events; x_root and y_root
+ * must be valid for Enter/Leave events, even
+ * though x and y needn't be valid). */
+ TkWindow *sourcePtr; /* Window that used to have the pointer or
+ * focus (NULL means it was not in a window
+ * managed by this process). */
+ TkWindow *destPtr; /* Window that is to end up with the pointer
+ * or focus (NULL means it's not one managed
+ * by this process). */
+ int leaveType; /* Type of events to generate for windows
+ * being left (LeaveNotify or FocusOut). 0
+ * means don't generate leave events. */
+ int enterType; /* Type of events to generate for windows
+ * being entered (EnterNotify or FocusIn). 0
+ * means don't generate enter events. */
+ Tcl_QueuePosition position; /* Position at which events are added to
+ * the system event queue. */
+{
+ register TkWindow *winPtr;
+ int upLevels, downLevels, i, j, focus;
+
+ /*
+ * There are four possible cases to deal with:
+ *
+ * 1. SourcePtr and destPtr are the same. There's nothing to do in
+ * this case.
+ * 2. SourcePtr is an ancestor of destPtr in the same top-level
+ * window. Must generate events down the window tree from source
+ * to dest.
+ * 3. DestPtr is an ancestor of sourcePtr in the same top-level
+ * window. Must generate events up the window tree from sourcePtr
+ * to destPtr.
+ * 4. All other cases. Must first generate events up the window tree
+ * from sourcePtr to its top-level, then down from destPtr's
+ * top-level to destPtr. This form is called "non-linear."
+ *
+ * The call to FindCommonAncestor separates these four cases and decides
+ * how many levels up and down events have to be generated for.
+ */
+
+ if (sourcePtr == destPtr) {
+ return;
+ }
+ if ((leaveType == FocusOut) || (enterType == FocusIn)) {
+ focus = 1;
+ } else {
+ focus = 0;
+ }
+ FindCommonAncestor(sourcePtr, destPtr, &upLevels, &downLevels);
+
+ /*
+ * Generate enter/leave events and add them to the grab event queue.
+ */
+
+
+#define QUEUE(w, t, d) \
+ if (w->window != None) { \
+ eventPtr->type = t; \
+ if (focus) { \
+ eventPtr->xfocus.window = w->window; \
+ eventPtr->xfocus.detail = d; \
+ } else { \
+ eventPtr->xcrossing.detail = d; \
+ TkChangeEventWindow(eventPtr, w); \
+ } \
+ Tk_QueueWindowEvent(eventPtr, position); \
+ }
+
+ if (downLevels == 0) {
+
+ /*
+ * SourcePtr is an inferior of destPtr.
+ */
+
+ if (leaveType != 0) {
+ QUEUE(sourcePtr, leaveType, NotifyAncestor);
+ for (winPtr = sourcePtr->parentPtr, i = upLevels-1; i > 0;
+ winPtr = winPtr->parentPtr, i--) {
+ QUEUE(winPtr, leaveType, NotifyVirtual);
+ }
+ }
+ if ((enterType != 0) && (destPtr != NULL)) {
+ QUEUE(destPtr, enterType, NotifyInferior);
+ }
+ } else if (upLevels == 0) {
+
+ /*
+ * DestPtr is an inferior of sourcePtr.
+ */
+
+ if ((leaveType != 0) && (sourcePtr != NULL)) {
+ QUEUE(sourcePtr, leaveType, NotifyInferior);
+ }
+ if (enterType != 0) {
+ for (i = downLevels-1; i > 0; i--) {
+ for (winPtr = destPtr->parentPtr, j = 1; j < i;
+ winPtr = winPtr->parentPtr, j++) {
+ }
+ QUEUE(winPtr, enterType, NotifyVirtual);
+ }
+ if (destPtr != NULL) {
+ QUEUE(destPtr, enterType, NotifyAncestor);
+ }
+ }
+ } else {
+
+ /*
+ * Non-linear: neither window is an inferior of the other.
+ */
+
+ if (leaveType != 0) {
+ QUEUE(sourcePtr, leaveType, NotifyNonlinear);
+ for (winPtr = sourcePtr->parentPtr, i = upLevels-1; i > 0;
+ winPtr = winPtr->parentPtr, i--) {
+ QUEUE(winPtr, leaveType, NotifyNonlinearVirtual);
+ }
+ }
+ if (enterType != 0) {
+ for (i = downLevels-1; i > 0; i--) {
+ for (winPtr = destPtr->parentPtr, j = 1; j < i;
+ winPtr = winPtr->parentPtr, j++) {
+ }
+ QUEUE(winPtr, enterType, NotifyNonlinearVirtual);
+ }
+ if (destPtr != NULL) {
+ QUEUE(destPtr, enterType, NotifyNonlinear);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MovePointer2 --
+ *
+ * This procedure synthesizes EnterNotify and LeaveNotify events
+ * to correctly transfer the pointer from one window to another.
+ * It is different from TkInOutEvents in that no template X event
+ * needs to be supplied; this procedure generates the template
+ * event and calls TkInOutEvents.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Synthesized events may be pushed back onto the event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MovePointer2(sourcePtr, destPtr, mode, leaveEvents, enterEvents)
+ TkWindow *sourcePtr; /* Window currently containing pointer (NULL
+ * means it's not one managed by this
+ * process). */
+ TkWindow *destPtr; /* Window that is to end up containing the
+ * pointer (NULL means it's not one managed
+ * by this process). */
+ int mode; /* Mode for enter/leave events, such as
+ * NotifyNormal or NotifyUngrab. */
+ int leaveEvents; /* Non-zero means generate leave events for the
+ * windows being left. Zero means don't
+ * generate leave events. */
+ int enterEvents; /* Non-zero means generate enter events for the
+ * windows being entered. Zero means don't
+ * generate enter events. */
+{
+ XEvent event;
+ Window dummy1, dummy2;
+ int dummy3, dummy4;
+ TkWindow *winPtr;
+
+ winPtr = sourcePtr;
+ if ((winPtr == NULL) || (winPtr->window == None)) {
+ winPtr = destPtr;
+ if ((winPtr == NULL) || (winPtr->window == None)) {
+ return;
+ }
+ }
+
+ event.xcrossing.serial = LastKnownRequestProcessed(
+ winPtr->display);
+ event.xcrossing.send_event = GENERATED_EVENT_MAGIC;
+ event.xcrossing.display = winPtr->display;
+ event.xcrossing.root = RootWindow(winPtr->display,
+ winPtr->screenNum);
+ event.xcrossing.time = TkCurrentTime(winPtr->dispPtr);
+ XQueryPointer(winPtr->display, winPtr->window, &dummy1, &dummy2,
+ &event.xcrossing.x_root, &event.xcrossing.y_root,
+ &dummy3, &dummy4, &event.xcrossing.state);
+ event.xcrossing.mode = mode;
+ event.xcrossing.focus = False;
+ TkInOutEvents(&event, sourcePtr, destPtr, (leaveEvents) ? LeaveNotify : 0,
+ (enterEvents) ? EnterNotify : 0, TCL_QUEUE_MARK);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGrabDeadWindow --
+ *
+ * This procedure is invoked whenever a window is deleted, so that
+ * grab-related cleanup can be performed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Various cleanups happen, such as generating events to move the
+ * pointer back to its "natural" window as if an ungrab had been
+ * done. See the code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkGrabDeadWindow(winPtr)
+ register TkWindow *winPtr; /* Window that is in the process
+ * of being deleted. */
+{
+ TkDisplay *dispPtr = winPtr->dispPtr;
+
+ if (dispPtr->eventualGrabWinPtr == winPtr) {
+ /*
+ * Grab window was deleted. Release the grab.
+ */
+
+ Tk_Ungrab((Tk_Window) dispPtr->eventualGrabWinPtr);
+ } else if (dispPtr->buttonWinPtr == winPtr) {
+ ReleaseButtonGrab(dispPtr);
+ }
+ if (dispPtr->serverWinPtr == winPtr) {
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ dispPtr->serverWinPtr = NULL;
+ } else {
+ dispPtr->serverWinPtr = winPtr->parentPtr;
+ }
+ }
+ if (dispPtr->grabWinPtr == winPtr) {
+ dispPtr->grabWinPtr = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EatGrabEvents --
+ *
+ * This procedure is called to eliminate any Enter, Leave,
+ * FocusIn, or FocusOut events in the event queue for a
+ * display that have mode NotifyGrab or NotifyUngrab and
+ * have a serial number no less than a given value and are not
+ * generated by the grab module.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * DispPtr's display gets sync-ed, and some of the events get
+ * removed from the Tk event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EatGrabEvents(dispPtr, serial)
+ TkDisplay *dispPtr; /* Display from which to consume events. */
+ unsigned int serial; /* Only discard events that have a serial
+ * number at least this great. */
+{
+ Tk_RestrictProc *oldProc;
+ GrabInfo info;
+ ClientData oldArg, dummy;
+
+ info.display = dispPtr->display;
+ info.serial = serial;
+ TkpSync(info.display);
+ oldProc = Tk_RestrictEvents(GrabRestrictProc, (ClientData)&info, &oldArg);
+ while (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) {
+ }
+ Tk_RestrictEvents(oldProc, oldArg, &dummy);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GrabRestrictProc --
+ *
+ * A Tk_RestrictProc used by EatGrabEvents to eliminate any
+ * Enter, Leave, FocusIn, or FocusOut events in the event queue
+ * for a display that has mode NotifyGrab or NotifyUngrab and
+ * have a serial number no less than a given value.
+ *
+ * Results:
+ * Returns either TK_DISCARD_EVENT or TK_DEFER_EVENT.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_RestrictAction
+GrabRestrictProc(arg, eventPtr)
+ ClientData arg;
+ XEvent *eventPtr;
+{
+ GrabInfo *info = (GrabInfo *) arg;
+ int mode, diff;
+
+ /*
+ * The diff caculation is trickier than it may seem. Don't forget
+ * that serial numbers can wrap around, so can't compare the two
+ * serial numbers directly.
+ */
+
+ diff = eventPtr->xany.serial - info->serial;
+ if ((eventPtr->type == EnterNotify)
+ || (eventPtr->type == LeaveNotify)) {
+ mode = eventPtr->xcrossing.mode;
+ } else if ((eventPtr->type == FocusIn)
+ || (eventPtr->type == FocusOut)) {
+ mode = eventPtr->xfocus.mode;
+ } else {
+ mode = NotifyNormal;
+ }
+ if ((info->display != eventPtr->xany.display) || (mode == NotifyNormal)
+ || (diff < 0)) {
+ return TK_DEFER_EVENT;
+ } else {
+ return TK_DISCARD_EVENT;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * QueueGrabWindowChange --
+ *
+ * This procedure queues a special event in the Tcl event queue,
+ * which will cause the "grabWinPtr" field for the display to get
+ * modified when the event is processed. This is needed to make
+ * sure that the grab window changes at the proper time relative
+ * to grab-related enter and leave events that are also in the
+ * queue. In particular, this approach works even when multiple
+ * grabs and ungrabs happen back-to-back.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * DispPtr->grabWinPtr will be modified later (by GrabWinEventProc)
+ * when the event is removed from the grab event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+QueueGrabWindowChange(dispPtr, grabWinPtr)
+ TkDisplay *dispPtr; /* Display on which to change the grab
+ * window. */
+ TkWindow *grabWinPtr; /* Window that is to become the new grab
+ * window (may be NULL). */
+{
+ NewGrabWinEvent *grabEvPtr;
+
+ grabEvPtr = (NewGrabWinEvent *) ckalloc(sizeof(NewGrabWinEvent));
+ grabEvPtr->header.proc = GrabWinEventProc;
+ grabEvPtr->dispPtr = dispPtr;
+ if (grabWinPtr == NULL) {
+ grabEvPtr->grabWindow = None;
+ } else {
+ grabEvPtr->grabWindow = grabWinPtr->window;
+ }
+ Tcl_QueueEvent(&grabEvPtr->header, TCL_QUEUE_MARK);
+ dispPtr->eventualGrabWinPtr = grabWinPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GrabWinEventProc --
+ *
+ * This procedure is invoked as a handler for Tcl_Events of type
+ * NewGrabWinEvent. It updates the current grab window field in
+ * a display.
+ *
+ * Results:
+ * Returns 1 if the event was processed, 0 if it should be deferred
+ * for processing later.
+ *
+ * Side effects:
+ * The grabWinPtr field is modified in the display associated with
+ * the event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GrabWinEventProc(evPtr, flags)
+ Tcl_Event *evPtr; /* Event of type NewGrabWinEvent. */
+ int flags; /* Flags argument to Tk_DoOneEvent: indicates
+ * what kinds of events are being processed
+ * right now. */
+{
+ NewGrabWinEvent *grabEvPtr = (NewGrabWinEvent *) evPtr;
+
+ grabEvPtr->dispPtr->grabWinPtr = (TkWindow *) Tk_IdToWindow(
+ grabEvPtr->dispPtr->display, grabEvPtr->grabWindow);
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindCommonAncestor --
+ *
+ * Given two windows, this procedure finds their least common
+ * ancestor and also computes how many levels up this ancestor
+ * is from each of the original windows.
+ *
+ * Results:
+ * If the windows are in different applications or top-level
+ * windows, then NULL is returned and *countPtr1 and *countPtr2
+ * are set to the depths of the two windows in their respective
+ * top-level windows (1 means the window is a top-level, 2 means
+ * its parent is a top-level, and so on). Otherwise, the return
+ * value is a pointer to the common ancestor and the counts are
+ * set to the distance of winPtr1 and winPtr2 from this ancestor
+ * (1 means they're children, 2 means grand-children, etc.).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkWindow *
+FindCommonAncestor(winPtr1, winPtr2, countPtr1, countPtr2)
+ TkWindow *winPtr1; /* First window. May be NULL. */
+ TkWindow *winPtr2; /* Second window. May be NULL. */
+ int *countPtr1; /* Store nesting level of winPtr1 within
+ * common ancestor here. */
+ int *countPtr2; /* Store nesting level of winPtr2 within
+ * common ancestor here. */
+{
+ register TkWindow *winPtr;
+ TkWindow *ancestorPtr;
+ int count1, count2, i;
+
+ /*
+ * Mark winPtr1 and all of its ancestors with a special flag bit.
+ */
+
+ if (winPtr1 != NULL) {
+ for (winPtr = winPtr1; winPtr != NULL; winPtr = winPtr->parentPtr) {
+ winPtr->flags |= TK_GRAB_FLAG;
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ break;
+ }
+ }
+ }
+
+ /*
+ * Search upwards from winPtr2 until an ancestor of winPtr1 is
+ * found or a top-level window is reached.
+ */
+
+ winPtr = winPtr2;
+ count2 = 0;
+ ancestorPtr = NULL;
+ if (winPtr2 != NULL) {
+ for (; winPtr != NULL; count2++, winPtr = winPtr->parentPtr) {
+ if (winPtr->flags & TK_GRAB_FLAG) {
+ ancestorPtr = winPtr;
+ break;
+ }
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ count2++;
+ break;
+ }
+ }
+ }
+
+ /*
+ * Search upwards from winPtr1 again, clearing the flag bits and
+ * remembering how many levels up we had to go.
+ */
+
+ if (winPtr1 == NULL) {
+ count1 = 0;
+ } else {
+ count1 = -1;
+ for (i = 0, winPtr = winPtr1; winPtr != NULL;
+ i++, winPtr = winPtr->parentPtr) {
+ winPtr->flags &= ~TK_GRAB_FLAG;
+ if (winPtr == ancestorPtr) {
+ count1 = i;
+ }
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ if (count1 == -1) {
+ count1 = i+1;
+ }
+ break;
+ }
+ }
+ }
+
+ *countPtr1 = count1;
+ *countPtr2 = count2;
+ return ancestorPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPositionInTree --
+ *
+ * Compute where the given window is relative to a particular
+ * subtree of the window hierarchy.
+ *
+ * Results:
+ *
+ * Returns TK_GRAB_IN_TREE if the window is contained in the
+ * subtree. Returns TK_GRAB_ANCESTOR if the window is an
+ * ancestor of the subtree, in the same toplevel. Otherwise
+ * it returns TK_GRAB_EXCLUDED.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkPositionInTree(winPtr, treePtr)
+ TkWindow *winPtr; /* Window to be checked. */
+ TkWindow *treePtr; /* Root of tree to compare against. */
+{
+ TkWindow *winPtr2;
+
+ for (winPtr2 = winPtr; winPtr2 != treePtr;
+ winPtr2 = winPtr2->parentPtr) {
+ if (winPtr2 == NULL) {
+ for (winPtr2 = treePtr; winPtr2 != NULL;
+ winPtr2 = winPtr2->parentPtr) {
+ if (winPtr2 == winPtr) {
+ return TK_GRAB_ANCESTOR;
+ }
+ if (winPtr2->flags & TK_TOP_LEVEL) {
+ break;
+ }
+ }
+ return TK_GRAB_EXCLUDED;
+ }
+ }
+ return TK_GRAB_IN_TREE;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGrabState --
+ *
+ * Given a window, this procedure returns a value that indicates
+ * the grab state of the application relative to the window.
+ *
+ * Results:
+ * The return value is one of three things:
+ * TK_GRAB_NONE - no grab is in effect.
+ * TK_GRAB_IN_TREE - there is a grab in effect, and winPtr
+ * is in the grabbed subtree.
+ * TK_GRAB_ANCESTOR - there is a grab in effect; winPtr is
+ * an ancestor of the grabbed window, in
+ * the same toplevel.
+ * TK_GRAB_EXCLUDED - there is a grab in effect; winPtr is
+ * outside the tree of the grab and is not
+ * an ancestor of the grabbed window in the
+ * same toplevel.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkGrabState(winPtr)
+ TkWindow *winPtr; /* Window for which grab information is
+ * needed. */
+{
+ TkWindow *grabWinPtr = winPtr->dispPtr->grabWinPtr;
+
+ if (grabWinPtr == NULL) {
+ return TK_GRAB_NONE;
+ }
+ if ((winPtr->mainPtr != grabWinPtr->mainPtr)
+ && !(winPtr->dispPtr->grabFlags & GRAB_GLOBAL)) {
+ return TK_GRAB_NONE;
+ }
+
+ return TkPositionInTree(winPtr, grabWinPtr);
+}
diff --git a/tk/generic/tkGrid.c b/tk/generic/tkGrid.c
new file mode 100644
index 00000000000..e78eb7e3b78
--- /dev/null
+++ b/tk/generic/tkGrid.c
@@ -0,0 +1,2615 @@
+/*
+ * 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$
+ */
+
+#include "tkInt.h"
+
+/*
+ * Convenience Macros
+ */
+
+#ifdef MAX
+# undef MAX
+#endif
+#define MAX(x,y) ((x) > (y) ? (x) : (y))
+#ifdef MIN
+# undef MIN
+#endif
+#define MIN(x,y) ((x) > (y) ? (y) : (x))
+
+#define COLUMN (1) /* working on column offsets */
+#define ROW (2) /* working on row offsets */
+
+#define CHECK_ONLY (1) /* check max slot constraint */
+#define CHECK_SPACE (2) /* alloc more space, don't change max */
+
+/*
+ * Pre-allocate enough row and column slots for "typical" sized tables
+ * this value should be chosen so by the time the extra malloc's are
+ * required, the layout calculations overwehlm them. [A "slot" contains
+ * information for either a row or column, depending upon the context.]
+ */
+
+#define TYPICAL_SIZE 25 /* (arbitrary guess) */
+#define PREALLOC 10 /* extra slots to allocate */
+
+/*
+ * Data structures are allocated dynamically to support arbitrary sized tables.
+ * However, the space is proportional to the highest numbered slot with
+ * some non-default property. This limit is used to head off mistakes and
+ * denial of service attacks by limiting the amount of storage required.
+ */
+
+#define MAX_ELEMENT 10000
+
+/*
+ * Special characters to support relative layouts.
+ */
+
+#define REL_SKIP 'x' /* Skip this column. */
+#define REL_HORIZ '-' /* Extend previous widget horizontally. */
+#define REL_VERT '^' /* Extend widget from row above. */
+
+/*
+ * Structure to hold information for grid masters. A slot is either
+ * a row or column.
+ */
+
+typedef struct SlotInfo {
+ int minSize; /* The minimum size of this slot (in pixels).
+ * It is set via the rowconfigure or
+ * columnconfigure commands. */
+ int weight; /* The resize weight of this slot. (0) means
+ * this slot doesn't resize. Extra space in
+ * the layout is given distributed among slots
+ * inproportion to their weights. */
+ int pad; /* Extra padding, in pixels, required for
+ * this slot. This amount is "added" to the
+ * largest slave in the slot. */
+ int offset; /* This is a cached value used for
+ * introspection. It is the pixel
+ * offset of the right or bottom edge
+ * of this slot from the beginning of the
+ * layout. */
+ int temp; /* This is a temporary value used for
+ * calculating adjusted weights when
+ * shrinking the layout below its
+ * nominal size. */
+} SlotInfo;
+
+/*
+ * Structure to hold information during layout calculations. There
+ * is one of these for each slot, an array for each of the rows or columns.
+ */
+
+typedef struct GridLayout {
+ struct Gridder *binNextPtr; /* The next slave window in this bin.
+ * Each bin contains a list of all
+ * slaves whose spans are >1 and whose
+ * right edges fall in this slot. */
+ int minSize; /* Minimum size needed for this slot,
+ * in pixels. This is the space required
+ * to hold any slaves contained entirely
+ * in this slot, adjusted for any slot
+ * constrants, such as size or padding. */
+ int pad; /* Padding needed for this slot */
+ int weight; /* Slot weight, controls resizing. */
+ int minOffset; /* The minimum offset, in pixels, from
+ * the beginning of the layout to the
+ * right/bottom edge of the slot calculated
+ * from top/left to bottom/right. */
+ int maxOffset; /* The maximum offset, in pixels, from
+ * the beginning of the layout to the
+ * right-or-bottom edge of the slot calculated
+ * from bottom-or-right to top-or-left. */
+} GridLayout;
+
+/*
+ * Keep one of these for each geometry master.
+ */
+
+typedef struct {
+ SlotInfo *columnPtr; /* Pointer to array of column constraints. */
+ SlotInfo *rowPtr; /* Pointer to array of row constraints. */
+ int columnEnd; /* The last column occupied by any slave. */
+ int columnMax; /* The number of columns with constraints. */
+ int columnSpace; /* The number of slots currently allocated for
+ * column constraints. */
+ int rowEnd; /* The last row occupied by any slave. */
+ int rowMax; /* The number of rows with constraints. */
+ int rowSpace; /* The number of slots currently allocated
+ * for row constraints. */
+ int startX; /* Pixel offset of this layout within its
+ * parent. */
+ int startY; /* Pixel offset of this layout within its
+ * parent. */
+} GridMaster;
+
+/*
+ * For each window that the grid cares about (either because
+ * the window is managed by the grid or because the window
+ * has slaves that are managed by the grid), there is a
+ * structure of the following type:
+ */
+
+typedef struct Gridder {
+ Tk_Window tkwin; /* Tk token for window. NULL means that
+ * the window has been deleted, but the
+ * gridder hasn't had a chance to clean up
+ * yet because the structure is still in
+ * use. */
+ struct Gridder *masterPtr; /* Master window within which this window
+ * is managed (NULL means this window
+ * isn't managed by the gridder). */
+ struct Gridder *nextPtr; /* Next window managed within same
+ * parent. List order doesn't matter. */
+ struct Gridder *slavePtr; /* First in list of slaves managed
+ * inside this window (NULL means
+ * no grid slaves). */
+ GridMaster *masterDataPtr; /* Additional data for geometry master. */
+ int column, row; /* Location in the grid (starting
+ * from zero). */
+ int numCols, numRows; /* Number of columns or rows this slave spans.
+ * Should be at least 1. */
+ int padX, padY; /* Total additional pixels to leave around the
+ * window (half of this space is left on each
+ * side). This is space *outside* the window:
+ * we'll allocate extra space in frame but
+ * won't enlarge window). */
+ int iPadX, iPadY; /* Total extra pixels to allocate inside the
+ * window (half this amount will appear on
+ * each side). */
+ int sticky; /* which sides of its cavity this window
+ * sticks to. See below for definitions */
+ int doubleBw; /* Twice the window's last known border
+ * width. If this changes, the window
+ * must be re-arranged within its parent. */
+ int *abortPtr; /* If non-NULL, it means that there is a nested
+ * call to ArrangeGrid already working on
+ * this window. *abortPtr may be set to 1 to
+ * abort that nested call. This happens, for
+ * example, if tkwin or any of its slaves
+ * is deleted. */
+ int flags; /* Miscellaneous flags; see below
+ * for definitions. */
+
+ /*
+ * These fields are used temporarily for layout calculations only.
+ */
+
+ struct Gridder *binNextPtr; /* Link to next span>1 slave in this bin. */
+ int size; /* Nominal size (width or height) in pixels
+ * of the slave. This includes the padding. */
+} Gridder;
+
+/* Flag values for "sticky"ness The 16 combinations subsume the packer's
+ * notion of anchor and fill.
+ *
+ * STICK_NORTH This window sticks to the top of its cavity.
+ * STICK_EAST This window sticks to the right edge of its cavity.
+ * STICK_SOUTH This window sticks to the bottom of its cavity.
+ * STICK_WEST This window sticks to the left edge of its cavity.
+ */
+
+#define STICK_NORTH 1
+#define STICK_EAST 2
+#define STICK_SOUTH 4
+#define STICK_WEST 8
+
+/*
+ * Flag values for Grid structures:
+ *
+ * REQUESTED_RELAYOUT: 1 means a Tcl_DoWhenIdle request
+ * has already been made to re-arrange
+ * all the slaves of this window.
+ *
+ * DONT_PROPAGATE: 1 means don't set this window's requested
+ * size. 0 means if this window is a master
+ * 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,
+ int elements, SlotInfo *slotPtr));
+static void ArrangeGrid _ANSI_ARGS_((ClientData clientData));
+static int CheckSlotData _ANSI_ARGS_((Gridder *masterPtr, int slot,
+ int slotType, int checkOnly));
+static int ConfigureSlaves _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, int argc, char *argv[]));
+static void DestroyGrid _ANSI_ARGS_((char *memPtr));
+static Gridder *GetGrid _ANSI_ARGS_((Tk_Window tkwin));
+static void GridStructureProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static void GridLostSlaveProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void GridReqProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void InitMasterData _ANSI_ARGS_((Gridder *masterPtr));
+static int ResolveConstraints _ANSI_ARGS_((Gridder *gridPtr,
+ int rowOrColumn, int maxOffset));
+static void SetGridSize _ANSI_ARGS_((Gridder *gridPtr));
+static void StickyToString _ANSI_ARGS_((int flags, char *result));
+static int StringToSticky _ANSI_ARGS_((char *string));
+static void Unlink _ANSI_ARGS_((Gridder *gridPtr));
+
+static Tk_GeomMgr gridMgrType = {
+ "grid", /* name */
+ GridReqProc, /* requestProc */
+ GridLostSlaveProc, /* lostSlaveProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GridCmd --
+ *
+ * This procedure is invoked to process the "grid" 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_GridCmd(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;
+ Gridder *masterPtr; /* master grid record */
+ GridMaster *gridPtr; /* pointer to grid data */
+ size_t length; /* streing length of argument */
+ char c; /* 1st character of argument */
+
+ if ((argc >= 2) && ((argv[1][0] == '.') || (argv[1][0] == REL_SKIP) ||
+ (argv[1][0] == REL_VERT))) {
+ return ConfigureSlaves(interp, tkwin, argc-1, argv+1);
+ }
+ if (argc < 3) {
+ 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 == '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;
+ }
+
+ master = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (master == NULL) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+
+ if (argc >= 5) {
+ if (Tcl_GetInt(interp, argv[3], &column) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[4], &row) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ column2 = column;
+ row2 = row;
+ }
+
+ if (argc == 7) {
+ if (Tcl_GetInt(interp, argv[5], &column2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ 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;
+ }
+
+ if (column > column2) {
+ int temp = column;
+ column = column2, column2 = temp;
+ }
+ if (row > row2) {
+ int temp = row;
+ row = row2, row2 = temp;
+ }
+
+ if (column > 0 && column < endX) {
+ x = gridPtr->columnPtr[column-1].offset;
+ } else if (column > 0) {
+ x = gridPtr->columnPtr[endX-1].offset;
+ }
+
+ if (row > 0 && row < endY) {
+ y = gridPtr->rowPtr[row-1].offset;
+ } else if (row > 0) {
+ y = gridPtr->rowPtr[endY-1].offset;
+ }
+
+ if (column2 < 0) {
+ width = 0;
+ } else if (column2 >= endX) {
+ width = gridPtr->columnPtr[endX-1].offset - x;
+ } else {
+ width = gridPtr->columnPtr[column2].offset - x;
+ }
+
+ if (row2 < 0) {
+ 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);
+ } else if (((c == 'f') && (strncmp(argv[1], "forget", length) == 0)) ||
+ ((c == 'r') && (strncmp(argv[1], "remove", length) == 0))) {
+ Tk_Window slave;
+ Gridder *slavePtr;
+ int i;
+
+ for (i = 2; i < argc; i++) {
+ slave = Tk_NameToWindow(interp, argv[i], tkwin);
+ if (slave == NULL) {
+ return TCL_ERROR;
+ }
+ slavePtr = GetGrid(slave);
+ if (slavePtr->masterPtr != NULL) {
+
+ /*
+ * For "forget", reset all the settings to their defaults
+ */
+
+ 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,
+ slavePtr->numCols, slavePtr->numRows);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ sprintf(buffer, " -ipadx %d -ipady %d -padx %d -pady %d",
+ slavePtr->iPadX/2, slavePtr->iPadY/2, slavePtr->padX/2,
+ slavePtr->padY/2);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ StickyToString(slavePtr->sticky,buffer);
+ 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;
+ }
+
+ master = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (master == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (Tk_GetPixels(interp, master, argv[3], &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ 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
+ * the pipeline, but its as close as its easy to get.
+ */
+
+ while (masterPtr->flags & REQUESTED_RELAYOUT) {
+ Tk_CancelIdleCall(ArrangeGrid, (ClientData) masterPtr);
+ ArrangeGrid ((ClientData) masterPtr);
+ }
+ SetGridSize(masterPtr);
+ endX = MAX(gridPtr->columnEnd, gridPtr->columnMax);
+ endY = MAX(gridPtr->rowEnd, gridPtr->rowMax);
+
+ slotPtr = masterPtr->masterDataPtr->columnPtr;
+ if (x < masterPtr->masterDataPtr->startX) {
+ i = -1;
+ } else {
+ x -= masterPtr->masterDataPtr->startX;
+ for (i=0;slotPtr[i].offset < x && i < endX; i++) {
+ /* null body */
+ }
+ }
+
+ slotPtr = masterPtr->masterDataPtr->rowPtr;
+ if (y < masterPtr->masterDataPtr->startY) {
+ j = -1;
+ } 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;
+
+ /*
+ * Re-arrange the master to allow new geometry information to
+ * propagate upwards to the master's master.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_RELAYOUT)) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr);
+ }
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "size", length) == 0)
+ && (length > 1)) {
+ Tk_Window master;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " size window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ 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;
+
+ if ((argc < 3) || ((argc%2) == 0)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " slaves window ?-option value...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ for (i=3; i<argc; i+=2) {
+ length = strlen(argv[i]);
+ if ((*argv[i] != '-') || (length < 2)) {
+ Tcl_AppendResult(interp, "invalid args: should be \"",
+ argv[0], " slaves window ?-option value...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[i+1], &value) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (value < 0) {
+ Tcl_AppendResult(interp, argv[i],
+ " is an invalid value: should NOT be < 0",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (strncmp(argv[i], "-column", length) == 0) {
+ column = value;
+ } else if (strncmp(argv[i], "-row", length) == 0) {
+ row = value;
+ } else {
+ Tcl_AppendResult(interp, argv[i],
+ " is an invalid option: should be \"",
+ "-row, -column\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ master = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (master == NULL) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetGrid(master);
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ if (column>=0 && (slavePtr->column > column
+ || slavePtr->column+slavePtr->numCols-1 < column)) {
+ continue;
+ }
+ if (row>=0 && (slavePtr->row > row ||
+ slavePtr->row+slavePtr->numRows-1 < row)) {
+ continue;
+ }
+ Tcl_AppendElement(interp, Tk_PathName(slavePtr->tkwin));
+ }
+
+ /*
+ * Sample argument combinations:
+ * grid columnconfigure <master> <index> -option
+ * grid columnconfigure <master> <index> -option value -option value
+ * grid rowconfigure <master> <index>
+ * grid rowconfigure <master> <index> -option
+ * grid rowconfigure <master> <index> -option value -option value.
+ */
+
+ } else if(((c == 'c') && (strncmp(argv[1], "columnconfigure", length) == 0)
+ && (length >= 3)) ||
+ ((c == 'r') && (strncmp(argv[1], "rowconfigure", length) == 0)
+ && (length >=2))) {
+ Tk_Window master;
+ SlotInfo *slotPtr = NULL;
+ int slot; /* the column or row number */
+ size_t length; /* the # of chars in the "-option" string */
+ int slotType; /* COLUMN or ROW */
+ int size; /* the configuration value */
+ int checkOnly; /* check the size only */
+ int argcPtr; /* Number of items in index list */
+ char **argvPtr; /* array of indeces */
+ char **indexP; /* String value of current index list item. */
+ int ok; /* temporary TCL result code */
+ int i;
+
+ if (((argc%2 != 0) && (argc>6)) || (argc < 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " ", argv[1], " master index ?-option value...?\"",
+ (char *)NULL);
+ return TCL_ERROR;
+ }
+
+ master = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (master == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (Tcl_SplitList(interp, argv[3], &argcPtr, &argvPtr) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ checkOnly = ((argc == 4) || (argc == 5));
+ masterPtr = GetGrid(master);
+ slotType = (c == 'c') ? COLUMN : ROW;
+ if (checkOnly && argcPtr > 1) {
+ Tcl_AppendResult(interp, argv[3],
+ " must be a single element.", (char *) NULL);
+ Tcl_Free((char *)argvPtr);
+ return TCL_ERROR;
+ }
+ for (indexP=argvPtr; *indexP != NULL; indexP++) {
+ if (Tcl_GetInt(interp, *indexP, &slot) != TCL_OK) {
+ Tcl_Free((char *)argvPtr);
+ return TCL_ERROR;
+ }
+ ok = CheckSlotData(masterPtr, slot, slotType, checkOnly);
+ if ((ok!=TCL_OK) && ((argc<4) || (argc>5))) {
+ Tcl_AppendResult(interp, argv[0],
+ " ", argv[1], ": \"", *argvPtr,"\" is out of range",
+ (char *) NULL);
+ Tcl_Free((char *)argvPtr);
+ return TCL_ERROR;
+ } else if (ok == TCL_OK) {
+ slotPtr = (slotType == COLUMN) ?
+ masterPtr->masterDataPtr->columnPtr :
+ masterPtr->masterDataPtr->rowPtr;
+ }
+
+ /*
+ * Return all of the options for this row or column. If the
+ * 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);
+ Tcl_Free((char *)argvPtr);
+ return TCL_ERROR;
+ } else {
+ slotPtr[slot].pad = size;
+ }
+ } else {
+ Tcl_AppendResult(interp, "invalid arg \"",
+ argv[i], "\": expecting -minsize, -pad, or -weight.",
+ (char *) NULL);
+ Tcl_Free((char *)argvPtr);
+ return TCL_ERROR;
+ }
+ }
+ }
+ Tcl_Free((char *)argvPtr);
+
+ /*
+ * If we changed a property, re-arrange the table,
+ * and check for constraint shrinkage.
+ */
+
+ if (argc != 5) {
+ if (slotType == ROW) {
+ int last = masterPtr->masterDataPtr->rowMax - 1;
+ while ((last >= 0) && (slotPtr[last].weight == 0)
+ && (slotPtr[last].pad == 0)
+ && (slotPtr[last].minSize == 0)) {
+ last--;
+ }
+ masterPtr->masterDataPtr->rowMax = last+1;
+ } else {
+ int last = masterPtr->masterDataPtr->columnMax - 1;
+ while ((last >= 0) && (slotPtr[last].weight == 0)
+ && (slotPtr[last].pad == 0)
+ && (slotPtr[last].minSize == 0)) {
+ last--;
+ }
+ masterPtr->masterDataPtr->columnMax = last + 1;
+ }
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_RELAYOUT)) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr);
+ }
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be bbox, columnconfigure, configure, forget, info, ",
+ "location, propagate, remove, rowconfigure, size, or slaves.",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GridReqProc --
+ *
+ * This procedure is invoked by Tk_GeometryRequest for
+ * windows managed by the grid.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for tkwin, and all its managed siblings, to
+ * be re-arranged at the next idle point.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+GridReqProc(clientData, tkwin)
+ ClientData clientData; /* Grid's information about
+ * window that got new preferred
+ * geometry. */
+ Tk_Window tkwin; /* Other Tk-related information
+ * about the window. */
+{
+ register Gridder *gridPtr = (Gridder *) clientData;
+
+ gridPtr = gridPtr->masterPtr;
+ if (!(gridPtr->flags & REQUESTED_RELAYOUT)) {
+ gridPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GridLostSlaveProc --
+ *
+ * This procedure is invoked by Tk whenever some other geometry
+ * claims control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all grid-related information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+GridLostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* Grid structure for slave window that
+ * was stolen away. */
+ Tk_Window tkwin; /* Tk's handle for the slave window. */
+{
+ register Gridder *slavePtr = (Gridder *) clientData;
+
+ if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin);
+ }
+ Unlink(slavePtr);
+ Tk_UnmapWindow(slavePtr->tkwin);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AdjustOffsets --
+ *
+ * This procedure adjusts the size of the layout to fit in the
+ * space provided. If it needs more space, the extra is added
+ * according to the weights. If it needs less, the space is removed
+ * according to the weights, but at no time does the size drop below
+ * the minsize specified for that slot.
+ *
+ * Results:
+ * The initial offset of the layout,
+ * if all the weights are zero, else 0.
+ *
+ * Side effects:
+ * The slot offsets are modified to shrink the layout.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+AdjustOffsets(size, slots, slotPtr)
+ int size; /* The total layout size (in pixels). */
+ int slots; /* Number of slots. */
+ register SlotInfo *slotPtr; /* Pointer to slot array. */
+{
+ register int slot; /* Current slot. */
+ int diff; /* Extra pixels needed to add to the layout. */
+ int totalWeight = 0; /* Sum of the weights for all the slots. */
+ int weight = 0; /* Sum of the weights so far. */
+ int minSize = 0; /* Minimum possible layout size. */
+ int newDiff; /* The most pixels that can be added on
+ * the current pass. */
+
+ diff = size - slotPtr[slots-1].offset;
+
+ /*
+ * The layout is already the correct size; all done.
+ */
+
+ if (diff == 0) {
+ return(0);
+ }
+
+ /*
+ * If all the weights are zero, center the layout in its parent if
+ * there is extra space, else clip on the bottom/right.
+ */
+
+ for (slot=0; slot < slots; slot++) {
+ totalWeight += slotPtr[slot].weight;
+ }
+
+ if (totalWeight == 0 ) {
+ return(diff > 0 ? diff/2 : 0);
+ }
+
+ /*
+ * Add extra space according to the slot weights. This is done
+ * cumulatively to prevent round-off error accumulation.
+ */
+
+ if (diff > 0) {
+ for (weight=slot=0; slot < slots; slot++) {
+ weight += slotPtr[slot].weight;
+ slotPtr[slot].offset += diff * weight / totalWeight;
+ }
+ return(0);
+ }
+
+ /*
+ * The layout must shrink below its requested size. Compute the
+ * minimum possible size by looking at the slot minSizes.
+ */
+
+ for (slot=0; slot < slots; slot++) {
+ if (slotPtr[slot].weight > 0) {
+ minSize += slotPtr[slot].minSize;
+ } else if (slot > 0) {
+ minSize += slotPtr[slot].offset - slotPtr[slot-1].offset;
+ } else {
+ minSize += slotPtr[slot].offset;
+ }
+ }
+
+ /*
+ * If the requested size is less than the minimum required size,
+ * set the slot sizes to their minimum values, then clip on the
+ * bottom/right.
+ */
+
+ if (size <= minSize) {
+ int offset = 0;
+ for (slot=0; slot < slots; slot++) {
+ if (slotPtr[slot].weight > 0) {
+ offset += slotPtr[slot].minSize;
+ } else if (slot > 0) {
+ offset += slotPtr[slot].offset - slotPtr[slot-1].offset;
+ } else {
+ offset += slotPtr[slot].offset;
+ }
+ slotPtr[slot].offset = offset;
+ }
+ return(0);
+ }
+
+ /*
+ * Remove space from slots according to their weights. The weights
+ * get renormalized anytime a slot shrinks to its minimum size.
+ */
+
+ while (diff < 0) {
+
+ /*
+ * Find the total weight for the shrinkable slots.
+ */
+
+ for (totalWeight=slot=0; slot < slots; slot++) {
+ int current = (slot == 0) ? slotPtr[slot].offset :
+ slotPtr[slot].offset - slotPtr[slot-1].offset;
+ if (current > slotPtr[slot].minSize) {
+ totalWeight += slotPtr[slot].weight;
+ slotPtr[slot].temp = slotPtr[slot].weight;
+ } else {
+ slotPtr[slot].temp = 0;
+ }
+ }
+ if (totalWeight == 0) {
+ break;
+ }
+
+ /*
+ * Find the maximum amount of space we can distribute this pass.
+ */
+
+ newDiff = diff;
+ for (slot = 0; slot < slots; slot++) {
+ int current; /* current size of this slot */
+ int maxDiff; /* max diff that would cause
+ * this slot to equal its minsize */
+ if (slotPtr[slot].temp == 0) {
+ continue;
+ }
+ current = (slot == 0) ? slotPtr[slot].offset :
+ slotPtr[slot].offset - slotPtr[slot-1].offset;
+ maxDiff = totalWeight * (slotPtr[slot].minSize - current)
+ / slotPtr[slot].temp;
+ if (maxDiff > newDiff) {
+ newDiff = maxDiff;
+ }
+ }
+
+ /*
+ * Now distribute the space.
+ */
+
+ for (weight=slot=0; slot < slots; slot++) {
+ weight += slotPtr[slot].temp;
+ slotPtr[slot].offset += newDiff * weight / totalWeight;
+ }
+ diff -= newDiff;
+ }
+ return(0);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AdjustForSticky --
+ *
+ * This procedure adjusts the size of a slave in its cavity based
+ * on its "sticky" flags.
+ *
+ * Results:
+ * The input x, y, width, and height are changed to represent the
+ * desired coordinates of the slave.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+AdjustForSticky(slavePtr, xPtr, yPtr, widthPtr, heightPtr)
+ Gridder *slavePtr; /* Slave window to arrange in its cavity. */
+ int *xPtr; /* Pixel location of the left edge of the cavity. */
+ int *yPtr; /* Pixel location of the top edge of the cavity. */
+ int *widthPtr; /* Width of the cavity (in pixels). */
+ int *heightPtr; /* Height of the cavity (in pixels). */
+{
+ int diffx=0; /* Cavity width - slave width. */
+ int diffy=0; /* Cavity hight - slave height. */
+ int sticky = slavePtr->sticky;
+
+ *xPtr += slavePtr->padX/2;
+ *widthPtr -= slavePtr->padX;
+ *yPtr += slavePtr->padY/2;
+ *heightPtr -= slavePtr->padY;
+
+ if (*widthPtr > (Tk_ReqWidth(slavePtr->tkwin) + slavePtr->iPadX)) {
+ diffx = *widthPtr - (Tk_ReqWidth(slavePtr->tkwin) + slavePtr->iPadX);
+ *widthPtr = Tk_ReqWidth(slavePtr->tkwin) + slavePtr->iPadX;
+ }
+
+ if (*heightPtr > (Tk_ReqHeight(slavePtr->tkwin) + slavePtr->iPadY)) {
+ diffy = *heightPtr - (Tk_ReqHeight(slavePtr->tkwin) + slavePtr->iPadY);
+ *heightPtr = Tk_ReqHeight(slavePtr->tkwin) + slavePtr->iPadY;
+ }
+
+ if (sticky&STICK_EAST && sticky&STICK_WEST) {
+ *widthPtr += diffx;
+ }
+ if (sticky&STICK_NORTH && sticky&STICK_SOUTH) {
+ *heightPtr += diffy;
+ }
+ if (!(sticky&STICK_WEST)) {
+ *xPtr += (sticky&STICK_EAST) ? diffx : diffx/2;
+ }
+ if (!(sticky&STICK_NORTH)) {
+ *yPtr += (sticky&STICK_SOUTH) ? diffy : diffy/2;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArrangeGrid --
+ *
+ * This procedure is invoked (using the Tcl_DoWhenIdle
+ * mechanism) to re-layout a set of windows managed by
+ * the grid. It is invoked at idle time so that a
+ * series of grid requests can be merged into a single
+ * layout operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The slaves of masterPtr may get resized or moved.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ArrangeGrid(clientData)
+ ClientData clientData; /* Structure describing parent whose slaves
+ * are to be re-layed out. */
+{
+ register Gridder *masterPtr = (Gridder *) clientData;
+ register Gridder *slavePtr;
+ GridMaster *slotPtr = masterPtr->masterDataPtr;
+ int abort;
+ int width, height; /* requested size of layout, in pixels */
+ int realWidth, realHeight; /* actual size layout should take-up */
+
+ masterPtr->flags &= ~REQUESTED_RELAYOUT;
+
+ /*
+ * If the parent has no slaves anymore, then don't do anything
+ * at all: just leave the parent's size as-is. Otherwise there is
+ * no way to "relinquish" control over the parent so another geometry
+ * manager can take over.
+ */
+
+ if (masterPtr->slavePtr == NULL) {
+ return;
+ }
+
+ if (masterPtr->masterDataPtr == NULL) {
+ return;
+ }
+
+ /*
+ * Abort any nested call to ArrangeGrid for this window, since
+ * we'll do everything necessary here, and set up so this call
+ * can be aborted if necessary.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ masterPtr->abortPtr = &abort;
+ abort = 0;
+ Tcl_Preserve((ClientData) masterPtr);
+
+ /*
+ * Call the constraint engine to fill in the row and column offsets.
+ */
+
+ SetGridSize(masterPtr);
+ width = ResolveConstraints(masterPtr, COLUMN, 0);
+ height = ResolveConstraints(masterPtr, ROW, 0);
+ width += 2*Tk_InternalBorderWidth(masterPtr->tkwin);
+ height += 2*Tk_InternalBorderWidth(masterPtr->tkwin);
+
+ if (((width != Tk_ReqWidth(masterPtr->tkwin))
+ || (height != Tk_ReqHeight(masterPtr->tkwin)))
+ && !(masterPtr->flags & DONT_PROPAGATE)) {
+ Tk_GeometryRequest(masterPtr->tkwin, width, height);
+ if (width>1 && height>1) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr);
+ }
+ masterPtr->abortPtr = NULL;
+ Tcl_Release((ClientData) masterPtr);
+ return;
+ }
+
+ /*
+ * If the currently requested layout size doesn't match the parent's
+ * window size, then adjust the slot offsets according to the
+ * weights. If all of the weights are zero, center the layout in
+ * its parent. I haven't decided what to do if the parent is smaller
+ * than the requested size.
+ */
+
+ realWidth = Tk_Width(masterPtr->tkwin) -
+ 2*Tk_InternalBorderWidth(masterPtr->tkwin);
+ realHeight = Tk_Height(masterPtr->tkwin) -
+ 2*Tk_InternalBorderWidth(masterPtr->tkwin);
+ slotPtr->startX = AdjustOffsets(realWidth,
+ MAX(slotPtr->columnEnd,slotPtr->columnMax), slotPtr->columnPtr);
+ slotPtr->startY = AdjustOffsets(realHeight,
+ MAX(slotPtr->rowEnd,slotPtr->rowMax), slotPtr->rowPtr);
+ slotPtr->startX += Tk_InternalBorderWidth(masterPtr->tkwin);
+ slotPtr->startY += Tk_InternalBorderWidth(masterPtr->tkwin);
+
+ /*
+ * Now adjust the actual size of the slave to its cavity by
+ * computing the cavity size, and adjusting the widget according
+ * to its stickyness.
+ */
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL && !abort;
+ slavePtr = slavePtr->nextPtr) {
+ int x, y; /* top left coordinate */
+ int width, height; /* slot or slave size */
+ int col = slavePtr->column;
+ int row = slavePtr->row;
+
+ x = (col>0) ? slotPtr->columnPtr[col-1].offset : 0;
+ y = (row>0) ? slotPtr->rowPtr[row-1].offset : 0;
+
+ width = slotPtr->columnPtr[slavePtr->numCols+col-1].offset - x;
+ height = slotPtr->rowPtr[slavePtr->numRows+row-1].offset - y;
+
+ x += slotPtr->startX;
+ y += slotPtr->startY;
+
+ AdjustForSticky(slavePtr, &x, &y, &width, &height);
+
+ /*
+ * Now put the window in the proper spot. (This was taken directly
+ * from tkPack.c.) If the slave is a child of the master, then
+ * do this here. Otherwise let Tk_MaintainGeometry do the work.
+ */
+
+ if (masterPtr->tkwin == Tk_Parent(slavePtr->tkwin)) {
+ if ((width <= 0) || (height <= 0)) {
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ if ((x != Tk_X(slavePtr->tkwin))
+ || (y != Tk_Y(slavePtr->tkwin))
+ || (width != Tk_Width(slavePtr->tkwin))
+ || (height != Tk_Height(slavePtr->tkwin))) {
+ Tk_MoveResizeWindow(slavePtr->tkwin, x, y, width, height);
+ }
+ if (abort) {
+ break;
+ }
+
+ /*
+ * Don't map the slave if the master isn't mapped: wait
+ * until the master gets mapped later.
+ */
+
+ if (Tk_IsMapped(masterPtr->tkwin)) {
+ Tk_MapWindow(slavePtr->tkwin);
+ }
+ }
+ } else {
+ if ((width <= 0) || (height <= 0)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, masterPtr->tkwin);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ Tk_MaintainGeometry(slavePtr->tkwin, masterPtr->tkwin,
+ x, y, width, height);
+ }
+ }
+ }
+
+ masterPtr->abortPtr = NULL;
+ Tcl_Release((ClientData) masterPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ResolveConstraints --
+ *
+ * Resolve all of the column and row boundaries. Most of
+ * the calculations are identical for rows and columns, so this procedure
+ * is called twice, once for rows, and again for columns.
+ *
+ * Results:
+ * The offset (in pixels) from the left/top edge of this layout is
+ * returned.
+ *
+ * Side effects:
+ * The slot offsets are copied into the SlotInfo structure for the
+ * geometry master.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ResolveConstraints(masterPtr, slotType, maxOffset)
+ Gridder *masterPtr; /* The geometry master for this grid. */
+ int slotType; /* Either ROW or COLUMN. */
+ int maxOffset; /* The actual maximum size of this layout
+ * in pixels, or 0 (not currently used). */
+{
+ register SlotInfo *slotPtr; /* Pointer to row/col constraints. */
+ register Gridder *slavePtr; /* List of slave windows in this grid. */
+ int constraintCount; /* Count of rows or columns that have
+ * constraints. */
+ int slotCount; /* Last occupied row or column. */
+ int gridCount; /* The larger of slotCount and constraintCount.
+ */
+ GridLayout *layoutPtr; /* Temporary layout structure. */
+ int requiredSize; /* The natural size of the grid (pixels).
+ * This is the minimum size needed to
+ * accomodate all of the slaves at their
+ * requested sizes. */
+ int offset; /* The pixel offset of the right edge of the
+ * current slot from the beginning of the
+ * layout. */
+ int slot; /* The current slot. */
+ int start; /* The first slot of a contiguous set whose
+ * constraints are not yet fully resolved. */
+ int end; /* The Last slot of a contiguous set whose
+ * constraints are not yet fully resolved. */
+
+ /*
+ * For typical sized tables, we'll use stack space for the layout data
+ * to avoid the overhead of a malloc and free for every layout.
+ */
+
+ GridLayout layoutData[TYPICAL_SIZE + 1];
+
+ if (slotType == COLUMN) {
+ constraintCount = masterPtr->masterDataPtr->columnMax;
+ slotCount = masterPtr->masterDataPtr->columnEnd;
+ slotPtr = masterPtr->masterDataPtr->columnPtr;
+ } else {
+ constraintCount = masterPtr->masterDataPtr->rowMax;
+ slotCount = masterPtr->masterDataPtr->rowEnd;
+ slotPtr = masterPtr->masterDataPtr->rowPtr;
+ }
+
+ /*
+ * Make sure there is enough memory for the layout.
+ */
+
+ gridCount = MAX(constraintCount,slotCount);
+ if (gridCount >= TYPICAL_SIZE) {
+ layoutPtr = (GridLayout *) Tcl_Alloc(sizeof(GridLayout) * (1+gridCount));
+ } else {
+ layoutPtr = layoutData;
+ }
+
+ /*
+ * Allocate an extra layout slot to represent the left/top edge of
+ * the 0th slot to make it easier to calculate slot widths from
+ * offsets without special case code.
+ * Initialize the "dummy" slot to the left/top of the table.
+ * This slot avoids special casing the first slot.
+ */
+
+ layoutPtr->minOffset = 0;
+ layoutPtr->maxOffset = 0;
+ layoutPtr++;
+
+ /*
+ * Step 1.
+ * Copy the slot constraints into the layout structure,
+ * and initialize the rest of the fields.
+ */
+
+ for (slot=0; slot < constraintCount; slot++) {
+ layoutPtr[slot].minSize = slotPtr[slot].minSize;
+ layoutPtr[slot].weight = slotPtr[slot].weight;
+ layoutPtr[slot].pad = slotPtr[slot].pad;
+ layoutPtr[slot].binNextPtr = NULL;
+ }
+ for(;slot<gridCount;slot++) {
+ layoutPtr[slot].minSize = 0;
+ layoutPtr[slot].weight = 0;
+ layoutPtr[slot].pad = 0;
+ layoutPtr[slot].binNextPtr = NULL;
+ }
+
+ /*
+ * Step 2.
+ * Slaves with a span of 1 are used to determine the minimum size of
+ * each slot. Slaves whose span is two or more slots don't
+ * contribute to the minimum size of each slot directly, but can cause
+ * slots to grow if their size exceeds the the sizes of the slots they
+ * span.
+ *
+ * Bin all slaves whose spans are > 1 by their right edges. This
+ * allows the computation on minimum and maximum possible layout
+ * sizes at each slot boundary, without the need to re-sort the slaves.
+ */
+
+ switch (slotType) {
+ case COLUMN:
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ int rightEdge = slavePtr->column + slavePtr->numCols - 1;
+ slavePtr->size = Tk_ReqWidth(slavePtr->tkwin) +
+ slavePtr->padX + slavePtr->iPadX + slavePtr->doubleBw;
+ if (slavePtr->numCols > 1) {
+ slavePtr->binNextPtr = layoutPtr[rightEdge].binNextPtr;
+ layoutPtr[rightEdge].binNextPtr = slavePtr;
+ } else {
+ int size = slavePtr->size + layoutPtr[rightEdge].pad;
+ if (size > layoutPtr[rightEdge].minSize) {
+ layoutPtr[rightEdge].minSize = size;
+ }
+ }
+ }
+ break;
+ case ROW:
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ int rightEdge = slavePtr->row + slavePtr->numRows - 1;
+ slavePtr->size = Tk_ReqHeight(slavePtr->tkwin) +
+ slavePtr->padY + slavePtr->iPadY + slavePtr->doubleBw;
+ if (slavePtr->numRows > 1) {
+ slavePtr->binNextPtr = layoutPtr[rightEdge].binNextPtr;
+ layoutPtr[rightEdge].binNextPtr = slavePtr;
+ } else {
+ int size = slavePtr->size + layoutPtr[rightEdge].pad;
+ if (size > layoutPtr[rightEdge].minSize) {
+ layoutPtr[rightEdge].minSize = size;
+ }
+ }
+ }
+ break;
+ }
+
+ /*
+ * Step 3.
+ * Determine the minimum slot offsets going from left to right
+ * that would fit all of the slaves. This determines the minimum
+ */
+
+ for (offset=slot=0; slot < gridCount; slot++) {
+ layoutPtr[slot].minOffset = layoutPtr[slot].minSize + offset;
+ for (slavePtr = layoutPtr[slot].binNextPtr; slavePtr != NULL;
+ slavePtr = slavePtr->binNextPtr) {
+ int span = (slotType == COLUMN) ? slavePtr->numCols : slavePtr->numRows;
+ int required = slavePtr->size + layoutPtr[slot - span].minOffset;
+ if (required > layoutPtr[slot].minOffset) {
+ layoutPtr[slot].minOffset = required;
+ }
+ }
+ offset = layoutPtr[slot].minOffset;
+ }
+
+ /*
+ * At this point, we know the minimum required size of the entire layout.
+ * It might be prudent to stop here if our "master" will resize itself
+ * to this size.
+ */
+
+ requiredSize = offset;
+ if (maxOffset > offset) {
+ offset=maxOffset;
+ }
+
+ /*
+ * Step 4.
+ * Determine the minimum slot offsets going from right to left,
+ * bounding the pixel range of each slot boundary.
+ * Pre-fill all of the right offsets with the actual size of the table;
+ * they will be reduced as required.
+ */
+
+ for (slot=0; slot < gridCount; slot++) {
+ layoutPtr[slot].maxOffset = offset;
+ }
+ for (slot=gridCount-1; slot > 0;) {
+ for (slavePtr = layoutPtr[slot].binNextPtr; slavePtr != NULL;
+ slavePtr = slavePtr->binNextPtr) {
+ int span = (slotType == COLUMN) ? slavePtr->numCols : slavePtr->numRows;
+ int require = offset - slavePtr->size;
+ int startSlot = slot - span;
+ if (startSlot >=0 && require < layoutPtr[startSlot].maxOffset) {
+ layoutPtr[startSlot].maxOffset = require;
+ }
+ }
+ offset -= layoutPtr[slot].minSize;
+ slot--;
+ if (layoutPtr[slot].maxOffset < offset) {
+ offset = layoutPtr[slot].maxOffset;
+ } else {
+ layoutPtr[slot].maxOffset = offset;
+ }
+ }
+
+ /*
+ * Step 5.
+ * At this point, each slot boundary has a range of values that
+ * will satisfy the overall layout size.
+ * Make repeated passes over the layout structure looking for
+ * spans of slot boundaries where the minOffsets are less than
+ * the maxOffsets, and adjust the offsets according to the slot
+ * weights. At each pass, at least one slot boundary will have
+ * its range of possible values fixed at a single value.
+ */
+
+ for (start=0; start < gridCount;) {
+ int totalWeight = 0; /* Sum of the weights for all of the
+ * slots in this span. */
+ int need = 0; /* The minimum space needed to layout
+ * this span. */
+ int have; /* The actual amount of space that will
+ * be taken up by this span. */
+ int weight; /* Cumulative weights of the columns in
+ * this span. */
+ int noWeights = 0; /* True if the span has no weights. */
+
+ /*
+ * Find a span by identifying ranges of slots whose edges are
+ * already constrained at fixed offsets, but whose internal
+ * slot boundaries have a range of possible positions.
+ */
+
+ if (layoutPtr[start].minOffset == layoutPtr[start].maxOffset) {
+ start++;
+ continue;
+ }
+
+ for (end=start+1; end<gridCount; end++) {
+ if (layoutPtr[end].minOffset == layoutPtr[end].maxOffset) {
+ break;
+ }
+ }
+
+ /*
+ * We found a span. Compute the total weight, minumum space required,
+ * for this span, and the actual amount of space the span should
+ * use.
+ */
+
+ for (slot=start; slot<=end; slot++) {
+ totalWeight += layoutPtr[slot].weight;
+ need += layoutPtr[slot].minSize;
+ }
+ have = layoutPtr[end].maxOffset - layoutPtr[start-1].minOffset;
+
+ /*
+ * If all the weights in the span are zero, then distribute the
+ * extra space evenly.
+ */
+
+ if (totalWeight == 0) {
+ noWeights++;
+ totalWeight = end - start + 1;
+ }
+
+ /*
+ * It might not be possible to give the span all of the space
+ * available on this pass without violating the size constraints
+ * of one or more of the internal slot boundaries.
+ * Determine the maximum amount of space that when added to the
+ * entire span, would cause a slot boundary to have its possible
+ * range reduced to one value, and reduce the amount of extra
+ * space allocated on this pass accordingly.
+ *
+ * The calculation is done cumulatively to avoid accumulating
+ * roundoff errors.
+ */
+
+ for (weight=0,slot=start; slot<end; slot++) {
+ int diff = layoutPtr[slot].maxOffset - layoutPtr[slot].minOffset;
+ weight += noWeights ? 1 : layoutPtr[slot].weight;
+ if ((noWeights || layoutPtr[slot].weight>0) &&
+ (diff*totalWeight/weight) < (have-need)) {
+ have = diff * totalWeight / weight + need;
+ }
+ }
+
+ /*
+ * Now distribute the extra space among the slots by
+ * adjusting the minSizes and minOffsets.
+ */
+
+ for (weight=0,slot=start; slot<end; slot++) {
+ weight += noWeights ? 1 : layoutPtr[slot].weight;
+ layoutPtr[slot].minOffset +=
+ (int)((double) (have-need) * weight/totalWeight + 0.5);
+ layoutPtr[slot].minSize = layoutPtr[slot].minOffset
+ - layoutPtr[slot-1].minOffset;
+ }
+ layoutPtr[slot].minSize = layoutPtr[slot].minOffset
+ - layoutPtr[slot-1].minOffset;
+
+ /*
+ * Having pushed the top/left boundaries of the slots to
+ * take up extra space, the bottom/right space is recalculated
+ * to propagate the new space allocation.
+ */
+
+ for (slot=end; slot > start; slot--) {
+ layoutPtr[slot-1].maxOffset =
+ layoutPtr[slot].maxOffset-layoutPtr[slot].minSize;
+ }
+ }
+
+
+ /*
+ * Step 6.
+ * All of the space has been apportioned; copy the
+ * layout information back into the master.
+ */
+
+ for (slot=0; slot < gridCount; slot++) {
+ slotPtr[slot].offset = layoutPtr[slot].minOffset;
+ }
+
+ --layoutPtr;
+ if (layoutPtr != layoutData) {
+ Tcl_Free((char *)layoutPtr);
+ }
+ return requiredSize;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetGrid --
+ *
+ * This internal procedure is used to locate a Grid
+ * structure for a given window, creating one if one
+ * doesn't exist already.
+ *
+ * Results:
+ * The return value is a pointer to the Grid structure
+ * corresponding to tkwin.
+ *
+ * Side effects:
+ * A new grid structure may be created. If so, then
+ * a callback is set up to clean things up when the
+ * window is deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Gridder *
+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;
+ gridPtr->nextPtr = NULL;
+ gridPtr->slavePtr = NULL;
+ gridPtr->binNextPtr = NULL;
+
+ gridPtr->column = gridPtr->row = -1;
+ gridPtr->numCols = 1;
+ gridPtr->numRows = 1;
+
+ gridPtr->padX = gridPtr->padY = 0;
+ gridPtr->iPadX = gridPtr->iPadY = 0;
+ gridPtr->doubleBw = 2*Tk_Changes(tkwin)->border_width;
+ gridPtr->abortPtr = NULL;
+ gridPtr->flags = 0;
+ gridPtr->sticky = 0;
+ gridPtr->size = 0;
+ gridPtr->masterDataPtr = NULL;
+ Tcl_SetHashValue(hPtr, gridPtr);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ GridStructureProc, (ClientData) gridPtr);
+ return gridPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SetGridSize --
+ *
+ * This internal procedure sets the size of the grid occupied
+ * by slaves.
+ *
+ * Results:
+ * none
+ *
+ * Side effects:
+ * The width and height arguments are filled in the master data structure.
+ * Additional space is allocated for the constraints to accomodate
+ * the offsets.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+SetGridSize(masterPtr)
+ Gridder *masterPtr; /* The geometry master for this grid. */
+{
+ register Gridder *slavePtr; /* Current slave window. */
+ int maxX = 0, maxY = 0;
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ maxX = MAX(maxX,slavePtr->numCols + slavePtr->column);
+ maxY = MAX(maxY,slavePtr->numRows + slavePtr->row);
+ }
+ masterPtr->masterDataPtr->columnEnd = maxX;
+ masterPtr->masterDataPtr->rowEnd = maxY;
+ CheckSlotData(masterPtr, maxX, COLUMN, CHECK_SPACE);
+ CheckSlotData(masterPtr, maxY, ROW, CHECK_SPACE);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CheckSlotData --
+ *
+ * This internal procedure is used to manage the storage for
+ * row and column (slot) constraints.
+ *
+ * Results:
+ * TRUE if the index is OK, False otherwise.
+ *
+ * Side effects:
+ * A new master grid structure may be created. If so, then
+ * it is initialized. In addition, additional storage for
+ * a row or column constraints may be allocated, and the constraint
+ * maximums are adjusted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CheckSlotData(masterPtr, slot, slotType, checkOnly)
+ Gridder *masterPtr; /* the geometry master for this grid */
+ int slot; /* which slot to look at */
+ int slotType; /* ROW or COLUMN */
+ int checkOnly; /* don't allocate new space if true */
+{
+ int numSlot; /* number of slots already allocated (Space) */
+ int end; /* last used constraint */
+
+ /*
+ * If slot is out of bounds, return immediately.
+ */
+
+ if (slot < 0 || slot >= MAX_ELEMENT) {
+ return TCL_ERROR;
+ }
+
+ if ((checkOnly == CHECK_ONLY) && (masterPtr->masterDataPtr == NULL)) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If we need to allocate more space, allocate a little extra to avoid
+ * repeated re-alloc's for large tables. We need enough space to
+ * hold all of the offsets as well.
+ */
+
+ InitMasterData(masterPtr);
+ end = (slotType == ROW) ? masterPtr->masterDataPtr->rowMax :
+ masterPtr->masterDataPtr->columnMax;
+ if (checkOnly == CHECK_ONLY) {
+ return (end < slot) ? TCL_ERROR : TCL_OK;
+ } else {
+ numSlot = (slotType == ROW) ? masterPtr->masterDataPtr->rowSpace
+ : masterPtr->masterDataPtr->columnSpace;
+ if (slot >= numSlot) {
+ int newNumSlot = slot + PREALLOC ;
+ size_t oldSize = numSlot * sizeof(SlotInfo) ;
+ size_t newSize = newNumSlot * sizeof(SlotInfo) ;
+ SlotInfo *new = (SlotInfo *) Tcl_Alloc(newSize);
+ SlotInfo *old = (slotType == ROW) ?
+ masterPtr->masterDataPtr->rowPtr :
+ masterPtr->masterDataPtr->columnPtr;
+ memcpy((VOID *) new, (VOID *) old, oldSize );
+ memset((VOID *) (new+numSlot), 0, newSize - oldSize );
+ Tcl_Free((char *) old);
+ if (slotType == ROW) {
+ masterPtr->masterDataPtr->rowPtr = new ;
+ masterPtr->masterDataPtr->rowSpace = newNumSlot ;
+ } else {
+ masterPtr->masterDataPtr->columnPtr = new;
+ masterPtr->masterDataPtr->columnSpace = newNumSlot ;
+ }
+ }
+ if (slot >= end && checkOnly != CHECK_SPACE) {
+ if (slotType == ROW) {
+ masterPtr->masterDataPtr->rowMax = slot+1;
+ } else {
+ masterPtr->masterDataPtr->columnMax = slot+1;
+ }
+ }
+ return TCL_OK;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * InitMasterData --
+ *
+ * This internal procedure is used to allocate and initialize
+ * the data for a geometry master, if the data
+ * doesn't exist already.
+ *
+ * Results:
+ * none
+ *
+ * Side effects:
+ * A new master grid structure may be created. If so, then
+ * it is initialized.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+InitMasterData(masterPtr)
+ Gridder *masterPtr;
+{
+ size_t size;
+ if (masterPtr->masterDataPtr == NULL) {
+ GridMaster *gridPtr = masterPtr->masterDataPtr =
+ (GridMaster *) Tcl_Alloc(sizeof(GridMaster));
+ size = sizeof(SlotInfo) * TYPICAL_SIZE;
+
+ gridPtr->columnEnd = 0;
+ gridPtr->columnMax = 0;
+ gridPtr->columnPtr = (SlotInfo *) Tcl_Alloc(size);
+ gridPtr->columnSpace = 0;
+ gridPtr->columnSpace = TYPICAL_SIZE;
+ gridPtr->rowEnd = 0;
+ gridPtr->rowMax = 0;
+ gridPtr->rowPtr = (SlotInfo *) Tcl_Alloc(size);
+ gridPtr->rowSpace = 0;
+ gridPtr->rowSpace = TYPICAL_SIZE;
+
+ memset((VOID *) gridPtr->columnPtr, 0, size);
+ memset((VOID *) gridPtr->rowPtr, 0, size);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Unlink --
+ *
+ * Remove a grid from its parent's list of slaves.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The parent will be scheduled for re-arranging, and the size of the
+ * grid will be adjusted accordingly
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Unlink(slavePtr)
+ register Gridder *slavePtr; /* Window to unlink. */
+{
+ register Gridder *masterPtr, *slavePtr2;
+ GridMaster *gridPtr; /* pointer to grid data */
+
+ masterPtr = slavePtr->masterPtr;
+ if (masterPtr == NULL) {
+ return;
+ }
+
+ gridPtr = masterPtr->masterDataPtr;
+ if (masterPtr->slavePtr == slavePtr) {
+ masterPtr->slavePtr = slavePtr->nextPtr;
+ }
+ else {
+ for (slavePtr2 = masterPtr->slavePtr; ; slavePtr2 = slavePtr2->nextPtr) {
+ if (slavePtr2 == NULL) {
+ panic("Unlink couldn't find previous window");
+ }
+ if (slavePtr2->nextPtr == slavePtr) {
+ slavePtr2->nextPtr = slavePtr->nextPtr;
+ break;
+ }
+ }
+ }
+ if (!(masterPtr->flags & REQUESTED_RELAYOUT)) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr);
+ }
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+
+ if ((slavePtr->numCols+slavePtr->column == gridPtr->columnMax)
+ || (slavePtr->numRows+slavePtr->row == gridPtr->rowMax)) {
+ }
+ slavePtr->masterPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyGrid --
+ *
+ * This procedure is invoked by Tk_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a grid at a safe time
+ * (when no-one is using it anymore). Cleaning up the grid involves
+ * freeing the main structure for all windows. and the master structure
+ * for geometry managers.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the grid is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyGrid(memPtr)
+ char *memPtr; /* Info about window that is now dead. */
+{
+ register Gridder *gridPtr = (Gridder *) memPtr;
+
+ if (gridPtr->masterDataPtr != NULL) {
+ if (gridPtr->masterDataPtr->rowPtr != NULL) {
+ Tcl_Free((char *) gridPtr->masterDataPtr -> rowPtr);
+ }
+ if (gridPtr->masterDataPtr->columnPtr != NULL) {
+ Tcl_Free((char *) gridPtr->masterDataPtr -> columnPtr);
+ }
+ Tcl_Free((char *) gridPtr->masterDataPtr);
+ }
+ Tcl_Free((char *) gridPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GridStructureProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher in response
+ * to StructureNotify events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a window was just deleted, clean up all its grid-related
+ * information. If it was just resized, re-configure its slaves, if
+ * any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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) {
+ if ((gridPtr->masterPtr != NULL) &&
+ !(gridPtr->masterPtr->flags & REQUESTED_RELAYOUT)) {
+ gridPtr->doubleBw = 2*Tk_Changes(gridPtr->tkwin)->border_width;
+ gridPtr->masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr->masterPtr);
+ }
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ register Gridder *gridPtr2, *nextPtr;
+
+ if (gridPtr->masterPtr != NULL) {
+ Unlink(gridPtr);
+ }
+ 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) {
+ if (!(gridPtr->flags & REQUESTED_RELAYOUT)) {
+ gridPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) gridPtr);
+ }
+ } else if (eventPtr->type == UnmapNotify) {
+ register Gridder *gridPtr2;
+
+ for (gridPtr2 = gridPtr->slavePtr; gridPtr2 != NULL;
+ gridPtr2 = gridPtr2->nextPtr) {
+ Tk_UnmapWindow(gridPtr2->tkwin);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureSlaves --
+ *
+ * This implements the guts of the "grid configure" command. Given
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureSlaves(interp, tkwin, argc, argv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Any window in application containing
+ * slaves. Used to look up slave names. */
+ int argc; /* Number of elements in argv. */
+ char *argv[]; /* Argument strings: contains one or more
+ * window names followed by any number
+ * of "option value" pairs. Caller must
+ * make sure that there is at least one
+ * window name. */
+{
+ Gridder *masterPtr;
+ Gridder *slavePtr;
+ Tk_Window other, slave, parent, ancestor;
+ int i, j, c, tmp;
+ size_t length;
+ int numWindows;
+ int width;
+ int defaultColumn = 0; /* default column number */
+ int defaultColumnSpan = 1; /* default number of columns */
+ char *lastWindow; /* use this window to base current
+ * Row/col on */
+
+ /*
+ * Count the number of windows, or window short-cuts.
+ */
+
+ for(numWindows=i=0;i<argc;i++) {
+ char firstChar = *argv[i];
+ if (firstChar == '.') {
+ numWindows++;
+ continue;
+ }
+ length = strlen(argv[i]);
+ if (length > 1 && firstChar == '-') {
+ break;
+ }
+ if (length > 1) {
+ Tcl_AppendResult(interp, "unexpected parameter, \"",
+ argv[i], "\", in configure list. ",
+ "Should be window name or option", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if ((firstChar == REL_HORIZ) && ((numWindows == 0) ||
+ (*argv[i-1] == REL_SKIP) || (*argv[i-1] == REL_VERT))) {
+ Tcl_AppendResult(interp,
+ "Must specify window before shortcut '-'.",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if ((firstChar == REL_VERT) || (firstChar == REL_SKIP)
+ || (firstChar == REL_HORIZ)) {
+ continue;
+ }
+
+ Tcl_AppendResult(interp, "invalid window shortcut, \"",
+ argv[i], "\" should be '-', 'x', or '^'", (char *) NULL);
+ return TCL_ERROR;
+ }
+ numWindows = i;
+
+ if ((argc-numWindows)&1) {
+ Tcl_AppendResult(interp, "extra option or",
+ " option with no value", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Iterate over all of the slave windows and short-cuts, parsing
+ * options for each slave. It's a bit wasteful to re-parse the
+ * options for each slave, but things get too messy if we try to
+ * parse the arguments just once at the beginning. For example,
+ * if a slave already is managed we want to just change a few
+ * existing values without resetting everything. If there are
+ * multiple windows, the -in option only gets processed for the
+ * first window.
+ */
+
+ masterPtr = NULL;
+ for (j = 0; j < numWindows; j++) {
+ char firstChar = *argv[j];
+
+ /*
+ * '^' and 'x' cause us to skip a column. '-' is processed
+ * as part of its preceeding slave.
+ */
+
+ if ((firstChar == REL_VERT) || (firstChar == REL_SKIP)) {
+ defaultColumn++;
+ continue;
+ }
+ if (firstChar == REL_HORIZ) {
+ continue;
+ }
+
+ for (defaultColumnSpan=1;
+ j + defaultColumnSpan < numWindows &&
+ (*argv[j+defaultColumnSpan] == REL_HORIZ);
+ defaultColumnSpan++) {
+ /* null body */
+ }
+
+ slave = Tk_NameToWindow(interp, argv[j], tkwin);
+ if (slave == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tk_IsTopLevel(slave)) {
+ Tcl_AppendResult(interp, "can't manage \"", argv[j],
+ "\": it's a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr = GetGrid(slave);
+
+ /*
+ * The following statement is taken from tkPack.c:
+ *
+ * "If the slave isn't currently managed, reset all of its
+ * configuration information to default values (there could
+ * be old values left from a previous packer)."
+ *
+ * I [D.S.] disagree with this statement. If a slave is disabled (using
+ * "forget") and then re-enabled, I submit that 90% of the time the
+ * programmer will want it to retain its old configuration information.
+ * If the programmer doesn't want this behavior, then the
+ * defaults can be reestablished by hand, without having to worry
+ * about keeping track of the old state.
+ */
+
+ for (i = numWindows; i < argc; i+=2) {
+ length = strlen(argv[i]);
+ c = argv[i][1];
+
+ if (length < 2) {
+ Tcl_AppendResult(interp, "unknown or ambiguous option \"",
+ argv[i], "\": must be ",
+ "-column, -columnspan, -in, -ipadx, -ipady, ",
+ "-padx, -pady, -row, -rowspan, or -sticky",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((c == 'c') && (strncmp(argv[i], "-column", length) == 0)) {
+ if (Tcl_GetInt(interp, argv[i+1], &tmp) != TCL_OK || tmp<0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad column value \"", argv[i+1],
+ "\": must be a non-negative integer", (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->column = tmp;
+ } else if ((c == 'c')
+ && (strncmp(argv[i], "-columnspan", length) == 0)) {
+ if (Tcl_GetInt(interp, argv[i+1], &tmp) != TCL_OK || tmp <= 0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad columnspan value \"", argv[i+1],
+ "\": must be a positive integer", (char *)NULL);
+ return TCL_ERROR;
+ }
+ 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)
+ || (tmp < 0)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad ipadx value \"", argv[i+1],
+ "\": must be positive screen distance",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->iPadX = tmp*2;
+ } else if ((c == 'i')
+ && (strncmp(argv[i], "-ipady", length) == 0)) {
+ if ((Tk_GetPixels(interp, slave, argv[i+1], &tmp) != TCL_OK)
+ || (tmp< 0)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad ipady value \"", argv[i+1],
+ "\": must be positive screen distance",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->iPadY = tmp*2;
+ } else if ((c == 'p')
+ && (strncmp(argv[i], "-padx", length) == 0)) {
+ if ((Tk_GetPixels(interp, slave, argv[i+1], &tmp) != TCL_OK)
+ || (tmp< 0)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad padx value \"", argv[i+1],
+ "\": must be positive screen distance",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->padX = tmp*2;
+ } else if ((c == 'p')
+ && (strncmp(argv[i], "-pady", length) == 0)) {
+ if ((Tk_GetPixels(interp, slave, argv[i+1], &tmp) != TCL_OK)
+ || (tmp< 0)) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad pady value \"", argv[i+1],
+ "\": must be positive screen distance",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->padY = tmp*2;
+ } else if ((c == 'r') && (strncmp(argv[i], "-row", length) == 0)) {
+ if (Tcl_GetInt(interp, argv[i+1], &tmp) != TCL_OK || tmp<0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad grid value \"", argv[i+1],
+ "\": must be a non-negative integer", (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->row = tmp;
+ } else if ((c == 'r')
+ && (strncmp(argv[i], "-rowspan", length) == 0)) {
+ if ((Tcl_GetInt(interp, argv[i+1], &tmp) != TCL_OK) || tmp<=0) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad rowspan value \"", argv[i+1],
+ "\": must be a positive integer", (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->numRows = tmp;
+ } else if ((c == 's')
+ && strncmp(argv[i], "-sticky", length) == 0) {
+ int sticky = StringToSticky(argv[i+1]);
+ if (sticky == -1) {
+ Tcl_AppendResult(interp, "bad stickyness value \"", argv[i+1],
+ "\": must be a string containing n, e, s, and/or w",
+ (char *)NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->sticky = sticky;
+ } else {
+ Tcl_AppendResult(interp, "unknown or ambiguous option \"",
+ argv[i], "\": must be ",
+ "-column, -columnspan, -in, -ipadx, -ipady, ",
+ "-padx, -pady, -row, -rowspan, or -sticky",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Make sure we have a geometry master. We look at:
+ * 1) the -in flag
+ * 2) the geometry master of the first slave (if specified)
+ * 3) the parent of the first slave.
+ */
+
+ if (masterPtr == NULL) {
+ masterPtr = slavePtr->masterPtr;
+ }
+ parent = Tk_Parent(slave);
+ if (masterPtr == NULL) {
+ masterPtr = GetGrid(parent);
+ InitMasterData(masterPtr);
+ }
+
+ if (slavePtr->masterPtr != NULL && slavePtr->masterPtr != masterPtr) {
+ Unlink(slavePtr);
+ slavePtr->masterPtr = NULL;
+ }
+
+ if (slavePtr->masterPtr == NULL) {
+ Gridder *tempPtr = masterPtr->slavePtr;
+ slavePtr->masterPtr = masterPtr;
+ masterPtr->slavePtr = slavePtr;
+ slavePtr->nextPtr = tempPtr;
+ }
+
+ /*
+ * Make sure that the slave's parent is either the master or
+ * an ancestor of the master, and that the master and slave
+ * aren't the same.
+ */
+
+ for (ancestor = masterPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (Tk_IsTopLevel(ancestor)) {
+ Tcl_AppendResult(interp, "can't put ", argv[j],
+ " inside ", Tk_PathName(masterPtr->tkwin),
+ (char *) NULL);
+ Unlink(slavePtr);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Try to make sure our master isn't managed by us.
+ */
+
+ if (masterPtr->masterPtr == slavePtr) {
+ Tcl_AppendResult(interp, "can't put ", argv[j],
+ " inside ", Tk_PathName(masterPtr->tkwin),
+ ", would cause management loop.",
+ (char *) NULL);
+ Unlink(slavePtr);
+ return TCL_ERROR;
+ }
+
+ Tk_ManageGeometry(slave, &gridMgrType, (ClientData) slavePtr);
+
+ /*
+ * Assign default position information.
+ */
+
+ if (slavePtr->column == -1) {
+ slavePtr->column = defaultColumn;
+ }
+ slavePtr->numCols += defaultColumnSpan - 1;
+ if (slavePtr->row == -1) {
+ if (masterPtr->masterDataPtr == NULL) {
+ slavePtr->row = 0;
+ } else {
+ slavePtr->row = masterPtr->masterDataPtr->rowEnd;
+ }
+ }
+ defaultColumn += slavePtr->numCols;
+ defaultColumnSpan = 1;
+
+ /*
+ * Arrange for the parent to be re-arranged at the first
+ * idle moment.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_RELAYOUT)) {
+ masterPtr->flags |= REQUESTED_RELAYOUT;
+ Tcl_DoWhenIdle(ArrangeGrid, (ClientData) masterPtr);
+ }
+ }
+
+ /* Now look for all the "^"'s. */
+
+ lastWindow = NULL;
+ for (j = 0; j < numWindows; j++) {
+ struct Gridder *otherPtr;
+ int match; /* found a match for the ^ */
+ int lastRow, lastColumn; /* implied end of table */
+
+ if (*argv[j] == '.') {
+ lastWindow = argv[j];
+ }
+ if (*argv[j] != REL_VERT) {
+ continue;
+ }
+
+ if (masterPtr == NULL) {
+ Tcl_AppendResult(interp, "can't use '^', cant find master",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ for (width=1; width+j < numWindows && *argv[j+width] == REL_VERT;
+ width++) {
+ /* Null Body */
+ }
+
+ /*
+ * Find the implied grid location of the ^
+ */
+
+ if (lastWindow == NULL) {
+ if (masterPtr->masterDataPtr != NULL) {
+ SetGridSize(masterPtr);
+ lastRow = masterPtr->masterDataPtr->rowEnd - 1;
+ } else {
+ lastRow = 0;
+ }
+ lastColumn = 0;
+ } else {
+ other = Tk_NameToWindow(interp, lastWindow, tkwin);
+ otherPtr = GetGrid(other);
+ lastRow = otherPtr->row;
+ lastColumn = otherPtr->column + otherPtr->numCols;
+ }
+
+ for (match=0, slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+
+ if (slavePtr->numCols == width
+ && slavePtr->column == lastColumn
+ && slavePtr->row + slavePtr->numRows == lastRow) {
+ slavePtr->numRows++;
+ match++;
+ }
+ lastWindow = Tk_PathName(slavePtr->tkwin);
+ }
+ if (!match) {
+ Tcl_AppendResult(interp, "can't find slave to extend with \"^\".",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ j += width - 1;
+ }
+
+ if (masterPtr == NULL) {
+ Tcl_AppendResult(interp, "can't determine master window",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ SetGridSize(masterPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StickyToString
+ *
+ * Converts the internal boolean combination of "sticky" bits onto
+ * a TCL list element containing zero or mor of n, s, e, or w.
+ *
+ * Results:
+ * A string is placed into the "result" pointer.
+ *
+ * Side effects:
+ * none.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+StickyToString(flags, result)
+ int flags; /* the sticky flags */
+ char *result; /* where to put the result */
+{
+ int count = 0;
+ if (flags&STICK_NORTH) {
+ result[count++] = 'n';
+ }
+ if (flags&STICK_EAST) {
+ result[count++] = 'e';
+ }
+ if (flags&STICK_SOUTH) {
+ result[count++] = 's';
+ }
+ if (flags&STICK_WEST) {
+ result[count++] = 'w';
+ }
+ if (count) {
+ result[count] = '\0';
+ } else {
+ sprintf(result,"{}");
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringToSticky --
+ *
+ * Converts an ascii string representing a widgets stickyness
+ * into the boolean result.
+ *
+ * Results:
+ * The boolean combination of the "sticky" bits is retuned. If an
+ * error occurs, such as an invalid character, -1 is returned instead.
+ *
+ * Side effects:
+ * none
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringToSticky(string)
+ char *string;
+{
+ int sticky = 0;
+ char c;
+
+ while ((c = *string++) != '\0') {
+ switch (c) {
+ case 'n': case 'N': sticky |= STICK_NORTH; break;
+ case 'e': case 'E': sticky |= STICK_EAST; break;
+ case 's': case 'S': sticky |= STICK_SOUTH; break;
+ case 'w': case 'W': sticky |= STICK_WEST; break;
+ case ' ': case ',': case '\t': case '\r': case '\n': break;
+ default: return -1;
+ }
+ }
+ return sticky;
+}
diff --git a/tk/generic/tkImage.c b/tk/generic/tkImage.c
new file mode 100644
index 00000000000..74ed3bc91b2
--- /dev/null
+++ b/tk/generic/tkImage.c
@@ -0,0 +1,795 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * Each call to Tk_GetImage returns a pointer to one of the following
+ * structures, which is used as a token by clients (widgets) that
+ * display images.
+ */
+
+typedef struct Image {
+ Tk_Window tkwin; /* Window passed to Tk_GetImage (needed to
+ * "re-get" the image later if the manager
+ * changes). */
+ Display *display; /* Display for tkwin. Needed because when
+ * the image is eventually freed tkwin may
+ * not exist anymore. */
+ struct ImageMaster *masterPtr;
+ /* Master for this image (identifiers image
+ * manager, for example). */
+ ClientData instanceData;
+ /* One word argument to pass to image manager
+ * when dealing with this image instance. */
+ Tk_ImageChangedProc *changeProc;
+ /* Code in widget to call when image changes
+ * in a way that affects redisplay. */
+ ClientData widgetClientData;
+ /* Argument to pass to changeProc. */
+ struct Image *nextPtr; /* Next in list of all image instances
+ * associated with the same name. */
+
+} Image;
+
+/*
+ * For each image master there is one of the following structures,
+ * which represents a name in the image table and all of the images
+ * instantiated from it. Entries in mainPtr->imageTable point to
+ * these structures.
+ */
+
+typedef struct ImageMaster {
+ Tk_ImageType *typePtr; /* Information about image type. NULL means
+ * that no image manager owns this image: the
+ * image was deleted. */
+ ClientData masterData; /* One-word argument to pass to image mgr
+ * when dealing with the master, as opposed
+ * to instances. */
+ int width, height; /* Last known dimensions for image. */
+ Tcl_HashTable *tablePtr; /* Pointer to hash table containing image
+ * (the imageTable field in some TkMainInfo
+ * structure). */
+ 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));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateImageType --
+ *
+ * This procedure is invoked by an image manager to tell Tk about
+ * a new kind of image and the procedures that manage the new type.
+ * The procedure is typically invoked during Tcl_AppInit.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The new image type is entered into a table used in the "image
+ * create" command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 --
+ *
+ * This procedure is invoked to process the "image" 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_ImageCmd(clientData, interp, argc, objv)
+ ClientData clientData; /* Main window associated with interpreter. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings. */
+{
+ TkWindow *winPtr = (TkWindow *) clientData;
+ 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;
+
+ static char **argv = NULL;
+ if (argv) ckfree((char *) argv);
+ argv = (char **) ckalloc(argc * sizeof(char *));
+ for (i = 0; i < argc; i++) {
+ argv[i]=Tcl_GetStringFromObj(objv[i], (int *) NULL);
+ }
+ 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;
+ }
+
+ /*
+ * Create the data structure for the new image.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&winPtr->mainPtr->imageTable, name, &new);
+ if (new) {
+ masterPtr = (ImageMaster *) ckalloc(sizeof(ImageMaster));
+ masterPtr->typePtr = NULL;
+ masterPtr->masterData = NULL;
+ masterPtr->width = masterPtr->height = 1;
+ masterPtr->tablePtr = &winPtr->mainPtr->imageTable;
+ masterPtr->hPtr = hPtr;
+ masterPtr->instancePtr = NULL;
+ Tcl_SetHashValue(hPtr, masterPtr);
+ } else {
+ /*
+ * An image already exists by this name. Disconnect the
+ * instances from the master.
+ */
+
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ if (masterPtr->typePtr != NULL) {
+ for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+ imagePtr = imagePtr->nextPtr) {
+ (*masterPtr->typePtr->freeProc)(
+ imagePtr->instanceData, imagePtr->display);
+ (*imagePtr->changeProc)(imagePtr->widgetClientData, 0, 0,
+ masterPtr->width, masterPtr->height, masterPtr->width,
+ masterPtr->height);
+ }
+ (*masterPtr->typePtr->deleteProc)(masterPtr->masterData);
+ masterPtr->typePtr = NULL;
+ }
+ }
+
+ /*
+ * Call the image type manager so that it can perform its own
+ * initialization, then re-"get" for any existing instances of
+ * the image.
+ */
+
+ if ((*typePtr->createProc)(interp, name, argc-firstOption,
+ objv+firstOption, typePtr, (Tk_ImageMaster) masterPtr,
+ &masterPtr->masterData) != TCL_OK) {
+ DeleteImage(masterPtr);
+ return TCL_ERROR;
+ }
+ masterPtr->typePtr = typePtr;
+ for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+ imagePtr = imagePtr->nextPtr) {
+ imagePtr->instanceData = (*typePtr->getProc)(
+ imagePtr->tkwin, masterPtr->masterData);
+ }
+ Tcl_AppendResult(interp, Tcl_GetHashKey(&winPtr->mainPtr->imageTable, hPtr), (char *) NULL);
+ } 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);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), 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);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendElement(interp, Tcl_GetHashKey(
+ &winPtr->mainPtr->imageTable, hPtr));
+ }
+ } else if ((c == 't') && (strcmp(argv[1], "type") == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " type 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);
+ if (masterPtr->typePtr != NULL) {
+ Tcl_AppendResult(interp, masterPtr->typePtr->name, (char *) NULL);
+ }
+ } 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);
+ Tcl_SetIntObj(Tcl_GetObjResult(interp), 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ImageChanged --
+ *
+ * This procedure is called by an image manager whenever something
+ * has happened that requires the image to be redrawn (some of its
+ * pixels have changed, or its size has changed).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Any widgets that display the image are notified so that they
+ * can redisplay themselves as appropriate.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_ImageChanged(imageMaster, x, y, width, height, imageWidth,
+ imageHeight)
+ Tk_ImageMaster imageMaster; /* Image that needs redisplay. */
+ int x, y; /* Coordinates of upper-left pixel of
+ * region of image that needs to be
+ * redrawn. */
+ int width, height; /* Dimensions (in pixels) of region of
+ * image to redraw. If either dimension
+ * is zero then the image doesn't need to
+ * be redrawn (perhaps all that happened is
+ * that its size changed). */
+ int imageWidth, imageHeight;/* New dimensions of image. */
+{
+ ImageMaster *masterPtr = (ImageMaster *) imageMaster;
+ Image *imagePtr;
+
+ masterPtr->width = imageWidth;
+ masterPtr->height = imageHeight;
+ for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+ imagePtr = imagePtr->nextPtr) {
+ (*imagePtr->changeProc)(imagePtr->widgetClientData, x, y,
+ width, height, imageWidth, imageHeight);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_NameOfImage --
+ *
+ * Given a token for an image master, this procedure returns
+ * the name of the image.
+ *
+ * Results:
+ * The return value is the string name for imageMaster.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tk_NameOfImage(imageMaster)
+ Tk_ImageMaster imageMaster; /* Token for image. */
+{
+ ImageMaster *masterPtr = (ImageMaster *) imageMaster;
+
+ return Tcl_GetHashKey(masterPtr->tablePtr, masterPtr->hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetImage --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Image
+Tk_GetImage(interp, tkwin, name, changeProc, clientData)
+ Tcl_Interp *interp; /* Place to leave error message if image
+ * can't be found. */
+ Tk_Window tkwin; /* Token for window in which image will
+ * be used. */
+ char *name; /* Name of desired image. */
+ Tk_ImageChangedProc *changeProc;
+ /* Procedure to invoke when redisplay is
+ * needed because image's pixels or size
+ * changed. */
+ ClientData clientData; /* One-word argument to pass to damageProc. */
+{
+ Tcl_HashEntry *hPtr;
+ ImageMaster *masterPtr;
+ Image *imagePtr;
+
+ hPtr = Tcl_FindHashEntry(&((TkWindow *) tkwin)->mainPtr->imageTable, name);
+ if (hPtr == NULL) {
+ goto noSuchImage;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ if (masterPtr->typePtr == NULL) {
+ goto noSuchImage;
+ }
+ imagePtr = (Image *) ckalloc(sizeof(Image));
+ imagePtr->tkwin = tkwin;
+ imagePtr->display = Tk_Display(tkwin);
+ imagePtr->masterPtr = masterPtr;
+ imagePtr->instanceData =
+ (*masterPtr->typePtr->getProc)(tkwin, masterPtr->masterData);
+ imagePtr->changeProc = changeProc;
+ imagePtr->widgetClientData = clientData;
+ imagePtr->nextPtr = masterPtr->instancePtr;
+ masterPtr->instancePtr = imagePtr;
+ return (Tk_Image) imagePtr;
+
+ noSuchImage:
+ Tcl_AppendResult(interp, "image \"", name, "\" doesn't exist",
+ (char *) NULL);
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeImage --
+ *
+ * This procedure is invoked by a widget when it no longer needs
+ * an image acquired by a previous call to Tk_GetImage. For each
+ * call to Tk_GetImage there must be exactly one call to Tk_FreeImage.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The association between the image and the widget is removed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeImage(image)
+ Tk_Image image; /* Token for image that is no longer
+ * needed by a widget. */
+{
+ Image *imagePtr = (Image *) image;
+ ImageMaster *masterPtr = imagePtr->masterPtr;
+ Image *prevPtr;
+
+ /*
+ * Clean up the particular instance.
+ */
+
+ if (masterPtr->typePtr != NULL) {
+ (*masterPtr->typePtr->freeProc)(imagePtr->instanceData,
+ imagePtr->display);
+ }
+ prevPtr = masterPtr->instancePtr;
+ if (prevPtr == imagePtr) {
+ masterPtr->instancePtr = imagePtr->nextPtr;
+ } else {
+ while (prevPtr->nextPtr != imagePtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = imagePtr->nextPtr;
+ }
+ ckfree((char *) imagePtr);
+
+ /*
+ * If there are no more instances left for the master, and if the
+ * master image has been deleted, then delete the master too.
+ */
+
+ if ((masterPtr->typePtr == NULL) && (masterPtr->instancePtr == NULL)) {
+ Tcl_DeleteHashEntry(masterPtr->hPtr);
+ ckfree((char *) masterPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_RedrawImage --
+ *
+ * This procedure is called by widgets that contain images in order
+ * to redisplay an image on the screen or an off-screen pixmap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image's manager is notified, and it redraws the desired
+ * portion of the image before returning.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_RedrawImage(image, imageX, imageY, width, height, drawable,
+ drawableX, drawableY)
+ Tk_Image image; /* Token for image to redisplay. */
+ int imageX, imageY; /* Upper-left pixel of region in image that
+ * needs to be redisplayed. */
+ int width, height; /* Dimensions of region to redraw. */
+ Drawable drawable; /* Drawable in which to display image
+ * (window or pixmap). If this is a pixmap,
+ * it must have the same depth as the window
+ * used in the Tk_GetImage call for the
+ * image. */
+ int drawableX, drawableY; /* Coordinates in drawable that correspond
+ * to imageX and imageY. */
+{
+ Image *imagePtr = (Image *) image;
+
+ if (imagePtr->masterPtr->typePtr == NULL) {
+ /*
+ * No master for image, so nothing to display.
+ */
+
+ return;
+ }
+
+ /*
+ * Clip the redraw area to the area of the image.
+ */
+
+ if (imageX < 0) {
+ width += imageX;
+ drawableX -= imageX;
+ imageX = 0;
+ }
+ if (imageY < 0) {
+ height += imageY;
+ drawableY -= imageY;
+ imageY = 0;
+ }
+ if ((imageX + width) > imagePtr->masterPtr->width) {
+ width = imagePtr->masterPtr->width - imageX;
+ }
+ if ((imageY + height) > imagePtr->masterPtr->height) {
+ height = imagePtr->masterPtr->height - imageY;
+ }
+ (*imagePtr->masterPtr->typePtr->displayProc)(
+ imagePtr->instanceData, imagePtr->display, drawable,
+ imageX, imageY, width, height, drawableX, drawableY);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SizeOfImage --
+ *
+ * This procedure returns the current dimensions of an image.
+ *
+ * Results:
+ * The width and height of the image are returned in *widthPtr
+ * and *heightPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SizeOfImage(image, widthPtr, heightPtr)
+ Tk_Image image; /* Token for image whose size is wanted. */
+ int *widthPtr; /* Return width of image here. */
+ int *heightPtr; /* Return height of image here. */
+{
+ Image *imagePtr = (Image *) image;
+
+ *widthPtr = imagePtr->masterPtr->width;
+ *heightPtr = imagePtr->masterPtr->height;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DeleteImage --
+ *
+ * Given the name of an image, this procedure destroys the
+ * image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image is destroyed; existing instances will display as
+ * blank areas. If no such image exists then the procedure does
+ * nothing.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DeleteImage(interp, name)
+ Tcl_Interp *interp; /* Interpreter in which the image was
+ * created. */
+ char *name; /* Name of image. */
+{
+ Tcl_HashEntry *hPtr;
+ TkWindow *winPtr;
+
+ winPtr = (TkWindow *) Tk_MainWindow(interp);
+ if (winPtr == NULL) {
+ return;
+ }
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, name);
+ if (hPtr == NULL) {
+ return;
+ }
+ DeleteImage((ImageMaster *) Tcl_GetHashValue(hPtr));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteImage --
+ *
+ * This procedure is responsible for deleting an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The connection is dropped between instances of this image and
+ * an image master. Image instances will redisplay themselves
+ * as empty areas, but existing instances will not be deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteImage(masterPtr)
+ ImageMaster *masterPtr; /* Pointer to main data structure for image. */
+{
+ Image *imagePtr;
+ Tk_ImageType *typePtr;
+
+ typePtr = masterPtr->typePtr;
+ masterPtr->typePtr = NULL;
+ if (typePtr != NULL) {
+ for (imagePtr = masterPtr->instancePtr; imagePtr != NULL;
+ imagePtr = imagePtr->nextPtr) {
+ (*typePtr->freeProc)(imagePtr->instanceData,
+ imagePtr->display);
+ (*imagePtr->changeProc)(imagePtr->widgetClientData, 0, 0,
+ masterPtr->width, masterPtr->height, masterPtr->width,
+ masterPtr->height);
+ }
+ (*typePtr->deleteProc)(masterPtr->masterData);
+ }
+ if (masterPtr->instancePtr == NULL) {
+ Tcl_DeleteHashEntry(masterPtr->hPtr);
+ ckfree((char *) masterPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDeleteAllImages --
+ *
+ * This procedure is called when an application is deleted. It
+ * calls back all of the managers for all images so that they
+ * can cleanup, then it deletes all of Tk's internal information
+ * about images.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All information for all images gets deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkDeleteAllImages(mainPtr)
+ TkMainInfo *mainPtr; /* Structure describing application that is
+ * going away. */
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+ ImageMaster *masterPtr;
+
+ for (hPtr = Tcl_FirstHashEntry(&mainPtr->imageTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ DeleteImage(masterPtr);
+ }
+ Tcl_DeleteHashTable(&mainPtr->imageTable);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetImageMasterData --
+ *
+ * Given the name of an image, this procedure returns the type
+ * of the image and the clientData associated with its master.
+ *
+ * Results:
+ * If there is no image by the given name, then NULL is returned
+ * and a NULL value is stored at *typePtrPtr. Otherwise the return
+ * value is the clientData returned by the createProc when the
+ * image was created and a pointer to the type structure for the
+ * image is stored at *typePtrPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ClientData
+Tk_GetImageMasterData(interp, name, typePtrPtr)
+ Tcl_Interp *interp; /* Interpreter in which the image was
+ * created. */
+ char *name; /* Name of image. */
+ Tk_ImageType **typePtrPtr; /* Points to location to fill in with
+ * pointer to type information for image. */
+{
+ Tcl_HashEntry *hPtr;
+ TkWindow *winPtr;
+ ImageMaster *masterPtr;
+
+ winPtr = (TkWindow *) Tk_MainWindow(interp);
+ hPtr = Tcl_FindHashEntry(&winPtr->mainPtr->imageTable, name);
+ if (hPtr == NULL) {
+ *typePtrPtr = NULL;
+ return NULL;
+ }
+ masterPtr = (ImageMaster *) Tcl_GetHashValue(hPtr);
+ *typePtrPtr = masterPtr->typePtr;
+ return masterPtr->masterData;
+}
diff --git a/tk/generic/tkImgBmap.c b/tk/generic/tkImgBmap.c
new file mode 100644
index 00000000000..fcdc990ed82
--- /dev/null
+++ b/tk/generic/tkImgBmap.c
@@ -0,0 +1,1082 @@
+/*
+ * 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$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * The following data structure represents the master for a bitmap
+ * image:
+ */
+
+typedef struct BitmapMaster {
+ Tk_ImageMaster tkMaster; /* Tk's token for image master. NULL means
+ * the image is being deleted. */
+ Tcl_Interp *interp; /* Interpreter for application that is
+ * using image. */
+ Tcl_Command imageCmd; /* Token for image command (used to delete
+ * it when the image goes away). NULL means
+ * the image command has already been
+ * deleted. */
+ int width, height; /* Dimensions of image. */
+ char *data; /* Data comprising bitmap (suitable for
+ * input to XCreateBitmapFromData). May
+ * be NULL if no data. Malloc'ed. */
+ char *maskData; /* Data for bitmap's mask (suitable for
+ * input to XCreateBitmapFromData).
+ * Malloc'ed. */
+ Tk_Uid fgUid; /* Value of -foreground option (malloc'ed). */
+ Tk_Uid bgUid; /* Value of -background option (malloc'ed). */
+ char *fileString; /* Value of -file option (malloc'ed). */
+ char *dataString; /* Value of -data option (malloc'ed). */
+ char *maskFileString; /* Value of -maskfile option (malloc'ed). */
+ char *maskDataString; /* Value of -maskdata option (malloc'ed). */
+ struct BitmapInstance *instancePtr;
+ /* First in list of all instances associated
+ * with this master. */
+} BitmapMaster;
+
+/*
+ * The following data structure represents all of the instances of an
+ * image that lie within a particular window:
+ */
+
+typedef struct BitmapInstance {
+ int refCount; /* Number of instances that share this
+ * data structure. */
+ BitmapMaster *masterPtr; /* Pointer to master for image. */
+ Tk_Window tkwin; /* Window in which the instances will be
+ * displayed. */
+ XColor *fg; /* Foreground color for displaying image. */
+ XColor *bg; /* Background color for displaying image. */
+ Pixmap bitmap; /* The bitmap to display. */
+ Pixmap mask; /* Mask: only display bitmap pixels where
+ * there are 1's here. */
+ GC gc; /* Graphics context for displaying bitmap.
+ * None means there was an error while
+ * setting up the instance, so it cannot
+ * be displayed. */
+ struct BitmapInstance *nextPtr;
+ /* Next in list of all instance structures
+ * associated with masterPtr (NULL means
+ * end of list). */
+} BitmapInstance;
+
+/*
+ * The type record for bitmap images:
+ */
+
+static int GetByte _ANSI_ARGS_((Tcl_Channel chan));
+static int ImgBmapCreate _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, int argc, Tcl_Obj *CONST objv[],
+ Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *clientDataPtr));
+static ClientData ImgBmapGet _ANSI_ARGS_((Tk_Window tkwin,
+ ClientData clientData));
+static void ImgBmapDisplay _ANSI_ARGS_((ClientData clientData,
+ Display *display, Drawable drawable,
+ int imageX, int imageY, int width, int height,
+ int drawableX, int drawableY));
+static void ImgBmapFree _ANSI_ARGS_((ClientData clientData,
+ Display *display));
+static void ImgBmapDelete _ANSI_ARGS_((ClientData clientData));
+
+Tk_ImageType tkBitmapImageType = {
+ "bitmap", /* name */
+ ImgBmapCreate, /* createProc */
+ ImgBmapGet, /* getProc */
+ ImgBmapDisplay, /* displayProc */
+ ImgBmapFree, /* freeProc */
+ ImgBmapDelete, /* deleteProc */
+ (Tk_ImageType *) NULL /* nextPtr */
+};
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_UID, "-background", (char *) NULL, (char *) NULL,
+ "", Tk_Offset(BitmapMaster, bgUid), 0},
+ {TK_CONFIG_STRING, "-data", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapMaster, dataString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapMaster, fileString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_UID, "-foreground", (char *) NULL, (char *) NULL,
+ "#000000", Tk_Offset(BitmapMaster, fgUid), 0},
+ {TK_CONFIG_STRING, "-maskdata", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapMaster, maskDataString),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-maskfile", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(BitmapMaster, maskFileString),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * The following data structure is used to describe the state of
+ * parsing a bitmap file or string. It is used for communication
+ * between TkGetBitmapData and NextBitmapWord.
+ */
+
+#define MAX_WORD_LENGTH 100
+typedef struct ParseInfo {
+ char *string; /* Next character of string data for bitmap,
+ * or NULL if bitmap is being read from
+ * file. */
+ Tcl_Channel chan; /* File containing bitmap data, or NULL
+ * if no file. */
+ char word[MAX_WORD_LENGTH+1];
+ /* Current word of bitmap data, NULL
+ * terminated. */
+ int wordLength; /* Number of non-NULL bytes in word. */
+} ParseInfo;
+
+/*
+ * Prototypes for procedures used only locally in this file:
+ */
+
+static int ImgBmapCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void ImgBmapCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void ImgBmapConfigureInstance _ANSI_ARGS_((
+ BitmapInstance *instancePtr));
+static int ImgBmapConfigureMaster _ANSI_ARGS_((
+ BitmapMaster *masterPtr, int argc, char **argv,
+ int flags));
+static int NextBitmapWord _ANSI_ARGS_((ParseInfo *parseInfoPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapCreate --
+ *
+ * This procedure is called by the Tk image code to create "test"
+ * images.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The data structure for a new image is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ImgBmapCreate(interp, name, argc, objv, typePtr, master, clientDataPtr)
+ Tcl_Interp *interp; /* Interpreter for application containing
+ * image. */
+ char *name; /* Name to use for image. */
+ int argc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects for options (doesn't
+ * include image name or type). */
+ Tk_ImageType *typePtr; /* Pointer to our type record (not used). */
+ Tk_ImageMaster master; /* Token for image, to be used by us in
+ * later callbacks. */
+ ClientData *clientDataPtr; /* Store manager's token for image here;
+ * it will be returned in later callbacks. */
+{
+ BitmapMaster *masterPtr;
+ char **argv;
+ int i;
+
+ masterPtr = (BitmapMaster *) ckalloc(sizeof(BitmapMaster));
+ masterPtr->tkMaster = master;
+ masterPtr->interp = interp;
+ masterPtr->imageCmd = Tcl_CreateCommand(interp, name, ImgBmapCmd,
+ (ClientData) masterPtr, ImgBmapCmdDeletedProc);
+ masterPtr->width = masterPtr->height = 0;
+ masterPtr->data = NULL;
+ masterPtr->maskData = NULL;
+ masterPtr->fgUid = NULL;
+ masterPtr->bgUid = NULL;
+ masterPtr->fileString = NULL;
+ masterPtr->dataString = NULL;
+ masterPtr->maskFileString = NULL;
+ masterPtr->maskDataString = NULL;
+ masterPtr->instancePtr = NULL;
+
+ /*
+ * Convert the objv arguments into string equivalent.
+ * A proper conversion to object format will need to be done in the future
+ */
+ argv = (char **) ckalloc(argc * sizeof(char *));
+ for (i = 0; i < argc; i++) {
+ argv[i] = Tcl_GetStringFromObj(objv[i], NULL);
+ }
+ if (ImgBmapConfigureMaster(masterPtr, argc, argv, 0) != TCL_OK) {
+ ImgBmapDelete((ClientData) masterPtr);
+ ckfree((char *) argv);
+ return TCL_ERROR;
+ }
+ ckfree((char *) argv);
+ *clientDataPtr = (ClientData) masterPtr;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapConfigureMaster --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgBmapConfigureMaster(masterPtr, argc, argv, flags)
+ BitmapMaster *masterPtr; /* Pointer to data structure describing
+ * overall bitmap image to (reconfigure). */
+ int argc; /* Number of entries in argv. */
+ char **argv; /* Pairs of configuration options for image. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget,
+ * such as TK_CONFIG_ARGV_ONLY. */
+{
+ BitmapInstance *instancePtr;
+ int maskWidth, maskHeight, dummy1, dummy2;
+
+ if (Tk_ConfigureWidget(masterPtr->interp, Tk_MainWindow(masterPtr->interp),
+ configSpecs, argc, argv, (char *) masterPtr, flags)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Parse the bitmap and/or mask to create binary data. Make sure that
+ * the bitmap and mask have the same dimensions.
+ */
+
+ if (masterPtr->data != NULL) {
+ ckfree(masterPtr->data);
+ masterPtr->data = NULL;
+ }
+ if ((masterPtr->fileString != NULL) || (masterPtr->dataString != NULL)) {
+ masterPtr->data = TkGetBitmapData(masterPtr->interp,
+ masterPtr->dataString, masterPtr->fileString,
+ &masterPtr->width, &masterPtr->height, &dummy1, &dummy2);
+ if (masterPtr->data == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ 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
+ * redisplayed everywhere that it is used.
+ */
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ ImgBmapConfigureInstance(instancePtr);
+ }
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width,
+ masterPtr->height, masterPtr->width, masterPtr->height);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapConfigureInstance --
+ *
+ * This procedure is called to create displaying information for
+ * a bitmap image instance based on the configuration information
+ * in the master. It is invoked both when new instances are
+ * created and when the master is reconfigured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates errors via Tcl_BackgroundError if there are problems
+ * in setting up the instance.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapConfigureInstance(instancePtr)
+ 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) {
+ colorPtr = Tk_GetColor(masterPtr->interp, instancePtr->tkwin,
+ masterPtr->bgUid);
+ if (colorPtr == NULL) {
+ goto error;
+ }
+ } else {
+ colorPtr = NULL;
+ }
+ if (instancePtr->bg != NULL) {
+ Tk_FreeColor(instancePtr->bg);
+ }
+ instancePtr->bg = colorPtr;
+
+ colorPtr = Tk_GetColor(masterPtr->interp, instancePtr->tkwin,
+ masterPtr->fgUid);
+ if (colorPtr == NULL) {
+ goto error;
+ }
+ if (instancePtr->fg != NULL) {
+ Tk_FreeColor(instancePtr->fg);
+ }
+ instancePtr->fg = colorPtr;
+
+ if (instancePtr->bitmap != None) {
+ Tk_FreePixmap(Tk_Display(instancePtr->tkwin), instancePtr->bitmap);
+ instancePtr->bitmap = None;
+ }
+ if (masterPtr->data != NULL) {
+ 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;
+ mask |= GCBackground;
+ if (instancePtr->mask != None) {
+ gcValues.clip_mask = instancePtr->mask;
+ mask |= GCClipMask;
+ }
+ } else {
+ gcValues.clip_mask = instancePtr->bitmap;
+ mask |= GCClipMask;
+ }
+ gc = Tk_GetGCColor(instancePtr->tkwin, mask, &gcValues,
+ instancePtr->fg, instancePtr->bg);
+ } else {
+ gc = None;
+ }
+ if (instancePtr->gc != None) {
+ Tk_FreeGC(Tk_Display(instancePtr->tkwin), instancePtr->gc);
+ }
+ instancePtr->gc = gc;
+ return;
+
+ error:
+ /*
+ * An error occurred: clear the graphics context in the instance to
+ * make it clear that this instance cannot be displayed. Then report
+ * the error.
+ */
+
+ if (instancePtr->gc != None) {
+ Tk_FreeGC(Tk_Display(instancePtr->tkwin), instancePtr->gc);
+ }
+ instancePtr->gc = None;
+ Tcl_AddErrorInfo(masterPtr->interp, "\n (while configuring image \"");
+ Tcl_AddErrorInfo(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster));
+ Tcl_AddErrorInfo(masterPtr->interp, "\")");
+ Tcl_BackgroundError(masterPtr->interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetBitmapData --
+ *
+ * Given a file name or ASCII string, this procedure parses the
+ * file or string contents to produce binary data for a bitmap.
+ *
+ * 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, 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;
+ }
+
+ /*
+ * Parse the lines that define the dimensions of the bitmap,
+ * plus the first line that defines the bitmap data (it declares
+ * the name of a data variable but doesn't include any actual
+ * data). These lines look something like the following:
+ *
+ * #define foo_width 16
+ * #define foo_height 16
+ * #define foo_x_hot 3
+ * #define foo_y_hot 3
+ * static char foo_bits[] = {
+ *
+ * The x_hot and y_hot lines may or may not be present. It's
+ * important to check for "char" in the last line, in order to
+ * reject old X10-style bitmaps that used shorts.
+ */
+
+ width = 0;
+ height = 0;
+ hotX = -1;
+ hotY = -1;
+ while (1) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ if ((pi.wordLength >= 6) && (pi.word[pi.wordLength-6] == '_')
+ && (strcmp(pi.word+pi.wordLength-6, "_width") == 0)) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ width = strtol(pi.word, &end, 0);
+ if ((end == pi.word) || (*end != 0)) {
+ goto error;
+ }
+ } else if ((pi.wordLength >= 7) && (pi.word[pi.wordLength-7] == '_')
+ && (strcmp(pi.word+pi.wordLength-7, "_height") == 0)) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ height = strtol(pi.word, &end, 0);
+ if ((end == pi.word) || (*end != 0)) {
+ goto error;
+ }
+ } else if ((pi.wordLength >= 6) && (pi.word[pi.wordLength-6] == '_')
+ && (strcmp(pi.word+pi.wordLength-6, "_x_hot") == 0)) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ hotX = strtol(pi.word, &end, 0);
+ if ((end == pi.word) || (*end != 0)) {
+ goto error;
+ }
+ } else if ((pi.wordLength >= 6) && (pi.word[pi.wordLength-6] == '_')
+ && (strcmp(pi.word+pi.wordLength-6, "_y_hot") == 0)) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ hotY = strtol(pi.word, &end, 0);
+ if ((end == pi.word) || (*end != 0)) {
+ goto error;
+ }
+ } else if ((pi.word[0] == 'c') && (strcmp(pi.word, "char") == 0)) {
+ while (1) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ 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.
+ */
+
+ getData:
+ if ((width <= 0) || (height <= 0)) {
+ goto error;
+ }
+ numBytes = ((width+7)/8) * height;
+ data = (char *) ckalloc((unsigned) numBytes);
+ for (p = data; numBytes > 0; p++, numBytes--) {
+ if (NextBitmapWord(&pi) != TCL_OK) {
+ goto error;
+ }
+ *p = (char) strtol(pi.word, &end, 0);
+ if (end == pi.word) {
+ goto error;
+ }
+ }
+
+ /*
+ * All done. Clean up and return.
+ */
+
+ if (pi.chan != NULL) {
+ Tcl_Close(NULL, pi.chan);
+ }
+ *widthPtr = width;
+ *heightPtr = height;
+ *hotXPtr = hotX;
+ *hotYPtr = hotY;
+ return data;
+
+ error:
+ if (interp != NULL) {
+ interp->result = "format error in bitmap data";
+ }
+ errorCleanup:
+ if (data != NULL) {
+ ckfree(data);
+ }
+ if (pi.chan != NULL) {
+ Tcl_Close(NULL, pi.chan);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NextBitmapWord --
+ *
+ * This procedure retrieves the next word of information (stuff
+ * between commas or white space) from a bitmap description.
+ *
+ * Results:
+ * Returns TCL_OK if all went well. In this case the next word,
+ * and its length, will be availble in *parseInfoPtr. If the end
+ * of the bitmap description was reached then TCL_ERROR is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NextBitmapWord(parseInfoPtr)
+ ParseInfo *parseInfoPtr; /* Describes what we're reading
+ * and where we are in it. */
+{
+ char *src, *dst;
+ int c;
+
+ parseInfoPtr->wordLength = 0;
+ dst = parseInfoPtr->word;
+ if (parseInfoPtr->string != NULL) {
+ for (src = parseInfoPtr->string; isspace(UCHAR(*src)) || (*src == ',');
+ src++) {
+ if (*src == 0) {
+ return TCL_ERROR;
+ }
+ }
+ for ( ; !isspace(UCHAR(*src)) && (*src != ',') && (*src != 0); src++) {
+ *dst = *src;
+ dst++;
+ parseInfoPtr->wordLength++;
+ if (parseInfoPtr->wordLength > MAX_WORD_LENGTH) {
+ return TCL_ERROR;
+ }
+ }
+ parseInfoPtr->string = src;
+ } else {
+ for (c = GetByte(parseInfoPtr->chan); isspace(UCHAR(c)) || (c == ',');
+ c = GetByte(parseInfoPtr->chan)) {
+ if (c == EOF) {
+ return TCL_ERROR;
+ }
+ }
+ for ( ; !isspace(UCHAR(c)) && (c != ',') && (c != EOF);
+ c = GetByte(parseInfoPtr->chan)) {
+ *dst = c;
+ dst++;
+ parseInfoPtr->wordLength++;
+ if (parseInfoPtr->wordLength > MAX_WORD_LENGTH) {
+ return TCL_ERROR;
+ }
+ }
+ }
+ if (parseInfoPtr->wordLength == 0) {
+ return TCL_ERROR;
+ }
+ parseInfoPtr->word[parseInfoPtr->wordLength] = 0;
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ImgBmapCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to an image 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
+ImgBmapCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about the image master. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ 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) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
+ (char *) masterPtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc == 2) {
+ code = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ code = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, argv[2], 0);
+ } else {
+ code = ImgBmapConfigureMaster(masterPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ return code;
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be cget or configure", (char *) NULL);
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapGet --
+ *
+ * This procedure is called for each use of a bitmap image in a
+ * widget.
+ *
+ * Results:
+ * The return value is a token for the instance, which is passed
+ * back to us in calls to ImgBmapDisplay and ImgBmapFree.
+ *
+ * Side effects:
+ * A data structure is set up for the instance (or, an existing
+ * instance is re-used for the new one).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+ImgBmapGet(tkwin, masterData)
+ Tk_Window tkwin; /* Window in which the instance will be
+ * used. */
+ ClientData masterData; /* Pointer to our master structure for the
+ * image. */
+{
+ BitmapMaster *masterPtr = (BitmapMaster *) masterData;
+ BitmapInstance *instancePtr;
+
+ /*
+ * See if there is already an instance for this window. If so
+ * then just re-use it.
+ */
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ if (instancePtr->tkwin == tkwin) {
+ instancePtr->refCount++;
+ return (ClientData) instancePtr;
+ }
+ }
+
+ /*
+ * The image isn't already in use in this window. Make a new
+ * instance of the image.
+ */
+
+ instancePtr = (BitmapInstance *) ckalloc(sizeof(BitmapInstance));
+ instancePtr->refCount = 1;
+ instancePtr->masterPtr = masterPtr;
+ instancePtr->tkwin = tkwin;
+ instancePtr->fg = NULL;
+ instancePtr->bg = NULL;
+ instancePtr->bitmap = None;
+ instancePtr->mask = None;
+ instancePtr->gc = None;
+ instancePtr->nextPtr = masterPtr->instancePtr;
+ masterPtr->instancePtr = instancePtr;
+ ImgBmapConfigureInstance(instancePtr);
+
+ /*
+ * If this is the first instance, must set the size of the image.
+ */
+
+ if (instancePtr->nextPtr == NULL) {
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0, masterPtr->width,
+ masterPtr->height);
+ }
+
+ return (ClientData) instancePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapDisplay --
+ *
+ * This procedure is invoked to draw a bitmap image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A portion of the image gets rendered in a pixmap or window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapDisplay(clientData, display, drawable, imageX, imageY, width,
+ height, drawableX, drawableY)
+ ClientData clientData; /* Pointer to BitmapInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display on which to draw image. */
+ Drawable drawable; /* Pixmap or window in which to draw image. */
+ int imageX, imageY; /* Upper-left corner of region within image
+ * to draw. */
+ int width, height; /* Dimensions of region within image to draw. */
+ int drawableX, drawableY; /* Coordinates within drawable that
+ * correspond to imageX and imageY. */
+{
+ BitmapInstance *instancePtr = (BitmapInstance *) clientData;
+ int masking;
+
+ /*
+ * If there's no graphics context, it means that an error occurred
+ * while creating the image instance so it can't be displayed.
+ */
+
+ if (instancePtr->gc == None) {
+ return;
+ }
+
+ /*
+ * If masking is in effect, must modify the mask origin within
+ * the graphics context to line up with the image's origin.
+ * Then draw the image and reset the clip origin, if there's
+ * a mask.
+ */
+
+ masking = (instancePtr->mask != None) || (instancePtr->bg == NULL);
+ if (masking) {
+ XSetClipOrigin(display, instancePtr->gc, drawableX - imageX,
+ drawableY - imageY);
+ }
+ XCopyPlane(display, instancePtr->bitmap, drawable, instancePtr->gc,
+ imageX, imageY, (unsigned) width, (unsigned) height,
+ drawableX, drawableY, 1);
+ if (masking) {
+ XSetClipOrigin(display, instancePtr->gc, 0, 0);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapFree --
+ *
+ * This procedure is called when a widget ceases to use a
+ * particular instance of an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Internal data structures get cleaned up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapFree(clientData, display)
+ ClientData clientData; /* Pointer to BitmapInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display containing window that used image. */
+{
+ BitmapInstance *instancePtr = (BitmapInstance *) clientData;
+ BitmapInstance *prevPtr;
+
+ instancePtr->refCount--;
+ if (instancePtr->refCount > 0) {
+ return;
+ }
+
+ /*
+ * There are no more uses of the image within this widget. Free
+ * the instance structure.
+ */
+
+ if (instancePtr->fg != NULL) {
+ Tk_FreeColor(instancePtr->fg);
+ }
+ if (instancePtr->bg != NULL) {
+ Tk_FreeColor(instancePtr->bg);
+ }
+ if (instancePtr->bitmap != None) {
+ Tk_FreePixmap(display, instancePtr->bitmap);
+ }
+ if (instancePtr->mask != None) {
+ Tk_FreePixmap(display, instancePtr->mask);
+ }
+ if (instancePtr->gc != None) {
+ Tk_FreeGC(display, instancePtr->gc);
+ }
+ if (instancePtr->masterPtr->instancePtr == instancePtr) {
+ instancePtr->masterPtr->instancePtr = instancePtr->nextPtr;
+ } else {
+ for (prevPtr = instancePtr->masterPtr->instancePtr;
+ prevPtr->nextPtr != instancePtr; prevPtr = prevPtr->nextPtr) {
+ /* Empty loop body */
+ }
+ prevPtr->nextPtr = instancePtr->nextPtr;
+ }
+ ckfree((char *) instancePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapDelete --
+ *
+ * This procedure is called by the image code to delete the
+ * master structure for an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with the image get freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapDelete(masterData)
+ ClientData masterData; /* Pointer to BitmapMaster structure for
+ * image. Must not have any more instances. */
+{
+ BitmapMaster *masterPtr = (BitmapMaster *) masterData;
+
+ if (masterPtr->instancePtr != NULL) {
+ panic("tried to delete bitmap image when instances still exist");
+ }
+ masterPtr->tkMaster = NULL;
+ if (masterPtr->imageCmd != NULL) {
+ Tcl_DeleteCommandFromToken(masterPtr->interp, masterPtr->imageCmd);
+ }
+ if (masterPtr->data != NULL) {
+ ckfree(masterPtr->data);
+ }
+ if (masterPtr->maskData != NULL) {
+ ckfree(masterPtr->maskData);
+ }
+ Tk_FreeOptions(configSpecs, (char *) masterPtr, (Display *) NULL, 0);
+ ckfree((char *) masterPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgBmapCmdDeletedProc --
+ *
+ * This procedure is invoked when the image command for an image
+ * is deleted. It deletes the image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgBmapCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to BitmapMaster structure for
+ * image. */
+{
+ BitmapMaster *masterPtr = (BitmapMaster *) clientData;
+
+ masterPtr->imageCmd = NULL;
+ if (masterPtr->tkMaster != NULL) {
+ Tk_DeleteImage(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster));
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetByte --
+ *
+ * Get the next byte from the open channel.
+ *
+ * Results:
+ * The next byte or EOF.
+ *
+ * Side effects:
+ * We read from the channel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetByte(chan)
+ Tcl_Channel chan; /* The channel we read from. */
+{
+ char buffer;
+ int size;
+
+ size = Tcl_Read(chan, &buffer, 1);
+ if (size <= 0) {
+ return EOF;
+ } else {
+ return buffer;
+ }
+}
diff --git a/tk/generic/tkImgGIF.c b/tk/generic/tkImgGIF.c
new file mode 100644
index 00000000000..98bb23af4e4
--- /dev/null
+++ b/tk/generic/tkImgGIF.c
@@ -0,0 +1,1098 @@
+/*
+ * tkImgGIF.c --
+ *
+ * A photo image file handler for GIF files. Reads 87a and 89a GIF
+ * files. At present there is no write function. GIF images may be
+ * read using the -data option of the photo image. The data may be
+ * given as a binary string in a Tcl_Obj or by representing
+ * the data as BASE64 encoded ascii. Derived from the giftoppm code
+ * found in the pbmplus package and tkImgFmtPPM.c in the tk4.0b2
+ * distribution.
+ *
+ * Copyright (c) Reed Wade (wade@cs.utk.edu), University of Tennessee
+ * Copyright (c) 1995-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1997 Australian National University
+ *
+ * See the file "license.terms" for information on usage and redistribution
+ * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+ *
+ * This file also contains code from the giftoppm program, which is
+ * copyrighted as follows:
+ *
+ * +-------------------------------------------------------------------+
+ * | Copyright 1990, David Koblas. |
+ * | Permission to use, copy, modify, and distribute this software |
+ * | and its documentation for any purpose and without fee is hereby |
+ * | granted, provided that the above copyright notice appear in all |
+ * | copies and that both that copyright notice and this permission |
+ * | notice appear in supporting documentation. This software is |
+ * | provided "as is" without express or implied warranty. |
+ * +-------------------------------------------------------------------+
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * 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
+ * multiple of 3 bytes. We'll ignore white space when encountered.
+ * Any other invalid character is treated as an EOF
+ */
+
+#define GIF_SPECIAL (256)
+#define GIF_PAD (GIF_SPECIAL+1)
+#define GIF_SPACE (GIF_SPECIAL+2)
+#define GIF_BAD (GIF_SPECIAL+3)
+#define GIF_DONE (GIF_SPECIAL+4)
+
+/*
+ * structure to "mimic" FILE for Mread, so we can look like fread.
+ * The decoder state keeps track of which byte we are about to read,
+ * or EOF.
+ */
+
+typedef struct mFile {
+ unsigned char *data; /* mmencoded source string */
+ 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,
+ Tcl_Channel chan, char *fileName, char *formatString,
+ Tk_PhotoHandle imageHandle, int destX, int destY,
+ int width, int height, int srcX, int srcY));
+static int StringMatchGIF _ANSI_ARGS_(( Tcl_Obj *dataObj,
+ char *formatString, int *widthPtr, int *heightPtr));
+static int StringReadGIF _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Obj *dataObj,
+ char *formatString, Tk_PhotoHandle imageHandle,
+ int destX, int destY, int width, int height,
+ int srcX, int srcY));
+
+Tk_PhotoImageFormat tkImgFmtGIF = {
+ "GIF", /* name */
+ FileMatchGIF, /* fileMatchProc */
+ StringMatchGIF, /* stringMatchProc */
+ FileReadGIF, /* fileReadProc */
+ StringReadGIF, /* stringReadProc */
+ NULL, /* fileWriteProc */
+ NULL, /* stringWriteProc */
+};
+
+#define INTERLACE 0x40
+#define LOCALCOLORMAP 0x80
+#define BitSet(byte, bit) (((byte) & (bit)) == (bit))
+#define MAXCOLORMAPSIZE 256
+#define CM_RED 0
+#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.
+ * 0==from file; 1==from base64 encoded data; 2==from binary data
+ */
+
+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,
+ int flag));
+static int GetDataBlock _ANSI_ARGS_((Tcl_Channel chan,
+ unsigned char *buf));
+static int LWZReadByte _ANSI_ARGS_((Tcl_Channel chan, int flag,
+ int input_code_size));
+static int ReadColorMap _ANSI_ARGS_((Tcl_Channel chan, int number,
+ unsigned char buffer[MAXCOLORMAPSIZE][4]));
+static int ReadGIFHeader _ANSI_ARGS_((Tcl_Channel chan,
+ int *widthPtr, int *heightPtr));
+static int ReadImage _ANSI_ARGS_((Tcl_Interp *interp,
+ char *imagePtr, Tcl_Channel chan,
+ int len, int rows,
+ unsigned char cmap[MAXCOLORMAPSIZE][4],
+ int width, int height, int srcX, int srcY,
+ int interlace, int transparent));
+
+/*
+ * these are for the BASE64 image reader code only
+ */
+
+static int Fread _ANSI_ARGS_((unsigned char *dst, size_t size,
+ size_t count, Tcl_Channel chan));
+static int Mread _ANSI_ARGS_((unsigned char *dst, size_t size,
+ size_t count, MFile *handle));
+static int Mgetc _ANSI_ARGS_((MFile *handle));
+static int char64 _ANSI_ARGS_((int c));
+static void mInit _ANSI_ARGS_((unsigned char *string,
+ MFile *handle));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileMatchGIF --
+ *
+ * This procedure is invoked by the photo image type to see if
+ * a file contains image data in GIF format.
+ *
+ * Results:
+ * The return value is 1 if the first characters in file f look
+ * like GIF data, and 0 otherwise.
+ *
+ * Side effects:
+ * The access position in f may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileMatchGIF(chan, fileName, formatString, widthPtr, heightPtr)
+ Tcl_Channel chan; /* The image file, open for reading. */
+ char *fileName; /* The name of the image file. */
+ char *formatString; /* User-specified format string, or NULL. */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are
+ * returned here if the file is a valid
+ * raw GIF file. */
+{
+ return ReadGIFHeader(chan, widthPtr, heightPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileReadGIF --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileReadGIF(interp, chan, fileName, formatString, imageHandle, destX, destY,
+ width, height, srcX, srcY)
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ Tcl_Channel chan; /* The image file, open for reading. */
+ char *fileName; /* The name of the image file. */
+ char *formatString; /* User-specified format string, or NULL. */
+ Tk_PhotoHandle imageHandle; /* The photo image to write into. */
+ int destX, destY; /* Coordinates of top-left pixel in
+ * photo image to be written to. */
+ int width, height; /* Dimensions of block of photo image to
+ * be written to. */
+ int srcX, srcY; /* Coordinates of top-left pixel to be used
+ * in image being read. */
+{
+ int fileWidth, fileHeight;
+ int nBytes;
+ Tk_PhotoImageBlock block;
+ unsigned char buf[100];
+ int bitPixel;
+ unsigned char colorMap[MAXCOLORMAPSIZE][4];
+ int transparent = -1;
+
+ if (!ReadGIFHeader(chan, &fileWidth, &fileHeight)) {
+ Tcl_AppendResult(interp, "couldn't read GIF header from file \"",
+ fileName, "\"", NULL);
+ return TCL_ERROR;
+ }
+ if ((fileWidth <= 0) || (fileHeight <= 0)) {
+ Tcl_AppendResult(interp, "GIF image file \"", fileName,
+ "\" has dimension(s) <= 0", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (Fread(buf, 1, 3, chan) != 3) {
+ return TCL_OK;
+ }
+ bitPixel = 2<<(buf[0]&0x07);
+
+ if (BitSet(buf[0], LOCALCOLORMAP)) { /* Global Colormap */
+ if (!ReadColorMap(chan, bitPixel, colorMap)) {
+ Tcl_AppendResult(interp, "error reading color map",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if ((srcX + width) > fileWidth) {
+ width = fileWidth - srcX;
+ }
+ if ((srcY + height) > fileHeight) {
+ height = fileHeight - srcY;
+ }
+ if ((width <= 0) || (height <= 0)
+ || (srcX >= fileWidth) || (srcY >= fileHeight)) {
+ return TCL_OK;
+ }
+
+ Tk_PhotoExpand(imageHandle, destX + width, destY + height);
+
+ block.width = width;
+ block.height = height;
+ block.pixelSize = 4;
+ block.pitch = block.pixelSize * block.width;
+ block.offset[0] = 0;
+ block.offset[1] = 1;
+ block.offset[2] = 2;
+ nBytes = height * block.pitch;
+ block.pixelPtr = (unsigned char *) ckalloc((unsigned) nBytes);
+
+ while (1) {
+ if (Fread(buf, 1, 1, chan) != 1) {
+ /*
+ * Premature end of image. We should really notify
+ * the user, but for now just show garbage.
+ */
+
+ break;
+ }
+
+ if (buf[0] == ';') {
+ /*
+ * GIF terminator.
+ */
+
+ break;
+ }
+
+ 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)) {
+ Tcl_AppendResult(interp, "error reading color map",
+ (char *) NULL);
+ goto error;
+ }
+ }
+ if (ReadImage(interp, (char *) block.pixelPtr, chan, width,
+ height, colorMap, fileWidth, fileHeight, srcX, srcY,
+ BitSet(buf[8], INTERLACE), transparent) != TCL_OK) {
+ goto error;
+ }
+ break;
+ }
+
+ if (transparent == -1) {
+ Tk_PhotoPutBlock(imageHandle, &block, destX, destY, width, height);
+ } else {
+ int x, y, end;
+ unsigned char *imagePtr, *rowPtr, *pixelPtr;
+
+ imagePtr = rowPtr = block.pixelPtr;
+ for (y = 0; y < height; y++) {
+ x = 0;
+ pixelPtr = rowPtr;
+ while(x < width) {
+ /* search for first non-transparent pixel */
+ while ((x < width) && !(pixelPtr[CM_ALPHA])) {
+ x++; pixelPtr += 4;
+ }
+ end = x;
+ /* search for first transparent pixel */
+ while ((end < width) && pixelPtr[CM_ALPHA]) {
+ end++; pixelPtr += 4;
+ }
+ if (end > x) {
+ block.pixelPtr = rowPtr + 4 * x;
+ Tk_PhotoPutBlock(imageHandle, &block, destX+x,
+ destY+y, end-x, 1);
+ }
+ x = end;
+ }
+ rowPtr += block.pitch;
+ }
+ block.pixelPtr = imagePtr;
+ }
+ ckfree((char *) block.pixelPtr);
+ return TCL_OK;
+
+ error:
+ ckfree((char *) block.pixelPtr);
+ return TCL_ERROR;
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringMatchGIF --
+ *
+ * This procedure is invoked by the photo image type to see if
+ * an object contains image data in GIF format.
+ *
+ * Results:
+ * The return value is 1 if the first characters in the data are
+ * like GIF data, and 0 otherwise.
+ *
+ * Side effects:
+ * the size of the image is placed in widthPre and heightPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+StringMatchGIF(dataObj, formatString, widthPtr, heightPtr)
+ Tcl_Obj *dataObj; /* the object containing the image data */
+ char *formatString; /* the image format string */
+ int *widthPtr; /* where to put the string width */
+ int *heightPtr; /* where to put the string height */
+{
+ unsigned char *data, header[10];
+ int got, length;
+ MFile handle;
+
+ data = Tcl_GetStringFromObj(dataObj, &length);
+
+ /* Header is a minimum of 10 bytes */
+ if (length < 10) {
+ return 0;
+ }
+
+ /* Check whether the data is Base64 encoded */
+
+ if ((strncmp("GIF87a", data, 6) != 0) &&
+ (strncmp("GIF89a", data, 6) != 0)) {
+ /* Try interpreting the data as Base64 encoded */
+ mInit((unsigned char *) data, &handle);
+ got = Mread(header, 10, 1, &handle);
+ if (got != 10
+ || ((strncmp("GIF87a", (char *) header, 6) != 0)
+ && (strncmp("GIF89a", (char *) header, 6) != 0))) {
+ return 0;
+ }
+ } else {
+ memcpy((VOID *) header, (VOID *) data, 10);
+ }
+ *widthPtr = LM_to_uint(header[6],header[7]);
+ *heightPtr = LM_to_uint(header[8],header[9]);
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StringReadGif -- --
+ *
+ * This procedure is called by the photo image type to read
+ * GIF format data from an object, optionally base64 encoded,
+ * 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,dataObj,formatString,imageHandle,
+ destX, destY, width, height, srcX, srcY)
+ Tcl_Interp *interp; /* interpreter for reporting errors in */
+ Tcl_Obj *dataObj; /* object 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;
+ Tcl_Channel dataSrc;
+ char *data;
+ /* Check whether the data is Base64 encoded */
+ data = Tcl_GetStringFromObj(dataObj, NULL);
+ if ((strncmp("GIF87a", data, 6) != 0) &&
+ (strncmp("GIF89a", data, 6) != 0)) {
+ mInit((unsigned char *)data,&handle);
+ fromData = 1;
+ dataSrc = (Tcl_Channel) &handle;
+ } else {
+ fromData = 2;
+ mInit((unsigned char *)data,&handle);
+ dataSrc = (Tcl_Channel) &handle;
+ }
+ result = FileReadGIF(interp, dataSrc, "inline data",
+ formatString, imageHandle, destX, destY, width, height,
+ srcX, srcY);
+ fromData = 0;
+ return(result);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadGIFHeader --
+ *
+ * This procedure reads the GIF header from the beginning of a
+ * GIF file and returns the dimensions of the image.
+ *
+ * Results:
+ * The return value is 1 if file "f" appears to start with
+ * a valid GIF header, 0 otherwise. If the header is valid,
+ * then *widthPtr and *heightPtr are modified to hold the
+ * dimensions of the image.
+ *
+ * Side effects:
+ * The access position in f advances.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadGIFHeader(chan, widthPtr, heightPtr)
+ Tcl_Channel chan; /* Image file to read the header from */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are
+ * returned here. */
+{
+ unsigned char buf[7];
+
+ if ((Fread(buf, 1, 6, chan) != 6)
+ || ((strncmp("GIF87a", (char *) buf, 6) != 0)
+ && (strncmp("GIF89a", (char *) buf, 6) != 0))) {
+ return 0;
+ }
+
+ if (Fread(buf, 1, 4, chan) != 4) {
+ return 0;
+ }
+
+ *widthPtr = LM_to_uint(buf[0],buf[1]);
+ *heightPtr = LM_to_uint(buf[2],buf[3]);
+ return 1;
+}
+
+/*
+ *-----------------------------------------------------------------
+ * The code below is copied from the giftoppm program and modified
+ * just slightly.
+ *-----------------------------------------------------------------
+ */
+
+static int
+ReadColorMap(chan, number, buffer)
+ Tcl_Channel chan;
+ int number;
+ unsigned char buffer[MAXCOLORMAPSIZE][4];
+{
+ int i;
+ unsigned char rgb[3];
+
+ for (i = 0; i < number; ++i) {
+ if (! ReadOK(chan, rgb, sizeof(rgb))) {
+ return 0;
+ }
+
+ buffer[i][CM_RED] = rgb[0] ;
+ buffer[i][CM_GREEN] = rgb[1] ;
+ buffer[i][CM_BLUE] = rgb[2] ;
+ buffer[i][CM_ALPHA] = 255 ;
+ }
+ return 1;
+}
+
+
+
+static int
+DoExtension(chan, label, transparent)
+ Tcl_Channel chan;
+ int label;
+ int *transparent;
+{
+ static unsigned char buf[256];
+ int count;
+
+ switch (label) {
+ case 0x01: /* Plain Text Extension */
+ break;
+
+ case 0xff: /* Application Extension */
+ break;
+
+ case 0xfe: /* Comment Extension */
+ do {
+ count = GetDataBlock(chan, (unsigned char*) buf);
+ } while (count > 0);
+ return count;
+
+ case 0xf9: /* Graphic Control Extension */
+ count = GetDataBlock(chan, (unsigned char*) buf);
+ if (count < 0) {
+ return 1;
+ }
+ if ((buf[0] & 0x1) != 0) {
+ *transparent = buf[3];
+ }
+
+ do {
+ count = GetDataBlock(chan, (unsigned char*) buf);
+ } while (count > 0);
+ return count;
+ }
+
+ do {
+ count = GetDataBlock(chan, (unsigned char*) buf);
+ } while (count > 0);
+ return count;
+}
+
+static int ZeroDataBlock = 0;
+
+static int
+GetDataBlock(chan, buf)
+ Tcl_Channel chan;
+ unsigned char *buf;
+{
+ unsigned char count;
+
+ if (! ReadOK(chan, &count,1)) {
+ return -1;
+ }
+
+ ZeroDataBlock = count == 0;
+
+ if ((count != 0) && (! ReadOK(chan, buf, count))) {
+ return -1;
+ }
+
+ return count;
+}
+
+
+static int
+ReadImage(interp, imagePtr, chan, len, rows, cmap,
+ width, height, srcX, srcY, interlace, transparent)
+ Tcl_Interp *interp;
+ char *imagePtr;
+ Tcl_Channel chan;
+ int len, rows;
+ unsigned char cmap[MAXCOLORMAPSIZE][4];
+ int width, height;
+ int srcX, srcY;
+ int interlace;
+ int transparent;
+{
+ unsigned char c;
+ int v;
+ int xpos = 0, ypos = 0, pass = 0;
+ char *pixelPtr;
+
+
+ /*
+ * Initialize the Compression routines
+ */
+ 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;
+ cmap[transparent][CM_ALPHA] = 0;
+ }
+
+ pixelPtr = imagePtr;
+ while ((v = LWZReadByte(chan, 0, c)) >= 0 ) {
+
+ if ((xpos>=srcX) && (xpos<srcX+len) &&
+ (ypos>=srcY) && (ypos<srcY+rows)) {
+ *pixelPtr++ = cmap[v][CM_RED];
+ *pixelPtr++ = cmap[v][CM_GREEN];
+ *pixelPtr++ = cmap[v][CM_BLUE];
+ *pixelPtr++ = cmap[v][CM_ALPHA];
+ }
+
+ ++xpos;
+ if (xpos == width) {
+ xpos = 0;
+ if (interlace) {
+ switch (pass) {
+ case 0:
+ case 1:
+ ypos += 8; break;
+ case 2:
+ ypos += 4; break;
+ case 3:
+ ypos += 2; break;
+ }
+
+ while (ypos >= height) {
+ ++pass;
+ switch (pass) {
+ case 1:
+ ypos = 4; break;
+ case 2:
+ ypos = 2; break;
+ case 3:
+ ypos = 1; break;
+ default:
+ return TCL_OK;
+ }
+ }
+ } else {
+ ++ypos;
+ }
+ pixelPtr = imagePtr + (ypos-srcY) * len * 4;
+ }
+ if (ypos >= height)
+ break;
+ }
+ return TCL_OK;
+}
+
+static int
+LWZReadByte(chan, flag, input_code_size)
+ Tcl_Channel chan;
+ int flag;
+ int input_code_size;
+{
+ static int fresh = 0;
+ int code, incode;
+ static int code_size, set_code_size;
+ static int max_code, max_code_size;
+ static int firstcode, oldcode;
+ static int clear_code, end_code;
+ static int table[2][(1<< MAX_LWZ_BITS)];
+ static int stack[(1<<(MAX_LWZ_BITS))*2], *sp;
+ register int i;
+
+ if (flag) {
+ set_code_size = input_code_size;
+ code_size = set_code_size+1;
+ clear_code = 1 << set_code_size ;
+ end_code = clear_code + 1;
+ max_code_size = 2*clear_code;
+ max_code = clear_code+2;
+
+ GetCode(chan, 0, 1);
+
+ fresh = 1;
+
+ for (i = 0; i < clear_code; ++i) {
+ table[0][i] = 0;
+ table[1][i] = i;
+ }
+ for (; i < (1<<MAX_LWZ_BITS); ++i) {
+ table[0][i] = table[1][0] = 0;
+ }
+
+ sp = stack;
+
+ return 0;
+ } else if (fresh) {
+ fresh = 0;
+ do {
+ firstcode = oldcode = GetCode(chan, code_size, 0);
+ } while (firstcode == clear_code);
+ return firstcode;
+ }
+
+ if (sp > stack) {
+ return *--sp;
+ }
+
+ while ((code = GetCode(chan, code_size, 0)) >= 0) {
+ if (code == clear_code) {
+ for (i = 0; i < clear_code; ++i) {
+ table[0][i] = 0;
+ table[1][i] = i;
+ }
+
+ for (; i < (1<<MAX_LWZ_BITS); ++i) {
+ table[0][i] = table[1][i] = 0;
+ }
+
+ code_size = set_code_size+1;
+ max_code_size = 2*clear_code;
+ max_code = clear_code+2;
+ sp = stack;
+ firstcode = oldcode = GetCode(chan, code_size, 0);
+ return firstcode;
+
+ } else if (code == end_code) {
+ int count;
+ unsigned char buf[260];
+
+ if (ZeroDataBlock) {
+ return -2;
+ }
+
+ while ((count = GetDataBlock(chan, buf)) > 0)
+ /* Empty body */;
+
+ if (count != 0) {
+ return -2;
+ }
+ }
+
+ incode = code;
+
+ if (code >= max_code) {
+ *sp++ = firstcode;
+ code = oldcode;
+ }
+
+ while (code >= clear_code) {
+ *sp++ = table[1][code];
+ if (code == table[0][code]) {
+ return -2;
+
+ /*
+ * Used to be this instead, Steve Ball suggested
+ * the change to just return.
+ printf("circular table entry BIG ERROR\n");
+ */
+ }
+ code = table[0][code];
+ }
+
+ *sp++ = firstcode = table[1][code];
+
+ if ((code = max_code) <(1<<MAX_LWZ_BITS)) {
+ table[0][code] = oldcode;
+ table[1][code] = firstcode;
+ ++max_code;
+ if ((max_code>=max_code_size) && (max_code_size < (1<<MAX_LWZ_BITS))) {
+ max_code_size *= 2;
+ ++code_size;
+ }
+ }
+
+ oldcode = incode;
+
+ if (sp > stack)
+ return *--sp;
+ }
+ return code;
+}
+
+
+static int
+GetCode(chan, code_size, flag)
+ Tcl_Channel chan;
+ int code_size;
+ int flag;
+{
+ static unsigned char buf[280];
+ static int curbit, lastbit, done, last_byte;
+ int i, j, ret;
+ unsigned char count;
+
+ if (flag) {
+ curbit = 0;
+ lastbit = 0;
+ done = 0;
+ return 0;
+ }
+
+
+ if ( (curbit+code_size) >= lastbit) {
+ if (done) {
+ /* ran off the end of my bits */
+ return -1;
+ }
+ if (last_byte >= 2) {
+ buf[0] = buf[last_byte-2];
+ }
+ if (last_byte >= 1) {
+ buf[1] = buf[last_byte-1];
+ }
+
+ if ((count = GetDataBlock(chan, &buf[2])) == 0) {
+ done = 1;
+ }
+
+ last_byte = 2 + count;
+ curbit = (curbit - lastbit) + 16;
+ lastbit = (2+count)*8 ;
+ }
+
+ ret = 0;
+ for (i = curbit, j = 0; j < code_size; ++i, ++j) {
+ ret |= ((buf[ i / 8 ] & (1 << (i % 8))) != 0) << j;
+ }
+
+ curbit += code_size;
+
+ return ret;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Minit -- --
+ *
+ * This procedure initializes a base64 decoder handle
+ *
+ * Results:
+ * none
+ *
+ * Side effects:
+ * the base64 handle is initialized
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+mInit(string, handle)
+ unsigned char *string; /* string containing initial mmencoded data */
+ MFile *handle; /* mmdecode "file" handle */
+{
+ handle->data = string;
+ handle->state = 0;
+ handle->c = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mread --
+ *
+ * This procedure is invoked by the GIF file reader as a
+ * temporary replacement for "fread", to get GIF data out
+ * of a string (using Mgetc).
+ *
+ * Results:
+ * The return value is the number of characters "read"
+ *
+ * Side effects:
+ * The base64 handle will change state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Mread(dst, chunkSize, numChunks, handle)
+ unsigned char *dst; /* where to put the result */
+ size_t chunkSize; /* size of each transfer */
+ size_t numChunks; /* number of chunks */
+ MFile *handle; /* mmdecode "file" handle */
+{
+ register int i, c;
+ int count = chunkSize * numChunks;
+
+ for(i=0; i<count && (c=Mgetc(handle)) != GIF_DONE; i++) {
+ *dst++ = c;
+ }
+ return i;
+}
+
+/*
+ * get the next decoded character from an mmencode handle
+ * This causes at least 1 character to be "read" from the encoded string
+ */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Mgetc --
+ *
+ * This procedure decodes and returns the next byte from a base64
+ * encoded string.
+ *
+ * Results:
+ * The next byte (or GIF_DONE) is returned.
+ *
+ * Side effects:
+ * The base64 handle will change state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Mgetc(handle)
+ MFile *handle; /* Handle containing decoder data and state. */
+{
+ int c;
+ int result = 0; /* Initialization needed only to prevent
+ * gcc compiler warning. */
+
+ if (handle->state == GIF_DONE) {
+ return(GIF_DONE);
+ }
+
+ do {
+ c = char64(*handle->data);
+ handle->data++;
+ } while (c==GIF_SPACE);
+
+ if (c>GIF_SPECIAL) {
+ handle->state = GIF_DONE;
+ return(handle->state ? handle->c : GIF_DONE);
+ }
+
+ switch (handle->state++) {
+ case 0:
+ handle->c = c<<2;
+ result = Mgetc(handle);
+ break;
+ case 1:
+ result = handle->c | (c>>4);
+ handle->c = (c&0xF)<<4;
+ break;
+ case 2:
+ result = handle->c | (c>>2);
+ handle->c = (c&0x3) << 6;
+ break;
+ case 3:
+ result = handle->c | c;
+ handle->state = 0;
+ break;
+ }
+ return(result);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * char64 --
+ *
+ * This procedure converts a base64 ascii character into its binary
+ * equivalent. This code is a slightly modified version of the
+ * char64 proc in N. Borenstein's metamail decoder.
+ *
+ * Results:
+ * The binary value, or an error code.
+ *
+ * Side effects:
+ * None.
+ *----------------------------------------------------------------------
+ */
+
+static int
+char64(c)
+int c;
+{
+ switch(c) {
+ case 'A': return(0); case 'B': return(1); case 'C': return(2);
+ case 'D': return(3); case 'E': return(4); case 'F': return(5);
+ case 'G': return(6); case 'H': return(7); case 'I': return(8);
+ case 'J': return(9); case 'K': return(10); case 'L': return(11);
+ case 'M': return(12); case 'N': return(13); case 'O': return(14);
+ case 'P': return(15); case 'Q': return(16); case 'R': return(17);
+ case 'S': return(18); case 'T': return(19); case 'U': return(20);
+ case 'V': return(21); case 'W': return(22); case 'X': return(23);
+ case 'Y': return(24); case 'Z': return(25); case 'a': return(26);
+ case 'b': return(27); case 'c': return(28); case 'd': return(29);
+ case 'e': return(30); case 'f': return(31); case 'g': return(32);
+ case 'h': return(33); case 'i': return(34); case 'j': return(35);
+ case 'k': return(36); case 'l': return(37); case 'm': return(38);
+ case 'n': return(39); case 'o': return(40); case 'p': return(41);
+ case 'q': return(42); case 'r': return(43); case 's': return(44);
+ case 't': return(45); case 'u': return(46); case 'v': return(47);
+ case 'w': return(48); case 'x': return(49); case 'y': return(50);
+ case 'z': return(51); case '0': return(52); case '1': return(53);
+ case '2': return(54); case '3': return(55); case '4': return(56);
+ case '5': return(57); case '6': return(58); case '7': return(59);
+ case '8': return(60); case '9': return(61); case '+': return(62);
+ case '/': return(63);
+
+ case ' ': case '\t': case '\n': case '\r': case '\f': return(GIF_SPACE);
+ case '=': return(GIF_PAD);
+ case '\0': return(GIF_DONE);
+ default: return(GIF_BAD);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Fread --
+ *
+ * This procedure calls either fread or Mread to read data
+ * from a file or a base64 encoded string.
+ *
+ * Results: - same as fread
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+Fread(dst, hunk, count, chan)
+ unsigned char *dst; /* where to put the result */
+ size_t hunk,count; /* how many */
+ Tcl_Channel chan;
+{
+ MFile *handle;
+ switch (fromData) {
+ case 0:
+ return Tcl_Read(chan, (char *) dst, (int) (hunk * count));
+ case 1:
+ return(Mread(dst, hunk, count, (MFile *) chan));
+ case 2:
+ handle = (MFile *) chan;
+ memcpy((VOID *)dst, (VOID *) handle->data, (int) (hunk * count));
+ handle->data += hunk * count;
+ return((int) (hunk * count));
+ }
+}
diff --git a/tk/generic/tkImgPPM.c b/tk/generic/tkImgPPM.c
new file mode 100644
index 00000000000..02309eb6588
--- /dev/null
+++ b/tk/generic/tkImgPPM.c
@@ -0,0 +1,421 @@
+/*
+ * tkImgPPM.c --
+ *
+ * A photo image file handler for PPM (Portable PixMap) files.
+ *
+ * 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 (paulus@cs.anu.edu.au),
+ * Department of Computer Science,
+ * Australian National University.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * The maximum amount of memory to allocate for data read from the
+ * file. If we need more than this, we do it in pieces.
+ */
+
+#define MAX_MEMORY 10000 /* don't allocate > 10KB */
+
+/*
+ * Define PGM and PPM, i.e. gray images and color images.
+ */
+
+#define PGM 1
+#define PPM 2
+
+/*
+ * The format record for the PPM file format:
+ */
+
+static int FileMatchPPM _ANSI_ARGS_((Tcl_Channel chan,
+ char *fileName, char *formatString,
+ int *widthPtr, int *heightPtr));
+static int FileReadPPM _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Channel chan, char *fileName,
+ char *formatString, Tk_PhotoHandle imageHandle,
+ int destX, int destY, int width, int height,
+ int srcX, int srcY));
+static int FileWritePPM _ANSI_ARGS_((Tcl_Interp *interp,
+ char *fileName, char *formatString,
+ Tk_PhotoImageBlock *blockPtr));
+
+Tk_PhotoImageFormat tkImgFmtPPM = {
+ "PPM", /* name */
+ FileMatchPPM, /* fileMatchProc */
+ NULL, /* stringMatchProc */
+ FileReadPPM, /* fileReadProc */
+ NULL, /* stringReadProc */
+ FileWritePPM, /* fileWriteProc */
+ NULL, /* stringWriteProc */
+};
+
+/*
+ * Prototypes for local procedures defined in this file:
+ */
+
+static int ReadPPMFileHeader _ANSI_ARGS_((Tcl_Channel chan,
+ int *widthPtr, int *heightPtr,
+ int *maxIntensityPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileMatchPPM --
+ *
+ * This procedure is invoked by the photo image type to see if
+ * a file contains image data in PPM format.
+ *
+ * Results:
+ * The return value is >0 if the first characters in file "f" look
+ * like PPM data, and 0 otherwise.
+ *
+ * Side effects:
+ * The access position in f may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileMatchPPM(chan, fileName, formatString, widthPtr, heightPtr)
+ Tcl_Channel chan; /* The image file, open for reading. */
+ char *fileName; /* The name of the image file. */
+ char *formatString; /* User-specified format string, or NULL. */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are
+ * returned here if the file is a valid
+ * raw PPM file. */
+{
+ int dummy;
+
+ return ReadPPMFileHeader(chan, widthPtr, heightPtr, &dummy);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileReadPPM --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FileReadPPM(interp, chan, fileName, formatString, imageHandle, destX, destY,
+ width, height, srcX, srcY)
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ Tcl_Channel chan; /* The image file, open for reading. */
+ char *fileName; /* The name of the image file. */
+ char *formatString; /* User-specified format string, or NULL. */
+ Tk_PhotoHandle imageHandle; /* The photo image to write into. */
+ int destX, destY; /* Coordinates of top-left pixel in
+ * photo image to be written to. */
+ int width, height; /* Dimensions of block of photo image to
+ * be written to. */
+ int srcX, srcY; /* Coordinates of top-left pixel to be used
+ * in image being read. */
+{
+ int fileWidth, fileHeight, maxIntensity;
+ int nLines, nBytes, h, type, count;
+ unsigned char *pixelPtr;
+ Tk_PhotoImageBlock block;
+
+ type = ReadPPMFileHeader(chan, &fileWidth, &fileHeight, &maxIntensity);
+ if (type == 0) {
+ Tcl_AppendResult(interp, "couldn't read raw PPM header from file \"",
+ fileName, "\"", NULL);
+ return TCL_ERROR;
+ }
+ 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;
+ }
+
+ if ((srcX + width) > fileWidth) {
+ width = fileWidth - srcX;
+ }
+ if ((srcY + height) > fileHeight) {
+ height = fileHeight - srcY;
+ }
+ if ((width <= 0) || (height <= 0)
+ || (srcX >= fileWidth) || (srcY >= fileHeight)) {
+ return TCL_OK;
+ }
+
+ if (type == PGM) {
+ block.pixelSize = 1;
+ block.offset[0] = 0;
+ block.offset[1] = 0;
+ block.offset[2] = 0;
+ }
+ else {
+ block.pixelSize = 3;
+ block.offset[0] = 0;
+ block.offset[1] = 1;
+ block.offset[2] = 2;
+ }
+ block.width = width;
+ block.pitch = block.pixelSize * fileWidth;
+
+ Tk_PhotoExpand(imageHandle, destX + width, destY + height);
+
+ if (srcY > 0) {
+ Tcl_Seek(chan, (srcY * block.pitch), SEEK_CUR);
+ }
+
+ nLines = (MAX_MEMORY + block.pitch - 1) / block.pitch;
+ if (nLines > height) {
+ nLines = height;
+ }
+ if (nLines <= 0) {
+ nLines = 1;
+ }
+ nBytes = nLines * block.pitch;
+ pixelPtr = (unsigned char *) ckalloc((unsigned) nBytes);
+ block.pixelPtr = pixelPtr + srcX * block.pixelSize;
+
+ for (h = height; h > 0; h -= nLines) {
+ if (nLines > h) {
+ nLines = h;
+ nBytes = nLines * block.pitch;
+ }
+ count = Tcl_Read(chan, (char *) pixelPtr, nBytes);
+ if (count != nBytes) {
+ Tcl_AppendResult(interp, "error reading PPM image file \"",
+ fileName, "\": ",
+ Tcl_Eof(chan) ? "not enough data" : Tcl_PosixError(interp),
+ (char *) NULL);
+ ckfree((char *) pixelPtr);
+ return TCL_ERROR;
+ }
+ if (maxIntensity != 255) {
+ unsigned char *p;
+
+ for (p = pixelPtr; count > 0; count--, p++) {
+ *p = (((int) *p) * 255)/maxIntensity;
+ }
+ }
+ block.height = nLines;
+ Tk_PhotoPutBlock(imageHandle, &block, destX, destY, width, nLines);
+ destY += nLines;
+ }
+
+ ckfree((char *) pixelPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+ Tcl_Write(chan, header, -1);
+
+ pixLinePtr = blockPtr->pixelPtr + blockPtr->offset[0];
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+
+ if ((greenOffset == 1) && (blueOffset == 2) && (blockPtr->pixelSize == 3)
+ && (blockPtr->pitch == (blockPtr->width * 3))) {
+ nBytes = blockPtr->height * blockPtr->pitch;
+ if (Tcl_Write(chan, (char *) pixLinePtr, nBytes) != nBytes) {
+ goto writeerror;
+ }
+ } else {
+ for (h = blockPtr->height; h > 0; h--) {
+ pixelPtr = pixLinePtr;
+ for (w = blockPtr->width; w > 0; w--) {
+ if ((Tcl_Write(chan, (char *) &pixelPtr[0], 1) == -1)
+ || (Tcl_Write(chan, (char *) &pixelPtr[greenOffset], 1) == -1)
+ || (Tcl_Write(chan, (char *) &pixelPtr[blueOffset], 1) == -1)) {
+ goto writeerror;
+ }
+ pixelPtr += blockPtr->pixelSize;
+ }
+ pixLinePtr += blockPtr->pitch;
+ }
+ }
+
+ if (Tcl_Close(NULL, chan) == 0) {
+ return TCL_OK;
+ }
+ chan = NULL;
+
+ writeerror:
+ Tcl_AppendResult(interp, "error writing \"", fileName, "\": ",
+ Tcl_PosixError(interp), (char *) NULL);
+ if (chan != NULL) {
+ Tcl_Close(NULL, chan);
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadPPMFileHeader --
+ *
+ * This procedure reads the PPM header from the beginning of a
+ * PPM file and returns information from the header.
+ *
+ * Results:
+ * The return value is PGM if file "f" appears to start with
+ * a valid PGM header, PPM if "f" appears to start with a valid
+ * PPM header, and 0 otherwise. If the header is valid,
+ * then *widthPtr and *heightPtr are modified to hold the
+ * dimensions of the image and *maxIntensityPtr is modified to
+ * hold the value of a "fully on" intensity value.
+ *
+ * Side effects:
+ * The access position in f advances.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadPPMFileHeader(chan, widthPtr, heightPtr, maxIntensityPtr)
+ Tcl_Channel chan; /* Image file to read the header from */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are
+ * returned here. */
+ int *maxIntensityPtr; /* The maximum intensity value for
+ * the image is stored here. */
+{
+#define BUFFER_SIZE 1000
+ char buffer[BUFFER_SIZE];
+ int i, numFields, firstInLine;
+ int type = 0;
+ char c;
+
+ /*
+ * Read 4 space-separated fields from the file, ignoring
+ * comments (any line that starts with "#").
+ */
+
+ if (Tcl_Read(chan, &c, 1) != 1) {
+ return 0;
+ }
+ firstInLine = 1;
+ i = 0;
+ for (numFields = 0; numFields < 4; numFields++) {
+ /*
+ * Skip comments and white space.
+ */
+
+ while (1) {
+ while (isspace(UCHAR(c))) {
+ firstInLine = (c == '\n');
+ if (Tcl_Read(chan, &c, 1) != 1) {
+ return 0;
+ }
+ }
+ if (c != '#') {
+ break;
+ }
+ do {
+ if (Tcl_Read(chan, &c, 1) != 1) {
+ return 0;
+ }
+ } while (c != '\n');
+ firstInLine = 1;
+ }
+
+ /*
+ * Read a field (everything up to the next white space).
+ */
+
+ while (!isspace(UCHAR(c))) {
+ if (i < (BUFFER_SIZE-2)) {
+ buffer[i] = c;
+ i++;
+ }
+ if (Tcl_Read(chan, &c, 1) != 1) {
+ goto done;
+ }
+ }
+ if (i < (BUFFER_SIZE-1)) {
+ buffer[i] = ' ';
+ i++;
+ }
+ firstInLine = 0;
+ }
+ done:
+ buffer[i] = 0;
+
+ /*
+ * Parse the fields, which are: id, width, height, maxIntensity.
+ */
+
+ if (strncmp(buffer, "P6 ", 3) == 0) {
+ type = PPM;
+ } else if (strncmp(buffer, "P5 ", 3) == 0) {
+ type = PGM;
+ } else {
+ return 0;
+ }
+ if (sscanf(buffer+3, "%d %d %d", widthPtr, heightPtr, maxIntensityPtr)
+ != 3) {
+ return 0;
+ }
+ return type;
+}
diff --git a/tk/generic/tkImgPhoto.c b/tk/generic/tkImgPhoto.c
new file mode 100644
index 00000000000..72fddfe1478
--- /dev/null
+++ b/tk/generic/tkImgPhoto.c
@@ -0,0 +1,4622 @@
+/*
+ * tkImgPhoto.c --
+ *
+ * Implements images of type "photo" for Tk. Photo images are
+ * stored in full color (24 bits per pixel) and displayed using
+ * dithering if necessary.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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));
+
+/*
+ * A signed 8-bit integral type. If chars are unsigned and the compiler
+ * isn't an ANSI one, then we have to use short instead (which wastes
+ * space) to get signed behavior.
+ */
+
+#if defined(__STDC__) || defined(_AIX)
+ typedef signed char schar;
+#else
+# ifndef __CHAR_UNSIGNED__
+ typedef char schar;
+# else
+ typedef short schar;
+# endif
+#endif
+
+/*
+ * An unsigned 32-bit integral type, used for pixel values.
+ * We use int rather than long here to accommodate those systems
+ * where longs are 64 bits.
+ */
+
+typedef unsigned int pixel;
+
+/*
+ * The maximum number of pixels to transmit to the server in a
+ * single XPutImage call.
+ */
+
+#define MAX_PIXELS 65536
+
+/*
+ * The set of colors required to display a photo image in a window depends on:
+ * - the visual used by the window
+ * - the palette, which specifies how many levels of each primary
+ * color to use, and
+ * - the gamma value for the image.
+ *
+ * Pixel values allocated for specific colors are valid only for the
+ * colormap in which they were allocated. Sets of pixel values
+ * allocated for displaying photos are re-used in other windows if
+ * possible, that is, if the display, colormap, palette and gamma
+ * values match. A hash table is used to locate these sets of pixel
+ * values, using the following data structure as key:
+ */
+
+typedef struct {
+ Display *display; /* Qualifies the colormap resource ID */
+ Colormap colormap; /* Colormap that the windows are using. */
+ double gamma; /* Gamma exponent value for images. */
+ Tk_Uid palette; /* Specifies how many shades of each primary
+ * we want to allocate. */
+} ColorTableId;
+
+/*
+ * For a particular (display, colormap, palette, gamma) combination,
+ * a data structure of the following type is used to store the allocated
+ * pixel values and other information:
+ */
+
+typedef struct ColorTable {
+ ColorTableId id; /* Information used in selecting this
+ * color table. */
+ int flags; /* See below. */
+ int refCount; /* Number of instances using this map. */
+ int liveRefCount; /* Number of instances which are actually
+ * in use, using this map. */
+ int numColors; /* Number of colors allocated for this map. */
+
+ XVisualInfo visualInfo; /* Information about the visual for windows
+ * using this color table. */
+
+ pixel redValues[256]; /* Maps 8-bit values of red intensity
+ * to a pixel value or index in pixelMap. */
+ pixel greenValues[256]; /* Ditto for green intensity */
+ pixel blueValues[256]; /* Ditto for blue intensity */
+ unsigned long *pixelMap; /* Actual pixel values allocated. */
+
+ unsigned char colorQuant[3][256];
+ /* Maps 8-bit intensities to quantized
+ * intensities. The first index is 0 for
+ * red, 1 for green, 2 for blue. */
+} ColorTable;
+
+/*
+ * Bit definitions for the flags field of a ColorTable.
+ * BLACK_AND_WHITE: 1 means only black and white colors are
+ * available.
+ * COLOR_WINDOW: 1 means a full 3-D color cube has been
+ * 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
+
+/*
+ * Definition of the data associated with each photo image master.
+ */
+
+typedef struct PhotoMaster {
+ Tk_ImageMaster tkMaster; /* Tk's token for image master. NULL means
+ * the image is being deleted. */
+ Tcl_Interp *interp; /* Interpreter associated with the
+ * application using this image. */
+ Tcl_Command imageCmd; /* Token for image command (used to delete
+ * it when the image goes away). NULL means
+ * the image command has already been
+ * deleted. */
+ int flags; /* Sundry flags, defined below. */
+ int width, height; /* Dimensions of image. */
+ int userWidth, userHeight; /* User-declared image dimensions. */
+ Tk_Uid palette; /* User-specified default palette for
+ * instances of this image. */
+ double gamma; /* Display gamma value to correct for. */
+ char *fileString; /* Name of file to read into image. */
+ Tcl_Obj *dataObj; /* Object to use as contents of image. */
+ char *format; /* User-specified format of data in image
+ * file or string value. */
+ unsigned char *pix24; /* Local storage for 24-bit image. */
+ int ditherX, ditherY; /* Location of first incorrectly
+ * dithered pixel in image. */
+ TkRegion validRegion; /* Tk region indicating which parts of
+ * the image have valid image data. */
+ struct PhotoInstance *instancePtr;
+ /* First in the list of instances
+ * associated with this master. */
+} PhotoMaster;
+
+/*
+ * Bit definitions for the flags field of a PhotoMaster.
+ * COLOR_IMAGE: 1 means that the image has different color
+ * components.
+ * IMAGE_CHANGED: 1 means that the instances of this image
+ * need to be redithered.
+ */
+
+#define COLOR_IMAGE 1
+#define IMAGE_CHANGED 2
+
+/*
+ * The following data structure represents all of the instances of
+ * a photo image in windows on a given screen that are using the
+ * same colormap.
+ */
+
+typedef struct PhotoInstance {
+ PhotoMaster *masterPtr; /* Pointer to master for image. */
+ Display *display; /* Display for windows using this instance. */
+ Colormap colormap; /* The image may only be used in windows with
+ * this particular colormap. */
+ struct PhotoInstance *nextPtr;
+ /* Pointer to the next instance in the list
+ * of instances associated with this master. */
+ int refCount; /* Number of instances using this structure. */
+ Tk_Uid palette; /* Palette for these particular instances. */
+ double gamma; /* Gamma value for these instances. */
+ Tk_Uid defaultPalette; /* Default palette to use if a palette
+ * is not specified for the master. */
+ ColorTable *colorTablePtr; /* Pointer to information about colors
+ * allocated for image display in windows
+ * like this one. */
+ Pixmap pixels; /* X pixmap containing dithered image. */
+ int width, height; /* Dimensions of the pixmap. */
+ schar *error; /* Error image, used in dithering. */
+ XImage *imagePtr; /* Image structure for converted pixels. */
+ XVisualInfo visualInfo; /* Information about the visual that these
+ * windows are using. */
+ GC gc; /* Graphics context for writing images
+ * to the pixmap. */
+} PhotoInstance;
+
+/*
+ * The following data structure is used to return information
+ * from ParseSubcommandOptions:
+ */
+
+struct SubcommandOptions {
+ int options; /* Individual bits indicate which
+ * options were specified - see below. */
+ char *name; /* Name specified without an option. */
+ int fromX, fromY; /* Values specified for -from option. */
+ int fromX2, fromY2; /* Second coordinate pair for -from option. */
+ int toX, toY; /* Values specified for -to option. */
+ int toX2, toY2; /* Second coordinate pair for -to option. */
+ int zoomX, zoomY; /* Values specified for -zoom option. */
+ int subsampleX, subsampleY; /* Values specified for -subsample option. */
+ char *format; /* Value specified for -format option. */
+ XColor *background; /* Value specified for -background option. */
+};
+
+/*
+ * Bit definitions for use with ParseSubcommandOptions:
+ * Each bit is set in the allowedOptions parameter on a call to
+ * ParseSubcommandOptions if that option is allowed for the current
+ * photo image subcommand. On return, the bit is set in the options
+ * field of the SubcommandOptions structure if that option was specified.
+ *
+ * OPT_BACKGROUND: Set if -format option allowed/specified.
+ * OPT_FORMAT: Set if -format option allowed/specified.
+ * OPT_FROM: Set if -from option allowed/specified.
+ * OPT_GRAYSCALE: Set if -grayscale option allowed/specified.
+ * OPT_SHRINK: Set if -shrink option allowed/specified.
+ * OPT_SUBSAMPLE: Set if -subsample option allowed/spec'd.
+ * OPT_TO: Set if -to option allowed/specified.
+ * OPT_ZOOM: Set if -zoom option allowed/specified.
+ */
+
+#define OPT_BACKGROUND 1
+#define OPT_FORMAT 2
+#define OPT_FROM 4
+#define OPT_GRAYSCALE 8
+#define OPT_SHRINK 0x10
+#define OPT_SUBSAMPLE 0x20
+#define OPT_TO 0x40
+#define OPT_ZOOM 0x80
+
+/*
+ * List of option names. The order here must match the order of
+ * declarations of the OPT_* constants above.
+ */
+
+static char *optionNames[] = {
+ "-background",
+ "-format",
+ "-from",
+ "-grayscale",
+ "-shrink",
+ "-subsample",
+ "-to",
+ "-zoom",
+ (char *) NULL
+};
+
+/*
+ * The type record for photo images:
+ */
+
+static int ImgPhotoCreate _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, int argc, Tcl_Obj *CONST objv[],
+ Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *clientDataPtr));
+static ClientData ImgPhotoGet _ANSI_ARGS_((Tk_Window tkwin,
+ ClientData clientData));
+static void ImgPhotoDisplay _ANSI_ARGS_((ClientData clientData,
+ Display *display, Drawable drawable,
+ int imageX, int imageY, int width, int height,
+ int drawableX, int drawableY));
+static void ImgPhotoFree _ANSI_ARGS_((ClientData clientData,
+ Display *display));
+static void ImgPhotoDelete _ANSI_ARGS_((ClientData clientData));
+
+Tk_ImageType tkPhotoImageType = {
+ "photo", /* name */
+ ImgPhotoCreate, /* createProc */
+ 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 ""
+#define DEF_PHOTO_WIDTH "0"
+
+/*
+ * Information used for parsing configuration specifications:
+ */
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_STRING, "-format", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PhotoMaster, format), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-file", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(PhotoMaster, fileString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_DOUBLE, "-gamma", (char *) NULL, (char *) NULL,
+ DEF_PHOTO_GAMMA, Tk_Offset(PhotoMaster, gamma), 0},
+ {TK_CONFIG_INT, "-height", (char *) NULL, (char *) NULL,
+ DEF_PHOTO_HEIGHT, Tk_Offset(PhotoMaster, userHeight), 0},
+ {TK_CONFIG_UID, "-palette", (char *) NULL, (char *) NULL,
+ DEF_PHOTO_PALETTE, Tk_Offset(PhotoMaster, palette), 0},
+ {TK_CONFIG_INT, "-width", (char *) NULL, (char *) NULL,
+ DEF_PHOTO_WIDTH, Tk_Offset(PhotoMaster, userWidth), 0},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Hash table used to hash from (display, colormap, palette, gamma)
+ * 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, Tcl_Obj *CONST objv[]));
+static int ParseSubcommandOptions _ANSI_ARGS_((
+ struct SubcommandOptions *optPtr,
+ Tcl_Interp *interp, int allowedOptions,
+ int *indexPtr, int argc, char **argv));
+static void ImgPhotoCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int ImgPhotoConfigureMaster _ANSI_ARGS_((
+ Tcl_Interp *interp, PhotoMaster *masterPtr,
+ int argc, Tcl_Obj *CONST objv[], int flags));
+static void ImgPhotoConfigureInstance _ANSI_ARGS_((
+ PhotoInstance *instancePtr));
+static void ImgPhotoSetSize _ANSI_ARGS_((PhotoMaster *masterPtr,
+ int width, int height));
+static void ImgPhotoInstanceSetSize _ANSI_ARGS_((
+ PhotoInstance *instancePtr));
+static int ImgStringWrite _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_DString *dataPtr, char *formatString,
+ Tk_PhotoImageBlock *blockPtr));
+static char * ImgGetPhoto _ANSI_ARGS_((PhotoMaster *masterPtr,
+ Tk_PhotoImageBlock *blockPtr,
+ struct SubcommandOptions *optPtr));
+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,
+ char *formatString,
+ Tk_PhotoImageFormat **imageFormatPtr,
+ int *widthPtr, int *heightPtr));
+static int MatchStringFormat _ANSI_ARGS_((Tcl_Interp *interp,
+ Tcl_Obj *dataObj, char *formatString,
+ Tk_PhotoImageFormat **imageFormatPtr,
+ int *widthPtr, int *heightPtr));
+static void Dither _ANSI_ARGS_((PhotoMaster *masterPtr,
+ int x, int y, int width, int height));
+static void DitherInstance _ANSI_ARGS_((PhotoInstance *instancePtr,
+ int x, int y, int width, int height));
+
+#undef MIN
+#define MIN(a, b) ((a) < (b)? (a): (b))
+#undef MAX
+#define MAX(a, b) ((a) > (b)? (a): (b))
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreatePhotoImageFormat --
+ *
+ * This procedure is invoked by an image file handler to register
+ * a new photo image format and the procedures that handle the
+ * new format. The procedure is typically invoked during
+ * Tcl_AppInit.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The new image file format is entered into a table used in the
+ * photo image "read" and "write" subcommands.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_CreatePhotoImageFormat(formatPtr)
+ 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 --
+ *
+ * This procedure is called by the Tk image code to create
+ * a new photo image.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The data structure for a new photo image is allocated and
+ * initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgPhotoCreate(interp, name, argc, objv, typePtr, master, clientDataPtr)
+ Tcl_Interp *interp; /* Interpreter for application containing
+ * image. */
+ char *name; /* Name to use for image. */
+ int argc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects for options (doesn't
+ * include image name or type). */
+ Tk_ImageType *typePtr; /* Pointer to our type record (not used). */
+ Tk_ImageMaster master; /* Token for image, to be used by us in
+ * later callbacks. */
+ ClientData *clientDataPtr; /* Store manager's token for image here;
+ * it will be returned in later callbacks. */
+{
+ PhotoMaster *masterPtr;
+
+ /*
+ * Allocate and initialize the photo image master record.
+ */
+
+ masterPtr = (PhotoMaster *) ckalloc(sizeof(PhotoMaster));
+ memset((void *) masterPtr, 0, sizeof(PhotoMaster));
+ masterPtr->tkMaster = master;
+ masterPtr->interp = interp;
+ masterPtr->imageCmd = Tcl_CreateObjCommand(interp, name, ImgPhotoCmd,
+ (ClientData) masterPtr, ImgPhotoCmdDeletedProc);
+ masterPtr->palette = NULL;
+ masterPtr->pix24 = NULL;
+ masterPtr->instancePtr = NULL;
+ masterPtr->validRegion = TkCreateRegion();
+
+ /*
+ * Process configuration options given in the image create command.
+ */
+
+ if (ImgPhotoConfigureMaster(interp, masterPtr, argc, objv, 0) != TCL_OK) {
+ ImgPhotoDelete((ClientData) masterPtr);
+ return TCL_ERROR;
+ }
+
+ *clientDataPtr = (ClientData) masterPtr;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoCmd --
+ *
+ * This procedure is invoked to process the Tcl command that
+ * corresponds to a photo image. See the user documentation
+ * for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgPhotoCmd(clientData, interp, argc, objv)
+ ClientData clientData; /* Information about photo master. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument objects. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) clientData;
+ int c, result, index;
+ int x, y, width, height;
+ int dataWidth, dataHeight;
+ 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;
+ static char **argv = NULL;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (argv) {
+ ckfree((char *) argv);
+ }
+ argv = (char **) ckalloc((argc+1) * sizeof(char *));
+ argv[argc] = NULL;
+ for (index = 0; index < argc; index++) {
+ argv[index] = Tcl_GetStringFromObj(objv[index], (int *) NULL);
+ }
+ c = argv[1][0];
+ length = strlen(argv[1]);
+
+ if ((c == 'b') && (strncmp(argv[1], "blank", length) == 0)) {
+ /*
+ * photo blank command - just call Tk_PhotoBlank.
+ */
+
+ if (argc == 2) {
+ Tk_PhotoBlank(masterPtr);
+ } else {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " blank\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if ((c == 'c') && (length >= 2)
+ && (strncmp(argv[1], "cget", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " cget option\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (strncmp(argv[2],"-data", length) == 0) {
+ if (masterPtr->dataObj) {
+ Tcl_SetObjResult(interp, masterPtr->dataObj);
+ }
+ return TCL_OK;
+ }
+ Tk_ConfigureValue(interp, Tk_MainWindow(interp), configSpecs,
+ (char *) masterPtr, argv[2], 0);
+ } else if ((c == 'c') && (length >= 3)
+ && (strncmp(argv[1], "configure", length) == 0)) {
+ /*
+ * photo configure command - handle this in the standard way.
+ */
+ char *opt, *arg;
+
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, (char *) NULL, 0);
+ if (result != TCL_OK) {
+ return result;
+ }
+ opt = Tcl_GetStringFromObj(Tcl_GetObjResult(interp), &length);
+ arg = (char *) ckalloc(length + 1);
+ strcpy(arg, opt);
+ Tcl_ResetResult(interp);
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "{-data {} {} {} {}} ", arg, (char*) NULL);
+ ckfree(arg);
+ return TCL_OK;
+ }
+ if (argc == 3) {
+ if (strncmp(argv[2], "-data", length)) {
+ return Tk_ConfigureInfo(interp, Tk_MainWindow(interp),
+ configSpecs, (char *) masterPtr, argv[2], 0);
+ } else {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "-data {} {} {} ", (char *) NULL);
+ if (masterPtr->dataObj) {
+ Tcl_ListObjAppendElement(interp, Tcl_GetObjResult(interp),
+ masterPtr->dataObj);
+ } else {
+ Tcl_AppendStringsToObj(Tcl_GetObjResult(interp),
+ "{}", (char *) NULL);
+ }
+ return TCL_OK;
+ }
+ }
+ return ImgPhotoConfigureMaster(interp, masterPtr, argc-2, objv+2,
+ TK_CONFIG_ARGV_ONLY);
+ } else if ((c == 'c') && (length >= 3)
+ && (strncmp(argv[1], "copy", length) == 0)) {
+ /*
+ * photo copy command - first parse options.
+ */
+
+ index = 2;
+ memset((VOID *) &options, 0, sizeof(options));
+ options.zoomX = options.zoomY = 1;
+ options.subsampleX = options.subsampleY = 1;
+ options.name = NULL;
+ if (ParseSubcommandOptions(&options, interp,
+ OPT_FROM | OPT_TO | OPT_ZOOM | OPT_SUBSAMPLE | OPT_SHRINK,
+ &index, argc, argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (options.name == NULL || index < argc) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " copy source-image ?-from x1 y1 x2 y2?",
+ " ?-to x1 y1 x2 y2? ?-zoom x y? ?-subsample x y?",
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Look for the source image and get a pointer to its image data.
+ * Check the values given for the -from option.
+ */
+
+ if ((srcHandle = Tk_FindPhoto(interp, options.name)) == NULL) {
+ Tcl_AppendResult(interp, "image \"", argv[2], "\" doesn't",
+ " exist or is not a photo image", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tk_PhotoGetImage(srcHandle, &block);
+ if ((options.fromX2 > block.width) || (options.fromY2 > block.height)
+ || (options.fromX2 > block.width)
+ || (options.fromY2 > block.height)) {
+ Tcl_AppendResult(interp, "coordinates for -from option extend ",
+ "outside source image", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Fill in default values for unspecified parameters.
+ */
+
+ if (((options.options & OPT_FROM) == 0) || (options.fromX2 < 0)) {
+ options.fromX2 = block.width;
+ options.fromY2 = block.height;
+ }
+ if (((options.options & OPT_TO) == 0) || (options.toX2 < 0)) {
+ width = options.fromX2 - options.fromX;
+ if (options.subsampleX > 0) {
+ width = (width + options.subsampleX - 1) / options.subsampleX;
+ } else if (options.subsampleX == 0) {
+ width = 0;
+ } else {
+ width = (width - options.subsampleX - 1) / -options.subsampleX;
+ }
+ options.toX2 = options.toX + width * options.zoomX;
+
+ height = options.fromY2 - options.fromY;
+ if (options.subsampleY > 0) {
+ height = (height + options.subsampleY - 1)
+ / options.subsampleY;
+ } else if (options.subsampleY == 0) {
+ height = 0;
+ } else {
+ height = (height - options.subsampleY - 1)
+ / -options.subsampleY;
+ }
+ options.toY2 = options.toY + height * options.zoomY;
+ }
+
+ /*
+ * Set the destination image size if the -shrink option was specified.
+ */
+
+ if (options.options & OPT_SHRINK) {
+ ImgPhotoSetSize(masterPtr, options.toX2, options.toY2);
+ }
+
+ /*
+ * Copy the image data over using Tk_PhotoPutZoomedBlock.
+ */
+
+ block.pixelPtr += options.fromX * block.pixelSize
+ + options.fromY * block.pitch;
+ block.width = options.fromX2 - options.fromX;
+ block.height = options.fromY2 - options.fromY;
+ Tk_PhotoPutZoomedBlock((Tk_PhotoHandle) masterPtr, &block,
+ options.toX, options.toY, options.toX2 - options.toX,
+ options.toY2 - options.toY, options.zoomX, options.zoomY,
+ options.subsampleX, options.subsampleY);
+
+ } else if ((c == 'd') && (strncmp(argv[1], "data", length) == 0)) {
+ Tcl_DString buffer;
+ char *data;
+
+ /*
+ * photo data command - first parse and check any options given.
+ */
+ Tk_ImageStringWriteProc *stringWriteProc = NULL;
+
+ index = 2;
+ memset((VOID *) &options, 0, sizeof(options));
+ options.name = NULL;
+ options.format = NULL;
+ options.fromX = 0;
+ options.fromY = 0;
+ if (ParseSubcommandOptions(&options, interp,
+ OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND,
+ &index, argc, argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name != NULL) || (index < argc)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " data ?-format format-name?",
+ "?-from x1 y1 x2 y2?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((options.fromX > masterPtr->width)
+ || (options.fromY > masterPtr->height)
+ || (options.fromX2 > masterPtr->width)
+ || (options.fromY2 > masterPtr->height)) {
+ Tcl_AppendResult(interp, "coordinates for -from option extend ",
+ "outside image", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Fill in default values for unspecified parameters.
+ */
+
+ if (((options.options & OPT_FROM) == 0) || (options.fromX2 < 0)) {
+ options.fromX2 = masterPtr->width;
+ options.fromY2 = masterPtr->height;
+ }
+
+ /*
+ * Search for an appropriate image string format handler.
+ */
+
+ if (options.options & OPT_FORMAT) {
+ for (imageFormat = formatList; imageFormat != NULL;
+ imageFormat = imageFormat->nextPtr) {
+ if ((strncasecmp(options.format, imageFormat->name,
+ strlen(imageFormat->name)) == 0)) {
+ if (imageFormat->stringWriteProc != NULL) {
+ stringWriteProc = imageFormat->stringWriteProc;
+ break;
+ }
+ }
+ }
+ if (stringWriteProc == NULL) {
+ Tcl_AppendResult(interp, "image string format \"", options.format,
+ "\" is not supported", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ stringWriteProc = ImgStringWrite;
+ }
+
+ /*
+ * Call the handler's string write procedure to write out
+ * the image.
+ */
+
+ data = ImgGetPhoto(masterPtr, &block, &options);
+ Tcl_DStringInit(&buffer);
+
+ result = stringWriteProc(interp, &buffer,
+ options.format, &block);
+ if (options.background) {
+ Tk_FreeColor(options.background);
+ }
+ if (data) {
+ ckfree(data);
+ }
+ if (result == TCL_OK) {
+ Tcl_DStringResult(interp, &buffer);
+ } else {
+ Tcl_DStringFree(&buffer);
+ }
+ return result;
+ } 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)
+ || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ if ((x < 0) || (x >= masterPtr->width)
+ || (y < 0) || (y >= masterPtr->height)) {
+ Tcl_AppendResult(interp, argv[0], " get: ",
+ "coordinates out of range", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Extract the value of the desired pixel and format it as a string.
+ */
+
+ pixelPtr = masterPtr->pix24 + (y * masterPtr->width + x) * 4;
+ sprintf(string, "%d %d %d", pixelPtr[0], pixelPtr[1],
+ pixelPtr[2]);
+ Tcl_AppendResult(interp, string, (char *) NULL);
+ } else if ((c == 'p') && (strncmp(argv[1], "put", length) == 0)) {
+ /*
+ * photo put command - first parse the options and colors specified.
+ */
+
+ index = 2;
+ memset((VOID *) &options, 0, sizeof(options));
+ options.name = NULL;
+ if (ParseSubcommandOptions(&options, interp, OPT_TO|OPT_FORMAT,
+ &index, argc, argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name == NULL) || (index < argc)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " put data ?-format format? ?-to x1 y1 x2 y2?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (MatchStringFormat(interp, options.name ? objv[2]:NULL,
+ options.format, &imageFormat, &imageWidth,
+ &imageHeight) == TCL_OK) {
+ if (((options.options & OPT_TO) == 0) || (options.toX2 < 0)) {
+ options.toX2 = options.toX + imageWidth;
+ options.toY2 = options.toY + imageHeight;
+ }
+ if (imageWidth > options.toX2 - options.toX) {
+ imageWidth = options.toX2 - options.toX;
+ }
+ if (imageHeight > options.toY2 - options.toY) {
+ imageHeight = options.toY2 - options.toY;
+ }
+ if ((*imageFormat->stringReadProc)(interp, objv[2],
+ options.format, (Tk_PhotoHandle) masterPtr,
+ 0, 0, imageWidth, imageHeight, options.toX, options.toY)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ masterPtr->flags |= IMAGE_CHANGED;
+ return TCL_OK;
+ }
+ if (options.options & OPT_FORMAT) {
+ return TCL_ERROR;
+ }
+ Tcl_ResetResult(interp);
+ if (Tcl_SplitList(interp, options.name, &dataHeight, &srcArgv)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ tkwin = Tk_MainWindow(interp);
+ block.pixelPtr = NULL;
+ dataWidth = 0;
+ pixelPtr = NULL;
+ for (y = 0; y < dataHeight; ++y) {
+ if (Tcl_SplitList(interp, srcArgv[y], &listArgc, &listArgv)
+ != TCL_OK) {
+ break;
+ }
+ if (y == 0) {
+ dataWidth = listArgc;
+ pixelPtr = (unsigned char *) ckalloc((unsigned)
+ dataWidth * dataHeight * 3);
+ block.pixelPtr = pixelPtr;
+ } else {
+ if (listArgc != dataWidth) {
+ Tcl_AppendResult(interp, "all elements of color list must",
+ " have the same number of elements",
+ (char *) NULL);
+ ckfree((char *) listArgv);
+ break;
+ }
+ }
+ for (x = 0; x < dataWidth; ++x) {
+ if (!XParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin),
+ listArgv[x], &color)) {
+ Tcl_AppendResult(interp, "can't parse color \"",
+ listArgv[x], "\"", (char *) NULL);
+ break;
+ }
+ *pixelPtr++ = color.red >> 8;
+ *pixelPtr++ = color.green >> 8;
+ *pixelPtr++ = color.blue >> 8;
+ }
+ ckfree((char *) listArgv);
+ if (x < dataWidth)
+ break;
+ }
+ ckfree((char *) srcArgv);
+ if (y < dataHeight || dataHeight == 0 || dataWidth == 0) {
+ if (block.pixelPtr != NULL) {
+ ckfree((char *) block.pixelPtr);
+ }
+ if (y < dataHeight) {
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+ }
+
+ /*
+ * Fill in default values for the -to option, then
+ * copy the block in using Tk_PhotoPutBlock.
+ */
+
+ if (((options.options & OPT_TO) == 0) || (options.toX2 < 0)) {
+ options.toX2 = options.toX + dataWidth;
+ options.toY2 = options.toY + dataHeight;
+ }
+ block.width = dataWidth;
+ block.height = dataHeight;
+ block.pitch = dataWidth * 3;
+ block.pixelSize = 3;
+ block.offset[0] = 0;
+ block.offset[1] = 1;
+ block.offset[2] = 2;
+ Tk_PhotoPutBlock((ClientData)masterPtr, &block,
+ options.toX, options.toY, options.toX2 - options.toX,
+ options.toY2 - options.toY);
+ ckfree((char *) block.pixelPtr);
+ } else if ((c == 'r') && (length >= 3)
+ && (strncmp(argv[1], "read", length) == 0)) {
+ /*
+ * photo read command - first parse the options specified.
+ */
+
+ index = 2;
+ memset((VOID *) &options, 0, sizeof(options));
+ options.name = NULL;
+ options.format = NULL;
+ if (ParseSubcommandOptions(&options, interp,
+ OPT_FORMAT | OPT_FROM | OPT_TO | OPT_SHRINK,
+ &index, argc, argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name == NULL) || (index < argc)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " read fileName ?-format format-name?",
+ " ?-from x1 y1 x2 y2? ?-to x y? ?-shrink?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Prevent file system access in safe interpreters.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't get image from a file in a",
+ " safe interpreter", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Open the image file and look for a handler for it.
+ */
+
+ chan = Tcl_OpenFileChannel(interp, options.name, "r", 0);
+ if (chan == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tcl_SetChannelOption(interp, chan, "-translation", "binary")
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (MatchFileFormat(interp, chan, options.name, options.format,
+ &imageFormat, &imageWidth, &imageHeight) != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Check the values given for the -from option.
+ */
+
+ if ((options.fromX > imageWidth) || (options.fromY > imageHeight)
+ || (options.fromX2 > imageWidth)
+ || (options.fromY2 > imageHeight)) {
+ Tcl_AppendResult(interp, "coordinates for -from option extend ",
+ "outside source image", (char *) NULL);
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+ if (((options.options & OPT_FROM) == 0) || (options.fromX2 < 0)) {
+ width = imageWidth - options.fromX;
+ height = imageHeight - options.fromY;
+ } else {
+ width = options.fromX2 - options.fromX;
+ height = options.fromY2 - options.fromY;
+ }
+
+ /*
+ * If the -shrink option was specified, set the size of the image.
+ */
+
+ if (options.options & OPT_SHRINK) {
+ ImgPhotoSetSize(masterPtr, options.toX + width,
+ options.toY + height);
+ }
+
+ /*
+ * Call the handler's file read procedure to read the data
+ * into the image.
+ */
+
+ result = (*imageFormat->fileReadProc)(interp, chan, options.name,
+ options.format, (Tk_PhotoHandle) masterPtr, options.toX,
+ options.toY, width, height, options.fromX, options.fromY);
+ if (chan != NULL) {
+ Tcl_Close(NULL, chan);
+ }
+ return result;
+ } else if ((c == 'r') && (length >= 3)
+ && (strncmp(argv[1], "redither", length) == 0)) {
+
+ if (argc == 2) {
+ /*
+ * Call Dither if any part of the image is not correctly
+ * dithered at present.
+ */
+
+ x = masterPtr->ditherX;
+ y = masterPtr->ditherY;
+ if (masterPtr->ditherX != 0) {
+ Dither(masterPtr, x, y, masterPtr->width - x, 1);
+ }
+ if (masterPtr->ditherY < masterPtr->height) {
+ x = 0;
+ Dither(masterPtr, 0, masterPtr->ditherY, masterPtr->width,
+ masterPtr->height - masterPtr->ditherY);
+ }
+
+ if (y < masterPtr->height) {
+ /*
+ * Tell the core image code that part of the image has changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, x, y,
+ (masterPtr->width - x), (masterPtr->height - y),
+ masterPtr->width, masterPtr->height);
+ }
+
+ } else {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " redither\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if ((c == 'w') && (strncmp(argv[1], "write", length) == 0)) {
+ char *data;
+ /*
+ * Prevent file system access in safe interpreters.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't write image to a file in a",
+ " safe interpreter", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * photo write command - first parse and check any options given.
+ */
+
+ index = 2;
+ memset((VOID *) &options, 0, sizeof(options));
+ options.name = NULL;
+ options.format = NULL;
+ if (ParseSubcommandOptions(&options, interp,
+ OPT_FORMAT | OPT_FROM | OPT_GRAYSCALE | OPT_BACKGROUND,
+ &index, argc, argv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if ((options.name == NULL) || (index < argc)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " write fileName ?-format format-name?",
+ "?-from x1 y1 x2 y2?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((options.fromX > masterPtr->width)
+ || (options.fromY > masterPtr->height)
+ || (options.fromX2 > masterPtr->width)
+ || (options.fromY2 > masterPtr->height)) {
+ Tcl_AppendResult(interp, "coordinates for -from option extend ",
+ "outside image", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Fill in default values for unspecified parameters.
+ */
+
+ if (((options.options & OPT_FROM) == 0) || (options.fromX2 < 0)) {
+ options.fromX2 = masterPtr->width;
+ options.fromY2 = masterPtr->height;
+ }
+
+ /*
+ * 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;
+ }
+ }
+ }
+ if (imageFormat == NULL) {
+ if (options.format == NULL) {
+ Tcl_AppendResult(interp, "no available image file format ",
+ "has file writing capability", (char *) NULL);
+ } else if (!matched) {
+ Tcl_AppendResult(interp, "image file format \"",
+ options.format, "\" is unknown", (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "image file format \"",
+ options.format, "\" has no file writing capability",
+ (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * Call the handler's file write procedure to write out
+ * the image.
+ */
+
+ data = ImgGetPhoto(masterPtr, &block, &options);
+ result = (*imageFormat->fileWriteProc)(interp, options.name,
+ options.format, &block);
+ if (options.background) {
+ Tk_FreeColor(options.background);
+ }
+ if (data) {
+ ckfree(data);
+ }
+ return result;
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be blank, cget, configure, copy, get, put,",
+ " read, redither, or write", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ParseSubcommandOptions --
+ *
+ * This procedure is invoked to process one of the options
+ * which may be specified for the photo image subcommands,
+ * namely, -from, -to, -zoom, -subsample, -format, and -shrink.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Fields in *optPtr get filled in.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParseSubcommandOptions(optPtr, interp, allowedOptions, optIndexPtr, argc, argv)
+ struct SubcommandOptions *optPtr;
+ /* Information about the options specified
+ * and the values given is returned here. */
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ int allowedOptions; /* Indicates which options are valid for
+ * the current command. */
+ int *optIndexPtr; /* Points to a variable containing the
+ * current index in argv; this variable is
+ * updated by this procedure. */
+ int argc; /* Number of arguments in argv[]. */
+ char **argv; /* Arguments to be parsed. */
+{
+ int index, c, bit, currentBit;
+ size_t length;
+ char *option, **listPtr;
+ int values[4];
+ int numValues, maxValues, argIndex;
+
+ for (index = *optIndexPtr; index < argc; *optIndexPtr = ++index) {
+ /*
+ * We can have one value specified without an option;
+ * it goes into optPtr->name.
+ */
+
+ option = argv[index];
+ if (option[0] != '-') {
+ if (optPtr->name == NULL) {
+ optPtr->name = option;
+ continue;
+ }
+ break;
+ }
+
+ /*
+ * Work out which option this is.
+ */
+
+ length = strlen(option);
+ c = option[0];
+ bit = 0;
+ currentBit = 1;
+ for (listPtr = optionNames; *listPtr != NULL; ++listPtr) {
+ if ((c == *listPtr[0])
+ && (strncmp(option, *listPtr, length) == 0)) {
+ if (bit != 0) {
+ bit = 0; /* An ambiguous option. */
+ break;
+ }
+ bit = currentBit;
+ }
+ currentBit <<= 1;
+ }
+
+ /*
+ * If this option is not recognized and allowed, put
+ * an error message in the interpreter and return.
+ */
+
+ if ((allowedOptions & bit) == 0) {
+ Tcl_AppendResult(interp, "unrecognized option \"", argv[index],
+ "\": must be ", (char *)NULL);
+ bit = 1;
+ for (listPtr = optionNames; *listPtr != NULL; ++listPtr) {
+ if ((allowedOptions & bit) != 0) {
+ if ((allowedOptions & (bit - 1)) != 0) {
+ Tcl_AppendResult(interp, ", ", (char *) NULL);
+ if ((allowedOptions & ~((bit << 1) - 1)) == 0) {
+ Tcl_AppendResult(interp, "or ", (char *) NULL);
+ }
+ }
+ Tcl_AppendResult(interp, *listPtr, (char *) NULL);
+ }
+ bit <<= 1;
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * For the -from, -to, -zoom and -subsample options,
+ * parse the values given. Report an error if too few
+ * or too many values are given.
+ */
+
+ if (bit == OPT_BACKGROUND) {
+ /*
+ * The -background option takes a single XColor value.
+ */
+
+ if (index + 1 < argc) {
+ *optIndexPtr = ++index;
+ optPtr->background = Tk_GetColor(interp, Tk_MainWindow(interp),
+ Tk_GetUid(argv[index]));
+ if (!optPtr->background) {
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "the \"-background\" option ",
+ "requires a value", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if (bit == OPT_FORMAT) {
+ /*
+ * The -format option takes a single string value.
+ */
+
+ if (index + 1 < argc) {
+ *optIndexPtr = ++index;
+ optPtr->format = argv[index];
+ } else {
+ Tcl_AppendResult(interp, "the \"-format\" option ",
+ "requires a value", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if ((bit != OPT_SHRINK) && (bit != OPT_GRAYSCALE)) {
+ maxValues = ((bit == OPT_FROM) || (bit == OPT_TO))? 4: 2;
+ argIndex = index + 1;
+ for (numValues = 0; numValues < maxValues; ++numValues) {
+ if ((argIndex < argc) && (isdigit(UCHAR(argv[argIndex][0]))
+ || ((argv[argIndex][0] == '-')
+ && (isdigit(UCHAR(argv[argIndex][1])))))) {
+ if (Tcl_GetInt(interp, argv[argIndex], &values[numValues])
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ break;
+ }
+ ++argIndex;
+ }
+
+ if (numValues == 0) {
+ Tcl_AppendResult(interp, "the \"", argv[index], "\" option ",
+ "requires one ", maxValues == 2? "or two": "to four",
+ " integer values", (char *) NULL);
+ return TCL_ERROR;
+ }
+ *optIndexPtr = (index += numValues);
+
+ /*
+ * Y values default to the corresponding X value if not specified.
+ */
+
+ if (numValues == 1) {
+ values[1] = values[0];
+ }
+ if (numValues == 3) {
+ values[3] = values[2];
+ }
+
+ /*
+ * Check the values given and put them in the appropriate
+ * field of the SubcommandOptions structure.
+ */
+
+ switch (bit) {
+ case OPT_FROM:
+ if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2)
+ && ((values[2] < 0) || (values[3] < 0)))) {
+ Tcl_AppendResult(interp, "value(s) for the -from",
+ " option must be non-negative", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (numValues <= 2) {
+ optPtr->fromX = values[0];
+ optPtr->fromY = values[1];
+ optPtr->fromX2 = -1;
+ optPtr->fromY2 = -1;
+ } else {
+ optPtr->fromX = MIN(values[0], values[2]);
+ optPtr->fromY = MIN(values[1], values[3]);
+ optPtr->fromX2 = MAX(values[0], values[2]);
+ optPtr->fromY2 = MAX(values[1], values[3]);
+ }
+ break;
+ case OPT_SUBSAMPLE:
+ optPtr->subsampleX = values[0];
+ optPtr->subsampleY = values[1];
+ break;
+ case OPT_TO:
+ if ((values[0] < 0) || (values[1] < 0) || ((numValues > 2)
+ && ((values[2] < 0) || (values[3] < 0)))) {
+ Tcl_AppendResult(interp, "value(s) for the -to",
+ " option must be non-negative", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (numValues <= 2) {
+ optPtr->toX = values[0];
+ optPtr->toY = values[1];
+ optPtr->toX2 = -1;
+ optPtr->toY2 = -1;
+ } else {
+ optPtr->toX = MIN(values[0], values[2]);
+ optPtr->toY = MIN(values[1], values[3]);
+ optPtr->toX2 = MAX(values[0], values[2]);
+ optPtr->toY2 = MAX(values[1], values[3]);
+ }
+ break;
+ case OPT_ZOOM:
+ if ((values[0] <= 0) || (values[1] <= 0)) {
+ Tcl_AppendResult(interp, "value(s) for the -zoom",
+ " option must be positive", (char *) NULL);
+ return TCL_ERROR;
+ }
+ optPtr->zoomX = values[0];
+ optPtr->zoomY = values[1];
+ break;
+ }
+ }
+
+ /*
+ * Remember that we saw this option.
+ */
+
+ optPtr->options |= bit;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoConfigureMaster --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgPhotoConfigureMaster(interp, masterPtr, argc, objv, flags)
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ PhotoMaster *masterPtr; /* Pointer to data structure describing
+ * overall photo image to (re)configure. */
+ int argc; /* Number of entries in argv. */
+ Tcl_Obj *CONST objv[]; /* Pairs of configuration options for image. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget,
+ * such as TK_CONFIG_ARGV_ONLY. */
+{
+ PhotoInstance *instancePtr;
+ char *oldFileString, *oldPaletteString, *oldFormat;
+ Tcl_Obj *oldDataObj, *dataObj = NULL;
+ int length, i, j;
+ double oldGamma;
+ int result;
+ Tcl_Channel chan;
+ Tk_PhotoImageFormat *imageFormat;
+ int imageWidth, imageHeight;
+ static char **argv = NULL;
+
+ if (argv) ckfree((char *) argv);
+ argv = (char **) ckalloc((argc + 1) * sizeof(char *));
+ for (i = 0, j = 0; i < argc; i++,j++) {
+ argv[j] = Tcl_GetStringFromObj(objv[i], &length);
+ if (argv[j][0] == '-' && argv[j][1] == 'd' &&
+ strncmp(argv[j],"-data", length) == 0) {
+ if (i < argc) {
+ dataObj = objv[++i];
+ j--;
+ }
+ }
+ }
+ /*
+ * Save the current values for fileString and dataString, so we
+ * can tell if the user specifies them anew.
+ * IMPORTANT: if the format changes we have to interpret
+ * "-file" and "-data" again as well!!!!!!! It might be
+ * that the format string influences how "-data" or "-file"
+ * is interpreted.
+ */
+
+ oldFileString = masterPtr->fileString;
+ oldDataObj = (oldFileString == NULL) ? masterPtr->dataObj: NULL;
+ oldFormat = masterPtr->format;
+ oldPaletteString = masterPtr->palette;
+ oldGamma = masterPtr->gamma;
+
+ /*
+ * Process the configuration options specified.
+ */
+
+ if (Tk_ConfigureWidget(interp, Tk_MainWindow(interp), configSpecs,
+ j, argv, (char *) masterPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Regard the empty string for -file, -data or -format as the null
+ * value.
+ */
+
+ if ((masterPtr->fileString != NULL) && (masterPtr->fileString[0] == 0)) {
+ ckfree(masterPtr->fileString);
+ masterPtr->fileString = NULL;
+ }
+ if (dataObj) {
+ if (dataObj->length) {
+ Tcl_IncrRefCount(dataObj);
+ } else {
+ dataObj = NULL;
+ }
+ if (masterPtr->dataObj) {
+ Tcl_DecrRefCount(masterPtr->dataObj);
+ }
+ masterPtr->dataObj = dataObj;
+ }
+ if ((masterPtr->format != NULL) && (masterPtr->format[0] == 0)) {
+ ckfree(masterPtr->format);
+ masterPtr->format = NULL;
+ }
+
+ /*
+ * Set the image to the user-requested size, if any,
+ * and make sure storage is correctly allocated for this image.
+ */
+
+ ImgPhotoSetSize(masterPtr, masterPtr->width, masterPtr->height);
+
+ /*
+ * Read in the image from the file or string if the user has
+ * specified the -file or -data option.
+ */
+
+ if ((masterPtr->fileString != NULL)
+ && ((masterPtr->fileString != oldFileString)
+ || (masterPtr->format != oldFormat))) {
+
+ /*
+ * Prevent file system access in a safe interpreter.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't get image from a file in a",
+ " safe interpreter", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ chan = Tcl_OpenFileChannel(interp, masterPtr->fileString, "r", 0);
+ if (chan == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tcl_SetChannelOption(interp, chan, "-translation", "binary")
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (MatchFileFormat(interp, chan, masterPtr->fileString,
+ masterPtr->format, &imageFormat, &imageWidth,
+ &imageHeight) != TCL_OK) {
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+ ImgPhotoSetSize(masterPtr, imageWidth, imageHeight);
+ result = (*imageFormat->fileReadProc)(interp, chan,
+ masterPtr->fileString, masterPtr->format,
+ (Tk_PhotoHandle) masterPtr, 0, 0,
+ imageWidth, imageHeight, 0, 0);
+ Tcl_Close(NULL, chan);
+ if (result != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ masterPtr->flags |= IMAGE_CHANGED;
+ }
+
+ if ((masterPtr->fileString == NULL) && (masterPtr->dataObj != NULL)
+ && ((masterPtr->dataObj != oldDataObj)
+ || (masterPtr->format != oldFormat))) {
+
+ if (MatchStringFormat(interp, masterPtr->dataObj,
+ masterPtr->format, &imageFormat, &imageWidth,
+ &imageHeight) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ImgPhotoSetSize(masterPtr, imageWidth, imageHeight);
+ if ((*imageFormat->stringReadProc)(interp, masterPtr->dataObj,
+ masterPtr->format, (Tk_PhotoHandle) masterPtr,
+ 0, 0, imageWidth, imageHeight, 0, 0) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ masterPtr->flags |= IMAGE_CHANGED;
+ }
+
+ /*
+ * Enforce a reasonable value for gamma.
+ */
+
+ if (masterPtr->gamma <= 0) {
+ masterPtr->gamma = 1.0;
+ }
+
+ if ((masterPtr->gamma != oldGamma)
+ || (masterPtr->palette != oldPaletteString)) {
+ masterPtr->flags |= IMAGE_CHANGED;
+ }
+
+ /*
+ * Cycle through all of the instances of this image, regenerating
+ * the information for each instance. Then force the image to be
+ * redisplayed everywhere that it is used.
+ */
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ ImgPhotoConfigureInstance(instancePtr);
+ }
+
+ /*
+ * Inform the generic image code that the image
+ * has (potentially) changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width,
+ masterPtr->height, masterPtr->width, masterPtr->height);
+ masterPtr->flags &= ~IMAGE_CHANGED;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoConfigureInstance --
+ *
+ * This procedure is called to create displaying information for
+ * a photo image instance based on the configuration information
+ * in the master. It is invoked both when new instances are
+ * created and when the master is reconfigured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates errors via Tcl_BackgroundError if there are problems
+ * in setting up the instance.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoConfigureInstance(instancePtr)
+ PhotoInstance *instancePtr; /* Instance to reconfigure. */
+{
+ PhotoMaster *masterPtr = instancePtr->masterPtr;
+ XImage *imagePtr;
+ int bitsPerPixel;
+ ColorTable *colorTablePtr;
+ XRectangle validBox;
+
+ /*
+ * If the -palette configuration option has been set for the master,
+ * use the value specified for our palette, but only if it is
+ * a valid palette for our windows. Use the gamma value specified
+ * the master.
+ */
+
+ if ((masterPtr->palette && masterPtr->palette[0])
+ && IsValidPalette(instancePtr, masterPtr->palette)) {
+ instancePtr->palette = masterPtr->palette;
+ } else {
+ instancePtr->palette = instancePtr->defaultPalette;
+ }
+ instancePtr->gamma = masterPtr->gamma;
+
+ /*
+ * If we don't currently have a color table, or if the one we
+ * have no longer applies (e.g. because our palette or gamma
+ * has changed), get a new one.
+ */
+
+ colorTablePtr = instancePtr->colorTablePtr;
+ if ((colorTablePtr == NULL)
+ || (instancePtr->colormap != colorTablePtr->id.colormap)
+ || (instancePtr->palette != colorTablePtr->id.palette)
+ || (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.
+ */
+
+ if (instancePtr->colorTablePtr->flags & BLACK_AND_WHITE) {
+ bitsPerPixel = 1;
+ } else {
+ bitsPerPixel = instancePtr->visualInfo.depth;
+ }
+
+ if ((instancePtr->imagePtr == NULL)
+ || (instancePtr->imagePtr->bits_per_pixel != bitsPerPixel)) {
+ if (instancePtr->imagePtr != NULL) {
+ XFree((char *) instancePtr->imagePtr);
+ }
+ imagePtr = XCreateImage(instancePtr->display,
+ instancePtr->visualInfo.visual, (unsigned) bitsPerPixel,
+ (bitsPerPixel > 1? ZPixmap: XYBitmap), 0, (char *) NULL,
+ 1, 1, 32, 0);
+ instancePtr->imagePtr = imagePtr;
+
+ /*
+ * Determine the endianness of this machine.
+ * We create images using the local host's endianness, rather
+ * than the endianness of the server; otherwise we would have
+ * to byte-swap any 16 or 32 bit values that we store in the
+ * image in those situations where the server's endianness
+ * is different from ours.
+ */
+
+ if (imagePtr != NULL) {
+ union {
+ int i;
+ char c[sizeof(int)];
+ } kludge;
+
+ imagePtr->bitmap_unit = sizeof(pixel) * NBBY;
+ kludge.i = 0;
+ kludge.c[0] = 1;
+ imagePtr->byte_order = (kludge.i == 1) ? LSBFirst : MSBFirst;
+ _XInitImageFuncPtrs(imagePtr);
+ }
+ }
+ }
+
+ /*
+ * If the user has specified a width and/or height for the master
+ * which is different from our current width/height, set the size
+ * to the values specified by the user. If we have no pixmap, we
+ * do this also, since it has the side effect of allocating a
+ * pixmap for us.
+ */
+
+ if ((instancePtr->pixels == None) || (instancePtr->error == NULL)
+ || (instancePtr->width != masterPtr->width)
+ || (instancePtr->height != masterPtr->height)) {
+ ImgPhotoInstanceSetSize(instancePtr);
+ }
+
+ /*
+ * Redither this instance if necessary.
+ */
+
+ if ((masterPtr->flags & IMAGE_CHANGED)
+ || (instancePtr->colorTablePtr != colorTablePtr)) {
+ TkClipBox(masterPtr->validRegion, &validBox);
+ if ((validBox.width > 0) && (validBox.height > 0)) {
+ DitherInstance(instancePtr, validBox.x, validBox.y,
+ validBox.width, validBox.height);
+ }
+ }
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoGet --
+ *
+ * This procedure is called for each use of a photo image in a
+ * widget.
+ *
+ * Results:
+ * The return value is a token for the instance, which is passed
+ * back to us in calls to ImgPhotoDisplay and ImgPhotoFree.
+ *
+ * Side effects:
+ * A data structure is set up for the instance (or, an existing
+ * instance is re-used for the new one).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+ImgPhotoGet(tkwin, masterData)
+ Tk_Window tkwin; /* Window in which the instance will be
+ * used. */
+ ClientData masterData; /* Pointer to our master structure for the
+ * image. */
+{
+ 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.
+ */
+
+ static int paletteChoice[13][3] = {
+ /* #red, #green, #blue */
+ {2, 2, 2, /* 3 bits, 8 colors */},
+ {2, 3, 2, /* 4 bits, 12 colors */},
+ {3, 4, 2, /* 5 bits, 24 colors */},
+ {4, 5, 3, /* 6 bits, 60 colors */},
+ {5, 6, 4, /* 7 bits, 120 colors */},
+ {7, 7, 4, /* 8 bits, 198 colors */},
+ {8, 10, 6, /* 9 bits, 480 colors */},
+ {10, 12, 8, /* 10 bits, 960 colors */},
+ {14, 15, 9, /* 11 bits, 1890 colors */},
+ {16, 20, 12, /* 12 bits, 3840 colors */},
+ {20, 24, 16, /* 13 bits, 7680 colors */},
+ {26, 30, 20, /* 14 bits, 15600 colors */},
+ {32, 32, 30, /* 15 bits, 30720 colors */}
+ };
+
+ /*
+ * See if there is already an instance for windows using
+ * the same colormap. If so then just re-use it.
+ */
+
+ colormap = Tk_Colormap(tkwin);
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ if ((colormap == instancePtr->colormap)
+ && (Tk_Display(tkwin) == instancePtr->display)) {
+
+ /*
+ * Re-use this instance.
+ */
+
+ 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;
+ }
+ }
+
+ /*
+ * The image isn't already in use in a window with the same colormap.
+ * Make a new instance of the image.
+ */
+
+ instancePtr = (PhotoInstance *) ckalloc(sizeof(PhotoInstance));
+ instancePtr->masterPtr = masterPtr;
+ instancePtr->display = Tk_Display(tkwin);
+ instancePtr->colormap = Tk_Colormap(tkwin);
+ Tk_PreserveColormap(instancePtr->display, instancePtr->colormap);
+ instancePtr->refCount = 1;
+ instancePtr->colorTablePtr = NULL;
+ instancePtr->pixels = None;
+ instancePtr->error = NULL;
+ instancePtr->width = 0;
+ instancePtr->height = 0;
+ instancePtr->imagePtr = 0;
+ instancePtr->nextPtr = masterPtr->instancePtr;
+ masterPtr->instancePtr = instancePtr;
+
+ /*
+ * Obtain information about the visual and decide on the
+ * default palette.
+ */
+
+ visualInfo.screen = Tk_ScreenNumber(tkwin);
+ visualInfo.visualid = XVisualIDFromVisual(Tk_Visual(tkwin));
+ visInfoPtr = XGetVisualInfo(Tk_Display(tkwin),
+ VisualScreenMask | VisualIDMask, &visualInfo, &numVisuals);
+ nRed = 2;
+ nGreen = nBlue = 0;
+ mono = 1;
+ if (visInfoPtr != NULL) {
+ instancePtr->visualInfo = *visInfoPtr;
+ switch (visInfoPtr->class) {
+ case DirectColor:
+ case TrueColor:
+ nRed = 1 << CountBits(visInfoPtr->red_mask);
+ nGreen = 1 << CountBits(visInfoPtr->green_mask);
+ nBlue = 1 << CountBits(visInfoPtr->blue_mask);
+ mono = 0;
+ break;
+ case PseudoColor:
+ case StaticColor:
+ if (visInfoPtr->depth > 15) {
+ nRed = 32;
+ nGreen = 32;
+ nBlue = 32;
+ mono = 0;
+ } else if (visInfoPtr->depth >= 3) {
+ int *ip = paletteChoice[visInfoPtr->depth - 3];
+
+ nRed = ip[0];
+ nGreen = ip[1];
+ nBlue = ip[2];
+ mono = 0;
+ }
+ break;
+ case GrayScale:
+ case StaticGray:
+ nRed = 1 << visInfoPtr->depth;
+ break;
+ }
+ XFree((char *) visInfoPtr);
+
+ } else {
+ panic("ImgPhotoGet couldn't find visual for window");
+ }
+
+ sprintf(buf, ((mono) ? "%d": "%d/%d/%d"), nRed, nGreen, nBlue);
+ instancePtr->defaultPalette = Tk_GetUid(buf);
+
+ /*
+ * Make a GC with background = black and foreground = white.
+ */
+
+ white = Tk_GetColor(masterPtr->interp, tkwin, "white");
+ black = Tk_GetColor(masterPtr->interp, tkwin, "black");
+ gcValues.foreground = (white != NULL)? white->pixel:
+ WhitePixelOfScreen(Tk_Screen(tkwin));
+ gcValues.background = (black != NULL)? black->pixel:
+ BlackPixelOfScreen(Tk_Screen(tkwin));
+ gcValues.graphics_exposures = False;
+ instancePtr->gc = Tk_GetGCColor(tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures, &gcValues,
+ white, black);
+ /*
+ * Set configuration options and finish the initialization of the instance.
+ */
+
+ ImgPhotoConfigureInstance(instancePtr);
+
+ /*
+ * If this is the first instance, must set the size of the image.
+ */
+
+ if (instancePtr->nextPtr == NULL) {
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0,
+ masterPtr->width, masterPtr->height);
+ }
+
+ /*
+ * Dither the image to fill in this instance's pixmap.
+ */
+
+ TkClipBox(masterPtr->validRegion, &validBox);
+ if ((validBox.width > 0) && (validBox.height > 0)) {
+ DitherInstance(instancePtr, validBox.x, validBox.y, validBox.width,
+ validBox.height);
+ }
+
+ return (ClientData) instancePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoDisplay --
+ *
+ * This procedure is invoked to draw a photo image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A portion of the image gets rendered in a pixmap or window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoDisplay(clientData, display, drawable, imageX, imageY, width,
+ height, drawableX, drawableY)
+ ClientData clientData; /* Pointer to PhotoInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display on which to draw image. */
+ Drawable drawable; /* Pixmap or window in which to draw image. */
+ int imageX, imageY; /* Upper-left corner of region within image
+ * to draw. */
+ int width, height; /* Dimensions of region within image to draw. */
+ int drawableX, drawableY; /* Coordinates within drawable that
+ * correspond to imageX and imageY. */
+{
+ PhotoInstance *instancePtr = (PhotoInstance *) clientData;
+
+ /*
+ * If there's no pixmap, it means that an error occurred
+ * while creating the image instance so it can't be displayed.
+ */
+
+ if (instancePtr->pixels == None) {
+ return;
+ }
+
+ /*
+ * masterPtr->region describes which parts of the image contain
+ * valid data. We set this region as the clip mask for the gc,
+ * setting its origin appropriately, and use it when drawing the
+ * image.
+ */
+
+ TkSetRegion(display, instancePtr->gc, instancePtr->masterPtr->validRegion);
+ XSetClipOrigin(display, instancePtr->gc, drawableX - imageX,
+ drawableY - imageY);
+ XCopyArea(display, instancePtr->pixels, drawable, instancePtr->gc,
+ imageX, imageY, (unsigned) width, (unsigned) height,
+ drawableX, drawableY);
+ XSetClipMask(display, instancePtr->gc, None);
+ XSetClipOrigin(display, instancePtr->gc, 0, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoFree --
+ *
+ * This procedure is called when a widget ceases to use a
+ * particular instance of an image. We don't actually get
+ * rid of the instance until later because we may be about
+ * to get this instance again.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Internal data structures get cleaned up, later.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoFree(clientData, display)
+ ClientData clientData; /* Pointer to PhotoInstance structure for
+ * for instance to be displayed. */
+ Display *display; /* Display containing window that used image. */
+{
+ PhotoInstance *instancePtr = (PhotoInstance *) clientData;
+ ColorTable *colorPtr;
+
+ instancePtr->refCount -= 1;
+ if (instancePtr->refCount > 0) {
+ return;
+ }
+
+ /*
+ * There are no more uses of the image within this widget.
+ * Decrement the count of live uses of its color table, so
+ * that its colors can be reclaimed if necessary, and
+ * set up an idle call to free the instance structure.
+ */
+
+ colorPtr = instancePtr->colorTablePtr;
+ if (colorPtr != NULL) {
+ colorPtr->liveRefCount -= 1;
+ }
+
+ Tcl_DoWhenIdle(DisposeInstance, (ClientData) instancePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoDelete --
+ *
+ * This procedure is called by the image code to delete the
+ * master structure for an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with the image get freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoDelete(masterData)
+ ClientData masterData; /* Pointer to PhotoMaster structure for
+ * image. Must not have any more instances. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) masterData;
+ PhotoInstance *instancePtr;
+
+ while ((instancePtr = masterPtr->instancePtr) != NULL) {
+ if (instancePtr->refCount > 0) {
+ panic("tried to delete photo image when instances still exist");
+ }
+ Tcl_CancelIdleCall(DisposeInstance, (ClientData) instancePtr);
+ DisposeInstance((ClientData) instancePtr);
+ }
+ masterPtr->tkMaster = NULL;
+ if (masterPtr->imageCmd != NULL) {
+ Tcl_DeleteCommandFromToken(masterPtr->interp, masterPtr->imageCmd);
+ }
+ if (masterPtr->pix24 != NULL) {
+ ckfree((char *) masterPtr->pix24);
+ }
+ if (masterPtr->validRegion != NULL) {
+ TkDestroyRegion(masterPtr->validRegion);
+ }
+ if (masterPtr->dataObj != NULL) {
+ Tcl_DecrRefCount(masterPtr->dataObj);
+ }
+ Tk_FreeOptions(configSpecs, (char *) masterPtr, (Display *) NULL, 0);
+ ckfree((char *) masterPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoCmdDeletedProc --
+ *
+ * This procedure is invoked when the image command for an image
+ * is deleted. It deletes the image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to PhotoMaster structure for
+ * image. */
+{
+ PhotoMaster *masterPtr = (PhotoMaster *) clientData;
+
+ masterPtr->imageCmd = NULL;
+ if (masterPtr->tkMaster != NULL) {
+ Tk_DeleteImage(masterPtr->interp, Tk_NameOfImage(masterPtr->tkMaster));
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoSetSize --
+ *
+ * This procedure reallocates the image storage and instance
+ * pixmaps for a photo image, as necessary, to change the
+ * image's size to `width' x `height' pixels.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Storage gets reallocated, for the master and all its instances.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoSetSize(masterPtr, width, height)
+ PhotoMaster *masterPtr;
+ int width, height;
+{
+ unsigned char *newPix24;
+ int h, offset, pitch;
+ unsigned char *srcPtr, *destPtr;
+ XRectangle validBox, clipBox;
+ TkRegion clipRegion;
+ PhotoInstance *instancePtr;
+
+ if (masterPtr->userWidth > 0) {
+ width = masterPtr->userWidth;
+ }
+ if (masterPtr->userHeight > 0) {
+ height = masterPtr->userHeight;
+ }
+
+ /*
+ * We have to trim the valid region if it is currently
+ * larger than the new image size.
+ */
+
+ TkClipBox(masterPtr->validRegion, &validBox);
+ if ((validBox.x + validBox.width > width)
+ || (validBox.y + validBox.height > height)) {
+ clipBox.x = 0;
+ clipBox.y = 0;
+ clipBox.width = width;
+ clipBox.height = height;
+ clipRegion = TkCreateRegion();
+ TkUnionRectWithRegion(&clipBox, clipRegion, clipRegion);
+ TkIntersectRegion(masterPtr->validRegion, clipRegion,
+ masterPtr->validRegion);
+ TkDestroyRegion(clipRegion);
+ TkClipBox(masterPtr->validRegion, &validBox);
+ }
+
+ if ((width != masterPtr->width) || (height != masterPtr->height)
+ || (masterPtr->pix24 == NULL)) {
+
+ /*
+ * Reallocate storage for the 24-bit image and copy
+ * over valid regions.
+ */
+
+ pitch = width * 4;
+ newPix24 = (unsigned char *) ckalloc((unsigned) (height * pitch));
+
+ /*
+ * Zero the new array. The dithering code shouldn't read the
+ * areas outside validBox, but they might be copied to another
+ * photo image or written to a file.
+ */
+
+ if ((masterPtr->pix24 != NULL)
+ && ((width == masterPtr->width) || (width == validBox.width))) {
+ if (validBox.y > 0) {
+ memset((VOID *) newPix24, 0, (size_t) (validBox.y * pitch));
+ }
+ h = validBox.y + validBox.height;
+ if (h < height) {
+ memset((VOID *) (newPix24 + h * pitch), 0,
+ (size_t) ((height - h) * pitch));
+ }
+ } else {
+ memset((VOID *) newPix24, 0, (size_t) (height * pitch));
+ }
+
+ if (masterPtr->pix24 != NULL) {
+
+ /*
+ * Copy the common area over to the new array array and
+ * free the old array.
+ */
+
+ if (width == masterPtr->width) {
+
+ /*
+ * The region to be copied is contiguous.
+ */
+
+ offset = validBox.y * pitch;
+ memcpy((VOID *) (newPix24 + offset),
+ (VOID *) (masterPtr->pix24 + offset),
+ (size_t) (validBox.height * pitch));
+
+ } else if ((validBox.width > 0) && (validBox.height > 0)) {
+
+ /*
+ * Area to be copied is not contiguous - copy line by line.
+ */
+
+ destPtr = newPix24 + (validBox.y * width + validBox.x) * 4;
+ srcPtr = masterPtr->pix24 + (validBox.y * masterPtr->width
+ + validBox.x) * 4;
+ for (h = validBox.height; h > 0; h--) {
+ memcpy((VOID *) destPtr, (VOID *) srcPtr,
+ (size_t) (validBox.width * 4));
+ destPtr += width * 4;
+ srcPtr += masterPtr->width * 4;
+ }
+ }
+
+ ckfree((char *) masterPtr->pix24);
+ }
+
+ masterPtr->pix24 = newPix24;
+ masterPtr->width = width;
+ masterPtr->height = height;
+
+ /*
+ * Dithering will be correct up to the end of the last
+ * pre-existing complete scanline.
+ */
+
+ if ((validBox.x > 0) || (validBox.y > 0)) {
+ masterPtr->ditherX = 0;
+ masterPtr->ditherY = 0;
+ } else if (validBox.width == width) {
+ if ((int) validBox.height < masterPtr->ditherY) {
+ masterPtr->ditherX = 0;
+ masterPtr->ditherY = validBox.height;
+ }
+ } else {
+ if ((masterPtr->ditherY > 0)
+ || ((int) validBox.width < masterPtr->ditherX)) {
+ masterPtr->ditherX = validBox.width;
+ masterPtr->ditherY = 0;
+ }
+ }
+ }
+
+ /*
+ * Now adjust the sizes of the pixmaps for all of the instances.
+ */
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ ImgPhotoInstanceSetSize(instancePtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgPhotoInstanceSetSize --
+ *
+ * This procedure reallocates the instance pixmap and dithering
+ * error array for a photo instance, as necessary, to change the
+ * image's size to `width' x `height' pixels.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Storage gets reallocated, here and in the X server.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImgPhotoInstanceSetSize(instancePtr)
+ PhotoInstance *instancePtr; /* Instance whose size is to be
+ * changed. */
+{
+ PhotoMaster *masterPtr;
+ schar *newError;
+ schar *errSrcPtr, *errDestPtr;
+ int h, offset;
+ XRectangle validBox;
+ Pixmap newPixmap;
+
+ masterPtr = instancePtr->masterPtr;
+ TkClipBox(masterPtr->validRegion, &validBox);
+
+ if ((instancePtr->width != masterPtr->width)
+ || (instancePtr->height != masterPtr->height)
+ || (instancePtr->pixels == None)) {
+ newPixmap = Tk_GetPixmap(instancePtr->display,
+ RootWindow(instancePtr->display,
+ instancePtr->visualInfo.screen),
+ (masterPtr->width > 0) ? masterPtr->width: 1,
+ (masterPtr->height > 0) ? masterPtr->height: 1,
+ instancePtr->visualInfo.depth);
+
+ /*
+ * The following is a gross hack needed to properly support colormaps
+ * under Windows. Before the pixels can be copied to the pixmap,
+ * the relevent colormap must be associated with the drawable.
+ * Normally we can infer this association from the window that
+ * was used to create the pixmap. However, in this case we're
+ * using the root window, so we have to be more explicit.
+ */
+
+ TkSetPixmapColormap(newPixmap, instancePtr->colormap);
+
+ if (instancePtr->pixels != None) {
+ /*
+ * Copy any common pixels from the old pixmap and free it.
+ */
+ XCopyArea(instancePtr->display, instancePtr->pixels, newPixmap,
+ instancePtr->gc, validBox.x, validBox.y,
+ validBox.width, validBox.height, validBox.x, validBox.y);
+ Tk_FreePixmap(instancePtr->display, instancePtr->pixels);
+ }
+ instancePtr->pixels = newPixmap;
+ }
+
+ if ((instancePtr->width != masterPtr->width)
+ || (instancePtr->height != masterPtr->height)
+ || (instancePtr->error == NULL)) {
+
+ newError = (schar *) ckalloc((unsigned)
+ (masterPtr->height * masterPtr->width * 3 * sizeof(schar)));
+
+ /*
+ * Zero the new array so that we don't get bogus error values
+ * propagating into areas we dither later.
+ */
+
+ if ((instancePtr->error != NULL)
+ && ((instancePtr->width == masterPtr->width)
+ || (validBox.width == masterPtr->width))) {
+ if (validBox.y > 0) {
+ memset((VOID *) newError, 0, (size_t)
+ (validBox.y * masterPtr->width * 3 * sizeof(schar)));
+ }
+ h = validBox.y + validBox.height;
+ if (h < masterPtr->height) {
+ memset((VOID *) (newError + h * masterPtr->width * 3), 0,
+ (size_t) ((masterPtr->height - h)
+ * masterPtr->width * 3 * sizeof(schar)));
+ }
+ } else {
+ memset((VOID *) newError, 0, (size_t)
+ (masterPtr->height * masterPtr->width * 3 * sizeof(schar)));
+ }
+
+ if (instancePtr->error != NULL) {
+
+ /*
+ * Copy the common area over to the new array
+ * and free the old array.
+ */
+
+ if (masterPtr->width == instancePtr->width) {
+
+ offset = validBox.y * masterPtr->width * 3;
+ memcpy((VOID *) (newError + offset),
+ (VOID *) (instancePtr->error + offset),
+ (size_t) (validBox.height
+ * masterPtr->width * 3 * sizeof(schar)));
+
+ } else if (validBox.width > 0 && validBox.height > 0) {
+
+ errDestPtr = newError
+ + (validBox.y * masterPtr->width + validBox.x) * 3;
+ errSrcPtr = instancePtr->error
+ + (validBox.y * instancePtr->width + validBox.x) * 3;
+ for (h = validBox.height; h > 0; --h) {
+ memcpy((VOID *) errDestPtr, (VOID *) errSrcPtr,
+ validBox.width * 3 * sizeof(schar));
+ errDestPtr += masterPtr->width * 3;
+ errSrcPtr += instancePtr->width * 3;
+ }
+ }
+ ckfree((char *) instancePtr->error);
+ }
+
+ instancePtr->error = newError;
+ }
+
+ instancePtr->width = masterPtr->width;
+ instancePtr->height = masterPtr->height;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IsValidPalette --
+ *
+ * This procedure is called to check whether a value given for
+ * the -palette option is valid for a particular instance
+ * of a photo image.
+ *
+ * Results:
+ * A boolean value: 1 if the palette is acceptable, 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+IsValidPalette(instancePtr, palette)
+ PhotoInstance *instancePtr; /* Instance to which the palette
+ * specification is to be applied. */
+ char *palette; /* Palette specification string. */
+{
+ int nRed, nGreen, nBlue, mono, numColors;
+ char *endp;
+
+ /*
+ * First parse the specification: it must be of the form
+ * %d or %d/%d/%d.
+ */
+
+ nRed = strtol(palette, &endp, 10);
+ if ((endp == palette) || ((*endp != 0) && (*endp != '/'))
+ || (nRed < 2) || (nRed > 256)) {
+ return 0;
+ }
+
+ if (*endp == 0) {
+ mono = 1;
+ nGreen = nBlue = nRed;
+ } else {
+ palette = endp + 1;
+ nGreen = strtol(palette, &endp, 10);
+ if ((endp == palette) || (*endp != '/') || (nGreen < 2)
+ || (nGreen > 256)) {
+ return 0;
+ }
+ palette = endp + 1;
+ nBlue = strtol(palette, &endp, 10);
+ if ((endp == palette) || (*endp != 0) || (nBlue < 2)
+ || (nBlue > 256)) {
+ return 0;
+ }
+ mono = 0;
+ }
+
+ switch (instancePtr->visualInfo.class) {
+ case DirectColor:
+ case TrueColor:
+ if ((nRed > (1 << CountBits(instancePtr->visualInfo.red_mask)))
+ || (nGreen > (1
+ << CountBits(instancePtr->visualInfo.green_mask)))
+ || (nBlue > (1
+ << CountBits(instancePtr->visualInfo.blue_mask)))) {
+ return 0;
+ }
+ break;
+ case PseudoColor:
+ case StaticColor:
+ numColors = nRed;
+ if (!mono) {
+ numColors *= nGreen*nBlue;
+ }
+ if (numColors > (1 << instancePtr->visualInfo.depth)) {
+ return 0;
+ }
+ break;
+ case GrayScale:
+ case StaticGray:
+ if (!mono || (nRed > (1 << instancePtr->visualInfo.depth))) {
+ return 0;
+ }
+ break;
+ }
+
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CountBits --
+ *
+ * This procedure counts how many bits are set to 1 in `mask'.
+ *
+ * Results:
+ * The integer number of bits.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CountBits(mask)
+ pixel mask; /* Value to count the 1 bits in. */
+{
+ int n;
+
+ for( n = 0; mask != 0; mask &= mask - 1 )
+ n++;
+ return n;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetColorTable --
+ *
+ * This procedure is called to allocate a table of colormap
+ * information for an instance of a photo image. Only one such
+ * table is allocated for all photo instances using the same
+ * display, colormap, palette and gamma values, so that the
+ * application need only request a set of colors from the X
+ * server once for all such photo widgets. This procedure
+ * maintains a hash table to find previously-allocated
+ * ColorTables.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new ColorTable may be allocated and placed in the hash
+ * table, and have colors allocated for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetColorTable(instancePtr)
+ PhotoInstance *instancePtr; /* Instance needing a color table. */
+{
+ ColorTable *colorPtr;
+ Tcl_HashEntry *entry;
+ ColorTableId id;
+ int isNew;
+
+ /*
+ * Look for an existing ColorTable in the hash table.
+ */
+
+ memset((VOID *) &id, 0, sizeof(id));
+ id.display = instancePtr->display;
+ id.colormap = instancePtr->colormap;
+ id.palette = instancePtr->palette;
+ id.gamma = instancePtr->gamma;
+ if (!imgPhotoColorHashInitialized) {
+ Tcl_InitHashTable(&imgPhotoColorHash, N_COLOR_HASH);
+ imgPhotoColorHashInitialized = 1;
+ }
+ entry = Tcl_CreateHashEntry(&imgPhotoColorHash, (char *) &id, &isNew);
+
+ if (!isNew) {
+ /*
+ * Re-use the existing entry.
+ */
+
+ colorPtr = (ColorTable *) Tcl_GetHashValue(entry);
+
+ } else {
+ /*
+ * No color table currently available; need to make one.
+ */
+
+ colorPtr = (ColorTable *) ckalloc(sizeof(ColorTable));
+
+ /*
+ * The following line of code should not normally be needed due
+ * to the assignment in the following line. However, it compensates
+ * for bugs in some compilers (HP, for example) where
+ * sizeof(ColorTable) is 24 but the assignment only copies 20 bytes,
+ * leaving 4 bytes uninitialized; these cause problems when using
+ * the id for lookups in imgPhotoColorHash, and can result in
+ * core dumps.
+ */
+
+ memset((VOID *) &colorPtr->id, 0, sizeof(ColorTableId));
+ colorPtr->id = id;
+ Tk_PreserveColormap(colorPtr->id.display, colorPtr->id.colormap);
+ colorPtr->flags = 0;
+ colorPtr->refCount = 0;
+ colorPtr->liveRefCount = 0;
+ colorPtr->numColors = 0;
+ colorPtr->visualInfo = instancePtr->visualInfo;
+ colorPtr->pixelMap = NULL;
+ Tcl_SetHashValue(entry, colorPtr);
+ }
+
+ colorPtr->refCount++;
+ colorPtr->liveRefCount++;
+ instancePtr->colorTablePtr = colorPtr;
+ if (colorPtr->flags & DISPOSE_PENDING) {
+ Tcl_CancelIdleCall(DisposeColorTable, (ClientData) colorPtr);
+ colorPtr->flags &= ~DISPOSE_PENDING;
+ }
+
+ /*
+ * Allocate colors for this color table if necessary.
+ */
+
+ if ((colorPtr->numColors == 0)
+ && ((colorPtr->flags & BLACK_AND_WHITE) == 0)) {
+ AllocateColors(colorPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeColorTable --
+ *
+ * This procedure is called when an instance ceases using a
+ * color table.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If no other instances are using this color table, a when-idle
+ * 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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AllocateColors --
+ *
+ * This procedure allocates the colors required by a color table,
+ * and sets up the fields in the color table data structure which
+ * are used in dithering.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Colors are allocated from the X server. Fields in the
+ * color table data structure are updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AllocateColors(colorPtr)
+ ColorTable *colorPtr; /* Pointer to the color table requiring
+ * colors to be allocated. */
+{
+ int i, r, g, b, rMult, mono;
+ int numColors, nRed, nGreen, nBlue;
+ double fr, fg, fb, igam;
+ XColor *colors;
+ unsigned long *pixels;
+
+ /* 16-bit intensity value for i/n of full intensity. */
+# define CFRAC(i, n) ((i) * 65535 / (n))
+
+ /* As for CFRAC, but apply exponent of g. */
+# define CGFRAC(i, n, g) ((int)(65535 * pow((double)(i) / (n), (g))))
+
+ /*
+ * First parse the palette specification to get the required number of
+ * shades of each primary.
+ */
+
+ nRed = nGreen = nBlue = 0;
+ mono = sscanf(colorPtr->id.palette, "%d/%d/%d", &nRed, &nGreen, &nBlue)
+ <= 1;
+ igam = 1.0 / colorPtr->id.gamma;
+
+ /*
+ * Each time around this loop, we reduce the number of colors we're
+ * trying to allocate until we succeed in allocating all of the colors
+ * we need.
+ */
+
+ for (;;) {
+ /*
+ * If we are using 1 bit/pixel, we don't need to allocate
+ * any colors (we just use the foreground and background
+ * colors in the GC).
+ */
+
+ if (mono && (nRed <= 2)) {
+ colorPtr->flags |= BLACK_AND_WHITE;
+ return;
+ }
+
+ /*
+ * Calculate the RGB coordinates of the colors we want to
+ * allocate and store them in *colors.
+ */
+
+ if ((colorPtr->visualInfo.class == DirectColor)
+ || (colorPtr->visualInfo.class == TrueColor)) {
+
+ /*
+ * Direct/True Color: allocate shades of red, green, blue
+ * independently.
+ */
+
+ if (mono) {
+ numColors = nGreen = nBlue = nRed;
+ } else {
+ numColors = MAX(MAX(nRed, nGreen), nBlue);
+ }
+ colors = (XColor *) ckalloc(numColors * sizeof(XColor));
+
+ for (i = 0; i < numColors; ++i) {
+ if (igam == 1.0) {
+ colors[i].red = CFRAC(i, nRed - 1);
+ colors[i].green = CFRAC(i, nGreen - 1);
+ colors[i].blue = CFRAC(i, nBlue - 1);
+ } else {
+ colors[i].red = CGFRAC(i, nRed - 1, igam);
+ colors[i].green = CGFRAC(i, nGreen - 1, igam);
+ colors[i].blue = CGFRAC(i, nBlue - 1, igam);
+ }
+ }
+ } else {
+ /*
+ * PseudoColor, StaticColor, GrayScale or StaticGray visual:
+ * we have to allocate each color in the color cube separately.
+ */
+
+ numColors = (mono) ? nRed: (nRed * nGreen * nBlue);
+ colors = (XColor *) ckalloc(numColors * sizeof(XColor));
+
+ if (!mono) {
+ /*
+ * Color display using a PseudoColor or StaticColor visual.
+ */
+
+ i = 0;
+ for (r = 0; r < nRed; ++r) {
+ for (g = 0; g < nGreen; ++g) {
+ for (b = 0; b < nBlue; ++b) {
+ if (igam == 1.0) {
+ colors[i].red = CFRAC(r, nRed - 1);
+ colors[i].green = CFRAC(g, nGreen - 1);
+ colors[i].blue = CFRAC(b, nBlue - 1);
+ } else {
+ colors[i].red = CGFRAC(r, nRed - 1, igam);
+ colors[i].green = CGFRAC(g, nGreen - 1, igam);
+ colors[i].blue = CGFRAC(b, nBlue - 1, igam);
+ }
+ i++;
+ }
+ }
+ }
+ } else {
+ /*
+ * Monochrome display - allocate the shades of grey we want.
+ */
+
+ for (i = 0; i < numColors; ++i) {
+ if (igam == 1.0) {
+ r = CFRAC(i, numColors - 1);
+ } else {
+ r = CGFRAC(i, numColors - 1, igam);
+ }
+ colors[i].red = colors[i].green = colors[i].blue = r;
+ }
+ }
+ }
+
+ /*
+ * Now try to allocate the colors we've calculated.
+ */
+
+ pixels = (unsigned long *) ckalloc(numColors * sizeof(unsigned long));
+ for (i = 0; i < numColors; ++i) {
+ if (!XAllocColor(colorPtr->id.display, colorPtr->id.colormap,
+ &colors[i])) {
+
+ /*
+ * Can't get all the colors we want in the default colormap;
+ * first try freeing colors from other unused color tables.
+ */
+
+ if (!ReclaimColors(&colorPtr->id, numColors - i)
+ || !XAllocColor(colorPtr->id.display,
+ colorPtr->id.colormap, &colors[i])) {
+ /*
+ * Still can't allocate the color.
+ */
+ break;
+ }
+ }
+ pixels[i] = colors[i].pixel;
+ }
+
+ /*
+ * If we didn't get all of the colors, reduce the
+ * resolution of the color cube, free the ones we got,
+ * and try again.
+ */
+
+ if (i >= numColors) {
+ break;
+ }
+ XFreeColors(colorPtr->id.display, colorPtr->id.colormap, pixels, i, 0);
+ ckfree((char *) colors);
+ ckfree((char *) pixels);
+
+ if (!mono) {
+ if ((nRed == 2) && (nGreen == 2) && (nBlue == 2)) {
+ /*
+ * Fall back to 1-bit monochrome display.
+ */
+
+ mono = 1;
+ } else {
+ /*
+ * Reduce the number of shades of each primary to about
+ * 3/4 of the previous value. This should reduce the
+ * total number of colors required to about half the
+ * previous value for PseudoColor displays.
+ */
+
+ nRed = (nRed * 3 + 2) / 4;
+ nGreen = (nGreen * 3 + 2) / 4;
+ nBlue = (nBlue * 3 + 2) / 4;
+ }
+ } else {
+ /*
+ * Reduce the number of shades of gray to about 1/2.
+ */
+
+ nRed = nRed / 2;
+ }
+ }
+
+ /*
+ * We have allocated all of the necessary colors:
+ * fill in various fields of the ColorTable record.
+ */
+
+ if (!mono) {
+ colorPtr->flags |= COLOR_WINDOW;
+
+ /*
+ * The following is a hairy hack. We only want to index into
+ * the pixelMap on colormap displays. However, if the display
+ * is on Windows, then we actually want to store the index not
+ * the value since we will be passing the color table into the
+ * TkPutImage call.
+ */
+
+#ifndef __WIN32__
+ if ((colorPtr->visualInfo.class != DirectColor)
+ && (colorPtr->visualInfo.class != TrueColor)) {
+ colorPtr->flags |= MAP_COLORS;
+ }
+#endif /* __WIN32__ */
+ }
+
+ colorPtr->numColors = numColors;
+ colorPtr->pixelMap = pixels;
+
+ /*
+ * Set up quantization tables for dithering.
+ */
+ rMult = nGreen * nBlue;
+ for (i = 0; i < 256; ++i) {
+ r = (i * (nRed - 1) + 127) / 255;
+ if (mono) {
+ fr = (double) colors[r].red / 65535.0;
+ if (colorPtr->id.gamma != 1.0 ) {
+ fr = pow(fr, colorPtr->id.gamma);
+ }
+ colorPtr->colorQuant[0][i] = (int)(fr * 255.99);
+ colorPtr->redValues[i] = colors[r].pixel;
+ } else {
+ g = (i * (nGreen - 1) + 127) / 255;
+ b = (i * (nBlue - 1) + 127) / 255;
+ if ((colorPtr->visualInfo.class == DirectColor)
+ || (colorPtr->visualInfo.class == TrueColor)) {
+ colorPtr->redValues[i] = colors[r].pixel
+ & colorPtr->visualInfo.red_mask;
+ colorPtr->greenValues[i] = colors[g].pixel
+ & colorPtr->visualInfo.green_mask;
+ colorPtr->blueValues[i] = colors[b].pixel
+ & colorPtr->visualInfo.blue_mask;
+ } else {
+ r *= rMult;
+ g *= nBlue;
+ colorPtr->redValues[i] = r;
+ colorPtr->greenValues[i] = g;
+ colorPtr->blueValues[i] = b;
+ }
+ fr = (double) colors[r].red / 65535.0;
+ fg = (double) colors[g].green / 65535.0;
+ fb = (double) colors[b].blue / 65535.0;
+ if (colorPtr->id.gamma != 1.0) {
+ fr = pow(fr, colorPtr->id.gamma);
+ fg = pow(fg, colorPtr->id.gamma);
+ fb = pow(fb, colorPtr->id.gamma);
+ }
+ colorPtr->colorQuant[0][i] = (int)(fr * 255.99);
+ colorPtr->colorQuant[1][i] = (int)(fg * 255.99);
+ colorPtr->colorQuant[2][i] = (int)(fb * 255.99);
+ }
+ }
+
+ ckfree((char *) colors);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisposeColorTable --
+ *
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The colors in the argument color table are freed, as is the
+ * color table structure itself. The color table is removed
+ * from the hash table which is used to locate color tables.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisposeColorTable(clientData)
+ ClientData clientData; /* Pointer to the ColorTable whose
+ * colors are to be released. */
+{
+ ColorTable *colorPtr;
+ Tcl_HashEntry *entry;
+
+ colorPtr = (ColorTable *) clientData;
+ if (colorPtr->pixelMap != NULL) {
+ if (colorPtr->numColors > 0) {
+ XFreeColors(colorPtr->id.display, colorPtr->id.colormap,
+ colorPtr->pixelMap, colorPtr->numColors, 0);
+ Tk_FreeColormap(colorPtr->id.display, colorPtr->id.colormap);
+ }
+ ckfree((char *) colorPtr->pixelMap);
+ }
+
+ entry = Tcl_FindHashEntry(&imgPhotoColorHash, (char *) &colorPtr->id);
+ if (entry == NULL) {
+ panic("DisposeColorTable couldn't find hash entry");
+ }
+ Tcl_DeleteHashEntry(entry);
+
+ ckfree((char *) colorPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReclaimColors --
+ *
+ * This procedure is called to try to free up colors in the
+ * colormap used by a color table. It looks for other color
+ * tables with the same colormap and with a zero live reference
+ * count, and frees their colors. It only does so if there is
+ * the possibility of freeing up at least `numColors' colors.
+ *
+ * Results:
+ * The return value is TRUE if any colors were freed, FALSE
+ * otherwise.
+ *
+ * Side effects:
+ * ColorTables which are not currently in use may lose their
+ * color allocations.
+ *
+ *---------------------------------------------------------------------- */
+
+static int
+ReclaimColors(id, numColors)
+ ColorTableId *id; /* Pointer to information identifying
+ * the color table which needs more colors. */
+ int numColors; /* Number of colors required. */
+{
+ Tcl_HashSearch srch;
+ Tcl_HashEntry *entry;
+ ColorTable *colorPtr;
+ int nAvail;
+
+ /*
+ * First scan through the color hash table to get an
+ * upper bound on how many colors we might be able to free.
+ */
+
+ nAvail = 0;
+ entry = Tcl_FirstHashEntry(&imgPhotoColorHash, &srch);
+ while (entry != NULL) {
+ colorPtr = (ColorTable *) Tcl_GetHashValue(entry);
+ if ((colorPtr->id.display == id->display)
+ && (colorPtr->id.colormap == id->colormap)
+ && (colorPtr->liveRefCount == 0 )&& (colorPtr->numColors != 0)
+ && ((colorPtr->id.palette != id->palette)
+ || (colorPtr->id.gamma != id->gamma))) {
+
+ /*
+ * We could take this guy's colors off him.
+ */
+
+ nAvail += colorPtr->numColors;
+ }
+ entry = Tcl_NextHashEntry(&srch);
+ }
+
+ /*
+ * nAvail is an (over)estimate of the number of colors we could free.
+ */
+
+ if (nAvail < numColors) {
+ return 0;
+ }
+
+ /*
+ * Scan through a second time freeing colors.
+ */
+
+ entry = Tcl_FirstHashEntry(&imgPhotoColorHash, &srch);
+ while ((entry != NULL) && (numColors > 0)) {
+ colorPtr = (ColorTable *) Tcl_GetHashValue(entry);
+ if ((colorPtr->id.display == id->display)
+ && (colorPtr->id.colormap == id->colormap)
+ && (colorPtr->liveRefCount == 0) && (colorPtr->numColors != 0)
+ && ((colorPtr->id.palette != id->palette)
+ || (colorPtr->id.gamma != id->gamma))) {
+
+ /*
+ * Free the colors that this ColorTable has.
+ */
+
+ XFreeColors(colorPtr->id.display, colorPtr->id.colormap,
+ colorPtr->pixelMap, colorPtr->numColors, 0);
+ numColors -= colorPtr->numColors;
+ colorPtr->numColors = 0;
+ ckfree((char *) colorPtr->pixelMap);
+ colorPtr->pixelMap = NULL;
+ }
+
+ entry = Tcl_NextHashEntry(&srch);
+ }
+ return 1; /* we freed some colors */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisposeInstance --
+ *
+ * This procedure is called to finally free up an instance
+ * of a photo image which is no longer required.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The instance data structure and the resources it references
+ * are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisposeInstance(clientData)
+ ClientData clientData; /* Pointer to the instance whose resources
+ * are to be released. */
+{
+ PhotoInstance *instancePtr = (PhotoInstance *) clientData;
+ PhotoInstance *prevPtr;
+
+ if (instancePtr->pixels != None) {
+ Tk_FreePixmap(instancePtr->display, instancePtr->pixels);
+ }
+ if (instancePtr->gc != None) {
+ Tk_FreeGC(instancePtr->display, instancePtr->gc);
+ }
+ 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) {
+ /* Empty loop body */
+ }
+ prevPtr->nextPtr = instancePtr->nextPtr;
+ }
+ Tk_FreeColormap(instancePtr->display, instancePtr->colormap);
+ ckfree((char *) instancePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MatchFileFormat --
+ *
+ * This procedure is called to find a photo image file format
+ * handler which can parse the image data in the given file.
+ * If a user-specified format string is provided, only handlers
+ * whose names match a prefix of the format string are tried.
+ *
+ * Results:
+ * A standard TCL return value. If the return value is TCL_OK, a
+ * pointer to the image format record is returned in
+ * *imageFormatPtr, and the width and height of the image are
+ * returned in *widthPtr and *heightPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MatchFileFormat(interp, chan, fileName, formatString, imageFormatPtr,
+ widthPtr, heightPtr)
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ Tcl_Channel chan; /* The image file, open for reading. */
+ char *fileName; /* The name of the image file. */
+ char *formatString; /* User-specified format string, or NULL. */
+ Tk_PhotoImageFormat **imageFormatPtr;
+ /* 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;
+ if (formatPtr->fileMatchProc == NULL) {
+ Tcl_AppendResult(interp, "-file option isn't supported for ",
+ formatString, " images", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (formatPtr->fileMatchProc != NULL) {
+ (void) Tcl_Seek(chan, 0L, SEEK_SET);
+
+ if ((*formatPtr->fileMatchProc)(chan, fileName, formatString,
+ widthPtr, heightPtr)) {
+ if (*widthPtr < 1) {
+ *widthPtr = 1;
+ }
+ if (*heightPtr < 1) {
+ *heightPtr = 1;
+ }
+ break;
+ }
+ }
+ }
+
+ if (formatPtr == NULL) {
+ if ((formatString != NULL) && !matched) {
+ Tcl_AppendResult(interp, "image file format \"", formatString,
+ "\" is not supported", (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp,
+ "couldn't recognize data in image file \"",
+ fileName, "\"", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ *imageFormatPtr = formatPtr;
+ (void) Tcl_Seek(chan, 0L, SEEK_SET);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MatchStringFormat --
+ *
+ * This procedure is called to find a photo image file format
+ * handler which can parse the image data in the given string.
+ * If a user-specified format string is provided, only handlers
+ * whose names match a prefix of the format string are tried.
+ *
+ * Results:
+ * A standard TCL return value. If the return value is TCL_OK, a
+ * pointer to the image format record is returned in
+ * *imageFormatPtr, and the width and height of the image are
+ * returned in *widthPtr and *heightPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MatchStringFormat(interp, dataObj, formatString, imageFormatPtr,
+ widthPtr, heightPtr)
+ Tcl_Interp *interp; /* Interpreter to use for reporting errors. */
+ Tcl_Obj *dataObj; /* Object containing the image data. */
+ char *formatString; /* User-specified format string, or NULL. */
+ Tk_PhotoImageFormat **imageFormatPtr;
+ /* 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;
+ if (formatPtr->stringMatchProc == NULL) {
+ Tcl_AppendResult(interp, "-data option isn't supported for ",
+ formatString, " images", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if ((formatPtr->stringMatchProc != NULL)
+ && (formatPtr->stringReadProc != NULL)
+ && (*formatPtr->stringMatchProc)(dataObj, formatString,
+ widthPtr, heightPtr)) {
+ break;
+ }
+ }
+
+ if (formatPtr == NULL) {
+ if ((formatString != NULL) && !matched) {
+ Tcl_AppendResult(interp, "image format \"", formatString,
+ "\" is not supported", (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "couldn't recognize image data",
+ (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+
+ *imageFormatPtr = formatPtr;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FindPhoto --
+ *
+ * This procedure is called to get an opaque handle (actually a
+ * PhotoMaster *) for a given image, which can be used in
+ * subsequent calls to Tk_PhotoPutBlock, etc. The `name'
+ * parameter is the name of the image.
+ *
+ * Results:
+ * The handle for the photo image, or NULL if there is no
+ * photo image with the name given.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_PhotoHandle
+Tk_FindPhoto(interp, imageName)
+ Tcl_Interp *interp; /* Interpreter (application) in which image
+ * exists. */
+ char *imageName; /* Name of the desired photo image. */
+{
+ ClientData clientData;
+ Tk_ImageType *typePtr;
+
+ clientData = Tk_GetImageMasterData(interp, imageName, &typePtr);
+ if (typePtr != &tkPhotoImageType) {
+ return NULL;
+ }
+ return (Tk_PhotoHandle) clientData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoPutBlock --
+ *
+ * This procedure is called to put image data into a photo image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image data is stored. The image may be expanded.
+ * The Tk image code is informed that the image has changed.
+ *
+ *---------------------------------------------------------------------- */
+
+void
+Tk_PhotoPutBlock(handle, blockPtr, x, y, width, height)
+ Tk_PhotoHandle handle; /* Opaque handle for the photo image
+ * to be updated. */
+ register Tk_PhotoImageBlock *blockPtr;
+ /* Pointer to a structure describing the
+ * pixel data to be copied into the image. */
+ int x, y; /* Coordinates of the top-left pixel to
+ * be updated in the image. */
+ int width, height; /* Dimensions of the area of the image
+ * to be updated. */
+{
+ register PhotoMaster *masterPtr;
+ int xEnd, yEnd;
+ int greenOffset, blueOffset, alphaOffset;
+ int wLeft, hLeft;
+ int wCopy, hCopy;
+ unsigned char *srcPtr, *srcLinePtr;
+ unsigned char *destPtr, *destLinePtr;
+ int pitch;
+ XRectangle rect;
+
+ masterPtr = (PhotoMaster *) handle;
+
+ if ((masterPtr->userWidth != 0) && ((x + width) > masterPtr->userWidth)) {
+ width = masterPtr->userWidth - x;
+ }
+ if ((masterPtr->userHeight != 0)
+ && ((y + height) > masterPtr->userHeight)) {
+ height = masterPtr->userHeight - y;
+ }
+ if ((width <= 0) || (height <= 0))
+ return;
+
+ xEnd = x + width;
+ yEnd = y + height;
+ if ((xEnd > masterPtr->width) || (yEnd > masterPtr->height)) {
+ ImgPhotoSetSize(masterPtr, MAX(xEnd, masterPtr->width),
+ MAX(yEnd, masterPtr->height));
+ }
+
+ if ((y < masterPtr->ditherY) || ((y == masterPtr->ditherY)
+ && (x < masterPtr->ditherX))) {
+ /*
+ * The dithering isn't correct past the start of this block.
+ */
+ masterPtr->ditherX = x;
+ masterPtr->ditherY = y;
+ }
+
+ /*
+ * If this image block could have different red, green and blue
+ * components, mark it as a color image.
+ */
+
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+ alphaOffset = 0;
+ while ((alphaOffset != blockPtr->offset[0]) &&
+ (alphaOffset != blockPtr->offset[1]) &&
+ (alphaOffset != blockPtr->offset[2])) {
+ alphaOffset++;
+ }
+ if (alphaOffset >= blockPtr->pixelSize) {
+ alphaOffset = 0;
+ } else {
+ alphaOffset -= blockPtr->offset[0];
+ }
+ if ((greenOffset != 0) || (blueOffset != 0)) {
+ masterPtr->flags |= COLOR_IMAGE;
+ }
+
+ /*
+ * Copy the data into our local 24-bit/pixel array.
+ * If we can do it with a single memcpy, we do.
+ */
+
+ destLinePtr = masterPtr->pix24 + (y * masterPtr->width + x) * 4;
+ pitch = masterPtr->width * 4;
+
+ if ((blockPtr->pixelSize == 4) && (greenOffset == 1) && (blueOffset == 2)
+ && (width <= blockPtr->width) && (height <= blockPtr->height)
+ && ((height == 1) || ((x == 0) && (width == masterPtr->width)
+ && (blockPtr->pitch == pitch)))) {
+ memcpy((VOID *) destLinePtr,
+ (VOID *) (blockPtr->pixelPtr + blockPtr->offset[0]),
+ (size_t) (height * width * 4));
+ } else {
+ for (hLeft = height; hLeft > 0;) {
+ srcLinePtr = blockPtr->pixelPtr + blockPtr->offset[0];
+ hCopy = MIN(hLeft, blockPtr->height);
+ hLeft -= hCopy;
+ for (; hCopy > 0; --hCopy) {
+ destPtr = destLinePtr;
+ for (wLeft = width; wLeft > 0;) {
+ wCopy = MIN(wLeft, blockPtr->width);
+ wLeft -= wCopy;
+ srcPtr = srcLinePtr;
+ for (; wCopy > 0; --wCopy) {
+ *destPtr++ = srcPtr[0];
+ *destPtr++ = srcPtr[greenOffset];
+ *destPtr++ = srcPtr[blueOffset];
+ *destPtr++ = alphaOffset ? srcPtr[alphaOffset] : 255;
+ srcPtr += blockPtr->pixelSize;
+ }
+ }
+ srcLinePtr += blockPtr->pitch;
+ destLinePtr += pitch;
+ }
+ }
+ }
+
+ /*
+ * Add this new block to the region which specifies which data is valid.
+ */
+
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = height;
+ TkUnionRectWithRegion(&rect, masterPtr->validRegion,
+ masterPtr->validRegion);
+
+ /*
+ * Update each instance.
+ */
+
+ Dither(masterPtr, x, y, width, height);
+
+ /*
+ * Tell the core image code that this image has changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, x, y, width, height, masterPtr->width,
+ masterPtr->height);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoPutZoomedBlock --
+ *
+ * This procedure is called to put image data into a photo image,
+ * with possible subsampling and/or zooming of the pixels.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image data is stored. The image may be expanded.
+ * The Tk image code is informed that the image has changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoPutZoomedBlock(handle, blockPtr, x, y, width, height, zoomX, zoomY,
+ subsampleX, subsampleY)
+ Tk_PhotoHandle handle; /* Opaque handle for the photo image
+ * to be updated. */
+ register Tk_PhotoImageBlock *blockPtr;
+ /* Pointer to a structure describing the
+ * pixel data to be copied into the image. */
+ int x, y; /* Coordinates of the top-left pixel to
+ * be updated in the image. */
+ int width, height; /* Dimensions of the area of the image
+ * to be updated. */
+ int zoomX, zoomY; /* Zoom factors for the X and Y axes. */
+ int subsampleX, subsampleY; /* Subsampling factors for the X and Y axes. */
+{
+ register PhotoMaster *masterPtr;
+ int xEnd, yEnd;
+ int greenOffset, blueOffset, alphaOffset;
+ int wLeft, hLeft;
+ int wCopy, hCopy;
+ int blockWid, blockHt;
+ unsigned char *srcPtr, *srcLinePtr, *srcOrigPtr;
+ unsigned char *destPtr, *destLinePtr;
+ int pitch;
+ int xRepeat, yRepeat;
+ int blockXSkip, blockYSkip;
+ XRectangle rect;
+
+ if ((zoomX == 1) && (zoomY == 1) && (subsampleX == 1)
+ && (subsampleY == 1)) {
+ Tk_PhotoPutBlock(handle, blockPtr, x, y, width, height);
+ return;
+ }
+
+ masterPtr = (PhotoMaster *) handle;
+
+ if ((zoomX <= 0) || (zoomY <= 0))
+ return;
+ if ((masterPtr->userWidth != 0) && ((x + width) > masterPtr->userWidth)) {
+ width = masterPtr->userWidth - x;
+ }
+ if ((masterPtr->userHeight != 0)
+ && ((y + height) > masterPtr->userHeight)) {
+ height = masterPtr->userHeight - y;
+ }
+ if ((width <= 0) || (height <= 0))
+ return;
+
+ xEnd = x + width;
+ yEnd = y + height;
+ if ((xEnd > masterPtr->width) || (yEnd > masterPtr->height)) {
+ int sameSrc = (blockPtr->pixelPtr == masterPtr->pix24);
+ ImgPhotoSetSize(masterPtr, MAX(xEnd, masterPtr->width),
+ MAX(yEnd, masterPtr->height));
+ if (sameSrc) {
+ blockPtr->pixelPtr = masterPtr->pix24;
+ }
+ }
+
+ if ((y < masterPtr->ditherY) || ((y == masterPtr->ditherY)
+ && (x < masterPtr->ditherX))) {
+ /*
+ * The dithering isn't correct past the start of this block.
+ */
+
+ masterPtr->ditherX = x;
+ masterPtr->ditherY = y;
+ }
+
+ /*
+ * If this image block could have different red, green and blue
+ * components, mark it as a color image.
+ */
+
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+ alphaOffset = 0;
+ while ((alphaOffset != blockPtr->offset[0]) &&
+ (alphaOffset != blockPtr->offset[1]) &&
+ (alphaOffset != blockPtr->offset[2])) {
+ alphaOffset++;
+ }
+ if (alphaOffset >= blockPtr->pixelSize) {
+ alphaOffset = 0;
+ } else {
+ alphaOffset -= blockPtr->offset[0];
+ }
+ if ((greenOffset != 0) || (blueOffset != 0)) {
+ masterPtr->flags |= COLOR_IMAGE;
+ }
+
+ /*
+ * Work out what area the pixel data in the block expands to after
+ * subsampling and zooming.
+ */
+
+ blockXSkip = subsampleX * blockPtr->pixelSize;
+ blockYSkip = subsampleY * blockPtr->pitch;
+ if (subsampleX > 0)
+ blockWid = ((blockPtr->width + subsampleX - 1) / subsampleX) * zoomX;
+ else if (subsampleX == 0)
+ blockWid = width;
+ else
+ blockWid = ((blockPtr->width - subsampleX - 1) / -subsampleX) * zoomX;
+ if (subsampleY > 0)
+ blockHt = ((blockPtr->height + subsampleY - 1) / subsampleY) * zoomY;
+ else if (subsampleY == 0)
+ blockHt = height;
+ else
+ blockHt = ((blockPtr->height - subsampleY - 1) / -subsampleY) * zoomY;
+
+ /*
+ * Copy the data into our local 24-bit/pixel array.
+ */
+
+ destLinePtr = masterPtr->pix24 + (y * masterPtr->width + x) * 4;
+ srcOrigPtr = blockPtr->pixelPtr + blockPtr->offset[0];
+ if (subsampleX < 0) {
+ srcOrigPtr += (blockPtr->width - 1) * blockPtr->pixelSize;
+ }
+ if (subsampleY < 0) {
+ srcOrigPtr += (blockPtr->height - 1) * blockPtr->pitch;
+ }
+
+ pitch = masterPtr->width * 4;
+ for (hLeft = height; hLeft > 0; ) {
+ hCopy = MIN(hLeft, blockHt);
+ hLeft -= hCopy;
+ yRepeat = zoomY;
+ srcLinePtr = srcOrigPtr;
+ for (; hCopy > 0; --hCopy) {
+ destPtr = destLinePtr;
+ for (wLeft = width; wLeft > 0;) {
+ wCopy = MIN(wLeft, blockWid);
+ wLeft -= wCopy;
+ srcPtr = srcLinePtr;
+ for (; wCopy > 0; wCopy -= zoomX) {
+ for (xRepeat = MIN(wCopy, zoomX); xRepeat > 0; xRepeat--) {
+ *destPtr++ = srcPtr[0];
+ *destPtr++ = srcPtr[greenOffset];
+ *destPtr++ = srcPtr[blueOffset];
+ *destPtr++ = alphaOffset ? srcPtr[alphaOffset] : 255;
+ }
+ srcPtr += blockXSkip;
+ }
+ }
+ destLinePtr += pitch;
+ yRepeat--;
+ if (yRepeat <= 0) {
+ srcLinePtr += blockYSkip;
+ yRepeat = zoomY;
+ }
+ }
+ }
+
+ /*
+ * Add this new block to the region that specifies which data is valid.
+ */
+
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = height;
+ TkUnionRectWithRegion(&rect, masterPtr->validRegion,
+ masterPtr->validRegion);
+
+ /*
+ * Update each instance.
+ */
+
+ Dither(masterPtr, x, y, width, height);
+
+ /*
+ * Tell the core image code that this image has changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, x, y, width, height, masterPtr->width,
+ masterPtr->height);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Dither --
+ *
+ * This procedure is called to update an area of each instance's
+ * pixmap by dithering the corresponding area of the image master.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The pixmap of each instance of this image gets updated.
+ * The fields in *masterPtr indicating which area of the image
+ * is correctly dithered get updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Dither(masterPtr, x, y, width, height)
+ PhotoMaster *masterPtr; /* Image master whose instances are
+ * to be updated. */
+ int x, y; /* Coordinates of the top-left pixel
+ * in the area to be dithered. */
+ int width, height; /* Dimensions of the area to be dithered. */
+{
+ PhotoInstance *instancePtr;
+
+ if ((width <= 0) || (height <= 0)) {
+ return;
+ }
+
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ DitherInstance(instancePtr, x, y, width, height);
+ }
+
+ /*
+ * Work out whether this block will be correctly dithered
+ * and whether it will extend the correctly dithered region.
+ */
+
+ if (((y < masterPtr->ditherY)
+ || ((y == masterPtr->ditherY) && (x <= masterPtr->ditherX)))
+ && ((y + height) > (masterPtr->ditherY))) {
+
+ /*
+ * This block starts inside (or immediately after) the correctly
+ * dithered region, so the first scan line at least will be right.
+ * Furthermore this block extends into scanline masterPtr->ditherY.
+ */
+
+ if ((x == 0) && (width == masterPtr->width)) {
+ /*
+ * We are doing the full width, therefore the dithering
+ * will be correct to the end.
+ */
+
+ masterPtr->ditherX = 0;
+ masterPtr->ditherY = y + height;
+ } else {
+ /*
+ * We are doing partial scanlines, therefore the
+ * correctly-dithered region will be extended by
+ * at most one scan line.
+ */
+
+ if (x <= masterPtr->ditherX) {
+ masterPtr->ditherX = x + width;
+ if (masterPtr->ditherX >= masterPtr->width) {
+ masterPtr->ditherX = 0;
+ masterPtr->ditherY++;
+ }
+ }
+ }
+ }
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DitherInstance --
+ *
+ * This procedure is called to update an area of an instance's
+ * pixmap by dithering the corresponding area of the master.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The instance's pixmap gets updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DitherInstance(instancePtr, xStart, yStart, width, height)
+ PhotoInstance *instancePtr; /* The instance to be updated. */
+ int xStart, yStart; /* Coordinates of the top-left pixel in the
+ * block to be dithered. */
+ int width, height; /* Dimensions of the block to be dithered. */
+{
+ PhotoMaster *masterPtr;
+ ColorTable *colorPtr;
+ XImage *imagePtr;
+ int nLines, bigEndian;
+ int i, c, x, y;
+ int xEnd, yEnd;
+ int bitsPerPixel, bytesPerLine, lineLength;
+ unsigned char *srcLinePtr, *srcPtr;
+ schar *errLinePtr, *errPtr;
+ unsigned char *destBytePtr, *dstLinePtr;
+ pixel *destLongPtr;
+ pixel firstBit, word, mask;
+ int col[3];
+ int doDithering = 1;
+
+ colorPtr = instancePtr->colorTablePtr;
+ masterPtr = instancePtr->masterPtr;
+
+ /*
+ * Turn dithering off in certain cases where it is not
+ * needed (TrueColor, DirectColor with many colors).
+ */
+
+ if ((colorPtr->visualInfo.class == DirectColor)
+ || (colorPtr->visualInfo.class == TrueColor)) {
+ int nRed, nGreen, nBlue, result;
+
+ result = sscanf(colorPtr->id.palette, "%d/%d/%d", &nRed,
+ &nGreen, &nBlue);
+ if ((nRed >= 256)
+ && ((result == 1) || ((nGreen >= 256) && (nBlue >= 256)))) {
+ doDithering = 0;
+ }
+ }
+
+ /*
+ * First work out how many lines to do at a time,
+ * then how many bytes we'll need for pixel storage,
+ * and allocate it.
+ */
+
+ nLines = (MAX_PIXELS + width - 1) / width;
+ if (nLines < 1) {
+ nLines = 1;
+ }
+ if (nLines > height ) {
+ nLines = height;
+ }
+
+ imagePtr = instancePtr->imagePtr;
+ if (imagePtr == NULL) {
+ return; /* we must be really tight on memory */
+ }
+ bitsPerPixel = imagePtr->bits_per_pixel;
+ bytesPerLine = ((bitsPerPixel * width + 31) >> 3) & ~3;
+ imagePtr->width = width;
+ imagePtr->height = nLines;
+ imagePtr->bytes_per_line = bytesPerLine;
+ imagePtr->data = (char *) ckalloc((unsigned) (imagePtr->bytes_per_line * nLines));
+ bigEndian = imagePtr->bitmap_bit_order == MSBFirst;
+ firstBit = bigEndian? (1 << (imagePtr->bitmap_unit - 1)): 1;
+
+ lineLength = masterPtr->width * 3;
+ srcLinePtr = masterPtr->pix24 + (yStart * masterPtr->width + xStart) * 4;
+ errLinePtr = instancePtr->error + yStart * lineLength + xStart * 3;
+ xEnd = xStart + width;
+
+ /*
+ * Loop over the image, doing at most nLines lines before
+ * updating the screen image.
+ */
+
+ for (; height > 0; height -= nLines) {
+ if (nLines > height) {
+ nLines = height;
+ }
+ dstLinePtr = (unsigned char *) imagePtr->data;
+ yEnd = yStart + nLines;
+ for (y = yStart; y < yEnd; ++y) {
+ srcPtr = srcLinePtr;
+ errPtr = errLinePtr;
+ destBytePtr = dstLinePtr;
+ destLongPtr = (pixel *) dstLinePtr;
+ if (colorPtr->flags & COLOR_WINDOW) {
+ /*
+ * Color window. We dither the three components
+ * independently, using Floyd-Steinberg dithering,
+ * which propagates errors from the quantization of
+ * pixels to the pixels below and to the right.
+ */
+
+ for (x = xStart; x < xEnd; ++x) {
+ if (doDithering) {
+ for (i = 0; i < 3; ++i) {
+ /*
+ * Compute the error propagated into this pixel
+ * for this component.
+ * If e[x,y] is the array of quantization error
+ * values, we compute
+ * 7/16 * e[x-1,y] + 1/16 * e[x-1,y-1]
+ * + 5/16 * e[x,y-1] + 3/16 * e[x+1,y-1]
+ * and round it to an integer.
+ *
+ * The expression ((c + 2056) >> 4) - 128
+ * computes round(c / 16), and works correctly on
+ * machines without a sign-extending right shift.
+ */
+
+ c = (x > 0) ? errPtr[-3] * 7: 0;
+ if (y > 0) {
+ if (x > 0) {
+ c += errPtr[-lineLength-3];
+ }
+ c += errPtr[-lineLength] * 5;
+ if ((x + 1) < masterPtr->width) {
+ c += errPtr[-lineLength+3] * 3;
+ }
+ }
+
+ /*
+ * Add the propagated error to the value of this
+ * component, quantize it, and store the
+ * quantization error.
+ */
+
+ c = ((c + 2056) >> 4) - 128 + *srcPtr++;
+ if (c < 0) {
+ c = 0;
+ } else if (c > 255) {
+ c = 255;
+ }
+ col[i] = colorPtr->colorQuant[i][c];
+ *errPtr++ = c - col[i];
+ }
+ } else {
+ /*
+ * Output is virtually continuous in this case,
+ * so don't bother dithering.
+ */
+
+ col[0] = *srcPtr++;
+ col[1] = *srcPtr++;
+ col[2] = *srcPtr++;
+ }
+ srcPtr++;
+
+ /*
+ * Translate the quantized component values into
+ * an X pixel value, and store it in the image.
+ */
+
+ i = colorPtr->redValues[col[0]]
+ + colorPtr->greenValues[col[1]]
+ + colorPtr->blueValues[col[2]];
+ if (colorPtr->flags & MAP_COLORS) {
+ i = colorPtr->pixelMap[i];
+ }
+ switch (bitsPerPixel) {
+ case NBBY:
+ *destBytePtr++ = i;
+ break;
+#ifndef __WIN32__
+/*
+ * This case is not valid for Windows because the image format is different
+ * from the pixel format in Win32. Eventually we need to fix the image
+ * code in Tk to use the Windows native image ordering. This would speed
+ * up the image code for all of the common sizes.
+ */
+
+ case NBBY * sizeof(pixel):
+ *destLongPtr++ = i;
+ break;
+#endif
+ default:
+ XPutPixel(imagePtr, x - xStart, y - yStart,
+ (unsigned) i);
+ }
+ }
+
+ } else if (bitsPerPixel > 1) {
+ /*
+ * Multibit monochrome window. The operation here is similar
+ * to the color window case above, except that there is only
+ * one component. If the master image is in color, use the
+ * luminance computed as
+ * 0.344 * red + 0.5 * green + 0.156 * blue.
+ */
+
+ for (x = xStart; x < xEnd; ++x) {
+ c = (x > 0) ? errPtr[-1] * 7: 0;
+ if (y > 0) {
+ if (x > 0) {
+ c += errPtr[-lineLength-1];
+ }
+ c += errPtr[-lineLength] * 5;
+ if (x + 1 < masterPtr->width) {
+ c += errPtr[-lineLength+1] * 3;
+ }
+ }
+ c = ((c + 2056) >> 4) - 128;
+
+ if ((masterPtr->flags & COLOR_IMAGE) == 0) {
+ c += srcPtr[0];
+ } else {
+ c += (unsigned)(srcPtr[0] * 11 + srcPtr[1] * 16
+ + srcPtr[2] * 5 + 16) >> 5;
+ }
+ srcPtr += 4;
+
+ if (c < 0) {
+ c = 0;
+ } else if (c > 255) {
+ c = 255;
+ }
+ i = colorPtr->colorQuant[0][c];
+ *errPtr++ = c - i;
+ i = colorPtr->redValues[i];
+ switch (bitsPerPixel) {
+ case NBBY:
+ *destBytePtr++ = i;
+ break;
+#ifndef __WIN32__
+/*
+ * This case is not valid for Windows because the image format is different
+ * from the pixel format in Win32. Eventually we need to fix the image
+ * code in Tk to use the Windows native image ordering. This would speed
+ * up the image code for all of the common sizes.
+ */
+
+ case NBBY * sizeof(pixel):
+ *destLongPtr++ = i;
+ break;
+#endif
+ default:
+ XPutPixel(imagePtr, x - xStart, y - yStart,
+ (unsigned) i);
+ }
+ }
+ } else {
+ /*
+ * 1-bit monochrome window. This is similar to the
+ * multibit monochrome case above, except that the
+ * quantization is simpler (we only have black = 0
+ * and white = 255), and we produce an XY-Bitmap.
+ */
+
+ word = 0;
+ mask = firstBit;
+ for (x = xStart; x < xEnd; ++x) {
+ /*
+ * If we have accumulated a whole word, store it
+ * in the image and start a new word.
+ */
+
+ if (mask == 0) {
+ *destLongPtr++ = word;
+ mask = firstBit;
+ word = 0;
+ }
+
+ c = (x > 0) ? errPtr[-1] * 7: 0;
+ if (y > 0) {
+ if (x > 0) {
+ c += errPtr[-lineLength-1];
+ }
+ c += errPtr[-lineLength] * 5;
+ if (x + 1 < masterPtr->width) {
+ c += errPtr[-lineLength+1] * 3;
+ }
+ }
+ c = ((c + 2056) >> 4) - 128;
+
+ if ((masterPtr->flags & COLOR_IMAGE) == 0) {
+ c += srcPtr[0];
+ } else {
+ c += (unsigned)(srcPtr[0] * 11 + srcPtr[1] * 16
+ + srcPtr[2] * 5 + 16) >> 5;
+ }
+ srcPtr += 4;
+
+ if (c < 0) {
+ c = 0;
+ } else if (c > 255) {
+ c = 255;
+ }
+ if (c >= 128) {
+ word |= mask;
+ *errPtr++ = c - 255;
+ } else {
+ *errPtr++ = c;
+ }
+ mask = bigEndian? (mask >> 1): (mask << 1);
+ }
+ *destLongPtr = word;
+ }
+ srcLinePtr += masterPtr->width * 4;
+ errLinePtr += lineLength;
+ dstLinePtr += bytesPerLine;
+ }
+
+ /*
+ * Update the pixmap for this instance with the block of
+ * pixels that we have just computed.
+ */
+
+ TkPutImage(colorPtr->pixelMap, colorPtr->numColors,
+ instancePtr->display, instancePtr->pixels,
+ instancePtr->gc, imagePtr, 0, 0, xStart, yStart,
+ (unsigned) width, (unsigned) nLines);
+ yStart = yEnd;
+
+ }
+
+ ckfree(imagePtr->data);
+ imagePtr->data = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoBlank --
+ *
+ * This procedure is called to clear an entire photo image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The valid region for the image is set to the null region.
+ * The generic image code is notified that the image has changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoBlank(handle)
+ Tk_PhotoHandle handle; /* Handle for the image to be blanked. */
+{
+ PhotoMaster *masterPtr;
+ PhotoInstance *instancePtr;
+
+ masterPtr = (PhotoMaster *) handle;
+ masterPtr->ditherX = masterPtr->ditherY = 0;
+ masterPtr->flags = 0;
+
+ /*
+ * The image has valid data nowhere.
+ */
+
+ if (masterPtr->validRegion != NULL) {
+ TkDestroyRegion(masterPtr->validRegion);
+ }
+ masterPtr->validRegion = TkCreateRegion();
+
+ /*
+ * Clear out the 24-bit pixel storage array.
+ * Clear out the dithering error arrays for each instance.
+ */
+
+ memset((VOID *) masterPtr->pix24, 0,
+ (size_t) (masterPtr->width * masterPtr->height * 4));
+ for (instancePtr = masterPtr->instancePtr; instancePtr != NULL;
+ instancePtr = instancePtr->nextPtr) {
+ if (instancePtr->error) {
+ memset((VOID *) instancePtr->error, 0,
+ (size_t) (masterPtr->width * masterPtr->height
+ * 3 * sizeof(schar)));
+ }
+ }
+
+ /*
+ * Tell the core image code that this image has changed.
+ */
+
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, masterPtr->width,
+ masterPtr->height, masterPtr->width, masterPtr->height);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoExpand --
+ *
+ * This procedure is called to request that a photo image be
+ * expanded if necessary to be at least `width' pixels wide and
+ * `height' pixels high. If the user has declared a definite
+ * image size (using the -width and -height configuration
+ * options) then this call has no effect.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size of the photo image may change; if so the generic
+ * image code is informed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoExpand(handle, width, height)
+ Tk_PhotoHandle handle; /* Handle for the image to be expanded. */
+ int width, height; /* Desired minimum dimensions of the image. */
+{
+ PhotoMaster *masterPtr;
+
+ masterPtr = (PhotoMaster *) handle;
+
+ if (width <= masterPtr->width) {
+ width = masterPtr->width;
+ }
+ if (height <= masterPtr->height) {
+ height = masterPtr->height;
+ }
+ if ((width != masterPtr->width) || (height != masterPtr->height)) {
+ ImgPhotoSetSize(masterPtr, MAX(width, masterPtr->width),
+ MAX(height, masterPtr->height));
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0, masterPtr->width,
+ masterPtr->height);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoGetSize --
+ *
+ * This procedure is called to obtain the current size of a photo
+ * image.
+ *
+ * Results:
+ * The image's width and height are returned in *widthp
+ * and *heightp.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoGetSize(handle, widthPtr, heightPtr)
+ Tk_PhotoHandle handle; /* Handle for the image whose dimensions
+ * are requested. */
+ int *widthPtr, *heightPtr; /* The dimensions of the image are returned
+ * here. */
+{
+ PhotoMaster *masterPtr;
+
+ masterPtr = (PhotoMaster *) handle;
+ *widthPtr = masterPtr->width;
+ *heightPtr = masterPtr->height;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoSetSize --
+ *
+ * This procedure is called to set size of a photo image.
+ * This call is equivalent to using the -width and -height
+ * configuration options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size of the image may change; if so the generic
+ * image code is informed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PhotoSetSize(handle, width, height)
+ Tk_PhotoHandle handle; /* Handle for the image whose size is to
+ * be set. */
+ int width, height; /* New dimensions for the image. */
+{
+ PhotoMaster *masterPtr;
+
+ masterPtr = (PhotoMaster *) handle;
+
+ masterPtr->userWidth = width;
+ masterPtr->userHeight = height;
+ ImgPhotoSetSize(masterPtr, ((width > 0) ? width: masterPtr->width),
+ ((height > 0) ? height: masterPtr->height));
+ Tk_ImageChanged(masterPtr->tkMaster, 0, 0, 0, 0,
+ masterPtr->width, masterPtr->height);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgGetPhoto --
+ *
+ * This procedure is called to obtain image data from a photo
+ * image. This procedure fills in the Tk_PhotoImageBlock structure
+ * pointed to by `blockPtr' with details of the address and
+ * layout of the image data in memory.
+ *
+ * Results:
+ * A pointer to the allocated data which should be freed later.
+ * NULL if there is no need to free data because
+ * blockPtr->pixelPtr points directly to the image data.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+ImgGetPhoto(masterPtr, blockPtr, optPtr)
+ PhotoMaster *masterPtr; /* Handle for the photo image from which
+ * image data is desired. */
+ Tk_PhotoImageBlock *blockPtr;
+ /* Information about the address and layout
+ * of the image data is returned here. */
+ struct SubcommandOptions *optPtr;
+{
+ unsigned char *pixelPtr;
+ int x, y, greenOffset, blueOffset, alphaOffset;
+
+ Tk_PhotoGetImage((Tk_PhotoHandle) masterPtr, blockPtr);
+ blockPtr->pixelPtr += optPtr->fromY * blockPtr->pitch
+ + optPtr->fromX * blockPtr->pixelSize;
+ blockPtr->width = optPtr->fromX2 - optPtr->fromX;
+ blockPtr->height = optPtr->fromY2 - optPtr->fromY;
+
+ if (!(masterPtr->flags & COLOR_IMAGE) &&
+ (!(optPtr->options & OPT_BACKGROUND)
+ || ((optPtr->background->red == optPtr->background->green)
+ && (optPtr->background->red == optPtr->background->blue)))) {
+ blockPtr->offset[0] = blockPtr->offset[1] =
+ blockPtr->offset[2];
+ }
+ alphaOffset = 0;
+ for (y = 0; y < blockPtr->height; y++) {
+ pixelPtr = blockPtr->pixelPtr + (y * blockPtr->pitch)
+ + blockPtr->pixelSize - 1;
+ for (x = 0; x < blockPtr->width; x++) {
+ if (*pixelPtr != 255) {
+ alphaOffset = 3; break;
+ }
+ pixelPtr += blockPtr->pixelSize;
+ }
+ if (alphaOffset) break;
+ }
+ if (!alphaOffset) {
+ blockPtr->pixelPtr--;
+ blockPtr->offset[0]++;
+ blockPtr->offset[1]++;
+ blockPtr->offset[2]++;
+ }
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+ if (((optPtr->options & OPT_BACKGROUND) && alphaOffset) ||
+ ((optPtr->options & OPT_GRAYSCALE) && (greenOffset || blueOffset))) {
+ int newPixelSize,x,y;
+ unsigned char *srcPtr, *destPtr;
+ char *data;
+
+ newPixelSize = (!(optPtr->options & OPT_BACKGROUND) && alphaOffset) ? 2 : 1;
+ if ((greenOffset || blueOffset) && !(optPtr->options & OPT_GRAYSCALE)) {
+ newPixelSize += 2;
+ }
+ data = ckalloc(newPixelSize * blockPtr->width * blockPtr->height);
+ srcPtr = blockPtr->pixelPtr + blockPtr->offset[0];
+ destPtr = (unsigned char *) data;
+ if (!greenOffset && !blueOffset) {
+ for (y = blockPtr->height; y > 0; y--) {
+ for (x = blockPtr->width; x > 0; x--) {
+ *destPtr = *srcPtr;
+ srcPtr += blockPtr->pixelSize;
+ destPtr += newPixelSize;
+ }
+ srcPtr += blockPtr->pitch - (blockPtr->width * blockPtr->pixelSize);
+ }
+ } else if (optPtr->options & OPT_GRAYSCALE) {
+ for (y = blockPtr->height; y > 0; y--) {
+ for (x = blockPtr->width; x > 0; x--) {
+ *destPtr = (unsigned char) ((srcPtr[0] * 11 + srcPtr[1] * 16
+ + srcPtr[2] * 5 + 16) >> 5);
+ srcPtr += blockPtr->pixelSize;
+ destPtr += newPixelSize;
+ }
+ srcPtr += blockPtr->pitch - (blockPtr->width * blockPtr->pixelSize);
+ }
+ } else {
+ for (y = blockPtr->height; y > 0; y--) {
+ for (x = blockPtr->width; x > 0; x--) {
+ destPtr[0] = srcPtr[0];
+ destPtr[1] = srcPtr[1];
+ destPtr[2] = srcPtr[2];
+ srcPtr += blockPtr->pixelSize;
+ destPtr += newPixelSize;
+ }
+ srcPtr += blockPtr->pitch - (blockPtr->width * blockPtr->pixelSize);
+ }
+ }
+ srcPtr = blockPtr->pixelPtr + alphaOffset;
+ destPtr = (unsigned char *) data;
+ if (!alphaOffset) {
+ /* nothing to be done */
+ } else if (optPtr->options & OPT_BACKGROUND) {
+ if (newPixelSize > 2) {
+ int red = optPtr->background->red>>8;
+ int green = optPtr->background->green>>8;
+ int blue = optPtr->background->blue>>8;
+ for (y = blockPtr->height; y > 0; y--) {
+ for (x = blockPtr->width; x > 0; x--) {
+ destPtr[0] += (unsigned char) (((255 - *srcPtr) *
+ (red-destPtr[0])) / 255);
+ destPtr[1] += (unsigned char) (((255 - *srcPtr) *
+ (green-destPtr[1])) / 255);
+ destPtr[2] += (unsigned char) (((255 - *srcPtr) *
+ (blue-destPtr[2])) / 255);
+ srcPtr += blockPtr->pixelSize;
+ destPtr += newPixelSize;
+ }
+ srcPtr += blockPtr->pitch - (blockPtr->width * blockPtr->pixelSize);
+ }
+ } else {
+ int gray = (unsigned char) (((optPtr->background->red>>8) * 11
+ + (optPtr->background->green>>8) * 16
+ + (optPtr->background->blue>>8) * 5 + 16) >> 5);
+ for (y = blockPtr->height; y > 0; y--) {
+ for (x = blockPtr->width; x > 0; x--) {
+ destPtr[0] += ((255 - *srcPtr) *
+ (gray-destPtr[0])) / 255;
+ srcPtr += blockPtr->pixelSize;
+ destPtr += newPixelSize;
+ }
+ srcPtr += blockPtr->pitch - (blockPtr->width * blockPtr->pixelSize);
+ }
+ }
+ } else {
+ destPtr += newPixelSize-1;
+ for (y = blockPtr->height; y > 0; y--) {
+ for (x = blockPtr->width; x > 0; x--) {
+ *destPtr = *srcPtr;
+ srcPtr += blockPtr->pixelSize;
+ destPtr += newPixelSize;
+ }
+ srcPtr += blockPtr->pitch - (blockPtr->width * blockPtr->pixelSize);
+ }
+ }
+ blockPtr->pixelPtr = (unsigned char *) data;
+ blockPtr->pixelSize = newPixelSize;
+ blockPtr->pitch = newPixelSize * blockPtr->width;
+ blockPtr->offset[0] = 0;
+ if (newPixelSize>2) {
+ blockPtr->offset[1]= 1;
+ blockPtr->offset[2]= 2;
+ } else {
+ blockPtr->offset[1]= 0;
+ blockPtr->offset[2]= 0;
+ }
+ return data;
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImgStringWrite --
+ *
+ * Default string write function. The data is formatted in
+ * the default format as accepted by the "<img> put" command.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ImgStringWrite (interp, dataPtr, formatString, blockPtr)
+ Tcl_Interp *interp;
+ Tcl_DString *dataPtr;
+ char *formatString;
+ Tk_PhotoImageBlock *blockPtr;
+{
+ int row,col;
+ char *line, *linePtr;
+ unsigned char *pixelPtr;
+ int greenOffset, blueOffset;
+
+ greenOffset = blockPtr->offset[1] - blockPtr->offset[0];
+ blueOffset = blockPtr->offset[2] - blockPtr->offset[0];
+
+ if ((blockPtr->width > 0) && (blockPtr->height > 0)) {
+ line = (char *) ckalloc(8 * blockPtr->width + 2);
+ for (row=0; row<blockPtr->height; row++) {
+ pixelPtr = blockPtr->pixelPtr + blockPtr->offset[0] +
+ row * blockPtr->pitch;
+ linePtr = line;
+ for (col=0; col<blockPtr->width; col++) {
+ sprintf(linePtr, " #%02x%02x%02x", *pixelPtr,
+ pixelPtr[greenOffset], pixelPtr[blueOffset]);
+ pixelPtr += blockPtr->pixelSize;
+ linePtr += 8;
+ }
+ Tcl_DStringAppendElement(dataPtr, line+1);
+ }
+ ckfree (line);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PhotoGetImage --
+ *
+ * This procedure is called to obtain image data from a photo
+ * image. This procedure fills in the Tk_PhotoImageBlock structure
+ * pointed to by `blockPtr' with details of the address and
+ * layout of the image data in memory.
+ *
+ * Results:
+ * TRUE (1) indicating that image data is available,
+ * for backwards compatibility with the old photo widget.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_PhotoGetImage(handle, blockPtr)
+ Tk_PhotoHandle handle; /* Handle for the photo image from which
+ * image data is desired. */
+ Tk_PhotoImageBlock *blockPtr;
+ /* Information about the address and layout
+ * of the image data is returned here. */
+{
+ PhotoMaster *masterPtr;
+
+ masterPtr = (PhotoMaster *) handle;
+ blockPtr->pixelPtr = masterPtr->pix24;
+ blockPtr->width = masterPtr->width;
+ blockPtr->height = masterPtr->height;
+ blockPtr->pitch = masterPtr->width * 4;
+ blockPtr->pixelSize = 4;
+ blockPtr->offset[0] = 0;
+ blockPtr->offset[1] = 1;
+ blockPtr->offset[2] = 2;
+ return 1;
+}
diff --git a/tk/generic/tkImgUtil.c b/tk/generic/tkImgUtil.c
new file mode 100644
index 00000000000..b865c9ca18f
--- /dev/null
+++ b/tk/generic/tkImgUtil.c
@@ -0,0 +1,78 @@
+/*
+ * 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$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+#include "xbytes.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkAlignImageData --
+ *
+ * This function takes an image and copies the data into an
+ * aligned buffer, performing any necessary bit swapping.
+ *
+ * Results:
+ * Returns a newly allocated buffer that should be freed by the
+ * caller.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkAlignImageData(image, alignment, bitOrder)
+ XImage *image; /* Image to be aligned. */
+ int alignment; /* Number of bytes to which the data should
+ * be aligned (e.g. 2 or 4) */
+ int bitOrder; /* Desired bit order: LSBFirst or MSBFirst. */
+{
+ long dataWidth;
+ char *data, *srcPtr, *destPtr;
+ int i, j;
+
+ if (image->bits_per_pixel != 1) {
+ panic("TkAlignImageData: Can't handle image depths greater than 1.");
+ }
+
+ /*
+ * Compute line width for output data buffer.
+ */
+
+ dataWidth = image->bytes_per_line;
+ if (dataWidth % alignment) {
+ dataWidth += (alignment - (dataWidth % alignment));
+ }
+
+ data = ckalloc(dataWidth * image->height);
+
+ destPtr = data;
+ for (i = 0; i < image->height; i++) {
+ srcPtr = &image->data[i * image->bytes_per_line];
+ for (j = 0; j < dataWidth; j++) {
+ if (j >= image->bytes_per_line) {
+ *destPtr = 0;
+ } else if (image->bitmap_bit_order != bitOrder) {
+ *destPtr = xBitReverseTable[(unsigned char)(*(srcPtr++))];
+ } else {
+ *destPtr = *(srcPtr++);
+ }
+ destPtr++;
+ }
+ }
+ return data;
+}
diff --git a/tk/generic/tkInitScript.h b/tk/generic/tkInitScript.h
new file mode 100644
index 00000000000..959ebea448d
--- /dev/null
+++ b/tk/generic/tkInitScript.h
@@ -0,0 +1,56 @@
+/*
+ * 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$
+ */
+
+/*
+ * 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";
+
diff --git a/tk/generic/tkInt.h b/tk/generic/tkInt.h
new file mode 100644
index 00000000000..359b6c99150
--- /dev/null
+++ b/tk/generic/tkInt.h
@@ -0,0 +1,994 @@
+/*
+ * 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$
+ */
+
+#ifndef _TKINT
+#define _TKINT
+
+#ifndef _TK
+#include "tk.h"
+#endif
+#ifndef _TCL
+#include "tcl.h"
+#endif
+#ifndef _TKPORT
+#include <tkPort.h>
+#endif
+
+#ifdef BUILD_tk
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLEXPORT
+#endif
+
+/*
+ * Opaque type declarations:
+ */
+
+typedef struct TkColormap TkColormap;
+typedef struct TkGrabEvent TkGrabEvent;
+typedef struct Tk_PostscriptInfo Tk_PostscriptInfo;
+typedef struct TkpCursor_ *TkpCursor;
+typedef struct TkRegion_ *TkRegion;
+typedef struct TkStressedCmap TkStressedCmap;
+typedef struct TkBindInfo_ *TkBindInfo;
+
+/*
+ * Procedure types.
+ */
+
+typedef int (TkBindEvalProc) _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, XEvent *eventPtr, Tk_Window tkwin,
+ KeySym keySym));
+typedef void (TkBindFreeProc) _ANSI_ARGS_((ClientData clientData));
+typedef Window (TkClassCreateProc) _ANSI_ARGS_((Tk_Window tkwin,
+ Window parent, ClientData instanceData));
+typedef void (TkClassGeometryProc) _ANSI_ARGS_((ClientData instanceData));
+typedef void (TkClassModalProc) _ANSI_ARGS_((Tk_Window tkwin,
+ XEvent *eventPtr));
+
+
+/*
+ * Widget class procedures used to implement platform specific widget
+ * behavior.
+ */
+
+typedef struct TkClassProcs {
+ TkClassCreateProc *createProc;
+ /* Procedure to invoke when the
+ platform-dependent window needs to be
+ created. */
+ TkClassGeometryProc *geometryProc;
+ /* Procedure to invoke when the geometry of a
+ window needs to be recalculated as a result
+ of some change in the system. */
+ TkClassModalProc *modalProc;
+ /* Procedure to invoke after all bindings on a
+ widget have been triggered in order to
+ handle a modal loop. */
+} TkClassProcs;
+
+/*
+ * 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. */
+ unsigned int modeModMask; /* Has one bit set to indicate the modifier
+ * corresponding to "mode shift". If no
+ * such modifier, than this is zero. */
+ unsigned int metaModMask; /* Has one bit set to indicate the modifier
+ * corresponding to the "Meta" key. If no
+ * such modifier, then this is zero. */
+ unsigned int altModMask; /* Has one bit set to indicate the modifier
+ * corresponding to the "Meta" key. If no
+ * such modifier, then this is zero. */
+ enum {LU_IGNORE, LU_CAPS, LU_SHIFT} lockUsage;
+ /* Indicates how to interpret lock modifier. */
+ 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
+ * grabbed, or NULL if none. */
+ struct TkWindow *eventualGrabWinPtr;
+ /* Value that grabWinPtr will have once the
+ * grab event queue (below) has been
+ * completely emptied. */
+ struct TkWindow *buttonWinPtr;
+ /* Window in which first mouse button was
+ * pressed while grab was in effect, or NULL
+ * if no such press in effect. */
+ struct TkWindow *serverWinPtr;
+ /* If no application contains the pointer then
+ * this is NULL. Otherwise it contains the
+ * last window for which we've gotten an
+ * Enter or Leave event from the server (i.e.
+ * the last window known to have contained
+ * the pointer). Doesn't reflect events
+ * that were synthesized in tkGrab.c. */
+ TkGrabEvent *firstGrabEventPtr;
+ /* First in list of enter/leave events
+ * synthesized by grab code. These events
+ * must be processed in order before any other
+ * events are processed. NULL means no such
+ * 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 */
+ Tcl_HashTable winTable; /* Maps from X window ids to TkWindow ptrs. */
+
+ int refCount; /* Reference count of how many Tk applications
+ * are using this display. Used to clean up
+ * the display when we no longer have any
+ * Tk applications using it.
+ */
+} TkDisplay;
+
+/*
+ * One of the following structures exists for each error handler
+ * created by a call to Tk_CreateErrorHandler. The structure
+ * is managed by tkError.c.
+ */
+
+typedef struct TkErrorHandler {
+ TkDisplay *dispPtr; /* Display to which handler applies. */
+ unsigned long firstRequest; /* Only errors with serial numbers
+ * >= to this are considered. */
+ unsigned long lastRequest; /* Only errors with serial numbers
+ * <= to this are considered. This
+ * field is filled in when XUnhandle
+ * is called. -1 means XUnhandle
+ * hasn't been called yet. */
+ int error; /* Consider only errors with this
+ * error_code (-1 means consider
+ * all errors). */
+ int request; /* Consider only errors with this
+ * major request code (-1 means
+ * consider all major codes). */
+ int minorCode; /* Consider only errors with this
+ * minor request code (-1 means
+ * consider all minor codes). */
+ Tk_ErrorProc *errorProc; /* Procedure to invoke when a matching
+ * error occurs. NULL means just ignore
+ * errors. */
+ 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.
+ */
+
+typedef struct TkEventHandler {
+ unsigned long mask; /* Events for which to invoke
+ * proc. */
+ Tk_EventProc *proc; /* Procedure to invoke when an event
+ * in mask occurs. */
+ ClientData clientData; /* Argument to pass to proc. */
+ struct TkEventHandler *nextPtr;
+ /* Next in list of handlers
+ * associated with window (NULL means
+ * end of list). */
+} TkEventHandler;
+
+/*
+ * Tk keeps one of the following data structures for each main
+ * window (created by a call to Tk_CreateMainWindow). It stores
+ * information that is shared by all of the windows associated
+ * with a particular main window.
+ */
+
+typedef struct TkMainInfo {
+ int refCount; /* Number of windows whose "mainPtr" fields
+ * point here. When this becomes zero, can
+ * free up the structure (the reference
+ * count is zero because windows can get
+ * deleted in almost any order; the main
+ * window isn't necessarily the last one
+ * deleted). */
+ struct TkWindow *winPtr; /* Pointer to main window. */
+ Tcl_Interp *interp; /* Interpreter associated with application. */
+ 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
+ * information for each top-level in the
+ * application. Used only by tkFocus.c. */
+ struct TkDisplayFocusInfo *displayFocusPtr;
+ /* First in list of records containing focus
+ * information for each display that this
+ * application has ever used. Used only
+ * by tkFocus.c. */
+
+ struct ElArray *optionRootPtr;
+ /* Top level of option hierarchy for this
+ * main window. NULL means uninitialized.
+ * Managed by tkOption.c. */
+ Tcl_HashTable imageTable; /* Maps from image names to Tk_ImageMaster
+ * structures. Managed by tkImage.c. */
+ int strictMotif; /* This is linked to the tk_strictMotif
+ * global variable. */
+ struct TkMainInfo *nextPtr; /* Next in list of all main windows managed by
+ * this process. */
+} TkMainInfo;
+
+/*
+ * Tk keeps the following data structure for each of it's builtin
+ * bitmaps. This structure is only used by tkBitmap.c and other
+ * platform specific bitmap files.
+ */
+
+typedef struct {
+ char *source; /* Bits for bitmap. */
+ int width, height; /* Dimensions of bitmap. */
+ int native; /* 0 means generic (X style) bitmap,
+ * 1 means native style bitmap. */
+} TkPredefBitmap;
+
+/*
+ * Tk keeps one of the following structures for each window.
+ * Some of the information (like size and location) is a shadow
+ * of information managed by the X server, and some is special
+ * information used here, such as event and geometry management
+ * information. This information is (mostly) managed by tkWindow.c.
+ * WARNING: the declaration below must be kept consistent with the
+ * Tk_FakeWin structure in tk.h. If you change one, be sure to
+ * change the other!!
+ */
+
+typedef struct TkWindow {
+
+ /*
+ * Structural information:
+ */
+
+ Display *display; /* Display containing window. */
+ TkDisplay *dispPtr; /* Tk's information about display
+ * for window. */
+ int screenNum; /* Index of screen for window, among all
+ * those for dispPtr. */
+ Visual *visual; /* Visual to use for window. If not default,
+ * MUST be set before X window is created. */
+ int depth; /* Number of bits/pixel. */
+ Window window; /* X's id for window. NULL means window
+ * hasn't actually been created yet, or it's
+ * been deleted. */
+ struct TkWindow *childList; /* First in list of child windows,
+ * or NULL if no children. List is in
+ * stacking order, lowest window first.*/
+ struct TkWindow *lastChildPtr;
+ /* Last in list of child windows (highest
+ * in stacking order), or NULL if no
+ * children. */
+ struct TkWindow *parentPtr; /* Pointer to parent window (logical
+ * parent, not necessarily X parent). NULL
+ * means either this is the main window, or
+ * the window's parent has already been
+ * deleted. */
+ struct TkWindow *nextPtr; /* Next higher sibling (in stacking order)
+ * in list of children with same parent. NULL
+ * means end of list. */
+ TkMainInfo *mainPtr; /* Information shared by all windows
+ * associated with a particular main
+ * window. NULL means this window is
+ * a rogue that isn't associated with
+ * any application (at present, this
+ * only happens for the dummy windows
+ * used for "send" communication). */
+
+ /*
+ * Name and type information for the window:
+ */
+
+ char *pathName; /* Path name of window (concatenation
+ * of all names between this window and
+ * its top-level ancestor). This is a
+ * pointer into an entry in
+ * mainPtr->nameTable. NULL means that
+ * the window hasn't been completely
+ * created yet. */
+ Tk_Uid nameUid; /* Name of the window within its parent
+ * (unique within the parent). */
+ Tk_Uid classUid; /* Class of the window. NULL means window
+ * hasn't been given a class yet. */
+
+ /*
+ * Geometry and other attributes of window. This information
+ * may not be updated on the server immediately; stuff that
+ * hasn't been reflected in the server yet is called "dirty".
+ * At present, information can be dirty only if the window
+ * hasn't yet been created.
+ */
+
+ XWindowChanges changes; /* Geometry and other info about
+ * window. */
+ unsigned int dirtyChanges; /* Bits indicate fields of "changes"
+ * that are dirty. */
+ XSetWindowAttributes atts; /* Current attributes of window. */
+ unsigned long dirtyAtts; /* Bits indicate fields of "atts"
+ * that are dirty. */
+
+ unsigned int flags; /* Various flag values: these are all
+ * defined in tk.h (confusing, but they're
+ * needed there for some query macros). */
+
+ /*
+ * Information kept by the event manager (tkEvent.c):
+ */
+
+ TkEventHandler *handlerList;/* First in list of event handlers
+ * declared for this window, or
+ * NULL if none. */
+#ifdef TK_USE_INPUT_METHODS
+ XIC inputContext; /* Input context (for input methods). */
+#endif /* TK_USE_INPUT_METHODS */
+
+ /*
+ * Information used for event bindings (see "bind" and "bindtags"
+ * commands in tkCmds.c):
+ */
+
+ ClientData *tagPtr; /* Points to array of tags used for bindings
+ * on this window. Each tag is a Tk_Uid.
+ * Malloc'ed. NULL means no tags. */
+ int numTags; /* Number of tags at *tagPtr. */
+
+ /*
+ * Information used by tkOption.c to manage options for the
+ * window.
+ */
+
+ int optionLevel; /* -1 means no option information is
+ * currently cached for this window.
+ * Otherwise this gives the level in
+ * the option stack at which info is
+ * cached. */
+ /*
+ * Information used by tkSelect.c to manage the selection.
+ */
+
+ struct TkSelHandler *selHandlerList;
+ /* First in list of handlers for
+ * returning the selection in various
+ * forms. */
+
+ /*
+ * Information used by tkGeometry.c for geometry management.
+ */
+
+ Tk_GeomMgr *geomMgrPtr; /* Information about geometry manager for
+ * this window. */
+ ClientData geomData; /* Argument for geometry manager procedures. */
+ int reqWidth, reqHeight; /* Arguments from last call to
+ * Tk_GeometryRequest, or 0's if
+ * Tk_GeometryRequest hasn't been
+ * called. */
+ int internalBorderWidth; /* Width of internal border of window
+ * (0 means no internal border). Geometry
+ * managers should not normally place children
+ * on top of the border. */
+
+ /*
+ * Information maintained by tkWm.c for window manager communication.
+ */
+
+ struct TkWmInfo *wmInfoPtr; /* For top-level windows (and also
+ * for special Unix menubar and wrapper
+ * windows), points to structure with
+ * wm-related info (see tkWm.c). For
+ * other windows, this is NULL. */
+
+ /*
+ * Information used by widget classes.
+ */
+
+ TkClassProcs *classProcsPtr;
+ ClientData instanceData;
+
+ /*
+ * Platform specific information private to each port.
+ */
+
+ struct TkWindowPrivate *privatePtr;
+} TkWindow;
+
+/*
+ * The following structure is used as a two way map between integers
+ * and strings, usually to map between an internal C representation
+ * and the strings used in Tcl.
+ */
+
+typedef struct TkStateMap {
+ int numKey; /* Integer representation of a value. */
+ char *strKey; /* String representation of a value. */
+} TkStateMap;
+
+/*
+ * This structure is used by the Mac and Window porting layers as
+ * the internal representation of a clip_mask in a GC.
+ */
+
+typedef struct TkpClipMask {
+ int type; /* One of TKP_CLIP_PIXMAP or TKP_CLIP_REGION */
+ union {
+ Pixmap pixmap;
+ TkRegion region;
+ } value;
+} TkpClipMask;
+
+#define TKP_CLIP_PIXMAP 0
+#define TKP_CLIP_REGION 1
+
+/*
+ * Pointer to first entry in list of all displays currently known.
+ */
+
+extern TkDisplay *tkDisplayList;
+
+/*
+ * Return values from TkGrabState:
+ */
+
+#define TK_GRAB_NONE 0
+#define TK_GRAB_IN_TREE 1
+#define TK_GRAB_ANCESTOR 2
+#define TK_GRAB_EXCLUDED 3
+
+/*
+ * The macro below is used to modify a "char" value (e.g. by casting
+ * it to an unsigned character) so that it can be used safely with
+ * macros such as isspace.
+ */
+
+#define UCHAR(c) ((unsigned char) (c))
+
+/*
+ * The following symbol is used in the mode field of FocusIn events
+ * generated by an embedded application to request the input focus from
+ * its container.
+ */
+
+#define EMBEDDED_APP_WANTS_FOCUS (NotifyNormal + 20)
+
+/*
+ * Miscellaneous variables shared among Tk modules but not exported
+ * to the outside world:
+ */
+
+extern Tk_Uid tkActiveUid;
+extern Tk_ImageType tkBitmapImageType;
+extern Tk_Uid tkDisabledUid;
+extern Tk_PhotoImageFormat tkImgFmtGIF;
+extern void (*tkHandleEventProc) _ANSI_ARGS_((
+ XEvent* eventPtr));
+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 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 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[]));
+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 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 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));
+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));
+#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));
+
+/*
+ * Unsupported commands.
+ */
+EXTERN int TkUnsupported1Cmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+
+/* CYGNUS LOCAL. */
+EXTERN void TkRegisterColorGC _ANSI_ARGS_((XColor *, Display *,
+ GC, unsigned long));
+EXTERN void TkDeregisterColorGC _ANSI_ARGS_((XColor *, GC,
+ unsigned long));
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+
+#endif /* _TKINT */
diff --git a/tk/generic/tkListbox.c b/tk/generic/tkListbox.c
new file mode 100644
index 00000000000..9e32979956c
--- /dev/null
+++ b/tk/generic/tkListbox.c
@@ -0,0 +1,2337 @@
+/*
+ * 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$
+ */
+
+#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
+ * listbox, or NULL for last element. */
+ char text[4]; /* Characters of this element, NULL-
+ * terminated. The actual space allocated
+ * here will be as large as needed (> 4,
+ * most likely). Must be the last field
+ * of the record. */
+} Element;
+
+#define ElementSize(stringLength) \
+ ((unsigned) (sizeof(Element) - 3 + stringLength))
+
+/*
+ * A data structure of the following type is kept for each listbox
+ * widget managed by this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the listbox. 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 listbox. */
+ Tcl_Command widgetCmd; /* Token for listbox's widget command. */
+ int numElements; /* Total number of elements in this listbox. */
+ Element *firstPtr; /* First in list of elements (NULL if no
+ * elements). */
+ Element *lastPtr; /* Last in list of elements (NULL if no
+ * elements). */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ Tk_3DBorder normalBorder; /* Used for drawing border around whole
+ * window, plus used for background. */
+ int borderWidth; /* Width of 3-D border around window. */
+ 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. */
+ 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. */
+ Tk_Font tkfont; /* Information about text font, or NULL. */
+ XColor *fgColorPtr; /* Text color in normal mode. */
+ GC textGC; /* For drawing normal text. */
+ Tk_3DBorder selBorder; /* Borders and backgrounds for selected
+ * elements. */
+ int selBorderWidth; /* Width of border around selection. */
+ XColor *selFgColorPtr; /* Foreground color for selected elements. */
+ GC selTextGC; /* For drawing selected text. */
+ int width; /* Desired width of window, in characters. */
+ int height; /* Desired height of window, in lines. */
+ int lineHeight; /* Number of pixels allocated for each line
+ * in display. */
+ int topIndex; /* Index of top-most element visible in
+ * window. */
+ int fullLines; /* Number of lines that fit are completely
+ * visible in window. There may be one
+ * additional line at the bottom that is
+ * partially visible. */
+ int partialLine; /* 0 means that the window holds exactly
+ * fullLines lines. 1 means that there is
+ * one additional line that is partially
+ * visble. */
+ int setGrid; /* Non-zero means pass gridding information
+ * to window manager. */
+
+ /*
+ * Information to support horizontal scrolling:
+ */
+
+ int maxWidth; /* Width (in pixels) of widest string in
+ * listbox. */
+ int xScrollUnit; /* Number of pixels in one "unit" for
+ * horizontal scrolling (window scrolls
+ * horizontally in increments of this size).
+ * This is an average character size. */
+ int xOffset; /* The left edge of each string in the
+ * listbox is offset to the left by this
+ * many pixels (0 means no offset, positive
+ * means there is an offset). */
+
+ /*
+ * Information about what's selected or active, if any.
+ */
+
+ Tk_Uid selectMode; /* Selection style: single, browse, multiple,
+ * or extended. This value isn't used in C
+ * code, but the Tcl bindings use it. */
+ int numSelected; /* Number of elements currently selected. */
+ int selectAnchor; /* Fixed end of selection (i.e. element
+ * at which selection was started.) */
+ int exportSelection; /* Non-zero means tie internal listbox
+ * to X selection. */
+ int active; /* Index of "active" element (the one that
+ * has been selected by keyboard traversal).
+ * -1 means none. */
+
+ /*
+ * Information for scanning:
+ */
+
+ int scanMarkX; /* X-position at which scan started (e.g.
+ * button was pressed here). */
+ int scanMarkY; /* Y-position at which scan started (e.g.
+ * button was pressed here). */
+ int scanMarkXOffset; /* Value of "xOffset" field when scan
+ * started. */
+ int scanMarkYIndex; /* Index of line that was at top of window
+ * when scan started. */
+
+ /*
+ * 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 *yScrollCmd; /* Command prefix for communicating with
+ * vertical scrollbar. NULL means no command
+ * to issue. Malloc'ed. */
+ char *xScrollCmd; /* Command prefix for communicating with
+ * horizontal scrollbar. NULL means no command
+ * to issue. Malloc'ed. */
+ int flags; /* Various flag bits: see below for
+ * definitions. */
+} Listbox;
+
+/*
+ * Flag bits for listboxes:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler
+ * has already been queued to redraw
+ * this window.
+ * UPDATE_V_SCROLLBAR: Non-zero means vertical scrollbar needs
+ * to be updated.
+ * UPDATE_H_SCROLLBAR: Non-zero means horizontal scrollbar needs
+ * to be updated.
+ * GOT_FOCUS: Non-zero means this widget currently
+ * has the input focus.
+ */
+
+#define REDRAW_PENDING 1
+#define UPDATE_V_SCROLLBAR 2
+#define UPDATE_H_SCROLLBAR 4
+#define GOT_FOCUS 8
+
+/*
+ * Information used for argv parsing:
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_LISTBOX_BG_COLOR, Tk_Offset(Listbox, normalBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_LISTBOX_BG_MONO, Tk_Offset(Listbox, 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_LISTBOX_BORDER_WIDTH, Tk_Offset(Listbox, borderWidth), 0},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_LISTBOX_CURSOR, Tk_Offset(Listbox, cursor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", DEF_LISTBOX_EXPORT_SELECTION,
+ Tk_Offset(Listbox, exportSelection), 0},
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_LISTBOX_FONT, Tk_Offset(Listbox, tkfont), 0},
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_LISTBOX_FG, Tk_Offset(Listbox, fgColorPtr), 0},
+ {TK_CONFIG_INT, "-height", "height", "Height",
+ DEF_LISTBOX_HEIGHT, Tk_Offset(Listbox, height), 0},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_LISTBOX_HIGHLIGHT_BG,
+ Tk_Offset(Listbox, highlightBgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_LISTBOX_HIGHLIGHT, Tk_Offset(Listbox, highlightColorPtr), 0},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_LISTBOX_HIGHLIGHT_WIDTH, Tk_Offset(Listbox, highlightWidth), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_LISTBOX_RELIEF, Tk_Offset(Listbox, relief), 0},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_LISTBOX_SELECT_COLOR, Tk_Offset(Listbox, selBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_LISTBOX_SELECT_MONO, Tk_Offset(Listbox, selBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_PIXELS, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
+ DEF_LISTBOX_SELECT_BD, Tk_Offset(Listbox, selBorderWidth), 0},
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_LISTBOX_SELECT_FG_COLOR, Tk_Offset(Listbox, selFgColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_LISTBOX_SELECT_FG_MONO, Tk_Offset(Listbox, selFgColorPtr),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_UID, "-selectmode", "selectMode", "SelectMode",
+ DEF_LISTBOX_SELECT_MODE, Tk_Offset(Listbox, selectMode), 0},
+ {TK_CONFIG_BOOLEAN, "-setgrid", "setGrid", "SetGrid",
+ DEF_LISTBOX_SET_GRID, Tk_Offset(Listbox, setGrid), 0},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_LISTBOX_TAKE_FOCUS, Tk_Offset(Listbox, takeFocus),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_INT, "-width", "width", "Width",
+ DEF_LISTBOX_WIDTH, Tk_Offset(Listbox, width), 0},
+ {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_LISTBOX_SCROLL_COMMAND, Tk_Offset(Listbox, xScrollCmd),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ DEF_LISTBOX_SCROLL_COMMAND, Tk_Offset(Listbox, yScrollCmd),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void ChangeListboxOffset _ANSI_ARGS_((Listbox *listPtr,
+ int offset));
+static void ChangeListboxView _ANSI_ARGS_((Listbox *listPtr,
+ int index));
+static int ConfigureListbox _ANSI_ARGS_((Tcl_Interp *interp,
+ Listbox *listPtr, int argc, char **argv,
+ int flags));
+static void DeleteEls _ANSI_ARGS_((Listbox *listPtr, int first,
+ int last));
+static void DestroyListbox _ANSI_ARGS_((char *memPtr));
+static void DisplayListbox _ANSI_ARGS_((ClientData clientData));
+static int GetListboxIndex _ANSI_ARGS_((Tcl_Interp *interp,
+ Listbox *listPtr, char *string, int endIsSize,
+ int *indexPtr));
+static void InsertEls _ANSI_ARGS_((Listbox *listPtr, int index,
+ int argc, char **argv));
+static void ListboxCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void ListboxComputeGeometry _ANSI_ARGS_((Listbox *listPtr,
+ int fontChanged, int maxIsStale, int updateGrid));
+static void ListboxEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int ListboxFetchSelection _ANSI_ARGS_((
+ ClientData clientData, int offset, char *buffer,
+ int maxBytes));
+static void ListboxLostSelection _ANSI_ARGS_((
+ ClientData clientData));
+static void ListboxRedrawRange _ANSI_ARGS_((Listbox *listPtr,
+ int first, int last));
+static void ListboxScanTo _ANSI_ARGS_((Listbox *listPtr,
+ int x, int y));
+static void ListboxSelect _ANSI_ARGS_((Listbox *listPtr,
+ int first, int last, int select));
+static void ListboxUpdateHScrollbar _ANSI_ARGS_((Listbox *listPtr));
+static void ListboxUpdateVScrollbar _ANSI_ARGS_((Listbox *listPtr));
+static int ListboxWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void ListboxWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static int NearestListboxElement _ANSI_ARGS_((Listbox *listPtr,
+ int y));
+
+/*
+ * The structure below defines button class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static TkClassProcs listboxClass = {
+ NULL, /* createProc. */
+ ListboxWorldChanged, /* geometryProc. */
+ NULL /* modalProc. */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ListboxCmd --
+ *
+ * This procedure is invoked to process the "listbox" 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_ListboxCmd(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 Listbox *listPtr;
+ Tk_Window new;
+ Tk_Window tkwin = (Tk_Window) clientData;
+
+ 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 ConfigureListbox, or that ConfigureListbox requires to be
+ * initialized already (e.g. resource pointers).
+ */
+
+ listPtr = (Listbox *) ckalloc(sizeof(Listbox));
+ listPtr->tkwin = new;
+ listPtr->display = Tk_Display(new);
+ listPtr->interp = interp;
+ listPtr->widgetCmd = Tcl_CreateCommand(interp,
+ Tk_PathName(listPtr->tkwin), ListboxWidgetCmd,
+ (ClientData) listPtr, ListboxCmdDeletedProc);
+ listPtr->numElements = 0;
+ listPtr->firstPtr = NULL;
+ listPtr->lastPtr = NULL;
+ listPtr->normalBorder = NULL;
+ listPtr->borderWidth = 0;
+ listPtr->relief = TK_RELIEF_RAISED;
+ listPtr->highlightWidth = 0;
+ listPtr->highlightBgColorPtr = NULL;
+ listPtr->highlightColorPtr = NULL;
+ listPtr->inset = 0;
+ listPtr->tkfont = NULL;
+ listPtr->fgColorPtr = NULL;
+ listPtr->textGC = None;
+ listPtr->selBorder = NULL;
+ listPtr->selBorderWidth = 0;
+ listPtr->selFgColorPtr = None;
+ listPtr->selTextGC = None;
+ listPtr->width = 0;
+ listPtr->height = 0;
+ listPtr->lineHeight = 0;
+ listPtr->topIndex = 0;
+ listPtr->fullLines = 1;
+ listPtr->partialLine = 0;
+ listPtr->setGrid = 0;
+ listPtr->maxWidth = 0;
+ listPtr->xScrollUnit = 1;
+ listPtr->xOffset = 0;
+ listPtr->selectMode = NULL;
+ listPtr->numSelected = 0;
+ listPtr->selectAnchor = 0;
+ listPtr->exportSelection = 1;
+ listPtr->active = 0;
+ listPtr->scanMarkX = 0;
+ listPtr->scanMarkY = 0;
+ listPtr->scanMarkXOffset = 0;
+ listPtr->scanMarkYIndex = 0;
+ listPtr->cursor = None;
+ listPtr->takeFocus = NULL;
+ listPtr->xScrollCmd = NULL;
+ listPtr->yScrollCmd = NULL;
+ listPtr->flags = 0;
+
+ Tk_SetClass(listPtr->tkwin, "Listbox");
+ TkSetClassProcs(listPtr->tkwin, &listboxClass, (ClientData) listPtr);
+ Tk_CreateEventHandler(listPtr->tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ListboxWidgetCmd --
+ *
+ * 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
+ListboxWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about listbox widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register Listbox *listPtr = (Listbox *) clientData;
+ int result = TCL_OK;
+ size_t length;
+ int c;
+ Tk_FontMetrics fm;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) listPtr);
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'a') && (strncmp(argv[1], "activate", length) == 0)) {
+ int index;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " activate index\"",
+ (char *) NULL);
+ goto error;
+ }
+ ListboxRedrawRange(listPtr, listPtr->active, listPtr->active);
+ if (GetListboxIndex(interp, listPtr, argv[2], 0, &index) != TCL_OK) {
+ goto error;
+ }
+ if (index >= listPtr->numElements) {
+ index = listPtr->numElements-1;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ listPtr->active = index;
+ ListboxRedrawRange(listPtr, listPtr->active, listPtr->active);
+ } else if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) {
+ int index, x, y, i;
+ Element *elPtr;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " bbox index\"", (char *) NULL);
+ goto error;
+ }
+ if (GetListboxIndex(interp, listPtr, argv[2], 0, &index) != TCL_OK) {
+ goto error;
+ }
+ if ((index >= listPtr->numElements) || (index < 0)) {
+ goto done;
+ }
+ 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);
+ goto error;
+ }
+ result = Tk_ConfigureValue(interp, listPtr->tkwin, configSpecs,
+ (char *) listPtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, listPtr->tkwin, configSpecs,
+ (char *) listPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, listPtr->tkwin, configSpecs,
+ (char *) listPtr, argv[2], 0);
+ } 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");
+ }
+ } 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 (GetListboxIndex(interp, listPtr, argv[2], 0, &first) != TCL_OK) {
+ goto error;
+ }
+ if (first < listPtr->numElements) {
+ if (argc == 3) {
+ last = first;
+ } else {
+ if (GetListboxIndex(interp, listPtr, argv[3], 0,
+ &last) != TCL_OK) {
+ goto error;
+ }
+ if (last >= listPtr->numElements) {
+ last = listPtr->numElements-1;
+ }
+ }
+ DeleteEls(listPtr, first, last);
+ }
+ } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
+ int first, last, i;
+ Element *elPtr;
+
+ if ((argc != 3) && (argc != 4)) {
+ 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);
+ goto error;
+ }
+ if ((Tcl_GetInt(interp, argv[3], &x) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[4], &y) != TCL_OK)) {
+ goto error;
+ }
+ if ((argv[2][0] == 'm')
+ && (strncmp(argv[2], "mark", strlen(argv[2])) == 0)) {
+ listPtr->scanMarkX = x;
+ listPtr->scanMarkY = y;
+ listPtr->scanMarkXOffset = listPtr->xOffset;
+ listPtr->scanMarkYIndex = listPtr->topIndex;
+ } else if ((argv[2][0] == 'd')
+ && (strncmp(argv[2], "dragto", strlen(argv[2])) == 0)) {
+ ListboxScanTo(listPtr, x, y);
+ } else {
+ Tcl_AppendResult(interp, "bad scan option \"", argv[2],
+ "\": must be mark or dragto", (char *) NULL);
+ goto error;
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "see", length) == 0)
+ && (length >= 3)) {
+ int index, diff;
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " see index\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (GetListboxIndex(interp, listPtr, argv[2], 0, &index) != TCL_OK) {
+ goto error;
+ }
+ if (index >= listPtr->numElements) {
+ index = listPtr->numElements-1;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ diff = listPtr->topIndex-index;
+ if (diff > 0) {
+ if (diff <= (listPtr->fullLines/3)) {
+ ChangeListboxView(listPtr, index);
+ } else {
+ ChangeListboxView(listPtr, index - (listPtr->fullLines-1)/2);
+ }
+ } else {
+ diff = index - (listPtr->topIndex + listPtr->fullLines - 1);
+ if (diff > 0) {
+ if (diff <= (listPtr->fullLines/3)) {
+ ChangeListboxView(listPtr, listPtr->topIndex + diff);
+ } else {
+ ChangeListboxView(listPtr,
+ index - (listPtr->fullLines-1)/2);
+ }
+ }
+ }
+ } else if ((c == 's') && (length >= 3)
+ && (strncmp(argv[1], "selection", length) == 0)) {
+ int first, last;
+
+ if ((argc != 4) && (argc != 5)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " selection option index ?index?\"",
+ (char *) NULL);
+ goto error;
+ }
+ if (GetListboxIndex(interp, listPtr, argv[3], 0, &first) != TCL_OK) {
+ goto error;
+ }
+ if (argc == 5) {
+ if (GetListboxIndex(interp, listPtr, argv[4], 0, &last) != TCL_OK) {
+ goto error;
+ }
+ } else {
+ last = first;
+ }
+ length = strlen(argv[2]);
+ c = argv[2][0];
+ if ((c == 'a') && (strncmp(argv[2], "anchor", length) == 0)) {
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " selection anchor index\"", (char *) NULL);
+ goto error;
+ }
+ if (first >= listPtr->numElements) {
+ first = listPtr->numElements-1;
+ }
+ if (first < 0) {
+ first = 0;
+ }
+ listPtr->selectAnchor = first;
+ } else if ((c == 'c') && (strncmp(argv[2], "clear", length) == 0)) {
+ ListboxSelect(listPtr, first, last, 0);
+ } else if ((c == 'i') && (strncmp(argv[2], "includes", length) == 0)) {
+ int i;
+ Element *elPtr;
+
+ 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 {
+ type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ goto error;
+ case TK_SCROLL_MOVETO:
+ offset = (int) (fraction*listPtr->maxWidth + 0.5);
+ break;
+ case TK_SCROLL_PAGES:
+ windowUnits = windowWidth/listPtr->xScrollUnit;
+ if (windowUnits > 2) {
+ offset = listPtr->xOffset
+ + count*listPtr->xScrollUnit*(windowUnits-2);
+ } else {
+ offset = listPtr->xOffset + count*listPtr->xScrollUnit;
+ }
+ break;
+ case TK_SCROLL_UNITS:
+ offset = listPtr->xOffset + count*listPtr->xScrollUnit;
+ break;
+ }
+ ChangeListboxOffset(listPtr, offset);
+ }
+ } 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);
+ } else {
+ type = Tk_GetScrollInfo(interp, argc, argv, &fraction, &count);
+ switch (type) {
+ case TK_SCROLL_ERROR:
+ goto error;
+ case TK_SCROLL_MOVETO:
+ index = (int) (listPtr->numElements*fraction + 0.5);
+ break;
+ case TK_SCROLL_PAGES:
+ if (listPtr->fullLines > 2) {
+ index = listPtr->topIndex
+ + count*(listPtr->fullLines-2);
+ } else {
+ index = listPtr->topIndex + count;
+ }
+ break;
+ case TK_SCROLL_UNITS:
+ index = listPtr->topIndex + count;
+ break;
+ }
+ ChangeListboxView(listPtr, index);
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be activate, bbox, cget, configure, ",
+ "curselection, delete, get, index, insert, nearest, ",
+ "scan, see, selection, size, ",
+ "xview, or yview", (char *) NULL);
+ goto error;
+ }
+ done:
+ Tcl_Release((ClientData) listPtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) listPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyListbox --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a listbox at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the listbox is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyListbox(memPtr)
+ char *memPtr; /* Info about listbox widget. */
+{
+ register Listbox *listPtr = (Listbox *) memPtr;
+ register Element *elPtr, *nextPtr;
+
+ /*
+ * Free up all of the list elements.
+ */
+
+ for (elPtr = listPtr->firstPtr; elPtr != NULL; ) {
+ nextPtr = elPtr->nextPtr;
+ ckfree((char *) elPtr);
+ elPtr = nextPtr;
+ }
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ if (listPtr->textGC != None) {
+ Tk_FreeGC(listPtr->display, listPtr->textGC);
+ }
+ if (listPtr->selTextGC != None) {
+ Tk_FreeGC(listPtr->display, listPtr->selTextGC);
+ }
+ Tk_FreeOptions(configSpecs, (char *) listPtr, listPtr->display, 0);
+ ckfree((char *) listPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureListbox --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureListbox(interp, listPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register Listbox *listPtr; /* 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;
+
+ oldExport = listPtr->exportSelection;
+ if (Tk_ConfigureWidget(interp, listPtr->tkwin, configSpecs,
+ argc, argv, (char *) listPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few options need special processing, such as setting the
+ * background from a 3-D border.
+ */
+
+ Tk_SetBackgroundFromBorder(listPtr->tkwin, listPtr->normalBorder);
+
+ if (listPtr->highlightWidth < 0) {
+ listPtr->highlightWidth = 0;
+ }
+ listPtr->inset = listPtr->highlightWidth + listPtr->borderWidth;
+
+ /*
+ * Claim the selection if we've suddenly started exporting it and
+ * there is a selection to export.
+ */
+
+ if (listPtr->exportSelection && !oldExport
+ && (listPtr->numSelected != 0)) {
+ Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection,
+ (ClientData) listPtr);
+ }
+
+ ListboxWorldChanged((ClientData) listPtr);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * ListboxWorldChanged --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Listbox will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ListboxWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC gc;
+ unsigned long mask;
+ Listbox *listPtr;
+
+ listPtr = (Listbox *) instanceData;
+
+ gcValues.foreground = listPtr->fgColorPtr->pixel;
+ gcValues.font = Tk_FontId(listPtr->tkfont);
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCFont | GCGraphicsExposures;
+ gc = Tk_GetGCColor(listPtr->tkwin, mask, &gcValues, listPtr->fgColorPtr,
+ NULL);
+ if (listPtr->textGC != None) {
+ Tk_FreeGC(listPtr->display, listPtr->textGC);
+ }
+ listPtr->textGC = gc;
+
+ gcValues.foreground = listPtr->selFgColorPtr->pixel;
+ gcValues.font = Tk_FontId(listPtr->tkfont);
+ mask = GCForeground | GCFont;
+ gc = Tk_GetGCColor(listPtr->tkwin, mask, &gcValues, listPtr->selFgColorPtr,
+ NULL);
+ if (listPtr->selTextGC != None) {
+ Tk_FreeGC(listPtr->display, listPtr->selTextGC);
+ }
+ listPtr->selTextGC = gc;
+
+ /*
+ * Register the desired geometry for the window and arrange for
+ * the window to be redisplayed.
+ */
+
+ ListboxComputeGeometry(listPtr, 1, 1, 1);
+ listPtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR;
+ ListboxRedrawRange(listPtr, 0, listPtr->numElements-1);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayListbox --
+ *
+ * This procedure redraws the contents of a listbox window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayListbox(clientData)
+ ClientData clientData; /* Information about window. */
+{
+ register Listbox *listPtr = (Listbox *) clientData;
+ register Tk_Window tkwin = listPtr->tkwin;
+ register Element *elPtr;
+ GC gc;
+ int i, limit, x, y, width, prevSelected;
+ Tk_FontMetrics fm;
+ int left, right; /* Non-zero values here indicate
+ * that the left or right edge of
+ * the listbox is off-screen. */
+ Pixmap pixmap;
+
+ listPtr->flags &= ~REDRAW_PENDING;
+ if (listPtr->flags & UPDATE_V_SCROLLBAR) {
+ ListboxUpdateVScrollbar(listPtr);
+ }
+ if (listPtr->flags & UPDATE_H_SCROLLBAR) {
+ ListboxUpdateHScrollbar(listPtr);
+ }
+ listPtr->flags &= ~(REDRAW_PENDING|UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR);
+ if ((listPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ /*
+ * Redrawing is done in a temporary pixmap that is allocated
+ * here and freed at the end of the procedure. All drawing is
+ * done to the pixmap, and the pixmap is copied to the screen
+ * at the end of the procedure. This provides the smoothest
+ * possible visual effects (no flashing on the screen).
+ */
+
+ pixmap = Tk_GetPixmap(listPtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+ Tk_Fill3DRectangle(tkwin, pixmap, listPtr->normalBorder, 0, 0,
+ Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
+
+ /*
+ * Iterate through all of the elements of the listbox, displaying each
+ * in turn. Selected elements use a different GC and have a raised
+ * background.
+ */
+
+ limit = listPtr->topIndex + listPtr->fullLines + listPtr->partialLine - 1;
+ if (limit >= listPtr->numElements) {
+ limit = listPtr->numElements-1;
+ }
+ left = right = 0;
+ if (listPtr->xOffset > 0) {
+ left = listPtr->selBorderWidth+1;
+ }
+ if ((listPtr->maxWidth - listPtr->xOffset) > (Tk_Width(listPtr->tkwin)
+ - 2*(listPtr->inset + listPtr->selBorderWidth))) {
+ right = listPtr->selBorderWidth+1;
+ }
+ prevSelected = 0;
+ for (elPtr = listPtr->firstPtr, i = 0; (elPtr != NULL) && (i <= limit);
+ prevSelected = elPtr->selected, elPtr = elPtr->nextPtr, i++) {
+ if (i < listPtr->topIndex) {
+ continue;
+ }
+ x = listPtr->inset;
+ y = ((i - listPtr->topIndex) * listPtr->lineHeight)
+ + listPtr->inset;
+ gc = listPtr->textGC;
+ if (elPtr->selected) {
+ gc = listPtr->selTextGC;
+ width = Tk_Width(tkwin) - 2*listPtr->inset;
+ Tk_Fill3DRectangle(tkwin, pixmap, listPtr->selBorder, x, y,
+ width, listPtr->lineHeight, 0, TK_RELIEF_FLAT);
+
+ /*
+ * Draw beveled edges around the selection, if there are visible
+ * edges next to this element. Special considerations:
+ * 1. The left and right bevels may not be visible if horizontal
+ * scrolling is enabled (the "left" and "right" variables
+ * are zero to indicate that the corresponding bevel is
+ * visible).
+ * 2. Top and bottom bevels are only drawn if this is the
+ * first or last seleted item.
+ * 3. If the left or right bevel isn't visible, then the "left"
+ * and "right" variables, computed above, have non-zero values
+ * that extend the top and bottom bevels so that the mitered
+ * corners are off-screen.
+ */
+
+ if (left == 0) {
+ Tk_3DVerticalBevel(tkwin, pixmap, listPtr->selBorder,
+ x, y, listPtr->selBorderWidth, listPtr->lineHeight,
+ 1, TK_RELIEF_RAISED);
+ }
+ if (right == 0) {
+ Tk_3DVerticalBevel(tkwin, pixmap, listPtr->selBorder,
+ x + width - listPtr->selBorderWidth, y,
+ listPtr->selBorderWidth, listPtr->lineHeight,
+ 0, TK_RELIEF_RAISED);
+ }
+ if (!prevSelected) {
+ Tk_3DHorizontalBevel(tkwin, pixmap, listPtr->selBorder,
+ x-left, y, width+left+right, listPtr->selBorderWidth,
+ 1, 1, 1, TK_RELIEF_RAISED);
+ }
+ if ((elPtr->nextPtr == NULL) || !elPtr->nextPtr->selected) {
+ Tk_3DHorizontalBevel(tkwin, pixmap, listPtr->selBorder, x-left,
+ y + listPtr->lineHeight - listPtr->selBorderWidth,
+ width+left+right, listPtr->selBorderWidth, 0, 0, 0,
+ TK_RELIEF_RAISED);
+ }
+ }
+ Tk_GetFontMetrics(listPtr->tkfont, &fm);
+ y += fm.ascent + listPtr->selBorderWidth;
+ x = listPtr->inset + listPtr->selBorderWidth - elPtr->lBearing
+ - listPtr->xOffset;
+ Tk_DrawChars(listPtr->display, pixmap, gc, listPtr->tkfont,
+ elPtr->text, elPtr->textLength, x, y);
+
+ /*
+ * If this is the active element, underline it.
+ */
+
+ if ((i == listPtr->active) && (listPtr->flags & GOT_FOCUS)) {
+ Tk_UnderlineChars(listPtr->display, pixmap, gc, listPtr->tkfont,
+ elPtr->text, x, y, 0, elPtr->textLength);
+ }
+ }
+
+ /*
+ * Redraw the border for the listbox to make sure that it's on top
+ * of any of the text of the listbox entries.
+ */
+
+ Tk_Draw3DRectangle(tkwin, pixmap, listPtr->normalBorder,
+ listPtr->highlightWidth, listPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*listPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*listPtr->highlightWidth,
+ listPtr->borderWidth, listPtr->relief);
+ if (listPtr->highlightWidth > 0) {
+ GC gc;
+
+ if (listPtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(listPtr->highlightColorPtr, pixmap);
+ } else {
+ gc = Tk_GCForColor(listPtr->highlightBgColorPtr, pixmap);
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, listPtr->highlightWidth, pixmap);
+ }
+ XCopyArea(listPtr->display, pixmap, Tk_WindowId(tkwin),
+ listPtr->textGC, 0, 0, (unsigned) Tk_Width(tkwin),
+ (unsigned) Tk_Height(tkwin), 0, 0);
+ Tk_FreePixmap(listPtr->display, pixmap);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxComputeGeometry --
+ *
+ * This procedure is invoked to recompute geometry information
+ * such as the sizes of the elements and the overall dimensions
+ * desired for the listbox.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Geometry information is updated and a new requested size is
+ * registered for the widget. Internal border and gridding
+ * information is also set.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxComputeGeometry(listPtr, fontChanged, maxIsStale, updateGrid)
+ Listbox *listPtr; /* Listbox whose geometry is to be
+ * recomputed. */
+ int fontChanged; /* Non-zero means the font may have changed
+ * so per-element width information also
+ * has to be computed. */
+ int maxIsStale; /* Non-zero means the "maxWidth" field may
+ * no longer be up-to-date and must
+ * be recomputed. If fontChanged is 1 then
+ * this must be 1. */
+ int updateGrid; /* Non-zero means call Tk_SetGrid or
+ * Tk_UnsetGrid to update gridding for
+ * the window. */
+{
+ register Element *elPtr;
+ int width, height, pixelWidth, pixelHeight;
+ Tk_FontMetrics fm;
+
+ if (fontChanged || maxIsStale) {
+ listPtr->xScrollUnit = Tk_TextWidth(listPtr->tkfont, "0", 1);
+ if (listPtr->xScrollUnit == 0) {
+ listPtr->xScrollUnit = 1;
+ }
+ listPtr->maxWidth = 0;
+ for (elPtr = listPtr->firstPtr; elPtr != NULL; elPtr = elPtr->nextPtr) {
+ if (fontChanged) {
+ elPtr->pixelWidth = Tk_TextWidth(listPtr->tkfont,
+ elPtr->text, elPtr->textLength);
+ elPtr->lBearing = 0;
+ }
+ if (elPtr->pixelWidth > listPtr->maxWidth) {
+ listPtr->maxWidth = elPtr->pixelWidth;
+ }
+ }
+ }
+
+ Tk_GetFontMetrics(listPtr->tkfont, &fm);
+ listPtr->lineHeight = fm.linespace + 1 + 2*listPtr->selBorderWidth;
+ width = listPtr->width;
+ if (width <= 0) {
+ width = (listPtr->maxWidth + listPtr->xScrollUnit - 1)
+ /listPtr->xScrollUnit;
+ if (width < 1) {
+ width = 1;
+ }
+ }
+ pixelWidth = width*listPtr->xScrollUnit + 2*listPtr->inset
+ + 2*listPtr->selBorderWidth;
+ height = listPtr->height;
+ if (listPtr->height <= 0) {
+ height = listPtr->numElements;
+ if (height < 1) {
+ height = 1;
+ }
+ }
+ pixelHeight = height*listPtr->lineHeight + 2*listPtr->inset;
+ Tk_GeometryRequest(listPtr->tkwin, pixelWidth, pixelHeight);
+ Tk_SetInternalBorder(listPtr->tkwin, listPtr->inset);
+ if (updateGrid) {
+ if (listPtr->setGrid) {
+ Tk_SetGrid(listPtr->tkwin, width, height, listPtr->xScrollUnit,
+ listPtr->lineHeight);
+ } else {
+ Tk_UnsetGrid(listPtr->tkwin);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InsertEls --
+ *
+ * Add new elements to a listbox widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * New information gets added to listPtr; it will be redisplayed
+ * soon, but not immediately.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InsertEls(listPtr, index, argc, argv)
+ register Listbox *listPtr; /* Listbox that is to get the new
+ * elements. */
+ int index; /* Add the new elements before this
+ * element. */
+ int argc; /* Number of new elements to add. */
+ char **argv; /* New elements (one per entry). */
+{
+ register Element *prevPtr, *newPtr;
+ int length, i, oldMaxWidth;
+
+ /*
+ * Find the element before which the new ones will be inserted.
+ */
+
+ if (index <= 0) {
+ index = 0;
+ }
+ if (index > listPtr->numElements) {
+ index = listPtr->numElements;
+ }
+ if (index == 0) {
+ prevPtr = NULL;
+ } else if (index == listPtr->numElements) {
+ prevPtr = listPtr->lastPtr;
+ } else {
+ for (prevPtr = listPtr->firstPtr, i = index - 1; i > 0; i--) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ }
+
+ /*
+ * For each new element, create a record, initialize it, and link
+ * it into the list of elements.
+ */
+
+ oldMaxWidth = listPtr->maxWidth;
+ for (i = argc ; i > 0; i--, argv++, prevPtr = newPtr) {
+ length = strlen(*argv);
+ newPtr = (Element *) ckalloc(ElementSize(length));
+ newPtr->textLength = length;
+ strcpy(newPtr->text, *argv);
+ newPtr->pixelWidth = Tk_TextWidth(listPtr->tkfont, newPtr->text,
+ newPtr->textLength);
+ newPtr->lBearing = 0;
+ if (newPtr->pixelWidth > listPtr->maxWidth) {
+ listPtr->maxWidth = newPtr->pixelWidth;
+ }
+ newPtr->selected = 0;
+ if (prevPtr == NULL) {
+ newPtr->nextPtr = listPtr->firstPtr;
+ listPtr->firstPtr = newPtr;
+ } else {
+ newPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = newPtr;
+ }
+ }
+ if ((prevPtr != NULL) && (prevPtr->nextPtr == NULL)) {
+ listPtr->lastPtr = prevPtr;
+ }
+ listPtr->numElements += argc;
+
+ /*
+ * Update the selection and other indexes to account for the
+ * renumbering that has just occurred. Then arrange for the new
+ * information to be displayed.
+ */
+
+ if (index <= listPtr->selectAnchor) {
+ listPtr->selectAnchor += argc;
+ }
+ if (index < listPtr->topIndex) {
+ listPtr->topIndex += argc;
+ }
+ if (index <= listPtr->active) {
+ listPtr->active += argc;
+ if ((listPtr->active >= listPtr->numElements)
+ && (listPtr->numElements > 0)) {
+ listPtr->active = listPtr->numElements-1;
+ }
+ }
+ listPtr->flags |= UPDATE_V_SCROLLBAR;
+ if (listPtr->maxWidth != oldMaxWidth) {
+ listPtr->flags |= UPDATE_H_SCROLLBAR;
+ }
+ ListboxComputeGeometry(listPtr, 0, 0, 0);
+ ListboxRedrawRange(listPtr, index, listPtr->numElements-1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteEls --
+ *
+ * Remove one or more elements from a listbox widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory gets freed, the listbox gets modified and (eventually)
+ * redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteEls(listPtr, first, last)
+ register Listbox *listPtr; /* Listbox widget to modify. */
+ int first; /* Index of first element to delete. */
+ int last; /* Index of last element to delete. */
+{
+ register Element *prevPtr, *elPtr;
+ int count, i, widthChanged;
+
+ /*
+ * Adjust the range to fit within the existing elements of the
+ * listbox, and make sure there's something to delete.
+ */
+
+ if (first < 0) {
+ first = 0;
+ }
+ if (last >= listPtr->numElements) {
+ last = listPtr->numElements-1;
+ }
+ count = last + 1 - first;
+ if (count <= 0) {
+ return;
+ }
+
+ /*
+ * Find the element just before the ones to delete.
+ */
+
+ if (first == 0) {
+ prevPtr = NULL;
+ } else {
+ for (i = first-1, prevPtr = listPtr->firstPtr; i > 0; i--) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ }
+
+ /*
+ * Delete the requested number of elements.
+ */
+
+ widthChanged = 0;
+ for (i = count; i > 0; i--) {
+ if (prevPtr == NULL) {
+ elPtr = listPtr->firstPtr;
+ listPtr->firstPtr = elPtr->nextPtr;
+ if (listPtr->firstPtr == NULL) {
+ listPtr->lastPtr = NULL;
+ }
+ } else {
+ elPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = elPtr->nextPtr;
+ if (prevPtr->nextPtr == NULL) {
+ listPtr->lastPtr = prevPtr;
+ }
+ }
+ if (elPtr->pixelWidth == listPtr->maxWidth) {
+ widthChanged = 1;
+ }
+ if (elPtr->selected) {
+ listPtr->numSelected -= 1;
+ }
+ ckfree((char *) elPtr);
+ }
+ listPtr->numElements -= count;
+
+ /*
+ * Update the selection and viewing information to reflect the change
+ * in the element numbering, and redisplay to slide information up over
+ * the elements that were deleted.
+ */
+
+ if (first <= listPtr->selectAnchor) {
+ listPtr->selectAnchor -= count;
+ if (listPtr->selectAnchor < first) {
+ listPtr->selectAnchor = first;
+ }
+ }
+ if (first <= listPtr->topIndex) {
+ listPtr->topIndex -= count;
+ if (listPtr->topIndex < first) {
+ listPtr->topIndex = first;
+ }
+ }
+ if (listPtr->topIndex > (listPtr->numElements - listPtr->fullLines)) {
+ listPtr->topIndex = listPtr->numElements - listPtr->fullLines;
+ if (listPtr->topIndex < 0) {
+ listPtr->topIndex = 0;
+ }
+ }
+ if (listPtr->active > last) {
+ listPtr->active -= count;
+ } else if (listPtr->active >= first) {
+ listPtr->active = first;
+ if ((listPtr->active >= listPtr->numElements)
+ && (listPtr->numElements > 0)) {
+ listPtr->active = listPtr->numElements-1;
+ }
+ }
+ listPtr->flags |= UPDATE_V_SCROLLBAR;
+ ListboxComputeGeometry(listPtr, 0, widthChanged, 0);
+ if (widthChanged) {
+ listPtr->flags |= UPDATE_H_SCROLLBAR;
+ }
+ ListboxRedrawRange(listPtr, first, listPtr->numElements-1);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ListboxEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on listboxes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ListboxEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ Listbox *listPtr = (Listbox *) clientData;
+
+ if (eventPtr->type == Expose) {
+ ListboxRedrawRange(listPtr,
+ NearestListboxElement(listPtr, eventPtr->xexpose.y),
+ NearestListboxElement(listPtr, eventPtr->xexpose.y
+ + eventPtr->xexpose.height));
+ } else if (eventPtr->type == DestroyNotify) {
+ if (listPtr->tkwin != NULL) {
+ if (listPtr->setGrid) {
+ Tk_UnsetGrid(listPtr->tkwin);
+ }
+ listPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(listPtr->interp, listPtr->widgetCmd);
+ }
+ if (listPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayListbox, (ClientData) listPtr);
+ }
+ Tcl_EventuallyFree((ClientData) listPtr, DestroyListbox);
+ } else if (eventPtr->type == ConfigureNotify) {
+ int vertSpace;
+
+ vertSpace = Tk_Height(listPtr->tkwin) - 2*listPtr->inset;
+ listPtr->fullLines = vertSpace / listPtr->lineHeight;
+ if ((listPtr->fullLines*listPtr->lineHeight) < vertSpace) {
+ listPtr->partialLine = 1;
+ } else {
+ listPtr->partialLine = 0;
+ }
+ listPtr->flags |= UPDATE_V_SCROLLBAR|UPDATE_H_SCROLLBAR;
+ ChangeListboxView(listPtr, listPtr->topIndex);
+ ChangeListboxOffset(listPtr, listPtr->xOffset);
+
+ /*
+ * Redraw the whole listbox. It's hard to tell what needs
+ * to be redrawn (e.g. if the listbox has shrunk then we
+ * may only need to redraw the borders), so just redraw
+ * everything for safety.
+ */
+
+ ListboxRedrawRange(listPtr, 0, listPtr->numElements-1);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ listPtr->flags |= GOT_FOCUS;
+ ListboxRedrawRange(listPtr, 0, listPtr->numElements-1);
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ listPtr->flags &= ~GOT_FOCUS;
+ ListboxRedrawRange(listPtr, 0, listPtr->numElements-1);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxCmdDeletedProc --
+ *
+ * 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
+ListboxCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ Listbox *listPtr = (Listbox *) clientData;
+ Tk_Window tkwin = listPtr->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) {
+ if (listPtr->setGrid) {
+ Tk_UnsetGrid(listPtr->tkwin);
+ }
+ listPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetListboxIndex --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetListboxIndex(interp, listPtr, string, endIsSize, indexPtr)
+ Tcl_Interp *interp; /* For error messages. */
+ Listbox *listPtr; /* Listbox for which the index is being
+ * specified. */
+ char *string; /* Specifies an element in the listbox. */
+ int endIsSize; /* If 1, "end" refers to the number of
+ * entries in the listbox. If 0, "end"
+ * refers to 1 less than the number of
+ * entries. */
+ int *indexPtr; /* Where to store converted index. */
+{
+ int c;
+ size_t length;
+
+ length = strlen(string);
+ c = string[0];
+ if ((c == 'a') && (strncmp(string, "active", length) == 0)
+ && (length >= 2)) {
+ *indexPtr = listPtr->active;
+ } else if ((c == 'a') && (strncmp(string, "anchor", length) == 0)
+ && (length >= 2)) {
+ *indexPtr = listPtr->selectAnchor;
+ } else if ((c == 'e') && (strncmp(string, "end", length) == 0)) {
+ if (endIsSize) {
+ *indexPtr = listPtr->numElements;
+ } else {
+ *indexPtr = listPtr->numElements - 1;
+ }
+ } else if (c == '@') {
+ int y;
+ char *p, *end;
+
+ p = string+1;
+ strtol(p, &end, 0);
+ if ((end == p) || (*end != ',')) {
+ goto badIndex;
+ }
+ p = end+1;
+ y = strtol(p, &end, 0);
+ if ((end == p) || (*end != 0)) {
+ goto badIndex;
+ }
+ *indexPtr = NearestListboxElement(listPtr, y);
+ } else {
+ if (Tcl_GetInt(interp, string, indexPtr) != TCL_OK) {
+ Tcl_ResetResult(interp);
+ goto badIndex;
+ }
+ }
+ return TCL_OK;
+
+ badIndex:
+ Tcl_AppendResult(interp, "bad listbox index \"", string,
+ "\": must be active, anchor, end, @x,y, or a number",
+ (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangeListboxView --
+ *
+ * Change the view on a listbox widget so that a given element
+ * is displayed at the top.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * What's displayed on the screen is changed. If there is a
+ * scrollbar associated with this widget, then the scrollbar
+ * is instructed to change its display too.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChangeListboxView(listPtr, index)
+ register Listbox *listPtr; /* Information about widget. */
+ int index; /* Index of element in listPtr
+ * that should now appear at the
+ * top of the listbox. */
+{
+ if (index >= (listPtr->numElements - listPtr->fullLines)) {
+ index = listPtr->numElements - listPtr->fullLines;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ if (listPtr->topIndex != index) {
+ listPtr->topIndex = index;
+ if (!(listPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayListbox, (ClientData) listPtr);
+ listPtr->flags |= REDRAW_PENDING;
+ }
+ listPtr->flags |= UPDATE_V_SCROLLBAR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangListboxOffset --
+ *
+ * Change the horizontal offset for a listbox.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The listbox may be redrawn to reflect its new horizontal
+ * offset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChangeListboxOffset(listPtr, offset)
+ register Listbox *listPtr; /* Information about widget. */
+ int offset; /* Desired new "xOffset" for
+ * listbox. */
+{
+ int maxOffset;
+
+ /*
+ * Make sure that the new offset is within the allowable range, and
+ * round it off to an even multiple of xScrollUnit.
+ */
+
+ maxOffset = listPtr->maxWidth - (Tk_Width(listPtr->tkwin) -
+ 2*listPtr->inset - 2*listPtr->selBorderWidth)
+ + listPtr->xScrollUnit - 1;
+ if (offset > maxOffset) {
+ offset = maxOffset;
+ }
+ if (offset < 0) {
+ offset = 0;
+ }
+ offset -= offset % listPtr->xScrollUnit;
+ if (offset != listPtr->xOffset) {
+ listPtr->xOffset = offset;
+ listPtr->flags |= UPDATE_H_SCROLLBAR;
+ ListboxRedrawRange(listPtr, 0, listPtr->numElements);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxScanTo --
+ *
+ * Given a point (presumably of the curent mouse location)
+ * drag the view in the window to implement the scan operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The view in the window may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxScanTo(listPtr, x, y)
+ register Listbox *listPtr; /* Information about widget. */
+ int x; /* X-coordinate to use for scan
+ * operation. */
+ int y; /* Y-coordinate to use for scan
+ * operation. */
+{
+ int newTopIndex, newOffset, maxIndex, maxOffset;
+
+ maxIndex = listPtr->numElements - listPtr->fullLines;
+ maxOffset = listPtr->maxWidth + (listPtr->xScrollUnit - 1)
+ - (Tk_Width(listPtr->tkwin) - 2*listPtr->inset
+ - 2*listPtr->selBorderWidth - listPtr->xScrollUnit);
+
+ /*
+ * Compute new top line for screen by amplifying the difference
+ * between the current position and the place where the scan
+ * started (the "mark" position). If we run off the top or bottom
+ * of the list, 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).
+ */
+
+ newTopIndex = listPtr->scanMarkYIndex
+ - (10*(y - listPtr->scanMarkY))/listPtr->lineHeight;
+ if (newTopIndex > maxIndex) {
+ newTopIndex = listPtr->scanMarkYIndex = maxIndex;
+ listPtr->scanMarkY = y;
+ } else if (newTopIndex < 0) {
+ newTopIndex = listPtr->scanMarkYIndex = 0;
+ listPtr->scanMarkY = y;
+ }
+ ChangeListboxView(listPtr, newTopIndex);
+
+ /*
+ * Compute new left edge for display in a similar fashion by amplifying
+ * the difference between the current position and the place where the
+ * scan started.
+ */
+
+ newOffset = listPtr->scanMarkXOffset - (10*(x - listPtr->scanMarkX));
+ if (newOffset > maxOffset) {
+ newOffset = listPtr->scanMarkXOffset = maxOffset;
+ listPtr->scanMarkX = x;
+ } else if (newOffset < 0) {
+ newOffset = listPtr->scanMarkXOffset = 0;
+ listPtr->scanMarkX = x;
+ }
+ ChangeListboxOffset(listPtr, newOffset);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NearestListboxElement --
+ *
+ * Given a y-coordinate inside a listbox, compute the index of
+ * the element under that y-coordinate (or closest to that
+ * y-coordinate).
+ *
+ * Results:
+ * The return value is an index of an element of listPtr. If
+ * listPtr has no elements, then 0 is always returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NearestListboxElement(listPtr, y)
+ register Listbox *listPtr; /* Information about widget. */
+ int y; /* Y-coordinate in listPtr's window. */
+{
+ int index;
+
+ index = (y - listPtr->inset)/listPtr->lineHeight;
+ if (index >= (listPtr->fullLines + listPtr->partialLine)) {
+ index = listPtr->fullLines + listPtr->partialLine - 1;
+ }
+ if (index < 0) {
+ index = 0;
+ }
+ index += listPtr->topIndex;
+ if (index >= listPtr->numElements) {
+ index = listPtr->numElements-1;
+ }
+ return index;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxSelect --
+ *
+ * Select or deselect one or more elements in a listbox..
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All of the elements in the range between first and last are
+ * marked as either selected or deselected, depending on the
+ * "select" argument. Any items whose state changes are redisplayed.
+ * The selection is claimed from X when the number of selected
+ * elements changes from zero to non-zero.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxSelect(listPtr, first, last, select)
+ register Listbox *listPtr; /* Information about widget. */
+ int first; /* Index of first element to
+ * select or deselect. */
+ int last; /* Index of last element to
+ * select or deselect. */
+ int select; /* 1 means select items, 0 means
+ * deselect them. */
+{
+ int i, firstRedisplay, increment, oldCount;
+ Element *elPtr;
+
+ if (last < first) {
+ i = first;
+ first = last;
+ last = i;
+ }
+ if ((last < 0) || (first >= listPtr->numElements)) {
+ return;
+ }
+ if (first < 0) {
+ first = 0;
+ }
+ if (last >= listPtr->numElements) {
+ last = listPtr->numElements - 1;
+ }
+ oldCount = listPtr->numSelected;
+ firstRedisplay = -1;
+ increment = select ? 1 : -1;
+ for (i = 0, elPtr = listPtr->firstPtr; i < first;
+ i++, elPtr = elPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ for ( ; i <= last; i++, elPtr = elPtr->nextPtr) {
+ if (elPtr->selected == select) {
+ continue;
+ }
+ listPtr->numSelected += increment;
+ elPtr->selected = select;
+ if (firstRedisplay < 0) {
+ firstRedisplay = i;
+ }
+ }
+ if (firstRedisplay >= 0) {
+ ListboxRedrawRange(listPtr, first, last);
+ }
+ if ((oldCount == 0) && (listPtr->numSelected > 0)
+ && (listPtr->exportSelection)) {
+ Tk_OwnSelection(listPtr->tkwin, XA_PRIMARY, ListboxLostSelection,
+ (ClientData) listPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxFetchSelection --
+ *
+ * This procedure is called back by Tk when the selection is
+ * requested by someone. It returns part or all of the selection
+ * in a buffer provided by the caller.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored
+ * at buffer. Buffer is filled (or partially filled) with a
+ * NULL-terminated string containing part or all of the selection,
+ * as given by offset and maxBytes. The selection is returned
+ * as a Tcl list with one list element for each element in the
+ * listbox.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ListboxFetchSelection(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Information about listbox widget. */
+ int offset; /* Offset within selection of first
+ * byte 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. */
+{
+ register Listbox *listPtr = (Listbox *) clientData;
+ register Element *elPtr;
+ Tcl_DString selection;
+ int length, count, needNewline;
+
+ if (!listPtr->exportSelection) {
+ return -1;
+ }
+
+ /*
+ * Use a dynamic string to accumulate the contents of the selection.
+ */
+
+ needNewline = 0;
+ Tcl_DStringInit(&selection);
+ for (elPtr = listPtr->firstPtr; elPtr != NULL; elPtr = elPtr->nextPtr) {
+ if (elPtr->selected) {
+ if (needNewline) {
+ Tcl_DStringAppend(&selection, "\n", 1);
+ }
+ Tcl_DStringAppend(&selection, elPtr->text, elPtr->textLength);
+ needNewline = 1;
+ }
+ }
+
+ length = Tcl_DStringLength(&selection);
+ if (length == 0) {
+ return -1;
+ }
+
+ /*
+ * Copy the requested portion of the selection to the buffer.
+ */
+
+ count = length - offset;
+ if (count <= 0) {
+ count = 0;
+ } else {
+ if (count > maxBytes) {
+ count = maxBytes;
+ }
+ memcpy((VOID *) buffer,
+ (VOID *) (Tcl_DStringValue(&selection) + offset),
+ (size_t) count);
+ }
+ buffer[count] = '\0';
+ Tcl_DStringFree(&selection);
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxLostSelection --
+ *
+ * This procedure is called back by Tk when the selection is
+ * grabbed away from a listbox widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The existing selection is unhighlighted, and the window is
+ * marked as not containing a selection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxLostSelection(clientData)
+ ClientData clientData; /* Information about listbox widget. */
+{
+ register Listbox *listPtr = (Listbox *) clientData;
+
+ if ((listPtr->exportSelection) && (listPtr->numElements > 0)) {
+ ListboxSelect(listPtr, 0, listPtr->numElements-1, 0);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxRedrawRange --
+ *
+ * Ensure that a given range of elements is eventually redrawn on
+ * the display (if those elements in fact appear on the display).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ListboxRedrawRange(listPtr, first, last)
+ register Listbox *listPtr; /* Information about widget. */
+ int first; /* Index of first element in list
+ * that needs to be redrawn. */
+ int last; /* Index of last element in list
+ * that needs to be redrawn. May
+ * be less than first;
+ * these just bracket a range. */
+{
+ if ((listPtr->tkwin == NULL) || !Tk_IsMapped(listPtr->tkwin)
+ || (listPtr->flags & REDRAW_PENDING)) {
+ return;
+ }
+ Tcl_DoWhenIdle(DisplayListbox, (ClientData) listPtr);
+ listPtr->flags |= REDRAW_PENDING;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxUpdateVScrollbar --
+ *
+ * This procedure is invoked whenever information has changed in
+ * a listbox in a way that would invalidate a vertical scrollbar
+ * display. If there is an associated scrollbar, then this command
+ * updates it by invoking a Tcl command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Tcl command is invoked, and an additional command may be
+ * invoked to process errors in the command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxUpdateVScrollbar(listPtr)
+ register Listbox *listPtr; /* Information about widget. */
+{
+ char string[100];
+ double first, last;
+ int result;
+ Tcl_Interp *interp;
+
+ if (listPtr->yScrollCmd == NULL) {
+ return;
+ }
+ if (listPtr->numElements == 0) {
+ first = 0.0;
+ last = 1.0;
+ } else {
+ first = listPtr->topIndex/((double) listPtr->numElements);
+ last = (listPtr->topIndex+listPtr->fullLines)
+ /((double) listPtr->numElements);
+ if (last > 1.0) {
+ last = 1.0;
+ }
+ }
+ sprintf(string, " %g %g", first, last);
+
+ /*
+ * We must hold onto the interpreter from the listPtr because the data
+ * at listPtr might be freed as a result of the Tcl_VarEval.
+ */
+
+ interp = listPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ result = Tcl_VarEval(interp, listPtr->yScrollCmd, string,
+ (char *) NULL);
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (vertical scrolling command executed by listbox)");
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_Release((ClientData) interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ListboxUpdateHScrollbar --
+ *
+ * This procedure is invoked whenever information has changed in
+ * a listbox in a way that would invalidate a horizontal scrollbar
+ * display. If there is an associated horizontal scrollbar, then
+ * this command updates it by invoking a Tcl command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Tcl command is invoked, and an additional command may be
+ * invoked to process errors in the command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ListboxUpdateHScrollbar(listPtr)
+ register Listbox *listPtr; /* Information about widget. */
+{
+ char string[60];
+ int result, windowWidth;
+ double first, last;
+ Tcl_Interp *interp;
+
+ if (listPtr->xScrollCmd == NULL) {
+ return;
+ }
+ windowWidth = Tk_Width(listPtr->tkwin) - 2*(listPtr->inset
+ + listPtr->selBorderWidth);
+ if (listPtr->maxWidth == 0) {
+ first = 0;
+ last = 1.0;
+ } else {
+ first = listPtr->xOffset/((double) listPtr->maxWidth);
+ last = (listPtr->xOffset + windowWidth)
+ /((double) listPtr->maxWidth);
+ if (last > 1.0) {
+ last = 1.0;
+ }
+ }
+ sprintf(string, " %g %g", first, last);
+
+ /*
+ * We must hold onto the interpreter because the data referred to at
+ * listPtr might be freed as a result of the call to Tcl_VarEval.
+ */
+
+ interp = listPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ result = Tcl_VarEval(interp, listPtr->xScrollCmd, string,
+ (char *) NULL);
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (horizontal scrolling command executed by listbox)");
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_Release((ClientData) interp);
+}
diff --git a/tk/generic/tkMacWinMenu.c b/tk/generic/tkMacWinMenu.c
new file mode 100644
index 00000000000..ed9a3b1f42d
--- /dev/null
+++ b/tk/generic/tkMacWinMenu.c
@@ -0,0 +1,134 @@
+/*
+ * 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$
+ */
+
+#include "tkMenu.h"
+
+static int postCommandGeneration;
+
+static int PreprocessMenu _ANSI_ARGS_((TkMenu *menuPtr));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PreprocessMenu --
+ *
+ * The guts of the preprocessing. Recursive.
+ *
+ * Results:
+ * The return value is a standard Tcl result (errors can occur
+ * while the postcommands are being processed).
+ *
+ * Side effects:
+ * Since commands can get executed while this routine is being executed,
+ * the entire world can change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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.
+ */
+
+ result = TkPostCommand(menuPtr);
+ if ((result != TCL_OK) || (menuPtr->tkwin == NULL)) {
+ goto done;
+ }
+
+ /*
+ * Now, we go through structure and process all of the commands.
+ * Since the structure is changing, we stop after we do one command,
+ * and start over. When we get through without doing any, we are done.
+ */
+
+
+ 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;
+ }
+ }
+ }
+ }
+ } while (!finished);
+
+ done:
+ Tcl_Release((ClientData)menuPtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPreprocessMenu --
+ *
+ * On the Mac and on Windows, all of the postcommand processing has
+ * to be done on the entire tree underneath the main window to be
+ * posted. This means that we have to traverse the menu tree and
+ * issue the postcommands for all of the menus that have cascades
+ * attached. Since the postcommands can change the menu structure while
+ * we are traversing, we have to be extremely careful. Basically, the
+ * idea is to traverse the structure until we succesfully process
+ * one postcommand. Then we start over, and do it again until
+ * we traverse the whole structure without processing any postcommands.
+ *
+ * We are also going to set up the cascade back pointers in here
+ * since we have to traverse the entire structure underneath the menu
+ * anyway, We can clear the postcommand marks while we do that.
+ *
+ * Results:
+ * The return value is a standard Tcl result (errors can occur
+ * while the postcommands are being processed).
+ *
+ * Side effects:
+ * Since commands can get executed while this routine is being executed,
+ * the entire world can change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkPreprocessMenu(menuPtr)
+ TkMenu *menuPtr;
+{
+ postCommandGeneration++;
+ menuPtr->postCommandGeneration = postCommandGeneration;
+ return PreprocessMenu(menuPtr);
+}
diff --git a/tk/generic/tkMain.c b/tk/generic/tkMain.c
new file mode 100644
index 00000000000..02ef0afd422
--- /dev/null
+++ b/tk/generic/tkMain.c
@@ -0,0 +1,390 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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
+ * next argument doesn't start with a "-" then strip it off and
+ * use it as the name of a script file to process.
+ */
+
+ fileName = NULL;
+ if (argc > 1) {
+ length = strlen(argv[1]);
+ if ((length >= 2) && (strncmp(argv[1], "-file", length) == 0)) {
+ argc--;
+ argv++;
+ }
+ }
+ if ((argc > 1) && (argv[1][0] != '-')) {
+ fileName = argv[1];
+ argc--;
+ argv++;
+ }
+
+ /*
+ * 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.
+ */
+
+ Tk_MainLoop();
+ Tcl_DeleteInterp(interp);
+ Tcl_Exit(0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * StdinProc --
+ *
+ * This procedure is invoked by the event dispatcher whenever
+ * standard input becomes readable. It grabs the next line of
+ * input characters, adds them to a command being assembled, and
+ * executes the command if it's complete.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Could be almost arbitrary, depending on the command that's
+ * typed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+StdinProc(clientData, mask)
+ 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;
+
+ /*
+ * Disable the stdin channel handler while evaluating the command;
+ * otherwise if the command re-enters the event loop we might
+ * process commands from stdin before the current command is
+ * finished. Among other things, this will trash the text of the
+ * command being evaluated.
+ */
+
+ Tcl_CreateChannelHandler(chan, 0, StdinProc, (ClientData) chan);
+ 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Prompt --
+ *
+ * Issue a prompt on standard output, or invoke a script
+ * to issue the prompt.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A prompt gets output, and a Tcl script may be evaluated
+ * in interp.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Prompt(interp, partial)
+ Tcl_Interp *interp; /* Interpreter to use for prompting. */
+ int partial; /* Non-zero means there already
+ * exists a partial command, so use
+ * the secondary prompt. */
+{
+ char *promptCmd;
+ int code;
+ Tcl_Channel outChannel, errChannel;
+
+ promptCmd = Tcl_GetVar(interp,
+ partial ? "tcl_prompt2" : "tcl_prompt1", TCL_GLOBAL_ONLY);
+ if (promptCmd == NULL) {
+defaultPrompt:
+ if (!partial) {
+
+ /*
+ * 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);
+ }
+}
diff --git a/tk/generic/tkMenu.c b/tk/generic/tkMenu.c
new file mode 100644
index 00000000000..3663d40ecbc
--- /dev/null
+++ b/tk/generic/tkMenu.c
@@ -0,0 +1,3057 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * Notes on implementation of menus:
+ *
+ * Menus can be used in three ways:
+ * - as a popup menu, either as part of a menubutton or standalone.
+ * - as a menubar. The menu's cascade items are arranged according to
+ * the specific platform to provide the user access to the menus at all
+ * times
+ * - as a tearoff palette. This is a window with the menu's items in it.
+ *
+ * The goal is to provide the Tk developer with a way to use a common
+ * set of menus for all of these tasks.
+ *
+ * In order to make the bindings for cascade menus work properly under Unix,
+ * the cascade menus' pathnames must be proper children of the menu that
+ * they are cascade from. So if there is a menu .m, and it has two
+ * cascades labelled "File" and "Edit", the cascade menus might have
+ * the pathnames .m.file and .m.edit. Another constraint is that the menus
+ * used for menubars must be children of the toplevel widget that they
+ * are attached to. And on the Macintosh, the platform specific menu handle
+ * for cascades attached to a menu bar must have a title that matches the
+ * label for the cascade menu.
+ *
+ * To handle all of the constraints, Tk menubars and tearoff menus are
+ * implemented using menu clones. Menu clones are full menus in their own
+ * right; they have a Tk window and pathname associated with them; they have
+ * a TkMenu structure and array of entries. However, they are linked with the
+ * original menu that they were cloned from. The reflect the attributes of
+ * the original, or "master", menu. So if an item is added to a menu, and
+ * that menu has clones, then the item must be added to all of its clones
+ * also. Menus are cloned when a menu is torn-off or when a menu is assigned
+ * as a menubar using the "-menu" option of the toplevel's pathname configure
+ * subcommand. When a clone is destroyed, only the clone is destroyed, but
+ * when the master menu is destroyed, all clones are also destroyed. This
+ * allows the developer to just deal with one set of menus when creating
+ * and destroying.
+ *
+ * Clones are rather tricky when a menu with cascade entries is cloned (such
+ * as a menubar). Not only does the menu have to be cloned, but each cascade
+ * entry's corresponding menu must also be cloned. This maintains the pathname
+ * parent-child hierarchy necessary for menubars and toplevels to work.
+ * This leads to several special cases:
+ *
+ * 1. When a new menu is created, and it is pointed to by cascade entries in
+ * cloned menus, the new menu has to be cloned to parallel the cascade
+ * structure.
+ * 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.
+ *
+ * If a menu has an instance and has cascade entries, then each cascade
+ * menu must also have a parallel instance. This is especially true on
+ * the Mac, where each menu has to have a separate title everytime it is in
+ * a menubar. For instance, say you have a menu .m1 with a cascade entry
+ * for .m2, where .m2 does not exist yet. You then put .m1 into a menubar.
+ * This creates a menubar instance for .m1, but since .m2 is not there,
+ * nothing else happens. When we go to create .m2, we hook it up properly
+ * with .m1. However, we now need to clone .m2 and assign the clone of .m2
+ * 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,
+ * find them and notify them so that they can reconfigure their
+ * geometry to reflect the menu.
+ */
+
+ if (menuRefPtr->topLevelListPtr != NULL) {
+ TkMenuTopLevelList *topLevelListPtr = menuRefPtr->topLevelListPtr;
+ TkMenuTopLevelList *nextPtr;
+ Tk_Window listtkwin;
+ while (topLevelListPtr != NULL) {
+
+ /*
+ * Need to get the next pointer first. TkSetWindowMenuBar
+ * changes the list, so that the next pointer is different
+ * after calling it.
+ */
+
+ nextPtr = topLevelListPtr->nextPtr;
+ 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
+ * entry associated with that index.
+ *
+ * Results:
+ * Standard Tcl result.
+ *
+ * Side effects:
+ * Commands may get excecuted; variables may get set; sub-menus may
+ * get posted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkInvokeMenu(interp, menuPtr, index)
+ Tcl_Interp *interp; /* The interp that the menu lives in. */
+ TkMenu *menuPtr; /* The menu we are invoking. */
+ int index; /* The zero based index of the item we
+ * are invoking */
+{
+ 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
+ * to clean up the internal structure of a menu at a safe time
+ * (when no-one is using it anymore). Only takes care of one instance
+ * of the menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the menu is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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
+ * back to this entry name if this is a master menu pointed to by another
+ * master menu. If there is a clone menu that points to this menu,
+ * then this menu is itself a clone, so when this menu goes away,
+ * the -menu field of the pointing entry must be set back to this
+ * menu's master menu name so that later if another menu is created
+ * the cascade hierarchy can be maintained.
+ */
+
+ 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 --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a menu at a safe time
+ * (when no-one is using it anymore). If called on a master instance,
+ * destroys all of the slave instances. If called on a non-master
+ * instance, just destroys that instance.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the menu is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkDestroyMenu(menuPtr)
+ TkMenu *menuPtr; /* Info about menu widget. */
+{
+ TkMenu *menuInstancePtr;
+ TkMenuTopLevelList *topLevelListPtr, *nextTopLevelPtr;
+
+ if (menuPtr->menuFlags & MENU_DELETION_PENDING) {
+ return;
+ }
+
+ /*
+ * Now destroy all non-tearoff instances of this menu if this is a
+ * parent menu. Is this loop safe enough? Are there going to be
+ * destroy bindings on child menus which kill the parent? If not,
+ * we have to do a slightly more complex scheme.
+ */
+
+ if (menuPtr->masterMenuPtr == menuPtr) {
+ menuPtr->menuFlags |= MENU_DELETION_PENDING;
+ while (menuPtr->nextInstancePtr != NULL) {
+ menuInstancePtr = menuPtr->nextInstancePtr;
+ menuPtr->nextInstancePtr = menuInstancePtr->nextInstancePtr;
+ if (menuInstancePtr->tkwin != NULL) {
+ Tk_DestroyWindow(menuInstancePtr->tkwin);
+ }
+ }
+ menuPtr->menuFlags &= ~MENU_DELETION_PENDING;
+ }
+
+ /*
+ * If any toplevel widgets have this menu as their menubar,
+ * the geometry of the window may have to be recalculated.
+ */
+
+ topLevelListPtr = menuPtr->menuRefPtr->topLevelListPtr;
+ while (topLevelListPtr != NULL) {
+ nextTopLevelPtr = topLevelListPtr->nextPtr;
+ TkpSetWindowMenuBar(topLevelListPtr->tkwin, NULL);
+ topLevelListPtr = nextTopLevelPtr;
+ }
+ DestroyMenuInstance(menuPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UnhookCascadeEntry --
+ *
+ * This entry is removed from the list of entries that point to the
+ * cascade menu. This is done in preparation for changing the menu
+ * that this entry points to.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * The appropriate lists are modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UnhookCascadeEntry(mePtr)
+ TkMenuEntry *mePtr; /* The cascade entry we are removing
+ * from the cascade list. */
+{
+ TkMenuEntry *cascadeEntryPtr;
+ TkMenuEntry *prevCascadePtr;
+ TkMenuReferences *menuRefPtr;
+
+ menuRefPtr = mePtr->childMenuRefPtr;
+ if (menuRefPtr == NULL) {
+ return;
+ }
+
+ cascadeEntryPtr = menuRefPtr->parentEntryPtr;
+ if (cascadeEntryPtr == NULL) {
+ return;
+ }
+
+ /*
+ * Singularly linked list deletion. The two special cases are
+ * 1. one element; 2. The first element is the one we want.
+ */
+
+ if (cascadeEntryPtr == mePtr) {
+ if (cascadeEntryPtr->nextCascadePtr == NULL) {
+
+ /*
+ * This is the last menu entry which points to this
+ * menu, so we need to clear out the list pointer in the
+ * cascade itself.
+ */
+
+ menuRefPtr->parentEntryPtr = NULL;
+ TkFreeMenuReferences(menuRefPtr);
+ } else {
+ menuRefPtr->parentEntryPtr = cascadeEntryPtr->nextCascadePtr;
+ }
+ mePtr->nextCascadePtr = NULL;
+ } else {
+ for (prevCascadePtr = cascadeEntryPtr,
+ cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr;
+ cascadeEntryPtr != NULL;
+ prevCascadePtr = cascadeEntryPtr,
+ cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
+ if (cascadeEntryPtr == mePtr){
+ prevCascadePtr->nextCascadePtr =
+ cascadeEntryPtr->nextCascadePtr;
+ cascadeEntryPtr->nextCascadePtr = NULL;
+ break;
+ }
+ }
+ }
+ mePtr->childMenuRefPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyMenuEntry --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a menu entry at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the menu entry is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyMenuEntry(memPtr)
+ char *memPtr; /* Pointer to entry to be freed. */
+{
+ register TkMenuEntry *mePtr = (TkMenuEntry *) memPtr;
+ TkMenu *menuPtr = mePtr->menuPtr;
+
+ if (menuPtr->postedCascade == mePtr) {
+
+ /*
+ * Ignore errors while unposting the menu, since it's possible
+ * that the menu has already been deleted and the unpost will
+ * generate an error.
+ */
+
+ 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 --
+ *
+ * This procedure is called when the world has changed in some
+ * way (such as the fonts in the system changing) and the widget needs
+ * to recompute all its graphics contexts and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Menu will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+MenuWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ TkMenu *menuPtr = (TkMenu *) instanceData;
+ int i;
+
+ 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;
+ cascadeEntryPtr != NULL;
+ cascadeEntryPtr =
+ cascadeEntryPtr->nextCascadePtr) {
+ if (cascadeEntryPtr == mePtr) {
+ alreadyThere = 1;
+ break;
+ }
+ }
+
+ /*
+ * Put the item at the front of the list.
+ */
+
+ if (!alreadyThere) {
+ mePtr->nextCascadePtr = menuRefPtr->parentEntryPtr;
+ menuRefPtr->parentEntryPtr = mePtr;
+ }
+ }
+ }
+ }
+
+ if (TkMenuConfigureEntryDrawOptions(mePtr, index) != TCL_OK) {
+ 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 --
+ *
+ * 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
+MenuCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ TkMenu *menuPtr = (TkMenu *) clientData;
+ Tk_Window tkwin = menuPtr->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) {
+ menuPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuNewEntry --
+ *
+ * This procedure allocates and initializes a new menu entry.
+ *
+ * Results:
+ * The return value is a pointer to a new menu entry structure,
+ * which has been malloc-ed, initialized, and entered into the
+ * entry array for the menu.
+ *
+ * Side effects:
+ * Storage gets allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkMenuEntry *
+MenuNewEntry(menuPtr, index, type)
+ TkMenu *menuPtr; /* Menu that will hold the new entry. */
+ int index; /* Where in the menu the new entry is to
+ * go. */
+ int type; /* The type of the new entry. */
+{
+ TkMenuEntry *mePtr;
+ TkMenuEntry **newEntries;
+ int i;
+
+ /*
+ * Create a new array of entries with an empty slot for the
+ * new entry.
+ */
+
+ newEntries = (TkMenuEntry **) ckalloc((unsigned)
+ ((menuPtr->numEntries+1)*sizeof(TkMenuEntry *)));
+ for (i = 0; i < index; i++) {
+ newEntries[i] = menuPtr->entries[i];
+ }
+ for ( ; i < menuPtr->numEntries; i++) {
+ newEntries[i+1] = menuPtr->entries[i];
+ newEntries[i+1]->index = i + 1;
+ }
+ if (menuPtr->numEntries != 0) {
+ 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 --
+ *
+ * This procedure does all of the work of the "add" and "insert"
+ * widget commands, allowing the code for these to be shared.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * 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++) {
+ errorMenuPtr->entries[i] = errorMenuPtr->entries[i + 1];
+ errorMenuPtr->entries[i]->index = i;
+ }
+ errorMenuPtr->numEntries--;
+ if (errorMenuPtr->numEntries == 0) {
+ ckfree((char *) errorMenuPtr->entries);
+ errorMenuPtr->entries = NULL;
+ }
+ if (errorMenuPtr == menuListPtr) {
+ break;
+ }
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * If a menu has cascades, then every instance of the menu has
+ * to have its own parallel cascade structure. So adding an
+ * 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MenuVarProc --
+ *
+ * This procedure is invoked when someone changes the
+ * state variable associated with a radiobutton or checkbutton
+ * menu entry. The entry's selected state is set to match
+ * the value of the variable.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The menu entry may become selected or deselected.
+ *
+ *--------------------------------------------------------------
+ */
+
+static char *
+MenuVarProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Information about menu entry. */
+ Tcl_Interp *interp; /* Interpreter containing variable. */
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkActivateMenuEntry --
+ *
+ * This procedure is invoked to make a particular menu entry
+ * the active one, deactivating any other entry that might
+ * currently be active.
+ *
+ * Results:
+ * The return value is a standard Tcl result (errors can occur
+ * while posting and unposting submenus).
+ *
+ * Side effects:
+ * Menu entries get redisplayed, and the active entry changes.
+ * Submenus may get posted and unposted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkActivateMenuEntry(menuPtr, index)
+ register TkMenu *menuPtr; /* Menu in which to activate. */
+ int index; /* Index of entry to activate, or
+ * -1 to deactivate all entries. */
+{
+ register TkMenuEntry *mePtr;
+ int result = TCL_OK;
+
+ if (menuPtr->active >= 0) {
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPostCommand --
+ *
+ * Execute the postcommand for the given menu.
+ *
+ * Results:
+ * The return value is a standard Tcl result (errors can occur
+ * while the postcommands are being processed).
+ *
+ * Side effects:
+ * Since commands can get executed while this routine is being executed,
+ * the entire world can change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkPostCommand(menuPtr)
+ TkMenu *menuPtr;
+{
+ int result;
+
+ /*
+ * 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CloneMenu --
+ *
+ * Creates a child copy of the menu. It will be inserted into
+ * the menu's instance chain. All attributes and entry
+ * attributes will be duplicated.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Allocates storage. After the menu is created, any
+ * 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.
+ */
+
+ if (menuPtr->nextInstancePtr == NULL) {
+ menuPtr->nextInstancePtr = newMenuPtr;
+ newMenuPtr->masterMenuPtr = menuPtr->masterMenuPtr;
+ } else {
+ TkMenu *masterMenuPtr;
+
+ masterMenuPtr = menuPtr->masterMenuPtr;
+ newMenuPtr->nextInstancePtr = masterMenuPtr->nextInstancePtr;
+ masterMenuPtr->nextInstancePtr = newMenuPtr;
+ newMenuPtr->masterMenuPtr = masterMenuPtr;
+ }
+
+ /*
+ * Add the master menu's window to the bind tags for this window
+ * after this window's tag. This is so the user can bind to either
+ * this clone (which may not be easy to do) or the entire menu
+ * clone structure.
+ */
+
+ 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;
+ }
+ Tcl_Release((ClientData) menuPtr);
+ return returnResult;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuDoYPosition --
+ *
+ * Given arguments from an option command line, returns the Y position.
+ *
+ * Results:
+ * Returns TCL_OK or TCL_Error
+ *
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetIndexFromCoords --
+ *
+ * Given a string of the form "@int", return the menu item corresponding
+ * to int.
+ *
+ * Results:
+ * If int is a valid number, *indexPtr will be the number of the menuentry
+ * that is the correct height. If int is invaled, *indexPtr will be
+ * unchanged. Returns appropriate Tcl error number.
+ *
+ * Side effects:
+ * If int is invalid, interp's result will set to NULL.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetIndexFromCoords(interp, menuPtr, string, indexPtr)
+ Tcl_Interp *interp; /* interp of menu */
+ TkMenu *menuPtr; /* the menu we are searching */
+ char *string; /* The @string we are parsing */
+ int *indexPtr; /* The index of the item that matches */
+{
+ int x, y, i;
+ char *p, *end;
+
+ TkRecomputeMenu(menuPtr);
+ p = string + 1;
+ y = strtol(p, &end, 0);
+ if (end == p) {
+ goto error;
+ }
+ if (*end == ',') {
+ 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))) {
+ break;
+ }
+ }
+ if (i >= menuPtr->numEntries) {
+ /* i = menuPtr->numEntries - 1; */
+ i = -1;
+ }
+ *indexPtr = i;
+ return TCL_OK;
+
+ error:
+ Tcl_SetResult(interp, (char *) NULL, TCL_STATIC);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecursivelyDeleteMenu --
+ *
+ * Deletes a menu and any cascades underneath it. Used for deleting
+ * instances when a menu is no longer being used as a menubar,
+ * for instance.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Destroys the menu and all cascade menus underneath it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RecursivelyDeleteMenu(menuPtr)
+ TkMenu *menuPtr; /* The menubar instance we are deleting */
+{
+ int i;
+ TkMenuEntry *mePtr;
+
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ mePtr = menuPtr->entries[i];
+ if ((mePtr->type == CASCADE_ENTRY)
+ && (mePtr->childMenuRefPtr != NULL)
+ && (mePtr->childMenuRefPtr->menuPtr != NULL)) {
+ RecursivelyDeleteMenu(mePtr->childMenuRefPtr->menuPtr);
+ }
+ }
+ Tk_DestroyWindow(menuPtr->tkwin);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkNewMenuName --
+ *
+ * Makes a new unique name for a cloned menu. Will be a child
+ * of oldName.
+ *
+ * Results:
+ * Returns a char * which has been allocated; caller must free.
+ *
+ * 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 --
+ *
+ * Associates a menu with a window. Called by ConfigureFrame in
+ * in response to a "-menu .foo" configuration option for a top
+ * level.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The old menu clones for the menubar are thrown away, and a
+ * handler is set up to allocate the new ones.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TkSetWindowMenuBar(interp, tkwin, oldMenuName, menuName)
+ Tcl_Interp *interp; /* The interpreter the toplevel lives in. */
+ Tk_Window tkwin; /* The toplevel window */
+ char *oldMenuName; /* The name of the menubar previously set in
+ * this toplevel. NULL means no menu was
+ * set previously. */
+ char *menuName; /* The name of the new menubar that the
+ * toplevel needs to be set to. NULL means
+ * that their is no menu now. */
+{
+ TkMenuTopLevelList *topLevelListPtr, *prevTopLevelPtr;
+ TkMenu *menuPtr;
+ TkMenuReferences *menuRefPtr;
+
+ TkMenuInit();
+
+ /*
+ * Destroy the menubar instances of the old menu. Take this window
+ * out of the old menu's top level reference list.
+ */
+
+ if (oldMenuName != NULL) {
+ menuRefPtr = TkFindMenuReferences(interp, oldMenuName);
+ if (menuRefPtr != NULL) {
+
+ /*
+ * Find the menubar instance that is to be removed. Destroy
+ * it and all of the cascades underneath it.
+ */
+
+ if (menuRefPtr->menuPtr != NULL) {
+ TkMenu *instancePtr;
+
+ menuPtr = menuRefPtr->menuPtr;
+
+ for (instancePtr = menuPtr->masterMenuPtr;
+ instancePtr != NULL;
+ instancePtr = instancePtr->nextInstancePtr) {
+ if (instancePtr->menuType == MENUBAR
+ && instancePtr->parentTopLevelPtr == tkwin) {
+ RecursivelyDeleteMenu(instancePtr);
+ break;
+ }
+ }
+ }
+
+ /*
+ * Now we need to remove this toplevel from the list of toplevels
+ * that reference this menu.
+ */
+
+ for (topLevelListPtr = menuRefPtr->topLevelListPtr,
+ prevTopLevelPtr = NULL;
+ (topLevelListPtr != NULL)
+ && (topLevelListPtr->tkwin != tkwin);
+ prevTopLevelPtr = topLevelListPtr,
+ topLevelListPtr = topLevelListPtr->nextPtr) {
+
+ /*
+ * Empty loop body.
+ */
+
+ }
+
+ /*
+ * Now we have found the toplevel reference that matches the
+ * tkwin; remove this reference from the list.
+ */
+
+ if (topLevelListPtr != NULL) {
+ if (prevTopLevelPtr == NULL) {
+ menuRefPtr->topLevelListPtr =
+ menuRefPtr->topLevelListPtr->nextPtr;
+ } else {
+ prevTopLevelPtr->nextPtr = topLevelListPtr->nextPtr;
+ }
+ ckfree((char *) topLevelListPtr);
+ TkFreeMenuReferences(menuRefPtr);
+ }
+ }
+ }
+
+ /*
+ * Now, add the clone references for the new menu.
+ */
+
+ 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
+ * to this menu.
+ */
+
+ topLevelListPtr = (TkMenuTopLevelList *)
+ ckalloc(sizeof(TkMenuTopLevelList));
+ topLevelListPtr->tkwin = tkwin;
+ topLevelListPtr->nextPtr = menuRefPtr->topLevelListPtr;
+ menuRefPtr->topLevelListPtr = topLevelListPtr;
+ } else {
+ TkpSetWindowMenuBar(tkwin, NULL);
+ }
+ TkpSetMainMenubar(interp, tkwin, menuName);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyMenuHashTable --
+ *
+ * Called when an interp is deleted and a menu hash table has
+ * been set in it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The hash table is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyMenuHashTable(clientData, interp)
+ ClientData clientData; /* The menu hash table we are destroying */
+ Tcl_Interp *interp; /* The interpreter we are destroying */
+{
+ Tcl_DeleteHashTable((Tcl_HashTable *) clientData);
+ ckfree((char *) clientData);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetMenuHashTable --
+ *
+ * For a given interp, give back the menu hash table that goes with
+ * it. If the hash table does not exist, it is created.
+ *
+ * Results:
+ * Returns a hash table pointer.
+ *
+ * Side effects:
+ * A new hash table is created if there were no table in the interp
+ * originally.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tcl_HashTable *
+TkGetMenuHashTable(interp)
+ Tcl_Interp *interp; /* The interp we need the hash table in.*/
+{
+ Tcl_HashTable *menuTablePtr;
+
+ menuTablePtr = (Tcl_HashTable *) Tcl_GetAssocData(interp, MENU_HASH_KEY,
+ NULL);
+ if (menuTablePtr == NULL) {
+ menuTablePtr = (Tcl_HashTable *) ckalloc(sizeof(Tcl_HashTable));
+ Tcl_InitHashTable(menuTablePtr, TCL_STRING_KEYS);
+ Tcl_SetAssocData(interp, MENU_HASH_KEY, DestroyMenuHashTable,
+ (ClientData) menuTablePtr);
+ }
+ return menuTablePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCreateMenuReferences --
+ *
+ * Given a pathname, gives back a pointer to a TkMenuReferences structure.
+ * If a reference is not already in the hash table, one is created.
+ *
+ * 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.
+ *
+ * Side effects:
+ * A new hash table entry is created if there were no references
+ * to the menu originally.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkMenuReferences *
+TkCreateMenuReferences(interp, pathName)
+ Tcl_Interp *interp;
+ char *pathName; /* The path of the menu widget */
+{
+ Tcl_HashEntry *hashEntryPtr;
+ TkMenuReferences *menuRefPtr;
+ int newEntry;
+ Tcl_HashTable *menuTablePtr = TkGetMenuHashTable(interp);
+
+ hashEntryPtr = Tcl_CreateHashEntry(menuTablePtr, pathName, &newEntry);
+ if (newEntry) {
+ menuRefPtr = (TkMenuReferences *) ckalloc(sizeof(TkMenuReferences));
+ menuRefPtr->menuPtr = NULL;
+ menuRefPtr->topLevelListPtr = NULL;
+ menuRefPtr->parentEntryPtr = NULL;
+ menuRefPtr->hashEntryPtr = hashEntryPtr;
+ Tcl_SetHashValue(hashEntryPtr, (char *) menuRefPtr);
+ } else {
+ menuRefPtr = (TkMenuReferences *) Tcl_GetHashValue(hashEntryPtr);
+ }
+ return menuRefPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFindMenuReferences --
+ *
+ * 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 *
+TkFindMenuReferences(interp, pathName)
+ Tcl_Interp *interp; /* The interp the menu is living in. */
+ char *pathName; /* The path of the menu widget */
+{
+ Tcl_HashEntry *hashEntryPtr;
+ TkMenuReferences *menuRefPtr = NULL;
+ Tcl_HashTable *menuTablePtr;
+
+ menuTablePtr = TkGetMenuHashTable(interp);
+ hashEntryPtr = Tcl_FindHashEntry(menuTablePtr, pathName);
+ if (hashEntryPtr != NULL) {
+ menuRefPtr = (TkMenuReferences *) Tcl_GetHashValue(hashEntryPtr);
+ }
+ 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.
+ *
+ * Side effects:
+ * If this is the last field to be cleared, the menu ref is
+ * taken out of the hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFreeMenuReferences(menuRefPtr)
+ TkMenuReferences *menuRefPtr; /* The menu reference to
+ * free */
+{
+ if ((menuRefPtr->menuPtr == NULL)
+ && (menuRefPtr->parentEntryPtr == NULL)
+ && (menuRefPtr->topLevelListPtr == NULL)) {
+ Tcl_DeleteHashEntry(menuRefPtr->hashEntryPtr);
+ ckfree((char *) menuRefPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteMenuCloneEntries --
+ *
+ * For every clone in this clone chain, delete the menu entries
+ * given by the parameters.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The appropriate entries are deleted from all clones of this menu.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteMenuCloneEntries(menuPtr, first, last)
+ TkMenu *menuPtr; /* the menu the command was issued with */
+ int first; /* the zero-based first entry in the set
+ * of entries to delete. */
+ int last; /* the zero-based last entry */
+{
+
+ TkMenu *menuListPtr;
+ int numDeleted, i;
+
+ numDeleted = last + 1 - first;
+ for (menuListPtr = menuPtr->masterMenuPtr; menuListPtr != NULL;
+ menuListPtr = menuListPtr->nextInstancePtr) {
+ for (i = last; i >= first; i--) {
+ Tcl_EventuallyFree((ClientData) menuListPtr->entries[i],
+ DestroyMenuEntry);
+ }
+ for (i = last + 1; i < menuListPtr->numEntries; i++) {
+ menuListPtr->entries[i - numDeleted] = menuListPtr->entries[i];
+ menuListPtr->entries[i - numDeleted]->index = i;
+ }
+ menuListPtr->numEntries -= numDeleted;
+ if (menuListPtr->numEntries == 0) {
+ ckfree((char *) menuListPtr->entries);
+ menuListPtr->entries = NULL;
+ }
+ if ((menuListPtr->active >= first)
+ && (menuListPtr->active <= last)) {
+ menuListPtr->active = -1;
+ } else if (menuListPtr->active > last) {
+ menuListPtr->active -= numDeleted;
+ }
+ TkEventuallyRecomputeMenu(menuListPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuInit --
+ *
+ * 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
+TkMenuInit()
+{
+ if (!menusInitialized) {
+ TkpMenuInit();
+ menusInitialized = 1;
+ }
+}
diff --git a/tk/generic/tkMenu.h b/tk/generic/tkMenu.h
new file mode 100644
index 00000000000..27b9dfa61b3
--- /dev/null
+++ b/tk/generic/tkMenu.h
@@ -0,0 +1,549 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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. */
+ 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.
+ */
+
+ int width; /* Number of pixels occupied by entry in
+ * horizontal dimension. Not used except
+ * in menubars. The width of norma menus
+ * is dependent on the rest of the menu. */
+ int x; /* X-coordinate of leftmost pixel in entry */
+ int height; /* Number of pixels occupied by entry in
+ * vertical dimension, including raised
+ * border drawn around entry when active. */
+ int y; /* Y-coordinate of topmost pixel in entry. */
+ GC textGC; /* GC for drawing text in entry. NULL means
+ * use overall textGC for menu. */
+ GC activeGC; /* GC for drawing text in entry when active.
+ * NULL means use overall activeGC for
+ * menu. */
+ GC disabledGC; /* Used to produce disabled effect for entry.
+ * NULL means use overall disabledGC from
+ * menu structure. See comments for
+ * disabledFg in menu structure for more
+ * information. */
+ GC indicatorGC; /* For drawing indicators. None means use
+ * GC from menu. */
+
+ /*
+ * Miscellaneous fields.
+ */
+
+ int entryFlags; /* Various flags. See below for
+ definitions. */
+ int index; /* Need to know which index we are. This
+ * is zero-based. This is the top-left entry
+ * of the menu. */
+
+ /*
+ * Bookeeping for master menus and cascade menus.
+ */
+
+ struct TkMenuReferences *childMenuRefPtr;
+ /* A pointer to the hash table entry for
+ * the child menu. Stored here when the menu
+ * entry is configured so that a hash lookup
+ * is not necessary later.*/
+ struct TkMenuEntry *nextCascadePtr;
+ /* 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 {
+ Tk_Window tkwin; /* Window that embodies the pane. 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 be
+ * freed up even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with menu. */
+ Tcl_Command widgetCmd; /* Token for menu's widget command. */
+ 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
+ * disabledFg isn't NULL, this GC is used to
+ * draw text and icons for disabled entries.
+ * Otherwise text and icons are drawn with
+ * normalGC and this GC is used to stipple
+ * background across them. */
+ GC activeGC; /* GC for drawing active entry. */
+ GC indicatorGC; /* For drawing indicators. */
+ GC disabledImageGC; /* Used for drawing disabled images. They
+ * have to be stippled. This is created
+ * when the image is about to be drawn the
+ * first time. */
+
+ /*
+ * Information about geometry of menu.
+ */
+
+ 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.
+ */
+
+typedef struct TkMenuTopLevelList {
+ struct TkMenuTopLevelList *nextPtr;
+ /* The next window in the list */
+ Tk_Window tkwin; /* The window that has this menu as its
+ * menubar. */
+} TkMenuTopLevelList;
+
+/*
+ * The following structure is used to keep track of things which
+ * reference a menu. It is created when:
+ * - a menu is created.
+ * - a cascade entry is added to a menu with a non-null name
+ * - the "-menu" configuration option is used on a toplevel widget
+ * with a non-null parameter.
+ *
+ * One of these three fields must be non-NULL, but any of the fields may
+ * be NULL. This structure makes it easy to determine whether or not
+ * anything like recalculating platform data or geometry is necessary
+ * when one of the three actions above is performed.
+ */
+
+typedef struct TkMenuReferences {
+ struct TkMenu *menuPtr; /* The menu data structure. This is NULL
+ * if the menu does not exist. */
+ TkMenuTopLevelList *topLevelListPtr;
+ /* First in the list of all toplevels that
+ * have this menu as its menubar. NULL if no
+ * toplevel widgets have this menu as its
+ * menubar. */
+ TkMenuEntry *parentEntryPtr;/* First in the list of all cascade menu
+ * entries that have this menu as their child.
+ * 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
+ * has already been scheduled.
+ * MENU_DELETION_PENDING Non-zero means that we are currently destroying
+ * this menu. This is useful when we are in the
+ * middle of cleaning this master menu's chain of
+ * menus up when TkDestroyMenu was called again on
+ * this menu (via a destroy binding or somesuch).
+ * MENU_PLATFORM_FLAG1... Reserved for use by the platform-specific menu
+ * code.
+ */
+
+#define REDRAW_PENDING 1
+#define RESIZE_PENDING 2
+#define MENU_DELETION_PENDING 4
+#define MENU_PLATFORM_FLAG1 (1 << 30)
+#define MENU_PLATFORM_FLAG2 (1 << 29)
+#define MENU_PLATFORM_FLAG3 (1 << 28)
+
+/*
+ * Each menu created by the user is a MASTER_MENU. When a menu is torn off,
+ * a TEAROFF_MENU instance is created. When a menu is assigned to a toplevel
+ * as a menu bar, a MENUBAR instance is created. All instances have the same
+ * configuration information. If the master instance is deleted, all instances
+ * are deleted. If one of the other instances is deleted, only that instance
+ * is deleted.
+ */
+
+#define UNKNOWN_TYPE -1
+#define MASTER_MENU 0
+#define TEAROFF_MENU 1
+#define MENUBAR 2
+
+/*
+ * 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_((
+ TkMenuEntry *mePtr, int index));
+EXTERN void TkMenuFreeDrawOptions _ANSI_ARGS_((TkMenu *menuPtr));
+EXTERN void TkMenuEntryFreeDrawOptions _ANSI_ARGS_((
+ TkMenuEntry *mePtr));
+EXTERN void TkMenuEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+EXTERN void TkMenuImageProc _ANSI_ARGS_((
+ 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));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKMENU */
+
diff --git a/tk/generic/tkMenuDraw.c b/tk/generic/tkMenuDraw.c
new file mode 100644
index 00000000000..6109310bb7a
--- /dev/null
+++ b/tk/generic/tkMenuDraw.c
@@ -0,0 +1,1039 @@
+/*
+ * 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$
+ */
+
+#include "tkMenu.h"
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void AdjustMenuCoords _ANSI_ARGS_ ((TkMenu *menuPtr,
+ TkMenuEntry *mePtr, int *xPtr, int *yPtr,
+ char *string));
+static void ComputeMenuGeometry _ANSI_ARGS_((
+ ClientData clientData));
+static void DisplayMenu _ANSI_ARGS_((ClientData clientData));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuInitializeDrawingFields(menuPtr)
+ TkMenu *menuPtr; /* The menu we are initializing. */
+{
+ menuPtr->textGC = None;
+ menuPtr->gray = None;
+ menuPtr->disabledGC = None;
+ menuPtr->activeGC = None;
+ menuPtr->indicatorGC = None;
+ menuPtr->disabledImageGC = None;
+ menuPtr->totalWidth = menuPtr->totalHeight = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuInitializeEntryDrawingFields --
+ *
+ * Fills in drawing fields of a new menu entry. Called when an
+ * entry is created.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuInitializeEntryDrawingFields(mePtr)
+ TkMenuEntry *mePtr; /* The menu we are initializing. */
+{
+ mePtr->width = 0;
+ mePtr->height = 0;
+ mePtr->x = 0;
+ mePtr->y = 0;
+ mePtr->indicatorSpace = 0;
+ mePtr->labelWidth = 0;
+ mePtr->textGC = None;
+ mePtr->activeGC = None;
+ mePtr->disabledGC = None;
+ mePtr->indicatorGC = None;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuFreeDrawOptions --
+ *
+ * Frees up any structures allocated for the drawing of a menu.
+ * Called when menu is deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Storage is released.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuFreeDrawOptions(menuPtr)
+ TkMenu *menuPtr;
+{
+ if (menuPtr->textGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->textGC);
+ }
+ if (menuPtr->disabledImageGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->disabledImageGC);
+ }
+ if (menuPtr->gray != None) {
+ Tk_FreeBitmap(menuPtr->display, menuPtr->gray);
+ }
+ if (menuPtr->disabledGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->disabledGC);
+ }
+ if (menuPtr->activeGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->activeGC);
+ }
+ if (menuPtr->indicatorGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->indicatorGC);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuEntryFreeDrawOptions --
+ *
+ * Frees up drawing structures for a menu entry. Called when
+ * menu entry is freed.
+ *
+ * RESULTS:
+ * None.
+ *
+ * Side effects:
+ * Storage is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuEntryFreeDrawOptions(mePtr)
+ TkMenuEntry *mePtr;
+{
+ if (mePtr->textGC != None) {
+ Tk_FreeGC(mePtr->menuPtr->display, mePtr->textGC);
+ }
+ if (mePtr->disabledGC != None) {
+ Tk_FreeGC(mePtr->menuPtr->display, mePtr->disabledGC);
+ }
+ if (mePtr->activeGC != None) {
+ Tk_FreeGC(mePtr->menuPtr->display, mePtr->activeGC);
+ }
+ if (mePtr->indicatorGC != None) {
+ Tk_FreeGC(mePtr->menuPtr->display, mePtr->indicatorGC);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuConfigureDrawOptions --
+ *
+ * Sets the menu's drawing attributes in preparation for drawing
+ * the menu.
+ *
+ * RESULTS:
+ * None.
+ *
+ * Side effects:
+ * Storage is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuConfigureDrawOptions(menuPtr)
+ TkMenu *menuPtr; /* The menu we are configuring. */
+{
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+ XColor *foreground, *background;
+
+ /*
+ * 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_GetGCColor(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
+ &gcValues, menuPtr->fg, Tk_3DBorderColor(menuPtr->border));
+ if (menuPtr->textGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->textGC);
+ }
+ menuPtr->textGC = newGC;
+
+ gcValues.font = Tk_FontId(menuPtr->tkfont);
+ background = Tk_3DBorderColor(menuPtr->border);
+ gcValues.background = background->pixel;
+ if (menuPtr->disabledFg != NULL) {
+ foreground = menuPtr->disabledFg;
+ gcValues.foreground = foreground->pixel;
+ mask = GCForeground|GCBackground|GCFont;
+ } else {
+ foreground = background;
+ background = NULL;
+ 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_GetGCColor(menuPtr->tkwin, mask, &gcValues, foreground,
+ background);
+ 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_GetGCColor(menuPtr->tkwin,
+ GCForeground|GCFillStyle|GCStipple, &gcValues,
+ Tk_3DBorderColor(menuPtr->border), NULL);
+ }
+ 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_GetGCColor(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
+ &gcValues, menuPtr->activeFg,
+ Tk_3DBorderColor(menuPtr->activeBorder));
+ 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_GetGCColor(menuPtr->tkwin, GCForeground|GCBackground|GCFont,
+ &gcValues, menuPtr->indicatorFg,
+ Tk_3DBorderColor(menuPtr->border));
+ if (menuPtr->indicatorGC != None) {
+ Tk_FreeGC(menuPtr->display, menuPtr->indicatorGC);
+ }
+ menuPtr->indicatorGC = newGC;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuConfigureEntryDrawOptions --
+ *
+ * Calculates any entry-specific draw options for the given menu
+ * entry.
+ *
+ * Results:
+ * Returns a standard Tcl error.
+ *
+ * Side effects:
+ * Storage may be allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkMenuConfigureEntryDrawOptions(mePtr, index)
+ TkMenuEntry *mePtr;
+ int index;
+{
+
+ 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)) {
+ XColor *foreground, *background;
+
+ background = Tk_3DBorderColor(
+ (mePtr->border != NULL)
+ ? mePtr->border
+ : menuPtr->border);
+ foreground = (mePtr->fg != NULL)
+ ? mePtr->fg
+ : menuPtr->fg;
+
+ gcValues.foreground = foreground->pixel;
+ gcValues.background = background->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_GetGCColor(menuPtr->tkwin,
+ GCForeground|GCBackground|GCFont|GCGraphicsExposures,
+ &gcValues, foreground, background);
+
+ if (mePtr->indicatorFg != NULL) {
+ foreground = mePtr->indicatorFg;
+ gcValues.foreground = foreground->pixel;
+ } else if (menuPtr->indicatorFg != NULL) {
+ foreground = menuPtr->indicatorFg;
+ gcValues.foreground = foreground->pixel;
+ }
+ newIndicatorGC = Tk_GetGCColor(menuPtr->tkwin,
+ GCForeground|GCBackground|GCGraphicsExposures,
+ &gcValues, foreground, background);
+
+ if ((menuPtr->disabledFg != NULL) || (mePtr->image != NULL)) {
+ foreground = menuPtr->disabledFg;
+ gcValues.foreground = foreground->pixel;
+ mask = GCForeground|GCBackground|GCFont|GCGraphicsExposures;
+ } else {
+ foreground = background;
+ background = NULL;
+ gcValues.foreground = gcValues.background;
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = menuPtr->gray;
+ mask = GCForeground|GCFillStyle|GCStipple;
+ }
+ newDisabledGC = Tk_GetGCColor(menuPtr->tkwin, mask, &gcValues,
+ foreground, background);
+
+ foreground = (mePtr->activeFg != NULL)
+ ? mePtr->activeFg
+ : menuPtr->activeFg;
+ gcValues.foreground = foreground->pixel;
+ background = Tk_3DBorderColor(
+ (mePtr->activeBorder != NULL)
+ ? mePtr->activeBorder
+ : menuPtr->activeBorder);
+ gcValues.background = background->pixel;
+ newActiveGC = Tk_GetGCColor(menuPtr->tkwin,
+ GCForeground|GCBackground|GCFont|GCGraphicsExposures,
+ &gcValues, foreground, background);
+ } else {
+ newGC = None;
+ newActiveGC = None;
+ newDisabledGC = None;
+ newIndicatorGC = None;
+ }
+ if (mePtr->textGC != None) {
+ Tk_FreeGC(menuPtr->display, mePtr->textGC);
+ }
+ mePtr->textGC = newGC;
+ if (mePtr->activeGC != None) {
+ Tk_FreeGC(menuPtr->display, mePtr->activeGC);
+ }
+ mePtr->activeGC = newActiveGC;
+ if (mePtr->disabledGC != None) {
+ Tk_FreeGC(menuPtr->display, mePtr->disabledGC);
+ }
+ mePtr->disabledGC = newDisabledGC;
+ if (mePtr->indicatorGC != None) {
+ Tk_FreeGC(menuPtr->display, mePtr->indicatorGC);
+ }
+ mePtr->indicatorGC = newIndicatorGC;
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkEventuallyRecomputeMenu --
+ *
+ * Tells Tcl to redo the geometry because this menu has changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Menu geometry is recomputed at idle time, and the menu will be
+ * redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkEventuallyRecomputeMenu(menuPtr)
+ TkMenu *menuPtr;
+{
+ if (!(menuPtr->menuFlags & RESIZE_PENDING)) {
+ menuPtr->menuFlags |= RESIZE_PENDING;
+ Tcl_DoWhenIdle(ComputeMenuGeometry, (ClientData) menuPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkRecomputeMenu --
+ *
+ * Tells Tcl to redo the geometry because this menu has changed.
+ * Does it now; removes any ComputeMenuGeometries from the idler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Menu geometry is immediately reconfigured.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkRecomputeMenu(menuPtr)
+ TkMenu *menuPtr;
+{
+ if (menuPtr->menuFlags & RESIZE_PENDING) {
+ Tcl_CancelIdleCall(ComputeMenuGeometry, (ClientData) menuPtr);
+ ComputeMenuGeometry((ClientData) menuPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkEventuallyRedrawMenu --
+ *
+ * Arrange for an entry of a menu, or the whole menu, to be
+ * redisplayed at some point in the future.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A when-idle hander is scheduled to do the redisplay, if there
+ * isn't one already scheduled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ }
+ if (mePtr != NULL) {
+ mePtr->entryFlags |= ENTRY_NEEDS_REDISPLAY;
+ } else {
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ menuPtr->entries[i]->entryFlags |= ENTRY_NEEDS_REDISPLAY;
+ }
+ }
+ if (!Tk_IsMapped(menuPtr->tkwin)
+ || (menuPtr->menuFlags & REDRAW_PENDING)) {
+ return;
+ }
+ Tcl_DoWhenIdle(DisplayMenu, (ClientData) menuPtr);
+ menuPtr->menuFlags |= REDRAW_PENDING;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeMenuGeometry --
+ *
+ * This procedure is invoked to recompute the size and
+ * layout of a menu. It is called as a when-idle handler so
+ * that it only gets done once, even if a group of changes is
+ * made to the menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Fields of menu entries are changed to reflect their
+ * current positions, and the size of the menu window
+ * itself may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeMenuGeometry(clientData)
+ ClientData clientData; /* Structure describing menu. */
+{
+ TkMenu *menuPtr = (TkMenu *) clientData;
+
+ if (menuPtr->tkwin == NULL) {
+ return;
+ }
+
+ if (menuPtr->menuType == MENUBAR) {
+ TkpComputeMenubarGeometry(menuPtr);
+ } else {
+ TkpComputeStandardMenuGeometry(menuPtr);
+ }
+
+ if ((menuPtr->totalWidth != Tk_ReqWidth(menuPtr->tkwin)) ||
+ (menuPtr->totalHeight != Tk_ReqHeight(menuPtr->tkwin))) {
+ Tk_GeometryRequest(menuPtr->tkwin, menuPtr->totalWidth,
+ menuPtr->totalHeight);
+ }
+
+ /*
+ * Must always force a redisplay here if the window is mapped
+ * (even if the size didn't change, something else might have
+ * changed in the menu, such as a label or accelerator). The
+ * resize will force a redisplay above.
+ */
+
+ TkEventuallyRedrawMenu(menuPtr, (TkMenuEntry *) NULL);
+
+ menuPtr->menuFlags &= ~RESIZE_PENDING;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMenuSelectImageProc --
+ *
+ * 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 menu entry when it is selected.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the menu to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuSelectImageProc(clientData, x, y, width, height, imgWidth,
+ imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ register TkMenuEntry *mePtr = (TkMenuEntry *) clientData;
+
+ if ((mePtr->entryFlags & ENTRY_SELECTED)
+ && !(mePtr->menuPtr->menuFlags &
+ REDRAW_PENDING)) {
+ mePtr->menuPtr->menuFlags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayMenu, (ClientData) mePtr->menuPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayMenu --
+ *
+ * This procedure is invoked to display a menu widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+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 --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on menus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkMenuEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkMenu *menuPtr = (TkMenu *) clientData;
+
+ 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 --
+ *
+ * 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 menu entry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for the menu to get redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMenuImageProc(clientData, x, y, width, height, imgWidth,
+ imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ register TkMenu *menuPtr = ((TkMenuEntry *)clientData)->menuPtr;
+
+ if ((menuPtr->tkwin != NULL) && !(menuPtr->menuFlags
+ & RESIZE_PENDING)) {
+ menuPtr->menuFlags |= RESIZE_PENDING;
+ Tcl_DoWhenIdle(ComputeMenuGeometry, (ClientData) menuPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPostTearoffMenu --
+ *
+ * Posts a menu on the screen. Used to post tearoff menus. On Unix,
+ * all menus are posted this way. Adjusts the menu's position
+ * so that it fits on the screen, and maps and raises the menu.
+ *
+ * Results:
+ * Returns a standard Tcl Error.
+ *
+ * Side effects:
+ * The menu is posted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkPostTearoffMenu(interp, menuPtr, x, y)
+ Tcl_Interp *interp; /* The interpreter of the menu */
+ TkMenu *menuPtr; /* The menu we are posting */
+ int x; /* The root X coordinate where we
+ * are posting */
+ int y; /* The root Y coordinate where we
+ * are posting */
+{
+ int vRootX, vRootY, vRootWidth, vRootHeight;
+ int tmp, result;
+
+ TkActivateMenuEntry(menuPtr, -1);
+ TkRecomputeMenu(menuPtr);
+ result = TkPostCommand(menuPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+
+ /*
+ * The post commands could have deleted the menu, which means
+ * we are dead and should go away.
+ */
+
+ if (menuPtr->tkwin == NULL) {
+ return TCL_OK;
+ }
+
+ /*
+ * Adjust the position of the menu if necessary to keep it
+ * visible on the screen. There are two special tricks to
+ * make this work right:
+ *
+ * 1. If a virtual root window manager is being used then
+ * the coordinates are in the virtual root window of
+ * menuPtr's parent; since the menu uses override-redirect
+ * mode it will be in the *real* root window for the screen,
+ * so we have to map the coordinates from the virtual root
+ * (if any) to the real root. Can't get the virtual root
+ * from the menu itself (it will never be seen by the wm)
+ * so use its parent instead (it would be better to have an
+ * an option that names a window to use for this...).
+ * 2. The menu may not have been mapped yet, so its current size
+ * might be the default 1x1. To compute how much space it
+ * needs, use its requested size, not its actual size.
+ *
+ * Note that this code assumes square screen regions and all
+ * positive coordinates. This does not work on a Mac with
+ * multiple monitors. But then again, Tk has other problems
+ * with this.
+ */
+
+ Tk_GetVRootGeometry(Tk_Parent(menuPtr->tkwin), &vRootX, &vRootY,
+ &vRootWidth, &vRootHeight);
+ x += vRootX;
+ y += vRootY;
+ tmp = WidthOfScreen(Tk_Screen(menuPtr->tkwin))
+ - Tk_ReqWidth(menuPtr->tkwin);
+ if (x > tmp) {
+ x = tmp;
+ }
+ if (x < 0) {
+ x = 0;
+ }
+ tmp = HeightOfScreen(Tk_Screen(menuPtr->tkwin))
+ - Tk_ReqHeight(menuPtr->tkwin);
+ if (y > tmp) {
+ y = tmp;
+ }
+ if (y < 0) {
+ y = 0;
+ }
+ Tk_MoveToplevelWindow(menuPtr->tkwin, x, y);
+ if (!Tk_IsMapped(menuPtr->tkwin)) {
+ Tk_MapWindow(menuPtr->tkwin);
+ }
+ TkWmRestackToplevel((TkWindow *) menuPtr->tkwin, Above, NULL);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkPostSubmenu --
+ *
+ * This procedure arranges for a particular submenu (i.e. the
+ * menu corresponding to a given cascade entry) to be
+ * posted.
+ *
+ * Results:
+ * A standard Tcl return result. Errors may occur in the
+ * Tcl commands generated to post and unpost submenus.
+ *
+ * Side effects:
+ * If there is already a submenu posted, it is unposted.
+ * The new submenu is then posted.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkPostSubmenu(interp, menuPtr, mePtr)
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AdjustMenuCoords --
+ *
+ * Adjusts the given coordinates down and the left to give a Motif
+ * look.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The menu is eventually redrawn if necessary.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AdjustMenuCoords(menuPtr, mePtr, xPtr, yPtr, string)
+ TkMenu *menuPtr;
+ TkMenuEntry *mePtr;
+ int *xPtr;
+ 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);
+}
diff --git a/tk/generic/tkMenubutton.c b/tk/generic/tkMenubutton.c
new file mode 100644
index 00000000000..f7f9c6cb7c1
--- /dev/null
+++ b/tk/generic/tkMenubutton.c
@@ -0,0 +1,872 @@
+/*
+ * 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$
+ */
+
+#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;
+ mbPtr->inset = 0;
+ mbPtr->tkfont = NULL;
+ mbPtr->normalFg = NULL;
+ mbPtr->activeFg = NULL;
+ mbPtr->disabledFg = NULL;
+ mbPtr->normalTextGC = None;
+ mbPtr->activeTextGC = None;
+ mbPtr->gray = None;
+ mbPtr->disabledGC = None;
+ mbPtr->leftBearing = 0;
+ mbPtr->rightBearing = 0;
+ mbPtr->widthString = NULL;
+ mbPtr->heightString = NULL;
+ mbPtr->width = 0;
+ mbPtr->width = 0;
+ mbPtr->wrapLength = 0;
+ mbPtr->padX = 0;
+ 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 --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * TkMenuButton will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+void
+TkMenuButtonWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC gc;
+ unsigned long mask;
+ TkMenuButton *mbPtr;
+ XColor *foreground, *background;
+
+ mbPtr = (TkMenuButton *) instanceData;
+
+ gcValues.font = Tk_FontId(mbPtr->tkfont);
+ gcValues.foreground = mbPtr->normalFg->pixel;
+ gcValues.background = Tk_3DBorderColor(mbPtr->normalBorder)->pixel;
+
+ /*
+ * Note: GraphicsExpose events are disabled in GC's because they're
+ * used to copy stuff from an off-screen pixmap onto the screen (we know
+ * that there's no problem with obscured areas).
+ */
+
+ gcValues.graphics_exposures = False;
+ mask = GCForeground | GCBackground | GCFont | GCGraphicsExposures;
+ gc = Tk_GetGCColor(mbPtr->tkwin, mask, &gcValues, mbPtr->normalFg,
+ Tk_3DBorderColor(mbPtr->normalBorder));
+ if (mbPtr->normalTextGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->normalTextGC);
+ }
+ mbPtr->normalTextGC = gc;
+
+ gcValues.font = Tk_FontId(mbPtr->tkfont);
+ gcValues.foreground = mbPtr->activeFg->pixel;
+ gcValues.background = Tk_3DBorderColor(mbPtr->activeBorder)->pixel;
+ mask = GCForeground | GCBackground | GCFont;
+ gc = Tk_GetGCColor(mbPtr->tkwin, mask, &gcValues, mbPtr->activeFg,
+ Tk_3DBorderColor(mbPtr->activeBorder));
+ if (mbPtr->activeTextGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->activeTextGC);
+ }
+ mbPtr->activeTextGC = gc;
+
+ gcValues.font = Tk_FontId(mbPtr->tkfont);
+ background = Tk_3DBorderColor(mbPtr->normalBorder);
+ gcValues.background = background->pixel;
+ if ((mbPtr->disabledFg != NULL) && (mbPtr->imageString == NULL)) {
+ foreground = mbPtr->disabledFg;
+ gcValues.foreground = foreground->pixel;
+ mask = GCForeground | GCBackground | GCFont;
+ } else {
+ foreground = background;
+ background = NULL;
+ gcValues.foreground = gcValues.background;
+ mask = GCForeground;
+ if (mbPtr->gray == None) {
+ mbPtr->gray = Tk_GetBitmap(NULL, mbPtr->tkwin,
+ Tk_GetUid("gray50"));
+ }
+ if (mbPtr->gray != None) {
+ gcValues.fill_style = FillStippled;
+ gcValues.stipple = mbPtr->gray;
+ mask |= GCFillStyle | GCStipple;
+ }
+ }
+ gc = Tk_GetGCColor(mbPtr->tkwin, mask, &gcValues, foreground, background);
+ if (mbPtr->disabledGC != None) {
+ Tk_FreeGC(mbPtr->display, mbPtr->disabledGC);
+ }
+ mbPtr->disabledGC = gc;
+
+ TkpComputeMenuButtonGeometry(mbPtr);
+
+ /*
+ * Lastly, arrange for the button to be redisplayed.
+ */
+
+ if (Tk_IsMapped(mbPtr->tkwin) && !(mbPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayMenuButton, (ClientData) mbPtr);
+ mbPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MenuButtonEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on buttons.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+MenuButtonEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkMenuButton *mbPtr = (TkMenuButton *) clientData;
+ if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
+ goto redraw;
+ } else if (eventPtr->type == ConfigureNotify) {
+ /*
+ * 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;
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ mbPtr->flags &= ~GOT_FOCUS;
+ if (mbPtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ }
+ return;
+
+ redraw:
+ if ((mbPtr->tkwin != NULL) && !(mbPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayMenuButton, (ClientData) mbPtr);
+ mbPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuButtonCmdDeletedProc --
+ *
+ * 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
+MenuButtonCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ TkMenuButton *mbPtr = (TkMenuButton *) clientData;
+ Tk_Window tkwin = mbPtr->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) {
+ mbPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MenuButtonTextVarProc --
+ *
+ * This procedure is invoked when someone changes the variable
+ * whose contents are to be displayed in a menu button.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The text displayed in the menu button will change to match the
+ * variable.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+MenuButtonTextVarProc(clientData, interp, name1, name2, flags)
+ 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 TkMenuButton *mbPtr = (TkMenuButton *) 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, mbPtr->textVarName, mbPtr->text,
+ TCL_GLOBAL_ONLY);
+ Tcl_TraceVar(interp, mbPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MenuButtonTextVarProc, clientData);
+ }
+ return (char *) NULL;
+ }
+
+ value = Tcl_GetVar(interp, mbPtr->textVarName, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ value = "";
+ }
+ if (mbPtr->text != NULL) {
+ ckfree(mbPtr->text);
+ }
+ mbPtr->text = (char *) ckalloc((unsigned) (strlen(value) + 1));
+ strcpy(mbPtr->text, value);
+ TkpComputeMenuButtonGeometry(mbPtr);
+
+ if ((mbPtr->tkwin != NULL) && Tk_IsMapped(mbPtr->tkwin)
+ && !(mbPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayMenuButton, (ClientData) mbPtr);
+ mbPtr->flags |= REDRAW_PENDING;
+ }
+ return (char *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuButtonImageProc --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MenuButtonImageProc(clientData, x, y, width, height, imgWidth, imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+{
+ register TkMenuButton *mbPtr = (TkMenuButton *) clientData;
+
+ if (mbPtr->tkwin != NULL) {
+ TkpComputeMenuButtonGeometry(mbPtr);
+ if (Tk_IsMapped(mbPtr->tkwin) && !(mbPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(TkpDisplayMenuButton, (ClientData) mbPtr);
+ mbPtr->flags |= REDRAW_PENDING;
+ }
+ }
+}
diff --git a/tk/generic/tkMenubutton.h b/tk/generic/tkMenubutton.h
new file mode 100644
index 00000000000..b2382c6bde6
--- /dev/null
+++ b/tk/generic/tkMenubutton.h
@@ -0,0 +1,215 @@
+/*
+ * 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$
+ */
+
+#ifndef _TKMENUBUTTON
+#define _TKMENUBUTTON
+
+#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
+ * 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:
+ */
+
+ char *text; /* Text to display in button (malloc'ed)
+ * or NULL. */
+ int underline; /* Index of character to underline. */
+ 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 and underline
+ * 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. */
+
+ /*
+ * 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. */
+ 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. */
+ 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. */
+ GC activeTextGC; /* GC for drawing text in active mode (NULL
+ * means use normalTextGC). */
+ Pixmap gray; /* Pixmap for displaying disabled text/icon 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. */
+ int leftBearing; /* Distance from text origin to leftmost drawn
+ * pixel (positive means to right). */
+ int rightBearing; /* Amount text sticks right from its origin. */
+ 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 or bitmap (pixels
+ * on each side). */
+ Tk_Anchor anchor; /* Where text/bitmap should be displayed
+ * inside window region. */
+ Tk_Justify justify; /* Justification to use for multi-line text. */
+ 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 indicatorOn; /* Non-zero means display indicator; 0 means
+ * don't display. */
+ int indicatorHeight; /* Height of indicator in pixels. This same
+ * amount of extra space is also left on each
+ * side of the indicator. 0 if no indicator. */
+ int indicatorWidth; /* Width of indicator in pixels, including
+ * 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.
+ * "left" and "right" will pop the menu
+ * left or right, and the active item
+ * will be next to the button. */
+ 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. */
+} TkMenuButton;
+
+/*
+ * Flag bits for buttons:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler
+ * has already been queued to redraw
+ * this window.
+ * POSTED: Non-zero means that the menu associated
+ * with this button has been posted (typically
+ * because of an active button press).
+ * GOT_FOCUS: Non-zero means this button currently
+ * has the input focus.
+ */
+
+#define REDRAW_PENDING 1
+#define POSTED 2
+#define GOT_FOCUS 4
+
+/*
+ * The following constants define the dimensions of the cascade indicator,
+ * which is displayed if the "-indicatoron" option is true. The units for
+ * these options are 1/10 millimeters.
+ */
+
+#define INDICATOR_WIDTH 40
+#define INDICATOR_HEIGHT 17
+
+/*
+ * Declaration of variables shared between the files in the button module.
+ */
+
+extern TkClassProcs tkpMenubuttonClass;
+
+/*
+ * Declaration of procedures used in the implementation of the button
+ * widget.
+ */
+
+EXTERN void TkpComputeMenuButtonGeometry _ANSI_ARGS_((
+ TkMenuButton *mbPtr));
+EXTERN TkMenuButton * TkpCreateMenuButton _ANSI_ARGS_((Tk_Window tkwin));
+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 */
diff --git a/tk/generic/tkMessage.c b/tk/generic/tkMessage.c
new file mode 100644
index 00000000000..e1313bb6bff
--- /dev/null
+++ b/tk/generic/tkMessage.c
@@ -0,0 +1,849 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "default.h"
+#include "tkInt.h"
+
+/*
+ * A data structure of the following type is kept for each message
+ * widget managed by this file:
+ */
+
+typedef struct {
+ Tk_Window tkwin; /* Window that embodies the message. 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 message. */
+ Tcl_Command widgetCmd; /* Token for message's widget command. */
+
+ /*
+ * 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. */
+ 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. */
+ XColor *highlightBgColorPtr;
+ /* Color for drawing traversal highlight
+ * area when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ Tk_Font tkfont; /* Information about text font, or NULL. */
+ XColor *fgColorPtr; /* Foreground color in normal mode. */
+ int padX, padY; /* User-requested extra space around text. */
+ int width; /* User-requested width, in pixels. 0 means
+ * compute width using aspect ratio below. */
+ int aspect; /* Desired aspect ratio for window
+ * (100*width/height). */
+ int msgWidth; /* Width in pixels needed to display
+ * message. */
+ int msgHeight; /* Height in pixels needed to display
+ * message. */
+ Tk_Anchor anchor; /* Where to position text within window region
+ * if window is larger or smaller than
+ * needed. */
+ Tk_Justify justify; /* Justification for text. */
+
+ GC textGC; /* GC for drawing text in normal mode. */
+ Tk_TextLayout textLayout; /* Saved layout information. */
+
+ /*
+ * 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. */
+} Message;
+
+/*
+ * Flag bits for messages:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler
+ * has already been queued to redraw
+ * this window.
+ * GOT_FOCUS: Non-zero means this button currently
+ * has the input focus.
+ */
+
+#define REDRAW_PENDING 1
+#define GOT_FOCUS 4
+
+/*
+ * Information used for argv parsing.
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_ANCHOR, "-anchor", "anchor", "Anchor",
+ DEF_MESSAGE_ANCHOR, Tk_Offset(Message, anchor), 0},
+ {TK_CONFIG_INT, "-aspect", "aspect", "Aspect",
+ DEF_MESSAGE_ASPECT, Tk_Offset(Message, aspect), 0},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_MESSAGE_BG_COLOR, Tk_Offset(Message, border),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_MESSAGE_BG_MONO, Tk_Offset(Message, 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_MESSAGE_BORDER_WIDTH, Tk_Offset(Message, borderWidth), 0},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_MESSAGE_CURSOR, Tk_Offset(Message, cursor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_MESSAGE_FONT, Tk_Offset(Message, tkfont), 0},
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_MESSAGE_FG, Tk_Offset(Message, fgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_MESSAGE_HIGHLIGHT_BG,
+ Tk_Offset(Message, highlightBgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_MESSAGE_HIGHLIGHT, Tk_Offset(Message, highlightColorPtr), 0},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_MESSAGE_HIGHLIGHT_WIDTH, Tk_Offset(Message, highlightWidth), 0},
+ {TK_CONFIG_JUSTIFY, "-justify", "justify", "Justify",
+ DEF_MESSAGE_JUSTIFY, Tk_Offset(Message, justify), 0},
+ {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
+ DEF_MESSAGE_PADX, Tk_Offset(Message, padX), 0},
+ {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
+ DEF_MESSAGE_PADY, Tk_Offset(Message, padY), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_MESSAGE_RELIEF, Tk_Offset(Message, relief), 0},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_MESSAGE_TAKE_FOCUS, Tk_Offset(Message, takeFocus),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-text", "text", "Text",
+ DEF_MESSAGE_TEXT, Tk_Offset(Message, string), 0},
+ {TK_CONFIG_STRING, "-textvariable", "textVariable", "Variable",
+ DEF_MESSAGE_TEXT_VARIABLE, Tk_Offset(Message, textVarName),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-width", "width", "Width",
+ DEF_MESSAGE_WIDTH, Tk_Offset(Message, 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 MessageCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void MessageEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static char * MessageTextVarProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, char *name1, char *name2,
+ int flags));
+static int MessageWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void MessageWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static void ComputeMessageGeometry _ANSI_ARGS_((Message *msgPtr));
+static int ConfigureMessage _ANSI_ARGS_((Tcl_Interp *interp,
+ Message *msgPtr, int argc, char **argv,
+ int flags));
+static void DestroyMessage _ANSI_ARGS_((char *memPtr));
+static void DisplayMessage _ANSI_ARGS_((ClientData clientData));
+
+/*
+ * The structure below defines message class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static TkClassProcs messageClass = {
+ NULL, /* createProc. */
+ MessageWorldChanged, /* geometryProc. */
+ NULL /* modalProc. */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MessageCmd --
+ *
+ * This procedure is invoked to process the "message" 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_MessageCmd(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 Message *msgPtr;
+ Tk_Window new;
+ Tk_Window tkwin = (Tk_Window) clientData;
+
+ 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;
+ }
+
+ msgPtr = (Message *) ckalloc(sizeof(Message));
+ msgPtr->tkwin = new;
+ msgPtr->display = Tk_Display(new);
+ msgPtr->interp = interp;
+ msgPtr->widgetCmd = Tcl_CreateCommand(interp, Tk_PathName(msgPtr->tkwin),
+ MessageWidgetCmd, (ClientData) msgPtr, MessageCmdDeletedProc);
+ msgPtr->textLayout = NULL;
+ msgPtr->string = NULL;
+ msgPtr->numChars = 0;
+ msgPtr->textVarName = NULL;
+ msgPtr->border = NULL;
+ msgPtr->borderWidth = 0;
+ msgPtr->relief = TK_RELIEF_FLAT;
+ msgPtr->highlightWidth = 0;
+ msgPtr->highlightBgColorPtr = NULL;
+ msgPtr->highlightColorPtr = NULL;
+ msgPtr->tkfont = NULL;
+ msgPtr->fgColorPtr = NULL;
+ msgPtr->textGC = None;
+ msgPtr->padX = 0;
+ msgPtr->padY = 0;
+ msgPtr->anchor = TK_ANCHOR_CENTER;
+ msgPtr->width = 0;
+ msgPtr->aspect = 150;
+ msgPtr->msgWidth = 0;
+ msgPtr->msgHeight = 0;
+ msgPtr->justify = TK_JUSTIFY_LEFT;
+ msgPtr->cursor = None;
+ msgPtr->takeFocus = NULL;
+ msgPtr->flags = 0;
+
+ Tk_SetClass(msgPtr->tkwin, "Message");
+ TkSetClassProcs(msgPtr->tkwin, &messageClass, (ClientData) msgPtr);
+ 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MessageWidgetCmd --
+ *
+ * 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
+MessageWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about message widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register Message *msgPtr = (Message *) clientData;
+ 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;
+ }
+ 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);
+ return TCL_ERROR;
+ }
+ return Tk_ConfigureValue(interp, msgPtr->tkwin, configSpecs,
+ (char *) msgPtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc == 2) {
+ return Tk_ConfigureInfo(interp, msgPtr->tkwin, configSpecs,
+ (char *) msgPtr, (char *) NULL, 0);
+ } else if (argc == 3) {
+ return Tk_ConfigureInfo(interp, msgPtr->tkwin, configSpecs,
+ (char *) msgPtr, argv[2], 0);
+ } else {
+ return ConfigureMessage(interp, msgPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be cget or configure", (char *) NULL);
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyMessage --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a message at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the message is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyMessage(memPtr)
+ char *memPtr; /* Info about message widget. */
+{
+ register Message *msgPtr = (Message *) memPtr;
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ Tk_FreeTextLayout(msgPtr->textLayout);
+ if (msgPtr->textVarName != NULL) {
+ Tcl_UntraceVar(msgPtr->interp, msgPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MessageTextVarProc, (ClientData) msgPtr);
+ }
+ if (msgPtr->textGC != None) {
+ Tk_FreeGC(msgPtr->display, msgPtr->textGC);
+ }
+ Tk_FreeOptions(configSpecs, (char *) msgPtr, msgPtr->display, 0);
+ ckfree((char *) msgPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureMessage --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureMessage(interp, msgPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register Message *msgPtr; /* 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. */
+{
+ /*
+ * Eliminate any existing trace on a variable monitored by the message.
+ */
+
+ if (msgPtr->textVarName != NULL) {
+ Tcl_UntraceVar(interp, msgPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MessageTextVarProc, (ClientData) msgPtr);
+ }
+
+ if (Tk_ConfigureWidget(interp, msgPtr->tkwin, configSpecs,
+ argc, argv, (char *) msgPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the message is to display the value of a variable, then set up
+ * a trace on the variable's value, create the variable if it doesn't
+ * exist, and fetch its current value.
+ */
+
+ if (msgPtr->textVarName != NULL) {
+ char *value;
+
+ value = Tcl_GetVar(interp, msgPtr->textVarName, TCL_GLOBAL_ONLY);
+ if (value == NULL) {
+ Tcl_SetVar(interp, msgPtr->textVarName, msgPtr->string,
+ TCL_GLOBAL_ONLY);
+ } else {
+ if (msgPtr->string != NULL) {
+ ckfree(msgPtr->string);
+ }
+ msgPtr->string = strcpy(ckalloc(strlen(value) + 1), value);
+ }
+ Tcl_TraceVar(interp, msgPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MessageTextVarProc, (ClientData) msgPtr);
+ }
+
+ /*
+ * 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;
+ }
+
+ MessageWorldChanged((ClientData) msgPtr);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * MessageWorldChanged --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Message will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+MessageWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC gc;
+ Tk_FontMetrics fm;
+ Message *msgPtr;
+
+ msgPtr = (Message *) instanceData;
+
+ gcValues.font = Tk_FontId(msgPtr->tkfont);
+ gcValues.foreground = msgPtr->fgColorPtr->pixel;
+ gc = Tk_GetGCColor(msgPtr->tkwin, GCForeground | GCFont, &gcValues,
+ msgPtr->fgColorPtr, NULL);
+ if (msgPtr->textGC != None) {
+ Tk_FreeGC(msgPtr->display, msgPtr->textGC);
+ }
+ msgPtr->textGC = gc;
+
+ Tk_GetFontMetrics(msgPtr->tkfont, &fm);
+ if (msgPtr->padX < 0) {
+ msgPtr->padX = fm.ascent / 2;
+ }
+ if (msgPtr->padY == -1) {
+ msgPtr->padY = fm.ascent / 4;
+ }
+
+ /*
+ * Recompute the desired geometry for the window, and arrange for
+ * the window to be redisplayed.
+ */
+
+ ComputeMessageGeometry(msgPtr);
+ if ((msgPtr->tkwin != NULL) && Tk_IsMapped(msgPtr->tkwin)
+ && !(msgPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayMessage, (ClientData) msgPtr);
+ msgPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeMessageGeometry --
+ *
+ * Compute the desired geometry for a message window,
+ * taking into account the desired aspect ratio for the
+ * window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Tk_GeometryRequest is called to inform the geometry
+ * manager of the desired geometry for this window.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ComputeMessageGeometry(msgPtr)
+ register Message *msgPtr; /* Information about window. */
+{
+ int width, inc, height;
+ int thisWidth, thisHeight, maxWidth;
+ int aspect, lowerBound, upperBound, inset;
+
+ Tk_FreeTextLayout(msgPtr->textLayout);
+
+ inset = msgPtr->borderWidth + msgPtr->highlightWidth;
+
+ /*
+ * Compute acceptable bounds for the final aspect ratio.
+ */
+
+ aspect = msgPtr->aspect/10;
+ if (aspect < 5) {
+ aspect = 5;
+ }
+ lowerBound = msgPtr->aspect - aspect;
+ upperBound = msgPtr->aspect + aspect;
+
+ /*
+ * Do the computation in multiple passes: start off with
+ * a very wide window, and compute its height. Then change
+ * the width and try again. Reduce the size of the change
+ * and iterate until dimensions are found that approximate
+ * the desired aspect ratio. Or, if the user gave an explicit
+ * width then just use that.
+ */
+
+ if (msgPtr->width > 0) {
+ width = msgPtr->width;
+ inc = 0;
+ } else {
+ width = WidthOfScreen(Tk_Screen(msgPtr->tkwin))/2;
+ inc = width/2;
+ }
+
+ for ( ; ; inc /= 2) {
+ msgPtr->textLayout = Tk_ComputeTextLayout(msgPtr->tkfont,
+ msgPtr->string, msgPtr->numChars, width, msgPtr->justify,
+ 0, &thisWidth, &thisHeight);
+ maxWidth = thisWidth + 2 * (inset + msgPtr->padX);
+ height = thisHeight + 2 * (inset + msgPtr->padY);
+
+ if (inc <= 2) {
+ break;
+ }
+ aspect = (100 * maxWidth) / height;
+
+ if (aspect < lowerBound) {
+ width += inc;
+ } else if (aspect > upperBound) {
+ width -= inc;
+ } else {
+ break;
+ }
+ Tk_FreeTextLayout(msgPtr->textLayout);
+ }
+ msgPtr->msgWidth = thisWidth;
+ msgPtr->msgHeight = thisHeight;
+ Tk_GeometryRequest(msgPtr->tkwin, maxWidth, height);
+ Tk_SetInternalBorder(msgPtr->tkwin, inset);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayMessage --
+ *
+ * This procedure redraws the contents of a message window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayMessage(clientData)
+ ClientData clientData; /* Information about window. */
+{
+ register Message *msgPtr = (Message *) clientData;
+ register Tk_Window tkwin = msgPtr->tkwin;
+ int x, y;
+
+ msgPtr->flags &= ~REDRAW_PENDING;
+ if ((msgPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), msgPtr->border, 0, 0,
+ Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
+
+ /*
+ * Compute starting y-location for message based on message size
+ * and anchor option.
+ */
+
+ TkComputeAnchor(msgPtr->anchor, tkwin, msgPtr->padX, msgPtr->padY,
+ msgPtr->msgWidth, msgPtr->msgHeight, &x, &y);
+ Tk_DrawTextLayout(Tk_Display(tkwin), Tk_WindowId(tkwin), msgPtr->textGC,
+ msgPtr->textLayout, x, y, 0, -1);
+
+ if (msgPtr->relief != TK_RELIEF_FLAT) {
+ Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin), msgPtr->border,
+ msgPtr->highlightWidth, msgPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*msgPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*msgPtr->highlightWidth,
+ msgPtr->borderWidth, msgPtr->relief);
+ }
+ if (msgPtr->highlightWidth != 0) {
+ GC gc;
+
+ if (msgPtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(msgPtr->highlightColorPtr, Tk_WindowId(tkwin));
+ } else {
+ gc = Tk_GCForColor(msgPtr->highlightBgColorPtr, Tk_WindowId(tkwin));
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, msgPtr->highlightWidth,
+ Tk_WindowId(tkwin));
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MessageEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on messages.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+MessageEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ Message *msgPtr = (Message *) clientData;
+
+ if (((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0))
+ || (eventPtr->type == ConfigureNotify)) {
+ goto redraw;
+ } else if (eventPtr->type == DestroyNotify) {
+ if (msgPtr->tkwin != NULL) {
+ msgPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(msgPtr->interp, msgPtr->widgetCmd);
+ }
+ if (msgPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayMessage, (ClientData) msgPtr);
+ }
+ Tcl_EventuallyFree((ClientData) msgPtr, DestroyMessage);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ msgPtr->flags |= GOT_FOCUS;
+ if (msgPtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ msgPtr->flags &= ~GOT_FOCUS;
+ if (msgPtr->highlightWidth > 0) {
+ goto redraw;
+ }
+ }
+ }
+ return;
+
+ redraw:
+ if ((msgPtr->tkwin != NULL) && !(msgPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayMessage, (ClientData) msgPtr);
+ msgPtr->flags |= REDRAW_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MessageCmdDeletedProc --
+ *
+ * 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
+MessageCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ Message *msgPtr = (Message *) clientData;
+ Tk_Window tkwin = msgPtr->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) {
+ msgPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MessageTextVarProc --
+ *
+ * This procedure is invoked when someone changes the variable
+ * whose contents are to be displayed in a message.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The text displayed in the message will change to match the
+ * variable.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+MessageTextVarProc(clientData, interp, name1, name2, flags)
+ ClientData clientData; /* Information about message. */
+ 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 Message *msgPtr = (Message *) 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, msgPtr->textVarName, msgPtr->string,
+ TCL_GLOBAL_ONLY);
+ Tcl_TraceVar(interp, msgPtr->textVarName,
+ TCL_GLOBAL_ONLY|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
+ MessageTextVarProc, clientData);
+ }
+ return (char *) NULL;
+ }
+
+ 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;
+}
diff --git a/tk/generic/tkOption.c b/tk/generic/tkOption.c
new file mode 100644
index 00000000000..f3807167edb
--- /dev/null
+++ b/tk/generic/tkOption.c
@@ -0,0 +1,1397 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The option database is stored as one tree for each main window.
+ * Each name or class field in an option is associated with a node or
+ * leaf of the tree. For example, the options "x.y.z" and "x.y*a"
+ * each correspond to three nodes in the tree; they share the nodes
+ * "x" and "x.y", but have different leaf nodes. One of the following
+ * structures exists for each node or leaf in the option tree. It is
+ * actually stored as part of the parent node, and describes a particular
+ * child of the parent.
+ */
+
+typedef struct Element {
+ Tk_Uid nameUid; /* Name or class from one element of
+ * an option spec. */
+ union {
+ struct ElArray *arrayPtr; /* If this is an intermediate node,
+ * a pointer to a structure describing
+ * the remaining elements of all
+ * options whose prefixes are the
+ * same up through this element. */
+ Tk_Uid valueUid; /* For leaf nodes, this is the string
+ * value of the option. */
+ } child;
+ int priority; /* Used to select among matching
+ * options. Includes both the
+ * priority level and a serial #.
+ * Greater value means higher
+ * priority. Irrelevant except in
+ * leaf nodes. */
+ int flags; /* OR-ed combination of bits. See
+ * below for values. */
+} Element;
+
+/*
+ * Flags in Element structures:
+ *
+ * CLASS - Non-zero means this element refers to a class,
+ * Zero means this element refers to a name.
+ * NODE - Zero means this is a leaf element (the child
+ * field is a value, not a pointer to another node).
+ * One means this is a node element.
+ * WILDCARD - Non-zero means this there was a star in the
+ * original specification just before this element.
+ * Zero means there was a dot.
+ */
+
+#define TYPE_MASK 0x7
+
+#define CLASS 0x1
+#define NODE 0x2
+#define WILDCARD 0x4
+
+#define EXACT_LEAF_NAME 0x0
+#define EXACT_LEAF_CLASS 0x1
+#define EXACT_NODE_NAME 0x2
+#define EXACT_NODE_CLASS 0x3
+#define WILDCARD_LEAF_NAME 0x4
+#define WILDCARD_LEAF_CLASS 0x5
+#define WILDCARD_NODE_NAME 0x6
+#define WILDCARD_NODE_CLASS 0x7
+
+/*
+ * The following structure is used to manage a dynamic array of
+ * Elements. These structures are used for two purposes: to store
+ * the contents of a node in the option tree, and for the option
+ * stacks described below.
+ */
+
+typedef struct ElArray {
+ int arraySize; /* Number of elements actually
+ * allocated in the "els" array. */
+ int numUsed; /* Number of elements currently in
+ * use out of els. */
+ Element *nextToUse; /* Pointer to &els[numUsed]. */
+ Element els[1]; /* Array of structures describing
+ * children of this node. The
+ * array will actually contain enough
+ * elements for all of the children
+ * (and even a few extras, perhaps).
+ * This must be the last field in
+ * the structure. */
+} ElArray;
+
+#define EL_ARRAY_SIZE(numEls) ((unsigned) (sizeof(ElArray) \
+ + ((numEls)-1)*sizeof(Element)))
+#define INITIAL_SIZE 5
+
+/*
+ * In addition to the option tree, which is a relatively static structure,
+ * there are eight additional structures called "stacks", which are used
+ * to speed up queries into the option database. The stack structures
+ * are designed for the situation where an individual widget makes repeated
+ * requests for its particular options. The requests differ only in
+ * their last name/class, so during the first request we extract all
+ * the options pertaining to the particular widget and save them in a
+ * stack-like cache; subsequent requests for the same widget can search
+ * the cache relatively quickly. In fact, the cache is a hierarchical
+ * one, storing a list of relevant options for this widget and all of
+ * its ancestors up to the application root; hence the name "stack".
+ *
+ * Each of the eight stacks consists of an array of Elements, ordered in
+ * terms of levels in the window hierarchy. All the elements relevant
+ * for the top-level widget appear first in the array, followed by all
+ * those from the next-level widget on the path to the current widget,
+ * etc. down to those for the current widget.
+ *
+ * Cached information is divided into eight stacks according to the
+ * CLASS, NODE, and WILDCARD flags. Leaf and non-leaf information is
+ * kept separate to speed up individual probes (non-leaf information is
+ * only relevant when building the stacks, but isn't relevant when
+ * making probes; similarly, only non-leaf information is relevant
+ * when the stacks are being extended to the next widget down in the
+ * widget hierarchy). Wildcard elements are handled separately from
+ * "exact" elements because once they appear at a particular level in
+ * the stack they remain active for all deeper levels; exact elements
+ * are only relevant at a particular level. For example, when searching
+ * for options relevant in a particular window, the entire wildcard
+ * 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));
+static void ClearOptionTree _ANSI_ARGS_((ElArray *arrayPtr));
+static ElArray * ExtendArray _ANSI_ARGS_((ElArray *arrayPtr,
+ Element *elPtr));
+static void ExtendStacks _ANSI_ARGS_((ElArray *arrayPtr,
+ int leaf));
+static int GetDefaultOptions _ANSI_ARGS_((Tcl_Interp *interp,
+ TkWindow *winPtr));
+static ElArray * NewArray _ANSI_ARGS_((int numEls));
+static void OptionInit _ANSI_ARGS_((TkMainInfo *mainPtr));
+static int ParsePriority _ANSI_ARGS_((Tcl_Interp *interp,
+ char *string));
+static int ReadOptionFile _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, char *fileName, int priority));
+static void SetupStacks _ANSI_ARGS_((TkWindow *winPtr, int leaf));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_AddOption --
+ *
+ * Add a new option to the option database.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information is added to the option database.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_AddOption(tkwin, name, value, priority)
+ Tk_Window tkwin; /* Window token; option will be associated
+ * with main window for this window. */
+ char *name; /* Multi-element name of option. */
+ char *value; /* String value for option. */
+ int priority; /* Overall priority level to use for
+ * this option, such as TK_USER_DEFAULT_PRIO
+ * or TK_INTERACTIVE_PRIO. Must be between
+ * 0 and TK_MAX_PRIO. */
+{
+ TkWindow *winPtr = ((TkWindow *) tkwin)->mainPtr->winPtr;
+ register ElArray **arrayPtrPtr;
+ 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;
+ for (firstField = 1; ; firstField = 0) {
+
+ /*
+ * Scan the next field from the name and convert it to a Tk_Uid.
+ * Must copy the field before calling Tk_Uid, so that a terminating
+ * NULL may be added without modifying the source string.
+ */
+
+ if (*p == '*') {
+ newEl.flags = WILDCARD;
+ p++;
+ } else {
+ newEl.flags = 0;
+ }
+ field = p;
+ while ((*p != 0) && (*p != '.') && (*p != '*')) {
+ p++;
+ }
+ length = p - field;
+ if (length > TMP_SIZE) {
+ length = TMP_SIZE;
+ }
+ strncpy(tmp, field, (size_t) length);
+ tmp[length] = 0;
+ newEl.nameUid = Tk_GetUid(tmp);
+ if (isupper(UCHAR(*field))) {
+ newEl.flags |= CLASS;
+ }
+
+ if (*p != 0) {
+
+ /*
+ * New element will be a node. If this option can't possibly
+ * apply to this main window, then just skip it. Otherwise,
+ * add it to the parent, if it isn't already there, and descend
+ * into it.
+ */
+
+ newEl.flags |= NODE;
+ if (firstField && !(newEl.flags & WILDCARD)
+ && (newEl.nameUid != winPtr->nameUid)
+ && (newEl.nameUid != winPtr->classUid)) {
+ return;
+ }
+ for (elPtr = (*arrayPtrPtr)->els, count = (*arrayPtrPtr)->numUsed;
+ ; elPtr++, count--) {
+ if (count == 0) {
+ newEl.child.arrayPtr = NewArray(5);
+ *arrayPtrPtr = ExtendArray(*arrayPtrPtr, &newEl);
+ arrayPtrPtr = &((*arrayPtrPtr)->nextToUse[-1].child.arrayPtr);
+ break;
+ }
+ if ((elPtr->nameUid == newEl.nameUid)
+ && (elPtr->flags == newEl.flags)) {
+ arrayPtrPtr = &(elPtr->child.arrayPtr);
+ break;
+ }
+ }
+ if (*p == '.') {
+ p++;
+ }
+ } else {
+
+ /*
+ * New element is a leaf. Add it to the parent, if it isn't
+ * already there. If it exists already, keep whichever value
+ * has highest priority.
+ */
+
+ newEl.child.valueUid = Tk_GetUid(value);
+ for (elPtr = (*arrayPtrPtr)->els, count = (*arrayPtrPtr)->numUsed;
+ ; elPtr++, count--) {
+ if (count == 0) {
+ *arrayPtrPtr = ExtendArray(*arrayPtrPtr, &newEl);
+ return;
+ }
+ if ((elPtr->nameUid == newEl.nameUid)
+ && (elPtr->flags == newEl.flags)) {
+ if (elPtr->priority < newEl.priority) {
+ elPtr->priority = newEl.priority;
+ elPtr->child.valueUid = newEl.child.valueUid;
+ }
+ return;
+ }
+ }
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetOption --
+ *
+ * Retrieve an option from the option database.
+ *
+ * Results:
+ * The return value is the value specified in the option
+ * database for the given name and class on the given
+ * window. If there is nothing specified in the database
+ * for that option, then NULL is returned.
+ *
+ * Side effects:
+ * The internal caches used to speed up option mapping
+ * may be modified, if this tkwin is different from the
+ * last tkwin used for option retrieval.
+ *
+ *--------------------------------------------------------------
+ */
+
+Tk_Uid
+Tk_GetOption(tkwin, name, className)
+ Tk_Window tkwin; /* Token for window that option is
+ * associated with. */
+ char *name; /* Name of option. */
+ 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_OptionCmd --
+ *
+ * This procedure is invoked to process the "option" 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_OptionCmd(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;
+ 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];
+ length = strlen(argv[1]);
+ if ((c == 'a') && (strncmp(argv[1], "add", length) == 0)) {
+ int priority;
+
+ if ((argc != 4) && (argc != 5)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " add pattern value ?priority?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 4) {
+ priority = TK_INTERACTIVE_PRIO;
+ } else {
+ priority = ParsePriority(interp, argv[4]);
+ if (priority < 0) {
+ return TCL_ERROR;
+ }
+ }
+ Tk_AddOption(tkwin, argv[2], argv[3], priority);
+ return TCL_OK;
+ } else if ((c == 'c') && (strncmp(argv[1], "clear", length) == 0)) {
+ TkMainInfo *mainPtr;
+
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " clear\"", (char *) NULL);
+ 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 \"",
+ argv[0], " readfile fileName ?priority?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 4) {
+ priority = ParsePriority(interp, argv[3]);
+ if (priority < 0) {
+ return TCL_ERROR;
+ }
+ } else {
+ priority = TK_INTERACTIVE_PRIO;
+ }
+ return ReadOptionFile(interp, tkwin, argv[2], priority);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be add, clear, get, or readfile", (char *) NULL);
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkOptionDeadWindow --
+ *
+ * This procedure is called whenever a window is deleted.
+ * It cleans up any option-related stuff associated with
+ * the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Option-related resources are freed. See code below
+ * for details.
+ *
+ *--------------------------------------------------------------
+ */
+
+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.
+ */
+
+ if ((winPtr->mainPtr->winPtr == winPtr)
+ && (winPtr->mainPtr->optionRootPtr != NULL)) {
+ ClearOptionTree(winPtr->mainPtr->optionRootPtr);
+ winPtr->mainPtr->optionRootPtr = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkOptionClassChanged --
+ *
+ * This procedure is invoked when a window's class changes. If
+ * the window is on the option cache, this procedure flushes
+ * any information for the window, since the new class could change
+ * what is relevant.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The option cache may be flushed in part or in whole.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ParsePriority(interp, string)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ char *string; /* Describes a priority level, either
+ * symbolically or numerically. */
+{
+ int priority, c;
+ size_t length;
+
+ c = string[0];
+ length = strlen(string);
+ if ((c == 'w')
+ && (strncmp(string, "widgetDefault", length) == 0)) {
+ return TK_WIDGET_DEFAULT_PRIO;
+ } else if ((c == 's')
+ && (strncmp(string, "startupFile", length) == 0)) {
+ return TK_STARTUP_FILE_PRIO;
+ } else if ((c == 'u')
+ && (strncmp(string, "userDefault", length) == 0)) {
+ return TK_USER_DEFAULT_PRIO;
+ } else if ((c == 'i')
+ && (strncmp(string, "interactive", length) == 0)) {
+ return TK_INTERACTIVE_PRIO;
+ } else {
+ char *end;
+
+ priority = strtoul(string, &end, 0);
+ if ((end == string) || (*end != 0) || (priority < 0)
+ || (priority > 100)) {
+ Tcl_AppendResult(interp, "bad priority level \"", string,
+ "\": must be widgetDefault, startupFile, userDefault, ",
+ "interactive, or a number between 0 and 100",
+ (char *) NULL);
+ return -1;
+ }
+ }
+ return priority;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AddFromString --
+ *
+ * Given a string containing lines in the standard format for
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+AddFromString(interp, tkwin, string, priority)
+ Tcl_Interp *interp; /* Interpreter to use for reporting results. */
+ Tk_Window tkwin; /* Token for window: options are entered
+ * for this window's main window. */
+ char *string; /* String containing option specifiers. */
+ int priority; /* Priority level to use for options in
+ * this string, such as TK_USER_DEFAULT_PRIO
+ * or TK_INTERACTIVE_PRIO. Must be between
+ * 0 and TK_MAX_PRIO. */
+{
+ register char *src, *dst;
+ char *name, *value;
+ int lineNum;
+
+ src = string;
+ lineNum = 1;
+ while (1) {
+
+ /*
+ * Skip leading white space and empty lines and comment lines, and
+ * check for the end of the spec.
+ */
+
+ while ((*src == ' ') || (*src == '\t')) {
+ src++;
+ }
+ if ((*src == '#') || (*src == '!')) {
+ do {
+ src++;
+ if ((src[0] == '\\') && (src[1] == '\n')) {
+ src += 2;
+ lineNum++;
+ }
+ } while ((*src != '\n') && (*src != 0));
+ }
+ if (*src == '\n') {
+ src++;
+ lineNum++;
+ continue;
+ }
+ if (*src == '\0') {
+ break;
+ }
+
+ /*
+ * 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;
+ dst++;
+ src++;
+ }
+ }
+
+ /*
+ * Eliminate trailing white space on the name, and null-terminate
+ * it.
+ */
+
+ while ((dst != name) && ((dst[-1] == ' ') || (dst[-1] == '\t'))) {
+ dst--;
+ }
+ *dst = '\0';
+
+ /*
+ * Skip white space between the name and the value.
+ */
+
+ 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;
+ dst++;
+ src++;
+ }
+ }
+ *dst = 0;
+
+ /*
+ * Enter the option into the database.
+ */
+
+ Tk_AddOption(tkwin, name, value, priority);
+ src++;
+ lineNum++;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReadOptionFile --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ReadOptionFile(interp, tkwin, fileName, priority)
+ Tcl_Interp *interp; /* Interpreter to use for reporting results. */
+ Tk_Window tkwin; /* Token for window: options are entered
+ * for this window's main window. */
+ char *fileName; /* Name of file containing options. */
+ int priority; /* Priority level to use for options in
+ * this file, such as TK_USER_DEFAULT_PRIO
+ * or TK_INTERACTIVE_PRIO. Must be between
+ * 0 and TK_MAX_PRIO. */
+{
+ char *realName, *buffer;
+ int result, bufferSize;
+ Tcl_Channel chan;
+ Tcl_DString newName;
+
+ /*
+ * Prevent file system access in a safe interpreter.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't read options from a file in a",
+ " safe interpreter", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ realName = Tcl_TranslateFileName(interp, fileName, &newName);
+ if (realName == NULL) {
+ return TCL_ERROR;
+ }
+ chan = Tcl_OpenFileChannel(interp, realName, "r", 0);
+ Tcl_DStringFree(&newName);
+ if (chan == NULL) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "couldn't open \"", fileName,
+ "\": ", Tcl_PosixError(interp), (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Compute size of file by seeking to the end of the file. This will
+ * overallocate if we are performing CRLF translation.
+ */
+
+ bufferSize = Tcl_Seek(chan, 0L, SEEK_END);
+ (void) Tcl_Seek(chan, 0L, SEEK_SET);
+
+ if (bufferSize < 0) {
+ Tcl_AppendResult(interp, "error seeking to end of file \"",
+ fileName, "\":", Tcl_PosixError(interp), (char *) NULL);
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+
+ }
+ buffer = (char *) ckalloc((unsigned) bufferSize+1);
+ bufferSize = Tcl_Read(chan, buffer, bufferSize);
+ if (bufferSize < 0) {
+ Tcl_AppendResult(interp, "error reading file \"", fileName, "\":",
+ Tcl_PosixError(interp), (char *) NULL);
+ Tcl_Close(NULL, chan);
+ return TCL_ERROR;
+ }
+ Tcl_Close(NULL, chan);
+ buffer[bufferSize] = 0;
+ result = AddFromString(interp, tkwin, buffer, priority);
+ ckfree(buffer);
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * NewArray --
+ *
+ * Create a new ElArray structure of a given size.
+ *
+ * Results:
+ * The return value is a pointer to a properly initialized
+ * element array with "numEls" space. The array is marked
+ * as having no active elements.
+ *
+ * Side effects:
+ * Memory is allocated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static ElArray *
+NewArray(numEls)
+ int numEls; /* How many elements of space to allocate. */
+{
+ register ElArray *arrayPtr;
+
+ arrayPtr = (ElArray *) ckalloc(EL_ARRAY_SIZE(numEls));
+ arrayPtr->arraySize = numEls;
+ arrayPtr->numUsed = 0;
+ arrayPtr->nextToUse = arrayPtr->els;
+ return arrayPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ExtendArray --
+ *
+ * Add a new element to an array, extending the array if
+ * necessary.
+ *
+ * Results:
+ * The return value is a pointer to the new array, which
+ * will be different from arrayPtr if the array got expanded.
+ *
+ * Side effects:
+ * Memory may be allocated or freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static ElArray *
+ExtendArray(arrayPtr, elPtr)
+ register ElArray *arrayPtr; /* Array to be extended. */
+ register Element *elPtr; /* Element to be copied into array. */
+{
+ /*
+ * If the current array has filled up, make it bigger.
+ */
+
+ if (arrayPtr->numUsed >= arrayPtr->arraySize) {
+ register ElArray *newPtr;
+
+ newPtr = (ElArray *) ckalloc(EL_ARRAY_SIZE(2*arrayPtr->arraySize));
+ newPtr->arraySize = 2*arrayPtr->arraySize;
+ newPtr->numUsed = arrayPtr->numUsed;
+ newPtr->nextToUse = &newPtr->els[newPtr->numUsed];
+ memcpy((VOID *) newPtr->els, (VOID *) arrayPtr->els,
+ (arrayPtr->arraySize*sizeof(Element)));
+ ckfree((char *) arrayPtr);
+ arrayPtr = newPtr;
+ }
+
+ *arrayPtr->nextToUse = *elPtr;
+ arrayPtr->nextToUse++;
+ arrayPtr->numUsed++;
+ return arrayPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SetupStacks --
+ *
+ * Arrange the stacks so that they cache all the option
+ * information for a particular window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The stacks are modified to hold information for tkwin
+ * and all its ancestors in the window hierarchy.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+SetupStacks(winPtr, leaf)
+ TkWindow *winPtr; /* Window for which information is to
+ * be cached. */
+ 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
+ * of the old days when priorities were determined differently.
+ */
+
+ static int searchOrder[] = {WILDCARD_NODE_CLASS, WILDCARD_NODE_NAME,
+ EXACT_NODE_CLASS, EXACT_NODE_NAME, -1};
+
+ if (winPtr->mainPtr->optionRootPtr == NULL) {
+ OptionInit(winPtr->mainPtr);
+ }
+
+ /*
+ * 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 --
+ *
+ * Given an element array, copy all the elements from the
+ * array onto the system stacks (except for irrelevant leaf
+ * elements).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The option stacks are extended.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+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 --
+ *
+ * Initialize data structures for option handling.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Option-related data structures get initialized.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+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.
+ */
+
+ mainPtr->optionRootPtr = NewArray(20);
+ interp = Tcl_CreateInterp();
+ (void) GetDefaultOptions(interp, mainPtr->winPtr);
+ Tcl_DeleteInterp(interp);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ClearOptionTree --
+ *
+ * This procedure is called to erase everything in a
+ * hierarchical option database.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All the options associated with arrayPtr are deleted,
+ * along with all option subtrees. The space pointed to
+ * by arrayPtr is freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ClearOptionTree(arrayPtr)
+ ElArray *arrayPtr; /* Array of options; delete everything
+ * referred to recursively by this. */
+{
+ register Element *elPtr;
+ int count;
+
+ for (count = arrayPtr->numUsed, elPtr = arrayPtr->els; count > 0;
+ count--, elPtr++) {
+ if (elPtr->flags & NODE) {
+ ClearOptionTree(elPtr->child.arrayPtr);
+ }
+ }
+ ckfree((char *) arrayPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetDefaultOptions --
+ *
+ * This procedure is invoked to load the default set of options
+ * for a window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Options are added to those for winPtr's main window. If
+ * there exists a RESOURCE_MANAGER proprety for winPtr's
+ * display, that is used. Otherwise, the .Xdefaults file in
+ * the user's home directory is used.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+GetDefaultOptions(interp, winPtr)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ TkWindow *winPtr; /* Fetch option defaults for main window
+ * associated with this. */
+{
+ char *regProp;
+ int result, actualFormat;
+ unsigned long numItems, bytesAfter;
+ Atom actualType;
+
+ /*
+ * Try the RESOURCE_MANAGER property on the root window first.
+ */
+
+ regProp = NULL;
+ result = XGetWindowProperty(winPtr->display,
+ RootWindow(winPtr->display, 0),
+ XA_RESOURCE_MANAGER, 0, 100000,
+ False, XA_STRING, &actualType, &actualFormat,
+ &numItems, &bytesAfter, (unsigned char **) &regProp);
+
+ if ((result == Success) && (actualType == XA_STRING)
+ && (actualFormat == 8)) {
+ result = AddFromString(interp, (Tk_Window) winPtr, regProp,
+ TK_USER_DEFAULT_PRIO);
+ XFree(regProp);
+ return result;
+ }
+
+ /*
+ * No luck there. Try a .Xdefaults file in the user's home
+ * directory.
+ */
+
+ if (regProp != NULL) {
+ XFree(regProp);
+ }
+ result = ReadOptionFile(interp, (Tk_Window) winPtr, "~/.Xdefaults",
+ TK_USER_DEFAULT_PRIO);
+ return result;
+}
diff --git a/tk/generic/tkPack.c b/tk/generic/tkPack.c
new file mode 100644
index 00000000000..9e5d2421fdf
--- /dev/null
+++ b/tk/generic/tkPack.c
@@ -0,0 +1,1727 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+typedef enum {TOP, BOTTOM, LEFT, RIGHT} Side;
+
+/* For each window that the packer cares about (either because
+ * the window is managed by the packer or because the window
+ * has slaves that are managed by the packer), there is a
+ * structure of the following type:
+ */
+
+typedef struct Packer {
+ Tk_Window tkwin; /* Tk token for window. NULL means that
+ * the window has been deleted, but the
+ * packet hasn't had a chance to clean up
+ * yet because the structure is still in
+ * use. */
+ struct Packer *masterPtr; /* Master window within which this window
+ * is packed (NULL means this window
+ * isn't managed by the packer). */
+ struct Packer *nextPtr; /* Next window packed within same
+ * parent. List is priority-ordered:
+ * first on list gets packed first. */
+ struct Packer *slavePtr; /* First in list of slaves packed
+ * inside this window (NULL means
+ * no packed slaves). */
+ Side side; /* Side of parent against which
+ * this window is packed. */
+ Tk_Anchor anchor; /* If frame allocated for window is larger
+ * than window needs, this indicates how
+ * where to position window in frame. */
+ int padX, padY; /* Total additional pixels to leave around the
+ * window (half of this space is left on each
+ * side). This is space *outside* the window:
+ * we'll allocate extra space in frame but
+ * won't enlarge window). */
+ int iPadX, iPadY; /* Total extra pixels to allocate inside the
+ * window (half this amount will appear on
+ * each side). */
+ int doubleBw; /* Twice the window's last known border
+ * width. If this changes, the window
+ * must be repacked within its parent. */
+ int *abortPtr; /* If non-NULL, it means that there is a nested
+ * call to ArrangePacking already working on
+ * this window. *abortPtr may be set to 1 to
+ * abort that nested call. This happens, for
+ * example, if tkwin or any of its slaves
+ * is deleted. */
+ int flags; /* Miscellaneous flags; see below
+ * for definitions. */
+} Packer;
+
+/*
+ * Flag values for Packer structures:
+ *
+ * REQUESTED_REPACK: 1 means a Tcl_DoWhenIdle request
+ * has already been made to repack
+ * all the slaves of this window.
+ * FILLX: 1 means if frame allocated for window
+ * is wider than window needs, expand window
+ * to fill frame. 0 means don't make window
+ * any larger than needed.
+ * FILLY: Same as FILLX, except for height.
+ * EXPAND: 1 means this window's frame will absorb any
+ * extra space in the parent window.
+ * OLD_STYLE: 1 means this window is being managed with
+ * the old-style packer algorithms (before
+ * Tk version 3.3). The main difference is
+ * that padding and filling are done differently.
+ * DONT_PROPAGATE: 1 means don't set this window's requested
+ * size. 0 means if this window is a master
+ * then Tk will set its requested size to fit
+ * the needs of its slaves.
+ */
+
+#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));
+static void PackLostSlaveProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+
+static Tk_GeomMgr packerType = {
+ "pack", /* name */
+ PackReqProc, /* requestProc */
+ PackLostSlaveProc, /* lostSlaveProc */
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void ArrangePacking _ANSI_ARGS_((ClientData clientData));
+static int ConfigureSlaves _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window tkwin, int argc, char *argv[]));
+static void DestroyPacker _ANSI_ARGS_((char *memPtr));
+static Packer * GetPacker _ANSI_ARGS_((Tk_Window tkwin));
+static int PackAfter _ANSI_ARGS_((Tcl_Interp *interp,
+ Packer *prevPtr, Packer *masterPtr, int argc,
+ char **argv));
+static void PackReqProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void PackStructureProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void Unlink _ANSI_ARGS_((Packer *packPtr));
+static int XExpansion _ANSI_ARGS_((Packer *slavePtr,
+ int cavityWidth));
+static int YExpansion _ANSI_ARGS_((Packer *slavePtr,
+ int cavityHeight));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PackCmd --
+ *
+ * This procedure is invoked to process the "pack" 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_PackCmd(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;
+ int c;
+
+ if ((argc >= 2) && (argv[1][0] == '.')) {
+ return ConfigureSlaves(interp, tkwin, argc-1, argv+1);
+ }
+ if (argc < 3) {
+ 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 == 'a') && (length >= 2)
+ && (strncmp(argv[1], "after", length) == 0)) {
+ Packer *prevPtr;
+ Tk_Window tkwin2;
+
+ tkwin2 = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ prevPtr = GetPacker(tkwin2);
+ if (prevPtr->masterPtr == NULL) {
+ Tcl_AppendResult(interp, "window \"", argv[2],
+ "\" isn't packed", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return PackAfter(interp, prevPtr, prevPtr->masterPtr, argc-3, argv+3);
+ } else if ((c == 'a') && (length >= 2)
+ && (strncmp(argv[1], "append", length) == 0)) {
+ Packer *masterPtr;
+ register Packer *prevPtr;
+ Tk_Window tkwin2;
+
+ tkwin2 = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetPacker(tkwin2);
+ prevPtr = masterPtr->slavePtr;
+ if (prevPtr != NULL) {
+ while (prevPtr->nextPtr != NULL) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ }
+ return PackAfter(interp, prevPtr, masterPtr, argc-3, argv+3);
+ } else if ((c == 'b') && (strncmp(argv[1], "before", length) == 0)) {
+ Packer *packPtr, *masterPtr;
+ register Packer *prevPtr;
+ Tk_Window tkwin2;
+
+ tkwin2 = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ packPtr = GetPacker(tkwin2);
+ if (packPtr->masterPtr == NULL) {
+ Tcl_AppendResult(interp, "window \"", argv[2],
+ "\" isn't packed", (char *) NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = packPtr->masterPtr;
+ prevPtr = masterPtr->slavePtr;
+ if (prevPtr == packPtr) {
+ prevPtr = NULL;
+ } else {
+ for ( ; ; prevPtr = prevPtr->nextPtr) {
+ if (prevPtr == NULL) {
+ panic("\"pack before\" couldn't find predecessor");
+ }
+ if (prevPtr->nextPtr == packPtr) {
+ break;
+ }
+ }
+ }
+ return PackAfter(interp, prevPtr, masterPtr, argc-3, argv+3);
+ } 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);
+ } else if ((c == 'f') && (strncmp(argv[1], "forget", length) == 0)) {
+ Tk_Window slave;
+ Packer *slavePtr;
+ int i;
+
+ for (i = 2; i < argc; i++) {
+ slave = Tk_NameToWindow(interp, argv[i], tkwin);
+ if (slave == NULL) {
+ continue;
+ }
+ slavePtr = GetPacker(slave);
+ if ((slavePtr != NULL) && (slavePtr->masterPtr != NULL)) {
+ 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 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;
+ }
+ slave = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (slave == NULL) {
+ return TCL_ERROR;
+ }
+ slavePtr = GetPacker(slave);
+ if (slavePtr->masterPtr == NULL) {
+ Tcl_AppendResult(interp, "window \"", argv[2],
+ "\" isn't packed", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_AppendElement(interp, "-in");
+ Tcl_AppendElement(interp, Tk_PathName(slavePtr->masterPtr->tkwin));
+ Tcl_AppendElement(interp, "-anchor");
+ Tcl_AppendElement(interp, Tk_NameOfAnchor(slavePtr->anchor));
+ Tcl_AppendResult(interp, " -expand ",
+ (slavePtr->flags & EXPAND) ? "1" : "0", " -fill ",
+ (char *) NULL);
+ switch (slavePtr->flags & (FILLX|FILLY)) {
+ case 0:
+ Tcl_AppendResult(interp, "none", (char *) NULL);
+ break;
+ case FILLX:
+ Tcl_AppendResult(interp, "x", (char *) NULL);
+ break;
+ case FILLY:
+ Tcl_AppendResult(interp, "y", (char *) NULL);
+ break;
+ case FILLX|FILLY:
+ Tcl_AppendResult(interp, "both", (char *) NULL);
+ break;
+ }
+ sprintf(buffer, " -ipadx %d -ipady %d -padx %d -pady %d",
+ slavePtr->iPadX/2, slavePtr->iPadY/2, slavePtr->padX/2,
+ slavePtr->padY/2);
+ Tcl_AppendResult(interp, buffer, " -side ", sideNames[slavePtr->side],
+ (char *) NULL);
+ } else if ((c == 'p') && (strncmp(argv[1], "propagate", length) == 0)) {
+ Tk_Window master;
+ Packer *masterPtr;
+ 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 = 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) {
+ masterPtr->flags &= ~DONT_PROPAGATE;
+
+ /*
+ * Repack the master to allow new geometry information to
+ * propagate upwards to the master's master.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_REPACK)) {
+ masterPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr);
+ }
+ } else {
+ masterPtr->flags |= DONT_PROPAGATE;
+ }
+ } else if ((c == 's') && (strncmp(argv[1], "slaves", length) == 0)) {
+ Tk_Window master;
+ Packer *masterPtr, *slavePtr;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " slaves window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ master = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (master == NULL) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetPacker(master);
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ Tcl_AppendElement(interp, Tk_PathName(slavePtr->tkwin));
+ }
+ } else if ((c == 'u') && (strncmp(argv[1], "unpack", length) == 0)) {
+ Tk_Window tkwin2;
+ Packer *packPtr;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " unpack window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ tkwin2 = Tk_NameToWindow(interp, argv[2], tkwin);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ packPtr = GetPacker(tkwin2);
+ if ((packPtr != NULL) && (packPtr->masterPtr != NULL)) {
+ Tk_ManageGeometry(tkwin2, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ if (packPtr->masterPtr->tkwin != Tk_Parent(packPtr->tkwin)) {
+ Tk_UnmaintainGeometry(packPtr->tkwin,
+ packPtr->masterPtr->tkwin);
+ }
+ Unlink(packPtr);
+ Tk_UnmapWindow(packPtr->tkwin);
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be configure, forget, info, ",
+ "propagate, or slaves", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PackReqProc --
+ *
+ * This procedure is invoked by Tk_GeometryRequest for
+ * windows managed by the packer.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arranges for tkwin, and all its managed siblings, to
+ * be re-packed at the next idle point.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+PackReqProc(clientData, tkwin)
+ ClientData clientData; /* Packer's information about
+ * window that got new preferred
+ * geometry. */
+ Tk_Window tkwin; /* Other Tk-related information
+ * about the window. */
+{
+ register Packer *packPtr = (Packer *) clientData;
+
+ packPtr = packPtr->masterPtr;
+ if (!(packPtr->flags & REQUESTED_REPACK)) {
+ packPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, (ClientData) packPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PackLostSlaveProc --
+ *
+ * This procedure is invoked by Tk whenever some other geometry
+ * claims control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all packer-related information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+PackLostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* Packer structure for slave window that
+ * was stolen away. */
+ Tk_Window tkwin; /* Tk's handle for the slave window. */
+{
+ register Packer *slavePtr = (Packer *) clientData;
+
+ if (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, slavePtr->masterPtr->tkwin);
+ }
+ Unlink(slavePtr);
+ Tk_UnmapWindow(slavePtr->tkwin);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ArrangePacking --
+ *
+ * This procedure is invoked (using the Tcl_DoWhenIdle
+ * mechanism) to re-layout a set of windows managed by
+ * the packer. It is invoked at idle time so that a
+ * series of packer requests can be merged into a single
+ * layout operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The packed slaves of masterPtr may get resized or
+ * moved.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ArrangePacking(clientData)
+ ClientData clientData; /* Structure describing parent whose slaves
+ * are to be re-layed out. */
+{
+ register Packer *masterPtr = (Packer *) clientData;
+ register Packer *slavePtr;
+ int cavityX, cavityY, cavityWidth, cavityHeight;
+ /* These variables keep track of the
+ * as-yet-unallocated space remaining in
+ * the middle of the parent window. */
+ int frameX, frameY, frameWidth, frameHeight;
+ /* These variables keep track of the frame
+ * allocated to the current window. */
+ int x, y, width, height; /* These variables are used to hold the
+ * actual geometry of the current window. */
+ int intBWidth; /* Width of internal border in parent window,
+ * if any. */
+ int abort; /* May get set to non-zero to abort this
+ * repacking operation. */
+ int borderX, borderY;
+ int maxWidth, maxHeight, tmp;
+
+ masterPtr->flags &= ~REQUESTED_REPACK;
+
+ /*
+ * If the parent has no slaves anymore, then don't do anything
+ * at all: just leave the parent's size as-is.
+ */
+
+ if (masterPtr->slavePtr == NULL) {
+ return;
+ }
+
+ /*
+ * Abort any nested call to ArrangePacking for this window, since
+ * we'll do everything necessary here, and set up so this call
+ * can be aborted if necessary.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ masterPtr->abortPtr = &abort;
+ abort = 0;
+ Tcl_Preserve((ClientData) masterPtr);
+
+ /*
+ * Pass #1: scan all the slaves to figure out the total amount
+ * of space needed. Two separate width and height values are
+ * computed:
+ *
+ * width - Holds the sum of the widths (plus padding) of
+ * all the slaves seen so far that were packed LEFT
+ * or RIGHT.
+ * height - Holds the sum of the heights (plus padding) of
+ * all the slaves seen so far that were packed TOP
+ * or BOTTOM.
+ *
+ * maxWidth - Gradually builds up the width needed by the master
+ * to just barely satisfy all the slave's needs. For
+ * each slave, the code computes the width needed for
+ * all the slaves so far and updates maxWidth if the
+ * new value is greater.
+ * maxHeight - Same as maxWidth, except keeps height info.
+ */
+
+ intBWidth = Tk_InternalBorderWidth(masterPtr->tkwin);
+ width = height = maxWidth = maxHeight = 2*intBWidth;
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ if ((slavePtr->side == TOP) || (slavePtr->side == BOTTOM)) {
+ tmp = Tk_ReqWidth(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padX + slavePtr->iPadX + width;
+ if (tmp > maxWidth) {
+ maxWidth = tmp;
+ }
+ height += Tk_ReqHeight(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padY + slavePtr->iPadY;
+ } else {
+ tmp = Tk_ReqHeight(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padY + slavePtr->iPadY + height;
+ if (tmp > maxHeight) {
+ maxHeight = tmp;
+ }
+ width += Tk_ReqWidth(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padX + slavePtr->iPadX;
+ }
+ }
+ if (width > maxWidth) {
+ maxWidth = width;
+ }
+ if (height > maxHeight) {
+ maxHeight = height;
+ }
+
+ /*
+ * If the total amount of space needed in the parent window has
+ * changed, and if we're propagating geometry information, then
+ * notify the next geometry manager up and requeue ourselves to
+ * start again after the parent has had a chance to
+ * resize us.
+ */
+
+ if (((maxWidth != Tk_ReqWidth(masterPtr->tkwin))
+ || (maxHeight != Tk_ReqHeight(masterPtr->tkwin)))
+ && !(masterPtr->flags & DONT_PROPAGATE)) {
+ Tk_GeometryRequest(masterPtr->tkwin, maxWidth, maxHeight);
+ masterPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr);
+ goto done;
+ }
+
+ /*
+ * Pass #2: scan the slaves a second time assigning
+ * new sizes. The "cavity" variables keep track of the
+ * unclaimed space in the cavity of the window; this
+ * shrinks inward as we allocate windows around the
+ * edges. The "frame" variables keep track of the space
+ * allocated to the current window and its frame. The
+ * current window is then placed somewhere inside the
+ * frame, depending on anchor.
+ */
+
+ cavityX = cavityY = x = y = intBWidth;
+ cavityWidth = Tk_Width(masterPtr->tkwin) - 2*intBWidth;
+ cavityHeight = Tk_Height(masterPtr->tkwin) - 2*intBWidth;
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ if ((slavePtr->side == TOP) || (slavePtr->side == BOTTOM)) {
+ frameWidth = cavityWidth;
+ frameHeight = Tk_ReqHeight(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padY + slavePtr->iPadY;
+ if (slavePtr->flags & EXPAND) {
+ frameHeight += YExpansion(slavePtr, cavityHeight);
+ }
+ cavityHeight -= frameHeight;
+ if (cavityHeight < 0) {
+ frameHeight += cavityHeight;
+ cavityHeight = 0;
+ }
+ frameX = cavityX;
+ if (slavePtr->side == TOP) {
+ frameY = cavityY;
+ cavityY += frameHeight;
+ } else {
+ frameY = cavityY + cavityHeight;
+ }
+ } else {
+ frameHeight = cavityHeight;
+ frameWidth = Tk_ReqWidth(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padX + slavePtr->iPadX;
+ if (slavePtr->flags & EXPAND) {
+ frameWidth += XExpansion(slavePtr, cavityWidth);
+ }
+ cavityWidth -= frameWidth;
+ if (cavityWidth < 0) {
+ frameWidth += cavityWidth;
+ cavityWidth = 0;
+ }
+ frameY = cavityY;
+ if (slavePtr->side == LEFT) {
+ frameX = cavityX;
+ cavityX += frameWidth;
+ } else {
+ frameX = cavityX + cavityWidth;
+ }
+ }
+
+ /*
+ * Now that we've got the size of the frame for the window,
+ * compute the window's actual size and location using the
+ * fill, padding, and frame factors. The variables "borderX"
+ * and "borderY" are used to handle the differences between
+ * old-style packing and the new style (in old-style, iPadX
+ * and iPadY are always zero and padding is completely ignored
+ * except when computing frame size).
+ */
+
+ if (slavePtr->flags & OLD_STYLE) {
+ borderX = borderY = 0;
+ } else {
+ borderX = slavePtr->padX;
+ borderY = slavePtr->padY;
+ }
+ width = Tk_ReqWidth(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->iPadX;
+ if ((slavePtr->flags & FILLX)
+ || (width > (frameWidth - borderX))) {
+ width = frameWidth - borderX;
+ }
+ height = Tk_ReqHeight(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->iPadY;
+ if ((slavePtr->flags & FILLY)
+ || (height > (frameHeight - borderY))) {
+ height = frameHeight - borderY;
+ }
+ borderX /= 2;
+ borderY /= 2;
+ switch (slavePtr->anchor) {
+ case TK_ANCHOR_N:
+ x = frameX + (frameWidth - width)/2;
+ y = frameY + borderY;
+ break;
+ case TK_ANCHOR_NE:
+ x = frameX + frameWidth - width - borderX;
+ y = frameY + borderY;
+ break;
+ case TK_ANCHOR_E:
+ x = frameX + frameWidth - width - borderX;
+ y = frameY + (frameHeight - height)/2;
+ break;
+ case TK_ANCHOR_SE:
+ x = frameX + frameWidth - width - borderX;
+ y = frameY + frameHeight - height - borderY;
+ break;
+ case TK_ANCHOR_S:
+ x = frameX + (frameWidth - width)/2;
+ y = frameY + frameHeight - height - borderY;
+ break;
+ case TK_ANCHOR_SW:
+ x = frameX + borderX;
+ y = frameY + frameHeight - height - borderY;
+ break;
+ case TK_ANCHOR_W:
+ x = frameX + borderX;
+ y = frameY + (frameHeight - height)/2;
+ break;
+ case TK_ANCHOR_NW:
+ x = frameX + borderX;
+ y = frameY + borderY;
+ break;
+ case TK_ANCHOR_CENTER:
+ x = frameX + (frameWidth - width)/2;
+ y = frameY + (frameHeight - height)/2;
+ break;
+ default:
+ panic("bad frame factor in ArrangePacking");
+ }
+ width -= slavePtr->doubleBw;
+ height -= slavePtr->doubleBw;
+
+ /*
+ * The final step is to set the position, size, and mapped/unmapped
+ * state of the slave. If the slave is a child of the master, then
+ * do this here. Otherwise let Tk_MaintainGeometry do the work.
+ */
+
+ if (masterPtr->tkwin == Tk_Parent(slavePtr->tkwin)) {
+ if ((width <= 0) || (height <= 0)) {
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ if ((x != Tk_X(slavePtr->tkwin))
+ || (y != Tk_Y(slavePtr->tkwin))
+ || (width != Tk_Width(slavePtr->tkwin))
+ || (height != Tk_Height(slavePtr->tkwin))) {
+ Tk_MoveResizeWindow(slavePtr->tkwin, x, y, width, height);
+ }
+ if (abort) {
+ goto done;
+ }
+
+ /*
+ * Don't map the slave if the master isn't mapped: wait
+ * until the master gets mapped later.
+ */
+
+ if (Tk_IsMapped(masterPtr->tkwin)) {
+ Tk_MapWindow(slavePtr->tkwin);
+ }
+ }
+ } else {
+ if ((width <= 0) || (height <= 0)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, masterPtr->tkwin);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ Tk_MaintainGeometry(slavePtr->tkwin, masterPtr->tkwin,
+ x, y, width, height);
+ }
+ }
+
+ /*
+ * Changes to the window's structure could cause almost anything
+ * to happen, including deleting the parent or child. If this
+ * happens, we'll be told to abort.
+ */
+
+ if (abort) {
+ goto done;
+ }
+ }
+
+ done:
+ masterPtr->abortPtr = NULL;
+ Tcl_Release((ClientData) masterPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XExpansion --
+ *
+ * Given a list of packed slaves, the first of which is packed
+ * on the left or right and is expandable, compute how much to
+ * expand the child.
+ *
+ * Results:
+ * The return value is the number of additional pixels to give to
+ * the child.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+XExpansion(slavePtr, cavityWidth)
+ register Packer *slavePtr; /* First in list of remaining
+ * slaves. */
+ int cavityWidth; /* Horizontal space left for all
+ * remaining slaves. */
+{
+ int numExpand, minExpand, curExpand;
+ int childWidth;
+
+ /*
+ * This procedure is tricky because windows packed top or bottom can
+ * be interspersed among expandable windows packed left or right.
+ * Scan through the list, keeping a running sum of the widths of
+ * all left and right windows (actually, count the cavity space not
+ * allocated) and a running count of all expandable left and right
+ * windows. At each top or bottom window, and at the end of the
+ * list, compute the expansion factor that seems reasonable at that
+ * point. Return the smallest factor seen at any of these points.
+ */
+
+ minExpand = cavityWidth;
+ numExpand = 0;
+ for ( ; slavePtr != NULL; slavePtr = slavePtr->nextPtr) {
+ childWidth = Tk_ReqWidth(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padX + slavePtr->iPadX;
+ if ((slavePtr->side == TOP) || (slavePtr->side == BOTTOM)) {
+ curExpand = (cavityWidth - childWidth)/numExpand;
+ if (curExpand < minExpand) {
+ minExpand = curExpand;
+ }
+ } else {
+ cavityWidth -= childWidth;
+ if (slavePtr->flags & EXPAND) {
+ numExpand++;
+ }
+ }
+ }
+ curExpand = cavityWidth/numExpand;
+ if (curExpand < minExpand) {
+ minExpand = curExpand;
+ }
+ return (minExpand < 0) ? 0 : minExpand;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * YExpansion --
+ *
+ * Given a list of packed slaves, the first of which is packed
+ * on the top or bottom and is expandable, compute how much to
+ * expand the child.
+ *
+ * Results:
+ * The return value is the number of additional pixels to give to
+ * the child.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+YExpansion(slavePtr, cavityHeight)
+ register Packer *slavePtr; /* First in list of remaining
+ * slaves. */
+ int cavityHeight; /* Vertical space left for all
+ * remaining slaves. */
+{
+ int numExpand, minExpand, curExpand;
+ int childHeight;
+
+ /*
+ * See comments for XExpansion.
+ */
+
+ minExpand = cavityHeight;
+ numExpand = 0;
+ for ( ; slavePtr != NULL; slavePtr = slavePtr->nextPtr) {
+ childHeight = Tk_ReqHeight(slavePtr->tkwin) + slavePtr->doubleBw
+ + slavePtr->padY + slavePtr->iPadY;
+ if ((slavePtr->side == LEFT) || (slavePtr->side == RIGHT)) {
+ curExpand = (cavityHeight - childHeight)/numExpand;
+ if (curExpand < minExpand) {
+ minExpand = curExpand;
+ }
+ } else {
+ cavityHeight -= childHeight;
+ if (slavePtr->flags & EXPAND) {
+ numExpand++;
+ }
+ }
+ }
+ curExpand = cavityHeight/numExpand;
+ if (curExpand < minExpand) {
+ minExpand = curExpand;
+ }
+ return (minExpand < 0) ? 0 : minExpand;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * GetPacker --
+ *
+ * This internal procedure is used to locate a Packer
+ * structure for a given window, creating one if one
+ * doesn't exist already.
+ *
+ * Results:
+ * The return value is a pointer to the Packer structure
+ * corresponding to tkwin.
+ *
+ * Side effects:
+ * A new packer structure may be created. If so, then
+ * a callback is set up to clean things up when the
+ * window is deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static Packer *
+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;
+ packPtr->slavePtr = NULL;
+ packPtr->side = TOP;
+ packPtr->anchor = TK_ANCHOR_CENTER;
+ packPtr->padX = packPtr->padY = 0;
+ packPtr->iPadX = packPtr->iPadY = 0;
+ packPtr->doubleBw = 2*Tk_Changes(tkwin)->border_width;
+ packPtr->abortPtr = NULL;
+ packPtr->flags = 0;
+ Tcl_SetHashValue(hPtr, packPtr);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ PackStructureProc, (ClientData) packPtr);
+ return packPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PackAfter --
+ *
+ * This procedure does most of the real work of adding
+ * one or more windows into the packing order for its parent.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The geometry of the specified windows may change, both now and
+ * again in the future.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+PackAfter(interp, prevPtr, masterPtr, argc, argv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Packer *prevPtr; /* Pack windows in argv just after this
+ * window; NULL means pack as first
+ * child of masterPtr. */
+ Packer *masterPtr; /* Master in which to pack windows. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Array of lists, each containing 2
+ * elements: window name and side
+ * against which to pack. */
+{
+ register Packer *packPtr;
+ Tk_Window tkwin, ancestor, parent;
+ size_t length;
+ char **options;
+ int index, tmp, optionCount, c;
+
+ /*
+ * Iterate over all of the window specifiers, each consisting of
+ * two arguments. The first argument contains the window name and
+ * the additional arguments contain options such as "top" or
+ * "padx 20".
+ */
+
+ for ( ; argc > 0; argc -= 2, argv += 2, prevPtr = packPtr) {
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: window \"",
+ argv[0], "\" should be followed by options",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Find the packer for the window to be packed, and make sure
+ * that the window in which it will be packed is either its
+ * or a descendant of its parent.
+ */
+
+ tkwin = Tk_NameToWindow(interp, argv[0], masterPtr->tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+
+ parent = Tk_Parent(tkwin);
+ for (ancestor = masterPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (((Tk_FakeWin *) (ancestor))->flags & TK_TOP_LEVEL) {
+ badWindow:
+ Tcl_AppendResult(interp, "can't pack ", argv[0],
+ " inside ", Tk_PathName(masterPtr->tkwin),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (((Tk_FakeWin *) (tkwin))->flags & TK_TOP_LEVEL) {
+ goto badWindow;
+ }
+ if (tkwin == masterPtr->tkwin) {
+ goto badWindow;
+ }
+ packPtr = GetPacker(tkwin);
+
+ /*
+ * Process options for this window.
+ */
+
+ if (Tcl_SplitList(interp, argv[1], &optionCount, &options) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ packPtr->side = TOP;
+ packPtr->anchor = TK_ANCHOR_CENTER;
+ packPtr->padX = packPtr->padY = 0;
+ packPtr->iPadX = packPtr->iPadY = 0;
+ packPtr->flags &= ~(FILLX|FILLY|EXPAND);
+ packPtr->flags |= OLD_STYLE;
+ for (index = 0 ; index < optionCount; index++) {
+ char *curOpt = options[index];
+
+ c = curOpt[0];
+ length = strlen(curOpt);
+
+ if ((c == 't')
+ && (strncmp(curOpt, "top", length)) == 0) {
+ packPtr->side = TOP;
+ } else if ((c == 'b')
+ && (strncmp(curOpt, "bottom", length)) == 0) {
+ packPtr->side = BOTTOM;
+ } else if ((c == 'l')
+ && (strncmp(curOpt, "left", length)) == 0) {
+ packPtr->side = LEFT;
+ } else if ((c == 'r')
+ && (strncmp(curOpt, "right", length)) == 0) {
+ packPtr->side = RIGHT;
+ } else if ((c == 'e')
+ && (strncmp(curOpt, "expand", length)) == 0) {
+ packPtr->flags |= EXPAND;
+ } else if ((c == 'f')
+ && (strcmp(curOpt, "fill")) == 0) {
+ packPtr->flags |= FILLX|FILLY;
+ } else if ((length == 5) && (strcmp(curOpt, "fillx")) == 0) {
+ packPtr->flags |= FILLX;
+ } else if ((length == 5) && (strcmp(curOpt, "filly")) == 0) {
+ packPtr->flags |= FILLY;
+ } else if ((c == 'p') && (strcmp(curOpt, "padx")) == 0) {
+ if (optionCount < (index+2)) {
+ missingPad:
+ Tcl_AppendResult(interp, "wrong # args: \"", curOpt,
+ "\" option must be followed by screen distance",
+ (char *) NULL);
+ goto error;
+ }
+ if ((Tk_GetPixels(interp, tkwin, options[index+1], &tmp)
+ != TCL_OK) || (tmp < 0)) {
+ badPad:
+ Tcl_AppendResult(interp, "bad pad value \"",
+ options[index+1],
+ "\": must be positive screen distance",
+ (char *) NULL);
+ goto error;
+ }
+ packPtr->padX = tmp;
+ packPtr->iPadX = 0;
+ index++;
+ } else if ((c == 'p') && (strcmp(curOpt, "pady")) == 0) {
+ if (optionCount < (index+2)) {
+ goto missingPad;
+ }
+ if ((Tk_GetPixels(interp, tkwin, options[index+1], &tmp)
+ != TCL_OK) || (tmp < 0)) {
+ goto badPad;
+ }
+ packPtr->padY = tmp;
+ packPtr->iPadY = 0;
+ index++;
+ } else if ((c == 'f') && (length > 1)
+ && (strncmp(curOpt, "frame", length) == 0)) {
+ if (optionCount < (index+2)) {
+ Tcl_AppendResult(interp, "wrong # args: \"frame\" ",
+ "option must be followed by anchor point",
+ (char *) NULL);
+ goto error;
+ }
+ if (Tk_GetAnchor(interp, options[index+1],
+ &packPtr->anchor) != TCL_OK) {
+ goto error;
+ }
+ index++;
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", curOpt,
+ "\": should be top, bottom, left, right, ",
+ "expand, fill, fillx, filly, padx, pady, or frame",
+ (char *) NULL);
+ goto error;
+ }
+ }
+
+ if (packPtr != prevPtr) {
+
+ /*
+ * Unpack this window if it's currently packed.
+ */
+
+ if (packPtr->masterPtr != NULL) {
+ if ((packPtr->masterPtr != masterPtr) &&
+ (packPtr->masterPtr->tkwin
+ != Tk_Parent(packPtr->tkwin))) {
+ Tk_UnmaintainGeometry(packPtr->tkwin,
+ packPtr->masterPtr->tkwin);
+ }
+ Unlink(packPtr);
+ }
+
+ /*
+ * Add the window in the correct place in its parent's
+ * packing order, then make sure that the window is
+ * managed by us.
+ */
+
+ packPtr->masterPtr = masterPtr;
+ if (prevPtr == NULL) {
+ packPtr->nextPtr = masterPtr->slavePtr;
+ masterPtr->slavePtr = packPtr;
+ } else {
+ packPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = packPtr;
+ }
+ Tk_ManageGeometry(tkwin, &packerType, (ClientData) packPtr);
+ }
+ ckfree((char *) options);
+ }
+
+ /*
+ * Arrange for the parent to be re-packed at the first
+ * idle moment.
+ */
+
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_REPACK)) {
+ masterPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr);
+ }
+ return TCL_OK;
+
+ error:
+ ckfree((char *) options);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Unlink --
+ *
+ * Remove a packer from its parent's list of slaves.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The parent will be scheduled for repacking.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Unlink(packPtr)
+ register Packer *packPtr; /* Window to unlink. */
+{
+ register Packer *masterPtr, *packPtr2;
+
+ masterPtr = packPtr->masterPtr;
+ if (masterPtr == NULL) {
+ return;
+ }
+ if (masterPtr->slavePtr == packPtr) {
+ masterPtr->slavePtr = packPtr->nextPtr;
+ } else {
+ for (packPtr2 = masterPtr->slavePtr; ; packPtr2 = packPtr2->nextPtr) {
+ if (packPtr2 == NULL) {
+ panic("Unlink couldn't find previous window");
+ }
+ if (packPtr2->nextPtr == packPtr) {
+ packPtr2->nextPtr = packPtr->nextPtr;
+ break;
+ }
+ }
+ }
+ if (!(masterPtr->flags & REQUESTED_REPACK)) {
+ masterPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr);
+ }
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+
+ packPtr->masterPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyPacker --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a packer at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the packer is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyPacker(memPtr)
+ char *memPtr; /* Info about packed window that
+ * is now dead. */
+{
+ register Packer *packPtr = (Packer *) memPtr;
+ ckfree((char *) packPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PackStructureProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher in response
+ * to StructureNotify events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a window was just deleted, clean up all its packer-related
+ * information. If it was just resized, repack its slaves, if
+ * any.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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) {
+ if ((packPtr->masterPtr != NULL)
+ && !(packPtr->masterPtr->flags & REQUESTED_REPACK)) {
+ packPtr->doubleBw = 2*Tk_Changes(packPtr->tkwin)->border_width;
+ packPtr->masterPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, (ClientData) packPtr->masterPtr);
+ }
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ register Packer *slavePtr, *nextPtr;
+
+ if (packPtr->masterPtr != NULL) {
+ Unlink(packPtr);
+ }
+ for (slavePtr = packPtr->slavePtr; slavePtr != NULL;
+ slavePtr = nextPtr) {
+ 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) {
+ /*
+ * When a master gets mapped, must redo the geometry computation
+ * so that all of its slaves get remapped.
+ */
+
+ if ((packPtr->slavePtr != NULL)
+ && !(packPtr->flags & REQUESTED_REPACK)) {
+ packPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, (ClientData) packPtr);
+ }
+ } else if (eventPtr->type == UnmapNotify) {
+ Packer *packPtr2;
+
+ /*
+ * Unmap all of the slaves when the master gets unmapped,
+ * so that they don't bother to keep redisplaying
+ * themselves.
+ */
+
+ for (packPtr2 = packPtr->slavePtr; packPtr2 != NULL;
+ packPtr2 = packPtr2->nextPtr) {
+ Tk_UnmapWindow(packPtr2->tkwin);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureSlaves --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureSlaves(interp, tkwin, argc, argv)
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ Tk_Window tkwin; /* Any window in application containing
+ * slaves. Used to look up slave names. */
+ int argc; /* Number of elements in argv. */
+ char *argv[]; /* Argument strings: contains one or more
+ * window names followed by any number
+ * of "option value" pairs. Caller must
+ * make sure that there is at least one
+ * window name. */
+{
+ Packer *masterPtr, *slavePtr, *prevPtr, *otherPtr;
+ Tk_Window other, slave, parent, ancestor;
+ int i, j, numWindows, c, tmp, positionGiven;
+ size_t length;
+
+ /*
+ * Find out how many windows are specified.
+ */
+
+ for (numWindows = 0; numWindows < argc; numWindows++) {
+ if (argv[numWindows][0] != '.') {
+ break;
+ }
+ }
+
+ /*
+ * Iterate over all of the slave windows, parsing the configuration
+ * options for each slave. It's a bit wasteful to re-parse the
+ * options for each slave, but things get too messy if we try to
+ * parse the arguments just once at the beginning. For example,
+ * if a slave already is packed we want to just change a few
+ * existing values without resetting everything. If there are
+ * multiple windows, the -after, -before, and -in options only
+ * get processed for the first window.
+ */
+
+ masterPtr = NULL;
+ prevPtr = NULL;
+ positionGiven = 0;
+ for (j = 0; j < numWindows; j++) {
+ slave = Tk_NameToWindow(interp, argv[j], tkwin);
+ if (slave == NULL) {
+ return TCL_ERROR;
+ }
+ if (Tk_IsTopLevel(slave)) {
+ Tcl_AppendResult(interp, "can't pack \"", argv[j],
+ "\": it's a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr = GetPacker(slave);
+ slavePtr->flags &= ~OLD_STYLE;
+
+ /*
+ * If the slave isn't currently packed, reset all of its
+ * configuration information to default values (there could
+ * be old values left from a previous packing).
+ */
+
+ if (slavePtr->masterPtr == NULL) {
+ slavePtr->side = TOP;
+ slavePtr->anchor = TK_ANCHOR_CENTER;
+ slavePtr->padX = slavePtr->padY = 0;
+ slavePtr->iPadX = slavePtr->iPadY = 0;
+ slavePtr->flags &= ~(FILLX|FILLY|EXPAND);
+ }
+
+ for (i = numWindows; i < argc; i+=2) {
+ if ((i+2) > argc) {
+ Tcl_AppendResult(interp, "extra option \"", argv[i],
+ "\" (option with no value?)", (char *) NULL);
+ return TCL_ERROR;
+ }
+ length = strlen(argv[i]);
+ if (length < 2) {
+ goto badOption;
+ }
+ c = argv[i][1];
+ if ((c == 'a') && (strncmp(argv[i], "-after", length) == 0)
+ && (length >= 2)) {
+ if (j == 0) {
+ other = Tk_NameToWindow(interp, argv[i+1], tkwin);
+ if (other == NULL) {
+ return TCL_ERROR;
+ }
+ prevPtr = GetPacker(other);
+ if (prevPtr->masterPtr == NULL) {
+ notPacked:
+ Tcl_AppendResult(interp, "window \"", argv[i+1],
+ "\" isn't packed", (char *) NULL);
+ return TCL_ERROR;
+ }
+ masterPtr = prevPtr->masterPtr;
+ positionGiven = 1;
+ }
+ } else if ((c == 'a') && (strncmp(argv[i], "-anchor", length) == 0)
+ && (length >= 2)) {
+ if (Tk_GetAnchor(interp, argv[i+1], &slavePtr->anchor)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else if ((c == 'b')
+ && (strncmp(argv[i], "-before", length) == 0)) {
+ if (j == 0) {
+ other = Tk_NameToWindow(interp, argv[i+1], tkwin);
+ if (other == NULL) {
+ return TCL_ERROR;
+ }
+ otherPtr = GetPacker(other);
+ if (otherPtr->masterPtr == NULL) {
+ goto notPacked;
+ }
+ masterPtr = otherPtr->masterPtr;
+ prevPtr = masterPtr->slavePtr;
+ if (prevPtr == otherPtr) {
+ prevPtr = NULL;
+ } else {
+ while (prevPtr->nextPtr != otherPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ }
+ positionGiven = 1;
+ }
+ } else if ((c == 'e')
+ && (strncmp(argv[i], "-expand", length) == 0)) {
+ if (Tcl_GetBoolean(interp, argv[i+1], &tmp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ slavePtr->flags &= ~EXPAND;
+ if (tmp) {
+ slavePtr->flags |= EXPAND;
+ }
+ } else if ((c == 'f') && (strncmp(argv[i], "-fill", length) == 0)) {
+ if (strcmp(argv[i+1], "none") == 0) {
+ slavePtr->flags &= ~(FILLX|FILLY);
+ } else if (strcmp(argv[i+1], "x") == 0) {
+ slavePtr->flags = (slavePtr->flags & ~FILLY) | FILLX;
+ } else if (strcmp(argv[i+1], "y") == 0) {
+ slavePtr->flags = (slavePtr->flags & ~FILLX) | FILLY;
+ } else if (strcmp(argv[i+1], "both") == 0) {
+ slavePtr->flags |= FILLX|FILLY;
+ } else {
+ Tcl_AppendResult(interp, "bad fill style \"", argv[i+1],
+ "\": must be none, x, y, or both", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else if ((c == 'i') && (strcmp(argv[i], "-in") == 0)) {
+ if (j == 0) {
+ other = Tk_NameToWindow(interp, argv[i+1], tkwin);
+ if (other == NULL) {
+ return TCL_ERROR;
+ }
+ masterPtr = GetPacker(other);
+ prevPtr = masterPtr->slavePtr;
+ if (prevPtr != NULL) {
+ while (prevPtr->nextPtr != NULL) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ }
+ positionGiven = 1;
+ }
+ } else if ((c == 'i') && (strcmp(argv[i], "-ipadx") == 0)) {
+ if ((Tk_GetPixels(interp, slave, argv[i+1], &tmp) != TCL_OK)
+ || (tmp < 0)) {
+ badPad:
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad pad value \"", argv[i+1],
+ "\": must be positive screen distance",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr->iPadX = tmp*2;
+ } else if ((c == 'i') && (strcmp(argv[i], "-ipady") == 0)) {
+ if ((Tk_GetPixels(interp, slave, argv[i+1], &tmp) != TCL_OK)
+ || (tmp< 0)) {
+ goto badPad;
+ }
+ slavePtr->iPadY = tmp*2;
+ } else if ((c == 'p') && (strcmp(argv[i], "-padx") == 0)) {
+ if ((Tk_GetPixels(interp, slave, argv[i+1], &tmp) != TCL_OK)
+ || (tmp< 0)) {
+ goto badPad;
+ }
+ slavePtr->padX = tmp*2;
+ } else if ((c == 'p') && (strcmp(argv[i], "-pady") == 0)) {
+ if ((Tk_GetPixels(interp, slave, argv[i+1], &tmp) != TCL_OK)
+ || (tmp< 0)) {
+ goto badPad;
+ }
+ slavePtr->padY = tmp*2;
+ } else if ((c == 's') && (strncmp(argv[i], "-side", length) == 0)) {
+ c = argv[i+1][0];
+ if ((c == 't') && (strcmp(argv[i+1], "top") == 0)) {
+ slavePtr->side = TOP;
+ } else if ((c == 'b') && (strcmp(argv[i+1], "bottom") == 0)) {
+ slavePtr->side = BOTTOM;
+ } else if ((c == 'l') && (strcmp(argv[i+1], "left") == 0)) {
+ slavePtr->side = LEFT;
+ } else if ((c == 'r') && (strcmp(argv[i+1], "right") == 0)) {
+ slavePtr->side = RIGHT;
+ } else {
+ Tcl_AppendResult(interp, "bad side \"", argv[i+1],
+ "\": must be top, bottom, left, or right",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ badOption:
+ Tcl_AppendResult(interp, "unknown or ambiguous option \"",
+ argv[i], "\": must be -after, -anchor, -before, ",
+ "-expand, -fill, -in, -ipadx, -ipady, -padx, ",
+ "-pady, or -side", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * If no position in a packing list was specified and the slave
+ * is already packed, then leave it in its current location in
+ * its current packing list.
+ */
+
+ if (!positionGiven && (slavePtr->masterPtr != NULL)) {
+ masterPtr = slavePtr->masterPtr;
+ goto scheduleLayout;
+ }
+
+ /*
+ * If the slave is going to be put back after itself then
+ * skip the whole operation, since it won't work anyway.
+ */
+
+ if (prevPtr == slavePtr) {
+ masterPtr = slavePtr->masterPtr;
+ goto scheduleLayout;
+ }
+
+ /*
+ * If none of the "-in", "-before", or "-after" options has
+ * been specified, arrange for the slave to go at the end of
+ * the order for its parent.
+ */
+
+ if (!positionGiven) {
+ masterPtr = GetPacker(Tk_Parent(slave));
+ prevPtr = masterPtr->slavePtr;
+ if (prevPtr != NULL) {
+ while (prevPtr->nextPtr != NULL) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ }
+ }
+
+ /*
+ * Make sure that the slave's parent is either the master or
+ * an ancestor of the master, and that the master and slave
+ * aren't the same.
+ */
+
+ parent = Tk_Parent(slave);
+ for (ancestor = masterPtr->tkwin; ; ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (Tk_IsTopLevel(ancestor)) {
+ Tcl_AppendResult(interp, "can't pack ", argv[j],
+ " inside ", Tk_PathName(masterPtr->tkwin),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (slave == masterPtr->tkwin) {
+ Tcl_AppendResult(interp, "can't pack ", argv[j],
+ " inside itself", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Unpack the slave if it's currently packed, then position it
+ * after prevPtr.
+ */
+
+ if (slavePtr->masterPtr != NULL) {
+ if ((slavePtr->masterPtr != masterPtr) &&
+ (slavePtr->masterPtr->tkwin
+ != Tk_Parent(slavePtr->tkwin))) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin,
+ slavePtr->masterPtr->tkwin);
+ }
+ Unlink(slavePtr);
+ }
+ slavePtr->masterPtr = masterPtr;
+ if (prevPtr == NULL) {
+ slavePtr->nextPtr = masterPtr->slavePtr;
+ masterPtr->slavePtr = slavePtr;
+ } else {
+ slavePtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = slavePtr;
+ }
+ Tk_ManageGeometry(slave, &packerType, (ClientData) slavePtr);
+ prevPtr = slavePtr;
+
+ /*
+ * Arrange for the parent to be re-packed at the first
+ * idle moment.
+ */
+
+ scheduleLayout:
+ if (masterPtr->abortPtr != NULL) {
+ *masterPtr->abortPtr = 1;
+ }
+ if (!(masterPtr->flags & REQUESTED_REPACK)) {
+ masterPtr->flags |= REQUESTED_REPACK;
+ Tcl_DoWhenIdle(ArrangePacking, (ClientData) masterPtr);
+ }
+ }
+ return TCL_OK;
+}
diff --git a/tk/generic/tkPlace.c b/tk/generic/tkPlace.c
new file mode 100644
index 00000000000..2102b506117
--- /dev/null
+++ b/tk/generic/tkPlace.c
@@ -0,0 +1,1060 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * Border modes for relative placement:
+ *
+ * BM_INSIDE: relative distances computed using area inside
+ * all borders of master window.
+ * BM_OUTSIDE: relative distances computed using outside area
+ * that includes all borders of master.
+ * BM_IGNORE: border issues are ignored: place relative to
+ * master's actual window size.
+ */
+
+typedef enum {BM_INSIDE, BM_OUTSIDE, BM_IGNORE} BorderMode;
+
+/*
+ * For each window whose geometry is managed by the placer there is
+ * a structure of the following type:
+ */
+
+typedef struct Slave {
+ Tk_Window tkwin; /* Tk's token for window. */
+ struct Master *masterPtr; /* Pointer to information for window
+ * relative to which tkwin is placed.
+ * This isn't necessarily the logical
+ * parent of tkwin. NULL means the
+ * master was deleted or never assigned. */
+ struct Slave *nextPtr; /* Next in list of windows placed relative
+ * to same master (NULL for end of list). */
+
+ /*
+ * Geometry information for window; where there are both relative
+ * and absolute values for the same attribute (e.g. x and relX) only
+ * one of them is actually used, depending on flags.
+ */
+
+ int x, y; /* X and Y pixel coordinates for tkwin. */
+ float relX, relY; /* X and Y coordinates relative to size of
+ * master. */
+ int width, height; /* Absolute dimensions for tkwin. */
+ float relWidth, relHeight; /* Dimensions for tkwin relative to size of
+ * master. */
+ Tk_Anchor anchor; /* Which point on tkwin is placed at the
+ * given position. */
+ BorderMode borderMode; /* How to treat borders of master window. */
+ int flags; /* Various flags; see below for bit
+ * definitions. */
+} Slave;
+
+/*
+ * Flag definitions for Slave structures:
+ *
+ * CHILD_WIDTH - 1 means -width was specified;
+ * CHILD_REL_WIDTH - 1 means -relwidth was specified.
+ * CHILD_HEIGHT - 1 means -height was specified;
+ * CHILD_REL_HEIGHT - 1 means -relheight was specified.
+ */
+
+#define CHILD_WIDTH 1
+#define CHILD_REL_WIDTH 2
+#define CHILD_HEIGHT 4
+#define CHILD_REL_HEIGHT 8
+
+/*
+ * For each master window that has a slave managed by the placer there
+ * is a structure of the following form:
+ */
+
+typedef struct Master {
+ Tk_Window tkwin; /* Tk's token for master window. */
+ struct Slave *slavePtr; /* First in linked list of slaves
+ * placed relative to this master. */
+ int flags; /* See below for bit definitions. */
+} Master;
+
+/*
+ * Flag definitions for masters:
+ *
+ * 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,
+ Tk_Window tkwin));
+
+static Tk_GeomMgr placerType = {
+ "place", /* name */
+ PlaceRequestProc, /* requestProc */
+ PlaceLostSlaveProc, /* lostSlaveProc */
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void SlaveStructureProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int ConfigureSlave _ANSI_ARGS_((Tcl_Interp *interp,
+ Slave *slavePtr, int argc, char **argv));
+static Slave * FindSlave _ANSI_ARGS_((Tk_Window tkwin));
+static Master * FindMaster _ANSI_ARGS_((Tk_Window tkwin));
+static void MasterStructureProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void RecomputePlacement _ANSI_ARGS_((ClientData clientData));
+static void UnlinkSlave _ANSI_ARGS_((Slave *slavePtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_PlaceCmd --
+ *
+ * This procedure is invoked to process the "place" 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_PlaceCmd(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;
+ 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;
+ }
+ c = argv[1][0];
+ length = strlen(argv[1]);
+
+ /*
+ * Handle special shortcut where window name is first argument.
+ */
+
+ if (c == '.') {
+ tkwin = Tk_NameToWindow(interp, argv[1], (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ slavePtr = FindSlave(tkwin);
+ return ConfigureSlave(interp, slavePtr, argc-2, argv+2);
+ }
+
+ /*
+ * Handle more general case of option followed by window name followed
+ * by possible additional arguments.
+ */
+
+ tkwin = Tk_NameToWindow(interp, argv[2], (Tk_Window) clientData);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)) {
+ if (argc < 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0],
+ " configure pathName option value ?option value ...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ slavePtr = FindSlave(tkwin);
+ 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);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ sprintf(buffer, " -y %d", slavePtr->y);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ sprintf(buffer, " -rely %.4g", slavePtr->relY);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ if (slavePtr->flags & CHILD_WIDTH) {
+ sprintf(buffer, " -width %d", slavePtr->width);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, " -width {}", (char *) NULL);
+ }
+ if (slavePtr->flags & CHILD_REL_WIDTH) {
+ sprintf(buffer, " -relwidth %.4g", slavePtr->relWidth);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, " -relwidth {}", (char *) NULL);
+ }
+ if (slavePtr->flags & CHILD_HEIGHT) {
+ sprintf(buffer, " -height %d", slavePtr->height);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, " -height {}", (char *) NULL);
+ }
+ if (slavePtr->flags & CHILD_REL_HEIGHT) {
+ sprintf(buffer, " -relheight %.4g", slavePtr->relHeight);
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, " -relheight {}", (char *) NULL);
+ }
+
+ Tcl_AppendResult(interp, " -anchor ", Tk_NameOfAnchor(slavePtr->anchor),
+ (char *) NULL);
+ if (slavePtr->borderMode == BM_OUTSIDE) {
+ Tcl_AppendResult(interp, " -bordermode outside", (char *) NULL);
+ } else if (slavePtr->borderMode == BM_IGNORE) {
+ Tcl_AppendResult(interp, " -bordermode ignore", (char *) NULL);
+ }
+ if ((slavePtr->masterPtr != NULL)
+ && (slavePtr->masterPtr->tkwin != Tk_Parent(slavePtr->tkwin))) {
+ Tcl_AppendResult(interp, " -in ",
+ Tk_PathName(slavePtr->masterPtr->tkwin), (char *) NULL);
+ }
+ } 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));
+ }
+ }
+ } else {
+ Tcl_AppendResult(interp, "unknown or ambiguous option \"", argv[1],
+ "\": must be configure, forget, info, or slaves",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindSlave --
+ *
+ * Given a Tk_Window token, find the Slave structure corresponding
+ * to that token (making a new one if necessary).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new Slave structure may be created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ slavePtr->width = slavePtr->height = 0;
+ slavePtr->relWidth = slavePtr->relHeight = (float) 0.0;
+ slavePtr->anchor = TK_ANCHOR_NW;
+ slavePtr->borderMode = BM_INSIDE;
+ slavePtr->flags = 0;
+ Tcl_SetHashValue(hPtr, slavePtr);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask, SlaveStructureProc,
+ (ClientData) slavePtr);
+ Tk_ManageGeometry(tkwin, &placerType, (ClientData) slavePtr);
+ } else {
+ slavePtr = (Slave *) Tcl_GetHashValue(hPtr);
+ }
+ return slavePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UnlinkSlave --
+ *
+ * This procedure removes a slave window from the chain of slaves
+ * in its master.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The slave list of slavePtr's master changes.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UnlinkSlave(slavePtr)
+ Slave *slavePtr; /* Slave structure to be unlinked. */
+{
+ register Master *masterPtr;
+ register Slave *prevPtr;
+
+ masterPtr = slavePtr->masterPtr;
+ if (masterPtr == NULL) {
+ return;
+ }
+ if (masterPtr->slavePtr == slavePtr) {
+ masterPtr->slavePtr = slavePtr->nextPtr;
+ } else {
+ for (prevPtr = masterPtr->slavePtr; ;
+ prevPtr = prevPtr->nextPtr) {
+ if (prevPtr == NULL) {
+ panic("UnlinkSlave couldn't find slave to unlink");
+ }
+ if (prevPtr->nextPtr == slavePtr) {
+ prevPtr->nextPtr = slavePtr->nextPtr;
+ break;
+ }
+ }
+ }
+ slavePtr->masterPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindMaster --
+ *
+ * Given a Tk_Window token, find the Master structure corresponding
+ * to that token (making a new one if necessary).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new Master structure may be created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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,
+ MasterStructureProc, (ClientData) masterPtr);
+ } else {
+ masterPtr = (Master *) Tcl_GetHashValue(hPtr);
+ }
+ return masterPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureSlave(interp, slavePtr, argc, argv)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Slave *slavePtr; /* Pointer to current information
+ * about slave. */
+ int argc; /* Number of config arguments. */
+ char **argv; /* String values for arguments. */
+{
+ register Master *masterPtr;
+ int c, result;
+ size_t length;
+ double d;
+
+ result = TCL_OK;
+ if (Tk_IsTopLevel(slavePtr->tkwin)) {
+ Tcl_AppendResult(interp, "can't use placer on top-level window \"",
+ Tk_PathName(slavePtr->tkwin), "\"; use wm command instead",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ for ( ; argc > 0; argc -= 2, argv += 2) {
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "extra option \"", argv[0],
+ "\" (option with no value?)", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ length = strlen(argv[0]);
+ c = argv[0][1];
+ if ((c == 'a') && (strncmp(argv[0], "-anchor", length) == 0)) {
+ if (Tk_GetAnchor(interp, argv[1], &slavePtr->anchor) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else if ((c == 'b')
+ && (strncmp(argv[0], "-bordermode", length) == 0)) {
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'i') && (strncmp(argv[1], "ignore", length) == 0)
+ && (length >= 2)) {
+ slavePtr->borderMode = BM_IGNORE;
+ } else if ((c == 'i') && (strncmp(argv[1], "inside", length) == 0)
+ && (length >= 2)) {
+ slavePtr->borderMode = BM_INSIDE;
+ } else if ((c == 'o')
+ && (strncmp(argv[1], "outside", length) == 0)) {
+ slavePtr->borderMode = BM_OUTSIDE;
+ } else {
+ Tcl_AppendResult(interp, "bad border mode \"", argv[1],
+ "\": must be ignore, inside, or outside",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else if ((c == 'h') && (strncmp(argv[0], "-height", length) == 0)) {
+ if (argv[1][0] == 0) {
+ slavePtr->flags &= ~CHILD_HEIGHT;
+ } else {
+ if (Tk_GetPixels(interp, slavePtr->tkwin, argv[1],
+ &slavePtr->height) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ slavePtr->flags |= CHILD_HEIGHT;
+ }
+ } else if ((c == 'i') && (strncmp(argv[0], "-in", length) == 0)) {
+ Tk_Window tkwin;
+ Tk_Window ancestor;
+
+ tkwin = Tk_NameToWindow(interp, argv[1], slavePtr->tkwin);
+ if (tkwin == NULL) {
+ result = TCL_ERROR;
+ goto done;
+ }
+
+ /*
+ * Make sure that the new master is either the logical parent
+ * of the slave or a descendant of that window, and that the
+ * master and slave aren't the same.
+ */
+
+ for (ancestor = tkwin; ; ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == Tk_Parent(slavePtr->tkwin)) {
+ break;
+ }
+ if (Tk_IsTopLevel(ancestor)) {
+ Tcl_AppendResult(interp, "can't place ",
+ Tk_PathName(slavePtr->tkwin), " relative to ",
+ Tk_PathName(tkwin), (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+ if (slavePtr->tkwin == tkwin) {
+ Tcl_AppendResult(interp, "can't place ",
+ Tk_PathName(slavePtr->tkwin), " relative to itself",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if ((slavePtr->masterPtr != NULL)
+ && (slavePtr->masterPtr->tkwin == tkwin)) {
+ /*
+ * Re-using same old master. Nothing to do.
+ */
+ } else {
+ if ((slavePtr->masterPtr != NULL)
+ && (slavePtr->masterPtr->tkwin
+ != Tk_Parent(slavePtr->tkwin))) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin,
+ slavePtr->masterPtr->tkwin);
+ }
+ UnlinkSlave(slavePtr);
+ slavePtr->masterPtr = FindMaster(tkwin);
+ slavePtr->nextPtr = slavePtr->masterPtr->slavePtr;
+ slavePtr->masterPtr->slavePtr = slavePtr;
+ }
+ } else if ((c == 'r') && (strncmp(argv[0], "-relheight", length) == 0)
+ && (length >= 5)) {
+ if (argv[1][0] == 0) {
+ slavePtr->flags &= ~CHILD_REL_HEIGHT;
+ } else {
+ if (Tcl_GetDouble(interp, argv[1], &d) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ slavePtr->relHeight = (float) d;
+ slavePtr->flags |= CHILD_REL_HEIGHT;
+ }
+ } else if ((c == 'r') && (strncmp(argv[0], "-relwidth", length) == 0)
+ && (length >= 5)) {
+ if (argv[1][0] == 0) {
+ slavePtr->flags &= ~CHILD_REL_WIDTH;
+ } else {
+ if (Tcl_GetDouble(interp, argv[1], &d) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ slavePtr->relWidth = (float) d;
+ slavePtr->flags |= CHILD_REL_WIDTH;
+ }
+ } else if ((c == 'r') && (strncmp(argv[0], "-relx", length) == 0)
+ && (length >= 5)) {
+ if (Tcl_GetDouble(interp, argv[1], &d) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ slavePtr->relX = (float) d;
+ } else if ((c == 'r') && (strncmp(argv[0], "-rely", length) == 0)
+ && (length >= 5)) {
+ if (Tcl_GetDouble(interp, argv[1], &d) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ slavePtr->relY = (float) d;
+ } else if ((c == 'w') && (strncmp(argv[0], "-width", length) == 0)) {
+ if (argv[1][0] == 0) {
+ slavePtr->flags &= ~CHILD_WIDTH;
+ } else {
+ if (Tk_GetPixels(interp, slavePtr->tkwin, argv[1],
+ &slavePtr->width) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ slavePtr->flags |= CHILD_WIDTH;
+ }
+ } else if ((c == 'x') && (strncmp(argv[0], "-x", length) == 0)) {
+ if (Tk_GetPixels(interp, slavePtr->tkwin, argv[1],
+ &slavePtr->x) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else if ((c == 'y') && (strncmp(argv[0], "-y", length) == 0)) {
+ if (Tk_GetPixels(interp, slavePtr->tkwin, argv[1],
+ &slavePtr->y) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else {
+ Tcl_AppendResult(interp, "unknown or ambiguous option \"",
+ argv[0], "\": must be -anchor, -bordermode, -height, ",
+ "-in, -relheight, -relwidth, -relx, -rely, -width, ",
+ "-x, or -y", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ }
+
+ /*
+ * If there's no master specified for this slave, use its Tk_Parent.
+ * Then arrange for a placement recalculation in the master.
+ */
+
+ done:
+ masterPtr = slavePtr->masterPtr;
+ if (masterPtr == NULL) {
+ masterPtr = FindMaster(Tk_Parent(slavePtr->tkwin));
+ slavePtr->masterPtr = masterPtr;
+ slavePtr->nextPtr = masterPtr->slavePtr;
+ masterPtr->slavePtr = slavePtr;
+ }
+ if (!(masterPtr->flags & PARENT_RECONFIG_PENDING)) {
+ masterPtr->flags |= PARENT_RECONFIG_PENDING;
+ Tcl_DoWhenIdle(RecomputePlacement, (ClientData) masterPtr);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecomputePlacement --
+ *
+ * This procedure is called as a when-idle handler. It recomputes
+ * the geometries of all the slaves of a given master.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Windows may change size or shape.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RecomputePlacement(clientData)
+ ClientData clientData; /* Pointer to Master record. */
+{
+ register Master *masterPtr = (Master *) clientData;
+ register Slave *slavePtr;
+ int x, y, width, height, tmp;
+ int masterWidth, masterHeight, masterBW;
+ double x1, y1, x2, y2;
+
+ masterPtr->flags &= ~PARENT_RECONFIG_PENDING;
+
+ /*
+ * Iterate over all the slaves for the master. Each slave's
+ * geometry can be computed independently of the other slaves.
+ */
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ /*
+ * Step 1: compute size and borderwidth of master, taking into
+ * account desired border mode.
+ */
+
+ masterBW = 0;
+ masterWidth = Tk_Width(masterPtr->tkwin);
+ masterHeight = Tk_Height(masterPtr->tkwin);
+ if (slavePtr->borderMode == BM_INSIDE) {
+ masterBW = Tk_InternalBorderWidth(masterPtr->tkwin);
+ } else if (slavePtr->borderMode == BM_OUTSIDE) {
+ masterBW = -Tk_Changes(masterPtr->tkwin)->border_width;
+ }
+ masterWidth -= 2*masterBW;
+ masterHeight -= 2*masterBW;
+
+ /*
+ * Step 2: compute size of slave (outside dimensions including
+ * border) and location of anchor point within master.
+ */
+
+ x1 = slavePtr->x + masterBW + (slavePtr->relX*masterWidth);
+ x = (int) (x1 + ((x1 > 0) ? 0.5 : -0.5));
+ y1 = slavePtr->y + masterBW + (slavePtr->relY*masterHeight);
+ y = (int) (y1 + ((y1 > 0) ? 0.5 : -0.5));
+ if (slavePtr->flags & (CHILD_WIDTH|CHILD_REL_WIDTH)) {
+ width = 0;
+ if (slavePtr->flags & CHILD_WIDTH) {
+ width += slavePtr->width;
+ }
+ if (slavePtr->flags & CHILD_REL_WIDTH) {
+ /*
+ * The code below is a bit tricky. In order to round
+ * correctly when both relX and relWidth are specified,
+ * compute the location of the right edge and round that,
+ * then compute width. If we compute the width and round
+ * it, rounding errors in relX and relWidth accumulate.
+ */
+
+ x2 = x1 + (slavePtr->relWidth*masterWidth);
+ tmp = (int) (x2 + ((x2 > 0) ? 0.5 : -0.5));
+ width += tmp - x;
+ }
+ } else {
+ width = Tk_ReqWidth(slavePtr->tkwin)
+ + 2*Tk_Changes(slavePtr->tkwin)->border_width;
+ }
+ if (slavePtr->flags & (CHILD_HEIGHT|CHILD_REL_HEIGHT)) {
+ height = 0;
+ if (slavePtr->flags & CHILD_HEIGHT) {
+ height += slavePtr->height;
+ }
+ if (slavePtr->flags & CHILD_REL_HEIGHT) {
+ /*
+ * See note above for rounding errors in width computation.
+ */
+
+ y2 = y1 + (slavePtr->relHeight*masterHeight);
+ tmp = (int) (y2 + ((y2 > 0) ? 0.5 : -0.5));
+ height += tmp - y;
+ }
+ } else {
+ height = Tk_ReqHeight(slavePtr->tkwin)
+ + 2*Tk_Changes(slavePtr->tkwin)->border_width;
+ }
+
+ /*
+ * Step 3: adjust the x and y positions so that the desired
+ * anchor point on the slave appears at that position. Also
+ * adjust for the border mode and master's border.
+ */
+
+ switch (slavePtr->anchor) {
+ case TK_ANCHOR_N:
+ x -= width/2;
+ break;
+ case TK_ANCHOR_NE:
+ x -= width;
+ break;
+ case TK_ANCHOR_E:
+ x -= width;
+ y -= height/2;
+ break;
+ case TK_ANCHOR_SE:
+ x -= width;
+ y -= height;
+ break;
+ case TK_ANCHOR_S:
+ x -= width/2;
+ y -= height;
+ break;
+ case TK_ANCHOR_SW:
+ y -= height;
+ break;
+ case TK_ANCHOR_W:
+ y -= height/2;
+ break;
+ case TK_ANCHOR_NW:
+ break;
+ case TK_ANCHOR_CENTER:
+ x -= width/2;
+ y -= height/2;
+ break;
+ }
+
+ /*
+ * Step 4: adjust width and height again to reflect inside dimensions
+ * of window rather than outside. Also make sure that the width and
+ * height aren't zero.
+ */
+
+ width -= 2*Tk_Changes(slavePtr->tkwin)->border_width;
+ height -= 2*Tk_Changes(slavePtr->tkwin)->border_width;
+ if (width <= 0) {
+ width = 1;
+ }
+ if (height <= 0) {
+ height = 1;
+ }
+
+ /*
+ * Step 5: reconfigure the window and map it if needed. If the
+ * slave is a child of the master, we do this ourselves. If the
+ * slave isn't a child of the master, let Tk_MaintainWindow do
+ * the work (it will re-adjust things as relevant windows map,
+ * unmap, and move).
+ */
+
+ if (masterPtr->tkwin == Tk_Parent(slavePtr->tkwin)) {
+ if ((x != Tk_X(slavePtr->tkwin))
+ || (y != Tk_Y(slavePtr->tkwin))
+ || (width != Tk_Width(slavePtr->tkwin))
+ || (height != Tk_Height(slavePtr->tkwin))) {
+ Tk_MoveResizeWindow(slavePtr->tkwin, x, y, width, height);
+ }
+
+ /*
+ * Don't map the slave unless the master is mapped: the slave
+ * will get mapped later, when the master is mapped.
+ */
+
+ if (Tk_IsMapped(masterPtr->tkwin)) {
+ Tk_MapWindow(slavePtr->tkwin);
+ }
+ } else {
+ if ((width <= 0) || (height <= 0)) {
+ Tk_UnmaintainGeometry(slavePtr->tkwin, masterPtr->tkwin);
+ Tk_UnmapWindow(slavePtr->tkwin);
+ } else {
+ Tk_MaintainGeometry(slavePtr->tkwin, masterPtr->tkwin,
+ x, y, width, height);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MasterStructureProc --
+ *
+ * This procedure is invoked by the Tk event handler when
+ * StructureNotify events occur for a master window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Structures get cleaned up if the window was deleted. If the
+ * window was resized then slave geometries get recomputed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+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) {
+ /*
+ * When a master gets mapped, must redo the geometry computation
+ * so that all of its slaves get remapped.
+ */
+
+ if ((masterPtr->slavePtr != NULL)
+ && !(masterPtr->flags & PARENT_RECONFIG_PENDING)) {
+ masterPtr->flags |= PARENT_RECONFIG_PENDING;
+ Tcl_DoWhenIdle(RecomputePlacement, (ClientData) masterPtr);
+ }
+ } else if (eventPtr->type == UnmapNotify) {
+ /*
+ * Unmap all of the slaves when the master gets unmapped,
+ * so that they don't keep redisplaying themselves.
+ */
+
+ for (slavePtr = masterPtr->slavePtr; slavePtr != NULL;
+ slavePtr = slavePtr->nextPtr) {
+ Tk_UnmapWindow(slavePtr->tkwin);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SlaveStructureProc --
+ *
+ * This procedure is invoked by the Tk event handler when
+ * StructureNotify events occur for a slave window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Structures get cleaned up if the window was deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PlaceRequestProc --
+ *
+ * This procedure is invoked by Tk whenever a slave managed by us
+ * changes its requested geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window will get relayed out, if its requested size has
+ * anything to do with its actual size.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+PlaceRequestProc(clientData, tkwin)
+ ClientData clientData; /* Pointer to our record for slave. */
+ Tk_Window tkwin; /* Window that changed its desired
+ * size. */
+{
+ Slave *slavePtr = (Slave *) clientData;
+ Master *masterPtr;
+
+ if (((slavePtr->flags & (CHILD_WIDTH|CHILD_REL_WIDTH)) != 0)
+ && ((slavePtr->flags & (CHILD_HEIGHT|CHILD_REL_HEIGHT)) != 0)) {
+ return;
+ }
+ masterPtr = slavePtr->masterPtr;
+ if (masterPtr == NULL) {
+ return;
+ }
+ if (!(masterPtr->flags & PARENT_RECONFIG_PENDING)) {
+ masterPtr->flags |= PARENT_RECONFIG_PENDING;
+ Tcl_DoWhenIdle(RecomputePlacement, (ClientData) masterPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * PlaceLostSlaveProc --
+ *
+ * This procedure is invoked by Tk whenever some other geometry
+ * claims control over a slave that used to be managed by us.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Forgets all placer-related information about the slave.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+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);
+}
diff --git a/tk/generic/tkPointer.c b/tk/generic/tkPointer.c
new file mode 100644
index 00000000000..85a6af87811
--- /dev/null
+++ b/tk/generic/tkPointer.c
@@ -0,0 +1,623 @@
+/*
+ * 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$
+ */
+
+#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));
+static void InitializeEvent _ANSI_ARGS_((XEvent* eventPtr,
+ TkWindow *winPtr, int type, int x, int y,
+ int state, int detail));
+static void UpdateCursor _ANSI_ARGS_((TkWindow *winPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitializeEvent --
+ *
+ * Initializes the common fields for several X events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Fills in the specified event structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitializeEvent(eventPtr, winPtr, type, x, y, state, detail)
+ XEvent* eventPtr; /* Event structure to initialize. */
+ TkWindow *winPtr; /* Window to make event relative to. */
+ int type; /* Message type. */
+ int x, y; /* Root coords of event. */
+ int state; /* State flags. */
+ int detail; /* Detail value. */
+{
+ eventPtr->type = type;
+ eventPtr->xany.serial = LastKnownRequestProcessed(winPtr->display);
+ eventPtr->xany.send_event = False;
+ eventPtr->xany.display = winPtr->display;
+
+ eventPtr->xcrossing.root = RootWindow(winPtr->display, winPtr->screenNum);
+ eventPtr->xcrossing.time = TkpGetMS();
+ eventPtr->xcrossing.x_root = x;
+ eventPtr->xcrossing.y_root = y;
+
+ switch (type) {
+ case EnterNotify:
+ case LeaveNotify:
+ eventPtr->xcrossing.mode = NotifyNormal;
+ eventPtr->xcrossing.state = state;
+ eventPtr->xcrossing.detail = detail;
+ eventPtr->xcrossing.focus = False;
+ break;
+ case MotionNotify:
+ eventPtr->xmotion.state = state;
+ eventPtr->xmotion.is_hint = detail;
+ break;
+ case ButtonPress:
+ case ButtonRelease:
+ eventPtr->xbutton.state = state;
+ eventPtr->xbutton.button = detail;
+ break;
+ }
+ TkChangeEventWindow(eventPtr, winPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateEnterLeave --
+ *
+ * Update the current mouse window and position, and generate
+ * any enter/leave events that are needed.
+ *
+ * Results:
+ * Returns 1 if enter/leave events were generated.
+ *
+ * Side effects:
+ * May insert events into the Tk event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+
+ /*
+ * Check if the mouse crossed into or out of the restrict
+ * window. If so, we need to generate an Enter or Leave event.
+ */
+
+ if ((newPos != oldPos) && ((newPos == TK_GRAB_IN_TREE)
+ || (oldPos == TK_GRAB_IN_TREE))) {
+ XEvent event;
+ int type, detail;
+
+ if (newPos == TK_GRAB_IN_TREE) {
+ type = EnterNotify;
+ } else {
+ type = LeaveNotify;
+ }
+ if ((oldPos == TK_GRAB_ANCESTOR)
+ || (newPos == TK_GRAB_ANCESTOR)) {
+ detail = NotifyAncestor;
+ } else {
+ detail = NotifyVirtual;
+ }
+ InitializeEvent(&event, restrictWinPtr, type, x, y,
+ state, detail);
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ }
+
+ } else {
+ TkWindow *targetPtr;
+
+ if ((lastWinPtr == NULL)
+ || (lastWinPtr->window == None)) {
+ targetPtr = winPtr;
+ } else {
+ targetPtr = lastWinPtr;
+ }
+
+ if (targetPtr && (targetPtr->window != None)) {
+ XEvent event;
+
+ /*
+ * Generate appropriate Enter/Leave events.
+ */
+
+ InitializeEvent(&event, targetPtr, LeaveNotify, x, y, state,
+ NotifyNormal);
+
+ TkInOutEvents(&event, lastWinPtr, winPtr, LeaveNotify,
+ EnterNotify, TCL_QUEUE_TAIL);
+ crossed = 1;
+ }
+ }
+ lastWinPtr = winPtr;
+ }
+
+ return crossed;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_UpdatePointer --
+ *
+ * This function updates the pointer state machine given an
+ * the current window, position and modifier state.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May queue new events and update the grab state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 --
+ *
+ * Capture the mouse so event are reported outside of toplevels.
+ * Note that this is a very limited implementation that only
+ * supports GrabModeAsync and owner_events True.
+ *
+ * Results:
+ * Always returns GrabSuccess.
+ *
+ * Side effects:
+ * Turns on mouse capture, sets the global grab pointer, and
+ * clears any window restrictions.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+XGrabPointer(display, grab_window, owner_events, event_mask, pointer_mode,
+ keyboard_mode, confine_to, cursor, time)
+ 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;
+{
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XUngrabPointer --
+ *
+ * Release the current grab.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Releases the mouse capture.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XUngrabPointer(display, time)
+ Display* display;
+ Time time;
+{
+ display->request++;
+ grabWinPtr = NULL;
+ restrictWinPtr = NULL;
+ TkpSetCapture(NULL);
+ UpdateCursor(lastWinPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPointerDeadWindow --
+ *
+ * Clean up pointer module state when a window is destroyed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May release the current capture window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateCursor --
+ *
+ * Set the windows global cursor to the cursor associated with
+ * the given Tk window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the mouse cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ }
+ winPtr = winPtr->parentPtr;
+ }
+ TkpSetCursor((TkpCursor) cursor);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XDefineCursor --
+ *
+ * This function is called to update the cursor on a window.
+ * Since the mouse might be in the specified window, we need to
+ * check the specified window against the current mouse position
+ * and grab state.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May update the cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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++;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGenerateActivateEvents --
+ *
+ * This function is called by the Mac and Windows window manager
+ * routines when a toplevel window is activated or deactivated.
+ * Activate/Deactivate events will be sent to every subwindow of
+ * the toplevel followed by a FocusIn/FocusOut message.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates X events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkGenerateActivateEvents(winPtr, active)
+ TkWindow *winPtr; /* Toplevel to activate. */
+ int active; /* Non-zero if the window is being
+ * activated, else 0.*/
+{
+ XEvent event;
+
+ /*
+ * Generate Activate and Deactivate events. This event
+ * is sent to every subwindow in a toplevel window.
+ */
+
+ event.xany.serial = winPtr->display->request++;
+ event.xany.send_event = False;
+ event.xany.display = winPtr->display;
+ event.xany.window = winPtr->window;
+
+ event.xany.type = active ? ActivateNotify : DeactivateNotify;
+ TkQueueEventForAllChildren(winPtr, &event);
+
+}
diff --git a/tk/generic/tkPort.h b/tk/generic/tkPort.h
new file mode 100644
index 00000000000..ab9f28b15f8
--- /dev/null
+++ b/tk/generic/tkPort.h
@@ -0,0 +1,36 @@
+/*
+ * 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$
+ */
+
+#ifndef _TKPORT
+#define _TKPORT
+
+#ifndef _TK
+#include "tk.h"
+#endif
+#ifndef _TCL
+#include "tcl.h"
+#endif
+
+#if defined(__WIN32__) || defined(_WIN32)
+# include "tkWinPort.h"
+#else
+# if defined(MAC_TCL)
+# include "tkMacPort.h"
+# else
+# include "../unix/tkUnixPort.h"
+# endif
+#endif
+
+#endif /* _TKPORT */
diff --git a/tk/generic/tkRectOval.c b/tk/generic/tkRectOval.c
new file mode 100644
index 00000000000..daa39dafbdf
--- /dev/null
+++ b/tk/generic/tkRectOval.c
@@ -0,0 +1,1032 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include "tk.h"
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * The structure below defines the record for each rectangle/oval item.
+ */
+
+typedef struct RectOvalItem {
+ Tk_Item header; /* Generic stuff that's the same for all
+ * types. MUST BE FIRST IN STRUCTURE. */
+ double bbox[4]; /* Coordinates of bounding box for rectangle
+ * or oval (x1, y1, x2, y2). Item includes
+ * x1 and x2 but not y1 and y2. */
+ int width; /* Width of outline. */
+ XColor *outlineColor; /* Color for outline. */
+ XColor *fillColor; /* Color for filling rectangle/oval. */
+ Pixmap fillStipple; /* Stipple bitmap for filling item. */
+ GC outlineGC; /* Graphics context for outline. */
+ GC fillGC; /* Graphics context for filling item. */
+} RectOvalItem;
+
+/*
+ * Information used for parsing configuration specs:
+ */
+
+static Tk_CustomOption tagsOption = {Tk_CanvasTagsParseProc,
+ Tk_CanvasTagsPrintProc, (ClientData) NULL
+};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_COLOR, "-fill", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(RectOvalItem, fillColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-outline", (char *) NULL, (char *) NULL,
+ "black", Tk_Offset(RectOvalItem, outlineColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-stipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(RectOvalItem, fillStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_CUSTOM, "-tags", (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, TK_CONFIG_NULL_OK, &tagsOption},
+ {TK_CONFIG_PIXELS, "-width", (char *) NULL, (char *) NULL,
+ "1", Tk_Offset(RectOvalItem, width), TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static void ComputeRectOvalBbox _ANSI_ARGS_((Tk_Canvas canvas,
+ RectOvalItem *rectOvalPtr));
+static int ConfigureRectOval _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv, int flags));
+static int CreateRectOval _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, struct Tk_Item *itemPtr,
+ int argc, char **argv));
+static void DeleteRectOval _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display));
+static void DisplayRectOval _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, Display *display, Drawable dst,
+ int x, int y, int width, int height));
+static int OvalToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *areaPtr));
+static double OvalToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr));
+static int RectOvalCoords _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int argc,
+ char **argv));
+static int RectOvalToPostscript _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Canvas canvas, Tk_Item *itemPtr, int prepass));
+static int RectToArea _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *areaPtr));
+static double RectToPoint _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double *pointPtr));
+static void ScaleRectOval _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double originX, double originY,
+ double scaleX, double scaleY));
+static void TranslateRectOval _ANSI_ARGS_((Tk_Canvas canvas,
+ Tk_Item *itemPtr, double deltaX, double deltaY));
+
+/*
+ * The structures below defines the rectangle and oval item types
+ * by means of procedures that can be invoked by generic item code.
+ */
+
+Tk_ItemType tkRectangleType = {
+ "rectangle", /* name */
+ sizeof(RectOvalItem), /* itemSize */
+ CreateRectOval, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureRectOval, /* configureProc */
+ RectOvalCoords, /* coordProc */
+ DeleteRectOval, /* deleteProc */
+ DisplayRectOval, /* displayProc */
+ 0, /* alwaysRedraw */
+ RectToPoint, /* pointProc */
+ RectToArea, /* areaProc */
+ RectOvalToPostscript, /* postscriptProc */
+ ScaleRectOval, /* scaleProc */
+ TranslateRectOval, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* icursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) NULL, /* insertProc */
+ (Tk_ItemDCharsProc *) NULL, /* dTextProc */
+ (Tk_ItemType *) NULL /* nextPtr */
+};
+
+Tk_ItemType tkOvalType = {
+ "oval", /* name */
+ sizeof(RectOvalItem), /* itemSize */
+ CreateRectOval, /* createProc */
+ configSpecs, /* configSpecs */
+ ConfigureRectOval, /* configureProc */
+ RectOvalCoords, /* coordProc */
+ DeleteRectOval, /* deleteProc */
+ DisplayRectOval, /* displayProc */
+ 0, /* alwaysRedraw */
+ OvalToPoint, /* pointProc */
+ OvalToArea, /* areaProc */
+ RectOvalToPostscript, /* postscriptProc */
+ ScaleRectOval, /* scaleProc */
+ TranslateRectOval, /* translateProc */
+ (Tk_ItemIndexProc *) NULL, /* indexProc */
+ (Tk_ItemCursorProc *) NULL, /* cursorProc */
+ (Tk_ItemSelectionProc *) NULL, /* selectionProc */
+ (Tk_ItemInsertProc *) NULL, /* insertProc */
+ (Tk_ItemDCharsProc *) NULL, /* dTextProc */
+ (Tk_ItemType *) NULL /* nextPtr */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CreateRectOval --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CreateRectOval(interp, canvas, itemPtr, argc, argv)
+ Tcl_Interp *interp; /* 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. */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+
+ if (argc < 4) {
+ 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.
+ */
+
+ rectOvalPtr->width = 1;
+ rectOvalPtr->outlineColor = NULL;
+ rectOvalPtr->fillColor = NULL;
+ rectOvalPtr->fillStipple = None;
+ rectOvalPtr->outlineGC = None;
+ rectOvalPtr->fillGC = None;
+
+ /*
+ * Process the arguments to fill in the item record.
+ */
+
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0],
+ &rectOvalPtr->bbox[0]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1],
+ &rectOvalPtr->bbox[1]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[2],
+ &rectOvalPtr->bbox[2]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[3],
+ &rectOvalPtr->bbox[3]) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+
+ if (ConfigureRectOval(interp, canvas, itemPtr, argc-4, argv+4, 0)
+ != TCL_OK) {
+ DeleteRectOval(canvas, itemPtr, Tk_Display(Tk_CanvasTkwin(canvas)));
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+RectOvalCoords(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, ... */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+ char c0[TCL_DOUBLE_SPACE], c1[TCL_DOUBLE_SPACE];
+ char c2[TCL_DOUBLE_SPACE], c3[TCL_DOUBLE_SPACE];
+
+ if (argc == 0) {
+ Tcl_PrintDouble(interp, rectOvalPtr->bbox[0], c0);
+ Tcl_PrintDouble(interp, rectOvalPtr->bbox[1], c1);
+ Tcl_PrintDouble(interp, rectOvalPtr->bbox[2], c2);
+ Tcl_PrintDouble(interp, rectOvalPtr->bbox[3], c3);
+ Tcl_AppendResult(interp, c0, " ", c1, " ", c2, " ", c3,
+ (char *) NULL);
+ } else if (argc == 4) {
+ if ((Tk_CanvasGetCoord(interp, canvas, argv[0],
+ &rectOvalPtr->bbox[0]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[1],
+ &rectOvalPtr->bbox[1]) != TCL_OK)
+ || (Tk_CanvasGetCoord(interp, canvas, argv[2],
+ &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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ConfigureRectOval(interp, canvas, itemPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Canvas canvas; /* Canvas containing itemPtr. */
+ Tk_Item *itemPtr; /* Rectangle item to reconfigure. */
+ int argc; /* Number of elements in argv. */
+ char **argv; /* Arguments describing things to configure. */
+ int flags; /* Flags to pass to Tk_ConfigureWidget. */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+ XGCValues gcValues;
+ GC newGC;
+ unsigned long mask;
+ Tk_Window tkwin;
+
+ tkwin = Tk_CanvasTkwin(canvas);
+ if (Tk_ConfigureWidget(interp, tkwin, configSpecs, argc, argv,
+ (char *) rectOvalPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few of the options require additional processing, such as
+ * graphics contexts.
+ */
+
+ if (rectOvalPtr->width < 1) {
+ rectOvalPtr->width = 1;
+ }
+ if (rectOvalPtr->outlineColor == NULL) {
+ newGC = None;
+ } else {
+ gcValues.foreground = rectOvalPtr->outlineColor->pixel;
+ gcValues.cap_style = CapProjecting;
+ gcValues.line_width = rectOvalPtr->width;
+ mask = GCForeground|GCCapStyle|GCLineWidth;
+ newGC = Tk_GetGCColor(tkwin, mask, &gcValues,
+ rectOvalPtr->outlineColor, NULL);
+ }
+ if (rectOvalPtr->outlineGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), rectOvalPtr->outlineGC);
+ }
+ rectOvalPtr->outlineGC = newGC;
+
+ if (rectOvalPtr->fillColor == NULL) {
+ newGC = None;
+ } else {
+ gcValues.foreground = rectOvalPtr->fillColor->pixel;
+ if (rectOvalPtr->fillStipple != None) {
+ gcValues.stipple = rectOvalPtr->fillStipple;
+ gcValues.fill_style = FillStippled;
+ mask = GCForeground|GCStipple|GCFillStyle;
+ } else {
+ mask = GCForeground;
+ }
+ newGC = Tk_GetGCColor(tkwin, mask, &gcValues, rectOvalPtr->fillColor,
+ NULL);
+ }
+ if (rectOvalPtr->fillGC != None) {
+ Tk_FreeGC(Tk_Display(tkwin), rectOvalPtr->fillGC);
+ }
+ rectOvalPtr->fillGC = newGC;
+ ComputeRectOvalBbox(canvas, rectOvalPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteRectOval --
+ *
+ * This procedure is called to clean up the data structure
+ * associated with a rectangle or oval item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resources associated with itemPtr are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DeleteRectOval(canvas, itemPtr, display)
+ Tk_Canvas canvas; /* Info about overall widget. */
+ Tk_Item *itemPtr; /* Item that is being deleted. */
+ Display *display; /* Display containing window for
+ * canvas. */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+
+ if (rectOvalPtr->outlineColor != NULL) {
+ Tk_FreeColor(rectOvalPtr->outlineColor);
+ }
+ if (rectOvalPtr->fillColor != NULL) {
+ Tk_FreeColor(rectOvalPtr->fillColor);
+ }
+ if (rectOvalPtr->fillStipple != None) {
+ Tk_FreeBitmap(display, rectOvalPtr->fillStipple);
+ }
+ if (rectOvalPtr->outlineGC != None) {
+ Tk_FreeGC(display, rectOvalPtr->outlineGC);
+ }
+ if (rectOvalPtr->fillGC != None) {
+ Tk_FreeGC(display, rectOvalPtr->fillGC);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ComputeRectOvalBbox --
+ *
+ * This procedure is invoked to compute the bounding box of
+ * all the pixels that may be drawn as part of a rectangle
+ * or oval.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The fields x1, y1, x2, and y2 are updated in the header
+ * for itemPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+ComputeRectOvalBbox(canvas, rectOvalPtr)
+ Tk_Canvas canvas; /* Canvas that contains item. */
+ RectOvalItem *rectOvalPtr; /* Item whose bbox is to be
+ * recomputed. */
+{
+ int bloat, tmp;
+ double dtmp;
+
+ /*
+ * Make sure that the first coordinates are the lowest ones.
+ */
+
+ if (rectOvalPtr->bbox[1] > rectOvalPtr->bbox[3]) {
+ double tmp;
+ tmp = rectOvalPtr->bbox[3];
+ rectOvalPtr->bbox[3] = rectOvalPtr->bbox[1];
+ rectOvalPtr->bbox[1] = tmp;
+ }
+ if (rectOvalPtr->bbox[0] > rectOvalPtr->bbox[2]) {
+ double tmp;
+ tmp = rectOvalPtr->bbox[2];
+ rectOvalPtr->bbox[2] = rectOvalPtr->bbox[0];
+ rectOvalPtr->bbox[0] = tmp;
+ }
+
+ if (rectOvalPtr->outlineColor == NULL) {
+ bloat = 0;
+ } else {
+ bloat = (rectOvalPtr->width+1)/2;
+ }
+
+ /*
+ * Special note: the rectangle is always drawn at least 1x1 in
+ * size, so round up the upper coordinates to be at least 1 unit
+ * greater than the lower ones.
+ */
+
+ tmp = (int) ((rectOvalPtr->bbox[0] >= 0) ? rectOvalPtr->bbox[0] + .5
+ : rectOvalPtr->bbox[0] - .5);
+ rectOvalPtr->header.x1 = tmp - bloat;
+ tmp = (int) ((rectOvalPtr->bbox[1] >= 0) ? rectOvalPtr->bbox[1] + .5
+ : rectOvalPtr->bbox[1] - .5);
+ rectOvalPtr->header.y1 = tmp - bloat;
+ dtmp = rectOvalPtr->bbox[2];
+ if (dtmp < (rectOvalPtr->bbox[0] + 1)) {
+ dtmp = rectOvalPtr->bbox[0] + 1;
+ }
+ tmp = (int) ((dtmp >= 0) ? dtmp + .5 : dtmp - .5);
+ rectOvalPtr->header.x2 = tmp + bloat;
+ dtmp = rectOvalPtr->bbox[3];
+ if (dtmp < (rectOvalPtr->bbox[1] + 1)) {
+ dtmp = rectOvalPtr->bbox[1] + 1;
+ }
+ tmp = (int) ((dtmp >= 0) ? dtmp + .5 : dtmp - .5);
+ rectOvalPtr->header.y2 = tmp + bloat;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayRectOval --
+ *
+ * This procedure is invoked to draw a rectangle or oval
+ * item in a given drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * ItemPtr is drawn in drawable using the transformation
+ * information in canvas.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayRectOval(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). */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+ short x1, y1, x2, y2;
+
+ /*
+ * Compute the screen coordinates of the bounding box for the item.
+ * Make sure that the bbox is at least one pixel large, since some
+ * X servers will die if it isn't.
+ */
+
+ Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[0], rectOvalPtr->bbox[1],
+ &x1, &y1);
+ Tk_CanvasDrawableCoords(canvas, rectOvalPtr->bbox[2], rectOvalPtr->bbox[3],
+ &x2, &y2);
+ if (x2 <= x1) {
+ x2 = x1+1;
+ }
+ if (y2 <= y1) {
+ y2 = y1+1;
+ }
+
+ /*
+ * Display filled part first (if wanted), then outline. 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 (rectOvalPtr->fillGC != None) {
+ if (rectOvalPtr->fillStipple != None) {
+ Tk_CanvasSetStippleOrigin(canvas, rectOvalPtr->fillGC);
+ }
+ if (rectOvalPtr->header.typePtr == &tkRectangleType) {
+ XFillRectangle(display, drawable, rectOvalPtr->fillGC,
+ x1, y1, (unsigned int) (x2-x1), (unsigned int) (y2-y1));
+ } else {
+ XFillArc(display, drawable, rectOvalPtr->fillGC,
+ x1, y1, (unsigned) (x2-x1), (unsigned) (y2-y1),
+ 0, 360*64);
+ }
+ if (rectOvalPtr->fillStipple != None) {
+ XSetTSOrigin(display, rectOvalPtr->fillGC, 0, 0);
+ }
+ }
+ if (rectOvalPtr->outlineGC != None) {
+ if (rectOvalPtr->header.typePtr == &tkRectangleType) {
+ XDrawRectangle(display, drawable, rectOvalPtr->outlineGC,
+ x1, y1, (unsigned) (x2-x1), (unsigned) (y2-y1));
+ } else {
+ XDrawArc(display, drawable, rectOvalPtr->outlineGC,
+ x1, y1, (unsigned) (x2-x1), (unsigned) (y2-y1), 0, 360*64);
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RectToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * rectangle, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are coordPtr[0] and coordPtr[1] is inside the rectangle. If the
+ * point isn't inside the rectangle then the return value is the
+ * distance from the point to the rectangle. If itemPtr is filled,
+ * then anywhere in the interior is considered "inside"; if
+ * itemPtr isn't filled, then "inside" means only the area
+ * occupied by the outline.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+RectToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ RectOvalItem *rectPtr = (RectOvalItem *) itemPtr;
+ double xDiff, yDiff, x1, y1, x2, y2, inc, tmp;
+
+ /*
+ * Generate a new larger rectangle that includes the border
+ * width, if there is one.
+ */
+
+ x1 = rectPtr->bbox[0];
+ y1 = rectPtr->bbox[1];
+ x2 = rectPtr->bbox[2];
+ y2 = rectPtr->bbox[3];
+ if (rectPtr->outlineGC != None) {
+ inc = rectPtr->width/2.0;
+ x1 -= inc;
+ y1 -= inc;
+ x2 += inc;
+ y2 += inc;
+ }
+
+ /*
+ * If the point is inside the rectangle, handle specially:
+ * distance is 0 if rectangle is filled, otherwise compute
+ * distance to nearest edge of rectangle and subtract width
+ * of edge.
+ */
+
+ if ((pointPtr[0] >= x1) && (pointPtr[0] < x2)
+ && (pointPtr[1] >= y1) && (pointPtr[1] < y2)) {
+ if ((rectPtr->fillGC != None) || (rectPtr->outlineGC == None)) {
+ return 0.0;
+ }
+ xDiff = pointPtr[0] - x1;
+ tmp = x2 - pointPtr[0];
+ if (tmp < xDiff) {
+ xDiff = tmp;
+ }
+ yDiff = pointPtr[1] - y1;
+ tmp = y2 - pointPtr[1];
+ if (tmp < yDiff) {
+ yDiff = tmp;
+ }
+ if (yDiff < xDiff) {
+ xDiff = yDiff;
+ }
+ xDiff -= rectPtr->width;
+ if (xDiff < 0.0) {
+ return 0.0;
+ }
+ return xDiff;
+ }
+
+ /*
+ * Point is outside rectangle.
+ */
+
+ if (pointPtr[0] < x1) {
+ xDiff = x1 - pointPtr[0];
+ } else if (pointPtr[0] > x2) {
+ xDiff = pointPtr[0] - x2;
+ } else {
+ xDiff = 0;
+ }
+
+ if (pointPtr[1] < y1) {
+ yDiff = y1 - pointPtr[1];
+ } else if (pointPtr[1] > y2) {
+ yDiff = pointPtr[1] - y2;
+ } else {
+ yDiff = 0;
+ }
+
+ return hypot(xDiff, yDiff);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * OvalToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * oval, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point whose x and y coordinates
+ * are coordPtr[0] and coordPtr[1] is inside the oval. If the
+ * point isn't inside the oval then the return value is the
+ * distance from the point to the oval. If itemPtr is filled,
+ * then anywhere in the interior is considered "inside"; if
+ * itemPtr isn't filled, then "inside" means only the area
+ * occupied by the outline.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static double
+OvalToPoint(canvas, itemPtr, pointPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against point. */
+ double *pointPtr; /* Pointer to x and y coordinates. */
+{
+ RectOvalItem *ovalPtr = (RectOvalItem *) itemPtr;
+ double width;
+ int filled;
+
+ width = ovalPtr->width;
+ filled = ovalPtr->fillGC != None;
+ if (ovalPtr->outlineGC == None) {
+ width = 0.0;
+ filled = 1;
+ }
+ return TkOvalToPoint(ovalPtr->bbox, width, filled, pointPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RectToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangle.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+RectToArea(canvas, itemPtr, areaPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against rectangle. */
+ double *areaPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ RectOvalItem *rectPtr = (RectOvalItem *) itemPtr;
+ double halfWidth;
+
+ halfWidth = rectPtr->width/2.0;
+ if (rectPtr->outlineGC == None) {
+ halfWidth = 0.0;
+ }
+
+ if ((areaPtr[2] <= (rectPtr->bbox[0] - halfWidth))
+ || (areaPtr[0] >= (rectPtr->bbox[2] + halfWidth))
+ || (areaPtr[3] <= (rectPtr->bbox[1] - halfWidth))
+ || (areaPtr[1] >= (rectPtr->bbox[3] + halfWidth))) {
+ return -1;
+ }
+ if ((rectPtr->fillGC == None) && (rectPtr->outlineGC != None)
+ && (areaPtr[0] >= (rectPtr->bbox[0] + halfWidth))
+ && (areaPtr[1] >= (rectPtr->bbox[1] + halfWidth))
+ && (areaPtr[2] <= (rectPtr->bbox[2] - halfWidth))
+ && (areaPtr[3] <= (rectPtr->bbox[3] - halfWidth))) {
+ return -1;
+ }
+ if ((areaPtr[0] <= (rectPtr->bbox[0] - halfWidth))
+ && (areaPtr[1] <= (rectPtr->bbox[1] - halfWidth))
+ && (areaPtr[2] >= (rectPtr->bbox[2] + halfWidth))
+ && (areaPtr[3] >= (rectPtr->bbox[3] + halfWidth))) {
+ return 1;
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * OvalToArea --
+ *
+ * This procedure is called to determine whether an item
+ * lies entirely inside, entirely outside, or overlapping
+ * a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the item is entirely outside the area
+ * given by rectPtr, 0 if it overlaps, and 1 if it is entirely
+ * inside the given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+OvalToArea(canvas, itemPtr, areaPtr)
+ Tk_Canvas canvas; /* Canvas containing item. */
+ Tk_Item *itemPtr; /* Item to check against oval. */
+ double *areaPtr; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) describing rectangular
+ * area. */
+{
+ RectOvalItem *ovalPtr = (RectOvalItem *) itemPtr;
+ double oval[4], halfWidth;
+ int result;
+
+ /*
+ * Expand the oval to include the width of the outline, if any.
+ */
+
+ halfWidth = ovalPtr->width/2.0;
+ if (ovalPtr->outlineGC == None) {
+ halfWidth = 0.0;
+ }
+ oval[0] = ovalPtr->bbox[0] - halfWidth;
+ oval[1] = ovalPtr->bbox[1] - halfWidth;
+ oval[2] = ovalPtr->bbox[2] + halfWidth;
+ oval[3] = ovalPtr->bbox[3] + halfWidth;
+
+ result = TkOvalToArea(oval, areaPtr);
+
+ /*
+ * If the rectangle appears to overlap the oval and the oval
+ * isn't filled, do one more check to see if perhaps all four
+ * of the rectangle's corners are totally inside the oval's
+ * unfilled center, in which case we should return "outside".
+ */
+
+ if ((result == 0) && (ovalPtr->outlineGC != None)
+ && (ovalPtr->fillGC == None)) {
+ double centerX, centerY, width, height;
+ double xDelta1, yDelta1, xDelta2, yDelta2;
+
+ centerX = (ovalPtr->bbox[0] + ovalPtr->bbox[2])/2.0;
+ centerY = (ovalPtr->bbox[1] + ovalPtr->bbox[3])/2.0;
+ width = (ovalPtr->bbox[2] - ovalPtr->bbox[0])/2.0 - halfWidth;
+ height = (ovalPtr->bbox[3] - ovalPtr->bbox[1])/2.0 - halfWidth;
+ xDelta1 = (areaPtr[0] - centerX)/width;
+ xDelta1 *= xDelta1;
+ yDelta1 = (areaPtr[1] - centerY)/height;
+ yDelta1 *= yDelta1;
+ xDelta2 = (areaPtr[2] - centerX)/width;
+ xDelta2 *= xDelta2;
+ yDelta2 = (areaPtr[3] - centerY)/height;
+ yDelta2 *= yDelta2;
+ if (((xDelta1 + yDelta1) < 1.0)
+ && ((xDelta1 + yDelta2) < 1.0)
+ && ((xDelta2 + yDelta1) < 1.0)
+ && ((xDelta2 + yDelta2) < 1.0)) {
+ return -1;
+ }
+ }
+ return result;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleRectOval --
+ *
+ * This procedure is invoked to rescale a rectangle or oval
+ * item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The rectangle or oval referred to by itemPtr is rescaled
+ * so that the following transformation is applied to all
+ * point coordinates:
+ * x' = originX + scaleX*(x-originX)
+ * y' = originY + scaleY*(y-originY)
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleRectOval(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. */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+
+ rectOvalPtr->bbox[0] = originX + scaleX*(rectOvalPtr->bbox[0] - originX);
+ rectOvalPtr->bbox[1] = originY + scaleY*(rectOvalPtr->bbox[1] - originY);
+ rectOvalPtr->bbox[2] = originX + scaleX*(rectOvalPtr->bbox[2] - originX);
+ rectOvalPtr->bbox[3] = originY + scaleY*(rectOvalPtr->bbox[3] - originY);
+ ComputeRectOvalBbox(canvas, rectOvalPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TranslateRectOval --
+ *
+ * This procedure is called to move a rectangle or oval by a
+ * given amount.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The position of the rectangle or oval is offset by
+ * (xDelta, yDelta), and the bounding box is updated in the
+ * generic part of the item structure.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TranslateRectOval(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. */
+{
+ RectOvalItem *rectOvalPtr = (RectOvalItem *) itemPtr;
+
+ rectOvalPtr->bbox[0] += deltaX;
+ rectOvalPtr->bbox[1] += deltaY;
+ rectOvalPtr->bbox[2] += deltaX;
+ rectOvalPtr->bbox[3] += deltaY;
+ ComputeRectOvalBbox(canvas, rectOvalPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * RectOvalToPostscript --
+ *
+ * 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]);
+
+ /*
+ * Generate a string that creates a path for the rectangle or oval.
+ * This is the only part of the procedure's code that is type-
+ * specific.
+ */
+
+
+ if (rectOvalPtr->header.typePtr == &tkRectangleType) {
+ sprintf(pathCmd, "%.15g %.15g moveto %.15g 0 rlineto 0 %.15g rlineto %.15g 0 rlineto closepath\n",
+ rectOvalPtr->bbox[0], y1,
+ rectOvalPtr->bbox[2]-rectOvalPtr->bbox[0], y2-y1,
+ rectOvalPtr->bbox[0]-rectOvalPtr->bbox[2]);
+ } else {
+ sprintf(pathCmd, "matrix currentmatrix\n%.15g %.15g translate %.15g %.15g scale 1 0 moveto 0 0 1 0 360 arc\nsetmatrix\n",
+ (rectOvalPtr->bbox[0] + rectOvalPtr->bbox[2])/2, (y1 + y2)/2,
+ (rectOvalPtr->bbox[2] - rectOvalPtr->bbox[0])/2, (y1 - y2)/2);
+ }
+
+ /*
+ * First draw the filled area of the rectangle.
+ */
+
+ if (rectOvalPtr->fillColor != NULL) {
+ Tcl_AppendResult(interp, pathCmd, (char *) NULL);
+ if (Tk_CanvasPsColor(interp, canvas, rectOvalPtr->fillColor)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (rectOvalPtr->fillStipple != None) {
+ Tcl_AppendResult(interp, "clip ", (char *) NULL);
+ if (Tk_CanvasPsStipple(interp, canvas, rectOvalPtr->fillStipple)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (rectOvalPtr->outlineColor != NULL) {
+ Tcl_AppendResult(interp, "grestore gsave\n", (char *) NULL);
+ }
+ } else {
+ Tcl_AppendResult(interp, "fill\n", (char *) NULL);
+ }
+ }
+
+ /*
+ * 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;
+}
diff --git a/tk/generic/tkScale.c b/tk/generic/tkScale.c
new file mode 100644
index 00000000000..ea579f587d3
--- /dev/null
+++ b/tk/generic/tkScale.c
@@ -0,0 +1,1145 @@
+/*
+ * tkScale.c --
+ *
+ * This module implements a scale widgets for the Tk toolkit.
+ * A scale displays a slider that can be adjusted to change a
+ * value; it also displays numeric labels and a textual label,
+ * if desired.
+ *
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyScale --
+ *
+ * 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 scale is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyScale(memPtr)
+ char *memPtr; /* Info about scale widget. */
+{
+ register TkScale *scalePtr = (TkScale *) memPtr;
+
+ /*
+ * 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, 0);
+
+ 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 --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Scale will be relayed out and redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+ScaleWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ XGCValues gcValues;
+ GC gc;
+ TkScale *scalePtr;
+
+ scalePtr = (TkScale *) instanceData;
+
+ gcValues.foreground = scalePtr->troughColorPtr->pixel;
+ gc = Tk_GetGCColor(scalePtr->tkwin, GCForeground, &gcValues,
+ scalePtr->troughColorPtr, NULL);
+ if (scalePtr->troughGC != None) {
+ Tk_FreeGC(scalePtr->display, scalePtr->troughGC);
+ }
+ scalePtr->troughGC = gc;
+
+ gcValues.font = Tk_FontId(scalePtr->tkfont);
+ gcValues.foreground = scalePtr->textColorPtr->pixel;
+ gc = Tk_GetGCColor(scalePtr->tkwin, GCForeground | GCFont, &gcValues,
+ scalePtr->textColorPtr, NULL);
+ if (scalePtr->textGC != None) {
+ Tk_FreeGC(scalePtr->display, scalePtr->textGC);
+ }
+ scalePtr->textGC = gc;
+
+ if (scalePtr->copyGC == None) {
+ gcValues.graphics_exposures = False;
+ scalePtr->copyGC = Tk_GetGC(scalePtr->tkwin, GCGraphicsExposures,
+ &gcValues);
+ }
+ scalePtr->inset = scalePtr->highlightWidth + scalePtr->borderWidth;
+
+ /*
+ * Recompute display-related information, and let the geometry
+ * manager know how much space is needed now.
+ */
+
+ ComputeScaleGeometry(scalePtr);
+
+ TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeFormat --
+ *
+ * This procedure is invoked to recompute the "format" field
+ * of a scale's widget record, which determines how the value
+ * of the scale is converted to a string.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The format field of scalePtr is modified.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ComputeFormat(scalePtr)
+ TkScale *scalePtr; /* Information about scale widget. */
+{
+ double maxValue, x;
+ int mostSigDigit, numDigits, leastSigDigit, afterDecimal;
+ int eDigits, fDigits;
+
+ /*
+ * Compute the displacement from the decimal of the most significant
+ * digit required for any number in the scale's range.
+ */
+
+ maxValue = fabs(scalePtr->fromValue);
+ x = fabs(scalePtr->toValue);
+ if (x > maxValue) {
+ maxValue = x;
+ }
+ if (maxValue == 0) {
+ maxValue = 1;
+ }
+ mostSigDigit = (int) floor(log10(maxValue));
+
+ /*
+ * If the number of significant digits wasn't specified explicitly,
+ * compute it. It's the difference between the most significant
+ * digit needed to represent any number on the scale and the
+ * most significant digit of the smallest difference between
+ * numbers on the scale. In other words, display enough digits so
+ * that at least one digit will be different between any two adjacent
+ * positions of the scale.
+ */
+
+ numDigits = scalePtr->digits;
+ if (numDigits <= 0) {
+ if (scalePtr->resolution > 0) {
+ /*
+ * A resolution was specified for the scale, so just use it.
+ */
+
+ leastSigDigit = (int) floor(log10(scalePtr->resolution));
+ } else {
+ /*
+ * No resolution was specified, so compute the difference
+ * in value between adjacent pixels and use it for the least
+ * significant digit.
+ */
+
+ x = fabs(scalePtr->fromValue - scalePtr->toValue);
+ if (scalePtr->length > 0) {
+ x /= scalePtr->length;
+ }
+ if (x > 0){
+ leastSigDigit = (int) floor(log10(x));
+ } else {
+ leastSigDigit = 0;
+ }
+ }
+ numDigits = mostSigDigit - leastSigDigit + 1;
+ if (numDigits < 1) {
+ numDigits = 1;
+ }
+ }
+
+ /*
+ * Compute the number of characters required using "e" format and
+ * "f" format, and then choose whichever one takes fewer characters.
+ */
+
+ eDigits = numDigits + 4;
+ if (numDigits > 1) {
+ eDigits++; /* Decimal point. */
+ }
+ afterDecimal = numDigits - mostSigDigit - 1;
+ if (afterDecimal < 0) {
+ afterDecimal = 0;
+ }
+ fDigits = (mostSigDigit >= 0) ? mostSigDigit + afterDecimal : afterDecimal;
+ if (afterDecimal > 0) {
+ fDigits++; /* Decimal point. */
+ }
+ if (mostSigDigit < 0) {
+ fDigits++; /* Zero to left of decimal point. */
+ }
+ if (fDigits <= eDigits) {
+ sprintf(scalePtr->format, "%%.%df", afterDecimal);
+ } else {
+ sprintf(scalePtr->format, "%%.%de", numDigits-1);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeScaleGeometry --
+ *
+ * This procedure is called to compute various geometrical
+ * information for a scale, such as where various things get
+ * displayed. It's called when the window is reconfigured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Display-related numbers get changed in *scalePtr. The
+ * geometry manager gets told about the window's preferred size.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ }
+ if (scalePtr->showValue) {
+ scalePtr->horizValueY = y + SPACING;
+ y += fm.linespace + SPACING;
+ extraSpace = SPACING;
+ } else {
+ scalePtr->horizValueY = y;
+ }
+ y += extraSpace;
+ scalePtr->horizTroughY = y;
+ y += scalePtr->width + 2*scalePtr->borderWidth;
+ if (scalePtr->tickInterval != 0) {
+ scalePtr->horizTickY = y + SPACING;
+ y += fm.linespace + 2*SPACING;
+ }
+ Tk_GeometryRequest(scalePtr->tkwin,
+ scalePtr->length + 2*scalePtr->inset, y + scalePtr->inset);
+ Tk_SetInternalBorder(scalePtr->tkwin, scalePtr->inset);
+ return;
+ }
+
+ /*
+ * Vertical scale: compute the amount of space needed to display
+ * the scales value by formatting strings for the two end points;
+ * use whichever length is longer.
+ */
+
+ sprintf(valueString, scalePtr->format, scalePtr->fromValue);
+ valuePixels = Tk_TextWidth(scalePtr->tkfont, valueString, -1);
+
+ sprintf(valueString, scalePtr->format, scalePtr->toValue);
+ tmp = Tk_TextWidth(scalePtr->tkfont, valueString, -1);
+ if (valuePixels < tmp) {
+ valuePixels = tmp;
+ }
+
+ /*
+ * Assign x-locations to the elements of the scale, working from
+ * left to right.
+ */
+
+ x = scalePtr->inset;
+ if ((scalePtr->tickInterval != 0) && (scalePtr->showValue)) {
+ scalePtr->vertTickRightX = x + SPACING + valuePixels;
+ scalePtr->vertValueRightX = scalePtr->vertTickRightX + valuePixels
+ + fm.ascent/2;
+ x = scalePtr->vertValueRightX + SPACING;
+ } else if (scalePtr->tickInterval != 0) {
+ scalePtr->vertTickRightX = x + SPACING + valuePixels;
+ scalePtr->vertValueRightX = scalePtr->vertTickRightX;
+ x = scalePtr->vertTickRightX + SPACING;
+ } else if (scalePtr->showValue) {
+ scalePtr->vertTickRightX = x;
+ scalePtr->vertValueRightX = x + SPACING + valuePixels;
+ x = scalePtr->vertValueRightX + SPACING;
+ } else {
+ scalePtr->vertTickRightX = x;
+ scalePtr->vertValueRightX = x;
+ }
+ 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);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on scales.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScaleEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkScale *scalePtr = (TkScale *) clientData;
+
+ if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
+ TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
+ } else if (eventPtr->type == DestroyNotify) {
+ if (scalePtr->tkwin != NULL) {
+ scalePtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(scalePtr->interp, scalePtr->widgetCmd);
+ }
+ if (scalePtr->flags & REDRAW_ALL) {
+ Tcl_CancelIdleCall(TkpDisplayScale, (ClientData) scalePtr);
+ }
+ Tcl_EventuallyFree((ClientData) scalePtr, DestroyScale);
+ } else if (eventPtr->type == ConfigureNotify) {
+ ComputeScaleGeometry(scalePtr);
+ TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ scalePtr->flags |= GOT_FOCUS;
+ if (scalePtr->highlightWidth > 0) {
+ TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ scalePtr->flags &= ~GOT_FOCUS;
+ if (scalePtr->highlightWidth > 0) {
+ TkEventuallyRedrawScale(scalePtr, REDRAW_ALL);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScaleCmdDeletedProc --
+ *
+ * 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
+ScaleCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ TkScale *scalePtr = (TkScale *) clientData;
+ Tk_Window tkwin = scalePtr->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) {
+ scalePtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkEventuallyRedrawScale --
+ *
+ * Arrange for part or all of a scale widget to redrawn at
+ * the next convenient time in the future.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If "what" is REDRAW_SLIDER then just the slider and the
+ * value readout will be redrawn; if "what" is REDRAW_ALL
+ * then the entire widget will be redrawn.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkEventuallyRedrawScale(scalePtr, what)
+ register TkScale *scalePtr; /* Information about widget. */
+ int what; /* What to redraw: REDRAW_SLIDER
+ * or REDRAW_ALL. */
+{
+ if ((what == 0) || (scalePtr->tkwin == NULL)
+ || !Tk_IsMapped(scalePtr->tkwin)) {
+ return;
+ }
+ if ((scalePtr->flags & REDRAW_ALL) == 0) {
+ Tcl_DoWhenIdle(TkpDisplayScale, (ClientData) scalePtr);
+ }
+ scalePtr->flags |= what;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkRoundToResolution --
+ *
+ * Round a given floating-point value to the nearest multiple
+ * of the scale's resolution.
+ *
+ * Results:
+ * The return value is the rounded result.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+double
+TkRoundToResolution(scalePtr, value)
+ TkScale *scalePtr; /* Information about scale widget. */
+ double value; /* Value to round. */
+{
+ double rem, new;
+
+ if (scalePtr->resolution <= 0) {
+ return value;
+ }
+ new = scalePtr->resolution * floor(value/scalePtr->resolution);
+ rem = value - new;
+ if (rem < 0) {
+ if (rem <= -scalePtr->resolution/2) {
+ new -= scalePtr->resolution;
+ }
+ } else {
+ if (rem >= scalePtr->resolution/2) {
+ new += scalePtr->resolution;
+ }
+ }
+ return new;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScaleVarProc --
+ *
+ * This procedure is invoked by Tcl whenever someone modifies a
+ * variable associated with a scale widget.
+ *
+ * Results:
+ * NULL is always returned.
+ *
+ * Side effects:
+ * The value displayed in the scale will change to match the
+ * variable's new value. If the variable has a bogus value then
+ * it is reset to the value of the scale.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+ScaleVarProc(clientData, interp, name1, name2, flags)
+ 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;
+}
diff --git a/tk/generic/tkScale.h b/tk/generic/tkScale.h
new file mode 100644
index 00000000000..ee676f3a903
--- /dev/null
+++ b/tk/generic/tkScale.h
@@ -0,0 +1,233 @@
+/*
+ * 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$
+ */
+
+#ifndef _TKSCALE
+#define _TKSCALE
+
+#ifndef _TK
+#include "tk.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 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
+ * long dimension of scale. */
+ int showValue; /* Non-zero means to display the scale value
+ * below or to the left of the slider; zero
+ * means don't display the value. */
+
+ /*
+ * Layout information for horizontal scales, assuming that window
+ * gets the size it requested:
+ */
+
+ int horizLabelY; /* Y-coord at which to draw label. */
+ int horizValueY; /* Y-coord at which to draw value text. */
+ int horizTroughY; /* Y-coord of top of slider trough. */
+ int horizTickY; /* Y-coord at which to draw tick text. */
+ /*
+ * Layout information for vertical scales, assuming that window
+ * gets the size it requested:
+ */
+
+ int vertTickRightX; /* X-location of right side of tick-marks. */
+ int vertValueRightX; /* X-location of right side of value string. */
+ int vertTroughX; /* X-location of scale's slider trough. */
+ 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:
+ *
+ * REDRAW_SLIDER - 1 means slider (and numerical readout) need
+ * to be redrawn.
+ * REDRAW_OTHER - 1 means other stuff besides slider and value
+ * need to be redrawn.
+ * REDRAW_ALL - 1 means the entire widget needs to be redrawn.
+ * ACTIVE - 1 means the widget is active (the mouse is
+ * in its window).
+ * INVOKE_COMMAND - 1 means the scale's command needs to be
+ * invoked during the next redisplay (the
+ * value of the scale has changed since the
+ * last time the command was invoked).
+ * SETTING_VAR - 1 means that the associated variable is
+ * being set by us, so there's no need for
+ * ScaleVarProc to do anything.
+ * NEVER_SET - 1 means that the scale's value has never
+ * been set before (so must invoke -command and
+ * set associated variable even if the value
+ * doesn't appear to have changed).
+ * GOT_FOCUS - 1 means that the focus is currently in
+ * this widget.
+ */
+
+#define REDRAW_SLIDER 1
+#define REDRAW_OTHER 2
+#define REDRAW_ALL 3
+#define ACTIVE 4
+#define INVOKE_COMMAND 0x10
+#define SETTING_VAR 0x20
+#define NEVER_SET 0x40
+#define GOT_FOCUS 0x80
+
+/*
+ * Symbolic values for the active parts of a slider. These are
+ * the values that may be returned by the ScaleElement procedure.
+ */
+
+#define OTHER 0
+#define TROUGH1 1
+#define SLIDER 2
+#define TROUGH2 3
+
+/*
+ * Space to leave between scale area and text, and between text and
+ * edge of window.
+ */
+
+#define SPACING 2
+
+/*
+ * 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));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKSCALE */
diff --git a/tk/generic/tkScrollbar.c b/tk/generic/tkScrollbar.c
new file mode 100644
index 00000000000..b49069a0a8a
--- /dev/null
+++ b/tk/generic/tkScrollbar.c
@@ -0,0 +1,691 @@
+/*
+ * tkScrollbar.c --
+ *
+ * This module implements a scrollbar widgets for the Tk
+ * toolkit. A scrollbar displays a slider and two arrows;
+ * mouse clicks on features within the scrollbar cause
+ * scrolling commands to be invoked.
+ *
+ * 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$
+ */
+
+#include "tkPort.h"
+#include "tkScrollbar.h"
+#include "default.h"
+
+/*
+ * Information used for argv parsing.
+ */
+
+Tk_ConfigSpec tkpScrollbarConfigSpecs[] = {
+ {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_SCROLLBAR_ACTIVE_BG_COLOR, Tk_Offset(TkScrollbar, activeBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-activebackground", "activeBackground", "Foreground",
+ DEF_SCROLLBAR_ACTIVE_BG_MONO, Tk_Offset(TkScrollbar, activeBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_RELIEF, "-activerelief", "activeRelief", "Relief",
+ DEF_SCROLLBAR_ACTIVE_RELIEF, Tk_Offset(TkScrollbar, activeRelief), 0},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_SCROLLBAR_BG_COLOR, Tk_Offset(TkScrollbar, bgBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_SCROLLBAR_BG_MONO, Tk_Offset(TkScrollbar, 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",
+ DEF_SCROLLBAR_BORDER_WIDTH, Tk_Offset(TkScrollbar, borderWidth), 0},
+ {TK_CONFIG_STRING, "-command", "command", "Command",
+ DEF_SCROLLBAR_COMMAND, Tk_Offset(TkScrollbar, command),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_SCROLLBAR_CURSOR, Tk_Offset(TkScrollbar, cursor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_PIXELS, "-elementborderwidth", "elementBorderWidth",
+ "BorderWidth", DEF_SCROLLBAR_EL_BORDER_WIDTH,
+ Tk_Offset(TkScrollbar, elementBorderWidth), 0},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_SCROLLBAR_HIGHLIGHT_BG,
+ Tk_Offset(TkScrollbar, highlightBgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_SCROLLBAR_HIGHLIGHT,
+ Tk_Offset(TkScrollbar, highlightColorPtr), 0},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_SCROLLBAR_HIGHLIGHT_WIDTH, Tk_Offset(TkScrollbar, highlightWidth), 0},
+ {TK_CONFIG_BOOLEAN, "-jump", "jump", "Jump",
+ DEF_SCROLLBAR_JUMP, Tk_Offset(TkScrollbar, jump), 0},
+ {TK_CONFIG_UID, "-orient", "orient", "Orient",
+ DEF_SCROLLBAR_ORIENT, Tk_Offset(TkScrollbar, orientUid), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_SCROLLBAR_RELIEF, Tk_Offset(TkScrollbar, relief), 0},
+ {TK_CONFIG_INT, "-repeatdelay", "repeatDelay", "RepeatDelay",
+ DEF_SCROLLBAR_REPEAT_DELAY, Tk_Offset(TkScrollbar, repeatDelay), 0},
+ {TK_CONFIG_INT, "-repeatinterval", "repeatInterval", "RepeatInterval",
+ DEF_SCROLLBAR_REPEAT_INTERVAL, Tk_Offset(TkScrollbar, repeatInterval), 0},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_SCROLLBAR_TAKE_FOCUS, Tk_Offset(TkScrollbar, takeFocus),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background",
+ DEF_SCROLLBAR_TROUGH_COLOR, Tk_Offset(TkScrollbar, troughColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR, "-troughcolor", "troughColor", "Background",
+ DEF_SCROLLBAR_TROUGH_MONO, Tk_Offset(TkScrollbar, troughColorPtr),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_PIXELS, "-width", "width", "Width",
+ DEF_SCROLLBAR_WIDTH, Tk_Offset(TkScrollbar, 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 int ConfigureScrollbar _ANSI_ARGS_((Tcl_Interp *interp,
+ TkScrollbar *scrollPtr, int argc, char **argv,
+ int flags));
+static void ScrollbarCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static int ScrollbarWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *, int argc, char **argv));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_ScrollbarCmd --
+ *
+ * This procedure is invoked to process the "scrollbar" 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_ScrollbarCmd(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 TkScrollbar *scrollPtr;
+ 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;
+ }
+
+ Tk_SetClass(new, "Scrollbar");
+ scrollPtr = TkpCreateScrollbar(new);
+
+ TkSetClassProcs(new, &tkpScrollbarProcs, (ClientData) scrollPtr);
+
+ /*
+ * Initialize fields that won't be initialized by ConfigureScrollbar,
+ * or which ConfigureScrollbar expects to have reasonable values
+ * (e.g. resource pointers).
+ */
+
+ scrollPtr->tkwin = new;
+ scrollPtr->display = Tk_Display(new);
+ scrollPtr->interp = interp;
+ scrollPtr->widgetCmd = Tcl_CreateCommand(interp,
+ Tk_PathName(scrollPtr->tkwin), ScrollbarWidgetCmd,
+ (ClientData) scrollPtr, ScrollbarCmdDeletedProc);
+ scrollPtr->orientUid = NULL;
+ scrollPtr->vertical = 0;
+ scrollPtr->width = 0;
+ scrollPtr->command = NULL;
+ scrollPtr->commandSize = 0;
+ scrollPtr->repeatDelay = 0;
+ scrollPtr->repeatInterval = 0;
+ scrollPtr->borderWidth = 0;
+ scrollPtr->bgBorder = NULL;
+ scrollPtr->activeBorder = NULL;
+ scrollPtr->troughColorPtr = NULL;
+ scrollPtr->relief = TK_RELIEF_FLAT;
+ scrollPtr->highlightWidth = 0;
+ scrollPtr->highlightBgColorPtr = NULL;
+ scrollPtr->highlightColorPtr = NULL;
+ scrollPtr->inset = 0;
+ scrollPtr->elementBorderWidth = -1;
+ scrollPtr->arrowLength = 0;
+ scrollPtr->sliderFirst = 0;
+ scrollPtr->sliderLast = 0;
+ scrollPtr->activeField = 0;
+ scrollPtr->activeRelief = TK_RELIEF_RAISED;
+ scrollPtr->totalUnits = 0;
+ scrollPtr->windowUnits = 0;
+ scrollPtr->firstUnit = 0;
+ scrollPtr->lastUnit = 0;
+ scrollPtr->firstFraction = 0.0;
+ scrollPtr->lastFraction = 0.0;
+ scrollPtr->cursor = None;
+ scrollPtr->takeFocus = NULL;
+ 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 --
+ *
+ * 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
+ScrollbarWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about scrollbar
+ * widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register TkScrollbar *scrollPtr = (TkScrollbar *) 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) 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;
+ }
+ c = argv[2][0];
+ length = strlen(argv[2]);
+ oldActiveField = scrollPtr->activeField;
+ if ((c == 'a') && (strcmp(argv[2], "arrow1") == 0)) {
+ scrollPtr->activeField = TOP_ARROW;
+ } else if ((c == 'a') && (strcmp(argv[2], "arrow2") == 0)) {
+ scrollPtr->activeField = BOTTOM_ARROW;
+ } else if ((c == 's') && (strncmp(argv[2], "slider", length) == 0)) {
+ scrollPtr->activeField = SLIDER;
+ } else {
+ scrollPtr->activeField = OUTSIDE;
+ }
+ if (oldActiveField != scrollPtr->activeField) {
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ }
+ } 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, scrollPtr->tkwin,
+ tkpScrollbarConfigSpecs, (char *) scrollPtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc == 2) {
+ result = Tk_ConfigureInfo(interp, scrollPtr->tkwin,
+ tkpScrollbarConfigSpecs, (char *) scrollPtr,
+ (char *) NULL, 0);
+ } else if (argc == 3) {
+ result = Tk_ConfigureInfo(interp, scrollPtr->tkwin,
+ tkpScrollbarConfigSpecs, (char *) scrollPtr, argv[2], 0);
+ } 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)
+ || (Tcl_GetInt(interp, argv[3], &yDelta) != TCL_OK)) {
+ goto error;
+ }
+ if (scrollPtr->vertical) {
+ pixels = yDelta;
+ length = Tk_Height(scrollPtr->tkwin) - 1
+ - 2*(scrollPtr->arrowLength + scrollPtr->inset);
+ } else {
+ pixels = xDelta;
+ length = Tk_Width(scrollPtr->tkwin) - 1
+ - 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)
+ || (Tcl_GetInt(interp, argv[3], &y) != TCL_OK)) {
+ goto error;
+ }
+ if (scrollPtr->vertical) {
+ pos = y - (scrollPtr->arrowLength + scrollPtr->inset);
+ length = Tk_Height(scrollPtr->tkwin) - 1
+ - 2*(scrollPtr->arrowLength + scrollPtr->inset);
+ } else {
+ pos = x - (scrollPtr->arrowLength + scrollPtr->inset);
+ length = Tk_Width(scrollPtr->tkwin) - 1
+ - 2*(scrollPtr->arrowLength + scrollPtr->inset);
+ }
+ if (length == 0) {
+ fraction = 0.0;
+ } else {
+ 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;
+
+ if (Tcl_GetDouble(interp, argv[2], &first) != TCL_OK) {
+ goto error;
+ }
+ if (Tcl_GetDouble(interp, argv[3], &last) != TCL_OK) {
+ goto error;
+ }
+ if (first < 0) {
+ scrollPtr->firstFraction = 0;
+ } else if (first > 1.0) {
+ scrollPtr->firstFraction = 1.0;
+ } else {
+ scrollPtr->firstFraction = first;
+ }
+ if (last < scrollPtr->firstFraction) {
+ scrollPtr->lastFraction = scrollPtr->firstFraction;
+ } else if (last > 1.0) {
+ scrollPtr->lastFraction = 1.0;
+ } else {
+ scrollPtr->lastFraction = last;
+ }
+ scrollPtr->flags |= NEW_STYLE_COMMANDS;
+ } else if (argc == 6) {
+ if (Tcl_GetInt(interp, argv[2], &totalUnits) != TCL_OK) {
+ goto error;
+ }
+ if (totalUnits < 0) {
+ totalUnits = 0;
+ }
+ if (Tcl_GetInt(interp, argv[3], &windowUnits) != TCL_OK) {
+ goto error;
+ }
+ if (windowUnits < 0) {
+ windowUnits = 0;
+ }
+ if (Tcl_GetInt(interp, argv[4], &firstUnit) != TCL_OK) {
+ goto error;
+ }
+ if (Tcl_GetInt(interp, argv[5], &lastUnit) != TCL_OK) {
+ goto error;
+ }
+ if (totalUnits > 0) {
+ if (lastUnit < firstUnit) {
+ lastUnit = firstUnit;
+ }
+ } else {
+ firstUnit = lastUnit = 0;
+ }
+ scrollPtr->totalUnits = totalUnits;
+ scrollPtr->windowUnits = windowUnits;
+ scrollPtr->firstUnit = firstUnit;
+ scrollPtr->lastUnit = lastUnit;
+ if (scrollPtr->totalUnits == 0) {
+ scrollPtr->firstFraction = 0.0;
+ scrollPtr->lastFraction = 1.0;
+ } else {
+ scrollPtr->firstFraction = ((double) firstUnit)/totalUnits;
+ scrollPtr->lastFraction = ((double) (lastUnit+1))/totalUnits;
+ }
+ scrollPtr->flags &= ~NEW_STYLE_COMMANDS;
+ } else {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " set firstFraction lastFraction\" or \"",
+ argv[0],
+ " set totalUnits windowUnits firstUnit lastUnit\"",
+ (char *) NULL);
+ goto error;
+ }
+ TkpComputeScrollbarGeometry(scrollPtr);
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be activate, cget, configure, delta, fraction, ",
+ "get, identify, or set", (char *) NULL);
+ goto error;
+ }
+ done:
+ Tcl_Release((ClientData) scrollPtr);
+ return result;
+
+ error:
+ Tcl_Release((ClientData) scrollPtr);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureScrollbar --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureScrollbar(interp, scrollPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register TkScrollbar *scrollPtr; /* 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;
+
+ if (Tk_ConfigureWidget(interp, scrollPtr->tkwin, tkpScrollbarConfigSpecs,
+ argc, argv, (char *) scrollPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * A few options need special processing, such as parsing the
+ * orientation or setting the background from a 3-D border.
+ */
+
+ length = strlen(scrollPtr->orientUid);
+ if (strncmp(scrollPtr->orientUid, "vertical", length) == 0) {
+ scrollPtr->vertical = 1;
+ } else if (strncmp(scrollPtr->orientUid, "horizontal", length) == 0) {
+ scrollPtr->vertical = 0;
+ } else {
+ Tcl_AppendResult(interp, "bad orientation \"", scrollPtr->orientUid,
+ "\": must be vertical or horizontal", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ if (scrollPtr->command != NULL) {
+ scrollPtr->commandSize = strlen(scrollPtr->command);
+ } else {
+ scrollPtr->commandSize = 0;
+ }
+
+ /*
+ * Configure platform specific options.
+ */
+
+ TkpConfigureScrollbar(scrollPtr);
+
+ /*
+ * Register the desired geometry for the window (leave enough space
+ * for the two arrows plus a minimum-size slider, plus border around
+ * the whole window, if any). Then arrange for the window to be
+ * redisplayed.
+ */
+
+ TkpComputeScrollbarGeometry(scrollPtr);
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkScrollbarEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on scrollbars.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkScrollbarEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ TkScrollbar *scrollPtr = (TkScrollbar *) clientData;
+
+ if ((eventPtr->type == Expose) && (eventPtr->xexpose.count == 0)) {
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ } else if (eventPtr->type == DestroyNotify) {
+ TkpDestroyScrollbar(scrollPtr);
+ if (scrollPtr->tkwin != NULL) {
+ scrollPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(scrollPtr->interp,
+ scrollPtr->widgetCmd);
+ }
+ if (scrollPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(TkpDisplayScrollbar, (ClientData) scrollPtr);
+ }
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff.
+ */
+
+ Tk_FreeOptions(tkpScrollbarConfigSpecs, (char *) scrollPtr,
+ scrollPtr->display, 0);
+ Tcl_EventuallyFree((ClientData) scrollPtr, TCL_DYNAMIC);
+ } else if (eventPtr->type == ConfigureNotify) {
+ TkpComputeScrollbarGeometry(scrollPtr);
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ } else if (eventPtr->type == FocusIn) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ scrollPtr->flags |= GOT_FOCUS;
+ if (scrollPtr->highlightWidth > 0) {
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ }
+ }
+ } else if (eventPtr->type == FocusOut) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ scrollPtr->flags &= ~GOT_FOCUS;
+ if (scrollPtr->highlightWidth > 0) {
+ TkScrollbarEventuallyRedraw(scrollPtr);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScrollbarCmdDeletedProc --
+ *
+ * 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
+ScrollbarCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ TkScrollbar *scrollPtr = (TkScrollbar *) clientData;
+ Tk_Window tkwin = scrollPtr->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) {
+ scrollPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkScrollbarEventuallyRedraw --
+ *
+ * Arrange for one or more of the fields of a scrollbar
+ * to be redrawn.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkScrollbarEventuallyRedraw(scrollPtr)
+ register TkScrollbar *scrollPtr; /* Information about widget. */
+{
+ if ((scrollPtr->tkwin == NULL) || (!Tk_IsMapped(scrollPtr->tkwin))) {
+ return;
+ }
+ if ((scrollPtr->flags & REDRAW_PENDING) == 0) {
+ Tcl_DoWhenIdle(TkpDisplayScrollbar, (ClientData) scrollPtr);
+ scrollPtr->flags |= REDRAW_PENDING;
+ }
+}
diff --git a/tk/generic/tkScrollbar.h b/tk/generic/tkScrollbar.h
new file mode 100644
index 00000000000..fea8ea6b093
--- /dev/null
+++ b/tk/generic/tkScrollbar.h
@@ -0,0 +1,208 @@
+/*
+ * 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$
+ */
+
+#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 {
+ Tk_Window tkwin; /* Window that embodies the scrollbar. 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 scrollbar. */
+ Tcl_Command widgetCmd; /* Token for scrollbar's widget command. */
+ Tk_Uid orientUid; /* Orientation for window ("vertical" or
+ * "horizontal"). */
+ int vertical; /* Non-zero means vertical orientation
+ * requested, zero means horizontal. */
+ int width; /* Desired narrow dimension of scrollbar,
+ * in pixels. */
+ char *command; /* Command prefix to use when invoking
+ * scrolling commands. NULL means don't
+ * invoke commands. Malloc'ed. */
+ int commandSize; /* Number of non-NULL bytes in command. */
+ int repeatDelay; /* How long to wait before auto-repeating
+ * on scrolling actions (in ms). */
+ int repeatInterval; /* Interval between autorepeats (in ms). */
+ int jump; /* Value of -jump option. */
+
+ /*
+ * Information used when displaying widget:
+ */
+
+ int borderWidth; /* Width of 3-D borders. */
+ Tk_3DBorder bgBorder; /* Used for drawing background (all flat
+ * surfaces except for trough). */
+ Tk_3DBorder activeBorder; /* For drawing backgrounds when active (i.e.
+ * when mouse is positioned over element). */
+ XColor *troughColorPtr; /* Color for drawing trough. */
+ 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 elementBorderWidth; /* Width of border to draw around elements
+ * inside scrollbar (arrows and slider).
+ * -1 means use borderWidth. */
+ int arrowLength; /* Length of arrows along long dimension of
+ * scrollbar, including space for a small gap
+ * between the arrow and the slider.
+ * Recomputed on window size changes. */
+ int sliderFirst; /* Pixel coordinate of top or left edge
+ * of slider area, including border. */
+ int sliderLast; /* Coordinate of pixel just after bottom
+ * or right edge of slider area, including
+ * border. */
+ int activeField; /* Names field to be displayed in active
+ * colors, such as TOP_ARROW, or 0 for
+ * no field. */
+ int activeRelief; /* Value of -activeRelief option: relief
+ * to use for active element. */
+
+ /*
+ * Information describing the application related to the scrollbar.
+ * This information is provided by the application by invoking the
+ * "set" widget command. This information can now be provided in
+ * two ways: the "old" form (totalUnits, windowUnits, firstUnit,
+ * and lastUnit), or the "new" form (firstFraction and lastFraction).
+ * FirstFraction and lastFraction will always be valid, but
+ * the old-style information is only valid if the NEW_STYLE_COMMANDS
+ * flag is 0.
+ */
+
+ int totalUnits; /* Total dimension of application, in
+ * units. Valid only if the NEW_STYLE_COMMANDS
+ * flag isn't set. */
+ int windowUnits; /* Maximum number of units that can be
+ * displayed in the window at once. Valid
+ * only if the NEW_STYLE_COMMANDS flag isn't
+ * set. */
+ int firstUnit; /* Number of last unit visible in
+ * application's window. Valid only if the
+ * NEW_STYLE_COMMANDS flag isn't set. */
+ int lastUnit; /* Index of last unit visible in window.
+ * Valid only if the NEW_STYLE_COMMANDS
+ * flag isn't set. */
+ double firstFraction; /* Position of first visible thing in window,
+ * specified as a fraction between 0 and
+ * 1.0. */
+ double lastFraction; /* Position of last visible thing in window,
+ * specified as a fraction between 0 and
+ * 1.0. */
+
+ /*
+ * 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. */
+} TkScrollbar;
+
+/*
+ * Legal values for "activeField" field of Scrollbar structures. These
+ * are also the return values from the ScrollbarPosition procedure.
+ */
+
+#define OUTSIDE 0
+#define TOP_ARROW 1
+#define TOP_GAP 2
+#define SLIDER 3
+#define BOTTOM_GAP 4
+#define BOTTOM_ARROW 5
+
+/*
+ * Flag bits for scrollbars:
+ *
+ * REDRAW_PENDING: Non-zero means a DoWhenIdle handler
+ * has already been queued to redraw
+ * this window.
+ * NEW_STYLE_COMMANDS: Non-zero means the new style of commands
+ * should be used to communicate with the
+ * widget: ".t yview scroll 2 lines", instead
+ * of ".t yview 40", for example.
+ * GOT_FOCUS: Non-zero means this window has the input
+ * focus.
+ */
+
+#define REDRAW_PENDING 1
+#define NEW_STYLE_COMMANDS 2
+#define GOT_FOCUS 4
+
+/*
+ * Declaration of scrollbar class procedures structure.
+ */
+
+extern TkClassProcs tkpScrollbarProcs;
+
+/*
+ * Declaration of scrollbar configuration options.
+ */
+
+extern Tk_ConfigSpec tkpScrollbarConfigSpecs[];
+
+/*
+ * Declaration of procedures used in the implementation of the scrollbar
+ * widget.
+ */
+
+EXTERN void TkScrollbarEventProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+EXTERN void TkScrollbarEventuallyRedraw _ANSI_ARGS_((
+ TkScrollbar *scrollPtr));
+EXTERN void TkpComputeScrollbarGeometry _ANSI_ARGS_((
+ TkScrollbar *scrollPtr));
+EXTERN TkScrollbar * TkpCreateScrollbar _ANSI_ARGS_((Tk_Window tkwin));
+EXTERN void TkpDestroyScrollbar _ANSI_ARGS_((
+ TkScrollbar *scrollPtr));
+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 */
diff --git a/tk/generic/tkSelect.c b/tk/generic/tkSelect.c
new file mode 100644
index 00000000000..f97d5e411fe
--- /dev/null
+++ b/tk/generic/tkSelect.c
@@ -0,0 +1,1341 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkSelect.h"
+
+/*
+ * When a selection handler is set up by invoking "selection handle",
+ * one of the following data structures is set up to hold information
+ * about the command to invoke and its interpreter.
+ */
+
+typedef struct {
+ Tcl_Interp *interp; /* Interpreter in which to invoke command. */
+ int cmdLength; /* # of non-NULL bytes in command. */
+ char command[4]; /* Command to invoke. Actual space is
+ * allocated as large as necessary. This
+ * must be the last entry in the structure. */
+} CommandInfo;
+
+/*
+ * When selection ownership is claimed with the "selection own" Tcl command,
+ * one of the following structures is created to record the Tcl command
+ * to be executed when the selection is lost again.
+ */
+
+typedef struct LostCommand {
+ 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));
+static void LostSelection _ANSI_ARGS_((ClientData clientData));
+static int SelGetProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, char *portion));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_CreateSelHandler --
+ *
+ * This procedure is called to register a procedure
+ * as the handler for selection requests of a particular
+ * target type on a particular window for a particular
+ * selection.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * In the future, whenever the selection is in tkwin's
+ * window and someone requests the selection in the
+ * form given by target, proc will be invoked to provide
+ * part or all of the selection in the given form. If
+ * there was already a handler declared for the given
+ * window, target and selection type, then it is replaced.
+ * Proc should have the following form:
+ *
+ * int
+ * proc(clientData, offset, buffer, maxBytes)
+ * ClientData clientData;
+ * int offset;
+ * char *buffer;
+ * int maxBytes;
+ * {
+ * }
+ *
+ * The clientData argument to proc will be the same as
+ * the clientData argument to this procedure. The offset
+ * argument indicates which portion of the selection to
+ * return: skip the first offset bytes. Buffer is a
+ * pointer to an area in which to place the converted
+ * selection, and maxBytes gives the number of bytes
+ * available at buffer. Proc should place the selection
+ * in buffer as a string, and return a count of the number
+ * of bytes of selection actually placed in buffer (not
+ * including the terminating NULL character). If the
+ * return value equals maxBytes, this is a sign that there
+ * is probably still more selection information available.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_CreateSelHandler(tkwin, selection, target, proc, clientData, format)
+ Tk_Window tkwin; /* Token for window. */
+ Atom selection; /* Selection to be handled. */
+ Atom target; /* The kind of selection conversions
+ * that can be handled by proc,
+ * e.g. TARGETS or STRING. */
+ Tk_SelectionProc *proc; /* Procedure to invoke to convert
+ * selection to type "target". */
+ ClientData clientData; /* Value to pass to proc. */
+ Atom format; /* Format in which the selection
+ * information should be returned to
+ * the requestor. XA_STRING is best by
+ * far, but anything listed in the ICCCM
+ * will be tolerated (blech). */
+{
+ register TkSelHandler *selPtr;
+ TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (winPtr->dispPtr->multipleAtom == None) {
+ TkSelInit(tkwin);
+ }
+
+ /*
+ * See if there's already a handler for this target and selection on
+ * this window. If so, re-use it. If not, create a new one.
+ */
+
+ for (selPtr = winPtr->selHandlerList; ; selPtr = selPtr->nextPtr) {
+ if (selPtr == NULL) {
+ selPtr = (TkSelHandler *) ckalloc(sizeof(TkSelHandler));
+ selPtr->nextPtr = winPtr->selHandlerList;
+ winPtr->selHandlerList = selPtr;
+ break;
+ }
+ if ((selPtr->selection == selection) && (selPtr->target == target)) {
+
+ /*
+ * Special case: when replacing handler created by
+ * "selection handle", free up memory. Should there be a
+ * callback to allow other clients to do this too?
+ */
+
+ if (selPtr->proc == HandleTclCommand) {
+ ckfree((char *) selPtr->clientData);
+ }
+ break;
+ }
+ }
+ selPtr->selection = selection;
+ selPtr->target = target;
+ selPtr->format = format;
+ selPtr->proc = proc;
+ selPtr->clientData = clientData;
+ if (format == XA_STRING) {
+ selPtr->size = 8;
+ } else {
+ selPtr->size = 32;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DeleteSelHandler --
+ *
+ * Remove the selection handler for a given window, target, and
+ * selection, if it exists.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The selection handler for tkwin and target is removed. If there
+ * is no such handler then nothing happens.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DeleteSelHandler(tkwin, selection, target)
+ Tk_Window tkwin; /* Token for window. */
+ Atom selection; /* The selection whose handler
+ * 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; ;
+ prevPtr = selPtr, selPtr = selPtr->nextPtr) {
+ if (selPtr == NULL) {
+ return;
+ }
+ if ((selPtr->selection == selection) && (selPtr->target == target)) {
+ break;
+ }
+ }
+
+ /*
+ * 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.
+ */
+
+ if (prevPtr == NULL) {
+ winPtr->selHandlerList = selPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = selPtr->nextPtr;
+ }
+ if (selPtr->proc == HandleTclCommand) {
+ ckfree((char *) selPtr->clientData);
+ }
+ ckfree((char *) selPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_OwnSelection --
+ *
+ * Arrange for tkwin to become the owner of a selection.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * From now on, requests for the selection will be directed
+ * to procedures associated with tkwin (they must have been
+ * declared with calls to Tk_CreateSelHandler). When the
+ * selection is lost by this window, proc will be invoked
+ * (see the manual entry for details). This procedure may
+ * invoke callbacks, including Tcl scripts, so any calling
+ * function should be reentrant at the point where
+ * Tk_OwnSelection is invoked.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_OwnSelection(tkwin, selection, proc, clientData)
+ Tk_Window tkwin; /* Window to become new selection
+ * owner. */
+ Atom selection; /* Selection that window should own. */
+ Tk_LostSelProc *proc; /* Procedure to call when selection
+ * is taken away from tkwin. */
+ ClientData clientData; /* Arbitrary one-word argument to
+ * pass to proc. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkSelectionInfo *infoPtr;
+ Tk_LostSelProc *clearProc = NULL;
+ ClientData clearData = NULL; /* Initialization needed only to
+ * prevent compiler warning. */
+
+
+ if (dispPtr->multipleAtom == None) {
+ TkSelInit(tkwin);
+ }
+ Tk_MakeWindowExist(tkwin);
+
+ /*
+ * This code is somewhat tricky. First, we find the specified selection
+ * on the selection list. If the previous owner is in this process, and
+ * is a different window, then we need to invoke the clearProc. However,
+ * it's dangerous to call the clearProc right now, because it could
+ * invoke a Tcl script that wrecks the current state (e.g. it could
+ * delete the window). To be safe, defer the call until the end of the
+ * procedure when we no longer care about the state.
+ */
+
+ for (infoPtr = dispPtr->selectionInfoPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->selection == selection) {
+ break;
+ }
+ }
+ if (infoPtr == NULL) {
+ infoPtr = (TkSelectionInfo*) ckalloc(sizeof(TkSelectionInfo));
+ infoPtr->selection = selection;
+ infoPtr->nextPtr = dispPtr->selectionInfoPtr;
+ dispPtr->selectionInfoPtr = infoPtr;
+ } else if (infoPtr->clearProc != NULL) {
+ if (infoPtr->owner != tkwin) {
+ clearProc = infoPtr->clearProc;
+ clearData = infoPtr->clearData;
+ } else if (infoPtr->clearProc == LostSelection) {
+ /*
+ * If the selection handler is one created by "selection own",
+ * be sure to free the record for it; otherwise there will be
+ * a memory leak.
+ */
+
+ ckfree((char *) infoPtr->clearData);
+ }
+ }
+
+ infoPtr->owner = tkwin;
+ infoPtr->serial = NextRequest(winPtr->display);
+ infoPtr->clearProc = proc;
+ infoPtr->clearData = clientData;
+
+ /*
+ * Note that we are using CurrentTime, even though ICCCM recommends against
+ * this practice (the problem is that we don't necessarily have a valid
+ * time to use). We will not be able to retrieve a useful timestamp for
+ * the TIMESTAMP target later.
+ */
+
+ infoPtr->time = CurrentTime;
+
+ /*
+ * Note that we are not checking to see if the selection claim succeeded.
+ * If the ownership does not change, then the clearProc may never be
+ * invoked, and we will return incorrect information when queried for the
+ * current selection owner.
+ */
+
+ XSetSelectionOwner(winPtr->display, infoPtr->selection, winPtr->window,
+ infoPtr->time);
+
+ /*
+ * Now that we are done, we can invoke clearProc without running into
+ * reentrancy problems.
+ */
+
+ if (clearProc != NULL) {
+ (*clearProc)(clearData);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_ClearSelection --
+ *
+ * Eliminate the specified selection on tkwin's display, if there is one.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The specified selection is cleared, so that future requests to retrieve
+ * it will fail until some application owns it again. This procedure
+ * invokes callbacks, possibly including Tcl scripts, so any calling
+ * function should be reentrant at the point Tk_ClearSelection is invoked.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_ClearSelection(tkwin, selection)
+ Tk_Window tkwin; /* Window that selects a display. */
+ Atom selection; /* Selection to be cancelled. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkSelectionInfo *infoPtr;
+ TkSelectionInfo *prevPtr;
+ TkSelectionInfo *nextPtr;
+ Tk_LostSelProc *clearProc = NULL;
+ ClientData clearData = NULL; /* Initialization needed only to
+ * prevent compiler warning. */
+
+ if (dispPtr->multipleAtom == None) {
+ TkSelInit(tkwin);
+ }
+
+ for (infoPtr = dispPtr->selectionInfoPtr, prevPtr = NULL;
+ infoPtr != NULL; infoPtr = nextPtr) {
+ nextPtr = infoPtr->nextPtr;
+ if (infoPtr->selection == selection) {
+ if (prevPtr == NULL) {
+ dispPtr->selectionInfoPtr = nextPtr;
+ } else {
+ prevPtr->nextPtr = nextPtr;
+ }
+ break;
+ }
+ prevPtr = infoPtr;
+ }
+
+ if (infoPtr != NULL) {
+ clearProc = infoPtr->clearProc;
+ clearData = infoPtr->clearData;
+ ckfree((char *) infoPtr);
+ }
+ XSetSelectionOwner(winPtr->display, selection, None, CurrentTime);
+
+ if (clearProc != NULL) {
+ (*clearProc)(clearData);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_GetSelection --
+ *
+ * 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:
+ *
+ * int
+ * proc(clientData, interp, portion)
+ * ClientData clientData;
+ * Tcl_Interp *interp;
+ * char *portion;
+ * {
+ * }
+ *
+ * The interp and clientData arguments to proc will be the
+ * same as the corresponding arguments to Tk_GetSelection.
+ * 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)
+ Tcl_Interp *interp; /* Interpreter to use for reporting
+ * errors. */
+ Tk_Window tkwin; /* Window on whose behalf to retrieve
+ * the selection (determines display
+ * from which to retrieve). */
+ Atom selection; /* Selection to retrieve. */
+ 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. */
+{
+ 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
+ * process, then call the retrieval procedure directly,
+ * rather than going through the X server (it's dangerous
+ * to go through the X server in this case because it could
+ * result in deadlock if an INCR-style selection results).
+ */
+
+ for (infoPtr = dispPtr->selectionInfoPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->selection == selection)
+ break;
+ }
+ if (infoPtr != NULL) {
+ register TkSelHandler *selPtr;
+ int offset, result, count;
+ char buffer[TK_SEL_BYTES_AT_ONCE+1];
+ TkSelInProgress ip;
+
+ for (selPtr = ((TkWindow *) infoPtr->owner)->selHandlerList;
+ selPtr != NULL; selPtr = selPtr->nextPtr) {
+ if ((selPtr->target == target)
+ && (selPtr->selection == selection)) {
+ break;
+ }
+ }
+ if (selPtr == NULL) {
+ Atom type;
+
+ count = TkSelDefaultSelection(infoPtr, target, buffer,
+ TK_SEL_BYTES_AT_ONCE, &type);
+ if (count > TK_SEL_BYTES_AT_ONCE) {
+ panic("selection handler returned too many bytes");
+ }
+ if (count < 0) {
+ goto cantget;
+ }
+ 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.
+ */
+
+ return TkSelGetSelection(interp, tkwin, selection, target, proc,
+ clientData);
+
+ cantget:
+ Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),
+ " selection doesn't exist or form \"", Tk_GetAtomName(tkwin, target),
+ "\" not defined", (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SelectionCmd --
+ *
+ * This procedure is invoked to process the "selection" 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_SelectionCmd(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;
+ char *path = NULL;
+ 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] != '-') {
+ break;
+ }
+ if (count < 2) {
+ Tcl_AppendResult(interp, "value for \"", *args,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = args[0][1];
+ length = strlen(args[0]);
+ if ((c == 'd') && (strncmp(args[0], "-displayof", length) == 0)) {
+ path = args[1];
+ } else if ((c == 's')
+ && (strncmp(args[0], "-selection", length) == 0)) {
+ selName = args[1];
+ } else {
+ Tcl_AppendResult(interp, "unknown option \"", args[0],
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (count == 1) {
+ path = args[0];
+ } else if (count > 1) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " clear ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (selName != NULL) {
+ selection = Tk_InternAtom(tkwin, selName);
+ } else {
+ selection = XA_PRIMARY;
+ }
+
+ Tk_ClearSelection(tkwin, selection);
+ return TCL_OK;
+ } else if ((c == 'g') && (strncmp(argv[1], "get", length) == 0)) {
+ Atom target;
+ char *targetName = NULL;
+ Tcl_DString selBytes;
+ int result;
+
+ for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
+ if (args[0][0] != '-') {
+ break;
+ }
+ if (count < 2) {
+ Tcl_AppendResult(interp, "value for \"", *args,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = args[0][1];
+ length = strlen(args[0]);
+ if ((c == 'd') && (strncmp(args[0], "-displayof", length) == 0)) {
+ path = args[1];
+ } else if ((c == 's')
+ && (strncmp(args[0], "-selection", length) == 0)) {
+ selName = args[1];
+ } else if ((c == 't')
+ && (strncmp(args[0], "-type", length) == 0)) {
+ targetName = args[1];
+ } else {
+ Tcl_AppendResult(interp, "unknown option \"", args[0],
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (selName != NULL) {
+ selection = Tk_InternAtom(tkwin, selName);
+ } else {
+ selection = XA_PRIMARY;
+ }
+ if (count > 1) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " get ?options?\"", (char *) NULL);
+ return TCL_ERROR;
+ } else if (count == 1) {
+ target = Tk_InternAtom(tkwin, args[0]);
+ } else if (targetName != NULL) {
+ target = Tk_InternAtom(tkwin, targetName);
+ } else {
+ target = XA_STRING;
+ }
+
+ Tcl_DStringInit(&selBytes);
+ result = Tk_GetSelection(interp, tkwin, selection, target, SelGetProc,
+ (ClientData) &selBytes);
+ if (result == TCL_OK) {
+ Tcl_DStringResult(interp, &selBytes);
+ } else {
+ Tcl_DStringFree(&selBytes);
+ }
+ return result;
+ } else if ((c == 'h') && (strncmp(argv[1], "handle", length) == 0)) {
+ Atom target, format;
+ char *targetName = NULL;
+ char *formatName = NULL;
+ register CommandInfo *cmdInfoPtr;
+ int cmdLength;
+
+ for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
+ if (args[0][0] != '-') {
+ break;
+ }
+ if (count < 2) {
+ Tcl_AppendResult(interp, "value for \"", *args,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = args[0][1];
+ length = strlen(args[0]);
+ if ((c == 'f') && (strncmp(args[0], "-format", length) == 0)) {
+ formatName = args[1];
+ } else if ((c == 's')
+ && (strncmp(args[0], "-selection", length) == 0)) {
+ selName = args[1];
+ } else if ((c == 't')
+ && (strncmp(args[0], "-type", length) == 0)) {
+ targetName = args[1];
+ } else {
+ Tcl_AppendResult(interp, "unknown option \"", args[0],
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if ((count < 2) || (count > 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " handle ?options? window command\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ tkwin = Tk_NameToWindow(interp, args[0], tkwin);
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ if (selName != NULL) {
+ selection = Tk_InternAtom(tkwin, selName);
+ } else {
+ selection = XA_PRIMARY;
+ }
+
+ if (count > 2) {
+ target = Tk_InternAtom(tkwin, args[2]);
+ } else if (targetName != NULL) {
+ target = Tk_InternAtom(tkwin, targetName);
+ } else {
+ target = XA_STRING;
+ }
+ if (count > 3) {
+ format = Tk_InternAtom(tkwin, args[3]);
+ } else if (formatName != NULL) {
+ format = Tk_InternAtom(tkwin, formatName);
+ } else {
+ format = XA_STRING;
+ }
+ cmdLength = strlen(args[1]);
+ if (cmdLength == 0) {
+ Tk_DeleteSelHandler(tkwin, selection, target);
+ } else {
+ cmdInfoPtr = (CommandInfo *) ckalloc((unsigned) (
+ sizeof(CommandInfo) - 3 + cmdLength));
+ cmdInfoPtr->interp = interp;
+ cmdInfoPtr->cmdLength = cmdLength;
+ strcpy(cmdInfoPtr->command, args[1]);
+ Tk_CreateSelHandler(tkwin, selection, target, HandleTclCommand,
+ (ClientData) cmdInfoPtr, format);
+ }
+ return TCL_OK;
+ } else if ((c == 'o') && (strncmp(argv[1], "own", length) == 0)) {
+ register LostCommand *lostPtr;
+ char *script = NULL;
+ int cmdLength;
+
+ for (count = argc-2, args = argv+2; count > 0; count -= 2, args += 2) {
+ if (args[0][0] != '-') {
+ break;
+ }
+ if (count < 2) {
+ Tcl_AppendResult(interp, "value for \"", *args,
+ "\" missing", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = args[0][1];
+ length = strlen(args[0]);
+ if ((c == 'c') && (strncmp(args[0], "-command", length) == 0)) {
+ script = args[1];
+ } else if ((c == 'd')
+ && (strncmp(args[0], "-displayof", length) == 0)) {
+ path = args[1];
+ } else if ((c == 's')
+ && (strncmp(args[0], "-selection", length) == 0)) {
+ selName = args[1];
+ } else {
+ Tcl_AppendResult(interp, "unknown option \"", args[0],
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (count > 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " own ?options? ?window?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (selName != NULL) {
+ selection = Tk_InternAtom(tkwin, selName);
+ } else {
+ selection = XA_PRIMARY;
+ }
+ if (count == 0) {
+ TkSelectionInfo *infoPtr;
+ TkWindow *winPtr;
+ if (path != NULL) {
+ tkwin = Tk_NameToWindow(interp, path, tkwin);
+ }
+ if (tkwin == NULL) {
+ return TCL_ERROR;
+ }
+ winPtr = (TkWindow *)tkwin;
+ for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->selection == selection)
+ break;
+ }
+
+ /*
+ * 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;
+ }
+ if (count == 2) {
+ script = args[1];
+ }
+ if (script == NULL) {
+ Tk_OwnSelection(tkwin, selection, (Tk_LostSelProc *) NULL,
+ (ClientData) NULL);
+ return TCL_OK;
+ }
+ cmdLength = strlen(script);
+ 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.
+ * It performs selection-related cleanup.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees up memory associated with the selection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+ }
+ ckfree((char *) selPtr);
+ }
+
+ /*
+ * Remove selections owned by window being deleted.
+ */
+
+ for (infoPtr = winPtr->dispPtr->selectionInfoPtr, prevPtr = NULL;
+ infoPtr != NULL; infoPtr = nextPtr) {
+ nextPtr = infoPtr->nextPtr;
+ if (infoPtr->owner == (Tk_Window) winPtr) {
+ if (infoPtr->clearProc == LostSelection) {
+ ckfree((char *) infoPtr->clearData);
+ }
+ ckfree((char *) infoPtr);
+ infoPtr = prevPtr;
+ if (prevPtr == NULL) {
+ winPtr->dispPtr->selectionInfoPtr = nextPtr;
+ } else {
+ prevPtr->nextPtr = nextPtr;
+ }
+ }
+ prevPtr = infoPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelInit --
+ *
+ * Initialize selection-related information for a display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Selection-related information is initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSelInit(tkwin)
+ Tk_Window tkwin; /* Window token (used to find
+ * display to initialize). */
+{
+ register TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ /*
+ * Fetch commonly-used atoms.
+ */
+
+ dispPtr->multipleAtom = Tk_InternAtom(tkwin, "MULTIPLE");
+ dispPtr->incrAtom = Tk_InternAtom(tkwin, "INCR");
+ dispPtr->targetsAtom = Tk_InternAtom(tkwin, "TARGETS");
+ dispPtr->timestampAtom = Tk_InternAtom(tkwin, "TIMESTAMP");
+ dispPtr->textAtom = Tk_InternAtom(tkwin, "TEXT");
+ dispPtr->compoundTextAtom = Tk_InternAtom(tkwin, "COMPOUND_TEXT");
+ dispPtr->applicationAtom = Tk_InternAtom(tkwin, "TK_APPLICATION");
+ dispPtr->windowAtom = Tk_InternAtom(tkwin, "TK_WINDOW");
+ dispPtr->clipboardAtom = Tk_InternAtom(tkwin, "CLIPBOARD");
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelClearSelection --
+ *
+ * This procedure is invoked to process a SelectionClear event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Invokes the clear procedure for the window which lost the
+ * selection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSelClearSelection(tkwin, eventPtr)
+ Tk_Window tkwin; /* Window for which event was targeted. */
+ register XEvent *eventPtr; /* X SelectionClear event. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ TkSelectionInfo *infoPtr;
+ TkSelectionInfo *prevPtr;
+
+ /*
+ * Invoke clear procedure for window that just lost the selection. This
+ * code is a bit tricky, because any callbacks due to selection changes
+ * between windows managed by the process have already been made. Thus,
+ * ignore the event unless it refers to the window that's currently the
+ * selection owner and the event was generated after the server saw the
+ * SetSelectionOwner request.
+ */
+
+ for (infoPtr = dispPtr->selectionInfoPtr, prevPtr = NULL;
+ infoPtr != NULL; infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->selection == eventPtr->xselectionclear.selection) {
+ break;
+ }
+ prevPtr = infoPtr;
+ }
+
+ if (infoPtr != NULL && (infoPtr->owner == tkwin)
+ && (eventPtr->xselectionclear.serial >= (unsigned) infoPtr->serial)) {
+ if (prevPtr == NULL) {
+ dispPtr->selectionInfoPtr = infoPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = infoPtr->nextPtr;
+ }
+
+ /*
+ * Because of reentrancy problems, calling clearProc must be done
+ * after the infoPtr has been removed from the selectionInfoPtr
+ * list (clearProc could modify the list, e.g. by creating
+ * a new selection).
+ */
+
+ if (infoPtr->clearProc != NULL) {
+ (*infoPtr->clearProc)(infoPtr->clearData);
+ }
+ ckfree((char *) infoPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SelGetProc --
+ *
+ * This procedure is invoked to process pieces of the selection
+ * as they arrive during "selection get" commands.
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * Bytes get appended to the dynamic string pointed to by the
+ * clientData argument.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+SelGetProc(clientData, interp, portion)
+ ClientData clientData; /* Dynamic string holding partially
+ * assembled selection. */
+ Tcl_Interp *interp; /* Interpreter used for error
+ * reporting (not used). */
+ char *portion; /* New information to be appended. */
+{
+ Tcl_DStringAppend((Tcl_DString *) clientData, portion, -1);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * HandleTclCommand --
+ *
+ * This procedure acts as selection handler for handlers created
+ * by the "selection handle" command. It invokes a Tcl command to
+ * retrieve the selection.
+ *
+ * Results:
+ * The return value is a count of the number of bytes actually
+ * stored at buffer, or -1 if an error occurs while executing
+ * the Tcl command to retrieve the selection.
+ *
+ * Side effects:
+ * None except for things done by the Tcl command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+HandleTclCommand(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Information about command to execute. */
+ int offset; /* Return selection bytes starting at this
+ * offset. */
+ char *buffer; /* Place to store converted selection. */
+ int maxBytes; /* Maximum # of bytes to store at buffer. */
+{
+ CommandInfo *cmdInfoPtr = (CommandInfo *) clientData;
+ int spaceNeeded, length;
+#define MAX_STATIC_SIZE 100
+ char staticSpace[MAX_STATIC_SIZE];
+ char *command;
+ Tcl_Interp *interp;
+ Tcl_DString oldResult;
+
+ /*
+ * We must copy the interpreter pointer from CommandInfo because the
+ * command could delete the handler, freeing the CommandInfo data before we
+ * are done using it. We must also protect the interpreter from being
+ * deleted too soo.
+ */
+
+ interp = cmdInfoPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+
+ /*
+ * First, generate a command by taking the command string
+ * and appending the offset and maximum # of bytes.
+ */
+
+ spaceNeeded = cmdInfoPtr->cmdLength + 30;
+ if (spaceNeeded < MAX_STATIC_SIZE) {
+ command = staticSpace;
+ } else {
+ command = (char *) ckalloc((unsigned) spaceNeeded);
+ }
+ sprintf(command, "%s %d %d", cmdInfoPtr->command, offset, maxBytes);
+
+ /*
+ * 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) {
+ ckfree(command);
+ }
+
+ Tcl_Release((ClientData) interp);
+ return length;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelDefaultSelection --
+ *
+ * This procedure is called to generate selection information
+ * for a few standard targets such as TIMESTAMP and TARGETS.
+ * It is invoked only if no handler has been declared by the
+ * application.
+ *
+ * Results:
+ * If "target" is a standard target understood by this procedure,
+ * the selection is converted to that form and stored as a
+ * character string in buffer. The type of the selection (e.g.
+ * STRING or ATOM) is stored in *typePtr, and the return value is
+ * a count of the # of non-NULL bytes at buffer. If the target
+ * wasn't understood, or if there isn't enough space at buffer
+ * to hold the entire selection (no INCR-mode transfers for this
+ * stuff!), then -1 is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkSelDefaultSelection(infoPtr, target, buffer, maxBytes, typePtr)
+ TkSelectionInfo *infoPtr; /* Info about selection being retrieved. */
+ Atom target; /* Desired form of selection. */
+ char *buffer; /* Place to put selection characters. */
+ int maxBytes; /* Maximum # of bytes to store at buffer. */
+ Atom *typePtr; /* Store here the type of the selection,
+ * for use in converting to proper X format. */
+{
+ register TkWindow *winPtr = (TkWindow *) infoPtr->owner;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+
+ if (target == dispPtr->timestampAtom) {
+ if (maxBytes < 20) {
+ return -1;
+ }
+ sprintf(buffer, "0x%x", (unsigned int) infoPtr->time);
+ *typePtr = XA_INTEGER;
+ return strlen(buffer);
+ }
+
+ if (target == dispPtr->targetsAtom) {
+ register TkSelHandler *selPtr;
+ char *atomString;
+ int length, atomLength;
+
+ if (maxBytes < 50) {
+ return -1;
+ }
+ strcpy(buffer, "MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW");
+ length = strlen(buffer);
+ for (selPtr = winPtr->selHandlerList; selPtr != NULL;
+ selPtr = selPtr->nextPtr) {
+ if ((selPtr->selection == infoPtr->selection)
+ && (selPtr->target != dispPtr->applicationAtom)
+ && (selPtr->target != dispPtr->windowAtom)) {
+ atomString = Tk_GetAtomName((Tk_Window) winPtr,
+ selPtr->target);
+ atomLength = strlen(atomString) + 1;
+ if ((length + atomLength) >= maxBytes) {
+ return -1;
+ }
+ sprintf(buffer+length, " %s", atomString);
+ length += atomLength;
+ }
+ }
+ *typePtr = XA_ATOM;
+ return length;
+ }
+
+ if (target == dispPtr->applicationAtom) {
+ int length;
+ char *name = winPtr->mainPtr->winPtr->nameUid;
+
+ length = strlen(name);
+ if (maxBytes <= length) {
+ return -1;
+ }
+ strcpy(buffer, name);
+ *typePtr = XA_STRING;
+ return length;
+ }
+
+ if (target == dispPtr->windowAtom) {
+ int length;
+ char *name = winPtr->pathName;
+
+ length = strlen(name);
+ if (maxBytes <= length) {
+ return -1;
+ }
+ strcpy(buffer, name);
+ *typePtr = XA_STRING;
+ return length;
+ }
+
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * LostSelection --
+ *
+ * This procedure is invoked when a window has lost ownership of
+ * the selection and the ownership was claimed with the command
+ * "selection own".
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Tcl script is executed; it can do almost anything.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+}
diff --git a/tk/generic/tkSelect.h b/tk/generic/tkSelect.h
new file mode 100644
index 00000000000..6065aa4b07d
--- /dev/null
+++ b/tk/generic/tkSelect.h
@@ -0,0 +1,184 @@
+/*
+ * 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$
+ */
+
+#ifndef _TKSELECT
+#define _TKSELECT
+
+/*
+ * When a selection is owned by a window on a given display, one of the
+ * following structures is present on a list of current selections in the
+ * display structure. The structure is used to record the current owner of
+ * a selection for use in later retrieval requests. There is a list of
+ * such structures because a display can have multiple different selections
+ * active at the same time.
+ */
+
+typedef struct TkSelectionInfo {
+ Atom selection; /* Selection name, e.g. XA_PRIMARY. */
+ Tk_Window owner; /* Current owner of this selection. */
+ int serial; /* Serial number of last XSelectionSetOwner
+ * request made to server for this
+ * selection (used to filter out redundant
+ * SelectionClear events). */
+ Time time; /* Timestamp used to acquire selection. */
+ Tk_LostSelProc *clearProc; /* Procedure to call when owner loses
+ * selection. */
+ ClientData clearData; /* Info to pass to clearProc. */
+ struct TkSelectionInfo *nextPtr;
+ /* Next in list of current selections on
+ * this display. NULL means end of list */
+} TkSelectionInfo;
+
+/*
+ * One of the following structures exists for each selection handler
+ * created for a window by calling Tk_CreateSelHandler. The handlers
+ * are linked in a list rooted in the TkWindow structure.
+ */
+
+typedef struct TkSelHandler {
+ Atom selection; /* Selection name, e.g. XA_PRIMARY */
+ Atom target; /* Target type for selection
+ * conversion, such as TARGETS or
+ * STRING. */
+ Atom format; /* Format in which selection
+ * info will be returned, such
+ * as STRING or ATOM. */
+ Tk_SelectionProc *proc; /* Procedure to generate selection
+ * in this format. */
+ ClientData clientData; /* Argument to pass to proc. */
+ int size; /* Size of units returned by proc
+ * (8 for STRING, 32 for almost
+ * anything else). */
+ struct TkSelHandler *nextPtr;
+ /* Next selection handler associated
+ * with same window (NULL for end of
+ * list). */
+} TkSelHandler;
+
+/*
+ * When the selection is being retrieved, one of the following
+ * structures is present on a list of pending selection retrievals.
+ * The structure is used to communicate between the background
+ * procedure that requests the selection and the foreground
+ * event handler that processes the events in which the selection
+ * is returned. There is a list of such structures so that there
+ * can be multiple simultaneous selection retrievals (e.g. on
+ * different displays).
+ */
+
+typedef struct TkSelRetrievalInfo {
+ Tcl_Interp *interp; /* Interpreter for error reporting. */
+ TkWindow *winPtr; /* Window used as requestor for
+ * selection. */
+ Atom selection; /* Selection being requested. */
+ Atom property; /* Property where selection will appear. */
+ Atom target; /* Desired form for selection. */
+ int (*proc) _ANSI_ARGS_((ClientData clientData, Tcl_Interp *interp,
+ char *portion)); /* Procedure to call to handle pieces
+ * of selection. */
+ ClientData clientData; /* Argument for proc. */
+ int result; /* Initially -1. Set to a Tcl
+ * return value once the selection
+ * has been retrieved. */
+ Tcl_TimerToken timeout; /* Token for current timeout procedure. */
+ int idleTime; /* Number of seconds that have gone by
+ * without hearing anything from the
+ * selection owner. */
+ struct TkSelRetrievalInfo *nextPtr;
+ /* Next in list of all pending
+ * selection retrievals. NULL means
+ * end of list. */
+} TkSelRetrievalInfo;
+
+/*
+ * The clipboard contains a list of buffers of various types and formats.
+ * All of the buffers of a given type will be returned in sequence when the
+ * CLIPBOARD selection is retrieved. All buffers of a given type on the
+ * same clipboard must have the same format. The TkClipboardTarget structure
+ * is used to record the information about a chain of buffers of the same
+ * type.
+ */
+
+typedef struct TkClipboardBuffer {
+ char *buffer; /* Null terminated data buffer. */
+ long length; /* Length of string in buffer. */
+ struct TkClipboardBuffer *nextPtr; /* Next in list of buffers. NULL
+ * means end of list . */
+} TkClipboardBuffer;
+
+typedef struct TkClipboardTarget {
+ Atom type; /* Type conversion supported. */
+ Atom format; /* Representation used for data. */
+ TkClipboardBuffer *firstBufferPtr; /* First in list of data buffers. */
+ TkClipboardBuffer *lastBufferPtr; /* Last in list of clipboard buffers.
+ * Used to speed up appends. */
+ struct TkClipboardTarget *nextPtr; /* Next in list of targets on
+ * clipboard. NULL means end of
+ * list. */
+} TkClipboardTarget;
+
+/*
+ * It is possible for a Tk_SelectionProc to delete the handler that it
+ * represents. If this happens, the code that is retrieving the selection
+ * needs to know about it so it doesn't use the now-defunct handler
+ * structure. One structure of the following form is created for each
+ * retrieval in progress, so that the retriever can find out if its
+ * handler is deleted. All of the pending retrievals (if there are more
+ * than one) are linked into a list.
+ */
+
+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,
+ Tk_GetSelProc *proc, ClientData clientData));
+#ifndef TkSelUpdateClipboard
+extern void TkSelUpdateClipboard _ANSI_ARGS_((TkWindow *winPtr,
+ TkClipboardTarget *targetPtr));
+#endif
+
+#endif /* _TKSELECT */
diff --git a/tk/generic/tkSquare.c b/tk/generic/tkSquare.c
new file mode 100644
index 00000000000..50484528d30
--- /dev/null
+++ b/tk/generic/tkSquare.c
@@ -0,0 +1,587 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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 --
+ *
+ * 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
+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);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SquareDisplay --
+ *
+ * This procedure redraws the contents of a square window.
+ * It is invoked as a do-when-idle handler, so it only runs
+ * when there's nothing else for the application to do.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SquareDestroy --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a square at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the square is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 --
+ *
+ * Adjust the position of the square if necessary to keep it in
+ * the widget's window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The x and y position of the square are adjusted if necessary
+ * to keep the square in the window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ }
+}
diff --git a/tk/generic/tkTest.c b/tk/generic/tkTest.c
new file mode 100644
index 00000000000..e33d6b62853
--- /dev/null
+++ b/tk/generic/tkTest.c
@@ -0,0 +1,1135 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+#ifdef __WIN32__
+#include "tkWinInt.h"
+#endif
+
+#ifdef MAC_TCL
+#include "tkScrollbar.h"
+#endif
+
+#ifdef __UNIX__
+#include "tkUnixInt.h"
+#endif
+
+/*
+ * The following data structure represents the master for a test
+ * image:
+ */
+
+typedef struct TImageMaster {
+ Tk_ImageMaster master; /* Tk's token for image master. */
+ Tcl_Interp *interp; /* Interpreter for application. */
+ int width, height; /* Dimensions of image. */
+ char *imageName; /* Name of image (malloc-ed). */
+ char *varName; /* Name of variable in which to log
+ * events for image (malloc-ed). */
+} TImageMaster;
+
+/*
+ * The following data structure represents a particular use of a
+ * particular test image.
+ */
+
+typedef struct TImageInstance {
+ TImageMaster *masterPtr; /* Pointer to master for image. */
+ XColor *fg; /* Foreground color for drawing in image. */
+ GC gc; /* Graphics context for drawing in image. */
+} TImageInstance;
+
+/*
+ * The type record for test images:
+ */
+
+static int ImageCreate _ANSI_ARGS_((Tcl_Interp *interp,
+ char *name, int argc, Tcl_Obj *CONST objv[],
+ Tk_ImageType *typePtr, Tk_ImageMaster master,
+ ClientData *clientDataPtr));
+static ClientData ImageGet _ANSI_ARGS_((Tk_Window tkwin,
+ ClientData clientData));
+static void ImageDisplay _ANSI_ARGS_((ClientData clientData,
+ Display *display, Drawable drawable,
+ int imageX, int imageY, int width,
+ int height, int drawableX,
+ int drawableY));
+static void ImageFree _ANSI_ARGS_((ClientData clientData,
+ Display *display));
+static void ImageDelete _ANSI_ARGS_((ClientData clientData));
+
+static Tk_ImageType imageType = {
+ "test", /* name */
+ ImageCreate, /* createProc */
+ ImageGet, /* getProc */
+ ImageDisplay, /* displayProc */
+ ImageFree, /* freeProc */
+ ImageDelete, /* deleteProc */
+ (Tk_ImageType *) NULL /* nextPtr */
+};
+
+/*
+ * One of the following structures describes each of the interpreters
+ * created by the "testnewapp" command. This information is used by
+ * the "testdeleteinterps" command to destroy all of those interpreters.
+ */
+
+typedef struct NewApp {
+ Tcl_Interp *interp; /* Token for interpreter. */
+ struct NewApp *nextPtr; /* Next in list of new interpreters. */
+} NewApp;
+
+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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tktest_Init(interp)
+ Tcl_Interp *interp; /* Interpreter for application. */
+{
+ static int initialized = 0;
+
+ /*
+ * 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.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Depends on option; see below.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TestcbindCmd(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;
+ Tk_Window tkwin;
+ ClientData object;
+ CBinding *cbindPtr;
+
+
+ if (argc < 4 || argc > 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " bindtag pattern command ?deletecommand?", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ tkwin = (Tk_Window) clientData;
+
+ if (argv[1][0] == '.') {
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[1], tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ object = (ClientData) winPtr->pathName;
+ } else {
+ winPtr = (TkWindow *) clientData;
+ object = (ClientData) Tk_GetUid(argv[1]);
+ }
+
+ if (argv[3][0] == '\0') {
+ return Tk_DeleteBinding(interp, winPtr->mainPtr->bindingTable,
+ object, argv[2]);
+ }
+
+ cbindPtr = (CBinding *) ckalloc(sizeof(CBinding));
+ cbindPtr->interp = interp;
+ cbindPtr->command =
+ strcpy((char *) ckalloc(strlen(argv[3]) + 1), argv[3]);
+ if (argc == 4) {
+ cbindPtr->delete = NULL;
+ } else {
+ cbindPtr->delete =
+ strcpy((char *) ckalloc(strlen(argv[4]) + 1), argv[4]);
+ }
+
+ if (TkCreateBindingProcedure(interp, winPtr->mainPtr->bindingTable,
+ object, argv[2], CBindingEvalProc, CBindingFreeProc,
+ (ClientData) cbindPtr) == 0) {
+ ckfree((char *) cbindPtr->command);
+ if (cbindPtr->delete != NULL) {
+ ckfree((char *) cbindPtr->delete);
+ }
+ ckfree((char *) cbindPtr);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+static int
+CBindingEvalProc(clientData, interp, eventPtr, tkwin, keySym)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ XEvent *eventPtr;
+ Tk_Window tkwin;
+ KeySym keySym;
+{
+ CBinding *cbindPtr;
+
+ cbindPtr = (CBinding *) clientData;
+
+ return Tcl_GlobalEval(interp, cbindPtr->command);
+}
+
+static void
+CBindingFreeProc(clientData)
+ ClientData clientData;
+{
+ CBinding *cbindPtr = (CBinding *) clientData;
+
+ if (cbindPtr->delete != NULL) {
+ Tcl_GlobalEval(cbindPtr->interp, cbindPtr->delete);
+ ckfree((char *) cbindPtr->delete);
+ }
+ 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.
+ *
+ * Side effects:
+ * All the intepreters created by previous calls to "testnewapp"
+ * get deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestdeleteappsCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ NewApp *nextPtr;
+
+ while (newAppPtr != NULL) {
+ nextPtr = newAppPtr->nextPtr;
+ Tcl_DeleteInterp(newAppPtr->interp);
+ ckfree((char *) newAppPtr);
+ newAppPtr = nextPtr;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageCreate --
+ *
+ * This procedure is called by the Tk image code to create "test"
+ * images.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * The data structure for a new image is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ImageCreate(interp, name, argc, objv, typePtr, master, clientDataPtr)
+ Tcl_Interp *interp; /* Interpreter for application containing
+ * image. */
+ char *name; /* Name to use for image. */
+ int argc; /* Number of arguments. */
+ Tcl_Obj *CONST objv[]; /* Argument strings for options (doesn't
+ * include image name or type). */
+ Tk_ImageType *typePtr; /* Pointer to our type record (not used). */
+ Tk_ImageMaster master; /* Token for image, to be used by us in
+ * later callbacks. */
+ ClientData *clientDataPtr; /* Store manager's token for image here;
+ * it will be returned in later callbacks. */
+{
+ TImageMaster *timPtr;
+ char *varName;
+ int i;
+
+ varName = "log";
+ for (i = 0; i < argc; i += 2) {
+ char *arg = Tcl_GetStringFromObj(objv[i], NULL);
+ if (strcmp(arg, "-variable") != 0) {
+ Tcl_AppendResult(interp, "bad option name \"", arg,
+ "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if ((i+1) == argc) {
+ Tcl_AppendResult(interp, "no value given for \"", arg,
+ "\" option", (char *) NULL);
+ return TCL_ERROR;
+ }
+ varName = Tcl_GetStringFromObj(objv[i+1], NULL);
+ }
+ timPtr = (TImageMaster *) ckalloc(sizeof(TImageMaster));
+ timPtr->master = master;
+ timPtr->interp = interp;
+ timPtr->width = 30;
+ timPtr->height = 15;
+ timPtr->imageName = (char *) ckalloc((unsigned) (strlen(name) + 1));
+ strcpy(timPtr->imageName, name);
+ timPtr->varName = (char *) ckalloc((unsigned) (strlen(varName) + 1));
+ strcpy(timPtr->varName, varName);
+ Tcl_CreateCommand(interp, name, ImageCmd, (ClientData) timPtr,
+ (Tcl_CmdDeleteProc *) NULL);
+ *clientDataPtr = (ClientData) timPtr;
+ Tk_ImageChanged(master, 0, 0, 30, 15, 30, 15);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageCmd --
+ *
+ * This procedure implements the commands corresponding to individual
+ * images.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Forces windows to be created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+ImageCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ TImageMaster *timPtr = (TImageMaster *) clientData;
+ int x, y, width, height;
+
+ if (argc < 2) {
+ 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)
+ || (Tcl_GetInt(interp, argv[6], &timPtr->width) != TCL_OK)
+ || (Tcl_GetInt(interp, argv[7], &timPtr->height) != TCL_OK)) {
+ return TCL_ERROR;
+ }
+ Tk_ImageChanged(timPtr->master, x, y, width, height, timPtr->width,
+ timPtr->height);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be changed", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageGet --
+ *
+ * This procedure is called by Tk to set things up for using a
+ * test image in a particular widget.
+ *
+ * Results:
+ * The return value is a token for the image instance, which is
+ * used in future callbacks to ImageDisplay and ImageFree.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static ClientData
+ImageGet(tkwin, clientData)
+ Tk_Window tkwin; /* Token for window in which image will
+ * be used. */
+ ClientData clientData; /* Pointer to TImageMaster for image. */
+{
+ TImageMaster *timPtr = (TImageMaster *) clientData;
+ TImageInstance *instPtr;
+ char buffer[100];
+ XGCValues gcValues;
+
+ sprintf(buffer, "%s get", timPtr->imageName);
+ Tcl_SetVar(timPtr->interp, timPtr->varName, buffer,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+
+ instPtr = (TImageInstance *) ckalloc(sizeof(TImageInstance));
+ instPtr->masterPtr = timPtr;
+ instPtr->fg = Tk_GetColor(timPtr->interp, tkwin, "#ff0000");
+ gcValues.foreground = instPtr->fg->pixel;
+ instPtr->gc = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ return (ClientData) instPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageDisplay --
+ *
+ * This procedure is invoked to redisplay part or all of an
+ * image in a given drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image gets partially redrawn, as an "X" that shows the
+ * exact redraw area.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageDisplay(clientData, display, drawable, imageX, imageY, width, height,
+ drawableX, drawableY)
+ ClientData clientData; /* Pointer to TImageInstance for image. */
+ Display *display; /* Display to use for drawing. */
+ Drawable drawable; /* Where to redraw image. */
+ 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)) {
+ width = instPtr->masterPtr->width - imageX;
+ }
+ if (height > (instPtr->masterPtr->height - imageY)) {
+ height = instPtr->masterPtr->height - imageY;
+ }
+ XDrawRectangle(display, drawable, instPtr->gc, drawableX, drawableY,
+ (unsigned) (width-1), (unsigned) (height-1));
+ XDrawLine(display, drawable, instPtr->gc, drawableX, drawableY,
+ (int) (drawableX + width - 1), (int) (drawableY + height - 1));
+ XDrawLine(display, drawable, instPtr->gc, drawableX,
+ (int) (drawableY + height - 1),
+ (int) (drawableX + width - 1), drawableY);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageFree --
+ *
+ * This procedure is called when an instance of an image is
+ * no longer used.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information related to the instance is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageFree(clientData, display)
+ ClientData clientData; /* Pointer to TImageInstance for instance. */
+ Display *display; /* Display where image was to be drawn. */
+{
+ TImageInstance *instPtr = (TImageInstance *) clientData;
+ char buffer[200];
+
+ sprintf(buffer, "%s free", instPtr->masterPtr->imageName);
+ Tcl_SetVar(instPtr->masterPtr->interp, instPtr->masterPtr->varName, buffer,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ Tk_FreeColor(instPtr->fg);
+ Tk_FreeGC(display, instPtr->gc);
+ ckfree((char *) instPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageDelete --
+ *
+ * This procedure is called to clean up a test image when
+ * an application goes away.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information about the image is deleted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ImageDelete(clientData)
+ ClientData clientData; /* Pointer to TImageMaster for image. When
+ * this procedure is called, no more
+ * instances exist. */
+{
+ TImageMaster *timPtr = (TImageMaster *) clientData;
+ char buffer[100];
+
+ sprintf(buffer, "%s delete", timPtr->imageName);
+ Tcl_SetVar(timPtr->interp, timPtr->varName, buffer,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+
+ Tcl_DeleteCommand(timPtr->interp, timPtr->imageName);
+ ckfree(timPtr->imageName);
+ ckfree(timPtr->varName);
+ ckfree((char *) timPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestmakeexistCmd --
+ *
+ * This procedure implements the "testmakeexist" command. It calls
+ * Tk_MakeWindowExist on each of its arguments to force the windows
+ * to be created.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Forces windows to be created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestmenubarCmd --
+ *
+ * This procedure implements the "testmenubar" command. It is used
+ * to test the Unix facilities for creating space above a toplevel
+ * window for a menubar.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Changes menubar related stuff.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+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
+ interp->result = "testmenubar is supported only under Unix";
+ return TCL_ERROR;
+#endif
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestmetricsCmd --
+ *
+ * This procedure implements the testmetrics command. It provides
+ * a way to determine the size of various widget components.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifdef __WIN32__
+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;
+ }
+
+ if (strcmp(argv[1], "cyvscroll") == 0) {
+ sprintf(buf, "%d", GetSystemMetrics(SM_CYVSCROLL));
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ } else if (strcmp(argv[1], "cxhscroll") == 0) {
+ sprintf(buf, "%d", GetSystemMetrics(SM_CXHSCROLL));
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be cxhscroll or cyvscroll", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+#endif
+#ifdef MAC_TCL
+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. */
+{
+ 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;
+ }
+
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+
+ if (strcmp(argv[1], "cyvscroll") == 0) {
+ sprintf(buf, "%d", ((TkScrollbar *) winPtr->instanceData)->width);
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ } else if (strcmp(argv[1], "cxhscroll") == 0) {
+ sprintf(buf, "%d", ((TkScrollbar *) winPtr->instanceData)->width);
+ Tcl_AppendResult(interp, buf, (char *) NULL);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be cxhscroll or cyvscroll", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestpropCmd --
+ *
+ * This procedure implements the "testprop" command. It fetches
+ * and prints the value of a property on a window.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+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) {
+ *p = '\n';
+ }
+ }
+ Tcl_SetResult(interp, property, TCL_VOLATILE);
+ } else {
+ for (p = property; length > 0; length--) {
+ if (actualFormat == 32) {
+ value = *((long *) p);
+ p += sizeof(long);
+ } else if (actualFormat == 16) {
+ value = 0xffff & (*((short *) p));
+ p += sizeof(short);
+ } else {
+ value = 0xff & *p;
+ p += 1;
+ }
+ sprintf(buffer, "0x%lx", value);
+ Tcl_AppendElement(interp, buffer);
+ }
+ }
+ }
+ if (property != NULL) {
+ XFree(property);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestsendCmd --
+ *
+ * This procedure implements the "testsend" command. It provides
+ * a set of functions for testing the "send" command and support
+ * procedure in tkSend.c.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Depends on option; see below.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+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;
+ }
+
+#if !(defined(__WIN32__) || defined(MAC_TCL))
+ if (strcmp(argv[1], "bogus") == 0) {
+ XChangeProperty(winPtr->dispPtr->display,
+ RootWindow(winPtr->dispPtr->display, 0),
+ winPtr->dispPtr->registryProperty, XA_INTEGER, 32,
+ PropModeReplace,
+ (unsigned char *) "This is bogus information", 6);
+ } else if (strcmp(argv[1], "prop") == 0) {
+ int result, actualFormat;
+ unsigned long length, bytesAfter;
+ Atom actualType, propName;
+ char *property, *p, *end;
+ Window w;
+
+ if ((argc != 4) && (argc != 5)) {
+ Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
+ " prop window name ?value ?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (strcmp(argv[2], "root") == 0) {
+ w = RootWindow(winPtr->dispPtr->display, 0);
+ } else if (strcmp(argv[2], "comm") == 0) {
+ w = Tk_WindowId(winPtr->dispPtr->commTkwin);
+ } else {
+ w = strtoul(argv[2], &end, 0);
+ }
+ propName = Tk_InternAtom((Tk_Window) winPtr, argv[3]);
+ if (argc == 4) {
+ property = NULL;
+ result = XGetWindowProperty(winPtr->dispPtr->display,
+ w, propName, 0, 100000, False, XA_STRING,
+ &actualType, &actualFormat, &length,
+ &bytesAfter, (unsigned char **) &property);
+ if ((result == Success) && (actualType != None)
+ && (actualFormat == 8) && (actualType == XA_STRING)) {
+ for (p = property; (p-property) < length; p++) {
+ if (*p == 0) {
+ *p = '\n';
+ }
+ }
+ Tcl_SetResult(interp, property, TCL_VOLATILE);
+ }
+ if (property != NULL) {
+ XFree(property);
+ }
+ } else {
+ if (argv[4][0] == 0) {
+ XDeleteProperty(winPtr->dispPtr->display, w, propName);
+ } else {
+ for (p = argv[4]; *p != 0; p++) {
+ if (*p == '\n') {
+ *p = 0;
+ }
+ }
+ 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))
+/*
+ *----------------------------------------------------------------------
+ *
+ * TestwrapperCmd --
+ *
+ * This procedure implements the "testwrapper" command. It
+ * provides a way from Tcl to determine the extra window Tk adds
+ * in between the toplevel window and the window decorations.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+TestwrapperCmd(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, *wrapperPtr;
+ Tk_Window tkwin;
+
+ if (argc != 2) {
+ Tcl_AppendResult(interp, "wrong # args; must be \"", argv[0],
+ " window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ tkwin = (Tk_Window) clientData;
+ 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
diff --git a/tk/generic/tkText.c b/tk/generic/tkText.c
new file mode 100644
index 00000000000..d9ff1cc9165
--- /dev/null
+++ b/tk/generic/tkText.c
@@ -0,0 +1,2364 @@
+/*
+ * tkText.c --
+ *
+ * This module provides a big chunk of the implementation of
+ * multi-line editable text widgets for Tk. Among other things,
+ * it provides the Tcl command interfaces to text widgets and
+ * the display code. The B-tree representation of text is
+ * implemented elsewhere.
+ *
+ * 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$
+ */
+
+#include "default.h"
+#include "tkPort.h"
+#include "tkInt.h"
+
+#ifdef MAC_TCL
+#define Style TkStyle
+#define DInfo TkDInfo
+#endif
+
+#include "tkText.h"
+
+/*
+ * Information used to parse text configuration options:
+ */
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_TEXT_BG_COLOR, Tk_Offset(TkText, border), TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-background", "background", "Background",
+ DEF_TEXT_BG_MONO, Tk_Offset(TkText, 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_TEXT_BORDER_WIDTH, Tk_Offset(TkText, borderWidth), 0},
+ {TK_CONFIG_ACTIVE_CURSOR, "-cursor", "cursor", "Cursor",
+ DEF_TEXT_CURSOR, Tk_Offset(TkText, cursor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BOOLEAN, "-exportselection", "exportSelection",
+ "ExportSelection", DEF_TEXT_EXPORT_SELECTION,
+ Tk_Offset(TkText, exportSelection), 0},
+ {TK_CONFIG_SYNONYM, "-fg", "foreground", (char *) NULL,
+ (char *) NULL, 0, 0},
+ {TK_CONFIG_FONT, "-font", "font", "Font",
+ DEF_TEXT_FONT, Tk_Offset(TkText, tkfont), 0},
+ {TK_CONFIG_COLOR, "-foreground", "foreground", "Foreground",
+ DEF_TEXT_FG, Tk_Offset(TkText, fgColor), 0},
+ {TK_CONFIG_PIXELS, "-height", "height", "Height",
+ DEF_TEXT_HEIGHT, Tk_Offset(TkText, height), 0},
+ {TK_CONFIG_COLOR, "-highlightbackground", "highlightBackground",
+ "HighlightBackground", DEF_TEXT_HIGHLIGHT_BG,
+ Tk_Offset(TkText, highlightBgColorPtr), 0},
+ {TK_CONFIG_COLOR, "-highlightcolor", "highlightColor", "HighlightColor",
+ DEF_TEXT_HIGHLIGHT, Tk_Offset(TkText, highlightColorPtr), 0},
+ {TK_CONFIG_PIXELS, "-highlightthickness", "highlightThickness",
+ "HighlightThickness",
+ DEF_TEXT_HIGHLIGHT_WIDTH, Tk_Offset(TkText, highlightWidth), 0},
+ {TK_CONFIG_BORDER, "-insertbackground", "insertBackground", "Foreground",
+ DEF_TEXT_INSERT_BG, Tk_Offset(TkText, insertBorder), 0},
+ {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
+ DEF_TEXT_INSERT_BD_COLOR, Tk_Offset(TkText, insertBorderWidth),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_PIXELS, "-insertborderwidth", "insertBorderWidth", "BorderWidth",
+ DEF_TEXT_INSERT_BD_MONO, Tk_Offset(TkText, insertBorderWidth),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_INT, "-insertofftime", "insertOffTime", "OffTime",
+ DEF_TEXT_INSERT_OFF_TIME, Tk_Offset(TkText, insertOffTime), 0},
+ {TK_CONFIG_INT, "-insertontime", "insertOnTime", "OnTime",
+ DEF_TEXT_INSERT_ON_TIME, Tk_Offset(TkText, insertOnTime), 0},
+ {TK_CONFIG_PIXELS, "-insertwidth", "insertWidth", "InsertWidth",
+ DEF_TEXT_INSERT_WIDTH, Tk_Offset(TkText, insertWidth), 0},
+ {TK_CONFIG_PIXELS, "-padx", "padX", "Pad",
+ DEF_TEXT_PADX, Tk_Offset(TkText, padX), 0},
+ {TK_CONFIG_PIXELS, "-pady", "padY", "Pad",
+ DEF_TEXT_PADY, Tk_Offset(TkText, padY), 0},
+ {TK_CONFIG_RELIEF, "-relief", "relief", "Relief",
+ DEF_TEXT_RELIEF, Tk_Offset(TkText, relief), 0},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_TEXT_SELECT_COLOR, Tk_Offset(TkText, selBorder),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_BORDER, "-selectbackground", "selectBackground", "Foreground",
+ DEF_TEXT_SELECT_MONO, Tk_Offset(TkText, selBorder),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_STRING, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
+ DEF_TEXT_SELECT_BD_COLOR, Tk_Offset(TkText, selBdString),
+ TK_CONFIG_COLOR_ONLY|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-selectborderwidth", "selectBorderWidth", "BorderWidth",
+ DEF_TEXT_SELECT_BD_MONO, Tk_Offset(TkText, selBdString),
+ TK_CONFIG_MONO_ONLY|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_TEXT_SELECT_FG_COLOR, Tk_Offset(TkText, selFgColorPtr),
+ TK_CONFIG_COLOR_ONLY},
+ {TK_CONFIG_COLOR, "-selectforeground", "selectForeground", "Background",
+ DEF_TEXT_SELECT_FG_MONO, Tk_Offset(TkText, selFgColorPtr),
+ TK_CONFIG_MONO_ONLY},
+ {TK_CONFIG_BOOLEAN, "-setgrid", "setGrid", "SetGrid",
+ DEF_TEXT_SET_GRID, Tk_Offset(TkText, setGrid), 0},
+ {TK_CONFIG_PIXELS, "-spacing1", "spacing1", "Spacing",
+ DEF_TEXT_SPACING1, Tk_Offset(TkText, spacing1),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_PIXELS, "-spacing2", "spacing2", "Spacing",
+ DEF_TEXT_SPACING2, Tk_Offset(TkText, spacing2),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_PIXELS, "-spacing3", "spacing3", "Spacing",
+ DEF_TEXT_SPACING3, Tk_Offset(TkText, spacing3),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_UID, "-state", "state", "State",
+ DEF_TEXT_STATE, Tk_Offset(TkText, state), 0},
+ {TK_CONFIG_STRING, "-tabs", "tabs", "Tabs",
+ DEF_TEXT_TABS, Tk_Offset(TkText, tabOptionString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-takefocus", "takeFocus", "TakeFocus",
+ DEF_TEXT_TAKE_FOCUS, Tk_Offset(TkText, takeFocus),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_INT, "-width", "width", "Width",
+ DEF_TEXT_WIDTH, Tk_Offset(TkText, width), 0},
+ {TK_CONFIG_UID, "-wrap", "wrap", "Wrap",
+ DEF_TEXT_WRAP, Tk_Offset(TkText, wrapMode), 0},
+ {TK_CONFIG_STRING, "-xscrollcommand", "xScrollCommand", "ScrollCommand",
+ DEF_TEXT_XSCROLL_COMMAND, Tk_Offset(TkText, xScrollCmd),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-yscrollcommand", "yScrollCommand", "ScrollCommand",
+ DEF_TEXT_YSCROLL_COMMAND, Tk_Offset(TkText, yScrollCmd),
+ TK_CONFIG_NULL_OK},
+
+ {TK_CONFIG_STRING, "-synccommand", "syncCommand", "SyncCommand",
+ DEF_TEXT_YSCROLL_COMMAND, Tk_Offset(TkText, SyncCmd),
+ TK_CONFIG_NULL_OK},
+
+
+ {TK_CONFIG_INT, "-tabsize", "tabSize", "TabSize",
+ DEF_TEXT_TAB_SIZE, Tk_Offset(TkText, tabsize), 0},
+
+ {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;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int ConfigureText _ANSI_ARGS_((Tcl_Interp *interp,
+ TkText *textPtr, int argc, char **argv, int flags));
+static int DeleteChars _ANSI_ARGS_((TkText *textPtr,
+ char *index1String, char *index2String));
+static void DestroyText _ANSI_ARGS_((char *memPtr));
+static void InsertChars _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr, char *string));
+static void TextBlinkProc _ANSI_ARGS_((ClientData clientData));
+static void TextCmdDeletedProc _ANSI_ARGS_((
+ ClientData clientData));
+static void TextEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int TextFetchSelection _ANSI_ARGS_((ClientData clientData,
+ int offset, char *buffer, int maxBytes));
+static int TextSearchCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, char **argv));
+static int TextWidgetCmd _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, int argc, char **argv));
+static void TextWorldChanged _ANSI_ARGS_((
+ ClientData instanceData));
+static int TextDumpCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, char **argv));
+static void DumpLine _ANSI_ARGS_((Tcl_Interp *interp,
+ TkText *textPtr, int what, TkTextLine *linePtr,
+ int start, int end, int lineno, char *command));
+static int DumpSegment _ANSI_ARGS_((Tcl_Interp *interp, char *key,
+ char *value, char * command, int lineno, int offset,
+ int what));
+
+/*
+ * The structure below defines text class behavior by means of procedures
+ * that can be invoked from generic window code.
+ */
+
+static TkClassProcs textClass = {
+ NULL, /* createProc. */
+ TextWorldChanged, /* geometryProc. */
+ NULL /* modalProc. */
+};
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_TextCmd --
+ *
+ * This procedure is invoked to process the "text" 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_TextCmd(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 TkText *textPtr;
+ TkTextIndex startIndex;
+
+ 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;
+ }
+
+ textPtr = (TkText *) ckalloc(sizeof(TkText));
+ textPtr->tkwin = new;
+ textPtr->display = Tk_Display(new);
+ textPtr->interp = interp;
+ textPtr->widgetCmd = Tcl_CreateCommand(interp,
+ Tk_PathName(textPtr->tkwin), TextWidgetCmd,
+ (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->tabsize = 8;
+ 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;
+ textPtr->insertMarkPtr = NULL;
+ textPtr->insertBorder = NULL;
+ textPtr->insertWidth = 0;
+ textPtr->insertBorderWidth = 0;
+ textPtr->insertOnTime = 0;
+ textPtr->insertOffTime = 0;
+ textPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ textPtr->bindingTable = NULL;
+ textPtr->currentMarkPtr = NULL;
+ textPtr->pickEvent.type = LeaveNotify;
+ textPtr->pickEvent.xcrossing.x = 0;
+ textPtr->pickEvent.xcrossing.y = 0;
+ textPtr->numCurTags = 0;
+ textPtr->curTagArrayPtr = NULL;
+ textPtr->takeFocus = NULL;
+ textPtr->xScrollCmd = NULL;
+ textPtr->yScrollCmd = NULL;
+
+ /*
+ * KHAMIS */
+ textPtr->SyncCmd = NULL;
+ 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextWidgetCmd --
+ *
+ * This procedure is invoked to process the Tcl command
+ * that corresponds to a text widget. See the user
+ * documentation for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+static int
+ExecSyncCmd (interp, textPtr, argc, argv)
+ Tcl_Interp *interp;
+ TkText *textPtr;
+ int argc;
+ char *argv[];
+{
+ static int ExecSyncCmdActive=0;
+ int i, ret;
+ Tcl_DString cmd;
+
+ if (ExecSyncCmdActive)
+ {
+ return TCL_OK;
+ }
+ ExecSyncCmdActive = 1;
+
+ Tcl_DStringInit (&cmd);
+ Tcl_DStringAppend (&cmd, textPtr->SyncCmd, -1);
+ for (i=1;i<argc;i++) {
+ Tcl_DStringAppendElement (&cmd, argv[i]);
+ }
+
+ ret = Tcl_Eval (interp, Tcl_DStringValue(&cmd));
+ Tcl_DStringFree (&cmd);
+
+ ExecSyncCmdActive = 0;
+
+ return ret;
+}
+
+static void
+ViewArgs (reason, argc, argv, mode)
+ char *reason;
+ int argc;
+ char *argv[];
+ int mode;
+{
+ int i;
+ if (reason)
+ {
+ fprintf (stderr, "%s\nused arguments:\n", reason);
+ }
+ for (i=0; i<argc; i++)
+ {
+ if (mode)
+ {
+ fprintf (stderr, "%s ", argv[i]);
+ }
+ else
+ {
+ fprintf (stderr, "argv[%i] = [%s]\n", i, argv[i]);
+ }
+ }
+ if (mode && mode != 2)
+ {
+ fprintf (stderr, "\n");
+ }
+}
+
+static int
+TextWidgetCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Information about text widget. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ int argc; /* Number of arguments. */
+ char **argv; /* Argument strings. */
+{
+ register TkText *textPtr = (TkText *) clientData;
+ int result = TCL_OK;
+ size_t length;
+ int c;
+ TkTextIndex index1, index2;
+
+ if (argc < 2) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_Preserve((ClientData) textPtr);
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 'b') && (strncmp(argv[1], "bbox", length) == 0)) {
+ int x, y, width, height;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " bbox index\"", (char *) NULL);
+ result = TCL_ERROR;
+ 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);
+ result = TCL_ERROR;
+ goto done;
+ }
+ result = Tk_ConfigureValue(interp, textPtr->tkwin, configSpecs,
+ (char *) textPtr, argv[2], 0);
+ } else if ((c == 'c') && (strncmp(argv[1], "compare", length) == 0)
+ && (length >= 3)) {
+ int relation, value;
+ char *p;
+
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " compare index1 op index2\"", (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ if ((TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK)
+ || (TkTextGetIndex(interp, textPtr, argv[4], &index2)
+ != TCL_OK)) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ relation = TkTextIndexCmp(&index1, &index2);
+ p = argv[3];
+ if (p[0] == '<') {
+ value = (relation < 0);
+ if ((p[1] == '=') && (p[2] == 0)) {
+ value = (relation <= 0);
+ } else if (p[1] != 0) {
+ compareError:
+ Tcl_AppendResult(interp, "bad comparison operator \"",
+ argv[3], "\": must be <, <=, ==, >=, >, or !=",
+ (char *) NULL);
+ result = TCL_ERROR;
+ goto done;
+ }
+ } else if (p[0] == '>') {
+ value = (relation > 0);
+ if ((p[1] == '=') && (p[2] == 0)) {
+ value = (relation >= 0);
+ } else if (p[1] != 0) {
+ goto compareError;
+ }
+ } 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,
+ (char *) textPtr, argv[2], 0);
+ } else {
+ result = ConfigureText(interp, textPtr, argc-2, argv+2,
+ TK_CONFIG_ARGV_ONLY);
+ }
+ } else if ((c == 'd') && (strncmp(argv[1], "debug", length) == 0)
+ && (length >= 3)) {
+ 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)) {
+
+/*ViewArgs ("editor", argc, argv, 0);*/
+
+ 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) {
+ /*
+ * KHAMIS
+ * Call synchronize command
+ * BEFORE INSERTING INTO THE EDITOR
+ ***********************************/
+ if (textPtr->SyncCmd && *textPtr->SyncCmd) {
+ result = ExecSyncCmd (interp, textPtr, argc, argv);
+ if (result == TCL_ERROR) {
+ goto done;
+ }
+ }
+ 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;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[2], &index1) != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (argc == 3) {
+ index2 = index1;
+ TkTextIndexForwChars(&index2, 1, &index2);
+ } else if (TkTextGetIndex(interp, textPtr, argv[3], &index2)
+ != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ if (TkTextIndexCmp(&index1, &index2) >= 0) {
+ goto done;
+ }
+ while (1) {
+ int offset, last, savedChar;
+ 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;
+
+/*ViewArgs ("editor", argc, argv, 0);*/
+
+ 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) {
+ /*
+ * KHAMIS
+ * Call synchronize command
+ * BEFORE INSERTING INTO THE EDITOR
+ ***********************************/
+ if (textPtr->SyncCmd && *textPtr->SyncCmd) {
+ result = ExecSyncCmd (interp, textPtr, argc, argv);
+ if (result == TCL_ERROR) {
+ goto done;
+ }
+ }
+ 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);
+ }
+ if (Tcl_SplitList(interp, argv[j+1], &numTags, &tagNames)
+ != TCL_OK) {
+ result = TCL_ERROR;
+ goto done;
+ }
+ for (i = 0; i < numTags; i++) {
+ TkBTreeTag(&index1, &index2,
+ TkTextCreateTag(textPtr, tagNames[i]), 1);
+ }
+ ckfree((char *) tagNames);
+ index1 = index2;
+ }
+ }
+ }
+ } else if ((c == 'd') && (strncmp(argv[1], "dump", length) == 0)) {
+ result = TextDumpCmd(textPtr, interp, argc, argv);
+ } else if ((c == 'i') && (strncmp(argv[1], "image", length) == 0)) {
+ result = TkTextImageCmd(textPtr, interp, argc, argv);
+ } else if ((c == 'm') && (strncmp(argv[1], "mark", length) == 0)) {
+ result = TkTextMarkCmd(textPtr, interp, argc, argv);
+ } else if ((c == 's') && (strcmp(argv[1], "scan") == 0) && (length >= 2)) {
+ result = TkTextScanCmd(textPtr, interp, argc, argv);
+ } else if ((c == 's') && (strcmp(argv[1], "search") == 0)
+ && (length >= 3)) {
+ result = TextSearchCmd(textPtr, interp, argc, argv);
+ } else if ((c == 's') && (strcmp(argv[1], "see") == 0) && (length >= 3)) {
+ result = TkTextSeeCmd(textPtr, interp, argc, argv);
+ } else if ((c == 't') && (strcmp(argv[1], "tag") == 0)) {
+ result = TkTextTagCmd(textPtr, interp, argc, argv);
+ } else if ((c == 'w') && (strncmp(argv[1], "window", length) == 0)) {
+ result = TkTextWindowCmd(textPtr, interp, argc, argv);
+ } else if ((c == 'x') && (strncmp(argv[1], "xview", length) == 0)) {
+ result = TkTextXviewCmd(textPtr, interp, argc, argv);
+ } else if ((c == 'y') && (strncmp(argv[1], "yview", length) == 0)
+ && (length >= 2)) {
+ result = TkTextYviewCmd(textPtr, interp, argc, argv);
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[1],
+ "\": must be bbox, cget, compare, configure, debug, delete, ",
+ "dlineinfo, get, image, index, insert, mark, scan, search, see, ",
+ "tag, window, xview, or yview",
+ (char *) NULL);
+ result = TCL_ERROR;
+ }
+
+ done:
+ Tcl_Release((ClientData) textPtr);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyText --
+ *
+ * This procedure is invoked by Tcl_EventuallyFree or Tcl_Release
+ * to clean up the internal structure of a text at a safe time
+ * (when no-one is using it anymore).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Everything associated with the text is freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyText(memPtr)
+ char *memPtr; /* Info about text widget. */
+{
+ register TkText *textPtr = (TkText *) memPtr;
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+ TkTextTag *tagPtr;
+
+ /*
+ * Free up all the stuff that requires special handling, then
+ * let Tk_FreeOptions handle all the standard option-related
+ * stuff. Special note: free up display-related information
+ * before deleting the B-tree, since display-related stuff
+ * may refer to stuff in the B-tree.
+ */
+
+ TkTextFreeDInfo(textPtr);
+ TkBTreeDestroy(textPtr->tree);
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->tagTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr);
+ TkTextFreeTag(textPtr, tagPtr);
+ }
+ Tcl_DeleteHashTable(&textPtr->tagTable);
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->markTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ ckfree((char *) Tcl_GetHashValue(hPtr));
+ }
+ Tcl_DeleteHashTable(&textPtr->markTable);
+ if (textPtr->tabArrayPtr != NULL) {
+ ckfree((char *) textPtr->tabArrayPtr);
+ }
+ if (textPtr->insertBlinkHandler != NULL) {
+ Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler);
+ }
+ if (textPtr->bindingTable != NULL) {
+ Tk_DeleteBindingTable(textPtr->bindingTable);
+ }
+
+ /*
+ * NOTE: do NOT free up selBorder, selBdString, or selFgColorPtr:
+ * they are duplicates of information in the "sel" tag, which was
+ * freed up as part of deleting the tags above.
+ */
+
+ textPtr->selBorder = NULL;
+ textPtr->selBdString = NULL;
+ textPtr->selFgColorPtr = NULL;
+ Tk_FreeOptions(configSpecs, (char *) textPtr, textPtr->display, 0);
+ ckfree((char *) textPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureText --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ConfigureText(interp, textPtr, argc, argv, flags)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ register TkText *textPtr; /* 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 = textPtr->exportSelection;
+
+ if (Tk_ConfigureWidget(interp, textPtr->tkwin, configSpecs,
+ argc, argv, (char *) textPtr, flags) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * 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.
+ */
+
+ if (textPtr->spacing1 < 0) {
+ textPtr->spacing1 = 0;
+ }
+ if (textPtr->spacing2 < 0) {
+ textPtr->spacing2 = 0;
+ }
+ if (textPtr->spacing3 < 0) {
+ textPtr->spacing3 = 0;
+ }
+
+ /*
+ * Parse tab stops.
+ */
+
+ if (textPtr->tabArrayPtr != NULL) {
+ ckfree((char *) textPtr->tabArrayPtr);
+ textPtr->tabArrayPtr = NULL;
+ }
+ if (textPtr->tabOptionString != NULL) {
+ textPtr->tabArrayPtr = TkTextGetTabs(interp, textPtr->tkwin,
+ textPtr->tabOptionString);
+ if (textPtr->tabArrayPtr == NULL) {
+ Tcl_AddErrorInfo(interp,"\n (while processing -tabs option)");
+ return TCL_ERROR;
+ }
+ }
+
+ /*
+ * Make sure that configuration options are properly mirrored
+ * between the widget record and the "sel" tags. NOTE: we don't
+ * have to free up information during the mirroring; old
+ * information was freed when it was replaced in the widget
+ * record.
+ */
+
+ textPtr->selTagPtr->border = textPtr->selBorder;
+ if (textPtr->selTagPtr->bdString != textPtr->selBdString) {
+ textPtr->selTagPtr->bdString = textPtr->selBdString;
+ if (textPtr->selBdString != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin, textPtr->selBdString,
+ &textPtr->selTagPtr->borderWidth) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (textPtr->selTagPtr->borderWidth < 0) {
+ textPtr->selTagPtr->borderWidth = 0;
+ }
+ }
+ }
+ textPtr->selTagPtr->fgColor = textPtr->selFgColorPtr;
+ textPtr->selTagPtr->affectsDisplay = 0;
+ if ((textPtr->selTagPtr->border != NULL)
+ || (textPtr->selTagPtr->bdString != NULL)
+ || (textPtr->selTagPtr->reliefString != NULL)
+ || (textPtr->selTagPtr->bgStipple != None)
+ || (textPtr->selTagPtr->fgColor != NULL)
+ || (textPtr->selTagPtr->tkfont != None)
+ || (textPtr->selTagPtr->fgStipple != None)
+ || (textPtr->selTagPtr->justifyString != NULL)
+ || (textPtr->selTagPtr->lMargin1String != NULL)
+ || (textPtr->selTagPtr->lMargin2String != NULL)
+ || (textPtr->selTagPtr->offsetString != NULL)
+ || (textPtr->selTagPtr->overstrikeString != NULL)
+ || (textPtr->selTagPtr->rMarginString != NULL)
+ || (textPtr->selTagPtr->spacing1String != NULL)
+ || (textPtr->selTagPtr->spacing2String != NULL)
+ || (textPtr->selTagPtr->spacing3String != NULL)
+ || (textPtr->selTagPtr->tabString != NULL)
+ || (textPtr->selTagPtr->underlineString != NULL)
+ || (textPtr->selTagPtr->wrapMode != NULL)) {
+ textPtr->selTagPtr->affectsDisplay = 1;
+ }
+ TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, (TkTextIndex *) NULL,
+ textPtr->selTagPtr, 1);
+
+ /*
+ * Claim the selection if we've suddenly started exporting it and there
+ * 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;
+ }
+ }
+
+ /*
+ * Register the desired geometry for the window, and arrange for
+ * the window to be redisplayed.
+ */
+
+ if (textPtr->width <= 0) {
+ textPtr->width = 1;
+ }
+ if (textPtr->height <= 0) {
+ textPtr->height = 1;
+ }
+ TextWorldChanged((ClientData) textPtr);
+ return TCL_OK;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TextWorldChanged --
+ *
+ * This procedure is called when the world has changed in some
+ * way and the widget needs to recompute all its graphics contexts
+ * and determine its new geometry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Configures all tags in the Text with a empty argc/argv, for
+ * the side effect of causing all the items to recompute their
+ * geometry and to be redisplayed.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static void
+TextWorldChanged(instanceData)
+ ClientData instanceData; /* Information about widget. */
+{
+ TkText *textPtr;
+ Tk_FontMetrics fm;
+
+ textPtr = (TkText *) instanceData;
+
+ textPtr->charWidth = Tk_TextWidth(textPtr->tkfont, "0", 1);
+ if (textPtr->charWidth <= 0) {
+ textPtr->charWidth = 1;
+ }
+ Tk_GetFontMetrics(textPtr->tkfont, &fm);
+ Tk_GeometryRequest(textPtr->tkwin,
+ textPtr->width * textPtr->charWidth + 2*textPtr->borderWidth
+ + 2*textPtr->padX + 2*textPtr->highlightWidth,
+ textPtr->height * (fm.linespace + textPtr->spacing1
+ + textPtr->spacing3) + 2*textPtr->borderWidth
+ + 2*textPtr->padY + 2*textPtr->highlightWidth);
+ Tk_SetInternalBorder(textPtr->tkwin,
+ textPtr->borderWidth + textPtr->highlightWidth);
+ if (textPtr->setGrid) {
+ Tk_SetGrid(textPtr->tkwin, textPtr->width, textPtr->height,
+ textPtr->charWidth, fm.linespace);
+ } else {
+ Tk_UnsetGrid(textPtr->tkwin);
+ }
+
+ TkTextRelayoutWindow(textPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TextEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher on
+ * structure changes to a text. For texts with 3D
+ * borders, this procedure is also invoked for exposures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+TextEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ register XEvent *eventPtr; /* Information about event. */
+{
+ register TkText *textPtr = (TkText *) clientData;
+ TkTextIndex index, index2;
+
+ if (eventPtr->type == Expose) {
+ TkTextRedrawRegion(textPtr, eventPtr->xexpose.x,
+ eventPtr->xexpose.y, eventPtr->xexpose.width,
+ eventPtr->xexpose.height);
+ } else if (eventPtr->type == ConfigureNotify) {
+ if ((textPtr->prevWidth != Tk_Width(textPtr->tkwin))
+ || (textPtr->prevHeight != Tk_Height(textPtr->tkwin))) {
+ TkTextRelayoutWindow(textPtr);
+ textPtr->prevWidth = Tk_Width(textPtr->tkwin);
+ textPtr->prevHeight = Tk_Height(textPtr->tkwin);
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ if (textPtr->tkwin != NULL) {
+ if (textPtr->setGrid) {
+ Tk_UnsetGrid(textPtr->tkwin);
+ }
+ textPtr->tkwin = NULL;
+ Tcl_DeleteCommandFromToken(textPtr->interp,
+ textPtr->widgetCmd);
+ }
+ Tcl_EventuallyFree((ClientData) textPtr, DestroyText);
+ } else if ((eventPtr->type == FocusIn) || (eventPtr->type == FocusOut)) {
+ if (eventPtr->xfocus.detail != NotifyInferior) {
+ Tcl_DeleteTimerHandler(textPtr->insertBlinkHandler);
+ if (eventPtr->type == FocusIn) {
+ textPtr->flags |= GOT_FOCUS | INSERT_ON;
+ if (textPtr->insertOffTime != 0) {
+ textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ textPtr->insertOnTime, TextBlinkProc,
+ (ClientData) textPtr);
+ }
+ } else {
+ textPtr->flags &= ~(GOT_FOCUS | INSERT_ON);
+ textPtr->insertBlinkHandler = (Tcl_TimerToken) NULL;
+ }
+#ifndef ALWAYS_SHOW_SELECTION
+ TkTextRedrawTag(textPtr, NULL, NULL, textPtr->selTagPtr, 1);
+#endif
+ TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
+ TkTextIndexForwChars(&index, 1, &index2);
+ TkTextChanged(textPtr, &index, &index2);
+ if (textPtr->highlightWidth > 0) {
+ TkTextRedrawRegion(textPtr, 0, 0, textPtr->highlightWidth,
+ textPtr->highlightWidth);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextCmdDeletedProc --
+ *
+ * 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
+TextCmdDeletedProc(clientData)
+ ClientData clientData; /* Pointer to widget record for widget. */
+{
+ TkText *textPtr = (TkText *) clientData;
+ Tk_Window tkwin = textPtr->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) {
+ if (textPtr->setGrid) {
+ Tk_UnsetGrid(textPtr->tkwin);
+ }
+ textPtr->tkwin = NULL;
+ Tk_DestroyWindow(tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InsertChars --
+ *
+ * This procedure implements most of the functionality of the
+ * "insert" widget command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The characters in "string" get added to the text just before
+ * the character indicated by "indexPtr".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InsertChars(textPtr, indexPtr, string)
+ TkText *textPtr; /* Overall information about text widget. */
+ TkTextIndex *indexPtr; /* Where to insert new characters. May be
+ * modified and/or invalidated. */
+ char *string; /* Null-terminated string containing new
+ * information to add to text. */
+{
+ int lineIndex, resetView, offset;
+ TkTextIndex newTop;
+
+ /*
+ * 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.
+ */
+
+ textPtr->abortSelections = 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteChars --
+ *
+ * This procedure implements most of the functionality of the
+ * "delete" widget command.
+ *
+ * Results:
+ * Returns a standard Tcl result, and leaves an error message
+ * in textPtr->interp if there is an error.
+ *
+ * Side effects:
+ * Characters get deleted from the text.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DeleteChars(textPtr, index1String, index2String)
+ TkText *textPtr; /* Overall information about text widget. */
+ 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)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (index2String != NULL) {
+ if (TkTextGetIndex(textPtr->interp, textPtr, index2String, &index2)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ } else {
+ index2 = index1;
+ TkTextIndexForwChars(&index2, 1, &index2);
+ }
+
+ /*
+ * Make sure there's really something to delete.
+ */
+
+ if (TkTextIndexCmp(&index1, &index2) >= 0) {
+ return TCL_OK;
+ }
+
+ /*
+ * The code below is ugly, but it's needed to make sure there
+ * is always a dummy empty line at the end of the text. If the
+ * final newline of the file (just before the dummy line) is being
+ * deleted, then back up index to just before the newline. If
+ * there is a newline just before the first character being deleted,
+ * then back up the first index too, so that an even number of lines
+ * gets deleted. Furthermore, remove any tags that are present on
+ * the newline that isn't going to be deleted after all (this simulates
+ * deleting the newline and then adding a "clean" one back again).
+ */
+
+ line1 = TkBTreeLineIndex(index1.linePtr);
+ line2 = TkBTreeLineIndex(index2.linePtr);
+ if (line2 == TkBTreeNumLines(textPtr->tree)) {
+ 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);
+ }
+ ckfree((char *) arrayPtr);
+ }
+ }
+
+ /*
+ * Tell the display what's about to happen so it can discard
+ * obsolete display information, then do the deletion. Also,
+ * 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.
+ */
+
+ textPtr->abortSelections = 1;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextFetchSelection --
+ *
+ * This procedure is called back by Tk when the selection is
+ * requested by someone. It returns part or all of the selection
+ * in a buffer provided by the caller.
+ *
+ * Results:
+ * The return value is the number of non-NULL bytes stored
+ * at buffer. Buffer is filled (or partially filled) with a
+ * NULL-terminated string containing part or all of the selection,
+ * as given by offset and maxBytes.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextFetchSelection(clientData, offset, buffer, maxBytes)
+ ClientData clientData; /* Information about text 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. */
+{
+ register TkText *textPtr = (TkText *) clientData;
+ TkTextIndex eof;
+ int count, chunkSize, offsetInSeg;
+ TkTextSearch search;
+ TkTextSegment *segPtr;
+
+ if (!textPtr->exportSelection) {
+ return -1;
+ }
+
+ /*
+ * Find the beginning of the next range of selected text. Note: if
+ * 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;
+ }
+ }
+ textPtr->selIndex = search.curIndex;
+ }
+
+ /*
+ * Each iteration through the outer loop below scans one selected range.
+ * Each iteration through the inner loop scans one segment in the
+ * selected range.
+ */
+
+ count = 0;
+ while (1) {
+ /*
+ * Find the end of the current range of selected text.
+ */
+
+ if (!TkBTreeNextTag(&search)) {
+ panic("TextFetchSelection couldn't find end of range");
+ }
+
+ /*
+ * Copy information from character segments into the buffer
+ * until either we run out of space in the buffer or we get
+ * to the end of this range of text.
+ */
+
+ while (1) {
+ if (maxBytes == 0) {
+ goto done;
+ }
+ segPtr = TkTextIndexToSeg(&textPtr->selIndex, &offsetInSeg);
+ 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.
+ */
+
+ if (!TkBTreeNextTag(&search)) {
+ break;
+ }
+ textPtr->selIndex = search.curIndex;
+ }
+
+ done:
+ *buffer = 0;
+ return count;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextLostSelection --
+ *
+ * This procedure is called back by Tk when the selection is
+ * grabbed away from a text widget. 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.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The "sel" tag is cleared from the window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextLostSelection(clientData)
+ ClientData clientData; /* Information about text widget. */
+{
+ register TkText *textPtr = (TkText *) clientData;
+#ifdef ALWAYS_SHOW_SELECTION
+ TkTextIndex start, end;
+
+ if (!textPtr->exportSelection) {
+ return;
+ }
+
+ /*
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextBlinkProc --
+ *
+ * This procedure is called as a timer handler to blink the
+ * insertion cursor off and on.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cursor gets turned on or off, redisplay gets invoked,
+ * and this procedure reschedules itself.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TextBlinkProc(clientData)
+ ClientData clientData; /* Pointer to record describing text. */
+{
+ register TkText *textPtr = (TkText *) clientData;
+ TkTextIndex index;
+ int x, y, w, h;
+
+ if (!(textPtr->flags & GOT_FOCUS) || (textPtr->insertOffTime == 0)) {
+ return;
+ }
+ if (textPtr->flags & INSERT_ON) {
+ textPtr->flags &= ~INSERT_ON;
+ textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ textPtr->insertOffTime, TextBlinkProc, (ClientData) textPtr);
+ } else {
+ textPtr->flags |= INSERT_ON;
+ textPtr->insertBlinkHandler = Tcl_CreateTimerHandler(
+ textPtr->insertOnTime, TextBlinkProc, (ClientData) textPtr);
+ }
+ TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
+ TkTextCharBbox(textPtr, &index, &x, &y, &w, &h);
+ TkTextRedrawRegion(textPtr, x - textPtr->insertWidth / 2, y,
+ textPtr->insertWidth, h);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextSearchCmd --
+ *
+ * This procedure is invoked to process the "search" widget command
+ * for text widgets. See the user documentation for details on what
+ * it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextSearchCmd(textPtr, interp, argc, argv)
+ 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;
+ Tcl_RegExp regexp = NULL; /* Initialization needed only to
+ * prevent compiler warning. */
+
+ /*
+ * Parse switches and other arguments.
+ */
+
+ exact = 1;
+ backwards = 0;
+ noCase = 0;
+ varName = NULL;
+ for (i = 2; i < argc; i++) {
+ arg = argv[i];
+ if (arg[0] != '-') {
+ break;
+ }
+ length = strlen(arg);
+ if (length < 2) {
+ badSwitch:
+ Tcl_AppendResult(interp, "bad switch \"", arg,
+ "\": must be -forward, -backward, -exact, -regexp, ",
+ "-nocase, -count, or --", (char *) NULL);
+ 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)) {
+ backwards = 0;
+ } else if ((c == 'n') && (strncmp(argv[i], "-nocase", length) == 0)) {
+ noCase = 1;
+ } else if ((c == 'r') && (strncmp(argv[i], "-regexp", length) == 0)) {
+ exact = 0;
+ } else if ((c == '-') && (strncmp(argv[i], "--", length) == 0)) {
+ i++;
+ break;
+ } else {
+ goto badSwitch;
+ }
+ }
+ argsLeft = argc - (i+2);
+ if ((argsLeft != 0) && (argsLeft != 1)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " search ?switches? pattern index ?stopIndex?",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ pattern = argv[i];
+
+ /*
+ * 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);
+ if (!backwards && (stopLine == numLines)) {
+ stopLine = numLines-1;
+ }
+ searchWholeText = 0;
+ } else {
+ stopLine = 0;
+ searchWholeText = 1;
+ }
+
+ /*
+ * Scan through all of the lines of the text circularly, starting
+ * at the given index.
+ */
+
+ matchLength = patLength = 0; /* Only needed to prevent compiler
+ * warnings. */
+ if (exact) {
+ patLength = strlen(pattern);
+ } else {
+ regexp = Tcl_RegExpCompile(interp, pattern);
+ if (regexp == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ lineNum = startingLine;
+ code = TCL_OK;
+ Tcl_DStringInit(&line);
+ for (passes = 0; passes < 2; ) {
+ if (lineNum >= numLines) {
+ /*
+ * Don't search the dummy last line of the text.
+ */
+
+ goto nextLine;
+ }
+
+ /*
+ * Extract the text from the line. If we're doing regular
+ * expression matching, drop the newline from the line, so
+ * that "$" can be used to match the end of the line.
+ */
+
+ linePtr = TkBTreeFindLine(textPtr->tree, lineNum);
+ for (segPtr = linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr != &tkTextCharType) {
+ continue;
+ }
+ Tcl_DStringAppend(&line, segPtr->body.chars, segPtr->size);
+ }
+ if (!exact) {
+ Tcl_DStringSetLength(&line, Tcl_DStringLength(&line)-1);
+ }
+ 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;
+ */
+
+ nextLine:
+ if (backwards) {
+ lineNum--;
+ if (!searchWholeText) {
+ if (lineNum < stopLine) {
+ break;
+ }
+ } else if (lineNum < 0) {
+ lineNum = numLines-1;
+ }
+ } else {
+ lineNum++;
+ if (!searchWholeText) {
+ if (lineNum > stopLine) {
+ break;
+ }
+ } else if (lineNum >= numLines) {
+ lineNum = 0;
+ }
+ }
+ Tcl_DStringSetLength(&line, 0);
+ }
+ done:
+ Tcl_DStringFree(&line);
+ if (noCase) {
+ Tcl_DStringFree(&patDString);
+ }
+ return code;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextGetTabs --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextTabArray *
+TkTextGetTabs(interp, tkwin, string)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ Tk_Window tkwin; /* Window in which the tabs will be
+ * used. */
+ 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
+ * tab array.
+ */
+
+ count = 0;
+ for (i = 0; i < argc; i++) {
+ c = argv[i][0];
+ if ((c != 'l') && (c != 'r') && (c != 'c') && (c != 'n')) {
+ count++;
+ }
+ }
+
+ /*
+ * Parse the elements of the list one at a time to fill in the
+ * array.
+ */
+
+ tabArrayPtr = (TkTextTabArray *) ckalloc((unsigned)
+ (sizeof(TkTextTabArray) + (count-1)*sizeof(TkTextTab)));
+ tabArrayPtr->numTabs = 0;
+ for (i = 0, tabPtr = &tabArrayPtr->tabs[0]; i < argc; i++, tabPtr++) {
+ if (Tk_GetPixels(interp, tkwin, argv[i], &tabPtr->location)
+ != TCL_OK) {
+ goto error;
+ }
+ tabArrayPtr->numTabs++;
+
+ /*
+ * See if there is an explicit alignment in the next list
+ * 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",
+ strlen(argv[i])) == 0)) {
+ tabPtr->alignment = CENTER;
+ } else if ((c == 'n') && (strncmp(argv[i],
+ "numeric", strlen(argv[i])) == 0)) {
+ tabPtr->alignment = NUMERIC;
+ } else {
+ Tcl_AppendResult(interp, "bad tab alignment \"",
+ argv[i], "\": must be left, right, center, or numeric",
+ (char *) NULL);
+ goto error;
+ }
+ }
+ ckfree((char *) argv);
+ return tabArrayPtr;
+
+ error:
+ ckfree((char *) tabArrayPtr);
+ ckfree((char *) argv);
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextDumpCmd --
+ *
+ * Return information about the text, tags, marks, and embedded windows
+ * and images in a text widget. See the man page for the description
+ * of the text dump operation for all the details.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Memory is allocated for the result, if needed (standard Tcl result
+ * side effects).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TextDumpCmd(textPtr, interp, argc, argv)
+ register TkText *textPtr; /* Information about text widget. */
+ 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 "dump". */
+{
+ TkTextIndex index1, index2;
+ int arg;
+ int lineno; /* Current line number */
+ int what = 0; /* bitfield to select segment types */
+ int atEnd; /* True if dumping up to logical end */
+ TkTextLine *linePtr;
+ char *command = NULL; /* Script callback to apply to segments */
+#define TK_DUMP_TEXT 0x1
+#define TK_DUMP_MARK 0x2
+#define TK_DUMP_TAG 0x4
+#define TK_DUMP_WIN 0x8
+#define TK_DUMP_IMG 0x10
+#define TK_DUMP_ALL (TK_DUMP_TEXT|TK_DUMP_MARK|TK_DUMP_TAG| \
+ TK_DUMP_WIN|TK_DUMP_IMG)
+
+ for (arg=2 ; argv[arg] != (char *) NULL ; arg++) {
+ size_t len;
+ if (argv[arg][0] != '-') {
+ break;
+ }
+ len = strlen(argv[arg]);
+ if (strncmp("-all", argv[arg], len) == 0) {
+ what = TK_DUMP_ALL;
+ } else if (strncmp("-text", argv[arg], len) == 0) {
+ what |= TK_DUMP_TEXT;
+ } else if (strncmp("-tag", argv[arg], len) == 0) {
+ what |= TK_DUMP_TAG;
+ } else if (strncmp("-mark", argv[arg], len) == 0) {
+ what |= TK_DUMP_MARK;
+ } else if (strncmp("-image", argv[arg], len) == 0) {
+ what |= TK_DUMP_IMG;
+ } else if (strncmp("-window", argv[arg], len) == 0) {
+ what |= TK_DUMP_WIN;
+ } else if (strncmp("-command", argv[arg], len) == 0) {
+ arg++;
+ if (arg >= argc) {
+ Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?", NULL);
+ return TCL_ERROR;
+ }
+ command = argv[arg];
+ } else {
+ Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?", NULL);
+ return TCL_ERROR;
+ }
+ }
+ if (arg >= argc) {
+ Tcl_AppendResult(interp, "Usage: ", argv[0], " dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?", NULL);
+ return TCL_ERROR;
+ }
+ if (what == 0) {
+ what = TK_DUMP_ALL;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[arg], &index1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ lineno = TkBTreeLineIndex(index1.linePtr) + 1;
+ arg++;
+ atEnd = 0;
+ if (argc == arg) {
+ TkTextIndexForwChars(&index1, 1, &index2);
+ } else {
+ if (TkTextGetIndex(interp, textPtr, argv[arg], &index2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (strncmp(argv[arg], "end", strlen(argv[arg])) == 0) {
+ atEnd = 1;
+ }
+ }
+ 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)) {
+ DumpSegment(interp, "tagon",
+ segPtr->body.toggle.tagPtr->name,
+ command, lineno, offset, what);
+ } else if ((what & TK_DUMP_TAG) &&
+ (segPtr->typePtr == &tkTextToggleOffType)) {
+ DumpSegment(interp, "tagoff",
+ segPtr->body.toggle.tagPtr->name,
+ command, lineno, offset, what);
+ } else if ((what & TK_DUMP_IMG) &&
+ (segPtr->typePtr->name[0] == 'i')) {
+ TkTextEmbImage *eiPtr = (TkTextEmbImage *)&segPtr->body;
+ char *name = (eiPtr->name == NULL) ? "" : eiPtr->name;
+ DumpSegment(interp, "image", name,
+ command, lineno, offset, what);
+ } else if ((what & TK_DUMP_WIN) &&
+ (segPtr->typePtr->name[0] == 'w')) {
+ TkTextEmbWindow *ewPtr = (TkTextEmbWindow *)&segPtr->body;
+ char *pathname;
+ if (ewPtr->tkwin == (Tk_Window) NULL) {
+ pathname = "";
+ } else {
+ pathname = Tk_PathName(ewPtr->tkwin);
+ }
+ DumpSegment(interp, "window", pathname,
+ command, lineno, offset, what);
+ }
+ }
+ }
+}
+
+/*
+ * DumpSegment
+ * Either append information about the current segment to the result,
+ * or make a script callback with that information as arguments.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Either evals the callback or appends elements to the result string.
+ */
+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];
+ char *list;
+ int result;
+ argv[0] = key;
+ argv[1] = value;
+ argv[2] = buffer;
+ argv[3] = (char *) NULL;
+ list = Tcl_Merge(3, argv);
+ result = Tcl_VarEval(interp, command, " ", list, (char *) NULL);
+ ckfree(list);
+ return result;
+ }
+}
+
diff --git a/tk/generic/tkText.h b/tk/generic/tkText.h
new file mode 100644
index 00000000000..e8c0ab2440e
--- /dev/null
+++ b/tk/generic/tkText.h
@@ -0,0 +1,857 @@
+/*
+ * 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$
+ */
+
+#ifndef _TKTEXT
+#define _TKTEXT
+
+#ifndef _TK
+#include "tk.h"
+#endif
+
+/*
+ * Opaque types for structures whose guts are only needed by a single
+ * file:
+ */
+
+typedef struct TkTextBTree *TkTextBTree;
+
+/*
+ * The data structure below defines a single line of text (from newline
+ * to newline, not necessarily what appears on one line of the screen).
+ */
+
+typedef struct TkTextLine {
+ struct Node *parentPtr; /* Pointer to parent node containing
+ * line. */
+ struct TkTextLine *nextPtr; /* Next in linked list of lines with
+ * same parent node in B-tree. NULL
+ * means end of list. */
+ struct TkTextSegment *segPtr; /* First in ordered list of segments
+ * that make up the line. */
+} TkTextLine;
+
+/*
+ * -----------------------------------------------------------------------
+ * Segments: each line is divided into one or more segments, where each
+ * segment is one of several things, such as a group of characters, a
+ * tag toggle, a mark, or an embedded widget. Each segment starts with
+ * a standard header followed by a body that varies from type to type.
+ * -----------------------------------------------------------------------
+ */
+
+/*
+ * The data structure below defines the body of a segment that represents
+ * a tag toggle. There is one of these structures at both the beginning
+ * and end of each tagged range.
+ */
+
+typedef struct TkTextToggle {
+ struct TkTextTag *tagPtr; /* Tag that starts or ends here. */
+ int inNodeCounts; /* 1 means this toggle has been
+ * accounted for in node toggle
+ * counts; 0 means it hasn't, yet. */
+} TkTextToggle;
+
+/*
+ * The data structure below defines line segments that represent
+ * marks. There is one of these for each mark in the text.
+ */
+
+typedef struct TkTextMark {
+ struct TkText *textPtr; /* Overall information about text
+ * widget. */
+ TkTextLine *linePtr; /* Line structure that contains the
+ * segment. */
+ Tcl_HashEntry *hPtr; /* Pointer to hash table entry for mark
+ * (in textPtr->markTable). */
+} TkTextMark;
+
+/*
+ * A structure of the following type holds information for each window
+ * embedded in a text widget. This information is only used by the
+ * file tkTextWind.c
+ */
+
+typedef struct TkTextEmbWindow {
+ struct TkText *textPtr; /* Information about the overall text
+ * widget. */
+ TkTextLine *linePtr; /* Line structure that contains this
+ * window. */
+ Tk_Window tkwin; /* Window for this segment. NULL
+ * means that the window hasn't
+ * been created yet. */
+ char *create; /* Script to create window on-demand.
+ * NULL means no such script.
+ * Malloc-ed. */
+ int align; /* How to align window in vertical
+ * space. See definitions in
+ * tkTextWind.c. */
+ int padX, padY; /* Padding to leave around each side
+ * of window, in pixels. */
+ int stretch; /* Should window stretch to fill
+ * vertical space of line (except for
+ * pady)? 0 or 1. */
+ int chunkCount; /* Number of display chunks that
+ * refer to this window. */
+ int displayed; /* Non-zero means that the window
+ * has been displayed on the screen
+ * recently. */
+} TkTextEmbWindow;
+
+/*
+ * A structure of the following type holds information for each image
+ * embedded in a text widget. This information is only used by the
+ * file tkTextImage.c
+ */
+
+typedef struct TkTextEmbImage {
+ struct TkText *textPtr; /* Information about the overall text
+ * widget. */
+ TkTextLine *linePtr; /* Line structure that contains this
+ * image. */
+ char *imageString; /* Name of the image for this segment */
+ char *imageName; /* Name used by text widget to identify
+ * this image. May be unique-ified */
+ char *name; /* Name used in the hash table.
+ * used by "image names" to identify
+ * this instance of the image */
+ Tk_Image image; /* Image for this segment. NULL
+ * means that the image hasn't
+ * been created yet. */
+ int align; /* How to align image in vertical
+ * space. See definitions in
+ * tkTextImage.c. */
+ int padX, padY; /* Padding to leave around each side
+ * of image, in pixels. */
+ int chunkCount; /* Number of display chunks that
+ * refer to this image. */
+} TkTextEmbImage;
+
+/*
+ * The data structure below defines line segments.
+ */
+
+typedef struct TkTextSegment {
+ struct Tk_SegType *typePtr; /* Pointer to record describing
+ * segment's type. */
+ struct TkTextSegment *nextPtr; /* Next in list of segments for this
+ * line, or NULL for end of list. */
+ int size; /* Size of this segment (# of bytes
+ * of index space it occupies). */
+ union {
+ char chars[4]; /* Characters that make up character
+ * info. Actual length varies to
+ * hold as many characters as needed.*/
+ TkTextToggle toggle; /* Information about tag toggle. */
+ TkTextMark mark; /* Information about mark. */
+ TkTextEmbWindow ew; /* Information about embedded
+ * window. */
+ TkTextEmbImage ei; /* Information about embedded
+ * image. */
+ } body;
+} TkTextSegment;
+
+/*
+ * Data structures of the type defined below are used during the
+ * execution of Tcl commands to keep track of various interesting
+ * places in a text. An index is only valid up until the next
+ * modification to the character structure of the b-tree so they
+ * can't be retained across Tcl commands. However, mods to marks
+ * 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:
+ */
+
+typedef struct TkTextDispChunk TkTextDispChunk;
+
+typedef void Tk_ChunkDisplayProc _ANSI_ARGS_((
+ TkTextDispChunk *chunkPtr, int x, int y,
+ int height, int baseline, Display *display,
+ Drawable dst, int screenY));
+typedef void Tk_ChunkUndisplayProc _ANSI_ARGS_((
+ struct TkText *textPtr,
+ TkTextDispChunk *chunkPtr));
+typedef int Tk_ChunkMeasureProc _ANSI_ARGS_((
+ TkTextDispChunk *chunkPtr, int x));
+typedef void Tk_ChunkBboxProc _ANSI_ARGS_((
+ TkTextDispChunk *chunkPtr, int index, int y,
+ int lineHeight, int baseline, int *xPtr,
+ int *yPtr, int *widthPtr, int *heightPtr));
+
+/*
+ * The structure below represents a chunk of stuff that is displayed
+ * together on the screen. This structure is allocated and freed by
+ * generic display code but most of its fields are filled in by
+ * segment-type-specific code.
+ */
+
+struct TkTextDispChunk {
+ /*
+ * The fields below are set by the type-independent code before
+ * calling the segment-type-specific layoutProc. They should not
+ * be modified by segment-type-specific code.
+ */
+
+ int x; /* X position of chunk, in pixels.
+ * This position is measured from the
+ * left edge of the logical line,
+ * not from the left edge of the
+ * window (i.e. it doesn't change
+ * under horizontal scrolling). */
+ struct TkTextDispChunk *nextPtr; /* Next chunk in the display line
+ * or NULL for the end of the list. */
+ struct TextStyle *stylePtr; /* Display information, known only
+ * to tkTextDisp.c. */
+
+ /*
+ * The fields below are set by the layoutProc that creates the
+ * chunk.
+ */
+
+ Tk_ChunkDisplayProc *displayProc; /* Procedure to invoke to draw this
+ * chunk on the display or an
+ * off-screen pixmap. */
+ Tk_ChunkUndisplayProc *undisplayProc;
+ /* 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. */
+};
+
+/*
+ * One data structure of the following type is used for each tag in a
+ * text widget. These structures are kept in textPtr->tagTable and
+ * referred to in other structures.
+ */
+
+typedef struct TkTextTag {
+ char *name; /* Name of this tag. This field is actually
+ * a pointer to the key from the entry in
+ * textPtr->tagTable, so it needn't be freed
+ * explicitly. */
+ int priority; /* Priority of this tag within widget. 0
+ * means lowest priority. Exactly one tag
+ * has each integer value between 0 and
+ * numTags-1. */
+ struct Node *tagRootPtr; /* Pointer into the B-Tree at the lowest
+ * node that completely dominates the ranges
+ * of text occupied by the tag. At this
+ * node there is no information about the
+ * tag. One or more children of the node
+ * do contain information about the tag. */
+ int toggleCount; /* Total number of tag toggles */
+
+ /*
+ * Information for displaying text with this tag. The information
+ * belows acts as an override on information specified by lower-priority
+ * tags. If no value is specified, then the next-lower-priority tag
+ * on the text determins the value. The text widget itself provides
+ * defaults if no tag specifies an override.
+ */
+
+ Tk_3DBorder border; /* Used for drawing background. NULL means
+ * no value specified here. */
+ char *bdString; /* -borderwidth option string (malloc-ed).
+ * NULL means option not specified. */
+ int borderWidth; /* Width of 3-D border for background. */
+ char *reliefString; /* -relief option string (malloc-ed).
+ * NULL means option not specified. */
+ int relief; /* 3-D relief for background. */
+ Pixmap bgStipple; /* Stipple bitmap for background. None
+ * means no value specified here. */
+ XColor *fgColor; /* Foreground color for text. NULL means
+ * no value specified here. */
+ Tk_Font tkfont; /* Font for displaying text. NULL means
+ * no value specified here. */
+ Pixmap fgStipple; /* Stipple bitmap for text and other
+ * foreground stuff. None means no value
+ * specified here.*/
+ char *justifyString; /* -justify option string (malloc-ed).
+ * NULL means option not specified. */
+ Tk_Justify justify; /* How to justify text: TK_JUSTIFY_LEFT,
+ * TK_JUSTIFY_RIGHT, or TK_JUSTIFY_CENTER.
+ * Only valid if justifyString is non-NULL. */
+ char *lMargin1String; /* -lmargin1 option string (malloc-ed).
+ * NULL means option not specified. */
+ int lMargin1; /* Left margin for first display line of
+ * each text line, in pixels. Only valid
+ * if lMargin1String is non-NULL. */
+ char *lMargin2String; /* -lmargin2 option string (malloc-ed).
+ * NULL means option not specified. */
+ int lMargin2; /* Left margin for second and later display
+ * lines of each text line, in pixels. Only
+ * valid if lMargin2String is non-NULL. */
+ char *offsetString; /* -offset option string (malloc-ed).
+ * NULL means option not specified. */
+ int offset; /* Vertical offset of text's baseline from
+ * baseline of line. Used for superscripts
+ * and subscripts. Only valid if
+ * offsetString is non-NULL. */
+ char *overstrikeString; /* -overstrike option string (malloc-ed).
+ * NULL means option not specified. */
+ int overstrike; /* Non-zero means draw horizontal line through
+ * middle of text. Only valid if
+ * overstrikeString is non-NULL. */
+ char *rMarginString; /* -rmargin option string (malloc-ed).
+ * NULL means option not specified. */
+ int rMargin; /* Right margin for text, in pixels. Only
+ * valid if rMarginString is non-NULL. */
+ char *spacing1String; /* -spacing1 option string (malloc-ed).
+ * NULL means option not specified. */
+ int spacing1; /* Extra spacing above first display
+ * line for text line. Only valid if
+ * spacing1String is non-NULL. */
+ char *spacing2String; /* -spacing2 option string (malloc-ed).
+ * NULL means option not specified. */
+ int spacing2; /* Extra spacing between display
+ * lines for the same text line. Only valid
+ * if spacing2String is non-NULL. */
+ char *spacing3String; /* -spacing2 option string (malloc-ed).
+ * NULL means option not specified. */
+ int spacing3; /* Extra spacing below last display
+ * line for text line. Only valid if
+ * spacing3String is non-NULL. */
+ char *tabString; /* -tabs option string (malloc-ed).
+ * NULL means option not specified. */
+ struct TkTextTabArray *tabArrayPtr;
+ /* Info about tabs for tag (malloc-ed)
+ * or NULL. Corresponds to tabString. */
+ char *underlineString; /* -underline option string (malloc-ed).
+ * NULL means option not specified. */
+ int underline; /* Non-zero means draw underline underneath
+ * text. Only valid if underlineString is
+ * non-NULL. */
+ Tk_Uid wrapMode; /* How to handle wrap-around for this tag.
+ * Must be tkTextCharUid, tkTextNoneUid,
+ * tkTextWordUid, or NULL to use wrapMode
+ * for whole widget. */
+ int affectsDisplay; /* Non-zero means that this tag affects the
+ * way information is displayed on the screen
+ * (so need to redisplay if tag changes). */
+} TkTextTag;
+
+#define TK_TAG_AFFECTS_DISPLAY 0x1
+#define TK_TAG_UNDERLINE 0x2
+#define TK_TAG_JUSTIFY 0x4
+#define TK_TAG_OFFSET 0x10
+
+/*
+ * The data structure below is used for searching a B-tree for transitions
+ * on a single tag (or for all tag transitions). No code outside of
+ * tkTextBTree.c should ever modify any of the fields in these structures,
+ * but it's OK to use them for read-only information.
+ */
+
+typedef struct TkTextSearch {
+ TkTextIndex curIndex; /* Position of last tag transition
+ * returned by TkBTreeNextTag, or
+ * index of start of segment
+ * containing starting position for
+ * search if TkBTreeNextTag hasn't
+ * been called yet, or same as
+ * stopIndex if search is over. */
+ TkTextSegment *segPtr; /* Actual tag segment returned by last
+ * call to TkBTreeNextTag, or NULL if
+ * TkBTreeNextTag hasn't returned
+ * anything yet. */
+ TkTextSegment *nextPtr; /* Where to resume search in next
+ * call to TkBTreeNextTag. */
+ TkTextSegment *lastPtr; /* Stop search before just before
+ * considering this segment. */
+ TkTextTag *tagPtr; /* Tag to search for (or tag found, if
+ * allTags is non-zero). */
+ int linesLeft; /* Lines left to search (including
+ * curIndex and stopIndex). When
+ * this becomes <= 0 the search is
+ * over. */
+ int allTags; /* Non-zero means ignore tag check:
+ * search for transitions on all
+ * tags. */
+} TkTextSearch;
+
+/*
+ * The following data structure describes a single tab stop.
+ */
+
+typedef enum {LEFT, RIGHT, CENTER, NUMERIC} TkTextTabAlign;
+
+typedef struct TkTextTab {
+ int location; /* Offset in pixels of this tab stop
+ * from the left margin (lmargin2) of
+ * the text. */
+ TkTextTabAlign alignment; /* Where the tab stop appears relative
+ * to the text. */
+} TkTextTab;
+
+typedef struct TkTextTabArray {
+ int numTabs; /* Number of tab stops. */
+ TkTextTab tabs[1]; /* Array of tabs. The actual size
+ * will be numTabs. THIS FIELD MUST
+ * BE THE LAST IN THE STRUCTURE. */
+} TkTextTabArray;
+
+/*
+ * A data structure of the following type is kept for each text widget that
+ * currently exists for this process:
+ */
+
+typedef struct TkText {
+ Tk_Window tkwin; /* Window that embodies the text. NULL
+ * means that the window has been destroyed
+ * but the data structures haven't yet been
+ * cleaned up.*/
+ Display *display; /* Display for widget. Needed, among other
+ * things, to allow resources to be freed
+ * even after tkwin has gone away. */
+ Tcl_Interp *interp; /* Interpreter associated with widget. Used
+ * to delete widget command. */
+ Tcl_Command widgetCmd; /* Token for text's widget command. */
+ TkTextBTree tree; /* B-tree representation of text and tags for
+ * widget. */
+ Tcl_HashTable tagTable; /* Hash table that maps from tag names to
+ * pointers to TkTextTag structures. */
+ int numTags; /* Number of tags currently defined for
+ * widget; needed to keep track of
+ * priorities. */
+ Tcl_HashTable markTable; /* Hash table that maps from mark names to
+ * pointers to mark segments. */
+ Tcl_HashTable windowTable; /* Hash table that maps from window names
+ * to pointers to window segments. If a
+ * window segment doesn't yet have an
+ * 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
+ * default background. */
+ int borderWidth; /* Width of 3-D border to draw around entire
+ * widget. */
+ int padX, padY; /* Padding between text and window border. */
+ int relief; /* 3-d effect for border around entire
+ * widget: 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. */
+ XColor *highlightBgColorPtr;
+ /* Color for drawing traversal highlight
+ * area when highlight is off. */
+ XColor *highlightColorPtr; /* Color for drawing traversal highlight. */
+ Tk_Cursor cursor; /* Current cursor for window, or None. */
+ XColor *fgColor; /* Default foreground color for text. */
+ Tk_Font tkfont; /* Default font for displaying text. */
+ int charWidth; /* Width of average character in default
+ * font. */
+ int spacing1; /* Default extra spacing above first display
+ * line for each text line. */
+ int spacing2; /* Default extra spacing between display lines
+ * for the same text line. */
+ int spacing3; /* Default extra spacing below last display
+ * line for each text line. */
+ char *tabOptionString; /* Value of -tabs option string (malloc'ed). */
+ TkTextTabArray *tabArrayPtr;
+ /* Information about tab stops (malloc'ed).
+ * NULL means perform default tabbing
+ * behavior. */
+
+ int tabsize; /* "-tabs" reconize only fixed placed tabs, but
+ * we need to have the behavior of a normal plain
+ * text editor (default is 8)
+ */
+
+ /*
+ * Additional information used for displaying:
+ */
+
+ Tk_Uid wrapMode; /* How to handle wrap-around. Must be
+ * tkTextCharUid, tkTextNoneUid, or
+ * tkTextWordUid. */
+ int width, height; /* Desired dimensions for window, measured
+ * in characters. */
+ int setGrid; /* Non-zero means pass gridding information
+ * to window manager. */
+ int prevWidth, prevHeight; /* Last known dimensions of window; used to
+ * detect changes in size. */
+ TkTextIndex topIndex; /* Identifies first character in top display
+ * line of window. */
+ struct TextDInfo *dInfoPtr; /* Information maintained by tkTextDisp.c. */
+
+ /*
+ * Information related to selection.
+ */
+
+ TkTextTag *selTagPtr; /* Pointer to "sel" tag. Used to tell when
+ * a new selection has been made. */
+ Tk_3DBorder selBorder; /* Border and background for selected
+ * characters. This is a copy of information
+ * in *cursorTagPtr, so it shouldn't be
+ * explicitly freed. */
+ char *selBdString; /* Value of -selectborderwidth option, or NULL
+ * if not specified (malloc'ed). */
+ XColor *selFgColorPtr; /* Foreground color for selected text.
+ * This is a copy of information in
+ * *cursorTagPtr, so it shouldn't be
+ * explicitly freed. */
+ int exportSelection; /* Non-zero means tie "sel" tag to X
+ * selection. */
+ TkTextIndex selIndex; /* Used during multi-pass selection retrievals.
+ * This index identifies the next character
+ * to be returned from the selection. */
+ int abortSelections; /* Set to 1 whenever the text is modified
+ * in a way that interferes with selection
+ * retrieval: used to abort incremental
+ * selection retrievals. */
+ int selOffset; /* Offset in selection corresponding to
+ * selLine and selCh. -1 means neither
+ * this information nor selIndex is of any
+ * use. */
+
+ /*
+ * Information related to insertion cursor:
+ */
+
+ TkTextSegment *insertMarkPtr;
+ /* Points to segment for "insert" mark. */
+ Tk_3DBorder insertBorder; /* Used to draw vertical bar for insertion
+ * cursor. */
+ int insertWidth; /* Total width of insert cursor. */
+ int insertBorderWidth; /* Width of 3-D border around insert cursor. */
+ int insertOnTime; /* Number of milliseconds cursor should spend
+ * in "on" state for each blink. */
+ int insertOffTime; /* Number of milliseconds cursor should spend
+ * in "off" state for each blink. */
+ Tcl_TimerToken insertBlinkHandler;
+ /* Timer handler used to blink cursor on and
+ * off. */
+
+ /*
+ * Information used for event bindings associated with tags:
+ */
+
+ Tk_BindingTable bindingTable;
+ /* Table of all bindings currently defined
+ * for this widget. NULL means that no
+ * bindings exist, so the table hasn't been
+ * created. Each "object" used for this
+ * table is the address of a tag. */
+ TkTextSegment *currentMarkPtr;
+ /* Pointer to segment for "current" mark,
+ * or NULL if none. */
+ XEvent pickEvent; /* The event from which the current character
+ * was chosen. Must be saved so that we
+ * can repick after modifications to the
+ * text. */
+ int numCurTags; /* Number of tags associated with character
+ * at current mark. */
+ TkTextTag **curTagArrayPtr; /* Pointer to array of tags for current
+ * mark, or NULL if none. */
+
+ /*
+ * Miscellaneous additional information:
+ */
+
+ 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 *xScrollCmd; /* Prefix of command to issue to update
+ * horizontal scrollbar when view changes. */
+ char *yScrollCmd; /* Prefix of command to issue to update
+ * vertical scrollbar when view changes. */
+ /* KHAMIS */
+ char *SyncCmd; /* Used to synchronize more than editor with the
+ * same file*/
+
+ int flags; /* Miscellaneous flags; see below for
+ * definitions. */
+} TkText;
+
+/*
+ * Flag values for TkText records:
+ *
+ * GOT_SELECTION: Non-zero means we've already claimed the
+ * selection.
+ * INSERT_ON: Non-zero means insertion cursor should be
+ * displayed on screen.
+ * GOT_FOCUS: Non-zero means this window has the input
+ * focus.
+ * BUTTON_DOWN: 1 means that a mouse button is currently
+ * down; this is used to implement grabs
+ * for the duration of button presses.
+ * UPDATE_SCROLLBARS: Non-zero means scrollbar(s) should be updated
+ * during next redisplay operation.
+ */
+
+#define GOT_SELECTION 1
+#define INSERT_ON 2
+#define GOT_FOCUS 4
+#define BUTTON_DOWN 8
+#define UPDATE_SCROLLBARS 0x10
+#define NEED_REPICK 0x20
+
+/*
+ * Records of the following type define segment types in terms of
+ * a collection of procedures that may be called to manipulate
+ * segments of that type.
+ */
+
+typedef TkTextSegment * Tk_SegSplitProc _ANSI_ARGS_((
+ struct TkTextSegment *segPtr, int index));
+typedef int Tk_SegDeleteProc _ANSI_ARGS_((
+ struct TkTextSegment *segPtr,
+ TkTextLine *linePtr, int treeGone));
+typedef TkTextSegment * Tk_SegCleanupProc _ANSI_ARGS_((
+ struct TkTextSegment *segPtr, TkTextLine *linePtr));
+typedef void Tk_SegLineChangeProc _ANSI_ARGS_((
+ struct TkTextSegment *segPtr, TkTextLine *linePtr));
+typedef int Tk_SegLayoutProc _ANSI_ARGS_((struct TkText *textPtr,
+ struct TkTextIndex *indexPtr, TkTextSegment *segPtr,
+ int offset, int maxX, int maxChars,
+ int noCharsYet, Tk_Uid wrapMode,
+ struct TkTextDispChunk *chunkPtr));
+typedef void Tk_SegCheckProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+
+typedef struct Tk_SegType {
+ char *name; /* Name of this kind of segment. */
+ int leftGravity; /* If a segment has zero size (e.g. a
+ * mark or tag toggle), does it
+ * attach to character to its left
+ * or right? 1 means left, 0 means
+ * right. */
+ Tk_SegSplitProc *splitProc; /* Procedure to split large segment
+ * into two smaller ones. */
+ Tk_SegDeleteProc *deleteProc; /* Procedure to call to delete
+ * segment. */
+ Tk_SegCleanupProc *cleanupProc; /* After any change to a line, this
+ * procedure is invoked for all
+ * segments left in the line to
+ * perform any cleanup they wish
+ * (e.g. joining neighboring
+ * segments). */
+ Tk_SegLineChangeProc *lineChangeProc;
+ /* Invoked when a segment is about
+ * to be moved from its current line
+ * to an earlier line because of
+ * a deletion. The linePtr is that
+ * for the segment's old line.
+ * CleanupProc will be invoked after
+ * the deletion is finished. */
+ Tk_SegLayoutProc *layoutProc; /* Returns size information when
+ * figuring out what to display in
+ * window. */
+ Tk_SegCheckProc *checkProc; /* Called during consistency checks
+ * to check internal consistency of
+ * segment. */
+} Tk_SegType;
+
+/*
+ * The constant below is used to specify a line when what is really
+ * wanted is the entire text. For now, just use a very big number.
+ */
+
+#define TK_END_OF_TEXT 1000000
+
+/*
+ * The following definition specifies the maximum number of characters
+ * needed in a string to hold a position specifier.
+ */
+
+#define TK_POS_CHARS 30
+
+/*
+ * Declarations for variables shared among the text-related files:
+ */
+
+extern int tkBTreeDebug;
+extern int tkTextDebug;
+extern Tk_SegType tkTextCharType;
+extern Tk_Uid tkTextCharUid;
+extern Tk_Uid tkTextDisabledUid;
+extern Tk_SegType tkTextLeftMarkType;
+extern Tk_Uid tkTextNoneUid;
+extern Tk_Uid tkTextNormalUid;
+extern Tk_SegType tkTextRightMarkType;
+extern Tk_SegType tkTextToggleOnType;
+extern Tk_SegType tkTextToggleOffType;
+extern Tk_Uid tkTextWordUid;
+
+/*
+ * Declarations for procedures that are used by the text-related files
+ * 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,
+ int *numTagsPtr));
+extern void TkBTreeInsertChars _ANSI_ARGS_((TkTextIndex *indexPtr,
+ char *string));
+extern int TkBTreeLineIndex _ANSI_ARGS_((TkTextLine *linePtr));
+extern void TkBTreeLinkSegment _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextIndex *indexPtr));
+extern TkTextLine * TkBTreeNextLine _ANSI_ARGS_((TkTextLine *linePtr));
+extern int TkBTreeNextTag _ANSI_ARGS_((TkTextSearch *searchPtr));
+extern int TkBTreeNumLines _ANSI_ARGS_((TkTextBTree tree));
+extern TkTextLine * TkBTreePreviousLine _ANSI_ARGS_((TkTextLine *linePtr));
+extern int TkBTreePrevTag _ANSI_ARGS_((TkTextSearch *searchPtr));
+extern void TkBTreeStartSearch _ANSI_ARGS_((TkTextIndex *index1Ptr,
+ TkTextIndex *index2Ptr, TkTextTag *tagPtr,
+ TkTextSearch *searchPtr));
+extern void TkBTreeStartSearchBack _ANSI_ARGS_((TkTextIndex *index1Ptr,
+ TkTextIndex *index2Ptr, TkTextTag *tagPtr,
+ TkTextSearch *searchPtr));
+extern void TkBTreeTag _ANSI_ARGS_((TkTextIndex *index1Ptr,
+ TkTextIndex *index2Ptr, TkTextTag *tagPtr,
+ int add));
+extern void TkBTreeUnlinkSegment _ANSI_ARGS_((TkTextBTree tree,
+ TkTextSegment *segPtr, TkTextLine *linePtr));
+extern void TkTextBindProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+extern void TkTextChanged _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *index1Ptr, TkTextIndex *index2Ptr));
+extern int TkTextCharBbox _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr, int *xPtr, int *yPtr,
+ int *widthPtr, int *heightPtr));
+extern int TkTextCharLayoutProc _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr, TkTextSegment *segPtr,
+ int offset, int maxX, int maxChars, int noBreakYet,
+ Tk_Uid wrapMode, TkTextDispChunk *chunkPtr));
+extern void TkTextCreateDInfo _ANSI_ARGS_((TkText *textPtr));
+extern int TkTextDLineInfo _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr, int *xPtr, int *yPtr,
+ int *widthPtr, int *heightPtr, int *basePtr));
+extern TkTextTag * TkTextCreateTag _ANSI_ARGS_((TkText *textPtr,
+ char *tagName));
+extern void TkTextFreeDInfo _ANSI_ARGS_((TkText *textPtr));
+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,
+ Tcl_Interp *interp, int argc, char **argv));
+extern int TkTextImageIndex _ANSI_ARGS_((TkText *textPtr,
+ char *name, TkTextIndex *indexPtr));
+extern int TkTextWindowCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, char **argv));
+extern int TkTextWindowIndex _ANSI_ARGS_((TkText *textPtr,
+ char *name, TkTextIndex *indexPtr));
+extern int TkTextXviewCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, char **argv));
+extern int TkTextYviewCmd _ANSI_ARGS_((TkText *textPtr,
+ Tcl_Interp *interp, int argc, char **argv));
+
+#endif /* _TKTEXT */
diff --git a/tk/generic/tkTextBTree.c b/tk/generic/tkTextBTree.c
new file mode 100644
index 00000000000..128edd29550
--- /dev/null
+++ b/tk/generic/tkTextBTree.c
@@ -0,0 +1,3594 @@
+/*
+ * 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$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkText.h"
+
+/*
+ * The data structure below keeps summary information about one tag as part
+ * of the tag information in a node.
+ */
+
+typedef struct Summary {
+ TkTextTag *tagPtr; /* Handle for tag. */
+ int toggleCount; /* Number of transitions into or
+ * out of this tag that occur in
+ * the subtree rooted at this node. */
+ struct Summary *nextPtr; /* Next in list of all tags for same
+ * node, or NULL if at end of list. */
+} Summary;
+
+/*
+ * The data structure below defines a node in the B-tree.
+ */
+
+typedef struct Node {
+ struct Node *parentPtr; /* Pointer to parent node, or NULL if
+ * this is the root. */
+ struct Node *nextPtr; /* Next in list of siblings with the
+ * same parent node, or NULL for end
+ * of list. */
+ Summary *summaryPtr; /* First in malloc-ed list of info
+ * about tags in this subtree (NULL if
+ * no tag info in the subtree). */
+ int level; /* Level of this node in the B-tree.
+ * 0 refers to the bottom of the tree
+ * (children are lines, not nodes). */
+ union { /* First in linked list of children. */
+ struct Node *nodePtr; /* Used if level > 0. */
+ TkTextLine *linePtr; /* Used if level == 0. */
+ } children;
+ int numChildren; /* Number of children of this node. */
+ int numLines; /* Total number of lines (leaves) in
+ * the subtree rooted here. */
+} Node;
+
+/*
+ * Upper and lower bounds on how many children a node may have:
+ * rebalance when either of these limits is exceeded. MAX_CHILDREN
+ * should be twice MIN_CHILDREN and MIN_CHILDREN must be >= 2.
+ */
+
+#define MAX_CHILDREN 12
+#define MIN_CHILDREN 6
+
+/*
+ * The data structure below defines an entire B-tree.
+ */
+
+typedef struct BTree {
+ Node *rootPtr; /* Pointer to root of B-tree. */
+ TkText *textPtr; /* Used to find tagTable in consistency
+ * checking code */
+} BTree;
+
+/*
+ * The structure below is used to pass information between
+ * TkBTreeGetTags and IncCount:
+ */
+
+typedef struct TagInfo {
+ int numTags; /* Number of tags for which there
+ * is currently information in
+ * tags and counts. */
+ int arraySize; /* Number of entries allocated for
+ * tags and counts. */
+ TkTextTag **tagPtrs; /* Array of tags seen so far.
+ * Malloc-ed. */
+ int *counts; /* Toggle count (so far) for each
+ * entry in tags. Malloc-ed. */
+} TagInfo;
+
+/*
+ * Variable that indicates whether to enable consistency checks for
+ * debugging.
+ */
+
+int tkBTreeDebug = 0;
+
+/*
+ * Macros that determine how much space to allocate for new segments:
+ */
+
+#define CSEG_SIZE(chars) ((unsigned) (Tk_Offset(TkTextSegment, body) \
+ + 1 + (chars)))
+#define TSEG_SIZE ((unsigned) (Tk_Offset(TkTextSegment, body) \
+ + sizeof(TkTextToggle)))
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void ChangeNodeToggleCount _ANSI_ARGS_((Node *nodePtr,
+ TkTextTag *tagPtr, int delta));
+static void CharCheckProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static int CharDeleteProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr, int treeGone));
+static TkTextSegment * CharCleanupProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static TkTextSegment * CharSplitProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ int index));
+static void CheckNodeConsistency _ANSI_ARGS_((Node *nodePtr));
+static void CleanupLine _ANSI_ARGS_((TkTextLine *linePtr));
+static void DeleteSummaries _ANSI_ARGS_((Summary *tagPtr));
+static void DestroyNode _ANSI_ARGS_((Node *nodePtr));
+static TkTextSegment * FindTagEnd _ANSI_ARGS_((TkTextBTree tree,
+ TkTextTag *tagPtr, TkTextIndex *indexPtr));
+static void IncCount _ANSI_ARGS_((TkTextTag *tagPtr, int inc,
+ TagInfo *tagInfoPtr));
+static void Rebalance _ANSI_ARGS_((BTree *treePtr, Node *nodePtr));
+static void RecomputeNodeCounts _ANSI_ARGS_((Node *nodePtr));
+static TkTextSegment * SplitSeg _ANSI_ARGS_((TkTextIndex *indexPtr));
+static void ToggleCheckProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static TkTextSegment * ToggleCleanupProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static int ToggleDeleteProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr, int treeGone));
+static void ToggleLineChangeProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static TkTextSegment * FindTagStart _ANSI_ARGS_((TkTextBTree tree,
+ TkTextTag *tagPtr, TkTextIndex *indexPtr));
+
+/*
+ * Type record for character segments:
+ */
+
+Tk_SegType tkTextCharType = {
+ "character", /* name */
+ 0, /* leftGravity */
+ CharSplitProc, /* splitProc */
+ CharDeleteProc, /* deleteProc */
+ CharCleanupProc, /* cleanupProc */
+ (Tk_SegLineChangeProc *) NULL, /* lineChangeProc */
+ TkTextCharLayoutProc, /* layoutProc */
+ CharCheckProc /* checkProc */
+};
+
+/*
+ * Type record for segments marking the beginning of a tagged
+ * range:
+ */
+
+Tk_SegType tkTextToggleOnType = {
+ "toggleOn", /* name */
+ 0, /* leftGravity */
+ (Tk_SegSplitProc *) NULL, /* splitProc */
+ ToggleDeleteProc, /* deleteProc */
+ ToggleCleanupProc, /* cleanupProc */
+ ToggleLineChangeProc, /* lineChangeProc */
+ (Tk_SegLayoutProc *) NULL, /* layoutProc */
+ ToggleCheckProc /* checkProc */
+};
+
+/*
+ * Type record for segments marking the end of a tagged
+ * range:
+ */
+
+Tk_SegType tkTextToggleOffType = {
+ "toggleOff", /* name */
+ 1, /* leftGravity */
+ (Tk_SegSplitProc *) NULL, /* splitProc */
+ ToggleDeleteProc, /* deleteProc */
+ ToggleCleanupProc, /* cleanupProc */
+ ToggleLineChangeProc, /* lineChangeProc */
+ (Tk_SegLayoutProc *) NULL, /* layoutProc */
+ ToggleCheckProc /* checkProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeCreate --
+ *
+ * This procedure is called to create a new text B-tree.
+ *
+ * Results:
+ * The return value is a pointer to a new B-tree containing
+ * one line with nothing but a newline character.
+ *
+ * Side effects:
+ * Memory is allocated and initialized.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextBTree
+TkBTreeCreate(textPtr)
+ TkText *textPtr;
+{
+ register BTree *treePtr;
+ register Node *rootPtr;
+ register TkTextLine *linePtr, *linePtr2;
+ register TkTextSegment *segPtr;
+
+ /*
+ * The tree will initially have two empty lines. The second line
+ * isn't actually part of the tree's contents, but its presence
+ * makes several operations easier. The tree will have one node,
+ * which is also the root of the tree.
+ */
+
+ rootPtr = (Node *) ckalloc(sizeof(Node));
+ linePtr = (TkTextLine *) ckalloc(sizeof(TkTextLine));
+ linePtr2 = (TkTextLine *) ckalloc(sizeof(TkTextLine));
+ rootPtr->parentPtr = NULL;
+ rootPtr->nextPtr = NULL;
+ rootPtr->summaryPtr = NULL;
+ rootPtr->level = 0;
+ rootPtr->children.linePtr = linePtr;
+ rootPtr->numChildren = 2;
+ rootPtr->numLines = 2;
+
+ linePtr->parentPtr = rootPtr;
+ linePtr->nextPtr = linePtr2;
+ segPtr = (TkTextSegment *) ckalloc(CSEG_SIZE(1));
+ linePtr->segPtr = segPtr;
+ segPtr->typePtr = &tkTextCharType;
+ segPtr->nextPtr = NULL;
+ segPtr->size = 1;
+ segPtr->body.chars[0] = '\n';
+ segPtr->body.chars[1] = 0;
+
+ linePtr2->parentPtr = rootPtr;
+ linePtr2->nextPtr = NULL;
+ segPtr = (TkTextSegment *) ckalloc(CSEG_SIZE(1));
+ linePtr2->segPtr = segPtr;
+ segPtr->typePtr = &tkTextCharType;
+ segPtr->nextPtr = NULL;
+ segPtr->size = 1;
+ segPtr->body.chars[0] = '\n';
+ segPtr->body.chars[1] = 0;
+
+ treePtr = (BTree *) ckalloc(sizeof(BTree));
+ treePtr->rootPtr = rootPtr;
+ treePtr->textPtr = textPtr;
+
+ return (TkTextBTree) treePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeDestroy --
+ *
+ * Delete a B-tree, recycling all of the storage it contains.
+ *
+ * Results:
+ * The tree given by treePtr is deleted. TreePtr should never
+ * again be used.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeDestroy(tree)
+ TkTextBTree tree; /* Pointer to tree to delete. */
+{
+ BTree *treePtr = (BTree *) tree;
+
+ DestroyNode(treePtr->rootPtr);
+ ckfree((char *) treePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyNode --
+ *
+ * This is a recursive utility procedure used during the deletion
+ * of a B-tree.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All the storage for nodePtr and its descendants is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DestroyNode(nodePtr)
+ register Node *nodePtr;
+{
+ if (nodePtr->level == 0) {
+ TkTextLine *linePtr;
+ TkTextSegment *segPtr;
+
+ while (nodePtr->children.linePtr != NULL) {
+ linePtr = nodePtr->children.linePtr;
+ nodePtr->children.linePtr = linePtr->nextPtr;
+ while (linePtr->segPtr != NULL) {
+ segPtr = linePtr->segPtr;
+ linePtr->segPtr = segPtr->nextPtr;
+ (*segPtr->typePtr->deleteProc)(segPtr, linePtr, 1);
+ }
+ ckfree((char *) linePtr);
+ }
+ } else {
+ register Node *childPtr;
+
+ while (nodePtr->children.nodePtr != NULL) {
+ childPtr = nodePtr->children.nodePtr;
+ nodePtr->children.nodePtr = childPtr->nextPtr;
+ DestroyNode(childPtr);
+ }
+ }
+ DeleteSummaries(nodePtr->summaryPtr);
+ ckfree((char *) nodePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteSummaries --
+ *
+ * Free up all of the memory in a list of tag summaries associated
+ * with a node.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Storage is released.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteSummaries(summaryPtr)
+ register Summary *summaryPtr; /* First in list of node's tag
+ * summaries. */
+{
+ register Summary *nextPtr;
+ while (summaryPtr != NULL) {
+ nextPtr = summaryPtr->nextPtr;
+ ckfree((char *) summaryPtr);
+ summaryPtr = nextPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeInsertChars --
+ *
+ * Insert characters at a given position in a B-tree.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Characters are added to the B-tree at the given position.
+ * If the string contains newlines, new lines will be added,
+ * which could cause the structure of the B-tree to change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeInsertChars(indexPtr, string)
+ register TkTextIndex *indexPtr; /* Indicates where to insert text.
+ * When the procedure returns, this
+ * index is no longer valid because
+ * of changes to the segment
+ * structure. */
+ char *string; /* Pointer to bytes to insert (may
+ * contain newlines, must be null-
+ * terminated). */
+{
+ register Node *nodePtr;
+ register TkTextSegment *prevPtr; /* The segment just before the first
+ * new segment (NULL means new segment
+ * is at beginning of line). */
+ TkTextSegment *curPtr; /* Current segment; new characters
+ * are inserted just after this one.
+ * NULL means insert at beginning of
+ * line. */
+ TkTextLine *linePtr; /* Current line (new segments are
+ * added to this line). */
+ register TkTextSegment *segPtr;
+ TkTextLine *newLinePtr;
+ int chunkSize; /* # characters in current chunk. */
+ register char *eol; /* Pointer to character just after last
+ * one in current chunk. */
+ int changeToLineCount; /* Counts change to total number of
+ * lines in file. */
+
+ prevPtr = SplitSeg(indexPtr);
+ linePtr = indexPtr->linePtr;
+ curPtr = prevPtr;
+
+ /*
+ * Chop the string up into lines and create a new segment for
+ * each line, plus a new line for the leftovers from the
+ * previous line.
+ */
+
+ changeToLineCount = 0;
+ while (*string != 0) {
+ for (eol = string; *eol != 0; eol++) {
+ if (*eol == '\n') {
+ eol++;
+ break;
+ }
+ }
+ chunkSize = eol-string;
+ segPtr = (TkTextSegment *) ckalloc(CSEG_SIZE(chunkSize));
+ segPtr->typePtr = &tkTextCharType;
+ if (curPtr == NULL) {
+ segPtr->nextPtr = linePtr->segPtr;
+ linePtr->segPtr = segPtr;
+ } else {
+ segPtr->nextPtr = curPtr->nextPtr;
+ curPtr->nextPtr = segPtr;
+ }
+ segPtr->size = chunkSize;
+ strncpy(segPtr->body.chars, string, (size_t) chunkSize);
+ segPtr->body.chars[chunkSize] = 0;
+
+ if (eol[-1] != '\n') {
+ break;
+ }
+
+ /*
+ * The chunk ended with a newline, so create a new TkTextLine
+ * and move the remainder of the old line to it.
+ */
+
+ newLinePtr = (TkTextLine *) ckalloc(sizeof(TkTextLine));
+ newLinePtr->parentPtr = linePtr->parentPtr;
+ newLinePtr->nextPtr = linePtr->nextPtr;
+ linePtr->nextPtr = newLinePtr;
+ newLinePtr->segPtr = segPtr->nextPtr;
+ segPtr->nextPtr = NULL;
+ linePtr = newLinePtr;
+ curPtr = NULL;
+ changeToLineCount++;
+
+ string = eol;
+ }
+
+ /*
+ * Cleanup the starting line for the insertion, plus the ending
+ * line if it's different.
+ */
+
+ CleanupLine(indexPtr->linePtr);
+ if (linePtr != indexPtr->linePtr) {
+ CleanupLine(linePtr);
+ }
+
+ /*
+ * Increment the line counts in all the parent nodes of the insertion
+ * point, then rebalance the tree if necessary.
+ */
+
+ for (nodePtr = linePtr->parentPtr ; nodePtr != NULL;
+ nodePtr = nodePtr->parentPtr) {
+ nodePtr->numLines += changeToLineCount;
+ }
+ nodePtr = linePtr->parentPtr;
+ nodePtr->numChildren += changeToLineCount;
+ if (nodePtr->numChildren > MAX_CHILDREN) {
+ Rebalance((BTree *) indexPtr->tree, nodePtr);
+ }
+
+ if (tkBTreeDebug) {
+ TkBTreeCheck(indexPtr->tree);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SplitSeg --
+ *
+ * This procedure is called before adding or deleting
+ * segments. It does three things: (a) it finds the segment
+ * containing indexPtr; (b) if there are several such
+ * segments (because some segments have zero length) then
+ * it picks the first segment that does not have left
+ * gravity; (c) if the index refers to the middle of
+ * a segment then it splits the segment so that the
+ * index now refers to the beginning of a segment.
+ *
+ * Results:
+ * The return value is a pointer to the segment just
+ * before the segment corresponding to indexPtr (as
+ * described above). If the segment corresponding to
+ * indexPtr is the first in its line then the return
+ * value is NULL.
+ *
+ * Side effects:
+ * The segment referred to by indexPtr is split unless
+ * indexPtr refers to its first character.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextSegment *
+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);
+ if (prevPtr == NULL) {
+ indexPtr->linePtr->segPtr = segPtr;
+ } else {
+ prevPtr->nextPtr = segPtr;
+ }
+ return segPtr;
+ } else if ((segPtr->size == 0) && (count == 0)
+ && !segPtr->typePtr->leftGravity) {
+ return prevPtr;
+ }
+ }
+ panic("SplitSeg reached end of line!");
+ return NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CleanupLine --
+ *
+ * This procedure is called after modifications have been
+ * made to a line. It scans over all of the segments in
+ * the line, giving each a chance to clean itself up, e.g.
+ * by merging with the following segments, updating internal
+ * information, etc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on what the segment-specific cleanup procedures do.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CleanupLine(linePtr)
+ TkTextLine *linePtr; /* Line to be cleaned up. */
+{
+ TkTextSegment *segPtr, **prevPtrPtr;
+ int anyChanges;
+
+ /*
+ * Make a pass over all of the segments in the line, giving each
+ * a chance to clean itself up. This could potentially change
+ * the structure of the line, e.g. by merging two segments
+ * together or having two segments cancel themselves; if so,
+ * then repeat the whole process again, since the first structure
+ * change might make other structure changes possible. Repeat
+ * until eventually there are no changes.
+ */
+
+ while (1) {
+ anyChanges = 0;
+ for (prevPtrPtr = &linePtr->segPtr, segPtr = *prevPtrPtr;
+ segPtr != NULL;
+ prevPtrPtr = &(*prevPtrPtr)->nextPtr, segPtr = *prevPtrPtr) {
+ if (segPtr->typePtr->cleanupProc != NULL) {
+ *prevPtrPtr = (*segPtr->typePtr->cleanupProc)(segPtr, linePtr);
+ if (segPtr != *prevPtrPtr) {
+ anyChanges = 1;
+ }
+ }
+ }
+ if (!anyChanges) {
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeDeleteChars --
+ *
+ * Delete a range of characters from a B-tree. The caller
+ * must make sure that the final newline of the B-tree is
+ * never deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information is deleted from the B-tree. This can cause the
+ * internal structure of the B-tree to change. Note: because
+ * of changes to the B-tree structure, the indices pointed
+ * to by index1Ptr and index2Ptr should not be used after this
+ * procedure returns.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeDeleteChars(index1Ptr, index2Ptr)
+ register TkTextIndex *index1Ptr; /* Indicates first character that is
+ * to be deleted. */
+ register TkTextIndex *index2Ptr; /* Indicates character just after the
+ * last one that is to be deleted. */
+{
+ TkTextSegment *prevPtr; /* The segment just before the start
+ * of the deletion range. */
+ TkTextSegment *lastPtr; /* The segment just after the end
+ * of the deletion range. */
+ TkTextSegment *segPtr, *nextPtr;
+ TkTextLine *curLinePtr;
+ Node *curNodePtr, *nodePtr;
+
+ /*
+ * Tricky point: split at index2Ptr first; otherwise the split
+ * at index2Ptr may invalidate segPtr and/or prevPtr.
+ */
+
+ lastPtr = SplitSeg(index2Ptr);
+ if (lastPtr != NULL) {
+ lastPtr = lastPtr->nextPtr;
+ } else {
+ lastPtr = index2Ptr->linePtr->segPtr;
+ }
+ prevPtr = SplitSeg(index1Ptr);
+ if (prevPtr != NULL) {
+ segPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = lastPtr;
+ } else {
+ segPtr = index1Ptr->linePtr->segPtr;
+ index1Ptr->linePtr->segPtr = lastPtr;
+ }
+
+ /*
+ * Delete all of the segments between prevPtr and lastPtr.
+ */
+
+ curLinePtr = index1Ptr->linePtr;
+ curNodePtr = curLinePtr->parentPtr;
+ while (segPtr != lastPtr) {
+ if (segPtr == NULL) {
+ TkTextLine *nextLinePtr;
+
+ /*
+ * We just ran off the end of a line. First find the
+ * next line, then go back to the old line and delete it
+ * (unless it's the starting line for the range).
+ */
+
+ nextLinePtr = TkBTreeNextLine(curLinePtr);
+ if (curLinePtr != index1Ptr->linePtr) {
+ if (curNodePtr == index1Ptr->linePtr->parentPtr) {
+ index1Ptr->linePtr->nextPtr = curLinePtr->nextPtr;
+ } else {
+ curNodePtr->children.linePtr = curLinePtr->nextPtr;
+ }
+ for (nodePtr = curNodePtr; nodePtr != NULL;
+ nodePtr = nodePtr->parentPtr) {
+ nodePtr->numLines--;
+ }
+ curNodePtr->numChildren--;
+ ckfree((char *) curLinePtr);
+ }
+ curLinePtr = nextLinePtr;
+ segPtr = curLinePtr->segPtr;
+
+ /*
+ * If the node is empty then delete it and its parents,
+ * recursively upwards until a non-empty node is found.
+ */
+
+ while (curNodePtr->numChildren == 0) {
+ Node *parentPtr;
+
+ parentPtr = curNodePtr->parentPtr;
+ if (parentPtr->children.nodePtr == curNodePtr) {
+ parentPtr->children.nodePtr = curNodePtr->nextPtr;
+ } else {
+ Node *prevNodePtr = parentPtr->children.nodePtr;
+ while (prevNodePtr->nextPtr != curNodePtr) {
+ prevNodePtr = prevNodePtr->nextPtr;
+ }
+ prevNodePtr->nextPtr = curNodePtr->nextPtr;
+ }
+ parentPtr->numChildren--;
+ ckfree((char *) curNodePtr);
+ curNodePtr = parentPtr;
+ }
+ curNodePtr = curLinePtr->parentPtr;
+ continue;
+ }
+
+ nextPtr = segPtr->nextPtr;
+ if ((*segPtr->typePtr->deleteProc)(segPtr, curLinePtr, 0) != 0) {
+ /*
+ * This segment refuses to die. Move it to prevPtr and
+ * advance prevPtr if the segment has left gravity.
+ */
+
+ if (prevPtr == NULL) {
+ segPtr->nextPtr = index1Ptr->linePtr->segPtr;
+ index1Ptr->linePtr->segPtr = segPtr;
+ } else {
+ segPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = segPtr;
+ }
+ if (segPtr->typePtr->leftGravity) {
+ prevPtr = segPtr;
+ }
+ }
+ segPtr = nextPtr;
+ }
+
+ /*
+ * If the beginning and end of the deletion range are in different
+ * lines, join the two lines together and discard the ending line.
+ */
+
+ if (index1Ptr->linePtr != index2Ptr->linePtr) {
+ TkTextLine *prevLinePtr;
+
+ for (segPtr = lastPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr->lineChangeProc != NULL) {
+ (*segPtr->typePtr->lineChangeProc)(segPtr, index2Ptr->linePtr);
+ }
+ }
+ curNodePtr = index2Ptr->linePtr->parentPtr;
+ for (nodePtr = curNodePtr; nodePtr != NULL;
+ nodePtr = nodePtr->parentPtr) {
+ nodePtr->numLines--;
+ }
+ curNodePtr->numChildren--;
+ prevLinePtr = curNodePtr->children.linePtr;
+ if (prevLinePtr == index2Ptr->linePtr) {
+ curNodePtr->children.linePtr = index2Ptr->linePtr->nextPtr;
+ } else {
+ while (prevLinePtr->nextPtr != index2Ptr->linePtr) {
+ prevLinePtr = prevLinePtr->nextPtr;
+ }
+ prevLinePtr->nextPtr = index2Ptr->linePtr->nextPtr;
+ }
+ ckfree((char *) index2Ptr->linePtr);
+ Rebalance((BTree *) index2Ptr->tree, curNodePtr);
+ }
+
+ /*
+ * Cleanup the segments in the new line.
+ */
+
+ CleanupLine(index1Ptr->linePtr);
+
+ /*
+ * Lastly, rebalance the first node of the range.
+ */
+
+ Rebalance((BTree *) index1Ptr->tree, index1Ptr->linePtr->parentPtr);
+ if (tkBTreeDebug) {
+ TkBTreeCheck(index1Ptr->tree);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeFindLine --
+ *
+ * Find a particular line in a B-tree based on its line number.
+ *
+ * Results:
+ * The return value is a pointer to the line structure for the
+ * line whose index is "line", or NULL if no such line exists.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextLine *
+TkBTreeFindLine(tree, line)
+ TkTextBTree tree; /* B-tree in which to find line. */
+ int line; /* Index of desired line. */
+{
+ BTree *treePtr = (BTree *) tree;
+ register Node *nodePtr;
+ register TkTextLine *linePtr;
+ int linesLeft;
+
+ nodePtr = treePtr->rootPtr;
+ linesLeft = line;
+ if ((line < 0) || (line >= nodePtr->numLines)) {
+ return NULL;
+ }
+
+ /*
+ * Work down through levels of the tree until a node is found at
+ * level 0.
+ */
+
+ while (nodePtr->level != 0) {
+ for (nodePtr = nodePtr->children.nodePtr;
+ nodePtr->numLines <= linesLeft;
+ nodePtr = nodePtr->nextPtr) {
+ if (nodePtr == NULL) {
+ panic("TkBTreeFindLine ran out of nodes");
+ }
+ linesLeft -= nodePtr->numLines;
+ }
+ }
+
+ /*
+ * Work through the lines attached to the level-0 node.
+ */
+
+ for (linePtr = nodePtr->children.linePtr; linesLeft > 0;
+ linePtr = linePtr->nextPtr) {
+ if (linePtr == NULL) {
+ panic("TkBTreeFindLine ran out of lines");
+ }
+ linesLeft -= 1;
+ }
+ return linePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeNextLine --
+ *
+ * Given an existing line in a B-tree, this procedure locates the
+ * next line in the B-tree. This procedure is used for scanning
+ * through the B-tree.
+ *
+ * Results:
+ * The return value is a pointer to the line that immediately
+ * follows linePtr, or NULL if there is no such line.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextLine *
+TkBTreeNextLine(linePtr)
+ register TkTextLine *linePtr; /* Pointer to existing line in
+ * B-tree. */
+{
+ register Node *nodePtr;
+
+ if (linePtr->nextPtr != NULL) {
+ return linePtr->nextPtr;
+ }
+
+ /*
+ * This was the last line associated with the particular parent node.
+ * Search up the tree for the next node, then search down from that
+ * node to find the first line.
+ */
+
+ for (nodePtr = linePtr->parentPtr; ; nodePtr = nodePtr->parentPtr) {
+ if (nodePtr->nextPtr != NULL) {
+ nodePtr = nodePtr->nextPtr;
+ break;
+ }
+ if (nodePtr->parentPtr == NULL) {
+ return (TkTextLine *) NULL;
+ }
+ }
+ while (nodePtr->level > 0) {
+ nodePtr = nodePtr->children.nodePtr;
+ }
+ return nodePtr->children.linePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreePreviousLine --
+ *
+ * Given an existing line in a B-tree, this procedure locates the
+ * previous line in the B-tree. This procedure is used for scanning
+ * through the B-tree in the reverse direction.
+ *
+ * Results:
+ * The return value is a pointer to the line that immediately
+ * preceeds linePtr, or NULL if there is no such line.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextLine *
+TkBTreePreviousLine(linePtr)
+ register TkTextLine *linePtr; /* Pointer to existing line in
+ * B-tree. */
+{
+ register Node *nodePtr;
+ register Node *node2Ptr;
+ register TkTextLine *prevPtr;
+
+ /*
+ * Find the line under this node just before the starting line.
+ */
+ prevPtr = linePtr->parentPtr->children.linePtr; /* First line at leaf */
+ while (prevPtr != linePtr) {
+ if (prevPtr->nextPtr == linePtr) {
+ return prevPtr;
+ }
+ prevPtr = prevPtr->nextPtr;
+ if (prevPtr == (TkTextLine *) NULL) {
+ panic("TkBTreePreviousLine ran out of lines");
+ }
+ }
+
+ /*
+ * This was the first line associated with the particular parent node.
+ * Search up the tree for the previous node, then search down from that
+ * node to find its last line.
+ */
+ for (nodePtr = linePtr->parentPtr; ; nodePtr = nodePtr->parentPtr) {
+ if (nodePtr == (Node *) NULL || nodePtr->parentPtr == (Node *) NULL) {
+ return (TkTextLine *) NULL;
+ }
+ if (nodePtr != nodePtr->parentPtr->children.nodePtr) {
+ break;
+ }
+ }
+ for (node2Ptr = nodePtr->parentPtr->children.nodePtr; ;
+ node2Ptr = node2Ptr->children.nodePtr) {
+ while (node2Ptr->nextPtr != nodePtr) {
+ node2Ptr = node2Ptr->nextPtr;
+ }
+ if (node2Ptr->level == 0) {
+ break;
+ }
+ nodePtr = (Node *)NULL;
+ }
+ for (prevPtr = node2Ptr->children.linePtr ; ; prevPtr = prevPtr->nextPtr) {
+ if (prevPtr->nextPtr == (TkTextLine *) NULL) {
+ return prevPtr;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeLineIndex --
+ *
+ * Given a pointer to a line in a B-tree, return the numerical
+ * index of that line.
+ *
+ * Results:
+ * The result is the index of linePtr within the tree, where 0
+ * corresponds to the first line in the tree.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreeLineIndex(linePtr)
+ TkTextLine *linePtr; /* Pointer to existing line in
+ * B-tree. */
+{
+ register TkTextLine *linePtr2;
+ register Node *nodePtr, *parentPtr, *nodePtr2;
+ int index;
+
+ /*
+ * First count how many lines precede this one in its level-0
+ * node.
+ */
+
+ nodePtr = linePtr->parentPtr;
+ index = 0;
+ for (linePtr2 = nodePtr->children.linePtr; linePtr2 != linePtr;
+ linePtr2 = linePtr2->nextPtr) {
+ if (linePtr2 == NULL) {
+ panic("TkBTreeLineIndex couldn't find line");
+ }
+ index += 1;
+ }
+
+ /*
+ * Now work up through the levels of the tree one at a time,
+ * counting how many lines are in nodes preceding the current
+ * node.
+ */
+
+ for (parentPtr = nodePtr->parentPtr ; parentPtr != NULL;
+ nodePtr = parentPtr, parentPtr = parentPtr->parentPtr) {
+ for (nodePtr2 = parentPtr->children.nodePtr; nodePtr2 != nodePtr;
+ nodePtr2 = nodePtr2->nextPtr) {
+ if (nodePtr2 == NULL) {
+ panic("TkBTreeLineIndex couldn't find node");
+ }
+ index += nodePtr2->numLines;
+ }
+ }
+ return index;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeLinkSegment --
+ *
+ * This procedure adds a new segment to a B-tree at a given
+ * location.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * SegPtr will be linked into its tree.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+TkBTreeLinkSegment(segPtr, indexPtr)
+ TkTextSegment *segPtr; /* Pointer to new segment to be added to
+ * B-tree. Should be completely initialized
+ * by caller except for nextPtr field. */
+ TkTextIndex *indexPtr; /* Where to add segment: it gets linked
+ * in just before the segment indicated
+ * here. */
+{
+ register TkTextSegment *prevPtr;
+
+ prevPtr = SplitSeg(indexPtr);
+ if (prevPtr == NULL) {
+ segPtr->nextPtr = indexPtr->linePtr->segPtr;
+ indexPtr->linePtr->segPtr = segPtr;
+ } else {
+ segPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = segPtr;
+ }
+ CleanupLine(indexPtr->linePtr);
+ if (tkBTreeDebug) {
+ TkBTreeCheck(indexPtr->tree);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeUnlinkSegment --
+ *
+ * This procedure unlinks a segment from its line in a B-tree.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * SegPtr will be unlinked from linePtr. The segment itself
+ * isn't modified by this procedure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+TkBTreeUnlinkSegment(tree, segPtr, linePtr)
+ TkTextBTree tree; /* Tree containing segment. */
+ TkTextSegment *segPtr; /* Segment to be unlinked. */
+ TkTextLine *linePtr; /* Line that currently contains
+ * segment. */
+{
+ register TkTextSegment *prevPtr;
+
+ if (linePtr->segPtr == segPtr) {
+ linePtr->segPtr = segPtr->nextPtr;
+ } else {
+ for (prevPtr = linePtr->segPtr; prevPtr->nextPtr != segPtr;
+ prevPtr = prevPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ prevPtr->nextPtr = segPtr->nextPtr;
+ }
+ CleanupLine(linePtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeTag --
+ *
+ * Turn a given tag on or off for a given range of characters in
+ * a B-tree of text.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The given tag is added to the given range of characters
+ * in the tree or removed from all those characters, depending
+ * on the "add" argument. The structure of the btree is modified
+ * enough that index1Ptr and index2Ptr are no longer valid after
+ * this procedure returns, and the indexes may be modified by
+ * this procedure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeTag(index1Ptr, index2Ptr, tagPtr, add)
+ register TkTextIndex *index1Ptr; /* Indicates first character in
+ * range. */
+ register TkTextIndex *index2Ptr; /* Indicates character just after the
+ * last one in range. */
+ TkTextTag *tagPtr; /* Tag to add or remove. */
+ int add; /* One means add tag to the given
+ * range of characters; zero means
+ * remove the tag from the range. */
+{
+ TkTextSegment *segPtr, *prevPtr;
+ TkTextSearch search;
+ TkTextLine *cleanupLinePtr;
+ int oldState;
+ int changed;
+
+ /*
+ * See whether the tag is present at the start of the range. If
+ * the state doesn't already match what we want then add a toggle
+ * there.
+ */
+
+ oldState = TkBTreeCharTagged(index1Ptr, tagPtr);
+ if ((add != 0) ^ oldState) {
+ segPtr = (TkTextSegment *) ckalloc(TSEG_SIZE);
+ segPtr->typePtr = (add) ? &tkTextToggleOnType : &tkTextToggleOffType;
+ prevPtr = SplitSeg(index1Ptr);
+ if (prevPtr == NULL) {
+ segPtr->nextPtr = index1Ptr->linePtr->segPtr;
+ index1Ptr->linePtr->segPtr = segPtr;
+ } else {
+ segPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = segPtr;
+ }
+ segPtr->size = 0;
+ segPtr->body.toggle.tagPtr = tagPtr;
+ segPtr->body.toggle.inNodeCounts = 0;
+ }
+
+ /*
+ * Scan the range of characters and delete any internal tag
+ * transitions. Keep track of what the old state was at the end
+ * of the range, and add a toggle there if it's needed.
+ */
+
+ TkBTreeStartSearch(index1Ptr, index2Ptr, tagPtr, &search);
+ cleanupLinePtr = index1Ptr->linePtr;
+ while (TkBTreeNextTag(&search)) {
+ oldState ^= 1;
+ segPtr = search.segPtr;
+ prevPtr = search.curIndex.linePtr->segPtr;
+ if (prevPtr == segPtr) {
+ search.curIndex.linePtr->segPtr = segPtr->nextPtr;
+ } else {
+ while (prevPtr->nextPtr != segPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = segPtr->nextPtr;
+ }
+ if (segPtr->body.toggle.inNodeCounts) {
+ ChangeNodeToggleCount(search.curIndex.linePtr->parentPtr,
+ segPtr->body.toggle.tagPtr, -1);
+ segPtr->body.toggle.inNodeCounts = 0;
+ changed = 1;
+ } else {
+ changed = 0;
+ }
+ ckfree((char *) segPtr);
+
+ /*
+ * The code below is a bit tricky. After deleting a toggle
+ * we eventually have to call CleanupLine, in order to allow
+ * character segments to be merged together. To do this, we
+ * remember in cleanupLinePtr a line that needs to be
+ * cleaned up, but we don't clean it up until we've moved
+ * on to a different line. That way the cleanup process
+ * won't goof up segPtr.
+ */
+
+ if (cleanupLinePtr != search.curIndex.linePtr) {
+ CleanupLine(cleanupLinePtr);
+ cleanupLinePtr = search.curIndex.linePtr;
+ }
+ /*
+ * Quick hack. ChangeNodeToggleCount may move the tag's root
+ * location around and leave the search in the void. This resets
+ * the search.
+ */
+ if (changed) {
+ TkBTreeStartSearch(index1Ptr, index2Ptr, tagPtr, &search);
+ }
+ }
+ if ((add != 0) ^ oldState) {
+ segPtr = (TkTextSegment *) ckalloc(TSEG_SIZE);
+ segPtr->typePtr = (add) ? &tkTextToggleOffType : &tkTextToggleOnType;
+ prevPtr = SplitSeg(index2Ptr);
+ if (prevPtr == NULL) {
+ segPtr->nextPtr = index2Ptr->linePtr->segPtr;
+ index2Ptr->linePtr->segPtr = segPtr;
+ } else {
+ segPtr->nextPtr = prevPtr->nextPtr;
+ prevPtr->nextPtr = segPtr;
+ }
+ segPtr->size = 0;
+ segPtr->body.toggle.tagPtr = tagPtr;
+ segPtr->body.toggle.inNodeCounts = 0;
+ }
+
+ /*
+ * Cleanup cleanupLinePtr and the last line of the range, if
+ * these are different.
+ */
+
+ CleanupLine(cleanupLinePtr);
+ if (cleanupLinePtr != index2Ptr->linePtr) {
+ CleanupLine(index2Ptr->linePtr);
+ }
+
+ if (tkBTreeDebug) {
+ TkBTreeCheck(index1Ptr->tree);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangeNodeToggleCount --
+ *
+ * This procedure increments or decrements the toggle count for
+ * a particular tag in a particular node and all its ancestors
+ * up to the per-tag root node.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The toggle count for tag is adjusted up or down by "delta" in
+ * nodePtr. This routine maintains the tagRootPtr that identifies
+ * the root node for the tag, moving it up or down the tree as needed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChangeNodeToggleCount(nodePtr, tagPtr, delta)
+ register Node *nodePtr; /* Node whose toggle count for a tag
+ * must be changed. */
+ TkTextTag *tagPtr; /* Information about tag. */
+ int delta; /* Amount to add to current toggle
+ * count for tag (may be negative). */
+{
+ register Summary *summaryPtr, *prevPtr;
+ register Node *node2Ptr;
+ int rootLevel; /* Level of original tag root */
+
+ tagPtr->toggleCount += delta;
+ if (tagPtr->tagRootPtr == (Node *) NULL) {
+ tagPtr->tagRootPtr = nodePtr;
+ return;
+ }
+
+ /*
+ * Note the level of the existing root for the tag so we can detect
+ * if it needs to be moved because of the toggle count change.
+ */
+
+ rootLevel = tagPtr->tagRootPtr->level;
+
+ /*
+ * Iterate over the node and its ancestors up to the tag root, adjusting
+ * summary counts at each node and moving the tag's root upwards if
+ * necessary.
+ */
+
+ for ( ; nodePtr != tagPtr->tagRootPtr; nodePtr = nodePtr->parentPtr) {
+ /*
+ * See if there's already an entry for this tag for this node. If so,
+ * perhaps all we have to do is adjust its count.
+ */
+
+ for (prevPtr = NULL, summaryPtr = nodePtr->summaryPtr;
+ summaryPtr != NULL;
+ prevPtr = summaryPtr, summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ break;
+ }
+ }
+ if (summaryPtr != NULL) {
+ summaryPtr->toggleCount += delta;
+ if (summaryPtr->toggleCount > 0 &&
+ summaryPtr->toggleCount < tagPtr->toggleCount) {
+ continue;
+ }
+ if (summaryPtr->toggleCount != 0) {
+ /*
+ * Should never find a node with max toggle count at this
+ * point (there shouldn't have been a summary entry in the
+ * first place).
+ */
+
+ panic("ChangeNodeToggleCount: bad toggle count (%d) max (%d)",
+ summaryPtr->toggleCount, tagPtr->toggleCount);
+ }
+
+ /*
+ * Zero toggle count; must remove this tag from the list.
+ */
+
+ if (prevPtr == NULL) {
+ nodePtr->summaryPtr = summaryPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = summaryPtr->nextPtr;
+ }
+ ckfree((char *) summaryPtr);
+ } else {
+ /*
+ * This tag isn't currently in the summary information list.
+ */
+
+ if (rootLevel == nodePtr->level) {
+
+ /*
+ * The old tag root is at the same level in the tree as this
+ * node, but it isn't at this node. Move the tag root up
+ * a level, in the hopes that it will now cover this node
+ * as well as the old root (if not, we'll move it up again
+ * the next time through the loop). To push it up one level
+ * we copy the original toggle count into the summary
+ * information at the old root and change the root to its
+ * parent node.
+ */
+
+ Node *rootNodePtr = tagPtr->tagRootPtr;
+ summaryPtr = (Summary *) ckalloc(sizeof(Summary));
+ summaryPtr->tagPtr = tagPtr;
+ summaryPtr->toggleCount = tagPtr->toggleCount - delta;
+ summaryPtr->nextPtr = rootNodePtr->summaryPtr;
+ rootNodePtr->summaryPtr = summaryPtr;
+ rootNodePtr = rootNodePtr->parentPtr;
+ rootLevel = rootNodePtr->level;
+ tagPtr->tagRootPtr = rootNodePtr;
+ }
+ summaryPtr = (Summary *) ckalloc(sizeof(Summary));
+ summaryPtr->tagPtr = tagPtr;
+ summaryPtr->toggleCount = delta;
+ summaryPtr->nextPtr = nodePtr->summaryPtr;
+ nodePtr->summaryPtr = summaryPtr;
+ }
+ }
+
+ /*
+ * If we've decremented the toggle count, then it may be necessary
+ * to push the tag root down one or more levels.
+ */
+
+ if (delta >= 0) {
+ return;
+ }
+ if (tagPtr->toggleCount == 0) {
+ tagPtr->tagRootPtr = (Node *) NULL;
+ return;
+ }
+ nodePtr = tagPtr->tagRootPtr;
+ while (nodePtr->level > 0) {
+ /*
+ * See if a single child node accounts for all of the tag's
+ * toggles. If so, push the root down one level.
+ */
+
+ for (node2Ptr = nodePtr->children.nodePtr;
+ node2Ptr != (Node *)NULL ;
+ node2Ptr = node2Ptr->nextPtr) {
+ for (prevPtr = NULL, summaryPtr = node2Ptr->summaryPtr;
+ summaryPtr != NULL;
+ prevPtr = summaryPtr, summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ break;
+ }
+ }
+ if (summaryPtr == NULL) {
+ continue;
+ }
+ if (summaryPtr->toggleCount != tagPtr->toggleCount) {
+ /*
+ * No node has all toggles, so the root is still valid.
+ */
+
+ return;
+ }
+
+ /*
+ * This node has all the toggles, so push down the root.
+ */
+
+ if (prevPtr == NULL) {
+ node2Ptr->summaryPtr = summaryPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = summaryPtr->nextPtr;
+ }
+ ckfree((char *) summaryPtr);
+ tagPtr->tagRootPtr = node2Ptr;
+ break;
+ }
+ nodePtr = tagPtr->tagRootPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindTagStart --
+ *
+ * Find the start of the first range of a tag.
+ *
+ * Results:
+ * The return value is a pointer to the first tag toggle segment
+ * for the tag. This can be either a tagon or tagoff segments because
+ * of the way TkBTreeAdd removes a tag.
+ * Sets *indexPtr to be the index of the tag toggle.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkTextSegment *
+FindTagStart(tree, tagPtr, indexPtr)
+ TkTextBTree tree; /* Tree to search within */
+ TkTextTag *tagPtr; /* Tag to search for. */
+ TkTextIndex *indexPtr; /* Return - index information */
+{
+ register Node *nodePtr;
+ register TkTextLine *linePtr;
+ register TkTextSegment *segPtr;
+ register Summary *summaryPtr;
+ int offset;
+
+ nodePtr = tagPtr->tagRootPtr;
+ if (nodePtr == (Node *) NULL) {
+ return NULL;
+ }
+
+ /*
+ * Search from the root of the subtree that contains the tag down
+ * to the level 0 node.
+ */
+
+ while (nodePtr->level > 0) {
+ for (nodePtr = nodePtr->children.nodePtr ; nodePtr != (Node *) NULL;
+ nodePtr = nodePtr->nextPtr) {
+ for (summaryPtr = nodePtr->summaryPtr ; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ goto gotNodeWithTag;
+ }
+ }
+ }
+ gotNodeWithTag:
+ continue;
+ }
+
+ /*
+ * Work through the lines attached to the level-0 node.
+ */
+
+ for (linePtr = nodePtr->children.linePtr; linePtr != (TkTextLine *) NULL;
+ linePtr = linePtr->nextPtr) {
+ for (offset = 0, segPtr = linePtr->segPtr ; segPtr != NULL;
+ offset += segPtr->size, segPtr = segPtr->nextPtr) {
+ if (((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType))
+ && (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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindTagEnd --
+ *
+ * Find the end of the last range of a tag.
+ *
+ * Results:
+ * The return value is a pointer to the last tag toggle segment
+ * for the tag. This can be either a tagon or tagoff segments because
+ * of the way TkBTreeAdd removes a tag.
+ * Sets *indexPtr to be the index of the tag toggle.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkTextSegment *
+FindTagEnd(tree, tagPtr, indexPtr)
+ TkTextBTree tree; /* Tree to search within */
+ TkTextTag *tagPtr; /* Tag to search for. */
+ TkTextIndex *indexPtr; /* Return - index information */
+{
+ register Node *nodePtr, *lastNodePtr;
+ register TkTextLine *linePtr ,*lastLinePtr;
+ register TkTextSegment *segPtr, *lastSegPtr, *last2SegPtr;
+ register Summary *summaryPtr;
+ int lastoffset, lastoffset2, offset;
+
+ nodePtr = tagPtr->tagRootPtr;
+ if (nodePtr == (Node *) NULL) {
+ return NULL;
+ }
+
+ /*
+ * Search from the root of the subtree that contains the tag down
+ * to the level 0 node.
+ */
+
+ while (nodePtr->level > 0) {
+ for (lastNodePtr = NULL, nodePtr = nodePtr->children.nodePtr ;
+ nodePtr != (Node *) NULL; nodePtr = nodePtr->nextPtr) {
+ for (summaryPtr = nodePtr->summaryPtr ; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ lastNodePtr = nodePtr;
+ break;
+ }
+ }
+ }
+ nodePtr = lastNodePtr;
+ }
+
+ /*
+ * Work through the lines attached to the level-0 node.
+ */
+ last2SegPtr = NULL;
+ lastoffset2 = 0;
+ lastoffset = 0;
+ for (lastLinePtr = NULL, linePtr = nodePtr->children.linePtr;
+ linePtr != (TkTextLine *) NULL; linePtr = linePtr->nextPtr) {
+ for (offset = 0, lastSegPtr = NULL, segPtr = linePtr->segPtr ;
+ segPtr != NULL;
+ offset += segPtr->size, segPtr = segPtr->nextPtr) {
+ if (((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType))
+ && (segPtr->body.toggle.tagPtr == tagPtr)) {
+ lastSegPtr = segPtr;
+ lastoffset = offset;
+ }
+ }
+ if (lastSegPtr != NULL) {
+ lastLinePtr = linePtr;
+ last2SegPtr = lastSegPtr;
+ lastoffset2 = lastoffset;
+ }
+ }
+ indexPtr->tree = tree;
+ indexPtr->linePtr = lastLinePtr;
+ indexPtr->charIndex = lastoffset2;
+ return last2SegPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeStartSearch --
+ *
+ * This procedure sets up a search for tag transitions involving
+ * a given tag (or all tags) in a given range of the text.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The information at *searchPtr is set up so that subsequent calls
+ * to TkBTreeNextTag or TkBTreePrevTag will return information about the
+ * locations of tag transitions. Note that TkBTreeNextTag or
+ * TkBTreePrevTag must be called to get the first transition.
+ * Note: unlike TkBTreeNextTag and TkBTreePrevTag, this routine does not
+ * guarantee that searchPtr->curIndex is equal to *index1Ptr. It may be
+ * greater than that if *index1Ptr is less than the first tag transition.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeStartSearch(index1Ptr, index2Ptr, tagPtr, searchPtr)
+ TkTextIndex *index1Ptr; /* Search starts here. Tag toggles
+ * at this position will not be
+ * returned. */
+ TkTextIndex *index2Ptr; /* Search stops here. Tag toggles
+ * at this position *will* be
+ * returned. */
+ TkTextTag *tagPtr; /* Tag to search for. NULL means
+ * search for any tag. */
+ register TkTextSearch *searchPtr; /* Where to store information about
+ * search's progress. */
+{
+ int offset;
+ TkTextIndex index0; /* First index of the tag */
+ TkTextSegment *seg0Ptr; /* First segment of the tag */
+
+ /*
+ * Find the segment that contains the first toggle for the tag. This
+ * may become the starting point in the search.
+ */
+
+ seg0Ptr = FindTagStart(index1Ptr->tree, tagPtr, &index0);
+ if (seg0Ptr == (TkTextSegment *) NULL) {
+ /*
+ * Even though there are no toggles, the display code still
+ * uses the search curIndex, so initialize that anyway.
+ */
+
+ searchPtr->linesLeft = 0;
+ searchPtr->curIndex = *index1Ptr;
+ searchPtr->segPtr = NULL;
+ searchPtr->nextPtr = NULL;
+ return;
+ }
+ if (TkTextIndexCmp(index1Ptr, &index0) < 0) {
+ /*
+ * Adjust start of search up to the first range of the tag
+ */
+
+ searchPtr->curIndex = index0;
+ 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;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeStartSearchBack --
+ *
+ * This procedure sets up a search backwards for tag transitions involving
+ * a given tag (or all tags) in a given range of the text. In the
+ * normal case the first index (*index1Ptr) is beyond the second
+ * index (*index2Ptr).
+ *
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The information at *searchPtr is set up so that subsequent calls
+ * to TkBTreePrevTag will return information about the
+ * locations of tag transitions. Note that TkBTreePrevTag must be called
+ * to get the first transition.
+ * Note: unlike TkBTreeNextTag and TkBTreePrevTag, this routine does not
+ * guarantee that searchPtr->curIndex is equal to *index1Ptr. It may be
+ * less than that if *index1Ptr is greater than the last tag transition.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeStartSearchBack(index1Ptr, index2Ptr, tagPtr, searchPtr)
+ TkTextIndex *index1Ptr; /* Search starts here. Tag toggles
+ * at this position will not be
+ * returned. */
+ TkTextIndex *index2Ptr; /* Search stops here. Tag toggles
+ * at this position *will* be
+ * returned. */
+ TkTextTag *tagPtr; /* Tag to search for. NULL means
+ * search for any tag. */
+ register TkTextSearch *searchPtr; /* Where to store information about
+ * search's progress. */
+{
+ int offset;
+ TkTextIndex index0; /* Last index of the tag */
+ TkTextIndex backOne; /* One character before starting index */
+ TkTextSegment *seg0Ptr; /* Last segment of the tag */
+
+ /*
+ * Find the segment that contains the last toggle for the tag. This
+ * may become the starting point in the search.
+ */
+
+ seg0Ptr = FindTagEnd(index1Ptr->tree, tagPtr, &index0);
+ if (seg0Ptr == (TkTextSegment *) NULL) {
+ /*
+ * Even though there are no toggles, the display code still
+ * uses the search curIndex, so initialize that anyway.
+ */
+
+ searchPtr->linesLeft = 0;
+ searchPtr->curIndex = *index1Ptr;
+ searchPtr->segPtr = NULL;
+ searchPtr->nextPtr = NULL;
+ return;
+ }
+
+ /*
+ * Adjust the start of the search so it doesn't find any tag toggles
+ * that are right at the index specified by the user.
+ */
+
+ if (TkTextIndexCmp(index1Ptr, &index0) > 0) {
+ 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;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeNextTag --
+ *
+ * Once a tag search has begun, successive calls to this procedure
+ * return successive tag toggles. Note: it is NOT SAFE to call this
+ * procedure if characters have been inserted into or deleted from
+ * the B-tree since the call to TkBTreeStartSearch.
+ *
+ * Results:
+ * The return value is 1 if another toggle was found that met the
+ * criteria specified in the call to TkBTreeStartSearch; in this
+ * case searchPtr->curIndex gives the toggle's position and
+ * searchPtr->curTagPtr points to its segment. 0 is returned if
+ * no more matching tag transitions were found; in this case
+ * searchPtr->curIndex is the same as searchPtr->stopIndex.
+ *
+ * Side effects:
+ * Information in *searchPtr is modified to update the state of the
+ * search and indicate where the next tag toggle is located.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreeNextTag(searchPtr)
+ register TkTextSearch *searchPtr; /* Information about search in
+ * progress; must have been set up by
+ * call to TkBTreeStartSearch. */
+{
+ register TkTextSegment *segPtr;
+ register Node *nodePtr;
+ register Summary *summaryPtr;
+
+ 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.
+ */
+
+ segPtr = searchPtr->nextPtr;
+ while (1) {
+ /*
+ * Check for more tags on the current line.
+ */
+
+ for ( ; segPtr != NULL; segPtr = segPtr->nextPtr) {
+ if (segPtr == searchPtr->lastPtr) {
+ goto searchOver;
+ }
+ if (((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType))
+ && (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;
+ }
+
+ /*
+ * Search across and up through the B-tree's node hierarchy looking
+ * for the next node that has a relevant tag transition somewhere in
+ * its subtree. Be sure to update linesLeft as we skip over large
+ * chunks of lines.
+ */
+
+ while (1) {
+ while (nodePtr->nextPtr == NULL) {
+ if (nodePtr->parentPtr == NULL ||
+ nodePtr->parentPtr == searchPtr->tagPtr->tagRootPtr) {
+ goto searchOver;
+ }
+ nodePtr = nodePtr->parentPtr;
+ }
+ nodePtr = nodePtr->nextPtr;
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if ((searchPtr->allTags) ||
+ (summaryPtr->tagPtr == searchPtr->tagPtr)) {
+ goto gotNodeWithTag;
+ }
+ }
+ searchPtr->linesLeft -= nodePtr->numLines;
+ }
+
+ /*
+ * At this point we've found a subtree that has a relevant tag
+ * transition. Now search down (and across) through that subtree
+ * to find the first level-0 node that has a relevant tag transition.
+ */
+
+ gotNodeWithTag:
+ while (nodePtr->level > 0) {
+ for (nodePtr = nodePtr->children.nodePtr; ;
+ nodePtr = nodePtr->nextPtr) {
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if ((searchPtr->allTags)
+ || (summaryPtr->tagPtr == searchPtr->tagPtr)) {
+ goto nextChild;
+ }
+ }
+ searchPtr->linesLeft -= nodePtr->numLines;
+ if (nodePtr->nextPtr == NULL) {
+ panic("TkBTreeNextTag found incorrect tag summary info.");
+ }
+ }
+ nextChild:
+ continue;
+ }
+
+ /*
+ * 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;
+ }
+
+ searchOver:
+ searchPtr->linesLeft = 0;
+ searchPtr->segPtr = NULL;
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreePrevTag --
+ *
+ * Once a tag search has begun, successive calls to this procedure
+ * return successive tag toggles in the reverse direction.
+ * Note: it is NOT SAFE to call this
+ * procedure if characters have been inserted into or deleted from
+ * the B-tree since the call to TkBTreeStartSearch.
+ *
+ * Results:
+ * The return value is 1 if another toggle was found that met the
+ * criteria specified in the call to TkBTreeStartSearch; in this
+ * case searchPtr->curIndex gives the toggle's position and
+ * searchPtr->curTagPtr points to its segment. 0 is returned if
+ * no more matching tag transitions were found; in this case
+ * searchPtr->curIndex is the same as searchPtr->stopIndex.
+ *
+ * Side effects:
+ * Information in *searchPtr is modified to update the state of the
+ * search and indicate where the next tag toggle is located.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreePrevTag(searchPtr)
+ register TkTextSearch *searchPtr; /* Information about search in
+ * 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.
+ */
+ goto searchOver;
+ }
+ searchPtr->segPtr = prevPtr;
+ searchPtr->nextPtr = prevPtr;
+ searchPtr->tagPtr = prevPtr->body.toggle.tagPtr;
+ return 1;
+ }
+
+ searchPtr->linesLeft--;
+ if (searchPtr->linesLeft <= 0) {
+ goto searchOver;
+ }
+
+ /*
+ * 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 previous
+ * one.
+ */
+
+ nodePtr = searchPtr->curIndex.linePtr->parentPtr;
+ for (prevLinePtr = NULL, linePtr = nodePtr->children.linePtr;
+ linePtr != NULL && linePtr != searchPtr->curIndex.linePtr;
+ prevLinePtr = linePtr, linePtr = linePtr->nextPtr) {
+ /* empty loop body */ ;
+ }
+ if (prevLinePtr != NULL) {
+ searchPtr->curIndex.linePtr = prevLinePtr;
+ searchPtr->nextPtr = NULL;
+ continue;
+ }
+ if (nodePtr == searchPtr->tagPtr->tagRootPtr) {
+ goto searchOver;
+ }
+
+ /*
+ * Search across and up through the B-tree's node hierarchy looking
+ * for the previous node that has a relevant tag transition somewhere in
+ * its subtree. The search and line counting is trickier with/out
+ * back pointers. We'll scan all the nodes under a parent up to
+ * the current node, searching all of them for tag state. The last
+ * one we find, if any, is recorded in prevNodePtr, and any nodes
+ * past prevNodePtr that don't have tag state increment linesSkipped.
+ */
+
+ while (1) {
+ for (prevNodePtr = NULL, linesSkipped = 0,
+ node2Ptr = nodePtr->parentPtr->children.nodePtr ;
+ node2Ptr != nodePtr; node2Ptr = node2Ptr->nextPtr) {
+ for (summaryPtr = node2Ptr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if ((searchPtr->allTags) ||
+ (summaryPtr->tagPtr == searchPtr->tagPtr)) {
+ prevNodePtr = node2Ptr;
+ linesSkipped = 0;
+ goto keepLooking;
+ }
+ }
+ linesSkipped += node2Ptr->numLines;
+
+ keepLooking:
+ continue;
+ }
+ if (prevNodePtr != NULL) {
+ nodePtr = prevNodePtr;
+ searchPtr->linesLeft -= linesSkipped;
+ goto gotNodeWithTag;
+ }
+ nodePtr = nodePtr->parentPtr;
+ if (nodePtr->parentPtr == NULL ||
+ nodePtr == searchPtr->tagPtr->tagRootPtr) {
+ goto searchOver;
+ }
+ }
+
+ /*
+ * At this point we've found a subtree that has a relevant tag
+ * transition. Now search down (and across) through that subtree
+ * to find the last level-0 node that has a relevant tag transition.
+ */
+
+ gotNodeWithTag:
+ while (nodePtr->level > 0) {
+ for (linesSkipped = 0, prevNodePtr = NULL,
+ nodePtr = nodePtr->children.nodePtr; nodePtr != NULL ;
+ nodePtr = nodePtr->nextPtr) {
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if ((searchPtr->allTags)
+ || (summaryPtr->tagPtr == searchPtr->tagPtr)) {
+ prevNodePtr = nodePtr;
+ linesSkipped = 0;
+ goto keepLooking2;
+ }
+ }
+ linesSkipped += nodePtr->numLines;
+
+ keepLooking2:
+ continue;
+ }
+ if (prevNodePtr == NULL) {
+ panic("TkBTreePrevTag found incorrect tag summary info.");
+ }
+ searchPtr->linesLeft -= linesSkipped;
+ nodePtr = prevNodePtr;
+ }
+
+ /*
+ * 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. We start with
+ * the last line below the node.
+ */
+
+ 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:
+ searchPtr->linesLeft = 0;
+ searchPtr->segPtr = NULL;
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeCharTagged --
+ *
+ * Determine whether a particular character has a particular tag.
+ *
+ * Results:
+ * The return value is 1 if the given tag is in effect at the
+ * character given by linePtr and ch, and 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreeCharTagged(indexPtr, tagPtr)
+ TkTextIndex *indexPtr; /* Indicates a character position at
+ * which to check for a tag. */
+ TkTextTag *tagPtr; /* Tag of interest. */
+{
+ register Node *nodePtr;
+ register TkTextLine *siblingLinePtr;
+ register TkTextSegment *segPtr;
+ TkTextSegment *toggleSegPtr;
+ int toggles, index;
+
+ /*
+ * 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;
+ }
+ }
+ if (toggleSegPtr != NULL) {
+ return (toggleSegPtr->typePtr == &tkTextToggleOnType);
+ }
+
+ /*
+ * No toggle in this line. Look for toggles for the tag in lines
+ * that are predecessors of indexPtr->linePtr but under the same
+ * level-0 node.
+ */
+
+ for (siblingLinePtr = indexPtr->linePtr->parentPtr->children.linePtr;
+ siblingLinePtr != indexPtr->linePtr;
+ siblingLinePtr = siblingLinePtr->nextPtr) {
+ for (segPtr = siblingLinePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if (((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType))
+ && (segPtr->body.toggle.tagPtr == tagPtr)) {
+ toggleSegPtr = segPtr;
+ }
+ }
+ }
+ if (toggleSegPtr != NULL) {
+ return (toggleSegPtr->typePtr == &tkTextToggleOnType);
+ }
+
+ /*
+ * No toggle in this node. Scan upwards through the ancestors of
+ * this node, counting the number of toggles of the given tag in
+ * siblings that precede that node.
+ */
+
+ toggles = 0;
+ for (nodePtr = indexPtr->linePtr->parentPtr; nodePtr->parentPtr != NULL;
+ nodePtr = nodePtr->parentPtr) {
+ register Node *siblingPtr;
+ register Summary *summaryPtr;
+
+ for (siblingPtr = nodePtr->parentPtr->children.nodePtr;
+ siblingPtr != nodePtr; siblingPtr = siblingPtr->nextPtr) {
+ for (summaryPtr = siblingPtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ toggles += summaryPtr->toggleCount;
+ }
+ }
+ }
+ if (nodePtr == tagPtr->tagRootPtr) {
+ break;
+ }
+ }
+
+ /*
+ * An odd number of toggles means that the tag is present at the
+ * given point.
+ */
+
+ return toggles & 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeGetTags --
+ *
+ * Return information about all of the tags that are associated
+ * with a particular character in a B-tree of text.
+ *
+ * Results:
+ * The return value is a malloc-ed array containing pointers to
+ * information for each of the tags that is associated with
+ * the character at the position given by linePtr and ch. The
+ * word at *numTagsPtr is filled in with the number of pointers
+ * in the array. It is up to the caller to free the array by
+ * passing it to free. If there are no tags at the given character
+ * then a NULL pointer is returned and *numTagsPtr will be set to 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+TkTextTag **
+TkBTreeGetTags(indexPtr, numTagsPtr)
+ TkTextIndex *indexPtr; /* Indicates a particular position in
+ * the B-tree. */
+ int *numTagsPtr; /* Store number of tags found at this
+ * location. */
+{
+ register Node *nodePtr;
+ register TkTextLine *siblingLinePtr;
+ register TkTextSegment *segPtr;
+ int src, dst, index;
+ TagInfo tagInfo;
+#define NUM_TAG_INFOS 10
+
+ tagInfo.numTags = 0;
+ tagInfo.arraySize = NUM_TAG_INFOS;
+ tagInfo.tagPtrs = (TkTextTag **) ckalloc((unsigned)
+ NUM_TAG_INFOS*sizeof(TkTextTag *));
+ tagInfo.counts = (int *) ckalloc((unsigned)
+ NUM_TAG_INFOS*sizeof(int));
+
+ /*
+ * 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);
+ }
+ }
+
+ /*
+ * Record toggles for tags in lines that are predecessors of
+ * indexPtr->linePtr but under the same level-0 node.
+ */
+
+ for (siblingLinePtr = indexPtr->linePtr->parentPtr->children.linePtr;
+ siblingLinePtr != indexPtr->linePtr;
+ siblingLinePtr = siblingLinePtr->nextPtr) {
+ for (segPtr = siblingLinePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if ((segPtr->typePtr == &tkTextToggleOnType)
+ || (segPtr->typePtr == &tkTextToggleOffType)) {
+ IncCount(segPtr->body.toggle.tagPtr, 1, &tagInfo);
+ }
+ }
+ }
+
+ /*
+ * For each node in the ancestry of this line, record tag toggles
+ * for all siblings that precede that node.
+ */
+
+ for (nodePtr = indexPtr->linePtr->parentPtr; nodePtr->parentPtr != NULL;
+ nodePtr = nodePtr->parentPtr) {
+ register Node *siblingPtr;
+ register Summary *summaryPtr;
+
+ for (siblingPtr = nodePtr->parentPtr->children.nodePtr;
+ siblingPtr != nodePtr; siblingPtr = siblingPtr->nextPtr) {
+ for (summaryPtr = siblingPtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->toggleCount & 1) {
+ IncCount(summaryPtr->tagPtr, summaryPtr->toggleCount,
+ &tagInfo);
+ }
+ }
+ }
+ }
+
+ /*
+ * Go through the tag information and squash out all of the tags
+ * that have even toggle counts (these tags exist before the point
+ * of interest, but not at the desired character itself).
+ */
+
+ for (src = 0, dst = 0; src < tagInfo.numTags; src++) {
+ if (tagInfo.counts[src] & 1) {
+ tagInfo.tagPtrs[dst] = tagInfo.tagPtrs[src];
+ dst++;
+ }
+ }
+ *numTagsPtr = dst;
+ ckfree((char *) tagInfo.counts);
+ if (dst == 0) {
+ ckfree((char *) tagInfo.tagPtrs);
+ return NULL;
+ }
+ return tagInfo.tagPtrs;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IncCount --
+ *
+ * This is a utility procedure used by TkBTreeGetTags. It
+ * increments the count for a particular tag, adding a new
+ * entry for that tag if there wasn't one previously.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The information at *tagInfoPtr may be modified, and the arrays
+ * may be reallocated to make them larger.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+IncCount(tagPtr, inc, tagInfoPtr)
+ TkTextTag *tagPtr; /* Handle for tag. */
+ int inc; /* Amount by which to increment tag count. */
+ TagInfo *tagInfoPtr; /* Holds cumulative information about tags;
+ * increment count here. */
+{
+ register TkTextTag **tagPtrPtr;
+ int count;
+
+ for (tagPtrPtr = tagInfoPtr->tagPtrs, count = tagInfoPtr->numTags;
+ count > 0; tagPtrPtr++, count--) {
+ if (*tagPtrPtr == tagPtr) {
+ tagInfoPtr->counts[tagInfoPtr->numTags-count] += inc;
+ return;
+ }
+ }
+
+ /*
+ * There isn't currently an entry for this tag, so we have to
+ * make a new one. If the arrays are full, then enlarge the
+ * arrays first.
+ */
+
+ if (tagInfoPtr->numTags == tagInfoPtr->arraySize) {
+ TkTextTag **newTags;
+ int *newCounts, newSize;
+
+ newSize = 2*tagInfoPtr->arraySize;
+ newTags = (TkTextTag **) ckalloc((unsigned)
+ (newSize*sizeof(TkTextTag *)));
+ memcpy((VOID *) newTags, (VOID *) tagInfoPtr->tagPtrs,
+ tagInfoPtr->arraySize * sizeof(TkTextTag *));
+ ckfree((char *) tagInfoPtr->tagPtrs);
+ tagInfoPtr->tagPtrs = newTags;
+ newCounts = (int *) ckalloc((unsigned) (newSize*sizeof(int)));
+ memcpy((VOID *) newCounts, (VOID *) tagInfoPtr->counts,
+ tagInfoPtr->arraySize * sizeof(int));
+ ckfree((char *) tagInfoPtr->counts);
+ tagInfoPtr->counts = newCounts;
+ tagInfoPtr->arraySize = newSize;
+ }
+
+ tagInfoPtr->tagPtrs[tagInfoPtr->numTags] = tagPtr;
+ tagInfoPtr->counts[tagInfoPtr->numTags] = inc;
+ tagInfoPtr->numTags++;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeCheck --
+ *
+ * This procedure runs a set of consistency checks over a B-tree
+ * and panics if any inconsistencies are found.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a structural defect is found, the procedure panics with an
+ * error message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkBTreeCheck(tree)
+ TkTextBTree tree; /* Tree to check. */
+{
+ BTree *treePtr = (BTree *) tree;
+ register Summary *summaryPtr;
+ register Node *nodePtr;
+ register TkTextLine *linePtr;
+ register TkTextSegment *segPtr;
+ register TkTextTag *tagPtr;
+ Tcl_HashEntry *entryPtr;
+ Tcl_HashSearch search;
+ int count;
+
+ /*
+ * Make sure that the tag toggle counts and the tag root pointers are OK.
+ */
+ for (entryPtr = Tcl_FirstHashEntry(&treePtr->textPtr->tagTable, &search);
+ entryPtr != NULL ; entryPtr = Tcl_NextHashEntry(&search)) {
+ tagPtr = (TkTextTag *) Tcl_GetHashValue(entryPtr);
+ nodePtr = tagPtr->tagRootPtr;
+ if (nodePtr == (Node *) NULL) {
+ if (tagPtr->toggleCount != 0) {
+ panic("TkBTreeCheck found \"%s\" with toggles (%d) but no root",
+ tagPtr->name, tagPtr->toggleCount);
+ }
+ continue; /* no ranges for the tag */
+ } else if (tagPtr->toggleCount == 0) {
+ panic("TkBTreeCheck found root for \"%s\" with no toggles",
+ tagPtr->name);
+ } else if (tagPtr->toggleCount & 1) {
+ panic("TkBTreeCheck found odd toggle count for \"%s\" (%d)",
+ tagPtr->name, tagPtr->toggleCount);
+ }
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ panic("TkBTreeCheck found root node with summary info");
+ }
+ }
+ count = 0;
+ if (nodePtr->level > 0) {
+ for (nodePtr = nodePtr->children.nodePtr ; nodePtr != NULL ;
+ nodePtr = nodePtr->nextPtr) {
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr == tagPtr) {
+ count += summaryPtr->toggleCount;
+ }
+ }
+ }
+ } else {
+ for (linePtr = nodePtr->children.linePtr ; linePtr != NULL ;
+ linePtr = linePtr->nextPtr) {
+ for (segPtr = linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if ((segPtr->typePtr == &tkTextToggleOnType ||
+ segPtr->typePtr == &tkTextToggleOffType) &&
+ segPtr->body.toggle.tagPtr == tagPtr) {
+ count++;
+ }
+ }
+ }
+ }
+ if (count != tagPtr->toggleCount) {
+ panic("TkBTreeCheck toggleCount (%d) wrong for \"%s\" should be (%d)",
+ tagPtr->toggleCount, tagPtr->name, count);
+ }
+ }
+
+ /*
+ * Call a recursive procedure to do the main body of checks.
+ */
+
+ nodePtr = treePtr->rootPtr;
+ CheckNodeConsistency(treePtr->rootPtr);
+
+ /*
+ * Make sure that there are at least two lines in the text and
+ * that the last line has no characters except a newline.
+ */
+
+ if (nodePtr->numLines < 2) {
+ panic("TkBTreeCheck: less than 2 lines in tree");
+ }
+ while (nodePtr->level > 0) {
+ nodePtr = nodePtr->children.nodePtr;
+ while (nodePtr->nextPtr != NULL) {
+ nodePtr = nodePtr->nextPtr;
+ }
+ }
+ linePtr = nodePtr->children.linePtr;
+ while (linePtr->nextPtr != NULL) {
+ linePtr = linePtr->nextPtr;
+ }
+ segPtr = linePtr->segPtr;
+ while ((segPtr->typePtr == &tkTextToggleOffType)
+ || (segPtr->typePtr == &tkTextRightMarkType)
+ || (segPtr->typePtr == &tkTextLeftMarkType)) {
+ /*
+ * It's OK to toggle a tag off in the last line, but
+ * not to start a new range. It's also OK to have marks
+ * in the last line.
+ */
+
+ segPtr = segPtr->nextPtr;
+ }
+ if (segPtr->typePtr != &tkTextCharType) {
+ panic("TkBTreeCheck: last line has bogus segment type");
+ }
+ if (segPtr->nextPtr != NULL) {
+ panic("TkBTreeCheck: last line has too many segments");
+ }
+ if (segPtr->size != 1) {
+ panic("TkBTreeCheck: last line has wrong # characters: %d",
+ segPtr->size);
+ }
+ if ((segPtr->body.chars[0] != '\n') || (segPtr->body.chars[1] != 0)) {
+ panic("TkBTreeCheck: last line had bad value: %s",
+ segPtr->body.chars);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CheckNodeConsistency --
+ *
+ * This procedure is called as part of consistency checking for
+ * B-trees: it checks several aspects of a node and also runs
+ * checks recursively on the node's children.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If anything suspicious is found in the tree structure, the
+ * procedure panics.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CheckNodeConsistency(nodePtr)
+ register Node *nodePtr; /* Node whose subtree should be
+ * checked. */
+{
+ register Node *childNodePtr;
+ register Summary *summaryPtr, *summaryPtr2;
+ register TkTextLine *linePtr;
+ register TkTextSegment *segPtr;
+ int numChildren, numLines, toggleCount, minChildren;
+
+ if (nodePtr->parentPtr != NULL) {
+ minChildren = MIN_CHILDREN;
+ } else if (nodePtr->level > 0) {
+ minChildren = 2;
+ } else {
+ minChildren = 1;
+ }
+ if ((nodePtr->numChildren < minChildren)
+ || (nodePtr->numChildren > MAX_CHILDREN)) {
+ panic("CheckNodeConsistency: bad child count (%d)",
+ nodePtr->numChildren);
+ }
+
+ numChildren = 0;
+ numLines = 0;
+ if (nodePtr->level == 0) {
+ for (linePtr = nodePtr->children.linePtr; linePtr != NULL;
+ linePtr = linePtr->nextPtr) {
+ if (linePtr->parentPtr != nodePtr) {
+ panic("CheckNodeConsistency: line doesn't point to parent");
+ }
+ if (linePtr->segPtr == NULL) {
+ panic("CheckNodeConsistency: line has no segments");
+ }
+ for (segPtr = linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr->checkProc != NULL) {
+ (*segPtr->typePtr->checkProc)(segPtr, linePtr);
+ }
+ if ((segPtr->size == 0) && (!segPtr->typePtr->leftGravity)
+ && (segPtr->nextPtr != NULL)
+ && (segPtr->nextPtr->size == 0)
+ && (segPtr->nextPtr->typePtr->leftGravity)) {
+ panic("CheckNodeConsistency: wrong segment order for gravity");
+ }
+ if ((segPtr->nextPtr == NULL)
+ && (segPtr->typePtr != &tkTextCharType)) {
+ panic("CheckNodeConsistency: line ended with wrong type");
+ }
+ }
+ numChildren++;
+ numLines++;
+ }
+ } else {
+ for (childNodePtr = nodePtr->children.nodePtr; childNodePtr != NULL;
+ childNodePtr = childNodePtr->nextPtr) {
+ if (childNodePtr->parentPtr != nodePtr) {
+ panic("CheckNodeConsistency: node doesn't point to parent");
+ }
+ if (childNodePtr->level != (nodePtr->level-1)) {
+ panic("CheckNodeConsistency: level mismatch (%d %d)",
+ nodePtr->level, childNodePtr->level);
+ }
+ CheckNodeConsistency(childNodePtr);
+ for (summaryPtr = childNodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ for (summaryPtr2 = nodePtr->summaryPtr; ;
+ summaryPtr2 = summaryPtr2->nextPtr) {
+ if (summaryPtr2 == NULL) {
+ if (summaryPtr->tagPtr->tagRootPtr == nodePtr) {
+ break;
+ }
+ panic("CheckNodeConsistency: node tag \"%s\" not %s",
+ summaryPtr->tagPtr->name,
+ "present in parent summaries");
+ }
+ if (summaryPtr->tagPtr == summaryPtr2->tagPtr) {
+ break;
+ }
+ }
+ }
+ numChildren++;
+ numLines += childNodePtr->numLines;
+ }
+ }
+ if (numChildren != nodePtr->numChildren) {
+ panic("CheckNodeConsistency: mismatch in numChildren (%d %d)",
+ numChildren, nodePtr->numChildren);
+ }
+ if (numLines != nodePtr->numLines) {
+ panic("CheckNodeConsistency: mismatch in numLines (%d %d)",
+ numLines, nodePtr->numLines);
+ }
+
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr->tagPtr->toggleCount == summaryPtr->toggleCount) {
+ panic("CheckNodeConsistency: found unpruned root for \"%s\"",
+ summaryPtr->tagPtr->name);
+ }
+ toggleCount = 0;
+ if (nodePtr->level == 0) {
+ for (linePtr = nodePtr->children.linePtr; linePtr != NULL;
+ linePtr = linePtr->nextPtr) {
+ for (segPtr = linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if ((segPtr->typePtr != &tkTextToggleOnType)
+ && (segPtr->typePtr != &tkTextToggleOffType)) {
+ continue;
+ }
+ if (segPtr->body.toggle.tagPtr == summaryPtr->tagPtr) {
+ toggleCount ++;
+ }
+ }
+ }
+ } else {
+ for (childNodePtr = nodePtr->children.nodePtr;
+ childNodePtr != NULL;
+ childNodePtr = childNodePtr->nextPtr) {
+ for (summaryPtr2 = childNodePtr->summaryPtr;
+ summaryPtr2 != NULL;
+ summaryPtr2 = summaryPtr2->nextPtr) {
+ if (summaryPtr2->tagPtr == summaryPtr->tagPtr) {
+ toggleCount += summaryPtr2->toggleCount;
+ }
+ }
+ }
+ }
+ if (toggleCount != summaryPtr->toggleCount) {
+ panic("CheckNodeConsistency: mismatch in toggleCount (%d %d)",
+ toggleCount, summaryPtr->toggleCount);
+ }
+ for (summaryPtr2 = summaryPtr->nextPtr; summaryPtr2 != NULL;
+ summaryPtr2 = summaryPtr2->nextPtr) {
+ if (summaryPtr2->tagPtr == summaryPtr->tagPtr) {
+ panic("CheckNodeConsistency: duplicated node tag: %s",
+ summaryPtr->tagPtr->name);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Rebalance --
+ *
+ * This procedure is called when a node of a B-tree appears to be
+ * out of balance (too many children, or too few). It rebalances
+ * that node and all of its ancestors in the tree.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The internal structure of treePtr may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+Rebalance(treePtr, nodePtr)
+ BTree *treePtr; /* Tree that is being rebalanced. */
+ register Node *nodePtr; /* Node that may be out of balance. */
+{
+ /*
+ * Loop over the entire ancestral chain of the node, working up
+ * through the tree one node at a time until the root node has
+ * been processed.
+ */
+
+ for ( ; nodePtr != NULL; nodePtr = nodePtr->parentPtr) {
+ register Node *newPtr, *childPtr;
+ register TkTextLine *linePtr;
+ int i;
+
+ /*
+ * Check to see if the node has too many children. If it does,
+ * then split off all but the first MIN_CHILDREN into a separate
+ * node following the original one. Then repeat until the
+ * node has a decent size.
+ */
+
+ if (nodePtr->numChildren > MAX_CHILDREN) {
+ while (1) {
+ /*
+ * If the node being split is the root node, then make a
+ * new root node above it first.
+ */
+
+ if (nodePtr->parentPtr == NULL) {
+ newPtr = (Node *) ckalloc(sizeof(Node));
+ newPtr->parentPtr = NULL;
+ newPtr->nextPtr = NULL;
+ newPtr->summaryPtr = NULL;
+ newPtr->level = nodePtr->level + 1;
+ newPtr->children.nodePtr = nodePtr;
+ newPtr->numChildren = 1;
+ newPtr->numLines = nodePtr->numLines;
+ RecomputeNodeCounts(newPtr);
+ treePtr->rootPtr = newPtr;
+ }
+ newPtr = (Node *) ckalloc(sizeof(Node));
+ newPtr->parentPtr = nodePtr->parentPtr;
+ newPtr->nextPtr = nodePtr->nextPtr;
+ nodePtr->nextPtr = newPtr;
+ newPtr->summaryPtr = NULL;
+ newPtr->level = nodePtr->level;
+ newPtr->numChildren = nodePtr->numChildren - MIN_CHILDREN;
+ if (nodePtr->level == 0) {
+ for (i = MIN_CHILDREN-1,
+ linePtr = nodePtr->children.linePtr;
+ i > 0; i--, linePtr = linePtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ newPtr->children.linePtr = linePtr->nextPtr;
+ linePtr->nextPtr = NULL;
+ } else {
+ for (i = MIN_CHILDREN-1,
+ childPtr = nodePtr->children.nodePtr;
+ i > 0; i--, childPtr = childPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ newPtr->children.nodePtr = childPtr->nextPtr;
+ childPtr->nextPtr = NULL;
+ }
+ RecomputeNodeCounts(nodePtr);
+ nodePtr->parentPtr->numChildren++;
+ nodePtr = newPtr;
+ if (nodePtr->numChildren <= MAX_CHILDREN) {
+ RecomputeNodeCounts(nodePtr);
+ break;
+ }
+ }
+ }
+
+ while (nodePtr->numChildren < MIN_CHILDREN) {
+ register Node *otherPtr;
+ Node *halfwayNodePtr = NULL; /* Initialization needed only */
+ TkTextLine *halfwayLinePtr = NULL; /* to prevent cc warnings. */
+ int totalChildren, firstChildren, i;
+
+ /*
+ * Too few children for this node. If this is the root then,
+ * it's OK for it to have less than MIN_CHILDREN children
+ * as long as it's got at least two. If it has only one
+ * (and isn't at level 0), then chop the root node out of
+ * the tree and use its child as the new root.
+ */
+
+ if (nodePtr->parentPtr == NULL) {
+ if ((nodePtr->numChildren == 1) && (nodePtr->level > 0)) {
+ treePtr->rootPtr = nodePtr->children.nodePtr;
+ treePtr->rootPtr->parentPtr = NULL;
+ DeleteSummaries(nodePtr->summaryPtr);
+ ckfree((char *) nodePtr);
+ }
+ return;
+ }
+
+ /*
+ * Not the root. Make sure that there are siblings to
+ * balance with.
+ */
+
+ if (nodePtr->parentPtr->numChildren < 2) {
+ Rebalance(treePtr, nodePtr->parentPtr);
+ continue;
+ }
+
+ /*
+ * Find a sibling neighbor to borrow from, and arrange for
+ * nodePtr to be the earlier of the pair.
+ */
+
+ if (nodePtr->nextPtr == NULL) {
+ for (otherPtr = nodePtr->parentPtr->children.nodePtr;
+ otherPtr->nextPtr != nodePtr;
+ otherPtr = otherPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ nodePtr = otherPtr;
+ }
+ otherPtr = nodePtr->nextPtr;
+
+ /*
+ * We're going to either merge the two siblings together
+ * into one node or redivide the children among them to
+ * balance their loads. As preparation, join their two
+ * child lists into a single list and remember the half-way
+ * point in the list.
+ */
+
+ totalChildren = nodePtr->numChildren + otherPtr->numChildren;
+ firstChildren = totalChildren/2;
+ if (nodePtr->children.nodePtr == NULL) {
+ nodePtr->children = otherPtr->children;
+ otherPtr->children.nodePtr = NULL;
+ otherPtr->children.linePtr = NULL;
+ }
+ if (nodePtr->level == 0) {
+ register TkTextLine *linePtr;
+
+ for (linePtr = nodePtr->children.linePtr, i = 1;
+ linePtr->nextPtr != NULL;
+ linePtr = linePtr->nextPtr, i++) {
+ if (i == firstChildren) {
+ halfwayLinePtr = linePtr;
+ }
+ }
+ linePtr->nextPtr = otherPtr->children.linePtr;
+ while (i <= firstChildren) {
+ halfwayLinePtr = linePtr;
+ linePtr = linePtr->nextPtr;
+ i++;
+ }
+ } else {
+ register Node *childPtr;
+
+ for (childPtr = nodePtr->children.nodePtr, i = 1;
+ childPtr->nextPtr != NULL;
+ childPtr = childPtr->nextPtr, i++) {
+ if (i <= firstChildren) {
+ if (i == firstChildren) {
+ halfwayNodePtr = childPtr;
+ }
+ }
+ }
+ childPtr->nextPtr = otherPtr->children.nodePtr;
+ while (i <= firstChildren) {
+ halfwayNodePtr = childPtr;
+ childPtr = childPtr->nextPtr;
+ i++;
+ }
+ }
+
+ /*
+ * If the two siblings can simply be merged together, do it.
+ */
+
+ if (totalChildren <= MAX_CHILDREN) {
+ RecomputeNodeCounts(nodePtr);
+ nodePtr->nextPtr = otherPtr->nextPtr;
+ nodePtr->parentPtr->numChildren--;
+ DeleteSummaries(otherPtr->summaryPtr);
+ ckfree((char *) otherPtr);
+ continue;
+ }
+
+ /*
+ * The siblings can't be merged, so just divide their
+ * children evenly between them.
+ */
+
+ if (nodePtr->level == 0) {
+ otherPtr->children.linePtr = halfwayLinePtr->nextPtr;
+ halfwayLinePtr->nextPtr = NULL;
+ } else {
+ otherPtr->children.nodePtr = halfwayNodePtr->nextPtr;
+ halfwayNodePtr->nextPtr = NULL;
+ }
+ RecomputeNodeCounts(nodePtr);
+ RecomputeNodeCounts(otherPtr);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecomputeNodeCounts --
+ *
+ * This procedure is called to recompute all the counts in a node
+ * (tags, child information, etc.) by scanning the information in
+ * its descendants. This procedure is called during rebalancing
+ * when a node's child structure has changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The tag counts for nodePtr are modified to reflect its current
+ * child structure, as are its numChildren and numLines fields.
+ * Also, all of the childrens' parentPtr fields are made to point
+ * to nodePtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RecomputeNodeCounts(nodePtr)
+ register Node *nodePtr; /* Node whose tag summary information
+ * must be recomputed. */
+{
+ register Summary *summaryPtr, *summaryPtr2;
+ register Node *childPtr;
+ register TkTextLine *linePtr;
+ register TkTextSegment *segPtr;
+ TkTextTag *tagPtr;
+
+ /*
+ * Zero out all the existing counts for the node, but don't delete
+ * the existing Summary records (most of them will probably be reused).
+ */
+
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL;
+ summaryPtr = summaryPtr->nextPtr) {
+ summaryPtr->toggleCount = 0;
+ }
+ nodePtr->numChildren = 0;
+ nodePtr->numLines = 0;
+
+ /*
+ * Scan through the children, adding the childrens' tag counts into
+ * the node's tag counts and adding new Summary structures if
+ * necessary.
+ */
+
+ if (nodePtr->level == 0) {
+ for (linePtr = nodePtr->children.linePtr; linePtr != NULL;
+ linePtr = linePtr->nextPtr) {
+ nodePtr->numChildren++;
+ nodePtr->numLines++;
+ linePtr->parentPtr = nodePtr;
+ for (segPtr = linePtr->segPtr; segPtr != NULL;
+ segPtr = segPtr->nextPtr) {
+ if (((segPtr->typePtr != &tkTextToggleOnType)
+ && (segPtr->typePtr != &tkTextToggleOffType))
+ || !(segPtr->body.toggle.inNodeCounts)) {
+ continue;
+ }
+ tagPtr = segPtr->body.toggle.tagPtr;
+ for (summaryPtr = nodePtr->summaryPtr; ;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr == NULL) {
+ summaryPtr = (Summary *) ckalloc(sizeof(Summary));
+ summaryPtr->tagPtr = tagPtr;
+ summaryPtr->toggleCount = 1;
+ summaryPtr->nextPtr = nodePtr->summaryPtr;
+ nodePtr->summaryPtr = summaryPtr;
+ break;
+ }
+ if (summaryPtr->tagPtr == tagPtr) {
+ summaryPtr->toggleCount++;
+ break;
+ }
+ }
+ }
+ }
+ } else {
+ for (childPtr = nodePtr->children.nodePtr; childPtr != NULL;
+ childPtr = childPtr->nextPtr) {
+ nodePtr->numChildren++;
+ nodePtr->numLines += childPtr->numLines;
+ childPtr->parentPtr = nodePtr;
+ for (summaryPtr2 = childPtr->summaryPtr; summaryPtr2 != NULL;
+ summaryPtr2 = summaryPtr2->nextPtr) {
+ for (summaryPtr = nodePtr->summaryPtr; ;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr == NULL) {
+ summaryPtr = (Summary *) ckalloc(sizeof(Summary));
+ summaryPtr->tagPtr = summaryPtr2->tagPtr;
+ summaryPtr->toggleCount = summaryPtr2->toggleCount;
+ summaryPtr->nextPtr = nodePtr->summaryPtr;
+ nodePtr->summaryPtr = summaryPtr;
+ break;
+ }
+ if (summaryPtr->tagPtr == summaryPtr2->tagPtr) {
+ summaryPtr->toggleCount += summaryPtr2->toggleCount;
+ break;
+ }
+ }
+ }
+ }
+ }
+
+ /*
+ * Scan through the node's tag records again and delete any Summary
+ * records that still have a zero count, or that have all the toggles.
+ * The node with the children that account for all the tags toggles
+ * have no summary information, and they become the tagRootPtr for the tag.
+ */
+
+ summaryPtr2 = NULL;
+ for (summaryPtr = nodePtr->summaryPtr; summaryPtr != NULL; ) {
+ if (summaryPtr->toggleCount > 0 &&
+ summaryPtr->toggleCount < summaryPtr->tagPtr->toggleCount) {
+ if (nodePtr->level == summaryPtr->tagPtr->tagRootPtr->level) {
+ /*
+ * The tag's root node split and some toggles left.
+ * The tag root must move up a level.
+ */
+ summaryPtr->tagPtr->tagRootPtr = nodePtr->parentPtr;
+ }
+ summaryPtr2 = summaryPtr;
+ summaryPtr = summaryPtr->nextPtr;
+ continue;
+ }
+ if (summaryPtr->toggleCount == summaryPtr->tagPtr->toggleCount) {
+ /*
+ * A node merge has collected all the toggles under one node.
+ * Push the root down to this level.
+ */
+ summaryPtr->tagPtr->tagRootPtr = nodePtr;
+ }
+ if (summaryPtr2 != NULL) {
+ summaryPtr2->nextPtr = summaryPtr->nextPtr;
+ ckfree((char *) summaryPtr);
+ summaryPtr = summaryPtr2->nextPtr;
+ } else {
+ nodePtr->summaryPtr = summaryPtr->nextPtr;
+ ckfree((char *) summaryPtr);
+ summaryPtr = nodePtr->summaryPtr;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeNumLines --
+ *
+ * This procedure returns a count of the number of lines of
+ * text present in a given B-tree.
+ *
+ * Results:
+ * The return value is a count of the number of usable lines
+ * in tree (i.e. it doesn't include the dummy line that is just
+ * used to mark the end of the tree).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkBTreeNumLines(tree)
+ TkTextBTree tree; /* Information about tree. */
+{
+ BTree *treePtr = (BTree *) tree;
+ return treePtr->rootPtr->numLines - 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharSplitProc --
+ *
+ * This procedure implements splitting for character segments.
+ *
+ * Results:
+ * The return value is a pointer to a chain of two segments
+ * that have the same characters as segPtr except split
+ * among the two segments.
+ *
+ * Side effects:
+ * Storage for segPtr is freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextSegment *
+CharSplitProc(segPtr, index)
+ TkTextSegment *segPtr; /* Pointer to segment to split. */
+ int index; /* Position within segment at which
+ * to split. */
+{
+ TkTextSegment *newPtr1, *newPtr2;
+
+ newPtr1 = (TkTextSegment *) ckalloc(CSEG_SIZE(index));
+ newPtr2 = (TkTextSegment *) ckalloc(
+ CSEG_SIZE(segPtr->size - index));
+ newPtr1->typePtr = &tkTextCharType;
+ newPtr1->nextPtr = newPtr2;
+ newPtr1->size = index;
+ strncpy(newPtr1->body.chars, segPtr->body.chars, (size_t) index);
+ newPtr1->body.chars[index] = 0;
+ newPtr2->typePtr = &tkTextCharType;
+ newPtr2->nextPtr = segPtr->nextPtr;
+ newPtr2->size = segPtr->size - index;
+ strcpy(newPtr2->body.chars, segPtr->body.chars + index);
+ ckfree((char*) segPtr);
+ return newPtr1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharCleanupProc --
+ *
+ * This procedure merges adjacent character segments into
+ * a single character segment, if possible.
+ *
+ * Results:
+ * The return value is a pointer to the first segment in
+ * the (new) list of segments that used to start with segPtr.
+ *
+ * Side effects:
+ * Storage for the segments may be allocated and freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static TkTextSegment *
+CharCleanupProc(segPtr, linePtr)
+ TkTextSegment *segPtr; /* Pointer to first of two adjacent
+ * segments to join. */
+ TkTextLine *linePtr; /* Line containing segments (not
+ * used). */
+{
+ TkTextSegment *segPtr2, *newPtr;
+
+ segPtr2 = segPtr->nextPtr;
+ if ((segPtr2 == NULL) || (segPtr2->typePtr != &tkTextCharType)) {
+ return segPtr;
+ }
+ newPtr = (TkTextSegment *) ckalloc(CSEG_SIZE(
+ segPtr->size + segPtr2->size));
+ newPtr->typePtr = &tkTextCharType;
+ newPtr->nextPtr = segPtr2->nextPtr;
+ newPtr->size = segPtr->size + segPtr2->size;
+ strcpy(newPtr->body.chars, segPtr->body.chars);
+ strcpy(newPtr->body.chars + segPtr->size, segPtr2->body.chars);
+ ckfree((char*) segPtr);
+ ckfree((char*) segPtr2);
+ return newPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharDeleteProc --
+ *
+ * This procedure is invoked to delete a character segment.
+ *
+ * Results:
+ * Always returns 0 to indicate that the segment was deleted.
+ *
+ * Side effects:
+ * Storage for the segment is freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+CharDeleteProc(segPtr, linePtr, treeGone)
+ TkTextSegment *segPtr; /* Segment to delete. */
+ TkTextLine *linePtr; /* Line containing segment. */
+ int treeGone; /* Non-zero means the entire tree is
+ * being deleted, so everything must
+ * get cleaned up. */
+{
+ ckfree((char*) segPtr);
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharCheckProc --
+ *
+ * This procedure is invoked to perform consistency checks
+ * on character segments.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If the segment isn't inconsistent then the procedure
+ * panics.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+CharCheckProc(segPtr, linePtr)
+ TkTextSegment *segPtr; /* Segment to check. */
+ TkTextLine *linePtr; /* Line containing segment. */
+{
+ /*
+ * Make sure that the segment contains the number of
+ * characters indicated by its header, and that the last
+ * segment in a line ends in a newline. Also make sure
+ * that there aren't ever two character segments adjacent
+ * to each other: they should be merged together.
+ */
+
+ if (segPtr->size <= 0) {
+ panic("CharCheckProc: segment has size <= 0");
+ }
+ if (strlen(segPtr->body.chars) != (size_t) segPtr->size) {
+ panic("CharCheckProc: segment has wrong size");
+ }
+ if (segPtr->nextPtr == NULL) {
+ if (segPtr->body.chars[segPtr->size-1] != '\n') {
+ panic("CharCheckProc: line doesn't end with newline");
+ }
+ } else {
+ if (segPtr->nextPtr->typePtr == &tkTextCharType) {
+ panic("CharCheckProc: adjacent character segments weren't merged");
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ToggleDeleteProc --
+ *
+ * This procedure is invoked to delete toggle segments.
+ *
+ * Results:
+ * Returns 1 to indicate that the segment may not be deleted,
+ * unless the entire B-tree is going away.
+ *
+ * Side effects:
+ * If the tree is going away then the toggle's memory is
+ * freed; otherwise the toggle counts in nodes above the
+ * segment get updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ToggleDeleteProc(segPtr, linePtr, treeGone)
+ TkTextSegment *segPtr; /* Segment to check. */
+ TkTextLine *linePtr; /* Line containing segment. */
+ int treeGone; /* Non-zero means the entire tree is
+ * being deleted, so everything must
+ * get cleaned up. */
+{
+ if (treeGone) {
+ ckfree((char *) segPtr);
+ return 0;
+ }
+
+ /*
+ * This toggle is in the middle of a range of characters that's
+ * being deleted. Refuse to die. We'll be moved to the end of
+ * the deleted range and our cleanup procedure will be called
+ * later. Decrement node toggle counts here, and set a flag
+ * so we'll re-increment them in the cleanup procedure.
+ */
+
+ if (segPtr->body.toggle.inNodeCounts) {
+ ChangeNodeToggleCount(linePtr->parentPtr,
+ segPtr->body.toggle.tagPtr, -1);
+ segPtr->body.toggle.inNodeCounts = 0;
+ }
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ToggleCleanupProc --
+ *
+ * This procedure is called when a toggle is part of a line that's
+ * been modified in some way. It's invoked after the
+ * modifications are complete.
+ *
+ * Results:
+ * The return value is the head segment in a new list
+ * that is to replace the tail of the line that used to
+ * start at segPtr. This allows the procedure to delete
+ * or modify segPtr.
+ *
+ * Side effects:
+ * Toggle counts in the nodes above the new line will be
+ * updated if they're not already. Toggles may be collapsed
+ * if there are duplicate toggles at the same position.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextSegment *
+ToggleCleanupProc(segPtr, linePtr)
+ TkTextSegment *segPtr; /* Segment to check. */
+ TkTextLine *linePtr; /* Line that now contains segment. */
+{
+ TkTextSegment *segPtr2, *prevPtr;
+ int counts;
+
+ /*
+ * If this is a toggle-off segment, look ahead through the next
+ * segments to see if there's a toggle-on segment for the same tag
+ * before any segments with non-zero size. If so then the two
+ * toggles cancel each other; remove them both.
+ */
+
+ if (segPtr->typePtr == &tkTextToggleOffType) {
+ for (prevPtr = segPtr, segPtr2 = prevPtr->nextPtr;
+ (segPtr2 != NULL) && (segPtr2->size == 0);
+ prevPtr = segPtr2, segPtr2 = prevPtr->nextPtr) {
+ if (segPtr2->typePtr != &tkTextToggleOnType) {
+ continue;
+ }
+ if (segPtr2->body.toggle.tagPtr != segPtr->body.toggle.tagPtr) {
+ continue;
+ }
+ counts = segPtr->body.toggle.inNodeCounts
+ + segPtr2->body.toggle.inNodeCounts;
+ if (counts != 0) {
+ ChangeNodeToggleCount(linePtr->parentPtr,
+ segPtr->body.toggle.tagPtr, -counts);
+ }
+ prevPtr->nextPtr = segPtr2->nextPtr;
+ ckfree((char *) segPtr2);
+ segPtr2 = segPtr->nextPtr;
+ ckfree((char *) segPtr);
+ return segPtr2;
+ }
+ }
+
+ if (!segPtr->body.toggle.inNodeCounts) {
+ ChangeNodeToggleCount(linePtr->parentPtr,
+ segPtr->body.toggle.tagPtr, 1);
+ segPtr->body.toggle.inNodeCounts = 1;
+ }
+ return segPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ToggleLineChangeProc --
+ *
+ * This procedure is invoked when a toggle segment is about
+ * to move from one line to another.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Toggle counts are decremented in the nodes above the line.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ToggleLineChangeProc(segPtr, linePtr)
+ TkTextSegment *segPtr; /* Segment to check. */
+ TkTextLine *linePtr; /* Line that used to contain segment. */
+{
+ if (segPtr->body.toggle.inNodeCounts) {
+ ChangeNodeToggleCount(linePtr->parentPtr,
+ segPtr->body.toggle.tagPtr, -1);
+ segPtr->body.toggle.inNodeCounts = 0;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ToggleCheckProc --
+ *
+ * This procedure is invoked to perform consistency checks
+ * on toggle segments.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a consistency problem is found the procedure panics.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ToggleCheckProc(segPtr, linePtr)
+ TkTextSegment *segPtr; /* Segment to check. */
+ TkTextLine *linePtr; /* Line containing segment. */
+{
+ register Summary *summaryPtr;
+ int needSummary;
+
+ if (segPtr->size != 0) {
+ panic("ToggleCheckProc: segment had non-zero size");
+ }
+ if (!segPtr->body.toggle.inNodeCounts) {
+ panic("ToggleCheckProc: toggle counts not updated in nodes");
+ }
+ needSummary = (segPtr->body.toggle.tagPtr->tagRootPtr != linePtr->parentPtr);
+ for (summaryPtr = linePtr->parentPtr->summaryPtr; ;
+ summaryPtr = summaryPtr->nextPtr) {
+ if (summaryPtr == NULL) {
+ if (needSummary) {
+ panic("ToggleCheckProc: tag not present in node");
+ } else {
+ break;
+ }
+ }
+ if (summaryPtr->tagPtr == segPtr->body.toggle.tagPtr) {
+ if (!needSummary) {
+ panic("ToggleCheckProc: tag present in root node summary");
+ }
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkBTreeCharsInLine --
+ *
+ * This procedure returns a count of the number of characters
+ * in a given line.
+ *
+ * Results:
+ * The return value is the character count for linePtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+}
diff --git a/tk/generic/tkTextDisp.c b/tk/generic/tkTextDisp.c
new file mode 100644
index 00000000000..9d0afc19727
--- /dev/null
+++ b/tk/generic/tkTextDisp.c
@@ -0,0 +1,5045 @@
+/*
+ * 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$
+ */
+
+#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.
+ */
+
+typedef struct StyleValues {
+ Tk_3DBorder border; /* Used for drawing background under text.
+ * NULL means use widget background. */
+ int borderWidth; /* Width of 3-D border for background. */
+ int relief; /* 3-D relief for background. */
+ Pixmap bgStipple; /* Stipple bitmap for background. None
+ * means draw solid. */
+ XColor *fgColor; /* Foreground color for text. */
+ Tk_Font tkfont; /* Font for displaying text. */
+ Pixmap fgStipple; /* Stipple bitmap for text and other
+ * foreground stuff. None means draw
+ * solid.*/
+ int justify; /* Justification style for text. */
+ int lMargin1; /* Left margin, in pixels, for first display
+ * line of each text line. */
+ int lMargin2; /* Left margin, in pixels, for second and
+ * later display lines of each text line. */
+ int offset; /* Offset in pixels of baseline, relative to
+ * baseline of line. */
+ int overstrike; /* Non-zero means draw overstrike through
+ * text. */
+ int rMargin; /* Right margin, in pixels. */
+ int spacing1; /* Spacing above first dline in text line. */
+ 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.
+ */
+
+typedef struct TextStyle {
+ int refCount; /* Number of times this structure is
+ * referenced in Chunks. */
+ GC bgGC; /* Graphics context for background. None
+ * means use widget background. */
+ GC fgGC; /* Graphics context for foreground. */
+ StyleValues *sValuePtr; /* Raw information from which GCs were
+ * derived. */
+ Tcl_HashEntry *hPtr; /* Pointer to entry in styleTable. Used
+ * to delete entry. */
+} TextStyle;
+
+/*
+ * The following macro determines whether two styles have the same
+ * background so that, for example, no beveled border should be drawn
+ * between them.
+ */
+
+#define SAME_BACKGROUND(s1, s2) \
+ (((s1)->sValuePtr->border == (s2)->sValuePtr->border) \
+ && ((s1)->sValuePtr->borderWidth == (s2)->sValuePtr->borderWidth) \
+ && ((s1)->sValuePtr->relief == (s2)->sValuePtr->relief) \
+ && ((s1)->sValuePtr->bgStipple == (s2)->sValuePtr->bgStipple))
+
+/*
+ * 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
+ * currently visible on display and must be
+ * redrawn. This is used to move lines by
+ * scrolling rather than re-drawing. */
+ int height; /* Height of line, in pixels. */
+ int baseline; /* Offset of text baseline from y, in
+ * pixels. */
+ int spaceAbove; /* How much extra space was added to the
+ * top of the line because of spacing
+ * options. This is included in height
+ * and baseline. */
+ int spaceBelow; /* How much extra space was added to the
+ * bottom of the line because of spacing
+ * options. This is included in height. */
+ int length; /* Total length of line, in pixels. */
+ TkTextDispChunk *chunkPtr; /* Pointer to first chunk in list of all
+ * of those that are displayed on this
+ * line of the screen. */
+ struct DLine *nextPtr; /* Next in list of all display lines for
+ * this window. The list is sorted in
+ * order from top to bottom. Note: the
+ * next DLine doesn't always correspond
+ * to the next line of text: (a) can have
+ * multiple DLines for one text line, and
+ * (b) can have gaps where DLine's have been
+ * deleted because they're out of date. */
+ int flags; /* Various flag bits: see below for values. */
+} DLine;
+
+/*
+ * Flag bits for DLine structures:
+ *
+ * HAS_3D_BORDER - Non-zero means that at least one of the
+ * chunks in this line has a 3D border, so
+ * it potentially interacts with 3D borders
+ * in neighboring lines (see
+ * DisplayLineBackground).
+ * NEW_LAYOUT - Non-zero means that the line has been
+ * re-layed out since the last time the
+ * display was updated.
+ * TOP_LINE - Non-zero means that this was the top line
+ * in the window the last time that the window
+ * was laid out. This is important because
+ * a line may be displayed differently if its
+ * at the top or bottom than if it's in the
+ * middle (e.g. beveled edges aren't displayed
+ * for middle lines if the adjacent line has
+ * a similar background).
+ * BOTTOM_LINE - Non-zero means that this was the bottom line
+ * in the window the last time that the window
+ * was laid out.
+ */
+
+#define HAS_3D_BORDER 1
+#define NEW_LAYOUT 2
+#define TOP_LINE 4
+#define BOTTOM_LINE 8
+
+/*
+ * Overall display information for a text widget:
+ */
+
+typedef struct TextDInfo {
+ Tcl_HashTable styleTable; /* Hash table that maps from StyleValues
+ * to TextStyles for this widget. */
+ DLine *dLinePtr; /* First in list of all display lines for
+ * this widget, in order from top to bottom. */
+ GC copyGC; /* Graphics context for copying from off-
+ * screen pixmaps onto screen. */
+ GC scrollGC; /* Graphics context for copying from one place
+ * in the window to another (scrolling):
+ * differs from copyGC in that we need to get
+ * GraphicsExpose events. */
+ int x; /* First x-coordinate that may be used for
+ * actually displaying line information.
+ * Leaves space for border, etc. */
+ int y; /* First y-coordinate that may be used for
+ * actually displaying line information.
+ * Leaves space for border, etc. */
+ int maxX; /* First x-coordinate to right of available
+ * space for displaying lines. */
+ int maxY; /* First y-coordinate below available
+ * space for displaying lines. */
+ int topOfEof; /* Top-most pixel (lowest y-value) that has
+ * been drawn in the appropriate fashion for
+ * the portion of the window after the last
+ * line of the text. This field is used to
+ * 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
+ * size). If there's no wrapping, this will
+ * be zero. */
+ double xScrollFirst, xScrollLast;
+ /* Most recent values reported to horizontal
+ * scrollbar; used to eliminate unnecessary
+ * reports. */
+ double yScrollFirst, yScrollLast;
+ /* Most recent values reported to vertical
+ * 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:
+ */
+
+ int dLinesInvalidated; /* This value is set to 1 whenever something
+ * happens that invalidates information in
+ * DLine structures; if a redisplay
+ * is in progress, it will see this and
+ * abort the redisplay. This is needed
+ * because, for example, an embedded window
+ * could change its size when it is first
+ * displayed, invalidating the DLine that
+ * is currently being displayed. If redisplay
+ * continues, it will use freed memory and
+ * could dump core. */
+ int flags; /* Various flag values: see below for
+ * definitions. */
+} TextDInfo;
+
+/*
+ * 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
+ * for this window are partially or completely
+ * out of date and need to be recomputed.
+ * REDRAW_PENDING: Means that a when-idle handler has been
+ * scheduled to update the display.
+ * REDRAW_BORDERS: Means window border or pad area has
+ * potentially been damaged and must be redrawn.
+ * REPICK_NEEDED: 1 means that the widget has been modified
+ * in a way that could change the current
+ * character (a different character might be
+ * under the mouse cursor now). Need to
+ * recompute the current character before
+ * the next redisplay.
+ */
+
+#define DINFO_OUT_OF_DATE 1
+#define REDRAW_PENDING 2
+#define REDRAW_BORDERS 4
+#define REPICK_NEEDED 8
+
+/*
+ * The following counters keep statistics about redisplay that can be
+ * checked to see how clever this code is at reducing redisplays.
+ */
+
+static int numRedisplays; /* Number of calls to DisplayText. */
+static int linesRedrawn; /* Number of calls to DisplayDLine. */
+static int numCopies; /* Number of calls to XCopyArea to copy part
+ * of the screen. */
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void AdjustForTab _ANSI_ARGS_((TkText *textPtr,
+ TkTextTabArray *tabArrayPtr, int index,
+ TkTextDispChunk *chunkPtr));
+static void CharBboxProc _ANSI_ARGS_((TkTextDispChunk *chunkPtr,
+ int index, int y, int lineHeight, int baseline,
+ int *xPtr, int *yPtr, int *widthPtr,
+ int *heightPtr));
+static void CharDisplayProc _ANSI_ARGS_((TkTextDispChunk *chunkPtr,
+ int x, int y, int height, int baseline,
+ Display *display, Drawable dst, int screenY));
+static int CharMeasureProc _ANSI_ARGS_((TkTextDispChunk *chunkPtr,
+ int x));
+static void CharUndisplayProc _ANSI_ARGS_((TkText *textPtr,
+ TkTextDispChunk *chunkPtr));
+static void DisplayDLine _ANSI_ARGS_((TkText *textPtr,
+ DLine *dlPtr, DLine *prevPtr, Pixmap pixmap));
+static void DisplayLineBackground _ANSI_ARGS_((TkText *textPtr,
+ DLine *dlPtr, DLine *prevPtr, Pixmap pixmap));
+static void DisplayText _ANSI_ARGS_((ClientData clientData));
+static DLine * FindDLine _ANSI_ARGS_((DLine *dlPtr,
+ TkTextIndex *indexPtr));
+static void FreeDLines _ANSI_ARGS_((TkText *textPtr,
+ DLine *firstPtr, DLine *lastPtr, int unlink));
+static void FreeStyle _ANSI_ARGS_((TkText *textPtr,
+ TextStyle *stylePtr));
+static TextStyle * GetStyle _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr));
+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_((TkText *textPtr, Tk_Font tkfont, int x,
+ int tabOrigin));
+static void UpdateDisplayInfo _ANSI_ARGS_((TkText *textPtr));
+static void ScrollByLines _ANSI_ARGS_((TkText *textPtr,
+ int offset));
+static int SizeOfTab _ANSI_ARGS_((TkText *textPtr,
+ TkTextTabArray *tabArrayPtr, int index, int x,
+ int maxX));
+static void TextInvalidateRegion _ANSI_ARGS_((TkText *textPtr,
+ TkRegion region));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextCreateDInfo --
+ *
+ * This procedure is called when a new text widget is created.
+ * Its job is to set up display-related information for the widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A TextDInfo data structure is allocated and initialized and attached
+ * to textPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextCreateDInfo(textPtr)
+ TkText *textPtr; /* Overall information for text widget. */
+{
+ register TextDInfo *dInfoPtr;
+ XGCValues gcValues;
+
+ dInfoPtr = (TextDInfo *) ckalloc(sizeof(TextDInfo));
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextFreeDInfo --
+ *
+ * This procedure is called to free up all of the private display
+ * information kept by this file for a text widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Lots of resources get freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextFreeDInfo(textPtr)
+ TkText *textPtr; /* Overall information for text widget. */
+{
+ register TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+
+ /*
+ * Be careful to free up styleTable *after* freeing up all the
+ * DLines, so that the hash table is still intact to free up the
+ * style-related information from the lines. Once the lines are
+ * all free then styleTable will be empty.
+ */
+
+ FreeDLines(textPtr, dInfoPtr->dLinePtr, (DLine *) NULL, 1);
+ Tcl_DeleteHashTable(&dInfoPtr->styleTable);
+ if (dInfoPtr->copyGC != None) {
+ Tk_FreeGC(textPtr->display, dInfoPtr->copyGC);
+ }
+ Tk_FreeGC(textPtr->display, dInfoPtr->scrollGC);
+ if (dInfoPtr->flags & REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DisplayText, (ClientData) textPtr);
+ }
+ ckfree((char *) dInfoPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetStyle --
+ *
+ * This procedure creates all the information needed to display
+ * text at a particular location.
+ *
+ * Results:
+ * The return value is a pointer to a TextStyle structure that
+ * corresponds to *sValuePtr.
+ *
+ * Side effects:
+ * A new entry may be created in the style table for the widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TextStyle *
+GetStyle(textPtr, indexPtr)
+ TkText *textPtr; /* Overall information about text widget. */
+ TkTextIndex *indexPtr; /* The character in the text for which
+ * display information is wanted. */
+{
+ TkTextTag **tagPtrs;
+ register TkTextTag *tagPtr;
+ StyleValues styleValues;
+ TextStyle *stylePtr;
+ Tcl_HashEntry *hPtr;
+ int numTags, new, i;
+ XGCValues gcValues;
+ unsigned long mask;
+
+ /*
+ * The variables below keep track of the highest-priority specification
+ * that has occurred for each of the various fields of the StyleValues.
+ */
+
+ int borderPrio, borderWidthPrio, reliefPrio, bgStipplePrio;
+ int fgPrio, fontPrio, fgStipplePrio;
+ int underlinePrio, justifyPrio, offsetPrio;
+ int lMargin1Prio, lMargin2Prio, rMarginPrio;
+ int spacing1Prio, spacing2Prio, spacing3Prio;
+ int overstrikePrio, tabPrio, wrapPrio;
+
+ /*
+ * Find out what tags are present for the character, then compute
+ * a StyleValues structure corresponding to those tags (scan
+ * through all of the tags, saving information for the highest-
+ * priority tag).
+ */
+
+ tagPtrs = TkBTreeGetTags(indexPtr, &numTags);
+ borderPrio = borderWidthPrio = reliefPrio = bgStipplePrio = -1;
+ fgPrio = fontPrio = fgStipplePrio = -1;
+ underlinePrio = justifyPrio = offsetPrio = -1;
+ lMargin1Prio = lMargin2Prio = rMarginPrio = -1;
+ spacing1Prio = spacing2Prio = spacing3Prio = -1;
+ overstrikePrio = tabPrio = wrapPrio = -1;
+ memset((VOID *) &styleValues, 0, sizeof(StyleValues));
+ styleValues.relief = TK_RELIEF_FLAT;
+ styleValues.fgColor = textPtr->fgColor;
+ styleValues.tkfont = textPtr->tkfont;
+ styleValues.justify = TK_JUSTIFY_LEFT;
+ styleValues.spacing1 = textPtr->spacing1;
+ styleValues.spacing2 = textPtr->spacing2;
+ styleValues.spacing3 = textPtr->spacing3;
+ styleValues.tabArrayPtr = textPtr->tabArrayPtr;
+ styleValues.wrapMode = textPtr->wrapMode;
+ for (i = 0 ; i < numTags; i++) {
+ tagPtr = tagPtrs[i];
+
+ /*
+ * On Windows and Mac, we need to skip the selection tag if
+ * we don't have focus.
+ */
+
+#ifndef ALWAYS_SHOW_SELECTION
+ if ((tagPtr == textPtr->selTagPtr) && !(textPtr->flags & GOT_FOCUS)) {
+ continue;
+ }
+#endif
+
+ if ((tagPtr->border != NULL) && (tagPtr->priority > borderPrio)) {
+ styleValues.border = tagPtr->border;
+ borderPrio = tagPtr->priority;
+ }
+ if ((tagPtr->bdString != NULL)
+ && (tagPtr->priority > borderWidthPrio)) {
+ styleValues.borderWidth = tagPtr->borderWidth;
+ borderWidthPrio = tagPtr->priority;
+ }
+ if ((tagPtr->reliefString != NULL)
+ && (tagPtr->priority > reliefPrio)) {
+ if (styleValues.border == NULL) {
+ styleValues.border = textPtr->border;
+ }
+ styleValues.relief = tagPtr->relief;
+ reliefPrio = tagPtr->priority;
+ }
+ if ((tagPtr->bgStipple != None)
+ && (tagPtr->priority > bgStipplePrio)) {
+ styleValues.bgStipple = tagPtr->bgStipple;
+ bgStipplePrio = tagPtr->priority;
+ }
+ if ((tagPtr->fgColor != None) && (tagPtr->priority > fgPrio)) {
+ styleValues.fgColor = tagPtr->fgColor;
+ fgPrio = tagPtr->priority;
+ }
+ if ((tagPtr->tkfont != None) && (tagPtr->priority > fontPrio)) {
+ styleValues.tkfont = tagPtr->tkfont;
+ fontPrio = tagPtr->priority;
+ }
+ if ((tagPtr->fgStipple != None)
+ && (tagPtr->priority > fgStipplePrio)) {
+ styleValues.fgStipple = tagPtr->fgStipple;
+ fgStipplePrio = tagPtr->priority;
+ }
+ if ((tagPtr->justifyString != NULL)
+ && (tagPtr->priority > justifyPrio)) {
+ styleValues.justify = tagPtr->justify;
+ justifyPrio = tagPtr->priority;
+ }
+ if ((tagPtr->lMargin1String != NULL)
+ && (tagPtr->priority > lMargin1Prio)) {
+ styleValues.lMargin1 = tagPtr->lMargin1;
+ lMargin1Prio = tagPtr->priority;
+ }
+ if ((tagPtr->lMargin2String != NULL)
+ && (tagPtr->priority > lMargin2Prio)) {
+ styleValues.lMargin2 = tagPtr->lMargin2;
+ lMargin2Prio = tagPtr->priority;
+ }
+ if ((tagPtr->offsetString != NULL)
+ && (tagPtr->priority > offsetPrio)) {
+ styleValues.offset = tagPtr->offset;
+ offsetPrio = tagPtr->priority;
+ }
+ if ((tagPtr->overstrikeString != NULL)
+ && (tagPtr->priority > overstrikePrio)) {
+ styleValues.overstrike = tagPtr->overstrike;
+ overstrikePrio = tagPtr->priority;
+ }
+ if ((tagPtr->rMarginString != NULL)
+ && (tagPtr->priority > rMarginPrio)) {
+ styleValues.rMargin = tagPtr->rMargin;
+ rMarginPrio = tagPtr->priority;
+ }
+ if ((tagPtr->spacing1String != NULL)
+ && (tagPtr->priority > spacing1Prio)) {
+ styleValues.spacing1 = tagPtr->spacing1;
+ spacing1Prio = tagPtr->priority;
+ }
+ if ((tagPtr->spacing2String != NULL)
+ && (tagPtr->priority > spacing2Prio)) {
+ styleValues.spacing2 = tagPtr->spacing2;
+ spacing2Prio = tagPtr->priority;
+ }
+ if ((tagPtr->spacing3String != NULL)
+ && (tagPtr->priority > spacing3Prio)) {
+ styleValues.spacing3 = tagPtr->spacing3;
+ spacing3Prio = tagPtr->priority;
+ }
+ if ((tagPtr->tabString != NULL)
+ && (tagPtr->priority > tabPrio)) {
+ styleValues.tabArrayPtr = tagPtr->tabArrayPtr;
+ tabPrio = tagPtr->priority;
+ }
+ if ((tagPtr->underlineString != NULL)
+ && (tagPtr->priority > underlinePrio)) {
+ styleValues.underline = tagPtr->underline;
+ underlinePrio = tagPtr->priority;
+ }
+ if ((tagPtr->wrapMode != NULL)
+ && (tagPtr->priority > wrapPrio)) {
+ styleValues.wrapMode = tagPtr->wrapMode;
+ wrapPrio = tagPtr->priority;
+ }
+ }
+ if (tagPtrs != NULL) {
+ ckfree((char *) tagPtrs);
+ }
+
+ /*
+ * Use an existing style if there's one around that matches.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&textPtr->dInfoPtr->styleTable,
+ (char *) &styleValues, &new);
+ if (!new) {
+ stylePtr = (TextStyle *) Tcl_GetHashValue(hPtr);
+ stylePtr->refCount++;
+ return stylePtr;
+ }
+
+ /*
+ * No existing style matched. Make a new one.
+ */
+
+ stylePtr = (TextStyle *) ckalloc(sizeof(TextStyle));
+ stylePtr->refCount = 1;
+ if (styleValues.border != NULL) {
+ gcValues.foreground = Tk_3DBorderColor(styleValues.border)->pixel;
+ mask = GCForeground;
+ if (styleValues.bgStipple != None) {
+ gcValues.stipple = styleValues.bgStipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ stylePtr->bgGC = Tk_GetGCColor(textPtr->tkwin, mask, &gcValues,
+ Tk_3DBorderColor(styleValues.border),
+ NULL);
+ } else {
+ stylePtr->bgGC = None;
+ }
+ mask = GCForeground|GCFont;
+ gcValues.foreground = styleValues.fgColor->pixel;
+ gcValues.font = Tk_FontId(styleValues.tkfont);
+ if (styleValues.fgStipple != None) {
+ gcValues.stipple = styleValues.fgStipple;
+ gcValues.fill_style = FillStippled;
+ mask |= GCStipple|GCFillStyle;
+ }
+ stylePtr->fgGC = Tk_GetGCColor(textPtr->tkwin, mask, &gcValues,
+ styleValues.fgColor, NULL);
+ stylePtr->sValuePtr = (StyleValues *)
+ Tcl_GetHashKey(&textPtr->dInfoPtr->styleTable, hPtr);
+ stylePtr->hPtr = hPtr;
+ Tcl_SetHashValue(hPtr, stylePtr);
+ return stylePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeStyle --
+ *
+ * This procedure is called when a TextStyle structure is no longer
+ * needed. It decrements the reference count and frees up the
+ * space for the style structure if the reference count is 0.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The storage and other resources associated with the style
+ * are freed up if no-one's still using it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeStyle(textPtr, stylePtr)
+ TkText *textPtr; /* Information about overall widget. */
+ register TextStyle *stylePtr; /* Information about style to free. */
+
+{
+ stylePtr->refCount--;
+ if (stylePtr->refCount == 0) {
+ if (stylePtr->bgGC != None) {
+ Tk_FreeGC(textPtr->display, stylePtr->bgGC);
+ }
+ Tk_FreeGC(textPtr->display, stylePtr->fgGC);
+ Tcl_DeleteHashEntry(stylePtr->hPtr);
+ ckfree((char *) stylePtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * LayoutDLine --
+ *
+ * This procedure generates a single DLine structure for a display
+ * line whose leftmost character is given by indexPtr.
+ *
+ * Results:
+ * The return value is a pointer to a DLine structure desribing the
+ * display line. All fields are filled in and correct except for
+ * y and nextPtr.
+ *
+ * Side effects:
+ * Storage is allocated for the new DLine.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DLine *
+LayoutDLine(textPtr, indexPtr)
+ TkText *textPtr; /* Overall information about text widget. */
+ TkTextIndex *indexPtr; /* Beginning of display line. May not
+ * necessarily point to a character segment. */
+{
+ register DLine *dlPtr; /* New display line. */
+ TkTextSegment *segPtr; /* Current segment in text. */
+ TkTextDispChunk *lastChunkPtr; /* Last chunk allocated so far
+ * 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");
+ }
+ wholeLine = (segPtr == NULL);
+
+ /*
+ * We're at the end of the display line. Throw away everything
+ * after the most recent word break, if there is one; this may
+ * potentially require the last chunk to be layed out again.
+ */
+
+ if (breakChunkPtr == NULL) {
+ /*
+ * This code makes sure that we don't accidentally display
+ * 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) {
+ dlPtr->height = chunkPtr->minHeight;
+ }
+ sValuePtr = chunkPtr->stylePtr->sValuePtr;
+ if ((sValuePtr->borderWidth > 0)
+ && (sValuePtr->relief != TK_RELIEF_FLAT)) {
+ dlPtr->flags |= HAS_3D_BORDER;
+ }
+ }
+ 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 {
+ dlPtr->spaceBelow = sValuePtr->spacing2/2;
+ }
+ dlPtr->height += dlPtr->spaceAbove + dlPtr->spaceBelow;
+ dlPtr->baseline += dlPtr->spaceAbove;
+
+ /*
+ * Recompute line length: may have changed because of justification.
+ */
+
+ dlPtr->length = lastChunkPtr->x + lastChunkPtr->width;
+ return dlPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateDisplayInfo --
+ *
+ * This procedure is invoked to recompute some or all of the
+ * DLine structures for a text widget. At the time it is called
+ * the DLine structures still left in the widget are guaranteed
+ * to be correct except that (a) the y-coordinates aren't
+ * necessarily correct, (b) there may be missing structures
+ * (the DLine structures get removed as soon as they are potentially
+ * out-of-date), and (c) DLine structures that don't start at the
+ * beginning of a line may be incorrect if previous information in
+ * the same line changed size in a way that moved a line boundary
+ * (DLines for any info that changed will have been deleted, but
+ * not DLines for unchanged info in the same text line).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Upon return, the DLine information for textPtr correctly reflects
+ * the positions where characters will be displayed. However, this
+ * procedure doesn't actually bring the display up-to-date.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateDisplayInfo(textPtr)
+ TkText *textPtr; /* Text widget to update. */
+{
+ register TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ register DLine *dlPtr, *prevPtr;
+ TkTextIndex index;
+ TkTextLine *lastLinePtr;
+ int y, maxY, pixelOffset, maxOffset;
+
+ if (!(dInfoPtr->flags & DINFO_OUT_OF_DATE)) {
+ return;
+ }
+ dInfoPtr->flags &= ~DINFO_OUT_OF_DATE;
+
+ /*
+ * Delete any DLines that are now above the top of the window.
+ */
+
+ index = textPtr->topIndex;
+ dlPtr = FindDLine(dInfoPtr->dLinePtr, &index);
+ if ((dlPtr != NULL) && (dlPtr != dInfoPtr->dLinePtr)) {
+ FreeDLines(textPtr, dInfoPtr->dLinePtr, dlPtr, 1);
+ }
+
+ /*
+ *--------------------------------------------------------------
+ * Scan through the contents of the window from top to bottom,
+ * recomputing information for lines that are missing.
+ *--------------------------------------------------------------
+ */
+
+ lastLinePtr = TkBTreeFindLine(textPtr->tree,
+ TkBTreeNumLines(textPtr->tree));
+ dlPtr = dInfoPtr->dLinePtr;
+ prevPtr = NULL;
+ y = dInfoPtr->y;
+ maxY = dInfoPtr->maxY;
+ while (1) {
+ register DLine *newPtr;
+
+ if (index.linePtr == lastLinePtr) {
+ break;
+ }
+
+ /*
+ * There are three possibilities right now:
+ * (a) the next DLine (dlPtr) corresponds exactly to the next
+ * information we want to display: just use it as-is.
+ * (b) the next DLine corresponds to a different line, or to
+ * a segment that will be coming later in the same line:
+ * leave this DLine alone in the hopes that we'll be able
+ * to use it later, then create a new DLine in front of
+ * it.
+ * (c) the next DLine corresponds to a segment in the line we
+ * want, but it's a segment that has already been processed
+ * or will never be processed. Delete the DLine and try
+ * again.
+ *
+ * One other twist on all this. It's possible for 3D borders
+ * to interact between lines (see DisplayLineBackground) so if
+ * a line is relayed out and has styles with 3D borders, its
+ * neighbors have to be redrawn if they have 3D borders too,
+ * since the interactions could have changed (the neighbors
+ * don't have to be relayed out, just redrawn).
+ */
+
+ if ((dlPtr == NULL) || (dlPtr->index.linePtr != index.linePtr)) {
+ /*
+ * Case (b) -- must make new DLine.
+ */
+
+ makeNewDLine:
+ if (tkTextDebug) {
+ char string[TK_POS_CHARS];
+
+ /*
+ * Debugging is enabled, so keep a log of all the lines
+ * that were re-layed out. The test suite uses this
+ * information.
+ */
+
+ TkTextPrintIndex(&index, string);
+ Tcl_SetVar2(textPtr->interp, "tk_textRelayout", (char *) NULL,
+ string,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ }
+ newPtr = LayoutDLine(textPtr, &index);
+ if (prevPtr == NULL) {
+ dInfoPtr->dLinePtr = newPtr;
+ } else {
+ prevPtr->nextPtr = newPtr;
+ if (prevPtr->flags & HAS_3D_BORDER) {
+ prevPtr->oldY = -1;
+ }
+ }
+ newPtr->nextPtr = dlPtr;
+ 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.
+ */
+
+ newPtr = dlPtr->nextPtr;
+ FreeDLines(textPtr, dlPtr, newPtr, 0);
+ dlPtr = newPtr;
+ if (prevPtr != NULL) {
+ prevPtr->nextPtr = newPtr;
+ } else {
+ dInfoPtr->dLinePtr = newPtr;
+ }
+ continue;
+ }
+
+ /*
+ * 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.
+ */
+
+ if (index.linePtr != prevPtr->index.linePtr) {
+ register DLine *nextPtr;
+
+ nextPtr = dlPtr;
+ while ((nextPtr != NULL)
+ && (nextPtr->index.linePtr == prevPtr->index.linePtr)) {
+ nextPtr = nextPtr->nextPtr;
+ }
+ if (nextPtr != dlPtr) {
+ FreeDLines(textPtr, dlPtr, nextPtr, 0);
+ prevPtr->nextPtr = nextPtr;
+ dlPtr = nextPtr;
+ }
+ }
+
+ /*
+ * It's important to have the following check here rather than in
+ * the while statement for the loop, so that there's always at least
+ * one DLine generated, regardless of how small the window is. This
+ * keeps a lot of other code from breaking.
+ */
+
+ if (y >= maxY) {
+ break;
+ }
+ }
+
+ /*
+ * Delete any DLine structures that don't fit on the screen.
+ */
+
+ FreeDLines(textPtr, dlPtr, (DLine *) NULL, 1);
+
+ /*
+ *--------------------------------------------------------------
+ * 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.
+ */
+
+ while (lowestPtr != NULL) {
+ dlPtr = lowestPtr;
+ spaceLeft -= dlPtr->height;
+ if (spaceLeft < 0) {
+ break;
+ }
+ lowestPtr = dlPtr->nextPtr;
+ dlPtr->nextPtr = dInfoPtr->dLinePtr;
+ dInfoPtr->dLinePtr = dlPtr;
+ if (tkTextDebug) {
+ char string[TK_POS_CHARS];
+
+ 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.
+ */
+
+ textPtr->topIndex = dInfoPtr->dLinePtr->index;
+ y = dInfoPtr->y;
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
+ dlPtr = dlPtr->nextPtr) {
+ if (y > dInfoPtr->maxY) {
+ panic("Added too many new lines in UpdateDisplayInfo");
+ }
+ dlPtr->y = y;
+ y += dlPtr->height;
+ }
+ }
+
+ /*
+ *--------------------------------------------------------------
+ * If the old top or bottom line has scrolled elsewhere on the
+ * screen, we may not be able to re-use its old contents by
+ * copying bits (e.g., a beveled edge that was drawn when it was
+ * at the top or bottom won't be drawn when the line is in the
+ * middle and its neighbor has a matching background). Similarly,
+ * if the new top or bottom line came from somewhere else on the
+ * screen, we may not be able to copy the old bits.
+ *--------------------------------------------------------------
+ */
+
+ dlPtr = dInfoPtr->dLinePtr;
+ if ((dlPtr->flags & HAS_3D_BORDER) && !(dlPtr->flags & TOP_LINE)) {
+ dlPtr->oldY = -1;
+ }
+ while (1) {
+ if ((dlPtr->flags & TOP_LINE) && (dlPtr != dInfoPtr->dLinePtr)
+ && (dlPtr->flags & HAS_3D_BORDER)) {
+ dlPtr->oldY = -1;
+ }
+ if ((dlPtr->flags & BOTTOM_LINE) && (dlPtr->nextPtr != NULL)
+ && (dlPtr->flags & HAS_3D_BORDER)) {
+ dlPtr->oldY = -1;
+ }
+ if (dlPtr->nextPtr == NULL) {
+ if ((dlPtr->flags & HAS_3D_BORDER)
+ && !(dlPtr->flags & BOTTOM_LINE)) {
+ dlPtr->oldY = -1;
+ }
+ dlPtr->flags &= ~TOP_LINE;
+ dlPtr->flags |= BOTTOM_LINE;
+ break;
+ }
+ dlPtr->flags &= ~(TOP_LINE|BOTTOM_LINE);
+ dlPtr = dlPtr->nextPtr;
+ }
+ dInfoPtr->dLinePtr->flags |= TOP_LINE;
+
+ /*
+ * Arrange for scrollbars to be updated.
+ */
+
+ textPtr->flags |= UPDATE_SCROLLBARS;
+
+ /*
+ *--------------------------------------------------------------
+ * Deal with horizontal scrolling:
+ * 1. If there's empty space to the right of the longest line,
+ * shift the screen to the right to fill in the empty space.
+ * 2. If the desired horizontal scroll position has changed,
+ * force a full redisplay of all the lines in the widget.
+ * 3. If the wrap mode isn't "none" then re-scroll to the base
+ * position.
+ *--------------------------------------------------------------
+ */
+
+ dInfoPtr->maxLength = 0;
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
+ 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;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeDLines --
+ *
+ * This procedure is called to free up all of the resources
+ * associated with one or more DLine structures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory gets freed and various other resources are released.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeDLines(textPtr, firstPtr, lastPtr, unlink)
+ TkText *textPtr; /* Information about overall text
+ * widget. */
+ register DLine *firstPtr; /* Pointer to first DLine to free up. */
+ DLine *lastPtr; /* Pointer to DLine just after last
+ * one to free (NULL means everything
+ * starting with firstPtr). */
+ int unlink; /* 1 means DLines are currently linked
+ * into the list rooted at
+ * textPtr->dInfoPtr->dLinePtr and
+ * they have to be unlinked. 0 means
+ * just free without unlinking. */
+{
+ register TkTextDispChunk *chunkPtr, *nextChunkPtr;
+ register DLine *nextDLinePtr;
+
+ if (unlink) {
+ if (textPtr->dInfoPtr->dLinePtr == firstPtr) {
+ textPtr->dInfoPtr->dLinePtr = lastPtr;
+ } else {
+ register DLine *prevPtr;
+ for (prevPtr = textPtr->dInfoPtr->dLinePtr;
+ prevPtr->nextPtr != firstPtr; prevPtr = prevPtr->nextPtr) {
+ /* Empty loop body. */
+ }
+ prevPtr->nextPtr = lastPtr;
+ }
+ }
+ while (firstPtr != lastPtr) {
+ nextDLinePtr = firstPtr->nextPtr;
+ for (chunkPtr = firstPtr->chunkPtr; chunkPtr != NULL;
+ chunkPtr = nextChunkPtr) {
+ if (chunkPtr->undisplayProc != NULL) {
+ (*chunkPtr->undisplayProc)(textPtr, chunkPtr);
+ }
+ FreeStyle(textPtr, chunkPtr->stylePtr);
+ nextChunkPtr = chunkPtr->nextPtr;
+ ckfree((char *) chunkPtr);
+ }
+ ckfree((char *) firstPtr);
+ firstPtr = nextDLinePtr;
+ }
+ textPtr->dInfoPtr->dLinesInvalidated = 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayDLine --
+ *
+ * This procedure is invoked to draw a single line on the
+ * screen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The line given by dlPtr is drawn at its correct position in
+ * textPtr's window. Note that this is one *display* line, not
+ * one *text* line.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayDLine(textPtr, dlPtr, prevPtr, pixmap)
+ TkText *textPtr; /* Text widget in which to draw line. */
+ register DLine *dlPtr; /* Information about line to draw. */
+ DLine *prevPtr; /* Line just before one to draw, or NULL
+ * if dlPtr is the top line. */
+ Pixmap pixmap; /* Pixmap to use for double-buffering.
+ * Caller must make sure it's large enough
+ * to hold line. */
+{
+ register TkTextDispChunk *chunkPtr;
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ Display *display;
+ int height, x;
+
+ /*
+ * First, clear the area of the line to the background color for the
+ * text widget.
+ */
+
+ display = Tk_Display(textPtr->tkwin);
+ Tk_Fill3DRectangle(textPtr->tkwin, pixmap, textPtr->border, 0, 0,
+ Tk_Width(textPtr->tkwin), dlPtr->height, 0, TK_RELIEF_FLAT);
+
+ /*
+ * Next, draw background information for the whole line.
+ */
+
+ DisplayLineBackground(textPtr, dlPtr, prevPtr, pixmap);
+
+ /*
+ * 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.
+ */
+
+#ifndef __WIN32__
+ /* CYGNUS LOCAL: On Windows, display the cursor even for disabled
+ text widgets. */
+ if (textPtr->state == tkNormalUid) {
+#endif /* __WIN32__ */
+ 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,
+ dlPtr->y + dlPtr->spaceAbove);
+ }
+ }
+#ifndef __WIN32__
+ }
+#endif /* __WIN32__ */
+
+ /*
+ * Make yet another pass through all of the chunks to redraw all of
+ * foreground information. Note: we have to call the displayProc
+ * even for chunks that are off-screen. This is needed, for
+ * example, so that embedded windows can be unmapped in this case.
+ * Conve
+ */
+
+ for (chunkPtr = dlPtr->chunkPtr; (chunkPtr != NULL);
+ chunkPtr = chunkPtr->nextPtr) {
+ if (chunkPtr->displayProc == TkTextInsertDisplayProc) {
+ /*
+ * Already displayed the insertion cursor above. Don't
+ * do it again here.
+ */
+
+ continue;
+ }
+ x = chunkPtr->x + dInfoPtr->x - dInfoPtr->curPixelOffset;
+ if ((x + chunkPtr->width <= 0) || (x >= dInfoPtr->maxX)) {
+ /*
+ * Note: we have to call the displayProc even for chunks
+ * that are off-screen. This is needed, for example, so
+ * that embedded windows can be unmapped in this case.
+ * Display the chunk at a coordinate that can be clearly
+ * identified by the displayProc as being off-screen to
+ * the left (the displayProc may not be able to tell if
+ * something is off to the right).
+ */
+
+ (*chunkPtr->displayProc)(chunkPtr, -chunkPtr->width,
+ dlPtr->spaceAbove,
+ dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
+ dlPtr->baseline - dlPtr->spaceAbove, display, pixmap,
+ dlPtr->y + dlPtr->spaceAbove);
+ } else {
+ (*chunkPtr->displayProc)(chunkPtr, x, dlPtr->spaceAbove,
+ dlPtr->height - dlPtr->spaceAbove - dlPtr->spaceBelow,
+ dlPtr->baseline - dlPtr->spaceAbove, display, pixmap,
+ dlPtr->y + dlPtr->spaceAbove);
+ }
+ if (dInfoPtr->dLinesInvalidated) {
+ return;
+ }
+ }
+
+ /*
+ * Copy the pixmap onto the screen. If this is the last line on
+ * the screen then copy a piece of the line, so that it doesn't
+ * overflow into the border area. Another special trick: copy the
+ * padding area to the left of the line; this is because the
+ * insertion cursor sometimes overflows onto that area and we want
+ * to get as much of the cursor as possible.
+ */
+
+ height = dlPtr->height;
+ if ((height + dlPtr->y) > dInfoPtr->maxY) {
+ height = dInfoPtr->maxY - dlPtr->y;
+ }
+ XCopyArea(display, pixmap, Tk_WindowId(textPtr->tkwin), dInfoPtr->copyGC,
+ dInfoPtr->x, 0, (unsigned) (dInfoPtr->maxX - dInfoPtr->x),
+ (unsigned) height, dInfoPtr->x, dlPtr->y);
+ linesRedrawn++;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayLineBackground --
+ *
+ * This procedure is called to fill in the background for
+ * a display line. It draws 3D borders cleverly so that
+ * adjacent chunks with the same style (whether on the same
+ * line or different lines) have a single 3D border around
+ * the whole region.
+ *
+ * Results:
+ * There is no return value. Pixmap is filled in with background
+ * information for dlPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayLineBackground(textPtr, dlPtr, prevPtr, pixmap)
+ TkText *textPtr; /* Text widget containing line. */
+ register DLine *dlPtr; /* Information about line to draw. */
+ DLine *prevPtr; /* Line just above dlPtr, or NULL if dlPtr
+ * is the top-most line in the window. */
+ Pixmap pixmap; /* Pixmap to use for double-buffering.
+ * Caller must make sure it's large enough
+ * to hold line. Caller must also have
+ * filled it with the background color for
+ * the widget. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ TkTextDispChunk *chunkPtr; /* Pointer to chunk in the current line. */
+ TkTextDispChunk *chunkPtr2; /* Pointer to chunk in the line above or
+ * below the current one. NULL if we're to
+ * the left of or to the right of the chunks
+ * in the line. */
+ TkTextDispChunk *nextPtr2; /* Next chunk after chunkPtr2 (it's not the
+ * same as chunkPtr2->nextPtr in the case
+ * where chunkPtr2 is NULL because the line
+ * is indented). */
+ int leftX; /* The left edge of the region we're
+ * currently working on. */
+ int leftXIn; /* 1 means beveled edge at leftX slopes right
+ * as it goes down, 0 means it slopes left
+ * as it goes down. */
+ int rightX; /* Right edge of chunkPtr. */
+ int rightX2; /* Right edge of chunkPtr2. */
+ int matchLeft; /* Does the style of this line match that
+ * of its neighbor just to the left of
+ * the current x coordinate? */
+ int matchRight; /* Does line's style match its neighbor
+ * just to the right of the current x-coord? */
+ int minX, maxX, xOffset;
+ StyleValues *sValuePtr;
+ Display *display;
+
+ /*
+ * Pass 1: scan through dlPtr from left to right. For each range of
+ * chunks with the same style, draw the main background for the style
+ * plus the vertical parts of the 3D borders (the left and right
+ * edges).
+ */
+
+ display = Tk_Display(textPtr->tkwin);
+ minX = dInfoPtr->curPixelOffset;
+ xOffset = dInfoPtr->x - minX;
+ maxX = minX + dInfoPtr->maxX - dInfoPtr->x;
+ chunkPtr = dlPtr->chunkPtr;
+
+ /*
+ * Note A: in the following statement, and a few others later in
+ * this file marked with "See Note A above", the right side of the
+ * assignment was replaced with 0 on 6/18/97. This has the effect
+ * of highlighting the empty space to the left of a line whenever
+ * the leftmost character of the line is highlighted. This way,
+ * multi-line highlights always line up along their left edges.
+ * However, this may look funny in the case where a single word is
+ * highlighted. To undo the change, replace "leftX = 0" with "leftX
+ * = chunkPtr->x" and "rightX2 = 0" with "rightX2 = nextPtr2->x"
+ * here and at all the marked points below. This restores the old
+ * behavior where empty space to the left of a line is not
+ * highlighted, leaving a ragged left edge for multi-line
+ * highlights.
+ */
+
+ leftX = 0;
+ for (; leftX < maxX; chunkPtr = chunkPtr->nextPtr) {
+ if ((chunkPtr->nextPtr != NULL)
+ && SAME_BACKGROUND(chunkPtr->nextPtr->stylePtr,
+ chunkPtr->stylePtr)) {
+ continue;
+ }
+ sValuePtr = chunkPtr->stylePtr->sValuePtr;
+ rightX = chunkPtr->x + chunkPtr->width;
+ if ((chunkPtr->nextPtr == NULL) && (rightX < maxX)) {
+ rightX = maxX;
+ }
+ if (chunkPtr->stylePtr->bgGC != None) {
+ XFillRectangle(display, pixmap, chunkPtr->stylePtr->bgGC,
+ leftX + xOffset, 0, (unsigned int) (rightX - leftX),
+ (unsigned int) dlPtr->height);
+ if (sValuePtr->relief != TK_RELIEF_FLAT) {
+ Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ leftX + xOffset, 0, sValuePtr->borderWidth,
+ dlPtr->height, 1, sValuePtr->relief);
+ Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ rightX - sValuePtr->borderWidth + xOffset,
+ 0, sValuePtr->borderWidth, dlPtr->height, 0,
+ sValuePtr->relief);
+ }
+ }
+ leftX = rightX;
+ }
+
+ /*
+ * Pass 2: draw the horizontal bevels along the top of the line. To
+ * do this, scan through dlPtr from left to right while simultaneously
+ * scanning through the line just above dlPtr. ChunkPtr2 and nextPtr2
+ * refer to two adjacent chunks in the line above.
+ */
+
+ chunkPtr = dlPtr->chunkPtr;
+ leftX = 0; /* See Note A above. */
+ leftXIn = 1;
+ rightX = chunkPtr->x + chunkPtr->width;
+ if ((chunkPtr->nextPtr == NULL) && (rightX < maxX)) {
+ rightX = maxX;
+ }
+ chunkPtr2 = NULL;
+ if (prevPtr != NULL) {
+ /*
+ * Find the chunk in the previous line that covers leftX.
+ */
+
+ nextPtr2 = prevPtr->chunkPtr;
+ rightX2 = 0; /* See Note A above. */
+ while (rightX2 <= leftX) {
+ chunkPtr2 = nextPtr2;
+ if (chunkPtr2 == NULL) {
+ break;
+ }
+ nextPtr2 = chunkPtr2->nextPtr;
+ rightX2 = chunkPtr2->x + chunkPtr2->width;
+ if (nextPtr2 == NULL) {
+ rightX2 = INT_MAX;
+ }
+ }
+ } else {
+ nextPtr2 = NULL;
+ rightX2 = INT_MAX;
+ }
+
+ while (leftX < maxX) {
+ matchLeft = (chunkPtr2 != NULL)
+ && SAME_BACKGROUND(chunkPtr2->stylePtr, chunkPtr->stylePtr);
+ sValuePtr = chunkPtr->stylePtr->sValuePtr;
+ if (rightX <= rightX2) {
+ /*
+ * The chunk in our line is about to end. If its style
+ * changes then draw the bevel for the current style.
+ */
+
+ if ((chunkPtr->nextPtr == NULL)
+ || !SAME_BACKGROUND(chunkPtr->stylePtr,
+ chunkPtr->nextPtr->stylePtr)) {
+ if (!matchLeft && (sValuePtr->relief != TK_RELIEF_FLAT)) {
+ Tk_3DHorizontalBevel(textPtr->tkwin, pixmap,
+ sValuePtr->border, leftX + xOffset, 0,
+ rightX - leftX, sValuePtr->borderWidth, leftXIn,
+ 1, 1, sValuePtr->relief);
+ }
+ leftX = rightX;
+ leftXIn = 1;
+
+ /*
+ * If the chunk in the line above is also ending at
+ * the same point then advance to the next chunk in
+ * that line.
+ */
+
+ if ((rightX == rightX2) && (chunkPtr2 != NULL)) {
+ goto nextChunk2;
+ }
+ }
+ chunkPtr = chunkPtr->nextPtr;
+ if (chunkPtr == NULL) {
+ break;
+ }
+ rightX = chunkPtr->x + chunkPtr->width;
+ if ((chunkPtr->nextPtr == NULL) && (rightX < maxX)) {
+ rightX = maxX;
+ }
+ continue;
+ }
+
+ /*
+ * The chunk in the line above is ending at an x-position where
+ * there is no change in the style of the current line. If the
+ * style above matches the current line on one side of the change
+ * but not on the other, we have to draw an L-shaped piece of
+ * bevel.
+ */
+
+ matchRight = (nextPtr2 != NULL)
+ && SAME_BACKGROUND(nextPtr2->stylePtr, chunkPtr->stylePtr);
+ if (matchLeft && !matchRight) {
+ if (sValuePtr->relief != TK_RELIEF_FLAT) {
+ Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ rightX2 - sValuePtr->borderWidth + xOffset, 0,
+ sValuePtr->borderWidth, sValuePtr->borderWidth, 0,
+ sValuePtr->relief);
+ }
+ leftX = rightX2 - sValuePtr->borderWidth;
+ leftXIn = 0;
+ } else if (!matchLeft && matchRight
+ && (sValuePtr->relief != TK_RELIEF_FLAT)) {
+ Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ rightX2 + xOffset, 0, sValuePtr->borderWidth,
+ sValuePtr->borderWidth, 1, sValuePtr->relief);
+ Tk_3DHorizontalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ leftX + xOffset, 0, rightX2 + sValuePtr->borderWidth -leftX,
+ sValuePtr->borderWidth, leftXIn, 0, 1,
+ sValuePtr->relief);
+ }
+
+ nextChunk2:
+ chunkPtr2 = nextPtr2;
+ if (chunkPtr2 == NULL) {
+ rightX2 = INT_MAX;
+ } else {
+ nextPtr2 = chunkPtr2->nextPtr;
+ rightX2 = chunkPtr2->x + chunkPtr2->width;
+ if (nextPtr2 == NULL) {
+ rightX2 = INT_MAX;
+ }
+ }
+ }
+ /*
+ * Pass 3: draw the horizontal bevels along the bottom of the line.
+ * This uses the same approach as pass 2.
+ */
+
+ chunkPtr = dlPtr->chunkPtr;
+ leftX = 0; /* See Note A above. */
+ leftXIn = 0;
+ rightX = chunkPtr->x + chunkPtr->width;
+ if ((chunkPtr->nextPtr == NULL) && (rightX < maxX)) {
+ rightX = maxX;
+ }
+ chunkPtr2 = NULL;
+ if (dlPtr->nextPtr != NULL) {
+ /*
+ * Find the chunk in the previous line that covers leftX.
+ */
+
+ nextPtr2 = dlPtr->nextPtr->chunkPtr;
+ rightX2 = 0; /* See Note A above. */
+ while (rightX2 <= leftX) {
+ chunkPtr2 = nextPtr2;
+ if (chunkPtr2 == NULL) {
+ break;
+ }
+ nextPtr2 = chunkPtr2->nextPtr;
+ rightX2 = chunkPtr2->x + chunkPtr2->width;
+ if (nextPtr2 == NULL) {
+ rightX2 = INT_MAX;
+ }
+ }
+ } else {
+ nextPtr2 = NULL;
+ rightX2 = INT_MAX;
+ }
+
+ while (leftX < maxX) {
+ matchLeft = (chunkPtr2 != NULL)
+ && SAME_BACKGROUND(chunkPtr2->stylePtr, chunkPtr->stylePtr);
+ sValuePtr = chunkPtr->stylePtr->sValuePtr;
+ if (rightX <= rightX2) {
+ if ((chunkPtr->nextPtr == NULL)
+ || !SAME_BACKGROUND(chunkPtr->stylePtr,
+ chunkPtr->nextPtr->stylePtr)) {
+ if (!matchLeft && (sValuePtr->relief != TK_RELIEF_FLAT)) {
+ Tk_3DHorizontalBevel(textPtr->tkwin, pixmap,
+ sValuePtr->border, leftX + xOffset,
+ dlPtr->height - sValuePtr->borderWidth,
+ rightX - leftX, sValuePtr->borderWidth, leftXIn,
+ 0, 0, sValuePtr->relief);
+ }
+ leftX = rightX;
+ leftXIn = 0;
+ if ((rightX == rightX2) && (chunkPtr2 != NULL)) {
+ goto nextChunk2b;
+ }
+ }
+ chunkPtr = chunkPtr->nextPtr;
+ if (chunkPtr == NULL) {
+ break;
+ }
+ rightX = chunkPtr->x + chunkPtr->width;
+ if ((chunkPtr->nextPtr == NULL) && (rightX < maxX)) {
+ rightX = maxX;
+ }
+ continue;
+ }
+
+ matchRight = (nextPtr2 != NULL)
+ && SAME_BACKGROUND(nextPtr2->stylePtr, chunkPtr->stylePtr);
+ if (matchLeft && !matchRight) {
+ if (sValuePtr->relief != TK_RELIEF_FLAT) {
+ Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ rightX2 - sValuePtr->borderWidth + xOffset,
+ dlPtr->height - sValuePtr->borderWidth,
+ sValuePtr->borderWidth, sValuePtr->borderWidth, 0,
+ sValuePtr->relief);
+ }
+ leftX = rightX2 - sValuePtr->borderWidth;
+ leftXIn = 1;
+ } else if (!matchLeft && matchRight
+ && (sValuePtr->relief != TK_RELIEF_FLAT)) {
+ Tk_3DVerticalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ rightX2 + xOffset, dlPtr->height - sValuePtr->borderWidth,
+ sValuePtr->borderWidth, sValuePtr->borderWidth,
+ 1, sValuePtr->relief);
+ Tk_3DHorizontalBevel(textPtr->tkwin, pixmap, sValuePtr->border,
+ leftX + xOffset, dlPtr->height - sValuePtr->borderWidth,
+ rightX2 + sValuePtr->borderWidth - leftX,
+ sValuePtr->borderWidth, leftXIn, 1, 0, sValuePtr->relief);
+ }
+
+ nextChunk2b:
+ chunkPtr2 = nextPtr2;
+ if (chunkPtr2 == NULL) {
+ rightX2 = INT_MAX;
+ } else {
+ nextPtr2 = chunkPtr2->nextPtr;
+ rightX2 = chunkPtr2->x + chunkPtr2->width;
+ if (nextPtr2 == NULL) {
+ rightX2 = INT_MAX;
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayText --
+ *
+ * This procedure is invoked as a when-idle handler to update the
+ * display. It only redisplays the parts of the text widget that
+ * are out of date.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information is redrawn on the screen.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayText(clientData)
+ ClientData clientData; /* Information about widget. */
+{
+ register TkText *textPtr = (TkText *) clientData;
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ Tk_Window tkwin;
+ register DLine *dlPtr;
+ DLine *prevPtr;
+ Pixmap pixmap;
+ int maxHeight, borders;
+ int bottomY = 0; /* Initialization needed only to stop
+ * compiler warnings. */
+ Tcl_Interp *interp;
+
+ if (textPtr->tkwin == NULL) {
+
+ /*
+ * The widget has been deleted. Don't do anything.
+ */
+
+ return;
+ }
+
+ interp = textPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+
+ if (tkTextDebug) {
+ Tcl_SetVar2(interp, "tk_textRelayout", (char *) NULL, "",
+ TCL_GLOBAL_ONLY);
+ }
+
+ if (textPtr->tkwin == NULL) {
+
+ /*
+ * The widget has been deleted. Don't do anything.
+ */
+
+ goto end;
+ }
+
+ if (!Tk_IsMapped(textPtr->tkwin) || (dInfoPtr->maxX <= dInfoPtr->x)
+ || (dInfoPtr->maxY <= dInfoPtr->y)) {
+ UpdateDisplayInfo(textPtr);
+ dInfoPtr->flags &= ~REDRAW_PENDING;
+ goto doScrollbars;
+ }
+ numRedisplays++;
+ if (tkTextDebug) {
+ Tcl_SetVar2(interp, "tk_textRedraw", (char *) NULL, "",
+ TCL_GLOBAL_ONLY);
+ }
+
+ if (textPtr->tkwin == NULL) {
+
+ /*
+ * The widget has been deleted. Don't do anything.
+ */
+
+ goto end;
+ }
+
+ /*
+ * Choose a new current item if that is needed (this could cause
+ * event handlers to be invoked, hence the preserve/release calls
+ * and the loop, since the handlers could conceivably necessitate
+ * yet another current item calculation). The tkwin check is because
+ * the whole window could go away in the Tcl_Release call.
+ */
+
+ while (dInfoPtr->flags & REPICK_NEEDED) {
+ Tcl_Preserve((ClientData) textPtr);
+ dInfoPtr->flags &= ~REPICK_NEEDED;
+ TkTextPickCurrent(textPtr, &textPtr->pickEvent);
+ tkwin = textPtr->tkwin;
+ Tcl_Release((ClientData) textPtr);
+ if (tkwin == NULL) {
+ goto end;
+ }
+ }
+
+ /*
+ * First recompute what's supposed to be displayed.
+ */
+
+ UpdateDisplayInfo(textPtr);
+ dInfoPtr->dLinesInvalidated = 0;
+
+ /*
+ * See if it's possible to bring some parts of the screen up-to-date
+ * by scrolling (copying from other parts of the screen).
+ */
+
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL; dlPtr = dlPtr->nextPtr) {
+ register DLine *dlPtr2;
+ int offset, height, y, oldY;
+ TkRegion damageRgn;
+
+ if ((dlPtr->oldY == -1) || (dlPtr->y == dlPtr->oldY)
+ || ((dlPtr->oldY + dlPtr->height) > dInfoPtr->maxY)) {
+ continue;
+ }
+
+ /*
+ * This line is already drawn somewhere in the window so it only
+ * needs to be copied to its new location. See if there's a group
+ * of lines that can all be copied together.
+ */
+
+ offset = dlPtr->y - dlPtr->oldY;
+ height = dlPtr->height;
+ y = dlPtr->y;
+ for (dlPtr2 = dlPtr->nextPtr; dlPtr2 != NULL;
+ dlPtr2 = dlPtr2->nextPtr) {
+ if ((dlPtr2->oldY == -1)
+ || ((dlPtr2->oldY + offset) != dlPtr2->y)
+ || ((dlPtr2->oldY + dlPtr2->height) > dInfoPtr->maxY)) {
+ break;
+ }
+ height += dlPtr2->height;
+ }
+
+ /*
+ * Reduce the height of the area being copied if necessary to
+ * avoid overwriting the border area.
+ */
+
+ if ((y + height) > dInfoPtr->maxY) {
+ height = dInfoPtr->maxY -y;
+ }
+ oldY = dlPtr->oldY;
+
+ /*
+ * Update the lines we are going to scroll to show that they
+ * have been copied.
+ */
+
+ while (1) {
+ dlPtr->oldY = dlPtr->y;
+ if (dlPtr->nextPtr == dlPtr2) {
+ break;
+ }
+ dlPtr = dlPtr->nextPtr;
+ }
+
+ /*
+ * Scan through the lines following the copied ones to see if
+ * we are going to overwrite them with the copy operation.
+ * If so, mark them for redisplay.
+ */
+
+ for ( ; dlPtr2 != NULL; dlPtr2 = dlPtr2->nextPtr) {
+ if ((dlPtr2->oldY != -1)
+ && ((dlPtr2->oldY + dlPtr2->height) > y)
+ && (dlPtr2->oldY < (y + height))) {
+ dlPtr2->oldY = -1;
+ }
+ }
+
+ /*
+ * Now scroll the lines. This may generate damage which we
+ * handle by calling TextInvalidateRegion to mark the display
+ * blocks as stale.
+ */
+
+ damageRgn = TkCreateRegion();
+ if (TkScrollWindow(textPtr->tkwin, dInfoPtr->scrollGC,
+ dInfoPtr->x, oldY,
+ (dInfoPtr->maxX - dInfoPtr->x), height,
+ 0, y - oldY, damageRgn)) {
+ TextInvalidateRegion(textPtr, damageRgn);
+ }
+ numCopies++;
+ TkDestroyRegion(damageRgn);
+ }
+
+ /*
+ * Clear the REDRAW_PENDING flag here. This is actually pretty
+ * tricky. We want to wait until *after* doing the scrolling,
+ * since that could generate more areas to redraw and don't
+ * want to reschedule a redisplay for them. On the other hand,
+ * we can't wait until after all the redisplaying, because the
+ * act of redisplaying could actually generate more redisplays
+ * (e.g. in the case of a nested window with event bindings triggered
+ * by redisplay).
+ */
+
+ dInfoPtr->flags &= ~REDRAW_PENDING;
+
+ /*
+ * Redraw the borders if that's needed.
+ */
+
+ if (dInfoPtr->flags & REDRAW_BORDERS) {
+ if (tkTextDebug) {
+ Tcl_SetVar2(interp, "tk_textRedraw", (char *) NULL, "borders",
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ }
+
+ if (textPtr->tkwin == NULL) {
+
+ /*
+ * The widget has been deleted. Don't do anything.
+ */
+
+ goto end;
+ }
+
+ Tk_Draw3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
+ textPtr->border, textPtr->highlightWidth,
+ textPtr->highlightWidth,
+ Tk_Width(textPtr->tkwin) - 2*textPtr->highlightWidth,
+ Tk_Height(textPtr->tkwin) - 2*textPtr->highlightWidth,
+ textPtr->borderWidth, textPtr->relief);
+ if (textPtr->highlightWidth != 0) {
+ GC gc;
+
+ if (textPtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(textPtr->highlightColorPtr,
+ Tk_WindowId(textPtr->tkwin));
+ } else {
+ gc = Tk_GCForColor(textPtr->highlightBgColorPtr,
+ Tk_WindowId(textPtr->tkwin));
+ }
+ Tk_DrawFocusHighlight(textPtr->tkwin, gc, textPtr->highlightWidth,
+ Tk_WindowId(textPtr->tkwin));
+ }
+ borders = textPtr->borderWidth + textPtr->highlightWidth;
+ if (textPtr->padY > 0) {
+ Tk_Fill3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
+ textPtr->border, borders, borders,
+ Tk_Width(textPtr->tkwin) - 2*borders, textPtr->padY,
+ 0, TK_RELIEF_FLAT);
+ Tk_Fill3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
+ textPtr->border, borders,
+ Tk_Height(textPtr->tkwin) - borders - textPtr->padY,
+ Tk_Width(textPtr->tkwin) - 2*borders,
+ textPtr->padY, 0, TK_RELIEF_FLAT);
+ }
+ if (textPtr->padX > 0) {
+ Tk_Fill3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
+ textPtr->border, borders, borders + textPtr->padY,
+ textPtr->padX,
+ Tk_Height(textPtr->tkwin) - 2*borders -2*textPtr->padY,
+ 0, TK_RELIEF_FLAT);
+ Tk_Fill3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
+ textPtr->border,
+ Tk_Width(textPtr->tkwin) - borders - textPtr->padX,
+ borders + textPtr->padY, textPtr->padX,
+ Tk_Height(textPtr->tkwin) - 2*borders -2*textPtr->padY,
+ 0, TK_RELIEF_FLAT);
+ }
+ dInfoPtr->flags &= ~REDRAW_BORDERS;
+ }
+
+ /*
+ * Now we have to redraw the lines that couldn't be updated by
+ * scrolling. First, compute the height of the largest line and
+ * allocate an off-screen pixmap to use for double-buffered
+ * displays.
+ */
+
+ maxHeight = -1;
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
+ dlPtr = dlPtr->nextPtr) {
+ if ((dlPtr->height > maxHeight) && (dlPtr->oldY != dlPtr->y)) {
+ maxHeight = dlPtr->height;
+ }
+ bottomY = dlPtr->y + dlPtr->height;
+ }
+ if (maxHeight > dInfoPtr->maxY) {
+ maxHeight = dInfoPtr->maxY;
+ }
+ if (maxHeight > 0) {
+ pixmap = Tk_GetPixmap(Tk_Display(textPtr->tkwin),
+ Tk_WindowId(textPtr->tkwin), Tk_Width(textPtr->tkwin),
+ maxHeight, Tk_Depth(textPtr->tkwin));
+ for (prevPtr = NULL, dlPtr = textPtr->dInfoPtr->dLinePtr;
+ (dlPtr != NULL) && (dlPtr->y < dInfoPtr->maxY);
+ prevPtr = dlPtr, dlPtr = dlPtr->nextPtr) {
+ if (dlPtr->oldY != dlPtr->y) {
+ if (tkTextDebug) {
+ char string[TK_POS_CHARS];
+ TkTextPrintIndex(&dlPtr->index, string);
+ Tcl_SetVar2(textPtr->interp, "tk_textRedraw",
+ (char *) NULL, string,
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ }
+ DisplayDLine(textPtr, dlPtr, prevPtr, pixmap);
+ if (dInfoPtr->dLinesInvalidated) {
+ Tk_FreePixmap(Tk_Display(textPtr->tkwin), pixmap);
+ return;
+ }
+ dlPtr->oldY = dlPtr->y;
+ dlPtr->flags &= ~NEW_LAYOUT;
+ }
+ }
+ Tk_FreePixmap(Tk_Display(textPtr->tkwin), pixmap);
+ }
+
+ /*
+ * See if we need to refresh the part of the window below the
+ * last line of text (if there is any such area). Refresh the
+ * padding area on the left too, since the insertion cursor might
+ * have been displayed there previously).
+ */
+
+ if (dInfoPtr->topOfEof > dInfoPtr->maxY) {
+ dInfoPtr->topOfEof = dInfoPtr->maxY;
+ }
+ if (bottomY < dInfoPtr->topOfEof) {
+ if (tkTextDebug) {
+ Tcl_SetVar2(textPtr->interp, "tk_textRedraw",
+ (char *) NULL, "eof",
+ TCL_GLOBAL_ONLY|TCL_APPEND_VALUE|TCL_LIST_ELEMENT);
+ }
+
+ if (textPtr->tkwin == NULL) {
+
+ /*
+ * The widget has been deleted. Don't do anything.
+ */
+
+ goto end;
+ }
+
+ Tk_Fill3DRectangle(textPtr->tkwin, Tk_WindowId(textPtr->tkwin),
+ textPtr->border, dInfoPtr->x - textPtr->padX, bottomY,
+ dInfoPtr->maxX - (dInfoPtr->x - textPtr->padX),
+ dInfoPtr->topOfEof-bottomY, 0, TK_RELIEF_FLAT);
+ }
+ dInfoPtr->topOfEof = bottomY;
+
+ doScrollbars:
+
+ /*
+ * Update the vertical scrollbar, if there is one. Note: it's
+ * important to clear REDRAW_PENDING here, just in case the
+ * scroll procedure does something that requires redisplay.
+ */
+
+ if (textPtr->flags & UPDATE_SCROLLBARS) {
+ textPtr->flags &= ~UPDATE_SCROLLBARS;
+ if (textPtr->yScrollCmd != NULL) {
+ GetYView(textPtr->interp, textPtr, 1);
+ }
+
+ if (textPtr->tkwin == NULL) {
+
+ /*
+ * The widget has been deleted. Don't do anything.
+ */
+
+ goto end;
+ }
+
+ /*
+ * Update the horizontal scrollbar, if any.
+ */
+
+ if (textPtr->xScrollCmd != NULL) {
+ GetXView(textPtr->interp, textPtr, 1);
+ }
+ }
+
+end:
+ Tcl_Release((ClientData) interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextEventuallyRepick --
+ *
+ * This procedure is invoked whenever something happens that
+ * could change the current character or the tags associated
+ * with it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A repick is scheduled as an idle handler.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+TkTextEventuallyRepick(textPtr)
+ TkText *textPtr; /* Widget record for text widget. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+
+ dInfoPtr->flags |= REPICK_NEEDED;
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ dInfoPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextRedrawRegion --
+ *
+ * This procedure is invoked to schedule a redisplay for a given
+ * region of a text widget. The redisplay itself may not occur
+ * immediately: it's scheduled as a when-idle handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information will eventually be redrawn on the screen.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+TkTextRedrawRegion(textPtr, x, y, width, height)
+ TkText *textPtr; /* Widget record for text widget. */
+ int x, y; /* Coordinates of upper-left corner of area
+ * to be redrawn, in pixels relative to
+ * textPtr's window. */
+ int width, height; /* Width and height of area to be redrawn. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ TkRegion damageRgn = TkCreateRegion();
+ XRectangle rect;
+
+ rect.x = x;
+ rect.y = y;
+ rect.width = width;
+ rect.height = height;
+ TkUnionRectWithRegion(&rect, damageRgn, damageRgn);
+
+ TextInvalidateRegion(textPtr, damageRgn);
+
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ dInfoPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ TkDestroyRegion(damageRgn);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TextInvalidateRegion --
+ *
+ * Mark a region of text as invalid.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Updates the display information for the text widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TextInvalidateRegion(textPtr, region)
+ TkText *textPtr; /* Widget record for text widget. */
+ TkRegion region; /* Region of area to redraw. */
+{
+ register DLine *dlPtr;
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ int maxY, inset;
+ XRectangle rect;
+
+ /*
+ * Find all lines that overlap the given region and mark them for
+ * redisplay.
+ */
+
+ TkClipBox(region, &rect);
+ maxY = rect.y + rect.height;
+ for (dlPtr = dInfoPtr->dLinePtr; dlPtr != NULL;
+ dlPtr = dlPtr->nextPtr) {
+ if ((dlPtr->oldY != -1) && (TkRectInRegion(region, rect.x, dlPtr->y,
+ rect.width, (unsigned int) dlPtr->height) != RectangleOut)) {
+ dlPtr->oldY = -1;
+ }
+ }
+ if (dInfoPtr->topOfEof < maxY) {
+ dInfoPtr->topOfEof = maxY;
+ }
+
+ /*
+ * Schedule the redisplay operation if there isn't one already
+ * scheduled.
+ */
+
+ inset = textPtr->borderWidth + textPtr->highlightWidth;
+ if ((rect.x < (inset + textPtr->padX))
+ || (rect.y < (inset + textPtr->padY))
+ || ((int) (rect.x + rect.width) > (Tk_Width(textPtr->tkwin)
+ - inset - textPtr->padX))
+ || (maxY > (Tk_Height(textPtr->tkwin) - inset - textPtr->padY))) {
+ dInfoPtr->flags |= REDRAW_BORDERS;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextChanged --
+ *
+ * This procedure is invoked when info in a text widget is about
+ * to be modified in a way that changes how it is displayed (e.g.
+ * characters were inserted or deleted, or tag information was
+ * changed). This procedure must be called *before* a change is
+ * made, so that indexes in the display information are still
+ * valid.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The range of character between index1Ptr (inclusive) and
+ * index2Ptr (exclusive) will be redisplayed at some point in the
+ * future (the actual redisplay is scheduled as a when-idle handler).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextChanged(textPtr, index1Ptr, index2Ptr)
+ TkText *textPtr; /* Widget record for text widget. */
+ TkTextIndex *index1Ptr; /* Index of first character to redisplay. */
+ TkTextIndex *index2Ptr; /* Index of character just after last one
+ * to redisplay. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ DLine *firstPtr, *lastPtr;
+ TkTextIndex rounded;
+
+ /*
+ * Schedule both a redisplay and a recomputation of display information.
+ * It's done here rather than the end of the procedure for two reasons:
+ *
+ * 1. If there are no display lines to update we'll want to return
+ * immediately, well before the end of the procedure.
+ * 2. It's important to arrange for the redisplay BEFORE calling
+ * FreeDLines. The reason for this is subtle and has to do with
+ * embedded windows. The chunk delete procedure for an embedded
+ * window will schedule an idle handler to unmap the window.
+ * However, we want the idle handler for redisplay to be called
+ * first, so that it can put the embedded window back on the screen
+ * again (if appropriate). This will prevent the window from ever
+ * being unmapped, and thereby avoid flashing.
+ */
+
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED;
+
+ /*
+ * Find the DLines corresponding to index1Ptr and index2Ptr. There
+ * is one tricky thing here, which is that we have to relayout in
+ * units of whole text lines: round index1Ptr back to the beginning
+ * 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)) {
+ lastPtr = lastPtr->nextPtr;
+ }
+
+ /*
+ * Delete all the DLines from firstPtr up to but not including lastPtr.
+ */
+
+ FreeDLines(textPtr, firstPtr, lastPtr, 1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextRedrawTag --
+ *
+ * This procedure is invoked to request a redraw of all characters
+ * in a given range that have a particular tag on or off. It's
+ * called, for example, when tag options change.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information on the screen may be redrawn, and the layout of
+ * the screen may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextRedrawTag(textPtr, index1Ptr, index2Ptr, tagPtr, withTag)
+ TkText *textPtr; /* Widget record for text widget. */
+ TkTextIndex *index1Ptr; /* First character in range to consider
+ * for redisplay. NULL means start at
+ * beginning of text. */
+ TkTextIndex *index2Ptr; /* Character just after last one to consider
+ * for redisplay. NULL means process all
+ * the characters in the text. */
+ TkTextTag *tagPtr; /* Information about tag. */
+ int withTag; /* 1 means redraw characters that have the
+ * tag, 0 means redraw those without. */
+{
+ register DLine *dlPtr;
+ DLine *endPtr;
+ int tagOn;
+ TkTextSearch search;
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ TkTextIndex *curIndexPtr;
+ TkTextIndex endOfText, *endIndexPtr;
+
+ /*
+ * Round up the starting position if it's before the first line
+ * visible on the screen (we only care about what's on the screen).
+ */
+
+ dlPtr = dInfoPtr->dLinePtr;
+ if (dlPtr == NULL) {
+ return;
+ }
+ if ((index1Ptr == NULL) || (TkTextIndexCmp(&dlPtr->index, index1Ptr) > 0)) {
+ index1Ptr = &dlPtr->index;
+ }
+
+ /*
+ * 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.
+ */
+
+ TkBTreeStartSearch(index1Ptr, index2Ptr, tagPtr, &search);
+ /*
+ * Make our own curIndex because at this point search.curIndex
+ * may not equal index1Ptr->curIndex in the case the first tag toggle
+ * comes after index1Ptr (See the use of FindTagStart in TkBTreeStartSearch)
+ */
+ curIndexPtr = index1Ptr;
+ tagOn = TkBTreeCharTagged(index1Ptr, tagPtr);
+ if (tagOn != withTag) {
+ if (!TkBTreeNextTag(&search)) {
+ return;
+ }
+ curIndexPtr = &search.curIndex;
+ }
+
+ /*
+ * Schedule a redisplay and layout recalculation if they aren't
+ * already pending. This has to be done before calling FreeDLines,
+ * for the reason given in TkTextChanged.
+ */
+
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED;
+
+ /*
+ * Each loop through the loop below is for one range of characters
+ * where the tag's current state is different than its eventual
+ * state. At the top of the loop, search contains information about
+ * the first character in the range.
+ */
+
+ while (1) {
+ /*
+ * Find the first DLine structure in the range. Note: if the
+ * desired character isn't the first in its text line, then look
+ * 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.
+ */
+
+ FreeDLines(textPtr, dlPtr, endPtr, 1);
+ dlPtr = endPtr;
+
+ /*
+ * Find the first text line in the next range.
+ */
+
+ if (!TkBTreeNextTag(&search)) {
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextRelayoutWindow --
+ *
+ * This procedure is called when something has happened that
+ * invalidates the whole layout of characters on the screen, such
+ * as a change in a configuration option for the overall text
+ * widget or a change in the window size. It causes all display
+ * information to be recomputed and the window to be redrawn.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All the display information will be recomputed for the window
+ * and the window will be redrawn.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextRelayoutWindow(textPtr)
+ TkText *textPtr; /* Widget record for text widget. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ GC new;
+ XGCValues gcValues;
+
+ /*
+ * Schedule the window redisplay. See TkTextChanged for the
+ * reason why this has to be done before any calls to FreeDLines.
+ */
+
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ dInfoPtr->flags |= REDRAW_PENDING|REDRAW_BORDERS|DINFO_OUT_OF_DATE
+ |REPICK_NEEDED;
+
+ /*
+ * (Re-)create the graphics context for drawing the traversal
+ * highlight.
+ */
+
+ gcValues.graphics_exposures = False;
+ new = Tk_GetGC(textPtr->tkwin, GCGraphicsExposures, &gcValues);
+ if (dInfoPtr->copyGC != None) {
+ Tk_FreeGC(textPtr->display, dInfoPtr->copyGC);
+ }
+ dInfoPtr->copyGC = new;
+
+ /*
+ * Throw away all the current layout information.
+ */
+
+ FreeDLines(textPtr, dInfoPtr->dLinePtr, (DLine *) NULL, 1);
+ dInfoPtr->dLinePtr = NULL;
+
+ /*
+ * Recompute some overall things for the layout. Even if the
+ * window gets very small, pretend that there's at least one
+ * pixel of drawing space in it.
+ */
+
+ if (textPtr->highlightWidth < 0) {
+ textPtr->highlightWidth = 0;
+ }
+ dInfoPtr->x = textPtr->highlightWidth + textPtr->borderWidth
+ + textPtr->padX;
+ dInfoPtr->y = textPtr->highlightWidth + textPtr->borderWidth
+ + textPtr->padY;
+ dInfoPtr->maxX = Tk_Width(textPtr->tkwin) - textPtr->highlightWidth
+ - textPtr->borderWidth - textPtr->padX;
+ if (dInfoPtr->maxX <= dInfoPtr->x) {
+ dInfoPtr->maxX = dInfoPtr->x + 1;
+ }
+ dInfoPtr->maxY = Tk_Height(textPtr->tkwin) - textPtr->highlightWidth
+ - textPtr->borderWidth - textPtr->padY;
+ if (dInfoPtr->maxY <= dInfoPtr->y) {
+ dInfoPtr->maxY = dInfoPtr->y + 1;
+ }
+ dInfoPtr->topOfEof = dInfoPtr->maxY;
+
+ /*
+ * 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.
+ */
+
+ dInfoPtr->xScrollFirst = dInfoPtr->xScrollLast = -1;
+ dInfoPtr->yScrollFirst = dInfoPtr->yScrollLast = -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextSetYView --
+ *
+ * This procedure is called to specify what lines are to be
+ * displayed in a text widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The display will (eventually) be updated so that the position
+ * given by "indexPtr" is visible on the screen at the position
+ * determined by "pickPlace".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextSetYView(textPtr, indexPtr, pickPlace)
+ TkText *textPtr; /* Widget record for text widget. */
+ TkTextIndex *indexPtr; /* Position that is to appear somewhere
+ * in the view. */
+ int pickPlace; /* 0 means topLine must appear at top of
+ * screen. 1 means we get to pick where it
+ * appears: minimize screen motion or else
+ * display line at center of screen. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ register DLine *dlPtr;
+ int bottomY, close, lineIndex;
+ TkTextIndex tmpIndex, rounded;
+ Tk_FontMetrics fm;
+
+ /*
+ * If the specified position is the extra line at the end of the
+ * text, round it back to the last real line.
+ */
+
+ lineIndex = TkBTreeLineIndex(indexPtr->linePtr);
+ if (lineIndex == TkBTreeNumLines(indexPtr->tree)) {
+ TkTextIndexBackChars(indexPtr, 1, &rounded);
+ indexPtr = &rounded;
+ }
+
+ if (!pickPlace) {
+ /*
+ * 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;
+ }
+
+ /*
+ * We have to pick where to display the index. First, bring
+ * the display information up to date and see if the index will be
+ * completely visible in the current screen configuration. If so
+ * then there's nothing to do.
+ */
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+ dlPtr = FindDLine(dInfoPtr->dLinePtr, indexPtr);
+ if (dlPtr != NULL) {
+ if ((dlPtr->y + dlPtr->height) > dInfoPtr->maxY) {
+ /*
+ * 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.
+ * Close means within 1/3 of the screen height or within three
+ * lines, whichever is greater. Add one extra line also, to
+ * account for the way MeasureUp rounds.
+ */
+
+ Tk_GetFontMetrics(textPtr->tkfont, &fm);
+ bottomY = (dInfoPtr->y + dInfoPtr->maxY + fm.linespace)/2;
+ close = (dInfoPtr->maxY - dInfoPtr->y)/3;
+ if (close < 3*fm.linespace) {
+ close = 3*fm.linespace;
+ }
+ close += fm.linespace;
+ if (dlPtr != NULL) {
+ /*
+ * The desired line is above the top of screen. If it is
+ * "close" to the top of the window then make it the top
+ * line on the screen.
+ */
+
+ MeasureUp(textPtr, &textPtr->topIndex, close, &tmpIndex);
+ if (TkTextIndexCmp(&tmpIndex, indexPtr) <= 0) {
+ MeasureUp(textPtr, indexPtr, 0, &textPtr->topIndex);
+ goto scheduleUpdate;
+ }
+ } else {
+ /*
+ * The desired line is below the bottom of the screen. If it is
+ * "close" to the bottom of the screen then position it at the
+ * bottom of the screen.
+ */
+
+ MeasureUp(textPtr, indexPtr, close, &tmpIndex);
+ if (FindDLine(dInfoPtr->dLinePtr, &tmpIndex) != NULL) {
+ bottomY = dInfoPtr->maxY - dInfoPtr->y;
+ }
+ }
+
+ /*
+ * Our job now is to arrange the display so that indexPtr appears
+ * as low on the screen as possible but with its bottom no lower
+ * than bottomY. BottomY is the bottom of the window if the
+ * desired line is just below the current screen, otherwise it
+ * is a half-line lower than the center of the window.
+ */
+
+ MeasureUp(textPtr, indexPtr, bottomY, &textPtr->topIndex);
+
+ scheduleUpdate:
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MeasureUp --
+ *
+ * Given one index, find the index of the first character
+ * on the highest display line that would be displayed no more
+ * than "distance" pixels above the given index.
+ *
+ * Results:
+ * *dstPtr is filled in with the index of the first character
+ * on a display line. The display line is found by measuring
+ * up "distance" pixels above the pixel just below an imaginary
+ * display line that contains srcPtr. If the display line
+ * that covers this coordinate actually extends above the
+ * coordinate, then return the index of the next lower line
+ * instead (i.e. the returned index will be completely visible
+ * at or below the given y-coordinate).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+MeasureUp(textPtr, srcPtr, distance, dstPtr)
+ TkText *textPtr; /* Text widget in which to measure. */
+ TkTextIndex *srcPtr; /* Index of character from which to start
+ * 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.
+ */
+
+ for (dlPtr = lowestPtr; dlPtr != NULL; dlPtr = dlPtr->nextPtr) {
+ distance -= dlPtr->height;
+ if (distance < 0) {
+ *dstPtr = (noBestYet) ? dlPtr->index : bestIndex;
+ break;
+ }
+ bestIndex = dlPtr->index;
+ noBestYet = 0;
+ }
+
+ /*
+ * Discard the display lines, then either return or prepare
+ * 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 --
+ *
+ * This procedure is invoked to process the "see" option for
+ * the widget command for text widgets. See the user documentation
+ * for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextSeeCmd(textPtr, interp, argc, argv)
+ TkText *textPtr; /* Information about text widget. */
+ 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 "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;
+ }
+
+ if (TkTextGetIndex(interp, textPtr, argv[2], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * If the specified position is the extra line at the end of the
+ * text, round it back to the last real line.
+ */
+
+ if (TkBTreeLineIndex(index.linePtr) == TkBTreeNumLines(index.tree)) {
+ TkTextIndexBackChars(&index, 1, &index);
+ }
+
+ /*
+ * First get the desired position into the vertical range of the window.
+ */
+
+ TkTextSetYView(textPtr, &index, 1);
+
+ /*
+ * Now make sure that the character is in view horizontally.
+ */
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+ lineWidth = dInfoPtr->maxX - dInfoPtr->x;
+ if (dInfoPtr->maxLength < lineWidth) {
+ return TCL_OK;
+ }
+
+ /*
+ * Find the chunk that contains the desired index.
+ */
+
+ dlPtr = FindDLine(dInfoPtr->dLinePtr, &index);
+
+ /*
+ * CYGNUS LOCAL: I can sometimes get FindDLine to return a null
+ * pointer. I have not been able to find a simple test case,
+ * it happens in Gdbtk when you change the font for the debug window.
+ * Since you should not have to catch the see command, I have made
+ * the error silent...
+ */
+
+ if (dlPtr == NULL) {
+ Tcl_AppendResult(interp, "got a null dlinePtr from FindDLine in the see command.",
+ (char *) NULL);
+ return TCL_OK;
+ }
+
+ 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;
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ dInfoPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextXviewCmd --
+ *
+ * This procedure is invoked to process the "xview" option for
+ * the widget command for text widgets. See the user documentation
+ * for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextXviewCmd(textPtr, interp, argc, argv)
+ TkText *textPtr; /* Information about text widget. */
+ 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 "xview". */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ int type, charsPerPage, count, newOffset;
+ double fraction;
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScrollByLines --
+ *
+ * This procedure is called to scroll a text widget up or down
+ * by a given number of lines.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The view in textPtr's window changes to reflect the value
+ * of "offset".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ScrollByLines(textPtr, offset)
+ 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;
+ }
+ }
+
+ scheduleUpdate:
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextYviewCmd --
+ *
+ * This procedure is invoked to process the "yview" option for
+ * the widget command for text widgets. See the user documentation
+ * for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextYviewCmd(textPtr, interp, argc, argv)
+ TkText *textPtr; /* Information about text widget. */
+ 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;
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+
+ if (argc == 2) {
+ GetYView(interp, textPtr, 0);
+ return TCL_OK;
+ }
+
+ /*
+ * Next, handle the old syntax: "pathName yview ?-pickplace? where"
+ */
+
+ pickPlace = 0;
+ if (argv[2][0] == '-') {
+ switchLength = strlen(argv[2]);
+ if ((switchLength >= 2)
+ && (strncmp(argv[2], "-pickplace", switchLength) == 0)) {
+ pickPlace = 1;
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " yview -pickplace lineNum|index\"",
+ (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.
+ */
+
+ Tcl_ResetResult(interp);
+ if (TkTextGetIndex(interp, textPtr, argv[2+pickPlace],
+ &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ TkTextSetYView(textPtr, &index, pickPlace);
+ return TCL_OK;
+ }
+
+ /*
+ * New syntax: dispatch based on argv[2].
+ */
+
+ 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;
+ }
+ 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
+ * overlap between adjacent pages.
+ */
+
+ Tk_GetFontMetrics(textPtr->tkfont, &fm);
+ if (count < 0) {
+ pixels = (dInfoPtr->maxY - 2*fm.linespace - dInfoPtr->y)*(-count)
+ + fm.linespace;
+ MeasureUp(textPtr, &textPtr->topIndex, pixels, &new);
+ if (TkTextIndexCmp(&textPtr->topIndex, &new) == 0) {
+ /*
+ * A page of scrolling ended up being less than one line.
+ * Scroll one line anyway.
+ */
+
+ count = -1;
+ goto scrollByLines;
+ }
+ textPtr->topIndex = new;
+ } else {
+ /*
+ * Scrolling down by pages. Layout lines starting at the
+ * top index and count through the desired vertical distance.
+ */
+
+ 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;
+ } while (pixels > 0);
+ }
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ dInfoPtr->flags |= REDRAW_PENDING|DINFO_OUT_OF_DATE|REPICK_NEEDED;
+ break;
+ case TK_SCROLL_UNITS:
+ scrollByLines:
+ ScrollByLines(textPtr, count);
+ break;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextScanCmd --
+ *
+ * This procedure is invoked to process the "scan" option for
+ * the widget command for text widgets. See the user documentation
+ * for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextScanCmd(textPtr, interp, argc, argv)
+ register TkText *textPtr; /* Information about text widget. */
+ 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 "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;
+ }
+ if (Tcl_GetInt(interp, argv[3], &x) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[4], &y) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ c = argv[2][0];
+ length = strlen(argv[2]);
+ if ((c == 'd') && (strncmp(argv[2], "dragto", length) == 0)) {
+ /*
+ * Amplify the difference between the current position and the
+ * mark position to compute how much the view should shift, then
+ * update the mark position to correspond to the new view. If we
+ * run off the edge of the text, 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).
+ */
+
+ 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;
+ }
+ dInfoPtr->flags |= DINFO_OUT_OF_DATE;
+ if (!(dInfoPtr->flags & REDRAW_PENDING)) {
+ dInfoPtr->flags |= REDRAW_PENDING;
+ Tcl_DoWhenIdle(DisplayText, (ClientData) textPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ sprintf(buffer, " %g %g", first, last);
+ code = Tcl_VarEval(interp, textPtr->xScrollCmd,
+ buffer, (char *) NULL);
+ if (code != TCL_OK) {
+ Tcl_AddErrorInfo(interp,
+ "\n (horizontal scrolling command executed by text)");
+ Tcl_BackgroundError(interp);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindDLine --
+ *
+ * This procedure is called to find the DLine corresponding to a
+ * given text index.
+ *
+ * Results:
+ * The return value is a pointer to the first DLine found in the
+ * list headed by dlPtr that displays information at or after the
+ * specified position. If there is no such line in the list then
+ * NULL is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static DLine *
+FindDLine(dlPtr, indexPtr)
+ register DLine *dlPtr; /* Pointer to first in list of DLines
+ * to search. */
+ TkTextIndex *indexPtr; /* Index of desired character. */
+{
+ TkTextLine *linePtr;
+
+ if (dlPtr == NULL) {
+ return NULL;
+ }
+ if (TkBTreeLineIndex(indexPtr->linePtr)
+ < TkBTreeLineIndex(dlPtr->index.linePtr)) {
+ /*
+ * The first display line is already past the desired line.
+ */
+ return dlPtr;
+ }
+
+ /*
+ * Find the first display line that covers the desired text line.
+ */
+
+ linePtr = dlPtr->index.linePtr;
+ while (linePtr != indexPtr->linePtr) {
+ while (dlPtr->index.linePtr == linePtr) {
+ dlPtr = dlPtr->nextPtr;
+ if (dlPtr == NULL) {
+ return NULL;
+ }
+ }
+ linePtr = TkBTreeNextLine(linePtr);
+ if (linePtr == NULL) {
+ panic("FindDLine reached end of text");
+ }
+ }
+ if (indexPtr->linePtr != dlPtr->index.linePtr) {
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextPixelIndex --
+ *
+ * Given an (x,y) coordinate on the screen, find the location of
+ * the character closest to that location.
+ *
+ * Results:
+ * The index at *indexPtr is modified to refer to the character
+ * on the display that is closest to (x,y).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextPixelIndex(textPtr, x, y, indexPtr)
+ TkText *textPtr; /* Widget record for text widget. */
+ int x, y; /* Pixel coordinates of point in widget's
+ * window. */
+ TkTextIndex *indexPtr; /* This index gets filled in with the
+ * index of the character nearest to (x,y). */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ register DLine *dlPtr;
+ register TkTextDispChunk *chunkPtr;
+
+ /*
+ * Make sure that all of the layout information about what's
+ * displayed where on the screen is up-to-date.
+ */
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+
+ /*
+ * If the coordinates are above the top of the window, then adjust
+ * them to refer to the upper-right corner of the window. If they're
+ * off to one side or the other, then adjust to the closest side.
+ */
+
+ if (y < dInfoPtr->y) {
+ y = dInfoPtr->y;
+ x = dInfoPtr->x;
+ }
+ if (x >= dInfoPtr->maxX) {
+ x = dInfoPtr->maxX - 1;
+ }
+ if (x < dInfoPtr->x) {
+ x = dInfoPtr->x;
+ }
+
+ /*
+ * Find the display line containing the desired y-coordinate.
+ */
+
+ for (dlPtr = dInfoPtr->dLinePtr; y >= (dlPtr->y + dlPtr->height);
+ dlPtr = dlPtr->nextPtr) {
+ if (dlPtr->nextPtr == NULL) {
+ /*
+ * Y-coordinate is off the bottom of the displayed text.
+ * Use the last character on the last line.
+ */
+
+ x = dInfoPtr->maxX - 1;
+ break;
+ }
+ }
+
+ /*
+ * Scan through the line's chunks to find the one that contains
+ * the desired x-coordinate. Before doing this, translate the
+ * 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 --
+ *
+ * Given an index, find the bounding box of the screen area
+ * occupied by that character.
+ *
+ * Results:
+ * Zero is returned if the character is on the screen. -1
+ * means the character isn't on the screen. If the return value
+ * is 0, then the bounding box of the part of the character that's
+ * visible on the screen is returned to *xPtr, *yPtr, *widthPtr,
+ * and *heightPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkTextCharBbox(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr)
+ TkText *textPtr; /* Widget record for text widget. */
+ TkTextIndex *indexPtr; /* Index of character whose bounding
+ * box is desired. */
+ 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);
+ }
+
+ /*
+ * Find the display line containing the desired index.
+ */
+
+ dlPtr = FindDLine(dInfoPtr->dLinePtr, indexPtr);
+ if ((dlPtr == NULL) || (TkTextIndexCmp(&dlPtr->index, indexPtr) > 0)) {
+ return -1;
+ }
+
+ /*
+ * 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;
+ }
+ *widthPtr = dInfoPtr->maxX - *xPtr;
+ }
+ if ((*xPtr + *widthPtr) <= dInfoPtr->x) {
+ return -1;
+ }
+ if ((*xPtr + *widthPtr) > dInfoPtr->maxX) {
+ *widthPtr = dInfoPtr->maxX - *xPtr;
+ if (*widthPtr <= 0) {
+ return -1;
+ }
+ }
+ if ((*yPtr + *heightPtr) > dInfoPtr->maxY) {
+ *heightPtr = dInfoPtr->maxY - *yPtr;
+ if (*heightPtr <= 0) {
+ return -1;
+ }
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextDLineInfo --
+ *
+ * Given an index, return information about the display line
+ * containing that character.
+ *
+ * Results:
+ * Zero is returned if the character is on the screen. -1
+ * means the character isn't on the screen. If the return value
+ * is 0, then information is returned in the variables pointed
+ * to by xPtr, yPtr, widthPtr, heightPtr, and basePtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkTextDLineInfo(textPtr, indexPtr, xPtr, yPtr, widthPtr, heightPtr, basePtr)
+ TkText *textPtr; /* Widget record for text widget. */
+ TkTextIndex *indexPtr; /* Index of character whose bounding
+ * box is desired. */
+ int *xPtr, *yPtr; /* Filled with line's upper-left
+ * coordinate. */
+ int *widthPtr, *heightPtr; /* Filled in with line's dimensions. */
+ int *basePtr; /* Filled in with the baseline position,
+ * measured as an offset down from *yPtr. */
+{
+ TextDInfo *dInfoPtr = textPtr->dInfoPtr;
+ DLine *dlPtr;
+
+ /*
+ * Make sure that all of the screen layout information is up to date.
+ */
+
+ if (dInfoPtr->flags & DINFO_OUT_OF_DATE) {
+ UpdateDisplayInfo(textPtr);
+ }
+
+ /*
+ * Find the display line containing the desired index.
+ */
+
+ dlPtr = FindDLine(dInfoPtr->dLinePtr, indexPtr);
+ if ((dlPtr == NULL) || (TkTextIndexCmp(&dlPtr->index, indexPtr) > 0)) {
+ return -1;
+ }
+
+ *xPtr = dInfoPtr->x - dInfoPtr->curPixelOffset + dlPtr->chunkPtr->x;
+ *widthPtr = dlPtr->length - dlPtr->chunkPtr->x;
+ *yPtr = dlPtr->y;
+ if ((dlPtr->y + dlPtr->height) > dInfoPtr->maxY) {
+ *heightPtr = dInfoPtr->maxY - dlPtr->y;
+ } else {
+ *heightPtr = dlPtr->height;
+ }
+ *basePtr = dlPtr->baseline;
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharDisplayProc --
+ *
+ * This procedure is called to display a character chunk on
+ * the screen or in an off-screen pixmap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Graphics are drawn.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CharDisplayProc(chunkPtr, x, y, height, baseline, display, dst, screenY)
+ TkTextDispChunk *chunkPtr; /* Chunk that is to be drawn. */
+ int x; /* X-position in dst at which to
+ * draw this chunk (may differ from
+ * the x-position in the chunk because
+ * of scrolling). */
+ int y; /* Y-position at which to draw this
+ * chunk in dst. */
+ int height; /* Total height of line. */
+ int baseline; /* Offset of baseline from y. */
+ Display *display; /* Display to use for drawing. */
+ Drawable dst; /* Pixmap or window in which to draw
+ * 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;
+ }
+
+ stylePtr = chunkPtr->stylePtr;
+ sValuePtr = stylePtr->sValuePtr;
+
+ /*
+ * If the text sticks out way to the left of the window, skip
+ * 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);
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharUndisplayProc --
+ *
+ * This procedure is called when a character chunk is no
+ * longer going to be displayed. It frees up resources
+ * that were allocated to display the chunk.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory and other resources get freed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+CharUndisplayProc(textPtr, chunkPtr)
+ TkText *textPtr; /* Overall information about text
+ * widget. */
+ TkTextDispChunk *chunkPtr; /* Chunk that is about to be freed. */
+{
+ CharInfo *ciPtr = (CharInfo *) chunkPtr->clientData;
+
+ ckfree((char *) ciPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * CharMeasureProc --
+ *
+ * This procedure is called to determine which character in
+ * a character chunk lies over a given x-coordinate.
+ *
+ * Results:
+ * The return value is the index *within the chunk* of the
+ * character that covers the position given by "x".
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+CharMeasureProc(chunkPtr, x)
+ TkTextDispChunk *chunkPtr; /* Chunk containing desired coord. */
+ 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 --
+ *
+ * This procedure is called to compute the bounding box of
+ * the area occupied by a single character.
+ *
+ * Results:
+ * There is no return value. *xPtr and *yPtr are filled in
+ * with the coordinates of the upper left corner of the
+ * character, and *widthPtr and *heightPtr are filled in with
+ * the dimensions of the character in pixels. Note: not all
+ * of the returned bbox is necessarily visible on the screen
+ * (the rightmost part might be off-screen to the right,
+ * and the bottommost part might be off-screen to the bottom).
+ *
+ * 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;
+ *heightPtr = chunkPtr->minAscent + chunkPtr->minDescent;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AdjustForTab --
+ *
+ * This procedure is called to move a series of chunks right
+ * in order to align them with a tab stop.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The width of chunkPtr gets adjusted so that it absorbs the
+ * extra space due to the tab. The x locations in all the chunks
+ * after chunkPtr are adjusted rightward to align with the tab
+ * stop given by tabArrayPtr and index.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+AdjustForTab(textPtr, tabArrayPtr, index, chunkPtr)
+ TkText *textPtr; /* Information about the text widget as
+ * a whole. */
+ TkTextTabArray *tabArrayPtr; /* Information about the tab stops
+ * that apply to this line. May be
+ * NULL to indicate default tabbing
+ * (every 8 chars). */
+ int index; /* Index of current tab stop. */
+ TkTextDispChunk *chunkPtr; /* Chunk whose last character is
+ * the tab; the following chunks
+ * contain information to be shifted
+ * right. */
+
+{
+ int x, desired, delta, width, decimal, i, gotDigit;
+ TkTextDispChunk *chunkPtr2, *decimalChunkPtr;
+ CharInfo *ciPtr;
+ int tabX, prev, spaceWidth;
+ char *p;
+ TkTextTabAlign alignment;
+
+ if (chunkPtr->nextPtr == NULL) {
+ /*
+ * Nothing after the actual tab; just return.
+ */
+
+ return;
+ }
+
+ /*
+ * If no tab information has been given, do the usual thing:
+ * round up to the next boundary of 8 average-sized characters.
+ */
+
+ x = chunkPtr->nextPtr->x;
+ if ((tabArrayPtr == NULL) || (tabArrayPtr->numTabs == 0)) {
+ /*
+ * No tab information has been given, so use the default
+ * interpretation of tabs.
+ */
+
+ desired = NextTabStop(textPtr, textPtr->tkfont, x, 0);
+ goto update;
+ }
+
+ if (index < tabArrayPtr->numTabs) {
+ alignment = tabArrayPtr->tabs[index].alignment;
+ tabX = tabArrayPtr->tabs[index].location;
+ } else {
+ /*
+ * Ran out of tab stops; compute a tab position by extrapolating
+ * from the last two tab positions.
+ */
+
+ if (tabArrayPtr->numTabs > 1) {
+ prev = tabArrayPtr->tabs[tabArrayPtr->numTabs-2].location;
+ } else {
+ prev = 0;
+ }
+ alignment = tabArrayPtr->tabs[tabArrayPtr->numTabs-1].alignment;
+ tabX = tabArrayPtr->tabs[tabArrayPtr->numTabs-1].location
+ + (index + 1 - tabArrayPtr->numTabs)
+ * (tabArrayPtr->tabs[tabArrayPtr->numTabs-1].location - prev);
+ }
+
+ if (alignment == LEFT) {
+ desired = tabX;
+ goto update;
+ }
+
+ if ((alignment == CENTER) || (alignment == RIGHT)) {
+ /*
+ * Compute the width of all the information in the tab group,
+ * then use it to pick a desired location.
+ */
+
+ width = 0;
+ for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL;
+ chunkPtr2 = chunkPtr2->nextPtr) {
+ width += chunkPtr2->width;
+ }
+ if (alignment == CENTER) {
+ desired = tabX - width/2;
+ } else {
+ desired = tabX - width;
+ }
+ goto update;
+ }
+
+ /*
+ * Must be numeric alignment. Search through the text to be
+ * tabbed, looking for the last , or . before the first character
+ * that isn't a number, comma, period, or sign.
+ */
+
+ decimalChunkPtr = NULL;
+ 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.
+ */
+
+ width = 0;
+ for (chunkPtr2 = chunkPtr->nextPtr; chunkPtr2 != NULL;
+ chunkPtr2 = chunkPtr2->nextPtr) {
+ width += chunkPtr2->width;
+ }
+ desired = tabX - width;
+ }
+
+ /*
+ * Shift all of the chunks to the right so that the left edge is
+ * 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;
+ }
+ chunkPtr->width += delta;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SizeOfTab --
+ *
+ * This returns an estimate of the amount of white space that will
+ * be consumed by a tab.
+ *
+ * Results:
+ * The return value is the minimum number of pixels that will
+ * be occupied by the index'th tab of tabArrayPtr, assuming that
+ * the current position on the line is x and the end of the
+ * line is maxX. For numeric tabs, this is a conservative
+ * estimate. The return value is always >= 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SizeOfTab(textPtr, tabArrayPtr, index, x, maxX)
+ TkText *textPtr; /* Information about the text widget as
+ * a whole. */
+ TkTextTabArray *tabArrayPtr; /* Information about the tab stops
+ * that apply to this line. NULL
+ * means use default tabbing (every
+ * 8 chars.) */
+ int index; /* Index of current tab stop. */
+ int x; /* Current x-location in line. Only
+ * used if tabArrayPtr == NULL. */
+ int maxX; /* X-location of pixel just past the
+ * right edge of the line. */
+{
+ int tabX, prev, result, spaceWidth;
+ TkTextTabAlign alignment;
+
+ if ((tabArrayPtr == NULL) || (tabArrayPtr->numTabs == 0)) {
+ tabX = NextTabStop(textPtr, textPtr->tkfont, x, 0);
+ return tabX - x;
+ }
+ if (index < tabArrayPtr->numTabs) {
+ tabX = tabArrayPtr->tabs[index].location;
+ alignment = tabArrayPtr->tabs[index].alignment;
+ } else {
+ /*
+ * Ran out of tab stops; compute a tab position by extrapolating
+ * from the last two tab positions.
+ */
+
+ if (tabArrayPtr->numTabs > 1) {
+ prev = tabArrayPtr->tabs[tabArrayPtr->numTabs-2].location;
+ } else {
+ prev = 0;
+ }
+ tabX = tabArrayPtr->tabs[tabArrayPtr->numTabs-1].location
+ + (index + 1 - tabArrayPtr->numTabs)
+ * (tabArrayPtr->tabs[tabArrayPtr->numTabs-1].location - prev);
+ alignment = tabArrayPtr->tabs[tabArrayPtr->numTabs-1].alignment;
+ }
+ if (alignment == CENTER) {
+ /*
+ * Be very careful in the arithmetic below, because maxX may
+ * be the largest positive number: watch out for integer
+ * overflow.
+ */
+
+ if ((maxX-tabX) < (tabX - x)) {
+ result = (maxX - x) - 2*(maxX - tabX);
+ } else {
+ result = 0;
+ }
+ goto done;
+ }
+ if (alignment == RIGHT) {
+ result = 0;
+ goto done;
+ }
+
+ /*
+ * Note: this treats NUMERIC alignment the same as LEFT
+ * alignment, which is somewhat conservative. However, it's
+ * pretty tricky at this point to figure out exactly where
+ * the damn decimal point will be.
+ */
+
+ 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;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * NextTabStop --
+ *
+ * Given the current position, determine where the next default
+ * tab stop would be located. This procedure is called when the
+ * current chunk in the text has no tabs defined and so the default
+ * tab spacing for the font should be used.
+ *
+ * Results:
+ * The location in pixels of the next tab stop.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+static int
+NextTabStop(textPtr, tkfont, x, tabOrigin)
+ TkText *textPtr;
+ Tk_Font tkfont; /* Font in which chunk that contains tab
+ * stop will be drawn. */
+ int x; /* X-position in pixels where last
+ * character was drawn. The next tab stop
+ * occurs somewhere after this location. */
+ int tabOrigin; /* The origin for tab stops. May be
+ * non-zero if text has been scrolled. */
+{
+ int tabWidth, rem;
+
+#if 1
+ tabWidth = Tk_TextWidth(tkfont, "0", 1) * textPtr->tabsize;
+#else
+ tabWidth = Tk_TextWidth(tkfont, "0", 1) * 8;
+#endif
+ if (tabWidth == 0) {
+ tabWidth = 1;
+ }
+
+ x += tabWidth;
+ rem = (x - tabOrigin) % tabWidth;
+ if (rem < 0) {
+ rem += tabWidth;
+ }
+ x -= rem;
+ return x;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * 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_DisplayChars will be used to actually display
+ * the characters.
+ *
+ * If tabs are encountered in the string, they will be expanded
+ * 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) {
+ /*
+ * No more chars fit in line.
+ */
+
+ break;
+ }
+ if (special < end) {
+ if (ch == '\t') {
+ start++;
+ } else {
+ break;
+ }
+ }
+ }
+
+ *nextXPtr = curX;
+ return start - source;
+}
diff --git a/tk/generic/tkTextImage.c b/tk/generic/tkTextImage.c
new file mode 100644
index 00000000000..2083d101895
--- /dev/null
+++ b/tk/generic/tkTextImage.c
@@ -0,0 +1,898 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tk.h"
+#include "tkText.h"
+#include "tkPort.h"
+
+/*
+ * Definitions for alignment values:
+ */
+
+#define ALIGN_BOTTOM 0
+#define ALIGN_CENTER 1
+#define ALIGN_TOP 2
+#define ALIGN_BASELINE 3
+
+/*
+ * Macro that determines the size of an embedded image segment:
+ */
+
+#define EI_SEG_SIZE ((unsigned) (Tk_Offset(TkTextSegment, body) \
+ + sizeof(TkTextEmbImage)))
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static int AlignParseProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin, char *value,
+ char *widgRec, int offset));
+static char * AlignPrintProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+static TkTextSegment * EmbImageCleanupProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static void EmbImageCheckProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static void EmbImageBboxProc _ANSI_ARGS_((TkTextDispChunk *chunkPtr,
+ int index, int y, int lineHeight, int baseline,
+ int *xPtr, int *yPtr, int *widthPtr,
+ int *heightPtr));
+static int EmbImageConfigure _ANSI_ARGS_((TkText *textPtr,
+ TkTextSegment *eiPtr, int argc, char **argv));
+static int EmbImageDeleteProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr, int treeGone));
+static void EmbImageDisplayProc _ANSI_ARGS_((
+ TkTextDispChunk *chunkPtr, int x, int y,
+ int lineHeight, int baseline, Display *display,
+ Drawable dst, int screenY));
+static int EmbImageLayoutProc _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr, TkTextSegment *segPtr,
+ int offset, int maxX, int maxChars,
+ int noCharsYet, Tk_Uid wrapMode,
+ TkTextDispChunk *chunkPtr));
+static void EmbImageProc _ANSI_ARGS_((ClientData clientData,
+ int x, int y, int width, int height,
+ int imageWidth, int imageHeight));
+
+/*
+ * The following structure declares the "embedded image" segment type.
+ */
+
+static Tk_SegType tkTextEmbImageType = {
+ "image", /* name */
+ 0, /* leftGravity */
+ (Tk_SegSplitProc *) NULL, /* splitProc */
+ EmbImageDeleteProc, /* deleteProc */
+ EmbImageCleanupProc, /* cleanupProc */
+ (Tk_SegLineChangeProc *) NULL, /* lineChangeProc */
+ EmbImageLayoutProc, /* layoutProc */
+ EmbImageCheckProc /* checkProc */
+};
+
+/*
+ * Information used for parsing image configuration options:
+ */
+
+static Tk_CustomOption alignOption = {AlignParseProc, AlignPrintProc,
+ (ClientData) NULL};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_CUSTOM, "-align", (char *) NULL, (char *) NULL,
+ "center", 0, TK_CONFIG_DONT_SET_DEFAULT, &alignOption},
+ {TK_CONFIG_PIXELS, "-padx", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(TkTextEmbImage, padX),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_PIXELS, "-pady", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(TkTextEmbImage, padY),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_STRING, "-image", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextEmbImage, imageString),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-name", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextEmbImage, imageName),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextImageCmd --
+ *
+ * This procedure implements the "image" widget command
+ * for text widgets. See the user documentation for details
+ * on what it does.
+ *
+ * Results:
+ * A standard Tcl result or error.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextImageCmd(textPtr, interp, argc, argv)
+ register TkText *textPtr; /* Information about text widget. */
+ 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 "image". */
+{
+ size_t length;
+ register TkTextSegment *eiPtr;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " image option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ length = strlen(argv[2]);
+ if ((strncmp(argv[2], "cget", length) == 0) && (length >= 2)) {
+ TkTextIndex index;
+ TkTextSegment *eiPtr;
+
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " image cget index option\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ eiPtr = TkTextIndexToSeg(&index, (int *) NULL);
+ if (eiPtr->typePtr != &tkTextEmbImageType) {
+ Tcl_AppendResult(interp, "no embedded image at index \"",
+ argv[3], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return Tk_ConfigureValue(interp, textPtr->tkwin, configSpecs,
+ (char *) &eiPtr->body.ei, argv[4], 0);
+ } else if ((strncmp(argv[2], "configure", length) == 0) && (length >= 2)) {
+ TkTextIndex index;
+ TkTextSegment *eiPtr;
+
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " image configure index ?option value ...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ eiPtr = TkTextIndexToSeg(&index, (int *) NULL);
+ if (eiPtr->typePtr != &tkTextEmbImageType) {
+ Tcl_AppendResult(interp, "no embedded image at index \"",
+ argv[3], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 4) {
+ return Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
+ (char *) &eiPtr->body.ei, (char *) NULL, 0);
+ } else if (argc == 5) {
+ return Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
+ (char *) &eiPtr->body.ei, argv[4], 0);
+ } else {
+ TkTextChanged(textPtr, &index, &index);
+ return EmbImageConfigure(textPtr, eiPtr, argc-4, argv+4);
+ }
+ } else if ((strncmp(argv[2], "create", length) == 0) && (length >= 2)) {
+ TkTextIndex index;
+ int lineIndex;
+
+ /*
+ * Add a new image. Find where to put the new image, and
+ * mark that position for redisplay.
+ */
+
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " image create index ?option value ...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * 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);
+ eiPtr->typePtr = &tkTextEmbImageType;
+ eiPtr->size = 1;
+ eiPtr->body.ei.textPtr = textPtr;
+ eiPtr->body.ei.linePtr = NULL;
+ eiPtr->body.ei.imageName = NULL;
+ eiPtr->body.ei.imageString = NULL;
+ eiPtr->body.ei.name = NULL;
+ eiPtr->body.ei.image = NULL;
+ eiPtr->body.ei.align = ALIGN_CENTER;
+ eiPtr->body.ei.padX = eiPtr->body.ei.padY = 0;
+ eiPtr->body.ei.chunkCount = 0;
+
+ /*
+ * Link the segment into the text widget, then configure it (delete
+ * it again if the configuration fails).
+ */
+
+ TkTextChanged(textPtr, &index, &index);
+ TkBTreeLinkSegment(eiPtr, &index);
+ if (EmbImageConfigure(textPtr, eiPtr, argc-4, argv+4) != TCL_OK) {
+ TkTextIndex index2;
+
+ TkTextIndexForwChars(&index, 1, &index2);
+ TkBTreeDeleteChars(&index, &index2);
+ return TCL_ERROR;
+ }
+ } else if (strncmp(argv[2], "names", length) == 0) {
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " image names\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->imageTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendElement(interp,
+ Tcl_GetHashKey(&textPtr->markTable, hPtr));
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad image option \"", argv[2],
+ "\": must be cget, configure, create, or names",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+EmbImageConfigure(textPtr, eiPtr, argc, argv)
+ TkText *textPtr; /* Information about text widget that
+ * contains embedded image. */
+ TkTextSegment *eiPtr; /* Embedded image to be configured. */
+ int argc; /* Number of strings in argv. */
+ char **argv; /* Array of strings describing configuration
+ * options. */
+{
+ Tk_Image image;
+ Tcl_DString newName;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+ int new;
+ char *name;
+ int count = 0; /* The counter for picking a unique name */
+ int conflict = 0; /* True if we have a name conflict */
+ unsigned int len; /* length of image name */
+
+ if (Tk_ConfigureWidget(textPtr->interp, textPtr->tkwin, configSpecs,
+ argc, argv, (char *) &eiPtr->body.ei,TK_CONFIG_ARGV_ONLY)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * Create the image. Save the old image around and don't free it
+ * until after the new one is allocated. This keeps the reference
+ * count from going to zero so the image doesn't have to be recreated
+ * if it hasn't changed.
+ */
+
+ if (eiPtr->body.ei.imageString != NULL) {
+ image = Tk_GetImage(textPtr->interp, textPtr->tkwin, eiPtr->body.ei.imageString,
+ EmbImageProc, (ClientData) eiPtr);
+ if (image == NULL) {
+ return TCL_ERROR;
+ }
+ } else {
+ image = NULL;
+ }
+ if (eiPtr->body.ei.image != NULL) {
+ Tk_FreeImage(eiPtr->body.ei.image);
+ }
+ eiPtr->body.ei.image = image;
+
+ if (eiPtr->body.ei.name != NULL) {
+ return TCL_OK;
+ }
+
+ /*
+ * Find a unique name for this image. Use imageName (or imageString)
+ * if available, otherwise tack on a #nn and use it. If a name is already
+ * associated with this image, delete the name.
+ */
+
+ name = eiPtr->body.ei.imageName;
+ if (name == NULL) {
+ name = eiPtr->body.ei.imageString;
+ }
+ if (name == NULL) {
+ Tcl_AppendResult(textPtr->interp,"Either a \"-name\" ",
+ "or a \"-image\" argument must be provided ",
+ "to the \"image create\" subcommand.",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ len = strlen(name);
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->imageTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ char *haveName = Tcl_GetHashKey(&textPtr->imageTable, hPtr);
+ if (strncmp(name, haveName, len) == 0) {
+ new = 0;
+ sscanf(haveName+len,"#%d",&new);
+ if (new > count) {
+ count = new;
+ }
+ if (len == (int) strlen(haveName)) {
+ conflict = 1;
+ }
+ }
+ }
+
+ 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);
+ eiPtr->body.ei.name = ckalloc((unsigned) Tcl_DStringLength(&newName)+1);
+ strcpy(eiPtr->body.ei.name,name);
+ Tcl_DStringFree(&newName);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AlignParseProc --
+ *
+ * This procedure is invoked by Tk_ConfigureWidget during
+ * option processing to handle "-align" options for embedded
+ * images.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The alignment for the embedded image may change.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+AlignParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* Not used.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window for text widget. */
+ char *value; /* Value of option. */
+ char *widgRec; /* Pointer to TkTextEmbWindow
+ * structure. */
+ int offset; /* Offset into item (ignored). */
+{
+ register TkTextEmbImage *embPtr = (TkTextEmbImage *) widgRec;
+
+ if (strcmp(value, "baseline") == 0) {
+ embPtr->align = ALIGN_BASELINE;
+ } else if (strcmp(value, "bottom") == 0) {
+ embPtr->align = ALIGN_BOTTOM;
+ } else if (strcmp(value, "center") == 0) {
+ embPtr->align = ALIGN_CENTER;
+ } else if (strcmp(value, "top") == 0) {
+ embPtr->align = ALIGN_TOP;
+ } else {
+ Tcl_AppendResult(interp, "bad alignment \"", value,
+ "\": must be baseline, bottom, center, or top",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AlignPrintProc --
+ *
+ * This procedure is invoked by the Tk configuration code
+ * to produce a printable string for the "-align" configuration
+ * option for embedded images.
+ *
+ * Results:
+ * The return value is a string describing the embedded
+ * images's current alignment.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+AlignPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Window for text widget. */
+ char *widgRec; /* Pointer to TkTextEmbImage
+ * structure. */
+ int offset; /* Ignored. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ switch (((TkTextEmbImage *) widgRec)->align) {
+ case ALIGN_BASELINE:
+ return "baseline";
+ case ALIGN_BOTTOM:
+ return "bottom";
+ case ALIGN_CENTER:
+ return "center";
+ case ALIGN_TOP:
+ return "top";
+ default:
+ return "??";
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageDeleteProc --
+ *
+ * This procedure is invoked by the text B-tree code whenever
+ * an embedded image lies in a range of characters being deleted.
+ *
+ * Results:
+ * Returns 0 to indicate that the deletion has been accepted.
+ *
+ * Side effects:
+ * The embedded image is deleted, if it exists, and any resources
+ * associated with it are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+EmbImageDeleteProc(eiPtr, linePtr, treeGone)
+ TkTextSegment *eiPtr; /* Segment being deleted. */
+ TkTextLine *linePtr; /* Line containing segment. */
+ int treeGone; /* Non-zero means the entire tree is
+ * being deleted, so everything must
+ * get cleaned up. */
+{
+ Tcl_HashEntry *hPtr;
+
+ if (eiPtr->body.ei.image != NULL) {
+ hPtr = Tcl_FindHashEntry(&eiPtr->body.ei.textPtr->imageTable,
+ eiPtr->body.ei.name);
+ if (hPtr != NULL) {
+ /*
+ * (It's possible for there to be no hash table entry for this
+ * image, if an error occurred while creating the image segment
+ * but before the image got added to the table)
+ */
+
+ Tcl_DeleteHashEntry(hPtr);
+ }
+ Tk_FreeImage(eiPtr->body.ei.image);
+ }
+ Tk_FreeOptions(configSpecs, (char *) &eiPtr->body.ei,
+ eiPtr->body.ei.textPtr->display, 0);
+ if (eiPtr->body.ei.name != NULL) {
+ ckfree(eiPtr->body.ei.name);
+ }
+ ckfree((char *) eiPtr);
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageCleanupProc --
+ *
+ * This procedure is invoked by the B-tree code whenever a
+ * segment containing an embedded image is moved from one
+ * line to another.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The linePtr field of the segment gets updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextSegment *
+EmbImageCleanupProc(eiPtr, linePtr)
+ TkTextSegment *eiPtr; /* Mark segment that's being moved. */
+ TkTextLine *linePtr; /* Line that now contains segment. */
+{
+ eiPtr->body.ei.linePtr = linePtr;
+ return eiPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageLayoutProc --
+ *
+ * This procedure is the "layoutProc" for embedded image
+ * segments.
+ *
+ * Results:
+ * 1 is returned to indicate that the segment should be
+ * displayed. The chunkPtr structure is filled in.
+ *
+ * Side effects:
+ * None, except for filling in chunkPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /*ARGSUSED*/
+static int
+EmbImageLayoutProc(textPtr, indexPtr, eiPtr, offset, maxX, maxChars,
+ noCharsYet, wrapMode, chunkPtr)
+ TkText *textPtr; /* Text widget being layed out. */
+ TkTextIndex *indexPtr; /* Identifies first character in chunk. */
+ TkTextSegment *eiPtr; /* Segment corresponding to indexPtr. */
+ int offset; /* Offset within segPtr corresponding to
+ * 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;
+
+ if (offset != 0) {
+ panic("Non-zero offset in EmbImageLayoutProc");
+ }
+
+ /*
+ * See if there's room for this image on this line.
+ */
+
+ if (eiPtr->body.ei.image == NULL) {
+ width = 0;
+ 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;
+ chunkPtr->minHeight = height;
+ }
+ chunkPtr->width = width;
+ chunkPtr->breakIndex = -1;
+ chunkPtr->breakIndex = 1;
+ chunkPtr->clientData = (ClientData) eiPtr;
+ eiPtr->body.ei.chunkCount += 1;
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageCheckProc --
+ *
+ * This procedure is invoked by the B-tree code to perform
+ * consistency checks on embedded images.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The procedure panics if it detects anything wrong with
+ * the embedded image.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbImageCheckProc(eiPtr, linePtr)
+ TkTextSegment *eiPtr; /* Segment to check. */
+ TkTextLine *linePtr; /* Line containing segment. */
+{
+ if (eiPtr->nextPtr == NULL) {
+ panic("EmbImageCheckProc: embedded image is last segment in line");
+ }
+ if (eiPtr->size != 1) {
+ panic("EmbImageCheckProc: embedded image has size %d", eiPtr->size);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageDisplayProc --
+ *
+ * This procedure is invoked by the text displaying code
+ * when it is time to actually draw an embedded image
+ * chunk on the screen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The embedded image gets moved to the correct location
+ * and drawn onto the display.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbImageDisplayProc(chunkPtr, x, y, lineHeight, baseline, display, dst, screenY)
+ TkTextDispChunk *chunkPtr; /* Chunk that is to be drawn. */
+ int x; /* X-position in dst at which to
+ * draw this chunk (differs from
+ * the x-position in the chunk because
+ * of scrolling). */
+ int y; /* Top of rectangular bounding box
+ * for line: tells where to draw this
+ * chunk in dst (x-position is in
+ * the chunk itself). */
+ int lineHeight; /* Total height of line. */
+ int baseline; /* Offset of baseline from y. */
+ Display *display; /* Display to use for drawing. */
+ Drawable dst; /* Pixmap or window in which to draw */
+ int screenY; /* Y-coordinate in text window that
+ * corresponds to y. */
+{
+ TkTextSegment *eiPtr = (TkTextSegment *) chunkPtr->clientData;
+ int lineX, imageX, imageY, width, height;
+ Tk_Image image;
+
+ image = eiPtr->body.ei.image;
+ if (image == NULL) {
+ return;
+ }
+ if ((x + chunkPtr->width) <= 0) {
+ return;
+ }
+
+ /*
+ * Compute the image's location and size in the text widget, taking
+ * into account the align value for the image.
+ */
+
+ EmbImageBboxProc(chunkPtr, 0, y, lineHeight, baseline, &lineX,
+ &imageY, &width, &height);
+ imageX = lineX - chunkPtr->x + x;
+
+ Tk_RedrawImage(image, 0, 0, width, height, dst,
+ imageX, imageY);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbImageBboxProc --
+ *
+ * This procedure is called to compute the bounding box of
+ * the area occupied by an embedded image.
+ *
+ * Results:
+ * There is no return value. *xPtr and *yPtr are filled in
+ * with the coordinates of the upper left corner of the
+ * image, and *widthPtr and *heightPtr are filled in with
+ * the dimensions of the image in pixels. Note: not all
+ * of the returned bbox is necessarily visible on the screen
+ * (the rightmost part might be off-screen to the right,
+ * and the bottommost part might be off-screen to the bottom).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbImageBboxProc(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; /* Total height of line. */
+ 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. */
+ int *widthPtr; /* Gets filled in with width of
+ * character, in pixels. */
+ int *heightPtr; /* Gets filled in with height of
+ * character, in pixels. */
+{
+ TkTextSegment *eiPtr = (TkTextSegment *) chunkPtr->clientData;
+ Tk_Image image;
+
+ image = eiPtr->body.ei.image;
+ if (image != NULL) {
+ Tk_SizeOfImage(image, widthPtr, heightPtr);
+ } else {
+ *widthPtr = 0;
+ *heightPtr = 0;
+ }
+ *xPtr = chunkPtr->x + eiPtr->body.ei.padX;
+ switch (eiPtr->body.ei.align) {
+ case ALIGN_BOTTOM:
+ *yPtr = y + (lineHeight - *heightPtr - eiPtr->body.ei.padY);
+ break;
+ case ALIGN_CENTER:
+ *yPtr = y + (lineHeight - *heightPtr)/2;
+ break;
+ case ALIGN_TOP:
+ *yPtr = y + eiPtr->body.ei.padY;
+ break;
+ case ALIGN_BASELINE:
+ *yPtr = y + (baseline - *heightPtr);
+ break;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextImageIndex --
+ *
+ * Given the name of an embedded image within a text widget,
+ * returns an index corresponding to the image's position
+ * in the text.
+ *
+ * Results:
+ * The return value is 1 if there is an embedded image by
+ * the given name in the text widget, 0 otherwise. If the
+ * image exists, *indexPtr is filled in with its index.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextImageIndex(textPtr, name, indexPtr)
+ TkText *textPtr; /* Text widget containing image. */
+ char *name; /* Name of image. */
+ TkTextIndex *indexPtr; /* Index information gets stored here. */
+{
+ Tcl_HashEntry *hPtr;
+ TkTextSegment *eiPtr;
+
+ 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 --
+ *
+ * This procedure is called by the image code whenever an
+ * image or its contents changes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The image will be redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbImageProc(clientData, x, y, width, height, imgWidth, imgHeight)
+ ClientData clientData; /* Pointer to widget record. */
+ int x, y; /* Upper left pixel (within image)
+ * that must be redisplayed. */
+ int width, height; /* Dimensions of area to redisplay
+ * (may be <= 0). */
+ int imgWidth, imgHeight; /* New dimensions of image. */
+
+{
+ 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);
+}
diff --git a/tk/generic/tkTextIndex.c b/tk/generic/tkTextIndex.c
new file mode 100644
index 00000000000..f2e9b0316ab
--- /dev/null
+++ b/tk/generic/tkTextIndex.c
@@ -0,0 +1,840 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "default.h"
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkText.h"
+
+/*
+ * Index to use to select last character in line (very large integer):
+ */
+
+#define LAST_CHAR 1000000
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+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;
+
+ /*
+ *---------------------------------------------------------------------
+ * Stage 1: check to see if the index consists of nothing but a mark
+ * name. We do this check now even though it's also done later, in
+ * order to allow mark names that include funny characters such as
+ * spaces or "+1c".
+ *---------------------------------------------------------------------
+ */
+
+ if (TkTextMarkNameToIndex(textPtr, string, indexPtr) == TCL_OK) {
+ return TCL_OK;
+ }
+
+ /*
+ *------------------------------------------------
+ * Stage 2: start again by parsing the base index.
+ *------------------------------------------------
+ */
+
+ indexPtr->tree = textPtr->tree;
+
+ /*
+ * First look for the form "tag.first" or "tag.last" where "tag"
+ * is the name of a valid tag. Try to use up as much as possible
+ * of the string in this check (strrchr instead of strchr below).
+ * Doing the check now, and in this way, allows tag names to include
+ * funny characters like "@" or "+1c".
+ */
+
+ p = strrchr(string, '.');
+ if (p != NULL) {
+ if ((p[1] == 'f') && (strncmp(p+1, "first", 5) == 0)) {
+ wantLast = 0;
+ endOfBase = p+6;
+ } else if ((p[1] == 'l') && (strncmp(p+1, "last", 4) == 0)) {
+ wantLast = 1;
+ endOfBase = p+5;
+ } else {
+ goto tryxy;
+ }
+ *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);
+ return TCL_ERROR;
+ }
+ *indexPtr = search.curIndex;
+ if (wantLast) {
+ while (TkBTreeNextTag(&search)) {
+ *indexPtr = search.curIndex;
+ }
+ }
+ goto gotBase;
+ }
+
+ tryxy:
+ if (string[0] == '@') {
+ /*
+ * Find character at a given x,y location in the window.
+ */
+
+ int x, y;
+
+ p = string+1;
+ x = strtol(p, &end, 0);
+ if ((end == p) || (*end != ',')) {
+ goto error;
+ }
+ p = end+1;
+ y = strtol(p, &end, 0);
+ if (end == p) {
+ goto error;
+ }
+ TkTextPixelIndex(textPtr, x, y, indexPtr);
+ endOfBase = end;
+ goto gotBase;
+ }
+
+ if (isdigit(UCHAR(string[0])) || (string[0] == '-')) {
+ int lineIndex, charIndex;
+
+ /*
+ * Base is identified with line and character indices.
+ */
+
+ lineIndex = strtol(string, &end, 0) - 1;
+ if ((end == string) || (*end != '.')) {
+ goto error;
+ }
+ p = end+1;
+ if ((*p == 'e') && (strncmp(p, "end", 3) == 0)) {
+ charIndex = LAST_CHAR;
+ endOfBase = p+3;
+ } 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;
+ }
+ }
+ endOfBase = p;
+ if (string[0] == '.') {
+ /*
+ * See if the base position is the name of an embedded window.
+ */
+
+ c = *endOfBase;
+ *endOfBase = 0;
+ result = TkTextWindowIndex(textPtr, string, indexPtr);
+ *endOfBase = c;
+ if (result != 0) {
+ goto gotBase;
+ }
+ }
+ 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.
+ */
+
+ c = *endOfBase;
+ *endOfBase = 0;
+ result = TkTextMarkNameToIndex(textPtr, string, indexPtr);
+ *endOfBase = c;
+ if (result == TCL_OK) {
+ goto gotBase;
+ }
+
+ /*
+ * See if the base position is the name of an embedded image
+ */
+
+ c = *endOfBase;
+ *endOfBase = 0;
+ result = TkTextImageIndex(textPtr, string, indexPtr);
+ *endOfBase = c;
+ if (result != 0) {
+ goto gotBase;
+ }
+ }
+ goto error;
+
+ /*
+ *-------------------------------------------------------------------
+ * Stage 3: process zero or more modifiers. Each modifier is either
+ * a keyword like "wordend" or "linestart", or it has the form
+ * "op count units" where op is + or -, count is a number, and units
+ * is "chars" or "lines".
+ *-------------------------------------------------------------------
+ */
+
+ gotBase:
+ p = endOfBase;
+ while (1) {
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (*p == 0) {
+ break;
+ }
+
+ if ((*p == '+') || (*p == '-')) {
+ p = ForwBack(p, indexPtr);
+ } else {
+ p = StartEnd(p, indexPtr);
+ }
+ if (p == NULL) {
+ goto error;
+ }
+ }
+ return TCL_OK;
+
+ 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
+ * modifier. */
+ TkTextIndex *indexPtr; /* Index to update as specified in string. */
+{
+ register char *p;
+ char *end, *units;
+ int count, lineIndex;
+ size_t length;
+
+ /*
+ * Get the count (how many units forward or backward).
+ */
+
+ p = string+1;
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ count = strtol(p, &end, 0);
+ if (end == p) {
+ return NULL;
+ }
+ p = end;
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+
+ /*
+ * 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 {
+ TkTextIndexBackChars(indexPtr, count, indexPtr);
+ }
+ } else if ((*units == 'l') && (strncmp(units, "lines", length) == 0)) {
+ lineIndex = TkBTreeLineIndex(indexPtr->linePtr);
+ if (*string == '+') {
+ lineIndex += count;
+ } else {
+ lineIndex -= count;
+
+ /*
+ * The check below retains the character position, even
+ * if the line runs off the start of the file. Without
+ * it, the character position will get reset to 0 by
+ * 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 --
+ *
+ * This procedure handles modifiers like "wordstart" and "lineend"
+ * to adjust indices forwards or backwards.
+ *
+ * Results:
+ * If the modifier 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 *
+StartEnd(string, indexPtr)
+ char *string; /* String to parse for additional info
+ * about modifier (count and units).
+ * Points to first character of modifer
+ * word. */
+ TkTextIndex *indexPtr; /* Index to mdoify based on string. */
+{
+ char *p;
+ int c, offset;
+ size_t length;
+ register TkTextSegment *segPtr;
+
+ /*
+ * Find the end of the modifier word.
+ */
+
+ 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);
+ }
+ } else if ((*string == 'w') && (strncmp(string, "wordstart", length) == 0)
+ && (length >= 5)) {
+ int firstChar = 1;
+
+ /*
+ * Starting with the current character, look for one that's not
+ * part of a word and keep moving backward until you find one.
+ * Then if the character found wasn't the first one, move forward
+ * again one position.
+ */
+
+ 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 < 0) {
+ if (indexPtr->charIndex < 0) {
+ indexPtr->charIndex = 0;
+ goto done;
+ }
+ segPtr = TkTextIndexToSeg(indexPtr, &offset);
+ }
+ }
+ if (!firstChar) {
+ TkTextIndexForwChars(indexPtr, 1, indexPtr);
+ }
+ } else {
+ return NULL;
+ }
+ done:
+ return p;
+}
diff --git a/tk/generic/tkTextMark.c b/tk/generic/tkTextMark.c
new file mode 100644
index 00000000000..87f6079abab
--- /dev/null
+++ b/tk/generic/tkTextMark.c
@@ -0,0 +1,775 @@
+/*
+ * 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$
+ */
+
+#include "tkInt.h"
+#include "tkText.h"
+#include "tkPort.h"
+
+/*
+ * Macro that determines the size of a mark segment:
+ */
+
+#define MSEG_SIZE ((unsigned) (Tk_Offset(TkTextSegment, body) \
+ + sizeof(TkTextMark)))
+
+/*
+ * Forward references for procedures defined in this file:
+ */
+
+static void InsertUndisplayProc _ANSI_ARGS_((TkText *textPtr,
+ TkTextDispChunk *chunkPtr));
+static int MarkDeleteProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr, int treeGone));
+static TkTextSegment * MarkCleanupProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static void MarkCheckProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static int MarkLayoutProc _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr, TkTextSegment *segPtr,
+ int offset, int maxX, int maxChars,
+ int noCharsYet, Tk_Uid wrapMode,
+ TkTextDispChunk *chunkPtr));
+static int MarkFindNext _ANSI_ARGS_((Tcl_Interp *interp,
+ TkText *textPtr, char *markName));
+static int MarkFindPrev _ANSI_ARGS_((Tcl_Interp *interp,
+ TkText *textPtr, char *markName));
+
+
+/*
+ * The following structures declare the "mark" segment types.
+ * There are actually two types for marks, one with left gravity
+ * and one with right gravity. They are identical except for
+ * their gravity property.
+ */
+
+Tk_SegType tkTextRightMarkType = {
+ "mark", /* name */
+ 0, /* leftGravity */
+ (Tk_SegSplitProc *) NULL, /* splitProc */
+ MarkDeleteProc, /* deleteProc */
+ MarkCleanupProc, /* cleanupProc */
+ (Tk_SegLineChangeProc *) NULL, /* lineChangeProc */
+ MarkLayoutProc, /* layoutProc */
+ MarkCheckProc /* checkProc */
+};
+
+Tk_SegType tkTextLeftMarkType = {
+ "mark", /* name */
+ 1, /* leftGravity */
+ (Tk_SegSplitProc *) NULL, /* splitProc */
+ MarkDeleteProc, /* deleteProc */
+ MarkCleanupProc, /* cleanupProc */
+ (Tk_SegLineChangeProc *) NULL, /* lineChangeProc */
+ MarkLayoutProc, /* layoutProc */
+ MarkCheckProc /* checkProc */
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextMarkCmd --
+ *
+ * This procedure is invoked to process the "mark" options of
+ * the widget command for text widgets. See the user documentation
+ * for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextMarkCmd(textPtr, interp, argc, argv)
+ register TkText *textPtr; /* Information about text widget. */
+ 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 "mark". */
+{
+ int c, i;
+ size_t length;
+ Tcl_HashEntry *hPtr;
+ TkTextSegment *markPtr;
+ Tcl_HashSearch search;
+ TkTextIndex index;
+ Tk_SegType *newTypePtr;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " mark option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[2][0];
+ length = strlen(argv[2]);
+ if ((c == 'g') && (strncmp(argv[2], "gravity", length) == 0)) {
+ if (argc < 4 || argc > 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " mark gravity markName ?gravity?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ hPtr = Tcl_FindHashEntry(&textPtr->markTable, argv[3]);
+ if (hPtr == NULL) {
+ 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;
+ } else if ((c == 'r') && (strncmp(argv[4], "right", length) == 0)) {
+ newTypePtr = &tkTextRightMarkType;
+ } else {
+ Tcl_AppendResult(interp, "bad mark gravity \"",
+ argv[4], "\": must be left or right", (char *) NULL);
+ return TCL_ERROR;
+ }
+ TkTextMarkSegToIndex(textPtr, markPtr, &index);
+ TkBTreeUnlinkSegment(textPtr->tree, markPtr,
+ markPtr->body.mark.linePtr);
+ markPtr->typePtr = newTypePtr;
+ TkBTreeLinkSegment(markPtr, &index);
+ } else if ((c == 'n') && (strncmp(argv[2], "names", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " mark names\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->markTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendElement(interp,
+ Tcl_GetHashKey(&textPtr->markTable, hPtr));
+ }
+ } else if ((c == 'n') && (strncmp(argv[2], "next", length) == 0)) {
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " mark next index\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return MarkFindNext(interp, textPtr, argv[3]);
+ } else if ((c == 'p') && (strncmp(argv[2], "previous", length) == 0)) {
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " mark previous index\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return MarkFindPrev(interp, textPtr, argv[3]);
+ } else if ((c == 's') && (strncmp(argv[2], "set", length) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " mark set markName index\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[4], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ TkTextSetMark(textPtr, argv[3], &index);
+ } else if ((c == 'u') && (strncmp(argv[2], "unset", length) == 0)) {
+ for (i = 3; i < argc; i++) {
+ hPtr = Tcl_FindHashEntry(&textPtr->markTable, argv[i]);
+ if (hPtr != NULL) {
+ markPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
+ if ((markPtr == textPtr->insertMarkPtr)
+ || (markPtr == textPtr->currentMarkPtr)) {
+ continue;
+ }
+ TkBTreeUnlinkSegment(textPtr->tree, markPtr,
+ markPtr->body.mark.linePtr);
+ Tcl_DeleteHashEntry(hPtr);
+ ckfree((char *) markPtr);
+ }
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad mark option \"", argv[2],
+ "\": must be gravity, names, next, previous, set, or unset",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextSetMark --
+ *
+ * Set a mark to a particular position, creating a new mark if
+ * one doesn't already exist.
+ *
+ * Results:
+ * The return value is a pointer to the mark that was just set.
+ *
+ * Side effects:
+ * A new mark is created, or an existing mark is moved.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextSegment *
+TkTextSetMark(textPtr, name, indexPtr)
+ TkText *textPtr; /* Text widget in which to create mark. */
+ char *name; /* Name of mark to set. */
+ TkTextIndex *indexPtr; /* Where to set mark. */
+{
+ Tcl_HashEntry *hPtr;
+ TkTextSegment *markPtr;
+ TkTextIndex insertIndex;
+ int new;
+
+ hPtr = Tcl_CreateHashEntry(&textPtr->markTable, name, &new);
+ markPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
+ if (!new) {
+ /*
+ * If this is the insertion point that's being moved, be sure
+ * to force a display update at the old position. Also, don't
+ * let the insertion cursor be after the final newline of the
+ * file.
+ */
+
+ if (markPtr == textPtr->insertMarkPtr) {
+ TkTextIndex index, index2;
+ TkTextMarkSegToIndex(textPtr, textPtr->insertMarkPtr, &index);
+ TkTextIndexForwChars(&index, 1, &index2);
+ TkTextChanged(textPtr, &index, &index2);
+ if (TkBTreeLineIndex(indexPtr->linePtr)
+ == TkBTreeNumLines(textPtr->tree)) {
+ TkTextIndexBackChars(indexPtr, 1, &insertIndex);
+ indexPtr = &insertIndex;
+ }
+ }
+ TkBTreeUnlinkSegment(textPtr->tree, markPtr,
+ markPtr->body.mark.linePtr);
+ } else {
+ markPtr = (TkTextSegment *) ckalloc(MSEG_SIZE);
+ markPtr->typePtr = &tkTextRightMarkType;
+ markPtr->size = 0;
+ markPtr->body.mark.textPtr = textPtr;
+ markPtr->body.mark.linePtr = indexPtr->linePtr;
+ markPtr->body.mark.hPtr = hPtr;
+ Tcl_SetHashValue(hPtr, markPtr);
+ }
+ TkBTreeLinkSegment(markPtr, indexPtr);
+
+ /*
+ * If the mark is the insertion cursor, then update the screen at the
+ * mark's new location.
+ */
+
+ if (markPtr == textPtr->insertMarkPtr) {
+ TkTextIndex index2;
+
+ TkTextIndexForwChars(indexPtr, 1, &index2);
+ TkTextChanged(textPtr, indexPtr, &index2);
+ }
+ return markPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextMarkSegToIndex --
+ *
+ * Given a segment that is a mark, create an index that
+ * refers to the next text character (or other text segment
+ * with non-zero size) after the mark.
+ *
+ * Results:
+ * *IndexPtr is filled in with index information.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkTextMarkSegToIndex(textPtr, markPtr, indexPtr)
+ TkText *textPtr; /* Text widget containing mark. */
+ 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 --
+ *
+ * Given the name of a mark, return an index corresponding
+ * to the mark name.
+ *
+ * Results:
+ * The return value is TCL_OK if "name" exists as a mark in
+ * the text widget. In this case *indexPtr is filled in with
+ * the next segment whose after the mark whose size is
+ * non-zero. TCL_ERROR is returned if the mark doesn't exist
+ * in the text widget.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextMarkNameToIndex(textPtr, name, indexPtr)
+ TkText *textPtr; /* Text widget containing mark. */
+ char *name; /* Name of mark. */
+ TkTextIndex *indexPtr; /* Index information gets stored here. */
+{
+ Tcl_HashEntry *hPtr;
+
+ hPtr = Tcl_FindHashEntry(&textPtr->markTable, name);
+ if (hPtr == NULL) {
+ return TCL_ERROR;
+ }
+ TkTextMarkSegToIndex(textPtr, (TkTextSegment *) Tcl_GetHashValue(hPtr),
+ indexPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MarkDeleteProc --
+ *
+ * This procedure is invoked by the text B-tree code whenever
+ * a mark lies in a range of characters being deleted.
+ *
+ * Results:
+ * Returns 1 to indicate that deletion has been rejected.
+ *
+ * Side effects:
+ * None (even if the whole tree is being deleted we don't
+ * free up the mark; it will be done elsewhere).
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+MarkDeleteProc(segPtr, linePtr, treeGone)
+ TkTextSegment *segPtr; /* Segment being deleted. */
+ TkTextLine *linePtr; /* Line containing segment. */
+ int treeGone; /* Non-zero means the entire tree is
+ * being deleted, so everything must
+ * get cleaned up. */
+{
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MarkCleanupProc --
+ *
+ * This procedure is invoked by the B-tree code whenever a
+ * mark segment is moved from one line to another.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The linePtr field of the segment gets updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextSegment *
+MarkCleanupProc(markPtr, linePtr)
+ TkTextSegment *markPtr; /* Mark segment that's being moved. */
+ TkTextLine *linePtr; /* Line that now contains segment. */
+{
+ markPtr->body.mark.linePtr = linePtr;
+ return markPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MarkLayoutProc --
+ *
+ * This procedure is the "layoutProc" for mark segments.
+ *
+ * Results:
+ * If the mark isn't the insertion cursor then the return
+ * value is -1 to indicate that this segment shouldn't be
+ * displayed. If the mark is the insertion character then
+ * 1 is returned and the chunkPtr structure is filled in.
+ *
+ * Side effects:
+ * None, except for filling in chunkPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /*ARGSUSED*/
+static int
+MarkLayoutProc(textPtr, indexPtr, segPtr, offset, maxX, maxChars,
+ noCharsYet, wrapMode, chunkPtr)
+ TkText *textPtr; /* Text widget being layed out. */
+ TkTextIndex *indexPtr; /* Identifies first character in chunk. */
+ TkTextSegment *segPtr; /* Segment corresponding to indexPtr. */
+ int offset; /* Offset within segPtr corresponding to
+ * 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; /* Not used. */
+ register TkTextDispChunk *chunkPtr;
+ /* Structure to fill in with information
+ * about this chunk. The x field has already
+ * been set by the caller. */
+{
+ if (segPtr != textPtr->insertMarkPtr) {
+ 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
+ * prevents the insertion cursor from being stranded at the end
+ * of a line.
+ */
+
+ chunkPtr->breakIndex = -1;
+ chunkPtr->clientData = (ClientData) textPtr;
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextInsertDisplayProc --
+ *
+ * This procedure is called to display the insertion
+ * cursor.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Graphics are drawn.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+TkTextInsertDisplayProc(chunkPtr, x, y, height, baseline, display, dst, screenY)
+ TkTextDispChunk *chunkPtr; /* Chunk that is to be drawn. */
+ int x; /* X-position in dst at which to
+ * draw this chunk (may differ from
+ * the x-position in the chunk because
+ * of scrolling). */
+ int y; /* Y-position at which to draw this
+ * chunk in dst (x-position is in
+ * the chunk itself). */
+ int height; /* Total height of line. */
+ int baseline; /* Offset of baseline from y. */
+ Display *display; /* Display to use for drawing. */
+ Drawable dst; /* Pixmap or window in which to draw
+ * chunk. */
+ int screenY; /* Y-coordinate in text window that
+ * corresponds to y. */
+{
+ TkText *textPtr = (TkText *) chunkPtr->clientData;
+ int halfWidth = textPtr->insertWidth/2;
+
+ if ((x + halfWidth) < 0) {
+ /*
+ * The insertion cursor is off-screen. Just return.
+ */
+
+ return;
+ }
+
+ /*
+ * As a special hack to keep the cursor visible on mono displays
+ * (or anywhere else that the selection and insertion cursors
+ * have the same color) write the default background in the cursor
+ * area (instead of nothing) when the cursor isn't on. Otherwise
+ * the selection might hide the cursor.
+ */
+
+ if (textPtr->flags & INSERT_ON) {
+ Tk_Fill3DRectangle(textPtr->tkwin, dst, textPtr->insertBorder,
+ x - textPtr->insertWidth/2, y, textPtr->insertWidth,
+ height, textPtr->insertBorderWidth, TK_RELIEF_RAISED);
+ } else if (textPtr->selBorder == textPtr->insertBorder) {
+ Tk_Fill3DRectangle(textPtr->tkwin, dst, textPtr->border,
+ x - textPtr->insertWidth/2, y, textPtr->insertWidth,
+ height, 0, TK_RELIEF_FLAT);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * InsertUndisplayProc --
+ *
+ * This procedure is called when the insertion cursor is no
+ * longer at a visible point on the display. It does nothing
+ * right now.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+InsertUndisplayProc(textPtr, chunkPtr)
+ TkText *textPtr; /* Overall information about text
+ * widget. */
+ TkTextDispChunk *chunkPtr; /* Chunk that is about to be freed. */
+{
+ return;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MarkCheckProc --
+ *
+ * This procedure is invoked by the B-tree code to perform
+ * consistency checks on mark segments.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The procedure panics if it detects anything wrong with
+ * the mark.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+MarkCheckProc(markPtr, linePtr)
+ TkTextSegment *markPtr; /* Segment to check. */
+ TkTextLine *linePtr; /* Line containing segment. */
+{
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+
+ if (markPtr->body.mark.linePtr != linePtr) {
+ panic("MarkCheckProc: markPtr->body.mark.linePtr bogus");
+ }
+
+ /*
+ * Make sure that the mark is still present in the text's mark
+ * hash table.
+ */
+
+ for (hPtr = Tcl_FirstHashEntry(&markPtr->body.mark.textPtr->markTable,
+ &search); hPtr != markPtr->body.mark.hPtr;
+ hPtr = Tcl_NextHashEntry(&search)) {
+ if (hPtr == NULL) {
+ panic("MarkCheckProc couldn't find hash table entry for mark");
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MarkFindNext --
+ *
+ * This procedure searches forward for the next mark.
+ *
+ * Results:
+ * A standard Tcl result, which is a mark name or an empty string.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MarkFindNext(interp, textPtr, string)
+ Tcl_Interp *interp; /* For error reporting */
+ TkText *textPtr; /* The widget */
+ char *string; /* The starting index or mark name */
+{
+ TkTextIndex index;
+ Tcl_HashEntry *hPtr;
+ register TkTextSegment *segPtr;
+ int offset;
+
+
+ hPtr = Tcl_FindHashEntry(&textPtr->markTable, string);
+ if (hPtr != NULL) {
+ /*
+ * If given a mark name, return the next mark in the list of
+ * segments, even if it happens to be at the same character position.
+ */
+ segPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
+ TkTextMarkSegToIndex(textPtr, segPtr, &index);
+ segPtr = segPtr->nextPtr;
+ } else {
+ /*
+ * 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,
+ * or NULL if we ran off the end of the line.
+ */
+ for ( ; segPtr != NULL ; segPtr = segPtr->nextPtr) {
+ if (segPtr->typePtr == &tkTextRightMarkType ||
+ segPtr->typePtr == &tkTextLeftMarkType) {
+ Tcl_SetResult(interp,
+ Tcl_GetHashKey(&textPtr->markTable, segPtr->body.mark.hPtr),
+ TCL_STATIC);
+ return TCL_OK;
+ }
+ }
+ index.linePtr = TkBTreeNextLine(index.linePtr);
+ if (index.linePtr == (TkTextLine *) NULL) {
+ return TCL_OK;
+ }
+ index.charIndex = 0;
+ segPtr = index.linePtr->segPtr;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MarkFindPrev --
+ *
+ * This procedure searches backwards for the previous mark.
+ *
+ * Results:
+ * A standard Tcl result, which is a mark name or an empty string.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MarkFindPrev(interp, textPtr, string)
+ Tcl_Interp *interp; /* For error reporting */
+ TkText *textPtr; /* The widget */
+ char *string; /* The starting index or mark name */
+{
+ TkTextIndex index;
+ Tcl_HashEntry *hPtr;
+ register TkTextSegment *segPtr, *seg2Ptr, *prevPtr;
+ int offset;
+
+
+ hPtr = Tcl_FindHashEntry(&textPtr->markTable, string);
+ if (hPtr != NULL) {
+ /*
+ * If given a mark name, return the previous mark in the list of
+ * segments, even if it happens to be at the same character position.
+ */
+ segPtr = (TkTextSegment *) Tcl_GetHashValue(hPtr);
+ TkTextMarkSegToIndex(textPtr, segPtr, &index);
+ } else {
+ /*
+ * 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,
+ * or at the begining of the line.
+ */
+ for (prevPtr = NULL, seg2Ptr = index.linePtr->segPtr;
+ seg2Ptr != NULL && seg2Ptr != segPtr;
+ seg2Ptr = seg2Ptr->nextPtr) {
+ if (seg2Ptr->typePtr == &tkTextRightMarkType ||
+ seg2Ptr->typePtr == &tkTextLeftMarkType) {
+ prevPtr = seg2Ptr;
+ }
+ }
+ if (prevPtr != NULL) {
+ Tcl_SetResult(interp,
+ Tcl_GetHashKey(&textPtr->markTable, prevPtr->body.mark.hPtr),
+ TCL_STATIC);
+ return TCL_OK;
+ }
+ index.linePtr = TkBTreePreviousLine(index.linePtr);
+ if (index.linePtr == (TkTextLine *) NULL) {
+ return TCL_OK;
+ }
+ segPtr = NULL;
+ }
+}
diff --git a/tk/generic/tkTextTag.c b/tk/generic/tkTextTag.c
new file mode 100644
index 00000000000..e3ae2451683
--- /dev/null
+++ b/tk/generic/tkTextTag.c
@@ -0,0 +1,1376 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "default.h"
+#include "tkPort.h"
+#include "tk.h"
+#include "tkText.h"
+
+/*
+ * Information used for parsing tag configuration information:
+ */
+
+static Tk_ConfigSpec tagConfigSpecs[] = {
+ {TK_CONFIG_BORDER, "-background", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, border), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-bgstipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, bgStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-borderwidth", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(TkTextTag, bdString),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_BITMAP, "-fgstipple", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, fgStipple), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_FONT, "-font", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, tkfont), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_COLOR, "-foreground", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, fgColor), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-justify", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, justifyString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-lmargin1", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, lMargin1String), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-lmargin2", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, lMargin2String), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-offset", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, offsetString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-overstrike", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, overstrikeString),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-relief", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, reliefString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-rmargin", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, rMarginString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-spacing1", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, spacing1String), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-spacing2", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, spacing2String), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-spacing3", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, spacing3String), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-tabs", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, tabString), TK_CONFIG_NULL_OK},
+ {TK_CONFIG_STRING, "-underline", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, underlineString),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_UID, "-wrap", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextTag, wrapMode),
+ TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void ChangeTagPriority _ANSI_ARGS_((TkText *textPtr,
+ TkTextTag *tagPtr, int prio));
+static TkTextTag * FindTag _ANSI_ARGS_((Tcl_Interp *interp,
+ TkText *textPtr, char *tagName));
+static void SortTags _ANSI_ARGS_((int numTags,
+ TkTextTag **tagArrayPtr));
+static int TagSortProc _ANSI_ARGS_((CONST VOID *first,
+ CONST VOID *second));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextTagCmd --
+ *
+ * This procedure is invoked to process the "tag" options of
+ * the widget command for text widgets. See the user documentation
+ * for details on what it does.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextTagCmd(textPtr, interp, argc, argv)
+ register TkText *textPtr; /* Information about text widget. */
+ 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 "tag". */
+{
+ int c, i, addTag;
+ size_t length;
+ char *fullOption;
+ register TkTextTag *tagPtr;
+ TkTextIndex first, last, index1, index2;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ c = argv[2][0];
+ length = strlen(argv[2]);
+ if ((c == 'a') && (strncmp(argv[2], "add", length) == 0)) {
+ fullOption = "add";
+ addTag = 1;
+
+ addAndRemove:
+ if (argc < 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag ", fullOption,
+ " tagName index1 ?index2 index1 index2 ...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ tagPtr = TkTextCreateTag(textPtr, argv[3]);
+ for (i = 4; i < argc; i += 2) {
+ if (TkTextGetIndex(interp, textPtr, argv[i], &index1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (argc > (i+1)) {
+ if (TkTextGetIndex(interp, textPtr, argv[i+1], &index2)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (TkTextIndexCmp(&index1, &index2) >= 0) {
+ return TCL_OK;
+ }
+ } else {
+ index2 = index1;
+ TkTextIndexForwChars(&index2, 1, &index2);
+ }
+
+ if (tagPtr->affectsDisplay) {
+ TkTextRedrawTag(textPtr, &index1, &index2, tagPtr, !addTag);
+ } else {
+ /*
+ * Still need to trigger enter/leave events on tags that
+ * have changed.
+ */
+
+ TkTextEventuallyRepick(textPtr);
+ }
+ TkBTreeTag(&index1, &index2, tagPtr, addTag);
+
+ /*
+ * If the tag is "sel" then grab the selection if we're supposed
+ * to export it and don't already have it. Also, invalidate
+ * partially-completed selection retrievals.
+ */
+
+ if (tagPtr == textPtr->selTagPtr) {
+ if (addTag && textPtr->exportSelection
+ && !(textPtr->flags & GOT_SELECTION)) {
+ Tk_OwnSelection(textPtr->tkwin, XA_PRIMARY,
+ TkTextLostSelection, (ClientData) textPtr);
+ textPtr->flags |= GOT_SELECTION;
+ }
+ textPtr->abortSelections = 1;
+ }
+ }
+ } else if ((c == 'b') && (strncmp(argv[2], "bind", length) == 0)) {
+ if ((argc < 4) || (argc > 6)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag bind tagName ?sequence? ?command?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ tagPtr = TkTextCreateTag(textPtr, argv[3]);
+
+ /*
+ * Make a binding table if the widget doesn't already have
+ * one.
+ */
+
+ if (textPtr->bindingTable == NULL) {
+ textPtr->bindingTable = Tk_CreateBindingTable(interp);
+ }
+
+ if (argc == 6) {
+ int append = 0;
+ unsigned long mask;
+
+ if (argv[5][0] == 0) {
+ return Tk_DeleteBinding(interp, textPtr->bindingTable,
+ (ClientData) tagPtr, argv[4]);
+ }
+ if (argv[5][0] == '+') {
+ argv[5]++;
+ append = 1;
+ }
+ mask = Tk_CreateBinding(interp, textPtr->bindingTable,
+ (ClientData) tagPtr, argv[4], argv[5], append);
+ if (mask == 0) {
+ return TCL_ERROR;
+ }
+ if (mask & (unsigned) ~(ButtonMotionMask|Button1MotionMask
+ |Button2MotionMask|Button3MotionMask|Button4MotionMask
+ |Button5MotionMask|ButtonPressMask|ButtonReleaseMask
+ |EnterWindowMask|LeaveWindowMask|KeyPressMask
+ |KeyReleaseMask|PointerMotionMask|VirtualEventMask)) {
+ Tk_DeleteBinding(interp, textPtr->bindingTable,
+ (ClientData) tagPtr, argv[4]);
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "requested illegal events; ",
+ "only key, button, motion, enter, leave, and virtual ",
+ "events may be used", (char *) NULL);
+ return TCL_ERROR;
+ }
+ } 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) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag cget tagName option\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ tagPtr = FindTag(interp, textPtr, argv[3]);
+ if (tagPtr == NULL) {
+ return TCL_ERROR;
+ }
+ return Tk_ConfigureValue(interp, textPtr->tkwin, tagConfigSpecs,
+ (char *) tagPtr, argv[4], 0);
+ } else if ((c == 'c') && (strncmp(argv[2], "configure", length) == 0)
+ && (length >= 2)) {
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag configure tagName ?option? ?value? ",
+ "?option value ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ tagPtr = TkTextCreateTag(textPtr, argv[3]);
+ if (argc == 4) {
+ return Tk_ConfigureInfo(interp, textPtr->tkwin, tagConfigSpecs,
+ (char *) tagPtr, (char *) NULL, 0);
+ } else if (argc == 5) {
+ return Tk_ConfigureInfo(interp, textPtr->tkwin, tagConfigSpecs,
+ (char *) tagPtr, argv[4], 0);
+ } else {
+ int result;
+
+ result = Tk_ConfigureWidget(interp, textPtr->tkwin, tagConfigSpecs,
+ argc-4, argv+4, (char *) tagPtr, 0);
+ /*
+ * Some of the configuration options, like -underline
+ * and -justify, require additional translation (this is
+ * needed because we need to distinguish a particular value
+ * of an option from "unspecified").
+ */
+
+ if (tagPtr->bdString != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin, tagPtr->bdString,
+ &tagPtr->borderWidth) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (tagPtr->borderWidth < 0) {
+ tagPtr->borderWidth = 0;
+ }
+ }
+ if (tagPtr->reliefString != NULL) {
+ if (Tk_GetRelief(interp, tagPtr->reliefString,
+ &tagPtr->relief) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->justifyString != NULL) {
+ if (Tk_GetJustify(interp, tagPtr->justifyString,
+ &tagPtr->justify) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->lMargin1String != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin,
+ tagPtr->lMargin1String, &tagPtr->lMargin1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->lMargin2String != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin,
+ tagPtr->lMargin2String, &tagPtr->lMargin2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->offsetString != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin, tagPtr->offsetString,
+ &tagPtr->offset) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->overstrikeString != NULL) {
+ if (Tcl_GetBoolean(interp, tagPtr->overstrikeString,
+ &tagPtr->overstrike) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->rMarginString != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin,
+ tagPtr->rMarginString, &tagPtr->rMargin) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ }
+ if (tagPtr->spacing1String != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin,
+ tagPtr->spacing1String, &tagPtr->spacing1) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (tagPtr->spacing1 < 0) {
+ tagPtr->spacing1 = 0;
+ }
+ }
+ if (tagPtr->spacing2String != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin,
+ tagPtr->spacing2String, &tagPtr->spacing2) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (tagPtr->spacing2 < 0) {
+ tagPtr->spacing2 = 0;
+ }
+ }
+ if (tagPtr->spacing3String != NULL) {
+ if (Tk_GetPixels(interp, textPtr->tkwin,
+ tagPtr->spacing3String, &tagPtr->spacing3) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (tagPtr->spacing3 < 0) {
+ tagPtr->spacing3 = 0;
+ }
+ }
+ if (tagPtr->tabArrayPtr != NULL) {
+ ckfree((char *) tagPtr->tabArrayPtr);
+ tagPtr->tabArrayPtr = NULL;
+ }
+ if (tagPtr->tabString != NULL) {
+ tagPtr->tabArrayPtr = TkTextGetTabs(interp, textPtr->tkwin,
+ tagPtr->tabString);
+ if (tagPtr->tabArrayPtr == NULL) {
+ return TCL_ERROR;
+ }
+ }
+ 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;
+ }
+
+ /*
+ * If the "sel" tag was changed, be sure to mirror information
+ * from the tag back into the text widget record. NOTE: we
+ * don't have to free up information in the widget record
+ * before overwriting it, because it was mirrored in the tag
+ * and hence freed when the tag field was overwritten.
+ */
+
+ if (tagPtr == textPtr->selTagPtr) {
+ textPtr->selBorder = tagPtr->border;
+ textPtr->selBdString = tagPtr->bdString;
+ textPtr->selFgColorPtr = tagPtr->fgColor;
+ }
+ tagPtr->affectsDisplay = 0;
+ if ((tagPtr->border != NULL)
+ || (tagPtr->bdString != NULL)
+ || (tagPtr->reliefString != NULL)
+ || (tagPtr->bgStipple != None)
+ || (tagPtr->fgColor != NULL) || (tagPtr->tkfont != None)
+ || (tagPtr->fgStipple != None)
+ || (tagPtr->justifyString != NULL)
+ || (tagPtr->lMargin1String != NULL)
+ || (tagPtr->lMargin2String != NULL)
+ || (tagPtr->offsetString != NULL)
+ || (tagPtr->overstrikeString != NULL)
+ || (tagPtr->rMarginString != NULL)
+ || (tagPtr->spacing1String != NULL)
+ || (tagPtr->spacing2String != NULL)
+ || (tagPtr->spacing3String != NULL)
+ || (tagPtr->tabString != NULL)
+ || (tagPtr->underlineString != NULL)
+ || (tagPtr->wrapMode != NULL)) {
+ tagPtr->affectsDisplay = 1;
+ }
+ TkTextRedrawTag(textPtr, (TkTextIndex *) NULL,
+ (TkTextIndex *) NULL, tagPtr, 1);
+ return result;
+ }
+ } else if ((c == 'd') && (strncmp(argv[2], "delete", length) == 0)) {
+ Tcl_HashEntry *hPtr;
+
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag delete tagName tagName ...\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (i = 3; i < argc; i++) {
+ hPtr = Tcl_FindHashEntry(&textPtr->tagTable, argv[i]);
+ if (hPtr == NULL) {
+ continue;
+ }
+ tagPtr = (TkTextTag *) Tcl_GetHashValue(hPtr);
+ 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);
+ }
+
+ /*
+ * Update the tag priorities to reflect the deletion of this tag.
+ */
+
+ ChangeTagPriority(textPtr, tagPtr, textPtr->numTags-1);
+ textPtr->numTags -= 1;
+ TkTextFreeTag(textPtr, tagPtr);
+ }
+ } else if ((c == 'l') && (strncmp(argv[2], "lower", length) == 0)) {
+ TkTextTag *tagPtr2;
+ int prio;
+
+ if ((argc != 4) && (argc != 5)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag lower tagName ?belowThis?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ tagPtr = FindTag(interp, textPtr, argv[3]);
+ if (tagPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (argc == 5) {
+ tagPtr2 = FindTag(interp, textPtr, argv[4]);
+ if (tagPtr2 == NULL) {
+ return TCL_ERROR;
+ }
+ if (tagPtr->priority < tagPtr2->priority) {
+ prio = tagPtr2->priority - 1;
+ } else {
+ prio = tagPtr2->priority;
+ }
+ } else {
+ prio = 0;
+ }
+ ChangeTagPriority(textPtr, tagPtr, prio);
+ TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, (TkTextIndex *) NULL,
+ tagPtr, 1);
+ } else if ((c == 'n') && (strncmp(argv[2], "names", length) == 0)
+ && (length >= 2)) {
+ TkTextTag **arrayPtr;
+ int arraySize;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag names ?index?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 3) {
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+
+ arrayPtr = (TkTextTag **) ckalloc((unsigned)
+ (textPtr->numTags * sizeof(TkTextTag *)));
+ for (i = 0, hPtr = Tcl_FirstHashEntry(&textPtr->tagTable, &search);
+ hPtr != NULL; i++, hPtr = Tcl_NextHashEntry(&search)) {
+ arrayPtr[i] = (TkTextTag *) Tcl_GetHashValue(hPtr);
+ }
+ arraySize = textPtr->numTags;
+ } else {
+ if (TkTextGetIndex(interp, textPtr, argv[3], &index1)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ arrayPtr = TkBTreeGetTags(&index1, &arraySize);
+ if (arrayPtr == NULL) {
+ return TCL_OK;
+ }
+ }
+ SortTags(arraySize, arrayPtr);
+ for (i = 0; i < arraySize; i++) {
+ tagPtr = arrayPtr[i];
+ Tcl_AppendElement(interp, tagPtr->name);
+ }
+ ckfree((char *) arrayPtr);
+ } else if ((c == 'n') && (strncmp(argv[2], "nextrange", length) == 0)
+ && (length >= 2)) {
+ TkTextSearch tSearch;
+ char position[TK_POS_CHARS];
+
+ if ((argc != 5) && (argc != 6)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag nextrange tagName index1 ?index2?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ 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;
+ }
+
+ /*
+ * The search below is a bit tricky. Rather than use the B-tree
+ * facilities to stop the search at index2, let it search up
+ * until the end of the file but check for a position past index2
+ * ourselves. The reason for doing it this way is that we only
+ * care whether the *start* of the range is before index2; once
+ * we find the start, we don't want TkBTreeNextTag to abort the
+ * search because the end of the range is after index2.
+ */
+
+ TkBTreeStartSearch(&index1, &last, tagPtr, &tSearch);
+ if (TkBTreeCharTagged(&index1, tagPtr)) {
+ TkTextSegment *segPtr;
+ int offset;
+
+ /*
+ * 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;
+ }
+ }
+ if (!TkBTreeNextTag(&tSearch)) {
+ return TCL_OK;
+ }
+ }
+
+ /*
+ * Find the start of the tagged range.
+ */
+
+ if (!TkBTreeNextTag(&tSearch)) {
+ return TCL_OK;
+ }
+ gotStart:
+ if (TkTextIndexCmp(&tSearch.curIndex, &index2) >= 0) {
+ return TCL_OK;
+ }
+ TkTextPrintIndex(&tSearch.curIndex, position);
+ Tcl_AppendElement(interp, position);
+ TkBTreeNextTag(&tSearch);
+ TkTextPrintIndex(&tSearch.curIndex, position);
+ Tcl_AppendElement(interp, position);
+ } else if ((c == 'p') && (strncmp(argv[2], "prevrange", length) == 0)
+ && (length >= 2)) {
+ TkTextSearch tSearch;
+ char position1[TK_POS_CHARS];
+ char position2[TK_POS_CHARS];
+
+ if ((argc != 5) && (argc != 6)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag prevrange tagName index1 ?index2?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ 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;
+ }
+ 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);
+ if (TkTextIndexCmp(&tSearch.curIndex, &index2) < 0) {
+ return TCL_OK;
+ }
+ TkTextPrintIndex(&tSearch.curIndex, position1);
+ }
+ Tcl_AppendElement(interp, position1);
+ Tcl_AppendElement(interp, position2);
+ } else if ((c == 'r') && (strncmp(argv[2], "raise", length) == 0)
+ && (length >= 3)) {
+ TkTextTag *tagPtr2;
+ int prio;
+
+ if ((argc != 4) && (argc != 5)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " tag raise tagName ?aboveThis?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ tagPtr = FindTag(interp, textPtr, argv[3]);
+ if (tagPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (argc == 5) {
+ tagPtr2 = FindTag(interp, textPtr, argv[4]);
+ if (tagPtr2 == NULL) {
+ return TCL_ERROR;
+ }
+ if (tagPtr->priority <= tagPtr2->priority) {
+ prio = tagPtr2->priority;
+ } else {
+ prio = tagPtr2->priority + 1;
+ }
+ } else {
+ prio = textPtr->numTags-1;
+ }
+ ChangeTagPriority(textPtr, tagPtr, prio);
+ TkTextRedrawTag(textPtr, (TkTextIndex *) NULL, (TkTextIndex *) NULL,
+ tagPtr, 1);
+ } else if ((c == 'r') && (strncmp(argv[2], "ranges", length) == 0)
+ && (length >= 3)) {
+ TkTextSearch tSearch;
+ char position[TK_POS_CHARS];
+
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ 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)) {
+ TkTextPrintIndex(&tSearch.curIndex, position);
+ Tcl_AppendElement(interp, position);
+ }
+ } else if ((c == 'r') && (strncmp(argv[2], "remove", length) == 0)
+ && (length >= 2)) {
+ fullOption = "remove";
+ addTag = 0;
+ goto addAndRemove;
+ } else {
+ Tcl_AppendResult(interp, "bad tag option \"", argv[2],
+ "\": must be add, bind, cget, configure, delete, lower, ",
+ "names, nextrange, raise, ranges, or remove",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextCreateTag --
+ *
+ * Find the record describing a tag within a given text widget,
+ * creating a new record if one doesn't already exist.
+ *
+ * Results:
+ * The return value is a pointer to the TkTextTag record for tagName.
+ *
+ * Side effects:
+ * A new tag record is created if there isn't one already defined
+ * for tagName.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkTextTag *
+TkTextCreateTag(textPtr, tagName)
+ TkText *textPtr; /* Widget in which tag is being used. */
+ char *tagName; /* Name of desired tag. */
+{
+ register TkTextTag *tagPtr;
+ Tcl_HashEntry *hPtr;
+ int new;
+
+ hPtr = Tcl_CreateHashEntry(&textPtr->tagTable, tagName, &new);
+ if (!new) {
+ return (TkTextTag *) Tcl_GetHashValue(hPtr);
+ }
+
+ /*
+ * No existing entry. Create a new one, initialize it, and add a
+ * pointer to it to the hash table entry.
+ */
+
+ tagPtr = (TkTextTag *) ckalloc(sizeof(TkTextTag));
+ tagPtr->name = Tcl_GetHashKey(&textPtr->tagTable, hPtr);
+ tagPtr->toggleCount = 0;
+ tagPtr->tagRootPtr = NULL;
+ tagPtr->priority = textPtr->numTags;
+ tagPtr->border = NULL;
+ tagPtr->bdString = NULL;
+ tagPtr->borderWidth = 0;
+ tagPtr->reliefString = NULL;
+ tagPtr->relief = TK_RELIEF_FLAT;
+ tagPtr->bgStipple = None;
+ tagPtr->fgColor = NULL;
+ tagPtr->tkfont = NULL;
+ tagPtr->fgStipple = None;
+ tagPtr->justifyString = NULL;
+ tagPtr->justify = TK_JUSTIFY_LEFT;
+ tagPtr->lMargin1String = NULL;
+ tagPtr->lMargin1 = 0;
+ tagPtr->lMargin2String = NULL;
+ tagPtr->lMargin2 = 0;
+ tagPtr->offsetString = NULL;
+ tagPtr->offset = 0;
+ tagPtr->overstrikeString = NULL;
+ tagPtr->overstrike = 0;
+ tagPtr->rMarginString = NULL;
+ tagPtr->rMargin = 0;
+ tagPtr->spacing1String = NULL;
+ tagPtr->spacing1 = 0;
+ tagPtr->spacing2String = NULL;
+ tagPtr->spacing2 = 0;
+ tagPtr->spacing3String = NULL;
+ tagPtr->spacing3 = 0;
+ tagPtr->tabString = NULL;
+ tagPtr->tabArrayPtr = NULL;
+ tagPtr->underlineString = NULL;
+ tagPtr->underline = 0;
+ tagPtr->wrapMode = NULL;
+ tagPtr->affectsDisplay = 0;
+ textPtr->numTags++;
+ Tcl_SetHashValue(hPtr, tagPtr);
+ return tagPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkTextTag *
+FindTag(interp, textPtr, tagName)
+ Tcl_Interp *interp; /* Interpreter to use for error message;
+ * if NULL, then don't record an error
+ * message. */
+ TkText *textPtr; /* Widget in which tag is being used. */
+ char *tagName; /* Name of desired tag. */
+{
+ Tcl_HashEntry *hPtr;
+
+ hPtr = Tcl_FindHashEntry(&textPtr->tagTable, tagName);
+ if (hPtr != NULL) {
+ return (TkTextTag *) Tcl_GetHashValue(hPtr);
+ }
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "tag \"", tagName,
+ "\" isn't defined in text widget", (char *) NULL);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkTextFreeTag --
+ *
+ * This procedure is called when a tag is deleted to free up the
+ * memory and other resources associated with the tag.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory and other resources are freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkTextFreeTag(textPtr, tagPtr)
+ TkText *textPtr; /* Info about overall widget. */
+ register TkTextTag *tagPtr; /* Tag being deleted. */
+{
+ if (tagPtr->border != None) {
+ Tk_Free3DBorder(tagPtr->border);
+ }
+ if (tagPtr->bdString != NULL) {
+ ckfree(tagPtr->bdString);
+ }
+ if (tagPtr->reliefString != NULL) {
+ ckfree(tagPtr->reliefString);
+ }
+ if (tagPtr->bgStipple != None) {
+ Tk_FreeBitmap(textPtr->display, tagPtr->bgStipple);
+ }
+ if (tagPtr->fgColor != None) {
+ Tk_FreeColor(tagPtr->fgColor);
+ }
+ Tk_FreeFont(tagPtr->tkfont);
+ if (tagPtr->fgStipple != None) {
+ Tk_FreeBitmap(textPtr->display, tagPtr->fgStipple);
+ }
+ if (tagPtr->justifyString != NULL) {
+ ckfree(tagPtr->justifyString);
+ }
+ if (tagPtr->lMargin1String != NULL) {
+ ckfree(tagPtr->lMargin1String);
+ }
+ if (tagPtr->lMargin2String != NULL) {
+ ckfree(tagPtr->lMargin2String);
+ }
+ if (tagPtr->offsetString != NULL) {
+ ckfree(tagPtr->offsetString);
+ }
+ if (tagPtr->overstrikeString != NULL) {
+ ckfree(tagPtr->overstrikeString);
+ }
+ if (tagPtr->rMarginString != NULL) {
+ ckfree(tagPtr->rMarginString);
+ }
+ if (tagPtr->spacing1String != NULL) {
+ ckfree(tagPtr->spacing1String);
+ }
+ if (tagPtr->spacing2String != NULL) {
+ ckfree(tagPtr->spacing2String);
+ }
+ if (tagPtr->spacing3String != NULL) {
+ ckfree(tagPtr->spacing3String);
+ }
+ if (tagPtr->tabString != NULL) {
+ ckfree(tagPtr->tabString);
+ }
+ if (tagPtr->tabArrayPtr != NULL) {
+ ckfree((char *) tagPtr->tabArrayPtr);
+ }
+ if (tagPtr->underlineString != NULL) {
+ ckfree(tagPtr->underlineString);
+ }
+ ckfree((char *) tagPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SortTags --
+ *
+ * This procedure sorts an array of tag pointers in increasing
+ * order of priority, optimizing for the common case where the
+ * array is small.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SortTags(numTags, tagArrayPtr)
+ int numTags; /* Number of tag pointers at *tagArrayPtr. */
+ TkTextTag **tagArrayPtr; /* Pointer to array of pointers. */
+{
+ int i, j, prio;
+ register TkTextTag **tagPtrPtr;
+ TkTextTag **maxPtrPtr, *tmp;
+
+ if (numTags < 2) {
+ return;
+ }
+ if (numTags < 20) {
+ for (i = numTags-1; i > 0; i--, tagArrayPtr++) {
+ maxPtrPtr = tagPtrPtr = tagArrayPtr;
+ prio = tagPtrPtr[0]->priority;
+ for (j = i, tagPtrPtr++; j > 0; j--, tagPtrPtr++) {
+ if (tagPtrPtr[0]->priority < prio) {
+ prio = tagPtrPtr[0]->priority;
+ maxPtrPtr = tagPtrPtr;
+ }
+ }
+ tmp = *maxPtrPtr;
+ *maxPtrPtr = *tagArrayPtr;
+ *tagArrayPtr = tmp;
+ }
+ } else {
+ qsort((VOID *) tagArrayPtr, (unsigned) numTags, sizeof (TkTextTag *),
+ TagSortProc);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TagSortProc --
+ *
+ * This procedure is called by qsort when sorting an array of
+ * tags in priority order.
+ *
+ * Results:
+ * The return value is -1 if the first argument should be before
+ * the second element (i.e. it has lower priority), 0 if it's
+ * equivalent (this should never happen!), and 1 if it should be
+ * after the second element.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+TagSortProc(first, second)
+ CONST VOID *first, *second; /* Elements to be compared. */
+{
+ TkTextTag *tagPtr1, *tagPtr2;
+
+ tagPtr1 = * (TkTextTag **) first;
+ tagPtr2 = * (TkTextTag **) second;
+ return tagPtr1->priority - tagPtr2->priority;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ChangeTagPriority --
+ *
+ * This procedure changes the priority of a tag by modifying
+ * its priority and the priorities of other tags that are affected
+ * by the change.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Priorities may be changed for some or all of the tags in
+ * textPtr. The tags will be arranged so that there is exactly
+ * one tag at each priority level between 0 and textPtr->numTags-1,
+ * with tagPtr at priority "prio".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ChangeTagPriority(textPtr, tagPtr, prio)
+ TkText *textPtr; /* Information about text widget. */
+ TkTextTag *tagPtr; /* Tag whose priority is to be
+ * changed. */
+ int prio; /* New priority for tag. */
+{
+ int low, high, delta;
+ register TkTextTag *tagPtr2;
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch search;
+
+ if (prio < 0) {
+ prio = 0;
+ }
+ if (prio >= textPtr->numTags) {
+ prio = textPtr->numTags-1;
+ }
+ if (prio == tagPtr->priority) {
+ return;
+ } else if (prio < tagPtr->priority) {
+ low = prio;
+ high = tagPtr->priority-1;
+ delta = 1;
+ } else {
+ low = tagPtr->priority+1;
+ high = prio;
+ delta = -1;
+ }
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->tagTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ tagPtr2 = (TkTextTag *) Tcl_GetHashValue(hPtr);
+ if ((tagPtr2->priority >= low) && (tagPtr2->priority <= high)) {
+ tagPtr2->priority += delta;
+ }
+ }
+ tagPtr->priority = prio;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextBindProc --
+ *
+ * This procedure is invoked by the Tk dispatcher to handle
+ * events associated with bindings on items.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the command invoked as part of the binding
+ * (if there was any).
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkTextBindProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to canvas structure. */
+ XEvent *eventPtr; /* Pointer to X event that just
+ * happened. */
+{
+ TkText *textPtr = (TkText *) clientData;
+ int repick = 0;
+
+# define AnyButtonMask (Button1Mask|Button2Mask|Button3Mask\
+ |Button4Mask|Button5Mask)
+
+ Tcl_Preserve((ClientData) textPtr);
+
+ /*
+ * This code simulates grabs for mouse buttons by keeping track
+ * of whether a button is pressed and refusing to pick a new current
+ * character while a button is pressed.
+ */
+
+ if (eventPtr->type == ButtonPress) {
+ textPtr->flags |= BUTTON_DOWN;
+ } else if (eventPtr->type == ButtonRelease) {
+ int mask;
+
+ switch (eventPtr->xbutton.button) {
+ case Button1:
+ mask = Button1Mask;
+ break;
+ case Button2:
+ mask = Button2Mask;
+ break;
+ case Button3:
+ mask = Button3Mask;
+ break;
+ case Button4:
+ mask = Button4Mask;
+ break;
+ case Button5:
+ mask = Button5Mask;
+ break;
+ default:
+ mask = 0;
+ break;
+ }
+ if ((eventPtr->xbutton.state & AnyButtonMask) == (unsigned) mask) {
+ textPtr->flags &= ~BUTTON_DOWN;
+ repick = 1;
+ }
+ } else if ((eventPtr->type == EnterNotify)
+ || (eventPtr->type == LeaveNotify)) {
+ if (eventPtr->xcrossing.state & AnyButtonMask) {
+ textPtr->flags |= BUTTON_DOWN;
+ } else {
+ textPtr->flags &= ~BUTTON_DOWN;
+ }
+ TkTextPickCurrent(textPtr, eventPtr);
+ goto done;
+ } else if (eventPtr->type == MotionNotify) {
+ if (eventPtr->xmotion.state & AnyButtonMask) {
+ textPtr->flags |= BUTTON_DOWN;
+ } else {
+ textPtr->flags &= ~BUTTON_DOWN;
+ }
+ TkTextPickCurrent(textPtr, eventPtr);
+ }
+ if ((textPtr->numCurTags > 0) && (textPtr->bindingTable != NULL)
+ && (textPtr->tkwin != NULL)) {
+ Tk_BindEvent(textPtr->bindingTable, eventPtr, textPtr->tkwin,
+ textPtr->numCurTags, (ClientData *) textPtr->curTagArrayPtr);
+ }
+ if (repick) {
+ unsigned int oldState;
+
+ oldState = eventPtr->xbutton.state;
+ eventPtr->xbutton.state &= ~(Button1Mask|Button2Mask
+ |Button3Mask|Button4Mask|Button5Mask);
+ TkTextPickCurrent(textPtr, eventPtr);
+ eventPtr->xbutton.state = oldState;
+ }
+
+ done:
+ Tcl_Release((ClientData) textPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextPickCurrent --
+ *
+ * Find the character containing the coordinates in an event
+ * and place the "current" mark on that character. If the
+ * "current" mark has moved then generate a fake leave event
+ * on the old current character and a fake enter event on the new
+ * current character.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The current mark for textPtr may change. If it does,
+ * then the commands associated with character entry and leave
+ * could do just about anything. For example, the text widget
+ * might be deleted. It is up to the caller to protect itself
+ * with calls to Tcl_Preserve and Tcl_Release.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkTextPickCurrent(textPtr, eventPtr)
+ register TkText *textPtr; /* Text widget in which to select
+ * current character. */
+ XEvent *eventPtr; /* Event describing location of
+ * mouse cursor. Must be EnterWindow,
+ * LeaveWindow, ButtonRelease, or
+ * MotionNotify. */
+{
+ TkTextIndex index;
+ TkTextTag **oldArrayPtr, **newArrayPtr;
+ TkTextTag **copyArrayPtr = NULL; /* Initialization needed to prevent
+ * compiler warning. */
+
+ int numOldTags, numNewTags, i, j, size;
+ XEvent event;
+
+ /*
+ * If a button is down, then don't do anything at all; we'll be
+ * called again when all buttons are up, and we can repick then.
+ * This implements a form of mouse grabbing.
+ */
+
+ if (textPtr->flags & BUTTON_DOWN) {
+ if (((eventPtr->type == EnterNotify) || (eventPtr->type == LeaveNotify))
+ && ((eventPtr->xcrossing.mode == NotifyGrab)
+ || (eventPtr->xcrossing.mode == NotifyUngrab))) {
+ /*
+ * Special case: the window is being entered or left because
+ * of a grab or ungrab. In this case, repick after all.
+ * Furthermore, clear BUTTON_DOWN to release the simulated
+ * grab.
+ */
+
+ textPtr->flags &= ~BUTTON_DOWN;
+ } else {
+ return;
+ }
+ }
+
+ /*
+ * Save information about this event in the widget in case we have
+ * to synthesize more enter and leave events later (e.g. because a
+ * character was deleted, causing a new character to be underneath
+ * the mouse cursor). Also translate MotionNotify events into
+ * EnterNotify events, since that's what gets reported to event
+ * handlers when the current character changes.
+ */
+
+ if (eventPtr != &textPtr->pickEvent) {
+ if ((eventPtr->type == MotionNotify)
+ || (eventPtr->type == ButtonRelease)) {
+ textPtr->pickEvent.xcrossing.type = EnterNotify;
+ textPtr->pickEvent.xcrossing.serial = eventPtr->xmotion.serial;
+ textPtr->pickEvent.xcrossing.send_event
+ = eventPtr->xmotion.send_event;
+ textPtr->pickEvent.xcrossing.display = eventPtr->xmotion.display;
+ textPtr->pickEvent.xcrossing.window = eventPtr->xmotion.window;
+ textPtr->pickEvent.xcrossing.root = eventPtr->xmotion.root;
+ textPtr->pickEvent.xcrossing.subwindow = None;
+ textPtr->pickEvent.xcrossing.time = eventPtr->xmotion.time;
+ textPtr->pickEvent.xcrossing.x = eventPtr->xmotion.x;
+ textPtr->pickEvent.xcrossing.y = eventPtr->xmotion.y;
+ textPtr->pickEvent.xcrossing.x_root = eventPtr->xmotion.x_root;
+ textPtr->pickEvent.xcrossing.y_root = eventPtr->xmotion.y_root;
+ textPtr->pickEvent.xcrossing.mode = NotifyNormal;
+ textPtr->pickEvent.xcrossing.detail = NotifyNonlinear;
+ textPtr->pickEvent.xcrossing.same_screen
+ = eventPtr->xmotion.same_screen;
+ textPtr->pickEvent.xcrossing.focus = False;
+ textPtr->pickEvent.xcrossing.state = eventPtr->xmotion.state;
+ } else {
+ textPtr->pickEvent = *eventPtr;
+ }
+ }
+
+ /*
+ * Find the new current character, then find and sort all of the
+ * tags associated with it.
+ */
+
+ if (textPtr->pickEvent.type != LeaveNotify) {
+ TkTextPixelIndex(textPtr, textPtr->pickEvent.xcrossing.x,
+ textPtr->pickEvent.xcrossing.y, &index);
+ newArrayPtr = TkBTreeGetTags(&index, &numNewTags);
+ SortTags(numNewTags, newArrayPtr);
+ } else {
+ newArrayPtr = NULL;
+ numNewTags = 0;
+ }
+
+ /*
+ * Resort the tags associated with the previous marked character
+ * (the priorities might have changed), then make a copy of the
+ * new tags, and compare the old tags to the copy, nullifying
+ * any tags that are present in both groups (i.e. the tags that
+ * haven't changed).
+ */
+
+ SortTags(textPtr->numCurTags, textPtr->curTagArrayPtr);
+ if (numNewTags > 0) {
+ size = numNewTags * sizeof(TkTextTag *);
+ copyArrayPtr = (TkTextTag **) ckalloc((unsigned) size);
+ memcpy((VOID *) copyArrayPtr, (VOID *) newArrayPtr, (size_t) size);
+ for (i = 0; i < textPtr->numCurTags; i++) {
+ for (j = 0; j < numNewTags; j++) {
+ if (textPtr->curTagArrayPtr[i] == copyArrayPtr[j]) {
+ textPtr->curTagArrayPtr[i] = NULL;
+ copyArrayPtr[j] = NULL;
+ break;
+ }
+ }
+ }
+ }
+
+ /*
+ * Invoke the binding system with a LeaveNotify event for all of
+ * the tags that have gone away. We have to be careful here,
+ * because it's possible that the binding could do something
+ * (like calling tkwait) that eventually modifies
+ * textPtr->curTagArrayPtr. To avoid problems in situations like
+ * this, update curTagArrayPtr to its new value before invoking
+ * any bindings, and don't use it any more here.
+ */
+
+ numOldTags = textPtr->numCurTags;
+ textPtr->numCurTags = numNewTags;
+ oldArrayPtr = textPtr->curTagArrayPtr;
+ textPtr->curTagArrayPtr = newArrayPtr;
+ if (numOldTags != 0) {
+ if ((textPtr->bindingTable != NULL) && (textPtr->tkwin != NULL)) {
+ event = textPtr->pickEvent;
+ event.type = LeaveNotify;
+
+ /*
+ * Always use a detail of NotifyAncestor. Besides being
+ * consistent, this avoids problems where the binding code
+ * will discard NotifyInferior events.
+ */
+
+ event.xcrossing.detail = NotifyAncestor;
+ Tk_BindEvent(textPtr->bindingTable, &event, textPtr->tkwin,
+ numOldTags, (ClientData *) oldArrayPtr);
+ }
+ ckfree((char *) oldArrayPtr);
+ }
+
+ /*
+ * Reset the "current" mark (be careful to recompute its location,
+ * since it might have changed during an event binding). Then
+ * invoke the binding system with an EnterNotify event for all of
+ * the tags that have just appeared.
+ */
+
+ TkTextPixelIndex(textPtr, textPtr->pickEvent.xcrossing.x,
+ textPtr->pickEvent.xcrossing.y, &index);
+ TkTextSetMark(textPtr, "current", &index);
+ if (numNewTags != 0) {
+ if ((textPtr->bindingTable != NULL) && (textPtr->tkwin != NULL)) {
+ event = textPtr->pickEvent;
+ event.type = EnterNotify;
+ event.xcrossing.detail = NotifyAncestor;
+ Tk_BindEvent(textPtr->bindingTable, &event, textPtr->tkwin,
+ numNewTags, (ClientData *) copyArrayPtr);
+ }
+ ckfree((char *) copyArrayPtr);
+ }
+}
diff --git a/tk/generic/tkTextWind.c b/tk/generic/tkTextWind.c
new file mode 100644
index 00000000000..cc9f7ba0820
--- /dev/null
+++ b/tk/generic/tkTextWind.c
@@ -0,0 +1,1176 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tk.h"
+#include "tkText.h"
+#include "tkPort.h"
+
+/*
+ * The following structure is the official type record for the
+ * embedded window geometry manager:
+ */
+
+static void EmbWinRequestProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+static void EmbWinLostSlaveProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+
+static Tk_GeomMgr textGeomType = {
+ "text", /* name */
+ EmbWinRequestProc, /* requestProc */
+ EmbWinLostSlaveProc, /* lostSlaveProc */
+};
+
+/*
+ * Definitions for alignment values:
+ */
+
+#define ALIGN_BOTTOM 0
+#define ALIGN_CENTER 1
+#define ALIGN_TOP 2
+#define ALIGN_BASELINE 3
+
+/*
+ * Macro that determines the size of an embedded window segment:
+ */
+
+#define EW_SEG_SIZE ((unsigned) (Tk_Offset(TkTextSegment, body) \
+ + sizeof(TkTextEmbWindow)))
+
+/*
+ * Prototypes for procedures defined in this file:
+ */
+
+static int AlignParseProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, Tk_Window tkwin, char *value,
+ char *widgRec, int offset));
+static char * AlignPrintProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin, char *widgRec, int offset,
+ Tcl_FreeProc **freeProcPtr));
+static TkTextSegment * EmbWinCleanupProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static void EmbWinCheckProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr));
+static void EmbWinBboxProc _ANSI_ARGS_((TkTextDispChunk *chunkPtr,
+ int index, int y, int lineHeight, int baseline,
+ int *xPtr, int *yPtr, int *widthPtr,
+ int *heightPtr));
+static int EmbWinConfigure _ANSI_ARGS_((TkText *textPtr,
+ TkTextSegment *ewPtr, int argc, char **argv));
+static void EmbWinDelayedUnmap _ANSI_ARGS_((
+ ClientData clientData));
+static int EmbWinDeleteProc _ANSI_ARGS_((TkTextSegment *segPtr,
+ TkTextLine *linePtr, int treeGone));
+static void EmbWinDisplayProc _ANSI_ARGS_((
+ TkTextDispChunk *chunkPtr, int x, int y,
+ int lineHeight, int baseline, Display *display,
+ Drawable dst, int screenY));
+static int EmbWinLayoutProc _ANSI_ARGS_((TkText *textPtr,
+ TkTextIndex *indexPtr, TkTextSegment *segPtr,
+ int offset, int maxX, int maxChars,
+ int noCharsYet, Tk_Uid wrapMode,
+ TkTextDispChunk *chunkPtr));
+static void EmbWinStructureProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void EmbWinUndisplayProc _ANSI_ARGS_((TkText *textPtr,
+ TkTextDispChunk *chunkPtr));
+
+/*
+ * The following structure declares the "embedded window" segment type.
+ */
+
+static Tk_SegType tkTextEmbWindowType = {
+ "window", /* name */
+ 0, /* leftGravity */
+ (Tk_SegSplitProc *) NULL, /* splitProc */
+ EmbWinDeleteProc, /* deleteProc */
+ EmbWinCleanupProc, /* cleanupProc */
+ (Tk_SegLineChangeProc *) NULL, /* lineChangeProc */
+ EmbWinLayoutProc, /* layoutProc */
+ EmbWinCheckProc /* checkProc */
+};
+
+/*
+ * Information used for parsing window configuration options:
+ */
+
+static Tk_CustomOption alignOption = {AlignParseProc, AlignPrintProc,
+ (ClientData) NULL};
+
+static Tk_ConfigSpec configSpecs[] = {
+ {TK_CONFIG_CUSTOM, "-align", (char *) NULL, (char *) NULL,
+ "center", 0, TK_CONFIG_DONT_SET_DEFAULT, &alignOption},
+ {TK_CONFIG_STRING, "-create", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextEmbWindow, create),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_INT, "-padx", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(TkTextEmbWindow, padX),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_INT, "-pady", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(TkTextEmbWindow, padY),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_BOOLEAN, "-stretch", (char *) NULL, (char *) NULL,
+ "0", Tk_Offset(TkTextEmbWindow, stretch),
+ TK_CONFIG_DONT_SET_DEFAULT},
+ {TK_CONFIG_WINDOW, "-window", (char *) NULL, (char *) NULL,
+ (char *) NULL, Tk_Offset(TkTextEmbWindow, tkwin),
+ TK_CONFIG_DONT_SET_DEFAULT|TK_CONFIG_NULL_OK},
+ {TK_CONFIG_END, (char *) NULL, (char *) NULL, (char *) NULL,
+ (char *) NULL, 0, 0}
+};
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextWindowCmd --
+ *
+ * This procedure implements the "window" widget command
+ * for text widgets. See the user documentation for details
+ * on what it does.
+ *
+ * Results:
+ * A standard Tcl result or error.
+ *
+ * Side effects:
+ * See the user documentation.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextWindowCmd(textPtr, interp, argc, argv)
+ register TkText *textPtr; /* Information about text widget. */
+ 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 "window". */
+{
+ size_t length;
+ register TkTextSegment *ewPtr;
+
+ if (argc < 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " window option ?arg arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ length = strlen(argv[2]);
+ if ((strncmp(argv[2], "cget", length) == 0) && (length >= 2)) {
+ TkTextIndex index;
+ TkTextSegment *ewPtr;
+
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " window cget index option\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ewPtr = TkTextIndexToSeg(&index, (int *) NULL);
+ if (ewPtr->typePtr != &tkTextEmbWindowType) {
+ Tcl_AppendResult(interp, "no embedded window at index \"",
+ argv[3], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ return Tk_ConfigureValue(interp, textPtr->tkwin, configSpecs,
+ (char *) &ewPtr->body.ew, argv[4], 0);
+ } else if ((strncmp(argv[2], "configure", length) == 0) && (length >= 2)) {
+ TkTextIndex index;
+ TkTextSegment *ewPtr;
+
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " window configure index ?option value ...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ ewPtr = TkTextIndexToSeg(&index, (int *) NULL);
+ if (ewPtr->typePtr != &tkTextEmbWindowType) {
+ Tcl_AppendResult(interp, "no embedded window at index \"",
+ argv[3], "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 4) {
+ return Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
+ (char *) &ewPtr->body.ew, (char *) NULL, 0);
+ } else if (argc == 5) {
+ return Tk_ConfigureInfo(interp, textPtr->tkwin, configSpecs,
+ (char *) &ewPtr->body.ew, argv[4], 0);
+ } else {
+ TkTextChanged(textPtr, &index, &index);
+ return EmbWinConfigure(textPtr, ewPtr, argc-4, argv+4);
+ }
+ } else if ((strncmp(argv[2], "create", length) == 0) && (length >= 2)) {
+ TkTextIndex index;
+ int lineIndex;
+
+ /*
+ * Add a new window. Find where to put the new window, and
+ * mark that position for redisplay.
+ */
+
+ if (argc < 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " window create index ?option value ...?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (TkTextGetIndex(interp, textPtr, argv[3], &index) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ /*
+ * 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);
+ ewPtr->typePtr = &tkTextEmbWindowType;
+ ewPtr->size = 1;
+ ewPtr->body.ew.textPtr = textPtr;
+ ewPtr->body.ew.linePtr = NULL;
+ ewPtr->body.ew.tkwin = NULL;
+ ewPtr->body.ew.create = NULL;
+ ewPtr->body.ew.align = ALIGN_CENTER;
+ ewPtr->body.ew.padX = ewPtr->body.ew.padY = 0;
+ ewPtr->body.ew.stretch = 0;
+ ewPtr->body.ew.chunkCount = 0;
+ ewPtr->body.ew.displayed = 0;
+
+ /*
+ * Link the segment into the text widget, then configure it (delete
+ * it again if the configuration fails).
+ */
+
+ TkTextChanged(textPtr, &index, &index);
+ TkBTreeLinkSegment(ewPtr, &index);
+ if (EmbWinConfigure(textPtr, ewPtr, argc-4, argv+4) != TCL_OK) {
+ TkTextIndex index2;
+
+ TkTextIndexForwChars(&index, 1, &index2);
+ TkBTreeDeleteChars(&index, &index2);
+ return TCL_ERROR;
+ }
+ } else if (strncmp(argv[2], "names", length) == 0) {
+ Tcl_HashSearch search;
+ Tcl_HashEntry *hPtr;
+
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " window names\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ for (hPtr = Tcl_FirstHashEntry(&textPtr->windowTable, &search);
+ hPtr != NULL; hPtr = Tcl_NextHashEntry(&search)) {
+ Tcl_AppendElement(interp,
+ Tcl_GetHashKey(&textPtr->markTable, hPtr));
+ }
+ } else {
+ Tcl_AppendResult(interp, "bad window option \"", argv[2],
+ "\": must be cget, configure, create, or names",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+EmbWinConfigure(textPtr, ewPtr, argc, argv)
+ TkText *textPtr; /* Information about text widget that
+ * contains embedded window. */
+ TkTextSegment *ewPtr; /* Embedded window to be configured. */
+ int argc; /* Number of strings in argv. */
+ char **argv; /* Array of strings describing configuration
+ * options. */
+{
+ Tk_Window oldWindow;
+ Tcl_HashEntry *hPtr;
+ int new;
+
+ oldWindow = ewPtr->body.ew.tkwin;
+ if (Tk_ConfigureWidget(textPtr->interp, textPtr->tkwin, configSpecs,
+ argc, argv, (char *) &ewPtr->body.ew, TK_CONFIG_ARGV_ONLY)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (oldWindow != ewPtr->body.ew.tkwin) {
+ if (oldWindow != NULL) {
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&textPtr->windowTable,
+ Tk_PathName(oldWindow)));
+ Tk_DeleteEventHandler(oldWindow, StructureNotifyMask,
+ EmbWinStructureProc, (ClientData) ewPtr);
+ Tk_ManageGeometry(oldWindow, (Tk_GeomMgr *) NULL,
+ (ClientData) NULL);
+ if (textPtr->tkwin != Tk_Parent(oldWindow)) {
+ Tk_UnmaintainGeometry(oldWindow, textPtr->tkwin);
+ } else {
+ Tk_UnmapWindow(oldWindow);
+ }
+ }
+ if (ewPtr->body.ew.tkwin != NULL) {
+ Tk_Window ancestor, parent;
+
+ /*
+ * Make sure that the text is either the parent of the
+ * embedded window or a descendant of that parent. Also,
+ * don't allow a top-level window to be managed inside
+ * a text.
+ */
+
+ parent = Tk_Parent(ewPtr->body.ew.tkwin);
+ for (ancestor = textPtr->tkwin; ;
+ ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == parent) {
+ break;
+ }
+ if (Tk_IsTopLevel(ancestor)) {
+ badMaster:
+ Tcl_AppendResult(textPtr->interp, "can't embed ",
+ Tk_PathName(ewPtr->body.ew.tkwin), " in ",
+ Tk_PathName(textPtr->tkwin), (char *) NULL);
+ ewPtr->body.ew.tkwin = NULL;
+ return TCL_ERROR;
+ }
+ }
+ if (Tk_IsTopLevel(ewPtr->body.ew.tkwin)
+ || (ewPtr->body.ew.tkwin == textPtr->tkwin)) {
+ goto badMaster;
+ }
+
+ /*
+ * Take over geometry management for the window, plus create
+ * an event handler to find out when it is deleted.
+ */
+
+ Tk_ManageGeometry(ewPtr->body.ew.tkwin, &textGeomType,
+ (ClientData) ewPtr);
+ Tk_CreateEventHandler(ewPtr->body.ew.tkwin, StructureNotifyMask,
+ EmbWinStructureProc, (ClientData) ewPtr);
+
+ /*
+ * Special trick! Must enter into the hash table *after*
+ * calling Tk_ManageGeometry: if the window was already managed
+ * elsewhere in this text, the Tk_ManageGeometry call will cause
+ * the entry to be removed, which could potentially lose the new
+ * entry.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&textPtr->windowTable,
+ Tk_PathName(ewPtr->body.ew.tkwin), &new);
+ Tcl_SetHashValue(hPtr, ewPtr);
+
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AlignParseProc --
+ *
+ * This procedure is invoked by Tk_ConfigureWidget during
+ * option processing to handle "-align" options for embedded
+ * windows.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * The alignment for the embedded window may change.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+AlignParseProc(clientData, interp, tkwin, value, widgRec, offset)
+ ClientData clientData; /* Not used.*/
+ Tcl_Interp *interp; /* Used for reporting errors. */
+ Tk_Window tkwin; /* Window for text widget. */
+ char *value; /* Value of option. */
+ char *widgRec; /* Pointer to TkTextEmbWindow
+ * structure. */
+ int offset; /* Offset into item (ignored). */
+{
+ register TkTextEmbWindow *embPtr = (TkTextEmbWindow *) widgRec;
+
+ if (strcmp(value, "baseline") == 0) {
+ embPtr->align = ALIGN_BASELINE;
+ } else if (strcmp(value, "bottom") == 0) {
+ embPtr->align = ALIGN_BOTTOM;
+ } else if (strcmp(value, "center") == 0) {
+ embPtr->align = ALIGN_CENTER;
+ } else if (strcmp(value, "top") == 0) {
+ embPtr->align = ALIGN_TOP;
+ } else {
+ Tcl_AppendResult(interp, "bad alignment \"", value,
+ "\": must be baseline, bottom, center, or top",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AlignPrintProc --
+ *
+ * This procedure is invoked by the Tk configuration code
+ * to produce a printable string for the "-align" configuration
+ * option for embedded windows.
+ *
+ * Results:
+ * The return value is a string describing the embedded
+ * window's current alignment.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static char *
+AlignPrintProc(clientData, tkwin, widgRec, offset, freeProcPtr)
+ ClientData clientData; /* Ignored. */
+ Tk_Window tkwin; /* Window for text widget. */
+ char *widgRec; /* Pointer to TkTextEmbWindow
+ * structure. */
+ int offset; /* Ignored. */
+ Tcl_FreeProc **freeProcPtr; /* Pointer to variable to fill in with
+ * information about how to reclaim
+ * storage for return string. */
+{
+ switch (((TkTextEmbWindow *) widgRec)->align) {
+ case ALIGN_BASELINE:
+ return "baseline";
+ case ALIGN_BOTTOM:
+ return "bottom";
+ case ALIGN_CENTER:
+ return "center";
+ case ALIGN_TOP:
+ return "top";
+ default:
+ return "??";
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinStructureProc --
+ *
+ * This procedure is invoked by the Tk event loop whenever
+ * StructureNotify events occur for a window that's embedded
+ * in a text widget. This procedure's only purpose is to
+ * clean up when windows are deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is disassociated from the window segment, and
+ * the portion of the text is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to record describing window item. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ register TkTextSegment *ewPtr = (TkTextSegment *) clientData;
+ TkTextIndex index;
+
+ if (eventPtr->type != DestroyNotify) {
+ return;
+ }
+
+ 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 --
+ *
+ * This procedure is invoked whenever a window that's associated
+ * with a window canvas item changes its requested dimensions.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size and location on the screen of the window may change,
+ * depending on the options specified for the window item.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+EmbWinRequestProc(clientData, tkwin)
+ ClientData clientData; /* Pointer to record for window item. */
+ Tk_Window tkwin; /* Window that changed its desired
+ * 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 --
+ *
+ * This procedure is invoked by the Tk geometry manager when
+ * a slave window managed by a text widget is claimed away
+ * by another geometry manager.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is disassociated from the window segment, and
+ * the portion of the text is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinLostSlaveProc(clientData, tkwin)
+ ClientData clientData; /* Pointer to record describing window item. */
+ Tk_Window tkwin; /* Window that was claimed away by another
+ * geometry manager. */
+{
+ register TkTextSegment *ewPtr = (TkTextSegment *) clientData;
+ TkTextIndex index;
+
+ Tk_DeleteEventHandler(ewPtr->body.ew.tkwin, StructureNotifyMask,
+ EmbWinStructureProc, (ClientData) ewPtr);
+ Tcl_CancelIdleCall(EmbWinDelayedUnmap, (ClientData) ewPtr);
+ if (ewPtr->body.ew.textPtr->tkwin != Tk_Parent(tkwin)) {
+ Tk_UnmaintainGeometry(tkwin, ewPtr->body.ew.textPtr->tkwin);
+ } else {
+ 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 --
+ *
+ * This procedure is invoked by the text B-tree code whenever
+ * an embedded window lies in a range of characters being deleted.
+ *
+ * Results:
+ * Returns 0 to indicate that the deletion has been accepted.
+ *
+ * Side effects:
+ * The embedded window is deleted, if it exists, and any resources
+ * associated with it are released.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static int
+EmbWinDeleteProc(ewPtr, linePtr, treeGone)
+ TkTextSegment *ewPtr; /* Segment being deleted. */
+ TkTextLine *linePtr; /* Line containing segment. */
+ int treeGone; /* Non-zero means the entire tree is
+ * being deleted, so everything must
+ * get cleaned up. */
+{
+ Tcl_HashEntry *hPtr;
+
+ if (ewPtr->body.ew.tkwin != NULL) {
+ hPtr = Tcl_FindHashEntry(&ewPtr->body.ew.textPtr->windowTable,
+ Tk_PathName(ewPtr->body.ew.tkwin));
+ if (hPtr != NULL) {
+ /*
+ * (It's possible for there to be no hash table entry for this
+ * window, if an error occurred while creating the window segment
+ * but before the window got added to the table)
+ */
+
+ Tcl_DeleteHashEntry(hPtr);
+ }
+
+ /*
+ * Delete the event handler for the window before destroying
+ * the window, so that EmbWinStructureProc doesn't get called
+ * (we'll already do everything that it would have done, and
+ * it will just get confused).
+ */
+
+ Tk_DeleteEventHandler(ewPtr->body.ew.tkwin, StructureNotifyMask,
+ EmbWinStructureProc, (ClientData) ewPtr);
+ Tk_DestroyWindow(ewPtr->body.ew.tkwin);
+ }
+ Tcl_CancelIdleCall(EmbWinDelayedUnmap, (ClientData) ewPtr);
+ Tk_FreeOptions(configSpecs, (char *) &ewPtr->body.ew,
+ ewPtr->body.ew.textPtr->display, 0);
+ ckfree((char *) ewPtr);
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinCleanupProc --
+ *
+ * This procedure is invoked by the B-tree code whenever a
+ * segment containing an embedded window is moved from one
+ * line to another.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The linePtr field of the segment gets updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static TkTextSegment *
+EmbWinCleanupProc(ewPtr, linePtr)
+ TkTextSegment *ewPtr; /* Mark segment that's being moved. */
+ TkTextLine *linePtr; /* Line that now contains segment. */
+{
+ ewPtr->body.ew.linePtr = linePtr;
+ return ewPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinLayoutProc --
+ *
+ * This procedure is the "layoutProc" for embedded window
+ * segments.
+ *
+ * Results:
+ * 1 is returned to indicate that the segment should be
+ * displayed. The chunkPtr structure is filled in.
+ *
+ * Side effects:
+ * None, except for filling in chunkPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /*ARGSUSED*/
+static int
+EmbWinLayoutProc(textPtr, indexPtr, ewPtr, offset, maxX, maxChars,
+ noCharsYet, wrapMode, chunkPtr)
+ TkText *textPtr; /* Text widget being layed out. */
+ TkTextIndex *indexPtr; /* Identifies first character in chunk. */
+ TkTextSegment *ewPtr; /* Segment corresponding to indexPtr. */
+ int offset; /* Offset within segPtr corresponding to
+ * 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;
+
+ if (offset != 0) {
+ panic("Non-zero offset in EmbWinLayoutProc");
+ }
+
+ if ((ewPtr->body.ew.tkwin == NULL) && (ewPtr->body.ew.create != NULL)) {
+ int code, new;
+ Tcl_DString name;
+ Tk_Window ancestor;
+ Tcl_HashEntry *hPtr;
+
+ /*
+ * The window doesn't currently exist. Create it by evaluating
+ * the creation script. The script must return the window's
+ * path name: look up that name to get back to the window
+ * token. Then register ourselves as the geometry manager for
+ * the window.
+ */
+
+ 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; ;
+ ancestor = Tk_Parent(ancestor)) {
+ if (ancestor == Tk_Parent(ewPtr->body.ew.tkwin)) {
+ break;
+ }
+ if (Tk_IsTopLevel(ancestor)) {
+ badMaster:
+ Tcl_AppendResult(textPtr->interp, "can't embed ",
+ Tk_PathName(ewPtr->body.ew.tkwin), " relative to ",
+ Tk_PathName(textPtr->tkwin), (char *) NULL);
+ Tcl_BackgroundError(textPtr->interp);
+ ewPtr->body.ew.tkwin = NULL;
+ goto gotWindow;
+ }
+ }
+ if (Tk_IsTopLevel(ewPtr->body.ew.tkwin)
+ || (textPtr->tkwin == ewPtr->body.ew.tkwin)) {
+ goto badMaster;
+ }
+ Tk_ManageGeometry(ewPtr->body.ew.tkwin, &textGeomType,
+ (ClientData) ewPtr);
+ Tk_CreateEventHandler(ewPtr->body.ew.tkwin, StructureNotifyMask,
+ EmbWinStructureProc, (ClientData) ewPtr);
+
+ /*
+ * Special trick! Must enter into the hash table *after*
+ * calling Tk_ManageGeometry: if the window was already managed
+ * elsewhere in this text, the Tk_ManageGeometry call will cause
+ * the entry to be removed, which could potentially lose the new
+ * entry.
+ */
+
+ hPtr = Tcl_CreateHashEntry(&textPtr->windowTable,
+ Tk_PathName(ewPtr->body.ew.tkwin), &new);
+ Tcl_SetHashValue(hPtr, ewPtr);
+ }
+
+ /*
+ * See if there's room for this window on this line.
+ */
+
+ gotWindow:
+ if (ewPtr->body.ew.tkwin == NULL) {
+ 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;
+ chunkPtr->minHeight = height;
+ }
+ chunkPtr->width = width;
+ chunkPtr->breakIndex = -1;
+ chunkPtr->breakIndex = 1;
+ chunkPtr->clientData = (ClientData) ewPtr;
+ ewPtr->body.ew.chunkCount += 1;
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinCheckProc --
+ *
+ * This procedure is invoked by the B-tree code to perform
+ * consistency checks on embedded windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The procedure panics if it detects anything wrong with
+ * the embedded window.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinCheckProc(ewPtr, linePtr)
+ TkTextSegment *ewPtr; /* Segment to check. */
+ TkTextLine *linePtr; /* Line containing segment. */
+{
+ if (ewPtr->nextPtr == NULL) {
+ panic("EmbWinCheckProc: embedded window is last segment in line");
+ }
+ if (ewPtr->size != 1) {
+ panic("EmbWinCheckProc: embedded window has size %d", ewPtr->size);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinDisplayProc --
+ *
+ * This procedure is invoked by the text displaying code
+ * when it is time to actually draw an embedded window
+ * chunk on the screen.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The embedded window gets moved to the correct location
+ * and mapped onto the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinDisplayProc(chunkPtr, x, y, lineHeight, baseline, display, dst, screenY)
+ TkTextDispChunk *chunkPtr; /* Chunk that is to be drawn. */
+ int x; /* X-position in dst at which to
+ * draw this chunk (differs from
+ * the x-position in the chunk because
+ * of scrolling). */
+ int y; /* Top of rectangular bounding box
+ * for line: tells where to draw this
+ * chunk in dst (x-position is in
+ * the chunk itself). */
+ int lineHeight; /* Total height of line. */
+ int baseline; /* Offset of baseline from y. */
+ Display *display; /* Display to use for drawing. */
+ Drawable dst; /* Pixmap or window in which to draw */
+ int screenY; /* Y-coordinate in text window that
+ * corresponds to y. */
+{
+ TkTextSegment *ewPtr = (TkTextSegment *) chunkPtr->clientData;
+ int lineX, windowX, windowY, width, height;
+ Tk_Window tkwin;
+
+ tkwin = ewPtr->body.ew.tkwin;
+ if (tkwin == NULL) {
+ return;
+ }
+ if ((x + chunkPtr->width) <= 0) {
+ /*
+ * The window is off-screen; just unmap it.
+ */
+
+ if (ewPtr->body.ew.textPtr->tkwin != Tk_Parent(tkwin)) {
+ Tk_UnmaintainGeometry(tkwin, ewPtr->body.ew.textPtr->tkwin);
+ } else {
+ Tk_UnmapWindow(tkwin);
+ }
+ return;
+ }
+
+ /*
+ * Compute the window's location and size in the text widget, taking
+ * into account the align and stretch values for the window.
+ */
+
+ EmbWinBboxProc(chunkPtr, 0, screenY, lineHeight, baseline, &lineX,
+ &windowY, &width, &height);
+ windowX = lineX - chunkPtr->x + x;
+
+ if (ewPtr->body.ew.textPtr->tkwin == Tk_Parent(tkwin)) {
+ if ((windowX != Tk_X(tkwin)) || (windowY != Tk_Y(tkwin))
+ || (Tk_ReqWidth(tkwin) != Tk_Width(tkwin))
+ || (height != Tk_Height(tkwin))) {
+ Tk_MoveResizeWindow(tkwin, windowX, windowY, width, height);
+ }
+ Tk_MapWindow(tkwin);
+ } else {
+ Tk_MaintainGeometry(tkwin, ewPtr->body.ew.textPtr->tkwin,
+ windowX, windowY, width, height);
+ }
+
+ /*
+ * Mark the window as displayed so that it won't get unmapped.
+ */
+
+ ewPtr->body.ew.displayed = 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinUndisplayProc --
+ *
+ * This procedure is called when the chunk for an embedded
+ * window is no longer going to be displayed. It arranges
+ * for the window associated with the chunk to be unmapped.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is scheduled for unmapping.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinUndisplayProc(textPtr, chunkPtr)
+ TkText *textPtr; /* Overall information about text
+ * widget. */
+ TkTextDispChunk *chunkPtr; /* Chunk that is about to be freed. */
+{
+ TkTextSegment *ewPtr = (TkTextSegment *) chunkPtr->clientData;
+
+ ewPtr->body.ew.chunkCount--;
+ if (ewPtr->body.ew.chunkCount == 0) {
+ /*
+ * Don't unmap the window immediately, since there's a good chance
+ * that it will immediately be redisplayed, perhaps even in the
+ * same place. Instead, schedule the window to be unmapped later;
+ * the call to EmbWinDelayedUnmap will be cancelled in the likely
+ * event that the unmap becomes unnecessary.
+ */
+
+ ewPtr->body.ew.displayed = 0;
+ Tcl_DoWhenIdle(EmbWinDelayedUnmap, (ClientData) ewPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinBboxProc --
+ *
+ * This procedure is called to compute the bounding box of
+ * the area occupied by an embedded window.
+ *
+ * Results:
+ * There is no return value. *xPtr and *yPtr are filled in
+ * with the coordinates of the upper left corner of the
+ * window, and *widthPtr and *heightPtr are filled in with
+ * the dimensions of the window in pixels. Note: not all
+ * of the returned bbox is necessarily visible on the screen
+ * (the rightmost part might be off-screen to the right,
+ * and the bottommost part might be off-screen to the bottom).
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinBboxProc(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; /* Total height of line. */
+ 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. */
+ int *widthPtr; /* Gets filled in with width of
+ * character, in pixels. */
+ int *heightPtr; /* Gets filled in with height of
+ * character, in pixels. */
+{
+ TkTextSegment *ewPtr = (TkTextSegment *) chunkPtr->clientData;
+ Tk_Window tkwin;
+
+ tkwin = ewPtr->body.ew.tkwin;
+ if (tkwin != NULL) {
+ *widthPtr = Tk_ReqWidth(tkwin);
+ *heightPtr = Tk_ReqHeight(tkwin);
+ } else {
+ *widthPtr = 0;
+ *heightPtr = 0;
+ }
+ *xPtr = chunkPtr->x + ewPtr->body.ew.padX;
+ if (ewPtr->body.ew.stretch) {
+ if (ewPtr->body.ew.align == ALIGN_BASELINE) {
+ *heightPtr = baseline - ewPtr->body.ew.padY;
+ } else {
+ *heightPtr = lineHeight - 2*ewPtr->body.ew.padY;
+ }
+ }
+ switch (ewPtr->body.ew.align) {
+ case ALIGN_BOTTOM:
+ *yPtr = y + (lineHeight - *heightPtr - ewPtr->body.ew.padY);
+ break;
+ case ALIGN_CENTER:
+ *yPtr = y + (lineHeight - *heightPtr)/2;
+ break;
+ case ALIGN_TOP:
+ *yPtr = y + ewPtr->body.ew.padY;
+ break;
+ case ALIGN_BASELINE:
+ *yPtr = y + (baseline - *heightPtr);
+ break;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * EmbWinDelayedUnmap --
+ *
+ * This procedure is an idle handler that does the actual
+ * work of unmapping an embedded window. See the comment
+ * in EmbWinUndisplayProc for details.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window gets unmapped, unless its chunk reference count
+ * has become non-zero again.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+EmbWinDelayedUnmap(clientData)
+ ClientData clientData; /* Token for the window to
+ * be unmapped. */
+{
+ TkTextSegment *ewPtr = (TkTextSegment *) clientData;
+
+ if (!ewPtr->body.ew.displayed && (ewPtr->body.ew.tkwin != NULL)) {
+ if (ewPtr->body.ew.textPtr->tkwin != Tk_Parent(ewPtr->body.ew.tkwin)) {
+ Tk_UnmaintainGeometry(ewPtr->body.ew.tkwin,
+ ewPtr->body.ew.textPtr->tkwin);
+ } else {
+ Tk_UnmapWindow(ewPtr->body.ew.tkwin);
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkTextWindowIndex --
+ *
+ * Given the name of an embedded window within a text widget,
+ * returns an index corresponding to the window's position
+ * in the text.
+ *
+ * Results:
+ * The return value is 1 if there is an embedded window by
+ * the given name in the text widget, 0 otherwise. If the
+ * window exists, *indexPtr is filled in with its index.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkTextWindowIndex(textPtr, name, indexPtr)
+ TkText *textPtr; /* Text widget containing window. */
+ char *name; /* Name of window. */
+ TkTextIndex *indexPtr; /* Index information gets stored here. */
+{
+ Tcl_HashEntry *hPtr;
+ TkTextSegment *ewPtr;
+
+ 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;
+}
diff --git a/tk/generic/tkTrig.c b/tk/generic/tkTrig.c
new file mode 100644
index 00000000000..cf4b8b80c0b
--- /dev/null
+++ b/tk/generic/tkTrig.c
@@ -0,0 +1,1467 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <stdio.h>
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkCanvas.h"
+
+#undef MIN
+#define MIN(a,b) (((a) < (b)) ? (a) : (b))
+#undef MAX
+#define MAX(a,b) (((a) > (b)) ? (a) : (b))
+#ifndef PI
+# define PI 3.14159265358979323846
+#endif /* PI */
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkLineToPoint --
+ *
+ * Compute the distance from a point to a finite line segment.
+ *
+ * Results:
+ * The return value is the distance from the line segment
+ * whose end-points are *end1Ptr and *end2Ptr to the point
+ * given by *pointPtr.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+double
+TkLineToPoint(end1Ptr, end2Ptr, pointPtr)
+ double end1Ptr[2]; /* Coordinates of first end-point of line. */
+ double end2Ptr[2]; /* Coordinates of second end-point of line. */
+ double pointPtr[2]; /* Points to coords for point. */
+{
+ double x, y;
+
+ /*
+ * Compute the point on the line that is closest to the
+ * point. This must be done separately for vertical edges,
+ * horizontal edges, and other edges.
+ */
+
+ if (end1Ptr[0] == end2Ptr[0]) {
+
+ /*
+ * Vertical edge.
+ */
+
+ x = end1Ptr[0];
+ if (end1Ptr[1] >= end2Ptr[1]) {
+ y = MIN(end1Ptr[1], pointPtr[1]);
+ y = MAX(y, end2Ptr[1]);
+ } else {
+ y = MIN(end2Ptr[1], pointPtr[1]);
+ y = MAX(y, end1Ptr[1]);
+ }
+ } else if (end1Ptr[1] == end2Ptr[1]) {
+
+ /*
+ * Horizontal edge.
+ */
+
+ y = end1Ptr[1];
+ if (end1Ptr[0] >= end2Ptr[0]) {
+ x = MIN(end1Ptr[0], pointPtr[0]);
+ x = MAX(x, end2Ptr[0]);
+ } else {
+ x = MIN(end2Ptr[0], pointPtr[0]);
+ x = MAX(x, end1Ptr[0]);
+ }
+ } else {
+ double m1, b1, m2, b2;
+
+ /*
+ * The edge is neither horizontal nor vertical. Convert the
+ * edge to a line equation of the form y = m1*x + b1. Then
+ * compute a line perpendicular to this edge but passing
+ * through the point, also in the form y = m2*x + b2.
+ */
+
+ m1 = (end2Ptr[1] - end1Ptr[1])/(end2Ptr[0] - end1Ptr[0]);
+ b1 = end1Ptr[1] - m1*end1Ptr[0];
+ m2 = -1.0/m1;
+ b2 = pointPtr[1] - m2*pointPtr[0];
+ x = (b2 - b1)/(m1 - m2);
+ y = m1*x + b1;
+ if (end1Ptr[0] > end2Ptr[0]) {
+ if (x > end1Ptr[0]) {
+ x = end1Ptr[0];
+ y = end1Ptr[1];
+ } else if (x < end2Ptr[0]) {
+ x = end2Ptr[0];
+ y = end2Ptr[1];
+ }
+ } else {
+ if (x > end2Ptr[0]) {
+ x = end2Ptr[0];
+ y = end2Ptr[1];
+ } else if (x < end1Ptr[0]) {
+ x = end1Ptr[0];
+ y = end1Ptr[1];
+ }
+ }
+ }
+
+ /*
+ * Compute the distance to the closest point.
+ */
+
+ return hypot(pointPtr[0] - x, pointPtr[1] - y);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkLineToArea --
+ *
+ * Determine whether a line lies entirely inside, entirely
+ * outside, or overlapping a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the line given by end1Ptr and end2Ptr
+ * is entirely outside the rectangle given by rectPtr. 0 is
+ * returned if the polygon overlaps the rectangle, and 1 is
+ * returned if the polygon is entirely inside the rectangle.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkLineToArea(end1Ptr, end2Ptr, rectPtr)
+ double end1Ptr[2]; /* X and y coordinates for one endpoint
+ * of line. */
+ double end2Ptr[2]; /* X and y coordinates for other endpoint
+ * of line. */
+ double rectPtr[4]; /* Points to coords for rectangle, in the
+ * order x1, y1, x2, y2. X1 must be no
+ * larger than x2, and y1 no larger than y2. */
+{
+ int inside1, inside2;
+
+ /*
+ * First check the two points individually to see whether they
+ * are inside the rectangle or not.
+ */
+
+ inside1 = (end1Ptr[0] >= rectPtr[0]) && (end1Ptr[0] <= rectPtr[2])
+ && (end1Ptr[1] >= rectPtr[1]) && (end1Ptr[1] <= rectPtr[3]);
+ inside2 = (end2Ptr[0] >= rectPtr[0]) && (end2Ptr[0] <= rectPtr[2])
+ && (end2Ptr[1] >= rectPtr[1]) && (end2Ptr[1] <= rectPtr[3]);
+ if (inside1 != inside2) {
+ return 0;
+ }
+ if (inside1 & inside2) {
+ return 1;
+ }
+
+ /*
+ * Both points are outside the rectangle, but still need to check
+ * for intersections between the line and the rectangle. Horizontal
+ * and vertical lines are particularly easy, so handle them
+ * separately.
+ */
+
+ if (end1Ptr[0] == end2Ptr[0]) {
+ /*
+ * Vertical line.
+ */
+
+ if (((end1Ptr[1] >= rectPtr[1]) ^ (end2Ptr[1] >= rectPtr[1]))
+ && (end1Ptr[0] >= rectPtr[0])
+ && (end1Ptr[0] <= rectPtr[2])) {
+ return 0;
+ }
+ } else if (end1Ptr[1] == end2Ptr[1]) {
+ /*
+ * Horizontal line.
+ */
+
+ if (((end1Ptr[0] >= rectPtr[0]) ^ (end2Ptr[0] >= rectPtr[0]))
+ && (end1Ptr[1] >= rectPtr[1])
+ && (end1Ptr[1] <= rectPtr[3])) {
+ return 0;
+ }
+ } else {
+ double m, x, y, low, high;
+
+ /*
+ * Diagonal line. Compute slope of line and use
+ * for intersection checks against each of the
+ * sides of the rectangle: left, right, bottom, top.
+ */
+
+ m = (end2Ptr[1] - end1Ptr[1])/(end2Ptr[0] - end1Ptr[0]);
+ if (end1Ptr[0] < end2Ptr[0]) {
+ low = end1Ptr[0]; high = end2Ptr[0];
+ } else {
+ low = end2Ptr[0]; high = end1Ptr[0];
+ }
+
+ /*
+ * Left edge.
+ */
+
+ y = end1Ptr[1] + (rectPtr[0] - end1Ptr[0])*m;
+ if ((rectPtr[0] >= low) && (rectPtr[0] <= high)
+ && (y >= rectPtr[1]) && (y <= rectPtr[3])) {
+ return 0;
+ }
+
+ /*
+ * Right edge.
+ */
+
+ y += (rectPtr[2] - rectPtr[0])*m;
+ if ((y >= rectPtr[1]) && (y <= rectPtr[3])
+ && (rectPtr[2] >= low) && (rectPtr[2] <= high)) {
+ return 0;
+ }
+
+ /*
+ * Bottom edge.
+ */
+
+ if (end1Ptr[1] < end2Ptr[1]) {
+ low = end1Ptr[1]; high = end2Ptr[1];
+ } else {
+ low = end2Ptr[1]; high = end1Ptr[1];
+ }
+ x = end1Ptr[0] + (rectPtr[1] - end1Ptr[1])/m;
+ if ((x >= rectPtr[0]) && (x <= rectPtr[2])
+ && (rectPtr[1] >= low) && (rectPtr[1] <= high)) {
+ return 0;
+ }
+
+ /*
+ * Top edge.
+ */
+
+ x += (rectPtr[3] - rectPtr[1])/m;
+ if ((x >= rectPtr[0]) && (x <= rectPtr[2])
+ && (rectPtr[3] >= low) && (rectPtr[3] <= high)) {
+ return 0;
+ }
+ }
+ return -1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkThickPolyLineToArea --
+ *
+ * This procedure is called to determine whether a connected
+ * series of line segments lies entirely inside, entirely
+ * outside, or overlapping a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the lines are entirely outside the area,
+ * 0 if they overlap, and 1 if they are entirely inside the
+ * given area.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TkThickPolyLineToArea(coordPtr, numPoints, width, capStyle, joinStyle, rectPtr)
+ double *coordPtr; /* Points to an array of coordinates for
+ * the polyline: x0, y0, x1, y1, ... */
+ int numPoints; /* Total number of points at *coordPtr. */
+ double width; /* Width of each line segment. */
+ int capStyle; /* How are end-points of polyline drawn?
+ * CapRound, CapButt, or CapProjecting. */
+ int joinStyle; /* How are joints in polyline drawn?
+ * JoinMiter, JoinRound, or JoinBevel. */
+ double *rectPtr; /* Rectangular area to check against. */
+{
+ double radius, poly[10];
+ int count;
+ int changedMiterToBevel; /* Non-zero means that a mitered corner
+ * had to be treated as beveled after all
+ * because the angle was < 11 degrees. */
+ int inside; /* Tentative guess about what to return,
+ * based on all points seen so far: one
+ * means everything seen so far was
+ * inside the area; -1 means everything
+ * was outside the area. 0 means overlap
+ * has been found. */
+
+ radius = width/2.0;
+ inside = -1;
+
+ if ((coordPtr[0] >= rectPtr[0]) && (coordPtr[0] <= rectPtr[2])
+ && (coordPtr[1] >= rectPtr[1]) && (coordPtr[1] <= rectPtr[3])) {
+ inside = 1;
+ }
+
+ /*
+ * Iterate through all of the edges of the line, computing a polygon
+ * for each edge and testing the area against that polygon. In
+ * addition, there are additional tests to deal with rounded joints
+ * and caps.
+ */
+
+ changedMiterToBevel = 0;
+ for (count = numPoints; count >= 2; count--, coordPtr += 2) {
+
+ /*
+ * If rounding is done around the first point of the edge
+ * then test a circular region around the point with the
+ * area.
+ */
+
+ if (((capStyle == CapRound) && (count == numPoints))
+ || ((joinStyle == JoinRound) && (count != numPoints))) {
+ poly[0] = coordPtr[0] - radius;
+ poly[1] = coordPtr[1] - radius;
+ poly[2] = coordPtr[0] + radius;
+ poly[3] = coordPtr[1] + radius;
+ if (TkOvalToArea(poly, rectPtr) != inside) {
+ return 0;
+ }
+ }
+
+ /*
+ * 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,
+ capStyle == CapProjecting, poly, poly+2);
+ } else if ((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 the last joint was beveled, then also check 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 beveled joint.
+ */
+
+ if ((joinStyle == JoinBevel) || changedMiterToBevel) {
+ poly[8] = poly[0];
+ poly[9] = poly[1];
+ if (TkPolygonToArea(poly, 5, rectPtr) != inside) {
+ return 0;
+ }
+ changedMiterToBevel = 0;
+ }
+ }
+ if (count == 2) {
+ TkGetButtPoints(coordPtr, coordPtr+2, width,
+ capStyle == CapProjecting, poly+4, poly+6);
+ } else if (joinStyle == JoinMiter) {
+ if (TkGetMiterPoints(coordPtr, coordPtr+2, coordPtr+4,
+ (double) 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];
+ if (TkPolygonToArea(poly, 5, rectPtr) != inside) {
+ return 0;
+ }
+ }
+
+ /*
+ * If caps are rounded, check the cap around the final point
+ * of the line.
+ */
+
+ if (capStyle == CapRound) {
+ poly[0] = coordPtr[0] - radius;
+ poly[1] = coordPtr[1] - radius;
+ poly[2] = coordPtr[0] + radius;
+ poly[3] = coordPtr[1] + radius;
+ if (TkOvalToArea(poly, rectPtr) != inside) {
+ return 0;
+ }
+ }
+
+ return inside;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkPolygonToPoint --
+ *
+ * Compute the distance from a point to a polygon.
+ *
+ * Results:
+ * The return value is 0.0 if the point referred to by
+ * pointPtr is within the polygon referred to by polyPtr
+ * and numPoints. Otherwise the return value is the
+ * distance of the point from the polygon.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+double
+TkPolygonToPoint(polyPtr, numPoints, pointPtr)
+ double *polyPtr; /* Points to an array coordinates for
+ * closed polygon: x0, y0, x1, y1, ...
+ * The polygon may be self-intersecting. */
+ int numPoints; /* Total number of points at *polyPtr. */
+ double *pointPtr; /* Points to coords for point. */
+{
+ double bestDist; /* Closest distance between point and
+ * any edge in polygon. */
+ int intersections; /* Number of edges in the polygon that
+ * intersect a ray extending vertically
+ * upwards from the point to infinity. */
+ int count;
+ register double *pPtr;
+
+ /*
+ * Iterate through all of the edges in the polygon, updating
+ * bestDist and intersections.
+ *
+ * TRICKY POINT: when computing intersections, include left
+ * x-coordinate of line within its range, but not y-coordinate.
+ * Otherwise if the point lies exactly below a vertex we'll
+ * count it as two intersections.
+ */
+
+ bestDist = 1.0e36;
+ intersections = 0;
+
+ for (count = numPoints, pPtr = polyPtr; count > 1; count--, pPtr += 2) {
+ double x, y, dist;
+
+ /*
+ * Compute the point on the current edge closest to the point
+ * and update the intersection count. This must be done
+ * separately for vertical edges, horizontal edges, and
+ * other edges.
+ */
+
+ if (pPtr[2] == pPtr[0]) {
+
+ /*
+ * Vertical edge.
+ */
+
+ x = pPtr[0];
+ if (pPtr[1] >= pPtr[3]) {
+ y = MIN(pPtr[1], pointPtr[1]);
+ y = MAX(y, pPtr[3]);
+ } else {
+ y = MIN(pPtr[3], pointPtr[1]);
+ y = MAX(y, pPtr[1]);
+ }
+ } else if (pPtr[3] == pPtr[1]) {
+
+ /*
+ * Horizontal edge.
+ */
+
+ y = pPtr[1];
+ if (pPtr[0] >= pPtr[2]) {
+ x = MIN(pPtr[0], pointPtr[0]);
+ x = MAX(x, pPtr[2]);
+ if ((pointPtr[1] < y) && (pointPtr[0] < pPtr[0])
+ && (pointPtr[0] >= pPtr[2])) {
+ intersections++;
+ }
+ } else {
+ x = MIN(pPtr[2], pointPtr[0]);
+ x = MAX(x, pPtr[0]);
+ if ((pointPtr[1] < y) && (pointPtr[0] < pPtr[2])
+ && (pointPtr[0] >= pPtr[0])) {
+ intersections++;
+ }
+ }
+ } else {
+ double m1, b1, m2, b2;
+ int lower; /* Non-zero means point below line. */
+
+ /*
+ * The edge is neither horizontal nor vertical. Convert the
+ * edge to a line equation of the form y = m1*x + b1. Then
+ * compute a line perpendicular to this edge but passing
+ * through the point, also in the form y = m2*x + b2.
+ */
+
+ m1 = (pPtr[3] - pPtr[1])/(pPtr[2] - pPtr[0]);
+ b1 = pPtr[1] - m1*pPtr[0];
+ m2 = -1.0/m1;
+ b2 = pointPtr[1] - m2*pointPtr[0];
+ x = (b2 - b1)/(m1 - m2);
+ y = m1*x + b1;
+ if (pPtr[0] > pPtr[2]) {
+ if (x > pPtr[0]) {
+ x = pPtr[0];
+ y = pPtr[1];
+ } else if (x < pPtr[2]) {
+ x = pPtr[2];
+ y = pPtr[3];
+ }
+ } else {
+ if (x > pPtr[2]) {
+ x = pPtr[2];
+ y = pPtr[3];
+ } else if (x < pPtr[0]) {
+ x = pPtr[0];
+ y = pPtr[1];
+ }
+ }
+ lower = (m1*pointPtr[0] + b1) > pointPtr[1];
+ if (lower && (pointPtr[0] >= MIN(pPtr[0], pPtr[2]))
+ && (pointPtr[0] < MAX(pPtr[0], pPtr[2]))) {
+ intersections++;
+ }
+ }
+
+ /*
+ * Compute the distance to the closest point, and see if that
+ * is the best distance seen so far.
+ */
+
+ dist = hypot(pointPtr[0] - x, pointPtr[1] - y);
+ if (dist < bestDist) {
+ bestDist = dist;
+ }
+ }
+
+ /*
+ * We've processed all of the points. If the number of intersections
+ * is odd, the point is inside the polygon.
+ */
+
+ if (intersections & 0x1) {
+ return 0.0;
+ }
+ return bestDist;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkPolygonToArea --
+ *
+ * Determine whether a polygon lies entirely inside, entirely
+ * outside, or overlapping a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the polygon given by polyPtr and numPoints
+ * is entirely outside the rectangle given by rectPtr. 0 is
+ * returned if the polygon overlaps the rectangle, and 1 is
+ * returned if the polygon is entirely inside the rectangle.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkPolygonToArea(polyPtr, numPoints, rectPtr)
+ double *polyPtr; /* Points to an array coordinates for
+ * closed polygon: x0, y0, x1, y1, ...
+ * The polygon may be self-intersecting. */
+ int numPoints; /* Total number of points at *polyPtr. */
+ register double *rectPtr; /* Points to coords for rectangle, in the
+ * order x1, y1, x2, y2. X1 and y1 must
+ * be lower-left corner. */
+{
+ int state; /* State of all edges seen so far (-1 means
+ * outside, 1 means inside, won't ever be
+ * 0). */
+ int count;
+ register double *pPtr;
+
+ /*
+ * Iterate over all of the edges of the polygon and test them
+ * against the rectangle. Can quit as soon as the state becomes
+ * "intersecting".
+ */
+
+ state = TkLineToArea(polyPtr, polyPtr+2, rectPtr);
+ if (state == 0) {
+ return 0;
+ }
+ for (pPtr = polyPtr+2, count = numPoints-1; count >= 2;
+ pPtr += 2, count--) {
+ if (TkLineToArea(pPtr, pPtr+2, rectPtr) != state) {
+ return 0;
+ }
+ }
+
+ /*
+ * If all of the edges were inside the rectangle we're done.
+ * If all of the edges were outside, then the rectangle could
+ * still intersect the polygon (if it's entirely enclosed).
+ * Call TkPolygonToPoint to figure this out.
+ */
+
+ if (state == 1) {
+ return 1;
+ }
+ if (TkPolygonToPoint(polyPtr, numPoints, rectPtr) == 0.0) {
+ return 0;
+ }
+ return -1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkOvalToPoint --
+ *
+ * Computes the distance from a given point to a given
+ * oval, in canvas units.
+ *
+ * Results:
+ * The return value is 0 if the point given by *pointPtr is
+ * inside the oval. If the point isn't inside the
+ * oval then the return value is approximately the distance
+ * from the point to the oval. If the oval is filled, then
+ * anywhere in the interior is considered "inside"; if
+ * the oval isn't filled, then "inside" means only the area
+ * occupied by the outline.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+double
+TkOvalToPoint(ovalPtr, width, filled, pointPtr)
+ double ovalPtr[4]; /* Pointer to array of four coordinates
+ * (x1, y1, x2, y2) defining oval's bounding
+ * box. */
+ double width; /* Width of outline for oval. */
+ int filled; /* Non-zero means oval should be treated as
+ * filled; zero means only consider outline. */
+ double pointPtr[2]; /* Coordinates of point. */
+{
+ double xDelta, yDelta, scaledDistance, distToOutline, distToCenter;
+ double xDiam, yDiam;
+
+ /*
+ * Compute the distance between the center of the oval and the
+ * point in question, using a coordinate system where the oval
+ * has been transformed to a circle with unit radius.
+ */
+
+ xDelta = (pointPtr[0] - (ovalPtr[0] + ovalPtr[2])/2.0);
+ yDelta = (pointPtr[1] - (ovalPtr[1] + ovalPtr[3])/2.0);
+ distToCenter = hypot(xDelta, yDelta);
+ scaledDistance = hypot(xDelta / ((ovalPtr[2] + width - ovalPtr[0])/2.0),
+ yDelta / ((ovalPtr[3] + width - ovalPtr[1])/2.0));
+
+
+ /*
+ * If the scaled distance is greater than 1 then it means no
+ * hit. Compute the distance from the point to the edge of
+ * the circle, then scale this distance back to the original
+ * coordinate system.
+ *
+ * Note: this distance isn't completely accurate. It's only
+ * an approximation, and it can overestimate the correct
+ * distance when the oval is eccentric.
+ */
+
+ if (scaledDistance > 1.0) {
+ return (distToCenter/scaledDistance) * (scaledDistance - 1.0);
+ }
+
+ /*
+ * Scaled distance less than 1 means the point is inside the
+ * outer edge of the oval. If this is a filled oval, then we
+ * have a hit. Otherwise, do the same computation as above
+ * (scale back to original coordinate system), but also check
+ * to see if the point is within the width of the outline.
+ */
+
+ if (filled) {
+ return 0.0;
+ }
+ if (scaledDistance > 1E-10) {
+ distToOutline = (distToCenter/scaledDistance) * (1.0 - scaledDistance)
+ - width;
+ } else {
+ /*
+ * Avoid dividing by a very small number (it could cause an
+ * arithmetic overflow). This problem occurs if the point is
+ * very close to the center of the oval.
+ */
+
+ xDiam = ovalPtr[2] - ovalPtr[0];
+ yDiam = ovalPtr[3] - ovalPtr[1];
+ if (xDiam < yDiam) {
+ distToOutline = (xDiam - width)/2;
+ } else {
+ distToOutline = (yDiam - width)/2;
+ }
+ }
+
+ if (distToOutline < 0.0) {
+ return 0.0;
+ }
+ return distToOutline;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkOvalToArea --
+ *
+ * Determine whether an oval lies entirely inside, entirely
+ * outside, or overlapping a given rectangular area.
+ *
+ * Results:
+ * -1 is returned if the oval described by ovalPtr is entirely
+ * outside the rectangle given by rectPtr. 0 is returned if the
+ * oval overlaps the rectangle, and 1 is returned if the oval
+ * is entirely inside the rectangle.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkOvalToArea(ovalPtr, rectPtr)
+ register double *ovalPtr; /* Points to coordinates definining the
+ * bounding rectangle for the oval: x1, y1,
+ * x2, y2. X1 must be less than x2 and y1
+ * less than y2. */
+ register double *rectPtr; /* Points to coords for rectangle, in the
+ * order x1, y1, x2, y2. X1 and y1 must
+ * be lower-left corner. */
+{
+ double centerX, centerY, radX, radY, deltaX, deltaY;
+
+ /*
+ * First, see if oval is entirely inside rectangle or entirely
+ * outside rectangle.
+ */
+
+ if ((rectPtr[0] <= ovalPtr[0]) && (rectPtr[2] >= ovalPtr[2])
+ && (rectPtr[1] <= ovalPtr[1]) && (rectPtr[3] >= ovalPtr[3])) {
+ return 1;
+ }
+ if ((rectPtr[2] < ovalPtr[0]) || (rectPtr[0] > ovalPtr[2])
+ || (rectPtr[3] < ovalPtr[1]) || (rectPtr[1] > ovalPtr[3])) {
+ return -1;
+ }
+
+ /*
+ * Next, go through the rectangle side by side. For each side
+ * of the rectangle, find the point on the side that is closest
+ * to the oval's center, and see if that point is inside the
+ * oval. If at least one such point is inside the oval, then
+ * the rectangle intersects the oval.
+ */
+
+ centerX = (ovalPtr[0] + ovalPtr[2])/2;
+ centerY = (ovalPtr[1] + ovalPtr[3])/2;
+ radX = (ovalPtr[2] - ovalPtr[0])/2;
+ radY = (ovalPtr[3] - ovalPtr[1])/2;
+
+ deltaY = rectPtr[1] - centerY;
+ if (deltaY < 0.0) {
+ deltaY = centerY - rectPtr[3];
+ if (deltaY < 0.0) {
+ deltaY = 0;
+ }
+ }
+ deltaY /= radY;
+ deltaY *= deltaY;
+
+ /*
+ * Left side:
+ */
+
+ deltaX = (rectPtr[0] - centerX)/radX;
+ deltaX *= deltaX;
+ if ((deltaX + deltaY) <= 1.0) {
+ return 0;
+ }
+
+ /*
+ * Right side:
+ */
+
+ deltaX = (rectPtr[2] - centerX)/radX;
+ deltaX *= deltaX;
+ if ((deltaX + deltaY) <= 1.0) {
+ return 0;
+ }
+
+ deltaX = rectPtr[0] - centerX;
+ if (deltaX < 0.0) {
+ deltaX = centerX - rectPtr[2];
+ if (deltaX < 0.0) {
+ deltaX = 0;
+ }
+ }
+ deltaX /= radX;
+ deltaX *= deltaX;
+
+ /*
+ * Bottom side:
+ */
+
+ deltaY = (rectPtr[1] - centerY)/radY;
+ deltaY *= deltaY;
+ if ((deltaX + deltaY) < 1.0) {
+ return 0;
+ }
+
+ /*
+ * Top side:
+ */
+
+ deltaY = (rectPtr[3] - centerY)/radY;
+ deltaY *= deltaY;
+ if ((deltaX + deltaY) < 1.0) {
+ return 0;
+ }
+
+ return -1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkIncludePoint --
+ *
+ * Given a point and a generic canvas item header, expand
+ * the item's bounding box if needed to include the point.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The boudn.
+ *
+ *--------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+void
+TkIncludePoint(itemPtr, pointPtr)
+ register Tk_Item *itemPtr; /* Item whose bounding box is
+ * being calculated. */
+ double *pointPtr; /* Address of two doubles giving
+ * x and y coordinates of point. */
+{
+ int tmp;
+
+ tmp = (int) (pointPtr[0] + 0.5);
+ if (tmp < itemPtr->x1) {
+ itemPtr->x1 = tmp;
+ }
+ if (tmp > itemPtr->x2) {
+ itemPtr->x2 = tmp;
+ }
+ tmp = (int) (pointPtr[1] + 0.5);
+ if (tmp < itemPtr->y1) {
+ itemPtr->y1 = tmp;
+ }
+ if (tmp > itemPtr->y2) {
+ itemPtr->y2 = tmp;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkBezierScreenPoints --
+ *
+ * Given four control points, create a larger set of XPoints
+ * for a Bezier spline based on the points.
+ *
+ * Results:
+ * The array at *xPointPtr gets filled in with numSteps XPoints
+ * corresponding to the Bezier spline defined by the four
+ * control points. Note: no output point is generated for the
+ * first input point, but an output point *is* generated for
+ * the last input point.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkBezierScreenPoints(canvas, control, numSteps, xPointPtr)
+ Tk_Canvas canvas; /* Canvas in which curve is to be
+ * drawn. */
+ double control[]; /* Array of coordinates for four
+ * control points: x0, y0, x1, y1,
+ * ... x3 y3. */
+ int numSteps; /* Number of curve points to
+ * generate. */
+ register XPoint *xPointPtr; /* Where to put new points. */
+{
+ int i;
+ double u, u2, u3, t, t2, t3;
+
+ for (i = 1; i <= numSteps; i++, xPointPtr++) {
+ t = ((double) i)/((double) numSteps);
+ t2 = t*t;
+ t3 = t2*t;
+ u = 1.0 - t;
+ u2 = u*u;
+ u3 = u2*u;
+ Tk_CanvasDrawableCoords(canvas,
+ (control[0]*u3 + 3.0 * (control[2]*t*u2 + control[4]*t2*u)
+ + control[6]*t3),
+ (control[1]*u3 + 3.0 * (control[3]*t*u2 + control[5]*t2*u)
+ + control[7]*t3),
+ &xPointPtr->x, &xPointPtr->y);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkBezierPoints --
+ *
+ * Given four control points, create a larger set of points
+ * for a Bezier spline based on the points.
+ *
+ * Results:
+ * The array at *coordPtr gets filled in with 2*numSteps
+ * coordinates, which correspond to the Bezier spline defined
+ * by the four control points. Note: no output point is
+ * generated for the first input point, but an output point
+ * *is* generated for the last input point.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkBezierPoints(control, numSteps, coordPtr)
+ double control[]; /* Array of coordinates for four
+ * control points: x0, y0, x1, y1,
+ * ... x3 y3. */
+ int numSteps; /* Number of curve points to
+ * generate. */
+ register double *coordPtr; /* Where to put new points. */
+{
+ int i;
+ double u, u2, u3, t, t2, t3;
+
+ for (i = 1; i <= numSteps; i++, coordPtr += 2) {
+ t = ((double) i)/((double) numSteps);
+ t2 = t*t;
+ t3 = t2*t;
+ u = 1.0 - t;
+ u2 = u*u;
+ u3 = u2*u;
+ coordPtr[0] = control[0]*u3
+ + 3.0 * (control[2]*t*u2 + control[4]*t2*u) + control[6]*t3;
+ coordPtr[1] = control[1]*u3
+ + 3.0 * (control[3]*t*u2 + control[5]*t2*u) + control[7]*t3;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkMakeBezierCurve --
+ *
+ * Given a set of points, create a new set of points that fit
+ * parabolic splines to the line segments connecting the original
+ * points. Produces output points in either of two forms.
+ *
+ * Note: in spite of this procedure's name, it does *not* generate
+ * Bezier curves. Since only three control points are used for
+ * each curve segment, not four, the curves are actually just
+ * parabolic.
+ *
+ * Results:
+ * Either or both of the xPoints or dblPoints arrays are filled
+ * in. The return value is the number of points placed in the
+ * arrays. Note: if the first and last points are the same, then
+ * a closed curve is generated.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkMakeBezierCurve(canvas, pointPtr, numPoints, numSteps, xPoints, dblPoints)
+ Tk_Canvas canvas; /* Canvas in which curve is to be
+ * drawn. */
+ double *pointPtr; /* Array of input coordinates: x0,
+ * y0, x1, y1, etc.. */
+ int numPoints; /* Number of points at pointPtr. */
+ int numSteps; /* Number of steps to use for each
+ * spline segments (determines
+ * smoothness of curve). */
+ XPoint xPoints[]; /* Array of XPoints to fill in (e.g.
+ * for display. NULL means don't
+ * fill in any XPoints. */
+ double dblPoints[]; /* Array of points to fill in as
+ * doubles, in the form x0, y0,
+ * x1, y1, .... NULL means don't
+ * fill in anything in this form.
+ * Caller must make sure that this
+ * array has enough space. */
+{
+ int closed, outputPoints, i;
+ int numCoords = numPoints*2;
+ double control[8];
+
+ /*
+ * If the curve is a closed one then generate a special spline
+ * that spans the last points and the first ones. Otherwise
+ * just put the first point into the output.
+ */
+
+ outputPoints = 0;
+ if ((pointPtr[0] == pointPtr[numCoords-2])
+ && (pointPtr[1] == pointPtr[numCoords-1])) {
+ closed = 1;
+ control[0] = 0.5*pointPtr[numCoords-4] + 0.5*pointPtr[0];
+ control[1] = 0.5*pointPtr[numCoords-3] + 0.5*pointPtr[1];
+ control[2] = 0.167*pointPtr[numCoords-4] + 0.833*pointPtr[0];
+ control[3] = 0.167*pointPtr[numCoords-3] + 0.833*pointPtr[1];
+ control[4] = 0.833*pointPtr[0] + 0.167*pointPtr[2];
+ control[5] = 0.833*pointPtr[1] + 0.167*pointPtr[3];
+ control[6] = 0.5*pointPtr[0] + 0.5*pointPtr[2];
+ control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3];
+ if (xPoints != NULL) {
+ Tk_CanvasDrawableCoords(canvas, control[0], control[1],
+ &xPoints->x, &xPoints->y);
+ TkBezierScreenPoints(canvas, control, numSteps, xPoints+1);
+ xPoints += numSteps+1;
+ }
+ if (dblPoints != NULL) {
+ dblPoints[0] = control[0];
+ dblPoints[1] = control[1];
+ TkBezierPoints(control, numSteps, dblPoints+2);
+ dblPoints += 2*(numSteps+1);
+ }
+ outputPoints += numSteps+1;
+ } else {
+ closed = 0;
+ if (xPoints != NULL) {
+ Tk_CanvasDrawableCoords(canvas, pointPtr[0], pointPtr[1],
+ &xPoints->x, &xPoints->y);
+ xPoints += 1;
+ }
+ if (dblPoints != NULL) {
+ dblPoints[0] = pointPtr[0];
+ dblPoints[1] = pointPtr[1];
+ dblPoints += 2;
+ }
+ outputPoints += 1;
+ }
+
+ for (i = 2; i < numPoints; i++, pointPtr += 2) {
+ /*
+ * Set up the first two control points. This is done
+ * differently for the first spline of an open curve
+ * than for other cases.
+ */
+
+ if ((i == 2) && !closed) {
+ control[0] = pointPtr[0];
+ control[1] = pointPtr[1];
+ control[2] = 0.333*pointPtr[0] + 0.667*pointPtr[2];
+ control[3] = 0.333*pointPtr[1] + 0.667*pointPtr[3];
+ } else {
+ control[0] = 0.5*pointPtr[0] + 0.5*pointPtr[2];
+ control[1] = 0.5*pointPtr[1] + 0.5*pointPtr[3];
+ control[2] = 0.167*pointPtr[0] + 0.833*pointPtr[2];
+ control[3] = 0.167*pointPtr[1] + 0.833*pointPtr[3];
+ }
+
+ /*
+ * Set up the last two control points. This is done
+ * differently for the last spline of an open curve
+ * than for other cases.
+ */
+
+ if ((i == (numPoints-1)) && !closed) {
+ control[4] = .667*pointPtr[2] + .333*pointPtr[4];
+ control[5] = .667*pointPtr[3] + .333*pointPtr[5];
+ control[6] = pointPtr[4];
+ control[7] = pointPtr[5];
+ } else {
+ control[4] = .833*pointPtr[2] + .167*pointPtr[4];
+ control[5] = .833*pointPtr[3] + .167*pointPtr[5];
+ control[6] = 0.5*pointPtr[2] + 0.5*pointPtr[4];
+ control[7] = 0.5*pointPtr[3] + 0.5*pointPtr[5];
+ }
+
+ /*
+ * If the first two points coincide, or if the last
+ * two points coincide, then generate a single
+ * straight-line segment by outputting the last control
+ * point.
+ */
+
+ if (((pointPtr[0] == pointPtr[2]) && (pointPtr[1] == pointPtr[3]))
+ || ((pointPtr[2] == pointPtr[4])
+ && (pointPtr[3] == pointPtr[5]))) {
+ if (xPoints != NULL) {
+ Tk_CanvasDrawableCoords(canvas, control[6], control[7],
+ &xPoints[0].x, &xPoints[0].y);
+ xPoints++;
+ }
+ if (dblPoints != NULL) {
+ dblPoints[0] = control[6];
+ dblPoints[1] = control[7];
+ dblPoints += 2;
+ }
+ outputPoints += 1;
+ continue;
+ }
+
+ /*
+ * Generate a Bezier spline using the control points.
+ */
+
+
+ if (xPoints != NULL) {
+ TkBezierScreenPoints(canvas, control, numSteps, xPoints);
+ xPoints += numSteps;
+ }
+ if (dblPoints != NULL) {
+ TkBezierPoints(control, numSteps, dblPoints);
+ dblPoints += 2*numSteps;
+ }
+ outputPoints += numSteps;
+ }
+ return outputPoints;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkMakeBezierPostscript(interp, canvas, pointPtr, numPoints)
+ Tcl_Interp *interp; /* Interpreter in whose result the
+ * Postscript is to be stored. */
+ Tk_Canvas canvas; /* Canvas widget for which the
+ * Postscript is being generated. */
+ double *pointPtr; /* Array of input coordinates: x0,
+ * y0, x1, y1, etc.. */
+ int numPoints; /* Number of points at pointPtr. */
+{
+ int closed, i;
+ int numCoords = numPoints*2;
+ double control[8];
+ char buffer[200];
+
+ /*
+ * If the curve is a closed one then generate a special spline
+ * that spans the last points and the first ones. Otherwise
+ * just put the first point into the path.
+ */
+
+ if ((pointPtr[0] == pointPtr[numCoords-2])
+ && (pointPtr[1] == pointPtr[numCoords-1])) {
+ closed = 1;
+ control[0] = 0.5*pointPtr[numCoords-4] + 0.5*pointPtr[0];
+ control[1] = 0.5*pointPtr[numCoords-3] + 0.5*pointPtr[1];
+ control[2] = 0.167*pointPtr[numCoords-4] + 0.833*pointPtr[0];
+ control[3] = 0.167*pointPtr[numCoords-3] + 0.833*pointPtr[1];
+ control[4] = 0.833*pointPtr[0] + 0.167*pointPtr[2];
+ control[5] = 0.833*pointPtr[1] + 0.167*pointPtr[3];
+ control[6] = 0.5*pointPtr[0] + 0.5*pointPtr[2];
+ control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3];
+ sprintf(buffer, "%.15g %.15g moveto\n%.15g %.15g %.15g %.15g %.15g %.15g curveto\n",
+ control[0], Tk_CanvasPsY(canvas, control[1]),
+ control[2], Tk_CanvasPsY(canvas, control[3]),
+ control[4], Tk_CanvasPsY(canvas, control[5]),
+ control[6], Tk_CanvasPsY(canvas, control[7]));
+ } else {
+ closed = 0;
+ control[6] = pointPtr[0];
+ control[7] = pointPtr[1];
+ sprintf(buffer, "%.15g %.15g moveto\n",
+ control[6], Tk_CanvasPsY(canvas, control[7]));
+ }
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+
+ /*
+ * Cycle through all the remaining points in the curve, generating
+ * a curve section for each vertex in the linear path.
+ */
+
+ for (i = numPoints-2, pointPtr += 2; i > 0; i--, pointPtr += 2) {
+ control[2] = 0.333*control[6] + 0.667*pointPtr[0];
+ control[3] = 0.333*control[7] + 0.667*pointPtr[1];
+
+ /*
+ * Set up the last two control points. This is done
+ * differently for the last spline of an open curve
+ * than for other cases.
+ */
+
+ if ((i == 1) && !closed) {
+ control[6] = pointPtr[2];
+ control[7] = pointPtr[3];
+ } else {
+ control[6] = 0.5*pointPtr[0] + 0.5*pointPtr[2];
+ control[7] = 0.5*pointPtr[1] + 0.5*pointPtr[3];
+ }
+ control[4] = 0.333*control[6] + 0.667*pointPtr[0];
+ control[5] = 0.333*control[7] + 0.667*pointPtr[1];
+
+ sprintf(buffer, "%.15g %.15g %.15g %.15g %.15g %.15g curveto\n",
+ control[2], Tk_CanvasPsY(canvas, control[3]),
+ control[4], Tk_CanvasPsY(canvas, control[5]),
+ control[6], Tk_CanvasPsY(canvas, control[7]));
+ Tcl_AppendResult(interp, buffer, (char *) NULL);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkGetMiterPoints --
+ *
+ * Given three points forming an angle, compute the
+ * coordinates of the inside and outside points of
+ * the mitered corner formed by a line of a given
+ * width at that angle.
+ *
+ * Results:
+ * If the angle formed by the three points is less than
+ * 11 degrees then 0 is returned and m1 and m2 aren't
+ * modified. Otherwise 1 is returned and the points at
+ * m1 and m2 are filled in with the positions of the points
+ * of the mitered corner.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkGetMiterPoints(p1, p2, p3, width, m1, m2)
+ double p1[]; /* Points to x- and y-coordinates of point
+ * before vertex. */
+ double p2[]; /* Points to x- and y-coordinates of vertex
+ * for mitered joint. */
+ double p3[]; /* Points to x- and y-coordinates of point
+ * after vertex. */
+ double width; /* Width of line. */
+ double m1[]; /* Points to place to put "left" vertex
+ * point (see as you face from p1 to p2). */
+ double m2[]; /* Points to place to put "right" vertex
+ * point. */
+{
+ double theta1; /* Angle of segment p2-p1. */
+ double theta2; /* Angle of segment p2-p3. */
+ double theta; /* Angle between line segments (angle
+ * of joint). */
+ double theta3; /* Angle that bisects theta1 and
+ * theta2 and points to m1. */
+ double dist; /* Distance of miter points from p2. */
+ double deltaX, deltaY; /* X and y offsets cooresponding to
+ * dist (fudge factors for bounding
+ * box). */
+ double p1x, p1y, p2x, p2y, p3x, p3y;
+ static double elevenDegrees = (11.0*2.0*PI)/360.0;
+
+ /*
+ * Round the coordinates to integers to mimic what happens when the
+ * line segments are displayed; without this code, the bounding box
+ * of a mitered line can be miscomputed greatly.
+ */
+
+ p1x = floor(p1[0]+0.5);
+ p1y = floor(p1[1]+0.5);
+ p2x = floor(p2[0]+0.5);
+ p2y = floor(p2[1]+0.5);
+ p3x = floor(p3[0]+0.5);
+ p3y = floor(p3[1]+0.5);
+
+ if (p2y == p1y) {
+ theta1 = (p2x < p1x) ? 0 : PI;
+ } else if (p2x == p1x) {
+ theta1 = (p2y < p1y) ? PI/2.0 : -PI/2.0;
+ } else {
+ theta1 = atan2(p1y - p2y, p1x - p2x);
+ }
+ if (p3y == p2y) {
+ theta2 = (p3x > p2x) ? 0 : PI;
+ } else if (p3x == p2x) {
+ theta2 = (p3y > p2y) ? PI/2.0 : -PI/2.0;
+ } else {
+ theta2 = atan2(p3y - p2y, p3x - p2x);
+ }
+ theta = theta1 - theta2;
+ if (theta > PI) {
+ theta -= 2*PI;
+ } else if (theta < -PI) {
+ theta += 2*PI;
+ }
+ if ((theta < elevenDegrees) && (theta > -elevenDegrees)) {
+ return 0;
+ }
+ dist = 0.5*width/sin(0.5*theta);
+ if (dist < 0.0) {
+ dist = -dist;
+ }
+
+ /*
+ * Compute theta3 (make sure that it points to the left when
+ * looking from p1 to p2).
+ */
+
+ theta3 = (theta1 + theta2)/2.0;
+ if (sin(theta3 - (theta1 + PI)) < 0.0) {
+ theta3 += PI;
+ }
+ deltaX = dist*cos(theta3);
+ m1[0] = p2x + deltaX;
+ m2[0] = p2x - deltaX;
+ deltaY = dist*sin(theta3);
+ m1[1] = p2y + deltaY;
+ m2[1] = p2y - deltaY;
+ return 1;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkGetButtPoints --
+ *
+ * Given two points forming a line segment, compute the
+ * coordinates of two endpoints of a rectangle formed by
+ * bloating the line segment until it is width units wide.
+ *
+ * Results:
+ * There is no return value. M1 and m2 are filled in to
+ * correspond to m1 and m2 in the diagram below:
+ *
+ * ----------------* m1
+ * |
+ * p1 *---------------* p2
+ * |
+ * ----------------* m2
+ *
+ * M1 and m2 will be W units apart, with p2 centered between
+ * them and m1-m2 perpendicular to p1-p2. However, if
+ * "project" is true then m1 and m2 will be as follows:
+ *
+ * -------------------* m1
+ * p2 |
+ * p1 *---------------* |
+ * |
+ * -------------------* m2
+ *
+ * In this case p2 will be width/2 units from the segment m1-m2.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkGetButtPoints(p1, p2, width, project, m1, m2)
+ double p1[]; /* Points to x- and y-coordinates of point
+ * before vertex. */
+ double p2[]; /* Points to x- and y-coordinates of vertex
+ * for mitered joint. */
+ double width; /* Width of line. */
+ int project; /* Non-zero means project p2 by an additional
+ * width/2 before computing m1 and m2. */
+ double m1[]; /* Points to place to put "left" result
+ * point, as you face from p1 to p2. */
+ double m2[]; /* Points to place to put "right" result
+ * point. */
+{
+ double length; /* Length of p1-p2 segment. */
+ double deltaX, deltaY; /* Increments in coords. */
+
+ width *= 0.5;
+ length = hypot(p2[0] - p1[0], p2[1] - p1[1]);
+ if (length == 0.0) {
+ m1[0] = m2[0] = p2[0];
+ m1[1] = m2[1] = p2[1];
+ } else {
+ deltaX = -width * (p2[1] - p1[1]) / length;
+ deltaY = width * (p2[0] - p1[0]) / length;
+ m1[0] = p2[0] + deltaX;
+ m2[0] = p2[0] - deltaX;
+ m1[1] = p2[1] + deltaY;
+ m2[1] = p2[1] - deltaY;
+ if (project) {
+ m1[0] += deltaY;
+ m2[0] += deltaY;
+ m1[1] -= deltaX;
+ m2[1] -= deltaX;
+ }
+ }
+}
diff --git a/tk/generic/tkUtil.c b/tk/generic/tkUtil.c
new file mode 100644
index 00000000000..407837438e6
--- /dev/null
+++ b/tk/generic/tkUtil.c
@@ -0,0 +1,348 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDrawInsetFocusHighlight --
+ *
+ * This procedure draws a rectangular ring around the outside of
+ * a widget to indicate that it has received the input focus. It
+ * takes an additional padding argument that specifies how much
+ * padding is present outside th widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A rectangle "width" pixels wide is drawn in "drawable",
+ * corresponding to the outer area of "tkwin".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkDrawInsetFocusHighlight(tkwin, gc, width, drawable, padding)
+ Tk_Window tkwin; /* Window whose focus highlight ring is
+ * to be drawn. */
+ GC gc; /* Graphics context to use for drawing
+ * the highlight ring. */
+ int width; /* Width of the highlight ring, in pixels. */
+ Drawable drawable; /* Where to draw the ring (typically a
+ * pixmap for double buffering). */
+ int padding; /* Width of padding outside of widget. */
+{
+ XRectangle rects[4];
+
+ /*
+ * On the Macintosh the highlight ring needs to be "padded"
+ * out by one pixel. Unfortunantly, none of the Tk widgets
+ * had a notion of padding between the focus ring and the
+ * widget. So we add this padding here. This introduces
+ * two things to worry about:
+ *
+ * 1) The widget must draw the background color covering
+ * the focus ring area before calling Tk_DrawFocus.
+ * 2) It is impossible to draw a focus ring of width 1.
+ * (For the Macintosh Look & Feel use width of 3)
+ */
+#ifdef MAC_TCL
+ width--;
+#endif
+
+ rects[0].x = padding;
+ rects[0].y = padding;
+ rects[0].width = Tk_Width(tkwin) - (2 * padding);
+ rects[0].height = width;
+ rects[1].x = padding;
+ rects[1].y = Tk_Height(tkwin) - width - padding;
+ rects[1].width = Tk_Width(tkwin) - (2 * padding);
+ rects[1].height = width;
+ rects[2].x = padding;
+ rects[2].y = width + padding;
+ rects[2].width = width;
+ rects[2].height = Tk_Height(tkwin) - 2*width - 2*padding;
+ rects[3].x = Tk_Width(tkwin) - width - padding;
+ rects[3].y = rects[2].y;
+ rects[3].width = width;
+ rects[3].height = rects[2].height;
+ XFillRectangles(Tk_Display(tkwin), drawable, gc, rects, 4);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DrawFocusHighlight --
+ *
+ * This procedure draws a rectangular ring around the outside of
+ * a widget to indicate that it has received the input focus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A rectangle "width" pixels wide is drawn in "drawable",
+ * corresponding to the outer area of "tkwin".
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_DrawFocusHighlight(tkwin, gc, width, drawable)
+ Tk_Window tkwin; /* Window whose focus highlight ring is
+ * to be drawn. */
+ GC gc; /* Graphics context to use for drawing
+ * the highlight ring. */
+ int width; /* Width of the highlight ring, in pixels. */
+ Drawable drawable; /* Where to draw the ring (typically a
+ * pixmap for double buffering). */
+{
+ TkDrawInsetFocusHighlight(tkwin, gc, width, drawable, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetScrollInfo --
+ *
+ * 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, interp->result contains an
+ * error message.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetScrollInfo(interp, argc, argv, dblPtr, intPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ int argc; /* # arguments for command. */
+ char **argv; /* 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;
+
+ length = strlen(argv[2]);
+ c = argv[2][0];
+ if ((c == 'm') && (strncmp(argv[2], "moveto", length) == 0)) {
+ if (argc != 4) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " ", argv[1], " moveto fraction\"",
+ (char *) NULL);
+ return TK_SCROLL_ERROR;
+ }
+ if (Tcl_GetDouble(interp, argv[3], dblPtr) != TCL_OK) {
+ return TK_SCROLL_ERROR;
+ }
+ return TK_SCROLL_MOVETO;
+ } else if ((c == 's')
+ && (strncmp(argv[2], "scroll", length) == 0)) {
+ if (argc != 5) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " ", argv[1], " scroll number units|pages\"",
+ (char *) NULL);
+ return TK_SCROLL_ERROR;
+ }
+ if (Tcl_GetInt(interp, argv[3], intPtr) != TCL_OK) {
+ return TK_SCROLL_ERROR;
+ }
+ length = strlen(argv[4]);
+ c = argv[4][0];
+ if ((c == 'p') && (strncmp(argv[4], "pages", length) == 0)) {
+ return TK_SCROLL_PAGES;
+ } else if ((c == 'u')
+ && (strncmp(argv[4], "units", length) == 0)) {
+ return TK_SCROLL_UNITS;
+ } else {
+ Tcl_AppendResult(interp, "bad argument \"", argv[4],
+ "\": must be units or pages", (char *) NULL);
+ 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
+ * anchored with respect to the given window. Used by widgets
+ * to align a box of text inside a window. When anchoring with
+ * respect to one of the sides, the rectangle be placed inside of
+ * the internal border of the window.
+ *
+ * Results:
+ * *xPtr and *yPtr set to the upper-left corner of the rectangle
+ * anchored in the window.
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+void
+TkComputeAnchor(anchor, tkwin, padX, padY, innerWidth, innerHeight, xPtr, yPtr)
+ Tk_Anchor anchor; /* Desired anchor. */
+ Tk_Window tkwin; /* Anchored with respect to this window. */
+ int padX, padY; /* Use this extra padding inside window, in
+ * addition to the internal border. */
+ int innerWidth, innerHeight;/* Size of rectangle to anchor in window. */
+ int *xPtr, *yPtr; /* Returns upper-left corner of anchored
+ * rectangle. */
+{
+ switch (anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_SW:
+ *xPtr = Tk_InternalBorderWidth(tkwin) + padX;
+ break;
+
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_S:
+ *xPtr = (Tk_Width(tkwin) - innerWidth) / 2;
+ break;
+
+ default:
+ *xPtr = Tk_Width(tkwin) - (Tk_InternalBorderWidth(tkwin) + padX)
+ - innerWidth;
+ break;
+ }
+
+ switch (anchor) {
+ case TK_ANCHOR_NW:
+ case TK_ANCHOR_N:
+ case TK_ANCHOR_NE:
+ *yPtr = Tk_InternalBorderWidth(tkwin) + padY;
+ break;
+
+ case TK_ANCHOR_W:
+ case TK_ANCHOR_CENTER:
+ case TK_ANCHOR_E:
+ *yPtr = (Tk_Height(tkwin) - innerHeight) / 2;
+ break;
+
+ default:
+ *yPtr = Tk_Height(tkwin) - Tk_InternalBorderWidth(tkwin) - padY
+ - innerHeight;
+ break;
+ }
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFindStateString --
+ *
+ * Given a lookup table, map a number to a string in the table.
+ *
+ * Results:
+ * If numKey was equal to the numeric key of one of the elements
+ * in the table, returns the string key of that element.
+ * Returns NULL if numKey was not equal to any of the numeric keys
+ * in the table.
+ *
+ * Side effects.
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+char *
+TkFindStateString(mapPtr, numKey)
+ CONST TkStateMap *mapPtr; /* The state table. */
+ int numKey; /* The key to try to find in the table. */
+{
+ for ( ; mapPtr->strKey != NULL; mapPtr++) {
+ if (numKey == mapPtr->numKey) {
+ return mapPtr->strKey;
+ }
+ }
+ return NULL;
+}
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkFindStateNum --
+ *
+ * Given a lookup table, map a string to a number in the table.
+ *
+ * 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;
+}
diff --git a/tk/generic/tkVisual.c b/tk/generic/tkVisual.c
new file mode 100644
index 00000000000..4b9457814a2
--- /dev/null
+++ b/tk/generic/tkVisual.c
@@ -0,0 +1,540 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+/*
+ * The table below maps from symbolic names for visual classes
+ * to the associated X class symbols.
+ */
+
+typedef struct VisualDictionary {
+ char *name; /* Textual name of class. */
+ int minLength; /* Minimum # characters that must be
+ * specified for an unambiguous match. */
+ int class; /* X symbol for class. */
+} VisualDictionary;
+static VisualDictionary visualNames[] = {
+ {"best", 1, 0},
+ {"directcolor", 2, DirectColor},
+ {"grayscale", 1, GrayScale},
+ {"greyscale", 1, GrayScale},
+ {"pseudocolor", 1, PseudoColor},
+ {"staticcolor", 7, StaticColor},
+ {"staticgray", 7, StaticGray},
+ {"staticgrey", 7, StaticGray},
+ {"truecolor", 1, TrueColor},
+ {NULL, 0, 0},
+};
+
+/*
+ * One of the following structures exists for each distinct non-default
+ * colormap allocated for a display by Tk_GetColormap.
+ */
+
+struct TkColormap {
+ Colormap colormap; /* X's identifier for the colormap. */
+ Visual *visual; /* Visual for which colormap was
+ * allocated. */
+ int refCount; /* How many uses of the colormap are still
+ * outstanding (calls to Tk_GetColormap
+ * minus calls to Tk_FreeColormap). */
+ int shareable; /* 0 means this colormap was allocated by
+ * a call to Tk_GetColormap with "new",
+ * implying that the window wants it all
+ * for itself. 1 means that the colormap
+ * was allocated as a default for a particular
+ * visual, so it can be shared. */
+ struct TkColormap *nextPtr; /* Next in list of colormaps for this display,
+ * or NULL for end of list. */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetVisual --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Visual *
+Tk_GetVisual(interp, tkwin, string, depthPtr, colormapPtr)
+ Tcl_Interp *interp; /* Interpreter to use for error
+ * reporting. */
+ Tk_Window tkwin; /* Window in which visual will be
+ * used. */
+ char *string; /* String describing visual. See
+ * manual entry for details. */
+ int *depthPtr; /* The depth of the returned visual
+ * is stored here. */
+ Colormap *colormapPtr; /* If non-NULL, then a suitable
+ * colormap for visual is placed here.
+ * This colormap must eventually be
+ * freed by calling Tk_FreeColormap. */
+{
+ Tk_Window tkwin2;
+ XVisualInfo template, *visInfoList, *bestPtr;
+ long mask;
+ Visual *visual;
+ int length, c, numVisuals, prio, bestPrio, i;
+ char *p;
+ VisualDictionary *dictPtr;
+ TkColormap *cmapPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+
+ /*
+ * Parse string and set up a template for use in searching for
+ * an appropriate visual.
+ */
+
+ c = string[0];
+ if (c == '.') {
+ /*
+ * The string must be a window name. If the window is on the
+ * same screen as tkwin, then just use its visual. Otherwise
+ * use the information about the visual as a template for the
+ * search.
+ */
+
+ tkwin2 = Tk_NameToWindow(interp, string, tkwin);
+ if (tkwin2 == NULL) {
+ return NULL;
+ }
+ visual = Tk_Visual(tkwin2);
+ if (Tk_Screen(tkwin) == Tk_Screen(tkwin2)) {
+ *depthPtr = Tk_Depth(tkwin2);
+ if (colormapPtr != NULL) {
+ /*
+ * Use the colormap from the other window too (but be sure
+ * to increment its reference count if it's one of the ones
+ * allocated here).
+ */
+
+ *colormapPtr = Tk_Colormap(tkwin2);
+ for (cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL;
+ cmapPtr = cmapPtr->nextPtr) {
+ if (cmapPtr->colormap == *colormapPtr) {
+ cmapPtr->refCount += 1;
+ break;
+ }
+ }
+ }
+ return visual;
+ }
+ template.depth = Tk_Depth(tkwin2);
+ template.class = visual->class;
+ template.red_mask = visual->red_mask;
+ template.green_mask = visual->green_mask;
+ template.blue_mask = visual->blue_mask;
+ template.colormap_size = visual->map_entries;
+ template.bits_per_rgb = visual->bits_per_rgb;
+ mask = VisualDepthMask|VisualClassMask|VisualRedMaskMask
+ |VisualGreenMaskMask|VisualBlueMaskMask|VisualColormapSizeMask
+ |VisualBitsPerRGBMask;
+ } else if ((c == 0) || ((c == 'd') && (string[1] != 0)
+ && (strncmp(string, "default", strlen(string)) == 0))) {
+ /*
+ * Use the default visual for the window's screen.
+ */
+
+ if (colormapPtr != NULL) {
+ *colormapPtr = DefaultColormapOfScreen(Tk_Screen(tkwin));
+ }
+ *depthPtr = DefaultDepthOfScreen(Tk_Screen(tkwin));
+ return DefaultVisualOfScreen(Tk_Screen(tkwin));
+ } else if (isdigit(UCHAR(c))) {
+ int visualId;
+
+ /*
+ * This is a visual ID.
+ */
+
+ if (Tcl_GetInt(interp, string, &visualId) == TCL_ERROR) {
+ Tcl_ResetResult(interp);
+ Tcl_AppendResult(interp, "bad X identifier for visual: ",
+ string, "\"", (char *) NULL);
+ return NULL;
+ }
+ template.visualid = visualId;
+ mask = VisualIDMask;
+ } else {
+ /*
+ * Parse the string into a class name (or "best") optionally
+ * followed by whitespace and a depth.
+ */
+
+ for (p = string; *p != 0; p++) {
+ if (isspace(UCHAR(*p)) || isdigit(UCHAR(*p))) {
+ break;
+ }
+ }
+ length = p - string;
+ template.class = -1;
+ for (dictPtr = visualNames; dictPtr->name != NULL; dictPtr++) {
+ if ((dictPtr->name[0] == c) && (length >= dictPtr->minLength)
+ && (strncmp(string, dictPtr->name,
+ (size_t) length) == 0)) {
+ template.class = dictPtr->class;
+ break;
+ }
+ }
+ if (template.class == -1) {
+ Tcl_AppendResult(interp, "unknown or ambiguous visual name \"",
+ string, "\": class must be ", (char *) NULL);
+ for (dictPtr = visualNames; dictPtr->name != NULL; dictPtr++) {
+ Tcl_AppendResult(interp, dictPtr->name, ", ", (char *) NULL);
+ }
+ Tcl_AppendResult(interp, "or default", (char *) NULL);
+ return NULL;
+ }
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (*p == 0) {
+ template.depth = 10000;
+ } else {
+ if (Tcl_GetInt(interp, p, &template.depth) != TCL_OK) {
+ return NULL;
+ }
+ }
+ if (c == 'b') {
+ mask = 0;
+ } else {
+ mask = VisualClassMask;
+ }
+ }
+
+ /*
+ * Find all visuals that match the template we've just created,
+ * and return an error if there are none that match.
+ */
+
+ 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:
+ *
+ * 1. Depth: choose a visual with exactly the desired depth,
+ * else one with more bits than requested but as few bits
+ * as possible, else one with fewer bits but as many as
+ * possible.
+ * 2. Class: some visual classes are more desirable than others;
+ * pick the visual with the most desirable class.
+ * 3. Default: the default visual for the screen gets preference
+ * over other visuals, all else being equal.
+ */
+
+ bestPrio = 0;
+ bestPtr = NULL;
+ for (i = 0; i < numVisuals; i++) {
+ switch (visInfoList[i].class) {
+ case DirectColor: prio = 5; break;
+ case GrayScale: prio = 1; break;
+ case PseudoColor: prio = 7; break;
+ case StaticColor: prio = 3; break;
+ case StaticGray: prio = 1; break;
+ case TrueColor: prio = 5; break;
+ default: prio = 0; break;
+ }
+ if (visInfoList[i].visual
+ == DefaultVisualOfScreen(Tk_Screen(tkwin))) {
+ prio++;
+ }
+ if (bestPtr == NULL) {
+ goto newBest;
+ }
+ if (visInfoList[i].depth < bestPtr->depth) {
+ if (visInfoList[i].depth >= template.depth) {
+ goto newBest;
+ }
+ } else if (visInfoList[i].depth > bestPtr->depth) {
+ if (bestPtr->depth < template.depth) {
+ goto newBest;
+ }
+ } else {
+ if (prio > bestPrio) {
+ goto newBest;
+ }
+ }
+ continue;
+
+ newBest:
+ bestPtr = &visInfoList[i];
+ bestPrio = prio;
+ }
+ *depthPtr = bestPtr->depth;
+ visual = bestPtr->visual;
+ XFree((char *) visInfoList);
+
+ /*
+ * If we need to find a colormap for this visual, do it now.
+ * If the visual is the default visual for the screen, then
+ * use the default colormap. Otherwise search for an existing
+ * colormap that's shareable. If all else fails, create a new
+ * colormap.
+ */
+
+ if (colormapPtr != NULL) {
+ if (visual == DefaultVisualOfScreen(Tk_Screen(tkwin))) {
+ *colormapPtr = DefaultColormapOfScreen(Tk_Screen(tkwin));
+ } else {
+ for (cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL;
+ cmapPtr = cmapPtr->nextPtr) {
+ if (cmapPtr->shareable && (cmapPtr->visual == visual)) {
+ *colormapPtr = cmapPtr->colormap;
+ cmapPtr->refCount += 1;
+ goto done;
+ }
+ }
+ cmapPtr = (TkColormap *) ckalloc(sizeof(TkColormap));
+ cmapPtr->colormap = XCreateColormap(Tk_Display(tkwin),
+ RootWindowOfScreen(Tk_Screen(tkwin)), visual,
+ AllocNone);
+ cmapPtr->visual = visual;
+ cmapPtr->refCount = 1;
+ cmapPtr->shareable = 1;
+ cmapPtr->nextPtr = dispPtr->cmapPtr;
+ dispPtr->cmapPtr = cmapPtr;
+ *colormapPtr = cmapPtr->colormap;
+ }
+ }
+
+ done:
+ return visual;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetColormap --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Colormap
+Tk_GetColormap(interp, tkwin, string)
+ Tcl_Interp *interp; /* Interpreter to use for error
+ * reporting. */
+ Tk_Window tkwin; /* Window where colormap will be
+ * used. */
+ char *string; /* String that identifies colormap:
+ * either "new" or the name of
+ * another window. */
+{
+ Colormap colormap;
+ TkColormap *cmapPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ Tk_Window other;
+
+ /*
+ * Allocate a new colormap, if that's what is wanted.
+ */
+
+ if (strcmp(string, "new") == 0) {
+ cmapPtr = (TkColormap *) ckalloc(sizeof(TkColormap));
+ cmapPtr->colormap = XCreateColormap(Tk_Display(tkwin),
+ RootWindowOfScreen(Tk_Screen(tkwin)), Tk_Visual(tkwin),
+ AllocNone);
+ cmapPtr->visual = Tk_Visual(tkwin);
+ cmapPtr->refCount = 1;
+ cmapPtr->shareable = 0;
+ cmapPtr->nextPtr = dispPtr->cmapPtr;
+ dispPtr->cmapPtr = cmapPtr;
+ return cmapPtr->colormap;
+ }
+
+ /*
+ * Use a colormap from an existing window. It must have the same
+ * visual as tkwin (which means, among other things, that the
+ * other window must be on the same screen).
+ */
+
+ other = Tk_NameToWindow(interp, string, tkwin);
+ if (other == NULL) {
+ return None;
+ }
+ if (Tk_Screen(other) != Tk_Screen(tkwin)) {
+ Tcl_AppendResult(interp, "can't use colormap for ", string,
+ ": not on same screen", (char *) NULL);
+ return None;
+ }
+ if (Tk_Visual(other) != Tk_Visual(tkwin)) {
+ Tcl_AppendResult(interp, "can't use colormap for ", string,
+ ": incompatible visuals", (char *) NULL);
+ return None;
+ }
+ colormap = Tk_Colormap(other);
+
+ /*
+ * If the colormap was a special one allocated by code in this file,
+ * increment its reference count.
+ */
+
+ for (cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL;
+ cmapPtr = cmapPtr->nextPtr) {
+ if (cmapPtr->colormap == colormap) {
+ cmapPtr->refCount += 1;
+ }
+ }
+ return colormap;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeColormap --
+ *
+ * This procedure is called to release a colormap that was
+ * previously allocated by Tk_GetColormap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The colormap's reference count is decremented. If this was the
+ * last reference to the colormap, then the colormap is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeColormap(display, colormap)
+ Display *display; /* Display for which colormap was
+ * allocated. */
+ Colormap colormap; /* Colormap that is no longer needed.
+ * Must have been returned by previous
+ * call to Tk_GetColormap, or
+ * preserved by a previous call to
+ * Tk_PreserveColormap. */
+{
+ TkDisplay *dispPtr;
+ TkColormap *cmapPtr, *prevPtr;
+
+ /*
+ * Find Tk's information about the display, then see if this
+ * colormap is a non-default one (if it's a default one, there
+ * won't be an entry for it in the display's list).
+ */
+
+ dispPtr = TkGetDisplay(display);
+ if (dispPtr == NULL) {
+ panic("unknown display passed to Tk_FreeColormap");
+ }
+ for (prevPtr = NULL, cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL;
+ prevPtr = cmapPtr, cmapPtr = cmapPtr->nextPtr) {
+ if (cmapPtr->colormap == colormap) {
+ cmapPtr->refCount -= 1;
+ if (cmapPtr->refCount == 0) {
+ XFreeColormap(display, colormap);
+ if (prevPtr == NULL) {
+ dispPtr->cmapPtr = cmapPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = cmapPtr->nextPtr;
+ }
+ ckfree((char *) cmapPtr);
+ }
+ return;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PreserveColormap --
+ *
+ * This procedure is called to indicate to Tk that the specified
+ * colormap is being referenced from another location and should
+ * not be freed until all extra references are eliminated. The
+ * colormap must have been returned by Tk_GetColormap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The colormap's reference count is incremented, so
+ * Tk_FreeColormap must eventually be called exactly once for
+ * each call to Tk_PreserveColormap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PreserveColormap(display, colormap)
+ Display *display; /* Display for which colormap was
+ * allocated. */
+ Colormap colormap; /* Colormap that should be
+ * preserved. */
+{
+ TkDisplay *dispPtr;
+ TkColormap *cmapPtr;
+
+ /*
+ * Find Tk's information about the display, then see if this
+ * colormap is a non-default one (if it's a default one, there
+ * won't be an entry for it in the display's list).
+ */
+
+ dispPtr = TkGetDisplay(display);
+ if (dispPtr == NULL) {
+ panic("unknown display passed to Tk_PreserveColormap");
+ }
+ for (cmapPtr = dispPtr->cmapPtr; cmapPtr != NULL;
+ cmapPtr = cmapPtr->nextPtr) {
+ if (cmapPtr->colormap == colormap) {
+ cmapPtr->refCount += 1;
+ return;
+ }
+ }
+}
diff --git a/tk/generic/tkWindow.c b/tk/generic/tkWindow.c
new file mode 100644
index 00000000000..2da31fd6e2d
--- /dev/null
+++ b/tk/generic/tkWindow.c
@@ -0,0 +1,2836 @@
+/*
+ * tkWindow.c --
+ *
+ * This file provides basic window-manipulation procedures,
+ * which are equivalent to procedures in Xlib (and even
+ * invoke them) but also maintain the local Tk_Window
+ * structure.
+ *
+ * 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$
+ */
+
+#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.
+ */
+
+static XWindowChanges defChanges = {
+ 0, 0, 1, 1, 0, 0, Above
+};
+#define ALL_EVENTS_MASK \
+ KeyPressMask|KeyReleaseMask|ButtonPressMask|ButtonReleaseMask| \
+ EnterWindowMask|LeaveWindowMask|PointerMotionMask|ExposureMask| \
+ VisibilityChangeMask|PropertyChangeMask|ColormapChangeMask
+static XSetWindowAttributes defAtts= {
+ None, /* background_pixmap */
+ 0, /* background_pixel */
+ CopyFromParent, /* border_pixmap */
+ 0, /* border_pixel */
+ NorthWestGravity, /* bit_gravity */
+ NorthWestGravity, /* win_gravity */
+ NotUseful, /* backing_store */
+ (unsigned) ~0, /* backing_planes */
+ 0, /* backing_pixel */
+ False, /* save_under */
+ ALL_EVENTS_MASK, /* event_mask */
+ 0, /* do_not_propagate_mask */
+ False, /* override_redirect */
+ CopyFromParent, /* colormap */
+ None /* cursor */
+};
+
+/*
+ * The following structure defines all of the commands supported by
+ * Tk, and the C procedures that execute them.
+ */
+
+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", NULL, Tk_BellObjCmd, 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", NULL, Tk_ImageCmd, 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;
+static char *display = NULL;
+static char *geometry = NULL;
+static char *colormap = NULL;
+static char *use = NULL;
+static char *visual = NULL;
+static int rest = 0;
+
+static Tk_ArgvInfo argTable[] = {
+ {"-colormap", TK_ARGV_STRING, (char *) NULL, (char *) &colormap,
+ "Colormap for main window"},
+ {"-display", TK_ARGV_STRING, (char *) NULL, (char *) &display,
+ "Display to use"},
+ {"-geometry", TK_ARGV_STRING, (char *) NULL, (char *) &geometry,
+ "Initial geometry for window"},
+ {"-name", TK_ARGV_STRING, (char *) NULL, (char *) &name,
+ "Name to use for application"},
+ {"-sync", TK_ARGV_CONSTANT, (char *) 1, (char *) &synchronize,
+ "Use synchronous mode for display server"},
+ {"-visual", TK_ARGV_STRING, (char *) NULL, (char *) &visual,
+ "Visual for main window"},
+ {"-use", TK_ARGV_STRING, (char *) NULL, (char *) &use,
+ "Id of window in which to embed application"},
+ {"--", TK_ARGV_REST, (char *) 1, (char *) &rest,
+ "Pass all remaining arguments through to script"},
+ {(char *) NULL, TK_ARGV_END, (char *) NULL, (char *) NULL,
+ (char *) NULL}
+};
+
+/*
+ * Forward declarations to procedures defined later in this file:
+ */
+
+static Tk_Window CreateTopLevelWindow _ANSI_ARGS_((Tcl_Interp *interp,
+ Tk_Window parent, char *name, char *screenName));
+static void DeleteWindowsExitProc _ANSI_ARGS_((
+ ClientData clientData));
+static TkDisplay * GetScreen _ANSI_ARGS_((Tcl_Interp *interp,
+ char *screenName, int *screenPtr));
+static int Initialize _ANSI_ARGS_((Tcl_Interp *interp));
+static int NameWindow _ANSI_ARGS_((Tcl_Interp *interp,
+ TkWindow *winPtr, TkWindow *parentPtr,
+ char *name));
+static void OpenIM _ANSI_ARGS_((TkDisplay *dispPtr));
+static void UnlinkWindow _ANSI_ARGS_((TkWindow *winPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateTopLevelWindow --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_Window
+CreateTopLevelWindow(interp, parent, name, screenName)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ Tk_Window parent; /* Token for logical parent of new window
+ * (used for naming, options, etc.). May
+ * be NULL. */
+ char *name; /* Name for new window; if parent is
+ * non-NULL, must be unique among parent's
+ * children. */
+ char *screenName; /* Name of screen on which to create
+ * window. NULL means use DISPLAY environment
+ * 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);
+
+ /*
+ * Create built-in photo image formats.
+ */
+
+ Tk_CreatePhotoImageFormat(&tkImgFmtGIF);
+ Tk_CreatePhotoImageFormat(&tkImgFmtPPM);
+
+ /*
+ * Create exit handler to delete all windows when the application
+ * exits.
+ */
+
+ Tcl_CreateExitHandler(DeleteWindowsExitProc, (ClientData) NULL);
+ }
+
+ if ((parent != NULL) && (screenName != NULL) && (screenName[0] == '\0')) {
+ dispPtr = ((TkWindow *) parent)->dispPtr;
+ screenId = Tk_ScreenNumber(parent);
+ } else {
+ dispPtr = GetScreen(interp, screenName, &screenId);
+ if (dispPtr == NULL) {
+ return (Tk_Window) NULL;
+ }
+ }
+
+ winPtr = TkAllocWindow(dispPtr, screenId, (TkWindow *) parent);
+
+ /*
+ * Force the window to use a border pixel instead of border pixmap.
+ * This is needed for the case where the window doesn't use the
+ * default visual. In this case, the default border is a pixmap
+ * inherited from the root window, which won't work because it will
+ * have the wrong visual.
+ */
+
+ winPtr->dirtyAtts |= CWBorderPixel;
+
+ /*
+ * (Need to set the TK_TOP_LEVEL flag immediately here; otherwise
+ * Tk_DestroyWindow will core dump if it is called before the flag
+ * has been set.)
+ */
+
+ winPtr->flags |= TK_TOP_LEVEL;
+
+ if (parent != NULL) {
+ if (NameWindow(interp, winPtr, (TkWindow *) parent, name) != TCL_OK) {
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ return (Tk_Window) NULL;
+ }
+ }
+ TkWmNewWindow(winPtr);
+
+ return (Tk_Window) winPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetScreen --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static TkDisplay *
+GetScreen(interp, screenName, screenPtr)
+ Tcl_Interp *interp; /* Place to leave error message. */
+ char *screenName; /* Name for screen. NULL or empty means
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetDisplay --
+ *
+ * Given an X display, TkGetDisplay returns the TkDisplay
+ * structure for the display.
+ *
+ * Results:
+ * The return value is a pointer to information about the display,
+ * or NULL if the display did not have a TkDisplay structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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.
+ *
+ * Results:
+ * The return value is a pointer to the new window.
+ *
+ * Side effects:
+ * A new window structure is allocated and all its fields are
+ * initialized.
+ *
+ *--------------------------------------------------------------
+ */
+
+TkWindow *
+TkAllocWindow(dispPtr, screenNum, parentPtr)
+ TkDisplay *dispPtr; /* Display associated with new window. */
+ int screenNum; /* Index of screen for new window. */
+ TkWindow *parentPtr; /* Parent from which this window should
+ * inherit visual information. NULL means
+ * use screen defaults instead of
+ * inheriting. */
+{
+ register TkWindow *winPtr;
+
+ winPtr = (TkWindow *) ckalloc(sizeof(TkWindow));
+ winPtr->display = dispPtr->display;
+ winPtr->dispPtr = dispPtr;
+ winPtr->screenNum = screenNum;
+ if ((parentPtr != NULL) && (parentPtr->display == winPtr->display)
+ && (parentPtr->screenNum == winPtr->screenNum)) {
+ winPtr->visual = parentPtr->visual;
+ winPtr->depth = parentPtr->depth;
+ } else {
+ winPtr->visual = DefaultVisual(dispPtr->display, screenNum);
+ winPtr->depth = DefaultDepth(dispPtr->display, screenNum);
+ }
+ winPtr->window = None;
+ winPtr->childList = NULL;
+ winPtr->lastChildPtr = NULL;
+ winPtr->parentPtr = NULL;
+ winPtr->nextPtr = NULL;
+ winPtr->mainPtr = NULL;
+ winPtr->pathName = NULL;
+ winPtr->nameUid = NULL;
+ winPtr->classUid = NULL;
+ winPtr->changes = defChanges;
+ winPtr->dirtyChanges = CWX|CWY|CWWidth|CWHeight|CWBorderWidth;
+ winPtr->atts = defAtts;
+ if ((parentPtr != NULL) && (parentPtr->display == winPtr->display)
+ && (parentPtr->screenNum == winPtr->screenNum)) {
+ winPtr->atts.colormap = parentPtr->atts.colormap;
+ } else {
+ winPtr->atts.colormap = DefaultColormap(dispPtr->display, screenNum);
+ }
+ winPtr->dirtyAtts = CWEventMask|CWColormap|CWBitGravity;
+ winPtr->flags = 0;
+ winPtr->handlerList = NULL;
+#ifdef TK_USE_INPUT_METHODS
+ winPtr->inputContext = NULL;
+#endif /* TK_USE_INPUT_METHODS */
+ winPtr->tagPtr = NULL;
+ winPtr->numTags = 0;
+ winPtr->optionLevel = -1;
+ winPtr->selHandlerList = NULL;
+ winPtr->geomMgrPtr = NULL;
+ winPtr->geomData = NULL;
+ winPtr->reqWidth = winPtr->reqHeight = 1;
+ winPtr->internalBorderWidth = 0;
+ winPtr->wmInfoPtr = NULL;
+ winPtr->classProcsPtr = NULL;
+ winPtr->instanceData = NULL;
+ winPtr->privatePtr = NULL;
+
+ return winPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NameWindow --
+ *
+ * This procedure is invoked to give a window a name and insert
+ * the window into the hierarchy associated with a particular
+ * application.
+ *
+ * Results:
+ * A standard Tcl return value.
+ *
+ * Side effects:
+ * See above.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+NameWindow(interp, winPtr, parentPtr, name)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ register TkWindow *winPtr; /* Window that is to be named and inserted. */
+ TkWindow *parentPtr; /* Pointer to logical parent for winPtr
+ * (used for naming, options, etc.). */
+ char *name; /* Name for winPtr; must be unique among
+ * parentPtr's children. */
+{
+#define FIXED_SIZE 200
+ char staticSpace[FIXED_SIZE];
+ char *pathName;
+ int new;
+ Tcl_HashEntry *hPtr;
+ int length1, length2;
+
+ /*
+ * Setup all the stuff except name right away, then do the name stuff
+ * last. This is so that if the name stuff fails, everything else
+ * will be properly initialized (needed to destroy the window cleanly
+ * after the naming failure).
+ */
+ winPtr->parentPtr = parentPtr;
+ winPtr->nextPtr = NULL;
+ if (parentPtr->childList == NULL) {
+ parentPtr->childList = winPtr;
+ } else {
+ parentPtr->lastChildPtr->nextPtr = winPtr;
+ }
+ parentPtr->lastChildPtr = winPtr;
+ winPtr->mainPtr = parentPtr->mainPtr;
+ winPtr->mainPtr->refCount++;
+ winPtr->nameUid = Tk_GetUid(name);
+
+ /*
+ * Don't permit names that start with an upper-case letter: this
+ * will just cause confusion with class names in the option database.
+ */
+
+ if (isupper(UCHAR(name[0]))) {
+ Tcl_AppendResult(interp,
+ "window name starts with an upper-case letter: \"",
+ name, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * To permit names of arbitrary length, must be prepared to malloc
+ * a buffer to hold the new path name. To run fast in the common
+ * case where names are short, use a fixed-size buffer on the
+ * stack.
+ */
+
+ length1 = strlen(parentPtr->pathName);
+ length2 = strlen(name);
+ if ((length1+length2+2) <= FIXED_SIZE) {
+ pathName = staticSpace;
+ } else {
+ pathName = (char *) ckalloc((unsigned) (length1+length2+2));
+ }
+ if (length1 == 1) {
+ pathName[0] = '.';
+ strcpy(pathName+1, name);
+ } else {
+ strcpy(pathName, parentPtr->pathName);
+ pathName[length1] = '.';
+ strcpy(pathName+length1+1, name);
+ }
+ hPtr = Tcl_CreateHashEntry(&parentPtr->mainPtr->nameTable, pathName, &new);
+ if (pathName != staticSpace) {
+ ckfree(pathName);
+ }
+ if (!new) {
+ Tcl_AppendResult(interp, "window name \"", name,
+ "\" already exists in parent", (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tcl_SetHashValue(hPtr, winPtr);
+ winPtr->pathName = Tcl_GetHashKey(&parentPtr->mainPtr->nameTable, hPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCreateMainWindow --
+ *
+ * Make a new main window. A main window is a special kind of
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+TkCreateMainWindow(interp, screenName, baseName)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ char *screenName; /* Name of screen on which to create
+ * window. Empty or NULL string means
+ * use DISPLAY environment variable. */
+ char *baseName; /* Base name for application; usually of the
+ * form "prog instance". */
+{
+ 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)) {
+ panic("TkWindow and Tk_FakeWin are not the same size");
+ }
+
+ /*
+ * Create the basic TkWindow structure.
+ */
+
+ tkwin = CreateTopLevelWindow(interp, (Tk_Window) NULL, baseName,
+ screenName);
+ if (tkwin == NULL) {
+ return NULL;
+ }
+
+ /*
+ * Create the TkMainInfo structure for this application, and set
+ * up name-related information for the new window.
+ */
+
+ 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
+ * on the display pointer.
+ */
+
+ winPtr->dispPtr->refCount++;
+
+ /*
+ * Register the interpreter for "send" purposes.
+ */
+
+ winPtr->nameUid = Tk_GetUid(Tk_SetAppName(tkwin, baseName));
+
+ /*
+ * Bind in Tk's commands.
+ */
+
+ 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
+ * new window; window will be a top-level
+ * window. */
+{
+ TkWindow *parentPtr = (TkWindow *) parent;
+ TkWindow *winPtr;
+
+ if ((parentPtr != NULL) && (parentPtr->flags & TK_ALREADY_DEAD)) {
+ Tcl_AppendResult(interp,
+ "can't create window: parent has been destroyed",
+ (char *) NULL);
+ return NULL;
+ } else if ((parentPtr != NULL) &&
+ (parentPtr->flags & TK_CONTAINER)) {
+ Tcl_AppendResult(interp,
+ "can't create window: its parent has -container = yes",
+ (char *) NULL);
+ return NULL;
+ }
+ if (screenName == NULL) {
+ winPtr = TkAllocWindow(parentPtr->dispPtr, parentPtr->screenNum,
+ parentPtr);
+ if (NameWindow(interp, winPtr, parentPtr, name) != TCL_OK) {
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ return NULL;
+ } else {
+ return (Tk_Window) winPtr;
+ }
+ } else {
+ return CreateTopLevelWindow(interp, parent, name, screenName);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CreateWindowFromPath --
+ *
+ * This procedure is similar to Tk_CreateWindow except that
+ * 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. */
+ char *screenName; /* If NULL, new window will be on same
+ * screen as its parent. If non-NULL,
+ * gives name of screen on which to create
+ * new window; window will be a top-level
+ * window. */
+{
+#define FIXED_SPACE 5
+ char fixedSpace[FIXED_SPACE+1];
+ char *p;
+ Tk_Window parent;
+ int numChars;
+
+ /*
+ * Strip the parent's name out of pathName (it's everything up
+ * to the last dot). There are two tricky parts: (a) must
+ * copy the parent's name somewhere else to avoid modifying
+ * the pathName string (for large names, space for the copy
+ * will have to be malloc'ed); (b) must special-case the
+ * situation where the parent is ".".
+ */
+
+ p = strrchr(pathName, '.');
+ if (p == NULL) {
+ Tcl_AppendResult(interp, "bad window path name \"", pathName,
+ "\"", (char *) NULL);
+ return NULL;
+ }
+ numChars = p-pathName;
+ if (numChars > FIXED_SPACE) {
+ p = (char *) ckalloc((unsigned) (numChars+1));
+ } else {
+ p = fixedSpace;
+ }
+ if (numChars == 0) {
+ *p = '.';
+ p[1] = '\0';
+ } else {
+ strncpy(p, pathName, (size_t) numChars);
+ p[numChars] = '\0';
+ }
+
+ /*
+ * Find the parent window.
+ */
+
+ parent = Tk_NameToWindow(interp, p, tkwin);
+ if (p != fixedSpace) {
+ ckfree(p);
+ }
+ if (parent == NULL) {
+ return NULL;
+ }
+ if (((TkWindow *) parent)->flags & TK_ALREADY_DEAD) {
+ Tcl_AppendResult(interp,
+ "can't create window: parent has been destroyed", (char *) NULL);
+ return NULL;
+ } else if (((TkWindow *) parent)->flags & TK_CONTAINER) {
+ Tcl_AppendResult(interp,
+ "can't create window: its parent has -container = yes",
+ (char *) NULL);
+ return NULL;
+ }
+
+ /*
+ * Create the window.
+ */
+
+ if (screenName == NULL) {
+ TkWindow *parentPtr = (TkWindow *) parent;
+ TkWindow *winPtr;
+
+ winPtr = TkAllocWindow(parentPtr->dispPtr, parentPtr->screenNum,
+ parentPtr);
+ if (NameWindow(interp, winPtr, parentPtr, pathName+numChars+1)
+ != TCL_OK) {
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ return NULL;
+ } else {
+ return (Tk_Window) winPtr;
+ }
+ } else {
+ return CreateTopLevelWindow(interp, parent, pathName+numChars+1,
+ screenName);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_DestroyWindow --
+ *
+ * Destroy an existing window. After this call, the caller
+ * should never again use the token.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is deleted, along with all of its children.
+ * Relevant callback procedures are invoked.
+ *
+ *--------------------------------------------------------------
+ */
+
+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.
+ */
+
+ return;
+ }
+ winPtr->flags |= TK_ALREADY_DEAD;
+
+ /*
+ * Some cleanup needs to be done immediately, rather than later,
+ * because it needs information that will be destoyed before we
+ * get to the main cleanup point. For example, TkFocusDeadWindow
+ * needs to access the parentPtr field from a window, but if
+ * a Destroy event handler deletes the window's parent this
+ * field will be NULL before the main cleanup point is reached.
+ */
+
+ TkFocusDeadWindow(winPtr);
+
+ /*
+ * If this is a main window, remove it from the list of main
+ * windows. This needs to be done now (rather than later with
+ * all the other main window cleanup) to handle situations where
+ * a destroy binding for a window calls "exit". In this case
+ * the child window cleanup isn't complete when exit is called,
+ * so the reference count of its application doesn't go to zero
+ * when exit calls Tk_DestroyWindow on ".", so the main window
+ * doesn't get removed from the list and exit loops infinitely.
+ * Even worse, if "destroy ." is called by the destroy binding
+ * before calling "exit", "exit" will attempt to destroy
+ * mainPtr->winPtr, which no longer exists, and there may be a
+ * core dump.
+ *
+ * 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++;
+ while (winPtr->childList != NULL) {
+ TkWindow *childPtr;
+ childPtr = winPtr->childList;
+ childPtr->flags |= TK_DONT_DESTROY_WINDOW;
+ Tk_DestroyWindow((Tk_Window) childPtr);
+ if (winPtr->childList == childPtr) {
+ /*
+ * The child didn't remove itself from the child list, so
+ * let's remove it here. This can happen in some strange
+ * conditions, such as when a Delete event handler for a
+ * window deletes the window's parent.
+ */
+
+ winPtr->childList = childPtr->nextPtr;
+ childPtr->parentPtr = NULL;
+ }
+ }
+ if ((winPtr->flags & (TK_CONTAINER|TK_BOTH_HALVES))
+ == (TK_CONTAINER|TK_BOTH_HALVES)) {
+ /*
+ * This is the container for an embedded application, and
+ * the embedded application is also in this process. Delete
+ * the embedded window in-line here, for the same reasons we
+ * delete children in-line (otherwise, for example, the Tk
+ * window may appear to exist even though its X window is
+ * gone; this could cause errors). Special note: it's possible
+ * that the embedded window has already been deleted, in which
+ * case TkpGetOtherWindow will return NULL.
+ */
+
+ TkWindow *childPtr;
+ childPtr = TkpGetOtherWindow(winPtr);
+ if (childPtr != NULL) {
+ childPtr->flags |= TK_DONT_DESTROY_WINDOW;
+ Tk_DestroyWindow((Tk_Window) childPtr);
+ }
+ }
+
+ /*
+ * Generate a DestroyNotify event. In order for the DestroyNotify
+ * event to be processed correctly, need to make sure the window
+ * exists. This is a bit of a kludge, and may be unnecessarily
+ * expensive, but without it no event handlers will get called for
+ * windows that don't exist yet.
+ *
+ * Note: if the window's pathName is NULL it means that the window
+ * was not successfully initialized in the first place, so we should
+ * not make the window exist or generate the event.
+ */
+
+ if (winPtr->pathName != NULL) {
+ if (winPtr->window == None) {
+ Tk_MakeWindowExist(tkwin);
+ }
+ event.type = DestroyNotify;
+ event.xdestroywindow.serial =
+ LastKnownRequestProcessed(winPtr->display);
+ event.xdestroywindow.send_event = False;
+ event.xdestroywindow.display = winPtr->display;
+ event.xdestroywindow.event = winPtr->window;
+ event.xdestroywindow.window = winPtr->window;
+ Tk_HandleEvent(&event);
+ }
+
+ /*
+ * Cleanup the data structures associated with this window.
+ */
+
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ TkWmDeadWindow(winPtr);
+ } else if (winPtr->flags & TK_WM_COLORMAP_WINDOW) {
+ TkWmRemoveFromColormapWindows(winPtr);
+ }
+ if (winPtr->window != None) {
+#if defined(MAC_TCL) || defined(__WIN32__)
+ XDestroyWindow(winPtr->display, winPtr->window);
+#else
+ if ((winPtr->flags & TK_TOP_LEVEL)
+ || !(winPtr->flags & TK_DONT_DESTROY_WINDOW)) {
+ /*
+ * The parent has already been destroyed and this isn't
+ * a top-level window, so this window will be destroyed
+ * implicitly when the parent's X window is destroyed;
+ * it's much faster not to do an explicit destroy of this
+ * X window.
+ */
+
+ dispPtr->lastDestroyRequest = NextRequest(winPtr->display);
+ XDestroyWindow(winPtr->display, winPtr->window);
+ }
+#endif
+ TkFreeWindowId(dispPtr, winPtr->window);
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&dispPtr->winTable,
+ (char *) winPtr->window));
+ winPtr->window = None;
+ }
+ dispPtr->destroyCount--;
+ UnlinkWindow(winPtr);
+ TkEventDeadWindow(winPtr);
+ TkBindDeadWindow(winPtr);
+#ifdef TK_USE_INPUT_METHODS
+ if (winPtr->inputContext != NULL) {
+ XDestroyIC(winPtr->inputContext);
+ }
+#endif /* TK_USE_INPUT_METHODS */
+ if (winPtr->tagPtr != NULL) {
+ TkFreeBindingTags(winPtr);
+ }
+ TkOptionDeadWindow(winPtr);
+ TkSelDeadWindow(winPtr);
+ TkGrabDeadWindow(winPtr);
+ if (winPtr->mainPtr != NULL) {
+ if (winPtr->pathName != NULL) {
+ Tk_DeleteAllBindings(winPtr->mainPtr->bindingTable,
+ (ClientData) winPtr->pathName);
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&winPtr->mainPtr->nameTable,
+ winPtr->pathName));
+ }
+ winPtr->mainPtr->refCount--;
+ if (winPtr->mainPtr->refCount == 0) {
+ register TkCmd *cmdPtr;
+
+ /*
+ * We just deleted the last window in the application. Delete
+ * the TkMainInfo structure too and replace all of Tk's commands
+ * with dummy commands that return errors. Also delete the
+ * "send" command to unregister the interpreter.
+ *
+ * NOTE: Only replace the commands it if the interpreter is
+ * not being deleted. If it *is*, the interpreter cleanup will
+ * do all the needed work.
+ */
+
+ if ((winPtr->mainPtr->interp != NULL) &&
+ (!Tcl_InterpDeleted(winPtr->mainPtr->interp))) {
+ for (cmdPtr = commands; cmdPtr->name != NULL; cmdPtr++) {
+ Tcl_CreateCommand(winPtr->mainPtr->interp, cmdPtr->name,
+ TkDeadAppCmd, (ClientData) NULL,
+ (void (*) _ANSI_ARGS_((ClientData))) NULL);
+ }
+ Tcl_CreateCommand(winPtr->mainPtr->interp, "send",
+ 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
+ */
+
+ if (winPtr->flags & TK_EMBEDDED) {
+ XSync(winPtr->display,False) ;
+ }
+ ckfree((char *) winPtr->mainPtr);
+
+ /*
+ * If no other applications are using the display, close the
+ * display now and relinquish its data structures.
+ */
+
+ if (dispPtr->refCount <= 0) {
+#ifdef NOT_YET
+ /*
+ * I have disabled this code because on Windows there are
+ * still order dependencies in close-down. All displays
+ * and resources will get closed down properly anyway at
+ * exit, through the exit handler.
+ */
+
+ 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.
+ */
+
+ if (dispPtr->name != NULL) {
+ ckfree(dispPtr->name);
+ }
+
+ Tcl_DeleteHashTable(&(dispPtr->winTable));
+
+ /*
+ * Cannot yet close the display because we still have
+ * order of deletion problems. Defer until exit handling
+ * instead. At that time, the display will cleanly shut
+ * down (hopefully..). (JYL)
+ */
+
+ TkpCloseDisplay(dispPtr);
+
+ /*
+ * There is lots more to clean up, we leave it at this for
+ * the time being.
+ */
+#endif
+ }
+ }
+ }
+ ckfree((char *) winPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MapWindow --
+ *
+ * Map a window within its parent. This may require the
+ * window and/or its parents to actually be created.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The given window will be mapped. Windows may also
+ * be created.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_MapWindow(tkwin)
+ Tk_Window tkwin; /* Token for window to map. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ XEvent event;
+
+ if (winPtr->flags & TK_MAPPED) {
+ return;
+ }
+ if (winPtr->window == None) {
+ Tk_MakeWindowExist(tkwin);
+ }
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ /*
+ * Lots of special processing has to be done for top-level
+ * windows. Let tkWm.c handle everything itself.
+ */
+
+ TkWmMapWindow(winPtr);
+ return;
+ }
+ winPtr->flags |= TK_MAPPED;
+ XMapWindow(winPtr->display, winPtr->window);
+ event.type = MapNotify;
+ event.xmap.serial = LastKnownRequestProcessed(winPtr->display);
+ event.xmap.send_event = False;
+ event.xmap.display = winPtr->display;
+ event.xmap.event = winPtr->window;
+ event.xmap.window = winPtr->window;
+ event.xmap.override_redirect = winPtr->atts.override_redirect;
+ Tk_HandleEvent(&event);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_MakeWindowExist --
+ *
+ * Ensure that a particular window actually exists. This
+ * procedure shouldn't normally need to be invoked from
+ * outside the Tk package, but may be needed if someone
+ * wants to manipulate a window before mapping it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the procedure returns, the X window associated with
+ * tkwin is guaranteed to exist. This may require the
+ * window's ancestors to be created also.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_MakeWindowExist(tkwin)
+ Tk_Window tkwin; /* Token for window. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ TkWindow *winPtr2;
+ Window parent;
+ Tcl_HashEntry *hPtr;
+ int new;
+
+ if (winPtr->window != None) {
+ return;
+ }
+
+ if ((winPtr->parentPtr == NULL) || (winPtr->flags & TK_TOP_LEVEL)) {
+ parent = XRootWindow(winPtr->display, winPtr->screenNum);
+ } else {
+ if (winPtr->parentPtr->window == None) {
+ Tk_MakeWindowExist((Tk_Window) winPtr->parentPtr);
+ }
+ parent = winPtr->parentPtr->window;
+ }
+
+ if (winPtr->classProcsPtr != NULL
+ && winPtr->classProcsPtr->createProc != NULL) {
+ winPtr->window = (*winPtr->classProcsPtr->createProc)(tkwin, parent,
+ winPtr->instanceData);
+ } else {
+ winPtr->window = TkpMakeWindow(winPtr, parent);
+ }
+
+ hPtr = Tcl_CreateHashEntry(&winPtr->dispPtr->winTable,
+ (char *) winPtr->window, &new);
+ Tcl_SetHashValue(hPtr, winPtr);
+ winPtr->dirtyAtts = 0;
+ winPtr->dirtyChanges = 0;
+#ifdef TK_USE_INPUT_METHODS
+ winPtr->inputContext = NULL;
+#endif /* TK_USE_INPUT_METHODS */
+
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ /*
+ * If any siblings higher up in the stacking order have already
+ * been created then move this window to its rightful position
+ * in the stacking order.
+ *
+ * NOTE: this code ignores any changes anyone might have made
+ * to the sibling and stack_mode field of the window's attributes,
+ * so it really isn't safe for these to be manipulated except
+ * by calling Tk_RestackWindow.
+ */
+
+ for (winPtr2 = winPtr->nextPtr; winPtr2 != NULL;
+ winPtr2 = winPtr2->nextPtr) {
+ if ((winPtr2->window != None)
+ && !(winPtr2->flags & (TK_TOP_LEVEL|TK_REPARENTED))) {
+ XWindowChanges changes;
+ changes.sibling = winPtr2->window;
+ changes.stack_mode = Below;
+ XConfigureWindow(winPtr->display, winPtr->window,
+ CWSibling|CWStackMode, &changes);
+ break;
+ }
+ }
+
+ /*
+ * If this window has a different colormap than its parent, add
+ * the window to the WM_COLORMAP_WINDOWS property for its top-level.
+ */
+
+ if ((winPtr->parentPtr != NULL) &&
+ (winPtr->atts.colormap != winPtr->parentPtr->atts.colormap)) {
+ TkWmAddToColormapWindows(winPtr);
+ winPtr->flags |= TK_WM_COLORMAP_WINDOW;
+ }
+ }
+
+ /*
+ * Issue a ConfigureNotify event if there were deferred configuration
+ * changes (but skip it if the window is being deleted; the
+ * ConfigureNotify event could cause problems if we're being called
+ * from Tk_DestroyWindow under some conditions).
+ */
+
+ if ((winPtr->flags & TK_NEED_CONFIG_NOTIFY)
+ && !(winPtr->flags & TK_ALREADY_DEAD)){
+ winPtr->flags &= ~TK_NEED_CONFIG_NOTIFY;
+ TkDoConfigureNotify(winPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_UnmapWindow, etc. --
+ *
+ * There are several procedures under here, each of which
+ * mirrors an existing X procedure. In addition to performing
+ * the functions of the corresponding procedure, each
+ * procedure also updates the local window structure and
+ * synthesizes an X event (if the window's structure is being
+ * managed internally).
+ *
+ * Results:
+ * See the manual entries.
+ *
+ * Side effects:
+ * See the manual entries.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_UnmapWindow(tkwin)
+ Tk_Window tkwin; /* Token for window to unmap. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (!(winPtr->flags & TK_MAPPED) || (winPtr->flags & TK_ALREADY_DEAD)) {
+ return;
+ }
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ /*
+ * Special processing has to be done for top-level windows. Let
+ * tkWm.c handle everything itself.
+ */
+
+ TkWmUnmapWindow(winPtr);
+ return;
+ }
+ winPtr->flags &= ~TK_MAPPED;
+ XUnmapWindow(winPtr->display, winPtr->window);
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ XEvent event;
+
+ event.type = UnmapNotify;
+ event.xunmap.serial = LastKnownRequestProcessed(winPtr->display);
+ event.xunmap.send_event = False;
+ event.xunmap.display = winPtr->display;
+ event.xunmap.event = winPtr->window;
+ event.xunmap.window = winPtr->window;
+ event.xunmap.from_configure = False;
+ Tk_HandleEvent(&event);
+ }
+}
+
+void
+Tk_ConfigureWindow(tkwin, valueMask, valuePtr)
+ Tk_Window tkwin; /* Window to re-configure. */
+ unsigned int valueMask; /* Mask indicating which parts of
+ * *valuePtr are to be used. */
+ XWindowChanges *valuePtr; /* New values. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (valueMask & CWX) {
+ winPtr->changes.x = valuePtr->x;
+ }
+ if (valueMask & CWY) {
+ winPtr->changes.y = valuePtr->y;
+ }
+ if (valueMask & CWWidth) {
+ winPtr->changes.width = valuePtr->width;
+ }
+ if (valueMask & CWHeight) {
+ winPtr->changes.height = valuePtr->height;
+ }
+ if (valueMask & CWBorderWidth) {
+ winPtr->changes.border_width = valuePtr->border_width;
+ }
+ if (valueMask & (CWSibling|CWStackMode)) {
+ panic("Can't set sibling or stack mode from Tk_ConfigureWindow.");
+ }
+
+ if (winPtr->window != None) {
+ XConfigureWindow(winPtr->display, winPtr->window,
+ valueMask, valuePtr);
+ TkDoConfigureNotify(winPtr);
+ } else {
+ winPtr->dirtyChanges |= valueMask;
+ winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
+ }
+}
+
+void
+Tk_MoveWindow(tkwin, x, y)
+ Tk_Window tkwin; /* Window to move. */
+ int x, y; /* New location for window (within
+ * parent). */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->changes.x = x;
+ winPtr->changes.y = y;
+ if (winPtr->window != None) {
+ XMoveWindow(winPtr->display, winPtr->window, x, y);
+ TkDoConfigureNotify(winPtr);
+ } else {
+ winPtr->dirtyChanges |= CWX|CWY;
+ winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
+ }
+}
+
+void
+Tk_ResizeWindow(tkwin, width, height)
+ Tk_Window tkwin; /* Window to resize. */
+ int width, height; /* New dimensions for window. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->changes.width = (unsigned) width;
+ winPtr->changes.height = (unsigned) height;
+ if (winPtr->window != None) {
+ XResizeWindow(winPtr->display, winPtr->window, (unsigned) width,
+ (unsigned) height);
+ TkDoConfigureNotify(winPtr);
+ } else {
+ winPtr->dirtyChanges |= CWWidth|CWHeight;
+ winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
+ }
+}
+
+void
+Tk_MoveResizeWindow(tkwin, x, y, width, height)
+ Tk_Window tkwin; /* Window to move and resize. */
+ int x, y; /* New location for window (within
+ * parent). */
+ int width, height; /* New dimensions for window. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->changes.x = x;
+ winPtr->changes.y = y;
+ winPtr->changes.width = (unsigned) width;
+ winPtr->changes.height = (unsigned) height;
+ if (winPtr->window != None) {
+ XMoveResizeWindow(winPtr->display, winPtr->window, x, y,
+ (unsigned) width, (unsigned) height);
+ TkDoConfigureNotify(winPtr);
+ } else {
+ winPtr->dirtyChanges |= CWX|CWY|CWWidth|CWHeight;
+ winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
+ }
+}
+
+void
+Tk_SetWindowBorderWidth(tkwin, width)
+ Tk_Window tkwin; /* Window to modify. */
+ int width; /* New border width for window. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->changes.border_width = width;
+ if (winPtr->window != None) {
+ XSetWindowBorderWidth(winPtr->display, winPtr->window,
+ (unsigned) width);
+ TkDoConfigureNotify(winPtr);
+ } else {
+ winPtr->dirtyChanges |= CWBorderWidth;
+ winPtr->flags |= TK_NEED_CONFIG_NOTIFY;
+ }
+}
+
+void
+Tk_ChangeWindowAttributes(tkwin, valueMask, attsPtr)
+ Tk_Window tkwin; /* Window to manipulate. */
+ unsigned long valueMask; /* OR'ed combination of bits,
+ * indicating which fields of
+ * *attsPtr are to be used. */
+ register XSetWindowAttributes *attsPtr;
+ /* New values for some attributes. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (valueMask & CWBackPixmap) {
+ winPtr->atts.background_pixmap = attsPtr->background_pixmap;
+ }
+ if (valueMask & CWBackPixel) {
+ winPtr->atts.background_pixel = attsPtr->background_pixel;
+ }
+ if (valueMask & CWBorderPixmap) {
+ winPtr->atts.border_pixmap = attsPtr->border_pixmap;
+ }
+ if (valueMask & CWBorderPixel) {
+ winPtr->atts.border_pixel = attsPtr->border_pixel;
+ }
+ if (valueMask & CWBitGravity) {
+ winPtr->atts.bit_gravity = attsPtr->bit_gravity;
+ }
+ if (valueMask & CWWinGravity) {
+ winPtr->atts.win_gravity = attsPtr->win_gravity;
+ }
+ if (valueMask & CWBackingStore) {
+ winPtr->atts.backing_store = attsPtr->backing_store;
+ }
+ if (valueMask & CWBackingPlanes) {
+ winPtr->atts.backing_planes = attsPtr->backing_planes;
+ }
+ if (valueMask & CWBackingPixel) {
+ winPtr->atts.backing_pixel = attsPtr->backing_pixel;
+ }
+ if (valueMask & CWOverrideRedirect) {
+ winPtr->atts.override_redirect = attsPtr->override_redirect;
+ }
+ if (valueMask & CWSaveUnder) {
+ winPtr->atts.save_under = attsPtr->save_under;
+ }
+ if (valueMask & CWEventMask) {
+ winPtr->atts.event_mask = attsPtr->event_mask;
+ }
+ if (valueMask & CWDontPropagate) {
+ winPtr->atts.do_not_propagate_mask
+ = attsPtr->do_not_propagate_mask;
+ }
+ if (valueMask & CWColormap) {
+ winPtr->atts.colormap = attsPtr->colormap;
+ }
+ if (valueMask & CWCursor) {
+ winPtr->atts.cursor = attsPtr->cursor;
+ }
+
+ if (winPtr->window != None) {
+ XChangeWindowAttributes(winPtr->display, winPtr->window,
+ valueMask, attsPtr);
+ } else {
+ winPtr->dirtyAtts |= valueMask;
+ }
+}
+
+void
+Tk_SetWindowBackground(tkwin, pixel)
+ Tk_Window tkwin; /* Window to manipulate. */
+ unsigned long pixel; /* Pixel value to use for
+ * window's background. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->atts.background_pixel = pixel;
+
+ if (winPtr->window != None) {
+ XSetWindowBackground(winPtr->display, winPtr->window, pixel);
+ } else {
+ winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBackPixmap)
+ | CWBackPixel;
+ }
+}
+
+void
+Tk_SetWindowBackgroundPixmap(tkwin, pixmap)
+ Tk_Window tkwin; /* Window to manipulate. */
+ Pixmap pixmap; /* Pixmap to use for window's
+ * background. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->atts.background_pixmap = pixmap;
+
+ if (winPtr->window != None) {
+ XSetWindowBackgroundPixmap(winPtr->display,
+ winPtr->window, pixmap);
+ } else {
+ winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBackPixel)
+ | CWBackPixmap;
+ }
+}
+
+void
+Tk_SetWindowBorder(tkwin, pixel)
+ Tk_Window tkwin; /* Window to manipulate. */
+ unsigned long pixel; /* Pixel value to use for
+ * window's border. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->atts.border_pixel = pixel;
+
+ if (winPtr->window != None) {
+ XSetWindowBorder(winPtr->display, winPtr->window, pixel);
+ } else {
+ winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBorderPixmap)
+ | CWBorderPixel;
+ }
+}
+
+void
+Tk_SetWindowBorderPixmap(tkwin, pixmap)
+ Tk_Window tkwin; /* Window to manipulate. */
+ Pixmap pixmap; /* Pixmap to use for window's
+ * border. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->atts.border_pixmap = pixmap;
+
+ if (winPtr->window != None) {
+ XSetWindowBorderPixmap(winPtr->display,
+ winPtr->window, pixmap);
+ } else {
+ winPtr->dirtyAtts = (winPtr->dirtyAtts & (unsigned) ~CWBorderPixel)
+ | CWBorderPixmap;
+ }
+}
+
+void
+Tk_DefineCursor(tkwin, cursor)
+ Tk_Window tkwin; /* Window to manipulate. */
+ Tk_Cursor cursor; /* Cursor to use for window (may be None). */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+#ifdef MAC_TCL
+ winPtr->atts.cursor = (XCursor) cursor;
+#else
+ winPtr->atts.cursor = (Cursor) cursor;
+#endif
+
+ if (winPtr->window != None) {
+ XDefineCursor(winPtr->display, winPtr->window, winPtr->atts.cursor);
+ } else {
+ winPtr->dirtyAtts = winPtr->dirtyAtts | CWCursor;
+ }
+}
+
+void
+Tk_UndefineCursor(tkwin)
+ Tk_Window tkwin; /* Window to manipulate. */
+{
+ Tk_DefineCursor(tkwin, None);
+}
+
+void
+Tk_SetWindowColormap(tkwin, colormap)
+ Tk_Window tkwin; /* Window to manipulate. */
+ Colormap colormap; /* Colormap to use for window. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->atts.colormap = colormap;
+
+ if (winPtr->window != None) {
+ XSetWindowColormap(winPtr->display, winPtr->window, colormap);
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ TkWmAddToColormapWindows(winPtr);
+ winPtr->flags |= TK_WM_COLORMAP_WINDOW;
+ }
+ } else {
+ winPtr->dirtyAtts |= CWColormap;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetWindowVisual --
+ *
+ * This procedure is called to specify a visual to be used
+ * for a Tk window when it is created. This procedure, if
+ * called at all, must be called before the X window is created
+ * (i.e. before Tk_MakeWindowExist is called).
+ *
+ * Results:
+ * The return value is 1 if successful, or 0 if the X window has
+ * been already created.
+ *
+ * Side effects:
+ * The information given is stored for when the window is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_SetWindowVisual(tkwin, visual, depth, colormap)
+ Tk_Window tkwin; /* Window to manipulate. */
+ Visual *visual; /* New visual for window. */
+ int depth; /* New depth for window. */
+ Colormap colormap; /* An appropriate colormap for the visual. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if( winPtr->window != None ){
+ /* Too late! */
+ return 0;
+ }
+
+ winPtr->visual = visual;
+ winPtr->depth = depth;
+ winPtr->atts.colormap = colormap;
+ winPtr->dirtyAtts |= CWColormap;
+
+ /*
+ * The following code is needed to make sure that the window doesn't
+ * inherit the parent's border pixmap, which would result in a BadMatch
+ * error.
+ */
+
+ if (!(winPtr->dirtyAtts & CWBorderPixmap)) {
+ winPtr->dirtyAtts |= CWBorderPixel;
+ }
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDoConfigureNotify --
+ *
+ * Generate a ConfigureNotify event describing the current
+ * configuration of a window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * An event is generated and processed by Tk_HandleEvent.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkDoConfigureNotify(winPtr)
+ register TkWindow *winPtr; /* Window whose configuration
+ * was just changed. */
+{
+ XEvent event;
+
+ event.type = ConfigureNotify;
+ event.xconfigure.serial = LastKnownRequestProcessed(winPtr->display);
+ event.xconfigure.send_event = False;
+ event.xconfigure.display = winPtr->display;
+ event.xconfigure.event = winPtr->window;
+ event.xconfigure.window = winPtr->window;
+ event.xconfigure.x = winPtr->changes.x;
+ event.xconfigure.y = winPtr->changes.y;
+ event.xconfigure.width = winPtr->changes.width;
+ event.xconfigure.height = winPtr->changes.height;
+ event.xconfigure.border_width = winPtr->changes.border_width;
+ if (winPtr->changes.stack_mode == Above) {
+ event.xconfigure.above = winPtr->changes.sibling;
+ } else {
+ event.xconfigure.above = None;
+ }
+ event.xconfigure.override_redirect = winPtr->atts.override_redirect;
+ Tk_HandleEvent(&event);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetClass --
+ *
+ * This procedure is used to give a window a class.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new class is stored for tkwin, replacing any existing
+ * class for it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetClass(tkwin, className)
+ Tk_Window tkwin; /* Token for window to assign class. */
+ char *className; /* New class for tkwin. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->classUid = Tk_GetUid(className);
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ TkWmSetClass(winPtr);
+ }
+ TkOptionClassChanged(winPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSetClassProcs --
+ *
+ * This procedure is used to set the class procedures and
+ * instance data for a window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new set of class procedures and instance data is stored
+ * for tkwin, replacing any existing values.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSetClassProcs(tkwin, procs, instanceData)
+ Tk_Window tkwin; /* Token for window to modify. */
+ TkClassProcs *procs; /* Class procs structure. */
+ ClientData instanceData; /* Data to be passed to class procedures. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ winPtr->classProcsPtr = procs;
+ winPtr->instanceData = instanceData;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_NameToWindow --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_NameToWindow(interp, pathName, tkwin)
+ Tcl_Interp *interp; /* Where to report errors. */
+ char *pathName; /* Path name of window. */
+ Tk_Window tkwin; /* Token for window: name is assumed to
+ * belong to the same main window as tkwin. */
+{
+ Tcl_HashEntry *hPtr;
+
+ hPtr = Tcl_FindHashEntry(&((TkWindow *) tkwin)->mainPtr->nameTable,
+ pathName);
+ if (hPtr == NULL) {
+ Tcl_AppendResult(interp, "bad window path name \"",
+ pathName, "\"", (char *) NULL);
+ return NULL;
+ }
+ return (Tk_Window) Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_IdToWindow --
+ *
+ * Given an X display and window ID, this procedure returns the
+ * Tk token for the window, if there exists a Tk window corresponding
+ * to the given ID.
+ *
+ * Results:
+ * The return result is either a token for the window corresponding
+ * to the given X id, or else NULL to indicate that there is no such
+ * window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+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;
+ }
+ }
+
+ hPtr = Tcl_FindHashEntry(&dispPtr->winTable, (char *) window);
+ if (hPtr == NULL) {
+ return NULL;
+ }
+ return (Tk_Window) Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_DisplayName --
+ *
+ * Return the textual name of a window's display.
+ *
+ * Results:
+ * The return value is the string name of the display associated
+ * with tkwin.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+Tk_DisplayName(tkwin)
+ Tk_Window tkwin; /* Window whose display name is desired. */
+{
+ return ((TkWindow *) tkwin)->dispPtr->name;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UnlinkWindow --
+ *
+ * This procedure removes a window from the childList of its
+ * parent.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is unlinked from its childList.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UnlinkWindow(winPtr)
+ TkWindow *winPtr; /* Child window to be unlinked. */
+{
+ TkWindow *prevPtr;
+
+ if (winPtr->parentPtr == NULL) {
+ return;
+ }
+ prevPtr = winPtr->parentPtr->childList;
+ if (prevPtr == winPtr) {
+ winPtr->parentPtr->childList = winPtr->nextPtr;
+ if (winPtr->nextPtr == NULL) {
+ winPtr->parentPtr->lastChildPtr = NULL;
+ }
+ } else {
+ while (prevPtr->nextPtr != winPtr) {
+ prevPtr = prevPtr->nextPtr;
+ if (prevPtr == NULL) {
+ panic("UnlinkWindow couldn't find child in parent");
+ }
+ }
+ prevPtr->nextPtr = winPtr->nextPtr;
+ if (winPtr->nextPtr == NULL) {
+ winPtr->parentPtr->lastChildPtr = prevPtr;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_RestackWindow --
+ *
+ * Change a window's position in the stacking order.
+ *
+ * Results:
+ * TCL_OK is normally returned. If other is not a descendant
+ * of tkwin's parent then TCL_ERROR is returned and tkwin is
+ * not repositioned.
+ *
+ * Side effects:
+ * Tkwin is repositioned in the stacking order.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_RestackWindow(tkwin, aboveBelow, other)
+ Tk_Window tkwin; /* Token for window whose position in
+ * the stacking order is to change. */
+ int aboveBelow; /* Indicates new position of tkwin relative
+ * to other; must be Above or Below. */
+ Tk_Window other; /* Tkwin will be moved to a position that
+ * puts it just above or below this window.
+ * If NULL then tkwin goes above or below
+ * all windows in the same parent. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkWindow *otherPtr = (TkWindow *) other;
+ XWindowChanges changes;
+ unsigned int mask;
+
+
+ /*
+ * Special case: if winPtr is a top-level window then just find
+ * the top-level ancestor of otherPtr and restack winPtr above
+ * otherPtr without changing any of Tk's childLists.
+ */
+
+ changes.stack_mode = aboveBelow;
+ mask = CWStackMode;
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ while ((otherPtr != NULL) && !(otherPtr->flags & TK_TOP_LEVEL)) {
+ otherPtr = otherPtr->parentPtr;
+ }
+ TkWmRestackToplevel(winPtr, aboveBelow, otherPtr);
+ return TCL_OK;
+ }
+
+ /*
+ * Find an ancestor of otherPtr that is a sibling of winPtr.
+ */
+
+ if (winPtr->parentPtr == NULL) {
+ /*
+ * Window is going to be deleted shortly; don't do anything.
+ */
+
+ return TCL_OK;
+ }
+ if (otherPtr == NULL) {
+ if (aboveBelow == Above) {
+ otherPtr = winPtr->parentPtr->lastChildPtr;
+ } else {
+ otherPtr = winPtr->parentPtr->childList;
+ }
+ } else {
+ while (winPtr->parentPtr != otherPtr->parentPtr) {
+ if ((otherPtr == NULL) || (otherPtr->flags & TK_TOP_LEVEL)) {
+ return TCL_ERROR;
+ }
+ otherPtr = otherPtr->parentPtr;
+ }
+ }
+ if (otherPtr == winPtr) {
+ return TCL_OK;
+ }
+
+ /*
+ * Reposition winPtr in the stacking order.
+ */
+
+ UnlinkWindow(winPtr);
+ if (aboveBelow == Above) {
+ winPtr->nextPtr = otherPtr->nextPtr;
+ if (winPtr->nextPtr == NULL) {
+ winPtr->parentPtr->lastChildPtr = winPtr;
+ }
+ otherPtr->nextPtr = winPtr;
+ } else {
+ TkWindow *prevPtr;
+
+ prevPtr = winPtr->parentPtr->childList;
+ if (prevPtr == otherPtr) {
+ winPtr->parentPtr->childList = winPtr;
+ } else {
+ while (prevPtr->nextPtr != otherPtr) {
+ prevPtr = prevPtr->nextPtr;
+ }
+ prevPtr->nextPtr = winPtr;
+ }
+ winPtr->nextPtr = otherPtr;
+ }
+
+ /*
+ * Notify the X server of the change. If winPtr hasn't yet been
+ * created then there's no need to tell the X server now, since
+ * the stacking order will be handled properly when the window
+ * is finally created.
+ */
+
+ if (winPtr->window != None) {
+ changes.stack_mode = Above;
+ for (otherPtr = winPtr->nextPtr; otherPtr != NULL;
+ otherPtr = otherPtr->nextPtr) {
+ if ((otherPtr->window != None)
+ && !(otherPtr->flags & (TK_TOP_LEVEL|TK_REPARENTED))){
+ changes.sibling = otherPtr->window;
+ changes.stack_mode = Below;
+ mask = CWStackMode|CWSibling;
+ break;
+ }
+ }
+ XConfigureWindow(winPtr->display, winPtr->window, mask, &changes);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 --
+ *
+ * Indicates whether strict Motif compliance has been specified
+ * for the given window.
+ *
+ * Results:
+ * The return value is 1 if strict Motif compliance has been
+ * requested for tkwin's application by setting the tk_strictMotif
+ * variable in its interpreter to a true value. 0 is returned
+ * if tk_strictMotif has a false value.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_StrictMotif(tkwin)
+ Tk_Window tkwin; /* Window whose application is
+ * to be checked. */
+{
+ return ((TkWindow *) tkwin)->mainPtr->strictMotif;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * OpenIM --
+ *
+ * Tries to open an X input method, associated with the
+ * given display. Right now we can only deal with a bare-bones
+ * input style: no preedit, and no status.
+ *
+ * Results:
+ * Stores the input method in dispPtr->inputMethod; if there isn't
+ * a suitable input method, then NULL is stored in dispPtr->inputMethod.
+ *
+ * Side effects:
+ * An input method gets opened.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+OpenIM(dispPtr)
+ TkDisplay *dispPtr; /* Tk's structure for the display. */
+{
+#ifndef TK_USE_INPUT_METHODS
+ return;
+#else
+ unsigned short i;
+ XIMStyles *stylePtr;
+
+ dispPtr->inputMethod = XOpenIM(dispPtr->display, NULL, NULL, NULL);
+ if (dispPtr->inputMethod == NULL) {
+ return;
+ }
+
+ if ((XGetIMValues(dispPtr->inputMethod, XNQueryInputStyle, &stylePtr,
+ NULL) != NULL) || (stylePtr == NULL)) {
+ goto error;
+ }
+ for (i = 0; i < stylePtr->count_styles; i++) {
+ if (stylePtr->supported_styles[i]
+ == (XIMPreeditNothing|XIMStatusNothing)) {
+ XFree(stylePtr);
+ return;
+ }
+ }
+ XFree(stylePtr);
+
+ error:
+
+ /*
+ * Should close the input method, but this causes core dumps on some
+ * systems (e.g. Solaris 2.3 as of 1/6/95).
+ * XCloseIM(dispPtr->inputMethod);
+ */
+ dispPtr->inputMethod = NULL;
+ return;
+#endif /* TK_USE_INPUT_METHODS */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetNumMainWindows --
+ *
+ * This procedure returns the number of main windows currently
+ * open in this process.
+ *
+ * Results:
+ * The number of main windows open in this process.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_GetNumMainWindows()
+{
+ return numMainWindows;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteWindowsExitProc --
+ *
+ * This procedure is invoked as an exit handler. It deletes all
+ * of the main windows in the process.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_Init(interp)
+ Tcl_Interp *interp; /* Interpreter to initialize. */
+{
+ return Initialize(interp);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_SafeInit(interp)
+ Tcl_Interp *interp; /* Interpreter to initialize. */
+{
+ /*
+ * Initialize the interpreter with Tk, safely. This removes
+ * all the Tk commands that are unsafe.
+ *
+ * Rationale:
+ *
+ * - Toplevel and menu are unsafe because they can be used to cover
+ * the entire screen and to steal input from the user.
+ * - Continuous ringing of the bell is a nuisance.
+ * - Cannot allow access to the clipboard because a malicious script
+ * can replace the contents with the string "rm -r *" and lead to
+ * surprises when the contents of the clipboard are pasted. We do
+ * not currently hide the selection command.. Should we?
+ * - Cannot allow send because it can be used to cause unsafe
+ * interpreters to execute commands. The tk command recreates the
+ * send command, so that too must be hidden.
+ * - Focus can be used to grab the focus away from another window,
+ * in effect stealing user input. Cannot allow that.
+ * NOTE: We currently do *not* hide focus as it would make it
+ * impossible to provide keyboard input to Tk in a safe interpreter.
+ * - Grab can be used to block the user from using any other apps
+ * on the screen.
+ * - Tkwait can block the containing process forever. Use bindings,
+ * fileevents and split the protocol into before-the-wait and
+ * after-the-wait parts. More work but necessary.
+ * - Wm is unsafe because (if toplevels are allowed, in the future)
+ * it can be used to remove decorations, move windows around, cover
+ * the entire screen etc etc.
+ *
+ * Current risks:
+ *
+ * - No CPU time limit, no memory allocation limits, no color limits.
+ *
+ * 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;
+
+ /*
+ * 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);
+ 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);
+ 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);
+ 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) {
+ 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;
+ }
+ p = Tcl_Merge(argc, argv);
+ Tcl_SetVar2(interp, "argv", (char *) NULL, p, TCL_GLOBAL_ONLY);
+ sprintf(buffer, "%d", argc);
+ Tcl_SetVar2(interp, "argc", (char *) NULL, buffer, TCL_GLOBAL_ONLY);
+ ckfree(p);
+ }
+
+ /*
+ * Figure out the application's name and class.
+ */
+
+ Tcl_DStringInit(&class);
+ if (name == NULL) {
+ int offset;
+ TkpGetAppName(interp, &class);
+ offset = Tcl_DStringLength(&class)+1;
+ Tcl_DStringSetLength(&class, offset);
+ 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.
+ */
+
+ args[0] = "toplevel";
+ args[1] = ".";
+ args[2] = "-class";
+ args[3] = Tcl_DStringValue(&class);
+ argc = 4;
+ if (display != NULL) {
+ args[argc] = "-screen";
+ args[argc+1] = display;
+ argc += 2;
+
+ /*
+ * 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;
+ colormap = NULL;
+ }
+ if (use != NULL) {
+ args[argc] = "-use";
+ args[argc+1] = use;
+ argc += 2;
+ use = NULL;
+ }
+ if (visual != NULL) {
+ args[argc] = "-visual";
+ args[argc+1] = visual;
+ argc += 2;
+ visual = NULL;
+ }
+ args[argc] = NULL;
+ code = TkCreateFrame((ClientData) NULL, interp, argc, args, 1, name);
+
+ Tcl_DStringFree(&class);
+ if (code != TCL_OK) {
+ goto done;
+ }
+ Tcl_ResetResult(interp);
+ if (synchronize) {
+ XSynchronize(Tk_Display(Tk_MainWindow(interp)), True);
+ }
+
+ /*
+ * Set the geometry of the main window, if requested. Put the
+ * requested geometry into the "geometry" variable.
+ */
+
+ if (geometry != NULL) {
+ 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;
+}
diff --git a/tk/library/bgerror.tcl b/tk/library/bgerror.tcl
new file mode 100644
index 00000000000..2c43305edf3
--- /dev/null
+++ b/tk/library/bgerror.tcl
@@ -0,0 +1,99 @@
+# 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.
+
+
+# bgerror --
+# This is the default version of bgerror.
+# It tries to execute tkerror, if that fails it posts a dialog box containing
+# the error message and gives the user a chance to ask to see a stack
+# trace.
+# Arguments:
+# err - The error message.
+
+proc bgerror err {
+ global errorInfo tcl_platform
+
+ # save errorInfo which would be erased in the catch below otherwise.
+ set info $errorInfo ;
+
+ # For backward compatibility :
+ # 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
+ } else {
+ set ok OK
+ }
+ set button [tk_dialog .bgerrorDialog "Error in Tcl Script" \
+ "Error: $err" error 0 $ok "Skip Messages" "Stack Trace"]
+ if {$button == 0} {
+ return
+ } elseif {$button == 1} {
+ return -code break
+ }
+
+ 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 .]
+ }
+}
diff --git a/tk/library/button.tcl b/tk/library/button.tcl
new file mode 100644
index 00000000000..b490f76f99c
--- /dev/null
+++ b/tk/library/button.tcl
@@ -0,0 +1,465 @@
+# 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 Button <Return> {
+ tkButtonInvoke %W
+ }
+ bind Checkbutton <Return> {
+ tkCheckRadioInvoke %W
+ }
+ bind Radiobutton <Return> {
+ tkCheckRadioInvoke %W
+ }
+ bind Checkbutton <equal> {
+ tkCheckRadioInvoke %W select
+ }
+ bind Checkbutton <plus> {
+ tkCheckRadioInvoke %W select
+ }
+ bind Checkbutton <minus> {
+ tkCheckRadioInvoke %W deselect
+ }
+ bind Checkbutton <1> {
+ tkCheckRadioDown %W
+ }
+ bind Checkbutton <ButtonRelease-1> {
+ tkButtonUp %W
+ }
+ bind Checkbutton <Enter> {
+ tkCheckRadioEnter %W
+ }
+
+ bind Radiobutton <1> {
+ tkCheckRadioDown %W
+ }
+ 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> {
+ tkCheckRadioInvoke %W
+ }
+ bind Checkbutton <Enter> {
+ tkButtonEnter %W
+ }
+ bind Radiobutton <Enter> {
+ tkButtonEnter %W
+ }
+}
+
+bind Button <space> {
+ tkButtonInvoke %W
+}
+bind Checkbutton <space> {
+ tkCheckRadioInvoke %W
+}
+bind Radiobutton <space> {
+ tkCheckRadioInvoke %W
+}
+
+bind Button <FocusIn> {}
+bind Button <Enter> {
+ tkButtonEnter %W
+}
+bind Button <Leave> {
+ tkButtonLeave %W
+}
+bind Button <1> {
+ tkButtonDown %W
+}
+bind Button <ButtonRelease-1> {
+ tkButtonUp %W
+}
+
+bind Checkbutton <FocusIn> {}
+bind Checkbutton <Leave> {
+ tkButtonLeave %W
+}
+
+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]
+ }
+}
+
+# tkCheckRadioInvoke --
+# The procedure below is invoked when the mouse button is pressed in
+# a checkbutton or radiobutton widget, or when the widget is invoked
+# through the keyboard. It invokes the widget if it
+# 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]
+ }
+}
+
diff --git a/tk/library/clrpick.tcl b/tk/library/clrpick.tcl
new file mode 100644
index 00000000000..a06b2e2ab4a
--- /dev/null
+++ b/tk/library/clrpick.tcl
@@ -0,0 +1,691 @@
+# 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): Find out how many free colors are left in the colormap and
+# don't allocate too many colors.
+# (2): Implement HSV color selection.
+#
+
+# tkColorDialog --
+#
+# Create a color dialog and let the user choose a color. This function
+# should not be called directly. It is called by the tk_chooseColor
+# function when a native color selector widget does not exist
+#
+proc tkColorDialog {args} {
+ global tkPriv
+ set w .__tk__color
+ upvar #0 $w data
+
+ # The lines variables track the start and end indices of the line
+ # elements in the colorbar canvases.
+ set data(lines,red,start) 0
+ set data(lines,red,last) -1
+ set data(lines,green,start) 0
+ set data(lines,green,last) -1
+ set data(lines,blue,start) 0
+ set data(lines,blue,last) -1
+
+ # This is the actual number of lines that are drawn in each color strip.
+ # Note that the bars may be of any width.
+ # However, NUM_COLORBARS must be a number that evenly divides 256.
+ # Such as 256, 128, 64, etc.
+ set data(NUM_COLORBARS) 8
+
+ # BARS_WIDTH is the number of pixels wide the color bar portion of the
+ # canvas is. This number must be a multiple of NUM_COLORBARS
+ set data(BARS_WIDTH) 128
+
+ # PLGN_WIDTH is the number of pixels wide of the triangular selection
+ # polygon. This also results in the definition of the padding on the
+ # left and right sides which is half of PLGN_WIDTH. Make this number even.
+ set data(PLGN_HEIGHT) 10
+
+ # 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} {
+ global tkPriv
+ upvar #0 $w data
+
+ # 1: the configuration specs
+ #
+ set specs {
+ {-initialcolor "" "" ""}
+ {-parent "" "" "."}
+ {-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.
+#
+proc tkColorDialog_BuildDialog {w} {
+ upvar #0 $w data
+
+ # TopFrame contains the color strips and the color selection
+ #
+ set topFrame [frame $w.top -relief raised -bd 1]
+
+ # StripsFrame contains the colorstrips and the individual RGB entries
+ set stripsFrame [frame $topFrame.colorStrip]
+
+ foreach c { Red Green Blue } {
+ set color [string tolower $c]
+
+ # each f frame contains an [R|G|B] entry and the equiv. color strip.
+ set f [frame $stripsFrame.$color]
+
+ # The box frame contains the label and entry widget for an [R|G|B]
+ set box [frame $f.box]
+
+ label $box.label -text $c: -width 6 -under 0 -anchor ne
+ 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
+
+ pack $f -side top -fill x -padx 0 -pady 2
+
+ set data($color,entry) $box.entry
+ set data($color,col) $f.color
+ set data($color,sel) $f.sel
+
+ bind $data($color,col) <Configure> \
+ "tkColorDialog_DrawColorScale $w $color 1"
+ bind $data($color,col) <Enter> \
+ "tkColorDialog_EnterColorBar $w $color"
+ bind $data($color,col) <Leave> \
+ "tkColorDialog_LeaveColorBar $w $color"
+
+ bind $data($color,sel) <Enter> \
+ "tkColorDialog_EnterColorBar $w $color"
+ bind $data($color,sel) <Leave> \
+ "tkColorDialog_LeaveColorBar $w $color"
+
+ bind $box.entry <Return> "tkColorDialog_HandleRGBEntry $w"
+ }
+
+ pack $stripsFrame -side left -fill both -padx 4 -pady 10
+
+ # The selFrame contains a frame that demonstrates the currently
+ # selected color
+ #
+ set selFrame [frame $topFrame.sel]
+ set lab [label $selFrame.lab -text "Selection:" -under 0 -anchor sw]
+ set ent [entry $selFrame.ent -textvariable [format %s $w](selection) \
+ -width 16]
+ set f1 [frame $selFrame.f1 -relief sunken -bd 2]
+ set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70]
+
+ pack $lab $ent -side top -fill x -padx 4 -pady 2
+ pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10
+ pack $data(finalCanvas) -expand yes -fill both
+
+ bind $ent <Return> "tkColorDialog_HandleSelEntry $w"
+
+ pack $selFrame -side left -fill none -anchor nw
+ pack $topFrame -side top -expand yes -fill both -anchor nw
+
+ # the botFrame frame contains the buttons
+ #
+ set botFrame [frame $w.bot -relief raised -bd 1]
+ button $botFrame.ok -text OK -width 8 -under 0 \
+ -command "tkColorDialog_OkCmd $w"
+ button $botFrame.cancel -text Cancel -width 8 -under 0 \
+ -command "tkColorDialog_CancelCmd $w"
+
+ set data(okBtn) $botFrame.ok
+ set data(cancelBtn) $botFrame.cancel
+
+ pack $botFrame.ok $botFrame.cancel \
+ -padx 10 -pady 10 -expand yes -side left
+ pack $botFrame -side bottom -fill x
+
+
+ # Accelerator bindings
+
+ bind $w <Alt-r> "focus $data(red,entry)"
+ bind $w <Alt-g> "focus $data(green,entry)"
+ bind $w <Alt-b> "focus $data(blue,entry)"
+ bind $w <Alt-s> "focus $ent"
+ bind $w <KeyPress-Escape> "tkButtonInvoke $data(cancelBtn)"
+ bind $w <Alt-c> "tkButtonInvoke $data(cancelBtn)"
+ bind $w <Alt-o> "tkButtonInvoke $data(okBtn)"
+
+ wm protocol $w WM_DELETE_WINDOW "tkColorDialog_CancelCmd $w"
+}
+
+# tkColorDialog_SetRGBValue --
+#
+# Sets the current selection of the dialog box
+#
+proc tkColorDialog_SetRGBValue {w color} {
+ upvar #0 $w data
+
+ set data(red,intensity) [lindex $color 0]
+ set data(green,intensity) [lindex $color 1]
+ set data(blue,intensity) [lindex $color 2]
+
+ tkColorDialog_RedrawColorBars $w all
+
+ # Now compute the new x value of each colorbars pointer polygon
+ foreach color { red green blue } {
+ set x [tkColorDialog_RgbToX $w $data($color,intensity)]
+ tkColorDialog_MoveSelector $w $data($color,sel) $color $x 0
+ }
+}
+
+# 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"
+ $sel bind $data($c,index) <B1-Motion> \
+ "tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)"
+ $sel bind $data($c,index) <ButtonRelease-1> \
+ "tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)"
+
+ set height [winfo height $col]
+ # Create an invisible region under the colorstrip to catch mouse clicks
+ # that aren't on the selector.
+ set data($c,clickRegion) [$sel create rectangle 0 0 \
+ $data(canvasWidth) $height -fill {} -outline {}]
+
+ bind $col <ButtonPress-1> \
+ "tkColorDialog_StartMove $w $sel $c %x $data(colorPad)"
+ bind $col <B1-Motion> \
+ "tkColorDialog_MoveSelector $w $sel $c %x $data(colorPad)"
+ bind $col <ButtonRelease-1> \
+ "tkColorDialog_ReleaseMouse $w $sel $c %x $data(colorPad)"
+
+ $sel bind $data($c,clickRegion) <ButtonPress-1> \
+ "tkColorDialog_StartMove $w $sel $c %x $data(selPad)"
+ $sel bind $data($c,clickRegion) <B1-Motion> \
+ "tkColorDialog_MoveSelector $w $sel $c %x $data(selPad)"
+ $sel bind $data($c,clickRegion) <ButtonRelease-1> \
+ "tkColorDialog_ReleaseMouse $w $sel $c %x $data(selPad)"
+ } 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 --
+#
+# Creates and draws the selector polygon at the position
+# $data($c,intensity).
+#
+proc tkColorDialog_CreateSelector {w sel c } {
+ upvar #0 $w data
+ set data($c,index) [$sel create polygon \
+ 0 $data(PLGN_HEIGHT) \
+ $data(PLGN_WIDTH) $data(PLGN_HEIGHT) \
+ $data(indent) 0]
+ set data($c,x) [tkColorDialog_RgbToX $w $data($c,intensity)]
+ $sel move $data($c,index) $data($c,x) 0
+}
+
+# tkColorDialog_RedrawFinalColor
+#
+# Combines the intensities of the three colors into the final color
+#
+proc tkColorDialog_RedrawFinalColor {w} {
+ upvar #0 $w data
+
+ set color [format "#%02x%02x%02x" $data(red,intensity) \
+ $data(green,intensity) $data(blue,intensity)]
+
+ $data(finalCanvas) conf -bg $color
+ set data(finalColor) $color
+ set data(selection) $color
+ set data(finalRGB) [list \
+ $data(red,intensity) \
+ $data(green,intensity) \
+ $data(blue,intensity)]
+}
+
+# tkColorDialog_RedrawColorBars --
+#
+# Only redraws the colors on the color strips that were not manipulated.
+# Params: color of colorstrip that changed. If color is not [red|green|blue]
+# Then all colorstrips will be updated
+#
+proc tkColorDialog_RedrawColorBars {w colorChanged} {
+ upvar #0 $w data
+
+ switch $colorChanged {
+ red {
+ tkColorDialog_DrawColorScale $w green
+ tkColorDialog_DrawColorScale $w blue
+ }
+ green {
+ tkColorDialog_DrawColorScale $w red
+ tkColorDialog_DrawColorScale $w blue
+ }
+ blue {
+ tkColorDialog_DrawColorScale $w red
+ tkColorDialog_DrawColorScale $w green
+ }
+ default {
+ tkColorDialog_DrawColorScale $w red
+ tkColorDialog_DrawColorScale $w green
+ tkColorDialog_DrawColorScale $w blue
+ }
+ }
+ tkColorDialog_RedrawFinalColor $w
+}
+
+#----------------------------------------------------------------------
+# Event handlers
+#----------------------------------------------------------------------
+
+# tkColorDialog_StartMove --
+#
+# Handles a mousedown button event over the selector polygon.
+# Adds the bindings for moving the mouse while the button is
+# 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
+# x value as the specified x. If x is outside the bounds [0,255],
+# the selector is set to the closest endpoint.
+#
+# Params: sel is the selector canvas, c is [red|green|blue]
+# x is a x-coordinate.
+#
+proc tkColorDialog_MoveSelector {w sel color x delta} {
+ 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
+#
+# Removes mouse tracking bindings, updates the colorbars.
+#
+# Params: sel is the selector canvas, color is the color of the strip,
+# x is the x-coord of the mouse.
+#
+proc tkColorDialog_ReleaseMouse {w sel color x delta} {
+ upvar #0 $w data
+
+ set x [tkColorDialog_MoveSelector $w $sel $color $x $delta]
+
+ # Determine exactly what color we are looking at.
+ set data($color,intensity) [tkColorDialog_XToRgb $w $x]
+
+ tkColorDialog_RedrawColorBars $w $color
+}
+
+# tkColorDialog_ResizeColorbars --
+#
+# Completely redraws the colorbars, including resizing the
+# colorstrips
+#
+proc tkColorDialog_ResizeColorBars {w} {
+ upvar #0 $w data
+
+ if { ($data(BARS_WIDTH) < $data(NUM_COLORBARS)) ||
+ (($data(BARS_WIDTH) % $data(NUM_COLORBARS)) != 0)} {
+ set data(BARS_WIDTH) $data(NUM_COLORBARS)
+ }
+ tkColorDialog_InitValues $w
+ foreach color { red green blue } {
+ $data($color,col) conf -width $data(canvasWidth)
+ tkColorDialog_DrawColorScale $w $color 1
+ }
+}
+
+# tkColorDialog_HandleSelEntry --
+#
+# 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} {
+ set data($c,intensity) 255
+ }
+ }
+
+ tkColorDialog_SetRGBValue $w "$data(red,intensity) $data(green,intensity) \
+ $data(blue,intensity)"
+}
+
+# mouse cursor enters a color bar
+#
+proc tkColorDialog_EnterColorBar {w color} {
+ upvar #0 $w data
+
+ $data($color,sel) itemconfig $data($color,index) -fill red
+}
+
+# mouse leaves enters a color bar
+#
+proc tkColorDialog_LeaveColorBar {w color} {
+ upvar #0 $w data
+
+ $data($color,sel) itemconfig $data($color,index) -fill black
+}
+
+# user hits OK button
+#
+proc tkColorDialog_OkCmd {w} {
+ global tkPriv
+ upvar #0 $w data
+
+ set tkPriv(selectColor) $data(finalColor)
+}
+
+# user hits Cancel button
+#
+proc tkColorDialog_CancelCmd {w} {
+ global tkPriv
+
+ set tkPriv(selectColor) ""
+}
+
diff --git a/tk/library/comdlg.tcl b/tk/library/comdlg.tcl
new file mode 100644
index 00000000000..30e4c813df8
--- /dev/null
+++ b/tk/library/comdlg.tcl
@@ -0,0 +1,308 @@
+# 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.
+#
+
+# tclParseConfigSpec --
+#
+# Parses a list of "-option value" pairs. If all options and
+# values are legal, the values are stored in
+# $data($option). Otherwise an error message is returned. When
+# an error happens, the data() array may have been partially
+# modified, but all the modified members of the data(0 array are
+# guaranteed to have valid values. This is different than
+# Tk_ConfigureWidget() which does not modify the value of a
+# widget record if any error occurs.
+#
+# Arguments:
+#
+# w = widget record to modify. Must be the pathname of a widget.
+#
+# specs = {
+# {-commandlineswitch resourceName ResourceClass defaultValue verifier}
+# {....}
+# }
+#
+# flags = currently unused.
+#
+# argList = The list of "-option value" pairs.
+#
+proc tclParseConfigSpec {w specs flags argList} {
+ upvar #0 $w data
+
+ # 1: Put the specs in associative arrays for faster access
+ #
+ foreach spec $specs {
+ if {[llength $spec] < 4} {
+ error "\"spec\" should contain 5 or 4 elements"
+ }
+ set cmdsw [lindex $spec 0]
+ 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]%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
+}
+
+# This procedure is used to sort strings in a case-insenstive mode.
+#
+proc tclSortNoCase {str1 str2} {
+ return [string compare [string toupper $str1] [string toupper $str2]]
+}
+
+
+# Gives an error if the string does not contain a valid integer
+# number
+#
+proc tclVerifyInteger {string} {
+ lindex {1 2 3} $string
+}
+
+
+#----------------------------------------------------------------------
+#
+# Focus Group
+#
+# Focus groups are used to handle the user's focusing actions inside a
+# toplevel.
+#
+# One example of using focus groups is: when the user focuses on an
+# entry, the text in the entry is highlighted and the cursor is put to
+# the end of the text. When the user changes focus to another widget,
+# the text in the previously focused entry is validated.
+#
+#----------------------------------------------------------------------
+
+
+# tkFocusGroup_Create --
+#
+# 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)
+ }
+}
+
+# tkFocusGroup_Out --
+#
+# Handles the <FocusOut> event. Checks if this is really a lose
+# focus event, not one generated by the mouse moving out of the
+# toplevel window. Calls the FocusOut command for the widget
+# who loses its focus.
+#
+proc tkFocusGroup_Out {t w detail} {
+ 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) ""
+ }
+}
+
+# tkFDGetFileTypes --
+#
+# Process the string given by the -filetypes option of the file
+# dialogs. Similar to the C function TkGetFileFilters() on the Mac
+# and Windows platform.
+#
+proc tkFDGetFileTypes {string} {
+ foreach t $string {
+ if {[llength $t] < 2 || [llength $t] > 3} {
+ error "bad file type \"$t\", should be \"typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?\""
+ }
+ eval lappend [list fileTypes([lindex $t 0])] [lindex $t 1]
+ }
+
+ 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 ")"
+ lappend types [list $name $exts]
+
+ set hasDoneType($label) 1
+ }
+
+ return $types
+}
diff --git a/tk/library/console.tcl b/tk/library/console.tcl
new file mode 100644
index 00000000000..673d842ef2f
--- /dev/null
+++ b/tk/library/console.tcl
@@ -0,0 +1,481 @@
+# 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
+
+ focus .console
+
+ wm protocol . WM_DELETE_WINDOW { wm withdraw . }
+ wm title . "Console"
+ flush stdout
+ .console mark set output [.console index "end - 1 char"]
+ tkTextSetCursor .console end
+ .console mark set promptEnd insert
+ .console mark gravity promptEnd left
+}
+
+# tkConsoleSource --
+#
+# Prompts the user for a file to source in the main interpreter.
+#
+# 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
+}
+
+# tkConsoleHistory --
+# This procedure implements command line history for the
+# console. In general is evals the history command in the
+# main interpreter to obtain the history. The global variable
+# histNum is used to store the current location in the history.
+#
+# Arguments:
+# cmd - Which action to take: prev, next, reset.
+
+set histNum 1
+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
+ tkTextSetCursor .console end
+ .console mark set promptEnd insert
+ .console mark gravity promptEnd left
+}
+
+# tkConsoleBind --
+# This procedure first ensures that the default bindings for the Text
+# class have been defined. Then certain bindings are overridden for
+# the class.
+#
+# Arguments:
+# None.
+
+proc tkConsoleBind {win} {
+ bindtags $win "$win Text . all"
+
+ # 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 $win <Alt-KeyPress> {# nothing }
+ bind $win <Meta-KeyPress> {# nothing}
+ bind $win <Control-KeyPress> {# nothing}
+ bind $win <Escape> {# nothing}
+ bind $win <KP_Enter> {# nothing}
+
+ bind $win <Tab> {
+ tkConsoleInsert %W \t
+ focus %W
+ break
+ }
+ 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
+ }
+ }
+ foreach prev {Control-n Down} {
+ bind $win <$prev> {
+ tkConsoleHistory next
+ break
+ }
+ }
+ bind $win <Insert> {
+ catch {tkConsoleInsert %W [selection get -displayof %W]}
+ break
+ }
+ 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
+ if {![catch {set data [%W get sel.first sel.last]}]} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W $data
+ }
+ break
+ }
+ bind $win <<Copy>> {
+ if {![catch {set data [%W get sel.first sel.last]}]} {
+ clipboard clear -displayof %W
+ clipboard append -displayof %W $data
+ }
+ break
+ }
+ bind $win <<Paste>> {
+ catch {
+ set clip [selection get -displayof %W -selection CLIPBOARD]
+ set list [split $clip \n\r]
+ tkConsoleInsert %W [lindex $list 0]
+ foreach x [lrange $list 1 end] {
+ %W mark set insert {end - 1c}
+ tkConsoleInsert %W "\n"
+ tkConsoleInvoke
+ tkConsoleInsert %W $x
+ }
+ }
+ break
+ }
+}
+
+# tkConsoleInsert --
+# Insert a string into a text at the point of the insertion cursor.
+# If there is a selection in the text, and it covers the point of the
+# insertion cursor, then delete the selection before inserting. Insertion
+# 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
+ }
+ }
+ if {[$w compare insert < promptEnd]} {
+ $w mark set insert end
+ }
+ $w insert insert $s {input stdin}
+ $w see insert
+}
+
+# tkConsoleOutput --
+#
+# This routine is called directly by ConsolePutsCmd to cause a string
+# to be displayed in the console.
+#
+# Arguments:
+# dest - The output tag to be used: either "stderr" or "stdout".
+# string - The string to be displayed.
+
+proc tkConsoleOutput {dest string} {
+ .console insert output $string $dest
+ .console see insert
+}
+
+# tkConsoleExit --
+#
+# This routine is called by ConsoleEventProc when the main window of
+# the application is destroyed. Don't call exit - that probably already
+# happened. Just delete our window.
+#
+# Arguments:
+# None.
+
+proc tkConsoleExit {} {
+ destroy .
+}
+
+# tkConsoleAbout --
+#
+# This routine displays an About box to show Tcl/Tk version info.
+#
+# Arguments:
+# None.
+
+proc tkConsoleAbout {} {
+ global tk_patchLevel
+ tk_messageBox -type ok -message "Tcl for Windows
+Copyright \251 1996 Sun Microsystems, Inc.
+
+Tcl [info patchlevel]
+Tk $tk_patchLevel"
+}
+
+# now initialize the console
+
+tkConsoleInit
diff --git a/tk/library/demos/README b/tk/library/demos/README
new file mode 100644
index 00000000000..c71f977d741
--- /dev/null
+++ b/tk/library/demos/README
@@ -0,0 +1,46 @@
+This directory contains a collection of programs to demonstrate
+the features of the Tk toolkit. The programs are all scripts for
+"wish", a windowing shell. If wish has been installed in /usr/local
+then you can invoke any of the programs in this directory just
+by typing its file name to your command shell. Otherwise invoke
+wish with the file as its first argument, e.g., "wish hello".
+The rest of this file contains a brief description of each program.
+Files with names ending in ".tcl" are procedure packages used by one
+or more of the demo programs; they can't be used as programs by
+themselves so they aren't described below.
+
+hello - Creates a single button; if you click on it, a message
+ is typed and the application terminates.
+
+widget - Contains a collection of demonstrations of the widgets
+ currently available in the Tk library. Most of the .tcl
+ files are scripts for individual demos available through
+ the "widget" program.
+
+ixset - A simple Tk-based wrapper for the "xset" program, which
+ allows you to interactively query and set various X options
+ such as mouse acceleration and bell volume. Thanks to
+ Pierre David for contributing this example.
+
+rolodex - A mock-up of a simple rolodex application. It has much of
+ the user interface for such an application but no back-end
+ database. This program was written in response to Tom
+ LaStrange's toolkit benchmark challenge.
+
+tcolor - A color editor. Allows you to edit colors in several
+ different ways, and will also perform automatic updates
+ using "send".
+
+rmt - Allows you to "hook-up" remotely to any Tk application
+ on the display. Select an application with the menu,
+ then just type commands: they'll go to that application.
+
+timer - Displays a seconds timer with start and stop buttons.
+ 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
diff --git a/tk/library/demos/arrow.tcl b/tk/library/demos/arrow.tcl
new file mode 100644
index 00000000000..126c17959c4
--- /dev/null
+++ b/tk/library/demos/arrow.tcl
@@ -0,0 +1,238 @@
+# 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
+# window. It's called when the canvas is initially created, and also
+# whenever any of the parameters of the arrow head are changed
+# interactively.
+#
+# Arguments:
+# c - Name of the canvas widget.
+
+proc arrowSetup c {
+ upvar #0 demo_arrowInfo v
+
+ # Remember the current box, if there is one.
+
+ set tags [$c gettags current]
+ if {$tags != ""} {
+ set cur [lindex $tags [lsearch -glob $tags box?]]
+ } else {
+ set cur ""
+ }
+
+ # Create the arrow and outline.
+
+ $c delete all
+ eval "$c create line $v(x1) $v(y) $v(x2) $v(y) -width [expr 10*$v(width)] \
+ -arrowshape {[expr 10*$v(a)] [expr 10*$v(b)] [expr 10*$v(c)]} \
+ -arrow last $v(bigLineStyle)"
+ set xtip [expr $v(x2)-10*$v(b)]
+ set deltaY [expr 10*$v(c)+5*$v(width)]
+ $c create line $v(x2) $v(y) $xtip [expr $v(y)+$deltaY] \
+ [expr $v(x2)-10*$v(a)] $v(y) $xtip [expr $v(y)-$deltaY] \
+ $v(x2) $v(y) -width 2 -capstyle round -joinstyle round
+
+ # Create the boxes for reshaping the line and arrowhead.
+
+ eval "$c create rect [expr $v(x2)-10*$v(a)-5] [expr $v(y)-5] \
+ [expr $v(x2)-10*$v(a)+5] [expr $v(y)+5] $v(boxStyle) \
+ -tags {box1 box}"
+ eval "$c create rect [expr $xtip-5] [expr $v(y)-$deltaY-5] \
+ [expr $xtip+5] [expr $v(y)-$deltaY+5] $v(boxStyle) \
+ -tags {box2 box}"
+ eval "$c create rect [expr $v(x1)-5] [expr $v(y)-5*$v(width)-5] \
+ [expr $v(x1)+5] [expr $v(y)-5*$v(width)+5] $v(boxStyle) \
+ -tags {box3 box}"
+ if {$cur != ""} {
+ eval $c itemconfigure $cur $v(activeStyle)
+ }
+
+ # Create three arrows in actual size with the same parameters
+
+ $c create line [expr $v(x2)+50] 0 [expr $v(x2)+50] 1000 \
+ -width 2
+ set tmp [expr $v(x2)+100]
+ $c create line $tmp [expr $v(y)-125] $tmp [expr $v(y)-75] \
+ -width $v(width) \
+ -arrow both -arrowshape "$v(a) $v(b) $v(c)"
+ $c create line [expr $tmp-25] $v(y) [expr $tmp+25] $v(y) \
+ -width $v(width) \
+ -arrow both -arrowshape "$v(a) $v(b) $v(c)"
+ $c create line [expr $tmp-25] [expr $v(y)+75] [expr $tmp+25] \
+ [expr $v(y)+125] -width $v(width) \
+ -arrow both -arrowshape "$v(a) $v(b) $v(c)"
+
+ # Create a bunch of other arrows and text items showing the
+ # current dimensions.
+
+ set tmp [expr $v(x2)+10]
+ $c create line $tmp [expr $v(y)-5*$v(width)] \
+ $tmp [expr $v(y)-$deltaY] \
+ -arrow both -arrowshape $v(smallTips)
+ $c create text [expr $v(x2)+15] [expr $v(y)-$deltaY+5*$v(c)] \
+ -text $v(c) -anchor w
+ set tmp [expr $v(x1)-10]
+ $c create line $tmp [expr $v(y)-5*$v(width)] \
+ $tmp [expr $v(y)+5*$v(width)] \
+ -arrow both -arrowshape $v(smallTips)
+ $c create text [expr $v(x1)-15] $v(y) -text $v(width) -anchor e
+ set tmp [expr $v(y)+5*$v(width)+10*$v(c)+10]
+ $c create line [expr $v(x2)-10*$v(a)] $tmp $v(x2) $tmp \
+ -arrow both -arrowshape $v(smallTips)
+ $c create text [expr $v(x2)-5*$v(a)] [expr $tmp+5] \
+ -text $v(a) -anchor n
+ set tmp [expr $tmp+25]
+ $c create line [expr $v(x2)-10*$v(b)] $tmp $v(x2) $tmp \
+ -arrow both -arrowshape $v(smallTips)
+ $c create text [expr $v(x2)-5*$v(b)] [expr $tmp+5] \
+ -text $v(b) -anchor n
+
+ $c create text $v(x1) 310 -text "-width $v(width)" \
+ -anchor w -font {Helvetica 18}
+ $c create text $v(x1) 330 -text "-arrowshape {$v(a) $v(b) $v(c)}" \
+ -anchor w -font {Helvetica 18}
+
+ incr v(count)
+}
+
+set w .arrow
+global tk_library
+catch {destroy $w}
+toplevel $w
+wm title $w "Arrowhead Editor Demonstration"
+wm iconname $w "arrow"
+positionWindow $w
+set c $w.c
+
+label $w.msg -font $font -wraplength 5i -justify left -text "This widget allows you to experiment with different widths and arrowhead shapes for lines in canvases. To change the line width or the shape of the arrowhead, drag any of the three boxes attached to the oversized arrow. The arrows on the right give examples at normal scale. The text at the bottom shows the configuration options as you'd enter them for a canvas line item."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+canvas $c -width 500 -height 350 -relief sunken -borderwidth 2
+pack $c -expand yes -fill both
+
+set demo_arrowInfo(a) 8
+set demo_arrowInfo(b) 10
+set demo_arrowInfo(c) 3
+set demo_arrowInfo(width) 2
+set demo_arrowInfo(motionProc) arrowMoveNull
+set demo_arrowInfo(x1) 40
+set demo_arrowInfo(x2) 350
+set demo_arrowInfo(y) 150
+set demo_arrowInfo(smallTips) {5 5 2}
+set demo_arrowInfo(count) 0
+if {[winfo depth $c] > 1} {
+ set demo_arrowInfo(bigLineStyle) "-fill SkyBlue1"
+ set demo_arrowInfo(boxStyle) "-fill {} -outline black -width 1"
+ set demo_arrowInfo(activeStyle) "-fill red -outline black -width 1"
+} else {
+ set demo_arrowInfo(bigLineStyle) "-fill black \
+ -stipple @[file join $tk_library demos images grey.25]"
+ set demo_arrowInfo(boxStyle) "-fill {} -outline black -width 1"
+ set demo_arrowInfo(activeStyle) "-fill black -outline black -width 1"
+}
+arrowSetup $c
+$c bind box <Enter> "$c itemconfigure current $demo_arrowInfo(activeStyle)"
+$c bind box <Leave> "$c itemconfigure current $demo_arrowInfo(boxStyle)"
+$c bind box <B1-Enter> " "
+$c bind box <B1-Leave> " "
+$c bind box1 <1> {set demo_arrowInfo(motionProc) arrowMove1}
+$c bind box2 <1> {set demo_arrowInfo(motionProc) arrowMove2}
+$c bind box3 <1> {set demo_arrowInfo(motionProc) arrowMove3}
+$c bind box <B1-Motion> "\$demo_arrowInfo(motionProc) $c %x %y"
+bind $c <Any-ButtonRelease-1> "arrowSetup $c"
+
+# arrowMove1 --
+# This procedure is called for each mouse motion event on box1 (the
+# one at the vertex of the arrow). It updates the controlling parameters
+# for the line and arrowhead.
+#
+# Arguments:
+# c - The name of the canvas window.
+# x, y - The coordinates of the mouse.
+
+proc arrowMove1 {c x y} {
+ upvar #0 demo_arrowInfo v
+ set newA [expr ($v(x2)+5-round([$c canvasx $x]))/10]
+ if {$newA < 0} {
+ set newA 0
+ }
+ if {$newA > 25} {
+ set newA 25
+ }
+ if {$newA != $v(a)} {
+ $c move box1 [expr 10*($v(a)-$newA)] 0
+ set v(a) $newA
+ }
+}
+
+# arrowMove2 --
+# This procedure is called for each mouse motion event on box2 (the
+# one at the trailing tip of the arrowhead). It updates the controlling
+# parameters for the line and arrowhead.
+#
+# Arguments:
+# c - The name of the canvas window.
+# x, y - The coordinates of the mouse.
+
+proc arrowMove2 {c x y} {
+ upvar #0 demo_arrowInfo v
+ set newB [expr ($v(x2)+5-round([$c canvasx $x]))/10]
+ if {$newB < 0} {
+ set newB 0
+ }
+ if {$newB > 25} {
+ set newB 25
+ }
+ set newC [expr ($v(y)+5-round([$c canvasy $y])-5*$v(width))/10]
+ if {$newC < 0} {
+ set newC 0
+ }
+ if {$newC > 20} {
+ set newC 20
+ }
+ if {($newB != $v(b)) || ($newC != $v(c))} {
+ $c move box2 [expr 10*($v(b)-$newB)] [expr 10*($v(c)-$newC)]
+ set v(b) $newB
+ set v(c) $newC
+ }
+}
+
+# arrowMove3 --
+# This procedure is called for each mouse motion event on box3 (the
+# one that controls the thickness of the line). It updates the
+# controlling parameters for the line and arrowhead.
+#
+# Arguments:
+# c - The name of the canvas window.
+# x, y - The coordinates of the mouse.
+
+proc arrowMove3 {c x y} {
+ upvar #0 demo_arrowInfo v
+ set newWidth [expr ($v(y)+2-round([$c canvasy $y]))/5]
+ if {$newWidth < 0} {
+ set newWidth 0
+ }
+ if {$newWidth > 20} {
+ set newWidth 20
+ }
+ if {$newWidth != $v(width)} {
+ $c move box3 0 [expr 5*($v(width)-$newWidth)]
+ set v(width) $newWidth
+ }
+}
diff --git a/tk/library/demos/bind.tcl b/tk/library/demos/bind.tcl
new file mode 100644
index 00000000000..175be10b465
--- /dev/null
+++ b/tk/library/demos/bind.tcl
@@ -0,0 +1,79 @@
+# 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}
+toplevel $w
+wm title $w "Text Demonstration - Tag Bindings"
+wm iconname $w "bind"
+positionWindow $w
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+text $w.text -yscrollcommand "$w.scroll set" -setgrid true \
+ -width 60 -height 24 -font $font -wrap word
+scrollbar $w.scroll -command "$w.text yview"
+pack $w.scroll -side right -fill y
+pack $w.text -expand yes -fill both
+
+# Set up display styles.
+
+if {[winfo depth $w] > 1} {
+ set bold "-background #43ce80 -relief raised -borderwidth 1"
+ set normal "-background {} -relief flat"
+} else {
+ set bold "-foreground white -background black"
+ set normal "-foreground {} -background {}"
+}
+
+# Add text to widget.
+
+$w.text insert 0.0 {\
+The same tag mechanism that controls display styles in text widgets can also be used to associate Tcl commands with regions of text, so that mouse or keyboard actions on the text cause particular Tcl commands to be invoked. For example, in the text below the descriptions of the canvas demonstrations have been tagged. When you move the mouse over a demo description the description lights up, and when you press button 1 over a description then that particular demonstration is invoked.
+
+}
+$w.text insert end \
+{1. Samples of all the different types of items that can be created in canvas widgets.} d1
+$w.text insert end \n\n
+$w.text insert end \
+{2. A simple two-dimensional plot that allows you to adjust the positions of the data points.} d2
+$w.text insert end \n\n
+$w.text insert end \
+{3. Anchoring and justification modes for text items.} d3
+$w.text insert end \n\n
+$w.text insert end \
+{4. An editor for arrow-head shapes for line items.} d4
+$w.text insert end \n\n
+$w.text insert end \
+{5. A ruler with facilities for editing tab stops.} d5
+$w.text insert end \n\n
+$w.text insert end \
+{6. A grid that demonstrates how canvases can be scrolled.} d6
+
+# Create bindings for tags.
+
+foreach tag {d1 d2 d3 d4 d5 d6} {
+ $w.text tag bind $tag <Any-Enter> "$w.text tag configure $tag $bold"
+ $w.text tag bind $tag <Any-Leave> "$w.text tag configure $tag $normal"
+}
+$w.text tag bind d1 <1> {source [file join $tk_library demos items.tcl]}
+$w.text tag bind d2 <1> {source [file join $tk_library demos plot.tcl]}
+$w.text tag bind d3 <1> {source [file join $tk_library demos ctext.tcl]}
+$w.text tag bind d4 <1> {source [file join $tk_library demos arrow.tcl]}
+$w.text tag bind d5 <1> {source [file join $tk_library demos ruler.tcl]}
+$w.text tag bind d6 <1> {source [file join $tk_library demos cscroll.tcl]}
+
+$w.text mark set insert 0.0
+$w.text configure -state disabled
diff --git a/tk/library/demos/bitmap.tcl b/tk/library/demos/bitmap.tcl
new file mode 100644
index 00000000000..55f9e734946
--- /dev/null
+++ b/tk/library/demos/bitmap.tcl
@@ -0,0 +1,55 @@
+# 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.
+#
+# Arguments:
+# w - The window that is to contain the row.
+# args - The names of one or more bitmaps, which will be displayed
+# in a new row across the bottom of w along with their
+# names.
+
+proc bitmapRow {w args} {
+ frame $w
+ pack $w -side top -fill both
+ set i 0
+ foreach bitmap $args {
+ frame $w.$i
+ pack $w.$i -side left -fill both -pady .25c -padx .25c
+ label $w.$i.bitmap -bitmap $bitmap
+ label $w.$i.label -text $bitmap -width 9
+ pack $w.$i.label $w.$i.bitmap -side bottom
+ incr i
+ }
+}
+
+set w .bitmap
+global tk_library
+catch {destroy $w}
+toplevel $w
+wm title $w "Bitmap Demonstration"
+wm iconname $w "bitmap"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "This window displays all of Tk's built-in bitmaps, along with the names you can use for them in Tcl scripts."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.frame
+bitmapRow $w.frame.0 error gray12 gray25 gray50 gray75
+bitmapRow $w.frame.1 hourglass info question questhead warning
+pack $w.frame -side top -expand yes -fill both
diff --git a/tk/library/demos/browse b/tk/library/demos/browse
new file mode 100755
index 00000000000..46f653264b5
--- /dev/null
+++ b/tk/library/demos/browse
@@ -0,0 +1,56 @@
+#!/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 \
+ -setgrid yes
+pack .list -side left -fill both -expand yes
+wm minsize . 1 1
+
+# The procedure below is invoked to open a browser on a given file; if the
+# file is a directory then another instance of this program is invoked; if
+# the file is a regular file then the Mx editor is invoked to display
+# the file.
+
+proc browse {dir file} {
+ global env
+ if {[string compare $dir "."] != 0} {set file $dir/$file}
+ if [file isdirectory $file] {
+ exec browse $file &
+ } else {
+ if [file isfile $file] {
+ if [info exists env(EDITOR)] {
+ eval exec $env(EDITOR) $file &
+ } else {
+ exec xedit $file &
+ }
+ } else {
+ puts stdout "\"$file\" isn't a directory or regular file"
+ }
+ }
+}
+
+# Fill the listbox with a list of all the files in the directory (run
+# the "ls" command to get that information).
+
+if $argc>0 {set dir [lindex $argv 0]} else {set dir "."}
+foreach i [exec ls -a $dir] {
+ .list insert end $i
+}
+
+# Set up bindings for the browser.
+
+bind all <Control-c> {destroy .}
+bind .list <Double-Button-1> {foreach i [selection get] {browse $dir $i}}
diff --git a/tk/library/demos/button.tcl b/tk/library/demos/button.tcl
new file mode 100644
index 00000000000..8569b1dc5a6
--- /dev/null
+++ b/tk/library/demos/button.tcl
@@ -0,0 +1,36 @@
+# 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}
+toplevel $w
+wm title $w "Button Demonstration"
+wm iconname $w "button"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "If you click on any of the four buttons below, the background of the button area will change to the color indicated in the button. You can press Tab to move among the buttons, then press Space to invoke the current button."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+button $w.b1 -text "Peach Puff" -width 10 \
+ -command "$w config -bg PeachPuff1; $w.buttons config -bg PeachPuff1"
+button $w.b2 -text "Light Blue" -width 10 \
+ -command "$w config -bg LightBlue1; $w.buttons config -bg LightBlue1"
+button $w.b3 -text "Sea Green" -width 10 \
+ -command "$w config -bg SeaGreen2; $w.buttons config -bg SeaGreen2"
+button $w.b4 -text "Yellow" -width 10 \
+ -command "$w config -bg Yellow1; $w.buttons config -bg Yellow1"
+pack $w.b1 $w.b2 $w.b3 $w.b4 -side top -expand yes -pady 2
diff --git a/tk/library/demos/check.tcl b/tk/library/demos/check.tcl
new file mode 100644
index 00000000000..46e21b350eb
--- /dev/null
+++ b/tk/library/demos/check.tcl
@@ -0,0 +1,33 @@
+# 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}
+toplevel $w
+wm title $w "Checkbutton Demonstration"
+wm iconname $w "check"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "Three checkbuttons are displayed below. If you click on a button, it will toggle the button's selection state and set a Tcl variable to a value indicating the state of the checkbutton. Click the \"See Variables\" button to see the current values of the variables."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+button $w.buttons.vars -text "See Variables" \
+ -command "showVars $w.dialog wipers brakes sober"
+pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1
+
+checkbutton $w.b1 -text "Wipers OK" -variable wipers -relief flat
+checkbutton $w.b2 -text "Brakes OK" -variable brakes -relief flat
+checkbutton $w.b3 -text "Driver Sober" -variable sober -relief flat
+pack $w.b1 $w.b2 $w.b3 -side top -pady 2 -anchor w
diff --git a/tk/library/demos/clrpick.tcl b/tk/library/demos/clrpick.tcl
new file mode 100644
index 00000000000..757e0b84bc7
--- /dev/null
+++ b/tk/library/demos/clrpick.tcl
@@ -0,0 +1,56 @@
+# 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}
+toplevel $w
+wm title $w "Color Selection Dialog"
+wm iconname $w "colors"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "Press the buttons below to choose the foreground and background colors for the widgets in this window."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+button $w.back -text "Set background color ..." \
+ -command \
+ "setColor $w $w.back background {-background -highlightbackground}"
+button $w.fore -text "Set foreground color ..." \
+ -command \
+ "setColor $w $w.back foreground -foreground"
+
+pack $w.back $w.fore -side top -anchor c -pady 2m
+
+proc setColor {w button name options} {
+ grab $w
+ set initialColor [$button cget -$name]
+ set color [tk_chooseColor -title "Choose a $name color" -parent $w \
+ -initialcolor $initialColor]
+ if [string compare $color ""] {
+ setColor_helper $w $options $color
+ }
+ grab release $w
+}
+
+proc setColor_helper {w options color} {
+ foreach option $options {
+ catch {
+ $w config $option $color
+ }
+ }
+ foreach child [winfo children $w] {
+ setColor_helper $child $options $color
+ }
+}
diff --git a/tk/library/demos/colors.tcl b/tk/library/demos/colors.tcl
new file mode 100644
index 00000000000..e95c21c8b0a
--- /dev/null
+++ b/tk/library/demos/colors.tcl
@@ -0,0 +1,101 @@
+# 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}
+toplevel $w
+wm title $w "Listbox Demonstration (colors)"
+wm iconname $w "Listbox"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "A listbox containing several color names is displayed below, along with a scrollbar. You can scan the list either using the scrollbar or by dragging in the listbox window with button 2 pressed. If you double-click button 1 on a color, then the application's color palette will be set to match that color"
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.frame -borderwidth 10
+pack $w.frame -side top -expand yes -fill y
+
+scrollbar $w.frame.scroll -command "$w.frame.list yview"
+listbox $w.frame.list -yscroll "$w.frame.scroll set" \
+ -width 20 -height 16 -setgrid 1
+pack $w.frame.list $w.frame.scroll -side left -fill y -expand 1
+
+bind $w.frame.list <Double-1> {
+ tk_setPalette [selection get]
+}
+$w.frame.list insert 0 gray60 gray70 gray80 gray85 gray90 gray95 \
+ snow1 snow2 snow3 snow4 seashell1 seashell2 \
+ seashell3 seashell4 AntiqueWhite1 AntiqueWhite2 AntiqueWhite3 \
+ AntiqueWhite4 bisque1 bisque2 bisque3 bisque4 PeachPuff1 \
+ PeachPuff2 PeachPuff3 PeachPuff4 NavajoWhite1 NavajoWhite2 \
+ NavajoWhite3 NavajoWhite4 LemonChiffon1 LemonChiffon2 \
+ LemonChiffon3 LemonChiffon4 cornsilk1 cornsilk2 cornsilk3 \
+ cornsilk4 ivory1 ivory2 ivory3 ivory4 honeydew1 honeydew2 \
+ honeydew3 honeydew4 LavenderBlush1 LavenderBlush2 \
+ LavenderBlush3 LavenderBlush4 MistyRose1 MistyRose2 \
+ MistyRose3 MistyRose4 azure1 azure2 azure3 azure4 \
+ SlateBlue1 SlateBlue2 SlateBlue3 SlateBlue4 RoyalBlue1 \
+ RoyalBlue2 RoyalBlue3 RoyalBlue4 blue1 blue2 blue3 blue4 \
+ DodgerBlue1 DodgerBlue2 DodgerBlue3 DodgerBlue4 SteelBlue1 \
+ SteelBlue2 SteelBlue3 SteelBlue4 DeepSkyBlue1 DeepSkyBlue2 \
+ DeepSkyBlue3 DeepSkyBlue4 SkyBlue1 SkyBlue2 SkyBlue3 \
+ SkyBlue4 LightSkyBlue1 LightSkyBlue2 LightSkyBlue3 \
+ LightSkyBlue4 SlateGray1 SlateGray2 SlateGray3 SlateGray4 \
+ LightSteelBlue1 LightSteelBlue2 LightSteelBlue3 \
+ LightSteelBlue4 LightBlue1 LightBlue2 LightBlue3 \
+ LightBlue4 LightCyan1 LightCyan2 LightCyan3 LightCyan4 \
+ PaleTurquoise1 PaleTurquoise2 PaleTurquoise3 PaleTurquoise4 \
+ CadetBlue1 CadetBlue2 CadetBlue3 CadetBlue4 turquoise1 \
+ turquoise2 turquoise3 turquoise4 cyan1 cyan2 cyan3 cyan4 \
+ DarkSlateGray1 DarkSlateGray2 DarkSlateGray3 \
+ DarkSlateGray4 aquamarine1 aquamarine2 aquamarine3 \
+ aquamarine4 DarkSeaGreen1 DarkSeaGreen2 DarkSeaGreen3 \
+ DarkSeaGreen4 SeaGreen1 SeaGreen2 SeaGreen3 SeaGreen4 \
+ PaleGreen1 PaleGreen2 PaleGreen3 PaleGreen4 SpringGreen1 \
+ SpringGreen2 SpringGreen3 SpringGreen4 green1 green2 \
+ green3 green4 chartreuse1 chartreuse2 chartreuse3 \
+ chartreuse4 OliveDrab1 OliveDrab2 OliveDrab3 OliveDrab4 \
+ DarkOliveGreen1 DarkOliveGreen2 DarkOliveGreen3 \
+ DarkOliveGreen4 khaki1 khaki2 khaki3 khaki4 \
+ LightGoldenrod1 LightGoldenrod2 LightGoldenrod3 \
+ LightGoldenrod4 LightYellow1 LightYellow2 LightYellow3 \
+ LightYellow4 yellow1 yellow2 yellow3 yellow4 gold1 gold2 \
+ gold3 gold4 goldenrod1 goldenrod2 goldenrod3 goldenrod4 \
+ DarkGoldenrod1 DarkGoldenrod2 DarkGoldenrod3 DarkGoldenrod4 \
+ RosyBrown1 RosyBrown2 RosyBrown3 RosyBrown4 IndianRed1 \
+ IndianRed2 IndianRed3 IndianRed4 sienna1 sienna2 sienna3 \
+ sienna4 burlywood1 burlywood2 burlywood3 burlywood4 wheat1 \
+ wheat2 wheat3 wheat4 tan1 tan2 tan3 tan4 chocolate1 \
+ chocolate2 chocolate3 chocolate4 firebrick1 firebrick2 \
+ firebrick3 firebrick4 brown1 brown2 brown3 brown4 salmon1 \
+ salmon2 salmon3 salmon4 LightSalmon1 LightSalmon2 \
+ LightSalmon3 LightSalmon4 orange1 orange2 orange3 orange4 \
+ DarkOrange1 DarkOrange2 DarkOrange3 DarkOrange4 coral1 \
+ coral2 coral3 coral4 tomato1 tomato2 tomato3 tomato4 \
+ OrangeRed1 OrangeRed2 OrangeRed3 OrangeRed4 red1 red2 red3 \
+ red4 DeepPink1 DeepPink2 DeepPink3 DeepPink4 HotPink1 \
+ HotPink2 HotPink3 HotPink4 pink1 pink2 pink3 pink4 \
+ LightPink1 LightPink2 LightPink3 LightPink4 PaleVioletRed1 \
+ PaleVioletRed2 PaleVioletRed3 PaleVioletRed4 maroon1 \
+ maroon2 maroon3 maroon4 VioletRed1 VioletRed2 VioletRed3 \
+ VioletRed4 magenta1 magenta2 magenta3 magenta4 orchid1 \
+ orchid2 orchid3 orchid4 plum1 plum2 plum3 plum4 \
+ MediumOrchid1 MediumOrchid2 MediumOrchid3 MediumOrchid4 \
+ DarkOrchid1 DarkOrchid2 DarkOrchid3 DarkOrchid4 purple1 \
+ purple2 purple3 purple4 MediumPurple1 MediumPurple2 \
+ MediumPurple3 MediumPurple4 thistle1 thistle2 thistle3 \
+ thistle4
diff --git a/tk/library/demos/cscroll.tcl b/tk/library/demos/cscroll.tcl
new file mode 100644
index 00000000000..78f99fa93b9
--- /dev/null
+++ b/tk/library/demos/cscroll.tcl
@@ -0,0 +1,96 @@
+# 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}
+toplevel $w
+wm title $w "Scrollable Canvas Demonstration"
+wm iconname $w "cscroll"
+positionWindow $w
+set c $w.c
+
+label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget that can be scrolled either using the scrollbars or by dragging with button 2 in the canvas. If you click button 1 on one of the rectangles, its indices will be printed on stdout."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.grid
+scrollbar $w.hscroll -orient horiz -command "$c xview"
+scrollbar $w.vscroll -command "$c yview"
+canvas $c -relief sunken -borderwidth 2 -scrollregion {-11c -11c 50c 20c} \
+ -xscrollcommand "$w.hscroll set" \
+ -yscrollcommand "$w.vscroll set"
+pack $w.grid -expand yes -fill both -padx 1 -pady 1
+grid rowconfig $w.grid 0 -weight 1 -minsize 0
+grid columnconfig $w.grid 0 -weight 1 -minsize 0
+
+grid $c -padx 1 -in $w.grid -pady 1 \
+ -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
+grid $w.vscroll -in $w.grid -padx 1 -pady 1 \
+ -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
+grid $w.hscroll -in $w.grid -padx 1 -pady 1 \
+ -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
+
+
+set bg [lindex [$c config -bg] 4]
+for {set i 0} {$i < 20} {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 $bg -tags rect
+ $c create text [expr $x+1]c [expr $y+1]c -text "$i,$j" \
+ -anchor center -tags text
+ }
+}
+
+$c bind all <Any-Enter> "scrollEnter $c"
+$c bind all <Any-Leave> "scrollLeave $c"
+$c bind all <1> "scrollButton $c"
+bind $c <2> "$c scan mark %x %y"
+bind $c <B2-Motion> "$c scan dragto %x %y"
+
+proc scrollEnter canvas {
+ global oldFill
+ set id [$canvas find withtag current]
+ if {[lsearch [$canvas gettags current] text] >= 0} {
+ set id [expr $id-1]
+ }
+ set oldFill [lindex [$canvas itemconfig $id -fill] 4]
+ if {[winfo depth $canvas] > 1} {
+ $canvas itemconfigure $id -fill SeaGreen1
+ } else {
+ $canvas itemconfigure $id -fill black
+ $canvas itemconfigure [expr $id+1] -fill white
+ }
+}
+
+proc scrollLeave canvas {
+ global oldFill
+ set id [$canvas find withtag current]
+ if {[lsearch [$canvas gettags current] text] >= 0} {
+ set id [expr $id-1]
+ }
+ $canvas itemconfigure $id -fill $oldFill
+ $canvas itemconfigure [expr $id+1] -fill black
+}
+
+proc scrollButton canvas {
+ global oldFill
+ set id [$canvas find withtag current]
+ if {[lsearch [$canvas gettags current] text] < 0} {
+ set id [expr $id+1]
+ }
+ puts stdout "You buttoned at [lindex [$canvas itemconf $id -text] 4]"
+}
diff --git a/tk/library/demos/ctext.tcl b/tk/library/demos/ctext.tcl
new file mode 100644
index 00000000000..fdd3f79a69e
--- /dev/null
+++ b/tk/library/demos/ctext.tcl
@@ -0,0 +1,146 @@
+# 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}
+toplevel $w
+wm title $w "Canvas Text Demonstration"
+wm iconname $w "Text"
+positionWindow $w
+set c $w.c
+
+label $w.msg -font $font -wraplength 5i -justify left -text "This window displays a string of text to demonstrate the text facilities of canvas widgets. You can click in the boxes to adjust the position of the text relative to its positioning point or change its justification. The text also supports the following simple bindings for editing:
+ 1. You can point, click, and type.
+ 2. You can also select with button 1.
+ 3. You can copy the selection to the mouse position with button 2.
+ 4. Backspace and Control+h delete the selection if there is one;
+ otherwise they delete the character just before the insertion cursor.
+ 5. Delete deletes the selection if there is one; otherwise it deletes
+ the character just after the insertion cursor."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+canvas $c -relief flat -borderwidth 0 -width 500 -height 350
+pack $w.c -side top -expand yes -fill both
+
+set textFont {Helvetica 24}
+
+$c create rectangle 245 195 255 205 -outline black -fill red
+
+# First, create the text item and give it bindings so it can be edited.
+
+$c addtag text withtag [$c create text 250 200 -text "This is just a string of text to demonstrate the text facilities of canvas widgets. Bindings have been been defined to support editing (see above)." -width 440 -anchor n -font {Helvetica 24} -justify left]
+$c bind text <1> "textB1Press $c %x %y"
+$c bind text <B1-Motion> "textB1Move $c %x %y"
+$c bind text <Shift-1> "$c select adjust current @%x,%y"
+$c bind text <Shift-B1-Motion> "textB1Move $c %x %y"
+$c bind text <KeyPress> "textInsert $c %A"
+$c bind text <Return> "textInsert $c \\n"
+$c bind text <Control-h> "textBs $c"
+$c bind text <BackSpace> "textBs $c"
+$c bind text <Delete> "textDel $c"
+$c bind text <2> "textPaste $c @%x,%y"
+
+# Next, create some items that allow the text's anchor position
+# to be edited.
+
+proc mkTextConfig {w x y option value color} {
+ set item [$w create rect [expr $x] [expr $y] [expr $x+30] [expr $y+30] \
+ -outline black -fill $color -width 1]
+ $w bind $item <1> "$w itemconf text $option $value"
+ $w addtag config withtag $item
+}
+
+set x 50
+set y 50
+set color LightSkyBlue1
+mkTextConfig $c $x $y -anchor se $color
+mkTextConfig $c [expr $x+30] [expr $y] -anchor s $color
+mkTextConfig $c [expr $x+60] [expr $y] -anchor sw $color
+mkTextConfig $c [expr $x] [expr $y+30] -anchor e $color
+mkTextConfig $c [expr $x+30] [expr $y+30] -anchor center $color
+mkTextConfig $c [expr $x+60] [expr $y+30] -anchor w $color
+mkTextConfig $c [expr $x] [expr $y+60] -anchor ne $color
+mkTextConfig $c [expr $x+30] [expr $y+60] -anchor n $color
+mkTextConfig $c [expr $x+60] [expr $y+60] -anchor nw $color
+set item [$c create rect [expr $x+40] [expr $y+40] [expr $x+50] [expr $y+50] \
+ -outline black -fill red]
+$c bind $item <1> "$c itemconf text -anchor center"
+$c create text [expr $x+45] [expr $y-5] -text {Text Position} -anchor s \
+ -font {Times 24} -fill brown
+
+# Lastly, create some items that allow the text's justification to be
+# changed.
+
+set x 350
+set y 50
+set color SeaGreen2
+mkTextConfig $c $x $y -justify left $color
+mkTextConfig $c [expr $x+30] [expr $y] -justify center $color
+mkTextConfig $c [expr $x+60] [expr $y] -justify right $color
+$c create text [expr $x+45] [expr $y-5] -text {Justification} -anchor s \
+ -font {Times 24} -fill brown
+
+$c bind config <Enter> "textEnter $c"
+$c bind config <Leave> "$c itemconf current -fill \$textConfigFill"
+
+set textConfigFill {}
+
+proc textEnter {w} {
+ global textConfigFill
+ set textConfigFill [lindex [$w itemconfig current -fill] 4]
+ $w itemconfig current -fill black
+}
+
+proc textInsert {w string} {
+ if {$string == ""} {
+ return
+ }
+ catch {$w dchars text sel.first sel.last}
+ $w insert text insert $string
+}
+
+proc textPaste {w pos} {
+ catch {
+ $w insert text $pos [selection get]
+ }
+}
+
+proc textB1Press {w x y} {
+ $w icursor current @$x,$y
+ $w focus current
+ focus $w
+ $w select from current @$x,$y
+}
+
+proc textB1Move {w x y} {
+ $w select to current @$x,$y
+}
+
+proc textBs {w} {
+ if ![catch {$w dchars text sel.first sel.last}] {
+ return
+ }
+ set char [expr {[$w index text insert] - 1}]
+ if {$char >= 0} {$w dchar text $char}
+}
+
+proc textDel {w} {
+ if ![catch {$w dchars text sel.first sel.last}] {
+ return
+ }
+ $w dchars text insert
+}
diff --git a/tk/library/demos/dialog1.tcl b/tk/library/demos/dialog1.tcl
new file mode 100644
index 00000000000..e221beb2df4
--- /dev/null
+++ b/tk/library/demos/dialog1.tcl
@@ -0,0 +1,15 @@
+# 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 {puts "You pressed Cancel"}
+ 2 {showCode .dialog1}
+}
diff --git a/tk/library/demos/dialog2.tcl b/tk/library/demos/dialog2.tcl
new file mode 100644
index 00000000000..0cc3bb6e1e7
--- /dev/null
+++ b/tk/library/demos/dialog2.tcl
@@ -0,0 +1,19 @@
+# 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
+}
+set i [tk_dialog .dialog2 "Dialog with local grab" {This dialog box uses a global grab, so it prevents you from interacting with anything on your display until you invoke one of the buttons below. Global grabs are almost always a bad idea; don't use them unless you're truly desperate.} warning 0 OK Cancel {Show Code}]
+
+switch $i {
+ 0 {puts "You pressed OK"}
+ 1 {puts "You pressed Cancel"}
+ 2 {showCode .dialog2}
+}
diff --git a/tk/library/demos/entry1.tcl b/tk/library/demos/entry1.tcl
new file mode 100644
index 00000000000..0b68b682140
--- /dev/null
+++ b/tk/library/demos/entry1.tcl
@@ -0,0 +1,36 @@
+# 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}
+toplevel $w
+wm title $w "Entry Demonstration (no scrollbars)"
+wm iconname $w "entry1"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 5i -justify left -text "Three different entries are displayed below. You can add characters by pointing, clicking and typing. The normal Motif editing characters are supported, along with many Emacs bindings. For example, Backspace and Control-h delete the character to the left of the insertion cursor and Delete and Control-d delete the chararacter to the right of the insertion cursor. For entries that are too large to fit in the window all at once, you can scan through the entries by dragging with mouse button2 pressed."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+entry $w.e1
+entry $w.e2
+entry $w.e3
+pack $w.e1 $w.e2 $w.e3 -side top -pady 5 -padx 10 -fill x
+
+$w.e1 insert 0 "Initial value"
+$w.e2 insert end "This entry contains a long value, much too long "
+$w.e2 insert end "to fit in the window at one time, so long in fact "
+$w.e2 insert end "that you'll have to scan or scroll to see the end."
diff --git a/tk/library/demos/entry2.tcl b/tk/library/demos/entry2.tcl
new file mode 100644
index 00000000000..d9b67cd846b
--- /dev/null
+++ b/tk/library/demos/entry2.tcl
@@ -0,0 +1,48 @@
+# 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}
+toplevel $w
+wm title $w "Entry Demonstration (with scrollbars)"
+wm iconname $w "entry2"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 5i -justify left -text "Three different entries are displayed below, with a scrollbar for each entry. You can add characters by pointing, clicking and typing. The normal Motif editing characters are supported, along with many Emacs bindings. For example, Backspace and Control-h delete the character to the left of the insertion cursor and Delete and Control-d delete the chararacter to the right of the insertion cursor. For entries that are too large to fit in the window all at once, you can scan through the entries with the scrollbars, or by dragging with mouse button2 pressed."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.frame -borderwidth 10
+pack $w.frame -side top -fill x -expand 1
+
+entry $w.frame.e1 -xscrollcommand "$w.frame.s1 set"
+scrollbar $w.frame.s1 -relief sunken -orient horiz -command \
+ "$w.frame.e1 xview"
+frame $w.frame.spacer1 -width 20 -height 10
+entry $w.frame.e2 -xscrollcommand "$w.frame.s2 set"
+scrollbar $w.frame.s2 -relief sunken -orient horiz -command \
+ "$w.frame.e2 xview"
+frame $w.frame.spacer2 -width 20 -height 10
+entry $w.frame.e3 -xscrollcommand "$w.frame.s3 set"
+scrollbar $w.frame.s3 -relief sunken -orient horiz -command \
+ "$w.frame.e3 xview"
+pack $w.frame.e1 $w.frame.s1 $w.frame.spacer1 $w.frame.e2 $w.frame.s2 \
+ $w.frame.spacer2 $w.frame.e3 $w.frame.s3 -side top -fill x
+
+$w.frame.e1 insert 0 "Initial value"
+$w.frame.e2 insert end "This entry contains a long value, much too long "
+$w.frame.e2 insert end "to fit in the window at one time, so long in fact "
+$w.frame.e2 insert end "that you'll have to scan or scroll to see the end."
diff --git a/tk/library/demos/filebox.tcl b/tk/library/demos/filebox.tcl
new file mode 100644
index 00000000000..83eeacc02b2
--- /dev/null
+++ b/tk/library/demos/filebox.tcl
@@ -0,0 +1,70 @@
+# 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}
+toplevel $w
+wm title $w "File Selection Dialogs"
+wm iconname $w "filebox"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "Enter a file name in the entry box or click on the \"Browse\" buttons to select a file name using the file selection dialog."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+foreach i {open save} {
+ set f [frame $w.$i]
+ label $f.lab -text "Select a file to $i: " -anchor e
+ entry $f.ent -width 20
+ button $f.but -text "Browse ..." -command "fileDialog $w $f.ent $i"
+ pack $f.lab -side left
+ pack $f.ent -side left -expand yes -fill x
+ pack $f.but -side left
+ pack $f -fill x -padx 1c -pady 3
+}
+
+if ![string compare $tcl_platform(platform) unix] {
+ checkbutton $w.strict -text "Use Motif Style Dialog" \
+ -variable tk_strictMotif -onvalue 1 -offvalue 0
+ pack $w.strict -anchor c
+}
+
+proc fileDialog {w ent operation} {
+ # Type names Extension(s) Mac File Type(s)
+ #
+ #---------------------------------------------------------
+ set types {
+ {"Text files" {.txt .doc} }
+ {"Text files" {} TEXT}
+ {"Tcl Scripts" {.tcl} TEXT}
+ {"C Source Files" {.c .h} }
+ {"All Source Files" {.tcl .c .h} }
+ {"Image Files" {.gif} }
+ {"Image Files" {.jpeg .jpg} }
+ {"Image Files" "" {GIFF JPEG}}
+ {"All files" *}
+ }
+ if {$operation == "open"} {
+ set file [tk_getOpenFile -filetypes $types -parent $w]
+ } else {
+ set file [tk_getSaveFile -filetypes $types -parent $w \
+ -initialfile Untitled -defaultextension .txt]
+ }
+ if [string compare $file ""] {
+ $ent delete 0 end
+ $ent insert 0 $file
+ $ent xview end
+ }
+}
diff --git a/tk/library/demos/floor.tcl b/tk/library/demos/floor.tcl
new file mode 100644
index 00000000000..30b62da2e2c
--- /dev/null
+++ b/tk/library/demos/floor.tcl
@@ -0,0 +1,1370 @@
+# 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
+# floor given by "active" is displayed on top with its office structure
+# visible.
+#
+# Arguments:
+# w - Name of the canvas window.
+# active - Number of active floor (1, 2, or 3).
+
+proc floorDisplay {w active} {
+ global floorLabels floorItems colors activeFloor
+
+ if {$activeFloor == $active} {
+ return
+ }
+
+ $w delete all
+ set activeFloor $active
+
+ # First go through the three floors, displaying the backgrounds for
+ # each floor.
+
+ bg1 $w $colors(bg1) $colors(outline1)
+ bg2 $w $colors(bg2) $colors(outline2)
+ bg3 $w $colors(bg3) $colors(outline3)
+
+ # Raise the background for the active floor so that it's on top.
+
+ $w raise floor$active
+
+ # Create a dummy item just to mark this point in the display list,
+ # so we can insert highlights here.
+
+ $w create rect 0 100 1 101 -fill {} -outline {} -tags marker
+
+ # Add the walls and labels for the active floor, along with
+ # transparent polygons that define the rooms on the floor.
+ # Make sure that the room polygons are on top.
+
+ catch {unset floorLabels}
+ catch {unset floorItems}
+ fg$active $w $colors(offices)
+ $w raise room
+
+ # Offset the floors diagonally from each other.
+
+ $w move floor1 2c 2c
+ $w move floor2 1c 1c
+
+ # Create items for the room entry and its label.
+
+ $w create window 600 100 -anchor w -window $w.entry
+ $w create text 600 100 -anchor e -text "Room: "
+ $w config -scrollregion [$w bbox all]
+}
+
+# newRoom --
+# This procedure is invoked whenever the mouse enters a room
+# in the floorplan. It changes tags so that the current room is
+# highlighted.
+#
+# Arguments:
+# w - The name of the canvas window.
+
+proc newRoom w {
+ global currentRoom floorLabels
+
+ set id [$w find withtag current]
+ if {$id != ""} {
+ set currentRoom $floorLabels($id)
+ }
+ update idletasks
+}
+
+# roomChanged --
+# This procedure is invoked whenever the currentRoom variable changes.
+# It highlights the current room and unhighlights any previous room.
+#
+# Arguments:
+# w - The canvas window displaying the floorplan.
+# args - Not used.
+
+proc roomChanged {w args} {
+ global currentRoom floorItems colors
+ $w delete highlight
+ if [catch {set item $floorItems($currentRoom)}] {
+ return
+ }
+ set new [eval \
+ "$w create polygon [$w coords $item] -fill $colors(active) \
+ -tags highlight"]
+ $w raise $new marker
+}
+
+# bg1 --
+# This procedure represents part of the floorplan database. When
+# invoked, it instantiates the background information for the first
+# floor.
+#
+# Arguments:
+# w - The canvas window.
+# fill - Fill color to use for the floor's background.
+# outline - Color to use for the floor's outline.
+
+proc bg1 {w fill outline} {
+ $w create poly 347 80 349 82 351 84 353 85 363 92 375 99 386 104 \
+ 386 129 398 129 398 162 484 162 484 129 559 129 559 133 725 \
+ 133 725 129 802 129 802 389 644 389 644 391 559 391 559 327 \
+ 508 327 508 311 484 311 484 278 395 278 395 288 400 288 404 \
+ 288 409 290 413 292 418 297 421 302 422 309 421 318 417 325 \
+ 411 330 405 332 397 333 344 333 340 334 336 336 335 338 332 \
+ 342 331 347 332 351 334 354 336 357 341 359 340 360 335 363 \
+ 331 365 326 366 304 366 304 355 258 355 258 387 60 387 60 391 \
+ 0 391 0 337 3 337 3 114 8 114 8 25 30 25 30 5 93 5 98 5 104 7 \
+ 110 10 116 16 119 20 122 28 123 32 123 68 220 68 220 34 221 \
+ 22 223 17 227 13 231 8 236 4 242 2 246 0 260 0 283 1 300 5 \
+ 321 14 335 22 348 25 365 29 363 39 358 48 352 56 337 70 \
+ 344 76 347 80 \
+ -tags {floor1 bg} -fill $fill
+ $w create line 386 129 398 129 -fill $outline -tags {floor1 bg}
+ $w create line 258 355 258 387 -fill $outline -tags {floor1 bg}
+ $w create line 60 387 60 391 -fill $outline -tags {floor1 bg}
+ $w create line 0 337 0 391 -fill $outline -tags {floor1 bg}
+ $w create line 60 391 0 391 -fill $outline -tags {floor1 bg}
+ $w create line 3 114 3 337 -fill $outline -tags {floor1 bg}
+ $w create line 258 387 60 387 -fill $outline -tags {floor1 bg}
+ $w create line 484 162 398 162 -fill $outline -tags {floor1 bg}
+ $w create line 398 162 398 129 -fill $outline -tags {floor1 bg}
+ $w create line 484 278 484 311 -fill $outline -tags {floor1 bg}
+ $w create line 484 311 508 311 -fill $outline -tags {floor1 bg}
+ $w create line 508 327 508 311 -fill $outline -tags {floor1 bg}
+ $w create line 559 327 508 327 -fill $outline -tags {floor1 bg}
+ $w create line 644 391 559 391 -fill $outline -tags {floor1 bg}
+ $w create line 644 389 644 391 -fill $outline -tags {floor1 bg}
+ $w create line 559 129 484 129 -fill $outline -tags {floor1 bg}
+ $w create line 484 162 484 129 -fill $outline -tags {floor1 bg}
+ $w create line 725 133 559 133 -fill $outline -tags {floor1 bg}
+ $w create line 559 129 559 133 -fill $outline -tags {floor1 bg}
+ $w create line 725 129 802 129 -fill $outline -tags {floor1 bg}
+ $w create line 802 389 802 129 -fill $outline -tags {floor1 bg}
+ $w create line 3 337 0 337 -fill $outline -tags {floor1 bg}
+ $w create line 559 391 559 327 -fill $outline -tags {floor1 bg}
+ $w create line 802 389 644 389 -fill $outline -tags {floor1 bg}
+ $w create line 725 133 725 129 -fill $outline -tags {floor1 bg}
+ $w create line 8 25 8 114 -fill $outline -tags {floor1 bg}
+ $w create line 8 114 3 114 -fill $outline -tags {floor1 bg}
+ $w create line 30 25 8 25 -fill $outline -tags {floor1 bg}
+ $w create line 484 278 395 278 -fill $outline -tags {floor1 bg}
+ $w create line 30 25 30 5 -fill $outline -tags {floor1 bg}
+ $w create line 93 5 30 5 -fill $outline -tags {floor1 bg}
+ $w create line 98 5 93 5 -fill $outline -tags {floor1 bg}
+ $w create line 104 7 98 5 -fill $outline -tags {floor1 bg}
+ $w create line 110 10 104 7 -fill $outline -tags {floor1 bg}
+ $w create line 116 16 110 10 -fill $outline -tags {floor1 bg}
+ $w create line 119 20 116 16 -fill $outline -tags {floor1 bg}
+ $w create line 122 28 119 20 -fill $outline -tags {floor1 bg}
+ $w create line 123 32 122 28 -fill $outline -tags {floor1 bg}
+ $w create line 123 68 123 32 -fill $outline -tags {floor1 bg}
+ $w create line 220 68 123 68 -fill $outline -tags {floor1 bg}
+ $w create line 386 129 386 104 -fill $outline -tags {floor1 bg}
+ $w create line 386 104 375 99 -fill $outline -tags {floor1 bg}
+ $w create line 375 99 363 92 -fill $outline -tags {floor1 bg}
+ $w create line 353 85 363 92 -fill $outline -tags {floor1 bg}
+ $w create line 220 68 220 34 -fill $outline -tags {floor1 bg}
+ $w create line 337 70 352 56 -fill $outline -tags {floor1 bg}
+ $w create line 352 56 358 48 -fill $outline -tags {floor1 bg}
+ $w create line 358 48 363 39 -fill $outline -tags {floor1 bg}
+ $w create line 363 39 365 29 -fill $outline -tags {floor1 bg}
+ $w create line 365 29 348 25 -fill $outline -tags {floor1 bg}
+ $w create line 348 25 335 22 -fill $outline -tags {floor1 bg}
+ $w create line 335 22 321 14 -fill $outline -tags {floor1 bg}
+ $w create line 321 14 300 5 -fill $outline -tags {floor1 bg}
+ $w create line 300 5 283 1 -fill $outline -tags {floor1 bg}
+ $w create line 283 1 260 0 -fill $outline -tags {floor1 bg}
+ $w create line 260 0 246 0 -fill $outline -tags {floor1 bg}
+ $w create line 246 0 242 2 -fill $outline -tags {floor1 bg}
+ $w create line 242 2 236 4 -fill $outline -tags {floor1 bg}
+ $w create line 236 4 231 8 -fill $outline -tags {floor1 bg}
+ $w create line 231 8 227 13 -fill $outline -tags {floor1 bg}
+ $w create line 223 17 227 13 -fill $outline -tags {floor1 bg}
+ $w create line 221 22 223 17 -fill $outline -tags {floor1 bg}
+ $w create line 220 34 221 22 -fill $outline -tags {floor1 bg}
+ $w create line 340 360 335 363 -fill $outline -tags {floor1 bg}
+ $w create line 335 363 331 365 -fill $outline -tags {floor1 bg}
+ $w create line 331 365 326 366 -fill $outline -tags {floor1 bg}
+ $w create line 326 366 304 366 -fill $outline -tags {floor1 bg}
+ $w create line 304 355 304 366 -fill $outline -tags {floor1 bg}
+ $w create line 395 288 400 288 -fill $outline -tags {floor1 bg}
+ $w create line 404 288 400 288 -fill $outline -tags {floor1 bg}
+ $w create line 409 290 404 288 -fill $outline -tags {floor1 bg}
+ $w create line 413 292 409 290 -fill $outline -tags {floor1 bg}
+ $w create line 418 297 413 292 -fill $outline -tags {floor1 bg}
+ $w create line 421 302 418 297 -fill $outline -tags {floor1 bg}
+ $w create line 422 309 421 302 -fill $outline -tags {floor1 bg}
+ $w create line 421 318 422 309 -fill $outline -tags {floor1 bg}
+ $w create line 421 318 417 325 -fill $outline -tags {floor1 bg}
+ $w create line 417 325 411 330 -fill $outline -tags {floor1 bg}
+ $w create line 411 330 405 332 -fill $outline -tags {floor1 bg}
+ $w create line 405 332 397 333 -fill $outline -tags {floor1 bg}
+ $w create line 397 333 344 333 -fill $outline -tags {floor1 bg}
+ $w create line 344 333 340 334 -fill $outline -tags {floor1 bg}
+ $w create line 340 334 336 336 -fill $outline -tags {floor1 bg}
+ $w create line 336 336 335 338 -fill $outline -tags {floor1 bg}
+ $w create line 335 338 332 342 -fill $outline -tags {floor1 bg}
+ $w create line 331 347 332 342 -fill $outline -tags {floor1 bg}
+ $w create line 332 351 331 347 -fill $outline -tags {floor1 bg}
+ $w create line 334 354 332 351 -fill $outline -tags {floor1 bg}
+ $w create line 336 357 334 354 -fill $outline -tags {floor1 bg}
+ $w create line 341 359 336 357 -fill $outline -tags {floor1 bg}
+ $w create line 341 359 340 360 -fill $outline -tags {floor1 bg}
+ $w create line 395 288 395 278 -fill $outline -tags {floor1 bg}
+ $w create line 304 355 258 355 -fill $outline -tags {floor1 bg}
+ $w create line 347 80 344 76 -fill $outline -tags {floor1 bg}
+ $w create line 344 76 337 70 -fill $outline -tags {floor1 bg}
+ $w create line 349 82 347 80 -fill $outline -tags {floor1 bg}
+ $w create line 351 84 349 82 -fill $outline -tags {floor1 bg}
+ $w create line 353 85 351 84 -fill $outline -tags {floor1 bg}
+}
+
+# bg2 --
+# This procedure represents part of the floorplan database. When
+# invoked, it instantiates the background information for the second
+# floor.
+#
+# Arguments:
+# w - The canvas window.
+# fill - Fill color to use for the floor's background.
+# outline - Color to use for the floor's outline.
+
+proc bg2 {w fill outline} {
+ $w create poly 559 129 484 129 484 162 398 162 398 129 315 129 \
+ 315 133 176 133 176 129 96 129 96 133 3 133 3 339 0 339 0 391 \
+ 60 391 60 387 258 387 258 329 350 329 350 311 395 311 395 280 \
+ 484 280 484 311 508 311 508 327 558 327 558 391 644 391 644 \
+ 367 802 367 802 129 725 129 725 133 559 133 559 129 \
+ -tags {floor2 bg} -fill $fill
+ $w create line 350 311 350 329 -fill $outline -tags {floor2 bg}
+ $w create line 398 129 398 162 -fill $outline -tags {floor2 bg}
+ $w create line 802 367 802 129 -fill $outline -tags {floor2 bg}
+ $w create line 802 129 725 129 -fill $outline -tags {floor2 bg}
+ $w create line 725 133 725 129 -fill $outline -tags {floor2 bg}
+ $w create line 559 129 559 133 -fill $outline -tags {floor2 bg}
+ $w create line 559 133 725 133 -fill $outline -tags {floor2 bg}
+ $w create line 484 162 484 129 -fill $outline -tags {floor2 bg}
+ $w create line 559 129 484 129 -fill $outline -tags {floor2 bg}
+ $w create line 802 367 644 367 -fill $outline -tags {floor2 bg}
+ $w create line 644 367 644 391 -fill $outline -tags {floor2 bg}
+ $w create line 644 391 558 391 -fill $outline -tags {floor2 bg}
+ $w create line 558 327 558 391 -fill $outline -tags {floor2 bg}
+ $w create line 558 327 508 327 -fill $outline -tags {floor2 bg}
+ $w create line 508 327 508 311 -fill $outline -tags {floor2 bg}
+ $w create line 484 311 508 311 -fill $outline -tags {floor2 bg}
+ $w create line 484 280 484 311 -fill $outline -tags {floor2 bg}
+ $w create line 398 162 484 162 -fill $outline -tags {floor2 bg}
+ $w create line 484 280 395 280 -fill $outline -tags {floor2 bg}
+ $w create line 395 280 395 311 -fill $outline -tags {floor2 bg}
+ $w create line 258 387 60 387 -fill $outline -tags {floor2 bg}
+ $w create line 3 133 3 339 -fill $outline -tags {floor2 bg}
+ $w create line 3 339 0 339 -fill $outline -tags {floor2 bg}
+ $w create line 60 391 0 391 -fill $outline -tags {floor2 bg}
+ $w create line 0 339 0 391 -fill $outline -tags {floor2 bg}
+ $w create line 60 387 60 391 -fill $outline -tags {floor2 bg}
+ $w create line 258 329 258 387 -fill $outline -tags {floor2 bg}
+ $w create line 350 329 258 329 -fill $outline -tags {floor2 bg}
+ $w create line 395 311 350 311 -fill $outline -tags {floor2 bg}
+ $w create line 398 129 315 129 -fill $outline -tags {floor2 bg}
+ $w create line 176 133 315 133 -fill $outline -tags {floor2 bg}
+ $w create line 176 129 96 129 -fill $outline -tags {floor2 bg}
+ $w create line 3 133 96 133 -fill $outline -tags {floor2 bg}
+ $w create line 315 133 315 129 -fill $outline -tags {floor2 bg}
+ $w create line 176 133 176 129 -fill $outline -tags {floor2 bg}
+ $w create line 96 133 96 129 -fill $outline -tags {floor2 bg}
+}
+
+# bg3 --
+# This procedure represents part of the floorplan database. When
+# invoked, it instantiates the background information for the third
+# floor.
+#
+# Arguments:
+# w - The canvas window.
+# fill - Fill color to use for the floor's background.
+# outline - Color to use for the floor's outline.
+
+proc bg3 {w fill outline} {
+ $w create poly 159 300 107 300 107 248 159 248 159 129 96 129 96 \
+ 133 21 133 21 331 0 331 0 391 60 391 60 370 159 370 159 300 \
+ -tags {floor3 bg} -fill $fill
+ $w create poly 258 370 258 329 350 329 350 311 399 311 399 129 \
+ 315 129 315 133 176 133 176 129 159 129 159 370 258 370 \
+ -tags {floor3 bg} -fill $fill
+ $w create line 96 133 96 129 -fill $outline -tags {floor3 bg}
+ $w create line 176 129 96 129 -fill $outline -tags {floor3 bg}
+ $w create line 176 129 176 133 -fill $outline -tags {floor3 bg}
+ $w create line 315 133 176 133 -fill $outline -tags {floor3 bg}
+ $w create line 315 133 315 129 -fill $outline -tags {floor3 bg}
+ $w create line 399 129 315 129 -fill $outline -tags {floor3 bg}
+ $w create line 399 311 399 129 -fill $outline -tags {floor3 bg}
+ $w create line 399 311 350 311 -fill $outline -tags {floor3 bg}
+ $w create line 350 329 350 311 -fill $outline -tags {floor3 bg}
+ $w create line 350 329 258 329 -fill $outline -tags {floor3 bg}
+ $w create line 258 370 258 329 -fill $outline -tags {floor3 bg}
+ $w create line 60 370 258 370 -fill $outline -tags {floor3 bg}
+ $w create line 60 370 60 391 -fill $outline -tags {floor3 bg}
+ $w create line 60 391 0 391 -fill $outline -tags {floor3 bg}
+ $w create line 0 391 0 331 -fill $outline -tags {floor3 bg}
+ $w create line 21 331 0 331 -fill $outline -tags {floor3 bg}
+ $w create line 21 331 21 133 -fill $outline -tags {floor3 bg}
+ $w create line 96 133 21 133 -fill $outline -tags {floor3 bg}
+ $w create line 107 300 159 300 159 248 107 248 107 300 \
+ -fill $outline -tags {floor3 bg}
+}
+
+# fg1 --
+# This procedure represents part of the floorplan database. When
+# invoked, it instantiates the foreground information for the first
+# floor (office outlines and numbers).
+#
+# Arguments:
+# w - The canvas window.
+# color - Color to use for drawing foreground information.
+
+proc fg1 {w color} {
+ global floorLabels floorItems
+ set i [$w create polygon 375 246 375 172 341 172 341 246 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 101
+ set {floorItems(101)} $i
+ $w create text 358 209 -text 101 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 307 240 339 240 339 206 307 206 -fill {} -tags {floor1 room}]
+ set floorLabels($i) {Pub Lift1}
+ set {floorItems(Pub Lift1)} $i
+ $w create text 323 223 -text {Pub Lift1} -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 339 205 307 205 307 171 339 171 -fill {} -tags {floor1 room}]
+ set floorLabels($i) {Priv Lift1}
+ set {floorItems(Priv Lift1)} $i
+ $w create text 323 188 -text {Priv Lift1} -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 42 389 42 337 1 337 1 389 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 110
+ set {floorItems(110)} $i
+ $w create text 21.5 363 -text 110 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 59 389 59 385 90 385 90 337 44 337 44 389 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 109
+ set {floorItems(109)} $i
+ $w create text 67 363 -text 109 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 51 300 51 253 6 253 6 300 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 111
+ set {floorItems(111)} $i
+ $w create text 28.5 276.5 -text 111 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 98 248 98 309 79 309 79 248 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 117B
+ set {floorItems(117B)} $i
+ $w create text 88.5 278.5 -text 117B -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 51 251 51 204 6 204 6 251 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 112
+ set {floorItems(112)} $i
+ $w create text 28.5 227.5 -text 112 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 6 156 51 156 51 203 6 203 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 113
+ set {floorItems(113)} $i
+ $w create text 28.5 179.5 -text 113 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 85 169 79 169 79 192 85 192 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 117A
+ set {floorItems(117A)} $i
+ $w create text 82 180.5 -text 117A -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 77 302 77 168 53 168 53 302 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 117
+ set {floorItems(117)} $i
+ $w create text 65 235 -text 117 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 51 155 51 115 6 115 6 155 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 114
+ set {floorItems(114)} $i
+ $w create text 28.5 135 -text 114 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 95 115 53 115 53 168 95 168 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 115
+ set {floorItems(115)} $i
+ $w create text 74 141.5 -text 115 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 87 113 87 27 10 27 10 113 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 116
+ set {floorItems(116)} $i
+ $w create text 48.5 70 -text 116 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 89 91 128 91 128 113 89 113 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 118
+ set {floorItems(118)} $i
+ $w create text 108.5 102 -text 118 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 178 128 178 132 216 132 216 91 163 91 163 112 149 112 149 128 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 120
+ set {floorItems(120)} $i
+ $w create text 189.5 111.5 -text 120 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 79 193 87 193 87 169 136 169 136 192 156 192 156 169 175 169 175 246 79 246 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 122
+ set {floorItems(122)} $i
+ $w create text 131 207.5 -text 122 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 138 169 154 169 154 191 138 191 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 121
+ set {floorItems(121)} $i
+ $w create text 146 180 -text 121 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 99 300 126 300 126 309 99 309 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 106A
+ set {floorItems(106A)} $i
+ $w create text 112.5 304.5 -text 106A -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 128 299 128 309 150 309 150 248 99 248 99 299 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 105
+ set {floorItems(105)} $i
+ $w create text 124.5 278.5 -text 105 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 174 309 174 300 152 300 152 309 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 106B
+ set {floorItems(106B)} $i
+ $w create text 163 304.5 -text 106B -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 176 299 176 309 216 309 216 248 152 248 152 299 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 104
+ set {floorItems(104)} $i
+ $w create text 184 278.5 -text 104 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 138 385 138 337 91 337 91 385 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 108
+ set {floorItems(108)} $i
+ $w create text 114.5 361 -text 108 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 256 337 140 337 140 385 256 385 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 107
+ set {floorItems(107)} $i
+ $w create text 198 361 -text 107 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 300 353 300 329 260 329 260 353 -fill {} -tags {floor1 room}]
+ set floorLabels($i) Smoking
+ set {floorItems(Smoking)} $i
+ $w create text 280 341 -text Smoking -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 314 135 314 170 306 170 306 246 177 246 177 135 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 123
+ set {floorItems(123)} $i
+ $w create text 245.5 190.5 -text 123 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 217 248 301 248 301 326 257 326 257 310 217 310 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 103
+ set {floorItems(103)} $i
+ $w create text 259 287 -text 103 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 396 188 377 188 377 169 316 169 316 131 396 131 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 124
+ set {floorItems(124)} $i
+ $w create text 356 150 -text 124 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 397 226 407 226 407 189 377 189 377 246 397 246 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 125
+ set {floorItems(125)} $i
+ $w create text 392 217.5 -text 125 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 399 187 409 187 409 207 474 207 474 164 399 164 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 126
+ set {floorItems(126)} $i
+ $w create text 436.5 185.5 -text 126 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 409 209 409 229 399 229 399 253 486 253 486 239 474 239 474 209 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 127
+ set {floorItems(127)} $i
+ $w create text 436.5 231 -text 127 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 501 164 501 174 495 174 495 188 490 188 490 204 476 204 476 164 -fill {} -tags {floor1 room}]
+ set floorLabels($i) MShower
+ set {floorItems(MShower)} $i
+ $w create text 488.5 184 -text MShower -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 497 176 513 176 513 204 492 204 492 190 497 190 -fill {} -tags {floor1 room}]
+ set floorLabels($i) Closet
+ set {floorItems(Closet)} $i
+ $w create text 502.5 190 -text Closet -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 476 237 476 206 513 206 513 254 488 254 488 237 -fill {} -tags {floor1 room}]
+ set floorLabels($i) WShower
+ set {floorItems(WShower)} $i
+ $w create text 494.5 230 -text WShower -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 486 131 558 131 558 135 724 135 724 166 697 166 697 275 553 275 531 254 515 254 515 174 503 174 503 161 486 161 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 130
+ set {floorItems(130)} $i
+ $w create text 638.5 205 -text 130 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 308 242 339 242 339 248 342 248 342 246 397 246 397 276 393 276 393 309 300 309 300 248 308 248 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 102
+ set {floorItems(102)} $i
+ $w create text 367.5 278.5 -text 102 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 397 255 486 255 486 276 397 276 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 128
+ set {floorItems(128)} $i
+ $w create text 441.5 265.5 -text 128 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 510 309 486 309 486 255 530 255 552 277 561 277 561 325 510 325 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 129
+ set {floorItems(129)} $i
+ $w create text 535.5 293 -text 129 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 696 281 740 281 740 387 642 387 642 389 561 389 561 277 696 277 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 133
+ set {floorItems(133)} $i
+ $w create text 628.5 335 -text 133 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 742 387 742 281 800 281 800 387 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 132
+ set {floorItems(132)} $i
+ $w create text 771 334 -text 132 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 800 168 800 280 699 280 699 168 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 134
+ set {floorItems(134)} $i
+ $w create text 749.5 224 -text 134 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 726 131 726 166 800 166 800 131 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 135
+ set {floorItems(135)} $i
+ $w create text 763 148.5 -text 135 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 340 360 335 363 331 365 326 366 304 366 304 312 396 312 396 288 400 288 404 288 409 290 413 292 418 297 421 302 422 309 421 318 417 325 411 330 405 332 397 333 344 333 340 334 336 336 335 338 332 342 331 347 332 351 334 354 336 357 341 359 -fill {} -tags {floor1 room}]
+ set floorLabels($i) {Ramona Stair}
+ set {floorItems(Ramona Stair)} $i
+ $w create text 368 323 -text {Ramona Stair} -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 30 23 30 5 93 5 98 5 104 7 110 10 116 16 119 20 122 28 123 32 123 68 220 68 220 87 90 87 90 23 -fill {} -tags {floor1 room}]
+ set floorLabels($i) {University Stair}
+ set {floorItems(University Stair)} $i
+ $w create text 155 77.5 -text {University Stair} -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 282 37 295 40 312 49 323 56 337 70 352 56 358 48 363 39 365 29 348 25 335 22 321 14 300 5 283 1 260 0 246 0 242 2 236 4 231 8 227 13 223 17 221 22 220 34 260 34 -fill {} -tags {floor1 room}]
+ set floorLabels($i) {Plaza Stair}
+ set {floorItems(Plaza Stair)} $i
+ $w create text 317.5 28.5 -text {Plaza Stair} -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 220 34 260 34 282 37 295 40 312 49 323 56 337 70 350 83 365 94 377 100 386 104 386 128 220 128 -fill {} -tags {floor1 room}]
+ set floorLabels($i) {Plaza Deck}
+ set {floorItems(Plaza Deck)} $i
+ $w create text 303 81 -text {Plaza Deck} -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 257 336 77 336 6 336 6 301 77 301 77 310 257 310 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 106
+ set {floorItems(106)} $i
+ $w create text 131.5 318.5 -text 106 -fill $color -anchor c -tags {floor1 label}
+ set i [$w create polygon 146 110 162 110 162 91 130 91 130 115 95 115 95 128 114 128 114 151 157 151 157 153 112 153 112 130 97 130 97 168 175 168 175 131 146 131 -fill {} -tags {floor1 room}]
+ set floorLabels($i) 119
+ set {floorItems(119)} $i
+ $w create text 143.5 133 -text 119 -fill $color -anchor c -tags {floor1 label}
+ $w create line 155 191 155 189 -fill $color -tags {floor1 wall}
+ $w create line 155 177 155 169 -fill $color -tags {floor1 wall}
+ $w create line 96 129 96 169 -fill $color -tags {floor1 wall}
+ $w create line 78 169 176 169 -fill $color -tags {floor1 wall}
+ $w create line 176 247 176 129 -fill $color -tags {floor1 wall}
+ $w create line 340 206 307 206 -fill $color -tags {floor1 wall}
+ $w create line 340 187 340 170 -fill $color -tags {floor1 wall}
+ $w create line 340 210 340 201 -fill $color -tags {floor1 wall}
+ $w create line 340 247 340 224 -fill $color -tags {floor1 wall}
+ $w create line 340 241 307 241 -fill $color -tags {floor1 wall}
+ $w create line 376 246 376 170 -fill $color -tags {floor1 wall}
+ $w create line 307 247 307 170 -fill $color -tags {floor1 wall}
+ $w create line 376 170 307 170 -fill $color -tags {floor1 wall}
+ $w create line 315 129 315 170 -fill $color -tags {floor1 wall}
+ $w create line 147 129 176 129 -fill $color -tags {floor1 wall}
+ $w create line 202 133 176 133 -fill $color -tags {floor1 wall}
+ $w create line 398 129 315 129 -fill $color -tags {floor1 wall}
+ $w create line 258 352 258 387 -fill $color -tags {floor1 wall}
+ $w create line 60 387 60 391 -fill $color -tags {floor1 wall}
+ $w create line 0 337 0 391 -fill $color -tags {floor1 wall}
+ $w create line 60 391 0 391 -fill $color -tags {floor1 wall}
+ $w create line 3 114 3 337 -fill $color -tags {floor1 wall}
+ $w create line 258 387 60 387 -fill $color -tags {floor1 wall}
+ $w create line 52 237 52 273 -fill $color -tags {floor1 wall}
+ $w create line 52 189 52 225 -fill $color -tags {floor1 wall}
+ $w create line 52 140 52 177 -fill $color -tags {floor1 wall}
+ $w create line 395 306 395 311 -fill $color -tags {floor1 wall}
+ $w create line 531 254 398 254 -fill $color -tags {floor1 wall}
+ $w create line 475 178 475 238 -fill $color -tags {floor1 wall}
+ $w create line 502 162 398 162 -fill $color -tags {floor1 wall}
+ $w create line 398 129 398 188 -fill $color -tags {floor1 wall}
+ $w create line 383 188 376 188 -fill $color -tags {floor1 wall}
+ $w create line 408 188 408 194 -fill $color -tags {floor1 wall}
+ $w create line 398 227 398 254 -fill $color -tags {floor1 wall}
+ $w create line 408 227 398 227 -fill $color -tags {floor1 wall}
+ $w create line 408 222 408 227 -fill $color -tags {floor1 wall}
+ $w create line 408 206 408 210 -fill $color -tags {floor1 wall}
+ $w create line 408 208 475 208 -fill $color -tags {floor1 wall}
+ $w create line 484 278 484 311 -fill $color -tags {floor1 wall}
+ $w create line 484 311 508 311 -fill $color -tags {floor1 wall}
+ $w create line 508 327 508 311 -fill $color -tags {floor1 wall}
+ $w create line 559 327 508 327 -fill $color -tags {floor1 wall}
+ $w create line 644 391 559 391 -fill $color -tags {floor1 wall}
+ $w create line 644 389 644 391 -fill $color -tags {floor1 wall}
+ $w create line 514 205 475 205 -fill $color -tags {floor1 wall}
+ $w create line 496 189 496 187 -fill $color -tags {floor1 wall}
+ $w create line 559 129 484 129 -fill $color -tags {floor1 wall}
+ $w create line 484 162 484 129 -fill $color -tags {floor1 wall}
+ $w create line 725 133 559 133 -fill $color -tags {floor1 wall}
+ $w create line 559 129 559 133 -fill $color -tags {floor1 wall}
+ $w create line 725 149 725 167 -fill $color -tags {floor1 wall}
+ $w create line 725 129 802 129 -fill $color -tags {floor1 wall}
+ $w create line 802 389 802 129 -fill $color -tags {floor1 wall}
+ $w create line 739 167 802 167 -fill $color -tags {floor1 wall}
+ $w create line 396 188 408 188 -fill $color -tags {floor1 wall}
+ $w create line 0 337 9 337 -fill $color -tags {floor1 wall}
+ $w create line 58 337 21 337 -fill $color -tags {floor1 wall}
+ $w create line 43 391 43 337 -fill $color -tags {floor1 wall}
+ $w create line 105 337 75 337 -fill $color -tags {floor1 wall}
+ $w create line 91 387 91 337 -fill $color -tags {floor1 wall}
+ $w create line 154 337 117 337 -fill $color -tags {floor1 wall}
+ $w create line 139 387 139 337 -fill $color -tags {floor1 wall}
+ $w create line 227 337 166 337 -fill $color -tags {floor1 wall}
+ $w create line 258 337 251 337 -fill $color -tags {floor1 wall}
+ $w create line 258 328 302 328 -fill $color -tags {floor1 wall}
+ $w create line 302 355 302 311 -fill $color -tags {floor1 wall}
+ $w create line 395 311 302 311 -fill $color -tags {floor1 wall}
+ $w create line 484 278 395 278 -fill $color -tags {floor1 wall}
+ $w create line 395 294 395 278 -fill $color -tags {floor1 wall}
+ $w create line 473 278 473 275 -fill $color -tags {floor1 wall}
+ $w create line 473 256 473 254 -fill $color -tags {floor1 wall}
+ $w create line 533 257 531 254 -fill $color -tags {floor1 wall}
+ $w create line 553 276 551 274 -fill $color -tags {floor1 wall}
+ $w create line 698 276 553 276 -fill $color -tags {floor1 wall}
+ $w create line 559 391 559 327 -fill $color -tags {floor1 wall}
+ $w create line 802 389 644 389 -fill $color -tags {floor1 wall}
+ $w create line 741 314 741 389 -fill $color -tags {floor1 wall}
+ $w create line 698 280 698 167 -fill $color -tags {floor1 wall}
+ $w create line 707 280 698 280 -fill $color -tags {floor1 wall}
+ $w create line 802 280 731 280 -fill $color -tags {floor1 wall}
+ $w create line 741 280 741 302 -fill $color -tags {floor1 wall}
+ $w create line 698 167 727 167 -fill $color -tags {floor1 wall}
+ $w create line 725 137 725 129 -fill $color -tags {floor1 wall}
+ $w create line 514 254 514 175 -fill $color -tags {floor1 wall}
+ $w create line 496 175 514 175 -fill $color -tags {floor1 wall}
+ $w create line 502 175 502 162 -fill $color -tags {floor1 wall}
+ $w create line 475 166 475 162 -fill $color -tags {floor1 wall}
+ $w create line 496 176 496 175 -fill $color -tags {floor1 wall}
+ $w create line 491 189 496 189 -fill $color -tags {floor1 wall}
+ $w create line 491 205 491 189 -fill $color -tags {floor1 wall}
+ $w create line 487 238 475 238 -fill $color -tags {floor1 wall}
+ $w create line 487 240 487 238 -fill $color -tags {floor1 wall}
+ $w create line 487 252 487 254 -fill $color -tags {floor1 wall}
+ $w create line 315 133 304 133 -fill $color -tags {floor1 wall}
+ $w create line 256 133 280 133 -fill $color -tags {floor1 wall}
+ $w create line 78 247 270 247 -fill $color -tags {floor1 wall}
+ $w create line 307 247 294 247 -fill $color -tags {floor1 wall}
+ $w create line 214 133 232 133 -fill $color -tags {floor1 wall}
+ $w create line 217 247 217 266 -fill $color -tags {floor1 wall}
+ $w create line 217 309 217 291 -fill $color -tags {floor1 wall}
+ $w create line 217 309 172 309 -fill $color -tags {floor1 wall}
+ $w create line 154 309 148 309 -fill $color -tags {floor1 wall}
+ $w create line 175 300 175 309 -fill $color -tags {floor1 wall}
+ $w create line 151 300 175 300 -fill $color -tags {floor1 wall}
+ $w create line 151 247 151 309 -fill $color -tags {floor1 wall}
+ $w create line 78 237 78 265 -fill $color -tags {floor1 wall}
+ $w create line 78 286 78 309 -fill $color -tags {floor1 wall}
+ $w create line 106 309 78 309 -fill $color -tags {floor1 wall}
+ $w create line 130 309 125 309 -fill $color -tags {floor1 wall}
+ $w create line 99 309 99 247 -fill $color -tags {floor1 wall}
+ $w create line 127 299 99 299 -fill $color -tags {floor1 wall}
+ $w create line 127 309 127 299 -fill $color -tags {floor1 wall}
+ $w create line 155 191 137 191 -fill $color -tags {floor1 wall}
+ $w create line 137 169 137 191 -fill $color -tags {floor1 wall}
+ $w create line 78 171 78 169 -fill $color -tags {floor1 wall}
+ $w create line 78 190 78 218 -fill $color -tags {floor1 wall}
+ $w create line 86 192 86 169 -fill $color -tags {floor1 wall}
+ $w create line 86 192 78 192 -fill $color -tags {floor1 wall}
+ $w create line 52 301 3 301 -fill $color -tags {floor1 wall}
+ $w create line 52 286 52 301 -fill $color -tags {floor1 wall}
+ $w create line 52 252 3 252 -fill $color -tags {floor1 wall}
+ $w create line 52 203 3 203 -fill $color -tags {floor1 wall}
+ $w create line 3 156 52 156 -fill $color -tags {floor1 wall}
+ $w create line 8 25 8 114 -fill $color -tags {floor1 wall}
+ $w create line 63 114 3 114 -fill $color -tags {floor1 wall}
+ $w create line 75 114 97 114 -fill $color -tags {floor1 wall}
+ $w create line 108 114 129 114 -fill $color -tags {floor1 wall}
+ $w create line 129 114 129 89 -fill $color -tags {floor1 wall}
+ $w create line 52 114 52 128 -fill $color -tags {floor1 wall}
+ $w create line 132 89 88 89 -fill $color -tags {floor1 wall}
+ $w create line 88 25 88 89 -fill $color -tags {floor1 wall}
+ $w create line 88 114 88 89 -fill $color -tags {floor1 wall}
+ $w create line 218 89 144 89 -fill $color -tags {floor1 wall}
+ $w create line 147 111 147 129 -fill $color -tags {floor1 wall}
+ $w create line 162 111 147 111 -fill $color -tags {floor1 wall}
+ $w create line 162 109 162 111 -fill $color -tags {floor1 wall}
+ $w create line 162 96 162 89 -fill $color -tags {floor1 wall}
+ $w create line 218 89 218 94 -fill $color -tags {floor1 wall}
+ $w create line 218 89 218 119 -fill $color -tags {floor1 wall}
+ $w create line 8 25 88 25 -fill $color -tags {floor1 wall}
+ $w create line 258 337 258 328 -fill $color -tags {floor1 wall}
+ $w create line 113 129 96 129 -fill $color -tags {floor1 wall}
+ $w create line 302 355 258 355 -fill $color -tags {floor1 wall}
+ $w create line 386 104 386 129 -fill $color -tags {floor1 wall}
+ $w create line 377 100 386 104 -fill $color -tags {floor1 wall}
+ $w create line 365 94 377 100 -fill $color -tags {floor1 wall}
+ $w create line 350 83 365 94 -fill $color -tags {floor1 wall}
+ $w create line 337 70 350 83 -fill $color -tags {floor1 wall}
+ $w create line 337 70 323 56 -fill $color -tags {floor1 wall}
+ $w create line 312 49 323 56 -fill $color -tags {floor1 wall}
+ $w create line 295 40 312 49 -fill $color -tags {floor1 wall}
+ $w create line 282 37 295 40 -fill $color -tags {floor1 wall}
+ $w create line 260 34 282 37 -fill $color -tags {floor1 wall}
+ $w create line 253 34 260 34 -fill $color -tags {floor1 wall}
+ $w create line 386 128 386 104 -fill $color -tags {floor1 wall}
+ $w create line 113 152 156 152 -fill $color -tags {floor1 wall}
+ $w create line 113 152 156 152 -fill $color -tags {floor1 wall}
+ $w create line 113 152 113 129 -fill $color -tags {floor1 wall}
+}
+
+# fg2 --
+# This procedure represents part of the floorplan database. When
+# invoked, it instantiates the foreground information for the second
+# floor (office outlines and numbers).
+#
+# Arguments:
+# w - The canvas window.
+# color - Color to use for drawing foreground information.
+
+proc fg2 {w color} {
+ global floorLabels floorItems
+ set i [$w create polygon 748 188 755 188 755 205 758 205 758 222 800 222 800 168 748 168 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 238
+ set {floorItems(238)} $i
+ $w create text 774 195 -text 238 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 726 188 746 188 746 166 800 166 800 131 726 131 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 237
+ set {floorItems(237)} $i
+ $w create text 763 148.5 -text 237 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 497 187 497 204 559 204 559 324 641 324 643 324 643 291 641 291 641 205 696 205 696 291 694 291 694 314 715 314 715 291 715 205 755 205 755 190 724 190 724 187 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 246
+ set {floorItems(246)} $i
+ $w create text 600 264 -text 246 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 694 279 643 279 643 314 694 314 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 247
+ set {floorItems(247)} $i
+ $w create text 668.5 296.5 -text 247 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 232 250 308 250 308 242 339 242 339 246 397 246 397 255 476 255 476 250 482 250 559 250 559 274 482 274 482 278 396 278 396 274 232 274 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 202
+ set {floorItems(202)} $i
+ $w create text 285.5 260 -text 202 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 53 228 53 338 176 338 233 338 233 196 306 196 306 180 175 180 175 169 156 169 156 196 176 196 176 228 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 206
+ set {floorItems(206)} $i
+ $w create text 143 267 -text 206 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 51 277 6 277 6 338 51 338 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 212
+ set {floorItems(212)} $i
+ $w create text 28.5 307.5 -text 212 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 557 276 486 276 486 309 510 309 510 325 557 325 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 245
+ set {floorItems(245)} $i
+ $w create text 521.5 300.5 -text 245 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 560 389 599 389 599 326 560 326 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 244
+ set {floorItems(244)} $i
+ $w create text 579.5 357.5 -text 244 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 601 389 601 326 643 326 643 389 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 243
+ set {floorItems(243)} $i
+ $w create text 622 357.5 -text 243 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 688 316 645 316 645 365 688 365 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 242
+ set {floorItems(242)} $i
+ $w create text 666.5 340.5 -text 242 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 802 367 759 367 759 226 802 226 -fill {} -tags {floor2 room}]
+ set floorLabels($i) {Barbecue Deck}
+ set {floorItems(Barbecue Deck)} $i
+ $w create text 780.5 296.5 -text {Barbecue Deck} -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 755 262 755 314 717 314 717 262 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 240
+ set {floorItems(240)} $i
+ $w create text 736 288 -text 240 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 755 316 689 316 689 365 755 365 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 241
+ set {floorItems(241)} $i
+ $w create text 722 340.5 -text 241 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 755 206 717 206 717 261 755 261 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 239
+ set {floorItems(239)} $i
+ $w create text 736 233.5 -text 239 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 695 277 643 277 643 206 695 206 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 248
+ set {floorItems(248)} $i
+ $w create text 669 241.5 -text 248 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 676 135 676 185 724 185 724 135 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 236
+ set {floorItems(236)} $i
+ $w create text 700 160 -text 236 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 675 135 635 135 635 145 628 145 628 185 675 185 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 235
+ set {floorItems(235)} $i
+ $w create text 651.5 160 -text 235 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 626 143 633 143 633 135 572 135 572 143 579 143 579 185 626 185 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 234
+ set {floorItems(234)} $i
+ $w create text 606 160 -text 234 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 557 135 571 135 571 145 578 145 578 185 527 185 527 131 557 131 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 233
+ set {floorItems(233)} $i
+ $w create text 552.5 158 -text 233 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 476 249 557 249 557 205 476 205 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 230
+ set {floorItems(230)} $i
+ $w create text 516.5 227 -text 230 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 476 164 486 164 486 131 525 131 525 185 476 185 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 232
+ set {floorItems(232)} $i
+ $w create text 500.5 158 -text 232 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 476 186 495 186 495 204 476 204 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 229
+ set {floorItems(229)} $i
+ $w create text 485.5 195 -text 229 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 474 207 409 207 409 187 399 187 399 164 474 164 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 227
+ set {floorItems(227)} $i
+ $w create text 436.5 185.5 -text 227 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 399 228 399 253 474 253 474 209 409 209 409 228 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 228
+ set {floorItems(228)} $i
+ $w create text 436.5 231 -text 228 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 397 246 397 226 407 226 407 189 377 189 377 246 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 226
+ set {floorItems(226)} $i
+ $w create text 392 217.5 -text 226 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 377 169 316 169 316 131 397 131 397 188 377 188 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 225
+ set {floorItems(225)} $i
+ $w create text 356.5 150 -text 225 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 234 198 306 198 306 249 234 249 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 224
+ set {floorItems(224)} $i
+ $w create text 270 223.5 -text 224 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 270 179 306 179 306 170 314 170 314 135 270 135 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 223
+ set {floorItems(223)} $i
+ $w create text 292 157 -text 223 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 268 179 221 179 221 135 268 135 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 222
+ set {floorItems(222)} $i
+ $w create text 244.5 157 -text 222 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 177 179 219 179 219 135 177 135 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 221
+ set {floorItems(221)} $i
+ $w create text 198 157 -text 221 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 299 327 349 327 349 284 341 284 341 276 299 276 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 204
+ set {floorItems(204)} $i
+ $w create text 324 301.5 -text 204 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 234 276 297 276 297 327 257 327 257 338 234 338 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 205
+ set {floorItems(205)} $i
+ $w create text 265.5 307 -text 205 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 256 385 256 340 212 340 212 385 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 207
+ set {floorItems(207)} $i
+ $w create text 234 362.5 -text 207 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 210 340 164 340 164 385 210 385 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 208
+ set {floorItems(208)} $i
+ $w create text 187 362.5 -text 208 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 115 340 162 340 162 385 115 385 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 209
+ set {floorItems(209)} $i
+ $w create text 138.5 362.5 -text 209 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 89 228 89 156 53 156 53 228 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 217
+ set {floorItems(217)} $i
+ $w create text 71 192 -text 217 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 89 169 97 169 97 190 89 190 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 217A
+ set {floorItems(217A)} $i
+ $w create text 93 179.5 -text 217A -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 89 156 89 168 95 168 95 135 53 135 53 156 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 216
+ set {floorItems(216)} $i
+ $w create text 71 145.5 -text 216 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 51 179 51 135 6 135 6 179 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 215
+ set {floorItems(215)} $i
+ $w create text 28.5 157 -text 215 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 51 227 6 227 6 180 51 180 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 214
+ set {floorItems(214)} $i
+ $w create text 28.5 203.5 -text 214 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 51 275 6 275 6 229 51 229 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 213
+ set {floorItems(213)} $i
+ $w create text 28.5 252 -text 213 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 114 340 67 340 67 385 114 385 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 210
+ set {floorItems(210)} $i
+ $w create text 90.5 362.5 -text 210 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 59 389 59 385 65 385 65 340 1 340 1 389 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 211
+ set {floorItems(211)} $i
+ $w create text 33 364.5 -text 211 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 393 309 350 309 350 282 342 282 342 276 393 276 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 203
+ set {floorItems(203)} $i
+ $w create text 367.5 292.5 -text 203 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 99 191 91 191 91 226 174 226 174 198 154 198 154 192 109 192 109 169 99 169 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 220
+ set {floorItems(220)} $i
+ $w create text 132.5 208.5 -text 220 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 339 205 307 205 307 171 339 171 -fill {} -tags {floor2 room}]
+ set floorLabels($i) {Priv Lift2}
+ set {floorItems(Priv Lift2)} $i
+ $w create text 323 188 -text {Priv Lift2} -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 307 240 339 240 339 206 307 206 -fill {} -tags {floor2 room}]
+ set floorLabels($i) {Pub Lift 2}
+ set {floorItems(Pub Lift 2)} $i
+ $w create text 323 223 -text {Pub Lift 2} -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 175 168 97 168 97 131 175 131 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 218
+ set {floorItems(218)} $i
+ $w create text 136 149.5 -text 218 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 154 191 111 191 111 169 154 169 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 219
+ set {floorItems(219)} $i
+ $w create text 132.5 180 -text 219 -fill $color -anchor c -tags {floor2 label}
+ set i [$w create polygon 375 246 375 172 341 172 341 246 -fill {} -tags {floor2 room}]
+ set floorLabels($i) 201
+ set {floorItems(201)} $i
+ $w create text 358 209 -text 201 -fill $color -anchor c -tags {floor2 label}
+ $w create line 641 186 678 186 -fill $color -tags {floor2 wall}
+ $w create line 757 350 757 367 -fill $color -tags {floor2 wall}
+ $w create line 634 133 634 144 -fill $color -tags {floor2 wall}
+ $w create line 634 144 627 144 -fill $color -tags {floor2 wall}
+ $w create line 572 133 572 144 -fill $color -tags {floor2 wall}
+ $w create line 572 144 579 144 -fill $color -tags {floor2 wall}
+ $w create line 398 129 398 162 -fill $color -tags {floor2 wall}
+ $w create line 174 197 175 197 -fill $color -tags {floor2 wall}
+ $w create line 175 197 175 227 -fill $color -tags {floor2 wall}
+ $w create line 757 206 757 221 -fill $color -tags {floor2 wall}
+ $w create line 396 188 408 188 -fill $color -tags {floor2 wall}
+ $w create line 727 189 725 189 -fill $color -tags {floor2 wall}
+ $w create line 747 167 802 167 -fill $color -tags {floor2 wall}
+ $w create line 747 167 747 189 -fill $color -tags {floor2 wall}
+ $w create line 755 189 739 189 -fill $color -tags {floor2 wall}
+ $w create line 769 224 757 224 -fill $color -tags {floor2 wall}
+ $w create line 802 224 802 129 -fill $color -tags {floor2 wall}
+ $w create line 802 129 725 129 -fill $color -tags {floor2 wall}
+ $w create line 725 189 725 129 -fill $color -tags {floor2 wall}
+ $w create line 725 186 690 186 -fill $color -tags {floor2 wall}
+ $w create line 676 133 676 186 -fill $color -tags {floor2 wall}
+ $w create line 627 144 627 186 -fill $color -tags {floor2 wall}
+ $w create line 629 186 593 186 -fill $color -tags {floor2 wall}
+ $w create line 579 144 579 186 -fill $color -tags {floor2 wall}
+ $w create line 559 129 559 133 -fill $color -tags {floor2 wall}
+ $w create line 725 133 559 133 -fill $color -tags {floor2 wall}
+ $w create line 484 162 484 129 -fill $color -tags {floor2 wall}
+ $w create line 559 129 484 129 -fill $color -tags {floor2 wall}
+ $w create line 526 129 526 186 -fill $color -tags {floor2 wall}
+ $w create line 540 186 581 186 -fill $color -tags {floor2 wall}
+ $w create line 528 186 523 186 -fill $color -tags {floor2 wall}
+ $w create line 511 186 475 186 -fill $color -tags {floor2 wall}
+ $w create line 496 190 496 186 -fill $color -tags {floor2 wall}
+ $w create line 496 205 496 202 -fill $color -tags {floor2 wall}
+ $w create line 475 205 527 205 -fill $color -tags {floor2 wall}
+ $w create line 558 205 539 205 -fill $color -tags {floor2 wall}
+ $w create line 558 205 558 249 -fill $color -tags {floor2 wall}
+ $w create line 558 249 475 249 -fill $color -tags {floor2 wall}
+ $w create line 662 206 642 206 -fill $color -tags {floor2 wall}
+ $w create line 695 206 675 206 -fill $color -tags {floor2 wall}
+ $w create line 695 278 642 278 -fill $color -tags {floor2 wall}
+ $w create line 642 291 642 206 -fill $color -tags {floor2 wall}
+ $w create line 695 291 695 206 -fill $color -tags {floor2 wall}
+ $w create line 716 208 716 206 -fill $color -tags {floor2 wall}
+ $w create line 757 206 716 206 -fill $color -tags {floor2 wall}
+ $w create line 757 221 757 224 -fill $color -tags {floor2 wall}
+ $w create line 793 224 802 224 -fill $color -tags {floor2 wall}
+ $w create line 757 262 716 262 -fill $color -tags {floor2 wall}
+ $w create line 716 220 716 264 -fill $color -tags {floor2 wall}
+ $w create line 716 315 716 276 -fill $color -tags {floor2 wall}
+ $w create line 757 315 703 315 -fill $color -tags {floor2 wall}
+ $w create line 757 325 757 224 -fill $color -tags {floor2 wall}
+ $w create line 757 367 644 367 -fill $color -tags {floor2 wall}
+ $w create line 689 367 689 315 -fill $color -tags {floor2 wall}
+ $w create line 647 315 644 315 -fill $color -tags {floor2 wall}
+ $w create line 659 315 691 315 -fill $color -tags {floor2 wall}
+ $w create line 600 325 600 391 -fill $color -tags {floor2 wall}
+ $w create line 627 325 644 325 -fill $color -tags {floor2 wall}
+ $w create line 644 391 644 315 -fill $color -tags {floor2 wall}
+ $w create line 615 325 575 325 -fill $color -tags {floor2 wall}
+ $w create line 644 391 558 391 -fill $color -tags {floor2 wall}
+ $w create line 563 325 558 325 -fill $color -tags {floor2 wall}
+ $w create line 558 391 558 314 -fill $color -tags {floor2 wall}
+ $w create line 558 327 508 327 -fill $color -tags {floor2 wall}
+ $w create line 558 275 484 275 -fill $color -tags {floor2 wall}
+ $w create line 558 302 558 275 -fill $color -tags {floor2 wall}
+ $w create line 508 327 508 311 -fill $color -tags {floor2 wall}
+ $w create line 484 311 508 311 -fill $color -tags {floor2 wall}
+ $w create line 484 275 484 311 -fill $color -tags {floor2 wall}
+ $w create line 475 208 408 208 -fill $color -tags {floor2 wall}
+ $w create line 408 206 408 210 -fill $color -tags {floor2 wall}
+ $w create line 408 222 408 227 -fill $color -tags {floor2 wall}
+ $w create line 408 227 398 227 -fill $color -tags {floor2 wall}
+ $w create line 398 227 398 254 -fill $color -tags {floor2 wall}
+ $w create line 408 188 408 194 -fill $color -tags {floor2 wall}
+ $w create line 383 188 376 188 -fill $color -tags {floor2 wall}
+ $w create line 398 188 398 162 -fill $color -tags {floor2 wall}
+ $w create line 398 162 484 162 -fill $color -tags {floor2 wall}
+ $w create line 475 162 475 254 -fill $color -tags {floor2 wall}
+ $w create line 398 254 475 254 -fill $color -tags {floor2 wall}
+ $w create line 484 280 395 280 -fill $color -tags {floor2 wall}
+ $w create line 395 311 395 275 -fill $color -tags {floor2 wall}
+ $w create line 307 197 293 197 -fill $color -tags {floor2 wall}
+ $w create line 278 197 233 197 -fill $color -tags {floor2 wall}
+ $w create line 233 197 233 249 -fill $color -tags {floor2 wall}
+ $w create line 307 179 284 179 -fill $color -tags {floor2 wall}
+ $w create line 233 249 278 249 -fill $color -tags {floor2 wall}
+ $w create line 269 179 269 133 -fill $color -tags {floor2 wall}
+ $w create line 220 179 220 133 -fill $color -tags {floor2 wall}
+ $w create line 155 191 110 191 -fill $color -tags {floor2 wall}
+ $w create line 90 190 98 190 -fill $color -tags {floor2 wall}
+ $w create line 98 169 98 190 -fill $color -tags {floor2 wall}
+ $w create line 52 133 52 165 -fill $color -tags {floor2 wall}
+ $w create line 52 214 52 177 -fill $color -tags {floor2 wall}
+ $w create line 52 226 52 262 -fill $color -tags {floor2 wall}
+ $w create line 52 274 52 276 -fill $color -tags {floor2 wall}
+ $w create line 234 275 234 339 -fill $color -tags {floor2 wall}
+ $w create line 226 339 258 339 -fill $color -tags {floor2 wall}
+ $w create line 211 387 211 339 -fill $color -tags {floor2 wall}
+ $w create line 214 339 177 339 -fill $color -tags {floor2 wall}
+ $w create line 258 387 60 387 -fill $color -tags {floor2 wall}
+ $w create line 3 133 3 339 -fill $color -tags {floor2 wall}
+ $w create line 165 339 129 339 -fill $color -tags {floor2 wall}
+ $w create line 117 339 80 339 -fill $color -tags {floor2 wall}
+ $w create line 68 339 59 339 -fill $color -tags {floor2 wall}
+ $w create line 0 339 46 339 -fill $color -tags {floor2 wall}
+ $w create line 60 391 0 391 -fill $color -tags {floor2 wall}
+ $w create line 0 339 0 391 -fill $color -tags {floor2 wall}
+ $w create line 60 387 60 391 -fill $color -tags {floor2 wall}
+ $w create line 258 329 258 387 -fill $color -tags {floor2 wall}
+ $w create line 350 329 258 329 -fill $color -tags {floor2 wall}
+ $w create line 395 311 350 311 -fill $color -tags {floor2 wall}
+ $w create line 398 129 315 129 -fill $color -tags {floor2 wall}
+ $w create line 176 133 315 133 -fill $color -tags {floor2 wall}
+ $w create line 176 129 96 129 -fill $color -tags {floor2 wall}
+ $w create line 3 133 96 133 -fill $color -tags {floor2 wall}
+ $w create line 66 387 66 339 -fill $color -tags {floor2 wall}
+ $w create line 115 387 115 339 -fill $color -tags {floor2 wall}
+ $w create line 163 387 163 339 -fill $color -tags {floor2 wall}
+ $w create line 234 275 276 275 -fill $color -tags {floor2 wall}
+ $w create line 288 275 309 275 -fill $color -tags {floor2 wall}
+ $w create line 298 275 298 329 -fill $color -tags {floor2 wall}
+ $w create line 341 283 350 283 -fill $color -tags {floor2 wall}
+ $w create line 321 275 341 275 -fill $color -tags {floor2 wall}
+ $w create line 375 275 395 275 -fill $color -tags {floor2 wall}
+ $w create line 315 129 315 170 -fill $color -tags {floor2 wall}
+ $w create line 376 170 307 170 -fill $color -tags {floor2 wall}
+ $w create line 307 250 307 170 -fill $color -tags {floor2 wall}
+ $w create line 376 245 376 170 -fill $color -tags {floor2 wall}
+ $w create line 340 241 307 241 -fill $color -tags {floor2 wall}
+ $w create line 340 245 340 224 -fill $color -tags {floor2 wall}
+ $w create line 340 210 340 201 -fill $color -tags {floor2 wall}
+ $w create line 340 187 340 170 -fill $color -tags {floor2 wall}
+ $w create line 340 206 307 206 -fill $color -tags {floor2 wall}
+ $w create line 293 250 307 250 -fill $color -tags {floor2 wall}
+ $w create line 271 179 238 179 -fill $color -tags {floor2 wall}
+ $w create line 226 179 195 179 -fill $color -tags {floor2 wall}
+ $w create line 176 129 176 179 -fill $color -tags {floor2 wall}
+ $w create line 182 179 176 179 -fill $color -tags {floor2 wall}
+ $w create line 174 169 176 169 -fill $color -tags {floor2 wall}
+ $w create line 162 169 90 169 -fill $color -tags {floor2 wall}
+ $w create line 96 169 96 129 -fill $color -tags {floor2 wall}
+ $w create line 175 227 90 227 -fill $color -tags {floor2 wall}
+ $w create line 90 190 90 227 -fill $color -tags {floor2 wall}
+ $w create line 52 179 3 179 -fill $color -tags {floor2 wall}
+ $w create line 52 228 3 228 -fill $color -tags {floor2 wall}
+ $w create line 52 276 3 276 -fill $color -tags {floor2 wall}
+ $w create line 155 177 155 169 -fill $color -tags {floor2 wall}
+ $w create line 110 191 110 169 -fill $color -tags {floor2 wall}
+ $w create line 155 189 155 197 -fill $color -tags {floor2 wall}
+ $w create line 350 283 350 329 -fill $color -tags {floor2 wall}
+ $w create line 162 197 155 197 -fill $color -tags {floor2 wall}
+ $w create line 341 275 341 283 -fill $color -tags {floor2 wall}
+}
+
+# fg3 --
+# This procedure represents part of the floorplan database. When
+# invoked, it instantiates the foreground information for the third
+# floor (office outlines and numbers).
+#
+# Arguments:
+# w - The canvas window.
+# color - Color to use for drawing foreground information.
+
+proc fg3 {w color} {
+ global floorLabels floorItems
+ set i [$w create polygon 89 228 89 180 70 180 70 228 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 316
+ set {floorItems(316)} $i
+ $w create text 79.5 204 -text 316 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 115 368 162 368 162 323 115 323 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 309
+ set {floorItems(309)} $i
+ $w create text 138.5 345.5 -text 309 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 164 323 164 368 211 368 211 323 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 308
+ set {floorItems(308)} $i
+ $w create text 187.5 345.5 -text 308 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 256 368 212 368 212 323 256 323 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 307
+ set {floorItems(307)} $i
+ $w create text 234 345.5 -text 307 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 244 276 297 276 297 327 260 327 260 321 244 321 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 305
+ set {floorItems(305)} $i
+ $w create text 270.5 301.5 -text 305 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 251 219 251 203 244 203 244 219 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 324B
+ set {floorItems(324B)} $i
+ $w create text 247.5 211 -text 324B -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 251 249 244 249 244 232 251 232 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 324A
+ set {floorItems(324A)} $i
+ $w create text 247.5 240.5 -text 324A -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 223 135 223 179 177 179 177 135 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 320
+ set {floorItems(320)} $i
+ $w create text 200 157 -text 320 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 114 368 114 323 67 323 67 368 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 310
+ set {floorItems(310)} $i
+ $w create text 90.5 345.5 -text 310 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 23 277 23 321 68 321 68 277 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 312
+ set {floorItems(312)} $i
+ $w create text 45.5 299 -text 312 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 23 229 68 229 68 275 23 275 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 313
+ set {floorItems(313)} $i
+ $w create text 45.5 252 -text 313 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 68 227 23 227 23 180 68 180 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 314
+ set {floorItems(314)} $i
+ $w create text 45.5 203.5 -text 314 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 95 179 95 135 23 135 23 179 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 315
+ set {floorItems(315)} $i
+ $w create text 59 157 -text 315 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 99 226 99 204 91 204 91 226 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 316B
+ set {floorItems(316B)} $i
+ $w create text 95 215 -text 316B -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 91 202 99 202 99 180 91 180 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 316A
+ set {floorItems(316A)} $i
+ $w create text 95 191 -text 316A -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 97 169 109 169 109 192 154 192 154 198 174 198 174 226 101 226 101 179 97 179 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 319
+ set {floorItems(319)} $i
+ $w create text 141.5 209 -text 319 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 65 368 58 368 58 389 1 389 1 333 23 333 23 323 65 323 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 311
+ set {floorItems(311)} $i
+ $w create text 29.5 361 -text 311 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 154 191 111 191 111 169 154 169 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 318
+ set {floorItems(318)} $i
+ $w create text 132.5 180 -text 318 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 175 168 97 168 97 131 175 131 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 317
+ set {floorItems(317)} $i
+ $w create text 136 149.5 -text 317 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 274 194 274 221 306 221 306 194 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 323
+ set {floorItems(323)} $i
+ $w create text 290 207.5 -text 323 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 306 222 274 222 274 249 306 249 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 325
+ set {floorItems(325)} $i
+ $w create text 290 235.5 -text 325 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 263 179 224 179 224 135 263 135 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 321
+ set {floorItems(321)} $i
+ $w create text 243.5 157 -text 321 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 314 169 306 169 306 192 273 192 264 181 264 135 314 135 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 322
+ set {floorItems(322)} $i
+ $w create text 293.5 163.5 -text 322 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 307 240 339 240 339 206 307 206 -fill {} -tags {floor3 room}]
+ set floorLabels($i) {Pub Lift3}
+ set {floorItems(Pub Lift3)} $i
+ $w create text 323 223 -text {Pub Lift3} -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 339 205 307 205 307 171 339 171 -fill {} -tags {floor3 room}]
+ set floorLabels($i) {Priv Lift3}
+ set {floorItems(Priv Lift3)} $i
+ $w create text 323 188 -text {Priv Lift3} -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 350 284 376 284 376 276 397 276 397 309 350 309 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 303
+ set {floorItems(303)} $i
+ $w create text 373.5 292.5 -text 303 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 272 203 272 249 252 249 252 230 244 230 244 221 252 221 252 203 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 324
+ set {floorItems(324)} $i
+ $w create text 262 226 -text 324 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 299 276 299 327 349 327 349 284 341 284 341 276 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 304
+ set {floorItems(304)} $i
+ $w create text 324 301.5 -text 304 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 375 246 375 172 341 172 341 246 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 301
+ set {floorItems(301)} $i
+ $w create text 358 209 -text 301 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 397 246 377 246 377 185 397 185 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 327
+ set {floorItems(327)} $i
+ $w create text 387 215.5 -text 327 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 316 131 316 169 377 169 377 185 397 185 397 131 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 326
+ set {floorItems(326)} $i
+ $w create text 356.5 150 -text 326 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 308 251 242 251 242 274 342 274 342 282 375 282 375 274 397 274 397 248 339 248 339 242 308 242 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 302
+ set {floorItems(302)} $i
+ $w create text 319.5 261 -text 302 -fill $color -anchor c -tags {floor3 label}
+ set i [$w create polygon 70 321 242 321 242 200 259 200 259 203 272 203 272 193 263 180 242 180 175 180 175 169 156 169 156 196 177 196 177 228 107 228 70 228 70 275 107 275 107 248 160 248 160 301 107 301 107 275 70 275 -fill {} -tags {floor3 room}]
+ set floorLabels($i) 306
+ set {floorItems(306)} $i
+ $w create text 200.5 284.5 -text 306 -fill $color -anchor c -tags {floor3 label}
+ $w create line 341 275 341 283 -fill $color -tags {floor3 wall}
+ $w create line 162 197 155 197 -fill $color -tags {floor3 wall}
+ $w create line 396 247 399 247 -fill $color -tags {floor3 wall}
+ $w create line 399 129 399 311 -fill $color -tags {floor3 wall}
+ $w create line 258 202 243 202 -fill $color -tags {floor3 wall}
+ $w create line 350 283 350 329 -fill $color -tags {floor3 wall}
+ $w create line 251 231 243 231 -fill $color -tags {floor3 wall}
+ $w create line 243 220 251 220 -fill $color -tags {floor3 wall}
+ $w create line 243 250 243 202 -fill $color -tags {floor3 wall}
+ $w create line 155 197 155 190 -fill $color -tags {floor3 wall}
+ $w create line 110 192 110 169 -fill $color -tags {floor3 wall}
+ $w create line 155 192 110 192 -fill $color -tags {floor3 wall}
+ $w create line 155 177 155 169 -fill $color -tags {floor3 wall}
+ $w create line 176 197 176 227 -fill $color -tags {floor3 wall}
+ $w create line 69 280 69 274 -fill $color -tags {floor3 wall}
+ $w create line 21 276 69 276 -fill $color -tags {floor3 wall}
+ $w create line 69 262 69 226 -fill $color -tags {floor3 wall}
+ $w create line 21 228 69 228 -fill $color -tags {floor3 wall}
+ $w create line 21 179 75 179 -fill $color -tags {floor3 wall}
+ $w create line 69 179 69 214 -fill $color -tags {floor3 wall}
+ $w create line 90 220 90 227 -fill $color -tags {floor3 wall}
+ $w create line 90 204 90 202 -fill $color -tags {floor3 wall}
+ $w create line 90 203 100 203 -fill $color -tags {floor3 wall}
+ $w create line 90 187 90 179 -fill $color -tags {floor3 wall}
+ $w create line 90 227 176 227 -fill $color -tags {floor3 wall}
+ $w create line 100 179 100 227 -fill $color -tags {floor3 wall}
+ $w create line 100 179 87 179 -fill $color -tags {floor3 wall}
+ $w create line 96 179 96 129 -fill $color -tags {floor3 wall}
+ $w create line 162 169 96 169 -fill $color -tags {floor3 wall}
+ $w create line 173 169 176 169 -fill $color -tags {floor3 wall}
+ $w create line 182 179 176 179 -fill $color -tags {floor3 wall}
+ $w create line 176 129 176 179 -fill $color -tags {floor3 wall}
+ $w create line 195 179 226 179 -fill $color -tags {floor3 wall}
+ $w create line 224 133 224 179 -fill $color -tags {floor3 wall}
+ $w create line 264 179 264 133 -fill $color -tags {floor3 wall}
+ $w create line 238 179 264 179 -fill $color -tags {floor3 wall}
+ $w create line 273 207 273 193 -fill $color -tags {floor3 wall}
+ $w create line 273 235 273 250 -fill $color -tags {floor3 wall}
+ $w create line 273 224 273 219 -fill $color -tags {floor3 wall}
+ $w create line 273 193 307 193 -fill $color -tags {floor3 wall}
+ $w create line 273 222 307 222 -fill $color -tags {floor3 wall}
+ $w create line 273 250 307 250 -fill $color -tags {floor3 wall}
+ $w create line 384 247 376 247 -fill $color -tags {floor3 wall}
+ $w create line 340 206 307 206 -fill $color -tags {floor3 wall}
+ $w create line 340 187 340 170 -fill $color -tags {floor3 wall}
+ $w create line 340 210 340 201 -fill $color -tags {floor3 wall}
+ $w create line 340 247 340 224 -fill $color -tags {floor3 wall}
+ $w create line 340 241 307 241 -fill $color -tags {floor3 wall}
+ $w create line 376 247 376 170 -fill $color -tags {floor3 wall}
+ $w create line 307 250 307 170 -fill $color -tags {floor3 wall}
+ $w create line 376 170 307 170 -fill $color -tags {floor3 wall}
+ $w create line 315 129 315 170 -fill $color -tags {floor3 wall}
+ $w create line 376 283 366 283 -fill $color -tags {floor3 wall}
+ $w create line 376 283 376 275 -fill $color -tags {floor3 wall}
+ $w create line 399 275 376 275 -fill $color -tags {floor3 wall}
+ $w create line 341 275 320 275 -fill $color -tags {floor3 wall}
+ $w create line 341 283 350 283 -fill $color -tags {floor3 wall}
+ $w create line 298 275 298 329 -fill $color -tags {floor3 wall}
+ $w create line 308 275 298 275 -fill $color -tags {floor3 wall}
+ $w create line 243 322 243 275 -fill $color -tags {floor3 wall}
+ $w create line 243 275 284 275 -fill $color -tags {floor3 wall}
+ $w create line 258 322 226 322 -fill $color -tags {floor3 wall}
+ $w create line 212 370 212 322 -fill $color -tags {floor3 wall}
+ $w create line 214 322 177 322 -fill $color -tags {floor3 wall}
+ $w create line 163 370 163 322 -fill $color -tags {floor3 wall}
+ $w create line 165 322 129 322 -fill $color -tags {floor3 wall}
+ $w create line 84 322 117 322 -fill $color -tags {floor3 wall}
+ $w create line 71 322 64 322 -fill $color -tags {floor3 wall}
+ $w create line 115 322 115 370 -fill $color -tags {floor3 wall}
+ $w create line 66 322 66 370 -fill $color -tags {floor3 wall}
+ $w create line 52 322 21 322 -fill $color -tags {floor3 wall}
+ $w create line 21 331 0 331 -fill $color -tags {floor3 wall}
+ $w create line 21 331 21 133 -fill $color -tags {floor3 wall}
+ $w create line 96 133 21 133 -fill $color -tags {floor3 wall}
+ $w create line 176 129 96 129 -fill $color -tags {floor3 wall}
+ $w create line 315 133 176 133 -fill $color -tags {floor3 wall}
+ $w create line 315 129 399 129 -fill $color -tags {floor3 wall}
+ $w create line 399 311 350 311 -fill $color -tags {floor3 wall}
+ $w create line 350 329 258 329 -fill $color -tags {floor3 wall}
+ $w create line 258 322 258 370 -fill $color -tags {floor3 wall}
+ $w create line 60 370 258 370 -fill $color -tags {floor3 wall}
+ $w create line 60 370 60 391 -fill $color -tags {floor3 wall}
+ $w create line 0 391 0 331 -fill $color -tags {floor3 wall}
+ $w create line 60 391 0 391 -fill $color -tags {floor3 wall}
+ $w create line 307 250 307 242 -fill $color -tags {floor3 wall}
+ $w create line 273 250 307 250 -fill $color -tags {floor3 wall}
+ $w create line 258 250 243 250 -fill $color -tags {floor3 wall}
+}
+
+# Below is the "main program" that creates the floorplan demonstration.
+
+set w .floor
+global c tk_library currentRoom colors activeFloor
+catch {destroy $w}
+toplevel $w
+wm title $w "Floorplan Canvas Demonstration"
+wm iconname $w "Floorplan"
+wm geometry $w +20+20
+wm minsize $w 100 100
+
+label $w.msg -font $font -wraplength 8i -justify left -text "This window contains a canvas widget showing the floorplan of Digital Equipment Corporation's Western Research Laboratory. It has three levels. At any given time one of the levels is active, meaning that you can see its room structure. To activate a level, click the left mouse button anywhere on it. As the mouse moves over the active level, the room under the mouse lights up and its room number appears in the \"Room:\" entry. You can also type a room number in the entry and the room will light up."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+set f [frame $w.frame]
+pack $f -side top -fill both -expand yes
+set h [scrollbar $f.hscroll -highlightthickness 0 -orient horizontal]
+set v [scrollbar $f.vscroll -highlightthickness 0 -orient vertical]
+set f1 [frame $f.f1 -bd 2 -relief sunken]
+set c [canvas $f1.c -width 900 -height 500 -borderwidth 0 \
+ -highlightthickness 0 -xscrollcommand "$h set" -yscrollcommand "$v set"]
+pack $c -expand yes -fill both
+grid $f1 -padx 1 -pady 1 \
+ -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
+grid $v -padx 1 -pady 1 \
+ -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
+grid $h -padx 1 -pady 1 \
+ -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
+grid rowconfig $f 0 -weight 1 -minsize 0
+grid columnconfig $f 0 -weight 1 -minsize 0
+pack $f -expand yes -fill both -padx 1 -pady 1
+
+$v config -command "$c yview"
+$h config -command "$c xview"
+
+# Create an entry for displaying and typing in current room.
+
+entry $c.entry -width 10 -relief sunken -bd 2 -textvariable currentRoom
+
+# Choose colors, then fill in the floorplan.
+
+if {[winfo depth $c] > 1} {
+ set colors(bg1) #a9c1da
+ set colors(outline1) #77889a
+ set colors(bg2) #9ab0c6
+ set colors(outline2) #687786
+ set colors(bg3) #8ba0b3
+ set colors(outline3) #596673
+ set colors(offices) Black
+ set colors(active) #c4d1df
+} else {
+ set colors(bg1) white
+ set colors(outline1) black
+ set colors(bg2) white
+ set colors(outline2) black
+ set colors(bg3) white
+ set colors(outline3) black
+ set colors(offices) Black
+ set colors(active) black
+}
+set activeFloor ""
+floorDisplay $c 3
+
+# Set up event bindings for canvas:
+
+$c bind floor1 <1> "floorDisplay $c 1"
+$c bind floor2 <1> "floorDisplay $c 2"
+$c bind floor3 <1> "floorDisplay $c 3"
+$c bind room <Enter> "newRoom $c"
+$c bind room <Leave> {set currentRoom ""}
+bind $c <2> "$c scan mark %x %y"
+bind $c <B2-Motion> "$c scan dragto %x %y"
+bind $c <Destroy> "unset currentRoom"
+set currentRoom ""
+trace variable currentRoom w "roomChanged $c"
diff --git a/tk/library/demos/form.tcl b/tk/library/demos/form.tcl
new file mode 100644
index 00000000000..3c43497cbe0
--- /dev/null
+++ b/tk/library/demos/form.tcl
@@ -0,0 +1,40 @@
+# 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}
+toplevel $w
+wm title $w "Form Demonstration"
+wm iconname $w "form"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "This window contains a simple form where you can type in the various entries and use tabs to move circularly between the entries."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+foreach i {f1 f2 f3 f4 f5} {
+ frame $w.$i -bd 2
+ entry $w.$i.entry -relief sunken -width 40
+ label $w.$i.label
+ pack $w.$i.entry -side right
+ pack $w.$i.label -side left
+}
+$w.f1.label config -text Name:
+$w.f2.label config -text Address:
+$w.f5.label config -text Phone:
+pack $w.msg $w.f1 $w.f2 $w.f3 $w.f4 $w.f5 -side top -fill x
+bind $w <Return> "destroy $w"
+focus $w.f1.entry
diff --git a/tk/library/demos/hello b/tk/library/demos/hello
new file mode 100755
index 00000000000..0fa5d05b837
--- /dev/null
+++ b/tk/library/demos/hello
@@ -0,0 +1,18 @@
+#!/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 .
+}
+pack .hello
diff --git a/tk/library/demos/hscale.tcl b/tk/library/demos/hscale.tcl
new file mode 100644
index 00000000000..a760586046a
--- /dev/null
+++ b/tk/library/demos/hscale.tcl
@@ -0,0 +1,47 @@
+# 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}
+toplevel $w
+wm title $w "Horizontal Scale Demonstration"
+wm iconname $w "hscale"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 3.5i -justify left -text "An arrow and a horizontal scale are displayed below. If you click or drag mouse button 1 in the scale, you can change the length of the arrow."
+pack $w.msg -side top -padx .5c
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.frame -borderwidth 10
+pack $w.frame -side top -fill x
+
+canvas $w.frame.canvas -width 50 -height 50 -bd 0 -highlightthickness 0
+$w.frame.canvas create polygon 0 0 1 1 2 2 -fill DeepSkyBlue3 -tags poly
+$w.frame.canvas create line 0 0 1 1 2 2 0 0 -fill black -tags line
+scale $w.frame.scale -orient horizontal -length 284 -from 0 -to 250 \
+ -command "setWidth $w.frame.canvas" -tickinterval 50
+pack $w.frame.canvas -side top -expand yes -anchor s -fill x -padx 15
+pack $w.frame.scale -side bottom -expand yes -anchor n
+$w.frame.scale set 75
+
+proc setWidth {w width} {
+ incr width 21
+ set x2 [expr $width - 30]
+ if {$x2 < 21} {
+ set x2 21
+ }
+ $w coords poly 20 15 20 35 $x2 35 $x2 45 $width 25 $x2 5 $x2 15 20 15
+ $w coords line 20 15 20 35 $x2 35 $x2 45 $width 25 $x2 5 $x2 15 20 15
+}
diff --git a/tk/library/demos/icon.tcl b/tk/library/demos/icon.tcl
new file mode 100644
index 00000000000..1c98fd478b7
--- /dev/null
+++ b/tk/library/demos/icon.tcl
@@ -0,0 +1,52 @@
+# 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}
+toplevel $w
+wm title $w "Iconic Button Demonstration"
+wm iconname $w "icon"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 5i -justify left -text "This window shows three ways of using bitmaps or images in radiobuttons and checkbuttons. On the left are two radiobuttons, each of which displays a bitmap and an indicator. In the middle is a checkbutton that displays a different image depending on whether it is selected or not. On the right is a checkbutton that displays a single bitmap but changes its background color to indicate whether or not it is selected."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+image create bitmap flagup \
+ -file [file join $tk_library demos images flagup.bmp] \
+ -maskfile [file join $tk_library demos images flagup.bmp]
+image create bitmap flagdown \
+ -file [file join $tk_library demos images flagdown.bmp] \
+ -maskfile [file join $tk_library demos images flagdown.bmp]
+frame $w.frame -borderwidth 10
+pack $w.frame -side top
+
+checkbutton $w.frame.b1 -image flagdown -selectimage flagup \
+ -indicatoron 0
+$w.frame.b1 configure -selectcolor [$w.frame.b1 cget -background]
+checkbutton $w.frame.b2 \
+ -bitmap @[file join $tk_library demos images letters.bmp] \
+ -indicatoron 0 -selectcolor SeaGreen1
+frame $w.frame.left
+pack $w.frame.left $w.frame.b1 $w.frame.b2 -side left -expand yes -padx 5m
+
+radiobutton $w.frame.left.b3 \
+ -bitmap @[file join $tk_library demos images letters.bmp] \
+ -variable letters -value full
+radiobutton $w.frame.left.b4 \
+ -bitmap @[file join $tk_library demos images noletter.bmp] \
+ -variable letters -value empty
+pack $w.frame.left.b3 $w.frame.left.b4 -side top -expand yes
diff --git a/tk/library/demos/image1.tcl b/tk/library/demos/image1.tcl
new file mode 100644
index 00000000000..a3b78db92a0
--- /dev/null
+++ b/tk/library/demos/image1.tcl
@@ -0,0 +1,36 @@
+# 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}
+toplevel $w
+wm title $w "Image Demonstration #1"
+wm iconname $w "Image1"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration displays two images, each in a separate label widget."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+catch {image delete image1a}
+image create photo image1a -file [file join $tk_library demos images earth.gif]
+label $w.l1 -image image1a -bd 1 -relief sunken
+
+catch {image delete image1b}
+image create photo image1b \
+ -file [file join $tk_library demos images earthris.gif]
+label $w.l2 -image image1b -bd 1 -relief sunken
+
+pack $w.l1 $w.l2 -side top -padx .5m -pady .5m
diff --git a/tk/library/demos/image2.tcl b/tk/library/demos/image2.tcl
new file mode 100644
index 00000000000..badea14fd32
--- /dev/null
+++ b/tk/library/demos/image2.tcl
@@ -0,0 +1,80 @@
+# 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
+# named in the demo's entry.
+#
+# Arguments:
+# w - Name of the toplevel window of the demo.
+
+proc loadDir w {
+ global dirName
+
+ $w.f.list delete 0 end
+ foreach i [lsort [glob [file join $dirName *]]] {
+ $w.f.list insert end [file tail $i]
+ }
+}
+
+# loadImage --
+# Given the name of the toplevel window of the demo and the mouse
+# position, extracts the directory entry under the mouse and loads
+# that file into a photo image for display.
+#
+# Arguments:
+# w - Name of the toplevel window of the demo.
+# x, y- Mouse position within the listbox.
+
+proc loadImage {w x y} {
+ global dirName
+
+ set file [file join $dirName [$w.f.list get @$x,$y]]
+ image2a configure -file $file
+}
+
+set w .image2
+catch {destroy $w}
+toplevel $w
+wm title $w "Image Demonstration #2"
+wm iconname $w "Image2"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "This demonstration allows you to view images using a Tk \"photo\" image. First type a directory name in the listbox, then type Return to load the directory into the listbox. Then double-click on a file name in the listbox to see that image."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+label $w.dirLabel -text "Directory:"
+set dirName [file join $tk_library demos images]
+entry $w.dirName -width 30 -textvariable dirName
+bind $w.dirName <Return> "loadDir $w"
+frame $w.spacer1 -height 3m -width 20
+label $w.fileLabel -text "File:"
+frame $w.f
+pack $w.dirLabel $w.dirName $w.spacer1 $w.fileLabel $w.f -side top -anchor w
+
+listbox $w.f.list -width 20 -height 10 -yscrollcommand "$w.f.scroll set"
+scrollbar $w.f.scroll -command "$w.f.list yview"
+pack $w.f.list $w.f.scroll -side left -fill y -expand 1
+$w.f.list insert 0 earth.gif earthris.gif teapot.ppm
+bind $w.f.list <Double-1> "loadImage $w %x %y"
+
+catch {image delete image2a}
+image create photo image2a
+frame $w.spacer2 -height 3m -width 20
+label $w.imageLabel -text "Image:"
+label $w.image -image image2a
+pack $w.spacer2 $w.imageLabel $w.image -side top -anchor w
diff --git a/tk/library/demos/images/earth.gif b/tk/library/demos/images/earth.gif
new file mode 100644
index 00000000000..2c229eb1101
--- /dev/null
+++ b/tk/library/demos/images/earth.gif
Binary files differ
diff --git a/tk/library/demos/images/earthris.gif b/tk/library/demos/images/earthris.gif
new file mode 100644
index 00000000000..c4ee4737279
--- /dev/null
+++ b/tk/library/demos/images/earthris.gif
Binary files differ
diff --git a/tk/library/demos/images/face.bmp b/tk/library/demos/images/face.bmp
new file mode 100644
index 00000000000..03d829f4d1f
--- /dev/null
+++ b/tk/library/demos/images/face.bmp
@@ -0,0 +1,173 @@
+#define face_width 108
+#define face_height 144
+#define face_x_hot 48
+#define face_y_hot 80
+static char face_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x20, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x08, 0x09,
+ 0x20, 0x80, 0x24, 0x05, 0x00, 0x80, 0x08, 0x00, 0x00, 0x00, 0x00, 0x88,
+ 0x24, 0x20, 0x80, 0x24, 0x00, 0x00, 0x00, 0x10, 0x80, 0x04, 0x00, 0x01,
+ 0x00, 0x01, 0x40, 0x0a, 0x09, 0x00, 0x92, 0x04, 0x80, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x10, 0x40, 0x12, 0x00, 0x00, 0x10, 0x40, 0x00, 0x00, 0x84,
+ 0x24, 0x40, 0x22, 0xa8, 0x02, 0x14, 0x84, 0x92, 0x40, 0x42, 0x12, 0x04,
+ 0x10, 0x00, 0x00, 0x00, 0x00, 0x52, 0x00, 0x52, 0x11, 0x00, 0x12, 0x00,
+ 0x40, 0x02, 0x00, 0x20, 0x00, 0x08, 0x00, 0xaa, 0x02, 0x54, 0x85, 0x24,
+ 0x00, 0x10, 0x12, 0x00, 0x00, 0x81, 0x44, 0x00, 0x90, 0x5a, 0x00, 0xea,
+ 0x1b, 0x00, 0x80, 0x40, 0x40, 0x02, 0x00, 0x08, 0x00, 0x20, 0xa2, 0x05,
+ 0x8a, 0xb4, 0x6e, 0x45, 0x12, 0x04, 0x08, 0x00, 0x00, 0x00, 0x10, 0x02,
+ 0xa8, 0x92, 0x00, 0xda, 0x5f, 0x10, 0x00, 0x10, 0xa1, 0x04, 0x20, 0x41,
+ 0x02, 0x00, 0x5a, 0x25, 0xa0, 0xff, 0xfb, 0x05, 0x41, 0x02, 0x04, 0x00,
+ 0x00, 0x08, 0x40, 0x80, 0xec, 0x9b, 0xec, 0xfe, 0x7f, 0x01, 0x04, 0x20,
+ 0x90, 0x02, 0x04, 0x00, 0x08, 0x20, 0xfb, 0x2e, 0xf5, 0xff, 0xff, 0x57,
+ 0x00, 0x04, 0x02, 0x00, 0x00, 0x20, 0x01, 0xc1, 0x6e, 0xab, 0xfa, 0xff,
+ 0xff, 0x05, 0x90, 0x20, 0x48, 0x02, 0x00, 0x04, 0x20, 0xa8, 0xdf, 0xb5,
+ 0xfe, 0xff, 0xff, 0x0b, 0x01, 0x00, 0x01, 0x00, 0x80, 0x80, 0x04, 0xe0,
+ 0xbb, 0xef, 0xff, 0xff, 0x7f, 0x01, 0x00, 0x04, 0x48, 0x02, 0x00, 0x20,
+ 0x80, 0xf4, 0x6f, 0xfb, 0xff, 0xff, 0xff, 0x20, 0x90, 0x40, 0x02, 0x00,
+ 0x00, 0x04, 0x08, 0xb8, 0xf6, 0xff, 0xff, 0xdf, 0xbe, 0x12, 0x45, 0x10,
+ 0x90, 0x04, 0x90, 0x00, 0x22, 0xfa, 0xff, 0xff, 0xff, 0xbb, 0xd7, 0xe9,
+ 0x3a, 0x02, 0x02, 0x00, 0x04, 0x90, 0x80, 0xfe, 0xdf, 0xf6, 0xb7, 0xef,
+ 0xbe, 0x56, 0x57, 0x40, 0x48, 0x09, 0x00, 0x04, 0x00, 0xfa, 0xf5, 0xdf,
+ 0xed, 0x5a, 0xd5, 0xea, 0xbd, 0x09, 0x00, 0x00, 0x40, 0x00, 0x92, 0xfe,
+ 0xbf, 0x7d, 0xb7, 0x6a, 0x55, 0xbf, 0xf7, 0x02, 0x11, 0x01, 0x00, 0x91,
+ 0x00, 0xff, 0xff, 0xaf, 0x55, 0x55, 0x5b, 0xeb, 0xef, 0x22, 0x04, 0x04,
+ 0x04, 0x00, 0xa4, 0xff, 0xf7, 0xad, 0xaa, 0xaa, 0xaa, 0xbe, 0xfe, 0x03,
+ 0x20, 0x00, 0x10, 0x44, 0x80, 0xff, 0x7f, 0x55, 0x12, 0x91, 0x2a, 0xeb,
+ 0xbf, 0x0b, 0x82, 0x02, 0x00, 0x00, 0xd1, 0x7f, 0xdf, 0xa2, 0xa4, 0x54,
+ 0x55, 0xfd, 0xfd, 0x47, 0x08, 0x08, 0x00, 0x21, 0xe4, 0xff, 0x37, 0x11,
+ 0x09, 0xa5, 0xaa, 0xb6, 0xff, 0x0d, 0x80, 0x00, 0x00, 0x04, 0xd0, 0xff,
+ 0x4f, 0x44, 0x20, 0x48, 0x55, 0xfb, 0xff, 0x27, 0x11, 0x02, 0x40, 0x40,
+ 0xe2, 0xfb, 0x15, 0x11, 0x4a, 0x55, 0x4a, 0x7d, 0xf7, 0x0f, 0x00, 0x00,
+ 0x04, 0x08, 0xf8, 0xdf, 0x52, 0x44, 0x01, 0x52, 0xb5, 0xfa, 0xff, 0x0f,
+ 0x49, 0x02, 0x00, 0x02, 0xe9, 0xf6, 0x0a, 0x11, 0xa4, 0x88, 0x4a, 0x6d,
+ 0xff, 0x5f, 0x00, 0x00, 0x10, 0x20, 0xf0, 0x2f, 0x21, 0x44, 0x10, 0x52,
+ 0xb5, 0xfa, 0xff, 0x0f, 0x44, 0x04, 0x80, 0x08, 0xf8, 0xab, 0x8a, 0x00,
+ 0x81, 0xa4, 0xd4, 0xd6, 0xfe, 0x2f, 0x00, 0x00, 0x04, 0x40, 0xb5, 0x2d,
+ 0x21, 0x08, 0x04, 0x90, 0xaa, 0xfa, 0xff, 0x1f, 0x11, 0x01, 0x00, 0x04,
+ 0xf0, 0x57, 0x0a, 0x22, 0x40, 0x4a, 0xda, 0x5e, 0xfb, 0x1f, 0x40, 0x00,
+ 0x40, 0x20, 0xba, 0x95, 0x90, 0x00, 0x01, 0xa0, 0xaa, 0xea, 0xff, 0x5f,
+ 0x02, 0x02, 0x00, 0x01, 0xe8, 0x57, 0x05, 0x00, 0x00, 0x12, 0xd5, 0xfe,
+ 0xfd, 0x1f, 0x48, 0x00, 0x04, 0x48, 0x7a, 0x95, 0x08, 0x02, 0x10, 0x40,
+ 0xaa, 0x55, 0xf7, 0x1f, 0x00, 0x09, 0x20, 0x00, 0xf8, 0x57, 0x22, 0x10,
+ 0x00, 0x28, 0xa9, 0xfa, 0xff, 0x5f, 0x02, 0x00, 0x00, 0x49, 0xdd, 0x29,
+ 0x01, 0x00, 0x80, 0x80, 0xaa, 0xd7, 0xff, 0x0f, 0x10, 0x00, 0x08, 0x00,
+ 0xf8, 0x96, 0x08, 0x00, 0x00, 0x20, 0x54, 0xfa, 0xee, 0x3f, 0x81, 0x04,
+ 0x40, 0x24, 0xfe, 0x55, 0x82, 0x00, 0x00, 0x82, 0xd2, 0xad, 0xff, 0x0f,
+ 0x08, 0x00, 0x04, 0x80, 0x6c, 0x97, 0x00, 0x00, 0x02, 0x20, 0xa9, 0xf6,
+ 0xdf, 0x5f, 0x00, 0x02, 0x20, 0x09, 0xfa, 0x49, 0x12, 0x00, 0x20, 0x84,
+ 0x54, 0xdb, 0xfe, 0x1f, 0x91, 0x00, 0x00, 0x00, 0xf8, 0x2b, 0x00, 0x20,
+ 0x00, 0x40, 0xa4, 0xf6, 0xbb, 0x1f, 0x04, 0x00, 0x44, 0x92, 0x7e, 0x95,
+ 0x02, 0x00, 0x00, 0x89, 0xaa, 0xdd, 0xff, 0x1f, 0x20, 0x09, 0x10, 0x00,
+ 0xf4, 0x57, 0x20, 0x01, 0x08, 0x20, 0xa9, 0x76, 0xff, 0x5f, 0x02, 0x00,
+ 0x00, 0x21, 0xfc, 0x4a, 0x05, 0x00, 0x01, 0x80, 0x54, 0xdb, 0xff, 0x1e,
+ 0x08, 0x02, 0x04, 0x08, 0xf9, 0x2b, 0x00, 0x00, 0x40, 0x28, 0xd2, 0xf6,
+ 0xff, 0xbf, 0x80, 0x00, 0x90, 0x00, 0xbc, 0x92, 0x08, 0x10, 0x00, 0x82,
+ 0x54, 0xdb, 0xff, 0x1f, 0x20, 0x00, 0x00, 0x44, 0xf9, 0x55, 0x02, 0x01,
+ 0x00, 0x20, 0xaa, 0xbd, 0xfd, 0x3f, 0x08, 0x04, 0x04, 0x10, 0xf4, 0x2a,
+ 0x01, 0x00, 0x22, 0x80, 0xd4, 0xf6, 0xff, 0x5f, 0x82, 0x00, 0x40, 0x02,
+ 0xf8, 0x55, 0x20, 0x00, 0x00, 0x50, 0x6a, 0xdf, 0xfe, 0x3f, 0x00, 0x00,
+ 0x00, 0x48, 0xe9, 0x4a, 0x05, 0x08, 0x00, 0xa5, 0xd5, 0xf5, 0xff, 0x3f,
+ 0x10, 0x01, 0x10, 0x01, 0xb0, 0xab, 0x92, 0x02, 0x40, 0xf8, 0xbf, 0xde,
+ 0xfe, 0x5f, 0x02, 0x04, 0x04, 0x48, 0xfa, 0xd4, 0x6f, 0x20, 0x84, 0xef,
+ 0xff, 0xfb, 0xff, 0x1f, 0x20, 0x00, 0x00, 0x00, 0xe0, 0xed, 0xbf, 0x0b,
+ 0xa1, 0x7e, 0xff, 0xbf, 0xfd, 0x5f, 0x04, 0x01, 0x20, 0x49, 0xd2, 0xfb,
+ 0xfe, 0x55, 0xd4, 0xff, 0xff, 0xf6, 0xff, 0x07, 0x00, 0x04, 0x00, 0x00,
+ 0xc0, 0xaa, 0xfb, 0x2b, 0xa2, 0xfe, 0xff, 0xdf, 0xee, 0x1f, 0x91, 0x00,
+ 0x82, 0xa4, 0xa4, 0xf5, 0xff, 0x57, 0xd5, 0xff, 0xbf, 0xfd, 0xff, 0x4d,
+ 0x00, 0x00, 0x20, 0x00, 0x88, 0x5b, 0xff, 0x2f, 0x69, 0xff, 0xff, 0xdb,
+ 0xfe, 0x1f, 0x24, 0x02, 0x00, 0x49, 0xa2, 0xd6, 0xff, 0x5f, 0xea, 0xff,
+ 0x7f, 0x7f, 0x7f, 0x0d, 0x00, 0x00, 0x10, 0x00, 0x40, 0xab, 0xf7, 0xbb,
+ 0xf0, 0xdf, 0xff, 0xd5, 0xff, 0xbf, 0x82, 0x04, 0x42, 0x24, 0x91, 0xd5,
+ 0xaa, 0xae, 0xd4, 0xaa, 0x52, 0x7b, 0xff, 0x15, 0x08, 0x00, 0x00, 0x01,
+ 0x04, 0x55, 0xd5, 0x55, 0x70, 0x5b, 0x75, 0xdd, 0xdf, 0x1f, 0x40, 0x00,
+ 0x08, 0x48, 0xa0, 0x4a, 0xa9, 0x56, 0xea, 0x56, 0xad, 0x6a, 0x7d, 0x9b,
+ 0x04, 0x01, 0x00, 0x02, 0x42, 0x2a, 0xd5, 0xaa, 0xa8, 0xaa, 0xaa, 0xfa,
+ 0xdf, 0x2f, 0x10, 0x04, 0x22, 0x48, 0x08, 0x45, 0x2a, 0x15, 0x68, 0x55,
+ 0x55, 0xd7, 0x76, 0x1b, 0x00, 0x00, 0x00, 0x01, 0x40, 0x2a, 0x80, 0xa0,
+ 0xb2, 0x09, 0x48, 0xb9, 0xdf, 0x17, 0x22, 0x01, 0x00, 0x24, 0x45, 0x8a,
+ 0x24, 0x4a, 0x54, 0x51, 0x91, 0xf6, 0x6e, 0x4b, 0x00, 0x04, 0x90, 0x00,
+ 0x80, 0x52, 0x00, 0x20, 0x69, 0x05, 0xa4, 0xaa, 0xff, 0x1e, 0x48, 0x00,
+ 0x02, 0x92, 0x08, 0x05, 0x81, 0x94, 0xd4, 0x92, 0x40, 0xfd, 0xb6, 0x8b,
+ 0x00, 0x01, 0x40, 0x00, 0x82, 0x54, 0x00, 0x48, 0x68, 0x05, 0x90, 0xa4,
+ 0xef, 0x06, 0x24, 0x00, 0x08, 0x12, 0x10, 0x05, 0x00, 0x10, 0xb5, 0x01,
+ 0x42, 0xfb, 0xbf, 0x43, 0x00, 0x09, 0x00, 0x40, 0x81, 0xa8, 0x08, 0x4a,
+ 0xaa, 0x96, 0x90, 0xac, 0x6d, 0x15, 0x22, 0x00, 0x20, 0x09, 0x04, 0x15,
+ 0x80, 0x28, 0xdc, 0x01, 0x24, 0xfb, 0xbf, 0x01, 0x80, 0x04, 0x09, 0x00,
+ 0x40, 0x48, 0x02, 0x45, 0xb2, 0x2e, 0x41, 0x6d, 0xef, 0x05, 0x11, 0x00,
+ 0x40, 0x52, 0x02, 0x15, 0x29, 0x2a, 0xac, 0x42, 0x54, 0xfb, 0x3b, 0x51,
+ 0x84, 0x00, 0x08, 0x00, 0x20, 0x54, 0x80, 0x05, 0xb5, 0x3d, 0xa2, 0xb6,
+ 0xdf, 0x00, 0x20, 0x04, 0x20, 0x49, 0x89, 0xa8, 0x6a, 0x29, 0xac, 0xd6,
+ 0x54, 0xff, 0x3f, 0x84, 0x00, 0x01, 0x04, 0x10, 0x00, 0x94, 0xa8, 0x56,
+ 0xda, 0x5f, 0xab, 0xd5, 0x1e, 0x10, 0x48, 0x00, 0x90, 0x82, 0x48, 0xa8,
+ 0xb2, 0xac, 0xfd, 0x55, 0xd5, 0xfe, 0x9f, 0x80, 0x00, 0x0a, 0x02, 0x08,
+ 0x02, 0x55, 0x5a, 0x75, 0xff, 0xaf, 0xb6, 0xf7, 0x2d, 0x12, 0x92, 0x00,
+ 0x10, 0x20, 0x10, 0xa8, 0x54, 0xd5, 0xbf, 0x5d, 0xad, 0xdd, 0x0f, 0x00,
+ 0x00, 0x04, 0x40, 0x09, 0x84, 0xa8, 0xaa, 0x5a, 0xed, 0xeb, 0x6a, 0xff,
+ 0x9f, 0xa4, 0x24, 0x01, 0x02, 0xa0, 0x20, 0x50, 0x55, 0xd5, 0xbe, 0xae,
+ 0xad, 0xfd, 0x16, 0x00, 0x10, 0x04, 0x20, 0x0a, 0x08, 0xb4, 0xaa, 0x95,
+ 0xaa, 0x7b, 0xb7, 0xdb, 0x5f, 0x92, 0x04, 0x01, 0x84, 0x20, 0x21, 0x51,
+ 0xd5, 0x2a, 0xa9, 0xee, 0xd5, 0xfe, 0x0d, 0x00, 0x20, 0x04, 0x10, 0x00,
+ 0x08, 0x50, 0xe9, 0xd7, 0xd4, 0xfb, 0xb5, 0xff, 0x9f, 0x24, 0x09, 0x01,
+ 0x42, 0x4a, 0xa2, 0x64, 0xd5, 0x55, 0x7b, 0x7f, 0xda, 0x7d, 0x4f, 0x00,
+ 0x20, 0x04, 0x00, 0x80, 0x00, 0xa0, 0x2a, 0x13, 0x84, 0x6a, 0x55, 0xff,
+ 0x1d, 0x48, 0x8a, 0x00, 0x94, 0x24, 0x8a, 0xc8, 0xaa, 0x42, 0x20, 0x5d,
+ 0xf5, 0xff, 0x5f, 0x01, 0x00, 0x02, 0x01, 0x00, 0x20, 0xa2, 0x4a, 0x1a,
+ 0x82, 0x56, 0xda, 0xbd, 0x3f, 0x92, 0x92, 0x00, 0x90, 0x92, 0x00, 0x40,
+ 0x95, 0x6a, 0xf4, 0x55, 0x6d, 0xff, 0xd6, 0x00, 0x00, 0x0a, 0x04, 0x20,
+ 0x14, 0x49, 0x4b, 0xaa, 0xaa, 0x56, 0xf5, 0xff, 0xbf, 0xab, 0xa4, 0x00,
+ 0x20, 0x89, 0x40, 0x80, 0xaa, 0xaa, 0xaa, 0xaa, 0xde, 0xbf, 0xeb, 0x03,
+ 0x00, 0x02, 0x04, 0x02, 0x0a, 0x10, 0x2b, 0x2a, 0x55, 0x5b, 0xf5, 0xff,
+ 0xd7, 0x2f, 0x92, 0x00, 0x10, 0x28, 0x21, 0x01, 0x56, 0x95, 0xa0, 0x56,
+ 0xdf, 0xef, 0xea, 0x87, 0x40, 0x0a, 0x42, 0x41, 0x00, 0x90, 0xaa, 0x52,
+ 0xb6, 0xad, 0xfa, 0xff, 0xd5, 0x2f, 0x14, 0x00, 0x00, 0x04, 0x95, 0x04,
+ 0xaa, 0xac, 0x55, 0x6b, 0xff, 0xb7, 0xea, 0x9f, 0x40, 0x02, 0x28, 0x51,
+ 0x00, 0x40, 0x58, 0xd5, 0xda, 0xd6, 0x6e, 0x7f, 0xf9, 0x3f, 0x12, 0x04,
+ 0x02, 0x04, 0x49, 0x25, 0x55, 0xaa, 0x77, 0xab, 0xff, 0x2b, 0xfd, 0x3f,
+ 0x48, 0x01, 0x20, 0x41, 0x00, 0x00, 0x58, 0xa9, 0xda, 0xea, 0xfd, 0xaf,
+ 0xfa, 0xff, 0x02, 0x04, 0x08, 0x14, 0x29, 0x49, 0x52, 0x55, 0x55, 0x55,
+ 0xff, 0x8d, 0xfe, 0x3f, 0xa8, 0x00, 0x02, 0x41, 0x00, 0x02, 0xa0, 0xa2,
+ 0xaa, 0xea, 0xff, 0x53, 0xfd, 0xff, 0x02, 0x04, 0x50, 0x04, 0x25, 0xa8,
+ 0x54, 0x49, 0x52, 0xb5, 0xbf, 0x8a, 0xfe, 0xff, 0xa9, 0x08, 0x04, 0x50,
+ 0x80, 0x02, 0xa1, 0x2a, 0x95, 0xea, 0xff, 0xa1, 0xff, 0xff, 0x03, 0x02,
+ 0x90, 0x02, 0x09, 0x08, 0x44, 0x49, 0x52, 0xbd, 0x7f, 0xca, 0xff, 0xff,
+ 0x2b, 0x09, 0x04, 0x48, 0x40, 0x82, 0x90, 0x56, 0xa9, 0xf6, 0xbf, 0xd0,
+ 0xff, 0xff, 0x47, 0x00, 0x50, 0x02, 0x15, 0x11, 0x40, 0x95, 0xaa, 0xfd,
+ 0x2f, 0xe9, 0xff, 0xff, 0x8f, 0x0a, 0x84, 0x50, 0x40, 0x84, 0x14, 0xaa,
+ 0x6a, 0xff, 0x5f, 0xf2, 0xff, 0xff, 0x7f, 0x00, 0x10, 0x02, 0x09, 0x10,
+ 0x40, 0x7d, 0xf7, 0xff, 0x0b, 0xfc, 0xff, 0xff, 0xaf, 0x02, 0x84, 0x50,
+ 0x42, 0x85, 0x12, 0xd0, 0xdd, 0xff, 0xa7, 0xf2, 0xff, 0xff, 0xff, 0x04,
+ 0x00, 0x0a, 0x08, 0x10, 0x48, 0xf8, 0xff, 0xff, 0x0a, 0xfe, 0xff, 0xff,
+ 0x7f, 0x03, 0xa4, 0x80, 0xa2, 0x8a, 0x02, 0x68, 0xff, 0xff, 0x52, 0xfd,
+ 0xff, 0xff, 0xff, 0x07, 0x00, 0x2a, 0x08, 0x20, 0x28, 0xdc, 0xff, 0x5f,
+ 0x05, 0xff, 0xff, 0xff, 0xff, 0x0d, 0x92, 0x40, 0x22, 0x09, 0x02, 0xea,
+ 0xfb, 0xaf, 0x48, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x12, 0x81, 0xa0,
+ 0x48, 0x9c, 0x6e, 0x93, 0xa2, 0xff, 0xff, 0xff, 0xff, 0x07, 0xa8, 0x40,
+ 0x28, 0x0a, 0x02, 0x74, 0xb5, 0x45, 0x81, 0xff, 0xff, 0xff, 0xff, 0x0f,
+ 0x02, 0x0a, 0x81, 0x20, 0x08, 0xae, 0xaa, 0x90, 0xe8, 0xff, 0xff, 0xff,
+ 0xff, 0x0f, 0x90, 0x40, 0x28, 0x88, 0x12, 0x58, 0x15, 0x50, 0xd0, 0xff,
+ 0xff, 0xff, 0xff, 0x0f, 0x44, 0x0a, 0x41, 0x21, 0x08, 0xae, 0x04, 0x14,
+ 0xf0, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x10, 0x40, 0x14, 0x88, 0x04, 0xba,
+ 0x02, 0x28, 0xe8, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x42, 0x15, 0x41, 0x21,
+ 0x05, 0xad, 0x00, 0x05, 0xf8, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x10, 0x40,
+ 0x24, 0x8a, 0x0e, 0x36, 0x00, 0x0a, 0xf4, 0xff, 0xff, 0xff, 0xff, 0x0f,
+ 0x42, 0x25, 0x90, 0xd0, 0x8b, 0xc2, 0x41, 0x05, 0xfc, 0xff, 0xff, 0xff,
+ 0xff, 0x0f, 0x10, 0x08, 0x05, 0xe8, 0x8e, 0x58, 0x80, 0x02, 0xfa, 0xff,
+ 0xff, 0xff, 0xff, 0x0f, 0x4a, 0x20, 0xa8, 0xba, 0x0b, 0x2b, 0x51, 0x01,
+ 0xfe, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x8a, 0x02, 0xe8, 0xaf, 0x84,
+ 0x90, 0x04, 0xfd, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x52, 0x21, 0x54, 0xbf,
+ 0x1f, 0x15, 0xa5, 0x02, 0xfe, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x08,
+ 0x01, 0xfa, 0xb6, 0xa4, 0x52, 0x40, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f,
+ 0x4a, 0xa2, 0x54, 0xef, 0x5f, 0x4b, 0xa4, 0x80, 0xff, 0xff, 0xff, 0xff,
+ 0xff, 0x0f, 0x80, 0x10, 0x82, 0xfe, 0xbf, 0x92, 0x52, 0x42, 0xff, 0xff,
+ 0xff, 0xff, 0xff, 0x0f, 0x12, 0x42, 0xa8, 0xbf, 0x1f, 0x24, 0x80, 0xa0,
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x84, 0x28, 0x8a, 0xf7, 0x37, 0x80,
+ 0x52, 0x80, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x10, 0x82, 0xe0, 0xff,
+ 0x1f, 0x00, 0x20, 0xe1, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x84, 0x28,
+ 0xca, 0xff, 0x1f, 0x00, 0x00, 0xc0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f,
+ 0x10, 0x42, 0xf0, 0xfd, 0x1b, 0x00, 0x50, 0xf0, 0xff, 0xff, 0xff, 0xff,
+ 0xff, 0x0f, 0xa4, 0x10, 0xc5, 0xff, 0x1f, 0x00, 0x00, 0xe0, 0xff, 0xff,
+ 0xff, 0xff, 0xff, 0x0f, 0x00, 0x22, 0xf8, 0xff, 0x0e, 0x00, 0x00, 0xf0,
+ 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0xaa, 0x88, 0xe2, 0xff, 0x0f, 0x10,
+ 0x00, 0xf0, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x25, 0xfa, 0xff,
+ 0x0f, 0x01, 0x11, 0xfd, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f, 0xff, 0xfb,
+ 0xfb, 0xff, 0x7f, 0x5d, 0xd5, 0xfa, 0xff, 0xff, 0xff, 0xff, 0xff, 0x0f};
diff --git a/tk/library/demos/images/flagdown.bmp b/tk/library/demos/images/flagdown.bmp
new file mode 100644
index 00000000000..55abc51825b
--- /dev/null
+++ b/tk/library/demos/images/flagdown.bmp
@@ -0,0 +1,27 @@
+#define flagdown_width 48
+#define flagdown_height 48
+static char flagdown_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x1e, 0x00, 0x00,
+ 0x00, 0x00, 0x80, 0x7f, 0x00, 0x00, 0x00, 0x00, 0xe0, 0xe1, 0x00, 0x00,
+ 0x00, 0x00, 0x70, 0x80, 0x01, 0x00, 0x00, 0x00, 0x18, 0x00, 0x03, 0x00,
+ 0x00, 0x00, 0x0c, 0x00, 0x03, 0x00, 0x00, 0x00, 0x06, 0x00, 0x06, 0x04,
+ 0x00, 0x00, 0x03, 0x00, 0x06, 0x06, 0x00, 0x80, 0x01, 0x00, 0x06, 0x07,
+ 0x00, 0xc0, 0x1f, 0x00, 0x87, 0x07, 0x00, 0xe0, 0x7f, 0x80, 0xc7, 0x07,
+ 0x00, 0x70, 0xe0, 0xc0, 0xe5, 0x07, 0x00, 0x38, 0x80, 0xe1, 0x74, 0x07,
+ 0x00, 0x18, 0x80, 0x71, 0x3c, 0x07, 0x00, 0x0c, 0x00, 0x3b, 0x1e, 0x03,
+ 0x00, 0x0c, 0x00, 0x1f, 0x0f, 0x00, 0x00, 0x86, 0x1f, 0x8e, 0x07, 0x00,
+ 0x00, 0x06, 0x06, 0xc6, 0x05, 0x00, 0x00, 0x06, 0x00, 0xc6, 0x05, 0x00,
+ 0x00, 0x06, 0x00, 0xc6, 0x04, 0x00, 0x00, 0x06, 0x00, 0x06, 0x04, 0x00,
+ 0x7f, 0x06, 0x00, 0x06, 0xe4, 0xff, 0x00, 0x06, 0x00, 0x06, 0x04, 0x00,
+ 0x00, 0x06, 0x00, 0x06, 0x04, 0x00, 0x00, 0x06, 0x00, 0x06, 0x06, 0x00,
+ 0x00, 0x06, 0x00, 0x06, 0x03, 0x00, 0x00, 0x06, 0x00, 0x86, 0x01, 0x00,
+ 0x00, 0x06, 0x00, 0xc6, 0x00, 0x00, 0x00, 0x06, 0x00, 0x66, 0x00, 0x00,
+ 0x00, 0x06, 0x00, 0x36, 0x00, 0x00, 0x00, 0x06, 0x00, 0x3e, 0x00, 0x00,
+ 0x00, 0xfe, 0xff, 0x2f, 0x00, 0x00, 0x00, 0xfc, 0xff, 0x27, 0x00, 0x00,
+ 0x00, 0x00, 0x88, 0x20, 0x00, 0x00, 0x00, 0x00, 0x88, 0x20, 0x00, 0x00,
+ 0x00, 0x00, 0x88, 0x20, 0x00, 0x00, 0x00, 0x00, 0x88, 0x20, 0x00, 0x00,
+ 0x00, 0x00, 0x88, 0x20, 0x00, 0x00, 0x00, 0x00, 0x88, 0x20, 0x00, 0x00,
+ 0x00, 0x00, 0x88, 0x20, 0x00, 0x00, 0x00, 0x00, 0x88, 0x20, 0x00, 0x00,
+ 0xf7, 0xbf, 0x8e, 0xfc, 0xdf, 0xf8, 0x9d, 0xeb, 0x9b, 0x76, 0xd2, 0x7a,
+ 0x46, 0x30, 0xe2, 0x0f, 0xe1, 0x47, 0x55, 0x84, 0x48, 0x11, 0x84, 0x19};
diff --git a/tk/library/demos/images/flagup.bmp b/tk/library/demos/images/flagup.bmp
new file mode 100644
index 00000000000..6eb0d846a32
--- /dev/null
+++ b/tk/library/demos/images/flagup.bmp
@@ -0,0 +1,27 @@
+#define flagup_width 48
+#define flagup_height 48
+static char flagup_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x7f, 0x00,
+ 0x00, 0x00, 0x00, 0xe0, 0x7f, 0x00, 0x00, 0x00, 0x00, 0xef, 0x6a, 0x00,
+ 0x00, 0x00, 0xc0, 0x7b, 0x75, 0x00, 0x00, 0x00, 0xe0, 0xe0, 0x6a, 0x00,
+ 0x00, 0x00, 0x30, 0x60, 0x75, 0x00, 0x00, 0x00, 0x18, 0xe0, 0x7f, 0x00,
+ 0x00, 0x00, 0x0c, 0xe0, 0x7f, 0x00, 0x00, 0x00, 0x06, 0xe0, 0x04, 0x00,
+ 0x00, 0x00, 0x03, 0xe0, 0x04, 0x00, 0x00, 0x80, 0x01, 0xe0, 0x06, 0x00,
+ 0x00, 0xc0, 0x1f, 0xe0, 0x07, 0x00, 0x00, 0xe0, 0x7f, 0xe0, 0x07, 0x00,
+ 0x00, 0x70, 0xe0, 0xe0, 0x05, 0x00, 0x00, 0x38, 0x80, 0xe1, 0x04, 0x00,
+ 0x00, 0x18, 0x80, 0xf1, 0x04, 0x00, 0x00, 0x0c, 0x00, 0xfb, 0x04, 0x00,
+ 0x00, 0x0c, 0x00, 0xff, 0x04, 0x00, 0x00, 0x86, 0x1f, 0xee, 0x04, 0x00,
+ 0x00, 0x06, 0x06, 0xe6, 0x04, 0x00, 0x00, 0x06, 0x00, 0xe6, 0x04, 0x00,
+ 0x00, 0x06, 0x00, 0xe6, 0x04, 0x00, 0x00, 0x06, 0x00, 0x66, 0x04, 0x00,
+ 0x7f, 0x56, 0x52, 0x06, 0xe4, 0xff, 0x00, 0x76, 0x55, 0x06, 0x04, 0x00,
+ 0x00, 0x56, 0x57, 0x06, 0x04, 0x00, 0x00, 0x56, 0x55, 0x06, 0x06, 0x00,
+ 0x00, 0x56, 0xd5, 0x06, 0x03, 0x00, 0x00, 0x06, 0x00, 0x86, 0x01, 0x00,
+ 0x54, 0x06, 0x00, 0xc6, 0x54, 0x55, 0xaa, 0x06, 0x00, 0x66, 0xaa, 0x2a,
+ 0x54, 0x06, 0x00, 0x36, 0x55, 0x55, 0xaa, 0x06, 0x00, 0xbe, 0xaa, 0x2a,
+ 0x54, 0xfe, 0xff, 0x6f, 0x55, 0x55, 0xaa, 0xfc, 0xff, 0xa7, 0xaa, 0x2a,
+ 0x54, 0x01, 0x88, 0x60, 0x55, 0x55, 0xaa, 0xaa, 0x8a, 0xa0, 0xaa, 0x2a,
+ 0x54, 0x55, 0x8d, 0x60, 0x55, 0x55, 0xaa, 0xaa, 0x8a, 0xa0, 0xaa, 0x2a,
+ 0x54, 0x55, 0x8d, 0x60, 0x55, 0x55, 0xaa, 0xaa, 0x8a, 0xa0, 0xaa, 0x2a,
+ 0x54, 0x55, 0x8d, 0x50, 0x55, 0x55, 0xaa, 0xaa, 0x8a, 0xa8, 0xaa, 0x2a,
+ 0x54, 0x55, 0x95, 0x54, 0x55, 0x55, 0xaa, 0xaa, 0xaa, 0xaa, 0xaa, 0x2a,
+ 0x54, 0x55, 0x55, 0x55, 0x55, 0x15, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/tk/library/demos/images/gray25.bmp b/tk/library/demos/images/gray25.bmp
new file mode 100644
index 00000000000..b234b3cb0be
--- /dev/null
+++ b/tk/library/demos/images/gray25.bmp
@@ -0,0 +1,6 @@
+#define grey_width 16
+#define grey_height 16
+static char grey_bits[] = {
+ 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44,
+ 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44,
+ 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44};
diff --git a/tk/library/demos/images/letters.bmp b/tk/library/demos/images/letters.bmp
new file mode 100644
index 00000000000..0f12568d1a0
--- /dev/null
+++ b/tk/library/demos/images/letters.bmp
@@ -0,0 +1,27 @@
+#define letters_width 48
+#define letters_height 48
+static char letters_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0xfe, 0xff, 0xff, 0xff, 0x3f, 0x00, 0x02, 0x00, 0x00, 0x00, 0x20,
+ 0x00, 0xfa, 0x00, 0x00, 0x00, 0x2e, 0x00, 0x02, 0x00, 0x00, 0x00, 0x2a,
+ 0x00, 0x3a, 0x00, 0x00, 0x00, 0x2a, 0x00, 0x02, 0x00, 0x00, 0x00, 0x2e,
+ 0xe0, 0xff, 0xff, 0xff, 0xff, 0x21, 0x20, 0x00, 0x00, 0x00, 0x00, 0x21,
+ 0xa0, 0x03, 0x00, 0x00, 0x70, 0x21, 0x20, 0x00, 0x00, 0x00, 0x50, 0x21,
+ 0xa0, 0x1f, 0x00, 0x00, 0x50, 0x21, 0x20, 0x00, 0x00, 0x00, 0x70, 0x21,
+ 0xfe, 0xff, 0xff, 0xff, 0x0f, 0x21, 0x02, 0x00, 0x00, 0x00, 0x08, 0x21,
+ 0xfa, 0x01, 0x00, 0x80, 0x0b, 0x21, 0x02, 0x00, 0x00, 0x80, 0x0a, 0x21,
+ 0xba, 0x01, 0x00, 0x80, 0x0a, 0x21, 0x02, 0x00, 0x00, 0x80, 0x0b, 0x21,
+ 0x3a, 0x00, 0x00, 0x00, 0x08, 0x21, 0x02, 0x00, 0x00, 0x00, 0x08, 0x21,
+ 0x02, 0xc0, 0xfb, 0x03, 0x08, 0x21, 0x02, 0x00, 0x00, 0x00, 0x08, 0x3f,
+ 0x02, 0xc0, 0xbd, 0x0f, 0x08, 0x01, 0x02, 0x00, 0x00, 0x00, 0x08, 0x01,
+ 0x02, 0xc0, 0x7f, 0x7b, 0x08, 0x01, 0x02, 0x00, 0x00, 0x00, 0x08, 0x01,
+ 0x02, 0x00, 0x00, 0x00, 0xf8, 0x01, 0x02, 0x00, 0x00, 0x00, 0x08, 0x00,
+ 0x02, 0x00, 0x00, 0x00, 0x08, 0x00, 0x02, 0x00, 0x00, 0x00, 0x08, 0x00,
+ 0x02, 0x00, 0x00, 0x00, 0x08, 0x00, 0x02, 0x00, 0x00, 0x00, 0x08, 0x00,
+ 0xfe, 0xff, 0xff, 0xff, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
diff --git a/tk/library/demos/images/noletter.bmp b/tk/library/demos/images/noletter.bmp
new file mode 100644
index 00000000000..5774124efe9
--- /dev/null
+++ b/tk/library/demos/images/noletter.bmp
@@ -0,0 +1,27 @@
+#define noletters_width 48
+#define noletters_height 48
+static char noletters_bits[] = {
+ 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x1f, 0x00, 0x00,
+ 0x00, 0x00, 0xff, 0xff, 0x01, 0x00, 0x00, 0xc0, 0xff, 0xff, 0x07, 0x00,
+ 0x00, 0xf0, 0x0f, 0xe0, 0x1f, 0x00, 0x00, 0xfc, 0x01, 0x00, 0x7f, 0x00,
+ 0x00, 0x3e, 0x00, 0x00, 0xf8, 0x00, 0x00, 0x1f, 0x00, 0x00, 0xf0, 0x01,
+ 0x80, 0x07, 0x00, 0x00, 0xc0, 0x03, 0xc0, 0x03, 0x00, 0x00, 0xe0, 0x07,
+ 0xe0, 0x01, 0x00, 0x00, 0xf0, 0x0f, 0xe0, 0x00, 0x00, 0x00, 0x78, 0x0e,
+ 0xf0, 0x00, 0x00, 0x00, 0x3c, 0x1e, 0x70, 0x00, 0x00, 0x00, 0x1e, 0x1c,
+ 0x38, 0x00, 0x00, 0x00, 0x0f, 0x38, 0x38, 0x00, 0x00, 0x80, 0x07, 0x38,
+ 0x3c, 0xfc, 0xff, 0xff, 0x7f, 0x78, 0x1c, 0x04, 0x00, 0xe0, 0x41, 0x70,
+ 0x1c, 0x04, 0x00, 0xf0, 0x40, 0x70, 0x1c, 0x74, 0x00, 0x78, 0x4e, 0x70,
+ 0x0e, 0x04, 0x00, 0x3c, 0x4a, 0xe0, 0x0e, 0x74, 0x03, 0x1e, 0x4a, 0xe0,
+ 0x0e, 0x04, 0x00, 0x0f, 0x4e, 0xe0, 0x0e, 0x04, 0x80, 0x07, 0x40, 0xe0,
+ 0x0e, 0x04, 0xf8, 0x0f, 0x40, 0xe0, 0x0e, 0x04, 0xe0, 0x01, 0x40, 0xe0,
+ 0x0e, 0x04, 0xf8, 0x00, 0x40, 0xe0, 0x0e, 0x04, 0x78, 0x00, 0x40, 0xe0,
+ 0x0e, 0x04, 0xfc, 0xf3, 0x40, 0xe0, 0x1c, 0x04, 0x1e, 0x00, 0x40, 0x70,
+ 0x1c, 0x04, 0x0f, 0x00, 0x40, 0x70, 0x1c, 0x84, 0x07, 0x00, 0x40, 0x70,
+ 0x3c, 0xfc, 0xff, 0xff, 0x7f, 0x78, 0x38, 0xe0, 0x01, 0x00, 0x00, 0x38,
+ 0x38, 0xf0, 0x00, 0x00, 0x00, 0x38, 0x70, 0x78, 0x00, 0x00, 0x00, 0x1c,
+ 0xf0, 0x3c, 0x00, 0x00, 0x00, 0x1e, 0xe0, 0x1e, 0x00, 0x00, 0x00, 0x0e,
+ 0xe0, 0x0f, 0x00, 0x00, 0x00, 0x0f, 0xc0, 0x07, 0x00, 0x00, 0x80, 0x07,
+ 0x80, 0x07, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x1f, 0x00, 0x00, 0xf0, 0x01,
+ 0x00, 0x3e, 0x00, 0x00, 0xf8, 0x00, 0x00, 0xfc, 0x01, 0x00, 0x7f, 0x00,
+ 0x00, 0xf0, 0x0f, 0xe0, 0x1f, 0x00, 0x00, 0xc0, 0xff, 0xff, 0x07, 0x00,
+ 0x00, 0x00, 0xff, 0xff, 0x01, 0x00, 0x00, 0x00, 0xf0, 0x1f, 0x00, 0x00};
diff --git a/tk/library/demos/images/pattern.bmp b/tk/library/demos/images/pattern.bmp
new file mode 100644
index 00000000000..df31baf7895
--- /dev/null
+++ b/tk/library/demos/images/pattern.bmp
@@ -0,0 +1,6 @@
+#define foo_width 16
+#define foo_height 16
+static char foo_bits[] = {
+ 0x60, 0x06, 0x90, 0x09, 0x90, 0x09, 0xb0, 0x0d, 0x4e, 0x72, 0x49, 0x92,
+ 0x71, 0x8e, 0x8e, 0x71, 0x8e, 0x71, 0x71, 0x8e, 0x49, 0x92, 0x4e, 0x72,
+ 0xb0, 0x0d, 0x90, 0x09, 0x90, 0x09, 0x60, 0x06};
diff --git a/tk/library/demos/images/tcllogo.gif b/tk/library/demos/images/tcllogo.gif
new file mode 100644
index 00000000000..4603d4ff417
--- /dev/null
+++ b/tk/library/demos/images/tcllogo.gif
Binary files differ
diff --git a/tk/library/demos/images/teapot.ppm b/tk/library/demos/images/teapot.ppm
new file mode 100644
index 00000000000..b8ab85f3a5d
--- /dev/null
+++ b/tk/library/demos/images/teapot.ppm
@@ -0,0 +1,31 @@
+P6
+256 256
+255
+\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À[7 eOLjQLmSMoTMnSMlRMhPL_9 \À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀnSMtVMzYN~[N~[N\N\O€\O€]O€]O€]O€]O€\O€\O}[NyYNtVM\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀG-wXN}[N€]O„^O†_O†`O‡`Oˆ`Oˆ`OˆaO‰aO‰aO‰aO‰aO‰aO‰aOˆaOˆ`O†_Oƒ^O\N \À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀaMLyYN…_O‰aP‹bPcPŽcPŽdPŽdPdPdPdPdPdPdPdPeP‘eP’eP’eP‘ePdPcP…_OpUM\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀwXN…_OdP“fP•gQ–hQ˜hQ˜iQ™iQ™iQšiQšiQšjQ›jQ›jQœjQœjQœjQœjQœjQ›jQœjQ™iQ“fP‡`O\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀNCJiQL‹bP—hQkQ¡mR¤nR¥oR¥oR¥oR¥oR¥oR¥oR¦oR¦oR¦pR¨pS©qSªqS«rS¬rS«rS©qS¤oRœjQ€]O\KK\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀfOLrUMcPŸlR©qS¯tS²uTµwT·xT¸xT¹yTºyT»zT»zU¼zU¼zU¼zU»zUºyT¸xT¶wT¯tS¡mR‰aOhPL\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\Àa0 cNLqUM€\O”fQ¦pS²wVºzV¿|VÂ}VÄVÆVÇ€VÉ‚WÌ…[Õeæ w÷³‹êª…Ĉg§qT“fQ{ZNYIK9\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀO1{G#‘JkRMqUMtVN–iS¨v\·€d¹bµzZ±vU°uT®sSªqS¤nRœjQ’eP„^OrUMHh>!T4\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀG-V5wE"~I#†M%U+¥e7²l:°g2®b*­a(­`(©^(¥])¡^-›]1ŠS,qC$`9 R3G-\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À@)J/i>!pA"tD"wF$yH&xH&tE$wE#yG%}M+ƒT4S5mE*Z7!K/B*;'\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À‰aO¦oR½{UÇ€VÏ…X<(F-a: e<!h>!j@#k@$h>"d<!c=$hD-fF2[<)K0@);'5$Ë‚VÇ€V¿|U_LKYIK\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À…_O·xTÉ‚Wó«€ûµ‹Ö’k¼|X×>µf-¨^(¡Z'šW&–T&œN>)F-J/b; g>#nD(jB&c<!b=%jH2_A/I0!<(8&5$”J¥Y’S%8&;'?)E,<:HA=HE?IJAISFJYIKXIK\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À£nRÁ}UܘqÊŠe±vU²e,™V&¥V†C €@ |> y< u: r9 o7 l6
+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: p8 k5
+f3
+a0 _/ ]. [- I¡\*ª_(‘LkRMmSMmSMnSMnSMD,R3W5mA"|O0|P1j?"c<!a=%Y7"N1F,;'NCJNCJNDJODJODJODJh>!a: X/K%
+g3
+a0 Z- \/ T*Q(ŠHµm8kRMmSMnTMoTMpTMpUM15G15G05G04G04GpUMpTM5^9 d<!yF#O+€N,rC#qB"pB#k?"a: Z7 6ODJPDJPEJQEJQEJREJREJREJRFJSFJSFJSFJSFJe<!X/
+^/ V+Q(L&I$r9  TlRMnSM46G47G47G46G46G46G46G46G36G36G25G25G15G04G/4F.3F
+
+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$
+›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•gQePcPŠaPˆaO‡`O‡`O†_O†_O…_O…_O…_O…_O…_O…_O…_O„_O„^O„^Oƒ^Oƒ^O‚]O]O€\O~[N{ZN•T%
+
+ 
+@%<-$G?@…pfdNLuWM\NdNL\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀTFJvWN‰aP./01„E}[N]O…_Oˆ`O‰aP‹bPŒbPcPcPŽcPdPdPdPeP‘eP’eP’eP“fP“fQ”fQ•gQ•gQ–gQ–hQ—hQ˜hQ™iQšiQ›jQœjQkQkRžlRŸlRžY&¤\'¨^'µ^½bÀcÃeÇi ÄgÀc½b¼a¹`µ^´]¯X¢[' Z'žY&¢mR¡mR¡mR lRŸlRŸlRžkRkQœkQœjQ›jQšjQšiQ™iQ™iQ˜iQ˜hQ—hQ—hQ—hQ–gQ–gQ•gQ•gQ•gQ”fQ”fQ“fQ“fP’eP‘ePdPcP‰aP—O
+ B\À\À\À\À\À\À\À\À\À\À%7!!C*F#P) {dYœze»p€\OgPL\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀSFJ`LKvWNŠaPm6
+ 
+$5 ¬`(¶e)£nRœjQƒ^OJAI\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀXIK^KKdNLhPLuWM‚]OŒbP”fQeP m6
+†`OŽcP“fQ—hQ˜hQ™iQšiQšjQ›jQ›jQ›jQœjQœjQœjQœkQkQkQkRž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 mRkR—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œjQkQkQkRž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•gQ
+!C+E'0F.4F7%8%U/lG.SFJZIK]KKZIKB=H\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀREJZJK`LKdNLgPLjQLlRMnSMpTMqUMtWMxXN{ZN~[N]O„^O†`O‰aO‹bPdP•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‘ePdPŒ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ŽcPeP“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‘ePdPcPŠaP‡`O„^O]O}[NyYNuWMpTMoTMmSMkRLgPL&D#.E,3F46G;'<(D"iB(VGJ]KK`LK[JKB>H\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀNCJYIK^LKcNLfOLiQLkRMmSMoTMqUMsVMvXNzYN}[N€\O‚^O…_Oˆ`OŠaPŒcPdP‘eP“fQ•gQ—hQ™iQkR 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’ePdPcP‹bPˆ`O…_O‚]O~[NzYNvWNpTMoTMnSMkRMhQLo7 ,2F36G99HC+@ ]8 nA"\JK`ML_LKSFJ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀSFJ[JK`LKdNLgPLjQLlRMnSMpTMqUMtVMwXNzZN}[N€]Oƒ^O†_OˆaO‹bPcPdP‘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Ó•rÌmƉh¿„c¸~^²yZ®vX¬tWªsV¨qU¦pT¤oS¢nS mRžlRœkR›jQ™iQ—hQ•gQ“fPePŽcP‹bPˆaO…_O‚^O\N{ZNwXNsVMoTMnSMlRMiQL~I#26G99G?<HA*E$ i@$ZIKaMLbML[JK;:H\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀWHJ]KKbMLeOLhPLjRLlSMnTMpTMrUMuWMxXN{ZN~\N]O„^O†`O‰aO‹bPŽcPdP’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ƃ\Ç…^Ɇ`ˈbÌŠdÍ‹fÎgÎŽiÎŽjÎŽjÍŽjËŒiljgÆd¿ƒaº^¸}]¶|\´{[²yZ°xY®vX¬tWªsV¨qU¦pT¤oS¢nS mRžlRkR›jQ™iQ—hQ•gQ“fP‘ePŽdPŒbP‰aO†_Oƒ^O€\O|ZNxXNtVMpTMnSMmSMjQLgPL99G?<HG-E&b;!YIK`MLdOM`LKNCJ\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀŸlRºyTÄ~UÊ‚XʃYÄXº{W­tUšW'¢[(—hQ lRcP€\OhQL\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\ÀNCJYIK^LKcNLfOLiQLkRLmSMoTMqUMrVMvWNyYN|ZN\N‚]O„_O‡`O‰aPŒbPŽcPdP’fP”gQ–hQ˜iQšjRœkRžlS¡nT¤pU§sW«vZ°z]µb»„gŠlÉ‘sИyØžÞ¤…ã©Šè­ì±ï³‘ﳑ뭊穅⣀ݞzؘtÒ“nÎiɉdÆ…`Â]Á€[¿~Y¾}X½|W½|V¼{V¼{V¼{V¼{V¼{V¼|W¼|W½}X½}Y½~Z½~Z¼~Z»}[º}[º}[º~\º~\º~]º~]¹~]¸~]·}]¶|\´z[²yZ°wY®vX¬tWªsV¨rU¦pT¤oS¢nS mRŸlRkR›jQšiQ˜hQ–gQ“fQ‘ePdPŒcPŠaP‡`O„^O]O}[NyYNuWNpTMnTMmSMkRLhPL|H$D>IQ2P+XHK_LLfQOcNLXIK\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À©qSºyTÃ~VΈ`遲ޜv¾€]ªqS–LŽG|> g3
+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ŸlRkRœjQšiQ˜hQ–gQ”fQ’ePdPcPŠbP‡`O…_O‚]O~[NzZNvWNrUMoTMmSMlRMiQLeOLJAIJ(h>!]KKfQOgQN_LKD>I\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À\À™iQ°tS¸yT¼{UÂYÎŒeï­ˆô´Õ—u¶|\ Z'™LˆD |>
+
+ &3#.$-% .% .& /&!,#,#@70A71XNHXNHWNHWNHZRLYQLYQLXQLWQLWPLUOLSNLQMKOLJMJJ0//.-.,,-&(+"(!'
+ %' %$#" ! !$ 
diff --git a/tk/library/demos/items.tcl b/tk/library/demos/items.tcl
new file mode 100644
index 00000000000..83e603375db
--- /dev/null
+++ b/tk/library/demos/items.tcl
@@ -0,0 +1,285 @@
+# 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}
+toplevel $w
+wm title $w "Canvas Item Demonstration"
+wm iconname $w "Items"
+positionWindow $w
+set c $w.frame.c
+
+label $w.msg -font $font -wraplength 5i -justify left -text "This window contains a canvas widget with examples of the various kinds of items supported by canvases. The following operations are supported:\n Button-1 drag:\tmoves item under pointer.\n Button-2 drag:\trepositions view.\n Button-3 drag:\tstrokes out area.\n Ctrl+f:\t\tprints items under area."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.frame
+pack $w.frame -side top -fill both -expand yes
+
+canvas $c -scrollregion {0c 0c 30c 24c} -width 15c -height 10c \
+ -relief sunken -borderwidth 2 \
+ -xscrollcommand "$w.frame.hscroll set" \
+ -yscrollcommand "$w.frame.vscroll set"
+scrollbar $w.frame.vscroll -command "$c yview"
+scrollbar $w.frame.hscroll -orient horiz -command "$c xview"
+
+grid $c -in $w.frame \
+ -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
+grid $w.frame.vscroll \
+ -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
+grid $w.frame.hscroll \
+ -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
+grid rowconfig $w.frame 0 -weight 1 -minsize 0
+grid columnconfig $w.frame 0 -weight 1 -minsize 0
+
+# Display a 3x3 rectangular grid.
+
+$c create rect 0c 0c 30c 24c -width 2
+$c create line 0c 8c 30c 8c -width 2
+$c create line 0c 16c 30c 16c -width 2
+$c create line 10c 0c 10c 24c -width 2
+$c create line 20c 0c 20c 24c -width 2
+
+set font1 {Helvetica 12}
+set font2 {Helvetica 24 bold}
+if {[winfo depth $c] > 1} {
+ set blue DeepSkyBlue3
+ set red red
+ set bisque bisque3
+ set green SeaGreen3
+} else {
+ set blue black
+ set red black
+ set bisque black
+ set green black
+}
+
+# Set up demos within each of the areas of the grid.
+
+$c create text 5c .2c -text Lines -anchor n
+$c create line 1c 1c 3c 1c 1c 4c 3c 4c -width 2m -fill $blue \
+ -cap butt -join miter -tags item
+$c create line 4.67c 1c 4.67c 4c -arrow last -tags item
+$c create line 6.33c 1c 6.33c 4c -arrow both -tags item
+$c create line 5c 6c 9c 6c 9c 1c 8c 1c 8c 4.8c 8.8c 4.8c 8.8c 1.2c \
+ 8.2c 1.2c 8.2c 4.6c 8.6c 4.6c 8.6c 1.4c 8.4c 1.4c 8.4c 4.4c \
+ -width 3 -fill $red -tags item
+$c create line 1c 5c 7c 5c 7c 7c 9c 7c -width .5c \
+ -stipple @[file join $tk_library demos images gray25.bmp] \
+ -arrow both -arrowshape {15 15 7} -tags item
+$c create line 1c 7c 1.75c 5.8c 2.5c 7c 3.25c 5.8c 4c 7c -width .5c \
+ -cap round -join round -tags item
+
+$c create text 15c .2c -text "Curves (smoothed lines)" -anchor n
+$c create line 11c 4c 11.5c 1c 13.5c 1c 14c 4c -smooth on \
+ -fill $blue -tags item
+$c create line 15.5c 1c 19.5c 1.5c 15.5c 4.5c 19.5c 4c -smooth on \
+ -arrow both -width 3 -tags item
+$c create line 12c 6c 13.5c 4.5c 16.5c 7.5c 18c 6c \
+ 16.5c 4.5c 13.5c 7.5c 12c 6c -smooth on -width 3m -cap round \
+ -stipple @[file join $tk_library demos images gray25.bmp] \
+ -fill $red -tags item
+
+$c create text 25c .2c -text Polygons -anchor n
+$c create polygon 21c 1.0c 22.5c 1.75c 24c 1.0c 23.25c 2.5c \
+ 24c 4.0c 22.5c 3.25c 21c 4.0c 21.75c 2.5c -fill $green \
+ -outline black -width 4 -tags item
+$c create polygon 25c 4c 25c 4c 25c 1c 26c 1c 27c 4c 28c 1c \
+ 29c 1c 29c 4c 29c 4c -fill $red -smooth on -tags item
+$c create polygon 22c 4.5c 25c 4.5c 25c 6.75c 28c 6.75c \
+ 28c 5.25c 24c 5.25c 24c 6.0c 26c 6c 26c 7.5c 22c 7.5c \
+ -stipple @[file join $tk_library demos images gray25.bmp] \
+ -outline black -tags item
+
+$c create text 5c 8.2c -text Rectangles -anchor n
+$c create rectangle 1c 9.5c 4c 12.5c -outline $red -width 3m -tags item
+$c create rectangle 0.5c 13.5c 4.5c 15.5c -fill $green -tags item
+$c create rectangle 6c 10c 9c 15c -outline {} \
+ -stipple @[file join $tk_library demos images gray25.bmp] \
+ -fill $blue -tags item
+
+$c create text 15c 8.2c -text Ovals -anchor n
+$c create oval 11c 9.5c 14c 12.5c -outline $red -width 3m -tags item
+$c create oval 10.5c 13.5c 14.5c 15.5c -fill $green -tags item
+$c create oval 16c 10c 19c 15c -outline {} \
+ -stipple @[file join $tk_library demos images gray25.bmp] \
+ -fill $blue -tags item
+
+$c create text 25c 8.2c -text Text -anchor n
+$c create rectangle 22.4c 8.9c 22.6c 9.1c
+$c create text 22.5c 9c -anchor n -font $font1 -width 4c \
+ -text "A short string of text, word-wrapped, justified left, and anchored north (at the top). The rectangles show the anchor points for each piece of text." -tags item
+$c create rectangle 25.4c 10.9c 25.6c 11.1c
+$c create text 25.5c 11c -anchor w -font $font1 -fill $blue \
+ -text "Several lines,\n each centered\nindividually,\nand all anchored\nat the left edge." \
+ -justify center -tags item
+$c create rectangle 24.9c 13.9c 25.1c 14.1c
+$c create text 25c 14c -font $font2 -anchor c -fill $red -stipple gray50 \
+ -text "Stippled characters" -tags item
+
+$c create text 5c 16.2c -text Arcs -anchor n
+$c create arc 0.5c 17c 7c 20c -fill $green -outline black \
+ -start 45 -extent 270 -style pieslice -tags item
+$c create arc 6.5c 17c 9.5c 20c -width 4m -style arc \
+ -outline $blue -start -135 -extent 270 -tags item \
+ -outlinestipple @[file join $tk_library demos images gray25.bmp]
+$c create arc 0.5c 20c 9.5c 24c -width 4m -style pieslice \
+ -fill {} -outline $red -start 225 -extent -90 -tags item
+$c create arc 5.5c 20.5c 9.5c 23.5c -width 4m -style chord \
+ -fill $blue -outline {} -start 45 -extent 270 -tags item
+
+$c create text 15c 16.2c -text Bitmaps -anchor n
+$c create bitmap 13c 20c -tags item \
+ -bitmap @[file join $tk_library demos images face.bmp]
+$c create bitmap 17c 18.5c -tags item \
+ -bitmap @[file join $tk_library demos images noletter.bmp]
+$c create bitmap 17c 21.5c -tags item \
+ -bitmap @[file join $tk_library demos images letters.bmp]
+
+$c create text 25c 16.2c -text Windows -anchor n
+button $c.button -text "Press Me" -command "butPress $c $red"
+$c create window 21c 18c -window $c.button -anchor nw -tags item
+entry $c.entry -width 20 -relief sunken
+$c.entry insert end "Edit this text"
+$c create window 21c 21c -window $c.entry -anchor nw -tags item
+scale $c.scale -from 0 -to 100 -length 6c -sliderlength .4c \
+ -width .5c -tickinterval 0
+$c create window 28.5c 17.5c -window $c.scale -anchor n -tags item
+$c create text 21c 17.9c -text Button: -anchor sw
+$c create text 21c 20.9c -text Entry: -anchor sw
+$c create text 28.5c 17.4c -text Scale: -anchor s
+
+# Set up event bindings for canvas:
+
+$c bind item <Any-Enter> "itemEnter $c"
+$c bind item <Any-Leave> "itemLeave $c"
+bind $c <2> "$c scan mark %x %y"
+bind $c <B2-Motion> "$c scan dragto %x %y"
+bind $c <3> "itemMark $c %x %y"
+bind $c <B3-Motion> "itemStroke $c %x %y"
+bind $c <Control-f> "itemsUnderArea $c"
+bind $c <1> "itemStartDrag $c %x %y"
+bind $c <B1-Motion> "itemDrag $c %x %y"
+
+# Utility procedures for highlighting the item under the pointer:
+
+proc itemEnter {c} {
+ global restoreCmd
+
+ if {[winfo depth $c] == 1} {
+ set restoreCmd {}
+ return
+ }
+ set type [$c type current]
+ if {$type == "window"} {
+ set restoreCmd {}
+ return
+ }
+ if {$type == "bitmap"} {
+ set bg [lindex [$c itemconf current -background] 4]
+ set restoreCmd [list $c itemconfig current -background $bg]
+ $c itemconfig current -background SteelBlue2
+ return
+ }
+ set fill [lindex [$c itemconfig current -fill] 4]
+ if {(($type == "rectangle") || ($type == "oval") || ($type == "arc"))
+ && ($fill == "")} {
+ set outline [lindex [$c itemconfig current -outline] 4]
+ set restoreCmd "$c itemconfig current -outline $outline"
+ $c itemconfig current -outline SteelBlue2
+ } else {
+ set restoreCmd "$c itemconfig current -fill $fill"
+ $c itemconfig current -fill SteelBlue2
+ }
+}
+
+proc itemLeave {c} {
+ global restoreCmd
+
+ eval $restoreCmd
+}
+
+# Utility procedures for stroking out a rectangle and printing what's
+# underneath the rectangle's area.
+
+proc itemMark {c x y} {
+ global areaX1 areaY1
+ set areaX1 [$c canvasx $x]
+ set areaY1 [$c canvasy $y]
+ $c delete area
+}
+
+proc itemStroke {c x y} {
+ global areaX1 areaY1 areaX2 areaY2
+ set x [$c canvasx $x]
+ set y [$c canvasy $y]
+ if {($areaX1 != $x) && ($areaY1 != $y)} {
+ $c delete area
+ $c addtag area withtag [$c create rect $areaX1 $areaY1 $x $y \
+ -outline black]
+ set areaX2 $x
+ set areaY2 $y
+ }
+}
+
+proc itemsUnderArea {c} {
+ global areaX1 areaY1 areaX2 areaY2
+ set area [$c find withtag area]
+ set items ""
+ foreach i [$c find enclosed $areaX1 $areaY1 $areaX2 $areaY2] {
+ if {[lsearch [$c gettags $i] item] != -1} {
+ lappend items $i
+ }
+ }
+ puts stdout "Items enclosed by area: $items"
+ set items ""
+ foreach i [$c find overlapping $areaX1 $areaY1 $areaX2 $areaY2] {
+ if {[lsearch [$c gettags $i] item] != -1} {
+ lappend items $i
+ }
+ }
+ puts stdout "Items overlapping area: $items"
+}
+
+set areaX1 0
+set areaY1 0
+set areaX2 0
+set areaY2 0
+
+# Utility procedures to support dragging of items.
+
+proc itemStartDrag {c x y} {
+ global lastX lastY
+ set lastX [$c canvasx $x]
+ set lastY [$c canvasy $y]
+}
+
+proc itemDrag {c x y} {
+ global lastX lastY
+ set x [$c canvasx $x]
+ set y [$c canvasy $y]
+ $c move current [expr $x-$lastX] [expr $y-$lastY]
+ set lastX $x
+ set lastY $y
+}
+
+# Procedure that's invoked when the button embedded in the canvas
+# is invoked.
+
+proc butPress {w color} {
+ set i [$w create text 25c 18.1c -text "Ouch!!" -fill $color -anchor n]
+ after 500 "$w delete $i"
+}
diff --git a/tk/library/demos/ixset b/tk/library/demos/ixset
new file mode 100755
index 00000000000..dcde75dbb1d
--- /dev/null
+++ b/tk/library/demos/ixset
@@ -0,0 +1,312 @@
+#!/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 : pda@masi.ibp.fr, jt@ratp.fr : design
+# 92/08/01 : pda@masi.ibp.fr : cleaning
+#
+# SCCS: @(#) ixset 1.7 96/02/16 10:49:19
+
+#
+# Button actions
+#
+
+proc quit {} {
+ destroy .
+}
+
+proc ok {} {
+ writesettings
+ quit
+}
+
+proc cancel {} {
+ readsettings
+ dispsettings
+}
+
+# apply is just "writesettings"
+
+
+#
+# Read current settings
+#
+
+proc readsettings {} {
+ global kbdrep ; set kbdrep "on"
+ global kbdcli ; set kbdcli 0
+ global bellvol ; set bellvol 100
+ global bellpit ; set bellpit 440
+ global belldur ; set belldur 100
+ global mouseacc ; set mouseacc "3/1"
+ global mousethr ; set mousethr 4
+ global screenbla ; set screenbla "blank"
+ global screentim ; set screentim 600
+ global screencyc ; set screencyc 600
+
+ set xfd [open "|xset q" r]
+ while {[gets $xfd line] > -1} {
+ set kw [lindex $line 0]
+
+ case $kw in {
+ {auto}
+ {
+ set rpt [lindex $line 1]
+ if {[expr "{$rpt} == {repeat:}"]} then {
+ set kbdrep [lindex $line 2]
+ set kbdcli [lindex $line 6]
+ }
+ }
+ {bell}
+ {
+ set bellvol [lindex $line 2]
+ set bellpit [lindex $line 5]
+ set belldur [lindex $line 8]
+ }
+ {acceleration:}
+ {
+ set mouseacc [lindex $line 1]
+ set mousethr [lindex $line 3]
+ }
+ {prefer}
+ {
+ set bla [lindex $line 2]
+ set screenbla [expr "{$bla} == {yes} ? {blank} : {noblank}"]
+ }
+ {timeout:}
+ {
+ set screentim [lindex $line 1]
+ set screencyc [lindex $line 3]
+ }
+ }
+ }
+ close $xfd
+
+ # puts stdout [format "Key REPEAT = %s\n" $kbdrep]
+ # puts stdout [format "Key CLICK = %s\n" $kbdcli]
+ # puts stdout [format "Bell VOLUME = %s\n" $bellvol]
+ # puts stdout [format "Bell PITCH = %s\n" $bellpit]
+ # puts stdout [format "Bell DURATION = %s\n" $belldur]
+ # puts stdout [format "Mouse ACCELERATION = %s\n" $mouseacc]
+ # puts stdout [format "Mouse THRESHOLD = %s\n" $mousethr]
+ # puts stdout [format "Screen BLANCK = %s\n" $screenbla]
+ # puts stdout [format "Screen TIMEOUT = %s\n" $screentim]
+ # puts stdout [format "Screen CYCLE = %s\n" $screencyc]
+}
+
+
+#
+# Write settings into the X server
+#
+
+proc writesettings {} {
+ global kbdrep kbdcli bellvol bellpit belldur
+ global mouseacc mousethr screenbla screentim screencyc
+
+ set bellvol [.bell.vol get]
+ set bellpit [.bell.val.pit.entry get]
+ set belldur [.bell.val.dur.entry get]
+
+ if {[expr "{$kbdrep} == {on}"]} then {
+ set kbdcli [.kbd.val.cli get]
+ } else {
+ set kbdcli "off"
+ }
+
+ set mouseacc [.mouse.hor.acc.entry get]
+ set mousethr [.mouse.hor.thr.entry get]
+
+ set screentim [.screen.val.le.tim.entry get]
+ set screencyc [.screen.val.le.cyc.entry get]
+
+ exec xset \
+ b $bellvol $bellpit $belldur \
+ c $kbdcli \
+ r $kbdrep \
+ m $mouseacc $mousethr \
+ s $screentim $screencyc \
+ s $screenbla
+}
+
+
+#
+# Sends all settings to the window
+#
+
+proc dispsettings {} {
+ global kbdrep kbdcli bellvol bellpit belldur
+ global mouseacc mousethr screenbla screentim screencyc
+
+ .bell.vol set $bellvol
+ .bell.val.pit.entry delete 0 end
+ .bell.val.pit.entry insert 0 $bellpit
+ .bell.val.dur.entry delete 0 end
+ .bell.val.dur.entry insert 0 $belldur
+
+ .kbd.val.onoff [expr "{$kbdrep} == {on} ? {select} : {deselect}"]
+ .kbd.val.cli set $kbdcli
+
+ .mouse.hor.acc.entry delete 0 end
+ .mouse.hor.acc.entry insert 0 $mouseacc
+ .mouse.hor.thr.entry delete 0 end
+ .mouse.hor.thr.entry insert 0 $mousethr
+
+ .screen.val.rb.blank [expr "{$screenbla}=={blank} ? {select} : {deselect}"]
+ .screen.val.rb.pat [expr "{$screenbla}!={blank} ? {select} : {deselect}"]
+ .screen.val.le.tim.entry delete 0 end
+ .screen.val.le.tim.entry insert 0 $screentim
+ .screen.val.le.cyc.entry delete 0 end
+ .screen.val.le.cyc.entry insert 0 $screencyc
+}
+
+
+#
+# Create all windows, and pack them
+#
+
+proc labelentry {path text length} {
+ frame $path
+ label $path.label -text $text
+ entry $path.entry -width $length -relief sunken
+ pack $path.label -side left -expand y
+ pack $path.entry -side right -expand y
+}
+
+proc createwindows {} {
+ #
+ # Buttons
+ #
+
+ frame .buttons
+ button .buttons.ok -command "ok" -text "Ok"
+ button .buttons.apply -command "writesettings" -text "Apply"
+ button .buttons.cancel -command "cancel" -text "Cancel"
+ button .buttons.quit -command "quit" -text "Quit"
+
+ pack .buttons.ok .buttons.apply .buttons.cancel .buttons.quit \
+ -side left -expand yes -pady 5
+
+ #
+ # Bell settings
+ #
+
+ frame .bell -relief raised -borderwidth 2
+ label .bell.label -text "Bell Settings"
+ scale .bell.vol \
+ -from 0 -to 100 -length 200 -tickinterval 20 \
+ -label "Volume (%)" -orient horizontal
+
+ frame .bell.val
+ labelentry .bell.val.pit "Pitch (Hz)" 6
+ labelentry .bell.val.dur "Duration (ms)" 6
+ pack .bell.val.pit -side left -padx 5
+ pack .bell.val.dur -side right -padx 5
+ pack .bell.label .bell.vol .bell.val -side top -expand yes
+
+ #
+ # Keyboard settings
+ #
+
+ frame .kbd -relief raised -borderwidth 2
+
+ label .kbd.label -text "Keyboard Repeat Settings"
+
+ frame .kbd.val
+ checkbutton .kbd.val.onoff \
+ -text "On" \
+ -onvalue "on" -offvalue "off" -variable kbdrep \
+ -relief flat
+ scale .kbd.val.cli \
+ -from 0 -to 100 -length 200 -tickinterval 20 \
+ -label "Click Volume (%)" -orient horizontal
+ pack .kbd.val.onoff -side left -expand yes -fill both
+ pack .kbd.val.cli -side left -expand yes
+
+ pack .kbd.label -side top -expand yes
+ pack .kbd.val -side top -expand yes -pady 2 -fill x
+
+ #
+ # Mouse settings
+ #
+
+ frame .mouse -relief raised -borderwidth 2
+
+ label .mouse.label -text "Mouse Settings"
+ frame .mouse.hor
+ labelentry .mouse.hor.acc "Acceleration" 3
+ labelentry .mouse.hor.thr "Threshold (pixels)" 3
+
+ pack .mouse.hor.acc -side left
+ pack .mouse.hor.thr -side right
+
+ pack .mouse.label -side top
+ pack .mouse.hor -side top -expand yes
+
+ #
+ # Screen Saver settings
+ #
+
+ frame .screen -relief raised -borderwidth 2
+
+ label .screen.label -text "Screen-saver Settings"
+ frame .screen.val
+
+ frame .screen.val.rb
+ radiobutton .screen.val.rb.blank \
+ -variable screenblank -text "Blank" -relief flat \
+ -value "blank" -variable screenbla
+ radiobutton .screen.val.rb.pat \
+ -variable screenblank -text "Pattern" -relief flat \
+ -value "noblank" -variable screenbla
+ pack .screen.val.rb.blank .screen.val.rb.pat -side top -pady 2 -anchor w
+ frame .screen.val.le
+ labelentry .screen.val.le.tim "Timeout (s)" 5
+ labelentry .screen.val.le.cyc "Cycle (s)" 5
+ pack .screen.val.le.tim .screen.val.le.cyc -side top -pady 2 -anchor e
+
+ pack .screen.val.rb .screen.val.le -side left
+
+ pack .screen.label -side top
+ pack .screen.val -side top -expand y
+
+ #
+ # Main window
+ #
+
+ pack .buttons -side top -fill both
+ pack .bell .kbd .mouse .screen -side top -fill both -ipady 5 -expand yes
+
+ #
+ # Let the user resize our window
+ #
+ wm minsize . 10 10
+}
+
+##############################################################################
+# Main program
+
+#
+# Listen what "xset" tells us...
+#
+
+readsettings
+
+#
+# Create all windows
+#
+
+createwindows
+
+#
+# Write xset parameters
+#
+
+dispsettings
+
+#
+# Now, wait for user actions...
+#
diff --git a/tk/library/demos/label.tcl b/tk/library/demos/label.tcl
new file mode 100644
index 00000000000..2e0b0271f2e
--- /dev/null
+++ b/tk/library/demos/label.tcl
@@ -0,0 +1,40 @@
+# 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}
+toplevel $w
+wm title $w "Label Demonstration"
+wm iconname $w "label"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "Five labels are displayed below: three textual ones on the left, and a bitmap label and a text label on the right. Labels are pretty boring because you can't do anything with them."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.left
+frame $w.right
+pack $w.left $w.right -side left -expand yes -padx 10 -pady 10 -fill both
+
+label $w.left.l1 -text "First label"
+label $w.left.l2 -text "Second label, raised" -relief raised
+label $w.left.l3 -text "Third label, sunken" -relief sunken
+pack $w.left.l1 $w.left.l2 $w.left.l3 -side top -expand yes -pady 2 -anchor w
+
+label $w.right.bitmap -borderwidth 2 -relief sunken \
+ -bitmap @[file join $tk_library demos images face.bmp]
+label $w.right.caption -text "Tcl/Tk Proprietor"
+pack $w.right.bitmap $w.right.caption -side top
diff --git a/tk/library/demos/license.terms b/tk/library/demos/license.terms
new file mode 100644
index 00000000000..03ca6fcb319
--- /dev/null
+++ b/tk/library/demos/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., and other parties. The following
+terms apply to all files associated with the software unless explicitly
+disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
diff --git a/tk/library/demos/menu.tcl b/tk/library/demos/menu.tcl
new file mode 100644
index 00000000000..78ec6256f17
--- /dev/null
+++ b/tk/library/demos/menu.tcl
@@ -0,0 +1,152 @@
+# 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}
+toplevel $w
+wm title $w "Menu Demonstration"
+wm iconname $w "menu"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left
+if {$tcl_platform(platform) == "macintosh"} {
+ $w.msg configure -text "This window contains a menubar with cascaded menus. You can invoke entries with an accelerator by typing Command+x, where \"x\" is the character next to the command key symbol. The rightmost menu can be torn off into a palette by dragging outside of its bounds and releasing the mouse."
+} else {
+ $w.msg configure -text "This window contains a menubar with cascaded menus. You can post a menu from the keyboard by typing Alt+x, where \"x\" is the character underlined on the menu. You can then traverse among the menus using the arrow keys. When a menu is posted, you can invoke the current entry by typing space, or you can invoke any entry by typing its underlined character. If a menu entry has an accelerator, you can invoke the entry without posting the menu just by typing the accelerator. The rightmost menu can be torn off into a palette by selecting the first item in the menu."
+}
+pack $w.msg -side top
+
+set menustatus " "
+frame $w.statusBar
+label $w.statusBar.label -textvariable menustatus -relief sunken -bd 1 -font "Helvetica 10" -anchor w
+pack $w.statusBar.label -side left -padx 2 -expand yes -fill both
+pack $w.statusBar -side bottom -fill x -pady 2
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+menu $w.menu -tearoff 0
+
+set m $w.menu.file
+menu $m -tearoff 0
+$w.menu add cascade -label "File" -menu $m -underline 0
+$m add command -label "Open..." -command {error "this is just a demo: no action has been defined for the \"Open...\" entry"}
+$m add command -label "New" -command {error "this is just a demo: no action has been defined for the \"New\" entry"}
+$m add command -label "Save" -command {error "this is just a demo: no action has been defined for the \"Save\" entry"}
+$m add command -label "Save As..." -command {error "this is just a demo: no action has been defined for the \"Save As...\" entry"}
+$m add separator
+$m add command -label "Print Setup..." -command {error "this is just a demo: no action has been defined for the \"Print Setup...\" entry"}
+$m add command -label "Print..." -command {error "this is just a demo: no action has been defined for the \"Print...\" entry"}
+$m add separator
+$m add command -label "Dismiss Menus Demo" -command "destroy $w"
+
+set m $w.menu.basic
+$w.menu add cascade -label "Basic" -menu $m -underline 0
+menu $m -tearoff 0
+$m add command -label "Long entry that does nothing"
+if {$tcl_platform(platform) == "macintosh"} {
+ set modifier Command
+} elseif {$tcl_platform(platform) == "windows"} {
+ set modifier Control
+} else {
+ set modifier Meta
+}
+foreach i {A B C D E F} {
+ $m add command -label "Print letter \"$i\"" -underline 14 \
+ -accelerator Meta+$i -command "puts $i" -accelerator $modifier+$i
+ bind $w <$modifier-[string tolower $i]> "puts $i"
+}
+
+set m $w.menu.cascade
+$w.menu add cascade -label "Cascades" -menu $m -underline 0
+menu $m -tearoff 0
+$m add command -label "Print hello" \
+ -command {puts stdout "Hello"} -accelerator $modifier+H -underline 6
+bind $w <$modifier-h> {puts stdout "Hello"}
+$m add command -label "Print goodbye" -command {\
+ puts stdout "Goodbye"} -accelerator $modifier+G -underline 6
+bind $w <$modifier-g> {puts stdout "Goodbye"}
+$m add cascade -label "Check buttons" \
+ -menu $w.menu.cascade.check -underline 0
+$m add cascade -label "Radio buttons" \
+ -menu $w.menu.cascade.radio -underline 0
+
+set m $w.menu.cascade.check
+menu $m -tearoff 0
+$m add check -label "Oil checked" -variable oil
+$m add check -label "Transmission checked" -variable trans
+$m add check -label "Brakes checked" -variable brakes
+$m add check -label "Lights checked" -variable lights
+$m add separator
+$m add command -label "Show current values" \
+ -command "showVars $w.menu.cascade.dialog oil trans brakes lights"
+$m invoke 1
+$m invoke 3
+
+set m $w.menu.cascade.radio
+menu $m -tearoff 0
+$m add radio -label "10 point" -variable pointSize -value 10
+$m add radio -label "14 point" -variable pointSize -value 14
+$m add radio -label "18 point" -variable pointSize -value 18
+$m add radio -label "24 point" -variable pointSize -value 24
+$m add radio -label "32 point" -variable pointSize -value 32
+$m add sep
+$m add radio -label "Roman" -variable style -value roman
+$m add radio -label "Bold" -variable style -value bold
+$m add radio -label "Italic" -variable style -value italic
+$m add sep
+$m add command -label "Show current values" \
+ -command "showVars $w.menu.cascade.dialog pointSize style"
+$m invoke 1
+$m invoke 7
+
+set m $w.menu.icon
+$w.menu add cascade -label "Icons" -menu $m -underline 0
+menu $m -tearoff 0
+$m add command \
+ -bitmap @[file join $tk_library demos images pattern.bmp] \
+ -hidemargin 1 \
+ -command {
+ tk_dialog .pattern {Bitmap Menu Entry} {The menu entry you invoked displays a bitmap rather than a text string. Other than this, it is just like any other menu entry.} {} 0 OK
+}
+foreach i {info questhead error} {
+ $m add command -bitmap $i -command "puts {You invoked the $i bitmap}" -hidemargin 1
+}
+$m entryconfigure 2 -columnbreak 1
+
+set m $w.menu.more
+$w.menu add cascade -label "More" -menu $m -underline 0
+menu $m -tearoff 0
+foreach i {{An entry} {Another entry} {Does nothing} {Does almost nothing} {Make life meaningful}} {
+ $m add command -label $i -command [list puts "You invoked \"$i\""]
+}
+
+set m $w.menu.colors
+$w.menu add cascade -label "Colors" -menu $m -underline 1
+menu $m
+foreach i {red orange yellow green blue} {
+ $m add command -label $i -background $i \
+ -command [list puts "You invoked \"$i\""]
+}
+
+$w configure -menu $w.menu
+
+bind Menu <<MenuSelect>> {
+ global $menustatus
+ if {[catch {%W entrycget active -label} label]} {
+ set label " "
+ }
+ set menustatus $label
+ update idletasks
+}
diff --git a/tk/library/demos/menubu.tcl b/tk/library/demos/menubu.tcl
new file mode 100644
index 00000000000..2a76e302711
--- /dev/null
+++ b/tk/library/demos/menubu.tcl
@@ -0,0 +1,93 @@
+# 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}
+toplevel $w
+wm title $w "Menu Button Demonstration"
+wm iconname $w "menubutton"
+positionWindow $w
+
+
+frame $w.body
+pack $w.body -expand 1 -fill both
+
+menubutton $w.body.below -text "Below" -underline 0 -direction below -menu $w.body.below.m -relief raised
+menu $w.body.below.m -tearoff 0
+$w.body.below.m add command -label "Below menu: first item" -command "puts \"You have selected the first item from the Below menu.\""
+$w.body.below.m add command -label "Below menu: second item" -command "puts \"You have selected the second item from the Below menu.\""
+grid $w.body.below -row 0 -column 1 -sticky n
+menubutton $w.body.right -text "Right" -underline 0 -direction right -menu $w.body.right.m -relief raised
+menu $w.body.right.m -tearoff 0
+$w.body.right.m add command -label "Right menu: first item" -command "puts \"You have selected the first item from the Right menu.\""
+$w.body.right.m add command -label "Right menu: second item" -command "puts \"You have selected the second item from the Right menu.\""
+frame $w.body.center
+menubutton $w.body.left -text "Left" -underline 0 -direction left -menu $w.body.left.m -relief raised
+menu $w.body.left.m -tearoff 0
+$w.body.left.m add command -label "Left menu: first item" -command "puts \"You have selected the first item from the Left menu.\""
+$w.body.left.m add command -label "Left menu: second item" -command "puts \"You have selected the second item from the Left menu.\""
+grid $w.body.right -row 1 -column 0 -sticky w
+grid $w.body.center -row 1 -column 1 -sticky news
+grid $w.body.left -row 1 -column 2 -sticky e
+menubutton $w.body.above -text "Above" -underline 0 -direction above -menu $w.body.above.m -relief raised
+menu $w.body.above.m -tearoff 0
+$w.body.above.m add command -label "Above menu: first item" -command "puts \"You have selected the first item from the Above menu.\""
+$w.body.above.m add command -label "Above menu: second item" -command "puts \"You have selected the second item from the Above menu.\""
+grid $w.body.above -row 2 -column 1 -sticky s
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode .menubu"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+set body $w.body.center
+label $body.label -wraplength 300 -font "Helvetica 14" -justify left -text "This is a demonstration of menubuttons. The \"Below\" menubutton pops its menu below the button; the \"Right\" button pops to the right, etc. There are two option menus directly below this text; one is just a standard menu and the other is a 16-color palette."
+pack $body.label -side top -padx 25 -pady 25
+frame $body.buttons
+pack $body.buttons -padx 25 -pady 25
+tk_optionMenu $body.buttons.options menubuttonoptions one two three
+pack $body.buttons.options -side left -padx 25 -pady 25
+set m [tk_optionMenu $body.buttons.colors paletteColor Black red4 DarkGreen NavyBlue gray75 Red Green Blue gray50 Yellow Cyan Magenta White Brown DarkSeaGreen DarkViolet]
+if {$tcl_platform(platform) == "macintosh"} {
+ set topBorderColor Black
+ set bottomBorderColor Black
+} else {
+ set topBorderColor gray50
+ set bottomBorderColor gray75
+}
+for {set i 0} {$i <= [$m index last]} {incr i} {
+ set name [$m entrycget $i -label]
+ image create photo image_$name -height 16 -width 16
+ image_$name put $topBorderColor -to 0 0 16 1
+ image_$name put $topBorderColor -to 0 1 1 16
+ image_$name put $bottomBorderColor -to 0 15 16 16
+ image_$name put $bottomBorderColor -to 15 1 16 16
+ image_$name put $name -to 1 1 15 15
+
+ image create photo image_${name}_s -height 16 -width 16
+ image_${name}_s put Black -to 0 0 16 2
+ image_${name}_s put Black -to 0 2 2 16
+ image_${name}_s put Black -to 2 14 16 16
+ image_${name}_s put Black -to 14 2 16 14
+ image_${name}_s put $name -to 2 2 14 14
+
+ $m entryconfigure $i -image image_$name -selectimage image_${name}_s -hidemargin 1
+}
+$m configure -tearoff 1
+foreach i {Black gray75 gray50 White} {
+ $m entryconfigure $i -columnbreak 1
+}
+
+pack $body.buttons.colors -side left -padx 25 -pady 25
+
+
+
diff --git a/tk/library/demos/msgbox.tcl b/tk/library/demos/msgbox.tcl
new file mode 100644
index 00000000000..52b648f89ab
--- /dev/null
+++ b/tk/library/demos/msgbox.tcl
@@ -0,0 +1,65 @@
+# 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}
+toplevel $w
+wm title $w "Message Box Demonstration"
+wm iconname $w "messagebox"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "Choose the icon and type option of the message box. Then press the \"Message Box\" button to see the message box."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+button $w.buttons.vars -text "Message Box" \
+ -command "showMessageBox $w"
+pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1
+
+frame $w.left
+frame $w.right
+pack $w.left $w.right -side left -expand yes -fill y -pady .5c -padx .5c
+
+label $w.left.label -text "Icon"
+frame $w.left.sep -relief ridge -bd 1 -height 2
+pack $w.left.label -side top
+pack $w.left.sep -side top -fill x -expand no
+
+set msgboxIcon info
+foreach i {error info question warning} {
+ radiobutton $w.left.b$i -text $i -variable msgboxIcon \
+ -relief flat -value $i -width 16 -anchor w
+ pack $w.left.b$i -side top -pady 2 -anchor w -fill x
+}
+
+label $w.right.label -text "Type"
+frame $w.right.sep -relief ridge -bd 1 -height 2
+pack $w.right.label -side top
+pack $w.right.sep -side top -fill x -expand no
+
+set msgboxType ok
+foreach t {abortretryignore ok okcancel retrycancel yesno yesnocancel} {
+ radiobutton $w.right.$t -text $t -variable msgboxType \
+ -relief flat -value $t -width 16 -anchor w
+ pack $w.right.$t -side top -pady 2 -anchor w -fill x
+}
+
+proc showMessageBox {w} {
+ global msgboxIcon msgboxType
+ set button [tk_messageBox -icon $msgboxIcon -type $msgboxType \
+ -title Message -parent $w\
+ -message "This is a \"$msgboxType\" type messagebox with the \"$msgboxIcon\" icon"]
+
+ tk_messageBox -icon info -message "You have selected \"$button\"" -type ok\
+ -parent $w
+}
diff --git a/tk/library/demos/plot.tcl b/tk/library/demos/plot.tcl
new file mode 100644
index 00000000000..6067979806f
--- /dev/null
+++ b/tk/library/demos/plot.tcl
@@ -0,0 +1,98 @@
+# 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}
+toplevel $w
+wm title $w "Plot Demonstration"
+wm iconname $w "Plot"
+positionWindow $w
+set c $w.c
+
+label $w.msg -font $font -wraplength 4i -justify left -text "This window displays a canvas widget containing a simple 2-dimensional plot. You can doctor the data by dragging any of the points with mouse button 1."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+canvas $c -relief raised -width 450 -height 300
+pack $w.c -side top -fill x
+
+set plotFont {Helvetica 18}
+
+$c create line 100 250 400 250 -width 2
+$c create line 100 250 100 50 -width 2
+$c create text 225 20 -text "A Simple Plot" -font $plotFont -fill brown
+
+for {set i 0} {$i <= 10} {incr i} {
+ set x [expr {100 + ($i*30)}]
+ $c create line $x 250 $x 245 -width 2
+ $c create text $x 254 -text [expr 10*$i] -anchor n -font $plotFont
+}
+for {set i 0} {$i <= 5} {incr i} {
+ set y [expr {250 - ($i*40)}]
+ $c create line 100 $y 105 $y -width 2
+ $c create text 96 $y -text [expr $i*50].0 -anchor e -font $plotFont
+}
+
+foreach point {{12 56} {20 94} {33 98} {32 120} {61 180}
+ {75 160} {98 223}} {
+ set x [expr {100 + (3*[lindex $point 0])}]
+ set y [expr {250 - (4*[lindex $point 1])/5}]
+ set item [$c create oval [expr $x-6] [expr $y-6] \
+ [expr $x+6] [expr $y+6] -width 1 -outline black \
+ -fill SkyBlue2]
+ $c addtag point withtag $item
+}
+
+$c bind point <Any-Enter> "$c itemconfig current -fill red"
+$c bind point <Any-Leave> "$c itemconfig current -fill SkyBlue2"
+$c bind point <1> "plotDown $c %x %y"
+$c bind point <ButtonRelease-1> "$c dtag selected"
+bind $c <B1-Motion> "plotMove $c %x %y"
+
+set plot(lastX) 0
+set plot(lastY) 0
+
+# plotDown --
+# This procedure is invoked when the mouse is pressed over one of the
+# data points. It sets up state to allow the point to be dragged.
+#
+# Arguments:
+# w - The canvas window.
+# x, y - The coordinates of the mouse press.
+
+proc plotDown {w x y} {
+ global plot
+ $w dtag selected
+ $w addtag selected withtag current
+ $w raise current
+ set plot(lastX) $x
+ set plot(lastY) $y
+}
+
+# plotMove --
+# This procedure is invoked during mouse motion events. It drags the
+# current item.
+#
+# Arguments:
+# w - The canvas window.
+# x, y - The coordinates of the mouse.
+
+proc plotMove {w x y} {
+ global plot
+ $w move selected [expr $x-$plot(lastX)] [expr $y-$plot(lastY)]
+ set plot(lastX) $x
+ set plot(lastY) $y
+}
diff --git a/tk/library/demos/puzzle.tcl b/tk/library/demos/puzzle.tcl
new file mode 100644
index 00000000000..7e3d9c8d96c
--- /dev/null
+++ b/tk/library/demos/puzzle.tcl
@@ -0,0 +1,73 @@
+# 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;
+# if the button is next to the empty space, it moves the button into th
+# empty space.
+
+proc puzzleSwitch {w num} {
+ global xpos ypos
+ if {(($ypos($num) >= ($ypos(space) - .01))
+ && ($ypos($num) <= ($ypos(space) + .01))
+ && ($xpos($num) >= ($xpos(space) - .26))
+ && ($xpos($num) <= ($xpos(space) + .26)))
+ || (($xpos($num) >= ($xpos(space) - .01))
+ && ($xpos($num) <= ($xpos(space) + .01))
+ && ($ypos($num) >= ($ypos(space) - .26))
+ && ($ypos($num) <= ($ypos(space) + .26)))} {
+ set tmp $xpos(space)
+ set xpos(space) $xpos($num)
+ set xpos($num) $tmp
+ set tmp $ypos(space)
+ set ypos(space) $ypos($num)
+ set ypos($num) $tmp
+ place $w.frame.$num -relx $xpos($num) -rely $ypos($num)
+ }
+}
+
+set w .puzzle
+catch {destroy $w}
+toplevel $w
+wm title $w "15-Puzzle Demonstration"
+wm iconname $w "15-Puzzle"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "A 15-puzzle appears below as a collection of buttons. Click on any of the pieces next to the space, and that piece will slide over the space. Continue this until the pieces are arranged in numerical order from upper-left to lower-right."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+# Special trick: select a darker color for the space by creating a
+# scrollbar widget and using its trough color.
+
+scrollbar $w.s
+frame $w.frame -width 120 -height 120 -borderwidth 2 -relief sunken \
+ -bg [$w.s cget -troughcolor]
+pack $w.frame -side top -pady 1c -padx 1c
+destroy $w.s
+
+set order {3 1 6 2 5 7 15 13 4 11 8 9 14 10 12}
+for {set i 0} {$i < 15} {set i [expr $i+1]} {
+ set num [lindex $order $i]
+ set xpos($num) [expr ($i%4)*.25]
+ set ypos($num) [expr ($i/4)*.25]
+ button $w.frame.$num -relief raised -text $num -highlightthickness 0 \
+ -command "puzzleSwitch $w $num"
+ place $w.frame.$num -relx $xpos($num) -rely $ypos($num) \
+ -relwidth .25 -relheight .25
+}
+set xpos(space) .75
+set ypos(space) .75
diff --git a/tk/library/demos/radio.tcl b/tk/library/demos/radio.tcl
new file mode 100644
index 00000000000..2b73739e47d
--- /dev/null
+++ b/tk/library/demos/radio.tcl
@@ -0,0 +1,44 @@
+# 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}
+toplevel $w
+wm title $w "Radiobutton Demonstration"
+wm iconname $w "radio"
+positionWindow $w
+label $w.msg -font $font -wraplength 5i -justify left -text "Two groups of radiobuttons are displayed below. If you click on a button then the button will become selected exclusively among all the buttons in its group. A Tcl variable is associated with each group to indicate which of the group's buttons is selected. Click the \"See Variables\" button to see the current values of the variables."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+button $w.buttons.vars -text "See Variables" \
+ -command "showVars $w.dialog size color"
+pack $w.buttons.dismiss $w.buttons.code $w.buttons.vars -side left -expand 1
+
+frame $w.left
+frame $w.right
+pack $w.left $w.right -side left -expand yes -pady .5c -padx .5c
+
+foreach i {10 12 18 24} {
+ radiobutton $w.left.b$i -text "Point Size $i" -variable size \
+ -relief flat -value $i
+ pack $w.left.b$i -side top -pady 2 -anchor w
+}
+
+foreach color {Red Green Blue Yellow Orange Purple} {
+ set lower [string tolower $color]
+ radiobutton $w.right.$lower -text $color -variable color \
+ -relief flat -value $lower
+ pack $w.right.$lower -side top -pady 2 -anchor w
+}
diff --git a/tk/library/demos/rmt b/tk/library/demos/rmt
new file mode 100755
index 00000000000..93104758988
--- /dev/null
+++ b/tk/library/demos/rmt
@@ -0,0 +1,205 @@
+#!/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
+# the commands locally.
+
+set app "local"
+
+# The global variable below keeps track of whether we're in the
+# middle of executing a command entered via the text.
+
+set executing 0
+
+# The global variable below keeps track of the last command executed,
+# so it can be re-executed in response to !! commands.
+
+set lastCommand ""
+
+# Create menu bar. Arrange to recreate all the information in the
+# applications sub-menu whenever it is cascaded to.
+
+frame .menu -relief raised -bd 2
+pack .menu -side top -fill x
+menubutton .menu.file -text "File" -menu .menu.file.m -underline 0
+menu .menu.file.m
+.menu.file.m add cascade -label "Select Application" \
+ -menu .menu.file.m.apps -underline 0
+.menu.file.m add command -label "Quit" -command "destroy ." -underline 0
+menu .menu.file.m.apps -postcommand fillAppsMenu
+pack .menu.file -side left
+
+# Create text window and scrollbar.
+
+text .t -relief sunken -bd 2 -yscrollcommand ".s set" -setgrid true
+scrollbar .s -command ".t yview"
+pack .s -side right -fill both
+pack .t -side left
+
+# Create a binding to forward commands to the target application,
+# plus modify many of the built-in bindings so that only information
+# in the current command can be deleted (can still set the cursor
+# earlier in the text and select and insert; just can't delete).
+
+bindtags .t {.t Text . all}
+bind .t <Return> {
+ .t mark set insert {end - 1c}
+ .t insert insert \n
+ invoke
+ break
+}
+bind .t <Delete> {
+ catch {.t tag remove sel sel.first promptEnd}
+ if {[.t tag nextrange sel 1.0 end] == ""} {
+ if [.t compare insert < promptEnd] {
+ break
+ }
+ }
+}
+bind .t <BackSpace> {
+ catch {.t tag remove sel sel.first promptEnd}
+ if {[.t tag nextrange sel 1.0 end] == ""} {
+ if [.t compare insert <= promptEnd] {
+ break
+ }
+ }
+}
+bind .t <Control-d> {
+ if [.t compare insert < promptEnd] {
+ break
+ }
+}
+bind .t <Control-k> {
+ if [.t compare insert < promptEnd] {
+ .t mark set insert promptEnd
+ }
+}
+bind .t <Control-t> {
+ if [.t compare insert < promptEnd] {
+ break
+ }
+}
+bind .t <Meta-d> {
+ if [.t compare insert < promptEnd] {
+ break
+ }
+}
+bind .t <Meta-BackSpace> {
+ if [.t compare insert <= promptEnd] {
+ break
+ }
+}
+bind .t <Control-h> {
+ if [.t compare insert <= promptEnd] {
+ break
+ }
+}
+auto_load tkTextInsert
+proc tkTextInsert {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
+ }
+ }
+ $w insert insert $s
+ $w see insert
+}
+
+.t tag configure bold -font {Courier 12 bold}
+
+# The procedure below is used to print out a prompt at the
+# insertion point (which should be at the beginning of a line
+# right now).
+
+proc prompt {} {
+ global app
+ .t insert insert "$app: "
+ .t mark set promptEnd {insert}
+ .t mark gravity promptEnd left
+ .t tag add bold {promptEnd linestart} promptEnd
+}
+
+# The procedure below executes a command (it takes everything on the
+# current line after the prompt and either sends it to the remote
+# application or executes it locally, depending on "app".
+
+proc invoke {} {
+ global app executing lastCommand
+ set cmd [.t get promptEnd insert]
+ incr executing 1
+ if [info complete $cmd] {
+ if {$cmd == "!!\n"} {
+ set cmd $lastCommand
+ } else {
+ set lastCommand $cmd
+ }
+ if {$app == "local"} {
+ set result [catch [list uplevel #0 $cmd] msg]
+ } else {
+ set result [catch [list send $app $cmd] msg]
+ }
+ if {$result != 0} {
+ .t insert insert "Error: $msg\n"
+ } else {
+ if {$msg != ""} {
+ .t insert insert $msg\n
+ }
+ }
+ prompt
+ .t mark set promptEnd insert
+ }
+ incr executing -1
+ .t yview -pickplace insert
+}
+
+# The following procedure is invoked to change the application that
+# we're talking to. It also updates the prompt for the current
+# command, unless we're in the middle of executing a command from
+# the text item (in which case a new prompt is about to be output
+# so there's no need to change the old one).
+
+proc newApp appName {
+ global app executing
+ set app $appName
+ if !$executing {
+ .t mark gravity promptEnd right
+ .t delete "promptEnd linestart" promptEnd
+ .t insert promptEnd "$appName: "
+ .t tag add bold "promptEnd linestart" promptEnd
+ .t mark gravity promptEnd left
+ }
+ return {}
+}
+
+# The procedure below will fill in the applications sub-menu with a list
+# of all the applications that currently exist.
+
+proc fillAppsMenu {} {
+ catch {.menu.file.m.apps delete 0 last}
+ foreach i [lsort [winfo interps]] {
+ .menu.file.m.apps add command -label $i -command [list newApp $i]
+ }
+ .menu.file.m.apps add command -label local -command {newApp local}
+}
+
+set app [winfo name .]
+prompt
+focus .t
diff --git a/tk/library/demos/rolodex b/tk/library/demos/rolodex
new file mode 100755
index 00000000000..e3e0e5a2682
--- /dev/null
+++ b/tk/library/demos/rolodex
@@ -0,0 +1,196 @@
+#!/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.
+#------------------------------------------
+
+frame .frame -relief flat
+pack .frame -side top -fill y -anchor center
+
+set names {{} Name: Address: {} {} {Home Phone:} {Work Phone:} Fax:}
+foreach i {1 2 3 4 5 6 7} {
+ frame .frame.$i
+ pack .frame.$i -side top -pady 2 -anchor e
+
+ label .frame.$i.label -text [lindex $names $i] -anchor e
+ entry .frame.$i.entry -width 30 -relief sunken
+ pack .frame.$i.entry .frame.$i.label -side right
+}
+
+frame .buttons
+pack .buttons -side bottom -pady 2 -anchor center
+button .buttons.clear -text Clear
+button .buttons.add -text Add
+button .buttons.search -text Search
+button .buttons.delete -text "Delete ..."
+pack .buttons.clear .buttons.add .buttons.search .buttons.delete \
+ -side left -padx 2
+
+#------------------------------------------
+# Phase 1: Add menus, dialog boxes
+#------------------------------------------
+
+frame .menu -relief raised -borderwidth 1
+pack .menu -before .frame -side top -fill x
+
+menubutton .menu.file -text "File" -menu .menu.file.m -underline 0
+menu .menu.file.m
+.menu.file.m add command -label "Load ..." -command fileAction -underline 0
+.menu.file.m add command -label "Exit" -command {destroy .} -underline 0
+pack .menu.file -side left
+
+menubutton .menu.help -text "Help" -menu .menu.help.m -underline 0
+menu .menu.help.m
+pack .menu.help -side right
+
+proc deleteAction {} {
+ if {[tk_dialog .delete {Confirm Action} {Are you sure?} {} 0 Cancel]
+ == 0} {
+ clearAction
+ }
+}
+.buttons.delete config -command deleteAction
+
+proc fileAction {} {
+ tk_dialog .fileSelection {File Selection} {This is a dummy file selection dialog box, which is used because there isn't a good file selection dialog built into Tk yet.} {} 0 OK
+ puts stderr {dummy file name}
+}
+
+#------------------------------------------
+# Phase 3: Print contents of card
+#------------------------------------------
+
+proc addAction {} {
+ global names
+ foreach i {1 2 3 4 5 6 7} {
+ puts stderr [format "%-12s %s" [lindex $names $i] [.frame.$i.entry get]]
+ }
+}
+.buttons.add config -command addAction
+
+#------------------------------------------
+# Phase 4: Miscellaneous other actions
+#------------------------------------------
+
+proc clearAction {} {
+ foreach i {1 2 3 4 5 6 7} {
+ .frame.$i.entry delete 0 end
+ }
+}
+.buttons.clear config -command clearAction
+
+proc fillCard {} {
+ clearAction
+ .frame.1.entry insert 0 "John Ousterhout"
+ .frame.2.entry insert 0 "CS Division, Department of EECS"
+ .frame.3.entry insert 0 "University of California"
+ .frame.4.entry insert 0 "Berkeley, CA 94720"
+ .frame.5.entry insert 0 "private"
+ .frame.6.entry insert 0 "510-642-0865"
+ .frame.7.entry insert 0 "510-642-5775"
+}
+.buttons.search config -command "addAction; fillCard"
+
+#----------------------------------------------------
+# Phase 5: Accelerators, mnemonics, command-line info
+#----------------------------------------------------
+
+.buttons.clear config -text "Clear Ctrl+C"
+bind . <Control-c> clearAction
+.buttons.add config -text "Add Ctrl+A"
+bind . <Control-a> addAction
+.buttons.search config -text "Search Ctrl+S"
+bind . <Control-s> "addAction; fillCard"
+.buttons.delete config -text "Delete... Ctrl+D"
+bind . <Control-d> deleteAction
+
+.menu.file.m entryconfig 1 -accel Ctrl+F
+bind . <Control-f> fileAction
+.menu.file.m entryconfig 2 -accel Ctrl+Q
+bind . <Control-q> {destroy .}
+
+focus .frame.1.entry
+
+#----------------------------------------------------
+# Phase 6: help
+#----------------------------------------------------
+
+proc Help {topic {x 0} {y 0}} {
+ global helpTopics helpCmds
+ if {$topic == ""} return
+ while {[info exists helpCmds($topic)]} {
+ set topic [eval $helpCmds($topic)]
+ }
+ if [info exists helpTopics($topic)] {
+ set msg $helpTopics($topic)
+ } else {
+ set msg "Sorry, but no help is available for this topic"
+ }
+ tk_dialog .help {Rolodex Help} "Information on $topic:\n\n$msg" \
+ {} 0 OK
+}
+
+proc getMenuTopic {w x y} {
+ return $w.[$w index @[expr $y-[winfo rooty $w]]]
+}
+
+bind . <Any-F1> {Help [winfo containing %X %Y] %X %Y}
+bind . <Any-Help> {Help [winfo containing %X %Y] %X %Y}
+
+# Help text and commands follow:
+
+set helpTopics(.menu.file) {This is the "file" menu. It can be used to invoke some overall operations on the rolodex applications, such as loading a file or exiting.}
+
+set helpCmds(.menu.file.m) {getMenuTopic $topic $x $y}
+set helpTopics(.menu.file.m.0) {The "Load" entry in the "File" menu posts a dialog box that you can use to select a rolodex file}
+set helpTopics(.menu.file.m.1) {The "Exit" entry in the "File" menu causes the rolodex application to terminate}
+set helpCmds(.menu.file.m.none) {set topic ".menu.file"}
+
+set helpTopics(.frame.1.entry) {In this field of the rolodex entry you should type the person's name}
+set helpTopics(.frame.2.entry) {In this field of the rolodex entry you should type the first line of the person's address}
+set helpTopics(.frame.3.entry) {In this field of the rolodex entry you should type the second line of the person's address}
+set helpTopics(.frame.4.entry) {In this field of the rolodex entry you should type the third line of the person's address}
+set helpTopics(.frame.5.entry) {In this field of the rolodex entry you should type the person's home phone number, or "private" if the person doesn't want his or her number publicized}
+set helpTopics(.frame.6.entry) {In this field of the rolodex entry you should type the person's work phone number}
+set helpTopics(.frame.7.entry) {In this field of the rolodex entry you should type the phone number for the person's FAX machine}
+
+set helpCmds(.frame.1.label) {set topic .frame.1.entry}
+set helpCmds(.frame.2.label) {set topic .frame.2.entry}
+set helpCmds(.frame.3.label) {set topic .frame.3.entry}
+set helpCmds(.frame.4.label) {set topic .frame.4.entry}
+set helpCmds(.frame.5.label) {set topic .frame.5.entry}
+set helpCmds(.frame.6.label) {set topic .frame.6.entry}
+set helpCmds(.frame.7.label) {set topic .frame.7.entry}
+
+set helpTopics(context) {Unfortunately, this application doesn't support context-sensitive help in the usual way, because when this demo was written Tk didn't have a grab mechanism and this is needed for context-sensitive help. Instead, you can achieve much the same effect by simply moving the mouse over the window you're curious about and pressing the Help or F1 keys. You can do this anytime.}
+set helpTopics(help) {This application provides only very crude help. Besides the entries in this menu, you can get help on individual windows by moving the mouse cursor over the window and pressing the Help or F1 keys.}
+set helpTopics(window) {This window is a dummy rolodex application created as part of Tom LaStrange's toolkit benchmark. It doesn't really do anything useful except to demonstrate a few features of the Tk toolkit.}
+set helpTopics(keys) "The following accelerator keys are defined for this application (in addition to those already available for the entry windows):\n\nCtrl+A:\t\tAdd\nCtrl+C:\t\tClear\nCtrl+D:\t\tDelete\nCtrl+F:\t\tEnter file name\nCtrl+Q:\t\tExit application (quit)\nCtrl+S:\t\tSearch (dummy operation)"
+set helpTopics(version) {This is version 1.0.}
+
+# Entries in "Help" menu
+
+.menu.help.m add command -label "On Context..." -command {Help context} \
+ -underline 3
+.menu.help.m add command -label "On Help..." -command {Help help} \
+ -underline 3
+.menu.help.m add command -label "On Window..." -command {Help window} \
+ -underline 3
+.menu.help.m add command -label "On Keys..." -command {Help keys} \
+ -underline 3
+.menu.help.m add command -label "On Version..." -command {Help version} \
+ -underline 3
diff --git a/tk/library/demos/ruler.tcl b/tk/library/demos/ruler.tcl
new file mode 100644
index 00000000000..3c77c72d455
--- /dev/null
+++ b/tk/library/demos/ruler.tcl
@@ -0,0 +1,173 @@
+# 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
+# represent a tab stop.
+#
+# Arguments:
+# c - The canvas window.
+# x, y - Coordinates at which to create the tab stop.
+
+proc rulerMkTab {c x y} {
+ upvar #0 demo_rulerInfo v
+ $c create polygon $x $y [expr $x+$v(size)] [expr $y+$v(size)] \
+ [expr $x-$v(size)] [expr $y+$v(size)]
+}
+
+set w .ruler
+global tk_library
+catch {destroy $w}
+toplevel $w
+wm title $w "Ruler Demonstration"
+wm iconname $w "ruler"
+positionWindow $w
+set c $w.c
+
+label $w.msg -font $font -wraplength 5i -justify left -text "This canvas widget shows a mock-up of a ruler. You can create tab stops by dragging them out of the well to the right of the ruler. You can also drag existing tab stops. If you drag a tab stop far enough up or down so that it turns dim, it will be deleted when you release the mouse button."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+canvas $c -width 14.8c -height 2.5c
+pack $w.c -side top -fill x
+
+set demo_rulerInfo(grid) .25c
+set demo_rulerInfo(left) [winfo fpixels $c 1c]
+set demo_rulerInfo(right) [winfo fpixels $c 13c]
+set demo_rulerInfo(top) [winfo fpixels $c 1c]
+set demo_rulerInfo(bottom) [winfo fpixels $c 1.5c]
+set demo_rulerInfo(size) [winfo fpixels $c .2c]
+set demo_rulerInfo(normalStyle) "-fill black"
+if {[winfo depth $c] > 1} {
+ set demo_rulerInfo(activeStyle) "-fill red -stipple {}"
+ set demo_rulerInfo(deleteStyle) [list -fill red \
+ -stipple @[file join $tk_library demos images gray25.bmp]]
+} else {
+ set demo_rulerInfo(activeStyle) "-fill black -stipple {}"
+ set demo_rulerInfo(deleteStyle) [list -fill black \
+ -stipple @[file join $tk_library demos images gray25.bmp]]
+}
+
+$c create line 1c 0.5c 1c 1c 13c 1c 13c 0.5c -width 1
+for {set i 0} {$i < 12} {incr i} {
+ set x [expr $i+1]
+ $c create line ${x}c 1c ${x}c 0.6c -width 1
+ $c create line $x.25c 1c $x.25c 0.8c -width 1
+ $c create line $x.5c 1c $x.5c 0.7c -width 1
+ $c create line $x.75c 1c $x.75c 0.8c -width 1
+ $c create text $x.15c .75c -text $i -anchor sw
+}
+$c addtag well withtag [$c create rect 13.2c 1c 13.8c 0.5c \
+ -outline black -fill [lindex [$c config -bg] 4]]
+$c addtag well withtag [rulerMkTab $c [winfo pixels $c 13.5c] \
+ [winfo pixels $c .65c]]
+
+$c bind well <1> "rulerNewTab $c %x %y"
+$c bind tab <1> "rulerSelectTab $c %x %y"
+bind $c <B1-Motion> "rulerMoveTab $c %x %y"
+bind $c <Any-ButtonRelease-1> "rulerReleaseTab $c"
+
+# rulerNewTab --
+# Does all the work of creating a tab stop, including creating the
+# triangle object and adding tags to it to give it tab behavior.
+#
+# Arguments:
+# c - The canvas window.
+# x, y - The coordinates of the tab stop.
+
+proc rulerNewTab {c x y} {
+ upvar #0 demo_rulerInfo v
+ $c addtag active withtag [rulerMkTab $c $x $y]
+ $c addtag tab withtag active
+ set v(x) $x
+ set v(y) $y
+ rulerMoveTab $c $x $y
+}
+
+# rulerSelectTab --
+# This procedure is invoked when mouse button 1 is pressed over
+# a tab. It remembers information about the tab so that it can
+# be dragged interactively.
+#
+# Arguments:
+# c - The canvas widget.
+# x, y - The coordinates of the mouse (identifies the point by
+# which the tab was picked up for dragging).
+
+proc rulerSelectTab {c x y} {
+ upvar #0 demo_rulerInfo v
+ set v(x) [$c canvasx $x $v(grid)]
+ set v(y) [expr $v(top)+2]
+ $c addtag active withtag current
+ eval "$c itemconf active $v(activeStyle)"
+ $c raise active
+}
+
+# rulerMoveTab --
+# This procedure is invoked during mouse motion events to drag a tab.
+# It adjusts the position of the tab, and changes its appearance if
+# it is about to be dragged out of the ruler.
+#
+# Arguments:
+# c - The canvas widget.
+# x, y - The coordinates of the mouse.
+
+proc rulerMoveTab {c x y} {
+ upvar #0 demo_rulerInfo v
+ if {[$c find withtag active] == ""} {
+ return
+ }
+ set cx [$c canvasx $x $v(grid)]
+ set cy [$c canvasy $y]
+ if {$cx < $v(left)} {
+ set cx $v(left)
+ }
+ if {$cx > $v(right)} {
+ set cx $v(right)
+ }
+ if {($cy >= $v(top)) && ($cy <= $v(bottom))} {
+ set cy [expr $v(top)+2]
+ eval "$c itemconf active $v(activeStyle)"
+ } else {
+ set cy [expr $cy-$v(size)-2]
+ eval "$c itemconf active $v(deleteStyle)"
+ }
+ $c move active [expr $cx-$v(x)] [expr $cy-$v(y)]
+ set v(x) $cx
+ set v(y) $cy
+}
+
+# rulerReleaseTab --
+# This procedure is invoked during button release events that end
+# a tab drag operation. It deselects the tab and deletes the tab if
+# it was dragged out of the ruler.
+#
+# Arguments:
+# c - The canvas widget.
+# x, y - The coordinates of the mouse.
+
+proc rulerReleaseTab c {
+ upvar #0 demo_rulerInfo v
+ if {[$c find withtag active] == {}} {
+ return
+ }
+ if {$v(y) != [expr $v(top)+2]} {
+ $c delete active
+ } else {
+ eval "$c itemconf active $v(normalStyle)"
+ $c dtag active
+ }
+}
diff --git a/tk/library/demos/sayings.tcl b/tk/library/demos/sayings.tcl
new file mode 100644
index 00000000000..b4952c5f293
--- /dev/null
+++ b/tk/library/demos/sayings.tcl
@@ -0,0 +1,46 @@
+# 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}
+toplevel $w
+wm title $w "Listbox Demonstration (well-known sayings)"
+wm iconname $w "sayings"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "The listbox below contains a collection of well-known sayings. You can scan the list using either of the scrollbars or by dragging in the listbox window with button 2 pressed."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.frame -borderwidth 10
+pack $w.frame -side top -expand yes -fill y
+
+
+scrollbar $w.frame.yscroll -command "$w.frame.list yview"
+scrollbar $w.frame.xscroll -orient horizontal \
+ -command "$w.frame.list xview"
+listbox $w.frame.list -width 20 -height 10 -setgrid 1 \
+ -yscroll "$w.frame.yscroll set" -xscroll "$w.frame.xscroll set"
+
+grid $w.frame.list -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
+grid $w.frame.yscroll -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
+grid $w.frame.xscroll -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
+grid rowconfig $w.frame 0 -weight 1 -minsize 0
+grid columnconfig $w.frame 0 -weight 1 -minsize 0
+
+
+$w.frame.list insert 0 "Waste not, want not" "Early to bed and early to rise makes a man healthy, wealthy, and wise" "Ask not what your country can do for you, ask what you can do for your country" "I shall return" "NOT" "A picture is worth a thousand words" "User interfaces are hard to build" "Thou shalt not steal" "A penny for your thoughts" "Fool me once, shame on you; fool me twice, shame on me" "Every cloud has a silver lining" "Where there's smoke there's fire" "It takes one to know one" "Curiosity killed the cat" "Take this job and shove it" "Up a creek without a paddle" "I'm mad as hell and I'm not going to take it any more" "An apple a day keeps the doctor away" "Don't look a gift horse in the mouth"
diff --git a/tk/library/demos/search.tcl b/tk/library/demos/search.tcl
new file mode 100644
index 00000000000..ffefd823364
--- /dev/null
+++ b/tk/library/demos/search.tcl
@@ -0,0 +1,141 @@
+# 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
+# the previous contents of the widget. Tags for the old widget are
+# not affected, however.
+#
+# Arguments:
+# w - The window into which to load the file. Must be a
+# text widget.
+# file - The name of the file to load. Must be readable.
+
+proc textLoadFile {w file} {
+ set f [open $file]
+ $w delete 1.0 end
+ while {![eof $f]} {
+ $w insert end [read $f 10000]
+ }
+ close $f
+}
+
+# textSearch --
+# Search for all instances of a given string in a text widget and
+# apply a given tag to each instance found.
+#
+# Arguments:
+# w - The window in which to search. Must be a text widget.
+# string - The string to search for. The search is done using
+# exact matching only; no special characters.
+# tag - Tag to apply to each instance of a matching string.
+
+proc textSearch {w string tag} {
+ $w tag remove search 0.0 end
+ if {$string == ""} {
+ return
+ }
+ set cur 1.0
+ while 1 {
+ set cur [$w search -count length $string $cur end]
+ if {$cur == ""} {
+ break
+ }
+ $w tag add $tag $cur "$cur + $length char"
+ set cur [$w index "$cur + $length char"]
+ }
+}
+
+# textToggle --
+# This procedure is invoked repeatedly to invoke two commands at
+# periodic intervals. It normally reschedules itself after each
+# execution but if an error occurs (e.g. because the window was
+# deleted) then it doesn't reschedule itself.
+#
+# Arguments:
+# cmd1 - Command to execute when procedure is called.
+# sleep1 - Ms to sleep after executing cmd1 before executing cmd2.
+# cmd2 - Command to execute in the *next* invocation of this
+# procedure.
+# sleep2 - Ms to sleep after executing cmd2 before executing cmd1 again.
+
+proc textToggle {cmd1 sleep1 cmd2 sleep2} {
+ catch {
+ eval $cmd1
+ after $sleep1 [list textToggle $cmd2 $sleep2 $cmd1 $sleep1]
+ }
+}
+
+set w .search
+catch {destroy $w}
+toplevel $w
+wm title $w "Text Demonstration - Search and Highlight"
+wm iconname $w "search"
+positionWindow $w
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.file
+label $w.file.label -text "File name:" -width 13 -anchor w
+entry $w.file.entry -width 40 -textvariable fileName
+button $w.file.button -text "Load File" \
+ -command "textLoadFile $w.text \$fileName"
+pack $w.file.label $w.file.entry -side left
+pack $w.file.button -side left -pady 5 -padx 10
+bind $w.file.entry <Return> "
+ textLoadFile $w.text \$fileName
+ focus $w.string.entry
+"
+focus $w.file.entry
+
+frame $w.string
+label $w.string.label -text "Search string:" -width 13 -anchor w
+entry $w.string.entry -width 40 -textvariable searchString
+button $w.string.button -text "Highlight" \
+ -command "textSearch $w.text \$searchString search"
+pack $w.string.label $w.string.entry -side left
+pack $w.string.button -side left -pady 5 -padx 10
+bind $w.string.entry <Return> "textSearch $w.text \$searchString search"
+
+text $w.text -yscrollcommand "$w.scroll set" -setgrid true
+scrollbar $w.scroll -command "$w.text yview"
+pack $w.file $w.string -side top -fill x
+pack $w.scroll -side right -fill y
+pack $w.text -expand yes -fill both
+
+# Set up display styles for text highlighting.
+
+if {[winfo depth $w] > 1} {
+ textToggle "$w.text tag configure search -background \
+ #ce5555 -foreground white" 800 "$w.text tag configure \
+ search -background {} -foreground {}" 200
+} else {
+ textToggle "$w.text tag configure search -background \
+ black -foreground white" 800 "$w.text tag configure \
+ search -background {} -foreground {}" 200
+}
+$w.text insert 1.0 \
+{This window demonstrates how to use the tagging facilities in text
+widgets to implement a searching mechanism. First, type a file name
+in the top entry, then type <Return> or click on "Load File". Then
+type a string in the lower entry and type <Return> or click on
+"Load File". This will cause all of the instances of the string to
+be tagged with the tag "search", and it will arrange for the tag's
+display attributes to change to make all of the strings blink.}
+$w.text mark set insert 0.0
+
+set fileName ""
+set searchString ""
diff --git a/tk/library/demos/square b/tk/library/demos/square
new file mode 100755
index 00000000000..743016f9ea7
--- /dev/null
+++ b/tk/library/demos/square
@@ -0,0 +1,55 @@
+#!/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}
+bind .s a animate
+focus .s
+
+# The procedure below centers the square on a given position.
+
+proc center {x y} {
+ set a [.s size]
+ .s position [expr $x-($a/2)] [expr $y-($a/2)]
+}
+
+# The procedures below provide a simple form of animation where
+# the box changes size in a pulsing pattern: larger, smaller, larger,
+# and so on.
+
+set inc 0
+proc animate {} {
+ global inc
+ if {$inc == 0} {
+ set inc 3
+ timer
+ } else {
+ set inc 0
+ }
+}
+
+proc timer {} {
+ global inc
+ set s [.s size]
+ if {$inc == 0} return
+ if {$s >= 40} {set inc -3}
+ if {$s <= 10} {set inc 3}
+ .s size [expr {$s+$inc}]
+ after 30 timer
+}
diff --git a/tk/library/demos/states.tcl b/tk/library/demos/states.tcl
new file mode 100644
index 00000000000..23905a2d2b4
--- /dev/null
+++ b/tk/library/demos/states.tcl
@@ -0,0 +1,45 @@
+# 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}
+toplevel $w
+wm title $w "Listbox Demonstration (50 states)"
+wm iconname $w "states"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 4i -justify left -text "A listbox containing the 50 states is displayed below, along with a scrollbar. You can scan the list either using the scrollbar or by scanning. To scan, press button 2 in the widget and drag up or down."
+pack $w.msg -side top
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.frame -borderwidth .5c
+pack $w.frame -side top -expand yes -fill y
+
+scrollbar $w.frame.scroll -command "$w.frame.list yview"
+listbox $w.frame.list -yscroll "$w.frame.scroll set" -setgrid 1 -height 12
+pack $w.frame.scroll -side right -fill y
+pack $w.frame.list -side left -expand 1 -fill both
+
+$w.frame.list insert 0 Alabama Alaska Arizona Arkansas California \
+ Colorado Connecticut Delaware Florida Georgia Hawaii Idaho Illinois \
+ Indiana Iowa Kansas Kentucky Louisiana Maine Maryland \
+ Massachusetts Michigan Minnesota Mississippi Missouri \
+ Montana Nebraska Nevada "New Hampshire" "New Jersey" "New Mexico" \
+ "New York" "North Carolina" "North Dakota" \
+ Ohio Oklahoma Oregon Pennsylvania "Rhode Island" \
+ "South Carolina" "South Dakota" \
+ Tennessee Texas Utah Vermont Virginia Washington \
+ "West Virginia" Wisconsin Wyoming
diff --git a/tk/library/demos/style.tcl b/tk/library/demos/style.tcl
new file mode 100644
index 00000000000..6ed31f8004b
--- /dev/null
+++ b/tk/library/demos/style.tcl
@@ -0,0 +1,152 @@
+# 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}
+toplevel $w
+wm title $w "Text Demonstration - Display Styles"
+wm iconname $w "style"
+positionWindow $w
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+text $w.text -yscrollcommand "$w.scroll set" -setgrid true \
+ -width 70 -height 32 -wrap word
+scrollbar $w.scroll -command "$w.text yview"
+pack $w.scroll -side right -fill y
+pack $w.text -expand yes -fill both
+
+# Set up display styles
+
+$w.text tag configure bold -font {Courier 12 bold italic}
+$w.text tag configure big -font {Courier 14 bold}
+$w.text tag configure verybig -font {Helvetica 24 bold}
+if {[winfo depth $w] > 1} {
+ $w.text tag configure color1 -background #a0b7ce
+ $w.text tag configure color2 -foreground red
+ $w.text tag configure raised -relief raised -borderwidth 1
+ $w.text tag configure sunken -relief sunken -borderwidth 1
+} else {
+ $w.text tag configure color1 -background black -foreground white
+ $w.text tag configure color2 -background black -foreground white
+ $w.text tag configure raised -background white -relief raised \
+ -borderwidth 1
+ $w.text tag configure sunken -background white -relief sunken \
+ -borderwidth 1
+}
+$w.text tag configure bgstipple -background black -borderwidth 0 \
+ -bgstipple gray12
+$w.text tag configure fgstipple -fgstipple gray50
+$w.text tag configure underline -underline on
+$w.text tag configure overstrike -overstrike on
+$w.text tag configure right -justify right
+$w.text tag configure center -justify center
+$w.text tag configure super -offset 4p -font {Courier 10}
+$w.text tag configure sub -offset -2p -font {Courier 10}
+$w.text tag configure margins -lmargin1 12m -lmargin2 6m -rmargin 10m
+$w.text tag configure spacing -spacing1 10p -spacing2 2p \
+ -lmargin1 12m -lmargin2 6m -rmargin 10m
+
+$w.text insert end {Text widgets like this one allow you to display information in a
+variety of styles. Display styles are controlled using a mechanism
+called }
+$w.text insert end tags bold
+$w.text insert end {. Tags are just textual names that you can apply to one
+or more ranges of characters within a text widget. You can configure
+tags with various display styles. If you do this, then the tagged
+characters will be displayed with the styles you chose. The
+available display styles are:
+}
+$w.text insert end "\n1. Font." big
+$w.text insert end " You can choose any X font, "
+$w.text insert end large verybig
+$w.text insert end " or "
+$w.text insert end "small.\n"
+$w.text insert end "\n2. Color." big
+$w.text insert end " You can change either the "
+$w.text insert end background color1
+$w.text insert end " or "
+$w.text insert end foreground color2
+$w.text insert end "\ncolor, or "
+$w.text insert end both {color1 color2}
+$w.text insert end ".\n"
+$w.text insert end "\n3. Stippling." big
+$w.text insert end " You can cause either the "
+$w.text insert end background bgstipple
+$w.text insert end " or "
+$w.text insert end foreground fgstipple
+$w.text insert end {
+information to be drawn with a stipple fill instead of a solid fill.
+}
+$w.text insert end "\n4. Underlining." big
+$w.text insert end " You can "
+$w.text insert end underline underline
+$w.text insert end " ranges of text.\n"
+$w.text insert end "\n5. Overstrikes." big
+$w.text insert end " You can "
+$w.text insert end "draw lines through" overstrike
+$w.text insert end " ranges of text.\n"
+$w.text insert end "\n6. 3-D effects." big
+$w.text insert end { You can arrange for the background to be drawn
+with a border that makes characters appear either }
+$w.text insert end raised raised
+$w.text insert end " or "
+$w.text insert end sunken sunken
+$w.text insert end ".\n"
+$w.text insert end "\n7. Justification." big
+$w.text insert end " You can arrange for lines to be displayed\n"
+$w.text insert end "left-justified,\n"
+$w.text insert end "right-justified, or\n" right
+$w.text insert end "centered.\n" center
+$w.text insert end "\n8. Superscripts and subscripts." big
+$w.text insert end " You can control the vertical\n"
+$w.text insert end "position of text to generate superscript effects like 10"
+$w.text insert end "n" super
+$w.text insert end " or\nsubscript effects like X"
+$w.text insert end "i" sub
+$w.text insert end ".\n"
+$w.text insert end "\n9. Margins." big
+$w.text insert end " You can control the amount of extra space left"
+$w.text insert end " on\neach side of the text:\n"
+$w.text insert end "This paragraph is an example of the use of " margins
+$w.text insert end "margins. It consists of a single line of text " margins
+$w.text insert end "that wraps around on the screen. There are two " margins
+$w.text insert end "separate left margin values, one for the first " margins
+$w.text insert end "display line associated with the text line, " margins
+$w.text insert end "and one for the subsequent display lines, which " margins
+$w.text insert end "occur because of wrapping. There is also a " margins
+$w.text insert end "separate specification for the right margin, " margins
+$w.text insert end "which is used to choose wrap points for lines.\n" margins
+$w.text insert end "\n10. Spacing." big
+$w.text insert end " You can control the spacing of lines with three\n"
+$w.text insert end "separate parameters. \"Spacing1\" tells how much "
+$w.text insert end "extra space to leave\nabove a line, \"spacing3\" "
+$w.text insert end "tells how much space to leave below a line,\nand "
+$w.text insert end "if a text line wraps, \"spacing2\" tells how much "
+$w.text insert end "space to leave\nbetween the display lines that "
+$w.text insert end "make up the text line.\n"
+$w.text insert end "These indented paragraphs illustrate how spacing " spacing
+$w.text insert end "can be used. Each paragraph is actually a " spacing
+$w.text insert end "single line in the text widget, which is " spacing
+$w.text insert end "word-wrapped by the widget.\n" spacing
+$w.text insert end "Spacing1 is set to 10 points for this text, " spacing
+$w.text insert end "which results in relatively large gaps between " spacing
+$w.text insert end "the paragraphs. Spacing2 is set to 2 points, " spacing
+$w.text insert end "which results in just a bit of extra space " spacing
+$w.text insert end "within a pararaph. Spacing3 isn't used " spacing
+$w.text insert end "in this example.\n" spacing
+$w.text insert end "To see where the space is, select ranges of " spacing
+$w.text insert end "text within these paragraphs. The selection " spacing
+$w.text insert end "highlight will cover the extra space." spacing
diff --git a/tk/library/demos/tclIndex b/tk/library/demos/tclIndex
new file mode 100644
index 00000000000..86a72e2443e
--- /dev/null
+++ b/tk/library/demos/tclIndex
@@ -0,0 +1,67 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(arrowSetup) [list source [file join $dir arrow.tcl]]
+set auto_index(arrowMove1) [list source [file join $dir arrow.tcl]]
+set auto_index(arrowMove2) [list source [file join $dir arrow.tcl]]
+set auto_index(arrowMove3) [list source [file join $dir arrow.tcl]]
+set auto_index(textLoadFile) [list source [file join $dir search.tcl]]
+set auto_index(textSearch) [list source [file join $dir search.tcl]]
+set auto_index(textToggle) [list source [file join $dir search.tcl]]
+set auto_index(itemEnter) [list source [file join $dir items.tcl]]
+set auto_index(itemLeave) [list source [file join $dir items.tcl]]
+set auto_index(itemMark) [list source [file join $dir items.tcl]]
+set auto_index(itemStroke) [list source [file join $dir items.tcl]]
+set auto_index(itemsUnderArea) [list source [file join $dir items.tcl]]
+set auto_index(itemStartDrag) [list source [file join $dir items.tcl]]
+set auto_index(itemDrag) [list source [file join $dir items.tcl]]
+set auto_index(butPress) [list source [file join $dir items.tcl]]
+set auto_index(loadDir) [list source [file join $dir image2.tcl]]
+set auto_index(loadImage) [list source [file join $dir image2.tcl]]
+set auto_index(rulerMkTab) [list source [file join $dir ruler.tcl]]
+set auto_index(rulerNewTab) [list source [file join $dir ruler.tcl]]
+set auto_index(rulerSelectTab) [list source [file join $dir ruler.tcl]]
+set auto_index(rulerMoveTab) [list source [file join $dir ruler.tcl]]
+set auto_index(rulerReleaseTab) [list source [file join $dir ruler.tcl]]
+set auto_index(mkTextConfig) [list source [file join $dir ctext.tcl]]
+set auto_index(textEnter) [list source [file join $dir ctext.tcl]]
+set auto_index(textInsert) [list source [file join $dir ctext.tcl]]
+set auto_index(textPaste) [list source [file join $dir ctext.tcl]]
+set auto_index(textB1Press) [list source [file join $dir ctext.tcl]]
+set auto_index(textB1Move) [list source [file join $dir ctext.tcl]]
+set auto_index(textBs) [list source [file join $dir ctext.tcl]]
+set auto_index(textDel) [list source [file join $dir ctext.tcl]]
+set auto_index(bitmapRow) [list source [file join $dir bitmap.tcl]]
+set auto_index(scrollEnter) [list source [file join $dir cscroll.tcl]]
+set auto_index(scrollLeave) [list source [file join $dir cscroll.tcl]]
+set auto_index(scrollButton) [list source [file join $dir cscroll.tcl]]
+set auto_index(textWindOn) [list source [file join $dir twind.tcl]]
+set auto_index(textWindOff) [list source [file join $dir twind.tcl]]
+set auto_index(textWindPlot) [list source [file join $dir twind.tcl]]
+set auto_index(embPlotDown) [list source [file join $dir twind.tcl]]
+set auto_index(embPlotMove) [list source [file join $dir twind.tcl]]
+set auto_index(textWindDel) [list source [file join $dir twind.tcl]]
+set auto_index(embDefBg) [list source [file join $dir twind.tcl]]
+set auto_index(floorDisplay) [list source [file join $dir floor.tcl]]
+set auto_index(newRoom) [list source [file join $dir floor.tcl]]
+set auto_index(roomChanged) [list source [file join $dir floor.tcl]]
+set auto_index(bg1) [list source [file join $dir floor.tcl]]
+set auto_index(bg2) [list source [file join $dir floor.tcl]]
+set auto_index(bg3) [list source [file join $dir floor.tcl]]
+set auto_index(fg1) [list source [file join $dir floor.tcl]]
+set auto_index(fg2) [list source [file join $dir floor.tcl]]
+set auto_index(fg3) [list source [file join $dir floor.tcl]]
+set auto_index(setWidth) [list source [file join $dir hscale.tcl]]
+set auto_index(plotDown) [list source [file join $dir plot.tcl]]
+set auto_index(plotMove) [list source [file join $dir plot.tcl]]
+set auto_index(puzzleSwitch) [list source [file join $dir puzzle.tcl]]
+set auto_index(setHeight) [list source [file join $dir vscale.tcl]]
+set auto_index(showMessageBox) [list source [file join $dir msgbox.tcl]]
+set auto_index(setColor) [list source [file join $dir clrpick.tcl]]
+set auto_index(setColor_helper) [list source [file join $dir clrpick.tcl]]
+set auto_index(fileDialog) [list source [file join $dir filebox.tcl]]
diff --git a/tk/library/demos/tcolor b/tk/library/demos/tcolor
new file mode 100755
index 00000000000..50c0e6893a0
--- /dev/null
+++ b/tk/library/demos/tcolor
@@ -0,0 +1,358 @@
+#!/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".
+# label1, label2, label3 - Labels for the scales.
+# red, green, blue - Current color intensities in decimal
+# on a scale of 0-65535.
+# color - A string giving the current color value
+# in the proper form for x:
+# #RRRRGGGGBBBB
+# updating - Non-zero means that we're in the middle of
+# updating the scales to load a new color,so
+# information shouldn't be propagating back
+# from the scales to other elements of the
+# program: this would make an infinite loop.
+# command - Holds the command that has been typed
+# into the "Command" entry.
+# autoUpdate - 1 means execute the update command
+# automatically whenever the color changes.
+# name - Name for new color, typed into entry.
+
+set colorSpace hsb
+set red 65535
+set green 0
+set blue 0
+set color #ffff00000000
+set updating 0
+set autoUpdate 1
+set name ""
+
+# Create the menu bar at the top of the window.
+
+frame .menu -relief raised -borderwidth 2
+pack .menu -side top -fill x
+menubutton .menu.file -text File -menu .menu.file.m -underline 0
+menu .menu.file.m
+.menu.file.m add radio -label "RGB color space" -variable colorSpace \
+ -value rgb -underline 0 -command {changeColorSpace rgb}
+.menu.file.m add radio -label "CMY color space" -variable colorSpace \
+ -value cmy -underline 0 -command {changeColorSpace cmy}
+.menu.file.m add radio -label "HSB color space" -variable colorSpace \
+ -value hsb -underline 0 -command {changeColorSpace hsb}
+.menu.file.m add separator
+.menu.file.m add radio -label "Automatic updates" -variable autoUpdate \
+ -value 1 -underline 0
+.menu.file.m add radio -label "Manual updates" -variable autoUpdate \
+ -value 0 -underline 0
+.menu.file.m add separator
+.menu.file.m add command -label "Exit program" -underline 0 \
+ -command "destroy ."
+pack .menu.file -side left
+
+# Create the command entry window at the bottom of the window, along
+# with the update button.
+
+frame .bot -relief raised -borderwidth 2
+pack .bot -side bottom -fill x
+label .commandLabel -text "Command:"
+entry .command -relief sunken -borderwidth 2 -textvariable command \
+ -font {Courier 12}
+button .update -text Update -command doUpdate
+pack .commandLabel -in .bot -side left
+pack .update -in .bot -side right -pady .1c -padx .25c
+pack .command -in .bot -expand yes -fill x -ipadx 0.25c
+
+# Create the listbox that holds all of the color names in rgb.txt,
+# if an rgb.txt file can be found.
+
+frame .middle -relief raised -borderwidth 2
+pack .middle -side top -fill both
+foreach i {/usr/local/lib/X11/rgb.txt /usr/lib/X11/rgb.txt
+ /X11/R5/lib/X11/rgb.txt /X11/R4/lib/rgb/rgb.txt
+ /usr/openwin/lib/X11/rgb.txt} {
+ if ![file readable $i] {
+ continue;
+ }
+ set f [open $i]
+ frame .middle.left
+ pack .middle.left -side left -padx .25c -pady .25c
+ listbox .names -width 20 -height 12 -yscrollcommand ".scroll set" \
+ -relief sunken -borderwidth 2 -exportselection false
+ bind .names <Double-1> {
+ tc_loadNamedColor [.names get [.names curselection]]
+ }
+ scrollbar .scroll -orient vertical -command ".names yview" \
+ -relief sunken -borderwidth 2
+ pack .names -in .middle.left -side left
+ pack .scroll -in .middle.left -side right -fill y
+ while {[gets $f line] >= 0} {
+ if {[llength $line] == 4} {
+ .names insert end [lindex $line 3]
+ }
+ }
+ close $f
+ break
+}
+
+# Create the three scales for editing the color, and the entry for
+# typing in a color value.
+
+frame .middle.middle
+pack .middle.middle -side left -expand yes -fill y
+frame .middle.middle.1
+frame .middle.middle.2
+frame .middle.middle.3
+frame .middle.middle.4
+pack .middle.middle.1 .middle.middle.2 .middle.middle.3 -side top -expand yes
+pack .middle.middle.4 -side top -expand yes -fill x
+foreach i {1 2 3} {
+ label .label$i -textvariable label$i
+ scale .scale$i -from 0 -to 1000 -length 6c -orient horizontal \
+ -command tc_scaleChanged
+ pack .scale$i .label$i -in .middle.middle.$i -side top -anchor w
+}
+label .nameLabel -text "Name:"
+entry .name -relief sunken -borderwidth 2 -textvariable name -width 10 \
+ -font {Courier 12}
+pack .nameLabel -in .middle.middle.4 -side left
+pack .name -in .middle.middle.4 -side right -expand 1 -fill x
+bind .name <Return> {tc_loadNamedColor $name}
+
+# Create the color display swatch on the right side of the window.
+
+frame .middle.right
+pack .middle.right -side left -pady .25c -padx .25c -anchor s
+frame .swatch -width 2c -height 5c -background $color
+label .value -textvariable color -width 13 -font {Courier 12}
+pack .swatch -in .middle.right -side top -expand yes -fill both
+pack .value -in .middle.right -side bottom -pady .25c
+
+# The procedure below is invoked when one of the scales is adjusted.
+# It propagates color information from the current scale readings
+# to everywhere else that it is used.
+
+proc tc_scaleChanged args {
+ global red green blue colorSpace color updating autoUpdate
+ if $updating {
+ return
+ }
+ if {$colorSpace == "rgb"} {
+ set red [format %.0f [expr [.scale1 get]*65.535]]
+ set green [format %.0f [expr [.scale2 get]*65.535]]
+ set blue [format %.0f [expr [.scale3 get]*65.535]]
+ } else {
+ if {$colorSpace == "cmy"} {
+ set red [format %.0f [expr {65535 - [.scale1 get]*65.535}]]
+ set green [format %.0f [expr {65535 - [.scale2 get]*65.535}]]
+ set blue [format %.0f [expr {65535 - [.scale3 get]*65.535}]]
+ } else {
+ set list [hsbToRgb [expr {[.scale1 get]/1000.0}] \
+ [expr {[.scale2 get]/1000.0}] \
+ [expr {[.scale3 get]/1000.0}]]
+ set red [lindex $list 0]
+ set green [lindex $list 1]
+ set blue [lindex $list 2]
+ }
+ }
+ set color [format "#%04x%04x%04x" $red $green $blue]
+ .swatch config -bg $color
+ if $autoUpdate doUpdate
+ update idletasks
+}
+
+# The procedure below is invoked to update the scales from the
+# current red, green, and blue intensities. It's invoked after
+# a change in the color space and after a named color value has
+# been loaded.
+
+proc tc_setScales {} {
+ global red green blue colorSpace updating
+ set updating 1
+ if {$colorSpace == "rgb"} {
+ .scale1 set [format %.0f [expr $red/65.535]]
+ .scale2 set [format %.0f [expr $green/65.535]]
+ .scale3 set [format %.0f [expr $blue/65.535]]
+ } else {
+ if {$colorSpace == "cmy"} {
+ .scale1 set [format %.0f [expr (65535-$red)/65.535]]
+ .scale2 set [format %.0f [expr (65535-$green)/65.535]]
+ .scale3 set [format %.0f [expr (65535-$blue)/65.535]]
+ } else {
+ set list [rgbToHsv $red $green $blue]
+ .scale1 set [format %.0f [expr {[lindex $list 0] * 1000.0}]]
+ .scale2 set [format %.0f [expr {[lindex $list 1] * 1000.0}]]
+ .scale3 set [format %.0f [expr {[lindex $list 2] * 1000.0}]]
+ }
+ }
+ set updating 0
+}
+
+# The procedure below is invoked when a named color has been
+# selected from the listbox or typed into the entry. It loads
+# the color into the editor.
+
+proc tc_loadNamedColor name {
+ global red green blue color autoUpdate
+
+ if {[string index $name 0] != "#"} {
+ set list [winfo rgb .swatch $name]
+ set red [lindex $list 0]
+ set green [lindex $list 1]
+ set blue [lindex $list 2]
+ } else {
+ case [string length $name] {
+ 4 {set format "#%1x%1x%1x"; set shift 12}
+ 7 {set format "#%2x%2x%2x"; set shift 8}
+ 10 {set format "#%3x%3x%3x"; set shift 4}
+ 13 {set format "#%4x%4x%4x"; set shift 0}
+ default {error "syntax error in color name \"$name\""}
+ }
+ if {[scan $name $format red green blue] != 3} {
+ error "syntax error in color name \"$name\""
+ }
+ set red [expr $red<<$shift]
+ set green [expr $green<<$shift]
+ set blue [expr $blue<<$shift]
+ }
+ tc_setScales
+ set color [format "#%04x%04x%04x" $red $green $blue]
+ .swatch config -bg $color
+ if $autoUpdate doUpdate
+}
+
+# The procedure below is invoked when a new color space is selected.
+# It changes the labels on the scales and re-loads the scales with
+# the appropriate values for the current color in the new color space
+
+proc changeColorSpace space {
+ global label1 label2 label3
+ if {$space == "rgb"} {
+ set label1 Red
+ set label2 Green
+ set label3 Blue
+ tc_setScales
+ return
+ }
+ if {$space == "cmy"} {
+ set label1 Cyan
+ set label2 Magenta
+ set label3 Yellow
+ tc_setScales
+ return
+ }
+ if {$space == "hsb"} {
+ set label1 Hue
+ set label2 Saturation
+ set label3 Brightness
+ tc_setScales
+ return
+ }
+}
+
+# The procedure below converts an RGB value to HSB. It takes red, green,
+# and blue components (0-65535) as arguments, and returns a list containing
+# HSB components (floating-point, 0-1) as result. The code here is a copy
+# of the code on page 615 of "Fundamentals of Interactive Computer Graphics"
+# by Foley and Van Dam.
+
+proc rgbToHsv {red green blue} {
+ if {$red > $green} {
+ set max $red.0
+ set min $green.0
+ } else {
+ set max $green.0
+ set min $red.0
+ }
+ if {$blue > $max} {
+ set max $blue.0
+ } else {
+ if {$blue < $min} {
+ set min $blue.0
+ }
+ }
+ set range [expr $max-$min]
+ if {$max == 0} {
+ set sat 0
+ } else {
+ set sat [expr {($max-$min)/$max}]
+ }
+ if {$sat == 0} {
+ set hue 0
+ } else {
+ set rc [expr {($max - $red)/$range}]
+ set gc [expr {($max - $green)/$range}]
+ set bc [expr {($max - $blue)/$range}]
+ if {$red == $max} {
+ set hue [expr {.166667*($bc - $gc)}]
+ } else {
+ if {$green == $max} {
+ set hue [expr {.166667*(2 + $rc - $bc)}]
+ } else {
+ set hue [expr {.166667*(4 + $gc - $rc)}]
+ }
+ }
+ if {$hue < 0.0} {
+ set hue [expr $hue + 1.0]
+ }
+ }
+ return [list $hue $sat [expr {$max/65535}]]
+}
+
+# The procedure below converts an HSB value to RGB. It takes hue, saturation,
+# and value components (floating-point, 0-1.0) as arguments, and returns a
+# list containing RGB components (integers, 0-65535) as result. The code
+# here is a copy of the code on page 616 of "Fundamentals of Interactive
+# Computer Graphics" by Foley and Van Dam.
+
+proc hsbToRgb {hue sat value} {
+ set v [format %.0f [expr 65535.0*$value]]
+ if {$sat == 0} {
+ return "$v $v $v"
+ } else {
+ set hue [expr $hue*6.0]
+ if {$hue >= 6.0} {
+ set hue 0.0
+ }
+ scan $hue. %d i
+ set f [expr $hue-$i]
+ set p [format %.0f [expr {65535.0*$value*(1 - $sat)}]]
+ set q [format %.0f [expr {65535.0*$value*(1 - ($sat*$f))}]]
+ set t [format %.0f [expr {65535.0*$value*(1 - ($sat*(1 - $f)))}]]
+ case $i \
+ 0 {return "$v $t $p"} \
+ 1 {return "$q $v $p"} \
+ 2 {return "$p $v $t"} \
+ 3 {return "$p $q $v"} \
+ 4 {return "$t $p $v"} \
+ 5 {return "$v $p $q"}
+ error "i value $i is out of range"
+ }
+}
+
+# The procedure below is invoked when the "Update" button is pressed,
+# and whenever the color changes if update mode is enabled. It
+# propagates color information as determined by the command in the
+# Command entry.
+
+proc doUpdate {} {
+ global color command
+ set newCmd $command
+ regsub -all %% $command $color newCmd
+ eval $newCmd
+}
+
+changeColorSpace hsb
diff --git a/tk/library/demos/text.tcl b/tk/library/demos/text.tcl
new file mode 100644
index 00000000000..97df78021f5
--- /dev/null
+++ b/tk/library/demos/text.tcl
@@ -0,0 +1,76 @@
+# 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}
+toplevel $w
+wm title $w "Text Demonstration - Basic Facilities"
+wm iconname $w "text"
+positionWindow $w
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+text $w.text -relief sunken -bd 2 -yscrollcommand "$w.scroll set" -setgrid 1 \
+ -height 30
+scrollbar $w.scroll -command "$w.text yview"
+pack $w.scroll -side right -fill y
+pack $w.text -expand yes -fill both
+$w.text insert 0.0 \
+{This window is a text widget. It displays one or more lines of text
+and allows you to edit the text. Here is a summary of the things you
+can do to a text widget:
+
+1. Scrolling. Use the scrollbar to adjust the view in the text window.
+
+2. Scanning. Press mouse button 2 in the text window and drag up or down.
+This will drag the text at high speed to allow you to scan its contents.
+
+3. Insert text. Press mouse button 1 to set the insertion cursor, then
+type text. What you type will be added to the widget.
+
+4. Select. Press mouse button 1 and drag to select a range of characters.
+Once you've released the button, you can adjust the selection by pressing
+button 1 with the shift key down. This will reset the end of the
+selection nearest the mouse cursor and you can drag that end of the
+selection by dragging the mouse before releasing the mouse button.
+You can double-click to select whole words or triple-click to select
+whole lines.
+
+5. Delete and replace. To delete text, select the characters you'd like
+to delete and type Backspace or Delete. Alternatively, you can type new
+text, in which case it will replace the selected text.
+
+6. Copy the selection. To copy the selection into this window, select
+what you want to copy (either here or in another application), then
+click button 2 to copy the selection to the point of the mouse cursor.
+
+7. Edit. Text widgets support the standard Motif editing characters
+plus many Emacs editing characters. Backspace and Control-h erase the
+character to the left of the insertion cursor. Delete and Control-d
+erase the character to the right of the insertion cursor. Meta-backspace
+deletes the word to the left of the insertion cursor, and Meta-d deletes
+the word to the right of the insertion cursor. Control-k deletes from
+the insertion cursor to the end of the line, or it deletes the newline
+character if that is the only thing left on the line. Control-o opens
+a new line by inserting a newline character to the right of the insertion
+cursor. Control-t transposes the two characters on either side of the
+insertion cursor.
+
+7. Resize the window. This widget has been configured with the "setGrid"
+option on, so that if you resize the window it will always resize to an
+even number of characters high and wide. Also, if you make the window
+narrow you can see that long lines automatically wrap around onto
+additional lines so that all the information is always visible.}
+$w.text mark set insert 0.0
diff --git a/tk/library/demos/timer b/tk/library/demos/timer
new file mode 100755
index 00000000000..b2edd114786
--- /dev/null
+++ b/tk/library/demos/timer
@@ -0,0 +1,40 @@
+#!/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
+ }
+}
+button .stop -text Stop -command {set stopped 1}
+pack .counter -side bottom -fill both
+pack .start -side left -fill both -expand yes
+pack .stop -side right -fill both -expand yes
+
+set seconds 0
+set hundredths 0
+set stopped 1
+
+proc tick {} {
+ global seconds hundredths stopped
+ if $stopped return
+ after 50 tick
+ set hundredths [expr $hundredths+5]
+ if {$hundredths >= 100} {
+ set hundredths 0
+ set seconds [expr $seconds+1]
+ }
+ .counter config -text [format "%d.%02d" $seconds $hundredths]
+}
+
+bind . <Control-c> {destroy .}
+bind . <Control-q> {destroy .}
+focus .
diff --git a/tk/library/demos/twind.tcl b/tk/library/demos/twind.tcl
new file mode 100644
index 00000000000..75e732c6ac6
--- /dev/null
+++ b/tk/library/demos/twind.tcl
@@ -0,0 +1,196 @@
+# 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}
+toplevel $w
+wm title $w "Text Demonstration - Embedded Windows"
+wm iconname $w "Embedded Windows"
+positionWindow $w
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.f -highlightthickness 2 -borderwidth 2 -relief sunken
+set t $w.f.text
+text $t -yscrollcommand "$w.scroll set" -setgrid true -font $font -width 70 \
+ -height 35 -wrap word -highlightthickness 0 -borderwidth 0
+pack $t -expand yes -fill both
+scrollbar $w.scroll -command "$t yview"
+pack $w.scroll -side right -fill y
+pack $w.f -expand yes -fill both
+$t tag configure center -justify center -spacing1 5m -spacing3 5m
+$t tag configure buttons -lmargin1 1c -lmargin2 1c -rmargin 1c \
+ -spacing1 3m -spacing2 0 -spacing3 0
+
+button $t.on -text "Turn On" -command "textWindOn $w" \
+ -cursor top_left_arrow
+button $t.off -text "Turn Off" -command "textWindOff $w" \
+ -cursor top_left_arrow
+button $t.click -text "Click Here" -command "textWindPlot $t" \
+ -cursor top_left_arrow
+button $t.delete -text "Delete" -command "textWindDel $w" \
+ -cursor top_left_arrow
+
+$t insert end "A text widget can contain other widgets embedded "
+$t insert end "it. These are called \"embedded windows\", "
+$t insert end "and they can consist of arbitrary widgets. "
+$t insert end "For example, here are two embedded button "
+$t insert end "widgets. You can click on the first button to "
+$t window create end -window $t.on
+$t insert end " horizontal scrolling, which also turns off "
+$t insert end "word wrapping. Or, you can click on the second "
+$t insert end "button to\n"
+$t window create end -window $t.off
+$t insert end " horizontal scrolling and turn back on word wrapping.\n\n"
+
+$t insert end "Or, here is another example. If you "
+$t window create end -window $t.click
+$t insert end " a canvas displaying an x-y plot will appear right here."
+$t mark set plot insert
+$t mark gravity plot left
+$t insert end " You can drag the data points around with the mouse, "
+$t insert end "or you can click here to "
+$t window create end -window $t.delete
+$t insert end " the plot again.\n\n"
+
+$t insert end "You may also find it useful to put embedded windows in "
+$t insert end "a text without any actual text. In this case the "
+$t insert end "text widget acts like a geometry manager. For "
+$t insert end "example, here is a collection of buttons laid out "
+$t insert end "neatly into rows by the text widget. These buttons "
+$t insert end "can be used to change the background color of the "
+$t insert end "text widget (\"Default\" restores the color to "
+$t insert end "its default). If you click on the button labeled "
+$t insert end "\"Short\", it changes to a longer string so that "
+$t insert end "you can see how the text widget automatically "
+$t insert end "changes the layout. Click on the button again "
+$t insert end "to restore the short string.\n"
+
+button $t.default -text Default -command "embDefBg $t" \
+ -cursor top_left_arrow
+$t window create end -window $t.default -padx 3
+global embToggle
+set embToggle Short
+checkbutton $t.toggle -textvariable embToggle -indicatoron 0 \
+ -variable embToggle -onvalue "A much longer string" \
+ -offvalue "Short" -cursor top_left_arrow -pady 5 -padx 2
+$t window create end -window $t.toggle -padx 3 -pady 2
+set i 1
+foreach color {AntiqueWhite3 Bisque1 Bisque2 Bisque3 Bisque4
+ SlateBlue3 RoyalBlue1 SteelBlue2 DeepSkyBlue3 LightBlue1
+ DarkSlateGray1 Aquamarine2 DarkSeaGreen2 SeaGreen1
+ Yellow1 IndianRed1 IndianRed2 Tan1 Tan4} {
+ button $t.color$i -text $color -cursor top_left_arrow -command \
+ "$t configure -bg $color"
+ $t window create end -window $t.color$i -padx 3 -pady 2
+ incr i
+}
+$t tag add buttons $t.default end
+
+proc textWindOn w {
+ catch {destroy $w.scroll2}
+ set t $w.f.text
+ scrollbar $w.scroll2 -orient horizontal -command "$t xview"
+ pack $w.scroll2 -after $w.buttons -side bottom -fill x
+ $t configure -xscrollcommand "$w.scroll2 set" -wrap none
+}
+
+proc textWindOff w {
+ catch {destroy $w.scroll2}
+ set t $w.f.text
+ $t configure -xscrollcommand {} -wrap word
+}
+
+proc textWindPlot t {
+ set c $t.c
+ if [winfo exists $c] {
+ return
+ }
+ canvas $c -relief sunken -width 450 -height 300 -cursor top_left_arrow
+
+ set font {Helvetica 18}
+
+ $c create line 100 250 400 250 -width 2
+ $c create line 100 250 100 50 -width 2
+ $c create text 225 20 -text "A Simple Plot" -font $font -fill brown
+
+ for {set i 0} {$i <= 10} {incr i} {
+ set x [expr {100 + ($i*30)}]
+ $c create line $x 250 $x 245 -width 2
+ $c create text $x 254 -text [expr 10*$i] -anchor n -font $font
+ }
+ for {set i 0} {$i <= 5} {incr i} {
+ set y [expr {250 - ($i*40)}]
+ $c create line 100 $y 105 $y -width 2
+ $c create text 96 $y -text [expr $i*50].0 -anchor e -font $font
+ }
+
+ foreach point {{12 56} {20 94} {33 98} {32 120} {61 180}
+ {75 160} {98 223}} {
+ set x [expr {100 + (3*[lindex $point 0])}]
+ set y [expr {250 - (4*[lindex $point 1])/5}]
+ set item [$c create oval [expr $x-6] [expr $y-6] \
+ [expr $x+6] [expr $y+6] -width 1 -outline black \
+ -fill SkyBlue2]
+ $c addtag point withtag $item
+ }
+
+ $c bind point <Any-Enter> "$c itemconfig current -fill red"
+ $c bind point <Any-Leave> "$c itemconfig current -fill SkyBlue2"
+ $c bind point <1> "embPlotDown $c %x %y"
+ $c bind point <ButtonRelease-1> "$c dtag selected"
+ bind $c <B1-Motion> "embPlotMove $c %x %y"
+ while {[string first [$t get plot] " \t\n"] >= 0} {
+ $t delete plot
+ }
+ $t insert plot "\n"
+ $t window create plot -window $c
+ $t tag add center plot
+ $t insert plot "\n"
+}
+
+set embPlot(lastX) 0
+set embPlot(lastY) 0
+
+proc embPlotDown {w x y} {
+ global embPlot
+ $w dtag selected
+ $w addtag selected withtag current
+ $w raise current
+ set embPlot(lastX) $x
+ set embPlot(lastY) $y
+}
+
+proc embPlotMove {w x y} {
+ global embPlot
+ $w move selected [expr $x-$embPlot(lastX)] [expr $y-$embPlot(lastY)]
+ set embPlot(lastX) $x
+ set embPlot(lastY) $y
+}
+
+proc textWindDel w {
+ set t $w.f.text
+ if [winfo exists $t.c] {
+ $t delete $t.c
+ while {[string first [$t get plot] " \t\n"] >= 0} {
+ $t delete plot
+ }
+ $t insert plot " "
+ }
+}
+
+proc embDefBg t {
+ $t configure -background [lindex [$t configure -background] 3]
+}
diff --git a/tk/library/demos/vscale.tcl b/tk/library/demos/vscale.tcl
new file mode 100644
index 00000000000..ed78ac09347
--- /dev/null
+++ b/tk/library/demos/vscale.tcl
@@ -0,0 +1,48 @@
+# 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}
+toplevel $w
+wm title $w "Vertical Scale Demonstration"
+wm iconname $w "vscale"
+positionWindow $w
+
+label $w.msg -font $font -wraplength 3.5i -justify left -text "An arrow and a vertical scale are displayed below. If you click or drag mouse button 1 in the scale, you can change the size of the arrow."
+pack $w.msg -side top -padx .5c
+
+frame $w.buttons
+pack $w.buttons -side bottom -fill x -pady 2m
+button $w.buttons.dismiss -text Dismiss -command "destroy $w"
+button $w.buttons.code -text "See Code" -command "showCode $w"
+pack $w.buttons.dismiss $w.buttons.code -side left -expand 1
+
+frame $w.frame -borderwidth 10
+pack $w.frame
+
+scale $w.frame.scale -orient vertical -length 284 -from 0 -to 250 \
+ -command "setHeight $w.frame.canvas" -tickinterval 50
+canvas $w.frame.canvas -width 50 -height 50 -bd 0 -highlightthickness 0
+$w.frame.canvas create polygon 0 0 1 1 2 2 -fill SeaGreen3 -tags poly
+$w.frame.canvas create line 0 0 1 1 2 2 0 0 -fill black -tags line
+frame $w.frame.right -borderwidth 15
+pack $w.frame.scale -side left -anchor ne
+pack $w.frame.canvas -side left -anchor nw -fill y
+$w.frame.scale set 75
+
+proc setHeight {w height} {
+ incr height 21
+ set y2 [expr $height - 30]
+ if {$y2 < 21} {
+ set y2 21
+ }
+ $w coords poly 15 20 35 20 35 $y2 45 $y2 25 $height 5 $y2 15 $y2 15 20
+ $w coords line 15 20 35 20 35 $y2 45 $y2 25 $height 5 $y2 15 $y2 15 20
+}
diff --git a/tk/library/demos/widget b/tk/library/demos/widget
new file mode 100755
index 00000000000..05c89cdd2d1
--- /dev/null
+++ b/tk/library/demos/widget
@@ -0,0 +1,391 @@
+#!/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
+# and a text widget that explains how to use the program, plus lists
+# all of the demos as hypertext items.
+#----------------------------------------------------------------
+
+set font {Helvetica 14}
+menu .menuBar -tearoff 0
+.menuBar add cascade -menu .menuBar.file -label "File" -underline 0
+menu .menuBar.file -tearoff 0
+
+# On the Mac use the specia .apple menu for the about item
+if {$tcl_platform(platform) == "macintosh"} {
+ .menuBar add cascade -menu .menuBar.apple
+ menu .menuBar.apple -tearoff 0
+ .menuBar.apple add command -label "About..." -command "aboutBox"
+} else {
+ .menuBar.file add command -label "About..." -command "aboutBox" \
+ -underline 0 -accelerator "<F1>"
+ .menuBar.file add sep
+}
+
+.menuBar.file add command -label "Quit" -command "exit" -underline 0 \
+ -accelerator "Meta-Q"
+. configure -menu .menuBar
+bind . <F1> aboutBox
+
+frame .statusBar
+label .statusBar.lab -text " " -relief sunken -bd 1 \
+ -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w
+label .statusBar.foo -width 8 -relief sunken -bd 1 \
+ -font -*-Helvetica-Medium-R-Normal--*-120-*-*-*-*-*-* -anchor w
+pack .statusBar.lab -side left -padx 2 -expand yes -fill both
+pack .statusBar.foo -side left -padx 2
+pack .statusBar -side bottom -fill x -pady 2
+
+frame .textFrame
+scrollbar .s -orient vertical -command {.t yview} -highlightthickness 0 \
+ -takefocus 1
+pack .s -in .textFrame -side right -fill y
+text .t -yscrollcommand {.s set} -wrap word -width 60 -height 30 -font $font \
+ -setgrid 1 -highlightthickness 0 -padx 4 -pady 2 -takefocus 0
+pack .t -in .textFrame -expand y -fill both -padx 1
+pack .textFrame -expand yes -fill both
+
+# Create a bunch of tags to use in the text widget, such as those for
+# section titles and demo descriptions. Also define the bindings for
+# tags.
+
+.t tag configure title -font {Helvetica 18 bold}
+
+# We put some "space" characters to the left and right of each demo description
+# so that the descriptions are highlighted only when the mouse cursor
+# is right over them (but not when the cursor is to their left or right)
+#
+.t tag configure demospace -lmargin1 1c -lmargin2 1c
+
+
+if {[winfo depth .] == 1} {
+ .t tag configure demo -lmargin1 1c -lmargin2 1c \
+ -underline 1
+ .t tag configure visited -lmargin1 1c -lmargin2 1c \
+ -underline 1
+ .t tag configure hot -background black -foreground white
+} else {
+ .t tag configure demo -lmargin1 1c -lmargin2 1c \
+ -foreground blue -underline 1
+ .t tag configure visited -lmargin1 1c -lmargin2 1c \
+ -foreground #303080 -underline 1
+ .t tag configure hot -foreground red -underline 1
+}
+.t tag bind demo <ButtonRelease-1> {
+ invoke [.t index {@%x,%y}]
+}
+set lastLine ""
+.t tag bind demo <Enter> {
+ set lastLine [.t index {@%x,%y linestart}]
+ .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
+ .t config -cursor hand2
+ showStatus [.t index {@%x,%y}]
+}
+.t tag bind demo <Leave> {
+ .t tag remove hot 1.0 end
+ .t config -cursor xterm
+ .statusBar.lab config -text ""
+}
+.t tag bind demo <Motion> {
+ set newLine [.t index {@%x,%y linestart}]
+ if {[string compare $newLine $lastLine] != 0} {
+ .t tag remove hot 1.0 end
+ set lastLine $newLine
+
+ set tags [.t tag names {@%x,%y}]
+ set i [lsearch -glob $tags demo-*]
+ if {$i >= 0} {
+ .t tag add hot "$lastLine +1 chars" "$lastLine lineend -1 chars"
+ }
+ }
+ showStatus [.t index {@%x,%y}]
+}
+
+# Create the text for the text widget.
+
+.t insert end "Tk Widget Demonstrations\n" title
+.t insert end {
+This application provides a front end for several short scripts that demonstrate what you can do with Tk widgets. Each of the numbered lines below describes a demonstration; you can click on it to invoke the demonstration. Once the demonstration window appears, you can click the "See Code" button to see the Tcl/Tk code that created the demonstration. If you wish, you can edit the code and click the "Rerun Demo" button in the code window to reinvoke the demonstration with the modified code.
+
+}
+.t insert end "Labels, buttons, checkbuttons, and radiobuttons" title
+.t insert end " \n " {demospace}
+.t insert end "1. Labels (text and bitmaps)." {demo demo-label}
+.t insert end " \n " {demospace}
+.t insert end "2. Buttons." {demo demo-button}
+.t insert end " \n " {demospace}
+.t insert end "3. Checkbuttons (select any of a group)." {demo demo-check}
+.t insert end " \n " {demospace}
+.t insert end "4. Radiobuttons (select one of a group)." {demo demo-radio}
+.t insert end " \n " {demospace}
+.t insert end "5. A 15-puzzle game made out of buttons." {demo demo-puzzle}
+.t insert end " \n " {demospace}
+.t insert end "6. Iconic buttons that use bitmaps." {demo demo-icon}
+.t insert end " \n " {demospace}
+.t insert end "7. Two labels displaying images." {demo demo-image1}
+.t insert end " \n " {demospace}
+.t insert end "8. A simple user interface for viewing images." \
+ {demo demo-image2}
+.t insert end " \n " {demospace}
+
+.t insert end \n {} "Listboxes" title
+.t insert end " \n " {demospace}
+.t insert end "1. 50 states." {demo demo-states}
+.t insert end " \n " {demospace}
+.t insert end "2. Colors: change the color scheme for the application." \
+ {demo demo-colors}
+.t insert end " \n " {demospace}
+.t insert end "3. A collection of famous sayings." {demo demo-sayings}
+.t insert end " \n " {demospace}
+
+.t insert end \n {} "Entries" title
+.t insert end " \n " {demospace}
+.t insert end "1. Without scrollbars." {demo demo-entry1}
+.t insert end " \n " {demospace}
+.t insert end "2. With scrollbars." {demo demo-entry2}
+.t insert end " \n " {demospace}
+.t insert end "3. Simple Rolodex-like form." {demo demo-form}
+.t insert end " \n " {demospace}
+
+.t insert end \n {} "Text" title
+.t insert end " \n " {demospace}
+.t insert end "1. Basic editable text." {demo demo-text}
+.t insert end " \n " {demospace}
+.t insert end "2. Text display styles." {demo demo-style}
+.t insert end " \n " {demospace}
+.t insert end "3. Hypertext (tag bindings)." {demo demo-bind}
+.t insert end " \n " {demospace}
+.t insert end "4. A text widget with embedded windows." {demo demo-twind}
+.t insert end " \n " {demospace}
+.t insert end "5. A search tool built with a text widget." {demo demo-search}
+.t insert end " \n " {demospace}
+
+.t insert end \n {} "Canvases" title
+.t insert end " \n " {demospace}
+.t insert end "1. The canvas item types." {demo demo-items}
+.t insert end " \n " {demospace}
+.t insert end "2. A simple 2-D plot." {demo demo-plot}
+.t insert end " \n " {demospace}
+.t insert end "3. Text items in canvases." {demo demo-ctext}
+.t insert end " \n " {demospace}
+.t insert end "4. An editor for arrowheads on canvas lines." {demo demo-arrow}
+.t insert end " \n " {demospace}
+.t insert end "5. A ruler with adjustable tab stops." {demo demo-ruler}
+.t insert end " \n " {demospace}
+.t insert end "6. A building floor plan." {demo demo-floor}
+.t insert end " \n " {demospace}
+.t insert end "7. A simple scrollable canvas." {demo demo-cscroll}
+.t insert end " \n " {demospace}
+
+.t insert end \n {} "Scales" title
+.t insert end " \n " {demospace}
+.t insert end "1. Vertical scale." {demo demo-vscale}
+.t insert end " \n " {demospace}
+.t insert end "2. Horizontal scale." {demo demo-hscale}
+.t insert end " \n " {demospace}
+
+.t insert end \n {} "Menus" title
+.t insert end " \n " {demospace}
+.t insert end "1. Menus and cascades." \
+ {demo demo-menu}
+.t insert end " \n " {demospace}
+.t insert end "2. Menubuttons"\
+ {demo demo-menubu}
+.t insert end " \n " {demospace}
+
+.t insert end \n {} "Common Dialogs" title
+.t insert end " \n " {demospace}
+.t insert end "1. Message boxes." {demo demo-msgbox}
+.t insert end " \n " {demospace}
+.t insert end "2. File selection dialog." {demo demo-filebox}
+.t insert end " \n " {demospace}
+.t insert end "3. Color picker." {demo demo-clrpick}
+.t insert end " \n " {demospace}
+
+.t insert end \n {} "Miscellaneous" title
+.t insert end " \n " {demospace}
+.t insert end "1. The built-in bitmaps." {demo demo-bitmap}
+.t insert end " \n " {demospace}
+.t insert end "2. A dialog box with a local grab." {demo demo-dialog1}
+.t insert end " \n " {demospace}
+.t insert end "3. A dialog box with a global grab." {demo demo-dialog2}
+.t insert end " \n " {demospace}
+
+.t configure -state disabled
+focus .s
+
+# positionWindow --
+# This procedure is invoked by most of the demos to position a
+# new demo window.
+#
+# Arguments:
+# w - The name of the window to position.
+
+proc positionWindow w {
+ wm geometry $w +300+300
+}
+
+# showVars --
+# Displays the values of one or more variables in a window, and
+# updates the display whenever any of the variables changes.
+#
+# Arguments:
+# w - Name of new window to create for display.
+# args - Any number of names of variables.
+
+proc showVars {w args} {
+ catch {destroy $w}
+ toplevel $w
+ wm title $w "Variable values"
+ label $w.title -text "Variable values:" -width 20 -anchor center \
+ -font {Helvetica 18}
+ pack $w.title -side top -fill x
+ set len 1
+ foreach i $args {
+ if {[string length $i] > $len} {
+ set len [string length $i]
+ }
+ }
+ foreach i $args {
+ frame $w.$i
+ label $w.$i.name -text "$i: " -width [expr $len + 2] -anchor w
+ label $w.$i.value -textvar $i -anchor w
+ pack $w.$i.name -side left
+ pack $w.$i.value -side left -expand 1 -fill x
+ pack $w.$i -side top -anchor w -fill x
+ }
+ button $w.ok -text OK -command "destroy $w" -default active
+ bind $w <Return> "tkButtonInvoke $w.ok"
+ pack $w.ok -side bottom -pady 2
+}
+
+# invoke --
+# This procedure is called when the user clicks on a demo description.
+# It is responsible for invoking the demonstration.
+#
+# Arguments:
+# index - The index of the character that the user clicked on.
+
+proc invoke index {
+ global tk_library
+ set tags [.t tag names $index]
+ set i [lsearch -glob $tags demo-*]
+ if {$i < 0} {
+ return
+ }
+ set cursor [.t cget -cursor]
+ .t configure -cursor watch
+ update
+ set demo [string range [lindex $tags $i] 5 end]
+ uplevel [list source [file join $tk_library demos $demo.tcl]]
+ update
+ .t configure -cursor $cursor
+
+ .t tag add visited "$index linestart +1 chars" "$index lineend -1 chars"
+}
+
+# showStatus --
+#
+# Show the name of the demo program in the status bar. This procedure
+# is called when the user moves the cursor over a demo description.
+#
+proc showStatus index {
+ global tk_library
+ set tags [.t tag names $index]
+ set i [lsearch -glob $tags demo-*]
+ set cursor [.t cget -cursor]
+ if {$i < 0} {
+ .statusBar.lab config -text " "
+ set newcursor xterm
+ } else {
+ set demo [string range [lindex $tags $i] 5 end]
+ .statusBar.lab config -text "Run the \"$demo\" sample program"
+ set newcursor hand2
+ }
+ if [string compare $cursor $newcursor] {
+ .t config -cursor $newcursor
+ }
+}
+
+
+# showCode --
+# This procedure creates a toplevel window that displays the code for
+# a demonstration and allows it to be edited and reinvoked.
+#
+# Arguments:
+# w - The name of the demonstration's window, which can be
+# used to derive the name of the file containing its code.
+
+proc showCode w {
+ global tk_library
+ set file [string range $w 1 end].tcl
+ if ![winfo exists .code] {
+ toplevel .code
+ frame .code.buttons
+ pack .code.buttons -side bottom -fill x
+ button .code.buttons.dismiss -text Dismiss \
+ -default active -command "destroy .code"
+ button .code.buttons.rerun -text "Rerun Demo" -command {
+ eval [.code.text get 1.0 end]
+ }
+ pack .code.buttons.dismiss .code.buttons.rerun -side left \
+ -expand 1 -pady 2
+ frame .code.frame
+ pack .code.frame -expand yes -fill both -padx 1 -pady 1
+ text .code.text -height 40 -wrap word\
+ -xscrollcommand ".code.xscroll set" \
+ -yscrollcommand ".code.yscroll set" \
+ -setgrid 1 -highlightthickness 0 -pady 2 -padx 3
+ scrollbar .code.xscroll -command ".code.text xview" \
+ -highlightthickness 0 -orient horizontal
+ scrollbar .code.yscroll -command ".code.text yview" \
+ -highlightthickness 0 -orient vertical
+
+ grid .code.text -in .code.frame -padx 1 -pady 1 \
+ -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
+ grid .code.yscroll -in .code.frame -padx 1 -pady 1 \
+ -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
+# grid .code.xscroll -in .code.frame -padx 1 -pady 1 \
+# -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
+ grid rowconfig .code.frame 0 -weight 1 -minsize 0
+ grid columnconfig .code.frame 0 -weight 1 -minsize 0
+ } else {
+ wm deiconify .code
+ raise .code
+ }
+ wm title .code "Demo code: [file join $tk_library demos $file]"
+ wm iconname .code $file
+ set id [open [file join $tk_library demos $file]]
+ .code.text delete 1.0 end
+ .code.text insert 1.0 [read $id]
+ .code.text mark set insert 1.0
+ close $id
+}
+
+# aboutBox --
+#
+# Pops up a message box with an "about" message
+#
+proc aboutBox {} {
+ tk_messageBox -icon info -type ok -title "About Widget Demo" -message \
+"Tk widget demonstration\n\n\
+Copyright (c) 1996-1997 Sun Microsystems, Inc."
+}
+
diff --git a/tk/library/dialog.tcl b/tk/library/dialog.tcl
new file mode 100644
index 00000000000..c1f8fbc034d
--- /dev/null
+++ b/tk/library/dialog.tcl
@@ -0,0 +1,175 @@
+# 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.
+#
+
+#
+# tk_dialog:
+#
+# This procedure displays a dialog box, waits for a button in the dialog
+# to be invoked, then returns the index of the selected button. If the
+# dialog somehow gets destroyed, -1 is returned.
+#
+# Arguments:
+# w - Window to use for dialog top-level.
+# title - Title to display in dialog's decorative frame.
+# text - Message to display in dialog.
+# bitmap - Bitmap to display in dialog (empty string means none).
+# default - Index of button that is to display the default ring
+# (-1 means none).
+# args - One or more strings to display in buttons across the
+# bottom of the dialog box.
+
+proc tk_dialog {w title text bitmap default args} {
+ global tkPriv tcl_platform
+
+ # 1. Create the top-level window and divide it into top
+ # and bottom parts.
+
+ catch {destroy $w}
+ toplevel $w -class Dialog
+ wm title $w $title
+ wm iconname $w Dialog
+ wm protocol $w WM_DELETE_WINDOW {set tkPriv(button) -1}
+
+ # 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
+ update idle
+ 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
+ }
+
+ # 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(button)
+ catch {focus $oldFocus}
+ catch {
+ # 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)
+}
diff --git a/tk/library/entry.tcl b/tk/library/entry.tcl
new file mode 100644
index 00000000000..e03b3c30aa7
--- /dev/null
+++ b/tk/library/entry.tcl
@@ -0,0 +1,610 @@
+# 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.
+#
+
+#-------------------------------------------------------------------------
+# Elements of tkPriv that are used in this file:
+#
+# afterId - If non-null, it means that auto-scanning is underway
+# and it gives the "after" id for the next auto-scan
+# command to be executed.
+# mouseMoved - Non-zero means the mouse has moved a significant
+# amount since the button went down (so, for example,
+# start dragging out a selection).
+# pressX - X-coordinate at which the mouse button was pressed.
+# selectMode - The style of selection currently underway:
+# char, word, or line.
+# 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
+}
+bind Entry <<PasteSelection>> {
+ if {!$tkPriv(mouseMoved) || $tk_strictMotif} {
+ tkEntryPaste %W %x
+ }
+}
+
+# Standard Motif bindings:
+
+bind Entry <1> {
+ tkEntryButton1 %W %x
+ %W selection clear
+}
+bind Entry <B1-Motion> {
+ set tkPriv(x) %x
+ tkEntryMouseSelect %W %x
+}
+bind Entry <Double-1> {
+ set tkPriv(selectMode) word
+ tkEntryMouseSelect %W %x
+ catch {%W icursor sel.first}
+}
+bind Entry <Triple-1> {
+ set tkPriv(selectMode) line
+ tkEntryMouseSelect %W %x
+ %W icursor 0
+}
+bind Entry <Shift-1> {
+ set tkPriv(selectMode) char
+ %W selection adjust @%x
+}
+bind Entry <Double-Shift-1> {
+ set tkPriv(selectMode) word
+ tkEntryMouseSelect %W %x
+}
+bind Entry <Triple-Shift-1> {
+ set tkPriv(selectMode) line
+ tkEntryMouseSelect %W %x
+}
+bind Entry <B1-Leave> {
+ set tkPriv(x) %x
+ tkEntryAutoScan %W
+}
+bind Entry <B1-Enter> {
+ tkCancelRepeat
+}
+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]
+}
+bind Entry <Shift-Control-Left> {
+ tkEntryKeySelect %W [tkEntryPreviousWord %W insert]
+ tkEntrySeeInsert %W
+}
+bind Entry <Shift-Control-Right> {
+ tkEntryKeySelect %W [tkEntryNextWord %W insert]
+ tkEntrySeeInsert %W
+}
+bind Entry <Home> {
+ tkEntrySetCursor %W 0
+}
+bind Entry <Shift-Home> {
+ tkEntryKeySelect %W 0
+ tkEntrySeeInsert %W
+}
+bind Entry <End> {
+ tkEntrySetCursor %W end
+}
+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
+}
+
+bind Entry <Control-space> {
+ %W selection from insert
+}
+bind Entry <Select> {
+ %W selection from insert
+}
+bind Entry <Control-Shift-space> {
+ %W selection adjust insert
+}
+bind Entry <Shift-Select> {
+ %W selection adjust insert
+}
+bind Entry <Control-slash> {
+ %W selection range 0 end
+}
+bind Entry <Control-backslash> {
+ %W selection clear
+}
+bind Entry <KeyPress> {
+ tkEntryInsert %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, Return, and Tab.
+
+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}
+}
+
+# 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 {$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
+ }
+}
+
+# tkEntryClosestGap --
+# 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 entry window.
+# x - X-coordinate within the window.
+
+proc tkEntryClosestGap {w x} {
+ set pos [$w index @$x]
+ set bbox [$w bbox $pos]
+ if {($x - [lindex $bbox 0]) < ([lindex $bbox 2]/2)} {
+ return $pos
+ }
+ incr pos
+}
+
+# tkEntryButton1 --
+# This procedure is invoked to handle button-1 presses in entry
+# widgets. It moves the insertion cursor, sets the selection anchor,
+# and claims the input focus.
+#
+# Arguments:
+# w - The entry window in which the button was pressed.
+# x - The x-coordinate of the button press.
+
+proc tkEntryButton1 {w x} {
+ 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
+# one character to another or until there have been multiple clicks.
+#
+# Arguments:
+# w - The entry window in which the button was pressed.
+# x - The x-coordinate of the mouse.
+
+proc tkEntryMouseSelect {w x} {
+ global tkPriv
+
+ 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
+ }
+ $w selection range $before $after
+ }
+ line {
+ $w selection range 0 end
+ }
+ }
+ update idletasks
+}
+
+# tkEntryPaste --
+# This procedure sets the insertion cursor to the current mouse position,
+# pastes the selection there, and sets the focus to the window.
+#
+# Arguments:
+# w - The entry window.
+# 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
+# mouse moves back into the window or the mouse button is released.
+#
+# Arguments:
+# w - The entry window.
+
+proc tkEntryAutoScan {w} {
+ global tkPriv
+ set x $tkPriv(x)
+ if {![winfo exists $w]} return
+ if {$x >= [winfo width $w]} {
+ $w xview scroll 2 units
+ tkEntryMouseSelect $w $x
+ } elseif {$x < 0} {
+ $w xview scroll -2 units
+ tkEntryMouseSelect $w $x
+ }
+ set tkPriv(afterId) [after 50 tkEntryAutoScan $w]
+}
+
+# tkEntryKeySelect --
+# 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 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
+ }
+ }
+ $w insert insert $s
+ tkEntrySeeInsert $w
+}
+
+# tkEntryBackspace --
+# Backspace over the character just before the insertion cursor.
+# 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.
+#
+# Arguments:
+# w - The entry window.
+
+proc tkEntrySeeInsert w {
+ set c [$w index insert]
+ set left [$w index @0]
+ if {$left > $c} {
+ $w xview $c
+ return
+ }
+ set x [winfo width $w]
+ while {([$w index @$x] <= $c) && ($left < $c)} {
+ incr left
+ $w xview $left
+ }
+}
+
+# tkEntrySetCursor -
+# Move the insertion cursor to a given position in an entry. Also
+# clears the selection, if there is one in the entry, and makes sure
+# that the insertion cursor is visible.
+#
+# Arguments:
+# w - The entry window.
+# pos - The desired new position for the cursor in the window.
+
+proc tkEntrySetCursor {w pos} {
+ $w icursor $pos
+ $w selection clear
+ tkEntrySeeInsert $w
+}
+
+# tkEntryTranspose -
+# This procedure implements the "transpose" function for entry 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 - 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
+ }
+ return $pos
+ }
+} else {
+ proc tkEntryNextWord {w start} {
+ set pos [tcl_endOfWord [$w get] [$w index $start]]
+ if {$pos < 0} {
+ return end
+ }
+ return $pos
+ }
+}
+
+# tkEntryPreviousWord --
+#
+# Returns the index of the previous word position before a given
+# position in the entry.
+#
+# Arguments:
+# w - The entry window in which the cursor is to move.
+# start - Position at which to start search.
+
+proc tkEntryPreviousWord {w start} {
+ set pos [tcl_startOfPreviousWord [$w get] [$w index $start]]
+ if {$pos < 0} {
+ return 0
+ }
+ return $pos
+}
+
diff --git a/tk/library/focus.tcl b/tk/library/focus.tcl
new file mode 100644
index 00000000000..b4ff997dc43
--- /dev/null
+++ b/tk/library/focus.tcl
@@ -0,0 +1,180 @@
+# 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.
+#
+
+# tk_focusNext --
+# This procedure returns the name of the next window after "w" in
+# "focus order" (the window that should receive the focus next if
+# Tab is typed in w). "Next" is defined by a pre-order search
+# of a top-level and its non-top-level descendants, with the stacking
+# order determining the order of siblings. The "-takefocus" options
+# on windows determine whether or not they should be skipped.
+#
+# Arguments:
+# w - Name of a window.
+
+proc tk_focusNext w {
+ set cur $w
+ while 1 {
+
+ # Descend to just before the first child of the current widget.
+
+ set parent $cur
+ set children [winfo children $cur]
+ set i -1
+
+ # 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
+# "focus order" (the window that should receive the focus next if
+# Shift-Tab is typed in w). "Next" is defined by a pre-order search
+# of a top-level and its non-top-level descendants, with the stacking
+# order determining the order of siblings. The "-takefocus" options
+# on windows determine whether or not they should be skipped.
+#
+# Arguments:
+# w - Name of a window.
+
+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 --
+#
+# This procedure is invoked to decide whether or not to focus on
+# a given window. It returns 1 if it's OK to focus on the window,
+# 0 if it's not OK. The code first checks whether the window is
+# viewable. If not, then it never focuses on the window. Then it
+# checks the -takefocus option for the window and uses it if it's
+# set. If there's no -takefocus option, the procedure checks to
+# see if (a) the widget isn't disabled, and (b) it has some key
+# 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
+ }
+}
diff --git a/tk/library/images/README b/tk/library/images/README
new file mode 100644
index 00000000000..176b6e25997
--- /dev/null
+++ b/tk/library/images/README
@@ -0,0 +1,12 @@
+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.
+
+
diff --git a/tk/library/images/logo100.gif b/tk/library/images/logo100.gif
new file mode 100644
index 00000000000..4603d4ff417
--- /dev/null
+++ b/tk/library/images/logo100.gif
Binary files differ
diff --git a/tk/library/images/logo64.gif b/tk/library/images/logo64.gif
new file mode 100644
index 00000000000..749d55bdd21
--- /dev/null
+++ b/tk/library/images/logo64.gif
Binary files differ
diff --git a/tk/library/images/logoLarge.gif b/tk/library/images/logoLarge.gif
new file mode 100644
index 00000000000..bd7530a9e18
--- /dev/null
+++ b/tk/library/images/logoLarge.gif
Binary files differ
diff --git a/tk/library/images/logoMed.gif b/tk/library/images/logoMed.gif
new file mode 100644
index 00000000000..d41801a41f4
--- /dev/null
+++ b/tk/library/images/logoMed.gif
Binary files differ
diff --git a/tk/library/images/pwrdLogo100.gif b/tk/library/images/pwrdLogo100.gif
new file mode 100644
index 00000000000..42c5b30a74f
--- /dev/null
+++ b/tk/library/images/pwrdLogo100.gif
Binary files differ
diff --git a/tk/library/images/pwrdLogo150.gif b/tk/library/images/pwrdLogo150.gif
new file mode 100644
index 00000000000..e2e6b7af2db
--- /dev/null
+++ b/tk/library/images/pwrdLogo150.gif
Binary files differ
diff --git a/tk/library/images/pwrdLogo175.gif b/tk/library/images/pwrdLogo175.gif
new file mode 100644
index 00000000000..67d9536686f
--- /dev/null
+++ b/tk/library/images/pwrdLogo175.gif
Binary files differ
diff --git a/tk/library/images/pwrdLogo200.gif b/tk/library/images/pwrdLogo200.gif
new file mode 100644
index 00000000000..6bff47246c5
--- /dev/null
+++ b/tk/library/images/pwrdLogo200.gif
Binary files differ
diff --git a/tk/library/images/pwrdLogo75.gif b/tk/library/images/pwrdLogo75.gif
new file mode 100644
index 00000000000..1c6b11a89ff
--- /dev/null
+++ b/tk/library/images/pwrdLogo75.gif
Binary files differ
diff --git a/tk/library/license.terms b/tk/library/license.terms
new file mode 100644
index 00000000000..03ca6fcb319
--- /dev/null
+++ b/tk/library/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., and other parties. The following
+terms apply to all files associated with the software unless explicitly
+disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
diff --git a/tk/library/listbox.tcl b/tk/library/listbox.tcl
new file mode 100644
index 00000000000..ddaafa76a43
--- /dev/null
+++ b/tk/library/listbox.tcl
@@ -0,0 +1,452 @@
+# 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:
+#
+# afterId - Token returned by "after" for autoscanning.
+# listboxPrev - The last element to be selected or deselected
+# during a selection operation.
+# listboxSelection - All of the items that were selected before the
+# current selection operation (such as a mouse
+# drag) started; used to cancel an operation.
+#--------------------------------------------------------------------------
+
+#-------------------------------------------------------------------------
+# The code below creates the default class bindings for listboxes.
+#-------------------------------------------------------------------------
+
+# 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.
+
+bind Listbox <Double-1> {
+ # Empty script
+}
+
+bind Listbox <B1-Motion> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ tkListboxMotion %W [%W index @%x,%y]
+}
+bind Listbox <ButtonRelease-1> {
+ tkCancelRepeat
+ %W activate @%x,%y
+}
+bind Listbox <Shift-1> {
+ tkListboxBeginExtend %W [%W index @%x,%y]
+}
+bind Listbox <Control-1> {
+ tkListboxBeginToggle %W [%W index @%x,%y]
+}
+bind Listbox <B1-Leave> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ tkListboxAutoScan %W
+}
+bind Listbox <B1-Enter> {
+ tkCancelRepeat
+}
+
+bind Listbox <Up> {
+ tkListboxUpDown %W -1
+}
+bind Listbox <Shift-Up> {
+ tkListboxExtendUpDown %W -1
+}
+bind Listbox <Down> {
+ tkListboxUpDown %W 1
+}
+bind Listbox <Shift-Down> {
+ tkListboxExtendUpDown %W 1
+}
+bind Listbox <Left> {
+ %W xview scroll -1 units
+}
+bind Listbox <Control-Left> {
+ %W xview scroll -1 pages
+}
+bind Listbox <Right> {
+ %W xview scroll 1 units
+}
+bind Listbox <Control-Right> {
+ %W xview scroll 1 pages
+}
+bind Listbox <Prior> {
+ %W yview scroll -1 pages
+ %W activate @0,0
+}
+bind Listbox <Next> {
+ %W yview scroll 1 pages
+ %W activate @0,0
+}
+bind Listbox <Control-Prior> {
+ %W xview scroll -1 pages
+}
+bind Listbox <Control-Next> {
+ %W xview scroll 1 pages
+}
+bind Listbox <Home> {
+ %W xview moveto 0
+}
+bind Listbox <End> {
+ %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]
+}
+bind Listbox <Select> {
+ tkListboxBeginSelect %W [%W index active]
+}
+bind Listbox <Control-Shift-space> {
+ tkListboxBeginExtend %W [%W index active]
+}
+bind Listbox <Shift-Select> {
+ tkListboxBeginExtend %W [%W index active]
+}
+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.
+#
+# Arguments:
+# w - The listbox widget.
+# el - The element under the pointer (must be a number).
+
+proc tkListboxMotion {w el} {
+ global tkPriv
+ if {$el == $tkPriv(listboxPrev)} {
+ return
+ }
+ 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
+# itself as an "after" command so that the window continues to scroll until
+# the mouse moves back into the window or the mouse button is released.
+#
+# Arguments:
+# w - The entry window.
+
+proc tkListboxAutoScan {w} {
+ global tkPriv
+ if {![winfo exists $w]} return
+ set x $tkPriv(x)
+ set y $tkPriv(y)
+ if {$y >= [winfo height $w]} {
+ $w yview scroll 1 units
+ } elseif {$y < 0} {
+ $w yview scroll -1 units
+ } elseif {$x >= [winfo width $w]} {
+ $w xview scroll 2 units
+ } elseif {$x < 0} {
+ $w xview scroll -2 units
+ } else {
+ return
+ }
+ tkListboxMotion $w [$w index @$x,$y]
+ set tkPriv(afterId) [after 50 tkListboxAutoScan $w]
+}
+
+# tkListboxUpDown --
+#
+# Moves the location cursor (active element) up or down by one element,
+# and changes the selection if we're in browse or extended selection
+# mode.
+#
+# 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
+ }
+}
diff --git a/tk/library/menu.tcl b/tk/library/menu.tcl
new file mode 100644
index 00000000000..b0fa2cce559
--- /dev/null
+++ b/tk/library/menu.tcl
@@ -0,0 +1,1235 @@
+# 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:
+#
+# cursor - Saves the -cursor option for the posted menubutton.
+# focus - Saves the focus during a menu selection operation.
+# Focus gets restored here when the menu is unposted.
+# grabGlobal - Used in conjunction with tkPriv(oldGrab): if
+# tkPriv(oldGrab) is non-empty, then tkPriv(grabGlobal)
+# contains either an empty string or "-global" to
+# indicate whether the old grab was a local one or
+# a global one.
+# inMenubutton - The name of the menubutton widget containing
+# the mouse, or an empty string if the mouse is
+# not over any menubutton.
+# menuBar - The name of the menubar that is the root
+# of the cascade hierarchy which is currently
+# posted. This is null when there is no menu currently
+# being pulled down from a menu bar.
+# oldGrab - Window that had the grab before a menu was posted.
+# Used to restore the grab state after the menu
+# is unposted. Empty string means there was no
+# grab previously set.
+# popup - If a menu has been popped up via tk_popup, this
+# gives the name of the menu. Otherwise this
+# value is empty.
+# postedMb - Name of the menubutton whose menu is currently
+# posted, or an empty string if nothing is posted
+# A grab is set on this widget.
+# relief - Used to save the original relief of the current
+# menubutton.
+# window - When the mouse is over a menu, this holds the
+# name of the menu; it's cleared when the mouse
+# leaves the menu.
+# tearoff - Whether the last menu posted was a tearoff or not.
+# This is true always for unix, for tearoffs for Mac
+# and Windows.
+# activeMenu - This is the last active menu for use
+# with the <<MenuSelect>> virtual event.
+# activeItem - This is the last active menu item for
+# use with the <<MenuSelect>> virtual event.
+#-------------------------------------------------------------------------
+
+#-------------------------------------------------------------------------
+# Overall note:
+# This file is tricky because there are five different ways that menus
+# can be used:
+#
+# 1. As a pulldown from a menubutton. In this style, the variable
+# tkPriv(postedMb) identifies the posted menubutton.
+# 2. As a torn-off menu copied from some other menu. In this style
+# tkPriv(postedMb) is empty, and menu's type is "tearoff".
+# 3. As an option menu, triggered from an option menubutton. In this
+# style tkPriv(postedMb) identifies the posted menubutton.
+# 4. As a popup menu. In this style tkPriv(postedMb) is empty and
+# the top-level menu's type is "normal".
+# 5. As a pulldown from a menubar. The variable tkPriv(menubar) has
+# the owning menubar, and the menu itself is of type "normal".
+#
+# The various binding procedures use the state described above to
+# distinguish the various cases and take different actions in each
+# case.
+#-------------------------------------------------------------------------
+
+#-------------------------------------------------------------------------
+# The code below creates the default class bindings for menus
+# and menubuttons.
+#-------------------------------------------------------------------------
+
+bind Menubutton <FocusIn> {}
+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> {
+ tkMbMotion %W down %X %Y
+}
+bind Menubutton <ButtonRelease-1> {
+ tkMbButtonUp %W
+}
+bind Menubutton <space> {
+ tkMbPost %W
+ tkMenuFirstEntry [%W cget -menu]
+}
+
+# Must set focus when mouse enters a menu, in order to allow
+# mixed-mode processing using both the mouse and the keyboard.
+# Don't set the focus if the event comes from a grab release,
+# though: such an event can happen after as part of unposting
+# 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
+}
+
+bind Menu <Leave> {
+ tkMenuLeave %W %X %Y %s
+}
+bind Menu <Motion> {
+ tkMenuMotion %W %x %y %s
+}
+bind Menu <ButtonPress> {
+ tkMenuButtonDown %W
+}
+bind Menu <ButtonRelease> {
+ tkMenuInvoke %W 1
+}
+bind Menu <space> {
+ tkMenuInvoke %W 0
+}
+bind Menu <Return> {
+ tkMenuInvoke %W 0
+}
+bind Menu <Escape> {
+ tkMenuEscape %W
+}
+bind Menu <Left> {
+ tkMenuLeftArrow %W
+}
+bind Menu <Right> {
+ tkMenuRightArrow %W
+}
+bind Menu <Up> {
+ tkMenuUpArrow %W
+}
+bind Menu <Down> {
+ tkMenuDownArrow %W
+}
+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
+ }
+} else {
+ bind Menubutton <Alt-KeyPress> {
+ tkTraverseToMenu %W %A
+ }
+
+ bind Menubutton <F10> {
+ tkFirstMenu %W
+ }
+}
+
+# tkMbEnter --
+# This procedure is invoked when the mouse enters a menubutton
+# widget. It activates the widget unless it is disabled. Note:
+# this procedure is only invoked when mouse button 1 is *not* down.
+# The procedure tkMbB1Enter is invoked if the button is down.
+#
+# 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
+
+ }
+
+ set tkPriv(tearoff) $tearoff
+ if {$tearoff != 0} {
+ focus $menu
+ tkSaveGrabInfo $w
+ grab -global $w
+ }
+}
+
+# tkMenuUnpost --
+# This procedure unposts a given menu, plus all of its ancestors up
+# to (and including) a menubutton, if any. It also restores various
+# values to what they were before the menu was posted, and releases
+# a grab if there's a menubutton involved. Special notes:
+# 1. It's important to unpost all menus before releasing the grab, so
+# that any Enter-Leave events (e.g. from menu back to main
+# application) have mode NotifyGrab.
+# 2. Be sure to enclose various groups of commands in "catch" so that
+# the procedure will complete even if the menubutton or the menu
+# or the grab window has been deleted.
+#
+# Arguments:
+# menu - Name of a menu to unpost. Ignored if there
+# is a posted menubutton.
+
+proc tkMenuUnpost menu {
+ global tcl_platform
+ global tkPriv
+ set mb $tkPriv(postedMb)
+
+ # Restore focus right away (otherwise X will take focus away when
+ # the menu is unmapped and under some window managers (e.g. olvwm)
+ # we'll lose the focus completely).
+
+ 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 {}
+ }
+}
+
+# tkMenuMotion --
+# This procedure is called to handle mouse motion events for menus.
+# It does two things. First, it resets the active element in the
+# menu, if the mouse is over the menu. Second, if a mouse button
+# is down, it posts and unposts cascade entries to match the mouse
+# position.
+#
+# Arguments:
+# 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
+ }
+ }
+ if {($state & 0x1f00) != 0} {
+ $menu postcascade active
+ }
+}
+
+# tkMenuButtonDown --
+# Handles button presses in menus. There are a couple of tricky things
+# here:
+# 1. Change the posted cascade entry (if any) to match the mouse position.
+# 2. If there is a posted menubutton, must grab to the menubutton; this
+# overrrides the implicit grab on button press, so that the menu
+# button can track mouse motions over other menubuttons and change
+# the posted menu.
+# 3. If there's no posted menubutton (e.g. because we're a torn-off menu
+# or one of its descendants) must grab to the top-level menu so that
+# we can track mouse motions across the entire menu hierarchy.
+#
+# 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 --
+# This procedure is invoked to handle "left" and "right" traversal
+# motions in menus. It traverses to the next menu in a menu bar,
+# or into or out of a cascaded menu.
+#
+# Arguments:
+# menu - The menu that received the keyboard
+# event.
+# 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
+ }
+ while {$i < 0} {
+ incr i $length
+ }
+ while {$i >= $length} {
+ incr i -$length
+ }
+ if {[catch {$menu entrycget $i -state} state] == 0} {
+ if {$state != "disabled"} {
+ break
+ }
+ }
+ if {$i == $active} {
+ 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 --
+# This procedure searches the entire window hierarchy under w for
+# a menubutton that isn't disabled and whose underlined character
+# is "char" or an entry in a menubar that isn't disabled and whose
+# underlined character is "char".
+# It returns the name of that window, if found, or an
+# empty string if no matching window was found. If "char" is an
+# empty string then the procedure returns the name of the first
+# menubutton found that isn't disabled.
+#
+# Arguments:
+# w - Name of window where key was typed.
+# char - Underlined character to search for;
+# may be either upper or lower case, and
+# will match either upper or lower case.
+
+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 {}
+}
+
+# tkTraverseToMenu --
+# This procedure implements keyboard traversal of menus. Given an
+# ASCII character "char", it looks for a menubutton with that character
+# underlined. If one is found, it posts the menubutton's menu
+#
+# Arguments:
+# w - Window in which the key was typed (selects
+# 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
+ tkMenuFirstEntry [$w cget -menu]
+ }
+ }
+}
+
+# tkFirstMenu --
+# This procedure traverses to the first menubutton in the toplevel
+# for a given window, and posts that menubutton's menu.
+#
+# 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
+ tkMenuFirstEntry [$w cget -menu]
+ }
+ }
+}
+
+# tkTraverseWithinMenu
+# This procedure implements keyboard traversal within a menu. It
+# searches for an entry in the menu that has "char" underlined. If
+# such an entry is found, it is invoked and the menu is unposted.
+#
+# 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
+ }
+ }
+}
+
+# tkMenuFirstEntry --
+# Given a menu, this procedure finds the first entry that isn't
+# disabled or a tear-off or separator, and activates that entry.
+# However, if there is already an active entry in the menu (e.g.,
+# because of a previous call to tkPostOverPoint) then the active
+# 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
+ }
+ }
+}
+
+# tkMenuFindName --
+# Given a menu and a text string, return the index of the menu entry
+# that displays the string as its label. If there is no such entry,
+# return an empty string. This procedure is tricky because some names
+# like "active" have a special meaning in menu commands, so we can't
+# always use the "index" widget command.
+#
+# Arguments:
+# menu - Name of the menu widget.
+# s - String to look for.
+
+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 ""
+}
+
+# tkPostOverPoint --
+# This procedure posts a given menu such that a given entry in the
+# menu is centered over a given point in the root window. It also
+# activates the given entry.
+#
+# Arguments:
+# menu - Menu to post.
+# x, y - Root coordinates of point.
+# 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>>
+}
+
+# tk_popup --
+# This procedure pops up a menu and sets things up for traversing
+# the menu and its submenus.
+#
+# Arguments:
+# menu - Name of the menu to be popped up.
+# x, y - Root coordinates at which to pop up the
+# menu.
+# 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
+ }
+}
diff --git a/tk/library/msgbox.tcl b/tk/library/msgbox.tcl
new file mode 100644
index 00000000000..e892ea5ce23
--- /dev/null
+++ b/tk/library/msgbox.tcl
@@ -0,0 +1,268 @@
+# 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.
+#
+
+
+# tkMessageBox --
+#
+# Pops up a messagebox with an application-supplied message with
+# an icon and a list of buttons. This procedure will be called
+# by tk_messageBox if the platform does not have native
+# messagebox support, or if the particular type of messagebox is
+# not supported natively.
+#
+# This procedure is a private procedure shouldn't be called
+# directly. Call tk_messageBox instead.
+#
+# See the user documentation for details on what tk_messageBox does.
+#
+proc tkMessageBox {args} {
+ global tkPriv tcl_platform
+
+ set w tkPrivMsgBox
+ upvar #0 $w data
+
+ #
+ # The default value of the title is space (" ") not the empty string
+ # because for some window managers, a
+ # wm title .foo ""
+ # causes the window title to be "foo" instead of the empty string.
+ #
+ set specs {
+ {-default "" "" ""}
+ {-icon "" "" "info"}
+ {-message "" "" ""}
+ {-modal "" "" ""}
+ {-parent "" "" .}
+ {-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}
+ }
+ }
+ retrycancel {
+ set buttons {
+ {retry -width 6 -text Retry -under 0}
+ {cancel -width 6 -text Cancel -under 0}
+ }
+ }
+ yesno {
+ set buttons {
+ {yes -width 6 -text Yes -under 0}
+ {no -width 6 -text No -under 0}
+ }
+ }
+ yesnocancel {
+ 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"
+ }
+
+ # CYGNUS LOCAL - bind all buttons so that <Return>
+ # activates them
+ bind $w.$name <Return> "$w.$name invoke"
+
+ incr i
+ }
+
+ # 6. Create a binding for <Return> on the dialog if there is a
+ # default button.
+
+ # CYGNUS LOCAL - This seems like a bad idea. If the user
+ # uses the keyboard to select something other than the default and
+ # then hits <Return> to activate that button, the wrong value will
+ # be returned
+
+ #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)
+}
diff --git a/tk/library/obsolete.tcl b/tk/library/obsolete.tcl
new file mode 100644
index 00000000000..7fc1fb366f3
--- /dev/null
+++ b/tk/library/obsolete.tcl
@@ -0,0 +1,21 @@
+# 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.
+#
+
+# The procedures below are here strictly for backward compatibility with
+# Tk version 3.6 and earlier. The procedures are no longer needed, so
+# they are no-ops. You should not use these procedures anymore, since
+# they may be removed in some future release.
+
+proc tk_menuBar args {}
+proc tk_bindForTraversal args {}
diff --git a/tk/library/optMenu.tcl b/tk/library/optMenu.tcl
new file mode 100644
index 00000000000..bf9768c425d
--- /dev/null
+++ b/tk/library/optMenu.tcl
@@ -0,0 +1,45 @@
+# 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.
+#
+
+# tk_optionMenu --
+# This procedure creates an option button named $w and an associated
+# menu. Together they provide the functionality of Motif option menus:
+# they can be used to select one of many values, and the current value
+# appears in the global variable varName, as well as in the text of
+# the option menubutton. The name of the menu is returned as the
+# procedure's result, so that the caller can use it to change configuration
+# options on the menu or otherwise manipulate it.
+#
+# Arguments:
+# w - The name to use for the menubutton.
+# 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
+}
diff --git a/tk/library/palette.tcl b/tk/library/palette.tcl
new file mode 100644
index 00000000000..3fb2c084b73
--- /dev/null
+++ b/tk/library/palette.tcl
@@ -0,0 +1,224 @@
+# 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.
+#
+
+# tk_setPalette --
+# Changes the default color scheme for a Tk application by setting
+# default colors in the option database and by modifying all of the
+# color options for existing widgets that have the default value.
+#
+# Arguments:
+# The arguments consist of either a single color name, which
+# will be used as the new background color (all other colors will
+# be computed from this) or an even number of values consisting of
+# option names and values. The name for an option is the one used
+# for the option database, such as activeForeground, not -activeforeground.
+
+proc tk_setPalette {args} {
+ global tkPalette
+
+ # Create an array that has the complete new palette. If some colors
+ # 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
+ foreach q {button canvas checkbutton entry frame label listbox menubutton menu message \
+ radiobutton scale scrollbar text} {
+ $q .___tk_set_palette.$q
+ }
+
+ # Walk the widget hierarchy, recoloring all existing windows.
+ # The option database must be set according to what we do here,
+ # but it breaks things if we set things in the database while
+ # we are changing colors...so, tkRecolorTree now returns the
+ # option database changes that need to be made, and they
+ # need to be evalled here to take effect.
+ # We have to walk the whole widget tree instead of just
+ # relying on the widgets we've created above to do the work
+ # because different extensions may provide other kinds
+ # of widgets that we don't currently know about, so we'll
+ # walk the whole hierarchy just in case.
+
+ eval [tkRecolorTree . new]
+
+ catch {destroy .___tk_set_palette}
+
+ # Change the option database so that future windows will get the
+ # same colors.
+
+ foreach option [array names new] {
+ option add *$option $new($option) widgetDefault
+ }
+
+ # Save the options in the global variable tkPalette, for use the
+ # next time we change the options.
+
+ array set tkPalette [array get new]
+}
+
+# tkRecolorTree --
+# This procedure changes the colors in a window and all of its
+# descendants, according to information provided by the colors
+# argument. This looks at the defaults provided by the option
+# database, if it exists, and if not, then it looks at the default
+# value of the widget itself.
+#
+# Arguments:
+# w - The name of a window. This window and all its
+# descendants are recolored.
+# colors - The name of an array variable in the caller,
+# which contains color information. Each element
+# is named after a widget configuration option, and
+# each value is the value for that option.
+
+proc tkRecolorTree {w colors} {
+ global tkPalette
+ upvar $colors c
+ set result {}
+ foreach dbOption [array names c] {
+ set option -[string tolower $dbOption]
+ if {![catch {$w config $option} value]} {
+ # if the option database has a preference for this
+ # dbOption, then use it, otherwise use the defaults
+ # for the widget.
+ set defaultcolor [option get $w $dbOption widgetDefault]
+ if {[string match {} $defaultcolor]} {
+ set defaultcolor [winfo rgb . [lindex $value 3]]
+ } else {
+ set defaultcolor [winfo rgb . $defaultcolor]
+ }
+ if {[lindex $value 4] != {}} {
+ set chosencolor [winfo rgb . [lindex $value 4]]
+ if {[string match $defaultcolor $chosencolor]} {
+ # Change the option database so that future windows will get
+ # the same colors.
+ append result ";\noption add [list \
+ *[winfo class $w].$dbOption $c($dbOption) 60]"
+ $w configure $option $c($dbOption)
+ }
+ }
+ }
+ }
+ foreach child [winfo children $w] {
+ append result ";\n[tkRecolorTree $child c]"
+ }
+ return $result
+}
+
+# tkDarken --
+# Given a color name, computes a new color value that darkens (or
+# brightens) the given color by a given percent.
+#
+# 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.
+
+proc tk_bisque {} {
+ tk_setPalette activeBackground #e6ceb1 activeForeground black \
+ background #ffe4c4 disabledForeground #b0b0b0 foreground black \
+ highlightBackground #ffe4c4 highlightColor black \
+ insertBackground black selectColor #b03060 \
+ selectBackground #e6ceb1 selectForeground black \
+ troughColor #cdb79e
+}
diff --git a/tk/library/safetk.tcl b/tk/library/safetk.tcl
new file mode 100644
index 00000000000..40482ec4a1a
--- /dev/null
+++ b/tk/library/safetk.tcl
@@ -0,0 +1,204 @@
+# 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 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.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)
+ Set [DeleteHookName $slave] [list tkDelete {} $w];
+ } else {
+ # 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"
+ }
+}
+
+proc ::safe::allowTk {interpPath argv} {
+ variable tkInit
+ set tkInit($interpPath) $argv
+}
+
+ 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 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;
+
+ # Control frame
+ set wc $w.fc
+ frame $wc -bg red -borderwidth 3 -relief ridge ;
+
+ # We will destroy the interp when the window is destroyed
+ bindtags $wc [concat Safe$wc [bindtags $wc]]
+ bind Safe$wc <Destroy> [list ::safe::tkDelete %W $w $slave];
+
+ label $wc.l -text $msg \
+ -padx 2 -pady 0 -anchor w;
+
+ # We want the button to be the last visible item
+ # (so be packed first) and at the right and not resizing horizontally
+
+ # frame the button so it does not expand horizontally
+ # but still have the default background instead of red one from the parent
+ frame $wc.fb -bd 0 ;
+ button $wc.fb.b -text "Delete" \
+ -bd 1 -padx 2 -pady 0 -highlightthickness 0 \
+ -command [list ::safe::tkDelete $w $w $slave]
+ pack $wc.fb.b -side right -fill both ;
+ pack $wc.fb -side right -fill both -expand 1;
+ pack $wc.l -side left -fill both -expand 1;
+ pack $wc -side bottom -fill x ;
+
+ # Container frame
+ frame $w.c -container 1;
+ pack $w.c -fill both -expand 1;
+
+ # return both the toplevel window name and the id to use for embedding
+ list $w [winfo id $w.c] ;
+}
+
+}
diff --git a/tk/library/scale.tcl b/tk/library/scale.tcl
new file mode 100644
index 00000000000..f6bb4d307bb
--- /dev/null
+++ b/tk/library/scale.tcl
@@ -0,0 +1,265 @@
+# 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> {
+ tkScaleDrag %W %x %y
+}
+bind Scale <B1-Leave> { }
+bind Scale <B1-Enter> { }
+bind Scale <ButtonRelease-1> {
+ tkCancelRepeat
+ tkScaleEndDrag %W
+ tkScaleActivate %W %x %y
+}
+bind Scale <2> {
+ tkScaleButton2Down %W %x %y
+}
+bind Scale <B2-Motion> {
+ tkScaleDrag %W %x %y
+}
+bind Scale <B2-Leave> { }
+bind Scale <B2-Enter> { }
+bind Scale <ButtonRelease-2> {
+ tkCancelRepeat
+ tkScaleEndDrag %W
+ tkScaleActivate %W %x %y
+}
+bind Scale <Control-1> {
+ tkScaleControlPress %W %x %y
+}
+bind Scale <Up> {
+ tkScaleIncrement %W up little noRepeat
+}
+bind Scale <Down> {
+ tkScaleIncrement %W down little noRepeat
+}
+bind Scale <Left> {
+ tkScaleIncrement %W up little noRepeat
+}
+bind Scale <Right> {
+ tkScaleIncrement %W down little noRepeat
+}
+bind Scale <Control-Up> {
+ tkScaleIncrement %W up big noRepeat
+}
+bind Scale <Control-Down> {
+ tkScaleIncrement %W down big noRepeat
+}
+bind Scale <Control-Left> {
+ tkScaleIncrement %W up big noRepeat
+}
+bind Scale <Control-Right> {
+ tkScaleIncrement %W down big noRepeat
+}
+bind Scale <Home> {
+ %W set [%W cget -from]
+}
+bind Scale <End> {
+ %W set [%W cget -to]
+}
+
+# tkScaleActivate --
+# This procedure is invoked to check a given x-y position in the
+# scale and activate the slider if the x-y position falls within
+# the slider.
+#
+# 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:
+# w - The scale widget.
+
+proc tkScaleEndDrag {w} {
+ global tkPriv
+ set tkPriv(dragging) 0
+ $w configure -sliderrelief raised
+}
+
+# tkScaleIncrement --
+# This procedure is invoked to increment the value of a scale and
+# to set up auto-repeating of the action if that is desired. The
+# way the value is incremented depends on the "dir" and "big"
+# arguments.
+#
+# Arguments:
+# w - The scale widget.
+# dir - "up" means move value towards -from, "down" means
+# move towards -to.
+# big - Size of increments: "big" or "little".
+# repeat - Whether and how to auto-repeat the action: "noRepeat"
+# 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
+}
diff --git a/tk/library/scrlbar.tcl b/tk/library/scrlbar.tcl
new file mode 100644
index 00000000000..6073e746c6e
--- /dev/null
+++ b/tk/library/scrlbar.tcl
@@ -0,0 +1,417 @@
+# 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]
+}
+
+# The "info exists" command in the following binding handles the
+# situation where a Leave event occurs for a scrollbar without the Enter
+# event. This seems to happen on some systems (such as Solaris 2.4) for
+# unknown reasons.
+
+bind Scrollbar <Leave> {
+ if {$tk_strictMotif && [info exists tkPriv(activeBg)]} {
+ %W config -activebackground $tkPriv(activeBg)
+ }
+ %W activate {}
+}
+bind Scrollbar <1> {
+ tkScrollButtonDown %W %x %y
+}
+bind Scrollbar <B1-Motion> {
+ tkScrollDrag %W %x %y
+}
+bind Scrollbar <B1-B2-Motion> {
+ tkScrollDrag %W %x %y
+}
+bind Scrollbar <ButtonRelease-1> {
+ tkScrollButtonUp %W %x %y
+}
+bind Scrollbar <B1-Leave> {
+ # Prevents <Leave> binding from being invoked.
+}
+bind Scrollbar <B1-Enter> {
+ # Prevents <Enter> binding from being invoked.
+}
+bind Scrollbar <2> {
+ tkScrollButton2Down %W %x %y
+}
+bind Scrollbar <B1-2> {
+ # Do nothing, since button 1 is already down.
+}
+bind Scrollbar <B2-1> {
+ # Do nothing, since button 2 is already down.
+}
+bind Scrollbar <B2-Motion> {
+ tkScrollDrag %W %x %y
+}
+bind Scrollbar <ButtonRelease-2> {
+ tkScrollButtonUp %W %x %y
+}
+bind Scrollbar <B1-ButtonRelease-2> {
+ # Do nothing: B1 release will handle it.
+}
+bind Scrollbar <B2-ButtonRelease-1> {
+ # Do nothing: B2 release will handle it.
+}
+bind Scrollbar <B2-Leave> {
+ # Prevents <Leave> binding from being invoked.
+}
+bind Scrollbar <B2-Enter> {
+ # Prevents <Enter> binding from being invoked.
+}
+bind Scrollbar <Control-1> {
+ tkScrollTopBottom %W %x %y
+}
+bind Scrollbar <Control-2> {
+ tkScrollTopBottom %W %x %y
+}
+
+bind Scrollbar <Up> {
+ tkScrollByUnits %W v -1
+}
+bind Scrollbar <Down> {
+ tkScrollByUnits %W v 1
+}
+bind Scrollbar <Control-Up> {
+ tkScrollByPages %W v -1
+}
+bind Scrollbar <Control-Down> {
+ tkScrollByPages %W v 1
+}
+bind Scrollbar <Left> {
+ tkScrollByUnits %W h -1
+}
+bind Scrollbar <Right> {
+ tkScrollByUnits %W h 1
+}
+bind Scrollbar <Control-Left> {
+ tkScrollByPages %W h -1
+}
+bind Scrollbar <Control-Right> {
+ tkScrollByPages %W h 1
+}
+bind Scrollbar <Prior> {
+ tkScrollByPages %W hv -1
+}
+bind Scrollbar <Next> {
+ tkScrollByPages %W hv 1
+}
+bind Scrollbar <Home> {
+ tkScrollToPos %W 0
+}
+bind Scrollbar <End> {
+ tkScrollToPos %W 1
+}
+}
+# tkScrollButtonDown --
+# This procedure is invoked when a button is pressed in a scrollbar.
+# It changes the way the scrollbar is displayed and takes actions
+# depending on where the mouse is.
+#
+# Arguments:
+# w - The scrollbar widget.
+# 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 --
+# This procedure is invoked when a button is released in a scrollbar.
+# It cancels scans and auto-repeats that were in progress, and restores
+# the way the active element is displayed.
+#
+# Arguments:
+# w - The scrollbar widget.
+# x, y - Mouse coordinates.
+
+proc tkScrollButtonUp {w x y} {
+ global tkPriv
+ tkCancelRepeat
+ $w configure -activerelief $tkPriv(relief)
+ tkScrollEndDrag $w $x $y
+ $w activate [$w identify $x $y]
+}
+
+# tkScrollSelect --
+# This procedure is invoked when a button is pressed over the scrollbar.
+# It invokes one of several scrolling actions depending on where in
+# the scrollbar the button was pressed.
+#
+# Arguments:
+# w - The scrollbar widget.
+# element - The element of the scrollbar that was selected, such
+# as "arrow1" or "trough2". Shouldn't be "slider".
+# repeat - Whether and how to auto-repeat the action: "noRepeat"
+# 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]
+}
+
+# tkScrollButton2Down
+# This procedure is invoked when button 2 is pressed over a scrollbar.
+# If the button is over the trough or slider, it sets the scrollbar to
+# the mouse position and starts a slider drag. Otherwise it just
+# behaves the same as button 1.
+#
+# 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
+ # back to reset the actual scrollbar position before we start the
+ # slider drag.
+
+ update idletasks
+ $w configure -activerelief sunken
+ $w activate slider
+ tkScrollStartDrag $w $x $y
+}
diff --git a/tk/library/tclIndex b/tk/library/tclIndex
new file mode 100644
index 00000000000..e2cf7f1109b
--- /dev/null
+++ b/tk/library/tclIndex
@@ -0,0 +1,244 @@
+# Tcl autoload index file, version 2.0
+# This file is generated by the "auto_mkindex" command
+# and sourced to set up indexing information for one or
+# more commands. Typically each line is a command that
+# sets an element in the auto_index array, where the
+# element name is the name of a command and the value is
+# a script that loads the command.
+
+set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]
+set auto_index(tkCheckRadioEnter) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]
+set auto_index(tkCheckRadioDown) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonEnter) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonLeave) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonDown) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonUp) [list source [file join $dir button.tcl]]
+set auto_index(tkButtonInvoke) [list source [file join $dir button.tcl]]
+set auto_index(tkCheckRadioInvoke) [list source [file join $dir button.tcl]]
+set auto_index(tk_dialog) [list source [file join $dir dialog.tcl]]
+set auto_index(tkEntryClosestGap) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntryButton1) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntryMouseSelect) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntryPaste) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntryAutoScan) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntryKeySelect) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntryInsert) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntryBackspace) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntrySeeInsert) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntrySetCursor) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntryTranspose) [list source [file join $dir entry.tcl]]
+set auto_index(tkEntryPreviousWord) [list source [file join $dir entry.tcl]]
+set auto_index(tkListboxBeginSelect) [list source [file join $dir listbox.tcl]]
+set auto_index(tkListboxMotion) [list source [file join $dir listbox.tcl]]
+set auto_index(tkListboxBeginExtend) [list source [file join $dir listbox.tcl]]
+set auto_index(tkListboxBeginToggle) [list source [file join $dir listbox.tcl]]
+set auto_index(tkListboxAutoScan) [list source [file join $dir listbox.tcl]]
+set auto_index(tkListboxUpDown) [list source [file join $dir listbox.tcl]]
+set auto_index(tkListboxExtendUpDown) [list source [file join $dir listbox.tcl]]
+set auto_index(tkListboxDataExtend) [list source [file join $dir listbox.tcl]]
+set auto_index(tkListboxCancel) [list source [file join $dir listbox.tcl]]
+set auto_index(tkListboxSelectAll) [list source [file join $dir listbox.tcl]]
+set auto_index(tkMbEnter) [list source [file join $dir menu.tcl]]
+set auto_index(tkMbLeave) [list source [file join $dir menu.tcl]]
+set auto_index(tkMbPost) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuUnpost) [list source [file join $dir menu.tcl]]
+set auto_index(tkMbMotion) [list source [file join $dir menu.tcl]]
+set auto_index(tkMbButtonUp) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuMotion) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuButtonDown) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuLeave) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuInvoke) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuEscape) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuUpArrow) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuDownArrow) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuLeftArrow) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuRightArrow) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuNextMenu) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuNextEntry) [list source [file join $dir menu.tcl]]
+set auto_index(tkMenuFind) [list source [file join $dir menu.tcl]]
+set auto_index(tkTraverseToMenu) [list source [file join $dir menu.tcl]]
+set auto_index(tkFirstMenu) [list source [file join $dir menu.tcl]]
+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]]
+set auto_index(tkScrollByUnits) [list source [file join $dir scrlbar.tcl]]
+set auto_index(tkScrollByPages) [list source [file join $dir scrlbar.tcl]]
+set auto_index(tkScrollToPos) [list source [file join $dir scrlbar.tcl]]
+set auto_index(tkScrollTopBottom) [list source [file join $dir scrlbar.tcl]]
+set auto_index(tkScrollButton2Down) [list source [file join $dir scrlbar.tcl]]
+set auto_index(tkTextClosestGap) [list source [file join $dir text.tcl]]
+set auto_index(tkTextButton1) [list source [file join $dir text.tcl]]
+set auto_index(tkTextSelectTo) [list source [file join $dir text.tcl]]
+set auto_index(tkTextKeyExtend) [list source [file join $dir text.tcl]]
+set auto_index(tkTextPaste) [list source [file join $dir text.tcl]]
+set auto_index(tkTextAutoScan) [list source [file join $dir text.tcl]]
+set auto_index(tkTextSetCursor) [list source [file join $dir text.tcl]]
+set auto_index(tkTextKeySelect) [list source [file join $dir text.tcl]]
+set auto_index(tkTextResetAnchor) [list source [file join $dir text.tcl]]
+set auto_index(tkTextInsert) [list source [file join $dir text.tcl]]
+set auto_index(tkTextUpDownLine) [list source [file join $dir text.tcl]]
+set auto_index(tkTextPrevPara) [list source [file join $dir text.tcl]]
+set auto_index(tkTextNextPara) [list source [file join $dir text.tcl]]
+set auto_index(tkTextScrollPages) [list source [file join $dir text.tcl]]
+set auto_index(tkTextTranspose) [list source [file join $dir text.tcl]]
+set auto_index(tk_textCopy) [list source [file join $dir text.tcl]]
+set auto_index(tk_textCut) [list source [file join $dir text.tcl]]
+set auto_index(tk_textPaste) [list source [file join $dir text.tcl]]
+set auto_index(tkTextNextPos) [list source [file join $dir text.tcl]]
+set auto_index(tkTextPrevPos) [list source [file join $dir text.tcl]]
+set auto_index(tkScreenChanged) [list source [file join $dir tk.tcl]]
+set auto_index(tkEventMotifBindings) [list source [file join $dir tk.tcl]]
+set auto_index(tkCancelRepeat) [list source [file join $dir tk.tcl]]
+set auto_index(tkTabToWindow) [list source [file join $dir tk.tcl]]
+set auto_index(bgerror) [list source [file join $dir bgerror.tcl]]
+set auto_index(tkScaleActivate) [list source [file join $dir scale.tcl]]
+set auto_index(tkScaleButtonDown) [list source [file join $dir scale.tcl]]
+set auto_index(tkScaleDrag) [list source [file join $dir scale.tcl]]
+set auto_index(tkScaleEndDrag) [list source [file join $dir scale.tcl]]
+set auto_index(tkScaleIncrement) [list source [file join $dir scale.tcl]]
+set auto_index(tkScaleControlPress) [list source [file join $dir scale.tcl]]
+set auto_index(tkScaleButton2Down) [list source [file join $dir scale.tcl]]
+set auto_index(tk_optionMenu) [list source [file join $dir optMenu.tcl]]
+set auto_index(tkTearOffMenu) [list source [file join $dir tearoff.tcl]]
+set auto_index(tkMenuDup) [list source [file join $dir tearoff.tcl]]
+set auto_index(tk_menuBar) [list source [file join $dir obsolete.tcl]]
+set auto_index(tk_bindForTraversal) [list source [file join $dir obsolete.tcl]]
+set auto_index(tk_focusNext) [list source [file join $dir focus.tcl]]
+set auto_index(tk_focusPrev) [list source [file join $dir focus.tcl]]
+set auto_index(tkFocusOK) [list source [file join $dir focus.tcl]]
+set auto_index(tk_focusFollowsMouse) [list source [file join $dir focus.tcl]]
+set auto_index(tkConsoleInit) [list source [file join $dir console.tcl]]
+set auto_index(tkConsoleSource) [list source [file join $dir console.tcl]]
+set auto_index(tkConsoleInvoke) [list source [file join $dir console.tcl]]
+set auto_index(tkConsoleHistory) [list source [file join $dir console.tcl]]
+set auto_index(tkConsolePrompt) [list source [file join $dir console.tcl]]
+set auto_index(tkConsoleBind) [list source [file join $dir console.tcl]]
+set auto_index(tkConsoleInsert) [list source [file join $dir console.tcl]]
+set auto_index(tkConsoleOutput) [list source [file join $dir console.tcl]]
+set auto_index(tkConsoleExit) [list source [file join $dir console.tcl]]
+set auto_index(tkConsoleAbout) [list source [file join $dir console.tcl]]
+set auto_index(tk_setPalette) [list source [file join $dir palette.tcl]]
+set auto_index(tkRecolorTree) [list source [file join $dir palette.tcl]]
+set auto_index(tkDarken) [list source [file join $dir palette.tcl]]
+set auto_index(tk_bisque) [list source [file join $dir palette.tcl]]
+set auto_index(tkColorDialog) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_InitValues) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_Config) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_BuildDialog) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_SetRGBValue) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_XToRgb) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_RgbToX) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_DrawColorScale) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_CreateSelector) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_RedrawFinalColor) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_RedrawColorBars) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_StartMove) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_MoveSelector) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_ReleaseMouse) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_ResizeColorBars) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_HandleSelEntry) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_HandleRGBEntry) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_EnterColorBar) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_LeaveColorBar) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_OkCmd) [list source [file join $dir clrpick.tcl]]
+set auto_index(tkColorDialog_CancelCmd) [list source [file join $dir clrpick.tcl]]
+set auto_index(tclParseConfigSpec) [list source [file join $dir comdlg.tcl]]
+set auto_index(tclListValidFlags) [list source [file join $dir comdlg.tcl]]
+set auto_index(tclSortNoCase) [list source [file join $dir comdlg.tcl]]
+set auto_index(tclVerifyInteger) [list source [file join $dir comdlg.tcl]]
+set auto_index(tkFocusGroup_Create) [list source [file join $dir comdlg.tcl]]
+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]]
+set auto_index(tkIconList_Add) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Arrange) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Invoke) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_See) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_SelectAtXY) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Select) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Unselect) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Get) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Btn1) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Motion1) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Double1) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_ReturnKey) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Leave1) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_FocusIn) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_UpDown) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_LeftRight) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_KeyPress) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Goto) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkIconList_Reset) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_Config) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_Create) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_UpdateWhenIdle) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_Update) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_SetPathSilently) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_SetPath) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_SetFilter) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialogResolveFile) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_EntFocusIn) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_EntFocusOut) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_ActivateEnt) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_InvokeBtn) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_UpDirCmd) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_JoinFile) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_OkCmd) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_CancelCmd) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_ListBrowse) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_ListInvoke) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkFDialog_Done) [list source [file join $dir tkfbox.tcl]]
+set auto_index(tkMotifFDialog) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_Config) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_Create) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_MakeSList) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_BrowseDList) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_ActivateDList) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_BrowseFList) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_ActivateFList) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_ActivateFEnt) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_InterpFilter) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_ActivateSEnt) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_OkCmd) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_FilterCmd) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_CancelCmd) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_Update) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkMotifFDialog_LoadFiles) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkListBoxKeyAccel_Set) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkListBoxKeyAccel_Unset) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkListBoxKeyAccel_Key) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkListBoxKeyAccel_Goto) [list source [file join $dir xmfbox.tcl]]
+set auto_index(tkListBoxKeyAccel_Reset) [list source [file join $dir xmfbox.tcl]]
diff --git a/tk/library/tearoff.tcl b/tk/library/tearoff.tcl
new file mode 100644
index 00000000000..91b4ff21614
--- /dev/null
+++ b/tk/library/tearoff.tcl
@@ -0,0 +1,145 @@
+# 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.
+#
+
+# tkTearoffMenu --
+# Given the name of a menu, this procedure creates a torn-off menu
+# that is identical to the given menu (including nested submenus).
+# The new torn-off menu exists as a toplevel window managed by the
+# window manager. The return value is the name of the new menu.
+# The window is created at the point specified by x and y
+#
+# Arguments:
+# w - The menu to be torn-off (duplicated).
+# x - x coordinate where window is created
+# y - y coordinate where window is created
+
+proc tkTearOffMenu {w {x 0} {y 0}} {
+ # Find a unique name to use for the torn-off menu. Find the first
+ # ancestor of w that is a toplevel but not a menu, and use this as
+ # the parent of the new menu. This guarantees that the torn off
+ # menu will be on the same screen as the original menu. By making
+ # it a child of the ancestor, rather than a child of the menu, it
+ # can continue to live even if the menu is deleted; it will go
+ # away when the toplevel goes away.
+
+ if {$x == 0} {
+ 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 {
+ wm title $menu [$parent entrycget active -label]
+ }
+ }
+ }
+
+ $menu post $x $y
+
+ if {[winfo exists $menu] == 0} {
+ return ""
+ }
+
+ # Set tkPriv(focus) on entry: otherwise the focus will get lost
+ # after keyboard invocation of a sub-menu (it will stay on the
+ # submenu).
+
+ bind $menu <Enter> {
+ 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)
+# in a given window.
+#
+# Arguments:
+# src - Source window. Must be a menu. It and its
+# menu descendants will be duplicated at dst.
+# dst - Name to use for topmost menu in duplicate
+# hierarchy.
+
+proc tkMenuDup {src dst type} {
+ set cmd [list menu $dst -type $type]
+ foreach option [$src configure] {
+ if {[llength $option] == 2} {
+ continue
+ }
+ 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
+ }
+}
diff --git a/tk/library/text.tcl b/tk/library/text.tcl
new file mode 100644
index 00000000000..0c96f27f32c
--- /dev/null
+++ b/tk/library/text.tcl
@@ -0,0 +1,1010 @@
+# 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:
+#
+# afterId - If non-null, it means that auto-scanning is underway
+# and it gives the "after" id for the next auto-scan
+# command to be executed.
+# char - Character position on the line; kept in order
+# to allow moving up or down past short lines while
+# still remembering the desired position.
+# mouseMoved - Non-zero means the mouse has moved a significant
+# amount since the button went down (so, for example,
+# start dragging out a selection).
+# prevPos - Used when moving up or down lines via the keyboard.
+# Keeps track of the previous insert position, so
+# we can distinguish a series of ups and downs, all
+# in a row, from a new up or down.
+# selectMode - The style of selection currently underway:
+# char, word, or line.
+# x, y - Last known mouse coordinates for scanning
+# and auto-scanning.
+#-------------------------------------------------------------------------
+
+#-------------------------------------------------------------------------
+# The code below creates the default class bindings for entries.
+#-------------------------------------------------------------------------
+
+# Standard Motif bindings:
+
+bind Text <1> {
+ tkTextButton1 %W %x %y
+ %W tag remove sel 0.0 end
+}
+bind Text <B1-Motion> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ tkTextSelectTo %W %x %y
+}
+bind Text <Double-1> {
+ set tkPriv(selectMode) word
+ tkTextSelectTo %W %x %y
+ catch {%W mark set insert sel.first}
+}
+bind Text <Triple-1> {
+ set tkPriv(selectMode) line
+ tkTextSelectTo %W %x %y
+ catch {%W mark set insert sel.first}
+}
+bind Text <Shift-1> {
+ tkTextResetAnchor %W @%x,%y
+ set tkPriv(selectMode) char
+ tkTextSelectTo %W %x %y
+}
+bind Text <Double-Shift-1> {
+ set tkPriv(selectMode) word
+ tkTextSelectTo %W %x %y
+}
+bind Text <Triple-Shift-1> {
+ set tkPriv(selectMode) line
+ tkTextSelectTo %W %x %y
+}
+bind Text <B1-Leave> {
+ set tkPriv(x) %x
+ set tkPriv(y) %y
+ tkTextAutoScan %W
+}
+bind Text <B1-Enter> {
+ tkCancelRepeat
+}
+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> {
+ tkTextSetCursor %W [tkTextUpDownLine %W -1]
+}
+bind Text <Down> {
+ tkTextSetCursor %W [tkTextUpDownLine %W 1]
+}
+bind Text <Shift-Left> {
+ tkTextKeySelect %W [%W index {insert - 1c}]
+}
+bind Text <Shift-Right> {
+ tkTextKeySelect %W [%W index {insert + 1c}]
+}
+bind Text <Shift-Up> {
+ tkTextKeySelect %W [tkTextUpDownLine %W -1]
+}
+bind Text <Shift-Down> {
+ tkTextKeySelect %W [tkTextUpDownLine %W 1]
+}
+bind Text <Control-Left> {
+ tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
+}
+bind Text <Control-Right> {
+ tkTextSetCursor %W [tkTextNextWord %W insert]
+}
+bind Text <Control-Up> {
+ tkTextSetCursor %W [tkTextPrevPara %W insert]
+}
+bind Text <Control-Down> {
+ tkTextSetCursor %W [tkTextNextPara %W insert]
+}
+bind Text <Shift-Control-Left> {
+ tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
+}
+bind Text <Shift-Control-Right> {
+ tkTextKeySelect %W [tkTextNextWord %W insert]
+}
+bind Text <Shift-Control-Up> {
+ tkTextKeySelect %W [tkTextPrevPara %W insert]
+}
+bind Text <Shift-Control-Down> {
+ tkTextKeySelect %W [tkTextNextPara %W insert]
+}
+bind Text <Prior> {
+ tkTextSetCursor %W [tkTextScrollPages %W -1]
+}
+bind Text <Shift-Prior> {
+ tkTextKeySelect %W [tkTextScrollPages %W -1]
+}
+bind Text <Next> {
+ tkTextSetCursor %W [tkTextScrollPages %W 1]
+}
+bind Text <Shift-Next> {
+ tkTextKeySelect %W [tkTextScrollPages %W 1]
+}
+bind Text <Control-Prior> {
+ %W xview scroll -1 page
+}
+bind Text <Control-Next> {
+ %W xview scroll 1 page
+}
+
+bind Text <Home> {
+ tkTextSetCursor %W {insert linestart}
+}
+bind Text <Shift-Home> {
+ tkTextKeySelect %W {insert linestart}
+}
+bind Text <End> {
+ tkTextSetCursor %W {insert lineend}
+}
+bind Text <Shift-End> {
+ tkTextKeySelect %W {insert lineend}
+}
+bind Text <Control-Home> {
+ tkTextSetCursor %W 1.0
+}
+bind Text <Control-Shift-Home> {
+ tkTextKeySelect %W 1.0
+}
+bind Text <Control-End> {
+ tkTextSetCursor %W {end - 1 char}
+}
+bind Text <Control-Shift-End> {
+ tkTextKeySelect %W {end - 1 char}
+}
+
+bind Text <Tab> {
+ tkTextInsert %W \t
+ focus %W
+ break
+}
+bind Text <Shift-Tab> {
+ # Needed only to keep <Tab> binding from triggering; doesn't
+ # have to actually do anything.
+ break
+}
+bind Text <Control-Tab> {
+ focus [tk_focusNext %W]
+}
+bind Text <Control-Shift-Tab> {
+ focus [tk_focusPrev %W]
+}
+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
+}
+bind Text <Select> {
+ %W mark set anchor insert
+}
+bind Text <Control-Shift-space> {
+ set tkPriv(selectMode) char
+ tkTextKeyExtend %W insert
+}
+bind Text <Shift-Select> {
+ set tkPriv(selectMode) char
+ tkTextKeyExtend %W insert
+}
+bind Text <Control-slash> {
+ %W tag add sel 1.0 end
+}
+bind Text <Control-backslash> {
+ %W tag remove sel 1.0 end
+}
+bind Text <<Cut>> {
+ tk_textCut %W
+}
+bind Text <<Copy>> {
+ 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 {$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
+}
+bind Text <Option-Left> {
+ tkTextSetCursor %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
+}
+bind Text <Option-Right> {
+ tkTextSetCursor %W [tkTextNextWord %W insert]
+}
+bind Text <Option-Up> {
+ tkTextSetCursor %W [tkTextPrevPara %W insert]
+}
+bind Text <Option-Down> {
+ tkTextSetCursor %W [tkTextNextPara %W insert]
+}
+bind Text <Shift-Option-Left> {
+ tkTextKeySelect %W [tkTextPrevPos %W insert tcl_startOfPreviousWord]
+}
+bind Text <Shift-Option-Right> {
+ tkTextKeySelect %W [tkTextNextWord %W insert]
+}
+bind Text <Shift-Option-Up> {
+ tkTextKeySelect %W [tkTextPrevPara %W insert]
+}
+bind Text <Shift-Option-Down> {
+ tkTextKeySelect %W [tkTextNextPara %W insert]
+}
+
+# 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"
+}
+
+# tkTextButton1 --
+# This procedure is invoked to handle button-1 presses in text
+# widgets. It moves the insertion cursor, sets the selection anchor,
+# and claims the input focus.
+#
+# Arguments:
+# w - The text window in which the button was pressed.
+# x - The x-coordinate of the button press.
+# y - The x-coordinate of the button press.
+
+proc tkTextButton1 {w x y} {
+ 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
+ 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
+ update idletasks
+ }
+}
+
+# tkTextKeyExtend --
+# This procedure handles extending the selection from the keyboard,
+# where the point to extend to is really the boundary between two
+# characters rather than a particular character.
+#
+# Arguments:
+# 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
+ $w tag add sel $first $last
+ $w tag remove sel $last end
+}
+
+# tkTextPaste --
+# This procedure sets the insertion cursor to the mouse position,
+# inserts the selection, and sets the focus to the window.
+#
+# 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"
+# command so that the window continues to scroll until the mouse
+# moves back into the window or the mouse button is released.
+#
+# Arguments:
+# w - The text window.
+
+proc tkTextAutoScan {w} {
+ global tkPriv
+ if {![winfo exists $w]} return
+ if {$tkPriv(y) >= [winfo height $w]} {
+ $w yview scroll 2 units
+ } elseif {$tkPriv(y) < 0} {
+ $w yview scroll -2 units
+ } elseif {$tkPriv(x) >= [winfo width $w]} {
+ $w xview scroll 2 units
+ } elseif {$tkPriv(x) < 0} {
+ $w xview scroll -2 units
+ } else {
+ return
+ }
+ tkTextSelectTo $w $tkPriv(x) $tkPriv(y)
+ set tkPriv(afterId) [after 50 tkTextAutoScan $w]
+}
+
+# tkTextSetCursor
+# Move the insertion cursor to a given position in a text. Also
+# clears the selection, if there is one in the text, and makes sure
+# that the insertion cursor is visible. Also, don't let the insertion
+# cursor appear on the dummy last line of the text.
+#
+# 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
+ $w tag add sel $first $last
+ $w tag remove sel $last end
+ }
+ $w mark set insert $new
+ $w see insert
+ update idletasks
+}
+
+# tkTextResetAnchor --
+# Set the selection anchor to whichever end is farthest from the
+# index argument. One special trick: if the selection has two or
+# fewer characters, just leave the anchor where it is. In this
+# case it doesn't matter which point gets chosen for the anchor,
+# and for the things like Shift-Left and Shift-Right this produces
+# better behavior when the cursor moves back and forth across the
+# anchor.
+#
+# Arguments:
+# 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} {
+ set total [string length [$w get $b $c]]
+ if {$total <= 2} {
+ return
+ }
+ if {[string length [$w get $b $a]] < ($total/2)} {
+ $w mark set anchor sel.last
+ } else {
+ $w mark set anchor sel.first
+ }
+ return
+ }
+ if {($lineA-$lineB) < ($lineC-$lineA)} {
+ $w mark set anchor sel.last
+ } else {
+ $w mark set anchor sel.first
+ }
+}
+
+# tkTextInsert --
+# Insert a string into a text at the point of the insertion cursor.
+# If there is a selection in the text, and it covers the point of the
+# 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
+ }
+ }
+ $w insert insert $s
+ $w see insert
+}
+
+# tkTextUpDownLine --
+# Returns the index of the character one line above or below the
+# insertion cursor. There are two tricky things here. First,
+# we want to maintain the original column across repeated operations,
+# even though some lines that will get passed through don't have
+# enough characters to cover the original column. Second, don't
+# try to scroll past the beginning or end of the text.
+#
+# Arguments:
+# w - The text window in which the cursor is to move.
+# n - The number of lines to move: -1 for up one line,
+# +1 for down one line.
+
+proc tkTextUpDownLine {w n} {
+ 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
+}
+
+# tk_textCopy --
+# This procedure copies the selection from a text widget into the
+# clipboard.
+#
+# Arguments:
+# w - Name of a text widget.
+
+proc tk_textCopy w {
+ if {![catch {set data [$w get sel.first sel.last]}]} {
+ clipboard clear -displayof $w
+ clipboard append -displayof $w $data
+ }
+}
+
+# tk_textCut --
+# This procedure copies the selection from a text widget into the
+# clipboard, then deletes the selection (if it exists in the given
+# widget).
+#
+# Arguments:
+# w - Name of a text widget.
+
+proc tk_textCut w {
+ if {![catch {set data [$w get sel.first sel.last]}]} {
+ clipboard clear -displayof $w
+ clipboard append -displayof $w $data
+ $w delete sel.first sel.last
+ }
+}
+
+# tk_textPaste --
+# This procedure pastes the contents of the clipboard to the insertion
+# point in a text widget.
+#
+# 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
+ }
+}
+
+# tkTextNextPos --
+# Returns the index of the next position after the given starting
+# position in the text as computed by a specified function.
+#
+# Arguments:
+# w - The text window in which the cursor is to move.
+# start - Position at which to start search.
+# op - Function to use to find next position.
+
+proc tkTextNextPos {w start op} {
+ set text ""
+ set cur $start
+ while {[$w compare $cur < end]} {
+ set text "$text[$w get $cur "$cur lineend + 1c"]"
+ set pos [$op $text 0]
+ if {$pos >= 0} {
+ return [$w index "$start + $pos c"]
+ }
+ set cur [$w index "$cur lineend +1c"]
+ }
+ return end
+}
+
+# tkTextPrevPos --
+# Returns the index of the previous position before the given starting
+# position in the text as computed by a specified function.
+#
+# Arguments:
+# w - The text window in which the cursor is to move.
+# start - Position at which to start search.
+# op - Function to use to find next position.
+
+proc tkTextPrevPos {w start op} {
+ set text ""
+ set cur $start
+ while {[$w compare $cur > 0.0]} {
+ set text "[$w get "$cur linestart - 1c" $cur]$text"
+ set pos [$op $text end]
+ if {$pos >= 0} {
+ return [$w index "$cur linestart - 1c + $pos c"]
+ }
+ set cur [$w index "$cur linestart - 1c"]
+ }
+ return 0.0
+}
+
diff --git a/tk/library/tk.tcl b/tk/library/tk.tcl
new file mode 100644
index 00000000000..5d6784a46ae
--- /dev/null
+++ b/tk/library/tk.tcl
@@ -0,0 +1,192 @@
+# 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
+ }
+}
+
+# Turn off strict Motif look and feel as a default.
+
+set tk_strictMotif 0
+
+# tkScreenChanged --
+# This procedure is invoked by the binding mechanism whenever the
+# "current" screen is changing. The procedure does two things.
+# First, it uses "upvar" to make global variable "tkPriv" point at an
+# array variable that holds state for the current display. Second,
+# it initializes the array if it didn't already exist.
+#
+# 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) {}
+}
+
+# Do initial setup for tkPriv, so that it is always bound to something
+# (otherwise, if someone references it, it may get set to a non-upvar-ed
+# value, which will cause trouble later).
+
+tkScreenChanged [winfo screen .]
+
+# tkEventMotifBindings --
+# This procedure is invoked as a trace whenever tk_strictMotif is
+# changed. It is used to turn on or turn off the motif virtual
+# bindings.
+#
+# 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>
+ 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 {$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]}
+bind all <Shift-Tab> {tkTabToWindow [tk_focusPrev %W]}
+
+# tkCancelRepeat --
+# This procedure is invoked to cancel an auto-repeat action described
+# by tkPriv(afterId). It's used by several widgets to auto-scroll
+# the widget when the mouse is dragged out of the widget with a
+# button pressed.
+#
+# Arguments:
+# None.
+
+proc tkCancelRepeat {} {
+ global tkPriv
+ after cancel $tkPriv(afterId)
+ set tkPriv(afterId) {}
+}
+
+# tkTabToWindow --
+# 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
+}
diff --git a/tk/library/tkfbox.tcl b/tk/library/tkfbox.tcl
new file mode 100644
index 00000000000..e9025418518
--- /dev/null
+++ b/tk/library/tkfbox.tcl
@@ -0,0 +1,1665 @@
+# 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.
+#
+
+#----------------------------------------------------------------------
+#
+# I C O N L I S T
+#
+# This is a pseudo-widget that implements the icon list inside the
+# tkFDialog dialog box.
+#
+#----------------------------------------------------------------------
+
+# tkIconList --
+#
+# Creates an IconList widget.
+#
+proc tkIconList {w args} {
+ upvar #0 $w data
+
+ tkIconList_Config $w $args
+ tkIconList_Create $w
+}
+
+# tkIconList_Config --
+#
+# Configure the widget variables of IconList, according to the command
+# line arguments.
+#
+proc tkIconList_Config {w argList} {
+ upvar #0 $w data
+
+ # 1: the configuration specs
+ #
+ set specs {
+ {-browsecmd "" "" ""}
+ {-command "" "" ""}
+ {-multiple "" "" "0"}
+ }
+
+ # 2: parse the arguments
+ #
+ tclParseConfigSpec $w $specs "" $argList
+}
+
+# tkIconList_Create --
+#
+# Creates an IconList widget by assembling a canvas widget and a
+# scrollbar widget. Sets all the bindings necessary for the IconList's
+# operations.
+#
+proc tkIconList_Create {w} {
+ upvar #0 $w data
+
+ frame $w
+ set data(sbar) [scrollbar $w.sbar -orient horizontal \
+ -highlightthickness 0 -takefocus 0]
+ set data(canvas) [canvas $w.canvas -bd 2 -relief sunken \
+ -width 400 -height 120 -takefocus 1]
+ pack $data(sbar) -side bottom -fill x -padx 2
+ pack $data(canvas) -expand yes -fill both
+
+ $data(sbar) config -command "$data(canvas) xview"
+ $data(canvas) config -xscrollcommand "$data(sbar) set"
+
+ # Initializes the max icon/text width and height and other variables
+ #
+ set data(maxIW) 1
+ set data(maxIH) 1
+ set data(maxTW) 1
+ set data(maxTH) 1
+ set data(numItems) 0
+ set data(curItem) {}
+ set data(noScroll) 1
+
+ # 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) <Shift-1> "tkIconList_ShiftBtn1 $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"
+ bind $data(canvas) <Control-KeyPress> ";"
+ bind $data(canvas) <Alt-KeyPress> ";"
+
+ bind $data(canvas) <FocusIn> "tkIconList_FocusIn $w"
+
+ return $w
+}
+
+# tkIconList_AutoScan --
+#
+# 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
+# itself as an "after" command so that the window continues to scroll until
+# the mouse moves back into the window or the mouse button is released.
+#
+# Arguments:
+# w - The IconList window.
+#
+proc tkIconList_AutoScan {w} {
+ 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)]} {
+ # do nothing
+ } elseif {$y < 0} {
+ # do nothing
+ } else {
+ return
+ }
+
+ tkIconList_Motion1 $w $x $y
+ set tkPriv(afterId) [after 50 tkIconList_AutoScan $w]
+}
+
+# Deletes all the items inside the canvas subwidget and reset the IconList's
+# state.
+#
+proc tkIconList_DeleteAll {w} {
+ upvar #0 $w data
+ upvar #0 $w:itemList itemList
+
+ $data(canvas) delete all
+ catch {unset data(selected)}
+ catch {unset data(rect)}
+ catch {unset data(list)}
+ catch {unset itemList}
+ set data(maxIW) 1
+ set data(maxIH) 1
+ set data(maxTW) 1
+ set data(maxTH) 1
+ set data(numItems) 0
+ set data(curItem) {}
+ set data(noScroll) 1
+ $data(sbar) set 0.0 1.0
+ $data(canvas) xview moveto 0
+}
+
+# Adds an icon into the IconList with the designated image and text
+#
+proc tkIconList_Add {w image text} {
+ upvar #0 $w data
+ upvar #0 $w:itemList itemList
+ upvar #0 $w:textList textList
+
+ 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) [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}] ; # *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_AddSelectAtXY {w x y {no_delete 0}} {
+ upvar #0 $w data
+
+ if {$data(-multiple) && [info exists data(selected)]} {
+ tkIconList_AddSelect $w [$data(canvas) find closest \
+ [$data(canvas) canvasx $x] [$data(canvas) canvasy $y]] \
+ 1 $no_delete
+ return
+ }
+ tkIconList_SelectAtXY $w $x $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 {$data(-multiple) && [info exists data(rect)]} {
+ foreach r $data(rect) {
+ $data(canvas) delete $r
+ }
+ unset data(rect)
+ }
+ 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
+
+ #we can't set the text to data(selected) as text, this is bugy,
+ #when the path contains blanks
+ if {$data(-multiple)} {
+ catch {unset data(selected)}
+ lappend data(selected) $text
+ } else {
+ set data(selected) $text
+ }
+
+ if {$callBrowse} {
+ if [string compare $data(-browsecmd) ""] {
+ eval $data(-browsecmd) [list $data(selected)]
+ }
+ }
+}
+
+proc tkIconList_AddSelect {w rTag {callBrowse 1} {no_delete 0}} {
+ 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 {[lsearch -exact $data(selected) $text] != -1} {
+ if {$no_delete} {
+ return
+ }
+
+ # we've clicked on an existing item, so we need to remove it
+ set i [lsearch -exact $data(selected) $text]
+ set data(selected) [lreplace $data(selected) $i $i]
+
+ # find the appropriate coordinates and remove the
+ # corresponding rectangle.
+ set tmpbbox [$data(canvas) bbox $tTag]
+ for {set i 0} {$i<[llength $data(rect)]} {incr i} {
+ set rectTag [lindex $data(rect) $i]
+ set testbbox [$data(canvas) coords $rectTag]
+ # test first two coordinates; if they're the same the
+ # entire box should match
+ if {[lindex $testbbox 0]==[lindex $tmpbbox 0] && \
+ [lindex $testbbox 1]==[lindex $tmpbbox 1]} {
+ $data(canvas) delete $rectTag
+ set data(rect) [lreplace $data(rect) $i $i]
+ break
+ }
+ }
+
+ if {$callBrowse} {
+ if [string compare $data(-browsecmd) ""] {
+ eval $data(-browsecmd) [list $data(selected)]
+ }
+ }
+ return
+ }
+
+ set tmprect [$data(canvas) create rect 0 0 0 0 \
+ -fill #a0a0ff -outline #a0a0ff]
+ lappend data(rect) $tmprect
+
+ $data(canvas) lower $tmprect
+ set bbox [$data(canvas) bbox $tTag]
+ eval $data(canvas) coords $tmprect $bbox
+
+ set data(curItem) $serial
+ lappend data(selected) $text
+
+ if {$callBrowse} {
+ if [string compare $data(-browsecmd) ""] {
+ eval $data(-browsecmd) [list $data(selected)]
+ }
+ }
+}
+
+proc tkIconList_Unselect {w} {
+ upvar #0 $w data
+
+ if [info exists data(rect)] {
+ foreach r $data(rect) {
+ $data(canvas) delete $r
+ }
+ 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 ""
+ }
+}
+
+
+proc tkIconList_Btn1 {w x y} {
+ upvar #0 $w data
+
+ focus $data(canvas)
+ tkIconList_SelectAtXY $w $x $y
+}
+
+proc tkIconList_ShiftBtn1 {w x y} {
+ upvar #0 $w data
+
+ focus $data(canvas)
+ tkIconList_AddSelectAtXY $w $x $y
+}
+
+# Gets called on button-1 motions
+#
+proc tkIconList_Motion1 {w x y} {
+ global tkPriv
+ set tkPriv(x) $x
+ set tkPriv(y) $y
+
+ tkIconList_AddSelectAtXY $w $x $y 1
+}
+
+proc tkIconList_Double1 {w x y} {
+ upvar #0 $w data
+
+ if {$data(curItem) != {}} {
+ tkIconList_Invoke $w
+ }
+}
+
+proc tkIconList_ReturnKey {w} {
+ tkIconList_Invoke $w
+}
+
+proc tkIconList_Leave1 {w x y} {
+ global tkPriv
+
+ set tkPriv(x) $x
+ 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
+#----------------------------------------------------------------------
+
+# tkIconList_KeyPress --
+#
+# Gets called when user enters an arbitrary key in the listbox.
+#
+proc tkIconList_KeyPress {w key} {
+ global tkPriv
+
+ append tkPriv(ILAccel,$w) $key
+ tkIconList_Goto $w $tkPriv(ILAccel,$w)
+ catch {
+ after cancel $tkPriv(ILAccel,$w,afterId)
+ }
+ set tkPriv(ILAccel,$w,afterId) [after 500 tkIconList_Reset $w]
+}
+
+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} {
+ set theIndex $i
+ break
+ }
+ incr i
+ if {$i == $data(numItems)} {
+ set i 0
+ }
+ if {$i == $start} {
+ break
+ }
+ }
+
+ if {$theIndex > -1} {
+ set rTag [lindex [lindex $data(list) $theIndex] 2]
+ tkIconList_Select $w $rTag 0
+ tkIconList_See $w $rTag
+ }
+}
+
+proc tkIconList_Reset {w} {
+ global tkPriv
+
+ catch {unset tkPriv(ILAccel,$w)}
+}
+
+#----------------------------------------------------------------------
+#
+# F I L E D I A L O G
+#
+#----------------------------------------------------------------------
+
+# 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
+ global __old_dialog
+ global __old_multiple
+ 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
+ }
+
+ #because tk doesn't use window-path dependent array, it is
+ #impossible to use more than one dialog box at the same time,
+ #so we have to recreate the dialog!
+ if {[info exists __old_dialog] \
+ && ($__old_dialog != $w || $__old_multiple != $data(-multiple))} {
+ catch {destroy $w}
+ catch {destroy $__old_dialog}
+ }
+ set __old_dialog $w
+ set __old_multiple $data(-multiple)
+
+ # (re)create the dialog box if necessary
+ #
+ set new_dialog 0
+ if {![winfo exists $w]} {
+ tkFDialog_Create $w
+ set new_dialog 1
+ } elseif {[string compare [winfo class $w] TkFDialog]} {
+ destroy $w
+ tkFDialog_Create $w
+ set new_dialog 1
+ } 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
+ trace variable data(selectPath) w "tkFDialog_SetPath $w"
+
+ # 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.
+
+ if {$new_dialog} {
+ #center dialog, when it has been new created
+ 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 title $w $data(-title)
+ 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
+ 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
+ }
+ }
+ #delete the tracer, because this conflicts with multiple
+ #used dialogs
+ trace vdelete data(selectPath) w "tkFDialog_SetPath $w"
+ 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 "" "" ""}
+ }
+ if ![string compare $type open] {
+ # CYGNUS LOCAL: Handle -choosedir.
+ # Note: the -choosedir option is a Cygnus extension. It is not
+ # documented since it only works on Unix -- it is an
+ # implementation detail of the directory-choosing code in
+ # in libgui.
+ lappend specs {-multiple "" "" "0"} {-choosedir "" "" "0"}
+ # END CYGNUS LOCAL
+ }
+
+ # 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
+ #
+ # Khamis 16-04-98
+ # When the path contains blanks, glob returns an item in a list, but
+ # data(selectPath) must be an item and not a list of items, so we
+ # must extract the item from the returned list.
+ if {[string compare $data(-initialdir) ""]} {
+ if {[file isdirectory $data(-initialdir)]} {
+ #khamis: Join result of glob to an item
+ 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)\""
+ }
+
+ # Set -multiple to a one or zero value (not other boolean types
+ # like "yes") so we can use it in tests easier.
+ if {![string compare $type save]} {
+ set data(-multiple) 0
+ # CYGNUS LOCAL: choosedir
+ # Handle -choosedir here as well.
+ set data(-choosedir) 0
+ # END CYGNUS LOCAL
+ } else {
+ if {$data(-multiple)} {
+ set data(-multiple) 1
+ }
+ }
+}
+
+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,
+ 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01, 0x10, 0x02, 0x00, 0x01,
+ 0x10, 0xfe, 0x07, 0x01, 0x10, 0x00, 0x00, 0x01, 0x10, 0x00, 0x00, 0x01,
+ 0xf0, 0xff, 0xff, 0x01};}]
+ }
+ $data(upBtn) config -image $tkPriv(updirImage)
+
+ $f1.menu config -takefocus 1 -highlightthickness 2
+
+ pack $data(upBtn) -side right -padx 4 -fill both
+ 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" \
+ -multiple "$data(-multiple)"]
+
+ # 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
+ if {$data(-multiple)} {
+ $f2.lab config -text "File names:"
+ }
+ set data(ent) [entry $f2.ent]
+
+ # The font to use for the icons. The default Canvas font on Unix
+ # is just deviant.
+ global $w.icons
+ set $w.icons(font) [$data(ent) cget -font]
+
+ # f3: the frame with the cancel button and the file types field
+ #
+ set f3 [frame $w.f3 -bd 0]
+
+ # The "File of types:" label needs to be grayed-out when
+ # -filetypes are not specified. The label widget does not support
+ # grayed-out text on monochrome displays. Therefore, we have to
+ # use a button widget to emulate a label widget (by setting its
+ # bindtags)
+
+ set data(typeMenuLab) [button $f3.lab -text "Files of type:" \
+ -anchor e -width 14 -under 9 \
+ -bd [$f2.lab cget -bd] \
+ -highlightthickness [$f2.lab cget -highlightthickness] \
+ -relief [$f2.lab cget -relief] \
+ -padx [$f2.lab cget -padx] \
+ -pady [$f2.lab cget -pady]]
+ bindtags $data(typeMenuLab) [list $data(typeMenuLab) Label \
+ [winfo toplevel $data(typeMenuLab)] all]
+
+ set data(typeMenuBtn) [menubutton $f3.menu -indicatoron 1 -menu $f3.menu.m]
+ set data(typeMenu) [menu $data(typeMenuBtn).m -tearoff 0]
+ $data(typeMenuBtn) config -takefocus 1 -highlightthickness 2 \
+ -relief raised -bd 2 -anchor w
+
+ # the okBtn is created after the typeMenu so that the keyboard traversal
+ # is in the right order
+ set data(okBtn) [button $f2.ok -text OK -under 0 -width 6 \
+ -default active -pady 3]
+ set data(cancelBtn) [button $f3.cancel -text Cancel -under 0 -width 6\
+ -default normal -pady 3]
+
+ # pack the widgets in f2 and f3
+ #
+ pack $data(okBtn) -side right -padx 4 -anchor e
+ pack $f2.lab -side left -padx 4
+ pack $f2.ent -expand yes -fill x -padx 2 -pady 0
+
+ pack $data(cancelBtn) -side right -padx 4 -anchor w
+ pack $data(typeMenuLab) -side left -padx 4
+ pack $data(typeMenuBtn) -expand yes -fill x -side right
+
+ # Pack all the frames together. We are done with widget construction.
+ #
+ pack $f1 -side top -fill x -pady 4
+ pack $f3 -side bottom -fill x
+ pack $f2 -side bottom -fill x
+ pack $data(icons) -expand yes -fill both -padx 4 -pady 1
+
+ # Set up the event handlers
+ #
+ 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)"
+ bind $w <KeyPress-Escape> "tkButtonInvoke $data(cancelBtn)"
+ bind $w <Alt-c> "tkButtonInvoke $data(cancelBtn)"
+ bind $w <Alt-o> "tkFDialog_InvokeBtn $w Open"
+ bind $w <Alt-s> "tkFDialog_InvokeBtn $w Save"
+
+ wm protocol $w WM_DELETE_WINDOW "tkFDialog_CancelCmd $w"
+
+ # Build the focus group for all the entries
+ #
+ tkFocusGroup_Create $w
+ tkFocusGroup_BindIn $w $data(ent) "tkFDialog_EntFocusIn $w"
+ tkFocusGroup_BindOut $w $data(ent) "tkFDialog_EntFocusOut $w"
+}
+
+# tkFDialog_UpdateWhenIdle --
+#
+# Creates an idle event handler which updates the dialog in idle
+# 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
+ cd $appPWD
+ return
+ }
+
+ # Turn on the busy cursor. BUG?? We haven't disabled X events, though,
+ # so the user may still click and cause havoc ...
+ #
+ set entCursor [$data(ent) cget -cursor]
+ set dlgCursor [$w cget -cursor]
+ $data(ent) config -cursor watch
+ $w config -cursor watch
+ 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)
+
+ # Update the Directory: option menu
+ #
+ set list ""
+ set dir ""
+ foreach subdir [file split $data(selectPath)] {
+ set dir [file join $dir $subdir]
+ lappend list $dir
+ }
+
+ $data(dirMenu) delete 0 end
+ set var [format %s(selectPath) $dataName]
+ 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} {
+ 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
+
+ set data(filter) [lindex $type 1]
+ $data(typeMenuBtn) config -text [lindex $type 0] -indicatoron 1
+
+ $icons(sbar) set 0.0 0.0
+
+ tkFDialog_UpdateWhenIdle $w
+}
+
+# tkFDialogResolveFile --
+#
+# Interpret the user's text input in a file selection dialog.
+# Performs:
+#
+# (1) ~ substitution
+# (2) resolve all instances of . and ..
+# (3) check for non-existent files/directories
+# (4) check for chdir permissions
+#
+# Arguments:
+# context: the current directory you are in
+# text: the text entered by the user
+# defaultext: the default extension to add to files with no extension
+#
+# Return vaue:
+# [list $flag $directory $file]
+#
+# flag = OK : valid input
+# = PATTERN : valid directory/pattern
+# = PATH : the directory does not exist
+# = FILE : the directory exists by the file doesn't
+# exist
+# = CHDIR : Cannot change to the directory
+# = ERROR : Invalid entry
+#
+# directory : valid only if flag = OK or PATTERN or FILE
+# file : valid only if flag = OK or PATTERN
+#
+# directory may not be the same as context, because text may contain
+# a subdirectory name
+#
+proc tkFDialogResolveFile {context text defaultext} {
+
+ set appPWD [pwd]
+
+ 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
+ set file [file tail $path]
+ set flag PATH
+ }
+ }
+
+ return [list $flag $directory $file]
+}
+
+
+# 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} {
+ upvar #0 [winfo name $w] data
+
+ $data(ent) selection clear
+}
+
+
+# Verification procedure
+proc tkFDialog_VerifyFileName { w fname } {
+ upvar #0 [winfo name $w] data
+
+ set list [tkFDialogResolveFile $data(selectPath) $fname \
+ $data(-defaultextension)]
+ set flag [lindex $list 0]
+ set path [lindex $list 1]
+ set file [lindex $list 2]
+
+ case $flag {
+ OK {
+ if {![string compare $file ""]} {
+ tkFDialog_SetPathSilently $w [file dirname $path]
+ # CYGNUS LOCAL: handle choosedir
+ if {$data(-choosedir)} {
+ if {$data(-multiple)} {
+ lappend data(selectFile) [file tail $path]
+ } else {
+ set data(selectFile) [file tail $path]
+ }
+ tkFDialog_Done $w
+ } else {
+ # user has entered an existing (sub)directory
+ set data(selectPath) $path
+ $data(ent) delete 0 end
+ }
+ } else {
+ tkFDialog_SetPathSilently $w $path
+ if {$data(-multiple)} {
+ lappend data(selectFile) $file
+ } else {
+ 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
+ if {$data(-multiple)} {
+ lappend data(selectFile) $file
+ } else {
+ set data(selectFile) $file
+ }
+ tkFDialog_Done $w
+ }
+ }
+ PATH {
+ tk_messageBox -icon warning -type ok -parent $data(-parent) \
+ -message "Directory \"$path\" does not exist."
+ $data(ent) select from 0
+ $data(ent) select to end
+ $data(ent) icursor end
+ }
+ CHDIR {
+ tk_messageBox -type ok -parent $data(-parent) -message \
+ "Cannot change to the directory \"$path\".\nPermission denied."\
+ -icon warning
+ $data(ent) select from 0
+ $data(ent) select to end
+ $data(ent) icursor end
+ }
+ ERROR {
+ tk_messageBox -type ok -parent $data(-parent) -message \
+ "Invalid file name \"$path\"."\
+ -icon warning
+ $data(ent) select from 0
+ $data(ent) select to end
+ $data(ent) icursor end
+ }
+ }
+}
+
+# Gets called when user presses Return in the "File name" entry.
+#
+proc tkFDialog_ActivateEnt {w} {
+ upvar #0 [winfo name $w] data
+
+ #set text [string trim [$data(ent) get]]
+ set text [$data(ent) get]
+ if {$data(-multiple)} {
+ set data(selectFile) ""
+ foreach fname $text {
+ tkFDialog_VerifyFileName $w $fname
+ }
+ } else {
+ tkFDialog_VerifyFileName $w $text
+ }
+}
+
+# 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 ~
+#
+proc tkFDialog_JoinFile {path file} {
+ if {[string match {~*} $file] && [file exists $path/$file]} {
+ return [file join $path ./$file]
+ } else {
+ return [file join $path $file]
+ }
+}
+
+
+
+# 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 ""]} {
+ if {!$data(-multiple)} {
+ set file [tkFDialog_JoinFile $data(selectPath) $text]
+ # CYGNUS LOCAL: handle choosedir
+ if {!$data(-choosedir) && [file isdirectory $file]} {
+ tkFDialog_ListInvoke $w $text
+ return
+ }
+ }
+ }
+
+ tkFDialog_ActivateEnt $w
+}
+
+# Gets called when user presses the "Cancel" button
+#
+proc tkFDialog_CancelCmd {w} {
+ upvar #0 [winfo name $w] data
+ global tkPriv
+
+ set tkPriv(selectFilePath) ""
+}
+
+# Gets called when user browses the IconList widget (dragging mouse, arrow
+# keys, etc)
+#
+proc tkFDialog_ListBrowse {w text} {
+ upvar #0 [winfo name $w] data
+
+ if {$text == ""} {
+ return
+ }
+
+ set file [tkFDialog_JoinFile $data(selectPath) $text]
+ # CYGNUS LOCAL: handle choosedir
+ if {$data(-choosedir) || ![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"
+ }
+}
+
+# Gets called when user invokes the IconList widget (double-click,
+# Return key, etc)
+#
+proc tkFDialog_ListInvoke {w text} {
+ upvar #0 [winfo name $w] data
+
+ if {$text == ""} {
+ return
+ }
+
+ if {$data(-multiple)} {
+ set file [tkFDialog_JoinFile $data(selectPath) [lindex $text 0]]
+ } else {
+ 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
+ }
+ } else {
+ if {$data(-multiple)} {
+ set data(selectFile) [list $file]
+ } else {
+ set data(selectFile) $file
+ }
+ tkFDialog_Done $w
+ }
+}
+
+# tkFDialog_Done --
+#
+# Gets called when user has input a valid filename. Pops up a
+# dialog box to confirm selection when necessary. Sets the
+# tkPriv(selectFilePath) variable, which will break the "tkwait"
+# 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 ""]} {
+ if {$data(-multiple)} {
+ set selectFilePath {}
+ foreach f $data(selectFile) {
+ lappend selectFilePath [file join $data(selectPath) $f]
+ }
+ } else {
+ 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
+}
+
diff --git a/tk/library/xmfbox.tcl b/tk/library/xmfbox.tcl
new file mode 100644
index 00000000000..e4d4aeeb6ef
--- /dev/null
+++ b/tk/library/xmfbox.tcl
@@ -0,0 +1,650 @@
+# 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
+ } 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
+
+ # 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 {
+ 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)\""
+ }
+}
+
+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
+
+ set f1 [frame $top.f1]
+ set f2 [frame $top.f2]
+ set f3 [frame $top.f3]
+
+ pack $f1 -side top -fill x
+ pack $f3 -side bottom -fill x
+ pack $f2 -expand yes -fill both
+
+ set f2a [frame $f2.a]
+ set f2b [frame $f2.b]
+
+ grid $f2a -row 0 -column 0 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
+ -sticky news
+ grid $f2b -row 0 -column 1 -rowspan 1 -columnspan 1 -padx 4 -pady 4 \
+ -sticky news
+ grid rowconfig $f2 0 -minsize 0 -weight 1
+ grid columnconfig $f2 0 -minsize 0 -weight 1
+ grid columnconfig $f2 1 -minsize 150 -weight 2
+
+ # The Filter box
+ #
+ label $f1.lab -text "Filter:" -under 3 -anchor w
+ entry $f1.ent
+ pack $f1.lab -side top -fill x -padx 6 -pady 4
+ pack $f1.ent -side top -fill x -padx 4 -pady 0
+ set data(fEnt) $f1.ent
+
+ # The file and directory lists
+ #
+ set data(dList) [tkMotifFDialog_MakeSList $w $f2a Directory: 0 DList]
+ set data(fList) [tkMotifFDialog_MakeSList $w $f2b Files: 2 FList]
+
+ # The Selection box
+ #
+ label $f3.lab -text "Selection:" -under 0 -anchor w
+ entry $f3.ent
+ pack $f3.lab -side top -fill x -padx 6 -pady 0
+ pack $f3.ent -side top -fill x -padx 4 -pady 4
+ set data(sEnt) $f3.ent
+
+ # The buttons
+ #
+ set data(okBtn) [button $bot.ok -text OK -width 6 -under 0 \
+ -command "tkMotifFDialog_OkCmd $w"]
+ set data(filterBtn) [button $bot.filter -text Filter -width 6 -under 0 \
+ -command "tkMotifFDialog_FilterCmd $w"]
+ set data(cancelBtn) [button $bot.cancel -text Cancel -width 6 -under 0 \
+ -command "tkMotifFDialog_CancelCmd $w"]
+
+ pack $bot.ok $bot.filter $bot.cancel -padx 10 -pady 10 -expand yes \
+ -side left
+
+ # Create the bindings:
+ #
+ bind $w <Alt-t> "focus $data(fEnt)"
+ bind $w <Alt-d> "focus $data(dList)"
+ bind $w <Alt-l> "focus $data(fList)"
+ bind $w <Alt-s> "focus $data(sEnt)"
+
+ bind $w <Alt-o> "tkButtonInvoke $bot.ok "
+ bind $w <Alt-f> "tkButtonInvoke $bot.filter"
+ bind $w <Alt-c> "tkButtonInvoke $bot.cancel"
+
+ 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 \
+ -command "$f.l xview"
+ grid $f.lab -row 0 -column 0 -sticky news -rowspan 1 -columnspan 2 \
+ -padx 2 -pady 2
+ grid $f.l -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
+ grid $f.v -row 1 -column 1 -rowspan 1 -columnspan 1 -sticky news
+ grid $f.h -row 2 -column 0 -rowspan 1 -columnspan 1 -sticky news
+
+ 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
+ set tkPriv(selectPath) $selectPath
+}
+
+
+proc tkMotifFDialog_OkCmd {w} {
+ upvar #0 [winfo name $w] data
+
+ tkMotifFDialog_ActivateSEnt $w
+}
+
+proc tkMotifFDialog_FilterCmd {w} {
+ upvar #0 [winfo name $w] data
+
+ tkMotifFDialog_ActivateFEnt $w
+}
+
+proc tkMotifFDialog_CancelCmd {w} {
+ 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 isdirectory $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 {
+ after cancel $tkPriv(lbAccel,$w,afterId)
+ }
+ set tkPriv(lbAccel,$w,afterId) [after 500 tkListBoxKeyAccel_Reset $w]
+}
+
+proc tkListBoxKeyAccel_Goto {w string} {
+ global tkPriv
+
+ set string [string tolower $string]
+ set end [$w index end]
+ set theIndex -1
+
+ for {set i 0} {$i < $end} {incr i} {
+ set item [string tolower [$w get $i]]
+ if {[string compare $string $item] >= 0} {
+ set theIndex $i
+ }
+ if {[string compare $string $item] <= 0} {
+ set theIndex $i
+ break
+ }
+ }
+
+ if {$theIndex >= 0} {
+ $w selection clear 0 end
+ $w selection set $theIndex $theIndex
+ $w activate $theIndex
+ $w see $theIndex
+ }
+}
+
+proc tkListBoxKeyAccel_Reset {w} {
+ global tkPriv
+
+ catch {unset tkPriv(lbAccel,$w)}
+}
+
diff --git a/tk/license.terms b/tk/license.terms
new file mode 100644
index 00000000000..03ca6fcb319
--- /dev/null
+++ b/tk/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., and other parties. The following
+terms apply to all files associated with the software unless explicitly
+disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
diff --git a/tk/mac/MW_TkHeader.pch b/tk/mac/MW_TkHeader.pch
new file mode 100644
index 00000000000..448025b3dda
--- /dev/null
+++ b/tk/mac/MW_TkHeader.pch
@@ -0,0 +1,59 @@
+/*
+ * MW_TkHeader.pch --
+ *
+ * This file is the source for a pre-compilied header that gets used
+ * for all files in the Tk projects. This make compilies go a bit
+ * faster. This file is only intended to be used in the MetroWerks
+ * CodeWarrior environment. It essentially acts as a place to set
+ * 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$
+ */
+
+/*
+ * 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
diff --git a/tk/mac/README b/tk/mac/README
new file mode 100644
index 00000000000..a906e91b367
--- /dev/null
+++ b/tk/mac/README
@@ -0,0 +1,306 @@
+Tk 8.0.4 for Macintosh
+
+by Ray Johnson
+Scriptics Corporation
+rjohnson@scriptics.com
+with major help from
+Jim Ingham
+Cygnus Solutions
+jingham@cygnus.com
+
+RCS: @(#) $Id$
+
+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. Doing this is discouraged under Appearance, and we will probably
+not implement it anytime soon.
+
+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 <icepick@eng.sun.com> is
+the author of the new menu code. Feel free to contact him if you
+have questions or comments about the menu mechanism.
+
+As of Tk 8.0.4, MacTk menus will adopt the backgrounds, shape, separator, etc
+of the current theme.
+
+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.
+
+* The menu command has special rules for accessing the Macintosh
+ Apple and Help menus. See the menu.m man page for details.
+
+* If you have the special Tcl function "tkAboutDialog" defined, it
+ will be called instead of displaying the default About Box in the
+ console or other parts of the Wish application. See below for
+ details.
+
+* In addition to the standard X cursors, the Mac version of Tk will
+ let you use any Mac cursor that is named and installed in your
+ application. See the GetCursor.3 man page for details.
+
+* The wish application has a couple of hooks to know about the exit,
+ "open document" and "Do Script" Mac High Level events.
+ See below for details.
+
+* The command unsupported1 will allow you to set the style of new
+ 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.4.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.4.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.4.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.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)
+ 8.0.4 was build with CW Pro 3.
+ 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.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
+---------------
+
+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
+recieve apple events. However, there are a couple of hooks for
+dealing with some of the standard apple events.
+
+ exit - Generally, Tcl cleans up after it self when you exit.
+ However, your application may want to do application specifc
+ cleanup like saving a users data. To do this you can rename
+ the exit command to something else. Define your own exit
+ command to do whatever clean up you like and then call the
+ origional exit command. For example,
+
+ rename exit __exit
+ proc exit {} {
+ # Do your clean up hear
+ __exit
+ }
+
+ Both incoming quit events and hitting the Quit menu item
+ will call the exit command. However, don't expect you can
+ abort the exit. Tk may exit anyway if the exit command it
+ calls does not actually quit the application.
+
+ open - The other apple event Tk supports is the open event. The
+ open event is sent to Tk if, for example, you drop a file on
+ the Wish icon. If you define a Tcl procedure with the name
+ "tkOpenDocument" it will be invoked on any Open Document
+ events that the application receives. The a list of paths to
+ the various documents will be passed to the Tcl function.
+ Here is an example,
+
+ proc tkOpenDocument args {
+ foreach file $args {
+ # Deal with passed in file path
+ }
+ }
+
+ Note: This isn't every thing you need to do to make your
+ application dropable. You must still define a FREF resource
+ that makes sense for your application domain. (Out of the
+ box, you will not be able to drop files on the Wish
+ application. See the Inside Macintosh documentation for
+ details about the FREF resource.
+
+ do script - This is a way for external applications to drive MacTk, or
+ to recieve information from it. From AppleScript, you can say:
+
+ tell application "Wish8.0"
+ do script "console hide
+ pack [button .b1 -text {Hello world} -command exit]"
+ end tell
+
+ which will get Tk to run the canonical hello world application.
+
+8. unsupported1
+---------------
+
+The unsupported1 command is a short term hack we made available to
+allow you to set the window style of a new toplevel window. It works
+much like the "wm overrideredirect" and "wm transient" commands in
+that it must be run before the window it's being applied to is mapped.
+
+The syntax of the command is as follows:
+
+ unsupported1 style <window> ?style?
+
+The <window> must be a toplevel window. If the style is not given
+then the current style for the window is returned. If you want to set
+the style you must do so before the window gets mapped for the first
+time. The possible window styles include:
+
+ documentProc, dBoxProc, plainDBox, altDBoxProc,
+ movableDBoxProc, zoomDocProc, rDocProc, floatProc,
+ floatZoomProc, floatSideProc, or floatSideZoomProc
+
+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
diff --git a/tk/mac/bugs.doc b/tk/mac/bugs.doc
new file mode 100644
index 00000000000..f6d88aa1c9d
--- /dev/null
+++ b/tk/mac/bugs.doc
@@ -0,0 +1,45 @@
+Known bug list for Tk 8.0 for Macintosh
+
+by Ray Johnson
+Sun Microsystems Laboratories
+rjohnson@eng.sun.com
+
+RCS: @(#) $Id$
+
+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:
+
+* Transient windows (set by wm transient) do not go away when the
+ master does.
+
+* Tearoff menus should be floating windows & floating windows should
+ float. They also shouldn't be resizable.
+
+* The -use and -container windows only work with other Tk windows in
+ 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.
+
+* 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
diff --git a/tk/mac/license.terms b/tk/mac/license.terms
new file mode 100644
index 00000000000..03ca6fcb319
--- /dev/null
+++ b/tk/mac/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., and other parties. The following
+terms apply to all files associated with the software unless explicitly
+disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
diff --git a/tk/mac/tclets.tcl b/tk/mac/tclets.tcl
new file mode 100644
index 00000000000..380ad260089
--- /dev/null
+++ b/tk/mac/tclets.tcl
@@ -0,0 +1,215 @@
+# 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$
+#
+# 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.
+#
+
+# tkOpenDocument --
+#
+# This procedure is a called whenever Wish recieves an "Open" event. The
+# procedure must be named tkOpenDocument for this to work. Passed in files
+# are assumed to be Tcl files that the user wants to be made into Tclets.
+# (Only the first one is used.) The procedure then creates a copy of the
+# stub app and places the Tcl file in the new application's resource fork.
+#
+# Parameters:
+# args List of files
+#
+# Results:
+# One success a new Tclet is created.
+
+proc tkOpenDocument {args} {
+ global droped_to_start
+
+ # We only deal with the one file droped on the App
+ set tclFile [lindex $args 0]
+ set stub [GetStub]
+
+ # Give a helper screen to guide user
+ toplevel .helper -menu .bar
+ unsupported1 style .helper dBoxProc
+ message .helper.m -aspect 300 -text \
+ "Select the name & location of your target Tcl application."
+ pack .helper.m
+ wm geometry .helper +20+40
+ update idletasks
+
+ # Get the target file from the end user
+ set target [tk_getSaveFile]
+ destroy .helper
+ if {$target == ""} return
+
+ # Copy stub, copy the droped file into the stubs text resource
+ file copy $stub $target
+ set id [open $tclFile r]
+ set rid [resource open $target w]
+ resource write -name tclshrc -file $rid TEXT [read $id]
+ resource close $rid
+ close $id
+
+ # This is a hint to the start-up code - always set to true
+ set droped_to_start true
+}
+
+# GetStub --
+#
+# Get the location of our stub application. The value may be cached,
+# in the preferences file, or we may need to ask the user.
+#
+# Parameters:
+# None.
+#
+# Results:
+# A path to the stub application.
+
+proc GetStub {} {
+ global env stub_location
+
+ if {[info exists stub_location]} {
+ return $stub_location
+ }
+
+ set file $env(PREF_FOLDER)
+ append file "D&D Tclet Preferences"
+
+
+ if {[file exists $file]} {
+ uplevel #0 [list source $file]
+ if {[info exists stub_location] && [file exists $stub_location]} {
+ return $stub_location
+ }
+ }
+
+ SelectStub
+
+ if {[info exists stub_location]} {
+ return $stub_location
+ } else {
+ exit
+ }
+}
+
+# SelectStub --
+#
+# This procedure uses tk_getOpenFile to allow the user to select
+# the copy of "Wish" that is used as the basis for Tclets. The
+# result is stored in a preferences file.
+#
+# Parameters:
+# None.
+#
+# Results:
+# None. The prefernce file is updated.
+
+proc SelectStub {} {
+ global env stub_location
+
+ # Give a helper screen to guide user
+ toplevel .helper -menu .bar
+ unsupported1 style .helper dBoxProc
+ message .helper.m -aspect 300 -text \
+ "Select \"Wish\" stub to clone. A copy of this application will be made to create your Tclet." \
+
+ pack .helper.m
+ wm geometry .helper +20+40
+ update idletasks
+
+ set new_location [tk_getOpenFile]
+ destroy .helper
+ if {$new_location != ""} {
+ set stub_location $new_location
+ set file [file join $env(PREF_FOLDER) "D&D Tclet Preferences"]
+
+ set id [open $file w]
+ puts $id [list set stub_location $stub_location]
+ close $id
+ }
+}
+
+# CreateMenus --
+#
+# Create the menubar for this application.
+#
+# Parameters:
+# None.
+#
+# Results:
+# None.
+
+proc CreateMenus {} {
+ menu .bar
+ .bar add cascade -menu .bar.file -label File
+ .bar add cascade -menu .bar.apple
+ . configure -menu .bar
+
+ menu .bar.apple -tearoff 0
+ .bar.apple add command -label "About Drag & Drop Tclets..." -command {ShowAbout}
+
+ menu .bar.file -tearoff 0
+ .bar.file add command -label "Show Console..." -command {console show}
+ .bar.file add command -label "Select Wish Stub..." -command {SelectStub}
+ .bar.file add separator
+ .bar.file add command -label "Quit" -accel Command-Q -command exit
+}
+
+# ShowAbout --
+#
+# Show the about box for Drag & Drop Tclets.
+#
+# Parameters:
+# None.
+#
+# Results:
+# None.
+
+proc ShowAbout {} {
+ tk_messageBox -icon info -type ok -message \
+"Drag & Drop Tclets
+by Ray Johnson\n\n\
+Copyright (c) 1997 Sun Microsystems, Inc."
+}
+
+# Start --
+#
+# This procedure provides the main start-up code for the application.
+# It should be run first thing on start up. It will create the UI
+# and set up the rest of the state of the application.
+#
+# Parameters:
+# None.
+#
+# Results:
+# None.
+
+proc Start {} {
+ global droped_to_start
+
+ # Hide . & console - see if we ran as a droped item
+ wm geometry . 1x1-25000-25000
+ console hide
+
+ # Run update - if we get any drop events we know that we were
+ # started by a drag & drop - if so, we quit automatically when done
+ set droped_to_start false
+ update
+ if {$droped_to_start == "true"} {
+ exit
+ }
+
+ # We were not started by a drag & drop - create the UI
+ CreateMenus
+}
+
+# Now that everything is defined, lets start the app!
+Start
diff --git a/tk/mac/tkMac.h b/tk/mac/tkMac.h
new file mode 100644
index 00000000000..ab7c46f85f1
--- /dev/null
+++ b/tk/mac/tkMac.h
@@ -0,0 +1,81 @@
+/*
+ * 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$
+ */
+
+#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);
+
+/*
+ * Mac Specific functions that are available to extension writers.
+ */
+
+EXTERN void Tk_MacSetEmbedHandler _ANSI_ARGS_((
+ Tk_MacEmbedRegisterWinProc *registerWinProcPtr,
+ Tk_MacEmbedGetGrafPortProc *getPortProcPtr,
+ Tk_MacEmbedMakeContainerExistProc *containerExistProcPtr,
+ Tk_MacEmbedGetClipProc *getClipProc,
+ Tk_MacEmbedGetOffsetInParentProc *getOffsetProc));
+
+
+EXTERN void Tk_MacTurnOffMenus _ANSI_ARGS_ (());
+EXTERN void Tk_MacTkOwnsCursor _ANSI_ARGS_ ((int tkOwnsIt));
+
+/*
+ * 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));
+EXTERN int TkMacConvertTkEvent _ANSI_ARGS_((EventRecord *eventPtr,
+ Window window));
+EXTERN void TkGenWMConfigureEvent _ANSI_ARGS_((Tk_Window tkwin,
+ int x, int y, int width, int height, int flags));
+EXTERN void TkMacInvalClipRgns _ANSI_ARGS_((TkWindow *winPtr));
+EXTERN int TkMacHaveAppearance _ANSI_ARGS_((void));
+EXTERN GWorldPtr TkMacGetDrawablePort _ANSI_ARGS_((Drawable drawable));
+
+#pragma export reset
+
+#endif /* _TKMAC */
diff --git a/tk/mac/tkMacAppInit.c b/tk/mac/tkMacAppInit.c
new file mode 100644
index 00000000000..1064141a7e0
--- /dev/null
+++ b/tk/mac/tkMacAppInit.c
@@ -0,0 +1,393 @@
+/*
+ * 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$
+ */
+
+#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));
+
+/*
+ * Prototypes for functions the ANSI library needs to link against.
+ */
+short InstallConsole _ANSI_ARGS_((short fd));
+void RemoveConsole _ANSI_ARGS_((void));
+long WriteCharsToConsole _ANSI_ARGS_((char *buff, long n));
+long ReadCharsFromConsole _ANSI_ARGS_((char *buff, long n));
+extern char * __ttyname _ANSI_ARGS_((long fildes));
+short SIOUXHandleOneEvent _ANSI_ARGS_((EventRecord *event));
+
+/*
+ * Prototypes for functions from the tkConsole.c file.
+ */
+
+EXTERN void TkConsoleCreate _ANSI_ARGS_((void));
+EXTERN int TkConsoleInit _ANSI_ARGS_((Tcl_Interp *interp));
+EXTERN void TkConsolePrint _ANSI_ARGS_((Tcl_Interp *interp,
+ int devId, char *buffer, long size));
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int MacintoshInit _ANSI_ARGS_((void));
+static int SetupMainInterp _ANSI_ARGS_((Tcl_Interp *interp));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * main --
+ *
+ * Main program for Wish.
+ *
+ * Results:
+ * None. This procedure never returns (it exits the process when
+ * it's done
+ *
+ * Side effects:
+ * This procedure initializes the wish world and then
+ * calls Tk_Main.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+main(
+ int argc, /* Number of arguments. */
+ char **argv) /* Array of argument strings. */
+{
+ char *newArgv[2];
+
+ if (MacintoshInit() != TCL_OK) {
+ Tcl_Exit(1);
+ }
+
+ argc = 1;
+ newArgv[0] = "Wish";
+ newArgv[1] = NULL;
+ Tk_Main(argc, newArgv, Tcl_AppInit);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppInit(
+ 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);
+
+ /*
+ * Call the init procedures for included packages. Each call should
+ * look like this:
+ *
+ * if (Mod_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * where "Mod" is the name of the module.
+ */
+
+#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;
+ }
+ 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,
+ (Tcl_PackageInitProc *) NULL);
+#endif /* TK_TEST */
+
+ /*
+ * Call Tcl_CreateCommand for application-specific commands, if
+ * they weren't already created by the init procedures called above.
+ * Each call would look like this:
+ *
+ * Tcl_CreateCommand(interp, "tclName", CFuncCmd, NULL, NULL);
+ */
+
+ SetupMainInterp(interp);
+
+ /*
+ * Specify a user-specific startup script to invoke if the application
+ * is run interactively. On the Mac we can specifiy either a TEXT resource
+ * which contains the script or the more UNIX like file location
+ * may also used. (I highly recommend using the resource method.)
+ */
+
+ Tcl_SetVar(interp, "tcl_rcRsrcName", "tclshrc", TCL_GLOBAL_ONLY);
+ /* Tcl_SetVar(interp, "tcl_rcFileName", "~/.tclshrc", TCL_GLOBAL_ONLY); */
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MacintoshInit --
+ *
+ * This procedure calls Mac specific initilization calls. Most of
+ * these calls must be made as soon as possible in the startup
+ * process.
+ *
+ * Results:
+ * Returns TCL_OK if everything went fine. If it didn't the
+ * application should probably fail.
+ *
+ * Side effects:
+ * Inits the application.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MacintoshInit()
+{
+ int i;
+ long result, mask = 0x0700; /* mask = system 7.x */
+
+#if GENERATING68K && !GENERATINGCFM
+ SetApplLimit(GetApplLimit() - (TK_MAC_68K_STACK_GROWTH));
+#endif
+ MaxApplZone();
+ for (i = 0; i < 4; i++) {
+ (void) MoreMasters();
+ }
+
+ /*
+ * 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();
+
+ /*
+ * Make sure we are running on system 7 or higher
+ */
+
+ if ((NGetTrapAddress(_Gestalt, ToolTrap) ==
+ NGetTrapAddress(_Unimplemented, ToolTrap))
+ || (((Gestalt(gestaltSystemVersion, &result) != noErr)
+ || (result < mask)))) {
+ panic("Tcl/Tk requires System 7 or higher.");
+ }
+
+ /*
+ * Make sure we have color quick draw
+ * (this means we can't run on 68000 macs)
+ */
+
+ if (((Gestalt(gestaltQuickdrawVersion, &result) != noErr)
+ || (result < gestalt32BitQD13))) {
+ panic("Tk requires Color QuickDraw.");
+ }
+
+
+ FlushEvents(everyEvent, 0);
+ SetEventMask(everyEvent);
+
+
+ Tcl_MacSetEventProc(TkMacConvertEvent);
+ TkConsoleCreate();
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetupMainInterp --
+ *
+ * This procedure calls initalization routines require a Tcl
+ * interp as an argument. This call effectively makes the passed
+ * iterpreter the "main" interpreter for the application.
+ *
+ * Results:
+ * Returns TCL_OK if everything went fine. If it didn't the
+ * application should probably fail.
+ *
+ * Side effects:
+ * More initilization.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetupMainInterp(
+ Tcl_Interp *interp)
+{
+ /*
+ * Initialize the console only if we are running as an interactive
+ * application.
+ */
+
+ TkMacInitAppleEvents(interp);
+ TkMacInitMenus(interp);
+
+ if (strcmp(Tcl_GetVar(interp, "tcl_interactive", TCL_GLOBAL_ONLY), "1")
+ == 0) {
+ if (TkConsoleInit(interp) == TCL_ERROR) {
+ goto error;
+ }
+ }
+
+ /*
+ * Attach the global interpreter to tk's expected global console
+ */
+
+ gStdoutInterp = interp;
+
+ return TCL_OK;
+
+error:
+ panic(interp->result);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InstallConsole, RemoveConsole, etc. --
+ *
+ * The following functions provide the UI for the console package.
+ * Users wishing to replace SIOUX with their own console package
+ * need only provide the four functions below in a library.
+ *
+ * Results:
+ * See SIOUX documentation for details.
+ *
+ * Side effects:
+ * See SIOUX documentation for details.
+ *
+ *----------------------------------------------------------------------
+ */
+
+short
+InstallConsole(short fd)
+{
+#pragma unused (fd)
+
+ return 0;
+}
+
+void
+RemoveConsole(void)
+{
+}
+
+long
+WriteCharsToConsole(char *buffer, long n)
+{
+ TkConsolePrint(gStdoutInterp, TCL_STDOUT, buffer, n);
+ return n;
+}
+
+long
+ReadCharsFromConsole(char *buffer, long n)
+{
+ return 0;
+}
+
+extern char *
+__ttyname(long fildes)
+{
+ static char *__devicename = "null device";
+
+ if (fildes >= 0 && fildes <= 2) {
+ return (__devicename);
+ }
+
+ return (0L);
+}
+
+short
+SIOUXHandleOneEvent(EventRecord *event)
+{
+ return 0;
+}
diff --git a/tk/mac/tkMacApplication.r b/tk/mac/tkMacApplication.r
new file mode 100644
index 00000000000..a22ffb272b8
--- /dev/null
+++ b/tk/mac/tkMacApplication.r
@@ -0,0 +1,267 @@
+/*
+ * 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$
+ */
+
+#include <Types.r>
+#include <SysTypes.r>
+#include <AEUserTermTypes.r>
+
+/*
+ * The folowing include and defines help construct
+ * the version string for Tcl.
+ */
+
+#define RESOURCE_INCLUDED
+#include "tk.h"
+
+#if (TK_RELEASE_LEVEL == 0)
+# define RELEASE_LEVEL alpha
+#elif (TK_RELEASE_LEVEL == 1)
+# define RELEASE_LEVEL beta
+#elif (TK_RELEASE_LEVEL == 2)
+# define RELEASE_LEVEL final
+#endif
+
+#if (TK_RELEASE_LEVEL == 2)
+# define MINOR_VERSION (TK_MINOR_VERSION * 16) + TK_RELEASE_SERIAL
+#else
+# define MINOR_VERSION TK_MINOR_VERSION * 16
+#endif
+
+#define RELEASE_CODE 0x00
+
+resource 'vers' (1) {
+ TK_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ TK_PATCH_LEVEL,
+ TK_PATCH_LEVEL ", by Ray Johnson © 1993-1996" "\n" "Sun Microsystems Labratories"
+};
+
+resource 'vers' (2) {
+ TK_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ TK_PATCH_LEVEL,
+ "Wish " TK_PATCH_LEVEL " © 1993-1996"
+};
+
+#define TK_APP_RESOURCES 128
+#define TK_APP_CREATOR 'WIsH'
+
+/*
+ * The 'BNDL' resource is the primary link between a file's
+ * creator/type and its icon. This resource acts for all Tcl shared
+ * libraries; other libraries will not need one and ought to use
+ * custom icons rather than new file types for a different appearance.
+ */
+
+resource 'BNDL' (TK_APP_RESOURCES, "Tk app bundle", purgeable)
+{
+ TK_APP_CREATOR,
+ 0,
+ {
+ 'FREF',
+ {
+ 0, TK_APP_RESOURCES,
+ 1, TK_APP_RESOURCES+1
+ },
+ 'ICN#',
+ {
+ 0, TK_APP_RESOURCES,
+ 1, TK_APP_RESOURCES+1
+ }
+ }
+};
+
+resource 'FREF' (TK_APP_RESOURCES, purgeable)
+{
+ 'APPL', 0, ""
+};
+resource 'FREF' (TK_APP_RESOURCES+1, purgeable)
+{
+ 'TEXT', 1, ""
+};
+
+type TK_APP_CREATOR as 'STR ';
+resource TK_APP_CREATOR (0, purgeable) {
+ "Wish " TK_PATCH_LEVEL " © 1996"
+};
+
+/*
+ * The 'kind' resource works with a 'BNDL' in Macintosh Easy Open
+ * to affect the text the Finder displays in the "kind" column and
+ * file info dialog. This information will be applied to all files
+ * with the listed creator and type.
+ */
+resource 'kind' (TK_APP_RESOURCES, "Tcl kind", purgeable) {
+ TK_APP_CREATOR,
+ 0, /* region = USA */
+ {
+ 'APPL', "Wish",
+ 'TEXT', "Tcl/Tk Script"
+ }
+};
+
+/*
+ * The following resource define the icon used by Tcl scripts. Any
+ * TEXT file with the creator of WIsH will get this icon.
+ */
+
+data 'icl4' (TK_APP_RESOURCES + 1, "Tk Doc", purgeable) {
+ $"000F FFFF FFFF FFFF FFFF FFF0 0000 0000"
+ $"000F 3333 3333 3333 3333 33FF 0000 0000"
+ $"000F 3333 3333 3333 3433 33F2 F000 0000"
+ $"000F 3333 3333 3333 7D43 33F2 2F00 0000"
+ $"000F 3333 3333 3335 5623 33F2 22F0 0000"
+ $"000F 3333 3333 3356 6343 33FF FFFF 0000"
+ $"000F 3333 3333 256F 5223 3333 333F 0000"
+ $"000F 3333 3333 D666 2433 3333 333F 0000"
+ $"000F 3333 3333 D5F6 6633 3333 333F 0000"
+ $"000F 3333 3332 5666 6733 3333 333F 0000"
+ $"000F 3333 3336 E56F 6633 3333 333F 0000"
+ $"000F 3333 3336 5656 5733 3333 333F 0000"
+ $"000F 3333 3336 E5B6 5233 3333 333F 0000"
+ $"000F 3333 3336 5ED6 3333 3333 333F 0000"
+ $"000F 3333 3376 6475 6233 3333 333F 0000"
+ $"000F 3333 333D 5D56 7333 3333 333F 0000"
+ $"000F 3333 3336 6C55 6333 3333 333F 0000"
+ $"000F 3333 3336 5C56 7333 3333 333F 0000"
+ $"000F 3333 3362 6CE6 D333 3333 333F 0000"
+ $"000F 3333 3336 5C65 6333 3333 333F 0000"
+ $"000F 3333 3336 EC5E 3333 3333 333F 0000"
+ $"000F 3333 3336 5C56 6333 3333 333F 0000"
+ $"000F 3333 3333 5C75 3333 3333 333F 0000"
+ $"000F 3333 3333 5DD6 3333 3333 333F 0000"
+ $"000F 3333 3333 3CDD 3333 3333 333F 0000"
+ $"000F 3333 3333 3303 3333 3333 333F 0000"
+ $"000F 3333 3333 3C33 3333 3333 333F 0000"
+ $"000F 3333 3333 3C33 3333 3333 333F 0000"
+ $"000F 3333 3333 3C33 3333 3333 333F 0000"
+ $"000F 3333 3333 3333 3333 3333 333F 0000"
+ $"000F 3333 3333 3333 3333 3333 333F 0000"
+ $"000F FFFF FFFF FFFF FFFF FFFF FFFF 0000"
+};
+
+data 'ICN#' (TK_APP_RESOURCES + 1, "Tk Doc", purgeable) {
+ $"1FFF FE00 1000 0300 1000 F280 1003 F240"
+ $"1003 E220 1007 E3F0 100F C010 100F C010"
+ $"100F C010 101F F010 101F F010 101F F010"
+ $"101F F010 101F F010 101D E010 101D E010"
+ $"101D E010 101D C010 101D C010 101D C010"
+ $"101D C010 100D 8010 100D 8010 100D 8010"
+ $"1005 8010 1002 0010 1002 0010 1002 0010"
+ $"1002 0010 1002 0010 1000 0010 1FFF FFF0"
+ $"1FFF FE00 1FFF FF00 1FFF FF80 1FFF FFC0"
+ $"1FFF FFE0 1FFF FFF0 1FFF FFF0 1FFF FFF0"
+ $"1FFF FFF0 1FFF FFF0 1FFF FFF0 1FFF FFF0"
+ $"1FFF FFF0 1FFF FFF0 1FFF FFF0 1FFF FFF0"
+ $"1FFF FFF0 1FFF FFF0 1FFF FFF0 1FFF FFF0"
+ $"1FFF FFF0 1FFF FFF0 1FFF FFF0 1FFF FFF0"
+ $"1FFF FFF0 1FFF FFF0 1FFF FFF0 1FFF FFF0"
+ $"1FFF FFF0 1FFF FFF0 1FFF FFF0 1FFF FFF0"
+};
+
+data 'ics#' (TK_APP_RESOURCES + 1, "Tk Doc", purgeable) {
+ $"7FF0 41D8 419C 4384 43C4 47C4 47C4 4784"
+ $"4684 4684 4284 4284 4104 4104 4104 7FFC"
+ $"7FE0 7FF0 7FF8 7FFC 7FFC 7FFC 7FFC 7FFC"
+ $"7FFC 7FFC 7FFC 7FFC 7FFC 7FFC 7FFC 7FFC"
+};
+
+data 'ics4' (TK_APP_RESOURCES + 1, "Tk Doc", purgeable) {
+ $"0FFF FFFF FFFF 0000 0F33 3333 53F2 F000"
+ $"0F33 3335 52FF FF00 0F33 33E6 3333 3F00"
+ $"0F33 3256 6333 3F00 0F33 3556 6333 3F00"
+ $"0F33 3A5E 3333 3F00 0F33 65D6 D333 3F00"
+ $"0F33 3655 5333 3F00 0F33 65C6 3333 3F00"
+ $"0F33 3EC5 E333 3F00 0F33 36C6 3333 3F00"
+ $"0F33 33CD 3333 3F00 0F33 33C3 3333 3F00"
+ $"0F33 33C3 3333 3F00 0FFF FFFF FFFF FF00"
+};
+
+/*
+ * The following resources define the icons for the Wish
+ * application.
+ */
+
+data 'icl4' (TK_APP_RESOURCES, "Tk App", purgeable) {
+ $"0000 0000 0000 000F 0000 0000 0000 0000"
+ $"0000 0000 0000 00FC F000 0000 0000 0000"
+ $"0000 0000 0000 0FCC CF66 0000 0000 0000"
+ $"0000 0000 0000 FCCC C556 0000 0000 0000"
+ $"0000 0000 000F CCCC 566F 0000 0000 0000"
+ $"0000 0000 00FC CCC5 6F5C F000 0000 0000"
+ $"0000 0000 0FCC CC66 66CC CF00 0000 0000"
+ $"0000 0000 FCCC CCD5 5666 CCF0 0000 0000"
+ $"0000 000F CCCC C656 5667 CCCF 0000 0000"
+ $"0000 00FC CCCC C6E5 5566 CCCC F000 0000"
+ $"0000 0FCC CCCC C656 5657 CCCC CF00 0000"
+ $"0000 FCCC CCCC C6E5 565C CCCC CCF0 0000"
+ $"000F CCCC CCCC C655 565C CCCC CCCF 0000"
+ $"00FC CCCC CCCC 7660 556C CCCC CCCC F000"
+ $"0FCC CCCC CCCC CD5D 567C CCCC CCCC CF00"
+ $"FCCC CCCC CCCC 6660 556C CCCC CCCC CCF0"
+ $"0FCC CCCC CCCC 665C 565C CCCC CCCC C0CF"
+ $"00FC CCCC CCCC 6660 E6DC CCCC CCCC CCF0"
+ $"000F CCCC CCCC C650 656C CCCC CCCC CF00"
+ $"0000 FCCC CCCC C6EC 5ECC CCCC CCCC F000"
+ $"0000 0FCC CCCC C650 566C CCCC CCCF 0000"
+ $"0000 00FC CCCC CC50 75CC CCCC CCF0 0000"
+ $"0000 000F CCCC CC50 56CC CCCC CF00 0000"
+ $"0000 0000 FCCC CCC0 5CCC CCCC F000 0000"
+ $"0000 0000 0FCC CCC0 CCCC CCCF 0000 0000"
+ $"0000 0000 00FC CCC0 CCCC CCF0 0000 0000"
+ $"0000 0000 000F CCC0 CCCC CF00 0000 0000"
+ $"0000 0000 0000 FCCC CCCC F000 0000 0000"
+ $"0000 0000 0000 0FCC CCCF 0000 0000 0000"
+ $"0000 0000 0000 00FC CCF0 0000 0000 0000"
+ $"0000 0000 0000 000F CF00 0000 0000 0000"
+ $"0000 0000 0000 0000 F000 0000 0000 0000"
+};
+
+data 'ICN#' (TK_APP_RESOURCES, "Tk App", purgeable) {
+ $"0001 0000 0002 8000 0004 7000 0008 7000"
+ $"0010 F000 0021 E800 0043 C400 0081 F200"
+ $"0107 F100 0207 F080 0407 F040 0807 E020"
+ $"1007 E010 200E E008 4002 E004 800E E002"
+ $"400E E001 200E C002 1006 E004 0806 C008"
+ $"0406 E010 0202 C020 0102 C040 0080 8080"
+ $"0041 0100 0021 0200 0011 0400 0009 0800"
+ $"0004 1000 0002 2000 0001 4000 0000 8000"
+ $"0001 0000 0003 8000 0007 F000 000F F000"
+ $"001F F000 003F F800 007F FC00 00FF FE00"
+ $"01FF FF00 03FF FF80 07FF FFC0 0FFF FFE0"
+ $"1FFF FFF0 3FFF FFF8 7FFF FFFC FFFF FFFE"
+ $"7FFF FFFF 3FFF FFFE 1FFF FFFC 0FFF FFF8"
+ $"07FF FFF0 03FF FFE0 01FF FFC0 00FF FF80"
+ $"007F FF00 003F FE00 001F FC00 000F F800"
+ $"0007 F000 0003 E000 0001 C000 0000 8000"
+};
+
+data 'ics#' (TK_APP_RESOURCES, "Tk App", purgeable) {
+ $"01C0 0260 04E0 09D0 1388 23C4 43C2 8281"
+ $"8282 4284 2188 1190 0920 0540 0280 0100"
+ $"01C0 03E0 07E0 0FF0 1FF8 3FFC 7FFE FFFF"
+ $"FFFE 7FFC 3FF8 1FF0 0FE0 07C0 0380 0100"
+};
+
+data 'ics4' (TK_APP_RESOURCES, "Tk App", purgeable) {
+ $"0000 000F C000 0000 0000 00FC 6600 0000"
+ $"0000 0FCC 6600 0000 0000 FCC6 66F0 0000"
+ $"000F CCD5 56CF 0000 00FC CC66 57CC F000"
+ $"0FCC CC65 56CC CF00 FCCC CC56 57CC CCF0"
+ $"0FCC CCC6 6CCC CCCF 00FC CCC6 5CCC CCF0"
+ $"000F CCC6 6CCC CF00 0000 FCCC 5CCC F000"
+ $"0000 0FCC CCCF 0000 0000 00FC CCF0 0000"
+ $"0000 000F CF00 0000 0000 0000 F000 0000"
+};
+
+
diff --git a/tk/mac/tkMacBitmap.c b/tk/mac/tkMacBitmap.c
new file mode 100644
index 00000000000..06807a2e581
--- /dev/null
+++ b/tk/mac/tkMacBitmap.c
@@ -0,0 +1,268 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tk.h"
+#include "tkMacInt.h"
+
+#include <Icons.h>
+#include <Dialogs.h>
+#include <Resources.h>
+#include <Strings.h>
+
+/*
+ * Depending on the resource type there are different ways to
+ * draw native icons.
+ */
+#define TYPE1 0 /* Family icon suite. */
+#define TYPE2 1 /* ICON resource. */
+#define TYPE3 2 /* cicn resource. */
+
+/*
+ * This data structure describes the id and type of a given icon.
+ * It is used as the source for native icons.
+ */
+typedef struct {
+ int id; /* Resource Id for Icon. */
+ long int type; /* Type of icon. */
+} NativeIcon;
+
+/*
+ * This structure holds information about native bitmaps.
+ */
+
+typedef struct {
+ char *name; /* Name of icon. */
+ long int type; /* Type of icon. */
+ int id; /* Id of icon. */
+ int size; /* Size of icon. */
+} BuiltInIcon;
+
+/*
+ * This array mapps a string name to the supported builtin icons
+ * on the Macintosh.
+ */
+
+static BuiltInIcon builtInIcons[] = {
+ {"document", TYPE1, kGenericDocumentIconResource, 32},
+ {"stationery", TYPE1, kGenericStationeryIconResource, 32},
+ {"edition", TYPE1, kGenericEditionFileIconResource, 32},
+ {"application", TYPE1, kGenericApplicationIconResource, 32},
+ {"accessory", TYPE1, kGenericDeskAccessoryIconResource, 32},
+ {"folder", TYPE1, kGenericFolderIconResource, 32},
+ {"pfolder", TYPE1, kPrivateFolderIconResource, 32},
+ {"trash", TYPE1, kTrashIconResource, 32},
+ {"floppy", TYPE1, kFloppyIconResource, 32},
+ {"ramdisk", TYPE1, kGenericRAMDiskIconResource, 32},
+ {"cdrom", TYPE1, kGenericCDROMIconResource, 32},
+ {"preferences", TYPE1, kGenericPreferencesIconResource, 32},
+ {"querydoc", TYPE1, kGenericQueryDocumentIconResource, 32},
+ {"stop", TYPE2, kStopIcon, 32},
+ {"note", TYPE2, kNoteIcon, 32},
+ {"caution", TYPE2, kCautionIcon, 32},
+ {(char *) NULL, 0, 0, 0}
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+ predefPtr->source = (char *) nativeIconPtr;
+ predefPtr->width = builtInPtr->size;
+ predefPtr->height = builtInPtr->size;
+ predefPtr->native = 1;
+ Tcl_SetHashValue(predefHashPtr, predefPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+TkpCreateNativeBitmap(
+ Display *display,
+ char * source) /* Info about the icon to build. */
+{
+ Pixmap pix;
+ GWorldPtr destPort;
+ Rect destRect;
+ Handle icon;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ NativeIcon *nativeIconPtr;
+
+ pix = Tk_GetPixmap(display, None, 32, 32, 0);
+ destPort = TkMacGetDrawablePort(pix);
+
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ nativeIconPtr = (NativeIcon *) source;
+ SetRect(&destRect, 0, 0, 32, 32);
+ if (nativeIconPtr->type == TYPE1) {
+ RGBColor white = {0xFFFF, 0xFFFF, 0xFFFF};
+
+ RGBForeColor(&white);
+ PaintRect(&destRect);
+ PlotIconID(&destRect, atAbsoluteCenter, ttNone, nativeIconPtr->id);
+ } else if (nativeIconPtr->type == TYPE2) {
+ icon = GetIcon(nativeIconPtr->id);
+ if (icon != NULL) {
+ RGBColor black = {0, 0, 0};
+
+ RGBForeColor(&black);
+ PlotIcon(&destRect, icon);
+ ReleaseResource(icon);
+ }
+ }
+
+ SetGWorld(saveWorld, saveDevice);
+ return pix;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+TkpGetNativeAppBitmap(
+ Display *display, /* The display. */
+ char *name, /* The name of the bitmap. */
+ int *width, /* The width & height of the bitmap. */
+ int *height)
+{
+ 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);
+
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ SetRect(&destRect, 0, 0, 32, 32);
+ if (type == TYPE2) {
+ RGBColor black = {0, 0, 0};
+
+ RGBForeColor(&black);
+ PlotIcon(&destRect, resource);
+ ReleaseResource(resource);
+ } else if (type == TYPE3) {
+ RGBColor white = {0xFFFF, 0xFFFF, 0xFFFF};
+ short id;
+ ResType theType;
+ Str255 dummy;
+
+ /*
+ * We need to first paint the background white. Also, for
+ * some reason we *must* use GetCIcon instead of GetNamedResource
+ * for PlotCIcon to work - so we use GetResInfo to get the id.
+ */
+ RGBForeColor(&white);
+ PaintRect(&destRect);
+ GetResInfo(resource, &id, &theType, dummy);
+ ReleaseResource(resource);
+ resource = (Handle) GetCIcon(id);
+ PlotCIcon(&destRect, (CIconHandle) resource);
+ DisposeCIcon((CIconHandle) resource);
+ }
+
+ *width = 32;
+ *height = 32;
+ SetGWorld(saveWorld, saveDevice);
+ return pix;
+}
diff --git a/tk/mac/tkMacButton.c b/tk/mac/tkMacButton.c
new file mode 100644
index 00000000000..b06bfc8c2a0
--- /dev/null
+++ b/tk/mac/tkMacButton.c
@@ -0,0 +1,1443 @@
+/*
+ * 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$
+ */
+
+#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. */
+ TkButtonWorldChanged, /* geometryProc. */
+ NULL /* modalProc. */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCreateButton --
+ *
+ * Allocate a new TkButton structure.
+ *
+ * Results:
+ * Returns a newly allocated TkButton structure.
+ *
+ * Side effects:
+ * Registers an event handler for the widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkButton *
+TkpCreateButton(
+ Tk_Window tkwin)
+{
+ return (TkButton *) ckalloc(sizeof(TkButton));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDisplayButton --
+ *
+ * This procedure is invoked to display a button widget. It is
+ * normally invoked as an idle handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the button in its
+ * current mode. The REDRAW_PENDING flag is cleared.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDisplayButton(
+ ClientData clientData) /* Information about widget. */
+{
+ TkButton *butPtr = (TkButton *) clientData;
+ Pixmap pixmap;
+ GC gc;
+ Tk_3DBorder border;
+ 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 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 == 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.
+ * 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;
+
+ x += offset;
+ y += offset;
+ if (relief == TK_RELIEF_RAISED) {
+ x -= offset;
+ y -= offset;
+ } else if (relief == TK_RELIEF_SUNKEN) {
+ x += offset;
+ y += offset;
+ }
+ if (butPtr->image != NULL) {
+ if ((butPtr->selectImage != NULL) && (butPtr->flags & SELECTED)) {
+ Tk_RedrawImage(butPtr->selectImage, 0, 0, width, height,
+ pixmap, x, y);
+ } else {
+ Tk_RedrawImage(butPtr->image, 0, 0, width, height, pixmap,
+ x, y);
+ }
+ } else {
+ XSetClipOrigin(butPtr->display, gc, x, y);
+ XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, gc, 0, 0,
+ (unsigned int) width, (unsigned int) height, x, y, 1);
+ XSetClipOrigin(butPtr->display, gc, 0, 0);
+ }
+ y += height/2;
+ } else if (butPtr->bitmap != None) {
+ Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
+ goto imageOrBitmap;
+ } else {
+ TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX, butPtr->padY,
+ butPtr->indicatorSpace + butPtr->textWidth, butPtr->textHeight,
+ &x, &y);
+
+ x += butPtr->indicatorSpace;
+
+ 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,
+ butPtr->inset, butPtr->inset,
+ (unsigned) (Tk_Width(tkwin) - 2*butPtr->inset),
+ (unsigned) (Tk_Height(tkwin) - 2*butPtr->inset));
+ if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
+ && (butPtr->selectBorder != NULL)) {
+ XSetForeground(butPtr->display, butPtr->disabledGC,
+ Tk_3DBorderColor(butPtr->normalBorder)->pixel);
+ }
+ }
+
+ /*
+ * Draw the border and traversal highlight last. This way, if the
+ * button's contents overflow they'll be covered up by the border.
+ */
+
+ if (relief != TK_RELIEF_FLAT) {
+ int inset = butPtr->highlightWidth;
+ Tk_Draw3DRectangle(tkwin, pixmap, border, inset, inset,
+ Tk_Width(tkwin) - 2*inset, Tk_Height(tkwin) - 2*inset,
+ butPtr->borderWidth, relief);
+ }
+
+ /*
+ * Copy the information from the off-screen pixmap onto the screen,
+ * then delete the pixmap.
+ */
+
+ XCopyArea(butPtr->display, pixmap, Tk_WindowId(tkwin),
+ butPtr->copyGC, 0, 0, (unsigned) Tk_Width(tkwin),
+ (unsigned) Tk_Height(tkwin), 0, 0);
+ Tk_FreePixmap(butPtr->display, pixmap);
+
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpComputeButtonGeometry --
+ *
+ * After changes in a button's text or bitmap, this procedure
+ * recomputes the button's geometry and passes this information
+ * along to the geometry manager for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The button's window may change size.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ }
+ if (butPtr->height > 0) {
+ height = butPtr->height;
+ }
+ if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn) {
+ butPtr->indicatorSpace = height;
+ if (butPtr->type == TYPE_CHECK_BUTTON) {
+ butPtr->indicatorDiameter = (65*height)/100;
+ } else {
+ butPtr->indicatorDiameter = (75*height)/100;
+ }
+ }
+ } 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 = fm.linespace;
+ if (butPtr->type == TYPE_CHECK_BUTTON) {
+ 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 != tkDisabledUid) {
+ 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 != tkDisabledUid) {
+ 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyButton --
+ *
+ * Free data structures associated with the button control.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Restores the default control state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyButton(
+ TkButton *butPtr)
+{
+ /* Do nothing. */
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DrawBufferedControl --
+ *
+ * This function uses a dummy Macintosh window to allow
+ * drawing Mac controls to any GWorld (including off-screen
+ * bitmaps). In addition, this code may apply custom
+ * colors passed in the TkButton.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Control is to the GWorld. Static state created on
+ * first invocation of this routine.
+ *
+ *--------------------------------------------------------------
+ */
+
+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 == tkActiveUid) {
+ 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 == tkDisabledUid) {
+ (**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 == tkActiveUid) {
+ 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 == 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, 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.
+ *
+ * Side effects:
+ * The Window's color table will be adjusted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ChangeBackgroundWindowColor(
+ WindowRef macintoshWindow, /* A Mac window whose color to change. */
+ RGBColor rgbColor, /* The new RGB Color for the background. */
+ RGBColor *oldColor) /* The old color of the background. */
+{
+ AuxWinHandle auxWinHandle;
+ WCTabHandle winCTabHandle;
+ short ctIndex;
+ ColorSpecPtr rgbScan;
+
+ GetAuxWin(macintoshWindow, &auxWinHandle);
+ winCTabHandle = (WCTabHandle) ((**auxWinHandle).awCTable);
+
+ /*
+ * Scan through the color table until we find the content
+ * (background) color for the window. Don't tell the system
+ * about the change - it will generate damage and we will get
+ * into an infinite loop.
+ */
+
+ ctIndex = (**winCTabHandle).ctSize;
+ while (ctIndex > -1) {
+ rgbScan = ctIndex + (**winCTabHandle).ctTable;
+
+ if (rgbScan->value == wContentColor) {
+ *oldColor = rgbScan->rgb;
+ rgbScan->rgb = rgbColor;
+ break;
+ }
+ ctIndex--;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ButtonExitProc --
+ *
+ * This procedure is invoked just before the application exits.
+ * It frees all of the control handles, our dummy window, etc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ButtonExitProc(clientData)
+ 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;
+ RectRgn(((CWindowPeek) windowRef)->port.visRgn, &rgnRect);
+ RectRgn(((CWindowPeek) windowRef)->strucRgn, &rgnRect);
+ RectRgn(((CWindowPeek) windowRef)->updateRgn, &rgnRect);
+ RectRgn(((CWindowPeek) windowRef)->contRgn, &rgnRect);
+ PortChanged(windowRef);
+
+ DisposeControl(buttonHandle);
+ DisposeControl(checkHandle);
+ DisposeControl(radioHandle);
+ DisposeWindow(windowRef);
+ windowRef = NULL;
+}
diff --git a/tk/mac/tkMacClipboard.c b/tk/mac/tkMacClipboard.c
new file mode 100644
index 00000000000..88bc423a343
--- /dev/null
+++ b/tk/mac/tkMacClipboard.c
@@ -0,0 +1,293 @@
+/*
+ * 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$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkMacInt.h"
+
+#include <Scrap.h>
+#include <Events.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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkSelGetSelection(
+ Tcl_Interp *interp, /* Interpreter to use for reporting
+ * errors. */
+ Tk_Window tkwin, /* Window on whose behalf to retrieve
+ * the selection (determines display
+ * from which to retrieve). */
+ Atom selection, /* Selection to retrieve. */
+ 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. */
+{
+ int result;
+ long length, offset = 0;
+ Handle handle;
+
+ if ((selection == Tk_InternAtom(tkwin, "CLIPBOARD"))
+ && (target == XA_STRING)) {
+ /*
+ * Get the scrap from the Macintosh global clipboard.
+ */
+ handle = NewHandle(1);
+ length = GetScrap(handle, 'TEXT', &offset);
+ if (length > 0) {
+ SetHandleSize(handle, (Size) length + 1);
+ HLock(handle);
+ (*handle)[length] = '\0';
+
+ result = (*proc)(clientData, interp, *handle);
+
+ HUnlock(handle);
+ DisposeHandle(handle);
+ return result;
+ }
+
+ DisposeHandle(handle);
+ }
+
+ Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),
+ " selection doesn't exist or form \"", Tk_GetAtomName(tkwin, target),
+ "\" not defined", (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSetSelectionOwner --
+ *
+ * This function claims ownership of the specified selection.
+ * If the selection is CLIPBOARD, then we empty the system
+ * clipboard.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XSetSelectionOwner(
+ Display* display, /* X Display. */
+ Atom selection, /* What selection to own. */
+ Window owner, /* Window to be the owner. */
+ Time time) /* The current time? */
+{
+ Tk_Window tkwin;
+ TkDisplay *dispPtr;
+
+ /*
+ * 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.
+ */
+
+ dispPtr = tkMainWindowList->winPtr->dispPtr;
+ if (dispPtr->clipboardActive) {
+ return;
+ }
+ ZeroScrap();
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelUpdateClipboard --
+ *
+ * This function is called to force the clipboard to be updated
+ * after new data is added. On the Mac we don't need to do
+ * anything.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSelUpdateClipboard(
+ TkWindow *winPtr, /* Window associated with clipboard. */
+ TkClipboardTarget *targetPtr) /* Info about the content. */
+{
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkSelEventProc --
+ *
+ * This procedure is invoked whenever a selection-related
+ * event occurs.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Lots: depends on the type of event.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkSelEventProc(
+ Tk_Window tkwin, /* Window for which event was
+ * targeted. */
+ register XEvent *eventPtr) /* X event: either SelectionClear,
+ * SelectionRequest, or
+ * SelectionNotify. */
+{
+ if (eventPtr->type == SelectionClear) {
+ TkSelClearSelection(tkwin, eventPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelPropProc --
+ *
+ * This procedure is invoked when property-change events
+ * occur on windows not known to the toolkit. This is a stub
+ * function under Windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSelPropProc(
+ register XEvent *eventPtr) /* X PropertyChange event. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSuspendClipboard --
+ *
+ * Handle clipboard conversion as required by the suppend event.
+ * This function is also called on exit.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The local scrap is moved to the global scrap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSuspendClipboard()
+{
+ 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)
+ break;
+ }
+ if (targetPtr != NULL) {
+ length = 0;
+ for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL;
+ cbPtr = cbPtr->nextPtr) {
+ length += cbPtr->length;
+ }
+
+ buffer = ckalloc(length);
+ buffPtr = buffer;
+ for (cbPtr = targetPtr->firstBufferPtr; cbPtr != NULL;
+ cbPtr = cbPtr->nextPtr) {
+ for (p = cbPtr->buffer, endPtr = p + cbPtr->length;
+ p < endPtr; p++) {
+ if (*p == '\n') {
+ *buffPtr++ = '\r';
+ } else {
+ *buffPtr++ = *p;
+ }
+ }
+ }
+
+ ZeroScrap();
+ PutScrap(length, 'TEXT', buffer);
+ ckfree(buffer);
+ }
+
+ /*
+ * The system now owns the scrap. We tell Tk that it has
+ * lost the selection so that it will look for it the next time
+ * it needs it. (Window list NULL if quiting.)
+ */
+
+ if (tkMainWindowList != NULL) {
+ Tk_ClearSelection((Tk_Window) tkMainWindowList->winPtr,
+ Tk_InternAtom((Tk_Window) tkMainWindowList->winPtr,
+ "CLIPBOARD"));
+ }
+
+ return;
+}
diff --git a/tk/mac/tkMacColor.c b/tk/mac/tkMacColor.c
new file mode 100644
index 00000000000..ccdc6734469
--- /dev/null
+++ b/tk/mac/tkMacColor.c
@@ -0,0 +1,493 @@
+/*
+ * 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$
+ */
+
+#include <tkColor.h>
+#include "tkMacInt.h"
+
+#include <LowMem.h>
+#include <Palettes.h>
+#include <Quickdraw.h>
+
+/*
+ * Default Auxillary Control Record for all controls. This is cached once
+ * and is updated by the system. We use this to get the default system
+ * colors used by controls.
+ */
+static AuxCtlHandle defaultAuxCtlHandle = NULL;
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static int GetControlPartColor _ANSI_ARGS_((short part, RGBColor *macColor));
+static int GetMenuPartColor _ANSI_ARGS_((int part, RGBColor *macColor));
+static int GetWindowPartColor _ANSI_ARGS_((short part, RGBColor *macColor));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSetMacColor --
+ *
+ * Populates a Macintosh RGBColor structure from a X style
+ * pixel value.
+ *
+ * Results:
+ * Returns false if not a real pixel, true otherwise.
+ *
+ * Side effects:
+ * The variable macColor is updated to the pixels value.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkSetMacColor(
+ unsigned long pixel, /* Pixel value to convert. */
+ RGBColor *macColor) /* Mac color struct to modify. */
+{
+ switch (pixel >> 24) {
+ case HIGHLIGHT_PIXEL:
+ LMGetHiliteRGB(macColor);
+ return true;
+ case HIGHLIGHT_TEXT_PIXEL:
+ LMGetHiliteRGB(macColor);
+ if ((macColor->red == 0) && (macColor->green == 0)
+ && (macColor->blue == 0)) {
+ macColor->red = macColor->green = macColor->blue = 0xFFFFFFFF;
+ } else {
+ macColor->red = macColor->green = macColor->blue = 0;
+ }
+ return true;
+ case CONTROL_TEXT_PIXEL:
+ GetControlPartColor(cTextColor, macColor);
+ return true;
+ case CONTROL_BODY_PIXEL:
+ GetControlPartColor(cBodyColor, macColor);
+ return true;
+ case CONTROL_FRAME_PIXEL:
+ GetControlPartColor(cFrameColor, macColor);
+ return true;
+ case WINDOW_BODY_PIXEL:
+ GetWindowPartColor(wContentColor, macColor);
+ return true;
+ 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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Stub functions --
+ *
+ * These functions are just stubs for functions that either
+ * don't make sense on the Mac or have yet to be implemented.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * These calls do nothing - which may not be expected.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Status
+XAllocColor(
+ Display *display, /* Display. */
+ Colormap map, /* Not used. */
+ XColor *colorPtr) /* XColor struct to modify. */
+{
+ display->request++;
+ colorPtr->pixel = TkpGetPixel(colorPtr);
+ return 1;
+}
+
+Colormap
+XCreateColormap(
+ Display *display, /* Display. */
+ Window window, /* X window. */
+ Visual *visual, /* Not used. */
+ int alloc) /* Not used. */
+{
+ static Colormap index = 1;
+
+ /*
+ * Just return a new value each time.
+ */
+ return index++;
+}
+
+void
+XFreeColormap(
+ Display* display, /* Display. */
+ Colormap colormap) /* Colormap. */
+{
+}
+
+void
+XFreeColors(
+ Display* display, /* Display. */
+ Colormap colormap, /* Colormap. */
+ unsigned long* pixels, /* Array of pixels. */
+ int npixels, /* Number of pixels. */
+ unsigned long planes) /* Number of pixel planes. */
+{
+ /*
+ * The Macintosh version of Tk uses TrueColor. Nothing
+ * needs to be done to release colors as there really is
+ * no colormap in the Tk sense.
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetColor --
+ *
+ * Allocate a new TkColor for the color with the given name.
+ *
+ * Results:
+ * Returns a newly allocated TkColor, or NULL on failure.
+ *
+ * Side effects:
+ * May invalidate the colormap cache associated with tkwin upon
+ * allocating a new colormap entry. Allocates a new TkColor
+ * structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkColor *
+TkpGetColor(
+ 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). */
+{
+ Display *display = Tk_Display(tkwin);
+ Colormap colormap = Tk_Colormap(tkwin);
+ TkColor *tkColPtr;
+ XColor color;
+
+ /*
+ * Check to see if this is a system color. Otherwise, XParseColor
+ * will do all the work.
+ */
+ if (strncasecmp(name, "system", 6) == 0) {
+ int foundSystemColor = false;
+ RGBColor rgbValue;
+ char pixelCode;
+
+ if (!strcasecmp(name+6, "Highlight")) {
+ LMGetHiliteRGB(&rgbValue);
+ pixelCode = HIGHLIGHT_PIXEL;
+ foundSystemColor = true;
+ } else if (!strcasecmp(name+6, "HighlightText")) {
+ LMGetHiliteRGB(&rgbValue);
+ if ((rgbValue.red == 0) && (rgbValue.green == 0)
+ && (rgbValue.blue == 0)) {
+ rgbValue.red = rgbValue.green = rgbValue.blue = 0xFFFFFFFF;
+ } else {
+ rgbValue.red = rgbValue.green = rgbValue.blue = 0;
+ }
+ pixelCode = HIGHLIGHT_TEXT_PIXEL;
+ foundSystemColor = true;
+ } else if (!strcasecmp(name+6, "ButtonText")) {
+ GetControlPartColor(cTextColor, &rgbValue);
+ pixelCode = CONTROL_TEXT_PIXEL;
+ foundSystemColor = true;
+ } else if (!strcasecmp(name+6, "ButtonFace")) {
+ GetControlPartColor(cBodyColor, &rgbValue);
+ pixelCode = CONTROL_BODY_PIXEL;
+ foundSystemColor = true;
+ } else if (!strcasecmp(name+6, "ButtonFrame")) {
+ GetControlPartColor(cFrameColor, &rgbValue);
+ pixelCode = CONTROL_FRAME_PIXEL;
+ foundSystemColor = true;
+ } else if (!strcasecmp(name+6, "WindowBody")) {
+ GetWindowPartColor(wContentColor, &rgbValue);
+ pixelCode = WINDOW_BODY_PIXEL;
+ foundSystemColor = true;
+ } else if (!strcasecmp(name+6, "MenuActive")) {
+ GetMenuPartColor(MENU_ACTIVE_PIXEL, &rgbValue);
+ pixelCode = MENU_ACTIVE_PIXEL;
+ foundSystemColor = true;
+ } else if (!strcasecmp(name+6, "MenuActiveText")) {
+ GetMenuPartColor(MENU_ACTIVE_TEXT_PIXEL, &rgbValue);
+ pixelCode = MENU_ACTIVE_TEXT_PIXEL;
+ foundSystemColor = true;
+ } else if (!strcasecmp(name+6, "Menu")) {
+ GetMenuPartColor(MENU_BACKGROUND_PIXEL, &rgbValue);
+ pixelCode = MENU_BACKGROUND_PIXEL;
+ foundSystemColor = true;
+ } 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;
+ color.pixel = ((((((pixelCode << 8)
+ | ((color.red >> 8) & 0xff)) << 8)
+ | ((color.green >> 8) & 0xff)) << 8)
+ | ((color.blue >> 8) & 0xff));
+
+ tkColPtr = (TkColor *) ckalloc(sizeof(TkColor));
+ tkColPtr->color = color;
+ return tkColPtr;
+ }
+ }
+
+ if (XParseColor(display, colormap, name, &color) == 0) {
+ return (TkColor *) NULL;
+ }
+
+ tkColPtr = (TkColor *) ckalloc(sizeof(TkColor));
+ tkColPtr->color = color;
+
+ return tkColPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetColorByValue --
+ *
+ * Given a desired set of red-green-blue intensities for a color,
+ * locate a pixel value to use to draw that color in a given
+ * window.
+ *
+ * Results:
+ * The return value is a pointer to an TkColor structure that
+ * indicates the closest red, blue, and green intensities available
+ * to those specified in colorPtr, and also specifies a pixel
+ * value to use to draw in that color.
+ *
+ * Side effects:
+ * May invalidate the colormap cache for the specified window.
+ * Allocates a new TkColor structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkColor *
+TkpGetColorByValue(
+ Tk_Window tkwin, /* Window in which color will be used. */
+ XColor *colorPtr) /* Red, green, and blue fields indicate
+ * desired color. */
+{
+ TkColor *tkColPtr = (TkColor *) ckalloc(sizeof(TkColor));
+
+ tkColPtr->color.red = colorPtr->red;
+ tkColPtr->color.green = colorPtr->green;
+ tkColPtr->color.blue = colorPtr->blue;
+ tkColPtr->color.pixel = TkpGetPixel(&tkColPtr->color);
+ return tkColPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetControlPartColor --
+ *
+ * Given a part number this function will return the standard
+ * system default color for that part. It does this by looking
+ * in the system's 'cctb' resource.
+ *
+ * Results:
+ * True if a color is found, false otherwise.
+ *
+ * Side effects:
+ * If a color is found then the RGB variable will be changed to
+ * the parts color.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetControlPartColor(
+ short part, /* Part code. */
+ RGBColor *macColor) /* Pointer to Mac color. */
+{
+ short index;
+ CCTabHandle ccTab;
+
+ if (defaultAuxCtlHandle == NULL) {
+ GetAuxiliaryControlRecord(NULL, &defaultAuxCtlHandle);
+ }
+ ccTab = (**defaultAuxCtlHandle).acCTable;
+ if(ccTab && (ResError() == noErr)) {
+ for(index = 0; index <= (**ccTab).ctSize; index++) {
+ if((**ccTab).ctTable[index].value == part) {
+ *macColor = (**ccTab).ctTable[index].rgb;
+ return true;
+ }
+ }
+ }
+ return false;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetWindowPartColor --
+ *
+ * Given a part number this function will return the standard
+ * system default color for that part. It does this by looking
+ * in the system's 'wctb' resource.
+ *
+ * Results:
+ * True if a color is found, false otherwise.
+ *
+ * Side effects:
+ * If a color is found then the RGB variable will be changed to
+ * the parts color.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetWindowPartColor(
+ short part, /* Part code. */
+ RGBColor *macColor) /* Pointer to Mac color. */
+{
+ short index;
+ WCTabHandle wcTab;
+
+ wcTab = (WCTabHandle) GetResource('wctb', 0);
+ if(wcTab && (ResError() == noErr)) {
+ for(index = 0; index <= (**wcTab).ctSize; index++) {
+ if((**wcTab).ctTable[index].value == part) {
+ *macColor = (**wcTab).ctTable[index].rgb;
+ return true;
+ }
+ }
+ }
+ return false;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMenuPartColor --
+ *
+ * Given a magic pixel value, returns the RGB color associated
+ * with it by looking the value up in the system's 'mctb' resource.
+ *
+ * Results:
+ * True if a color is found, false otherwise.
+ *
+ * Side effects:
+ * If a color is found then the RGB variable will be changed to
+ * the parts color.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetMenuPartColor(
+ int pixel, /* The magic pixel value */
+ RGBColor *macColor) /* Pointer to Mac color */
+{
+ RGBColor backColor, foreColor;
+ GDHandle maxDevice;
+ Rect globalRect;
+ MCEntryPtr mcEntryPtr = GetMCEntry(0, 0);
+
+ switch (pixel) {
+ case MENU_ACTIVE_PIXEL:
+ if (mcEntryPtr == NULL) {
+ macColor->red = macColor->blue = macColor->green = 0;
+ } else {
+ *macColor = mcEntryPtr->mctRGB3;
+ }
+ return 1;
+ case MENU_ACTIVE_TEXT_PIXEL:
+ if (mcEntryPtr == NULL) {
+ macColor->red = macColor->blue = macColor->green = 0xFFFF;
+ } else {
+ *macColor = mcEntryPtr->mctRGB2;
+ }
+ return 1;
+ case MENU_BACKGROUND_PIXEL:
+ if (mcEntryPtr == NULL) {
+ macColor->red = macColor->blue = macColor->green = 0xFFFF;
+ } else {
+ *macColor = mcEntryPtr->mctRGB2;
+ }
+ return 1;
+ case MENU_DISABLED_PIXEL:
+ if (mcEntryPtr == NULL) {
+ backColor.red = backColor.blue = backColor.green = 0xFFFF;
+ foreColor.red = foreColor.blue = foreColor.green = 0x0000;
+ } else {
+ backColor = mcEntryPtr->mctRGB2;
+ foreColor = mcEntryPtr->mctRGB3;
+ }
+ SetRect(&globalRect, SHRT_MIN, SHRT_MIN, SHRT_MAX, SHRT_MAX);
+ maxDevice = GetMaxDevice(&globalRect);
+ if (GetGray(maxDevice, &backColor, &foreColor)) {
+ *macColor = foreColor;
+ } else {
+
+ /*
+ * Pointer may have been moved by GetMaxDevice or GetGray.
+ */
+
+ mcEntryPtr = GetMCEntry(0,0);
+ if (mcEntryPtr == NULL) {
+ macColor->red = macColor->green = macColor->blue = 0x7777;
+ } else {
+ *macColor = mcEntryPtr->mctRGB2;
+ }
+ }
+ return 1;
+ case MENU_TEXT_PIXEL:
+ if (mcEntryPtr == NULL) {
+ macColor->red = macColor->green = macColor->blue = 0;
+ } else {
+ *macColor = mcEntryPtr->mctRGB3;
+ }
+ return 1;
+ }
+ return 0;
+}
diff --git a/tk/mac/tkMacCursor.c b/tk/mac/tkMacCursor.c
new file mode 100644
index 00000000000..92ec0054f12
--- /dev/null
+++ b/tk/mac/tkMacCursor.c
@@ -0,0 +1,392 @@
+/*
+ * 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$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkMacInt.h"
+
+#include <Resources.h>
+#include <ToolUtils.h>
+#include <Strings.h>
+
+/*
+ * There are three different ways to set the cursor on the Mac.
+ */
+#define ARROW 0 /* The arrow cursor. */
+#define COLOR 1 /* Cursors of type crsr. */
+#define NORMAL 2 /* Cursors of type CURS. */
+
+/*
+ * The following data structure contains the system specific data
+ * necessary to control Windows cursors.
+ */
+
+typedef struct {
+ TkCursor info; /* Generic cursor info used by tkCursor.c */
+ Handle macCursor; /* Resource containing Macintosh cursor. */
+ int type; /* Type of Mac cursor: arrow, crsr, CURS */
+} TkMacCursor;
+
+/*
+ * The table below is used to map from the name of a predefined cursor
+ * to its resource identifier.
+ */
+
+static struct CursorName {
+ char *name;
+ int id;
+} cursorNames[] = {
+ {"ibeam", 1},
+ {"text", 1},
+ {"xterm", 1},
+ {"cross", 2},
+ {"crosshair", 2},
+ {"cross-hair", 2},
+ {"plus", 3},
+ {"watch", 4},
+ {"arrow", 5},
+ {NULL, 0}
+};
+
+/*
+ * 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));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindCursorByName --
+ *
+ * Retrieve a system cursor by name, and fill the macCursorPtr
+ * structure. If the cursor cannot be found, the macCursor field
+ * will be NULL. The function first attempts to load a color
+ * cursor. If that fails it will attempt to load a black & white
+ * cursor.
+ *
+ * Results:
+ * Fills the macCursorPtr record.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+
+ HLock(resource);
+ GetResInfo(resource, &id, &theType, theName);
+ HUnlock(resource);
+ macCursorPtr->macCursor = (Handle) GetCCursor(id);
+ macCursorPtr->type = COLOR;
+ }
+
+ if (resource == NULL) {
+ macCursorPtr->macCursor = GetNamedResource('CURS', curName);
+ macCursorPtr->type = NORMAL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetCursorByName --
+ *
+ * Retrieve a system cursor by name.
+ *
+ * Results:
+ * Returns a new cursor, or NULL on errors.
+ *
+ * Side effects:
+ * Allocates a new cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkCursor *
+TkGetCursorByName(
+ 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. */
+{
+ struct CursorName *namePtr;
+ TkMacCursor *macCursorPtr;
+
+ macCursorPtr = (TkMacCursor *) ckalloc(sizeof(TkMacCursor));
+ macCursorPtr->info.cursor = (Tk_Cursor) macCursorPtr;
+
+ /*
+ * To find a cursor we must first determine if it is one of the
+ * builtin cursors or the standard arrow cursor. Otherwise, we
+ * attempt to load the cursor as a named Mac resource.
+ */
+
+ for (namePtr = cursorNames; namePtr->name != NULL; namePtr++) {
+ if (strcmp(namePtr->name, string) == 0) {
+ break;
+ }
+ }
+
+
+ if (namePtr->name != NULL) {
+ if (namePtr->id == 5) {
+ macCursorPtr->macCursor = (Handle) -1;
+ macCursorPtr->type = ARROW;
+ } else {
+ macCursorPtr->macCursor = (Handle) GetCursor(namePtr->id);
+ macCursorPtr->type = NORMAL;
+ }
+ } else {
+ FindCursorByName(macCursorPtr, string);
+
+ if (macCursorPtr->macCursor == NULL) {
+ char **argv;
+ int argc, err;
+
+ /*
+ * The user may be trying to specify an XCursor with fore
+ * & back colors. We don't want this to be an error, so pick
+ * off the first word, and try again.
+ */
+
+ err = Tcl_SplitList(interp, string, &argc, &argv);
+ if (err == TCL_OK ) {
+ if (argc > 1) {
+ FindCursorByName(macCursorPtr, argv[0]);
+ }
+
+ ckfree((char *) argv);
+ }
+ }
+ }
+
+ if (macCursorPtr->macCursor == NULL) {
+ ckfree((char *)macCursorPtr);
+ Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"",
+ (char *) NULL);
+ return NULL;
+ } else {
+ return (TkCursor *) macCursorPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCreateCursorFromData --
+ *
+ * Creates a cursor from the source and mask bits.
+ *
+ * Results:
+ * Returns a new cursor, or NULL on errors.
+ *
+ * Side effects:
+ * Allocates a new cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkCursor *
+TkCreateCursorFromData(
+ Tk_Window tkwin, /* Window in which cursor will be used. */
+ char *source, /* Bitmap data for cursor shape. */
+ char *mask, /* Bitmap data for cursor mask. */
+ int width, int height, /* Dimensions of cursor. */
+ int xHot, int yHot, /* Location of hot-spot in cursor. */
+ XColor fgColor, /* Foreground color for cursor. */
+ XColor bgColor) /* Background color for cursor. */
+{
+ 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 --
+ *
+ * Installs either the current cursor as defined by TkpSetCursor
+ * or a resize cursor as the cursor the Macintosh should currently
+ * display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the Macintosh mouse cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacInstallCursor(
+ int resizeOverride)
+{
+ TkMacCursor *macCursorPtr = gCurrentCursor;
+ CCrsrHandle ccursor;
+ CursHandle cursor;
+
+ gResizeOverride = resizeOverride;
+
+ if (resizeOverride) {
+ cursor = (CursHandle) GetNamedResource('CURS', "\presize");
+ SetCursor(*cursor);
+ } else if (macCursorPtr == NULL || macCursorPtr->type == ARROW) {
+ SetCursor(&tcl_macQdPtr->arrow);
+ } else {
+ switch (macCursorPtr->type) {
+ case COLOR:
+ ccursor = (CCrsrHandle) macCursorPtr->macCursor;
+ SetCCursor(ccursor);
+ break;
+ case NORMAL:
+ cursor = (CursHandle) macCursorPtr->macCursor;
+ SetCursor(*cursor);
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpSetCursor --
+ *
+ * Set the current cursor and install it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the current cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+}
diff --git a/tk/mac/tkMacCursors.r b/tk/mac/tkMacCursors.r
new file mode 100644
index 00000000000..0c5b6cb83f8
--- /dev/null
+++ b/tk/mac/tkMacCursors.r
@@ -0,0 +1,130 @@
+/*
+ * 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$
+ */
+
+/*
+ * These are resource definitions for Macintosh cursors.
+ * The are identified and loaded by the "name" of the
+ * cursor. However, the ids must be unique.
+ */
+
+data 'CURS' (1000, "hand") {
+ $"0180 1A70 2648 264A 124D 1249 6809 9801"
+ $"8802 4002 2002 2004 1004 0808 0408 0408"
+ $"0180 1BF0 3FF8 3FFA 1FFF 1FFF 6FFF FFFF"
+ $"FFFE 7FFE 3FFE 3FFC 1FFC 0FF8 07F8 07F8"
+ $"0009 0008"
+};
+
+data 'CURS' (1002, "bucket") {
+ $"0000 0000 0600 0980 0940 0B30 0D18 090C"
+ $"129C 212C 104C 088C 050C 0208 0000 0000"
+ $"0000 0000 0600 0980 09C0 0BF0 0FF8 0FFC"
+ $"1FFC 3FEC 1FCC 0F8C 070C 0208 0000 0000"
+ $"000D 000C"
+};
+
+data 'CURS' (1003, "cancel") {
+ $"0000 0000 0000 0000 3180 4A40 4A40 3F80"
+ $"0A00 3F80 4A40 4A46 3186 0000 0000 0000"
+ $"0000 0000 0000 3180 7BC0 FFE0 FFE0 7FC0"
+ $"3F80 7FC0 FFE6 FFEF 7BCF 3186 0000 0000"
+ $"0008 0005"
+};
+
+data 'CURS' (1004, "Resize") {
+ $"FFFF 8001 BF01 A181 A1F9 A18D A18D BF8D"
+ $"9F8D 880D 880D 880D 8FFD 87FD 8001 FFFF"
+ $"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
+ $"FFFF FFFF FFFF FFFF FFFF FFFF FFFF FFFF"
+ $"0008 0008"
+};
+
+data 'CURS' (1005, "eyedrop") {
+ $"000E 001F 001F 00FF 007E 00B8 0118 0228"
+ $"0440 0880 1100 2200 4400 4800 B000 4000"
+ $"000E 001F 001F 00FF 007E 00F8 01F8 03E8"
+ $"07C0 0F80 1F00 3E00 7C00 7800 F000 4000"
+ $"000F 0000"
+};
+
+data 'CURS' (1006, "eyedrop-full") {
+ $"000E 001F 001F 00FF 007E 00B8 0118 0328"
+ $"07C0 0F80 1F00 3E00 7C00 7800 F000 4000"
+ $"000E 001F 001F 00FF 007E 00F8 01F8 03E8"
+ $"07C0 0F80 1F00 3E00 7C00 7800 F000 4000"
+ $"000F 0000"
+};
+
+data 'CURS' (1007, "zoom-in") {
+ $"0780 1860 2790 5868 5028 A014 AFD4 AFD4"
+ $"A014 5028 5868 2798 187C 078E 0007 0003"
+ $"0780 1FE0 3FF0 7878 7038 E01C EFDC EFDC"
+ $"E01C 7038 7878 3FF8 1FFC 078E 0007 0003"
+ $"0007 0007"
+};
+
+data 'CURS' (1008, "zoom-out") {
+ $"0780 1860 2790 5868 5328 A314 AFD4 AFD4"
+ $"A314 5328 5868 2798 187C 078E 0007 0003"
+ $"0780 1FE0 3FF0 7878 7338 E31C EFDC EFDC"
+ $"E31C 7338 7878 3FF8 1FFC 078E 0007 0003"
+ $"0007 0007"
+};
+
+/*
+ * The following are resource definitions for color
+ * cursors on the Macintosh. If a color cursor and
+ * a black & white cursor are both defined with the
+ * same name preference will be given to the color
+ * cursors.
+ */
+
+data 'crsr' (1000, "hand") {
+ $"8001 0000 0060 0000 0092 0000 0000 0000"
+ $"0000 0000 0180 1A70 2648 264A 124D 1249"
+ $"6809 9801 8802 4002 2002 2004 1004 0808"
+ $"0408 0408 0180 1BF0 3FF8 3FFA 1FFF 1FFF"
+ $"6FFF FFFF FFFE 7FFE 3FFE 3FFC 1FFC 0FF8"
+ $"07F8 07F8 0008 0008 0000 0000 0000 0000"
+ $"0000 0000 8004 0000 0000 0010 0010 0000"
+ $"0000 0000 0000 0048 0000 0048 0000 0000"
+ $"0002 0001 0002 0000 0000 0000 00D2 0000"
+ $"0000 0003 C000 03CD 7F00 0D7D 75C0 0D7D"
+ $"75CC 035D 75F7 035D 75D7 3CD5 55D7 D7D5"
+ $"5557 D5D5 555C 3555 555C 0D55 555C 0D55"
+ $"5570 0355 5570 00D5 55C0 0035 55C0 0035"
+ $"55C0 0000 0000 0000 0002 0000 FFFF FFFF"
+ $"FFFF 0001 FFFF CCCC 9999 0003 0000 0000"
+ $"0000"
+};
+
+data 'crsr' (1001, "fist") {
+ $"8001 0000 0060 0000 0092 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0DB0 124C"
+ $"100A 0802 1802 2002 2002 2004 1004 0808"
+ $"0408 0408 0000 0000 0000 0000 0DB0 1FFC"
+ $"1FFE 0FFE 1FFE 3FFE 3FFE 3FFC 1FFC 0FF8"
+ $"07F8 07F8 0008 0008 0000 0000 0000 0000"
+ $"0000 0000 8004 0000 0000 0010 0010 0000"
+ $"0000 0000 0000 0048 0000 0048 0000 0000"
+ $"0002 0001 0002 0000 0000 0000 00D2 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 00F3 CF00 035D 75F0 0355 55DC 00D5"
+ $"555C 03D5 555C 0D55 555C 0D55 555C 0D55"
+ $"5570 0355 5570 00D5 55C0 0035 55C0 0035"
+ $"55C0 0000 0000 0000 0002 0000 FFFF FFFF"
+ $"FFFF 0001 FFFF CCCC 9999 0003 0000 0000"
+ $"0000"
+};
+
diff --git a/tk/mac/tkMacDefault.h b/tk/mac/tkMacDefault.h
new file mode 100644
index 00000000000..03ee2d72db9
--- /dev/null
+++ b/tk/mac/tkMacDefault.h
@@ -0,0 +1,462 @@
+/*
+ * 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$
+ */
+
+#ifndef _TKMACDEFAULT
+#define _TKMACDEFAULT
+
+/*
+ * The definitions below provide symbolic names for the default colors.
+ * NORMAL_BG - Normal background color.
+ * ACTIVE_BG - Background color when widget is active.
+ * SELECT_BG - Background color for selected text.
+ * SELECT_FG - Foreground color for selected text.
+ * TROUGH - Background color for troughs in scales and scrollbars.
+ * INDICATOR - Color for indicator when button is selected.
+ * DISABLED - Foreground color when widget is disabled.
+ */
+
+#define BLACK "Black"
+#define WHITE "White"
+
+#define NORMAL_BG "systemWindowBody"
+#define ACTIVE_BG "#ececec"
+#define SELECT_BG "systemHighlight"
+#define SELECT_FG "systemHighlightText"
+#define TROUGH "#c3c3c3"
+#define INDICATOR "#b03060"
+#define DISABLED "#a3a3a3"
+
+/*
+ * Defaults for labels, buttons, checkbuttons, and radiobuttons:
+ */
+
+#define DEF_BUTTON_ANCHOR "center"
+#define DEF_BUTTON_ACTIVE_BG_COLOR "systemButtonText"
+#define DEF_BUTTON_ACTIVE_BG_MONO BLACK
+#define DEF_BUTTON_ACTIVE_FG_COLOR "systemButtonFace"
+#define DEF_CHKRAD_ACTIVE_FG_COLOR DEF_BUTTON_ACTIVE_FG_COLOR
+#define DEF_BUTTON_ACTIVE_FG_MONO WHITE
+#define DEF_BUTTON_BG_COLOR "systemButtonFace"
+#define DEF_BUTTON_BG_MONO WHITE
+#define DEF_BUTTON_BITMAP ""
+#define DEF_BUTTON_BORDER_WIDTH "2"
+#define DEF_BUTTON_CURSOR ""
+#define DEF_BUTTON_COMMAND ""
+#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"
+#define DEF_BUTTON_ON_VALUE "1"
+#define DEF_BUTTON_PADX "7"
+#define DEF_LABCHKRAD_PADX "1"
+#define DEF_BUTTON_PADY "3"
+#define DEF_LABCHKRAD_PADY "1"
+#define DEF_BUTTON_RELIEF "flat"
+#define DEF_LABCHKRAD_RELIEF "flat"
+#define DEF_BUTTON_SELECT_COLOR INDICATOR
+#define DEF_BUTTON_SELECT_MONO BLACK
+#define DEF_BUTTON_SELECT_IMAGE (char *) NULL
+#define DEF_BUTTON_STATE "normal"
+#define DEF_LABEL_TAKE_FOCUS "0"
+#define DEF_BUTTON_TAKE_FOCUS (char *) NULL
+#define DEF_BUTTON_TEXT ""
+#define DEF_BUTTON_TEXT_VARIABLE ""
+#define DEF_BUTTON_UNDERLINE "-1"
+#define DEF_BUTTON_VALUE ""
+#define DEF_BUTTON_WIDTH "0"
+#define DEF_BUTTON_WRAP_LENGTH "0"
+#define DEF_RADIOBUTTON_VARIABLE "selectedButton"
+#define DEF_CHECKBUTTON_VARIABLE ""
+
+/*
+ * Defaults for canvases:
+ */
+
+#define DEF_CANVAS_BG_COLOR NORMAL_BG
+#define DEF_CANVAS_BG_MONO WHITE
+#define DEF_CANVAS_BORDER_WIDTH "0"
+#define DEF_CANVAS_CLOSE_ENOUGH "1"
+#define DEF_CANVAS_CONFINE "1"
+#define DEF_CANVAS_CURSOR ""
+#define DEF_CANVAS_HEIGHT "7c"
+#define DEF_CANVAS_HIGHLIGHT_BG NORMAL_BG
+#define DEF_CANVAS_HIGHLIGHT BLACK
+#define DEF_CANVAS_HIGHLIGHT_WIDTH "3"
+#define DEF_CANVAS_INSERT_BG BLACK
+#define DEF_CANVAS_INSERT_BD_COLOR "0"
+#define DEF_CANVAS_INSERT_BD_MONO "0"
+#define DEF_CANVAS_INSERT_OFF_TIME "300"
+#define DEF_CANVAS_INSERT_ON_TIME "600"
+#define DEF_CANVAS_INSERT_WIDTH "2"
+#define DEF_CANVAS_RELIEF "flat"
+#define DEF_CANVAS_SCROLL_REGION ""
+#define DEF_CANVAS_SELECT_COLOR SELECT_BG
+#define DEF_CANVAS_SELECT_MONO BLACK
+#define DEF_CANVAS_SELECT_BD_COLOR "1"
+#define DEF_CANVAS_SELECT_BD_MONO "0"
+#define DEF_CANVAS_SELECT_FG_COLOR BLACK
+#define DEF_CANVAS_SELECT_FG_MONO WHITE
+#define DEF_CANVAS_TAKE_FOCUS (char *) NULL
+#define DEF_CANVAS_WIDTH "10c"
+#define DEF_CANVAS_X_SCROLL_CMD ""
+#define DEF_CANVAS_X_SCROLL_INCREMENT "0"
+#define DEF_CANVAS_Y_SCROLL_CMD ""
+#define DEF_CANVAS_Y_SCROLL_INCREMENT "0"
+
+/*
+ * Defaults for entries:
+ */
+
+#define DEF_ENTRY_BG_COLOR NORMAL_BG
+#define DEF_ENTRY_BG_MONO WHITE
+/* #define DEF_ENTRY_BORDER_WIDTH "2" */
+#define DEF_ENTRY_BORDER_WIDTH "1"
+#define DEF_ENTRY_CURSOR "xterm"
+#define DEF_ENTRY_EXPORT_SELECTION "1"
+#define DEF_ENTRY_FONT "Helvetica 12"
+#define DEF_ENTRY_FG BLACK
+#define DEF_ENTRY_HIGHLIGHT_BG NORMAL_BG
+#define DEF_ENTRY_HIGHLIGHT BLACK
+/* #define DEF_ENTRY_HIGHLIGHT_WIDTH "3" */
+#define DEF_ENTRY_HIGHLIGHT_WIDTH "0"
+#define DEF_ENTRY_INSERT_BG BLACK
+#define DEF_ENTRY_INSERT_BD_COLOR "0"
+#define DEF_ENTRY_INSERT_BD_MONO "0"
+#define DEF_ENTRY_INSERT_OFF_TIME "300"
+#define DEF_ENTRY_INSERT_ON_TIME "600"
+/* #define DEF_ENTRY_INSERT_WIDTH "2" */
+#define DEF_ENTRY_INSERT_WIDTH "1"
+#define DEF_ENTRY_JUSTIFY "left"
+/* #define DEF_ENTRY_RELIEF "sunken" */
+#define DEF_ENTRY_RELIEF "solid"
+#define DEF_ENTRY_SCROLL_COMMAND ""
+#define DEF_ENTRY_SELECT_COLOR SELECT_BG
+#define DEF_ENTRY_SELECT_MONO BLACK
+#define DEF_ENTRY_SELECT_BD_COLOR "1"
+#define DEF_ENTRY_SELECT_BD_MONO "0"
+#define DEF_ENTRY_SELECT_FG_COLOR SELECT_FG
+#define DEF_ENTRY_SELECT_FG_MONO WHITE
+#define DEF_ENTRY_SHOW (char *) NULL
+#define DEF_ENTRY_STATE "normal"
+#define DEF_ENTRY_TAKE_FOCUS (char *) NULL
+#define DEF_ENTRY_TEXT_VARIABLE ""
+#define DEF_ENTRY_WIDTH "20"
+
+/*
+ * Defaults for frames:
+ */
+
+#define DEF_FRAME_BG_COLOR NORMAL_BG
+#define DEF_FRAME_BG_MONO WHITE
+#define DEF_FRAME_BORDER_WIDTH "0"
+#define DEF_FRAME_CLASS "Frame"
+#define DEF_FRAME_COLORMAP ""
+#define DEF_FRAME_CONTAINER "0"
+#define DEF_FRAME_CURSOR ""
+#define DEF_FRAME_HEIGHT "0"
+#define DEF_FRAME_HIGHLIGHT_BG NORMAL_BG
+#define DEF_FRAME_HIGHLIGHT BLACK
+#define DEF_FRAME_HIGHLIGHT_WIDTH "0"
+#define DEF_FRAME_RELIEF "flat"
+#define DEF_FRAME_TAKE_FOCUS "0"
+#define DEF_FRAME_USE ""
+#define DEF_FRAME_VISUAL ""
+#define DEF_FRAME_WIDTH "0"
+
+/*
+ * Defaults for listboxes:
+ */
+
+#define DEF_LISTBOX_BG_COLOR NORMAL_BG
+#define DEF_LISTBOX_BG_MONO WHITE
+#define DEF_LISTBOX_BORDER_WIDTH "1"
+#define DEF_LISTBOX_CURSOR ""
+#define DEF_LISTBOX_EXPORT_SELECTION "1"
+#define DEF_LISTBOX_FONT "application"
+#define DEF_LISTBOX_FG BLACK
+#define DEF_LISTBOX_HEIGHT "10"
+#define DEF_LISTBOX_HIGHLIGHT_BG NORMAL_BG
+#define DEF_LISTBOX_HIGHLIGHT BLACK
+#define DEF_LISTBOX_HIGHLIGHT_WIDTH "0"
+#define DEF_LISTBOX_RELIEF "solid"
+#define DEF_LISTBOX_SCROLL_COMMAND ""
+#define DEF_LISTBOX_SELECT_COLOR SELECT_BG
+#define DEF_LISTBOX_SELECT_MONO BLACK
+#define DEF_LISTBOX_SELECT_BD "0"
+#define DEF_LISTBOX_SELECT_FG_COLOR SELECT_FG
+#define DEF_LISTBOX_SELECT_FG_MONO WHITE
+#define DEF_LISTBOX_SELECT_MODE "browse"
+#define DEF_LISTBOX_SET_GRID "0"
+#define DEF_LISTBOX_TAKE_FOCUS (char *) NULL
+#define DEF_LISTBOX_WIDTH "20"
+
+/*
+ * Defaults for individual entries of menus:
+ */
+
+#define DEF_MENU_ENTRY_ACTIVE_BG (char *) NULL
+#define DEF_MENU_ENTRY_ACTIVE_FG (char *) NULL
+#define DEF_MENU_ENTRY_ACCELERATOR (char *) NULL
+#define DEF_MENU_ENTRY_BG (char *) NULL
+#define DEF_MENU_ENTRY_BITMAP None
+#define DEF_MENU_ENTRY_COLUMN_BREAK "0"
+#define DEF_MENU_ENTRY_COMMAND (char *) NULL
+#define DEF_MENU_ENTRY_FG (char *) NULL
+#define DEF_MENU_ENTRY_FONT (char *) NULL
+#define DEF_MENU_ENTRY_HIDE_MARGIN "0"
+#define DEF_MENU_ENTRY_IMAGE (char *) NULL
+#define DEF_MENU_ENTRY_INDICATOR "1"
+#define DEF_MENU_ENTRY_LABEL (char *) NULL
+#define DEF_MENU_ENTRY_MENU (char *) NULL
+#define DEF_MENU_ENTRY_OFF_VALUE "0"
+#define DEF_MENU_ENTRY_ON_VALUE "1"
+#define DEF_MENU_ENTRY_SELECT_IMAGE (char *) NULL
+#define DEF_MENU_ENTRY_STATE "normal"
+#define DEF_MENU_ENTRY_VALUE (char *) NULL
+#define DEF_MENU_ENTRY_CHECK_VARIABLE (char *) NULL
+#define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton"
+#define DEF_MENU_ENTRY_SELECT (char *) NULL
+#define DEF_MENU_ENTRY_UNDERLINE "-1"
+
+/*
+ * Defaults for menus overall:
+ */
+
+#define DEF_MENU_ACTIVE_BG_COLOR "SystemMenuActive"
+#define DEF_MENU_ACTIVE_BG_MONO BLACK
+#define DEF_MENU_ACTIVE_BORDER_WIDTH "0"
+#define DEF_MENU_ACTIVE_FG_COLOR "SystemMenuActiveText"
+#define DEF_MENU_ACTIVE_FG_MONO WHITE
+#define DEF_MENU_BG_COLOR "SystemMenu"
+#define DEF_MENU_BG_MONO WHITE
+#define DEF_MENU_BORDER_WIDTH "0"
+#define DEF_MENU_CURSOR "arrow"
+#define DEF_MENU_DISABLED_FG_COLOR "SystemMenuDisabled"
+#define DEF_MENU_DISABLED_FG_MONO ""
+#define DEF_MENU_FONT "system"
+#define DEF_MENU_FG "SystemMenuText"
+#define DEF_MENU_POST_COMMAND ""
+#define DEF_MENU_RELIEF "flat"
+#define DEF_MENU_SELECT_COLOR "SystemMenuActive"
+#define DEF_MENU_SELECT_MONO BLACK
+#define DEF_MENU_TAKE_FOCUS "0"
+#define DEF_MENU_TEAROFF "1"
+#define DEF_MENU_TEAROFF_CMD (char *) NULL
+#define DEF_MENU_TITLE ""
+#define DEF_MENU_TYPE "normal"
+
+/*
+ * Defaults for menubuttons:
+ */
+
+#define DEF_MENUBUTTON_ANCHOR "center"
+#define DEF_MENUBUTTON_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_MENUBUTTON_ACTIVE_BG_MONO BLACK
+#define DEF_MENUBUTTON_ACTIVE_FG_COLOR BLACK
+#define DEF_MENUBUTTON_ACTIVE_FG_MONO WHITE
+#define DEF_MENUBUTTON_BG_COLOR NORMAL_BG
+#define DEF_MENUBUTTON_BG_MONO WHITE
+#define DEF_MENUBUTTON_BITMAP ""
+#define DEF_MENUBUTTON_BORDER_WIDTH "2"
+#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 ""
+#define DEF_MENUBUTTON_PADX "4p"
+#define DEF_MENUBUTTON_PADY "3p"
+#define DEF_MENUBUTTON_RELIEF "flat"
+#define DEF_MENUBUTTON_STATE "normal"
+#define DEF_MENUBUTTON_TAKE_FOCUS "0"
+#define DEF_MENUBUTTON_TEXT ""
+#define DEF_MENUBUTTON_TEXT_VARIABLE ""
+#define DEF_MENUBUTTON_UNDERLINE "-1"
+#define DEF_MENUBUTTON_WIDTH "0"
+#define DEF_MENUBUTTON_WRAP_LENGTH "0"
+
+/*
+ * Defaults for messages:
+ */
+
+#define DEF_MESSAGE_ANCHOR "center"
+#define DEF_MESSAGE_ASPECT "150"
+#define DEF_MESSAGE_BG_COLOR NORMAL_BG
+#define DEF_MESSAGE_BG_MONO WHITE
+#define DEF_MESSAGE_BORDER_WIDTH "2"
+#define DEF_MESSAGE_CURSOR ""
+#define DEF_MESSAGE_FG BLACK
+#define DEF_MESSAGE_FONT "system"
+#define DEF_MESSAGE_HIGHLIGHT_BG NORMAL_BG
+#define DEF_MESSAGE_HIGHLIGHT BLACK
+#define DEF_MESSAGE_HIGHLIGHT_WIDTH "0"
+#define DEF_MESSAGE_JUSTIFY "left"
+#define DEF_MESSAGE_PADX "-1"
+#define DEF_MESSAGE_PADY "-1"
+#define DEF_MESSAGE_RELIEF "flat"
+#define DEF_MESSAGE_TAKE_FOCUS "0"
+#define DEF_MESSAGE_TEXT ""
+#define DEF_MESSAGE_TEXT_VARIABLE ""
+#define DEF_MESSAGE_WIDTH "0"
+
+/*
+ * Defaults for scales:
+ */
+
+#define DEF_SCALE_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_SCALE_ACTIVE_BG_MONO BLACK
+#define DEF_SCALE_BG_COLOR NORMAL_BG
+#define DEF_SCALE_BG_MONO WHITE
+#define DEF_SCALE_BIG_INCREMENT "0"
+#define DEF_SCALE_BORDER_WIDTH "2"
+#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"
+#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"
+#define DEF_SCALE_STATE "normal"
+#define DEF_SCALE_TAKE_FOCUS (char *) NULL
+#define DEF_SCALE_TICK_INTERVAL "0"
+#define DEF_SCALE_TO "100"
+#define DEF_SCALE_VARIABLE ""
+#define DEF_SCALE_WIDTH "15"
+
+/*
+ * Defaults for scrollbars:
+ */
+
+#define DEF_SCROLLBAR_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_SCROLLBAR_ACTIVE_BG_MONO BLACK
+#define DEF_SCROLLBAR_ACTIVE_RELIEF "raised"
+#define DEF_SCROLLBAR_BG_COLOR NORMAL_BG
+#define DEF_SCROLLBAR_BG_MONO WHITE
+/* #define DEF_SCROLLBAR_BORDER_WIDTH "2" */
+#define DEF_SCROLLBAR_BORDER_WIDTH "0"
+#define DEF_SCROLLBAR_COMMAND ""
+#define DEF_SCROLLBAR_CURSOR ""
+#define DEF_SCROLLBAR_EL_BORDER_WIDTH "-1"
+#define DEF_SCROLLBAR_HIGHLIGHT_BG NORMAL_BG
+#define DEF_SCROLLBAR_HIGHLIGHT BLACK
+/* #define DEF_SCROLLBAR_HIGHLIGHT_WIDTH "2" */
+#define DEF_SCROLLBAR_HIGHLIGHT_WIDTH "0"
+#define DEF_SCROLLBAR_JUMP "0"
+#define DEF_SCROLLBAR_ORIENT "vertical"
+/*#define DEF_SCROLLBAR_RELIEF "sunken" */
+#define DEF_SCROLLBAR_RELIEF "flat"
+#define DEF_SCROLLBAR_REPEAT_DELAY "300"
+#define DEF_SCROLLBAR_REPEAT_INTERVAL "100"
+#define DEF_SCROLLBAR_TAKE_FOCUS (char *) NULL
+#define DEF_SCROLLBAR_TROUGH_COLOR TROUGH
+#define DEF_SCROLLBAR_TROUGH_MONO WHITE
+/*#define DEF_SCROLLBAR_WIDTH "15" */
+#define DEF_SCROLLBAR_WIDTH "16"
+
+/*
+ * Defaults for texts:
+ */
+
+#define DEF_TEXT_BG_COLOR NORMAL_BG
+#define DEF_TEXT_BG_MONO WHITE
+#define DEF_TEXT_BORDER_WIDTH "0"
+#define DEF_TEXT_CURSOR "xterm"
+#define DEF_TEXT_FG BLACK
+#define DEF_TEXT_EXPORT_SELECTION "1"
+#define DEF_TEXT_FONT "Courier 12"
+#define DEF_TEXT_HEIGHT "24"
+#define DEF_TEXT_HIGHLIGHT_BG NORMAL_BG
+#define DEF_TEXT_HIGHLIGHT BLACK
+#define DEF_TEXT_HIGHLIGHT_WIDTH "3"
+#define DEF_TEXT_INSERT_BG BLACK
+#define DEF_TEXT_INSERT_BD_COLOR "0"
+#define DEF_TEXT_INSERT_BD_MONO "0"
+#define DEF_TEXT_INSERT_OFF_TIME "300"
+#define DEF_TEXT_INSERT_ON_TIME "600"
+#define DEF_TEXT_INSERT_WIDTH "1"
+#define DEF_TEXT_PADX "1"
+#define DEF_TEXT_PADY "1"
+#define DEF_TEXT_RELIEF "flat"
+#define DEF_TEXT_SELECT_COLOR SELECT_BG
+#define DEF_TEXT_SELECT_MONO BLACK
+#define DEF_TEXT_SELECT_BD_COLOR "1"
+#define DEF_TEXT_SELECT_BD_MONO "0"
+#define DEF_TEXT_SELECT_FG_COLOR SELECT_FG
+#define DEF_TEXT_SELECT_FG_MONO WHITE
+#define DEF_TEXT_SELECT_RELIEF "solid"
+#define DEF_TEXT_SET_GRID "0"
+#define DEF_TEXT_SPACING1 "0"
+#define DEF_TEXT_SPACING2 "0"
+#define DEF_TEXT_SPACING3 "0"
+#define DEF_TEXT_STATE "normal"
+#define DEF_TEXT_TABS ""
+#define DEF_TEXT_TAKE_FOCUS (char *) NULL
+#define DEF_TEXT_WIDTH "80"
+#define DEF_TEXT_WRAP "char"
+#define DEF_TEXT_XSCROLL_COMMAND ""
+#define DEF_TEXT_YSCROLL_COMMAND ""
+#define DEF_TEXT_TAB_SIZE "8"
+
+/*
+ * Defaults for canvas text:
+ */
+
+#define DEF_CANVTEXT_FONT "Helvetica 12"
+
+/*
+ * Defaults for toplevels (most of the defaults for frames also apply
+ * to toplevels):
+ */
+
+#define DEF_TOPLEVEL_CLASS "Toplevel"
+#define DEF_TOPLEVEL_MENU ""
+#define DEF_TOPLEVEL_SCREEN ""
+
+#endif /* _TKMACDEFAULT */
diff --git a/tk/mac/tkMacDialog.c b/tk/mac/tkMacDialog.c
new file mode 100644
index 00000000000..0067a9f7f35
--- /dev/null
+++ b/tk/mac/tkMacDialog.c
@@ -0,0 +1,939 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ *
+ */
+
+#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
+ * the type of the event.
+ *
+ * Results:
+ * A standard result understood by the Mac file dialog event dispatcher.
+ *
+ * Side effects:
+ * The contents in the file dialog may be changed depending on
+ * the type of the event.
+ *----------------------------------------------------------------------
+ */
+
+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;
+ }
+
+ return item;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FileFilterProc --
+ *
+ * Filters files according to file types. Get called whenever the
+ * file list needs to be updated inside the dialog box.
+ *
+ * Results:
+ * Returns MATCHED if the file should be shown in the listbox, returns
+ * UNMATCHED otherwise.
+ *
+ * Side effects:
+ * If MATCHED is returned, the file is shown in the listbox.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MatchOneType --
+ *
+ * Match a file with one file type in the list of file types.
+ *
+ * Results:
+ * Returns MATCHED if the file matches with the file type; returns
+ * UNMATCHED otherwise.
+ *
+ * Side effects:
+ * None
+ *
+ *----------------------------------------------------------------------
+ */
+
+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
+ * clause of the type.
+ *
+ * If the clause has both glob patterns and ostypes, the file must
+ * match with at least one pattern AND at least one ostype.
+ *
+ * If the clause has glob patterns only, the file must match with at least
+ * one pattern.
+ *
+ * If the clause has mac types only, the file must match with at least
+ * one mac type.
+ *
+ * If the clause has neither glob patterns nor mac types, it's
+ * considered an error.
+ */
+
+ for (clausePtr=filterPtr->clauses; clausePtr; clausePtr=clausePtr->next) {
+ int macMatched = 0;
+ int globMatched = 0;
+ GlobPattern * globPtr;
+ MacFileType * mfPtr;
+
+ if (clausePtr->patterns == NULL) {
+ globMatched = 1;
+ }
+ if (clausePtr->macTypes == NULL) {
+ macMatched = 1;
+ }
+
+ for (globPtr=clausePtr->patterns; globPtr; globPtr=globPtr->next) {
+ char filename[256];
+ int len;
+ char * p, *q, *ext;
+
+ if (pb->hFileInfo.ioNamePtr == NULL) {
+ continue;
+ }
+ p = (char*)(pb->hFileInfo.ioNamePtr);
+ len = p[0];
+ strncpy(filename, p+1, len);
+ filename[len] = '\0';
+ ext = globPtr->pattern;
+
+ if (ext[0] == '\0') {
+ /*
+ * We don't want any extensions: OK if the filename doesn't
+ * have "." in it
+ */
+ for (q=filename; *q; q++) {
+ if (*q == '.') {
+ goto glob_unmatched;
+ }
+ }
+ goto glob_matched;
+ }
+
+ if (Tcl_StringMatch(filename, ext)) {
+ goto glob_matched;
+ } else {
+ goto glob_unmatched;
+ }
+
+ glob_unmatched:
+ continue;
+
+ glob_matched:
+ globMatched = 1;
+ break;
+ }
+
+ for (mfPtr=clausePtr->macTypes; mfPtr; mfPtr=mfPtr->next) {
+ if (pb->hFileInfo.ioFlFndrInfo.fdType == mfPtr->type) {
+ macMatched = 1;
+ break;
+ }
+ }
+
+ 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);
+}
diff --git a/tk/mac/tkMacDraw.c b/tk/mac/tkMacDraw.c
new file mode 100644
index 00000000000..cb26d39eb52
--- /dev/null
+++ b/tk/mac/tkMacDraw.c
@@ -0,0 +1,1130 @@
+/*
+ * 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$
+ */
+
+#include "tkInt.h"
+#include "X.h"
+#include "Xlib.h"
+#include <stdio.h>
+#include <tcl.h>
+
+#include <Windows.h>
+#include <Fonts.h>
+#include <QDOffscreen.h>
+#include "tkMacInt.h"
+
+#ifndef PI
+# define PI 3.14159265358979323846
+#endif
+
+/*
+ * Temporary regions that can be reused.
+ */
+static RgnHandle tmpRgn = NULL;
+static RgnHandle tmpRgn2 = NULL;
+
+static PixPatHandle gPenPat = NULL;
+
+/*
+ * Prototypes for functions used only in this file.
+ */
+static unsigned char InvertByte _ANSI_ARGS_((unsigned char data));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XCopyArea --
+ *
+ * Copies data from one drawable to another using block transfer
+ * routines.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Data is moved from a window or bitmap to a second window or
+ * bitmap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XCopyArea(
+ Display* display, /* Display. */
+ Drawable src, /* Source drawable. */
+ Drawable dest, /* Destination drawable. */
+ GC gc, /* GC to use. */
+ int src_x, /* X & Y, width & height */
+ int src_y, /* define the source rectangle */
+ unsigned int width, /* the will be copied. */
+ unsigned int height,
+ int dest_x, /* Dest X & Y on dest rect. */
+ int dest_y)
+{
+ Rect srcRect, destRect;
+ BitMapPtr srcBit, destBit;
+ MacDrawable *srcDraw = (MacDrawable *) src;
+ MacDrawable *destDraw = (MacDrawable *) dest;
+ GWorldPtr srcPort, destPort;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ short tmode;
+ RGBColor origForeColor, origBackColor, whiteColor, blackColor;
+
+ destPort = TkMacGetDrawablePort(dest);
+ srcPort = TkMacGetDrawablePort(src);
+
+ display->request++;
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+ GetForeColor(&origForeColor);
+ GetBackColor(&origBackColor);
+ whiteColor.red = 0;
+ whiteColor.blue = 0;
+ whiteColor.green = 0;
+ RGBForeColor(&whiteColor);
+ blackColor.red = 0xFFFF;
+ blackColor.blue = 0xFFFF;
+ blackColor.green = 0xFFFF;
+ RGBBackColor(&blackColor);
+
+
+ TkMacSetUpClippingRgn(dest);
+
+ /*
+ * We will change the clip rgn in this routine, so we need to
+ * be able to restore it when we exit.
+ */
+
+ if (tmpRgn2 == NULL) {
+ tmpRgn2 = NewRgn();
+ }
+ GetClip(tmpRgn2);
+
+ if (((TkpClipMask*)gc->clip_mask)->type == TKP_CLIP_REGION) {
+ RgnHandle clipRgn = (RgnHandle)
+ ((TkpClipMask*)gc->clip_mask)->value.region;
+
+ int xOffset, yOffset;
+
+ if (tmpRgn == NULL) {
+ tmpRgn = NewRgn();
+ }
+
+ xOffset = destDraw->xOff + gc->clip_x_origin;
+ yOffset = destDraw->yOff + gc->clip_y_origin;
+
+ OffsetRgn(clipRgn, xOffset, yOffset);
+
+ GetClip(tmpRgn);
+ SectRgn(tmpRgn, clipRgn, tmpRgn);
+
+ SetClip(tmpRgn);
+
+ OffsetRgn(clipRgn, -xOffset, -yOffset);
+ }
+
+ srcBit = &((GrafPtr) srcPort)->portBits;
+ destBit = &((GrafPtr) destPort)->portBits;
+ SetRect(&srcRect, (short) (srcDraw->xOff + src_x),
+ (short) (srcDraw->yOff + src_y),
+ (short) (srcDraw->xOff + src_x + width),
+ (short) (srcDraw->yOff + src_y + height));
+ SetRect(&destRect, (short) (destDraw->xOff + dest_x),
+ (short) (destDraw->yOff + dest_y),
+ (short) (destDraw->xOff + dest_x + width),
+ (short) (destDraw->yOff + dest_y + height));
+ tmode = srcCopy;
+
+ CopyBits(srcBit, destBit, &srcRect, &destRect, tmode, NULL);
+ RGBForeColor(&origForeColor);
+ RGBBackColor(&origBackColor);
+ SetClip(tmpRgn2);
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XCopyPlane --
+ *
+ * Copies a bitmap from a source drawable to a destination
+ * drawable. The plane argument specifies which bit plane of
+ * the source contains the bitmap. Note that this implementation
+ * ignores the gc->function.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the destination drawable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XCopyPlane(
+ Display* display, /* Display. */
+ Drawable src, /* Source drawable. */
+ Drawable dest, /* Destination drawable. */
+ GC gc, /* The GC to use. */
+ int src_x, /* X, Y, width & height */
+ int src_y, /* define the source rect. */
+ unsigned int width,
+ unsigned int height,
+ int dest_x, /* X & Y on dest where we will copy. */
+ int dest_y,
+ unsigned long plane) /* Which plane to copy. */
+{
+ Rect srcRect, destRect;
+ BitMapPtr srcBit, destBit, maskBit;
+ MacDrawable *srcDraw = (MacDrawable *) src;
+ MacDrawable *destDraw = (MacDrawable *) dest;
+ GWorldPtr srcPort, destPort, maskPort;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ RGBColor macColor;
+ TkpClipMask *clipPtr = (TkpClipMask*)gc->clip_mask;
+ short tmode;
+
+ destPort = TkMacGetDrawablePort(dest);
+ srcPort = TkMacGetDrawablePort(src);
+
+ display->request++;
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacSetUpClippingRgn(dest);
+
+ srcBit = &((GrafPtr) srcPort)->portBits;
+ destBit = &((GrafPtr) destPort)->portBits;
+ SetRect(&srcRect, (short) (srcDraw->xOff + src_x),
+ (short) (srcDraw->yOff + src_y),
+ (short) (srcDraw->xOff + src_x + width),
+ (short) (srcDraw->yOff + src_y + height));
+ SetRect(&destRect, (short) (destDraw->xOff + dest_x),
+ (short) (destDraw->yOff + dest_y),
+ (short) (destDraw->xOff + dest_x + width),
+ (short) (destDraw->yOff + dest_y + height));
+ tmode = srcOr;
+ tmode = srcCopy + transparent;
+
+ if (TkSetMacColor(gc->foreground, &macColor) == true) {
+ RGBForeColor(&macColor);
+ }
+
+ if (clipPtr == NULL || clipPtr->type == TKP_CLIP_REGION) {
+
+ /*
+ * Case 1: opaque bitmaps.
+ */
+
+ TkSetMacColor(gc->background, &macColor);
+ RGBBackColor(&macColor);
+ tmode = srcCopy;
+ CopyBits(srcBit, destBit, &srcRect, &destRect, tmode, NULL);
+ } else if (clipPtr->type == TKP_CLIP_PIXMAP) {
+ if (clipPtr->value.pixmap == src) {
+ /*
+ * Case 2: transparent bitmaps. If it's color we ignore
+ * the forecolor.
+ */
+ if ((**(srcPort->portPixMap)).pixelSize == 1) {
+ tmode = srcOr;
+ } else {
+ tmode = transparent;
+ }
+ CopyBits(srcBit, destBit, &srcRect, &destRect, tmode, NULL);
+ } else {
+ /*
+ * Case 3: two arbitrary bitmaps.
+ */
+ tmode = srcCopy;
+ maskPort = TkMacGetDrawablePort(clipPtr->value.pixmap);
+ maskBit = &((GrafPtr) maskPort)->portBits;
+ CopyDeepMask(srcBit, maskBit, destBit, &srcRect, &srcRect, &destRect, tmode, NULL);
+ }
+ }
+
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPutImage --
+ *
+ * Copies a subimage from an in-memory image to a rectangle of
+ * of the specified drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Draws the image on the specified drawable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkPutImage(
+ unsigned long *colors, /* Unused on Macintosh. */
+ int ncolors, /* Unused on Macintosh. */
+ Display* display, /* Display. */
+ Drawable d, /* Drawable to place image on. */
+ GC gc, /* GC to use. */
+ XImage* image, /* Image to place. */
+ int src_x, /* Source X & Y. */
+ int src_y,
+ int dest_x, /* Destination X & Y. */
+ int dest_y,
+ unsigned int width, /* Same width & height for both */
+ unsigned int height) /* distination and source. */
+{
+ MacDrawable *destDraw = (MacDrawable *) d;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+ int i, j;
+ BitMap bitmap;
+ char *newData = NULL;
+ Rect destRect, srcRect;
+
+ destPort = TkMacGetDrawablePort(d);
+ SetRect(&destRect, dest_x, dest_y, dest_x + width, dest_y + height);
+ SetRect(&srcRect, src_x, src_y, src_x + width, src_y + height);
+
+ display->request++;
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacSetUpClippingRgn(d);
+
+ if (image->depth == 1) {
+
+ /*
+ * This code assumes a pixel depth of 1
+ */
+
+ bitmap.bounds.top = bitmap.bounds.left = 0;
+ bitmap.bounds.right = (short) image->width;
+ bitmap.bounds.bottom = (short) image->height;
+ if ((image->bytes_per_line % 2) == 1) {
+ char *newPtr, *oldPtr;
+ newData = (char *) ckalloc(image->height *
+ (image->bytes_per_line + 1));
+ newPtr = newData;
+ oldPtr = image->data;
+ for (i = 0; i < image->height; i++) {
+ for (j = 0; j < image->bytes_per_line; j++) {
+ *newPtr = InvertByte((unsigned char) *oldPtr);
+ newPtr++, oldPtr++;
+ }
+ *newPtr = 0;
+ newPtr++;
+ }
+ bitmap.baseAddr = newData;
+ bitmap.rowBytes = image->bytes_per_line + 1;
+ } else {
+ newData = (char *) ckalloc(image->height * image->bytes_per_line);
+ for (i = 0; i < image->height * image->bytes_per_line; i++) {
+ newData[i] = InvertByte((unsigned char) image->data[i]);
+ }
+ bitmap.baseAddr = newData;
+ bitmap.rowBytes = image->bytes_per_line;
+ }
+
+ CopyBits(&bitmap, &((GrafPtr) destPort)->portBits,
+ &srcRect, &destRect, srcCopy, NULL);
+
+ } else {
+ /* Color image */
+ PixMap pixmap;
+
+ pixmap.bounds.left = 0;
+ pixmap.bounds.top = 0;
+ pixmap.bounds.right = (short) image->width;
+ pixmap.bounds.bottom = (short) image->height;
+ pixmap.pixelType = RGBDirect;
+ pixmap.pmVersion = 4; /* 32bit clean */
+ pixmap.packType = 0;
+ pixmap.packSize = 0;
+ pixmap.hRes = 0x00480000;
+ pixmap.vRes = 0x00480000;
+ pixmap.pixelSize = 32;
+ pixmap.cmpCount = 3;
+ pixmap.cmpSize = 8;
+ pixmap.planeBytes = 0;
+ pixmap.pmTable = NULL;
+ pixmap.pmReserved = 0;
+ pixmap.baseAddr = image->data;
+ pixmap.rowBytes = image->bytes_per_line | 0x8000;
+
+ CopyBits((BitMap *) &pixmap, &((GrafPtr) destPort)->portBits,
+ &srcRect, &destRect, srcCopy, NULL);
+ }
+
+ if (newData != NULL) {
+ ckfree(newData);
+ }
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XFillRectangles --
+ *
+ * Fill multiple rectangular areas in the given drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Draws onto the specified drawable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XFillRectangles(
+ Display* display, /* Display. */
+ Drawable d, /* Draw on this. */
+ GC gc, /* Use this GC. */
+ XRectangle *rectangles, /* Rectangle array. */
+ int n_rectangels) /* Number of rectangles. */
+{
+ MacDrawable *macWin = (MacDrawable *) d;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+ Rect theRect;
+ int i;
+
+ destPort = TkMacGetDrawablePort(d);
+
+ display->request++;
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacSetUpClippingRgn(d);
+
+ TkMacSetUpGraphicsPort(gc);
+
+ for (i=0; i<n_rectangels; i++) {
+ theRect.left = (short) (macWin->xOff + rectangles[i].x);
+ theRect.top = (short) (macWin->yOff + rectangles[i].y);
+ theRect.right = (short) (theRect.left + rectangles[i].width);
+ theRect.bottom = (short) (theRect.top + rectangles[i].height);
+ FillCRect(&theRect, gPenPat);
+ }
+
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XDrawLines --
+ *
+ * Draw connected lines.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Renders a series of connected lines.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XDrawLines(
+ Display* display, /* Display. */
+ Drawable d, /* Draw on this. */
+ GC gc, /* Use this GC. */
+ XPoint* points, /* Array of points. */
+ int npoints, /* Number of points. */
+ int mode) /* Line drawing mode. */
+{
+ MacDrawable *macWin = (MacDrawable *) d;
+ CGrafPtr saveWorld;
+ GWorldPtr destPort;
+ GDHandle saveDevice;
+ int i;
+
+ destPort = TkMacGetDrawablePort(d);
+
+ display->request++;
+ if (npoints < 2) {
+ return; /* TODO: generate BadValue error. */
+ }
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacSetUpClippingRgn(d);
+
+ TkMacSetUpGraphicsPort(gc);
+
+ ShowPen();
+
+ PenPixPat(gPenPat);
+ MoveTo((short) (macWin->xOff + points[0].x),
+ (short) (macWin->yOff + points[0].y));
+ for (i = 1; i < npoints; i++) {
+ if (mode == CoordModeOrigin) {
+ LineTo((short) (macWin->xOff + points[i].x),
+ (short) (macWin->yOff + points[i].y));
+ } else {
+ Line((short) (macWin->xOff + points[i].x),
+ (short) (macWin->yOff + points[i].y));
+ }
+ }
+
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XDrawSegments --
+ *
+ * Draw unconnected lines.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Renders a series of connected lines.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void XDrawSegments(
+ Display *display,
+ Drawable d,
+ GC gc,
+ XSegment *segments,
+ int nsegments)
+{
+ MacDrawable *macWin = (MacDrawable *) d;
+ CGrafPtr saveWorld;
+ GWorldPtr destPort;
+ GDHandle saveDevice;
+ int i;
+
+ destPort = TkMacGetDrawablePort(d);
+
+ display->request++;
+
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacSetUpClippingRgn(d);
+
+ TkMacSetUpGraphicsPort(gc);
+
+ ShowPen();
+
+ PenPixPat(gPenPat);
+ for (i = 0; i < nsegments; i++) {
+ MoveTo((short) (macWin->xOff + segments[i].x1),
+ (short) (macWin->yOff + segments[i].y1));
+ LineTo((short) (macWin->xOff + segments[i].x2),
+ (short) (macWin->yOff + segments[i].y2));
+ }
+
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XFillPolygon --
+ *
+ * Draws a filled polygon.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Draws a filled polygon on the specified drawable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XFillPolygon(
+ Display* display, /* Display. */
+ Drawable d, /* Draw on this. */
+ GC gc, /* Use this GC. */
+ XPoint* points, /* Array of points. */
+ int npoints, /* Number of points. */
+ int shape, /* Shape to draw. */
+ int mode) /* Drawing mode. */
+{
+ MacDrawable *macWin = (MacDrawable *) d;
+ PolyHandle polygon;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+ int i;
+
+ destPort = TkMacGetDrawablePort(d);
+
+ display->request++;
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacSetUpClippingRgn(d);
+
+ TkMacSetUpGraphicsPort(gc);
+
+ PenNormal();
+ polygon = OpenPoly();
+
+ MoveTo((short) (macWin->xOff + points[0].x),
+ (short) (macWin->yOff + points[0].y));
+ for (i = 1; i < npoints; i++) {
+ if (mode == CoordModePrevious) {
+ Line((short) (macWin->xOff + points[i].x),
+ (short) (macWin->yOff + points[i].y));
+ } else {
+ LineTo((short) (macWin->xOff + points[i].x),
+ (short) (macWin->yOff + points[i].y));
+ }
+ }
+
+ ClosePoly();
+
+ FillCPoly(polygon, gPenPat);
+
+ KillPoly(polygon);
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XDrawRectangle --
+ *
+ * Draws a rectangle.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Draws a rectangle on the specified drawable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XDrawRectangle(
+ Display* display, /* Display. */
+ Drawable d, /* Draw on this. */
+ GC gc, /* Use this GC. */
+ int x, /* Upper left corner. */
+ int y,
+ unsigned int width, /* Width & height of rect. */
+ unsigned int height)
+{
+ MacDrawable *macWin = (MacDrawable *) d;
+ Rect theRect;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+
+ destPort = TkMacGetDrawablePort(d);
+
+ display->request++;
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacSetUpClippingRgn(d);
+
+ TkMacSetUpGraphicsPort(gc);
+
+ theRect.left = (short) (macWin->xOff + x);
+ theRect.top = (short) (macWin->yOff + y);
+ theRect.right = (short) (theRect.left + width);
+ theRect.bottom = (short) (theRect.top + height);
+
+ ShowPen();
+ PenPixPat(gPenPat);
+ FrameRect(&theRect);
+
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XDrawArc --
+ *
+ * Draw an arc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Draws an arc on the specified drawable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XDrawArc(
+ Display* display, /* Display. */
+ Drawable d, /* Draw on this. */
+ GC gc, /* Use this GC. */
+ int x, /* Upper left of */
+ int y, /* bounding rect. */
+ unsigned int width, /* Width & height. */
+ unsigned int height,
+ int angle1, /* Staring angle of arc. */
+ int angle2) /* Ending angle of arc. */
+{
+ MacDrawable *macWin = (MacDrawable *) d;
+ Rect theRect;
+ short start, extent;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+
+ destPort = TkMacGetDrawablePort(d);
+
+ display->request++;
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacSetUpClippingRgn(d);
+
+ TkMacSetUpGraphicsPort(gc);
+
+ theRect.left = (short) (macWin->xOff + x);
+ theRect.top = (short) (macWin->yOff + y);
+ theRect.right = (short) (theRect.left + width);
+ theRect.bottom = (short) (theRect.top + height);
+ start = (short) (90 - (angle1 / 64));
+ extent = (short) (-(angle2 / 64));
+
+ ShowPen();
+ PenPixPat(gPenPat);
+ FrameArc(&theRect, start, extent);
+
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XFillArc --
+ *
+ * Draw a filled arc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Draws a filled arc on the specified drawable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XFillArc(
+ Display* display, /* Display. */
+ Drawable d, /* Draw on this. */
+ GC gc, /* Use this GC. */
+ int x, /* Upper left of */
+ int y, /* bounding rect. */
+ unsigned int width, /* Width & height. */
+ unsigned int height,
+ int angle1, /* Staring angle of arc. */
+ int angle2) /* Ending angle of arc. */
+{
+ MacDrawable *macWin = (MacDrawable *) d;
+ Rect theRect;
+ short start, extent;
+ PolyHandle polygon;
+ double sin1, cos1, sin2, cos2, angle;
+ double boxWidth, boxHeight;
+ double vertex[2], center1[2], center2[2];
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+
+ destPort = TkMacGetDrawablePort(d);
+
+ display->request++;
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacSetUpClippingRgn(d);
+
+ TkMacSetUpGraphicsPort(gc);
+
+ theRect.left = (short) (macWin->xOff + x);
+ theRect.top = (short) (macWin->yOff + y);
+ theRect.right = (short) (theRect.left + width);
+ theRect.bottom = (short) (theRect.top + height);
+ start = (short) (90 - (angle1 / 64));
+ extent = (short) (- (angle2 / 64));
+
+ if (gc->arc_mode == ArcChord) {
+ boxWidth = theRect.right - theRect.left;
+ boxHeight = theRect.bottom - theRect.top;
+ angle = -(angle1/64.0)*PI/180.0;
+ sin1 = sin(angle);
+ cos1 = cos(angle);
+ angle -= (angle2/64.0)*PI/180.0;
+ sin2 = sin(angle);
+ cos2 = cos(angle);
+ vertex[0] = (theRect.left + theRect.right)/2.0;
+ vertex[1] = (theRect.top + theRect.bottom)/2.0;
+ center1[0] = vertex[0] + cos1*boxWidth/2.0;
+ center1[1] = vertex[1] + sin1*boxHeight/2.0;
+ center2[0] = vertex[0] + cos2*boxWidth/2.0;
+ center2[1] = vertex[1] + sin2*boxHeight/2.0;
+
+ polygon = OpenPoly();
+ MoveTo((short) ((theRect.left + theRect.right)/2),
+ (short) ((theRect.top + theRect.bottom)/2));
+
+ LineTo((short) (center1[0] + 0.5), (short) (center1[1] + 0.5));
+ LineTo((short) (center2[0] + 0.5), (short) (center2[1] + 0.5));
+ ClosePoly();
+
+ ShowPen();
+ FillCArc(&theRect, start, extent, gPenPat);
+ FillCPoly(polygon, gPenPat);
+
+ KillPoly(polygon);
+ } else {
+ ShowPen();
+ FillCArc(&theRect, start, extent, gPenPat);
+ }
+
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkScrollWindow --
+ *
+ * Scroll a rectangle of the specified window and accumulate
+ * a damage region.
+ *
+ * Results:
+ * Returns 0 if the scroll genereated no additional damage.
+ * Otherwise, sets the region that needs to be repainted after
+ * scrolling and returns 1.
+ *
+ * Side effects:
+ * Scrolls the bits in the window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkScrollWindow(
+ Tk_Window tkwin, /* The window to be scrolled. */
+ GC gc, /* GC for window to be scrolled. */
+ int x, /* Position rectangle to be scrolled. */
+ int y,
+ int width,
+ int height,
+ int dx, /* Distance rectangle should be moved. */
+ int dy,
+ TkRegion damageRgn) /* Region to accumulate damage in. */
+{
+ MacDrawable *destDraw = (MacDrawable *) Tk_WindowId(tkwin);
+ RgnHandle rgn = (RgnHandle) damageRgn;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+ Rect srcRect, scrollRect;
+
+ destPort = TkMacGetDrawablePort(Tk_WindowId(tkwin));
+
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacSetUpClippingRgn(Tk_WindowId(tkwin));
+
+ /*
+ * Due to the implementation below the behavior may be differnt
+ * than X in certain cases that should never occur in Tk. The
+ * scrollRect is the source rect extended by the offset (the union
+ * of the source rect and the offset rect). Everything
+ * in the extended scrollRect is scrolled. On X, it's possible
+ * to "skip" over an area if the offset makes the source and
+ * destination rects disjoint and non-aligned.
+ */
+
+ SetRect(&srcRect, (short) (destDraw->xOff + x),
+ (short) (destDraw->yOff + y),
+ (short) (destDraw->xOff + x + width),
+ (short) (destDraw->yOff + y + height));
+ scrollRect = srcRect;
+ if (dx < 0) {
+ scrollRect.left += dx;
+ } else {
+ scrollRect.right += dx;
+ }
+ if (dy < 0) {
+ scrollRect.top += dy;
+ } else {
+ scrollRect.bottom += dy;
+ }
+
+ /*
+ * Adjust clip region so that we don't copy any windows
+ * that may overlap us.
+ */
+ RectRgn(rgn, &srcRect);
+ DiffRgn(rgn, destPort->visRgn, rgn);
+ OffsetRgn(rgn, dx, dy);
+ DiffRgn(destPort->clipRgn, rgn, destPort->clipRgn);
+ SetEmptyRgn(rgn);
+
+ /*
+ * When a menu is up, the Mac does not expect drawing to occur and
+ * does not clip out the menu. We have to do it ourselves. This
+ * is pretty gross.
+ */
+
+ if (tkUseMenuCascadeRgn == 1) {
+ Point scratch = {0, 0};
+ MacDrawable *macDraw = (MacDrawable *) Tk_WindowId(tkwin);
+
+ LocalToGlobal(&scratch);
+ CopyRgn(tkMenuCascadeRgn, rgn);
+ OffsetRgn(rgn, -scratch.h, -scratch.v);
+ DiffRgn(destPort->clipRgn, rgn, destPort->clipRgn);
+ SetEmptyRgn(rgn);
+ macDraw->toplevel->flags |= TK_DRAWN_UNDER_MENU;
+ }
+
+ ScrollRect(&scrollRect, dx, dy, rgn);
+
+ SetGWorld(saveWorld, saveDevice);
+
+ /*
+ * Fortunantly, the region returned by ScrollRect is symanticlly
+ * the same as what we need to return in this function. If the
+ * region is empty we return zero to denote that no damage was
+ * created.
+ */
+ if (EmptyRgn(rgn)) {
+ return 0;
+ } else {
+ return 1;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacSetUpGraphicsPort --
+ *
+ * Set up the graphics port from the given GC.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The current port is adjusted.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacSetUpGraphicsPort(
+ GC gc) /* GC to apply to current port. */
+{
+ RGBColor macColor;
+
+ if (gPenPat == NULL) {
+ gPenPat = NewPixPat();
+ }
+
+ if (TkSetMacColor(gc->foreground, &macColor) == true) {
+ /* TODO: cache RGBPats for preformace - measure gains... */
+ MakeRGBPat(gPenPat, &macColor);
+ }
+
+ PenNormal();
+ if(gc->function == GXxor) {
+ PenMode(patXor);
+ }
+ if (gc->line_width > 1) {
+ PenSize(gc->line_width, gc->line_width);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacSetUpClippingRgn --
+ *
+ * Set up the clipping region so that drawing only occurs on the
+ * specified X subwindow.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The clipping region in the current port is changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacSetUpClippingRgn(
+ Drawable drawable) /* Drawable to update. */
+{
+ MacDrawable *macDraw = (MacDrawable *) drawable;
+
+ if (macDraw->winPtr != NULL) {
+ if (macDraw->flags & TK_CLIP_INVALID) {
+ TkMacUpdateClipRgn(macDraw->winPtr);
+ }
+
+ /*
+ * When a menu is up, the Mac does not expect drawing to occur and
+ * does not clip out the menu. We have to do it ourselves. This
+ * is pretty gross.
+ */
+
+ if (macDraw->clipRgn != NULL) {
+ if (tkUseMenuCascadeRgn == 1) {
+ Point scratch = {0, 0};
+ GDHandle saveDevice;
+ GWorldPtr saveWorld;
+
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(TkMacGetDrawablePort(drawable), NULL);
+ LocalToGlobal(&scratch);
+ SetGWorld(saveWorld, saveDevice);
+ if (tmpRgn == NULL) {
+ tmpRgn = NewRgn();
+ }
+ CopyRgn(tkMenuCascadeRgn, tmpRgn);
+ OffsetRgn(tmpRgn, -scratch.h, -scratch.v);
+ DiffRgn(macDraw->clipRgn, tmpRgn, tmpRgn);
+ SetClip(tmpRgn);
+ macDraw->toplevel->flags |= TK_DRAWN_UNDER_MENU;
+ } else {
+ SetClip(macDraw->clipRgn);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacMakeStippleMap --
+ *
+ * Given a drawable and a stipple pattern this function draws the
+ * pattern repeatedly over the drawable. The drawable can then
+ * be used as a mask for bit-bliting a stipple pattern over an
+ * object.
+ *
+ * Results:
+ * A BitMap data structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+BitMapPtr
+TkMacMakeStippleMap(
+ Drawable drawable, /* Window to apply stipple. */
+ Drawable stipple) /* The stipple pattern. */
+{
+ MacDrawable *destDraw = (MacDrawable *) drawable;
+ GWorldPtr destPort;
+ BitMapPtr bitmapPtr;
+ int width, height, stippleHeight, stippleWidth;
+ int i, j;
+ char * data;
+ Rect bounds;
+
+ destPort = TkMacGetDrawablePort(drawable);
+ width = destPort->portRect.right - destPort->portRect.left;
+ height = destPort->portRect.bottom - destPort->portRect.top;
+
+ bitmapPtr = (BitMap *) ckalloc(sizeof(BitMap));
+ data = (char *) ckalloc(height * ((width / 8) + 1));
+ bitmapPtr->bounds.top = bitmapPtr->bounds.left = 0;
+ bitmapPtr->bounds.right = (short) width;
+ bitmapPtr->bounds.bottom = (short) height;
+ bitmapPtr->baseAddr = data;
+ bitmapPtr->rowBytes = (width / 8) + 1;
+
+ destPort = TkMacGetDrawablePort(stipple);
+ stippleWidth = destPort->portRect.right - destPort->portRect.left;
+ stippleHeight = destPort->portRect.bottom - destPort->portRect.top;
+
+ for (i = 0; i < height; i += stippleHeight) {
+ for (j = 0; j < width; j += stippleWidth) {
+ bounds.left = j;
+ bounds.top = i;
+ bounds.right = j + stippleWidth;
+ bounds.bottom = i + stippleHeight;
+
+ CopyBits(&((GrafPtr) destPort)->portBits, bitmapPtr,
+ &((GrafPtr) destPort)->portRect, &bounds, srcCopy, NULL);
+ }
+ }
+ return bitmapPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InvertByte --
+ *
+ * This function reverses the bits in the passed in Byte of data.
+ *
+ * Results:
+ * The incoming byte in reverse bit order.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static unsigned char
+InvertByte(
+ unsigned char data) /* Byte of data. */
+{
+ unsigned char i;
+ unsigned char mask = 1, result = 0;
+
+ for (i = (1 << 7); i != 0; i /= 2) {
+ if (data & mask) {
+ result |= i;
+ }
+ mask = mask << 1;
+ }
+ return result;
+}
diff --git a/tk/mac/tkMacEmbed.c b/tk/mac/tkMacEmbed.c
new file mode 100644
index 00000000000..d92a40488cc
--- /dev/null
+++ b/tk/mac/tkMacEmbed.c
@@ -0,0 +1,1192 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+#include "X.h"
+#include "Xlib.h"
+#include <stdio.h>
+
+#include <Windows.h>
+#include <QDOffscreen.h>
+#include "tkMacInt.h"
+
+/*
+ * One of the following structures exists for each container in this
+ * application. It keeps track of the container window and its
+ * associated embedded window.
+ */
+
+typedef struct Container {
+ Window parent; /* The Mac Drawable for the parent of
+ * the pair (the container). */
+ TkWindow *parentPtr; /* Tk's information about the container,
+ * or NULL if the container isn't
+ * in this process. */
+ Window embedded; /* The MacDrawable for the embedded
+ * window. Starts off as None, but
+ * gets filled in when the window is
+ * eventually created. */
+ TkWindow *embeddedPtr; /* Tk's information about the embedded
+ * 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. */
+/*
+ * 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));
+static void EmbeddedEventProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static void EmbedActivateProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void EmbedFocusProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void EmbedGeometryRequest _ANSI_ARGS_((
+ 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 --
+ *
+ * Creates an X Window (Mac subwindow).
+ *
+ * Results:
+ * The window id is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Window
+TkpMakeWindow(
+ TkWindow *winPtr,
+ Window parent)
+{
+ MacDrawable *macWin;
+ XEvent event;
+
+ /*
+ * If this window is marked as embedded then
+ * the window structure should have already been
+ * created in the TkpUseWindow function.
+ */
+
+ if (Tk_IsEmbedded(winPtr)) {
+ return (Window) winPtr->privatePtr;
+ }
+
+ /*
+ * Allocate sub window
+ */
+
+ macWin = (MacDrawable *) ckalloc(sizeof(MacDrawable));
+ if (macWin == NULL) {
+ winPtr->privatePtr = NULL;
+ return None;
+ }
+ macWin->winPtr = winPtr;
+ winPtr->privatePtr = macWin;
+ macWin->clipRgn = NewRgn();
+ macWin->aboveClipRgn = NewRgn();
+ macWin->referenceCount = 0;
+ macWin->flags = TK_CLIP_INVALID;
+
+ if (Tk_IsTopLevel(macWin->winPtr)) {
+
+ /*
+ *This will be set when we are mapped.
+ */
+
+ macWin->portPtr = (GWorldPtr) NULL;
+ macWin->toplevel = macWin;
+ macWin->xOff = 0;
+ macWin->yOff = 0;
+ } else {
+ macWin->portPtr = NULL;
+ macWin->xOff = winPtr->parentPtr->privatePtr->xOff +
+ winPtr->parentPtr->changes.border_width +
+ winPtr->changes.x;
+ macWin->yOff = winPtr->parentPtr->privatePtr->yOff +
+ winPtr->parentPtr->changes.border_width +
+ winPtr->changes.y;
+ macWin->toplevel = winPtr->parentPtr->privatePtr->toplevel;
+ }
+
+ macWin->toplevel->referenceCount++;
+
+ /*
+ * 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 (Window) macWin;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpUseWindow --
+ *
+ * This procedure causes a Tk window to use a given X window as
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpUseWindow(
+ 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;
+ MacDrawable *parent, *macWin;
+ Container *containerPtr;
+ XEvent event;
+ int result;
+
+ if (winPtr->window != None) {
+ panic("TkpUseWindow: X window already assigned");
+ }
+
+ /*
+ * Decode the container pointer, and look for it among the
+ *list of available containers.
+ *
+ * N.B. For now, we are limiting the containers to be in the same Tk
+ * application as tkwin, since otherwise they would not be in our list
+ * of containers.
+ *
+ */
+
+ if (Tcl_GetInt(interp, string, &result) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ parent = (MacDrawable *) result;
+
+ /*
+ * Save information about the container and the embedded window
+ * in a Container structure. Currently, there must already be an existing
+ * Container structure, since we only allow the case where both container
+ * and embedded app. are in the same process.
+ */
+
+ for (containerPtr = firstContainerPtr; containerPtr != NULL;
+ containerPtr = containerPtr->nextPtr) {
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMakeContainer --
+ *
+ * This procedure is called to indicate that a particular window
+ * will be a container for an embedded application. This changes
+ * certain aspects of the window's behavior, such as whether it
+ * will receive events anymore.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMakeContainer(
+ 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
+ * make sure the argument to -use is valid.
+ */
+
+
+ Tk_MakeWindowExist(tkwin);
+ containerPtr = (Container *) ckalloc(sizeof(Container));
+ containerPtr->parent = Tk_WindowId(tkwin);
+ containerPtr->parentPtr = winPtr;
+ containerPtr->embedded = 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. Also, pass activate events from
+ * the container down to the embedded toplevel.
+ */
+
+ Tk_CreateEventHandler(tkwin,
+ SubstructureNotifyMask|SubstructureRedirectMask,
+ ContainerEventProc, (ClientData) winPtr);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask, EmbedStructureProc,
+ (ClientData) containerPtr);
+ Tk_CreateEventHandler(tkwin, ActivateMask, EmbedActivateProc,
+ (ClientData) containerPtr);
+ Tk_CreateEventHandler(tkwin, FocusChangeMask, EmbedFocusProc,
+ (ClientData) containerPtr);
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacContainerId --
+ *
+ * Given an embedded window, this procedure returns the MacDrawable
+ * identifier for the associated container window.
+ *
+ * Results:
+ * The return value is the MacDrawable for winPtr's
+ * container window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+MacDrawable *
+TkMacContainerId(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 (MacDrawable *) containerPtr->parent;
+ }
+ }
+ panic("TkMacContainerId couldn't find window");
+ return None;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacGetHostToplevel --
+ *
+ * Given the TkWindow, return the MacDrawable for the outermost
+ * toplevel containing it. This will be a real Macintosh window.
+ *
+ * Results:
+ * Returns a MacDrawable corresponding to a Macintosh Toplevel
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+MacDrawable *
+TkMacGetHostToplevel(
+ TkWindow *winPtr) /* Tk's structure for a window. */
+{
+ TkWindow *contWinPtr, *topWinPtr;
+
+ topWinPtr = winPtr->privatePtr->toplevel->winPtr;
+ if (!Tk_IsEmbedded(topWinPtr)) {
+ return winPtr->privatePtr->toplevel;
+ } else {
+ contWinPtr = TkpGetOtherWindow(topWinPtr);
+
+ /*
+ * NOTE: Here we should handle out of process embedding.
+ */
+
+ if (contWinPtr != NULL) {
+ return TkMacGetHostToplevel(contWinPtr);
+ } else {
+ return None;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpClaimFocus --
+ *
+ * This procedure is invoked when someone asks for the input focus
+ * to be put on a window in an embedded application, but the
+ * application doesn't currently have the focus. It requests the
+ * input focus from the container application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The input focus may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpClaimFocus(
+ TkWindow *topLevelPtr, /* Top-level window containing desired
+ * 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);
+ event.xfocus.send_event = 1;
+ event.xfocus.display = topLevelPtr->display;
+ event.xfocus.window = containerPtr->parent;
+ event.xfocus.mode = EMBEDDED_APP_WANTS_FOCUS;
+ event.xfocus.detail = force;
+ Tk_QueueWindowEvent(&event,TCL_QUEUE_TAIL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpTestembedCmd --
+ *
+ * This procedure implements the "testembed" command. It returns
+ * some or all of the information in the list pointed to by
+ * firstContainerPtr.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpTestembedCmd(
+ ClientData clientData, /* Main window for application. */
+ Tcl_Interp *interp, /* Current interpreter. */
+ 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);
+ Tcl_DStringAppendElement(&dString, buffer);
+ } else {
+ Tcl_DStringAppendElement(&dString, "XXX");
+ }
+ }
+ if (containerPtr->parentPtr == NULL) {
+ Tcl_DStringAppendElement(&dString, "");
+ } else {
+ Tcl_DStringAppendElement(&dString,
+ containerPtr->parentPtr->pathName);
+ }
+ if (containerPtr->embedded == None) {
+ Tcl_DStringAppendElement(&dString, "");
+ } else {
+ if (all) {
+ sprintf(buffer, "0x%x", (int) containerPtr->embedded);
+ Tcl_DStringAppendElement(&dString, buffer);
+ } else {
+ Tcl_DStringAppendElement(&dString, "XXX");
+ }
+ }
+ if (containerPtr->embeddedPtr == NULL) {
+ Tcl_DStringAppendElement(&dString, "");
+ } else {
+ Tcl_DStringAppendElement(&dString,
+ containerPtr->embeddedPtr->pathName);
+ }
+ Tcl_DStringEndSublist(&dString);
+ }
+ Tcl_DStringResult(interp, &dString);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpRedirectKeyEvent --
+ *
+ * This procedure is invoked when a key press or release event
+ * arrives for an application that does not believe it owns the
+ * input focus. This can happen because of embedding; for example,
+ * X can send an event to an embedded application when the real
+ * focus window is in the container application and is an ancestor
+ * of the container. This procedure's job is to forward the event
+ * back to the application where it really belongs.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The event may get sent to a different application.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpRedirectKeyEvent(
+ TkWindow *winPtr, /* Window to which the event was originally
+ * reported. */
+ XEvent *eventPtr) /* X event to redirect (should be KeyPress
+ * or KeyRelease). */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetOtherWindow --
+ *
+ * If both the container and embedded window are in the same
+ * process, this procedure will return either one, given the other.
+ *
+ * Results:
+ * If winPtr is a container, the return value is the token for the
+ * embedded window, and vice versa. If the "other" window isn't in
+ * this process, NULL is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkpGetOtherWindow(
+ TkWindow *winPtr) /* Tk's structure for a container or
+ * embedded window. */
+{
+ Container *containerPtr;
+
+ /*
+ * TkpGetOtherWindow returns NULL if both windows are not
+ * in the same process...
+ */
+
+ if (!(winPtr->flags & TK_BOTH_HALVES)) {
+ return NULL;
+ }
+
+ for (containerPtr = firstContainerPtr; containerPtr != NULL;
+ containerPtr = containerPtr->nextPtr) {
+ if (containerPtr->embeddedPtr == winPtr) {
+ return containerPtr->parentPtr;
+ } else if (containerPtr->parentPtr == winPtr) {
+ return containerPtr->embeddedPtr;
+ }
+ }
+ return NULL;
+}
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbeddedEventProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher when various
+ * useful events are received for a window that is embedded in
+ * another application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Our internal state gets cleaned up when an embedded window is
+ * destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EmbeddedEventProc(clientData, eventPtr)
+ ClientData clientData; /* Token for container window. */
+ XEvent *eventPtr; /* ResizeRequest event. */
+{
+ TkWindow *winPtr = (TkWindow *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ EmbedWindowDeleted(winPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ContainerEventProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher when various
+ * useful events are received for the children of a container
+ * window. It forwards relevant information, such as geometry
+ * requests, from the events into the container's application.
+ *
+ * NOTE: on the Mac, only the DestroyNotify branch is ever taken.
+ * We don't synthesize the other events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the event. For example, when ConfigureRequest events
+ * occur, geometry information gets set for the container window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+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");
+ }
+ }
+
+ if (eventPtr->type == CreateNotify) {
+ /*
+ * A new child window has been created in the container. Record
+ * its id in the Container structure (if more than one child is
+ * created, just remember the last one and ignore the earlier
+ * ones).
+ */
+
+ containerPtr->embedded = eventPtr->xcreatewindow.window;
+ } else if (eventPtr->type == ConfigureRequest) {
+ if ((eventPtr->xconfigurerequest.x != 0)
+ || (eventPtr->xconfigurerequest.y != 0)) {
+ /*
+ * The embedded application is trying to move itself, which
+ * isn't legal. At this point, the window hasn't actually
+ * moved, but we need to send it a ConfigureNotify event to
+ * let it know that its request has been denied. If the
+ * embedded application was also trying to resize itself, a
+ * ConfigureNotify will be sent by the geometry management
+ * code below, so we don't need to do anything. Otherwise,
+ * generate a synthetic event.
+ */
+
+ if ((eventPtr->xconfigurerequest.width == winPtr->changes.width)
+ && (eventPtr->xconfigurerequest.height
+ == winPtr->changes.height)) {
+ EmbedSendConfigure(containerPtr);
+ }
+ }
+ EmbedGeometryRequest(containerPtr,
+ eventPtr->xconfigurerequest.width,
+ eventPtr->xconfigurerequest.height);
+ } else if (eventPtr->type == MapRequest) {
+ /*
+ * The embedded application's map request was ignored and simply
+ * passed on to us, so we have to map the window for it to appear
+ * on the screen.
+ */
+
+ XMapWindow(eventPtr->xmaprequest.display,
+ eventPtr->xmaprequest.window);
+ } else if (eventPtr->type == DestroyNotify) {
+ /*
+ * The embedded application is gone. Destroy the container window.
+ */
+
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ }
+ Tk_DeleteErrorHandler(errHandler);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedStructureProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher when
+ * a container window owned by this application gets resized
+ * (and also at several other times that we don't care about).
+ * This procedure reflects the size change in the embedded
+ * window that corresponds to the container.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The embedded window gets resized to match the container.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EmbedStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Token for container window. */
+ XEvent *eventPtr; /* ResizeRequest event. */
+{
+ Container *containerPtr = (Container *) clientData;
+ Tk_ErrorHandler errHandler;
+
+ if (eventPtr->type == ConfigureNotify) {
+ if (containerPtr->embedded != None) {
+ /*
+ * Ignore errors, since the embedded application could have
+ * deleted its window.
+ */
+
+ errHandler = Tk_CreateErrorHandler(eventPtr->xfocus.display, -1,
+ -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ Tk_MoveResizeWindow((Tk_Window) containerPtr->embeddedPtr, 0, 0,
+ (unsigned int) Tk_Width(
+ (Tk_Window) containerPtr->parentPtr),
+ (unsigned int) Tk_Height(
+ (Tk_Window) containerPtr->parentPtr));
+ Tk_DeleteErrorHandler(errHandler);
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ EmbedWindowDeleted(containerPtr->parentPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedActivateProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher when
+ * Activate and Deactivate events occur for a container window owned
+ * by this application. It is responsible for forwarding an activate
+ * event down into the embedded toplevel.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The X focus may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+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);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedFocusProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher when
+ * FocusIn and FocusOut events occur for a container window owned
+ * by this application. It is responsible for moving the focus
+ * back and forth between a container application and an embedded
+ * application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The X focus may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EmbedFocusProc(clientData, eventPtr)
+ ClientData clientData; /* Token for container window. */
+ 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 --
+ *
+ * This procedure is invoked when an embedded application requests
+ * a particular size. It processes the request (which may or may
+ * not actually honor the request) and reflects the results back
+ * to the embedded application.
+ *
+ * NOTE: On the Mac, this is a stub, since we don't synthesize
+ * ConfigureRequest events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If we deny the child's size change request, a Configure event
+ * is synthesized to let the child know how big it ought to be.
+ * Events get processed while we're waiting for the geometry
+ * managers to do their thing.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EmbedGeometryRequest(containerPtr, width, height)
+ Container *containerPtr; /* Information about the embedding. */
+ int width, height; /* Size that the child has requested. */
+{
+ TkWindow *winPtr = containerPtr->parentPtr;
+
+ /*
+ * Forward the requested size into our geometry management hierarchy
+ * via the container window. We need to send a Configure event back
+ * to the embedded application if we decide not to honor its
+ * request; to make this happen, process all idle event handlers
+ * synchronously here (so that the geometry managers have had a
+ * chance to do whatever they want to do), and if the window's size
+ * didn't change then generate a configure event.
+ */
+
+ Tk_GeometryRequest((Tk_Window) winPtr, width, height);
+ while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)) {
+ /* Empty loop body. */
+ }
+ if ((winPtr->changes.width != width)
+ || (winPtr->changes.height != height)) {
+ EmbedSendConfigure(containerPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedSendConfigure --
+ *
+ * This is currently a stub. It is called to notify an
+ * embedded application of its current size and location. This
+ * procedure is called when the embedded application made a
+ * geometry request that we did not grant, so that the embedded
+ * application knows that its geometry didn't change after all.
+ * It is a response to ConfigureRequest events, which we do not
+ * currently synthesize on the Mac
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EmbedSendConfigure(containerPtr)
+ Container *containerPtr; /* Information about the embedding. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedWindowDeleted --
+ *
+ * This procedure is invoked when a window involved in embedding
+ * (as either the container or the embedded application) is
+ * destroyed. It cleans up the Container structure for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Container structure may be freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EmbedWindowDeleted(winPtr)
+ TkWindow *winPtr; /* Tk's information about window that
+ * was deleted. */
+{
+ Container *containerPtr, *prevPtr;
+
+ /*
+ * Find the Container structure for this window. Delete the
+ * information about the embedded application and free the container's
+ * record.
+ */
+
+ prevPtr = NULL;
+ containerPtr = firstContainerPtr;
+ while (1) {
+ if (containerPtr->embeddedPtr == winPtr) {
+
+ /*
+ * We also have to destroy our parent, to clean up the container.
+ * Fabricate an event to do this.
+ */
+
+ if (containerPtr->parentPtr != NULL &&
+ containerPtr->parentPtr->flags & TK_BOTH_HALVES) {
+ XEvent event;
+
+ event.xany.serial =
+ Tk_Display(containerPtr->parentPtr)->request;
+ event.xany.send_event = False;
+ event.xany.display = Tk_Display(containerPtr->parentPtr);
+
+ event.xany.type = DestroyNotify;
+ event.xany.window = containerPtr->parent;
+ event.xdestroywindow.event = containerPtr->parent;
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_HEAD);
+
+ }
+
+ containerPtr->embedded = 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);
+ }
+}
+
diff --git a/tk/mac/tkMacFont.c b/tk/mac/tkMacFont.c
new file mode 100644
index 00000000000..a23e47d1f84
--- /dev/null
+++ b/tk/mac/tkMacFont.c
@@ -0,0 +1,678 @@
+/*
+ * 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$
+ */
+
+#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.
+ *
+ * Results:
+ * The return value is a pointer to a TkFont that represents the
+ * native font. If a native font by the given name could not be
+ * found, the return value is NULL.
+ *
+ * Every call to this procedure returns a new TkFont structure,
+ * even if the name has already been seen before. The caller should
+ * 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 generics TkFont before calling TkpDeleteFont().
+ *
+ * Side effects:
+ * None.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+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 --
+ *
+ * Given a desired set of attributes for a font, find a font with
+ * the closest matching attributes.
+ *
+ * Results:
+ * The return value is a pointer to a TkFont that represents the
+ * font with the desired attributes. If a font with the desired
+ * attributes could not be constructed, some other font will be
+ * substituted automatically.
+ *
+ * Every call to this procedure returns a new TkFont structure,
+ * even if the specified attributes have already been seen before.
+ * The caller should call TkpDeleteFont() to free the platform-
+ * 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(
+ 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 --
+ *
+ * Called to release a font allocated by TkpGetNativeFont() or
+ * TkpGetFontFromAttributes(). The caller should have already
+ * released the fields of the TkFont that are used exclusively by
+ * the generic TkFont code.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * TkFont is deallocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+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 --
+ *
+ * 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, /* 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;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ short txFont, txFace, txSize;
+ BitMapPtr stippleMap;
+
+ fontPtr = (MacFont *) tkfont;
+ macWin = (MacDrawable *) drawable;
+
+ destPort = TkMacGetDrawablePort(drawable);
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ TkMacSetUpClippingRgn(drawable);
+ TkMacSetUpGraphicsPort(gc);
+
+ txFont = tcl_macQdPtr->thePort->txFont;
+ txFace = tcl_macQdPtr->thePort->txFace;
+ txSize = tcl_macQdPtr->thePort->txSize;
+ GetForeColor(&origColor);
+
+ if ((gc->fill_style == FillStippled
+ || gc->fill_style == FillOpaqueStippled)
+ && gc->stipple != None) {
+ Pixmap pixmap;
+ GWorldPtr bufferPort;
+
+ stippleMap = TkMacMakeStippleMap(drawable, gc->stipple);
+
+ 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;
+}
+
diff --git a/tk/mac/tkMacHLEvents.c b/tk/mac/tkMacHLEvents.c
new file mode 100644
index 00000000000..02708c0d634
--- /dev/null
+++ b/tk/mac/tkMacHLEvents.c
@@ -0,0 +1,437 @@
+/*
+ * 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$
+ */
+
+#include "tcl.h"
+#include "tclMacInt.h"
+#include "tkMacInt.h"
+
+#include <Aliases.h>
+#include <AppleEvents.h>
+#include <SegLoad.h>
+#include <ToolUtils.h>
+
+/*
+ * This is a Tcl_Event structure that the Quit AppleEvent handler
+ * uses to schedule the tkReallyKillMe function.
+ */
+
+typedef struct KillEvent {
+ Tcl_Event header; /* Information that is standard for
+ * all events. */
+ Tcl_Interp *interp; /* Interp that was passed to the
+ * Quit AppleEvent */
+} KillEvent;
+
+/*
+ * Static functions used only in this file.
+ */
+
+static pascal OSErr QuitHandler _ANSI_ARGS_((AppleEvent* event,
+ AppleEvent* reply, long refcon));
+static pascal OSErr OappHandler _ANSI_ARGS_((AppleEvent* event,
+ AppleEvent* reply, long refcon));
+static pascal OSErr OdocHandler _ANSI_ARGS_((AppleEvent* event,
+ AppleEvent* reply, long refcon));
+static pascal OSErr PrintHandler _ANSI_ARGS_((AppleEvent* event,
+ AppleEvent* reply, long refcon));
+static pascal OSErr ScriptHandler _ANSI_ARGS_((AppleEvent* event,
+ AppleEvent* reply, long refcon));
+static int MissedAnyParameters _ANSI_ARGS_((AppleEvent *theEvent));
+static int ReallyKillMe _ANSI_ARGS_((Tcl_Event *eventPtr, int flags));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacInitAppleEvents --
+ *
+ * Initilize the Apple Events on the Macintosh. This registers the
+ * core event handlers.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacInitAppleEvents(
+ Tcl_Interp *interp) /* Interp to handle basic events. */
+{
+ OSErr err;
+ AEEventHandlerUPP OappHandlerUPP, OdocHandlerUPP,
+ PrintHandlerUPP, QuitHandlerUPP, ScriptHandlerUPP;
+
+ /*
+ * Install event handlers for the core apple events.
+ */
+ QuitHandlerUPP = NewAEEventHandlerProc(QuitHandler);
+ err = AEInstallEventHandler(kCoreEventClass, kAEQuitApplication,
+ QuitHandlerUPP, (long) interp, false);
+
+ OappHandlerUPP = NewAEEventHandlerProc(OappHandler);
+ err = AEInstallEventHandler(kCoreEventClass, kAEOpenApplication,
+ OappHandlerUPP, (long) interp, false);
+
+ OdocHandlerUPP = NewAEEventHandlerProc(OdocHandler);
+ err = AEInstallEventHandler(kCoreEventClass, kAEOpenDocuments,
+ OdocHandlerUPP, (long) interp, false);
+
+ PrintHandlerUPP = NewAEEventHandlerProc(PrintHandler);
+ err = AEInstallEventHandler(kCoreEventClass, kAEPrintDocuments,
+ PrintHandlerUPP, (long) interp, false);
+
+ if (interp != NULL) {
+ ScriptHandlerUPP = NewAEEventHandlerProc(ScriptHandler);
+ err = AEInstallEventHandler('misc', 'dosc',
+ ScriptHandlerUPP, (long) interp, false);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacDoHLEvent --
+ *
+ * Dispatch incomming highlevel events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the incoming event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacDoHLEvent(
+ EventRecord *theEvent)
+{
+ AEProcessAppleEvent(theEvent);
+
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * QuitHandler, OappHandler, etc. --
+ *
+ * These are the core Apple event handlers. Only the Quit event does
+ * anything interesting.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static pascal OSErr
+QuitHandler(
+ AppleEvent *theAppleEvent,
+ AppleEvent *reply,
+ long handlerRefcon)
+{
+ Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
+ KillEvent *eventPtr;
+
+ /*
+ * Call the exit command from the event loop, since you are not supposed
+ * to call ExitToShell in an Apple Event Handler. We put this at the head
+ * of Tcl's event queue because this message usually comes when the Mac is
+ * shutting down, and we want to kill the shell as quickly as possible.
+ */
+
+ eventPtr = (KillEvent *) ckalloc(sizeof(KillEvent));
+ eventPtr->header.proc = ReallyKillMe;
+ eventPtr->interp = interp;
+
+ Tcl_QueueEvent((Tcl_Event *) eventPtr, TCL_QUEUE_HEAD);
+
+ return noErr;
+}
+
+static pascal OSErr
+OappHandler(
+ AppleEvent *theAppleEvent,
+ AppleEvent *reply,
+ long handlerRefcon)
+{
+ return noErr;
+}
+
+static pascal OSErr
+OdocHandler(
+ AppleEvent *theAppleEvent,
+ AppleEvent *reply,
+ long handlerRefcon)
+{
+ Tcl_Interp *interp = (Tcl_Interp *) handlerRefcon;
+ AEDescList fileSpecList;
+ FSSpec file;
+ OSErr err;
+ DescType type;
+ Size actual;
+ long count;
+ AEKeyword keyword;
+ long index;
+ Tcl_DString command;
+ Tcl_DString pathName;
+ Tcl_CmdInfo dummy;
+
+ /*
+ * Don't bother if we don't have an interp or
+ * the open document procedure doesn't exist.
+ */
+
+ if ((interp == NULL) ||
+ (Tcl_GetCommandInfo(interp, "tkOpenDocument", &dummy)) == 0) {
+ return noErr;
+ }
+
+ /*
+ * If we get any errors wil retrieving our parameters
+ * we just return with no error.
+ */
+
+ err = AEGetParamDesc(theAppleEvent, keyDirectObject,
+ typeAEList, &fileSpecList);
+ if (err != noErr) {
+ return noErr;
+ }
+
+ err = MissedAnyParameters(theAppleEvent);
+ if (err != noErr) {
+ return noErr;
+ }
+
+ 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,
+ long handlerRefcon)
+{
+ return noErr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DoScriptHandler --
+ *
+ * This handler process the do script event.
+ *
+ * Results:
+ * Scedules the given event to be processed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static pascal OSErr
+ScriptHandler(
+ AppleEvent *theAppleEvent,
+ AppleEvent *reply,
+ long handlerRefcon)
+{
+ OSErr theErr;
+ AEDescList theDesc;
+ int tclErr = -1;
+ Tcl_Interp *interp;
+ char errString[128];
+
+ interp = (Tcl_Interp *) handlerRefcon;
+
+ /*
+ * The do script event receives one parameter that should be data or a file.
+ */
+ theErr = AEGetParamDesc(theAppleEvent, keyDirectObject, typeWildCard,
+ &theDesc);
+ if (theErr != noErr) {
+ sprintf(errString, "AEDoScriptHandler: GetParamDesc error %d", theErr);
+ theErr = AEPutParamPtr(reply, keyErrorString, typeChar, errString,
+ strlen(errString));
+ } else if (MissedAnyParameters(theAppleEvent)) {
+ sprintf(errString, "AEDoScriptHandler: extra parameters");
+ AEPutParamPtr(reply, keyErrorString, typeChar, errString,
+ strlen(errString));
+ theErr = -1771;
+ } else {
+ if (theDesc.descriptorType == (DescType)'TEXT') {
+ short length, i;
+
+ length = GetHandleSize(theDesc.dataHandle);
+ SetHandleSize(theDesc.dataHandle, length + 1);
+ *(*theDesc.dataHandle + length) = '\0';
+ for (i=0; i<length; i++) {
+ if ((*theDesc.dataHandle)[i] == '\r') {
+ (*theDesc.dataHandle)[i] = '\n';
+ }
+ }
+
+ HLock(theDesc.dataHandle);
+ tclErr = Tcl_GlobalEval(interp, *theDesc.dataHandle);
+ HUnlock(theDesc.dataHandle);
+ } else if (theDesc.descriptorType == (DescType)'alis') {
+ Boolean dummy;
+ FSSpec theFSS;
+ Handle fullPath;
+ int length;
+
+ theErr = ResolveAlias(NULL, (AliasHandle)theDesc.dataHandle,
+ &theFSS, &dummy);
+ if (theErr == noErr) {
+ FSpPathFromLocation(&theFSS, &length, &fullPath);
+ HLock(fullPath);
+ Tcl_EvalFile(interp, *fullPath);
+ HUnlock(fullPath);
+ DisposeHandle(fullPath);
+ } else {
+ sprintf(errString, "AEDoScriptHandler: file not found");
+ AEPutParamPtr(reply, keyErrorString, typeChar,
+ errString, strlen(errString));
+ }
+ } else {
+ sprintf(errString,
+ "AEDoScriptHandler: invalid script type '%-4.4s', must be 'alis' or 'TEXT'",
+ &theDesc.descriptorType);
+ AEPutParamPtr(reply, keyErrorString, typeChar,
+ errString, strlen(errString));
+ theErr = -1770;
+ }
+ }
+
+ /*
+ * 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);
+
+ return theErr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReallyKillMe --
+ *
+ * This proc tries to kill the shell by running exit, and if that
+ * has not succeeded (e.g. because someone has renamed the exit
+ * command), calls Tcl_Exit to really kill the shell. Called from
+ * an event scheduled by the "Quit" AppleEvent handler.
+ *
+ * Results:
+ * Kills the shell.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+ReallyKillMe(Tcl_Event *eventPtr, int flags)
+{
+ Tcl_Interp *interp = ((KillEvent *) eventPtr)->interp;
+ if (interp != NULL) {
+ Tcl_GlobalEval(interp, "exit");
+ }
+ Tcl_Exit(0);
+
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MissedAnyParameters --
+ *
+ * Checks to see if parameters are still left in the event.
+ *
+ * Results:
+ * True or false.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+MissedAnyParameters(
+ AppleEvent *theEvent)
+{
+ DescType returnedType;
+ Size actualSize;
+ OSErr err;
+
+ err = AEGetAttributePtr(theEvent, keyMissedKeywordAttr, typeWildCard,
+ &returnedType, NULL, 0, &actualSize);
+
+ return (err != errAEDescNotFound);
+}
diff --git a/tk/mac/tkMacInit.c b/tk/mac/tkMacInit.c
new file mode 100644
index 00000000000..d78a386462c
--- /dev/null
+++ b/tk/mac/tkMacInit.c
@@ -0,0 +1,240 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <Resources.h>
+#include <Files.h>
+#include <TextUtils.h>
+#include <Strings.h>
+#include "tkInt.h"
+#include "tkMacInt.h"
+#include "tclMacInt.h"
+
+/*
+ * The following global is used by various parts of Tk to access
+ * information in the global qd variable. It is provided as a pointer
+ * in the AppInit because we don't assume that Tk is running as an
+ * application. For example, Tk could be a plugin and may not have
+ * access to the qd variable. This mechanism provides a way for the
+ * container application to give a pointer to the qd variable.
+ */
+
+QDGlobalsPtr tcl_macQdPtr = NULL;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpInit(
+ Tcl_Interp *interp) /* Interp to initialize. */
+{
+ char *libDir, *tempPath;
+ Tcl_DString path;
+ int result;
+
+ /*
+ * The following does not work with
+ * safe interps because file exists is restricted.
+ * to be fixed using [interp issafe] like in Unix & Windows.
+ */
+ static char initCmd[] =
+ "if [file exists $tk_library:tk.tcl] {\n\
+ source $tk_library:tk.tcl\n\
+ source $tk_library:button.tcl\n\
+ source $tk_library:entry.tcl\n\
+ source $tk_library:listbox.tcl\n\
+ source $tk_library:menu.tcl\n\
+ source $tk_library:scale.tcl\n\
+ source $tk_library:scrlbar.tcl\n\
+ source $tk_library:text.tcl\n\
+ source $tk_library:comdlg.tcl\n\
+ source $tk_library:msgbox.tcl\n\
+ } else {\n\
+ set msg \"can't find tk resource or $tk_library:tk.tcl;\"\n\
+ append msg \" perhaps you need to\\ninstall Tk or set your \"\n\
+ append msg \"TK_LIBRARY environment variable?\"\n\
+ error $msg\n\
+ }";
+
+ Tcl_DStringInit(&path);
+
+ /*
+ * The tk_library path can be found in several places. Here is the order
+ * in which the are searched.
+ * 1) the variable may already exist
+ * 2) env array
+ * 3) System Folder:Extensions:Tool Command Language:
+ */
+
+ libDir = Tcl_GetVar(interp, "tk_library", TCL_GLOBAL_ONLY);
+ if (libDir == NULL) {
+ libDir = Tcl_GetVar2(interp, "env", "TK_LIBRARY", TCL_GLOBAL_ONLY);
+ }
+ if (libDir == NULL) {
+ tempPath = Tcl_GetVar2(interp, "env", "EXT_FOLDER", TCL_GLOBAL_ONLY);
+ if (tempPath != NULL) {
+ Tcl_DString libPath;
+
+ Tcl_JoinPath(1, &tempPath, &path);
+
+ Tcl_DStringInit(&libPath);
+ Tcl_DStringAppend(&libPath, ":Tool Command Language:tk", -1);
+ Tcl_DStringAppend(&libPath, TK_VERSION, -1);
+ Tcl_JoinPath(1, &libPath.string, &path);
+ Tcl_DStringFree(&libPath);
+ libDir = path.string;
+ }
+ }
+ if (libDir == NULL) {
+ libDir = "no library";
+ }
+
+ /*
+ * Assign path to the global Tcl variable tcl_library.
+ */
+ Tcl_SetVar(interp, "tk_library", libDir, TCL_GLOBAL_ONLY);
+ Tcl_DStringFree(&path);
+
+ /*
+ * Source the needed Tk libraries from the resource
+ * fork of the application.
+ */
+ result = Tcl_MacEvalResource(interp, "tk", 0, NULL);
+ result |= Tcl_MacEvalResource(interp, "button", 0, NULL);
+ result |= Tcl_MacEvalResource(interp, "entry", 0, NULL);
+ result |= Tcl_MacEvalResource(interp, "listbox", 0, NULL);
+ result |= Tcl_MacEvalResource(interp, "menu", 0, NULL);
+ result |= Tcl_MacEvalResource(interp, "scale", 0, NULL);
+ result |= Tcl_MacEvalResource(interp, "scrollbar", 0, NULL);
+ result |= Tcl_MacEvalResource(interp, "text", 0, NULL);
+ result |= Tcl_MacEvalResource(interp, "dialog", 0, NULL);
+ result |= Tcl_MacEvalResource(interp, "focus", 0, NULL);
+ result |= Tcl_MacEvalResource(interp, "optionMenu", 0, NULL);
+ result |= Tcl_MacEvalResource(interp, "palette", 0, NULL);
+ result |= Tcl_MacEvalResource(interp, "tearoff", 0, NULL);
+ result |= Tcl_MacEvalResource(interp, "tkerror", 0, NULL);
+ result |= Tcl_MacEvalResource(interp, "comdlg", 0, NULL);
+ result |= Tcl_MacEvalResource(interp, "msgbox", 0, NULL);
+
+ if (result != TCL_OK) {
+ result = Tcl_Eval(interp, initCmd);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetAppName --
+ *
+ * Retrieves the name of the current application from a platform
+ * specific location. On the Macintosh we look to see if the
+ * App Name is specified in a resource. If not, the application
+ * name is the root of the tail of the path contained in the tcl
+ * variable argv0.
+ *
+ * Results:
+ * Returns the application name in the given Tcl_DString.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpGetAppName(
+ Tcl_Interp *interp, /* The main interpreter. */
+ Tcl_DString *namePtr) /* A previously initialized Tcl_DString. */
+{
+ int argc;
+ char **argv = NULL, *name, *p;
+ Handle h = NULL;
+
+ h = GetNamedResource('STR ', "\pTk App Name");
+ if (h != NULL) {
+ HLock(h);
+ Tcl_DStringAppend(namePtr, (*h)+1, **h);
+ HUnlock(h);
+ ReleaseResource(h);
+ return;
+ }
+
+ name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
+ if (name != NULL) {
+ Tcl_SplitPath(name, &argc, &argv);
+ if (argc > 0) {
+ name = argv[argc-1];
+ p = strrchr(name, '.');
+ if (p != NULL) {
+ *p = '\0';
+ }
+ } else {
+ name = NULL;
+ }
+ }
+ if ((name == NULL) || (*name == 0)) {
+ name = "tk";
+ }
+ Tcl_DStringAppend(namePtr, name, -1);
+ if (argv != NULL) {
+ ckfree((char *)argv);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDisplayWarning --
+ *
+ * This routines is called from Tk_Main to display warning
+ * messages that occur during startup.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Displays a message box.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDisplayWarning(
+ char *msg, /* Message to be displayed. */
+ char *title) /* Title of warning. */
+{
+ Tcl_DString ds;
+ Tcl_DStringInit(&ds);
+ Tcl_DStringAppend(&ds, title, -1);
+ Tcl_DStringAppend(&ds, ": ", -1);
+ Tcl_DStringAppend(&ds, msg, -1);
+ panic(Tcl_DStringValue(&ds));
+ Tcl_DStringFree(&ds);
+}
diff --git a/tk/mac/tkMacInt.h b/tk/mac/tkMacInt.h
new file mode 100644
index 00000000000..bb946cd429b
--- /dev/null
+++ b/tk/mac/tkMacInt.h
@@ -0,0 +1,296 @@
+/*
+ * 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$
+ */
+
+#ifndef _TKMACINT
+#define _TKMACINT
+
+#include "tkInt.h"
+#include "tkPort.h"
+
+#ifndef _TKMAC
+# include "tkMac.h"
+#endif /* _TKMAC */
+
+
+#include <AppleEvents.h>
+#include <Windows.h>
+#include <QDOffscreen.h>
+#include <Menus.h>
+
+#define TK_MAC_68K_STACK_GROWTH (256*1024)
+
+struct TkWindowPrivate {
+ TkWindow *winPtr; /* Ptr to tk window or NULL if Pixmap */
+ GWorldPtr portPtr; /* Either WindowRef or off screen world */
+ int xOff; /* X offset from toplevel window */
+ int yOff; /* Y offset from toplevel window */
+ RgnHandle clipRgn; /* Visable region of window */
+ RgnHandle aboveClipRgn; /* Visable region of window & it's children */
+ int referenceCount; /* Don't delete toplevel until children are
+ * gone. */
+ struct TkWindowPrivate *toplevel; /* Pointer to the toplevel
+ * datastruct. */
+ int flags; /* Various state see defines below. */
+};
+typedef struct TkWindowPrivate MacDrawable;
+
+/*
+ * This list is used to keep track of toplevel windows that have a Mac
+ * window attached. This is useful for several things, not the least
+ * of which is maintaining floating windows.
+ */
+
+typedef struct TkMacWindowList {
+ struct TkMacWindowList *nextPtr; /* The next window in the list. */
+ TkWindow *winPtr; /* This window */
+} TkMacWindowList;
+
+/*
+ * Defines use for the flags field of the MacDrawable data structure.
+ */
+
+#define TK_SCROLLBAR_GROW 1
+#define TK_CLIP_INVALID 2
+#define TK_HOST_EXISTS 4
+#define TK_DRAWN_UNDER_MENU 8
+
+/*
+ * 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
+
+/*
+ * Accessor for the privatePtr flags field for the TK_HOST_EXISTS field
+ */
+
+#define TkMacHostToplevelExists(tkwin) \
+ (((TkWindow *) (tkwin))->privatePtr->toplevel->flags & TK_HOST_EXISTS)
+
+/*
+ * Defines use for the flags argument to TkGenWMConfigureEvent.
+ */
+
+#define TK_LOCATION_CHANGED 1
+#define TK_SIZE_CHANGED 2
+#define TK_BOTH_CHANGED 3
+
+/*
+ * Variables shared among various Mac Tk modules but are not
+ * exported to the outside world.
+ */
+
+extern int tkMacAppInFront;
+
+/*
+ * Globals shared among Macintosh Tk
+ */
+
+extern MenuHandle tkAppleMenu; /* Handle to the Apple Menu */
+extern MenuHandle tkFileMenu; /* Handles to menus */
+extern MenuHandle tkEditMenu; /* Handles to menus */
+extern RgnHandle tkMenuCascadeRgn; /* A region to clip with. */
+extern int tkUseMenuCascadeRgn; /* If this is 1, clipping code
+ * should intersect tkMenuCascadeRgn
+ * before drawing occurs.
+ * tkMenuCascadeRgn will only
+ * be valid when the value of this
+ * variable is 1. */
+extern TkMacWindowList *tkMacWindowListPtr;
+ /* The list of toplevels */
+
+/*
+ * The following types and defines are for MDEF support.
+ */
+
+#if STRUCTALIGNMENTSUPPORTED
+#pragma options align=mac8k
+#endif
+typedef struct TkMenuLowMemGlobals {
+ long menuDisable; /* A combination of the menu and the item
+ * that the mouse is currently over. */
+ short menuTop; /* Where in global coords the top of the
+ * menu is. */
+ short menuBottom; /* Where in global coords the bottom of
+ * the menu is. */
+ Rect itemRect; /* This is the rectangle of the currently
+ * selected item. */
+ short scrollFlag; /* This is used by the MDEF and the
+ * Menu Manager to control when scrolling
+ * starts. With hierarchicals, an
+ * mChooseMsg can come before an
+ * mDrawMsg, and scrolling should not
+ * occur until after the mDrawMsg.
+ * The mDrawMsg sets this flag;
+ * mChooseMsg checks the flag and
+ * does not scroll if it is set;
+ * and then resets the flag. */
+} TkMenuLowMemGlobals;
+#if STRUCTALIGNMENTSUPPORTED
+#pragma options align=reset
+#endif
+
+typedef pascal void (*TkMenuDefProcPtr) (short message, MenuHandle theMenu,
+ Rect *menuRectPtr, Point hitPt, short *whichItemPtr,
+ TkMenuLowMemGlobals *globalsPtr);
+enum {
+ tkUppMenuDefProcInfo = kPascalStackBased
+ | STACK_ROUTINE_PARAMETER(1, SIZE_CODE(sizeof(short)))
+ | STACK_ROUTINE_PARAMETER(2, SIZE_CODE(sizeof(MenuRef)))
+ | STACK_ROUTINE_PARAMETER(3, SIZE_CODE(sizeof(Rect*)))
+ | STACK_ROUTINE_PARAMETER(4, SIZE_CODE(sizeof(Point)))
+ | STACK_ROUTINE_PARAMETER(5, SIZE_CODE(sizeof(short*)))
+ | STACK_ROUTINE_PARAMETER(6, SIZE_CODE(sizeof(TkMenuLowMemGlobals *)))
+};
+
+#if GENERATINGCFM
+typedef UniversalProcPtr TkMenuDefUPP;
+#else
+typedef TkMenuDefProcPtr TkMenuDefUPP;
+#endif
+
+#if GENERATINGCFM
+#define TkNewMenuDefProc(userRoutine) \
+ (TkMenuDefUPP) NewRoutineDescriptor((ProcPtr)(userRoutine), \
+ tkUppMenuDefProcInfo, GetCurrentArchitecture())
+#else
+#define TkNewMenuDefProc(userRoutine) \
+ ((TkMenuDefUPP) (userRoutine))
+#endif
+
+#if GENERATINGCFM
+#define TkCallMenuDefProc(userRoutine, message, theMenu, menuRectPtr, hitPt, \
+ whichItemPtr, globalsPtr) \
+ CallUniversalProc((UniversalProcPtr)(userRoutine), TkUppMenuDefProcInfo, \
+ (message), (theMenu), (menuRectPtr), (hitPt), (whichItemPtr), \
+ (globalsPtr))
+#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 int TkMacHaveAppearance _ANSI_ARGS_((void));
+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));
+
+#endif /* _TKMACINT */
diff --git a/tk/mac/tkMacKeyboard.c b/tk/mac/tkMacKeyboard.c
new file mode 100644
index 00000000000..44a45d502f2
--- /dev/null
+++ b/tk/mac/tkMacKeyboard.c
@@ -0,0 +1,384 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "Xlib.h"
+#include "keysym.h"
+
+#include <Events.h>
+#include <Script.h>
+
+typedef struct {
+ short keycode; /* Macintosh keycode */
+ KeySym keysym; /* X windows Keysym */
+} KeyInfo;
+
+static KeyInfo keyArray[] = {
+ {0x4C, XK_Return},
+ {0x24, XK_Return},
+ {0x33, XK_BackSpace},
+ {0x75, XK_Delete},
+ {0x30, XK_Tab},
+ {0x74, XK_Page_Up},
+ {0x79, XK_Page_Down},
+ {0x73, XK_Home},
+ {0x77, XK_End},
+ {0x7B, XK_Left},
+ {0x7C, XK_Right},
+ {0x7E, XK_Up},
+ {0x7D, XK_Down},
+ {0x72, XK_Help},
+ {0x35, XK_Escape},
+ {0x47, XK_Clear},
+ {0, 0}
+};
+
+static KeyInfo vituralkeyArray[] = {
+ {122, XK_F1},
+ {120, XK_F2},
+ {99, XK_F3},
+ {118, XK_F4},
+ {96, XK_F5},
+ {97, XK_F6},
+ {98, XK_F7},
+ {100, XK_F8},
+ {101, XK_F9},
+ {109, XK_F10},
+ {103, XK_F11},
+ {111, XK_F12},
+ {105, XK_F13},
+ {107, XK_F14},
+ {113, XK_F15},
+ {0, 0}
+};
+
+static int initialized = 0;
+static Tcl_HashTable keycodeTable; /* keyArray hashed by keycode value. */
+static Tcl_HashTable vkeyTable; /* vituralkeyArray hashed by virtual
+ keycode value. */
+static Ptr KCHRPtr; /* Pointer to 'KCHR' resource. */
+
+/*
+ * Prototypes for static functions used in this file.
+ */
+static void InitKeyMaps _ANSI_ARGS_((void));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitKeyMaps --
+ *
+ * Creates hash tables used by some of the functions in this file.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Allocates memory & creates some hash tables.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitKeyMaps()
+{
+ register Tcl_HashEntry *hPtr;
+ register KeyInfo *kPtr;
+ int dummy;
+
+ Tcl_InitHashTable(&keycodeTable, TCL_ONE_WORD_KEYS);
+ for (kPtr = keyArray; kPtr->keycode != 0; kPtr++) {
+ hPtr = Tcl_CreateHashEntry(&keycodeTable, (char *) kPtr->keycode,
+ &dummy);
+ Tcl_SetHashValue(hPtr, kPtr->keysym);
+ }
+ Tcl_InitHashTable(&vkeyTable, TCL_ONE_WORD_KEYS);
+ for (kPtr = vituralkeyArray; kPtr->keycode != 0; kPtr++) {
+ hPtr = Tcl_CreateHashEntry(&vkeyTable, (char *) kPtr->keycode,
+ &dummy);
+ Tcl_SetHashValue(hPtr, kPtr->keysym);
+ }
+ KCHRPtr = (Ptr) GetScriptManagerVariable(smKCHRCache);
+ initialized = 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XKeycodeToKeysym --
+ *
+ * Translate from a system-dependent keycode to a
+ * system-independent keysym.
+ *
+ * Results:
+ * Returns the translated keysym, or NoSymbol on failure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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.
+ * TODO: The index may also specify the NUM_LOCK.
+ */
+ newKeycode = virtualKey;
+ if (index & 0x01) {
+ newKeycode += 0x0200;
+ }
+ dummy = 0;
+ newChar = KeyTranslate(KCHRPtr, (short) newKeycode, &dummy);
+ c = newChar & charCodeMask;
+
+ if (c >= XK_space && c < XK_asciitilde) {
+ return c;
+ }
+
+ 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 --
+ *
+ * Fetch the current keycodes used as modifiers.
+ *
+ * Results:
+ * Returns a new modifier map.
+ *
+ * Side effects:
+ * Allocates a new modifier map data structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XModifierKeymap *
+XGetModifierMapping(
+ Display* display)
+{
+ XModifierKeymap * modmap;
+
+ modmap = (XModifierKeymap *) ckalloc(sizeof(XModifierKeymap));
+ modmap->max_keypermod = 0;
+ modmap->modifiermap = NULL;
+ return modmap;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XFreeModifiermap --
+ *
+ * Deallocate a modifier map that was created by
+ * XGetModifierMapping.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees the datastructure referenced by modmap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XFreeModifiermap(
+ XModifierKeymap *modmap)
+{
+ if (modmap->modifiermap != NULL) {
+ ckfree((char *) modmap->modifiermap);
+ }
+ ckfree((char *) modmap);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XKeysymToString, XStringToKeysym --
+ *
+ * These X window functions map Keysyms to strings & strings to
+ * keysyms. However, Tk already does this for the most common keysyms.
+ * Therefor, these functions only need to support keysyms that will be
+ * specific to the Macintosh. Currently, there are none.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+XKeysymToString(
+ KeySym keysym)
+{
+ return NULL;
+}
+
+KeySym
+XStringToKeysym(
+ const char* string)
+{
+ return NoSymbol;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XKeysymToKeycode --
+ *
+ * The function XKeysymToKeycode is only used by tkTest.c and
+ * currently only implementes the support for keys used in the
+ * Tk test suite.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+KeyCode
+XKeysymToKeycode(
+ Display* display,
+ KeySym keysym)
+{
+ KeyCode keycode = 0;
+ char virtualKeyCode = 0;
+
+ if ((keysym >= XK_space) && (XK_asciitilde)) {
+ if (keysym == 'a') {
+ virtualKeyCode = 0x00;
+ } else if (keysym == 'b' || keysym == 'B') {
+ virtualKeyCode = 0x0B;
+ } else if (keysym == 'c') {
+ virtualKeyCode = 0x08;
+ } else if (keysym == 'x' || keysym == 'X') {
+ virtualKeyCode = 0x07;
+ } else if (keysym == 'z') {
+ virtualKeyCode = 0x06;
+ } else if (keysym == ' ') {
+ virtualKeyCode = 0x31;
+ } else if (keysym == XK_Return) {
+ virtualKeyCode = 0x24;
+ keysym = '\r';
+ }
+ keycode = keysym + ((virtualKeyCode << 8) & keyCodeMask);
+ }
+
+ return keycode;
+}
diff --git a/tk/mac/tkMacLibrary.r b/tk/mac/tkMacLibrary.r
new file mode 100644
index 00000000000..493dee15657
--- /dev/null
+++ b/tk/mac/tkMacLibrary.r
@@ -0,0 +1,508 @@
+/*
+ * 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$
+ */
+
+/*
+ * 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.
+ */
+
+#define DLOG_RezTemplateVersion 0
+
+#include <Types.r>
+#include <SysTypes.r>
+#include <AEUserTermTypes.r>
+
+/*
+ * The folowing include and defines help construct
+ * the version string for Tcl.
+ */
+
+#define RESOURCE_INCLUDED
+#include <tcl.h>
+#include "tk.h"
+
+#if (TK_RELEASE_LEVEL == 0)
+# define RELEASE_LEVEL alpha
+#elif (TK_RELEASE_LEVEL == 1)
+# define RELEASE_LEVEL beta
+#elif (TK_RELEASE_LEVEL == 2)
+# define RELEASE_LEVEL final
+#endif
+
+#if (TK_RELEASE_LEVEL == 2)
+# define MINOR_VERSION (TK_MINOR_VERSION * 16) + TK_RELEASE_SERIAL
+#else
+# define MINOR_VERSION TK_MINOR_VERSION * 16
+#endif
+
+#define RELEASE_CODE 0x00
+
+resource 'vers' (1) {
+ TK_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ TK_PATCH_LEVEL,
+ TK_PATCH_LEVEL ", by Ray Johnson © 1993-1996" "\n" "Sun Microsystems Labratories"
+};
+
+resource 'vers' (2) {
+ TK_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ TK_PATCH_LEVEL,
+ "Tk Library " TK_PATCH_LEVEL " © 1993-1996"
+};
+
+#define TK_LIBRARY_RESOURCES 3000
+/*
+ * The -16397 string will be displayed by Finder when a user
+ * tries to open the shared library. The string should
+ * give the user a little detail about the library's capabilities
+ * and enough information to install the library in the correct location.
+ * A similar string should be placed in all shared libraries.
+ */
+resource 'STR ' (-16397, purgeable) {
+ "Tk Library\n\n"
+ "This is the library needed to run Tcl/Tk programs. "
+ "To work properly, it should be placed in the ŒTool Command Language¹ folder "
+ "within the Extensions folder."
+};
+
+
+/*
+ * We now load the Tk library into the resource fork of the library.
+ */
+
+read 'TEXT' (TK_LIBRARY_RESOURCES+1, "tk", purgeable)
+ "::library:tk.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+2, "button", purgeable)
+ "::library:button.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+3, "dialog", purgeable)
+ "::library:dialog.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+4, "entry", purgeable)
+ "::library:entry.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+5, "focus", purgeable)
+ "::library:focus.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+6, "listbox", purgeable)
+ "::library:listbox.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+7, "menu", purgeable)
+ "::library:menu.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+8, "optionMenu", purgeable)
+ "::library:optMenu.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+9, "palette", purgeable)
+ "::library:palette.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+10, "scale", purgeable)
+ "::library:scale.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+11, "scrollbar", purgeable)
+ "::library:scrlbar.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+12, "tearoff", purgeable)
+ "::library:tearoff.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+13, "text", purgeable)
+ "::library:text.tcl";
+read 'TEXT' (TK_LIBRARY_RESOURCES+14, "tkerror", purgeable)
+ "::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
+ * create and manage an About Dialog box.
+ */
+
+data 'DLOG' (128, "Default About Box", purgeable) {
+ $"0055 006B 00F3 0196 0001 0100 0100 0000"
+ $"0000 0081 0000 280A"
+};
+
+resource 'DITL' (129, "About Box", purgeable) {
+ {
+ {128, 128, 148, 186}, Button {enabled, "Ok"},
+ { 14, 108, 117, 298}, StaticText {disabled,
+ "Wish - Windowing Shell" "\n" "based on Tcl "
+ TCL_PATCH_LEVEL " & Tk " TK_PATCH_LEVEL "\n\n" "Ray Johnson"
+ "Sun Microsystems Labs" "\n" "ray.johnson@eng.sun.com"},
+ { 11, 24, 111, 92}, Picture {enabled, 128}
+ }
+};
+
+data 'PICT' (128, purgeable) {
+ $"13A4 0000 0000 0064 0044 0011 02FF 0C00"
+ $"FFFE 0000 0048 0000 0048 0000 0000 0000"
+ $"0064 0044 0000 0000 0001 000A 0000 0000"
+ $"0064 0044 0099 8044 0000 0000 0064 0044"
+ $"0000 0000 0000 0000 0048 0000 0048 0000"
+ $"0000 0008 0001 0008 0000 0000 0108 00D8"
+ $"0000 0000 0001 5A5A 8000 00FF 3736 FF00"
+ $"FF00 FF00 3535 FF00 FF00 CC00 3434 FF00"
+ $"FF00 9900 3333 FF00 FF00 6600 3736 FF00"
+ $"FF00 3300 3535 FF00 FF00 0000 3434 FF00"
+ $"CC00 FF00 3333 FF00 CC00 CC00 3736 FF00"
+ $"CC00 9900 3535 FF00 CC00 6600 FAFA FF00"
+ $"CC00 3300 3333 FF00 CC00 0000 3130 FF00"
+ $"9900 FF00 2F2F FF00 9900 CC00 FAFA FF00"
+ $"9900 9900 F9F9 FF00 9900 6600 3130 FF00"
+ $"9900 3300 2F2F FF00 9900 0000 2E2E FF00"
+ $"6600 FF00 F9F9 FF00 6600 CC00 3130 FF00"
+ $"6600 9900 2F2F FF00 6600 6600 2E2E FF00"
+ $"6600 3300 2D2D FF00 6600 0000 3130 FF00"
+ $"3300 FF00 2F2F FF00 3300 CC00 2E2E FF00"
+ $"3300 9900 2D2D FF00 3300 6600 3130 FF00"
+ $"3300 3300 2F2F FF00 3300 0000 2E2E FF00"
+ $"0000 FF00 2D2D FF00 0000 CC00 3130 FF00"
+ $"0000 9900 2F2F FF00 0000 6600 2E2E FF00"
+ $"0000 3300 2DF8 FF00 0000 0000 2B2A CC00"
+ $"FF00 FF00 2929 CC00 FF00 CC00 2828 CC00"
+ $"FF00 9900 27F8 CC00 FF00 6600 2B2A CC00"
+ $"FF00 3300 2929 CC00 FF00 0000 2828 CC00"
+ $"CC00 FF00 2727 CC00 CC00 CC00 2B2A CC00"
+ $"CC00 9900 2929 CC00 CC00 6600 2828 CC00"
+ $"CC00 3300 2727 CC00 CC00 0000 2B2A CC00"
+ $"9900 FF00 2929 CC00 9900 CC00 2828 CC00"
+ $"9900 9900 2727 CC00 9900 6600 DBDB CC00"
+ $"9900 3300 4747 CC00 9900 0000 4646 CC00"
+ $"6600 FF00 4545 CC00 6600 CC00 DBDB CC00"
+ $"6600 9900 4747 CC00 6600 6600 4646 CC00"
+ $"6600 3300 4545 CC00 6600 0000 DBDB CC00"
+ $"3300 FF00 4747 CC00 3300 CC00 4646 CC00"
+ $"3300 9900 4545 CC00 3300 6600 DBDB CC00"
+ $"3300 3300 4141 CC00 3300 0000 4040 CC00"
+ $"0000 FF00 3F3F CC00 0000 CC00 4342 CC00"
+ $"0000 9900 4141 CC00 0000 6600 4040 CC00"
+ $"0000 3300 3F3F CC00 0000 0000 4342 9900"
+ $"FF00 FF00 4141 9900 FF00 CC00 4040 9900"
+ $"FF00 9900 3F3F 9900 FF00 6600 4342 9900"
+ $"FF00 3300 4141 9900 FF00 0000 4040 9900"
+ $"CC00 FF00 3F3F 9900 CC00 CC00 4342 9900"
+ $"CC00 9900 4141 9900 CC00 6600 4040 9900"
+ $"CC00 3300 3F3F 9900 CC00 0000 4342 9900"
+ $"9900 FF00 4141 9900 9900 CC00 4040 9900"
+ $"9900 9900 3F3F 9900 9900 6600 3D3C 9900"
+ $"9900 3300 3B3B 9900 9900 0000 3A3A 9900"
+ $"6600 FF00 3939 9900 6600 CC00 3D3C 9900"
+ $"6600 9900 3B3B 9900 6600 6600 3A3A 9900"
+ $"6600 3300 3939 9900 6600 0000 3D3C 9900"
+ $"3300 FF00 3B3B 9900 3300 CC00 3A3A 9900"
+ $"3300 9900 3939 9900 3300 6600 3D3C 9900"
+ $"3300 3300 3B3B 9900 3300 0000 3A3A 9900"
+ $"0000 FF00 3939 9900 0000 CC00 3D3C 9900"
+ $"0000 9900 3B3B 9900 0000 6600 3A3A 9900"
+ $"0000 3300 3939 9900 0000 0000 3D3C 6600"
+ $"FF00 FF00 3B3B 6600 FF00 CC00 3A3A 6600"
+ $"FF00 9900 3939 6600 FF00 6600 3D3C 6600"
+ $"FF00 3300 3B3B 6600 FF00 0000 3A3A 6600"
+ $"CC00 FF00 3939 6600 CC00 CC00 3736 6600"
+ $"CC00 9900 3535 6600 CC00 6600 3434 6600"
+ $"CC00 3300 3333 6600 CC00 0000 3736 6600"
+ $"9900 FF00 3535 6600 9900 CC00 3434 6600"
+ $"9900 9900 3333 6600 9900 6600 3736 6600"
+ $"9900 3300 3535 6600 9900 0000 3434 6600"
+ $"6600 FF00 3333 6600 6600 CC00 3736 6600"
+ $"6600 9900 3535 6600 6600 6600 3434 6600"
+ $"6600 3300 3333 6600 6600 0000 3736 6600"
+ $"3300 FF00 3535 6600 3300 CC00 3434 6600"
+ $"3300 9900 3333 6600 3300 6600 3736 6600"
+ $"3300 3300 3535 6600 3300 0000 3434 6600"
+ $"0000 FF00 3333 6600 0000 CC00 3130 6600"
+ $"0000 9900 2F2F 6600 0000 6600 2E2E 6600"
+ $"0000 3300 F9F9 6600 0000 0000 3130 3300"
+ $"FF00 FF00 2F2F 3300 FF00 CC00 2E2E 3300"
+ $"FF00 9900 F9F9 3300 FF00 6600 3130 3300"
+ $"FF00 3300 2F2F 3300 FF00 0000 2E2E 3300"
+ $"CC00 FF00 2D2D 3300 CC00 CC00 3130 3300"
+ $"CC00 9900 2F2F 3300 CC00 6600 2E2E 3300"
+ $"CC00 3300 2D2D 3300 CC00 0000 3130 3300"
+ $"9900 FF00 2F2F 3300 9900 CC00 2E2E 3300"
+ $"9900 9900 2D2D 3300 9900 6600 3130 3300"
+ $"9900 3300 2F2F 3300 9900 0000 2E2E 3300"
+ $"6600 FF00 2DF8 3300 6600 CC00 2B2A 3300"
+ $"6600 9900 2929 3300 6600 6600 2828 3300"
+ $"6600 3300 27F8 3300 6600 0000 2B2A 3300"
+ $"3300 FF00 2929 3300 3300 CC00 2828 3300"
+ $"3300 9900 2727 3300 3300 6600 2B2A 3300"
+ $"3300 3300 2929 3300 3300 0000 2828 3300"
+ $"0000 FF00 2727 3300 0000 CC00 2B2A 3300"
+ $"0000 9900 2929 3300 0000 6600 2828 3300"
+ $"0000 3300 2727 3300 0000 0000 4948 0000"
+ $"FF00 FF00 4747 0000 FF00 CC00 4646 0000"
+ $"FF00 9900 4545 0000 FF00 6600 4948 0000"
+ $"FF00 3300 4747 0000 FF00 0000 4646 0000"
+ $"CC00 FF00 4545 0000 CC00 CC00 4948 0000"
+ $"CC00 9900 4747 0000 CC00 6600 4646 0000"
+ $"CC00 3300 4545 0000 CC00 0000 4342 0000"
+ $"9900 FF00 4141 0000 9900 CC00 4040 0000"
+ $"9900 9900 3F3F 0000 9900 6600 4342 0000"
+ $"9900 3300 4141 0000 9900 0000 4040 0000"
+ $"6600 FF00 3F3F 0000 6600 CC00 4342 0000"
+ $"6600 9900 4141 0000 6600 6600 4040 0000"
+ $"6600 3300 3F3F 0000 6600 0000 4342 0000"
+ $"3300 FF00 4141 0000 3300 CC00 4040 0000"
+ $"3300 9900 3F3F 0000 3300 6600 4342 0000"
+ $"3300 3300 4141 0000 3300 0000 4040 0000"
+ $"0000 FF00 3F3F 0000 0000 CC00 4342 0000"
+ $"0000 9900 4141 0000 0000 6600 4040 0000"
+ $"0000 3300 3F3F EE00 0000 0000 3D3C DD00"
+ $"0000 0000 3B3B BB00 0000 0000 3A3A AA00"
+ $"0000 0000 3939 8800 0000 0000 3D3C 7700"
+ $"0000 0000 3B3B 5500 0000 0000 3A3A 4400"
+ $"0000 0000 3939 2200 0000 0000 3D3C 1100"
+ $"0000 0000 3B3B 0000 EE00 0000 3A3A 0000"
+ $"DD00 0000 3939 0000 BB00 0000 3D3C 0000"
+ $"AA00 0000 3B3B 0000 8800 0000 3A3A 0000"
+ $"7700 0000 3939 0000 5500 0000 3D3C 0000"
+ $"4400 0000 3B3B 0000 2200 0000 3A3A 0000"
+ $"1100 0000 3939 0000 0000 EE00 3D3C 0000"
+ $"0000 DD00 3B3B 0000 0000 BB00 3A3A 0000"
+ $"0000 AA00 3939 0000 0000 8800 3D3C 0000"
+ $"0000 7700 3B3B 0000 0000 5500 3A3A 0000"
+ $"0000 4400 3939 0000 0000 2200 3736 0000"
+ $"0000 1100 3535 EE00 EE00 EE00 3434 DD00"
+ $"DD00 DD00 3333 BB00 BB00 BB00 3736 AA00"
+ $"AA00 AA00 3535 8800 8800 8800 3434 7700"
+ $"7700 7700 3333 5500 5500 5500 3736 4400"
+ $"4400 4400 3535 2200 2200 2200 3434 1100"
+ $"1100 1100 3333 0000 0000 0000 0000 0000"
+ $"0064 0044 0000 0000 0064 0044 0000 000A"
+ $"0000 0000 0064 0044 02BD 0013 E800 01F5"
+ $"F6FE 07FE 0E02 3232 33FD 3900 0EE6 001D"
+ $"FC00 01F5 F5FE 0700 08FE 0E02 3232 33FE"
+ $"3900 3AFC 40F2 4102 4033 07E9 0017 0100"
+ $"0EFC 40DC 4102 390E F5F5 0002 F5F5 F6FE"
+ $"0702 0E07 0016 0100 32D5 4104 4039 0E32"
+ $"33FD 3900 3AFC 40FC 4101 3200 0801 000E"
+ $"C141 010E 0008 0100 0EC1 4101 0800 0801"
+ $"000E C141 0107 0008 0100 0EC1 4101 0700"
+ $"0901 0007 C241 0240 F500 0E01 0007 E841"
+ $"0147 47DD 4102 4000 0012 0100 07F0 4100"
+ $"47FA 4101 3B3B DD41 0240 0000 1901 0007"
+ $"F141 0C47 3B0B 3B47 4141 4711 0505 3B47"
+ $"DF41 023A 0000 1701 00F6 F041 010B 0BFE"
+ $"4105 473B 0505 113B DE41 0239 0000 1A02"
+ $"00F5 40F3 410C 473B 053B 4741 4741 0B0B"
+ $"3B47 47DE 4102 3900 0018 0200 F540 F341"
+ $"0247 110B FE41 0447 1105 4147 DC41 0233"
+ $"0000 1B02 0000 40F3 4103 4711 1147 FE41"
+ $"0205 3547 F741 FD47 E941 0232 0000 1E02"
+ $"0000 40F2 4106 113B 4741 4735 0BF7 4106"
+ $"4741 390E 0E40 47EA 4102 0E00 0021 0200"
+ $"0040 F241 0711 3B47 4141 0B35 47F9 4102"
+ $"4740 07FE 0002 F640 47EB 4102 0E00 0023"
+ $"0200 0040 F341 0847 3541 4147 3B05 4147"
+ $"FA41 0947 3AF6 00F5 4F55 F50E 47EB 4102"
+ $"0700 0022 0200 003A F341 0147 3BFE 4101"
+ $"0B0B F941 0547 3AF5 0055 C8FE CE01 5640"
+ $"EB41 0207 0000 1F02 0000 39F0 4104 4741"
+ $"053B 47FB 4104 4740 F5F5 A4FC CE01 C85D"
+ $"EB41 02F6 0000 1F02 0000 39F0 4104 473B"
+ $"0541 47FC 4104 4740 07F6 C8FA CE00 64EC"
+ $"4103 40F5 0000 1C02 0000 39F0 4102 4711"
+ $"0BFA 4103 4708 2AC8 FACE 0164 D8EC 4100"
+ $"40FE 0025 0200 0039 EF41 020B 3B47 FC41"
+ $"0347 0FF5 A4FB CE02 C887 D8FC 41FE 47FC"
+ $"4100 47F9 4100 3AFE 0028 0200 0039 EF41"
+ $"020B 3B47 FD41 0347 3900 A4FA CE00 ABFA"
+ $"4109 3B11 3B41 4147 3B0B 3B47 FA41 0039"
+ $"FE00 2402 0000 33F1 4102 4741 0BFA 4101"
+ $"0779 F9CE 0064 FA41 0235 050B FD41 010B"
+ $"0BF9 4100 39FE 0028 0200 0032 F141 0247"
+ $"3B0B FC41 0247 39F6 F9CE 0187 D8FB 4103"
+ $"4741 050B FE41 0247 110B F941 0039 FE00"
+ $"2C02 0000 32F1 4102 473B 11FB 4101 0879"
+ $"FACE 05AA 4041 4147 47FE 410A 4741 0511"
+ $"4741 4147 3511 47FA 4100 32FE 002F 0200"
+ $"000E F141 0347 3B11 47FE 4103 4740 F6C8"
+ $"FACE 0564 D841 4039 39FE 4104 473B 053B"
+ $"47FE 4102 3541 47FA 4100 0EFE 0027 0200"
+ $"000E F141 0347 3B3B 47FE 4102 470F 79FA"
+ $"CE0C 8741 4032 F500 003A 4741 473B 05F2"
+ $"4100 0EFE 0027 0200 000E F141 0347 3B3B"
+ $"47FD 4101 0EA4 FACE 01AB AAFE C808 7900"
+ $"3947 4147 110B 47F3 4100 07FE 001C 0200"
+ $"000E EA41 0240 2BC8 F5CE 0881 0033 4741"
+ $"410B 3B47 F341 0007 FE00 1A02 0000 08EB"
+ $"4102 473A 55F4 CE06 5D00 3947 4741 0BF1"
+ $"4100 F6FE 001C 0200 0007 EB41 0247 3979"
+ $"F4CE 0739 0039 4747 3511 47F3 4101 40F5"
+ $"FE00 1C02 0000 07EB 4102 4739 A4F5 CE08"
+ $"AB0E 0040 4741 1141 47F3 4100 40FD 001B"
+ $"0200 0007 EB41 0247 39A4 F5CE 0787 0707"
+ $"4147 4111 47F2 4100 40FD 001B 0200 0007"
+ $"EB41 0247 39C8 F5CE 0763 F532 4747 3B3B"
+ $"47F2 4100 3AFD 001A 0300 00F6 40EC 4102"
+ $"4739 C8F5 CE05 39F5 4047 413B F041 0039"
+ $"FD00 1C03 0000 F540 EB41 0140 C8FD CE01"
+ $"C8A4 FCCE 03AB 080E 47ED 4100 39FD 001A"
+ $"FE00 0040 EB41 0040 FCCE 01A4 C8FC CE03"
+ $"FA07 4047 ED41 0032 FD00 1AFE 0000 40EA"
+ $"4100 AAFE CE02 87F9 C8FC CE02 560F 47EC"
+ $"4100 32FD 0019 FE00 0040 EA41 00AB FECE"
+ $"0264 56C8 FDCE 01C8 32EA 4100 0EFD 001B"
+ $"FE00 0040 ED41 030E 4047 87FE CE01 4055"
+ $"FCCE 01FA 40EA 4100 08FD 001A FE00 003A"
+ $"ED41 0807 0740 FBCE CEAB 3979 FDCE 00AB"
+ $"E841 0007 FD00 1CFE 0000 3AED 4108 0700"
+ $"F6A4 CECE 8733 79FD CE02 4147 47EA 4100"
+ $"07FD 001E FE00 0039 ED41 0807 2AA4 C8CE"
+ $"CE88 0E9D FECE 0364 1C39 39EB 4101 40F5"
+ $"FD00 1CFE 0000 39ED 4101 074F FDCE 0264"
+ $"F7A4 FECE 03AB 80F6 07EB 4100 40FC 001C"
+ $"FE00 0039 ED41 0108 79FE CE03 AB40 2BA4"
+ $"FCCE 02F7 0E47 EC41 0040 FC00 1CFE 0000"
+ $"39ED 4101 0879 FECE 03AB 40F6 C8FC CE02"
+ $"F615 47EC 4100 40FC 001E FE00 003A EE41"
+ $"0247 0E79 FECE 03AB 40F5 C8FD CE03 A4F5"
+ $"3A47 EC41 0040 FC00 1EFE 0000 3AEE 4102"
+ $"470E 56FE CE03 FB3A F6C8 FDCE 0280 F540"
+ $"EB41 0140 F5FD 001E FE00 0040 EE41 0947"
+ $"0F56 CECE C888 39F6 C8FD CE02 5601 40EB"
+ $"4101 40F5 FD00 1CFE 0000 40EE 4109 4739"
+ $"32CE CEC8 8839 2AC8 FDCE 0156 07E9 4100"
+ $"F6FD 001B FE00 0040 EE41 0847 3A32 CECE"
+ $"C864 152A FCCE 0132 07E9 4100 07FD 001A"
+ $"FE00 0040 ED41 0740 32AB CEC8 6439 4EFC"
+ $"CE01 3A07 E941 0007 FD00 1D03 0000 F540"
+ $"ED41 0740 0EAB CECE 640F 4EFD CE03 AB40"
+ $"0840 EA41 0007 FD00 1B03 0000 F540 EC41"
+ $"060F 81CE CE64 334E FDCE 02AB 400E E941"
+ $"000E FD00 1C02 0000 F6EC 4107 4715 FACE"
+ $"CE64 334E FDCE 0387 0F0E 47EA 4100 0EFD"
+ $"001C 0200 0007 EC41 0747 16F9 CEC8 6433"
+ $"4EFD CE03 6308 4047 EA41 000E FD00 1A02"
+ $"0000 07EB 4106 40F9 CEC8 6439 4EFD CE02"
+ $"3940 47E9 4100 32FD 001B 0200 0007 EA41"
+ $"0539 CECE 8839 F6FE CE04 AB41 4139 40EA"
+ $"4100 32FD 001C 0200 0007 EB41 0E47 3AC8"
+ $"CE88 39F6 C8CE CE64 15F6 F540 EA41 0033"
+ $"FD00 1A02 0000 07EA 410C 40A4 CE87 392A"
+ $"C8CE AB41 40F8 F6E9 4100 39FD 001B 0200"
+ $"000E EB41 0D47 41AB C887 39F5 C8CE ABAB"
+ $"CEA4 07E9 4100 39FD 001C 0200 000E ED41"
+ $"0947 3939 4787 C8AB 40F5 C8FD CE01 A40E"
+ $"E941 0039 FD00 1D02 0000 0EED 4109 473A"
+ $"0007 80CE AB40 F5C8 FDCE 0255 0E47 EA41"
+ $"0039 FD00 1B02 0000 0EEB 4107 0779 C8CE"
+ $"CE40 F6A4 FDCE 022B 3947 EA41 003A FD00"
+ $"1C02 0000 0EEC 4102 4739 79FE CE02 6407"
+ $"A4FE CE02 A407 40E9 4100 40FD 001A 0200"
+ $"0032 EA41 0632 A4CE CE88 0879 FECE 02F9"
+ $"0F47 E941 0040 FD00 1A02 0000 32EB 4107"
+ $"4740 F7C8 CE87 0E79 FECE 0132 40E8 4100"
+ $"40FD 0019 0200 0033 EA41 0B47 40F8 C8AB"
+ $"0E55 CECE 8015 47E8 4100 40FD 0017 0200"
+ $"0033 E941 0847 40F9 A439 4FCE CE5D E641"
+ $"0140 F5FE 0014 0200 0039 E841 0647 64FB"
+ $"392B C8AB E441 00F6 FE00 1102 0000 39E5"
+ $"4103 40F6 8764 E441 0007 FE00 1E02 0000"
+ $"39EB 4102 3A0E 0EFD 4102 0740 47F6 4104"
+ $"400F 0839 47F4 4100 07FE 0027 0200 0039"
+ $"FB41 0147 47F2 4102 0800 40FE 4102 0839"
+ $"47FC 4101 4747 FC41 0339 0039 47F4 4100"
+ $"07FE 0029 0200 0039 FB41 0140 39F3 4109"
+ $"470E F540 4141 470E 3347 FC41 0139 3AFD"
+ $"4104 4739 0039 47F4 4100 08FE 0036 0200"
+ $"003A FC41 0347 0E00 40FC 4102 4741 40FC"
+ $"4109 470E F540 4141 4733 0E47 FE41 0447"
+ $"4000 0E47 FE41 0447 3900 3941 FE40 F741"
+ $"000E FE00 3A02 0000 3AFD 410E 4740 0700"
+ $"0E40 4741 4147 390E 390E 40FE 4108 470E"
+ $"F540 4141 4739 0EFC 4103 0F00 0739 FE41"
+ $"0747 3900 3940 080F 39F7 4100 0EFE 0035"
+ $"0200 0040 FB41 020E 0040 FE41 0D47 4000"
+ $"3941 0032 4741 4147 0EF5 40FE 4101 4008"
+ $"FC41 023A 000E FD41 0547 3900 3939 33F5"
+ $"4100 0EFE 0039 0200 0040 FC41 0347 0E00"
+ $"40FE 4106 4732 0040 4139 40FE 4103 470E"
+ $"F540 FD41 0108 40FE 4104 4740 000E 47FE"
+ $"4106 4739 0007 F540 47F6 4100 32FE 003A"
+ $"0200 0040 FC41 0C47 0E00 4047 4141 470E"
+ $"0040 4747 FD41 0347 0EF5 40FE 410A 470E"
+ $"3947 4141 4740 000E 47FE 4107 4739 000E"
+ $"0007 4147 F741 0032 FE00 3802 0000 40FC"
+ $"4102 470E 00FD 4106 4739 003A 4740 39FE"
+ $"4102 470E F5FD 410A 4733 3347 4141 4740"
+ $"000E 47FE 4106 4739 0039 3900 0EF6 4100"
+ $"33FE 003A 0200 F540 FC41 0447 3200 0E39"
+ $"FD41 0B0E 0E40 333A 4741 413A 07F5 39FE"
+ $"4102 473A 0EFD 410F 40F5 0733 4041 4140"
+ $"0E00 0E40 0700 0E40 F841 0039 FE00 2902"
+ $"00F5 40FA 4101 3939 FB41 023A 3A40 FD41"
+ $"FD40 FD41 0240 0E40 FD41 0240 3940 FD41"
+ $"FA40 F741 0039 FE00 2A01 00F6 F941 0147"
+ $"47FB 4101 4747 FB41 0147 47FB 4101 3940"
+ $"FD41 0147 47FB 4100 47FE 4100 47F6 4100"
+ $"39FE 000D 0100 07E1 4100 40E4 4100 3AFE"
+ $"0009 0100 07C3 4100 3AFE 0009 0100 07C3"
+ $"4100 40FE 0009 0100 07C3 4100 40FE 0009"
+ $"0100 07C3 4100 40FE 000A 0100 0EC3 4103"
+ $"40F5 0000 0901 000E C241 02F6 0000 0901"
+ $"000E C241 0207 0000 0901 000E C241 0207"
+ $"0000 1101 000E ED41 FE40 003A F940 E241"
+ $"0207 0000 2B01 0032 F941 FE40 FE39 0632"
+ $"0E0E 0707 F6F5 F800 02F5 F5F6 FB07 FB0E"
+ $"0332 3233 33FB 3901 3A3A FB40 0207 0000"
+ $"0E0A 000E 3939 320E 0E07 07F6 F5C8 0002"
+ $"BD00 00FF"
+};
+
+/*
+ * Here is the custom file open dialog. This dialog is used instead of
+ * the default file dialog if the -filetypes flag is specified.
+ */
+
+#define DLOG_RezTemplateVersion 0
+
+resource 'DLOG' (130, purgeable) {
+ {0, 0, 195, 344}, dBoxProc, invisible, noGoAway, 0,
+ 130, ""
+};
+
+resource 'DITL' (130, "File Open Box", purgeable) {
+ {
+ {135, 252, 155, 332}, Button {enabled, "Open"},
+ {104, 252, 124, 332}, Button {enabled, "Cancel"},
+ { 0, 0, 0, 0}, HelpItem {disabled, HMScanhdlg {130}},
+ { 8, 235, 24, 337}, UserItem {enabled},
+ { 32, 252, 52, 332}, Button {enabled, "Eject"},
+ { 60, 252, 80, 332}, Button {enabled, "Desktop"},
+ { 29, 12, 159, 230}, UserItem {enabled},
+ { 6, 12, 25, 230}, UserItem {enabled},
+ { 91, 251, 92, 333}, Picture {disabled, 11},
+ {168, 20, 187, 300}, Control {enabled, 131}
+ }
+};
+
+resource 'CNTL' (131, "File Types menu", purgeable) {
+ {168, 20, 187, 300},
+ popupTitleLeftJust,
+ visible,
+ 80,
+ 132,
+ popupMenuCDEFProc,
+ 0,
+ "File Type:"
+};
+
+
+resource 'MENU' (132, preload) {
+ 132,
+ textMenuProc,
+ 0xFFFF, enabled, "", {}
+};
diff --git a/tk/mac/tkMacMDEF.c b/tk/mac/tkMacMDEF.c
new file mode 100644
index 00000000000..136f1ba8cab
--- /dev/null
+++ b/tk/mac/tkMacMDEF.c
@@ -0,0 +1,116 @@
+/*
+ * 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$
+ */
+
+#define MAC_TCL
+#define NeedFunctionPrototypes 1
+#define NeedWidePrototypes 0
+
+#include <Menus.h>
+#include <LowMem.h>
+#include "tkMacInt.h"
+
+
+/*
+ * The following structure is built from assembly equates in MPW 3.0
+ * AIncludes file: "Private.a." We're forced to update several locations not
+ * documented in "Inside Mac" to make our MDEF behave properly with hierarchical
+ * menus.
+ */
+
+#if STRUCTALIGNMENTSUPPORTED
+#pragma options align=mac68k
+#endif
+typedef struct mbPrivate {
+ Byte unknown[6];
+ Rect mbItemRect; /* rect of currently chosen menu item */
+} mbPrivate;
+#if STRUCTALIGNMENTSUPPORTED
+#pragma options align=reset
+#endif
+
+/*
+ * We are forced to update a low-memory global to get cascades to work. This
+ * global does not have a LMEquate associated with it.
+ */
+
+#define SELECTRECT (*(Rect *)0x09fa) /* Menu select seems to need this */
+#define MBSAVELOC (*(short *)0x0B5C) /* address of handle to mbarproc private data redefined below */
+
+pascal void main _ANSI_ARGS_((short message,
+ MenuHandle menu, Rect *menuRect,
+ Point hitPt, short *whichItem));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacStdMenu --
+ *
+ * The dispatch routine called by the system to handle menu drawing,
+ * scrolling, etc. This is a stub; the address of the real routine
+ * is blasted in. The real routine will be a UniversalProcPtr,
+ * which will give the real dispatch routine in Tk globals
+ * and the like.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * This routine causes menus to be drawn and will certainly allocate
+ * memory as a result. Also, the menu can scroll up and down, and
+ * various other interface actions can take place
+ *
+ *----------------------------------------------------------------------
+ */
+
+pascal void
+main(
+ short message, /* What action are we taking? */
+ MenuHandle menu, /* The menu we are working with */
+ Rect *menuRect, /* A pointer to the rect we are working with */
+ Point hitPt, /* Where the mouse was hit for appropriate
+ * messages. */
+ short *whichItemPtr) /* Output result. Which item was hit by
+ * the user? */
+{
+ /*
+ * The constant 'MDEF' is what will be punched during menu intialization.
+ */
+
+ TkMenuDefProcPtr procPtr = (TkMenuDefProcPtr) 'MDEF';
+ TkMenuLowMemGlobals globals;
+ short oldItem;
+
+ globals.menuDisable = LMGetMenuDisable();
+ globals.menuTop = LMGetTopMenuItem();
+ globals.menuBottom = LMGetAtMenuBottom();
+ if (MBSAVELOC == -1) {
+ globals.itemRect = (**(mbPrivate***)&MBSAVELOC)->mbItemRect;
+ }
+ if (message == mChooseMsg) {
+ oldItem = *whichItemPtr;
+ }
+
+ TkCallMenuDefProc(procPtr, message, menu, menuRect, hitPt, whichItemPtr,
+ &globals);
+
+ LMSetMenuDisable(globals.menuDisable);
+ LMSetTopMenuItem(globals.menuTop);
+ LMSetAtMenuBottom(globals.menuBottom);
+ if ((message == mChooseMsg) && (oldItem != *whichItemPtr)
+ && (MBSAVELOC != -1)) {
+ (**(mbPrivate***)&MBSAVELOC)->mbItemRect = globals.itemRect;
+ SELECTRECT = globals.itemRect;
+ }
+}
diff --git a/tk/mac/tkMacMDEF.r b/tk/mac/tkMacMDEF.r
new file mode 100644
index 00000000000..85f165e2740
--- /dev/null
+++ b/tk/mac/tkMacMDEF.r
@@ -0,0 +1,45 @@
+/*
+ * tkMacMDEF.r --
+ *
+ * This file contains the actual MDEF. Since this is not likely to
+ * change much, this seems the easiest method to use. The address
+ * of the routine descriptor is written into offset 0x24 hex, and
+ * then when the MDEF is called, the Mixed Mode Manager will take
+ * care of the setup.
+ *
+ * This file also contains the icons 'SICN' used by the menu code
+ * 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$
+ */
+
+#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
+ * in.
+ */
+
+data 'MDEF' (591, preload) {
+ $"600A 0000 4D44 4546 024F 0000 4EFA 0004" /* `...MDEF.O..Nú.. */
+ $"4E75 4E56 FFEE 48E7 1830 362E 0018 246E" /* NuNVÿîHç.06...$n */
+ $"0008 267C 4D44 4546 594F 2EB8 0B54 201F" /* ..&|MDEFYO.¸.T . */
+ $"2D40 FFEE 554F 3EB8 0A0A 301F 3D40 FFF2" /* -@ÿîUO>¸..0.=@ÿò */
+ $"554F 3EB8 0A0C 301F 3D40 FFF4 0C78 FFFF" /* UO>¸..0.=@ÿô.xÿÿ */
+ $"0B5C 6612 2078 0B5C 2050 2D68 0006 FFF6" /* .\f. x.\ P-h..ÿö */
+ $"2D68 000A FFFA 0C43 0001 6602 3812 3F03" /* -h..ÿú.C..f.8.?. */
+ $"2F2E 0014 2F2E 0010 2F2E 000C 2F0A 486E" /* /.../.../.../.Hn */
+ $"FFEE 4E93 2F2E FFEE 21DF 0B54 3F2E FFF2" /* ÿîN“/.ÿî!ß.T?.ÿò */
+ $"31DF 0A0A 3F2E FFF4 31DF 0A0C 0C43 0001" /* 1ß..?.ÿô1ß...C.. */
+ $"662A B852 6726 0C78 FFFF 0B5C 671E 2078" /* f*¸Rg&.xÿÿ.\g. x */
+ $"0B5C 2050 216E FFF6 0006 216E FFFA 000A" /* .\ P!nÿö..!nÿú.. */
+ $"21EE FFF6 09FA 21EE FFFA 09FE 4CDF 0C18" /* !îÿöÆú!îÿúÆþLß.. */
+ $"4E5E 205F 4FEF 0012 4ED0 846D 6169 6E00" /* N^ _Oï..NЄmain. */
+ $"0000" /* .. */
+};
diff --git a/tk/mac/tkMacMenu.c b/tk/mac/tkMacMenu.c
new file mode 100644
index 00000000000..a3aadcd692f
--- /dev/null
+++ b/tk/mac/tkMacMenu.c
@@ -0,0 +1,4302 @@
+/*
+ * 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$
+ */
+
+#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
+#define COMMAND_ICON_WIDTH 10
+
+#define CASCADE_ARROW 0
+#define SHIFT_ICON 1
+#define OPTION_ICON 2
+#define CONTROL_ICON 3
+#define COMMAND_ICON 4
+#define DOWN_ARROW 5
+#define UP_ARROW 6
+
+/*
+ * Platform specific flags for menu entries
+ *
+ * ENTRY_COMMAND_ACCEL Indicates the entry has the command key
+ * in its accelerator string.
+ * ENTRY_OPTION_ACCEL Indicates the entry has the option key
+ * in its accelerator string.
+ * ENTRY_SHIFT_ACCEL Indicates the entry has the shift key
+ * in its accelerator string.
+ * ENTRY_CONTROL_ACCEL Indicates the entry has the control key
+ * in its accelerator string.
+ */
+
+#define ENTRY_COMMAND_ACCEL ENTRY_PLATFORM_FLAG1
+#define ENTRY_OPTION_ACCEL ENTRY_PLATFORM_FLAG2
+#define ENTRY_SHIFT_ACCEL ENTRY_PLATFORM_FLAG3
+#define ENTRY_CONTROL_ACCEL ENTRY_PLATFORM_FLAG4
+#define ENTRY_ACCEL_MASK (ENTRY_COMMAND_ACCEL | ENTRY_OPTION_ACCEL \
+ | ENTRY_SHIFT_ACCEL | ENTRY_CONTROL_ACCEL)
+
+/*
+ * This structure is used to keep track of subfields within Macintosh menu
+ * items.
+ */
+
+typedef struct EntryGeometry {
+ int accelTextStart; /* Offset into the accel string where
+ * the text starts. Everything before
+ * this is modifier key descriptions.
+ */
+ int modifierWidth; /* Width of modifier symbols. */
+ int accelTextWidth; /* Width of the text after the modifier
+ * keys. */
+ int nonAccelMargin; /* The width of the margin for entries
+ * without accelerators. */
+} EntryGeometry;
+
+/*
+ * Structure to keep track of toplevel windows and their menubars.
+ */
+
+typedef struct TopLevelMenubarList {
+ struct TopLevelMenubarList *nextPtr;
+ /* The next window in the list. */
+ Tk_Window tkwin; /* The toplevel window. */
+ TkMenu *menuPtr; /* The menu associated with this
+ * toplevel. */
+} TopLevelMenubarList;
+
+/*
+ * Platform-specific flags for menus.
+ *
+ * MENU_APPLE_MENU 0 indicates a custom Apple menu has
+ * not been installed; 1 a custom Apple
+ * menu has been installed.
+ * MENU_HELP_MENU 0 indicates a custom Help menu has
+ * not been installed; 1 a custom Help
+ * menu has been installed.
+ * MENU_RECONFIGURE_PENDING 1 indicates that an idle handler has
+ * been scheduled to reconfigure the
+ * Macintosh MenuHandle.
+ */
+
+#define MENU_APPLE_MENU MENU_PLATFORM_FLAG1
+#define MENU_HELP_MENU MENU_PLATFORM_FLAG2
+#define MENU_RECONFIGURE_PENDING MENU_PLATFORM_FLAG3
+
+#define CASCADE_CMD (0x1b)
+ /* 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
+ * be valid when the value of this
+ * variable is 1. */
+
+static Tcl_HashTable commandTable;
+ /* The list of menuInstancePtrs associated with
+ * menu ids */
+static short currentAppleMenuID;
+ /* The id of the current Apple menu. 0 for
+ * none. */
+static short currentHelpMenuID; /* The id of the current Help menu. 0 for
+ * none. */
+static Tcl_Interp *currentMenuBarInterp;
+ /* The interpreter of the window that owns
+ * 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. */
+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_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr,
+ Drawable d, Tk_3DBorder activeBorder,
+ Tk_3DBorder bgBorder, int x, int y,
+ int width, int heigth));
+static void DrawMenuEntryIndicator _ANSI_ARGS_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr,
+ Drawable d, GC gc, GC indicatorGC,
+ Tk_Font tkfont,
+ CONST Tk_FontMetrics *fmPtr, int x, int y,
+ int width, int height));
+static void DrawMenuEntryLabel _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 DrawMenuSeparator _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 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 Handle 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));
+static void GetMenuIndicatorGeometry _ANSI_ARGS_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr,
+ Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr,
+ int *widthPtr, int *heightPtr));
+static void GetMenuSeparatorGeometry _ANSI_ARGS_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr,
+ Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr,
+ int *widthPtr, int *heightPtr));
+static void GetTearoffEntryGeometry _ANSI_ARGS_((TkMenu *menuPtr,
+ TkMenuEntry *mePtr, Tk_Font tkfont,
+ CONST Tk_FontMetrics *fmPtr, int *widthPtr,
+ int *heightPtr));
+static int GetNewID _ANSI_ARGS_((Tcl_Interp *interp,
+ TkMenu *menuInstPtr, int cascade,
+ short *menuIDPtr));
+static char FindMarkCharacter _ANSI_ARGS_((TkMenuEntry *mePtr));
+static void FreeID _ANSI_ARGS_((short menuID));
+static void InvalidateMDEFRgns _ANSI_ARGS_((void));
+static void MenuDefProc _ANSI_ARGS_((short message,
+ MenuHandle menu, Rect *menuRectPtr,
+ Point hitPt, short *whichItem,
+ TkMenuLowMemGlobals *globalsPtr));
+static void MenuSelectEvent _ANSI_ARGS_((TkMenu *menuPtr));
+static void ReconfigureIndividualMenu _ANSI_ARGS_((
+ TkMenu *menuPtr, MenuHandle macMenuHdl,
+ int base));
+static void ReconfigureMacintoshMenu _ANSI_ARGS_ ((
+ ClientData clientData));
+static void RecursivelyClearActiveMenu _ANSI_ARGS_((
+ TkMenu *menuPtr));
+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 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 --
+ *
+ * Take the ID out of the available list for new menus. Used by the
+ * default menu bar's menus so that they do not get created at the tk
+ * level. See GetNewID for more information.
+ *
+ * Results:
+ * Returns TCL_OK if the id was not in use. Returns TCL_ERROR if the
+ * id was in use.
+ *
+ * Side effects:
+ * A hash table entry in the command table is created with a NULL
+ * 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);
+ if (newEntry == 1) {
+ Tcl_SetHashValue(commandEntryPtr, NULL);
+ return TCL_OK;
+ } else {
+ return TCL_ERROR;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetNewID --
+ *
+ * Allocates a new menu id and marks it in use. Each menu on the
+ * mac must be designated by a unique id, which is a short. In
+ * addition, some ids are reserved by the system. Since Tk uses
+ * mostly dynamic menus, we must allocate and free these ids on
+ * the fly. We use the id as a key into a hash table; if there
+ * is no hash entry, we know that we can use the id.
+ *
+ * Results:
+ * Returns TCL_OK if succesful; TCL_ERROR if there are no more
+ * ids of the appropriate type to allocate. menuIDPtr contains
+ * the new id if succesful.
+ *
+ * Side effects:
+ * An entry is created for the menu in the command hash table,
+ * and the hash entry is stored in the appropriate field in the
+ * menu data structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetNewID(
+ Tcl_Interp *interp, /* Used for error reporting */
+ TkMenu *menuPtr, /* The menu we are working with */
+ int cascade, /* 0 if we are working with a normal menu;
+ 1 if we are working with a cascade */
+ short *menuIDPtr) /* The resulting id */
+{
+ int found = 0;
+ int newEntry;
+ Tcl_HashEntry *commandEntryPtr;
+ short returnID = *menuIDPtr;
+
+ /*
+ * The following code relies on shorts and unsigned chars wrapping
+ * when the highest value is incremented. Also, the values between
+ * 236 and 255 inclusive are reserved for DA's by the Mac OS.
+ */
+
+ if (!cascade) {
+ short curID = lastMenuID + 1;
+ if (curID == 236) {
+ curID = 256;
+ }
+
+ while (curID != lastMenuID) {
+ commandEntryPtr = Tcl_CreateHashEntry(&commandTable,
+ (char *) curID, &newEntry);
+ if (newEntry == 1) {
+ found = 1;
+ lastMenuID = returnID = curID;
+ break;
+ }
+ curID++;
+ if (curID == 236) {
+ curID = 256;
+ }
+ }
+ } else {
+
+ /*
+ * Cascade ids must be between 0 and 235 only, so they must be
+ * dealt with separately.
+ */
+
+ unsigned char curID = lastCascadeID + 1;
+ if (curID == 236) {
+ curID = 0;
+ }
+
+ while (curID != lastCascadeID) {
+ commandEntryPtr = Tcl_CreateHashEntry(&commandTable,
+ (char *) curID, &newEntry);
+ if (newEntry == 1) {
+ found = 1;
+ lastCascadeID = returnID = curID;
+ break;
+ }
+ curID++;
+ if (curID == 236) {
+ curID = 0;
+ }
+ }
+ }
+
+ 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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeID --
+ *
+ * Marks the id as free.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The hash table entry for the ID is cleared.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeID(
+ short menuID) /* The id to free */
+{
+ Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&commandTable,
+ (char *) menuID);
+
+ if (entryPtr != NULL) {
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+ if (menuID == currentAppleMenuID) {
+ currentAppleMenuID = 0;
+ }
+ if (menuID == currentHelpMenuID) {
+ currentHelpMenuID = 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpNewMenu --
+ *
+ * Gets a new blank menu. Only the platform specific options are filled
+ * in.
+ *
+ * Results:
+ * Returns a standard TCL error.
+ *
+ * Side effects:
+ * Allocates a Macintosh menu handle and puts in the platformData
+ * field of the menuPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpNewMenu(
+ TkMenu *menuPtr) /* The common structure we are making the
+ * platform structure for. */
+{
+ short menuID;
+ Str255 itemText;
+ int length;
+ MenuHandle macMenuHdl;
+ int error = TCL_OK;
+
+ error = GetNewID(menuPtr->interp, menuPtr, 0, &menuID);
+ if (error != TCL_OK) {
+ return error;
+ }
+ 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);
+
+ if ((currentMenuBarInterp == menuPtr->interp)
+ && (currentMenuBarName != NULL)) {
+ Tk_Window parentWin = Tk_Parent(menuPtr->tkwin);
+
+ if (strcmp(currentMenuBarName, Tk_PathName(parentWin)) == 0) {
+ if ((strcmp(Tk_PathName(menuPtr->tkwin)
+ + strlen(Tk_PathName(parentWin)), ".apple") == 0)
+ || (strcmp(Tk_PathName(menuPtr->tkwin)
+ + strlen(Tk_PathName(parentWin)), ".help") == 0)) {
+ if (!(menuBarFlags & MENUBAR_REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DrawMenuBarWhenIdle, (ClientData *) NULL);
+ menuBarFlags |= MENUBAR_REDRAW_PENDING;
+ }
+ }
+ }
+ }
+
+ menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
+ Tcl_DoWhenIdle(ReconfigureMacintoshMenu, (ClientData) menuPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyMenu --
+ *
+ * Destroys platform-specific menu structures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All platform-specific allocations are freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyMenu(
+ TkMenu *menuPtr) /* The common menu structure */
+{
+ MenuHandle macMenuHdl = ((MacMenu *) menuPtr->platformData)->menuHdl;
+
+ if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
+ Tcl_CancelIdleCall(ReconfigureMacintoshMenu, (ClientData) menuPtr);
+ menuPtr->menuFlags &= ~MENU_RECONFIGURE_PENDING;
+ }
+
+ if ((*macMenuHdl)->menuID == currentHelpMenuID) {
+ MenuHandle helpMenuHdl;
+
+ if ((HMGetHelpMenuHandle(&helpMenuHdl) == noErr)
+ && (helpMenuHdl != NULL)) {
+ int i, count = CountMItems(helpMenuHdl);
+
+ for (i = helpItemCount; i <= count; i++) {
+ DeleteMenuItem(helpMenuHdl, helpItemCount);
+ }
+ }
+ currentHelpMenuID = 0;
+ }
+
+ if (menuPtr->platformData != NULL) {
+ DeleteMenu((*macMenuHdl)->menuID);
+ FreeID((*macMenuHdl)->menuID);
+ DisposeMenu(macMenuHdl);
+ ckfree((char *) menuPtr->platformData);
+ menuPtr->platformData = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetMenuCascade --
+ *
+ * Does any cleanup to change a menu from a normal to a cascade.
+ *
+ * Results:
+ * Standard Tcl error.
+ *
+ * Side effects:
+ * The mac menu id is reset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SetMenuCascade(
+ TkMenu* menuPtr) /* The menu we are setting up to be a
+ * cascade. */
+{
+ MenuHandle macMenuHdl = ((MacMenu *) menuPtr->platformData)->menuHdl;
+ short newMenuID, menuID = (*macMenuHdl)->menuID;
+ int error = TCL_OK;
+
+ if (menuID >= 256) {
+ error = GetNewID(menuPtr->interp, menuPtr, 1, &newMenuID);
+ if (error == TCL_OK) {
+ FreeID(menuID);
+ (*macMenuHdl)->menuID = newMenuID;
+ }
+ }
+ return error;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyMenuEntry --
+ *
+ * Cleans up platform-specific menu entry items.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * All platform-specific allocations are freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyMenuEntry(
+ TkMenuEntry *mePtr) /* The common structure for the menu
+ * entry. */
+{
+ TkMenu *menuPtr = mePtr->menuPtr;
+
+ ckfree((char *) mePtr->platformEntryData);
+ if ((menuPtr->platformData != NULL)
+ && !(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) {
+ menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
+ Tcl_DoWhenIdle(ReconfigureMacintoshMenu, (ClientData) menuPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetMenuIndicator --
+ *
+ * Sets the Macintosh mark character based on the font of the
+ * item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * New item is added to platform menu
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SetMenuIndicator(
+ TkMenuEntry *mePtr) /* The entry we are setting */
+{
+ TkMenu *menuPtr = mePtr->menuPtr;
+ MenuHandle macMenuHdl = ((MacMenu *) menuPtr->platformData)->menuHdl;
+ char markChar;
+
+ /*
+ * There can be no indicators on menus that are not checkbuttons
+ * or radiobuttons. However, we should go ahead and set them
+ * so that menus look right when they are displayed. We should
+ * not set cascade entries, however, as the mark character
+ * means something different for cascade items on the Mac.
+ * 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetMenuTitle --
+ *
+ * Sets title of menu so that the text displays correctly in menubar.
+ * This code directly manipulates menu handle data. This code
+ * was originally part of an ancient Apple Developer Response mail.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The menu handle will change size depending on the length of the
+ * title
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+ dataLength = oldHandleSize - (sizeof(MenuInfo) - sizeof(Str255))
+ - oldLength;
+ if (newLength > oldLength) {
+ SetHandleSize((Handle) menuHdl, oldHandleSize + (newLength
+ - oldLength));
+ menuDataPtr = (Ptr) (*menuHdl)->menuData;
+ }
+
+ BlockMove(menuDataPtr + oldLength, menuDataPtr + newLength,
+ dataLength);
+ BlockMove(title, menuDataPtr + 1, newLength - 1);
+ menuDataPtr[0] = newLength - 1;
+
+ if (newLength < oldLength) {
+ SetHandleSize((Handle) menuHdl, oldHandleSize + (newLength
+ - oldLength));
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpConfigureMenuEntry(
+ register TkMenuEntry *mePtr) /* Information about menu entry; may
+ * or may not already have values for
+ * some fields. */
+{
+ TkMenu *menuPtr = mePtr->menuPtr;
+ int index = mePtr->index;
+ MenuHandle macMenuHdl = ((MacMenu *) menuPtr->platformData)->menuHdl;
+ MenuHandle helpMenuHdl = NULL;
+
+ /*
+ * Cascade menus have to have menu IDs of less than 256. So
+ * we need to change the child menu if this has been configured
+ * for a cascade item.
+ */
+
+ if (mePtr->type == CASCADE_ENTRY) {
+ if ((mePtr->childMenuRefPtr != NULL)
+ && (mePtr->childMenuRefPtr->menuPtr != NULL)) {
+ MenuHandle childMenuHdl = ((MacMenu *) mePtr
+ ->childMenuRefPtr->menuPtr->platformData)->menuHdl;
+
+ if (childMenuHdl != NULL) {
+ 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;
+ } else if ((0 == strncasecmp("Ctrl", accelString, 4))
+ && (('-' == accelString[4]) || ('+' == accelString[4]))) {
+ mePtr->entryFlags |= ENTRY_CONTROL_ACCEL;
+ accelString += 5;
+ } else if ((0 == strncasecmp("Shift", accelString, 5))
+ && (('-' == accelString[5]) || ('+' == accelString[5]))) {
+ mePtr->entryFlags |= ENTRY_SHIFT_ACCEL;
+ accelString += 6;
+ } else if ((0 == strncasecmp("Option", accelString, 6))
+ && (('-' == accelString[6]) || ('+' == accelString[6]))) {
+ mePtr->entryFlags |= ENTRY_OPTION_ACCEL;
+ accelString += 7;
+ } else if ((0 == strncasecmp("Opt", accelString, 3))
+ && (('-' == accelString[3]) || ('+' == accelString[3]))) {
+ mePtr->entryFlags |= ENTRY_OPTION_ACCEL;
+ accelString += 4;
+ } else if ((0 == strncasecmp("Command", accelString, 7))
+ && (('-' == accelString[7]) || ('+' == accelString[7]))) {
+ mePtr->entryFlags |= ENTRY_COMMAND_ACCEL;
+ accelString += 8;
+ } else if ((0 == strncasecmp("Cmd", accelString, 3))
+ && (('-' == accelString[3]) || ('+' == accelString[3]))) {
+ mePtr->entryFlags |= ENTRY_COMMAND_ACCEL;
+ accelString += 4;
+ } else if ((0 == strncasecmp("Alt", accelString, 3))
+ && (('-' == accelString[3]) || ('+' == accelString[3]))) {
+ mePtr->entryFlags |= ENTRY_OPTION_ACCEL;
+ accelString += 4;
+ } else if ((0 == strncasecmp("Meta", accelString, 4))
+ && (('-' == accelString[4]) || ('+' == accelString[4]))) {
+ mePtr->entryFlags |= ENTRY_COMMAND_ACCEL;
+ 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);
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReconfigureIndividualMenu --
+ *
+ * This routine redoes the guts of the menu. It works from
+ * a base item and offset, so that a regular menu will
+ * just have all of its items added, but the help menu will
+ * have all of its items appended after the apple-defined
+ * items.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The Macintosh menu handle is updated
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReconfigureIndividualMenu(
+ TkMenu *menuPtr, /* The menu we are affecting. */
+ MenuHandle macMenuHdl, /* The macintosh menu we are affecting.
+ * Will not necessarily be
+ * menuPtr->platformData because this could
+ * be the help menu. */
+ int base) /* The last index that we do not want
+ * touched. 0 for normal menus;
+ * 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;
+ }
+ }
+
+ /*
+ * First, we get rid of all of the old items.
+ */
+
+ count = CountMItems(macMenuHdl);
+ for (index = base; index < count; index++) {
+ DeleteMenuItem(macMenuHdl, base + 1);
+ }
+
+ count = menuPtr->numEntries;
+
+ for (index = 1; index <= count; index++) {
+ mePtr = menuPtr->entries[index - 1];
+
+ /*
+ * 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) {
+ 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))) {
+ SetItemCmd(macMenuHdl, index, mePtr
+ ->accel[((EntryGeometry *)mePtr->platformEntryData)
+ ->accelTextStart]);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReconfigureMacintoshMenu --
+ *
+ * Rebuilds the Macintosh MenuHandle items from the menu. Called
+ * usually as an idle handler, but can be called synchronously
+ * if the menu is about to be posted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Configuration information get set for mePtr; old resources
+ * get freed, if any need it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReconfigureMacintoshMenu(
+ ClientData clientData) /* Information about menu entry; may
+ * or may not already have values for
+ * some fields. */
+{
+ TkMenu *menuPtr = (TkMenu *) clientData;
+ MenuHandle macMenuHdl = ((MacMenu *) menuPtr->platformData)->menuHdl;
+ MenuHandle helpMenuHdl = NULL;
+
+ menuPtr->menuFlags &= ~MENU_RECONFIGURE_PENDING;
+
+ if (NULL == macMenuHdl) {
+ return;
+ }
+
+ ReconfigureIndividualMenu(menuPtr, macMenuHdl, 0);
+
+ if (menuPtr->menuFlags & MENU_APPLE_MENU) {
+ AddResMenu(macMenuHdl, 'DRVR');
+ }
+
+ if ((*macMenuHdl)->menuID == currentHelpMenuID) {
+ HMGetHelpMenuHandle(&helpMenuHdl);
+ if (helpMenuHdl != NULL) {
+ ReconfigureIndividualMenu(menuPtr, helpMenuHdl, helpItemCount);
+ }
+ }
+
+ if (menuPtr->menuType == MENUBAR) {
+ if (!(menuBarFlags & MENUBAR_REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DrawMenuBarWhenIdle, (ClientData *) NULL);
+ menuBarFlags |= MENUBAR_REDRAW_PENDING;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CompleteIdlers --
+ *
+ * Completes all idle handling so that the menus are in sync when
+ * the user invokes them with the mouse.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The Macintosh menu handles are flushed out.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CompleteIdlers(
+ TkMenu *menuPtr) /* The menu we are completing. */
+{
+ int i;
+
+ if (menuPtr->menuFlags & MENU_RECONFIGURE_PENDING) {
+ Tcl_CancelIdleCall(ReconfigureMacintoshMenu, (ClientData) menuPtr);
+ ReconfigureMacintoshMenu((ClientData) menuPtr);
+ }
+
+ 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)) {
+ CompleteIdlers(menuPtr->entries[i]->childMenuRefPtr
+ ->menuPtr);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpPostMenu --
+ *
+ * Posts a menu on the screen
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The menu is posted and handled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpPostMenu(
+ Tcl_Interp *interp, /* The interpreter this menu lives in */
+ TkMenu *menuPtr, /* The menu we are posting */
+ int x, /* The global x-coordinate of the top, left-
+ * hand corner of where the menu is supposed
+ * to be posted. */
+ int y) /* The global y-coordinate */
+{
+ MenuHandle macMenuHdl = ((MacMenu *) menuPtr->platformData)->menuHdl;
+ long popUpResult;
+ int result;
+ int oldMode;
+
+ if (inPostMenu) {
+ Tcl_AppendResult(interp,
+ "Cannot call post menu while already posting menu",
+ (char *) NULL);
+ result = TCL_ERROR;
+ } else {
+ Window dummyWin;
+ unsigned int state;
+ int dummy, mouseX, mouseY;
+ short menuID;
+ Window window;
+ int oldWidth = menuPtr->totalWidth;
+ Tk_Window parentWindow = Tk_Parent(menuPtr->tkwin);
+
+ inPostMenu++;
+
+ 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;
+ }
+
+ CompleteIdlers(menuPtr);
+ if (menuBarFlags & MENUBAR_REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DrawMenuBarWhenIdle, (ClientData *) NULL);
+ DrawMenuBarWhenIdle((ClientData *) NULL);
+ }
+
+ if (NULL == parentWindow) {
+ tearoffStruct.excludeRect.top = tearoffStruct.excludeRect.left
+ = tearoffStruct.excludeRect.bottom
+ = tearoffStruct.excludeRect.right = SHRT_MAX;
+ } else {
+ int left, top;
+
+ Tk_GetRootCoords(parentWindow, &left, &top);
+ tearoffStruct.excludeRect.left = left;
+ tearoffStruct.excludeRect.top = top;
+ tearoffStruct.excludeRect.right = left + Tk_Width(parentWindow);
+ tearoffStruct.excludeRect.bottom = top + Tk_Height(parentWindow);
+ if (Tk_Class(parentWindow) == Tk_GetUid("Menubutton")) {
+ TkWindow *parentWinPtr = (TkWindow *) parentWindow;
+ TkMenuButton *mbPtr =
+ (TkMenuButton *) parentWinPtr->instanceData;
+ int menuButtonWidth = Tk_Width(parentWindow)
+ - 2 * (mbPtr->highlightWidth + mbPtr->borderWidth + 1);
+ menuPtr->totalWidth = menuButtonWidth > menuPtr->totalWidth
+ ? menuButtonWidth : menuPtr->totalWidth;
+ }
+ }
+
+ InsertMenu(macMenuHdl, -1);
+ RecursivelyInsertMenu(menuPtr);
+ CountMItems(macMenuHdl);
+
+ FixMDEF();
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ popUpResult = PopUpMenuSelect(macMenuHdl, y, x, menuPtr->active);
+ Tcl_SetServiceMode(oldMode);
+
+ menuPtr->totalWidth = oldWidth;
+ RecursivelyDeleteMenu(menuPtr);
+ DeleteMenu((*macMenuHdl)->menuID);
+
+ /*
+ * Simulate the mouse up.
+ */
+
+ XQueryPointer(NULL, None, &dummyWin, &dummyWin, &mouseX,
+ &mouseY, &dummy, &dummy, &state);
+ window = Tk_WindowId(menuPtr->tkwin);
+ TkGenerateButtonEvent(mouseX, mouseY, window, state);
+
+ /*
+ * Dispatch the command.
+ */
+
+ menuID = HiWord(popUpResult);
+ if (menuID != 0) {
+ result = TkMacDispatchMenuEvent(menuID, LoWord(popUpResult));
+ } else {
+ TkMacHandleTearoffMenu();
+ result = TCL_OK;
+ }
+ InvalidateMDEFRgns();
+ RecursivelyClearActiveMenu(menuPtr);
+
+ inPostMenu--;
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuNewEntry --
+ *
+ * Adds a pointer to a new menu entry structure with the platform-
+ * specific fields filled in. The Macintosh uses the
+ * platformEntryData field of the TkMenuEntry record to store
+ * geometry information.
+ *
+ * Results:
+ * Standard TCL error.
+ *
+ * Side effects:
+ * Storage gets allocated. New menu entry data is put into the
+ * platformEntryData field of the mePtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpMenuNewEntry(
+ TkMenuEntry *mePtr) /* The menu we are adding an entry to */
+{
+ EntryGeometry *geometryPtr =
+ (EntryGeometry *) ckalloc(sizeof(EntryGeometry));
+ TkMenu *menuPtr = mePtr->menuPtr;
+
+ geometryPtr->accelTextStart = 0;
+ geometryPtr->accelTextWidth = 0;
+ geometryPtr->nonAccelMargin = 0;
+ geometryPtr->modifierWidth = 0;
+ mePtr->platformEntryData = (TkMenuPlatformEntryData) geometryPtr;
+ if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) {
+ menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
+ Tcl_DoWhenIdle(ReconfigureMacintoshMenu, (ClientData) menuPtr);
+ }
+ 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.
+ *
+ * Side effects:
+ * Menu bar is redrawn.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+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,
+ (char *) currentAppleMenuID);
+ appleMenuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
+ TkpDestroyMenu(appleMenuPtr);
+ TkpNewMenu(appleMenuPtr);
+ appleMenuPtr->menuFlags &= ~MENU_APPLE_MENU;
+ appleMenuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
+ Tcl_DoWhenIdle(ReconfigureMacintoshMenu,
+ (ClientData) appleMenuPtr);
+ }
+
+ if (currentHelpMenuID != 0) {
+ hashEntryPtr = Tcl_FindHashEntry(&commandTable,
+ (char *) currentHelpMenuID);
+ helpMenuPtr = (TkMenu *) Tcl_GetHashValue(hashEntryPtr);
+ TkpDestroyMenu(helpMenuPtr);
+ TkpNewMenu(helpMenuPtr);
+ helpMenuPtr->menuFlags &= ~MENU_HELP_MENU;
+ helpMenuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
+ Tcl_DoWhenIdle(ReconfigureMacintoshMenu,
+ (ClientData) helpMenuPtr);
+ }
+
+ /*
+ * We need to find the clone of this menu that is the menubar.
+ * Once we do that, for every cascade in the menu, we need to
+ * insert the Mac menu in the Mac menubar. Finally, we need
+ * to redraw the menubar.
+ */
+
+ menuRefPtr = NULL;
+ if (currentMenuBarName != NULL) {
+ menuRefPtr = TkFindMenuReferences(currentMenuBarInterp,
+ currentMenuBarName);
+ }
+ if (menuRefPtr != NULL) {
+ TkMenu *menuPtr, *menuBarPtr;
+ TkMenu *cascadeMenuPtr;
+ char *appleMenuName, *helpMenuName;
+ int appleIndex = -1, helpIndex = -1;
+ int i;
+
+ menuPtr = menuRefPtr->menuPtr;
+ if (menuPtr != NULL) {
+ TkMenuReferences *specialMenuRefPtr;
+ TkMenuEntry *specialEntryPtr;
+
+ appleMenuName = ckalloc(strlen(currentMenuBarName)
+ + 1 + strlen(".apple") + 1);
+ sprintf(appleMenuName, "%s.apple",
+ Tk_PathName(menuPtr->tkwin));
+ specialMenuRefPtr = TkFindMenuReferences(currentMenuBarInterp,
+ appleMenuName);
+ if ((specialMenuRefPtr != NULL)
+ && (specialMenuRefPtr->menuPtr != NULL)) {
+ for (specialEntryPtr
+ = specialMenuRefPtr->parentEntryPtr;
+ specialEntryPtr != NULL;
+ specialEntryPtr
+ = specialEntryPtr->nextCascadePtr) {
+ if (specialEntryPtr->menuPtr == menuPtr) {
+ appleIndex = specialEntryPtr->index;
+ break;
+ }
+ }
+ }
+ ckfree(appleMenuName);
+
+ helpMenuName = ckalloc(strlen(currentMenuBarName)
+ + 1 + strlen(".help") + 1);
+ sprintf(helpMenuName, "%s.help",
+ Tk_PathName(menuPtr->tkwin));
+ specialMenuRefPtr = TkFindMenuReferences(currentMenuBarInterp,
+ helpMenuName);
+ if ((specialMenuRefPtr != NULL)
+ && (specialMenuRefPtr->menuPtr != NULL)) {
+ for (specialEntryPtr
+ = specialMenuRefPtr->parentEntryPtr;
+ specialEntryPtr != NULL;
+ specialEntryPtr
+ = specialEntryPtr->nextCascadePtr) {
+ if (specialEntryPtr->menuPtr == menuPtr) {
+ helpIndex = specialEntryPtr->index;
+ break;
+ }
+ }
+ }
+ ckfree(helpMenuName);
+
+ }
+
+ for (menuBarPtr = menuPtr;
+ (menuBarPtr != NULL)
+ && (menuBarPtr->menuType != MENUBAR);
+ menuBarPtr = menuBarPtr->nextInstancePtr) {
+
+ /*
+ * 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;
+ helpIndex = (-1 == helpIndex) ? helpIndex
+ : helpIndex - 1;
+ }
+ }
+ ClearMenuBar();
+
+ if (appleIndex == -1) {
+ InsertMenu(tkAppleMenu, 0);
+ currentAppleMenuID = 0;
+ } else {
+ short appleID;
+ appleMenuPtr = menuBarPtr->entries[appleIndex]
+ ->childMenuRefPtr->menuPtr;
+ TkpDestroyMenu(appleMenuPtr);
+ GetNewID(appleMenuPtr->interp, appleMenuPtr, 0,
+ &appleID);
+ macMenuHdl = NewMenu(appleID, "\p\024");
+ appleMenuPtr->platformData =
+ (TkMenuPlatformData) ckalloc(sizeof(MacMenu));
+ ((MacMenu *)appleMenuPtr->platformData)->menuHdl
+ = macMenuHdl;
+ SetRect(&((MacMenu *) appleMenuPtr->platformData)->menuRect,
+ 0, 0, 0, 0);
+ appleMenuPtr->menuFlags |= MENU_APPLE_MENU;
+ if (!(appleMenuPtr->menuFlags
+ & MENU_RECONFIGURE_PENDING)) {
+ appleMenuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
+ Tcl_DoWhenIdle(ReconfigureMacintoshMenu,
+ (ClientData) appleMenuPtr);
+ }
+ InsertMenu(macMenuHdl, 0);
+ RecursivelyInsertMenu(appleMenuPtr);
+ currentAppleMenuID = appleID;
+ }
+ 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
+ ->platformData)->menuHdl,
+ 0);
+ }
+ continue;
+ } else if (i == helpIndex) {
+ TkMenu *helpMenuPtr = menuBarPtr->entries[i]
+ ->childMenuRefPtr->menuPtr;
+ MenuHandle helpMenuHdl = NULL;
+
+ if (helpMenuPtr == NULL) {
+ continue;
+ }
+ helpMenuPtr->menuFlags |= MENU_HELP_MENU;
+ if (!(helpMenuPtr->menuFlags
+ & MENU_RECONFIGURE_PENDING)) {
+ helpMenuPtr->menuFlags
+ |= MENU_RECONFIGURE_PENDING;
+ Tcl_DoWhenIdle(ReconfigureMacintoshMenu,
+ (ClientData) helpMenuPtr);
+ }
+ macMenuHdl =
+ ((MacMenu *) helpMenuPtr->platformData)->menuHdl;
+ currentHelpMenuID = (*macMenuHdl)->menuID;
+ } else if (menuBarPtr->entries[i]->type
+ == CASCADE_ENTRY) {
+ if ((menuBarPtr->entries[i]->childMenuRefPtr != NULL)
+ && menuBarPtr->entries[i]->childMenuRefPtr
+ ->menuPtr != NULL) {
+ 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
+ ->platformData)->menuHdl,
+ 0);
+ }
+ }
+ }
+ }
+ }
+ } else {
+ SetDefaultMenubar();
+ }
+ DrawMenuBar();
+ menuBarFlags &= ~MENUBAR_REDRAW_PENDING;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecursivelyInsertMenu --
+ *
+ * Puts all of the cascades of this menu in the Mac hierarchical list.
+ *
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The menubar is changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RecursivelyInsertMenu(
+ TkMenu *menuPtr) /* All of the cascade items in this menu
+ * will be inserted into the mac menubar. */
+{
+ int i;
+ TkMenu *cascadeMenuPtr;
+ MenuHandle macMenuHdl;
+
+ 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);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecursivelyDeleteMenu --
+ *
+ * Takes all of the cascades of this menu out of the Mac hierarchical
+ * list.
+ *
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The menubar is changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RecursivelyDeleteMenu(
+ TkMenu *menuPtr) /* All of the cascade items in this menu
+ * will be inserted into the mac menubar. */
+{
+ int i;
+ TkMenu *cascadeMenuPtr;
+ MenuHandle macMenuHdl;
+
+ 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);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetDefaultMenubar --
+ *
+ * Puts the Apple, File and Edit menus into the Macintosh menubar.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The menubar is changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SetDefaultMenubar()
+{
+ if (currentMenuBarName != NULL) {
+ ckfree(currentMenuBarName);
+ currentMenuBarName = NULL;
+ }
+ currentMenuBarOwner = NULL;
+ ClearMenuBar();
+ InsertMenu(tkAppleMenu, 0);
+ InsertMenu(tkFileMenu, 0);
+ InsertMenu(tkEditMenu, 0);
+ if (!(menuBarFlags & MENUBAR_REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DrawMenuBarWhenIdle, (ClientData *) NULL);
+ menuBarFlags |= MENUBAR_REDRAW_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpSetMainMenubar --
+ *
+ * Puts the menu associated with a window into the menubar. Should
+ * only be called when the window is in front.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The menubar is changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpSetMainMenubar(
+ Tcl_Interp *interp, /* The interpreter of the application */
+ Tk_Window tkwin, /* The frame we are setting up */
+ char *menuName) /* The name of the menu to put in front.
+ * If NULL, use the default menu bar.
+ */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ WindowRef macWindowPtr = (WindowRef) TkMacGetDrawablePort(winPtr->window);
+
+ if ((macWindowPtr == NULL) || (macWindowPtr != FrontWindow())) {
+ return;
+ }
+
+ if ((currentMenuBarInterp != interp)
+ || (currentMenuBarOwner != tkwin)
+ || (currentMenuBarName == NULL)
+ || (menuName == NULL)
+ || (strcmp(menuName, currentMenuBarName) != 0)) {
+ Tk_Window searchWindow;
+ TopLevelMenubarList *listPtr;
+
+ if (currentMenuBarName != NULL) {
+ ckfree(currentMenuBarName);
+ }
+
+ if (menuName == NULL) {
+ searchWindow = tkwin;
+ if (strcmp(Tk_Class(searchWindow), "Menu") == 0) {
+ TkMenuReferences *menuRefPtr;
+
+ menuRefPtr = TkFindMenuReferences(interp, Tk_PathName(tkwin));
+ if (menuRefPtr != NULL) {
+ TkMenu *menuPtr = menuRefPtr->menuPtr;
+ if (menuPtr != NULL) {
+ menuPtr = menuPtr->masterMenuPtr;
+ searchWindow = menuPtr->tkwin;
+ }
+ }
+ }
+ for (; searchWindow != NULL;
+ searchWindow = Tk_Parent(searchWindow)) {
+
+ 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;
+ } else {
+ currentMenuBarName = ckalloc(strlen(menuName) + 1);
+ strcpy(currentMenuBarName, menuName);
+ }
+ currentMenuBarOwner = tkwin;
+ currentMenuBarInterp = interp;
+ }
+ if (!(menuBarFlags & MENUBAR_REDRAW_PENDING)) {
+ Tcl_DoWhenIdle(DrawMenuBarWhenIdle, (ClientData *) NULL);
+ menuBarFlags |= MENUBAR_REDRAW_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpSetWindowMenuBar --
+ *
+ * Associates a given menu with a window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * On Windows and UNIX, associates the platform menu with the
+ * platform window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpSetWindowMenuBar(
+ Tk_Window tkwin, /* The window we are setting the menu in */
+ TkMenu *menuPtr) /* The menu we are setting */
+{
+ TopLevelMenubarList *listPtr, *prevPtr;
+
+ /*
+ * Remove any existing reference to this window.
+ */
+
+ for (prevPtr = NULL, listPtr = windowListPtr;
+ listPtr != NULL;
+ prevPtr = listPtr, listPtr = listPtr->nextPtr) {
+ if (listPtr->tkwin == tkwin) {
+ break;
+ }
+ }
+
+ if (listPtr != NULL) {
+ if (prevPtr != NULL) {
+ prevPtr->nextPtr = listPtr->nextPtr;
+ } else {
+ windowListPtr = listPtr->nextPtr;
+ }
+ ckfree((char *) listPtr);
+ }
+
+ if (menuPtr != NULL) {
+ listPtr = (TopLevelMenubarList *) ckalloc(sizeof(TopLevelMenubarList));
+ listPtr->nextPtr = windowListPtr;
+ windowListPtr = listPtr;
+ listPtr->tkwin = tkwin;
+ listPtr->menuPtr = menuPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacDispatchMenuEvent --
+ *
+ * Given a menu id and an item, dispatches the command associated
+ * with it.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands get executed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkMacDispatchMenuEvent(
+ int menuID, /* The menu id of the menu we are invoking */
+ int index) /* The one-based index of the item that was
+ * selected. */
+{
+ int result = TCL_OK;
+ if (menuID != 0) {
+ if (menuID == kHMHelpMenuID) {
+ if (currentMenuBarOwner != NULL) {
+ TkMenuReferences *helpMenuRef;
+ char *helpMenuName = ckalloc(strlen(currentMenuBarName)
+ + strlen(".help") + 1);
+ sprintf(helpMenuName, "%s.help", currentMenuBarName);
+ helpMenuRef = TkFindMenuReferences(currentMenuBarInterp,
+ helpMenuName);
+ ckfree(helpMenuName);
+ if ((helpMenuRef != NULL) && (helpMenuRef->menuPtr != NULL)) {
+ int newIndex = index - helpItemCount - 1;
+ result = TkInvokeMenu(currentMenuBarInterp,
+ helpMenuRef->menuPtr, newIndex);
+ }
+ }
+ } else {
+ Tcl_HashEntry *commandEntryPtr =
+ Tcl_FindHashEntry(&commandTable, (char *) menuID);
+ TkMenu *menuPtr = (TkMenu *) Tcl_GetHashValue(commandEntryPtr);
+ if ((currentAppleMenuID == menuID)
+ && (index > menuPtr->numEntries + 1)) {
+ Str255 itemText;
+
+ GetMenuItemText(GetMenuHandle(menuID), index, itemText);
+ OpenDeskAcc(itemText);
+ result = TCL_OK;
+ } else {
+ result = TkInvokeMenu(menuPtr->interp, menuPtr, index - 1);
+ }
+ }
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMenuIndicatorGeometry --
+ *
+ * Gets the width and height of the indicator area of a menu.
+ *
+ * Results:
+ * widthPtr and heightPtr are set.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMenuIndicatorGeometry (
+ TkMenu *menuPtr, /* The menu we are drawing */
+ TkMenuEntry *mePtr, /* The entry we are measuring */
+ Tk_Font tkfont, /* Precalculated font */
+ CONST Tk_FontMetrics *fmPtr, /* Precalculated font metrics */
+ int *widthPtr, /* The resulting width */
+ int *heightPtr) /* The resulting height */
+{
+ char markChar;
+
+ *heightPtr = fmPtr->linespace;
+
+ markChar = (char) FindMarkCharacter(mePtr);
+ *widthPtr = Tk_TextWidth(tkfont, &markChar, 1) + 4;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMenuAccelGeometry --
+ *
+ * Gets the width and height of the accelerator area of a menu.
+ *
+ * Results:
+ * widthPtr and heightPtr are set.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMenuAccelGeometry (
+ TkMenu *menuPtr, /* The menu we are measuring */
+ TkMenuEntry *mePtr, /* The entry we are measuring */
+ Tk_Font tkfont, /* The precalculated font */
+ CONST Tk_FontMetrics *fmPtr, /* The precalculated font metrics */
+ int *modWidthPtr, /* The width of all of the key
+ * modifier symbols. */
+ int *textWidthPtr, /* The resulting width */
+ int *heightPtr) /* The resulting height */
+{
+ *heightPtr = fmPtr->linespace;
+ *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 {
+ int length = ((EntryGeometry *)mePtr->platformEntryData)
+ ->accelTextStart;
+ if (mePtr->entryFlags & ENTRY_CONTROL_ACCEL) {
+ *modWidthPtr += CONTROL_ICON_WIDTH;
+ }
+ if (mePtr->entryFlags & ENTRY_SHIFT_ACCEL) {
+ *modWidthPtr += SHIFT_ICON_WIDTH;
+ }
+ if (mePtr->entryFlags & ENTRY_OPTION_ACCEL) {
+ *modWidthPtr += OPTION_ICON_WIDTH;
+ }
+ 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);
+ }
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetTearoffEntryGeometry --
+ *
+ * Gets the width and height of of a tearoff entry.
+ *
+ * Results:
+ * widthPtr and heightPtr are set.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetTearoffEntryGeometry (
+ 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 precalculated font metrics */
+ int *widthPtr, /* The resulting width */
+ int *heightPtr) /* The resulting height */
+{
+ if ((GetResource('MDEF', 591) == NULL) &&
+ (menuPtr->menuType == MASTER_MENU)) {
+ *heightPtr = fmPtr->linespace;
+ *widthPtr = 0;
+ } else {
+ *widthPtr = *heightPtr = 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMenuSeparatorGeometry --
+ *
+ * Gets the width and height of menu separator.
+ *
+ * Results:
+ * widthPtr and heightPtr are set.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMenuSeparatorGeometry(
+ 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 --
+ *
+ * This procedure draws the indicator part of a menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawMenuEntryIndicator(
+ TkMenu *menuPtr, /* The menu we are drawing */
+ TkMenuEntry *mePtr, /* The entry we are drawing */
+ Drawable d, /* The drawable we are drawing */
+ GC gc, /* The GC we are drawing with */
+ GC indicatorGC, /* The GC to use for the indicator */
+ 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);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 --
+ *
+ * Given a resource id and an index, loads the appropriate SICN
+ * and draws it into a given drawable using the given gc.
+ *
+ * Results:
+ * Returns 1 if the SICN was found, 0 if not found.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+static int
+DrawSICN(
+ int resourceID, /* The resource # of the SICN table */
+ int index, /* The index into the SICN table of the
+ * icon we want. */
+ Drawable d, /* What we are drawing into */
+ GC gc, /* The GC to draw with */
+ int x, /* The left hand coord of the SICN */
+ int y) /* The top coord of the SICN */
+{
+ Handle sicnHandle = (Handle) GetResource('SICN', SICN_RESOURCE_NUMBER);
+
+ if (NULL == sicnHandle) {
+ return 0;
+ } else {
+ BitMap sicnBitmap;
+ Rect destRect;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+ BitMapPtr destBitMap;
+ RGBColor origForeColor, origBackColor, foreColor, backColor;
+
+ HLock(sicnHandle);
+ destPort = TkMacGetDrawablePort(d);
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+ TkMacSetUpClippingRgn(d);
+ TkMacSetUpGraphicsPort(gc);
+ GetForeColor(&origForeColor);
+ GetBackColor(&origBackColor);
+
+ if (TkSetMacColor(gc->foreground, &foreColor) == true) {
+ RGBForeColor(&foreColor);
+ }
+
+ if (TkSetMacColor(gc->background, &backColor) == true) {
+ RGBBackColor(&backColor);
+ }
+
+ SetRect(&destRect, x, y, x + SICN_HEIGHT, y + SICN_HEIGHT);
+ sicnBitmap.baseAddr = (Ptr) (*sicnHandle) + index * SICN_HEIGHT
+ * SICN_ROWS;
+ sicnBitmap.rowBytes = SICN_ROWS;
+ SetRect(&sicnBitmap.bounds, 0, 0, 16, 16);
+ destBitMap = &((GrafPtr) destPort)->portBits;
+ CopyBits(&sicnBitmap, destBitMap, &sicnBitmap.bounds, &destRect,
+ destPort->txMode, NULL);
+ HUnlock(sicnHandle);
+ RGBForeColor(&origForeColor);
+ RGBBackColor(&origBackColor);
+ SetGWorld(saveWorld, saveDevice);
+ return 1;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuEntryAccelerator --
+ *
+ * This procedure draws the accelerator part of a menu. We
+ * need to decide what to draw here. Should we replace strings
+ * like "Control", "Command", etc?
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawMenuEntryAccelerator(
+ TkMenu *menuPtr, /* The menu we are drawing */
+ TkMenuEntry *mePtr, /* The entry we are drawing */
+ Drawable d, /* The drawable we are drawing in */
+ GC gc, /* The gc to draw into */
+ Tk_Font tkfont, /* The precalculated font */
+ CONST Tk_FontMetrics *fmPtr, /* The precalculated font metrics */
+ 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) {
+ /*
+ * 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 - 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);
+ }
+
+ if (mePtr->entryFlags & ENTRY_OPTION_ACCEL) {
+ leftEdge -= OPTION_ICON_WIDTH;
+ DrawSICN(SICN_RESOURCE_NUMBER, OPTION_ICON, d, gc,
+ leftEdge, (y + (height / 2)) - (SICN_HEIGHT / 2) - 1);
+ }
+
+ if (mePtr->entryFlags & ENTRY_SHIFT_ACCEL) {
+ leftEdge -= SHIFT_ICON_WIDTH;
+ DrawSICN(SICN_RESOURCE_NUMBER, SHIFT_ICON, d, gc,
+ leftEdge, (y + (height / 2)) - (SICN_HEIGHT / 2) - 1);
+ }
+
+ if (mePtr->entryFlags & ENTRY_CONTROL_ACCEL) {
+ leftEdge -= CONTROL_ICON_WIDTH;
+ DrawSICN(SICN_RESOURCE_NUMBER, CONTROL_ICON, d, gc,
+ leftEdge, (y + (height / 2)) - (SICN_HEIGHT / 2) - 1);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuSeparator --
+ *
+ * The menu separator is drawn.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawMenuSeparator(
+ TkMenu *menuPtr, /* The menu we are drawing */
+ TkMenuEntry *mePtr, /* The entry we are drawing */
+ Drawable d, /* The drawable we are drawing into */
+ GC gc, /* The gc we are drawing with */
+ Tk_Font tkfont, /* The precalculated font */
+ CONST Tk_FontMetrics *fmPtr, /* The precalculated font metrics */
+ int x, /* left coordinate of entry */
+ int y, /* top coordinate of entry */
+ int width, /* width of entry */
+ int height) /* height of entry */
+{
+ CGrafPtr saveWorld;
+ 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 --
+ *
+ * This routine is the MDEF handler for Tk. It receives all messages
+ * for the menu and dispatches them.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * This routine causes menus to be drawn and will certainly allocate
+ * memory as a result. Also, the menu can scroll up and down, and
+ * various other interface actions can take place.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MenuDefProc(
+ short message, /* What action are we taking? */
+ MenuHandle menu, /* The menu we are working with */
+ Rect *menuRectPtr, /* A pointer to the rect for the
+ * whole menu. */
+ Point hitPt, /* Where the mouse was clicked for
+ * the appropriate messages. */
+ short *whichItem, /* Output result. Which item was
+ * hit by the user? */
+ TkMenuLowMemGlobals *globalsPtr) /* The low mem globals we have
+ * 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;
+ GDHandle device;
+ Rect itemRect;
+ short windowPart;
+ WindowRef whichWindow;
+ RGBColor bgColor;
+ RGBColor fgColor;
+ RGBColor origFgColor;
+ PenState origPenState;
+ Rect dragRect;
+ Rect scratchRect = {-32768, -32768, 32767, 32767};
+ RgnHandle oldClipRgn;
+ TkMenuReferences *menuRefPtr;
+ TkMenu *searchMenuPtr;
+ Rect menuClipRect;
+
+ HLock((Handle) menu);
+ commandEntryPtr = Tcl_FindHashEntry(&commandTable,
+ (char *) (*menu)->menuID);
+ HUnlock((Handle) menu);
+ menuPtr = (TkMenu *) Tcl_GetHashValue(commandEntryPtr);
+
+ switch (message) {
+ case mSizeMsg:
+ GetWMgrPort(&windowMgrPort);
+ maxMenuHeight = windowMgrPort->portRect.bottom
+ - windowMgrPort->portRect.top
+ - GetMBarHeight() - SCREEN_MARGIN;
+ (*menu)->menuWidth = menuPtr->totalWidth;
+ (*menu)->menuHeight = maxMenuHeight < menuPtr->totalHeight ?
+ maxMenuHeight : menuPtr->totalHeight;
+ break;
+
+ case mDrawMsg:
+
+ /*
+ * Store away the menu rectangle so we can keep track of the
+ * different regions that the menu obscures.
+ */
+
+ ((MacMenu *) menuPtr->platformData)->menuRect = *menuRectPtr;
+ if (tkMenuCascadeRgn == NULL) {
+ tkMenuCascadeRgn = NewRgn();
+ }
+ if (utilRgn == NULL) {
+ utilRgn = NewRgn();
+ }
+ if (totalMenuRgn == NULL) {
+ totalMenuRgn = NewRgn();
+ }
+ SetEmptyRgn(tkMenuCascadeRgn);
+ for (searchMenuPtr = menuPtr; searchMenuPtr != NULL; ) {
+ RectRgn(utilRgn,
+ &((MacMenu *) searchMenuPtr->platformData)->menuRect);
+ InsetRgn(utilRgn, -1, -1);
+ UnionRgn(tkMenuCascadeRgn, utilRgn, tkMenuCascadeRgn);
+ OffsetRgn(utilRgn, 1, 1);
+ UnionRgn(tkMenuCascadeRgn, utilRgn, tkMenuCascadeRgn);
+
+ if (searchMenuPtr->menuRefPtr->parentEntryPtr != NULL) {
+ searchMenuPtr = searchMenuPtr->menuRefPtr
+ ->parentEntryPtr->menuPtr;
+ } else {
+ break;
+ }
+ 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,
+ menuRectPtr->left
+ + menuPtr->entries[1]->indicatorSpace,
+ menuRectPtr->top);
+ menuClipRect.top += SICN_HEIGHT;
+ }
+ if ((globalsPtr->menuTop + menuPtr->totalHeight)
+ > menuRectPtr->bottom) {
+ DrawSICN(SICN_RESOURCE_NUMBER, DOWN_ARROW,
+ (Drawable) &macMDEFDrawable,
+ menuPtr->textGC,
+ menuRectPtr->left
+ + menuPtr->entries[1]->indicatorSpace,
+ menuRectPtr->bottom - SICN_HEIGHT);
+ menuClipRect.bottom -= SICN_HEIGHT;
+ }
+ GetClip(utilRgn);
+ }
+
+ /*
+ * 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;
+ }
+ 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);
+ }
+ MDEFScrollFlag = 1;
+ break;
+
+ case mChooseMsg: {
+ int hasTopScroll, hasBottomScroll;
+ enum {
+ DONT_SCROLL, DOWN_SCROLL, UP_SCROLL
+ } scrollDirection;
+ Rect updateRect;
+ short scrollAmt;
+ RGBColor origForeColor, origBackColor, foreColor, backColor;
+
+ 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.
+ */
+
+ oldItem = *whichItem - 1;
+
+ if (PtInRect(hitPt, menuRectPtr)) {
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ mePtr = menuPtr->entries[i];
+ itemRect.left = menuRectPtr->left + mePtr->x;
+ itemRect.top = globalsPtr->menuTop + mePtr->y;
+ if (mePtr->entryFlags & ENTRY_LAST_COLUMN) {
+ itemRect.right = itemRect.left + menuPtr->totalWidth
+ - mePtr->x;
+ } 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;
+ } else {
+ newItem = i;
+ if ((mePtr->type == CASCADE_ENTRY)
+ && (oldItem != newItem)) {
+ globalsPtr->itemRect = itemRect;
+ }
+ }
+ }
+ break;
+ }
+ }
+ }
+
+ /*
+ * Now we need to take care of scrolling the menu.
+ */
+
+ hasTopScroll = globalsPtr->menuTop < menuRectPtr->top;
+ hasBottomScroll = globalsPtr->menuBottom > menuRectPtr->bottom;
+ scrollDirection = DONT_SCROLL;
+ if (hasTopScroll
+ && (hitPt.v < menuRectPtr->top + SICN_HEIGHT)) {
+ newItem = -1;
+ scrollDirection = DOWN_SCROLL;
+ } else if (hasBottomScroll
+ && (hitPt.v > menuRectPtr->bottom - SICN_HEIGHT)) {
+ newItem = -1;
+ scrollDirection = UP_SCROLL;
+ }
+ menuClipRect = *menuRectPtr;
+ if (hasTopScroll) {
+ menuClipRect.top += SICN_HEIGHT;
+ }
+ if (hasBottomScroll) {
+ menuClipRect.bottom -= SICN_HEIGHT;
+ }
+ if (MDEFScrollFlag) {
+ scrollDirection = DONT_SCROLL;
+ MDEFScrollFlag = 0;
+ }
+ 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);
+ 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 != tkDisabledUid) {
+ TkActivateMenuEntry(menuPtr, newItem);
+ }
+ tkfont = mePtr->tkfont ? mePtr->tkfont : menuPtr->tkfont;
+ 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 != 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
+ + menuPtr->entries[1]->indicatorSpace,
+ menuRectPtr->top);
+ menuClipRect.top += SICN_HEIGHT;
+ }
+ } else if (scrollDirection == DOWN_SCROLL) {
+ scrollAmt = menuClipRect.top - hitPt.v;
+ if (scrollAmt > menuRectPtr->top - globalsPtr->menuTop) {
+ scrollAmt = menuRectPtr->top - globalsPtr->menuTop;
+ }
+ if (!hasBottomScroll && ((globalsPtr->menuBottom + scrollAmt)
+ > menuRectPtr->bottom)) {
+ SetRect(&updateRect, menuRectPtr->left,
+ globalsPtr->menuBottom - SICN_HEIGHT,
+ menuRectPtr->right, globalsPtr->menuBottom);
+ EraseRect(&updateRect);
+ DrawSICN(SICN_RESOURCE_NUMBER, DOWN_ARROW,
+ (Drawable) &macMDEFDrawable,
+ 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;
+ }
+ 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)) {
+ 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;
+ }
+
+ windowPart = FindWindow(hitPt, &whichWindow);
+ if ((windowPart != inMenuBar) && (newItem == -1)
+ && (hitPt.v != 0) && (hitPt.h != 0)
+ && (!PtInRect(hitPt, &scratchRect))
+ && (!PtInRect(hitPt, &tearoffStruct.excludeRect))) {
+/*
+ * This is the second argument to the Toolbox Delay function. It changed
+ * from long to unsigned long between Universal Headers 2.0 & 3.0
+ */
+#if !defined(UNIVERSAL_INTERFACES_VERSION) || (UNIVERSAL_INTERFACES_VERSION < 0x0300)
+ long dummy;
+#else
+ unsigned long dummy;
+#endif
+ oldClipRgn = NewRgn();
+ GetClip(oldClipRgn);
+ GetForeColor(&origFgColor);
+ GetPenState(&origPenState);
+ GetForeColor(&fgColor);
+ GetBackColor(&bgColor);
+ GetGray(device, &bgColor, &fgColor);
+ RGBForeColor(&fgColor);
+ SetRect(&scratchRect, -32768, -32768, 32767, 32767);
+ ClipRect(&scratchRect);
+
+ dragRect = *menuRectPtr;
+ tearoffStruct.menuPtr = menuPtr;
+
+ PenMode(srcXor);
+ dragRect = *menuRectPtr;
+ OffsetRect(&dragRect, -dragRect.left, -dragRect.top);
+ OffsetRect(&dragRect, tearoffStruct.point.h,
+ tearoffStruct.point.v);
+ if ((dragRect.top != 0) && (dragRect.left != 0)) {
+ FrameRect(&dragRect);
+ Delay(1, &dummy);
+ FrameRect(&dragRect);
+ }
+ tearoffStruct.point = hitPt;
+
+ SetClip(oldClipRgn);
+ DisposeRgn(oldClipRgn);
+ RGBForeColor(&origFgColor);
+ SetPenState(&origPenState);
+ } else {
+ tearoffStruct.menuPtr = NULL;
+ tearoffStruct.point.h = tearoffStruct.point.v = 0;
+ }
+ } else {
+ tearoffStruct.menuPtr = NULL;
+ tearoffStruct.point.h = tearoffStruct.point.v = 0;
+ }
+
+ break;
+ }
+
+ case mPopUpMsg:
+
+ /*
+ * Note that for some oddball reason, h and v are reversed in the
+ * point given to us by the MDEF.
+ */
+
+ oldItem = *whichItem;
+ if (oldItem >= menuPtr->numEntries) {
+ oldItem = -1;
+ }
+ GetWMgrPort(&windowMgrPort);
+ maxMenuHeight = windowMgrPort->portRect.bottom
+ - windowMgrPort->portRect.top
+ - GetMBarHeight() - SCREEN_MARGIN;
+ if (menuPtr->totalHeight > maxMenuHeight) {
+ menuRectPtr->top = GetMBarHeight();
+ } else {
+ menuRectPtr->top = hitPt.h;
+ if (oldItem >= 0) {
+ menuRectPtr->top -= menuPtr->entries[oldItem]->y;
+ }
+ if (menuRectPtr->top + menuPtr->totalHeight > maxMenuHeight) {
+ menuRectPtr->top -= maxMenuHeight - menuPtr->totalHeight;
+ }
+ }
+ menuRectPtr->left = hitPt.v;
+ menuRectPtr->right = menuRectPtr->left + menuPtr->totalWidth;
+ menuRectPtr->bottom = menuRectPtr->top +
+ ((maxMenuHeight < menuPtr->totalHeight)
+ ? maxMenuHeight : menuPtr->totalHeight);
+ if (menuRectPtr->top == GetMBarHeight()) {
+ *whichItem = hitPt.h;
+ } else {
+ *whichItem = menuRectPtr->top;
+ }
+ 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 == tkActiveUid) {
+ theState = kThemeMenuSelected;
+ } else if (mePtr->state == tkDisabledUid) {
+ 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[20];
+ short windowPart;
+ WindowRef whichWindow;
+
+ windowPart = FindWindow(tearoffStruct.point, &whichWindow);
+
+ if (windowPart != inMenuBar) {
+ Tcl_DStringInit(&tearoffCmdStr);
+ Tcl_DStringAppendElement(&tearoffCmdStr, "tkTearOffMenu");
+ Tcl_DStringAppendElement(&tearoffCmdStr,
+ Tk_PathName(tearoffStruct.menuPtr->tkwin));
+ sprintf(intString, "%d", tearoffStruct.point.h);
+ Tcl_DStringAppendElement(&tearoffCmdStr, intString);
+ sprintf(intString, "%d", tearoffStruct.point.v);
+ Tcl_DStringAppendElement(&tearoffCmdStr, intString);
+ Tcl_Eval(tearoffStruct.menuPtr->interp,
+ Tcl_DStringValue(&tearoffCmdStr));
+ Tcl_DStringFree(&tearoffCmdStr);
+ tearoffStruct.menuPtr = NULL;
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpInitializeMenuBindings --
+ *
+ * For every interp, initializes the bindings for Windows
+ * menus. Does nothing on Mac or XWindows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * C-level bindings are setup for the interp which will
+ * handle Alt-key sequences for menus without beeping
+ * or interfering with user-defined Alt-key bindings.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpInitializeMenuBindings(interp, bindingTable)
+ Tcl_Interp *interp; /* The interpreter to set. */
+ Tk_BindingTable bindingTable; /* The table to add to. */
+{
+ /*
+ * Nothing to do.
+ */
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpComputeMenubarGeometry --
+ *
+ * This procedure is invoked to recompute the size and
+ * layout of a menu that is a menubar clone.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Fields of menu entries are changed to reflect their
+ * current positions, and the size of the menu window
+ * itself may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpComputeMenubarGeometry(menuPtr)
+ TkMenu *menuPtr; /* Structure describing menu. */
+{
+ TkpComputeStandardMenuGeometry(menuPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawTearoffEntry --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+DrawTearoffEntry(
+ TkMenu *menuPtr, /* The menu we are drawing */
+ TkMenuEntry *mePtr, /* The entry we are drawing */
+ Drawable d, /* The drawable we are drawing into */
+ GC gc, /* The gc we are drawing with */
+ Tk_Font tkfont, /* The font we are drawing with */
+ CONST Tk_FontMetrics *fmPtr, /* The metrics we are drawing with */
+ 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) || (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;
+
+ 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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacSetHelpMenuItemCount --
+ *
+ * Has to be called after the first call to InsertMenu. Sets
+ * up the global variable for the number of items in the
+ * unmodified help menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets the global helpItemCount.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacSetHelpMenuItemCount()
+{
+ MenuHandle helpMenuHandle;
+
+ if ((HMGetHelpMenuHandle(&helpMenuHandle) != noErr)
+ || (helpMenuHandle == NULL)) {
+ helpItemCount = -1;
+ } else {
+ helpItemCount = CountMItems(helpMenuHandle);
+ DeleteMenuItem(helpMenuHandle, helpItemCount);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacMenuClick --
+ *
+ * Prepares a menubar for MenuSelect or MenuKey.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Any pending configurations of the menubar are completed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacMenuClick()
+{
+ TkMenu *menuPtr;
+ TkMenuReferences *menuRefPtr;
+
+ if ((currentMenuBarInterp != NULL) && (currentMenuBarName != NULL)) {
+ menuRefPtr = TkFindMenuReferences(currentMenuBarInterp,
+ currentMenuBarName);
+ for (menuPtr = menuRefPtr->menuPtr->masterMenuPtr;
+ menuPtr != NULL; menuPtr = menuPtr->nextInstancePtr) {
+ if (menuPtr->menuType == MENUBAR) {
+ CompleteIdlers(menuPtr);
+ break;
+ }
+ }
+ }
+
+ if (menuBarFlags & MENUBAR_REDRAW_PENDING) {
+ Tcl_CancelIdleCall(DrawMenuBarWhenIdle, (ClientData *) NULL);
+ DrawMenuBarWhenIdle((ClientData *) NULL);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDrawMenuEntry --
+ *
+ * Draws the given menu entry at the given coordinates with the
+ * given attributes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * X Server commands are executed to display the menu entry.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDrawMenuEntry(
+ TkMenuEntry *mePtr, /* The entry to draw */
+ Drawable d, /* What to draw into */
+ Tk_Font tkfont, /* Precalculated font for menu */
+ CONST Tk_FontMetrics *menuMetricsPtr,
+ /* Precalculated metrics for menu */
+ int x, /* X-coordinate of topleft of entry */
+ int y, /* Y-coordinate of topleft of entry */
+ int width, /* Width of the entry rectangle */
+ int height, /* Height of the current rectangle */
+ int strictMotif, /* Boolean flag */
+ int drawArrow) /* Whether or not to draw the cascade
+ * arrow for cascade items. Only applies
+ * to Windows. */
+{
+ GC gc, indicatorGC;
+ 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.
+ * Under Appearance, we pass a null (appearanceGC) to tell
+ * ourselves not to change whatever color the appearance manager has set.
+ */
+
+ if ((mePtr->state == tkActiveUid)
+ && !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) {
+ 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) {
+ 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 = 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
+ * into account the padding.
+ */
+
+ DrawMenuEntryBackground(menuPtr, mePtr, d, activeBorder,
+ bgBorder, x, y, width, height);
+
+ if (mePtr->type == SEPARATOR_ENTRY) {
+ DrawMenuSeparator(menuPtr, mePtr, d, gc, tkfont,
+ fmPtr, x, adjustedY, width, adjustedHeight);
+ } else if (mePtr->type == TEAROFF_ENTRY) {
+ DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, adjustedY,
+ width, adjustedHeight);
+ } else {
+ DrawMenuEntryLabel(menuPtr, mePtr, d, gc, tkfont, fmPtr, x,
+ 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 --
+ *
+ * This procedure is invoked to recompute the size and
+ * layout of a menu that is not a menubar clone.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Fields of menu entries are changed to reflect their
+ * current positions, and the size of the menu window
+ * itself may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+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;
+ }
+ nonAccelMargin = 0;
+ }
+
+ if (!(mePtr->hideMargin)) {
+ GetMenuIndicatorGeometry(menuPtr, mePtr, tkfont,
+ fmPtr, &indicatorSpace, &height);
+ if (height > mePtr->height) {
+ mePtr->height = height;
+ }
+ } else {
+ indicatorSpace = 0;
+ }
+
+ if (nonAccelMargin > maxNonAccelMargin) {
+ maxNonAccelMargin = nonAccelMargin;
+ }
+ if (accelWidth > maxAccelTextWidth) {
+ maxAccelTextWidth = accelWidth;
+ }
+ if (modifierWidth > maxModifierWidth) {
+ maxModifierWidth = modifierWidth;
+ }
+ if (indicatorSpace > maxIndicatorSpace) {
+ maxIndicatorSpace = indicatorSpace;
+ }
+
+ entryWidth = labelWidth + modifierWidth + accelWidth
+ + nonAccelMargin;
+
+ if (entryWidth > maxWidth) {
+ maxWidth = entryWidth;
+ }
+
+ if (mePtr->accelLength > 0) {
+ if (entryWidth > maxEntryWithAccelWidth) {
+ maxEntryWithAccelWidth = entryWidth;
+ }
+ } 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) {
+ windowWidth = 1;
+ }
+ if (windowHeight <= 0) {
+ windowHeight = 1;
+ }
+ menuPtr->totalWidth = windowWidth;
+ menuPtr->totalHeight = windowHeight;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuEntryLabel --
+ *
+ * This procedure draws the label part of a menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawMenuEntryLabel(
+ 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, /* right edge */
+ 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) {
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawMenuEntryBackground(
+ TkMenu *menuPtr, /* The menu we are drawing. */
+ TkMenuEntry *mePtr, /* The entry we are drawing. */
+ Drawable d, /* What we are drawing into */
+ 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 == tkActiveUid) && (mePtr->activeBorder != NULL))
+ || ((mePtr->state != tkActiveUid) && (mePtr->border != NULL))) {
+ if (mePtr->state == tkActiveUid) {
+ bgBorder = activeBorder;
+ }
+ Tk_Fill3DRectangle(menuPtr->tkwin, d, bgBorder,
+ x, y, width, height, 0, TK_RELIEF_FLAT);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMenuLabelGeometry --
+ *
+ * Figures out the size of the label portion of a menu item.
+ *
+ * Results:
+ * widthPtr and heightPtr are filled in with the correct geometry
+ * information.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMenuLabelGeometry(
+ TkMenuEntry *mePtr, /* The entry we are computing */
+ Tk_Font tkfont, /* The precalculated font */
+ CONST Tk_FontMetrics *fmPtr, /* The precalculated metrics */
+ int *widthPtr, /* The resulting width of the label
+ * portion */
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuSelectEvent --
+ *
+ * Generates a "MenuSelect" virtual event. This can be used to
+ * do context-sensitive menu help.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Places a virtual event on the event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MenuSelectEvent(
+ TkMenu *menuPtr) /* the menu we have selected. */
+{
+ XVirtualEvent event;
+ Point where;
+
+ event.type = VirtualEvent;
+ event.serial = menuPtr->display->request;
+ event.send_event = false;
+ event.display = menuPtr->display;
+ Tk_MakeWindowExist(menuPtr->tkwin);
+ event.event = Tk_WindowId(menuPtr->tkwin);
+ event.root = XRootWindow(menuPtr->display, 0);
+ event.subwindow = None;
+ event.time = TkpGetMS();
+
+ GetMouse(&where);
+ event.x_root = where.h;
+ event.y_root = where.v;
+ event.state = TkMacButtonKeyState();
+ event.same_screen = true;
+ event.name = Tk_GetUid("MenuSelect");
+ Tk_QueueWindowEvent((XEvent *) &event, TCL_QUEUE_TAIL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecursivelyClearActiveMenu --
+ *
+ * Recursively clears the active entry in the menu's cascade hierarchy.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates <<MenuSelect>> virtual events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+RecursivelyClearActiveMenu(
+ TkMenu *menuPtr) /* The menu to reset. */
+{
+ int i;
+ TkMenuEntry *mePtr;
+
+ TkActivateMenuEntry(menuPtr, -1);
+ MenuSelectEvent(menuPtr);
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ mePtr = menuPtr->entries[i];
+ if (mePtr->type == CASCADE_ENTRY) {
+ if ((mePtr->childMenuRefPtr != NULL)
+ && (mePtr->childMenuRefPtr->menuPtr != NULL)) {
+ RecursivelyClearActiveMenu(mePtr->childMenuRefPtr->menuPtr);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InvalidateMDEFRgns --
+ *
+ * Invalidates the regions covered by menus that did redrawing and
+ * might be damaged.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates Mac update events for affected windows.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+InvalidateMDEFRgns(void) {
+ GDHandle saveDevice;
+ GWorldPtr saveWorld, destPort;
+ Point scratch;
+ MacDrawable *macDraw;
+ TkMacWindowList *listPtr;
+
+ if (totalMenuRgn == NULL) {
+ return;
+ }
+
+ GetGWorld(&saveWorld, &saveDevice);
+ for (listPtr = tkMacWindowListPtr ; listPtr != NULL;
+ listPtr = listPtr->nextPtr) {
+ macDraw = (MacDrawable *) Tk_WindowId(listPtr->winPtr);
+ if (macDraw->flags & TK_DRAWN_UNDER_MENU) {
+ destPort = TkMacGetDrawablePort(Tk_WindowId(listPtr->winPtr));
+ SetGWorld(destPort, NULL);
+ scratch.h = scratch.v = 0;
+ GlobalToLocal(&scratch);
+ OffsetRgn(totalMenuRgn, scratch.v, scratch.h);
+ InvalRgn(totalMenuRgn);
+ OffsetRgn(totalMenuRgn, -scratch.v, -scratch.h);
+ macDraw->flags &= ~TK_DRAWN_UNDER_MENU;
+ }
+ }
+
+ SetGWorld(saveWorld, saveDevice);
+ SetEmptyRgn(totalMenuRgn);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacClearMenubarActive --
+ *
+ * Recursively clears the active entry in the current menubar hierarchy.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates <<MenuSelect>> virtual events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacClearMenubarActive(void) {
+ TkMenuReferences *menuBarRefPtr;
+
+ if (currentMenuBarName != NULL) {
+ menuBarRefPtr = TkFindMenuReferences(currentMenuBarInterp,
+ currentMenuBarName);
+ if ((menuBarRefPtr != NULL) && (menuBarRefPtr->menuPtr != NULL)) {
+ TkMenu *menuPtr;
+
+ for (menuPtr = menuBarRefPtr->menuPtr->masterMenuPtr; menuPtr != NULL;
+ menuPtr = menuPtr->nextInstancePtr) {
+ if (menuPtr->menuType == MENUBAR) {
+ RecursivelyClearActiveMenu(menuPtr);
+ }
+ }
+ }
+ }
+ InvalidateMDEFRgns();
+ FixMDEF();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuNotifyToplevelCreate --
+ *
+ * This routine reconfigures the menu and the clones indicated by
+ * menuName becuase a toplevel has been created and any system
+ * menus need to be created. Only applicable to Windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * An idle handler is set up to do the reconfiguration.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMenuNotifyToplevelCreate(
+ Tcl_Interp *interp, /* The interp the menu lives in. */
+ char *menuName) /* The name of the menu to
+ * reconfigure. */
+{
+ /*
+ * Nothing to do.
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FixMDEF --
+ *
+ * Loads the MDEF and blasts our routine descriptor into it.
+ * We have to set up the MDEF. This is pretty slimy. The real MDEF
+ * resource is 68K code. All this code does is call another procedure.
+ * When the application in launched, a dummy value for the procedure
+ * is compiled into the MDEF. We are going to replace that dummy
+ * 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:
+ * 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;
+
+ /*
+ * 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();
+
+}
diff --git a/tk/mac/tkMacMenu.r b/tk/mac/tkMacMenu.r
new file mode 100644
index 00000000000..feb3a5f05ee
--- /dev/null
+++ b/tk/mac/tkMacMenu.r
@@ -0,0 +1,47 @@
+/*
+ * 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$
+ */
+
+#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",
+ /* [3] */
+ $"0000 0000 0000 0000 0000 F8F0 C4F0 F270"
+ $"0900 0480 0270 0130 00F0",
+ /* [4] */
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 E4E0 CE60 1B00 3180",
+ /* [5] */
+ $"0000 0000 0000 0000 6300 9480 9480 7F00"
+ $"1400 7F00 9480 9480 63",
+ /* [6] */
+ $"0000 0000 0000 0000 0000 3FF8 1FF0 0FE0"
+ $"07C0 0380 01",
+ /* [7] */
+ $"0000 0000 0000 0000 0000 0100 0380 07C0"
+ $"0FE0 1FF0 3FF8"
+ }
+};
diff --git a/tk/mac/tkMacMenubutton.c b/tk/mac/tkMacMenubutton.c
new file mode 100644
index 00000000000..6ba9f192edb
--- /dev/null
+++ b/tk/mac/tkMacMenubutton.c
@@ -0,0 +1,339 @@
+/*
+ * 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$
+ */
+
+#include "tkMenubutton.h"
+#include "tkMacInt.h"
+#include <Controls.h>
+
+#define kShadowOffset (3) /* amount to offset shadow from frame */
+#define kTriangleWidth (11) /* width of the triangle */
+#define kTriangleHeight (6) /* height of the triangle */
+#define kTriangleMargin (5) /* margin around triangle */
+
+/*
+ * Declaration of Unix specific button structure.
+ */
+
+typedef struct MacMenuButton {
+ TkMenuButton info; /* Generic button info. */
+} MacMenuButton;
+
+/*
+ * The structure below defines menubutton class behavior by means of
+ * procedures that can be invoked from generic window code.
+ */
+
+TkClassProcs tkpMenubuttonClass = {
+ NULL, /* createProc. */
+ TkMenuButtonWorldChanged, /* geometryProc. */
+ NULL /* modalProc. */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCreateMenuButton --
+ *
+ * Allocate a new TkMenuButton structure.
+ *
+ * Results:
+ * Returns a newly allocated TkMenuButton structure.
+ *
+ * Side effects:
+ * Registers an event handler for the widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkMenuButton *
+TkpCreateMenuButton(
+ Tk_Window tkwin)
+{
+ MacMenuButton *butPtr = (MacMenuButton *)ckalloc(sizeof(MacMenuButton));
+
+ return (TkMenuButton *) butPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDisplayMenuButton --
+ *
+ * This procedure is invoked to display a menubutton widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menubutton in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDisplayMenuButton(
+ ClientData clientData) /* Information about widget. */
+{
+ TkMenuButton *mbPtr = (TkMenuButton *) clientData;
+ GC gc;
+ Tk_3DBorder border;
+ int x = 0; /* Initialization needed only to stop
+ * compiler warning. */
+ int y;
+ Tk_Window tkwin = mbPtr->tkwin;
+ int width, height;
+ MacMenuButton * macMBPtr = (MacMenuButton *) mbPtr;
+ GWorldPtr destPort;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ MacDrawable *macDraw;
+
+ mbPtr->flags &= ~REDRAW_PENDING;
+ if ((mbPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ 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;
+
+ /*
+ * In order to avoid screen flashes, this procedure redraws
+ * the menu 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.
+ */
+
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), border, 0, 0,
+ Tk_Width(tkwin), Tk_Height(tkwin), 0, TK_RELIEF_FLAT);
+
+ /*
+ * Display image or bitmap or text for button.
+ */
+
+ if (mbPtr->image != None) {
+ Tk_SizeOfImage(mbPtr->image, &width, &height);
+
+ imageOrBitmap:
+ TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0,
+ width + mbPtr->indicatorWidth, height, &x, &y);
+ if (mbPtr->image != NULL) {
+ Tk_RedrawImage(mbPtr->image, 0, 0, width, height,
+ Tk_WindowId(tkwin), x, y);
+ } else {
+ XCopyPlane(mbPtr->display, mbPtr->bitmap, Tk_WindowId(tkwin),
+ gc, 0, 0, (unsigned) width, (unsigned) height, x, y, 1);
+ }
+ } else if (mbPtr->bitmap != None) {
+ Tk_SizeOfBitmap(mbPtr->display, mbPtr->bitmap, &width, &height);
+ goto imageOrBitmap;
+ } else {
+ TkComputeAnchor(mbPtr->anchor, tkwin, mbPtr->padX, mbPtr->padY,
+ mbPtr->textWidth + mbPtr->indicatorWidth, mbPtr->textHeight,
+ &x, &y);
+ Tk_DrawTextLayout(mbPtr->display, Tk_WindowId(tkwin), gc,
+ mbPtr->textLayout, x, y, 0, -1);
+ }
+
+ /*
+ * 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.
+ */
+
+ if (mbPtr->indicatorOn) {
+ int w, h, i;
+ Rect r;
+
+ r.left = macDraw->xOff + Tk_Width(tkwin) - mbPtr->inset
+ - mbPtr->indicatorWidth;
+ r.top = macDraw->yOff + Tk_Height(tkwin)/2
+ - mbPtr->indicatorHeight/2;
+ r.right = macDraw->xOff + Tk_Width(tkwin) - mbPtr->inset
+ - kTriangleMargin;
+ r.bottom = macDraw->yOff + Tk_Height(tkwin)/2
+ + mbPtr->indicatorHeight/2;
+
+ h = mbPtr->indicatorHeight;
+ w = mbPtr->indicatorWidth - 1 - kTriangleMargin;
+ for (i = 0; i < h; i++) {
+ MoveTo(r.left + i, r.top + i);
+ LineTo(r.left + i + w, r.top + i);
+ w -= 2;
+ }
+ }
+
+ /*
+ * Draw the border and traversal highlight last. This way, if the
+ * menu button's contents overflow onto the border they'll be covered
+ * up by the border.
+ */
+
+ TkMacSetUpClippingRgn(Tk_WindowId(tkwin));
+ if (mbPtr->borderWidth > 0) {
+ Rect r;
+
+ r.left = macDraw->xOff + mbPtr->highlightWidth + mbPtr->borderWidth;
+ r.top = macDraw->yOff + mbPtr->highlightWidth + mbPtr->borderWidth;
+ r.right = macDraw->xOff + Tk_Width(tkwin) - mbPtr->highlightWidth
+ - mbPtr->borderWidth;
+ r.bottom = macDraw->yOff + Tk_Height(tkwin) - mbPtr->highlightWidth
+ - mbPtr->borderWidth;
+ 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 {
+ gc = Tk_GCForColor(mbPtr->highlightBgColorPtr, Tk_WindowId(tkwin));
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, mbPtr->highlightWidth,
+ Tk_WindowId(tkwin));
+ }
+
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyMenuButton --
+ *
+ * Free data structures associated with the menubutton control.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Restores the default control state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyMenuButton(
+ TkMenuButton *mbPtr)
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpComputeMenuButtonGeometry --
+ *
+ * After changes in a menu button's text or bitmap, this procedure
+ * recomputes the menu button's geometry and passes this information
+ * along to the geometry manager for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * 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) {
+ width = mbPtr->width;
+ }
+ if (mbPtr->height > 0) {
+ height = mbPtr->height;
+ }
+ } else if (mbPtr->bitmap != None) {
+ Tk_SizeOfBitmap(mbPtr->display, mbPtr->bitmap, &width, &height);
+ if (mbPtr->width > 0) {
+ width = mbPtr->width;
+ }
+ if (mbPtr->height > 0) {
+ height = mbPtr->height;
+ }
+ } else {
+ Tk_FreeTextLayout(mbPtr->textLayout);
+ mbPtr->textLayout = Tk_ComputeTextLayout(mbPtr->tkfont, mbPtr->text,
+ -1, mbPtr->wrapLength, mbPtr->justify, 0, &mbPtr->textWidth,
+ &mbPtr->textHeight);
+ width = mbPtr->textWidth;
+ height = mbPtr->textHeight;
+ if (mbPtr->width > 0) {
+ width = mbPtr->width * Tk_TextWidth(mbPtr->tkfont, "0", 1);
+ }
+ if (mbPtr->height > 0) {
+ Tk_FontMetrics fm;
+
+ Tk_GetFontMetrics(mbPtr->tkfont, &fm);
+ height = mbPtr->height * fm.linespace;
+ }
+ width += 2*mbPtr->padX;
+ height += 2*mbPtr->padY;
+ }
+
+ if (mbPtr->indicatorOn) {
+ mm = WidthMMOfScreen(Tk_Screen(mbPtr->tkwin));
+ pixels = WidthOfScreen(Tk_Screen(mbPtr->tkwin));
+ mbPtr->indicatorHeight= kTriangleHeight;
+ mbPtr->indicatorWidth = kTriangleWidth + kTriangleMargin;
+ width += mbPtr->indicatorWidth;
+ } else {
+ mbPtr->indicatorHeight = 0;
+ mbPtr->indicatorWidth = 0;
+ }
+
+ Tk_GeometryRequest(mbPtr->tkwin, (int) (width + 2*mbPtr->inset),
+ (int) (height + 2*mbPtr->inset));
+ Tk_SetInternalBorder(mbPtr->tkwin, mbPtr->inset);
+}
diff --git a/tk/mac/tkMacMenus.c b/tk/mac/tkMacMenus.c
new file mode 100644
index 00000000000..7808ffa93be
--- /dev/null
+++ b/tk/mac/tkMacMenus.c
@@ -0,0 +1,346 @@
+/*
+ * 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$
+ */
+
+#include "tcl.h"
+#include "tclMacInt.h"
+#include "tk.h"
+#include "tkInt.h"
+#include "tkMacInt.h"
+
+/*
+ * The define Status defined by Xlib.h conflicts with the function Status
+ * defined by Devices.h. We undefine it here to compile.
+ */
+#undef Status
+#include <Devices.h>
+#include <Menus.h>
+#include <Memory.h>
+#include <SegLoad.h>
+#include <StandardFile.h>
+#include <ToolUtils.h>
+#include <Balloons.h>
+
+#define kAppleMenu 256
+#define kAppleAboutItem 1
+#define kFileMenu 2
+#define kEditMenu 3
+
+#define kSourceItem 1
+#define kCloseItem 2
+#define kQuitItem 4
+
+#define EDIT_CUT 1
+#define EDIT_COPY 2
+#define EDIT_PASTE 3
+#define EDIT_CLEAR 4
+
+MenuHandle tkAppleMenu;
+MenuHandle tkFileMenu;
+MenuHandle tkEditMenu;
+
+static Tcl_Interp * gInterp; /* Interpreter for this application. */
+
+static void GenerateEditEvent _ANSI_ARGS_((int flag));
+static void SourceDialog _ANSI_ARGS_((void));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacHandleMenuSelect --
+ *
+ * Handles events that occur in the Menu bar.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacHandleMenuSelect(
+ long mResult,
+ int optionKeyPressed)
+{
+ short theItem = LoWord(mResult);
+ short theMenu = HiWord(mResult);
+ Str255 name;
+ Tk_Window tkwin;
+ Window window;
+
+ if (mResult == 0) {
+ TkMacHandleTearoffMenu();
+ TkMacClearMenubarActive();
+ return;
+ }
+
+ switch (theMenu) {
+
+ case kAppleMenu:
+ switch (theItem) {
+ case kAppleAboutItem:
+ {
+ Tcl_CmdInfo dummy;
+
+ if (optionKeyPressed || gInterp == NULL ||
+ Tcl_GetCommandInfo(gInterp,
+ "tkAboutDialog", &dummy) == 0) {
+ TkAboutDlg();
+ } else {
+ Tcl_Eval(gInterp, "tkAboutDialog");
+ }
+ break;
+ }
+ default:
+ GetItem(tkAppleMenu, theItem, name);
+ HiliteMenu(0);
+ OpenDeskAcc(name);
+ return;
+ }
+ break;
+ case kFileMenu:
+ switch (theItem) {
+ 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 {
+ Tcl_Eval(gInterp, "exit");
+ }
+ break;
+ }
+ break;
+ case kEditMenu:
+ /*
+ * This implementation just send keysyms
+ * the Tk thinks are associated with function keys that
+ * do Cut, Copy & Paste on a Sun keyboard.
+ */
+ GenerateEditEvent(theItem);
+ break;
+ default:
+ TkMacDispatchMenuEvent(theMenu, theItem);
+ TkMacClearMenubarActive();
+ break;
+ }
+
+ /*
+ * Finally we unhighlight the menu.
+ */
+ HiliteMenu(0);
+} /* TkMacHandleMenuSelect */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacInitMenus --
+ *
+ * This procedure initializes the Macintosh menu bar.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacInitMenus(
+ Tcl_Interp *interp)
+{
+ gInterp = interp;
+
+ /*
+ * At this point, InitMenus() should have already been called.
+ */
+
+ if (TkMacUseMenuID(256) != TCL_OK) {
+ panic("Menu ID 256 is already in use!");
+ }
+ tkAppleMenu = NewMenu(256, "\p\024");
+ if (tkAppleMenu == NULL) {
+ panic("memory - menus");
+ }
+ InsertMenu(tkAppleMenu, 0);
+ AppendMenu(tkAppleMenu, "\pAbout Tcl & TkÉ");
+ AppendMenu(tkAppleMenu, "\p(-");
+ AddResMenu(tkAppleMenu, 'DRVR');
+
+ if (TkMacUseMenuID(kFileMenu) != TCL_OK) {
+ panic("Menu ID %d is already in use!", kFileMenu);
+ }
+ tkFileMenu = NewMenu(kFileMenu, "\pFile");
+ if (tkFileMenu == NULL) {
+ panic("memory - menus");
+ }
+ InsertMenu(tkFileMenu, 0);
+ AppendMenu(tkFileMenu, "\pSourceÉ");
+ AppendMenu(tkFileMenu, "\pClose/W");
+ AppendMenu(tkFileMenu, "\p(-");
+ AppendMenu(tkFileMenu, "\pQuit/Q");
+
+ if (TkMacUseMenuID(kEditMenu) != TCL_OK) {
+ panic("Menu ID %d is already in use!", kEditMenu);
+ }
+ tkEditMenu = NewMenu(kEditMenu, "\pEdit");
+ if (tkEditMenu == NULL) {
+ panic("memory - menus");
+ }
+ InsertMenu(tkEditMenu, 0);
+ AppendMenu(tkEditMenu, "\pCut/X");
+ AppendMenu(tkEditMenu, "\pCopy/C");
+ AppendMenu(tkEditMenu, "\pPaste/V");
+ AppendMenu(tkEditMenu, "\pClear");
+ if (TkMacUseMenuID(kHMHelpMenuID) != TCL_OK) {
+ panic("Help menu ID %s is already in use!", kHMHelpMenuID);
+ }
+
+ DrawMenuBar();
+ TkMacSetHelpMenuItemCount();
+
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateEditEvent --
+ *
+ * Takes an edit menu item and posts the corasponding a virtual
+ * event to Tk's event queue.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May place events of queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+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;
+ event.send_event = false;
+ event.display = Tk_Display(tkwin);
+ event.event = Tk_WindowId(tkwin);
+ event.root = XRootWindow(Tk_Display(tkwin), 0);
+ event.subwindow = None;
+ event.time = TkpGetMS();
+
+ GetMouse(&where);
+ tkwin = Tk_TopCoordsToWindow(tkwin, where.h, where.v,
+ &event.x, &event.y);
+ LocalToGlobal(&where);
+ event.x_root = where.h;
+ event.y_root = where.v;
+ event.state = TkMacButtonKeyState();
+ event.same_screen = true;
+
+ switch (flag) {
+ case EDIT_CUT:
+ event.name = Tk_GetUid("Cut");
+ break;
+
+ case EDIT_COPY:
+ event.name = Tk_GetUid("Copy");
+ break;
+
+ case EDIT_PASTE:
+ event.name = Tk_GetUid("Paste");
+ break;
+
+ case EDIT_CLEAR:
+ event.name = Tk_GetUid("Clear");
+ break;
+ }
+ Tk_QueueWindowEvent((XEvent *) &event, TCL_QUEUE_TAIL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SourceDialog --
+ *
+ * Presents a dialog to the user for selecting a Tcl file. The
+ * selected file will be sourced into the main interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SourceDialog()
+{
+ StandardFileReply reply;
+ OSType fileTypes[1];
+ OSErr err;
+ int length, result;
+ Handle path;
+
+ if (gInterp == NULL) {
+ return;
+ }
+
+ fileTypes[0] = 'TEXT';
+ StandardGetFile(NULL, 1, fileTypes, &reply);
+ if (reply.sfGood == false) {
+ return;
+ }
+
+ err = FSpPathFromLocation(&reply.sfFile, &length, &path);
+ if (err == noErr) {
+ HLock(path);
+ result = Tcl_EvalFile(gInterp, *path);
+ HUnlock(path);
+ DisposeHandle(path);
+ }
+ if (result == TCL_ERROR) {
+ Tcl_BackgroundError(gInterp);
+ }
+}
diff --git a/tk/mac/tkMacPort.h b/tk/mac/tkMacPort.h
new file mode 100644
index 00000000000..b1895b236f4
--- /dev/null
+++ b/tk/mac/tkMacPort.h
@@ -0,0 +1,147 @@
+/*
+ * 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.
+ * 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$
+ */
+
+#ifndef _TKMACPORT
+#define _TKMACPORT
+
+/*
+ * Macro to use instead of "void" for arguments that must have
+ * type "void *" in ANSI C; maps them to type "char *" in
+ * non-ANSI systems. This macro may be used in some of the include
+ * files below, which is why it is defined here.
+ */
+
+#ifndef VOID
+# ifdef __STDC__
+# define VOID void
+# else
+# define VOID char
+# endif
+#endif
+
+#ifndef _TCL
+# include <tcl.h>
+#endif
+
+#include <time.h>
+#include <stdlib.h>
+#include <string.h>
+#include "tclMath.h"
+#include <ctype.h>
+#include <limits.h>
+
+#include <Xlib.h>
+#include <cursorfont.h>
+#include <keysym.h>
+#include <Xatom.h>
+#include <Xfuncproto.h>
+#include <Xutil.h>
+
+/*
+ * Not all systems declare the errno variable in errno.h. so this
+ * file does it explicitly.
+ */
+
+extern int errno;
+
+/*
+ * Define "NBBY" (number of bits per byte) if it's not already defined.
+ */
+
+#ifndef NBBY
+# define NBBY 8
+#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));
+extern int strcasecmp _ANSI_ARGS_((CONST char *s1,
+ CONST char *s2));
+extern int strncasecmp _ANSI_ARGS_((CONST char *s1,
+ CONST char *s2, size_t n));
+
+/*
+ * Defines for X functions that are used by Tk but are treated as
+ * no-op functions on the Macintosh.
+ */
+
+#define XFlush(display)
+#define XFree(data) {if ((data) != NULL) ckfree((char *) (data));}
+#define XGrabServer(display)
+#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.
+ */
+
+#define PIXEL_MAGIC ((unsigned char) 0x69)
+#define TkpGetPixel(p) ((((((PIXEL_MAGIC << 8) \
+ | (((p)->red >> 8) & 0xff)) << 8) \
+ | (((p)->green >> 8) & 0xff)) << 8) \
+ | (((p)->blue >> 8) & 0xff))
+
+/*
+ * This macro stores a representation of the window handle in a string.
+ */
+
+#define TkpPrintWindowId(buf,w) \
+ sprintf((buf), "0x%x", (unsigned int) (w))
+
+/*
+ * TkpScanWindowId is just an alias for Tcl_GetInt on Unix.
+ */
+
+#define TkpScanWindowId(i,s,wp) \
+ Tcl_GetInt((i),(s),(wp))
+
+/*
+ * Magic pixel values for dynamic (or active) colors.
+ */
+
+#define HIGHLIGHT_PIXEL 31
+#define HIGHLIGHT_TEXT_PIXEL 33
+#define CONTROL_TEXT_PIXEL 35
+#define CONTROL_BODY_PIXEL 37
+#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 */
diff --git a/tk/mac/tkMacRegion.c b/tk/mac/tkMacRegion.c
new file mode 100644
index 00000000000..7e9b4aa7565
--- /dev/null
+++ b/tk/mac/tkMacRegion.c
@@ -0,0 +1,217 @@
+/*
+ * 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$
+ */
+
+#include "tkInt.h"
+#include "X.h"
+#include "Xlib.h"
+
+#include <Windows.h>
+#include <QDOffscreen.h>
+
+/*
+ * Temporary region that can be reused.
+ */
+static RgnHandle tmpRgn = NULL;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCreateRegion --
+ *
+ * Implements the equivelent of the X window function
+ * XCreateRegion. See X window documentation for more details.
+ *
+ * Results:
+ * Returns an allocated region handle.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkRegion
+TkCreateRegion()
+{
+ RgnHandle rgn;
+
+ rgn = NewRgn();
+ return (TkRegion) rgn;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDestroyRegion --
+ *
+ * Implements the equivelent of the X window function
+ * XDestroyRegion. See X window documentation for more details.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkDestroyRegion(
+ TkRegion r)
+{
+ RgnHandle rgn = (RgnHandle) r;
+
+ DisposeRgn(rgn);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkIntersectRegion --
+ *
+ * Implements the equivilent of the X window function
+ * XIntersectRegion. See X window documentation for more details.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkIntersectRegion(
+ TkRegion sra,
+ TkRegion srb,
+ TkRegion dr_return)
+{
+ RgnHandle srcRgnA = (RgnHandle) sra;
+ RgnHandle srcRgnB = (RgnHandle) srb;
+ RgnHandle destRgn = (RgnHandle) dr_return;
+
+ SectRgn(srcRgnA, srcRgnB, destRgn);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUnionRectWithRegion --
+ *
+ * Implements the equivelent of the X window function
+ * XUnionRectWithRegion. See X window documentation for more
+ * details.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkUnionRectWithRegion(
+ XRectangle* rectangle,
+ TkRegion src_region,
+ TkRegion dest_region_return)
+{
+ RgnHandle srcRgn = (RgnHandle) src_region;
+ RgnHandle destRgn = (RgnHandle) dest_region_return;
+
+ if (tmpRgn == NULL) {
+ tmpRgn = NewRgn();
+ }
+ SetRectRgn(tmpRgn, rectangle->x, rectangle->y,
+ rectangle->x + rectangle->width, rectangle->y + rectangle->height);
+ UnionRgn(srcRgn, tmpRgn, destRgn);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkRectInRegion --
+ *
+ * Implements the equivelent of the X window function
+ * XRectInRegion. See X window documentation for more details.
+ *
+ * Results:
+ * Returns one of: RectangleOut, RectangleIn, RectanglePart.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkRectInRegion(
+ TkRegion region,
+ int x,
+ int y,
+ unsigned int width,
+ unsigned int height)
+{
+ RgnHandle rgn = (RgnHandle) region;
+ RgnHandle rectRgn, destRgn;
+ int result;
+
+ rectRgn = NewRgn();
+ destRgn = NewRgn();
+ SetRectRgn(rectRgn, x, y, x + width, y + height);
+ SectRgn(rgn, rectRgn, destRgn);
+ if (EmptyRgn(destRgn)) {
+ result = RectangleOut;
+ } else if (EqualRgn(rgn, destRgn)) {
+ result = RectangleIn;
+ } else {
+ result = RectanglePart;
+ }
+ DisposeRgn(rectRgn);
+ DisposeRgn(destRgn);
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkClipBox --
+ *
+ * Implements the equivelent of the X window function XClipBox.
+ * See X window documentation for more details.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkClipBox(
+ TkRegion r,
+ XRectangle* rect_return)
+{
+ RgnHandle rgn = (RgnHandle) r;
+
+ rect_return->x = (**rgn).rgnBBox.left;
+ rect_return->y = (**rgn).rgnBBox.top;
+ rect_return->width = (**rgn).rgnBBox.right - (**rgn).rgnBBox.left;
+ rect_return->height = (**rgn).rgnBBox.bottom - (**rgn).rgnBBox.top;
+}
diff --git a/tk/mac/tkMacResource.r b/tk/mac/tkMacResource.r
new file mode 100644
index 00000000000..66fef27da99
--- /dev/null
+++ b/tk/mac/tkMacResource.r
@@ -0,0 +1,505 @@
+/*
+ * 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$
+ */
+
+/*
+ * We define SystemSevenOrLater so that our dialogs may use the
+ * auto center feature.
+ */
+#define SystemSevenOrLater 1
+
+#include <Types.r>
+#include <SysTypes.r>
+
+/*
+ * The folowing include and defines help construct
+ * the version string for Tcl.
+ */
+
+#define RESOURCE_INCLUDED
+#include "tcl.h"
+#include "tk.h"
+
+#if (TK_RELEASE_LEVEL == 0)
+# define RELEASE_LEVEL alpha
+#elif (TK_RELEASE_LEVEL == 1)
+# define RELEASE_LEVEL beta
+#elif (TK_RELEASE_LEVEL == 2)
+# define RELEASE_LEVEL final
+#endif
+
+#if (TK_RELEASE_LEVEL == 2)
+# define MINOR_VERSION (TK_MINOR_VERSION * 16) + TK_RELEASE_SERIAL
+#else
+# define MINOR_VERSION TK_MINOR_VERSION * 16
+#endif
+
+resource 'vers' (1) {
+ TK_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ TK_PATCH_LEVEL,
+ TK_PATCH_LEVEL ", by Ray Johnson © 1993-1996" "\n" "Sun Microsystems Labratories"
+};
+
+resource 'vers' (2) {
+ TK_MAJOR_VERSION, MINOR_VERSION,
+ RELEASE_LEVEL, 0x00, verUS,
+ TK_PATCH_LEVEL,
+ "Wish " TK_PATCH_LEVEL " © 1993-1996"
+};
+
+
+/*
+ * The mechanisim below loads Tcl source into the resource fork of the
+ * application. The example below creates a TEXT resource named
+ * "Init" from the file "init.tcl". This allows applications to use
+ * Tcl to define the behavior of the application without having to
+ * 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";
+
+/*
+ * 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
+ * the resource must be of the form "KEYWORD=SOME STRING". See Tcl
+ * documentation for futher information about the env variable.
+ */
+
+/* A good example of something you may want to set is:
+ * "TCL_LIBRARY=My disk:etc."
+ */
+
+resource 'STR#' (128, "Tcl Environment Variables") {
+ { "SCHEDULE_NAME=Agent Controller Schedule",
+ "SCHEDULE_PATH=Lozoya:System Folder:Tcl Lib:Tcl-Scheduler"
+ };
+};
+
+/*
+ * 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
+ * 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" "ray.johnson@eng.sun.com"},
+ { 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"
+ $"0064 0044 0099 8044 0000 0000 0064 0044"
+ $"0000 0000 0000 0000 0048 0000 0048 0000"
+ $"0000 0008 0001 0008 0000 0000 0108 00D8"
+ $"0000 0000 0001 5A5A 8000 00FF 3736 FF00"
+ $"FF00 FF00 3535 FF00 FF00 CC00 3434 FF00"
+ $"FF00 9900 3333 FF00 FF00 6600 3736 FF00"
+ $"FF00 3300 3535 FF00 FF00 0000 3434 FF00"
+ $"CC00 FF00 3333 FF00 CC00 CC00 3736 FF00"
+ $"CC00 9900 3535 FF00 CC00 6600 FAFA FF00"
+ $"CC00 3300 3333 FF00 CC00 0000 3130 FF00"
+ $"9900 FF00 2F2F FF00 9900 CC00 FAFA FF00"
+ $"9900 9900 F9F9 FF00 9900 6600 3130 FF00"
+ $"9900 3300 2F2F FF00 9900 0000 2E2E FF00"
+ $"6600 FF00 F9F9 FF00 6600 CC00 3130 FF00"
+ $"6600 9900 2F2F FF00 6600 6600 2E2E FF00"
+ $"6600 3300 2D2D FF00 6600 0000 3130 FF00"
+ $"3300 FF00 2F2F FF00 3300 CC00 2E2E FF00"
+ $"3300 9900 2D2D FF00 3300 6600 3130 FF00"
+ $"3300 3300 2F2F FF00 3300 0000 2E2E FF00"
+ $"0000 FF00 2D2D FF00 0000 CC00 3130 FF00"
+ $"0000 9900 2F2F FF00 0000 6600 2E2E FF00"
+ $"0000 3300 2DF8 FF00 0000 0000 2B2A CC00"
+ $"FF00 FF00 2929 CC00 FF00 CC00 2828 CC00"
+ $"FF00 9900 27F8 CC00 FF00 6600 2B2A CC00"
+ $"FF00 3300 2929 CC00 FF00 0000 2828 CC00"
+ $"CC00 FF00 2727 CC00 CC00 CC00 2B2A CC00"
+ $"CC00 9900 2929 CC00 CC00 6600 2828 CC00"
+ $"CC00 3300 2727 CC00 CC00 0000 2B2A CC00"
+ $"9900 FF00 2929 CC00 9900 CC00 2828 CC00"
+ $"9900 9900 2727 CC00 9900 6600 DBDB CC00"
+ $"9900 3300 4747 CC00 9900 0000 4646 CC00"
+ $"6600 FF00 4545 CC00 6600 CC00 DBDB CC00"
+ $"6600 9900 4747 CC00 6600 6600 4646 CC00"
+ $"6600 3300 4545 CC00 6600 0000 DBDB CC00"
+ $"3300 FF00 4747 CC00 3300 CC00 4646 CC00"
+ $"3300 9900 4545 CC00 3300 6600 DBDB CC00"
+ $"3300 3300 4141 CC00 3300 0000 4040 CC00"
+ $"0000 FF00 3F3F CC00 0000 CC00 4342 CC00"
+ $"0000 9900 4141 CC00 0000 6600 4040 CC00"
+ $"0000 3300 3F3F CC00 0000 0000 4342 9900"
+ $"FF00 FF00 4141 9900 FF00 CC00 4040 9900"
+ $"FF00 9900 3F3F 9900 FF00 6600 4342 9900"
+ $"FF00 3300 4141 9900 FF00 0000 4040 9900"
+ $"CC00 FF00 3F3F 9900 CC00 CC00 4342 9900"
+ $"CC00 9900 4141 9900 CC00 6600 4040 9900"
+ $"CC00 3300 3F3F 9900 CC00 0000 4342 9900"
+ $"9900 FF00 4141 9900 9900 CC00 4040 9900"
+ $"9900 9900 3F3F 9900 9900 6600 3D3C 9900"
+ $"9900 3300 3B3B 9900 9900 0000 3A3A 9900"
+ $"6600 FF00 3939 9900 6600 CC00 3D3C 9900"
+ $"6600 9900 3B3B 9900 6600 6600 3A3A 9900"
+ $"6600 3300 3939 9900 6600 0000 3D3C 9900"
+ $"3300 FF00 3B3B 9900 3300 CC00 3A3A 9900"
+ $"3300 9900 3939 9900 3300 6600 3D3C 9900"
+ $"3300 3300 3B3B 9900 3300 0000 3A3A 9900"
+ $"0000 FF00 3939 9900 0000 CC00 3D3C 9900"
+ $"0000 9900 3B3B 9900 0000 6600 3A3A 9900"
+ $"0000 3300 3939 9900 0000 0000 3D3C 6600"
+ $"FF00 FF00 3B3B 6600 FF00 CC00 3A3A 6600"
+ $"FF00 9900 3939 6600 FF00 6600 3D3C 6600"
+ $"FF00 3300 3B3B 6600 FF00 0000 3A3A 6600"
+ $"CC00 FF00 3939 6600 CC00 CC00 3736 6600"
+ $"CC00 9900 3535 6600 CC00 6600 3434 6600"
+ $"CC00 3300 3333 6600 CC00 0000 3736 6600"
+ $"9900 FF00 3535 6600 9900 CC00 3434 6600"
+ $"9900 9900 3333 6600 9900 6600 3736 6600"
+ $"9900 3300 3535 6600 9900 0000 3434 6600"
+ $"6600 FF00 3333 6600 6600 CC00 3736 6600"
+ $"6600 9900 3535 6600 6600 6600 3434 6600"
+ $"6600 3300 3333 6600 6600 0000 3736 6600"
+ $"3300 FF00 3535 6600 3300 CC00 3434 6600"
+ $"3300 9900 3333 6600 3300 6600 3736 6600"
+ $"3300 3300 3535 6600 3300 0000 3434 6600"
+ $"0000 FF00 3333 6600 0000 CC00 3130 6600"
+ $"0000 9900 2F2F 6600 0000 6600 2E2E 6600"
+ $"0000 3300 F9F9 6600 0000 0000 3130 3300"
+ $"FF00 FF00 2F2F 3300 FF00 CC00 2E2E 3300"
+ $"FF00 9900 F9F9 3300 FF00 6600 3130 3300"
+ $"FF00 3300 2F2F 3300 FF00 0000 2E2E 3300"
+ $"CC00 FF00 2D2D 3300 CC00 CC00 3130 3300"
+ $"CC00 9900 2F2F 3300 CC00 6600 2E2E 3300"
+ $"CC00 3300 2D2D 3300 CC00 0000 3130 3300"
+ $"9900 FF00 2F2F 3300 9900 CC00 2E2E 3300"
+ $"9900 9900 2D2D 3300 9900 6600 3130 3300"
+ $"9900 3300 2F2F 3300 9900 0000 2E2E 3300"
+ $"6600 FF00 2DF8 3300 6600 CC00 2B2A 3300"
+ $"6600 9900 2929 3300 6600 6600 2828 3300"
+ $"6600 3300 27F8 3300 6600 0000 2B2A 3300"
+ $"3300 FF00 2929 3300 3300 CC00 2828 3300"
+ $"3300 9900 2727 3300 3300 6600 2B2A 3300"
+ $"3300 3300 2929 3300 3300 0000 2828 3300"
+ $"0000 FF00 2727 3300 0000 CC00 2B2A 3300"
+ $"0000 9900 2929 3300 0000 6600 2828 3300"
+ $"0000 3300 2727 3300 0000 0000 4948 0000"
+ $"FF00 FF00 4747 0000 FF00 CC00 4646 0000"
+ $"FF00 9900 4545 0000 FF00 6600 4948 0000"
+ $"FF00 3300 4747 0000 FF00 0000 4646 0000"
+ $"CC00 FF00 4545 0000 CC00 CC00 4948 0000"
+ $"CC00 9900 4747 0000 CC00 6600 4646 0000"
+ $"CC00 3300 4545 0000 CC00 0000 4342 0000"
+ $"9900 FF00 4141 0000 9900 CC00 4040 0000"
+ $"9900 9900 3F3F 0000 9900 6600 4342 0000"
+ $"9900 3300 4141 0000 9900 0000 4040 0000"
+ $"6600 FF00 3F3F 0000 6600 CC00 4342 0000"
+ $"6600 9900 4141 0000 6600 6600 4040 0000"
+ $"6600 3300 3F3F 0000 6600 0000 4342 0000"
+ $"3300 FF00 4141 0000 3300 CC00 4040 0000"
+ $"3300 9900 3F3F 0000 3300 6600 4342 0000"
+ $"3300 3300 4141 0000 3300 0000 4040 0000"
+ $"0000 FF00 3F3F 0000 0000 CC00 4342 0000"
+ $"0000 9900 4141 0000 0000 6600 4040 0000"
+ $"0000 3300 3F3F EE00 0000 0000 3D3C DD00"
+ $"0000 0000 3B3B BB00 0000 0000 3A3A AA00"
+ $"0000 0000 3939 8800 0000 0000 3D3C 7700"
+ $"0000 0000 3B3B 5500 0000 0000 3A3A 4400"
+ $"0000 0000 3939 2200 0000 0000 3D3C 1100"
+ $"0000 0000 3B3B 0000 EE00 0000 3A3A 0000"
+ $"DD00 0000 3939 0000 BB00 0000 3D3C 0000"
+ $"AA00 0000 3B3B 0000 8800 0000 3A3A 0000"
+ $"7700 0000 3939 0000 5500 0000 3D3C 0000"
+ $"4400 0000 3B3B 0000 2200 0000 3A3A 0000"
+ $"1100 0000 3939 0000 0000 EE00 3D3C 0000"
+ $"0000 DD00 3B3B 0000 0000 BB00 3A3A 0000"
+ $"0000 AA00 3939 0000 0000 8800 3D3C 0000"
+ $"0000 7700 3B3B 0000 0000 5500 3A3A 0000"
+ $"0000 4400 3939 0000 0000 2200 3736 0000"
+ $"0000 1100 3535 EE00 EE00 EE00 3434 DD00"
+ $"DD00 DD00 3333 BB00 BB00 BB00 3736 AA00"
+ $"AA00 AA00 3535 8800 8800 8800 3434 7700"
+ $"7700 7700 3333 5500 5500 5500 3736 4400"
+ $"4400 4400 3535 2200 2200 2200 3434 1100"
+ $"1100 1100 3333 0000 0000 0000 0000 0000"
+ $"0064 0044 0000 0000 0064 0044 0000 000A"
+ $"0000 0000 0064 0044 02BD 0013 E800 01F5"
+ $"F6FE 07FE 0E02 3232 33FD 3900 0EE6 001D"
+ $"FC00 01F5 F5FE 0700 08FE 0E02 3232 33FE"
+ $"3900 3AFC 40F2 4102 4033 07E9 0017 0100"
+ $"0EFC 40DC 4102 390E F5F5 0002 F5F5 F6FE"
+ $"0702 0E07 0016 0100 32D5 4104 4039 0E32"
+ $"33FD 3900 3AFC 40FC 4101 3200 0801 000E"
+ $"C141 010E 0008 0100 0EC1 4101 0800 0801"
+ $"000E C141 0107 0008 0100 0EC1 4101 0700"
+ $"0901 0007 C241 0240 F500 0E01 0007 E841"
+ $"0147 47DD 4102 4000 0012 0100 07F0 4100"
+ $"47FA 4101 3B3B DD41 0240 0000 1901 0007"
+ $"F141 0C47 3B0B 3B47 4141 4711 0505 3B47"
+ $"DF41 023A 0000 1701 00F6 F041 010B 0BFE"
+ $"4105 473B 0505 113B DE41 0239 0000 1A02"
+ $"00F5 40F3 410C 473B 053B 4741 4741 0B0B"
+ $"3B47 47DE 4102 3900 0018 0200 F540 F341"
+ $"0247 110B FE41 0447 1105 4147 DC41 0233"
+ $"0000 1B02 0000 40F3 4103 4711 1147 FE41"
+ $"0205 3547 F741 FD47 E941 0232 0000 1E02"
+ $"0000 40F2 4106 113B 4741 4735 0BF7 4106"
+ $"4741 390E 0E40 47EA 4102 0E00 0021 0200"
+ $"0040 F241 0711 3B47 4141 0B35 47F9 4102"
+ $"4740 07FE 0002 F640 47EB 4102 0E00 0023"
+ $"0200 0040 F341 0847 3541 4147 3B05 4147"
+ $"FA41 0947 3AF6 00F5 4F55 F50E 47EB 4102"
+ $"0700 0022 0200 003A F341 0147 3BFE 4101"
+ $"0B0B F941 0547 3AF5 0055 C8FE CE01 5640"
+ $"EB41 0207 0000 1F02 0000 39F0 4104 4741"
+ $"053B 47FB 4104 4740 F5F5 A4FC CE01 C85D"
+ $"EB41 02F6 0000 1F02 0000 39F0 4104 473B"
+ $"0541 47FC 4104 4740 07F6 C8FA CE00 64EC"
+ $"4103 40F5 0000 1C02 0000 39F0 4102 4711"
+ $"0BFA 4103 4708 2AC8 FACE 0164 D8EC 4100"
+ $"40FE 0025 0200 0039 EF41 020B 3B47 FC41"
+ $"0347 0FF5 A4FB CE02 C887 D8FC 41FE 47FC"
+ $"4100 47F9 4100 3AFE 0028 0200 0039 EF41"
+ $"020B 3B47 FD41 0347 3900 A4FA CE00 ABFA"
+ $"4109 3B11 3B41 4147 3B0B 3B47 FA41 0039"
+ $"FE00 2402 0000 33F1 4102 4741 0BFA 4101"
+ $"0779 F9CE 0064 FA41 0235 050B FD41 010B"
+ $"0BF9 4100 39FE 0028 0200 0032 F141 0247"
+ $"3B0B FC41 0247 39F6 F9CE 0187 D8FB 4103"
+ $"4741 050B FE41 0247 110B F941 0039 FE00"
+ $"2C02 0000 32F1 4102 473B 11FB 4101 0879"
+ $"FACE 05AA 4041 4147 47FE 410A 4741 0511"
+ $"4741 4147 3511 47FA 4100 32FE 002F 0200"
+ $"000E F141 0347 3B11 47FE 4103 4740 F6C8"
+ $"FACE 0564 D841 4039 39FE 4104 473B 053B"
+ $"47FE 4102 3541 47FA 4100 0EFE 0027 0200"
+ $"000E F141 0347 3B3B 47FE 4102 470F 79FA"
+ $"CE0C 8741 4032 F500 003A 4741 473B 05F2"
+ $"4100 0EFE 0027 0200 000E F141 0347 3B3B"
+ $"47FD 4101 0EA4 FACE 01AB AAFE C808 7900"
+ $"3947 4147 110B 47F3 4100 07FE 001C 0200"
+ $"000E EA41 0240 2BC8 F5CE 0881 0033 4741"
+ $"410B 3B47 F341 0007 FE00 1A02 0000 08EB"
+ $"4102 473A 55F4 CE06 5D00 3947 4741 0BF1"
+ $"4100 F6FE 001C 0200 0007 EB41 0247 3979"
+ $"F4CE 0739 0039 4747 3511 47F3 4101 40F5"
+ $"FE00 1C02 0000 07EB 4102 4739 A4F5 CE08"
+ $"AB0E 0040 4741 1141 47F3 4100 40FD 001B"
+ $"0200 0007 EB41 0247 39A4 F5CE 0787 0707"
+ $"4147 4111 47F2 4100 40FD 001B 0200 0007"
+ $"EB41 0247 39C8 F5CE 0763 F532 4747 3B3B"
+ $"47F2 4100 3AFD 001A 0300 00F6 40EC 4102"
+ $"4739 C8F5 CE05 39F5 4047 413B F041 0039"
+ $"FD00 1C03 0000 F540 EB41 0140 C8FD CE01"
+ $"C8A4 FCCE 03AB 080E 47ED 4100 39FD 001A"
+ $"FE00 0040 EB41 0040 FCCE 01A4 C8FC CE03"
+ $"FA07 4047 ED41 0032 FD00 1AFE 0000 40EA"
+ $"4100 AAFE CE02 87F9 C8FC CE02 560F 47EC"
+ $"4100 32FD 0019 FE00 0040 EA41 00AB FECE"
+ $"0264 56C8 FDCE 01C8 32EA 4100 0EFD 001B"
+ $"FE00 0040 ED41 030E 4047 87FE CE01 4055"
+ $"FCCE 01FA 40EA 4100 08FD 001A FE00 003A"
+ $"ED41 0807 0740 FBCE CEAB 3979 FDCE 00AB"
+ $"E841 0007 FD00 1CFE 0000 3AED 4108 0700"
+ $"F6A4 CECE 8733 79FD CE02 4147 47EA 4100"
+ $"07FD 001E FE00 0039 ED41 0807 2AA4 C8CE"
+ $"CE88 0E9D FECE 0364 1C39 39EB 4101 40F5"
+ $"FD00 1CFE 0000 39ED 4101 074F FDCE 0264"
+ $"F7A4 FECE 03AB 80F6 07EB 4100 40FC 001C"
+ $"FE00 0039 ED41 0108 79FE CE03 AB40 2BA4"
+ $"FCCE 02F7 0E47 EC41 0040 FC00 1CFE 0000"
+ $"39ED 4101 0879 FECE 03AB 40F6 C8FC CE02"
+ $"F615 47EC 4100 40FC 001E FE00 003A EE41"
+ $"0247 0E79 FECE 03AB 40F5 C8FD CE03 A4F5"
+ $"3A47 EC41 0040 FC00 1EFE 0000 3AEE 4102"
+ $"470E 56FE CE03 FB3A F6C8 FDCE 0280 F540"
+ $"EB41 0140 F5FD 001E FE00 0040 EE41 0947"
+ $"0F56 CECE C888 39F6 C8FD CE02 5601 40EB"
+ $"4101 40F5 FD00 1CFE 0000 40EE 4109 4739"
+ $"32CE CEC8 8839 2AC8 FDCE 0156 07E9 4100"
+ $"F6FD 001B FE00 0040 EE41 0847 3A32 CECE"
+ $"C864 152A FCCE 0132 07E9 4100 07FD 001A"
+ $"FE00 0040 ED41 0740 32AB CEC8 6439 4EFC"
+ $"CE01 3A07 E941 0007 FD00 1D03 0000 F540"
+ $"ED41 0740 0EAB CECE 640F 4EFD CE03 AB40"
+ $"0840 EA41 0007 FD00 1B03 0000 F540 EC41"
+ $"060F 81CE CE64 334E FDCE 02AB 400E E941"
+ $"000E FD00 1C02 0000 F6EC 4107 4715 FACE"
+ $"CE64 334E FDCE 0387 0F0E 47EA 4100 0EFD"
+ $"001C 0200 0007 EC41 0747 16F9 CEC8 6433"
+ $"4EFD CE03 6308 4047 EA41 000E FD00 1A02"
+ $"0000 07EB 4106 40F9 CEC8 6439 4EFD CE02"
+ $"3940 47E9 4100 32FD 001B 0200 0007 EA41"
+ $"0539 CECE 8839 F6FE CE04 AB41 4139 40EA"
+ $"4100 32FD 001C 0200 0007 EB41 0E47 3AC8"
+ $"CE88 39F6 C8CE CE64 15F6 F540 EA41 0033"
+ $"FD00 1A02 0000 07EA 410C 40A4 CE87 392A"
+ $"C8CE AB41 40F8 F6E9 4100 39FD 001B 0200"
+ $"000E EB41 0D47 41AB C887 39F5 C8CE ABAB"
+ $"CEA4 07E9 4100 39FD 001C 0200 000E ED41"
+ $"0947 3939 4787 C8AB 40F5 C8FD CE01 A40E"
+ $"E941 0039 FD00 1D02 0000 0EED 4109 473A"
+ $"0007 80CE AB40 F5C8 FDCE 0255 0E47 EA41"
+ $"0039 FD00 1B02 0000 0EEB 4107 0779 C8CE"
+ $"CE40 F6A4 FDCE 022B 3947 EA41 003A FD00"
+ $"1C02 0000 0EEC 4102 4739 79FE CE02 6407"
+ $"A4FE CE02 A407 40E9 4100 40FD 001A 0200"
+ $"0032 EA41 0632 A4CE CE88 0879 FECE 02F9"
+ $"0F47 E941 0040 FD00 1A02 0000 32EB 4107"
+ $"4740 F7C8 CE87 0E79 FECE 0132 40E8 4100"
+ $"40FD 0019 0200 0033 EA41 0B47 40F8 C8AB"
+ $"0E55 CECE 8015 47E8 4100 40FD 0017 0200"
+ $"0033 E941 0847 40F9 A439 4FCE CE5D E641"
+ $"0140 F5FE 0014 0200 0039 E841 0647 64FB"
+ $"392B C8AB E441 00F6 FE00 1102 0000 39E5"
+ $"4103 40F6 8764 E441 0007 FE00 1E02 0000"
+ $"39EB 4102 3A0E 0EFD 4102 0740 47F6 4104"
+ $"400F 0839 47F4 4100 07FE 0027 0200 0039"
+ $"FB41 0147 47F2 4102 0800 40FE 4102 0839"
+ $"47FC 4101 4747 FC41 0339 0039 47F4 4100"
+ $"07FE 0029 0200 0039 FB41 0140 39F3 4109"
+ $"470E F540 4141 470E 3347 FC41 0139 3AFD"
+ $"4104 4739 0039 47F4 4100 08FE 0036 0200"
+ $"003A FC41 0347 0E00 40FC 4102 4741 40FC"
+ $"4109 470E F540 4141 4733 0E47 FE41 0447"
+ $"4000 0E47 FE41 0447 3900 3941 FE40 F741"
+ $"000E FE00 3A02 0000 3AFD 410E 4740 0700"
+ $"0E40 4741 4147 390E 390E 40FE 4108 470E"
+ $"F540 4141 4739 0EFC 4103 0F00 0739 FE41"
+ $"0747 3900 3940 080F 39F7 4100 0EFE 0035"
+ $"0200 0040 FB41 020E 0040 FE41 0D47 4000"
+ $"3941 0032 4741 4147 0EF5 40FE 4101 4008"
+ $"FC41 023A 000E FD41 0547 3900 3939 33F5"
+ $"4100 0EFE 0039 0200 0040 FC41 0347 0E00"
+ $"40FE 4106 4732 0040 4139 40FE 4103 470E"
+ $"F540 FD41 0108 40FE 4104 4740 000E 47FE"
+ $"4106 4739 0007 F540 47F6 4100 32FE 003A"
+ $"0200 0040 FC41 0C47 0E00 4047 4141 470E"
+ $"0040 4747 FD41 0347 0EF5 40FE 410A 470E"
+ $"3947 4141 4740 000E 47FE 4107 4739 000E"
+ $"0007 4147 F741 0032 FE00 3802 0000 40FC"
+ $"4102 470E 00FD 4106 4739 003A 4740 39FE"
+ $"4102 470E F5FD 410A 4733 3347 4141 4740"
+ $"000E 47FE 4106 4739 0039 3900 0EF6 4100"
+ $"33FE 003A 0200 F540 FC41 0447 3200 0E39"
+ $"FD41 0B0E 0E40 333A 4741 413A 07F5 39FE"
+ $"4102 473A 0EFD 410F 40F5 0733 4041 4140"
+ $"0E00 0E40 0700 0E40 F841 0039 FE00 2902"
+ $"00F5 40FA 4101 3939 FB41 023A 3A40 FD41"
+ $"FD40 FD41 0240 0E40 FD41 0240 3940 FD41"
+ $"FA40 F741 0039 FE00 2A01 00F6 F941 0147"
+ $"47FB 4101 4747 FB41 0147 47FB 4101 3940"
+ $"FD41 0147 47FB 4100 47FE 4100 47F6 4100"
+ $"39FE 000D 0100 07E1 4100 40E4 4100 3AFE"
+ $"0009 0100 07C3 4100 3AFE 0009 0100 07C3"
+ $"4100 40FE 0009 0100 07C3 4100 40FE 0009"
+ $"0100 07C3 4100 40FE 000A 0100 0EC3 4103"
+ $"40F5 0000 0901 000E C241 02F6 0000 0901"
+ $"000E C241 0207 0000 0901 000E C241 0207"
+ $"0000 1101 000E ED41 FE40 003A F940 E241"
+ $"0207 0000 2B01 0032 F941 FE40 FE39 0632"
+ $"0E0E 0707 F6F5 F800 02F5 F5F6 FB07 FB0E"
+ $"0332 3233 33FB 3901 3A3A FB40 0207 0000"
+ $"0E0A 000E 3939 320E 0E07 07F6 F5C8 0002"
+ $"BD00 00FF"
+};
+
+/*
+ * Here is the custom file open dialog. This dialog is used instead of
+ * the default file dialog if the -filetypes flag is specified.
+ */
+
+resource 'DLOG' (130, purgeable) {
+ {0, 0, 195, 344}, dBoxProc, invisible, noGoAway, 0,
+ 130, "", noAutoCenter
+};
+
+resource 'DITL' (130, "File Open Box", purgeable) {
+ {
+ {135, 252, 155, 332}, Button {enabled, "Open"},
+ {104, 252, 124, 332}, Button {enabled, "Cancel"},
+ { 0, 0, 0, 0}, HelpItem {disabled, HMScanhdlg {130}},
+ { 8, 235, 24, 337}, UserItem {enabled},
+ { 32, 252, 52, 332}, Button {enabled, "Eject"},
+ { 60, 252, 80, 332}, Button {enabled, "Desktop"},
+ { 29, 12, 159, 230}, UserItem {enabled},
+ { 6, 12, 25, 230}, UserItem {enabled},
+ { 91, 251, 92, 333}, Picture {disabled, 11},
+ {168, 20, 187, 300}, Control {enabled, 131}
+ }
+};
+
+resource 'CNTL' (131, "File Types menu", purgeable) {
+ {168, 20, 187, 300},
+ popupTitleLeftJust,
+ visible,
+ 80,
+ 132,
+ popupMenuCDEFProc,
+ 0,
+ "File Type:"
+};
+
+
+resource 'MENU' (132, preload) {
+ 132,
+ textMenuProc,
+ 0xFFFF, enabled, "", {}
+};
diff --git a/tk/mac/tkMacScale.c b/tk/mac/tkMacScale.c
new file mode 100644
index 00000000000..600a96e027b
--- /dev/null
+++ b/tk/mac/tkMacScale.c
@@ -0,0 +1,603 @@
+/*
+ * 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$
+ */
+
+#include "tkScale.h"
+#include "tkInt.h"
+#include <Controls.h>
+#include "tkMacInt.h"
+
+/*
+ * Defines used in this file.
+ */
+#define slider 1110
+#define inSlider 1
+#define inInc 2
+#define inDecr 3
+
+/*
+ * Declaration of Macintosh specific scale structure.
+ */
+
+typedef struct MacScale {
+ TkScale info; /* Generic scale info. */
+ int flags; /* Flags. */
+ ControlRef scaleHandle; /* Handle to the Scale control struct. */
+} MacScale;
+
+/*
+ * Globals uses locally in this file.
+ */
+static ControlActionUPP scaleActionProc = NULL; /* Pointer to func. */
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void MacScaleEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static pascal void ScaleActionProc _ANSI_ARGS_((ControlRef theControl,
+ ControlPartCode partCode));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCreateScale --
+ *
+ * Allocate a new TkScale structure.
+ *
+ * Results:
+ * Returns a newly allocated TkScale structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkScale *
+TkpCreateScale(tkwin)
+ Tk_Window tkwin;
+{
+ MacScale *macScalePtr;;
+
+ macScalePtr = (MacScale *) ckalloc(sizeof(MacScale));
+ macScalePtr->scaleHandle = NULL;
+ if (scaleActionProc == NULL) {
+ scaleActionProc = NewControlActionProc(ScaleActionProc);
+ }
+
+ Tk_CreateEventHandler(tkwin, ButtonPressMask,
+ MacScaleEventProc, (ClientData) macScalePtr);
+
+ return (TkScale *) macScalePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyScale --
+ *
+ * Free Macintosh specific resources.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * The slider control is destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyScale(scalePtr)
+ TkScale *scalePtr;
+{
+ MacScale *macScalePtr = (MacScale *) scalePtr;
+
+ /*
+ * Free Macintosh control.
+ */
+ if (macScalePtr->scaleHandle != NULL) {
+ DisposeControl(macScalePtr->scaleHandle);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDisplayScale --
+ *
+ * This procedure is invoked as an idle handler to redisplay
+ * the contents of a scale widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The scale gets redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDisplayScale(clientData)
+ ClientData clientData; /* Widget record for scale. */
+{
+ TkScale *scalePtr = (TkScale *) clientData;
+ Tk_Window tkwin = scalePtr->tkwin;
+ Tcl_Interp *interp = scalePtr->interp;
+ int result;
+ char string[PRINT_CHARS];
+ MacScale *macScalePtr = (MacScale *) clientData;
+ Rect r;
+ WindowRef windowRef;
+ GWorldPtr destPort;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ MacDrawable *macDraw;
+
+ if ((scalePtr->tkwin == NULL) || !Tk_IsMapped(scalePtr->tkwin)) {
+ goto done;
+ }
+
+ /*
+ * Invoke the scale's command if needed.
+ */
+
+ Tcl_Preserve((ClientData) scalePtr);
+ if ((scalePtr->flags & INVOKE_COMMAND) && (scalePtr->command != NULL)) {
+ Tcl_Preserve((ClientData) interp);
+ 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;
+ if (scalePtr->tkwin == NULL) {
+ Tcl_Release((ClientData) scalePtr);
+ return;
+ }
+ Tcl_Release((ClientData) scalePtr);
+
+ /*
+ * Now handle the part of redisplay that is the same for
+ * horizontal and vertical scales: border and traversal
+ * highlight.
+ */
+
+ if (scalePtr->highlightWidth != 0) {
+ GC gc;
+
+ if (scalePtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(scalePtr->highlightColorPtr, Tk_WindowId(tkwin));
+ } else {
+ gc = Tk_GCForColor(scalePtr->highlightBgColorPtr, Tk_WindowId(tkwin));
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, scalePtr->highlightWidth, Tk_WindowId(tkwin));
+ }
+ Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin), scalePtr->bgBorder,
+ scalePtr->highlightWidth, scalePtr->highlightWidth,
+ Tk_Width(tkwin) - 2*scalePtr->highlightWidth,
+ Tk_Height(tkwin) - 2*scalePtr->highlightWidth,
+ scalePtr->borderWidth, scalePtr->relief);
+
+ /*
+ * Set up port for drawing Macintosh control.
+ */
+ macDraw = (MacDrawable *) Tk_WindowId(tkwin);
+ destPort = TkMacGetDrawablePort(Tk_WindowId(tkwin));
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+ TkMacSetUpClippingRgn(Tk_WindowId(tkwin));
+
+ /*
+ * Create Macintosh control.
+ */
+ if (macScalePtr->scaleHandle == NULL) {
+ r.left = r.top = 0;
+ r.right = r.bottom = 1;
+ /* TODO: initial value. */
+ /* 16*slider+4 */
+ macScalePtr->scaleHandle = NewControl((WindowRef) destPort,
+ &r, "\p", false, (short) 35, 0, 1000,
+ 16*slider, (SInt32) macScalePtr);
+
+ /*
+ * If we are foremost than make us active.
+ */
+ if ((WindowPtr) destPort == FrontWindow()) {
+ macScalePtr->flags |= ACTIVE;
+ }
+ }
+ windowRef = (**macScalePtr->scaleHandle).contrlOwner;
+
+ /*
+ * We can't use the Macintosh commands SizeControl and MoveControl as these
+ * calls will also cause a redraw which in our case will also cause
+ * flicker. To avoid this we adjust the control record directly. The
+ * Draw1Control command appears to just draw where ever the control says to
+ * draw so this seems right.
+ *
+ * NOTE: changing the control record directly may not work when
+ * Apple releases the Copland version of the MacOS in late 1996.
+ */
+
+ (**macScalePtr->scaleHandle).contrlRect.left = macDraw->xOff + scalePtr->inset;
+ (**macScalePtr->scaleHandle).contrlRect.top = macDraw->yOff + scalePtr->inset;
+ (**macScalePtr->scaleHandle).contrlRect.right = macDraw->xOff + Tk_Width(tkwin)
+ - scalePtr->inset;
+ (**macScalePtr->scaleHandle).contrlRect.bottom = macDraw->yOff +
+ Tk_Height(tkwin) - scalePtr->inset;
+
+ /*
+ * Set the thumb and resolution etc.
+ */
+ (**macScalePtr->scaleHandle).contrlMin = (SInt16) scalePtr->toValue;
+ (**macScalePtr->scaleHandle).contrlMax = (SInt16) scalePtr->fromValue;
+ (**macScalePtr->scaleHandle).contrlValue = (SInt16) scalePtr->value;
+
+ /*
+ * Finally draw the control.
+ */
+ (**macScalePtr->scaleHandle).contrlVis = 255;
+ (**macScalePtr->scaleHandle).contrlHilite = 0;
+ Draw1Control(macScalePtr->scaleHandle);
+
+ SetGWorld(saveWorld, saveDevice);
+
+ done:
+ scalePtr->flags &= ~REDRAW_ALL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpScaleElement --
+ *
+ * Determine which part of a scale widget lies under a given
+ * point.
+ *
+ * Results:
+ * The return value is either TROUGH1, SLIDER, TROUGH2, or
+ * OTHER, depending on which of the scale's active elements
+ * (if any) is under the point at (x,y).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpScaleElement(scalePtr, x, y)
+ TkScale *scalePtr; /* Widget record for scale. */
+ int x, y; /* Coordinates within scalePtr's window. */
+{
+ MacScale *macScalePtr = (MacScale *) scalePtr;
+ ControlPartCode part;
+ Point where;
+ Rect bounds;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+
+ destPort = TkMacGetDrawablePort(Tk_WindowId(scalePtr->tkwin));
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+
+ /*
+ * All of the calculations in this procedure mirror those in
+ * DisplayScrollbar. Be sure to keep the two consistent.
+ */
+
+ TkMacWinBounds((TkWindow *) scalePtr->tkwin, &bounds);
+ where.h = x + bounds.left;
+ where.v = y + bounds.top;
+ part = TestControl(macScalePtr->scaleHandle, where);
+
+ SetGWorld(saveWorld, saveDevice);
+
+ switch (part) {
+ case inSlider:
+ return SLIDER;
+ case inInc:
+ if (scalePtr->vertical) {
+ return TROUGH1;
+ } else {
+ return TROUGH2;
+ }
+ case inDecr:
+ if (scalePtr->vertical) {
+ return TROUGH2;
+ } else {
+ return TROUGH1;
+ }
+ default:
+ return OTHER;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpSetScaleValue --
+ *
+ * This procedure changes the value of a scale and invokes
+ * a Tcl command to reflect the current position of a scale
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Tcl command is invoked, and an additional error-processing
+ * command may also be invoked. The scale's slider is redrawn.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpSetScaleValue(scalePtr, value, setVar, invokeCommand)
+ register TkScale *scalePtr; /* Info about widget. */
+ double value; /* New value for scale. Gets adjusted
+ * if it's off the scale. */
+ int setVar; /* Non-zero means reflect new value through
+ * to associated variable, if any. */
+ int invokeCommand; /* Non-zero means invoked -command option
+ * to notify of new value, 0 means don't. */
+{
+ char string[PRINT_CHARS];
+
+ value = TkRoundToResolution(scalePtr, value);
+ if ((value < scalePtr->fromValue)
+ ^ (scalePtr->toValue < scalePtr->fromValue)) {
+ value = scalePtr->fromValue;
+ }
+ if ((value > scalePtr->toValue)
+ ^ (scalePtr->toValue < scalePtr->fromValue)) {
+ value = scalePtr->toValue;
+ }
+ if (scalePtr->flags & NEVER_SET) {
+ scalePtr->flags &= ~NEVER_SET;
+ } else if (scalePtr->value == value) {
+ return;
+ }
+ 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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpPixelToValue --
+ *
+ * Given a pixel within a scale window, return the scale
+ * reading corresponding to that pixel.
+ *
+ * Results:
+ * A double-precision scale reading. If the value is outside
+ * the legal range for the scale then it's rounded to the nearest
+ * end of the scale.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+double
+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;
+ }
+
+ if (pixelRange <= 0) {
+ /*
+ * Not enough room for the slider to actually slide: just return
+ * the scale's current value.
+ */
+
+ return scalePtr->value;
+ }
+ value -= scalePtr->sliderLength/2 + scalePtr->inset
+ + scalePtr->borderWidth;
+ value /= pixelRange;
+ if (value < 0) {
+ value = 0;
+ }
+ if (value > 1) {
+ value = 1;
+ }
+ value = scalePtr->fromValue +
+ value * (scalePtr->toValue - scalePtr->fromValue);
+ return TkRoundToResolution(scalePtr, value);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpValueToPixel --
+ *
+ * Given a reading of the scale, return the x-coordinate or
+ * y-coordinate corresponding to that reading, depending on
+ * whether the scale is vertical or horizontal, respectively.
+ *
+ * Results:
+ * An integer value giving the pixel location corresponding
+ * to reading. The value is restricted to lie within the
+ * defined range for the scale.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpValueToPixel(scalePtr, value)
+ 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);
+ if (y < 0) {
+ y = 0;
+ } else if (y > pixelRange) {
+ y = pixelRange;
+ }
+ }
+ y += scalePtr->sliderLength/2 + scalePtr->inset + scalePtr->borderWidth;
+ return y;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * MacScaleEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for
+ * ButtonPress events on scales.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+MacScaleEventProc(clientData, eventPtr)
+ ClientData clientData; /* Information about window. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ MacScale *macScalePtr = (MacScale *) clientData;
+ Point where;
+ Rect bounds;
+ int part, x, y, dummy;
+ unsigned int state;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+ Window dummyWin;
+
+ /*
+ * To call Macintosh control routines we must have the port
+ * set to the window containing the control. We will then test
+ * which part of the control was hit and act accordingly.
+ */
+ destPort = TkMacGetDrawablePort(Tk_WindowId(macScalePtr->info.tkwin));
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+ TkMacSetUpClippingRgn(Tk_WindowId(macScalePtr->info.tkwin));
+
+ TkMacWinBounds((TkWindow *) macScalePtr->info.tkwin, &bounds);
+ where.h = eventPtr->xbutton.x + bounds.left;
+ where.v = eventPtr->xbutton.y + bounds.top;
+ part = TestControl(macScalePtr->scaleHandle, where);
+ if (part == 0) {
+ return;
+ }
+
+ part = TrackControl(macScalePtr->scaleHandle, where, scaleActionProc);
+
+ /*
+ * Update the value for the widget.
+ */
+ macScalePtr->info.value = (**macScalePtr->scaleHandle).contrlValue;
+ /* TkpSetScaleValue(&macScalePtr->info, macScalePtr->info.value, 1, 0); */
+
+ /*
+ * The TrackControl call will "eat" the ButtonUp event. We now
+ * generate a ButtonUp event so Tk will unset implicit grabs etc.
+ */
+ GetMouse(&where);
+ XQueryPointer(NULL, None, &dummyWin, &dummyWin, &x,
+ &y, &dummy, &dummy, &state);
+ TkGenerateButtonEvent(x, y, Tk_WindowId(macScalePtr->info.tkwin), state);
+
+ SetGWorld(saveWorld, saveDevice);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScaleActionProc --
+ *
+ * Callback procedure used by the Macintosh toolbox call
+ * TrackControl. This call will update the display while
+ * the scrollbar is being manipulated by the user.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May change the display.
+ *
+ *--------------------------------------------------------------
+ */
+
+static pascal void
+ScaleActionProc(ControlRef theControl, ControlPartCode partCode)
+ /* ControlRef theControl; /* Handle to scrollbat control */
+ /* ControlPartCode partCode; /* Part of scrollbar that was "hit" */
+{
+ register int value;
+ register TkScale *scalePtr = (TkScale *) GetCRefCon(theControl);
+
+ value = (**theControl).contrlValue;
+ TkpSetScaleValue(scalePtr, value, 1, 1);
+ Tcl_Preserve((ClientData) scalePtr);
+ Tcl_DoOneEvent(TCL_IDLE_EVENTS);
+ Tcl_Release((ClientData) scalePtr);
+}
+
diff --git a/tk/mac/tkMacScrlbr.c b/tk/mac/tkMacScrlbr.c
new file mode 100644
index 00000000000..d3e67b28d9e
--- /dev/null
+++ b/tk/mac/tkMacScrlbr.c
@@ -0,0 +1,1057 @@
+/*
+ * 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$
+ */
+
+#include "tkScrollbar.h"
+#include "tkMacInt.h"
+#include <Controls.h>
+
+/*
+ * The following definitions should really be in MacOS
+ * header files. They are included here as this is the only
+ * file that needs the declarations.
+ */
+typedef pascal void (*ThumbActionFunc)(void);
+
+#if GENERATINGCFM
+typedef UniversalProcPtr ThumbActionUPP;
+#else
+typedef ThumbActionFunc ThumbActionUPP;
+#endif
+
+enum {
+ uppThumbActionProcInfo = kPascalStackBased
+};
+
+#if GENERATINGCFM
+#define NewThumbActionProc(userRoutine) \
+ (ThumbActionUPP) NewRoutineDescriptor((ProcPtr)(userRoutine), uppThumbActionProcInfo, GetCurrentArchitecture())
+#else
+#define NewThumbActionProc(userRoutine) \
+ ((ThumbActionUPP) (userRoutine))
+#endif
+
+/*
+ * Minimum slider length, in pixels (designed to make sure that the slider
+ * is always easy to grab with the mouse).
+ */
+
+#define MIN_SLIDER_LENGTH 5
+
+/*
+ * Declaration of Windows specific scrollbar structure.
+ */
+
+typedef struct MacScrollbar {
+ TkScrollbar info; /* Generic scrollbar info. */
+ ControlRef sbHandle; /* Handle to the Scrollbar control struct. */
+ int macFlags; /* Various flags; see below. */
+} MacScrollbar;
+
+/*
+ * Flag bits for scrollbars on the Mac:
+ *
+ * ALREADY_DEAD: Non-zero means this scrollbar has been
+ * destroyed, but has not been cleaned up.
+ * IN_MODAL_LOOP: Non-zero means this scrollbar is in the middle
+ * of a modal loop.
+ * ACTIVE: Non-zero means this window is currently
+ * active (in the foreground).
+ * FLUSH_TOP: Flush with top of Mac window.
+ * FLUSH_BOTTOM: Flush with bottom of Mac window.
+ * FLUSH_RIGHT: Flush with right of Mac window.
+ * FLUSH_LEFT: Flush with left of Mac window.
+ * SCROLLBAR_GROW: Non-zero means this window draws the grow
+ * region for the toplevel window.
+ * AUTO_ADJUST: Non-zero means we automatically adjust
+ * the size of the widget to align correctly
+ * along a Mac window.
+ * DRAW_GROW: Non-zero means we draw the grow region.
+ */
+
+#define ALREADY_DEAD 1
+#define IN_MODAL_LOOP 2
+#define ACTIVE 4
+#define FLUSH_TOP 8
+#define FLUSH_BOTTOM 16
+#define FLUSH_RIGHT 32
+#define FLUSH_LEFT 64
+#define SCROLLBAR_GROW 128
+#define AUTO_ADJUST 256
+#define DRAW_GROW 512
+
+/*
+ * Globals uses locally in this file.
+ */
+static ControlActionUPP scrollActionProc = NULL; /* Pointer to func. */
+static ThumbActionUPP thumbActionProc = NULL; /* Pointer to func. */
+static TkScrollbar *activeScrollPtr = NULL; /* Non-null when in thumb */
+ /* proc. */
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static pascal void ScrollbarActionProc _ANSI_ARGS_((ControlRef theControl,
+ ControlPartCode partCode));
+static int ScrollbarBindProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, XEvent *eventPtr,
+ Tk_Window tkwin, KeySym keySym));
+static void ScrollbarEventProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static pascal void ThumbActionProc _ANSI_ARGS_((void));
+static void UpdateControlValues _ANSI_ARGS_((MacScrollbar *macScrollPtr));
+
+/*
+ * The class procedure table for the scrollbar widget.
+ */
+
+TkClassProcs tkpScrollbarProcs = {
+ NULL, /* createProc. */
+ NULL, /* geometryProc. */
+ NULL /* modalProc */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCreateScrollbar --
+ *
+ * Allocate a new TkScrollbar structure.
+ *
+ * Results:
+ * Returns a newly allocated TkScrollbar structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkScrollbar *
+TkpCreateScrollbar(
+ Tk_Window tkwin) /* New Tk Window. */
+{
+ MacScrollbar * macScrollPtr;
+ TkWindow *winPtr = (TkWindow *)tkwin;
+
+ if (scrollActionProc == NULL) {
+ scrollActionProc = NewControlActionProc(ScrollbarActionProc);
+ thumbActionProc = NewThumbActionProc(ThumbActionProc);
+ }
+
+ macScrollPtr = (MacScrollbar *) ckalloc(sizeof(MacScrollbar));
+ macScrollPtr->sbHandle = NULL;
+ macScrollPtr->macFlags = 0;
+
+ Tk_CreateEventHandler(tkwin, ActivateMask|ExposureMask|
+ StructureNotifyMask|FocusChangeMask,
+ ScrollbarEventProc, (ClientData) macScrollPtr);
+
+ if (!Tcl_GetAssocData(winPtr->mainPtr->interp, "TkScrollbar", NULL)) {
+ Tcl_SetAssocData(winPtr->mainPtr->interp, "TkScrollbar", NULL,
+ (ClientData)1);
+ TkCreateBindingProcedure(winPtr->mainPtr->interp,
+ winPtr->mainPtr->bindingTable,
+ (ClientData)Tk_GetUid("Scrollbar"), "<ButtonPress>",
+ ScrollbarBindProc, NULL, NULL);
+ }
+
+ return (TkScrollbar *) macScrollPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpDisplayScrollbar --
+ *
+ * This procedure redraws the contents of a scrollbar window.
+ * It is invoked as a do-when-idle handler, so it only runs
+ * when there's nothing else for the application to do.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpDisplayScrollbar(
+ ClientData clientData) /* Information about window. */
+{
+ register TkScrollbar *scrollPtr = (TkScrollbar *) clientData;
+ register MacScrollbar *macScrollPtr = (MacScrollbar *) clientData;
+ register Tk_Window tkwin = scrollPtr->tkwin;
+
+ MacDrawable *macDraw;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+ WindowRef windowRef;
+
+ if ((scrollPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ goto done;
+ }
+
+ /*
+ * Draw the focus or any 3D relief we may have.
+ */
+ if (scrollPtr->highlightWidth != 0) {
+ GC gc;
+
+ if (scrollPtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(scrollPtr->highlightColorPtr,
+ Tk_WindowId(tkwin));
+ } else {
+ gc = Tk_GCForColor(scrollPtr->highlightBgColorPtr,
+ Tk_WindowId(tkwin));
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, scrollPtr->highlightWidth,
+ Tk_WindowId(tkwin));
+ }
+ Tk_Draw3DRectangle(tkwin, Tk_WindowId(tkwin), scrollPtr->bgBorder,
+ scrollPtr->highlightWidth, scrollPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*scrollPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*scrollPtr->highlightWidth,
+ scrollPtr->borderWidth, scrollPtr->relief);
+
+ /*
+ * Set up port for drawing Macintosh control.
+ */
+ macDraw = (MacDrawable *) Tk_WindowId(tkwin);
+ destPort = TkMacGetDrawablePort(Tk_WindowId(tkwin));
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+ TkMacSetUpClippingRgn(Tk_WindowId(tkwin));
+
+ if (macScrollPtr->sbHandle == NULL) {
+ Rect r;
+
+ r.left = r.top = 0;
+ r.right = r.bottom = 1;
+ macScrollPtr->sbHandle = NewControl((WindowRef) destPort, &r, "\p",
+ false, (short) 500, 0, 1000,
+ scrollBarProc, (SInt32) scrollPtr);
+
+ /*
+ * If we are foremost than make us active.
+ */
+ if ((WindowPtr) destPort == FrontWindow()) {
+ macScrollPtr->macFlags |= ACTIVE;
+ }
+ }
+
+ /*
+ * Update the control values before we draw.
+ */
+ windowRef = (**macScrollPtr->sbHandle).contrlOwner;
+ UpdateControlValues(macScrollPtr);
+
+ if (macScrollPtr->macFlags & ACTIVE) {
+ Draw1Control(macScrollPtr->sbHandle);
+ if (macScrollPtr->macFlags & DRAW_GROW) {
+ DrawGrowIcon(windowRef);
+ }
+ } else {
+ (**macScrollPtr->sbHandle).contrlHilite = 255;
+ Draw1Control(macScrollPtr->sbHandle);
+ if (macScrollPtr->macFlags & DRAW_GROW) {
+ DrawGrowIcon(windowRef);
+ Tk_Fill3DRectangle(tkwin, Tk_WindowId(tkwin), scrollPtr->bgBorder,
+ Tk_Width(tkwin) - 13, Tk_Height(tkwin) - 13,
+ Tk_Width(tkwin), Tk_Height(tkwin),
+ 0, TK_RELIEF_FLAT);
+ }
+ }
+
+ SetGWorld(saveWorld, saveDevice);
+
+ done:
+ scrollPtr->flags &= ~REDRAW_PENDING;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpConfigureScrollbar --
+ *
+ * This procedure is called after the generic code has finished
+ * processing configuration options, in order to configure
+ * platform specific options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpConfigureScrollbar(scrollPtr)
+ register TkScrollbar *scrollPtr; /* Information about widget; may or
+ * may not already have values for
+ * some fields. */
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpComputeScrollbarGeometry --
+ *
+ * After changes in a scrollbar's size or configuration, this
+ * procedure recomputes various geometry information used in
+ * displaying the scrollbar.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The scrollbar will be displayed differently.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpComputeScrollbarGeometry(
+ register TkScrollbar *scrollPtr) /* Scrollbar whose geometry may
+ * have changed. */
+{
+ MacScrollbar *macScrollPtr = (MacScrollbar *) scrollPtr;
+ int width, fieldLength, adjust = 0;
+
+ if (scrollPtr->highlightWidth < 0) {
+ scrollPtr->highlightWidth = 0;
+ }
+ scrollPtr->inset = scrollPtr->highlightWidth + scrollPtr->borderWidth;
+ width = (scrollPtr->vertical) ? Tk_Width(scrollPtr->tkwin)
+ : Tk_Height(scrollPtr->tkwin);
+ scrollPtr->arrowLength = width - 2*scrollPtr->inset + 1;
+ fieldLength = (scrollPtr->vertical ? Tk_Height(scrollPtr->tkwin)
+ : Tk_Width(scrollPtr->tkwin))
+ - 2*(scrollPtr->arrowLength + scrollPtr->inset);
+ if (fieldLength < 0) {
+ fieldLength = 0;
+ }
+ scrollPtr->sliderFirst = fieldLength*scrollPtr->firstFraction;
+ scrollPtr->sliderLast = fieldLength*scrollPtr->lastFraction;
+
+ /*
+ * Adjust the slider so that some piece of it is always
+ * displayed in the scrollbar and so that it has at least
+ * a minimal width (so it can be grabbed with the mouse).
+ */
+
+ if (scrollPtr->sliderFirst > (fieldLength - 2*scrollPtr->borderWidth)) {
+ scrollPtr->sliderFirst = fieldLength - 2*scrollPtr->borderWidth;
+ }
+ if (scrollPtr->sliderFirst < 0) {
+ scrollPtr->sliderFirst = 0;
+ }
+ if (scrollPtr->sliderLast < (scrollPtr->sliderFirst
+ + MIN_SLIDER_LENGTH)) {
+ scrollPtr->sliderLast = scrollPtr->sliderFirst + MIN_SLIDER_LENGTH;
+ }
+ if (scrollPtr->sliderLast > fieldLength) {
+ scrollPtr->sliderLast = fieldLength;
+ }
+ scrollPtr->sliderFirst += scrollPtr->arrowLength + scrollPtr->inset;
+ scrollPtr->sliderLast += scrollPtr->arrowLength + scrollPtr->inset;
+
+ /*
+ * Register the desired geometry for the window (leave enough space
+ * for the two arrows plus a minimum-size slider, plus border around
+ * the whole window, if any). Then arrange for the window to be
+ * redisplayed.
+ */
+
+ if (scrollPtr->vertical) {
+ if ((macScrollPtr->macFlags & AUTO_ADJUST) &&
+ (macScrollPtr->macFlags & (FLUSH_RIGHT|FLUSH_LEFT))) {
+ adjust--;
+ }
+ Tk_GeometryRequest(scrollPtr->tkwin,
+ scrollPtr->width + 2*scrollPtr->inset + adjust,
+ 2*(scrollPtr->arrowLength + scrollPtr->borderWidth
+ + scrollPtr->inset));
+ } else {
+ if ((macScrollPtr->macFlags & AUTO_ADJUST) &&
+ (macScrollPtr->macFlags & (FLUSH_TOP|FLUSH_BOTTOM))) {
+ adjust--;
+ }
+ Tk_GeometryRequest(scrollPtr->tkwin,
+ 2*(scrollPtr->arrowLength + scrollPtr->borderWidth
+ + scrollPtr->inset), scrollPtr->width + 2*scrollPtr->inset + adjust);
+ }
+ Tk_SetInternalBorder(scrollPtr->tkwin, scrollPtr->inset);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyScrollbar --
+ *
+ * Free data structures associated with the scrollbar control.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyScrollbar(
+ TkScrollbar *scrollPtr) /* Scrollbar to destroy. */
+{
+ MacScrollbar *macScrollPtr = (MacScrollbar *)scrollPtr;
+
+ if (macScrollPtr->sbHandle != NULL) {
+ if (!(macScrollPtr->macFlags & IN_MODAL_LOOP)) {
+ DisposeControl(macScrollPtr->sbHandle);
+ macScrollPtr->sbHandle = NULL;
+ }
+ }
+ macScrollPtr->macFlags |= ALREADY_DEAD;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpScrollbarPosition --
+ *
+ * Determine the scrollbar element corresponding to a
+ * given position.
+ *
+ * Results:
+ * One of TOP_ARROW, TOP_GAP, etc., indicating which element
+ * of the scrollbar covers the position given by (x, y). If
+ * (x,y) is outside the scrollbar entirely, then OUTSIDE is
+ * returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkpScrollbarPosition(
+ TkScrollbar *scrollPtr, /* Scrollbar widget record. */
+ int x, int y) /* Coordinates within scrollPtr's
+ * window. */
+{
+ MacScrollbar *macScrollPtr = (MacScrollbar *) scrollPtr;
+ GWorldPtr destPort;
+ int length, width, tmp, inactive = false;
+ ControlPartCode part;
+ Point where;
+ Rect bounds;
+
+ if (scrollPtr->vertical) {
+ length = Tk_Height(scrollPtr->tkwin);
+ width = Tk_Width(scrollPtr->tkwin);
+ } else {
+ tmp = x;
+ x = y;
+ y = tmp;
+ length = Tk_Width(scrollPtr->tkwin);
+ width = Tk_Height(scrollPtr->tkwin);
+ }
+
+ if ((x < scrollPtr->inset) || (x >= (width - scrollPtr->inset))
+ || (y < scrollPtr->inset) || (y >= (length - scrollPtr->inset))) {
+ return OUTSIDE;
+ }
+
+ /*
+ * All of the calculations in this procedure mirror those in
+ * DisplayScrollbar. Be sure to keep the two consistent. On the
+ * Macintosh we use the OS call TestControl to do this mapping.
+ * For TestControl to work, the scrollbar must be active and must
+ * be in the current port.
+ */
+
+ destPort = TkMacGetDrawablePort(Tk_WindowId(scrollPtr->tkwin));
+ SetGWorld(destPort, NULL);
+ UpdateControlValues(macScrollPtr);
+ if ((**macScrollPtr->sbHandle).contrlHilite == 255) {
+ inactive = true;
+ (**macScrollPtr->sbHandle).contrlHilite = 0;
+ }
+
+ TkMacWinBounds((TkWindow *) scrollPtr->tkwin, &bounds);
+ where.h = x + bounds.left;
+ where.v = y + bounds.top;
+ part = TestControl(((MacScrollbar *) scrollPtr)->sbHandle, where);
+ if (inactive) {
+ (**macScrollPtr->sbHandle).contrlHilite = 255;
+ }
+ switch (part) {
+ case inUpButton:
+ return TOP_ARROW;
+ case inPageUp:
+ return TOP_GAP;
+ case inThumb:
+ return SLIDER;
+ case inPageDown:
+ return BOTTOM_GAP;
+ case inDownButton:
+ return BOTTOM_ARROW;
+ default:
+ return OUTSIDE;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ThumbActionProc --
+ *
+ * Callback procedure used by the Macintosh toolbox call
+ * TrackControl. This call is used to track the thumb of
+ * the scrollbar. Unlike the ScrollbarActionProc function
+ * this function is called once and basically takes over
+ * tracking the scrollbar from the control. This is done
+ * to avoid conflicts with what the control plans to draw.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May change the display.
+ *
+ *--------------------------------------------------------------
+ */
+
+static pascal void
+ThumbActionProc()
+{
+ register TkScrollbar *scrollPtr = activeScrollPtr;
+ register MacScrollbar *macScrollPtr = (MacScrollbar *) activeScrollPtr;
+ Tcl_DString cmdString;
+ Rect nullRect = {0,0,0,0};
+ int origValue, trackBarPin;
+ double thumbWidth, newFirstFraction, trackBarSize;
+ char vauleString[40];
+ Point currentPoint = { 0, 0 };
+ Point lastPoint = { 0, 0 };
+ Rect trackRect;
+ Tcl_Interp *interp;
+
+ if (scrollPtr == NULL) {
+ return;
+ }
+
+ Tcl_DStringInit(&cmdString);
+
+ /*
+ * First compute values that will remain constant during the tracking
+ * of the thumb. The variable trackBarSize is the length of the scrollbar
+ * minus the 2 arrows and half the width of the thumb on both sides
+ * (3 * arrowLength). The variable trackBarPin is the lower starting point
+ * of the drag region.
+ *
+ * Note: the arrowLength is equal to the thumb width of a Mac scrollbar.
+ */
+ origValue = GetControlValue(macScrollPtr->sbHandle);
+ trackRect = (**macScrollPtr->sbHandle).contrlRect;
+ if (scrollPtr->vertical == true) {
+ trackBarSize = (double) (trackRect.bottom - trackRect.top
+ - (scrollPtr->arrowLength * 3));
+ trackBarPin = trackRect.top + scrollPtr->arrowLength
+ + (scrollPtr->arrowLength / 2);
+ InsetRect(&trackRect, -25, -113);
+
+ } else {
+ trackBarSize = (double) (trackRect.right - trackRect.left
+ - (scrollPtr->arrowLength * 3));
+ trackBarPin = trackRect.left + scrollPtr->arrowLength
+ + (scrollPtr->arrowLength / 2);
+ InsetRect(&trackRect, -113, -25);
+ }
+
+ /*
+ * Track the mouse while the button is held down. If the mouse is moved,
+ * we calculate the value that should be passed to the "command" part of
+ * the scrollbar.
+ */
+ while (StillDown()) {
+ GetMouse(&currentPoint);
+ if (EqualPt(currentPoint, lastPoint)) {
+ continue;
+ }
+ lastPoint = currentPoint;
+
+ /*
+ * Calculating this value is a little tricky. We need to calculate a
+ * value for where the thumb would be in a Motif widget (variable
+ * thumb). This value is what the "command" expects and is what will
+ * be resent to the scrollbar to update its value.
+ */
+ thumbWidth = scrollPtr->lastFraction - scrollPtr->firstFraction;
+ if (PtInRect(currentPoint, &trackRect)) {
+ if (scrollPtr->vertical == true) {
+ newFirstFraction = (1.0 - thumbWidth) *
+ ((double) (currentPoint.v - trackBarPin) / trackBarSize);
+ } else {
+ newFirstFraction = (1.0 - thumbWidth) *
+ ((double) (currentPoint.h - trackBarPin) / trackBarSize);
+ }
+ } else {
+ newFirstFraction = ((double) origValue / 1000.0)
+ * (1.0 - thumbWidth);
+ }
+
+ sprintf(vauleString, "%g", newFirstFraction);
+
+ Tcl_DStringSetLength(&cmdString, 0);
+ Tcl_DStringAppend(&cmdString, scrollPtr->command,
+ scrollPtr->commandSize);
+ Tcl_DStringAppendElement(&cmdString, "moveto");
+ Tcl_DStringAppendElement(&cmdString, vauleString);
+
+ interp = scrollPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ Tcl_GlobalEval(interp, cmdString.string);
+ Tcl_Release((ClientData) interp);
+
+ Tcl_DStringSetLength(&cmdString, 0);
+ Tcl_DStringAppend(&cmdString, "update idletasks",
+ strlen("update idletasks"));
+ Tcl_Preserve((ClientData) interp);
+ Tcl_GlobalEval(interp, cmdString.string);
+ Tcl_Release((ClientData) interp);
+ }
+
+ /*
+ * This next bit of code is a bit of a hack - but needed. The problem is
+ * that the control wants to draw the drag outline if the control value
+ * changes during the drag (which it does). What we do here is change the
+ * clip region to hide this drawing from the user.
+ */
+ ClipRect(&nullRect);
+
+ Tcl_DStringFree(&cmdString);
+ return;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScrollbarActionProc --
+ *
+ * Callback procedure used by the Macintosh toolbox call
+ * TrackControl. This call will update the display while
+ * the scrollbar is being manipulated by the user.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May change the display.
+ *
+ *--------------------------------------------------------------
+ */
+
+static pascal void
+ScrollbarActionProc(
+ ControlRef theControl, /* Handle to scrollbat control */
+ ControlPartCode partCode) /* Part of scrollbar that was "hit" */
+{
+ register TkScrollbar *scrollPtr = (TkScrollbar *) GetCRefCon(theControl);
+ Tcl_DString cmdString;
+
+ Tcl_DStringInit(&cmdString);
+ Tcl_DStringAppend(&cmdString, scrollPtr->command,
+ scrollPtr->commandSize);
+
+ if (partCode == inUpButton || partCode == inDownButton) {
+ Tcl_DStringAppendElement(&cmdString, "scroll");
+ Tcl_DStringAppendElement(&cmdString,
+ (partCode == inUpButton ) ? "-1" : "1");
+ Tcl_DStringAppendElement(&cmdString, "unit");
+ } else if (partCode == inPageUp || partCode == inPageDown) {
+ Tcl_DStringAppendElement(&cmdString, "scroll");
+ Tcl_DStringAppendElement(&cmdString,
+ (partCode == inPageUp ) ? "-1" : "1");
+ Tcl_DStringAppendElement(&cmdString, "page");
+ }
+ Tcl_Preserve((ClientData) scrollPtr->interp);
+ Tcl_DStringAppend(&cmdString, "; update idletasks",
+ strlen("; update idletasks"));
+ Tcl_GlobalEval(scrollPtr->interp, cmdString.string);
+ Tcl_Release((ClientData) scrollPtr->interp);
+
+ Tcl_DStringFree(&cmdString);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScrollbarBindProc --
+ *
+ * This procedure is invoked when the default <ButtonPress>
+ * binding on the Scrollbar bind tag fires.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The event enters a modal loop.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ScrollbarBindProc(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Interp with binding. */
+ XEvent *eventPtr, /* X event that triggered binding. */
+ Tk_Window tkwin, /* Target window for event. */
+ KeySym keySym) /* The KeySym if a key event. */
+{
+ TkWindow *winPtr = (TkWindow*)tkwin;
+ TkScrollbar *scrollPtr = (TkScrollbar *) winPtr->instanceData;
+ MacScrollbar *macScrollPtr = (MacScrollbar *) winPtr->instanceData;
+
+ Tcl_Preserve((ClientData)scrollPtr);
+ macScrollPtr->macFlags |= IN_MODAL_LOOP;
+
+ if (eventPtr->type == ButtonPress) {
+ Point where;
+ Rect bounds;
+ int part, x, y, dummy;
+ unsigned int state;
+ CGrafPtr saveWorld;
+ GDHandle saveDevice;
+ GWorldPtr destPort;
+ Window window;
+
+ /*
+ * To call Macintosh control routines we must have the port
+ * set to the window containing the control. We will then test
+ * which part of the control was hit and act accordingly.
+ */
+ destPort = TkMacGetDrawablePort(Tk_WindowId(scrollPtr->tkwin));
+ GetGWorld(&saveWorld, &saveDevice);
+ SetGWorld(destPort, NULL);
+ TkMacSetUpClippingRgn(Tk_WindowId(scrollPtr->tkwin));
+
+ TkMacWinBounds((TkWindow *) scrollPtr->tkwin, &bounds);
+ where.h = eventPtr->xbutton.x + bounds.left;
+ where.v = eventPtr->xbutton.y + bounds.top;
+ part = TestControl(macScrollPtr->sbHandle, where);
+ if (part == inThumb && scrollPtr->jump == false) {
+ /*
+ * Case 1: In thumb, no jump scrolling. Call track control
+ * with the thumb action proc which will do most of the work.
+ * Set the global activeScrollPtr to the current control
+ * so the callback may have access to it.
+ */
+ activeScrollPtr = scrollPtr;
+ part = TrackControl(macScrollPtr->sbHandle, where,
+ (ControlActionUPP) thumbActionProc);
+ activeScrollPtr = NULL;
+ } else if (part == inThumb) {
+ /*
+ * Case 2: in thumb with jump scrolling. Call TrackControl
+ * with a NULL action proc. Use the new value of the control
+ * to set update the control.
+ */
+ part = TrackControl(macScrollPtr->sbHandle, where, NULL);
+ if (part == inThumb) {
+ double newFirstFraction, thumbWidth;
+ Tcl_DString cmdString;
+ char vauleString[TCL_DOUBLE_SPACE];
+
+ /*
+ * The following calculation takes the new control
+ * value and maps it to what Tk needs for its variable
+ * thumb size representation.
+ */
+ thumbWidth = scrollPtr->lastFraction
+ - scrollPtr->firstFraction;
+ newFirstFraction = (1.0 - thumbWidth) *
+ ((double) GetControlValue(macScrollPtr->sbHandle) / 1000.0);
+ sprintf(vauleString, "%g", newFirstFraction);
+
+ Tcl_DStringInit(&cmdString);
+ Tcl_DStringAppend(&cmdString, scrollPtr->command,
+ strlen(scrollPtr->command));
+ Tcl_DStringAppendElement(&cmdString, "moveto");
+ Tcl_DStringAppendElement(&cmdString, vauleString);
+ Tcl_DStringAppend(&cmdString, "; update idletasks",
+ strlen("; update idletasks"));
+
+ interp = scrollPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ Tcl_GlobalEval(interp, cmdString.string);
+ Tcl_Release((ClientData) interp);
+ Tcl_DStringFree(&cmdString);
+ }
+ } else if (part != 0) {
+ /*
+ * Case 3: in any other part of the scrollbar. We call
+ * TrackControl with the scrollActionProc which will do
+ * most all the work.
+ */
+ TrackControl(macScrollPtr->sbHandle, where, scrollActionProc);
+ HiliteControl(macScrollPtr->sbHandle, 0);
+ }
+
+ /*
+ * The TrackControl call will "eat" the ButtonUp event. We now
+ * generate a ButtonUp event so Tk will unset implicit grabs etc.
+ */
+ GetMouse(&where);
+ XQueryPointer(NULL, None, &window, &window, &x,
+ &y, &dummy, &dummy, &state);
+ window = Tk_WindowId(scrollPtr->tkwin);
+ TkGenerateButtonEvent(x, y, window, state);
+
+ SetGWorld(saveWorld, saveDevice);
+ }
+
+ if (macScrollPtr->sbHandle && (macScrollPtr->macFlags & ALREADY_DEAD)) {
+ DisposeControl(macScrollPtr->sbHandle);
+ macScrollPtr->sbHandle = NULL;
+ }
+ macScrollPtr->macFlags &= ~IN_MODAL_LOOP;
+ Tcl_Release((ClientData)scrollPtr);
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScrollbarEventProc --
+ *
+ * This procedure is invoked by the Tk dispatcher for various
+ * events on scrollbars.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * When the window gets deleted, internal structures get
+ * cleaned up. When it gets exposed, it is redisplayed.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+ScrollbarEventProc(
+ ClientData clientData, /* Information about window. */
+ XEvent *eventPtr) /* Information about event. */
+{
+ TkScrollbar *scrollPtr = (TkScrollbar *) clientData;
+ MacScrollbar *macScrollPtr = (MacScrollbar *) clientData;
+
+ if (eventPtr->type == UnmapNotify) {
+ TkMacSetScrollbarGrow((TkWindow *) scrollPtr->tkwin, false);
+ } else if (eventPtr->type == ActivateNotify) {
+ macScrollPtr->macFlags |= ACTIVE;
+ TkScrollbarEventuallyRedraw((ClientData) scrollPtr);
+ } else if (eventPtr->type == DeactivateNotify) {
+ macScrollPtr->macFlags &= ~ACTIVE;
+ TkScrollbarEventuallyRedraw((ClientData) scrollPtr);
+ } else {
+ TkScrollbarEventProc(clientData, eventPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * UpdateControlValues --
+ *
+ * This procedure updates the Macintosh scrollbar control
+ * to display the values defined by the Tk scrollbar.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The Macintosh control is updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+UpdateControlValues(
+ MacScrollbar *macScrollPtr) /* Scrollbar data struct. */
+{
+ TkScrollbar *scrollPtr = (TkScrollbar *) macScrollPtr;
+ Tk_Window tkwin = scrollPtr->tkwin;
+ MacDrawable * macDraw = (MacDrawable *) Tk_WindowId(scrollPtr->tkwin);
+ WindowRef windowRef = (**macScrollPtr->sbHandle).contrlOwner;
+ double middle;
+ int drawGrowRgn = false;
+ int flushRight = false;
+ int flushBottom = false;
+
+ /*
+ * We can't use the Macintosh commands SizeControl and MoveControl as these
+ * calls will also cause a redraw which in our case will also cause
+ * flicker. To avoid this we adjust the control record directly. The
+ * Draw1Control command appears to just draw where ever the control says to
+ * draw so this seems right.
+ *
+ * NOTE: changing the control record directly may not work when
+ * Apple releases the Copland version of the MacOS (or when hell is cold).
+ */
+
+ (**macScrollPtr->sbHandle).contrlRect.left = macDraw->xOff + scrollPtr->inset;
+ (**macScrollPtr->sbHandle).contrlRect.top = macDraw->yOff + scrollPtr->inset;
+ (**macScrollPtr->sbHandle).contrlRect.right = macDraw->xOff + Tk_Width(tkwin)
+ - scrollPtr->inset;
+ (**macScrollPtr->sbHandle).contrlRect.bottom = macDraw->yOff +
+ Tk_Height(tkwin) - scrollPtr->inset;
+
+ /*
+ * To make Tk applications look more like Macintosh applications without
+ * requiring additional work by the Tk developer we do some cute tricks.
+ * The first trick plays with the size of the widget to get it to overlap
+ * with the side of the window by one pixel (we don't do this if the placer
+ * is the geometry manager). The second trick shrinks the scrollbar if it
+ * it covers the area of the grow region ao the scrollbar can also draw
+ * the grow region if need be.
+ */
+ if (!strcmp(macDraw->winPtr->geomMgrPtr->name, "place")) {
+ macScrollPtr->macFlags &= AUTO_ADJUST;
+ } else {
+ macScrollPtr->macFlags |= AUTO_ADJUST;
+ }
+ /* TODO: use accessor function!!! */
+ if (windowRef->portRect.left == (**macScrollPtr->sbHandle).contrlRect.left) {
+ if (macScrollPtr->macFlags & AUTO_ADJUST) {
+ (**macScrollPtr->sbHandle).contrlRect.left--;
+ }
+ if (!(macScrollPtr->macFlags & FLUSH_LEFT)) {
+ macScrollPtr->macFlags |= FLUSH_LEFT;
+ if (scrollPtr->vertical) {
+ TkpComputeScrollbarGeometry(scrollPtr);
+ }
+ }
+ } else if (macScrollPtr->macFlags & FLUSH_LEFT) {
+ macScrollPtr->macFlags &= ~FLUSH_LEFT;
+ if (scrollPtr->vertical) {
+ TkpComputeScrollbarGeometry(scrollPtr);
+ }
+ }
+
+ if (windowRef->portRect.top == (**macScrollPtr->sbHandle).contrlRect.top) {
+ if (macScrollPtr->macFlags & AUTO_ADJUST) {
+ (**macScrollPtr->sbHandle).contrlRect.top--;
+ }
+ if (!(macScrollPtr->macFlags & FLUSH_TOP)) {
+ macScrollPtr->macFlags |= FLUSH_TOP;
+ if (! scrollPtr->vertical) {
+ TkpComputeScrollbarGeometry(scrollPtr);
+ }
+ }
+ } else if (macScrollPtr->macFlags & FLUSH_TOP) {
+ macScrollPtr->macFlags &= ~FLUSH_TOP;
+ if (! scrollPtr->vertical) {
+ TkpComputeScrollbarGeometry(scrollPtr);
+ }
+ }
+
+ if (windowRef->portRect.right == (**macScrollPtr->sbHandle).contrlRect.right) {
+ flushRight = true;
+ if (macScrollPtr->macFlags & AUTO_ADJUST) {
+ (**macScrollPtr->sbHandle).contrlRect.right++;
+ }
+ if (!(macScrollPtr->macFlags & FLUSH_RIGHT)) {
+ macScrollPtr->macFlags |= FLUSH_RIGHT;
+ if (scrollPtr->vertical) {
+ TkpComputeScrollbarGeometry(scrollPtr);
+ }
+ }
+ } else if (macScrollPtr->macFlags & FLUSH_RIGHT) {
+ macScrollPtr->macFlags &= ~FLUSH_RIGHT;
+ if (scrollPtr->vertical) {
+ TkpComputeScrollbarGeometry(scrollPtr);
+ }
+ }
+
+ if (windowRef->portRect.bottom == (**macScrollPtr->sbHandle).contrlRect.bottom) {
+ flushBottom = true;
+ if (macScrollPtr->macFlags & AUTO_ADJUST) {
+ (**macScrollPtr->sbHandle).contrlRect.bottom++;
+ }
+ if (!(macScrollPtr->macFlags & FLUSH_BOTTOM)) {
+ macScrollPtr->macFlags |= FLUSH_BOTTOM;
+ if (! scrollPtr->vertical) {
+ TkpComputeScrollbarGeometry(scrollPtr);
+ }
+ }
+ } else if (macScrollPtr->macFlags & FLUSH_BOTTOM) {
+ macScrollPtr->macFlags &= ~FLUSH_BOTTOM;
+ if (! scrollPtr->vertical) {
+ TkpComputeScrollbarGeometry(scrollPtr);
+ }
+ }
+
+ /*
+ * If the scrollbar is flush against the bottom right hand coner then
+ * it may need to draw the grow region for the window so we let the
+ * wm code know about this scrollbar. We don't actually draw the grow
+ * region, however, unless we are currently resizable.
+ */
+ macScrollPtr->macFlags &= ~DRAW_GROW;
+ if (flushBottom && flushRight) {
+ TkMacSetScrollbarGrow((TkWindow *) tkwin, true);
+ if (TkMacResizable(macDraw->toplevel->winPtr)) {
+ if (scrollPtr->vertical) {
+ (**macScrollPtr->sbHandle).contrlRect.bottom -= 14;
+ } else {
+ (**macScrollPtr->sbHandle).contrlRect.right -= 14;
+ }
+ macScrollPtr->macFlags |= DRAW_GROW;
+ }
+ } else {
+ TkMacSetScrollbarGrow((TkWindow *) tkwin, false);
+ }
+
+ /*
+ * Given the Tk parameters for the fractions of the start and
+ * end of the thumb, the following calculation determines the
+ * location for the fixed sized Macintosh thumb.
+ */
+ middle = scrollPtr->firstFraction / (scrollPtr->firstFraction +
+ (1.0 - scrollPtr->lastFraction));
+
+ (**macScrollPtr->sbHandle).contrlValue = (short) (middle * 1000);
+ if ((**macScrollPtr->sbHandle).contrlHilite == 0 ||
+ (**macScrollPtr->sbHandle).contrlHilite == 255) {
+ if (scrollPtr->firstFraction == 0.0 &&
+ scrollPtr->lastFraction == 1.0) {
+ (**macScrollPtr->sbHandle).contrlHilite = 255;
+ } else {
+ (**macScrollPtr->sbHandle).contrlHilite = 0;
+ }
+ }
+ if ((**macScrollPtr->sbHandle).contrlVis != 255) {
+ (**macScrollPtr->sbHandle).contrlVis = 255;
+ }
+}
diff --git a/tk/mac/tkMacSend.c b/tk/mac/tkMacSend.c
new file mode 100644
index 00000000000..262cc1463f2
--- /dev/null
+++ b/tk/mac/tkMacSend.c
@@ -0,0 +1,358 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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
+ * to an interpreter named "name".
+ *
+ * When the registry is being manipulated by an application (e.g. to
+ * add or remove an entry), it is loaded into memory using a structure
+ * of the following type:
+ */
+
+typedef struct NameRegistry {
+ TkDisplay *dispPtr; /* Display from which the registry was
+ * 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,
+ * when a result is returned from a sent command, it is also appended
+ * to the comm property.
+ *
+ * Each command and each result takes the form of ASCII text. For a
+ * command, the text consists of a zero character followed by several
+ * null-terminated ASCII strings. The first string consists of the
+ * single letter "c". Subsequent strings have the form "option value"
+ * where the following options are supported:
+ *
+ * -r commWindow serial
+ *
+ * This option means that a response should be sent to the window
+ * whose X identifier is "commWindow" (in hex), and the response should
+ * be identified with the serial number given by "serial" (in decimal).
+ * If this option isn't specified then the send is asynchronous and
+ * no response is sent.
+ *
+ * -n name
+ * "Name" gives the name of the application for which the command is
+ * intended. This option must be present.
+ *
+ * -s script
+ *
+ * "Script" is the script to be executed. This option must be present.
+ *
+ * The options may appear in any order. The -n and -s options must be
+ * present, but -r may be omitted for asynchronous RPCs. For compatibility
+ * with future releases that may add new features, there may be additional
+ * options present; as long as they start with a "-" character, they will
+ * be ignored.
+ *
+ * A result also consists of a zero character followed by several null-
+ * terminated ASCII strings. The first string consists of the single
+ * letter "r". Subsequent strings have the form "option value" where
+ * the following options are supported:
+ *
+ * -s serial
+ *
+ * Identifies the command for which this is the result. It is the
+ * same as the "serial" field from the -s option in the command. This
+ * option must be present.
+ *
+ * -c code
+ *
+ * "Code" is the completion code for the script, in decimal. If the
+ * code is omitted it defaults to TCL_OK.
+ *
+ * -r result
+ *
+ * "Result" is the result string for the script, which may be either
+ * a result or an error message. If this field is omitted then it
+ * defaults to an empty string.
+ *
+ * -i errorInfo
+ *
+ * "ErrorInfo" gives a string with which to initialize the errorInfo
+ * variable. This option may be omitted; it is ignored unless the
+ * completion code is TCL_ERROR.
+ *
+ * -e errorCode
+ *
+ * "ErrorCode" gives a string with with to initialize the errorCode
+ * variable. This option may be omitted; it is ignored unless the
+ * completion code is TCL_ERROR.
+ *
+ * Options may appear in any order, and only the -s option must be
+ * present. As with commands, there may be additional options besides
+ * these; unknown options are ignored.
+ */
+
+ /*
+ * The following variable is the serial number that was used in the
+ * last "send" command. It is exported only for testing purposes.
+ */
+
+int tkSendSerial = 0;
+
+ /*
+ * Maximum size property that can be read at one time by
+ * this module:
+ */
+
+#define MAX_PROP_WORDS 100000
+
+/*
+ * 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));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SetAppName --
+ *
+ * This procedure is called to associate an ASCII name with a Tk
+ * application. If the application has already been named, the
+ * name replaces the old one.
+ *
+ * Results:
+ * The return value is the name actually given to the application.
+ * This will normally be the same as name, but if name was already
+ * in use for an application then a name of the form "name #2" will
+ * be chosen, with a high enough number to make the name unique.
+ *
+ * Side effects:
+ * Registration info is saved, thereby allowing the "send" command
+ * to be used later to invoke commands in the application. In
+ * addition, the "send" command is created in the application's
+ * interpreter. The registration will be removed automatically
+ * if the interpreter is deleted or the "send" command is removed.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_SetAppName(
+ Tk_Window tkwin, /* Token for any window in the application
+ * 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 --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 --
+ *
+ * This procedure is called to initialize the
+ * communication channels for sending commands and
+ * receiving results.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * 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;
+}
diff --git a/tk/mac/tkMacShLib.exp b/tk/mac/tkMacShLib.exp
new file mode 100644
index 00000000000..20e5bf33dcd
--- /dev/null
+++ b/tk/mac/tkMacShLib.exp
@@ -0,0 +1,765 @@
+MacMoveWindow
+TkAboutDlg
+TkActivateMenuEntry
+TkAllocWindow
+TkBTreeCharTagged
+TkBTreeCharsInLine
+TkBTreeCheck
+TkBTreeCreate
+TkBTreeDeleteChars
+TkBTreeDestroy
+TkBTreeFindLine
+TkBTreeGetTags
+TkBTreeInsertChars
+TkBTreeLineIndex
+TkBTreeLinkSegment
+TkBTreeNextLine
+TkBTreeNextTag
+TkBTreeNumLines
+TkBTreePrevTag
+TkBTreePreviousLine
+TkBTreeStartSearch
+TkBTreeStartSearchBack
+TkBTreeTag
+TkBTreeUnlinkSegment
+TkBezierPoints
+TkBezierScreenPoints
+TkBindDeadWindow
+TkBindEventProc
+TkBindFree
+TkBindInit
+TkButtonWorldChanged
+TkCanvPostscriptCmd
+TkChangeEventWindow
+TkClipBox
+TkClipInit
+TkComputeAnchor
+TkConsoleCreate
+TkConsoleInit
+TkConsolePrint
+TkCopyAndGlobalEval
+TkCreateBindingProcedure
+TkCreateCursorFromData
+TkCreateFrame
+TkCreateMainWindow
+TkCreateMenuReferences
+TkCreateNamedFont
+TkCreateRegion
+TkCurrentTime
+TkDeadAppCmd
+TkDeleteAllImages
+TkDestroyMenu
+TkDestroyRegion
+TkDoConfigureNotify
+TkEventDeadWindow
+TkEventuallyRecomputeMenu
+TkEventuallyRedrawMenu
+TkEventuallyRedrawScale
+TkFillPolygon
+TkFindMenuReferences
+TkFindStateNum
+TkFindStateString
+TkFocusDeadWindow
+TkFocusFilterEvent
+TkFocusKeyEvent
+TkFontPkgFree
+TkFontPkgInit
+TkFreeBindingTags
+TkFreeCursor
+TkFreeFileFilters
+TkFreeMenuReferences
+TkGenWMConfigureEvent
+TkGenWMDestroyEvent
+TkGenerateActivateEvents
+TkGenerateButtonEvent
+TkGetBitmapData
+TkGetButtPoints
+TkGetCursorByName
+TkGetDefaultScreenName
+TkGetDisplay
+TkGetDisplayOf
+TkGetFileFilters
+TkGetInterpNames
+TkGetMenuHashTable
+TkGetMenuIndex
+TkGetMiterPoints
+TkGetPointerCoords
+TkGetProlog
+TkGetServerInfo
+TkGetTransientMaster
+TkGrabDeadWindow
+TkGrabState
+TkInOutEvents
+TkIncludePoint
+TkInitFileFilters
+TkInitFontAttributes
+TkIntersectRegion
+TkInvokeButton
+TkInvokeMenu
+TkKeysymToString
+TkLineToArea
+TkLineToPoint
+TkMacButtonKeyState
+TkMacClearMenubarActive
+TkMacConvertEvent
+TkMacConvertTkEvent
+TkMacDispatchMenuEvent
+TkMacDoHLEvent
+TkMacGenerateTime
+TkMacGetDrawablePort
+TkMacGetScrollbarGrowWindow
+TkMacGetXWindow
+TkMacGrowToplevel
+TkMacHandleMenuSelect
+TkMacHandleTearoffMenu
+TkMacInitAppleEvents
+TkMacInitMenus
+TkMacInstallCursor
+TkMacInvalClipRgns
+TkMacInvalidateWindow
+TkMacIsCharacterMissing
+TkMacMakeRealWindowExist
+TkMacMakeStippleMap
+TkMacMenuClick
+TkMacRegisterOffScreenWindow
+TkMacResizable
+TkMacSetEmbedRgn
+TkMacSetHelpMenuItemCount
+TkMacSetScrollbarGrow
+TkMacSetUpClippingRgn
+TkMacSetUpGraphicsPort
+TkMacUnregisterMacWindow
+TkMacUpdateClipRgn
+TkMacUseMenuID
+TkMacVisableClipRgn
+TkMacWinBounds
+TkMacWindowOffset
+TkMacXAddPixel
+TkMacXDestroyImage
+TkMacXGetPixel
+TkMacXPutPixel
+TkMacXSubImage
+TkMacZoomToplevel
+TkMakeBezierCurve
+TkMakeBezierPostscript
+TkMakeMenuWindow
+TkMenuButtonWorldChanged
+TkMenuConfigureDrawOptions
+TkMenuConfigureEntryDrawOptions
+TkMenuEntryFreeDrawOptions
+TkMenuEventProc
+TkMenuFreeDrawOptions
+TkMenuImageProc
+TkMenuInit
+TkMenuInitializeDrawingFields
+TkMenuInitializeEntryDrawingFields
+TkMenuSelectImageProc
+TkNewMenuName
+TkOptionClassChanged
+TkOptionDeadWindow
+TkOvalToArea
+TkOvalToPoint
+TkParseXLFD
+TkPointerDeadWindow
+TkPointerEvent
+TkPolygonToArea
+TkPolygonToPoint
+TkPositionInTree
+TkPostCommand
+TkPostSubmenu
+TkPostTearoffMenu
+TkPreprocessMenu
+TkPutImage
+TkQueueEventForAllChildren
+TkRecomputeMenu
+TkRectInRegion
+TkRoundToResolution
+TkScrollWindow
+TkScrollbarEventProc
+TkScrollbarEventuallyRedraw
+TkSelClearSelection
+TkSelDeadWindow
+TkSelDefaultSelection
+TkSelEventProc
+TkSelGetSelection
+TkSelInit
+TkSelPropProc
+TkSelUpdateClipboard
+TkSetClassProcs
+TkSetMacColor
+TkSetRegion
+TkSetWMName
+TkSetWindowMenuBar
+TkStringToKeysym
+TkSuspendClipboard
+TkTextBindProc
+TkTextChanged
+TkTextCharBbox
+TkTextCharLayoutProc
+TkTextCreateDInfo
+TkTextCreateTag
+TkTextDLineInfo
+TkTextEventuallyRepick
+TkTextFreeDInfo
+TkTextFreeTag
+TkTextGetIndex
+TkTextGetTabs
+TkTextImageCmd
+TkTextImageIndex
+TkTextIndexBackChars
+TkTextIndexCmp
+TkTextIndexForwChars
+TkTextIndexToSeg
+TkTextInsertDisplayProc
+TkTextLostSelection
+TkTextMakeIndex
+TkTextMarkCmd
+TkTextMarkNameToIndex
+TkTextMarkSegToIndex
+TkTextPickCurrent
+TkTextPixelIndex
+TkTextPrintIndex
+TkTextRedrawRegion
+TkTextRedrawTag
+TkTextRelayoutWindow
+TkTextScanCmd
+TkTextSeeCmd
+TkTextSegToOffset
+TkTextSetMark
+TkTextSetYView
+TkTextTagCmd
+TkTextWindowCmd
+TkTextWindowIndex
+TkTextXviewCmd
+TkTextYviewCmd
+TkThickPolyLineToArea
+TkUnionRectWithRegion
+TkUnsupported1Cmd
+TkWmAddToColormapWindows
+TkWmDeadWindow
+TkWmFocusToplevel
+TkWmMapWindow
+TkWmNewWindow
+TkWmProtocolEventProc
+TkWmRemoveFromColormapWindows
+TkWmRestackToplevel
+TkWmSetClass
+TkWmUnmapWindow
+Tk_3DBorderColor
+Tk_3DBorderGC
+Tk_3DHorizontalBevel
+Tk_3DVerticalBevel
+Tk_AddOption
+Tk_BellCmd
+Tk_BindCmd
+Tk_BindEvent
+Tk_BindtagsCmd
+Tk_ButtonCmd
+Tk_CanvasCmd
+Tk_CanvasDrawableCoords
+Tk_CanvasEventuallyRedraw
+Tk_CanvasGetCoord
+Tk_CanvasGetTextInfo
+Tk_CanvasPsBitmap
+Tk_CanvasPsColor
+Tk_CanvasPsFont
+Tk_CanvasPsPath
+Tk_CanvasPsStipple
+Tk_CanvasPsY
+Tk_CanvasSetStippleOrigin
+Tk_CanvasTagsParseProc
+Tk_CanvasTagsPrintProc
+Tk_CanvasTkwin
+Tk_CanvasWindowCoords
+Tk_ChangeWindowAttributes
+Tk_CharBbox
+Tk_CheckbuttonCmd
+Tk_ChooseColorCmd
+Tk_ClearSelection
+Tk_ClipboardAppend
+Tk_ClipboardClear
+Tk_ClipboardCmd
+Tk_ComputeTextLayout
+Tk_ConfigureInfo
+Tk_ConfigureValue
+Tk_ConfigureWidget
+Tk_ConfigureWindow
+Tk_CoordsToWindow
+Tk_CreateBinding
+Tk_CreateBindingTable
+Tk_CreateErrorHandler
+Tk_CreateEventHandler
+Tk_CreateGenericHandler
+Tk_CreateImageType
+Tk_CreateItemType
+Tk_CreatePhotoImageFormat
+Tk_CreateSelHandler
+Tk_CreateWindow
+Tk_CreateWindowFromPath
+Tk_DefineBitmap
+Tk_DefineCursor
+Tk_DeleteAllBindings
+Tk_DeleteBinding
+Tk_DeleteBindingTable
+Tk_DeleteErrorHandler
+Tk_DeleteEventHandler
+Tk_DeleteGenericHandler
+Tk_DeleteImage
+Tk_DeleteSelHandler
+Tk_DestroyCmd
+Tk_DestroyWindow
+Tk_DisplayName
+Tk_DistanceToTextLayout
+Tk_Draw3DPolygon
+Tk_Draw3DRectangle
+Tk_DrawChars
+Tk_DrawFocusHighlight
+Tk_DrawTextLayout
+Tk_EntryCmd
+Tk_EventCmd
+Tk_Fill3DPolygon
+Tk_Fill3DRectangle
+Tk_FindPhoto
+Tk_FocusCmd
+Tk_FontId
+Tk_FontObjCmd
+Tk_FrameCmd
+Tk_Free3DBorder
+Tk_FreeBitmap
+Tk_FreeColor
+Tk_FreeColormap
+Tk_FreeCursor
+Tk_FreeFont
+Tk_FreeGC
+Tk_FreeImage
+Tk_FreeOptions
+Tk_FreePixmap
+Tk_FreeTextLayout
+Tk_GCForColor
+Tk_GeometryRequest
+Tk_Get3DBorder
+Tk_GetAllBindings
+Tk_GetAnchor
+Tk_GetAtomName
+Tk_GetBinding
+Tk_GetBitmap
+Tk_GetBitmapFromData
+Tk_GetCapStyle
+Tk_GetColor
+Tk_GetColorByValue
+Tk_GetColormap
+Tk_GetCursor
+Tk_GetCursorFromData
+Tk_GetFont
+Tk_GetFontFromObj
+Tk_GetFontMetrics
+Tk_GetGC
+Tk_GetImage
+Tk_GetItemTypes
+Tk_GetJoinStyle
+Tk_GetJustify
+Tk_GetNumMainWindows
+Tk_GetOpenFileCmd
+Tk_GetOption
+Tk_GetPixels
+Tk_GetPixmap
+Tk_GetRelief
+Tk_GetRootCoords
+Tk_GetSaveFileCmd
+Tk_GetScreenMM
+Tk_GetScrollInfo
+Tk_GetSelection
+Tk_GetUid
+Tk_GetVRootGeometry
+Tk_GetVisual
+Tk_Grab
+Tk_GrabCmd
+Tk_GridCmd
+Tk_HandleEvent
+Tk_IdToWindow
+Tk_ImageChanged
+Tk_ImageCmd
+Tk_Init
+Tk_InternAtom
+Tk_IntersectTextLayout
+Tk_LabelCmd
+Tk_ListboxCmd
+Tk_LowerCmd
+Tk_Main
+Tk_MainLoop
+Tk_MainWindow
+Tk_MaintainGeometry
+Tk_MakeWindowExist
+Tk_ManageGeometry
+Tk_MapWindow
+Tk_MeasureChars
+Tk_MenuCmd
+Tk_MenubuttonCmd
+Tk_MessageBoxCmd
+Tk_MessageCmd
+Tk_MoveResizeWindow
+Tk_MoveToplevelWindow
+Tk_MoveWindow
+Tk_NameOf3DBorder
+Tk_NameOfAnchor
+Tk_NameOfBitmap
+Tk_NameOfCapStyle
+Tk_NameOfColor
+Tk_NameOfCursor
+Tk_NameOfFont
+Tk_NameOfImage
+Tk_NameOfJoinStyle
+Tk_NameOfJustify
+Tk_NameOfRelief
+Tk_NameToWindow
+Tk_OptionCmd
+Tk_OwnSelection
+Tk_PackCmd
+Tk_ParseArgv
+Tk_PhotoBlank
+Tk_PhotoExpand
+Tk_PhotoGetImage
+Tk_PhotoGetSize
+Tk_PhotoPutBlock
+Tk_PhotoPutZoomedBlock
+Tk_PhotoSetSize
+Tk_PlaceCmd
+Tk_PointToChar
+Tk_PostscriptFontName
+Tk_PreserveColormap
+Tk_QueueWindowEvent
+Tk_RadiobuttonCmd
+Tk_RaiseCmd
+Tk_RedrawImage
+Tk_ResizeWindow
+Tk_RestackWindow
+Tk_RestrictEvents
+Tk_SafeInit
+Tk_ScaleCmd
+Tk_ScrollbarCmd
+Tk_SelectionCmd
+Tk_SendCmd
+Tk_SetAppName
+Tk_SetBackgroundFromBorder
+Tk_SetClass
+Tk_SetGrid
+Tk_SetInternalBorder
+Tk_SetWindowBackground
+Tk_SetWindowBackgroundPixmap
+Tk_SetWindowBorder
+Tk_SetWindowBorderPixmap
+Tk_SetWindowBorderWidth
+Tk_SetWindowColormap
+Tk_SetWindowVisual
+Tk_SizeOfBitmap
+Tk_SizeOfImage
+Tk_StrictMotif
+Tk_TextCmd
+Tk_TextLayoutToPostscript
+Tk_TextWidth
+Tk_TkObjCmd
+Tk_TkwaitCmd
+Tk_TopCoordsToWindow
+Tk_ToplevelCmd
+Tk_UndefineCursor
+Tk_UnderlineChars
+Tk_UnderlineTextLayout
+Tk_Ungrab
+Tk_UnmaintainGeometry
+Tk_UnmapWindow
+Tk_UnsetGrid
+Tk_UpdateCmd
+Tk_UpdatePointer
+Tk_WinfoObjCmd
+Tk_WmCmd
+TkpChangeFocus
+TkpClaimFocus
+TkpCloseDisplay
+TkpComputeButtonGeometry
+TkpComputeMenuButtonGeometry
+TkpComputeMenubarGeometry
+TkpComputeScrollbarGeometry
+TkpComputeStandardMenuGeometry
+TkpConfigureMenuEntry
+TkpConfigureScrollbar
+TkpCreateButton
+TkpCreateMenuButton
+TkpCreateNativeBitmap
+TkpCreateScale
+TkpCreateScrollbar
+TkpDefineNativeBitmaps
+TkpDeleteFont
+TkpDestroyButton
+TkpDestroyMenu
+TkpDestroyMenuButton
+TkpDestroyMenuEntry
+TkpDestroyScale
+TkpDestroyScrollbar
+TkpDisplayButton
+TkpDisplayMenuButton
+TkpDisplayScale
+TkpDisplayScrollbar
+TkpDisplayWarning
+TkpDrawMenuEntry
+TkpFindWindow
+TkpFreeBorder
+TkpGetAppName
+TkpGetBorder
+TkpGetColor
+TkpGetColorByValue
+TkpGetFontFamilies
+TkpGetFontFromAttributes
+TkpGetMS
+TkpGetNativeAppBitmap
+TkpGetNativeFont
+TkpGetOtherWindow
+TkpGetShadows
+TkpInit
+TkpInitializeMenuBindings
+TkpMakeContainer
+TkpMakeWindow
+TkpMenuInit
+TkpMenuNewEntry
+TkpNewMenu
+TkpOpenDisplay
+TkpPixelToValue
+TkpPostMenu
+TkpRedirectKeyEvent
+TkpScaleElement
+TkpScrollbarPosition
+TkpSetCapture
+TkpSetCursor
+TkpSetMainMenubar
+TkpSetScaleValue
+TkpSetWindowMenuBar
+TkpTestembedCmd
+TkpUseWindow
+TkpValueToPixel
+TkpWindowWasRecentlyDeleted
+XAllocColor
+XAllocSizeHints
+XBell
+XChangeGC
+XChangeProperty
+XChangeWindowAttributes
+XConfigureWindow
+XCopyArea
+XCopyPlane
+XCreateBitmapFromData
+XCreateColormap
+XCreateGC
+XCreateImage
+XDefineCursor
+XDestroyWindow
+XDrawArc
+XDrawLine
+XDrawLines
+XDrawRectangle
+XFillArc
+XFillPolygon
+XFillRectangle
+XFillRectangles
+XForceScreenSaver
+XFreeColormap
+XFreeColors
+XFreeGC
+XFreeModifiermap
+XGContextFromGC
+XGetAtomName
+XGetGeometry
+XGetImage
+XGetModifierMapping
+XGetVisualInfo
+XGetWindowProperty
+XGrabKeyboard
+XGrabPointer
+XInternAtom
+XKeycodeToKeysym
+XKeysymToKeycode
+XKeysymToString
+XLookupString
+XMapWindow
+XMoveResizeWindow
+XMoveWindow
+XParseColor
+XQueryPointer
+XRaiseWindow
+XReadBitmapFile
+XRefreshKeyboardMapping
+XResizeWindow
+XRootWindow
+XSelectInput
+XSendEvent
+XSetArcMode
+XSetBackground
+XSetClipMask
+XSetClipOrigin
+XSetErrorHandler
+XSetFillRule
+XSetFillStyle
+XSetFont
+XSetForeground
+XSetFunction
+XSetIconName
+XSetInputFocus
+XSetLineAttributes
+XSetSelectionOwner
+XSetStipple
+XSetTSOrigin
+XSetWMNormalHints
+XSetWindowBackground
+XSetWindowBackgroundPixmap
+XSetWindowBorder
+XSetWindowBorderPixmap
+XSetWindowBorderWidth
+XSetWindowColormap
+XStringToKeysym
+XUngrabKeyboard
+XUngrabPointer
+XUnmapWindow
+_Aldata
+_Assert
+_Atcount
+_Atfuns
+_Clocale
+_Closreg
+_Costate
+_Daysto
+_Dbl
+_Defloc
+_Environ
+_Environ1
+_Fgpos
+_Files
+_Flt
+_Fopen
+_Foprep
+_Fread
+_Freeloc
+_Frprep
+_Fspos
+_Fwprep
+_Fwrite
+_Genld
+_Gentime
+_Getdst
+_Getfld
+_Getfloat
+_Getint
+_Getloc
+_Getmem
+_Getstr
+_Gettime
+_Getzone
+_Isdst
+_Ldbl
+_Ldtob
+_Litob
+_Locale
+_Locsum
+_Loctab
+_Locterm
+_Locvar
+_MWERKS_Atcount
+_MWERKS_Atfuns
+_Makeloc
+_Makestab
+_Makewct
+_Mbcurmax
+_Mbstate
+_Mbtowc
+_Nnl
+_PJP_C_Copyright
+_Printf
+_Putfld
+_Putstr
+_Puttxt
+_Randseed
+_Readloc
+_Scanf
+_Setloc
+_Skip
+_Stdin
+_Stdout
+_Stod
+_Stof
+_Stoflt
+_Stold
+_Strerror
+_Strftime
+_Strxfrm
+_Times
+_Tolower
+_Toupper
+_Ttotm
+_WCostate
+_Wcstate
+_Wctob
+_Wctomb
+_Wctrans
+_Wctype
+_XInitImageFuncPtrs
+__CheckForSystem7
+__RemoveConsoleHandler__
+__aborting
+__ctopstring
+__getcreator
+__gettype
+__myraise
+__system7present
+_atexit
+_exit
+_fcreator
+_ftype
+pendingPtr
+tclFocusDebug
+tcl_macQdPtr
+tkActiveUid
+tkAppleMenu
+tkArcType
+tkBTreeDebug
+tkBitmapImageType
+tkBitmapType
+tkDisabledUid
+tkDisplayList
+tkEditMenu
+tkFileMenu
+tkImageType
+tkImgFmtGIF
+tkImgFmtPPM
+tkLineType
+tkMacAppInFront
+tkMacFocusWin
+tkMainWindowList
+tkMenuConfigSpecs
+tkMenuEntryConfigSpecs
+tkNormalUid
+tkOvalType
+tkPhotoImageType
+tkPolygonType
+tkPredefBitmapTable
+tkRectangleType
+tkSendSerial
+tkTextCharType
+tkTextCharUid
+tkTextDebug
+tkTextDisabledUid
+tkTextLeftMarkType
+tkTextNoneUid
+tkTextNormalUid
+tkTextRightMarkType
+tkTextToggleOffType
+tkTextToggleOnType
+tkTextType
+tkTextWordUid
+tkWindowType
+tkpButtonConfigSpecs
+tkpButtonProcs
+tkpMenubuttonClass
+tkpScrollbarConfigSpecs
+tkpScrollbarProcs
+#TclMacInitializeFragment
+#TclMacTerminateFragment
+#__initialize
+#__ptmf_null
+#__terminate
diff --git a/tk/mac/tkMacSubwindows.c b/tk/mac/tkMacSubwindows.c
new file mode 100644
index 00000000000..98adbd89186
--- /dev/null
+++ b/tk/mac/tkMacSubwindows.c
@@ -0,0 +1,1245 @@
+/*
+ * 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$
+ */
+
+#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.
+ *
+ * Results:
+ * The window id is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XDestroyWindow(
+ Display* display, /* Display. */
+ Window window) /* Window. */
+{
+ MacDrawable *macWin = (MacDrawable *) window;
+ GWorldPtr destPort;
+
+ /*
+ * Remove any dangling pointers that may exist if
+ * the window we are deleting is being tracked by
+ * the grab code.
+ */
+
+ TkPointerDeadWindow(macWin->winPtr);
+ macWin->toplevel->referenceCount--;
+
+
+ if (Tk_IsTopLevel(macWin->winPtr)) {
+ DisposeRgn(macWin->clipRgn);
+ DisposeRgn(macWin->aboveClipRgn);
+
+ /*
+ * Delete the Mac window and remove it from the windowTable.
+ * The window could be NULL if the window was never mapped.
+ * However, we don't do this for embedded windows, they don't
+ * go in the window list, and they do not own their portPtr's.
+ */
+
+ if (!(Tk_IsEmbedded(macWin->winPtr))) {
+ destPort = TkMacGetDrawablePort(window);
+ if (destPort != NULL) {
+ TkMacWindowList *listPtr, *prevPtr;
+
+ TkMacUnregisterMacWindow(destPort);
+ DisposeWindow((WindowRef) destPort);
+
+ for (listPtr = tkMacWindowListPtr, prevPtr = NULL;
+ tkMacWindowListPtr != NULL;
+ prevPtr = listPtr, listPtr = listPtr->nextPtr) {
+ if (listPtr->winPtr == macWin->winPtr) {
+ if (prevPtr == NULL) {
+ tkMacWindowListPtr = listPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = listPtr->nextPtr;
+ }
+ ckfree((char *) listPtr);
+ break;
+ }
+ }
+ }
+ }
+
+ macWin->portPtr = NULL;
+
+ /*
+ * Delay deletion of a toplevel data structure untill all
+ * children have been deleted.
+ */
+ if (macWin->toplevel->referenceCount == 0) {
+ ckfree((char *) macWin->toplevel);
+ }
+ } else {
+ destPort = TkMacGetDrawablePort(window);
+ if (destPort != NULL) {
+ SetGWorld(destPort, NULL);
+ TkMacInvalidateWindow(macWin, TK_PARENT_WINDOW);
+ }
+ if (macWin->winPtr->parentPtr != NULL) {
+ TkMacInvalClipRgns(macWin->winPtr->parentPtr);
+ }
+ DisposeRgn(macWin->clipRgn);
+ DisposeRgn(macWin->aboveClipRgn);
+
+ if (macWin->toplevel->referenceCount == 0) {
+ ckfree((char *) macWin->toplevel);
+ }
+ ckfree((char *) macWin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XMapWindow --
+ *
+ * Map the given X Window to the screen. See X window documentation
+ * for more details.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The subwindow or toplevel may appear on the screen.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XMapWindow(
+ Display* display, /* Display. */
+ Window window) /* Window. */
+{
+ MacDrawable *macWin = (MacDrawable *) window;
+ XEvent event;
+ GWorldPtr destPort;
+
+ /*
+ * Under certain situations it's possible for this function to be
+ * called before the toplevel window it's associated with has actually
+ * been mapped. In that case we need to create the real Macintosh
+ * window now as this function as well as other X functions assume that
+ * the portPtr is valid.
+ */
+ if (!TkMacHostToplevelExists(macWin->toplevel->winPtr)) {
+ TkMacMakeRealWindowExist(macWin->toplevel->winPtr);
+ }
+ destPort = TkMacGetDrawablePort(window);
+
+ display->request++;
+ macWin->winPtr->flags |= TK_MAPPED;
+ if (Tk_IsTopLevel(macWin->winPtr)) {
+ if (!Tk_IsEmbedded(macWin->winPtr)) {
+ ShowWindow((WindowRef) destPort);
+ }
+
+ /*
+ * We only need to send the MapNotify event
+ * for toplevel windows.
+ */
+ event.xany.serial = display->request;
+ event.xany.send_event = False;
+ event.xany.display = display;
+
+ event.xmap.window = window;
+ event.xmap.type = MapNotify;
+ event.xmap.event = window;
+ event.xmap.override_redirect = macWin->winPtr->atts.override_redirect;
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ } else {
+ TkMacInvalClipRgns(macWin->winPtr->parentPtr);
+ }
+
+ /*
+ * Generate damage for that area of the window
+ */
+ SetGWorld(destPort, NULL);
+ TkMacUpdateClipRgn(macWin->winPtr);
+ TkMacInvalidateWindow(macWin, TK_PARENT_WINDOW);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XUnmapWindow --
+ *
+ * Unmap the given X Window to the screen. See X window
+ * documentation for more details.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The subwindow or toplevel may be removed from the screen.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XUnmapWindow(
+ Display* display, /* Display. */
+ Window window) /* Window. */
+{
+ MacDrawable *macWin = (MacDrawable *) window;
+ XEvent event;
+ GWorldPtr destPort;
+
+ destPort = TkMacGetDrawablePort(window);
+
+ display->request++;
+ macWin->winPtr->flags &= ~TK_MAPPED;
+ if (Tk_IsTopLevel(macWin->winPtr)) {
+ if (!Tk_IsEmbedded(macWin->winPtr)) {
+ HideWindow((WindowRef) destPort);
+ }
+
+ /*
+ * We only need to send the UnmapNotify event
+ * for toplevel windows.
+ */
+ event.xany.serial = display->request;
+ event.xany.send_event = False;
+ event.xany.display = display;
+
+ event.xunmap.type = UnmapNotify;
+ event.xunmap.window = window;
+ event.xunmap.event = window;
+ event.xunmap.from_configure = false;
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ } else {
+ /*
+ * Generate damage for that area of the window.
+ */
+ SetGWorld(destPort, NULL);
+ TkMacInvalidateWindow(macWin, TK_PARENT_WINDOW); /* TODO: may not be valid */
+ TkMacInvalClipRgns(macWin->winPtr->parentPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XResizeWindow --
+ *
+ * Resize a given X window. See X windows documentation for
+ * further details.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XResizeWindow(
+ Display* display, /* Display. */
+ Window window, /* Window. */
+ unsigned int width,
+ unsigned int height)
+{
+ MacDrawable *macWin = (MacDrawable *) window;
+ GWorldPtr destPort;
+
+ 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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XMoveResizeWindow --
+ *
+ * Move or resize a given X window. See X windows documentation
+ * for further details.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XMoveResizeWindow(
+ Display* display, /* Display. */
+ Window window, /* Window. */
+ int x, int y,
+ unsigned int width,
+ unsigned int height)
+{
+ MacDrawable *macWin = (MacDrawable *) window;
+ GWorldPtr destPort;
+
+ destPort = TkMacGetDrawablePort(window);
+ if (destPort == NULL) {
+ return;
+ }
+
+ 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);
+ 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;
+ MacDrawable *macParent;
+
+ /*
+ * 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);
+ TkMacWinBounds(macWin->winPtr, &bounds);
+ InvalRect(&bounds);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XMoveWindow --
+ *
+ * Move a given X window. See X windows documentation for further
+ * details.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XMoveWindow(
+ Display* display, /* Display. */
+ Window window, /* Window. */
+ int x,
+ int y)
+{
+ MacDrawable *macWin = (MacDrawable *) window;
+ GWorldPtr destPort;
+
+ destPort = TkMacGetDrawablePort(window);
+ if (destPort == NULL) {
+ return;
+ }
+
+ 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;
+ MacDrawable *macParent;
+
+ /*
+ * 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("XMoveWindow 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);
+ TkMacWinBounds(macWin->winPtr, &bounds);
+ InvalRect(&bounds);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XRaiseWindow --
+ *
+ * Change the stacking order of a window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the stacking order of the specified window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XRaiseWindow(
+ Display* display, /* Display. */
+ Window window) /* Window. */
+{
+ MacDrawable *macWin = (MacDrawable *) window;
+
+ display->request++;
+ if (Tk_IsTopLevel(macWin->winPtr) && !Tk_IsEmbedded(macWin->winPtr)) {
+ TkWmRestackToplevel(macWin->winPtr, Above, NULL);
+ } else {
+ /* TODO: this should generate damage */
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XConfigureWindow --
+ *
+ * Change the size, position, stacking, or border of the specified
+ * window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the attributes of the specified window. Note that we
+ * ignore the passed in values and use the values stored in the
+ * TkWindow data structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XConfigureWindow(
+ Display* display, /* Display. */
+ Window w, /* Window. */
+ unsigned int value_mask,
+ XWindowChanges* values)
+{
+ MacDrawable *macWin = (MacDrawable *) w;
+ TkWindow *winPtr = macWin->winPtr;
+
+ display->request++;
+
+ /*
+ * Change the shape and/or position of the window.
+ */
+
+ if (value_mask & (CWX|CWY|CWWidth|CWHeight)) {
+ XMoveResizeWindow(display, w, winPtr->changes.x, winPtr->changes.y,
+ winPtr->changes.width, winPtr->changes.height);
+ }
+
+ /*
+ * Change the stacking order of the window. Tk actuall keeps all
+ * the information we need for stacking order. All we need to do
+ * is make sure the clipping regions get updated and generate damage
+ * that will ensure things get drawn correctly.
+ */
+
+ if (value_mask & CWStackMode) {
+ Rect bounds;
+ GWorldPtr destPort;
+
+ destPort = TkMacGetDrawablePort(w);
+ if (destPort != NULL) {
+ SetPort((GrafPtr) destPort);
+ TkMacInvalClipRgns(winPtr->parentPtr);
+ TkMacWinBounds(winPtr, &bounds);
+ InvalRect(&bounds);
+ }
+ }
+
+ /* TkGenWMMoveRequestEvent(macWin->winPtr,
+ macWin->winPtr->changes.x, macWin->winPtr->changes.y); */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacUpdateClipRgn --
+ *
+ * This function updates the cliping regions for a given window
+ * and all of its children. Once updated the TK_CLIP_INVALID flag
+ * in the subwindow data structure is unset. The TK_CLIP_INVALID
+ * flag should always be unset before any drawing is attempted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The clip regions for the window and its children are updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacUpdateClipRgn(
+ TkWindow *winPtr)
+{
+ RgnHandle rgn;
+ int x, y;
+ TkWindow *win2Ptr;
+
+ if (winPtr == NULL) {
+ return;
+ }
+
+ if (winPtr->privatePtr->flags & TK_CLIP_INVALID) {
+ rgn = winPtr->privatePtr->aboveClipRgn;
+ if (tmpRgn == NULL) {
+ tmpRgn = NewRgn();
+ }
+
+ /*
+ * Start with a region defined by the window bounds.
+ */
+
+ x = winPtr->privatePtr->xOff;
+ y = winPtr->privatePtr->yOff;
+ SetRectRgn(rgn, (short) x, (short) y,
+ (short) (winPtr->changes.width + x),
+ (short) (winPtr->changes.height + y));
+
+ /*
+ * Clip away the area of any windows that may obscure this
+ * window.
+ * For a non-toplevel window, first, clip to the parents visable
+ * clip region.
+ * Second, clip away any siblings that are higher in the
+ * stacking order.
+ * For an embedded toplevel, just clip to the container's visible
+ * clip region. Remember, we only allow one contained window
+ * in a frame, and don't support any other widgets in the frame either.
+ * This is not currently enforced, however.
+ */
+
+ if (!Tk_IsTopLevel(winPtr)) {
+ TkMacUpdateClipRgn(winPtr->parentPtr);
+ SectRgn(rgn,
+ winPtr->parentPtr->privatePtr->aboveClipRgn, rgn);
+
+ win2Ptr = winPtr->nextPtr;
+ while (win2Ptr != NULL) {
+ if (Tk_IsTopLevel(win2Ptr) || !Tk_IsMapped(win2Ptr)) {
+ win2Ptr = win2Ptr->nextPtr;
+ continue;
+ }
+ x = win2Ptr->privatePtr->xOff;
+ y = win2Ptr->privatePtr->yOff;
+ SetRectRgn(tmpRgn, (short) x, (short) y,
+ (short) (win2Ptr->changes.width + x),
+ (short) (win2Ptr->changes.height + y));
+ DiffRgn(rgn, tmpRgn, rgn);
+
+ win2Ptr = win2Ptr->nextPtr;
+ }
+ } else if (Tk_IsEmbedded(winPtr)) {
+ TkWindow *contWinPtr;
+
+ 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.
+ */
+
+ }
+
+ /*
+ * The final clip region is the aboveClip region (or visable
+ * region) minus all the children of this window.
+ * Alternatively, if the window is a container, we must also
+ * subtract the region of the embedded window.
+ */
+
+ rgn = winPtr->privatePtr->clipRgn;
+ CopyRgn(winPtr->privatePtr->aboveClipRgn, rgn);
+
+ win2Ptr = winPtr->childList;
+ while (win2Ptr != NULL) {
+ if (Tk_IsTopLevel(win2Ptr) || !Tk_IsMapped(win2Ptr)) {
+ win2Ptr = win2Ptr->nextPtr;
+ continue;
+ }
+ x = win2Ptr->privatePtr->xOff;
+ y = win2Ptr->privatePtr->yOff;
+ SetRectRgn(tmpRgn, (short) x, (short) y,
+ (short) (win2Ptr->changes.width + x),
+ (short) (win2Ptr->changes.height + y));
+ DiffRgn(rgn, tmpRgn, rgn);
+
+ win2Ptr = win2Ptr->nextPtr;
+ }
+
+ if (Tk_IsContainer(winPtr)) {
+ win2Ptr = TkpGetOtherWindow(winPtr);
+ if (win2Ptr != NULL) {
+ if (Tk_IsMapped(win2Ptr)) {
+ x = win2Ptr->privatePtr->xOff;
+ y = win2Ptr->privatePtr->yOff;
+ SetRectRgn(tmpRgn, (short) x, (short) y,
+ (short) (win2Ptr->changes.width + x),
+ (short) (win2Ptr->changes.height + y));
+ DiffRgn(rgn, tmpRgn, rgn);
+ }
+ }
+
+ /*
+ * NOTE: Here we should handle out of process embedding.
+ */
+
+ }
+
+ winPtr->privatePtr->flags &= ~TK_CLIP_INVALID;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacVisableClipRgn --
+ *
+ * This function returnd the Macintosh cliping region for the
+ * given window. A NULL Rgn means the window is not visable.
+ *
+ * Results:
+ * The region.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+RgnHandle
+TkMacVisableClipRgn(
+ TkWindow *winPtr)
+{
+ if (winPtr->privatePtr->flags & TK_CLIP_INVALID) {
+ TkMacUpdateClipRgn(winPtr);
+ }
+
+ return winPtr->privatePtr->clipRgn;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacInvalidateWindow --
+ *
+ * This function makes the window as invalid will generate damage
+ * for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Damage is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacInvalidateWindow(
+ MacDrawable *macWin, /* Make window that's causing damage. */
+ int flag) /* Should be TK_WINDOW_ONLY or
+ * TK_PARENT_WINDOW */
+{
+
+ if (flag == TK_WINDOW_ONLY) {
+ InvalRgn(macWin->clipRgn);
+ } else {
+ if (!EmptyRgn(macWin->aboveClipRgn)) {
+ InvalRgn(macWin->aboveClipRgn);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacGetDrawablePort --
+ *
+ * This function returns the Graphics Port for a given X drawable.
+ *
+ * Results:
+ * A GWorld pointer. Either an off screen pixmap or a Window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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
+ * always points to the off-screen port, and we don't
+ * have to worry about containment
+ */
+
+ if (macWin->clipRgn == NULL) {
+ return macWin->portPtr;
+ }
+
+ /*
+ * If the Drawable is in an embedded window, use the Port of its container.
+ *
+ * TRICKY POINT: we can have cases when a toplevel is being destroyed
+ * where the winPtr for the toplevel has been freed, but the children
+ * are not all the way destroyed. The children will call this function
+ * as they are being destroyed, but Tk_IsEmbedded will return garbage.
+ * So we check the copy of the TK_EMBEDDED flag we put into the
+ * toplevel's macWin flags.
+ */
+
+ if (!(macWin->toplevel->flags & TK_EMBEDDED)) {
+ 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 --
+ *
+ * This function invalidates the clipping regions for a given
+ * window and all of its children. This function should be
+ * called whenever changes are made to subwindows that would
+ * effect the size or position of windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The cliping regions for the window and its children are
+ * mark invalid. (Make sure they are valid before drawing.)
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacInvalClipRgns(
+ TkWindow *winPtr)
+{
+ TkWindow *childPtr;
+
+ /*
+ * If already marked we can stop because all
+ * decendants will also already be marked.
+ */
+ if (winPtr->privatePtr->flags & TK_CLIP_INVALID) {
+ return;
+ }
+
+ winPtr->privatePtr->flags |= TK_CLIP_INVALID;
+
+ /*
+ * Invalidate clip regions for all children &
+ * their decendants - unless the child is a toplevel.
+ */
+ childPtr = winPtr->childList;
+ while (childPtr != NULL) {
+ if (!Tk_IsTopLevel(childPtr) && Tk_IsMapped(childPtr)) {
+ TkMacInvalClipRgns(childPtr);
+ }
+ childPtr = childPtr->nextPtr;
+ }
+
+ /*
+ * Also, if the window is a container, mark its embedded window
+ */
+
+ if (Tk_IsContainer(winPtr)) {
+ childPtr = TkpGetOtherWindow(winPtr);
+
+ if (childPtr != NULL && Tk_IsMapped(childPtr)) {
+ TkMacInvalClipRgns(childPtr);
+ }
+
+ /*
+ * NOTE: Here we should handle out of process embedding.
+ */
+
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacWinBounds --
+ *
+ * Given a Tk window this function determines the windows
+ * bounds in relation to the Macintosh window's coordinate
+ * system. This is also the same coordinate system as the
+ * Tk toplevel window in which this window is contained.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacWinBounds(
+ TkWindow *winPtr,
+ Rect *bounds)
+{
+ bounds->left = (short) winPtr->privatePtr->xOff;
+ bounds->top = (short) winPtr->privatePtr->yOff;
+ bounds->right = (short) (winPtr->privatePtr->xOff +
+ winPtr->changes.width);
+ 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);
+ MoveWindow((WindowRef) window,
+ (short) (x + xOffset), (short) (y + yOffset), false);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateOffsets --
+ *
+ * Updates the X & Y offsets of the given TkWindow from the
+ * TopLevel it is a decendant of.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The xOff & yOff fields for the Mac window datastructure
+ * is updated to the proper offset.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateOffsets(
+ TkWindow *winPtr,
+ int deltaX,
+ int deltaY)
+{
+ TkWindow *childPtr;
+
+ if (winPtr->privatePtr == NULL) {
+ /*
+ * We havn't called Tk_MakeWindowExist for this window yet. The
+ * offset information will be postponed and calulated at that
+ * time. (This will usually only happen when a mapped parent is
+ * being moved but has child windows that have yet to be mapped.)
+ */
+ return;
+ }
+
+ winPtr->privatePtr->xOff += deltaX;
+ winPtr->privatePtr->yOff += deltaY;
+
+ childPtr = winPtr->childList;
+ while (childPtr != NULL) {
+ if (!Tk_IsTopLevel(childPtr)) {
+ UpdateOffsets(childPtr, deltaX, deltaY);
+ }
+ childPtr = childPtr->nextPtr;
+ }
+
+ if (Tk_IsContainer(winPtr)) {
+ childPtr = TkpGetOtherWindow(winPtr);
+ if (childPtr != NULL) {
+ UpdateOffsets(childPtr,deltaX,deltaY);
+ }
+
+ /*
+ * NOTE: Here we should handle out of process embedding.
+ */
+
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetPixmap --
+ *
+ * Creates an in memory drawing surface.
+ *
+ * Results:
+ * Returns a handle to a new pixmap.
+ *
+ * Side effects:
+ * Allocates a new Macintosh GWorld.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+Tk_GetPixmap(
+ Display *display, /* Display for new pixmap (can be null). */
+ Drawable d, /* Drawable where pixmap will be used (ignored). */
+ int width, /* Dimensions of pixmap. */
+ int height,
+ int depth) /* Bits per pixel for pixmap. */
+{
+ QDErr err;
+ GWorldPtr gWorld;
+ Rect bounds;
+ MacDrawable *macPix;
+ PixMapHandle pixels;
+
+ if (display != NULL) {
+ display->request++;
+ }
+ macPix = (MacDrawable *) ckalloc(sizeof(MacDrawable));
+ macPix->winPtr = NULL;
+ macPix->xOff = 0;
+ macPix->yOff = 0;
+ macPix->clipRgn = NULL;
+ macPix->aboveClipRgn = NULL;
+ macPix->referenceCount = 0;
+ macPix->toplevel = NULL;
+ macPix->flags = 0;
+
+ bounds.top = bounds.left = 0;
+ bounds.right = (short) width;
+ bounds.bottom = (short) height;
+ if (depth != 1) {
+ depth = 0;
+ }
+
+ /*
+ * Allocate memory for the off screen pixmap. If we fail
+ * try again from system memory. Eventually, we may have
+ * to panic.
+ */
+ err = NewGWorld(&gWorld, depth, &bounds, NULL, NULL, 0);
+ if (err != noErr) {
+ err = NewGWorld(&gWorld, depth, &bounds, NULL, NULL, useTempMem);
+ }
+ if (err != noErr) {
+ panic("Out of memory: NewGWorld failed in Tk_GetPixmap");
+ }
+
+ /*
+ * Lock down the pixels so they don't move out from under us.
+ */
+ pixels = GetGWorldPixMap(gWorld);
+ LockPixels(pixels);
+ macPix->portPtr = gWorld;
+
+ return (Pixmap) macPix;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreePixmap --
+ *
+ * Release the resources associated with a pixmap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Deletes the Macintosh GWorld created by Tk_GetPixmap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreePixmap(
+ Display *display, /* Display. */
+ Pixmap pixmap) /* Pixmap to destroy */
+{
+ MacDrawable *macPix = (MacDrawable *) pixmap;
+ PixMapHandle pixels;
+
+ display->request++;
+ pixels = GetGWorldPixMap(macPix->portPtr);
+ UnlockPixels(pixels);
+ DisposeGWorld(macPix->portPtr);
+ ckfree((char *) macPix);
+}
+
diff --git a/tk/mac/tkMacTest.c b/tk/mac/tkMacTest.c
new file mode 100644
index 00000000000..6d23c6eca68
--- /dev/null
+++ b/tk/mac/tkMacTest.c
@@ -0,0 +1,81 @@
+/*
+ * 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$
+ */
+
+#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,
+ 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, "debugger", DebuggerCmd,
+ (ClientData) 0, (Tcl_CmdDeleteProc *) NULL);
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DebuggerCmd --
+ *
+ * This procedure simply calls the low level debugger.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DebuggerCmd(
+ ClientData clientData, /* Not used. */
+ Tcl_Interp *interp, /* Not used. */
+ int argc, /* Not used. */
+ char **argv) /* Not used. */
+{
+ Debugger();
+ return TCL_OK;
+}
diff --git a/tk/mac/tkMacWindowMgr.c b/tk/mac/tkMacWindowMgr.c
new file mode 100644
index 00000000000..af12dacad00
--- /dev/null
+++ b/tk/mac/tkMacWindowMgr.c
@@ -0,0 +1,1630 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include <Events.h>
+#include <Dialogs.h>
+#include <EPPC.h>
+#include <Windows.h>
+#include <ToolUtils.h>
+#include <DiskInit.h>
+#include <LowMem.h>
+#include <Timer.h>
+#include <Sound.h>
+
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkMacInt.h"
+
+#define TK_DEFAULT_ABOUT 128
+
+/*
+ * Declarations of global variables defined in this file.
+ */
+
+int tkMacAppInFront = true; /* Boolean variable for determining
+ * if we are the frontmost app. */
+
+/*
+ * Non-standard event types that can be passed to HandleEvent.
+ * These are defined and used by Netscape's plugin architecture.
+ */
+#define getFocusEvent (osEvt + 16)
+#define loseFocusEvent (osEvt + 17)
+#define adjustCursorEvent (osEvt + 18)
+
+/*
+ * Declarations of static variables used in this file.
+ */
+
+static int gEatButtonUp = 0; /* 1 if we need to eat the next
+ * up event */
+static Tk_Window gGrabWinPtr = NULL; /* Current grab window, NULL if no grab. */
+static Tk_Window gKeyboardWinPtr = NULL; /* Current keyboard grab window. */
+static RgnHandle gDamageRgn = NULL; /* Damage region used for handling
+ * screen updates. */
+/*
+ * Forward declarations of procedures used in this file.
+ */
+
+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,
+ int adjustCursor));
+static OSErr TellWindowDefProcToCalcRegions _ANSI_ARGS_((WindowRef wRef));
+static int WindowManagerMouse _ANSI_ARGS_((EventRecord *theEvent,
+ Window window));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WindowManagerMouse --
+ *
+ * This function determines if a button event is a "Window Manager"
+ * function or an event that should be passed to Tk's event
+ * queue.
+ *
+ * Results:
+ * Return true if event was placed on Tk's event queue.
+ *
+ * Side effects:
+ * Depends on where the button event occurs.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WindowManagerMouse(
+ EventRecord *eventPtr, /* Macintosh event record. */
+ 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)) {
+ if ((gGrabWinPtr != NULL) && (gGrabWinPtr != tkwin)) {
+ SysBeep(1);
+ return false;
+ }
+ }
+ }
+
+ /*
+ * Call DragWindow to move the window around. It will
+ * also eat the mouse up event.
+ */
+ SetPort((GrafPort *) whichWindow);
+ where.h = where.v = 0;
+ LocalToGlobal(&where);
+ DragWindow(whichWindow, eventPtr->where,
+ &tcl_macQdPtr->screenBits.bounds);
+ gEatButtonUp = false;
+
+ where2.h = where2.v = 0;
+ LocalToGlobal(&where2);
+ if (EqualPt(where, where2)) {
+ return false;
+ }
+
+ TkMacWindowOffset(whichWindow, &xOffset, &yOffset);
+ where2.h -= xOffset;
+ where2.v -= yOffset;
+ TkGenWMConfigureEvent(tkwin, where2.h, where2.v,
+ -1, -1, TK_LOCATION_CHANGED);
+ return true;
+ case inGrow:
+ case inContent:
+ if (whichWindow != frontWindow ) {
+ /*
+ * This click moves the window forward. We don't want
+ * the corasponding mouse-up to be reported to the application
+ * or else it will mess up some Tk scripts.
+ */
+ if ((gGrabWinPtr != NULL) && (gGrabWinPtr != tkwin)) {
+ SysBeep(1);
+ return false;
+ }
+ BringWindowForward(whichWindow);
+ gEatButtonUp = true;
+ SetPort((GrafPort *) whichWindow);
+ return false;
+ } else {
+ /*
+ * Generally the content region is the domain of Tk
+ * sub-windows. However, one exception is the grow
+ * region. A button down in this area will be handled
+ * by the window manager. Note: this means that Tk
+ * may not get button down events in this area!
+ */
+
+ if (TkMacGrowToplevel(whichWindow, eventPtr->where) == true) {
+ return true;
+ } else {
+ return TkGenerateButtonEvent(eventPtr->where.h,
+ eventPtr->where.v, window, TkMacButtonKeyState());
+ }
+ }
+ case inGoAway:
+ if (TrackGoAway( whichWindow, eventPtr->where)) {
+ if (tkwin == NULL) {
+ return false;
+ }
+ TkGenWMDestroyEvent(tkwin);
+ return true;
+ }
+ return false;
+ case inMenuBar:
+ {
+ int oldMode;
+ KeyMap theKeys;
+
+ GetKeys(theKeys);
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ TkMacClearMenubarActive();
+ TkMacHandleMenuSelect(MenuSelect(eventPtr->where),
+ theKeys[1] & 4);
+ Tcl_SetServiceMode(oldMode);
+ return true; /* TODO: may not be on event on queue. */
+ }
+ case inZoomIn:
+ case inZoomOut:
+ if (TkMacZoomToplevel(whichWindow, eventPtr->where, windowPart)
+ == true) {
+ return true;
+ } else {
+ return false;
+ }
+ default:
+ return false;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkAboutDlg --
+ *
+ * Displays the default Tk About box. This code uses Macintosh
+ * resources to define the content of the About Box.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkAboutDlg()
+{
+ DialogPtr aboutDlog;
+ short itemHit = -9;
+
+ aboutDlog = GetNewDialog(128, NULL, (void*)(-1));
+
+ if (!aboutDlog) {
+ return;
+ }
+
+ SelectWindow((WindowRef) aboutDlog);
+
+ while (itemHit != 1) {
+ ModalDialog( NULL, &itemHit);
+ }
+ DisposDialog(aboutDlog);
+ aboutDlog = NULL;
+
+ SelectWindow(FrontWindow());
+
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateUpdateEvent --
+ *
+ * Given a Macintosh update event this function generates all the
+ * X update events needed by Tk.
+ *
+ * Results:
+ * True if event(s) are generated - false otherwise.
+ *
+ * Side effects:
+ * Additional events may be place on the Tk event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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();
+ }
+
+ /*
+ * After the call to BeginUpdate the visable region (visRgn) of the
+ * window is equal to the intersection of the real visable region and
+ * the update region for this event. We use this region in all of our
+ * calculations.
+ */
+
+ if (eventPtr->message != NULL) {
+ macWindow = (WindowRef) TkMacGetDrawablePort(window);
+ BeginUpdate(macWindow);
+ GenerateUpdates(macWindow->visRgn, winPtr);
+ EndUpdate(macWindow);
+ return true;
+ } else {
+ /*
+ * This event didn't come from the system. This might
+ * occur if we are running from inside of Netscape.
+ * In this we shouldn't call BeginUpdate as the vis region
+ * may be NULL.
+ */
+ RgnHandle rgn;
+ Rect bounds;
+
+ rgn = NewRgn();
+ TkMacWinBounds(winPtr, &bounds);
+ RectRgn(rgn, &bounds);
+ GenerateUpdates(rgn, winPtr);
+ DisposeRgn(rgn);
+ return true;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateUpdates --
+ *
+ * Given a Macintosh update region and a Tk window this function
+ * geneates a X damage event for the window if it is within the
+ * update region. The function will then recursivly have each
+ * damaged window generate damage events for its child windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Additional events may be place on the Tk event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GenerateUpdates(
+ RgnHandle updateRgn,
+ TkWindow *winPtr)
+{
+ TkWindow *childPtr;
+ XEvent event;
+ Rect bounds;
+
+ TkMacWinBounds(winPtr, &bounds);
+
+ if (bounds.top > (*updateRgn)->rgnBBox.bottom ||
+ (*updateRgn)->rgnBBox.top > bounds.bottom ||
+ bounds.left > (*updateRgn)->rgnBBox.right ||
+ (*updateRgn)->rgnBBox.left > bounds.right ||
+ !RectInRgn(&bounds, updateRgn)) {
+ return;
+ }
+
+ event.xany.serial = Tk_Display(winPtr)->request;
+ event.xany.send_event = false;
+ event.xany.window = Tk_WindowId(winPtr);
+ event.xany.display = Tk_Display(winPtr);
+
+ event.type = Expose;
+
+ /*
+ * Compute the bounding box of the area that the damage occured in.
+ */
+
+ /*
+ * CopyRgn(TkMacVisableClipRgn(winPtr), rgn);
+ * TODO: this call doesn't work doing resizes!!!
+ */
+ RectRgn(gDamageRgn, &bounds);
+ SectRgn(gDamageRgn, updateRgn, gDamageRgn);
+ OffsetRgn(gDamageRgn, -bounds.left, -bounds.top);
+ event.xexpose.x = (**gDamageRgn).rgnBBox.left;
+ event.xexpose.y = (**gDamageRgn).rgnBBox.top;
+ event.xexpose.width = (**gDamageRgn).rgnBBox.right -
+ (**gDamageRgn).rgnBBox.left;
+ event.xexpose.height = (**gDamageRgn).rgnBBox.bottom -
+ (**gDamageRgn).rgnBBox.top;
+ event.xexpose.count = 0;
+
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+
+ /*
+ * Generate updates for the children of this window
+ */
+
+ for (childPtr = winPtr->childList; childPtr != NULL;
+ childPtr = childPtr->nextPtr) {
+ if (!Tk_IsMapped(childPtr) || Tk_IsTopLevel(childPtr)) {
+ continue;
+ }
+
+ GenerateUpdates(updateRgn, childPtr);
+ }
+
+ /*
+ * Generate updates for any contained windows
+ */
+
+ if (Tk_IsContainer(winPtr)) {
+ childPtr = TkpGetOtherWindow(winPtr);
+ if (childPtr != NULL && Tk_IsMapped(childPtr)) {
+ GenerateUpdates(updateRgn, childPtr);
+ }
+
+ /*
+ * NOTE: Here we should handle out of process embedding.
+ */
+
+ }
+
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGenerateButtonEvent --
+ *
+ * Given a global x & y position and the button key status this
+ * procedure generates the appropiate X button event. It also
+ * handles the state changes needed to implement implicit grabs.
+ *
+ * Results:
+ * True if event(s) are generated - false otherwise.
+ *
+ * Side effects:
+ * Additional events may be place on the Tk event queue.
+ * Grab state may also change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkGenerateButtonEvent(
+ int x, /* X location of mouse */
+ int y, /* Y location of mouse */
+ 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);
+
+ return true;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateActivateEvents --
+ *
+ * Generate Activate/Deactivate events from a Macintosh Activate
+ * event. Note, the activate-on-foreground bit must be set in the
+ * SIZE flags to ensure we get Activate/Deactivate in addition to
+ * Susspend/Resume events.
+ *
+ * Results:
+ * Returns true if events were generate.
+ *
+ * Side effects:
+ * Queue events on Tk's event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XSetInputFocus --
+ *
+ * Change the focus window for the application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XSetInputFocus(
+ Display* display,
+ Window focus,
+ int revert_to,
+ Time time)
+{
+ /*
+ * Don't need to do a thing. Tk manages the focus for us.
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpChangeFocus --
+ *
+ * This procedure is a stub on the Mac because we always own the
+ * focus if we are a front most application.
+ *
+ * Results:
+ * The return value is the serial number of the command that
+ * changed the focus. It may be needed by the caller to filter
+ * out focus change events that were queued before the command.
+ * If the procedure doesn't actually change the focus then
+ * it returns 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpChangeFocus(winPtr, force)
+ TkWindow *winPtr; /* Window that is to receive the X focus. */
+ int force; /* Non-zero means claim the focus even
+ * if it didn't originally belong to
+ * topLevelPtr's application. */
+{
+ /*
+ * We don't really need to do anything on the Mac. Tk will
+ * keep all this state for us.
+ */
+
+ if (winPtr->atts.override_redirect) {
+ return 0;
+ }
+
+ /*
+ * 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
+ * events on either side of the mark.
+ */
+
+ return NextRequest(winPtr->display);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateFocusEvent --
+ *
+ * Generate FocusIn/FocusOut events from a Macintosh Activate
+ * event. Note, the activate-on-foreground bit must be set in
+ * the SIZE flags to ensure we get Activate/Deactivate in addition
+ * to Susspend/Resume events.
+ *
+ * Results:
+ * Returns true if events were generate.
+ *
+ * Side effects:
+ * Queue events on Tk's event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateKeyEvent --
+ *
+ * Given Macintosh keyUp, keyDown & autoKey events this function
+ * generates the appropiate X key events. The window that is passed
+ * should represent the frontmost window - which will recieve the
+ * event.
+ *
+ * Results:
+ * True if event(s) are generated - false otherwise.
+ *
+ * Side effects:
+ * Additional events may be place on the Tk event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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();
+
+ if (eventPtr->what == keyDown) {
+ event.xany.type = KeyPress;
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ } else if (eventPtr->what == keyUp) {
+ event.xany.type = KeyRelease;
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ } else {
+ /*
+ * Autokey events send multiple XKey events.
+ *
+ * Note: the last KeyRelease will always be missed with
+ * this scheme. However, most Tk scripts don't look for
+ * KeyUp events so we should be OK.
+ */
+ event.xany.type = KeyRelease;
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ event.xany.type = KeyPress;
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ }
+ return true;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GeneratePollingEvents --
+ *
+ * This function polls the mouse position and generates X Motion,
+ * Enter & Leave events. The cursor is also updated at this
+ * time.
+ *
+ * Results:
+ * True if event(s) are generated - false otherwise.
+ *
+ * Side effects:
+ * Additional events may be place on the Tk event queue.
+ * The cursor may be changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GeneratePollingEvents()
+{
+ Tk_Window tkwin, rootwin;
+ 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;
+ }
+ SetPort((GrafPort *) frontWin);
+
+ GetMouse(&whereLocal);
+ whereGlobal = whereLocal;
+ LocalToGlobal(&whereGlobal);
+
+ 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) &&
+ TkMacResizable((TkWindow *) tkwin) &&
+ (TkMacGetScrollbarGrowWindow((TkWindow *) tkwin) == NULL)) {
+ TkMacInstallCursor(1);
+ } else {
+ TkMacInstallCursor(0);
+ }
+
+ return true;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GeneratePollingEvents2 --
+ *
+ * This function polls the mouse position and generates X Motion,
+ * Enter & Leave events. The cursor is also updated at this
+ * time. NOTE: this version is for Netscape!!!
+ *
+ * Results:
+ * True if event(s) are generated - false otherwise.
+ *
+ * Side effects:
+ * Additional events may be place on the Tk event queue.
+ * 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;
+
+ /*
+ * 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;
+ }
+ SetPort((GrafPort *) frontWin);
+
+ GetMouse(&whereLocal);
+ whereGlobal = whereLocal;
+ LocalToGlobal(&whereGlobal);
+
+ /*
+ * 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.
+ */
+
+ if (adjustCursor) {
+ TkMacInstallCursor(0);
+ }
+ return true;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacButtonKeyState --
+ *
+ * Returns the current state of the button & modifier keys.
+ *
+ * Results:
+ * A bitwise inclusive OR of a subset of the following:
+ * Button1Mask, ShiftMask, LockMask, ControlMask, Mod?Mask,
+ * Mod?Mask.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+unsigned int
+TkMacButtonKeyState()
+{
+ unsigned int state = 0;
+ KeyMap theKeys;
+
+ if (Button() & !gEatButtonUp) {
+ state |= Button1Mask;
+ }
+
+ GetKeys(theKeys);
+
+ if (theKeys[1] & 2) {
+ state |= LockMask;
+ }
+
+ if (theKeys[1] & 1) {
+ state |= ShiftMask;
+ }
+
+ if (theKeys[1] & 8) {
+ state |= ControlMask;
+ }
+
+ if (theKeys[1] & 32768) {
+ state |= Mod1Mask; /* command key */
+ }
+
+ if (theKeys[1] & 4) {
+ state |= Mod2Mask; /* option key */
+ }
+
+ return state;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XGrabKeyboard --
+ *
+ * Simulates a keyboard grab by setting the focus.
+ *
+ * Results:
+ * Always returns GrabSuccess.
+ *
+ * Side effects:
+ * Sets the keyboard focus to the specified window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+XGrabKeyboard(
+ Display* display,
+ Window grab_window,
+ Bool owner_events,
+ int pointer_mode,
+ int keyboard_mode,
+ Time time)
+{
+ gKeyboardWinPtr = Tk_IdToWindow(display, grab_window);
+ return GrabSuccess;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XUngrabKeyboard --
+ *
+ * Releases the simulated keyboard grab.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets the keyboard focus back to the value before the grab.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XUngrabKeyboard(
+ Display* display,
+ Time time)
+{
+ gKeyboardWinPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XQueryPointer --
+ *
+ * Check the current state of the mouse. This is not a complete
+ * implementation of this function. It only computes the root
+ * coordinates and the current mask.
+ *
+ * Results:
+ * Sets root_x_return, root_y_return, and mask_return. Returns
+ * true on success.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Bool
+XQueryPointer(
+ 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)
+{
+ Point where;
+
+ GetMouse(&where);
+ LocalToGlobal(&where);
+ *root_x_return = where.h;
+ *root_y_return = where.v;
+ *mask_return = TkMacButtonKeyState();
+ return True;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacGenerateTime --
+ *
+ * Returns the total number of ticks from startup This function
+ * is used to generate the time of generated X events.
+ *
+ * Results:
+ * Returns the current time (ticks from startup).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Time
+TkMacGenerateTime()
+{
+ return (Time) LMGetTicks();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacConvertEvent --
+ *
+ * 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
+TkMacConvertEvent(
+ EventRecord *eventPtr)
+{
+ WindowRef whichWindow;
+ Window window;
+ int eventFound = false;
+
+ switch (eventPtr->what) {
+ case nullEvent:
+ case adjustCursorEvent:
+ if (GeneratePollingEvents()) {
+ eventFound = true;
+ }
+ break;
+ case updateEvt:
+ whichWindow = (WindowRef)eventPtr->message;
+ window = TkMacGetXWindow(whichWindow);
+ if (GenerateUpdateEvent(eventPtr, window)) {
+ eventFound = true;
+ }
+ break;
+ case mouseDown:
+ case mouseUp:
+ FindWindow(eventPtr->where, &whichWindow);
+ window = TkMacGetXWindow(whichWindow);
+ if (WindowManagerMouse(eventPtr, window)) {
+ eventFound = true;
+ }
+ break;
+ case autoKey:
+ case keyDown:
+ /*
+ * Handle menu-key events here. If it is *not*
+ * a menu key - just fall through to handle as a
+ * normal key event.
+ */
+ if ((eventPtr->modifiers & cmdKey) == cmdKey) {
+ long menuResult;
+ int oldMode;
+
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ menuResult = MenuKey(eventPtr->message & charCodeMask);
+ 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;
+ window = TkMacGetXWindow((WindowRef) eventPtr->message);
+ eventFound |= GenerateFocusEvent(eventPtr, window);
+ break;
+ case loseFocusEvent:
+ eventPtr->modifiers &= ~activeFlag;
+ window = TkMacGetXWindow((WindowRef) eventPtr->message);
+ 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 (GeneratePollingEvents()) {
+ eventFound = true;
+ }
+ break;
+ case suspendResumeMessage:
+ if (!(eventPtr->message & resumeFlag)) {
+ TkSuspendClipboard();
+ }
+ tkMacAppInFront = (eventPtr->message & resumeFlag);
+ break;
+ }
+ break;
+ case diskEvt:
+ /*
+ * Disk insertion.
+ */
+ if (HiWord(eventPtr->message) != noErr) {
+ Point pt;
+
+ DILoad();
+ 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. 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;
+
+ /*
+ * 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);
+ LocalToGlobal(&where);
+ eventFound |= TkGenerateButtonEvent(where.h, where.v,
+ window, TkMacButtonKeyState());
+ break;
+ case autoKey:
+ case keyDown:
+ /*
+ * Handle menu-key events here. If it is *not*
+ * a menu key - just fall through to handle as a
+ * normal key event.
+ */
+ if ((eventPtr->modifiers & cmdKey) == cmdKey) {
+ long menuResult = MenuKey(eventPtr->message & charCodeMask);
+
+ if (HiWord(menuResult) != 0) {
+ TkMacHandleMenuSelect(menuResult, false);
+ break;
+ }
+ }
+ case keyUp:
+ eventFound |= GenerateKeyEvent(eventPtr, window);
+ 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;
+ }
+ break;
+ case diskEvt:
+ /*
+ * Disk insertion.
+ */
+ if (HiWord(eventPtr->message) != noErr) {
+ Point pt;
+
+ DILoad();
+ pt.v = pt.h = 120; /* parameter ignored in sys 7 */
+ DIBadMount(pt, eventPtr->message);
+ DIUnload();
+ }
+ break;
+ }
+
+ return eventFound;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CheckEventsAvail --
+ *
+ * Checks to see if events are available on the Macintosh queue.
+ * This function looks for both queued events (eg. key & button)
+ * and generated events (update).
+ *
+ * Results:
+ * True is events exist, false otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+CheckEventsAvail()
+{
+ QHdrPtr evPtr;
+ WindowPeek macWinPtr;
+
+ evPtr = GetEvQHdr();
+ if (evPtr->qHead != NULL) {
+ return true;
+ }
+
+ macWinPtr = (WindowPeek) FrontWindow();
+ while (macWinPtr != NULL) {
+ if (!EmptyRgn(macWinPtr->updateRgn)) {
+ return true;
+ }
+ macWinPtr = macWinPtr->nextWindow;
+ }
+ return false;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpSetCapture --
+ *
+ * This function captures the mouse so that all future events
+ * will be reported to this window, even if the mouse is outside
+ * the window. If the specified window is NULL, then the mouse
+ * is released.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets the capture flag and captures the mouse.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpSetCapture(
+ TkWindow *winPtr) /* Capture window, or NULL. */
+{
+ while ((winPtr != NULL) && !Tk_IsTopLevel(winPtr)) {
+ winPtr = winPtr->parentPtr;
+ }
+ gGrabWinPtr = (Tk_Window) winPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacWindowOffset --
+ *
+ * Determines the x and y offset from the orgin of the toplevel
+ * window dressing (the structure region, ie. title bar) and the
+ * orgin of the content area.
+ *
+ * Results:
+ * The x & y offset in pixels.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacWindowOffset(
+ WindowRef wRef,
+ int *xOffset,
+ int *yOffset)
+{
+ OSErr err = noErr;
+ WindowPeek wPeek = (WindowPeek) wRef;
+ RgnHandle strucRgn = wPeek->strucRgn;
+ RgnHandle contRgn = wPeek->contRgn;
+ Rect strucRect, contRect;
+
+ if (!EmptyRgn(strucRgn) && !EmptyRgn(contRgn)) {
+ strucRect = (**strucRgn).rgnBBox;
+ contRect = (**contRgn).rgnBBox;
+ } else {
+ /*
+ * The current window's regions are not up to date.
+ * Probably because the window isn't visable. What we
+ * will do is save the old regions, have the window calculate
+ * what the regions should be, and then restore it self.
+ */
+ strucRgn = NewRgn( );
+ contRgn = NewRgn( );
+
+ if (!strucRgn || !contRgn) {
+ err = MemError( );
+ } else {
+ CopyRgn(wPeek->strucRgn, strucRgn);
+ CopyRgn(wPeek->contRgn, contRgn);
+
+ if (!(err = TellWindowDefProcToCalcRegions(wRef))) {
+ strucRect = (**(wPeek->strucRgn)).rgnBBox;
+ contRect = (**(wPeek->contRgn)).rgnBBox;
+ }
+
+ CopyRgn(strucRgn, wPeek->strucRgn);
+ CopyRgn(contRgn, wPeek->contRgn);
+ }
+
+ if (contRgn) {
+ DisposeRgn(contRgn);
+ }
+
+ if (strucRgn) {
+ DisposeRgn(strucRgn);
+ }
+ }
+
+ if (!err) {
+ *xOffset = contRect.left - strucRect.left;
+ *yOffset = contRect.top - strucRect.top;
+ } else {
+ *xOffset = 0;
+ *yOffset = 0;
+ }
+
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TellWindowDefProcToCalcRegions --
+ *
+ * Force a Macintosh window to recalculate it's content and
+ * structure regions.
+ *
+ * Results:
+ * An OS error.
+ *
+ * Side effects:
+ * The windows content and structure regions may be updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static OSErr
+TellWindowDefProcToCalcRegions(
+ WindowRef wRef)
+{
+ OSErr err = noErr;
+ SInt8 hState;
+ Handle wdef = ((WindowPeek) wRef)->windowDefProc;
+
+ /*
+ * Load and lock the window definition procedure for
+ * the window.
+ */
+ hState = HGetState(wdef);
+ if (!(err = MemError())) {
+ LoadResource(wdef);
+ if (!(err = ResError())) {
+ MoveHHi(wdef);
+ err = MemError();
+ if (err == memLockedErr) {
+ err = noErr;
+ } else if (!err) {
+ HLock(wdef);
+ err = MemError();
+ }
+ }
+ }
+
+ /*
+ * 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();
+ }
+ }
+
+ return err;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * BringWindowForward --
+ *
+ * Bring this background window to the front. We also set state
+ * so Tk thinks the button is currently up.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is brought forward.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+BringWindowForward(
+ WindowRef wRef)
+{
+ SelectWindow(wRef);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetMS --
+ *
+ * Return a relative time in milliseconds. It doesn't matter
+ * when the epoch was.
+ *
+ * Results:
+ * Number of milliseconds.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+unsigned long
+TkpGetMS()
+{
+ long long * int64Ptr;
+ UnsignedWide micros;
+
+ Microseconds(&micros);
+ int64Ptr = (long long *) &micros;
+
+ /*
+ * We need 64 bit math to do this. This is available in CW 11
+ * and on. Other's will need to use a different scheme.
+ */
+
+ *int64Ptr /= 1000;
+
+ return (long) *int64Ptr;
+}
diff --git a/tk/mac/tkMacWm.c b/tk/mac/tkMacWm.c
new file mode 100644
index 00000000000..033b0d72855
--- /dev/null
+++ b/tk/mac/tkMacWm.c
@@ -0,0 +1,4233 @@
+/*
+ * 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$
+ */
+
+#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.
+ */
+
+typedef struct ProtocolHandler {
+ Atom protocol; /* Identifies the protocol. */
+ struct ProtocolHandler *nextPtr;
+ /* Next in list of protocol handlers for
+ * the same top-level window, or NULL for
+ * end of list. */
+ Tcl_Interp *interp; /* Interpreter in which to invoke command. */
+ char command[4]; /* Tcl command to invoke when a client
+ * message for this protocol arrives.
+ * The actual size of the structure varies
+ * to accommodate the needs of the actual
+ * command. THIS MUST BE THE LAST FIELD OF
+ * THE STRUCTURE. */
+} ProtocolHandler;
+
+#define HANDLER_SIZE(cmdLength) \
+((unsigned) (sizeof(ProtocolHandler) - 3 + cmdLength))
+
+/*
+ * A data structure of the following type holds window-manager-related
+ * information for each top-level window in an application.
+ */
+
+typedef struct TkWmInfo {
+ TkWindow *winPtr; /* Pointer to main Tk information for
+ * this window. */
+ Window reparent; /* If the window has been reparented, this
+ * gives the ID of the ancestor of the window
+ * that is a child of the root window (may
+ * not be window's immediate parent). If
+ * the window isn't reparented, this has the
+ * value None. */
+ Tk_Uid titleUid; /* Title to display in window caption. If
+ * NULL, use name of widget. */
+ Tk_Uid iconName; /* Name to display in icon. */
+ Window master; /* Master window for TRANSIENT_FOR property,
+ * or None. */
+ XWMHints hints; /* Various pieces of information for
+ * window manager. */
+ char *leaderName; /* Path name of leader of window group
+ * (corresponds to hints.window_group).
+ * Malloc-ed. Note: this field doesn't
+ * get updated if leader is destroyed. */
+ char *masterWindowName; /* Path name of window specified as master
+ * in "wm transient" command, or NULL.
+ * Malloc-ed. Note: this field doesn't
+ * get updated if masterWindowName is
+ * destroyed. */
+ Tk_Window icon; /* Window to use as icon for this window,
+ * or NULL. */
+ Tk_Window iconFor; /* Window for which this window is icon, or
+ * NULL if this isn't an icon for anyone. */
+
+ /*
+ * Information used to construct an XSizeHints structure for
+ * the window manager:
+ */
+
+ int sizeHintsFlags; /* Flags word for XSizeHints structure.
+ * If the PBaseSize flag is set then the
+ * window is gridded; otherwise it isn't
+ * gridded. */
+ int minWidth, minHeight; /* Minimum dimensions of window, in
+ * grid units, not pixels. */
+ int maxWidth, maxHeight; /* Maximum dimensions of window, in
+ * grid units, not pixels. */
+ Tk_Window gridWin; /* Identifies the window that controls
+ * gridding for this top-level, or NULL if
+ * the top-level isn't currently gridded. */
+ int widthInc, heightInc; /* Increments for size changes (# pixels
+ * per step). */
+ struct {
+ int x; /* numerator */
+ int y; /* denominator */
+ } minAspect, maxAspect; /* Min/max aspect ratios for window. */
+ int reqGridWidth, reqGridHeight;
+ /* The dimensions of the window (in
+ * grid units) requested through
+ * the geometry manager. */
+ int gravity; /* Desired window gravity. */
+
+ /*
+ * Information used to manage the size and location of a window.
+ */
+
+ int width, height; /* Desired dimensions of window, specified
+ * in grid units. These values are
+ * set by the "wm geometry" command and by
+ * ConfigureNotify events (for when wm
+ * resizes window). -1 means user hasn't
+ * requested dimensions. */
+ int x, y; /* Desired X and Y coordinates for window.
+ * These values are set by "wm geometry",
+ * plus by ConfigureNotify events (when wm
+ * moves window). These numbers are
+ * different than the numbers stored in
+ * winPtr->changes because (a) they could be
+ * measured from the right or bottom edge
+ * of the screen (see WM_NEGATIVE_X and
+ * WM_NEGATIVE_Y flags) and (b) if the window
+ * has been reparented then they refer to the
+ * parent rather than the window itself. */
+ int parentWidth, parentHeight;
+ /* Width and height of reparent, in pixels
+ * *including border*. If window hasn't been
+ * reparented then these will be the outer
+ * dimensions of the window, including
+ * border. */
+ int xInParent, yInParent; /* Offset of window within reparent, measured
+ * from upper-left outer corner of parent's
+ * border to upper-left outer corner of child's
+ * border. If not reparented then these are
+ * zero. */
+ int configWidth, configHeight;
+ /* Dimensions passed to last request that we
+ * issued to change geometry of window. Used
+ * to eliminate redundant resize operations. */
+
+ /*
+ * Information about the virtual root window for this top-level,
+ * if there is one.
+ */
+
+ Window vRoot; /* Virtual root window for this top-level,
+ * or None if there is no virtual root
+ * window (i.e. just use the screen's root). */
+ int vRootX, vRootY; /* Position of the virtual root inside the
+ * root window. If the WM_VROOT_OFFSET_STALE
+ * flag is set then this information may be
+ * incorrect and needs to be refreshed from
+ * the X server. If vRoot is None then these
+ * values are both 0. */
+ unsigned int vRootWidth, vRootHeight;
+ /* Dimensions of the virtual root window.
+ * If vRoot is None, gives the dimensions
+ * of the containing screen. This information
+ * is never stale, even though vRootX and
+ * vRootY can be. */
+
+ /*
+ * List of children of the toplevel which have private colormaps.
+ */
+
+ TkWindow **cmapList; /* Array of window with private colormaps. */
+ int cmapCount; /* Number of windows in array. */
+
+ /*
+ * Miscellaneous information.
+ */
+
+ ProtocolHandler *protPtr; /* First in list of protocol handlers for
+ * this window (NULL means none). */
+ int cmdArgc; /* Number of elements in cmdArgv below. */
+ char **cmdArgv; /* Array of strings to store in the
+ * WM_COMMAND property. NULL means nothing
+ * available. */
+ char *clientMachine; /* String to store in WM_CLIENT_MACHINE
+ * property, or NULL. */
+ int flags; /* Miscellaneous flags, defined below. */
+
+ /*
+ * Macintosh information.
+ */
+ int style; /* Native window style. */
+ TkWindow *scrollWinPtr; /* Ptr to scrollbar handling grow widget. */
+} WmInfo;
+
+
+/*
+ * Flag values for WmInfo structures:
+ *
+ * WM_NEVER_MAPPED - non-zero means window has never been
+ * mapped; need to update all info when
+ * window is first mapped.
+ * WM_UPDATE_PENDING - non-zero means a call to UpdateGeometryInfo
+ * has already been scheduled for this
+ * window; no need to schedule another one.
+ * WM_NEGATIVE_X - non-zero means x-coordinate is measured in
+ * pixels from right edge of screen, rather
+ * than from left edge.
+ * WM_NEGATIVE_Y - non-zero means y-coordinate is measured in
+ * pixels up from bottom of screen, rather than
+ * down from top.
+ * WM_UPDATE_SIZE_HINTS - non-zero means that new size hints need to be
+ * propagated to window manager.
+ * WM_SYNC_PENDING - set to non-zero while waiting for the window
+ * manager to respond to some state change.
+ * WM_VROOT_OFFSET_STALE - non-zero means that (x,y) offset information
+ * about the virtual root window is stale and
+ * needs to be fetched fresh from the X server.
+ * WM_ABOUT_TO_MAP - non-zero means that the window is about to
+ * be mapped by TkWmMapWindow. This is used
+ * by UpdateGeometryInfo to modify its behavior.
+ * WM_MOVE_PENDING - non-zero means the application has requested
+ * a new position for the window, but it hasn't
+ * been reflected through the window manager
+ * yet.
+ * WM_COLORMAPS_EXPLICIT - non-zero means the colormap windows were
+ * set explicitly via "wm colormapwindows".
+ * WM_ADDED_TOPLEVEL_COLORMAP - non-zero means that when "wm colormapwindows"
+ * was called the top-level itself wasn't
+ * specified, so we added it implicitly at
+ * the end of the list.
+ * WM_WIDTH_NOT_RESIZABLE - non-zero means that we're not supposed to
+ * allow the user to change the width of the
+ * window (controlled by "wm resizable"
+ * command).
+ * WM_HEIGHT_NOT_RESIZABLE - non-zero means that we're not supposed to
+ * allow the user to change the height of the
+ * window (controlled by "wm resizable"
+ * command).
+ */
+
+#define WM_NEVER_MAPPED 1
+#define WM_UPDATE_PENDING 2
+#define WM_NEGATIVE_X 4
+#define WM_NEGATIVE_Y 8
+#define WM_UPDATE_SIZE_HINTS 0x10
+#define WM_SYNC_PENDING 0x20
+#define WM_VROOT_OFFSET_STALE 0x40
+#define WM_ABOUT_TO_MAP 0x100
+#define WM_MOVE_PENDING 0x200
+#define WM_COLORMAPS_EXPLICIT 0x400
+#define WM_ADDED_TOPLEVEL_COLORMAP 0x800
+#define WM_WIDTH_NOT_RESIZABLE 0x1000
+#define WM_HEIGHT_NOT_RESIZABLE 0x2000
+
+/*
+ * This is a list of all of the toplevels that have been mapped so far. It is
+ * used by the menu code to inval windows that were damaged by menus, and will
+ * eventually also be used to keep track of floating windows.
+ */
+
+TkMacWindowList *tkMacWindowListPtr = NULL;
+
+/*
+ * 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 _ANSI_ARGS_((ClientData dummy,
+ Tk_Window tkwin));
+
+static Tk_GeomMgr wmMgrType = {
+ "wm", /* name */
+ TopLevelReqProc, /* requestProc */
+ (Tk_GeomLostSlaveProc *) NULL, /* lostSlaveProc */
+};
+
+/*
+ * 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,
+ Tk_Window tkwin));
+static void UpdateGeometryInfo _ANSI_ARGS_((
+ ClientData clientData));
+static void UpdateSizeHints _ANSI_ARGS_((TkWindow *winPtr));
+static void UpdateVRootGeometry _ANSI_ARGS_((WmInfo *wmPtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmNewWindow --
+ *
+ * This procedure is invoked whenever a new top-level
+ * window is created. Its job is to initialize the WmInfo
+ * structure for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A WmInfo structure gets allocated and initialized.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkWmNewWindow(
+ TkWindow *winPtr) /* Newly-created top-level window. */
+{
+ register WmInfo *wmPtr;
+
+ wmPtr = (WmInfo *) ckalloc(sizeof(WmInfo));
+ wmPtr->winPtr = winPtr;
+ wmPtr->reparent = None;
+ wmPtr->titleUid = NULL;
+ wmPtr->iconName = NULL;
+ wmPtr->master = None;
+ wmPtr->hints.flags = InputHint | StateHint;
+ wmPtr->hints.input = True;
+ wmPtr->hints.initial_state = NormalState;
+ wmPtr->hints.icon_pixmap = None;
+ wmPtr->hints.icon_window = None;
+ wmPtr->hints.icon_x = wmPtr->hints.icon_y = 0;
+ wmPtr->hints.icon_mask = None;
+ wmPtr->hints.window_group = None;
+ wmPtr->leaderName = NULL;
+ wmPtr->masterWindowName = NULL;
+ wmPtr->icon = NULL;
+ wmPtr->iconFor = NULL;
+ wmPtr->sizeHintsFlags = 0;
+ wmPtr->minWidth = wmPtr->minHeight = 1;
+
+ /*
+ * Default the maximum dimensions to the size of the display, minus
+ * a guess about how space is needed for window manager decorations.
+ */
+
+ wmPtr->maxWidth = DisplayWidth(winPtr->display, winPtr->screenNum) - 15;
+ wmPtr->maxHeight = DisplayHeight(winPtr->display, winPtr->screenNum) - 30;
+ wmPtr->gridWin = NULL;
+ wmPtr->widthInc = wmPtr->heightInc = 1;
+ wmPtr->minAspect.x = wmPtr->minAspect.y = 1;
+ wmPtr->maxAspect.x = wmPtr->maxAspect.y = 1;
+ wmPtr->reqGridWidth = wmPtr->reqGridHeight = -1;
+ wmPtr->gravity = NorthWestGravity;
+ wmPtr->width = -1;
+ wmPtr->height = -1;
+ wmPtr->x = winPtr->changes.x;
+ wmPtr->y = winPtr->changes.y;
+ wmPtr->parentWidth = winPtr->changes.width
+ + 2*winPtr->changes.border_width;
+ wmPtr->parentHeight = winPtr->changes.height
+ + 2*winPtr->changes.border_width;
+ wmPtr->xInParent = 0;
+ wmPtr->yInParent = 0;
+ wmPtr->cmapList = NULL;
+ wmPtr->cmapCount = 0;
+ wmPtr->configWidth = -1;
+ wmPtr->configHeight = -1;
+ wmPtr->vRoot = None;
+ wmPtr->protPtr = NULL;
+ wmPtr->cmdArgv = NULL;
+ wmPtr->clientMachine = NULL;
+ wmPtr->flags = WM_NEVER_MAPPED;
+ wmPtr->style = zoomDocProc;
+ wmPtr->scrollWinPtr = NULL;
+ winPtr->wmInfoPtr = wmPtr;
+
+ UpdateVRootGeometry(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,
+ TopLevelEventProc, (ClientData) winPtr);
+
+ /*
+ * Arrange for geometry requests to be reflected from the window
+ * to the window manager.
+ */
+
+ Tk_ManageGeometry((Tk_Window) winPtr, &wmMgrType, (ClientData) 0);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmMapWindow --
+ *
+ * This procedure is invoked to map a top-level window. This
+ * module gets a chance to update all window-manager-related
+ * information in properties before the window manager sees
+ * the map event and checks the properties. It also gets to
+ * decide whether or not to even map the window after all.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Properties of winPtr may get updated to provide up-to-date
+ * information to the window manager. The window may also get
+ * mapped, but it may not be if this procedure decides that
+ * isn't appropriate (e.g. because the window is withdrawn).
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkWmMapWindow(
+ TkWindow *winPtr) /* Top-level window that's about to
+ * be mapped. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ Point where = {0, 0};
+ int xOffset, yOffset;
+ int firstMap = false;
+ MacDrawable *macWin;
+
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ wmPtr->flags &= ~WM_NEVER_MAPPED;
+ firstMap = true;
+
+ /*
+ * Create the underlying Mac window for this Tk window.
+ */
+ macWin = (MacDrawable *) winPtr->window;
+ if (!TkMacHostToplevelExists(winPtr)) {
+ TkMacMakeRealWindowExist(winPtr);
+ }
+
+ /*
+ * Generate configure event when we first map the window.
+ */
+ LocalToGlobal(&where);
+ TkMacWindowOffset((WindowRef) TkMacGetDrawablePort((Drawable) macWin),
+ &xOffset, &yOffset);
+ where.h -= xOffset;
+ where.v -= yOffset;
+ TkGenWMConfigureEvent((Tk_Window) winPtr,
+ where.h, where.v, -1, -1, TK_LOCATION_CHANGED);
+
+ /*
+ * This is the first time this window has ever been mapped.
+ * Store all the window-manager-related information for the
+ * window.
+ */
+
+ if (wmPtr->titleUid == NULL) {
+ wmPtr->titleUid = winPtr->nameUid;
+ }
+
+ if (!Tk_IsEmbedded(winPtr)) {
+ TkSetWMName(winPtr, wmPtr->titleUid);
+ }
+
+ TkWmSetClass(winPtr);
+
+ if (wmPtr->iconName != NULL) {
+ XSetIconName(winPtr->display, winPtr->window, wmPtr->iconName);
+ }
+
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ }
+ if (wmPtr->hints.initial_state == WithdrawnState) {
+ return;
+ }
+
+ /*
+ * TODO: we need to display a window if it's iconic on creation.
+ */
+
+ if (wmPtr->hints.initial_state == IconicState) {
+ return;
+ }
+
+ /*
+ * Update geometry information.
+ */
+ wmPtr->flags |= WM_ABOUT_TO_MAP;
+ if (wmPtr->flags & WM_UPDATE_PENDING) {
+ Tk_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr);
+ }
+ UpdateGeometryInfo((ClientData) winPtr);
+ 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);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmUnmapWindow --
+ *
+ * This procedure is invoked to unmap a top-level window.
+ * On the Macintosh all we do is call XUnmapWindow.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Unmaps the window.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkWmUnmapWindow(
+ TkWindow *winPtr) /* Top-level window that's about to
+ * be mapped. */
+{
+ XUnmapWindow(winPtr->display, winPtr->window);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmDeadWindow --
+ *
+ * This procedure is invoked when a top-level window is
+ * about to be deleted. It cleans up the wm-related data
+ * structures for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The WmInfo structure for winPtr gets freed up.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkWmDeadWindow(winPtr)
+ TkWindow *winPtr; /* Top-level window that's being deleted. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ WmInfo *wmPtr2;
+
+ if (wmPtr == NULL) {
+ return;
+ }
+ if (wmPtr->hints.flags & IconPixmapHint) {
+ Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap);
+ }
+ if (wmPtr->hints.flags & IconMaskHint) {
+ Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask);
+ }
+ if (wmPtr->leaderName != NULL) {
+ ckfree(wmPtr->leaderName);
+ }
+ if (wmPtr->masterWindowName != NULL) {
+ ckfree(wmPtr->masterWindowName);
+ }
+ if (wmPtr->icon != NULL) {
+ wmPtr2 = ((TkWindow *) wmPtr->icon)->wmInfoPtr;
+ wmPtr2->iconFor = NULL;
+ }
+ if (wmPtr->iconFor != NULL) {
+ wmPtr2 = ((TkWindow *) wmPtr->iconFor)->wmInfoPtr;
+ wmPtr2->icon = NULL;
+ wmPtr2->hints.flags &= ~IconWindowHint;
+ }
+ while (wmPtr->protPtr != NULL) {
+ ProtocolHandler *protPtr;
+
+ protPtr = wmPtr->protPtr;
+ wmPtr->protPtr = protPtr->nextPtr;
+ Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC);
+ }
+ if (wmPtr->cmdArgv != NULL) {
+ ckfree((char *) wmPtr->cmdArgv);
+ }
+ if (wmPtr->clientMachine != NULL) {
+ ckfree((char *) wmPtr->clientMachine);
+ }
+ if (wmPtr->flags & WM_UPDATE_PENDING) {
+ Tk_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr);
+ }
+ ckfree((char *) wmPtr);
+ winPtr->wmInfoPtr = NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmSetClass --
+ *
+ * This procedure is invoked whenever a top-level window's
+ * class is changed. If the window has been mapped then this
+ * procedure updates the window manager property for the
+ * class. If the window hasn't been mapped, the update is
+ * deferred until just before the first mapping.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A window property may get updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkWmSetClass(
+ TkWindow *winPtr) /* Newly-created top-level window. */
+{
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_WmCmd --
+ *
+ * This procedure is invoked to process the "wm" 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_WmCmd(
+ 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) {
+ return TCL_ERROR;
+ }
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ Tcl_AppendResult(interp, "window \"", winPtr->pathName,
+ "\" isn't a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ wmPtr = winPtr->wmInfoPtr;
+ if ((c == 'a') && (strncmp(argv[1], "aspect", length) == 0)) {
+ int numer1, denom1, numer2, denom2;
+
+ if ((argc != 3) && (argc != 7)) {
+ 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;
+ }
+ return TCL_OK;
+ }
+ if (wmPtr->clientMachine != NULL) {
+ ckfree((char *) wmPtr->clientMachine);
+ }
+ wmPtr->clientMachine = (char *)
+ ckalloc((unsigned) (strlen(argv[3]) + 1));
+ strcpy(wmPtr->clientMachine, argv[3]);
+ } else if ((c == 'c') && (strncmp(argv[1], "colormapwindows", length) == 0)
+ && (length >= 3)) {
+ TkWindow **cmapList;
+ TkWindow *winPtr2;
+ int i, windowArgc, gotToplevel;
+ char **windowArgv;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # arguments: must be \"",
+ argv[0], " colormapwindows window ?windowList?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 3) {
+ Tk_MakeWindowExist((Tk_Window) winPtr);
+ for (i = 0; i < wmPtr->cmapCount; i++) {
+ if ((i == (wmPtr->cmapCount-1))
+ && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) {
+ break;
+ }
+ Tcl_AppendElement(interp, wmPtr->cmapList[i]->pathName);
+ }
+ return TCL_OK;
+ }
+ if (Tcl_SplitList(interp, argv[3], &windowArgc, &windowArgv)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ cmapList = (TkWindow **) ckalloc((unsigned)
+ ((windowArgc+1)*sizeof(TkWindow*)));
+ for (i = 0; i < windowArgc; i++) {
+ winPtr2 = (TkWindow *) Tk_NameToWindow(interp, windowArgv[i],
+ tkwin);
+ if (winPtr2 == NULL) {
+ ckfree((char *) cmapList);
+ ckfree((char *) windowArgv);
+ return TCL_ERROR;
+ }
+ if (winPtr2 == winPtr) {
+ gotToplevel = 1;
+ }
+ if (winPtr2->window == None) {
+ Tk_MakeWindowExist((Tk_Window) winPtr2);
+ }
+ cmapList[i] = winPtr2;
+ }
+ if (!gotToplevel) {
+ wmPtr->flags |= WM_ADDED_TOPLEVEL_COLORMAP;
+ cmapList[windowArgc] = winPtr;
+ windowArgc++;
+ } else {
+ wmPtr->flags &= ~WM_ADDED_TOPLEVEL_COLORMAP;
+ }
+ wmPtr->flags |= WM_COLORMAPS_EXPLICIT;
+ if (wmPtr->cmapList != NULL) {
+ ckfree((char *)wmPtr->cmapList);
+ }
+ wmPtr->cmapList = cmapList;
+ wmPtr->cmapCount = windowArgc;
+ ckfree((char *) windowArgv);
+
+ /*
+ * On the Macintosh all of this is just an excercise
+ * in compatability as we don't support colormaps. If
+ * we did they would be installed here.
+ */
+
+ 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_FreeProc *) free;
+ }
+ return TCL_OK;
+ }
+ if (argv[3][0] == 0) {
+ if (wmPtr->cmdArgv != NULL) {
+ ckfree((char *) wmPtr->cmdArgv);
+ wmPtr->cmdArgv = NULL;
+ }
+ return TCL_OK;
+ }
+ if (Tcl_SplitList(interp, argv[3], &cmdArgc, &cmdArgv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (wmPtr->cmdArgv != NULL) {
+ ckfree((char *) wmPtr->cmdArgv);
+ }
+ wmPtr->cmdArgc = cmdArgc;
+ wmPtr->cmdArgv = cmdArgv;
+ } 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;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't deiconify ", argv[2],
+ ": it is an icon for ", winPtr->pathName, (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (winPtr->flags & TK_EMBEDDED) {
+ Tcl_AppendResult(interp, "can't deiconify ", winPtr->pathName,
+ ": it is an embedded window", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * TODO: may not want to call this function - look at Map events gened.
+ */
+
+ TkpWmSetState(winPtr, NormalState);
+ } else if ((c == 'f') && (strncmp(argv[1], "focusmodel", length) == 0)
+ && (length >= 2)) {
+ 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.
+ */
+
+ wmPtr->sizeHintsFlags &= ~(PBaseSize|PResizeInc);
+ if (wmPtr->width != -1) {
+ wmPtr->width = winPtr->reqWidth + (wmPtr->width
+ - wmPtr->reqGridWidth)*wmPtr->widthInc;
+ wmPtr->height = winPtr->reqHeight + (wmPtr->height
+ - wmPtr->reqGridHeight)*wmPtr->heightInc;
+ }
+ wmPtr->widthInc = 1;
+ wmPtr->heightInc = 1;
+ } else {
+ 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);
+ }
+ wmPtr->leaderName = NULL;
+ } else {
+ tkwin2 = Tk_NameToWindow(interp, argv[3], tkwin);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_MakeWindowExist(tkwin2);
+ wmPtr->hints.window_group = Tk_WindowId(tkwin2);
+ wmPtr->hints.flags |= WindowGroupHint;
+ wmPtr->leaderName = ckalloc((unsigned) (strlen(argv[3])+1));
+ strcpy(wmPtr->leaderName, argv[3]);
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "iconbitmap", length) == 0)
+ && (length >= 5)) {
+ Pixmap pixmap;
+
+ if ((argc != 3) && (argc != 4)) {
+ 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.flags &= ~IconPixmapHint;
+ } else {
+ pixmap = Tk_GetBitmap(interp, (Tk_Window) winPtr,
+ Tk_GetUid(argv[3]));
+ if (pixmap == None) {
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_pixmap = pixmap;
+ wmPtr->hints.flags |= IconPixmapHint;
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "iconify", length) == 0)
+ && (length >= 5)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # arguments: must be \"",
+ argv[0], " iconify window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
+ Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName,
+ "\": override-redirect flag is set", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->master != None) {
+ Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName,
+ "\": it is a transient", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't iconify ", argv[2],
+ ": it is an icon for ", Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (winPtr->flags & TK_EMBEDDED) {
+ Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName,
+ ": it is an embedded window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ TkpWmSetState(winPtr, IconicState);
+ } 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);
+ }
+ wmPtr->hints.flags &= ~IconMaskHint;
+ } else {
+ pixmap = Tk_GetBitmap(interp, tkwin, Tk_GetUid(argv[3]));
+ if (pixmap == None) {
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_mask = pixmap;
+ wmPtr->hints.flags |= IconMaskHint;
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "iconname", length) == 0)
+ && (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)
+ || (Tcl_GetInt(interp, argv[4], &y) != TCL_OK)){
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_x = x;
+ wmPtr->hints.icon_y = y;
+ wmPtr->hints.flags |= IconPositionHint;
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "iconwindow", length) == 0)
+ && (length >= 5)) {
+ Tk_Window tkwin2;
+ WmInfo *wmPtr2;
+
+ if ((argc != 3) && (argc != 4)) {
+ 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;
+ wmPtr2->iconFor = NULL;
+ wmPtr2->hints.initial_state = WithdrawnState;
+ }
+ wmPtr->icon = NULL;
+ } else {
+ tkwin2 = Tk_NameToWindow(interp, argv[3], tkwin);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ if (!Tk_IsTopLevel(tkwin2)) {
+ Tcl_AppendResult(interp, "can't use ", argv[3],
+ " as icon window: not at top level", (char *) NULL);
+ return TCL_ERROR;
+ }
+ wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr;
+ if (wmPtr2->iconFor != NULL) {
+ Tcl_AppendResult(interp, argv[3], " is already an icon for ",
+ Tk_PathName(wmPtr2->iconFor), (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->icon != NULL) {
+ WmInfo *wmPtr3 = ((TkWindow *) wmPtr->icon)->wmInfoPtr;
+ wmPtr3->iconFor = NULL;
+ }
+ Tk_MakeWindowExist(tkwin2);
+ 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)) {
+ /*
+ * Don't have iconwindows on the Mac. We just withdraw.
+ */
+
+ Tk_UnmapWindow(tkwin2);
+ }
+ }
+ } 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) {
+ 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;
+ wmPtr->minHeight = height;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ goto updateGeom;
+ } else if ((c == 'o')
+ && (strncmp(argv[1], "overrideredirect", length) == 0)) {
+ int boolean;
+ XSetWindowAttributes atts;
+
+ if ((argc != 3) && (argc != 4)) {
+ 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];
+ length = strlen(argv[3]);
+ if ((c == 'u') && (strncmp(argv[3], "user", length) == 0)) {
+ wmPtr->sizeHintsFlags &= ~PPosition;
+ wmPtr->sizeHintsFlags |= USPosition;
+ } else if ((c == 'p') &&
+ (strncmp(argv[3], "program", length) == 0)) {
+ wmPtr->sizeHintsFlags &= ~USPosition;
+ wmPtr->sizeHintsFlags |= PPosition;
+ } else {
+ Tcl_AppendResult(interp, "bad argument \"", argv[3],
+ "\": must be program or user", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ goto updateGeom;
+ } else if ((c == 'p') && (strncmp(argv[1], "protocol", length) == 0)
+ && (length >= 2)) {
+ register ProtocolHandler *protPtr, *prevPtr;
+ Atom protocol;
+ int cmdLength;
+
+ if ((argc < 3) || (argc > 5)) {
+ Tcl_AppendResult(interp, "wrong # arguments: must be \"",
+ argv[0], " protocol window ?name? ?command?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 3) {
+ /*
+ * Return a list of all defined protocols for the window.
+ */
+ for (protPtr = wmPtr->protPtr; protPtr != NULL;
+ protPtr = protPtr->nextPtr) {
+ Tcl_AppendElement(interp,
+ Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol));
+ }
+ return TCL_OK;
+ }
+ protocol = Tk_InternAtom((Tk_Window) winPtr, argv[3]);
+ 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;
+ }
+
+ /*
+ * Delete any current protocol handler, then create a new
+ * one with the specified command, unless the command is
+ * empty.
+ */
+
+ for (protPtr = wmPtr->protPtr, prevPtr = NULL; protPtr != NULL;
+ prevPtr = protPtr, protPtr = protPtr->nextPtr) {
+ if (protPtr->protocol == protocol) {
+ if (prevPtr == NULL) {
+ wmPtr->protPtr = protPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = protPtr->nextPtr;
+ }
+ Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC);
+ break;
+ }
+ }
+ cmdLength = strlen(argv[4]);
+ if (cmdLength > 0) {
+ protPtr = (ProtocolHandler *) ckalloc(HANDLER_SIZE(cmdLength));
+ protPtr->protocol = protocol;
+ protPtr->nextPtr = wmPtr->protPtr;
+ wmPtr->protPtr = protPtr;
+ protPtr->interp = interp;
+ strcpy(protPtr->command, argv[4]);
+ }
+ } else if ((c == 'r') && (strncmp(argv[1], "resizable", length) == 0)) {
+ int width, height;
+
+ 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) {
+ wmPtr->flags &= ~WM_WIDTH_NOT_RESIZABLE;
+ } else {
+ wmPtr->flags |= WM_WIDTH_NOT_RESIZABLE;
+ }
+ if (height) {
+ wmPtr->flags &= ~WM_HEIGHT_NOT_RESIZABLE;
+ } else {
+ wmPtr->flags |= WM_HEIGHT_NOT_RESIZABLE;
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ if (wmPtr->scrollWinPtr != NULL) {
+ TkScrollbarEventuallyRedraw(
+ (TkScrollbar *) wmPtr->scrollWinPtr->instanceData);
+ }
+ goto updateGeom;
+ } else if ((c == 's') && (strncmp(argv[1], "sizefrom", length) == 0)
+ && (length >= 2)) {
+ if ((argc != 3) && (argc != 4)) {
+ 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];
+ length = strlen(argv[3]);
+ if ((c == 'u') && (strncmp(argv[3], "user", length) == 0)) {
+ wmPtr->sizeHintsFlags &= ~PSize;
+ wmPtr->sizeHintsFlags |= USSize;
+ } else if ((c == 'p')
+ && (strncmp(argv[3], "program", length) == 0)) {
+ wmPtr->sizeHintsFlags &= ~USSize;
+ wmPtr->sizeHintsFlags |= PSize;
+ } else {
+ Tcl_AppendResult(interp, "bad argument \"", argv[3],
+ "\": must be program or user", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ goto updateGeom;
+ } else if ((c == 's') && (strncmp(argv[1], "state", length) == 0)
+ && (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);
+ }
+ wmPtr->masterWindowName = NULL;
+ wmPtr->style = documentProc;
+ } else {
+ master = Tk_NameToWindow(interp, argv[3], tkwin);
+ if (master == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_MakeWindowExist(master);
+ wmPtr->master = Tk_WindowId(master);
+ wmPtr->masterWindowName = ckalloc((unsigned) (strlen(argv[3])+1));
+ strcpy(wmPtr->masterWindowName, argv[3]);
+ wmPtr->style = plainDBox;
+ }
+ } else if ((c == 'w') && (strncmp(argv[1], "withdraw", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # arguments: must be \"",
+ argv[0], " withdraw window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't withdraw ", argv[2],
+ ": it is an icon for ", Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ TkpWmSetState(winPtr, WithdrawnState);
+ } else {
+ Tcl_AppendResult(interp, "unknown or ambiguous option \"", argv[1],
+ "\": must be aspect, client, command, deiconify, ",
+ "focusmodel, frame, geometry, grid, group, iconbitmap, ",
+ "iconify, iconmask, iconname, iconposition, ",
+ "iconwindow, maxsize, minsize, overrideredirect, ",
+ "positionfrom, protocol, resizable, sizefrom, state, title, ",
+ "transient, or withdraw",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+
+ updateGeom:
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tk_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetGrid --
+ *
+ * This procedure is invoked by a widget when it wishes to set a grid
+ * coordinate system that controls the size of a top-level window.
+ * It provides a C interface equivalent to the "wm grid" command and
+ * is usually asscoiated with the -setgrid option.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Grid-related information will be passed to the window manager, so
+ * that the top-level window associated with tkwin will resize on
+ * even grid units. If some other window already controls gridding
+ * for the top-level window then this procedure call has no effect.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetGrid(
+ Tk_Window tkwin, /* Token for window. New window mgr info
+ * will be posted for the top-level window
+ * associated with this window. */
+ int reqWidth, /* Width (in grid units) corresponding to
+ * the requested geometry for tkwin. */
+ int reqHeight, /* Height (in grid units) corresponding to
+ * the requested geometry for tkwin. */
+ int widthInc, int heightInc)/* Pixel increments corresponding to a
+ * change of one grid unit. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ register WmInfo *wmPtr;
+
+ /*
+ * Find the top-level window for tkwin, plus the window manager
+ * information.
+ */
+
+ while (!(winPtr->flags & TK_TOP_LEVEL)) {
+ winPtr = winPtr->parentPtr;
+ }
+ wmPtr = winPtr->wmInfoPtr;
+
+ if ((wmPtr->gridWin != NULL) && (wmPtr->gridWin != tkwin)) {
+ return;
+ }
+
+ 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
+ * grid units since the new requested size of the top-level window in
+ * pixels may not yet have been registered yet (it may filter up
+ * the hierarchy in DoWhenIdle handlers). However, if the window
+ * has never been mapped yet then just leave the window size alone:
+ * assume that it is intended to be in grid units but just happened
+ * to have been specified before this procedure was called.
+ */
+
+ if ((wmPtr->gridWin == NULL) && !(wmPtr->flags & WM_NEVER_MAPPED)) {
+ wmPtr->width = -1;
+ wmPtr->height = -1;
+ }
+
+ /*
+ * Set the new gridding information, and start the process of passing
+ * all of this information to the window manager.
+ */
+
+ wmPtr->gridWin = tkwin;
+ wmPtr->reqGridWidth = reqWidth;
+ wmPtr->reqGridHeight = reqHeight;
+ wmPtr->widthInc = widthInc;
+ wmPtr->heightInc = heightInc;
+ wmPtr->sizeHintsFlags |= PBaseSize|PResizeInc;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tk_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_UnsetGrid --
+ *
+ * This procedure cancels the effect of a previous call
+ * to Tk_SetGrid.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If tkwin currently controls gridding for its top-level window,
+ * gridding is cancelled for that top-level window; if some other
+ * window controls gridding then this procedure has no effect.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_UnsetGrid(
+ Tk_Window tkwin) /* Token for window that is currently
+ * controlling gridding. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ register WmInfo *wmPtr;
+
+ /*
+ * Find the top-level window for tkwin, plus the window manager
+ * information.
+ */
+
+ while (!(winPtr->flags & TK_TOP_LEVEL)) {
+ winPtr = winPtr->parentPtr;
+ }
+ wmPtr = winPtr->wmInfoPtr;
+ if (tkwin != wmPtr->gridWin) {
+ return;
+ }
+
+ wmPtr->gridWin = NULL;
+ wmPtr->sizeHintsFlags &= ~(PBaseSize|PResizeInc);
+ if (wmPtr->width != -1) {
+ wmPtr->width = winPtr->reqWidth + (wmPtr->width
+ - wmPtr->reqGridWidth)*wmPtr->widthInc;
+ wmPtr->height = winPtr->reqHeight + (wmPtr->height
+ - wmPtr->reqGridHeight)*wmPtr->heightInc;
+ }
+ wmPtr->widthInc = 1;
+ wmPtr->heightInc = 1;
+
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tk_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TopLevelEventProc --
+ *
+ * This procedure is invoked when a top-level (or other externally-
+ * managed window) is restructured in any way.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Tk's internal data structures for the window get modified to
+ * reflect the structural change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TopLevelEventProc(
+ ClientData clientData, /* Window for which event occurred. */
+ XEvent *eventPtr) /* Event that just happened. */
+{
+ register TkWindow *winPtr = (TkWindow *) clientData;
+
+ winPtr->wmInfoPtr->flags |= WM_VROOT_OFFSET_STALE;
+ if (eventPtr->type == DestroyNotify) {
+ Tk_ErrorHandler handler;
+
+ if (!(winPtr->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(winPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ Tk_DeleteErrorHandler(handler);
+ }
+ if (wmTracing) {
+ printf("TopLevelEventProc: %s deleted\n", winPtr->pathName);
+ }
+ } else if (eventPtr->type == ReparentNotify) {
+ panic("recieved unwanted reparent event");
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TopLevelReqProc --
+ *
+ * This procedure is invoked by the geometry manager whenever
+ * the requested size for a top-level window is changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arrange for the window to be resized to satisfy the request
+ * (this happens as a when-idle action).
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+TopLevelReqProc(
+ ClientData dummy, /* Not used. */
+ Tk_Window tkwin) /* Information about window. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ WmInfo *wmPtr;
+
+ wmPtr = winPtr->wmInfoPtr;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tk_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateGeometryInfo --
+ *
+ * This procedure is invoked when a top-level window is first
+ * mapped, and also as a when-idle procedure, to bring the
+ * geometry and/or position of a top-level window back into
+ * line with what has been requested by the user and/or widgets.
+ * This procedure doesn't return until the window manager has
+ * responded to the geometry change.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window's size and location may change, unless the WM prevents
+ * that from happening.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateGeometryInfo(
+ ClientData clientData) /* Pointer to the window's record. */
+{
+ register TkWindow *winPtr = (TkWindow *) clientData;
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int x, y, width, height;
+ unsigned long serial;
+
+ wmPtr->flags &= ~WM_UPDATE_PENDING;
+
+ /*
+ * Compute the new size for the top-level window. See the
+ * user documentation for details on this, but the size
+ * requested depends on (a) the size requested internally
+ * by the window's widgets, (b) the size requested by the
+ * user in a "wm geometry" command or via wm-based interactive
+ * resizing (if any), and (c) whether or not the window is
+ * gridded. Don't permit sizes <= 0 because this upsets
+ * the X server.
+ */
+
+ if (wmPtr->width == -1) {
+ width = winPtr->reqWidth;
+ } else if (wmPtr->gridWin != NULL) {
+ width = winPtr->reqWidth
+ + (wmPtr->width - wmPtr->reqGridWidth)*wmPtr->widthInc;
+ } else {
+ width = wmPtr->width;
+ }
+ if (width <= 0) {
+ width = 1;
+ }
+ if (wmPtr->height == -1) {
+ height = winPtr->reqHeight;
+ } else if (wmPtr->gridWin != NULL) {
+ height = winPtr->reqHeight
+ + (wmPtr->height - wmPtr->reqGridHeight)*wmPtr->heightInc;
+ } else {
+ height = wmPtr->height;
+ }
+ if (height <= 0) {
+ height = 1;
+ }
+
+ /*
+ * Compute the new position for the upper-left pixel of the window's
+ * decorative frame. This is tricky, because we need to include the
+ * border widths supplied by a reparented parent in this calculation,
+ * but can't use the parent's current overall size since that may
+ * change as a result of this code.
+ */
+
+ if (wmPtr->flags & WM_NEGATIVE_X) {
+ x = wmPtr->vRootWidth - wmPtr->x
+ - (width + (wmPtr->parentWidth - winPtr->changes.width));
+ } else {
+ x = wmPtr->x;
+ }
+ if (wmPtr->flags & WM_NEGATIVE_Y) {
+ y = wmPtr->vRootHeight - wmPtr->y
+ - (height + (wmPtr->parentHeight - winPtr->changes.height));
+ } else {
+ y = wmPtr->y;
+ }
+
+ /*
+ * If the window's size is going to change and the window is
+ * supposed to not be resizable by the user, then we have to
+ * update the size hints. There may also be a size-hint-update
+ * request pending from somewhere else, too.
+ */
+
+ if (((width != winPtr->changes.width)
+ || (height != winPtr->changes.height))
+ && (wmPtr->gridWin == NULL)
+ && ((wmPtr->sizeHintsFlags & (PMinSize|PMaxSize)) == 0)) {
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ }
+ if (wmPtr->flags & WM_UPDATE_SIZE_HINTS) {
+ UpdateSizeHints(winPtr);
+ }
+
+ /*
+ * Reconfigure the window if it isn't already configured correctly.
+ * A few tricky points:
+ *
+ * 1. If the window is embedded and the container is also in this
+ * process, don't actually reconfigure the window; just pass the
+ * desired size on to the container. Also, zero out any position
+ * information, since embedded windows are not allowed to move.
+ * 2. Sometimes the window manager will give us a different size
+ * than we asked for (e.g. mwm has a minimum size for windows), so
+ * base the size check on what we *asked for* last time, not what we
+ * got.
+ * 3. Don't move window unless a new position has been requested for
+ * it. This is because of "features" in some window managers (e.g.
+ * twm, as of 4/24/91) where they don't interpret coordinates
+ * according to ICCCM. Moving a window to its current location may
+ * cause it to shift position on the screen.
+ */
+
+ if (Tk_IsEmbedded(winPtr)) {
+ TkWindow *contWinPtr;
+
+ contWinPtr = TkpGetOtherWindow(winPtr);
+
+ /*
+ * NOTE: Here we should handle out of process embedding.
+ */
+
+ if (contWinPtr != NULL) {
+ /*
+ * This window is embedded and the container is also in this
+ * process, so we don't need to do anything special about the
+ * geometry, except to make sure that the desired size is known
+ * by the container. Also, zero out any position information,
+ * since embedded windows are not allowed to move.
+ */
+
+ wmPtr->x = wmPtr->y = 0;
+ wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y);
+ Tk_GeometryRequest((Tk_Window) contWinPtr, width, height);
+ }
+ return;
+ }
+ serial = NextRequest(winPtr->display);
+ if (wmPtr->flags & WM_MOVE_PENDING) {
+ wmPtr->configWidth = width;
+ wmPtr->configHeight = height;
+ if (wmTracing) {
+ printf(
+ "UpdateGeometryInfo moving to %d %d, resizing to %d x %d,\n",
+ x, y, width, height);
+ }
+ Tk_MoveResizeWindow((Tk_Window) winPtr, x, y, (unsigned) width,
+ (unsigned) height);
+ } else if ((width != wmPtr->configWidth)
+ || (height != wmPtr->configHeight)) {
+ wmPtr->configWidth = width;
+ wmPtr->configHeight = height;
+ if (wmTracing) {
+ printf("UpdateGeometryInfo resizing to %d x %d\n", width, height);
+ }
+ Tk_ResizeWindow((Tk_Window) winPtr, (unsigned) width,
+ (unsigned) height);
+ } else {
+ return;
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * UpdateSizeHints --
+ *
+ * This procedure is called to update the window manager's
+ * size hints information from the information in a WmInfo
+ * structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Properties get changed for winPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+UpdateSizeHints(
+ TkWindow *winPtr)
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ XSizeHints *hintsPtr;
+
+ wmPtr->flags &= ~WM_UPDATE_SIZE_HINTS;
+
+ hintsPtr = XAllocSizeHints();
+ if (hintsPtr == NULL) {
+ return;
+ }
+
+ /*
+ * Compute the pixel-based sizes for the various fields in the
+ * size hints structure, based on the grid-based sizes in
+ * our structure.
+ */
+
+ if (wmPtr->gridWin != NULL) {
+ hintsPtr->base_width = winPtr->reqWidth
+ - (wmPtr->reqGridWidth * wmPtr->widthInc);
+ if (hintsPtr->base_width < 0) {
+ hintsPtr->base_width = 0;
+ }
+ hintsPtr->base_height = winPtr->reqHeight
+ - (wmPtr->reqGridHeight * wmPtr->heightInc);
+ if (hintsPtr->base_height < 0) {
+ hintsPtr->base_height = 0;
+ }
+ hintsPtr->min_width = hintsPtr->base_width
+ + (wmPtr->minWidth * wmPtr->widthInc);
+ hintsPtr->min_height = hintsPtr->base_height
+ + (wmPtr->minHeight * wmPtr->heightInc);
+ hintsPtr->max_width = hintsPtr->base_width
+ + (wmPtr->maxWidth * wmPtr->widthInc);
+ hintsPtr->max_height = hintsPtr->base_height
+ + (wmPtr->maxHeight * wmPtr->heightInc);
+ } else {
+ hintsPtr->min_width = wmPtr->minWidth;
+ hintsPtr->min_height = wmPtr->minHeight;
+ hintsPtr->max_width = wmPtr->maxWidth;
+ hintsPtr->max_height = wmPtr->maxHeight;
+ hintsPtr->base_width = 0;
+ hintsPtr->base_height = 0;
+ }
+ hintsPtr->width_inc = wmPtr->widthInc;
+ hintsPtr->height_inc = wmPtr->heightInc;
+ hintsPtr->min_aspect.x = wmPtr->minAspect.x;
+ hintsPtr->min_aspect.y = wmPtr->minAspect.y;
+ hintsPtr->max_aspect.x = wmPtr->maxAspect.x;
+ hintsPtr->max_aspect.y = wmPtr->maxAspect.y;
+ hintsPtr->win_gravity = wmPtr->gravity;
+ hintsPtr->flags = wmPtr->sizeHintsFlags | PMinSize | PMaxSize;
+
+ /*
+ * If the window isn't supposed to be resizable, then set the
+ * minimum and maximum dimensions to be the same.
+ */
+
+ if (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) {
+ if (wmPtr->width >= 0) {
+ hintsPtr->min_width = wmPtr->width;
+ } else {
+ hintsPtr->min_width = winPtr->reqWidth;
+ }
+ hintsPtr->max_width = hintsPtr->min_width;
+ }
+ if (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) {
+ if (wmPtr->height >= 0) {
+ hintsPtr->min_height = wmPtr->height;
+ } else {
+ hintsPtr->min_height = winPtr->reqHeight;
+ }
+ hintsPtr->max_height = hintsPtr->min_height;
+ }
+
+ XSetWMNormalHints(winPtr->display, winPtr->window, hintsPtr);
+
+ XFree((char *) hintsPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ParseGeometry --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ParseGeometry(
+ Tcl_Interp *interp, /* Used for error reporting. */
+ char *string, /* String containing new geometry. Has the
+ * standard form "=wxh+x+y". */
+ TkWindow *winPtr) /* Pointer to top-level window whose
+ * geometry is to be changed. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int x, y, width, height, flags;
+ char *end;
+ register char *p = string;
+
+ /*
+ * The leading "=" is optional.
+ */
+
+ if (*p == '=') {
+ p++;
+ }
+
+ /*
+ * Parse the width and height, if they are present. Don't
+ * actually update any of the fields of wmPtr until we've
+ * successfully parsed the entire geometry string.
+ */
+
+ width = wmPtr->width;
+ height = wmPtr->height;
+ x = wmPtr->x;
+ y = wmPtr->y;
+ flags = wmPtr->flags;
+ if (isdigit(UCHAR(*p))) {
+ width = strtoul(p, &end, 10);
+ p = end;
+ if (*p != 'x') {
+ goto error;
+ }
+ p++;
+ if (!isdigit(UCHAR(*p))) {
+ goto error;
+ }
+ height = strtoul(p, &end, 10);
+ p = end;
+ }
+
+ /*
+ * Parse the X and Y coordinates, if they are present.
+ */
+
+ if (*p != '\0') {
+ flags &= ~(WM_NEGATIVE_X | WM_NEGATIVE_Y);
+ if (*p == '-') {
+ flags |= WM_NEGATIVE_X;
+ } else if (*p != '+') {
+ goto error;
+ }
+ x = strtol(p+1, &end, 10);
+ p = end;
+ if (*p == '-') {
+ flags |= WM_NEGATIVE_Y;
+ } else if (*p != '+') {
+ goto error;
+ }
+ y = strtol(p+1, &end, 10);
+ if (*end != '\0') {
+ goto error;
+ }
+
+ /*
+ * Assume that the geometry information came from the user,
+ * unless an explicit source has been specified. Otherwise
+ * most window managers assume that the size hints were
+ * program-specified and they ignore them.
+ */
+
+ if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) {
+ wmPtr->sizeHintsFlags |= USPosition;
+ flags |= WM_UPDATE_SIZE_HINTS;
+ }
+ }
+
+ /*
+ * Everything was parsed OK. Update the fields of *wmPtr and
+ * arrange for the appropriate information to be percolated out
+ * to the window manager at the next idle moment.
+ */
+
+ wmPtr->width = width;
+ wmPtr->height = height;
+ if ((x != wmPtr->x) || (y != wmPtr->y)
+ || ((flags & (WM_NEGATIVE_X|WM_NEGATIVE_Y))
+ != (wmPtr->flags & (WM_NEGATIVE_X|WM_NEGATIVE_Y)))) {
+ wmPtr->x = x;
+ wmPtr->y = y;
+ flags |= WM_MOVE_PENDING;
+ }
+ wmPtr->flags = flags;
+
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tk_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+ return TCL_OK;
+
+ error:
+ Tcl_AppendResult(interp, "bad geometry specifier \"",
+ string, "\"", (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetRootCoords --
+ *
+ * Given a token for a window, this procedure traces through the
+ * window's lineage to find the (virtual) root-window coordinates
+ * corresponding to point (0,0) in the window.
+ *
+ * Results:
+ * The locations pointed to by xPtr and yPtr are filled in with
+ * the root coordinates of the (0,0) point in tkwin. If a virtual
+ * root window is in effect for the window, then the coordinates
+ * in the virtual root are returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_GetRootCoords(
+ Tk_Window tkwin, /* Token for window. */
+ int *xPtr, /* Where to store x-displacement of (0,0). */
+ int *yPtr) /* Where to store y-displacement of (0,0). */
+{
+ int x, y;
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ /*
+ * Search back through this window's parents all the way to a
+ * top-level window, combining the offsets of each window within
+ * its parent.
+ */
+
+ x = y = 0;
+ while (1) {
+ x += winPtr->changes.x + winPtr->changes.border_width;
+ y += winPtr->changes.y + winPtr->changes.border_width;
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ if (!(Tk_IsEmbedded(winPtr))) {
+ x += winPtr->wmInfoPtr->xInParent;
+ y += winPtr->wmInfoPtr->yInParent;
+ break;
+ } else {
+ TkWindow *otherPtr;
+
+ otherPtr = TkpGetOtherWindow(winPtr);
+ if (otherPtr != NULL) {
+ /*
+ * The container window is in the same application.
+ * Query its coordinates.
+ */
+ winPtr = otherPtr;
+
+ /*
+ * Remember to offset by the container window here,
+ * since at the end of this if branch, we will
+ * 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;
+ *yPtr = y;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CoordsToWindow --
+ *
+ * This is a Macintosh specific implementation of this function.
+ * Given the root coordinates of a point, this procedure returns
+ * the token for the top-most window covering that point, if
+ * there exists such a window in this application.
+ *
+ * Results:
+ * The return result is either a token for the window corresponding
+ * to rootX and rootY, or else NULL to indicate that there is no such
+ * window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_CoordsToWindow(
+ int rootX, int rootY, /* Coordinates of point in root window. If
+ * a virtual-root window manager is in use,
+ * these coordinates refer to the virtual
+ * root, not the real root. */
+ Tk_Window tkwin) /* Token for any window in application;
+ * used to identify the display. */
+{
+ WindowPtr whichWin;
+ 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
+ * one in the stacking order that contains the point. Then repeat
+ * the whole process on that child.
+ */
+
+ x = rootX - winPtr->wmInfoPtr->xInParent;
+ y = rootY - winPtr->wmInfoPtr->yInParent;
+ while (1) {
+ x -= winPtr->changes.x;
+ y -= winPtr->changes.y;
+ nextPtr = NULL;
+
+ /*
+ * Container windows cannot have children. So if it is a container,
+ * look there, otherwise inspect the children.
+ */
+
+ if (Tk_IsContainer(winPtr)) {
+ childPtr = TkpGetOtherWindow(winPtr);
+ if (childPtr != NULL) {
+ if (Tk_IsMapped(childPtr)) {
+ tmpx = x - childPtr->changes.x;
+ tmpy = y - childPtr->changes.y;
+ bd = childPtr->changes.border_width;
+
+ if ((tmpx >= -bd) && (tmpy >= -bd)
+ && (tmpx < (childPtr->changes.width + bd))
+ && (tmpy < (childPtr->changes.height + bd))) {
+ nextPtr = childPtr;
+ }
+ }
+ }
+
+
+ /*
+ * NOTE: Here we should handle out of process embedding.
+ */
+
+ } else {
+ for (childPtr = winPtr->childList; childPtr != NULL;
+ childPtr = childPtr->nextPtr) {
+ if (!Tk_IsMapped(childPtr) ||
+ (childPtr->flags & TK_TOP_LEVEL)) {
+ continue;
+ }
+ tmpx = x - childPtr->changes.x;
+ tmpy = y - childPtr->changes.y;
+ bd = childPtr->changes.border_width;
+ if ((tmpx >= -bd) && (tmpy >= -bd)
+ && (tmpx < (childPtr->changes.width + bd))
+ && (tmpy < (childPtr->changes.height + bd))) {
+ nextPtr = childPtr;
+ }
+ }
+ }
+ if (nextPtr == NULL) {
+ break;
+ }
+ winPtr = nextPtr;
+ }
+ return (Tk_Window) winPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_TopCoordsToWindow --
+ *
+ * Given a Tk Window, and coordinates of a point relative to that window
+ * this procedure returns the top-most child of the window (excluding
+ * toplevels) covering that point, if there exists such a window in this
+ * application.
+ * It also sets newX, and newY to the coords of the point relative to the
+ * window returned.
+ *
+ * Results:
+ * The return result is either a token for the window corresponding
+ * to rootX and rootY, or else NULL to indicate that there is no such
+ * window. newX and newY are also set to the coords of the point relative
+ * to the returned window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_TopCoordsToWindow(
+ Tk_Window tkwin, /* Token for a Tk Window which defines the;
+ * coordinates for rootX & rootY */
+ int rootX, int rootY, /* Coordinates of a point in tkWin. */
+ int *newX, int *newY) /* Coordinates of point in the upperMost child of
+ * tkWin containing (rootX,rootY) */
+{
+ register TkWindow *winPtr, *childPtr;
+ TkWindow *nextPtr; /* Coordinates of highest child found so
+ * far that contains point. */
+ int x, y; /* Coordinates in winPtr. */
+ Window *children; /* Children of winPtr, or NULL. */
+
+ winPtr = (TkWindow *) tkwin;
+ x = rootX;
+ y = rootY;
+ while (1) {
+ nextPtr = NULL;
+ children = NULL;
+
+ /*
+ * Container windows cannot have children. So if it is a container,
+ * look there, otherwise inspect the children.
+ */
+
+ if (Tk_IsContainer(winPtr)) {
+ childPtr = TkpGetOtherWindow(winPtr);
+ if (childPtr != NULL) {
+ if (Tk_IsMapped(childPtr) &&
+ (x > childPtr->changes.x &&
+ x < childPtr->changes.x +
+ childPtr->changes.width) &&
+ (y > childPtr->changes.y &&
+ y < childPtr->changes.y +
+ childPtr->changes.height)) {
+ nextPtr = childPtr;
+ }
+ }
+
+ /*
+ * NOTE: Here we should handle out of process embedding.
+ */
+
+ } else {
+
+ for (childPtr = winPtr->childList; childPtr != NULL;
+ childPtr = childPtr->nextPtr) {
+ if (!Tk_IsMapped(childPtr) ||
+ (childPtr->flags & TK_TOP_LEVEL)) {
+ continue;
+ }
+ if (x < childPtr->changes.x || y < childPtr->changes.y) {
+ continue;
+ }
+ if (x > childPtr->changes.x + childPtr->changes.width ||
+ y > childPtr->changes.y + childPtr->changes.height) {
+ continue;
+ }
+ nextPtr = childPtr;
+ }
+ }
+ if (nextPtr == NULL) {
+ break;
+ }
+ winPtr = nextPtr;
+ x -= winPtr->changes.x;
+ y -= winPtr->changes.y;
+ }
+ *newX = x;
+ *newY = y;
+ return (Tk_Window) winPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateVRootGeometry --
+ *
+ * This procedure is called to update all the virtual root
+ * geometry information in wmPtr.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The vRootX, vRootY, vRootWidth, and vRootHeight fields in
+ * wmPtr are filled with the most up-to-date information.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateVRootGeometry(
+ WmInfo *wmPtr) /* Window manager information to be
+ * updated. The wmPtr->vRoot field must
+ * be valid. */
+{
+ TkWindow *winPtr = wmPtr->winPtr;
+ unsigned int bd, dummy;
+ Window dummy2;
+ Status status;
+ Tk_ErrorHandler handler;
+
+ /*
+ * If this isn't a virtual-root window manager, just return information
+ * about the screen.
+ */
+
+ wmPtr->flags &= ~WM_VROOT_OFFSET_STALE;
+ if (wmPtr->vRoot == None) {
+ noVRoot:
+ wmPtr->vRootX = wmPtr->vRootY = 0;
+ wmPtr->vRootWidth = DisplayWidth(winPtr->display, winPtr->screenNum);
+ wmPtr->vRootHeight = DisplayHeight(winPtr->display, winPtr->screenNum);
+ return;
+ }
+
+ /*
+ * Refresh the virtual root information if it's out of date.
+ */
+
+ handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ status = XGetGeometry(winPtr->display, wmPtr->vRoot,
+ &dummy2, &wmPtr->vRootX, &wmPtr->vRootY,
+ &wmPtr->vRootWidth, &wmPtr->vRootHeight, &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) {
+ /*
+ * The virtual root is gone! Pretend that it never existed.
+ */
+
+ wmPtr->vRoot = None;
+ goto noVRoot;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetVRootGeometry --
+ *
+ * This procedure returns information about the virtual root
+ * window corresponding to a particular Tk window.
+ *
+ * Results:
+ * The values at xPtr, yPtr, widthPtr, and heightPtr are set
+ * with the offset and dimensions of the root window corresponding
+ * to tkwin. If tkwin is being managed by a virtual root window
+ * manager these values correspond to the virtual root window being
+ * used for tkwin; otherwise the offsets will be 0 and the
+ * dimensions will be those of the screen.
+ *
+ * Side effects:
+ * Vroot window information is refreshed if it is out of date.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_GetVRootGeometry(
+ Tk_Window tkwin, /* Window whose virtual root is to be
+ * queried. */
+ int *xPtr, int *yPtr, /* Store x and y offsets of virtual root
+ * here. */
+ int *widthPtr, /* Store dimensions of virtual root here. */
+ int *heightPtr)
+{
+ WmInfo *wmPtr;
+ TkWindow *winPtr = (TkWindow *) tkwin;
+
+ /*
+ * Find the top-level window for tkwin, and locate the window manager
+ * information for that window.
+ */
+
+ while (!(winPtr->flags & TK_TOP_LEVEL)) {
+ winPtr = winPtr->parentPtr;
+ }
+ wmPtr = winPtr->wmInfoPtr;
+
+ /*
+ * Make sure that the geometry information is up-to-date, then copy
+ * it out to the caller.
+ */
+
+ if (wmPtr->flags & WM_VROOT_OFFSET_STALE) {
+ UpdateVRootGeometry(wmPtr);
+ }
+ *xPtr = wmPtr->vRootX;
+ *yPtr = wmPtr->vRootY;
+ *widthPtr = wmPtr->vRootWidth;
+ *heightPtr = wmPtr->vRootHeight;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MoveToplevelWindow --
+ *
+ * This procedure is called instead of Tk_MoveWindow to adjust
+ * the x-y location of a top-level window. It delays the actual
+ * move to a later time and keeps window-manager information
+ * up-to-date with the move
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is eventually moved so that its upper-left corner
+ * (actually, the upper-left corner of the window's decorative
+ * frame, if there is one) is at (x,y).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_MoveToplevelWindow(
+ Tk_Window tkwin, /* Window to move. */
+ int x, int y) /* New location for window (within
+ * parent). */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ panic("Tk_MoveToplevelWindow called with non-toplevel window");
+ }
+ wmPtr->x = x;
+ wmPtr->y = y;
+ wmPtr->flags |= WM_MOVE_PENDING;
+ wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y);
+ if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) {
+ wmPtr->sizeHintsFlags |= USPosition;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ }
+
+ /*
+ * If the window has already been mapped, must bring its geometry
+ * up-to-date immediately, otherwise an event might arrive from the
+ * server that would overwrite wmPtr->x and wmPtr->y and lose the
+ * new position.
+ */
+
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ if (wmPtr->flags & WM_UPDATE_PENDING) {
+ Tk_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr);
+ }
+ UpdateGeometryInfo((ClientData) winPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmProtocolEventProc --
+ *
+ * This procedure is called by the Tk_HandleEvent whenever a
+ * ClientMessage event arrives whose type is "WM_PROTOCOLS".
+ * This procedure handles the message from the window manager
+ * in an appropriate fashion.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on what sort of handler, if any, was set up for the
+ * protocol.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWmProtocolEventProc(
+ TkWindow *winPtr, /* Window to which the event was sent. */
+ XEvent *eventPtr) /* X event. */
+{
+ WmInfo *wmPtr;
+ register ProtocolHandler *protPtr;
+ Tcl_Interp *interp;
+ Atom protocol;
+ int result;
+
+ wmPtr = winPtr->wmInfoPtr;
+ if (wmPtr == NULL) {
+ return;
+ }
+ protocol = (Atom) eventPtr->xclient.data.l[0];
+ for (protPtr = wmPtr->protPtr; protPtr != NULL;
+ protPtr = protPtr->nextPtr) {
+ if (protocol == protPtr->protocol) {
+ Tcl_Preserve((ClientData) protPtr);
+ interp = protPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ result = Tcl_GlobalEval(interp, protPtr->command);
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(interp, "\n (command for \"");
+ Tcl_AddErrorInfo(interp,
+ Tk_GetAtomName((Tk_Window) winPtr, protocol));
+ Tcl_AddErrorInfo(interp, "\" window manager protocol)");
+ Tk_BackgroundError(interp);
+ }
+ Tcl_Release((ClientData) interp);
+ Tcl_Release((ClientData) protPtr);
+ return;
+ }
+ }
+
+ /*
+ * No handler was present for this protocol. If this is a
+ * WM_DELETE_WINDOW message then just destroy the window.
+ */
+
+ if (protocol == Tk_InternAtom((Tk_Window) winPtr, "WM_DELETE_WINDOW")) {
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmRestackToplevel --
+ *
+ * This procedure restacks a top-level window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * WinPtr gets restacked as specified by aboveBelow and otherPtr.
+ * This procedure doesn't return until the restack has taken
+ * effect and the ConfigureNotify event for it has been received.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWmRestackToplevel(
+ TkWindow *winPtr, /* Window to restack. */
+ int aboveBelow, /* Gives relative position for restacking;
+ * must be Above or Below. */
+ TkWindow *otherPtr) /* Window relative to which to restack;
+ * if NULL, then winPtr gets restacked
+ * above or below *all* siblings. */
+{
+ WmInfo *wmPtr;
+ WindowPeek macWindow, otherMacWindow, frontWindow;
+
+ wmPtr = winPtr->wmInfoPtr;
+
+ /*
+ * Get the mac window. Make sure it exists & is mapped.
+ */
+
+ if (winPtr->window == None) {
+ Tk_MakeWindowExist((Tk_Window) winPtr);
+ }
+ if (winPtr->wmInfoPtr->flags & WM_NEVER_MAPPED) {
+
+ /*
+ * Can't set stacking order properly until the window is on the
+ * screen (mapping it may give it a reparent window), so make sure
+ * it's on the screen.
+ */
+
+ TkWmMapWindow(winPtr);
+ }
+ macWindow = (WindowPeek) TkMacGetDrawablePort(winPtr->window);
+
+ /*
+ * Get the window in which a raise or lower is in relation to.
+ */
+ if (otherPtr != NULL) {
+ if (otherPtr->window == None) {
+ Tk_MakeWindowExist((Tk_Window) otherPtr);
+ }
+ if (otherPtr->wmInfoPtr->flags & WM_NEVER_MAPPED) {
+ TkWmMapWindow(otherPtr);
+ }
+ otherMacWindow = (WindowPeek) TkMacGetDrawablePort(otherPtr->window);
+ } else {
+ otherMacWindow = NULL;
+ }
+
+ frontWindow = (WindowPeek) FrontWindow();
+ if (aboveBelow == Above) {
+ if (macWindow == frontWindow) {
+ /*
+ * Do nothing - it's already at the top.
+ */
+ } else if (otherMacWindow == frontWindow || otherMacWindow == NULL) {
+ /*
+ * Raise the window to the top. If the window is visable then
+ * we also make it the active window.
+ */
+
+ if (wmPtr->hints.initial_state == WithdrawnState) {
+ BringToFront((WindowPtr) macWindow);
+ } else {
+ SelectWindow((WindowPtr) macWindow);
+ }
+ } else {
+ /*
+ * Find the window to be above. (Front window will actually be the
+ * window to be behind.) Front window is NULL if no other windows.
+ */
+ while (frontWindow != NULL &&
+ frontWindow->nextWindow != otherMacWindow) {
+ frontWindow = frontWindow->nextWindow;
+ }
+ if (frontWindow != NULL) {
+ SendBehind((WindowPtr) macWindow, (WindowPtr) frontWindow);
+ }
+ }
+ } else {
+ /*
+ * Send behind. If it was in front find another window to make active.
+ */
+ if (macWindow == frontWindow) {
+ if (macWindow->nextWindow != NULL) {
+ SelectWindow((WindowPtr) macWindow->nextWindow);
+ }
+ }
+ SendBehind((WindowPtr) macWindow, (WindowPtr) otherMacWindow);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmAddToColormapWindows --
+ *
+ * This procedure is called to add a given window to the
+ * WM_COLORMAP_WINDOWS property for its top-level, if it
+ * isn't already there. It is invoked by the Tk code that
+ * creates a new colormap, in order to make sure that colormap
+ * information is propagated to the window manager by default.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * WinPtr's window gets added to the WM_COLORMAP_WINDOWS
+ * property of its nearest top-level ancestor, unless the
+ * colormaps have been set explicitly with the
+ * "wm colormapwindows" command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWmAddToColormapWindows(
+ TkWindow *winPtr) /* Window with a non-default colormap.
+ * Should not be a top-level window. */
+{
+ TkWindow *topPtr;
+ TkWindow **oldPtr, **newPtr;
+ int count, i;
+
+ if (winPtr->window == None) {
+ return;
+ }
+
+ for (topPtr = winPtr->parentPtr; ; topPtr = topPtr->parentPtr) {
+ if (topPtr == NULL) {
+ /*
+ * Window is being deleted. Skip the whole operation.
+ */
+
+ return;
+ }
+ if (topPtr->flags & TK_TOP_LEVEL) {
+ break;
+ }
+ }
+ if (topPtr->wmInfoPtr->flags & WM_COLORMAPS_EXPLICIT) {
+ return;
+ }
+
+ /*
+ * Make sure that the window isn't already in the list.
+ */
+
+ count = topPtr->wmInfoPtr->cmapCount;
+ oldPtr = topPtr->wmInfoPtr->cmapList;
+
+ for (i = 0; i < count; i++) {
+ if (oldPtr[i] == winPtr) {
+ return;
+ }
+ }
+
+ /*
+ * Make a new bigger array and use it to reset the property.
+ * Automatically add the toplevel itself as the last element
+ * of the list.
+ */
+
+ newPtr = (TkWindow **) ckalloc((unsigned) ((count+2)*sizeof(TkWindow*)));
+ if (count > 0) {
+ memcpy(newPtr, oldPtr, count * sizeof(TkWindow*));
+ }
+ if (count == 0) {
+ count++;
+ }
+ newPtr[count-1] = winPtr;
+ newPtr[count] = topPtr;
+ if (oldPtr != NULL) {
+ ckfree((char *) oldPtr);
+ }
+
+ topPtr->wmInfoPtr->cmapList = newPtr;
+ topPtr->wmInfoPtr->cmapCount = count+1;
+
+ /*
+ * On the Macintosh all of this is just an excercise
+ * in compatability as we don't support colormaps. If
+ * we did they would be installed here.
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmRemoveFromColormapWindows --
+ *
+ * This procedure is called to remove a given window from the
+ * WM_COLORMAP_WINDOWS property for its top-level. It is invoked
+ * when windows are deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * WinPtr's window gets removed from the WM_COLORMAP_WINDOWS
+ * property of its nearest top-level ancestor, unless the
+ * top-level itself is being deleted too.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWmRemoveFromColormapWindows(
+ TkWindow *winPtr) /* Window that may be present in
+ * WM_COLORMAP_WINDOWS property for its
+ * top-level. Should not be a top-level
+ * window. */
+{
+ TkWindow *topPtr;
+ TkWindow **oldPtr;
+ int count, i, j;
+
+ for (topPtr = winPtr->parentPtr; ; topPtr = topPtr->parentPtr) {
+ if (topPtr == NULL) {
+ /*
+ * Ancestors have been deleted, so skip the whole operation.
+ * Seems like this can't ever happen?
+ */
+
+ return;
+ }
+ if (topPtr->flags & TK_TOP_LEVEL) {
+ break;
+ }
+ }
+ if (topPtr->flags & TK_ALREADY_DEAD) {
+ /*
+ * Top-level is being deleted, so there's no need to cleanup
+ * the WM_COLORMAP_WINDOWS property.
+ */
+
+ return;
+ }
+
+ /*
+ * Find the window and slide the following ones down to cover
+ * it up.
+ */
+
+ count = topPtr->wmInfoPtr->cmapCount;
+ oldPtr = topPtr->wmInfoPtr->cmapList;
+ for (i = 0; i < count; i++) {
+ if (oldPtr[i] == winPtr) {
+ for (j = i ; j < count-1; j++) {
+ oldPtr[j] = oldPtr[j+1];
+ }
+ topPtr->wmInfoPtr->cmapCount = count - 1;
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetPointerCoords --
+ *
+ * Fetch the position of the mouse pointer.
+ *
+ * Results:
+ * *xPtr and *yPtr are filled in with the (virtual) root coordinates
+ * of the mouse pointer for tkwin's display. If the pointer isn't
+ * on tkwin's screen, then -1 values are returned for both
+ * coordinates. The argument tkwin must be a toplevel window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkGetPointerCoords(
+ Tk_Window tkwin, /* Toplevel window that identifies screen
+ * on which lookup is to be done. */
+ int *xPtr, int *yPtr) /* Store pointer coordinates here. */
+{
+ Point where;
+
+ GetMouse(&where);
+ LocalToGlobal(&where);
+ *xPtr = where.h;
+ *yPtr = where.v;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitialWindowBounds --
+ *
+ * This function calculates the initial bounds for a new Mac
+ * toplevel window. Unless the geometry is specified by the user
+ * this code will auto place the windows in a cascade diagonially
+ * across the main monitor of the Mac.
+ *
+ * Results:
+ * The bounds are returned in geometry.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitialWindowBounds(
+ TkWindow *winPtr, /* Window to get initial bounds for. */
+ Rect *geometry) /* On return the initial bounds. */
+{
+ int x, y;
+ static int defaultX = 5;
+ static int defaultY = 45;
+
+ if (!(winPtr->wmInfoPtr->sizeHintsFlags & (USPosition | PPosition))) {
+ /*
+ * We will override the program & hopefully place the
+ * window in a "better" location.
+ */
+
+ if (((tcl_macQdPtr->screenBits.bounds.right - defaultX) < 30) ||
+ ((tcl_macQdPtr->screenBits.bounds.bottom - defaultY) < 30)) {
+ defaultX = 5;
+ defaultY = 45;
+ }
+ x = defaultX;
+ y = defaultY;
+ defaultX += 20;
+ defaultY += 20;
+ } else {
+ x = winPtr->wmInfoPtr->x;
+ y = winPtr->wmInfoPtr->y;
+ }
+
+ geometry->left = x;
+ geometry->top = y;
+ geometry->right = x + winPtr->changes.width;
+ geometry->bottom = y + winPtr->changes.height;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacResizable --
+ *
+ * This function determines if the passed in window is part of
+ * a toplevel window that is resizable. If the window is
+ * resizable in the x, y or both directions, true is returned.
+ *
+ * Results:
+ * True if resizable, false otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkMacResizable(
+ TkWindow *winPtr) /* Tk window or NULL. */
+{
+ WmInfo *wmPtr;
+
+ if (winPtr == NULL) {
+ return false;
+ }
+ while (winPtr->wmInfoPtr == NULL) {
+ winPtr = winPtr->parentPtr;
+ }
+
+ wmPtr = winPtr->wmInfoPtr;
+ if ((wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) &&
+ (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE)) {
+ return false;
+ } else {
+ return true;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacGrowToplevel --
+ *
+ * The function is invoked when the user clicks in the grow region
+ * of a Tk window. The function will handle the dragging
+ * procedure and not return until completed. Finally, the function
+ * may place information Tk's event queue is the window was resized.
+ *
+ * Results:
+ * True if events were placed on event queue, false otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ }
+ if (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) {
+ bounds.left = bounds.right = winPtr->changes.width;
+ } else {
+ bounds.left = (wmPtr->minWidth < 64) ? 64 : wmPtr->minWidth;
+ bounds.right = (wmPtr->maxWidth < 64) ? 64 : wmPtr->maxWidth;
+ }
+ if (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) {
+ bounds.top = bounds.bottom = winPtr->changes.height;
+ } else {
+ bounds.top = (wmPtr->minHeight < 64) ? 64 : wmPtr->minHeight;
+ bounds.bottom = (wmPtr->maxHeight < 64) ? 64 : wmPtr->maxHeight;
+ }
+
+ growResult = GrowWindow(whichWindow, start, &bounds);
+
+ if (growResult != 0) {
+ SizeWindow(whichWindow,
+ LoWord(growResult), HiWord(growResult), true);
+ SetPort(whichWindow);
+ InvalRect(&whichWindow->portRect); /* TODO: may not be needed */
+ TkMacInvalClipRgns(winPtr);
+ TkGenWMConfigureEvent((Tk_Window) winPtr, -1, -1,
+ (int) LoWord(growResult), (int) HiWord(growResult),
+ TK_SIZE_CHANGED);
+ return true;
+ }
+ return false;
+ }
+ return false;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSetWMName --
+ *
+ * Set the title for a toplevel window. If the window is embedded,
+ * do not change the window title.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The title of the window is changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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)
+{
+ XEvent event;
+
+ event.xany.serial = Tk_Display(tkwin)->request;
+ event.xany.send_event = False;
+ event.xany.display = Tk_Display(tkwin);
+
+ event.xclient.window = Tk_WindowId(tkwin);
+ event.xclient.type = ClientMessage;
+ event.xclient.message_type = Tk_InternAtom(tkwin, "WM_PROTOCOLS");
+ event.xclient.format = 32;
+ event.xclient.data.l[0] = Tk_InternAtom(tkwin, "WM_DELETE_WINDOW");
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGenWMConfigureEvent --
+ *
+ * Generate a ConfigureNotify event for Tk. Depending on the
+ * value of flag the values of width/height, x/y, or both may
+ * be changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A ConfigureNotify event is sent to Tk.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkGenWMConfigureEvent(
+ Tk_Window tkwin,
+ int x,
+ int y,
+ int width,
+ int height,
+ int flags)
+{
+ XEvent event;
+ WmInfo *wmPtr;
+ TkWindow *winPtr = (TkWindow *) tkwin;
+
+ if (tkwin == NULL) {
+ return;
+ }
+
+ event.type = ConfigureNotify;
+ event.xconfigure.serial = Tk_Display(tkwin)->request;
+ event.xconfigure.send_event = False;
+ event.xconfigure.display = Tk_Display(tkwin);
+ event.xconfigure.event = Tk_WindowId(tkwin);
+ event.xconfigure.window = Tk_WindowId(tkwin);
+ event.xconfigure.border_width = winPtr->changes.border_width;
+ event.xconfigure.override_redirect = winPtr->atts.override_redirect;
+ if (winPtr->changes.stack_mode == Above) {
+ event.xconfigure.above = winPtr->changes.sibling;
+ } else {
+ event.xconfigure.above = None;
+ }
+
+ if (flags & TK_LOCATION_CHANGED) {
+ event.xconfigure.x = x;
+ event.xconfigure.y = y;
+ } else {
+ event.xconfigure.x = Tk_X(tkwin);
+ event.xconfigure.y = Tk_Y(tkwin);
+ x = Tk_X(tkwin);
+ y = Tk_Y(tkwin);
+ }
+ if (flags & TK_SIZE_CHANGED) {
+ event.xconfigure.width = width;
+ event.xconfigure.height = height;
+ } else {
+ event.xconfigure.width = Tk_Width(tkwin);
+ event.xconfigure.height = Tk_Height(tkwin);
+ width = Tk_Width(tkwin);
+ height = Tk_Height(tkwin);
+ }
+
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+
+ /*
+ * Update window manager information.
+ */
+ if (Tk_IsTopLevel(winPtr)) {
+ wmPtr = winPtr->wmInfoPtr;
+ if (flags & TK_LOCATION_CHANGED) {
+ wmPtr->x = x;
+ wmPtr->y = y;
+ wmPtr->flags &= ~(WM_NEGATIVE_X | WM_NEGATIVE_Y);
+ }
+ if ((flags & TK_SIZE_CHANGED) &&
+ ((width != Tk_Width(tkwin)) || (height != Tk_Height(tkwin)))) {
+ if ((wmPtr->width == -1) && (width == winPtr->reqWidth)) {
+ /*
+ * Don't set external width, since the user didn't change it
+ * from what the widgets asked for.
+ */
+ } else {
+ if (wmPtr->gridWin != NULL) {
+ wmPtr->width = wmPtr->reqGridWidth
+ + (width - winPtr->reqWidth)/wmPtr->widthInc;
+ if (wmPtr->width < 0) {
+ wmPtr->width = 0;
+ }
+ } else {
+ wmPtr->width = width;
+ }
+ }
+ if ((wmPtr->height == -1) && (height == winPtr->reqHeight)) {
+ /*
+ * Don't set external height, since the user didn't change it
+ * from what the widgets asked for.
+ */
+ } else {
+ if (wmPtr->gridWin != NULL) {
+ wmPtr->height = wmPtr->reqGridHeight
+ + (height - winPtr->reqHeight)/wmPtr->heightInc;
+ if (wmPtr->height < 0) {
+ wmPtr->height = 0;
+ }
+ } else {
+ wmPtr->height = height;
+ }
+ }
+ wmPtr->configWidth = width;
+ wmPtr->configHeight = height;
+ }
+ }
+
+ /*
+ * Now set up the changes structure. Under X we wait for the
+ * ConfigureNotify to set these values. On the Mac we know imediatly that
+ * this is what we want - so we just set them. However, we need to
+ * make sure the windows clipping region is marked invalid so the
+ * change is visable to the subwindow.
+ */
+ winPtr->changes.x = x;
+ winPtr->changes.y = y;
+ winPtr->changes.width = width;
+ winPtr->changes.height = height;
+ TkMacInvalClipRgns(winPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetTransientMaster --
+ *
+ * If the passed window has the TRANSIENT_FOR property set this
+ * will return the master window. Otherwise it will return None.
+ *
+ * Results:
+ * The master window or None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Window
+TkGetTransientMaster(
+ TkWindow *winPtr)
+{
+ if (winPtr->wmInfoPtr != NULL) {
+ return winPtr->wmInfoPtr->master;
+ }
+ return None;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacGetXWindow --
+ *
+ * Returns the X window Id associated with the given WindowRef.
+ *
+ * Results:
+ * The window id is returned. None is returned if not a Tk window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Window
+TkMacGetXWindow(
+ WindowRef macWinPtr)
+{
+ register Tcl_HashEntry *hPtr;
+
+ if ((macWinPtr == NULL) || !windowHashInit) {
+ return None;
+ }
+ hPtr = Tcl_FindHashEntry(&windowTable, (char *) macWinPtr);
+ if (hPtr == NULL) {
+ return None;
+ }
+ return (Window) Tcl_GetHashValue(hPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacZoomToplevel --
+ *
+ * The function is invoked when the user clicks in the zoom region
+ * of a Tk window. The function will handle the mouse tracking
+ * for the interaction. If the window is to be zoomed the window
+ * size is changed and events are generated to let Tk know what
+ * happened.
+ *
+ * Results:
+ * True if events were placed on event queue, false otherwise.
+ *
+ * Side effects:
+ * The window may be resized & events placed on Tk's queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkMacZoomToplevel(
+ WindowPtr whichWindow, /* The Macintosh window to zoom. */
+ Point where, /* The current mouse position. */
+ short zoomPart) /* Either inZoomIn or inZoomOut */
+{
+ Window window;
+ Tk_Window tkwin;
+ Point location = {0, 0};
+ int xOffset, yOffset;
+ WmInfo *wmPtr;
+
+ SetPort(whichWindow);
+ if (!TrackBox(whichWindow, where, zoomPart)) {
+ return false;
+ }
+
+ /*
+ * 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
+ * broken - we must manually set the standard state (by default
+ * it's something like 1x1) and we must swap the zoomPart manually
+ * otherwise we always get the same zoomPart and nothing happens.
+ */
+ wmPtr = ((TkWindow *) tkwin)->wmInfoPtr;
+ if (wmPtr->style >= floatProc && wmPtr->style <= floatSideZoomGrowProc) {
+ if (zoomPart == inZoomIn) {
+ Rect zoomRect = tcl_macQdPtr->screenBits.bounds;
+ InsetRect(&zoomRect, 60, 60);
+ SetWindowStandardState(whichWindow, &zoomRect);
+ zoomPart = inZoomOut;
+ } else {
+ zoomPart = inZoomIn;
+ }
+ }
+
+ ZoomWindow(whichWindow, zoomPart, false);
+ InvalRect(&whichWindow->portRect);
+ TkMacInvalClipRgns((TkWindow *) tkwin);
+
+ LocalToGlobal(&location);
+ TkMacWindowOffset(whichWindow, &xOffset, &yOffset);
+ location.h -= xOffset;
+ location.v -= yOffset;
+ TkGenWMConfigureEvent(tkwin, location.h, location.v,
+ whichWindow->portRect.right - whichWindow->portRect.left,
+ whichWindow->portRect.bottom - whichWindow->portRect.top,
+ TK_BOTH_CHANGED);
+ return true;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUnsupported1Cmd --
+ *
+ * This procedure is invoked to process the "unsupported1" Tcl
+ * command. This command allows you to set the style of decoration
+ * for a Macintosh window.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * Changes the style of a new Mac window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TkUnsupported1Cmd(
+ 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 < 3) {
+ wrongNumArgs:
+ Tcl_AppendResult(interp, "wrong # args: should be \"",
+ argv[0], " option window ?arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[2], tkwin);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ Tcl_AppendResult(interp, "window \"", winPtr->pathName,
+ "\" isn't a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ wmPtr = winPtr->wmInfoPtr;
+ c = argv[1][0];
+ length = strlen(argv[1]);
+ if ((c == 's') && (strncmp(argv[1], "style", length) == 0)) {
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # arguments: must be \"",
+ argv[0], " style window ?windowStyle?\"",
+ (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) {
+ wmPtr->style = documentProc;
+ } else if (strcmp(argv[3], "noGrowDocProc") == 0) {
+ wmPtr->style = documentProc;
+ } else if (strcmp(argv[3], "dBoxProc") == 0) {
+ wmPtr->style = dBoxProc;
+ } else if (strcmp(argv[3], "plainDBox") == 0) {
+ wmPtr->style = plainDBox;
+ } else if (strcmp(argv[3], "altDBoxProc") == 0) {
+ wmPtr->style = altDBoxProc;
+ } else if (strcmp(argv[3], "movableDBoxProc") == 0) {
+ wmPtr->style = movableDBoxProc;
+ } else if (strcmp(argv[3], "zoomDocProc") == 0) {
+ wmPtr->style = zoomDocProc;
+ } else if (strcmp(argv[3], "zoomNoGrow") == 0) {
+ wmPtr->style = zoomNoGrow;
+ } else if (strcmp(argv[3], "rDocProc") == 0) {
+ wmPtr->style = rDocProc;
+ } else if (strcmp(argv[3], "floatProc") == 0) {
+ wmPtr->style = floatGrowProc;
+ } else if (strcmp(argv[3], "floatGrowProc") == 0) {
+ wmPtr->style = floatGrowProc;
+ } else if (strcmp(argv[3], "floatZoomProc") == 0) {
+ wmPtr->style = floatZoomGrowProc;
+ } else if (strcmp(argv[3], "floatZoomGrowProc") == 0) {
+ wmPtr->style = floatZoomGrowProc;
+ } else if (strcmp(argv[3], "floatSideProc") == 0) {
+ wmPtr->style = floatSideGrowProc;
+ } else if (strcmp(argv[3], "floatSideGrowProc") == 0) {
+ wmPtr->style = floatSideGrowProc;
+ } else if (strcmp(argv[3], "floatSideZoomProc") == 0) {
+ wmPtr->style = floatSideZoomGrowProc;
+ } else if (strcmp(argv[3], "floatSideZoomGrowProc") == 0) {
+ wmPtr->style = floatSideZoomGrowProc;
+ } else {
+ Tcl_AppendResult(interp, "bad style: should be documentProc, ",
+ "dBoxProc, plainDBox, altDBoxProc, movableDBoxProc, ",
+ "zoomDocProc, rDocProc, floatProc, floatZoomProc, ",
+ "floatSideProc, or floatSideZoomProc",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ } else {
+ Tcl_AppendResult(interp, "unknown or ambiguous option \"", argv[1],
+ "\": must be style",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMakeMenuWindow --
+ *
+ * Configure the window to be either a undecorated pull-down
+ * (or pop-up) menu, or as a toplevel floating menu (palette).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the style bit used to create a new Mac toplevel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMakeMenuWindow(
+ Tk_Window tkwin, /* New window. */
+ int transient) /* 1 means menu is only posted briefly as
+ * a popup or pulldown or cascade. 0 means
+ * menu is always visible, e.g. as a
+ * floating menu. */
+{
+ if (transient) {
+ ((TkWindow *) tkwin)->wmInfoPtr->style = plainDBox;
+ } else {
+ ((TkWindow *) tkwin)->wmInfoPtr->style = floatProc;
+ ((TkWindow *) tkwin)->wmInfoPtr->flags |= WM_WIDTH_NOT_RESIZABLE;
+ ((TkWindow *) tkwin)->wmInfoPtr->flags |= WM_HEIGHT_NOT_RESIZABLE;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacMakeRealWindowExist --
+ *
+ * This function finally creates the real Macintosh window that
+ * the Mac actually understands.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new Macintosh toplevel is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacMakeRealWindowExist(
+ TkWindow *winPtr) /* Tk window. */
+{
+ WmInfo *wmPtr = winPtr->wmInfoPtr;
+ WindowRef newWindow = NULL;
+ MacDrawable *macWin;
+ Rect geometry;
+ Tcl_HashEntry *valueHashPtr;
+ int new;
+ TkMacWindowList *listPtr;
+
+ if (TkMacHostToplevelExists(winPtr)) {
+ return;
+ }
+
+ macWin = (MacDrawable *) winPtr->window;
+
+ /*
+ * If this is embedded, make sure its container's toplevel exists,
+ * then return...
+ */
+
+ 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.
+ */
+
+ }
+
+ InitialWindowBounds(winPtr, &geometry);
+
+ newWindow = NewCWindow(NULL, &geometry, "\ptemp", false,
+ (short) wmPtr->style, (WindowRef) -1, true, 0);
+ if (newWindow == NULL) {
+ panic("couldn't allocate new Mac window");
+ }
+
+ /*
+ * Add this window to the list of toplevel windows.
+ */
+
+ 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,
+ (char *) newWindow, &new);
+ if (!new) {
+ panic("same macintosh window allocated twice!");
+ }
+ Tcl_SetHashValue(valueHashPtr, macWin);
+
+ macWin->flags |= TK_HOST_EXISTS;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacRegisterOffScreenWindow --
+ *
+ * This function adds the passed in Off Screen Port to the
+ * hash table that maps Mac windows to root X windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * An entry is added to the windowTable hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacRegisterOffScreenWindow(
+ Window window, /* Window structure. */
+ GWorldPtr portPtr) /* Pointer to a Mac GWorld. */
+{
+ WindowRef newWindow = NULL;
+ MacDrawable *macWin;
+ Tcl_HashEntry *valueHashPtr;
+ int new;
+
+ macWin = (MacDrawable *) window;
+ if (!windowHashInit) {
+ Tcl_InitHashTable(&windowTable, TCL_ONE_WORD_KEYS);
+ windowHashInit = true;
+ }
+ valueHashPtr = Tcl_CreateHashEntry(&windowTable,
+ (char *) portPtr, &new);
+ if (!new) {
+ panic("same macintosh window allocated twice!");
+ }
+ Tcl_SetHashValue(valueHashPtr, macWin);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacUnregisterMacWindow --
+ *
+ * Given a macintosh port window, this function removes the
+ * association between this window and the root X window that
+ * Tk cares about.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * An entry is removed from the windowTable hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacUnregisterMacWindow(
+ GWorldPtr portPtr) /* Pointer to a Mac GWorld. */
+{
+ if (!windowHashInit) {
+ panic("TkMacUnregisterMacWindow: unmapping before inited");;
+ }
+ Tcl_DeleteHashEntry(Tcl_FindHashEntry(&windowTable,
+ (char *) portPtr));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacSetScrollbarGrow --
+ *
+ * Sets a flag for a toplevel window indicating that the passed
+ * Tk scrollbar window will display the grow region for the
+ * toplevel window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A flag is set int windows toplevel parent.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkMacSetScrollbarGrow(
+ TkWindow *winPtr, /* Tk scrollbar window. */
+ int flag) /* Boolean value true or false. */
+{
+ if (flag) {
+ winPtr->privatePtr->toplevel->flags |= TK_SCROLLBAR_GROW;
+ winPtr->privatePtr->toplevel->winPtr->wmInfoPtr->scrollWinPtr = winPtr;
+ } else if (winPtr->privatePtr->toplevel->winPtr->wmInfoPtr->scrollWinPtr
+ == winPtr) {
+ winPtr->privatePtr->toplevel->flags &= ~TK_SCROLLBAR_GROW;
+ winPtr->privatePtr->toplevel->winPtr->wmInfoPtr->scrollWinPtr = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkMacGetScrollbarGrowWindow --
+ *
+ * Tests to see if a given window's toplevel window contains a
+ * scrollbar that will draw the GrowIcon for the window.
+ *
+ * Results:
+ * Boolean value.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkMacGetScrollbarGrowWindow(
+ TkWindow *winPtr) /* Tk window. */
+{
+ TkWindow *scrollWinPtr;
+
+ if (winPtr == NULL) {
+ return NULL;
+ }
+ scrollWinPtr =
+ winPtr->privatePtr->toplevel->winPtr->wmInfoPtr->scrollWinPtr;
+ if (winPtr != NULL) {
+ /*
+ * We need to confirm the window exists.
+ */
+ if ((Tk_Window) scrollWinPtr !=
+ Tk_IdToWindow(winPtr->display, winPtr->window)) {
+ scrollWinPtr = NULL;
+ }
+ }
+ return scrollWinPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmFocusToplevel --
+ *
+ * This is a utility procedure invoked by focus-management code. It
+ * exists because of the extra wrapper windows that exist under
+ * Unix; its job is to map from wrapper windows to the
+ * corresponding toplevel windows. On PCs and Macs there are no
+ * wrapper windows so no mapping is necessary; this procedure just
+ * determines whether a window is a toplevel or not.
+ *
+ * Results:
+ * If winPtr is a toplevel window, returns the pointer to the
+ * window; otherwise returns NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkWmFocusToplevel(
+ TkWindow *winPtr) /* Window that received a focus-related
+ * event. */
+{
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ return NULL;
+ }
+ return winPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetWrapperWindow --
+ *
+ * This is a utility procedure invoked by focus-management code. It
+ * maps to the wrapper for a top-level, which is just the same
+ * as the top-level on Macs and PCs.
+ *
+ * Results:
+ * If winPtr is a toplevel window, returns the pointer to the
+ * window; otherwise returns NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkpGetWrapperWindow(
+ TkWindow *winPtr) /* Window that received a focus-related
+ * event. */
+{
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ return NULL;
+ }
+ return winPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpWmSetState --
+ *
+ * Sets the window manager state for the wrapper window of a
+ * given toplevel window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May maximize, minimize, restore, or withdraw a window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpWmSetState(winPtr, state)
+ TkWindow *winPtr; /* Toplevel window to operate on. */
+ int state; /* One of IconicState, ZoomState, NormalState,
+ * or WithdrawnState. */
+{
+ WmInfo *wmPtr = winPtr->wmInfoPtr;
+ GWorldPtr macWin;
+
+ wmPtr->hints.initial_state = state;
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ return;
+ }
+
+ 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;
+}
diff --git a/tk/mac/tkMacXCursors.r b/tk/mac/tkMacXCursors.r
new file mode 100644
index 00000000000..18176d1ada3
--- /dev/null
+++ b/tk/mac/tkMacXCursors.r
@@ -0,0 +1,961 @@
+/*
+ * 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. (gneufeld@ccs.carleton.ca)
+ *
+ *
+ * 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$
+ */
+
+/*
+ * 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').
+ */
+
+data 'CURS' (3000, "X_cursor") {
+ $"E007 F00F F81F 7C3E 3E7C 1FF8 0FF0 07E0"
+ $"07E0 0FF0 1FF8 3E7C 7C3E F81F F00F E007"
+ $"0000 6006 700E 381C 1C38 0E70 07E0 03C0"
+ $"03C0 07E0 0E70 1C38 381C 700E 6006 0000"
+ $"0007 0007"
+};
+
+data 'CURS' (3001, "arrow") {
+ $"0000 0006 001E 007C 01FC 07F8 00F8 01F0"
+ $"03B0 0720 0E20 1C00 3800 7000 2000 0000"
+ $"0007 001F 007F 01FE 07FE 1FFC 7FFC 03F8"
+ $"07F8 0FF0 1F70 3E60 7C60 F840 7040 2000"
+ $"0001 000E"
+};
+
+data 'CURS' (3002, "based_arrow_down") {
+ $"0000 0000 0000 1FE0 0000 1FE0 0300 0300"
+ $"0300 0B40 0780 0300 0000 0000 0000 0000"
+ $"0000 0000 0000 1FE0 0000 1FE0 0780 0780"
+ $"3FF0 1FE0 0FC0 0780 0300 0000 0000 0000"
+ $"000B 0006"
+};
+
+data 'CURS' (3003, "based_arrow_up") {
+ $"0000 0000 0000 0000 0300 0780 0B40 0300"
+ $"0300 0300 1FE0 0000 1FE0 0000 0000 0000"
+ $"0000 0000 0000 0300 0780 0FC0 1FE0 3FF0"
+ $"0780 0780 1FE0 0000 1FE0 0000 0000 0000"
+ $"0004 0006"
+};
+
+data 'CURS' (3004, "boat") {
+ $"0000 0000 0000 0000 0100 03C0 8460 FFFF"
+ $"0018 0020 0040 FFC0 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0100 03C0 87E0 FFFF"
+ $"FFF8 FFE0 FFC0 FFC0 0000 0000 0000 0000"
+ $"0007 000F"
+};
+
+data 'CURS' (3005, "bogosity") {
+ $"0000 711C 1110 1110 1110 7FFC 5114 5114"
+ $"5114 5114 7FFC 1110 1110 1110 711C 0000"
+ $"0000 0000 0000 0000 0000 7FFC 7FFC 7FFC"
+ $"7FFC 7FFC 7FFC 0000 0000 0000 0000 0000"
+ $"0001 0007"
+};
+
+data 'CURS' (3006, "bottom_left_corner") {
+ $"0000 0000 0000 0000 C000 C020 C840 C880"
+ $"C900 CA00 CC00 CFC0 C000 C000 FFF0 FFF0"
+ $"0000 0000 0000 0000 0000 0020 0840 0880"
+ $"0900 0A00 0C00 0FC0 0000 0000 0000 0000"
+ $"000F 0000"
+};
+
+data 'CURS' (3007, "bottom_right_corner") {
+ $"0000 0000 0000 0000 0003 0403 0213 0113"
+ $"0093 0053 0033 03F3 0003 0003 0FFF 0FFF"
+ $"0000 0000 0000 0000 0000 0400 0210 0110"
+ $"0090 0050 0030 03F0 0000 0000 0000 0000"
+ $"000F 000F"
+};
+
+data 'CURS' (3008, "bottom_side") {
+ $"0000 0000 0100 0100 0100 0100 0100 1110"
+ $"0920 0540 0380 0100 0000 7FFC 7FFC 0000"
+ $"0000 0000 0100 0100 0100 0100 0100 1110"
+ $"0920 0540 0380 0100 0000 0000 0000 0000"
+ $"000B 0007"
+};
+
+data 'CURS' (3009, "bottom_tee") {
+ $"0000 0000 0000 0180 0180 0180 0180 0180"
+ $"0180 0180 7FFE 7FFE 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"000B 0007"
+};
+
+data 'CURS' (3010, "box_spiral") {
+ $"FFFE 8000 BFFE A002 AFFA A80A ABEA AA2A"
+ $"AAAA ABAA A82A AFEA A00A BFFA 8002 FFFE"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0008 0008"
+};
+
+data 'CURS' (3011, "center_ptr") {
+ $"0000 0300 0300 0780 0780 0FC0 0FC0 1FE0"
+ $"1FE0 3330 2310 0300 0300 0300 0300 0000"
+ $"0300 0780 0780 0FC0 0FC0 1FE0 1FE0 3FF0"
+ $"3FF0 7FF8 77B8 6798 0780 0780 0780 0780"
+ $"0001 0006"
+};
+
+data 'CURS' (3012, "circle") {
+ $"0000 03C0 0FF0 1FF8 3C3C 381C 700E 700E"
+ $"700E 700E 381C 3C3C 1FF8 0FF0 03C0 0000"
+ $"03C0 0FF0 1FF8 3FFC 7FFE 7C3E F81F F81F"
+ $"F81F F81F 7C3E 7FFE 3FFC 1FF8 0FF0 03C0"
+ $"0007 0007"
+};
+
+data 'CURS' (3013, "clock") {
+ $"1FF8 33CC 6466 4992 4F12 4422 63C6 3FFC"
+ $"2994 2994 2994 2BD4 6996 781E 7FFE 7FFE"
+ $"1FF8 3FFC 7FFE 7FFE 7FFE 7FFE 7FFE 3FFC"
+ $"3FFC 3FFC 3FFC 3FFC 7FFE 7FFE 7FFE 7FFE"
+ $"0004 0008"
+};
+
+data 'CURS' (3014, "coffee_mug") {
+ $"03F8 0C06 1001 1C07 33F9 7001 D001 9001"
+ $"960D DA55 7A55 36ED 10A1 1001 0802 07FC"
+ $"03F8 0FFE 1FFF 1FFF 3FFF 7FFF FFFF FFFF"
+ $"FFFF FFFF 7FFF 3FFF 1FFF 1FFF 0FFE 07FC"
+ $"0004 0003"
+};
+
+data 'CURS' (3015, "cross") {
+ $"0280 0280 0280 0280 0280 0280 FEFE 0000"
+ $"FEFE 0280 0280 0280 0280 0280 0280 0000"
+ $"0380 0380 0380 0380 0380 0380 FFFE FFFE"
+ $"FFFE 0380 0380 0380 0380 0380 0380 0000"
+ $"0007 0007"
+};
+
+data 'CURS' (3016, "cross_reverse") {
+ $"4284 A28A 5294 2AA8 16D0 0AA0 FD7E 0280"
+ $"FD7E 0AA0 16D0 2AA8 5294 A28A 4284 0000"
+ $"4384 E38E 739C 3BB8 1FF0 0FE0 FFFE FFFE"
+ $"FFFE 0FE0 1FF0 3BB8 739C E38E 4384 0000"
+ $"0007 0007"
+};
+
+data 'CURS' (3017, "crosshair") {
+ $"0100 0100 0100 0100 0100 0100 0100 FEFE"
+ $"0100 0100 0100 0100 0100 0100 0100 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0007 0007"
+};
+
+data 'CURS' (3018, "diamond_cross") {
+ $"0280 06C0 0AA0 1290 2288 4284 FEFE 0000"
+ $"FEFE 4284 2288 1290 0AA0 06C0 0280 0000"
+ $"0280 06C0 0EE0 1EF0 3EF8 7EFC FEFE 0000"
+ $"FEFE 7EFC 3EF8 1EF0 0EE0 06C0 0280 0000"
+ $"0007 0007"
+};
+
+data 'CURS' (3019, "dot") {
+ $"0000 0000 0780 1FE0 1FE0 3FF0 3FF0 3FF0"
+ $"3FF0 1FE0 1FE0 0780 0000 0000 0000 0000"
+ $"0000 0780 1FE0 3FF0 3FF0 7FF8 7FF8 7FF8"
+ $"7FF8 3FF0 3FF0 1FE0 0780 0000 0000 0000"
+ $"0006 0006"
+};
+
+data 'CURS' (3020, "dotbox") {
+ $"0000 0000 3FFC 2004 2004 2004 2004 2184"
+ $"2184 2004 2004 2004 2004 3FFC 0000 0000"
+ $"0000 0000 3FFC 3FFC 300C 300C 318C 33CC"
+ $"33CC 318C 300C 300C 3FFC 3FFC 0000 0000"
+ $"0007 0007"
+};
+
+data 'CURS' (3021, "double_arrow") {
+ $"0000 0180 03C0 07E0 0DB0 1998 0180 0180"
+ $"0180 0180 1998 0DB0 07E0 03C0 0180 0000"
+ $"0180 03C0 07E0 0FF0 1FF8 3FFC 3BDC 03C0"
+ $"03C0 3BDC 3FFC 1FF8 0FF0 07E0 03C0 0180"
+ $"0007 0007"
+};
+
+data 'CURS' (3022, "draft_large") {
+ $"0000 0002 000C 003C 00F8 03F8 0FF0 00F0"
+ $"0160 0260 0440 0840 1000 2000 4000 0000"
+ $"0003 000F 003E 00FE 03FC 0FFC 3FF8 FFF8"
+ $"03F0 07F0 0EE0 1CE0 38C0 70C0 E080 4080"
+ $"0001 000E"
+};
+
+data 'CURS' (3023, "draft_small") {
+ $"0000 0002 000C 003C 00F8 03F8 0070 00B0"
+ $"0120 0220 0400 0800 1000 2000 4000 0000"
+ $"0003 000F 003E 00FE 03FC 0FFC 3FF8 01F8"
+ $"03F0 0770 0E60 1C60 3840 7040 E000 4000"
+ $"0001 000E"
+};
+
+data 'CURS' (3024, "draped_box") {
+ $"0000 0000 3FFC 2244 2664 2C34 381C 2184"
+ $"2184 381C 2C34 2664 2244 3FFC 0000 0000"
+ $"0000 0000 3FFC 3E7C 3E7C 3C3C 399C 23C4"
+ $"23C4 399C 3C3C 3E7C 3E7C 3FFC 0000 0000"
+ $"0007 0007"
+};
+
+data 'CURS' (3025, "exchange") {
+ $"0000 47C0 6FE0 7C30 4810 4C00 7E00 0000"
+ $"0000 00FC 0064 1024 187C 0FEC 07C4 0000"
+ $"C7C0 EFE0 FFF0 FFF8 FC38 FE10 FF00 FF80"
+ $"03FE 01FE 10FE 387E 3FFE 1FFE 0FEE 07C6"
+ $"0007 0007"
+};
+
+data 'CURS' (3026, "fleur") {
+ $"0000 0180 03C0 07E0 0180 1188 318C 7FFE"
+ $"7FFE 318C 1188 0180 07E0 03C0 0180 0000"
+ $"0180 03C0 07E0 0FF0 17E8 3BDC 7FFE FFFF"
+ $"FFFF 7FFE 3BDC 17E8 0FF0 07E0 03C0 0180"
+ $"0007 0007"
+};
+
+data 'CURS' (3027, "gobbler") {
+ $"0000 0078 0070 4036 4FB0 7FF0 7E30 7C30"
+ $"3038 00F0 0FE0 0400 0400 0400 0F00 0000"
+ $"00FC 00FC E0FF FFFF FFFF FFF8 FFF8 FFF8"
+ $"FFFC 7FFC 3FF8 1FF0 0E00 1F80 1F80 1F80"
+ $"0003 000E"
+};
+
+data 'CURS' (3028, "gumby") {
+ $"3F00 10C0 C820 EAA0 C820 CBA0 F838 383E"
+ $"0826 0826 092E 0926 0920 1110 2108 3EF8"
+ $"3F00 1FC0 CFE0 EFE0 CFE0 CFE0 FFF8 3FFE"
+ $"0FE6 0FE6 0FEE 0FE6 0FE0 1FF0 3FF8 3EF8"
+ $"0000 0002"
+};
+
+data 'CURS' (3029, "hand1") {
+ $"000C 003C 00F0 01E0 03C0 07E0 0FF0 2FE0"
+ $"7FF0 5FF0 07E0 07C0 4A00 6200 3400 1800"
+ $"000C 003C 00F0 01E0 03C0 07E0 0FF0 2FE0"
+ $"7FF0 7FF0 7FE0 7FC0 7E00 7E00 3C00 1800"
+ $"0000 000D"
+};
+
+data 'CURS' (3030, "hand2") {
+ $"0000 3FC0 4020 3F10 0808 0708 0808 0714"
+ $"0822 0641 0182 0124 0088 0050 0020 0000"
+ $"0000 3FC0 7FE0 3FF0 0FF8 07F8 0FF8 07FC"
+ $"0FFE 07FF 01FE 01FC 00F8 0070 0020 0000"
+ $"0002 0001"
+};
+
+data 'CURS' (3031, "heart") {
+ $"0000 3EF8 638C C106 8002 8002 8002 8002"
+ $"C006 600C 3018 1830 0C60 06C0 0380 0000"
+ $"0000 3EF8 7FFC FFFE FFFE FFFE FFFE FFFE"
+ $"FFFE 7FFC 3FF8 1FF0 0FE0 07C0 0380 0000"
+ $"0003 0007"
+};
+
+data 'CURS' (3032, "icon") {
+ $"FFFF D555 AAAB D555 A00B D005 A00B D005"
+ $"A00B D005 A00B D005 AAAB D555 AAAB FFFF"
+ $"FFFF FFFF FFFF FFFF F00F F00F F00F F00F"
+ $"F00F F00F F00F F00F FFFF FFFF FFFF FFFF"
+ $"0007 0007"
+};
+
+data 'CURS' (3033, "iron_cross") {
+ $"0000 3FFC 1FF8 4FF2 67E6 73CE 799E 7FFE"
+ $"7FFE 799E 73CE 67E6 4FF2 1FF8 3FFC 0000"
+ $"7FFE 7FFE FFFF FFFF FFFF FFFF FFFF FFFF"
+ $"FFFF FFFF FFFF FFFF FFFF FFFF 7FFE 7FFE"
+ $"0007 0006"
+};
+
+data 'CURS' (3034, "left_ptr") {
+ $"0000 0800 0C00 0E00 0F00 0F80 0FC0 0FE0"
+ $"0FF0 0F80 0D80 08C0 00C0 0060 0060 0000"
+ $"1800 1C00 1E00 1F00 1F80 1FC0 1FE0 1FF0"
+ $"1FF8 1FFC 1FC0 1DE0 19E0 10F0 00F0 0070"
+ $"0001 0004"
+};
+
+data 'CURS' (3035, "left_side") {
+ $"0000 6000 6000 6080 6100 6200 6400 6FFC"
+ $"6400 6200 6100 6080 6000 6000 0000 0000"
+ $"0000 0000 0000 0080 0100 0200 0400 0FFC"
+ $"0400 0200 0100 0080 0000 0000 0000 0000"
+ $"0007 0004"
+};
+
+data 'CURS' (3036, "left_tee") {
+ $"0000 0C00 0C00 0C00 0C00 0C00 0C00 0FF8"
+ $"0FF8 0C00 0C00 0C00 0C00 0C00 0C00 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0007 0004"
+};
+
+data 'CURS' (3037, "leftbutton") {
+ $"8002 7FFC 7FFC 4444 4554 4554 4554 4554"
+ $"4444 7FFC 7FFC 7FFC 7FFC 7FFC 7FFC 8002"
+ $"FFFE FFFE FFFE FFFE FFFE FFFE FFFE FFFE"
+ $"FFFE FFFE FFFE FFFE FFFE FFFE FFFE FFFE"
+ $"0004 0003"
+};
+
+data 'CURS' (3038, "ll_angle") {
+ $"0000 0000 0000 0C00 0C00 0C00 0C00 0C00"
+ $"0C00 0C00 0FF8 0FF8 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"000B 0004"
+};
+
+data 'CURS' (3039, "lr_angle") {
+ $"0000 0000 0000 0030 0030 0030 0030 0030"
+ $"0030 0030 1FF0 1FF0 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"000B 000B"
+};
+
+data 'CURS' (3040, "man") {
+ $"0380 1EF0 0280 8100 4387 244B 1D70 0540"
+ $"0440 0280 0440 0920 1290 1450 783C F83F"
+ $"0380 1FF0 0380 8100 4387 27CB 1FF0 07C0"
+ $"07C0 0380 07C0 0FE0 1EF0 1C70 783C F83F"
+ $"0001 0007"
+};
+
+data 'CURS' (3041, "middlebutton") {
+ $"8002 7FFC 7FFC 4444 5454 5454 5454 5454"
+ $"4444 7FFC 7FFC 7FFC 7FFC 7FFC 7FFC 8002"
+ $"FFFE FFFE FFFE FFFE FFFE FFFE FFFE FFFE"
+ $"FFFE FFFE FFFE FFFE FFFE FFFE FFFE FFFE"
+ $"0004 0007"
+};
+
+data 'CURS' (3042, "mouse") {
+ $"0600 0100 0180 0FF0 1008 17E8 1428 1428"
+ $"17E8 1008 1008 1008 1008 1008 1008 0FF0"
+ $"0600 0100 0180 0FF0 1FF8 1FF8 1FF8 1FF8"
+ $"1FF8 1FF8 1FF8 1FF8 1FF8 1FF8 1FF8 0FF0"
+ $"0000 0000"
+};
+
+data 'CURS' (3043, "pencil") {
+ $"0000 00F0 0088 0108 0190 0270 0220 0440"
+ $"0440 0880 0880 1100 1E00 1C00 1800 1000"
+ $"0000 00F0 00F8 01F8 01F0 03F0 03E0 07C0"
+ $"07C0 0F80 0F80 1F00 1E00 1C00 1800 1000"
+ $"000F 0003"
+};
+
+data 'CURS' (3044, "pirate") {
+ $"03C0 07E0 0FF0 1998 1998 0FF0 07E0 03C0"
+ $"43C2 43C3 2184 1C38 03C0 0FF1 781F 4002"
+ $"07E0 0FF0 1FF8 3FFC 3FFC 1FF8 0FF0 47E2"
+ $"E7E7 E7E7 7FFF 3FFC 1FF9 7FFF FFFF F81F"
+ $"000A 0007"
+};
+
+data 'CURS' (3045, "plus") {
+ $"0000 0000 0000 0180 0180 0180 0180 1FF8"
+ $"1FF8 0180 0180 0180 0180 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0007 0007"
+};
+
+data 'CURS' (3046, "question_arrow") {
+ $"07C0 0FE0 1C70 1830 1C30 0C70 00E0 03C0"
+ $"0380 0280 0280 0EE0 06C0 0380 0100 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 3FF8 1FF0 0FE0 07C0 0380 0100"
+ $"000E 0007"
+};
+
+data 'CURS' (3047, "right_ptr") {
+ $"0000 0010 0030 0070 00F0 01F0 03F0 07F0"
+ $"0FF0 01F0 01B0 0310 0300 0600 0600 0000"
+ $"0018 0038 0078 00F8 01F8 03F8 07F8 0FF8"
+ $"1FF8 3FF8 03F8 07B8 0798 0F08 0F00 0E00"
+ $"0001 000B"
+};
+
+data 'CURS' (3048, "right_side") {
+ $"0000 0000 0006 0006 0106 0086 0046 0026"
+ $"3FF6 0026 0046 0086 0106 0006 0006 0000"
+ $"0000 0000 0000 0000 0100 0080 0040 0020"
+ $"3FF0 0020 0040 0080 0100 0000 0000 0000"
+ $"0008 000B"
+};
+
+data 'CURS' (3049, "right_tee") {
+ $"0000 0030 0030 0030 0030 0030 0030 1FF0"
+ $"1FF0 0030 0030 0030 0030 0030 0030 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0007 000A"
+};
+
+data 'CURS' (3050, "rightbutton") {
+ $"8002 7FFC 7FFC 4444 5544 5544 5544 5544"
+ $"4444 7FFC 7FFC 7FFC 7FFC 7FFC 7FFC 8002"
+ $"FFFE FFFE FFFE FFFE FFFE FFFE FFFE FFFE"
+ $"FFFE FFFE FFFE FFFE FFFE FFFE FFFE FFFE"
+ $"0004 0003"
+};
+
+data 'CURS' (3051, "rtl_logo") {
+ $"0000 7FFE 4022 4022 4022 7FE2 4422 4422"
+ $"4422 4422 47FE 4402 4402 4402 7FFE 0000"
+ $"0000 7FFE 7FFE 6076 7FF6 7FF6 7C36 6C36"
+ $"6C36 6C3E 6FFE 6FFE 6E06 7FFE 7FFE 0000"
+ $"0007 0007"
+};
+
+data 'CURS' (3052, "sailboat") {
+ $"0000 0040 0040 0160 0160 0360 0370 0770"
+ $"0770 0F78 0F78 1F78 1F7C 3E38 0000 0000"
+ $"0040 00E0 01E0 03F0 03F0 07F0 07F8 0FF8"
+ $"0FF8 1FFC 1FFC 3FFC 3FFE 7F7C 7E38 0000"
+ $"000C 0008"
+};
+
+data 'CURS' (3053, "sb_down_arrow") {
+ $"0280 0280 0280 0280 0280 0280 0280 0280"
+ $"0280 0280 0280 0FE0 07C0 0380 0100 0000"
+ $"0380 0380 0380 0380 0380 0380 0380 0380"
+ $"0380 0380 0380 1FF0 0FE0 07C0 0380 0100"
+ $"000E 0007"
+};
+
+data 'CURS' (3054, "sb_h_double_arrow") {
+ $"0000 0000 0000 0000 0810 1818 3FFC 781E"
+ $"3FFC 1818 0810 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0810 1818 381C 7FFE FFFF"
+ $"7FFE 381C 1818 0810 0000 0000 0000 0000"
+ $"0007 0007"
+};
+
+data 'CURS' (3055, "sb_left_arrow") {
+ $"0000 0000 0000 0000 0800 1800 3FFF 7800"
+ $"3FFF 1800 0800 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0800 1800 3800 7FFF FFFF"
+ $"7FFF 3800 1800 0800 0000 0000 0000 0000"
+ $"0007 0001"
+};
+
+data 'CURS' (3056, "sb_right_arrow") {
+ $"0000 0000 0000 0000 0000 0010 0018 FFFC"
+ $"001E FFFC 0018 0010 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0010 0018 001C FFFE"
+ $"FFFF FFFE 001C 0018 0010 0000 0000 0000"
+ $"0008 000E"
+};
+
+data 'CURS' (3057, "sb_up_arrow") {
+ $"0000 0080 01C0 03E0 07F0 0140 0140 0140"
+ $"0140 0140 0140 0140 0140 0140 0140 0140"
+ $"0080 01C0 03E0 07F0 0FF8 01C0 01C0 01C0"
+ $"01C0 01C0 01C0 01C0 01C0 01C0 01C0 01C0"
+ $"0001 0008"
+};
+
+data 'CURS' (3058, "sb_v_double_arrow") {
+ $"0000 0100 0380 07C0 0FE0 0280 0280 0280"
+ $"0280 0280 0280 0FE0 07C0 0380 0100 0000"
+ $"0100 0380 07C0 0FE0 1FF0 0380 0380 0380"
+ $"0380 0380 0380 1FF0 0FE0 07C0 0380 0100"
+ $"0007 0007"
+};
+
+data 'CURS' (3059, "shuttle") {
+ $"0020 0070 00F8 01DE 05DE 09DE 11DE 11DE"
+ $"11DE 11DE 31DE 71DE FDDE 1888 0078 0030"
+ $"0020 0070 00F8 01FE 07FE 0FFE 1FFE 1FFE"
+ $"1FFE 1FFE 3FFE 7FFE FFFE 18F8 0078 0030"
+ $"0000 000A"
+};
+
+data 'CURS' (3060, "sizing") {
+ $"0000 7F80 4000 4000 4000 47E0 4420 4422"
+ $"4422 0422 07E2 0012 000A 0006 01FE 0000"
+ $"FFC0 FFC0 FFC0 E000 EFF0 EFF0 EC37 EC37"
+ $"EC37 EC37 0FF7 0FFF 001F 03FF 03FF 03FF"
+ $"000E 000E"
+};
+
+data 'CURS' (3061, "spider") {
+ $"2010 1020 1020 0840 0840 8787 6798 1FE0"
+ $"1FE0 6798 8787 0840 0840 1020 1020 2010"
+ $"7038 3870 3870 1CE0 9FE7 EFDF FFFF 7FF8"
+ $"7FF8 FFFF EFDF 9FE7 1CE0 3870 3870 7038"
+ $"0007 0007"
+};
+
+data 'CURS' (3062, "spraycan") {
+ $"0018 0040 0D18 1E40 1A18 3F00 2100 3900"
+ $"2900 3900 2900 3900 3900 2100 2100 3F00"
+ $"0000 0000 0C00 1E00 1E00 3F00 3F00 3F00"
+ $"3F00 3F00 3F00 3F00 3F00 3F00 3F00 3F00"
+ $"0002 0007"
+};
+
+data 'CURS' (3063, "star") {
+ $"0100 0280 0280 0280 0440 0440 0440 3938"
+ $"C006 3838 0920 1290 2448 2828 3018 2008"
+ $"0100 0380 0380 0380 07C0 07C0 07C0 3FF8"
+ $"FFFE 3FF8 0FE0 1EF0 3C78 3838 3018 2008"
+ $"0007 0007"
+};
+
+data 'CURS' (3064, "target") {
+ $"0000 0380 0FE0 1C70 3018 600C C106 C286"
+ $"C106 600C 3018 1C70 0FE0 0380 0000 0000"
+ $"0000 0380 0FE0 1FF0 3C78 701C E38E E38E"
+ $"E38E 701C 3C78 1FF0 0FE0 0380 0000 0000"
+ $"0007 0007"
+};
+
+data 'CURS' (3065, "tcross") {
+ $"0100 0100 0100 0100 0100 0100 0100 FFFE"
+ $"0100 0100 0100 0100 0100 0100 0100 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0007 0007"
+};
+
+data 'CURS' (3066, "top_left_arrow") {
+ $"0000 6000 7800 3E00 3F80 1FE0 1E00 0D00"
+ $"0C80 0440 0420 0010 0008 0004 0000 0000"
+ $"E000 F800 FE00 7F80 7FE0 3FF8 3FFE 1F80"
+ $"1FC0 0EE0 0E70 0638 061C 020E 0204 0000"
+ $"0001 0001"
+};
+
+data 'CURS' (3067, "top_left_corner") {
+ $"FFF0 FFF0 C000 C000 CFC0 CC00 CA00 C900"
+ $"C880 C840 C020 C000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0FC0 0C00 0A00 0900"
+ $"0880 0840 0020 0000 0000 0000 0000 0000"
+ $"0000 0000"
+};
+
+data 'CURS' (3068, "top_right_corner") {
+ $"0FFF 0FFF 0003 0003 03F3 0033 0053 0093"
+ $"0113 0213 0403 0003 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 03F0 0030 0050 0090"
+ $"0110 0210 0400 0000 0000 0000 0000 0000"
+ $"0000 000F"
+};
+
+data 'CURS' (3069, "top_side") {
+ $"0000 7FFC 7FFC 0000 0100 0380 0540 0920"
+ $"1110 0100 0100 0100 0100 0100 0000 0000"
+ $"0000 0000 0000 0000 0100 0380 0540 0920"
+ $"1110 0100 0100 0100 0100 0100 0000 0000"
+ $"0004 0007"
+};
+
+data 'CURS' (3070, "top_tee") {
+ $"0000 0000 0000 0000 7FFE 7FFE 0180 0180"
+ $"0180 0180 0180 0180 0180 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0004 0007"
+};
+
+data 'CURS' (3071, "trek") {
+ $"0100 0000 0380 07C0 0FE0 0EE0 0FE0 07C0"
+ $"0380 0100 0BA0 0D60 0920 0820 0820 0000"
+ $"0000 0380 07C0 0FE0 1FF0 1FF0 1FF0 0FE0"
+ $"07C0 0BA0 1FF0 1FF0 1FF0 1D70 1C70 0820"
+ $"0000 0007"
+};
+
+data 'CURS' (3072, "ul_angle") {
+ $"0000 0000 0000 0FF8 0FF8 0C00 0C00 0C00"
+ $"0C00 0C00 0C00 0C00 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0003 0004"
+};
+
+data 'CURS' (3073, "umbrella") {
+ $"0000 0890 0228 49A6 27C8 1930 610C 0100"
+ $"0100 0100 0100 0100 0140 0140 0080 0000"
+ $"0000 0FF0 1FF8 7FFE 7FFC FFFE FBBE E38E"
+ $"0380 0380 0380 03C0 03E0 03E0 01C0 0080"
+ $"0004 0007"
+};
+
+data 'CURS' (3074, "ur_angle") {
+ $"0000 0000 0000 0000 1FF0 1FF0 0030 0030"
+ $"0030 0030 0030 0030 0030 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0004 000B"
+};
+
+data 'CURS' (3075, "watch") {
+ $"07E0 07E0 07E0 07E0 0810 1088 1088 108C"
+ $"138C 1008 1008 0810 07E0 07E0 07E0 07E0"
+ $"07E0 07E0 07E0 07E0 0FF0 1FF8 1FF8 1FFC"
+ $"1FFC 1FF8 1FF8 0FF0 07E0 07E0 07E0 07E0"
+ $"0008 000D"
+};
+
+data 'CURS' (3076, "xterm") {
+ $"0C60 0280 0100 0100 0100 0100 0100 0100"
+ $"0100 0100 0100 0100 0100 0100 0280 0C60"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"000B 0007"
+};
+
+/*
+ * The following are color versions of some of the
+ * cursors defined above. The color cursors will be
+ * used if the exist in preference to the black & white
+ * cursors.
+ */
+
+data 'crsr' (3004, "boat", purgeable) {
+ $"8001 0000 0060 0000 0092 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0100 03C0"
+ $"8460 FFFF 0018 0020 0040 FFC0 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0100 03C0"
+ $"87E0 FFFF FFF8 FFE0 FFC0 FFC0 0000 0000"
+ $"0000 0000 0007 000F 0000 0000 0000 0000"
+ $"0000 0000 8008 0000 0000 0010 0010 0000"
+ $"0000 0000 0000 0048 0000 0048 0000 0000"
+ $"0004 0001 0004 0000 0000 0000 0112 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 000F 0000 0000 0000 00FF FF00"
+ $"0000 F000 0F32 25F0 0000 6FFF FFFF FFFF"
+ $"FFFF 2222 2222 221F F000 2222 2222 21F0"
+ $"0000 3333 3333 4F00 0000 FFFF FFFF FF00"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0007 0000 FFFF FFFF"
+ $"FFFF 0001 BBBB BBBB BBBB 0002 EEEE EEEE"
+ $"EEEE 0003 DDDD DDDD DDDD 0004 CCCC CCCC"
+ $"CCCC 0005 4444 4444 4444 0006 1111 1111"
+ $"1111 000F 0000 0000 0000"
+};
+
+data 'crsr' (3013, "clock") {
+ $"8001 0000 0060 0000 0092 0000 0000 0000"
+ $"0000 0000 1FF8 33CC 6466 4992 4F12 4422"
+ $"63C6 3FFC 2994 2994 2994 2BD4 6996 781E"
+ $"7FFE 7FFE 1FF8 3FFC 7FFE 7FFE 7FFE 7FFE"
+ $"7FFE 3FFC 3FFC 3FFC 3FFC 3FFC 7FFE 7FFE"
+ $"7FFE 7FFE 0004 0008 0000 0000 0000 0000"
+ $"0000 0000 8008 0000 0000 0010 0010 0000"
+ $"0000 0000 0000 0048 0000 0048 0000 0000"
+ $"0004 0001 0004 0000 0000 0000 0112 0000"
+ $"0000 000F FFFF FFFF F000 00F6 05FF FF50"
+ $"6F00 0F60 5F00 56F5 06F0 0F00 F021 F30F"
+ $"00F0 0F00 F6F1 000F 00F0 0F00 5F00 00F5"
+ $"00F0 0F60 05FF FF50 06F0 00FF FFFF FFFF"
+ $"FF00 00F0 F001 100F 0F00 00F0 F001 100F"
+ $"0F00 00F0 F021 120F 0F00 00F0 F01F F10F"
+ $"0F00 0FF0 F021 120F 0FF0 0FF4 F500 005F"
+ $"4FF0 0FFF FFFF FFFF FFF0 0FFF FFFF FFFF"
+ $"FFF0 0000 0000 0000 0007 0000 FFFF FFFF"
+ $"FFFF 0001 4444 4444 4444 0002 AAAA AAAA"
+ $"AAAA 0003 EEEE EEEE EEEE 0004 5555 5555"
+ $"5555 0005 DDDD DDDD DDDD 0006 7777 7777"
+ $"7777 000F 0000 0000 0000"
+};
+
+data 'crsr' (3014, "coffee_mug") {
+ $"8001 0000 0060 0000 0092 0000 0000 0000"
+ $"0000 0000 03F8 0C06 1001 1C07 33F9 7001"
+ $"D001 9001 960D DA55 7A55 36ED 10A1 1001"
+ $"0802 07FC 03F8 0FFE 1FFF 1FFF 3FFF 7FFF"
+ $"FFFF FFFF FFFF FFFF 7FFF 3FFF 1FFF 1FFF"
+ $"0FFE 07FC 0004 0003 0000 0000 0000 0000"
+ $"0000 0000 8008 0000 0000 0010 0010 0000"
+ $"0000 0000 0000 0048 0000 0048 0000 0000"
+ $"0004 0001 0004 0000 0000 0000 0112 0000"
+ $"0000 0000 00FF FFFF F000 0000 FF42 2222"
+ $"4FF0 000F 4221 1111 224F 000F FF11 1111"
+ $"1FFF 00FF 24FF FFFF F42F 0F5F 2222 2222"
+ $"222F F52F 2222 2222 222F F40F 2222 2222"
+ $"222F F40F 4FF2 2224 FF2F F52F F2F2 2F2F"
+ $"2F2F 0F5F F2F2 535F 2F2F 00FF 4FF2 F3F4"
+ $"FF2F 000F 2222 F2F2 222F 000F 4222 2222"
+ $"224F 0000 F422 2222 24F0 0000 0FFF FFFF"
+ $"FF00 0000 0000 0000 0006 0000 FFFF FFFF"
+ $"FFFF 0001 CCCC 9999 6666 0002 CCCC CCCC"
+ $"FFFF 0003 3333 3333 6666 0004 9999 9999"
+ $"FFFF 0005 6666 6666 CCCC 000F 0000 0000"
+ $"0000"
+};
+
+data 'crsr' (3027, "gobbler") {
+ $"8001 0000 0060 0000 0092 0000 0000 0000"
+ $"0000 0000 0000 0078 0070 4036 4FB0 7FF0"
+ $"7E30 7C30 3038 00F0 0FE0 0400 0400 0400"
+ $"0F00 0000 00FC 00FC E0FF FFFF FFFF FFF8"
+ $"FFF8 FFF8 FFFC 7FFC 3FF8 1FF0 0E00 1F80"
+ $"1F80 1F80 0003 000E 0000 0000 0000 0000"
+ $"0000 0000 8008 0000 0000 0010 0010 0000"
+ $"0000 0000 0000 0048 0000 0048 0000 0000"
+ $"0004 0001 0004 0000 0000 0000 0112 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 0222"
+ $"2000 0000 0000 0111 0000 0300 0000 0011"
+ $"0220 0100 1616 1011 0000 0361 6111 1111"
+ $"0000 0111 1114 4415 0000 0311 1144 4451"
+ $"0000 0011 4444 4415 1000 0004 4444 5151"
+ $"0000 0000 1515 1510 0000 0000 0200 0000"
+ $"0000 0000 0300 0000 0000 0000 0200 0000"
+ $"0000 0000 2323 0000 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0006 0000 FFFF FFFF"
+ $"FFFF 0001 CCCC 9999 6666 0002 DDDD 0000"
+ $"0000 0003 FFFF 6666 3333 0004 CCCC CCCC"
+ $"CCCC 0005 8888 8888 8888 0006 FFFF CCCC"
+ $"9999"
+};
+
+data 'crsr' (3028, "gumby") {
+ $"8001 0000 0060 0000 0092 0000 0000 0000"
+ $"0000 0000 3F00 10C0 C820 EAA0 C820 CBA0"
+ $"F838 383E 0826 0826 092E 0926 0920 1110"
+ $"2108 3EF8 3F00 1FC0 CFE0 EFE0 CFE0 CFE0"
+ $"FFF8 3FFE 0FE6 0FE6 0FEE 0FE6 0FE0 1FF0"
+ $"3FF8 3EF8 0000 0002 0000 0000 0000 0000"
+ $"0000 0000 8008 0000 0000 0010 0010 0000"
+ $"0000 0000 0000 0048 0000 0048 0000 0000"
+ $"0004 0001 0004 0000 0000 0000 0112 0000"
+ $"0000 00FF FFFF 0000 0000 000F 1212 FF00"
+ $"0000 FF00 F131 31F0 0000 FFF0 F3F3 F3F0"
+ $"0000 FF00 F131 31F0 0000 FF00 F2FF F2F0"
+ $"0000 4FFF F121 21FF F000 00FF F212 12FF"
+ $"FF40 0000 F121 21F0 0FF0 0000 F212 12F0"
+ $"0FF0 0000 F12F 21F0 FFF0 0000 F21F 12F0"
+ $"0FF0 0000 F12F 21F0 0000 000F 121F 121F"
+ $"0000 00F1 212F 2121 F000 00FF FFF0 FFFF"
+ $"F000 0000 0000 0000 0005 0000 FFFF FFFF"
+ $"FFFF 0001 0000 BBBB 0000 0002 CCCC CCCC"
+ $"CCCC 0003 AAAA AAAA AAAA 0004 4444 4444"
+ $"4444 000F 0000 0000 0000"
+};
+
+data 'crsr' (3031, "heart") {
+ $"8001 0000 0060 0000 0092 0000 0000 0000"
+ $"0000 0000 0000 3EF8 638C C106 8002 8002"
+ $"8002 8002 C006 600C 3018 1830 0C60 06C0"
+ $"0380 0000 0000 3EF8 7FFC FFFE FFFE FFFE"
+ $"FFFE FFFE FFFE 7FFC 3FF8 1FF0 0FE0 07C0"
+ $"0380 0000 0003 0007 0000 0000 0000 0000"
+ $"0000 0000 8004 0000 0000 0010 0010 0000"
+ $"0000 0000 0000 0048 0000 0048 0000 0000"
+ $"0002 0001 0002 0000 0000 0000 00D2 0000"
+ $"0000 0000 0000 0FFC FFC0 3AAB AA70 E99B"
+ $"999C E665 A65C E999 999C E666 665C E999"
+ $"999C D666 665C 3599 9970 0D66 65C0 0359"
+ $"9700 00D6 5C00 0035 7000 000F C000 0000"
+ $"0000 0000 0000 0000 0003 0000 FFFF FFFF"
+ $"FFFF 0001 DDDD 0000 0000 0002 FFFF 6666"
+ $"CCCC 0003 0000 0000 0000"
+};
+
+data 'crsr' (3042, "mouse", purgeable) {
+ $"8001 0000 0060 0000 0092 0000 0000 0000"
+ $"0000 0000 BE00 0100 0180 0FF0 1008 17E8"
+ $"1428 1428 17E8 1008 1008 1008 1008 1008"
+ $"1008 0FF0 FE00 0100 0180 0FF0 1FF8 1FF8"
+ $"1FF8 1FF8 1FF8 1FF8 1FF8 1FF8 1FF8 1FF8"
+ $"1FF8 0FF0 0001 0007 0000 0000 0000 0000"
+ $"0000 0000 8008 0000 0000 0010 0010 0000"
+ $"0000 0000 0000 0048 0000 0048 0000 0000"
+ $"0004 0001 0004 0000 0000 0000 0112 0000"
+ $"0000 1379 4AF0 0000 0000 0000 000F 0000"
+ $"0000 0000 000F F000 0000 0000 FFFF FFFF"
+ $"0000 000F 2111 1112 F000 000F 3655 5563"
+ $"F000 000F 3513 1351 F000 000F 3533 3351"
+ $"F000 000F 3655 5561 F000 000F 3311 1111"
+ $"F000 000F 3333 3333 F000 000F 3333 3333"
+ $"F000 000F 2222 2222 F000 000F 8888 8888"
+ $"F000 000F 7888 8887 F000 0000 FFFF FFFF"
+ $"0000 0000 0000 0000 000B 0000 FFFF FFFF"
+ $"FFFF 0001 EEEE EEEE EEEE 0002 CCCC CCCC"
+ $"CCCC 0003 DDDD DDDD DDDD 0004 4444 4444"
+ $"4444 0005 2222 2222 2222 0006 5555 5555"
+ $"5555 0007 AAAA AAAA AAAA 0008 BBBB BBBB"
+ $"BBBB 0009 7777 7777 7777 000A 1111 1111"
+ $"1111 000F 0000 0000 0000"
+};
+
+data 'crsr' (3043, "pencil", purgeable) {
+ $"8001 0000 0060 0000 0092 0000 0000 0000"
+ $"0000 0000 0000 00F0 0088 0108 0190 0270"
+ $"0220 0440 0440 0880 0880 1100 1E00 1C00"
+ $"1800 1000 0000 00F0 00F8 01F8 01F0 03F0"
+ $"03E0 07C0 07C0 0F80 0F80 1F00 1E00 1C00"
+ $"1800 1000 000F 0003 0000 0000 0000 0000"
+ $"0000 0000 8008 0000 0000 0010 0010 0000"
+ $"0000 0000 0000 0048 0000 0048 0000 0000"
+ $"0004 0001 0004 0000 0000 0000 0112 0000"
+ $"0000 0000 0000 0000 0000 0000 0000 FFFF"
+ $"0000 0000 0000 F404 F000 0000 000F 4042"
+ $"F000 0000 000F F42F 0000 0000 00F5 3FFF"
+ $"0000 0000 00F3 52F0 0000 0000 0F35 1F00"
+ $"0000 0000 0F53 2F00 0000 0000 F532 F000"
+ $"0000 0000 F312 F000 0000 000F 352F 0000"
+ $"0000 000F FFF0 0000 0000 000F FF00 0000"
+ $"0000 000F F000 0000 0000 000F 0000 0000"
+ $"0000 0000 0000 0000 0006 0000 FFFF FFFF"
+ $"FFFF 0001 CCCC CCCC CCCC 0002 8888 8888"
+ $"8888 0003 FFFF FFFF 0000 0004 DDDD 0000"
+ $"0000 0005 FFFF 6666 3333 000F 0000 0000"
+ $"0000"
+};
+
+data 'crsr' (3059, "shuttle") {
+ $"8001 0000 0060 0000 0092 0000 0000 0000"
+ $"0000 0000 0020 0070 00F8 01DE 05DE 09DE"
+ $"11DE 11DE 11DE 11DE 31DE 71DE FDDE 1888"
+ $"0078 0030 0020 0070 00F8 01FE 07FE 0FFE"
+ $"1FFE 1FFE 1FFE 1FFE 3FFE 7FFE FFFE 18F8"
+ $"0078 0030 0000 000A 0000 0000 0000 0000"
+ $"0000 0000 8008 0000 0000 0010 0010 0000"
+ $"0000 0000 0000 0048 0000 0048 0000 0000"
+ $"0004 0001 0004 0000 0000 0000 0112 0000"
+ $"0000 0000 0000 00F0 0000 0000 0000 0F3F"
+ $"0000 0000 0000 F343 F000 0000 000F 3404"
+ $"3FF0 0000 0F4F 3404 3FF0 0000 F55F 3404"
+ $"3FF0 000F 505F 3404 3FF0 000F 005F 3404"
+ $"3FF0 000F 005F 3404 3FF0 000F 005F 3404"
+ $"3FF0 00F3 005F 3404 3FF0 0F33 505F 3404"
+ $"3FF0 FFF3 3F4F 3404 3FF0 000F F000 1222"
+ $"1000 0000 0000 0111 1000 0000 0000 0011"
+ $"0000 0000 0000 0000 0006 0000 FFFF FFFF"
+ $"FFFF 0001 FFFF 6666 3333 0002 DDDD 0000"
+ $"0000 0003 4444 4444 4444 0004 8888 8888"
+ $"8888 0005 DDDD DDDD DDDD 000F 0000 0000"
+ $"0000"
+};
+
+data 'crsr' (3062, "spraycan") {
+ $"8001 0000 0060 0000 0092 0000 0000 0000"
+ $"0000 0000 0018 0040 0D18 1E40 1A18 3F00"
+ $"2100 3900 2900 3900 2900 3900 3900 2100"
+ $"2100 3F00 0000 0000 0C00 1E00 1E00 3F00"
+ $"3F00 3F00 3F00 3F00 3F00 3F00 3F00 3F00"
+ $"3F00 3F00 0002 0007 0000 0000 0000 0000"
+ $"0000 0000 8008 0000 0000 0010 0010 0000"
+ $"0000 0000 0000 0048 0000 0048 0000 0000"
+ $"0004 0001 0004 0000 0000 0000 0112 0000"
+ $"0000 0000 0000 0005 2000 0000 0000 0460"
+ $"0000 0000 FF1F 6005 2000 000F 33F0 0460"
+ $"0000 000F 10F0 0005 2000 00FF FFFF 0000"
+ $"0000 00F8 170F 0000 0000 00F5 F70F 0000"
+ $"0000 00FA F70F 0000 0000 00F9 F70F 0000"
+ $"0000 00FA F70F 0000 0000 00F9 F70F 0000"
+ $"0000 00F5 F70F 0000 0000 00F8 170F 0000"
+ $"0000 00F8 170F 0000 0000 00FF FFFF 0000"
+ $"0000 0000 0000 0000 000B 0000 FFFF FFFF"
+ $"FFFF 0001 AAAA AAAA AAAA 0002 7777 7777"
+ $"7777 0003 5555 5555 5555 0004 2222 2222"
+ $"2222 0005 4444 4444 4444 0006 BBBB BBBB"
+ $"BBBB 0007 DDDD DDDD DDDD 0008 EEEE EEEE"
+ $"EEEE 0009 6666 6666 CCCC 000A CCCC CCCC"
+ $"FFFF 000F 0000 0000 0000"
+};
+
+data 'crsr' (3063, "star") {
+ $"8001 0000 0060 0000 0092 0000 0000 0000"
+ $"0000 0000 0100 0280 0280 0280 0440 0440"
+ $"0440 3938 C006 3838 0920 1290 2448 2828"
+ $"3018 2008 0100 0380 0380 0380 07C0 07C0"
+ $"07C0 3FF8 FFFE 3FF8 0FE0 1EF0 3C78 3838"
+ $"3018 2008 0007 0007 0000 0000 0000 0000"
+ $"0000 0000 8004 0000 0000 0010 0010 0000"
+ $"0000 0000 0000 0048 0000 0048 0000 0000"
+ $"0002 0001 0002 0000 0000 0000 00D2 0000"
+ $"0000 0003 0000 000D C000 000D C000 000D"
+ $"C000 0035 7000 0035 7000 0035 7000 0FD7"
+ $"5FC0 F555 557C 0FD5 5FC0 00D7 5C00 035C"
+ $"D700 0D70 35C0 0DC0 0DC0 0F00 03C0 0C00"
+ $"00C0 0000 0000 0000 0002 0000 FFFF FFFF"
+ $"FFFF 0001 FFFF FFFF 0000 0003 0000 0000"
+ $"0000"
+};
+
+data 'crsr' (3071, "trek") {
+ $"8001 0000 0060 0000 0092 0000 0000 0000"
+ $"0000 0000 0100 0000 0380 07C0 0FE0 0EE0"
+ $"0FE0 07C0 0380 0100 0BA0 0D60 0920 0820"
+ $"0820 0000 0000 0380 07C0 0FE0 1FF0 1FF0"
+ $"1FF0 0FE0 07C0 0BA0 1FF0 1FF0 1FF0 1D70"
+ $"1C70 0820 0000 0007 0000 0000 0000 0000"
+ $"0000 0000 8008 0000 0000 0010 0010 0000"
+ $"0000 0000 0000 0048 0000 0048 0000 0000"
+ $"0004 0001 0004 0000 0000 0000 0112 0000"
+ $"0000 0000 0005 0000 0000 0000 0005 0000"
+ $"0000 0000 00FF F000 0000 0000 0F31 3F00"
+ $"0000 0000 F322 23F0 0000 0000 F110 11F0"
+ $"0000 0000 F311 13F0 0000 0000 0F31 3F00"
+ $"0000 0000 00FF F000 0000 0000 000F 0000"
+ $"0000 0000 F0FF F0F0 0000 0000 FF0F 0FF0"
+ $"0000 0000 400F 0040 0000 0000 4000 0040"
+ $"0000 0000 4000 0040 0000 0000 0000 0000"
+ $"0000 0000 0000 0000 0006 0000 FFFF FFFF"
+ $"FFFF 0001 EEEE EEEE EEEE 0002 9999 9999"
+ $"FFFF 0003 DDDD DDDD DDDD 0004 3333 3333"
+ $"6666 0005 DDDD 0000 0000 000F 0000 0000"
+ $"0000"
+};
+
+data 'crsr' (3075, "watch", purgeable) {
+ $"8001 0000 0060 0000 0092 0000 0000 0000"
+ $"0000 0000 07E0 07E0 07E0 07E0 0810 1088"
+ $"1088 108C 138C 1008 1008 0810 07E0 07E0"
+ $"07E0 07E0 07E0 07E0 07E0 07E0 0FF0 1FF8"
+ $"1FF8 1FF8 1FF8 1FF8 1FF8 0FF0 07E0 07E0"
+ $"07E0 07E0 0008 000D 0000 0000 0000 0000"
+ $"0000 0000 8008 0000 0000 0010 0010 0000"
+ $"0000 0000 0000 0048 0000 0048 0000 0000"
+ $"0004 0001 0004 0000 0000 0000 0112 0000"
+ $"0000 0000 0FFF FFF0 0000 0000 0FFF FFF0"
+ $"0000 0000 0FFF FFF0 0000 0000 0FFF FFF0"
+ $"0000 0000 F020 202F 0000 000F 0222 F221"
+ $"F000 000F 2222 F123 F000 000F 0222 F121"
+ $"FF00 000F 22FF F123 FF00 000F 0222 2221"
+ $"F000 000F 2222 2213 F000 0000 F131 313F"
+ $"0000 0000 0FFF FFF0 0000 0000 0FFF FFF0"
+ $"0000 0000 0FFF FFF0 0000 0000 0FFF FFF0"
+ $"0000 0000 0000 0000 0004 0000 FFFF FFFF"
+ $"FFFF 0001 CCCC CCCC CCCC 0002 EEEE EEEE"
+ $"EEEE 0003 BBBB BBBB BBBB 000F 0000 0000"
+ $"0000"
+};
+
diff --git a/tk/mac/tkMacXStubs.c b/tk/mac/tkMacXStubs.c
new file mode 100644
index 00000000000..96f53547658
--- /dev/null
+++ b/tk/mac/tkMacXStubs.c
@@ -0,0 +1,709 @@
+/*
+ * 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$
+ */
+
+#include "tkInt.h"
+#include <X.h>
+#include <Xlib.h>
+#include <stdio.h>
+#include <tcl.h>
+
+#include <Xatom.h>
+
+#include <Windows.h>
+#include <Fonts.h>
+#include <QDOffscreen.h>
+#include <ToolUtils.h>
+#include <Sound.h>
+#include "tkMacInt.h"
+
+/*
+ * Because this file is still under major development Debugger statements are
+ * used through out this file. The define TCL_DEBUG will decide whether
+ * the debugger statements actually call the debugger or not.
+ */
+
+#ifndef TCL_DEBUG
+# define Debugger()
+#endif
+
+#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));
+static int DefaultErrorHandler _ANSI_ARGS_((Display* display,
+ XErrorEvent* err_evt));
+
+/*
+ * Other declrations
+ */
+
+int TkMacXDestroyImage _ANSI_ARGS_((XImage *image));
+unsigned long TkMacXGetPixel _ANSI_ARGS_((XImage *image, int x, int y));
+int TkMacXPutPixel _ANSI_ARGS_((XImage *image, int x, int y,
+ unsigned long pixel));
+XImage *TkMacXSubImage _ANSI_ARGS_((XImage *image, int x, int y,
+ unsigned int width, unsigned int height));
+int TkMacXAddPixel _ANSI_ARGS_((XImage *image, long value));
+int _XInitImageFuncPtrs _ANSI_ARGS_((XImage *image));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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(
+ char *display_name)
+{
+ Display *display;
+ Screen *screen;
+ GDHandle graphicsDevice;
+
+ if (gMacDisplay != NULL) {
+ if (strcmp(gMacDisplay->display->display_name, display_name) == 0) {
+ return gMacDisplay;
+ } else {
+ return NULL;
+ }
+ }
+
+ graphicsDevice = GetMainDevice();
+ display = (Display *) ckalloc(sizeof(Display));
+ display->resource_alloc = MacXIdAlloc;
+ screen = (Screen *) ckalloc(sizeof(Screen) * 2);
+ display->default_screen = 0;
+ display->request = 0;
+ display->nscreens = 1;
+ display->screens = screen;
+ display->display_name = macScreenName;
+ display->qlen = 0;
+
+ screen->root = ROOT_ID;
+ screen->display = display;
+ screen->root_depth = (*(*graphicsDevice)->gdPMap)->cmpSize *
+ (*(*graphicsDevice)->gdPMap)->cmpCount;
+ screen->height = (*graphicsDevice)->gdRect.bottom -
+ (*graphicsDevice)->gdRect.top;
+ screen->width = (*graphicsDevice)->gdRect.right -
+ (*graphicsDevice)->gdRect.left;
+
+ screen->mwidth = (screen->width * 254 + 360) / 720;
+ screen->mheight = (screen->height * 254 + 360) / 720;
+ screen->black_pixel = 0x00000000;
+ screen->white_pixel = 0x00FFFFFF;
+ screen->root_visual = (Visual *) ckalloc(sizeof(Visual));
+ screen->root_visual->visualid = 0;
+ screen->root_visual->class = TrueColor;
+ screen->root_visual->red_mask = 0x00FF0000;
+ screen->root_visual->green_mask = 0x0000FF00;
+ screen->root_visual->blue_mask = 0x000000FF;
+ screen->root_visual->bits_per_rgb = 24;
+ screen->root_visual->map_entries = 2 ^ 8;
+
+ gMacDisplay = (TkDisplay *) ckalloc(sizeof(TkDisplay));
+ gMacDisplay->display = display;
+ return gMacDisplay;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCloseDisplay --
+ *
+ * Deallocates a display structure created by TkpOpenDisplay.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpCloseDisplay(
+ TkDisplay *displayPtr)
+{
+ Display *display = displayPtr->display;
+ if (gMacDisplay != displayPtr) {
+ panic("TkpCloseDisplay: tried to call TkpCloseDisplay on bad display");
+ }
+
+ /*
+ * Make sure that the local scrap is transfered to the global
+ * scrap if needed.
+ */
+
+ TkSuspendClipboard();
+
+ gMacDisplay = NULL;
+ if (display->screens != (Screen *) NULL) {
+ if (display->screens->root_visual != (Visual *) NULL) {
+ ckfree((char *) display->screens->root_visual);
+ }
+ ckfree((char *) display->screens);
+ }
+ ckfree((char *) display);
+ ckfree((char *) displayPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MacXIdAlloc --
+ *
+ * This procedure is invoked by Xlib as the resource allocator
+ * for a display.
+ *
+ * Results:
+ * The return value is an X resource identifier that isn't currently
+ * in use.
+ *
+ * Side effects:
+ * The identifier is removed from the stack of free identifiers,
+ * if it was previously on the stack.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static XID
+MacXIdAlloc(
+ Display *display) /* Display for which to allocate. */
+{
+ static long int cur_id = 100;
+ /*
+ * Some special XIds are reserved
+ * - this is why we start at 100
+ */
+
+ return ++cur_id;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpWindowWasRecentlyDeleted --
+ *
+ * Tries to determine whether the given window was recently deleted.
+ * Called from the generic code error handler to attempt to deal with
+ * async BadWindow errors under some circumstances.
+ *
+ * Results:
+ * Always 0, we do not keep this information on the Mac, so we do not
+ * know whether the window was destroyed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpWindowWasRecentlyDeleted(
+ Window win,
+ TkDisplay *dispPtr)
+{
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DefaultErrorHandler --
+ *
+ * This procedure is the default X error handler. Tk uses it's
+ * own error handler so this call should never be called.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * This function will call panic and exit.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+DefaultErrorHandler(
+ Display* display,
+ XErrorEvent* err_evt)
+{
+ /*
+ * This call should never be called. Tk replaces
+ * it with its own error handler.
+ */
+ panic("Warning hit bogus error handler!");
+ return 0;
+}
+
+
+char *
+XGetAtomName(
+ Display * display,
+ Atom atom)
+{
+ display->request++;
+ return NULL;
+}
+
+int
+_XInitImageFuncPtrs(XImage *image)
+{
+ return 0;
+}
+
+XErrorHandler
+XSetErrorHandler(
+ XErrorHandler handler)
+{
+ return DefaultErrorHandler;
+}
+
+Window
+XRootWindow(Display *display, int screen_number)
+{
+ display->request++;
+ return ROOT_ID;
+}
+
+XImage *
+XGetImage(display, d, x, y, width, height, plane_mask, format)
+ Display *display;
+ Drawable d;
+ int x;
+ int y;
+ unsigned int width;
+ unsigned int height;
+ unsigned long plane_mask;
+ int format;
+{
+ Debugger();
+ return NULL;
+}
+
+int
+XGetGeometry(display, d, root_return, x_return, y_return, width_return,
+ height_return, border_width_return, depth_return)
+ 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;
+{
+ /* Used in tkCanvPs.c & wm code */
+ Debugger();
+ return 0;
+}
+
+void
+XChangeProperty(
+ Display* display,
+ Window w,
+ Atom property,
+ Atom type,
+ int format,
+ int mode,
+ _Xconst unsigned char* data,
+ int nelements)
+{
+ Debugger();
+}
+
+void
+XSelectInput(
+ Display* display,
+ Window w,
+ long event_mask)
+{
+ Debugger();
+}
+
+void
+XBell(
+ Display* display,
+ int percent)
+{
+ SysBeep(percent);
+}
+
+void
+XSetWMNormalHints(
+ Display* display,
+ Window w,
+ XSizeHints* hints)
+{
+ /*
+ * Do nothing. Shouldn't even be called.
+ */
+}
+
+XSizeHints *
+XAllocSizeHints()
+{
+ /*
+ * Always return NULL. Tk code checks to see if NULL
+ * is returned & does nothing if it is.
+ */
+
+ return NULL;
+}
+
+XImage *
+XCreateImage(
+ 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)
+{
+ XImage *ximage;
+
+ display->request++;
+ ximage = (XImage *) ckalloc(sizeof(XImage));
+
+ ximage->height = height;
+ ximage->width = width;
+ ximage->depth = depth;
+ ximage->xoffset = offset;
+ ximage->format = format;
+ ximage->data = data;
+ ximage->bitmap_pad = bitmap_pad;
+ if (bytes_per_line == 0) {
+ ximage->bytes_per_line = width * 4; /* assuming 32 bits per pixel */
+ } else {
+ ximage->bytes_per_line = bytes_per_line;
+ }
+
+ if (format == ZPixmap) {
+ ximage->bits_per_pixel = 32;
+ ximage->bitmap_unit = 32;
+ } else {
+ ximage->bits_per_pixel = 1;
+ ximage->bitmap_unit = 8;
+ }
+ ximage->byte_order = LSBFirst;
+ ximage->bitmap_bit_order = LSBFirst;
+ ximage->red_mask = 0x00FF0000;
+ ximage->green_mask = 0x0000FF00;
+ ximage->blue_mask = 0x000000FF;
+
+ ximage->f.destroy_image = TkMacXDestroyImage;
+ ximage->f.get_pixel = TkMacXGetPixel;
+ ximage->f.put_pixel = TkMacXPutPixel;
+ ximage->f.sub_image = TkMacXSubImage;
+ ximage->f.add_pixel = TkMacXAddPixel;
+
+ return ximage;
+}
+
+GContext
+XGContextFromGC(
+ GC gc)
+{
+ /* TODO - currently a no-op */
+ return 0;
+}
+
+Status
+XSendEvent(
+ Display* display,
+ Window w,
+ Bool propagate,
+ long event_mask,
+ XEvent* event_send)
+{
+ Debugger();
+ return 0;
+}
+
+int
+XGetWindowProperty(
+ 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)
+{
+ display->request++;
+ *actual_type_return = None;
+ *actual_format_return = *bytes_after_return = 0;
+ *nitems_return = 0;
+ return 0;
+}
+
+void
+XRefreshKeyboardMapping()
+{
+ /* used by tkXEvent.c */
+ Debugger();
+}
+
+void
+XSetIconName(
+ Display* display,
+ Window w,
+ const char *icon_name)
+{
+ /*
+ * This is a no-op, no icon name for Macs.
+ */
+ display->request++;
+}
+
+void
+XForceScreenSaver(
+ Display* display,
+ int mode)
+{
+ /*
+ * 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
+ * the window server for that window. This procedure provides
+ * the guts of the "winfo server" command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+}
+/*
+ * Image stuff
+ */
+
+int
+TkMacXDestroyImage(
+ XImage *image)
+{
+ Debugger();
+ return 0;
+}
+
+unsigned long
+TkMacXGetPixel(
+ XImage *image,
+ int x,
+ int y)
+{
+ Debugger();
+ return 0;
+}
+
+int
+TkMacXPutPixel(
+ XImage *image,
+ int x,
+ int y,
+ unsigned long pixel)
+{
+ /* Debugger(); */
+ return 0;
+}
+
+XImage *
+TkMacXSubImage(
+ XImage *image,
+ int x,
+ int y,
+ unsigned int width,
+ unsigned int height)
+{
+ Debugger();
+ return NULL;
+}
+
+int
+TkMacXAddPixel(
+ XImage *image,
+ long value)
+{
+ Debugger();
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XChangeWindowAttributes, XSetWindowBackground,
+ * XSetWindowBackgroundPixmap, XSetWindowBorder, XSetWindowBorderPixmap,
+ * XSetWindowBorderWidth, XSetWindowColormap
+ *
+ * These functions are all no-ops. They all have equivilent
+ * Tk calls that should always be used instead.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XChangeWindowAttributes(
+ Display* display,
+ Window w,
+ unsigned long value_mask,
+ XSetWindowAttributes* attributes)
+{
+}
+
+void
+XSetWindowBackground(
+ Display *display,
+ Window window,
+ unsigned long value)
+{
+}
+
+void
+XSetWindowBackgroundPixmap(
+ Display* display,
+ Window w,
+ Pixmap background_pixmap)
+{
+}
+
+void
+XSetWindowBorder(
+ Display* display,
+ Window w,
+ unsigned long border_pixel)
+{
+}
+
+void
+XSetWindowBorderPixmap(
+ Display* display,
+ Window w,
+ Pixmap border_pixmap)
+{
+}
+
+void
+XSetWindowBorderWidth(
+ Display* display,
+ Window w,
+ unsigned int width)
+{
+}
+
+void
+XSetWindowColormap(
+ Display* display,
+ Window w,
+ Colormap colormap)
+{
+ Debugger();
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetDefaultScreenName --
+ *
+ * Returns the name of the screen that Tk should use during
+ * initialization.
+ *
+ * Results:
+ * Returns a statically allocated string.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkGetDefaultScreenName(
+ Tcl_Interp *interp, /* Not used. */
+ char *screenName) /* If NULL, use default string. */
+{
+ if ((screenName == NULL) || (screenName[0] == '\0')) {
+ screenName = macScreenName;
+ }
+ return screenName;
+}
diff --git a/tk/tests/README b/tk/tests/README
new file mode 100644
index 00000000000..d1f4d1a46ac
--- /dev/null
+++ b/tk/tests/README
@@ -0,0 +1,30 @@
+Tk Test Suite
+--------------
+
+RCS: @(#) $Id$
+
+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.
diff --git a/tk/tests/arc.tcl b/tk/tests/arc.tcl
new file mode 100644
index 00000000000..f164b4b9cb1
--- /dev/null
+++ b/tk/tests/arc.tcl
@@ -0,0 +1,140 @@
+# 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$
+
+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
+
+canvas .t.c -width 650 -height 600 -relief raised
+pack .t.c -expand yes -fill both
+button .t.quit -text Quit -command {destroy .t}
+pack .t.quit -side bottom -pady 3 -ipadx 4 -ipady 2
+
+puts "depth is [winfo depth .t]"
+if {[winfo depth .t] > 1} {
+ set fill1 aquamarine3
+ set fill2 aquamarine3
+ set fill3 IndianRed1
+ set outline2 IndianRed3
+} else {
+ set fill1 black
+ set fill2 white
+ set fill3 Black
+ set outline2 white
+}
+set outline black
+
+.t.c create arc 20 20 220 120 -start 30 -extent 270 -outline $fill1 -width 14 \
+ -style arc
+.t.c create arc 260 20 460 120 -start 30 -extent 270 -fill $fill2 -width 14 \
+ -style chord -outline $outline
+.t.c create arc 500 20 620 160 -start 30 -extent 270 -fill {} -width 14 \
+ -style chord -outline $outline -outlinestipple gray50
+.t.c create arc 20 260 140 460 -start 45 -extent 90 -fill $fill2 -width 14 \
+ -style pieslice -outline $outline
+.t.c create arc 180 260 300 460 -start 45 -extent 90 -fill {} -width 14 \
+ -style pieslice -outline $outline
+.t.c create arc 340 260 460 460 -start 30 -extent 150 -fill $fill2 -width 14 \
+ -style chord -outline $outline -stipple gray50 -outlinestipple gray25
+.t.c create arc 500 260 620 460 -start 30 -extent 150 -fill {} -width 14 \
+ -style chord -outline $outline
+.t.c create arc 20 450 140 570 -start 135 -extent 270 -fill $fill1 -width 14 \
+ -style pieslice -outline {}
+.t.c create arc 180 450 300 570 -start 30 -extent -90 -fill $fill1 -width 14 \
+ -style pieslice -outline {}
+.t.c create arc 340 450 460 570 -start 320 -extent 270 -fill $fill1 -width 14 \
+ -style chord -outline {}
+.t.c create arc 500 450 620 570 -start 350 -extent -110 -fill $fill1 -width 14 \
+ -style chord -outline {}
+.t.c addtag arc withtag all
+.t.c addtag circle withtag [.t.c create oval 320 200 340 220 -fill MistyRose3]
+
+.t.c bind arc <Any-Enter> {
+ set prevFill [lindex [.t.c itemconf current -fill] 4]
+ set prevOutline [lindex [.t.c itemconf current -outline] 4]
+ if {($prevFill != "") || ($prevOutline == "")} {
+ .t.c itemconf current -fill $fill3
+ }
+ if {$prevOutline != ""} {
+ .t.c itemconf current -outline $outline2
+ }
+}
+.t.c bind arc <Any-Leave> {.t.c itemconf current -fill $prevFill -outline $prevOutline}
+
+bind .t.c <1> {markarea %x %y}
+bind .t.c <B1-Motion> {strokearea %x %y}
+
+proc markarea {x y} {
+ global areaX1 areaY1
+ set areaX1 $x
+ set areaY1 $y
+}
+
+proc strokearea {x y} {
+ global areaX1 areaY1 areaX2 areaY2
+ if {($areaX1 != $x) && ($areaY1 != $y)} {
+ .t.c delete area
+ .t.c addtag area withtag [.t.c create rect $areaX1 $areaY1 $x $y \
+ -outline black]
+ set areaX2 $x
+ set areaY2 $y
+ }
+}
+
+bind .t.c <Control-f> {
+ puts stdout "Enclosed: [.t.c find enclosed $areaX1 $areaY1 $areaX2 $areaY2]"
+ puts stdout "Overlapping: [.t.c find overl $areaX1 $areaY1 $areaX2 $areaY2]"
+}
+
+bind .t.c <3> {puts stdout "%x %y"}
+
+# The code below allows the circle to be move by shift-dragging.
+
+bind .t.c <Shift-1> {
+ set curx %x
+ set cury %y
+}
+
+bind .t.c <Shift-B1-Motion> {
+ .t.c move circle [expr %x-$curx] [expr %y-$cury]
+ set curx %x
+ set cury %y
+}
+
+# The binding below flashes the closest item to the mouse.
+
+bind .t.c <Control-c> {
+ set closest [.t.c find closest %x %y]
+ set oldfill [lindex [.t.c itemconf $closest -fill] 4]
+ .t.c itemconf $closest -fill IndianRed1
+ after 200 [list .t.c itemconfig $closest -fill $oldfill]
+}
+
+proc c {option value} {.t.c itemconf 2 $option $value}
+
+bind .t.c a {
+ set go 1
+ set i 1
+ while {$go} {
+ if {$i >= 50} {
+ set delta -5
+ }
+ if {$i <= 5} {
+ set delta 5
+ }
+ incr i $delta
+ c -start $i
+ c -extent [expr 360-2*$i]
+ after 20
+ update
+ }
+}
+
+bind .t.c b {set go 0}
+
+bind .t.c <Control-x> {.t.c delete current}
diff --git a/tk/tests/bell.test b/tk/tests/bell.test
new file mode 100644
index 00000000000..4ea8983edfe
--- /dev/null
+++ b/tk/tests/bell.test
@@ -0,0 +1,37 @@
+# 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.
+# 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$
+
+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 {bad option "a": must be -displayof}}
+test bell-1.3 {bell command} {
+ list [catch {bell -displayof gorp} msg] $msg
+} {1 {bad window path name "gorp"}}
+test bell-1.4 {bell command} {
+ puts "Bell should ring now ..."
+ flush stdout
+ after 500
+ bell -displayof .
+ after 200
+ bell -dis .
+ after 200
+ bell
+ after 200
+ bell
+} {}
diff --git a/tk/tests/bevel.tcl b/tk/tests/bevel.tcl
new file mode 100644
index 00000000000..ea89b092565
--- /dev/null
+++ b/tk/tests/bevel.tcl
@@ -0,0 +1,128 @@
+# 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$
+
+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
+
+text .t.t -width 60 -height 30 -setgrid true -xscrollcommand {.t.h set} \
+ -font {Courier 12} \
+ -yscrollcommand {.t.v set} -wrap none -relief raised -bd 2
+scrollbar .t.v -orient vertical -command ".t.t yview"
+scrollbar .t.h -orient horizontal -command ".t.t xview"
+button .t.quit -text Quit -command {destroy .t}
+pack .t.quit -side bottom -pady 3 -ipadx 4 -ipady 2
+pack .t.h -side bottom -fill x
+pack .t.v -side right -fill y
+pack .t.t -expand yes -fill both
+wm minsize .t 1 1
+
+if {[winfo depth .t] > 1} {
+ .t.t tag configure r1 -relief raised -borderwidth 2 -background #b2dfee
+ .t.t tag configure r2 -relief raised -borderwidth 2 -background #b2dfee \
+ -offset 2
+ .t.t tag configure s1 -relief sunken -borderwidth 2 -background #b2dfee
+} else {
+ .t.t tag configure r1 -relief raised -borderwidth 2 -background white
+ .t.t tag configure r2 -relief raised -borderwidth 2 -background white \
+ -offset 2
+ .t.t tag configure s1 -relief sunken -borderwidth 2 -background white
+}
+.t.t tag configure indent1 -lmargin1 100
+.t.t tag configure indent2 -lmargin1 200
+
+.t.t insert end {This display contains a bunch of raised and sunken
+regions to exercise the bevel-drawing facilities of
+DisplayLineBackground. The letters have the following
+significance:
+
+r - should appear raised
+u - should appear raised and also slightly offset vertically
+s - should appear sunken
+n - preceding relief should extend right to end of line.
+* - should appear "normal"
+x - extra long lines to allow horizontal scrolling.
+
+Try scrolling the text both vertically and horizontally to
+be sure that the bevels are still drawn correctly.
+
+xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
+
+Pass 1 (side bevels):
+
+}
+.t.t insert end ****
+.t.t insert end rrrrrrr r1
+.t.t insert end uuuu r2
+.t.t insert end ************
+.t.t insert end ssssssssssssssssss s1
+.t.t insert end \n\n****************
+.t.t insert end rrrrrrrrrrrrrrn\n r1
+
+.t.t insert end "\nPass 2 (top bevels):\n\n"
+.t.t insert end rrrrrrrrrrrrrr r1
+.t.t insert end rrrrr {r1 dummy}
+.t.t insert end rrrrrrrrrrrrrrrrrrr r1
+.t.t insert end \n************
+.t.t insert end rrrrrrrrrrrrrrrrr r1
+.t.t insert end ***********\n
+.t.t insert end rrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrrr r1
+.t.t insert end \n\n***
+.t.t insert end rrrrrrrrrrrrrrrrrrr r1
+.t.t insert end ***********\n*
+.t.t insert end rrrrrrrrr r1
+.t.t insert end ********
+.t.t insert end rrrrrrrrrrrrrrrrrrrrrrrrr r1
+.t.t insert end \n\n*
+.t.t insert end *** dummy
+.t.t insert end rrrrrrrrrrrrrrrrrrrrrrrrr r1
+.t.t insert end n\nrrrrrrrrrrrrrrr {r1 indent1}
+.t.t insert end \n\n***
+.t.t insert end rrr r1
+.t.t insert end \n
+.t.t insert end rrrr {r1 indent1}
+
+.t.t insert end \n\nxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n\n
+.t.t insert end "Pass 3 (bottom bevels):\n\n"
+.t.t insert end *******
+.t.t insert end ********** dummy
+.t.t insert end rrrrrrrrrrrrrrrr r1
+.t.t insert end **********\n
+.t.t insert end rrrrrrrrr r1
+.t.t insert end uuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuuu r2
+.t.t insert end \n********************
+.t.t insert end rrrrrrrrrrrrrrr r1
+.t.t insert end ************\n\n*
+.t.t insert end rrrrrrrrrrrr r1
+.t.t insert end ********
+.t.t insert end rrrrrrrrrrrrrrrrrrrrrrrrr r1
+.t.t insert end \n*****
+.t.t insert end rrrrrrrrrrrrrrrrrrrr r1
+.t.t insert end **********\n\n
+.t.t insert end rrrrrrrrrrrrrrr {r1 indent1}
+.t.t insert end \n** dummy
+.t.t insert end **
+.t.t insert end rrrrrrrrrrrrrrrrrrrrn\n r1
+.t.t insert end \n
+.t.t insert end rrrr {r1 indent1}
+.t.t insert end \n***
+.t.t insert end rrr r1
+
+.t.t insert end \n\nMiscellaneous:\n\n
+.t.t insert end rrr r1
+.t.t insert end *****
+.t.t insert end rrr r1
+foreach i {1 2 3} {
+ .t.t insert end \n
+ .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
diff --git a/tk/tests/bgerror.test b/tk/tests/bgerror.test
new file mode 100644
index 00000000000..d98f2cac2a2
--- /dev/null
+++ b/tk/tests/bgerror.test
@@ -0,0 +1,59 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[info commands test] == ""} {
+ source defs
+}
+
+
+test bgerror-1.1 {bgerror / tkerror compat} {
+ set errRes {}
+ proc tkerror {err} {
+ global errRes;
+ set errRes $err;
+ }
+ after 0 {error err1}
+ vwait errRes;
+ set errRes;
+} err1
+
+test bgerror-1.2 {bgerror / tkerror compat / accumulation} {
+ set errRes {}
+ proc tkerror {err} {
+ global errRes;
+ lappend errRes $err;
+ }
+ after 0 {error err1}
+ after 0 {error err2}
+ after 0 {error err3}
+ update
+ set errRes;
+} {err1 err2 err3}
+
+test bgerror-1.3 {bgerror / tkerror compat / accumulation / break} {
+ set errRes {}
+ proc tkerror {err} {
+ global errRes;
+ lappend errRes $err;
+ return -code break "skip!";
+ }
+ after 0 {error err1}
+ after 0 {error err2}
+ after 0 {error err3}
+ update
+ set errRes;
+} err1
+
+catch {rename tkerror {}}
+
+# some testing of the default error dialog
+# would be needed too, but that's not easy at all
+# to emulate.
+
diff --git a/tk/tests/bind.test b/tk/tests/bind.test
new file mode 100644
index 00000000000..f03961e3506
--- /dev/null
+++ b/tk/tests/bind.test
@@ -0,0 +1,2559 @@
+# 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 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$
+
+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
+
+proc setup {} {
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ pack .b.f
+ focus -force .b.f
+ foreach p [event info] {event delete $p}
+ update
+}
+setup
+
+foreach i [bind Test] {
+ bind Test $i {}
+}
+foreach i [bind all] {
+ bind all $i {}
+}
+
+test bind-1.1 {bind command} {
+ list [catch {bind} msg] $msg
+} {1 {wrong # args: should be "bind window ?pattern? ?command?"}}
+test bind-1.2 {bind command} {
+ list [catch {bind a b c d} msg] $msg
+} {1 {wrong # args: should be "bind window ?pattern? ?command?"}}
+test bind-1.3 {bind command} {
+ list [catch {bind .gorp} msg] $msg
+} {1 {bad window path name ".gorp"}}
+test bind-1.4 {bind command} {
+ list [catch {bind foo} msg] $msg
+} {0 {}}
+test bind-1.5 {bind command} {
+ list [catch {bind .b <gorp-> {}} msg] $msg
+} {0 {}}
+test bind-1.6 {bind command} {
+ catch {destroy .b.f}
+ frame .b.f
+ bind .b.f <Enter> {test script}
+ set result [bind .b.f <Enter>]
+ bind .b.f <Enter> {}
+ list $result [bind .b.f <Enter>]
+} {{test script} {}}
+test bind-1.7 {bind command} {
+ catch {destroy .b.f}
+ frame .b.f
+ bind .b.f <Enter> {test script}
+ bind .b.f <Enter> {+more text}
+ bind .b.f <Enter>
+} {test script
+more text}
+test bind-1.8 {bind command} {
+ list [catch {bind .b <gorp-> {test script}} msg] $msg [bind .b]
+} {1 {bad event type or keysym "gorp"} {}}
+test bind-1.9 {bind command} {
+ list [catch {bind .b <gorp->} msg] $msg
+} {0 {}}
+test bind-1.10 {bind command} {
+ catch {destroy .b.f}
+ frame .b.f
+ bind .b.f <Enter> {script 1}
+ bind .b.f <Leave> {script 2}
+ bind .b.f a {script for a}
+ bind .b.f b {script for b}
+ lsort [bind .b.f]
+} {<Enter> <Leave> a b}
+
+test bind-2.1 {bindtags command} {
+ list [catch {bindtags} msg] $msg
+} {1 {wrong # args: should be "bindtags window ?tags?"}}
+test bind-2.2 {bindtags command} {
+ list [catch {bindtags a b c} msg] $msg
+} {1 {wrong # args: should be "bindtags window ?tags?"}}
+test bind-2.3 {bindtags command} {
+ list [catch {bindtags .foo} msg] $msg
+} {1 {bad window path name ".foo"}}
+test bind-2.4 {bindtags command} {
+ bindtags .b
+} {.b Toplevel all}
+test bind-2.5 {bindtags command} {
+ catch {destroy .b.f}
+ frame .b.f
+ bindtags .b.f
+} {.b.f Frame .b all}
+test bind-2.6 {bindtags command} {
+ catch {destroy .b.f}
+ frame .b.f
+ bindtags .b.f {{x y z} b c d}
+ bindtags .b.f
+} {{x y z} b c d}
+test bind-2.7 {bindtags command} {
+ catch {destroy .b.f}
+ frame .b.f
+ bindtags .b.f {x y z}
+ bindtags .b.f {}
+ bindtags .b.f
+} {.b.f Frame .b all}
+test bind-2.8 {bindtags command} {
+ catch {destroy .b.f}
+ frame .b.f
+ bindtags .b.f {x y z}
+ bindtags .b.f {a b c d}
+ bindtags .b.f
+} {a b c d}
+test bind-2.9 {bindtags command} {
+ catch {destroy .b.f}
+ frame .b.f
+ bindtags .b.f {a b c}
+ list [catch {bindtags .b.f "\{"} msg] $msg [bindtags .b.f]
+} {1 {unmatched open brace in list} {.b.f Frame .b all}}
+test bind-2.10 {bindtags command} {
+ catch {destroy .b.f}
+ frame .b.f
+ bindtags .b.f {a b c}
+ list [catch {bindtags .b.f "a .gorp b"} msg] $msg [bindtags .b.f]
+} {0 {} {a .gorp b}}
+test bind-3.1 {TkFreeBindingTags procedure} {
+ catch {destroy .b.f}
+ frame .b.f
+ bindtags .b.f "a b c d"
+ destroy .b.f
+} {}
+test bind-3.2 {TkFreeBindingTags procedure} {
+ catch {destroy .b.f}
+ frame .b.f
+ catch {bindtags .b.f "a .gorp b .b.f"}
+ destroy .b.f
+} {}
+
+bind all <Enter> {lappend x "%W enter all"}
+bind Test <Enter> {lappend x "%W enter frame"}
+bind Toplevel <Enter> {lappend x "%W enter toplevel"}
+bind xyz <Enter> {lappend x "%W enter xyz"}
+bind {a b} <Enter> {lappend x "%W enter {a b}"}
+bind .b <Enter> {lappend x "%W enter .b"}
+test bind-4.1 {TkBindEventProc procedure} {
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ pack .b.f
+ update
+ bind .b.f <Enter> {lappend x "%W enter .b.f"}
+ set x {}
+ event gen .b.f <Enter>
+ set x
+} {{.b.f enter .b.f} {.b.f enter frame} {.b.f enter .b} {.b.f enter all}}
+test bind-4.2 {TkBindEventProc procedure} {
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ pack .b.f
+ update
+ bind .b.f <Enter> {lappend x "%W enter .b.f"}
+ bindtags .b.f {.b.f {a b} xyz}
+ set x {}
+ event gen .b.f <Enter>
+ set x
+} {{.b.f enter .b.f} {.b.f enter {a b}} {.b.f enter xyz}}
+test bind-4.3 {TkBindEventProc procedure} {
+ set x {}
+ event gen .b <Enter>
+ set x
+} {{.b enter .b} {.b enter toplevel} {.b enter all}}
+test bind-4.4 {TkBindEventProc procedure} {
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ pack .b.f
+ update
+ bindtags .b.f {.b.f .b.f2 .b.f3}
+ frame .b.f3 -width 50 -height 50
+ pack .b.f3
+ bind .b.f <Enter> {lappend x "%W enter .b.f"}
+ bind .b.f3 <Enter> {lappend x "%W enter .b.f3"}
+ set x {}
+ event gen .b.f <Enter>
+ destroy .b.f3
+ set x
+} {{.b.f enter .b.f} {.b.f enter .b.f3}}
+test bind-4.5 {TkBindEventProc procedure} {
+ # This tests memory allocation for objPtr; it won't serve any useful
+ # purpose unless run with some sort of allocation checker turned on.
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ pack .b.f
+ update
+ bindtags .b.f {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}
+ event gen .b.f <Enter>
+} {}
+bind all <Enter> {}
+bind Test <Enter> {}
+bind Toplevel <Enter> {}
+bind xyz <Enter> {}
+bind {a b} <Enter> {}
+bind .b <Enter> {}
+
+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}
+ destroy .b.c
+} {}
+test bind-6.2 {Tk_DeleteBindTable procedure: pending bindings deleted later} {
+ catch {interp delete foo}
+ interp create foo
+ foo eval {
+ load {} Tk
+ load {} Tktest
+ wm geometry . +0+0
+ frame .t -width 50 -height 50
+ bindtags .t {a b c d}
+ pack .t
+ update
+ set x {}
+ testcbind a <1> "lappend x a1; destroy ." "lappend x bye.a1"
+ bind b <1> "lappend x b1"
+ testcbind c <1> "lappend x c1" "lappend x bye.c1"
+ testcbind c <2> "lappend x all2" "lappend x bye.all2"
+ 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
+ testcbind .b.f <1> "xyz" "lappend x bye.1"
+ set x {}
+ bind .b.f <1> "abc"
+ destroy .b.f
+ set x
+} {bye.1}
+test bind-7.3 {Tk_CreateBinding procedure: append} {
+ catch {destroy .b.c}
+ canvas .b.c
+ .b.c bind foo <1> "button 1"
+ .b.c bind foo <1> "+more button 1"
+ .b.c bind foo <1>
+} {button 1
+more button 1}
+test bind-7.4 {Tk_CreateBinding procedure: append to non-existing} {
+ catch {destroy .b.c}
+ canvas .b.c
+ .b.c bind foo <1> "+button 1"
+ .b.c bind foo <1>
+} {button 1}
+
+test bind-8.1 {TkCreateBindingProcedure: error} {
+ list [catch {testcbind . <xyz> "xyz"} msg] $msg
+} {1 {bad event type or keysym "xyz"}}
+test bind-8.2 {TkCreateBindingProcedure: new binding} {
+ catch {destroy .b.f}
+ frame .b.f
+ testcbind .b.f <1> "lappend x 1" "lappend x bye.1"
+ set x {}
+ event gen .b.f <1>
+ destroy .b.f
+ set x
+} {bye.1}
+test bind-8.3 {TkCreateBindingProcedure: replace existing} {
+ catch {destroy .b.f}
+ frame .b.f
+ pack .b.f
+ set x {}
+ testcbind .b.f <1> "lappend x old1" "lappend x bye.old1"
+ testcbind .b.f <1> "lappend x new1" "lappend x bye.new1"
+ set x
+} {bye.old1}
+test bind-8.4 {TkCreateBindingProcedure: replace existing while pending} {
+ catch {destroy .b.f}
+ frame .b.f
+ pack .b.f
+ update
+ testcbind .b.f <1> "lappend x .b.f; testcbind Frame <1> {lappend x Frame}"
+ testcbind Frame <1> "lappend x never"
+ set x {}
+ event gen .b.f <1>
+ bind .b.f <1> {}
+ set x
+} {.b.f Frame}
+
+test bind-9.1 {Tk_DeleteBinding procedure} {
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ list [catch {bind .b.f <} msg] $msg
+} {0 {}}
+test bind-9.2 {Tk_DeleteBinding procedure} {
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ foreach i {a b c d} {
+ bind .b.f $i "binding for $i"
+ }
+ set result {}
+ foreach i {b d a c} {
+ bind .b.f $i {}
+ lappend result [lsort [bind .b.f]]
+ }
+ set result
+} {{a c d} {a c} c {}}
+test bind-9.3 {Tk_DeleteBinding procedure} {
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ foreach i {<1> <Meta-1> <Control-1> <Double-Alt-1>} {
+ bind .b.f $i "binding for $i"
+ }
+ set result {}
+ foreach i {<Control-1> <Double-Alt-1> <1> <Meta-1>} {
+ bind .b.f $i {}
+ lappend result [lsort [bind .b.f]]
+ }
+ set result
+} {{<Button-1> <Double-Alt-Button-1> <Meta-Button-1>} {<Button-1> <Meta-Button-1>} <Meta-Button-1> {}}
+test bind-9.4 {Tk_DeleteBinding procedure: pending bindings delete later} {
+ catch {destroy .b.f}
+ frame .b.f
+ pack .b.f
+ update
+ bindtags .b.f {a b c}
+ testcbind a <1> {lappend x a1; bind c <1> {}; bind c <2> {}} {lappend x bye.a1}
+ bind b <1> {lappend x b1}
+ testcbind c <1> {lappend x c1} {lappend x bye.c1}
+ testcbind c <2> {lappend x c2} {lappend x bye.c2}
+ set x {}
+ event gen .b.f <1>
+ bind a <1> {}
+ bind b <1> {}
+ set x
+} {a1 bye.c2 b1 bye.c1 bye.a1}
+
+test bind-10.1 {Tk_GetBinding procedure} {
+ 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-10.2 {Tk_GetBinding procedure} {
+ catch {destroy .b.c}
+ canvas .b.c
+ .b.c bind foo a Test
+ .b.c bind foo a
+} {Test}
+test bind-10.3 {Tk_GetBinding procedure: C binding} {
+ catch {destroy .b.f}
+ frame .b.f
+ testcbind .b.f <1> "foo"
+ list [bind .b.f] [bind .b.f <1>]
+} {<Button-1> {}}
+
+test bind-11.1 {Tk_GetAllBindings procedure} {
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ foreach i "! a \\\{ ~ <Delete> <space> <<Paste>> <Tab> <Linefeed> <less> <Meta-a> <Acircumflex>" {
+ bind .b.f $i Test
+ }
+ lsort [bind .b.f]
+} {! <<Paste>> <Key-Acircumflex> <Key-Delete> <Key-Linefeed> <Key-Tab> <Key-less> <Key-space> <Meta-Key-a> a \{ ~}
+test bind-11.2 {Tk_GetAllBindings procedure} {
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ foreach i "<Double-1> <Triple-1> <Meta-Control-a> <Double-Alt-Enter> <1>" {
+ bind .b.f $i Test
+ }
+ lsort [bind .b.f]
+} {<Button-1> <Control-Meta-Key-a> <Double-Alt-Enter> <Double-Button-1> <Triple-Button-1>}
+test bind-11.3 {Tk_GetAllBindings procedure} {
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ foreach i "<Double-Triple-1> abcd a<Leave>b" {
+ bind .b.f $i Test
+ }
+ lsort [bind .b.f]
+} {<Triple-Button-1> a<Leave>b abcd}
+
+
+test bind-12.1 {Tk_DeleteAllBindings procedure} {
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ destroy .b.f
+} {}
+test bind-12.2 {Tk_DeleteAllBindings procedure} {
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ foreach i "a b c <Meta-1> <Alt-a> <Control-a>" {
+ bind .b.f $i x
+ }
+ destroy .b.f
+} {}
+test bind-12.3 {Tk_DeleteAllBindings procedure: pending bindings deleted later} {
+ catch {destroy .b.f}
+ frame .b.f
+ pack .b.f
+ update
+ testcbind .b.f <1> {lappend x before; event gen .b.f <2>; lappend x after} {lappend x bye.f1}
+ testcbind .b.f <2> {destroy .b.f} {lappend x bye.f2}
+ bind .b.f <Destroy> {lappend x fDestroy}
+ testcbind .b.f <3> {foo} {lappend x bye.f3}
+ set x {}
+ event gen .b.f <1>
+ set x
+} {before fDestroy bye.f3 bye.f2 after bye.f1}
+
+bind Test <KeyPress> {lappend x "%W %K Test press any"}
+bind all <KeyPress> {lappend x "%W %K all press any"}
+bind Test a {lappend x "%W %K Test press a"}
+bind all x {lappend x "%W %K all press x"}
+
+test bind-13.1 {Tk_BindEvent procedure} {
+ setup
+ bind .b.f a {lappend x "%W %K .b.f press a"}
+ set x {}
+ event gen .b.f <Key-a>
+ event gen .b.f <Key-b>
+ event gen .b.f <Key-x>
+ set x
+} {{.b.f a .b.f press a} {.b.f a Test press a} {.b.f a all press any} {.b.f b Test press any} {.b.f b all press any} {.b.f x Test press any} {.b.f x all press x}}
+
+bind Test <KeyPress> {lappend x "%W %K Test press any"; break}
+bind all <KeyPress> {continue; lappend x "%W %K all press any"}
+
+test bind-13.2 {Tk_BindEvent procedure} {
+ setup
+ bind .b.f b {lappend x "%W %K .b.f press a"}
+ set x {}
+ event gen .b.f <Key-b>
+ set x
+} {{.b.f b .b.f press a} {.b.f b Test press any}}
+if {[info procs bgerror] == "bgerror"} {
+ rename bgerror {}
+}
+proc bgerror args {}
+bind Test <KeyPress> {lappend x "%W %K Test press any"; error Test}
+test bind-13.3 {Tk_BindEvent procedure} {
+ setup
+ bind .b.f b {lappend x "%W %K .b.f press a"}
+ set x {}
+ event gen .b.f <Key-b>
+ update
+ list $x $errorInfo
+} {{{.b.f b .b.f press a} {.b.f b Test press any}} {Test
+ while executing
+"error Test"
+ (command bound to event)}}
+rename bgerror {}
+test bind-13.4 {Tk_BindEvent procedure} {
+ proc foo {} {
+ set x 44
+ event gen .b.f <Key-a>
+ }
+ setup
+ bind .b.f a {lappend x "%W %K .b.f press a"}
+ set x {}
+ foo
+ set x
+} {{.b.f a .b.f press a} {.b.f a Test press a}}
+test bind-13.5 {Tk_BindEvent procedure} {
+ bind all <Destroy> {lappend x "%W destroyed"}
+ set x {}
+ list [catch {frame .b.g -gorp foo} msg] $msg $x
+} {1 {unknown option "-gorp"} {{.b.g destroyed}}}
+foreach i [bind all] {
+ bind all $i {}
+}
+foreach i [bind Test] {
+ bind Test $i {}
+}
+test bind-13.6 {Tk_BindEvent procedure} {
+ setup
+ bind .b.f z {lappend x "%W z (.b.f binding)"}
+ bind Test z {lappend x "%W z (.b.f binding)"}
+ bind all z {bind .b.f z {}; lappend x "%W z (.b.f binding)"}
+ set x {}
+ event gen .b.f <Key-z>
+ bind Test z {}
+ bind all z {}
+ set x
+} {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}}
+test bind-13.7 {Tk_BindEvent procedure} {
+ setup
+ bind .b.f z {lappend x "%W z (.b.f binding)"}
+ bind Test z {lappend x "%W z (.b.f binding)"}
+ bind all z {destroy .b.f; lappend x "%W z (.b.f binding)"}
+ set x {}
+ event gen .b.f <Key-z>
+ bind Test z {}
+ bind all z {}
+ set x
+} {{.b.f z (.b.f binding)} {.b.f z (.b.f binding)} {.b.f z (.b.f binding)}}
+test bind-13.8 {Tk_BindEvent procedure} {
+ setup
+ bind .b.f <1> {lappend x "%W z (.b.f <1> binding)"}
+ bind .b.f <ButtonPress> {lappend x "%W z (.b.f <ButtonPress> binding)"}
+ set x {}
+ event gen .b.f <Button-1>
+ event gen .b.f <Button-2>
+ set x
+} {{.b.f z (.b.f <1> binding)} {.b.f z (.b.f <ButtonPress> binding)}}
+test bind-13.9 {Tk_BindEvent procedure: ignore NotifyInferior} {
+ setup
+ bind .b.f <Enter> "lappend x Enter%#"
+ bind .b.f <Leave> "lappend x Leave%#"
+ set x {}
+ event gen .b.f <Enter> -serial 100 -detail NotifyAncestor
+ event gen .b.f <Enter> -serial 101 -detail NotifyInferior
+ event gen .b.f <Leave> -serial 102 -detail NotifyAncestor
+ event gen .b.f <Leave> -serial 103 -detail NotifyInferior
+ set x
+} {Enter100 Leave102}
+test bind-13.10 {Tk_BindEvent procedure: collapse Motions} {
+ setup
+ bind .b.f <Motion> "lappend x Motion%#(%x,%y)"
+ set x {}
+ event gen .b.f <Motion> -serial 100 -x 100 -y 200 -when tail
+ update
+ event gen .b.f <Motion> -serial 101 -x 200 -y 300 -when tail
+ event gen .b.f <Motion> -serial 102 -x 300 -y 400 -when tail
+ update
+ set x
+} {Motion100(100,200) Motion102(300,400)}
+test bind-13.11 {Tk_BindEvent procedure: collapse repeating modifiers} {
+ setup
+ bind .b.f <Key> "lappend x %K%#"
+ bind .b.f <KeyRelease> "lappend x %K%#"
+ event gen .b.f <Key-Shift_L> -serial 100 -when tail
+ event gen .b.f <KeyRelease-Shift_L> -serial 101 -when tail
+ event gen .b.f <Key-Shift_L> -serial 102 -when tail
+ event gen .b.f <KeyRelease-Shift_L> -serial 103 -when tail
+ update
+} {}
+test bind-13.12 {Tk_BindEvent procedure: valid key detail} {
+ setup
+ bind .b.f <Key> "lappend x Key%K"
+ bind .b.f <KeyRelease> "lappend x Release%K"
+ set x {}
+ event gen .b.f <Key> -keysym a
+ event gen .b.f <KeyRelease> -keysym a
+ set x
+} {Keya Releasea}
+test bind-13.13 {Tk_BindEvent procedure: invalid key detail} {
+ setup
+ bind .b.f <Key> "lappend x Key%K"
+ bind .b.f <KeyRelease> "lappend x Release%K"
+ set x {}
+ event gen .b.f <Key> -keycode 0
+ event gen .b.f <KeyRelease> -keycode 0
+ set x
+} {Key?? Release??}
+test bind-13.14 {Tk_BindEvent procedure: button detail} {
+ setup
+ bind .b.f <Button> "lappend x Button%b"
+ bind .b.f <ButtonRelease> "lappend x Release%b"
+ set x {}
+ event gen .b.f <Button> -button 1
+ event gen .b.f <ButtonRelease> -button 3
+ set x
+} {Button1 Release3}
+test bind-13.15 {Tk_BindEvent procedure: virtual detail} {
+ setup
+ bind .b.f <<Paste>> "lappend x Paste"
+ set x {}
+ event gen .b.f <<Paste>>
+ set x
+} {Paste}
+test bind-13.16 {Tk_BindEvent procedure: virtual event in event stream} {
+ setup
+ bind .b.f <<Paste>> "lappend x Paste"
+ set x {}
+ event gen .b.f <<Paste>>
+ set x
+} {Paste}
+test bind-13.17 {Tk_BindEvent procedure: match detail physical} {
+ setup
+ bind .b.f <Button-2> {set x Button-2}
+ event add <<Paste>> <Button-2>
+ bind .b.f <<Paste>> {set x Paste}
+ set x {}
+ event gen .b.f <Button-2>
+ set x
+} {Button-2}
+test bind-13.18 {Tk_BindEvent procedure: no match detail physical} {
+ setup
+ event add <<Paste>> <Button-2>
+ bind .b.f <<Paste>> {set x Paste}
+ set x {}
+ event gen .b.f <Button-2>
+ set x
+} {Paste}
+test bind-13.19 {Tk_BindEvent procedure: match detail virtual} {
+ setup
+ event add <<Paste>> <Button-2>
+ bind .b.f <<Paste>> "lappend x Paste"
+ set x {}
+ event gen .b.f <Button-2>
+ set x
+} {Paste}
+test bind-13.20 {Tk_BindEvent procedure: no match detail virtual} {
+ setup
+ event add <<Paste>> <Button-2>
+ bind .b.f <<Paste>> "lappend x Paste"
+ set x {}
+ event gen .b.f <Button>
+ set x
+} {}
+test bind-13.21 {Tk_BindEvent procedure: match no-detail physical} {
+ setup
+ bind .b.f <Button> {set x Button}
+ event add <<Paste>> <Button>
+ bind .b.f <<Paste>> {set x Paste}
+ set x {}
+ event gen .b.f <Button-2>
+ set x
+} {Button}
+test bind-13.22 {Tk_BindEvent procedure: no match no-detail physical} {
+ setup
+ event add <<Paste>> <Button>
+ bind .b.f <<Paste>> {set x Paste}
+ set x {}
+ event gen .b.f <Button-2>
+ set x
+} {Paste}
+test bind-13.23 {Tk_BindEvent procedure: match no-detail virtual} {
+ setup
+ event add <<Paste>> <Button>
+ bind .b.f <<Paste>> "lappend x Paste"
+ set x {}
+ event gen .b.f <Button-2>
+ set x
+} {Paste}
+test bind-13.24 {Tk_BindEvent procedure: no match no-detail virtual} {
+ setup
+ event add <<Paste>> <Key>
+ bind .b.f <<Paste>> "lappend x Paste"
+ set x {}
+ event gen .b.f <Button>
+ set x
+} {}
+test bind-13.25 {Tk_BindEvent procedure: precedence} {
+ setup
+ event add <<Paste>> <Button-2>
+ event add <<Copy>> <Button>
+ bind .b.f <Button-2> "lappend x Button-2"
+ bind .b.f <<Paste>> "lappend x Paste"
+ bind .b.f <Button> "lappend x Button"
+ bind .b.f <<Copy>> "lappend x Copy"
+
+ set x {}
+ event gen .b.f <Button-2>
+ bind .b.f <Button-2> {}
+ event gen .b.f <Button-2>
+ bind .b.f <<Paste>> {}
+ event gen .b.f <Button-2>
+ bind .b.f <Button> {}
+ event gen .b.f <Button-2>
+ bind .b.f <<Copy>> {}
+ event gen .b.f <Button-2>
+ set x
+} {Button-2 Paste Button Copy}
+test bind-13.26 {Tk_BindEvent procedure: no detail virtual pattern list} {
+ setup
+ bind .b.f <Button-2> {set x Button-2}
+ set x {}
+ event gen .b.f <Button-2>
+ set x
+} {Button-2}
+test bind-13.27 {Tk_BindEvent procedure: detail virtual pattern list} {
+ setup
+ event add <<Paste>> <Button-2>
+ bind .b.f <<Paste>> {set x Paste}
+ set x {}
+ event gen .b.f <Button-2>
+ set x
+} {Paste}
+test bind-13.28 {Tk_BindEvent procedure: no no-detail virtual pattern list} {
+ setup
+ bind .b.f <Button> {set x Button}
+ set x {}
+ event gen .b.f <Button-2>
+ set x
+} {Button}
+test bind-13.29 {Tk_BindEvent procedure: no-detail virtual pattern list} {
+ setup
+ event add <<Paste>> <Button>
+ bind .b.f <<Paste>> {set x Paste}
+ set x {}
+ event gen .b.f <Button-2>
+ set x
+} {Paste}
+test bind-13.30 {Tk_BindEvent procedure: no match} {
+ setup
+ event gen .b.f <Button-2>
+} {}
+test bind-13.31 {Tk_BindEvent procedure: match} {
+ setup
+ bind .b.f <Button-2> {set x Button-2}
+ set x {}
+ event gen .b.f <Button-2>
+ set x
+} {Button-2}
+test bind-13.32 {Tk_BindEvent procedure: many C bindings cause realloc} {
+ setup
+ bindtags .b.f {a b c d e f g h i j k l m n o p}
+ foreach p [bindtags .b.f] {
+ testcbind $p <1> "lappend x $p"
+ }
+ set x {}
+ event gen .b.f <1>
+ foreach p [bindtags .b.f] {
+ bind $p <1> {}
+ }
+ set x
+} {a b c d e f g h i j k l m n o p}
+test bind-13.33 {Tk_BindEvent procedure: multiple tags} {
+ setup
+ bind .b.f <Button-2> {lappend x .b.f}
+ bind Test <Button-2> {lappend x Button}
+ set x {}
+ event gen .b.f <Button-2>
+ bind Test <Button-2> {}
+ set x
+} {.b.f Button}
+test bind-13.34 {Tk_BindEvent procedure: execute C binding} {
+ setup
+ testcbind .b.f <1> {lappend x 1}
+ set x {}
+ event gen .b.f <1>
+ set x
+} {1}
+test bind-13.35 {Tk_BindEvent procedure: pending list marked deleted} {
+ setup
+ testcbind Test <1> {lappend x Test} {lappend x Deleted}
+ bind .b.f <1> {lappend x .b.f; destroy .b.f}
+ set x {}
+ event gen .b.f <1>
+ set y [list $x [bind Test]]
+ bind Test <1> {}
+ set y
+} {.b.f <Button-1>}
+test bind-13.36 {Tk_BindEvent procedure: C binding marked deleted} {
+ setup
+ testcbind Test <1> {lappend x Test} {lappend x Deleted}
+ bind .b.f <1> {lappend x .b.f; bind Test <1> {}; lappend x after}
+ set x {}
+ event gen .b.f <1>
+ set x
+} {.b.f after Deleted}
+test bind-13.37 {Tk_BindEvent procedure: C binding gets to run} {
+ setup
+ testcbind Test <1> {lappend x Test}
+ bind .b.f <1> {lappend x .b.f}
+ set x {}
+ event gen .b.f <1>
+ bind Test <1> {}
+ set x
+} {.b.f Test}
+test bind-13.38 {Tk_BindEvent procedure: C binding deleted, refcount == 0} {
+ setup
+ testcbind .b.f <1> {lappend x hi; bind .b.f <1> {}} {lappend x bye}
+ set x {}
+ event gen .b.f <1>
+ set x
+} {hi bye}
+test bind-13.39 {Tk_BindEvent procedure: C binding deleted, refcount != 0} {
+ setup
+ testcbind .b.f <1> {
+ lappend x before$n
+ if {$n==0} {
+ bind .b.f <1> {}
+ } else {
+ set n [expr $n-1]
+ event gen .b.f <1>
+ }
+ lappend x after$n
+ } {lappend x Deleted}
+ set n 3
+ set x {}
+ event gen .b.f <1>
+ set x
+} {before3 before2 before1 before0 after0 after0 after0 after0 Deleted}
+test bind-13.40 {Tk_BindEvent procedure: continue in script} {
+ setup
+ bind .b.f <Button-2> {lappend x b1; continue; lappend x b2}
+ bind Test <Button-2> {lappend x B1; continue; lappend x B2}
+ set x {}
+ event gen .b.f <Button-2>
+ bind Test <Button-2> {}
+ set x
+} {b1 B1}
+test bind-13.41 {Tk_BindEvent procedure: continue in script} {
+ setup
+ testcbind .b.f <Button-2> {lappend x b1; continue; lappend x b2}
+ testcbind Test <Button-2> {lappend x B1; continue; lappend x B2}
+ set x {}
+ event gen .b.f <Button-2>
+ bind Test <Button-2> {}
+ set x
+} {b1 B1}
+test bind-13.42 {Tk_BindEvent procedure: break in script} {
+ setup
+ bind .b.f <Button-2> {lappend x b1; break; lappend x b2}
+ bind Test <Button-2> {lappend x B1; break; lappend x B2}
+ set x {}
+ event gen .b.f <Button-2>
+ bind Test <Button-2> {}
+ set x
+} {b1}
+test bind-13.43 {Tk_BindEvent procedure: break in script} {
+ setup
+ testcbind .b.f <Button-2> {lappend x b1; break; lappend x b2}
+ testcbind Test <Button-2> {lappend x B1; break; lappend x B2}
+ set x {}
+ event gen .b.f <Button-2>
+ bind Test <Button-2> {}
+ set x
+} {b1}
+
+proc bgerror msg {
+ global x
+ lappend x $msg
+}
+test bind-13.44 {Tk_BindEvent procedure: error in script} {
+ setup
+ bind .b.f <Button-2> {lappend x b1; blap}
+ bind Test <Button-2> {lappend x B1}
+ set x {}
+ event gen .b.f <Button-2>
+ update
+ bind Test <Button-2> {}
+ set x
+} {b1 {invalid command name "blap"}}
+test bind-13.45 {Tk_BindEvent procedure: error in script} {
+ setup
+ testcbind .b.f <Button-2> {lappend x b1; blap}
+ testcbind Test <Button-2> {lappend x B1}
+ set x {}
+ event gen .b.f <Button-2>
+ update
+ bind Test <Button-2> {}
+ set x
+} {b1 {invalid command name "blap"}}
+
+test bind-14.1 {TkBindDeadWindow: no C bindings pending} {
+ setup
+ bind .b.f <1> x
+ testcbind .b.f <2> y
+ destroy .b.f
+} {}
+test bind-14.2 {TkBindDeadWindow: is called after <Destroy>} {
+ setup
+ testcbind .b.f <Destroy> "lappend x .b.f"
+ testcbind Test <Destroy> "lappend x Test"
+ set x {}
+ destroy .b.f
+ bind Test <Destroy> {}
+ set x
+} {.b.f Test}
+test bind-14.3 {TkBindDeadWindow: pending C bindings} {
+ setup
+ bindtags .b.f {a b c d}
+ testcbind a <1> "lappend x a1" "lappend x bye.a1"
+ testcbind b <1> "destroy .b.f; lappend x b1" "lappend x bye.b1"
+ testcbind c <1> "lappend x c1" "lappend x bye.c1"
+ testcbind d <1> "lappend x d1" "lappend x bye.d1"
+ bind a <2> "event gen .b.f <1>"
+ testcbind b <2> "lappend x b2" "lappend x bye.b2"
+ testcbind c <2> "lappend x c2" "lappend x bye.d2"
+ bind d <2> "lappend x d2"
+ testcbind a <3> "event gen .b.f <2>"
+ set x {}
+ event gen .b.f <3>
+ set y $x
+ foreach tag {a b c d} {
+ foreach event {<1> <2> <3>} {
+ bind $tag $event {}
+ }
+ }
+ set y
+} {a1 b1 d2}
+
+test bind-15.1 {MatchPatterns procedure, ignoring type mismatches} {
+ setup
+ bind .b.f ab {set x 1}
+ set x 0
+ event gen .b.f <Key-a>
+ event gen .b.f <KeyRelease-a>
+ event gen .b.f <Key-b>
+ event gen .b.f <KeyRelease-b>
+ set x
+} 1
+test bind-15.2 {MatchPatterns procedure, ignoring type mismatches} {
+ setup
+ bind .b.f ab {set x 1}
+ set x 0
+ event gen .b.f <Key-a>
+ event gen .b.f <Enter>
+ event gen .b.f <KeyRelease-a>
+ event gen .b.f <Leave>
+ event gen .b.f <Key-b>
+ event gen .b.f <KeyRelease-b>
+ set x
+} 1
+test bind-15.3 {MatchPatterns procedure, ignoring type mismatches} {
+ setup
+ bind .b.f ab {set x 1}
+ set x 0
+ event gen .b.f <Key-a>
+ event gen .b.f <Button-1>
+ event gen .b.f <Key-b>
+ set x
+} 0
+test bind-15.4 {MatchPatterns procedure, ignoring type mismatches} {
+ setup
+ bind .b.f <Double-1> {set x 1}
+ set x 0
+ event gen .b.f <Button-1>
+ event gen .b.f <ButtonRelease-1>
+ event gen .b.f <Button-1>
+ event gen .b.f <ButtonRelease-1>
+ set x
+} 1
+test bind-15.5 {MatchPatterns procedure, ignoring type mismatches} {
+ setup
+ bind .b.f <Double-ButtonRelease> {set x 1}
+ set x 0
+ event gen .b.f <Button-1>
+ event gen .b.f <ButtonRelease-1>
+ event gen .b.f <Button-2>
+ event gen .b.f <ButtonRelease-2>
+ set x
+} 1
+test bind-15.6 {MatchPatterns procedure, ignoring type mismatches} {
+ setup
+ bind .b.f <Double-1> {set x 1}
+ set x 0
+ event gen .b.f <Button-1>
+ event gen .b.f <Key-a>
+ event gen .b.f <ButtonRelease-1>
+ event gen .b.f <Button-1>
+ event gen .b.f <ButtonRelease-1>
+ set x
+} 0
+test bind-15.7 {MatchPatterns procedure, ignoring type mismatches} {
+ setup
+ bind .b.f <Double-1> {set x 1}
+ set x 0
+ event gen .b.f <Button-1>
+ event gen .b.f <Key-Shift_L>
+ event gen .b.f <ButtonRelease-1>
+ event gen .b.f <Button-1>
+ event gen .b.f <ButtonRelease-1>
+ set x
+} 1
+test bind-15.8 {MatchPatterns procedure, ignoring type mismatches} {
+ setup
+ bind .b.f ab {set x 1}
+ set x 0
+ event gen .b.f <Key-a>
+ event gen .b.f <Key-c>
+ event gen .b.f <Key-b>
+ set x
+} 0
+test bind-15.9 {MatchPatterns procedure, modifier checks} {
+ setup
+ bind .b.f <M1-M2-Key> {set x 1}
+ set x 0
+ event gen .b.f <Key-a> -state 0x18
+ set x
+} 1
+test bind-15.10 {MatchPatterns procedure, modifier checks} {
+ setup
+ bind .b.f <M1-M2-Key> {set x 1}
+ set x 0
+ event gen .b.f <Key-a> -state 0xfc
+ set x
+} 1
+test bind-15.11 {MatchPatterns procedure, modifier checks} {
+ setup
+ bind .b.f <M1-M2-Key> {set x 1}
+ set x 0
+ event gen .b.f <Key-a> -state 0x8
+ set x
+} 0
+test bind-15.12 {MatchPatterns procedure, ignore modifier presses and releases} {nonPortable} {
+ # This test is non-portable because the Shift_L keysym may behave
+ # differently on some platforms.
+ setup
+ bind .b.f aB {set x 1}
+ set x 0
+ event gen .b.f <Key-a>
+ event gen .b.f <Key-Shift_L>
+ event gen .b.f <Key-b> -state 1
+ set x
+} 1
+test bind-15.13 {MatchPatterns procedure, checking detail} {
+ setup
+ bind .b.f ab {set x 1}
+ set x 0
+ event gen .b.f <Key-a>
+ event gen .b.f <Key-c>
+ set x
+} 0
+test bind-15.14 {MatchPatterns procedure, checking "nearby"} {
+ setup
+ bind .b.f <Double-1> {set x 1}
+ set x 0
+ event gen .b.f <Button-2>
+ event gen .b.f <Button-1> -x 30 -y 40
+ event gen .b.f <Button-1> -x 31 -y 39
+ set x
+} 1
+test bind-15.15 {MatchPatterns procedure, checking "nearby"} {
+ setup
+ bind .b.f <Double-1> {set x 1}
+ set x 0
+ event gen .b.f <Button-2>
+ event gen .b.f <Button-1> -x 30 -y 40
+ event gen .b.f <Button-1> -x 29 -y 41
+ set x
+} 1
+test bind-15.16 {MatchPatterns procedure, checking "nearby"} {
+ setup
+ bind .b.f <Double-1> {set x 1}
+ set x 0
+ event gen .b.f <Button-2>
+ event gen .b.f <Button-1> -x 30 -y 40
+ event gen .b.f <Button-1> -x 40 -y 40
+ set x
+} 0
+test bind-15.17 {MatchPatterns procedure, checking "nearby"} {
+ setup
+ bind .b.f <Double-1> {set x 1}
+ set x 0
+ event gen .b.f <Button-2>
+ event gen .b.f <Button-1> -x 30 -y 40
+ event gen .b.f <Button-1> -x 20 -y 40
+ set x
+} 0
+test bind-15.18 {MatchPatterns procedure, checking "nearby"} {
+ setup
+ bind .b.f <Double-1> {set x 1}
+ set x 0
+ event gen .b.f <Button-2>
+ event gen .b.f <Button-1> -x 30 -y 40
+ event gen .b.f <Button-1> -x 30 -y 30
+ set x
+} 0
+test bind-15.19 {MatchPatterns procedure, checking "nearby"} {
+ setup
+ bind .b.f <Double-1> {set x 1}
+ set x 0
+ event gen .b.f <Button-2>
+ event gen .b.f <Button-1> -x 30 -y 40
+ event gen .b.f <Button-1> -x 30 -y 50
+ set x
+} 0
+test bind-15.20 {MatchPatterns procedure, checking "nearby"} {
+ setup
+ bind .b.f <Double-1> {set x 1}
+ set x 0
+ event gen .b.f <Button-2>
+ event gen .b.f <Button-1> -time 300
+ event gen .b.f <Button-1> -time 700
+ set x
+} 1
+test bind-15.21 {MatchPatterns procedure, checking "nearby"} {
+ setup
+ bind .b.f <Double-1> {set x 1}
+ set x 0
+ event gen .b.f <Button-2>
+ event gen .b.f <Button-1> -time 300
+ event gen .b.f <Button-1> -time 900
+ set x
+} 0
+test bind-15.22 {MatchPatterns procedure, time wrap-around} {
+ setup
+ bind .b.f <Double-1> {set x 1}
+ set x 0
+ event gen .b.f <Button-1> -time [expr -100]
+ event gen .b.f <Button-1> -time 200
+ set x
+} 1
+test bind-15.23 {MatchPatterns procedure, time wrap-around} {
+ setup
+ bind .b.f <Double-1> {set x 1}
+ set x 0
+ event gen .b.f <Button-1> -time -100
+ event gen .b.f <Button-1> -time 500
+ set x
+} 0
+test bind-15.24 {MatchPatterns procedure, virtual event} {
+ setup
+ event add <<Paste>> <Button-1>
+ bind .b.f <<Paste>> {lappend x paste}
+ set x {}
+ event gen .b.f <Button-1>
+ set x
+} {paste}
+test bind-15.25 {MatchPatterns procedure, reject a virtual event} {
+ setup
+ event add <<Paste>> <Shift-Button-1>
+ bind .b.f <<Paste>> {lappend x paste}
+ set x {}
+ event gen .b.f <Button-1>
+ set x
+} {}
+test bind-15.26 {MatchPatterns procedure, reject a virtual event} {
+ setup
+ event add <<V1>> <Button>
+ event add <<V2>> <Button-1>
+ event add <<V3>> <Shift-Button-1>
+ bind .b.f <<V2>> "lappend x V2%#"
+ set x {}
+ event gen .b.f <Button> -serial 101
+ event gen .b.f <Button-1> -serial 102
+ event gen .b.f <Shift-Button-1> -serial 103
+ bind .b.f <Shift-Button-1> "lappend x Shift-Button-1"
+ event gen .b.f <Button> -serial 104
+ event gen .b.f <Button-1> -serial 105
+ event gen .b.f <Shift-Button-1> -serial 106
+ set x
+} {V2102 V2103 V2105 Shift-Button-1}
+test bind-15.27 {MatchPatterns procedure, conflict resolution} {
+ setup
+ bind .b.f <KeyPress> {set x 0}
+ bind .b.f a {set x 1}
+ set x none
+ event gen .b.f <Key-a>
+ set x
+} 1
+test bind-15.28 {MatchPatterns procedure, conflict resolution} {
+ setup
+ bind .b.f <KeyPress> {set x 0}
+ bind .b.f a {set x 1}
+ set x none
+ event gen .b.f <Key-b>
+ set x
+} 0
+test bind-15.29 {MatchPatterns procedure, conflict resolution} {
+ setup
+ bind .b.f <KeyPress> {lappend x 0}
+ bind .b.f a {lappend x 1}
+ bind .b.f ba {lappend x 2}
+ set x none
+ event gen .b.f <Key-b>
+ event gen .b.f <KeyRelease-b>
+ event gen .b.f <Key-a>
+ set x
+} {none 0 2}
+test bind-15.30 {MatchPatterns procedure, conflict resolution} {
+ setup
+ bind .b.f <ButtonPress> {set x 0}
+ bind .b.f <1> {set x 1}
+ set x none
+ event gen .b.f <Button-1>
+ set x
+} 1
+test bind-15.31 {MatchPatterns procedure, conflict resolution} {
+ setup
+ bind .b.f <M1-Key> {set x 0}
+ bind .b.f <M2-Key> {set x 1}
+ set x none
+ event gen .b.f <Key-a> -state 0x18
+ set x
+} 1
+test bind-15.32 {MatchPatterns procedure, conflict resolution} {
+ setup
+ bind .b.f <M2-Key> {set x 0}
+ bind .b.f <M1-Key> {set x 1}
+ set x none
+ event gen .b.f <Key-a> -state 0x18
+ set x
+} 1
+test bind-15.33 {MatchPatterns procedure, conflict resolution} {
+ setup
+ bind .b.f <1> {lappend x single}
+ bind Test <1> {lappend x single(Test)}
+ bind Test <Double-1> {lappend x double(Test)}
+ set x {}
+ event gen .b.f <Button-1>
+ event gen .b.f <Button-1>
+ event gen .b.f <Button-1>
+ set x
+} {single single(Test) single double(Test) single double(Test)}
+foreach i [bind Test] {
+ bind Test $i {}
+}
+test bind-16.1 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Enter> {set x abcd}
+ set x none
+ event gen .b.f <Enter>
+ set x
+} abcd
+test bind-16.2 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Enter> {set x %#}
+ set x none
+ event gen .b.f <Enter> -serial 1234
+ set x
+} 1234
+test bind-16.3 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Configure> {set x %a}
+ set x none
+ event gen .b.f <Configure> -above .b -window .b.f
+ set x
+} [winfo id .b]
+test bind-16.4 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Button> {set x %b}
+ set x none
+ event gen .b.f <Button-3>
+ set x
+} 3
+test bind-16.5 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Expose> {set x %c}
+ set x none
+ event gen .b.f <Expose> -count 47
+ set x
+} 47
+test bind-16.6 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Enter> {set x %d}
+ set x none
+ event gen .b.f <Enter> -detail NotifyAncestor
+ set x
+} NotifyAncestor
+test bind-16.7 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Enter> {set x %d}
+ set x none
+ event gen .b.f <Enter> -detail NotifyVirtual
+ set x
+} NotifyVirtual
+test bind-16.8 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Enter> {set x %d}
+ set x none
+ event gen .b.f <Enter> -detail NotifyNonlinear
+ set x
+} NotifyNonlinear
+test bind-16.9 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Enter> {set x %d}
+ set x none
+ event gen .b.f <Enter> -detail NotifyNonlinearVirtual
+ set x
+} NotifyNonlinearVirtual
+test bind-16.10 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Enter> {set x %d}
+ set x none
+ event gen .b.f <Enter> -detail NotifyPointer
+ set x
+} NotifyPointer
+test bind-16.11 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Enter> {set x %d}
+ set x none
+ event gen .b.f <Enter> -detail NotifyPointerRoot
+ set x
+} NotifyPointerRoot
+test bind-16.12 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Enter> {set x %d}
+ set x none
+ event gen .b.f <Enter> -detail NotifyDetailNone
+ set x
+} NotifyDetailNone
+test bind-16.13 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Enter> {set x %f}
+ set x none
+ event gen .b.f <Enter> -focus 1
+ set x
+} 1
+test bind-16.14 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Expose> {set x "%x %y %w %h"}
+ set x none
+ event gen .b.f <Expose> -x 24 -y 18 -width 147 -height 61
+ set x
+} {24 18 147 61}
+test bind-16.15 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Configure> {set x "%x %y %w %h"}
+ set x none
+ event gen .b.f <Configure> -x 24 -y 18 -width 147 -height 61 -window .b.f
+ set x
+} {24 18 147 61}
+test bind-16.16 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Key> {set x "%k"}
+ set x none
+ event gen .b.f <Key> -keycode 146
+ set x
+} 146
+test bind-16.17 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Enter> {set x "%m"}
+ set x none
+ event gen .b.f <Enter> -mode NotifyNormal
+ set x
+} NotifyNormal
+test bind-16.18 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Enter> {set x "%m"}
+ set x none
+ event gen .b.f <Enter> -mode NotifyGrab
+ set x
+} NotifyGrab
+test bind-16.19 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Enter> {set x "%m"}
+ set x none
+ event gen .b.f <Enter> -mode NotifyUngrab
+ set x
+} NotifyUngrab
+test bind-16.20 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Enter> {set x "%m"}
+ set x none
+ event gen .b.f <Enter> -mode NotifyWhileGrabbed
+ set x
+} NotifyWhileGrabbed
+test bind-16.21 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Map> {set x "%o"}
+ set x none
+ event gen .b.f <Map> -override 1 -window .b.f
+ set x
+} 1
+test bind-16.22 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Reparent> {set x "%o"}
+ set x none
+ event gen .b.f <Reparent> -override true -window .b.f
+ set x
+} 1
+test bind-16.23 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Configure> {set x "%o"}
+ set x none
+ event gen .b.f <Configure> -override 1 -window .b.f
+ set x
+} 1
+test bind-16.24 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Circulate> {set x "%p"}
+ set x none
+ event gen .b.f <Circulate> -place PlaceOnTop -window .b.f
+ set x
+} PlaceOnTop
+test bind-16.25 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Circulate> {set x "%p"}
+ set x none
+ event gen .b.f <Circulate> -place PlaceOnBottom -window .b.f
+ set x
+} PlaceOnBottom
+test bind-16.26 {ExpandPercents procedure} {
+ setup
+ bind .b.f <1> {set x "%s"}
+ set x none
+ event gen .b.f <Button-1> -state 122
+ set x
+} 122
+test bind-16.27 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Enter> {set x "%s"}
+ set x none
+ event gen .b.f <Enter> -state 0x3ff
+ set x
+} 1023
+test bind-16.28 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Visibility> {set x "%s"}
+ set x none
+ event gen .b.f <Visibility> -state VisibilityPartiallyObscured
+ set x
+} VisibilityPartiallyObscured
+test bind-16.29 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Visibility> {set x "%s"}
+ set x none
+ event gen .b.f <Visibility> -state VisibilityUnobscured
+ set x
+} VisibilityUnobscured
+test bind-16.30 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Visibility> {set x "%s"}
+ set x none
+ event gen .b.f <Visibility> -state VisibilityFullyObscured
+ set x
+} VisibilityFullyObscured
+test bind-16.31 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Button> {set x "%t"}
+ set x none
+ event gen .b.f <Button> -time 4294
+ set x
+} 4294
+test bind-16.32 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Button> {set x "%x %y"}
+ set x none
+ event gen .b.f <Button> -x 881 -y 432
+ set x
+} {881 432}
+test bind-16.33 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Reparent> {set x "%x %y"}
+ set x none
+ event gen .b.f <Reparent> -x 882 -y 431 -window .b.f
+ set x
+} {882 431}
+test bind-16.34 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Enter> {set x "%x %y"}
+ set x none
+ event gen .b.f <Enter> -x 781 -y 632
+ set x
+} {781 632}
+test bind-16.35 {ExpandPercents procedure} {nonPortable} {
+ setup
+ bind .b.f <Key> {lappend x "%A"}
+ set x {}
+ event gen .b.f <Key-a>
+ event gen .b.f <Key-A> -state 1
+ 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
+test bind-16.37 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Enter> {set x "%E"}
+ set x none
+ event gen .b.f <Enter> -sendevent 1
+ set x
+} 1
+test bind-16.38 {ExpandPercents procedure} {nonPortable} {
+ setup
+ bind .b.f <Key> {lappend x %K}
+ set x {}
+ event gen .b.f <Key-a>
+ event gen .b.f <Key-A> -state 1
+ event gen .b.f <Key-Tab>
+ 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 Tab F1 Shift_L space dollar braceleft}
+test bind-16.39 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Key> {set x "%N"}
+ set x none
+ event gen .b.f <Key-a>
+ set x
+} 97
+test bind-16.40 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Key> {set x "%S"}
+ set x none
+ event gen .b.f <Key-a> -subwindow .b
+ set x
+} [winfo id .b]
+test bind-16.41 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Key> {set x "%T"}
+ set x none
+ event gen .b.f <Key>
+ set x
+} 2
+test bind-16.42 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Key> {set x "%W"}
+ set x none
+ event gen .b.f <Key>
+ set x
+} .b.f
+test bind-16.43 {ExpandPercents procedure} {
+ setup
+ bind .b.f <Button> {set x "%X %Y"}
+ set x none
+ 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>>
+} {<Control-Key-v>}
+test bind-17.5 {event command: add 2} {
+ setup
+ event add <<Paste>> <Control-v> <Button-2>
+ lsort [event info <<Paste>>]
+} {<Button-2> <Control-Key-v>}
+test bind-17.6 {event command: add with error} {
+ setup
+ list [catch {event add <<Paste>> <Control-v> <Button-2> abc <xyz> <1>} \
+ msg] $msg [lsort [event info <<Paste>>]]
+} {1 {bad event type or keysym "xyz"} {<Button-2> <Control-Key-v> abc}}
+test bind-17.7 {event command: delete} {
+ list [catch {event delete} msg] $msg
+} {1 {wrong # args: should be "event delete virtual ?sequence sequence ...?"}}
+test bind-17.8 {event command: delete many} {
+ setup
+ event add <<Paste>> <3> <1> <2> t
+ event delete <<Paste>> <1> <2>
+ lsort [event info <<Paste>>]
+} {<Button-3> t}
+test bind-17.9 {event command: delete all} {
+ setup
+ event add <<Paste>> a b
+ event delete <<Paste>>
+ event info <<Paste>>
+} {}
+test bind-17.10 {event command: delete 1} {
+ setup
+ event add <<Paste>> a b c
+ event delete <<Paste>> b
+ lsort [event info <<Paste>>]
+} {a c}
+test bind-17.11 {event command: info name} {
+ setup
+ event add <<Paste>> a b c
+ lsort [event info <<Paste>>]
+} {a b c}
+test bind-17.12 {event command: info all} {
+ setup
+ event add <<Paste>> a
+ event add <<Alive>> b
+ lsort [event info]
+} {<<Alive>> <<Paste>>}
+test bind-17.13 {event command: info error} {
+ list [catch {event info <<Paste>> <Control-v>} msg] $msg
+} {1 {wrong # args: should be "event info ?virtual?"}}
+test bind-17.14 {event command: generate} {
+ list [catch {event generate} msg] $msg
+} {1 {wrong # args: should be "event generate window event ?options?"}}
+test bind-17.15 {event command: generate} {
+ setup
+ bind .b.f <1> "lappend x 1"
+ set x {}
+ event generate .b.f <1>
+ 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"}}
+test bind-18.3 {CreateVirtualEvent procedure: new physical} {
+ setup
+ event add <<xyz>> <Control-v>
+ event info <<xyz>>
+} {<Control-Key-v>}
+test bind-18.4 {CreateVirtualEvent procedure: duplicate physical} {
+ setup
+ event add <<xyz>> <Control-v>
+ event add <<xyz>> <Control-v>
+ event info <<xyz>>
+} {<Control-Key-v>}
+test bind-18.5 {CreateVirtualEvent procedure: existing physical} {
+ setup
+ event add <<xyz>> <Control-v>
+ event add <<abc>> <Control-v>
+ list [lsort [event info]] [event info <<xyz>>] [event info <<abc>>]
+} {{<<abc>> <<xyz>>} <Control-Key-v> <Control-Key-v>}
+test bind-18.6 {CreateVirtualEvent procedure: new virtual} {
+ setup
+ event add <<xyz>> <Control-v>
+ list [event info] [event info <<xyz>>]
+} {<<xyz>> <Control-Key-v>}
+test bind-18.7 {CreateVirtualEvent procedure: existing virtual} {
+ setup
+ event add <<xyz>> <Control-v>
+ event add <<xyz>> <Button-2>
+ list [event info] [lsort [event info <<xyz>>]]
+} {<<xyz>> {<Button-2> <Control-Key-v>}}
+
+
+test bind-19.1 {DeleteVirtualEvent procedure: GetVirtualEventUid} {
+ list [catch {event add xyz {}} msg] $msg
+} {1 {virtual event "xyz" is badly formed}}
+test bind-19.2 {DeleteVirtualEvent procedure: non-existent virtual} {
+ setup
+ event delete <<xyz>>
+ event info
+} {}
+test bind-19.3 {DeleteVirtualEvent procedure: delete 1} {
+ setup
+ event add <<xyz>> <Control-v>
+ event delete <<xyz>> <Control-v>
+ event info <<xyz>>
+} {}
+test bind-19.4 {DeleteVirtualEvent procedure: delete 1, not owned} {
+ setup
+ event add <<xyz>> <Control-v>
+ event delete <<xyz>> <Button-1>
+ event info <<xyz>>
+} {<Control-Key-v>}
+test bind-19.5 {DeleteVirtualEvent procedure: delete 1, badly formed} {
+ setup
+ event add <<xyz>> <Control-v>
+ list [catch {event delete <<xyz>> <xyz>} msg] $msg
+} {1 {bad event type or keysym "xyz"}}
+test bind-19.6 {DeleteVirtualEvent procedure: delete 1, badly formed} {
+ setup
+ event add <<xyz>> <Control-v>
+ list [catch {event delete <<xyz>> <<Paste>>} msg] $msg
+} {1 {virtual event not allowed in definition of another virtual event}}
+test bind-19.7 {DeleteVirtualEvent procedure: owns 1, delete all} {
+ setup
+ event add <<xyz>> <Control-v>
+ event delete <<xyz>>
+ event info
+} {}
+test bind-19.8 {DeleteVirtualEvent procedure: owns 1, delete 1} {
+ setup
+ event add <<xyz>> <Control-v>
+ event delete <<xyz>> <Control-v>
+ event info
+} {}
+test bind-19.9 {DeleteVirtualEvent procedure: owns many, delete all} {
+ setup
+ event add <<xyz>> <Control-v> <Control-w> <Control-x>
+ event delete <<xyz>>
+ event info
+} {}
+test bind-19.10 {DeleteVirtualEvent procedure: owns many, delete 1} {
+ setup
+ event add <<xyz>> <Control-v> <Control-w> <Control-x>
+ event delete <<xyz>> <Control-w>
+ lsort [event info <<xyz>>]
+} {<Control-Key-v> <Control-Key-x>}
+test bind-19.11 {DeleteVirtualEvent procedure: owned by 1, only} {
+ setup
+ event add <<xyz>> <Button-2>
+ bind .b.f <<xyz>> {lappend x %#}
+ set x {}
+ event gen .b.f <Button-2> -serial 101
+ event delete <<xyz>>
+ event gen .b.f <Button-2> -serial 102
+ set x
+} {101}
+test bind-19.12 {DeleteVirtualEvent procedure: owned by 1, first in chain} {
+ setup
+ event add <<abc>> <Control-Button-2>
+ event add <<xyz>> <Button-2>
+ bind .b.f <<xyz>> {lappend x xyz}
+ bind .b.f <<abc>> {lappend x abc}
+ set x {}
+ event gen .b.f <Button-2>
+ event gen .b.f <Control-Button-2>
+ event delete <<xyz>>
+ event gen .b.f <Button-2>
+ event gen .b.f <Control-Button-2>
+ list $x [event info <<abc>>]
+} {{xyz abc abc} <Control-Button-2>}
+test bind-19.13 {DeleteVirtualEvent procedure: owned by 1, second in chain} {
+ setup
+ event add <<def>> <Shift-Button-2>
+ event add <<xyz>> <Button-2>
+ event add <<abc>> <Control-Button-2>
+ bind .b.f <<xyz>> {lappend x xyz}
+ bind .b.f <<abc>> {lappend x abc}
+ bind .b.f <<def>> {lappend x def}
+ set x {}
+ event gen .b.f <Button-2>
+ event gen .b.f <Control-Button-2>
+ event gen .b.f <Shift-Button-2>
+ event delete <<xyz>>
+ event gen .b.f <Button-2>
+ event gen .b.f <Control-Button-2>
+ event gen .b.f <Shift-Button-2>
+ list $x [event info <<def>>] [event info <<xyz>>] [event info <<abc>>]
+} {{xyz abc def abc def} <Shift-Button-2> {} <Control-Button-2>}
+test bind-19.14 {DeleteVirtualEvent procedure: owned by 1, last in chain} {
+ setup
+ event add <<xyz>> <Button-2>
+ event add <<abc>> <Control-Button-2>
+ event add <<def>> <Shift-Button-2>
+ bind .b.f <<xyz>> {lappend x xyz}
+ bind .b.f <<abc>> {lappend x abc}
+ bind .b.f <<def>> {lappend x def}
+ set x {}
+ event gen .b.f <Button-2>
+ event gen .b.f <Control-Button-2>
+ event gen .b.f <Shift-Button-2>
+ event delete <<xyz>>
+ event gen .b.f <Button-2>
+ event gen .b.f <Control-Button-2>
+ event gen .b.f <Shift-Button-2>
+ list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>]
+} {{xyz abc def abc def} {} <Control-Button-2> <Shift-Button-2>}
+test bind-19.15 {DeleteVirtualEvent procedure: owned by many, first} {
+ setup
+ pack [frame .b.g -class Test -width 150 -height 100]
+ pack [frame .b.h -class Test -width 150 -height 100]
+ update
+ event add <<xyz>> <Button-2>
+ event add <<abc>> <Button-2>
+ event add <<def>> <Button-2>
+ bind .b.f <<xyz>> {lappend x xyz}
+ bind .b.g <<abc>> {lappend x abc}
+ bind .b.h <<def>> {lappend x def}
+ set x {}
+ event gen .b.f <Button-2>
+ event gen .b.g <Button-2>
+ event gen .b.h <Button-2>
+ event delete <<xyz>>
+ event gen .b.f <Button-2>
+ event gen .b.g <Button-2>
+ event gen .b.h <Button-2>
+ destroy .b.g
+ destroy .b.h
+ list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>]
+} {{xyz abc def abc def} {} <Button-2> <Button-2>}
+test bind-19.16 {DeleteVirtualEvent procedure: owned by many, middle} {
+ setup
+ pack [frame .b.g -class Test -width 150 -height 100]
+ pack [frame .b.h -class Test -width 150 -height 100]
+ update
+ event add <<xyz>> <Button-2>
+ event add <<abc>> <Button-2>
+ event add <<def>> <Button-2>
+ bind .b.f <<xyz>> {lappend x xyz}
+ bind .b.g <<abc>> {lappend x abc}
+ bind .b.h <<def>> {lappend x def}
+ set x {}
+ event gen .b.f <Button-2>
+ event gen .b.g <Button-2>
+ event gen .b.h <Button-2>
+ event delete <<abc>>
+ event gen .b.f <Button-2>
+ event gen .b.g <Button-2>
+ event gen .b.h <Button-2>
+ destroy .b.g
+ destroy .b.h
+ list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>]
+} {{xyz abc def xyz def} <Button-2> {} <Button-2>}
+test bind-19.17 {DeleteVirtualEvent procedure: owned by many, last} {
+ setup
+ pack [frame .b.g -class Test -width 150 -height 100]
+ pack [frame .b.h -class Test -width 150 -height 100]
+ update
+ event add <<xyz>> <Button-2>
+ event add <<abc>> <Button-2>
+ event add <<def>> <Button-2>
+ bind .b.f <<xyz>> {lappend x xyz}
+ bind .b.g <<abc>> {lappend x abc}
+ bind .b.h <<def>> {lappend x def}
+ set x {}
+ event gen .b.f <Button-2>
+ event gen .b.g <Button-2>
+ event gen .b.h <Button-2>
+ event delete <<def>>
+ event gen .b.f <Button-2>
+ event gen .b.g <Button-2>
+ event gen .b.h <Button-2>
+ destroy .b.g
+ destroy .b.h
+ list $x [event info <<xyz>>] [event info <<abc>>] [event info <<def>>]
+} {{xyz abc def xyz abc} <Button-2> <Button-2> {}}
+
+
+test bind-20.1 {GetVirtualEvent procedure: GetVirtualEventUid} {
+ list [catch {event info asd} msg] $msg
+} {1 {virtual event "asd" is badly formed}}
+test bind-20.2 {GetVirtualEvent procedure: non-existent event} {
+ event info <<asd>>
+} {}
+test bind-20.3 {GetVirtualEvent procedure: owns 1} {
+ setup
+ event add <<xyz>> <Control-Key-v>
+ event info <<xyz>>
+} {<Control-Key-v>}
+test bind-20.4 {GetVirtualEvent procedure: owns many} {
+ setup
+ event add <<xyz>> <Control-v> <Button-2> spack
+ event info <<xyz>>
+} {<Control-Key-v> <Button-2> spack}
+
+
+test bind-21.1 {GetAllVirtualEvents procedure: no events} {
+ setup
+ event info
+} {}
+test bind-21.2 {GetAllVirtualEvents procedure: 1 event} {
+ setup
+ event add <<xyz>> <Control-v>
+ event info
+} {<<xyz>>}
+test bind-21.3 {GetAllVirtualEvents procedure: many events} {
+ setup
+ event add <<xyz>> <Control-v>
+ event add <<xyz>> <Button-2>
+ event add <<abc>> <Control-v>
+ event add <<def>> <Key-F6>
+ lsort [event info]
+} {<<abc>> <<def>> <<xyz>>}
+
+test bind-22.1 {HandleEventGenerate} {
+ list [catch {event gen .xyz <Control-v>} msg] $msg
+} {1 {bad window path name ".xyz"}}
+test bind-22.2 {HandleEventGenerate} {
+ list [catch {event gen zzz <Control-v>} msg] $msg
+} {1 {bad window name/identifier "zzz"}}
+test bind-22.3 {HandleEventGenerate} {
+ list [catch {event gen 47 <Control-v>} msg] $msg
+} {1 {window id "47" doesn't exist in this application}}
+test bind-22.4 {HandleEventGenerate} {
+ setup
+ bind .b.f <Button> {set x "%s %b"}
+ set x {}
+ event gen [winfo id .b.f] <Control-Button-1>
+ set x
+} {4 1}
+test bind-22.5 {HandleEventGenerate} {
+ list [catch {event gen . <xyz>} msg] $msg
+} {1 {bad event type or keysym "xyz"}}
+test bind-22.6 {HandleEventGenerate} {
+ list [catch {event gen . <Double-Button-1>} msg] $msg
+} {1 {Double or Triple modifier not allowed}}
+test bind-22.7 {HandleEventGenerate} {
+ list [catch {event gen . xyz} msg] $msg
+} {1 {only one event specification allowed}}
+test bind-22.8 {HandleEventGenerate} {
+ list [catch {event gen . <Button> -button} msg] $msg
+} {1 {value for "-button" missing}}
+test bind-22.9 {HandleEventGenerate} {
+ setup
+ bind .b.f <Button> {set x "%s %b"}
+ set x {}
+ event gen .b.f <Control-Button-1>
+ set x
+} {4 1}
+test bind-22.10 {HandleEventGenerate} {
+ setup
+ bind .b.f <Key> {set x "%s %K"}
+ set x {}
+ event gen .b.f <Control-Key-1>
+ set x
+} {4 1}
+test bind-22.11 {HandleEventGenerate} {
+ setup
+ bind .b.f <<Paste>> {set x "%s"}
+ set x {}
+ event gen .b.f <<Paste>> -state 1
+ set x
+} {1}
+test bind-22.12 {HandleEventGenerate} {
+ setup
+ bind .b.f <Motion> {set x "%s"}
+ set x {}
+ event gen .b.f <Control-Motion>
+ set x
+} {4}
+test bind-22.13 {HandleEventGenerate} {
+ setup
+ bind .b.f <Button> {lappend x %#}
+ set x {}
+ event gen .b.f <Button> -when now -serial 100
+ set x
+} {100}
+test bind-22.14 {HandleEventGenerate} {
+ setup
+ bind .b.f <Button> {lappend x %#}
+ set x {}
+ event gen .b.f <Button> -when head -serial 100
+ event gen .b.f <Button> -when head -serial 101
+ event gen .b.f <Button> -when head -serial 102
+ lappend x foo
+ update
+ set x
+} {foo 102 101 100}
+test bind-22.15 {HandleEventGenerate} {
+ setup
+ bind .b.f <Button> {lappend x %#}
+ set x {}
+ event gen .b.f <Button> -when head -serial 99
+ event gen .b.f <Button> -when mark -serial 100
+ event gen .b.f <Button> -when mark -serial 101
+ event gen .b.f <Button> -when mark -serial 102
+ lappend x foo
+ update
+ set x
+} {foo 100 101 102 99}
+test bind-22.16 {HandleEventGenerate} {
+ setup
+ bind .b.f <Button> {lappend x %#}
+ set x {}
+ event gen .b.f <Button> -when head -serial 99
+ event gen .b.f <Button> -when tail -serial 100
+ event gen .b.f <Button> -when tail -serial 101
+ 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] {
+ set x [list 1 $msg]
+ }
+ set x
+ } [eval set x [lindex $check 3]]
+ incr i
+}
+test bind-23.1 {GetVirtualEventUid procedure} {
+ list [catch {event info <<asd} msg] $msg
+} {1 {virtual event "<<asd" is badly formed}}
+test bind-23.2 {GetVirtualEventUid procedure} {
+ list [catch {event info <<>>} msg] $msg
+} {1 {virtual event "<<>>" is badly formed}}
+test bind-23.3 {GetVirtualEventUid procedure} {
+ list [catch {event info <<asd>} msg] $msg
+} {1 {virtual event "<<asd>" is badly formed}}
+test bind-23.4 {GetVirtualEventUid procedure} {
+ event info <<asd>>
+} {}
+
+
+test bind-24.1 {FindSequence procedure: no event} {
+ list [catch {bind .b {} test} msg] $msg
+} {1 {no events specified in binding}}
+test bind-24.2 {FindSequence procedure: bad event} {
+ list [catch {bind .b <xyz> test} msg] $msg
+} {1 {bad event type or keysym "xyz"}}
+test bind-24.3 {FindSequence procedure: virtual allowed} {
+ bind .b.f <<Paste>> test
+} {}
+test bind-24.4 {FindSequence procedure: virtual not allowed} {
+ list [catch {event add <<Paste>> <<Alive>>} msg] $msg
+} {1 {virtual event not allowed in definition of another virtual event}}
+test bind-24.5 {FindSequence procedure, multiple bindings} {
+ setup
+ bind .b.f <1> {lappend x single}
+ bind .b.f <Double-1> {lappend x double}
+ bind .b.f <Triple-1> {lappend x triple}
+ set x press
+ event gen .b.f <Button-1>
+ lappend x press
+ event gen .b.f <Button-1>
+ lappend x press
+ event gen .b.f <Button-1>
+ lappend x press
+ event gen .b.f <Button-1>
+ set x
+} {press single press double press triple press triple}
+test bind-24.6 {FindSequence procedure: virtual composed} {
+ list [catch {bind .b <Control-b><<Paste>> "puts hi"} msg] $msg
+} {1 {virtual events may not be composed}}
+test bind-24.7 {FindSequence procedure: new pattern sequence} {
+ setup
+ bind .b.f <Button-1><Button-2> {lappend x 1-2}
+ set x {}
+ event gen .b.f <Button-1>
+ event gen .b.f <Button-2>
+ set x
+} {1-2}
+test bind-24.8 {FindSequence procedure: similar pattern sequence} {
+ setup
+ bind .b.f <Button-1><Button-2> {lappend x 1-2}
+ bind .b.f <Button-2> {lappend x 2}
+ set x {}
+ event gen .b.f <Button-3>
+ event gen .b.f <Button-2>
+ event gen .b.f <Button-1>
+ event gen .b.f <Button-2>
+ set x
+} {2 1-2}
+test bind-24.9 {FindSequence procedure: similar pattern sequence} {
+ setup
+ bind .b.f <Button-1><Button-2> {lappend x 1-2}
+ bind .b.f <Button-2><Button-2> {lappend x 2-2}
+ set x {}
+ event gen .b.f <Button-3>
+ event gen .b.f <Button-2>
+ event gen .b.f <Button-2>
+ event gen .b.f <Button-1>
+ event gen .b.f <Button-2>
+ set x
+} {2-2 1-2}
+test bind-24.10 {FindSequence procedure: similar pattern sequence} {
+ setup
+ bind .b.f <Button-2><Button-2> {lappend x 2-2}
+ bind .b.f <Double-Button-2> {lappend x d-2}
+ set x {}
+ event gen .b.f <Button-3>
+ event gen .b.f <Button-2>
+ event gen .b.f <Button-2>
+ event gen .b.f <Button-1>
+ event gen .b.f <Button-2> -x 100
+ event gen .b.f <Button-2> -x 200
+ set x
+} {d-2 2-2}
+test bind-24.11 {FindSequence procedure: new sequence, don't create} {
+ setup
+ 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}}
+test bind-25.3 {ParseEventDescription procedure} {
+ list [catch {bind .b "\x4" test} msg] $msg
+} {1 {bad ASCII character 0x4}}
+test bind-25.4 {ParseEventDescription procedure} {
+ setup
+ bind .b.f a test
+ bind .b.f a
+} {test}
+test bind-25.5 {ParseEventDescription procedure: virtual} {
+ list [catch {bind .b <<>> foo} msg] $msg
+} {1 {virtual event "<<>>" is badly formed}}
+test bind-25.6 {ParseEventDescription procedure: virtual} {
+ list [catch {bind .b <<Paste foo} msg] $msg
+} {1 {missing ">" in virtual binding}}
+test bind-25.7 {ParseEventDescription procedure: virtual} {
+ list [catch {bind .b <<Paste> foo} msg] $msg
+} {1 {missing ">" in virtual binding}}
+test bind-25.8 {ParseEventDescription procedure: correctly terminate virtual} {
+ list [catch {bind .b <<Paste>>h foo} msg] $msg
+} {1 {virtual events may not be composed}}
+test bind-25.9 {ParseEventDescription procedure} {
+ list [catch {bind .b <> test} msg] $msg
+} {1 {no event type or button # or keysym}}
+test bind-25.10 {ParseEventDescription procedure: misinterpreted modifier} {
+ button .x
+ bind .x <Control-M> a
+ bind .x <M-M> b
+ set x [lsort [bind .x]]
+ destroy .x
+ set x
+} {<Control-Key-M> <Meta-Key-M>}
+test bind-25.11 {ParseEventDescription procedure} {
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ bind .b.f <a---> {nothing}
+ bind .b.f
+} a
+test bind-25.12 {ParseEventDescription procedure} {
+ list [catch {bind .b <a-- test} msg] $msg
+} {1 {missing ">" in binding}}
+test bind-25.13 {ParseEventDescription procedure} {
+ list [catch {bind .b <a-b> test} msg] $msg
+} {1 {extra characters after detail in binding}}
+test bind-25.14 {ParseEventDescription} {
+ setup
+ list [catch {bind .b <<abc {puts hi}} msg] $msg
+} {1 {missing ">" in virtual binding}}
+test bind-25.15 {ParseEventDescription} {
+ setup
+ list [catch {bind .b <<abc> {puts hi}} msg] $msg
+} {1 {missing ">" in virtual binding}}
+test bind-25.16 {ParseEventDescription} {
+ setup
+ bind .b <<Shift-Paste>> {puts hi}
+ bind .b
+} {<<Shift-Paste>>}
+test bind-25.17 {ParseEventDescription} {
+ setup
+ list [catch {event add <<xyz>> <<abc>>} msg] $msg
+} {1 {virtual event not allowed in definition of another virtual event}}
+set i 1
+foreach check {
+ {{<Control- a>} <Control-Key-a>}
+ {<Shift-a> <Shift-Key-a>}
+ {<Lock-a> <Lock-Key-a>}
+ {<Meta---a> <Meta-Key-a>}
+ {<M-a> <Meta-Key-a>}
+ {<Alt-a> <Alt-Key-a>}
+ {<B1-a> <B1-Key-a>}
+ {<B2-a> <B2-Key-a>}
+ {<B3-a> <B3-Key-a>}
+ {<B4-a> <B4-Key-a>}
+ {<B5-a> <B5-Key-a>}
+ {<Button1-a> <B1-Key-a>}
+ {<Button2-a> <B2-Key-a>}
+ {<Button3-a> <B3-Key-a>}
+ {<Button4-a> <B4-Key-a>}
+ {<Button5-a> <B5-Key-a>}
+ {<M1-a> <Mod1-Key-a>}
+ {<M2-a> <Mod2-Key-a>}
+ {<M3-a> <Mod3-Key-a>}
+ {<M4-a> <Mod4-Key-a>}
+ {<M5-a> <Mod5-Key-a>}
+ {<Mod1-a> <Mod1-Key-a>}
+ {<Mod2-a> <Mod2-Key-a>}
+ {<Mod3-a> <Mod3-Key-a>}
+ {<Mod4-a> <Mod4-Key-a>}
+ {<Mod5-a> <Mod5-Key-a>}
+ {<Double-a> <Double-Key-a>}
+ {<Triple-a> <Triple-Key-a>}
+ {{<Double 1>} <Double-Button-1>}
+ {<Triple-1> <Triple-Button-1>}
+ {{<M1-M2 M3-M4 B1-Control-a>} <Control-B1-Mod1-Mod2-Mod3-Mod4-Key-a>}
+} {
+ test bind-25.$i {modifier names} {
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ bind .b.f [lindex $check 0] foo
+ bind .b.f
+ } [lindex $check 1]
+ bind .b.f [lindex $check 1] {}
+ incr i
+}
+
+foreach event [bind Test] {
+ bind Test $event {}
+}
+foreach event [bind all] {
+ bind all $event {}
+}
+test bind-26.1 {event names} {
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ bind .b.f <FocusIn> {nothing}
+ bind .b.f
+} <FocusIn>
+test bind-26.2 {event names} {
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ bind .b.f <FocusOut> {nothing}
+ bind .b.f
+} <FocusOut>
+test bind-26.3 {event names} {
+ setup
+ bind .b.f <Destroy> {lappend x "destroyed"}
+ set x [bind .b.f]
+ destroy .b.f
+ set x
+} {<Destroy> destroyed}
+set i 4
+foreach check {
+ {Motion Motion}
+ {Button Button}
+ {ButtonPress Button}
+ {ButtonRelease ButtonRelease}
+ {Colormap Colormap}
+ {Enter Enter}
+ {Leave Leave}
+ {Expose Expose}
+ {Key Key}
+ {KeyPress Key}
+ {KeyRelease KeyRelease}
+ {Property Property}
+ {Visibility Visibility}
+ {Activate Activate}
+ {Deactivate Deactivate}
+} {
+ set event [lindex $check 0]
+ test bind-26.$i {event names} {
+ setup
+ bind .b.f <$event> "set x {event $event}"
+ set x xyzzy
+ event gen .b.f <$event>
+ list $x [bind .b.f]
+ } [list "event $event" <[lindex $check 1]>]
+ incr i
+}
+foreach check {
+ {Circulate Circulate}
+ {Configure Configure}
+ {Gravity Gravity}
+ {Map Map}
+ {Reparent Reparent}
+ {Unmap Unmap}
+} {
+ set event [lindex $check 0]
+ test bind-26.$i {event names} {
+ setup
+ bind .b.f <$event> "set x {event $event}"
+ set x xyzzy
+ event gen .b.f <$event> -window .b.f
+ list $x [bind .b.f]
+ } [list "event $event" <[lindex $check 1]>]
+ incr i
+}
+
+
+test bind-27.1 {button names} {
+ list [catch {bind .b <Expose-1> foo} msg] $msg
+} {1 {specified button "1" for non-button event}}
+test bind-27.2 {button names} {
+ list [catch {bind .b <Button-6> foo} msg] $msg
+} {1 {specified keysym "6" for non-key event}}
+set i 3
+foreach button {1 2 3 4 5} {
+ test bind-27.$i {button names} {
+ setup
+ bind .b.f <Button-$button> "lappend x \"button $button\""
+ set x [bind .b.f]
+ event gen .b.f <Button-$button>
+ set x
+ } [list <Button-$button> "button $button"]
+ incr i
+}
+
+test bind-28.1 {keysym names} {
+ list [catch {bind .b <Expose-a> foo} msg] $msg
+} {1 {specified keysym "a" for non-key event}}
+test bind-28.2 {keysym names} {
+ list [catch {bind .b <Gorp> foo} msg] $msg
+} {1 {bad event type or keysym "Gorp"}}
+test bind-28.3 {keysym names} {
+ list [catch {bind .b <Key-Stupid> foo} msg] $msg
+} {1 {bad event type or keysym "Stupid"}}
+test bind-28.4 {keysym names} {
+ catch {destroy .b.f}
+ frame .b.f -class Test -width 150 -height 100
+ bind .b.f <a> foo
+ bind .b.f
+} a
+set i 5
+foreach check {
+ {a 0 a}
+ {space 0 <Key-space>}
+ {Return 0 <Key-Return>}
+ {X 1 X}
+} {
+ set keysym [lindex $check 0]
+ test bind-28.$i {keysym names} {
+ setup
+ bind .b.f <Key-$keysym> "lappend x \"keysym $keysym\""
+ bind .b.f <Key-x> "lappend x {bad binding match}"
+ set x [lsort [bind .b.f]]
+ event gen .b.f <Key-$keysym> -state [lindex $check 1]
+ set x
+ } [concat [lsort "x [lindex $check 2]"] "{keysym $keysym}"]
+ incr i
+}
+
+test bind-29.1 {dummy test to help ensure proper numbering} {} {}
+setup
+bind .b.f <KeyPress> {set x %K}
+set i 2
+foreach check {
+ {a 0 a}
+ {x 1 X}
+ {x 2 X}
+ {space 0 space}
+ {F1 1 F1}
+} {
+ test bind-29.$i {GetKeySym procedure} {nonPortable} {
+ set x nothing
+ event gen .b.f <KeyPress> -keysym [lindex $check 0] \
+ -state [lindex $check 1]
+ set x
+ } [lindex $check 2]
+ incr i
+}
+
+
+proc bgerror msg {
+ global x errorInfo
+ set x [list $msg $errorInfo]
+}
+test bind-30.1 {Tk_BackgroundError procedure} {
+ setup
+ bind .b.f <Button> {error "This is a test"}
+ set x none
+ event gen .b.f <Button>
+ update
+ set x
+} {{This is a test} {This is a test
+ while executing
+"error "This is a test""
+ (command bound to event)}}
+test bind-30.2 {Tk_BackgroundError procedure} {
+ proc do {} {
+ event gen .b.f <Button>
+ }
+ setup
+ bind .b.f <Button> {error Message2}
+ set x none
+ do
+ update
+ 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
diff --git a/tk/tests/bugs.tcl b/tk/tests/bugs.tcl
new file mode 100644
index 00000000000..b03dd02eff6
--- /dev/null
+++ b/tk/tests/bugs.tcl
@@ -0,0 +1,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.
+#
+# RCS: @(#) $Id$
+
+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 ""
+} {}
diff --git a/tk/tests/butGeom.tcl b/tk/tests/butGeom.tcl
new file mode 100644
index 00000000000..9d82980764c
--- /dev/null
+++ b/tk/tests/butGeom.tcl
@@ -0,0 +1,115 @@
+# 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$
+
+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
+
+label .t.l -text {This screen exercises the layout mechanisms for various flavors of buttons. Select display options below, and they will be applied to all of the button widgets. In order to see the effects of different anchor positions, expand the window so that there is extra space in the buttons. The letter "o" in "automatically" should be underlined in the right column of widgets.} -wraplength 5i
+pack .t.l -side top -fill both
+
+button .t.quit -text Quit -command {destroy .t}
+pack .t.quit -side bottom -pady 2m
+
+set sepId 1
+proc sep {} {
+ global sepId
+ frame .t.sep$sepId -height 2 -bd 1 -relief sunken
+ pack .t.sep$sepId -side top -padx 2m -pady 2m -fill x
+ incr sepId
+}
+
+# Create buttons that control configuration options.
+
+frame .t.control
+pack .t.control -side top -fill x -pady 3m
+frame .t.control.left
+frame .t.control.right
+pack .t.control.left .t.control.right -side left -expand 1 -fill x
+label .t.anchorLabel -text "Anchor:"
+frame .t.control.left.f -width 6c -height 3c
+pack .t.anchorLabel .t.control.left.f -in .t.control.left -side top
+foreach anchor {nw n ne w center e sw s se} {
+ button .t.anchor-$anchor -text $anchor -command "config -anchor $anchor"
+}
+place .t.anchor-nw -in .t.control.left.f -relx 0 -relwidth 0.333 \
+ -rely 0 -relheight 0.333
+place .t.anchor-n -in .t.control.left.f -relx 0.333 -relwidth 0.333 \
+ -rely 0 -relheight 0.333
+place .t.anchor-ne -in .t.control.left.f -relx 0.666 -relwidth 0.333 \
+ -rely 0 -relheight 0.333
+place .t.anchor-w -in .t.control.left.f -relx 0 -relwidth 0.333 \
+ -rely 0.333 -relheight 0.333
+place .t.anchor-center -in .t.control.left.f -relx 0.333 -relwidth 0.333 \
+ -rely 0.333 -relheight 0.333
+place .t.anchor-e -in .t.control.left.f -relx 0.666 -relwidth 0.333 \
+ -rely 0.333 -relheight 0.333
+place .t.anchor-sw -in .t.control.left.f -relx 0 -relwidth 0.333 \
+ -rely 0.666 -relheight 0.333
+place .t.anchor-s -in .t.control.left.f -relx 0.333 -relwidth 0.333 \
+ -rely 0.666 -relheight 0.333
+place .t.anchor-se -in .t.control.left.f -relx 0.666 -relwidth 0.333 \
+ -rely 0.666 -relheight 0.333
+
+set justify center
+radiobutton .t.justify-left -text "Justify Left" -relief flat \
+ -command "config -justify left" -variable justify \
+ -value left
+radiobutton .t.justify-center -text "Justify Center" -relief flat \
+ -command "config -justify center" -variable justify \
+ -value center
+radiobutton .t.justify-right -text "Justify Right" -relief flat \
+ -command "config -justify right" -variable justify \
+ -value right
+pack .t.justify-left .t.justify-center .t.justify-right \
+ -in .t.control.right -anchor w
+
+sep
+frame .t.f1
+pack .t.f1 -side top -expand 1 -fill both
+sep
+frame .t.f2
+pack .t.f2 -side top -expand 1 -fill both
+sep
+frame .t.f3
+pack .t.f3 -side top -expand 1 -fill both
+sep
+frame .t.f4
+pack .t.f4 -side top -expand 1 -fill both
+sep
+
+label .t.l1 -text Label -bd 2 -relief sunken
+label .t.l2 -text "Explicit\nnewlines\n\nin the text" -bd 2 -relief sunken
+label .t.l3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -bd 2 -relief sunken -underline 50
+pack .t.l1 .t.l2 .t.l3 -in .t.f1 -side left -padx 5m -pady 3m \
+ -expand y -fill both
+
+button .t.b1 -text Button
+button .t.b2 -text "Explicit\nnewlines\n\nin the text"
+button .t.b3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -underline 50
+pack .t.b1 .t.b2 .t.b3 -in .t.f2 -side left -padx 5m -pady 3m \
+ -expand y -fill both
+
+checkbutton .t.c1 -text Checkbutton -variable a
+checkbutton .t.c2 -text "Explicit\nnewlines\n\nin the text" -variable b
+checkbutton .t.c3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -variable c -underline 50
+pack .t.c1 .t.c2 .t.c3 -in .t.f3 -side left -padx 5m -pady 3m \
+ -expand y -fill both
+
+radiobutton .t.r1 -text Radiobutton -value a
+radiobutton .t.r2 -text "Explicit\nnewlines\n\nin the text" -value b
+radiobutton .t.r3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -value c -underline 50
+pack .t.r1 .t.r2 .t.r3 -in .t.f4 -side left -padx 5m -pady 3m \
+ -expand y -fill both
+
+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
+ }
+}
diff --git a/tk/tests/butGeom2.tcl b/tk/tests/butGeom2.tcl
new file mode 100644
index 00000000000..f1a074a04f8
--- /dev/null
+++ b/tk/tests/butGeom2.tcl
@@ -0,0 +1,113 @@
+# 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$
+
+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
+
+label .t.l -text {This screen exercises the color options for various flavors of buttons. Select display options below, and they will be applied to the appropiate button widgets.} -wraplength 5i
+pack .t.l -side top -fill both
+
+button .t.quit -text Quit -command {destroy .t}
+pack .t.quit -side bottom -pady 2m
+
+set sepId 1
+proc sep {} {
+ global sepId
+ frame .t.sep$sepId -height 2 -bd 1 -relief sunken
+ pack .t.sep$sepId -side top -padx 2m -pady 2m -fill x
+ incr sepId
+}
+
+# Create buttons that control configuration options.
+
+frame .t.control
+pack .t.control -side top -fill x -pady 3m
+frame .t.control.left
+frame .t.control.right
+pack .t.control.left .t.control.right -side left -expand 1 -fill x
+label .t.anchorLabel -text "Color:"
+frame .t.control.left.f -width 6c -height 3c
+pack .t.anchorLabel .t.control.left.f -in .t.control.left -side top -anchor w
+foreach opt {activebackground activeforeground background disabledforeground foreground highlightbackground highlightcolor } {
+ #button .t.color-$opt -text $opt -command "config -$opt \[tk_chooseColor]"
+ menubutton .t.color-$opt -text $opt -menu .t.color-$opt.m -indicatoron 1 \
+ -relief raised -bd 2
+ menu .t.color-$opt.m -tearoff 0
+ .t.color-$opt.m add command -label Red -command "config -$opt red"
+ .t.color-$opt.m add command -label Green -command "config -$opt green"
+ .t.color-$opt.m add command -label Blue -command "config -$opt blue"
+ .t.color-$opt.m add command -label Other... \
+ -command "config -$opt \[tk_chooseColor]"
+ pack .t.color-$opt -in .t.control.left.f -fill x
+}
+
+set default disabled
+label .t.default -text Default:
+radiobutton .t.default-normal -text "Default normal" -relief flat \
+ -command "config-but -default normal" -variable default \
+ -value normal
+radiobutton .t.default-active -text "Default active" -relief flat \
+ -command "config-but -default active" -variable default \
+ -value active
+radiobutton .t.default-disabled -text "Default disabled" -relief flat \
+ -command "config-but -default disabled" -variable default \
+ -value disabled
+pack .t.default .t.default-normal .t.default-active .t.default-disabled \
+ -in .t.control.right -anchor w
+
+sep
+frame .t.f1
+pack .t.f1 -side top -expand 1 -fill both
+sep
+frame .t.f2
+pack .t.f2 -side top -expand 1 -fill both
+sep
+frame .t.f3
+pack .t.f3 -side top -expand 1 -fill both
+sep
+frame .t.f4
+pack .t.f4 -side top -expand 1 -fill both
+sep
+
+label .t.l1 -text Label -bd 2 -relief sunken
+label .t.l2 -text "Explicit\nnewlines\n\nin the text" -bd 2 -relief sunken
+label .t.l3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -bd 2 -relief sunken -underline 50
+pack .t.l1 .t.l2 .t.l3 -in .t.f1 -side left -padx 5m -pady 3m \
+ -expand y -fill both
+
+button .t.b1 -text Button
+button .t.b2 -text "Explicit\nnewlines\n\nin the text"
+button .t.b3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -underline 50
+pack .t.b1 .t.b2 .t.b3 -in .t.f2 -side left -padx 5m -pady 3m \
+ -expand y -fill both
+
+checkbutton .t.c1 -text Checkbutton -variable a
+checkbutton .t.c2 -text "Explicit\nnewlines\n\nin the text" -variable b
+checkbutton .t.c3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -variable c -underline 50
+pack .t.c1 .t.c2 .t.c3 -in .t.f3 -side left -padx 5m -pady 3m \
+ -expand y -fill both
+
+radiobutton .t.r1 -text Radiobutton -value a
+radiobutton .t.r2 -text "Explicit\nnewlines\n\nin the text" -value b
+radiobutton .t.r3 -text "This text is quite long, so it must be wrapped automatically by Tk" -wraplength 2i -value c -underline 50
+pack .t.r1 .t.r2 .t.r3 -in .t.f4 -side left -padx 5m -pady 3m \
+ -expand y -fill both
+
+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} {
+ catch {$w configure $option $value}
+ }
+}
+
+proc config-but {option value} {
+ foreach w {.t.b1 .t.b2 .t.b3} {
+ $w configure $option $value
+ }
+}
diff --git a/tk/tests/button.test b/tk/tests/button.test
new file mode 100644
index 00000000000..2d44d5dc54d
--- /dev/null
+++ b/tk/tests/button.test
@@ -0,0 +1,822 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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 {
+ error "trace aborted"
+}
+catch {unset value}
+catch {unset value2}
+
+# Create entries in the option database to be sure that geometry options
+# like border width have predictable values.
+
+option add *Button.borderWidth 2
+option add *Button.highlightThickness 2
+option add *Button.font {Helvetica -12 bold}
+
+eval image delete [image names]
+image create test image1
+label .l -text Label
+button .b -text Button
+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
+".c toggle"}}
+
+test button-5.1 {DestroyButton procedure} {
+ image create test image1
+ button .b1 -image image1
+ button .b2 -fg #ff0000 -text "Button 2"
+ button .b3 -state active -text "Button 3"
+ button .b4 -disabledforeground #0000ff -state disabled -text "Button 4"
+ 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}
+
+test button-7.1 {ButtonEventProc procedure} {
+ catch {destroy .b1}
+ button .b1 -text "Test Button" -command {
+ destroy .b1
+ set x [list [winfo exists .b1] [info commands .b1]]
+ }
+ .b1 invoke
+ set x
+} {0 {}}
+test button-7.2 {ButtonEventProc procedure} {
+ eval destroy [winfo children .]
+ button .b1 -bg #543210
+ rename .b1 .b2
+ set x {}
+ lappend x [winfo children .]
+ lappend x [.b2 cget -bg]
+ destroy .b1
+ lappend x [info command .b*] [winfo children .]
+} {.b1 #543210 {} {}}
+
+test button-8.1 {ButtonCmdDeletedProc procedure} {
+ eval destroy [winfo children .]
+ button .b1
+ rename .b1 {}
+ list [info command .b*] [winfo children .]
+} {{} {}}
+
+test button-9.1 {TkInvokeButton procedure} {
+ catch {destroy .b1}
+ set x 0
+ checkbutton .b1 -variable x
+ set result $x
+ .b1 invoke
+ lappend result $x
+ .b1 invoke
+ lappend result $x
+} {0 1 0}
+test button-9.2 {TkInvokeButton procedure} {
+ catch {destroy .b1}
+ set x 0
+ checkbutton .b1 -variable x
+ trace variable x w bogusTrace
+ set result [list [catch {.b1 invoke} msg] $msg $x]
+ trace vdelete x w bogusTrace
+ set result
+} {1 {can't set "x": trace aborted} 1}
+test button-9.3 {TkInvokeButton procedure} {
+ catch {destroy .b1}
+ set x 1
+ checkbutton .b1 -variable x
+ trace variable x w bogusTrace
+ set result [list [catch {.b1 invoke} msg] $msg $x]
+ trace vdelete x w bogusTrace
+ set result
+} {1 {can't set "x": trace aborted} 0}
+test button-9.4 {TkInvokeButton procedure} {
+ catch {destroy .b1}
+ set x 0
+ radiobutton .b1 -variable x -value red
+ set result $x
+ .b1 invoke
+ lappend result $x
+ .b1 invoke
+ lappend result $x
+} {0 red red}
+test button-9.5 {TkInvokeButton procedure} {
+ catch {destroy .b1}
+ radiobutton .b1 -variable x -value red
+ set x green
+ trace variable x w bogusTrace
+ set result [list [catch {.b1 invoke} msg] $msg $errorInfo $x]
+ trace vdelete x w bogusTrace
+ set result
+} {1 {can't set "x": trace aborted} {can't set "x": trace aborted
+ while executing
+".b1 invoke"} red}
+test button-9.6 {TkInvokeButton procedure} {
+ eval destroy [winfo children .]
+ set result untouched
+ button .b1 -command {set result invoked}
+ list [catch {.b1 invoke} msg] $msg $result
+} {0 invoked invoked}
+test button-9.7 {TkInvokeButton procedure} {
+ eval destroy [winfo children .]
+ set result untouched
+ set x 0
+ checkbutton .b1 -variable x -command {set result "invoked $x"}
+ list [catch {.b1 invoke} msg] $msg $result
+} {0 {invoked 1} {invoked 1}}
+test button-9.8 {TkInvokeButton procedure} {
+ eval destroy [winfo children .]
+ set result untouched
+ set x 0
+ radiobutton .b1 -variable x -value red -command {set result "invoked $x"}
+ list [catch {.b1 invoke} msg] $msg $result
+} {0 {invoked red} {invoked red}}
+
+test button-10.1 {ButtonVarProc procedure} {
+ eval destroy [winfo children .]
+ set x 1
+ checkbutton .b1 -variable x
+ unset x
+ set result [info exists x]
+ .b1 toggle
+ lappend result $x
+ set x 0
+ .b1 toggle
+ lappend result $x
+} {0 1 1}
+test button-10.2 {ButtonVarProc procedure} {
+ eval destroy [winfo children .]
+ set x 0
+ checkbutton .b1 -variable x
+ set x 44
+ .b1 toggle
+ set x
+} {1}
+test button-10.3 {ButtonVarProc procedure} {
+ eval destroy [winfo children .]
+ set x 1
+ checkbutton .b1 -variable x
+ set x 44
+ .b1 toggle
+ set x
+} {1}
+test button-10.4 {ButtonVarProc procedure} {
+ eval destroy [winfo children .]
+ set x 0
+ checkbutton .b1 -variable x
+ set x 1
+ .b1 toggle
+ set x
+} {0}
+test button-10.5 {ButtonVarProc procedure} {
+ eval destroy [winfo children .]
+ set x 1
+ checkbutton .b1 -variable x
+ set x 1
+ .b1 toggle
+ set x
+} {0}
+test button-10.6 {ButtonVarProc procedure} {
+ eval destroy [winfo children .]
+ set x 0
+ checkbutton .b1 -variable x
+ set x 0
+ .b1 toggle
+ set x
+} {1}
+test button-10.7 {ButtonVarProc procedure} {
+ eval destroy [winfo children .]
+ set x 1
+ checkbutton .b1 -variable x
+ set x 0
+ .b1 toggle
+ set x
+} {1}
+test button-10.8 {ButtonVarProc procedure, can't read variable} {
+ # This test does nothing but produce a core dump if there's a prbblem.
+ eval destroy [winfo children .]
+ catch {unset a}
+ checkbutton .b1 -variable a
+ unset a
+ set a(32) 0
+ unset a
+} {}
+
+test button-11.1 {ButtonTextVarProc procedure} {
+ eval destroy [winfo children .]
+ set x Label
+ button .b1 -textvariable x
+ unset x
+ set result [list $x [lindex [.b1 configure -text] 4]]
+ set x New
+ lappend result [lindex [.b1 configure -text] 4]
+} {Label Label New}
+test button-11.2 {ButtonTextVarProc procedure} {
+ eval destroy [winfo children .]
+ set x Label
+ button .b1 -textvariable x
+ set old [winfo reqwidth .b1]
+ set x New
+ set new [winfo reqwidth .b1]
+ list [lindex [.b1 configure -text] 4] [expr $old == $new]
+} {New 0}
+
+test button-12.1 {ButtonImageProc procedure} {
+ eval destroy [winfo children .]
+ eval image delete [image names]
+ image create test image1
+ label .b1 -image image1 -padx 0 -pady 0 -bd 0
+ pack .b1
+ set result "[winfo reqwidth .b1] [winfo reqheight .b1]"
+ image1 changed 0 0 0 0 80 100
+ lappend result [winfo reqwidth .b1] [winfo reqheight .b1]
+} {30 15 80 100}
+
+eval destroy [winfo children .]
+set l [interp hidden]
+
+test button-13.1 {button widget vs hidden commands} {
+ catch {destroy .b}
+ button .b -text hello
+ interp hide {} .b
+ destroy .b
+ list [winfo children .] [interp hidden]
+} [list {} $l]
+
+eval destroy [winfo children .]
+
+option clear
+
diff --git a/tk/tests/canvImg.test b/tk/tests/canvImg.test
new file mode 100644
index 00000000000..f10115e9333
--- /dev/null
+++ b/tk/tests/canvImg.test
@@ -0,0 +1,397 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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]
+canvas .c
+pack .c
+update
+image create test foo -variable x
+image create test foo2 -variable y
+foo2 changed 0 0 0 0 80 60
+test canvImg-1.1 {options for image items} {
+ .c delete all
+ .c create image 50 50 -anchor nw -tags i1
+ .c itemconfigure i1 -anchor
+} {-anchor {} {} center nw}
+test canvImg-1.2 {options for image items} {
+ .c delete all
+ list [catch {.c create image 50 50 -anchor gorp -tags i1} msg] $msg
+} {1 {bad anchor position "gorp": must be n, ne, e, se, s, sw, w, nw, or center}}
+test canvImg-1.3 {options for image items} {
+ .c delete all
+ .c create image 50 50 -image foo -tags i1
+ .c itemconfigure i1 -image
+} {-image {} {} {} foo}
+test canvImg-1.4 {options for image items} {
+ .c delete all
+ list [catch {.c create image 50 50 -image unknown -tags i1} msg] $msg
+} {1 {image "unknown" doesn't exist}}
+test canvImg-1.5 {options for image items} {
+ .c delete all
+ .c create image 50 50 -image foo -tags {i1 foo}
+ .c itemconfigure i1 -tags
+} {-tags {} {} {} {i1 foo}}
+
+test canvImg-2.1 {CreateImage procedure} {
+ list [catch {.c create image 40} msg] $msg
+} {1 {wrong # args: should be ".c create image x y ?options?"}}
+test canvImg-2.2 {CreateImage procedure} {
+ list [catch {.c create image 40 50 60} msg] $msg
+} {1 {unknown option "60"}}
+test canvImg-2.3 {CreateImage procedure} {
+ .c delete all
+ set i [.c create image 50 50]
+ list [lindex [.c itemconf $i -anchor] 4] \
+ [lindex [.c itemconf $i -image] 4] \
+ [lindex [.c itemconf $i -tags] 4]
+} {center {} {}}
+test canvImg-2.4 {CreateImage procedure} {
+ list [catch {.c create image xyz 40} msg] $msg
+} {1 {bad screen distance "xyz"}}
+test canvImg-2.5 {CreateImage procedure} {
+ list [catch {.c create image 50 qrs} msg] $msg
+} {1 {bad screen distance "qrs"}}
+test canvImg-2.6 {CreateImage procedure} {
+ list [catch {.c create image 50 50 -gorp foo} msg] $msg
+} {1 {unknown option "-gorp"}}
+
+test canvImg-3.1 {ImageCoords procedure} {
+ .c delete all
+ .c create image 50 100 -image foo -tags i1
+ .c coords i1
+} {50.0 100.0}
+test canvImg-3.2 {ImageCoords procedure} {
+ .c delete all
+ .c create image 50 100 -image foo -tags i1
+ list [catch {.c coords i1 dumb 100} msg] $msg
+} {1 {bad screen distance "dumb"}}
+test canvImg-3.3 {ImageCoords procedure} {
+ .c delete all
+ .c create image 50 100 -image foo -tags i1
+ list [catch {.c coords i1 250 dumb0} msg] $msg
+} {1 {bad screen distance "dumb0"}}
+test canvImg-3.4 {ImageCoords procedure} {
+ .c delete all
+ .c create image 50 100 -image foo -tags i1
+ list [catch {.c coords i1 250} msg] $msg
+} {1 {wrong # coordinates: expected 0 or 2, got 1}}
+test canvImg-3.5 {ImageCoords procedure} {
+ .c delete all
+ .c create image 50 100 -image foo -tags i1
+ list [catch {.c coords i1 250 300 400} msg] $msg
+} {1 {wrong # coordinates: expected 0 or 2, got 3}}
+
+test canvImg-4.1 {ConfiugreImage procedure} {
+ .c delete all
+ .c create image 50 100 -image foo -tags i1
+ update
+ set x {}
+ .c itemconfigure i1 -image {}
+ update
+ list $x [.c bbox i1]
+} {{{foo free}} {}}
+test canvImg-4.2 {ConfiugreImage procedure} {
+ .c delete all
+ .c create image 50 100 -image foo -tags i1 -anchor nw
+ update
+ set x {}
+ set y {}
+ .c itemconfigure i1 -image foo2
+ update
+ list $x $y [.c bbox i1]
+} {{{foo free}} {{foo2 get} {foo2 display 0 0 80 60 30 30}} {50 100 130 160}}
+test canvImg-4.3 {ConfiugreImage procedure} {
+ .c delete all
+ .c create image 50 100 -image foo -tags i1 -anchor nw
+ update
+ set x {}
+ set y {}
+ list [catch {.c itemconfigure i1 -image lousy} msg] $msg
+} {1 {image "lousy" doesn't exist}}
+
+test canvImg-5.1 {DeleteImage procedure} {
+ image create test xyzzy -variable z
+ .c delete all
+ .c create image 50 100 -image xyzzy -tags i1
+ update
+ image delete xyzzy
+ set z {}
+ set names [lsort [image names]]
+ .c delete i1
+ update
+ list $names $z [lsort [image names]]
+} {{foo foo2 xyzzy} {} {foo foo2}}
+test canvImg-5.2 {DeleteImage procedure (don't delete non-existent image)} {
+ .c delete all
+ .c create image 50 100 -tags i1
+ update
+ .c delete i1
+ update
+} {}
+
+test canvImg-6.1 {ComputeImageBbox procedure} {
+ .c delete all
+ .c create image 15.51 17.51 -image foo -tags i1 -anchor nw
+ .c bbox i1
+} {16 18 46 33}
+test canvImg-6.2 {ComputeImageBbox procedure} {
+ .c delete all
+ .c create image 15.49 17.49 -image foo -tags i1 -anchor nw
+ .c bbox i1
+} {15 17 45 32}
+test canvImg-6.3 {ComputeImageBbox procedure} {
+ .c delete all
+ .c create image 20 30 -tags i1 -anchor nw
+ .c bbox i1
+} {}
+test canvImg-6.4 {ComputeImageBbox procedure} {
+ .c delete all
+ .c create image 20 30 -image foo -tags i1 -anchor nw
+ .c bbox i1
+} {20 30 50 45}
+test canvImg-6.5 {ComputeImageBbox procedure} {
+ .c delete all
+ .c create image 20 30 -image foo -tags i1 -anchor n
+ .c bbox i1
+} {5 30 35 45}
+test canvImg-6.6 {ComputeImageBbox procedure} {
+ .c delete all
+ .c create image 20 30 -image foo -tags i1 -anchor ne
+ .c bbox i1
+} {-10 30 20 45}
+test canvImg-6.7 {ComputeImageBbox procedure} {
+ .c delete all
+ .c create image 20 30 -image foo -tags i1 -anchor e
+ .c bbox i1
+} {-10 23 20 38}
+test canvImg-6.8 {ComputeImageBbox procedure} {
+ .c delete all
+ .c create image 20 30 -image foo -tags i1 -anchor se
+ .c bbox i1
+} {-10 15 20 30}
+test canvImg-6.9 {ComputeImageBbox procedure} {
+ .c delete all
+ .c create image 20 30 -image foo -tags i1 -anchor s
+ .c bbox i1
+} {5 15 35 30}
+test canvImg-6.10 {ComputeImageBbox procedure} {
+ .c delete all
+ .c create image 20 30 -image foo -tags i1 -anchor sw
+ .c bbox i1
+} {20 15 50 30}
+test canvImg-6.11 {ComputeImageBbox procedure} {
+ .c delete all
+ .c create image 20 30 -image foo -tags i1 -anchor w
+ .c bbox i1
+} {20 23 50 38}
+test canvImg-6.12 {ComputeImageBbox procedure} {
+ .c delete all
+ .c create image 20 30 -image foo -tags i1 -anchor center
+ .c bbox i1
+} {5 23 35 38}
+
+# The following test is non-portable because of differences in
+# coordinate rounding on some machines (does 0.5 round up?).
+
+test canvImg-7.1 {DisplayImage procedure} {nonPortable} {
+ .c delete all
+ .c create image 50 100 -image foo -tags i1 -anchor nw
+ update
+ set x {}
+ .c create rect 55 110 65 115 -width 1 -outline black -fill white
+ update
+ set x
+} {{foo display 4 9 12 6 30 30}}
+test canvImg-7.2 {DisplayImage procedure, no image} {
+ .c delete all
+ .c create image 50 100 -tags i1
+ update
+ .c create rect 55 110 65 115 -width 1 -outline black -fill white
+ update
+} {}
+
+set i 1
+.c delete all
+.c create image 50 100 -image foo -tags image -anchor nw
+.c create rect 10 10 20 20 -tags rect -fill black -width 0 -outline {}
+foreach check {
+ {{50 70 80 81} {70 90} {rect}}
+ {{50 70 80 79} {70 90} {image}}
+ {{99 70 110 81} {90 90} {rect}}
+ {{101 70 110 79} {90 90} {image}}
+ {{99 100 110 115} {90 110} {rect}}
+ {{101 100 110 115} {90 110} {image}}
+ {{99 134 110 145} {90 125} {rect}}
+ {{101 136 110 145} {90 125} {image}}
+ {{50 134 80 145} {70 125} {rect}}
+ {{50 136 80 145} {70 125} {image}}
+ {{20 134 31 145} {40 125} {rect}}
+ {{20 136 29 145} {40 125} {image}}
+ {{20 100 31 115} {40 110} {rect}}
+ {{20 100 29 115} {40 110} {image}}
+ {{20 70 31 80} {40 90} {rect}}
+ {{20 70 29 79} {40 90} {image}}
+ {{60 70 69 109} {70 110} {image}}
+ {{60 70 71 111} {70 110} {rect}}
+} {
+ test canvImg-8.$i {ImageToPoint procedure} {
+ eval .c coords rect [lindex $check 0]
+ .c gettags [eval .c find closest [lindex $check 1]]
+ } [lindex $check 2]
+ incr i
+}
+
+.c delete all
+.c create image 50 100 -image foo -tags image -anchor nw
+test canvImg-8.19 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 60 0 70 99]
+} {}
+test canvImg-8.20 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 60 0 70 99.999]
+} {}
+test canvImg-8.21 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 60 0 70 101]
+} {image}
+test canvImg-8.22 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 81 105 120 115]
+} {}
+test canvImg-8.23 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 80.001 105 120 115]
+} {}
+test canvImg-8.24 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 79 105 120 115]
+} {image}
+test canvImg-8.25 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 60 116 70 150]
+} {}
+test canvImg-8.26 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 60 115.001 70 150]
+} {}
+test canvImg-8.27 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 60 114 70 150]
+} {image}
+test canvImg-8.28 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 0 105 49 115]
+} {}
+test canvImg-8.29 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 0 105 50 114.999]
+} {}
+test canvImg-8.30 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 0 105 51 115]
+} {image}
+test canvImg-8.31 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 0 0 49.999 99.999]
+} {}
+test canvImg-8.32 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 0 0 51 101]
+} {image}
+test canvImg-8.33 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 80 0 150 100]
+} {}
+test canvImg-8.34 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 79 0 150 101]
+} {image}
+test canvImg-8.35 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 80.001 115.001 150 180]
+} {}
+test canvImg-8.36 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 79 114 150 180]
+} {image}
+test canvImg-8.37 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 0 115 50 180]
+} {}
+test canvImg-8.38 {ImageToArea procedure} {
+ .c gettags [.c find overlapping 0 114 51 180]
+} {image}
+test canvImg-8.39 {ImageToArea procedure} {
+ .c gettags [.c find enclosed 0 0 200 200]
+} {image}
+test canvImg-8.40 {ImageToArea procedure} {
+ .c gettags [.c find enclosed 49.999 99.999 80.001 115.001]
+} {image}
+test canvImg-8.41 {ImageToArea procedure} {
+ .c gettags [.c find enclosed 51 100 80 115]
+} {}
+test canvImg-8.42 {ImageToArea procedure} {
+ .c gettags [.c find enclosed 50 101 80 115]
+} {}
+test canvImg-8.43 {ImageToArea procedure} {
+ .c gettags [.c find enclosed 50 100 79 115]
+} {}
+test canvImg-8.44 {ImageToArea procedure} {
+ .c gettags [.c find enclosed 50 100 80 114]
+} {}
+
+test canvImg-9.1 {DisplayImage procedure} {
+ .c delete all
+ .c create image 50 100 -image foo -tags image -anchor nw
+ .c scale image 25 0 2.0 1.5
+ .c bbox image
+} {75 150 105 165}
+
+test canvImg-10.1 {TranslateImage procedure} {
+ .c delete all
+ .c create image 50 100 -image foo -tags image -anchor nw
+ update
+ set x {}
+ foo changed 2 4 6 8 30 15
+ update
+ set x
+} {{foo display 2 4 6 8 30 30}}
+
+test canvImg-11.1 {TranslateImage procedure} {
+ .c delete all
+ .c create image 50 100 -image foo -tags image -anchor nw
+ update
+ set x {}
+ foo changed 2 4 6 8 40 50
+ update
+ set x
+} {{foo display 0 0 40 50 30 30}}
+test canvImg-11.2 {ImageChangedProc procedure} {
+ .c delete all
+ image create test foo -variable x
+ .c create image 50 100 -image foo -tags image -anchor center
+ update
+ set x {}
+ foo changed 0 0 0 0 40 50
+ .c bbox image
+} {30 75 70 125}
+test canvImg-11.3 {ImageChangedProc procedure} {
+ .c delete all
+ image create test foo -variable x
+ foo changed 0 0 0 0 40 50
+ .c create image 50 100 -image foo -tags image -anchor nw
+ .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}}
diff --git a/tk/tests/canvPs.test b/tk/tests/canvPs.test
new file mode 100644
index 00000000000..98f3c950d1a
--- /dev/null
+++ b/tk/tests/canvPs.test
@@ -0,0 +1,105 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[info procs test] != "test"} {
+ source defs
+}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+wm geometry . {}
+raise .
+
+canvas .c -width 400 -height 300 -bd 2 -relief sunken
+.c create rectangle 20 20 80 80 -fill red
+pack .c
+update
+
+test canvPs-1.1 {test writing to a file} {unixOrPc} {
+ removeFile foo.ps
+ .c postscript -file foo.ps
+ file exists foo.ps
+} 1
+test canvPs-1.2 {test writing to a file, idempotency} {unixOrPc} {
+ removeFile foo.ps
+ removeFile bar.ps
+ .c postscript -file foo.ps
+ .c postscript -file bar.ps
+ set status ok
+ if {[file size bar.ps] != [file size foo.ps]} {
+ set status broken
+ }
+ set status
+} ok
+
+test canvPs-2.1 {test writing to a channel} {unixOrPc} {
+ removeFile foo.ps
+ set chan [open foo.ps w]
+ fconfigure $chan -translation lf
+ .c postscript -channel $chan
+ close $chan
+ file exists foo.ps
+} 1
+test canvPs-2.2 {test writing to channel, idempotency} {unixOrPc} {
+ removeFile foo.ps
+ removeFile bar.ps
+ set c1 [open foo.ps w]
+ set c2 [open bar.ps w]
+ fconfigure $c1 -translation lf
+ fconfigure $c2 -translation lf
+ .c postscript -channel $c1
+ .c postscript -channel $c2
+ close $c1
+ close $c2
+ set status ok
+ if {[file size bar.ps] != [file size foo.ps]} {
+ set status broken
+ }
+ set status
+} ok
+test canvPs-2.3 {test writing to channel and file, same output} {unixOnly} {
+ removeFile foo.ps
+ removeFile bar.ps
+ set c1 [open foo.ps w]
+ fconfigure $c1 -translation lf
+ .c postscript -channel $c1
+ close $c1
+ .c postscript -file bar.ps
+ set status ok
+ if {[file size foo.ps] != [file size bar.ps]} {
+ set status broken
+ }
+ set status
+} ok
+test canvPs-2.4 {test writing to channel and file, same output} {pcOnly} {
+ removeFile foo.ps
+ removeFile bar.ps
+ set c1 [open foo.ps w]
+ fconfigure $c1 -translation crlf
+ .c postscript -channel $c1
+ close $c1
+ .c postscript -file bar.ps
+ 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
+}
diff --git a/tk/tests/canvPsArc.tcl b/tk/tests/canvPsArc.tcl
new file mode 100644
index 00000000000..00ff211872a
--- /dev/null
+++ b/tk/tests/canvPsArc.tcl
@@ -0,0 +1,45 @@
+# 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$
+
+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
+
+set c .t.c
+
+message .t.m -text {This screen exercises the Postscript-generation abilities of Tk canvas widgets for arcs. Click on "Print" to print the canvas to your default printer. You can click on items in the canvas to delete them.} -width 6i
+pack .t.m -side top -fill both
+
+frame .t.bot
+pack .t.bot -side bottom -fill both
+button .t.bot.quit -text Quit -command {destroy .t}
+button .t.bot.print -text Print -command "lpr $c"
+pack .t.bot.print .t.bot.quit -side left -pady 1m -expand 1
+
+canvas $c -width 6i -height 6i -bd 2 -relief sunken
+pack $c -expand yes -fill both -padx 2m -pady 2m
+
+$c create arc .5i .5i 2i 2i -style pieslice -start 20 -extent 90 \
+ -fill black -outline {}
+$c create arc 2.5i 0 4.5i 1i -style pieslice -start -45 -extent -135 \
+ -fill {} -outline black -outlinestipple gray50 -width 3m
+$c create arc 5.0i .5i 6.5i 2i -style pieslice -start 45 -extent 315 \
+ -fill black -stipple gray25 -outline black -width 1m
+
+$c create arc -.5i 2.5i 2.0i 3.5i -style chord -start 90 -extent 270 \
+ -fill black -outline {}
+$c create arc 2.5i 2i 4i 6i -style chord -start 20 -extent 140 \
+ -fill black -stipple gray50 -outline black -width 2m
+$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
diff --git a/tk/tests/canvPsBmap.tcl b/tk/tests/canvPsBmap.tcl
new file mode 100644
index 00000000000..241b7bc9ef1
--- /dev/null
+++ b/tk/tests/canvPsBmap.tcl
@@ -0,0 +1,71 @@
+# 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$
+
+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
+
+set c .t.c
+
+message .t.m -text {This screen exercises the Postscript-generation abilities of Tk canvas widgets for bitmaps. Click on "Print" to print the canvas to your default printer. You can click on items in the canvas to delete them.} -width 6i
+pack .t.m -side top -fill both
+
+frame .t.bot
+pack .t.bot -side bottom -fill both
+button .t.bot.quit -text Quit -command {destroy .t}
+button .t.bot.print -text Print -command "lpr $c"
+pack .t.bot.print .t.bot.quit -side left -pady 1m -expand 1
+
+canvas $c -width 6i -height 6i -bd 2 -relief sunken
+pack $c -expand yes -fill both -padx 2m -pady 2m
+
+$c create bitmap 0.5i 0.5i \
+ -bitmap @[file join $tk_library demos/images/flagdown.bmp] \
+ -background {} -foreground black -anchor nw
+$c create rect 0.47i 0.47i 0.53i 0.53i -fill {} -outline black
+
+$c create bitmap 3.0i 0.5i \
+ -bitmap @[file join $tk_library demos/images/flagdown.bmp] \
+ -background {} -foreground black -anchor n
+$c create rect 2.97i 0.47i 3.03i 0.53i -fill {} -outline black
+
+$c create bitmap 5.5i 0.5i \
+ -bitmap @[file join $tk_library demos/images/flagdown.bmp] \
+ -background black -foreground white -anchor ne
+$c create rect 5.47i 0.47i 5.53i 0.53i -fill {} -outline black
+
+$c create bitmap 0.5i 3.0i \
+ -bitmap @[file join $tk_library demos/images/face.bmp] \
+ -background {} -foreground black -anchor w
+$c create rect 0.47i 2.97i 0.53i 3.03i -fill {} -outline black
+
+$c create bitmap 3.0i 3.0i \
+ -bitmap @[file join $tk_library demos/images/face.bmp] \
+ -background {} -foreground black -anchor center
+$c create rect 2.97i 2.97i 3.03i 3.03i -fill {} -outline black
+
+$c create bitmap 5.5i 3.0i \
+ -bitmap @[file join $tk_library demos/images/face.bmp] \
+ -background blue -foreground black -anchor e
+$c create rect 5.47i 2.97i 5.53i 3.03i -fill {} -outline black
+
+$c create bitmap 0.5i 5.5i \
+ -bitmap @[file join $tk_library demos/images/flagup.bmp] \
+ -background black -foreground white -anchor sw
+$c create rect 0.47i 5.47i 0.53i 5.53i -fill {} -outline black
+
+$c create bitmap 3.0i 5.5i \
+ -bitmap @[file join $tk_library demos/images/flagup.bmp] \
+ -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
diff --git a/tk/tests/canvPsGrph.tcl b/tk/tests/canvPsGrph.tcl
new file mode 100644
index 00000000000..8a2ddb7e875
--- /dev/null
+++ b/tk/tests/canvPsGrph.tcl
@@ -0,0 +1,87 @@
+# 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$
+
+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
+
+set c .t.mid.c
+
+message .t.m -text {This screen exercises the Postscript-generation abilities of Tk canvas widgets. Select what you want to display with the buttons below, then click on "Print" to print it to your default printer. You can click on items in the canvas to delete them.} -width 4i
+pack .t.m -side top -fill both
+
+frame .t.top
+pack .t.top -side top -fill both
+set what rect
+radiobutton .t.top.rect -text Rectangles -variable what -value rect \
+ -command "mkObjs $c" -relief flat
+radiobutton .t.top.oval -text Ovals -variable what -value oval \
+ -command "mkObjs $c" -relief flat
+radiobutton .t.top.poly -text Polygons -variable what -value poly \
+ -command "mkObjs $c" -relief flat
+radiobutton .t.top.line -text Lines -variable what -value line \
+ -command "mkObjs $c" -relief flat
+pack .t.top.rect .t.top.oval .t.top.poly .t.top.line \
+ -side left -pady 2m -ipadx 2m -ipady 1m -expand 1
+
+frame .t.bot
+pack .t.bot -side bottom -fill both
+button .t.bot.quit -text Quit -command {destroy .t}
+button .t.bot.print -text Print -command "lpr $c"
+pack .t.bot.print .t.bot.quit -side left -pady 1m -expand 1
+
+frame .t.mid -relief sunken -bd 2
+pack .t.mid -side top -expand yes -fill both -padx 2m -pady 2m
+canvas $c -width 400 -height 350 -bd 0 -relief sunken
+pack $c -expand yes -fill both -padx 1 -pady 1
+
+proc mkObjs c {
+ global what
+ $c delete all
+ if {$what == "rect"} {
+ $c create rect 0 0 400 350 -outline black
+ $c create rect 2 2 100 50 -fill black -stipple gray25
+ $c create rect -20 180 80 320 -fill black -stipple gray50 -width .5c
+ $c create rect 200 -20 240 20 -fill black
+ $c create rect 380 200 420 240 -fill black
+ $c create rect 200 330 240 370 -fill black
+ }
+
+ if {$what == "oval"} {
+ $c create oval 50 10 150 80 -fill black -stipple gray25 -outline {}
+ $c create oval 100 100 200 150 -outline {} -fill black -stipple gray50
+ $c create oval 250 100 400 300 -width .5c
+ }
+
+ if {$what == "poly"} {
+ $c create poly 100 200 200 50 300 200 -smooth yes -stipple gray25 \
+ -outline black -width 4
+ $c create poly 100 300 100 250 350 250 350 300 350 300 100 300 100 300 \
+ -fill red -smooth yes
+ $c create poly 20 10 40 10 40 60 80 60 80 25 30 25 30 \
+ 35 50 35 50 45 20 45
+ $c create poly 300 20 300 120 380 80 320 100 -fill blue -outline black
+ $c create poly 20 200 100 220 90 100 40 250 \
+ -fill {} -outline brown -width 3
+ }
+
+ if {$what == "line"} {
+ $c create line 20 20 120 20 -arrow both -width 5
+ $c create line 20 80 150 80 20 200 150 200 -smooth yes
+ $c create line 150 20 150 150 250 150 -width .5c -smooth yes \
+ -arrow both -arrowshape {.75c 1.0c .5c} -stipple gray25
+ $c create line 50 340 100 250 150 340 -join round -cap round -width 10
+ $c create line 200 340 250 250 300 340 -join bevel -cap project \
+ -width 10
+ $c create line 300 20 380 20 300 150 380 150 -join miter -cap butt \
+ -width 10 -stipple gray25
+ }
+}
+
+mkObjs $c
diff --git a/tk/tests/canvPsText.tcl b/tk/tests/canvPsText.tcl
new file mode 100644
index 00000000000..2274f36b9e3
--- /dev/null
+++ b/tk/tests/canvPsText.tcl
@@ -0,0 +1,83 @@
+# 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$
+
+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
+
+set c .t.c
+
+message .t.m -text {This screen exercises the Postscript-generation abilities of Tk canvas widgets for text. Click on "Print" to print the canvas to your default printer. The "Stipple" button can be used to turn stippling on and off for the text, but beware: many Postscript printers cannot handle stippled text. You can click on items in the canvas to delete them.} -width 6i
+pack .t.m -side top -fill both
+
+set stipple {}
+checkbutton .t.stipple -text Stippling -variable stipple -onvalue gray50 \
+ -offvalue {} -command "setStipple $c" -relief flat
+pack .t.stipple -side top -pady 2m -expand 1 -anchor w
+
+frame .t.bot
+pack .t.bot -side bottom -fill both
+button .t.bot.quit -text Quit -command {destroy .t}
+button .t.bot.print -text Print -command "lpr $c"
+pack .t.bot.print .t.bot.quit -side left -pady 1m -expand 1
+
+canvas $c -width 6i -height 7i -bd 2 -relief sunken
+pack $c -expand yes -fill both -padx 2m -pady 2m
+
+$c create rect 2.95i 0.45i 3.05i 0.55i -fill {} -outline black
+$c create text 3.0i 0.5i -text "Center Courier Oblique 24" \
+ -anchor center -tags text -font {Courier 24 italic} -stipple $stipple
+$c create rect 2.95i 0.95i 3.05i 1.05i -fill {} -outline black
+$c create text 3.0i 1.0i -text "Northwest Helvetica 24" \
+ -anchor nw -tags text -font {Helvetica 24} -stipple $stipple
+$c create rect 2.95i 1.45i 3.05i 1.55i -fill {} -outline black
+$c create text 3.0i 1.5i -text "North Helvetica Oblique 12 " \
+ -anchor n -tags text -font {Helvetica 12 italic} -stipple $stipple
+$c create rect 2.95i 1.95i 3.05i 2.05i -fill {} -outline blue
+$c create text 3.0i 2.0i -text "Northeast Helvetica Bold 24" \
+ -anchor ne -tags text -font {Helvetica 24 bold} -stipple $stipple
+$c create rect 2.95i 2.45i 3.05i 2.55i -fill {} -outline black
+$c create text 3.0i 2.5i -text "East Helvetica Bold Oblique 18" \
+ -anchor e -tags text -font {Helvetica 18 {bold italic}} -stipple $stipple
+$c create rect 2.95i 2.95i 3.05i 3.05i -fill {} -outline black
+$c create text 3.0i 3.0i -text "Southeast Times 10" \
+ -anchor se -tags text -font {Times 10} -stipple $stipple
+$c create rect 2.95i 3.45i 3.05i 3.55i -fill {} -outline black
+$c create text 3.0i 3.5i -text "South Times Italic 24" \
+ -anchor s -tags text -font {Times 24 italic} -stipple $stipple
+$c create rect 2.95i 3.95i 3.05i 4.05i -fill {} -outline black
+$c create text 3.0i 4.0i -text "Southwest Times Bold 18" \
+ -anchor sw -tags text -font {Times 18 bold} -stipple $stipple
+$c create rect 2.95i 4.45i 3.05i 4.55i -fill {} -outline black
+$c create text 3.0i 4.5i -text "West Times Bold Italic 24"\
+ -anchor w -tags text -font {Times 24 {bold italic}} -stipple $stipple
+
+$c create rect 0.95i 5.20i 1.05i 5.30i -fill {} -outline black
+$c create text 1.0i 5.25i -width 1.9i -anchor c -justify left -tags text \
+ -font {Times 18 bold} -stipple $stipple \
+ -text "This is a sample text item to see how left justification works"
+$c create rect 2.95i 5.20i 3.05i 5.30i -fill {} -outline black
+$c create text 3.0i 5.25i -width 1.8i -anchor c -justify center -tags text \
+ -font {Times 18 bold} -stipple $stipple \
+ -text "This is a sample text item to see how center justification works"
+$c create rect 4.95i 5.20i 5.05i 5.30i -fill {} -outline black
+$c create text 5.0i 5.25i -width 1.8i -anchor c -justify right -tags text \
+ -font {Times 18 bold} -stipple $stipple \
+ -text "This is a sample text item to see how right justification works"
+
+$c create text 3.0i 6.0i -width 5.0i -anchor n -justify right -tags text \
+ -text "This text is\nright justified\nwith a line length equal to\n\
+ the size of the enclosing rectangle.\nMake sure it prints right\
+ 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
+}
diff --git a/tk/tests/canvRect.test b/tk/tests/canvRect.test
new file mode 100644
index 00000000000..28018935549
--- /dev/null
+++ b/tk/tests/canvRect.test
@@ -0,0 +1,329 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[info procs test] != "test"} {
+ source defs
+}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+wm geometry . {}
+raise .
+
+canvas .c -width 400 -height 300 -bd 2 -relief sunken
+pack .c
+bind .c <1> {
+ puts "button down at (%x,%y)"
+}
+update
+
+set i 1
+.c create rectangle 20 20 80 80 -tag test
+foreach test {
+ {-fill #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
+ {-outline #123456 #123456 bad_color {unknown color name "bad_color"}}
+ {-stipple gray50 gray50 bogus {bitmap "bogus" not defined}}
+ {-tags {test a b c} {test a b c} {} {}}
+ {-width 6 6 abc {bad screen distance "abc"}}
+} {
+ set name [lindex $test 0]
+ test canvRect-1.$i {configuration options} {
+ .c itemconfigure test $name [lindex $test 1]
+ list [lindex [.c itemconfigure test $name] 4] [.c itemcget test $name]
+ } [list [lindex $test 2] [lindex $test 2]]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test canvRect-1.$i {configuration options} {
+ list [catch {.c itemconfigure test $name [lindex $test 3]} msg] $msg
+ } [list 1 [lindex $test 4]]
+ }
+ incr i
+}
+test canvRect-1.$i {configuration options} {
+ .c itemconfigure test -tags {test xyz}
+ .c itemcget xyz -tags
+} {test xyz}
+
+test canvRect-2.1 {CreateRectOval procedure} {
+ list [catch {.c create rect} msg] $msg
+} {1 {wrong # args: should be ".c create rectangle x1 y1 x2 y2 ?options?"}}
+test canvRect-2.2 {CreateRectOval procedure} {
+ list [catch {.c create oval x y z} msg] $msg
+} {1 {wrong # args: should be ".c create oval x1 y1 x2 y2 ?options?"}}
+test canvRect-2.3 {CreateRectOval procedure} {
+ list [catch {.c create rectangle x 2 3 4} msg] $msg
+} {1 {bad screen distance "x"}}
+test canvRect-2.4 {CreateRectOval procedure} {
+ list [catch {.c create rectangle 1 y 3 4} msg] $msg
+} {1 {bad screen distance "y"}}
+test canvRect-2.5 {CreateRectOval procedure} {
+ list [catch {.c create rectangle 1 2 z 4} msg] $msg
+} {1 {bad screen distance "z"}}
+test canvRect-2.6 {CreateRectOval procedure} {
+ list [catch {.c create rectangle 1 2 3 q} msg] $msg
+} {1 {bad screen distance "q"}}
+test canvRect-2.7 {CreateRectOval procedure} {
+ .c create rectangle 1 2 3 4 -tags x
+ set result {}
+ foreach element [.c coords x] {
+ lappend result [format %.1f $element]
+ }
+ set result
+} {1.0 2.0 3.0 4.0}
+test canvRect-2.8 {CreateRectOval procedure} {
+ list [catch {.c create rectangle 1 2 3 4 -gorp foo} msg] $msg
+} {1 {unknown option "-gorp"}}
+
+.c delete withtag all
+.c create rectangle 10 20 30 40 -tags x
+test canvRect-3.1 {RectOvalCoords procedure} {
+ set result {}
+ foreach element [.c coords x] {
+ lappend result [format %.1f $element]
+ }
+ set result
+} {10.0 20.0 30.0 40.0}
+test canvRect-3.2 {RectOvalCoords procedure} {
+ list [catch {.c coords x a 2 3 4} msg] $msg
+} {1 {bad screen distance "a"}}
+test canvRect-3.3 {RectOvalCoords procedure} {
+ list [catch {.c coords x 1 b 3 4} msg] $msg
+} {1 {bad screen distance "b"}}
+test canvRect-3.4 {RectOvalCoords procedure} {
+ list [catch {.c coords x 1 2 c 4} msg] $msg
+} {1 {bad screen distance "c"}}
+test canvRect-3.5 {RectOvalCoords procedure} {
+ list [catch {.c coords x 1 2 3 d} msg] $msg
+} {1 {bad screen distance "d"}}
+test canvRect-3.6 {RectOvalCoords procedure} {nonPortable} {
+ # Non-portable due to rounding differences.
+ .c coords x 10 25 15 40
+ .c bbox x
+} {9 24 16 41}
+test canvRect-3.7 {RectOvalCoords procedure} {
+ list [catch {.c coords x 1 2 3 4 5} msg] $msg
+} {1 {wrong # coordinates: expected 0 or 4, got 5}}
+
+.c delete withtag all
+.c create rectangle 10 20 30 40 -tags x -width 1
+test canvRect-4.1 {ConfigureRectOval procedure} {
+ list [catch {.c itemconfigure x -width abc} msg] $msg \
+ [.c itemcget x -width]
+} {1 {bad screen distance "abc"} 1}
+test canvRect-4.2 {ConfigureRectOval procedure} {
+ .c itemconfigure x -width -5
+ .c itemcget x -width
+} {1}
+test canvRect-4.3 {ConfigureRectOval procedure} {nonPortable} {
+ # Non-portable due to rounding differences.
+ .c itemconfigure x -width 10
+ .c bbox x
+} {5 15 35 45}
+# I can't come up with any good tests for DeleteRectOval.
+
+.c delete withtag all
+.c create rectangle 10 20 30 40 -tags x -width 1 -outline {}
+test canvRect-5.1 {ComputeRectOvalBbox procedure} {nonPortable} {
+ # Non-portable due to rounding differences:
+ .c coords x 20 15 10 5
+ .c bbox x
+} {10 5 20 15}
+test canvRect-5.2 {ComputeRectOvalBbox procedure} {nonPortable} {
+ # Non-portable due to rounding differences:
+ .c coords x 10 20 30 10
+ .c itemconfigure x -width 1 -outline red
+ .c bbox x
+} {9 9 31 21}
+test canvRect-5.3 {ComputeRectOvalBbox procedure} {nonPortable} {
+ # Non-portable due to rounding differences:
+ .c coords x 10 20 30 10
+ .c itemconfigure x -width 2 -outline red
+ .c bbox x
+} {9 9 31 21}
+test canvRect-5.4 {ComputeRectOvalBbox procedure} {nonPortable} {
+ # Non-portable due to rounding differences:
+ .c coords x 10 20 30 10
+ .c itemconfigure x -width 3 -outline red
+ .c bbox x
+} {8 8 32 22}
+
+# I can't come up with any good tests for DisplayRectOval.
+
+.c delete withtag all
+set x [.c create rectangle 10 20 30 35 -tags x -fill green]
+set y [.c create rectangle 15 25 25 30 -tags y -fill red]
+test canvRect-6.1 {RectToPoint procedure} {
+ .c itemconfigure y -outline {}
+ list [.c find closest 14.9 28] [.c find closest 15.1 28] \
+ [.c find closest 24.9 28] [.c find closest 25.1 28]
+} "$x $y $y $x"
+test canvRect-6.2 {RectToPoint procedure} {
+ .c itemconfigure y -outline {}
+ list [.c find closest 20 24.9] [.c find closest 20 25.1] \
+ [.c find closest 20 29.9] [.c find closest 20 30.1]
+} "$x $y $y $x"
+test canvRect-6.3 {RectToPoint procedure} {
+ .c itemconfigure y -width 1 -outline black
+ list [.c find closest 14.4 28] [.c find closest 14.6 28] \
+ [.c find closest 25.4 28] [.c find closest 25.6 28]
+} "$x $y $y $x"
+test canvRect-6.4 {RectToPoint procedure} {
+ .c itemconfigure y -width 1 -outline black
+ list [.c find closest 20 24.4] [.c find closest 20 24.6] \
+ [.c find closest 20 30.4] [.c find closest 20 30.6]
+} "$x $y $y $x"
+.c itemconfigure x -fill {} -outline black -width 3
+.c itemconfigure y -outline {}
+test canvRect-6.5 {RectToPoint procedure} {
+ list [.c find closest 13.2 28] [.c find closest 13.3 28] \
+ [.c find closest 26.7 28] [.c find closest 26.8 28]
+} "$x $y $y $x"
+test canvRect-6.6 {RectToPoint procedure} {
+ list [.c find closest 20 23.2] [.c find closest 20 23.3] \
+ [.c find closest 20 31.7] [.c find closest 20 31.8]
+} "$x $y $y $x"
+.c delete withtag all
+set x [.c create rectangle 10 20 30 40 -outline {} -fill black]
+set y [.c create rectangle 40 40 50 50 -outline {} -fill black]
+test canvRect-6.7 {RectToPoint procedure} {
+ list [.c find closest 35 35] [.c find closest 36 36] \
+ [.c find closest 37 37] [.c find closest 38 38]
+} "$x $y $y $y"
+
+.c delete withtag all
+set x [.c create rectangle 10 20 30 35 -fill green -outline {}]
+set y [.c create rectangle 40 45 60 70 -fill red -outline black -width 3]
+set z [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3]
+test canvRect-7.1 {RectToArea procedure} {
+ list [.c find overlapping 20 50 38 60] \
+ [.c find overlapping 20 50 39 60] \
+ [.c find overlapping 20 50 70 60] \
+ [.c find overlapping 61 50 70 60] \
+ [.c find overlapping 62 50 70 60]
+} "{} $y $y $y {}"
+test canvRect-7.2 {RectToArea procedure} {
+ list [.c find overlapping 45 20 55 43] \
+ [.c find overlapping 45 20 55 44] \
+ [.c find overlapping 45 20 55 80] \
+ [.c find overlapping 45 71 55 80] \
+ [.c find overlapping 45 72 55 80]
+} "{} $y $y $y {}"
+test canvRect-7.3 {RectToArea procedure} {
+ list [.c find overlapping 5 25 9.9 30] [.c find overlapping 5 25 10.1 30]
+} "{} $x"
+test canvRect-7.4 {RectToArea procedure} {
+ list [.c find overlapping 102 152 118 168] \
+ [.c find overlapping 101 152 118 168] \
+ [.c find overlapping 102 151 118 168] \
+ [.c find overlapping 102 152 119 168] \
+ [.c find overlapping 102 152 118 169]
+} "{} $z $z $z $z"
+test canvRect-7.5 {RectToArea procedure} {
+ list [.c find enclosed 20 40 38 80] \
+ [.c find enclosed 20 40 39 80] \
+ [.c find enclosed 20 40 70 80] \
+ [.c find enclosed 61 40 70 80] \
+ [.c find enclosed 62 40 70 80]
+} "{} {} $y {} {}"
+test canvRect-7.6 {RectToArea procedure} {
+ list [.c find enclosed 20 20 65 43] \
+ [.c find enclosed 20 20 65 44] \
+ [.c find enclosed 20 20 65 80] \
+ [.c find enclosed 20 71 65 80] \
+ [.c find enclosed 20 72 65 80]
+} "{} {} $y {} {}"
+
+.c delete withtag all
+set x [.c create oval 50 100 200 150 -fill green -outline {}]
+set y [.c create oval 50 100 200 150 -fill red -outline black -width 3]
+set z [.c create oval 50 100 200 150 -fill {} -outline black -width 3]
+test canvRect-8.1 {OvalToArea procedure} {
+ list [.c find overlapping 20 120 48 130] \
+ [.c find overlapping 20 120 49 130] \
+ [.c find overlapping 20 120 50.2 130] \
+ [.c find overlapping 20 120 300 130] \
+ [.c find overlapping 60 120 190 130] \
+ [.c find overlapping 199.9 120 300 130] \
+ [.c find overlapping 201 120 300 130] \
+ [.c find overlapping 202 120 300 130]
+} "{} {$y $z} {$x $y $z} {$x $y $z} {$x $y} {$x $y $z} {$y $z} {}"
+test canvRect-8.2 {OvalToArea procedure} {
+ list [.c find overlapping 100 50 150 98] \
+ [.c find overlapping 100 50 150 99] \
+ [.c find overlapping 100 50 150 100.1] \
+ [.c find overlapping 100 50 150 200] \
+ [.c find overlapping 100 110 150 140] \
+ [.c find overlapping 100 149.9 150 200] \
+ [.c find overlapping 100 151 150 200] \
+ [.c find overlapping 100 152 150 200]
+} "{} {$y $z} {$x $y $z} {$x $y $z} {$x $y} {$x $y $z} {$y $z} {}"
+test canvRect-8.3 {OvalToArea procedure} {
+ list [.c find overlapping 176 104 177 105] \
+ [.c find overlapping 187 116 188 117] \
+ [.c find overlapping 192 142 193 143] \
+ [.c find overlapping 180 138 181 139] \
+ [.c find overlapping 61 142 62 143] \
+ [.c find overlapping 65 137 66 136] \
+ [.c find overlapping 62 108 63 109] \
+ [.c find overlapping 68 115 69 116]
+} "{} {$x $y} {} {$x $y} {} {$x $y} {} {$x $y}"
+
+test canvRect-9.1 {ScaleRectOval procedure} {
+ .c delete withtag all
+ .c create rect 100 300 200 350 -tags x
+ .c scale x 50 100 2 4
+ .c coords x
+} {150.0 900.0 350.0 1100.0}
+
+test canvRect-10.1 {TranslateRectOval procedure} {
+ .c delete withtag all
+ .c create rect 100 300 200 350 -tags x
+ .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
+ update
+ set x [.c postscript]
+ string range $x [string first "-200 -150 translate" $x] end
+} {-200 -150 translate
+0 300 moveto 400 300 lineto 400 0 lineto 0 0 lineto closepath clip newpath
+gsave
+50 240 moveto 40 0 rlineto 0 -20 rlineto -40 0 rlineto closepath
+0.000 0.000 0.000 setrgbcolor AdjustColor
+clip 16 16 <5555aaaa5555aaaa5555aaaa5555aaaa5555aaaa5555aaaa5555aaaa5555
+aaaa> StippleFill
+grestore
+gsave
+matrix currentmatrix
+150 125 translate 50 25 scale 1 0 moveto 0 0 1 0 360 arc
+setmatrix
+5 setlinewidth 0 setlinejoin 2 setlinecap
+1.000 0.000 0.000 setrgbcolor AdjustColor
+stroke
+grestore
+restore showpage
+
+%%Trailer
+end
+%%EOF
+}
diff --git a/tk/tests/canvText.test b/tk/tests/canvText.test
new file mode 100644
index 00000000000..b9d2afec87d
--- /dev/null
+++ b/tk/tests/canvText.test
@@ -0,0 +1,493 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {"[info procs test]" != "test"} {
+ source defs
+}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+wm geometry . {}
+raise .
+
+canvas .c -width 400 -height 300 -bd 2 -relief sunken
+pack .c
+update
+
+set i 1
+.c create text 20 20 -tag test
+
+set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*"
+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"}}
+} {
+ set name [lindex $test 0]
+ test canvText-1.$i {configuration options} {
+ .c itemconfigure test $name [lindex $test 1]
+ list [lindex [.c itemconfigure test $name] 4] [.c itemcget test $name]
+ } [list [lindex $test 2] [lindex $test 2]]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test canvText-1.$i {configuration options} {
+ list [catch {.c itemconfigure test $name [lindex $test 3]} msg] $msg
+ } [list 1 [lindex $test 4]]
+ }
+ incr i
+}
+test canvText-1.$i {configuration options} {
+ .c itemconfigure test -tags {test xyz}
+ .c itemcget xyz -tags
+} {test xyz}
+
+.c delete test
+.c create text 20 20 -tag test
+
+test canvText-2.1 {CreateText procedure: args} {
+ list [catch {.c create text} msg] $msg
+} {1 {wrong # args: should be ".c create text x y ?options?"}}
+test canvText-2.2 {CreateText procedure: args} {
+ list [catch {.c create text xyz 0} msg] $msg
+} {1 {bad screen distance "xyz"}}
+test canvText-2.3 {CreateText procedure: args} {
+ list [catch {.c create text 0 xyz} msg] $msg
+} {1 {bad screen distance "xyz"}}
+test canvText-2.4 {CreateText procedure: args} {
+ list [catch {.c create text 0 0 -xyz xyz} msg] $msg
+} {1 {unknown option "-xyz"}}
+test canvText-2.5 {CreateText procedure} {
+ .c create text 0 0 -tags x
+ set x [.c coords x]
+ .c delete x
+ set x
+} {0.0 0.0}
+
+focus -force .c
+.c focus test
+.c coords test 0 0
+update
+
+test canvText-3.1 {TextCoords procedure} {
+ .c coords test
+} {0.0 0.0}
+test canvText-3.2 {TextCoords procedure} {
+ list [catch {.c coords test xyz 0} msg] $msg
+} {1 {bad screen distance "xyz"}}
+test canvText-3.3 {TextCoords procedure} {
+ list [catch {.c coords test 0 xyz} msg] $msg
+} {1 {bad screen distance "xyz"}}
+test canvText-3.4 {TextCoords procedure} {
+ .c coords test 10 10
+ set result {}
+ foreach element [.c coords test] {
+ lappend result [format %.1f $element]
+ }
+ set result
+} {10.0 10.0}
+test canvText-3.5 {TextCoords procedure} {
+ list [catch {.c coords test 10} msg] $msg
+} {1 {wrong # coordinates: expected 0 or 2, got 1}}
+test canvText-3.6 {TextCoords procedure} {
+ list [catch {.c coords test 10 10 10} msg] $msg
+} {1 {wrong # coordinates: expected 0 or 2, got 3}}
+
+test canvText-4.1 {ConfigureText procedure} {
+ list [catch {.c itemconfig test -fill xyz} msg] $msg
+} {1 {unknown color name "xyz"}}
+test canvText-4.2 {ConfigureText procedure} {
+ .c itemconfig test -fill blue
+ .c itemcget test -fill
+} {blue}
+test canvText-4.3 {ConfigureText procedure: construct font gcs} {
+ .c itemconfig test -font "times 20" -fill black -stipple gray50
+ list [.c itemcget test -font] [.c itemcget test -fill] [.c itemcget test -stipple]
+} {{times 20} black gray50}
+test canvText-4.4 {ConfigureText procedure: construct cursor gc} {
+ .c itemconfig test -text "abcdefg"
+ .c select from test 2
+ .c select to test 4
+ .c icursor test 3
+
+ # Both black -> cursor becomes white.
+ .c config -insertbackground black
+ .c config -selectbackground black
+ .c itemconfig test -just left
+ update
+
+ # Both same color (and not black) -> cursor becomes black.
+ .c config -insertbackground red
+ .c config -selectbackground red
+ .c itemconfig test -just left
+ update
+} {}
+test canvText-4.5 {ConfigureText procedure: adjust selection} {
+ set x {}
+ .c itemconfig test -text "abcdefghi"
+ .c select from test 2
+ .c select to test 6
+ lappend x [selection get]
+ .c dchars test 1 end
+ lappend x [catch {selection get}]
+ .c insert test end "bcdefghi"
+ .c select from test 2
+ .c select to test 6
+ lappend x [selection get]
+ .c dchars test 4 end
+ lappend x [selection get]
+ .c insert test end "efghi"
+ .c select from test 6
+ .c select to test 2
+ lappend x [selection get]
+ .c dchars test 4 end
+ lappend x [selection get]
+} {cdefg 1 cdefg cd cdef cd}
+test canvText-4.6 {ConfigureText procedure: adjust cursor} {
+ .c itemconfig test -text "abcdefghi"
+ set x {}
+ .c icursor test 6
+ .c dchars test 4 end
+ .c index test insert
+} {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]
+ lappend x [.c itemconfig test -anchor s; .c bbox test]
+ lappend x [.c itemconfig test -anchor se; .c bbox test]
+ lappend x [.c itemconfig test -anchor e; .c bbox test]
+ lappend x [.c itemconfig test -anchor ne; .c bbox test]
+ lappend x [.c itemconfig test -anchor center; .c bbox test]
+} "{[expr -$ax/2-1] 0 [expr $ax/2+1] $ay}\
+{-1 0 [expr $ax+1] $ay}\
+{-1 [expr -$ay/2] [expr $ax+1] [expr $ay/2]}\
+{-1 -$ay [expr $ax+1] 0}\
+{[expr -$ax/2-1] -$ay [expr $ax/2+1] 0}\
+{[expr -$ax-1] -$ay 1 0}\
+{[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
+ .c select to test end
+ update
+ selection get
+} "abcd\nefghi\njklmnopq"
+test canvText-7.3 {DisplayText procedure: selection} {
+ .c select from test 0
+ .c select to test end
+ update
+ selection get
+} "abcd\nefghi\njklmnopq"
+test canvText-7.4 {DisplayText procedure: one line selection} {
+ .c select from test 2
+ .c select to test 3
+ update
+} {}
+test canvText-7.5 {DisplayText procedure: multi-line selection} {
+ .c select from test 2
+ .c select to test 12
+ update
+} {}
+test canvText-7.6 {DisplayText procedure: draw cursor} {
+ .c icursor test 3
+ update
+} {}
+test canvText-7.7 {DisplayText procedure: selected text different color} {
+ .c config -selectforeground blue
+ .c itemconfig test -anchor n
+ update
+} {}
+test canvText-7.8 {DisplayText procedure: not selected} {
+ .c select clear
+ update
+} {}
+
+test canvText-8.1 {TextInsert procedure: 0 length insert} {
+ .c insert test end {}
+} {}
+test canvText-8.2 {TextInsert procedure: before beginning/after end} {
+ # Can't test this because GetTextIndex filters out those numbers.
+} {}
+test canvText-8.3 {TextInsert procedure: inserting in a selected item} {
+ .c itemconfig test -text "abcdefg"
+ .c select from test 2
+ .c select to test 4
+ .c insert test 1 "xyz"
+ .c itemcget test -text
+} {axyzbcdefg}
+test canvText-8.4 {TextInsert procedure: inserting before selection} {
+ .c itemconfig test -text "abcdefg"
+ .c select from test 2
+ .c select to test 4
+ .c insert test 1 "xyz"
+ list [.c index test sel.first] [.c index test sel.last]
+} {5 7}
+test canvText-8.5 {TextInsert procedure: inserting in selection} {
+ .c itemconfig test -text "abcdefg"
+ .c select from test 2
+ .c select to test 4
+ .c insert test 3 "xyz"
+ list [.c index test sel.first] [.c index test sel.last]
+} {2 7}
+test canvText-8.6 {TextInsert procedure: inserting after selection} {
+ .c itemconfig test -text "abcdefg"
+ .c select from test 2
+ .c select to test 4
+ .c insert test 5 "xyz"
+ list [.c index test sel.first] [.c index test sel.last]
+} {2 4}
+test canvText-8.7 {TextInsert procedure: inserting in unselected item} {
+ .c itemconfig test -text "abcdefg"
+ .c select clear
+ .c insert test 5 "xyz"
+ .c itemcget test -text
+} {abcdexyzfg}
+test canvText-8.8 {TextInsert procedure: inserting before cursor} {
+ .c itemconfig test -text "abcdefg"
+ .c icursor test 3
+ .c insert test 2 "xyz"
+ .c index test insert
+} {6}
+test canvText-8.9 {TextInsert procedure: inserting after cursor} {
+ .c itemconfig test -text "abcdefg"
+ .c icursor test 3
+ .c insert test 4 "xyz"
+ .c index test insert
+} {3}
+
+test canvText-9.1 {TextInsert procedure: before beginning/after end} {
+ # Can't test this because GetTextIndex filters out those numbers.
+} {}
+test canvText-9.2 {TextInsert procedure: start > end} {
+ .c itemconfig test -text "abcdefg"
+ .c dchars test 4 2
+ .c itemcget test -text
+} {abcdefg}
+test canvText-9.3 {TextInsert procedure: deleting from a selected item} {
+ .c itemconfig test -text "abcdefg"
+ .c select from test 2
+ .c select to test 4
+ .c dchars test 3 5
+ .c itemcget test -text
+} {abcg}
+test canvText-9.4 {TextInsert procedure: deleting before start} {
+ .c itemconfig test -text "abcdefghijk"
+ .c select from test 4
+ .c select to test 8
+ .c dchars test 1 1
+ list [.c index test sel.first] [.c index test sel.last]
+} {3 7}
+test canvText-9.5 {TextInsert procedure: keep start > first char deleted} {
+ .c itemconfig test -text "abcdefghijk"
+ .c select from test 4
+ .c select to test 8
+ .c dchars test 2 6
+ list [.c index test sel.first] [.c index test sel.last]
+} {2 3}
+test canvText-9.6 {TextInsert procedure: deleting inside selection} {
+ .c itemconfig test -text "abcdefghijk"
+ .c select from test 4
+ .c select to test 8
+ .c dchars test 6 6
+ list [.c index test sel.first] [.c index test sel.last]
+} {4 7}
+test canvText-9.7 {TextInsert procedure: keep end > first char deleted} {
+ .c itemconfig test -text "abcdefghijk"
+ .c select from test 4
+ .c select to test 8
+ .c dchars test 6 10
+ list [.c index test sel.first] [.c index test sel.last]
+} {4 5}
+test canvText-9.8 {TextInsert procedure: selectFirst > selectLast: deselect} {
+ .c itemconfig test -text "abcdefghijk"
+ .c select from test 4
+ .c select to test 8
+ .c dchars test 3 10
+ list [catch {.c index test sel.first} msg] $msg
+} {1 {selection isn't in item}}
+test canvText-9.9 {TextInsert procedure: selectFirst <= selectLast} {
+ .c itemconfig test -text "abcdefghijk"
+ .c select from test 4
+ .c select to test 8
+ .c dchars test 4 7
+ list [.c index test sel.first] [.c index test sel.last]
+} {4 4}
+test canvText-9.10 {TextInsert procedure: move anchor} {
+ .c itemconfig test -text "abcdefghijk"
+ .c select from test 6
+ .c select to test 8
+ .c dchars test 2 4
+ .c select to test 1
+ list [.c index test sel.first] [.c index test sel.last]
+} {1 2}
+test canvText-9.11 {TextInsert procedure: keep anchor >= first} {
+ .c itemconfig test -text "abcdefghijk"
+ .c select from test 6
+ .c select to test 8
+ .c dchars test 5 7
+ .c select to test 1
+ list [.c index test sel.first] [.c index test sel.last]
+} {1 4}
+test canvText-9.12 {TextInsert procedure: anchor doesn't move} {
+ .c itemconfig test -text "abcdefghijk"
+ .c select from test 2
+ .c select to test 5
+ .c dchars test 6 8
+ .c select to test 8
+ list [.c index test sel.first] [.c index test sel.last]
+} {2 8}
+test canvText-9.13 {TextInsert procedure: move cursor} {
+ .c itemconfig test -text "abcdefghijk"
+ .c icursor test 6
+ .c dchars test 2 4
+ .c index test insert
+} {3}
+test canvText-9.14 {TextInsert procedure: keep cursor >= first} {
+ .c itemconfig test -text "abcdefghijk"
+ .c icursor test 6
+ .c dchars test 2 10
+ .c index test insert
+} {2}
+test canvText-9.15 {TextInsert procedure: cursor doesn't move} {
+ .c itemconfig test -text "abcdefghijk"
+ .c icursor test 5
+ .c dchars test 7 9
+ .c index test insert
+} {5}
+
+test canvText-10.1 {TextToPoint procedure} {
+ .c coords test 0 0
+ .c itemconfig test -text 0 -anchor center
+ .c index test @0,0
+} {0}
+
+test canvText-11.1 {TextToArea procedure} {
+ .c coords test 0 0
+ .c itemconfig test -text 0 -anchor center
+ .c find overlapping 0 0 1 1
+} [.c find withtag test]
+test canvText-11.2 {TextToArea procedure} {
+ .c coords test 0 0
+ .c itemconfig test -text 0 -anchor center
+ .c find overlapping 1000 1000 1001 1001
+} {}
+
+test canvText-12.1 {ScaleText procedure} {
+ .c coords test 100 100
+ .c scale all 50 50 2 2
+ .c coords test
+} {150.0 150.0}
+
+test canvText-13.1 {TranslateText procedure} {
+ .c coords test 100 100
+ .c move all 10 10
+ .c coords test
+} {110.0 110.0}
+
+.c itemconfig test -text "abcdefghijklmno" -anchor nw
+.c select from test 5
+.c select to test 8
+.c icursor test 12
+.c coords test 0 0
+test canvText-14.1 {GetTextIndex procedure} {
+ list [.c index test end] [.c index test insert] \
+ [.c index test sel.first] [.c index test sel.last] \
+ [.c index test @0,0] \
+ [.c index test -1] [.c index test 10] [.c index test 100]
+} {15 12 5 8 0 0 10 15}
+test canvText-14.2 {GetTextIndex procedure: select error} {
+ .c select clear
+ list [catch {.c index test sel.first} msg] $msg
+} {1 {selection isn't in item}}
+test canvText-14.3 {GetTextIndex procedure: select error} {
+ .c select clear
+ list [catch {.c index test sel.last} msg] $msg
+} {1 {selection isn't in item}}
+test canvText-14.4 {GetTextIndex procedure: select error} {
+ .c select clear
+ list [catch {.c index test sel.} msg] $msg
+} {1 {bad index "sel."}}
+test canvText-14.5 {GetTextIndex procedure: bad int or unknown index} {
+ list [catch {.c index test xyz} msg] $msg
+} {1 {bad index "xyz"}}
+
+test canvText-15.1 {SetTextCursor procedure} {
+ .c itemconfig -text "abcdefg"
+ .c icursor test 3
+ .c index test insert
+} {3}
+
+test canvText-16.1 {GetSelText procedure} {
+ .c itemconfig test -text "abcdefghijklmno" -anchor nw
+ .c select from test 5
+ .c select to test 8
+ selection get
+} {fghi}
+
+set font {Courier 12 italic}
+set ax [font measure $font 0]
+set ay [font metrics $font -linespace]
+
+test canvText-17.1 {TextToPostscript procedure} {
+ .c delete all
+ .c config -height 300 -highlightthickness 0 -bd 0
+ update
+ .c create text 100 100 -tags test
+ .c itemconfig test -font $font -text "00000000" -width [expr 3*$ax]
+ .c itemconfig test -anchor n -fill black
+ set x [.c postscript]
+ set x [string range $x [string first "/Courier-Oblique" $x] end]
+} "/Courier-Oblique findfont [font actual $font -size] scalefont ISOEncode setfont
+0.000 0.000 0.000 setrgbcolor AdjustColor
+100 200 \[
+(000)
+(000)
+(00)
+] $ay -0.5 0 0 false DrawText
+grestore
+restore showpage
+
+%%Trailer
+end
+%%EOF
+"
diff --git a/tk/tests/canvWind.test b/tk/tests/canvWind.test
new file mode 100644
index 00000000000..7e9d7da7ab7
--- /dev/null
+++ b/tk/tests/canvWind.test
@@ -0,0 +1,133 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {"[info procs test]" != "test"} {
+ source defs
+}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+wm geometry . {}
+raise .
+
+test canvWind-1.1 {DisplayWinItem, windows off-screen vertically} {
+ catch {destroy .t}
+ toplevel .t
+ canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \
+ -relief sunken -xscrollincrement 1 -yscrollincrement 1 \
+ -highlightthickness 1
+ pack .t.c -fill both -expand 1 -padx 20 -pady 20
+ wm geometry .t +0+0
+ set f .t.f
+ frame $f -width 80 -height 50 -bg red
+ .t.c create window 300 400 -window $f -anchor nw
+ .t.c xview moveto .3
+ .t.c yview moveto .50
+ update
+ set x [list [list [winfo ismapped $f] [winfo y $f]]]
+ .t.c yview scroll 52 units
+ update
+ lappend x [list [winfo ismapped $f] [winfo y $f]]
+ .t.c yview scroll 1 units
+ update
+ lappend x [list [winfo ismapped $f] [winfo y $f]]
+ .t.c yview scroll -255 units
+ update
+ lappend x [list [winfo ismapped $f] [winfo y $f]]
+ .t.c yview scroll -1 units
+ update
+ lappend x [list [winfo ismapped $f] [winfo y $f]]
+} {{1 23} {1 -29} {0 -29} {1 225} {0 225}}
+test canvWind-1.2 {DisplayWinItem, windows off-screen vertically} {
+ catch {destroy .t}
+ toplevel .t
+ canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \
+ -relief sunken -xscrollincrement 1 -yscrollincrement 1 \
+ -highlightthickness 1
+ pack .t.c -fill both -expand 1 -padx 20 -pady 20
+ wm geometry .t +0+0
+ set f .t.c.f
+ frame $f -width 80 -height 50 -bg red
+ .t.c create window 300 400 -window $f -anchor nw
+ .t.c xview moveto .3
+ .t.c yview moveto .50
+ update
+ set x [list [list [winfo ismapped $f] [winfo y $f]]]
+ .t.c yview scroll 52 units
+ update
+ lappend x [list [winfo ismapped $f] [winfo y $f]]
+ .t.c yview scroll 1 units
+ update
+ lappend x [list [winfo ismapped $f] [winfo y $f]]
+ .t.c yview scroll -255 units
+ update
+ lappend x [list [winfo ismapped $f] [winfo y $f]]
+ .t.c yview scroll -1 units
+ update
+ lappend x [list [winfo ismapped $f] [winfo y $f]]
+} {{1 3} {1 -49} {0 -49} {1 205} {0 205}}
+test canvWind-1.3 {DisplayWinItem, windows off-screen horizontally} {
+ catch {destroy .t}
+ toplevel .t
+ canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \
+ -relief sunken -xscrollincrement 1 -yscrollincrement 1 \
+ -highlightthickness 1
+ pack .t.c -fill both -expand 1 -padx 20 -pady 20
+ wm geometry .t +0+0
+ set f .t.f
+ frame $f -width 80 -height 50 -bg red
+ .t.c create window 300 400 -window $f -anchor nw
+ .t.c xview moveto .3
+ .t.c yview moveto .50
+ update
+ set x [list [list [winfo ismapped $f] [winfo x $f]]]
+ .t.c xview scroll 82 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]]
+ .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 23} {1 -59} {0 -59} {1 275} {0 275}}
+test canvWind-1.4 {DisplayWinItem, windows off-screen horizontally} {
+ catch {destroy .t}
+ toplevel .t
+ canvas .t.c -scrollregion {0 0 1000 800} -width 250 -height 200 -bd 2 \
+ -relief sunken -xscrollincrement 1 -yscrollincrement 1 \
+ -highlightthickness 1
+ pack .t.c -fill both -expand 1 -padx 20 -pady 20
+ wm geometry .t +0+0
+ set f .t.c.f
+ frame $f -width 80 -height 50 -bg red
+ .t.c create window 300 400 -window $f -anchor nw
+ .t.c xview moveto .3
+ .t.c yview moveto .50
+ update
+ set x [list [list [winfo ismapped $f] [winfo x $f]]]
+ .t.c xview scroll 82 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]]
+ .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}}
diff --git a/tk/tests/canvas.test b/tk/tests/canvas.test
new file mode 100644
index 00000000000..9bf32d9447c
--- /dev/null
+++ b/tk/tests/canvas.test
@@ -0,0 +1,238 @@
+# 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 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$
+
+if {[info procs test] != "test"} {
+ source defs
+}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+wm geometry . {}
+raise .
+
+# XXX - This test file is woefully incomplete. At present, only a
+# few of the features are tested.
+
+canvas .c
+pack .c
+update
+set i 1
+foreach test {
+ {-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"}}
+ {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
+ {-closeenough 24 24.0 bogus {expected floating-point number but got "bogus"}}
+ {-confine true 1 silly {expected boolean value but got "silly"}}
+ {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
+ {-height 2.1 2 x42 {bad screen distance "x42"}}
+ {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
+ {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"}}
+ {-highlightthickness 18 18 badValue {bad screen distance "badValue"}}
+ {-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"}}
+ {-insertwidth 1.3 1 6x {bad screen distance "6x"}}
+ {-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"}}
+ {-takefocus "any string" "any string" {} {}}
+ {-width 402 402 xyz {bad screen distance "xyz"}}
+ {-xscrollcommand {Some command} {Some command} {} {}}
+ {-yscrollcommand {Another command} {Another command} {} {}}
+} {
+ set name [lindex $test 0]
+ test canvas-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 canvas-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
+}
+
+
+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
+ update
+ lappend x [.c xview]
+} {{0.6 0.9} {0.66 0.96}}
+
+catch {destroy .c}
+canvas .c -width 60 -height 40 -scrollregion {0 0 200 80} \
+ -borderwidth 0 -highlightthickness 0
+pack .c
+update
+test canvas-3.1 {CanvasWidgetCmd, yview option} {
+ .c configure -xscrollincrement 40 -yscrollincrement 5
+ .c yview moveto 0
+ update
+ set x [list [.c yview]]
+ .c yview scroll 3 units
+ update
+ lappend x [.c yview]
+} {{0 0.5} {0.1875 0.6875}}
+test canvas-3.2 {CanvasWidgetCmd, yview option} {
+ .c configure -xscrollincrement 40 -yscrollincrement 0
+ .c yview moveto 0
+ update
+ set x [list [.c yview]]
+ .c yview scroll 2 units
+ update
+ lappend x [.c yview]
+} {{0 0.5} {0.1 0.6}}
+
+test canvas-4.1 {ButtonEventProc procedure} {
+ eval destroy [winfo children .]
+ canvas .c1 -bg #543210
+ rename .c1 .c2
+ set x {}
+ lappend x [winfo children .]
+ lappend x [.c2 cget -bg]
+ destroy .c1
+ lappend x [info command .c*] [winfo children .]
+} {.c1 #543210 {} {}}
+
+test canvas-5.1 {ButtonCmdDeletedProc procedure} {
+ eval destroy [winfo children .]
+ canvas .c1
+ rename .c1 {}
+ list [info command .c*] [winfo children .]
+} {{} {}}
+
+catch {destroy .c}
+canvas .c -width 100 -height 50 -scrollregion {-200 -100 305 102} \
+ -borderwidth 2 -highlightthickness 3
+pack .c
+update
+test canvas-6.1 {CanvasSetOrigin procedure} {
+ .c configure -xscrollincrement 0 -yscrollincrement 0
+ .c xview moveto 0
+ .c yview moveto 0
+ update
+ list [.c canvasx 0] [.c canvasy 0]
+} {-205.0 -105.0}
+test canvas-6.2 {CanvasSetOrigin procedure} {
+ .c configure -xscrollincrement 20 -yscrollincrement 10
+ set x ""
+ foreach i {.08 .10 .48 .50} {
+ .c xview moveto $i
+ update
+ lappend x [.c canvasx 0]
+ }
+ set x
+} {-165.0 -145.0 35.0 55.0}
+test canvas-6.3 {CanvasSetOrigin procedure} {
+ .c configure -xscrollincrement 20 -yscrollincrement 10
+ set x ""
+ foreach i {.06 .08 .70 .72} {
+ .c yview moveto $i
+ update
+ lappend x [.c canvasy 0]
+ }
+ set x
+} {-95.0 -85.0 35.0 45.0}
+test canvas-6.4 {CanvasSetOrigin procedure} {
+ .c configure -xscrollincrement 20 -yscrollincrement 10
+ .c xview moveto 1.0
+ .c canvasx 0
+} {215.0}
+test canvas-6.5 {CanvasSetOrigin procedure} {
+ .c configure -xscrollincrement 20 -yscrollincrement 10
+ .c yview moveto 1.0
+ .c canvasy 0
+} {55.0}
+
+set l [interp hidden]
+eval destroy [winfo children .]
+
+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 ""
+} {}
diff --git a/tk/tests/clipboard.test b/tk/tests/clipboard.test
new file mode 100644
index 00000000000..b730b09a852
--- /dev/null
+++ b/tk/tests/clipboard.test
@@ -0,0 +1,234 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+#
+# 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} {
+ set j $i.1$i.2$i.3$i.4$i.5$i.6$i.7$i.8$i.9$i.10$i.11$i.12$i.13$i.14
+ append longValue A$j B$j C$j D$j E$j F$j G$j H$j I$j K$j L$j M$j N$j
+}
+
+# Now we start the main body of the test code
+
+test clipboard-1.1 {ClipboardHandler procedure} {
+ clipboard clear
+ clipboard append "test"
+ selection get -s CLIPBOARD
+} {test}
+test clipboard-1.2 {ClipboardHandler procedure} {
+ clipboard clear
+ clipboard append "test"
+ clipboard append "ing"
+ selection get -s CLIPBOARD
+} {testing}
+test clipboard-1.3 {ClipboardHandler procedure} {
+ clipboard clear
+ clipboard append "t"
+ clipboard append "e"
+ clipboard append "s"
+ clipboard append "t"
+ selection get -s CLIPBOARD
+} {test}
+test clipboard-1.4 {ClipboardHandler procedure} {
+ clipboard clear
+ clipboard append $longValue
+ selection get -s CLIPBOARD
+} "$longValue"
+test clipboard-1.5 {ClipboardHandler procedure} {
+ clipboard clear
+ clipboard append $longValue
+ clipboard append "test"
+ selection get -s CLIPBOARD
+} "${longValue}test"
+test clipboard-1.6 {ClipboardHandler procedure} {
+ clipboard clear
+ clipboard append -t TEST $longValue
+ clipboard append -t STRING "test"
+ list [selection get -s CLIPBOARD -t STRING] \
+ [selection get -s CLIPBOARD -t TEST]
+} [list test $longValue]
+test clipboard-1.7 {ClipboardHandler procedure} {
+ clipboard clear
+ clipboard append -t TEST [string range $longValue 1 4000]
+ clipboard append -t STRING "test"
+ list [selection get -s CLIPBOARD -t STRING] \
+ [selection get -s CLIPBOARD -t TEST]
+} [list test [string range $longValue 1 4000]]
+test clipboard-1.8 {ClipboardHandler procedure} {
+ clipboard clear
+ clipboard append ""
+ selection get -s CLIPBOARD
+} {}
+test clipboard-1.9 {ClipboardHandler procedure} {
+ clipboard clear
+ clipboard append ""
+ clipboard append "Test"
+ selection get -s CLIPBOARD
+} {Test}
+
+##############################################################################
+
+test clipboard-2.1 {ClipboardAppHandler procedure} {
+ set oldAppName [tk appname]
+ tk appname UnexpectedName
+ clipboard clear
+ clipboard append -type NEW_TYPE Data
+ set result [selection get -selection CLIPBOARD -type TK_APPLICATION]
+ tk appname $oldAppName
+ set result
+} {UnexpectedName}
+
+##############################################################################
+
+test clipboard-3.1 {ClipboardWindowHandler procedure} {
+ set oldAppName [tk appname]
+ tk appname UnexpectedName
+ clipboard clear
+ clipboard append -type NEW_TYPE Data
+ set result [selection get -selection CLIPBOARD -type TK_WINDOW]
+ tk appname $oldAppName
+ set result
+} {.}
+
+##############################################################################
+
+test clipboard-4.1 {ClipboardLostSel procedure} {
+ clipboard clear
+ clipboard append "Test"
+ selection clear -s CLIPBOARD
+ list [catch {selection get -s CLIPBOARD} msg] $msg
+} {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined}}
+test clipboard-4.2 {ClipboardLostSel procedure} {
+ clipboard clear
+ clipboard append "Test"
+ clipboard append -t TEST "Test2"
+ selection clear -s CLIPBOARD
+ list [catch {selection get -s CLIPBOARD} msg] $msg \
+ [catch {selection get -s CLIPBOARD -t TEST} msg] $msg
+} {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}}
+test clipboard-4.3 {ClipboardLostSel procedure} {
+ clipboard clear
+ clipboard append "Test"
+ clipboard append -t TEST "Test2"
+ clipboard append "Test3"
+ selection clear -s CLIPBOARD
+ list [catch {selection get -s CLIPBOARD} msg] $msg \
+ [catch {selection get -s CLIPBOARD -t TEST} msg] $msg
+} {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}}
+
+##############################################################################
+
+test clipboard-5.1 {Tk_ClipboardClear procedure} {
+ clipboard clear
+ clipboard append -t TEST "test"
+ set result [lsort [selection get -s CLIPBOARD TARGETS]]
+ clipboard clear
+ list $result [lsort [selection get -s CLIPBOARD TARGETS]]
+} {{MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}
+test clipboard-5.2 {Tk_ClipboardClear procedure} {
+ clipboard clear
+ clipboard append -t TEST "test"
+ set result [lsort [selection get -s CLIPBOARD TARGETS]]
+ selection own -s CLIPBOARD .
+ lappend result [lsort [selection get -s CLIPBOARD TARGETS]]
+ clipboard clear
+ clipboard append -t TEST "test"
+ lappend result [lsort [selection get -s CLIPBOARD TARGETS]]
+} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
+
+##############################################################################
+
+test clipboard-6.1 {Tk_ClipboardAppend procedure} {
+ clipboard clear
+ clipboard append "first chunk"
+ selection own -s CLIPBOARD .
+ list [catch {
+ clipboard append " second chunk"
+ selection get -s CLIPBOARD
+ } msg] $msg
+} {0 {first chunk second chunk}}
+test clipboard-6.2 {Tk_ClipboardAppend procedure} {unixOnly} {
+ setupbg
+ clipboard clear
+ clipboard append -f INTEGER -t TEST "16"
+ set result [dobg {selection get -s CLIPBOARD TEST}]
+ cleanupbg
+ set result
+} {0x10}
+test clipboard-6.3 {Tk_ClipboardAppend procedure} {
+ clipboard clear
+ clipboard append -f INTEGER -t TEST "16"
+ list [catch {clipboard append -t TEST "test"} msg] $msg
+} {1 {format "STRING" does not match current format "INTEGER" for TEST}}
+
+##############################################################################
+
+test clipboard-7.1 {Tk_ClipboardCmd procedure} {
+ list [catch {clipboard} msg] $msg
+} {1 {wrong # args: should be "clipboard option ?arg arg ...?"}}
+test clipboard-7.2 {Tk_ClipboardCmd procedure} {
+ clipboard clear
+ list [catch {clipboard append --} msg] $msg \
+ [selection get -selection CLIPBOARD]
+} {0 {} --}
+test clipboard-7.3 {Tk_ClipboardCmd procedure} {
+ clipboard clear
+ list [catch {clipboard append -- information} msg] $msg \
+ [selection get -selection CLIPBOARD]
+} {0 {} information}
+test clipboard-7.4 {Tk_ClipboardCmd procedure} {
+ list [catch {clipboard append --x a b} msg] $msg
+} {1 {unknown option "--x"}}
+test clipboard-7.5 {Tk_ClipboardCmd procedure} {
+ list [catch {clipboard append -- a b} msg] $msg
+} {1 {wrong # args: should be "clipboard append ?options? data"}}
+test clipboard-7.6 {Tk_ClipboardCmd procedure} {
+ clipboard clear
+ list [catch {clipboard append -format} msg] $msg \
+ [selection get -selection CLIPBOARD]
+} {0 {} -format}
+test clipboard-7.7 {Tk_ClipboardCmd procedure} {
+ list [catch {clipboard append -displayofoo f} msg] $msg
+} {1 {unknown option "-displayofoo"}}
+test clipboard-7.8 {Tk_ClipboardCmd procedure} {
+ list [catch {clipboard append -type TEST} msg] $msg
+} {1 {wrong # args: should be "clipboard append ?options? data"}}
+test clipboard-7.9 {Tk_ClipboardCmd procedure} {
+ list [catch {clipboard append -displayof foo "test"} msg] $msg
+} {1 {bad window path name "foo"}}
+
+test clipboard-7.10 {Tk_ClipboardCmd procedure} {
+ list [catch {clipboard clear -displayof} msg] $msg
+} {1 {value for "-displayof" missing}}
+test clipboard-7.11 {Tk_ClipboardCmd procedure} {
+ list [catch {clipboard clear -displayofoo f} msg] $msg
+} {1 {unknown option "-displayofoo"}}
+test clipboard-7.12 {Tk_ClipboardCmd procedure} {
+ list [catch {clipboard clear foo} msg] $msg
+} {1 {wrong # args: should be "clipboard clear ?options?"}}
+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}}
diff --git a/tk/tests/clrpick.test b/tk/tests/clrpick.test
new file mode 100644
index 00000000000..69b621dc999
--- /dev/null
+++ b/tk/tests/clrpick.test
@@ -0,0 +1,215 @@
+# 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.
+#
+# RCS: @(#) $Id$
+#
+
+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 {bad window path name "foo.bar"}}
+
+test clrpick-1.6 {tk_chooseColor command} {
+ list [catch {tk_chooseColor -initialcolor badbadbaadcolor} msg] $msg
+} {1 {unknown color name "badbadbaadcolor"}}
+
+test clrpick-1.7 {tk_chooseColor command} {
+ list [catch {tk_chooseColor -initialcolor ##badbadbaadcolor} msg] $msg
+} {1 {invalid color name "##badbadbaadcolor"}}
+
+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"
+ }
+}
+
+proc ToChooseColorByKey {parent r g b} {
+ global isNative
+ if {!$isNative} {
+ after 200 ChooseColorByKey $parent $r $g $b
+ }
+}
+
+proc PressButton {btn} {
+ event generate $btn <Enter>
+ event generate $btn <1> -x 5 -y 5
+ event generate $btn <ButtonRelease-1> -x 5 -y 5
+}
+
+proc ChooseColorByKey {parent r g b} {
+ set w .__tk__color
+ upvar #0 $w data
+
+ update
+ $data(red,entry) delete 0 end
+ $data(green,entry) delete 0 end
+ $data(blue,entry) delete 0 end
+
+ $data(red,entry) insert 0 $r
+ $data(green,entry) insert 0 $g
+ $data(blue,entry) insert 0 $b
+
+ # Manually force the refresh of the color values instead
+ # of counting on the timing of the event stream to change
+ # the values for us.
+ tkColorDialog_HandleRGBEntry $w
+
+ SendButtonPress $parent ok mouse
+}
+
+proc SendButtonPress {parent btn type} {
+ set w .__tk__color
+ upvar #0 $w data
+
+ set button $data($btn\Btn)
+ if ![winfo ismapped $button] {
+ update
+ }
+
+ if {$type == "mouse"} {
+ PressButton $button
+ } else {
+ event generate $w <Enter>
+ focus $w
+ event generate $button <Enter>
+ event generate $w <KeyPress> -keysym Return
+ }
+}
+
+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
+# Interesting thing...when this is too long, the
+# delay caused in processing it kills the automated testing,
+# and makes a lot of the test cases fail.
+#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"
+} ""
diff --git a/tk/tests/cmap.tcl b/tk/tests/cmap.tcl
new file mode 100644
index 00000000000..8fe0207ce15
--- /dev/null
+++ b/tk/tests/cmap.tcl
@@ -0,0 +1,61 @@
+# 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$
+
+catch {destroy .t}
+toplevel .t -colormap new
+wm title .t "Visual Test for Colormaps"
+wm iconname .t "Colormaps"
+wm geom .t +0+0
+
+# The following procedure creates a whole bunch of frames within a
+# window, in order to eat up all the colors in a colormap.
+
+proc colors {w redInc greenInc blueInc} {
+ set red 0
+ set green 0
+ set blue 0
+ for {set y 0} {$y < 8} {incr y} {
+ for {set x 0} {$x < 8} {incr x} {
+ frame $w.f$x,$y -width 40 -height 40 -bd 2 -relief raised \
+ -bg [format #%02x%02x%02x $red $green $blue]
+ place $w.f$x,$y -x [expr 40*$x] -y [expr 40*$y]
+ incr red $redInc
+ incr green $greenInc
+ incr blue $blueInc
+ }
+ }
+}
+
+message .t.m -width 6i -text {This window displays two nested frames, each with a whole bunch of subwindows that eat up a lot of colors. The toplevel window has its own colormap, which is inherited by the outer frame. The inner frame has its own colormap. As you move the mouse around, the colors in the frames should change back and forth.}
+pack .t.m -side top -fill x
+
+button .t.quit -text Quit -command {destroy .t}
+pack .t.quit -side bottom -pady 3 -ipadx 4 -ipady 2
+
+frame .t.f -width 700 -height 450 -relief raised -bd 2
+pack .t.f -side top -padx 1c -pady 1c
+colors .t.f 4 0 0
+frame .t.f.f -width 350 -height 350 -colormap new -bd 2 -relief raised
+place .t.f.f -relx 1.0 -rely 0 -anchor ne
+colors .t.f.f 0 4 0
+bind .t.f.f <Enter> {wm colormapwindows .t {.t.f.f .t}}
+bind .t.f.f <Leave> {wm colormapwindows .t {.t .t.f.f}}
+
+catch {destroy .t2}
+toplevel .t2
+wm title .t2 "Visual Test for Colormaps"
+wm iconname .t2 "Colormaps"
+wm geom .t2 +0-0
+
+message .t2.m -width 6i -text {This window just eats up most of the colors in the default colormap.}
+pack .t2.m -side top -fill x
+
+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
diff --git a/tk/tests/cmds.test b/tk/tests/cmds.test
new file mode 100644
index 00000000000..23a46700b88
--- /dev/null
+++ b/tk/tests/cmds.test
@@ -0,0 +1,43 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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} {
+ list [catch {tkwait visibility} msg] $msg
+} {1 {wrong # args: should be "tkwait variable|visibility|window name"}}
+test cmds-1.2 {tkwait visibility, argument errors} {
+ list [catch {tkwait visibility foo bar} msg] $msg
+} {1 {wrong # args: should be "tkwait variable|visibility|window name"}}
+test cmds-1.3 {tkwait visibility, argument errors} {
+ list [catch {tkwait visibility bad_window} msg] $msg
+} {1 {bad window path name "bad_window"}}
+test cmds-1.4 {tkwait visibility, waiting for window to be mapped} {
+ button .b -text "Test"
+ set x init
+ after 100 {set x delay; place .b -x 0 -y 0}
+ tkwait visibility .b
+ destroy .b
+ set x
+} {delay}
+test cmds-1.5 {tkwait visibility, window gets deleted} {
+ 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}
diff --git a/tk/tests/color.test b/tk/tests/color.test
new file mode 100644
index 00000000000..37867f6100f
--- /dev/null
+++ b/tk/tests/color.test
@@ -0,0 +1,167 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[info procs test] != "test"} {
+ source defs
+}
+
+eval destroy [winfo children .]
+wm geometry . {}
+raise .
+
+# cname --
+# Returns a proper name for a color, given its intensities.
+#
+# Arguments:
+# r, g, b - Intensities on a 0-255 scale.
+
+proc cname {r g b} {
+ format #%02x%02x%02x $r $g $b
+}
+proc cname4 {r g b} {
+ format #%04x%04x%04x $r $g $b
+}
+
+# mkColors --
+# Creates a canvas and fills it with a 2-D array of squares, each of a
+# different color.
+#
+# Arguments:
+# c - Name of canvas window to create.
+# width - Number of squares in each row.
+# height - Number of squares in each column.
+# r, g, b - Initial value for red, green, and blue intensities.
+# rx, gx, bx - Change in intensities between adjacent elements in row.
+# ry, gy, by - Change in intensities between adjacent elements in column.
+
+proc mkColors {c width height r g b rx gx bx ry gy by} {
+ catch {destroy $c}
+ canvas $c -width 400 -height 200 -bd 0
+ for {set y 0} {$y < $height} {incr y} {
+ for {set x 0} {$x < $width} {incr x} {
+ set color [format #%02x%02x%02x [expr $r + $y*$ry + $x*$rx] \
+ [expr $g + $y*$gy + $x*$gx] [expr $b + $y*$by + $x*$bx]]
+ $c create rectangle [expr 10*$x] [expr 20*$y] \
+ [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \
+ -fill $color
+ }
+ }
+}
+
+# closest -
+# Given intensities between 0 and 255, return the closest intensities
+# that the server can provide.
+#
+# Arguments:
+# w - Window in which to lookup color
+# r, g, b - Desired intensities, between 0 and 255.
+
+proc closest {w r g b} {
+ set vals [winfo rgb $w [cname $r $g $b]]
+ list [expr [lindex $vals 0]/256] [expr [lindex $vals 1]/256] \
+ [expr [lindex $vals 2]/256]
+}
+
+# c255 -
+# Given a list of red, green, and blue intensities, scale them
+# down to a 0-255 range.
+#
+# Arguments:
+# vals - List of intensities.
+
+proc c255 {vals} {
+ list [expr [lindex $vals 0]/256] [expr [lindex $vals 1]/256] \
+ [expr [lindex $vals 2]/256]
+}
+
+# colorsFree --
+#
+# Returns 1 if there appear to be free colormap entries in a window,
+# 0 otherwise.
+#
+# Arguments:
+# w - Name of window in which to check.
+# red, green, blue - Intensities to use in a trial color allocation
+# to see if there are colormap entries free.
+
+proc colorsFree {w {red 31} {green 245} {blue 192}} {
+ set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]]
+ expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) \
+ && ([lindex $vals 2]/256 == $blue)
+}
+
+# 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
diff --git a/tk/tests/entry.test b/tk/tests/entry.test
new file mode 100644
index 00000000000..0a45f2086e1
--- /dev/null
+++ b/tk/tests/entry.test
@@ -0,0 +1,1269 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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 {
+ global scrollInfo
+ set scrollInfo $args
+}
+
+# Create additional widget that's used to hold the selection at times.
+
+entry .sel
+.sel insert end "This is some sample text"
+
+# Font names
+
+set big -adobe-helvetica-medium-r-normal--24-240-75-75-p-*-iso8859-1
+set fixed -adobe-courier-medium-r-normal--12-120-75-75-m-*-iso8859-1
+
+# Create entries in the option database to be sure that geometry options
+# like border width have predictable values.
+
+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"}}
+ {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
+ {-exportselection yes 1 xyzzy {expected boolean value but got "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"}}
+ {-highlightbackground #123456 #123456 ugly {unknown color name "ugly"}}
+ {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
+ {-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
+}
+
+test entry-2.1 {Tk_EntryCmd procedure} {
+ list [catch {entry} msg] $msg
+} {1 {wrong # args: should be "entry pathName ?options?"}}
+test entry-2.2 {Tk_EntryCmd procedure} {
+ list [catch {entry gorp} msg] $msg
+} {1 {bad window path name "gorp"}}
+test entry-2.3 {Tk_EntryCmd procedure} {
+ catch {destroy .e}
+ entry .e
+ list [winfo exists .e] [winfo class .e] [info commands .e]
+} {1 Entry .e}
+test entry-2.4 {Tk_EntryCmd procedure} {
+ catch {destroy .e}
+ list [catch {entry .e -gorp foo} msg] $msg [winfo exists .e] \
+ [info commands .e]
+} {1 {unknown option "-gorp"} 0 {}}
+test entry-2.5 {Tk_EntryCmd procedure} {
+ catch {destroy .e}
+ entry .e
+} {.e}
+
+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.
+
+test entry-4.1 {DestroyEntry procedure} {
+ catch {destroy .e}
+ entry .e -textvariable x -show *
+ pack .e
+ .e insert end "Sample text"
+ update
+ destroy .e
+} {}
+
+frame .f -width 200 -height 50 -relief raised -bd 2
+pack .f -side right
+test entry-5.1 {ConfigureEntry procedure, -textvariable} {
+ catch {destroy .e}
+ set x 12345
+ entry .e -textvariable x
+ .e get
+} {12345}
+test entry-5.2 {ConfigureEntry procedure, -textvariable} {
+ catch {destroy .e}
+ set x 12345
+ entry .e -textvariable x
+ set y abcde
+ .e configure -textvariable y
+ set x 54321
+ .e get
+} {abcde}
+test entry-5.3 {ConfigureEntry procedure, -textvariable} {
+ catch {destroy .e}
+ catch {unset x}
+ entry .e
+ .e insert 0 "Some text"
+ .e configure -textvariable x
+ set x
+} {Some text}
+test entry-5.4 {ConfigureEntry procedure, -textvariable} {
+ proc override args {
+ global x
+ set x 12345
+ }
+ catch {destroy .e}
+ catch {unset x}
+ trace variable x w override
+ entry .e
+ .e insert 0 "Some text"
+ .e configure -textvariable x
+ set result [list $x [.e get]]
+ unset x; rename override {}
+ set result
+} {12345 12345}
+test entry-5.5 {ConfigureEntry procedure} {
+ catch {destroy .e}
+ entry .e -exportselection false
+ pack .e
+ .e insert end "0123456789"
+ .sel select from 0
+ .sel select to 10
+ set x {}
+ lappend x [selection get]
+ .e select from 1
+ .e select to 5
+ lappend x [selection get]
+ .e configure -exportselection 1
+ lappend x [selection get]
+ set x
+} {{This is so} {This is so} 1234}
+test entry-5.6 {ConfigureEntry procedure} {
+ catch {destroy .e}
+ entry .e
+ pack .e
+ .e insert end "0123456789"
+ .e select from 1
+ .e select to 5
+ .e configure -exportselection 0
+ list [catch {selection get} msg] $msg [.e index sel.first] \
+ [.e index sel.last]
+} {1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 5}
+test entry-5.7 {ConfigureEntry procedure} {
+ catch {destroy .e}
+ entry .e -font $fixed -width 4 -xscrollcommand scroll
+ pack .e
+ .e insert end "01234567890"
+ update
+ .e configure -width 5
+ set scrollInfo
+} {0 0.363636}
+test entry-5.8 {ConfigureEntry procedure} {fonts} {
+ catch {destroy .e}
+ entry .e -width 0
+ pack .e
+ .e insert end "0123"
+ update
+ .e configure -font $big
+ update
+ winfo geom .e
+} {62x37+0+0}
+test entry-5.9 {ConfigureEntry procedure} {fonts} {
+ catch {destroy .e}
+ entry .e -font $fixed -bd 2 -relief raised
+ pack .e
+ .e insert end "0123"
+ update
+ list [.e index @10] [.e index @11] [.e index @12] [.e index @13]
+} {0 0 1 1}
+test entry-5.10 {ConfigureEntry procedure} {fonts} {
+ catch {destroy .e}
+ entry .e -font $fixed -bd 2 -relief flat
+ pack .e
+ .e insert end "0123"
+ update
+ list [.e index @10] [.e index @11] [.e index @12] [.e index @13]
+} {0 0 1 1}
+test entry-5.11 {ConfigureEntry procedure} {
+ # If "0" in selected font had 0 width, caused divide-by-zero error.
+
+ catch {destroy .e}
+ pack [entry .e -font {{open look glyph}}]
+ .e scan dragto 30
+ update
+} {}
+
+# No tests for DisplayEntry.
+
+test entry-6.1 {EntryComputeGeometry procedure} {fonts} {
+ catch {destroy .e}
+ entry .e -font $fixed -bd 2 -relief raised -width 20 -highlightthickness 3
+ pack .e
+ .e insert end 012\t45
+ update
+ list [.e index @61] [.e index @62]
+} {3 4}
+test entry-6.2 {EntryComputeGeometry procedure} {fonts} {
+ catch {destroy .e}
+ entry .e -font $fixed -bd 2 -relief raised -width 20 -justify center \
+ -highlightthickness 3
+ pack .e
+ .e insert end 012\t45
+ update
+ list [.e index @96] [.e index @97]
+} {3 4}
+test entry-6.3 {EntryComputeGeometry procedure} {fonts} {
+ catch {destroy .e}
+ entry .e -font $fixed -bd 2 -relief raised -width 20 -justify right \
+ -highlightthickness 3
+ pack .e
+ .e insert end 012\t45
+ update
+ list [.e index @131] [.e index @132]
+} {3 4}
+test entry-6.4 {EntryComputeGeometry procedure} {
+ catch {destroy .e}
+ entry .e -font $fixed -bd 2 -relief raised -width 5
+ pack .e
+ .e insert end "01234567890"
+ update
+ .e xview 6
+ .e index @0
+} {6}
+test entry-6.5 {EntryComputeGeometry procedure} {
+ catch {destroy .e}
+ entry .e -font $fixed -bd 2 -relief raised -width 5
+ pack .e
+ .e insert end "01234567890"
+ update
+ .e xview 7
+ .e index @0
+} {6}
+test entry-6.6 {EntryComputeGeometry procedure} {fonts} {
+ catch {destroy .e}
+ entry .e -font $fixed -bd 2 -relief raised -width 10
+ pack .e
+ .e insert end "01234\t67890"
+ update
+ .e xview 3
+ list [.e index @39] [.e index @40]
+} {5 6}
+test entry-6.7 {EntryComputeGeometry procedure} {fonts} {
+ catch {destroy .e}
+ entry .e -font $big -bd 3 -relief raised -width 5
+ pack .e
+ .e insert end "01234567"
+ update
+ list [winfo reqwidth .e] [winfo reqheight .e]
+} {77 39}
+test entry-6.8 {EntryComputeGeometry procedure} {fonts} {
+ catch {destroy .e}
+ entry .e -font $big -bd 3 -relief raised -width 0
+ pack .e
+ .e insert end "01234567"
+ update
+ list [winfo reqwidth .e] [winfo reqheight .e]
+} {116 39}
+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
+ .e insert 0 abcde
+ .e insert 2 XXX
+ update
+ list [.e get] $contents $scrollInfo
+} {abXXXcde abXXXcde {0 1}}
+test entry-7.2 {InsertChars procedure} {
+ .e delete 0 end
+ .e insert 0 abcde
+ .e insert 500 XXX
+ update
+ list [.e get] $contents $scrollInfo
+} {abcdeXXX abcdeXXX {0 1}}
+test entry-7.3 {InsertChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789
+ .e select from 2
+ .e select to 6
+ .e insert 2 XXX
+ set x "[.e index sel.first] [.e index sel.last]"
+ .e select to 8
+ lappend x [.e index sel.first] [.e index sel.last]
+} {5 9 5 8}
+test entry-7.4 {InsertChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789
+ .e select from 2
+ .e select to 6
+ .e insert 3 XXX
+ set x "[.e index sel.first] [.e index sel.last]"
+ .e select to 8
+ lappend x [.e index sel.first] [.e index sel.last]
+} {2 9 2 8}
+test entry-7.5 {InsertChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789
+ .e select from 2
+ .e select to 6
+ .e insert 5 XXX
+ set x "[.e index sel.first] [.e index sel.last]"
+ .e select to 8
+ lappend x [.e index sel.first] [.e index sel.last]
+} {2 9 2 8}
+test entry-7.6 {InsertChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789
+ .e select from 2
+ .e select to 6
+ .e insert 6 XXX
+ set x "[.e index sel.first] [.e index sel.last]"
+ .e select to 5
+ lappend x [.e index sel.first] [.e index sel.last]
+} {2 6 2 5}
+test entry-7.7 {InsertChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789
+ .e icursor 4
+ .e insert 4 XXX
+ .e index insert
+} {7}
+test entry-7.8 {InsertChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789
+ .e icursor 4
+ .e insert 5 XXX
+ .e index insert
+} {4}
+test entry-7.9 {InsertChars procedure} {
+ .e delete 0 end
+ .e insert 0 "This is a very long string"
+ update
+ .e xview 4
+ .e insert 3 XXX
+ .e index @0
+} {7}
+test entry-7.10 {InsertChars procedure} {
+ .e delete 0 end
+ .e insert 0 "This is a very long string"
+ update
+ .e xview 4
+ .e insert 4 XXX
+ .e index @0
+} {4}
+.e configure -width 0
+test entry-7.11 {InsertChars procedure} {fonts} {
+ .e delete 0 end
+ .e insert 0 "xyzzy"
+ update
+ .e insert 2 00
+ winfo reqwidth .e
+} {59}
+
+.e configure -width 10
+test entry-8.1 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 abcde
+ .e delete 2 4
+ update
+ list [.e get] $contents $scrollInfo
+} {abe abe {0 1}}
+test entry-8.2 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 abcde
+ .e delete -2 2
+ update
+ list [.e get] $contents $scrollInfo
+} {cde cde {0 1}}
+test entry-8.3 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 abcde
+ .e delete 3 1000
+ update
+ list [.e get] $contents $scrollInfo
+} {abc abc {0 1}}
+test entry-8.4 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789abcde
+ .e select from 3
+ .e select to 8
+ .e delete 1 3
+ update
+ set x "[.e index sel.first] [.e index sel.last]"
+ .e select to 5
+ lappend x [.e index sel.first] [.e index sel.last]
+} {1 6 1 5}
+test entry-8.5 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789abcde
+ .e select from 3
+ .e select to 8
+ .e delete 1 4
+ update
+ set x "[.e index sel.first] [.e index sel.last]"
+ .e select to 4
+ lappend x [.e index sel.first] [.e index sel.last]
+} {1 5 1 4}
+test entry-8.6 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789abcde
+ .e select from 3
+ .e select to 8
+ .e delete 1 7
+ update
+ set x "[.e index sel.first] [.e index sel.last]"
+ .e select to 5
+ lappend x [.e index sel.first] [.e index sel.last]
+} {1 2 1 5}
+test entry-8.7 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789abcde
+ .e select from 3
+ .e select to 8
+ .e delete 1 8
+ list [catch {.e index sel.first} msg] $msg
+} {1 {selection isn't in entry}}
+test entry-8.8 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789abcde
+ .e select from 3
+ .e select to 8
+ .e delete 3 7
+ update
+ set x "[.e index sel.first] [.e index sel.last]"
+ .e select to 8
+ lappend x [.e index sel.first] [.e index sel.last]
+} {3 4 3 8}
+test entry-8.9 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789abcde
+ .e select from 3
+ .e select to 8
+ .e delete 3 8
+ list [catch {.e index sel.first} msg] $msg
+} {1 {selection isn't in entry}}
+test entry-8.10 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789abcde
+ .e select from 8
+ .e select to 3
+ .e delete 5 8
+ update
+ set x "[.e index sel.first] [.e index sel.last]"
+ .e select to 8
+ lappend x [.e index sel.first] [.e index sel.last]
+} {3 5 5 8}
+test entry-8.11 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789abcde
+ .e select from 8
+ .e select to 3
+ .e delete 8 10
+ update
+ set x "[.e index sel.first] [.e index sel.last]"
+ .e select to 4
+ lappend x [.e index sel.first] [.e index sel.last]
+} {3 8 4 8}
+test entry-8.12 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789abcde
+ .e icursor 4
+ .e delete 1 4
+ .e index insert
+} {1}
+test entry-8.13 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789abcde
+ .e icursor 4
+ .e delete 1 5
+ .e index insert
+} {1}
+test entry-8.14 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789abcde
+ .e icursor 4
+ .e delete 4 6
+ .e index insert
+} {4}
+test entry-8.15 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 "This is a very long string"
+ .e xview 4
+ .e delete 1 4
+ .e index @0
+} {1}
+test entry-8.16 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 "This is a very long string"
+ .e xview 4
+ .e delete 1 5
+ .e index @0
+} {1}
+test entry-8.17 {DeleteChars procedure} {
+ .e delete 0 end
+ .e insert 0 "This is a very long string"
+ .e xview 4
+ .e delete 4 6
+ .e index @0
+} {4}
+.e configure -width 0
+test entry-8.18 {DeleteChars procedure} {fonts} {
+ .e delete 0 end
+ .e insert 0 "xyzzy"
+ update
+ .e delete 2 4
+ winfo reqwidth .e
+} {31}
+
+test entry-9.1 {EntryValueChanged procedure} {
+ catch {destroy .e}
+ proc override args {
+ global x
+ set x 12345
+ }
+ catch {unset x}
+ trace variable x w override
+ entry .e -textvariable x
+ .e insert 0 foo
+ set result [list $x [.e get]]
+ unset x; rename override {}
+ set result
+} {12345 12345}
+
+catch {destroy .e}
+entry .e
+pack .e
+.e configure -width 0
+test entry-10.1 {EntrySetValue procedure} {fonts} {
+ set x abcde
+ set y ab
+ .e configure -textvariable x
+ update
+ .e configure -textvariable y
+ update
+ list [.e get] [winfo reqwidth .e]
+} {ab 24}
+test entry-10.2 {EntrySetValue procedure, updating selection} {
+ catch {destroy .e}
+ entry .e -textvariable x
+ .e insert 0 "abcdefghjklmnopqrstu"
+ .e selection range 4 10
+ set x "a"
+ list [catch {.e index sel.first} msg] $msg
+} {1 {selection isn't in entry}}
+test entry-10.3 {EntrySetValue procedure, updating selection} {
+ catch {destroy .e}
+ entry .e -textvariable x
+ .e insert 0 "abcdefghjklmnopqrstu"
+ .e selection range 4 10
+ set x "abcdefg"
+ list [.e index sel.first] [.e index sel.last]
+} {4 7}
+test entry-10.4 {EntrySetValue procedure, updating selection} {
+ catch {destroy .e}
+ entry .e -textvariable x
+ .e insert 0 "abcdefghjklmnopqrstu"
+ .e selection range 4 10
+ set x "abcdefghijklmn"
+ list [.e index sel.first] [.e index sel.last]
+} {4 10}
+test entry-10.5 {EntrySetValue procedure, updating display position} {
+ catch {destroy .e}
+ entry .e -width 10 -font $fixed -textvariable x
+ pack .e
+ .e insert 0 "abcdefghjklmnopqrstuvwxyz"
+ .e xview 10
+ update
+ set x "abcdefg"
+ update
+ .e index @0
+} {0}
+test entry-10.6 {EntrySetValue procedure, updating display position} {
+ catch {destroy .e}
+ entry .e -width 10 -font $fixed -textvariable x
+ pack .e
+ .e insert 0 "abcdefghjklmnopqrstuvwxyz"
+ .e xview 10
+ update
+ set x "1234567890123456789012"
+ update
+ .e index @0
+} {10}
+test entry-10.7 {EntrySetValue procedure, updating insertion cursor} {
+ catch {destroy .e}
+ entry .e -width 10 -font $fixed -textvariable x
+ pack .e
+ .e insert 0 "abcdefghjklmnopqrstuvwxyz"
+ .e icursor 5
+ set x "123"
+ .e index insert
+} {3}
+test entry-10.8 {EntrySetValue procedure, updating insertion cursor} {
+ catch {destroy .e}
+ entry .e -width 10 -font $fixed -textvariable x
+ pack .e
+ .e insert 0 "abcdefghjklmnopqrstuvwxyz"
+ .e icursor 5
+ set x "123456"
+ .e index insert
+} {5}
+
+test entry-11.1 {EntryEventProc procedure} {
+ catch {destroy .e}
+ entry .e
+ .e insert 0 abcdefg
+ destroy .e
+ update
+} {}
+test entry-11.2 {EntryEventProc procedure} {
+ eval destroy [winfo children .]
+ entry .e1 -fg #112233
+ rename .e1 .e2
+ set x {}
+ lappend x [winfo children .]
+ lappend x [.e2 cget -fg]
+ destroy .e1
+ lappend x [info command .e*] [winfo children .]
+} {.e1 #112233 {} {}}
+
+test entry-12.1 {EntryCmdDeletedProc procedure} {
+ eval destroy [winfo children .]
+ button .e1 -text "xyz_123"
+ rename .e1 {}
+ list [info command .e*] [winfo children .]
+} {{} {}}
+
+catch {destroy .e}
+entry .e -font $fixed -width 5 -bd 2 -relief sunken
+pack .e
+.e insert 0 012345678901234567890
+.e xview 4
+update
+test entry-13.1 {GetEntryIndex procedure} {
+ .e index end
+} {21}
+test entry-13.2 {GetEntryIndex procedure} {
+ list [catch {.e index abogus} msg] $msg
+} {1 {bad entry index "abogus"}}
+test entry-13.3 {GetEntryIndex procedure} {
+ .e select from 1
+ .e select to 6
+ .e index anchor
+} {1}
+test entry-13.4 {GetEntryIndex procedure} {
+ .e select from 4
+ .e select to 1
+ .e index anchor
+} {4}
+test entry-13.5 {GetEntryIndex procedure} {
+ .e select from 3
+ .e select to 15
+ .e select adjust 4
+ .e index anchor
+} {15}
+test entry-13.6 {GetEntryIndex procedure} {
+ list [catch {.e index ebogus} msg] $msg
+} {1 {bad entry index "ebogus"}}
+test entry-13.7 {GetEntryIndex procedure} {
+ .e icursor 2
+ .e index insert
+} {2}
+test entry-13.8 {GetEntryIndex procedure} {
+ list [catch {.e index ibogus} msg] $msg
+} {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}
+
+# XXX Still need to write tests for EntryScanTo and EntrySelectTo.
+
+set x {}
+for {set i 1} {$i <= 500} {incr i} {
+ append x "This is line $i, out of 500\n"
+}
+test entry-14.1 {EntryFetchSelection procedure} {
+ catch {destroy .e}
+ entry .e
+ .e insert end "This is a test string"
+ .e select from 1
+ .e select to 18
+ selection get
+} {his is a test str}
+test entry-14.2 {EntryFetchSelection procedure} {
+ catch {destroy .e}
+ entry .e -show *
+ .e insert end "This is a test string"
+ .e select from 1
+ .e select to 18
+ selection get
+} {*****************}
+test entry-14.3 {EntryFetchSelection procedure} {
+ catch {destroy .e}
+ entry .e
+ .e insert end $x
+ .e select from 0
+ .e select to end
+ string compare [selection get] $x
+} 0
+
+test entry-15.1 {EntryLostSelection} {
+ catch {destroy .e}
+ entry .e
+ .e insert 0 "Text"
+ .e select from 0
+ .e select to 4
+ set result [selection get]
+ selection clear
+ .e select from 0
+ .e select to 4
+ lappend result [selection get]
+} {Text Text}
+
+# No tests for EventuallyRedraw.
+
+catch {destroy .e}
+entry .e -width 10 -xscrollcommand scroll
+pack .e
+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
+update
+test entry-17.1 {EntryUpdateScrollbar procedure} {
+ .e delete 0 end
+ .e insert 0 123
+ update
+ set scrollInfo
+} {0 1}
+test entry-17.2 {EntryUpdateScrollbar procedure} {
+ .e delete 0 end
+ .e insert 0 0123456789abcdef
+ .e xview 3
+ update
+ set scrollInfo
+} {0.1875 0.8125}
+test entry-17.3 {EntryUpdateScrollbar procedure} {
+ .e delete 0 end
+ .e insert 0 abcdefghijklmnopqrs
+ .e xview 6
+ update
+ set scrollInfo
+} {0.315789 0.842105}
+test entry-17.4 {EntryUpdateScrollbar procedure} {
+ catch {destroy .e}
+ proc bgerror msg {
+ global x
+ set x $msg
+ }
+ entry .e -width 5 -xscrollcommand bogus
+ pack .e
+ update
+ rename bgerror {}
+ list $x $errorInfo
+} {{invalid command name "bogus"} {invalid command name "bogus"
+ while executing
+"bogus 0 1"
+ (horizontal scrolling command executed by entry)}}
+
+set l [interp hidden]
+eval destroy [winfo children .]
+
+test entry-18.1 {Entry widget vs hiding} {
+ catch {destroy .e}
+ entry .e
+ interp hide {} .e
+ destroy .e
+ list [winfo children .] [interp hidden]
+} [list {} $l]
+
+# XXX Still need to write tests for EntryBlinkProc, EntryFocusProc,
+# and EntryTextVarProc.
+
+
+option clear
diff --git a/tk/tests/event.test b/tk/tests/event.test
new file mode 100644
index 00000000000..5cbfffe817f
--- /dev/null
+++ b/tk/tests/event.test
@@ -0,0 +1,41 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[info procs test] != "test"} {
+ source defs
+}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+wm geometry . {}
+raise .
+
+# XXX This test file is woefully incomplete. Right now it only tests
+# a few of the procedures in tkEvent.c. Please add more tests whenever
+# possible.
+
+test event-1.1 {Tk_HandleEvent procedure, filter events for dead windows} {
+ button .b -text Test
+ pack .b
+ bindtags .b .b
+ update
+ bind .b <Destroy> {
+ lappend x destroy
+ event generate .b <1>
+ }
+ bind .b <1> {
+ lappend x button
+ }
+ set x {}
+ destroy .b
+ set x
+} {destroy}
diff --git a/tk/tests/filebox.test b/tk/tests/filebox.test
new file mode 100644
index 00000000000..98ae0d36af9
--- /dev/null
+++ b/tk/tests/filebox.test
@@ -0,0 +1,302 @@
+# 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.
+#
+# RCS: @(#) $Id$
+#
+
+set tk_strictMotif_old $tk_strictMotif
+
+#----------------------------------------------------------------------
+#
+# Procedures needed by this test file
+#
+#----------------------------------------------------------------------
+
+proc ToPressButton {parent btn} {
+ global isNative
+ if {!$isNative} {
+ after 100 SendButtonPress $parent $btn mouse
+ }
+}
+
+proc ToEnterFileByKey {parent fileName fileDir} {
+ global isNative
+ if {!$isNative} {
+ after 100 EnterFileByKey $parent [list $fileName] [list $fileDir]
+ }
+}
+
+proc PressButton {btn} {
+ 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
+ }
+
+ if {$type == "mouse"} {
+ PressButton $button
+ } else {
+ event generate $w <Enter>
+ focus $w
+ event generate $button <Enter>
+ event generate $w <KeyPress> -keysym Return
+ }
+}
+
+
+#----------------------------------------------------------------------
+#
+# 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
+}
+
+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" {
+
+ if {$command == "tk_getOpenFile" && $mode == 0} {
+ set unknownOptionsMsg {1 {unknown option "-foo", must be -defaultextension, -filetypes, -initialdir, -initialfile, -multiple, -parent or -title}}
+ } else {
+ set unknownOptionsMsg {1 {unknown option "-foo", must be -defaultextension, -filetypes, -initialdir, -initialfile, -parent or -title}}
+ }
+
+ 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
+ } [list 1 "value for \"$option\" missing"]
+ }
+ }
+
+ test filebox-1.3 "$command command" {
+ list [catch {$command -foo bar} msg] $msg
+ } $unknownOptionsMsg
+
+ test filebox-1.4 "$command command" {
+ list [catch {$command -initialdir} msg] $msg
+ } {1 {value for "-initialdir" missing}}
+
+ test filebox-1.5 "$command command" {
+ list [catch {$command -parent foo.bar} msg] $msg
+ } {1 {bad window path name "foo.bar"}}
+
+ test filebox-1.6 "$command command" {
+ list [catch {$command -filetypes {Foo}} msg] $msg
+ } {1 {bad file type "Foo", should be "typeName {extension ?extensions ...?} ?{macType ?macTypes ...?}?"}}
+
+ 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
+
+ test filebox-2.4 "$command command" {
+ ToPressButton $parent ok
+ set choice [$command -title "Enter \"$fileName\" and press Ok" \
+ -parent $parent -initialdir . \
+ -initialfile $fileName]
+ } $pathName
+
+ test filebox-2.5 "$command command" {
+ 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" {
+ 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}
+ {"C Source Files" {.c .h} }
+ {"All Source Files" {.tcl .c .h} }
+ {"Image Files" {.gif} }
+ {"Image Files" {.jpeg .jpg} }
+ {"Image Files" "" {GIFF JPEG}}
+ {"All files" *}
+ }
+
+ 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
+ }
+
+ #
+ # The rest of the tests need to be executed on Unix only. The test whether
+ # the dialog box widgets were implemented correctly. These tests are not
+ # needed on the other platforms because they use native file dialogs.
+ #
+
+
+
+
+ # end inner if
+ }
+
+ # 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
+}
diff --git a/tk/tests/focus.test b/tk/tests/focus.test
new file mode 100644
index 00000000000..b10ee5e89e2
--- /dev/null
+++ b/tk/tests/focus.test
@@ -0,0 +1,636 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+pack .b
+
+proc focusSetup {} {
+ catch {destroy .t}
+ toplevel .t
+ wm geom .t +0+0
+ foreach i {b1 b2 b3 b4} {
+ button .t.$i -text .t.$i -relief raised -bd 2
+ pack .t.$i
+ }
+ tkwait visibility .t.b4
+}
+proc focusSetupAlt {} {
+ global env
+ catch {destroy .alt}
+ toplevel .alt -screen $env(TK_ALT_DISPLAY)
+ wm withdraw .alt
+ foreach i {a b c d} {
+ 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}}
+
+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."
+ return
+}
+
+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
+ NotifyVirtual NotifyAncestor} {
+ focus -force .
+ update
+ event gen [testwrapper .t] <FocusIn> -detail $detail
+ set focusInfo {}
+ update
+ lappend result $focusInfo
+ }
+ set result
+} {{out . NotifyNonlinear
+in .t NotifyNonlinearVirtual
+in .t.b1 NotifyNonlinear
+} {out . NotifyNonlinear
+in .t NotifyNonlinearVirtual
+in .t.b1 NotifyNonlinear
+} {} {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
+ entry .t.f2.e1 -bg red
+ pack .t.f2.e1
+ bind all <FocusIn> {lappend x "focus in %W %d"}
+ bind all <FocusOut> {lappend x "focus out %W %d"}
+ interp create child
+ child eval "set argv {-use [winfo id .t.f1]}"
+ load {} tk child
+ child eval {
+ entry .e1 -bg lightBlue
+ pack .e1
+ bind all <FocusIn> {lappend x "focus in %W %d"}
+ bind all <FocusOut> {lappend x "focus out %W %d"}
+ set x {}
+ }
+
+ # Claim the focus and wait long enough for it to really arrive.
+
+ focus -force .t.f2.e1
+ after 300 {set timer 1}
+ vwait timer
+ set x {}
+ lappend x [focus] [child eval focus]
+
+ # See if a "focus" command will move the focus to the embedded
+ # application.
+
+ child eval {focus .e1}
+ after 300 {set timer 1}
+ vwait timer
+ lappend x |
+ child eval {lappend x |}
+
+ # Bring the focus back to the main application.
+
+ 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
+ pack .t.f1 .t.f2
+ entry .t.f2.e1 -bg red
+ pack .t.f2.e1
+ bind all <FocusIn> {lappend x "focus in %W %d"}
+ bind all <FocusOut> {lappend x "focus out %W %d"}
+ setupbg -use [winfo id .t.f1]
+ dobg {
+ entry .e1 -bg lightBlue
+ pack .e1
+ bind all <FocusIn> {lappend x "focus in %W %d"}
+ bind all <FocusOut> {lappend x "focus out %W %d"}
+ set x {}
+ }
+
+ # Claim the focus and wait long enough for it to really arrive.
+
+ focus -force .t.f2.e1
+ after 300 {set timer 1}
+ vwait timer
+ set x {}
+ lappend x [focus] [dobg focus]
+
+ # See if a "focus" command will move the focus to the embedded
+ # application.
+
+ dobg {focus .e1}
+ after 300 {set timer 1}
+ vwait timer
+ lappend x |
+ dobg {lappend x |}
+
+ # Bring the focus back to the main application.
+
+ focus .t.f2.e1
+ after 300 {set timer 1}
+ vwait timer
+ set result [list $x [dobg {set x}]]
+ 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> {}
diff --git a/tk/tests/focusTcl.test b/tk/tests/focusTcl.test
new file mode 100644
index 00000000000..19dc0a09c47
--- /dev/null
+++ b/tk/tests/focusTcl.test
@@ -0,0 +1,279 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[info procs test] != "test"} {
+ source defs
+}
+
+eval destroy [winfo children .]
+wm geometry . {}
+raise .
+
+proc setup1 w {
+ if {$w == "."} {
+ set w ""
+ }
+ foreach i {a b c d} {
+ frame $w.$i -width 100 -height 50 -bd 2 -relief raised
+ pack $w.$i
+ }
+ .b configure -width 0 -height 0
+ foreach i {x y z} {
+ button $w.b.$i -text "Button $w.b.$i"
+ pack $w.b.$i -side left
+ }
+ tkwait visibility $w.b.z
+}
+
+option add *takeFocus 1
+option add *highlightThickness 2
+. configure -takefocus 1 -highlightthickness 2
+test focusTcl-1.1 {tk_focusNext procedure, no children} {
+ tk_focusNext .
+} {.}
+setup1 .
+test focusTcl-1.2 {tk_focusNext procedure, basic tree traversal} {
+ tk_focusNext .
+} {.a}
+test focusTcl-1.3 {tk_focusNext procedure, basic tree traversal} {
+ tk_focusNext .a
+} {.b}
+test focusTcl-1.4 {tk_focusNext procedure, basic tree traversal} {
+ tk_focusNext .b
+} {.b.x}
+test focusTcl-1.5 {tk_focusNext procedure, basic tree traversal} {
+ tk_focusNext .b.x
+} {.b.y}
+test focusTcl-1.6 {tk_focusNext procedure, basic tree traversal} {
+ tk_focusNext .b.y
+} {.b.z}
+test focusTcl-1.7 {tk_focusNext procedure, basic tree traversal} {
+ tk_focusNext .b.z
+} {.c}
+test focusTcl-1.8 {tk_focusNext procedure, basic tree traversal} {
+ tk_focusNext .c
+} {.d}
+test focusTcl-1.9 {tk_focusNext procedure, basic tree traversal} {
+ tk_focusNext .d
+} {.}
+foreach w {.b .b.x .b.y .c .d} {
+ $w configure -takefocus 0
+}
+test focusTcl-1.10 {tk_focusNext procedure, basic tree traversal} {
+ tk_focusNext .a
+} {.b.z}
+test focusTcl-1.11 {tk_focusNext procedure, basic tree traversal} {
+ tk_focusNext .b.z
+} {.}
+test focusTcl-1.12 {tk_focusNext procedure, basic tree traversal} {
+ eval destroy [winfo child .]
+ setup1 .
+ update
+ . configure -takefocus 0
+ tk_focusNext .d
+} {.a}
+. configure -takefocus 1
+
+eval destroy [winfo child .]
+setup1 .
+toplevel .t
+wm geom .t +0+0
+toplevel .t2
+wm geom .t2 -0+0
+raise .t .a
+test focusTcl-2.1 {tk_focusNext procedure, toplevels} {
+ tk_focusNext .a
+} {.b}
+test focusTcl-2.2 {tk_focusNext procedure, toplevels} {
+ tk_focusNext .d
+} {.}
+test focusTcl-2.3 {tk_focusNext procedure, toplevels} {
+ tk_focusNext .t
+} {.t}
+setup1 .t
+raise .t.b
+test focusTcl-2.4 {tk_focusNext procedure, toplevels} {
+ tk_focusNext .t
+} {.t.a}
+test focusTcl-2.5 {tk_focusNext procedure, toplevels} {
+ tk_focusNext .t.b.z
+} {.t}
+
+eval destroy [winfo child .]
+test focusTcl-3.1 {tk_focusPrev procedure, no children} {
+ tk_focusPrev .
+} {.}
+setup1 .
+test focusTcl-3.2 {tk_focusPrev procedure, basic tree traversal} {
+ tk_focusPrev .
+} {.d}
+test focusTcl-3.3 {tk_focusPrev procedure, basic tree traversal} {
+ tk_focusPrev .d
+} {.c}
+test focusTcl-3.4 {tk_focusPrev procedure, basic tree traversal} {
+ tk_focusPrev .c
+} {.b.z}
+test focusTcl-3.5 {tk_focusPrev procedure, basic tree traversal} {
+ tk_focusPrev .b.z
+} {.b.y}
+test focusTcl-3.6 {tk_focusPrev procedure, basic tree traversal} {
+ tk_focusPrev .b.y
+} {.b.x}
+test focusTcl-3.7 {tk_focusPrev procedure, basic tree traversal} {
+ tk_focusPrev .b.x
+} {.b}
+test focusTcl-3.8 {tk_focusPrev procedure, basic tree traversal} {
+ tk_focusPrev .b
+} {.a}
+test focusTcl-3.9 {tk_focusPrev procedure, basic tree traversal} {
+ tk_focusPrev .a
+} {.}
+
+eval destroy [winfo child .]
+setup1 .
+toplevel .t
+wm geom .t +0+0
+toplevel .t2
+wm geom .t2 -0+0
+raise .t .a
+test focusTcl-4.1 {tk_focusPrev procedure, toplevels} {
+ tk_focusPrev .
+} {.d}
+test focusTcl-4.2 {tk_focusPrev procedure, toplevels} {
+ tk_focusPrev .b
+} {.a}
+test focusTcl-4.3 {tk_focusPrev procedure, toplevels} {
+ tk_focusPrev .t
+} {.t}
+setup1 .t
+update
+.t configure -takefocus 0
+raise .t.b
+test focusTcl-4.4 {tk_focusPrev procedure, toplevels} {
+ tk_focusPrev .t
+} {.t.b.z}
+test focusTcl-4.5 {tk_focusPrev procedure, toplevels} {
+ tk_focusPrev .t.a
+} {.t.b.z}
+
+eval destroy [winfo child .]
+test focusTcl-5.1 {tkFocusOK procedure, -takefocus 0} {
+ eval destroy [winfo child .]
+ setup1 .
+ .b.x configure -takefocus 0
+ tk_focusNext .b
+} {.b.y}
+test focusTcl-5.2 {tkFocusOK procedure, -takefocus 1} {
+ eval destroy [winfo child .]
+ setup1 .
+ pack forget .b
+ update
+ .b configure -takefocus ""
+ .b.y configure -takefocus ""
+ .b.z configure -takefocus ""
+ list [tk_focusNext .a] [tk_focusNext .b.x]
+} {.c .c}
+test focusTcl-5.3 {tkFocusOK procedure, -takefocus procedure} {
+ proc t w {
+ if {$w == ".b.x"} {
+ return 1
+ } elseif {$w == ".b.y"} {
+ return ""
+ }
+ return 0
+ }
+ eval destroy [winfo child .]
+ setup1 .
+ pack forget .b.y
+ update
+ .b configure -takefocus ""
+ foreach w {.b.x .b.y .b.z .c} {
+ $w configure -takefocus t
+ }
+ list [tk_focusNext .a] [tk_focusNext .b.x]
+} {.b.x .d}
+test focusTcl-5.4 {tkFocusOK procedure, -takefocus ""} {
+ eval destroy [winfo child .]
+ setup1 .
+ .b.x configure -takefocus ""
+ update
+ tk_focusNext .b
+} {.b.x}
+test focusTcl-5.5 {tkFocusOK procedure, -takefocus "", not mapped} {
+ eval destroy [winfo child .]
+ setup1 .
+ .b.x configure -takefocus ""
+ pack unpack .b.x
+ update
+ tk_focusNext .b
+} {.b.y}
+test focusTcl-5.6 {tkFocusOK procedure, -takefocus "", not mapped} {
+ eval destroy [winfo child .]
+ setup1 .
+ foreach w {.b.x .b.y .b.z} {
+ $w configure -takefocus ""
+ }
+ pack unpack .b
+ update
+ tk_focusNext .b
+} {.c}
+test focusTcl-5.7 {tkFocusOK procedure, -takefocus "", not mapped} {
+ eval destroy [winfo child .]
+ setup1 .
+ .b.y configure -takefocus 1
+ pack unpack .b.y
+ update
+ tk_focusNext .b.x
+} {.b.z}
+test focusTcl-5.8 {tkFocusOK procedure, -takefocus "", not mapped} {
+ proc always args {return 1}
+ eval destroy [winfo child .]
+ setup1 .
+ .b.y configure -takefocus always
+ pack unpack .b.y
+ update
+ tk_focusNext .b.x
+} {.b.y}
+test focusTcl-5.9 {tkFocusOK procedure, -takefocus "", window disabled} {
+ eval destroy [winfo child .]
+ setup1 .
+ foreach w {.b.x .b.y .b.z} {
+ $w configure -takefocus ""
+ }
+ update
+ .b.x configure -state disabled
+ tk_focusNext .b
+} {.b.y}
+test focusTcl-5.10 {tkFocusOK procedure, -takefocus "", check for bindings} {
+ eval destroy [winfo child .]
+ setup1 .
+ foreach w {.a .b .c .d} {
+ $w configure -takefocus ""
+ }
+ update
+ bind .a <Key> {foo}
+ list [tk_focusNext .] [tk_focusNext .a]
+} {.a .b.x}
+test focusTcl-5.11 {tkFocusOK procedure, -takefocus "", check for bindings} {
+ eval destroy [winfo child .]
+ setup1 .
+ foreach w {.a .b .c .d} {
+ $w configure -takefocus ""
+ }
+ update
+ bind Frame <Key> {foo}
+ list [tk_focusNext .] [tk_focusNext .a]
+} {.a .b}
+
+bind Frame <Key> {}
+. configure -takefocus 0 -highlightthickness 0
+option clear
diff --git a/tk/tests/font.test b/tk/tests/font.test
new file mode 100644
index 00000000000..f36fe049544
--- /dev/null
+++ b/tk/tests/font.test
@@ -0,0 +1,1092 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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 "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
+ return "[winfo reqwidth .b.l] [winfo reqheight .b.l]"
+}
+
+proc csetup {{str ""}} {
+ focus -force .b.c
+ .b.c dchars text 0 end
+ .b.c insert text 0 $str
+ .b.c focus text
+}
+
+setup
+
+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} {
+ lappend x [psfontname $name]
+ } else {
+ lappend x [lindex $p $i]
+ }
+ incr i
+ }
+ }
+ incr i
+ set x
+ } [lrange $p 1 end]
+}
+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"
+ .b.c insert text end "end"
+ set x [.b.c postscript]
+ set i [string first "(qwerty" $x]
+ string range $x $i [expr {$i + 213}]
+} {(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)
+(qwertyuiopasdfghjklzxcvbnm1234qwertyuiopasdfghjklzxcvbnm)
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+()
+(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
diff --git a/tk/tests/frame.test b/tk/tests/frame.test
new file mode 100644
index 00000000000..3919f576a97
--- /dev/null
+++ b/tk/tests/frame.test
@@ -0,0 +1,617 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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.
+
+proc eatColors {w} {
+ catch {destroy $w}
+ toplevel $w
+ wm geom $w +0+0
+ canvas $w.c -width 400 -height 200 -bd 0
+ pack $w.c
+ for {set y 0} {$y < 8} {incr y} {
+ for {set x 0} {$x < 40} {incr x} {
+ set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0]
+ $w.c create rectangle [expr 10*$x] [expr 20*$y] \
+ [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \
+ -fill $color
+ }
+ }
+ update
+}
+
+# colorsFree --
+#
+# Returns 1 if there appear to be free colormap entries in a window,
+# 0 otherwise.
+#
+# Arguments:
+# w - Name of window in which to check.
+# red, green, blue - Intensities to use in a trial color allocation
+# to see if there are colormap entries free.
+
+proc colorsFree {w {red 31} {green 245} {blue 192}} {
+ set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]]
+ expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) \
+ && ([lindex $vals 2]/256 == $blue)
+}
+
+test frame-1.1 {frame configuration options} {
+ frame .f -class NewFrame
+ list [.f configure -class] [catch {.f configure -class Different} msg] $msg
+} {{-class class Class Frame NewFrame} 1 {can't modify -class option after widget is created}}
+catch {destroy .f}
+test frame-1.2 {frame configuration options} {
+ list [catch {frame .f -colormap new} msg] $msg
+} {0 .f}
+catch {destroy .f}
+test frame-1.3 {frame configuration options} {
+ list [catch {frame .f -visual default} msg] $msg
+} {0 .f}
+catch {destroy .f}
+test frame-1.4 {frame configuration options} {
+ list [catch {frame .f -screen bogus} msg] $msg
+} {1 {unknown option "-screen"}}
+test frame-1.5 {frame configuration options} {
+ set result [list [catch {frame .f -container true} msg] $msg \
+ [.f configure -container]]
+ destroy .f
+ set result
+} {0 .f {-container container Container 0 1}}
+test frame-1.6 {frame configuration options} {
+ list [catch {frame .f -container bogus} msg] $msg
+} {1 {expected boolean value but got "bogus"}}
+test frame-1.7 {frame configuration options} {
+ frame .f
+ set result [list [catch {.f configure -container 1} msg] $msg]
+ destroy .f
+ set result
+} {1 {can't modify -container option after widget is created}}
+frame .f
+set i 8
+foreach test {
+ {-background #ff0000 #ff0000 non-existent
+ {unknown color name "non-existent"}}
+ {-bd 4 4 badValue {bad screen distance "badValue"}}
+ {-bg #00ff00 #00ff00 non-existent
+ {unknown color name "non-existent"}}
+ {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
+ {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
+ {-height 100 100 not_a_number {bad screen distance "not_a_number"}}
+ {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
+ {-highlightcolor #123456 #123456 non-existent
+ {unknown color name "non-existent"}}
+ {-highlightthickness 6 6 badValue {bad screen distance "badValue"}}
+ {-relief ridge ridge badValue {bad relief type "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-takefocus "any string" "any string" {} {}}
+ {-width 32 32 badValue {bad screen distance "badValue"}}
+} {
+ set name [lindex $test 0]
+ test frame-1.$i {frame configuration options} {
+ .f configure $name [lindex $test 1]
+ lindex [.f configure $name] 4
+ } [lindex $test 2]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test frame-1.$i {frame configuration options} {
+ list [catch {.f configure $name [lindex $test 3]} msg] $msg
+ } [list 1 [lindex $test 4]]
+ }
+ .f configure $name [lindex [.f configure $name] 3]
+ incr i
+}
+destroy .f
+
+set i 1
+test frame-2.1 {toplevel configuration options} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100 -class NewClass
+ wm geometry .t +0+0
+ list [.t configure -class] [catch {.t configure -class Another} msg] $msg
+} {{-class class Class Toplevel NewClass} 1 {can't modify -class option after widget is created}}
+test frame-2.2 {toplevel configuration options} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100 -colormap new
+ wm geometry .t +0+0
+ list [.t configure -colormap] [catch {.t configure -colormap .} msg] $msg
+} {{-colormap colormap Colormap {} new} 1 {can't modify -colormap option after widget is created}}
+test frame-2.3 {toplevel configuration options} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100
+ wm geometry .t +0+0
+ list [catch {.t configure -container 1} msg] $msg [.t configure -container]
+} {1 {can't modify -container option after widget is created} {-container container Container 0 0}}
+test frame-2.4 {toplevel configuration options} {
+ catch {destroy .t}
+ list [catch {toplevel .t -width 200 -height 100 -colormap bogus} msg] $msg
+} {1 {bad window path name "bogus"}}
+set default "[winfo visual .] [winfo depth .]"
+test frame-2.5 {toplevel configuration options} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100
+ wm geometry .t +0+0
+ list [catch {.t configure -use 0x44022} msg] $msg [.t configure -use]
+} {1 {can't modify -use option after widget is created} {-use use Use {} {}}}
+test frame-2.6 {toplevel configuration options} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100 -visual default
+ wm geometry .t +0+0
+ list [.t configure -visual] [catch {.t configure -visual best} msg] $msg
+} {{-visual visual Visual {} default} 1 {can't modify -visual option after widget is created}}
+test frame-2.7 {toplevel configuration options} {
+ catch {destroy .t}
+ list [catch {toplevel .t -width 200 -height 100 -visual who_knows?} msg] $msg
+} {1 {unknown or ambiguous visual name "who_knows?": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}}
+if [info exists env(DISPLAY)] {
+ test frame-2.8 {toplevel configuration options} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100 -screen $env(DISPLAY)
+ wm geometry .t +0+0
+ list [.t configure -screen] \
+ [catch {.t configure -screen another} msg] $msg
+ } [list [list -screen screen Screen {} $env(DISPLAY)] 1 {can't modify -screen option after widget is created}]
+}
+test frame-2.9 {toplevel configuration options} {
+ catch {destroy .t}
+ list [catch {toplevel .t -width 200 -height 100 -screen bogus} msg] $msg
+} {1 {couldn't connect to display "bogus"}}
+catch {destroy .t}
+toplevel .t -width 300 -height 150
+wm geometry .t +0+0
+update
+set i 8
+foreach test {
+ {-background #ff0000 #ff0000 non-existent
+ {unknown color name "non-existent"}}
+ {-bd 4 4 badValue {bad screen distance "badValue"}}
+ {-bg #00ff00 #00ff00 non-existent
+ {unknown color name "non-existent"}}
+ {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
+ {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
+ {-height 100 100 not_a_number {bad screen distance "not_a_number"}}
+ {-highlightcolor #123456 #123456 non-existent
+ {unknown color name "non-existent"}}
+ {-highlightthickness 3 3 badValue {bad screen distance "badValue"}}
+ {-relief ridge ridge badValue {bad relief type "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-width 32 32 badValue {bad screen distance "badValue"}}
+} {
+ set name [lindex $test 0]
+ test frame-2.$i {frame configuration options} {
+ .t configure $name [lindex $test 1]
+ lindex [.t configure $name] 4
+ } [lindex $test 2]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test frame-2.$i {frame configuration options} {
+ list [catch {.t configure $name [lindex $test 3]} msg] $msg
+ } [list 1 [lindex $test 4]]
+ }
+ .t configure $name [lindex [.t configure $name] 3]
+ incr i
+}
+
+test frame-3.1 {TkCreateFrame procedure} {
+ list [catch frame msg] $msg
+} {1 {wrong # args: should be "frame pathName ?options?"}}
+test frame-3.2 {TkCreateFrame procedure} {
+ catch {destroy .f}
+ frame .f
+ set result [.f configure -class]
+ destroy .f
+ set result
+} {-class class Class Frame Frame}
+test frame-3.3 {TkCreateFrame procedure} {
+ catch {destroy .t}
+ toplevel .t
+ wm geometry .t +0+0
+ set result [.t configure -class]
+ destroy .t
+ set result
+} {-class class Class Toplevel Toplevel}
+test frame-3.4 {TkCreateFrame procedure} {
+ catch {destroy .t}
+ toplevel .t -width 350 -class NewClass -bg black -visual default -height 90
+ wm geometry .t +0+0
+ update
+ list [lindex [.t configure -width] 4] \
+ [lindex [.t configure -background] 4] \
+ [lindex [.t configure -height] 4]
+} {350 black 90}
+
+# Be sure that the -class, -colormap, and -visual options are processed
+# before configuring the widget.
+
+test frame-3.5 {TkCreateFrame procedure} {
+ catch {destroy .f}
+ option add *NewFrame.background #123456
+ frame .f -class NewFrame
+ option clear
+ lindex [.f configure -background] 4
+} {#123456}
+test frame-3.6 {TkCreateFrame procedure} {
+ catch {destroy .f}
+ option add *NewFrame.background #123456
+ frame .f -class NewFrame
+ option clear
+ lindex [.f configure -background] 4
+} {#123456}
+test frame-3.7 {TkCreateFrame procedure} {
+ catch {destroy .f}
+ option add *NewFrame.background #332211
+ option add *f.class NewFrame
+ frame .f
+ option clear
+ list [lindex [.f configure -class] 4] [lindex [.f configure -background] 4]
+} {NewFrame #332211}
+test frame-3.8 {TkCreateFrame procedure} {
+ catch {destroy .f}
+ option add *Silly.background #122334
+ option add *f.Class Silly
+ frame .f
+ option clear
+ list [lindex [.f configure -class] 4] [lindex [.f configure -background] 4]
+} {Silly #122334}
+test frame-3.9 {TkCreateFrame procedure, -use option} unixOnly {
+ catch {destroy .t}
+ catch {destroy .x}
+ toplevel .t -container 1 -width 300 -height 120
+ wm geometry .t +0+0
+ toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green
+ tkwait visibility .x
+ set result "[expr [winfo rootx .x] - [winfo rootx .t]] [expr [winfo rooty .x] - [winfo rooty .t]] [winfo width .t] [winfo height .t]"
+ destroy .t
+ set result
+} {0 0 140 300}
+test frame-3.10 {TkCreateFrame procedure, -use option} unixOnly {
+ catch {destroy .t}
+ catch {destroy .x}
+ toplevel .t -container 1 -width 300 -height 120
+ wm geometry .t +0+0
+ option add *x.use [winfo id .t]
+ toplevel .x -width 140 -height 300 -bg green
+ tkwait visibility .x
+ set result "[expr [winfo rootx .x] - [winfo rootx .t]] [expr [winfo rooty .x] - [winfo rooty .t]] [winfo width .t] [winfo height .t]"
+ destroy .t
+ option clear
+ set result
+} {0 0 140 300}
+
+# The tests below require specific display characteristics. Even so,
+# they are non-portable: some machines don't seem to ever run out of
+# colors.
+
+if {([winfo visual .] == "pseudocolor") && ([winfo depth .] == 8)} {
+ eatColors .t1
+ test frame-3.11 {TkCreateFrame procedure} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 300 -height 200 -bg #475601
+ wm geometry .t +0+0
+ update
+ colorsFree .t
+ } {0}
+ test frame-3.12 {TkCreateFrame procedure} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 300 -height 200 -bg #475601 -colormap new
+ wm geometry .t +0+0
+ update
+ colorsFree .t
+ } {1}
+ test frame-3.13 {TkCreateFrame procedure} {nonPortable} {
+ catch {destroy .t}
+ option add *t.class Toplevel2
+ option add *Toplevel2.colormap new
+ toplevel .t -width 300 -height 200 -bg #475601
+ wm geometry .t +0+0
+ update
+ option clear
+ colorsFree .t
+ } {1}
+ test frame-3.14 {TkCreateFrame procedure} {nonPortable} {
+ catch {destroy .t}
+ option add *t.class Toplevel3
+ option add *Toplevel3.Colormap new
+ toplevel .t -width 300 -height 200 -bg #475601 -colormap new
+ wm geometry .t +0+0
+ update
+ option clear
+ colorsFree .t
+ } {1}
+ test frame-3.15 {TkCreateFrame procedure, -use and -colormap} {unixOnly nonPortable} {
+ catch {destroy .t}
+ catch {destroy .x}
+ toplevel .t -container 1 -width 300 -height 120
+ wm geometry .t +0+0
+ toplevel .x -width 140 -height 300 -use [winfo id .t] -bg green -colormap new
+ tkwait visibility .x
+ set result "[colorsFree .t] [colorsFree .x]"
+ destroy .t
+ set result
+ } {0 1}
+ test frame-3.16 {TkCreateFrame procedure} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 300 -height 200 -bg #475601 -visual default
+ wm geometry .t +0+0
+ update
+ colorsFree .t
+ } {0}
+ test frame-3.17 {TkCreateFrame procedure} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 300 -height 200 -bg #475601 -visual default \
+ -colormap new
+ wm geometry .t +0+0
+ update
+ colorsFree .t
+ } {1}
+ if {[lsearch -exact [winfo visualsavailable .] {grayscale 8}] >= 0} {
+ test frame-3.18 {TkCreateFrame procedure} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -visual {grayscale 8} -width 300 -height 200 \
+ -bg #434343
+ wm geometry .t +0+0
+ update
+ colorsFree .t 131 131 131
+ } {1}
+ test frame-3.19 {TkCreateFrame procedure} {nonPortable} {
+ catch {destroy .t}
+ option add *t.class T4
+ option add *T4.visual {grayscale 8}
+ toplevel .t -width 300 -height 200 -bg #434343
+ wm geometry .t +0+0
+ update
+ option clear
+ list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]
+ } {1 {grayscale 8}}
+ test frame-3.20 {TkCreateFrame procedure} {nonPortable} {
+ catch {destroy .t}
+ set x ok
+ option add *t.class T5
+ option add *T5.Visual {grayscale 8}
+ toplevel .t -width 300 -height 200 -bg #434343
+ wm geometry .t +0+0
+ update
+ option clear
+ list [colorsFree .t 131 131 131] [lindex [.t configure -visual] 4]
+ } {1 {grayscale 8}}
+ test frame-3.21 {TkCreateFrame procedure} {nonPortable} {
+ catch {destroy .t}
+ set x ok
+ toplevel .t -visual {grayscale 8} -width 300 -height 200 \
+ -bg #434343
+ wm geometry .t +0+0
+ update
+ colorsFree .t 131 131 131
+ } {1}
+ }
+ destroy .t1
+}
+test frame-3.22 {TkCreateFrame procedure, default dimensions} {
+ catch {destroy .t}
+ toplevel .t
+ wm geometry .t +0+0
+ update
+ set result "[winfo reqwidth .t] [winfo reqheight .t]"
+ frame .t.f -bg red
+ pack .t.f
+ update
+ lappend result [winfo reqwidth .t.f] [winfo reqheight .t.f]
+ destroy .t
+ set result
+} {200 200 1 1}
+test frame-3.23 {TkCreateFrame procedure} {
+ catch {destroy .f}
+ list [catch {frame .f -gorp glob} msg] $msg
+} {1 {unknown option "-gorp"}}
+test frame-3.24 {TkCreateFrame procedure} {
+ catch {destroy .t}
+ list [catch {
+ toplevel .t -width 300 -height 200 -colormap new -bogus option
+ wm geometry .t +0+0
+ } msg] $msg
+} {1 {unknown option "-bogus"}}
+
+test frame-4.1 {TkCreateFrame procedure} {
+ catch {destroy .f}
+ catch {frame .f -gorp glob}
+ winfo exists .f
+} 0
+test frame-4.2 {TkCreateFrame procedure} {
+ catch {destroy .f}
+ list [frame .f -width 200 -height 100] [winfo exists .f]
+} {.f 1}
+
+catch {destroy .f}
+frame .f -highlightcolor black
+test frame-5.1 {FrameWidgetCommand procedure} {
+ list [catch .f msg] $msg
+} {1 {wrong # args: should be ".f option ?arg arg ...?"}}
+test scale-5.2 {FrameWidgetCommand procedure, cget option} {
+ list [catch {.f cget} msg] $msg
+} {1 {wrong # args: should be ".f cget option"}}
+test scale-5.3 {FrameWidgetCommand procedure, cget option} {
+ list [catch {.f cget a b} msg] $msg
+} {1 {wrong # args: should be ".f cget option"}}
+test scale-5.4 {FrameWidgetCommand procedure, cget option} {
+ list [catch {.f cget -gorp} msg] $msg
+} {1 {unknown option "-gorp"}}
+test scale-5.5 {FrameWidgetCommand procedure, cget option} {
+ .f cget -highlightcolor
+} {black}
+test scale-5.6 {FrameWidgetCommand procedure, cget option} {
+ list [catch {.f cget -screen} msg] $msg
+} {1 {unknown option "-screen"}}
+test scale-5.7 {FrameWidgetCommand procedure, cget option} {
+ catch {destroy .t}
+ toplevel .t
+ catch {.t cget -screen}
+} {0}
+catch {destroy .t}
+test frame-5.8 {FrameWidgetCommand procedure, configure option} {
+ llength [.f configure]
+} {16}
+test frame-5.9 {FrameWidgetCommand procedure, configure option} {
+ list [catch {.f configure -gorp} msg] $msg
+} {1 {unknown option "-gorp"}}
+test frame-5.10 {FrameWidgetCommand procedure, configure option} {
+ list [catch {.f configure -gorp bogus} msg] $msg
+} {1 {unknown option "-gorp"}}
+test frame-5.11 {FrameWidgetCommand procedure, configure option} {
+ list [catch {.f configure -width 200 -height} msg] $msg
+} {1 {value for "-height" missing}}
+test frame-5.12 {FrameWidgetCommand procedure} {
+ list [catch {.f swizzle} msg] $msg
+} {1 {bad option "swizzle": must be cget or configure}}
+
+test frame-6.1 {ConfigureFrame procedure} {
+ catch {destroy .f}
+ frame .f -width 150
+ list [winfo reqwidth .f] [winfo reqheight .f]
+} {150 1}
+test frame-6.2 {ConfigureFrame procedure} {
+ catch {destroy .f}
+ frame .f -height 97
+ list [winfo reqwidth .f] [winfo reqheight .f]
+} {1 97}
+test frame-6.3 {ConfigureFrame procedure} {
+ catch {destroy .f}
+ frame .f
+ set result {}
+ lappend result [winfo reqwidth .f] [winfo reqheight .f]
+ .f configure -width 100 -height 180
+ lappend result [winfo reqwidth .f] [winfo reqheight .f]
+ .f configure -width 0 -height 0
+ lappend result [winfo reqwidth .f] [winfo reqheight .f]
+} {1 1 100 180 100 180}
+
+test frame-7.1 {FrameEventProc procedure} {
+ frame .frame2
+ set result [info commands .frame2]
+ destroy .frame2
+ lappend result [info commands .frame2]
+} {.frame2 {}}
+test frame-7.2 {FrameEventProc procedure} {
+ eval destroy [winfo children .]
+ frame .f1 -bg #543210
+ rename .f1 .f2
+ set x {}
+ lappend x [winfo children .]
+ lappend x [.f2 cget -bg]
+ destroy .f1
+ lappend x [info command .f*] [winfo children .]
+} {.f1 #543210 {} {}}
+
+test frame-8.1 {FrameCmdDeletedProc procedure} {
+ eval destroy [winfo children .]
+ frame .f1
+ rename .f1 {}
+ list [info command .f*] [winfo children .]
+} {{} {}}
+test frame-8.2 {FrameCmdDeletedProc procedure} {
+ eval destroy [winfo children .]
+ toplevel .f1 -menu .m
+ wm geometry .f1 +0+0
+ update
+ rename .f1 {}
+ update
+ list [info command .f*] [winfo children .]
+} {{} {}}
+test frame-8.3 {FrameCmdDeletedProc procedure} {
+ eval destroy [winfo children .]
+ toplevel .f1 -menu .m
+ wm geometry .f1 +0+0
+ menu .m
+ update
+ rename .f1 {}
+ update
+ set result [list [info command .f*] [winfo children .]]
+ eval destroy [winfo children .]
+ set result
+} {{} .m}
+
+test frame-9.1 {MapFrame procedure} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 400
+ wm geometry .t +0+0
+ set result [winfo ismapped .t]
+ update idletasks
+ lappend result [winfo ismapped .t]
+} {0 1}
+test frame-9.2 {MapFrame procedure} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 400
+ wm geometry .t +0+0
+ destroy .t
+ update
+ winfo exists .t
+} {0}
+test frame-9.3 {MapFrame procedure, window deleted while mapping} {
+ toplevel .t2 -width 200 -height 200
+ wm geometry .t2 +0+0
+ tkwait visibility .t2
+ catch {destroy .t}
+ toplevel .t -width 100 -height 400
+ wm geometry .t +0+0
+ frame .t2.f -width 50 -height 50
+ bind .t2.f <Configure> {destroy .t}
+ pack .t2.f -side top
+ update idletasks
+ winfo exists .t
+} {0}
+
+set l [interp hidden]
+eval destroy [winfo children .]
+
+test frame-10.1 {frame widget vs hidden commands} {
+ catch {destroy .t}
+ frame .t
+ interp hide {} .t
+ destroy .t
+ list [winfo children .] [interp hidden]
+} [list {} $l]
+
+test frame-11.1 {TkInstallFrameMenu} {
+ catch {destroy .t}
+ menu .m1
+ .m1 add cascade -menu .m1.system
+ menu .m1.system -tearoff 0
+ .m1.system add command -label foo
+ list [toplevel .t -menu .m1] [destroy .m1] [destroy .t]
+} {.t {} {}}
+test frame-11.2 {TkInstallFrameMenu - frame renamed} {
+ catch {destroy .t}
+ catch {rename foo {}}
+ menu .m1
+ .m1 add cascade -menu .m1.system
+ menu .m1.system -tearoff 0
+ .m1.system add command -label foo
+ toplevel .t
+ list [rename .t foo] [destroy .t] [destroy foo] [destroy .m1]
+} {{} {} {} {}}
+
+
+catch {destroy .f}
+rename eatColors {}
+rename colorsFree {}
diff --git a/tk/tests/geometry.test b/tk/tests/geometry.test
new file mode 100644
index 00000000000..1144e3ef95c
--- /dev/null
+++ b/tk/tests/geometry.test
@@ -0,0 +1,251 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[info procs test] != "test"} {
+ source defs
+}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+wm geometry . 300x300
+raise .
+update
+
+frame .f -bd 2 -relief raised
+frame .f.f -bd 2 -relief sunken
+frame .f.f.f -bd 2 -relief raised
+button .b1 -text .b1
+button .b2 -text .b2
+button .b3 -text .b3
+button .f.f.b4 -text .b4
+
+test geometry-1.1 {Tk_ManageGeometry procedure} {
+ place .b1 -x 120 -y 80
+ update
+ list [winfo x .b1] [winfo y .b1]
+} {120 80}
+test geometry-1.2 {Tk_ManageGeometry procedure} {
+ foreach w {.f .f.f .f.f.f .b1 .b2 .b3} {
+ place forget $w
+ }
+ place .f -x 20 -y 30 -width 200 -height 200
+ place .b1 -in .f -x 40 -y 30
+ update
+ pack .b1 -side top -anchor w
+ place .f -x 30 -y 40
+ update
+ list [winfo x .b1] [winfo y .b1]
+} {0 0}
+
+test geometry-2.1 {Tk_GeometryRequest procedure} {
+ frame .f2
+ set result [list [winfo reqwidth .f2] [winfo reqheight .f2]]
+ .f2 configure -width 150 -height 300
+ update
+ lappend result [winfo reqwidth .f2] [winfo reqheight .f2] \
+ [winfo geom .f2]
+ place .f2 -x 10 -y 20
+ update
+ lappend result [winfo geom .f2]
+ .f2 configure -width 100 -height 80
+ update
+ lappend result [winfo geom .f2]
+} {1 1 150 300 1x1+0+0 150x300+10+20 100x80+10+20}
+catch {destroy .f2}
+
+test geometry-3.1 {Tk_SetInternalBorder procedure} {
+ foreach w {.f .f.f .f.f.f .b1 .b2 .b3} {
+ place forget $w
+ }
+ place .f -x 20 -y 30 -width 200 -height 200
+ place .b1 -in .f -x 50 -y 5
+ update
+ set x [list [winfo x .b1] [winfo y .b1]]
+ .f configure -bd 5
+ update
+ lappend x [winfo x .b1] [winfo y .b1]
+} {72 37 75 40}
+.f configure -bd 2
+
+test geometry-4.1 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} {
+ foreach w {.f .f.f .f.f.f .b1 .b2 .b3} {
+ place forget $w
+ }
+ place .f -x 20 -y 30 -width 200 -height 200
+ place .f.f -x 15 -y 5 -width 150 -height 120
+ place .f.f.f -width 100 -height 80
+ place .b1 -in .f.f.f -x 50 -y 5
+ update
+ list [winfo x .b1] [winfo y .b1]
+} {91 46}
+test geometry-4.2 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} {
+ foreach w {.f .f.f .f.f.f .b1 .b2 .b3} {
+ place forget $w
+ }
+ place .f -x 20 -y 30 -width 200 -height 200
+ place .f.f -x 15 -y 5 -width 150 -height 120
+ place .f.f.f -width 100 -height 80
+ place .b1 -in .f.f.f -x 50 -y 5
+ place .b2 -in .f.f.f -x 10 -y 25
+ place .b3 -in .f.f.f -x 50 -y 25
+ update
+ place .f -x 30 -y 25
+ update
+ list [winfo x .b1] [winfo y .b1] [winfo x .b2] [winfo y .b2] \
+ [winfo x .b3] [winfo y .b3]
+} {101 41 61 61 101 61}
+test geometry-4.3 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} {
+ foreach w {.f .f.f .f.f.f .b1 .b2 .b3} {
+ place forget $w
+ }
+ place .f -x 20 -y 30 -width 200 -height 200
+ place .f.f -x 15 -y 5 -width 150 -height 120
+ place .f.f.f -width 100 -height 80
+ place .b1 -in .f.f.f -x 50 -y 5
+ place .b2 -in .f.f.f -x 10 -y 25
+ place .b3 -in .f.f.f -x 50 -y 25
+ update
+ destroy .b1
+ button .b1 -text .b1
+ place .f.f -x 10 -y 25
+ update
+ list [winfo x .b1] [winfo y .b1] [winfo x .b2] [winfo y .b2] \
+ [winfo x .b3] [winfo y .b3]
+} {0 0 46 86 86 86}
+test geometry-4.4 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} {
+ foreach w {.f .f.f .f.f.f .b1 .b2 .b3} {
+ place forget $w
+ }
+ place .f -x 20 -y 30 -width 200 -height 200
+ place .f.f -x 15 -y 5 -width 150 -height 120
+ place .f.f.f -width 100 -height 80
+ place .b1 -in .f.f.f -x 50 -y 5
+ place .b2 -in .f.f.f -x 10 -y 25
+ place .b3 -in .f.f.f -x 50 -y 25
+ update
+ destroy .b2
+ button .b2 -text .b2
+ place .f.f.f -x 2 -y 3
+ update
+ list [winfo x .b1] [winfo y .b1] [winfo x .b2] [winfo y .b2] \
+ [winfo x .b3] [winfo y .b3]
+} {93 49 0 0 93 69}
+test geometry-4.5 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} {
+ foreach w {.f .f.f .f.f.f .b1 .b2 .b3} {
+ place forget $w
+ }
+ place .f -x 20 -y 30 -width 200 -height 200
+ place .f.f -x 15 -y 5 -width 150 -height 120
+ place .f.f.f -width 100 -height 80
+ place .b1 -in .f.f.f -x 50 -y 5
+ place .b2 -in .f.f.f -x 10 -y 25
+ place .b3 -in .f.f.f -x 50 -y 25
+ update
+ destroy .b3
+ button .b3 -text .b3
+ place .f.f.f -x 2 -y 3
+ update
+ list [winfo x .b1] [winfo y .b1] [winfo x .b2] [winfo y .b2] \
+ [winfo x .b3] [winfo y .b3]
+} {93 49 53 69 0 0}
+test geometry-4.6 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} {
+ foreach w {.f .f.f .f.f.f .b1 .b2 .b3 .f.f.b4} {
+ place forget $w
+ }
+ place .f -x 20 -y 30 -width 200 -height 200
+ place .f.f -x 15 -y 5 -width 150 -height 120
+ place .f.f.f -width 100 -height 80
+ place .f.f.b4 -in .f.f.f -x 50 -y 5
+ place .b2 -in .f.f.f -x 10 -y 25
+ update
+ place .f -x 25 -y 35
+ update
+ list [winfo x .f.f.b4] [winfo y .f.f.b4] [winfo x .b2] [winfo y .b2]
+} {54 9 56 71}
+test geometry-4.7 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} {
+ foreach w {.f .f.f .f.f.f .b1 .b2 .b3 .f.f.b4} {
+ place forget $w
+ }
+ bind .b1 <Configure> {lappend x configure}
+ place .f -x 20 -y 30 -width 200 -height 200
+ place .f.f -x 15 -y 5 -width 150 -height 120
+ place .f.f.f -width 100 -height 80
+ place .f.f.b4 -in .f.f.f -x 50 -y 5
+ place .b1 -in .f.f.f -x 10 -y 25
+ update
+ set x init
+ place .f -x 25 -y 35
+ update
+ lappend x |
+ place .f -x 30 -y 40
+ place .f.f -x 10 -y 0
+ update
+ bind .b1 <Configure> {}
+ set x
+} {init configure |}
+test geometry-4.8 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} {
+ foreach w {.f .f.f .f.f.f .b1 .b2 .b3} {
+ place forget $w
+ }
+ place .f -x 20 -y 30 -width 200 -height 200
+ place .f.f -x 15 -y 5 -width 150 -height 120
+ place .f.f.f -width 100 -height 80
+ place .b1 -in .f.f.f -x 50 -y 5
+ place .b2 -in .f.f.f -x 10 -y 25
+ place .b3 -in .f.f.f -x 50 -y 25
+ update
+ destroy .f.f
+ frame .f.f -bd 2 -relief raised
+ frame .f.f.f -bd 2 -relief raised
+ place .f -x 30 -y 25
+ update
+ list [winfo x .b1] [winfo y .b1] [winfo ismapped .b1] \
+ [winfo x .b2] [winfo y .b2] [winfo ismapped .b2] \
+ [winfo x .b3] [winfo y .b3] [winfo ismapped .b3]
+} {91 46 0 51 66 0 91 66 0}
+test geometry-4.9 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} {
+ foreach w {.f .f.f .f.f.f .b1 .b2 .b3} {
+ place forget $w
+ }
+ place .f -x 20 -y 30 -width 200 -height 200
+ place .f.f -x 15 -y 5 -width 150 -height 120
+ place .f.f.f -width 100 -height 80
+ place .b1 -in .f.f.f -x 50 -y 5
+ update
+ set result [winfo ismapped .b1]
+ place forget .f.f
+ update
+ lappend result [winfo ismapped .b1]
+ place .f.f -x 15 -y 5 -width 150 -height 120
+ update
+ lappend result [winfo ismapped .b1]
+} {1 0 1}
+test geometry-4.10 {Tk_MaintainGeometry and Tk_UnmaintainGeometry} {
+ toplevel .t
+ wm geometry .t +0+0
+ tkwait visibility .t
+ update
+ frame .t.f
+ pack .t.f
+ button .t.quit -text Quit -command exit
+ pack .t.quit -in .t.f
+ wm iconify .t
+ set x 0
+ after 500 {set x 1}
+ tkwait variable x
+ wm deiconify .t
+ update
+ winfo ismapped .t.quit
+} {1}
+catch {destroy .t}
+concat
diff --git a/tk/tests/grid.test b/tk/tests/grid.test
new file mode 100644
index 00000000000..f4e27626efc
--- /dev/null
+++ b/tk/tests/grid.test
@@ -0,0 +1,1205 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+ if {[info exists GRID_VERBOSE]} {
+ if {$GRID_VERBOSE=="" || $GRID_VERBOSE==$test} {
+ puts -nonewline "grid test $test: "
+ flush stdout
+ gets stdin
+ }
+ }
+ eval destroy [winfo children $top]
+ update
+ foreach {cols rows} [grid size .] {}
+ for {set i 0} {$i <= $cols} {incr i} {
+ grid columnconfigure . $i -weight 0 -minsize 0 -pad 0
+ }
+ for {set i 0} {$i <= $rows} {incr i} {
+ grid rowconfigure . $i -weight 0 -minsize 0 -pad 0
+ }
+ grid propagate . 1
+ update
+}
+
+grid_reset 0.0
+wm geometry . {}
+
+test grid-1.1 {basic argument checking} {
+ list [catch grid msg] $msg
+} {1 {wrong # args: should be "grid option arg ?arg ...?"}}
+
+test grid-1.2 {basic argument checking} {
+ list [catch {grid foo bar} msg] $msg
+} {1 {bad option "foo": must be bbox, columnconfigure, configure, forget, info, location, propagate, remove, rowconfigure, size, or slaves.}}
+
+test grid-1.3 {basic argument checking} {
+ button .b
+ list [catch {grid .b -row 0 -column} msg] $msg
+} {1 {extra option or option with no value}}
+grid_reset 1.3
+
+test grid-1.4 {basic argument checking} {
+ button .b
+ list [catch {grid configure .b - foo} msg] $msg
+} {1 {unexpected parameter, "foo", in configure list. Should be window name or option}}
+grid_reset 1.4
+
+test grid-1.5 {basic argument checking} {
+ list [catch {grid .} msg] $msg
+} {1 {can't manage ".": it's a top-level window}}
+
+test grid-1.6 {basic argument checking} {
+ list [catch {grid x} msg] $msg
+} {1 {can't determine master window}}
+
+test grid-2.1 {bbox} {
+ list [catch {grid bbox .} msg] $msg
+} {0 {0 0 0 0}}
+
+test grid-2.2 {bbox} {
+ button .b
+ grid .b
+ destroy .b
+ update
+ list [catch {grid bbox .} msg] $msg
+} {0 {0 0 0 0}}
+
+test grid-2.3 {bbox: argument checking} {
+ list [catch {grid bbox . 0 0 5} msg] $msg
+} {1 {wrong number of arguments: must be "grid bbox master ?column row ?column row??"}}
+
+test grid-2.4 {bbox} {
+ list [catch {grid bbox .bad 0 0} msg] $msg
+} {1 {bad window path name ".bad"}}
+
+test grid-2.5 {bbox} {
+ list [catch {grid bbox . x 0} msg] $msg
+} {1 {expected integer but got "x"}}
+
+test grid-2.6 {bbox} {
+ list [catch {grid bbox . 0 x} msg] $msg
+} {1 {expected integer but got "x"}}
+
+test grid-2.7 {bbox} {
+ list [catch {grid bbox . 0 0 x 0} msg] $msg
+} {1 {expected integer but got "x"}}
+
+test grid-2.8 {bbox} {
+ list [catch {grid bbox . 0 0 0 x} msg] $msg
+} {1 {expected integer but got "x"}}
+
+test grid-2.9 {bbox} {
+ frame .1 -width 75 -height 75 -bg red
+ frame .2 -width 90 -height 90 -bg red
+ grid .1 -row 0 -column 0
+ grid .2 -row 1 -column 1
+ update
+ set a ""
+ lappend a [grid bbox .]
+ lappend a [grid bbox . 0 0]
+ lappend a [grid bbox . 0 0 1 1]
+ lappend a [grid bbox . 1 1]
+ set a
+} {{0 0 165 165} {0 0 75 75} {0 0 165 165} {75 75 90 90}}
+grid_reset 2.9
+
+test grid-2.10 {bbox} {
+ frame .1 -width 75 -height 75 -bg red
+ frame .2 -width 90 -height 90 -bg red
+ grid .1 -row 0 -column 0
+ grid .2 -row 1 -column 1
+ update
+ set a ""
+ lappend a [grid bbox . 10 10 0 0]
+ lappend a [grid bbox . -2 -2 -1 -1]
+ lappend a [grid bbox . 10 10 12 12]
+ set a
+} {{0 0 165 165} {0 0 0 0} {165 165 0 0}}
+grid_reset 2.10
+
+test grid-3.1 {configure: basic argument checking} {
+ list [catch {grid configure foo} msg] $msg
+} {1 {bad argument "foo": must be name of window}}
+
+test grid-3.2 {configure: basic argument checking} {
+ button .b
+ grid configure .b
+ grid slaves .
+} {.b}
+grid_reset 3.2
+
+test grid-3.3 {configure: basic argument checking} {
+ button .b
+ list [catch {grid .b -row -1} msg] $msg
+} {1 {bad grid value "-1": must be a non-negative integer}}
+grid_reset 3.3
+
+test grid-3.4 {configure: basic argument checking} {
+ button .b
+ list [catch {grid .b -column -1} msg] $msg
+} {1 {bad column value "-1": must be a non-negative integer}}
+grid_reset 3.4
+
+test grid-3.5 {configure: basic argument checking} {
+ button .b
+ list [catch {grid .b -rowspan 0} msg] $msg
+} {1 {bad rowspan value "0": must be a positive integer}}
+grid_reset 3.5
+
+test grid-3.6 {configure: basic argument checking} {
+ button .b
+ list [catch {grid .b -columnspan 0} msg] $msg
+} {1 {bad columnspan value "0": must be a positive integer}}
+grid_reset 3.6
+
+test grid-3.7 {configure: basic argument checking} {
+ frame .f
+ button .f.b
+ list [catch {grid .f .f.b} msg] $msg
+} {1 {can't put .f.b inside .}}
+grid_reset 3.7
+
+test grid-4.1 {forget: basic argument checking} {
+ list [catch {grid forget foo} msg] $msg
+} {1 {bad window path name "foo"}}
+
+test grid-4.2 {forget} {
+ button .c
+ grid [button .b]
+ set a [grid slaves .]
+ grid forget .b .c
+ lappend a [grid slaves .]
+ set a
+} {.b {}}
+grid_reset 4.2
+
+test grid-4.3 {forget} {
+ button .c
+ grid .c -row 2 -column 2 -rowspan 2 -columnspan 2 -padx 3 -pady 4 -sticky ns
+ grid forget .c
+ grid .c -row 0 -column 0
+ grid info .c
+} {-in . -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 0 -ipady 0 -padx 0 -pady 0 -sticky {}}
+grid_reset 4.3
+
+test grid-4.4 {forget, calling Tk_UnmaintainGeometry} {
+ frame .f -bd 2 -relief raised
+ place .f -x 10 -y 20 -width 200 -height 100
+ frame .f2 -width 50 -height 30 -bg red
+ grid .f2 -in .f
+ update
+ set x [winfo ismapped .f2]
+ grid forget .f2
+ place .f -x 30
+ update
+ lappend x [winfo ismapped .f2]
+} {1 0}
+grid_reset 4.4
+
+test grid-5.1 {info: basic argument checking} {
+ list [catch {grid info a b} msg] $msg
+} {1 {wrong # args: should be "grid info window"}}
+
+test grid-5.2 {info} {
+ frame .1 -width 75 -height 75 -bg red
+ grid .1 -row 0 -column 0
+ update
+ list [catch {grid info .x} msg] $msg
+} {1 {bad window path name ".x"}}
+grid_reset 5.2
+
+test grid-5.3 {info} {
+ frame .1 -width 75 -height 75 -bg red
+ grid .1 -row 0 -column 0
+ update
+ list [catch {grid info .1} msg] $msg
+} {0 {-in . -column 0 -row 0 -columnspan 1 -rowspan 1 -ipadx 0 -ipady 0 -padx 0 -pady 0 -sticky {}}}
+grid_reset 5.3
+
+test grid-5.4 {info} {
+ frame .1 -width 75 -height 75 -bg red
+ update
+ list [catch {grid info .1} msg] $msg
+} {0 {}}
+grid_reset 5.4
+
+test grid-6.1 {location: basic argument checking} {
+ list [catch "grid location ." msg] $msg
+} {1 {wrong # args: should be "grid location master x y"}}
+
+test grid-6.2 {location: basic argument checking} {
+ list [catch "grid location .bad 0 0" msg] $msg
+} {1 {bad window path name ".bad"}}
+
+test grid-6.3 {location: basic argument checking} {
+ list [catch "grid location . x y" msg] $msg
+} {1 {bad screen distance "x"}}
+
+test grid-6.4 {location: basic argument checking} {
+ list [catch "grid location . 1c y" msg] $msg
+} {1 {bad screen distance "y"}}
+
+test grid-6.5 {location: basic argument checking} {
+ frame .f
+ grid location .f 10 10
+} {-1 -1}
+grid_reset 6.5
+
+test grid-6.6 {location (x)} {
+ frame .f -width 200 -height 100 -highlightthickness 0 -bg red
+ grid .f
+ update
+ set got ""
+ set result ""
+ for {set x -10} { $x < 220} { incr x} {
+ set a [grid location . $x 0]
+ if {$a != $got} {
+ lappend result $x->$a
+ set got $a
+ }
+ }
+ set result
+} {{-10->-1 0} {0->0 0} {201->1 0}}
+grid_reset 6.6
+
+test grid-6.7 {location (y)} {
+ frame .f -width 200 -height 100 -highlightthickness 0 -bg red
+ grid .f
+ update
+ set got ""
+ set result ""
+ for {set y -10} { $y < 110} { incr y} {
+ set a [grid location . 0 $y]
+ if {$a != $got} {
+ lappend result $y->$a
+ set got $a
+ }
+ }
+ 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
+} {{0 0} {1 1} {1 1}}
+grid_reset 6.9
+
+test grid-7.1 {propagate} {
+ list [catch {grid propagate . 1 xxx} msg] $msg
+} {1 {wrong # args: should be "grid propagate window ?boolean?"}}
+grid_reset 7.1
+
+test grid-7.2 {propagate} {
+ list [catch {grid propagate .} msg] $msg
+} {0 1}
+grid_reset 7.2
+
+test grid-7.3 {propagate} {
+ list [catch {grid propagate . 0;grid propagate .} msg] $msg
+} {0 0}
+grid_reset 7.3
+
+test grid-7.4 {propagate} {
+ list [catch {grid propagate .x} msg] $msg
+} {1 {bad window path name ".x"}}
+grid_reset 7.4
+
+test grid-7.5 {propagate} {
+ list [catch {grid propagate . x} msg] $msg
+} {1 {expected boolean value but got "x"}}
+grid_reset 7.5
+
+test grid-7.6 {propagate} {
+ frame .f -width 100 -height 100 -bg red
+ grid .f -row 0 -column 0
+ update
+ set a [winfo width .f]x[winfo height .f]
+ grid propagate .f 0
+ frame .g -width 75 -height 85 -bg green
+ grid .g -in .f -row 0 -column 0
+ update
+ lappend a [winfo width .f]x[winfo height .f]
+ grid propagate .f 1
+ update
+ lappend a [winfo width .f]x[winfo height .f]
+ set a
+} {100x100 100x100 75x85}
+grid_reset 7.6
+
+
+test grid-8.1 {size} {
+ list [catch {grid size . foo} msg] $msg
+} {1 {wrong # args: should be "grid size window"}}
+grid_reset 8.1
+
+test grid-8.2 {size} {
+ list [catch {grid size .x} msg] $msg
+} {1 {bad window path name ".x"}}
+grid_reset 8.2
+
+test grid-8.3 {size} {
+ frame .f
+ list [catch {grid size .f} msg] $msg
+} {0 {0 0}}
+grid_reset 8.3
+
+test grid-8.4 {size} {
+ catch {unset a}
+ scale .f
+ grid .f -row 0 -column 0
+ update
+ lappend a [grid size .]
+ grid .f -row 4 -column 5
+ update
+ lappend a [grid size .]
+ grid .f -row 947 -column 663
+ update
+ lappend a [grid size .]
+ grid .f -row 0 -column 0
+ update
+ lappend a [grid size .]
+ set a
+} {{1 1} {6 5} {664 948} {1 1}}
+grid_reset 8.4
+
+test grid-8.5 {size} {
+ catch {unset a}
+ scale .f
+ grid .f -row 0 -column 0
+ update
+ lappend a [grid size .]
+ grid rowconfigure . 17 -weight 1
+ update
+ lappend a [grid size .]
+ grid columnconfigure . 63 -weight 1
+ update
+ lappend a [grid size .]
+ grid columnconfigure . 63 -weight 0
+ grid rowconfigure . 17 -weight 0
+ update
+ lappend a [grid size .]
+ set a
+} {{1 1} {1 18} {64 18} {1 1}}
+grid_reset 8.5
+
+test grid-8.6 {size} {
+ catch {unset a}
+ scale .f
+ grid .f -row 10 -column 50
+ update
+ lappend a [grid size .]
+ grid columnconfigure . 15 -weight 1
+ grid columnconfigure . 30 -weight 1
+ update
+ lappend a [grid size .]
+ grid .f -row 10 -column 20
+ update
+ lappend a [grid size .]
+ grid columnconfigure . 30 -weight 0
+ update
+ lappend a [grid size .]
+ grid .f -row 0 -column 0
+ update
+ lappend a [grid size .]
+ grid columnconfigure . 15 -weight 0
+ update
+ lappend a [grid size .]
+ set a
+} {{51 11} {51 11} {31 11} {21 11} {16 1} {1 1}}
+grid_reset 8.6
+
+test grid-9.1 {slaves} {
+ list [catch {grid slaves .} msg] $msg
+} {0 {}}
+
+test grid-9.2 {slaves} {
+ list [catch {grid slaves .foo} msg] $msg
+} {1 {bad window path name ".foo"}}
+
+test grid-9.3 {slaves} {
+ list [catch {grid slaves a b} msg] $msg
+} {1 {wrong # args: should be "grid slaves window ?-option value...?"}}
+
+test grid-9.4 {slaves} {
+ list [catch {grid slaves . a b} msg] $msg
+} {1 {invalid args: should be "grid slaves window ?-option value...?"}}
+
+test grid-9.5 {slaves} {
+ list [catch {grid slaves . -foo x} msg] $msg
+} {1 {expected integer but got "x"}}
+
+test grid-9.6 {slaves} {
+ list [catch {grid slaves . -foo -3} msg] $msg
+} {1 {-foo is an invalid value: should NOT be < 0}}
+
+test grid-9.7 {slaves} {
+ list [catch {grid slaves . -foo 3} msg] $msg
+} {1 {-foo is an invalid option: should be "-row, -column"}}
+
+test grid-9.8 {slaves} {
+ list [catch {grid slaves .x -row 3} msg] $msg
+} {1 {bad window path name ".x"}}
+
+test grid-9.9 {slaves} {
+ list [catch {grid slaves . -row 3} msg] $msg
+} {0 {}}
+
+test grid-9.10 {slaves} {
+ foreach i {0 1 2} {
+ label .$i -text $i
+ grid .$i -row $i -column $i
+ }
+ list [catch {grid slaves .} msg] $msg
+} {0 {.2 .1 .0}}
+grid_reset 9.10
+
+test grid-9.11 {slaves} {
+ catch {unset a}
+ foreach i {0 1 2} {
+ label .$i -text $i
+ label .$i-x -text $i-x
+ grid .$i -row $i -column $i
+ grid .$i-x -row $i -column [incr i]
+ }
+ foreach row {0 1 2 3} {
+ lappend a $row{[grid slaves . -row $row]}
+ }
+ foreach col {0 1 2 3} {
+ lappend a $col{[grid slaves . -column $col]}
+ }
+ set a
+} {{0{.0-x .0}} {1{.1-x .1}} {2{.2-x .2}} 3{} 0{.0} {1{.1 .0-x}} {2{.2 .1-x}} 3{.2-x}}
+grid_reset 9.11
+
+# column/row configure
+
+test grid-10.1 {column/row configure} {
+ list [catch {grid columnconfigure .} msg] $msg
+} {1 {wrong # args: should be "grid columnconfigure master index ?-option value...?"}}
+grid_reset 10.1
+
+test grid-10.2 {column/row configure} {
+ list [catch {grid columnconfigure . 0 -weight 0 -pad} msg] $msg
+} {1 {wrong # args: should be "grid columnconfigure master index ?-option value...?"}}
+grid_reset 10.2
+
+test grid-10.3 {column/row configure} {
+ list [catch {grid columnconfigure .f 0 -weight} msg] $msg
+} {1 {bad window path name ".f"}}
+grid_reset 10.3
+
+test grid-10.4 {column/row configure} {
+ list [catch {grid columnconfigure . nine -weight} msg] $msg
+} {1 {expected integer but got "nine"}}
+grid_reset 10.4
+
+test grid-10.5 {column/row configure} {
+ list [catch {grid columnconfigure . 265 -weight} msg] $msg
+} {0 0}
+grid_reset 10.5
+
+test grid-10.6 {column/row configure} {
+ list [catch {grid columnconfigure . 0} msg] $msg
+} {0 {-minsize 0 -pad 0 -weight 0}}
+grid_reset 10.6
+
+test grid-10.7 {column/row configure} {
+ list [catch {grid columnconfigure . 0 -foo} msg] $msg
+} {1 {invalid arg "-foo": expecting -minsize, -pad, or -weight.}}
+grid_reset 10.7
+
+test grid-10.8 {column/row configure} {
+ list [catch {grid columnconfigure . 0 -minsize foo} msg] $msg
+} {1 {bad screen distance "foo"}}
+grid_reset 10.8
+
+test grid-10.9 {column/row configure} {
+ list [catch {grid columnconfigure . 0 -minsize foo} msg] $msg
+} {1 {bad screen distance "foo"}}
+grid_reset 10.9
+
+test grid-10.10 {column/row configure} {
+ grid columnconfigure . 0 -minsize 10
+ grid columnconfigure . 0 -minsize
+} {10}
+grid_reset 10.10
+
+test grid-10.11 {column/row configure} {
+ list [catch {grid columnconfigure . 0 -weight bad} msg] $msg
+} {1 {expected integer but got "bad"}}
+grid_reset 10.10a
+
+test grid-10.12 {column/row configure} {
+ list [catch {grid columnconfigure . 0 -weight -3} msg] $msg
+} {1 {invalid arg "-weight": should be non-negative}}
+grid_reset 10.11
+
+test grid-10.13 {column/row configure} {
+ grid columnconfigure . 0 -weight 3
+ grid columnconfigure . 0 -weight
+} {3}
+grid_reset 10.12
+
+test grid-10.14 {column/row configure} {
+ list [catch {grid columnconfigure . 0 -pad foo} msg] $msg
+} {1 {bad screen distance "foo"}}
+grid_reset 10.13
+
+test grid-10.15 {column/row configure} {
+ list [catch {grid columnconfigure . 0 -pad -3} msg] $msg
+} {1 {invalid arg "-pad": should be non-negative}}
+grid_reset 10.14
+
+test grid-10.16 {column/row configure} {
+ grid columnconfigure . 0 -pad 3
+ grid columnconfigure . 0 -pad
+} {3}
+grid_reset 10.15
+
+test grid-10.17 {column/row configure} {
+ frame .f
+ set a ""
+ grid columnconfigure .f 0 -weight 0
+ lappend a [grid columnconfigure .f 0 -weight]
+ grid columnconfigure .f 0 -weight 1
+ lappend a [grid columnconfigure .f 0 -weight]
+ grid rowconfigure .f 0 -weight 0
+ lappend a [grid rowconfigure .f 0 -weight]
+ grid rowconfigure .f 0 -weight 1
+ lappend a [grid columnconfigure .f 0 -weight]
+ grid columnconfigure .f 0 -weight 0
+ set a
+} {0 1 0 1}
+grid_reset 10.16
+
+test grid-10.18 {column/row configure} {
+ frame .f
+ grid columnconfigure .f 0 -minsize 10 -weight 1
+ list [grid columnconfigure .f 0 -minsize] \
+ [grid columnconfigure .f 1 -minsize] \
+ [grid columnconfigure .f 0 -weight] \
+ [grid columnconfigure .f 1 -weight]
+} {10 0 1 0}
+grid_reset 10.17
+
+# auto-placement tests
+
+test grid-11.1 {default widget placement} {
+ list [catch {grid ^} msg] $msg
+} {1 {can't use '^', cant find master}}
+grid_reset 11.1
+
+test grid-11.2 {default widget placement} {
+ button .b
+ list [catch {grid .b ^} msg] $msg
+} {1 {can't find slave to extend with "^".}}
+grid_reset 11.2
+
+test grid-11.3 {default widget placement} {
+ button .b
+ list [catch {grid .b - - .c} msg] $msg
+} {1 {bad window path name ".c"}}
+grid_reset 11.3
+
+test grid-11.4 {default widget placement} {
+ button .b
+ list [catch {grid .b - - = -} msg] $msg
+} {1 {invalid window shortcut, "=" should be '-', 'x', or '^'}}
+grid_reset 11.4
+
+test grid-11.5 {default widget placement} {
+ button .b
+ list [catch {grid .b - x -} msg] $msg
+} {1 {Must specify window before shortcut '-'.}}
+grid_reset 11.5
+
+test grid-11.6 {default widget placement} {
+ foreach i {1 2 3 4 5 6} {
+ frame .f$i -width 50 -height 50 -highlightthickness 0 -bg red
+ }
+ grid .f1 .f2 .f3 .f4
+ grid .f5 - x .f6 -sticky nsew
+ update
+ set a ""
+ foreach i {5 6} {
+ lappend a "[winfo x .f$i],[winfo y .f$i] \
+ [winfo width .f$i],[winfo height .f$i]"
+ }
+ set a
+} {{0,50 100,50} {150,50 50,50}}
+grid_reset 11.6
+
+test grid-11.7 {default widget placement} {
+ frame .f -width 20 -height 20 -highlightthickness 0 -bg red
+ grid .f -row 5 -column 5
+ list [catch "grid .f x -" msg] $msg
+} {1 {Must specify window before shortcut '-'.}}
+grid_reset 11.7
+
+test grid-11.8 {default widget placement} {
+ frame .f -width 20 -height 20 -highlightthickness 0 -bg red
+ grid .f -row 5 -column 5
+ list [catch "grid .f ^ -" msg] $msg
+} {1 {Must specify window before shortcut '-'.}}
+grid_reset 11.8
+
+test grid-11.9 {default widget placement} {
+ frame .f -width 20 -height 20 -highlightthickness 0 -bg red
+ grid .f -row 5 -column 5
+ list [catch "grid .f x ^" msg] $msg
+} {1 {can't find slave to extend with "^".}}
+grid_reset 11.9
+
+test grid-11.10 {default widget placement} {
+ foreach i {1 2 3} {
+ frame .f$i -width 100 -height 50 -highlightthickness 0 -bg red
+ }
+ grid .f1 .f2 -sticky nsew
+ grid .f3 ^ -sticky nsew
+ update
+ set a ""
+ foreach i {1 2 3} {
+ lappend a "[winfo x .f$i],[winfo y .f$i] \
+ [winfo width .f$i],[winfo height .f$i]"
+ }
+ set a
+} {{0,0 100,50} {100,0 100,100} {0,50 100,50}}
+grid_reset 11.10
+
+test grid-11.11 {default widget placement} {
+ foreach i {1 2 3 4 5 6 7 8 9 10 11 12} {
+ frame .f$i -width 50 -height 50 -highlightthickness 1 -highlightbackground black
+ }
+ grid .f1 .f2 .f3 .f4 -sticky nsew
+ grid .f5 .f6 - .f7 -sticky nsew
+ grid .f8 ^ ^ .f9 -sticky nsew
+ grid .f10 ^ ^ .f11 -sticky nsew
+ grid .f12 - - - -sticky nsew
+ update
+ set a ""
+ foreach i {5 6 7 8 9 10 11 12 } {
+ lappend a "[winfo x .f$i],[winfo y .f$i] \
+ [winfo width .f$i],[winfo height .f$i]"
+ }
+ set a
+} {{0,50 50,50} {50,50 100,150} {150,50 50,50} {0,100 50,50} {150,100 50,50} {0,150 50,50} {150,150 50,50} {0,200 200,50}}
+grid_reset 11.11
+
+test grid-11.12 {default widget placement} {
+ foreach i {1 2 3 4} {
+ frame .f$i -width 75 -height 50 -highlightthickness 1 -highlightbackground black
+ }
+ grid .f1 .f2 .f3 -sticky nsew
+ grid .f4 ^ -sticky nsew
+ update
+ set a ""
+ foreach i {1 2 3 4} {
+ lappend a "[winfo x .f$i],[winfo y .f$i] \
+ [winfo width .f$i],[winfo height .f$i]"
+ }
+ grid .f4 ^ -column 1
+ update
+ foreach i {1 2 3 4} {
+ lappend a "[winfo x .f$i],[winfo y .f$i] \
+ [winfo width .f$i],[winfo height .f$i]"
+ }
+ set a
+} {{0,0 75,50} {75,0 75,100} {150,0 75,50} {0,50 75,50} {0,0 75,50} {75,0 75,100} {150,0 75,100} {75,50 75,50}}
+grid_reset 11.12
+
+test grid-11.13 {default widget placement} {
+ foreach i {1 2 3 4 5 6 7} {
+ frame .f$i -width 40 -height 50 -highlightthickness 1 -highlightbackground black
+ }
+ grid .f1 .f2 .f3 .f4 .f5 -sticky nsew
+ grid .f6 - .f7 -sticky nsew -columnspan 2
+ update
+ set a ""
+ foreach i {6 7} {
+ lappend a "[winfo x .f$i],[winfo y .f$i] \
+ [winfo width .f$i],[winfo height .f$i]"
+ }
+ set a
+} {{0,50 120,50} {120,50 80,50}}
+grid_reset 11.13
+
+test grid-11.14 {default widget placement} {
+ foreach i {1 2 3} {
+ frame .f$i -width 50 -height 50 -highlightthickness 0 -bg red
+ }
+ grid .f1 .f2
+ grid ^ .f3
+ update
+ set a ""
+ foreach i {1 2 3} {
+ lappend a "[winfo x .f$i],[winfo y .f$i] \
+ [winfo width .f$i],[winfo height .f$i]"
+ }
+ set a
+} {{0,25 50,50} {50,0 50,50} {50,50 50,50}}
+grid_reset 11.14
+
+test grid-12.1 {-sticky} {
+ catch {unset data}
+ frame .f -width 200 -height 100 -highlightthickness 0 -bg red
+ set a ""
+ grid .f
+ grid rowconfigure . 0 -weight 1
+ grid columnconfigure . 0 -weight 1
+ grid propagate . 0
+ . configure -width 250 -height 150
+ foreach i { {} n s e w ns ew nw ne se sw nse nsw sew new nsew} {
+ grid .f -sticky $i
+ update
+ array set data [grid info .f]
+ append a "($data(-sticky)) [winfo x .f] [winfo y .f] [winfo width .f] [winfo height .f]\n"
+ }
+ set a
+} {() 25 25 200 100
+(n) 25 0 200 100
+(s) 25 50 200 100
+(e) 50 25 200 100
+(w) 0 25 200 100
+(ns) 25 0 200 150
+(ew) 0 25 250 100
+(nw) 0 0 200 100
+(ne) 50 0 200 100
+(es) 50 50 200 100
+(sw) 0 50 200 100
+(nes) 50 0 200 150
+(nsw) 0 0 200 150
+(esw) 0 50 250 100
+(new) 0 0 250 100
+(nesw) 0 0 250 150
+}
+grid_reset 12.1
+
+test grid-12.2 {-sticky} {
+ frame .f -bg red
+ list [catch "grid .f -sticky glue" msg] $msg
+} {1 {bad stickyness value "glue": must be a string containing n, e, s, and/or w}}
+grid_reset 12.2
+
+test grid-12.3 {-sticky} {
+ frame .f -bg red
+ grid .f -sticky {n,s,e,w}
+ array set A [grid info .f]
+ set A(-sticky)
+} {nesw}
+grid_reset 12.3
+
+test grid-13.1 {-in} {
+ frame .f -bg red
+ list [catch "grid .f -in .f" msg] $msg
+} {1 {Window can't be managed in itself}}
+grid_reset 13.1
+
+test grid-13.2 {-in} {
+ frame .f -bg red
+ list [catch "grid .f -in .bad" msg] $msg
+} {1 {bad window path name ".bad"}}
+grid_reset 13.2
+
+test grid-13.3 {-in} {
+ frame .f -bg red
+ toplevel .top
+ list [catch "grid .f -in .top" msg] $msg
+} {1 {can't put .f inside .top}}
+destroy .top
+grid_reset 13.3
+
+test grid-13.4 {-ipadx} {
+ frame .f -width 20 -height 20 -highlightthickness 0 -bg red
+ list [catch "grid .f -ipadx x" msg] $msg
+} {1 {bad ipadx value "x": must be positive screen distance}}
+grid_reset 13.4
+
+test grid-13.5 {-ipadx} {
+ frame .f -width 200 -height 100 -highlightthickness 0 -bg red
+ grid .f
+ update
+ set a [winfo width .f]
+ grid .f -ipadx 1
+ update
+ list $a [winfo width .f]
+} {200 202}
+grid_reset 13.5
+
+test grid-13.6 {-ipady} {
+ frame .f -width 20 -height 20 -highlightthickness 0 -bg red
+ list [catch "grid .f -ipady x" msg] $msg
+} {1 {bad ipady value "x": must be positive screen distance}}
+grid_reset 13.6
+
+test grid-13.7 {-ipady} {
+ frame .f -width 200 -height 100 -highlightthickness 0 -bg red
+ grid .f
+ update
+ set a [winfo height .f]
+ grid .f -ipady 1
+ update
+ list $a [winfo height .f]
+} {100 102}
+grid_reset 13.7
+
+test grid-13.8 {-padx} {
+ frame .f -width 20 -height 20 -highlightthickness 0 -bg red
+ list [catch "grid .f -padx x" msg] $msg
+} {1 {bad padx value "x": must be positive screen distance}}
+grid_reset 13.8
+
+test grid-13.9 {-padx} {
+ frame .f -width 200 -height 100 -highlightthickness 0 -bg red
+ grid .f
+ update
+ set a "[winfo width .f] [winfo width .]"
+ grid .f -padx 1
+ update
+ list $a "[winfo width .f] [winfo width .]"
+} {{200 200} {200 202}}
+grid_reset 13.9
+
+test grid-13.10 {-pady} {
+ frame .f -width 20 -height 20 -highlightthickness 0 -bg red
+ list [catch "grid .f -pady x" msg] $msg
+} {1 {bad pady value "x": must be positive screen distance}}
+grid_reset 13.10
+
+test grid-13.11 {-pady} {
+ frame .f -width 200 -height 100 -highlightthickness 0 -bg red
+ grid .f
+ update
+ set a "[winfo height .f] [winfo height .]"
+ grid .f -pady 1
+ update
+ list $a "[winfo height .f] [winfo height .]"
+} {{100 100} {100 102}}
+grid_reset 13.11
+
+test grid-13.12 {-ipad x and y} {
+ frame .f -width 20 -height 20 -highlightthickness 0 -bg red
+ grid columnconfigure . 0 -minsize 150
+ grid rowconfigure . 0 -minsize 100
+ set a ""
+ foreach x {0 5} {
+ foreach y {0 5} {
+ grid .f -ipadx $x -ipady $y
+ update
+ append a " $x,$y:"
+ foreach prop {x y width height} {
+ append a ,[winfo $prop .f]
+ }
+ }
+ }
+ set a
+} { 0,0:,65,40,20,20 0,5:,65,35,20,30 5,0:,60,40,30,20 5,5:,60,35,30,30}
+grid_reset 13.12
+
+test grid-13.13 {reparenting} {
+ frame .1
+ frame .2
+ button .b
+ grid .1 .2
+ grid .b -in .1
+ set a ""
+ catch {unset info}; array set info [grid info .b]
+ lappend a [grid slaves .1],[grid slaves .2],$info(-in)
+ grid .b -in .2
+ catch {unset info}; array set info [grid info .b]
+ lappend a [grid slaves .1],[grid slaves .2],$info(-in)
+ unset info
+ set a
+} {.b,,.1 ,.b,.2}
+grid_reset 13.13
+
+test grid-14.1 {structure notify} {
+ frame .f -width 200 -height 100 -highlightthickness 0 -bg red
+ frame .g -width 200 -height 100 -highlightthickness 0 -bg red
+ grid .f
+ grid .g -in .f
+ update
+ set a ""
+ lappend a "[winfo x .g],[winfo y .g] \
+ [winfo width .g],[winfo height .g]"
+ .f configure -bd 5 -relief raised
+ update
+ lappend a "[winfo x .g],[winfo y .g] \
+ [winfo width .g],[winfo height .g]"
+ set a
+} {{0,0 200,100} {5,5 200,100}}
+grid_reset 14.1
+
+test grid-14.2 {structure notify} {
+ frame .f -width 200 -height 100
+ frame .f.g -width 200 -height 100
+ grid .f
+ grid .f.g
+ update
+ set a ""
+ 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
+ lappend a [grid slaves .]
+ grid .b
+ lappend a [grid slaves .]
+} {.b {} .b}
+grid_reset 15.1
+
+test grid-15.2 {lost slave} {
+ frame .f
+ grid .f
+ button .b
+ grid .b -in .f
+ set a [grid slaves .f]
+ pack .b
+ lappend a [grid slaves .f]
+ grid .b -in .f
+ lappend a [grid slaves .f]
+} {.b {} .b}
+grid_reset 15.2
+
+test grid-16.1 {layout centering} {
+ foreach i {0 1 2} {
+ frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge
+ grid .$i -row $i -column $i -sticky nswe
+ }
+ grid propagate . 0
+ . configure -width 300 -height 250
+ update
+ grid bbox .
+} {37 50 225 150}
+grid_reset 16.1
+
+test grid-16.2 {layout weights (expanding)} {
+ foreach i {0 1 2} {
+ frame .$i -bg gray -width 75 -height 50 -bd 2 -relief ridge
+ grid .$i -row $i -column $i -sticky nswe
+ grid rowconfigure . $i -weight [expr $i + 1]
+ grid columnconfigure . $i -weight [expr $i + 1]
+ }
+ grid propagate . 0
+ . configure -width 500 -height 300
+ set a ""
+ update
+ foreach i {0 1 2} {
+ lappend a [winfo width .$i]-[winfo height .$i]
+ }
+ set a
+} {120-75 167-100 213-125}
+grid_reset 16.2
+
+test grid-16.3 {layout weights (shrinking)} {
+ foreach i {0 1 2} {
+ frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge
+ grid .$i -row $i -column $i -sticky nswe
+ grid rowconfigure . $i -weight [expr $i + 1]
+ grid columnconfigure . $i -weight [expr $i + 1]
+ }
+ grid propagate . 0
+ . configure -width 200 -height 150
+ set a ""
+ update
+ foreach i {0 1 2} {
+ lappend a [winfo width .$i]-[winfo height .$i]
+ }
+ set a
+} {84-63 66-50 50-37}
+grid_reset 16.3
+
+test grid-16.4 {layout weights (shrinking with minsize)} {
+ foreach i {0 1 2} {
+ frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge
+ grid .$i -row $i -column $i -sticky nswe
+ grid rowconfigure . $i -weight [expr $i + 1] -minsize 45
+ grid columnconfigure . $i -weight [expr $i + 1] -minsize 65
+ }
+ grid propagate . 0
+ . configure -width 200 -height 150
+ set a ""
+ update
+ foreach i {0 1 2} {
+ lappend a [winfo width .$i]-[winfo height .$i]
+ }
+ set a
+} {70-60 65-45 65-45}
+grid_reset 16.4
+
+test grid-16.5 {layout weights (shrinking at minsize)} {
+ foreach i {0 1 2} {
+ frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge
+ grid .$i -row $i -column $i -sticky nswe
+ grid rowconfigure . $i -weight 0 -minsize 70
+ grid columnconfigure . $i -weight 0 -minsize 90
+ }
+ grid propagate . 0
+ . configure -width 100 -height 75
+ set a ""
+ update
+ foreach i {0 1 2} {
+ lappend a [winfo width .$i]-[winfo height .$i]
+ }
+ set a
+} {100-75 100-75 100-75}
+grid_reset 16.5
+
+
+test grid-16.6 {layout weights (shrinking at minsize)} {
+ foreach i {0 1 2} {
+ frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge
+ grid .$i -row $i -column $i -sticky nswe
+ grid rowconfigure . $i -weight [expr $i + 1] -minsize 52
+ grid columnconfigure . $i -weight [expr $i + 1] -minsize 69
+ }
+ grid propagate . 0
+ . configure -width 200 -height 150
+ set a ""
+ update
+ foreach i {0 1 2} {
+ lappend a [winfo width .$i]-[winfo height .$i]
+ }
+ set a
+} {69-52 69-52 69-52}
+grid_reset 16.6
+
+test grid-16.7 {layout weights (shrinking at minsize)} {
+ foreach i {0 1 2} {
+ frame .$i -bg gray -width 100 -height 75 -bd 2 -relief ridge
+ grid .$i -row $i -column $i -sticky nswe
+ }
+ grid propagate . 0
+ grid columnconfigure . 1 -weight 1 -minsize 0
+ grid rowconfigure . 1 -weight 1 -minsize 0
+ . configure -width 100 -height 75
+ set a ""
+ update
+ foreach i {0 1 2} {
+ lappend a [winfo width .$i]-[winfo height .$i]-[winfo ismapped .$i]
+ }
+ set a
+} {100-75-1 1-1-0 200-150-1}
+grid_reset 16.7
+
+test grid-16.8 {layout internal constraints} {
+ foreach i {0 1 2 3 4} {
+ frame .$i -bg gray -width 30 -height 25 -bd 2 -relief ridge
+ grid .$i -row $i -column $i -sticky nswe
+ }
+ frame .f -bg red -width 250 -height 200
+ frame .g -bg green -width 200 -height 180
+ lower .f
+ raise .g .f
+ grid .f -row 1 -column 1 -rowspan 3 -columnspan 3 -sticky nswe
+ grid .g -row 1 -column 1 -rowspan 2 -columnspan 2 -sticky nswe
+ update
+ set a ""
+ foreach i {0 1 2 3 4} {
+ append a "[winfo x .$i] "
+ }
+ append a ", "
+ grid remove .f
+ update
+ foreach i {0 1 2 3 4} {
+ append a "[winfo x .$i] "
+ }
+ append a ", "
+ grid remove .g
+ grid .f
+ update
+ foreach i {0 1 2 3 4} {
+ append a "[winfo x .$i] "
+ }
+ append a ", "
+ 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 }
diff --git a/tk/tests/id.test b/tk/tests/id.test
new file mode 100644
index 00000000000..c6ee46f9714
--- /dev/null
+++ b/tk/tests/id.test
@@ -0,0 +1,102 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[info procs test] != "test"} {
+ source defs
+}
+
+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."
+ return
+}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+wm geometry . {}
+raise .
+
+test id-1.1 {WindowIdCleanup, delaying window release} {unixOnly} {
+ bind all <Destroy> {lappend x %W}
+ catch {unset map}
+ frame .f
+ set j 0
+ foreach i {a b c d e f g h i j k l m n o p q} {
+ toplevel .f.$i -height 50 -width 100
+ wm geometry .f.$i +$j+$j
+ incr j 10
+ update
+ set map([winfo id .f.$i]) .f.$i
+ set map([testwrapper .f.$i]) wrapper.f.$i
+ }
+ set x {}
+ destroy .f
+
+ # Destroy events should have occurred for all windows.
+ set result [list [lsort $x]]
+
+ set x {}
+ update idletasks
+ set reused {}
+ foreach i {a b c d e} {
+ set w .${i}2
+ frame $w -height 20 -width 100 -bd 2 -relief raised
+ pack $w
+ if [info exists map([winfo id $w])] {
+ lappend reused $map([winfo id $w])
+ }
+ set map([winfo id $w]) $w
+ }
+
+ # No window ids should have been reused: stale Destroy events still
+ # pending in queue.
+ lappend result [lsort $reused]
+
+ # Wait a few seconds, then try again; ids should still not have
+ # been re-used.
+
+ set y 0
+ after 2000 {set y 1}
+ tkwait variable y
+ foreach i {a b c} {
+ set w .${i}3
+ frame $w -height 20 -width 100 -bd 2 -relief raised
+ pack $w
+ if [info exists map([winfo id $w])] {
+ lappend reused $map([winfo id $w])
+ }
+ set map([winfo id $w])] $w
+ }
+
+ # Ids should not yet have been reused.
+ lappend result [lsort $reused]
+
+
+ # Wait a few more seconds, to give ids enough time to be recycled.
+ set y 0
+ after 6000 {set y 1}
+ tkwait variable y
+ foreach i {a b c d e f} {
+ set w .${i}4
+ frame $w -height 20 -width 100 -bd 2 -relief raised
+ pack $w
+ if [info exists map([winfo id $w])] {
+ lappend reused $map([winfo id $w])
+ }
+ set map([winfo id $w])] $w
+ }
+
+ # 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> {}
diff --git a/tk/tests/image.test b/tk/tests/image.test
new file mode 100644
index 00000000000..fc899c0939a
--- /dev/null
+++ b/tk/tests/image.test
@@ -0,0 +1,357 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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]
+canvas .c -highlightthickness 2
+pack .c
+update
+test image-1.1 {Tk_ImageCmd procedure, "create" option} {
+ list [catch image msg] $msg
+} {1 {wrong # args: should be "image option ?args?"}}
+test image-1.2 {Tk_ImageCmd procedure, "create" option} {
+ list [catch {image gorp} msg] $msg
+} {1 {bad option "gorp": must be create, delete, height, names, type, types, or width}}
+test image-1.3 {Tk_ImageCmd procedure, "create" option} {
+ list [catch {image create} msg] $msg
+} {1 {wrong # args: should be "image create type ?name? ?options?"}}
+test image-1.4 {Tk_ImageCmd procedure, "create" option} {
+ list [catch {image c bad_type} msg] $msg
+} {1 {image type "bad_type" doesn't exist}}
+test image-1.5 {Tk_ImageCmd procedure, "create" option} {
+ list [image create test myimage] [image names]
+} {myimage myimage}
+test image-1.6 {Tk_ImageCmd procedure, "create" option} {
+ scan [image create test] image%d first
+ image create test myimage
+ scan [image create test -variable x] image%d second
+ expr $second-$first
+} {1}
+test image-1.7 {Tk_ImageCmd procedure, "create" option} {
+ image delete myimage
+ image create test myimage -variable x
+ .c create image 100 50 -image myimage
+ .c create image 100 150 -image myimage
+ update
+ set x {}
+ image create test myimage -variable x
+ update
+ set x
+} {{myimage free} {myimage free} {myimage delete} {myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}}
+test image-1.8 {Tk_ImageCmd procedure, "create" option} {
+ .c delete all
+ image create test myimage -variable x
+ .c create image 100 50 -image myimage
+ .c create image 100 150 -image myimage
+ image delete myimage
+ update
+ set x {}
+ image create test myimage -variable x
+ update
+ set x
+} {{myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}}
+test image-1.9 {Tk_ImageCmd procedure, "create" option} {
+ .c delete all
+ eval image delete [image names]
+ list [catch {image create test -badName foo} msg] $msg [image names]
+} {1 {bad option name "-badName"} {}}
+
+test image-2.1 {Tk_ImageCmd procedure, "delete" option} {
+ list [catch {image delete} msg] $msg
+} {0 {}}
+test image-2.2 {Tk_ImageCmd procedure, "delete" option} {
+ .c delete all
+ eval image delete [image names]
+ image create test myimage
+ image create test img2
+ set result {}
+ lappend result [lsort [image names]]
+ image d myimage img2
+ lappend result [image names]
+} {{img2 myimage} {}}
+test image-2.3 {Tk_ImageCmd procedure, "delete" option} {
+ .c delete all
+ eval image delete [image names]
+ image create test myimage
+ image create test img2
+ list [catch {image delete myimage gorp img2} msg] $msg [image names]
+} {1 {image "gorp" doesn't exist} img2}
+
+test image-3.1 {Tk_ImageCmd procedure, "height" option} {
+ list [catch {image height} msg] $msg
+} {1 {wrong # args: should be "image height name"}}
+test image-3.2 {Tk_ImageCmd procedure, "height" option} {
+ list [catch {image height a b} msg] $msg
+} {1 {wrong # args: should be "image height name"}}
+test image-3.3 {Tk_ImageCmd procedure, "height" option} {
+ list [catch {image height foo} msg] $msg
+} {1 {image "foo" doesn't exist}}
+test image-3.4 {Tk_ImageCmd procedure, "height" option} {
+ image create test myimage
+ set x [image h myimage]
+ myimage changed 0 0 0 0 60 50
+ list $x [image height myimage]
+} {15 50}
+
+test image-4.1 {Tk_ImageCmd procedure, "names" option} {
+ list [catch {image names x} msg] $msg
+} {1 {wrong # args: should be "image names"}}
+test image-4.2 {Tk_ImageCmd procedure, "names" option} {
+ .c delete all
+ eval image delete [image names]
+ image create test myimage
+ image create test img2
+ image create test 24613
+ lsort [image names]
+} {24613 img2 myimage}
+test image-4.3 {Tk_ImageCmd procedure, "names" option} {
+ .c delete all
+ eval image delete [image names]
+ lsort [image names]
+} {}
+
+test image-5.1 {Tk_ImageCmd procedure, "type" option} {
+ list [catch {image type} msg] $msg
+} {1 {wrong # args: should be "image type name"}}
+test image-5.2 {Tk_ImageCmd procedure, "type" option} {
+ list [catch {image type a b} msg] $msg
+} {1 {wrong # args: should be "image type name"}}
+test image-5.3 {Tk_ImageCmd procedure, "type" option} {
+ list [catch {image type foo} msg] $msg
+} {1 {image "foo" doesn't exist}}
+test image-5.4 {Tk_ImageCmd procedure, "type" option} {
+ image create test myimage
+ image type myimage
+} {test}
+test image-5.5 {Tk_ImageCmd procedure, "type" option} {
+ image create test myimage
+ .c create image 50 50 -image myimage
+ image delete myimage
+ image type myimage
+} {}
+
+test image-6.1 {Tk_ImageCmd procedure, "types" option} {
+ list [catch {image types x} msg] $msg
+} {1 {wrong # args: should be "image types"}}
+test image-6.2 {Tk_ImageCmd procedure, "types" option} {
+ lsort [image types]
+} {bitmap photo test}
+
+test image-7.1 {Tk_ImageCmd procedure, "width" option} {
+ list [catch {image width} msg] $msg
+} {1 {wrong # args: should be "image width name"}}
+test image-7.2 {Tk_ImageCmd procedure, "width" option} {
+ list [catch {image width a b} msg] $msg
+} {1 {wrong # args: should be "image width name"}}
+test image-7.3 {Tk_ImageCmd procedure, "width" option} {
+ list [catch {image width foo} msg] $msg
+} {1 {image "foo" doesn't exist}}
+test image-7.4 {Tk_ImageCmd procedure, "width" option} {
+ image create test myimage
+ set x [image w myimage]
+ myimage changed 0 0 0 0 60 50
+ list $x [image width myimage]
+} {30 60}
+
+test image-8.1 {Tk_ImageChanged procedure} {
+ .c delete all
+ eval image delete [image names]
+ image create test foo -variable x
+ .c create image 50 50 -image foo
+ update
+ set x {}
+ foo changed 5 6 7 8 30 15
+ update
+ set x
+} {{foo display 5 6 7 8 30 30}}
+test image-8.2 {Tk_ImageChanged procedure} {
+ .c delete all
+ eval image delete [image names]
+ image create test foo -variable x
+ .c create image 50 50 -image foo
+ .c create image 90 100 -image foo
+ update
+ set x {}
+ foo changed 5 6 7 8 30 15
+ update
+ set x
+} {{foo display 5 6 25 9 30 30} {foo display 0 0 12 14 65 74}}
+
+test image-9.1 {Tk_GetImage procedure} {
+ list [catch {.c create image 100 10 -image bad_name} msg] $msg
+} {1 {image "bad_name" doesn't exist}}
+test image-9.2 {Tk_GetImage procedure} {
+ image create test mytest
+ catch {destroy .l}
+ label .l -image mytest
+ image delete mytest
+ set result [list [catch {label .l2 -image mytest} msg] $msg]
+ destroy .l
+ set result
+} {1 {image "mytest" doesn't exist}}
+
+test image-10.1 {Tk_FreeImage procedure} {
+ .c delete all
+ eval image delete [image names]
+ image create test foo -variable x
+ .c create image 50 50 -image foo -tags i1
+ .c create image 90 100 -image foo -tags i2
+ pack forget .c
+ update
+ set x {}
+ .c delete i1
+ pack .c
+ update
+ list [image names] $x
+} {foo {{foo free} {foo display 0 0 30 15 103 121}}}
+test image-10.2 {Tk_FreeImage procedure} {
+ .c delete all
+ eval image delete [image names]
+ image create test foo -variable x
+ .c create image 50 50 -image foo -tags i1
+ image delete foo
+ update
+ set names [image names]
+ set x {}
+ .c delete i1
+ pack forget .c
+ pack .c
+ update
+ list $names [image names] $x
+} {foo {} {}}
+
+# Non-portable, apparently due to differences in rounding:
+
+test image-11.1 {Tk_RedrawImage procedure, redisplay area clipping} \
+ {nonPortable} {
+ .c delete all
+ eval image delete [image names]
+ image create test foo -variable x
+ .c create image 50 60 -image foo -tags i1 -anchor nw
+ update
+ .c create rectangle 30 40 55 65 -width 0 -fill black -outline {}
+ set x {}
+ update
+ set x
+} {{foo display 0 0 5 5 50 50}}
+test image-11.2 {Tk_RedrawImage procedure, redisplay area clipping} \
+ {nonPortable} {
+ .c delete all
+ eval image delete [image names]
+ image create test foo -variable x
+ .c create image 50 60 -image foo -tags i1 -anchor nw
+ update
+ .c create rectangle 60 40 100 65 -width 0 -fill black -outline {}
+ set x {}
+ update
+ set x
+} {{foo display 10 0 20 5 30 50}}
+test image-11.3 {Tk_RedrawImage procedure, redisplay area clipping} \
+ {nonPortable} {
+ .c delete all
+ eval image delete [image names]
+ image create test foo -variable x
+ .c create image 50 60 -image foo -tags i1 -anchor nw
+ update
+ .c create rectangle 60 70 100 200 -width 0 -fill black -outline {}
+ set x {}
+ update
+ set x
+} {{foo display 10 10 20 5 30 30}}
+test image-11.4 {Tk_RedrawImage procedure, redisplay area clipping} \
+ {nonPortable} {
+ .c delete all
+ eval image delete [image names]
+ image create test foo -variable x
+ .c create image 50 60 -image foo -tags i1 -anchor nw
+ update
+ .c create rectangle 30 70 55 200 -width 0 -fill black -outline {}
+ set x {}
+ update
+ set x
+} {{foo display 0 10 5 5 50 30}}
+test image-11.5 {Tk_RedrawImage procedure, redisplay area clipping} \
+ {nonPortable} {
+ .c delete all
+ eval image delete [image names]
+ image create test foo -variable x
+ .c create image 50 60 -image foo -tags i1 -anchor nw
+ update
+ .c create rectangle 10 20 120 130 -width 0 -fill black -outline {}
+ set x {}
+ update
+ set x
+} {{foo display 0 0 30 15 70 70}}
+test image-11.6 {Tk_RedrawImage procedure, redisplay area clipping} \
+ {nonPortable} {
+ .c delete all
+ eval image delete [image names]
+ image create test foo -variable x
+ .c create image 50 60 -image foo -tags i1 -anchor nw
+ update
+ .c create rectangle 55 65 75 70 -width 0 -fill black -outline {}
+ set x {}
+ update
+ set x
+} {{foo display 5 5 20 5 30 30}}
+
+test image-12.1 {Tk_SizeOfImage procedure} {
+ eval image delete [image names]
+ image create test foo -variable x
+ set result [list [image width foo] [image height foo]]
+ foo changed 0 0 0 0 85 60
+ lappend result [image width foo] [image height foo]
+} {30 15 85 60}
+
+test image-12.2 {DeleteImage procedure} {
+ .c delete all
+ eval image delete [image names]
+ image create test foo -variable x
+ .c create image 50 50 -image foo -tags i1
+ .c create image 90 100 -image foo -tags i2
+ set x {}
+ image delete foo
+ lappend x | [image names] |
+ image delete foo
+ lappend x | [image names] |
+} {{foo free} {foo free} {foo delete} | foo | | foo |}
+
+catch {image delete hidden}
+set l [image names]
+set h [interp hidden]
+
+test image-13.1 {image command vs hidden commands} {
+ catch {image delete hidden}
+ image create photo hidden
+ interp hide {} hidden
+ image delete hidden
+ list [image names] [interp hidden]
+} [list $l $h]
+
+destroy .c
+eval image delete [image names]
diff --git a/tk/tests/imgBmap.test b/tk/tests/imgBmap.test
new file mode 100644
index 00000000000..ec8d7d1fa11
--- /dev/null
+++ b/tk/tests/imgBmap.test
@@ -0,0 +1,474 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[info procs test] != "test"} {
+ source defs
+}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+wm geometry . {}
+raise .
+
+set data1 {#define foo_width 16
+#define foo_height 16
+#define foo_x_hot 3
+#define foo_y_hot 3
+static unsigned char foo_bits[] = {
+ 0xff, 0xff, 0x81, 0x81, 0x81, 0x81, 0x81, 0x81, 0x81, 0x81, 0x81, 0x81,
+ 0x81, 0x81, 0xff, 0xff, 0xff, 0xff, 0x81, 0x81, 0x81, 0x81, 0x81, 0x81,
+ 0x81, 0x81, 0x81, 0x81, 0x81, 0x81, 0xff, 0xff};
+}
+set data2 {
+ #define foo2_width 16
+ #define foo2_height 16
+ static char foo2_bits[] = {
+ 0xff, 0xff, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81,
+ 0xff, 0x81, 0xff, 0xff, 0xff, 0xff, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81,
+ 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0xff};
+}
+makeFile $data1 foo.bm
+makeFile $data2 foo2.bm
+
+eval image delete [image names]
+canvas .c
+pack .c
+update
+image create bitmap i1
+.c create image 200 100 -image i1
+update
+proc bgerror msg {
+ global errMsg
+ set errMsg $msg
+}
+test imageBmap-1.1 {options for bitmap images} {
+ image create bitmap i1 -background #123456
+ lindex [i1 configure -background] 4
+} {#123456}
+test imageBmap-1.2 {options for bitmap images} {
+ set errMsg {}
+ image create bitmap i1 -background lousy
+ update
+ list $errMsg $errorInfo
+} {{unknown color name "lousy"} {unknown color name "lousy"
+ (while configuring image "i1")}}
+test imageBmap-1.3 {options for bitmap images} {
+ image create bitmap i1 -data $data1
+ lindex [i1 configure -data] 4
+} $data1
+test imageBmap-1.4 {options for bitmap images} {
+ list [catch {image create bitmap i1 -data bogus} msg] $msg
+} {1 {format error in bitmap data}}
+test imageBmap-1.5 {options for bitmap images} {
+ image create bitmap i1 -file foo.bm
+ lindex [i1 configure -file] 4
+} foo.bm
+test imageBmap-1.6 {options for bitmap images} {
+ list [catch {image create bitmap i1 -file bogus} msg] [string tolower $msg]
+} {1 {couldn't read bitmap file "bogus": no such file or directory}}
+test imageBmap-1.7 {options for bitmap images} {
+ image create bitmap i1 -foreground #00ff00
+ lindex [i1 configure -foreground] 4
+} {#00ff00}
+test imageBmap-1.8 {options for bitmap images} {
+ set errMsg {}
+ image create bitmap i1 -foreground bad_color
+ update
+ list $errMsg $errorInfo
+} {{unknown color name "bad_color"} {unknown color name "bad_color"
+ (while configuring image "i1")}}
+test imageBmap-1.9 {options for bitmap images} {
+ image create bitmap i1 -data $data1 -maskdata $data2
+ lindex [i1 configure -maskdata] 4
+} $data2
+test imageBmap-1.10 {options for bitmap images} {
+ list [catch {image create bitmap i1 -data $data1 -maskdata bogus} msg] $msg
+} {1 {format error in bitmap data}}
+test imageBmap-1.11 {options for bitmap images} {
+ image create bitmap i1 -file foo.bm -maskfile foo2.bm
+ lindex [i1 configure -maskfile] 4
+} foo2.bm
+test imageBmap-1.12 {options for bitmap images} {
+ list [catch {image create bitmap i1 -data $data1 -maskfile bogus} msg] \
+ [string tolower $msg]
+} {1 {couldn't read bitmap file "bogus": no such file or directory}}
+rename bgerror {}
+
+test imageBmap-2.1 {ImgBmapCreate procedure} {
+ eval image delete [image names]
+ .c delete all
+ list [catch {image create bitmap -gorp dum} msg] $msg [image names]
+} {1 {unknown option "-gorp"} {}}
+test imageBmap-2.2 {ImgBmapCreate procedure} {
+ eval image delete [image names]
+ .c delete all
+ image create bitmap image1
+ list [info commands image1] [image names] \
+ [image width image1] [image height image1] \
+ [lindex [image1 configure -foreground] 4] \
+ [lindex [image1 configure -background] 4]
+} {image1 image1 0 0 #000000 {}}
+
+test imageBmap-3.1 {ImgBmapConfigureMaster procedure, memory de-allocation} {
+ image create bitmap i1 -data $data1
+ i1 configure -data $data1
+} {}
+test imageBmap-3.2 {ImgBmapConfigureMaster procedure} {
+ image create bitmap i1 -data $data1
+ list [catch {i1 configure -data bogus} msg] $msg [image width i1] \
+ [image height i1]
+} {1 {format error in bitmap data} 16 16}
+test imageBmap-3.3 {ImgBmapConfigureMaster procedure, memory de-allocation} {
+ image create bitmap i1 -data $data1 -maskdata $data2
+ i1 configure -maskdata $data2
+} {}
+test imageBmap-3.4 {ImgBmapConfigureMaster procedure} {
+ image create bitmap i1
+ list [catch {i1 configure -maskdata $data2} msg] $msg
+} {1 {can't have mask without bitmap}}
+test imageBmap-3.5 {ImgBmapConfigureMaster procedure} {
+ list [catch {image create bitmap i1 -data $data1 -maskdata {
+ #define foo_width 8
+ #define foo_height 16
+ static char foo_bits[] = {
+ 0xff, 0xff, 0x81, 0x81, 0x81, 0x81, 0x81, 0x81,
+ 0x81, 0x81, 0xff, 0xff, 0xff, 0xff, 0x81, 0x81};
+ }
+ } msg] $msg
+} {1 {bitmap and mask have different sizes}}
+test imageBmap-3.6 {ImgBmapConfigureMaster procedure} {
+ list [catch {image create bitmap i1 -data $data1 -maskdata {
+ #define foo_width 16
+ #define foo_height 8
+ static char foo_bits[] = {
+ 0xff, 0xff, 0x81, 0x81, 0x81, 0x81, 0x81, 0x81,
+ 0x81, 0x81, 0xff, 0xff, 0xff, 0xff, 0x81, 0x81};
+ }
+ } msg] $msg
+} {1 {bitmap and mask have different sizes}}
+test imageBmap-3.7 {ImgBmapConfigureMaster procedure} {
+ image create bitmap i1 -data $data1
+ .c create image 100 100 -image i1 -tags i1.1 -anchor nw
+ .c create image 200 100 -image i1 -tags i1.2 -anchor nw
+ update
+ i1 configure -data {
+ #define foo2_height 14
+ #define foo2_width 15
+ static char foo2_bits[] = {
+ 0xff, 0xff, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81,
+ 0xff, 0x81, 0xff, 0x81, 0xff, 0xff, 0xff, 0xff, 0xff, 0x81,
+ 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81,
+ 0xff, 0xff};
+ }
+ update
+ list [image width i1] [image height i1] [.c bbox i1.1] [.c bbox i1.2]
+} {15 14 {100 100 115 114} {200 100 215 114}}
+
+test imageBmap-4.1 {ImgBmapConfigureInstance procedure: check error handling} {
+ proc bgerror args {}
+ .c delete all
+ image create bitmap i1 -file foo.bm
+ .c create image 100 100 -image i1
+ update
+ i1 configure -foreground bogus
+ update
+} {}
+
+test imageBmap-5.1 {GetBitmapData procedure} {
+ list [catch {image create bitmap -file ~bad_user/a/b} msg] \
+ [string tolower $msg]
+} {1 {user "bad_user" doesn't exist}}
+test imageBmap-5.2 {GetBitmapData procedure} {
+ list [catch {image create bitmap -file bad_name} msg] [string tolower $msg]
+} {1 {couldn't read bitmap file "bad_name": no such file or directory}}
+test imageBmap-5.3 {GetBitmapData procedure} {
+ eval image delete [image names]
+ .c delete all
+ list [catch {image create bitmap -data { }} msg] $msg
+} {1 {format error in bitmap data}}
+test imageBmap-5.4 {GetBitmapData procedure} {
+ eval image delete [image names]
+ .c delete all
+ list [catch {image create bitmap -data {#define foo2_width}} msg] $msg
+} {1 {format error in bitmap data}}
+test imageBmap-5.5 {GetBitmapData procedure} {
+ eval image delete [image names]
+ .c delete all
+ list [catch {image create bitmap -data {#define foo2_width gorp}} msg] $msg
+} {1 {format error in bitmap data}}
+test imageBmap-5.6 {GetBitmapData procedure} {
+ eval image delete [image names]
+ .c delete all
+ list [catch {image create bitmap -data {#define foo2_width 1.4}} msg] $msg
+} {1 {format error in bitmap data}}
+test imageBmap-5.7 {GetBitmapData procedure} {
+ eval image delete [image names]
+ .c delete all
+ list [catch {image create bitmap -data {#define foo2_height}} msg] $msg
+} {1 {format error in bitmap data}}
+test imageBmap-5.8 {GetBitmapData procedure} {
+ eval image delete [image names]
+ .c delete all
+ list [catch {image create bitmap -data {#define foo2_height gorp}} msg] $msg
+} {1 {format error in bitmap data}}
+test imageBmap-5.9 {GetBitmapData procedure} {
+ eval image delete [image names]
+ .c delete all
+ list [catch {image create bitmap -data {#define foo2_height 1.4}} msg] $msg
+} {1 {format error in bitmap data}}
+test imageBmap-5.10 {GetBitmapData procedure} {
+ eval image delete [image names]
+ .c delete all
+ image create bitmap i1 -data {
+ #define foo2_height 14
+ #define foo2_width 15 xx _widtg 18 xwidth 18 _heighz 18 xheight 18
+ static char foo2_bits[] = {
+ 0xff, 0xff, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81,
+ 0xff, 0x81, 0xff, 0x81, 0xff, 0xff, 0xff, 0xff, 0xff, 0x81,
+ 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81,
+ 0xff, 0xff};
+ }
+ list [image width i1] [image height i1]
+} {15 14}
+test imageBmap-5.11 {GetBitmapData procedure} {
+ eval image delete [image names]
+ .c delete all
+ image create bitmap i1 -data {
+ _height 14 _width 15
+ char {
+ 0xff, 0xff, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81,
+ 0xff, 0x81, 0xff, 0x81, 0xff, 0xff, 0xff, 0xff, 0xff, 0x81,
+ 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81,
+ 0xff, 0xff}
+ }
+ list [image width i1] [image height i1]
+} {15 14}
+test imageBmap-5.12 {GetBitmapData procedure} {
+ eval image delete [image names]
+ .c delete all
+ list [catch {image create bitmap i1 -data {
+ #define foo2_height 14
+ #define foo2_width 15
+ static short foo2_bits[] = {
+ 0xff, 0xff, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81,
+ 0xff, 0x81, 0xff, 0x81, 0xff, 0xff, 0xff, 0xff, 0xff, 0x81,
+ 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81,
+ 0xff, 0xff};
+ }} msg] $msg
+} {1 {format error in bitmap data; looks like it's an obsolete X10 bitmap file}}
+test imageBmap-5.13 {GetBitmapData procedure} {
+ eval image delete [image names]
+ .c delete all
+ list [catch {image create bitmap i1 -data {
+ #define foo2_height 16
+ #define foo2_width 16
+ static char foo2_bits[] =
+ 0xff, 0xff, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81,
+ 0xff, 0x81, 0xff, 0x81, 0xff, 0xff, 0xff, 0xff, 0xff, 0x81,
+ 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81,
+ 0xff, 0xff;
+ }} msg] $msg
+} {1 {format error in bitmap data}}
+test imageBmap-5.14 {GetBitmapData procedure} {
+ eval image delete [image names]
+ .c delete all
+ list [catch {image create bitmap i1 -data {
+ #define foo2_width 16
+ static char foo2_bits[] = {
+ 0xff, 0xff, 0xff, }}} msg] $msg
+} {1 {format error in bitmap data}}
+test imageBmap-5.15 {GetBitmapData procedure} {
+ eval image delete [image names]
+ .c delete all
+ list [catch {image create bitmap i1 -data {
+ #define foo2_height 16
+ static char foo2_bits[] = {
+ 0xff, 0xff, 0xff, }}} msg] $msg
+} {1 {format error in bitmap data}}
+test imageBmap-5.16 {GetBitmapData procedure} {
+ eval image delete [image names]
+ .c delete all
+ list [catch {image create bitmap i1 -data {
+ #define foo2_height 16
+ #define foo2_width 16
+ static char foo2_bits[] = {
+ 0xff, 0xff, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81,
+ 0xff, 0x81, 0xff, 0x81, 0xff, 0xff, 0xff, 0xff, 0xff, 0x81,
+ 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81,
+ 0xff, foo};
+ }} msg] $msg
+} {1 {format error in bitmap data}}
+test imageBmap-5.17 {GetBitmapData procedure} {
+ eval image delete [image names]
+ .c delete all
+ list [catch {image create bitmap i1 -data "
+ #define foo2_height 16
+ #define foo2_width 16
+ static char foo2_bits[] = \{
+ 0xff, 0xff, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81,
+ 0xff, 0x81, 0xff, 0x81, 0xff, 0xff, 0xff, 0xff, 0xff, 0x81,
+ 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81, 0xff, 0x81,
+ 0xff
+ "} msg] $msg
+} {1 {format error in bitmap data}}
+
+test imageBmap-6.1 {NextBitmapWord procedure} {
+ eval image delete [image names]
+ .c delete all
+ list [catch {image create bitmap i1 -data {1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890}} msg] $msg
+} {1 {format error in bitmap data}}
+test imageBmap-6.2 {NextBitmapWord procedure} {
+ eval image delete [image names]
+ .c delete all
+ makeFile {1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890} foo3.bm
+ list [catch {image create bitmap i1 -file foo3.bm} msg] $msg
+} {1 {format error in bitmap data}}
+test imageBmap-6.3 {NextBitmapWord procedure} {
+ eval image delete [image names]
+ .c delete all
+ makeFile { } foo3.bm
+ list [catch {image create bitmap i1 -file foo3.bm} msg] $msg
+} {1 {format error in bitmap data}}
+removeFile foo3.bm
+
+eval image delete [image names]
+.c delete all
+image create bitmap i1
+test imageBmap-7.1 {ImgBmapCmd procedure} {
+ list [catch {i1} msg] $msg
+} {1 {wrong # args: should be "i1 option ?arg arg ...?"}}
+test imageBmap-7.2 {ImgBmapCmd procedure, "cget" option} {
+ list [catch {i1 cget} msg] $msg
+} {1 {wrong # args: should be "i1 cget option"}}
+test imageBmap-7.3 {ImgBmapCmd procedure, "cget" option} {
+ list [catch {i1 cget a b} msg] $msg
+} {1 {wrong # args: should be "i1 cget option"}}
+test imageBmap-7.4 {ImgBmapCmd procedure, "cget" option} {
+ i1 co -foreground #123456
+ i1 cget -foreground
+} {#123456}
+test imageBmap-7.5 {ImgBmapCmd procedure, "cget" option} {
+ list [catch {i1 cget -stupid} msg] $msg
+} {1 {unknown option "-stupid"}}
+test imageBmap-7.6 {ImgBmapCmd procedure} {
+ llength [i1 configure]
+} {6}
+test imageBmap-7.7 {ImgBmapCmd procedure} {
+ i1 co -foreground #001122
+ i1 configure -foreground
+} {-foreground {} {} #000000 #001122}
+test imageBmap-7.8 {ImgBmapCmd procedure} {
+ list [catch {i1 configure -gorp} msg] $msg
+} {1 {unknown option "-gorp"}}
+test imageBmap-7.9 {ImgBmapCmd procedure} {
+ list [catch {i1 configure -foreground #221100 -background} msg] $msg
+} {1 {value for "-background" missing}}
+test imageBmap-7.10 {ImgBmapCmd procedure} {
+ list [catch {i1 gorp} msg] $msg
+} {1 {bad option "gorp": must be cget or configure}}
+
+test imageBmap-8.1 {ImgBmapGet/Free procedures, shared instances} {
+ eval image delete [image names]
+ .c delete all
+ image create bitmap i1 -data $data1
+ .c create image 50 100 -image i1 -tags i1.1
+ .c create image 150 100 -image i1 -tags i1.2
+ .c create image 250 100 -image i1 -tags i1.3
+ update
+ .c delete i1.1
+ i1 configure -background black
+ update
+ .c delete i1.2
+ i1 configure -background white
+ update
+ .c delete i1.3
+ i1 configure -background black
+ update
+ image delete i1
+} {}
+
+test imageBmap-9.1 {ImgBmapDisplay procedure, nothing to display} {
+ proc bgerror args {}
+ eval image delete [image names]
+ .c delete all
+ image create bitmap i1 -data $data1
+ .c create image 50 100 -image i1 -tags i1.1
+ i1 configure -data {}
+ update
+} {}
+test imageBmap-9.2 {ImgBmapDisplay procedure, nothing to display} {
+ proc bgerror args {}
+ eval image delete [image names]
+ .c delete all
+ image create bitmap i1 -data $data1
+ .c create image 50 100 -image i1 -tags i1.1
+ i1 configure -foreground bogus
+ update
+} {}
+if {[info exists bgerror]} {
+ rename bgerror {}
+}
+
+test imageBmap-10.1 {ImgBmapFree procedure, resource freeing} {
+ eval image delete [image names]
+ .c delete all
+ image create bitmap i1 -data $data1 -maskdata $data2 -foreground #112233 \
+ -background #445566
+ .c create image 100 100 -image i1
+ update
+ .c delete all
+ image delete i1
+} {}
+test imageBmap-10.2 {ImgBmapFree procedures, unlinking} {
+ eval image delete [image names]
+ .c delete all
+ image create bitmap i1 -data $data1 -maskdata $data2 -foreground #112233 \
+ -background #445566
+ .c create image 100 100 -image i1
+ button .b1 -image i1
+ button .b2 -image i1
+ button .b3 -image i1
+ pack .b1 .b2 .b3
+ update
+ destroy .b2
+ update
+ destroy .b3
+ update
+ destroy .b1
+ update
+ .c delete all
+} {}
+
+test imageBmap-11.1 {ImgBmapDelete procedure} {
+ image create bitmap i2 -file foo.bm -maskfile foo2.bm
+ image delete i2
+ info command i2
+} {}
+test imageBmap-11.2 {ImgBmapDelete procedure} {
+ image create bitmap i2 -file foo.bm -maskfile foo2.bm
+ rename i2 newi2
+ set x [list [info command i2] [info command new*] [newi2 cget -file]]
+ image delete i2
+ lappend x [info command new*]
+} {{} newi2 foo.bm {}}
+
+test imageBmap-12.1 {ImgBmapCmdDeletedProc procedure} {
+ image create bitmap i2 -file foo.bm -maskfile foo2.bm
+ rename i2 {}
+ 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]
diff --git a/tk/tests/imgPPM.test b/tk/tests/imgPPM.test
new file mode 100644
index 00000000000..e0ffb0a3393
--- /dev/null
+++ b/tk/tests/imgPPM.test
@@ -0,0 +1,156 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[info procs test] != "test"} {
+ source defs
+}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+wm geometry . {}
+raise .
+
+eval image delete [image names]
+
+proc put {file data} {
+ set f [open $file w]
+ fconfigure $f -translation lf
+ puts -nonewline $f $data
+ close $f
+}
+
+test imgPPM-1.1 {FileReadPPM procedure} {
+ put test.ppm "P6\n0 256\n255\nabcdef"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {1 {PPM image file "test.ppm" has dimension(s) <= 0}}
+test imgPPM-1.2 {FileReadPPM procedure} {
+ put test.ppm "P6\n-2 256\n255\nabcdef"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {1 {PPM image file "test.ppm" has dimension(s) <= 0}}
+test imgPPM-1.3 {FileReadPPM procedure} {
+ put test.ppm "P6\n10 0\n255\nabcdef"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {1 {PPM image file "test.ppm" has dimension(s) <= 0}}
+test imgPPM-1.4 {FileReadPPM procedure} {
+ put test.ppm "P6\n10 -2\n255\nabcdef"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {1 {PPM image file "test.ppm" has dimension(s) <= 0}}
+test imgPPM-1.5 {FileReadPPM procedure} {
+ put test.ppm "P6\n10 20\n256\nabcdef"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {1 {PPM image file "test.ppm" has bad maximum intensity value 256}}
+test imgPPM-1.6 {FileReadPPM procedure} {
+ put test.ppm "P6\n10 20\n0\nabcdef"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {1 {PPM image file "test.ppm" has bad maximum intensity value 0}}
+test imgPPM-1.7 {FileReadPPM procedure} {
+ put test.ppm "P6\n10 10\n255\nabcdef"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {1 {error reading PPM image file "test.ppm": not enough data}}
+test imgPPM-1.8 {FileReadPPM procedure} {
+ put test.ppm "P6\n5 4\n255\n01234567890123456789012345678901234567890123456789012345678"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {1 {error reading PPM image file "test.ppm": not enough data}}
+test imgPPM-1.9 {FileReadPPM procedure} {
+ put test.ppm "P6\n5 4\n150\n012345678901234567890123456789012345678901234567890123456789"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg \
+ [image width p1] [image height p1]
+} {0 p1 5 4}
+
+catch {image delete p1}
+put test.ppm "P6\n5 4\n255\n012345678901234567890123456789012345678901234567890123456789"
+image create photo p1 -file test.ppm
+test imgPPM-2.1 {FileWritePPM procedure} {
+ list [catch {p1 write not_a_dir/bar/baz/gorp} msg] [string tolower $msg] \
+ [string tolower $errorCode]
+} {1 {couldn't open "not_a_dir/bar/baz/gorp": no such file or directory} {posix enoent {no such file or directory}}}
+test imgPPM-2.2 {FileWritePPM procedure} {
+ catch {unset data}
+ p1 write test2.ppm
+ set fd [open test2.ppm]
+ set data [read $fd]
+ close $fd
+ set data
+} {P6
+5 4
+255
+012345678901234567890123456789012345678901234567890123456789}
+
+test imgPPM-3.1 {ReadPPMFileHeader procedure} {
+ catch {image delete p1}
+ put test.ppm "# \n#\n#\nP6\n#\n##\n5 4\n255\n012345678901234567890123456789012345678901234567890123456789"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {0 p1}
+test imgPPM-3.2 {ReadPPMFileHeader procedure} {
+ catch {image delete p1}
+ put test.ppm "P6\n5\n 4 255\n012345678901234567890123456789012345678901234567890123456789"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {0 p1}
+test imgPPM-3.3 {ReadPPMFileHeader procedure} {
+ catch {image delete p1}
+ put test.ppm "P6\n# asdfasdf\n5 4\n255\n012345678901234567890123456789012345678901234567890123456789"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {0 p1}
+test imgPPM-3.4 {ReadPPMFileHeader procedure} {
+ catch {image delete p1}
+ put test.ppm "P6 \n5 4\n255\n012345678901234567890123456789012345678901234567890123456789"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {0 p1}
+test imgPPM-3.5 {ReadPPMFileHeader procedure} {
+ catch {image delete p1}
+ put test.ppm "P5\n5 4\n255\n01234567890123456789"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {0 p1}
+test imgPPM-3.6 {ReadPPMFileHeader procedure} {
+ catch {image delete p1}
+ put test.ppm "P3\n5 4\n255\n012345678901234567890123456789012345678901234567890123456789"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {1 {couldn't recognize data in image file "test.ppm"}}
+test imgPPM-3.7 {ReadPPMFileHeader procedure} {
+ catch {image delete p1}
+ put test.ppm "P6x\n5 4\n255\n012345678901234567890123456789012345678901234567890123456789"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {1 {couldn't recognize data in image file "test.ppm"}}
+test imgPPM-3.8 {ReadPPMFileHeader procedure} {
+ catch {image delete p1}
+ put test.ppm "P6\nxy5 4\n255\n012345678901234567890123456789012345678901234567890123456789"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {1 {couldn't recognize data in image file "test.ppm"}}
+test imgPPM-3.9 {ReadPPMFileHeader procedure} {
+ catch {image delete p1}
+ put test.ppm "P6\n5\n255\n!012345678901234567890123456789012345678901234567890123456789"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {1 {couldn't recognize data in image file "test.ppm"}}
+test imgPPM-3.10 {ReadPPMFileHeader procedure} {
+ catch {image delete p1}
+ put test.ppm "P6\n5 4\nzz255\n012345678901234567890123456789012345678901234567890123456789"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {1 {couldn't recognize data in image file "test.ppm"}}
+test imgPPM-3.11 {ReadPPMFileHeader procedure, empty file} {
+ catch {image delete p1}
+ put test.ppm " "
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {1 {couldn't recognize data in image file "test.ppm"}}
+test imgPPM-3.12 {ReadPPMFileHeader procedure, file ends too soon} {
+ catch {image delete p1}
+ put test.ppm "P6\n566"
+ list [catch {image create photo p1 -file test.ppm} msg] $msg
+} {1 {couldn't recognize data in image file "test.ppm"}}
+test imgPPM-3.13 {ReadPPMFileHeader procedure, file ends too soon} {
+ catch {image delete p1}
+ 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]
diff --git a/tk/tests/imgPhoto.test b/tk/tests/imgPhoto.test
new file mode 100644
index 00000000000..e0c6f568ea1
--- /dev/null
+++ b/tk/tests/imgPhoto.test
@@ -0,0 +1,423 @@
+# 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 (paulus@cs.anu.edu.au)
+#
+# RCS: @(#) $Id$
+
+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 {couldn't recognize data in image file "README"}}
+test imgPhoto-1.8 {options for photo images} {
+ list [catch {image create photo -blah blah} err] $err
+} {1 {unknown option "-blah"}}
+
+test imgPhoto-2.1 {ImgPhotoCreate procedure} {
+ eval image delete [image names]
+ catch {image create photo -blah blah}
+ image names
+} {}
+test imgPhoto-2.2 {ImgPhotoCreate procedure} {
+ eval image delete [image names]
+ image create photo image1
+ list [info commands image1] [image names] \
+ [image width image1] [image height image1]
+} {image1 image1 0 0}
+# test imgPhoto-2.3 {ImgPhotoCreate procedure: creation failure} {
+# image create photo p1
+# 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
+update
+
+test imgPhoto-4.1 {ImgPhotoCmd procedure} {
+ list [catch {p1} err] $err
+} {1 {wrong # args: should be "p1 option ?arg arg ...?"}}
+test imgPhoto-4.2 {ImgPhotoCmd procedure} {
+ list [catch {p1 blah} err] $err
+} {1 {bad option "blah": must be blank, cget, configure, copy, get, put, read, redither, or write}}
+test imgPhoto-4.3 {ImgPhotoCmd procedure: blank option} {
+ p1 blank
+ list [catch {p1 blank x} err] $err
+} {1 {wrong # args: should be "p1 blank"}}
+test imgPhoto-4.4 {ImgPhotoCmd procedure: cget option} {
+ list [catch {p1 cget} msg] $msg
+} {1 {wrong # args: should be "p1 cget option"}}
+test imgPhoto-4.5 {ImgPhotoCmd procedure: cget option} {
+ image create photo p2 -width 25 -height 30
+ list [p2 cget -width] [p2 cget -height]
+} {25 30}
+test imgPhoto-4.6 {ImgPhotoCmd procedure: configure option} {
+ llength [p1 configure]
+} {7}
+test imgPhoto-4.7 {ImgPhotoCmd procedure: configure option} {
+ p1 conf -palette 3/4/2
+ p1 configure -palette
+} {-palette {} {} {} 3/4/2}
+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?"}}
+test imgPhoto-4.12 {ImgPhotoCmd procedure: copy option} {
+ list [catch {p1 copy blah} msg] $msg
+} {1 {image "blah" doesn't exist or is not a photo image}}
+test imgPhoto-4.13 {ImgPhotoCmd procedure: copy option} {
+ list [catch {p1 copy p2 -blah} msg] $msg
+} {1 {unrecognized option "-blah": must be -from, -shrink, -subsample, -to, or -zoom}}
+test imgPhoto-4.14 {ImgPhotoCmd procedure: copy option} {
+ list [catch {p1 copy p2 -from -to} msg] $msg
+} {1 {the "-from" option requires one to four integer values}}
+test imgPhoto-4.15 {ImgPhotoCmd procedure: copy option} {
+ p1 copy p2
+ p1 copy p2 -from 0 70 60 120 -shrink
+ list [image width p1] [image height p1] [p1 get 20 10]
+} {60 50 {215 154 120}}
+test imgPhoto-4.16 {ImgPhotoCmd procedure: copy option} {
+ p1 copy p2 -from 60 120 0 70 -to 20 50
+ list [image width p1] [image height p1] [p1 get 40 80]
+} {80 100 {19 92 192}}
+test imgPhoto-4.17 {ImgPhotoCmd procedure: copy option} {
+ p1 copy p2 -from 0 120 60 70 -to 0 0 100 100
+ list [image width p1] [image height p1] [p1 get 80 60]
+} {100 100 {215 154 120}}
+test imgPhoto-4.18 {ImgPhotoCmd procedure: copy option} {
+ p1 copy p2 -from 60 70 0 120 -zoom 2
+ list [image width p1] [image height p1] [p1 get 100 50]
+} {120 100 {169 99 47}}
+test imgPhoto-4.19 {ImgPhotoCmd procedure: copy option} {
+ p1 copy p2 -from 0 70 60 120
+ list [image width p1] [image height p1] [p1 get 100 50]
+} {120 100 {169 99 47}}
+test imgPhoto-4.20 {ImgPhotoCmd procedure: copy option} {
+ p1 copy p2 -from 20 20 200 180 -subsample 2 -shrink
+ list [image width p1] [image height p1] [p1 get 50 30]
+} {90 80 {207 146 112}}
+test imgPhoto-4.21 {ImgPhotoCmd procedure: copy option} {
+ p1 copy p2
+ set result [list [image width p1] [image height p1]]
+ p1 conf -width 49 -height 51
+ lappend result [image width p1] [image height p1]
+ p1 copy p2
+ lappend result [image width p1] [image height p1]
+ p1 copy p2 -from 0 0 10 10 -shrink
+ lappend result [image width p1] [image height p1]
+ p1 conf -width 0
+ 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
+} {1 {p1 get: coordinates out of range}}
+test imgPhoto-4.25 {ImgPhotoCmd procedure: get option} {
+ list [catch {p1 get} err] $err
+} {1 {wrong # args: should be "p1 get x y"}}
+test imgPhoto-4.26 {ImgPhotoCmd procedure: put option} {
+ list [catch {p1 put} err] $err
+} {1 {wrong # args: should be "p1 put data ?-format format? ?-to x1 y1 x2 y2?"}}
+test imgPhoto-4.27 {ImgPhotoCmd procedure: put option} {
+ list [catch {p1 put {{white} {white white}}} err] $err
+} {1 {all elements of color list must have the same number of elements}}
+test imgPhoto-4.28 {ImgPhotoCmd procedure: put option} {
+ list [catch {p1 put {{blahgle}}} err] $err
+} {1 {can't parse color "blahgle"}}
+test imgPhoto-4.29 {ImgPhotoCmd procedure: put option} {
+ 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
+ .c delete i1.2
+ p1 configure -height 1
+ update
+ image delete p1
+} {}
+
+test imgPhoto-6.1 {ImgPhotoDisplay procedure, blank display} {
+ .c delete all
+ image create photo p1 -width 10 -height 10
+ p1 blank
+ .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
+ p1 put {{#ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000}} \
+ -to 0 0
+ p1 put {{#00ff00 #00ff00}} -to 2 0
+ list [p1 get 2 0] [p1 get 3 0] [p1 get 4 0]
+} {{0 255 0} {0 255 0} {255 0 0}}
+
+test imgPhoto-11.1 {Tk_FindPhoto} {
+ 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}}
+
+test imgPhoto-13.1 {check separation of images in different interpreters} {
+ eval image delete [image names]
+ set data {
+ R0lGODlhQgBkAPUAANbWxs7Wxs7OxsbOxsbGxsbGvb3Gvca9vcDAwL21vbW1vbW1tbWtta2t
+ ta2ltaWltaWlraWctaWcrZycrZyUrZSUrZSMrZSMpYyMrYyMpYyEpYSEpYR7pYR7nHp7pYRz
+ pYRynHtzpXtznHtrnHNrnHNjnGtjnGtjlGtalGNalGNSlGNSjFpSlFpKlFpKjFJKjFJCjFI5
+ jEo5jEo5hEoxhEIxhDkphDkhhAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACwAAAAAQgBkAAAG
+ /kCEcEgsGo/IpHLJbDqf0Kh0Sq1ar9isdsvter/gsHhMLpvP6LR6zW673/C4fE6v2+/4vH7P
+ 7/v/gIGCg4SFhoeIiYqLjI2Oj5CRkpOUlZaXmJmOBZxXnAQEnKIIBUQJCguoDKkIBgWhpUev
+ CA4TDwgEUpwKERUaHCIiJCQjIiEUQhwqKiwqLjDQMCwoIha3oUO5ESMuLSwtLSIMsU4Tzi4o
+ JBwWFA8ODQoMCkIMq6sNDQ4UFhwlzC4qSGhgkMvCsAoM6E0oAWMCOSUFGrgQcauAgAACSqGa
+ l6SAK1EaJXBA0SIDBw0KBiCg8EtEBgEWYCxoooAigFwIJGgQYQIF/goTAjk6sXhxAwwFnHRO
+ mEmAwoQAIUo8lCWhRgoOElJVkJBQFCwhCRqkYlUE1QMKHEywoBCrQaeIMCgQeOCi3AkYMmRI
+ S5EuxEkN7OApkGDhF4fDxoSVMAFUBAWkRxI0a+XghVAkBSqMsFCBwj4OI0igSKGCdLN0wYKd
+ zGDBwUYhn6YOKUCioQECGk7INpIArQgUKkr87TyhAYIDQxQgLkYsRIcQIDjcgi2Lw8RYKaAz
+ MXCgAs8UJrZGmOA5AkeQBlqRKsIpvYMQDx4S4NCCxIJSKJpFYMIgnPlSF2ygAQWuCUHAAp6x
+ E4EEE5BXQQUWYLABBySoAIMLHBSBWwso/jxwIAoyzMAWEw3AEEJCt6nUwAQagCDCYcCQwJcK
+ 6QD3DDQxwNDCCSg9NIAGKpwwgQAOtDADDBbsdkQDIPhkwosDPgDPAg1EAME++1jTnhAKdAnb
+ VAR04EIJFAhwwQs0sBDfE7cZwEAE++yU2joOtDcKE7GUcoIKH6RSmwwnQCZFKAo8cE2es7my
+ HnuxKTDgAA6owEEBjoL3wqRUNDBCCnyRYMFMRSDoWYPvyBPPA738lt1KKTxgpjolrDDiFAWU
+ cAMKE+CipAMRZMDTCSSUQMIJPQHLwWOcrDKBCBpokAIJgmYqQgosxIAOCS8iJEQD7HR2QbMh
+ WCCEK7Ck90Cz/oAFu+YVigpTwTsLyJOcBJ6N6plxRihA3E4cOKTkFCU6FMoAA7wiygAZgURA
+ ekYsEJYFGTSATRccQEMjti8eZsEFFuA7z2WkEJAAl7iEQekEhQHGzgQR4INUKLB8pYAFJaQA
+ KhleKdwAByEkFswHIoxQQn4AcYBvGRosisDICCjQAIMJGnZYBsUd4JEZBIhQwgPzKFwAwggL
+ IHbOQzCtxZ1NL0BlKmmhIOwwHGTg2YMUEBdtKzBfbQWlhMHoHIXBnvABBGE9UMKNMKhgQgnG
+ nNQO0wVQoI4FEohFyr9GzDIYaaPxxWy0rCjKQJUMQvxBaMOgNMQChcU4DAkZ6PoV/hIUoP4i
+ Z7g/YHZHIPXeyWyONgsaCi4AOoLjXP8uhAAvPpCQ2Akr38UpXW60Ij8yPkMmwwj8KAI8QWtQ
+ +eXSixEb37WhcHQBERz2rdZ8leCBBcXNY3XevQ8VG/6+F5CACDYgATlmYYD27aRmLngBNADC
+ GGxxQEAWUJDzqpcctc2DARN4kNRgtJxhnKAFV0kIEhYAJ34IQwUhqkENYFCCE5BmGf9wwWmA
+ 5UGgXAAVtfCFMIgRLMbFLQIPYFACcMI7TjQoH2eJQIs2poEMYMAp5XGAvFrBCYS9ImzQG1vT
+ arGTEQhIhE7QjLA+MKDOxClGwuoJtWi0uBIUIxjDSE2wQ4iHl7ywQDjGwZws/NcAlgBjaKQJ
+ JDVuoQBeUeACoFkMcFqgQL1IgxpRSsjsqHA/gy0tHvmAx2z2BxIupaJrnVxCEAAAOw==
+ }
+ interp create x1
+ interp create x2
+ x1 eval {load {} Tk}
+ x2 eval {load {} Tk}
+ x1 eval [list image create photo T1_data -data $data]
+ x2 eval [list image create photo T1_data -data $data]
+ unset data
+ interp delete x1
+ interp delete x2
+} {}
+
+destroy .c
+eval image delete [image names]
diff --git a/tk/tests/license.terms b/tk/tests/license.terms
new file mode 100644
index 00000000000..03ca6fcb319
--- /dev/null
+++ b/tk/tests/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., and other parties. The following
+terms apply to all files associated with the software unless explicitly
+disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
diff --git a/tk/tests/listbox.test b/tk/tests/listbox.test
new file mode 100644
index 00000000000..40e65d6218e
--- /dev/null
+++ b/tk/tests/listbox.test
@@ -0,0 +1,1658 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then \
+ {source defs}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+wm geometry . {}
+raise .
+set fixed {Courier -12}
+
+proc record args {
+ global log
+ lappend log $args
+}
+
+proc getsize w {
+ regexp {(^[^+-]*)} [wm geometry $w] foo x
+ return $x
+}
+
+proc resetGridInfo {} {
+ # Some window managers, such as mwm, don't reset gridding information
+ # unless the window is withdrawn and re-mapped. If this procedure
+ # isn't invoked, the window manager will stay in gridded mode, which
+ # can cause all sorts of problems. The "wm positionfrom" command is
+ # needed so that the window manager doesn't ask the user to
+ # manually position the window when it is re-mapped.
+
+ wm withdraw .
+ wm positionfrom . user
+ wm deiconify .
+}
+
+# Procedure that creates a second listbox for checking things related
+# to partially visible lines.
+
+proc mkPartial {{w .partial}} {
+ catch {destroy $w}
+ toplevel $w
+ wm geometry $w +0+0
+ listbox $w.l -width 30 -height 5
+ pack $w.l -expand 1 -fill both
+ $w.l insert end one two three four five six seven eight nine ten \
+ eleven twelve thirteen fourteen fifteen
+ update
+ scan [wm geometry $w] "%dx%d" width height
+ wm geometry $w ${width}x[expr $height-3]
+ update
+}
+
+# Create entries in the option database to be sure that geometry options
+# like border width have predictable values.
+
+option add *Listbox.borderWidth 2
+option add *Listbox.highlightThickness 2
+option add *Listbox.font {Helvetica -12 bold}
+
+listbox .l
+pack .l
+update
+resetGridInfo
+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"}}
+ {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
+ {-exportselection yes 1 xyzzy {expected boolean value but got "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 30 30 20p {expected integer but got "20p"}}
+ {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
+ {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
+ {-highlightthickness 6 6 bogus {bad screen distance "bogus"}}
+ {-highlightthickness -2 0 {} {}}
+ {-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"}}
+ {-selectmode string string {} {}}
+ {-setgrid false 0 lousy {expected boolean value but got "lousy"}}
+ {-takefocus "any string" "any string" {} {}}
+ {-width 45 45 3p {expected integer but got "3p"}}
+ {-xscrollcommand {Some command} {Some command} {} {}}
+ {-yscrollcommand {Another command} {Another command} {} {}}
+} {
+ set name [lindex $test 0]
+ test listbox-1.$i {configuration options} {
+ .l configure $name [lindex $test 1]
+ list [lindex [.l configure $name] 4] [.l cget $name]
+ } [list [lindex $test 2] [lindex $test 2]]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test listbox-1.$i {configuration options} {
+ list [catch {.l configure $name [lindex $test 3]} msg] $msg
+ } [list 1 [lindex $test 4]]
+ }
+ .l configure $name [lindex [.l configure $name] 3]
+ incr i
+}
+
+test listbox-2.1 {Tk_ListboxCmd procedure} {
+ list [catch {listbox} msg] $msg
+} {1 {wrong # args: should be "listbox pathName ?options?"}}
+test listbox-2.2 {Tk_ListboxCmd procedure} {
+ list [catch {listbox gorp} msg] $msg
+} {1 {bad window path name "gorp"}}
+test listbox-2.3 {Tk_ListboxCmd procedure} {
+ catch {destroy .l}
+ listbox .l
+ list [winfo exists .l] [winfo class .l] [info commands .l]
+} {1 Listbox .l}
+test listbox-2.4 {Tk_ListboxCmd procedure} {
+ catch {destroy .l}
+ list [catch {listbox .l -gorp foo} msg] $msg [winfo exists .l] \
+ [info commands .l]
+} {1 {unknown option "-gorp"} 0 {}}
+test listbox-2.5 {Tk_ListboxCmd procedure} {
+ catch {destroy .l}
+ listbox .l
+} {.l}
+
+catch {destroy .l}
+listbox .l -width 20 -height 5 -bd 4 -highlightthickness 1 -selectborderwidth 2
+pack .l
+.l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11 el12 el13 el14 \
+ el15 el16 el17
+update
+test listbox-3.1 {ListboxWidgetCmd procedure} {
+ list [catch .l msg] $msg
+} {1 {wrong # args: should be ".l option ?arg arg ...?"}}
+test listbox-3.2 {ListboxWidgetCmd procedure, "activate" option} {
+ list [catch {.l activate} msg] $msg
+} {1 {wrong # args: should be ".l activate index"}}
+test listbox-3.3 {ListboxWidgetCmd procedure, "activate" option} {
+ list [catch {.l activate a b} msg] $msg
+} {1 {wrong # args: should be ".l activate index"}}
+test listbox-3.4 {ListboxWidgetCmd procedure, "activate" option} {
+ list [catch {.l activate fooey} msg] $msg
+} {1 {bad listbox index "fooey": must be active, anchor, end, @x,y, or a number}}
+test listbox-3.5 {ListboxWidgetCmd procedure, "activate" option} {
+ .l activate 3
+ .l index active
+} 3
+test listbox-3.6 {ListboxWidgetCmd procedure, "activate" option} {
+ .l activate -1
+ .l index active
+} {0}
+test listbox-3.7 {ListboxWidgetCmd procedure, "activate" option} {
+ .l activate 30
+ .l index active
+} {17}
+test listbox-3.8 {ListboxWidgetCmd procedure, "activate" option} {
+ .l activate end
+ .l index active
+} {17}
+test listbox-3.9 {ListboxWidgetCmd procedure, "bbox" option} {
+ list [catch {.l bbox} msg] $msg
+} {1 {wrong # args: should be ".l bbox index"}}
+test listbox-3.10 {ListboxWidgetCmd procedure, "bbox" option} {
+ list [catch {.l bbox a b} msg] $msg
+} {1 {wrong # args: should be ".l bbox index"}}
+test listbox-3.11 {ListboxWidgetCmd procedure, "bbox" option} {
+ list [catch {.l bbox fooey} msg] $msg
+} {1 {bad listbox index "fooey": must be active, anchor, end, @x,y, or a number}}
+test listbox-3.12 {ListboxWidgetCmd procedure, "bbox" option} {
+ .l yview 3
+ update
+ list [.l bbox 2] [.l bbox 8]
+} {{} {}}
+test listbox-3.13 {ListboxWidgetCmd procedure, "bbox" option} {
+ # Used to generate a core dump before a bug was fixed (the last
+ # element would be on-screen if it existed, but it doesn't exist).
+
+ listbox .l2
+ pack .l2 -side top
+ tkwait visibility .l2
+ set x [.l2 bbox 0]
+ destroy .l2
+ set x
+} {}
+test listbox-3.14 {ListboxWidgetCmd procedure, "bbox" option} {fonts} {
+ .l yview 3
+ update
+ list [.l bbox 3] [.l bbox 4]
+} {{7 7 17 14} {7 26 17 14}}
+test listbox-3.15 {ListboxWidgetCmd procedure, "bbox" option} {fonts} {
+ .l yview 0
+ update
+ list [.l bbox -1] [.l bbox 0]
+} {{} {7 7 17 14}}
+test listbox-3.16 {ListboxWidgetCmd procedure, "bbox" option} {fonts} {
+ .l yview end
+ update
+ list [.l bbox 17] [.l bbox end] [.l bbox 18]
+} {{7 83 24 14} {7 83 24 14} {}}
+test listbox-3.17 {ListboxWidgetCmd procedure, "bbox" option} {fonts} {
+ catch {destroy .t}
+ toplevel .t
+ wm geom .t +0+0
+ listbox .t.l -width 10 -height 5
+ .t.l insert 0 "Short" "Somewhat longer" "Really, quite a whole lot longer than can possibly fit on the screen" "Short"
+ pack .t.l
+ update
+ .t.l xview moveto .2
+ .t.l bbox 2
+} {-72 39 393 14}
+test listbox-3.18 {ListboxWidgetCmd procedure, "bbox" option, partial last line} {fonts} {
+ mkPartial
+ list [.partial.l bbox 3] [.partial.l bbox 4]
+} {{5 56 24 14} {5 73 23 14}}
+test listbox-3.19 {ListboxWidgetCmd procedure, "cget" option} {
+ list [catch {.l cget} msg] $msg
+} {1 {wrong # args: should be ".l cget option"}}
+test listbox-3.20 {ListboxWidgetCmd procedure, "cget" option} {
+ list [catch {.l cget a b} msg] $msg
+} {1 {wrong # args: should be ".l cget option"}}
+test listbox-3.21 {ListboxWidgetCmd procedure, "cget" option} {
+ list [catch {.l cget -gorp} msg] $msg
+} {1 {unknown option "-gorp"}}
+test listbox-3.22 {ListboxWidgetCmd procedure, "cget" option} {
+ .l cget -setgrid
+} {0}
+test listbox-3.23 {ListboxWidgetCmd procedure, "configure" option} {
+ llength [.l configure]
+} {23}
+test listbox-3.24 {ListboxWidgetCmd procedure, "configure" option} {
+ list [catch {.l configure -gorp} msg] $msg
+} {1 {unknown option "-gorp"}}
+test listbox-3.25 {ListboxWidgetCmd procedure, "configure" option} {
+ .l configure -setgrid
+} {-setgrid setGrid SetGrid 0 0}
+test listbox-3.26 {ListboxWidgetCmd procedure, "configure" option} {
+ list [catch {.l configure -gorp is_messy} msg] $msg
+} {1 {unknown option "-gorp"}}
+test listbox-3.27 {ListboxWidgetCmd procedure, "configure" option} {
+ set oldbd [.l cget -bd]
+ set oldht [.l cget -highlightthickness]
+ .l configure -bd 3 -highlightthickness 0
+ set x "[.l cget -bd] [.l cget -highlightthickness]"
+ .l configure -bd $oldbd -highlightthickness $oldht
+ set x
+} {3 0}
+test listbox-3.28 {ListboxWidgetCmd procedure, "curselection" option} {
+ list [catch {.l curselection a} msg] $msg
+} {1 {wrong # args: should be ".l curselection"}}
+test listbox-3.29 {ListboxWidgetCmd procedure, "curselection" option} {
+ .l selection clear 0 end
+ .l selection set 3 6
+ .l selection set 9
+ .l curselection
+} {3 4 5 6 9}
+test listbox-3.30 {ListboxWidgetCmd procedure, "delete" option} {
+ list [catch {.l delete} msg] $msg
+} {1 {wrong # args: should be ".l delete firstIndex ?lastIndex?"}}
+test listbox-3.31 {ListboxWidgetCmd procedure, "delete" option} {
+ list [catch {.l delete a b c} msg] $msg
+} {1 {wrong # args: should be ".l delete firstIndex ?lastIndex?"}}
+test listbox-3.32 {ListboxWidgetCmd procedure, "delete" option} {
+ list [catch {.l delete badIndex} msg] $msg
+} {1 {bad listbox index "badIndex": must be active, anchor, end, @x,y, or a number}}
+test listbox-3.33 {ListboxWidgetCmd procedure, "delete" option} {
+ list [catch {.l delete 2 123ab} msg] $msg
+} {1 {bad listbox index "123ab": must be active, anchor, end, @x,y, or a number}}
+test listbox-3.34 {ListboxWidgetCmd procedure, "delete" option} {
+ catch {destroy .l2}
+ listbox .l2
+ .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
+ .l2 delete 3
+ list [.l2 get 2] [.l2 get 3] [.l2 index end]
+} {el2 el4 7}
+test listbox-3.35 {ListboxWidgetCmd procedure, "delete" option} {
+ catch {destroy .l2}
+ listbox .l2
+ .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
+ .l2 delete 2 4
+ list [.l2 get 1] [.l2 get 2] [.l2 index end]
+} {el1 el5 5}
+test listbox-3.36 {ListboxWidgetCmd procedure, "delete" option} {
+ catch {destroy .l2}
+ listbox .l2
+ .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
+ .l2 delete -3 2
+ .l2 get 0 end
+} {el3 el4 el5 el6 el7}
+test listbox-3.37 {ListboxWidgetCmd procedure, "delete" option} {
+ catch {destroy .l2}
+ listbox .l2
+ .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
+ .l2 delete -3 -1
+ .l2 get 0 end
+} {el0 el1 el2 el3 el4 el5 el6 el7}
+test listbox-3.38 {ListboxWidgetCmd procedure, "delete" option} {
+ catch {destroy .l2}
+ listbox .l2
+ .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
+ .l2 delete 2 end
+ .l2 get 0 end
+} {el0 el1}
+test listbox-3.39 {ListboxWidgetCmd procedure, "delete" option} {
+ catch {destroy .l2}
+ listbox .l2
+ .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
+ .l2 delete 5 20
+ .l2 get 0 end
+} {el0 el1 el2 el3 el4}
+test listbox-3.40 {ListboxWidgetCmd procedure, "delete" option} {
+ catch {destroy .l2}
+ listbox .l2
+ .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
+ .l2 delete end 20
+ .l2 get 0 end
+} {el0 el1 el2 el3 el4 el5 el6}
+test listbox-3.41 {ListboxWidgetCmd procedure, "delete" option} {
+ catch {destroy .l2}
+ listbox .l2
+ .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
+ .l2 delete 8 20
+ .l2 get 0 end
+} {el0 el1 el2 el3 el4 el5 el6 el7}
+test listbox-3.42 {ListboxWidgetCmd procedure, "get" option} {
+ list [catch {.l get} msg] $msg
+} {1 {wrong # args: should be ".l get first ?last?"}}
+test listbox-3.43 {ListboxWidgetCmd procedure, "get" option} {
+ list [catch {.l get a b c} msg] $msg
+} {1 {wrong # args: should be ".l get first ?last?"}}
+test listbox-3.44 {ListboxWidgetCmd procedure, "get" option} {
+ list [catch {.l get 2.4} msg] $msg
+} {1 {bad listbox index "2.4": must be active, anchor, end, @x,y, or a number}}
+test listbox-3.45 {ListboxWidgetCmd procedure, "get" option} {
+ list [catch {.l get end bogus} msg] $msg
+} {1 {bad listbox index "bogus": must be active, anchor, end, @x,y, or a number}}
+test listbox-3.46 {ListboxWidgetCmd procedure, "get" option} {
+ catch {destroy .l2}
+ listbox .l2
+ .l2 insert 0 el0 el1 el2 el3 el4 el5 el6 el7
+ list [.l2 get 0] [.l2 get 3] [.l2 get end]
+} {el0 el3 el7}
+test listbox-3.47 {ListboxWidgetCmd procedure, "get" option} {
+ catch {destroy .l2}
+ listbox .l2
+ list [.l2 get 0] [.l2 get end]
+} {{} {}}
+test listbox-3.48 {ListboxWidgetCmd procedure, "get" option} {
+ catch {destroy .l2}
+ listbox .l2
+ .l2 insert 0 el0 el1 el2 "two words" el4 el5 el6 el7
+ .l2 get 3 end
+} {{two words} el4 el5 el6 el7}
+test listbox-3.49 {ListboxWidgetCmd procedure, "get" option} {
+ .l get -1
+} {}
+test listbox-3.50 {ListboxWidgetCmd procedure, "get" option} {
+ .l get -2 -1
+} {}
+test listbox-3.51 {ListboxWidgetCmd procedure, "get" option} {
+ .l get -2 3
+} {el0 el1 el2 el3}
+test listbox-3.52 {ListboxWidgetCmd procedure, "get" option} {
+ .l get 12 end
+} {el12 el13 el14 el15 el16 el17}
+test listbox-3.53 {ListboxWidgetCmd procedure, "get" option} {
+ .l get 12 20
+} {el12 el13 el14 el15 el16 el17}
+test listbox-3.54 {ListboxWidgetCmd procedure, "get" option} {
+ .l get end
+} {el17}
+test listbox-3.55 {ListboxWidgetCmd procedure, "get" option} {
+ .l get 30
+} {}
+test listbox-3.56 {ListboxWidgetCmd procedure, "get" option} {
+ .l get 30 35
+} {}
+test listbox-3.57 {ListboxWidgetCmd procedure, "index" option} {
+ list [catch {.l index} msg] $msg
+} {1 {wrong # args: should be ".l index index"}}
+test listbox-3.58 {ListboxWidgetCmd procedure, "index" option} {
+ list [catch {.l index a b} msg] $msg
+} {1 {wrong # args: should be ".l index index"}}
+test listbox-3.59 {ListboxWidgetCmd procedure, "index" option} {
+ list [catch {.l index @} msg] $msg
+} {1 {bad listbox index "@": must be active, anchor, end, @x,y, or a number}}
+test listbox-3.60 {ListboxWidgetCmd procedure, "index" option} {
+ .l index 2
+} 2
+test listbox-3.61 {ListboxWidgetCmd procedure, "index" option} {
+ .l index -1
+} -1
+test listbox-3.62 {ListboxWidgetCmd procedure, "index" option} {
+ .l index end
+} 18
+test listbox-3.63 {ListboxWidgetCmd procedure, "index" option} {
+ .l index 34
+} 34
+test listbox-3.64 {ListboxWidgetCmd procedure, "insert" option} {
+ list [catch {.l insert} msg] $msg
+} {1 {wrong # args: should be ".l insert index ?element element ...?"}}
+test listbox-3.65 {ListboxWidgetCmd procedure, "insert" option} {
+ list [catch {.l insert badIndex} msg] $msg
+} {1 {bad listbox index "badIndex": must be active, anchor, end, @x,y, or a number}}
+test listbox-3.66 {ListboxWidgetCmd procedure, "insert" option} {
+ catch {destroy .l2}
+ listbox .l2
+ .l2 insert end a b c d e
+ .l2 insert 3 x y z
+ .l2 get 0 end
+} {a b c x y z d e}
+test listbox-3.67 {ListboxWidgetCmd procedure, "insert" option} {
+ catch {destroy .l2}
+ listbox .l2
+ .l2 insert end a b c
+ .l2 insert -1 x
+ .l2 get 0 end
+} {x a b c}
+test listbox-3.68 {ListboxWidgetCmd procedure, "insert" option} {
+ catch {destroy .l2}
+ listbox .l2
+ .l2 insert end a b c
+ .l2 insert end x
+ .l2 get 0 end
+} {a b c x}
+test listbox-3.69 {ListboxWidgetCmd procedure, "insert" option} {
+ catch {destroy .l2}
+ listbox .l2
+ .l2 insert end a b c
+ .l2 insert 43 x
+ .l2 get 0 end
+} {a b c x}
+test listbox-3.70 {ListboxWidgetCmd procedure, "nearest" option} {
+ list [catch {.l nearest} msg] $msg
+} {1 {wrong # args: should be ".l nearest y"}}
+test listbox-3.71 {ListboxWidgetCmd procedure, "nearest" option} {
+ list [catch {.l nearest a b} msg] $msg
+} {1 {wrong # args: should be ".l nearest y"}}
+test listbox-3.72 {ListboxWidgetCmd procedure, "nearest" option} {
+ list [catch {.l nearest 20p} msg] $msg
+} {1 {expected integer but got "20p"}}
+test listbox-3.73 {ListboxWidgetCmd procedure, "nearest" option} {
+ .l yview 3
+ .l nearest 1000
+} {7}
+test listbox-3.74 {ListboxWidgetCmd procedure, "scan" option} {
+ list [catch {.l scan a b} msg] $msg
+} {1 {wrong # args: should be ".l scan mark|dragto x y"}}
+test listbox-3.75 {ListboxWidgetCmd procedure, "scan" option} {
+ list [catch {.l scan a b c d} msg] $msg
+} {1 {wrong # args: should be ".l scan mark|dragto x y"}}
+test listbox-3.76 {ListboxWidgetCmd procedure, "scan" option} {
+ list [catch {.l scan foo bogus 2} msg] $msg
+} {1 {expected integer but got "bogus"}}
+test listbox-3.77 {ListboxWidgetCmd procedure, "scan" option} {
+ list [catch {.l scan foo 2 2.3} msg] $msg
+} {1 {expected integer but got "2.3"}}
+test listbox-3.78 {ListboxWidgetCmd procedure, "scan" option} {fonts} {
+ catch {destroy .t}
+ toplevel .t
+ wm geom .t +0+0
+ listbox .t.l -width 10 -height 5
+ .t.l insert 0 "Short" "Somewhat longer" "Really, quite a whole lot longer than can possibly fit on the screen" "Short" a b c d e f g h i j
+ pack .t.l
+ update
+ .t.l scan mark 100 140
+ .t.l scan dragto 90 137
+ update
+ list [.t.l xview] [.t.l yview]
+} {{0.249364 0.427481} {0.0714286 0.428571}}
+test listbox-3.79 {ListboxWidgetCmd procedure, "scan" option} {
+ list [catch {.l scan foo 2 4} msg] $msg
+} {1 {bad scan option "foo": must be mark or dragto}}
+test listbox-3.80 {ListboxWidgetCmd procedure, "see" option} {
+ list [catch {.l see} msg] $msg
+} {1 {wrong # args: should be ".l see index"}}
+test listbox-3.81 {ListboxWidgetCmd procedure, "see" option} {
+ list [catch {.l see a b} msg] $msg
+} {1 {wrong # args: should be ".l see index"}}
+test listbox-3.82 {ListboxWidgetCmd procedure, "see" option} {
+ list [catch {.l see gorp} msg] $msg
+} {1 {bad listbox index "gorp": must be active, anchor, end, @x,y, or a number}}
+test listbox-3.83 {ListboxWidgetCmd procedure, "see" option} {
+ .l yview 7
+ .l see 7
+ .l index @0,0
+} {7}
+test listbox-3.84 {ListboxWidgetCmd procedure, "see" option} {
+ .l yview 7
+ .l see 11
+ .l index @0,0
+} {7}
+test listbox-3.85 {ListboxWidgetCmd procedure, "see" option} {
+ .l yview 7
+ .l see 6
+ .l index @0,0
+} {6}
+test listbox-3.86 {ListboxWidgetCmd procedure, "see" option} {
+ .l yview 7
+ .l see 5
+ .l index @0,0
+} {3}
+test listbox-3.87 {ListboxWidgetCmd procedure, "see" option} {
+ .l yview 7
+ .l see 12
+ .l index @0,0
+} {8}
+test listbox-3.88 {ListboxWidgetCmd procedure, "see" option} {
+ .l yview 7
+ .l see 13
+ .l index @0,0
+} {11}
+test listbox-3.89 {ListboxWidgetCmd procedure, "see" option} {
+ .l yview 7
+ .l see -1
+ .l index @0,0
+} {0}
+test listbox-3.90 {ListboxWidgetCmd procedure, "see" option} {
+ .l yview 7
+ .l see end
+ .l index @0,0
+} {13}
+test listbox-3.91 {ListboxWidgetCmd procedure, "see" option} {
+ .l yview 7
+ .l see 322
+ .l index @0,0
+} {13}
+test listbox-3.92 {ListboxWidgetCmd procedure, "see" option, partial last line} {
+ mkPartial
+ .partial.l see 4
+ .partial.l index @0,0
+} {1}
+test listbox-3.93 {ListboxWidgetCmd procedure, "selection" option} {
+ list [catch {.l select a} msg] $msg
+} {1 {wrong # args: should be ".l selection option index ?index?"}}
+test listbox-3.94 {ListboxWidgetCmd procedure, "selection" option} {
+ list [catch {.l select a b c d} msg] $msg
+} {1 {wrong # args: should be ".l selection option index ?index?"}}
+test listbox-3.95 {ListboxWidgetCmd procedure, "selection" option} {
+ list [catch {.l selection a bogus} msg] $msg
+} {1 {bad listbox index "bogus": must be active, anchor, end, @x,y, or a number}}
+test listbox-3.96 {ListboxWidgetCmd procedure, "selection" option} {
+ list [catch {.l selection a 0 lousy} msg] $msg
+} {1 {bad listbox index "lousy": must be active, anchor, end, @x,y, or a number}}
+test listbox-3.97 {ListboxWidgetCmd procedure, "selection" option} {
+ list [catch {.l selection anchor 0 0} msg] $msg
+} {1 {wrong # args: should be ".l selection anchor index"}}
+test listbox-3.98 {ListboxWidgetCmd procedure, "selection" option} {
+ list [.l selection anchor 5; .l index anchor] \
+ [.l selection anchor 0; .l index anchor]
+} {5 0}
+test listbox-3.99 {ListboxWidgetCmd procedure, "selection" option} {
+ .l selection anchor -1
+ .l index anchor
+} {0}
+test listbox-3.100 {ListboxWidgetCmd procedure, "selection" option} {
+ .l selection anchor end
+ .l index anchor
+} {17}
+test listbox-3.101 {ListboxWidgetCmd procedure, "selection" option} {
+ .l selection anchor 44
+ .l index anchor
+} {17}
+test listbox-3.102 {ListboxWidgetCmd procedure, "selection" option} {
+ .l selection clear 0 end
+ .l selection set 2 8
+ .l selection clear 3 4
+ .l curselection
+} {2 5 6 7 8}
+test listbox-3.103 {ListboxWidgetCmd procedure, "selection" option} {
+ list [catch {.l selection includes 0 0} msg] $msg
+} {1 {wrong # args: should be ".l selection includes index"}}
+test listbox-3.104 {ListboxWidgetCmd procedure, "selection" option} {
+ .l selection clear 0 end
+ .l selection set 2 8
+ .l selection clear 4
+ list [.l selection includes 3] [.l selection includes 4] \
+ [.l selection includes 5]
+} {1 0 1}
+test listbox-3.105 {ListboxWidgetCmd procedure, "selection" option} {
+ .l selection set 0 end
+ .l selection includes -1
+} {0}
+test listbox-3.106 {ListboxWidgetCmd procedure, "selection" option} {
+ .l selection clear 0 end
+ .l selection set end
+ .l selection includes end
+} {1}
+test listbox-3.107 {ListboxWidgetCmd procedure, "selection" option} {
+ .l selection set 0 end
+ .l selection includes 44
+} {0}
+test listbox-3.108 {ListboxWidgetCmd procedure, "selection" option} {
+ catch {destroy .l2}
+ listbox .l2
+ .l2 selection includes 0
+} {0}
+test listbox-3.109 {ListboxWidgetCmd procedure, "selection" option} {
+ .l selection clear 0 end
+ .l selection set 2
+ .l selection set 5 7
+ .l curselection
+} {2 5 6 7}
+test listbox-3.110 {ListboxWidgetCmd procedure, "selection" option} {
+ .l selection set 5 7
+ .l curselection
+} {2 5 6 7}
+test listbox-3.111 {ListboxWidgetCmd procedure, "selection" option} {
+ list [catch {.l selection badOption 0 0} msg] $msg
+} {1 {bad selection option "badOption": must be anchor, clear, includes, or set}}
+test listbox-3.112 {ListboxWidgetCmd procedure, "size" option} {
+ list [catch {.l size a} msg] $msg
+} {1 {wrong # args: should be ".l size"}}
+test listbox-3.113 {ListboxWidgetCmd procedure, "size" option} {
+ .l size
+} {18}
+test listbox-3.114 {ListboxWidgetCmd procedure, "xview" option} {
+ catch {destroy .l2}
+ listbox .l2
+ update
+ .l2 xview
+} {0 1}
+test listbox-3.115 {ListboxWidgetCmd procedure, "xview" option} {
+ catch {destroy .l}
+ listbox .l -width 10 -height 5 -font $fixed
+ .l insert 0 a b c d e f g h i j k l m n o p q r s t
+ pack .l
+ update
+ .l xview
+} {0 1}
+catch {destroy .l}
+listbox .l -width 10 -height 5 -font $fixed
+.l insert 0 a b c d e f g h i j k l m n o p q r s t
+.l insert 1 "0123456789a123456789b123456789c123456789d123456789"
+pack .l
+update
+test listbox-3.116 {ListboxWidgetCmd procedure, "xview" option} {fonts} {
+ .l xview 4
+ .l xview
+} {0.08 0.28}
+test listbox-3.117 {ListboxWidgetCmd procedure, "xview" option} {
+ list [catch {.l xview foo} msg] $msg
+} {1 {expected integer but got "foo"}}
+test listbox-3.118 {ListboxWidgetCmd procedure, "xview" option} {
+ list [catch {.l xview zoom a b} msg] $msg
+} {1 {unknown option "zoom": must be moveto or scroll}}
+test listbox-3.119 {ListboxWidgetCmd procedure, "xview" option} {fonts} {
+ .l xview 0
+ .l xview moveto .4
+ update
+ .l xview
+} {0.4 0.6}
+test listbox-3.120 {ListboxWidgetCmd procedure, "xview" option} {fonts} {
+ .l xview 0
+ .l xview scroll 2 units
+ update
+ .l xview
+} {0.04 0.24}
+test listbox-3.121 {ListboxWidgetCmd procedure, "xview" option} {fonts} {
+ .l xview 30
+ .l xview scroll -1 pages
+ update
+ .l xview
+} {0.44 0.64}
+test listbox-3.122 {ListboxWidgetCmd procedure, "xview" option} {fonts} {
+ .l configure -width 1
+ update
+ .l xview 30
+ .l xview scroll -4 pages
+ update
+ .l xview
+} {0.52 0.54}
+test listbox-3.123 {ListboxWidgetCmd procedure, "yview" option} {
+ catch {destroy .l}
+ listbox .l
+ pack .l
+ update
+ .l yview
+} {0 1}
+test listbox-3.124 {ListboxWidgetCmd procedure, "yview" option} {
+ catch {destroy .l}
+ listbox .l
+ .l insert 0 el1
+ pack .l
+ update
+ .l yview
+} {0 1}
+catch {destroy .l}
+listbox .l -width 10 -height 5 -font $fixed
+.l insert 0 a b c d e f g h i j k l m n o p q r s t
+pack .l
+update
+test listbox-3.125 {ListboxWidgetCmd procedure, "yview" option} {
+ .l yview 4
+ update
+ .l yview
+} {0.2 0.45}
+test listbox-3.126 {ListboxWidgetCmd procedure, "yview" option, partial last line} {
+ mkPartial
+ .partial.l yview
+} {0 0.266667}
+test listbox-3.127 {ListboxWidgetCmd procedure, "xview" option} {
+ list [catch {.l yview foo} msg] $msg
+} {1 {bad listbox index "foo": must be active, anchor, end, @x,y, or a number}}
+test listbox-3.128 {ListboxWidgetCmd procedure, "xview" option} {
+ list [catch {.l yview foo a b} msg] $msg
+} {1 {unknown option "foo": must be moveto or scroll}}
+test listbox-3.129 {ListboxWidgetCmd procedure, "xview" option} {
+ .l yview 0
+ .l yview moveto .31
+ .l yview
+} {0.3 0.55}
+test listbox-3.130 {ListboxWidgetCmd procedure, "xview" option} {
+ .l yview 2
+ .l yview scroll 2 pages
+ .l yview
+} {0.4 0.65}
+test listbox-3.131 {ListboxWidgetCmd procedure, "xview" option} {
+ .l yview 10
+ .l yview scroll -3 units
+ .l yview
+} {0.35 0.6}
+test listbox-3.132 {ListboxWidgetCmd procedure, "xview" option} {
+ .l configure -height 2
+ update
+ .l yview 15
+ .l yview scroll -4 pages
+ .l yview
+} {0.55 0.65}
+test listbox-3.133 {ListboxWidgetCmd procedure, "xview" option} {
+ list [catch {.l whoknows} msg] $msg
+} {1 {bad option "whoknows": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
+test listbox-3.134 {ListboxWidgetCmd procedure, "xview" option} {
+ list [catch {.l c} msg] $msg
+} {1 {bad option "c": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
+test listbox-3.135 {ListboxWidgetCmd procedure, "xview" option} {
+ list [catch {.l in} msg] $msg
+} {1 {bad option "in": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
+test listbox-3.136 {ListboxWidgetCmd procedure, "xview" option} {
+ list [catch {.l s} msg] $msg
+} {1 {bad option "s": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
+test listbox-3.137 {ListboxWidgetCmd procedure, "xview" option} {
+ list [catch {.l se} msg] $msg
+} {1 {bad option "se": must be activate, bbox, cget, configure, curselection, delete, get, index, insert, nearest, scan, see, selection, size, xview, or yview}}
+
+# No tests for DestroyListbox: I can't come up with anything to test
+# in this procedure.
+
+test listbox-4.1 {ConfigureListbox procedure} {fonts} {
+ catch {destroy .l}
+ listbox .l -setgrid 1 -width 25 -height 15
+ pack .l
+ update
+ set x [getsize .]
+ .l configure -setgrid 0
+ update
+ list $x [getsize .]
+} {25x15 185x263}
+resetGridInfo
+test listbox-4.2 {ConfigureListbox procedure} {
+ .l configure -highlightthickness -3
+ .l cget -highlightthickness
+} {0}
+test listbox-4.3 {ConfigureListbox procedure} {
+ .l configure -exportselection 0
+ .l delete 0 end
+ .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8
+ .l selection set 3 5
+ .l configure -exportselection 1
+ selection get
+} {el3
+el4
+el5}
+test listbox-4.4 {ConfigureListbox procedure} {
+ catch {destroy .e}
+ entry .e
+ .e insert 0 abc
+ .e select from 0
+ .e select to 2
+ .l configure -exportselection 0
+ .l delete 0 end
+ .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8
+ .l selection set 3 5
+ .l selection clear 3 5
+ .l configure -exportselection 1
+ list [selection own] [selection get]
+} {.e ab}
+test listbox-4.5 {-exportselection option} {
+ selection clear .
+ .l configure -exportselection 1
+ .l delete 0 end
+ .l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8
+ .l selection set 1 1
+ set x {}
+ lappend x [catch {selection get} msg] $msg [.l curselection]
+ .l config -exportselection 0
+ lappend x [catch {selection get} msg] $msg [.l curselection]
+ .l selection clear 0 end
+ lappend x [catch {selection get} msg] $msg [.l curselection]
+ .l selection set 1 3
+ lappend x [catch {selection get} msg] $msg [.l curselection]
+ .l config -exportselection 1
+ lappend x [catch {selection get} msg] $msg [.l curselection]
+} {0 el1 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} 1 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined} {1 2 3} 0 {el1
+el2
+el3} {1 2 3}}
+test listbox-4.6 {ConfigureListbox procedure} {fonts} {
+ catch {destroy .l}
+
+ # The following code (reset geometry, withdraw, etc.) is necessary
+ # to reset the state of some window managers like olvwm under
+ # SunOS 4.1.3.
+
+ wm geom . 300x300
+ update
+ wm geom . {}
+ wm withdraw .
+ listbox .l -font $fixed -width 15 -height 20
+ pack .l
+ update
+ wm deiconify .
+ set x [getsize .]
+ .l configure -setgrid 1
+ update
+ list $x [getsize .]
+} {115x328 15x20}
+test listbox-4.7 {ConfigureListbox procedure} {
+ catch {destroy .l}
+ wm withdraw .
+ listbox .l -font $fixed -width 30 -height 20 -setgrid 1
+ wm geom . +0+0
+ pack .l
+ update
+ wm deiconify .
+ set result [getsize .]
+ wm geom . 26x15
+ update
+ lappend result [getsize .]
+ .l configure -setgrid 1
+ update
+ lappend result [getsize .]
+} {30x20 26x15 26x15}
+wm geom . {}
+catch {destroy .l}
+resetGridInfo
+test listbox-4.8 {ConfigureListbox procedure} {
+ catch {destroy .l}
+ listbox .l -width 15 -height 20 -xscrollcommand "record x" \
+ -yscrollcommand "record y"
+ pack .l
+ update
+ .l configure -fg black
+ set log {}
+ update
+ set log
+} {{y 0 1} {x 0 1}}
+
+# No tests for DisplayListbox: I don't know how to test this procedure.
+
+test listbox-5.1 {ListboxComputeGeometry procedure} {fonts} {
+ catch {destroy .l}
+ listbox .l -font $fixed -width 15 -height 20
+ pack .l
+ list [winfo reqwidth .l] [winfo reqheight .l]
+} {115 328}
+test listbox-5.2 {ListboxComputeGeometry procedure} {fonts} {
+ catch {destroy .l}
+ listbox .l -font $fixed -width 0 -height 10
+ pack .l
+ update
+ list [winfo reqwidth .l] [winfo reqheight .l]
+} {17 168}
+test listbox-5.3 {ListboxComputeGeometry procedure} {fonts} {
+ catch {destroy .l}
+ listbox .l -font $fixed -width 0 -height 10 -bd 3
+ .l insert 0 Short "Really much longer" Longer
+ pack .l
+ update
+ list [winfo reqwidth .l] [winfo reqheight .l]
+} {138 170}
+test listbox-5.4 {ListboxComputeGeometry procedure} {fonts} {
+ catch {destroy .l}
+ listbox .l -font $fixed -width 10 -height 0
+ pack .l
+ update
+ list [winfo reqwidth .l] [winfo reqheight .l]
+} {80 24}
+test listbox-5.5 {ListboxComputeGeometry procedure} {fonts} {
+ catch {destroy .l}
+ listbox .l -font $fixed -width 10 -height 0 -highlightthickness 0
+ .l insert 0 Short "Really much longer" Longer
+ pack .l
+ update
+ list [winfo reqwidth .l] [winfo reqheight .l]
+} {76 52}
+test listbox-5.6 {ListboxComputeGeometry procedure} {
+ # If "0" in selected font had 0 width, caused divide-by-zero error.
+
+ catch {destroy .l}
+ pack [listbox .l -font {{open look glyph}}]
+ update
+} {}
+
+
+catch {destroy .l}
+listbox .l -height 2 -xscrollcommand "record x" -yscrollcommand "record y"
+pack .l
+update
+test listbox-6.1 {InsertEls procedure} {
+ .l delete 0 end
+ .l insert end a b c d
+ .l insert 5 x y z
+ .l insert 2 A
+ .l insert 0 q r s
+ .l get 0 end
+} {q r s a b A c d x y z}
+test listbox-6.2 {InsertEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l selection anchor 2
+ .l insert 2 A B
+ .l index anchor
+} {4}
+test listbox-6.3 {InsertEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l selection anchor 2
+ .l insert 3 A B
+ .l index anchor
+} {2}
+test listbox-6.4 {InsertEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l yview 3
+ update
+ .l insert 2 A B
+ .l index @0,0
+} {5}
+test listbox-6.5 {InsertEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l yview 3
+ update
+ .l insert 3 A B
+ .l index @0,0
+} {3}
+test listbox-6.6 {InsertEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l activate 5
+ .l insert 5 A B
+ .l index active
+} {7}
+test listbox-6.7 {InsertEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l activate 5
+ .l insert 6 A B
+ .l index active
+} {5}
+test listbox-6.8 {InsertEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c
+ .l index active
+} {2}
+test listbox-6.9 {InsertEls procedure} {
+ .l delete 0 end
+ .l insert 0
+ .l index active
+} {0}
+test listbox-6.10 {InsertEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b "two words" c d e f g h i j
+ update
+ set log {}
+ .l insert 0 word
+ update
+ set log
+} {{y 0 0.166667}}
+test listbox-6.11 {InsertEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b "two words" c d e f g h i j
+ update
+ set log {}
+ .l insert 0 "much longer entry"
+ update
+ set log
+} {{y 0 0.166667} {x 0 1}}
+test listbox-6.12 {InsertEls procedure} {fonts} {
+ catch {destroy .l2}
+ listbox .l2 -width 0 -height 0
+ pack .l2 -side top
+ .l2 insert 0 a b "two words" c d
+ set x {}
+ lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
+ .l2 insert 0 "much longer entry"
+ lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
+} {80 93 122 110}
+
+test listbox-7.1 {DeleteEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l selection set 1 6
+ .l delete 4 3
+ list [.l size] [selection get]
+} {10 {b
+c
+d
+e
+f
+g}}
+test listbox-7.2 {DeleteEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l selection set 3 6
+ .l delete 4 4
+ list [.l size] [.l get 4] [.l curselection]
+} {9 f {3 4 5}}
+test listbox-7.3 {DeleteEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l delete 0 3
+ list [.l size] [.l get 0] [.l get 1]
+} {6 e f}
+test listbox-7.4 {DeleteEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l delete 8 1000
+ list [.l size] [.l get 7]
+} {8 h}
+test listbox-7.5 {DeleteEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l selection anchor 2
+ .l delete 0 1
+ .l index anchor
+} {0}
+test listbox-7.6 {DeleteEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l selection anchor 2
+ .l delete 2
+ .l index anchor
+} {2}
+test listbox-7.7 {DeleteEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l selection anchor 4
+ .l delete 2 5
+ .l index anchor
+} {2}
+test listbox-7.8 {DeleteEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l selection anchor 3
+ .l delete 4 5
+ .l index anchor
+} {3}
+test listbox-7.9 {DeleteEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l yview 3
+ update
+ .l delete 1 2
+ .l index @0,0
+} {1}
+test listbox-7.10 {DeleteEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l yview 3
+ update
+ .l delete 3 4
+ .l index @0,0
+} {3}
+test listbox-7.11 {DeleteEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l yview 3
+ update
+ .l delete 4 6
+ .l index @0,0
+} {3}
+test listbox-7.12 {DeleteEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l yview 3
+ update
+ .l delete 3 end
+ .l index @0,0
+} {1}
+test listbox-7.13 {DeleteEls procedure, updating view with partial last line} {
+ mkPartial
+ .partial.l yview 8
+ update
+ .partial.l delete 10 13
+ .partial.l index @0,0
+} {7}
+test listbox-7.14 {DeleteEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l activate 6
+ .l delete 3 4
+ .l index active
+} {4}
+test listbox-7.15 {DeleteEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l activate 6
+ .l delete 5 7
+ .l index active
+} {5}
+test listbox-7.16 {DeleteEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l activate 6
+ .l delete 5 end
+ .l index active
+} {4}
+test listbox-7.17 {DeleteEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j
+ .l activate 6
+ .l delete 0 end
+ .l index active
+} {0}
+test listbox-7.18 {DeleteEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c "two words" d e f g h i j
+ update
+ set log {}
+ .l delete 4 6
+ update
+ set log
+} {{y 0 0.25}}
+test listbox-7.19 {DeleteEls procedure} {
+ .l delete 0 end
+ .l insert 0 a b c "two words" d e f g h i j
+ update
+ set log {}
+ .l delete 3
+ update
+ set log
+} {{y 0 0.2} {x 0 1}}
+test listbox-7.20 {DeleteEls procedure} {fonts} {
+ catch {destroy .l2}
+ listbox .l2 -width 0 -height 0
+ pack .l2 -side top
+ .l2 insert 0 a b "two words" c d e f g
+ set x {}
+ lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
+ .l2 delete 2 4
+ lappend x [winfo reqwidth .l2] [winfo reqheight .l2]
+} {80 144 17 93}
+catch {destroy .l2}
+
+test listbox-8.1 {ListboxEventProc procedure} {fonts} {
+ catch {destroy .l}
+ listbox .l -setgrid 1
+ pack .l
+ update
+ set x [getsize .]
+ destroy .l
+ list $x [getsize .] [winfo exists .l] [info command .l]
+} {20x10 150x178 0 {}}
+resetGridInfo
+test listbox-8.2 {ListboxEventProc procedure} {fonts} {
+ catch {destroy .l}
+ listbox .l -height 5 -width 10
+ .l insert 0 a b c "A string that is very very long" d e f g h i j k
+ pack .l
+ update
+ place .l -width 50 -height 80
+ update
+ list [.l xview] [.l yview]
+} {{0 0.222222} {0 0.333333}}
+test listbox-8.3 {ListboxEventProc procedure} {
+ eval destroy [winfo children .]
+ listbox .l1 -bg #543210
+ rename .l1 .l2
+ set x {}
+ lappend x [winfo children .]
+ lappend x [.l2 cget -bg]
+ destroy .l1
+ lappend x [info command .l*] [winfo children .]
+} {.l1 #543210 {} {}}
+
+test listbox-9.1 {ListboxCmdDeletedProc procedure} {
+ eval destroy [winfo children .]
+ listbox .l1
+ rename .l1 {}
+ list [info command .l*] [winfo children .]
+} {{} {}}
+test listbox-9.2 {ListboxCmdDeletedProc procedure, disabling -setgrid} fonts {
+ catch {destroy .top}
+ toplevel .top
+ wm geom .top +0+0
+ listbox .top.l -setgrid 1 -width 20 -height 10
+ pack .top.l
+ update
+ set x [wm geometry .top]
+ rename .top.l {}
+ update
+ lappend x [wm geometry .top]
+ destroy .top
+ set x
+} {20x10+0+0 150x178+0+0}
+
+catch {destroy .l}
+listbox .l
+pack .l
+.l delete 0 end
+.l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
+test listbox-10.1 {GetListboxIndex procedure} {
+ .l activate 3
+ list [.l activate 3; .l index active] [.l activate 6; .l index active]
+} {3 6}
+test listbox-10.2 {GetListboxIndex procedure} {
+ .l selection anchor 2
+ .l index anchor
+} 2
+test listbox-10.3 {GetListboxIndex procedure} {
+ .l insert end A B C D E
+ .l selection anchor end
+ .l delete 12 end
+ list [.l index anchor] [.l index end]
+} {12 12}
+test listbox-10.4 {GetListboxIndex procedure} {
+ list [catch {.l index a} msg] $msg
+} {1 {bad listbox index "a": must be active, anchor, end, @x,y, or a number}}
+test listbox-10.5 {GetListboxIndex procedure} {
+ .l index end
+} {12}
+test listbox-10.6 {GetListboxIndex procedure} {
+ .l get end
+} {el11}
+test listbox-10.7 {GetListboxIndex procedure} {
+ .l delete 0 end
+ .l index end
+} 0
+.l delete 0 end
+.l insert 0 el0 el1 el2 el3 el4 el5 el6 el7 el8 el9 el10 el11
+update
+test listbox-10.8 {GetListboxIndex procedure} {
+ list [catch {.l index @} msg] $msg
+} {1 {bad listbox index "@": must be active, anchor, end, @x,y, or a number}}
+test listbox-10.9 {GetListboxIndex procedure} {
+ list [catch {.l index @foo} msg] $msg
+} {1 {bad listbox index "@foo": must be active, anchor, end, @x,y, or a number}}
+test listbox-10.10 {GetListboxIndex procedure} {
+ list [catch {.l index @1x3} msg] $msg
+} {1 {bad listbox index "@1x3": must be active, anchor, end, @x,y, or a number}}
+test listbox-10.11 {GetListboxIndex procedure} {
+ list [catch {.l index @1,} msg] $msg
+} {1 {bad listbox index "@1,": must be active, anchor, end, @x,y, or a number}}
+test listbox-10.12 {GetListboxIndex procedure} {
+ list [catch {.l index @1,foo} msg] $msg
+} {1 {bad listbox index "@1,foo": must be active, anchor, end, @x,y, or a number}}
+test listbox-10.13 {GetListboxIndex procedure} {
+ list [catch {.l index @1,2x} msg] $msg
+} {1 {bad listbox index "@1,2x": must be active, anchor, end, @x,y, or a number}}
+test listbox-10.14 {GetListboxIndex procedure} {fonts} {
+ list [.l index @5,57] [.l index @5,58]
+} {3 3}
+test listbox-10.15 {GetListboxIndex procedure} {
+ list [catch {.l index 1xy} msg] $msg
+} {1 {bad listbox index "1xy": must be active, anchor, end, @x,y, or a number}}
+test listbox-10.16 {GetListboxIndex procedure} {
+ .l index 3
+} {3}
+test listbox-10.17 {GetListboxIndex procedure} {
+ .l index 20
+} {20}
+test listbox-10.18 {GetListboxIndex procedure} {
+ .l get 20
+} {}
+test listbox-10.19 {GetListboxIndex procedure} {
+ .l index -2
+} -2
+test listbox-10.20 {GetListboxIndex procedure} {
+ .l delete 0 end
+ .l index 1
+} 1
+
+test listbox-11.1 {ChangeListboxView procedure, boundary conditions for index} {
+ catch {destroy .l}
+ listbox .l -height 5
+ pack .l
+ .l insert 0 a b c d e f g h i j
+ .l yview 3
+ update
+ set x [.l index @0,0]
+ .l yview -1
+ update
+ lappend x [.l index @0,0]
+} {3 0}
+test listbox-11.2 {ChangeListboxView procedure, boundary conditions for index} {
+ catch {destroy .l}
+ listbox .l -height 5
+ pack .l
+ .l insert 0 a b c d e f g h i j
+ .l yview 3
+ update
+ set x [.l index @0,0]
+ .l yview 20
+ update
+ lappend x [.l index @0,0]
+} {3 5}
+test listbox-11.3 {ChangeListboxView procedure} {
+ catch {destroy .l}
+ listbox .l -height 5 -yscrollcommand "record y"
+ pack .l
+ .l insert 0 a b c d e f g h i j
+ update
+ set log {}
+ .l yview 2
+ update
+ list [.l yview] $log
+} {{0.2 0.7} {{y 0.2 0.7}}}
+test listbox-11.4 {ChangeListboxView procedure} {
+ catch {destroy .l}
+ listbox .l -height 5 -yscrollcommand "record y"
+ pack .l
+ .l insert 0 a b c d e f g h i j
+ update
+ set log {}
+ .l yview 8
+ update
+ list [.l yview] $log
+} {{0.5 1} {{y 0.5 1}}}
+test listbox-11.5 {ChangeListboxView procedure} {
+ catch {destroy .l}
+ listbox .l -height 5 -yscrollcommand "record y"
+ pack .l
+ .l insert 0 a b c d e f g h i j
+ .l yview 3
+ update
+ set log {}
+ .l yview 3
+ update
+ list [.l yview] $log
+} {{0.3 0.8} {}}
+test listbox-11.6 {ChangeListboxView procedure, partial last line} {
+ mkPartial
+ .partial.l yview 13
+ .partial.l index @0,0
+} {11}
+
+catch {destroy .l}
+listbox .l -font $fixed -xscrollcommand "record x" -width 10
+.l insert 0 0123456789a123456789b123456789c123456789d123456789e123456789f123456789g123456789h123456789i123456789
+pack .l
+update
+test listbox-12.1 {ChangeListboxOffset procedure} {fonts} {
+ set log {}
+ .l xview 99
+ update
+ list [.l xview] $log
+} {{0.9 1} {{x 0.9 1}}}
+test listbox-12.2 {ChangeListboxOffset procedure} {fonts} {
+ set log {}
+ .l xview moveto -.25
+ update
+ list [.l xview] $log
+} {{0 0.1} {{x 0 0.1}}}
+test listbox-12.3 {ChangeListboxOffset procedure} {fonts} {
+ .l xview 10
+ update
+ set log {}
+ .l xview 10
+ update
+ list [.l xview] $log
+} {{0.1 0.2} {}}
+
+catch {destroy .l}
+listbox .l -font $fixed -width 10 -height 5
+pack .l
+.l insert 0 a bb c d e f g h i j k l m n o p q r s
+.l insert 0 0123456789a123456789b123456789c123456789d123456789
+update
+set width [expr [lindex [.l bbox 2] 2] - [lindex [.l bbox 1] 2]]
+set height [expr [lindex [.l bbox 2] 1] - [lindex [.l bbox 1] 1]]
+test listbox-13.1 {ListboxScanTo procedure} {fonts} {
+ .l yview 0
+ .l xview 0
+ .l scan mark 10 20
+ .l scan dragto [expr 10-$width] [expr 20-$height]
+ update
+ list [.l xview] [.l yview]
+} {{0.2 0.4} {0.5 0.75}}
+test listbox-13.2 {ListboxScanTo procedure} {fonts} {
+ .l yview 5
+ .l xview 10
+ .l scan mark 10 20
+ .l scan dragto 20 40
+ update
+ set x [list [.l xview] [.l yview]]
+ .l scan dragto [expr 20-$width] [expr 40-$height]
+ update
+ lappend x [.l xview] [.l yview]
+} {{0 0.2} {0 0.25} {0.2 0.4} {0.5 0.75}}
+test listbox-13.3 {ListboxScanTo procedure} {fonts} {
+ .l yview moveto 1.0
+ .l xview moveto 1.0
+ .l scan mark 10 20
+ .l scan dragto 5 10
+ update
+ set x [list [.l xview] [.l yview]]
+ .l scan dragto [expr 5+$width] [expr 10+$height]
+ update
+ lappend x [.l xview] [.l yview]
+} {{0.8 1} {0.75 1} {0.62 0.82} {0.25 0.5}}
+
+test listbox-14.1 {NearestListboxElement procedure, partial last line} {
+ mkPartial
+ .partial.l nearest [winfo height .partial.l]
+} {4}
+catch {destroy .l}
+listbox .l -font $fixed -width 20 -height 10
+.l insert 0 a b c d e f g h i j k l m n o p q r s t
+.l yview 4
+pack .l
+update
+test listbox-14.2 {NearestListboxElement procedure} {fonts} {
+ .l index @50,0
+} {4}
+test listbox-14.3 {NearestListboxElement procedure} {fonts} {
+ list [.l index @50,35] [.l index @50,36]
+} {5 6}
+test listbox-14.4 {NearestListboxElement procedure} {fonts} {
+ .l index @50,200
+} {13}
+
+test listbox-15.1 {ListboxSelect procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j k l m n o p
+ .l select set 2 4
+ .l select set 7 12
+ .l select clear 4 7
+ .l curselection
+} {2 3 8 9 10 11 12}
+test listbox-15.2 {ListboxSelect procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e f g h i j k l m n o p
+ catch {destroy .e}
+ entry .e
+ .e insert 0 "This is some text"
+ .e select from 0
+ .e select to 7
+ .l selection clear 2 4
+ set x [selection own]
+ .l selection set 3
+ list $x [selection own] [selection get]
+} {.e .l d}
+test listbox-15.3 {ListboxSelect procedure} {
+ .l delete 0 end
+ .l selection clear 0 end
+ .l select set 0 end
+ .l curselection
+} {}
+test listbox-15.4 {ListboxSelect procedure, boundary conditions for indices} {
+ .l delete 0 end
+ .l insert 0 a b c d e f
+ .l select clear 0 end
+ .l select set -2 -1
+ .l curselection
+} {}
+test listbox-15.5 {ListboxSelect procedure, boundary conditions for indices} {
+ .l delete 0 end
+ .l insert 0 a b c d e f
+ .l select clear 0 end
+ .l select set -1 3
+ .l curselection
+} {0 1 2 3}
+test listbox-15.6 {ListboxSelect procedure, boundary conditions for indices} {
+ .l delete 0 end
+ .l insert 0 a b c d e f
+ .l select clear 0 end
+ .l select set 2 4
+ .l curselection
+} {2 3 4}
+test listbox-15.7 {ListboxSelect procedure, boundary conditions for indices} {
+ .l delete 0 end
+ .l insert 0 a b c d e f
+ .l select clear 0 end
+ .l select set 4 end
+ .l curselection
+} {4 5}
+test listbox-15.8 {ListboxSelect procedure, boundary conditions for indices} {
+ .l delete 0 end
+ .l insert 0 a b c d e f
+ .l select clear 0 end
+ .l select set 4 30
+ .l curselection
+} {4 5}
+test listbox-15.9 {ListboxSelect procedure, boundary conditions for indices} {
+ .l delete 0 end
+ .l insert 0 a b c d e f
+ .l select clear 0 end
+ .l select set end 30
+ .l curselection
+} {5}
+test listbox-15.10 {ListboxSelect procedure, boundary conditions for indices} {
+ .l delete 0 end
+ .l insert 0 a b c d e f
+ .l select clear 0 end
+ .l select set 20 25
+ .l curselection
+} {}
+
+test listbox-16.1 {ListboxFetchSelection procedure} {
+ .l delete 0 end
+ .l insert 0 a b c "two words" e f g h i \\ k l m n o p
+ .l selection set 2 4
+ .l selection set 9
+ .l selection set 11 12
+ selection get
+} "c\ntwo words\ne\n\\\nl\nm"
+test listbox-16.2 {ListboxFetchSelection procedure} {
+ .l delete 0 end
+ .l insert 0 a b c "two words" e f g h i \\ k l m n o p
+ .l selection set 3
+ selection get
+} "two words"
+test listbox-16.3 {ListboxFetchSelection procedure, retrieve in several parts} {
+ set long "This is quite a long string\n"
+ append long $long $long $long $long
+ append long $long $long $long $long
+ append long $long $long
+ .l delete 0 end
+ .l insert 0 1$long 2$long 3$long 4$long 5$long
+ .l selection set 0 end
+ set sel [selection get]
+ string compare 1$long\n2$long\n3$long\n4$long\n5$long $sel
+} {0}
+catch {unset long sel}
+
+test listbox-17.1 {ListboxLostSelection procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e
+ .l select set 0 end
+ catch {destroy .e}
+ entry .e
+ .e insert 0 "This is some text"
+ .e select from 0
+ .e select to 5
+ .l curselection
+} {}
+test listbox-17.2 {ListboxLostSelection procedure} {
+ .l delete 0 end
+ .l insert 0 a b c d e
+ .l select set 0 end
+ .l configure -exportselection 0
+ catch {destroy .e}
+ entry .e
+ .e insert 0 "This is some text"
+ .e select from 0
+ .e select to 5
+ .l curselection
+} {0 1 2 3 4}
+
+catch {destroy .l}
+listbox .l -font $fixed -width 10 -height 5
+pack .l
+update
+test listbox-18.1 {ListboxUpdateVScrollbar procedure} {
+ .l configure -yscrollcommand "record y"
+ set log {}
+ .l insert 0 a b c
+ update
+ .l insert end d e f g h
+ update
+ .l delete 0 end
+ update
+ set log
+} {{y 0 1} {y 0 0.625} {y 0 1}}
+test listbox-18.2 {ListboxUpdateVScrollbar procedure, partial last line} {
+ mkPartial
+ .partial.l configure -yscrollcommand "record y"
+ set log {}
+ .partial.l yview 3
+ update
+ set log
+} {{y 0.2 0.466667}}
+test listbox-18.3 {ListboxUpdateVScrollbar procedure} {
+ proc bgerror args {
+ global x errorInfo
+ set x [list $args $errorInfo]
+ }
+ .l configure -yscrollcommand gorp
+ .l insert 0 foo
+ update
+ set x
+} {{{invalid command name "gorp"}} {invalid command name "gorp"
+ while executing
+"gorp 0 1"
+ (vertical scrolling command executed by listbox)}}
+if {[info exists bgerror]} {
+ rename bgerror {}
+}
+
+catch {destroy .l}
+listbox .l -font $fixed -width 10 -height 5
+pack .l
+update
+test listbox-19.1 {ListboxUpdateVScrollbar procedure} {fonts} {
+ .l configure -xscrollcommand "record x"
+ set log {}
+ .l insert 0 abc
+ update
+ .l insert 0 "This is a much longer string..."
+ update
+ .l delete 0 end
+ update
+ set log
+} {{x 0 1} {x 0 0.322581} {x 0 1}}
+test listbox-19.2 {ListboxUpdateVScrollbar procedure} {
+ proc bgerror args {
+ global x errorInfo
+ set x [list $args $errorInfo]
+ }
+ .l configure -xscrollcommand bogus
+ .l insert 0 foo
+ update
+ set x
+} {{{invalid command name "bogus"}} {invalid command name "bogus"
+ while executing
+"bogus 0 1"
+ (horizontal scrolling command executed by listbox)}}
+
+set l [interp hidden]
+eval destroy [winfo children .]
+
+test listbox-20.1 {listbox vs hidden commands} {
+ catch {destroy .l}
+ listbox .l
+ interp hide {} .l
+ destroy .l
+ list [winfo children .] [interp hidden]
+} [list {} $l]
+
+resetGridInfo
+catch {destroy .l2}
+catch {destroy .t}
+catch {destroy .e}
+catch {destroy .partial}
+option clear
+
diff --git a/tk/tests/macEmbed.test b/tk/tests/macEmbed.test
new file mode 100644
index 00000000000..6765c37d375
--- /dev/null
+++ b/tk/tests/macEmbed.test
@@ -0,0 +1,297 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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.}}
+
+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."
+ return
+}
+
+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
+ interp create child
+ child eval "set argv {-use [winfo id .f1]}"
+ load {} tk child
+ child eval {
+ . configure -bd 2 -highlightthickness 2 -relief sunken
+ }
+ focus -force .f2
+ update
+ list [child eval {
+ focus .
+ 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}
+}
diff --git a/tk/tests/macFont.test b/tk/tests/macFont.test
new file mode 100644
index 00000000000..e0636aa4023
--- /dev/null
+++ b/tk/tests/macFont.test
@@ -0,0 +1,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.
+#
+# RCS: @(#) $Id$
+
+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
diff --git a/tk/tests/macMenu.test b/tk/tests/macMenu.test
new file mode 100644
index 00000000000..0cd39899dca
--- /dev/null
+++ b/tk/tests/macMenu.test
@@ -0,0 +1,1565 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+wm geometry . {}
+raise .
+
+test macMenu-1.0 {TkMacUseMenuID} {} {
+ # Can't really test TkMacUseMenuID; it's only called on startup.
+} {}
+
+test macMenu-2.1 {GetNewID} {
+ catch {destroy .m1}
+ list [catch {menu .m1} msg] $msg [destroy .m1]
+} {0 .m1 {}}
+test macMenu-2.2 {GetNewID - cascade menu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m2
+ list [catch {menu .m2} msg] $msg [destroy .m1] [destroy .m2]
+} {0 .m2 {} {}}
+test macMenu-2.3 {GetNewID - running out of ids} {
+ deleteWindows
+ menu .menu
+ for {set i 0} {$i < 230} {incr i} {
+ menu .m$i
+ .menu add cascade -label ".m$i" -menu .m$i
+ }
+ menu .breaker
+ list [catch {.menu add cascade -menu .breaker} msg] $msg [deleteWindows]
+} {1 {No more menus can be allocated.} {}}
+
+test macMenu-3.1 {FreeID} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+
+# No way to test running out of ids in TkpNewPlatformMenu
+test macMenu-4.1 {TkpNewMenu} {
+ catch {destroy .m1}
+ list [catch {menu .m1} msg] $msg [catch {destroy .m1} msg2] $msg2
+} {0 .m1 0 {}}
+test macMenu-4.2 {TkpNewMenu - checking for help menu when one is there} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ menu .m1.help -tearoff 0
+ .m1.help add command -label Test
+ . configure -menu .m1
+ raise .
+ update
+ list [catch {menu .m2} msg] $msg [destroy .m1] [destroy .m2] [. configure -menu ""]
+} {0 .m2 {} {} {}}
+test macMenu-4.3 {TkpNewMenu - menubar set but different interp} {
+ catch {interp delete testinterp}
+ catch {destroy .m1}
+ interp create testinterp
+ load {} Tk testinterp
+ interp eval testinterp {raise .}
+ interp eval testinterp {menu .m1}
+ interp eval testinterp {. configure -menu .m1}
+ interp eval testinterp {update}
+ list [catch {menu .m1} msg] $msg [destroy .m1] [interp delete testinterp]
+} {0 .m1 {} {}}
+test macMenu-4.4 {TkpNewMenu - menubar set but new menu has different parent} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1 -tearoff 0
+ .m1 add cascade -menu .m1.help
+ menu .m2
+ .m2 add cascade -menu .m2.help
+ . configure -menu .m1
+ raise .
+ update
+ list [catch {menu .m2.help} msg] $msg [. configure -menu ""] [destroy .m1] [destroy .m2]
+} {0 .m2.help {} {} {}}
+test macMenu-4.5 {TkpNewMenu - menubar set, same parent, not .help} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -menu .m1.help
+ . configure -menu .m1
+ raise .
+ update
+ list [catch {menu .m1.foo} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 .m1.foo {} {}}
+test macMenu-4.6 {TkpNewMenu - creating the help menu} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -menu .m1.help
+ . configure -menu .m1
+ raise .
+ update
+ list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 .m1.help {} {}}
+
+test macMenu-5.1 {TkpDestroyMenu} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+test macMenu-5.2 {TkpDestroyMenu - help menu} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -menu .m1.help
+ . configure -menu .m1
+ menu .m1.help
+ raise .
+ update
+ list [catch {destroy .m1.help} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-5.3 {TkpDestroyMenu - idle handler pending} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label test
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+test macMenu-5.4 {TkpDestroyMenu - idle handler not pending} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label test
+ update idletasks
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+
+test macMenu-6.1 {SetMenuCascade} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ menu .m2
+ list [catch {.m2 add cascade -menu .m1} msg] $msg [destroy .m1 .m2]
+} {0 {} {}}
+test macMenu-6.2 {SetMenuCascade - running out of ids} {
+ deleteWindows
+ menu .menu
+ for {set i 0} {$i < 230} {incr i} {
+ menu .m$i
+ .menu add cascade -label ".m$i" -menu .m$i
+ }
+ menu .breaker
+ list [catch {.menu add cascade -menu .breaker} msg] $msg [deleteWindows]
+} {1 {No more menus can be allocated.} {}}
+
+test macMenu-7.1 {TkpDestroyMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {.m1 delete 1} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-7.2 {TkpDestroyMenuEntry - help menu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m1.help
+ menu .m1.help -tearoff 0
+ .m1.help add command -label "test"
+ . configure -menu .m1
+ raise .
+ update
+ list [catch {.m1.help delete test} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+
+test macMenu-8.1 {GetEntryText} {
+ catch {destroy .m1}
+ list [catch {menu .m1} msg] $msg [destroy .m1]
+} {0 .m1 {}}
+test macMenu-8.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 macMenu-8.3 {GetEntryText} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -bitmap questhead} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-8.4 {GetEntryText} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-8.5 {GetEntryText} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "foo"
+ list [catch {.m1 add command -label "foo"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-8.6 {GetEntryText} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "This is a very long string. 9012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890012345678900123456789001234567890"} \
+ msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-8.7 {GetEntryText - elipses character} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "foo..."} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-8.8 {GetEntryText - false elipses character} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "foo."} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-8.9 {GetEntryText - false elipses character} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "foo.."} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-8.10 {GetEntryText - false elipses character} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "foo.b"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-8.11 {GetEntryText - false elipses character} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label "foo..b"} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+
+# test macMenu-9.1 - assumes some fonts
+test macMenu-9.1 {FindMarkCharacter} {
+ catch {destroy .m1}
+ menu .m1 -font "Helvetica 12" -tearoff 0
+ .m1 add checkbutton -label test
+ .m1 invoke test
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+# All standard fonts have "¥" defined. We can't test further.
+
+test macMenu-10.1 {SetMenuIndicator - cascade entry} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add cascade -label foo} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-10.2 {SetMenuIndicator - not radio or checkbutton} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label foo} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-10.3 {SetMenuIndicator - indiatorOn false} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add checkbutton -label foo -indicatoron 0} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-10.4 {SetMenuIndicator - entry not selected} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add checkbutton -label foo} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-10.5 {SetMenuIndicator - checkbutton} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ list [catch {.m1 invoke foo} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-10.6 {SetMenuIndicator - radio button} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label foo
+ list [catch {.m1 invoke foo} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test macMenu-11.1 {SetMenuTitle} {
+ catch {destroy .m1}
+ catch {destroy .container}
+ menu .container
+ menu .m1
+#previous title is .m1
+ .container add cascade -label "File" -menu .m1
+ list [catch {. configure -menu .container} msg] $msg [. configure -menu ""] [destroy .container .m1]
+} {0 {} {} {}}
+test macMenu-11.2 {SetMenuTitle} {
+ menu .container
+ menu .m1
+ . configure -menu ""
+#previous title is .m1
+ .container add cascade -label "F" -menu .m1
+ list [catch {. configure -menu .container} msg] $msg [. configure -menu ""] [destroy .container .m1]
+} {0 {} {} {}}
+
+test macMenu-12.1 {TkpConfigureMenuEntry} {
+ catch {destroy .m1}
+ . configure -menu ""
+ menu .m1
+ .m1 add cascade -menu .m3
+ list [catch {.m1 entryconfigure 1 -menu .m2} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.2 {TkpConfigureMenuEntry} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ . configure -menu ""
+ menu .m1
+ .m1 add cascade -menu .m3
+ menu .m2
+ list [catch {.m1 entryconfigure 1 -menu .m2} msg] $msg [destroy .m1 .m2]
+} {0 {} {}}
+test macMenu-12.3 {TkpConfigureMenuEntry - running out of ids} {
+ deleteWindows
+ menu .menu
+ for {set i 0} {$i < 230} {incr i} {
+ menu .m$i
+ .menu add cascade -label ".m$i" -menu .m$i
+ }
+ menu .breaker
+ list [catch {.menu add cascade -menu .breaker} msg] $msg [deleteWindows]
+} {1 {No more menus can be allocated.} {}}
+test macMenu-12.4 {TkpConfigureMenuEntry - Control} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -accel "Control+S"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.5 {TkpConfigureMenuEntry - Ctrl} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -accel "Ctrl+S"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.6 {TkpConfigureMenuEntry - Shift} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -accel "Shift+S"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.7 {TkpConfigureMenuEntry - Option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -accel "Opt+S"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.8 {TkpConfigureMenuEntry - Command} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -accel "Command+S"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.9 {TkpConfigureMenuEntry - Cmd} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -accel "Cmd+S"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.10 {TkpConfigureMenuEntry - Alt} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -accel "Alt+S"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.11 {TkpConfigureMenuEntry - Meta} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -accel "Meta+S"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.12 {TkpConfigureMenuEntry - Two modifiers} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -accel "Cmd+Shift+S"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.13 {TkpConfigureMenuEntry - dash instead of plus} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -accel "Command-S"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.14 {TkpConfigureMenuEntry - idler pending} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label test
+ list [catch {.m1 entryconfigure test -label test2} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-12.15 {TkpConfigureMenuEntry - idler not pending} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label test
+ update idletasks
+ list [catch {.m1 entryconfigure test -label test2} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test macMenu-13.1 {ReconfigureIndividualMenu - getting rid of zero items} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label test
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-13.2 {ReconfigureIndividualMenu - getting rid of one item} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label test
+ update idletasks
+ .m1 delete test
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-13.3 {ReconfigureIndividualMenu - getting rid of more than one} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label test
+ .m1 add command -label test2
+ update idletasks
+ .m1 entryconfigure test2 -label "test two"
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-13.4 {ReconfigureIndividualMenu - separator} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-13.5 {ReconfigureIndividualMenu - disabled} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command
+ .m1 entryconfigure 1 -state disabled
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-13.6 {ReconfigureIndividualMenu - active} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command
+ .m1 entryconfigure 1 -state active
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-13.7 {ReconfigureIndividualMenu - checkbutton not checked} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label test
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-13.8 {ReconfigureIndividualMenu - checkbutton - indicator off} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label test -indicatoron 0
+ .m1 invoke test
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-13.9 {ReconfigureIndividualMenu - checkbutton on} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label test
+ .m1 invoke test
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-13.10 {ReconfigureIndividualMenu - radiobutton not checked} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label test
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-13.11 {ReconfigureIndividualMenu - radiobutton - indicator off} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label test -indicatoron 0
+ .m1 invoke test
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-13.12 {ReconfigureIndividualMenu - radiobutton on} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label test
+ .m1 invoke test
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-13.13 {ReconfigureIndividualMenu} {
+ catch {destroy .m1}
+ . configure -menu ""
+ menu .m1
+ .m1 add cascade -menu .m3
+ .m1 entryconfigure 1 -menu .m2
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-13.14 {ReconfigureIndividualMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ . configure -menu ""
+ menu .m1
+ .m1 add cascade -menu .m3
+ menu .m2
+ .m1 entryconfigure 1 -menu .m2
+ list [catch {update idletasks} msg] $msg [destroy .m1 .m2]
+} {0 {} {}}
+test macMenu-13.15 {ReconfigureIndividualMenu - accelerator} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -accel "Command-S"
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-13.16 {ReconfigureIndividualMenu - parent is disabled} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label .m1.edit -label "Edit" -state disabled
+ menu .m1.edit
+ .m1.edit add command -label foo
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-13.17 {ReconfigureIndividualMenu - disabling parent} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label .m1.edit -label Edit
+ menu .m1.edit
+ .m1.edit add command -label foo
+ .m1 entryconfigure Edit -state disabled
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test macMenu-14.1 {ReconfigureMacintoshMenu - normal menu} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label test
+ list [catch {update idletasks} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-14.2 {ReconfigureMacintoshMenu - apple menu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m1.apple
+ menu .m1.apple -tearoff 0
+ .m1.apple add command -label test
+ . configure -menu .m1
+ raise .
+ list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-14.3 {ReconfigureMacintoshMenu - help menu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m1.help
+ menu .m1.help -tearoff 0
+ .m1.help add command -label test
+ . configure -menu .m1
+ raise .
+ list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-14.4 {ReconfigureMacintoshMenu - menubar} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m1.file -label "foo"
+ menu .m1.file
+ . configure -menu .m1
+ raise .
+ .m1 entryconfigure foo -label "File"
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+
+test macMenu-15.1 {CompleteIdlers - no idle pending} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label test
+ update idletasks
+ list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-15.2 {CompleteIdlers - idle pending} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label test
+ list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-15.3 {CompleteIdlers - recursive} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m1.m2 -label test
+ menu .m1.m2
+ .m1.m2 add command -label test
+ list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+#Don't know how to generate nested post menus
+test macMenu-16.1 {TkpPostMenu} {
+ catch {destroy .m1}
+ menu .m1 -postcommand "destroy .m1"
+ list [catch {.m1 post 40 40} msg] $msg
+} {0 {}}
+test macMenu-16.2 {TkpPostMenu} {
+ catch {destroy .m1}
+ menu .m1 -postcommand "blork"
+ list [catch {.m1 post 40 40} msg] $msg [destroy .m1]
+} {1 {invalid command name "blork"} {}}
+# We need to write the interactive test for menu posting.
+
+test macMenu-17.1 {TkpMenuNewEntry - no idle pending} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add command -label test} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-17.2 {TkpMenuNewEntry - idle pending} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label test
+ list [catch {.m1 add command -label test2} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test macMenu-18.1 {DrawMenuBarWhenIdle} {
+ catch {destroy .m1}
+ . configure -menu ""
+ menu .m1
+ . configure -menu .m1
+ list [catch {update idletasks} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-18.2 {DrawMenuBarWhenIdle - clearing old apple menu out} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m1.apple
+ menu .m1.apple
+ .m1.apple add command -label test
+ . configure -menu .m1
+ raise .
+ update
+ . configure -menu ""
+ raise .
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-18.3 {DrawMenuBarWhenIdle - clearing out old help menu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m1.help
+ menu .m1.help
+ .m1.help add command -label test
+ . configure -menu .m1
+ raise .
+ update
+ . configure -menu ""
+ raise .
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-18.4 {DrawMenuBarWhenIdle - menu not there} {
+ catch {destroy .m1}
+ . configure -menu .m1
+ raise .
+ list [catch {update} msg] $msg [. configure -menu ""]
+} {0 {} {}}
+test macMenu-18.5 {DrawMenuBarWhenIdle - menu there} {
+ catch {destroy .m1}
+ menu .m1
+ . configure -menu .m1
+ raise .
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-18.6 {DrawMenuBarWhenIdle - no apple menu} {
+ catch {destroy .m1}
+ menu .m1
+ . configure -menu .m1
+ raise .
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-18.7 {DrawMenuBarWhenIdle - apple menu references but not there} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m1.apple
+ . configure -menu .m1
+ raise .
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-18.8 {DrawMenuBarWhenIdle - apple menu there} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m1.apple
+ menu .m1.apple
+ .m1.apple add command -label test
+ . configure -menu .m1
+ raise .
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-18.9 {DrawMenuBarWhenIdle - apple menu there; no idle handler} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m1.apple
+ menu .m1.apple
+ .m1.apple add command -label test
+ . configure -menu .m1
+ raise .
+ update idletasks
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-18.10 {DrawMenuBarWhenIdle - no help menu} {
+ catch {destroy .m1}
+ menu .m1
+ . configure -menu .m1
+ raise .
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-18.11 {DrawMenuBarWhenIdle - help menu referenced but not there} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m1.help
+ . configure -menu .m1
+ raise .
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-18.12 {DrawMenuBarWhenIdle - help menu there} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m1.help
+ menu .m1.help
+ .m1.help add command -label test
+ . configure -menu .m1
+ raise .
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-18.13 {DrawMenuBarWhenIdle - help menu there - no idlers} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m1.help
+ menu .m1.help
+ .m1.help add command -label test
+ . configure -menu .m1
+ raise .
+ update idletasks
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+# Can't generate no menubar clone
+test macMenu-18.14 {DrawMenuBarWhenIdle - apple and help menus in tearoff menubar} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m1.apple
+ .m1 add cascade -menu .m1.help
+ menu .m1.apple
+ menu .m1.help
+ . configure -menu .m1
+ raise .
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-18.15 {DrawMenuBarWhenIdle - apple and help menus in non-tearoff menubar} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -menu .m1.apple
+ .m1 add cascade -menu .m1.help
+ menu .m1.apple
+ menu .m1.help
+ . configure -menu .m1
+ raise .
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-18.16 {DrawMenuBarWhenIdle - no apple menu} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ . configure -menu .m1
+ raise .
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-18.17 {DrawMenuBarWhenIdle - apple menu} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ . configure -menu .m1
+ .m1 add cascade -menu .m1.apple
+ menu .m1.apple
+ .m1.apple add cascade -label test -menu .m1.apple.test
+ menu .m1.apple.test
+ raise .
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-18.18 {DrawMenuBarWhenIdle - big for loop} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ menu .m1.apple -tearoff 0
+ menu .m1.help -tearoff 0
+ menu .m1.foo -tearoff 0
+ .m1 add cascade -menu .m1.apple
+ .m1 add cascade -menu .m1.help
+ .m1 add cascade -label Foo -menu .m1.foo
+ . configure -menu .m1
+ raise .
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-18.19 {DrawMenuBarWhenIdle = disabled menu} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ menu .m1.edit -tearoff 0
+ .m1 add cascade -menu .m1.edit -label Edit
+ . configure -menu .m1
+ raise .
+ .m1 entryconfigure Edit -state disabled
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+
+test macMenu-19.1 {RecursivelyInsertMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .main}
+ catch {destroy .t2}
+ toplevel .t2 -menu .main
+ wm geometry .t2 +0+0
+ menu .main
+ .main add cascade -menu .m1 -label ".m1"
+ menu .m1
+ .m1 add command -label "Test 2"
+ .m1 add cascade -label ".m2" -menu .m2
+ menu .m2
+ .m2 add command -label "Test 3"
+ list [catch {raise .t2} msg] $msg [destroy .t2 .main .m1 .m2]
+} {0 {} {}}
+test macMenu-19.2 {RecursivelyInsertMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .main}
+ catch {destroy .t2}
+ toplevel .t2 -menu .main
+ wm geometry .t2 +0+0
+ menu .main
+ .main add cascade -menu .m1 -label ".m1"
+ menu .m1
+ .m1 add command -label "Test 2"
+ .m1 add cascade -label ".m2" -menu .m2
+ menu .m2
+ .m2 add command -label "Test 3"
+ list [catch {raise .t2} msg] $msg [destroy .t2 .main .m1 .m2]
+} {0 {} {}}
+
+test macMenu-20.1 {SetDefaultMenuBar} {
+ . configure -menu ""
+ raise .
+ list [catch {update} msg] $msg
+} {0 {}}
+
+test macMenu-21.1 {TkpSetMainMenubar - not front window} {
+ catch {destroy .m1}
+ catch {destroy .t2}
+ toplevel .t2
+ wm geometry .t2 +50+50
+ menu .m1
+ raise .
+ update
+ list [catch {.t2 configure -menu .m1} msg] $msg [destroy .t2] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-21.2 {TkpSetMainMenubar - menu null} {
+ . configure -menu ""
+ raise .
+ list [catch {update} msg] $msg
+} {0 {}}
+test macMenu-21.3 {TkpSetMainMenubar - different interps} {
+ catch {destroy .m1}
+ catch {interp delete testinterp}
+ interp create testinterp
+ load {} tk testinterp
+ menu .m1
+ . configure -menu .m1
+ raise .
+ update
+ interp eval testinterp {menu .m1}
+ interp eval testinterp {. configure -menu .m1}
+ interp eval testinterp {raise .}
+ list [catch {interp eval testinterp {update}} msg] $msg [interp delete testinterp] [. configure -menu ""] [destroy .m1]
+} {0 {} {} {} {}}
+test macMenu-21.4 {TkpSetMainMenubar - different windows} {
+ catch {destroy .m1}
+ catch {destroy .t2}
+ menu .m1
+ . configure -menu .m1
+ toplevel .t2
+ wm geometry .t2 +50+50
+ .t2 configure -menu .m1
+ raise .
+ update
+ raise .t2
+ list [catch {update} msg] $msg [destroy .t2] [. configure -menu ""] [destroy .m1]
+} {0 {} {} {} {}}
+test macMenu-21.5 {TkpSetMainMenubar - old menu was null} {
+ catch {destroy .m1}
+ . configure -menu ""
+ update
+ menu .m1
+ . configure -menu .m1
+ raise .
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test macMenu-21.6 {TkpSetMainMenubar - old menu different} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ menu .m2
+ . configure -menu .m1
+ raise .
+ update
+ . configure -menu .m2
+ raise .
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] [destroy .m2]
+} {0 {} {} {} {}}
+test macMenu-21.7 {TkpSetMainMenubar - child window NULL - parent window now} {
+ catch {destroy .m1}
+ catch {destroy .t2}
+ toplevel .t2
+ menu .m1
+ .m1 add cascade -label Foo -menu .m1.foo
+ menu .m1.foo
+ .m1.foo add command -label foo
+ . configure -menu .m1
+ raise .t2
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1] [destroy .t2]
+} {0 {} {} {} {}}
+test macMenu-21.8 {TkpSetMainMenubar - tearoff window} {
+ catch {destroy .t2}
+ toplevel .t2 -menu .t2.m1
+ menu .t2.m1
+ .t2.m1 add cascade -label File -menu .t2.m1.foo
+ menu .t2.m1.foo
+ .t2.m1.foo add command -label foo
+ raise .t2
+ tkTearOffMenu .t2.m1.foo 100 100
+ list [catch {update} msg] $msg [destroy .t2]
+} {0 {} {}}
+
+test macMenu-22.1 {TkSetWindowMenuBar} {
+} {}
+
+test macMenu-23.1 {TkMacDispatchMenuEvent} {
+ # needs to be interactive.
+} {}
+
+test macMenu-24.1 {GetMenuIndicatorGeometry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ .m1 invoke foo
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+
+test macMenu-25.1 {GetMenuAccelGeometry - cascade entry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label foo
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test macMenu-25.2 {GetMenuAccelGeometry - no accel} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test macMenu-25.3 {GetMenuAccelGeometry - no special chars - arbitrary string} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -accel "Test"
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test macMenu-25.4 {GetMenuAccelGeometry - Command} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Cmd+S"
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test macMenu-25.5 {GetMenuAccelGeometry - Control} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Ctrl+S"
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test macMenu-25.6 {GetMenuAccelGeometry - Shift} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Shift+S"
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test macMenu-25.7 {GetMenuAccelGeometry - Option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Opt+S"
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test macMenu-25.8 {GetMenuAccelGeometry - Combination} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Cmd+Shift+S"
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test macMenu-25.9 {GetMenuAccelGeometry - extra text} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Command+Delete"
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+
+test macMenu-26.1 {GetTearoffEntryGeometry} {
+ # can't call this on power mac.
+} {}
+
+test macMenu-27.1 {GetMenuSeparatorGeometry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+
+test macMenu-28.1 {DrawMenuEntryIndicator - non-checkbutton} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-28.2 {DrawMenuEntryIndicator - indicator off} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo -indicatoron 0
+ .m1 invoke foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-28.3 {DrawMenuEntryIndicator - not selected} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-28.4 {DrawMenuEntryIndicator - checkbutton} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ .m1 invoke foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-28.5 {DrawMenuEntryIndicator - radiobutton} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label foo
+ .m1 invoke foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+# Cannot reproduce resources missing or color allocation failing easily.
+test macMenu-29.1 {DrawSICN} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Cmd+S"
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+# Cannot reproduce resources missing
+test macMenu-30.1 {DrawMenuEntryAccelerator - cascade entry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-30.2 {DrawMenuEntryAccelerator - no accel string} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-30.3 {DrawMenuEntryAccelerator - random accel string} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-30.4 {DrawMenuEntryAccelerator - Command} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Cmd+S"
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-30.5 {DrawMenuEntryAccelerator - Option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Opt+S"
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-30.6 {DrawMenuEntryAccelerator - Shift} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Shift+S"
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-30.7 {DrawMenuEntryAccelerator - Control} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Ctrl+S"
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test macMenu-30.8 {DrawMenuEntryAccelerator - combination} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Cmd+Shift+S"
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test macMenu-31.1 {DrawMenuSeparator} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test macMenu-32.1 {TkpDrawMenuEntryLabel} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test macMenu-33.1 {MenuDefProc - No way to test automatically.} {} {}
+test macMenu-34.1 {TkMacHandleTearoffMenu - no way to test automatically} {} {}
+test macMenu-35.1 {TkpInitializeMenuBindings - nothing to do} {} {}
+
+test macMenu-36.1 {TkpComputeMenubarGeometry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label foo
+ . configure -menu .m1
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+
+test macMenu-37.1 {DrawTearoffEntry - can't do automatically} {} {}
+test macMenu-38.1 {TkMacSetHelpMenuItemCount - called at boot time} {} {}
+test macMenu-39.1 {TkMacMenuClick - can't do automatically} {} {}
+
+test macMenu-40.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 macMenu-40.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 macMenu-40.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 macMenu-40.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 macMenu-40.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 macMenu-40.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 macMenu-40.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 macMenu-40.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 macMenu-40.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 macMenu-40.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 macMenu-40.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 macMenu-40.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 macMenu-40.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 macMenu-40.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 macMenu-40.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 macMenu-40.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 macMenu-40.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 macMenu-40.18 {TkpDrawMenuEntry - separator} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.19 {TkpDrawMenuEntry - standard} {
+ catch {destroy .mb}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.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 macMenu-40.21 {TkpDrawMenuEntry - indicator} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label macMenu-40.20
+ .m1 invoke 0
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-40.22 {TkpDrawMenuEntry - indicator - hideMargin} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label macMenu-40.21 -hidemargin 1
+ .m1 invoke 0
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+
+test macMenu-41.1 {TkpComputeStandardMenuGeometry - no entries} {
+ catch {destroy .m1}
+ menu .m1
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-41.2 {TkpComputeStandardMenuGeometry - one entry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "one"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-41.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 macMenu-41.4 {TkpComputeStandardMenuGeometry - separator} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-41.5 {TkpComputeStandardMenuGeometry - standard label geometry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-41.6 {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 macMenu-41.7 {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 macMenu-41.8 {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 macMenu-41.9 {TkpComputeStandardMenuGeometry - accelerator} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test" -accel "Ctrl+S"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-41.10 {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 macMenu-41.11 {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 macMenu-41.12 {TkpComputeStandardMenuGeometry - indicator} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label test
+ .m1 invoke 1
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-41.13 {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 macMenu-41.14 {TkpComputeStandardMenuGeometry - hidden margin} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label macMenu-41.15 -hidemargin 1
+ .m1 invoke macMenu-41.15
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-41.15 {TkpComputeStandardMenuGeometry - zero sized menus} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-41.16 {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 macMenu-41.17 {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 macMenu-41.18 {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 macMenu-41.19 {TkpComputeStandardMenuGeometry - entry without accel long} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label "This is a long item with no accel."
+ .m1 add command -label foo -accel "Cmd+S"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-41.20 {TkpComputeStandardMenuGeometry - entry with accel long} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label foo
+ .m1 add command -label "This is a long label with an accel." -accel "Cmd+W"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+
+test macMenu-42.1 {DrawMenuEntryLabel - setting indicatorSpace} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "foo"
+ set tearoff [tkTearOffMenu .m1]
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-42.2 {DrawMenuEntryLabel - drawing image} {
+ catch {destroy .m1}
+ catch {image delete image1}
+ image create test image1
+ menu .m1
+ .m1 add command -image image1
+ set tearoff [tkTearOffMenu .m1]
+ list [update idletasks] [destroy .m1] [image delete image1]
+} {{} {} {}}
+test macMenu-42.3 {DrawMenuEntryLabel - drawing select image} {
+ catch {destroy .m1}
+ catch {eval image delete [image names]}
+ image create test image1
+ image create test image2
+ menu .m1
+ .m1 add checkbutton -image image1 -selectimage image2
+ .m1 invoke 1
+ set tearoff [tkTearOffMenu .m1]
+ list [update idletasks] [destroy .m1] [eval image delete [image names]]
+} {{} {} {}}
+test macMenu-42.4 {DrawMenuEntryLabel - drawing a bitmap} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -bitmap questhead
+ set tearoff [tkTearOffMenu .m1]
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-42.5 {DrawMenuEntryLabel - drawing null label} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command
+ set tearoff [tkTearOffMenu .m1]
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-42.6 {DrawMenuEntryLabel - drawing real label} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "This is a long label" -underline 3
+ set tearoff [tkTearOffMenu .m1]
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-42.7 {DrawMenuEntryLabel - drawing disabled label} {
+ catch {destroy .m1}
+ menu .m1 -disabledforeground ""
+ .m1 add command -label "This is a long label" -state disabled
+ set tearoff [tkTearOffMenu .m1]
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-42.8 {DrawMenuEntryLabel - disabled images} {
+ catch {destroy .m1}
+ catch {image delete image1}
+ image create test image1
+ menu .m1
+ .m1 add command -image image1 -state disabled
+ set tearoff [tkTearOffMenu .m1 100 100]
+ list [update idletasks] [destroy .m1] [image delete image1]
+} {{} {} {}}
+
+test macMenu-43.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 macMenu-43.2 {GetMenuLabelGeometry - bitmap} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -bitmap questhead
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-43.3 {GetMenuLabelGeometry - no text} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test macMenu-43.4 {GetMenuLabelGeometry - text} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "This is a test."
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+
+test macMenu-44.1 {DrawMenuEntryBackground} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test macMenu-44.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 macMenu-45.1 {TkpMenuInit - called at boot time} {} {}
+
+deleteWindows
+
diff --git a/tk/tests/macWinMenu.test b/tk/tests/macWinMenu.test
new file mode 100644
index 00000000000..013138f4f6f
--- /dev/null
+++ b/tk/tests/macWinMenu.test
@@ -0,0 +1,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.
+#
+# RCS: @(#) $Id$
+
+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
diff --git a/tk/tests/macscrollbar.test b/tk/tests/macscrollbar.test
new file mode 100644
index 00000000000..24f49362d9f
--- /dev/null
+++ b/tk/tests/macscrollbar.test
@@ -0,0 +1,101 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+# 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 .
+update
+
+# Tests for display and layout
+wm geometry . 50x300
+scrollbar .s
+pack .s -fill y -expand 1
+update
+test macscroll-1.1 {TkpDisplayScrollbar procedure} {
+ list [.s configure -width] [.s configure -bd]
+} {{-width width Width 16 16} {-borderwidth borderWidth BorderWidth 0 0}}
+test macscroll-1.2 {TkpDisplayScrollbar procedure} {
+ # Exercise drawing 3D relief
+ pack .s -fill y -expand 1 -anchor center
+ .s configure -bd 4
+ update
+ focus .s
+ update
+} {}
+test macscroll-1.3 {TkpDisplayScrollbar procedure} {
+ pack .s -fill y -expand 1 -anchor e
+ update
+ set x [.s configure -width]
+ pack .s -fill y -expand 1 -anchor w
+ update
+ list [.s configure -width] $x
+} {{-width width Width 16 16} {-width width Width 16 16}}
+test macscroll-1.4 {TkpDisplayScrollbar procedure} {
+ wm geometry . 300x50
+ .s configure -bd 0 -orient horizontal
+ pack .s -fill x -expand 1 -anchor center
+ update
+ set x [.s configure -width]
+ pack .s -fill x -expand 1 -anchor n
+ update
+ set y [.s configure -width]
+ pack .s -fill x -expand 1 -anchor s
+ update
+ list [.s configure -width] $x $y
+} {{-width width Width 16 16} {-width width Width 16 16} {-width width Width 16 16}}
+test macscroll-1.5 {TkpDisplayScrollbar procedure} {
+ wm geometry . 300x16
+ .s configure -bd 0 -orient horizontal
+ pack .s -fill x -expand 1 -anchor s
+ update
+ wm geometry . 300x15
+ update
+ wm geometry . 300x14
+ update
+} {}
+test macscroll-1.6 {TkpDisplayScrollbar procedure} {
+ # Check the drawing of the resize hack
+ wm geometry . 20x300
+ wm resizable . 1 1
+ .s configure -bd 0 -orient vertical
+ pack .s -fill y -expand 1 -anchor e
+ update
+ set x [.s identify 12 295]
+ wm resizable . 0 0
+ update
+ set y [.s identify 12 295]
+ wm resizable . 1 1
+ pack .s -fill y -expand 1 -anchor center
+ update
+ list $x $y [.s identify 12 295]
+} {{} arrow2 arrow2}
+test macscroll-1.7 {TkpDisplayScrollbar procedure} {
+ wm geometry . 300x300
+ pack .s -fill y -expand 1 -anchor e
+ catch {destroy .s2}
+ scrollbar .s2 -orient horizontal
+ place .s2 -x 0 -y 284 -width 300
+} {}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+concat {}
diff --git a/tk/tests/main.test b/tk/tests/main.test
new file mode 100644
index 00000000000..21bd20956ee
--- /dev/null
+++ b/tk/tests/main.test
@@ -0,0 +1,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.
+#
+# RCS: @(#) $Id$
+
+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 {}}
diff --git a/tk/tests/menu.test b/tk/tests/menu.test
new file mode 100644
index 00000000000..cc07d9269e2
--- /dev/null
+++ b/tk/tests/menu.test
@@ -0,0 +1,2385 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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]
+ }
+}
+
+deleteWindows
+wm geometry . {}
+raise .
+
+test menu-1.1 {Tk_MenuCmd procedure} {
+ list [catch menu msg] $msg
+} {1 {wrong # args: should be "menu pathName ?options?"}}
+test menu-1.2 {Tk_MenuCmd procedure} {
+ list [catch "menu bogus" msg] $msg
+} {1 {bad window path name "bogus"}}
+test menu-1.3 {Tk_MenuCmd procedure} {
+ list [catch "menu .m1 foo" msg] $msg
+} {1 {unknown option "foo"}}
+test menu-1.4 {Tk_MenuCmd procedure} {
+ catch {destroy .m1}
+ list [catch {menu .m1} msg] $msg [destroy .m1]
+} {0 .m1 {}}
+test menu-1.5 {Tk_MenuCmd - creating menubar} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label Test -menu ""
+ list [. configure -menu .m1] [. configure -menu ""] [destroy .m1]
+} {{} {} {}}
+test menu-1.6 {Tk_MenuCmd procedure menu ref no cascade} {
+ catch {destroy .t2}
+ catch {destroy .m1}
+ toplevel .t2 -menu .m1
+ wm geometry .t2 +0+0
+ list [catch {menu .m1} msg] $msg [destroy .m1 .t2]
+} {0 .m1 {}}
+test menu-1.7 {Tk_MenuCmd procedure one clone cascade} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .t2}
+ toplevel .t2 -menu .m1
+ wm geometry .t2 +0+0
+ menu .m1
+ .m1 add cascade -menu .m2
+ list [catch {menu .m2} msg] $msg [destroy .t2 .m1 .m2]
+} {0 .m2 {}}
+test menu-1.8 {Tk_MenuCmd procedure two clone cascades} {
+ catch {destroy .m1}
+ catch {destroy .t2}
+ catch {destroy .t3}
+ catch {destroy .m2}
+ menu .m1
+ .m1 add cascade -menu .m2
+ toplevel .t2 -menu .m1
+ wm geometry .t2 +0+0
+ toplevel .t3 -menu .m1
+ wm geometry .t3 +0+0
+ list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .m1 .m2]
+} {0 .m2 {}}
+test menu-1.9 {Tk_MenuCmd procedure two clone cascades different order} {
+ catch {destroy .t2}
+ catch {destroy .m1}
+ catch {destroy .t3}
+ catch {destroy .m2}
+ toplevel .t2 -menu .m1
+ wm geometry .t2 +0+0
+ menu .m1
+ .m1 add cascade -menu .m2
+ toplevel .t3 -menu .m1
+ wm geometry .t3 +0+0
+ list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .m1 .m2]
+} {0 .m2 {}}
+test menu-1.10 {Tk_MenuCmd procedure two clone cascades menus last} {
+ catch {destroy .t2}
+ catch {destroy .t3}
+ catch {destroy .m1}
+ catch {destroy .m2}
+ toplevel .t2 -menu .m1
+ wm geometry .t2 +0+0
+ toplevel .t3 -menu .m1
+ wm geometry .t3 +0+0
+ menu .m1
+ .m1 add cascade -menu .m2
+ list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .m1 .m2]
+} {0 .m2 {}}
+test menu-1.11 {Tk_MenuCmd procedure three clones cascades} {
+ catch {destroy .t2}
+ catch {destroy .t3}
+ catch {destroy .t4}
+ catch {destroy .m1}
+ catch {destroy .m2}
+ toplevel .t2 -menu .m1
+ wm geometry .t2 +0+0
+ toplevel .t3 -menu .m1
+ wm geometry .t3 +0+0
+ toplevel .t4 -menu .m1
+ wm geometry .t4 +0+0
+ menu .m1
+ .m1 add cascade -menu .m2
+ list [catch {menu .m2} msg] $msg [destroy .t2 .t3 .t4 .m1 .m2]
+} {0 .m2 {}}
+test menu-1.12 {Tk_MenuCmd procedure} {
+ catch {destroy .t2}
+ catch {destroy .m1}
+ toplevel .t2 -menu .m1
+ wm geometry .t2 +0+0
+ list [catch {menu .m1} msg] $msg [destroy .t2 .m1]
+} {0 .m1 {}}
+test menu-1.13 {Tk_MenuCmd procedure} {
+ catch {destroy .t2}
+ catch {destroy .t3}
+ catch {destroy .m1}
+ toplevel .t2 -menu .m1
+ wm geometry .t2 +0+0
+ toplevel .t3 -menu .m1
+ wm geometry .t3 +0+0
+ list [catch {menu .m1} msg] $msg [destroy .t2 .t3 .m1]
+} {0 .m1 {}}
+test menu-1.14 {Tk_MenuCmd procedure} {
+ catch {destroy .t2}
+ catch {destroy .t3}
+ catch {destroy .t4}
+ catch {destroy .m1}
+ toplevel .t2 -menu .m1
+ wm geometry .t2 +0+0
+ toplevel .t3 -menu .m1
+ wm geometry .t3 +0+0
+ toplevel .t4 -menu .m1
+ 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
+# menu entries. The following code sets up .m1 with 6 items. It then
+# runs through the big table below it.
+# index 0 is tearoff, 1 command, 2 cascade, 3 separator, 4 checkbutton,
+# 5 radiobutton
+
+menu .m1
+.m1 add command -label "command"
+menu .m2
+.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
+ {#ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000
+ }
+ }
+ {non-existent
+ {{unknown color name "non-existent"}
+ {unknown color name "non-existent"}
+ {unknown color name "non-existent"}
+ {unknown color name "non-existent"}
+ {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"}
+ {image "bogus" doesn't exist}
+ {image "bogus" doesn't exist}
+ }
+ }
+ {""
+ {{unknown option "-image"}
+ {}
+ {}
+ {unknown option "-image"}
+ {}
+ {}
+ }
+ }}
+ }
+ {-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"}
+ {unknown option "-selectcolor"}
+ {unknown option "-selectcolor"}
+ {unknown color name "non-existent"}
+ {unknown color name "non-existent"}
+ }
+ }}
+ }
+ {-selectimage
+ {{image1
+ {{unknown option "-selectimage"}
+ {unknown option "-selectimage"}
+ {unknown option "-selectimage"}
+ {unknown option "-selectimage"} image1 image1
+ }
+ }
+ {bogus
+ {{unknown option "-selectimage"}
+ {unknown option "-selectimage"}
+ {unknown option "-selectimage"}
+ {unknown option "-selectimage"}
+ {image "bogus" doesn't exist}
+ {image "bogus" doesn't exist}
+ }
+ }
+ {""
+ {{unknown option "-selectimage"}
+ {unknown option "-selectimage"}
+ {unknown option "-selectimage"}
+ {unknown option "-selectimage"}
+ {}
+ {}
+ }
+ }}
+ }
+ {-state
+ {{normal
+ {normal normal normal
+ {unknown option "-state"} normal normal
+ }
+ }}
+ }
+ {-value
+ {{"any string"
+ {{unknown option "-value"}
+ {unknown option "-value"}
+ {unknown option "-value"}
+ {unknown option "-value"}
+ {unknown option "-value"} "any string"
+ }
+ }}
+ }
+ {-variable
+ {{"any string"
+ {{unknown option "-variable"}
+ {unknown option "-variable"}
+ {unknown option "-variable"}
+ {unknown option "-variable"}
+ "any string"
+ "any string"
+ }
+ }}
+ }
+ {-underline
+ {{0
+ {{unknown option "-underline"} 0 0
+ {unknown option "-underline"} 0 0
+ }
+ }
+ {3p
+ {{unknown option "-underline"}
+ {expected integer but got "3p"}
+ {expected integer but got "3p"}
+ {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]
+ incr i
+ }
+ }
+}
+
+image delete image1
+destroy .m1
+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}
+ menu .m1
+ list [catch {.m1 add} msg] $msg [destroy .m1]
+} {1 {wrong # args: should be ".m1 add type ?options?"} {}}
+test menu-3.9 {MenuWidgetCmd procedure, "add" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add foo} msg] $msg [destroy .m1]
+} {1 {bad menu entry type "foo": must be cascade, checkbutton, command, radiobutton, or separator} {}}
+test menu-3.10 {MenuWidgetCmd procedure, "add" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 add separator} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-3.11 {MenuWidgetCmd procedure, "cget" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 cget} msg] $msg [destroy .m1]
+} {1 {wrong # args: should be ".m1 cget option"} {}}
+test menu-3.12 {MenuWidgetCmd procedure, "cget" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 cget -gorp} msg] $msg [destroy .m1]
+} {1 {unknown option "-gorp"} {}}
+test menu-3.13 {MenuWidgetCmd procedure, "cget" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 configure -postcommand "Some string"
+ list [catch {.m1 cget -postcommand} msg] $msg [destroy .m1]
+} {0 {Some string} {}}
+test menu-3.14 {MenuWidgetCmd procedure, "clone" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 clone} msg] $msg [destroy .m1]
+} {1 {wrong # args: should be ".m1 clone newMenuName ?menuType?"} {}}
+test menu-3.15 {MenuWidgetCmd procedure, "clone" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 clone a b c d} msg] $msg [destroy .m1]
+} {1 {wrong # args: should be ".m1 clone newMenuName ?menuType?"} {}}
+test menu-3.16 {MenuWidgetCmd procedure, "clone" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 clone .m1.clone1} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-3.17 {MenuWidgetCmd procedure, "clone" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 clone .m1.clone1 tearoff} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-3.18 {MenuWidgetCmd procedure, "configure" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {llength [.m1 configure]} msg] $msg [destroy .m1]
+} {0 20 {}}
+test menu-3.19 {MenuWidgetCmd procedure, "configure" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 configure -gorp} msg] $msg [destroy .m1]
+} {1 {unknown option "-gorp"} {}}
+test menu-3.20 {MenuWidgetCmd procedure, "configure" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 configure -postcommand "A random String"} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-3.21 {MenuWidgetCmd procedure, "configure" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 configure -postcommand "Another string"
+ list [catch {lindex [.m1 configure -postcommand] 4} msg] $msg [destroy .m1]
+} {0 {Another string} {}}
+test menu-3.22 {MenuWidgetCmd procedure, "delete" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 delete} msg] $msg [destroy .m1]
+} {1 {wrong # args: should be ".m1 delete first ?last?"} {}}
+test menu-3.23 {MenuWidgetCmd procedure, "delete" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 delete foo} msg] $msg [destroy .m1]
+} {1 {bad menu entry index "foo"} {}}
+test menu-3.24 {MenuWidgetCmd procedure, "delete" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 delete 0 "foo"} msg] $msg [destroy .m1]
+} {1 {bad menu entry index "foo"} {}}
+test menu-3.25 {MenuWidgetCmd procedure, "delete" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 delete 0} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-3.26 {MenuWidgetCmd procedure, "delete" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "foo"
+ list [catch {.m1 delete 1 0} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-3.27 {MenuWidgetCmd procedure, "delete" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "1"
+ .m1 add command -label "2"
+ .m1 add command -label "3"
+ list [catch {.m1 delete 1 3} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-3.28 {MenuWidgetCmd procedure, "delete" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "1"
+ .m1 add command -label "2"
+ .m1 add command -label "3"
+ .m1 activate 2
+ list [catch {.m1 delete 1 3} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-3.29 {MenuWidgetCmd procedure, "delete" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "1"
+ .m1 add command -label "2"
+ .m1 add command -label "3"
+ .m1 activate 3
+ list [catch {.m1 delete 1} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-3.30 {MenuWidgetCmd procedure, "entrycget" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 entrycget} msg] $msg [destroy .m1]
+} {1 {wrong # args: should be ".m1 entrycget index option"} {}}
+test menu-3.31 {MenuWidgetCmd procedure, "entrycget" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 entrycget index option foo} msg] $msg [destroy .m1]
+} {1 {wrong # args: should be ".m1 entrycget index option"} {}}
+test menu-3.32 {MenuWidgetCmd procedure, "entrycget" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 entrycget foo -label} msg] $msg [destroy .m1]
+} {1 {bad menu entry index "foo"} {}}
+test menu-3.33 {MenuWidgetCmd procedure, "entrycget" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
+} {0 test {}}
+test menu-3.34 {MenuWidgetCmd procedure, "entryconfigure" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 entryconfigure} msg] $msg [destroy .m1]
+} {1 {wrong # args: should be ".m1 entryconfigure index ?option value ...?"} {}}
+test menu-3.35 {MenuWidgetCmd procedure, "entryconfigure" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 entryconfigure foo} msg] $msg [destroy .m1]
+} {1 {bad menu entry index "foo"} {}}
+test menu-3.36 {MenuWidgetCmd procedure, "entryconfigure" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {llength [.m1 entryconfigure 1]} msg] $msg [destroy .m1]
+} {0 14 {}}
+test menu-3.37 {MenuWidgetCmd procedure, "entryconfigure" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {lindex [.m1 entryconfigure 1 -label] 4} msg] $msg [destroy .m1]
+} {0 test {}}
+test menu-3.38 {MenuWidgetCmd procedure, "entryconfigure" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ .m1 entryconfigure 1 -label "changed"
+ list [catch {lindex [.m1 entryconfigure 1 -label] 4} msg] $msg [destroy .m1]
+} {0 changed {}}
+test menu-3.39 {MenuWidgetCmd procedure, "index" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 index} msg] $msg [destroy .m1]
+} {1 {wrong # args: should be ".m1 index string"} {}}
+test menu-3.40 {MenuWidgetCmd procedure, "index" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 index foo} msg] $msg [destroy .m1]
+} {1 {bad menu entry index "foo"} {}}
+test menu-3.41 {MenuWidgetCmd procedure, "index" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {.m1 index "test"} msg] $msg [destroy .m1]
+} {0 1 {}}
+test menu-3.42 {MenuWidgetCmd procedure, "insert" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 insert} msg] $msg [destroy .m1]
+} {1 {wrong # args: should be ".m1 insert index type ?options?"} {}}
+test menu-3.43 {MenuWidgetCmd procedure, "insert" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 insert 1 command -label "test"
+ list [catch {.m1 entrycget 1 -label} msg] $msg [destroy .m1]
+} {0 test {}}
+test menu-3.44 {MenuWidgetCmd procedure, "invoke" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 invoke} msg] $msg [destroy .m1]
+} {1 {wrong # args: should be ".m1 invoke index"} {}}
+test menu-3.45 {MenuWidgetCmd procedure, "invoke" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 invoke foo} msg] $msg [destroy .m1]
+} {1 {bad menu entry index "foo"} {}}
+test menu-3.46 {MenuWidgetCmd procedure, "invoke" option} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ .m1 add command -label "set foo" -command "set foo hello"
+ list [catch {.m1 invoke 1} msg] $msg [catch {set foo} msg2] $msg2 [catch {unset foo} msg3] $msg3 [destroy .m1]
+} {0 hello 0 hello 0 {} {}}
+test menu-3.47 {MenuWidgetCmd procedure, "post" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "On Windows, hit Escape to get this menu to go away"
+ list [catch {.m1 post} msg] $msg [destroy .m1]
+} {1 {wrong # args: should be ".m1 post x y"} {}}
+test menu-3.48 {MenuWidgetCmd procedure, "post" option} {
+ catch {destroy .m1}
+ menu .m1
+ 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
+ list [catch {.m1 postcascade 1} msg] $msg [destroy .m1 .m2]
+} {0 {} {}}
+test menu-3.54 {MenuWidgetCmd procedure, "postcascade" option} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ menu .m2
+ .m1 add cascade -menu .m2 -label "menu-3.57 - hit Escape"
+ .m1 postcascade 1
+ list [catch {.m1 postcascade none} msg] $msg [destroy .m1 .m2]
+} {0 {} {}}
+test menu-3.55 {MenuWidgetCmd procedure, "type" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 type} msg] $msg [destroy .m1]
+} {1 {wrong # args: should be ".m1 type index"} {}}
+test menu-3.56 {MenuWidgetCmd procedure, "type" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 type foo} msg] $msg [destroy .m1]
+} {1 {bad menu entry index "foo"} {}}
+test menu-3.57 {MenuWidgetCmd procedure, "type" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {.m1 type 1} msg] $msg [destroy .m1]
+} {0 command {}}
+test menu-3.58 {MenuWidgetCmd procedure, "type" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ list [catch {.m1 type 1} msg] $msg [destroy .m1]
+} {0 separator {}}
+test menu-3.59 {MenuWidgetCmd procedure, "type" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label "test"
+ list [catch {.m1 type 1} msg] $msg [destroy .m1]
+} {0 checkbutton {}}
+test menu-3.60 {MenuWidgetCmd procedure, "type" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label "test"
+ list [catch {.m1 type 1} msg] $msg [destroy .m1]
+} {0 radiobutton {}}
+test menu-3.61 {MenuWidgetCmd procedure, "type" option} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label "test"
+ list [catch {.m1 type 1} msg] $msg [destroy .m1]
+} {0 cascade {}}
+test menu-3.62 {MenuWidgetCmd procedure, "type" option} {
+ catch {destroy .m1}
+ menu .m1
+ 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} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 yposition} msg] $msg [destroy .m1]
+} {1 {wrong # args: should be ".m1 yposition index"} {}}
+test menu-3.66 {MenuWidgetCmd procedure, "yposition" option} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 yposition 1}] [destroy .m1]
+} {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} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+test menu-5.2 {DestroyMenuInstance - cascade menu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 add cascade -menu .m2
+ menu .m2
+ list [catch {destroy .m2} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-5.3 {DestroyMenuInstance - multiple cascade parents} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ menu .m1
+ .m1 add cascade -menu .m3
+ menu .m2
+ .m2 add cascade -menu .m3
+ menu .m3
+ list [catch {destroy .m3} msg] $msg [destroy .m1 .m2]
+} {0 {} {}}
+test menu-5.4 {DestroyMenuInstance - multiple cascade parents} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ catch {destroy .m4}
+ menu .m1
+ .m1 add cascade -menu .m4
+ menu .m2
+ .m2 add cascade -menu .m4
+ menu .m3
+ .m3 add cascade -menu .m4
+ menu .m4
+ list [catch {destroy .m4} msg] $msg [destroy .m1 .m2 .m3]
+} {0 {} {}}
+test menu-5.5 {DestroyMenuInstance - cascades of cloned menus} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ menu .m2
+ .m1 add cascade -menu .m2
+ . configure -menu .m1
+ list [catch {destroy .m2} msg] $msg [.m1 entrycget 1 -menu] [. configure -menu ""] [destroy .m1]
+} {0 {} .m2 {} {}}
+test menu-5.6 {DestroyMenuInstance - cascades of cloned menus} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .t2}
+ menu .m1
+ .m1 add cascade -menu .m2
+ menu .m2
+ . configure -menu .m1
+ toplevel .t2
+ wm geometry .t2 +0+0
+ .t2 configure -menu .m1
+ list [catch {destroy .m2} msg] $msg [. configure -menu ""] [destroy .t2 .m1]
+} {0 {} {} {}}
+test menu-5.7 {DestroyMenuInstance - basic clones} {
+ catch {destroy .m1}
+ menu .m1
+ set tearoff [tkTearOffMenu .m1]
+ list [catch {destroy $tearoff} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-5.8 {DestroyMenuInstance - multiple clones} {
+ catch {destroy .m1}
+ menu .m1
+ set tearoff1 [tkTearOffMenu .m1]
+ set tearoff2 [tkTearOffMenu .m1]
+ list [catch {destroy $tearoff1} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-5.9 {DestroyMenuInstace - master menu} {
+ catch {destroy .m1}
+ menu .m1
+ tkTearOffMenu .m1
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+test menu-5.10 {DestroyMenuInstance - freeing entries} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "foo"
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+test menu-5.11 {DestroyMenuInstace - no entries} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 configure -tearoff 0
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+test menu-5.12 {DestroyMenuInstance - platform data} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+test menu-5.13 {DestroyMenuInstance - clones when mismatched tearoffs} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ menu .m2
+ .m1 add cascade -menu .m2
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [destroy .m2] [destroy .m1]
+} {{} {}}
+
+test menu-6.1 {TkDestroyMenu} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+test menu-6.2 {TkDestroyMenu - reentrancy} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ bind .m1 <Destroy> {destroy .m1}
+ menu .m2
+ bind .m2 <Destroy> {destroy .m2}
+ list [catch {destroy .m1} msg] $msg [destroy .m2]
+} {0 {} {}}
+test menu-6.3 {TkDestroyMenu - reentrancy} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ menu .m1
+ bind .m1 <Destroy> {destroy .m2}
+ .m1 clone .m2
+ .m1 clone .m3
+ list [catch {destroy .m1} msg] $msg [winfo exists .m2]
+} {0 {} 0}
+test menu-6.4 {TkDestroyMenu - reentrancy - clones} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 clone .m2
+ .m1 clone .m1.m3
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+test menu-6.5 {TkDestroyMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 clone .m2
+ destroy .m1
+ winfo exists .m2
+} {0}
+test menu-6.6 {TkDestroyMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 clone .m2 tearoff
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+test menu-6.7 {TkDestroyMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 clone .m2
+ destroy .m2
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+test menu-6.8 {TkDestroyMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ menu .m1
+ .m1 clone .m2
+ .m1 clone .m3
+ destroy .m1
+ list [winfo exists .m2] [winfo exists .m3]
+} {0 0}
+test menu-6.9 {TkDestroyMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ menu .m1
+ .m1 clone .m2
+ .m1 clone .m3
+ list [catch {destroy .m2} msg] $msg [catch {destroy .m3} msg2] $msg2 [catch {destroy .m1} msg3] $msg3
+} {0 {} 0 {} 0 {}}
+test menu-6.10 {TkDestroyMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ menu .m1
+ .m1 clone .m2
+ .m1 clone .m3
+ list [catch {destroy .m3} msg] $msg [catch {destroy .m1} msg2] $msg2
+} {0 {} 0 {}}
+test menu-6.11 {TkDestroyMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ catch {destroy .m4}
+ menu .m1
+ .m1 clone .m2
+ .m1 clone .m3
+ .m1 clone .m4
+ list [catch {destroy .m2} msg1] $msg1 [catch {destroy .m1} msg2] $msg2
+} {0 {} 0 {}}
+test menu-6.12 {TkDestroyMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ catch {destroy .m4}
+ menu .m1
+ .m1 clone .m2
+ .m1 clone .m3
+ .m1 clone .m4
+ list [catch {destroy .m3} msg1] $msg1 [catch {destroy .m1} msg2] $msg2
+} {0 {} 0 {}}
+test menu-6.13 {TkDestroyMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ catch {destroy .m4}
+ menu .m1
+ .m1 clone .m2
+ .m1 clone .m3
+ .m1 clone .m4
+ list [catch {destroy .m4} msg1] $msg1 [catch {destroy .m1} msg2] $msg2
+} {0 {} 0 {}}
+test menu-6.14 {TkDestroyMenu} {
+ catch {destroy .m1}
+ menu .m1
+ . configure -menu .m1
+ list [catch {destroy .m1} msg] $msg [. configure -menu ""]
+} {0 {} {}}
+test menu-6.15 {TkDestroyMenu} {
+ catch {destroy .m1}
+ catch {destroy .t2}
+ menu .m1
+ toplevel .t2
+ wm geometry .t2 +0+0
+ . configure -menu .m1
+ .t2 configure -menu .m1
+ list [catch {destroy .m1} msg] $msg [destroy .t2] [. configure -menu ""]
+} {0 {} {} {}}
+test menu-6.16 {TkDestroyMenu} {
+ catch {destroy .m1}
+ catch {destroy .t2}
+ catch {destroy .t3}
+ menu .m1
+ toplevel .t2
+ wm geometry .t2 +0+0
+ toplevel .t3
+ wm geometry .t3 +0+0
+ . configure -menu .m1
+ .t2 configure -menu .m1
+ .t3 configure -menu .m1
+ list [catch {destroy .m1} msg] $msg [destroy .t2] [destroy .t3] [. configure -menu ""]
+} {0 {} {} {} {}}
+
+test menu-7.1 {UnhookCascadeEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+test menu-7.2 {UnhookCascadeEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -menu .m2
+ list [catch {destroy .m1} msg] $msg
+} {0 {}}
+test menu-7.3 {UnhookCascadeEntry} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ menu .m2
+ .m2 add cascade -menu .cascade
+ .m1 add cascade -menu .cascade
+ list [catch {destroy .m1} msg] $msg [destroy .m2]
+} {0 {} {}}
+test menu-7.4 {UnhookCascadeEntry} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ menu .m2
+ .m1 add cascade -menu .cascade
+ .m2 add cascade -menu .cascade
+ list [catch {destroy .m1} msg] $msg [destroy .m2]
+} {0 {} {}}
+test menu-7.5 {UnhookCascadeEntry} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ menu .m1
+ menu .m2
+ menu .m3
+ .m1 add cascade -menu .cascade
+ .m2 add cascade -menu .cascade
+ .m3 add cascade -menu .cascade
+ list [catch {destroy .m1} msg] $msg [destroy .m2 .m3]
+} {0 {} {}}
+test menu-7.6 {UnhookCascadeEntry} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ menu .m1
+ menu .m2
+ menu .m3
+ .m1 add cascade -menu .cascade
+ .m2 add cascade -menu .cascade
+ .m3 add cascade -menu .cascade
+ list [catch {destroy .m2} msg] $msg [destroy .m1 .m3]
+} {0 {} {}}
+test menu-7.7 {UnhookCascadeEntry} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ menu .m1
+ menu .m2
+ menu .m3
+ .m1 add cascade -menu .cascade
+ .m2 add cascade -menu .cascade
+ .m3 add cascade -menu .cascade
+ list [catch {destroy .m3} msg] $msg [destroy .m1 .m2]
+} {0 {} {}}
+test menu-7.8 {UnhookCascadeEntry} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ menu .m2
+ .m1 add cascade -menu .m2
+ list [catch {destroy .m1} msg] $msg [destroy .m2]
+} {0 {} {}}
+test menu-7.9 {UnhookCascadeEntry} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ menu .m2
+ .m1 add cascade -menu .m2
+ destroy .m1
+ list [catch {destroy .m2} msg] $msg
+} {0 {}}
+
+test menu-8.1 {DestroyMenuEntry} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ menu .m2
+ .m1 add cascade -menu .m2
+ list [catch {.m1 delete 1} msg] $msg [destroy .m1 .m2]
+} {0 {} {}}
+test menu-8.2 {DestroyMenuEntry} {
+ catch {image delete image1a}
+ catch {destroy .m1}
+ image create photo image1a -file [file join $tk_library demos images earth.gif]
+ menu .m1
+ .m1 add command -image image1a
+ list [catch {.m1 delete 1} msg] $msg [destroy .m1] [image delete image1a]
+} {0 {} {} {}}
+test menu-8.3 {DestroyMenuEntry} {
+ catch {eval image delete [image names]}
+ catch {destroy .m1}
+ image create test image1
+ image create test image2
+ menu .m1
+ .m1 add checkbutton -image image1 -selectimage image2
+ .m1 invoke 1
+ list [catch {.m1 delete 1} msg] $msg [destroy .m1] [eval image delete [image names]]
+} {0 {} {} {}}
+test menu-8.4 {DestroyMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -variable foo
+ list [catch {.m1 delete 1} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-8.5 {DestroyMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {.m1 delete 1} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-8.6 {DestroyMenuEntry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "one"
+ .m1 add command -label "two"
+ list [catch {.m1 delete 1} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
+} {0 {} two {}}
+test menu-8.7 {DestroyMenuEntry} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 add command -label "one"
+ .m1 clone .m2 tearoff
+ list [catch {.m2 delete 0} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+# test menu-9 - Can only change when fonts change on system, which cannot
+# be done from tcl.
+
+test menu-9.1 {ConfigureMenu} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 configure -postcommand "beep"} msg] $msg [.m1 cget -postcommand] [destroy .m1]
+} {0 {} beep {}}
+test menu-9.2 {ConfigureMenu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {.m1 configure -tearoff 0} msg] $msg [.m1 entrycget 1 -label] [destroy .m1]
+} {0 {} test {}}
+test menu-9.3 {ConfigureMenu} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {.m1 configure -postcommand "beep"} msg] $msg [.m1 cget -postcommand] [destroy .m1]
+} {0 {} beep {}}
+test menu-9.4 {ConfigureMenu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ list [catch {.m1 configure -fg red} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-9.5 {ConfigureMenu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ .m1 add command -label "two"
+ list [catch {.m1 configure -fg red} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-9.6 {ConfigureMenu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test"
+ .m1 add command -label "two"
+ .m1 add command -label "three"
+ list [catch {.m1 configure -fg red} msg] $msg [destroy .m1]
+} {0 {} {}}
+test menu-9.7 {ConfigureMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 clone .m2 tearoff
+ list [catch {.m1 configure -fg red} msg] $msg [.m2 cget -fg] [destroy .m1]
+} {0 {} red {}}
+test menu-9.8 {ConfigureMenu} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 clone .m2 tearoff
+ list [catch {.m2 configure -fg red} msg] $msg [.m1 cget -fg] [destroy .m1]
+} {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
diff --git a/tk/tests/menuDraw.test b/tk/tests/menuDraw.test
new file mode 100644
index 00000000000..7a1b660df85
--- /dev/null
+++ b/tk/tests/menuDraw.test
@@ -0,0 +1,546 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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}
+ menu .m1
+ list [.m1 add command] [destroy .m1]
+} {{} {}}
+
+test menuDraw-3.1 {TkMenuFreeDrawOptions} {
+ catch {destroy .m1}
+ menu .m1
+ list [destroy .m1]
+} {{}}
+
+test menuDraw-4.1 {TkMenuEntryFreeDrawOptions} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "This is a test"
+ list [destroy .m1]
+} {{}}
+test menuDraw-4.2 {TkMenuEntryFreeDrawOptions} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label "This is a test." -font "Courier 12" -activeforeground red -background green -selectcolor purple
+ list [destroy .m1]
+} {{}}
+
+test menuDraw-5.1 {TkMenuConfigureDrawOptions - new menu} {
+ catch {destroy .m1}
+ list [menu .m1] [destroy .m1]
+} {.m1 {}}
+test menuDraw-5.2 {TkMenuConfigureDrawOptions - old menu} {
+ catch {destroy .m1}
+ menu .m1
+ list [.m1 configure -fg red] [destroy .m1]
+} {{} {}}
+test menuDraw-5.3 {TkMenuConfigureDrawOptions - no disabledFg} {
+ catch {destroy .m1}
+ list [menu .m1 -disabledforeground ""] [destroy .m1]
+} {.m1 {}}
+
+test menuDraw-6.1 {TkMenuConfigureEntryDrawOptions - no tkfont specified} {
+ catch {destroy .m1}
+ menu .m1
+ list [.m1 add command -label "foo"] [destroy .m1]
+} {{} {}}
+test menuDraw-6.2 {TkMenuConfigureEntryDrawOptions - tkfont specified} {
+ catch {destroy .m1}
+ menu .m1
+ list [.m1 add command -label "foo" -font "Courier 12"] [destroy .m1]
+} {{} {}}
+test menuDraw-6.3 {TkMenuConfigureEntryDrawOptions - active state - wrong entry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "foo"
+ list [.m1 entryconfigure 1 -state active] [destroy .m1]
+} {{} {}}
+test menuDraw-6.4 {TkMenuConfigureEntryDrawOptions - active state - correct entry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "foo"
+ .m1 activate 1
+ list [.m1 entryconfigure 1 -state active] [destroy .m1]
+} {{} {}}
+test menuDraw-6.5 {TkMenuConfigureEntryDrawOptions - deactivate entry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "foo"
+ .m1 activate 1
+ 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}
+ menu .m1
+ list [.m1 add command -label "foo" -background "red"] [destroy .m1]
+} {{} {}}
+test menuDraw-6.9 {TkMenuConfigureEntryDrawOptions - foreground specified} {
+ catch {destroy .m1}
+ menu .m1
+ list [.m1 add command -label "foo" -foreground "red"] [destroy .m1]
+} {{} {}}
+test menuDraw-6.10 {TkMenuConfigureEntryDrawOptions - activeBorder specified} {
+ catch {destroy .m1}
+ menu .m1
+ list [.m1 add command -label "foo" -activebackground "red"] [destroy .m1]
+} {{} {}}
+test menuDraw-6.11 {TkMenuConfigureEntryDrawOptions - activeforeground specified} {
+ catch {destroy .m1}
+ menu .m1
+ list [.m1 add command -label "foo" -activeforeground "red"] [destroy .m1]
+} {{} {}}
+test menuDraw-6.12 {TkMenuConfigureEntryDrawOptions - selectcolor specified} {
+ catch {destroy .m1}
+ menu .m1
+ list [.m1 add radiobutton -label "foo" -selectcolor "red"] [destroy .m1]
+} {{} {}}
+test menuDraw-6.13 {TkMenuConfigureEntryDrawOptions - textGC disposal} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "foo" -font "Helvetica 12"
+ list [.m1 entryconfigure 1 -font "Courier 12"] [destroy .m1]
+} {{} {}}
+test menuDraw-6.14 {TkMenuConfigureEntryDrawOptions - activeGC disposal} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "foo" -activeforeground "red"
+ list [.m1 entryconfigure 1 -activeforeground "green"] [destroy .m1]
+} {{} {}}
+test menuDraw-6.15 {TkMenuConfigureEntryDrawOptions - disabledGC disposal} {
+ catch {destroy .m1}
+ menu .m1 -disabledforeground "red"
+ .m1 add command -label "foo"
+ list [.m1 configure -disabledforeground "green"] [destroy .m1]
+} {{} {}}
+test menuDraw-6.16 {TkMenuConfigureEntryDrawOptions - indicatorGC disposal} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label "foo" -selectcolor "red"
+ list [.m1 entryconfigure 1 -selectcolor "green"] [destroy .m1]
+} {{} {}}
+
+test menuDraw-7.1 {TkEventuallyRecomputeMenu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "This is a long label"
+ set tearoff [tkTearOffMenu .m1]
+ update idletasks
+ list [.m1 entryconfigure 1 -label "foo"] [destroy .m1]
+} {{} {}}
+test menuDraw-7.2 {TkEventuallyRecomputeMenu - update pending} {
+ catch {destroy .m1}
+ 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]
+} {{} {}}
+
+
+test menuDraw-9.1 {TkEventuallyRedrawMenu - entry test} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1
+ set foo 0
+ .m1 add radiobutton -variable foo -label test
+ tkTearOffMenu .m1
+ update idletasks
+ list [set foo test] [destroy .m1] [unset foo]
+} {test {} {}}
+test menuDraw-9.2 {TkEventuallyRedrawMenu - whole menu} {
+ catch {destroy .m1}
+ menu .m1
+ list [catch {tkTearOffMenu .m1}] [destroy .m1]
+} {0 {}}
+
+# Don't know how to test when window has been deleted and ComputeMenuGeometry
+# gets called.
+test menuDraw-10.1 {ComputeMenuGeometry - menubar} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label test
+ . configure -menu .m1
+ list [update idletasks] [. configure -menu ""] [destroy .m1]
+} {{} {} {}}
+test menuDraw-10.2 {ComputeMenuGeometry - non-menubar} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label test
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test menuDraw-10.3 {ComputeMenuGeometry - Resize necessary} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label test
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test menuDraw-10.4 {ComputeMenuGeometry - resize not necessary} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label test
+ update idletasks
+ .m1 entryconfigure 1 -label test
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+
+test menuDraw-11.1 {TkMenuSelectImageProc - entry selected; redraw not pending} {
+ catch {destroy .m1}
+ catch {eval image delete [image names]}
+ image create test image1
+ image create test image2
+ menu .m1
+ .m1 add checkbutton -image image1 -selectimage image2
+ .m1 invoke 1
+ set tearoff [tkTearOffMenu .m1 40 40]
+ update idletasks
+ list [image delete image2] [destroy .m1] [eval image delete [image names]]
+} {{} {} {}}
+test menuDraw-11.2 {TkMenuSelectImageProc - entry selected; redraw pending} {
+ catch {destroy .m1}
+ catch {eval image delete [image names]}
+ image create test image1
+ image create test image2
+ menu .m1
+ .m1 add checkbutton -image image1 -selectimage image2
+ .m1 invoke 1
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [image delete image2] [destroy .m1] [eval image delete [image names]]
+} {{} {} {}}
+test menuDraw-11.3 {TkMenuSelectImageProc - entry not selected} {
+ catch {destroy .m1}
+ catch {eval image delete [image names]}
+ image create test image1
+ image create test image2
+ menu .m1
+ .m1 add checkbutton -image image1 -selectimage image2
+ set tearoff [tkTearOffMenu .m1 40 40]
+ update idletasks
+ list [image delete image2] [destroy .m1] [eval image delete [image names]]
+} {{} {} {}}
+
+#Don't know how to test missing tkwin in DisplayMenu
+test menuDraw-12.1 {DisplayMenu - menubar background} {unixOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label foo -menu .m2
+ . configure -menu .m1
+ list [update] [. configure -menu ""] [destroy .m1]
+} {{} {} {}}
+test menuDraw-12.2 {Display menu - no entries} {
+ catch {destroy .m1}
+ menu .m1
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test menuDraw-12.3 {DisplayMenu - one entry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test menuDraw-12.4 {DisplayMenu - two entries} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "one"
+ .m1 add command -label "two"
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test menuDraw.12.5 {DisplayMenu - two columns - first bigger} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "one"
+ .m1 add command -label "two"
+ .m1 add command -label "three" -columnbreak 1
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test menuDraw-12.5 {DisplayMenu - two column - second bigger} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "one"
+ .m1 add command -label "two" -columnbreak 1
+ .m1 add command -label "three"
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test menuDraw.12.7 {DisplayMenu - three columns} {
+ catch {destroy .m1}
+ menu .m1
+ .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"
+ .m1 add command -label "six"
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test menuDraw-12.6 {Display menu - testing for extra space and menubars} {unixOnly} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label foo
+ . configure -menu .m1
+ list [update] [. configure -menu ""] [destroy .m1]
+} {{} {} {}}
+test menuDraw-12.7 {Display menu - extra space at end of menu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ wm geometry $tearoff 200x100
+ list [update] [destroy .m1]
+} {{} {}}
+
+test menuDraw-13.1 {TkMenuEventProc - Expose} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1
+ .m1 add command -label "one"
+ menu .m2
+ .m2 add command -label "two"
+ set tearoff1 [tkTearOffMenu .m1 40 40]
+ set tearoff2 [tkTearOffMenu .m2 40 40]
+ list [raise $tearoff2] [update] [destroy .m1] [destroy .m2]
+} {{} {} {} {}}
+test menuDraw-13.2 {TkMenuEventProc - ConfigureNotify} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "foo"
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [wm geometry $tearoff 200x100] [update] [destroy .m1]
+} {{} {} {}}
+test menuDraw-13.3 {TkMenuEventProc - ActivateNotify} {macOnly} {
+ catch {destroy .t2}
+ toplevel .t2 -menu .t2.m1
+ menu .t2.m1
+ .t2.m1 add command -label foo
+ tkTearOffMenu .t2.m1 40 40
+ list [catch {update} msg] $msg [destroy .t2]
+} {0 {} {}}
+# Testing deletes is hard, and I am going to do my best. Don't know how
+# to test the case where we have already cleared the tkwin field in the
+# menuPtr.
+test menuDraw-13.4 {TkMenuEventProc - simple delete} {
+ catch {destroy .m1}
+ menu .m1
+ list [destroy .m1]
+} {{}}
+test menuDraw-13.5 {TkMenuEventProc - nothing pending} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ update idletasks
+ list [destroy .m1]
+} {{}}
+
+test menuDraw-14.1 {TkMenuImageProc} {
+ catch {destroy .m1}
+ catch {image delete image1}
+ menu .m1
+ image create test image1
+ .m1 add command -image image1
+ update idletasks
+ list [image delete image1] [destroy .m1]
+} {{} {}}
+test menuDraw-14.2 {TkMenuImageProc} {
+ catch {destroy .m1}
+ catch {image delete image1}
+ menu .m1
+ image create test image1
+ .m1 add command -image image1
+ list [image delete image1] [destroy .m1]
+} {{} {}}
+
+test menuDraw-15.1 {TkPostTearoffMenu - Basic posting} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "foo"
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test menuDraw-15.2 {TkPostTearoffMenu - Deactivation} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "foo" -state active
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [$tearoff index active] [destroy .m1]
+} {none {}}
+test menuDraw-15.3 {TkPostTearoffMenu - post command} {
+ catch {destroy .m1}
+ catch {unset foo}
+ menu .m1 -postcommand "set foo .m1"
+ .m1 add command -label "foo"
+ list [catch {tkTearOffMenu .m1 40 40}] [set foo] [unset foo] [destroy .m1]
+} {0 .m1 {} {}}
+test menuDraw-15.4 {TkPostTearoffMenu - post command deleting the menu} {
+ catch {destroy .m1}
+ menu .m1 -postcommand "destroy .m1"
+ .m1 add command -label "foo"
+ list [catch {tkTearOffMenu .m1 40 40} msg] $msg [winfo exists .m1]
+} {0 {} 0}
+test menuDraw-15.5 {TkPostTearoffMenu - tearoff at edge of screen} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "foo"
+ set height [winfo screenheight .m1]
+ list [catch {tkTearOffMenu .m1 40 $height}] [destroy .m1]
+} {0 {}}
+test menuDraw-15.6 {TkPostTearoffMenu - tearoff off right} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "foo"
+ set width [winfo screenwidth .m1]
+ list [catch {tkTearOffMenu .m1 $width 40}] [destroy .m1]
+} {0 {}}
+
+
+test menuDraw-16.1 {TkPostSubmenu} {unixOnly} {
+ 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]
+ $tearoff postcascade 0
+ list [$tearoff postcascade 0] [destroy .m1] [destroy .m2]
+} {{} {} {}}
+test menuDraw-16.2 {TkPostSubMenu} {unixOnly} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ catch {destroy .m3}
+ menu .m1
+ .m1 add cascade -label "two" -menu .m2
+ .m1 add cascade -label "three" -menu .m3
+ menu .m2
+ .m2 add command -label "two"
+ menu .m3
+ .m3 add command -label "three"
+ set tearoff [tkTearOffMenu .m1 40 40]
+ $tearoff postcascade 0
+ list [$tearoff postcascade 1] [destroy .m1] [destroy .m2] [destroy .m3]
+} {{} {} {} {}}
+test menuDraw-16.3 {TkPostSubMenu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label test -menu .m2
+ list [.m1 postcascade 1] [destroy .m1]
+} {{} {}}
+test menuDraw-16.4 {TkPostSubMenu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label test
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [$tearoff postcascade 0] [destroy .m1]
+} {{} {}}
+test menuDraw-16.5 {TkPostSubMenu} {unixOnly} {
+ catch {destroy .m1}
+ 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]
+ list [$tearoff postcascade 0] [destroy .m1] [destroy .m2]
+} {{} {} {}}
+
+test menuDraw-17.1 {AdjustMenuCoords - menubar} {unixOnly} {
+ catch {destroy .m1}
+ catch {destroy .m2}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label test -menu .m2
+ menu .m2 -tearoff 0
+ .m2 add command -label foo
+ . configure -menu .m1
+ 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
diff --git a/tk/tests/menubut.test b/tk/tests/menubut.test
new file mode 100644
index 00000000000..eb510cfe823
--- /dev/null
+++ b/tk/tests/menubut.test
@@ -0,0 +1,352 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+# 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
+# like border width have predictable values.
+
+option add *Menubutton.borderWidth 2
+option add *Menubutton.highlightThickness 2
+option add *Menubutton.font {Helvetica -12 bold}
+option add *Button.borderWidth 2
+option add *Button.highlightThickness 2
+option add *Button.font {Helvetica -12 bold}
+
+eval image delete [image names]
+image create test image1
+menubutton .mb -text "Test"
+pack .mb
+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"}}
+} {
+ set name [lindex $test 0]
+ test menubutton-1.$i {configuration options} {
+ .mb configure $name [lindex $test 1]
+ lindex [.mb configure $name] 4
+ } [lindex $test 2]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test menubutton-1.$i {configuration options} {
+ list [catch {.mb configure $name [lindex $test 3]} msg] $msg
+ } [list 1 [lindex $test 4]]
+ }
+ .mb configure $name [lindex [.mb configure $name] 3]
+ incr i
+}
+
+test menubutton-2.1 {Tk_MenubuttonCmd procedure} {
+ list [catch {menubutton} msg] $msg
+} {1 {wrong # args: should be "menubutton pathName ?options?"}}
+test menubutton-2.2 {Tk_MenubuttonCmd procedure} {
+ list [catch {menubutton foo} msg] $msg
+} {1 {bad window path name "foo"}}
+test menubutton-2.3 {Tk_MenubuttonCmd procedure} {
+ catch {destroy .mb}
+ menubutton .mb
+ winfo class .mb
+} {Menubutton}
+test menubutton-2.4 {Tk_ButtonCmd procedure} {
+ catch {destroy .mb}
+ list [catch {menubutton .mb -gorp foo} msg] $msg [winfo exists .mb]
+} {1 {unknown option "-gorp"} 0}
+
+catch {destroy .mb}
+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} {
+ list [catch {.mb cget -gorp} msg] $msg
+} {1 {unknown option "-gorp"}}
+test menubutton-3.6 {ButtonWidgetCmd procedure, "cget" option} {
+ .mb configure -highlightthickness 3
+ .mb cget -highlightthickness
+} {3}
+test menubutton-3.7 {ButtonWidgetCmd procedure, "configure" option} {
+ llength [.mb configure]
+} {32}
+test menubutton-3.8 {ButtonWidgetCmd procedure, "configure" option} {
+ list [catch {.mb configure -gorp} msg] $msg
+} {1 {unknown option "-gorp"}}
+test menubutton-3.9 {ButtonWidgetCmd procedure, "configure" option} {
+ list [catch {.mb co -bg #ffffff -fg} msg] $msg
+} {1 {value for "-fg" missing}}
+test menubutton-3.10 {ButtonWidgetCmd procedure, "configure" option} {
+ .mb configure -fg #123456
+ .mb configure -bg #654321
+ lindex [.mb configure -fg] 4
+} {#123456}
+test menubutton-3.11 {ButtonWidgetCmd procedure, "configure" option} {
+ list [catch {.mb foobar} msg] $msg
+} {1 {bad option "foobar": must be cget or configure}}
+
+# XXX Need to add tests for several procedures here. The tests for XXX
+# XXX ConfigureMenuButton aren't complete either. XXX
+
+test menubutton-4.1 {ConfigureMenuButton procedure} {
+ catch {destroy .mb1}
+ button .mb1 -text "Menubutton 1"
+ list [catch {.mb1 configure -width 1i} msg] $msg $errorInfo
+} {1 {expected integer but got "1i"} {expected integer but got "1i"
+ (processing -width option)
+ invoked from within
+".mb1 configure -width 1i"}}
+test menubutton-4.2 {ConfigureMenuButton procedure} {
+ catch {destroy .mb1}
+ button .mb1 -text "Menubutton 1"
+ list [catch {.mb1 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
+".mb1 configure -height 0.5c"}}
+test menubutton-4.3 {ConfigureMenuButton procedure} {
+ catch {destroy .mb1}
+ button .mb1 -bitmap questhead
+ list [catch {.mb1 configure -width abc} msg] $msg $errorInfo
+} {1 {bad screen distance "abc"} {bad screen distance "abc"
+ (processing -width option)
+ invoked from within
+".mb1 configure -width abc"}}
+test menubutton-4.4 {ConfigureMenuButton procedure} {
+ catch {destroy .mb1}
+ eval image delete [image names]
+ image create test image1
+ button .mb1 -image image1
+ list [catch {.mb1 configure -height 0.5x} msg] $msg $errorInfo
+} {1 {bad screen distance "0.5x"} {bad screen distance "0.5x"
+ (processing -height option)
+ invoked from within
+".mb1 configure -height 0.5x"}}
+test menubutton-4.5 {ConfigureMenuButton procedure} {fonts} {
+ catch {destroy .mb1}
+ button .mb1 -text "Sample text" -width 10 -height 2
+ pack .mb1
+ set result "[winfo reqwidth .mb1] [winfo reqheight .mb1]"
+ .mb1 configure -bitmap questhead
+ 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
+ set x {}
+ lappend x [winfo children .]
+ lappend x [.mb2 cget -bg]
+ destroy .mb1
+ lappend x [info command .mb*] [winfo children .]
+} {.mb1 #543210 {} {}}
+
+test menubutton-6.1 {MenuButtonCmdDeletedProc procedure} {
+ eval destroy [winfo children .]
+ menubutton .mb1
+ rename .mb1 {}
+ list [info command .mb*] [winfo children .]
+} {{} {}}
+
+test menubutton-7.1 {ComputeMenuButtonGeometry procedure} {
+ catch {destroy .mb}
+ menubutton .mb -image image1 -bd 4 -highlightthickness 0
+ pack .mb
+ list [winfo reqwidth .mb] [winfo reqheight .mb]
+} {38 23}
+test menubutton-7.2 {ComputeMenuButtonGeometry procedure} {
+ catch {destroy .mb}
+ menubutton .mb -image image1 -bd 1 -highlightthickness 2
+ pack .mb
+ list [winfo reqwidth .mb] [winfo reqheight .mb]
+} {36 21}
+test menubutton-7.3 {ComputeMenuButtonGeometry procedure} {
+ catch {destroy .mb}
+ menubutton .mb -image image1 -bd 0 -highlightthickness 2 -padx 5 -pady 5
+ pack .mb
+ list [winfo reqwidth .mb] [winfo reqheight .mb]
+} {34 19}
+test menubutton-7.4 {ComputeMenuButtonGeometry procedure} {
+ catch {destroy .mb}
+ menubutton .mb -image image1 -bd 2 -relief raised -width 40 \
+ -highlightthickness 2
+ pack .mb
+ list [winfo reqwidth .mb] [winfo reqheight .mb]
+} {48 23}
+test menubutton-7.5 {ComputeMenuButtonGeometry procedure} {
+ catch {destroy .mb}
+ menubutton .mb -image image1 -bd 2 -relief raised -height 30 \
+ -highlightthickness 2
+ pack .mb
+ list [winfo reqwidth .mb] [winfo reqheight .mb]
+} {38 38}
+test menubutton-7.6 {ComputeMenuButtonGeometry procedure} {
+ catch {destroy .mb}
+ menubutton .mb -bitmap question -bd 2 -relief raised \
+ -highlightthickness 2
+ pack .mb
+ list [winfo reqwidth .mb] [winfo reqheight .mb]
+} {25 35}
+test menubutton-7.7 {ComputeMenuButtonGeometry procedure} {
+ catch {destroy .mb}
+ menubutton .mb -bitmap question -bd 2 -relief raised -width 40 \
+ -highlightthickness 1
+ pack .mb
+ list [winfo reqwidth .mb] [winfo reqheight .mb]
+} {46 33}
+test menubutton-7.8 {ComputeMenuButtonGeometry procedure} {
+ catch {destroy .mb}
+ menubutton .mb -bitmap question -bd 2 -relief raised -height 50 \
+ -highlightthickness 1
+ pack .mb
+ list [winfo reqwidth .mb] [winfo reqheight .mb]
+} {23 56}
+test menubutton-7.9 {ComputeMenuButtonGeometry procedure} {fonts} {
+ catch {destroy .mb}
+ menubutton .mb -text String -bd 2 -relief raised -padx 0 -pady 0 \
+ -highlightthickness 1
+ pack .mb
+ list [winfo reqwidth .mb] [winfo reqheight .mb]
+} {42 20}
+test menubutton-7.10 {ComputeMenuButtonGeometry procedure} {fonts} {
+ catch {destroy .mb}
+ menubutton .mb -text String -bd 2 -relief raised -width 20 \
+ -padx 0 -pady 0 -highlightthickness 1
+ pack .mb
+ list [winfo reqwidth .mb] [winfo reqheight .mb]
+} {146 20}
+test menubutton-7.11 {ComputeMenuButtonGeometry procedure} {fonts} {
+ catch {destroy .mb}
+ menubutton .mb -text String -bd 2 -relief raised -height 2 \
+ -padx 0 -pady 0 -highlightthickness 1
+ pack .mb
+ list [winfo reqwidth .mb] [winfo reqheight .mb]
+} {42 34}
+test menubutton-7.12 {ComputeMenuButtonGeometry procedure} {fonts} {
+ catch {destroy .mb}
+ menubutton .mb -text String -bd 2 -relief raised -padx 10 -pady 5 \
+ -highlightthickness 1
+ pack .mb
+ list [winfo reqwidth .mb] [winfo reqheight .mb]
+} {62 30}
+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
+ list [winfo reqwidth .mb] [winfo reqheight .mb]
+} {65 23}
+
+set l [interp hidden]
+eval destroy [winfo children .]
+
+test menubutton-8.1 {menubutton vs hidden commands} {
+ catch {destroy .mb}
+ menubutton .mb
+ interp hide {} .mb
+ destroy .mb
+ list [winfo children .] [interp hidden]
+} [list {} $l]
+
+eval image delete [image names]
+eval destroy [winfo children .]
+option clear
+
diff --git a/tk/tests/msgbox.test b/tk/tests/msgbox.test
new file mode 100644
index 00000000000..26b4746c2f6
--- /dev/null
+++ b/tk/tests/msgbox.test
@@ -0,0 +1,157 @@
+# 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.
+#
+# RCS: @(#) $Id$
+#
+
+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, -modal, -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, -modal, -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
+ }
+}
+
+proc ChooseMsgByKey {parent btn} {
+ global isNative
+ if {!$isNative} {
+ after 100 SendEventToMsg $parent $btn key
+ }
+}
+
+proc PressButton {btn} {
+ event generate $btn <Enter>
+ event generate $btn <ButtonPress-1> -x 5 -y 5
+ event generate $btn <ButtonRelease-1> -x 5 -y 5
+}
+
+proc SendEventToMsg {parent btn type} {
+ if {$parent != "."} {
+ set w $parent.__tk__messagebox
+ } else {
+ set w .__tk__messagebox
+ }
+ if ![winfo ismapped $w.$btn] {
+ update
+ }
+ if {$type == "mouse"} {
+ PressButton $w.$btn
+ } else {
+ event generate $w <Enter>
+ focus $w
+ event generate $w.$btn <Enter>
+ event generate $w <KeyPress> -keysym Return
+ }
+}
+
+set parent .
+
+set specs {
+ {"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"}}
+}
+
+#
+# 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"
+ }
+}
diff --git a/tk/tests/obj.test b/tk/tests/obj.test
new file mode 100644
index 00000000000..1e3c52490c8
--- /dev/null
+++ b/tk/tests/obj.test
@@ -0,0 +1,37 @@
+# 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.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+# SCCS: @(#) obj.test 1.2 97/11/17 11:20:18
+
+if {[info procs test] != "test"} {
+ source defs
+}
+
+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 .]
+
+
diff --git a/tk/tests/oldpack.test b/tk/tests/oldpack.test
new file mode 100644
index 00000000000..0d2f9ccf292
--- /dev/null
+++ b/tk/tests/oldpack.test
@@ -0,0 +1,508 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+label .pack.red.l -text R -bd 2 -relief raised
+place .pack.red.l -relwidth 1.0 -relheight 1.0
+frame .pack.green -width 30 -height 40
+label .pack.green.l -text G -bd 2 -relief raised
+place .pack.green.l -relwidth 1.0 -relheight 1.0
+frame .pack.blue -width 40 -height 40
+label .pack.blue.l -text B -bd 2 -relief raised
+place .pack.blue.l -relwidth 1.0 -relheight 1.0
+frame .pack.violet -width 80 -height 20
+label .pack.violet.l -text P -bd 2 -relief raised
+place .pack.violet.l -relwidth 1.0 -relheight 1.0
+
+test pack-1.1 {basic positioning} {
+ pack ap .pack .pack.red top
+ update
+ winfo geometry .pack.red
+} 10x20+45+0
+test pack-1.2 {basic positioning} {
+ pack append .pack .pack.red bottom
+ update
+ winfo geometry .pack.red
+} 10x20+45+80
+test pack-1.3 {basic positioning} {
+ pack append .pack .pack.red left
+ update
+ winfo geometry .pack.red
+} 10x20+0+40
+test pack-1.4 {basic positioning} {
+ pack append .pack .pack.red right
+ update
+ winfo geometry .pack.red
+} 10x20+90+40
+
+# Try adding padding around the window and make sure that the
+# window gets a larger frame.
+
+test pack-2.1 {padding} {
+ pack append .pack .pack.red {t padx 20}
+ update
+ winfo geometry .pack.red
+} 10x20+45+0
+test pack-2.2 {padding} {
+ pack append .pack .pack.red {top pady 20}
+ update
+ winfo geometry .pack.red
+} 10x20+45+10
+test pack-2.3 {padding} {
+ pack append .pack .pack.red {l padx 20}
+ update
+ winfo geometry .pack.red
+} 10x20+10+40
+test pack-2.4 {padding} {
+ pack append .pack .pack.red {left pady 20}
+ update
+ winfo geometry .pack.red
+} 10x20+0+40
+
+# Position the window at different positions in its frame to
+# make sure they all work. Try two differenet frame locations,
+# to make sure that frame offsets are being added in correctly.
+
+test pack-3.1 {framing} {
+ pack append .pack .pack.red {b padx 20 pady 30}
+ update
+ winfo geometry .pack.red
+} 10x20+45+65
+test pack-3.2 {framing} {
+ pack append .pack .pack.red {bottom padx 20 pady 30 fr n}
+ update
+ winfo geometry .pack.red
+} 10x20+45+50
+test pack-3.3 {framing} {
+ pack append .pack .pack.red {bottom padx 20 pady 30 frame ne}
+ update
+ winfo geometry .pack.red
+} 10x20+90+50
+test pack-3.4 {framing} {
+ pack append .pack .pack.red {bottom padx 20 pady 30 frame e}
+ update
+ winfo geometry .pack.red
+} 10x20+90+65
+test pack-3.5 {framing} {
+ pack append .pack .pack.red {bottom padx 20 pady 30 frame se}
+ update
+ winfo geometry .pack.red
+} 10x20+90+80
+test pack-3.6 {framing} {
+ pack append .pack .pack.red {bottom padx 20 pady 30 frame s}
+ update
+ winfo geometry .pack.red
+} 10x20+45+80
+test pack-3.7 {framing} {
+ pack append .pack .pack.red {bottom padx 20 pady 30 frame sw}
+ update
+ winfo geometry .pack.red
+} 10x20+0+80
+test pack-3.8 {framing} {
+ pack append .pack .pack.red {bottom padx 20 pady 30 frame w}
+ update
+ winfo geometry .pack.red
+} 10x20+0+65
+test pack-3.9 {framing} {
+ pack append .pack .pack.red {bottom padx 20 pady 30 frame nw}
+ update
+ winfo geometry .pack.red
+} 10x20+0+50
+test pack-3.10 {framing} {
+ pack append .pack .pack.red {bottom padx 20 pady 30 frame c}
+ update
+ winfo geometry .pack.red
+} 10x20+45+65
+test pack-3.11 {framing} {
+ pack append .pack .pack.red {r padx 20 pady 30}
+ update
+ winfo geometry .pack.red
+} 10x20+80+40
+test pack-3.12 {framing} {
+ pack append .pack .pack.red {right padx 20 pady 30 frame n}
+ update
+ winfo geometry .pack.red
+} 10x20+80+0
+test pack-3.13 {framing} {
+ pack append .pack .pack.red {right padx 20 pady 30 frame ne}
+ update
+ winfo geometry .pack.red
+} 10x20+90+0
+test pack-3.14 {framing} {
+ pack append .pack .pack.red {right padx 20 pady 30 frame e}
+ update
+ winfo geometry .pack.red
+} 10x20+90+40
+test pack-3.15 {framing} {
+ pack append .pack .pack.red {right padx 20 pady 30 frame se}
+ update
+ winfo geometry .pack.red
+} 10x20+90+80
+test pack-3.16 {framing} {
+ pack append .pack .pack.red {right padx 20 pady 30 frame s}
+ update
+ winfo geometry .pack.red
+} 10x20+80+80
+test pack-3.17 {framing} {
+ pack append .pack .pack.red {right padx 20 pady 30 frame sw}
+ update
+ winfo geometry .pack.red
+} 10x20+70+80
+test pack-3.18 {framing} {
+ pack append .pack .pack.red {right padx 20 pady 30 frame w}
+ update
+ winfo geometry .pack.red
+} 10x20+70+40
+test pack-3.19 {framing} {
+ pack append .pack .pack.red {right padx 20 pady 30 frame nw}
+ update
+ winfo geometry .pack.red
+} 10x20+70+0
+test pack-3.20 {framing} {
+ pack append .pack .pack.red {right padx 20 pady 30 frame center}
+ update
+ winfo geometry .pack.red
+} 10x20+80+40
+
+# Try out various filling combinations in a couple of different
+# frame locations.
+
+test pack-4.1 {filling} {
+ pack append .pack .pack.red {bottom padx 20 pady 30 fillx}
+ update
+ winfo geometry .pack.red
+} 100x20+0+65
+test pack-4.2 {filling} {
+ pack append .pack .pack.red {bottom padx 20 pady 30 filly}
+ update
+ winfo geometry .pack.red
+} 10x50+45+50
+test pack-4.3 {filling} {
+ pack append .pack .pack.red {bottom padx 20 pady 30 fill}
+ update
+ winfo geometry .pack.red
+} 100x50+0+50
+test pack-4.4 {filling} {
+ pack append .pack .pack.red {right padx 20 pady 30 fillx}
+ update
+ winfo geometry .pack.red
+} 30x20+70+40
+test pack-4.5 {filling} {
+ pack append .pack .pack.red {right padx 20 pady 30 filly}
+ update
+ winfo geometry .pack.red
+} 10x100+80+0
+test pack-4.6 {filling} {
+ pack append .pack .pack.red {right padx 20 pady 30 fill}
+ update
+ winfo geometry .pack.red
+} 30x100+70+0
+
+# Multiple windows: make sure that space is properly subtracted
+# from the cavity as windows are positioned inwards from all
+# different sides. Also make sure that windows get unmapped if
+# there isn't enough space for them.
+
+pack append .pack .pack.red top .pack.green top .pack.blue top \
+ .pack.violet top
+update
+test pack-5.1 {multiple windows} {winfo geometry .pack.red} 10x20+45+0
+test pack-5.2 {multiple windows} {winfo geometry .pack.green} 30x40+35+20
+test pack-5.3 {multiple windows} {winfo geometry .pack.blue} 40x40+30+60
+test pack-5.4 {multiple windows} {winfo ismapped .pack.violet} 0
+pack b .pack.blue .pack.violet top
+update
+test pack-5.5 {multiple windows} {winfo ismapped .pack.violet} 1
+test pack-5.6 {multiple windows} {winfo geometry .pack.violet} 80x20+10+60
+test pack-5.7 {multiple windows} {winfo geometry .pack.blue} 40x20+30+80
+pack after .pack.blue .pack.red top
+update
+test pack-5.8 {multiple windows} {winfo geometry .pack.green} 30x40+35+0
+test pack-5.9 {multiple windows} {winfo geometry .pack.violet} 80x20+10+40
+test pack-5.10 {multiple windows} {winfo geometry .pack.blue} 40x40+30+60
+test pack-5.11 {multiple windows} {winfo ismapped .pack.red} 0
+pack before .pack.green .pack.red right .pack.blue left
+update
+test pack-5.12 {multiple windows} {winfo ismapped .pack.red} 1
+test pack-5.13 {multiple windows} {winfo geometry .pack.red} 10x20+90+40
+test pack-5.14 {multiple windows} {winfo geometry .pack.blue} 40x40+0+30
+test pack-5.15 {multiple windows} {winfo geometry .pack.green} 30x40+50+0
+test pack-5.16 {multiple windows} {winfo geometry .pack.violet} 50x20+40+40
+pack append .pack .pack.violet left .pack.green bottom .pack.red bottom \
+ .pack.blue bottom
+update
+test pack-5.17 {multiple windows} {winfo geometry .pack.violet} 80x20+0+40
+test pack-5.18 {multiple windows} {winfo geometry .pack.green} 20x40+80+60
+test pack-5.19 {multiple windows} {winfo geometry .pack.red} 10x20+85+40
+test pack-5.20 {multiple windows} {winfo geometry .pack.blue} 20x40+80+0
+pack after .pack.blue .pack.blue top .pack.red right .pack.green right \
+ .pack.violet right
+update
+test pack-5.21 {multiple windows} {winfo geometry .pack.blue} 40x40+30+0
+test pack-5.22 {multiple windows} {winfo geometry .pack.red} 10x20+90+60
+test pack-5.23 {multiple windows} {winfo geometry .pack.green} 30x40+60+50
+test pack-5.24 {multiple windows} {winfo geometry .pack.violet} 60x20+0+60
+pack after .pack.blue .pack.red left .pack.green left .pack.violet left
+update
+test pack-5.25 {multiple windows} {winfo geometry .pack.blue} 40x40+30+0
+test pack-5.26 {multiple windows} {winfo geometry .pack.red} 10x20+0+60
+test pack-5.27 {multiple windows} {winfo geometry .pack.green} 30x40+10+50
+test pack-5.28 {multiple windows} {winfo geometry .pack.violet} 60x20+40+60
+pack append .pack .pack.violet left .pack.green left .pack.blue left \
+ .pack.red left
+update
+test pack-5.29 {multiple windows} {winfo geometry .pack.violet} 80x20+0+40
+test pack-5.30 {multiple windows} {winfo geometry .pack.green} 20x40+80+30
+test pack-5.31 {multiple windows} {winfo ismapped .pack.blue} 0
+test pack-5.32 {multiple windows} {winfo ismapped .pack.red} 0
+
+
+# Test the ability of the packer to propagate geometry information
+# to its parent. Make sure it computes the parent's needs both in
+# the direction of packing (width for "left" and "right" windows,
+# for example), and perpendicular to the pack direction (height for
+# "left" and "right" windows).
+
+pack append .pack .pack.red top .pack.green top .pack.blue top \
+ .pack.violet top
+update
+test pack-6.1 {geometry propagation} {winfo reqwidth .pack} 80
+test pack-6.2 {geometry propagation} {winfo reqheight .pack} 120
+destroy .pack.violet
+update
+test pack-6.3 {geometry propagation} {winfo reqwidth .pack} 40
+test pack-6.4 {geometry propagation} {winfo reqheight .pack} 100
+frame .pack.violet -width 80 -height 20 -bg violet
+label .pack.violet.l -text P -bd 2 -relief raised
+place .pack.violet.l -relwidth 1.0 -relheight 1.0
+pack append .pack .pack.red left .pack.green right .pack.blue bottom \
+ .pack.violet top
+update
+test pack-6.5 {geometry propagation} {winfo reqwidth .pack} 120
+test pack-6.6 {geometry propagation} {winfo reqheight .pack} 60
+pack append .pack .pack.violet top .pack.green top .pack.blue left \
+ .pack.red left
+update
+test pack-6.7 {geometry propagation} {winfo reqwidth .pack} 80
+test pack-6.8 {geometry propagation} {winfo reqheight .pack} 100
+
+# Test the "expand" option, and make sure space is evenly divided
+# when several windows request expansion.
+
+pack append .pack .pack.violet top .pack.green {left e} \
+ .pack.blue {left expand} .pack.red {left expand}
+update
+test pack-7.1 {multiple expanded windows} {
+ pack append .pack .pack.violet top .pack.green {left e} \
+ .pack.blue {left expand} .pack.red {left expand}
+ update
+ list [winfo geometry .pack.green] [winfo geometry .pack.blue] \
+ [winfo geometry .pack.red]
+} {30x40+3+40 40x40+39+40 10x20+86+50}
+test pack-7.2 {multiple expanded windows} {
+ pack append .pack .pack.green left .pack.violet {bottom expand} \
+ .pack.blue {bottom expand} .pack.red {bottom expand}
+ update
+ list [winfo geometry .pack.violet] [winfo geometry .pack.blue] \
+ [winfo geometry .pack.red]
+} {70x20+30+77 40x40+45+30 10x20+60+3}
+test pack-7.3 {multiple expanded windows} {
+ foreach i [winfo child .pack] {
+ pack unpack $i
+ }
+ pack append .pack .pack.green {left e fill} .pack.red {left expand fill} \
+ .pack.blue {top fill}
+ update
+ list [winfo geometry .pack.green] [winfo geometry .pack.red] \
+ [winfo geometry .pack.blue]
+} {40x100+0+0 20x100+40+0 40x40+60+0}
+test pack-7.4 {multiple expanded windows} {
+ foreach i [winfo child .pack] {
+ pack unpack $i
+ }
+ pack append .pack .pack.red {top expand} .pack.violet {top expand} \
+ .pack.blue {right fill}
+ update
+ list [winfo geometry .pack.red] [winfo geometry .pack.violet] \
+ [winfo geometry .pack.blue]
+} {10x20+45+5 80x20+10+35 40x40+60+60}
+test pack-7.5 {multiple expanded windows} {
+ foreach i [winfo child .pack] {
+ pack unpack $i
+ }
+ pack append .pack .pack.green {right frame s} .pack.red {top expand}
+ update
+ list [winfo geometry .pack.green] [winfo geometry .pack.red]
+} {30x40+70+60 10x20+30+40}
+test pack-7.6 {multiple expanded windows} {
+ foreach i [winfo child .pack] {
+ pack unpack $i
+ }
+ pack append .pack .pack.violet {bottom frame e} .pack.red {right expand}
+ update
+ list [winfo geometry .pack.violet] [winfo geometry .pack.red]
+} {80x20+20+80 10x20+45+30}
+
+# Need more bizarre tests with combinations of expanded windows and
+# windows in opposing directions! Also, include padding in expanded
+# (and unexpanded) windows.
+
+# Syntax errors on pack commands
+
+test pack-8.1 {syntax errors} {
+ set msg ""
+ set result [catch {pack} msg]
+ concat $result $msg
+} {1 wrong # args: should be "pack option arg ?arg ...?"}
+test pack-8.2 {syntax errors} {
+ set msg ""
+ set result [catch {pack append} msg]
+ concat $result $msg
+} {1 wrong # args: should be "pack option arg ?arg ...?"}
+test pack-8.3 {syntax errors} {
+ set msg ""
+ set result [catch {pack gorp foo} msg]
+ concat $result $msg
+} {1 bad option "gorp": must be configure, forget, info, propagate, or slaves}
+test pack-8.4 {syntax errors} {
+ set msg ""
+ set result [catch {pack a .pack} msg]
+ concat $result $msg
+} {1 bad option "a": must be configure, forget, info, propagate, or slaves}
+test pack-8.5 {syntax errors} {
+ set msg ""
+ set result [catch {pack after foobar} msg]
+ concat $result $msg
+} {1 bad window path name "foobar"}
+test pack-8.6 {syntax errors} {
+ frame .pack.yellow -bg yellow
+ set msg ""
+ set result [catch {pack after .pack.yellow} msg]
+ destroy .pack.yellow
+ concat $result $msg
+} {1 window ".pack.yellow" isn't packed}
+test pack-8.7 {syntax errors} {
+ set msg ""
+ set result [catch {pack append foobar} msg]
+ concat $result $msg
+} {1 bad window path name "foobar"}
+test pack-8.8 {syntax errors} {
+ set msg ""
+ set result [catch {pack before foobar} msg]
+ concat $result $msg
+} {1 bad window path name "foobar"}
+test pack-8.9 {syntax errors} {
+ frame .pack.yellow -bg yellow
+ set msg ""
+ set result [catch {pack before .pack.yellow} msg]
+ destroy .pack.yellow
+ concat $result $msg
+} {1 window ".pack.yellow" isn't packed}
+test pack-8.10 {syntax errors} {
+ set msg ""
+ set result [catch {pack info .pack help} msg]
+ concat $result $msg
+} {1 wrong # args: should be "pack info window"}
+test pack-8.11 {syntax errors} {
+ set msg ""
+ set result [catch {pack info foobar} msg]
+ concat $result $msg
+} {1 bad window path name "foobar"}
+test pack-8.12 {syntax errors} {
+ set msg ""
+ set result [catch {pack append .pack .pack.blue} msg]
+ concat $result $msg
+} {1 wrong # args: window ".pack.blue" should be followed by options}
+test pack-8.13 {syntax errors} {
+ set msg ""
+ set result [catch {pack append . .pack.blue top} msg]
+ concat $result $msg
+} {1 can't pack .pack.blue inside .}
+test pack-8.14 {syntax errors} {
+ set msg ""
+ set result [catch {pack append .pack .pack.blue f} msg]
+ concat $result $msg
+} {1 bad option "f": should be top, bottom, left, right, expand, fill, fillx, filly, padx, pady, or frame}
+test pack-8.15 {syntax errors} {
+ set msg ""
+ set result [catch {pack append .pack .pack.blue pad} msg]
+ concat $result $msg
+} {1 bad option "pad": should be top, bottom, left, right, expand, fill, fillx, filly, padx, pady, or frame}
+test pack-8.16 {syntax errors} {
+ set msg ""
+ set result [catch {pack append .pack .pack.blue {frame south}} msg]
+ concat $result $msg
+} {1 bad anchor position "south": must be n, ne, e, se, s, sw, w, nw, or center}
+test pack-8.17 {syntax errors} {
+ set msg ""
+ set result [catch {pack append .pack .pack.blue {padx -2}} msg]
+ concat $result $msg
+} {1 bad pad value "-2": must be positive screen distance}
+test pack-8.18 {syntax errors} {
+ set msg ""
+ set result [catch {pack append .pack .pack.blue {padx}} msg]
+ concat $result $msg
+} {1 wrong # args: "padx" option must be followed by screen distance}
+test pack-8.19 {syntax errors} {
+ set msg ""
+ set result [catch {pack append .pack .pack.blue {pady -2}} msg]
+ concat $result $msg
+} {1 bad pad value "-2": must be positive screen distance}
+test pack-8.20 {syntax errors} {
+ set msg ""
+ set result [catch {pack append .pack .pack.blue {pady}} msg]
+ concat $result $msg
+} {1 wrong # args: "pady" option must be followed by screen distance}
+test pack-8.21 {syntax errors} {
+ set msg ""
+ set result [catch {pack append .pack .pack.blue "\{abc"} msg]
+ concat $result $msg
+} {1 unmatched open brace in list}
+test pack-8.22 {syntax errors} {
+ set msg ""
+ set result [catch {pack append .pack .pack.blue frame} msg]
+ concat $result $msg
+} {1 wrong # args: "frame" option must be followed by anchor point}
+
+# Test "pack info" command output.
+
+test pack-9.1 {information output} {
+ pack append .pack .pack.blue {top fillx frame n} \
+ .pack.red {bottom filly frame s} .pack.green {left fill frame w} \
+ .pack.violet {right expand frame e}
+ 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 n -expand 0 -fill x -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor s -expand 0 -fill y -ipadx 0 -ipady 0 -padx 0 -pady 0 -side bottom} {-in .pack -anchor w -expand 0 -fill both -ipadx 0 -ipady 0 -padx 0 -pady 0 -side left} {-in .pack -anchor e -expand 1 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side right}}
+test pack-9.2 {information output} {
+ pack append .pack .pack.blue {padx 10 frame nw} \
+ .pack.red {pady 20 frame ne} .pack.green {frame se} \
+ .pack.violet {frame sw}
+ 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 nw -expand 0 -fill none -ipadx 0 -ipady 0 -padx 5 -pady 0 -side top} {-in .pack -anchor ne -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 10 -side top} {-in .pack -anchor se -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top} {-in .pack -anchor sw -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top}}
+test pack-9.3 {information output} {
+ 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 {}
diff --git a/tk/tests/option.file1 b/tk/tests/option.file1
new file mode 100644
index 00000000000..e64b6cc38ef
--- /dev/null
+++ b/tk/tests/option.file1
@@ -0,0 +1,17 @@
+! This file is a sample option (resource) database used to test
+! Tk's option-handling capabilities.
+
+! Comment line \
+ with a backslash-newline sequence embedded in it.
+
+*x1: blue
+ tktest.x2 : green
+*\
+x3 \
+ : pur\
+ple
+*x 4: brown
+# More comments, this time delimited by hash-marks.
+ # Comment-line with space.
+*x6:
+# comment line as last line of file.
diff --git a/tk/tests/option.file2 b/tk/tests/option.file2
new file mode 100644
index 00000000000..f1d020a89a1
--- /dev/null
+++ b/tk/tests/option.file2
@@ -0,0 +1,2 @@
+*foo1: magenta
+foo2 missing colon
diff --git a/tk/tests/option.test b/tk/tests/option.test
new file mode 100644
index 00000000000..42c4d3bc980
--- /dev/null
+++ b/tk/tests/option.test
@@ -0,0 +1,232 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+# everything in-between).
+
+frame .op1 -class Class1
+frame .op2 -class Class2
+frame .op1.op3 -class Class1
+frame .op1.op4 -class Class3
+frame .op2.op5 -class Class2
+frame .op1.op3.op6 -class Class4
+
+option clear
+option add *Color1 red
+option add *x blue
+option add *Class1.x yellow
+option add $appName.op1.x green
+option add *Class2.Color1 orange
+option add $appName.op2.op5.Color2 purple
+option add $appName.Class1.Class3.y brown
+option add $appName*op6*Color2 black
+option add $appName*Class1.op1.Color2 grey
+
+test option-1.1 {basic option retrieval} {option get . x Color1} blue
+test option-1.2 {basic option retrieval} {option get . y Color1} red
+test option-1.3 {basic option retrieval} {option get . z Color1} red
+test option-1.4 {basic option retrieval} {option get . x Color2} blue
+test option-1.5 {basic option retrieval} {option get . y Color2} {}
+test option-1.6 {basic option retrieval} {option get . z Color2} {}
+
+test option-2.1 {basic option retrieval} {option get .op1 x Color1} green
+test option-2.2 {basic option retrieval} {option get .op1 y Color1} red
+test option-2.3 {basic option retrieval} {option get .op1 z Color1} red
+test option-2.4 {basic option retrieval} {option get .op1 x Color2} green
+test option-2.5 {basic option retrieval} {option get .op1 y Color2} {}
+test option-2.6 {basic option retrieval} {option get .op1 z Color2} {}
+
+test option-3.1 {basic option retrieval} {option get .op1.op3 x Color1} yellow
+test option-3.2 {basic option retrieval} {option get .op1.op3 y Color1} red
+test option-3.3 {basic option retrieval} {option get .op1.op3 z Color1} red
+test option-3.4 {basic option retrieval} {option get .op1.op3 x Color2} yellow
+test option-3.5 {basic option retrieval} {option get .op1.op3 y Color2} {}
+test option-3.6 {basic option retrieval} {option get .op1.op3 z Color2} {}
+
+test option-4.1 {basic option retrieval} {option get .op1.op3.op6 x Color1} blue
+test option-4.2 {basic option retrieval} {option get .op1.op3.op6 y Color1} red
+test option-4.3 {basic option retrieval} {option get .op1.op3.op6 z Color1} red
+test option-4.4 {basic option retrieval} {option get .op1.op3.op6 x Color2} black
+test option-4.5 {basic option retrieval} {option get .op1.op3.op6 y Color2} black
+test option-4.6 {basic option retrieval} {option get .op1.op3.op6 z Color2} black
+
+test option-5.1 {basic option retrieval} {option get .op1.op4 x Color1} blue
+test option-5.2 {basic option retrieval} {option get .op1.op4 y Color1} brown
+test option-5.3 {basic option retrieval} {option get .op1.op4 z Color1} red
+test option-5.4 {basic option retrieval} {option get .op1.op4 x Color2} blue
+test option-5.5 {basic option retrieval} {option get .op1.op4 y Color2} brown
+test option-5.6 {basic option retrieval} {option get .op1.op4 z Color2} {}
+
+test option-6.1 {basic option retrieval} {option get .op2 x Color1} orange
+test option-6.2 {basic option retrieval} {option get .op2 y Color1} orange
+test option-6.3 {basic option retrieval} {option get .op2 z Color1} orange
+test option-6.4 {basic option retrieval} {option get .op2 x Color2} blue
+test option-6.5 {basic option retrieval} {option get .op2 y Color2} {}
+test option-6.6 {basic option retrieval} {option get .op2 z Color2} {}
+
+test option-7.1 {basic option retrieval} {option get .op2.op5 x Color1} orange
+test option-7.2 {basic option retrieval} {option get .op2.op5 y Color1} orange
+test option-7.3 {basic option retrieval} {option get .op2.op5 z Color1} orange
+test option-7.4 {basic option retrieval} {option get .op2.op5 x Color2} purple
+test option-7.5 {basic option retrieval} {option get .op2.op5 y Color2} purple
+test option-7.6 {basic option retrieval} {option get .op2.op5 z Color2} purple
+
+# Now try similar tests to above, except jump around non-hierarchically
+# between windows to make sure that the option stacks are pushed and
+# popped correctly.
+
+option get . foo Foo
+test option-8.1 {stack pushing/popping} {option get .op2.op5 x Color1} orange
+test option-8.2 {stack pushing/popping} {option get .op2.op5 y Color1} orange
+test option-8.3 {stack pushing/popping} {option get .op2.op5 z Color1} orange
+test option-8.4 {stack pushing/popping} {option get .op2.op5 x Color2} purple
+test option-8.5 {stack pushing/popping} {option get .op2.op5 y Color2} purple
+test option-8.6 {stack pushing/popping} {option get .op2.op5 z Color2} purple
+
+test option-9.1 {stack pushing/popping} {option get . x Color1} blue
+test option-9.2 {stack pushing/popping} {option get . y Color1} red
+test option-9.3 {stack pushing/popping} {option get . z Color1} red
+test option-9.4 {stack pushing/popping} {option get . x Color2} blue
+test option-9.5 {stack pushing/popping} {option get . y Color2} {}
+test option-9.6 {stack pushing/popping} {option get . z Color2} {}
+
+test option-10.1 {stack pushing/popping} {option get .op1.op3.op6 x Color1} blue
+test option-10.2 {stack pushing/popping} {option get .op1.op3.op6 y Color1} red
+test option-10.3 {stack pushing/popping} {option get .op1.op3.op6 z Color1} red
+test option-10.4 {stack pushing/popping} {option get .op1.op3.op6 x Color2} black
+test option-10.5 {stack pushing/popping} {option get .op1.op3.op6 y Color2} black
+test option-10.6 {stack pushing/popping} {option get .op1.op3.op6 z Color2} black
+
+test option-11.1 {stack pushing/popping} {option get .op1.op3 x Color1} yellow
+test option-11.2 {stack pushing/popping} {option get .op1.op3 y Color1} red
+test option-11.3 {stack pushing/popping} {option get .op1.op3 z Color1} red
+test option-11.4 {stack pushing/popping} {option get .op1.op3 x Color2} yellow
+test option-11.5 {stack pushing/popping} {option get .op1.op3 y Color2} {}
+test option-11.6 {stack pushing/popping} {option get .op1.op3 z Color2} {}
+
+test option-12.1 {stack pushing/popping} {option get .op1 x Color1} green
+test option-12.2 {stack pushing/popping} {option get .op1 y Color1} red
+test option-12.3 {stack pushing/popping} {option get .op1 z Color1} red
+test option-12.4 {stack pushing/popping} {option get .op1 x Color2} green
+test option-12.5 {stack pushing/popping} {option get .op1 y Color2} {}
+test option-12.6 {stack pushing/popping} {option get .op1 z Color2} {}
+
+# Test the major priority levels (widgetDefault, etc.)
+
+option add $appName.op1.a 100 100
+option add $appName.op1.A interactive interactive
+option add $appName.op1.b userDefault userDefault
+option add $appName.op1.B startupFile startupFile
+option add $appName.op1.c widgetDefault widgetDefault
+option add $appName.op1.C 0 0
+
+test option-13.1 {priority levels} {option get .op1 a A} 100
+test option-13.2 {priority levels} {option get .op1 b A} interactive
+test option-13.3 {priority levels} {option get .op1 b B} userDefault
+test option-13.4 {priority levels} {option get .op1 c B} startupFile
+test option-13.5 {priority levels} {option get .op1 c C} widgetDefault
+option add $appName.op1.B file2 widget
+test option-13.6 {priority levels} {option get .op1 c B} startupFile
+option add $appName.op1.B file2 startupFile
+test option-13.7 {priority levels} {option get .op1 c B} file2
+
+# Test various error conditions
+
+test option-14.1 {error conditions} {
+ list [catch {option} msg] $msg
+} {1 {wrong # args: should be "option cmd arg ?arg ...?"}}
+test option-14.2 {error conditions} {
+ list [catch {option x} msg] $msg
+} {1 {bad option "x": must be add, clear, get, or readfile}}
+test option-14.3 {error conditions} {
+ list [catch {option foo 3} msg] $msg
+} {1 {bad option "foo": must be add, clear, get, or readfile}}
+test option-14.4 {error conditions} {
+ list [catch {option add 3} msg] $msg
+} {1 {wrong # args: should be "option add pattern value ?priority?"}}
+test option-14.5 {error conditions} {
+ list [catch {option add . a b c} msg] $msg
+} {1 {wrong # args: should be "option add pattern value ?priority?"}}
+test option-14.6 {error conditions} {
+ list [catch {option add . a -1} msg] $msg
+} {1 {bad priority level "-1": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}}
+test option-14.7 {error conditions} {
+ list [catch {option add . a 101} msg] $msg
+} {1 {bad priority level "101": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}}
+test option-14.8 {error conditions} {
+ list [catch {option add . a gorp} msg] $msg
+} {1 {bad priority level "gorp": must be widgetDefault, startupFile, userDefault, interactive, or a number between 0 and 100}}
+test option-14.9 {error conditions} {
+ list [catch {option get 3} msg] $msg
+} {1 {wrong # args: should be "option get window name class"}}
+test option-14.10 {error conditions} {
+ list [catch {option get 3 4} msg] $msg
+} {1 {wrong # args: should be "option get window name class"}}
+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"} {
+ test option-15.3 {database files} {option get . x2 color} green
+}
+test option-15.4 {database files} {option get . x3 color} purple
+test option-15.5 {database files} {option get . {x 4} color} brown
+test option-15.6 {database files} {option get . x6 color} {}
+test option-15.7 {database files} {
+ list [catch {option read $option1 widget foo} msg] $msg
+} {1 {wrong # args: should be "option readfile fileName ?priority?"}}
+option add *x3 burgundy
+catch {option read $option1 userDefault}
+test option-15.8 {database files} {option get . x3 color} burgundy
+test option-15.9 {database files} {
+ list [catch {option read $option2} msg] $msg
+} {1 {missing colon on line 2}}
+
+test option-16.1 {ReadOptionFile} {
+ set file [open "$option3" w]
+ fconfigure $file -translation crlf
+ puts $file "*x7: true\n*x8: false"
+ close $file
+ option read $option3 userDefault
+ set result [list [option get . x7 color] [option get . x8 color]]
+ removeFile $option3
+ set result
+} {true false}
+
+catch {destroy .op1}
+catch {destroy .op2}
+concat {}
diff --git a/tk/tests/pack.test b/tk/tests/pack.test
new file mode 100644
index 00000000000..e4f604ef062
--- /dev/null
+++ b/tk/tests/pack.test
@@ -0,0 +1,969 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+ update
+ list [winfo geometry .pack.a] [winfo geometry .pack.b]
+}
+proc pack2 {args} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ eval pack .pack.a $args
+ update
+ winfo geometry .pack.a
+}
+proc pack3 {args} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -side top
+ pack .pack.c -side left
+ eval pack .pack.b $args
+ update
+ winfo geometry .pack.b
+}
+proc pack4 {option value} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a $option $value
+ set i [pack info .pack.a]
+ lindex $i [expr [lsearch -exact $i $option]+1]
+}
+
+# Create some test windows.
+
+catch {destroy .pack}
+toplevel .pack
+wm geom .pack 300x200+0+0
+wm minsize .pack 1 1
+update idletasks
+foreach i {a b c d} {
+ frame .pack.$i
+ label .pack.$i.label -text $i -relief raised
+ place .pack.$i.label -relwidth 1.0 -relheight 1.0
+}
+.pack.a config -width 20 -height 40
+.pack.b config -width 50 -height 30
+.pack.c config -width 80 -height 80
+.pack.d config -width 40 -height 30
+
+test pack-1.1 {-side option} {
+ pack1 -side top
+} {20x40+140+0 300x160+0+40}
+test pack-1.2 {-side option} {
+ pack1 -side bottom
+} {20x40+140+160 300x160+0+0}
+test pack-1.3 {-side option} {
+ pack1 -side left
+} {20x40+0+80 280x200+20+0}
+test pack-1.4 {-side option} {
+ pack1 -side right
+} {20x40+280+80 280x200+0+0}
+
+test pack-2.1 {x padding and filling} {
+ pack1 -side right -padx 20
+} {20x40+260+80 240x200+0+0}
+test pack-2.2 {x padding and filling} {
+ pack1 -side right -ipadx 20
+} {60x40+240+80 240x200+0+0}
+test pack-2.3 {x padding and filling} {
+ pack1 -side right -ipadx 5 -padx 10
+} {30x40+260+80 250x200+0+0}
+test pack-2.4 {x padding and filling} {
+ pack1 -side right -padx 20 -fill x
+} {20x40+260+80 240x200+0+0}
+test pack-2.5 {x padding and filling} {
+ pack1 -side right -ipadx 20 -fill x
+} {60x40+240+80 240x200+0+0}
+test pack-2.6 {x padding and filling} {
+ pack1 -side right -ipadx 5 -padx 10 -fill x
+} {30x40+260+80 250x200+0+0}
+test pack-2.7 {x padding and filling} {
+ pack1 -side top -padx 20
+} {20x40+140+0 300x160+0+40}
+test pack-2.8 {x padding and filling} {
+ pack1 -side top -ipadx 20
+} {60x40+120+0 300x160+0+40}
+test pack-2.9 {x padding and filling} {
+ pack1 -side top -ipadx 5 -padx 10
+} {30x40+135+0 300x160+0+40}
+test pack-2.10 {x padding and filling} {
+ pack1 -side top -padx 20 -fill x
+} {260x40+20+0 300x160+0+40}
+test pack-2.11 {x padding and filling} {
+ pack1 -side top -ipadx 20 -fill x
+} {300x40+0+0 300x160+0+40}
+test pack-2.12 {x padding and filling} {
+ pack1 -side top -ipadx 5 -padx 10 -fill x
+} {280x40+10+0 300x160+0+40}
+set pad [winfo pixels .pack 1c]
+test pack-2.13 {x padding and filling} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -padx 1c
+ set x [pack info .pack.a]
+ lindex $x [expr [lsearch -exact $x -padx]+1]
+} $pad
+test pack-2.14 {x padding and filling} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -ipadx 1c
+ set x [pack info .pack.a]
+ lindex $x [expr [lsearch -exact $x -ipadx]+1]
+} $pad
+
+test pack-3.1 {y padding and filling} {
+ pack1 -side right -pady 20
+} {20x40+280+80 280x200+0+0}
+test pack-3.2 {y padding and filling} {
+ pack1 -side right -ipady 20
+} {20x80+280+60 280x200+0+0}
+test pack-3.3 {y padding and filling} {
+ pack1 -side right -ipady 5 -pady 10
+} {20x50+280+75 280x200+0+0}
+test pack-3.4 {y padding and filling} {
+ pack1 -side right -pady 20 -fill y
+} {20x160+280+20 280x200+0+0}
+test pack-3.5 {y padding and filling} {
+ pack1 -side right -ipady 20 -fill y
+} {20x200+280+0 280x200+0+0}
+test pack-3.6 {y padding and filling} {
+ pack1 -side right -ipady 5 -pady 10 -fill y
+} {20x180+280+10 280x200+0+0}
+test pack-3.7 {y padding and filling} {
+ pack1 -side top -pady 20
+} {20x40+140+20 300x120+0+80}
+test pack-3.8 {y padding and filling} {
+ pack1 -side top -ipady 20
+} {20x80+140+0 300x120+0+80}
+test pack-3.9 {y padding and filling} {
+ pack1 -side top -ipady 5 -pady 10
+} {20x50+140+10 300x130+0+70}
+test pack-3.10 {y padding and filling} {
+ pack1 -side top -pady 20 -fill y
+} {20x40+140+20 300x120+0+80}
+test pack-3.11 {y padding and filling} {
+ pack1 -side top -ipady 20 -fill y
+} {20x80+140+0 300x120+0+80}
+test pack-3.12 {y padding and filling} {
+ pack1 -side top -ipady 5 -pady 10 -fill y
+} {20x50+140+10 300x130+0+70}
+set pad [winfo pixels .pack 1c]
+test pack-3.13 {y padding and filling} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -pady 1c
+ set x [pack info .pack.a]
+ lindex $x [expr [lsearch -exact $x -pady]+1]
+} $pad
+test pack-3.14 {y padding and filling} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -ipady 1c
+ set x [pack info .pack.a]
+ lindex $x [expr [lsearch -exact $x -ipady]+1]
+} $pad
+
+test pack-4.1 {anchors} {
+ pack2 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor n
+} {30x70+135+20}
+test pack-4.2 {anchors} {
+ pack2 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor ne
+} {30x70+260+20}
+test pack-4.3 {anchors} {
+ pack2 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor e
+} {30x70+260+65}
+test pack-4.4 {anchors} {
+ pack2 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor se
+} {30x70+260+110}
+test pack-4.5 {anchors} {
+ pack2 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor s
+} {30x70+135+110}
+test pack-4.6 {anchors} {
+ pack2 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor sw
+} {30x70+10+110}
+test pack-4.7 {anchors} {
+ pack2 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor w
+} {30x70+10+65}
+test pack-4.8 {anchors} {
+ pack2 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor nw
+} {30x70+10+20}
+test pack-4.9 {anchors} {
+ pack2 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor center
+} {30x70+135+65}
+
+# Repeat above tests, but with a frame that isn't at (0,0), so that
+# we can be sure that the frame offset is being added in correctly.
+
+test pack-5.1 {more anchors} {
+ pack3 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor n
+} {60x60+160+60}
+test pack-5.2 {more anchors} {
+ pack3 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor ne
+} {60x60+230+60}
+test pack-5.3 {more anchors} {
+ pack3 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor e
+} {60x60+230+90}
+test pack-5.4 {more anchors} {
+ pack3 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor se
+} {60x60+230+120}
+test pack-5.5 {more anchors} {
+ pack3 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor s
+} {60x60+160+120}
+test pack-5.6 {more anchors} {
+ pack3 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor sw
+} {60x60+90+120}
+test pack-5.7 {more anchors} {
+ pack3 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor w
+} {60x60+90+90}
+test pack-5.8 {more anchors} {
+ pack3 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor nw
+} {60x60+90+60}
+test pack-5.9 {more anchors} {
+ pack3 -side top -ipadx 5 -padx 10 -ipady 15 -pady 20 -expand y -anchor center
+} {60x60+160+90}
+
+test pack-6.1 {-expand option} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c .pack.d -side left
+ update
+ list [winfo geometry .pack.a] [winfo geometry .pack.b] \
+ [winfo geometry .pack.c] [winfo geometry .pack.d]
+} {20x40+0+80 50x30+20+85 80x80+70+60 40x30+150+85}
+test pack-6.2 {-expand option} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -side left -expand yes
+ pack .pack.b -side left
+ pack .pack.c .pack.d -side left -expand 1
+ update
+ list [winfo geometry .pack.a] [winfo geometry .pack.b] \
+ [winfo geometry .pack.c] [winfo geometry .pack.d]
+} {20x40+18+80 50x30+56+85 80x80+124+60 40x30+241+85}
+test pack-6.3 {-expand option} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c .pack.d -side top
+ update
+ list [winfo geometry .pack.a] [winfo geometry .pack.b] \
+ [winfo geometry .pack.c] [winfo geometry .pack.d]
+} {20x40+140+0 50x30+125+40 80x80+110+70 40x30+130+150}
+test pack-6.4 {-expand option} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -side top -expand yes
+ pack .pack.b -side top
+ pack .pack.c .pack.d -side top -expand 1
+ update
+ list [winfo geometry .pack.a] [winfo geometry .pack.b] \
+ [winfo geometry .pack.c] [winfo geometry .pack.d]
+} {20x40+140+3 50x30+125+46 80x80+110+79 40x30+130+166}
+test pack-6.5 {-expand option} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c .pack.d -side right
+ update
+ list [winfo geometry .pack.a] [winfo geometry .pack.b] \
+ [winfo geometry .pack.c] [winfo geometry .pack.d]
+} {20x40+280+80 50x30+230+85 80x80+150+60 40x30+110+85}
+test pack-6.6 {-expand option} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -side right -expand yes
+ pack .pack.b -side right
+ pack .pack.c .pack.d -side right -expand 1
+ update
+ list [winfo geometry .pack.a] [winfo geometry .pack.b] \
+ [winfo geometry .pack.c] [winfo geometry .pack.d]
+} {20x40+262+80 50x30+194+85 80x80+95+60 40x30+18+85}
+test pack-6.7 {-expand option} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c .pack.d -side bottom
+ update
+ list [winfo geometry .pack.a] [winfo geometry .pack.b] \
+ [winfo geometry .pack.c] [winfo geometry .pack.d]
+} {20x40+140+160 50x30+125+130 80x80+110+50 40x30+130+20}
+test pack-6.8 {-expand option} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -side bottom -expand yes
+ pack .pack.b -side bottom
+ pack .pack.c .pack.d -side bottom -expand 1
+ update
+ list [winfo geometry .pack.a] [winfo geometry .pack.b] \
+ [winfo geometry .pack.c] [winfo geometry .pack.d]
+} {20x40+140+157 50x30+125+124 80x80+110+40 40x30+130+3}
+test pack-6.9 {-expand option} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -side bottom -expand yes -fill both
+ pack .pack.b -side right
+ pack .pack.c -side top -expand 1 -fill both
+ pack .pack.d -side left
+ update
+ list [winfo geometry .pack.a] [winfo geometry .pack.b] \
+ [winfo geometry .pack.c] [winfo geometry .pack.d]
+} {300x65+0+135 50x30+250+52 250x105+0+0 40x30+0+105}
+test pack-6.10 {-expand option} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -side left -expand yes -fill both
+ pack .pack.b -side top
+ pack .pack.c -side right -expand 1 -fill both
+ pack .pack.d -side bottom
+ update
+ list [winfo geometry .pack.a] [winfo geometry .pack.b] \
+ [winfo geometry .pack.c] [winfo geometry .pack.d]
+} {100x200+0+0 50x30+175+0 160x170+140+30 40x30+100+170}
+test pack-6.11 {-expand option} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -side left -expand yes -fill both
+ pack .pack.b -side top -expand yes -fill both
+ pack .pack.c -side right -expand 1 -fill both
+ pack .pack.d -side bottom -expand yes -fill both
+ update
+ list [winfo geometry .pack.a] [winfo geometry .pack.b] \
+ [winfo geometry .pack.c] [winfo geometry .pack.d]
+} {100x200+0+0 200x100+100+0 160x100+140+100 40x100+100+100}
+catch {destroy .pack2}
+toplevel .pack2 -height 400 -width 400
+wm geometry .pack2 +0+0
+pack propagate .pack2 0
+pack forget .pack2.a .pack2.b .pack2.c .pack2.d
+foreach i {w1 w2 w3} {
+ frame .pack2.$i -width 30 -height 30 -bd 2 -relief raised
+ label .pack2.$i.l -text $i
+ place .pack2.$i.l -relwidth 1.0 -relheight 1.0
+}
+test pack-6.12 {-expand option} {
+ pack .pack2.w1 .pack2.w2 .pack2.w3 -padx 5 -ipadx 4 -pady 2 -ipady 6 -expand 1 -side left
+ update
+ list [winfo geometry .pack2.w1] [winfo geometry .pack2.w2] [winfo geometry .pack2.w3]
+} {38x42+47+179 38x42+180+179 38x42+314+179}
+test pack-6.13 {-expand option} {
+ pack forget .pack2.w1 .pack2.w2 .pack2.w3
+ pack .pack2.w1 .pack2.w2 .pack2.w3 -padx 5 -ipadx 4 -pady 2 \
+ -ipady 6 -expand 1 -side top
+ update
+ list [winfo geometry .pack2.w1] [winfo geometry .pack2.w2] [winfo geometry .pack2.w3]
+} {38x42+181+45 38x42+181+178 38x42+181+312}
+catch {destroy .pack2}
+
+wm geometry .pack {}
+test pack-7.1 {requesting size for parent} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c .pack.d -side left -padx 5 -pady 10
+ update
+ list [winfo reqwidth .pack] [winfo reqheight .pack]
+} {230 100}
+test pack-7.2 {requesting size for parent} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c .pack.d -side top -padx 5 -pady 10
+ update
+ list [winfo reqwidth .pack] [winfo reqheight .pack]
+} {90 260}
+test pack-7.3 {requesting size for parent} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c .pack.d -side right -padx 5 -pady 10
+ update
+ list [winfo reqwidth .pack] [winfo reqheight .pack]
+} {230 100}
+test pack-7.4 {requesting size for parent} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c .pack.d -side bottom -padx 5 -pady 10
+ update
+ list [winfo reqwidth .pack] [winfo reqheight .pack]
+} {90 260}
+test pack-7.5 {requesting size for parent} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -side top -padx 5 -pady 10
+ pack .pack.b -side right -padx 5 -pady 10
+ pack .pack.c -side bottom -padx 5 -pady 10
+ pack .pack.d -side left -padx 5 -pady 10
+ update
+ list [winfo reqwidth .pack] [winfo reqheight .pack]
+} {150 210}
+test pack-7.6 {requesting size for parent} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -side top
+ pack .pack.c -side left
+ pack .pack.d -side bottom
+ update
+ list [winfo reqwidth .pack] [winfo reqheight .pack]
+} {120 120}
+test pack-7.7 {requesting size for parent} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -side right
+ pack .pack.c -side bottom
+ pack .pack.d -side top
+ update
+ list [winfo reqwidth .pack] [winfo reqheight .pack]
+} {100 110}
+
+
+# For the tests below, create a couple of "pad" windows to shrink
+# the available space for the remaining windows. The tests have to
+# be done this way rather than shrinking the whole window, because
+# some window managers like mwm won't let a top-level window get
+# very small.
+
+pack forget .pack.a .pack.b .pack.c .pack.d
+frame .pack.right -width 200 -height 10 -bd 2 -relief raised
+frame .pack.bottom -width 10 -height 150 -bd 2 -relief raised
+pack .pack.right -side right
+pack .pack.bottom -side bottom
+pack .pack.a .pack.b .pack.c -side top
+update
+test pack-8.1 {insufficient space} {
+ list [winfo geometry .pack.a] [winfo ismapped .pack.a] \
+ [winfo geometry .pack.b] [winfo ismapped .pack.b] \
+ [winfo geometry .pack.c] [winfo ismapped .pack.c]
+} {20x40+30+0 1 50x30+15+40 1 80x80+0+70 1}
+wm geom .pack 270x250
+update
+test pack-8.2 {insufficient space} {
+ list [winfo geometry .pack.a] [winfo ismapped .pack.a] \
+ [winfo geometry .pack.b] [winfo ismapped .pack.b] \
+ [winfo geometry .pack.c] [winfo ismapped .pack.c]
+} {20x40+25+0 1 50x30+10+40 1 70x30+0+70 1}
+wm geom .pack 240x220
+update
+test pack-8.3 {insufficient space} {
+ list [winfo geometry .pack.a] [winfo ismapped .pack.a] \
+ [winfo geometry .pack.b] [winfo ismapped .pack.b] \
+ [winfo geometry .pack.c] [winfo ismapped .pack.c]
+} {20x40+10+0 1 40x30+0+40 1 70x30+0+70 0}
+wm geom .pack 350x350
+update
+test pack-8.4 {insufficient space} {
+ list [winfo geometry .pack.a] [winfo ismapped .pack.a] \
+ [winfo geometry .pack.b] [winfo ismapped .pack.b] \
+ [winfo geometry .pack.c] [winfo ismapped .pack.c]
+} {20x40+65+0 1 50x30+50+40 1 80x80+35+70 1}
+wm geom .pack {}
+pack .pack.a -side left
+pack .pack.b -side right
+pack .pack.c -side left
+update
+test pack-8.5 {insufficient space} {
+ list [winfo geometry .pack.a] [winfo ismapped .pack.a] \
+ [winfo geometry .pack.b] [winfo ismapped .pack.b] \
+ [winfo geometry .pack.c] [winfo ismapped .pack.c]
+} {20x40+0+20 1 50x30+100+25 1 80x80+20+0 1}
+wm geom .pack 320x180
+update
+test pack-8.6 {insufficient space} {
+ list [winfo geometry .pack.a] [winfo ismapped .pack.a] \
+ [winfo geometry .pack.b] [winfo ismapped .pack.b] \
+ [winfo geometry .pack.c] [winfo ismapped .pack.c]
+} {20x30+0+0 1 50x30+70+0 1 50x30+20+0 1}
+wm geom .pack 250x180
+update
+test pack-8.7 {insufficient space} {
+ list [winfo geometry .pack.a] [winfo ismapped .pack.a] \
+ [winfo geometry .pack.b] [winfo ismapped .pack.b] \
+ [winfo geometry .pack.c] [winfo ismapped .pack.c]
+} {20x30+0+0 1 30x30+20+0 1 50x30+20+0 0}
+pack forget .pack.b
+update
+test pack-8.8 {insufficient space} {
+ list [winfo geometry .pack.a] [winfo ismapped .pack.a] \
+ [winfo geometry .pack.b] [winfo ismapped .pack.b] \
+ [winfo geometry .pack.c] [winfo ismapped .pack.c]
+} {20x30+0+0 1 30x30+20+0 0 30x30+20+0 1}
+pack .pack.b -side right -after .pack.a
+wm geom .pack {}
+update
+test pack-8.9 {insufficient space} {
+ list [winfo geometry .pack.a] [winfo ismapped .pack.a] \
+ [winfo geometry .pack.b] [winfo ismapped .pack.b] \
+ [winfo geometry .pack.c] [winfo ismapped .pack.c]
+} {20x40+0+20 1 50x30+100+25 1 80x80+20+0 1}
+pack forget .pack.right .pack.bottom
+
+test pack-9.1 {window ordering} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c .pack.d -side top
+ pack .pack.a -after .pack.b
+ pack slaves .pack
+} {.pack.b .pack.a .pack.c .pack.d}
+test pack-9.2 {window ordering} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c .pack.d -side top
+ pack .pack.a -after .pack.a
+ pack slaves .pack
+} {.pack.a .pack.b .pack.c .pack.d}
+test pack-9.3 {window ordering} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c .pack.d -side top
+ pack .pack.a -before .pack.d
+ pack slaves .pack
+} {.pack.b .pack.c .pack.a .pack.d}
+test pack-9.4 {window ordering} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c .pack.d -side top
+ pack .pack.d -before .pack.a
+ pack slaves .pack
+} {.pack.d .pack.a .pack.b .pack.c}
+test pack-9.5 {window ordering} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c .pack.d -side top
+ pack propagate .pack.c 0
+ pack .pack.a -in .pack.c
+ list [pack slaves .pack] [pack slaves .pack.c]
+} {{.pack.b .pack.c .pack.d} .pack.a}
+test pack-9.6 {window ordering} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c .pack.d -side top
+ pack .pack.a -in .pack
+ pack slaves .pack
+} {.pack.b .pack.c .pack.d .pack.a}
+test pack-9.7 {window ordering} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c .pack.d -side top
+ pack .pack.a -padx 0
+ pack slaves .pack
+} {.pack.a .pack.b .pack.c .pack.d}
+test pack-9.8 {window ordering} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c
+ pack .pack.d
+ pack slaves .pack
+} {.pack.a .pack.b .pack.c .pack.d}
+test pack-9.9 {window ordering} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c .pack.d
+ pack .pack.b .pack.d .pack.c -before .pack.a
+ pack slaves .pack
+} {.pack.b .pack.d .pack.c .pack.a}
+test pack-9.10 {window ordering} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.c .pack.d .pack.b -after .pack.a
+ pack slaves .pack
+} {.pack.a .pack.c .pack.d .pack.b}
+
+test pack-10.1 {retaining/clearing configuration state} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -side bottom -anchor n -padx 1 -pady 2 -ipadx 3 -ipady 4 \
+ -fill both -expand 1
+ pack forget .pack.a
+ pack .pack.a
+ pack info .pack.a
+} {-in .pack -anchor center -expand 0 -fill none -ipadx 0 -ipady 0 -padx 0 -pady 0 -side top}
+test pack-10.2 {retaining/clearing configuration state} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -side bottom -anchor n -padx 1 -pady 2 -ipadx 3 -ipady 4 \
+ -fill both -expand 1
+ pack .pack.a -pady 14
+ pack info .pack.a
+} {-in .pack -anchor n -expand 1 -fill both -ipadx 3 -ipady 4 -padx 1 -pady 14 -side bottom}
+
+test pack-11.1 {info option} {
+ pack4 -in .pack
+} .pack
+test pack-11.2 {info option} {
+ pack4 -anchor n
+} n
+test pack-11.3 {info option} {
+ pack4 -anchor sw
+} sw
+test pack-11.4 {info option} {
+ pack4 -expand yes
+} 1
+test pack-11.5 {info option} {
+ pack4 -expand no
+} 0
+test pack-11.6 {info option} {
+ pack4 -fill x
+} x
+test pack-11.7 {info option} {
+ pack4 -fill y
+} y
+test pack-11.8 {info option} {
+ pack4 -fill both
+} both
+test pack-11.9 {info option} {
+ pack4 -fill none
+} none
+test pack-11.10 {info option} {
+ pack4 -ipadx 14
+} 14
+test pack-11.11 {info option} {
+ pack4 -ipady 22
+} 22
+test pack-11.12 {info option} {
+ pack4 -padx 2
+} 2
+test pack-11.13 {info option} {
+ pack4 -pady 3
+} 3
+test pack-11.14 {info option} {
+ pack4 -side top
+} top
+test pack-11.15 {info option} {
+ pack4 -side bottom
+} bottom
+test pack-11.16 {info option} {
+ pack4 -side left
+} left
+test pack-11.17 {info option} {
+ pack4 -side right
+} right
+
+test pack-12.1 {command options and errors} {
+ list [catch {pack} msg] $msg
+} {1 {wrong # args: should be "pack option arg ?arg ...?"}}
+test pack-12.2 {command options and errors} {
+ list [catch {pack foo} msg] $msg
+} {1 {wrong # args: should be "pack option arg ?arg ...?"}}
+test pack-12.3 {command options and errors} {
+ list [catch {pack configure x} msg] $msg
+} {1 {bad argument "x": must be name of window}}
+test pack-12.4 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack configure .pack.b .pack.c
+ pack slaves .pack
+} {.pack.b .pack.c}
+test pack-12.5 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .foo} msg] $msg
+} {1 {bad window path name ".foo"}}
+test pack-12.6 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack} msg] $msg
+} {1 {can't pack ".pack": it's a top-level window}}
+test pack-12.7 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -after .foo} msg] $msg
+} {1 {bad window path name ".foo"}}
+test pack-12.8 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -after .pack.b} msg] $msg
+} {1 {window ".pack.b" isn't packed}}
+test pack-12.9 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -anchor gorp} msg] $msg
+} {1 {bad anchor position "gorp": must be n, ne, e, se, s, sw, w, nw, or center}}
+test pack-12.10 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -before gorp} msg] $msg
+} {1 {bad window path name "gorp"}}
+test pack-12.11 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -before .pack.b} msg] $msg
+} {1 {window ".pack.b" isn't packed}}
+test pack-12.12 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -expand "who cares?"} msg] $msg
+} {1 {expected boolean value but got "who cares?"}}
+test pack-12.13 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -fill z} msg] $msg
+} {1 {bad fill style "z": must be none, x, y, or both}}
+test pack-12.14 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -in z} msg] $msg
+} {1 {bad window path name "z"}}
+set pad [winfo pixels .pack 1c]
+test pack-12.15 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -padx abc} msg] $msg
+} {1 {bad pad value "abc": must be positive screen distance}}
+test pack-12.16 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -padx -1} msg] $msg
+} {1 {bad pad value "-1": must be positive screen distance}}
+test pack-12.17 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -pady abc} msg] $msg
+} {1 {bad pad value "abc": must be positive screen distance}}
+test pack-12.18 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -pady -1} msg] $msg
+} {1 {bad pad value "-1": must be positive screen distance}}
+test pack-12.19 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -ipadx abc} msg] $msg
+} {1 {bad pad value "abc": must be positive screen distance}}
+test pack-12.20 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -ipadx -1} msg] $msg
+} {1 {bad pad value "-1": must be positive screen distance}}
+test pack-12.21 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -ipady abc} msg] $msg
+} {1 {bad pad value "abc": must be positive screen distance}}
+test pack-12.22 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -ipady -1} msg] $msg
+} {1 {bad pad value "-1": must be positive screen distance}}
+test pack-12.23 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -side bac} msg] $msg
+} {1 {bad side "bac": must be top, bottom, left, or right}}
+test pack-12.24 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -lousy bac} msg] $msg
+} {1 {unknown or ambiguous option "-lousy": must be -after, -anchor, -before, -expand, -fill, -in, -ipadx, -ipady, -padx, -pady, or -side}}
+test pack-12.25 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -padx} msg] $msg
+} {1 {extra option "-padx" (option with no value?)}}
+test pack-12.26 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a {} 22} msg] $msg
+} {1 {unknown or ambiguous option "": must be -after, -anchor, -before, -expand, -fill, -in, -ipadx, -ipady, -padx, -pady, or -side}}
+test pack-12.27 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -in .} msg] $msg
+} {1 {can't pack .pack.a inside .}}
+test pack-12.28 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ frame .pack.a.a
+ list [catch {pack .pack.a.a -in .pack.b} msg] $msg
+} {1 {can't pack .pack.a.a inside .pack.b}}
+test pack-12.29 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack .pack.a -in .pack.a} msg] $msg
+} {1 {can't pack .pack.a inside itself}}
+test pack-12.30 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.b .pack.c .pack.d
+ pack forget .pack.a .pack.d
+ pack slaves .pack
+} {.pack.b .pack.c}
+test pack-12.31 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ .pack configure -width 300 -height 200
+ pack propagate .pack 0
+ pack .pack.a
+ update
+ set result [list [winfo reqwidth .pack] [winfo reqheight .pack]]
+ pack propagate .pack 1
+ update
+ lappend result [winfo reqwidth .pack] [winfo reqheight .pack]
+ set result
+} {300 200 20 40}
+test pack-12.32 {command options and errors} {
+ set result [pack propagate .pack.d]
+ pack propagate .pack.d 0
+ lappend result [pack propagate .pack.d]
+ pack propagate .pack.d 1
+ lappend result [pack propagate .pack.d]
+ set result
+} {1 0 1}
+test pack-12.33 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack propagate .dum} msg] $msg
+} {1 {bad window path name ".dum"}}
+test pack-12.34 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack propagate .pack foo} msg] $msg
+} {1 {expected boolean value but got "foo"}}
+test pack-12.35 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack propagate .pack foo bar} msg] $msg
+} {1 {wrong # args: should be "pack propagate window ?boolean?"}}
+test pack-12.36 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack slaves} msg] $msg
+} {1 {wrong # args: should be "pack option arg ?arg ...?"}}
+test pack-12.37 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack slaves a b} msg] $msg
+} {1 {wrong # args: should be "pack slaves window"}}
+test pack-12.38 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack slaves .x} msg] $msg
+} {1 {bad window path name ".x"}}
+test pack-12.39 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack slaves .pack.a} msg] $msg
+} {0 {}}
+test pack-12.40 {command options and errors} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ list [catch {pack lousy .pack} msg] $msg
+} {1 {bad option "lousy": must be configure, forget, info, propagate, or slaves}}
+
+pack .pack.right -side right
+pack .pack.bottom -side bottom
+test pack-13.1 {window deletion} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a .pack.d .pack.b .pack.c -side top
+ update
+ destroy .pack.d
+ update
+ set result [list [pack slaves .pack] [winfo geometry .pack.a] \
+ [winfo geometry .pack.b] [winfo geometry .pack.c]]
+} {{.pack.right .pack.bottom .pack.a .pack.b .pack.c} 20x40+30+0 50x30+15+40 80x80+0+70}
+
+test pack-14.1 {respond to changes in expansion} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ wm geom .pack {}
+ pack .pack.a
+ update
+ set result [winfo geom .pack.a]
+ wm geom .pack 400x300
+ update
+ lappend result [winfo geom .pack.a]
+ pack .pack.a -expand true -fill both
+ update
+ lappend result [winfo geom .pack.a]
+} {20x40+0+0 20x40+90+0 200x150+0+0}
+wm geom .pack {}
+
+test pack-15.1 {managing geometry with -in option} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -side top
+ frame .pack.f
+ lower .pack.f
+ pack .pack.f -side top
+ frame .pack.f.f2
+ lower .pack.f.f2
+ pack .pack.f.f2 -side top
+ pack .pack.b -in .pack.f.f2
+ update
+ set result [winfo geom .pack.b]
+ pack unpack .pack.a
+ update
+ lappend result [winfo geom .pack.b]
+} {50x30+0+40 50x30+0+0}
+catch {destroy .pack.f}
+test pack-15.2 {managing geometry with -in option} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ frame .pack.f
+ lower .pack.f
+ pack .pack.a -in .pack.f -side top
+ update
+ set result [winfo ismapped .pack.a]
+ place .pack.f -x 30 -y 45
+ update
+ lappend result [winfo ismapped .pack.a] [winfo geometry .pack.a]
+ place forget .pack.f
+ update
+ lappend result [winfo ismapped .pack.a]
+} {0 1 20x40+30+45 0}
+catch {destroy .pack.f}
+test pack-15.3 {managing geometry with -in option} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a -side top
+ frame .pack.f
+ lower .pack.f
+ pack .pack.f -side top
+ frame .pack.f.f2
+ lower .pack.f.f2
+ pack .pack.f.f2 -side top
+ pack .pack.b -in .pack.f.f2
+ update
+ set result [winfo ismapped .pack.b]
+ pack unpack .pack.f
+ update
+ lappend result [winfo ismapped .pack.b]
+} {1 0}
+catch {destroy .pack.f}
+test pack-15.4 {managing geometry with -in option} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ foreach i {1 2} {
+ frame .pack.f$i -width 100 -height 40 -bd 2 -relief raised
+ lower .pack.f$i
+ pack propagate .pack.f$i 0
+ pack .pack.f$i -side top
+ }
+ pack .pack.b -in .pack.f1 -side right
+ update
+ set result {}
+ lappend result [winfo geometry .pack.b] [winfo ismapped .pack.b]
+ pack .pack.b -in .pack.f2 -side bottom
+ update
+ lappend result [winfo geometry .pack.b] [winfo ismapped .pack.b]
+ .pack.f1 configure -width 50 -height 20
+ update
+ lappend result [winfo geometry .pack.b] [winfo ismapped .pack.b]
+ pack forget .pack.b
+ update
+ lappend result [winfo geometry .pack.b] [winfo ismapped .pack.b]
+} {50x30+48+5 1 50x30+25+48 1 50x30+25+28 1 50x30+25+28 0}
+catch {destroy .pack.f1 .pack.f2}
+test pack-15.5 {managing geometry with -in option} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ foreach i {1 2} {
+ frame .pack.f$i -width 100 -height 20 -bd 2 -relief raised
+ lower .pack.f$i
+ pack propagate .pack.f$i 0
+ pack .pack.f$i -side top
+ }
+ pack .pack.b -in .pack.f2 -side top
+ update
+ set result {}
+ lappend result [winfo geometry .pack.b] [winfo ismapped .pack.b]
+ pack .pack.a -before .pack.b -side top
+ update
+ lappend result [winfo geometry .pack.b] [winfo ismapped .pack.b]
+} {50x16+25+22 1 50x16+25+22 0}
+catch {destroy .pack.f1 .pack.f2}
+
+test pack-16.1 {geometry manager name} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ set result {}
+ lappend result [winfo manager .pack.a]
+ pack .pack.a
+ lappend result [winfo manager .pack.a]
+ pack forget .pack.a
+ lappend result [winfo manager .pack.a]
+} {{} pack {}}
+
+test pack-17.1 {PackLostSlaveProc procedure} {
+ pack forget .pack.a .pack.b .pack.c .pack.d
+ pack .pack.a
+ update
+ place .pack.a -x 40 -y 10
+ update
+ list [winfo manager .pack.a] [winfo geometry .pack.a] \
+ [catch {pack info .pack.a} msg] $msg
+} {place 20x40+40+10 1 {window ".pack.a" isn't packed}}
+
+test pack-18.1 {unmap slaves when master unmapped} {tempNotPc} {
+ # On the PC, when the width/height is configured while the window is
+ # unmapped, the changes don't take effect until the window is remapped.
+ # Who knows why?
+
+ eval destroy [winfo child .pack]
+ frame .pack.a -width 100 -height 50 -relief raised -bd 2
+ pack .pack.a
+ update
+ set result [winfo ismapped .pack.a]
+ wm iconify .pack
+ update
+ lappend result [winfo ismapped .pack.a]
+ .pack.a configure -width 200 -height 75
+ update
+ lappend result [winfo width .pack.a ] [winfo height .pack.a] \
+ [winfo ismapped .pack.a]
+ wm deiconify .pack
+ update
+ lappend result [winfo ismapped .pack.a]
+} {1 0 200 75 0 1}
+test pack-18.2 {unmap slaves when master unmapped} {
+ eval destroy [winfo child .pack]
+ frame .pack.a -relief raised -bd 2
+ frame .pack.b -width 70 -height 30 -relief sunken -bd 2
+ pack .pack.a
+ pack .pack.b -in .pack.a
+ update
+ set result [winfo ismapped .pack.b]
+ wm iconify .pack
+ update
+ lappend result [winfo ismapped .pack.b]
+ .pack.b configure -width 100 -height 30
+ update
+ lappend result [winfo width .pack.b ] [winfo height .pack.b] \
+ [winfo ismapped .pack.b]
+ wm deiconify .pack
+ update
+ lappend result [winfo ismapped .pack.b]
+} {1 0 100 30 0 1}
+destroy .pack
+foreach i {pack1 pack2 pack3 pack4} {
+ rename $i {}
+}
diff --git a/tk/tests/place.test b/tk/tests/place.test
new file mode 100644
index 00000000000..f84903fc097
--- /dev/null
+++ b/tk/tests/place.test
@@ -0,0 +1,221 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[info procs test] != "test"} {
+ source defs
+}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+wm geometry . {}
+raise .
+
+# XXX - This test file is woefully incomplete. At present, only a
+# few of the features are tested.
+
+toplevel .t -width 300 -height 200 -bd 0
+wm geom .t +0+0
+frame .t.f -width 154 -height 84 -bd 2 -relief raised
+place .t.f -x 48 -y 38
+frame .t.f2 -width 30 -height 60 -bd 2 -relief raised
+update
+
+test place-1.1 {Tk_PlaceCmd procedure, "info" option} {
+ place .t.f2 -x 0
+ place info .t.f2
+} {-x 0 -relx 0 -y 0 -rely 0 -width {} -relwidth {} -height {} -relheight {} -anchor nw}
+test place-1.2 {Tk_PlaceCmd procedure, "info" option} {
+ place .t.f2 -x 1 -y 2 -width 3 -height 4 -relx 0.1 -rely 0.2 \
+ -relwidth 0.3 -relheight 0.4 -anchor se -in .t.f \
+ -bordermode outside
+ place info .t.f2
+} {-x 1 -relx 0.1 -y 2 -rely 0.2 -width 3 -relwidth 0.3 -height 4 -relheight 0.4 -anchor se -bordermode outside -in .t.f}
+
+test place-2.1 {ConfigureSlave procedure, -height option} {
+ list [catch {place .t.f2 -height abcd} msg] $msg
+} {1 {bad screen distance "abcd"}}
+test place-2.2 {ConfigureSlave procedure, -height option} {
+ place forget .t.f2
+ place .t.f2 -in .t.f -height 40
+ update
+ winfo height .t.f2
+} {40}
+test place-2.3 {ConfigureSlave procedure, -height option} {
+ place forget .t.f2
+ place .t.f2 -in .t.f -height 120
+ update
+ place .t.f2 -height {}
+ update
+ winfo height .t.f2
+} {60}
+
+test place-3.1 {ConfigureSlave procedure, -relheight option} {
+ list [catch {place .t.f2 -relheight abcd} msg] $msg
+} {1 {expected floating-point number but got "abcd"}}
+test place-3.2 {ConfigureSlave procedure, -relheight option} {
+ place forget .t.f2
+ place .t.f2 -in .t.f -relheight .5
+ update
+ winfo height .t.f2
+} {40}
+test place-3.3 {ConfigureSlave procedure, -relheight option} {
+ place forget .t.f2
+ place .t.f2 -in .t.f -relheight .8
+ update
+ place .t.f2 -relheight {}
+ update
+ winfo height .t.f2
+} {60}
+
+test place-4.1 {ConfigureSlave procedure, bad -in options} {
+ place forget .t.f2
+ list [catch {place .t.f2 -in .t.f2} msg] $msg
+} {1 {can't place .t.f2 relative to itself}}
+
+test place-5.1 {ConfigureSlave procedure, -relwidth option} {
+ list [catch {place .t.f2 -relwidth abcd} msg] $msg
+} {1 {expected floating-point number but got "abcd"}}
+test place-5.2 {ConfigureSlave procedure, -relwidth option} {
+ place forget .t.f2
+ place .t.f2 -in .t.f -relwidth .5
+ update
+ winfo width .t.f2
+} {75}
+test place-5.3 {ConfigureSlave procedure, -relwidth option} {
+ place forget .t.f2
+ place .t.f2 -in .t.f -relwidth .8
+ update
+ place .t.f2 -relwidth {}
+ update
+ winfo width .t.f2
+} {30}
+
+test place-6.1 {ConfigureSlave procedure, -width option} {
+ list [catch {place .t.f2 -width abcd} msg] $msg
+} {1 {bad screen distance "abcd"}}
+test place-6.2 {ConfigureSlave procedure, -width option} {
+ place forget .t.f2
+ place .t.f2 -in .t.f -width 100
+ update
+ winfo width .t.f2
+} {100}
+test place-6.3 {ConfigureSlave procedure, -width option} {
+ place forget .t.f2
+ place .t.f2 -in .t.f -width 120
+ update
+ place .t.f2 -width {}
+ update
+ winfo width .t.f2
+} {30}
+
+test place-7.1 {ReconfigurePlacement procedure, computing position} {
+ place forget .t.f2
+ place .t.f2 -in .t.f -x -2 -relx .5 -y 3 -rely .4
+ update
+ winfo geometry .t.f2
+} {30x60+123+75}
+test place-7.2 {ReconfigurePlacement procedure, position rounding} {
+ place forget .t.f2
+ place .t.f2 -in .t.f -x -1.4 -y -2.3
+ update
+ winfo geometry .t.f2
+} {30x60+49+38}
+test place-7.3 {ReconfigurePlacement procedure, position rounding} {
+ place forget .t.f2
+ place .t.f2 -in .t.f -x 1.4 -y 2.3
+ update
+ winfo geometry .t.f2
+} {30x60+51+42}
+test place-7.4 {ReconfigurePlacement procedure, position rounding} {
+ place forget .t.f2
+ place .t.f2 -in .t.f -x -1.6 -y -2.7
+ update
+ winfo geometry .t.f2
+} {30x60+48+37}
+test place-7.5 {ReconfigurePlacement procedure, position rounding} {
+ place forget .t.f2
+ place .t.f2 -in .t.f -x 1.6 -y 2.7
+ update
+ winfo geometry .t.f2
+} {30x60+52+43}
+test place-7.6 {ReconfigurePlacement procedure, position rounding} {
+ frame .t.f3 -width 100 -height 100 -bg #f00000 -bd 0
+ place .t.f3 -x 0 -y 0
+ raise .t.f2
+ place forget .t.f2
+ place .t.f2 -in .t.f3 -relx .303 -rely .406 -relwidth .304 -relheight .206
+ update
+ winfo geometry .t.f2
+} {31x20+30+41}
+catch {destroy .t.f3}
+test place-7.7 {ReconfigurePlacement procedure, computing size} {
+ place forget .t.f2
+ place .t.f2 -in .t.f -width 120 -height 89
+ update
+ list [winfo width .t.f2] [winfo height .t.f2]
+} {120 89}
+test place-7.8 {ReconfigurePlacement procedure, computing size} {
+ place forget .t.f2
+ place .t.f2 -in .t.f -relwidth .4 -relheight .5
+ update
+ list [winfo width .t.f2] [winfo height .t.f2]
+} {60 40}
+test place-7.9 {ReconfigurePlacement procedure, computing size} {
+ place forget .t.f2
+ place .t.f2 -in .t.f -width 10 -relwidth .4 -height -4 -relheight .5
+ update
+ list [winfo width .t.f2] [winfo height .t.f2]
+} {70 36}
+test place-7.10 {ReconfigurePlacement procedure, computing size} {
+ place forget .t.f2
+ place .t.f2 -in .t.f -width 10 -relwidth .4 -height -4 -relheight .5
+ place .t.f2 -width {} -relwidth {} -height {} -relheight {}
+ update
+ list [winfo width .t.f2] [winfo height .t.f2]
+} {30 60}
+
+
+test place-8.1 {MasterStructureProc, mapping and unmapping slaves} {
+ place forget .t.f2
+ place forget .t.f
+ place .t.f2 -relx 1.0 -rely 1.0 -anchor sw
+ update
+ set result [winfo ismapped .t.f2]
+ wm iconify .t
+ update
+ lappend result [winfo ismapped .t.f2]
+ place .t.f2 -x 40 -y 30 -relx 0 -rely 0 -anchor nw
+ update
+ 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 40 30 0 1}
+test place-8.2 {MasterStructureProc, mapping and unmapping slaves} {
+ place forget .t.f2
+ place forget .t.f
+ place .t.f -x 0 -y 0 -width 200 -height 100
+ place .t.f2 -in .t.f -relx 1.0 -rely 1.0 -anchor sw -width 50 -height 20
+ update
+ set result [winfo ismapped .t.f2]
+ wm iconify .t
+ update
+ lappend result [winfo ismapped .t.f2]
+ place .t.f2 -x 40 -y 30 -relx 0 -rely 0 -anchor nw
+ update
+ 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
diff --git a/tk/tests/raise.test b/tk/tests/raise.test
new file mode 100644
index 00000000000..e315db69839
--- /dev/null
+++ b/tk/tests/raise.test
@@ -0,0 +1,299 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+ }
+ foreach i {a b c d e} {
+ label .raise.$i -text $i -relief raised -bd 2
+ }
+ place .raise.a -x 20 -y 60 -width 60 -height 80
+ place .raise.b -x 60 -y 60 -width 60 -height 80
+ place .raise.c -x 100 -y 60 -width 60 -height 80
+ place .raise.d -x 40 -y 20 -width 100 -height 60
+ place .raise.e -x 40 -y 120 -width 100 -height 60
+}
+
+# Procedure to return information about which windows are on top
+# of which other windows.
+
+proc raise_getOrder {} {
+ set x [winfo rootx .raise]
+ set y [winfo rooty .raise]
+ list [winfo name [winfo containing [expr $x+50] [expr $y+70]]] \
+ [winfo name [winfo containing [expr $x+90] [expr $y+70]]] \
+ [winfo name [winfo containing [expr $x+130] [expr $y+70]]] \
+ [winfo name [winfo containing [expr $x+70] [expr $y+100]]] \
+ [winfo name [winfo containing [expr $x+110] [expr $y+100]]] \
+ [winfo name [winfo containing [expr $x+50] [expr $y+130]]] \
+ [winfo name [winfo containing [expr $x+90] [expr $y+130]]] \
+ [winfo name [winfo containing [expr $x+130] [expr $y+130]]]
+}
+
+# Procedure to set up a collection of top-level windows
+
+proc raise_makeToplevels {} {
+ foreach i [winfo child .] {
+ destroy $i
+ }
+ foreach i {.raise1 .raise2 .raise3} {
+ toplevel $i
+ wm geom $i 150x100+0+0
+ update
+ }
+}
+
+foreach i [winfo child .] {
+ destroy $i
+}
+toplevel .raise
+wm geom .raise 250x200+0+0
+
+test raise-1.1 {preserve creation order} {
+ raise_setup
+ update
+ raise_getOrder
+} {d d d b c e e e}
+test raise-1.2 {preserve creation order} {
+ raise_setup
+ testmakeexist .raise.a
+ update
+ raise_getOrder
+} {d d d b c e e e}
+test raise-1.3 {preserve creation order} {
+ raise_setup
+ testmakeexist .raise.c
+ update
+ raise_getOrder
+} {d d d b c e e e}
+test raise-1.4 {preserve creation order} {
+ raise_setup
+ testmakeexist .raise.e
+ update
+ raise_getOrder
+} {d d d b c e e e}
+test raise-1.5 {preserve creation order} {
+ raise_setup
+ testmakeexist .raise.d .raise.c .raise.b
+ update
+ raise_getOrder
+} {d d d b c e e e}
+
+test raise-2.1 {raise internal windows before creation} {
+ raise_setup
+ raise .raise.a
+ update
+ raise_getOrder
+} {a d d a c a e e}
+test raise-2.2 {raise internal windows before creation} {
+ raise_setup
+ raise .raise.c
+ update
+ raise_getOrder
+} {d d c b c e e c}
+test raise-2.3 {raise internal windows before creation} {
+ raise_setup
+ raise .raise.e
+ update
+ raise_getOrder
+} {d d d b c e e e}
+test raise-2.4 {raise internal windows before creation} {
+ raise_setup
+ raise .raise.e .raise.a
+ update
+ raise_getOrder
+} {d d d b c e b c}
+test raise-2.5 {raise internal windows before creation} {
+ raise_setup
+ raise .raise.a .raise.d
+ update
+ raise_getOrder
+} {a d d a c e e e}
+
+test raise-3.1 {raise internal windows after creation} {
+ raise_setup
+ update
+ raise .raise.a .raise.d
+ raise_getOrder
+} {a d d a c e e e}
+test raise-3.2 {raise internal windows after creation} {
+ raise_setup
+ testmakeexist .raise.a .raise.b
+ raise .raise.a .raise.b
+ update
+ raise_getOrder
+} {d d d a c e e e}
+test raise-3.3 {raise internal windows after creation} {
+ raise_setup
+ testmakeexist .raise.a .raise.d
+ raise .raise.a .raise.b
+ update
+ raise_getOrder
+} {d d d a c e e e}
+test raise-3.4 {raise internal windows after creation} {
+ raise_setup
+ testmakeexist .raise.a .raise.c .raise.d
+ raise .raise.a .raise.b
+ update
+ raise_getOrder
+} {d d d a c e e e}
+
+test raise-4.1 {raise relative to nephews} {
+ raise_setup
+ update
+ frame .raise.d.child
+ raise .raise.a .raise.d.child
+ raise_getOrder
+} {a d d a c e e e}
+test raise-4.2 {raise relative to nephews} {
+ raise_setup
+ update
+ frame .raise2
+ list [catch {raise .raise.a .raise2} msg] $msg
+} {1 {can't raise ".raise.a" above ".raise2"}}
+catch {destroy .raise2}
+
+test raise-5.1 {lower internal windows} {
+ raise_setup
+ update
+ lower .raise.d
+ raise_getOrder
+} {a b c b c e e e}
+test raise-5.2 {lower internal windows} {
+ raise_setup
+ update
+ lower .raise.d .raise.b
+ raise_getOrder
+} {d b c b c e e e}
+test raise-5.3 {lower internal windows} {
+ raise_setup
+ update
+ lower .raise.a .raise.e
+ raise_getOrder
+} {a d d a c e e e}
+test raise-5.4 {lower internal windows} {
+ raise_setup
+ update
+ frame .raise2
+ list [catch {lower .raise.a .raise2} msg] $msg
+} {1 {can't lower ".raise.a" below ".raise2"}}
+catch {destroy .raise2}
+
+test raise-6.1 {raise/lower toplevel windows} {nonPortable} {
+ raise_makeToplevels
+ update
+ raise .raise1
+ winfo containing [winfo rootx .raise1] [winfo rooty .raise1]
+} .raise1
+test raise-6.2 {raise/lower toplevel windows} {nonPortable} {
+ raise_makeToplevels
+ update
+ raise .raise2
+ winfo containing [winfo rootx .raise1] [winfo rooty .raise1]
+} .raise2
+test raise-6.3 {raise/lower toplevel windows} {nonPortable} {
+ raise_makeToplevels
+ update
+ raise .raise3
+ raise .raise2
+ raise .raise1 .raise3
+ set result [winfo containing [winfo rootx .raise1] \
+ [winfo rooty .raise1]]
+ destroy .raise2
+ update
+ after 500
+ list $result [winfo containing [winfo rootx .raise1] \
+ [winfo rooty .raise1]]
+} {.raise2 .raise1}
+test raise-6.4 {raise/lower toplevel windows} {nonPortable} {
+ raise_makeToplevels
+ update
+ raise .raise2
+ raise .raise1
+ lower .raise3 .raise1
+ set result [winfo containing [winfo rootx .raise1] \
+ [winfo rooty .raise1]]
+ wm geometry .raise2 +30+30
+ wm geometry .raise1 +60+60
+ destroy .raise1
+ update
+ after 500
+ list $result [winfo containing [winfo rootx .raise2] \
+ [winfo rooty .raise2]]
+} {.raise1 .raise3}
+test raise-6.5 {raise/lower toplevel windows} {nonPortable} {
+ raise_makeToplevels
+ raise .raise1
+ set time [lindex [time {raise .raise1}] 0]
+ expr {$time < 2000000}
+} 1
+test raise-6.6 {raise/lower toplevel windows} {nonPortable} {
+ raise_makeToplevels
+ update
+ raise .raise2
+ raise .raise1
+ raise .raise3
+ frame .raise1.f1
+ frame .raise1.f1.f2
+ lower .raise3 .raise1.f1.f2
+ set result [winfo containing [winfo rootx .raise1] \
+ [winfo rooty .raise1]]
+ destroy .raise1
+ update
+ after 500
+ list $result [winfo containing [winfo rootx .raise2] \
+ [winfo rooty .raise2]]
+} {.raise1 .raise3}
+
+test raise-7.1 {errors in raise/lower commands} {
+ list [catch {raise} msg] $msg
+} {1 {wrong # args: should be "raise window ?aboveThis?"}}
+test raise-7.2 {errors in raise/lower commands} {
+ list [catch {raise a b c} msg] $msg
+} {1 {wrong # args: should be "raise window ?aboveThis?"}}
+test raise-7.3 {errors in raise/lower commands} {
+ list [catch {raise badName} msg] $msg
+} {1 {bad window path name "badName"}}
+test raise-7.4 {errors in raise/lower commands} {
+ list [catch {raise . badName2} msg] $msg
+} {1 {bad window path name "badName2"}}
+test raise-7.5 {errors in raise/lower commands} {
+ list [catch {lower} msg] $msg
+} {1 {wrong # args: should be "lower window ?belowThis?"}}
+test raise-7.6 {errors in raise/lower commands} {
+ list [catch {lower a b c} msg] $msg
+} {1 {wrong # args: should be "lower window ?belowThis?"}}
+test raise-7.7 {errors in raise/lower commands} {
+ list [catch {lower badName3} msg] $msg
+} {1 {bad window path name "badName3"}}
+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
+}
diff --git a/tk/tests/safe.test b/tk/tests/safe.test
new file mode 100644
index 00000000000..6b4cbee3b9f
--- /dev/null
+++ b/tk/tests/safe.test
@@ -0,0 +1,169 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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 {}
+ set x
+} ""
+test safe-1.2 {Safe Tk loading into an interpreter} {
+ catch {safe::interpDelete a}
+ safe::interpCreate a
+ safe::loadTk a
+ set l [lsort [interp hidden a]]
+ safe::interpDelete a
+ set l
+} $hidden_cmds
+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]} {
+ set status ok
+ }
+ safe::interpDelete a
+ set status
+} ok
+test safe-2.2 {Unsafe commands not available} {
+ catch {safe::interpDelete a}
+ safe::interpCreate a
+ safe::loadTk a
+ set status broken
+ if {[catch {interp eval a {menu .m}} msg]} {
+ set status ok
+ }
+ safe::interpDelete a
+ set status
+} ok
+
+test safe-3.1 {Unsafe commands are available hidden} {
+ catch {safe::interpDelete a}
+ safe::interpCreate a
+ safe::loadTk a
+ set status ok
+ if {[catch {interp invokehidden a toplevel .t} msg]} {
+ set status broken
+ }
+ safe::interpDelete a
+ set status
+} ok
+test safe-3.2 {Unsafe commands are available hidden} {
+ catch {safe::interpDelete a}
+ safe::interpCreate a
+ safe::loadTk a
+ set status ok
+ if {[catch {interp invokehidden a menu .m} msg]} {
+ set status broken
+ }
+ safe::interpDelete a
+ set status
+} 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
+} {}
+
+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 }
+
+
+unset hidden_cmds
diff --git a/tk/tests/scale.test b/tk/tests/scale.test
new file mode 100644
index 00000000000..d4050f582e0
--- /dev/null
+++ b/tk/tests/scale.test
@@ -0,0 +1,801 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+# like border width have predictable values.
+
+option add *Scale.borderWidth 2
+option add *Scale.highlightThickness 2
+option add *Scale.font {Helvetica -12 bold}
+
+scale .s -from 100 -to 300
+pack .s
+update
+set i 1
+foreach test {
+ {-activebackground #ff0000 #ff0000 non-existent
+ {unknown color name "non-existent"}}
+ {-background #ff0000 #ff0000 non-existent
+ {unknown color name "non-existent"}}
+ {-bd 4 4 badValue {bad screen distance "badValue"}}
+ {-bigincrement 12.5 12.5 badValue
+ {expected floating-point number but got "badValue"}}
+ {-bg #ff0000 #ff0000 non-existent
+ {unknown color name "non-existent"}}
+ {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
+ {-command "set x" {set x} {} {}}
+ {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
+ {-digits 5 5 badValue {expected integer but got "badValue"}}
+ {-fg #00ff00 #00ff00 badValue {unknown color name "badValue"}}
+ {-font fixed fixed {} {font "" doesn't exist}}
+ {-foreground green green badValue {unknown color name "badValue"}}
+ {-from -15.0 -15.0 badValue
+ {expected floating-point number but got "badValue"}}
+ {-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
+ {unknown color name "non-existent"}}
+ {-variable x x {} {}}
+ {-width 32 32 badValue {bad screen distance "badValue"}}
+} {
+ set name [lindex $test 0]
+ test scale-1.$i {configuration options} {
+ .s configure $name [lindex $test 1]
+ lindex [.s configure $name] 4
+ } [lindex $test 2]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test scale-1.$i {configuration options} {
+ list [catch {.s configure $name [lindex $test 3]} msg] $msg
+ } [list 1 [lindex $test 4]]
+ }
+ .s configure $name [lindex [.s configure $name] 3]
+ incr i
+}
+
+destroy .s
+test scale-2.1 {Tk_ScaleCmd procedure} {
+ list [catch {scale} msg] $msg
+} {1 {wrong # args: should be "scale pathName ?options?"}}
+test scale-2.2 {Tk_ScaleCmd procedure} {
+ list [catch {scale foo} msg] $msg [winfo child .]
+} {1 {bad window path name "foo"} {}}
+test scale-2.3 {Tk_ScaleCmd procedure} {
+ list [catch {scale .s -gorp dumb} msg] $msg [winfo child .]
+} {1 {unknown option "-gorp"} {}}
+
+scale .s -from 100 -to 200
+pack .s
+update idletasks
+test scale-3.1 {ScaleWidgetCmd procedure} {
+ list [catch {.s} msg] $msg
+} {1 {wrong # args: should be ".s option ?arg arg ...?"}}
+test scale-3.2 {ScaleWidgetCmd procedure, cget option} {
+ list [catch {.s cget} msg] $msg
+} {1 {wrong # args: should be ".s cget option"}}
+test scale-3.3 {ScaleWidgetCmd procedure, cget option} {
+ list [catch {.s cget a b} msg] $msg
+} {1 {wrong # args: should be ".s cget option"}}
+test scale-3.4 {ScaleWidgetCmd procedure, cget option} {
+ list [catch {.s cget -gorp} msg] $msg
+} {1 {unknown option "-gorp"}}
+test scale-3.5 {ScaleWidgetCmd procedure, cget option} {
+ .s cget -highlightthickness
+} {2}
+test scale-3.6 {ScaleWidgetCmd procedure, configure option} {
+ list [llength [.s configure]] [lindex [.s configure] 5]
+} {33 {-borderwidth borderWidth BorderWidth 2 2}}
+test scale-3.7 {ScaleWidgetCmd procedure, configure option} {
+ list [catch {.s configure -foo} msg] $msg
+} {1 {unknown option "-foo"}}
+test scale-3.8 {ScaleWidgetCmd procedure, configure option} {
+ list [catch {.s configure -borderwidth 2 -bg} msg] $msg
+} {1 {value for "-bg" missing}}
+test scale-3.9 {ScaleWidgetCmd procedure, coords option} {
+ list [catch {.s coords a b} msg] $msg
+} {1 {wrong # args: should be ".s coords ?value?"}}
+test scale-3.10 {ScaleWidgetCmd procedure, coords option} {
+ list [catch {.s coords bad} msg] $msg
+} {1 {expected floating-point number but got "bad"}}
+test scale-3.11 {ScaleWidgetCmd procedure} {fonts} {
+ .s set 120
+ .s coords
+} {38 34}
+test scale-3.12 {ScaleWidgetCmd procedure, coords option} {fonts} {
+ .s configure -orient horizontal
+ update
+ .s set 120
+ .s coords
+} {34 31}
+.s configure -orient vertical
+update
+test scale-3.13 {ScaleWidgetCmd procedure, get option} {
+ list [catch {.s get a} msg] $msg
+} {1 {wrong # args: should be ".s get ?x y?"}}
+test scale-3.14 {ScaleWidgetCmd procedure, get option} {
+ list [catch {.s get a b c} msg] $msg
+} {1 {wrong # args: should be ".s get ?x y?"}}
+test scale-3.15 {ScaleWidgetCmd procedure, get option} {
+ list [catch {.s get a 11} msg] $msg
+} {1 {expected integer but got "a"}}
+test scale-3.16 {ScaleWidgetCmd procedure, get option} {
+ list [catch {.s get 12 b} msg] $msg
+} {1 {expected integer but got "b"}}
+test scale-3.17 {ScaleWidgetCmd procedure, get option} {
+ .s set 133
+ .s get
+} 133
+test scale-3.18 {ScaleWidgetCmd procedure, get option} {
+ .s configure -resolution 0.5
+ .s set 150
+ .s get 37 34
+} 119.5
+.s configure -resolution 1
+test scale-3.19 {ScaleWidgetCmd procedure, identify option} {
+ list [catch {.s identify} msg] $msg
+} {1 {wrong # args: should be ".s identify x y"}}
+test scale-3.20 {ScaleWidgetCmd procedure, identify option} {
+ list [catch {.s identify 1 2 3} msg] $msg
+} {1 {wrong # args: should be ".s identify x y"}}
+test scale-3.21 {ScaleWidgetCmd procedure, identify option} {
+ list [catch {.s identify boo 16} msg] $msg
+} {1 {expected integer but got "boo"}}
+test scale-3.22 {ScaleWidgetCmd procedure, identify option} {
+ list [catch {.s identify 17 bad} msg] $msg
+} {1 {expected integer but got "bad"}}
+test scale-3.23 {ScaleWidgetCmd procedure, identify option} {fonts} {
+ .s set 120
+ list [.s identify 35 10] [.s identify 35 30] [.s identify 35 80] [.s identify 5 80]
+} {trough1 slider trough2 {}}
+test scale-3.24 {ScaleWidgetCmd procedure, set option} {
+ list [catch {.s set} msg] $msg
+} {1 {wrong # args: should be ".s set value"}}
+test scale-3.25 {ScaleWidgetCmd procedure, set option} {
+ list [catch {.s set a b} msg] $msg
+} {1 {wrong # args: should be ".s set value"}}
+test scale-3.26 {ScaleWidgetCmd procedure, set option} {
+ list [catch {.s set bad} msg] $msg
+} {1 {expected floating-point number but got "bad"}}
+test scale-3.27 {ScaleWidgetCmd procedure, set option} {
+ .s set 142
+} {}
+test scale-3.28 {ScaleWidgetCmd procedure, set option} {
+ .s set 118
+ .s configure -state disabled
+ .s set 181
+ .s configure -state normal
+ .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
+ update
+ .s configure -command kill
+ .s set 55
+} {}
+
+test scale-4.1 {DestroyScale procedure} {
+ catch {destroy .s}
+ set x 50
+ scale .s -variable x -from 0 -to 100 -orient horizontal
+ pack .s
+ update
+ destroy .s
+ list [catch {set x foo} msg] $msg $x
+} {0 foo foo}
+
+test scale-5.1 {ConfigureScale procedure} {
+ catch {destroy .s}
+ set x 66
+ set y 77
+ scale .s -variable x -from 0 -to 100
+ pack .s
+ update
+ .s configure -variable y
+ list [catch {set x foo} msg] $msg $x [.s get]
+} {0 foo foo 77}
+test scale-5.2 {ConfigureScale procedure} {
+ catch {destroy .s}
+ scale .s -from 0 -to 100
+ list [catch {.s configure -foo bar} msg] $msg
+} {1 {unknown option "-foo"}}
+test scale-5.3 {ConfigureScale procedure} {
+ catch {destroy .s}
+ catch {unset x}
+ scale .s -from 0 -to 100 -variable x
+ set result $x
+ lappend result [.s get]
+ set x 92
+ lappend result [.s get]
+ .s set 3
+ lappend result $x
+ 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
+ .s get
+} {50}
+test scale-6.2 {ComputeFormat procedure} {
+ .s configure -from 100 -to 1000 -resolution 100
+ .s set 493
+ .s get
+} {500}
+test scale-6.3 {ComputeFormat procedure} {
+ .s configure -from 1000 -to 10000 -resolution 1000
+ .s set 4930
+ .s get
+} {5000}
+test scale-6.4 {ComputeFormat procedure} {
+ .s configure -from 10000 -to 100000 -resolution 10000
+ .s set 49000
+ .s get
+} {50000}
+test scale-6.5 {ComputeFormat procedure} {
+ .s configure -from 100000 -to 1000000 -resolution 100000
+ .s set 493000
+ .s get
+} {500000}
+test scale-6.6 {ComputeFormat procedure} {nonPortable} {
+ # This test is non-portable because some platforms format the
+ # result as 5e+06.
+
+ .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
+ .s set .06
+ .s get
+} {0.06}
+test scale-6.10 {ComputeFormat procedure} {
+ .s configure -from .001 -to .01 -resolution .001
+ .s set .006
+ .s get
+} {0.006}
+test scale-6.11 {ComputeFormat procedure} {
+ .s configure -from .0001 -to .001 -resolution .0001
+ .s set .0006
+ .s get
+} {0.0006}
+test scale-6.12 {ComputeFormat procedure} {
+ .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
+ .s set .111111111
+ .s get
+} {0.11}
+test scale-6.19 {ComputeFormat procedure} {
+ .s configure -length 200 -from 1000 -to 1002 -resolution 0 -digits 0
+ .s set 1001.23456789
+ .s get
+} {1001.23}
+test scale-6.20 {ComputeFormat procedure} {
+ .s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 0
+ .s set 1001.23456789
+ .s get
+} {1001.235}
+
+test scale-7.1 {ComputeScaleGeometry procedure} {fonts} {
+ catch {destroy .s}
+ scale .s -from 0 -to 10 -label "Short" -orient vertical -length 5i
+ pack .s
+ update
+ list [winfo reqwidth .s] [winfo reqheight .s]
+} {88 458}
+test scale-7.2 {ComputeScaleGeometry procedure} {fonts} {
+ catch {destroy .s}
+ scale .s -from 0 -to 1000 -label "Long string" -orient vertical -tick 200
+ pack .s
+ update
+ list [winfo reqwidth .s] [winfo reqheight .s]
+} {168 108}
+test scale-7.3 {ComputeScaleGeometry procedure} {fonts} {
+ catch {destroy .s}
+ scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -width 10 \
+ -sliderlength 10
+ pack .s
+ update
+ list [winfo reqwidth .s] [winfo reqheight .s]
+} {22 108}
+test scale-7.4 {ComputeScaleGeometry procedure} {fonts} {
+ catch {destroy .s}
+ scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -bd 5 \
+ -relief sunken
+ pack .s
+ update
+ list [winfo reqwidth .s] [winfo reqheight .s]
+} {39 114}
+test scale-7.5 {ComputeScaleGeometry procedure} {fonts} {
+ catch {destroy .s}
+ scale .s -from 0 -to 10 -label "Short" -orient horizontal -length 5i
+ pack .s
+ update
+ list [winfo reqwidth .s] [winfo reqheight .s]
+} {458 61}
+test scale-7.6 {ComputeScaleGeometry procedure} {fonts} {
+ catch {destroy .s}
+ scale .s -from 0 -to 1000 -label "Long string" -orient horizontal \
+ -tick 500
+ pack .s
+ update
+ list [winfo reqwidth .s] [winfo reqheight .s]
+} {108 79}
+test scale-7.7 {ComputeScaleGeometry procedure} {fonts} {
+ catch {destroy .s}
+ scale .s -from 0 -to 1000 -orient horizontal -showvalue 0
+ pack .s
+ update
+ list [winfo reqwidth .s] [winfo reqheight .s]
+} {108 27}
+test scale-7.8 {ComputeScaleGeometry procedure} {
+ catch {destroy .s}
+ scale .s -from 0 -to 1000 -orient horizontal -showvalue 0 -bd 5 \
+ -relief raised -highlightthickness 2
+ pack .s
+ update
+ list [winfo reqwidth .s] [winfo reqheight .s]
+} {114 39}
+
+test scale-8.1 {ScaleElement procedure} {fonts} {
+ catch {destroy .s}
+ scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
+ pack .s
+ .s set 30
+ update
+ list [.s identify 53 52] [.s identify 54 52] [.s identify 70 52] \
+ [.s identify 71 52]
+} {{} trough1 trough1 {}}
+test scale-8.2 {ScaleElement procedure} {fonts} {
+ catch {destroy .s}
+ scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
+ pack .s
+ .s set 30
+ update
+ list [.s identify 60 2] [.s identify 60 3] [.s identify 60 302] \
+ [.s identify 60 303]
+} {{} trough1 trough2 {}}
+test scale-8.3 {ScaleElement procedure} {fonts} {
+ catch {destroy .s}
+ scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
+ pack .s
+ .s set 30
+ update
+ list [.s identify 60 83] [.s identify 60 84] [.s identify 60 113] \
+ [.s identify 60 114] \
+} {trough1 slider slider trough2}
+test scale-8.4 {ScaleElement procedure} {
+ catch {destroy .s}
+ scale .s -from 0 -to 100 -orient vertical -bd 4 -width 10 \
+ -highlightthickness 1 -length 300 -showvalue 0
+ pack .s
+ .s set 30
+ update
+ list [.s identify 4 40] [.s identify 5 40] [.s identify 22 40] \
+ [.s identify 23 40] \
+} {{} trough1 trough1 {}}
+test scale-8.5 {ScaleElement procedure} {fonts} {
+ catch {destroy .s}
+ scale .s -from 0 -to 100 -orient horizontal -bd 1 \
+ -highlightthickness 2 -tick 20 -sliderlength 20 \
+ -length 200 -label Test
+ pack .s
+ .s set 30
+ update
+ list [.s identify 150 36] [.s identify 150 37] [.s identify 150 53] \
+ [.s identify 150 54]
+} {{} trough2 trough2 {}}
+test scale-8.6 {ScaleElement procedure} {fonts} {
+ catch {destroy .s}
+ scale .s -from 0 -to 100 -orient horizontal -bd 2 \
+ -highlightthickness 1 -tick 20 -length 200
+ pack .s
+ .s set 30
+ update
+ list [.s identify 150 20] [.s identify 150 21] [.s identify 150 39] \
+ [.s identify 150 40]
+} {{} trough2 trough2 {}}
+test scale-8.7 {ScaleElement procedure} {
+ catch {destroy .s}
+ scale .s -from 0 -to 100 -orient horizontal -bd 4 -highlightthickness 2 \
+ -length 200 -width 10 -showvalue 0
+ pack .s
+ .s set 30
+ update
+ list [.s identify 30 5] [.s identify 30 6] [.s identify 30 23] \
+ [.s identify 30 24]
+} {{} trough1 trough1 {}}
+test scale-8.8 {ScaleElement procedure} {
+ catch {destroy .s}
+ scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \
+ -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
+ pack .s
+ .s set 30
+ update
+ list [.s identify 2 28] [.s identify 3 28] [.s identify 202 28] \
+ [.s identify 203 28]
+} {{} trough1 trough2 {}}
+test scale-8.9 {ScaleElement procedure} {
+ catch {destroy .s}
+ scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \
+ -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
+ pack .s
+ .s set 80
+ update
+ list [.s identify 145 28] [.s identify 146 28] [.s identify 165 28] \
+ [.s identify 166 28]
+} {trough1 slider slider trough2}
+
+catch {destroy .s}
+scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
+pack .s
+update
+test scale-9.1 {PixelToValue procedure} {
+ .s get 46 0
+} 0
+test scale-9.2 {PixelToValue procedure} {
+ .s get -10 9
+} 0
+test scale-9.3 {PixelToValue procedure} {
+ .s get -10 12
+} 1
+test scale-9.4 {PixelToValue procedure} {
+ .s get -10 46
+} 35
+test scale-9.5 {PixelToValue procedure} {
+ .s get -10 110
+} 99
+test scale-9.6 {PixelToValue procedure} {
+ .s get -10 111
+} 100
+test scale-9.7 {PixelToValue procedure} {
+ .s get -10 112
+} 100
+test scale-9.8 {PixelToValue procedure} {
+ .s get -10 154
+} 100
+.s configure -orient horizontal
+update
+test scale-9.9 {PixelToValue procedure} {
+ .s get 76 152
+} 65
+
+test scale-10.1 {ValueToPixel procedure} {fonts} {
+ catch {destroy .s}
+ scale .s -from 0 -to 100 -sliderlength 20 -length 124 -bd 2 \
+ -orient horizontal -label Test -tick 20
+ pack .s
+ update
+ list [.s coords -10] [.s coords 40] [.s coords 1000]
+} {{16 47} {56 47} {116 47}}
+test scale-10.2 {ValueToPixel procedure} {fonts} {
+ catch {destroy .s}
+ scale .s -from 100 -to 0 -sliderlength 20 -length 122 -bd 1 \
+ -orient vertical -label Test -tick 20
+ pack .s
+ update
+ list [.s coords -10] [.s coords 40] [.s coords 1000]
+} {{62 114} {62 74} {62 14}}
+
+test scale-11.1 {ScaleEventProc procedure} {
+ proc killScale value {
+ global x
+ if {$value > 30} {
+ destroy .s1
+ lappend x [winfo exists .s1] [info commands .s1]
+ }
+ }
+ catch {destroy .s1}
+ set x initial
+ scale .s1 -from 0 -to 100 -command killScale
+ .s1 set 20
+ pack .s1
+ update idletasks
+ lappend x [winfo exists .s1]
+ .s1 set 40
+ update idletasks
+ rename killScale {}
+ set x
+} {initial 1 0 {}}
+test scale-11.2 {ScaleEventProc procedure} {
+ eval destroy [winfo children .]
+ scale .s1 -bg #543210
+ rename .s1 .s2
+ set x {}
+ lappend x [winfo children .]
+ lappend x [.s2 cget -bg]
+ destroy .s1
+ lappend x [info command .s*] [winfo children .]
+} {.s1 #543210 {} {}}
+
+test scale-12.1 {ScaleCmdDeletedProc procedure} {
+ eval destroy [winfo children .]
+ scale .s1
+ rename .s1 {}
+ list [info command .s*] [winfo children .]
+} {{} {}}
+
+catch {destroy .s}
+scale .s -from 0 -to 100 -command {set x} -variable y
+pack .s
+update
+proc varTrace args {
+ global traceInfo
+ set traceInfo $args
+}
+test scale-13.1 {SetScaleValue procedure} {
+ set x xyzzy
+ .s set 44
+ set result [list $x $y]
+ update
+ lappend result $x $y
+} {xyzzy 44 44 44}
+test scale-13.2 {SetScaleValue procedure} {
+ .s set -3
+ .s get
+} 0
+test scale-13.3 {SetScaleValue procedure} {
+ .s set 105
+ .s get
+} 100
+.s configure -from 100 -to 0
+test scale-13.4 {SetScaleValue procedure} {
+ .s set -3
+ .s get
+} 0
+test scale-13.5 {SetScaleValue procedure} {
+ .s set 105
+ .s get
+} 100
+test scale-13.6 {SetScaleValue procedure} {
+ .s set 50
+ update
+ trace variable y w varTrace
+ set traceInfo empty
+ set x untouched
+ .s set 50
+ update
+ list $x $traceInfo
+} {untouched empty}
+
+catch {destroy .s}
+scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 -orient horizontal
+pack .s
+update
+.s configure -resolution 4.0
+update
+test scale-14.1 {RoundToResolution procedure} {
+ .s get 84 152
+} 72
+test scale-14.2 {RoundToResolution procedure} {
+ .s get 86 152
+} 76
+.s configure -from 100 -to 0
+update
+test scale-14.3 {RoundToResolution procedure} {
+ .s get 84 152
+} 28
+test scale-14.4 {RoundToResolution procedure} {
+ .s get 86 152
+} 24
+.s configure -from -100 -to 0
+update
+test scale-14.5 {RoundToResolution procedure} {
+ .s get 84 152
+} -28
+test scale-14.6 {RoundToResolution procedure} {
+ .s get 86 152
+} -24
+.s configure -from 0 -to -100
+update
+test scale-14.7 {RoundToResolution procedure} {
+ .s get 84 152
+} -72
+test scale-14.8 {RoundToResolution procedure} {
+ .s get 86 152
+} -76
+.s configure -from 0 -to 2.25 -resolution 0
+update
+test scale-14.9 {RoundToResolution procedure} {
+ .s get 84 152
+} 1.64
+test scale-14.10 {RoundToResolution procedure} {
+ .s get 86 152
+} 1.69
+.s configure -from 0 -to 225 -resolution 0 -digits 5
+update
+test scale-14.11 {RoundToResolution procedure} {
+ .s get 84 152
+} 164.25
+test scale-14.12 {RoundToResolution procedure} {
+ .s get 86 152
+} 168.75
+
+test scale-15.1 {ScaleVarProc procedure} {
+ catch {destroy .s}
+ set y -130
+ scale .s -from 0 -to -200 -variable y -orient horizontal -length 150
+ pack .s
+ set y
+} -130
+test scale-15.2 {ScaleVarProc procedure} {
+ catch {destroy .s}
+ set y -130
+ scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
+ pack .s
+ set y -87
+ .s get
+} -87
+test scale-15.3 {ScaleVarProc procedure} {
+ catch {destroy .s}
+ set y -130
+ scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
+ pack .s
+ list [catch {set y 40q} msg] $msg [.s get]
+} {1 {can't set "y": can't assign non-numeric value to scale variable} -130}
+test scale-15.4 {ScaleVarProc procedure} {
+ catch {destroy .s}
+ set y 1
+ scale .s -from 1 -to 0 -variable y -orient horizontal -length 150
+ pack .s
+ list [catch {set y x} msg] $msg [.s get]
+} {1 {can't set "y": can't assign non-numeric value to scale variable} 1}
+test scale-15.5 {ScaleVarProc procedure, variable deleted} {
+ catch {destroy .s}
+ set y 6
+ scale .s -from 10 -to 0 -variable y -orient horizontal -length 150 \
+ -command "set x"
+ pack .s
+ update
+ set x untouched
+ unset y
+ update
+ list [catch {set y} msg] $msg [.s get] $x
+} {0 6 6 untouched}
+test scale-15.6 {ScaleVarProc procedure, don't call -command} {
+ catch {destroy .s}
+ set y 6
+ scale .s -from 0 -to 100 -variable y -orient horizontal -length 150 \
+ -command "set x"
+ pack .s
+ update
+ set x untouched
+ set y 60
+ update
+ list $x [.s get]
+} {untouched 60}
+
+set l [interp hidden]
+eval destroy [winfo children .]
+
+test scale-16.1 {scale widget vs hidden commands} {
+ catch {destroy .s}
+ scale .s
+ interp hide {} .s
+ destroy .s
+ list [winfo children .] [interp hidden]
+} [list {} $l]
+
+catch {destroy .s}
+option clear
diff --git a/tk/tests/scrollbar.test b/tk/tests/scrollbar.test
new file mode 100644
index 00000000000..43709c74ac1
--- /dev/null
+++ b/tk/tests/scrollbar.test
@@ -0,0 +1,665 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[info procs test] != "test"} {
+ source defs
+}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+wm geometry . {}
+raise .
+update
+
+proc scroll args {
+ global scrollInfo
+ set scrollInfo $args
+}
+
+proc getTroughSize {w} {
+ global tcl_platform
+ if {$tcl_platform(platform) == "windows"} {
+ if [string match v* [$w cget -orient]] {
+ return [expr [winfo height $w] - 2*[testmetrics cyvscroll]]
+ } else {
+ return [expr [winfo width $w] - 2*[testmetrics cxhscroll]]
+ }
+ } else {
+ if [string match v* [$w cget -orient]] {
+ return [expr [winfo height $w] \
+ - ([winfo width $w] \
+ - [$w cget -highlightthickness] \
+ - [$w cget -bd] + 1)*2]
+ } else {
+ return [expr [winfo width $w] \
+ - ([winfo height $w] \
+ - [$w cget -highlightthickness] \
+ - [$w cget -bd] + 1)*2]
+ }
+ }
+}
+
+# XXX Note: this test file is woefully incomplete. Right now there are
+# only bits and pieces of tests. Please make this file more complete
+# as you fix bugs and add features.
+
+foreach {width height} [wm minsize .] {
+ set height [expr ($height < 200) ? 200 : $height]
+ set width [expr ($width < 1) ? 1 : $width]
+}
+
+frame .f -height $height -width $width
+pack .f -side left
+scrollbar .s
+pack .s -side right -fill y
+update
+set i 1
+foreach test {
+ {-activebackground #ff0000 #ff0000 non-existent
+ {unknown color name "non-existent"}}
+ {-activerelief sunken sunken non-existent
+ {bad relief type "non-existent": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-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"}}
+ {-command "set x" {set x} {} {}}
+ {-elementborderwidth 4 4 badValue {bad screen distance "badValue"}}
+ {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
+ {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
+ {-highlightcolor #123456 #123456 bogus {unknown color name "bogus"}}
+ {-highlightthickness 6 6 bogus {bad screen distance "bogus"}}
+ {-highlightthickness -2 0 {} {}}
+ {-jump true 1 silly {expected boolean value but got "silly"}}
+ {-orient horizontal horizontal badValue
+ {bad orientation "badValue": must be vertical or horizontal}}
+ {-orient horizontal horizontal bogus {bad orientation "bogus": must be vertical or horizontal}}
+ {-relief ridge ridge badValue {bad relief type "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-repeatdelay 140 140 129.3 {expected integer but got "129.3"}}
+ {-repeatinterval 140 140 129.3 {expected integer but got "129.3"}}
+ {-takefocus "any string" "any string" {} {}}
+ {-trough #432 #432 lousy {unknown color name "lousy"}}
+ {-width 32 32 badValue {bad screen distance "badValue"}}
+} {
+ set name [lindex $test 0]
+ test scrollbar-1.1 {configuration options} {
+ .s configure $name [lindex $test 1]
+ lindex [.s configure $name] 4
+ } [lindex $test 2]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test scrollbar-1.2 {configuration options} {
+ list [catch {.s configure $name [lindex $test 3]} msg] $msg
+ } [list 1 [lindex $test 4]]
+ }
+ .s configure $name [lindex [.s configure $name] 3]
+ incr i
+}
+
+destroy .s
+test scrollbar-2.1 {Tk_ScrollbarCmd procedure} {
+ list [catch {scrollbar} msg] $msg
+} {1 {wrong # args: should be "scrollbar pathName ?options?"}}
+test scrollbar-2.2 {Tk_ScrollbarCmd procedure} {
+ list [catch {scrollbar gorp} msg] $msg
+} {1 {bad window path name "gorp"}}
+test scrollbar-2.3 {Tk_ScrollbarCmd procedure} {
+ scrollbar .s
+ set x "[winfo class .s] [info command .s]"
+ destroy .s
+ set x
+} {Scrollbar .s}
+test scrollbar-2.4 {Tk_ScrollbarCmd procedure} {
+ list [catch {scrollbar .s -gorp blah} msg] $msg [winfo exists .s] \
+ [info command .s]
+} {1 {unknown option "-gorp"} 0 {}}
+test scrollbar-2.5 {Tk_ScrollbarCmd procedure} {
+ set x [scrollbar .s]
+ destroy .s
+ set x
+} {.s}
+
+scrollbar .s -orient vertical -command scroll -highlightthickness 2 -bd 2
+pack .s -side right -fill y
+update
+test scrollbar-3.1 {ScrollbarWidgetCmd procedure} {
+ list [catch {.s} msg] $msg
+} {1 {wrong # args: should be ".s option ?arg arg ...?"}}
+test scrollbar-3.2 {ScrollbarWidgetCmd procedure, "cget" option} {
+ list [catch {.s cget} msg] $msg
+} {1 {wrong # args: should be ".s cget option"}}
+test scrollbar-3.3 {ScrollbarWidgetCmd procedure, "cget" option} {
+ list [catch {.s cget -gorp} msg] $msg
+} {1 {unknown option "-gorp"}}
+test scrollbar-3.4 {ScrollbarWidgetCmd procedure, "activate" option} {
+ list [catch {.s activate a b} msg] $msg
+} {1 {wrong # args: should be ".s activate element"}}
+test scrollbar-3.5 {ScrollbarWidgetCmd procedure, "activate" option} {
+ .s activate arrow1
+ .s activate
+} {arrow1}
+test scrollbar-3.6 {ScrollbarWidgetCmd procedure, "activate" option} {
+ .s activate slider
+ .s activate
+} {slider}
+test scrollbar-3.7 {ScrollbarWidgetCmd procedure, "activate" option} {
+ .s activate arrow2
+ .s activate
+} {arrow2}
+test scrollbar-3.8 {ScrollbarWidgetCmd procedure, "activate" option} {
+ .s activate s
+ .s activate {}
+ .s activate
+} {}
+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} {
+ list [catch {.s configure -bad} msg] $msg
+} {1 {unknown option "-bad"}}
+test scrollbar-3.17 {ScrollbarWidgetCmd procedure, "configure" option} {
+ .s configure -orient
+} {-orient orient Orient vertical vertical}
+test scrollbar-3.18 {ScrollbarWidgetCmd procedure, "configure" option} {
+ .s configure -orient horizontal
+ set x [.s cget -orient]
+ .s configure -orient vertical
+ set x
+} {horizontal}
+test scrollbar-3.19 {ScrollbarWidgetCmd procedure, "configure" option} {
+ list [catch {.s configure -bad worse} msg] $msg
+} {1 {unknown option "-bad"}}
+test scrollbar-3.20 {ScrollbarWidgetCmd procedure, "delta" option} {
+ list [catch {.s delta 24} msg] $msg
+} {1 {wrong # args: should be ".s delta xDelta yDelta"}}
+test scrollbar-3.21 {ScrollbarWidgetCmd procedure, "delta" option} {
+ list [catch {.s delta 24 35 42} msg] $msg
+} {1 {wrong # args: should be ".s delta xDelta yDelta"}}
+test scrollbar-3.22 {ScrollbarWidgetCmd procedure, "delta" option} {
+ list [catch {.s delta silly 24} msg] $msg
+} {1 {expected integer but got "silly"}}
+test scrollbar-3.23 {ScrollbarWidgetCmd procedure, "delta" option} {
+ list [catch {.s delta 18 xxyz} msg] $msg
+} {1 {expected integer but got "xxyz"}}
+test scrollbar-3.24 {ScrollbarWidgetCmd procedure, "delta" option} {
+ list [catch {.s delta 18 xxyz} msg] $msg
+} {1 {expected integer but got "xxyz"}}
+test scrollbar-3.25 {ScrollbarWidgetCmd procedure, "delta" option} {
+ .s delta 20 0
+} {0}
+test scrollbar-3.26 {ScrollbarWidgetCmd procedure, "delta" option} {
+ .s delta 0 20
+} [format %.6g [expr 20.0/([getTroughSize .s]-1)]]
+test scrollbar-3.27 {ScrollbarWidgetCmd procedure, "delta" option} {
+ .s delta 0 -20
+} [format %.6g [expr -20.0/([getTroughSize .s]-1)]]
+test scrollbar-3.28 {ScrollbarWidgetCmd procedure, "delta" option} {
+ toplevel .t -width 250 -height 100
+ wm geom .t +0+0
+ scrollbar .t.s -orient horizontal -borderwidth 2
+ place .t.s -width 201
+ update
+ set result [list [.t.s delta 0 20] \
+ [.t.s delta [expr [getTroughSize .t.s] - 1] 0]]
+ destroy .t
+ set result
+} {0 1}
+test scrollbar-3.29 {ScrollbarWidgetCmd procedure, "fraction" option} {
+ list [catch {.s fraction 24} msg] $msg
+} {1 {wrong # args: should be ".s fraction x y"}}
+test scrollbar-3.30 {ScrollbarWidgetCmd procedure, "fraction" option} {
+ list [catch {.s fraction 24 30 32} msg] $msg
+} {1 {wrong # args: should be ".s fraction x y"}}
+test scrollbar-3.31 {ScrollbarWidgetCmd procedure, "fraction" option} {
+ list [catch {.s fraction silly 24} msg] $msg
+} {1 {expected integer but got "silly"}}
+test scrollbar-3.32 {ScrollbarWidgetCmd procedure, "fraction" option} {
+ list [catch {.s fraction 24 bogus} msg] $msg
+} {1 {expected integer but got "bogus"}}
+test scrollbar-3.33 {ScrollbarWidgetCmd procedure, "fraction" option} {
+ .s fraction 0 0
+} {0}
+test scrollbar-3.34 {ScrollbarWidgetCmd procedure, "fraction" option} {
+ .s fraction 0 1000
+} {1}
+test scrollbar-3.35 {ScrollbarWidgetCmd procedure, "fraction" option} {
+ .s fraction 4 21
+} [format %.6g [expr (21.0 - ([winfo height .s] - [getTroughSize .s])/2.0) \
+ /([getTroughSize .s] - 1)]]
+test scrollbar-3.36 {ScrollbarWidgetCmd procedure, "fraction" option} {unixOnly} {
+ .s fraction 4 179
+} {1}
+test scrollbar-3.37 {ScrollbarWidgetCmd procedure, "fraction" option} {macOrPc} {
+ .s fraction 4 [expr 200 - [testmetrics cyvscroll .s]]
+} {1}
+test scrollbar-3.38 {ScrollbarWidgetCmd procedure, "fraction" option} {unixOnly} {
+ .s fraction 4 178
+} {0.993711}
+test scrollbar-3.39 {ScrollbarWidgetCmd procedure, "fraction" option} {pcOnly} {
+ expr [.s fraction 4 [expr 200 - [testmetrics cyvscroll .s] - 2]] \
+ == [format %g [expr (200.0 - [testmetrics cyvscroll .s]*2 - 2) \
+ / ($height - 1 - [testmetrics cyvscroll .s]*2)]]
+} 1
+test scrollbar-3.40 {ScrollbarWidgetCmd procedure, "fraction" option} {macOnly} {
+ .s fraction 4 178
+} {0.97006}
+
+toplevel .t -width 250 -height 100
+wm geom .t +0+0
+scrollbar .t.s -orient horizontal -borderwidth 2
+place .t.s -width 201
+update
+
+test scrollbar-3.41 {ScrollbarWidgetCmd procedure, "fraction" option} {
+ .t.s fraction 100 0
+} {0.5}
+if {$tcl_platform(platform) == "windows"} {
+ place configure .t.s -width [expr 2*[testmetrics cxhscroll]+1]
+} else {
+ place configure .t.s -width [expr [winfo reqwidth .t.s] - 4]
+}
+update
+test scrollbar-3.42 {ScrollbarWidgetCmd procedure, "fraction" option} {
+ .t.s fraction 100 0
+} {0}
+destroy .t
+test scrollbar-3.43 {ScrollbarWidgetCmd procedure, "get" option} {
+ list [catch {.s get a} msg] $msg
+} {1 {wrong # args: should be ".s get"}}
+test scrollbar-3.44 {ScrollbarWidgetCmd procedure, "get" option} {
+ .s set 100 10 13 14
+ .s get
+} {100 10 13 14}
+test scrollbar-3.45 {ScrollbarWidgetCmd procedure, "get" option} {
+ .s set 0.6 0.8
+ set result {}
+ foreach element [.s get] {
+ lappend result [format %.1f $element]
+ }
+ set result
+} {0.6 0.8}
+test scrollbar-3.46 {ScrollbarWidgetCmd procedure, "identify" option} {
+ list [catch {.s identify 0} msg] $msg
+} {1 {wrong # args: should be ".s identify x y"}}
+test scrollbar-3.47 {ScrollbarWidgetCmd procedure, "identify" option} {
+ list [catch {.s identify 0 0 1} msg] $msg
+} {1 {wrong # args: should be ".s identify x y"}}
+test scrollbar-3.48 {ScrollbarWidgetCmd procedure, "identify" option} {
+ list [catch {.s identify bogus 2} msg] $msg
+} {1 {expected integer but got "bogus"}}
+test scrollbar-3.49 {ScrollbarWidgetCmd procedure, "identify" option} {
+ list [catch {.s identify -1 bogus} msg] $msg
+} {1 {expected integer but got "bogus"}}
+test scrollbar-3.50 {ScrollbarWidgetCmd procedure, "identify" option} {
+ .s identify 5 5
+} {arrow1}
+test scrollbar-3.51 {ScrollbarWidgetCmd procedure, "identify" option} {
+ .s identify 5 35
+} {trough1}
+test scrollbar-3.52 {ScrollbarWidgetCmd procedure, "identify" option} {
+ .s set .3 .6
+ .s identify 5 80
+} {slider}
+test scrollbar-3.53 {ScrollbarWidgetCmd procedure, "identify" option} {
+ .s identify 5 145
+} {trough2}
+test scrollbar-3.54 {ScrollbarWidgetCmd procedure, "identify" option} {unixOrPc} {
+ .s identify 5 195
+} {arrow2}
+test scrollbar-3.55 {ScrollbarWidgetCmd procedure, "identify" option} {macOnly} {
+ .s identify 5 195
+} {}
+test scrollbar-3.56 {ScrollbarWidgetCmd procedure, "identify" option} {unixOnly} {
+ .s identify 0 0
+} {}
+test scrollbar-3.57 {ScrollbarWidgetCmd procedure, "set" option} {
+ list [catch {.s set abc def} msg] $msg
+} {1 {expected floating-point number but got "abc"}}
+test scrollbar-3.58 {ScrollbarWidgetCmd procedure, "set" option} {
+ list [catch {.s set 0.6 def} msg] $msg
+} {1 {expected floating-point number but got "def"}}
+test scrollbar-3.59 {ScrollbarWidgetCmd procedure, "set" option} {
+ .s set -.2 .3
+ set result {}
+ foreach element [.s get] {
+ lappend result [format %.1f $element]
+ }
+ set result
+} {0.0 0.3}
+test scrollbar-3.60 {ScrollbarWidgetCmd procedure, "set" option} {
+ .s set 1.1 .4
+ .s get
+} {1.0 1.0}
+test scrollbar-3.61 {ScrollbarWidgetCmd procedure, "set" option} {
+ .s set .5 -.3
+ .s get
+} {0.5 0.5}
+test scrollbar-3.62 {ScrollbarWidgetCmd procedure, "set" option} {
+ .s set .5 87
+ .s get
+} {0.5 1.0}
+test scrollbar-3.63 {ScrollbarWidgetCmd procedure, "set" option} {
+ .s set .4 .3
+ set result {}
+ foreach element [.s get] {
+ lappend result [format %.1f $element]
+ }
+ set result
+} {0.4 0.4}
+test scrollbar-3.64 {ScrollbarWidgetCmd procedure, "set" option} {
+ list [catch {.s set abc def ghi jkl} msg] $msg
+} {1 {expected integer but got "abc"}}
+test scrollbar-3.65 {ScrollbarWidgetCmd procedure, "set" option} {
+ list [catch {.s set 1 def ghi jkl} msg] $msg
+} {1 {expected integer but got "def"}}
+test scrollbar-3.66 {ScrollbarWidgetCmd procedure, "set" option} {
+ list [catch {.s set 1 2 ghi jkl} msg] $msg
+} {1 {expected integer but got "ghi"}}
+test scrollbar-3.67 {ScrollbarWidgetCmd procedure, "set" option} {
+ list [catch {.s set 1 2 3 jkl} msg] $msg
+} {1 {expected integer but got "jkl"}}
+test scrollbar-3.68 {ScrollbarWidgetCmd procedure, "set" option} {
+ .s set -10 50 20 30
+ .s get
+} {0 50 0 0}
+test scrollbar-3.69 {ScrollbarWidgetCmd procedure, "set" option} {
+ .s set 100 -10 20 30
+ .s get
+} {100 0 20 30}
+test scrollbar-3.70 {ScrollbarWidgetCmd procedure, "set" option} {
+ .s set 100 50 30 20
+ .s get
+} {100 50 30 30}
+test scrollbar-3.71 {ScrollbarWidgetCmd procedure, "set" option} {
+ list [catch {.s set 1 2 3} msg] $msg
+} {1 {wrong # args: should be ".s set firstFraction lastFraction" or ".s set totalUnits windowUnits firstUnit lastUnit"}}
+test scrollbar-3.72 {ScrollbarWidgetCmd procedure, "set" option} {
+ list [catch {.s set 1 2 3 4 5} msg] $msg
+} {1 {wrong # args: should be ".s set firstFraction lastFraction" or ".s set totalUnits windowUnits firstUnit lastUnit"}}
+test scrollbar-3.73 {ScrollbarWidgetCmd procedure} {
+ list [catch {.s bogus} msg] $msg
+} {1 {bad option "bogus": must be activate, cget, configure, delta, fraction, get, identify, or set}}
+test scrollbar-3.74 {ScrollbarWidgetCmd procedure} {
+ list [catch {.s c} msg] $msg
+} {1 {bad option "c": must be activate, cget, configure, delta, fraction, get, identify, or set}}
+
+test scrollbar-4.1 {ScrollbarEventProc procedure} {
+ catch {destroy .s1}
+ scrollbar .s1 -bg #543210
+ rename .s1 .s2
+ set x {}
+ lappend x [winfo exists .s1]
+ lappend x [.s2 cget -bg]
+ destroy .s1
+ lappend x [info command .s?] [winfo exists .s1] [winfo exists .s2]
+} {1 #543210 {} 0 0}
+
+test scrollbar-5.1 {ScrollbarCmdDeletedProc procedure} {
+ catch {destroy .s1}
+ scrollbar .s1
+ rename .s1 {}
+ list [info command .s?] [winfo exists .s1]
+} {{} 0}
+
+catch {destroy .s}
+scrollbar .s -orient vertical -relief sunken -bd 2 -highlightthickness 2
+pack .s -side left -fill y
+.s set .2 .4
+update
+test scrollbar-6.1 {ScrollbarPosition procedure} {unixOnly} {
+ .s identify 8 3
+} {}
+test scrollbar-6.2 {ScrollbarPosition procedure} {macOnly} {
+ .s identify 8 3
+} {arrow1}
+test scrollbar-6.3 {ScrollbarPosition procedure} {macOrUnix} {
+ .s identify 8 196
+} {}
+test scrollbar-6.4 {ScrollbarPosition procedure} {unixOnly} {
+ .s identify 3 100
+} {}
+test scrollbar-6.5 {ScrollbarPosition procedure} {macOnly} {
+ .s identify 3 100
+} {trough2}
+test scrollbar-6.6 {ScrollbarPosition procedure} {macOrUnix} {
+ .s identify 19 100
+} {}
+test scrollbar-6.7 {ScrollbarPosition procedure} {
+ .s identify [expr [winfo width .s] / 2] -1
+} {}
+test scrollbar-6.8 {ScrollbarPosition procedure} {
+ .s identify [expr [winfo width .s] / 2] [expr [winfo height .s]]
+} {}
+test scrollbar-6.9 {ScrollbarPosition procedure} {
+ .s identify -1 [expr [winfo height .s] / 2]
+} {}
+test scrollbar-6.10 {ScrollbarPosition procedure} {
+ .s identify [winfo width .s] [expr [winfo height .s] / 2]
+} {}
+
+test scrollbar-6.11 {ScrollbarPosition procedure} {macOrUnix} {
+ .s identify 8 4
+} {arrow1}
+test scrollbar-6.12 {ScrollbarPosition procedure} {unixOnly} {
+ .s identify 8 19
+} {arrow1}
+test scrollbar-6.13 {ScrollbarPosition procedure} {macOnly} {
+ .s identify 8 19
+} {trough1}
+test scrollbar-6.14 {ScrollbarPosition procedure} {pcOnly} {
+ .s identify [expr [winfo width .s] / 2] 0
+} {arrow1}
+test scrollbar-6.15 {ScrollbarPosition procedure} {pcOnly} {
+ .s identify [expr [winfo width .s] / 2] [expr [testmetrics cyvscroll] - 1]
+} {arrow1}
+
+test scrollbar-6.16 {ScrollbarPosition procedure} {macOrUnix} {
+ .s identify 8 20
+} {trough1}
+test scrollbar-6.17 {ScrollbarPosition procedure} {macOrUnix nonPortable} {
+ # Don't know why this is non-portable, but it doesn't work on
+ # some platforms.
+ .s identify 8 51
+} {trough1}
+test scrollbar-6.18 {ScrollbarPosition procedure} {pcOnly} {
+ .s identify [expr [winfo width .s] / 2] [testmetrics cyvscroll]
+} {trough1}
+test scrollbar-6.19 {ScrollbarPosition procedure} {pcOnly} {
+ .s identify [expr [winfo width .s] / 2] [expr int(.2 / [.s delta 0 1]) \
+ + [testmetrics cyvscroll] - 1]
+} {trough1}
+
+test scrollbar-6.20 {ScrollbarPosition procedure} {macOrUnix} {
+ .s identify 8 52
+} {slider}
+test scrollbar-6.21 {ScrollbarPosition procedure} {macOrUnix nonPortable} {
+ # Don't know why this is non-portable, but it doesn't work on
+ # some platforms.
+ .s identify 8 83
+} {slider}
+test scrollbar-6.22 {ScrollbarPosition procedure} {pcOnly} {
+ .s identify [expr [winfo width .s] / 2] [expr int(.2 / [.s delta 0 1]) \
+ + [testmetrics cyvscroll]]
+} {slider}
+test scrollbar-6.23 {ScrollbarPosition procedure} {pcOnly} {
+ .s identify [expr [winfo width .s] / 2] [expr int(.4 / [.s delta 0 1]) \
+ + [testmetrics cyvscroll] - 1]
+} {slider}
+
+test scrollbar-6.24 {ScrollbarPosition procedure} {macOrUnix} {
+ .s identify 8 84
+} {trough2}
+test scrollbar-6.25 {ScrollbarPosition procedure} {unixOnly} {
+ .s identify 8 179
+} {trough2}
+test scrollbar-6.26 {ScrollbarPosition procedure} {macOnly} {
+ .s identify 8 179
+} {arrow2}
+test scrollbar-6.27 {ScrollbarPosition procedure} {pcOnly} {
+ .s identify [expr [winfo width .s] / 2] [expr int(.4 / [.s delta 0 1]) \
+ + [testmetrics cyvscroll]]
+} {trough2}
+test scrollbar-6.28 {ScrollbarPosition procedure} {pcOnly} {
+ .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] \
+ - [testmetrics cyvscroll] - 1]
+} {trough2}
+
+test scrollbar-6.29 {ScrollbarPosition procedure} {macOrUnix} {
+ .s identify 8 180
+} {arrow2}
+test scrollbar-6.30 {ScrollbarPosition procedure} {unixOnly} {
+ .s identify 8 195
+} {arrow2}
+test scrollbar-6.31 {ScrollbarPosition procedure} {macOnly} {
+ .s identify 8 195
+} {}
+test scrollbar-6.32 {ScrollbarPosition procedure} {pcOnly} {
+ .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] \
+ - [testmetrics cyvscroll]]
+} {arrow2}
+test scrollbar-6.33 {ScrollbarPosition procedure} {pcOnly} {
+ .s identify [expr [winfo width .s] / 2] [expr [winfo height .s] - 1]
+} {arrow2}
+
+test scrollbar-6.34 {ScrollbarPosition procedure} {macOrUnix} {
+ .s identify 4 100
+} {trough2}
+test scrollbar-6.35 {ScrollbarPosition procedure} {unixOnly} {
+ .s identify 18 100
+} {trough2}
+test scrollbar-6.36 {ScrollbarPosition procedure} {macOnly} {
+ .s identify 18 100
+} {}
+test scrollbar-6.37 {ScrollbarPosition procedure} {pcOnly} {
+ .s identify 0 100
+} {trough2}
+test scrollbar-6.38 {ScrollbarPosition procedure} {pcOnly} {
+ .s identify [expr [winfo width .s] - 1] 100
+} {trough2}
+
+catch {destroy .t}
+toplevel .t -width 250 -height 150
+wm geometry .t +0+0
+scrollbar .t.s -orient horizontal -relief sunken -bd 2 -highlightthickness 2
+place .t.s -width 200
+.t.s set .2 .4
+update
+test scrollbar-6.39 {ScrollbarPosition procedure} {macOrUnix} {
+ .t.s identify 4 8
+} {arrow1}
+test scrollbar-6.40 {ScrollbarPosition procedure} {pcOnly} {
+ .t.s identify 0 [expr [winfo height .t.s] / 2]
+} {arrow1}
+test scrollbar-6.41 {ScrollbarPosition procedure} {unixOnly} {
+ .t.s identify 82 8
+} {slider}
+test scrollbar-6.42 {ScrollbarPosition procedure} {macOnly} {
+ .t.s identify 82 8
+} {}
+test scrollbar-6.43 {ScrollbarPosition procedure} {pcOnly} {
+ .t.s identify [expr int(.4 / [.t.s delta 1 0]) + [testmetrics cxhscroll] \
+ - 1] [expr [winfo height .t.s] / 2]
+} {slider}
+test scrollbar-6.44 {ScrollbarPosition procedure} {unixOnly} {
+ .t.s identify 100 18
+} {trough2}
+test scrollbar-6.45 {ScrollbarPosition procedure} {macOnly} {
+ .t.s identify 100 18
+} {}
+test scrollbar-6.46 {ScrollbarPosition procedure} {pcOnly} {
+ .t.s identify 100 [expr [winfo height .t.s] - 1]
+} {trough2}
+
+test scrollbar-7.1 {EventuallyRedraw} {
+ .s configure -orient horizontal
+ update
+ set result [.s cget -orient]
+ .s configure -orient vertical
+ update
+ lappend result [.s cget -orient]
+} {horizontal vertical}
+
+catch {destroy .t}
+toplevel .t
+wm geometry .t +0+0
+test scrollbar-8.1 {TkScrollbarEventProc: recursive deletion} {
+ proc doit {args} { destroy .t.f }
+ proc bgerror {args} {}
+ frame .t.f
+ scrollbar .t.f.s -command doit
+ pack .t.f -fill both -expand 1
+ pack .t.f.s -fill y -expand 1 -side right
+ wm geometry .t 100x100
+ .t.f.s set 0 .5
+ update
+ set result [winfo exists .t.f.s]
+ event generate .t.f.s <ButtonPress> -button 1 -x [expr [winfo width .t.f.s] / 2] -y 5
+ update
+ lappend result [winfo exists .t.f.s] [winfo exists .t.f]
+ rename bgerror {}
+ set result
+} {1 0 0}
+test scrollbar-8.2 {TkScrollbarEventProc: recursive deletion} {
+ proc doit {args} { destroy .t.f.s }
+ proc bgerror {args} {}
+ frame .t.f
+ scrollbar .t.f.s -command doit
+ pack .t.f -fill both -expand 1
+ pack .t.f.s -fill y -expand 1 -side right
+ wm geometry .t 100x100
+ .t.f.s set 0 .5
+ update
+ set result [winfo exists .t.f.s]
+ event generate .t.f.s <ButtonPress> -button 1 -x [expr [winfo width .t.f.s] / 2] -y 5
+ update
+ lappend result [winfo exists .t.f.s] [winfo exists .t.f]
+ rename bgerror {}
+ set result
+} {1 0 1}
+
+set l [interp hidden]
+eval destroy [winfo children .]
+
+test scrollbar-9.1 {scrollbar widget vs hidden commands} {
+ catch {destroy .s}
+ scrollbar .s
+ interp hide {} .s
+ destroy .s
+ list [winfo children .] [interp hidden]
+} [list {} $l]
+
+catch {destroy .s}
+catch {destroy .t}
+concat {}
diff --git a/tk/tests/select.test b/tk/tests/select.test
new file mode 100644
index 00000000000..1ebaad629bc
--- /dev/null
+++ b/tk/tests/select.test
@@ -0,0 +1,987 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+#
+# 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 {}
+set selInfo {}
+
+proc handler {type offset count} {
+ global selValue selInfo
+ lappend selInfo $type $offset $count
+ set numBytes [expr {[string length $selValue] - $offset}]
+ if {$numBytes <= 0} {
+ return ""
+ }
+ string range $selValue $offset [expr $numBytes+$offset]
+}
+
+proc errIncrHandler {type offset count} {
+ global selValue selInfo pass
+ if {$offset == 4000} {
+ if {$pass == 0} {
+ # Just sizing the selection; don't do anything here.
+ set pass 1
+ } else {
+ # Fetching the selection; wait long enough to cause a timeout.
+ after 6000
+ }
+ }
+ lappend selInfo $type $offset $count
+ set numBytes [expr {[string length $selValue] - $offset}]
+ if {$numBytes <= 0} {
+ return ""
+ }
+ string range $selValue $offset [expr $numBytes+$offset]
+}
+
+proc errHandler args {
+ error "selection handler aborted"
+}
+
+proc badHandler {path type offset count} {
+ global selValue selInfo
+ selection handle -type $type $path {}
+ lappend selInfo $path $type $offset $count
+ set numBytes [expr {[string length $selValue] - $offset}]
+ if {$numBytes <= 0} {
+ return ""
+ }
+ string range $selValue $offset [expr $numBytes+$offset]
+}
+proc reallyBadHandler {path type offset count} {
+ global selValue selInfo pass
+ if {$offset == 4000} {
+ if {$pass == 0} {
+ set pass 1
+ } else {
+ selection handle -type $type $path {}
+ }
+ }
+ lappend selInfo $path $type $offset $count
+ set numBytes [expr {[string length $selValue] - $offset}]
+ if {$numBytes <= 0} {
+ return ""
+ }
+ string range $selValue $offset [expr $numBytes+$offset]
+}
+
+# Eliminate any existing selection on the screen. This is needed in case
+# there is a selection in some other application, in order to prevent races
+# from causing false errors in the tests below.
+
+selection clear .
+after 1500
+
+# common setup code
+proc setup {{path .f1} {display {}}} {
+ catch {destroy $path}
+ if {$display == {}} {
+ frame $path
+ } else {
+ toplevel $path -screen $display
+ wm geom $path +0+0
+ }
+ selection own $path
+}
+
+# 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} {
+ set j $i.1$i.2$i.3$i.4$i.5$i.6$i.7$i.8$i.9$i.10$i.11$i.12$i.13$i.14
+ append longValue A$j B$j C$j D$j E$j F$j G$j H$j I$j K$j L$j M$j N$j
+}
+
+# Now we start the main body of the test code
+
+test select-1.1 {Tk_CreateSelHandler procedure} {
+ setup
+ lsort [selection get TARGETS]
+} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}
+test select-1.2 {Tk_CreateSelHandler procedure} {
+ setup
+ selection handle .f1 {handler TEST} TEST
+ lsort [selection get TARGETS]
+} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}
+test select-1.3 {Tk_CreateSelHandler procedure} {
+ global selValue selInfo
+ setup
+ selection handle .f1 {handler TEST} TEST
+ set selValue "Test value"
+ set selInfo ""
+ list [selection get TEST] $selInfo
+} {{Test value} {TEST 0 4000}}
+test select-1.4 {Tk_CreateSelHandler procedure} {
+ setup
+ selection handle .f1 {handler TEST} TEST
+ selection handle .f1 {handler STRING}
+ lsort [selection get TARGETS]
+} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}
+test select-1.5 {Tk_CreateSelHandler procedure} {
+ global selValue selInfo
+ setup
+ selection handle .f1 {handler TEST} TEST
+ selection handle .f1 {handler STRING}
+ set selValue ""
+ set selInfo ""
+ list [selection get] $selInfo
+} {{} {STRING 0 4000}}
+test select-1.6 {Tk_CreateSelHandler procedure} {
+ global selValue selInfo
+ setup
+ selection handle .f1 {handler TEST} TEST
+ selection handle .f1 {handler STRING}
+ set selValue ""
+ set selInfo ""
+ selection get
+ selection get -type TEST
+ selection handle .f1 {handler TEST2} TEST
+ selection get -type TEST
+ list [set selInfo] [lsort [selection get TARGETS]]
+} {{STRING 0 4000 TEST 0 4000 TEST2 0 4000} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
+test select-1.7 {Tk_CreateSelHandler procedure} {
+ setup
+ selection own -selection CLIPBOARD .f1
+ selection handle -selection CLIPBOARD .f1 {handler TEST} TEST
+ selection handle -selection PRIMARY .f1 {handler TEST2} STRING
+ list [lsort [selection get -selection PRIMARY TARGETS]] \
+ [lsort [selection get -selection CLIPBOARD TARGETS]]
+} {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
+test select-1.8 {Tk_CreateSelHandler procedure} {
+ setup
+ selection handle -format INTEGER -type TEST .f1 {handler TEST}
+ lsort [selection get TARGETS]
+} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}
+
+##############################################################################
+
+test select-2.1 {Tk_DeleteSelHandler procedure} {
+ setup
+ selection handle .f1 {handler STRING}
+ selection handle -type TEST .f1 {handler TEST}
+ selection handle -type USER .f1 {handler USER}
+ set result [list [lsort [selection get TARGETS]]]
+ selection handle -type TEST .f1 {}
+ lappend result [lsort [selection get TARGETS]]
+} {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW USER}}
+test select-2.2 {Tk_DeleteSelHandler procedure} {
+ setup
+ selection handle .f1 {handler STRING}
+ selection handle -type TEST .f1 {handler TEST}
+ selection handle -type USER .f1 {handler USER}
+ set result [list [lsort [selection get TARGETS]]]
+ selection handle -type USER .f1 {}
+ lappend result [lsort [selection get TARGETS]]
+} {{MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW USER} {MULTIPLE STRING TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
+test select-2.3 {Tk_DeleteSelHandler procedure} {
+ setup
+ selection own -selection CLIPBOARD .f1
+ selection handle -selection PRIMARY .f1 {handler STRING}
+ selection handle -selection CLIPBOARD .f1 {handler STRING}
+ selection handle -selection CLIPBOARD .f1 {}
+ list [lsort [selection get TARGETS]] \
+ [lsort [selection get -selection CLIPBOARD TARGETS]]
+} {{MULTIPLE STRING TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}
+test select-2.4 {Tk_DeleteSelHandler procedure} {
+ setup
+ selection handle .f1 {handler STRING}
+ list [selection handle .f1 {}] [selection handle .f1 {}]
+} {{} {}}
+
+##############################################################################
+
+test select-3.1 {Tk_OwnSelection procedure} {
+ setup
+ selection own
+} {.f1}
+test select-3.2 {Tk_OwnSelection procedure} {
+ setup .f1
+ set result [selection own]
+ setup .f2
+ lappend result [selection own]
+} {.f1 .f2}
+test select-3.3 {Tk_OwnSelection procedure} {
+ setup .f1
+ setup .f2
+ selection own -selection CLIPBOARD .f1
+ list [selection own] [selection own -selection CLIPBOARD]
+} {.f2 .f1}
+test select-3.4 {Tk_OwnSelection procedure} {
+ global lostSel
+ setup
+ set lostSel {owned}
+ selection own -command { set lostSel {lost} } .f1
+ selection clear .f1
+ set lostSel
+} {lost}
+test select-3.5 {Tk_OwnSelection procedure} {
+ global lostSel
+ setup .f1
+ setup .f2
+ set lostSel {owned}
+ selection own -command { set lostSel {lost1} } .f1
+ selection own -command { set lostSel {lost2} } .f2
+ list $lostSel [selection own]
+} {lost1 .f2}
+test select-3.6 {Tk_OwnSelection procedure} {
+ global lostSel
+ setup
+ set lostSel {owned}
+ selection own -command { set lostSel {lost1} } .f1
+ selection own -command { set lostSel {lost2} } .f1
+ set result $lostSel
+ selection clear .f1
+ lappend result $lostSel
+} {owned lost2}
+test select-3.7 {Tk_OwnSelection procedure} {unixOnly} {
+ global lostSel
+ setup
+ setupbg
+ set lostSel {owned}
+ selection own -command { set lostSel {lost1} } .f1
+ update
+ set result {}
+ lappend result [dobg { selection own . }]
+ lappend result [dobg {selection own}]
+ update
+ cleanupbg
+ lappend result $lostSel
+} {{} . lost1}
+# check reentrancy on selection replacement
+test select-3.8 {Tk_OwnSelection procedure} {
+ setup
+ selection own -selection CLIPBOARD -command { destroy .f1 } .f1
+ selection own -selection CLIPBOARD .
+} {}
+test select-3.9 {Tk_OwnSelection procedure} {
+ setup .f2
+ setup .f1
+ selection own -selection CLIPBOARD -command { destroy .f2 } .f1
+ selection own -selection CLIPBOARD .f2
+} {}
+
+# multiple display tests
+if {[info exists env(TK_ALT_DISPLAY)]} {
+
+ test select-3.10 {Tk_OwnSelection procedure} {
+ setup .f1
+ setup .f2 $env(TK_ALT_DISPLAY)
+ list [selection own -displayof .f1] [selection own -displayof .f2]
+ } {.f1 .f2}
+ test select-3.11 {Tk_OwnSelection procedure} {
+ setup .f1
+ setup .f2 $env(TK_ALT_DISPLAY)
+ setupbg
+ update
+ set result ""
+ lappend result [dobg "toplevel .t -screen $env(TK_ALT_DISPLAY); wm geom .t +0+0; selection own .t; update"]
+ lappend result [selection own -displayof .f1] \
+ [selection own -displayof .f2]
+ cleanupbg
+ set result
+ } {{} .f1 {}}
+
+}
+##############################################################################
+
+test select-4.1 {Tk_ClearSelection procedure} {
+ setup
+ set result [selection own]
+ selection clear .f1
+ lappend result [selection own]
+} {.f1 {}}
+test select-4.2 {Tk_ClearSelection procedure} {
+ setup
+ selection own -selection CLIPBOARD .f1
+ selection clear .f1
+ selection own -selection CLIPBOARD
+} {.f1}
+test select-4.3 {Tk_ClearSelection procedure} {
+ setup
+ list [selection clear .f1] [selection clear .f1]
+} {{} {}}
+test select-4.4 {Tk_ClearSelection procedure} {unixOnly} {
+ global lostSel
+ setup
+ setupbg
+ set lostSel {owned}
+ selection own -command { set lostSel {lost1} } .f1
+ update
+ set result {}
+ lappend result [dobg {selection clear; update}]
+ update
+ cleanupbg
+ lappend result [selection own]
+} {{} {}}
+
+# multiple display tests
+if {[info exists env(TK_ALT_DISPLAY)]} {
+ test select-4.5 {Tk_ClearSelection procedure} {
+ global lostSel lostSel2
+ setup .f1
+ setup .f2 $env(TK_ALT_DISPLAY)
+ set lostSel {owned}
+ set lostSel2 {owned2}
+ selection own -command { set lostSel {lost1} } .f1
+ selection own -command { set lostSel2 {lost2} } .f2
+ update
+ selection clear -displayof .f2
+ update
+ list $lostSel $lostSel2
+ } {owned lost2}
+ test select-4.6 {Tk_ClearSelection procedure} {unixOnly} {
+ setup .f1
+ setup .f2 $env(TK_ALT_DISPLAY)
+ setupbg
+ set lostSel {owned}
+ set lostSel2 {owned2}
+ selection own -command { set lostSel {lost1} } .f1
+ selection own -command { set lostSel2 {lost2} } .f2
+ update
+ set result ""
+ lappend result [dobg "toplevel .t -screen $env(TK_ALT_DISPLAY); wm geom .t +0+0; selection own .t; update"]
+ lappend result [selection own -displayof .f1] \
+ [selection own -displayof .f2] $lostSel $lostSel2
+ cleanupbg
+ set result
+ } {{} .f1 {} owned lost2}
+
+}
+##############################################################################
+
+test select-5.1 {Tk_GetSelection procedure} {
+ setup
+ list [catch {selection get TEST} msg] $msg
+} {1 {PRIMARY selection doesn't exist or form "TEST" not defined}}
+test select-5.2 {Tk_GetSelection procedure} {
+ setup
+ selection get TK_WINDOW
+} {.f1}
+test select-5.3 {Tk_GetSelection procedure} {
+ setup
+ selection handle -selection PRIMARY .f1 {handler TEST} TEST
+ set selValue "Test value"
+ set selInfo ""
+ list [selection get TEST] $selInfo
+} {{Test value} {TEST 0 4000}}
+test select-5.4 {Tk_GetSelection procedure} {
+ setup
+ selection handle .f1 ERROR errHandler
+ list [catch {selection get ERROR} msg] $msg
+} {1 {PRIMARY selection doesn't exist or form "ERROR" not defined}}
+test select-5.5 {Tk_GetSelection procedure} {
+ setup
+ set selValue $longValue
+ set selInfo ""
+ selection handle .f1 {handler STRING}
+ list [selection get] $selInfo
+} "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000}"
+test select-5.6 {Tk_GetSelection procedure} {
+ proc weirdHandler {type offset count} {
+ selection handle .f1 {}
+ handler $type $offset $count
+ }
+ setup
+ set selValue $longValue
+ set selInfo ""
+ selection handle .f1 {weirdHandler STRING}
+ list [catch {selection get} msg] $msg
+} {1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
+test select-5.7 {Tk_GetSelection procedure} {
+ proc weirdHandler {type offset count} {
+ destroy .f1
+ handler $type $offset $count
+ }
+ setup
+ set selValue "Test Value"
+ set selInfo ""
+ selection handle .f1 {weirdHandler STRING}
+ list [catch {selection get} msg] $msg
+} {1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
+test select-5.8 {Tk_GetSelection procedure} {
+ proc weirdHandler {type offset count} {
+ selection clear
+ handler $type $offset $count
+ }
+ setup
+ set selValue $longValue
+ set selInfo ""
+ selection handle .f1 {weirdHandler STRING}
+ list [selection get] $selInfo [catch {selection get} msg] $msg
+} "$longValue {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000} 1 {PRIMARY selection doesn't exist or form \"STRING\" not defined}"
+test select-5.9 {Tk_GetSelection procedure} {unixOnly} {
+ setup
+ setupbg
+ selection handle -selection PRIMARY .f1 {handler TEST} TEST
+ update
+ set selValue "Test value"
+ set selInfo ""
+ set result ""
+ lappend result [dobg {selection get TEST}]
+ cleanupbg
+ lappend result $selInfo
+} {{Test value} {TEST 0 4000}}
+test select-5.10 {Tk_GetSelection procedure} {unixOnly} {
+ setup
+ 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} {
+ setup .f1
+ setup .f2 $env(TK_ALT_DISPLAY)
+ selection handle -selection PRIMARY .f1 {handler TEST} TEST
+ selection handle -selection PRIMARY .f2 {handler TEST2} TEST
+ set selValue "Test value"
+ set selInfo ""
+ set result [list [selection get TEST] $selInfo]
+ set selValue "Test value2"
+ set selInfo ""
+ lappend result [selection get -displayof .f2 TEST] $selInfo
+ } {{Test value} {TEST 0 4000} {Test value2} {TEST2 0 4000}}
+ test select-5.12 {Tk_GetSelection procedure} {
+ global lostSel lostSel2
+ setup .f1
+ setup .f2 $env(TK_ALT_DISPLAY)
+ selection handle -selection PRIMARY .f1 {handler TEST} TEST
+ selection handle -selection PRIMARY .f2 {} TEST
+ set selValue "Test value"
+ set selInfo ""
+ set result [list [catch {selection get TEST} msg] $msg $selInfo]
+ set selValue "Test value2"
+ set selInfo ""
+ lappend result [catch {selection get -displayof .f2 TEST} msg] $msg \
+ $selInfo
+ } {0 {Test value} {TEST 0 4000} 1 {PRIMARY selection doesn't exist or form "TEST" not defined} {}}
+ test select-5.13 {Tk_GetSelection procedure} {unixOnly} {
+ setup .f1
+ setup .f2 $env(TK_ALT_DISPLAY)
+ setupbg
+ selection handle -selection PRIMARY .f1 {handler TEST} TEST
+ selection own .f1
+ selection handle -selection PRIMARY .f2 {handler TEST2} TEST
+ selection own .f2
+ set selValue "Test value"
+ set selInfo ""
+ update
+ set result ""
+ lappend result [dobg "toplevel .t -screen $env(TK_ALT_DISPLAY); wm geom .t +0+0; selection get -displayof .t TEST"]
+ set selValue "Test value2"
+ lappend result [dobg "selection get TEST"]
+ cleanupbg
+ lappend result $selInfo
+ } {{Test value} {Test value2} {TEST2 0 4000 TEST 0 4000}}
+ test select-5.14 {Tk_GetSelection procedure} {unixOnly} {
+ setup .f1
+ setup .f2 $env(TK_ALT_DISPLAY)
+ setupbg
+ selection handle -selection PRIMARY .f1 {handler TEST} TEST
+ selection own .f1
+ selection handle -selection PRIMARY .f2 {} TEST
+ selection own .f2
+ set selValue "Test value"
+ set selInfo ""
+ update
+ set result ""
+ lappend result [dobg "toplevel .t -screen $env(TK_ALT_DISPLAY); wm geom .t +0+0; selection get -displayof .t TEST"]
+ set selValue "Test value2"
+ lappend result [dobg "selection get TEST"]
+ cleanupbg
+ lappend result $selInfo
+ } {{PRIMARY selection doesn't exist or form "TEST" not defined} {Test value2} {TEST 0 4000}}
+
+}
+##############################################################################
+
+test select-6.1 {Tk_SelectionCmd procedure} {
+ list [catch {selection} cmd] $cmd
+} {1 {wrong # args: should be "selection option ?arg arg ...?"}}
+
+# selection clear
+test select-6.2 {Tk_SelectionCmd procedure} {
+ list [catch {selection clear -selection} cmd] $cmd
+} {1 {value for "-selection" missing}}
+test select-6.3 {Tk_SelectionCmd procedure} {
+ setup
+ selection own .
+ set result [selection own]
+ selection clear -displayof .f1
+ lappend result [selection own]
+} {. {}}
+test select-6.4 {Tk_SelectionCmd procedure} {
+ setup
+ selection own -selection CLIPBOARD .f1
+ set result [list [selection own] [selection own -selection CLIPBOARD]]
+ selection clear -selection CLIPBOARD .f1
+ lappend result [selection own] [selection own -selection CLIPBOARD]
+} {.f1 .f1 .f1 {}}
+test select-6.5 {Tk_SelectionCmd procedure} {
+ setup
+ selection own -selection CLIPBOARD .
+ set result [list [selection own] [selection own -selection CLIPBOARD]]
+ selection clear -selection CLIPBOARD -displayof .f1
+ lappend result [selection own] [selection own -selection CLIPBOARD]
+} {.f1 . .f1 {}}
+test select-6.6 {Tk_SelectionCmd procedure} {
+ list [catch {selection clear -badopt foo} cmd] $cmd
+} {1 {unknown option "-badopt"}}
+test select-6.7 {Tk_SelectionCmd procedure} {
+ list [catch {selection clear -selectionfoo foo} cmd] $cmd
+} {1 {unknown option "-selectionfoo"}}
+test select-6.8 {Tk_SelectionCmd procedure} {
+ catch {destroy .f2}
+ list [catch {selection clear -displayof .f2} cmd] $cmd
+} {1 {bad window path name ".f2"}}
+test select-6.9 {Tk_SelectionCmd procedure} {
+ catch {destroy .f2}
+ list [catch {selection clear .f2} cmd] $cmd
+} {1 {bad window path name ".f2"}}
+test select-6.10 {Tk_SelectionCmd procedure} {
+ setup
+ set result [selection own -selection PRIMARY]
+ selection clear
+ lappend result [selection own -selection PRIMARY]
+} {.f1 {}}
+test select-6.11 {Tk_SelectionCmd procedure} {
+ setup
+ selection own -selection CLIPBOARD .f1
+ set result [selection own -selection CLIPBOARD]
+ selection clear -selection CLIPBOARD
+ lappend result [selection own -selection CLIPBOARD]
+} {.f1 {}}
+test select-6.12 {Tk_SelectionCmd procedure} {
+ list [catch {selection clear foo bar} cmd] $cmd
+} {1 {wrong # args: should be "selection clear ?options?"}}
+
+# selection get
+test select-6.13 {Tk_SelectionCmd procedure} {
+ list [catch {selection get -selection} cmd] $cmd
+} {1 {value for "-selection" missing}}
+test select-6.14 {Tk_SelectionCmd procedure} {
+ global selValue selInfo
+ setup
+ selection handle .f1 {handler TEST}
+ set selValue "Test value"
+ set selInfo ""
+ list [selection get -displayof .f1] $selInfo
+} {{Test value} {TEST 0 4000}}
+test select-6.15 {Tk_SelectionCmd procedure} {
+ global selValue selInfo
+ setup
+ selection handle .f1 {handler STRING}
+ selection handle -selection CLIPBOARD .f1 {handler TEST}
+ selection own -selection CLIPBOARD .f1
+ set selValue "Test value"
+ set selInfo ""
+ list [selection get -selection CLIPBOARD] $selInfo
+} {{Test value} {TEST 0 4000}}
+test select-6.16 {Tk_SelectionCmd procedure} {
+ global selValue selInfo
+ setup
+ selection handle -type TEST .f1 {handler TEST}
+ selection handle -type STRING .f1 {handler STRING}
+ set selValue "Test value"
+ set selInfo ""
+ list [selection get -type TEST] $selInfo
+} {{Test value} {TEST 0 4000}}
+test select-6.17 {Tk_SelectionCmd procedure} {
+ list [catch {selection get -badopt foo} cmd] $cmd
+} {1 {unknown option "-badopt"}}
+test select-6.18 {Tk_SelectionCmd procedure} {
+ list [catch {selection get -selectionfoo foo} cmd] $cmd
+} {1 {unknown option "-selectionfoo"}}
+test select-6.19 {Tk_SelectionCmd procedure} {
+ catch { destroy .f2 }
+ list [catch {selection get -displayof .f2} cmd] $cmd
+} {1 {bad window path name ".f2"}}
+test select-6.20 {Tk_SelectionCmd procedure} {
+ list [catch {selection get foo bar} cmd] $cmd
+} {1 {wrong # args: should be "selection get ?options?"}}
+test select-6.21 {Tk_SelectionCmd procedure} {
+ global selValue selInfo
+ setup
+ selection handle -type TEST .f1 {handler TEST}
+ selection handle -type STRING .f1 {handler STRING}
+ set selValue "Test value"
+ set selInfo ""
+ list [selection get TEST] $selInfo
+} {{Test value} {TEST 0 4000}}
+
+# selection handle
+# most of the handle section has been covered earlier
+test select-6.22 {Tk_SelectionCmd procedure} {
+ list [catch {selection handle -selection} cmd] $cmd
+} {1 {value for "-selection" missing}}
+test select-6.23 {Tk_SelectionCmd procedure} {
+ global selValue selInfo
+ setup
+ set selValue "Test value"
+ set selInfo ""
+ list [selection handle -format INTEGER .f1 {handler TEST}] [selection get -displayof .f1] $selInfo
+} {{} {Test value} {TEST 0 4000}}
+test select-6.24 {Tk_SelectionCmd procedure} {
+ list [catch {selection handle -badopt foo} cmd] $cmd
+} {1 {unknown option "-badopt"}}
+test select-6.25 {Tk_SelectionCmd procedure} {
+ list [catch {selection handle -selectionfoo foo} cmd] $cmd
+} {1 {unknown option "-selectionfoo"}}
+test select-6.26 {Tk_SelectionCmd procedure} {
+ list [catch {selection handle} cmd] $cmd
+} {1 {wrong # args: should be "selection handle ?options? window command"}}
+test select-6.27 {Tk_SelectionCmd procedure} {
+ list [catch {selection handle .} cmd] $cmd
+} {1 {wrong # args: should be "selection handle ?options? window command"}}
+test select-6.28 {Tk_SelectionCmd procedure} {
+ list [catch {selection handle . foo bar baz blat} cmd] $cmd
+} {1 {wrong # args: should be "selection handle ?options? window command"}}
+test select-6.29 {Tk_SelectionCmd procedure} {
+ catch { destroy .f2 }
+ list [catch {selection handle .f2 dummy} cmd] $cmd
+} {1 {bad window path name ".f2"}}
+
+# selection own
+test select-6.30 {Tk_SelectionCmd procedure} {
+ list [catch {selection own -selection} cmd] $cmd
+} {1 {value for "-selection" missing}}
+test select-6.31 {Tk_SelectionCmd procedure} {
+ setup
+ selection own .
+ selection own -displayof .f1
+} {.}
+test select-6.32 {Tk_SelectionCmd procedure} {
+ setup
+ selection own .
+ selection own -selection CLIPBOARD .f1
+ list [selection own] [selection own -selection CLIPBOARD]
+} {. .f1}
+test select-6.33 {Tk_SelectionCmd procedure} {
+ global lostSel
+ setup
+ set lostSel owned
+ selection own -command { set lostSel lost } .
+ selection own -selection CLIPBOARD .f1
+ set result $lostSel
+ selection own .f1
+ lappend result $lostSel
+} {owned lost}
+test select-6.34 {Tk_SelectionCmd procedure} {
+ list [catch {selection own -badopt foo} cmd] $cmd
+} {1 {unknown option "-badopt"}}
+test select-6.35 {Tk_SelectionCmd procedure} {
+ list [catch {selection own -selectionfoo foo} cmd] $cmd
+} {1 {unknown option "-selectionfoo"}}
+test select-6.36 {Tk_SelectionCmd procedure} {
+ catch {destroy .f2}
+ list [catch {selection own -displayof .f2} cmd] $cmd
+} {1 {bad window path name ".f2"}}
+test select-6.37 {Tk_SelectionCmd procedure} {
+ catch {destroy .f2}
+ list [catch {selection own .f2} cmd] $cmd
+} {1 {bad window path name ".f2"}}
+test select-6.38 {Tk_SelectionCmd procedure} {
+ list [catch {selection own foo bar baz} cmd] $cmd
+} {1 {wrong # args: should be "selection own ?options? ?window?"}}
+
+test select-6.39 {Tk_SelectionCmd procedure} {
+ list [catch {selection foo} cmd] $cmd
+} {1 {bad option "foo": must be clear, get, handle, or own}}
+
+##############################################################################
+
+ # This test is non-portable because some old X11/News servers ignore
+ # a selection request when the window doesn't exist, which causes a
+ # different error message.
+
+ test select-7.1 {TkSelDeadWindow procedure} {nonPortable} {
+ setup
+ selection handle .f1 { handler TEST }
+ set result [selection own]
+ destroy .f1
+ lappend result [selection own] [catch { selection get } msg] $msg
+ } {.f1 {} 1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
+
+##############################################################################
+
+# Check reentrancy on losing selection
+
+test select-8.1 {TkSelEventProc procedure} {unixOnly} {
+ setup
+ setupbg
+ selection own -selection CLIPBOARD -command { destroy .f1 } .f1
+ update
+ set result [dobg {selection own -selection CLIPBOARD .}]
+ cleanupbg
+ set result
+} {}
+
+##############################################################################
+
+test select-9.1 {SelCvtToX and SelCvtFromX procedures} {unixOnly} {
+ global selValue selInfo
+ setup
+ setupbg
+ set selValue "1024"
+ set selInfo ""
+ selection handle -selection PRIMARY -format INTEGER -type TEST \
+ .f1 {handler TEST}
+ update
+ set result ""
+ lappend result [dobg {selection get TEST}]
+ cleanupbg
+ lappend result $selInfo
+} {0x400 {TEST 0 4000}}
+test select-9.2 {SelCvtToX and SelCvtFromX procedures} {unixOnly} {
+ global selValue selInfo
+ setup
+ setupbg
+ set selValue "1024 0xffff 2048 -2 "
+ set selInfo ""
+ selection handle -selection PRIMARY -format INTEGER -type TEST \
+ .f1 {handler TEST}
+ set result ""
+ lappend result [dobg {selection get TEST}]
+ cleanupbg
+ lappend result $selInfo
+} {{0x400 0xffff 0x800 0xfffffffe} {TEST 0 4000}}
+test select-9.3 {SelCvtToX and SelCvtFromX procedures} {unixOnly} {
+ global selValue selInfo
+ setup
+ setupbg
+ set selValue " "
+ set selInfo ""
+ selection handle -selection PRIMARY -format INTEGER -type TEST \
+ .f1 {handler TEST}
+ set result ""
+ lappend result [dobg {selection get TEST}]
+ cleanupbg
+ lappend result $selInfo
+} {{} {TEST 0 4000}}
+test select-9.4 {SelCvtToX and SelCvtFromX procedures} {unixOnly} {
+ global selValue selInfo
+ setup
+ setupbg
+ set selValue "16 foobar 32"
+ set selInfo ""
+ selection handle -selection PRIMARY -format INTEGER -type TEST \
+ .f1 {handler TEST}
+ set result ""
+ lappend result [dobg {selection get TEST}]
+ cleanupbg
+ lappend result $selInfo
+} {{0x10 0x0 0x20} {TEST 0 4000}}
+
+##############################################################################
+
+# note, we are not testing MULTIPLE style selections
+
+# most control paths have been exercised above
+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}
+ set result ""
+ lappend result [dobg {selection get}]
+ cleanupbg
+ lappend result $selInfo
+} [list [string range $longValue 0 3999] {STRING 0 4000 STRING 4000 4000 STRING 0 4000 STRING 4000 4000}]
+test select-10.3 {ConvertSelection procedure} {unixOnly} {
+ setup
+ setupbg
+ selection handle .f1 ERROR errHandler
+ set result ""
+ lappend result [dobg {selection get ERROR}]
+ cleanupbg
+ set result
+} {{PRIMARY selection doesn't exist or form "ERROR" not defined}}
+# testing timers
+test select-10.4 {ConvertSelection procedure} {unixOnly} {
+ setup
+ setupbg
+ set selValue $longValue
+ set selInfo ""
+ selection handle .f1 {errIncrHandler STRING}
+ set result ""
+ set pass 0
+ lappend result [dobg {selection get}]
+ cleanupbg
+ lappend result $selInfo
+} {{selection owner didn't respond} {STRING 0 4000 STRING 4000 4000 STRING 8000 4000 STRING 12000 4000 STRING 16000 4000 STRING 0 4000 STRING 4000 4000}}
+test select-10.5 {ConvertSelection procedure, reentrancy issues} {unixOnly} {
+ setup
+ setupbg
+ set selValue "Test value"
+ set selInfo ""
+ selection handle -type TEST .f1 { handler TEST }
+ selection handle -type STRING .f1 { badHandler .f1 STRING }
+ set result ""
+ lappend result [dobg {selection get}]
+ cleanupbg
+ lappend result $selInfo
+} {{PRIMARY selection doesn't exist or form "STRING" not defined} {.f1 STRING 0 4000}}
+test select-10.6 {ConvertSelection procedure, reentrancy issues} {unixOnly} {
+ proc weirdHandler {type offset count} {
+ destroy .f1
+ handler $type $offset $count
+ }
+ setup
+ setupbg
+ set selValue $longValue
+ set selInfo ""
+ selection handle .f1 {weirdHandler STRING}
+ set result ""
+ lappend result [dobg {selection get}]
+ cleanupbg
+ lappend result $selInfo
+} {{PRIMARY selection doesn't exist or form "STRING" not defined} {STRING 0 4000}}
+
+##############################################################################
+
+# testing reentrancy
+test select-11.1 {TkSelPropProc procedure} {unixOnly} {
+ setup
+ setupbg
+ set selValue $longValue
+ set selInfo ""
+ selection handle -type TEST .f1 { handler TEST }
+ selection handle -type STRING .f1 { reallyBadHandler .f1 STRING }
+ set result ""
+ set pass 0
+ lappend result [dobg {selection get}]
+ cleanupbg
+ lappend result $selInfo
+} {{selection owner didn't respond} {.f1 STRING 0 4000 .f1 STRING 4000 4000 .f1 STRING 8000 4000 .f1 STRING 12000 4000 .f1 STRING 16000 4000 .f1 STRING 0 4000 .f1 STRING 4000 4000}}
+
+##############################################################################
+
+# Note, this assumes we are using CurrentTtime
+test select-12.1 {DefaultSelection procedure} {unixOnly} {
+ setup
+ set result [selection get -type TIMESTAMP]
+ setupbg
+ lappend result [dobg {selection get -type TIMESTAMP}]
+ cleanupbg
+ set result
+} {0x0 0x0}
+test select-12.2 {DefaultSelection procedure} {unixOnly} {
+ setup
+ set result [lsort [list [selection get -type TARGETS]]]
+ setupbg
+ lappend result [dobg {lsort [selection get -type TARGETS]}]
+ cleanupbg
+ set result
+} {{MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}
+test select-12.3 {DefaultSelection procedure} {unixOnly} {
+ setup
+ selection handle .f1 {handler TEST} TEST
+ set result [list [lsort [selection get -type TARGETS]]]
+ setupbg
+ lappend result [dobg {lsort [selection get -type TARGETS]}]
+ cleanupbg
+ set result
+} {{MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}}
+test select-12.4 {DefaultSelection procedure} {unixOnly} {
+ setup
+ set result ""
+ lappend result [selection get -type TK_APPLICATION]
+ setupbg
+ lappend result [dobg {selection get -type TK_APPLICATION}]
+ cleanupbg
+ set result
+} [list [winfo name .] [winfo name .]]
+test select-12.5 {DefaultSelection procedure} {unixOnly} {
+ setup
+ set result [selection get -type TK_WINDOW]
+ setupbg
+ lappend result [dobg {selection get -type TK_WINDOW}]
+ cleanupbg
+ set result
+} {.f1 .f1}
+test select-12.6 {DefaultSelection procedure} {
+ global selValue selInfo
+ setup
+ selection handle .f1 {handler TARGETS.f1} TARGETS
+ set selValue "Targets value"
+ set selInfo ""
+ set result [list [selection get TARGETS] $selInfo]
+ selection handle .f1 {} TARGETS
+ lappend result [selection get TARGETS]
+} {{Targets value} {TARGETS.f1 0 4000} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}}
+
+test select-13.1 {SelectionSize procedure, handler deleted} {unixOnly} {
+ proc badHandler {path type offset count} {
+ global selValue selInfo abortCount
+ incr abortCount -1
+ if {$abortCount == 0} {
+ selection handle -type $type $path {}
+ }
+ lappend selInfo $path $type $offset $count
+ set numBytes [expr {[string length $selValue] - $offset}]
+ if {$numBytes <= 0} {
+ return ""
+ }
+ string range $selValue $offset [expr $numBytes+$offset]
+ }
+ setup
+ setupbg
+ set selValue $longValue
+ set selInfo ""
+ selection handle .f1 {badHandler .f1 STRING}
+ set result ""
+ 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
diff --git a/tk/tests/send.test b/tk/tests/send.test
new file mode 100644
index 00000000000..427cd972d86
--- /dev/null
+++ b/tk/tests/send.test
@@ -0,0 +1,656 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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 .] {
+ 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
+ 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 send-1.1 {RegOpen procedure, bogus property} {
+ testsend bogus
+ set result [winfo interps]
+ tk appname tktest
+ list $result [winfo interps]
+ } {{} tktest}
+ test send-1.2 {RegOpen procedure, bogus property} {
+ testsend prop root InterpRegistry {}
+ set result [winfo interps]
+ tk appname tktest
+ list $result [winfo interps]
+ } {{} tktest}
+ test send-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 send-2.1 {RegFindName procedure} {
+ testsend prop root InterpRegistry {}
+ list [catch {send foo bar} msg] $msg
+ } {1 {no application named "foo"}}
+ test send-2.2 {RegFindName procedure} {
+ testsend prop root InterpRegistry " abc\n def\nghi\n\n$id foo\n"
+ tk appname foo
+ } {foo #2}
+ test send-2.3 {RegFindName procedure} {
+ testsend prop root InterpRegistry "gyz foo\n"
+ tk appname foo
+ } {foo}
+ test send-2.4 {RegFindName procedure} {
+ testsend prop root InterpRegistry "${id}z foo\n"
+ tk appname foo
+ } {foo}
+
+ test send-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 send-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 send-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 send-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 send-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 send-4.1 {RegAddName procedure} {
+ testsend prop root InterpRegistry ""
+ tk appname bar
+ testsend prop root InterpRegistry
+ } "$commId bar\n"
+ test send-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 send-5.1 {ValidateName procedure} {
+ testsend prop root InterpRegistry "123 abc\n"
+ winfo interps
+ } {}
+ test send-5.2 {ValidateName procedure} {
+ testsend prop root InterpRegistry "$id Hi there"
+ winfo interps
+ } {{Hi there}}
+ test send-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 send-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 send-6.1 {ServerSecure procedure} {nonPortable} {
+ set a 44
+ list [dobg [list send [tk appname] set a 55]] $a
+} {55 55}
+test send-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 send-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 send-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 send-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 send-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 send-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 send-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 send-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 send-8.3 {Tk_SendCmd procedure, options} {
+ list [catch {send -- -async foo bar baz} msg] $msg
+} {1 {no application named "-async"}}
+test send-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 send-8.5 {Tk_SendCmd procedure, options} {
+ list [catch {send -async foo} msg] $msg
+} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}}
+test send-8.6 {Tk_SendCmd procedure, options} {
+ list [catch {send foo} msg] $msg
+} {1 {wrong # args: should be "send ?options? interpName arg ?arg ...?"}}
+test send-8.7 {Tk_SendCmd procedure, local execution} {
+ set a initial
+ send [tk appname] {set a new}
+ set a
+} {new}
+test send-8.8 {Tk_SendCmd procedure, local execution} {
+ set a initial
+ send [tk appname] set a new
+ set a
+} {new}
+test send-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 send-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 send-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 send-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 send-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 send-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 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
+ set result
+ } {1 {no application named "bogus"}}
+ interp delete t_s_1
+}
+test send-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 send-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 send-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 send-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 send-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 send-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 send-10.1 {SendEventProc procedure, bogus comm property} {
+ testsend prop comm Comm {abc def}
+ testsend prop comm Comm {}
+ update
+ } {}
+ test send-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 send-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 send-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 send-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 send-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 send-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 send-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 send-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 send-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 send-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 send-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 send-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 send-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 send-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 send-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 send-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 send-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 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"}}
+ test send-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 send-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 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
+ 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 send-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 send-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 send-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 {}
diff --git a/tk/tests/text.test b/tk/tests/text.test
new file mode 100644
index 00000000000..533fd4e9ad3
--- /dev/null
+++ b/tk/tests/text.test
@@ -0,0 +1,1262 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+option add *Text.highlightThickness 2
+option add *Text.font {Courier -12}
+
+text .t -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 .
+
+entry .t.e
+.t.e insert end abcdefg
+.t.e select from 0
+
+.t insert 1.0 "Line 1
+abcdefghijklm
+12345
+Line 4
+bOy GIrl .#@? x_yz
+!@#$%
+Line 7"
+
+catch {destroy .t2}
+text .t2
+set i 0
+foreach test {
+ {-background #ff00ff #ff00ff <gorp>}
+ {-bd 4 4 foo}
+ {-bg blue blue #xx}
+ {-borderwidth 7 7 ++}
+ {-cursor watch watch lousy}
+ {-exportselection no 0 maybe}
+ {-fg red red stupid}
+ {-font fixed fixed {}}
+ {-foreground #012 #012 bogus}
+ {-height 5 5 bad}
+ {-highlightbackground #123 #123 bogus}
+ {-highlightcolor #234 #234 bogus}
+ {-highlightthickness -2 0 bad}
+ {-insertbackground green green <bogus>}
+ {-insertborderwidth 45 45 bogus}
+ {-insertofftime 100 100 2.4}
+ {-insertontime 47 47 e1}
+ {-insertwidth 2.3 2 47d}
+ {-padx 3.4 3 2.4.}
+ {-pady 82 82 bogus}
+ {-relief raised raised bumpy}
+ {-selectbackground #ffff01234567 #ffff01234567 bogus}
+ {-selectborderwidth 21 21 3x}
+ {-selectforeground yellow yellow #12345}
+ {-spacing1 20 20 1.3x}
+ {-spacing1 -5 0 bogus}
+ {-spacing2 5 5 bogus}
+ {-spacing2 -1 0 bogus}
+ {-spacing3 20 20 bogus}
+ {-spacing3 -10 0 bogus}
+ {-state disabled disabled foo}
+ {-tabs {1i 2i 3i 4i} {1i 2i 3i 4i} bad_tabs}
+ {-width 73 73 2.4}
+ {-wrap word word bad_wrap}
+} {
+ test text-1.[incr i] {text options} {
+ set result {}
+ lappend result [catch {.t2 configure [lindex $test 0] [lindex $test 3]}]
+ .t2 configure [lindex $test 0] [lindex $test 1]
+ lappend result [.t2 cget [lindex $test 0]]
+ } [list 1 [lindex $test 2]]
+}
+test text-1.[incr i] {text options} {
+ .t2 configure -takefocus "any old thing"
+ .t2 cget -takefocus
+} {any old thing}
+test text-1.[incr i] {text options} {
+ .t2 configure -xscrollcommand "x scroll command"
+ .t2 configure -xscrollcommand
+} {-xscrollcommand xScrollCommand ScrollCommand {} {x scroll command}}
+test text-1.[incr i] {text options} {
+ .t2 configure -yscrollcommand "test command"
+ .t2 configure -yscrollcommand
+} {-yscrollcommand yScrollCommand ScrollCommand {} {test command}}
+test text-1.[incr i] {text options} {
+ set result {}
+ foreach i [.t2 configure] {
+ lappend result [lindex $i 4]
+ }
+ set result
+} {blue {} {} 7 watch 0 {} fixed #012 5 #123 #234 0 green 45 100 47 2 3 82 raised #ffff01234567 21 yellow 0 0 0 0 disabled {1i 2i 3i 4i} {any old thing} 73 word {x scroll command} {test command}}
+
+test text-2.1 {Tk_TextCmd procedure} {
+ list [catch {text} msg] $msg
+} {1 {wrong # args: should be "text pathName ?options?"}}
+test text-2.2 {Tk_TextCmd procedure} {
+ list [catch {text foobar} msg] $msg
+} {1 {bad window path name "foobar"}}
+test text-2.3 {Tk_TextCmd procedure} {
+ catch {destroy .t2}
+ list [catch {text .t2 -gorp nofun} msg] $msg [winfo exists .t2]
+} {1 {unknown option "-gorp"} 0}
+test text-2.4 {Tk_TextCmd procedure} {
+ catch {destroy .t2}
+ list [catch {text .t2 -bd 2 -fg red} msg] $msg \
+ [lindex [.t2 config -bd] 4] [lindex [.t2 config -fg] 4]
+} {0 .t2 2 red}
+if {$tcl_platform(platform) == "macintosh"} {
+ set relief solid
+} elseif {$tcl_platform(platform) == "windows"} {
+ set relief flat
+} else {
+ set relief raised
+}
+test text-2.5 {Tk_TextCmd procedure} {
+ catch {destroy .t2}
+ text .t2
+ .t2 tag cget sel -relief
+} $relief
+test text-2.6 {Tk_TextCmd procedure} {
+ catch {destroy .t2}
+ list [text .t2] [winfo class .t2]
+} {.t2 Text}
+
+test text-3.1 {TextWidgetCmd procedure, basics} {
+ list [catch {.t} msg] $msg
+} {1 {wrong # args: should be ".t option ?arg arg ...?"}}
+test text-3.2 {TextWidgetCmd procedure} {
+ list [catch {.t gorp 1.0 z 1.2} msg] $msg
+} {1 {bad option "gorp": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
+
+test text-4.1 {TextWidgetCmd procedure, "bbox" option} {
+ list [catch {.t bbox} msg] $msg
+} {1 {wrong # args: should be ".t bbox index"}}
+test text-4.2 {TextWidgetCmd procedure, "bbox" option} {
+ list [catch {.t bbox a b} msg] $msg
+} {1 {wrong # args: should be ".t bbox index"}}
+test text-4.3 {TextWidgetCmd procedure, "bbox" option} {
+ list [catch {.t bbox bad_mark} msg] $msg
+} {1 {bad text index "bad_mark"}}
+
+test text-5.1 {TextWidgetCmd procedure, "cget" option} {
+ list [catch {.t cget} msg] $msg
+} {1 {wrong # args: should be ".t cget option"}}
+test text-5.2 {TextWidgetCmd procedure, "cget" option} {
+ list [catch {.t cget a b} msg] $msg
+} {1 {wrong # args: should be ".t cget option"}}
+test text-5.3 {TextWidgetCmd procedure, "cget" option} {
+ list [catch {.t cget -gorp} msg] $msg
+} {1 {unknown option "-gorp"}}
+test text-5.4 {TextWidgetCmd procedure, "cget" option} {
+ .t configure -bd 17
+ .t cget -bd
+} {17}
+.t configure -bd [lindex [.t configure -bd] 3]
+
+test text-6.1 {TextWidgetCmd procedure, "compare" option} {
+ list [catch {.t compare a b} msg] $msg
+} {1 {wrong # args: should be ".t compare index1 op index2"}}
+test text-6.2 {TextWidgetCmd procedure, "compare" option} {
+ list [catch {.t compare a b c d} msg] $msg
+} {1 {wrong # args: should be ".t compare index1 op index2"}}
+test text-6.3 {TextWidgetCmd procedure, "compare" option} {
+ list [catch {.t compare @x == 1.0} msg] $msg
+} {1 {bad text index "@x"}}
+test text-6.4 {TextWidgetCmd procedure, "compare" option} {
+ list [catch {.t compare 1.0 < @y} msg] $msg
+} {1 {bad text index "@y"}}
+test text-6.5 {TextWidgetCmd procedure, "compare" option} {
+ list [.t compare 1.1 < 1.0] [.t compare 1.1 < 1.1] [.t compare 1.1 < 1.2]
+} {0 0 1}
+test text-6.6 {TextWidgetCmd procedure, "compare" option} {
+ list [.t compare 1.1 <= 1.0] [.t compare 1.1 <= 1.1] [.t compare 1.1 <= 1.2]
+} {0 1 1}
+test text-6.7 {TextWidgetCmd procedure, "compare" option} {
+ list [.t compare 1.1 == 1.0] [.t compare 1.1 == 1.1] [.t compare 1.1 == 1.2]
+} {0 1 0}
+test text-6.8 {TextWidgetCmd procedure, "compare" option} {
+ list [.t compare 1.1 >= 1.0] [.t compare 1.1 >= 1.1] [.t compare 1.1 >= 1.2]
+} {1 1 0}
+test text-6.9 {TextWidgetCmd procedure, "compare" option} {
+ list [.t compare 1.1 > 1.0] [.t compare 1.1 > 1.1] [.t compare 1.1 > 1.2]
+} {1 0 0}
+test text-6.10 {TextWidgetCmd procedure, "compare" option} {
+ list [.t com 1.1 != 1.0] [.t compare 1.1 != 1.1] [.t compare 1.1 != 1.2]
+} {1 0 1}
+test text-6.11 {TextWidgetCmd procedure, "compare" option} {
+ list [catch {.t compare 1.0 <x 1.2} msg] $msg
+} {1 {bad comparison operator "<x": must be <, <=, ==, >=, >, or !=}}
+test text-6.12 {TextWidgetCmd procedure, "compare" option} {
+ list [catch {.t compare 1.0 >> 1.2} msg] $msg
+} {1 {bad comparison operator ">>": must be <, <=, ==, >=, >, or !=}}
+test text-6.13 {TextWidgetCmd procedure, "compare" option} {
+ list [catch {.t compare 1.0 z 1.2} msg] $msg
+} {1 {bad comparison operator "z": must be <, <=, ==, >=, >, or !=}}
+test text-6.14 {TextWidgetCmd procedure, "compare" option} {
+ list [catch {.t co 1.0 z 1.2} msg] $msg
+} {1 {bad option "co": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
+
+# "configure" option is already covered above
+
+test text-7.1 {TextWidgetCmd procedure, "debug" option} {
+ list [catch {.t debug 0 1} msg] $msg
+} {1 {wrong # args: should be ".t debug boolean"}}
+test text-7.2 {TextWidgetCmd procedure, "debug" option} {
+ list [catch {.t de 0 1} msg] $msg
+} {1 {bad option "de": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
+test text-7.3 {TextWidgetCmd procedure, "debug" option} {
+ .t debug true
+ .t deb
+} 1
+test text-7.4 {TextWidgetCmd procedure, "debug" option} {
+ .t debug false
+ .t debug
+} 0
+.t debug
+
+test text-8.1 {TextWidgetCmd procedure, "delete" option} {
+ list [catch {.t delete} msg] $msg
+} {1 {wrong # args: should be ".t delete index1 ?index2?"}}
+test text-8.2 {TextWidgetCmd procedure, "delete" option} {
+ list [catch {.t delete a b c} msg] $msg
+} {1 {wrong # args: should be ".t delete index1 ?index2?"}}
+test text-8.3 {TextWidgetCmd procedure, "delete" option} {
+ list [catch {.t delete @x 2.2} msg] $msg
+} {1 {bad text index "@x"}}
+test text-8.4 {TextWidgetCmd procedure, "delete" option} {
+ list [catch {.t delete 2.3 @y} msg] $msg
+} {1 {bad text index "@y"}}
+test text-8.5 {TextWidgetCmd procedure, "delete" option} {
+ .t con -state disabled
+ .t delete 2.3
+ .t g 2.0 2.end
+} abcdefghijklm
+.t con -state normal
+test text-8.6 {TextWidgetCmd procedure, "delete" option} {
+ .t delete 2.3
+ .t get 2.0 2.end
+} abcefghijklm
+test text-8.7 {TextWidgetCmd procedure, "delete" option} {
+ .t delete 2.1 2.3
+ .t get 2.0 2.end
+} aefghijklm
+
+test text-9.1 {TextWidgetCmd procedure, "get" option} {
+ list [catch {.t get} msg] $msg
+} {1 {wrong # args: should be ".t get index1 ?index2?"}}
+test text-9.2 {TextWidgetCmd procedure, "get" option} {
+ list [catch {.t get a b c} msg] $msg
+} {1 {wrong # args: should be ".t get index1 ?index2?"}}
+test text-9.3 {TextWidgetCmd procedure, "get" option} {
+ list [catch {.t get @q 3.1} msg] $msg
+} {1 {bad text index "@q"}}
+test text-9.4 {TextWidgetCmd procedure, "get" option} {
+ list [catch {.t get 3.1 @r} msg] $msg
+} {1 {bad text index "@r"}}
+test text-9.5 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.7 5.3
+} {}
+test text-9.6 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.3 5.5
+} { G}
+test text-9.7 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.3 end
+} { GIrl .#@? x_yz
+!@#$%
+Line 7
+}
+.t mark set a 5.3
+.t mark set b 5.3
+.t mark set c 5.5
+test text-9.8 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.2 5.7
+} {y GIr}
+test text-9.9 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.2
+} {y}
+test text-9.10 {TextWidgetCmd procedure, "get" option} {
+ .t get 5.2 5.4
+} {y }
+
+test text-10.1 {TextWidgetCmd procedure, "index" option} {
+ list [catch {.t index} msg] $msg
+} {1 {wrong # args: should be ".t index index"}}
+test text-10.2 {TextWidgetCmd procedure, "index" option} {
+ list [catch {.t ind a b} msg] $msg
+} {1 {wrong # args: should be ".t index index"}}
+test text-10.3 {TextWidgetCmd procedure, "index" option} {
+ list [catch {.t in a b} msg] $msg
+} {1 {bad option "in": must be bbox, cget, compare, configure, debug, delete, dlineinfo, get, image, index, insert, mark, scan, search, see, tag, window, xview, or yview}}
+test text-10.4 {TextWidgetCmd procedure, "index" option} {
+ list [catch {.t index @xyz} msg] $msg
+} {1 {bad text index "@xyz"}}
+test text-10.5 {TextWidgetCmd procedure, "index" option} {
+ .t index 1.2
+} 1.2
+
+test text-11.1 {TextWidgetCmd procedure, "insert" option} {
+ list [catch {.t insert 1.2} msg] $msg
+} {1 {wrong # args: should be ".t insert index chars ?tagList chars tagList ...?"}}
+test text-11.2 {TextWidgetCmd procedure, "insert" option} {
+ .t config -state disabled
+ .t insert 1.2 xyzzy
+ .t get 1.0 1.end
+} {Line 1}
+.t config -state normal
+test text-11.3 {TextWidgetCmd procedure, "insert" option} {
+ .t insert 1.2 xyzzy
+ .t get 1.0 1.end
+} {Lixyzzyne 1}
+test text-11.4 {TextWidgetCmd procedure, "insert" option} {
+ .t delete 1.0 end
+ .t insert 1.0 "Sample text" x
+ .t tag ranges x
+} {1.0 1.11}
+test text-11.5 {TextWidgetCmd procedure, "insert" option} {
+ .t delete 1.0 end
+ .t insert 1.0 "Sample text" x
+ .t insert 1.2 "XYZ" y
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.0 1.2 1.5 1.14} {1.2 1.5}}
+test text-11.6 {TextWidgetCmd procedure, "insert" option} {
+ .t delete 1.0 end
+ .t insert 1.0 "Sample text" {x y z}
+ list [.t tag ranges x] [.t tag ranges y] [.t tag ranges z]
+} {{1.0 1.11} {1.0 1.11} {1.0 1.11}}
+test text-11.7 {TextWidgetCmd procedure, "insert" option} {
+ .t delete 1.0 end
+ .t insert 1.0 "Sample text" {x y z}
+ .t insert 1.3 "A" {a b z}
+ list [.t tag ranges a] [.t tag ranges b] [.t tag ranges x] [.t tag ranges y] [.t tag ranges z]
+} {{1.3 1.4} {1.3 1.4} {1.0 1.3 1.4 1.12} {1.0 1.3 1.4 1.12} {1.0 1.12}}
+test text-11.8 {TextWidgetCmd procedure, "insert" option} {
+ .t delete 1.0 end
+ list [catch {.t insert 1.0 "Sample text" "a \{b"} msg] $msg
+} {1 {unmatched open brace in list}}
+test text-11.9 {TextWidgetCmd procedure, "insert" option} {
+ .t delete 1.0 end
+ .t insert 1.0 "First" bold " " {} second "x y z" " third"
+ list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges x] \
+ [.t tag ranges y] [.t tag ranges z]
+} {{First second third} {1.0 1.5} {1.6 1.12} {1.6 1.12} {1.6 1.12}}
+test text-11.10 {TextWidgetCmd procedure, "insert" option} {
+ .t delete 1.0 end
+ .t insert 1.0 "First" bold " second" silly
+ list [.t get 1.0 1.end] [.t tag ranges bold] [.t tag ranges silly]
+} {{First second} {1.0 1.5} {1.5 1.12}}
+
+# Mark, scan, search, see, tag, window, xview, and yview actions are tested elsewhere.
+
+test text-12.1 {ConfigureText procedure} {
+ list [catch {.t2 configure -state foobar} msg] $msg
+} {1 {bad state value "foobar": must be normal or disabled}}
+test text-12.2 {ConfigureText procedure} {
+ .t2 configure -spacing1 -2 -spacing2 1 -spacing3 1
+ list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
+} {0 1 1}
+test text-12.3 {ConfigureText procedure} {
+ .t2 configure -spacing1 1 -spacing2 -1 -spacing3 1
+ list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
+} {1 0 1}
+test text-12.4 {ConfigureText procedure} {
+ .t2 configure -spacing1 1 -spacing2 1 -spacing3 -3
+ list [.t2 cget -spacing1] [.t2 cget -spacing2] [.t2 cget -spacing3]
+} {1 1 0}
+test text-12.5 {ConfigureText procedure} {
+ set x [list [catch {.t2 configure -tabs {30 foo}} msg] $msg $errorInfo]
+ .t2 configure -tabs {10 20 30}
+ set x
+} {1 {bad tab alignment "foo": must be left, right, center, or numeric} {bad tab alignment "foo": must be left, right, center, or numeric
+ (while processing -tabs option)
+ invoked from within
+".t2 configure -tabs {30 foo}"}}
+test text-12.6 {ConfigureText procedure} {
+ .t2 configure -tabs {10 20 30}
+ .t2 configure -tabs {}
+ .t2 cget -tabs
+} {}
+test text-12.7 {ConfigureText procedure} {
+ list [catch {.t2 configure -wrap bogus} msg] $msg
+} {1 {bad wrap mode "bogus": must be char, none, or word}}
+test text-12.8 {ConfigureText procedure} {
+ .t2 configure -selectborderwidth 17 -selectforeground #332211 \
+ -selectbackground #abc
+ list [lindex [.t2 tag config sel -borderwidth] 4] \
+ [lindex [.t2 tag config sel -foreground] 4] \
+ [lindex [.t2 tag config sel -background] 4]
+} {17 #332211 #abc}
+test text-12.9 {ConfigureText procedure} {
+ .t2 configure -selectborderwidth {}
+ .t2 tag cget sel -borderwidth
+} {}
+test text-12.10 {ConfigureText procedure} {
+ list [catch {.t2 configure -selectborderwidth foo} msg] $msg
+} {1 {bad screen distance "foo"}}
+test text-12.11 {ConfigureText procedure} {
+ catch {destroy .t2}
+ .t.e select to 2
+ text .t2 -exportselection 1
+ selection get
+} {ab}
+test text-12.12 {ConfigureText procedure} {
+ catch {destroy .t2}
+ .t.e select to 2
+ text .t2 -exportselection 0
+ .t2 insert insert 1234657890
+ .t2 tag add sel 1.0 1.4
+ selection get
+} {ab}
+test text-12.13 {ConfigureText procedure} {
+ catch {destroy .t2}
+ .t.e select to 1
+ text .t2 -exportselection 1
+ .t2 insert insert 1234657890
+ .t2 tag add sel 1.0 1.4
+ selection get
+} {1234}
+test text-12.14 {ConfigureText procedure} {
+ catch {destroy .t2}
+ .t.e select to 1
+ text .t2 -exportselection 0
+ .t2 insert insert 1234657890
+ .t2 tag add sel 1.0 1.4
+ .t2 configure -exportselection 1
+ selection get
+} {1234}
+test text-12.15 {ConfigureText procedure} {
+ catch {destroy .t2}
+ text .t2 -exportselection 1
+ .t2 insert insert 1234657890
+ .t2 tag add sel 1.0 1.4
+ set result [selection get]
+ .t2 configure -exportselection 0
+ lappend result [catch {selection get} msg] $msg
+} {1234 1 {PRIMARY selection doesn't exist or form "STRING" not defined}}
+test text-12.16 {ConfigureText procedure} {fonts} {
+ # This test is non-portable because the window size will vary depending
+ # on the font size, which can vary.
+
+ catch {destroy .t2}
+ toplevel .t2
+ text .t2.t -width 20 -height 10
+ pack append .t2 .t2.t top
+ wm geometry .t2 +0+0
+ update
+ wm geometry .t2
+} {150x140+0+0}
+test text-12.17 {ConfigureText procedure} {
+ # This test was failing Windows because the title bar on .t2
+ # was a certain minimum size and it was interfering with the size
+ # requested by the -setgrid. The "overrideredirect" gets rid of the
+ # titlebar so the toplevel can shrink to the appropriate size.
+
+ catch {destroy .t2}
+ toplevel .t2
+ wm overrideredirect .t2 1
+ text .t2.t -width 20 -height 10 -setgrid 1
+ pack append .t2 .t2.t top
+ wm geometry .t2 +0+0
+ update
+ wm geometry .t2
+} {20x10+0+0}
+test text-12.18 {ConfigureText procedure} {
+ # This test was failing on Windows because the title bar on .t2
+ # was a certain minimum size and it was interfering with the size
+ # requested by the -setgrid. The "overrideredirect" gets rid of the
+ # titlebar so the toplevel can shrink to the appropriate size.
+
+ catch {destroy .t2}
+ toplevel .t2
+ wm overrideredirect .t2 1
+ text .t2.t -width 20 -height 10 -setgrid 1
+ pack append .t2 .t2.t top
+ wm geometry .t2 +0+0
+ update
+ set result [wm geometry .t2]
+ wm geometry .t2 15x8
+ update
+ lappend result [wm geometry .t2]
+ .t2.t configure -wrap word
+ update
+ lappend result [wm geometry .t2]
+} {20x10+0+0 15x8+0+0 15x8+0+0}
+
+test text-13.1 {TextWorldChanged procedure, spacing options} fonts {
+ catch {destroy .t2}
+ text .t2 -width 20 -height 10
+ set result [winfo reqheight .t2]
+ .t2 configure -spacing1 2
+ lappend result [winfo reqheight .t2]
+ .t2 configure -spacing3 1
+ lappend result [winfo reqheight .t2]
+ .t2 configure -spacing1 0
+ lappend result [winfo reqheight .t2]
+} {140 160 170 150}
+
+test text-14.1 {TextEventProc procedure} {
+ text .tx1 -bg #543210
+ rename .tx1 .tx2
+ set x {}
+ lappend x [winfo exists .tx1]
+ lappend x [.tx2 cget -bg]
+ destroy .tx1
+ lappend x [info command .tx*] [winfo exists .tx1] [winfo exists .tx2]
+} {1 #543210 {} 0 0}
+
+test text-15.1 {TextCmdDeletedProc procedure} {
+ text .tx1
+ rename .tx1 {}
+ list [info command .tx*] [winfo exists .tx1]
+} {{} 0}
+test text-15.2 {TextCmdDeletedProc procedure, disabling -setgrid} fonts {
+ catch {destroy .top}
+ toplevel .top
+ wm geom .top +0+0
+ text .top.t -setgrid 1 -width 20 -height 10
+ pack .top.t
+ update
+ set x [wm geometry .top]
+ rename .top.t {}
+ update
+ lappend x [wm geometry .top]
+ destroy .top
+ set x
+} {20x10+0+0 150x140+0+0}
+
+test text-16.1 {InsertChars procedure} {
+ catch {destroy .t2}
+ text .t2
+ .t2 insert 2.0 abcd\n
+ .t2 get 1.0 end
+} {abcd
+
+}
+test text-16.2 {InsertChars procedure} {
+ catch {destroy .t2}
+ text .t2
+ .t2 insert 1.0 abcd\n
+ .t2 insert end 123\n
+ .t2 get 1.0 end
+} {abcd
+123
+
+}
+test text-16.3 {InsertChars procedure} {
+ catch {destroy .t2}
+ text .t2
+ .t2 insert 1.0 abcd\n
+ .t2 insert 10.0 123
+ .t2 get 1.0 end
+} {abcd
+123
+}
+test text-16.4 {InsertChars procedure, inserting on top visible line} {
+ catch {destroy .t2}
+ text .t2 -width 20 -height 4 -wrap word
+ pack .t2
+ .t2 insert insert "Now is the time for all great men to come to the "
+ .t2 insert insert "aid of their party.\n"
+ .t2 insert insert "Now is the time for all great men.\n"
+ .t2 see end
+ update
+ .t2 insert 1.0 "Short\n"
+ .t2 index @0,0
+} {2.56}
+test text-16.5 {InsertChars procedure, inserting on top visible line} {
+ catch {destroy .t2}
+ text .t2 -width 20 -height 4 -wrap word
+ pack .t2
+ .t2 insert insert "Now is the time for all great men to come to the "
+ .t2 insert insert "aid of their party.\n"
+ .t2 insert insert "Now is the time for all great men.\n"
+ .t2 see end
+ update
+ .t2 insert 1.55 "Short\n"
+ .t2 index @0,0
+} {2.0}
+test text-16.6 {InsertChars procedure, inserting on top visible line} {
+ catch {destroy .t2}
+ text .t2 -width 20 -height 4 -wrap word
+ pack .t2
+ .t2 insert insert "Now is the time for all great men to come to the "
+ .t2 insert insert "aid of their party.\n"
+ .t2 insert insert "Now is the time for all great men.\n"
+ .t2 see end
+ update
+ .t2 insert 1.56 "Short\n"
+ .t2 index @0,0
+} {1.56}
+test text-16.7 {InsertChars procedure, inserting on top visible line} {
+ catch {destroy .t2}
+ text .t2 -width 20 -height 4 -wrap word
+ pack .t2
+ .t2 insert insert "Now is the time for all great men to come to the "
+ .t2 insert insert "aid of their party.\n"
+ .t2 insert insert "Now is the time for all great men.\n"
+ .t2 see end
+ update
+ .t2 insert 1.57 "Short\n"
+ .t2 index @0,0
+} {1.56}
+catch {destroy .t2}
+
+proc setup {} {
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1
+abcde
+12345
+Line 4"
+}
+
+.t delete 1.0 end
+test text-17.1 {DeleteChars procedure} {
+ .t get 1.0 end
+} {
+}
+test text-17.2 {DeleteChars procedure} {
+ list [catch {.t delete foobar} msg] $msg
+} {1 {bad text index "foobar"}}
+test text-17.3 {DeleteChars procedure} {
+ list [catch {.t delete 1.0 lousy} msg] $msg
+} {1 {bad text index "lousy"}}
+test text-17.4 {DeleteChars procedure} {
+ setup
+ .t delete 2.1
+ .t get 1.0 end
+} {Line 1
+acde
+12345
+Line 4
+}
+test text-17.5 {DeleteChars procedure} {
+ setup
+ .t delete 2.3
+ .t get 1.0 end
+} {Line 1
+abce
+12345
+Line 4
+}
+test text-17.6 {DeleteChars procedure} {
+ setup
+ .t delete 2.end
+ .t get 1.0 end
+} {Line 1
+abcde12345
+Line 4
+}
+test text-17.7 {DeleteChars procedure} {
+ setup
+ .t tag add sel 4.2 end
+ .t delete 4.2 end
+ list [.t tag ranges sel] [.t get 1.0 end]
+} {{} {Line 1
+abcde
+12345
+Li
+}}
+test text-17.8 {DeleteChars procedure} {
+ setup
+ .t tag add sel 1.0 end
+ .t delete 4.0 end
+ list [.t tag ranges sel] [.t get 1.0 end]
+} {{1.0 3.5} {Line 1
+abcde
+12345
+}}
+test text-17.9 {DeleteChars procedure} {
+ setup
+ .t delete 2.2 2.2
+ .t get 1.0 end
+} {Line 1
+abcde
+12345
+Line 4
+}
+test text-17.10 {DeleteChars procedure} {
+ setup
+ .t delete 2.3 2.1
+ .t get 1.0 end
+} {Line 1
+abcde
+12345
+Line 4
+}
+test text-17.11 {DeleteChars procedure} {
+ catch {destroy .t2}
+ toplevel .t2
+ text .t2.t -width 20 -height 5
+ pack append .t2 .t2.t top
+ wm geometry .t2 +0+0
+ .t2.t insert 1.0 "abc\n123\nx\ny\nz\nq\nr\ns"
+ update
+ .t2.t delete 1.0 3.0
+ list [.t2.t index @0,0] [.t2.t get @0,0]
+} {1.0 x}
+test text-17.12 {DeleteChars procedure} {
+ catch {destroy .t2}
+ toplevel .t2
+ text .t2.t -width 20 -height 5
+ pack append .t2 .t2.t top
+ wm geometry .t2 +0+0
+ .t2.t insert 1.0 "abc\n123\nx\ny\nz\nq\nr\ns"
+ .t2.t yview 3.0
+ update
+ .t2.t delete 2.0 4.0
+ list [.t2.t index @0,0] [.t2.t get @0,0]
+} {2.0 y}
+catch {destroy .t2}
+toplevel .t2
+text .t2.t -width 1 -height 10 -wrap char
+frame .t2.f -width 200 -height 20 -relief raised -bd 2
+pack .t2.f .t2.t -side left
+wm geometry .t2 +0+0
+update
+test text-17.13 {DeleteChars procedure, updates affecting topIndex} {
+ .t2.t delete 1.0 end
+ .t2.t insert end "abcde\n12345\nqrstuv"
+ .t2.t yview 2.1
+ .t2.t delete 1.4 2.3
+ .t2.t index @0,0
+} {1.2}
+test text-17.14 {DeleteChars procedure, updates affecting topIndex} {
+ .t2.t delete 1.0 end
+ .t2.t insert end "abcde\n12345\nqrstuv"
+ .t2.t yview 2.1
+ .t2.t delete 2.3 2.4
+ .t2.t index @0,0
+} {2.0}
+test text-17.15 {DeleteChars procedure, updates affecting topIndex} {
+ .t2.t delete 1.0 end
+ .t2.t insert end "abcde\n12345\nqrstuv"
+ .t2.t yview 1.3
+ .t2.t delete 1.0 1.2
+ .t2.t index @0,0
+} {1.1}
+test text-17.16 {DeleteChars procedure, updates affecting topIndex} {
+ catch {destroy .t2}
+ toplevel .t2
+ text .t2.t -width 6 -height 10 -wrap word
+ frame .t2.f -width 200 -height 20 -relief raised -bd 2
+ pack .t2.f .t2.t -side left
+ wm geometry .t2 +0+0
+ update
+ .t2.t insert end "abc def\n01 2345 678 9101112\nLine 3\nLine 4\nLine 5\n6\n7\n8\n"
+ .t2.t yview 2.4
+ .t2.t delete 2.5
+ set x [.t2.t index @0,0]
+ .t2.t delete 2.5
+ list $x [.t2.t index @0,0]
+} {2.3 2.0}
+
+.t delete 1.0 end
+foreach i {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} {
+ .t insert end $i.0$i.1$i.2$i.3$i.4\n
+}
+test text-18.1 {TextFetchSelection procedure} {
+ .t tag add sel 1.3 3.4
+ selection get
+} {a.1a.2a.3a.4
+b.0b.1b.2b.3b.4
+c.0c}
+test text-18.2 {TextFetchSelection procedure} {
+ .t tag add x 1.2
+ .t tag add x 1.4
+ .t tag add x 2.0
+ .t tag add x 2.3
+ .t tag remove sel 1.0 end
+ .t tag add sel 1.0 3.4
+ selection get
+} {a.0a.1a.2a.3a.4
+b.0b.1b.2b.3b.4
+c.0c}
+test text-18.3 {TextFetchSelection procedure} {
+ .t tag remove sel 1.0 end
+ .t tag add sel 13.3
+ selection get
+} {m}
+test text-18.4 {TextFetchSelection procedure} {
+ .t tag remove x 1.0 end
+ .t tag add sel 1.0 3.4
+ .t tag remove sel 1.0 end
+ .t tag add sel 1.2 1.5
+ .t tag add sel 2.4 3.1
+ .t tag add sel 10.0 10.end
+ .t tag add sel 13.3
+ selection get
+} {0a..1b.2b.3b.4
+cj.0j.1j.2j.3j.4m}
+set x ""
+for {set i 1} {$i < 200} {incr i} {
+ append x "This is line $i, padded to just about 53 characters.\n"
+}
+test text-18.5 {TextFetchSelection procedure, long selections} {
+ .t delete 1.0 end
+ .t insert end $x
+ .t tag add sel 1.0 end
+ selection get
+} $x\n
+
+test text-19.1 {TkTextLostSelection procedure} {unixOnly} {
+ catch {destroy .t2}
+ text .t2
+ .t2 insert 1.0 "abc\ndef\nghijk\n1234"
+ .t2 tag add sel 1.2 3.3
+ .t.e select to 1
+ .t2 tag ranges sel
+} {}
+test text-19.2 {TkTextLostSelection procedure} {macOrPc} {
+ catch {destroy .t2}
+ text .t2
+ .t2 insert 1.0 "abc\ndef\nghijk\n1234"
+ .t2 tag add sel 1.2 3.3
+ .t.e select to 1
+ .t2 tag ranges sel
+} {1.2 3.3}
+catch {destroy .t2}
+test text-19.3 {TkTextLostSelection procedure} {
+ catch {destroy .t2}
+ text .t2
+ .t2 insert 1.0 "abcdef\nghijk\n1234"
+ .t2 tag add sel 1.0 1.3
+ set x [selection get]
+ selection clear
+ lappend x [catch {selection get} msg] $msg
+ .t2 tag add sel 1.0 1.3
+ lappend x [selection get]
+} {abc 1 {PRIMARY selection doesn't exist or form "STRING" not defined} abc}
+
+.t delete 1.0 end
+.t insert end "xxyz xyz x. the\nfoo -forward bar xxxxx BaR foo\nxyz xxyzx"
+test text-20.1 {TextSearchCmd procedure, argument parsing} {
+ list [catch {.t search -} msg] $msg
+} {1 {bad switch "-": must be -forward, -backward, -exact, -regexp, -nocase, -count, or --}}
+test text-20.2 {TextSearchCmd procedure, -backwards option} {
+ .t search -backwards xyz 1.4
+} {1.1}
+test text-20.3 {TextSearchCmd procedure, -forwards option} {
+ .t search -forwards xyz 1.4
+} {1.5}
+test text-20.4 {TextSearchCmd procedure, -exact option} {
+ .t search -f -exact x. 1.0
+} {1.9}
+test text-20.5 {TextSearchCmd procedure, -regexp option} {
+ .t search -b -regexp x.z 1.4
+} {1.1}
+test text-20.6 {TextSearchCmd procedure, -count option} {
+ set length unmodified
+ list [.t search -count length x. 1.4] $length
+} {1.9 2}
+test text-20.7 {TextSearchCmd procedure, -count option} {
+ list [catch {.t search -count} msg] $msg
+} {1 {no value given for "-count" option}}
+test text-20.8 {TextSearchCmd procedure, -nocase option} {
+ list [.t search -nocase BaR 1.1] [.t search BaR 1.1]
+} {2.13 2.23}
+test text-20.9 {TextSearchCmd procedure, -nocase option} {
+ .t search -n BaR 1.1
+} {2.13}
+test text-20.10 {TextSearchCmd procedure, -- option} {
+ .t search -- -forward 1.0
+} {2.4}
+test text-20.11 {TextSearchCmd procedure, argument parsing} {
+ list [catch {.t search abc} msg] $msg
+} {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?}}
+test text-20.12 {TextSearchCmd procedure, argument parsing} {
+ list [catch {.t search abc d e f} msg] $msg
+} {1 {wrong # args: should be ".t search ?switches? pattern index ?stopIndex?}}
+test text-20.13 {TextSearchCmd procedure, check index} {
+ list [catch {.t search abc gorp} msg] $msg
+} {1 {bad text index "gorp"}}
+test text-20.14 {TextSearchCmd procedure, startIndex == "end"} {
+ .t search non-existent end
+} {}
+test text-20.15 {TextSearchCmd procedure, startIndex == "end"} {
+ .t search non-existent end
+} {}
+test text-20.16 {TextSearchCmd procedure, bad stopIndex} {
+ 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} {
+ .t search \n end
+} {1.15}
+test text-20.22 {TextSearchCmd procedure, skip dummy last line} {
+ .t search -back \n 1.0
+} {3.9}
+test text-20.23 {TextSearchCmd procedure, extract line contents} {
+ .t tag add foo 1.2
+ .t tag add x 1.3
+ .t mark set silly 1.2
+ .t search xyz 3.6
+} {1.1}
+test text-20.24 {TextSearchCmd procedure, stripping newlines} {
+ .t search the\n 1.0
+} {1.12}
+test text-20.25 {TextSearchCmd procedure, stripping newlines} {
+ .t search -regexp the\n 1.0
+} {}
+test text-20.26 {TextSearchCmd procedure, stripping newlines} {
+ .t search -regexp {the$} 1.0
+} {1.12}
+test text-20.27 {TextSearchCmd procedure, stripping newlines} {
+ .t search -regexp \n 1.0
+} {}
+test text-20.28 {TextSearchCmd procedure, line case conversion} {
+ list [.t search -nocase bar 2.18] [.t search bar 2.18]
+} {2.23 2.13}
+test text-20.29 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t search -backwards xyz 1.6
+} {1.5}
+test text-20.30 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t search -backwards xyz 1.5
+} {1.1}
+test text-20.31 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t search xyz 1.5
+} {1.5}
+test text-20.32 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t search xyz 1.6
+} {3.0}
+test text-20.33 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t search {} 1.end
+} {1.15}
+test text-20.34 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t search f 1.end
+} {2.0}
+test text-20.35 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t search {} end
+} {1.0}
+catch {destroy .t2}
+toplevel .t2
+wm geometry .t2 +0+0
+text .t2.t -width 30 -height 10
+pack .t2.t
+.t2.t insert 1.0 "This is a line\nand this is another"
+.t2.t insert end "\nand this is yet another"
+frame .t2.f -width 20 -height 20 -bd 2 -relief raised
+.t2.t window create 2.5 -window .t2.f
+test text-20.36 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t2.t search his 2.6
+} {2.6}
+test text-20.37 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t2.t search this 2.6
+} {3.4}
+test text-20.38 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t2.t search is 2.6
+} {2.7}
+test text-20.39 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t2.t search his 2.7
+} {3.5}
+test text-20.40 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t2.t search -backwards "his is another" 2.6
+} {2.6}
+test text-20.41 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t2.t search -backwards "his is" 2.6
+} {1.1}
+destroy .t2
+test text-20.42 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t search -backwards forw 2.5
+} {2.5}
+test text-20.43 {TextSearchCmd procedure, firstChar and lastChar} {
+ .t search forw 2.5
+} {2.5}
+test text-20.44 {TextSearchCmd procedure, firstChar and lastChar} {
+ catch {destroy .t2}
+ text .t2
+ list [.t2 search a 1.0] [.t2 search -backward a 1.0]
+} {{} {}}
+test text-20.45 {TextSearchCmd procedure, regexp match length} {
+ set length unchanged
+ list [.t search -regexp -count length x(.)(.*)z 1.1] $length
+} {1.1 7}
+test text-20.46 {TextSearchCmd procedure, regexp match length} {
+ set length unchanged
+ list [.t search -regexp -backward -count length fo* 2.5] $length
+} {2.0 3}
+test text-20.47 {TextSearchCmd procedure, checking stopIndex} {
+ list [.t search bar 2.1 2.13] [.t search bar 2.1 2.14] \
+ [.t search bar 2.12 2.14] [.t search bar 2.14 2.14]
+} {{} 2.13 2.13 {}}
+test text-20.48 {TextSearchCmd procedure, checking stopIndex} {
+ list [.t search -backwards bar 2.20 2.13] \
+ [.t search -backwards bar 2.20 2.14] \
+ [.t search -backwards bar 2.14 2.13] \
+ [.t search -backwards bar 2.13 2.13]
+} {2.13 {} 2.13 {}}
+test text-20.49 {TextSearchCmd procedure, embedded windows and index/count} {
+ frame .t.f1 -width 20 -height 20 -relief raised -bd 2
+ frame .t.f2 -width 20 -height 20 -relief raised -bd 2
+ frame .t.f3 -width 20 -height 20 -relief raised -bd 2
+ frame .t.f4 -width 20 -height 20 -relief raised -bd 2
+ .t window create 2.10 -window .t.f3
+ .t window create 2.8 -window .t.f2
+ .t window create 2.8 -window .t.f1
+ .t window create 2.1 -window .t.f4
+ set result ""
+ lappend result [.t search -count x forward 1.0] $x
+ lappend result [.t search -count x wa 1.0] $x
+ .t delete 2.1
+ .t delete 2.8 2.10
+ .t delete 2.10
+ set result
+} {2.6 10 2.11 2}
+test text-20.50 {TextSearchCmd procedure, error setting variable} {
+ catch {unset a}
+ set a 44
+ list [catch {.t search -count a(2) xyz 1.0} msg] $msg
+} {1 {can't set "a(2)": variable isn't array}}
+test text-20.51 {TextSearchCmd procedure, wrap-around} {
+ .t search -backwards xyz 1.1
+} {3.5}
+test text-20.52 {TextSearchCmd procedure, wrap-around} {
+ .t search -backwards xyz 1.1 1.0
+} {}
+test text-20.53 {TextSearchCmd procedure, wrap-around} {
+ .t search xyz 3.6
+} {1.1}
+test text-20.54 {TextSearchCmd procedure, wrap-around} {
+ .t search xyz 3.6 end
+} {}
+test text-20.55 {TextSearchCmd procedure, no match} {
+ .t search non_existent 3.5
+} {}
+test text-20.56 {TextSearchCmd procedure, no match} {
+ .t search -regexp non_existent 3.5
+} {}
+test text-20.57 {TextSearchCmd procedure, special cases} {
+ .t search -back x 1.1
+} {1.0}
+test text-20.58 {TextSearchCmd procedure, special cases} {
+ .t search -back x 1.0
+} {3.8}
+test text-20.59 {TextSearchCmd procedure, special cases} {
+ .t search \n {end-2c}
+} {3.9}
+test text-20.60 {TextSearchCmd procedure, special cases} {
+ .t search \n end
+} {1.15}
+test text-20.61 {TextSearchCmd procedure, special cases} {
+ .t search x 1.0
+} {1.0}
+test text-20.62 {TextSearchCmd, freeing copy of pattern} {
+ # This test doesn't return a result, but it will generate
+ # 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
+} {1 {unmatched open brace in list}}
+test text-21.2 {TkTextGetTabs procedure} {
+ list [catch {.t2 configure -tabs xyz} msg] $msg
+} {1 {bad screen distance "xyz"}}
+test text-21.3 {TkTextGetTabs procedure} {
+ .t2 configure -tabs {100 200}
+ update idletasks
+ list [lindex [.t2 bbox 1.2] 0] [lindex [.t2 bbox 1.4] 0]
+} {100 200}
+test text-21.4 {TkTextGetTabs procedure} {
+ .t2 configure -tabs {100 right 200 left 300 center 400 numeric}
+ update idletasks
+ list [expr [lindex [.t2 bbox 1.2] 0] + [lindex [.t2 bbox 1.2] 2]] \
+ [lindex [.t2 bbox 1.4] 0] \
+ [expr [lindex [.t2 bbox 1.6] 0] + [lindex [.t2 bbox 1.6] 2]/2] \
+ [lindex [.t2 bbox 1.10] 0]
+} {100 200 300 400}
+test text-21.5 {TkTextGetTabs procedure} {
+ .t2 configure -tabs {105 r 205 l 305 c 405 n}
+ update idletasks
+ list [expr [lindex [.t2 bbox 1.2] 0] + [lindex [.t2 bbox 1.2] 2]] \
+ [lindex [.t2 bbox 1.4] 0] \
+ [expr [lindex [.t2 bbox 1.6] 0] + [lindex [.t2 bbox 1.6] 2]/2] \
+ [lindex [.t2 bbox 1.10] 0]
+} {105 205 305 405}
+test text-21.6 {TkTextGetTabs procedure} {
+ list [catch {.t2 configure -tabs {100 left 200 lork}} msg] $msg
+} {1 {bad tab alignment "lork": must be left, right, center, or numeric}}
+test text-21.7 {TkTextGetTabs procedure} {
+ list [catch {.t2 configure -tabs {100 !44 200 lork}} msg] $msg
+} {1 {bad screen distance "!44"}}
+
+eval destroy [winfo child .]
+text .t
+pack .t
+.t insert 1.0 "One Line"
+.t mark set insert 1.0
+
+test text-22.1 {TextDumpCmd procedure, bad args} {
+ list [catch {.t dump} msg] $msg
+} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
+test text-22.2 {TextDumpCmd procedure, bad args} {
+ list [catch {.t dump -all} msg] $msg
+} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
+test text-22.3 {TextDumpCmd procedure, bad args} {
+ list [catch {.t dump -command} msg] $msg
+} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
+test text-22.4 {TextDumpCmd procedure, bad args} {
+ list [catch {.t dump -bogus} msg] $msg
+} {1 {Usage: .t dump ?-all -image -text -mark -tag -window? ?-command script? index ?index2?}}
+test text-22.5 {TextDumpCmd procedure, bad args} {
+ list [catch {.t dump bogus} msg] $msg
+} {1 {bad text index "bogus"}}
+test text-22.6 {TextDumpCmd procedure, one index} {
+ .t dump -text 1.2
+} {text e 1.2}
+test text-22.7 {TextDumpCmd procedure, two indices} {
+ .t dump -text 1.0 1.end
+} {text {One Line} 1.0}
+test text-22.8 {TextDumpCmd procedure, "end" index} {
+ .t dump -text 1.end end
+} {text {
+} 1.8}
+test text-22.9 {TextDumpCmd procedure, same indices} {
+ .t dump 1.5 1.5
+} {}
+test text-22.10 {TextDumpCmd procedure, negative range} {
+ .t dump 1.5 1.0
+} {}
+
+.t delete 1.0 end
+.t insert end "Line One\nLine Two\nLine Three\nLine Four"
+.t mark set insert 1.0
+.t mark set current 1.0
+
+test text-22.11 {TextDumpCmd procedure, stop at begin-line} {
+ .t dump -text 1.0 2.0
+} {text {Line One
+} 1.0}
+test text-22.12 {TextDumpCmd procedure, span multiple lines} {
+ .t dump -text 1.5 3.end
+} {text {One
+} 1.5 text {Line Two
+} 2.0 text {Line Three} 3.0}
+
+.t tag add x 2.0 2.end
+.t tag add y 1.0 end
+.t mark set m 2.4
+.t mark set n 4.0
+.t mark set END end
+test text-22.13 {TextDumpCmd procedure, tags only} {
+ .t dump -tag 2.1 2.8
+} {}
+test text-22.14 {TextDumpCmd procedure, tags only} {
+ .t dump -tag 2.0 2.8
+} {tagon x 2.0}
+test text-22.15 {TextDumpCmd procedure, tags only} {
+ .t dump -tag 1.0 4.end
+} {tagon y 1.0 tagon x 2.0 tagoff x 2.8}
+test text-22.16 {TextDumpCmd procedure, tags only} {
+ .t dump -tag 1.0 end
+} {tagon y 1.0 tagon x 2.0 tagoff x 2.8 tagoff y 5.0}
+
+.t mark set insert 1.0
+.t mark set current 1.0
+test text-22.17 {TextDumpCmd procedure, marks only} {
+ .t dump -mark 1.1 1.8
+} {}
+test text-22.18 {TextDumpCmd procedure, marks only} {
+ .t dump -mark 2.0 2.8
+} {mark m 2.4}
+test text-22.19 {TextDumpCmd procedure, marks only} {
+ .t dump -mark 1.1 4.end
+} {mark m 2.4 mark n 4.0}
+test text-22.20 {TextDumpCmd procedure, marks only} {
+ .t dump -mark 1.0 end
+} {mark current 1.0 mark insert 1.0 mark m 2.4 mark n 4.0 mark END 5.0}
+
+button .hello -text Hello
+.t window create 3.end -window .hello
+for {set i 0} {$i < 100} {incr i} {
+ .t insert end "-\n"
+}
+.t window create 100.0 -create { }
+test text-22.21 {TextDumpCmd procedure, windows only} {
+ .t dump -window 1.0 5.0
+} {window .hello 3.10}
+test text-22.22 {TextDumpCmd procedure, windows only} {
+ .t dump -window 5.0 end
+} {window {} 100.0}
+
+.t delete 1.0 end
+eval {.t mark unset} [.t mark names]
+.t insert end "Line One\nLine Two\nLine Three\nLine Four"
+.t mark set insert 1.0
+.t mark set current 1.0
+.t tag add x 2.0 2.end
+.t mark set m 2.4
+proc Append {varName key value index} {
+ upvar #0 $varName x
+ lappend x $key $index $value
+}
+test text-22.23 {TextDumpCmd procedure, command script} {
+ set x {}
+ .t dump -command {Append x} -all 1.0 end
+ set x
+} {mark 1.0 current mark 1.0 insert text 1.0 {Line One
+} tagon 2.0 x text 2.0 Line mark 2.4 m text 2.4 { Two} tagoff 2.8 x text 2.8 {
+} text 3.0 {Line Three
+} text 4.0 {Line Four
+}}
+test text-22.24 {TextDumpCmd procedure, command script} {
+ set x {}
+ .t dump -mark -command {Append x} 1.0 end
+ set x
+} {mark 1.0 current mark 1.0 insert mark 2.4 m}
+catch {unset x}
+
+set l [interp hidden]
+eval destroy [winfo children .]
+
+test text-23.1 {text widget vs hidden commands} {
+ catch {destroy .t}
+ text .t
+ interp hide {} .t
+ destroy .t
+ list [winfo children .] [interp hidden]
+} [list {} $l]
+
+eval destroy [winfo child .]
+option clear
diff --git a/tk/tests/textBTree.test b/tk/tests/textBTree.test
new file mode 100644
index 00000000000..415ed5c3b9f
--- /dev/null
+++ b/tk/tests/textBTree.test
@@ -0,0 +1,897 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t get 1.0 1000000.0
+} "Line 1\nLine 2\nLine 3\n"
+test btree-1.2 {basic insertions} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t insert 1.3 XXX
+ .t get 1.0 1000000.0
+} "LinXXXe 1\nLine 2\nLine 3\n"
+test btree-1.3 {basic insertions} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t insert 3.0 YYY
+ .t get 1.0 1000000.0
+} "Line 1\nLine 2\nYYYLine 3\n"
+test btree-1.4 {basic insertions} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t insert 2.1 X\nYY
+ .t get 1.0 1000000.0
+} "Line 1\nLX\nYYine 2\nLine 3\n"
+test btree-1.5 {basic insertions} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t insert 2.0 X\n\n\n
+ .t get 1.0 1000000.0
+} "Line 1\nX\n\n\nLine 2\nLine 3\n"
+test btree-1.6 {basic insertions} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t insert 2.6 X\n
+ .t get 1.0 1000000.0
+} "Line 1\nLine 2X\n\nLine 3\n"
+test btree-1.7 {insertion before start of text} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t insert 0.4 XXX
+ .t get 1.0 1000000.0
+} "XXXLine 1\nLine 2\nLine 3\n"
+test btree-1.8 {insertion past end of text} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t insert 100.0 ZZ
+ .t get 1.0 1000000.0
+} "Line 1\nLine 2\nLine 3ZZ\n"
+test btree-1.9 {insertion before start of line} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t insert 2.-3 Q
+ .t get 1.0 1000000.0
+} "Line 1\nQLine 2\nLine 3\n"
+test btree-1.10 {insertion past end of line} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t insert 2.40 XYZZY
+ .t get 1.0 1000000.0
+} "Line 1\nLine 2XYZZY\nLine 3\n"
+test btree-1.11 {insertion past end of last line} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t insert 3.40 ABC
+ .t get 1.0 1000000.0
+} "Line 1\nLine 2\nLine 3ABC\n"
+
+test btree-2.1 {basic deletions} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 1.0 1.3
+ .t get 1.0 1000000.0
+} "e 1\nLine 2\nLine 3\n"
+test btree-2.2 {basic deletions} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 2.2
+ .t get 1.0 1000000.0
+} "Line 1\nLie 2\nLine 3\n"
+test btree-2.3 {basic deletions} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 2.0 2.3
+ .t get 1.0 1000000.0
+} "Line 1\ne 2\nLine 3\n"
+test btree-2.4 {deleting whole lines} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 1.2 3.0
+ .t get 1.0 1000000.0
+} "LiLine 3\n"
+test btree-2.5 {deleting whole lines} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\n\n\nLine 5"
+ .t delete 1.0 5.2
+ .t get 1.0 1000000.0
+} "ne 5\n"
+test btree-2.6 {deleting before start of file} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 0.3 1.2
+ .t get 1.0 1000000.0
+} "ne 1\nLine 2\nLine 3\n"
+test btree-2.7 {deleting after end of file} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 10.3
+ .t get 1.0 1000000.0
+} "Line 1\nLine 2\nLine 3\n"
+test btree-2.8 {deleting before start of line} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 3.-1 3.3
+ .t get 1.0 1000000.0
+} "Line 1\nLine 2\ne 3\n"
+test btree-2.9 {deleting before start of line} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 1.-1 1.0
+ .t get 1.0 1000000.0
+} "Line 1\nLine 2\nLine 3\n"
+test btree-2.10 {deleting after end of line} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 1.8 2.1
+ .t get 1.0 1000000.0
+} "Line 1ine 2\nLine 3\n"
+test btree-2.11 {deleting after end of last line} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 3.8 4.1
+ .t get 1.0 1000000.0
+} "Line 1\nLine 2\nLine 3\n"
+test btree-2.12 {deleting before start of file} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 1.8 0.0
+ .t get 1.0 1000000.0
+} "Line 1\nLine 2\nLine 3\n"
+test btree-2.13 {deleting past end of file} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 1.8 4.0
+ .t get 1.0 1000000.0
+} "Line 1\n"
+test btree-2.14 {deleting with end before start of line} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 1.3 2.-3
+ .t get 1.0 1000000.0
+} "LinLine 2\nLine 3\n"
+test btree-2.15 {deleting past end of line} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 1.3 1.9
+ .t get 1.0 1000000.0
+} "Lin\nLine 2\nLine 3\n"
+test btree-2.16 {deleting past end of line} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 3.2 3.15
+ .t get 1.0 1000000.0
+} "Line 1\nLine 2\nLi\n"
+test btree-2.17 {deleting past end of line} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 3.0 3.15
+ .t get 1.0 1000000.0
+} "Line 1\nLine 2\n\n"
+test btree-2.18 {deleting past end of line} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 1.0 3.15
+ .t get 1.0 1000000.0
+} "\n"
+test btree-2.19 {deleting with negative range} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 3.2 2.4
+ .t get 1.0 1000000.0
+} "Line 1\nLine 2\nLine 3\n"
+test btree-2.20 {deleting with negative range} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 3.2 3.1
+ .t get 1.0 1000000.0
+} "Line 1\nLine 2\nLine 3\n"
+test btree-2.21 {deleting with negative range} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ .t delete 3.2 3.2
+ .t get 1.0 1000000.0
+} "Line 1\nLine 2\nLine 3\n"
+
+proc setup {} {
+ .t delete 1.0 100000.0
+ .t tag delete x y
+ .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+ .t tag add x 1.1
+ .t tag add x 1.5 1.13
+ .t tag add x 2.2 2.6
+ .t tag add y 1.5
+}
+
+test btree-3.1 {inserting with tags} {
+ setup
+ .t insert 1.0 XXX
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.4 1.5 1.8 1.16 2.2 2.6} {1.8 1.9}}
+test btree-3.2 {inserting with tags} {
+ setup
+ .t insert 1.15 YYY
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.1 1.2 1.5 1.13 2.2 2.6} {1.5 1.6}}
+test btree-3.3 {inserting with tags} {
+ setup
+ .t insert 1.7 ZZZZ
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.1 1.2 1.5 1.17 2.2 2.6} {1.5 1.6}}
+test btree-3.4 {inserting with tags} {
+ setup
+ .t insert 1.7 \n\n
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.1 1.2 1.5 3.6 4.2 4.6} {1.5 1.6}}
+test btree-3.5 {inserting with tags} {
+ setup
+ .t insert 1.5 A\n
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.1 1.2 2.0 2.8 3.2 3.6} {2.0 2.1}}
+test btree-3.6 {inserting with tags} {
+ setup
+ .t insert 1.13 A\n
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.1 1.2 1.5 1.13 3.2 3.6} {1.5 1.6}}
+
+test btree-4.1 {deleting with tags} {
+ setup
+ .t delete 1.6 1.9
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.1 1.2 1.5 1.10 2.2 2.6} {1.5 1.6}}
+test btree-4.2 {deleting with tags} {
+ setup
+ .t delete 1.1 2.3
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.1 1.4} {}}
+test btree-4.3 {deleting with tags} {
+ setup
+ .t delete 1.4 2.1
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.1 1.2 1.5 1.9} {}}
+test btree-4.4 {deleting with tags} {
+ setup
+ .t delete 1.14 2.1
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.1 1.2 1.5 1.13 1.15 1.19} {1.5 1.6}}
+test btree-4.5 {deleting with tags} {
+ setup
+ .t delete 1.0 2.10
+ list [.t tag ranges x] [.t tag ranges y]
+} {{} {}}
+test btree-4.6 {deleting with tags} {
+ setup
+ .t delete 1.0 1.5
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.0 1.8 2.2 2.6} {1.0 1.1}}
+test btree-4.7 {deleting with tags} {
+ setup
+ .t delete 1.6 1.9
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.1 1.2 1.5 1.10 2.2 2.6} {1.5 1.6}}
+test btree-4.8 {deleting with tags} {
+ setup
+ .t delete 1.5 1.13
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.1 1.2 2.2 2.6} {}}
+
+set bigText1 {}
+for {set i 0} {$i < 10} {incr i} {
+ append bigText1 "Line $i\n"
+}
+set bigText2 {}
+for {set i 0} {$i < 200} {incr i} {
+ append bigText2 "Line $i\n"
+}
+test btree-5.1 {very large inserts, with tags} {
+ setup
+ .t insert 1.0 $bigText1
+ list [.t tag ranges x] [.t tag ranges y]
+} {{11.1 11.2 11.5 11.13 12.2 12.6} {11.5 11.6}}
+test btree-5.2 {very large inserts, with tags} {
+ setup
+ .t insert 1.2 $bigText2
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.1 1.2 201.3 201.11 202.2 202.6} {201.3 201.4}}
+test btree-5.3 {very large inserts, with tags} {
+ setup
+ for {set i 0} {$i < 200} {incr i} {
+ .t insert 1.8 "longer line $i\n"
+ }
+ list [.t tag ranges x] [.t tag ranges y] [.t get 1.0 1.100] [.t get 198.0 198.100]
+} {{1.1 1.2 1.5 201.5 202.2 202.6} {1.5 1.6} {Text forlonger line 199} {longer line 2}}
+
+test btree-6.1 {very large deletes, with tags} {
+ setup
+ .t insert 1.1 $bigText2
+ .t delete 1.2 201.2
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.4 1.12 2.2 2.6} {1.4 1.5}}
+test btree-6.2 {very large deletes, with tags} {
+ setup
+ .t insert 1.1 $bigText2
+ for {set i 0} {$i < 200} {incr i} {
+ .t delete 1.2 2.2
+ }
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.4 1.12 2.2 2.6} {1.4 1.5}}
+test btree-6.3 {very large deletes, with tags} {
+ setup
+ .t insert 1.1 $bigText2
+ .t delete 2.3 10000.0
+ .t get 1.0 1000.0
+} {TLine 0
+Lin
+}
+test btree-6.4 {very large deletes, with tags} {
+ setup
+ .t insert 1.1 $bigText2
+ for {set i 0} {$i < 100} {incr i} {
+ .t delete 30.0 31.0
+ }
+ list [.t tag ranges x] [.t tag ranges y]
+} {{101.0 101.1 101.4 101.12 102.2 102.6} {101.4 101.5}}
+test btree-6.5 {very large deletes, with tags} {
+ setup
+ .t insert 1.1 $bigText2
+ for {set i 0} {$i < 100} {incr i} {
+ set j [expr $i+2]
+ set k [expr 1+2*$i]
+ .t tag add x $j.1 $j.3
+ .t tag add y $k.1 $k.6
+ }
+ .t delete 2.0 200.0
+ list [.t tag ranges x] [.t tag ranges y]
+} {{3.0 3.1 3.4 3.12 4.2 4.6} {1.1 1.6 3.4 3.5}}
+test btree-6.6 {very large deletes, with tags} {
+ setup
+ .t insert 1.1 $bigText2
+ for {set i 0} {$i < 100} {incr i} {
+ set j [expr $i+2]
+ set k [expr 1+2*$i]
+ .t tag add x $j.1 $j.3
+ .t tag add y $k.1 $k.6
+ }
+ for {set i 199} {$i >= 2} {incr i -1} {
+ .t delete $i.0 [expr $i+1].0
+ }
+ list [.t tag ranges x] [.t tag ranges y]
+} {{3.0 3.1 3.4 3.12 4.2 4.6} {1.1 1.6 3.4 3.5}}
+
+.t delete 1.0 end
+.t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+set i 1
+foreach check {
+ {1.3 1.6 1.7 2.0 {1.3 1.6 1.7 2.0}}
+ {1.3 1.6 1.6 2.0 {1.3 2.0}}
+ {1.3 1.6 1.4 2.0 {1.3 2.0}}
+ {2.0 4.3 1.4 1.10 {1.4 1.10 2.0 4.3}}
+ {2.0 4.3 1.4 1.end {1.4 1.19 2.0 4.3}}
+ {2.0 4.3 1.4 2.0 {1.4 4.3}}
+ {2.0 4.3 1.4 3.0 {1.4 4.3}}
+ {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.1 4.2 {1.1 4.2}}
+ {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.3 4.2 {1.2 4.2}}
+ {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.1 3.0 {1.1 4.0}}
+ {1.2 1.3 1.6 1.7 1.end 2.0 2.4 2.7 3.0 4.0 1.2 3.0 {1.2 4.0}}
+} {
+ test btree-7.$i {tag addition and removal} {
+ .t tag remove x 1.0 end
+ while {[llength $check] > 2} {
+ .t tag add x [lindex $check 0] [lindex $check 1]
+ set check [lrange $check 2 end]
+ }
+ .t tag ranges x
+ } [lindex $check [expr [llength $check]-1]]
+ incr i
+}
+
+test btree-8.1 {tag addition and removal, weird ranges} {
+ .t delete 1.0 100000.0
+ .t tag delete x
+ .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+ .t tag add x 0.0 1.3
+ .t tag ranges x
+} {1.0 1.3}
+test btree-8.2 {tag addition and removal, weird ranges} {
+ .t delete 1.0 100000.0
+ .t tag delete x
+ .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+ .t tag add x 1.40 2.4
+ .t tag ranges x
+} {1.19 2.4}
+test btree-8.3 {tag addition and removal, weird ranges} {
+ .t delete 1.0 100000.0
+ .t tag delete x
+ .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+ .t tag add x 4.40 4.41
+ .t tag ranges x
+} {}
+test btree-8.4 {tag addition and removal, weird ranges} {
+ .t delete 1.0 100000.0
+ .t tag delete x
+ .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+ .t tag add x 5.1 5.2
+ .t tag ranges x
+} {}
+test btree-8.5 {tag addition and removal, weird ranges} {
+ .t delete 1.0 100000.0
+ .t tag delete x
+ .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+ .t tag add x 1.1 9.0
+ .t tag ranges x
+} {1.1 5.0}
+test btree-8.6 {tag addition and removal, weird ranges} {
+ .t delete 1.0 100000.0
+ .t tag delete x
+ .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+ .t tag add x 1.1 1.90
+ .t tag ranges x
+} {1.1 1.19}
+test btree-8.7 {tag addition and removal, weird ranges} {
+ .t delete 1.0 100000.0
+ .t tag delete x
+ .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+ .t tag add x 1.1 4.90
+ .t tag ranges x
+} {1.1 4.17}
+test btree-8.8 {tag addition and removal, weird ranges} {
+ .t delete 1.0 100000.0
+ .t tag delete x
+ .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+ .t tag add x 3.0 3.0
+ .t tag ranges x
+} {}
+
+test btree-9.1 {tag names} {
+ setup
+ .t tag names
+} {sel x y}
+test btree-9.2 {tag names} {
+ setup
+ .t tag add tag1 1.8
+ .t tag add tag2 1.8
+ .t tag add tag3 1.7 1.9
+ .t tag names 1.8
+} {x tag1 tag2 tag3}
+test btree-9.3 {lots of tag names} {
+ setup
+ .t insert 1.2 $bigText2
+ foreach i {tag1 foo ThisOne {x space} q r s t} {
+ .t tag add $i 150.2
+ }
+ foreach i {u tagA tagB tagC and more {$} \{} {
+ .t tag add $i 150.1 150.3
+ }
+ .t tag names 150.2
+} {tag1 foo ThisOne {x space} q r s t u tagA tagB tagC and more {$} \{}
+test btree-9.4 {lots of tag names} {
+ setup
+ .t insert 1.2 $bigText2
+ .t tag delete tag1 foo ThisOne more {x space} q r s t u
+ .t tag delete tagA tagB tagC and {$} \{ more
+ foreach i {tag1 foo ThisOne more {x space} q r s t} {
+ .t tag add $i 150.2
+ }
+ foreach i {foo ThisOne u tagA tagB tagC and more {$} \{} {
+ .t tag add $i 150.4
+ }
+ .t tag delete tag1 more q r tagA
+ .t tag names 150.2
+} {foo ThisOne {x space} s t}
+
+proc msetup {} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+ .t mark set m1 1.2
+ .t mark set l1 1.2
+ .t mark gravity l1 left
+ .t mark set next 1.6
+ .t mark set x 1.6
+ .t mark set m2 2.0
+ .t mark set m3 2.100
+ .t tag add x 1.3 1.8
+}
+test btree-10.1 {basic mark facilities} {
+ msetup
+ list [lsort [.t mark names]] [.t index m1] [.t index m2] [.t index m3]
+} {{current insert l1 m1 m2 m3 next x} 1.2 2.0 2.11}
+test btree-10.2 {basic mark facilities} {
+ msetup
+ .t mark unset m2
+ lsort [.t mark names]
+} {current insert l1 m1 m3 next x}
+test btree-10.3 {basic mark facilities} {
+ msetup
+ .t mark set m2 1.8
+ list [lsort [.t mark names]] [.t index m1] [.t index m2] [.t index m3]
+} {{current insert l1 m1 m2 m3 next x} 1.2 1.8 2.11}
+
+test btree-11.1 {marks and inserts} {
+ msetup
+ .t insert 1.1 abcde
+ list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
+} {1.7 1.7 1.11 1.11 2.0 2.11}
+test btree-11.2 {marks and inserts} {
+ msetup
+ .t insert 1.2 abcde
+ list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
+} {1.2 1.7 1.11 1.11 2.0 2.11}
+test btree-11.3 {marks and inserts} {
+ msetup
+ .t insert 1.3 abcde
+ list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
+} {1.2 1.2 1.11 1.11 2.0 2.11}
+test btree-11.4 {marks and inserts} {
+ msetup
+ .t insert 1.1 ab\n\ncde
+ list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
+} {3.4 3.4 3.8 3.8 4.0 4.11}
+test btree-11.5 {marks and inserts} {
+ msetup
+ .t insert 1.4 ab\n\ncde
+ list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
+} {1.2 1.2 3.5 3.5 4.0 4.11}
+test btree-11.6 {marks and inserts} {
+ msetup
+ .t insert 1.7 ab\n\ncde
+ list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
+} {1.2 1.2 1.6 1.6 4.0 4.11}
+
+test btree-12.1 {marks and deletes} {
+ msetup
+ .t delete 1.3 1.5
+ list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
+} {1.2 1.2 1.4 1.4 2.0 2.11}
+test btree-12.2 {marks and deletes} {
+ msetup
+ .t delete 1.3 1.8
+ list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
+} {1.2 1.2 1.3 1.3 2.0 2.11}
+test btree-12.3 {marks and deletes} {
+ msetup
+ .t delete 1.2 1.8
+ list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
+} {1.2 1.2 1.2 1.2 2.0 2.11}
+test btree-12.4 {marks and deletes} {
+ msetup
+ .t delete 1.1 1.8
+ list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
+} {1.1 1.1 1.1 1.1 2.0 2.11}
+test btree-12.5 {marks and deletes} {
+ msetup
+ .t delete 1.5 3.1
+ list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
+} {1.2 1.2 1.5 1.5 1.5 1.5}
+test btree-12.6 {marks and deletes} {
+ msetup
+ .t mark set m2 4.5
+ .t delete 1.5 4.1
+ list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
+} {1.2 1.2 1.5 1.5 1.9 1.5}
+test btree-12.7 {marks and deletes} {
+ msetup
+ .t mark set m2 4.5
+ .t mark set m3 4.5
+ .t mark set m1 4.7
+ .t delete 1.5 4.1
+ list [.t index l1] [.t index m1] [.t index next] [.t index x] [.t index m2] [.t index m3]
+} {1.2 1.11 1.5 1.5 1.9 1.9}
+
+destroy .t
+text .t
+test btree-13.1 {tag searching} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+ .t tag next x 2.2 2.1
+} {}
+test btree-13.2 {tag searching} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+ .t tag add x 2.2 2.4
+ .t tag next x 2.2 2.3
+} {2.2 2.4}
+test btree-13.3 {tag searching} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+ .t tag add x 2.2 2.4
+ .t tag next x 2.3 2.6
+} {}
+test btree-13.4 {tag searching} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+ .t tag add x 2.5 2.8
+ .t tag next x 2.1 2.6
+} {2.5 2.8}
+test btree-13.5 {tag searching} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+ .t tag add x 2.5 2.8
+ .t tag next x 2.1 2.5
+} {}
+test btree-13.6 {tag searching} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+ .t tag add x 2.1 2.4
+ .t tag next x 2.5 2.8
+} {}
+test btree-13.7 {tag searching} {
+ .t delete 1.0 100000.0
+ .t insert 1.0 "Text for first line\nSecond line\n\nLast line of info"
+ .t tag add x 2.5 2.8
+ .t tag next x 2.1 2.4
+} {}
+test btree-13.8 {tag searching} {
+ setup
+ .t insert 1.2 $bigText2
+ .t tag add x 190.3 191.2
+ .t tag next x 3.5
+} {190.3 191.2}
+
+test btree-14.1 {check tag presence} {
+ setup
+ .t insert 1.2 $bigText2
+ .t tag add x 3.5 3.7
+ .t tag add y 133.9 141.5
+ .t tag add z 1.5 180.2
+ .t tag add q 141.4 142.3
+ .t tag add x 130.2 145.1
+ .t tag add a 141.0
+ .t tag add b 4.3
+ .t tag add b 7.5
+ .t tag add b 140.3
+ for {set i 120} {$i < 160} {incr i} {
+ .t tag add c $i.4
+ }
+ foreach i {a1 a2 a3 a4 a5 a6 a7 a8 a9 10 a11 a12 a13} {
+ .t tag add $i 122.2
+ }
+ .t tag add x 141.3
+ .t tag names 141.1
+} {x y z}
+
+test btree-15.1 {rebalance with empty node} {
+ catch {destroy .t}
+ text .t
+ .t debug 1
+ .t insert end "1\n2\n3\n4\n5\n6\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17\n18\n19\n20\n21\n22\n23"
+ .t delete 6.0 12.0
+ .t get 1.0 end
+} "1\n2\n3\n4\n5\n12\n13\n14\n15\n16\n17\n18\n19\n20\n21\n22\n23\n"
+
+proc setupBig {} {
+ .t delete 1.0 end
+ .t tag delete x y
+ .t tag configure x -foreground blue
+ .t tag configure y -underline true
+ # Create a Btree with 2002 lines (2000 + already existing + phantom at end)
+ # This generates a level 3 node with 9 children
+ # Most level 2 nodes cover 216 lines and have 6 children, except the last
+ # level 2 node covers 274 lines and has 7 children.
+ # Most level 1 nodes cover 36 lines and have 6 children, except the
+ # rightmost node has 58 lines and 9 children.
+ # Level 2: 2002 = 8*216 + 274
+ # Level 1: 2002 = 54*36 + 58
+ # Level 0: 2002 = 332*6 + 10
+ for {set i 0} {$i < 2000} {incr i} {
+ append x "Line $i abcd efgh ijkl\n"
+ }
+ .t insert insert $x
+ .t debug 1
+}
+
+test btree-16.1 {add tag does not push root above level 0} {
+ catch {destroy .t}
+ text .t
+ setupBig
+ .t tag add x 1.1 1.10
+ .t tag add x 5.1 5.10
+ .t tag ranges x
+} {1.1 1.10 5.1 5.10}
+test btree-16.2 {add tag pushes root up to level 1 node} {
+ catch {destroy .t}
+ text .t
+ .t debug 1
+ setupBig
+ .t tag add x 1.1 1.10
+ .t tag add x 8.1 8.10
+ .t tag ranges x
+} {1.1 1.10 8.1 8.10}
+test btree-16.3 {add tag pushes root up to level 2 node} {
+ .t tag remove x 1.0 end
+ .t tag add x 8.1 9.10
+ .t tag add x 180.1 180.end
+ .t tag ranges x
+} {8.1 9.10 180.1 180.23}
+test btree-16.4 {add tag pushes root up to level 3 node} {
+ .t tag remove x 1.0 end
+ .t tag add y 1.1 2000.0
+ .t tag add x 1.1 8.10
+ .t tag add x 180.end 217.0
+ list [.t tag ranges x] [.t tag ranges y]
+} {{1.1 8.10 180.23 217.0} {1.1 2000.0}}
+test btree-16.5 {add tag doesn't push root up} {
+ .t tag remove x 1.0 end
+ .t tag add x 1.1 8.10
+ .t tag add x 2000.0 2000.3
+ .t tag add x 180.end 217.0
+ .t tag ranges x
+} {1.1 8.10 180.23 217.0 2000.0 2000.3}
+test btree-16.6 {two node splits at once pushes root up} {
+ .t delete 1.0 end
+ for {set i 1} {$i < 10} {incr i} {
+ .t insert end "Line $i\n"
+ }
+ .t tag add x 8.0 8.end
+ .t tag add y 9.0 end
+ set x {}
+ for {} {$i < 50} {incr i} {
+ append x "Line $i\n"
+ }
+ .t insert end $x y
+ list [.t tag ranges x] [.t tag ranges y]
+} {{8.0 8.6} {9.0 51.0}}
+# The following find bugs in the SearchStart procedures
+test btree-16.7 {Partial tag remove from before first range} {
+ .t tag remove x 1.0 end
+ .t tag add x 2.0 2.6
+ .t tag remove x 1.0 2.0
+ .t tag ranges x
+} {2.0 2.6}
+test btree-16.8 {Partial tag remove from before first range} {
+ .t tag remove x 1.0 end
+ .t tag add x 2.0 2.6
+ .t tag remove x 1.0 2.1
+ .t tag ranges x
+} {2.1 2.6}
+test btree-16.9 {Partial tag remove from before first range} {
+ .t tag remove x 1.0 end
+ .t tag add x 2.0 2.6
+ .t tag remove x 1.0 2.3
+ .t tag ranges x
+} {2.3 2.6}
+test btree-16.10 {Partial tag remove from before first range} {
+ .t tag remove x 1.0 end
+ .t tag add x 1.0 2.6
+ .t tag remove x 1.0 2.5
+ .t tag ranges x
+} {2.5 2.6}
+test btree-16.11 {StartSearchBack boundary case} {
+ .t tag remove x 1.0 end
+ .t tag add x 1.3 1.4
+ .t tag prevr x 2.0 1.4
+} {}
+test btree-16.12 {StartSearchBack boundary case} {
+ .t tag remove x 1.0 end
+ .t tag add x 1.3 1.4
+ .t tag prevr x 2.0 1.3
+} {1.3 1.4}
+test btree-16.13 {StartSearchBack boundary case} {
+ .t tag remove x 1.0 end
+ .t tag add x 1.0 1.4
+ .t tag prevr x 1.3
+} {1.0 1.4}
+
+
+test btree-17.1 {remove tag does not push root down} {
+ catch {destroy .t}
+ text .t
+ .t debug 0
+ setupBig
+ .t tag add x 1.1 5.10
+ .t tag remove x 3.1 5.end
+ .t tag ranges x
+} {1.1 3.1}
+test btree-17.2 {remove tag pushes root from level 1 to level 0} {
+ .t tag remove x 1.0 end
+ .t tag add x 1.1 8.10
+ .t tag remove x 3.1 end
+ .t tag ranges x
+} {1.1 3.1}
+test btree-17.3 {remove tag pushes root from level 2 to level 1} {
+ .t tag remove x 1.0 end
+ .t tag add x 1.1 180.10
+ .t tag remove x 35.1 end
+ .t tag ranges x
+} {1.1 35.1}
+test btree-17.4 {remove tag doesn't change level 2} {
+ .t tag remove x 1.0 end
+ .t tag add x 1.1 180.10
+ .t tag remove x 35.1 180.0
+ .t tag ranges x
+} {1.1 35.1 180.0 180.10}
+test btree-17.5 {remove tag pushes root from level 3 to level 0} {
+ .t tag remove x 1.0 end
+ .t tag add x 1.1 1.10
+ .t tag add x 2000.1 2000.10
+ .t tag remove x 1.0 2000.0
+ .t tag ranges x
+} {2000.1 2000.10}
+test btree-17.6 {text deletion pushes root from level 3 to level 0} {
+ .t tag remove x 1.0 end
+ .t tag add x 1.1 1.10
+ .t tag add x 2000.1 2000.10
+ .t delete 1.0 "1000.0 lineend +1 char"
+ .t tag ranges x
+} {1000.1 1000.10}
+
+catch {destroy .t}
+text .t
+test btree-18.1 {tag search back, no tag} {
+ .t insert 1.0 "Line 1 abcd efgh ijkl\n"
+ .t tag prev x 1.1 1.1
+} {}
+test btree-18.2 {tag search back, start at existing range} {
+ .t tag remove x 1.0 end
+ .t tag add x 1.1 1.4
+ .t tag add x 1.8 1.11
+ .t tag add x 1.16
+ .t tag prev x 1.1
+} {}
+test btree-18.3 {tag search back, end at existing range} {
+ .t tag remove x 1.0 end
+ .t tag add x 1.1 1.4
+ .t tag add x 1.8 1.11
+ .t tag add x 1.16
+ .t tag prev x 1.3 1.1
+} {1.1 1.4}
+test btree-18.4 {tag search back, start within range} {
+ .t tag remove x 1.0 end
+ .t tag add x 1.1 1.4
+ .t tag add x 1.8 1.11
+ .t tag add x 1.16
+ .t tag prev x 1.10 1.0
+} {1.8 1.11}
+test btree-18.5 {tag search back, start at end of range} {
+ .t tag remove x 1.0 end
+ .t tag add x 1.1 1.4
+ .t tag add x 1.8 1.11
+ .t tag add x 1.16
+ list [.t tag prev x 1.4 1.0] [.t tag prev x 1.11 1.0]
+} {{1.1 1.4} {1.8 1.11}}
+test btree-18.6 {tag search back, start beyond range, same level 0 node} {
+ .t tag remove x 1.0 end
+ .t tag add x 1.1 1.4
+ .t tag add x 1.8 1.11
+ .t tag add x 1.16
+ .t tag prev x 3.0
+} {1.16 1.17}
+test btree-18.7 {tag search back, outside any range} {
+ .t tag remove x 1.0 end
+ .t tag add x 1.1 1.4
+ .t tag add x 1.16
+ .t tag prev x 1.8 1.5
+} {}
+test btree-18.8 {tag search back, start at start of node boundary} {
+ setupBig
+ .t tag remove x 1.0 end
+ .t tag add x 2.5 2.8
+ .t tag prev x 19.0
+} {2.5 2.8}
+test btree-18.9 {tag search back, large complex btree spans} {
+ .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
diff --git a/tk/tests/textDisp.test b/tk/tests/textDisp.test
new file mode 100644
index 00000000000..d6b460f46a3
--- /dev/null
+++ b/tk/tests/textDisp.test
@@ -0,0 +1,2868 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+ set scrollInfo $args
+}
+
+# The procedure below is used to generate errors during scrolling commands.
+
+proc scrollError args {
+ error "scrolling error"
+}
+
+# Create entries in the option database to be sure that geometry options
+# like border width have predictable values.
+
+option add *Text.borderWidth 2
+option add *Text.highlightThickness 2
+
+# The frame .f is needed to make sure that the overall window is always
+# fairly wide, even if the text window is very narrow. This is needed
+# because some window managers don't allow the overall width of a window
+# to get very narrow.
+
+foreach i [winfo child .] {
+ destroy $i
+}
+frame .f -width 100 -height 20
+pack append . .f left
+
+if {$tcl_platform(platform) == "windows"} {
+ set fixedFont {Courier -14}
+} else {
+ set fixedFont {Courier -12}
+}
+set fixedHeight [font metrics $fixedFont -linespace]
+set fixedWidth [font measure $fixedFont m]
+
+set varFont {Times -14}
+set bigFont {Helvetica -24}
+text .t -font $fixedFont -width 20 -height 10 -yscrollcommand scroll
+pack append . .t {top expand fill}
+.t tag configure big -font $bigFont
+.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 .
+update
+
+# Some window managers (like olwm under SunOS 4.1.3) misbehave in a way
+# that tends to march windows off the top and left of the screen. If
+# this happens, some tests will fail because parts of the window will
+# not need to be displayed (because they're off-screen). To keep this
+# from happening, move the window if it's getting near the left or top
+# edges of the screen.
+
+if {([winfo rooty .] < 50) || ([winfo rootx .] < 50)} {
+ wm geom . +50+50
+}
+test textDisp-1.1 {GetStyle procedure, priorities and tab stops} {
+ .t delete 1.0 end
+ .t insert 1.0 "x\ty"
+ .t tag delete x y z
+ .t tag configure x -tabs {50}
+ .t tag configure y -foreground black
+ .t tag configure z -tabs {70}
+ .t tag add x 1.0 1.end
+ .t tag add y 1.0 1.end
+ .t tag add z 1.0 1.end
+ update idletasks
+ set x [lindex [.t bbox 1.2] 0]
+ .t tag configure z -tabs {}
+ lappend x [lindex [.t bbox 1.2] 0]
+ .t tag configure z -tabs {30}
+ .t tag raise x
+ update idletasks
+ lappend x [lindex [.t bbox 1.2] 0]
+} {75 55 55}
+.t tag delete x y z
+test textDisp-1.2 {GetStyle procedure, wrapmode} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "abcd\nefg hijkl mnop qrstuv wxyz"
+ .t tag configure x -wrap word
+ .t tag configure y -wrap none
+ .t tag raise y
+ update
+ set result [list [.t bbox 2.20]]
+ .t tag add x 2.0 2.1
+ lappend result [.t bbox 2.20]
+ .t tag add y 1.end 2.2
+ lappend result [.t bbox 2.20]
+} {{5 31 7 13} {40 31 7 13} {}}
+.t tag delete x y
+
+test textDisp-2.1 {LayoutDLine, basics} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "This is some sample text for testing."
+ list [.t bbox 1.19] [.t bbox 1.20]
+} [list [list [expr 5 + $fixedWidth * 19] 5 $fixedWidth $fixedHeight] [list 5 [expr 5 + $fixedHeight] $fixedWidth $fixedHeight]]
+test textDisp-2.2 {LayoutDLine, basics} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "This isx some sample text for testing."
+ list [.t bbox 1.19] [.t bbox 1.20]
+} {{138 5 7 13} {5 18 7 13}}
+test textDisp-2.3 {LayoutDLine, basics} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "This isxxx some sample text for testing."
+ list [.t bbox 1.19] [.t bbox 1.20]
+} {{138 5 7 13} {5 18 7 13}}
+test textDisp-2.4 {LayoutDLine, word wrap} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "This is some sample text for testing."
+ list [.t bbox 1.19] [.t bbox 1.20]
+} {{138 5 7 13} {5 18 7 13}}
+test textDisp-2.5 {LayoutDLine, word wrap} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "This isx some sample text for testing."
+ list [.t bbox 1.13] [.t bbox 1.14] [.t bbox 1.19]
+} {{96 5 49 13} {5 18 7 13} {40 18 7 13}}
+test textDisp-2.6 {LayoutDLine, word wrap} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "This isxxx some sample text for testing."
+ list [.t bbox 1.15] [.t bbox 1.16]
+} {{110 5 35 13} {5 18 7 13}}
+test textDisp-2.7 {LayoutDLine, marks and tags} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "This isxxx some sample text for testing."
+ .t tag add foo 1.4 1.6
+ .t mark set insert 1.8
+ list [.t bbox 1.2] [.t bbox 1.5] [.t bbox 1.11]
+} {{19 5 7 13} {40 5 7 13} {82 5 7 13}}
+foreach m [.t mark names] {
+ catch {.t mark unset $m}
+}
+scan [wm geom .] %dx%d width height
+test textDisp-2.8 {LayoutDLine, extra chunk at end of dline} {fonts} {
+ wm geom . [expr $width+1]x$height
+ update
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "This isxx some sample text for testing."
+ .t mark set foo 1.20
+ list [.t bbox 1.19] [.t bbox 1.20]
+} {{138 5 8 13} {5 18 7 13}}
+wm geom . {}
+update
+test textDisp-2.9 {LayoutDLine, marks and tags} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "This is a very_very_long_word_that_wraps."
+ list [.t bbox 1.9] [.t bbox 1.10] [.t bbox 1.25]
+} {{68 5 77 13} {5 18 7 13} {110 18 7 13}}
+test textDisp-2.10 {LayoutDLine, marks and tags} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "This is a very_very_long_word_that_wraps."
+ .t tag add foo 1.13
+ .t tag add foo 1.15
+ .t tag add foo 1.17
+ .t tag add foo 1.19
+ list [.t bbox 1.9] [.t bbox 1.10] [.t bbox 1.25]
+} {{68 5 77 13} {5 18 7 13} {110 18 7 13}}
+test textDisp-2.11 {LayoutDLine, newline width} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "a\nbb\nccc\ndddd"
+ list [.t bbox 2.2] [.t bbox 3.3]
+} {{19 18 126 13} {26 31 119 13}}
+test textDisp-2.12 {LayoutDLine, justification} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "\na\nbb\nccc\ndddd"
+ .t tag configure x -justify center
+ .t tag add x 1.0 end
+ .t tag add y 3.0 3.2
+ list [.t bbox 1.0] [.t bbox 2.0] [.t bbox 4.0] [.t bbox 4.2]
+} {{75 5 70 13} {71 18 7 13} {64 44 7 13} {78 44 7 13}}
+test textDisp-2.13 {LayoutDLine, justification} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "\na\nbb\nccc\ndddd"
+ .t tag configure x -justify right
+ .t tag add x 1.0 end
+ .t tag add y 3.0 3.2
+ list [.t bbox 1.0] [.t bbox 2.0] [.t bbox 4.0] [.t bbox 4.2]
+} {{145 5 0 13} {138 18 7 13} {124 44 7 13} {138 44 7 13}}
+test textDisp-2.14 {LayoutDLine, justification} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "\na\nbb\nccc\ndddd"
+ .t tag configure x -justify center
+ .t tag add x 2.0 3.1
+ .t tag configure y -justify right
+ .t tag add y 3.0 4.0
+ .t tag raise y
+ list [.t bbox 2.0] [.t bbox 3.0] [.t bbox 3.end] [.t bbox 4.0]
+} {{71 18 7 13} {131 31 7 13} {145 31 0 13} {5 44 7 13}}
+test textDisp-2.15 {LayoutDLine, justification} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "\na\nbb\nccc\ndddd"
+ .t tag configure x -justify center
+ .t tag add x 2.0 3.1
+ .t tag configure y -justify right
+ .t tag add y 3.0 4.0
+ .t tag lower y
+ list [.t bbox 2.0] [.t bbox 3.0] [.t bbox 3.end] [.t bbox 4.0]
+} {{71 18 7 13} {68 31 7 13} {82 31 63 13} {5 44 7 13}}
+test textDisp-2.16 {LayoutDLine, justification} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "Lots of long words, enough to force word wrap\nThen\nmore lines"
+ .t tag configure x -justify center
+ .t tag add x 1.1 1.20
+ .t tag add x 1.21 1.end
+ list [.t bbox 1.0] [.t bbox 1.20] [.t bbox 1.36] [.t bbox 2.0]
+} {{5 5 7 13} {5 18 7 13} {43 31 7 13} {5 44 7 13}}
+test textDisp-2.17 {LayoutDLine, justification} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "Lots of long words, enough to force word wrap\nThen\nmore lines"
+ .t tag configure x -justify center
+ .t tag add x 1.20
+ list [.t bbox 1.0] [.t bbox 1.20] [.t bbox 1.36] [.t bbox 2.0]
+} {{5 5 7 13} {19 18 7 13} {5 31 7 13} {5 44 7 13}}
+test textDisp-2.18 {LayoutDLine, justification} {fonts} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert 1.0 "Lots of long words, enough to extend out of the window\n"
+ .t insert end "Then\nmore lines\nThat are shorter"
+ .t tag configure x -justify center
+ .t tag configure y -justify right
+ .t tag add x 2.0
+ .t tag add y 3.0
+ .t xview scroll 5 units
+ list [.t bbox 2.0] [.t bbox 3.0]
+} {{26 18 7 13} {40 31 7 13}}
+.t tag delete x
+.t tag delete y
+test textDisp-2.19 {LayoutDLine, margins} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "Lots of long words, enough to force word wrap\nThen\nmore lines"
+ .t tag configure x -lmargin1 20 -lmargin2 40 -rmargin 15
+ .t tag add x 1.0 end
+ list [.t bbox 1.0] [.t bbox 1.12] [.t bbox 1.13] [.t bbox 2.0]
+} {{25 5 7 13} {109 5 36 13} {45 18 7 13} {25 70 7 13}}
+test textDisp-2.20 {LayoutDLine, margins} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "Lots of long words, enough to force word wrap\nThen\nmore lines"
+ .t tag configure x -lmargin1 20 -lmargin2 10 -rmargin 3
+ .t tag configure y -lmargin1 15 -lmargin2 5 -rmargin 0
+ .t tag raise y
+ .t tag add x 1.0 end
+ .t tag add y 1.13
+ list [.t bbox 1.0] [.t bbox 1.13] [.t bbox 1.30] [.t bbox 2.0]
+} {{25 5 7 13} {10 18 7 13} {15 31 7 13} {25 44 7 13}}
+test textDisp-2.21 {LayoutDLine, margins} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "Sample text"
+ .t tag configure x -lmargin1 80 -lmargin2 80 -rmargin 100
+ .t tag add x 1.0 end
+ list [.t bbox 1.0] [.t bbox 1.1] [.t bbox 1.2]
+} {{85 5 60 13} {85 18 60 13} {85 31 60 13}}
+.t tag delete x
+.t tag delete y
+test textDisp-2.22 {LayoutDLine, spacing options} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t tag delete x y
+ .t insert end "Short line\nLine 2 is long enough "
+ .t insert end "to wrap around a couple of times"
+ .t insert end "\nLine 3\nLine 4"
+ set i [.t dlineinfo 1.0]
+ set b1 [expr [lindex $i 1] + [lindex $i 4]]
+ set i [.t dlineinfo 2.0]
+ set b2 [expr [lindex $i 1] + [lindex $i 4]]
+ set i [.t dlineinfo 2.end]
+ set b3 [expr [lindex $i 1] + [lindex $i 4]]
+ set i [.t dlineinfo 3.0]
+ set b4 [expr [lindex $i 1] + [lindex $i 4]]
+ .t configure -spacing1 2 -spacing2 1 -spacing3 3
+ set i [.t dlineinfo 1.0]
+ set b1 [expr [lindex $i 1] + [lindex $i 4] - $b1]
+ set i [.t dlineinfo 2.0]
+ set b2 [expr [lindex $i 1] + [lindex $i 4] - $b2]
+ set i [.t dlineinfo 2.end]
+ set b3 [expr [lindex $i 1] + [lindex $i 4] - $b3]
+ set i [.t dlineinfo 3.0]
+ set b4 [expr [lindex $i 1] + [lindex $i 4] - $b4]
+ list $b1 $b2 $b3 $b4
+} {2 7 10 15}
+.t configure -spacing1 0 -spacing2 0 -spacing3 0
+test textDisp-2.23 {LayoutDLine, spacing options} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t tag delete x y
+ .t insert end "Short line\nLine 2 is long enough "
+ .t insert end "to wrap around a couple of times"
+ .t insert end "\nLine 3\nLine 4"
+ set i [.t dlineinfo 1.0]
+ set b1 [expr [lindex $i 1] + [lindex $i 4]]
+ set i [.t dlineinfo 2.0]
+ set b2 [expr [lindex $i 1] + [lindex $i 4]]
+ set i [.t dlineinfo 2.end]
+ set b3 [expr [lindex $i 1] + [lindex $i 4]]
+ set i [.t dlineinfo 3.0]
+ set b4 [expr [lindex $i 1] + [lindex $i 4]]
+ .t configure -spacing1 4 -spacing2 4 -spacing3 4
+ .t tag configure x -spacing1 1 -spacing2 2 -spacing3 3
+ .t tag add x 1.0 end
+ .t tag configure y -spacing1 0 -spacing2 3
+ .t tag add y 2.19 end
+ .t tag raise y
+ set i [.t dlineinfo 1.0]
+ set b1 [expr [lindex $i 1] + [lindex $i 4] - $b1]
+ set i [.t dlineinfo 2.0]
+ set b2 [expr [lindex $i 1] + [lindex $i 4] - $b2]
+ set i [.t dlineinfo 2.end]
+ set b3 [expr [lindex $i 1] + [lindex $i 4] - $b3]
+ set i [.t dlineinfo 3.0]
+ set b4 [expr [lindex $i 1] + [lindex $i 4] - $b4]
+ list $b1 $b2 $b3 $b4
+} {1 5 13 16}
+.t configure -spacing1 0 -spacing2 0 -spacing3 0
+test textDisp-2.24 {LayoutDLine, tabs, saving from first chunk} {fonts} {
+ .t delete 1.0 end
+ .t tag delete x y
+ .t tag configure x -tabs 70
+ .t tag configure y -tabs 80
+ .t insert 1.0 "ab\tcde"
+ .t tag add x 1.0 end
+ .t tag add y 1.1 end
+ lindex [.t bbox 1.3] 0
+} {75}
+test textDisp-2.25 {LayoutDLine, tabs, breaking chunks at tabs} {fonts} {
+ .t delete 1.0 end
+ .t tag delete x
+ .t tag configure x -tabs {30 60 90 120}
+ .t insert 1.0 "a\tb\tc\td\te"
+ .t mark set dummy1 1.1
+ .t mark set dummy2 1.2
+ .t tag add x 1.0 end
+ list [lindex [.t bbox 1.2] 0] [lindex [.t bbox 1.4] 0] \
+ [lindex [.t bbox 1.6] 0] [lindex [.t bbox 1.8] 0]
+} {35 65 95 125}
+test textDisp-2.26 {LayoutDLine, tabs, breaking chunks at tabs} {fonts} {
+ .t delete 1.0 end
+ .t tag delete x
+ .t tag configure x -tabs {30 60 90 120} -justify right
+ .t insert 1.0 "a\tb\tc\td\te"
+ .t mark set dummy1 1.1
+ .t mark set dummy2 1.2
+ .t tag add x 1.0 end
+ list [lindex [.t bbox 1.2] 0] [lindex [.t bbox 1.4] 0] \
+ [lindex [.t bbox 1.6] 0] [lindex [.t bbox 1.8] 0]
+} {117 124 131 138}
+test textDisp-2.27 {LayoutDLine, tabs, calling AdjustForTab} {fonts} {
+ .t delete 1.0 end
+ .t tag delete x
+ .t tag configure x -tabs {30 60}
+ .t insert 1.0 "a\tb\tcd"
+ .t tag add x 1.0 end
+ list [lindex [.t bbox 1.2] 0] [lindex [.t bbox 1.4] 0]
+} {35 65}
+test textDisp-2.28 {LayoutDLine, tabs, running out of space in dline} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "a\tb\tc\td"
+ .t bbox 1.6
+} {5 18 7 13}
+test textDisp-2.29 {LayoutDLine, tabs, running out of space in dline} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "a\tx\tabcd"
+ .t bbox 1.4
+} {117 5 7 13}
+test textDisp-2.30 {LayoutDLine, tabs, running out of space in dline} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "a\tx\tabc"
+ .t bbox 1.4
+} {117 5 7 13}
+
+test textDisp-3.1 {different character sizes} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert end "Some sample text, including both large\n"
+ .t insert end "characters and\nsmall\n"
+ .t insert end "abc\nd\ne\nfghij"
+ .t tag add big 1.5 1.10
+ .t tag add big 2.11 2.14
+ list [.t bbox 1.1] [.t bbox 1.6] [.t dlineinfo 1.0] [.t dlineinfo 3.0]
+} {{12 17 7 13} {52 5 13 27} {5 5 114 27 22} {5 85 35 13 10}}
+
+.t configure -wrap char
+test textDisp-4.1 {UpdateDisplayInfo, basic} {fonts} {
+ .t delete 1.0 end
+ .t insert end "Line 1\nLine 2\nLine 3\n"
+ update
+ .t delete 2.0 2.end
+ .t insert 2.0 "New Line 2"
+ update
+ list [.t bbox 1.0] [.t bbox 2.0] [.t bbox 3.0] $tk_textRelayout
+} {{5 5 7 13} {5 18 7 13} {5 31 7 13} 2.0}
+test textDisp-4.2 {UpdateDisplayInfo, re-use tail of text line} {fonts} {
+ .t delete 1.0 end
+ .t insert end "Line 1\nLine 2 is so long that it wraps around\nLine 3"
+ update
+ .t mark set x 2.21
+ .t delete 2.2
+ .t insert 2.0 X
+ update
+ list [.t bbox 2.0] [.t bbox x] [.t bbox 3.0] $tk_textRelayout
+} {{5 18 7 13} {12 31 7 13} {5 44 7 13} {2.0 2.20}}
+test textDisp-4.3 {UpdateDisplayInfo, tail of text line shifts} {fonts} {
+ .t delete 1.0 end
+ .t insert end "Line 1\nLine 2 is so long that it wraps around\nLine 3"
+ update
+ .t mark set x 2.21
+ .t delete 2.2
+ update
+ list [.t bbox 2.0] [.t bbox x] [.t bbox 3.0] $tk_textRelayout
+} {{5 18 7 13} {5 31 7 13} {5 44 7 13} {2.0 2.20}}
+.t mark unset x
+test textDisp-4.4 {UpdateDisplayInfo, wrap-mode "none"} {fonts} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert end "Line 1\nLine 2 is so long that it wraps around\nLine 3"
+ update
+ list [.t bbox 2.0] [.t bbox 2.25] [.t bbox 3.0] $tk_textRelayout
+} {{5 18 7 13} {} {5 31 7 13} {1.0 2.0 3.0}}
+test textDisp-4.5 {UpdateDisplayInfo, tiny window} {fonts} {
+ wm geom . 103x$height
+ update
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert end "Line 1\nLine 2 is so long that it wraps around\nLine 3"
+ update
+ list [.t bbox 2.0] [.t bbox 2.1] [.t bbox 3.0] $tk_textRelayout
+} {{5 18 1 13} {} {5 31 1 13} {1.0 2.0 3.0}}
+test textDisp-4.6 {UpdateDisplayInfo, tiny window} {
+ # This test was failing on Windows because the title bar on .
+ # was a certain minimum size and it was interfering with the size
+ # requested. The "overrideredirect" gets rid of the titlebar so
+ # the toplevel can shrink to the appropriate size. On Unix, setting
+ # the overrideredirect on "." confuses the window manager and
+ # causes subsequent tests to fail.
+
+ if {$tcl_platform(platform) == "windows"} {
+ wm overrideredirect . 1
+ }
+ frame .f2 -width 20 -height 100
+ pack before .f .f2 top
+ wm geom . 103x103
+ update
+ .t configure -wrap none -borderwidth 2
+ .t delete 1.0 end
+ .t insert end "Line 1\nLine 2 is so long that it wraps around\nLine 3"
+ update
+ set x [list [.t bbox 1.0] [.t bbox 2.0] $tk_textRelayout]
+ wm overrideredirect . 0
+ update
+ set x
+} {{5 5 1 1} {} 1.0}
+catch {destroy .f2}
+.t configure -borderwidth 0 -wrap char
+wm geom . {}
+update
+test textDisp-4.7 {UpdateDisplayInfo, filling in extra vertical space} {
+ # This test was failing on Windows because the title bar on .
+ # was a certain minimum size and it was interfering with the size
+ # requested. The "overrideredirect" gets rid of the titlebar so
+ # the toplevel can shrink to the appropriate size. On Unix, setting
+ # the overrideredirect on "." confuses the window manager and
+ # causes subsequent tests to fail.
+
+ if {$tcl_platform(platform) == "windows"} {
+ wm overrideredirect . 1
+ }
+ .t delete 1.0 end
+ .t insert end "1\n2\n3\n4\n5\n6\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17"
+ .t yview 1.0
+ update
+ .t yview 16.0
+ update
+ set x [list [.t index @0,0] $tk_textRelayout $tk_textRedraw]
+ wm overrideredirect . 0
+ update
+ set x
+} {8.0 {16.0 17.0 15.0 14.0 13.0 12.0 11.0 10.0 9.0 8.0} {8.0 9.0 10.0 11.0 12.0 13.0 14.0 15.0 16.0 17.0}}
+test textDisp-4.8 {UpdateDisplayInfo, filling in extra vertical space} {
+ .t delete 1.0 end
+ .t insert end "1\n2\n3\n4\n5\n6\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17"
+ .t yview 16.0
+ update
+ .t delete 5.0 14.0
+ update
+ set x [list [.t index @0,0] $tk_textRelayout $tk_textRedraw]
+} {1.0 {5.0 4.0 3.0 2.0 1.0} {1.0 2.0 3.0 4.0 5.0 eof}}
+test textDisp-4.9 {UpdateDisplayInfo, filling in extra vertical space} {fonts} {
+ .t delete 1.0 end
+ .t insert end "1\n2\n3\n4\n5\n6\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17"
+ .t yview 16.0
+ update
+ .t delete 15.0 end
+ list [.t bbox 7.0] [.t bbox 12.0]
+} {{3 29 7 13} {3 94 7 13}}
+test textDisp-4.10 {UpdateDisplayInfo, filling in extra vertical space} {
+ .t delete 1.0 end
+ .t insert end "1\n2\n3\n4\n5\nLine 6 is such a long line that it wraps around.\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17"
+ .t yview end
+ update
+ .t delete 13.0 end
+ update
+ list [.t index @0,0] $tk_textRelayout $tk_textRedraw
+} {5.0 {12.0 7.0 6.40 6.20 6.0 5.0} {5.0 6.0 6.20 6.40 7.0 12.0}}
+test textDisp-4.11 {UpdateDisplayInfo, filling in extra vertical space} {
+ .t delete 1.0 end
+ .t insert end "1\n2\n3\n4\n5\nLine 6 is such a long line that it wraps around, not once but really quite a few times.\n7\n8\n9\n10\n11\n12\n13\n14\n15\n16\n17"
+ .t yview end
+ update
+ .t delete 14.0 end
+ update
+ list [.t index @0,0] $tk_textRelayout $tk_textRedraw
+} {6.40 {13.0 7.0 6.80 6.60 6.40} {6.40 6.60 6.80 7.0 13.0}}
+test textDisp-4.12 {UpdateDisplayInfo, filling in extra vertical space} {
+ .t delete 1.0 end
+ .t insert end "1\n2\n3\n4\n5\n7\n8\n9\n10\n11\n12"
+ button .b -text "Test" -bd 2 -highlightthickness 2
+ .t window create 3.end -window .b
+ .t yview moveto 1
+ update
+ .t yview moveto 0
+ update
+ .t yview moveto 1
+ update
+ winfo ismapped .b
+} {0}
+.t configure -wrap word
+.t delete 1.0 end
+.t insert end "Line 1\nLine 2\nLine 3\nLine 4\nLine 5\nLine 6\nLine 7\n"
+.t insert end "Line 8\nLine 9\nLine 10\nLine 11\nLine 12\nLine 13\n"
+.t insert end "Line 14\nLine 15\nLine 16"
+.t tag delete x
+.t tag configure x -relief raised -borderwidth 2 -background white
+test textDisp-4.13 {UpdateDisplayInfo, special handling for top/bottom lines} {
+ .t tag add x 1.0 end
+ .t yview 1.0
+ update
+ .t yview scroll 3 units
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{11.0 12.0 13.0} {4.0 10.0 11.0 12.0 13.0}}
+test textDisp-4.14 {UpdateDisplayInfo, special handling for top/bottom lines} {
+ .t tag remove x 1.0 end
+ .t yview 1.0
+ update
+ .t yview scroll 3 units
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{11.0 12.0 13.0} {11.0 12.0 13.0}}
+test textDisp-4.15 {UpdateDisplayInfo, special handling for top/bottom lines} {
+ .t tag add x 1.0 end
+ .t yview 4.0
+ update
+ .t yview scroll -2 units
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{2.0 3.0} {2.0 3.0 4.0 11.0}}
+test textDisp-4.16 {UpdateDisplayInfo, special handling for top/bottom lines} {
+ .t tag remove x 1.0 end
+ .t yview 4.0
+ update
+ .t yview scroll -2 units
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{2.0 3.0} {2.0 3.0}}
+test textDisp-4.17 {UpdateDisplayInfo, horizontal scrolling} {fonts} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert end "Short line 1\nLine 2 is long enough to scroll horizontally"
+ .t insert end "\nLine 3\nLine 4"
+ update
+ .t xview scroll 3 units
+ update
+ list $tk_textRelayout $tk_textRedraw [.t bbox 2.0] [.t bbox 2.5] \
+ [.t bbox 2.23]
+} {{} {1.0 2.0 3.0 4.0} {} {17 16 7 13} {}}
+test textDisp-4.18 {UpdateDisplayInfo, horizontal scrolling} {fonts} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert end "Short line 1\nLine 2 is long enough to scroll horizontally"
+ .t insert end "\nLine 3\nLine 4"
+ update
+ .t xview scroll 100 units
+ update
+ list $tk_textRelayout $tk_textRedraw [.t bbox 2.25]
+} {{} {1.0 2.0 3.0 4.0} {10 16 7 13}}
+test textDisp-4.19 {UpdateDisplayInfo, horizontal scrolling} {fonts} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert end "Short line 1\nLine 2 is long enough to scroll horizontally"
+ .t insert end "\nLine 3\nLine 4"
+ update
+ .t xview moveto 0
+ .t xview scroll -10 units
+ update
+ list $tk_textRelayout $tk_textRedraw [.t bbox 2.5]
+} {{} {1.0 2.0 3.0 4.0} {38 16 7 13}}
+test textDisp-4.20 {UpdateDisplayInfo, horizontal scrolling} {fonts} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert end "Short line 1\nLine 2 is long enough to scroll horizontally"
+ .t insert end "\nLine 3\nLine 4"
+ .t xview moveto 0.0
+ .t xview scroll 100 units
+ update
+ .t delete 2.30 2.44
+ update
+ list $tk_textRelayout $tk_textRedraw [.t bbox 2.25]
+} {2.0 {1.0 2.0 3.0 4.0} {108 16 7 13}}
+test textDisp-4.21 {UpdateDisplayInfo, horizontal scrolling} {fonts} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert end "Short line 1\nLine 2 is long enough to scroll horizontally"
+ .t insert end "\nLine 3\nLine 4"
+ .t xview moveto .9
+ update
+ .t xview moveto .6
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{} {}}
+test textDisp-4.22 {UpdateDisplayInfo, no horizontal scrolling except for -wrap none} {fonts} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert end "Short line 1\nLine 2 is long enough to scroll horizontally"
+ .t insert end "\nLine 3\nLine 4"
+ .t xview scroll 25 units
+ update
+ .t configure -wrap word
+ list [.t bbox 2.0] [.t bbox 2.16]
+} {{3 16 7 13} {10 29 7 13}}
+test textDisp-4.23 {UpdateDisplayInfo, no horizontal scrolling except for -wrap none} {fonts} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert end "Short line 1\nLine 2 is long enough to scroll horizontally"
+ .t insert end "\nLine 3\nLine 4"
+ .t xview scroll 25 units
+ update
+ .t configure -wrap char
+ list [.t bbox 2.0] [.t bbox 2.16]
+} {{3 16 7 13} {115 16 7 13}}
+
+test textDisp-5.1 {DisplayDLine, handling of spacing} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "abcdefghijkl\nmnopqrstuvwzyz"
+ .t tag configure spacing -spacing1 8 -spacing3 2
+ .t tag add spacing 1.0 end
+ frame .t.f1 -width 10 -height 4 -bg black
+ frame .t.f2 -width 10 -height 4 -bg black
+ frame .t.f3 -width 10 -height 4 -bg black
+ frame .t.f4 -width 10 -height 4 -bg black
+ .t window create 1.3 -window .t.f1 -align top
+ .t window create 1.7 -window .t.f2 -align center
+ .t window create 2.1 -window .t.f3 -align bottom
+ .t window create 2.10 -window .t.f4 -align baseline
+ update
+ list [winfo geometry .t.f1] [winfo geometry .t.f2] \
+ [winfo geometry .t.f3] [winfo geometry .t.f4]
+} {10x4+24+11 10x4+55+15 10x4+10+43 10x4+76+40}
+.t tag delete spacing
+
+# Although the following test produces a useful result, its main
+# effect is to produce a core dump if Tk doesn't handle display
+# relayout that occurs during redisplay.
+
+test textDisp-5.2 {DisplayDLine, line resizes during display} {
+ .t delete 1.0 end
+ frame .t.f -width 20 -height 20 -bd 2 -relief raised
+ bind .t.f <Configure> {.t.f configure -width 30 -height 30}
+ .t window create insert -window .t.f
+ update
+ list [winfo width .t.f] [winfo height .t.f]
+} {30 30}
+
+.t configure -wrap char
+test textDisp-6.1 {scrolling in DisplayText, scroll up} {
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ update
+ .t delete 2.0 3.0
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{2.0 10.0} {2.0 10.0}}
+test textDisp-6.2 {scrolling in DisplayText, scroll down} {
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ update
+ .t insert 2.0 "New Line 2\n"
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{2.0 3.0} {2.0 3.0}}
+test textDisp-6.3 {scrolling in DisplayText, multiple scrolls} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ update
+ .t insert 2.end "is so long that it wraps"
+ .t insert 4.end "is so long that it wraps"
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{2.0 2.20 4.0 4.20} {2.0 2.20 4.0 4.20}}
+test textDisp-6.4 {scrolling in DisplayText, scrolls interfere} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ update
+ .t insert 2.end "is so long that it wraps around, not once but three times"
+ .t insert 4.end "is so long that it wraps"
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{2.0 2.20 2.40 2.60 4.0 4.20} {2.0 2.20 2.40 2.60 4.0 4.20 6.0}}
+test textDisp-6.5 {scrolling in DisplayText, scroll source obscured} {nonPortable} {
+ .t configure -wrap char
+ frame .f2 -bg red
+ place .f2 -in .t -relx 0.5 -rely 0.5 -relwidth 0.5 -relheight 0.5
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1 is so long that it wraps around, a couple of times"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ update
+ .t delete 1.6 1.end
+ update
+ destroy .f2
+ list $tk_textRelayout $tk_textRedraw
+} {{1.0 9.0 10.0} {1.0 4.0 5.0 9.0 10.0}}
+test textDisp-6.6 {scrolling in DisplayText, Expose events after scroll} {unixOnly nonPortable} {
+ # this test depends on all of the expose events being handled at once
+ .t configure -wrap char
+ frame .f2 -bg #ff0000
+ place .f2 -in .t -relx 0.2 -rely 0.5 -relwidth 0.5 -relheight 0.5
+ .t configure -bd 2 -relief raised
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1 is so long that it wraps around, a couple of times"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ update
+ .t delete 1.6 1.end
+ destroy .f2
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{1.0 9.0 10.0} {borders 1.0 4.0 5.0 6.0 7.0 8.0 9.0 10.0}}
+.t configure -bd 0
+test textDisp-6.7 {DisplayText, vertical scrollbar updates} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ update
+ set scrollInfo
+} {0 1}
+test textDisp-6.8 {DisplayText, vertical scrollbar updates} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1"
+ update
+ set scrollInfo "unchanged"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13} {
+ .t insert end "\nLine $i"
+ }
+ update
+ set scrollInfo
+} {0 0.769231}
+.t configure -yscrollcommand {} -xscrollcommand scroll
+test textDisp-6.9 {DisplayText, horizontal scrollbar updates} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ update
+ set scrollInfo unchanged
+ .t insert end xxxxxxxxx\n
+ .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n
+ .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxx
+ update
+ set scrollInfo
+} {0 0.363636}
+
+# The following group of tests is marked non-portable because
+# they result in a lot of extra redisplay under Ultrix. I don't
+# know why this is so.
+
+.t configure -bd 2 -relief raised -wrap char
+.t delete 1.0 end
+.t insert 1.0 "Line 1 is so long that it wraps around, a couple of times"
+foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+}
+test textDisp-7.1 {TkTextRedrawRegion} {nonPortable} {
+ frame .f2 -bg #ff0000
+ place .f2 -in .t -relx 0.2 -relwidth 0.6 -rely 0.22 -relheight 0.55
+ update
+ destroy .f2
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{} {1.40 2.0 3.0 4.0 5.0 6.0}}
+test textDisp-7.2 {TkTextRedrawRegion} {nonPortable} {
+ frame .f2 -bg #ff0000
+ place .f2 -in .t -relx 0 -relwidth 0.5 -rely 0 -relheight 0.5
+ update
+ destroy .f2
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{} {borders 1.0 1.20 1.40 2.0 3.0}}
+test textDisp-7.3 {TkTextRedrawRegion} {nonPortable} {
+ frame .f2 -bg #ff0000
+ place .f2 -in .t -relx 0.5 -relwidth 0.5 -rely 0.5 -relheight 0.5
+ update
+ destroy .f2
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{} {borders 4.0 5.0 6.0 7.0 8.0}}
+test textDisp-7.4 {TkTextRedrawRegion} {nonPortable} {
+ frame .f2 -bg #ff0000
+ place .f2 -in .t -relx 0.4 -relwidth 0.2 -rely 0 -relheight 0.2 \
+ -bordermode ignore
+ update
+ destroy .f2
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{} {borders 1.0 1.20}}
+test textDisp-7.5 {TkTextRedrawRegion} {nonPortable} {
+ frame .f2 -bg #ff0000
+ place .f2 -in .t -relx 0.4 -relwidth 0.2 -rely 1.0 -relheight 0.2 \
+ -anchor s -bordermode ignore
+ update
+ destroy .f2
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{} {borders 7.0 8.0}}
+test textDisp-7.6 {TkTextRedrawRegion} {nonPortable} {
+ frame .f2 -bg #ff0000
+ place .f2 -in .t -relx 0 -relwidth 0.2 -rely 0.55 -relheight 0.2 \
+ -anchor w -bordermode ignore
+ update
+ destroy .f2
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{} {borders 3.0 4.0 5.0}}
+test textDisp-7.7 {TkTextRedrawRegion} {nonPortable} {
+ frame .f2 -bg #ff0000
+ place .f2 -in .t -relx 1.0 -relwidth 0.2 -rely 0.55 -relheight 0.2 \
+ -anchor e -bordermode ignore
+ update
+ destroy .f2
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{} {borders 3.0 4.0 5.0}}
+test textDisp-7.8 {TkTextRedrawRegion} {nonPortable} {
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1\nLine 2\nLine 3\nLine 4\nLine 5\nLine 6\n"
+ frame .f2 -bg #ff0000
+ place .f2 -in .t -relx 0.0 -relwidth 0.4 -rely 0.35 -relheight 0.4 \
+ -anchor nw -bordermode ignore
+ update
+ destroy .f2
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{} {borders 4.0 5.0 6.0 7.0 eof}}
+.t configure -bd 0
+
+test textDisp-8.1 {TkTextChanged: redisplay whole lines} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1\nLine 2 is so long that it wraps around, two times"
+ foreach i {3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ update
+ .t delete 2.36 2.38
+ update
+ list $tk_textRelayout $tk_textRedraw [.t bbox 2.32]
+} {{2.0 2.18 2.38} {2.0 2.18 2.38} {101 29 7 13}}
+.t configure -wrap char
+test textDisp-8.2 {TkTextChanged, redisplay whole lines} {
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1 is so long that it wraps around, two times"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ update
+ .t insert 1.2 xx
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{1.0 1.20 1.40} {1.0 1.20 1.40}}
+test textDisp-8.3 {TkTextChanged} {
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1 is so long that it wraps around, two times"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ update
+ .t insert 2.0 xx
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {2.0 2.0}
+test textDisp-8.4 {TkTextChanged} {
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1 is so long that it wraps around, two times"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ update
+ .t delete 1.5
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{1.0 1.20 1.40} {1.0 1.20 1.40}}
+test textDisp-8.5 {TkTextChanged} {
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1 is so long that it wraps around, two times"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ update
+ .t delete 1.40 1.44
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{1.0 1.20 1.40} {1.0 1.20 1.40}}
+test textDisp-8.6 {TkTextChanged} {
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1 is so long that it wraps around, two times"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ update
+ .t delete 1.41 1.44
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{1.0 1.20 1.40} {1.0 1.20 1.40}}
+test textDisp-8.7 {TkTextChanged} {
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1 is so long that it wraps around, two times"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ update
+ .t delete 1.2 1.end
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{1.0 9.0 10.0} {1.0 9.0 10.0}}
+test textDisp-8.8 {TkTextChanged} {
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1 is so long that it wraps around, two times"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ update
+ .t delete 2.2
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {2.0 2.0}
+test textDisp-8.9 {TkTextChanged} {
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1 is so long that it wraps around, two times"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ update
+ .t delete 2.0 3.0
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{2.0 8.0} {2.0 8.0}}
+test textDisp-8.10 {TkTextChanged} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap\nLine 4"
+ .t tag add big 2.19
+ update
+ .t delete 2.19
+ update
+ set tk_textRedraw
+} {2.0 2.20 eof}
+test textDisp-8.11 {TkTextChanged, scrollbar notification when changes are off-screen} {
+ .t delete 1.0 end
+ .t insert end "1\n2\n3\n4\n5\n6\n7\n8\n9\n10\n11\n12\n"
+ .t configure -yscrollcommand scroll
+ update
+ set scrollInfo ""
+ .t insert end "a\nb\nc\n"
+ update
+ .t configure -yscrollcommand ""
+ set scrollInfo
+} {0 0.625}
+
+test textDisp-9.1 {TkTextRedrawTag} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1\nLine 2 is long enough to wrap around\nLine 3\nLine 4"
+ update
+ .t tag add big 2.2 2.4
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{2.0 2.18} {2.0 2.18}}
+test textDisp-9.2 {TkTextRedrawTag} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1\nLine 2 is long enough to wrap around\nLine 3\nLine 4"
+ update
+ .t tag add big 1.2 2.4
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{1.0 2.0 2.17} {1.0 2.0 2.17}}
+test textDisp-9.3 {TkTextRedrawTag} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1\nLine 2 is long enough to wrap around\nLine 3\nLine 4"
+ update
+ .t tag add big 2.2 2.4
+ .t tag remove big 1.0 end
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {2.0 2.0}
+test textDisp-9.4 {TkTextRedrawTag} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1\nLine 2 is long enough to wrap around\nLine 3\nLine 4"
+ update
+ .t tag add big 2.2 2.20
+ .t tag remove big 1.0 end
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {2.0 2.0}
+test textDisp-9.5 {TkTextRedrawTag} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1\nLine 2 is long enough to wrap around\nLine 3\nLine 4"
+ update
+ .t tag add big 2.2 2.end
+ .t tag remove big 1.0 end
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{2.0 2.20} {2.0 2.20}}
+test textDisp-9.6 {TkTextRedrawTag} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap\nLine 4"
+ update
+ .t tag add big 2.2 3.5
+ .t tag remove big 1.0 end
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{2.0 2.20 3.0} {2.0 2.20 3.0}}
+test textDisp-9.7 {TkTextRedrawTag} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap\nLine 4"
+ .t tag add big 2.19
+ update
+ .t tag remove big 2.19
+ update
+ set tk_textRedraw
+} {2.0 2.20 eof}
+test textDisp-9.8 {TkTextRedrawTag} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap\nLine 4"
+ .t tag add big 1.0 2.0
+ update
+ .t tag add big 2.0 2.5
+ update
+ set tk_textRedraw
+} {2.0 2.17}
+test textDisp-9.9 {TkTextRedrawTag} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap\nLine 4"
+ .t tag add big 1.0 2.0
+ update
+ .t tag add big 1.5 2.5
+ update
+ set tk_textRedraw
+} {2.0 2.17}
+test textDisp-9.10 {TkTextRedrawTag} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap\nLine 4"
+ .t tag add big 1.0 2.0
+ update
+ set tk_textRedraw {none}
+ .t tag add big 1.3 1.5
+ update
+ set tk_textRedraw
+} {none}
+test textDisp-9.11 {TkTextRedrawTag} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap\nLine 4"
+ .t tag add big 1.0 2.0
+ update
+ .t tag add big 1.0 2.0
+ update
+ set tk_textRedraw
+} {}
+
+test textDisp-10.1 {TkTextRelayoutWindow} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1\nLine 2 is long enough to wrap\nLine 3 is also long enough to wrap\nLine 4"
+ update
+ .t configure -bg black
+ update
+ list $tk_textRelayout $tk_textRedraw
+} {{1.0 2.0 2.20 3.0 3.20 4.0} {borders 1.0 2.0 2.20 3.0 3.20 4.0 eof}}
+.t configure -bg [lindex [.t configure -bg] 3]
+test textDisp-10.2 {TkTextRelayoutWindow} {
+ toplevel .top -width 300 -height 200
+ wm geometry .top +0+0
+ text .top.t -font $fixedFont -width 20 -height 10 -relief raised -bd 2
+ place .top.t -x 0 -y 0 -width 20 -height 20
+ .top.t insert end "First line"
+ .top.t see insert
+ tkwait visibility .top.t
+ place .top.t -width 150 -height 100
+ update
+ .top.t index @0,0
+} {1.0}
+catch {destroy .top}
+
+.t delete 1.0 end
+.t insert end "Line 1"
+for {set i 2} {$i <= 200} {incr i} {
+ .t insert end "\nLine $i"
+}
+update
+test textDisp-11.1 {TkTextSetYView} {
+ .t yview 30.0
+ update
+ .t index @0,0
+} {30.0}
+test textDisp-11.2 {TkTextSetYView} {
+ .t yview 30.0
+ update
+ .t yview 32.0
+ update
+ list [.t index @0,0] $tk_textRedraw
+} {32.0 {40.0 41.0}}
+test textDisp-11.3 {TkTextSetYView} {
+ .t yview 30.0
+ update
+ .t yview 28.0
+ update
+ list [.t index @0,0] $tk_textRedraw
+} {28.0 {28.0 29.0}}
+test textDisp-11.4 {TkTextSetYView} {
+ .t yview 30.0
+ update
+ .t yview 31.4
+ update
+ list [.t index @0,0] $tk_textRedraw
+} {31.0 40.0}
+test textDisp-11.5 {TkTextSetYView} {
+ .t yview 30.0
+ update
+ set tk_textRedraw {}
+ .t yview -pickplace 31.0
+ update
+ list [.t index @0,0] $tk_textRedraw
+} {30.0 {}}
+test textDisp-11.6 {TkTextSetYView} {
+ .t yview 30.0
+ update
+ set tk_textRedraw {}
+ .t yview -pickplace 28.0
+ update
+ list [.t index @0,0] $tk_textRedraw
+} {28.0 {28.0 29.0}}
+test textDisp-11.7 {TkTextSetYView} {
+ .t yview 30.0
+ update
+ set tk_textRedraw {}
+ .t yview -pickplace 26.0
+ update
+ list [.t index @0,0] $tk_textRedraw
+} {22.0 {22.0 23.0 24.0 25.0 26.0 27.0 28.0 29.0}}
+test textDisp-11.8 {TkTextSetYView} {
+ .t yview 30.0
+ update
+ set tk_textRedraw {}
+ .t yview -pickplace 41.0
+ update
+ list [.t index @0,0] $tk_textRedraw
+} {32.0 {40.0 41.0}}
+test textDisp-11.9 {TkTextSetYView} {
+ .t yview 30.0
+ update
+ set tk_textRedraw {}
+ .t yview -pickplace 43.0
+ update
+ list [.t index @0,0] $tk_textRedraw
+} {39.0 {40.0 41.0 42.0 43.0 44.0 45.0 46.0 47.0 48.0}}
+test textDisp-11.10 {TkTextSetYView} {
+ .t yview 30.0
+ update
+ set tk_textRedraw {}
+ .t yview 10000.0
+ update
+ list [.t index @0,0] $tk_textRedraw
+} {191.0 {191.0 192.0 193.0 194.0 195.0 196.0 197.0 198.0 199.0 200.0}}
+test textDisp-11.11 {TkTextSetYView} {
+ .t yview 195.0
+ update
+ set tk_textRedraw {}
+ .t yview 197.0
+ update
+ list [.t index @0,0] $tk_textRedraw
+} {191.0 {191.0 192.0 193.0 194.0 195.0 196.0}}
+test textDisp-11.12 {TkTextSetYView, wrapped line is off-screen} {
+ .t insert 10.0 "Long line with enough text to wrap\n"
+ .t yview 1.0
+ update
+ set tk_textRedraw {}
+ .t see 10.30
+ update
+ list [.t index @0,0] $tk_textRedraw
+} {2.0 10.20}
+.t delete 10.0 11.0
+test textDisp-11.13 {TkTestSetYView, partially-visible last line} {
+ catch {destroy .top}
+ toplevel .top
+ wm geometry .top +0+0
+ text .top.t -width 20 -height 5
+ pack .top.t
+ .top.t insert end "Line 1"
+ for {set i 2} {$i <= 100} {incr i} {
+ .top.t insert end "\nLine $i"
+ }
+ update
+ scan [wm geometry .top] "%dx%d" w2 h2
+ wm geometry .top ${w2}x[expr $h2-2]
+ update
+ .top.t yview 1.0
+ update
+ set tk_textRedraw {}
+ .top.t see 5.0
+ update
+ list [.top.t index @0,0] $tk_textRedraw
+} {2.0 {5.0 6.0}}
+catch {destroy .top}
+toplevel .top
+wm geometry .top +0+0
+text .top.t -width 30 -height 3
+pack .top.t
+.top.t insert end "Line 1"
+for {set i 2} {$i <= 20} {incr i} {
+ .top.t insert end "\nLine $i"
+}
+update
+test textDisp-11.14 {TkTextSetYView, only a few lines visible} {
+ .top.t yview 5.0
+ update
+ .top.t see 10.0
+ .top.t index @0,0
+} {8.0}
+test textDisp-11.15 {TkTextSetYView, only a few lines visible} {
+ .top.t yview 5.0
+ update
+ .top.t see 11.0
+ .top.t index @0,0
+} {10.0}
+test textDisp-11.16 {TkTextSetYView, only a few lines visible} {
+ .top.t yview 8.0
+ update
+ .top.t see 5.0
+ .top.t index @0,0
+} {5.0}
+test textDisp-11.17 {TkTextSetYView, only a few lines visible} {
+ .top.t yview 8.0
+ update
+ .top.t see 4.0
+ .top.t index @0,0
+} {3.0}
+destroy .top
+
+.t configure -wrap word
+.t delete 50.0 51.0
+.t insert 50.0 "This is a long line, one that will wrap around twice.\n"
+test textDisp-12.1 {MeasureUp} {
+ .t yview 100.0
+ update
+ .t yview -pickplace 52.0
+ update
+ .t index @0,0
+} {50.0}
+test textDisp-12.2 {MeasureUp} {
+ .t yview 100.0
+ update
+ .t yview -pickplace 53.0
+ update
+ .t index @0,0
+} {50.15}
+test textDisp-12.3 {MeasureUp} {
+ .t yview 100.0
+ update
+ .t yview -pickplace 50.10
+ update
+ .t index @0,0
+} {46.0}
+.t configure -wrap none
+test textDisp-12.4 {MeasureUp} {
+ .t yview 100.0
+ update
+ .t yview -pickplace 53.0
+ update
+ .t index @0,0
+} {49.0}
+test textDisp-12.5 {MeasureUp} {
+ .t yview 100.0
+ update
+ .t yview -pickplace 50.10
+ update
+ .t index @0,0
+} {46.0}
+
+.t configure -wrap none
+.t delete 1.0 end
+for {set i 1} {$i < 99} {incr i} {
+ .t insert end "Line $i\n"
+}
+.t insert end "Line 100"
+.t insert 30.end { is quite long, so that it flows way off the end of the window and we can use it to test out the horizontal positioning features of the "see" command.}
+test textDisp-13.1 {TkTextSeeCmd procedure} {
+ list [catch {.t see} msg] $msg
+} {1 {wrong # args: should be ".t see index"}}
+test textDisp-13.2 {TkTextSeeCmd procedure} {
+ list [catch {.t see a b} msg] $msg
+} {1 {wrong # args: should be ".t see index"}}
+test textDisp-13.3 {TkTextSeeCmd procedure} {
+ list [catch {.t see badIndex} msg] $msg
+} {1 {bad text index "badIndex"}}
+test textDisp-13.4 {TkTextSeeCmd procedure} {
+ .t xview moveto 0
+ .t yview moveto 0
+ update
+ .t see 4.2
+ .t index @0,0
+} {1.0}
+test textDisp-13.5 {TkTextSeeCmd procedure} {
+ .t configure -wrap char
+ .t xview moveto 0
+ .t yview moveto 0
+ update
+ .t see 12.1
+ .t index @0,0
+} {3.0}
+test textDisp-13.6 {TkTextSeeCmd procedure} {
+ .t configure -wrap char
+ .t xview moveto 0
+ .t yview moveto 0
+ update
+ .t see 30.50
+ set x [.t index @0,0]
+ .t configure -wrap none
+ set x
+} {28.0}
+test textDisp-13.7 {TkTextSeeCmd procedure} {fonts} {
+ .t xview moveto 0
+ .t yview moveto 0
+ .t tag add sel 30.20
+ .t tag add sel 30.40
+ update
+ .t see 30.50
+ set x [list [.t bbox 30.50]]
+ .t see 30.39
+ lappend x [.t bbox 30.39]
+ .t see 30.38
+ lappend x [.t bbox 30.38]
+ .t see 30.20
+ lappend x [.t bbox 30.20]
+} {{73 55 7 13} {3 55 7 13} {3 55 7 13} {73 55 7 13}}
+test textDisp-13.8 {TkTextSeeCmd procedure} {fonts} {
+ .t xview moveto 0
+ .t yview moveto 0
+ .t tag add sel 30.20
+ .t tag add sel 30.50
+ update
+ .t see 30.50
+ set x [list [.t bbox 30.50]]
+ .t see 30.60
+ lappend x [.t bbox 30.60]
+ .t see 30.65
+ lappend x [.t bbox 30.65]
+ .t see 30.90
+ lappend x [.t bbox 30.90]
+} {{73 55 7 13} {136 55 7 13} {136 55 7 13} {73 55 7 13}}
+test textDisp-13.9 {TkTextSeeCmd procedure} {fonts} {
+ wm geom . [expr $width-2]x$height
+ .t xview moveto 0
+ .t yview moveto 0
+ .t tag add sel 30.20
+ .t tag add sel 30.50
+ update
+ .t see 30.50
+ set x [list [.t bbox 30.50]]
+ .t see 30.60
+ lappend x [.t bbox 30.60]
+ .t see 30.65
+ lappend x [.t bbox 30.65]
+ .t see 30.90
+ lappend x [.t bbox 30.90]
+} {{80 55 7 13} {136 55 7 13} {136 55 7 13} {80 55 7 13}}
+wm geom . {}
+
+.t configure -wrap none
+test textDisp-14.1 {TkTextXviewCmd procedure} {
+ .t delete 1.0 end
+ update
+ .t insert end xxxxxxxxx\n
+ .t insert end "xxxxx xxxxxxxxxxx xxxx xxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxx\n"
+ .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx"
+ .t xview moveto .5
+ .t xview
+} {0.5 0.857143}
+.t configure -wrap char
+test textDisp-14.2 {TkTextXviewCmd procedure} {
+ .t delete 1.0 end
+ update
+ .t insert end xxxxxxxxx\n
+ .t insert end "xxxxx\n"
+ .t insert end "xxxx"
+ .t xview
+} {0 1}
+.t configure -wrap none
+test textDisp-14.3 {TkTextXviewCmd procedure} {
+ .t delete 1.0 end
+ update
+ .t insert end xxxxxxxxx\n
+ .t insert end "xxxxx\n"
+ .t insert end "xxxx"
+ .t xview
+} {0 1}
+test textDisp-14.4 {TkTextXviewCmd procedure} {
+ list [catch {.t xview moveto} msg] $msg
+} {1 {wrong # args: should be ".t xview moveto fraction"}}
+test textDisp-14.5 {TkTextXviewCmd procedure} {
+ list [catch {.t xview moveto a b} msg] $msg
+} {1 {wrong # args: should be ".t xview moveto fraction"}}
+test textDisp-14.6 {TkTextXviewCmd procedure} {
+ list [catch {.t xview moveto a} msg] $msg
+} {1 {expected floating-point number but got "a"}}
+test textDisp-14.7 {TkTextXviewCmd procedure} {
+ .t delete 1.0 end
+ .t insert end xxxxxxxxx\n
+ .t insert end "xxxxx xxxxxxxxxxx xxxx xxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxx\n"
+ .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx"
+ .t xview moveto .3
+ .t xview
+} {0.303571 0.660714}
+test textDisp-14.8 {TkTextXviewCmd procedure} {
+ .t delete 1.0 end
+ .t insert end xxxxxxxxx\n
+ .t insert end "xxxxx xxxxxxxxxxx xxxx xxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxx\n"
+ .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx"
+ .t xview moveto -.4
+ .t xview
+} {0 0.357143}
+test textDisp-14.9 {TkTextXviewCmd procedure} {
+ .t delete 1.0 end
+ .t insert end xxxxxxxxx\n
+ .t insert end "xxxxx xxxxxxxxxxx xxxx xxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxx\n"
+ .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx"
+ .t xview m 1.4
+ .t xview
+} {0.642857 1}
+test textDisp-14.10 {TkTextXviewCmd procedure} {
+ list [catch {.t xview scroll a} msg] $msg
+} {1 {wrong # args: should be ".t xview scroll number units|pages"}}
+test textDisp-14.11 {TkTextXviewCmd procedure} {
+ list [catch {.t xview scroll a b c} msg] $msg
+} {1 {wrong # args: should be ".t xview scroll number units|pages"}}
+test textDisp-14.12 {TkTextXviewCmd procedure} {
+ list [catch {.t xview scroll gorp units} msg] $msg
+} {1 {expected integer but got "gorp"}}
+test textDisp-14.13 {TkTextXviewCmd procedure} {
+ .t delete 1.0 end
+ .t insert end xxxxxxxxx\n
+ .t insert end "a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 c0 c1 c2 c3 c4 c5 c6 c7 c8 c9\n"
+ .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx"
+ .t xview moveto 0
+ .t xview scroll 2 p
+ set x [.t index @0,22]
+ .t xview scroll -1 p
+ lappend x [.t index @0,22]
+ .t xview scroll -2 pages
+ lappend x [.t index @0,22]
+} {2.36 2.18 2.0}
+test textDisp-14.14 {TkTextXviewCmd procedure} {
+ .t delete 1.0 end
+ .t insert end xxxxxxxxx\n
+ .t insert end "a0 a1 a2 a3 a4 a5 a6 a7 a8 a9 b0 b1 b2 b3 b4 b5 b6 b7 b8 b9 c0 c1 c2 c3 c4 c5 c6 c7 c8 c9 c0 c1 c2 c3 c4 c5 c6 c7 c8 c9\n"
+ .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx"
+ .t xview moveto 0
+ .t xview scroll 21 u
+ set x [.t index @0,22]
+ .t xview scroll -1 u
+ lappend x [.t index @0,22]
+ .t xview scroll 100 units
+ lappend x [.t index @0,22]
+ .t xview scroll -15 units
+ lappend x [.t index @0,22]
+} {2.21 2.20 2.99 2.84}
+test textDisp-14.15 {TkTextXviewCmd procedure} {
+ list [catch {.t xview scroll 14 globs} msg] $msg
+} {1 {bad argument "globs": must be units or pages}}
+test textDisp-14.16 {TkTextXviewCmd procedure} {
+ list [catch {.t xview flounder} msg] $msg
+} {1 {unknown option "flounder": must be moveto or scroll}}
+
+.t configure -wrap char
+.t delete 1.0 end
+for {set i 1} {$i < 99} {incr i} {
+ .t insert end "Line $i\n"
+}
+.t insert end "Line 100"
+.t delete 50.0 51.0
+.t insert 50.0 "This is a long line, one that will wrap around twice.\n"
+test textDisp-15.1 {ScrollByLines procedure, scrolling backwards} {
+ .t yview 45.0
+ update
+ .t yview scroll -3 units
+ .t index @0,0
+} {42.0}
+test textDisp-15.2 {ScrollByLines procedure, scrolling backwards} {
+ .t yview 51.0
+ update
+ .t yview scroll -2 units
+ .t index @0,0
+} {50.20}
+test textDisp-15.3 {ScrollByLines procedure, scrolling backwards} {
+ .t yview 51.0
+ update
+ .t yview scroll -4 units
+ .t index @0,0
+} {49.0}
+test textDisp-15.4 {ScrollByLines procedure, scrolling backwards} {
+ .t yview 50.20
+ update
+ .t yview scroll -2 units
+ .t index @0,0
+} {49.0}
+test textDisp-15.5 {ScrollByLines procedure, scrolling backwards} {
+ .t yview 50.40
+ update
+ .t yview scroll -2 units
+ .t index @0,0
+} {50.0}
+test textDisp-15.6 {ScrollByLines procedure, scrolling backwards} {
+ .t yview 3.2
+ update
+ .t yview scroll -5 units
+ .t index @0,0
+} {1.0}
+test textDisp-15.7 {ScrollByLines procedure, scrolling forwards} {
+ .t yview 48.0
+ update
+ .t yview scroll 4 units
+ .t index @0,0
+} {50.40}
+
+.t configure -wrap char
+.t delete 1.0 end
+.t insert insert "Line 1"
+for {set i 2} {$i <= 200} {incr i} {
+ .t insert end "\nLine $i"
+}
+.t tag add big 100.0 105.0
+.t insert 151.end { has a lot of extra text, so that it wraps around on the screen several times over.}
+.t insert 153.end { also has enoug extra text to wrap.}
+update
+test textDisp-16.1 {TkTextYviewCmd procedure} {
+ .t yview 21.0
+ set x [.t yview]
+ .t yview 1.0
+ set x
+} {0.1 0.15}
+test textDisp-16.2 {TkTextYviewCmd procedure} {
+ list [catch {.t yview 2 3} msg] $msg
+} {1 {unknown option "2": must be moveto or scroll}}
+test textDisp-16.3 {TkTextYviewCmd procedure} {
+ list [catch {.t yview -pickplace} msg] $msg
+} {1 {wrong # args: should be ".t yview -pickplace lineNum|index"}}
+test textDisp-16.4 {TkTextYviewCmd procedure} {
+ list [catch {.t yview -pickplace 2 3} msg] $msg
+} {1 {wrong # args: should be ".t yview -pickplace lineNum|index"}}
+test textDisp-16.5 {TkTextYviewCmd procedure} {
+ list [catch {.t yview -bogus 2} msg] $msg
+} {1 {unknown option "-bogus": must be moveto or scroll}}
+test textDisp-16.6 {TkTextYviewCmd procedure, integer position} {
+ .t yview 100.0
+ update
+ .t yview 98
+ .t index @0,0
+} {99.0}
+test textDisp-16.7 {TkTextYviewCmd procedure} {
+ .t yview 2.0
+ .t yv -pickplace 13.0
+ .t index @0,0
+} {4.0}
+test textDisp-16.8 {TkTextYviewCmd procedure} {
+ list [catch {.t yview bad_mark_name} msg] $msg
+} {1 {bad text index "bad_mark_name"}}
+test textDisp-16.9 {TkTextYviewCmd procedure, "moveto" option} {
+ list [catch {.t yview moveto a b} msg] $msg
+} {1 {wrong # args: should be ".t yview moveto fraction"}}
+test textDisp-16.10 {TkTextYviewCmd procedure, "moveto" option} {
+ list [catch {.t yview moveto gorp} msg] $msg
+} {1 {expected floating-point number but got "gorp"}}
+test textDisp-16.11 {TkTextYviewCmd procedure, "moveto" option} {
+ .t yview moveto 0.5
+ .t index @0,0
+} {101.0}
+test textDisp-16.12 {TkTextYviewCmd procedure, "moveto" option} {
+ .t yview moveto -1
+ .t index @0,0
+} {1.0}
+test textDisp-16.13 {TkTextYviewCmd procedure, "moveto" option} {
+ .t yview moveto 1.1
+ .t index @0,0
+} {191.0}
+test textDisp-16.14 {TkTextYviewCmd procedure, "moveto" option} {
+ .t yview moveto .75
+ .t index @0,0
+} {151.0}
+test textDisp-16.15 {TkTextYviewCmd procedure, "moveto" option} {
+ .t yview moveto .752
+ .t index @0,0
+} {151.20}
+test textDisp-16.16 {TkTextYviewCmd procedure, "moveto" option} {
+ .t yview moveto .754
+ .t index @0,0
+} {151.60}
+test textDisp-16.17 {TkTextYviewCmd procedure, "moveto" option} {
+ .t yview moveto .755
+ .t index @0,0
+} {152.0}
+test textDisp-16.18 {TkTextYviewCmd procedure, "moveto" roundoff} {fonts} {
+ catch {destroy .top1}
+ toplevel .top1
+ wm geometry .top1 +0+0
+ text .top1.t -height 3 -width 4 -wrap none -setgrid 1 -padx 6 \
+ -spacing3 6
+ .top1.t insert end "1\n2\n3\n4\n5\n6"
+ pack .top1.t
+ update
+ .top1.t yview moveto 0.3333
+ set result [.top1.t yview]
+ destroy .top1
+ set result
+} {0.333333 0.833333}
+test textDisp-16.19 {TkTextYviewCmd procedure, "scroll" option} {
+ list [catch {.t yview scroll a} msg] $msg
+} {1 {wrong # args: should be ".t yview scroll number units|pages"}}
+test textDisp-16.20 {TkTextYviewCmd procedure, "scroll" option} {
+ list [catch {.t yview scroll a b c} msg] $msg
+} {1 {wrong # args: should be ".t yview scroll number units|pages"}}
+test textDisp-16.21 {TkTextYviewCmd procedure, "scroll" option} {
+ list [catch {.t yview scroll badInt bogus} msg] $msg
+} {1 {expected integer but got "badInt"}}
+test textDisp-16.22 {TkTextYviewCmd procedure, "scroll" option, back pages} {
+ .t yview 50.0
+ update
+ .t yview scroll -1 pages
+ .t index @0,0
+} {42.0}
+test textDisp-16.23 {TkTextYviewCmd procedure, "scroll" option, back pages} {
+ .t yview 50.0
+ update
+ .t yview scroll -3 p
+ .t index @0,0
+} {26.0}
+test textDisp-16.24 {TkTextYviewCmd procedure, "scroll" option, back pages} {
+ .t yview 5.0
+ update
+ .t yview scroll -3 p
+ .t index @0,0
+} {1.0}
+test textDisp-16.25 {TkTextYviewCmd procedure, "scroll" option, back pages} {
+ .t configure -height 1
+ update
+ .t yview 50.0
+ update
+ .t yview scroll -1 pages
+ set x [.t index @0,0]
+ .t configure -height 10
+ update
+ set x
+} {49.0}
+test textDisp-16.26 {TkTextYviewCmd procedure, "scroll" option, forward pages} {
+ .t yview 50.0
+ update
+ .t yview scroll 1 pages
+ .t index @0,0
+} {58.0}
+test textDisp-16.27 {TkTextYviewCmd procedure, "scroll" option, forward pages} {
+ .t yview 50.0
+ update
+ .t yview scroll 2 pages
+ .t index @0,0
+} {66.0}
+test textDisp-16.28 {TkTextYviewCmd procedure, "scroll" option, forward pages} {fonts} {
+ .t yview 98.0
+ update
+ .t yview scroll 1 page
+ .t index @0,0
+} {103.0}
+test textDisp-16.29 {TkTextYviewCmd procedure, "scroll" option, forward pages} {
+ .t configure -height 1
+ update
+ .t yview 50.0
+ update
+ .t yview scroll 1 pages
+ set x [.t index @0,0]
+ .t configure -height 10
+ update
+ set x
+} {51.0}
+test textDisp-16.30 {TkTextYviewCmd procedure, "scroll units" option} {
+ .t yview 45.0
+ update
+ .t yview scroll -3 units
+ .t index @0,0
+} {42.0}
+test textDisp-16.31 {TkTextYviewCmd procedure, "scroll units" option} {
+ .t yview 149.0
+ update
+ .t yview scroll 4 units
+ .t index @0,0
+} {151.40}
+test textDisp-16.32 {TkTextYviewCmd procedure} {
+ list [catch {.t yview scroll 12 bogoids} msg] $msg
+} {1 {bad argument "bogoids": must be units or pages}}
+test textDisp-16.33 {TkTextYviewCmd procedure} {
+ list [catch {.t yview bad_arg 1 2} msg] $msg
+} {1 {unknown option "bad_arg": must be moveto or scroll}}
+
+.t delete 1.0 end
+foreach i {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} {
+ .t insert end "\nLine $i 11111 $i 22222 $i 33333 $i 44444 $i 55555"
+ .t insert end " $i 66666 $i 77777 $i 88888 $i"
+}
+.t configure -wrap none
+test textDisp-17.1 {TkTextScanCmd procedure} {
+ list [catch {.t scan a b} msg] $msg
+} {1 {wrong # args: should be ".t scan mark|dragto x y"}}
+test textDisp-17.2 {TkTextScanCmd procedure} {
+ list [catch {.t scan a b c d} msg] $msg
+} {1 {wrong # args: should be ".t scan mark|dragto x y"}}
+test textDisp-17.3 {TkTextScanCmd procedure} {
+ list [catch {.t scan stupid b 20} msg] $msg
+} {1 {expected integer but got "b"}}
+test textDisp-17.4 {TkTextScanCmd procedure} {
+ list [catch {.t scan stupid -2 bogus} msg] $msg
+} {1 {expected integer but got "bogus"}}
+test textDisp-17.5 {TkTextScanCmd procedure} {
+ list [catch {.t scan stupid 123 456} msg] $msg
+} {1 {bad scan option "stupid": must be mark or dragto}}
+test textDisp-17.6 {TkTextScanCmd procedure} {fonts} {
+ .t yview 1.0
+ .t xview moveto 0
+ .t scan mark 40 60
+ .t scan dragto 35 55
+ .t index @0,0
+} {4.7}
+test textDisp-17.7 {TkTextScanCmd procedure} {fonts} {
+ .t yview 10.0
+ .t xview moveto 0
+ .t xview scroll 20 units
+ .t scan mark -10 60
+ .t scan dragto -5 65
+ .t index @0,0
+ set x [.t index @0,0]
+ .t scan dragto 0 70
+ list $x [.t index @0,0]
+} {7.13 3.6}
+test textDisp-17.8 {TkTextScanCmd procedure} {fonts} {
+ .t yview 1.0
+ .t xview moveto 0
+ .t scan mark 0 60
+ .t scan dragto 30 100
+ .t scan dragto 25 95
+ .t index @0,0
+} {4.7}
+test textDisp-17.9 {TkTextScanCmd procedure} {fonts} {
+ .t yview end
+ .t xview moveto 0
+ .t xview scroll 100 units
+ .t scan mark 90 60
+ .t scan dragto 10 0
+ .t scan dragto 15 5
+ .t index @0,0
+} {18.44}
+.t configure -wrap word
+test textDisp-17.10 {TkTextScanCmd procedure, word wrapping} {fonts} {
+ .t yview 10.0
+ .t scan mark -10 60
+ .t scan dragto -5 65
+ set x [.t index @0,0]
+ .t scan dragto 0 70
+ list $x [.t index @0,0]
+} {9.31 8.47}
+
+.t configure -xscrollcommand scroll -yscrollcommand {}
+test textDisp-18.1 {GetXView procedure} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert end xxxxxxxxx\n
+ .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n
+ .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxx
+ update
+ set scrollInfo
+} {0 0.363636}
+test textDisp-18.2 {GetXView procedure} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert end xxxxxxxxx\n
+ .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n
+ .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxx
+ update
+ set scrollInfo
+} {0 1}
+test textDisp-18.3 {GetXView procedure} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ update
+ set scrollInfo
+} {0 1}
+test textDisp-18.4 {GetXView procedure} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert end xxxxxxxxx\n
+ .t insert end xxxxxx\n
+ .t insert end xxxxxxxxxxxxxxxxx
+ update
+ set scrollInfo
+} {0 1}
+test textDisp-18.5 {GetXView procedure} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert end xxxxxxxxx\n
+ .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n
+ .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxx
+ .t xview scroll 31 units
+ update
+ set scrollInfo
+} {0.563636 0.927273}
+test textDisp-18.6 {GetXView procedure} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert end xxxxxxxxx\n
+ .t insert end "xxxxx xxxxxxxxxxx xxxx xxxxxxxxxxxxxxxxxxxx xxxxxxxxxxxx\n"
+ .t insert end "xxxx xxxxxxxxx xxxxxxxxxxxxx"
+ .t xview moveto 0
+ .t xview scroll 31 units
+ update
+ set x {}
+ lappend x $scrollInfo
+ .t configure -wrap char
+ update
+ lappend x $scrollInfo
+ .t configure -wrap word
+ update
+ lappend x $scrollInfo
+ .t configure -wrap none
+ update
+ lappend x $scrollInfo
+} {{0.553571 0.910714} {0 1} {0 1} {0 0.357143}}
+test textDisp-18.7 {GetXView procedure} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ update
+ set scrollInfo unchanged
+ .t insert end xxxxxx\n
+ .t insert end xxx
+ update
+ set scrollInfo
+} {unchanged}
+test textDisp-18.8 {GetXView procedure} {
+ proc bgerror msg {
+ global x errorInfo
+ set x [list $msg $errorInfo]
+ }
+ proc bogus args {
+ error "bogus scroll proc"
+ }
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert end xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx\n
+ update
+ .t delete 1.0 end
+ .t configure -xscrollcommand scrollError
+ update
+ set x
+} {{scrolling error} {scrolling error
+ while executing
+"error "scrolling error""
+ (procedure "scrollError" line 2)
+ invoked from within
+"scrollError 0 1"
+ (horizontal scrolling command executed by text)}}
+catch {rename bgerror {}}
+catch {rename bogus {}}
+.t configure -xscrollcommand {} -yscrollcommand scroll
+
+.t configure -xscrollcommand {} -yscrollcommand scroll
+test textDisp-19.1 {GetYView procedure} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ update
+ set scrollInfo
+} {0 1}
+test textDisp-19.2 {GetYView procedure} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ update
+ set scrollInfo "unchanged"
+ .t insert 1.0 "Line1\nLine2"
+ update
+ set scrollInfo
+} {unchanged}
+test textDisp-19.3 {GetYView procedure} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ update
+ set scrollInfo "unchanged"
+ .t insert 1.0 "Line 1\nLine 2 is so long that it wraps around\nLine 3"
+ update
+ set scrollInfo
+} {unchanged}
+test textDisp-19.4 {GetYView procedure} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1"
+ update
+ set scrollInfo "unchanged"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13} {
+ .t insert end "\nLine $i"
+ }
+ update
+ set scrollInfo
+} {0 0.769231}
+test textDisp-19.5 {GetYView procedure} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13} {
+ .t insert end "\nLine $i"
+ }
+ .t insert 2.end " is really quite long; in fact it's so long that it wraps three times"
+ update
+ set x $scrollInfo
+} {0 0.538462}
+test textDisp-19.6 {GetYView procedure} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13} {
+ .t insert end "\nLine $i"
+ }
+ .t insert 2.end " is really quite long; in fact it's so long that it wraps three times"
+ .t yview 4.0
+ update
+ set x $scrollInfo
+} {0.230769 1}
+test textDisp-19.7 {GetYView procedure} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13} {
+ .t insert end "\nLine $i"
+ }
+ .t insert 2.end " is really quite long; in fact it's so long that it wraps three times"
+ .t yview 2.26
+ update
+ set x $scrollInfo
+} {0.097166 0.692308}
+test textDisp-19.8 {GetYView procedure} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13} {
+ .t insert end "\nLine $i"
+ }
+ .t insert 10.end " is really quite long; in fact it's so long that it wraps three times"
+ .t yview 2.0
+ update
+ set x $scrollInfo
+} {0.0769231 0.732268}
+test textDisp-19.9 {GetYView procedure} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ .t yview 3.0
+ update
+ set scrollInfo
+} {0.133333 0.8}
+test textDisp-19.10 {GetYView procedure} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ .t yview 11.0
+ update
+ set scrollInfo
+} {0.333333 1}
+test textDisp-19.11 {GetYView procedure} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ .t insert end "\nThis last line wraps around four "
+ .t insert end "times with a bit left on the last line."
+ .t yview insert
+ update
+ set scrollInfo
+} {0.625 1}
+test textDisp-19.12 {GetYView procedure, partially visible last line} {
+ catch {destroy .top}
+ toplevel .top
+ wm geometry .top +0+0
+ text .top.t -width 40 -height 5
+ pack .top.t -expand yes -fill both
+ .top.t insert end "Line 1\nLine 2\nLine 3\nLine 4\nLine 5"
+ update
+ scan [wm geom .top] %dx%d twidth theight
+ wm geom .top ${twidth}x[expr $theight - 3]
+ update
+ .top.t yview
+} {0 0.8}
+test textDisp-19.13 {GetYView procedure, partially visible last line} {fonts} {
+ catch {destroy .top}
+ toplevel .top
+ wm geometry .top +0+0
+ text .top.t -width 40 -height 5
+ pack .top.t -expand yes -fill both
+ .top.t insert end "Line 1\nLine 2\nLine 3\nLine 4 has enough text to wrap around at least once"
+ update
+ scan [wm geom .top] %dx%d twidth theight
+ wm geom .top ${twidth}x[expr $theight - 3]
+ update
+ .top.t yview
+} {0 0.942308}
+catch {destroy .top}
+test textDisp-19.14 {GetYView procedure} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ .t insert end "\nThis last line wraps around four "
+ .t insert end "times with a bit left on the last line."
+ update
+ set scrollInfo "unchanged"
+ .t mark set insert 3.0
+ .t tag configure x -background red
+ .t tag add x 1.0 5.0
+ update
+ .t tag delete x
+ set scrollInfo
+} {unchanged}
+test textDisp-19.15 {GetYView procedure} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1"
+ foreach i {2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+ .t insert end "\nLine $i"
+ }
+ .t insert end "\nThis last line wraps around four "
+ .t insert end "times with a bit left on the last line."
+ update
+ .t configure -yscrollcommand scrollError
+ proc bgerror args {
+ global x errorInfo errorCode
+ set x [list $args $errorInfo $errorCode]
+ }
+ .t delete 1.0 end
+ update
+ rename bgerror {}
+ .t configure -yscrollcommand scroll
+ set x
+} {{{scrolling error}} {scrolling error
+ while executing
+"error "scrolling error""
+ (procedure "scrollError" line 2)
+ invoked from within
+"scrollError 0 1"
+ (vertical scrolling command executed by text)} NONE}
+
+.t delete 1.0 end
+.t insert end "Line 1"
+for {set i 2} {$i <= 200} {incr i} {
+ .t insert end "\nLine $i"
+}
+.t configure -wrap word
+.t delete 50.0 51.0
+.t insert 50.0 "This is a long line, one that will wrap around twice.\n"
+test textDisp-20.1 {FindDLine} {fonts} {
+ .t yview 48.0
+ list [.t dlineinfo 46.0] [.t dlineinfo 47.0] [.t dlineinfo 49.0] \
+ [.t dlineinfo 58.0]
+} {{} {} {3 16 49 13 10} {}}
+test textDisp-20.2 {FindDLine} {fonts} {
+ .t yview 100.0
+ .t yview -pickplace 53.0
+ list [.t dlineinfo 50.0] [.t dlineinfo 50.14] [.t dlineinfo 50.15]
+} {{} {} {3 3 140 13 10}}
+test textDisp-20.3 {FindDLine} {fonts} {
+ .t yview 100.0
+ .t yview 49.0
+ list [.t dlineinfo 50.0] [.t dlineinfo 50.20] [.t dlineinfo 57.0]
+} {{3 16 105 13 10} {3 29 140 13 10} {}}
+test textDisp-20.4 {FindDLine} {fonts} {
+ .t yview 100.0
+ .t yview 42.0
+ list [.t dlineinfo 50.0] [.t dlineinfo 50.20] [.t dlineinfo 50.40]
+} {{3 107 105 13 10} {3 120 140 13 10} {}}
+.t config -wrap none
+test textDisp-20.5 {FindDLine} {fonts} {
+ .t yview 100.0
+ .t yview 48.0
+ list [.t dlineinfo 50.0] [.t dlineinfo 50.20] [.t dlineinfo 50.40]
+} {{3 29 371 13 10} {3 29 371 13 10} {3 29 371 13 10}}
+
+.t config -wrap word
+test textDisp-21.1 {TkTextPixelIndex} {fonts} {
+ .t yview 48.0
+ list [.t index @-10,-10] [.t index @6,6] [.t index @22,6] \
+ [.t index @102,6] [.t index @38,55] [.t index @44,67]
+} {48.0 48.0 48.2 48.7 50.40 50.40}
+.t insert end \n
+test textDisp-21.2 {TkTextPixelIndex} {fonts} {
+ .t yview 195.0
+ list [.t index @11,70] [.t index @11,84] [.t index @11,102] \
+ [.t index @11,1002]
+} {197.1 198.1 199.1 201.0}
+test textDisp-21.3 {TkTextPixelIndex, horizontal scrolling} {fonts} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert end "12345\n"
+ .t insert end "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ .t xview scroll 2 units
+ list [.t index @-5,7] [.t index @5,7] [.t index @33,20]
+} {1.2 1.2 2.6}
+
+.t delete 1.0 end
+.t insert end "Line 1"
+for {set i 2} {$i <= 200} {incr i} {
+ .t insert end "\nLine $i"
+}
+.t configure -wrap word
+.t delete 50.0 51.0
+.t insert 50.0 "This is a long line, one that will wrap around twice.\n"
+update
+.t tag add x 50.1
+test textDisp-22.1 {TkTextCharBbox} {fonts} {
+ .t config -wrap word
+ .t yview 48.0
+ list [.t bbox 47.2] [.t bbox 48.0] [.t bbox 50.5] [.t bbox 50.40] \
+ [.t bbox 58.0]
+} {{} {3 3 7 13} {38 29 7 13} {38 55 7 13} {}}
+test textDisp-22.2 {TkTextCharBbox} {fonts} {
+ .t config -wrap none
+ .t yview 48.0
+ list [.t bbox 50.5] [.t bbox 50.40] [.t bbox 57.0]
+} {{38 29 7 13} {} {3 120 7 13}}
+test textDisp-22.3 {TkTextCharBbox, cut-off lines} {fonts} {
+ .t config -wrap char
+ .t yview 10.0
+ wm geom . ${width}x[expr $height-1]
+ update
+ list [.t bbox 19.1] [.t bbox 20.1]
+} {{10 120 7 13} {10 133 7 3}}
+test textDisp-22.4 {TkTextCharBbox, cut-off lines} {fonts} {
+ .t config -wrap char
+ .t yview 10.0
+ wm geom . ${width}x[expr $height+1]
+ update
+ list [.t bbox 19.1] [.t bbox 20.1]
+} {{10 120 7 13} {10 133 7 5}}
+test textDisp-22.5 {TkTextCharBbox, cut-off char} {fonts} {
+ .t config -wrap none
+ .t yview 10.0
+ wm geom . [expr $width-95]x$height
+ update
+ .t bbox 15.6
+} {45 68 7 13}
+test textDisp-22.6 {TkTextCharBbox, line visible but not char} {fonts} {
+ .t config -wrap char
+ .t yview 10.0
+ .t tag add big 20.2 20.5
+ wm geom . ${width}x[expr $height+3]
+ update
+ list [.t bbox 19.1] [.t bbox 20.1] [.t bbox 20.2]
+} {{10 120 7 13} {} {17 133 14 7}}
+wm geom . {}
+update
+test textDisp-22.7 {TkTextCharBbox, different character sizes} {fonts} {
+ .t config -wrap char
+ .t yview 10.0
+ .t tag add big 12.2 12.5
+ update
+ list [.t bbox 12.1] [.t bbox 12.2]
+} {{10 41 7 13} {17 29 14 27}}
+.t tag remove big 1.0 end
+test textDisp-22.8 {TkTextCharBbox, horizontal scrolling} {fonts} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert end "12345\n"
+ .t insert end "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
+ .t xview scroll 4 units
+ list [.t bbox 1.3] [.t bbox 1.4] [.t bbox 2.3] [.t bbox 2.4] \
+ [.t bbox 2.23] [.t bbox 2.24]
+} {{} {3 3 7 13} {} {3 16 7 13} {136 16 7 13} {}}
+test textDisp-22.9 {TkTextCharBbox, handling of spacing} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "abcdefghijkl\nmnopqrstuvwzyz"
+ .t tag configure spacing -spacing1 8 -spacing3 2
+ .t tag add spacing 1.0 end
+ frame .t.f1 -width 10 -height 4 -bg black
+ frame .t.f2 -width 10 -height 4 -bg black
+ frame .t.f3 -width 10 -height 4 -bg black
+ frame .t.f4 -width 10 -height 4 -bg black
+ .t window create 1.3 -window .t.f1 -align top
+ .t window create 1.7 -window .t.f2 -align center
+ .t window create 2.1 -window .t.f3 -align bottom
+ .t window create 2.10 -window .t.f4 -align baseline
+ update
+ list [.t bbox .t.f1] [.t bbox .t.f2] [.t bbox .t.f3] [.t bbox .t.f4] \
+ [.t bbox 1.1] [.t bbox 2.9]
+} {{24 11 10 4} {55 15 10 4} {10 43 10 4} {76 40 10 4} {10 11 7 13} {69 34 7 13}}
+.t tag delete spacing
+
+.t delete 1.0 end
+.t insert end "Line 1"
+for {set i 2} {$i <= 200} {incr i} {
+ .t insert end "\nLine $i"
+}
+.t configure -wrap word
+.t delete 50.0 51.0
+.t insert 50.0 "This is a long line, one that will wrap around twice.\n"
+update
+test textDisp-23.1 {TkTextDLineInfo} {fonts} {
+ .t config -wrap word
+ .t yview 48.0
+ list [.t dlineinfo 47.3] [.t dlineinfo 48.0] [.t dlineinfo 50.40] \
+ [.t dlineinfo 56.0]
+} {{} {3 3 49 13 10} {3 55 126 13 10} {}}
+test textDisp-23.2 {TkTextDLineInfo} {fonts} {
+ .t config -bd 4 -wrap word
+ update
+ .t yview 48.0
+ .t dlineinfo 50.40
+} {7 59 126 13 10}
+.t config -bd 0
+test textDisp-23.3 {TkTextDLineInfo} {fonts} {
+ .t config -wrap none
+ update
+ .t yview 48.0
+ list [.t dlineinfo 50.40] [.t dlineinfo 57.3]
+} {{3 29 371 13 10} {3 120 49 13 10}}
+test textDisp-23.4 {TkTextDLineInfo, cut-off lines} {fonts} {
+ .t config -wrap char
+ .t yview 10.0
+ wm geom . ${width}x[expr $height-1]
+ update
+ list [.t dlineinfo 19.0] [.t dlineinfo 20.0]
+} {{3 120 49 13 10} {3 133 49 3 10}}
+test textDisp-23.5 {TkTextDLineInfo, cut-off lines} {fonts} {
+ .t config -wrap char
+ .t yview 10.0
+ wm geom . ${width}x[expr $height+1]
+ update
+ list [.t dlineinfo 19.0] [.t dlineinfo 20.0]
+} {{3 120 49 13 10} {3 133 49 5 10}}
+wm geom . {}
+update
+test textDisp-23.6 {TkTextDLineInfo, horizontal scrolling} {fonts} {
+ .t config -wrap none
+ .t delete 1.0 end
+ .t insert end "First line\n"
+ .t insert end "Second line is a very long one that doesn't all fit.\n"
+ .t insert end "Third"
+ .t xview scroll 6 units
+ update
+ list [.t dlineinfo 1.0] [.t dlineinfo 2.0] [.t dlineinfo 3.0]
+} {{-39 3 70 13 10} {-39 16 364 13 10} {-39 29 35 13 10}}
+.t xview moveto 0
+test textDisp-23.7 {TkTextDLineInfo, centering} {fonts} {
+ .t config -wrap word
+ .t delete 1.0 end
+ .t insert end "First line\n"
+ .t insert end "Second line is a very long one that doesn't all fit.\n"
+ .t insert end "Third"
+ .t tag configure x -justify center
+ .t tag configure y -justify right
+ .t tag add x 1.0
+ .t tag add y 3.0
+ list [.t dlineinfo 1.0] [.t dlineinfo 2.0] [.t dlineinfo 3.0]
+} {{38 3 70 13 10} {3 16 119 13 10} {108 55 35 13 10}}
+.t tag delete x y
+
+test textDisp-24.1 {TkTextCharLayoutProc} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "abcdefghijklmnopqrstuvwxyz"
+ list [.t bbox 1.19] [.t bbox 1.20]
+} {{136 3 7 13} {3 16 7 13}}
+test textDisp-24.2 {TkTextCharLayoutProc} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "abcdefghijklmnopqrstuvwxyz"
+ wm geom . [expr $width+1]x$height
+ update
+ list [.t bbox 1.19] [.t bbox 1.20]
+} {{136 3 12 13} {3 16 7 13}}
+test textDisp-24.3 {TkTextCharLayoutProc} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "abcdefghijklmnopqrstuvwxyz"
+ wm geom . [expr $width-1]x$height
+ update
+ list [.t bbox 1.19] [.t bbox 1.20]
+} {{136 3 10 13} {3 16 7 13}}
+test textDisp-24.4 {TkTextCharLayoutProc, newline not visible} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 01234567890123456789\n012345678901234567890
+ wm geom . {}
+ update
+ list [.t bbox 1.19] [.t bbox 1.20] [.t bbox 2.20]
+} {{136 3 7 13} {143 3 0 13} {3 29 7 13}}
+test textDisp-24.5 {TkTextCharLayoutProc, char doesn't fit, newline not visible} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 0\n1\n
+ wm geom . 110x$height
+ update
+ list [.t bbox 1.0] [.t bbox 1.1] [.t bbox 2.0]
+} {{3 3 4 13} {7 3 0 13} {3 16 4 13}}
+test textDisp-24.6 {TkTextCharLayoutProc, line ends with space} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "a b c d e f g h i j k l m n o p"
+ wm geom . {}
+ update
+ list [.t bbox 1.19] [.t bbox 1.20]
+} {{136 3 7 13} {3 16 7 13}}
+test textDisp-24.7 {TkTextCharLayoutProc, line ends with space} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "a b c d e f g h i j k l m n o p"
+ wm geom . [expr $width+1]x$height
+ update
+ list [.t bbox 1.19] [.t bbox 1.20]
+} {{136 3 12 13} {3 16 7 13}}
+test textDisp-24.8 {TkTextCharLayoutProc, line ends with space} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "a b c d e f g h i j k l m n o p"
+ wm geom . [expr $width-1]x$height
+ update
+ list [.t bbox 1.19] [.t bbox 1.20]
+} {{136 3 10 13} {3 16 7 13}}
+test textDisp-24.9 {TkTextCharLayoutProc, line ends with space} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "a b c d e f g h i j k l m n o p"
+ wm geom . [expr $width-6]x$height
+ update
+ list [.t bbox 1.19] [.t bbox 1.20]
+} {{136 3 5 13} {3 16 7 13}}
+test textDisp-24.10 {TkTextCharLayoutProc, line ends with space} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "a b c d e f g h i j k l m n o p"
+ wm geom . [expr $width-7]x$height
+ update
+ list [.t bbox 1.19] [.t bbox 1.20]
+} {{136 3 4 13} {3 16 7 13}}
+test textDisp-24.11 {TkTextCharLayoutProc, line ends with space that doesn't quite fit} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "01234567890123456789 \nabcdefg"
+ wm geom . [expr $width-2]x$height
+ update
+ set result {}
+ lappend result [.t bbox 1.21] [.t bbox 2.0]
+ .t mark set insert 1.21
+ lappend result [.t bbox 1.21] [.t bbox 2.0]
+} {{145 3 0 13} {3 16 7 13} {145 3 0 13} {3 16 7 13}}
+test textDisp-24.12 {TkTextCharLayoutProc, tab causes wrap} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "abcdefghi"
+ .t mark set insert 1.4
+ .t insert insert \t\t\t
+ list [.t bbox {insert -1c}] [.t bbox insert]
+} {{115 3 30 13} {3 16 7 13}}
+test textDisp-24.13 {TkTextCharLayoutProc, -wrap none} {fonts} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert 1.0 "abcdefghijklmnopqrstuvwxyz"
+ wm geom . {}
+ update
+ list [.t bbox 1.19] [.t bbox 1.20]
+} {{136 3 7 13} {}}
+test textDisp-24.14 {TkTextCharLayoutProc, -wrap none} {fonts} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert 1.0 "abcdefghijklmnopqrstuvwxyz"
+ wm geom . [expr $width+1]x$height
+ update
+ list [.t bbox 1.19] [.t bbox 1.20]
+} {{136 3 7 13} {143 3 5 13}}
+test textDisp-24.15 {TkTextCharLayoutProc, -wrap none} {fonts} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert 1.0 "abcdefghijklmnopqrstuvwxyz"
+ wm geom . [expr $width-1]x$height
+ update
+ list [.t bbox 1.19] [.t bbox 1.20]
+} {{136 3 7 13} {143 3 3 13}}
+test textDisp-24.16 {TkTextCharLayoutProc, no chars fit} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "abcdefghijklmnopqrstuvwxyz"
+ wm geom . 103x$height
+ update
+ list [.t bbox 1.0] [.t bbox 1.1] [.t bbox 1.2]
+} {{3 3 1 13} {3 16 1 13} {3 29 1 13}}
+test textDisp-24.17 {TkTextCharLayoutProc, -wrap word} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "This is a line that wraps around"
+ wm geom . {}
+ update
+ list [.t bbox 1.19] [.t bbox 1.20]
+} {{136 3 7 13} {3 16 7 13}}
+test textDisp-24.18 {TkTextCharLayoutProc, -wrap word} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "xThis is a line that wraps around"
+ wm geom . {}
+ update
+ list [.t bbox 1.14] [.t bbox 1.15] [.t bbox 1.16]
+} {{101 3 7 13} {108 3 35 13} {3 16 7 13}}
+test textDisp-24.19 {TkTextCharLayoutProc, -wrap word} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "xxThis is a line that wraps around"
+ wm geom . {}
+ update
+ list [.t bbox 1.14] [.t bbox 1.15] [.t bbox 1.16]
+} {{101 3 7 13} {108 3 7 13} {115 3 28 13}}
+test textDisp-24.20 {TkTextCharLayoutProc, vertical offset} {fonts} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert 1.0 "Line 1\nLine 2\nLine 3"
+ set result {}
+ lappend result [.t bbox 2.1] [.t dlineinfo 2.1]
+ .t tag configure up -offset 6
+ .t tag add up 2.1
+ lappend result [.t bbox 2.1] [.t dlineinfo 2.1]
+ .t tag configure up -offset -2
+ lappend result [.t bbox 2.1] [.t dlineinfo 2.1]
+ .t tag delete up
+ set result
+} {{10 16 7 13} {3 16 42 13 10} {10 16 7 13} {3 16 42 19 16} {10 18 7 13} {3 16 42 15 10}}
+.t configure -width 30
+update
+test textDisp-24.21 {TkTextCharLayoutProc, word breaks} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ .t insert 1.0 "Sample text xxxxxxx yyyyy zzzzzzz qqqqq rrrr ssss tt u vvvvv"
+ frame .t.f -width 30 -height 20 -bg black
+ .t window create 1.36 -window .t.f
+ .t bbox 1.26
+} {3 19 7 13}
+test textDisp-24.22 {TkTextCharLayoutProc, word breaks} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ frame .t.f -width 30 -height 20 -bg black
+ .t insert 1.0 "Sample text xxxxxxx yyyyyyy"
+ .t window create end -window .t.f
+ .t insert end "zzzzzzz qqqqq rrrr ssss tt u vvvvv"
+ .t bbox 1.28
+} {33 19 7 13}
+test textDisp-24.23 {TkTextCharLayoutProc, word breaks} {fonts} {
+ .t configure -wrap word
+ .t delete 1.0 end
+ frame .t.f -width 30 -height 20 -bg black
+ .t insert 1.0 "Sample text xxxxxxx yyyyyyy "
+ .t insert end "zzzzzzz qqqqq rrrr ssss tt"
+ .t window create end -window .t.f
+ .t insert end "u vvvvv"
+ .t bbox .t.f
+} {3 29 30 20}
+catch {destroy .t.f}
+.t configure -width 20
+update
+test textDisp-24.24 {TkTextCharLayoutProc, justification and tabs} {fonts} {
+ .t delete 1.0 end
+ .t tag configure x -justify center
+ .t insert 1.0 aa\tbb\tcc\tdd\t
+ .t tag add x 1.0 end
+ list [.t bbox 1.0] [.t bbox 1.10]
+} {{45 3 7 13} {94 3 7 13}}
+
+.t configure -width 40 -bd 0 -relief flat -highlightthickness 0 -padx 0 \
+ -tabs 100
+update
+test textDisp-25.1 {CharBboxProc procedure, check tab width} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 abc\td\tfgh
+ list [.t bbox 1.3] [.t bbox 1.5] [.t bbox 1.6]
+} {{21 1 79 13} {107 1 93 13} {200 1 7 13}}
+
+.t configure -width 40 -bd 0 -relief flat -highlightthickness 0 -padx 0 \
+ -tabs {}
+update
+test textDisp-26.1 {AdjustForTab procedure, no tabs} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 a\tbcdefghij\tc\td
+ list [lindex [.t bbox 1.2] 0] [lindex [.t bbox 1.12] 0] \
+ [lindex [.t bbox 1.14] 0]
+} {56 168 224}
+test textDisp-26.2 {AdjustForTab procedure, not enough tabs specified} {
+ .t delete 1.0 end
+ .t insert 1.0 a\tb\tc\td
+ .t tag delete x
+ .t tag configure x -tabs 40
+ .t tag add x 1.0 end
+ list [lindex [.t bbox 1.2] 0] [lindex [.t bbox 1.4] 0] \
+ [lindex [.t bbox 1.6] 0]
+} {40 80 120}
+test textDisp-26.3 {AdjustForTab procedure, not enough tabs specified} {
+ .t delete 1.0 end
+ .t insert 1.0 a\tb\tc\td\te
+ .t tag delete x
+ .t tag configure x -tabs {40 70 right}
+ .t tag add x 1.0 end
+ list [lindex [.t bbox 1.2] 0] \
+ [expr [lindex [.t bbox 1.4] 0] + [lindex [.t bbox 1.4] 2]] \
+ [expr [lindex [.t bbox 1.6] 0] + [lindex [.t bbox 1.6] 2]] \
+ [expr [lindex [.t bbox 1.8] 0] + [lindex [.t bbox 1.8] 2]]
+} {40 70 100 130}
+test textDisp-26.4 {AdjustForTab procedure, different alignments} {
+ .t delete 1.0 end
+ .t insert 1.0 a\tbc\tde\tfg\thi
+ .t tag delete x
+ .t tag configure x -tabs {40 center 80 left 130 right}
+ .t tag add x 1.0 end
+ .t tag add y 1.2
+ .t tag add y 1.5
+ .t tag add y 1.8
+ list [lindex [.t bbox 1.3] 0] [lindex [.t bbox 1.5] 0] \
+ [lindex [.t bbox 1.10] 0]
+} {40 80 130}
+test textDisp-26.5 {AdjustForTab procedure, numeric alignment} {
+ .t delete 1.0 end
+ .t insert 1.0 a\t1.234
+ .t tag delete x
+ .t tag configure x -tabs {120 numeric}
+ .t tag add x 1.0 end
+ .t tag add y 1.2
+ .t tag add y 1.5
+ lindex [.t bbox 1.3] 0
+} {120}
+test textDisp-26.6 {AdjustForTab procedure, numeric alignment} {
+ .t delete 1.0 end
+ .t insert 1.0 a\t1,456.234
+ .t tag delete x
+ .t tag configure x -tabs {120 numeric}
+ .t tag add x 1.0 end
+ .t tag add y 1.2
+ lindex [.t bbox 1.7] 0
+} {120}
+test textDisp-26.7 {AdjustForTab procedure, numeric alignment} {
+ .t delete 1.0 end
+ .t insert 1.0 a\t1.456.234,7
+ .t tag delete x
+ .t tag configure x -tabs {120 numeric}
+ .t tag add x 1.0 end
+ .t tag add y 1.2
+ lindex [.t bbox 1.11] 0
+} {120}
+test textDisp-26.8 {AdjustForTab procedure, numeric alignment} {
+ .t delete 1.0 end
+ .t insert 1.0 a\ttest
+ .t tag delete x
+ .t tag configure x -tabs {120 numeric}
+ .t tag add x 1.0 end
+ .t tag add y 1.2
+ lindex [.t bbox 1.6] 0
+} {120}
+test textDisp-26.9 {AdjustForTab procedure, numeric alignment} {
+ .t delete 1.0 end
+ .t insert 1.0 a\t1234
+ .t tag delete x
+ .t tag configure x -tabs {120 numeric}
+ .t tag add x 1.0 end
+ .t tag add y 1.2
+ lindex [.t bbox 1.6] 0
+} {120}
+test textDisp-26.10 {AdjustForTab procedure, numeric alignment} {
+ .t delete 1.0 end
+ .t insert 1.0 a\t1.234567
+ .t tag delete x
+ .t tag configure x -tabs {120 numeric}
+ .t tag add x 1.0 end
+ .t tag add y 1.5
+ lindex [.t bbox 1.3] 0
+} {120}
+test textDisp-26.11 {AdjustForTab procedure, numeric alignment} {
+ .t delete 1.0 end
+ .t insert 1.0 a\tx=1.234567
+ .t tag delete x
+ .t tag configure x -tabs {120 numeric}
+ .t tag add x 1.0 end
+ .t tag add y 1.7
+ .t tag add y 1.9
+ lindex [.t bbox 1.5] 0
+} {120}
+test textDisp-26.12 {AdjustForTab procedure, adjusting chunks} {
+ .t delete 1.0 end
+ .t insert 1.0 a\tx1.234567
+ .t tag delete x
+ .t tag configure x -tabs {120 numeric}
+ .t tag add x 1.0 end
+ .t tag add y 1.7
+ .t tag add y 1.9
+ button .b -text "="
+ .t window create 1.3 -window .b
+ update
+ lindex [.t bbox 1.5] 0
+} {120}
+test textDisp-26.13 {AdjustForTab procedure, not enough space} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "abc\txyz\tqrs\txyz\t0"
+ .t tag delete x
+ .t tag configure x -tabs {10 30 center 50 right 120}
+ .t tag add x 1.0 end
+ list [lindex [.t bbox 1.4] 0] [lindex [.t bbox 1.8] 0] \
+ [lindex [.t bbox 1.12] 0] [lindex [.t bbox 1.16] 0]
+} {28 56 84 120}
+
+.t configure -width 20 -bd 2 -highlightthickness 2 -relief sunken -tabs {} \
+ -wrap char
+update
+test textDisp-27.1 {SizeOfTab procedure, old-style tabs} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 a\tbcdefghij\tc\td
+ list [.t bbox 1.2] [.t bbox 1.10] [.t bbox 1.12]
+} {{60 5 7 13} {116 5 7 13} {4 18 7 13}}
+test textDisp-27.2 {SizeOfTab procedure, choosing tabX and alignment} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 a\tbcd
+ .t tag delete x
+ .t tag configure x -tabs 120
+ .t tag add x 1.0 end
+ list [.t bbox 1.3] [.t bbox 1.4]
+} {{131 5 13 13} {4 18 7 13}}
+test textDisp-27.3 {SizeOfTab procedure, choosing tabX and alignment} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 a\t\t\tbcd
+ .t tag delete x
+ .t tag configure x -tabs 40
+ .t tag add x 1.0 end
+ list [.t bbox 1.5] [.t bbox 1.6]
+} {{131 5 13 13} {4 18 7 13}}
+test textDisp-27.4 {SizeOfTab procedure, choosing tabX and alignment} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 a\t\t\tbcd
+ .t tag delete x
+ .t tag configure x -tabs {20 center 70 left}
+ .t tag add x 1.0 end
+ list [.t bbox 1.5] [.t bbox 1.6]
+} {{131 5 13 13} {4 18 7 13}}
+test textDisp-27.5 {SizeOfTab procedure, center alignment} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 a\txyzzyabc
+ .t tag delete x
+ .t tag configure x -tabs {120 center}
+ .t tag add x 1.0 end
+ list [.t bbox 1.6] [.t bbox 1.7]
+} {{135 5 9 13} {4 18 7 13}}
+test textDisp-27.6 {SizeOfTab procedure, center alignment} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 a\txyzzyabc
+ .t tag delete x
+ .t tag configure x -tabs {150 center}
+ .t tag add x 1.0 end
+ list [.t bbox 1.6] [.t bbox 1.7]
+} {{32 18 7 13} {39 18 7 13}}
+test textDisp-27.7 {SizeOfTab procedure, center alignment, wrap -none (potential numerical problems)} {fonts} {
+ .t delete 1.0 end
+ .t configure -tabs {1c 2c center 3c 4c} -wrap none -width 40
+ .t insert 1.0 a\tb\tc\td\te\n012345678934567890a\tbb\tcc\tdd
+ update
+ .t bbox 2.24
+} {172 18 7 13}
+.t configure -wrap char -tabs {} -width 20
+update
+test textDisp-27.8 {SizeOfTab procedure, right alignment} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 a\t\txyzzyabc
+ .t tag delete x
+ .t tag configure x -tabs {100 left 140 right}
+ .t tag add x 1.0 end
+ list [.t bbox 1.6] [.t bbox 1.7]
+} {{137 5 7 13} {4 18 7 13}}
+test textDisp-27.9 {SizeOfTab procedure, left alignment} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 a\txyzzyabc
+ .t tag delete x
+ .t tag configure x -tabs {120}
+ .t tag add x 1.0 end
+ list [.t bbox 1.3] [.t bbox 1.4]
+} {{131 5 13 13} {4 18 7 13}}
+test textDisp-27.10 {SizeOfTab procedure, numeric alignment} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 a\t123.4
+ .t tag delete x
+ .t tag configure x -tabs {120 numeric}
+ .t tag add x 1.0 end
+ list [.t bbox 1.3] [.t bbox 1.4]
+} {{117 5 27 13} {4 18 7 13}}
+test textDisp-27.11 {SizeOfTab procedure, making tabs at least as wide as a space} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 abc\tdefghijklmnopqrst
+ .t tag delete x
+ .t tag configure x -tabs {120}
+ .t tag add x 1.0 end
+ list [.t bbox 1.5] [.t bbox 1.6]
+} {{131 5 13 13} {4 18 7 13}}
+
+proc bizarre_scroll args {
+ .t2.t delete 5.0 end
+}
+test textDisp-28.1 {"yview" option with bizarre scroll command} {
+ catch {destroy .t2}
+ toplevel .t2
+ text .t2.t -width 40 -height 4
+ .t2.t insert end "1\n2\n3\n4\n5\n6\n7\n8\n"
+ pack .t2.t
+ wm geometry .t2 +0+0
+ update
+ .t2.t configure -yscrollcommand bizarre_scroll
+ .t2.t yview 100.0
+ set result [.t2.t index @0,0]
+ update
+ lappend result [.t2.t index @0,0]
+} {6.0 1.0}
+
+test textDisp-29.1 {miscellaneous: lines wrap but are still too long} {fonts} {
+ catch {destroy .t2}
+ toplevel .t2
+ wm geometry .t2 +0+0
+ text .t2.t -width 20 -height 10 -font $fixedFont \
+ -wrap char -xscrollcommand ".t2.s set"
+ pack .t2.t -side top
+ scrollbar .t2.s -orient horizontal -command ".t2.t xview"
+ pack .t2.s -side bottom -fill x
+ .t2.t insert end 123
+ frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised
+ .t2.t window create 1.1 -window .t2.t.f
+ update
+ list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3]
+} {{0 0.466667} 300x50+5+18 {12 68 7 13}}
+test textDisp-29.2 {miscellaneous: lines wrap but are still too long} {fonts} {
+ catch {destroy .t2}
+ toplevel .t2
+ wm geometry .t2 +0+0
+ text .t2.t -width 20 -height 10 -font $fixedFont \
+ -wrap char -xscrollcommand ".t2.s set"
+ pack .t2.t -side top
+ scrollbar .t2.s -orient horizontal -command ".t2.t xview"
+ pack .t2.s -side bottom -fill x
+ .t2.t insert end 123
+ frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised
+ .t2.t window create 1.1 -window .t2.t.f
+ .t2.t xview scroll 1 unit
+ update
+ list [.t2.t xview] [winfo geom .t2.t.f] [.t2.t bbox 1.3]
+} {{0.0233333 0.49} 300x50+-2+18 {5 68 7 13}}
+test textDisp-29.3 {miscellaneous: lines wrap but are still too long} {fonts} {
+ catch {destroy .t2}
+ toplevel .t2
+ wm geometry .t2 +0+0
+ text .t2.t -width 20 -height 10 -font $fixedFont \
+ -wrap char -xscrollcommand ".t2.s set"
+ pack .t2.t -side top
+ scrollbar .t2.s -orient horizontal -command ".t2.t xview"
+ pack .t2.s -side bottom -fill x
+ .t2.t insert end 123
+ frame .t2.t.f -width 300 -height 50 -bd 2 -relief raised
+ .t2.t window create 1.1 -window .t2.t.f
+ update
+ .t2.t xview scroll 200 units
+ update
+ 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
diff --git a/tk/tests/textImage.test b/tk/tests/textImage.test
new file mode 100644
index 00000000000..4734711a55c
--- /dev/null
+++ b/tk/tests/textImage.test
@@ -0,0 +1,353 @@
+# RCS: @(#) $Id$
+
+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.
+
+# One time setup. Create a font to insure the tests are font metric invariant.
+
+wm geometry . {}
+catch {destroy .t}
+font create test_font -family courier -size 14
+text .t -font test_font
+destroy .t
+
+test textImage-1.1 {basic argument checking} {
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ list [catch {.t image} msg] $msg
+} {1 {wrong # args: should be ".t image option ?arg arg ...?"}}
+
+test textImage-1.2 {basic argument checking} {
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ list [catch {.t image c} msg] $msg
+} {1 {bad image option "c": must be cget, configure, create, or names}}
+
+test textImage-1.3 {cget argument checking} {
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ list [catch {.t image cget} msg] $msg
+} {1 {wrong # args: should be ".t image cget index option"}}
+
+test textImage-1.4 {cget argument checking} {
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ list [catch {.t image cget blurf -flurp} msg] $msg
+} {1 {bad text index "blurf"}}
+
+test textImage-1.5 {cget argument checking} {
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ list [catch {.t image cget 1.1 -flurp} msg] $msg
+} {1 {no embedded image at index "1.1"}}
+
+test textImage-1.6 {configure argument checking} {
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ list [catch {.t image configure } msg] $msg
+} {1 {wrong # args: should be ".t image configure index ?option value ...?"}}
+
+test textImage-1.7 {configure argument checking} {
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ list [catch {.t image configure blurf } msg] $msg
+} {1 {bad text index "blurf"}}
+
+test textImage-1.8 {configure argument checking} {
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ list [catch {.t image configure 1.1 } msg] $msg
+} {1 {no embedded image at index "1.1"}}
+
+test textImage-1.9 {create argument checking} {
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ list [catch {.t image create} msg] $msg
+} {1 {wrong # args: should be ".t image create index ?option value ...?"}}
+
+test textImage-1.10 {create argument checking} {
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ list [catch {.t image create blurf } msg] $msg
+} {1 {bad text index "blurf"}}
+
+test textImage-1.11 {basic argument checking} {
+ catch {
+ image create photo small -width 5 -height 5
+ small put red -to 0 0 4 4
+ }
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ list [catch {.t image create 1000.1000 -image small} msg] $msg
+} {0 small}
+
+test textImage-1.12 {names argument checking} {
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ list [catch {.t image names dates places} msg] $msg
+} {1 {wrong # args: should be ".t image names"}}
+
+
+test textImage-1.13 {names argument checking} {
+ catch {
+ image create photo small -width 5 -height 5
+ small put red -to 0 0 4 4
+ }
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ set result ""
+ lappend result [.t image names]
+ .t image create insert -image small
+ lappend result [.t image names]
+ .t image create insert -image small
+ lappend result [.t image names]
+ .t image create insert -image small -name little
+ lappend result [.t image names]
+} {{} small {small#1 small} {small#1 small little}}
+
+test textImage-1.14 {basic argument checking} {
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ list [catch {.t image huh} msg] $msg
+} {1 {bad image option "huh": must be cget, configure, create, or names}}
+
+test textImage-1.15 {align argument checking} {
+ catch {
+ image create photo small -width 5 -height 5
+ small put red -to 0 0 4 4
+ }
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ list [catch {.t image create end -image small -align wrong} msg] $msg
+} {1 {bad alignment "wrong": must be baseline, bottom, center, or top}}
+
+test textImage-1.16 {configure} {
+ catch {
+ image create photo small -width 5 -height 5
+ small put red -to 0 0 4 4
+ }
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ .t image create end -image small
+ .t image configure small
+} {{-align {} {} center center} {-padx {} {} 0 0} {-pady {} {} 0 0} {-image {} {} {} small} {-name {} {} {} {}}}
+
+test textImage-1.17 {basic cget options} {
+ catch {
+ image create photo small -width 5 -height 5
+ small put red -to 0 0 4 4
+ }
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ .t image create end -image small
+ set result ""
+ foreach i {align padx pady image name} {
+ lappend result $i:[.t image cget small -$i]
+ }
+ set result
+} {align:center padx:0 pady:0 image:small name:}
+
+test textImage-1.18 {basic configure options} {
+ catch {
+ image create photo small -width 5 -height 5
+ small put red -to 0 0 4 4
+ image create photo large -width 50 -height 50
+ large put green -to 0 0 50 50
+ }
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ .t image create end -image small
+ set result ""
+ foreach {option value} {align top padx 5 pady 7 image large name none} {
+ .t image configure small -$option $value
+ }
+ update
+ .t image configure small
+} {{-align {} {} center top} {-padx {} {} 0 5} {-pady {} {} 0 7} {-image {} {} {} large} {-name {} {} {} none}}
+
+test textImage-1.19 {basic image naming} {
+ catch {
+ image create photo small -width 5 -height 5
+ small put red -to 0 0 4 4
+ }
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ .t image create end -image small
+ .t image create end -image small -name small
+ .t image create end -image small -name small#6342
+ .t image create end -image small -name small
+ lsort [.t image names]
+} {small small#1 small#6342 small#6343}
+
+test textImage-2.1 {debug} {
+ catch {
+ image create photo small -width 5 -height 5
+ small put red -to 0 0 4 4
+ }
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ .t debug 1
+ .t insert end front
+ .t image create end -image small
+ .t insert end back
+ .t delete small
+ .t image names
+ .t debug 0
+} {}
+
+test textImage-3.1 {image change propagation} {
+ catch {
+ image create photo vary -width 5 -height 5
+ small put red -to 0 0 4 4
+ }
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ .t image create end -image vary -align top
+ update
+ set result ""
+ lappend result base:[.t bbox vary]
+ foreach i {10 20 40} {
+ vary configure -width $i -height $i
+ update
+ lappend result $i:[.t bbox vary]
+ }
+ set result
+} {{base:0 0 5 5} {10:0 0 10 10} {20:0 0 20 20} {40:0 0 40 40}}
+
+test textImage-3.2 {delayed image management} {
+ catch {
+ image create photo small -width 5 -height 5
+ small put red -to 0 0 4 4
+ }
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ .t image create end -name test
+ update
+ set result ""
+ lappend result [.t bbox test]
+ .t image configure test -image small -align top
+ update
+ lappend result [.t bbox test]
+} {{} {0 0 5 5}}
+
+# some temporary random tests
+
+test textImage-4.1 {alignment checking - except baseline} {
+ catch {
+ image create photo small -width 5 -height 5
+ small put red -to 0 0 4 4
+ image create photo large -width 50 -height 50
+ large put green -to 0 0 50 50
+ }
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ .t image create end -image large
+ .t image create end -image small
+ .t insert end test
+ update
+ set result ""
+ lappend result default:[.t bbox small]
+ foreach i {top bottom center} {
+ .t image configure small -align $i
+ update
+ lappend result [.t image cget small -align]:[.t bbox small]
+ }
+ set result
+} {{default:50 22 5 5} {top:50 0 5 5} {bottom:50 45 5 5} {center:50 22 5 5}}
+
+test textImage-4.2 {alignment checking - baseline} {
+ catch {
+ image create photo small -width 5 -height 5
+ small put red -to 0 0 4 4
+ image create photo large -width 50 -height 50
+ large put green -to 0 0 50 50
+ }
+ catch {destroy .t}
+ font create test_font2 -size 5
+ text .t -font test_font2 -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ .t image create end -image large
+ .t image create end -image small -align baseline
+ .t insert end test
+ set result ""
+ foreach size {10 15 20 30} {
+ font configure test_font2 -size $size
+ array set Metrics [font metrics test_font2]
+ update
+ foreach {x y w h} [.t bbox small] {}
+ set norm [expr {
+ (([image height large] - $Metrics(-linespace))/2
+ + $Metrics(-ascent) - [image height small] - $y)
+ }]
+ lappend result "$size $norm"
+ }
+ font delete test_font2
+ unset Metrics
+ set result
+} {{10 0} {15 0} {20 0} {30 0}}
+
+test textImage-4.3 {alignment and padding checking} {fonts} {
+ catch {
+ image create photo small -width 5 -height 5
+ small put red -to 0 0 4 4
+ image create photo large -width 50 -height 50
+ large put green -to 0 0 50 50
+ }
+ catch {destroy .t}
+ text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0
+ pack .t
+ .t image create end -image large
+ .t image create end -image small -padx 5 -pady 10
+ .t insert end test
+ update
+ set result ""
+ lappend result default:[.t bbox small]
+ foreach i {top bottom center baseline} {
+ .t image configure small -align $i
+ update
+ lappend result $i:[.t bbox small]
+ }
+ 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
diff --git a/tk/tests/textIndex.test b/tk/tests/textIndex.test
new file mode 100644
index 00000000000..dce76a1b50d
--- /dev/null
+++ b/tk/tests/textIndex.test
@@ -0,0 +1,349 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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"
+.t mark set $weirdMark 4.0
+.t tag config y -relief raised
+test textIndex-3.1 {TkTextGetIndex, weird mark names} {
+ list [catch {.t index $weirdMark} msg] $msg
+} {0 4.0}
+
+test textIndex-4.1 {TkTextGetIndex, tags} {
+ list [catch {.t index x.first} msg] $msg
+} {0 2.8}
+test textIndex-4.2 {TkTextGetIndex, tags} {
+ list [catch {.t index x.last} msg] $msg
+} {0 6.2}
+test textIndex-4.3 {TkTextGetIndex, weird tags} {
+ list [.t index $weirdTag.first+1c] [.t index $weirdTag.last+2c]
+} {2.2 2.8}
+test textIndex-4.4 {TkTextGetIndex, tags} {
+ list [catch {.t index x.gorp} msg] $msg
+} {1 {bad text index "x.gorp"}}
+test textIndex-4.5 {TkTextGetIndex, tags} {
+ list [catch {.t index foo.last} msg] $msg
+} {1 {bad text index "foo.last"}}
+test textIndex-4.6 {TkTextGetIndex, tags} {
+ list [catch {.t index y.first} msg] $msg
+} {1 {text doesn't contain any characters tagged with "y"}}
+test textIndex-4.7 {TkTextGetIndex, tags} {
+ list [catch {.t index x.last,} msg] $msg
+} {1 {bad text index "x.last,"}}
+test textIndex-4.8 {TkTextGetIndex, tags} {
+ .t tag add z 1.0
+ set result [list [.t index z.first] [.t index z.last]]
+ .t tag delete z
+ set result
+} {1.0 1.1}
+
+test textIndex-5.1 {TkTextGetIndex, "@"} {fonts} {
+ .t index @12,9
+} 1.1
+test textIndex-5.2 {TkTextGetIndex, "@"} {fonts} {
+ .t index @-2,7
+} 1.0
+test textIndex-5.3 {TkTextGetIndex, "@"} {fonts} {
+ .t index @10,-7
+} 1.0
+test textIndex-5.4 {TkTextGetIndex, "@"} {fonts} {
+ list [catch {.t index @x} msg] $msg
+} {1 {bad text index "@x"}}
+test textIndex-5.5 {TkTextGetIndex, "@"} {fonts} {
+ list [catch {.t index @10q} msg] $msg
+} {1 {bad text index "@10q"}}
+test textIndex-5.6 {TkTextGetIndex, "@"} {fonts} {
+ list [catch {.t index @10,} msg] $msg
+} {1 {bad text index "@10,"}}
+test textIndex-5.7 {TkTextGetIndex, "@"} {fonts} {
+ list [catch {.t index @10,a} msg] $msg
+} {1 {bad text index "@10,a"}}
+test textIndex-5.8 {TkTextGetIndex, "@"} {fonts} {
+ list [catch {.t index @10,9,} msg] $msg
+} {1 {bad text index "@10,9,"}}
+
+test textIndex-6.1 {TkTextGetIndex, numeric} {
+ list [catch {.t index 2.3} msg] $msg
+} {0 2.3}
+test textIndex-6.2 {TkTextGetIndex, numeric} {
+ list [catch {.t index -} msg] $msg
+} {1 {bad text index "-"}}
+test textIndex-6.3 {TkTextGetIndex, numeric} {
+ list [catch {.t index 2.end} msg] $msg
+} {0 2.13}
+test textIndex-6.4 {TkTextGetIndex, numeric} {
+ list [catch {.t index 2.x} msg] $msg
+} {1 {bad text index "2.x"}}
+test textIndex-6.5 {TkTextGetIndex, numeric} {
+ list [catch {.t index 2.3x} msg] $msg
+} {1 {bad text index "2.3x"}}
+
+test textIndex-7.1 {TkTextGetIndex, miscellaneous other bases} {
+ list [catch {.t index end} msg] $msg
+} {0 8.0}
+test textIndex-7.2 {TkTextGetIndex, miscellaneous other bases} {
+ list [catch {.t index foo} msg] $msg
+} {0 3.2}
+test textIndex-7.3 {TkTextGetIndex, miscellaneous other bases} {
+ list [catch {.t index foo+1c} msg] $msg
+} {0 3.3}
+
+test textIndex-8.1 {TkTextGetIndex, modifiers} {
+ list [catch {.t index 2.1+1char} msg] $msg
+} {0 2.2}
+test textIndex-8.2 {TkTextGetIndex, modifiers} {
+ list [catch {.t index "2.1 +1char"} msg] $msg
+} {0 2.2}
+test textIndex-8.3 {TkTextGetIndex, modifiers} {
+ list [catch {.t index 2.1-1char} msg] $msg
+} {0 2.0}
+test textIndex-8.4 {TkTextGetIndex, modifiers} {
+ list [catch {.t index {2.1 }} msg] $msg
+} {0 2.1}
+test textIndex-8.5 {TkTextGetIndex, modifiers} {
+ list [catch {.t index {2.1+foo bar}} msg] $msg
+} {1 {bad text index "2.1+foo bar"}}
+test textIndex-8.6 {TkTextGetIndex, modifiers} {
+ list [catch {.t index {2.1 foo bar}} msg] $msg
+} {1 {bad text index "2.1 foo bar"}}
+
+test textIndex-9.1 {TkTextIndexCmp} {
+ list [.t compare 3.1 < 3.2] [.t compare 3.1 == 3.2]
+} {1 0}
+test textIndex-9.2 {TkTextIndexCmp} {
+ list [.t compare 3.2 < 3.2] [.t compare 3.2 == 3.2]
+} {0 1}
+test textIndex-9.3 {TkTextIndexCmp} {
+ list [.t compare 3.3 < 3.2] [.t compare 3.3 == 3.2]
+} {0 0}
+test textIndex-9.4 {TkTextIndexCmp} {
+ list [.t compare 2.1 < 3.2] [.t compare 2.1 == 3.2]
+} {1 0}
+test textIndex-9.5 {TkTextIndexCmp} {
+ list [.t compare 4.1 < 3.2] [.t compare 4.1 == 3.2]
+} {0 0}
+
+test textIndex-10.1 {ForwBack} {
+ list [catch {.t index {2.3 + x}} msg] $msg
+} {1 {bad text index "2.3 + x"}}
+test textIndex-10.2 {ForwBack} {
+ list [catch {.t index {2.3 + 2 chars}} msg] $msg
+} {0 2.5}
+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
diff --git a/tk/tests/textMark.test b/tk/tests/textMark.test
new file mode 100644
index 00000000000..9680a98c5c7
--- /dev/null
+++ b/tk/tests/textMark.test
@@ -0,0 +1,222 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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 .
+
+entry .t.e
+.t insert 1.0 "Line 1
+abcdefghijklm
+12345
+Line 4
+bOy GIrl .#@? x_yz
+!@#$%
+Line 7"
+
+test textMark-1.1 {TkTextMarkCmd - missing option} {
+ list [catch {.t mark} msg] $msg
+} {1 {wrong # args: should be ".t mark option ?arg arg ...?"}}
+test textMark-1.2 {TkTextMarkCmd - bogus option} {
+ list [catch {.t mark gorp} msg] $msg
+} {1 {bad mark option "gorp": must be gravity, names, next, previous, set, or unset}}
+test textMark-1.3 {TkTextMarkCmd - "gravity" option} {
+ list [catch {.t mark gravity foo} msg] $msg
+} {1 {there is no mark named "foo"}}
+test textMark-1.4 {TkTextMarkCmd - "gravity" option} {
+ .t mark unset x
+ .t mark set x 1.3
+ .t insert 1.3 x
+ list [.t mark gravity x] [.t index x]
+} {right 1.4}
+test textMark-1.5 {TkTextMarkCmd - "gravity" option} {
+ .t mark unset x
+ .t mark set x 1.3
+ .t mark g x left
+ .t insert 1.3 x
+ list [.t mark gravity x] [.t index x]
+} {left 1.3}
+test textMark-1.6 {TkTextMarkCmd - "gravity" option} {
+ .t mark unset x
+ .t mark set x 1.3
+ .t mark gravity x right
+ .t insert 1.3 x
+ list [.t mark gravity x] [.t index x]
+} {right 1.4}
+test textMark-1.7 {TkTextMarkCmd - "gravity" option} {
+ list [catch {.t mark gravity x gorp} msg] $msg
+} {1 {bad mark gravity "gorp": must be left or right}}
+test textMark-1.8 {TkTextMarkCmd - "gravity" option} {
+ list [catch {.t mark gravity} msg] $msg
+} {1 {wrong # args: should be ".t mark gravity markName ?gravity?"}}
+
+test textMark-2.1 {TkTextMarkCmd - "names" option} {
+ list [catch {.t mark names 2} msg] $msg
+} {1 {wrong # args: should be ".t mark names"}}
+.t mark unset x
+test textMark-2.2 {TkTextMarkCmd - "names" option} {
+ lsort [.t mark n]
+} {current insert}
+test textMark-2.3 {TkTextMarkCmd - "names" option} {
+ .t mark set a 1.1
+ .t mark set "b c" 2.3
+ lsort [.t mark names]
+} {a {b c} current insert}
+
+test textMark-3.1 {TkTextMarkCmd - "set" option} {
+ list [catch {.t mark set a} msg] $msg
+} {1 {wrong # args: should be ".t mark set markName index"}}
+test textMark-3.2 {TkTextMarkCmd - "set" option} {
+ list [catch {.t mark s a b c} msg] $msg
+} {1 {wrong # args: should be ".t mark set markName index"}}
+test textMark-3.3 {TkTextMarkCmd - "set" option} {
+ list [catch {.t mark set a @x} msg] $msg
+} {1 {bad text index "@x"}}
+test textMark-3.4 {TkTextMarkCmd - "set" option} {
+ .t mark set a 1.2
+ .t index a
+} 1.2
+test textMark-3.5 {TkTextMarkCmd - "set" option} {
+ .t mark set a end
+ .t index a
+} {8.0}
+
+test textMark-4.1 {TkTextMarkCmd - "unset" option} {
+ list [catch {.t mark unset} msg] $msg
+} {0 {}}
+test textMark-4.2 {TkTextMarkCmd - "unset" option} {
+ .t mark set a 1.2
+ .t mark set b 2.3
+ .t mark unset a b
+ list [catch {.t index a} msg] $msg [catch {.t index b} msg2] $msg2
+} {1 {bad text index "a"} 1 {bad text index "b"}}
+test textMark-4.3 {TkTextMarkCmd - "unset" option} {
+ .t mark set a 1.2
+ .t mark set b 2.3
+ .t mark set 49ers 3.1
+ eval .t mark unset [.t mark names]
+ lsort [.t mark names]
+} {current insert}
+
+test textMark-5.1 {TkTextMarkCmd - miscellaneous} {
+ list [catch {.t mark} msg] $msg
+} {1 {wrong # args: should be ".t mark option ?arg arg ...?"}}
+test textMark-5.2 {TkTextMarkCmd - miscellaneous} {
+ list [catch {.t mark foo} msg] $msg
+} {1 {bad mark option "foo": must be gravity, names, next, previous, set, or unset}}
+
+test textMark-6.1 {TkTextMarkSegToIndex} {
+ .t mark set a 1.2
+ .t mark set b 1.2
+ .t mark set c 1.2
+ .t mark set d 1.4
+ list [.t index a] [.t index b] [.t index c ] [.t index d]
+} {1.2 1.2 1.2 1.4}
+
+catch {eval {.t mark unset} [.t mark names]}
+test textMark-7.1 {MarkFindNext - invalid mark name} {
+ catch {.t mark next bogus} x
+ set x
+} {bad text index "bogus"}
+test textMark-7.2 {MarkFindNext - marks at same location} {
+ .t mark set insert 2.0
+ .t mark set current 2.0
+ .t mark next current
+} {insert}
+test textMark-7.3 {MarkFindNext - numerical starting mark} {
+ .t mark set current 1.0
+ .t mark set insert 1.0
+ .t mark next 1.0
+} {insert}
+test textMark-7.4 {MarkFindNext - mark on the same line} {
+ .t mark set current 1.0
+ .t mark set insert 1.1
+ .t mark next current
+} {insert}
+test textMark-7.5 {MarkFindNext - mark on the next line} {
+ .t mark set current 1.end
+ .t mark set insert 2.0
+ .t mark next current
+} {insert}
+test textMark-7.6 {MarkFindNext - mark far away} {
+ .t mark set current 1.2
+ .t mark set insert 7.0
+ .t mark next current
+} {insert}
+test textMark-7.7 {MarkFindNext - mark on top of end} {
+ .t mark set current end
+ .t mark next end
+} {current}
+test textMark-7.8 {MarkFindNext - no next mark} {
+ .t mark set current 1.0
+ .t mark set insert 3.0
+ .t mark next insert
+} {}
+test textMark-8.1 {MarkFindPrev - invalid mark name} {
+ catch {.t mark prev bogus} x
+ set x
+} {bad text index "bogus"}
+test textMark-8.2 {MarkFindPrev - marks at same location} {
+ .t mark set insert 2.0
+ .t mark set current 2.0
+ .t mark prev insert
+} {current}
+test textMark-8.3 {MarkFindPrev - numerical starting mark} {
+ .t mark set current 1.0
+ .t mark set insert 1.0
+ .t mark prev 1.1
+} {current}
+test textMark-8.4 {MarkFindPrev - mark on the same line} {
+ .t mark set current 1.0
+ .t mark set insert 1.1
+ .t mark prev insert
+} {current}
+test textMark-8.5 {MarkFindPrev - mark on the previous line} {
+ .t mark set current 1.end
+ .t mark set insert 2.0
+ .t mark prev insert
+} {current}
+test textMark-8.6 {MarkFindPrev - mark far away} {
+ .t mark set current 1.2
+ .t mark set insert 7.0
+ .t mark prev insert
+} {current}
+test textMark-8.7 {MarkFindPrev - mark on top of end} {
+ .t mark set insert 3.0
+ .t mark set current end
+ .t mark prev end
+} {insert}
+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 {}
diff --git a/tk/tests/textTag.test b/tk/tests/textTag.test
new file mode 100644
index 00000000000..dee46079fef
--- /dev/null
+++ b/tk/tests/textTag.test
@@ -0,0 +1,756 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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}
+
+# 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 .
+
+entry .t.e
+.t.e insert 0 "Text"
+
+.t insert 1.0 "Line 1
+abcdefghijklm
+12345
+Line 4
+bOy GIrl .#@? x_yz
+!@#$%
+Line 7"
+
+
+set i 1
+foreach test {
+ {-background #012345 #012345 non-existent
+ {unknown color name "non-existent"}}
+ {-bgstipple gray50 gray50 badStipple
+ {bitmap "badStipple" not defined}}
+ {-borderwidth 2 2 46q
+ {bad screen distance "46q"}}
+ {-fgstipple gray25 gray25 bogus
+ {bitmap "bogus" not defined}}
+ {-font fixed fixed {}
+ {font "" doesn't exist}}
+ {-foreground #001122 #001122 {silly color}
+ {unknown color name "silly color"}}
+ {-justify left left middle
+ {bad justification "middle": must be left, right, or center}}
+ {-lmargin1 10 10 bad
+ {bad screen distance "bad"}}
+ {-lmargin2 10 10 bad
+ {bad screen distance "bad"}}
+ {-offset 2 2 100xyz
+ {bad screen distance "100xyz"}}
+ {-overstrike on on stupid
+ {expected boolean value but got "stupid"}}
+ {-relief raised raised stupid
+ {bad relief type "stupid": must be flat, groove, raised, ridge, solid, or sunken}}
+ {-rmargin 10 10 bad
+ {bad screen distance "bad"}}
+ {-spacing1 10 10 bad
+ {bad screen distance "bad"}}
+ {-spacing2 10 10 bad
+ {bad screen distance "bad"}}
+ {-spacing3 10 10 bad
+ {bad screen distance "bad"}}
+ {-tabs {10 20 30} {10 20 30} {10 fork}
+ {bad tab alignment "fork": must be left, right, center, or numeric}}
+ {-underline no no stupid
+ {expected boolean value but got "stupid"}}
+} {
+ set name [lindex $test 0]
+ test textTag-1.$i {tag configuration options} {
+ .t tag configure x $name [lindex $test 1]
+ .t tag cget x $name
+ } [lindex $test 2]
+ incr i
+ if {[lindex $test 3] != ""} {
+ test textTag-1.$i {configuration options} {
+ list [catch {.t tag configure x $name [lindex $test 3]} msg] $msg
+ } [list 1 [lindex $test 4]]
+ }
+ .t tag configure x $name [lindex [.t tag configure x $name] 3]
+ incr i
+}
+test textTag-2.1 {TkTextTagCmd - "add" option} {
+ list [catch {.t tag} msg] $msg
+} {1 {wrong # args: should be ".t tag option ?arg arg ...?"}}
+test textTag-2.2 {TkTextTagCmd - "add" option} {
+ list [catch {.t tag gorp} msg] $msg
+} {1 {bad tag option "gorp": must be add, bind, cget, configure, delete, lower, names, nextrange, raise, ranges, or remove}}
+test textTag-2.3 {TkTextTagCmd - "add" option} {
+ list [catch {.t tag add foo} msg] $msg
+} {1 {wrong # args: should be ".t tag add tagName index1 ?index2 index1 index2 ...?"}}
+test textTag-2.4 {TkTextTagCmd - "add" option} {
+ list [catch {.t tag add x gorp} msg] $msg
+} {1 {bad text index "gorp"}}
+test textTag-2.5 {TkTextTagCmd - "add" option} {
+ list [catch {.t tag add x 1.2 gorp} msg] $msg
+} {1 {bad text index "gorp"}}
+test textTag-2.6 {TkTextTagCmd - "add" option} {
+ .t tag add sel 3.2 3.4
+ .t tag add sel 3.2 3.0
+ .t tag ranges sel
+} {3.2 3.4}
+test textTag-2.7 {TkTextTagCmd - "add" option} {
+ .t tag add x 1.0 1.end
+ .t tag ranges x
+} {1.0 1.6}
+test textTag-2.8 {TkTextTagCmd - "add" option} {
+ .t tag remove x 1.0 end
+ .t tag add x 1.2
+ .t tag ranges x
+} {1.2 1.3}
+test textTag-2.9 {TkTextTagCmd - "add" option} {
+ .t.e select from 0
+ .t.e select to 4
+ .t tag add sel 3.2 3.4
+ selection get
+} 34
+test textTag-2.11 {TkTextTagCmd - "add" option} {
+ .t.e select from 0
+ .t.e select to 4
+ .t configure -exportselection 0
+ .t tag add sel 3.2 3.4
+ selection get
+} Text
+test textTag-2.12 {TkTextTagCmd - "add" option} {
+ .t tag remove sel 1.0 end
+ .t tag add sel 1.1 1.5 2.4 3.1 4.2 4.4
+ .t tag ranges sel
+} {1.1 1.5 2.4 3.1 4.2 4.4}
+test textTag-2.13 {TkTextTagCmd - "add" option} {
+ .t tag remove sel 1.0 end
+ .t tag add sel 1.1 1.5 2.4
+ .t tag ranges sel
+} {1.1 1.5 2.4 2.5}
+
+catch {.t tag delete x}
+test textTag-3.1 {TkTextTagCmd - "bind" option} {
+ list [catch {.t tag bind} msg] $msg
+} {1 {wrong # args: should be ".t tag bind tagName ?sequence? ?command?"}}
+test textTag-3.2 {TkTextTagCmd - "bind" option} {
+ list [catch {.t tag bind 1 2 3 4} msg] $msg
+} {1 {wrong # args: should be ".t tag bind tagName ?sequence? ?command?"}}
+test textTag-3.3 {TkTextTagCmd - "bind" option} {
+ .t tag bind x <Enter> script1
+ .t tag bind x <Enter>
+} script1
+test textTag-3.4 {TkTextTagCmd - "bind" option} {
+ list [catch {.t tag bind x <Gorp> script2} msg] $msg
+} {1 {bad event type or keysym "Gorp"}}
+test textTag-3.5 {TkTextTagCmd - "bind" option} {
+ .t tag delete x
+ .t tag bind x <Enter> script1
+ list [catch {.t tag bind x <FocusIn> script2} msg] $msg [.t tag bind x]
+} {1 {requested illegal events; only key, button, motion, enter, leave, and virtual events may be used} <Enter>}
+test textTag-3.6 {TkTextTagCmd - "bind" option} {
+ .t tag delete x
+ .t tag bind x <Enter> script1
+ .t tag bind x <Leave> script2
+ .t tag bind x a xyzzy
+ list [lsort [.t tag bind x]] [.t tag bind x <Enter>] [.t tag bind x a]
+} {{<Enter> <Leave> a} script1 xyzzy}
+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"}}
+test textTag-4.3 {TkTextTagCmd - "cget" option} {
+ .t tag delete foo
+ list [catch {.t tag cget foo bar} msg] $msg
+} {1 {tag "foo" isn't defined in text widget}}
+test textTag-4.4 {TkTextTagCmd - "cget" option} {
+ list [catch {.t tag cget sel bogus} msg] $msg
+} {1 {unknown option "bogus"}}
+test textTag-4.5 {TkTextTagCmd - "cget" option} {
+ .t tag delete x
+ .t tag configure x -background red
+ list [catch {.t tag cget x -background} msg] $msg
+} {0 red}
+
+test textTag-5.1 {TkTextTagCmd - "configure" option} {
+ list [catch {.t tag configure} msg] $msg
+} {1 {wrong # args: should be ".t tag configure tagName ?option? ?value? ?option value ...?"}}
+test textTag-5.2 {TkTextTagCmd - "configure" option} {
+ list [catch {.t tag configure x -foo} msg] $msg
+} {1 {unknown option "-foo"}}
+test textTag-5.3 {TkTextTagCmd - "configure" option} {
+ list [catch {.t tag configure x -background red -underline} msg] $msg
+} {1 {value for "-underline" missing}}
+test textTag-5.4 {TkTextTagCmd - "configure" option} {
+ .t tag delete x
+ .t tag configure x -underline yes
+ .t tag configure x -underline
+} {-underline {} {} {} yes}
+test textTag-5.5 {TkTextTagCmd - "configure" option} {
+ .t tag delete x
+ .t tag configure x -overstrike on
+ .t tag cget x -overstrike
+} {on}
+test textTag-5.6 {TkTextTagCmd - "configure" option} {
+ list [catch {.t tag configure x -overstrike foo} msg] $msg
+} {1 {expected boolean value but got "foo"}}
+test textTag-5.7 {TkTextTagCmd - "configure" option} {
+ .t tag delete x
+ list [catch {.t tag configure x -underline stupid} msg] $msg
+} {1 {expected boolean value but got "stupid"}}
+test textTag-5.8 {TkTextTagCmd - "configure" option} {
+ .t tag delete x
+ .t tag configure x -justify left
+ .t tag configure x -justify
+} {-justify {} {} {} left}
+test textTag-5.9 {TkTextTagCmd - "configure" option} {
+ .t tag delete x
+ list [catch {.t tag configure x -justify bogus} msg] $msg
+} {1 {bad justification "bogus": must be left, right, or center}}
+test textTag-5.10 {TkTextTagCmd - "configure" option} {
+ .t tag delete x
+ list [catch {.t tag configure x -justify fill} msg] $msg
+} {1 {bad justification "fill": must be left, right, or center}}
+test textTag-5.11 {TkTextTagCmd - "configure" option} {
+ .t tag delete x
+ .t tag configure x -offset 2
+ .t tag configure x -offset
+} {-offset {} {} {} 2}
+test textTag-5.12 {TkTextTagCmd - "configure" option} {
+ .t tag delete x
+ list [catch {.t tag configure x -offset 1.0q} msg] $msg
+} {1 {bad screen distance "1.0q"}}
+test textTag-5.13 {TkTextTagCmd - "configure" option} {
+ .t tag delete x
+ .t tag configure x -lmargin1 2 -lmargin2 4 -rmargin 5
+ list [.t tag configure x -lmargin1] [.t tag configure x -lmargin2] \
+ [.t tag configure x -rmargin]
+} {{-lmargin1 {} {} {} 2} {-lmargin2 {} {} {} 4} {-rmargin {} {} {} 5}}
+test textTag-5.14 {TkTextTagCmd - "configure" option} {
+ .t tag delete x
+ list [catch {.t tag configure x -lmargin1 2.0x} msg] $msg
+} {1 {bad screen distance "2.0x"}}
+test textTag-5.15 {TkTextTagCmd - "configure" option} {
+ .t tag delete x
+ list [catch {.t tag configure x -lmargin2 gorp} msg] $msg
+} {1 {bad screen distance "gorp"}}
+test textTag-5.16 {TkTextTagCmd - "configure" option} {
+ .t tag delete x
+ list [catch {.t tag configure x -rmargin 140.1.1} msg] $msg
+} {1 {bad screen distance "140.1.1"}}
+.t tag delete x
+test textTag-5.17 {TkTextTagCmd - "configure" option} {
+ .t tag delete x
+ .t tag configure x -spacing1 2 -spacing2 4 -spacing3 6
+ list [.t tag configure x -spacing1] [.t tag configure x -spacing2] \
+ [.t tag configure x -spacing3]
+} {{-spacing1 {} {} {} 2} {-spacing2 {} {} {} 4} {-spacing3 {} {} {} 6}}
+test textTag-5.18 {TkTextTagCmd - "configure" option} {
+ .t tag delete x
+ list [catch {.t tag configure x -spacing1 2.0x} msg] $msg
+} {1 {bad screen distance "2.0x"}}
+test textTag-5.19 {TkTextTagCmd - "configure" option} {
+ .t tag delete x
+ list [catch {.t tag configure x -spacing1 lousy} msg] $msg
+} {1 {bad screen distance "lousy"}}
+test textTag-5.20 {TkTextTagCmd - "configure" option} {
+ .t tag delete x
+ list [catch {.t tag configure x -spacing1 4.2.3} msg] $msg
+} {1 {bad screen distance "4.2.3"}}
+test textTag-5.21 {TkTextTagCmd - "configure" option} {
+ .t configure -selectborderwidth 2 -selectforeground blue \
+ -selectbackground black
+ .t tag configure sel -borderwidth 4 -foreground green -background yellow
+ set x {}
+ foreach i {-selectborderwidth -selectforeground -selectbackground} {
+ lappend x [lindex [.t configure $i] 4]
+ }
+ set x
+} {4 green yellow}
+test textTag-5.22 {TkTextTagCmd - "configure" option} {
+ .t configure -selectborderwidth 20
+ .t tag configure sel -borderwidth {}
+ .t cget -selectborderwidth
+} {}
+
+test textTag-6.1 {TkTextTagCmd - "delete" option} {
+ list [catch {.t tag delete} msg] $msg
+} {1 {wrong # args: should be ".t tag delete tagName tagName ..."}}
+test textTag-6.2 {TkTextTagCmd - "delete" option} {
+ list [catch {.t tag delete zork} msg] $msg
+} {0 {}}
+test textTag-6.3 {TkTextTagCmd - "delete" option} {
+ .t tag delete x
+ .t tag config x -background black
+ .t tag config y -foreground white
+ .t tag config z -background black
+ .t tag delete y z
+ lsort [.t tag names]
+} {sel x}
+test textTag-6.4 {TkTextTagCmd - "delete" option} {
+ .t tag config x -background black
+ .t tag config y -foreground white
+ .t tag config z -background black
+ eval .t tag delete [.t tag names]
+ .t tag names
+} {sel}
+test textTag-6.5 {TkTextTagCmd - "delete" option} {
+ .t tag bind x <Enter> foo
+ .t tag delete x
+ .t tag configure x -background black
+ .t tag bind x
+} {}
+
+proc tagsetup {} {
+ .t tag delete x y z a b c d
+ .t tag remove sel 1.0 end
+ foreach i {a b c d} {
+ .t tag configure $i -background black
+ }
+}
+test textTag-7.1 {TkTextTagCmd - "lower" option} {
+ list [catch {.t tag lower} msg] $msg
+} {1 {wrong # args: should be ".t tag lower tagName ?belowThis?"}}
+test textTag-7.2 {TkTextTagCmd - "lower" option} {
+ list [catch {.t tag lower foo} msg] $msg
+} {1 {tag "foo" isn't defined in text widget}}
+test textTag-7.3 {TkTextTagCmd - "lower" option} {
+ list [catch {.t tag lower sel bar} msg] $msg
+} {1 {tag "bar" isn't defined in text widget}}
+test textTag-7.4 {TkTextTagCmd - "lower" option} {
+ tagsetup
+ .t tag lower c
+ .t tag names
+} {c sel a b d}
+test textTag-7.5 {TkTextTagCmd - "lower" option} {
+ tagsetup
+ .t tag lower d b
+ .t tag names
+} {sel a d b c}
+test textTag-7.6 {TkTextTagCmd - "lower" option} {
+ tagsetup
+ .t tag lower a c
+ .t tag names
+} {sel b a c d}
+
+test textTag-8.1 {TkTextTagCmd - "names" option} {
+ list [catch {.t tag names a b} msg] $msg
+} {1 {wrong # args: should be ".t tag names ?index?"}}
+test textTag-8.2 {TkTextTagCmd - "names" option} {
+ tagsetup
+ .t tag names
+} {sel a b c d}
+test textTag-8.3 {TkTextTagCmd - "names" option} {
+ tagsetup
+ .t tag add "a b" 2.1 2.6
+ .t tag add c 2.4 2.7
+ .t tag names 2.5
+} {c {a b}}
+
+.t tag delete x y z a b c d {a b}
+.t tag add x 2.3 2.5
+.t tag add x 2.9 3.1
+.t tag add x 7.2
+test textTag-9.1 {TkTextTagCmd - "nextrange" option} {
+ list [catch {.t tag nextrange x} msg] $msg
+} {1 {wrong # args: should be ".t tag nextrange tagName index1 ?index2?"}}
+test textTag-9.2 {TkTextTagCmd - "nextrange" option} {
+ list [catch {.t tag nextrange x 1 2 3} msg] $msg
+} {1 {wrong # args: should be ".t tag nextrange tagName index1 ?index2?"}}
+test textTag-9.3 {TkTextTagCmd - "nextrange" option} {
+ list [catch {.t tag nextrange foo 1.0} msg] $msg
+} {0 {}}
+test textTag-9.4 {TkTextTagCmd - "nextrange" option} {
+ list [catch {.t tag nextrange x foo} msg] $msg
+} {1 {bad text index "foo"}}
+test textTag-9.5 {TkTextTagCmd - "nextrange" option} {
+ list [catch {.t tag nextrange x 1.0 bar} msg] $msg
+} {1 {bad text index "bar"}}
+test textTag-9.6 {TkTextTagCmd - "nextrange" option} {
+ .t tag nextrange x 1.0
+} {2.3 2.5}
+test textTag-9.7 {TkTextTagCmd - "nextrange" option} {
+ .t tag nextrange x 2.2
+} {2.3 2.5}
+test textTag-9.8 {TkTextTagCmd - "nextrange" option} {
+ .t tag nextrange x 2.3
+} {2.3 2.5}
+test textTag-9.9 {TkTextTagCmd - "nextrange" option} {
+ .t tag nextrange x 2.4
+} {2.9 3.1}
+test textTag-9.10 {TkTextTagCmd - "nextrange" option} {
+ .t tag nextrange x 2.4 2.9
+} {}
+test textTag-9.11 {TkTextTagCmd - "nextrange" option} {
+ .t tag nextrange x 2.4 2.10
+} {2.9 3.1}
+test textTag-9.12 {TkTextTagCmd - "nextrange" option} {
+ .t tag nextrange x 2.4 2.11
+} {2.9 3.1}
+test textTag-9.13 {TkTextTagCmd - "nextrange" option} {
+ .t tag nextrange x 7.0
+} {7.2 7.3}
+test textTag-9.14 {TkTextTagCmd - "nextrange" option} {
+ .t tag nextrange x 7.3
+} {}
+
+test textTag-10.1 {TkTextTagCmd - "prevrange" option} {
+ list [catch {.t tag prevrange x} msg] $msg
+} {1 {wrong # args: should be ".t tag prevrange tagName index1 ?index2?"}}
+test textTag-10.2 {TkTextTagCmd - "prevrange" option} {
+ list [catch {.t tag prevrange x 1 2 3} msg] $msg
+} {1 {wrong # args: should be ".t tag prevrange tagName index1 ?index2?"}}
+test textTag-10.3 {TkTextTagCmd - "prevrange" option} {
+ list [catch {.t tag prevrange foo end} msg] $msg
+} {0 {}}
+test textTag-10.4 {TkTextTagCmd - "prevrange" option} {
+ list [catch {.t tag prevrange x foo} msg] $msg
+} {1 {bad text index "foo"}}
+test textTag-10.5 {TkTextTagCmd - "prevrange" option} {
+ list [catch {.t tag prevrange x end bar} msg] $msg
+} {1 {bad text index "bar"}}
+test textTag-10.6 {TkTextTagCmd - "prevrange" option} {
+ .t tag prevrange x end
+} {7.2 7.3}
+test textTag-10.7 {TkTextTagCmd - "prevrange" option} {
+ .t tag prevrange x 2.4
+} {2.3 2.5}
+test textTag-10.8 {TkTextTagCmd - "prevrange" option} {
+ .t tag prevrange x 2.5
+} {2.3 2.5}
+test textTag-10.9 {TkTextTagCmd - "prevrange" option} {
+ .t tag prevrange x 2.9
+} {2.3 2.5}
+test textTag-10.10 {TkTextTagCmd - "prevrange" option} {
+ .t tag prevrange x 2.9 2.6
+} {}
+test textTag-10.11 {TkTextTagCmd - "prevrange" option} {
+ .t tag prevrange x 2.9 2.5
+} {}
+test textTag-10.12 {TkTextTagCmd - "prevrange" option} {
+ .t tag prevrange x 2.9 2.3
+} {2.3 2.5}
+test textTag-10.13 {TkTextTagCmd - "prevrange" option} {
+ .t tag prevrange x 7.0
+} {2.9 3.1}
+test textTag-10.14 {TkTextTagCmd - "prevrange" option} {
+ .t tag prevrange x 2.3
+} {}
+
+test textTag-11.1 {TkTextTagCmd - "raise" option} {
+ list [catch {.t tag raise} msg] $msg
+} {1 {wrong # args: should be ".t tag raise tagName ?aboveThis?"}}
+test textTag-11.2 {TkTextTagCmd - "raise" option} {
+ list [catch {.t tag raise foo} msg] $msg
+} {1 {tag "foo" isn't defined in text widget}}
+test textTag-11.3 {TkTextTagCmd - "raise" option} {
+ list [catch {.t tag raise sel bar} msg] $msg
+} {1 {tag "bar" isn't defined in text widget}}
+test textTag-11.4 {TkTextTagCmd - "raise" option} {
+ tagsetup
+ .t tag raise c
+ .t tag names
+} {sel a b d c}
+test textTag-11.5 {TkTextTagCmd - "raise" option} {
+ tagsetup
+ .t tag raise d b
+ .t tag names
+} {sel a b d c}
+test textTag-11.6 {TkTextTagCmd - "raise" option} {
+ tagsetup
+ .t tag raise a c
+ .t tag names
+} {sel b c a d}
+
+test textTag-12.1 {TkTextTagCmd - "ranges" option} {
+ list [catch {.t tag ranges} msg] $msg
+} {1 {wrong # args: should be ".t tag ranges tagName"}}
+test textTag-12.2 {TkTextTagCmd - "ranges" option} {
+ .t tag delete x
+ .t tag ranges x
+} {}
+test textTag-12.3 {TkTextTagCmd - "ranges" option} {
+ .t tag delete x
+ .t tag add x 2.2
+ .t tag add x 2.7 4.15
+ .t tag add x 5.2 5.5
+ .t tag ranges x
+} {2.2 2.3 2.7 4.6 5.2 5.5}
+test textTag-12.4 {TkTextTagCmd - "ranges" option} {
+ .t tag delete x
+ .t tag add x 1.0 3.0
+ .t tag add x 4.0 end
+ .t tag ranges x
+} {1.0 3.0 4.0 8.0}
+
+test textTag-13.1 {TkTextTagCmd - "remove" option} {
+ list [catch {.t tag remove} msg] $msg
+} {1 {wrong # args: should be ".t tag remove tagName index1 ?index2 index1 index2 ...?"}}
+test textTag-13.2 {TkTextTagCmd - "remove" option} {
+ .t tag delete x
+ .t tag add x 2.2 2.11
+ .t tag remove x 2.3 2.7
+ .t tag ranges x
+} {2.2 2.3 2.7 2.11}
+test textTag-13.3 {TkTextTagCmd - "remove" option} {
+ .t configure -exportselection 1
+ .t tag remove sel 1.0 end
+ .t tag add sel 2.4 3.3
+ .t.e select to 4
+ .t tag remove sel 2.7 3.1
+ selection get
+} Text
+
+.t tag delete x a b c d
+test textTag-14.1 {SortTags} {
+ foreach i {a b c d} {
+ .t tag add $i 2.0 2.2
+ }
+ .t tag names 2.1
+} {a b c d}
+.t tag delete a b c d
+test textTag-14.2 {SortTags} {
+ foreach i {a b c d} {
+ .t tag configure $i -background black
+ }
+ foreach i {d c b a} {
+ .t tag add $i 2.0 2.2
+ }
+ .t tag names 2.1
+} {a b c d}
+.t tag delete x a b c d
+test textTag-14.3 {SortTags} {
+ for {set i 0} {$i < 30} {incr i} {
+ .t tag add x$i 2.0 2.2
+ }
+ .t tag names 2.1
+} {x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29}
+test textTag-14.4 {SortTags} {
+ for {set i 0} {$i < 30} {incr i} {
+ .t tag configure x$i -background black
+ }
+ for {set i 29} {$i >= 0} {incr i -1} {
+ .t tag add x$i 2.0 2.2
+ }
+ .t tag names 2.1
+} {x0 x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x20 x21 x22 x23 x24 x25 x26 x27 x28 x29}
+
+foreach tag [.t tag names] {
+ catch {.t tag delete $tag}
+}
+set c [.t bbox 2.1]
+set x1 [expr [lindex $c 0] + [lindex $c 2]/2]
+set y1 [expr [lindex $c 1] + [lindex $c 3]/2]
+set c [.t bbox 3.2]
+set x2 [expr [lindex $c 0] + [lindex $c 2]/2]
+set y2 [expr [lindex $c 1] + [lindex $c 3]/2]
+set c [.t bbox 4.3]
+set x3 [expr [lindex $c 0] + [lindex $c 2]/2]
+set y3 [expr [lindex $c 1] + [lindex $c 3]/2]
+
+test textTag-15.1 {TkTextBindProc} {
+ bind .t <ButtonRelease> {lappend x up}
+ .t tag bind x <ButtonRelease> {lappend x x-up}
+ .t tag bind y <ButtonRelease> {lappend x y-up}
+ set x {}
+ .t tag add x 2.0 2.4
+ .t tag add y 4.3
+ event gen .t <Motion> -x $x1 -y $y1
+ event gen .t <ButtonRelease> -x $x1 -y $y1
+ event gen .t <Motion> -x $x2 -y $y2
+ event gen .t <ButtonRelease> -x $x2 -y $y2
+ event gen .t <Motion> -x $x3 -y $y3
+ event gen .t <ButtonRelease> -x $x3 -y $y3
+ bind .t <ButtonRelease> {}
+ set x
+} {x-up up up y-up up}
+test textTag-15.2 {TkTextBindProc} {
+ catch {.t tag delete x}
+ catch {.t tag delete y}
+ .t tag bind x <Enter> {lappend x x-enter}
+ .t tag bind x <ButtonPress> {lappend x x-down}
+ .t tag bind x <ButtonRelease> {lappend x x-up}
+ .t tag bind x <Leave> {lappend x x-leave}
+ .t tag bind y <Enter> {lappend x y-enter}
+ .t tag bind y <ButtonPress> {lappend x y-down}
+ .t tag bind y <ButtonRelease> {lappend x y-up}
+ .t tag bind y <Leave> {lappend x y-leave}
+ event gen .t <Motion> -x 0 -y 0
+ set x {}
+ .t tag add x 2.0 2.4
+ .t tag add y 4.3
+ event gen .t <Motion> -x $x1 -y $y1
+ lappend x |
+ event gen .t <Button> -x $x1 -y $y1
+ lappend x |
+ event gen .t <Motion> -x $x3 -y $y3 -state 0x100
+ lappend x |
+ event gen .t <ButtonRelease> -x $x3 -y $y3
+ set x
+} {x-enter | x-down | | x-up x-leave y-enter}
+test textTag-15.3 {TkTextBindProc} {
+ catch {.t tag delete x}
+ catch {.t tag delete y}
+ .t tag bind x <Enter> {lappend x x-enter}
+ .t tag bind x <Any-ButtonPress-1> {lappend x x-down}
+ .t tag bind x <Any-ButtonRelease-1> {lappend x x-up}
+ .t tag bind x <Leave> {lappend x x-leave}
+ .t tag bind y <Enter> {lappend x y-enter}
+ .t tag bind y <Any-ButtonPress-1> {lappend x y-down}
+ .t tag bind y <Any-ButtonRelease-1> {lappend x y-up}
+ .t tag bind y <Leave> {lappend x y-leave}
+ event gen .t <Motion> -x 0 -y 0
+ set x {}
+ .t tag add x 2.0 2.4
+ .t tag add y 4.3
+ event gen .t <Motion> -x $x1 -y $y1
+ lappend x |
+ event gen .t <Button-1> -x $x1 -y $y1
+ lappend x |
+ event gen .t <Button-2> -x $x1 -y $y1 -state 0x100
+ lappend x |
+ event gen .t <Motion> -x $x3 -y $y3 -state 0x300
+ lappend x |
+ event gen .t <ButtonRelease-1> -x $x3 -y $y3 -state 0x300
+ lappend x |
+ event gen .t <ButtonRelease-2> -x $x3 -y $y3 -state 0x200
+ set x
+} {x-enter | x-down | | | x-up | x-leave y-enter}
+
+foreach tag [.t tag names] {
+ catch {.t tag delete $tag}
+}
+.t tag configure big -font $bigFont
+test textTag-16.1 {TkTextPickCurrent procedure} {
+ event gen .t <ButtonRelease-1> -state 0x100 -x $x1 -y $y1
+ set x [.t index current]
+ event gen .t <Motion> -x $x2 -y $y2
+ lappend x [.t index current]
+ event gen .t <Button-1> -x $x2 -y $y2
+ lappend x [.t index current]
+ event gen .t <Motion> -x $x3 -y $y3 -state 0x100
+ lappend x [.t index current]
+ event gen .t <Button-3> -state 0x100 -x $x3 -y $y3
+ lappend x [.t index current]
+ event gen .t <ButtonRelease-3> -state 0x300 -x $x3 -y $y3
+ lappend x [.t index current]
+ event gen .t <ButtonRelease-1> -state 0x100 -x $x3 -y $y3
+ lappend x [.t index current]
+} {2.1 3.2 3.2 3.2 3.2 3.2 4.3}
+test textTag-16.2 {TkTextPickCurrent procedure} {
+ event gen .t <ButtonRelease-1> -state 0x100 -x $x1 -y $y1
+ event gen .t <Motion> -x $x2 -y $y2
+ set x [.t index current]
+ .t tag add big 3.0
+ update
+ lappend x [.t index current]
+} {3.2 3.1}
+.t tag remove big 1.0 end
+foreach i {a b c d} {
+ .t tag bind $i <Enter> "lappend x enter-$i"
+ .t tag bind $i <Leave> "lappend x leave-$i"
+}
+test textTag-16.3 {TkTextPickCurrent procedure} {
+ foreach i {a b c d} {
+ .t tag remove $i 1.0 end
+ }
+ .t tag lower b
+ .t tag lower a
+ set x {}
+ event gen .t <Motion> -x $x1 -y $y1
+ .t tag add a 2.1 3.3
+ .t tag add b 2.1
+ .t tag add c 3.2
+ update
+ lappend x |
+ event gen .t <Motion> -x $x2 -y $y2
+ lappend x |
+ event gen .t <Motion> -x $x3 -y $y3
+ set x
+} {enter-a enter-b | leave-b enter-c | leave-a leave-c}
+test textTag-16.4 {TkTextPickCurrent procedure} {
+ foreach i {a b c d} {
+ .t tag remove $i 1.0 end
+ }
+ .t tag lower b
+ .t tag lower a
+ set x {}
+ event gen .t <Motion> -x $x1 -y $y1
+ .t tag add a 2.1 3.3
+ .t tag add b 2.1
+ .t tag add c 2.1
+ update
+ lappend x |
+ .t tag lower c
+ event gen .t <Motion> -x $x2 -y $y2
+ set x
+} {enter-a enter-b enter-c | leave-c leave-b}
+foreach i {a b c d} {
+ .t tag delete $i
+}
+test textTag-16.5 {TkTextPickCurrent procedure} {
+ foreach i {a b c d} {
+ .t tag remove $i 1.0 end
+ }
+ event gen .t <Motion> -x $x1 -y $y1
+ .t tag bind a <Enter> {.t tag add big 3.0 3.2}
+ .t tag add a 3.2
+ event gen .t <Motion> -x $x2 -y $y2
+ .t index current
+} {3.2}
+test textTag-16.6 {TkTextPickCurrent procedure} {
+ foreach i {a b c d} {
+ .t tag remove $i 1.0 end
+ }
+ event gen .t <Motion> -x $x1 -y $y1
+ .t tag bind a <Enter> {.t tag add big 3.0 3.2}
+ .t tag add a 3.2
+ event gen .t <Motion> -x $x2 -y $y2
+ update
+ .t index current
+} {3.1}
+test textTag-16.7 {TkTextPickCurrent procedure} {
+ foreach i {a b c d} {
+ .t tag remove $i 1.0 end
+ }
+ event gen .t <Motion> -x $x1 -y $y1
+ .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 {}
diff --git a/tk/tests/textWind.test b/tk/tests/textWind.test
new file mode 100644
index 00000000000..f75c66c2a6f
--- /dev/null
+++ b/tk/tests/textWind.test
@@ -0,0 +1,826 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+# like border width have predictable values.
+
+option add *Text.borderWidth 2
+option add *Text.highlightThickness 2
+if {$tcl_platform(platform) == "windows"} {
+ option add *Text.font {Courier -14}
+} else {
+ option add *Text.font {Courier -12}
+}
+
+text .t -width 30 -height 6 -bd 2 -highlightthickness 2
+pack append . .t {top expand fill}
+update
+.t debug on
+wm geometry . {}
+if {[winfo depth .t] > 1} {
+ set color green
+} else {
+ set color black
+}
+
+# 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 .
+
+test textWind-1.1 {basic tests of options} {fonts} {
+ .t delete 1.0 end
+ .t insert end "This is the first line"
+ .t insert end "\nAnd this is a second line, which wraps around"
+ frame .f -width 3 -height 3 -bg $color
+ .t window create 2.2 -window .f
+ update
+ list [winfo ismapped .f] [winfo geom .f] [.t bbox .f] \
+ [.t window configure .f -window]
+} {1 3x3+19+23 {19 23 3 3} {-window {} {} {} .f}}
+test textWind-1.2 {basic tests of options} {fonts} {
+ .t delete 1.0 end
+ .t insert end "This is the first line"
+ .t insert end "\nAnd this is a second line, which wraps around"
+ frame .f -width 3 -height 3 -bg $color
+ .t window create 2.2 -window .f -align top
+ update
+ list [winfo ismapped .f] [winfo geom .f] [.t bbox .f] \
+ [.t window configure .f -align]
+} {1 3x3+19+18 {19 18 3 3} {-align {} {} center top}}
+test textWind-1.3 {basic tests of options} {
+ .t delete 1.0 end
+ .t insert end "This is the first line"
+ .t insert end "\nAnd this is a second line, which wraps around"
+ .t window create 2.2 -create "Test script"
+ .t window configure 2.2 -create
+} {-create {} {} {} {Test script}}
+test textWind-1.4 {basic tests of options} {fonts} {
+ .t delete 1.0 end
+ .t insert end "This is the first line"
+ .t insert end "\nAnd this is a second line, which wraps around"
+ frame .f -width 10 -height 20 -bg $color
+ .t window create 2.2 -window .f -padx 5
+ update
+ list [winfo geom .f] [.t window configure .f -padx] [.t bbox 2.3]
+} {10x20+24+18 {-padx {} {} 0 5} {39 21 7 13}}
+test textWind-1.5 {basic tests of options} {fonts} {
+ .t delete 1.0 end
+ .t insert end "This is the first line"
+ .t insert end "\nAnd this is a second line, which wraps around"
+ frame .f -width 10 -height 20 -bg $color
+ .t window create 2.2 -window .f -pady 4
+ update
+ list [winfo geom .f] [.t window configure .f -pady] [.t bbox 2.31]
+} {10x20+19+22 {-pady {} {} 0 4} {19 46 7 13}}
+test textWind-1.6 {basic tests of options} {fonts} {
+ .t delete 1.0 end
+ .t insert end "This is the first line"
+ .t insert end "\nAnd this is a second line, which wraps around"
+ frame .f -width 5 -height 5 -bg $color
+ .t window create 2.2 -window .f -stretch 1
+ update
+ list [winfo geom .f] [.t window configure .f -stretch]
+} {5x13+19+18 {-stretch {} {} 0 1}}
+
+.t delete 1.0 end
+.t insert end "This is the first line"
+frame .f -width 10 -height 6 -bg $color
+.t window create 1.3 -window .f -padx 1 -pady 2
+test textWind-2.1 {TkTextWindowCmd procedure} {
+ list [catch {.t window} msg] $msg
+} {1 {wrong # args: should be ".t window option ?arg arg ...?"}}
+test textWind-2.2 {TkTextWindowCmd procedure, "cget" option} {
+ list [catch {.t window cget} msg] $msg
+} {1 {wrong # args: should be ".t window cget index option"}}
+test textWind-2.3 {TkTextWindowCmd procedure, "cget" option} {
+ list [catch {.t window cget a b c} msg] $msg
+} {1 {wrong # args: should be ".t window cget index option"}}
+test textWind-2.4 {TkTextWindowCmd procedure, "cget" option} {
+ list [catch {.t window cget gorp -padx} msg] $msg
+} {1 {bad text index "gorp"}}
+test textWind-2.5 {TkTextWindowCmd procedure, "cget" option} {
+ list [catch {.t window cget 1.2 -padx} msg] $msg
+} {1 {no embedded window at index "1.2"}}
+test textWind-2.6 {TkTextWindowCmd procedure, "cget" option} {
+ list [catch {.t window cget .f -bogus} msg] $msg
+} {1 {unknown option "-bogus"}}
+test textWind-2.7 {TkTextWindowCmd procedure, "cget" option} {
+ list [catch {.t window cget .f -pady} msg] $msg
+} {0 2}
+test textWind-2.8 {TkTextWindowCmd procedure} {
+ list [catch {.t window co} msg] $msg
+} {1 {wrong # args: should be ".t window configure index ?option value ...?"}}
+test textWind-2.9 {TkTextWindowCmd procedure} {
+ list [catch {.t window configure gorp} msg] $msg
+} {1 {bad text index "gorp"}}
+test textWind-2.10 {TkTextWindowCmd procedure} {
+ .t delete 1.0 end
+ list [catch {.t window configure 1.0} msg] $msg
+} {1 {no embedded window at index "1.0"}}
+test textWind-2.11 {TkTextWindowCmd procedure} {
+ .t delete 1.0 end
+ .t insert end "This is the first line"
+ .t insert end "\nAnd this is a second line, which wraps around"
+ frame .f -width 10 -height 6 -bg $color
+ .t window create 2.2 -window .f -align baseline -padx 1 -pady 2 -create foo
+ update
+ list [catch {.t window configure .f} msg] $msg
+} {0 {{-align {} {} center baseline} {-create {} {} {} foo} {-padx {} {} 0 1} {-pady {} {} 0 2} {-stretch {} {} 0 0} {-window {} {} {} .f}}}
+test textWind-2.12 {TkTextWindowCmd procedure} {
+ .t delete 1.0 end
+ .t insert end "This is the first line"
+ .t insert end "\nAnd this is a second line, which wraps around"
+ frame .f -width 10 -height 6 -bg $color
+ .t window create 2.2 -window .f -align baseline -padx 1 -pady 2 -create foo
+ update
+ list [.t window configure .f -padx 33] [.t window configure .f -padx]
+} {{} {-padx {} {} 0 33}}
+test textWind-2.13 {TkTextWindowCmd procedure} {
+ .t delete 1.0 end
+ .t insert end "This is the first line"
+ .t insert end "\nAnd this is a second line, which wraps around"
+ frame .f -width 10 -height 6 -bg $color
+ .t window create 2.2 -window .f -align baseline -padx 1 -pady 2
+ update
+ list [.t window configure .f -padx 14 -pady 15] \
+ [.t window configure .f -padx] [.t window configure .f -pady]
+} {{} {-padx {} {} 0 14} {-pady {} {} 0 15}}
+test textWind-2.14 {TkTextWindowCmd procedure} {
+ list [catch {.t window create} msg] $msg
+} {1 {wrong # args: should be ".t window create index ?option value ...?"}}
+test textWind-2.15 {TkTextWindowCmd procedure} {
+ list [catch {.t window create gorp} msg] $msg
+} {1 {bad text index "gorp"}}
+test textWind-2.16 {TkTextWindowCmd procedure, don't insert after end} {
+ .t delete 1.0 end
+ .t insert end "Line 1\nLine 2"
+ frame .f -width 20 -height 10 -bg $color
+ .t window create end -window .f
+ .t index .f
+} {2.6}
+test textWind-2.17 {TkTextWindowCmd procedure} {
+ .t delete 1.0 end
+ list [catch {.t window create 1.0} msg] $msg [.t window configure 1.0]
+} {0 {} {{-align {} {} center center} {-create {} {} {} {}} {-padx {} {} 0 0} {-pady {} {} 0 0} {-stretch {} {} 0 0} {-window {} {} {} {}}}}
+test textWind-2.18 {TkTextWindowCmd procedure} {
+ .t delete 1.0 end
+ frame .f -width 10 -height 6 -bg $color
+ list [catch {.t window create 1.0 -window .f -gorp stupid} msg] $msg \
+ [winfo exists .f] [.t index 1.end] [catch {.t index .f}]
+} {1 {unknown option "-gorp"} 0 1.0 1}
+test textWind-2.19 {TkTextWindowCmd procedure} {
+ .t delete 1.0 end
+ frame .f -width 10 -height 6 -bg $color
+ list [catch {.t window create 1.0 -gorp -window .f stupid} msg] $msg \
+ [winfo exists .f] [.t index 1.end] [catch {.t index .f}]
+} {1 {unknown option "-gorp"} 1 1.0 1}
+test textWind-2.20 {TkTextWindowCmd procedure} {
+ list [catch {.t window c} msg] $msg
+} {1 {bad window option "c": must be cget, configure, create, or names}}
+destroy .f
+test textWind-2.21 {TkTextWindowCmd procedure, "names" option} {
+ list [catch {.t window names foo} msg] $msg
+} {1 {wrong # args: should be ".t window names"}}
+test textWind-2.22 {TkTextWindowCmd procedure, "names" option} {
+ .t delete 1.0 end
+ .t window names
+} {}
+test textWind-2.23 {TkTextWindowCmd procedure, "names" option} {
+ .t delete 1.0 end
+ foreach i {.f .f2 .t.f .t.f2} {
+ frame $i -width 20 -height 20
+ .t window create end -window $i
+ }
+ set result [.t window names]
+ destroy .f .f2 .t.f .t.f2
+ lsort $result
+} {.f .f2 .t.f .t.f2}
+
+test textWind-3.1 {EmbWinConfigure procedure} {
+ .t delete 1.0 end
+ frame .f -width 10 -height 6 -bg $color
+ .t window create 1.0 -window .f
+ list [catch {.t window configure 1.0 -foo bar} msg] $msg
+} {1 {unknown option "-foo"}}
+test textWind-3.2 {EmbWinConfigure procedure} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 10 -height 20 -bg $color
+ .t window create 1.3 -window .f
+ update
+ .t window configure 1.3 -window {}
+ update
+ list [catch {.t index .f} msg] $msg [winfo ismapped .f] [.t bbox 1.4]
+} {1 {bad text index ".f"} 0 {26 5 7 13}}
+catch {destroy .f}
+test textWind-3.3 {EmbWinConfigure procedure} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .t.f -width 10 -height 20 -bg $color
+ .t window create 1.3 -window .t.f
+ update
+ .t window configure 1.3 -window {}
+ update
+ list [catch {.t index .t.f} msg] $msg [winfo ismapped .t.f] [.t bbox 1.4]
+} {1 {bad text index ".t.f"} 0 {26 5 7 13}}
+catch {destroy .t.f}
+test textWind-3.4 {EmbWinConfigure procedure} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 10 -height 20 -bg $color
+ .t window create 1.3
+ update
+ .t window configure 1.3 -window .f
+ update
+ list [catch {.t index .f} msg] $msg [winfo ismapped .f] [.t bbox 1.4]
+} {0 1.3 1 {36 8 7 13}}
+test textWind-3.5 {EmbWinConfigure procedure} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f
+ frame .f.f -width 15 -height 20 -bg $color
+ pack .f.f
+ list [catch {.t window create 1.3 -window .f.f} msg] $msg
+} {1 {can't embed .f.f in .t}}
+catch {destroy .f}
+test textWind-3.6 {EmbWinConfigure procedure} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ toplevel .t2 -width 20 -height 10 -bg $color
+ .t window create 1.3
+ list [catch {.t window configure 1.3 -window .t2} msg] $msg \
+ [.t window configure 1.3 -window]
+} {1 {can't embed .t2 in .t} {-window {} {} {} {}}}
+catch {destroy .t2}
+test textWind-3.7 {EmbWinConfigure procedure} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ .t window create 1.3
+ list [catch {.t window configure 1.3 -window .t} msg] $msg
+} {1 {can't embed .t in .t}}
+test textWind-3.8 {EmbWinConfigure procedure} {
+ # This test checks for various errors when the text claims
+ # a window away from itself.
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ button .t.b -text "Hello!"
+ .t window create 1.4 -window .t.b
+ .t window create 1.6 -window .t.b
+ update
+ .t index .t.b
+} {1.6}
+
+.t delete 1.0 end
+frame .f -width 10 -height 20 -bg $color
+.t window create 1.0 -window .f
+test textWind-4.1 {AlignParseProc and AlignPrintProc procedures} {
+ .t window configure 1.0 -align baseline
+ .t window configure 1.0 -align
+} {-align {} {} center baseline}
+test textWind-4.2 {AlignParseProc and AlignPrintProc procedures} {
+ .t window configure 1.0 -align bottom
+ .t window configure 1.0 -align
+} {-align {} {} center bottom}
+test textWind-4.3 {AlignParseProc and AlignPrintProc procedures} {
+ .t window configure 1.0 -align center
+ .t window configure 1.0 -align
+} {-align {} {} center center}
+test textWind-4.4 {AlignParseProc and AlignPrintProc procedures} {
+ .t window configure 1.0 -align top
+ .t window configure 1.0 -align
+} {-align {} {} center top}
+test textWind-4.5 {AlignParseProc and AlignPrintProc procedures} {
+ .t window configure 1.0 -align top
+ list [catch {.t window configure 1.0 -align gorp} msg] $msg \
+ [.t window configure 1.0 -align]
+} {1 {bad alignment "gorp": must be baseline, bottom, center, or top} {-align {} {} center top}}
+
+test textWind-5.1 {EmbWinStructureProc procedure} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 10 -height 20 -bg $color
+ .t window create 1.2 -window .f
+ update
+ destroy .f
+ list [catch {.t index .f} msg] $msg [.t bbox 1.2] [.t bbox 1.3]
+} {1 {bad text index ".f"} {19 11 0 0} {19 5 7 13}}
+test textWind-5.2 {EmbWinStructureProc procedure} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 10 -height 20 -bg $color
+ .t window create 1.2 -align bottom
+ .t window configure 1.2 -window .f
+ update
+ destroy .f
+ list [catch {.t index .f} msg] $msg [.t bbox 1.2] [.t bbox 1.3]
+} {1 {bad text index ".f"} {19 18 0 0} {19 5 7 13}}
+test textWind-5.3 {EmbWinStructureProc procedure} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ .t window create 1.2 -create {frame .f -width 10 -height 20 -bg $color}
+ update
+ .t window configure 1.2 -create {frame .f -width 20 -height 10 -bg $color}
+ destroy .f
+ update
+ list [catch {.t index .f} msg] $msg [.t bbox 1.2] [.t bbox 1.3]
+} {0 1.2 {19 6 20 10} {39 5 7 13}}
+
+test textWind-6.1 {EmbWinRequestProc procedure} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 10 -height 20 -bg $color
+ .t window create 1.2 -window .f
+ set result {}
+ lappend result [.t bbox 1.2] [.t bbox 1.3]
+ .f configure -width 25 -height 30
+ lappend result [.t bbox 1.2] [.t bbox 1.3]
+} {{19 5 10 20} {29 8 7 13} {19 5 25 30} {44 13 7 13}}
+
+test textWind-7.1 {EmbWinLostSlaveProc procedure} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 10 -height 20 -bg $color
+ .t window create 1.2 -window .f
+ update
+ place .f -in .t -x 100 -y 50
+ update
+ list [winfo geom .f] [.t bbox 1.2]
+} {10x20+104+54 {19 11 0 0}}
+test textWind-7.2 {EmbWinLostSlaveProc procedure} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .t.f -width 10 -height 20 -bg $color
+ .t window create 1.2 -window .t.f
+ update
+ place .t.f -x 100 -y 50
+ update
+ list [winfo geom .t.f] [.t bbox 1.2]
+} {10x20+104+54 {19 11 0 0}}
+catch {destroy .f}
+catch {destroy .t.f}
+
+test textWind-8.1 {EmbWinDeleteProc procedure} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 10 -height 20 -bg $color
+ .t window create 1.2 -window .f
+ bind .f <Destroy> {set x destroyed}
+ set x XXX
+ .t delete 1.2
+ list $x [.t bbox 1.2] [.t bbox 1.3] [catch {.t index .f} msg] $msg \
+ [winfo exists .f]
+} {destroyed {19 5 7 13} {26 5 7 13} 1 {bad text index ".f"} 0}
+
+test textWind-9.1 {EmbWinCleanupProc procedure} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text\nA second line."
+ frame .f -width 10 -height 20 -bg $color
+ .t window create 2.3 -window .f
+ .t delete 1.5 2.1
+ .t index .f
+} 1.7
+
+proc bgerror args {
+ global msg
+ set msg $args
+}
+
+test textWind-10.1 {EmbWinLayoutProc procedure} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ .t window create 1.5 -create {
+ frame .f -width 10 -height 20 -bg $color
+ }
+ update
+ list [winfo exists .f] [winfo geom .f] [.t index .f]
+} {1 10x20+40+5 1.5}
+test textWind-10.2 {EmbWinLayoutProc procedure, error in creating window} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ .t window create 1.5 -create {
+ error "couldn't create window"
+ }
+ set msg xyzzy
+ update
+ list $msg [.t bbox 1.5]
+} {{{couldn't create window}} {40 11 0 0}}
+test textWind-10.3 {EmbWinLayoutProc procedure, error in creating window} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ .t window create 1.5 -create {
+ concat gorp
+ }
+ set msg xyzzy
+ update
+ list $msg [.t bbox 1.5]
+} {{{bad window path name "gorp"}} {40 11 0 0}}
+test textWind-10.4 {EmbWinLayoutProc procedure, error in creating window} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ .t window create 1.5 -create {
+ frame .t.f
+ frame .t.f.f -width 10 -height 20 -bg $color
+ }
+ set msg xyzzy
+ update
+ list $msg [.t bbox 1.5] [winfo exists .t.f.f]
+} {{{can't embed .t.f.f relative to .t}} {40 11 0 0} 1}
+catch {destroy .t.f}
+test textWind-10.5 {EmbWinLayoutProc procedure, error in creating window} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ .t window create 1.5 -create {
+ concat .t
+ }
+ set msg xyzzy
+ update
+ list $msg [.t bbox 1.5]
+} {{{can't embed .t relative to .t}} {40 11 0 0}}
+test textWind-10.6 {EmbWinLayoutProc procedure, error in creating window} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ .t window create 1.5 -create {
+ toplevel .t2 -width 100 -height 150
+ wm geom .t2 +0+0
+ concat .t2
+ }
+ set msg xyzzy
+ update
+ list $msg [.t bbox 1.5]
+} {{{can't embed .t2 relative to .t}} {40 11 0 0}}
+test textWind-10.7 {EmbWinLayoutProc procedure, steal window from self} {
+ .t delete 1.0 end
+ .t insert 1.0 ABCDEFGHIJKLMNOP
+ button .t.b -text "Hello!"
+ .t window create 1.5 -window .t.b
+ update
+ .t window create 1.3 -create {concat .t.b}
+ update
+ .t index .t.b
+} {1.3}
+catch {destroy .t2}
+test textWind-10.8 {EmbWinLayoutProc procedure, doesn't fit on line} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 125 -height 20 -bg $color -bd 2 -relief raised
+ .t window create 1.12 -window .f
+ list [.t bbox .f] [.t bbox 1.13]
+} {{89 5 126 20} {5 25 7 13}}
+test textWind-10.9 {EmbWinLayoutProc procedure, doesn't fit on line} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 126 -height 20 -bg $color -bd 2 -relief raised
+ .t window create 1.12 -window .f
+ update
+ list [.t bbox .f] [.t bbox 1.13]
+} {{89 5 126 20} {5 25 7 13}}
+test textWind-10.10 {EmbWinLayoutProc procedure, doesn't fit on line} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 127 -height 20 -bg $color -bd 2 -relief raised
+ .t window create 1.12 -window .f
+ update
+ list [.t bbox .f] [.t bbox 1.13]
+} {{5 18 127 20} {132 21 7 13}}
+test textWind-10.11 {EmbWinLayoutProc procedure, doesn't fit on line} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 130 -height 20 -bg $color -bd 2 -relief raised
+ .t window create 1.12 -window .f
+ update
+ list [.t bbox .f] [.t bbox 1.13]
+} {{89 5 126 20} {}}
+test textWind-10.12 {EmbWinLayoutProc procedure, doesn't fit on line} {fonts} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 130 -height 220 -bg $color -bd 2 -relief raised
+ .t window create 1.12 -window .f
+ update
+ list [.t bbox .f] [.t bbox 1.13]
+} {{89 5 126 78} {}}
+test textWind-10.13 {EmbWinLayoutProc procedure, doesn't fit on line} {fonts} {
+ .t configure -wrap char
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 250 -height 220 -bg $color -bd 2 -relief raised
+ .t window create 1.12 -window .f
+ update
+ list [.t bbox .f] [.t bbox 1.13]
+} {{5 18 210 65} {}}
+
+test textWind-11.1 {EmbWinDisplayProc procedure, geometry transforms} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ pack forget .t
+ place .t -x 30 -y 50
+ frame .f -width 30 -height 20 -bg $color
+ .t window create 1.12 -window .f
+ update
+ winfo geom .f
+} {30x20+119+55}
+place forget .t
+pack .t
+test textWind-11.2 {EmbWinDisplayProc procedure, geometry transforms} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ pack forget .t
+ place .t -x 30 -y 50
+ frame .t.f -width 30 -height 20 -bg $color
+ .t window create 1.12 -window .t.f
+ update
+ winfo geom .t.f
+} {30x20+89+5}
+place forget .t
+pack .t
+test textWind-11.3 {EmbWinDisplayProc procedure, configuration optimization} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 30 -height 20 -bg $color
+ .t window create 1.12 -window .f
+ update
+ bind .f <Configure> {set x ".f configured"}
+ set x {no configures}
+ .t delete 1.0
+ .t insert 1.0 "X"
+ update
+ set x
+} {no configures}
+test textWind-11.4 {EmbWinDisplayProc procedure, horizontal scrolling} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "xyzzy\nFirst window here: "
+ .t configure -wrap none
+ frame .f -width 30 -height 20 -bg $color
+ .t window create end -window .f
+ .t insert end " and second here: "
+ frame .f2 -width 40 -height 10 -bg $color
+ .t window create end -window .f2
+ .t insert end " with junk after it."
+ .t xview moveto 0
+ .t xview scroll 5 units
+ update
+ list [winfo ismapped .f] [winfo geom .f] [.t bbox .f] [winfo ismapped .f2]
+} {1 30x20+103+18 {103 18 30 20} 0}
+test textWind-11.5 {EmbWinDisplayProc procedure, horizontal scrolling} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "xyzzy\nFirst window here: "
+ .t configure -wrap none
+ frame .f -width 30 -height 20 -bg $color
+ .t window create end -window .f
+ .t insert end " and second here: "
+ frame .f2 -width 40 -height 10 -bg $color
+ .t window create end -window .f2
+ .t insert end " with junk after it."
+ update
+ .t xview moveto 0
+ .t xview scroll 25 units
+ update
+ list [winfo ismapped .f] [winfo ismapped .f2] [winfo geom .f2] [.t bbox .f2]
+} {0 1 40x10+119+23 {119 23 40 10}}
+.t configure -wrap char
+
+test textWind-12.1 {EmbWinUndisplayProc procedure, mapping/unmapping} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 30 -height 20 -bg $color
+ .t window create 1.2 -window .f
+ bind .f <Map> {lappend x mapped}
+ bind .f <Unmap> {lappend x unmapped}
+ set x created
+ update
+ lappend x modified
+ .t delete 1.0
+ update
+ lappend x replaced
+ .t window configure .f -window {}
+ .t delete 1.1
+ .t window create 1.4 -window .f
+ update
+ lappend x off-screen
+ .t configure -wrap none
+ .t insert 1.0 "Enough text to make the line run off-screen"
+ update
+ set x
+} {created mapped modified replaced unmapped mapped off-screen unmapped}
+
+test textWind-13.1 {EmbWinBboxProc procedure} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 5 -height 5 -bg $color
+ .t window create 1.2 -window .f -align top -padx 2 -pady 1
+ update
+ list [winfo geom .f] [.t bbox .f]
+} {5x5+21+6 {21 6 5 5}}
+test textWind-13.2 {EmbWinBboxProc procedure} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 5 -height 5 -bg $color
+ .t window create 1.2 -window .f -align center -padx 2 -pady 1
+ update
+ list [winfo geom .f] [.t bbox .f]
+} {5x5+21+9 {21 9 5 5}}
+test textWind-13.3 {EmbWinBboxProc procedure} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 5 -height 5 -bg $color
+ .t window create 1.2 -window .f -align baseline -padx 2 -pady 1
+ update
+ list [winfo geom .f] [.t bbox .f]
+} {5x5+21+10 {21 10 5 5}}
+test textWind-13.4 {EmbWinBboxProc procedure} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 5 -height 5 -bg $color
+ .t window create 1.2 -window .f -align bottom -padx 2 -pady 1
+ update
+ list [winfo geom .f] [.t bbox .f]
+} {5x5+21+12 {21 12 5 5}}
+test textWind-13.5 {EmbWinBboxProc procedure} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 5 -height 5 -bg $color
+ .t window create 1.2 -window .f -align top -padx 2 -pady 1 -stretch 1
+ update
+ list [winfo geom .f] [.t bbox .f]
+} {5x11+21+6 {21 6 5 11}}
+test textWind-13.6 {EmbWinBboxProc procedure} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 5 -height 5 -bg $color
+ .t window create 1.2 -window .f -align center -padx 2 -pady 1 -stretch 1
+ update
+ list [winfo geom .f] [.t bbox .f]
+} {5x11+21+6 {21 6 5 11}}
+test textWind-13.7 {EmbWinBboxProc procedure} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 5 -height 5 -bg $color
+ .t window create 1.2 -window .f -align baseline -padx 2 -pady 1 -stretch 1
+ update
+ list [winfo geom .f] [.t bbox .f]
+} {5x9+21+6 {21 6 5 9}}
+test textWind-13.8 {EmbWinBboxProc procedure} {fonts} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 5 -height 5 -bg $color
+ .t window create 1.2 -window .f -align bottom -padx 2 -pady 1 -stretch 1
+ update
+ list [winfo geom .f] [.t bbox .f]
+} {5x11+21+6 {21 6 5 11}}
+test textWind-13.9 {EmbWinBboxProc procedure, spacing options} {
+ .t configure -spacing1 5 -spacing3 2
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 5 -height 5 -bg $color
+ .t window create 1.2 -window .f -align center -padx 2 -pady 1
+ update
+ list [winfo geom .f] [.t bbox .f]
+} {5x5+21+14 {21 14 5 5}}
+.t configure -spacing1 0 -spacing2 0 -spacing3 0
+
+test textWind-14.1 {EmbWinDelayedUnmap procedure} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 30 -height 20 -bg $color
+ .t window create 1.2 -window .f
+ update
+ bind .f <Unmap> {lappend x unmapped}
+ set x modified
+ .t insert 1.0 x
+ lappend x removed
+ .t window configure .f -window {}
+ lappend x updated
+ update
+ set x
+} {modified removed unmapped updated}
+catch {destroy .f}
+test textWind-14.2 {EmbWinDelayedUnmap procedure} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 30 -height 20 -bg $color
+ .t window create 1.2 -window .f
+ update
+ bind .f <Unmap> {lappend x unmapped}
+ set x modified
+ .t insert 1.0 x
+ lappend x deleted
+ .t delete .f
+ lappend x updated
+ update
+ set x
+} {modified deleted updated}
+test textWind-14.3 {EmbWinDelayedUnmap procedure} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text\nAnother line\n3\n4\n5\n6\n7\n8\n9"
+ frame .f -width 30 -height 20 -bg $color
+ .t window create 1.2 -window .f
+ update
+ .t yview 2.0
+ set result [winfo ismapped .f]
+ update
+ list $result [winfo ismapped .f]
+} {1 0}
+test textWind-14.4 {EmbWinDelayedUnmap procedure} {
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text\nAnother line\n3\n4\n5\n6\n7\n8\n9"
+ frame .t.f -width 30 -height 20 -bg $color
+ .t window create 1.2 -window .t.f
+ update
+ .t yview 2.0
+ set result [winfo ismapped .t.f]
+ update
+ list $result [winfo ismapped .t.f]
+} {1 0}
+catch {destroy .t.f}
+catch {destroy .f}
+
+test textWind-15.1 {TkTextWindowIndex procedure} {
+ list [catch {.t index .foo} msg] $msg
+} {1 {bad text index ".foo"}}
+test textWind-15.2 {TkTextWindowIndex procedure} {fonts} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 30 -height 20 -bg $color
+ .t window create 1.6 -window .f
+ .t tag add a 1.1
+ .t tag add a 1.3
+ list [.t index .f] [.t bbox 1.7]
+} {1.6 {77 8 7 13}}
+
+test textWind-16.1 {EmbWinTextStructureProc procedure} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 30 -height 20 -bg $color
+ .t window create 1.6 -window .f
+ update
+ pack forget .t
+ update
+ winfo ismapped .f
+} 0
+pack .t
+test textWind-16.2 {EmbWinTextStructureProc procedure} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .f -width 30 -height 20 -bg $color
+ .t window create 1.6 -window .f
+ update
+ set result {}
+ lappend result [winfo geom .f] [.t bbox .f]
+ frame .f2 -width 150 -height 30 -bd 2 -relief raised
+ pack .f2 -before .t
+ update
+ lappend result [winfo geom .f] [.t bbox .f]
+} {30x20+47+5 {47 5 30 20} 30x20+47+35 {47 5 30 20}}
+catch {destroy .f2}
+test textWind-16.3 {EmbWinTextStructureProc procedure} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ .t window create 1.6
+ update
+ pack forget .t
+ update
+} {}
+pack .t
+test textWind-16.4 {EmbWinTextStructureProc procedure} {
+ .t configure -wrap none
+ .t delete 1.0 end
+ .t insert 1.0 "Some sample text"
+ frame .t.f -width 30 -height 20 -bg $color
+ .t window create 1.6 -window .t.f
+ update
+ pack forget .t
+ update
+ list [winfo ismapped .t.f] [.t bbox .t.f]
+} {1 {47 5 30 20}}
+pack .t
+
+catch {destroy .t}
+option clear
diff --git a/tk/tests/tk.test b/tk/tests/tk.test
new file mode 100644
index 00000000000..408ce7173cf
--- /dev/null
+++ b/tk/tests/tk.test
@@ -0,0 +1,80 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+} {foobazgarply}
+test tk-2.3 {tk command: appname} {unixOnly} {
+ tk appname bazfoogarply
+ expr {[lsearch -exact [winfo interps] [tk appname]] >= 0}
+} {1}
+test tk-2.4 {tk command: appname} {
+ tk appname $appname
+} $appname
+tk appname $appname
+
+set scaling [tk scaling]
+test tk-3.1 {tk command: scaling} {
+ list [catch {tk scaling -displayof} msg] $msg
+} {1 {value for "-displayof" missing}}
+test tk-3.2 {tk command: scaling: get current} {
+ tk scaling 1
+ format %.2g [tk scaling]
+} 1
+test tk-3.3 {tk command: scaling: get current} {
+ tk scaling -displayof . 1.25
+ format %.3g [tk scaling]
+} 1.25
+test tk-3.4 {tk command: scaling: set new} {
+ list [catch {tk scaling xyz} msg] $msg
+} {1 {expected floating-point number but got "xyz"}}
+test tk-3.5 {tk command: scaling: set new} {
+ list [catch {tk scaling -displayof . xyz} msg] $msg
+} {1 {expected floating-point number but got "xyz"}}
+test tk-3.6 {tk command: scaling: set new} {
+ tk scaling 1
+ format %.2g [tk scaling]
+} 1
+test tk-3.7 {tk command: scaling: set new} {
+ tk scaling -displayof . 1.25
+ format %.3g [tk scaling]
+} 1.25
+test tk-3.8 {tk command: scaling: negative} {
+ tk scaling -1
+ expr {[tk scaling] > 0}
+} {1}
+test tk-3.9 {tk command: scaling: too big} {
+ tk scaling 1000000
+ expr {[tk scaling] < 10000}
+} {1}
+test tk-3.10 {tk command: scaling: widthmm} {
+ tk scaling 1.25
+ 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
diff --git a/tk/tests/unixButton.test b/tk/tests/unixButton.test
new file mode 100644
index 00000000000..1ee15affafd
--- /dev/null
+++ b/tk/tests/unixButton.test
@@ -0,0 +1,182 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+# like border width have predictable values.
+
+option add *Label.borderWidth 2
+option add *Label.highlightThickness 0
+option add *Label.font {Helvetica -12 bold}
+option add *Button.borderWidth 2
+option add *Button.highlightThickness 2
+option add *Button.font {Helvetica -12 bold}
+option add *Checkbutton.borderWidth 2
+option add *Checkbutton.highlightThickness 2
+option add *Checkbutton.font {Helvetica -12 bold}
+option add *Radiobutton.borderWidth 2
+option add *Radiobutton.highlightThickness 2
+option add *Radiobutton.font {Helvetica -12 bold}
+
+
+proc bogusTrace args {
+ error "trace aborted"
+}
+catch {unset value}
+catch {unset value2}
+
+eval image delete [image names]
+image create test image1
+label .l -text Label
+button .b -text Button
+checkbutton .c -text Checkbutton
+radiobutton .r -text Radiobutton
+pack .l .b .c .r
+update
+
+test unixbutton-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 74 54 112 52 112 52}
+test unixbutton-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 29 39 54 37 54 37}
+test unixbutton-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 -highlightthickness 1 \
+ -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 25 35 25 35 25 35}
+test unixbutton-1.4 {TkpComputeButtonGeometry procedure} {nonPortable fonts} {
+ eval destroy [winfo children .]
+ label .b1 -text Xagqpim -padx 0 -pady 2 -font {Helvetica -18 bold}
+ button .b2 -text Xagqpim -padx 0 -pady 2 -font {Helvetica -18 bold}
+ checkbutton .b3 -text Xagqpim -padx 1 -pady 1 -font {Helvetica -18 bold}
+ radiobutton .b4 -text Xagqpim -padx 2 -pady 0 -font {Helvetica -18 bold}
+ 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]
+} {82 29 88 35 114 31 121 29}
+test unixbutton-1.5 {TkpComputeButtonGeometry procedure} {nonPortable fonts} {
+ 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]
+} {136 88}
+test unixbutton-1.6 {TkpComputeButtonGeometry procedure} {nonPortable fonts} {
+ 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]
+} {231 46}
+test unixbutton-1.7 {TkpComputeButtonGeometry procedure} {nonPortable fonts} {
+ 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 22 60 84 168 38 61 22}
+test unixbutton-1.8 {TkpComputeButtonGeometry procedure} {nonPortable fonts} {
+ 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]
+} {62 30 56 24 58 22 62 22}
+test unixbutton-1.9 {TkpComputeButtonGeometry procedure} {
+ eval destroy [winfo children .]
+ button .b2 -bitmap question -default active
+ list [winfo reqwidth .b2] [winfo reqheight .b2]
+} {37 47}
+test unixbutton-1.10 {TkpComputeButtonGeometry procedure} {
+ eval destroy [winfo children .]
+ button .b2 -bitmap question -default normal
+ list [winfo reqwidth .b2] [winfo reqheight .b2]
+} {37 47}
+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 .]
diff --git a/tk/tests/unixEmbed.test b/tk/tests/unixEmbed.test
new file mode 100644
index 00000000000..824c8833828
--- /dev/null
+++ b/tk/tests/unixEmbed.test
@@ -0,0 +1,627 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {$tcl_platform(platform) != "unix"} {
+ return
+}
+
+if {[info procs test] != "test"} {
+ source defs
+}
+
+eval destroy [winfo children .]
+wm geometry . {}
+raise .
+
+setupbg
+dobg {wm withdraw .}
+
+# 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.
+
+proc eatColors {w} {
+ catch {destroy $w}
+ toplevel $w
+ wm geom $w +0+0
+ canvas $w.c -width 400 -height 200 -bd 0
+ pack $w.c
+ for {set y 0} {$y < 8} {incr y} {
+ for {set x 0} {$x < 40} {incr x} {
+ set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0]
+ $w.c create rectangle [expr 10*$x] [expr 20*$y] \
+ [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \
+ -fill $color
+ }
+ }
+ update
+}
+
+# colorsFree --
+#
+# Returns 1 if there appear to be free colormap entries in a window,
+# 0 otherwise.
+#
+# Arguments:
+# w - Name of window in which to check.
+# red, green, blue - Intensities to use in a trial color allocation
+# to see if there are colormap entries free.
+
+proc colorsFree {w {red 31} {green 245} {blue 192}} {
+ set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]]
+ expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) \
+ && ([lindex $vals 2]/256 == $blue)
+}
+
+test unixEmbed-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 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}
+
+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."
+ 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 {
+ eval destroy [winfo child .]
+ toplevel .t -use $w
+ list [testembed] [expr [lindex [lindex [testembed all] 0] 0] - $w]
+ }
+} {{{XXX {} {} .t}} 0}
+test unixEmbed-1.6 {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 w1 [winfo id .f1]"
+ dobg "set w2 [winfo id .f2]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ toplevel .t2 -use $w2
+ testembed
+ }
+} {{XXX {} {} .t2} {XXX {} {} .t1}}
+test unixEmbed-1.7 {TkpUseWindow procedure, container and embedded in same app} {
+ eval destroy [winfo child .]
+ frame .f1 -container 1 -width 200 -height 50
+ frame .f2 -container 1 -width 200 -height 50
+ pack .f1 .f2
+ toplevel .t1 -use [winfo id .f1]
+ toplevel .t2 -use [winfo id .f2]
+ testembed
+} {{XXX .f2 {} .t2} {XXX .f1 {} .t1}}
+
+# Can't think of any way to test the procedures TkpMakeWindow,
+# TkpMakeContainer, or EmbedErrorProc.
+
+test unixEmbed-2.1 {EmbeddedEventProc procedure} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ testembed
+ }
+ destroy .f1
+ update
+ dobg {
+ testembed
+ }
+} {}
+test unixEmbed-2.2 {EmbeddedEventProc procedure} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ testembed
+ destroy .t1
+ testembed
+ }
+} {}
+test unixEmbed-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 .f1
+ testembed
+} {}
+test unixEmbed-2.4 {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
+ set x [testembed]
+ update
+ list $x [testembed]
+} {{{XXX .f1 {} {}}} {}}
+
+test unixEmbed-3.1 {ContainerEventProc procedure, detect creation} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ set x [testembed]
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ wm withdraw .t1
+ }
+ list $x [testembed]
+} {{{XXX .f1 {} {}}} {{XXX .f1 XXX {}}}}
+test unixEmbed-3.2 {ContainerEventProc procedure, set size on creation} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ toplevel .t1 -container 1
+ wm geometry .t1 +0+0
+ toplevel .t2 -use [winfo id .t1] -bg red
+ update
+ wm geometry .t2
+} {200x200+0+0}
+test unixEmbed-3.2 {ContainerEventProc procedure, disallow position changes} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1 -bd 2 -relief raised
+ update
+ wm geometry .t1 +30+40
+ }
+ update
+ dobg {
+ wm geometry .t1
+ }
+} {200x200+0+0}
+test unixEmbed-3.3 {ContainerEventProc procedure, disallow position changes} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ update
+ wm geometry .t1 300x100+30+40
+ }
+ update
+ dobg {
+ wm geometry .t1
+ }
+} {300x100+0+0}
+test unixEmbed-3.4 {ContainerEventProc procedure, geometry requests} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ }
+ update
+ dobg {
+ .t1 configure -width 300 -height 80
+ }
+ update
+ list [winfo width .f1] [winfo height .f1] [dobg {wm geometry .t1}]
+} {300 80 300x80+0+0}
+test unixEmbed-3.5 {ContainerEventProc procedure, map requests} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ set x unmapped
+ bind .t1 <Map> {set x mapped}
+ }
+ update
+ dobg {
+ after 100
+ update
+ set x
+ }
+} {mapped}
+test unixEmbed-3.6 {ContainerEventProc procedure, destroy events} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ bind .f1 <Destroy> {set x dead}
+ set x alive
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ }
+ update
+ dobg {
+ destroy .t1
+ }
+ update
+ list $x [winfo exists .f1]
+} {dead 0}
+
+test unixEmbed-4.1 {EmbedStructureProc procedure, configure events} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ }
+ update
+ dobg {
+ .t1 configure -width 180 -height 100
+ }
+ update
+ dobg {
+ winfo geometry .t1
+ }
+} {180x100+0+0}
+test unixEmbed-4.2 {EmbedStructureProc procedure, destroy events} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ }
+ update
+ set x [testembed]
+ destroy .f1
+ list $x [testembed]
+} {{{XXX .f1 XXX {}}} {}}
+
+test unixEmbed-5.1 {EmbedFocusProc procedure, FocusIn events} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ bind .t1 <FocusIn> {lappend x "focus in %W"}
+ bind .t1 <FocusOut> {lappend x "focus out %W"}
+ set x {}
+ }
+ focus -force .f1
+ update
+ dobg {set x}
+} {{focus in .t1}}
+test unixEmbed-5.2 {EmbedFocusProc procedure, focusing on dead window} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ }
+ update
+ dobg {
+ after 200 {destroy .t1}
+ }
+ after 400
+ focus -force .f1
+ update
+} {}
+test unixEmbed-5.3 {EmbedFocusProc procedure, FocusOut events} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ bind .t1 <FocusIn> {lappend x "focus in %W"}
+ bind .t1 <FocusOut> {lappend x "focus out %W"}
+ set x {}
+ }
+ focus -force .f1
+ update
+ set x [dobg {update; set x}]
+ focus .
+ update
+ list $x [dobg {update; set x}]
+} {{{focus in .t1}} {{focus in .t1} {focus out .t1}}}
+
+test unixEmbed-6.1 {EmbedGeometryRequest procedure, window changes size} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ }
+ update
+ dobg {
+ bind .t1 <Configure> {lappend x {configure .t1 %w %h}}
+ set x {}
+ .t1 configure -width 300 -height 120
+ update
+ list $x [winfo geom .t1]
+ }
+} {{{configure .t1 300 120}} 300x120+0+0}
+test unixEmbed-6.2 {EmbedGeometryRequest procedure, window changes size} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ place .f1 -width 200 -height 200
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ }
+ after 300 {set x done}
+ vwait x
+ dobg {
+ bind .t1 <Configure> {lappend x {configure .t1 %w %h}}
+ set x {}
+ .t1 configure -width 300 -height 120
+ update
+ list $x [winfo geom .t1]
+ }
+} {{{configure .t1 200 200}} 200x200+0+0}
+
+# Can't think up any tests for TkpGetOtherWindow procedure.
+
+test unixEmbed-7.1 {TkpRedirectKeyEvent procedure, forward keystroke} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ }
+ focus -force .
+ bind . <KeyPress> {lappend x {key %A %E}}
+ set x {}
+ set y [dobg {
+ update
+ bind .t1 <KeyPress> {lappend y {key %A}}
+ set y {}
+ event generate .t1 <KeyPress> -keysym a
+ set y
+ }]
+ update
+ bind . <KeyPress> {}
+ list $x $y
+} {{{key a 1}} {}}
+test unixEmbed-7.2 {TkpRedirectKeyEvent procedure, don't forward keystroke width} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1
+ }
+ update
+ focus -force .f1
+ update
+ bind . <KeyPress> {lappend x {key %A}}
+ set x {}
+ set y [dobg {
+ update
+ bind .t1 <KeyPress> {lappend y {key %A}}
+ set y {}
+ event generate .t1 <KeyPress> -keysym b
+ set y
+ }]
+ update
+ bind . <KeyPress> {}
+ list $x $y
+} {{} {{key b}}}
+
+test unixEmbed-8.1 {TkpClaimFocus procedure} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ frame .f2 -width 200 -height 50
+ pack .f1 .f2
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken
+ }
+ focus -force .f2
+ update
+ list [dobg {
+ focus .t1
+ set x [list [focus]]
+ update
+ after 500
+ update
+ lappend x [focus]
+ }] [focus]
+} {{{} .t1} .f1}
+test unixEmbed-8.2 {TkpClaimFocus procedure} {
+ 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
+ interp create child
+ child eval "set argv {-use [winfo id .f1]}"
+ load {} tk child
+ child eval {
+ . configure -bd 2 -highlightthickness 2 -relief sunken
+ }
+ focus -force .f2
+ update
+ list [child eval {
+ focus .
+ set x [list [focus]]
+ update
+ lappend x [focus]
+ }] [focus]
+} {{{} .} .f1}
+catch {interp delete child}
+
+test unixEmbed-9.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 unixEmbed-9.2 {EmbedWindowDeleted procedure, check embeddedPtr} {
+ foreach w [winfo child .] {
+ catch {destroy $w}
+ }
+ frame .f1 -container 1 -width 200 -height 50
+ pack .f1
+ dobg "set w1 [winfo id .f1]"
+ dobg {
+ eval destroy [winfo child .]
+ toplevel .t1 -use $w1 -highlightthickness 2 -bd 2 -relief sunken
+ set x {}
+ lappend x [testembed]
+ destroy .t1
+ lappend x [testembed]
+ }
+} {{{XXX {} {} .t1}} {}}
+
+test unixEmbed-10.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 unixEmbed-10.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}
+}
+cleanupbg
diff --git a/tk/tests/unixFont.test b/tk/tests/unixFont.test
new file mode 100644
index 00000000000..7df571a69a4
--- /dev/null
+++ b/tk/tests/unixFont.test
@@ -0,0 +1,293 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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.
+
+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 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]"
+}
+
+test unixfont-1.1 {TkpGetNativeFont procedure: not native} {
+ list [catch {font measure {} xyz} msg] $msg
+} {1 {font "" doesn't exist}}
+test unixfont-1.2 {TkpGetNativeFont procedure: native} {
+ font measure fixed 0
+} {6}
+
+test unixfont-2.1 {TkpGetFontFromAttributes procedure: no family} {
+ font actual {-size 10}
+ set x {}
+} {}
+test unixfont-2.2 {TkpGetFontFromAttributes procedure: Times relatives} {
+ set x {}
+ lappend x [lindex [font actual {-family "Times New Roman"}] 1]
+ lappend x [lindex [font actual {-family "New York"}] 1]
+ lappend x [lindex [font actual {-family "Times"}] 1]
+} {times times times}
+test unixfont-2.3 {TkpGetFontFromAttributes procedure: Courier relatives} {
+ set x {}
+ lappend x [lindex [font actual {-family "Courier New"}] 1]
+ lappend x [lindex [font actual {-family "Monaco"}] 1]
+ lappend x [lindex [font actual {-family "Courier"}] 1]
+} {courier courier courier}
+test unixfont-2.4 {TkpGetFontFromAttributes procedure: Helvetica relatives} {
+ set x {}
+ lappend x [lindex [font actual {-family "Arial"}] 1]
+ lappend x [lindex [font actual {-family "Geneva"}] 1]
+ lappend x [lindex [font actual {-family "Helvetica"}] 1]
+} {helvetica helvetica helvetica}
+test unixfont-2.5 {TkpGetFontFromAttributes procedure: fallback} {
+ font actual {-xyz-xyz-*-*-*-*-*-*-*-*-*-*-*-*}
+ set x {}
+} {}
+test unixfont-2.6 {TkpGetFontFromAttributes: fallback to fixed family} {
+ lindex [font actual {-family fixed -size 10}] 1
+} {fixed}
+test unixfont-2.7 {TkpGetFontFromAttributes: fixed family not available!} {
+ # no test available
+} {}
+test unixfont-2.8 {TkpGetFontFromAttributes: loop over returned font names} {
+ lindex [font actual {-family fixed -size 31}] 1
+} {fixed}
+test unixfont-2.9 {TkpGetFontFromAttributes: reject adobe courier if possible} {
+ lindex [font actual {-family courier}] 1
+} {courier}
+test unixfont-2.10 {TkpGetFontFromAttributes: scalable font found} {
+ lindex [font actual {-family courier -size 37}] 3
+} {37}
+test unixfont-2.11 {TkpGetFontFromAttributes: font cannot be loaded} {
+ # On Linux, XListFonts() was returning names for fonts that do not
+ # actually exist, causing the subsequent XLoadQueryFont() to fail
+ # unexpectedly. Now falls back to another font if that happens.
+
+ font actual {-size 14}
+ set x {}
+} {}
+
+test unixfont-3.1 {TkpDeleteFont procedure} {
+ font actual {-family xyz}
+ set x {}
+} {}
+
+test unixfont-4.1 {TkpGetFontFamilies procedure} {
+ font families
+ set x {}
+} {}
+
+test unixfont-5.1 {Tk_MeasureChars procedure: no chars to be measured} {
+ .b.l config -text "000000" -wrap [expr $ax*3]
+ .b.l config -wrap 0
+} {}
+test unixfont-5.2 {Tk_MeasureChars procedure: no right margin} {
+ .b.l config -text "000000"
+} {}
+test unixfont-5.3 {Tk_MeasureChars procedure: loop over chars} {
+ .b.l config -text "0"
+ .b.l config -text "\377"
+ .b.l config -text "0\3770\377"
+ .b.l config -text "000000000000000"
+} {}
+.b.l config -wrap [expr $ax*10]
+test unixfont-5.4 {Tk_MeasureChars procedure: reached right edge} {
+ .b.l config -text "0000000000000"
+ getsize
+} "[expr $ax*10] [expr $ay*2]"
+test unixfont-5.5 {Tk_MeasureChars procedure: ran out of chars} {
+ .b.l config -text "000000"
+ getsize
+} "[expr $ax*6] $ay"
+test unixfont-5.6 {Tk_MeasureChars procedure: find last word} {
+ .b.l config -text "000000 00000"
+ getsize
+} "[expr $ax*6] [expr $ay*2]"
+test unixfont-5.7 {Tk_MeasureChars procedure: already saw space in line} {
+ .b.l config -text "000000 00000"
+ getsize
+} "[expr $ax*6] [expr $ay*2]"
+test unixfont-5.8 {Tk_MeasureChars procedure: internal spaces significant} {
+ .b.l config -text "00 000 00000"
+ getsize
+} "[expr $ax*7] [expr $ay*2]"
+test unixfont-5.9 {Tk_MeasureChars procedure: TK_PARTIAL_OK} {
+ .b.c dchars $t 0 end
+ .b.c insert $t 0 "0000"
+ .b.c index $t @[expr int($ax*2.5)],1
+} {2}
+test unixfont-5.10 {Tk_MeasureChars procedure: TK_AT_LEAST_ONE} {
+ .b.l config -text "000000000000"
+ getsize
+} "[expr $ax*10] [expr $ay*2]"
+test unixfont-5.11 {Tk_MeasureChars: TK_AT_LEAST_ONE + not even one char fit!} {
+ set a [.b.l cget -wrap]
+ .b.l config -text "000000" -wrap 1
+ set x [getsize]
+ .b.l config -wrap $a
+ set x
+} "$ax [expr $ay*6]"
+test unixfont-5.12 {Tk_MeasureChars procedure: include eol spaces} {
+ .b.l config -text "000 \n000"
+ getsize
+} "[expr $ax*6] [expr $ay*2]"
+
+test unixfont-6.1 {Tk_DrawChars procedure: loop test} {
+ .b.l config -text "a"
+ update
+} {}
+test unixfont-6.2 {Tk_DrawChars procedure: loop test} {
+ .b.l config -text "abcd"
+ update
+} {}
+test unixfont-6.3 {Tk_DrawChars procedure: special char} {
+ .b.l config -text "\001"
+ update
+} {}
+test unixfont-6.4 {Tk_DrawChars procedure: normal then special} {
+ .b.l config -text "ab\001"
+ update
+} {}
+test unixfont-6.5 {Tk_DrawChars procedure: ends with special} {
+ .b.l config -text "ab\001"
+ update
+} {}
+test unixfont-6.6 {Tk_DrawChars procedure: more normal chars at end} {
+ .b.l config -text "ab\001def"
+ update
+} {}
+
+test unixfont-7.1 {DrawChars procedure: no effects} {
+ .b.l config -text "abc"
+ update
+} {}
+test unixfont-7.2 {DrawChars procedure: underlining} {
+ set f [.b.l cget -font]
+ .b.l config -text "abc" -font "courier 10 underline"
+ update
+ .b.l config -font $f
+} {}
+test unixfont-7.3 {DrawChars procedure: overstrike} {
+ set f [.b.l cget -font]
+ .b.l config -text "abc" -font "courier 10 overstrike"
+ update
+ .b.l config -font $f
+} {}
+
+test unixfont-8.1 {AllocFont procedure: use old font} {
+ font create xyz
+ 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
+ incr x [font measure $courier "\012"] ;# 2
+ set x
+} [expr $cx*10]
+test unixfont-8.7 {AllocFont procedure: XA_UNDERLINE_POSITION} {
+ catch {font actual -adobe-courier-bold-i-normal--0-0-0-0-m-0-iso8859-1}
+ set x {}
+} {}
+test unixfont-8.8 {AllocFont procedure: no XA_UNDERLINE_POSITION} {
+ catch {font actual --symbol-medium-r-normal--0-0-0-0-p-0-sun-fontspecific}
+ set x {}
+} {}
+test unixfont-8.9 {AllocFont procedure: XA_UNDERLINE_THICKNESS} {
+ catch {font actual -adobe-courier-bold-i-normal--0-0-0-0-m-0-iso8859-1}
+ set x {}
+} {}
+test unixfont-8.10 {AllocFont procedure: no XA_UNDERLINE_THICKNESS} {
+ catch {font actual --symbol-medium-r-normal--0-0-0-0-p-0-sun-fontspecific}
+ set x {}
+} {}
+test unixfont-8.11 {AllocFont procedure: XA_UNDERLINE_POSITION was 0} {
+ catch {font actual -adobe-courier-bold-i-normal--0-0-0-0-m-0-iso8859-1}
+ set x {}
+} {}
+
+test unixfont-9.1 {GetControlCharSubst procedure: 2 chars subst} {
+ .b.c dchars $t 0 end
+ .b.c insert $t 0 "0\a0"
+ 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]
+} {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}
+
diff --git a/tk/tests/unixMenu.test b/tk/tests/unixMenu.test
new file mode 100644
index 00000000000..ed4532d7851
--- /dev/null
+++ b/tk/tests/unixMenu.test
@@ -0,0 +1,969 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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 .
+
+test unixMenu-1.1 {TkpNewMenu - normal menu} {
+ catch {destroy .m1}
+ list [catch {menu .m1} msg] $msg [destroy .m1]
+} {0 .m1 {}}
+test unixMenu-1.2 {TkpNewMenu - help menu} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ . configure -menu .m1
+ .m1 add cascade -label Help -menu .m1.help
+ list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 .m1.help {} {}}
+
+test unixMenu-2.1 {TkpDestroyMenu - nothing to do} {} {}
+test unixMenu-3.1 {TkpDestroymenuEntry - nothing to do} {} {}
+
+test unixMenu-4.1 {TkpConfigureMenuEntry - non-cascade entry} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add command -label test
+ list [catch {.m1 entryconfigure test -label foo} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-4.2 {TkpConfigureMenuEntry - cascade entry} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -menu .m2 -label test
+ menu .m1.foo -tearoff 0
+ list [catch {.m1 entryconfigure test -menu .m1.foo} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test unixMenu-5.1 {TkpMenuNewEntry - nothing to do} {} {}
+
+test unixMenu-6.1 {TkpSetWindowMenuBar - null menu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label foo
+ . configure -menu .m1
+ list [catch {. configure -menu ""} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-6.2 {TkpSetWindowMenuBar - menu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label foo
+ list [catch {. configure -menu .m1} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+
+test unixMenu-7.1 {TkpSetMainMenubar - nothing to do} {} {}
+
+test unixMenu-8.1 {GetMenuIndicatorGeometry - indicator off} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo -indicatoron 0
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test unixMenu-8.2 {GetMenuIndicatorGeometry - not checkbutton or radio} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test unixMenu-8.3 {GetMenuIndicatorGeometry - checkbutton image} {
+ catch {destroy .m1}
+ catch {image delete image1}
+ menu .m1
+ image create test image1
+ .m1 add checkbutton -image image1 -label foo
+ .m1 invoke foo
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] [image delete image1]
+} {0 {} {}}
+test unixMenu-8.4 {GetMenuIndicatorGeometry - checkbutton bitmap} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -bitmap questhead -label foo
+ .m1 invoke foo
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test unixMenu-8.5 {GetMenuIndicatorGeometry - checkbutton} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ .m1 invoke foo
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test unixMenu-8.6 {GetMenuIndicatorGeometry - radiobutton image} {
+ catch {destroy .m1}
+ catch {image delete image1}
+ menu .m1
+ image create test image1
+ .m1 add radiobutton -image image1 -label foo
+ .m1 invoke foo
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1] [image delete image1]
+} {0 {} {}}
+test unixMenu-8.7 {GetMenuIndicatorGeometry - radiobutton bitmap} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -bitmap questhead -label foo
+ .m1 invoke foo
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test unixMenu-8.8 {GetMenuIndicatorGeometry - radiobutton} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label foo
+ .m1 invoke foo
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test unixMenu-8.9 {GetMenuIndicatorGeometry - hideMargin} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label foo -hidemargin 1
+ .m1 invoke foo
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+
+test unixMenu-9.1 {GetMenuAccelGeometry - cascade entry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label foo
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test unixMenu-9.2 {GetMenuAccelGeometry - non-null label} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Ctrl+S"
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+test unixMenu-9.3 {GetMenuAccelGeometry - null label} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+
+test unixMenu-10.1 {DrawMenuEntryBackground - active menubar} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label foo
+ . configure -menu .m1
+ .m1 activate 1
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-10.2 {DrawMenuEntryBackground - active} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ $tearoff activate 0
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-10.3 {DrawMenuEntryBackground - non-active} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test unixMenu-11.1 {DrawMenuEntryAccelerator - menubar} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Ctrl+U"
+ . configure -menu .m1
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+# drawArrow parameter is never false under Unix
+test unixMenu-11.2 {DrawMenuEntryAccelerator - cascade entry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-11.3 {DrawMenuEntryAccelerator - normal entry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -accel "Ctrl+U"
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-11.4 {DrawMenuEntryAccelerator - null entry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test unixMenu-12.1 {DrawMenuEntryIndicator - non-check or radio} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-12.2 {DrawMenuEntryIndicator - checkbutton - indicator off} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo -indicatoron 0
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-12.3 {DrawMenuEntryIndicator - checkbutton - not selected} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-12.4 {DrawMenuEntryIndicator - checkbutton - selected} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label foo
+ .m1 invoke 1
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-12.5 {DrawMenuEntryIndicator - radiobutton - indicator off} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label foo -indicatoron 0
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-12.6 {DrawMenuEntryIndicator - radiobutton - not selected} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+test unixMenu-12.7 {DrawMenuEntryIndicator - radiobutton - selected} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add radiobutton -label foo
+ .m1 invoke 1
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test unixMenu-13.1 {DrawMenuSeparator - menubar case} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ . configure -menu .m1
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-13.2 {DrawMenuSepartor - normal menu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test unixMenu-14.1 {DrawMenuEntryLabel} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test unixMenu-15.1 {DrawMenuUnderline - menubar} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -underline 0
+ . configure -menu .m1
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-15.2 {DrawMenuUnderline - no menubar} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo -underline 0
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test unixMenu-16.1 {TkpPostMenu} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+
+test unixMenu-17.1 {GetMenuSeparatorGeometry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ list [catch {tkTearOffMenu .m1 40 40}] [destroy .m1]
+} {0 {}}
+
+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]
+} {0 {} {} {}}
+# Don't know how to generate one width windows
+test unixMenu-19.2 {TkpComputeMenubarGeometry - one entry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label File
+ . configure -menu .m1
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.3 {TkpComputeMenubarGeometry - entry with different font} {
+ catch {destroy .m1}
+ menu .m1 -font "Courier 24"
+ .m1 add cascade -label File -font "Helvetica 18"
+ . configure -menu .m1
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.4 {TkpComputeMenubarGeometry - separator} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ . configure -menu .m1
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.5 {TkpComputeMenubarGeometry - First entry} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label File
+ . configure -menu .m1
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.6 {TkpComputeMenubarGeometry - First entry too wide} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label File -font "Times 72"
+ . configure -menu .m1
+ wm geometry . 10x10
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.7 {TkpComputeMenubarGeometry - two entries fit} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label File
+ .m1 add cascade -label Edit
+ . configure -menu .m1
+ wm geometry . 200x200
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.8 {TkpComputeMenubarGeometry - two entries; 2nd don't fit} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label File
+ .m1 add cascade -label Edit -font "Times 72"
+ . configure -menu .m1
+ wm geometry . 100x100
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.9 {TkpComputeMenubarGeometry - two entries; 1st dont fit} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label File -font "Times 72"
+ .m1 add cascade -label Edit
+ . configure -menu .m1
+ wm geometry . 100x100
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.10 {TkpComputeMenubarGeometry - two entries; neither fit} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0 -font "Times 72"
+ .m1 add cascade -label File
+ .m1 add cascade -label Edit
+ . configure -menu .m1
+ wm geometry . 10x10
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+# ABC notation; capital A means first window fits, small a means it
+# does not. capital B menu means second window fist, etc.
+test unixMenu-19.11 {TkpComputeMenubarGeometry - abc} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0 -font "Times 72"
+ .m1 add cascade -label "aaaaa"
+ .m1 add cascade -label "bbbbb"
+ .m1 add cascade -label "ccccc"
+ . configure -menu .m1
+ wm geometry . 10x10
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.12 {TkpComputeMenubarGeometry - abC} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label "aaaaa" -font "Times 72"
+ .m1 add cascade -label "bbbbb" -font "Times 72"
+ .m1 add cascade -label "C"
+ . configure -menu .m1
+ wm geometry . 10x10
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.13 {TkpComputeMenubarGeometry - aBc} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label "aaaaa" -font "Times 72"
+ .m1 add cascade -label "B"
+ .m1 add cascade -label "ccccc" -font "Times 72"
+ . configure -menu .m1
+ wm geometry . 10x10
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.14 {TkpComputeMenubarGeometry - aBC} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label "aaaaa" -font "Times 72"
+ .m1 add cascade -label "B"
+ .m1 add cascade -label "C"
+ . configure -menu .m1
+ wm geometry . 60x10
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.15 {TkpComputeMenubarGeometry - Abc} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label "A"
+ .m1 add cascade -label "bbbbb" -font "Times 72"
+ .m1 add cascade -label "ccccc" -font "Times 72"
+ . configure -menu .m1
+ wm geometry . 60x10
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.16 {TkpComputeMenubarGeometry - AbC} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label "A"
+ .m1 add cascade -label "bbbbb" -font "Times 72"
+ .m1 add cascade -label "C"
+ . configure -menu .m1
+ wm geometry . 60x10
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.17 {TkpComputeMenubarGeometry - ABc} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label "A"
+ .m1 add cascade -label "B"
+ .m1 add cascade -label "ccccc" -font "Times 72"
+ . configure -menu .m1
+ wm geometry . 60x10
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.18 {TkpComputeMenubarGeometry - ABC} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label "A"
+ .m1 add cascade -label "B"
+ .m1 add cascade -label "C"
+ . configure -menu .m1
+ wm geometry . 100x10
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.19 {TkpComputeMenubarGeometry - help menu in first position} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label Help -menu .m1.help
+ menu .m1.help -tearoff 0
+ .m1 add cascade -label File -menu .m1.file
+ menu .m1.file -tearoff 0
+ .m1 add cascade -label Edit -menu .m1.edit
+ menu .m1.edit -tearoff 0
+ . configure -menu .m1
+ wm geometry . 100x10
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.20 {TkpComputeMenubarGeometry - help menu in middle} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label Edit -menu .m1.edit
+ menu .m1.edit -tearoff 0
+ .m1 add cascade -label Help -menu .m1.help
+ menu .m1.help -tearoff 0
+ .m1 add cascade -label File -menu .m1.file
+ menu .m1.file -tearoff 0
+ . configure -menu .m1
+ wm geometry . 100x10
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.21 {TkpComputeMenubarGeometry - help menu in first position} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label File -menu .m1.file
+ menu .m1.file -tearoff 0
+ .m1 add cascade -label Edit -menu .m1.edit
+ menu .m1.edit -tearoff 0
+ .m1 add cascade -label Help -menu .m1.help
+ menu .m1.help -tearoff 0
+ . configure -menu .m1
+ wm geometry . 100x10
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.22 {TkpComputeMenubarGeometry - help item fits} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label File -menu .m1.file
+ menu .m1.file -tearoff 0
+ .m1 add cascade -label Help -menu .m1.help
+ menu .m1.help -tearoff 0
+ . configure -menu .m1
+ wm geometry . 100x10
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.23 {TkpComputeMenubarGeometry - help item does not fit} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label File -menu .m1.file
+ menu .m1.file -tearoff 0
+ .m1 add cascade -label Help -menu .m1.help -font "Helvetica 72"
+ menu .m1.help -tearoff 0
+ . configure -menu .m1
+ wm geometry . 100x10
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-19.24 {TkpComputeMenubarGeometry - help item only one} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label Help -menu .m1.help
+ menu .m1.help -tearoff 0
+ . configure -menu .m1
+ wm geometry . 100x10
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+
+test unixMenu-20.1 {DrawTearoffEntry - menubar} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add cascade -label File
+ . configure -menu .m1
+ list [catch {update} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 {} {} {}}
+test unixMenu-20.2 {DrawTearoffEntry - non-menubar} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label foo
+ .m1 post 40 40
+ list [catch {update} msg] $msg [destroy .m1]
+} {0 {} {}}
+
+test unixMenu-21.1 {TkpInitializeMenuBindings - nothing to do} {} {}
+
+test unixMenu-22.1 {SetHelpMenu - no menubars} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ .m1 add cascade -label test -menu .m1.test
+ list [catch {menu .m1.test} msg] $msg [destroy .m1]
+} {0 .m1.test {}}
+# Don't know how to automate missing tkwins
+test unixMenu-22.2 {SetHelpMenu - menubar but no help menu} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ . configure -menu .m1
+ .m1 add cascade -label .m1.file
+ list [catch {menu .m1.file} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 .m1.file {} {}}
+test unixMenu-22.3 {SetHelpMenu - menubar with help menu} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ . configure -menu .m1
+ .m1 add cascade -label .m1.help
+ list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1]
+} {0 .m1.help {} {}}
+test unixMenu-22.4 {SetHelpMenu - multiple menubars with same help menu} {
+ catch {destroy .m1}
+ catch {destroy .t2}
+ toplevel .t2
+ wm geometry .t2 +40+40
+ menu .m1 -tearoff 0
+ . configure -menu .m1
+ .t2 configure -menu .m1
+ .m1 add cascade -label .m1.help
+ list [catch {menu .m1.help} msg] $msg [. configure -menu ""] [destroy .m1] [destroy .t2]
+} {0 .m1.help {} {} {}}
+
+test unixMenu-23.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 unixMenu-23.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 unixMenu-23.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 unixMenu-23.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 unixMenu-23.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 unixMenu-23.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 unixMenu-23.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 unixMenu-23.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 unixMenu-23.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 unixMenu-23.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 unixMenu-23.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 unixMenu-23.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 unixMenu-23.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 unixMenu-23.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 unixMenu-23.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 unixMenu-23.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 unixMenu-23.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 unixMenu-23.18 {TkpDrawMenuEntry - separator} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.19 {TkpDrawMenuEntry - standard} {
+ catch {destroy .mb}
+ menu .m1
+ .m1 add command -label foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.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 unixMenu-23.21 {TkpDrawMenuEntry - indicator} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label Foo
+ .m1 invoke Foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+test unixMenu-23.22 {TkpDrawMenuEntry - hide margin} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label Foo -hidemargin 1
+ .m1 invoke Foo
+ set tearoff [tkTearOffMenu .m1 40 40]
+ list [update] [destroy .m1]
+} {{} {}}
+
+test unixMenu-24.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 unixMenu-24.2 {GetMenuLabelGeometry - bitmap} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -bitmap questhead
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test unixMenu-24.3 {GetMenuLabelGeometry - no text} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test unixMenu-24.4 {GetMenuLabelGeometry - text} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "This is a test."
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+
+test unixMenu-25.1 {TkpComputeStandardMenuGeometry - no entries} {
+ catch {destroy .m1}
+ menu .m1
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test unixMenu-25.2 {TkpComputeStandardMenuGeometry - one entry} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "one"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test unixMenu-25.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 unixMenu-25.4 {TkpComputeStandardMenuGeometry - separator} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add separator
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+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} {
+ catch {destroy .m1}
+ menu .m1 -font "Helvetica 12"
+ .m1 add command -label "test" -font "Courier 12"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test unixMenu-25.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 unixMenu-25.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 unixMenu-25.10 {TkpComputeStandardMenuGeometry - accelerator} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add command -label "test" -accel "Ctrl+S"
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test unixMenu-25.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 unixMenu-25.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 unixMenu-25.13 {TkpComputeStandardMenuGeometry - indicator} {
+ catch {destroy .m1}
+ menu .m1
+ .m1 add checkbutton -label test
+ .m1 invoke 1
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test unixMenu-25.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 unixMenu-25.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 unixMenu-25.16 {TkpComputeStandardMenuGeometry - zero sized menus} {
+ catch {destroy .m1}
+ menu .m1 -tearoff 0
+ list [update idletasks] [destroy .m1]
+} {{} {}}
+test unixMenu-25.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 unixMenu-25.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 unixMenu-25.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 unixMenu-25.20 {TkpComputeStandardMenuGeometry - hide margin} {
+ catch {destroy .m1}
+ 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
diff --git a/tk/tests/unixWm.test b/tk/tests/unixWm.test
new file mode 100644
index 00000000000..376026d8256
--- /dev/null
+++ b/tk/tests/unixWm.test
@@ -0,0 +1,2358 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+
+proc makeToplevels {} {
+ foreach i [winfo child .] {
+ destroy $i
+ }
+ foreach i {.raise1 .raise2 .raise3} {
+ toplevel $i
+ wm geom $i 150x100+0+0
+ update
+ }
+}
+
+set i 1
+foreach geom {+20+80 +80+20 +0+0} {
+ catch {destroy .t}
+ test unixWm-1.$i {initial window position} {
+ toplevel .t -width 200 -height 150
+ wm geom .t $geom
+ update
+ wm geom .t
+ } 200x150$geom
+ incr i
+}
+
+# The tests below are tricky because window managers don't all move
+# windows correctly. Try one motion and compute the window manager's
+# error, then factor this error into the actual tests. In other words,
+# this just makes sure that things are consistent between moves.
+
+set i 1
+catch {destroy .t}
+toplevel .t -width 100 -height 150
+wm geom .t +200+200
+update
+wm geom .t +150+150
+update
+scan [wm geom .t] %dx%d+%d+%d width height x y
+set xerr [expr 150-$x]
+set yerr [expr 150-$y]
+foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} {
+ test unixWm-2.$i {moving window while mapped} {
+ wm geom .t $geom
+ update
+ scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y
+ format "%s%d%s%d" $xsign [eval expr $x$xsign$xerr] $ysign \
+ [eval expr $y$ysign$yerr]
+ } $geom
+ incr i
+}
+
+set i 1
+foreach geom {+20+80 +80+20 +0+0 -0-0 +0-0 -0+0 -10-5 -10+5 +10-5} {
+ test unixWm-3.$i {moving window while iconified} {
+ wm iconify .t
+ sleep 200
+ wm geom .t $geom
+ update
+ wm deiconify .t
+ scan [wm geom .t] %dx%d%1s%d%1s%d width height xsign x ysign y
+ format "%s%d%s%d" $xsign [eval expr $x$xsign$xerr] $ysign \
+ [eval expr $y$ysign$yerr]
+ } $geom
+ incr i
+}
+
+set i 1
+foreach geom {+20+80 +100+40 +0+0} {
+ test unixWm-4.$i {moving window while withdrawn} {
+ wm withdraw .t
+ sleep 200
+ wm geom .t $geom
+ update
+ wm deiconify .t
+ wm geom .t
+ } 100x150$geom
+ incr i
+}
+
+test unixWm-5.1 {compounded state changes} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100
+ wm geometry .t +100+100
+ update
+ wm withdraw .t
+ wm deiconify .t
+ list [winfo ismapped .t] [wm state .t]
+} {1 normal}
+test unixWm-5.2 {compounded state changes} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100
+ wm geometry .t +100+100
+ update
+ wm withdraw .t
+ wm deiconify .t
+ wm withdraw .t
+ list [winfo ismapped .t] [wm state .t]
+} {0 withdrawn}
+test unixWm-5.3 {compounded state changes} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100
+ wm geometry .t +100+100
+ update
+ wm iconify .t
+ wm deiconify .t
+ wm iconify .t
+ wm deiconify .t
+ list [winfo ismapped .t] [wm state .t]
+} {1 normal}
+test unixWm-5.4 {compounded state changes} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100
+ wm geometry .t +100+100
+ update
+ wm iconify .t
+ wm deiconify .t
+ wm iconify .t
+ list [winfo ismapped .t] [wm state .t]
+} {0 iconic}
+test unixWm-5.5 {compounded state changes} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100
+ wm geometry .t +100+100
+ update
+ wm iconify .t
+ wm withdraw .t
+ list [winfo ismapped .t] [wm state .t]
+} {0 withdrawn}
+test unixWm-5.6 {compounded state changes} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100
+ wm geometry .t +100+100
+ update
+ wm iconify .t
+ wm withdraw .t
+ wm deiconify .t
+ list [winfo ismapped .t] [wm state .t]
+} {1 normal}
+test unixWm-5.7 {compounded state changes} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 100
+ wm geometry .t +100+100
+ update
+ wm withdraw .t
+ wm iconify .t
+ list [winfo ismapped .t] [wm state .t]
+} {0 iconic}
+
+catch {destroy .t}
+toplevel .t -width 200 -height 100
+wm geom .t +10+10
+wm minsize .t 1 1
+update
+test unixWm-6.1 {size changes} {
+ .t config -width 180 -height 150
+ update
+ wm geom .t
+} 180x150+10+10
+test unixWm-6.2 {size changes} {
+ wm geom .t 250x60
+ .t config -width 170 -height 140
+ update
+ wm geom .t
+} 250x60+10+10
+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
+ set width [winfo width .t]
+ set height [winfo height .t]
+ .t config -width 230 -height 110
+ update
+ incr width -[winfo width .t]
+ incr height -[winfo height .t]
+ wm geom .t {}
+ update
+ set w2 [winfo width .t]
+ set h2 [winfo height .t]
+ .t config -width 114 -height 261
+ update
+ list $width $height $w2 $h2 [wm geom .t]
+} {0 0 230 110 114x261+10+10}
+
+# I don't know why the wait below is needed, but without it the test
+# fails under twm.
+sleep 200
+
+test unixWm-6.5 {window initially iconic} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 30
+ wm geometry .t +0+0
+ wm title .t 2
+ wm iconify .t
+ update idletasks
+ wm withdraw .t
+ wm deiconify .t
+ list [winfo ismapped .t] [wm state .t]
+} {1 normal}
+
+catch {destroy .m}
+toplevel .m
+wm overrideredirect .m 1
+foreach i {{Test label} Another {Yet another} {Last label}} j {1 2 3} {
+ label .m.$j -text $i
+}
+wm geometry .m +[expr 100 - [winfo vrootx .]]+[expr 200 - [winfo vrooty .]]
+update
+test unixWm-7.1 {override_redirect and Tk_MoveTopLevelWindow} {
+ list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m]
+} {1 normal 100 200}
+wm geometry .m +[expr 150 - [winfo vrootx .]]+[expr 210 - [winfo vrooty .]]
+update
+test unixWm-7.2 {override_redirect and Tk_MoveTopLevelWindow} {
+ list [winfo ismapped .m] [wm state .m] [winfo x .m] [winfo y .m]
+} {1 normal 150 210}
+wm withdraw .m
+test unixWm-7.3 {override_redirect and Tk_MoveTopLevelWindow} {
+ list [winfo ismapped .m]
+} 0
+destroy .m
+catch {destroy .t}
+
+test unixWm-8.1 {icon windows} {
+ catch {destroy .t}
+ catch {destroy .icon}
+ toplevel .t -width 100 -height 30
+ wm geometry .t +0+0
+ toplevel .icon -width 50 -height 50 -bg red
+ wm iconwindow .t .icon
+ list [catch {wm withdraw .icon} msg] $msg
+} {1 {can't withdraw .icon: it is an icon for .t}}
+test unixWm-8.2 {icon windows} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 30
+ list [catch {wm iconwindow} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+test unixWm-8.3 {icon windows} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 30
+ list [catch {wm iconwindow .t b c} msg] $msg
+} {1 {wrong # arguments: must be "wm iconwindow window ?pathName?"}}
+test unixWm-8.4 {icon windows} {
+ catch {destroy .t}
+ catch {destroy .icon}
+ toplevel .t -width 100 -height 30
+ wm geom .t +0+0
+ set result [wm iconwindow .t]
+ toplevel .icon -width 50 -height 50 -bg red
+ wm iconwindow .t .icon
+ lappend result [wm iconwindow .t] [wm state .icon]
+ wm iconwindow .t {}
+ lappend result [wm iconwindow .t] [wm state .icon]
+ update
+ lappend result [winfo ismapped .t] [winfo ismapped .icon]
+ wm iconify .t
+ update
+ lappend result [winfo ismapped .t] [winfo ismapped .icon]
+} {.icon icon {} withdrawn 1 0 0 0}
+test unixWm-8.5 {icon windows} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 30
+ list [catch {wm iconwindow .t .gorp} msg] $msg
+} {1 {bad window path name ".gorp"}}
+test unixWm-8.6 {icon windows} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 30
+ frame .t.icon -width 50 -height 50 -bg red
+ list [catch {wm iconwindow .t .t.icon} msg] $msg
+} {1 {can't use .t.icon as icon window: not at top level}}
+test unixWm-8.7 {icon windows} {
+ catch {destroy .t}
+ catch {destroy .icon}
+ toplevel .t -width 100 -height 30
+ wm geom .t +0+0
+ toplevel .icon -width 50 -height 50 -bg red
+ toplevel .icon2 -width 50 -height 50 -bg green
+ wm iconwindow .t .icon
+ set result "[wm iconwindow .t] [wm state .icon] [wm state .icon2]"
+ wm iconwindow .t .icon2
+ lappend result [wm iconwindow .t] [wm state .icon] [wm state .icon2]
+} {.icon icon normal .icon2 withdrawn icon}
+catch {destroy .icon2}
+test unixWm-8.8 {icon windows} {
+ catch {destroy .t}
+ catch {destroy .icon}
+ toplevel .icon -width 50 -height 50 -bg red
+ wm geom .icon +0+0
+ update
+ set result [winfo ismapped .icon]
+ toplevel .t -width 100 -height 30
+ wm geom .t +0+0
+ tkwait visibility .t ;# Needed to keep tvtwm happy.
+ wm iconwindow .t .icon
+ sleep 500
+ lappend result [winfo ismapped .t] [winfo ismapped .icon]
+} {1 1 0}
+test unixWm-8.9 {icon windows} {nonPortable} {
+ # This test is non-portable because some window managers will
+ # destroy an icon window when it's associated window is destroyed.
+
+ catch {destroy .t}
+ catch {destroy .icon}
+ toplevel .t -width 100 -height 30
+ toplevel .icon -width 50 -height 50 -bg red
+ wm geom .t +0+0
+ wm iconwindow .t .icon
+ update
+ set result "[wm state .icon] [winfo ismapped .t] [winfo ismapped .icon]"
+ destroy .t
+ 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."
+ 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
+ testprop [testwrapper .t] WM_CLIENT_MACHINE
+} {Test_String}
+test unixWm-9.2 {TkWmMapWindow procedure, command property} {unixOnly} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 50
+ wm geom .t +0+0
+ wm command .t "test command"
+ update
+ testprop [testwrapper .t] WM_COMMAND
+} {test
+command
+}
+test unixWm-9.3 {TkWmMapWindow procedure, iconic windows} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 300 -bg blue
+ wm geom .t +0+0
+ wm iconify .t
+ sleep 500
+ winfo ismapped .t
+} {0}
+test unixWm-9.4 {TkWmMapWindow procedure, icon windows} {
+ catch {destroy .t}
+ sleep 500
+ toplevel .t -width 100 -height 50 -bg blue
+ wm iconwindow . .t
+ update
+ set result [winfo ismapped .t]
+} {0}
+test unixWm-9.5 {TkWmMapWindow procedure, normal windows} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 20
+ wm geom .t +0+0
+ update
+ winfo ismapped .t
+} {1}
+
+test unixWm-10.1 {TkWmDeadWindow procedure, canceling UpdateGeometry idle handler} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 50
+ wm geom .t +0+0
+ update
+ .t configure -width 200 -height 100
+ destroy .t
+} {}
+test unixWm-10.2 {TkWmDeadWindow procedure, destroying menubar} {unixOnly} {
+ catch {destroy .t}
+ catch {destroy .f}
+ toplevel .t -width 300 -height 200 -bd 2 -relief raised
+ wm geom .t +0+0
+ update
+ frame .f -width 400 -height 30 -bd 2 -relief raised -bg green
+ bind .f <Destroy> {lappend result destroyed}
+ testmenubar window .t .f
+ update
+ set result {}
+ destroy .t
+ lappend result [winfo exists .f]
+} {destroyed 0}
+
+test unixWm-11.1 {Tk_WmCmd procedure, miscellaneous errors} {
+ list [catch {wm} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+test unixWm-11.2 {Tk_WmCmd procedure, miscellaneous errors} {
+ list [catch {wm foo} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+test unixWm-11.3 {Tk_WmCmd procedure, miscellaneous errors} {
+ list [catch {wm foo bogus} msg] $msg
+} {1 {bad window path name "bogus"}}
+test unixWm-11.4 {Tk_WmCmd procedure, miscellaneous errors} {
+ catch {destroy .b}
+ button .b -text hello
+ list [catch {wm geometry .b} msg] $msg
+} {1 {window ".b" isn't a top-level window}}
+
+catch {destroy .t}
+catch {destroy .icon}
+
+toplevel .t -width 100 -height 50
+wm geom .t +0+0
+update
+
+test unixWm-12.1 {Tk_WmCmd procedure, "aspect" option} {
+ list [catch {wm aspect .t 12} msg] $msg
+} {1 {wrong # arguments: must be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}}
+test unixWm-12.2 {Tk_WmCmd procedure, "aspect" option} {
+ list [catch {wm aspect .t 12 13 14 15 16} msg] $msg
+} {1 {wrong # arguments: must be "wm aspect window ?minNumer minDenom maxNumer maxDenom?"}}
+test unixWm-12.3 {Tk_WmCmd procedure, "aspect" option} {
+ set result {}
+ lappend result [wm aspect .t]
+ wm aspect .t 3 4 10 2
+ lappend result [wm aspect .t]
+ wm aspect .t {} {} {} {}
+ lappend result [wm aspect .t]
+} {{} {3 4 10 2} {}}
+test unixWm-12.4 {Tk_WmCmd procedure, "aspect" option} {
+ list [catch {wm aspect .t bad 14 15 16} msg] $msg
+} {1 {expected integer but got "bad"}}
+test unixWm-12.5 {Tk_WmCmd procedure, "aspect" option} {
+ list [catch {wm aspect .t 13 foo 15 16} msg] $msg
+} {1 {expected integer but got "foo"}}
+test unixWm-12.6 {Tk_WmCmd procedure, "aspect" option} {
+ list [catch {wm aspect .t 13 14 bar 16} msg] $msg
+} {1 {expected integer but got "bar"}}
+test unixWm-12.7 {Tk_WmCmd procedure, "aspect" option} {
+ list [catch {wm aspect .t 13 14 15 baz} msg] $msg
+} {1 {expected integer but got "baz"}}
+test unixWm-12.8 {Tk_WmCmd procedure, "aspect" option} {
+ list [catch {wm aspect .t 0 14 15 16} msg] $msg
+} {1 {aspect number can't be <= 0}}
+test unixWm-12.9 {Tk_WmCmd procedure, "aspect" option} {
+ list [catch {wm aspect .t 13 0 15 16} msg] $msg
+} {1 {aspect number can't be <= 0}}
+test unixWm-12.10 {Tk_WmCmd procedure, "aspect" option} {
+ list [catch {wm aspect .t 13 14 0 16} msg] $msg
+} {1 {aspect number can't be <= 0}}
+test unixWm-12.11 {Tk_WmCmd procedure, "aspect" option} {
+ list [catch {wm aspect .t 13 14 15 0} msg] $msg
+} {1 {aspect number can't be <= 0}}
+
+test unixWm-13.1 {Tk_WmCmd procedure, "client" option} {
+ list [catch {wm client .t x y} msg] $msg
+} {1 {wrong # arguments: must be "wm client window ?name?"}}
+test unixWm-13.2 {Tk_WmCmd procedure, "client" option} {unixOnly} {
+ set result {}
+ lappend result [wm client .t]
+ wm client .t Test_String
+ lappend result [testprop [testwrapper .t] WM_CLIENT_MACHINE]
+ wm client .t New
+ lappend result [wm client .t]
+ wm client .t {}
+ lappend result [wm client .t] [testprop [testwrapper .t] WM_CLIENT_MACHINE]
+} {{} Test_String New {} {}}
+test unixWm-13.3 {Tk_WmCmd procedure, "client" option, unmapped window} {
+ catch {destroy .t2}
+ toplevel .t2
+ wm client .t2 Test_String
+ wm client .t2 {}
+ wm client .t2 Test_String
+ destroy .t2
+} {}
+
+test unixWm-14.1 {Tk_WmCmd procedure, "colormapwindows" option} {
+ list [catch {wm colormapwindows .t 12 13} msg] $msg
+} {1 {wrong # arguments: must be "wm colormapwindows window ?windowList?"}}
+test unixWm-14.2 {Tk_WmCmd procedure, "colormapwindows" option} {
+ catch {destroy .t2}
+ toplevel .t2 -width 200 -height 200 -colormap new
+ wm geom .t2 +0+0
+ frame .t2.a -width 100 -height 30
+ frame .t2.b -width 100 -height 30 -colormap new
+ pack .t2.a .t2.b -side top
+ update
+ set x [wm colormapwindows .t2]
+ frame .t2.c -width 100 -height 30 -colormap new
+ pack .t2.c -side top
+ update
+ list $x [wm colormapwindows .t2]
+} {{.t2.b .t2} {.t2.b .t2.c .t2}}
+test unixWm-14.3 {Tk_WmCmd procedure, "colormapwindows" option} {
+ list [catch {wm col . "a \{"} msg] $msg
+} {1 {unmatched open brace in list}}
+test unixWm-14.4 {Tk_WmCmd procedure, "colormapwindows" option} {
+ list [catch {wm colormapwindows . foo} msg] $msg
+} {1 {bad window path name "foo"}}
+test unixWm-14.5 {Tk_WmCmd procedure, "colormapwindows" option} {
+ catch {destroy .t2}
+ toplevel .t2 -width 200 -height 200 -colormap new
+ wm geom .t2 +0+0
+ frame .t2.a -width 100 -height 30
+ frame .t2.b -width 100 -height 30
+ frame .t2.c -width 100 -height 30
+ pack .t2.a .t2.b .t2.c -side top
+ wm colormapwindows .t2 {.t2.c .t2 .t2.a}
+ wm colormapwindows .t2
+} {.t2.c .t2 .t2.a}
+test unixWm-14.6 {Tk_WmCmd procedure, "colormapwindows" option} {
+ catch {destroy .t2}
+ toplevel .t2 -width 200 -height 200
+ wm geom .t2 +0+0
+ frame .t2.a -width 100 -height 30
+ frame .t2.b -width 100 -height 30
+ frame .t2.c -width 100 -height 30
+ pack .t2.a .t2.b .t2.c -side top
+ wm colormapwindows .t2 {.t2.b .t2.a}
+ wm colormapwindows .t2
+} {.t2.b .t2.a}
+test unixWm-14.7 {Tk_WmCmd procedure, "colormapwindows" option} {
+ catch {destroy .t2}
+ toplevel .t2 -width 200 -height 200 -colormap new
+ wm geom .t2 +0+0
+ set x [wm colormapwindows .t2]
+ wm colormapwindows .t2 {}
+ list $x [wm colormapwindows .t2]
+} {{} {}}
+catch {destroy .t2}
+
+test unixWm-15.1 {Tk_WmCmd procedure, "command" option} {
+ list [catch {wm command .t 12 13} msg] $msg
+} {1 {wrong # arguments: must be "wm command window ?value?"}}
+test unixWm-15.2 {Tk_WmCmd procedure, "command" option} {
+ list [catch {wm command .t 12 13} msg] $msg
+} {1 {wrong # arguments: must be "wm command window ?value?"}}
+test unixWm-15.3 {Tk_WmCmd procedure, "command" option} {unixOnly} {
+ set result {}
+ lappend result [wm command .t]
+ wm command .t "test command"
+ lappend result [testprop [testwrapper .t] WM_COMMAND]
+ wm command .t "new command"
+ lappend result [wm command .t]
+ wm command .t {}
+ lappend result [wm command .t] [testprop [testwrapper .t] WM_COMMAND]
+} {{} {test
+command
+} {new command} {} {}}
+test unixWm-15.4 {Tk_WmCmd procedure, "command" option, window not mapped} {
+ catch {destroy .t2}
+ toplevel .t2
+ wm geom .t2 +0+0
+ wm command .t2 "test command"
+ wm command .t2 "new command"
+ wm command .t2 {}
+ destroy .t2
+} {}
+test unixWm-15.5 {Tk_WmCmd procedure, "command" option} {
+ list [catch {wm command .t "a \{b"} msg] $msg
+} {1 {unmatched open brace in list}}
+
+test unixWm-16.1 {Tk_WmCmd procedure, "deiconify" option} {
+ list [catch {wm deiconify .t 12} msg] $msg
+} {1 {wrong # arguments: must be "wm deiconify window"}}
+test unixWm-16.2 {Tk_WmCmd procedure, "deiconify" option} {
+ catch {destroy .icon}
+ toplevel .icon -width 50 -height 50 -bg red
+ wm iconwindow .t .icon
+ set result [list [catch {wm deiconify .icon} msg] $msg]
+ destroy .icon
+ set result
+} {1 {can't deiconify .icon: it is an icon for .t}}
+test unixWm-16.3 {Tk_WmCmd procedure, "deiconify" option} {
+ wm iconify .t
+ set result {}
+ lappend result [winfo ismapped .t] [wm state .t]
+ wm deiconify .t
+ lappend result [winfo ismapped .t] [wm state .t]
+} {0 iconic 1 normal}
+
+test unixWm-17.1 {Tk_WmCmd procedure, "focusmodel" option} {
+ list [catch {wm focusmodel .t 12 13} msg] $msg
+} {1 {wrong # arguments: must be "wm focusmodel window ?active|passive?"}}
+test unixWm-17.2 {Tk_WmCmd procedure, "focusmodel" option} {
+ list [catch {wm focusmodel .t bogus} msg] $msg
+} {1 {bad argument "bogus": must be active or passive}}
+test unixWm-17.3 {Tk_WmCmd procedure, "focusmodel" option} {
+ set result {}
+ lappend result [wm focusmodel .t]
+ wm focusmodel .t active
+ lappend result [wm focusmodel .t]
+ wm focusmodel .t passive
+ lappend result [wm focusmodel .t]
+ set result
+} {passive active passive}
+
+test unixWm-18.1 {Tk_WmCmd procedure, "frame" option} {
+ list [catch {wm frame .t 12} msg] $msg
+} {1 {wrong # arguments: must be "wm frame window"}}
+test unixWm-18.2 {Tk_WmCmd procedure, "frame" option} nonPortable {
+ expr [wm frame .t] == [winfo id .t]
+} {0}
+test unixWm-18.3 {Tk_WmCmd procedure, "frame" option} nonPortable {
+ catch {destroy .t2}
+ toplevel .t2
+ wm geom .t2 +0+0
+ wm overrideredirect .t2 1
+ update
+ set result [expr [wm frame .t2] == [winfo id .t2]]
+ destroy .t2
+ set result
+} {1}
+
+test unixWm-19.1 {Tk_WmCmd procedure, "geometry" option} {
+ list [catch {wm geometry .t 12 13} msg] $msg
+} {1 {wrong # arguments: must be "wm geometry window ?newGeometry?"}}
+test unixWm-19.2 {Tk_WmCmd procedure, "geometry" option} nonPortable {
+ wm geometry .t -1+5
+ update
+ wm geometry .t
+} {100x50-1+5}
+test unixWm-19.3 {Tk_WmCmd procedure, "geometry" option} nonPortable {
+ wm geometry .t +10-4
+ update
+ wm geometry .t
+} {100x50+10-4}
+test unixWm-19.4 {Tk_WmCmd procedure, "geometry" option} nonPortable {
+ catch {destroy .t2}
+ toplevel .t2
+ wm geom .t2 -5+10
+ listbox .t2.l -width 30 -height 12 -setgrid 1
+ pack .t2.l
+ update
+ set result [wm geometry .t2]
+ destroy .t2
+ set result
+} {30x12-5+10}
+test unixWm-19.5 {Tk_WmCmd procedure, "geometry" option} nonPortable {
+ wm geometry .t 150x300+5+6
+ update
+ set result {}
+ lappend result [wm geometry .t]
+ wm geometry .t {}
+ update
+ lappend result [wm geometry .t]
+} {150x300+5+6 100x50+5+6}
+test unixWm-19.6 {Tk_WmCmd procedure, "geometry" option} {
+ list [catch {wm geometry .t qrs} msg] $msg
+} {1 {bad geometry specifier "qrs"}}
+
+test unixWm-20.1 {Tk_WmCmd procedure, "grid" option} {
+ list [catch {wm grid .t 12 13} msg] $msg
+} {1 {wrong # arguments: must be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}}
+test unixWm-20.2 {Tk_WmCmd procedure, "grid" option} {
+ list [catch {wm grid .t 12 13 14 15 16} msg] $msg
+} {1 {wrong # arguments: must be "wm grid window ?baseWidth baseHeight widthInc heightInc?"}}
+test unixWm-20.3 {Tk_WmCmd procedure, "grid" option} {
+ set result {}
+ lappend result [wm grid .t]
+ wm grid .t 5 6 20 10
+ lappend result [wm grid .t]
+ wm grid .t {} {} {} {}
+ lappend result [wm grid .t]
+} {{} {5 6 20 10} {}}
+test unixWm-20.4 {Tk_WmCmd procedure, "grid" option} {
+ list [catch {wm grid .t bad 10 11 12} msg] $msg
+} {1 {expected integer but got "bad"}}
+test unixWm-20.5 {Tk_WmCmd procedure, "grid" option} {
+ list [catch {wm grid .t -1 11 12 13} msg] $msg
+} {1 {baseWidth can't be < 0}}
+test unixWm-20.6 {Tk_WmCmd procedure, "grid" option} {
+ list [catch {wm grid .t 10 foo 12 13} msg] $msg
+} {1 {expected integer but got "foo"}}
+test unixWm-20.7 {Tk_WmCmd procedure, "grid" option} {
+ list [catch {wm grid .t 10 -11 12 13} msg] $msg
+} {1 {baseHeight can't be < 0}}
+test unixWm-20.8 {Tk_WmCmd procedure, "grid" option} {
+ list [catch {wm grid .t 10 11 bar 13} msg] $msg
+} {1 {expected integer but got "bar"}}
+test unixWm-20.9 {Tk_WmCmd procedure, "grid" option} {
+ list [catch {wm grid .t 10 11 -2 13} msg] $msg
+} {1 {widthInc can't be < 0}}
+test unixWm-20.10 {Tk_WmCmd procedure, "grid" option} {
+ list [catch {wm grid .t 10 11 12 bogus} msg] $msg
+} {1 {expected integer but got "bogus"}}
+test unixWm-20.11 {Tk_WmCmd procedure, "grid" option} {
+ list [catch {wm grid .t 10 11 12 -1} msg] $msg
+} {1 {heightInc can't be < 0}}
+
+catch {destroy .t}
+catch {destroy .icon}
+toplevel .t -width 100 -height 50
+wm geom .t +0+0
+update
+
+test unixWm-21.1 {Tk_WmCmd procedure, "group" option} {
+ list [catch {wm group .t 12 13} msg] $msg
+} {1 {wrong # arguments: must be "wm group window ?pathName?"}}
+test unixWm-21.2 {Tk_WmCmd procedure, "group" option} {
+ list [catch {wm group .t bogus} msg] $msg
+} {1 {bad window path name "bogus"}}
+test unixWm-21.3 {Tk_WmCmd procedure, "group" option} {unixOnly} {
+ set result {}
+ lappend result [wm group .t]
+ wm group .t .
+ set bit [format 0x%x [expr 0x40 & [lindex [testprop [testwrapper .t] \
+ WM_HINTS] 0]]]
+ lappend result [wm group .t] $bit
+ wm group .t {}
+ set bit [format 0x%x [expr 0x40 & [lindex [testprop [testwrapper .t] \
+ WM_HINTS] 0]]]
+ lappend result [wm group .t] $bit
+} {{} . 0x40 {} 0x0}
+test unixWm-21.4 {Tk_WmCmd procedure, "group" option, make window exist} {unixOnly} {
+ catch {destroy .t2}
+ toplevel .t2
+ wm geom .t2 +0+0
+ wm group .t .t2
+ set hints [testprop [testwrapper .t] WM_HINTS]
+ set result [expr [testwrapper .t2] - [lindex $hints 8]]
+ destroy .t2
+ set result
+} {0}
+test unixWm-21.5 {Tk_WmCmd procedure, "group" option, create leader wrapper} {unixOnly} {
+ catch {destroy .t2}
+ catch {destroy .t3}
+ toplevel .t2 -width 120 -height 300
+ wm geometry .t2 +0+0
+ toplevel .t3 -width 120 -height 300
+ wm geometry .t2 +0+0
+ set result [list [testwrapper .t2]]
+ wm group .t3 .t2
+ lappend result [expr {[testwrapper .t2] == ""}]
+ destroy .t2 .t3
+ set result
+} {{} 0}
+
+test unixWm-22.1 {Tk_WmCmd procedure, "iconbitmap" option} {
+ list [catch {wm iconbitmap .t 12 13} msg] $msg
+} {1 {wrong # arguments: must be "wm iconbitmap window ?bitmap?"}}
+test unixWm-22.2 {Tk_WmCmd procedure, "iconbitmap" option} {unixOnly} {
+ set result {}
+ lappend result [wm iconbitmap .t]
+ wm iconbitmap .t questhead
+ set bit [format 0x%x [expr 0x4 & [lindex [testprop [testwrapper .t] \
+ WM_HINTS] 0]]]
+ lappend result [wm iconbitmap .t] $bit
+ wm iconbitmap .t {}
+ set bit [format 0x%x [expr 0x4 & [lindex [testprop [testwrapper .t] \
+ WM_HINTS] 0]]]
+ lappend result [wm iconbitmap .t] $bit
+} {{} questhead 0x4 {} 0x0}
+test unixWm-22.3 {Tk_WmCmd procedure, "iconbitmap" option} {
+ list [catch {wm iconbitmap .t bad-bitmap} msg] $msg
+} {1 {bitmap "bad-bitmap" not defined}}
+
+test unixWm-23.1 {Tk_WmCmd procedure, "iconify" option} {
+ list [catch {wm iconify .t 12} msg] $msg
+} {1 {wrong # arguments: must be "wm iconify window"}}
+test unixWm-23.2 {Tk_WmCmd procedure, "iconify" option} {
+ catch {destroy .t2}
+ toplevel .t2
+ wm overrideredirect .t2 1
+ set result [list [catch {wm iconify .t2} msg] $msg]
+ destroy .t2
+ set result
+} {1 {can't iconify ".t2": override-redirect flag is set}}
+test unixWm-23.3 {Tk_WmCmd procedure, "iconify" option} {
+ catch {destroy .t2}
+ toplevel .t2
+ wm geom .t2 +0+0
+ wm transient .t2 .t
+ set result [list [catch {wm iconify .t2} msg] $msg]
+ destroy .t2
+ set result
+} {1 {can't iconify ".t2": it is a transient}}
+test unixWm-23.4 {Tk_WmCmd procedure, "iconify" option} {
+ catch {destroy .t2}
+ toplevel .t2
+ wm geom .t2 +0+0
+ wm iconwindow .t .t2
+ set result [list [catch {wm iconify .t2} msg] $msg]
+ destroy .t2
+ set result
+} {1 {can't iconify .t2: it is an icon for .t}}
+test unixWm-23.5 {Tk_WmCmd procedure, "iconify" option} {
+ catch {destroy .t2}
+ toplevel .t2
+ wm geom .t2 +0+0
+ wm iconify .t2
+ update
+ set result [winfo ismapped .t2]
+ destroy .t2
+ set result
+} {0}
+test unixWm-23.6 {Tk_WmCmd procedure, "iconify" option} {
+ catch {destroy .t2}
+ toplevel .t2
+ wm geom .t2 -0+0
+ update
+ set result [winfo ismapped .t2]
+ wm iconify .t2
+ lappend result [winfo ismapped .t2]
+ destroy .t2
+ set result
+} {1 0}
+
+test unixWm-24.1 {Tk_WmCmd procedure, "iconmask" option} {
+ list [catch {wm iconmask .t 12 13} msg] $msg
+} {1 {wrong # arguments: must be "wm iconmask window ?bitmap?"}}
+test unixWm-24.2 {Tk_WmCmd procedure, "iconmask" option} {unixOnly} {
+ set result {}
+ lappend result [wm iconmask .t]
+ wm iconmask .t questhead
+ set bit [format 0x%x [expr 0x20 & [lindex [testprop [testwrapper .t] \
+ WM_HINTS] 0]]]
+ lappend result [wm iconmask .t] $bit
+ wm iconmask .t {}
+ set bit [format 0x%x [expr 0x20 & [lindex [testprop [testwrapper .t] \
+ WM_HINTS] 0]]]
+ lappend result [wm iconmask .t] $bit
+} {{} questhead 0x20 {} 0x0}
+test unixWm-24.3 {Tk_WmCmd procedure, "iconmask" option} {
+ list [catch {wm iconmask .t bogus} msg] $msg
+} {1 {bitmap "bogus" not defined}}
+
+test unixWm-25.1 {Tk_WmCmd procedure, "iconname" option} {
+ list [catch {wm icon .t} msg] $msg
+} {1 {unknown or ambiguous option "icon": must be aspect, client, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, state, title, transient, or withdraw}}
+test unixWm-25.2 {Tk_WmCmd procedure, "iconname" option} {
+ list [catch {wm iconname .t 12 13} msg] $msg
+} {1 {wrong # arguments: must be "wm iconname window ?newName?"}}
+test unixWm-25.3 {Tk_WmCmd procedure, "iconname" option} {unixOnly} {
+ set result {}
+ lappend result [wm iconname .t]
+ wm iconname .t test_name
+ lappend result [wm iconname .t] [testprop [testwrapper .t] WM_ICON_NAME]
+ wm iconname .t {}
+ lappend result [wm iconname .t] [testprop [testwrapper .t] WM_ICON_NAME]
+} {{} test_name test_name {} {}}
+
+test unixWm-26.1 {Tk_WmCmd procedure, "iconposition" option} {
+ list [catch {wm iconposition .t 12} msg] $msg
+} {1 {wrong # arguments: must be "wm iconposition window ?x y?"}}
+test unixWm-26.2 {Tk_WmCmd procedure, "iconposition" option} {
+ list [catch {wm iconposition .t 12 13 14} msg] $msg
+} {1 {wrong # arguments: must be "wm iconposition window ?x y?"}}
+test unixWm-26.3 {Tk_WmCmd procedure, "iconposition" option} {unixOnly} {
+ set result {}
+ lappend result [wm iconposition .t]
+ wm iconposition .t 10 15
+ set prop [testprop [testwrapper .t] WM_HINTS]
+ lappend result [wm iconposition .t] [lindex $prop 5] [lindex $prop 6]
+ lappend result [format 0x%x [expr 0x10 & [lindex $prop 0]]]
+ wm iconposition .t {} {}
+ set bit [format 0x%x [expr 0x10 & [lindex [testprop [testwrapper .t] \
+ WM_HINTS] 0]]]
+ lappend result [wm iconposition .t] $bit
+} {{} {10 15} 0xa 0xf 0x10 {} 0x0}
+test unixWm-26.4 {Tk_WmCmd procedure, "iconposition" option} {
+ list [catch {wm iconposition .t bad 13} msg] $msg
+} {1 {expected integer but got "bad"}}
+test unixWm-26.5 {Tk_WmCmd procedure, "iconposition" option} {
+ list [catch {wm iconposition .t 13 lousy} msg] $msg
+} {1 {expected integer but got "lousy"}}
+
+test unixWm-27.1 {Tk_WmCmd procedure, "iconwindow" option} {
+ list [catch {wm iconwindow .t 12 13} msg] $msg
+} {1 {wrong # arguments: must be "wm iconwindow window ?pathName?"}}
+test unixWm-27.2 {Tk_WmCmd procedure, "iconwindow" option} {unixOnly} {
+ catch {destroy .icon}
+ toplevel .icon -width 50 -height 50 -bg green
+ set result {}
+ lappend result [wm iconwindow .t]
+ wm iconwindow .t .icon
+ set prop [testprop [testwrapper .t] WM_HINTS]
+ lappend result [wm iconwindow .t] [wm state .icon]
+ lappend result [format 0x%x [expr 0x8 & [lindex $prop 0]]]
+ lappend result [expr [testwrapper .icon] == [lindex $prop 4]]
+ wm iconwindow .t {}
+ set bit [format 0x%x [expr 0x8 & [lindex [testprop [testwrapper .t] \
+ WM_HINTS] 0]]]
+ lappend result [wm iconwindow .t] [wm state .icon] $bit
+ destroy .icon
+ set result
+} {{} .icon icon 0x8 1 {} withdrawn 0x0}
+test unixWm-27.3 {Tk_WmCmd procedure, "iconwindow" option} {
+ list [catch {wm iconwindow .t bogus} msg] $msg
+} {1 {bad window path name "bogus"}}
+test unixWm-27.4 {Tk_WmCmd procedure, "iconwindow" option} {
+ catch {destroy .b}
+ button .b -text Help
+ set result [list [catch {wm iconwindow .t .b} msg] $msg]
+ destroy .b
+ set result
+} {1 {can't use .b as icon window: not at top level}}
+test unixWm-27.5 {Tk_WmCmd procedure, "iconwindow" option} {
+ catch {destroy .icon}
+ toplevel .icon -width 50 -height 50 -bg green
+ catch {destroy .t2}
+ toplevel .t2
+ wm geom .t2 -0+0
+ wm iconwindow .t2 .icon
+ set result [list [catch {wm iconwindow .t .icon} msg] $msg]
+ destroy .t2
+ destroy .icon
+ set result
+} {1 {.icon is already an icon for .t2}}
+test unixWm-27.6 {Tk_WmCmd procedure, "iconwindow" option, changing icons} {
+ catch {destroy .icon}
+ catch {destroy .icon2}
+ toplevel .icon -width 50 -height 50 -bg green
+ toplevel .icon2 -width 50 -height 50 -bg red
+ set result {}
+ wm iconwindow .t .icon
+ lappend result [wm state .icon] [wm state .icon2]
+ wm iconwindow .t .icon2
+ lappend result [wm state .icon] [wm state .icon2]
+ destroy .icon .icon2
+ set result
+} {icon normal withdrawn icon}
+test unixWm-27.7 {Tk_WmCmd procedure, "iconwindow" option, withdrawing icon} {
+ catch {destroy .icon}
+ toplevel .icon -width 50 -height 50 -bg green
+ wm geometry .icon +0+0
+ update
+ set result {}
+ lappend result [wm state .icon] [winfo viewable .icon]
+ wm iconwindow .t .icon
+ lappend result [wm state .icon] [winfo viewable .icon]
+ destroy .icon
+ set result
+} {normal 1 icon 0}
+
+test unixWm-28.1 {Tk_WmCmd procedure, "maxsize" option} {
+ list [catch {wm maxsize} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+test unixWm-28.2 {Tk_WmCmd procedure, "maxsize" option} {
+ list [catch {wm maxsize . a} msg] $msg
+} {1 {wrong # arguments: must be "wm maxsize window ?width height?"}}
+test unixWm-28.3 {Tk_WmCmd procedure, "maxsize" option} {
+ list [catch {wm maxsize . a b c} msg] $msg
+} {1 {wrong # arguments: must be "wm maxsize window ?width height?"}}
+test unixWm-28.4 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} {
+ wm maxsize .t
+} {1137 870}
+test unixWm-28.5 {Tk_WmCmd procedure, "maxsize" option} {
+ list [catch {wm maxsize . x 100} msg] $msg
+} {1 {expected integer but got "x"}}
+test unixWm-28.6 {Tk_WmCmd procedure, "maxsize" option} {
+ list [catch {wm maxsize . 100 bogus} msg] $msg
+} {1 {expected integer but got "bogus"}}
+test unixWm-28.7 {Tk_WmCmd procedure, "maxsize" option} {
+ wm maxsize .t 200 150
+ wm maxsize .t
+} {200 150}
+test unixWm-28.8 {Tk_WmCmd procedure, "maxsize" option} {nonPortable} {
+ # Not portable, because some window managers let applications override
+ # minsize and maxsize.
+
+ wm maxsize .t 200 150
+ wm geom .t 300x200
+ update
+ list [winfo width .t] [winfo height .t]
+} {200 150}
+
+catch {destroy .t}
+catch {destroy .icon}
+toplevel .t -width 100 -height 50
+wm geom .t +0+0
+update
+
+test unixWm-29.1 {Tk_WmCmd procedure, "minsize" option} {
+ list [catch {wm minsize} msg] $msg
+} {1 {wrong # args: should be "wm option window ?arg ...?"}}
+test unixWm-29.2 {Tk_WmCmd procedure, "minsize" option} {
+ list [catch {wm minsize . a} msg] $msg
+} {1 {wrong # arguments: must be "wm minsize window ?width height?"}}
+test unixWm-29.3 {Tk_WmCmd procedure, "minsize" option} {
+ list [catch {wm minsize . a b c} msg] $msg
+} {1 {wrong # arguments: must be "wm minsize window ?width height?"}}
+test unixWm-29.4 {Tk_WmCmd procedure, "minsize" option} {
+ wm minsize .t
+} {1 1}
+test unixWm-29.5 {Tk_WmCmd procedure, "minsize" option} {
+ list [catch {wm minsize . x 100} msg] $msg
+} {1 {expected integer but got "x"}}
+test unixWm-29.6 {Tk_WmCmd procedure, "minsize" option} {
+ list [catch {wm minsize . 100 bogus} msg] $msg
+} {1 {expected integer but got "bogus"}}
+test unixWm-29.7 {Tk_WmCmd procedure, "minsize" option} {
+ wm minsize .t 200 150
+ wm minsize .t
+} {200 150}
+test unixWm-29.8 {Tk_WmCmd procedure, "minsize" option} {nonPortable} {
+ # Not portable, because some window managers let applications override
+ # minsize and maxsize.
+
+ wm minsize .t 150 100
+ wm geom .t 50x50
+ update
+ list [winfo width .t] [winfo height .t]
+} {150 100}
+
+catch {destroy .t}
+catch {destroy .icon}
+toplevel .t -width 100 -height 50
+wm geom .t +0+0
+update
+
+test unixWm-30.1 {Tk_WmCmd procedure, "overrideredirect" option} {
+ list [catch {wm overrideredirect .t 1 2} msg] $msg
+} {1 {wrong # arguments: must be "wm overrideredirect window ?boolean?"}}
+test unixWm-30.2 {Tk_WmCmd procedure, "overrideredirect" option} {
+ list [catch {wm overrideredirect .t boo} msg] $msg
+} {1 {expected boolean value but got "boo"}}
+test unixWm-30.3 {Tk_WmCmd procedure, "overrideredirect" option} {
+ set result {}
+ lappend result [wm overrideredirect .t]
+ wm overrideredirect .t true
+ lappend result [wm overrideredirect .t]
+ wm overrideredirect .t off
+ lappend result [wm overrideredirect .t]
+} {0 1 0}
+
+test unixWm-31.1 {Tk_WmCmd procedure, "positionfrom" option} {
+ list [catch {wm positionfrom .t 1 2} msg] $msg
+} {1 {wrong # arguments: must be "wm positionfrom window ?user/program?"}}
+test unixWm-31.2 {Tk_WmCmd procedure, "positionfrom" option} {unixOnly} {
+ set result {}
+ lappend result [wm positionfrom .t]
+ wm positionfrom .t program
+ update
+ set bit [format 0x%x [expr 0x5 & [lindex [testprop [testwrapper .t] \
+ WM_NORMAL_HINTS] 0]]]
+ lappend result [wm positionfrom .t] $bit
+ wm positionfrom .t user
+ update
+ set bit [format 0x%x [expr 0x5 & [lindex [testprop [testwrapper .t] \
+ WM_NORMAL_HINTS] 0]]]
+ lappend result [wm positionfrom .t] $bit
+} {user program 0x4 user 0x1}
+test unixWm-31.3 {Tk_WmCmd procedure, "positionfrom" option} {
+ list [catch {wm positionfrom .t none} msg] $msg
+} {1 {bad argument "none": must be program or user}}
+
+test unixWm-32.1 {Tk_WmCmd procedure, "protocol" option} {
+ list [catch {wm protocol .t 1 2 3} msg] $msg
+} {1 {wrong # arguments: must be "wm protocol window ?name? ?command?"}}
+test unixWm-32.2 {Tk_WmCmd procedure, "protocol" option} {
+ wm protocol .t {foo a} {a b c}
+ wm protocol .t bar {test script for bar}
+ set result [wm protocol .t]
+ wm protocol .t {foo a} {}
+ wm protocol .t bar {}
+ set result
+} {bar {foo a}}
+test unixWm-32.3 {Tk_WmCmd procedure, "protocol" option} {unixOnly} {
+ set result {}
+ lappend result [wm protocol .t]
+ set x {}
+ foreach i [testprop [testwrapper .t] WM_PROTOCOLS] {
+ lappend x [winfo atomname $i]
+ }
+ lappend result $x
+ wm protocol .t foo {test script}
+ wm protocol .t bar {test script}
+ set x {}
+ foreach i [testprop [testwrapper .t] WM_PROTOCOLS] {
+ lappend x [winfo atomname $i]
+ }
+ lappend result [wm protocol .t] $x
+ wm protocol .t foo {}
+ wm protocol .t bar {}
+ set x {}
+ foreach i [testprop [testwrapper .t] WM_PROTOCOLS] {
+ lappend x [winfo atomname $i]
+ }
+ lappend result [wm protocol .t] $x
+} {{} WM_DELETE_WINDOW {bar foo} {WM_DELETE_WINDOW bar foo} {} WM_DELETE_WINDOW}
+test unixWm-32.4 {Tk_WmCmd procedure, "protocol" option} {
+ set result {}
+ wm protocol .t foo {a b c}
+ wm protocol .t bar {test script for bar}
+ lappend result [wm protocol .t foo] [wm protocol .t bar]
+ wm protocol .t foo {}
+ wm protocol .t bar {}
+ lappend result [wm protocol .t foo] [wm protocol .t bar]
+} {{a b c} {test script for bar} {} {}}
+test unixWm-32.5 {Tk_WmCmd procedure, "protocol" option} {
+ wm protocol .t foo {a b c}
+ wm protocol .t foo {test script}
+ set result [wm protocol .t foo]
+ wm protocol .t foo {}
+ set result
+} {test script}
+
+test unixWm-33.1 {Tk_WmCmd procedure, "resizable" option} {
+ list [catch {wm resizable . a} msg] $msg
+} {1 {wrong # arguments: must be "wm resizable window ?width height?"}}
+test unixWm-33.2 {Tk_WmCmd procedure, "resizable" option} {
+ list [catch {wm resizable . a b c} msg] $msg
+} {1 {wrong # arguments: must be "wm resizable window ?width height?"}}
+test unixWm-33.3 {Tk_WmCmd procedure, "resizable" option} {
+ list [catch {wm resizable .foo a b c} msg] $msg
+} {1 {bad window path name ".foo"}}
+test unixWm-33.4 {Tk_WmCmd procedure, "resizable" option} {
+ list [catch {wm resizable . x 1} msg] $msg
+} {1 {expected boolean value but got "x"}}
+test unixWm-33.5 {Tk_WmCmd procedure, "resizable" option} {
+ list [catch {wm resizable . 0 gorp} msg] $msg
+} {1 {expected boolean value but got "gorp"}}
+test unixWm-33.6 {Tk_WmCmd procedure, "resizable" option} {
+ catch {destroy .t2}
+ toplevel .t2 -width 200 -height 100
+ wm geom .t2 +0+0
+ set result ""
+ lappend result [wm resizable .t2]
+ wm resizable .t2 1 0
+ lappend result [wm resizable .t2]
+ wm resizable .t2 no off
+ lappend result [wm resizable .t2]
+ wm resizable .t2 false true
+ lappend result [wm resizable .t2]
+ destroy .t2
+ set result
+} {{1 1} {1 0} {0 0} {0 1}}
+
+test unixWm-34.1 {Tk_WmCmd procedure, "sizefrom" option} {
+ list [catch {wm sizefrom .t 1 2} msg] $msg
+} {1 {wrong # arguments: must be "wm sizefrom window ?user|program?"}}
+test unixWm-34.2 {Tk_WmCmd procedure, "sizefrom" option} {unixOnly} {
+ set result {}
+ lappend result [wm sizefrom .t]
+ wm sizefrom .t program
+ update
+ set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \
+ WM_NORMAL_HINTS] 0]]]
+ lappend result [wm sizefrom .t] $bit
+ wm sizefrom .t user
+ update
+ set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \
+ WM_NORMAL_HINTS] 0]]]
+ lappend result [wm sizefrom .t] $bit
+} {{} program 0x8 user 0x2}
+test unixWm-34.3 {Tk_WmCmd procedure, "sizefrom" option} {
+ list [catch {wm sizefrom .t none} msg] $msg
+} {1 {bad argument "none": must be program or user}}
+
+test unixWm-35.1 {Tk_WmCmd procedure, "state" option} {
+ list [catch {wm state .t 1} msg] $msg
+} {1 {wrong # arguments: must be "wm state window"}}
+test unixWm-35.2 {Tk_WmCmd procedure, "state" option} {
+ set result {}
+ catch {destroy .t2}
+ toplevel .t2 -width 120 -height 300
+ wm geometry .t2 +0+0
+ lappend result [wm state .t2]
+ update
+ lappend result [wm state .t2]
+ wm withdraw .t2
+ lappend result [wm state .t2]
+ wm iconify .t2
+ lappend result [wm state .t2]
+ wm deiconify .t2
+ lappend result [wm state .t2]
+ destroy .t2
+ set result
+} {normal normal withdrawn iconic normal}
+
+test unixWm-36.1 {Tk_WmCmd procedure, "title" option} {
+ list [catch {wm title .t 1 2} msg] $msg
+} {1 {wrong # arguments: must be "wm title window ?newTitle?"}}
+test unixWm-36.2 {Tk_WmCmd procedure, "title" option} {unixOnly} {
+ set result {}
+ lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME]
+ wm title .t "Test window"
+ set bit [format 0x%x [expr 0xa & [lindex [testprop [testwrapper .t] \
+ WM_NORMAL_HINTS] 0]]]
+ lappend result [wm title .t] [testprop [testwrapper .t] WM_NAME]
+} {t t {Test window} {Test window}}
+
+test unixWm-37.1 {Tk_WmCmd procedure, "transient" option} {
+ list [catch {wm transient .t 1 2} msg] $msg
+} {1 {wrong # arguments: must be "wm transient window ?master?"}}
+test unixWm-37.2 {Tk_WmCmd procedure, "transient" option} {
+ list [catch {wm transient .t foo} msg] $msg
+} {1 {bad window path name "foo"}}
+test unixWm-37.3 {Tk_WmCmd procedure, "transient" option} {unixOnly} {
+ set result {}
+ catch {destroy .t2}
+ toplevel .t2 -width 120 -height 300
+ wm geometry .t2 +0+0
+ update
+ lappend result [wm transient .t2] \
+ [testprop [testwrapper .t2] WM_TRANSIENT_FOR]
+ wm transient .t2 .t
+ set transient [testprop [testwrapper .t2] WM_TRANSIENT_FOR]
+ lappend result [wm transient .t2] [expr [testwrapper .t] - $transient]
+ wm transient .t2 {}
+ lappend result [wm transient .t2] \
+ [testprop [testwrapper .t2] WM_TRANSIENT_FOR]
+ destroy .t2
+ set result
+} {{} {} .t 0 {} 0x0}
+test unixWm-37.4 {Tk_WmCmd procedure, "transient" option, create master wrapper} {unixOnly} {
+ catch {destroy .t2}
+ catch {destroy .t3}
+ toplevel .t2 -width 120 -height 300
+ wm geometry .t2 +0+0
+ toplevel .t3 -width 120 -height 300
+ wm geometry .t2 +0+0
+ set result [list [testwrapper .t2]]
+ wm transient .t3 .t2
+ lappend result [expr {[testwrapper .t2] == ""}]
+ destroy .t2 .t3
+ set result
+} {{} 0}
+
+test unixWm-38.1 {Tk_WmCmd procedure, "withdraw" option} {
+ list [catch {wm withdraw .t 1} msg] $msg
+} {1 {wrong # arguments: must be "wm withdraw window"}}
+test unixWm-38.2 {Tk_WmCmd procedure, "withdraw" option} {
+ catch {destroy .t2}
+ toplevel .t2 -width 120 -height 300
+ wm geometry .t2 +0+0
+ wm iconwindow .t .t2
+ set result [list [catch {wm withdraw .t2} msg] $msg]
+ destroy .t2
+ set result
+} {1 {can't withdraw .t2: it is an icon for .t}}
+test unixWm-38.3 {Tk_WmCmd procedure, "withdraw" option} {
+ set result {}
+ wm withdraw .t
+ lappend result [wm state .t] [winfo ismapped .t]
+ wm deiconify .t
+ lappend result [wm state .t] [winfo ismapped .t]
+} {withdrawn 0 normal 1}
+
+test unixWm-39.1 {Tk_WmCmd procedure, miscellaneous} {
+ list [catch {wm unknown .t} msg] $msg
+} {1 {unknown or ambiguous option "unknown": must be aspect, client, command, deiconify, focusmodel, frame, geometry, grid, group, iconbitmap, iconify, iconmask, iconname, iconposition, iconwindow, maxsize, minsize, overrideredirect, positionfrom, protocol, resizable, sizefrom, state, title, transient, or withdraw}}
+
+catch {destroy .t}
+catch {destroy .icon}
+
+test unixWm-40.1 {Tk_SetGrid procedure, set grid dimensions before turning on grid} {nonPortable} {
+ catch {destroy .t}
+ toplevel .t
+ wm geometry .t 30x10+0+0
+ listbox .t.l -height 20 -width 20 -setgrid 1
+ pack .t.l -fill both -expand 1
+ update
+ wm geometry .t
+} {30x10+0+0}
+test unixWm-40.2 {Tk_SetGrid procedure, turning on grid when dimensions already set} {
+ catch {destroy .t}
+ toplevel .t
+ wm geometry .t 200x100+0+0
+ listbox .t.l -height 20 -width 20
+ pack .t.l -fill both -expand 1
+ update
+ .t.l configure -setgrid 1
+ update
+ wm geometry .t
+} {20x20+0+0}
+
+test unixWm-41.1 {ConfigureEvent procedure, internally generated size changes} {
+ catch {destroy .t}
+ toplevel .t -width 400 -height 150
+ wm geometry .t +0+0
+ 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
+ testmenubar window .t .t.m
+ update
+ set result {}
+ bind .t <Configure> {
+ if {"%W" == ".t"} {
+ lappend result "%W: %wx%h"
+ }
+ }
+ bind .t.m <Configure> {lappend result "%W: %wx%h"}
+ wm geometry .t 200x300
+ update
+ lappend result [expr [winfo rootx .t.m] - $x] \
+ [expr [winfo rooty .t.m] - $y] \
+ [winfo width .t.m] [winfo height .t.m] \
+ [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y] \
+ [winfo width .t] [winfo height .t]
+} {{.t.m: 200x20} {.t: 200x300} 0 0 200 20 0 20 200 300}
+test unixWm-41.3 {ConfigureEvent procedure, synthesized Configure events} {
+ catch {destroy .t}
+ toplevel .t -width 400 -height 150
+ wm geometry .t +0+0
+ tkwait visibility .t
+ set result {no event}
+ bind .t <Configure> {set result "configured: %w %h"}
+ wm geometry .t +10+20
+ update
+ set result
+} {configured: 400 150}
+test unixWm-41.4 {ConfigureEvent procedure, synthesized Configure events} {
+ catch {destroy .t}
+ toplevel .t -width 400 -height 150
+ wm geometry .t +0+0
+ tkwait visibility .t
+ set result {no event}
+ bind .t <Configure> {set result "configured: %w %h"}
+ wm geometry .t 130x200
+ update
+ set result
+} {configured: 130 200}
+
+# No tests for ReparentEvent or ComputeReparentGeometry; I can't figure
+# out how to exercise these procedures reliably.
+
+test unixWm-42.1 {WrapperEventProc procedure, map and unmap events} {
+ catch {destroy .t}
+ toplevel .t -width 400 -height 150
+ wm geometry .t +0+0
+ tkwait visibility .t
+ set result {}
+ bind .t <Map> {set x "mapped"}
+ bind .t <Unmap> {set x "unmapped"}
+ set x {no event}
+ wm iconify .t
+ lappend result $x [winfo ismapped .t]
+ set x {no event}
+ wm deiconify .t
+ lappend result $x [winfo ismapped .t]
+} {unmapped 0 mapped 1}
+
+test unixWm-43.1 {TopLevelReqProc procedure, embedded in same process} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 200
+ wm geom .t +0+0
+ frame .t.f -container 1 -bd 2 -relief raised
+ place .t.f -x 20 -y 10
+ tkwait visibility .t.f
+ toplevel .t2 -use [winfo id .t.f] -width 30 -height 20 -bg blue
+ tkwait visibility .t2
+ set result {}
+ .t2 configure -width 70 -height 120
+ update
+ lappend result [winfo reqwidth .t.f] [winfo reqheight .t.f]
+ lappend result [winfo width .t2] [winfo height .t2]
+ # destroy .t2
+ set result
+} {70 120 70 120}
+test unixWm-43.2 {TopLevelReqProc procedure, resize causes window to move} \
+ {nonPortable} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 200
+ wm geom .t +0+0
+ update
+ wm geom .t -0-0
+ update
+ set x [winfo x .t]
+ set y [winfo y .t]
+ .t configure -width 300 -height 150
+ update
+ list [expr [winfo x .t] - $x] [expr [winfo y .t] - $y] \
+ [winfo width .t] [winfo height .t]
+} {-100 50 300 150}
+
+test unixWm-44.1 {UpdateGeometryInfo procedure, width/height computation} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 200
+ wm geometry .t +30+40
+ wm overrideredirect .t 1
+ tkwait visibility .t
+ .t configure -width 180 -height 20
+ update
+ list [winfo width .t] [winfo height .t]
+} {180 20}
+test unixWm-44.2 {UpdateGeometryInfo procedure, width/height computation} {
+ catch {destroy .t}
+ toplevel .t -width 80 -height 60
+ wm grid .t 5 4 10 12
+ wm geometry .t +30+40
+ wm overrideredirect .t 1
+ tkwait visibility .t
+ wm geometry .t 10x2
+ update
+ list [winfo width .t] [winfo height .t]
+} {130 36}
+test unixWm-44.3 {UpdateGeometryInfo procedure, width/height computation} {
+ catch {destroy .t}
+ toplevel .t -width 80 -height 60
+ wm grid .t 5 4 10 12
+ wm geometry .t +30+40
+ wm overrideredirect .t 1
+ tkwait visibility .t
+ wm geometry .t 1x10
+ update
+ list [winfo width .t] [winfo height .t]
+} {40 132}
+test unixWm-44.4 {UpdateGeometryInfo procedure, width/height computation} {
+ catch {destroy .t}
+ toplevel .t -width 100 -height 200
+ wm geometry .t +30+40
+ wm overrideredirect .t 1
+ tkwait visibility .t
+ wm geometry .t 300x150
+ update
+ list [winfo width .t] [winfo height .t]
+} {300 150}
+test unixWm-44.5 {UpdateGeometryInfo procedure, negative width} {
+ catch {destroy .t}
+ toplevel .t -width 80 -height 60
+ wm grid .t 18 7 10 12
+ wm geometry .t +30+40
+ wm overrideredirect .t 1
+ tkwait visibility .t
+ wm geometry .t 5x8
+ update
+ list [winfo width .t] [winfo height .t]
+} {1 72}
+test unixWm-44.6 {UpdateGeometryInfo procedure, negative height} {
+ catch {destroy .t}
+ toplevel .t -width 80 -height 60
+ wm grid .t 18 7 10 12
+ 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
+ update
+ set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
+ list [expr [lindex $property 5]] [expr [lindex $property 6]] \
+ [expr [lindex $property 7]] [expr [lindex $property 8]]
+} {180 20 180 20}
+test unixWm-44.10 {UpdateGeometryInfo procedure, menubar changing} {
+ 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 50
+ frame .t.m -bd 2 -relief raised -width 100 -height 50
+ testmenubar window .t .t.m
+ update
+ .t configure -height 70
+ .t.m configure -height 30
+ list [update] [destroy .t]
+} {{} {}}
+
+test unixWm-45.1 {UpdateSizeHints procedure, grid information} {unixOnly} {
+ catch {destroy .t}
+ toplevel .t -width 80 -height 60
+ wm grid .t 6 10 10 5
+ wm minsize .t 2 4
+ wm maxsize .t 30 40
+ wm geometry .t +0+0
+ tkwait visibility .t
+ set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
+ list [expr [lindex $property 5]] [expr [lindex $property 6]] \
+ [expr [lindex $property 7]] [expr [lindex $property 8]] \
+ [expr [lindex $property 9]] [expr [lindex $property 10]]
+} {40 30 320 210 10 5}
+test unixWm-45.2 {UpdateSizeHints procedure} {unixOnly} {
+ catch {destroy .t}
+ toplevel .t -width 80 -height 60
+ wm minsize .t 30 40
+ wm maxsize .t 200 500
+ wm geometry .t +0+0
+ tkwait visibility .t
+ set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
+ list [expr [lindex $property 5]] [expr [lindex $property 6]] \
+ [expr [lindex $property 7]] [expr [lindex $property 8]] \
+ [expr [lindex $property 9]] [expr [lindex $property 10]]
+} {30 40 200 500 1 1}
+test unixWm-45.3 {UpdateSizeHints procedure, grid with menu} {
+ catch {destroy .t}
+ toplevel .t -width 80 -height 60
+ frame .t.menu -height 23 -width 50
+ testmenubar window .t .t.menu
+ wm grid .t 6 10 10 5
+ wm minsize .t 2 4
+ wm maxsize .t 30 40
+ wm geometry .t +0+0
+ tkwait visibility .t
+ set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
+ list [winfo height .t] \
+ [expr [lindex $property 5]] [expr [lindex $property 6]] \
+ [expr [lindex $property 7]] [expr [lindex $property 8]] \
+ [expr [lindex $property 9]] [expr [lindex $property 10]]
+} {60 40 53 320 233 10 5}
+test unixWm-45.4 {UpdateSizeHints procedure, not resizable with menu} {
+ catch {destroy .t}
+ toplevel .t -width 80 -height 60
+ frame .t.menu -height 23 -width 50
+ testmenubar window .t .t.menu
+ wm resizable .t 0 0
+ wm geometry .t +0+0
+ tkwait visibility .t
+ set property [testprop [testwrapper .t] WM_NORMAL_HINTS]
+ list [winfo height .t] \
+ [expr [lindex $property 5]] [expr [lindex $property 6]] \
+ [expr [lindex $property 7]] [expr [lindex $property 8]] \
+ [expr [lindex $property 9]] [expr [lindex $property 10]]
+} {60 80 83 80 83 1 1}
+
+# I don't know how to test WaitForConfigureNotify.
+
+test unixWm-46.1 {WaitForEvent procedure, use of modal timeout} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 200
+ wm geom .t +0+0
+ update
+ wm iconify .t
+ set x no
+ after 0 {set x yes}
+ wm deiconify .t
+ set result $x
+ update
+ list $result $x
+} {no yes}
+
+test unixWm-47.1 {WaitRestrictProc procedure} {
+ catch {destroy .t}
+ toplevel .t -width 300 -height 200
+ frame .t.f -bd 2 -relief raised
+ place .t.f -x 20 -y 30 -width 100 -height 20
+ wm geometry .t +0+0
+ tkwait visibility .t
+ set result {}
+ bind .t.f <Configure> {lappend result {configure on .t.f}}
+ bind .t <Map> {lappend result {map on .t}}
+ bind .t <Unmap> {lappend result {unmap on .t}; bind .t <Unmap> {}}
+ bind .t <Button> {lappend result {button %b on .t}}
+ event generate .t.f <Configure> -when tail
+ event generate .t <Configure> -when tail
+ event generate .t <Button> -button 3 -when tail
+ event generate .t <Map> -when tail
+ lappend result iconify
+ wm iconify .t
+ lappend result done
+ update
+ set result
+} {iconify {unmap on .t} done {configure on .t.f} {button 3 on .t} {map on .t}}
+
+# I don't know how to test WaitTimeoutProc, WaitForMapNotify, or UpdateHints.
+
+catch {destroy .t}
+toplevel .t -width 300 -height 200
+wm geometry .t +0+0
+tkwait visibility .t
+
+test unixWm-48.1 {ParseGeometry procedure} {
+ wm geometry .t =100x120
+ update
+ list [winfo width .t] [winfo height .t]
+} {100 120}
+test unixWm-48.2 {ParseGeometry procedure} {
+ list [catch {wm geometry .t =10zx120} msg] $msg
+} {1 {bad geometry specifier "=10zx120"}}
+test unixWm-48.3 {ParseGeometry procedure} {
+ list [catch {wm geometry .t x120} msg] $msg
+} {1 {bad geometry specifier "x120"}}
+test unixWm-48.4 {ParseGeometry procedure} {
+ list [catch {wm geometry .t =100x120a} msg] $msg
+} {1 {bad geometry specifier "=100x120a"}}
+test unixWm-48.5 {ParseGeometry procedure} {
+ list [catch {wm geometry .t z} msg] $msg
+} {1 {bad geometry specifier "z"}}
+test unixWm-48.6 {ParseGeometry procedure} {
+ list [catch {wm geometry .t +20&} msg] $msg
+} {1 {bad geometry specifier "+20&"}}
+test unixWm-48.7 {ParseGeometry procedure} {
+ list [catch {wm geometry .t +-} msg] $msg
+} {1 {bad geometry specifier "+-"}}
+test unixWm-48.8 {ParseGeometry procedure} {
+ list [catch {wm geometry .t +20a} msg] $msg
+} {1 {bad geometry specifier "+20a"}}
+test unixWm-48.9 {ParseGeometry procedure} {
+ list [catch {wm geometry .t +20-} msg] $msg
+} {1 {bad geometry specifier "+20-"}}
+test unixWm-48.10 {ParseGeometry procedure} {
+ list [catch {wm geometry .t +20+10z} msg] $msg
+} {1 {bad geometry specifier "+20+10z"}}
+test unixWm-48.11 {ParseGeometry procedure} {
+ catch {wm geometry .t +-10+20}
+} {0}
+test unixWm-48.12 {ParseGeometry procedure} {
+ catch {wm geometry .t +30+-10}
+} {0}
+test unixWm-48.13 {ParseGeometry procedure, resize causes window to move} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 200
+ wm geom .t +0+0
+ update
+ wm geom .t -0-0
+ update
+ set x [winfo x .t]
+ set y [winfo y .t]
+ wm geometry .t 150x300
+ update
+ list [expr [winfo x .t] - $x] [expr [winfo y .t] - $y] \
+ [winfo width .t] [winfo height .t]
+} {50 -100 150 300}
+
+test unixWm-49.1 {Tk_GetRootCoords procedure} {
+ catch {destroy .t}
+ toplevel .t -width 300 -height 200
+ frame .t.f -width 150 -height 100 -bd 2 -relief raised
+ place .t.f -x 150 -y 120
+ frame .t.f.f -width 20 -height 20 -bd 2 -relief raised
+ place .t.f.f -x 10 -y 20
+ wm overrideredirect .t 1
+ wm geometry .t +40+50
+ tkwait visibility .t
+ list [winfo rootx .t.f.f] [winfo rooty .t.f.f]
+} {202 192}
+test unixWm-49.2 {Tk_GetRootCoords 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 -width 100 -height 30
+ frame .t.m.f -width 20 -height 10 -bd 2 -relief raised
+ place .t.m.f -x 50 -y 5
+ frame .t.f -width 20 -height 30 -bd 2 -relief raised
+ place .t.f -x 10 -y 30
+ testmenubar window .t .t.m
+ update
+ list [expr [winfo rootx .t.m.f] - $x] [expr [winfo rooty .t.m.f] - $y] \
+ [expr [winfo rootx .t.f] - $x] [expr [winfo rooty .t.f] - $y]
+} {52 7 12 62}
+
+foreach w [winfo children .] {
+ catch {destroy $w}
+}
+wm iconify .
+test unixWm-50.1 {Tk_CoordsToWindow procedure, finding a toplevel, x-coords} {
+ eval destroy [winfo children .]
+ toplevel .t -width 300 -height 400 -bg green
+ wm geom .t +40+0
+ tkwait visibility .t
+ toplevel .t2 -width 100 -height 80 -bg red
+ wm geom .t2 +140+200
+ tkwait visibility .t2
+ raise .t2
+ set x [winfo rootx .t]
+ set y [winfo rooty .t]
+ list [winfo containing [expr $x - 30] [expr $y + 250]] \
+ [winfo containing [expr $x - 1] [expr $y + 250]] \
+ [winfo containing $x [expr $y + 250]] \
+ [winfo containing [expr $x + 99] [expr $y + 250]] \
+ [winfo containing [expr $x + 100] [expr $y + 250]] \
+ [winfo containing [expr $x + 199] [expr $y + 250]] \
+ [winfo containing [expr $x + 200] [expr $y + 250]] \
+ [winfo containing [expr $x + 220] [expr $y + 250]]
+} {{} {} .t {} .t2 .t2 {} .t}
+test unixWm-50.2 {Tk_CoordsToWindow procedure, finding a toplevel, y-coords and overrideredirect} {
+ eval destroy [winfo children .]
+ toplevel .t -width 300 -height 400 -bg yellow
+ wm geom .t +0+50
+ tkwait visibility .t
+ toplevel .t2 -width 100 -height 80 -bg blue
+ wm overrideredirect .t2 1
+ wm geom .t2 +100+200
+ tkwait visibility .t2
+ raise .t2
+ set x [winfo rootx .t]
+ set y [winfo rooty .t]
+ set y2 [winfo rooty .t2]
+ list [winfo containing [expr $x +150] 10] \
+ [winfo containing [expr $x +150] [expr $y - 1]] \
+ [winfo containing [expr $x +150] $y] \
+ [winfo containing [expr $x +150] [expr $y2 - 1]] \
+ [winfo containing [expr $x +150] $y2] \
+ [winfo containing [expr $x +150] [expr $y2 + 79]] \
+ [winfo containing [expr $x +150] [expr $y2 + 80]] \
+ [winfo containing [expr $x +150] [expr $y + 450]]
+} {{} {} .t .t .t2 .t2 .t {}}
+test unixWm-50.3 {Tk_CoordsToWindow procedure, finding a toplevel with embedding} {
+ eval destroy [winfo children .]
+ toplevel .t -width 300 -height 400 -bg blue
+ wm geom .t +0+50
+ frame .t.f -container 1
+ place .t.f -x 150 -y 50
+ tkwait visibility .t.f
+ setupbg
+ dobg "
+ wm withdraw .
+ toplevel .x -width 100 -height 80 -use [winfo id .t.f] -bg yellow
+ tkwait visibility .x"
+ set result [dobg {
+ set x [winfo rootx .x]
+ set y [winfo rooty .x]
+ list [winfo containing [expr $x - 1] [expr $y + 50]] \
+ [winfo containing $x [expr $y +50]]
+ }]
+ set x [winfo rootx .t]
+ set y [winfo rooty .t]
+ lappend result [winfo containing [expr $x + 200] [expr $y + 49]] \
+ [winfo containing [expr $x + 200] [expr $y +50]]
+} {{} .x .t .t.f}
+cleanupbg
+test unixWm-50.4 {Tk_CoordsToWindow procedure, window in other application} {
+ catch {destroy .t}
+ catch {interp delete slave}
+ toplevel .t -width 200 -height 200 -bg green
+ wm geometry .t +0+0
+ tkwait visibility .t
+ interp create slave
+ load {} tk slave
+ slave eval {wm geometry . 200x200+0+0; tkwait visibility .}
+ set result [list [winfo containing 100 100] \
+ [slave eval {winfo containing 100 100}]]
+ interp delete slave
+ set result
+} {{} .}
+test unixWm-50.5 {Tk_CoordsToWindow procedure, handling menubars} {unixOnly} {
+ eval destroy [winfo children .]
+ toplevel .t -width 300 -height 400 -bd 2 -relief raised
+ frame .t.f -width 150 -height 120 -bg green
+ place .t.f -x 10 -y 150
+ wm geom .t +0+50
+ frame .t.menu -width 100 -height 30 -bd 2 -relief raised
+ frame .t.menu.f -width 40 -height 20 -bg purple
+ place .t.menu.f -x 30 -y 10
+ testmenubar window .t .t.menu
+ tkwait visibility .t.menu
+ update
+ set x [winfo rootx .t]
+ set y [winfo rooty .t]
+ list [winfo containing $x [expr $y - 31]] \
+ [winfo containing $x [expr $y - 30]] \
+ [winfo containing [expr $x + 50] [expr $y - 19]] \
+ [winfo containing [expr $x + 50] [expr $y - 18]] \
+ [winfo containing [expr $x + 50] $y] \
+ [winfo containing [expr $x + 11] [expr $y + 152]] \
+ [winfo containing [expr $x + 12] [expr $y + 152]]
+} {{} .t.menu .t.menu .t.menu.f .t .t .t.f}
+test unixWm-50.6 {Tk_CoordsToWindow procedure, embedding within one app.} {
+ eval destroy [winfo children .]
+ toplevel .t -width 300 -height 400 -bg orange
+ wm geom .t +0+50
+ frame .t.f -container 1
+ place .t.f -x 150 -y 50
+ tkwait visibility .t.f
+ toplevel .t2 -width 100 -height 80 -bg green -use [winfo id .t.f]
+ tkwait visibility .t2
+ update
+ set x [winfo rootx .t]
+ set y [winfo rooty .t]
+ list [winfo containing [expr $x +149] [expr $y + 80]] \
+ [winfo containing [expr $x +150] [expr $y +80]] \
+ [winfo containing [expr $x +249] [expr $y +80]] \
+ [winfo containing [expr $x +250] [expr $y +80]]
+} {.t .t2 .t2 .t}
+test unixWm-50.7 {Tk_CoordsToWindow procedure, more basics} {
+ catch {destroy .t}
+ toplevel .t -width 300 -height 400 -bg green
+ wm geom .t +0+0
+ frame .t.f -width 100 -height 200 -bd 2 -relief raised
+ place .t.f -x 100 -y 100
+ frame .t.f.f -width 100 -height 200 -bd 2 -relief raised
+ place .t.f.f -x 0 -y 100
+ tkwait visibility .t.f.f
+ set x [expr [winfo rootx .t] + 150]
+ set y [winfo rooty .t]
+ list [winfo containing $x [expr $y + 50]] \
+ [winfo containing $x [expr $y + 150]] \
+ [winfo containing $x [expr $y + 250]] \
+ [winfo containing $x [expr $y + 350]] \
+ [winfo containing $x [expr $y + 450]]
+} {.t .t.f .t.f.f .t {}}
+test unixWm-50.8 {Tk_CoordsToWindow procedure, more basics} {
+ catch {destroy .t}
+ toplevel .t -width 400 -height 300 -bg green
+ wm geom .t +0+0
+ frame .t.f -width 200 -height 100 -bd 2 -relief raised
+ place .t.f -x 100 -y 100
+ frame .t.f.f -width 200 -height 100 -bd 2 -relief raised
+ place .t.f.f -x 100 -y 0
+ update
+ set x [winfo rooty .t]
+ set y [expr [winfo rooty .t] + 150]
+ list [winfo containing [expr $x + 50] $y] \
+ [winfo containing [expr $x + 150] $y] \
+ [winfo containing [expr $x + 250] $y] \
+ [winfo containing [expr $x + 350] $y] \
+ [winfo containing [expr $x + 450] $y]
+} {.t .t.f .t.f.f .t {}}
+test unixWm-50.9 {Tk_CoordsToWindow procedure, unmapped windows} {
+ catch {destroy .t}
+ catch {destroy .t2}
+ sleep 500 ;# Give window manager time to catch up.
+ toplevel .t -width 200 -height 200 -bg green
+ wm geometry .t +0+0
+ tkwait visibility .t
+ toplevel .t2 -width 200 -height 200 -bg red
+ wm geometry .t2 +0+0
+ tkwait visibility .t2
+ set result [list [winfo containing 100 100]]
+ wm iconify .t2
+ lappend result [winfo containing 100 100]
+} {.t2 .t}
+test unixWm-50.10 {Tk_CoordsToWindow procedure, unmapped windows} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 200 -bg green
+ wm geometry .t +0+0
+ frame .t.f -width 150 -height 150 -bd 2 -relief raised
+ place .t.f -x 25 -y 25
+ tkwait visibility .t.f
+ set result [list [winfo containing 100 100]]
+ place forget .t.f
+ update
+ lappend result [winfo containing 100 100]
+} {.t.f .t}
+eval destroy [winfo children .]
+wm deiconify .
+
+# No tests for UpdateVRootGeometry, Tk_GetVRootGeometry,
+# Tk_MoveToplevelWindow, UpdateWmProtocols, or TkWmProtocolEventProc.
+
+test unixWm-51.1 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
+ makeToplevels
+ update
+ raise .raise1
+ winfo containing [winfo rootx .raise1] [winfo rooty .raise1]
+} .raise1
+test unixWm-51.2 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
+ makeToplevels
+ update
+ raise .raise2
+ winfo containing [winfo rootx .raise1] [winfo rooty .raise1]
+} .raise2
+test unixWm-51.3 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
+ makeToplevels
+ update
+ raise .raise3
+ raise .raise2
+ raise .raise1 .raise3
+ set result [winfo containing [winfo rootx .raise1] \
+ [winfo rooty .raise1]]
+ destroy .raise2
+ sleep 500
+ list $result [winfo containing [winfo rootx .raise1] \
+ [winfo rooty .raise1]]
+} {.raise2 .raise1}
+test unixWm-51.4 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
+ makeToplevels
+ raise .raise2
+ raise .raise1
+ lower .raise3 .raise1
+ set result [winfo containing 100 100]
+ destroy .raise1
+ sleep 500
+ lappend result [winfo containing 100 100]
+} {.raise1 .raise3}
+test unixWm-51.5 {TkWmRestackToplevel procedure, basic tests} {nonPortable} {
+ makeToplevels
+ update
+ raise .raise2
+ raise .raise1
+ raise .raise3
+ frame .raise1.f1
+ frame .raise1.f1.f2
+ lower .raise3 .raise1.f1.f2
+ set result [winfo containing [winfo rootx .raise1] \
+ [winfo rooty .raise1]]
+ destroy .raise1
+ sleep 500
+ list $result [winfo containing [winfo rootx .raise2] \
+ [winfo rooty .raise2]]
+} {.raise1 .raise3}
+foreach w [winfo children .] {
+ catch {destroy $w}
+}
+test unixWm-51.6 {TkWmRestackToplevel procedure, window to be stacked isn't mapped} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 200 -bg green
+ wm geometry .t +0+0
+ tkwait visibility .t
+ catch {destroy .t2}
+ toplevel .t2 -width 200 -height 200 -bg red
+ wm geometry .t2 +0+0
+ winfo containing 100 100
+} {.t}
+test unixWm-51.7 {TkWmRestackToplevel procedure, other window isn't mapped} {
+ foreach w {.t .t2 .t3} {
+ catch {destroy $w}
+ toplevel $w -width 200 -height 200 -bg green
+ wm geometry $w +0+0
+ }
+ raise .t .t2
+ update
+ set result [list [winfo containing 100 100]]
+ lower .t3
+ lappend result [winfo containing 100 100]
+} {.t3 .t}
+test unixWm-51.8 {TkWmRestackToplevel procedure, overrideredirect windows} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 200 -bg green
+ wm overrideredirect .t 1
+ wm geometry .t +0+0
+ tkwait visibility .t
+ catch {destroy .t2}
+ toplevel .t2 -width 200 -height 200 -bg red
+ wm overrideredirect .t2 1
+ wm geometry .t2 +0+0
+ tkwait visibility .t2
+
+ # Need to use vrootx and vrooty to make tests work correctly with
+ # virtual root window measures managers: overrideredirect windows
+ # come up at (0,0) in display coordinates, not virtual root
+ # coordinates.
+
+ set x [expr 100-[winfo vrootx .]]
+ set y [expr 100-[winfo vrooty .]]
+ set result [list [winfo containing $x $y]]
+ raise .t
+ lappend result [winfo containing $x $y]
+ raise .t2
+ lappend result [winfo containing $x $y]
+} {.t2 .t .t2}
+test unixWm-51.9 {TkWmRestackToplevel procedure, other window overrideredirect} {
+ foreach w {.t .t2 .t3} {
+ catch {destroy $w}
+ toplevel $w -width 200 -height 200 -bg green
+ wm overrideredirect $w 1
+ wm geometry $w +0+0
+ tkwait visibility $w
+ }
+ lower .t3 .t2
+ update
+
+ # Need to use vrootx and vrooty to make tests work correctly with
+ # virtual root window measures managers: overrideredirect windows
+ # come up at (0,0) in display coordinates, not virtual root
+ # coordinates.
+
+ set x [expr 100-[winfo vrootx .]]
+ set y [expr 100-[winfo vrooty .]]
+ set result [list [winfo containing $x $y]]
+ lower .t2
+ lappend result [winfo containing $x $y]
+} {.t2 .t3}
+test unixWm-51.10 {TkWmRestackToplevel procedure, don't move window that's already in the right place} {
+ makeToplevels
+ raise .raise1
+ set time [lindex [time {raise .raise1}] 0]
+ expr {$time < 2000000}
+} 1
+test unixWm-51.11 {TkWmRestackToplevel procedure, don't move window that's already in the right place} {
+ makeToplevels
+ set time [lindex [time {lower .raise1}] 0]
+ expr {$time < 2000000}
+} 1
+test unixWm-51.12 {TkWmRestackToplevel procedure, don't move window that's already in the right place} {
+ makeToplevels
+ set time [lindex [time {raise .raise3 .raise2}] 0]
+ expr {$time < 2000000}
+} 1
+test unixWm-51.13 {TkWmRestackToplevel procedure, don't move window that's already in the right place} {
+ makeToplevels
+ set time [lindex [time {lower .raise1 .raise2}] 0]
+ expr {$time < 2000000}
+} 1
+
+test unixWm-52.1 {TkWmAddToColormapWindows procedure} {
+ catch {destroy .t}
+ toplevel .t -width 200 -height 200 -colormap new -relief raised -bd 2
+ wm geom .t +0+0
+ update
+ wm colormap .t
+} {}
+test unixWm-52.2 {TkWmAddToColormapWindows procedure} {
+ catch {destroy .t}
+ toplevel .t -colormap new -relief raised -bd 2
+ wm geom .t +0+0
+ frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
+ pack .t.f
+ update
+ wm colormap .t
+} {.t.f .t}
+test unixWm-52.3 {TkWmAddToColormapWindows procedure} {
+ catch {destroy .t}
+ toplevel .t -colormap new
+ wm geom .t +0+0
+ frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
+ pack .t.f
+ frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2
+ pack .t.f2
+ update
+ wm colormap .t
+} {.t.f .t.f2 .t}
+test unixWm-52.4 {TkWmAddToColormapWindows procedure} {
+ catch {destroy .t}
+ toplevel .t -colormap new
+ wm geom .t +0+0
+ frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
+ pack .t.f
+ update
+ wm colormapwindows .t .t.f
+ frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2
+ pack .t.f2
+ update
+ wm colormapwindows .t
+} {.t.f}
+
+test unixWm-53.1 {TkWmRemoveFromColormapWindows procedure} {
+ catch {destroy .t}
+ toplevel .t -colormap new
+ wm geom .t +0+0
+ frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
+ pack .t.f
+ frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2
+ pack .t.f2
+ update
+ destroy .t.f2
+ wm colormap .t
+} {.t.f .t}
+test unixWm-53.2 {TkWmRemoveFromColormapWindows procedure} {
+ catch {destroy .t}
+ toplevel .t -colormap new
+ wm geom .t +0+0
+ frame .t.f -width 100 -height 100 -colormap new -relief sunken -bd 2
+ pack .t.f
+ frame .t.f2 -width 100 -height 100 -colormap new -relief sunken -bd 2
+ pack .t.f2
+ update
+ wm colormapwindows .t .t.f2
+ destroy .t.f2
+ wm colormap .t
+} {}
+
+test unixWm-54.1 {TkpMakeMenuWindow procedure, setting save_under} {
+ catch {destroy .t}
+ catch {destroy .m}
+ toplevel .t -width 300 -height 200 -bd 2 -relief raised
+ bind .t <Expose> {set x exposed}
+ wm geom .t +0+0
+ update
+ menu .m
+ .m add command -label First
+ .m add command -label Second
+ .m add command -label Third
+ .m post 30 30
+ update
+ set x {no event}
+ destroy .m
+ set x
+} {no event}
+test unixWm-54.2 {TkpMakeMenuWindow procedure, setting override_redirect} {
+ catch {destroy .m}
+ menu .m
+ .m add command -label First
+ .m add command -label Second
+ .m add command -label Third
+ .m post 30 30
+ update
+ set result [wm overrideredirect .m]
+ destroy .m
+ set result
+} {1}
+
+# No tests for TkGetPointerCoords, CreateWrapper, or GetMaxSize.
+
+test unixWm-55.1 {TkUnixSetMenubar procedure} {unixOnly} {
+ catch {destroy .t}
+ toplevel .t -width 300 -height 200 -bd 2 -relief raised
+ wm geom .t +0+0
+ update
+ frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
+ testmenubar window .t .t.f
+ update
+ list [winfo ismapped .t.f] [winfo geometry .t.f] \
+ [expr [winfo rootx .t] - [winfo rootx .t.f]] \
+ [expr [winfo rooty .t] - [winfo rooty .t.f]]
+} {1 300x30+0+0 0 30}
+test unixWm-55.2 {TkUnixSetMenubar procedure, removing menubar} {unixOnly} {
+ catch {destroy .t}
+ catch {destroy .f}
+ 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 .f -width 400 -height 30 -bd 2 -relief raised -bg green
+ testmenubar window .t .f
+ update
+ testmenubar window .t {}
+ update
+ list [winfo ismapped .f] [winfo geometry .f] \
+ [expr [winfo rootx .t] - $x] \
+ [expr [winfo rooty .t] - $y] \
+ [expr [winfo rootx .] - [winfo rootx .f]] \
+ [expr [winfo rooty .] - [winfo rooty .f]]
+} {0 300x30+0+0 0 0 0 0}
+test unixWm-55.3 {TkUnixSetMenubar procedure, removing geometry manager} {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.f -width 400 -height 30 -bd 2 -relief raised -bg green
+ testmenubar window .t .t.f
+ update
+ testmenubar window .t {}
+ update
+ set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]"
+ .t.f configure -height 100
+ update
+ lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]
+} {0 0 0 0}
+test unixWm-55.4 {TkUnixSetMenubar procedure, toplevel not yet created} {unixOnly} {
+ catch {destroy .t}
+ toplevel .t -width 300 -height 200 -bd 2 -relief raised
+ frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
+ testmenubar window .t .t.f
+ wm geom .t +0+0
+ update
+ list [winfo ismapped .t.f] [winfo geometry .t.f] \
+ [expr [winfo rootx .t] - [winfo rootx .t.f]] \
+ [expr [winfo rooty .t] - [winfo rooty .t.f]]
+} {1 300x30+0+0 0 30}
+test unixWm-55.5 {TkUnixSetMenubar procedure, changing menubar} {unixOnly} {
+ catch {destroy .t}
+ catch {destroy .f}
+ toplevel .t -width 300 -height 200 -bd 2 -relief raised
+ frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
+ wm geom .t +0+0
+ update
+ set y [winfo rooty .t]
+ frame .f -width 400 -height 50 -bd 2 -relief raised -bg green
+ testmenubar window .t .t.f
+ update
+ set result {}
+ lappend result [winfo ismapped .f] [winfo ismapped .t.f]
+ lappend result [expr [winfo rooty .t.f] - $y]
+ testmenubar window .t .f
+ update
+ lappend result [winfo ismapped .f] [winfo ismapped .t.f]
+ lappend result [expr [winfo rooty .f] - $y]
+} {0 1 0 1 0 0}
+test unixWm-55.6 {TkUnixSetMenubar procedure, changing menubar to self} {unixOnly} {
+ catch {destroy .t}
+ toplevel .t -width 300 -height 200 -bd 2 -relief raised
+ frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
+ testmenubar window .t .t.f
+ wm geom .t +0+0
+ update
+ testmenubar window .t .t.f
+ update
+ list [winfo ismapped .t.f] [winfo geometry .t.f] \
+ [expr [winfo rootx .t] - [winfo rootx .t.f]] \
+ [expr [winfo rooty .t] - [winfo rooty .t.f]]
+} {1 300x30+0+0 0 30}
+test unixWm-55.7 {TkUnixSetMenubar procedure, unsetting event handler} {unixOnly} {
+ catch {destroy .t}
+ catch {destroy .f}
+ toplevel .t -width 300 -height 200 -bd 2 -relief raised
+ frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
+ frame .f -width 400 -height 40 -bd 2 -relief raised -bg blue
+ wm geom .t +0+0
+ update
+ set y [winfo rooty .t]
+ testmenubar window .t .t.f
+ update
+ set result [expr [winfo rooty .t] - $y]
+ testmenubar window .t .f
+ update
+ lappend result [expr [winfo rooty .t] - $y]
+ destroy .t.f
+ update
+ lappend result [expr [winfo rooty .t] - $y]
+} {30 40 40}
+
+test unixWm-56.1 {MenubarDestroyProc procedure} {unixOnly} {
+ catch {destroy .t}
+ toplevel .t -width 300 -height 200 -bd 2 -relief raised
+ wm geom .t +0+0
+ update
+ set y [winfo rooty .t]
+ frame .t.f -width 400 -height 30 -bd 2 -relief raised -bg green
+ testmenubar window .t .t.f
+ update
+ set result [expr [winfo rooty .t] - $y]
+ destroy .t.f
+ update
+ lappend result [expr [winfo rooty .t] - $y]
+} {30 0}
+
+test unixWm-57.1 {MenubarReqProc procedure} {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.f -width 400 -height 10 -bd 2 -relief raised -bg green
+ testmenubar window .t .t.f
+ update
+ set result "[expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]"
+ .t.f configure -height 100
+ update
+ lappend result [expr [winfo rootx .t] - $x] [expr [winfo rooty .t] - $y]
+} {0 10 0 100}
+test unixWm-57.2 {MenubarReqProc procedure} {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.f -width 400 -height 20 -bd 2 -relief raised -bg green
+ 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} {
+ 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}
+ x eval {
+ button .b -text hello
+ bind .b <Destroy> foo
+ }
+ 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 {}
diff --git a/tk/tests/util.test b/tk/tests/util.test
new file mode 100644
index 00000000000..416de65957f
--- /dev/null
+++ b/tk/tests/util.test
@@ -0,0 +1,70 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[string compare test [info procs test]] == 1} then \
+ {source defs}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+wm geometry . {}
+raise .
+
+listbox .l -width 20 -height 5 -relief sunken -bd 2
+pack .l
+.l insert 0 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19
+update
+test util-1.1 {Tk_GetScrollInfo procedure} {
+ list [catch {.l yview moveto a b} msg] $msg
+} {1 {wrong # args: should be ".l yview moveto fraction"}}
+test util-1.2 {Tk_GetScrollInfo procedure} {
+ list [catch {.l yview moveto xyz} msg] $msg
+} {1 {expected floating-point number but got "xyz"}}
+test util-1.3 {Tk_GetScrollInfo procedure} {
+ .l yview 0
+ .l yview moveto .5
+ .l yview
+} {0.5 0.75}
+test util-1.4 {Tk_GetScrollInfo procedure} {
+ list [catch {.l yview scroll a} msg] $msg
+} {1 {wrong # args: should be ".l yview scroll number units|pages"}}
+test util-1.5 {Tk_GetScrollInfo procedure} {
+ list [catch {.l yview scroll a b c} msg] $msg
+} {1 {wrong # args: should be ".l yview scroll number units|pages"}}
+test util-1.6 {Tk_GetScrollInfo procedure} {
+ list [catch {.l yview scroll xyz units} msg] $msg
+} {1 {expected integer but got "xyz"}}
+test util-1.7 {Tk_GetScrollInfo procedure} {
+ .l yview 0
+ .l yview scroll 2 pages
+ .l nearest 0
+} {6}
+test util-1.8 {Tk_GetScrollInfo procedure} {
+ .l yview 15
+ .l yview scroll -2 pages
+ .l nearest 0
+} {9}
+test util-1.9 {Tk_GetScrollInfo procedure} {
+ .l yview 0
+ .l yview scroll 2 units
+ .l nearest 0
+} {2}
+test util-1.10 {Tk_GetScrollInfo procedure} {
+ .l yview 15
+ .l yview scroll -2 units
+ .l nearest 0
+} {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}}
diff --git a/tk/tests/visual.test b/tk/tests/visual.test
new file mode 100644
index 00000000000..82408bf061b
--- /dev/null
+++ b/tk/tests/visual.test
@@ -0,0 +1,312 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[info procs test] != "test"} {
+ source defs
+}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+wm geometry . {}
+raise .
+update
+
+# 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.
+
+proc eatColors {w} {
+ catch {destroy $w}
+ toplevel $w
+ wm geom $w +0+0
+ canvas $w.c -width 400 -height 200 -bd 0
+ pack $w.c
+ for {set y 0} {$y < 8} {incr y} {
+ for {set x 0} {$x < 40} {incr x} {
+ set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0]
+ $w.c create rectangle [expr 10*$x] [expr 20*$y] \
+ [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \
+ -fill $color
+ }
+ }
+ update
+}
+
+# colorsFree --
+#
+# Returns 1 if there appear to be free colormap entries in a window,
+# 0 otherwise.
+#
+# Arguments:
+# w - Name of window in which to check.
+# red, green, blue - Intensities to use in a trial color allocation
+# to see if there are colormap entries free.
+
+proc colorsFree {w {red 31} {green 245} {blue 192}} {
+ set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]]
+ expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) \
+ && ([lindex $vals 2]/256 == $blue)
+}
+
+# If more than one visual type is available for the screen, pick one
+# that is *not* the default.
+
+set default "[winfo visual .] [winfo depth .]"
+set avail [winfo visualsavailable .]
+set other {}
+if {[llength $avail] > 1} {
+ foreach visual $avail {
+ if {$visual != $default} {
+ set other $visual
+ break
+ }
+ }
+}
+
+test visual-1.1 {Tk_GetVisual, copying from other window} {
+ list [catch {toplevel .t -visual .foo.bar} msg] $msg
+} {1 {bad window path name ".foo.bar"}}
+if {$other != ""} {
+ test visual-1.2 {Tk_GetVisual, copying from other window} {nonPortable} {
+ catch {destroy .t1}
+ catch {destroy .t2}
+ toplevel .t1 -width 250 -height 100 -visual $other
+ wm geom .t1 +0+0
+ toplevel .t2 -width 200 -height 80 -visual .t1
+ wm geom .t2 +5+5
+ concat "[winfo visual .t2] [winfo depth .t2]"
+ } $other
+ test visual-1.3 {Tk_GetVisual, copying from other window} {
+ catch {destroy .t1}
+ catch {destroy .t2}
+ toplevel .t1 -width 250 -height 100 -visual $other
+ wm geom .t1 +0+0
+ toplevel .t2 -width 200 -height 80 -visual .
+ wm geom .t2 +5+5
+ concat "[winfo visual .t2] [winfo depth .t2]"
+ } $default
+
+ # Make sure reference count is incremented when copying visual (the
+ # following test will cause the colormap to be freed prematurely if
+ # the reference count isn't incremented).
+ test visual-1.4 {Tk_GetVisual, colormap reference count} {
+ catch {destroy .t1}
+ catch {destroy .t2}
+ toplevel .t1 -width 250 -height 100 -visual $other
+ wm geom .t1 +0+0
+ set result [list [catch {toplevel .t2 -gorp 80 -visual .t1} msg] $msg]
+ update
+ set result
+ } {1 {unknown option "-gorp"}}
+}
+test visual-1.5 {Tk_GetVisual, default colormap} {
+ catch {destroy .t1}
+ toplevel .t1 -width 250 -height 100 -visual default
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} $default
+
+set i 1
+foreach visual $avail {
+ test visual-2.$i {Tk_GetVisual, different visual types} {nonPortable} {
+ catch {destroy .t1}
+ toplevel .t1 -width 250 -height 100 -visual $visual
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+ } $visual
+ incr i
+}
+
+test visual-3.1 {Tk_GetVisual, parsing visual string} {
+ catch {destroy .t1}
+ toplevel .t1 -width 250 -height 100 \
+ -visual "[winfo visual .][winfo depth .]"
+ wm geometry .t1 +0+0
+ update
+ concat "[winfo visual .t1] [winfo depth .t1]"
+} $default
+test visual-3.2 {Tk_GetVisual, parsing visual string} {
+ catch {destroy .t1}
+ list [catch {
+ toplevel .t1 -width 250 -height 100 -visual goop20
+ wm geometry .t1 +0+0
+ } msg] $msg
+} {1 {unknown or ambiguous visual name "goop20": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}}
+test visual-3.3 {Tk_GetVisual, parsing visual string} {
+ catch {destroy .t1}
+ list [catch {
+ toplevel .t1 -width 250 -height 100 -visual d
+ wm geometry .t1 +0+0
+ } msg] $msg
+} {1 {unknown or ambiguous visual name "d": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}}
+test visual-3.4 {Tk_GetVisual, parsing visual string} {
+ catch {destroy .t1}
+ list [catch {
+ toplevel .t1 -width 250 -height 100 -visual static
+ wm geometry .t1 +0+0
+ } msg] $msg
+} {1 {unknown or ambiguous visual name "static": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}}
+test visual-3.5 {Tk_GetVisual, parsing visual string} {
+ catch {destroy .t1}
+ list [catch {
+ toplevel .t1 -width 250 -height 100 -visual "pseudocolor 48x"
+ wm geometry .t1 +0+0
+ } msg] $msg
+} {1 {expected integer but got "48x"}}
+
+if {$other != ""} {
+ catch {destroy .t1}
+ catch {destroy .t2}
+ catch {destroy .t3}
+ toplevel .t1 -width 250 -height 100 -visual $other
+ wm geom .t1 +0+0
+ toplevel .t2 -width 200 -height 80 -visual [winfo visual .]
+ wm geom .t2 +5+5
+ toplevel .t3 -width 150 -height 250 -visual [winfo visual .t1]
+ wm geom .t3 +10+10
+ test visual-4.1 {Tk_GetVisual, numerical visual id} nonPortable {
+ list [winfo visualid .t2] [winfo visualid .t3]
+ } [list [winfo visualid .] [winfo visualid .t1]]
+ destroy .t1 .t2 .t3
+}
+test visual-4.2 {Tk_GetVisual, numerical visual id} {
+ catch {destroy .t1}
+ list [catch {toplevel .t1 -visual 12xyz} msg] $msg
+} {1 {bad X identifier for visual: 12xyz"}}
+test visual-4.3 {Tk_GetVisual, numerical visual id} {
+ catch {destroy .t1}
+ list [catch {toplevel .t1 -visual 1291673} msg] $msg
+} {1 {couldn't find an appropriate visual}}
+
+if ![string match *pseudocolor* $avail] {
+ test visual-5.1 {Tk_GetVisual, no matching visual} {
+ catch {destroy .t1}
+ list [catch {
+ toplevel .t1 -width 250 -height 100 -visual "pseudocolor 8"
+ wm geometry .t1 +0+0
+ } msg] $msg
+ } {1 {couldn't find an appropriate visual}}
+}
+
+if {[string match *pseudocolor* $avail] && ([llength $avail] > 1)} {
+ test visual-6.1 {Tk_GetVisual, no matching visual} {nonPortable} {
+ catch {destroy .t1}
+ toplevel .t1 -width 250 -height 100 -visual "best"
+ wm geometry .t1 +0+0
+ update
+ winfo visual .t1
+ } {pseudocolor}
+}
+
+# These tests are non-portable due to variations in how many colors
+# are already in use on the screen.
+
+if {([winfo visual .] == "pseudocolor") && ([winfo depth .] == 8)} {
+ eatColors .t1
+ test visual-7.1 {Tk_GetColormap, "new"} {nonPortable} {
+ toplevel .t2 -width 30 -height 20
+ wm geom .t2 +0+0
+ update
+ colorsFree .t2
+ } {0}
+ test visual-7.2 {Tk_GetColormap, "new"} {nonPortable} {
+ catch {destroy .t2}
+ toplevel .t2 -width 30 -height 20 -colormap new
+ wm geom .t2 +0+0
+ update
+ colorsFree .t2
+ } {1}
+ test visual-7.3 {Tk_GetColormap, copy from other window} {nonPortable} {
+ catch {destroy .t2}
+ toplevel .t3 -width 400 -height 50 -colormap new
+ wm geom .t3 +0+0
+ catch {destroy .t2}
+ toplevel .t2 -width 30 -height 20 -colormap .t3
+ wm geom .t2 +0+0
+ update
+ destroy .t3
+ colorsFree .t2
+ } {1}
+ test visual-7.4 {Tk_GetColormap, copy from other window} {nonPortable} {
+ catch {destroy .t2}
+ toplevel .t3 -width 400 -height 50 -colormap new
+ wm geom .t3 +0+0
+ catch {destroy .t2}
+ toplevel .t2 -width 30 -height 20 -colormap .
+ wm geom .t2 +0+0
+ update
+ destroy .t3
+ colorsFree .t2
+ } {0}
+ test visual-7.5 {Tk_GetColormap, copy from other window} {nonPortable} {
+ catch {destroy .t1}
+ list [catch {toplevel .t1 -width 400 -height 50 \
+ -colormap .choke.lots} msg] $msg
+ } {1 {bad window path name ".choke.lots"}}
+ if {$other != {}} {
+ test visual-7.6 {Tk_GetColormap, copy from other window} {nonPortable} {
+ catch {destroy .t1}
+ catch {destroy .t2}
+ toplevel .t1 -width 300 -height 150 -visual $other
+ wm geometry .t1 +0+0
+ list [catch {toplevel .t2 -width 400 -height 50 \
+ -colormap .t1} msg] $msg
+ } {1 {can't use colormap for .t1: incompatible visuals}}
+ }
+ catch {destroy .t1}
+ catch {destroy .t2}
+}
+
+test visual-8.1 {Tk_FreeColormap procedure} {
+ foreach w [winfo child .] {
+ destroy $w
+ }
+ toplevel .t1 -width 300 -height 180 -colormap new
+ wm geometry .t1 +0+0
+ foreach i {.t2 .t3 .t4} {
+ toplevel $i -width 250 -height 150 -colormap .t1
+ wm geometry $i +0+0
+ }
+ destroy .t1
+ destroy .t3
+ destroy .t4
+ update
+} {}
+if {$other != {}} {
+ test visual-8.2 {Tk_FreeColormap procedure} {
+ foreach w [winfo child .] {
+ destroy $w
+ }
+ toplevel .t1 -width 300 -height 180 -visual $other
+ wm geometry .t1 +0+0
+ foreach i {.t2 .t3 .t4} {
+ toplevel $i -width 250 -height 150 -visual $other
+ wm geometry $i +0+0
+ }
+ destroy .t2
+ destroy .t3
+ destroy .t4
+ update
+ } {}
+}
+
+foreach w [winfo child .] {
+ destroy $w
+}
+rename eatColors {}
+rename colorsFree {}
diff --git a/tk/tests/winButton.test b/tk/tests/winButton.test
new file mode 100644
index 00000000000..509aaa258c7
--- /dev/null
+++ b/tk/tests/winButton.test
@@ -0,0 +1,154 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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 {
+ error "trace aborted"
+}
+catch {unset value}
+catch {unset value2}
+
+eval image delete [image names]
+image create test image1
+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]
+} {58 24 67 33 88 30 90 28}
+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]
+} {178 84}
+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]
+} {222 52}
+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]
+} {74 24 67 97 174 46 64 28}
+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]
+} {66 32 65 31 69 31 71 29}
+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 .]
diff --git a/tk/tests/winClipboard.test b/tk/tests/winClipboard.test
new file mode 100644
index 00000000000..58a2b2c1c79
--- /dev/null
+++ b/tk/tests/winClipboard.test
@@ -0,0 +1,47 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {$tcl_platform(platform)!="windows"} {
+ return
+}
+
+if {[string compare test [info procs test]] == 1} {
+ source defs
+}
+
+# Note that these tests may fail if another application is grabbing the
+# clipboard (e.g. an X server)
+
+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"]
+
diff --git a/tk/tests/winFont.test b/tk/tests/winFont.test
new file mode 100644
index 00000000000..294f4e0dd7e
--- /dev/null
+++ b/tk/tests/winFont.test
@@ -0,0 +1,185 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+
+set courier {Courier 14}
+set cx [font measure $courier 0]
+
+label .b.l -padx 0 -pady 0 -bd 0 -highlightthickness 0 -justify left -text "0" -font systemfixed
+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 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-5.10 {Tk_MeasureChars procedure: check for kerning} {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} {
+ .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
diff --git a/tk/tests/winMenu.test b/tk/tests/winMenu.test
new file mode 100644
index 00000000000..9274d604d91
--- /dev/null
+++ b/tk/tests/winMenu.test
@@ -0,0 +1,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.
+#
+# RCS: @(#) $Id$
+
+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
diff --git a/tk/tests/winWm.test b/tk/tests/winWm.test
new file mode 100644
index 00000000000..abe478eba2c
--- /dev/null
+++ b/tk/tests/winWm.test
@@ -0,0 +1,219 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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
+
+toplevel .t
+frame .t.f -width 100 -height 50
+pack .t.f
+menu .t.m
+.t.m add command -label "thisisreallylong"
+.t conf -menu .t.m
+wm geom .t -0-0
+update
+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}
diff --git a/tk/tests/window.test b/tk/tests/window.test
new file mode 100644
index 00000000000..fca332f2cb4
--- /dev/null
+++ b/tk/tests/window.test
@@ -0,0 +1,137 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+if {[info procs test] != "test"} {
+ source defs
+}
+
+foreach i [winfo children .] {
+ destroy $i
+}
+wm geometry . {}
+raise .
+update
+
+# XXX This file is woefully incomplete. Right now it only tests
+# a few parts of a few procedures in tkWindow.c
+
+test window-1.1 {Tk_CreateWindowFromPath procedure, parent dead} {
+ proc bgerror msg {
+ global x errorInfo
+ set x [list $msg $errorInfo]
+ }
+ set x unchanged
+ catch {destroy .t}
+ frame .t -width 100 -height 50
+ place .t -x 10 -y 10
+ bind .t <Destroy> {button .t.b -text hello; pack .t.b}
+ update
+ destroy .t
+ update
+ rename bgerror {}
+ set x
+} {{can't create window: parent has been destroyed} {can't create window: parent has been destroyed
+ while executing
+"button .t.b -text hello"
+ (command bound to event)}}
+
+# Most of the tests below don't produce meaningful results; they
+# will simply dump core if there are bugs.
+
+test window-2.1 {Tk_DestroyWindow procedure, destroy handler deletes parent} {
+ toplevel .t -width 300 -height 200
+ wm geometry .t +0+0
+ frame .t.f -width 200 -height 200 -relief raised -bd 2
+ place .t.f -x 0 -y 0
+ frame .t.f.f -width 100 -height 100 -relief raised -bd 2
+ place .t.f.f -relx 1 -rely 1 -anchor se
+ bind .t.f <Destroy> {destroy .t}
+ update
+ destroy .t.f
+} {}
+test window-2.2 {Tk_DestroyWindow procedure, destroy handler deletes parent} {
+ toplevel .t -width 300 -height 200
+ wm geometry .t +0+0
+ frame .t.f -width 200 -height 200 -relief raised -bd 2
+ place .t.f -x 0 -y 0
+ frame .t.f.f -width 100 -height 100 -relief raised -bd 2
+ place .t.f.f -relx 1 -rely 1 -anchor se
+ bind .t.f.f <Destroy> {destroy .t}
+ update
+ destroy .t.f
+} {}
+test window-2.3 {Tk_DestroyWindow procedure, destroy handler deletes parent} {
+ frame .f -width 80 -height 120 -relief raised -bd 2
+ place .f -relx 0.5 -rely 0.5 -anchor center
+ toplevel .f.t -width 300 -height 200
+ wm geometry .f.t +0+0
+ frame .f.t.f -width 200 -height 200 -relief raised -bd 2
+ 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
+} {}
+
+if {[string compare testmenubar [info commands testmenubar]] != 0} {
+ puts "This application hasn't been compiled with the testmenubar command,"
+ puts "therefore I am skipping all of these tests."
+ return
+}
+
+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.
+} {}
diff --git a/tk/tests/winfo.test b/tk/tests/winfo.test
new file mode 100644
index 00000000000..f2cb6250119
--- /dev/null
+++ b/tk/tests/winfo.test
@@ -0,0 +1,367 @@
+# 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.
+#
+# RCS: @(#) $Id$
+
+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.
+# options - Options for w, such as "-colormap new".
+
+proc eatColors {w {options ""}} {
+ catch {destroy $w}
+ eval toplevel $w $options
+ wm geom $w +0+0
+ canvas $w.c -width 400 -height 200 -bd 0
+ pack $w.c
+ for {set y 0} {$y < 8} {incr y} {
+ for {set x 0} {$x < 40} {incr x} {
+ set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0]
+ $w.c create rectangle [expr 10*$x] [expr 20*$y] \
+ [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \
+ -fill $color
+ }
+ }
+ update
+}
+
+# XXX - This test file is woefully incomplete. At present, only a
+# few of the winfo options are tested.
+
+test winfo-1.1 {"winfo atom" command} {
+ list [catch {winfo atom} msg] $msg
+} {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
+test winfo-1.2 {"winfo atom" command} {
+ list [catch {winfo atom a b} msg] $msg
+} {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
+test winfo-1.3 {"winfo atom" command} {
+ list [catch {winfo atom a b c d} msg] $msg
+} {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
+test winfo-1.4 {"winfo atom" command} {
+ list [catch {winfo atom -displayof geek foo} msg] $msg
+} {1 {bad window path name "geek"}}
+test winfo-1.5 {"winfo atom" command} {
+ winfo atom PRIMARY
+} 1
+test winfo-1.6 {"winfo atom" command} {
+ winfo atom -displayof . PRIMARY
+} 1
+
+test winfo-2.1 {"winfo atomname" command} {
+ list [catch {winfo atomname} msg] $msg
+} {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}}
+test winfo-2.2 {"winfo atomname" command} {
+ list [catch {winfo atomname a b} msg] $msg
+} {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}}
+test winfo-2.3 {"winfo atomname" command} {
+ list [catch {winfo atomname a b c d} msg] $msg
+} {1 {wrong # args: should be "winfo atomname ?-displayof window? id"}}
+test winfo-2.4 {"winfo atomname" command} {
+ list [catch {winfo atomname -displayof geek foo} msg] $msg
+} {1 {bad window path name "geek"}}
+test winfo-2.5 {"winfo atomname" command} {
+ list [catch {winfo atomname 44215} msg] $msg
+} {1 {no atom exists with id "44215"}}
+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
+} {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}}
+test winfo-4.2 {"winfo containing" command} {
+ list [catch {winfo containing a b c} msg] $msg
+} {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}}
+test winfo-4.3 {"winfo containing" command} {
+ list [catch {winfo containing a b c d e} msg] $msg
+} {1 {wrong # args: should be "winfo containing ?-displayof window? rootX rootY"}}
+test winfo-4.4 {"winfo containing" command} {
+ list [catch {winfo containing -displayof geek 25 30} msg] $msg
+} {1 {bad window path name "geek"}}
+test winfo-4.5 {"winfo containing" command} {
+ winfo containing [winfo rootx .t.f] [winfo rooty .t.f]
+} .t.f
+test winfo-4.6 {"winfo containing" command} {nonPortable} {
+ winfo containing [expr [winfo rootx .t.f]-1] [expr [winfo rooty .t.f]-1]
+} .t
+test winfo-4.7 {"winfo containing" command} {
+ set x [winfo containing -display .t.f [expr [winfo rootx .t]+600] \
+ [expr [winfo rooty .t.f]+450]]
+ expr {($x == ".") || ($x == "")}
+} {1}
+destroy .t
+
+test winfo-5.1 {"winfo interps" command} {
+ list [catch {winfo interps a} msg] $msg
+} {1 {wrong # args: should be "winfo interps ?-displayof window?"}}
+test winfo-5.2 {"winfo interps" command} {
+ list [catch {winfo interps a b c} msg] $msg
+} {1 {wrong # args: should be "winfo interps ?-displayof window?"}}
+test winfo-5.3 {"winfo interps" command} {
+ list [catch {winfo interps -displayof geek} msg] $msg
+} {1 {bad window path name "geek"}}
+test winfo-5.4 {"winfo interps" command} {unixOnly} {
+ expr [lsearch -exact [winfo interps] [tk appname]] >= 0
+} {1}
+test winfo-5.5 {"winfo interps" command} {unixOnly} {
+ expr [lsearch -exact [winfo interps -displayof .] [tk appname]] >= 0
+} {1}
+
+test winfo-6.1 {"winfo exists" command} {
+ list [catch {winfo exists} msg] $msg
+} {1 {wrong # args: should be "winfo exists window"}}
+test winfo-6.2 {"winfo exists" command} {
+ list [catch {winfo exists a b} msg] $msg
+} {1 {wrong # args: should be "winfo exists window"}}
+test winfo-6.3 {"winfo exists" command} {
+ winfo exists gorp
+} {0}
+test winfo-6.4 {"winfo exists" command} {
+ winfo exists .
+} {1}
+test winfo-6.5 {"winfo exists" command} {
+ button .b -text "Test button"
+ set x [winfo exists .b]
+ pack .b
+ update
+ bind .b <Destroy> {lappend x [winfo exists .x]}
+ destroy .b
+ lappend x [winfo exists .x]
+} {1 0 0}
+
+catch {destroy .b}
+button .b -text "Help"
+update
+test winfo-7.1 {"winfo pathname" command} {
+ list [catch {winfo pathname} msg] $msg
+} {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}}
+test winfo-7.2 {"winfo pathname" command} {
+ list [catch {winfo pathname a b} msg] $msg
+} {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}}
+test winfo-7.3 {"winfo pathname" command} {
+ list [catch {winfo pathname a b c d} msg] $msg
+} {1 {wrong # args: should be "winfo pathname ?-displayof window? id"}}
+test winfo-7.4 {"winfo pathname" command} {
+ list [catch {winfo pathname -displayof geek 25} msg] $msg
+} {1 {bad window path name "geek"}}
+test winfo-7.5 {"winfo pathname" command} {
+ list [catch {winfo pathname xyz} msg] $msg
+} {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 .]
+} {.}
+
+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."
+
+ 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} {
+ catch [winfo pointery .b]
+} 1
+test winfo-8.3 {"winfo pointerxy" command} {
+ catch [winfo pointerxy .b]
+} 1
+
+test winfo-9.1 {"winfo viewable" command} {
+ list [catch {winfo viewable} msg] $msg
+} {1 {wrong # args: should be "winfo viewable window"}}
+test winfo-9.2 {"winfo viewable" command} {
+ list [catch {winfo viewable foo} msg] $msg
+} {1 {bad window path name "foo"}}
+test winfo-9.3 {"winfo viewable" command} {
+ winfo viewable .
+} {1}
+test winfo-9.4 {"winfo viewable" command} {
+ wm iconify .
+ winfo viewable .
+} {0}
+wm deiconify .
+test winfo-9.5 {"winfo viewable" command} {
+ frame .f1 -width 100 -height 100 -relief raised -bd 2
+ place .f1 -x 0 -y 0
+ frame .f1.f2 -width 50 -height 50 -relief raised -bd 2
+ place .f1.f2 -x 0 -y 0
+ update
+ list [winfo viewable .f1] [winfo viewable .f1.f2]
+} {1 1}
+test winfo-9.6 {"winfo viewable" command} {
+ eval destroy [winfo child .]
+ frame .f1 -width 100 -height 100 -relief raised -bd 2
+ frame .f1.f2 -width 50 -height 50 -relief raised -bd 2
+ place .f1.f2 -x 0 -y 0
+ update
+ list [winfo viewable .f1] [winfo viewable .f1.f2]
+} {0 0}
+test winfo-9.7 {"winfo viewable" command} {
+ eval destroy [winfo child .]
+ frame .f1 -width 100 -height 100 -relief raised -bd 2
+ place .f1 -x 0 -y 0
+ frame .f1.f2 -width 50 -height 50 -relief raised -bd 2
+ place .f1.f2 -x 0 -y 0
+ update
+ wm iconify .
+ list [winfo viewable .f1] [winfo viewable .f1.f2]
+} {0 0}
+wm deiconify .
+eval destroy [winfo child .]
+
+test winfo-10.1 {"winfo visualid" command} {
+ list [catch {winfo visualid} msg] $msg
+} {1 {wrong # args: should be "winfo visualid window"}}
+test winfo-10.2 {"winfo visualid" command} {
+ list [catch {winfo visualid gorp} msg] $msg
+} {1 {bad window path name "gorp"}}
+test winfo-10.3 {"winfo visualid" command} {
+ expr 2+[winfo visualid .]-[winfo visualid .]
+} {2}
+
+test winfo-11.1 {"winfo visualid" command} {
+ list [catch {winfo visualsavailable} msg] $msg
+} {1 {wrong # args: should be "winfo visualsavailable window ?includeids?"}}
+test winfo-11.2 {"winfo visualid" command} {
+ list [catch {winfo visualsavailable gorp} msg] $msg
+} {1 {bad window path name "gorp"}}
+test winfo-11.3 {"winfo visualid" command} {
+ list [catch {winfo visualsavailable . includeids foo} msg] $msg
+} {1 {wrong # args: should be "winfo visualsavailable window ?includeids?"}}
+test winfo-11.4 {"winfo visualid" command} {
+ llength [lindex [winfo visualsa .] 0]
+} {2}
+test winfo-11.5 {"winfo visualid" command} {
+ llength [lindex [winfo visualsa . includeids] 0]
+} {3}
+test winfo-11.6 {"winfo visualid" command} {
+ set x [lindex [lindex [winfo visualsa . includeids] 0] 2]
+ expr $x + 2 - $x
+} {2}
+
+test winfo-12.1 {GetDisplayOf procedure} {
+ list [catch {winfo atom - foo x} msg] $msg
+} {1 {wrong # args: should be "winfo atom ?-displayof window? name"}}
+test winfo-12.2 {GetDisplayOf procedure} {
+ list [catch {winfo atom -d bad_window x} msg] $msg
+} {1 {bad window path name "bad_window"}}
+
+# Some embedding tests
+#
+
+proc MakeEmbed {} {
+ 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}
+}
diff --git a/tk/testsuite/config/default.exp b/tk/testsuite/config/default.exp
new file mode 100644
index 00000000000..37d8af5b8a0
--- /dev/null
+++ b/tk/testsuite/config/default.exp
@@ -0,0 +1,254 @@
+# Copyright (C) 1996 Cygnus Support
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# Please email any bugs, comments, and/or additions to this file to:
+# bug-dejagnu@prep.ai.mit.edu
+
+# This file was written by Tom Tromey <tromey@cygnus.com>
+
+set testdrv "unix/tktest"
+set tprompt "%"
+
+#
+# Extract and print the version number of wish.
+#
+proc tk_version {} {
+ global testdrv
+ if {! [catch {exec $testdrv -version} output]
+ && ! [regsub {^.*version } $output {} version]} then {
+ clone_output "Tk library is version\t$version\n"
+ }
+}
+
+#
+# Source a file.
+#
+proc tk_load {file} {
+ global subdir testdrv spawn_id
+
+ if {! [file exists $file]} then {
+ perror "$file does not exist."
+ return -1
+ }
+
+ verbose "Sourcing $file..."
+ send "source $file\n"
+ return 0
+}
+
+#
+# Exit the test driver.
+#
+proc tk_exit {} {
+ # If we started Xvfb, we should kill it. This doesn't happen right
+ # now, so this proc does nothing.
+ # xvfb_exit
+}
+
+#
+# Find X display to use. Return 0 if not found. Set DISPLAY
+# environment variable if display found.
+#
+proc find_x_display {} {
+ global env
+
+ if {[info exists env(TEST_DISPLAY)]} then {
+ set env(DISPLAY) $env(TEST_DISPLAY)
+ return 1
+ }
+
+ return 0
+}
+
+#
+# Start the test driver.
+#
+proc tk_start {} {
+ global testdrv objdir subdir srcdir spawn_id tprompt
+
+ set testdrv "$objdir/$testdrv"
+ set defs "$srcdir/../tests/defs"
+
+ set timeout 100
+ set timetol 0
+
+ if {! [find_x_display]} then {
+ return -1
+ }
+
+ spawn $testdrv
+
+ if ![file exists ${srcdir}/../tests] {
+ perror "The source for the test cases is missing." 0
+ return -1
+ }
+
+ send "[list set srcdir ${srcdir}/../tests]\r"
+ expect {
+ -re "set VERBOSE 1\[\r\n\]*1\[\r\n\]*%" {
+ verbose "Set verbose flag for tests"
+ exp_continue
+ }
+ -re "${srcdir}/../tests\[\r\n\]*$tprompt" {
+ verbose "Set srcdir to $srcdir/../tests" 2
+ }
+ -re "no files matched glob pattern" {
+ warning "Didn't set srcdir to $srcdir/../tests"
+ }
+ timeout {
+ perror "Couldn't set srcdir"
+ return -1
+ }
+ }
+
+ if ![file exists $defs] then {
+ perror "$defs does not exist."
+ return -1
+ }
+
+ verbose "Sourcing $defs..."
+ send "source $defs\r\n"
+
+ expect {
+ -re ".*source $defs.*$" {
+ verbose "Sourced $defs"
+ }
+ "Error: couldn't read file*" {
+ perror "Couldn't source $defs"
+ return -1
+ }
+ "%" {
+ verbose "Got prompt, sourced $defs"
+ }
+ timeout {
+ warning "Timed out sourcing $defs."
+ if { $timetol <= 3 } {
+ incr timetol
+ exp_continue
+ } else {
+ return -1
+ }
+ }
+ }
+
+ set timetol 0
+ sleep 2
+ send "set VERBOSE 1\n"
+ expect {
+ -re "% 1.*%" {
+ verbose "Set verbose flag for tests"
+ }
+ -re "set VERBOSE 1.*1.*%" {
+ verbose "Set verbose flag for tests"
+ }
+ timeout {
+ perror "Timed out setting verbose flag."
+ if { $timetol <= 3 } {
+ exp_continue
+ } else {
+ return -1
+ }
+ }
+ }
+ return $spawn_id
+}
+
+################################################################
+#
+# Utility functions.
+#
+
+proc read_file {name} {
+ set id [open $name r]
+ set contents [read $id]
+ close $id
+ return $contents
+}
+
+proc write_file {name contents} {
+ set id [open $name w]
+ puts -nonewline $id $contents
+ close $id
+}
+
+# NOTE that this fails to copy files with NULs in them. Change
+# implementation to "exec cp" if required.
+proc copy_file {from to} {
+ write_file $to [read_file $from]
+}
+
+################################################################
+#
+# Start/stop Xvfb. These procs aren't used right now; we assume Xvfb
+# is already running.
+#
+
+#
+# Stop Xvfb.
+#
+proc xvfb_exit {} {
+ global Xvfb_spawn_id
+
+ # Send C-c to kill it.
+ send -i $Xvfb_spawn_id "\003"
+}
+
+#
+# Start Xvfb. Return 0 on error, 1 if started. Set DISPLAY
+# environment variable on successful start.
+#
+#
+proc xvfb_start {} {
+ global spawn_id Xvfb_spawn_id Xvfb_screen env
+
+ # FIXME should look for Xvfb in build directory. Do this later,
+ # when we actually build Xvfb.
+
+ set Xvfb [which Xvfb]
+ # Why "0"? I don't know, but that is what the manual says.
+ if {$Xvfb == 0} then {
+ perror "Couldn't find Xvfb"
+ return 0
+ }
+ verbose "Xvfb is $Xvfb"
+
+ # Pick a number at random...
+ set Xvfb_screen 23
+
+ while {$Xvfb_screen < 100} {
+ spawn $Xvfb :$Xvfb_screen
+
+ expect {
+ "Server is already active" {
+ incr Xvfb_screen
+ }
+
+ timeout {
+ break
+ }
+ }
+ }
+
+ if {$Xvfb_screen == 100} then {
+ perror "Xvfb screen is 100!"
+ return 0
+ }
+
+ set Xvfb_spawn_id $spawn_id
+ set env(DISPLAY) :$Xvfb_screen
+ verbose "Screen is :$Xvfb_screen"
+ return 1
+}
diff --git a/tk/testsuite/tk.tests/tk-test.exp b/tk/testsuite/tk.tests/tk-test.exp
new file mode 100644
index 00000000000..fd8562a1674
--- /dev/null
+++ b/tk/testsuite/tk.tests/tk-test.exp
@@ -0,0 +1,99 @@
+# Copyright (C) 1996 Cygnus Support
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+# Please email any bugs, comments, and/or additions to this file to:
+# bug-dejagnu@prep.ai.mit.edu
+
+# This file was written by Tom Tromey <tromey@cygnus.com>
+
+if {$tracelevel} then {
+ strace $tracelevel
+}
+
+if {[tk_start] == -1} then {
+ perror "Couldn't start the Tk test environment" 0
+ return -1
+}
+
+# This file is needed by the Tk test suite.
+copy_file $srcdir/../tests/README README
+
+set timeoutmsg "Timed out: Never got started, "
+set timeout 100
+set file all
+set timetol 0
+
+#
+# Change to the dir where all the tests live.
+#
+
+set timetol 0
+if {! [file exists ${srcdir}/../tests/${file}]} then {
+ perror "The source for the test case \"$file\" is missing" 0
+ return -1
+}
+send "source \$srcdir/${file}\n"
+expect {
+ -re "source \$srcdir/$file\[\r\n\]+\[$tprompt\]*" {
+ verbose "Sourced test $file ..."
+ set timeoutmsg "Never got to the end of "
+ exp_continue
+ }
+ "install Tcl or set your TCL_LIBRARY environment variable" {
+ perror "You need to set the TCL_LIBRARY environment variable"
+ return -1
+ }
+ -re "\[\r\n\]*\\+\\+\\+\\+ (\[a-zA-Z\]*-\[.0-9\]*) PASSED\[\r\n\]*" {
+ pass $expect_out(1,string)
+ set timetol 0
+ exp_continue
+ }
+ -re "\[\r\n\]*\\+* (\[a-zA-Z\]*-\[.0-9\]*) FAILED\[\r\n\]*" {
+ fail $expect_out(1,string)
+ exp_continue
+ }
+ -re "\[x\]+ \[a-i\]+ \[A-K\]+ \[0-9\]+ " {
+ verbose "Got standard output message from exec 8.1 test." 3
+ exp_continue
+ }
+ -re "Test generated error:\[\r\n\]*.*\[\r\n\]*" {
+ regsub "Test generated error:\[\r\n\]*" $expect_out(0,string) "" tmp
+ regsub -all "\[\r\n\]*\[a-zA-Z.\]test\[\r\n\]*" $tmp "" tmp
+ regsub -all "\[\r\n\]*" $tmp "" tmp
+ perror "Got a test case bug \"$tmp\""
+ exp_continue
+ }
+ "Tests all done" {
+ verbose "Done" 2
+ }
+ "*Error: bad option *" {
+ fail "Got a bad option"
+ }
+ eof {
+ verbose "Done" 2
+ }
+ timeout {
+ warning "Timed out executing test case"
+ if { $timetol <= 2 } {
+ incr timetol
+ exp_continue
+ } else {
+ return -1
+ }
+ }
+}
+
+catch close
diff --git a/tk/unix/ChangeLog b/tk/unix/ChangeLog
new file mode 100644
index 00000000000..edb93447c0a
--- /dev/null
+++ b/tk/unix/ChangeLog
@@ -0,0 +1,230 @@
+Mon Aug 30 12:41:17 1999 Jeffrey A Law (law@cygnus.com)
+
+ * configure.in: Do not force static linking for hpux11 in wide
+ mode since no static X libraries exist.
+ * configure: Rebuilt.
+
+Wed Jan 6 13:45:20 1999 Elena Zannoni <ezannoni@kwikemart.cygnus.com>
+
+ * configure.in (TK_SHARED_LIB_FILE): init to dummy name.
+ (TK_UNSHARED_LIB_FILE): ditto.
+
+ * configure: regenerated.
+
+Thu Jul 9 14:35:35 1998 Felix Lee <flee@cygnus.com>
+
+ * configure.in: typo.
+ * configure: rebuild.
+
+Tue Jul 7 16:59:07 1998 Felix Lee <flee@cygnus.com>
+
+ * configure.in: Undo previous change, which didn't work right.
+ Add specialcase to make static link of X work on solaris.
+ * configure: Rebuild.
+
+Wed Jun 17 11:40:56 1998 Felix Lee <flee@cygnus.com>
+
+ * configure.in: When looking for the X libraries, set LDFLAGS to
+ find them statically if that is how we are going to link.
+ * configure: Rebuild.
+
+Mon Apr 13 17:55:38 1998 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Remove AC_REPLACE_FUNCS(memmove).
+ * Makefile.in (LIBOBJS): Remove variable.
+ (OBJS): Remove $(LIBOBJS).
+ (memmove.o): Remove target.
+ * configure: Rebuild.
+
+Mon Apr 6 20:07:55 1998 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Handle an empty x_libraries string correctly, in
+ case of Solaris when not using gcc.
+ * configure: Rebuild.
+
+Mon Dec 15 15:13:08 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * tkUnixPort.h: Don't include <string.h> if _STRING is defined.
+
+ * configure.in: When checking for GNU ld on Solaris, don't
+ redirect stderr to /dev/null.
+ * configure: Rebuild.
+
+Thu Sep 4 20:03:38 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: If SHLIB_LD matches *gcc*, then don't remove the
+ -Wl from TK_LD_SEARCH_FLAGS. Otherwise building shared libraries
+ fails on HP/UX.
+ * configure: Rebuild.
+
+Tue Oct 28 16:37:12 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * Makefile.in (install-minimal): New target.
+
+Tue Oct 21 14:25:07 1997 Tom Tromey <tromey@cygnus.com>
+
+ * tkUnixFont.c (TkpGetFontFamilies): Use XFreeFontNames, not
+ XFree. From jkb@mrc-lmb.cam.ac.uk (James Bonfield).
+
+Wed Sep 17 13:43:58 1997 Tom Tromey <tromey@cygnus.com>
+
+ * configure: Rebuilt.
+ * configure.in: Better error message if TCL_BIN_DIR can't be
+ found.
+
+Tue Aug 5 14:41:23 1997 Tom Tromey <tromey@cygnus.com>
+
+ * configure: Rebuilt.
+ * configure.in: Preserved local changes.
+ * Makefile.in: Preserved local changes.
+ * mkLinks: Preserved local changes.
+
+Tue Jul 1 22:10:44 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Fix -lnsl test.
+ * configure: Rebuild.
+
+Mon Jun 30 13:36:27 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * configure.in: Rework check for socket libraries to use a cache
+ variable and to not set ac_cv_func cache variables
+ inappropriately.
+ * configure: Rebuild.
+
+Mon Jun 9 16:25:20 1997 Ian Lance Taylor <ian@cygnus.com>
+
+ * tkConfig.sh.in: Set TK_BUILD_INCLUDES.
+ * configure.in: Set TK_BUILD_INCLUDES.
+ * configure: Rebuild.
+
+Fri May 9 09:26:51 1997 Tom Tromey <tromey@cygnus.com>
+
+ * tkUnixPort.h (panic): Added prototype. From Ian Taylor.
+
+Fri Apr 18 12:13:39 1997 Tom Tromey <tromey@cygnus.com>
+
+ * configure: Regenerated.
+ * configure.in: Only statically link on Solaris if running GNU
+ ld.
+
+Thu Mar 13 10:40:55 1997 Tom Tromey <tromey@cygnus.com>
+
+ * configure.in: Don't run AC_C_CROSS.
+ (AC_CONFIG_AUX_DIR): Look in srcdir.
+
+Sun Dec 8 23:07:48 1996 Martin Hunt <hunt@cygnus.com>
+
+ * Makefile.in (${TK_SHARED_LIB_FILE}): Don't run RANLIB on
+ shared libs.
+
+Mon Aug 26 09:44:57 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * Makefile.in: Use TK_SHARED_LIB_FILE, TK_UNSHARED_LIB_FILE.
+ * configure: Regenerated.
+ * configure.in: Introduct TK_SHARED_LIB_FILE and
+ TK_UNSHARED_LIB_FILE.
+
+ * configure: Regenerated.
+ * configure.in: AC_SUBST more variables so shared/unshared lib
+ targets can be separate.
+
+ * Makefile.in (libtk${TCL_SHARED_LIB_SUFFIX}): New target.
+ (libtk${TCL_SHARED_LIB_SUFFIX}): New target.
+
+Fri Aug 23 13:40:25 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * configure: Regenerated.
+ * configure.in: Suppress --enable-shared when statically linking
+ libX11.
+
+Wed Aug 14 09:21:16 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * Makefile.in (install-man): Man page permissions are 644, not
+ 444.
+
+Mon Aug 5 10:47:45 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * Makefile.in (configure): Don't depend on configure.in. Work
+ when not in srcdir.
+
+ * Makefile.in (config.status): New target.
+ (Makefile): Depend on config.status.
+
+Fri Aug 2 13:51:59 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * configure.in: Find Tcl source directory relative to $srcdir.
+ * configure: Regenerated.
+
+Wed Jun 26 12:51:49 1996 Jason Molenda (crash@godzilla.cygnus.co.jp)
+
+ * Makefile.in (TK_LIBRARY, LIB_INSTALL_DIR, BIN_INSTALL_DIR,
+ BIN_DIR, INCLUDE_INSTALL_DIR, MAN_INSTALL_DIR): Use autoconf-set
+ values.
+ (install-libraries, install-demos): Use @datadir@ instead of
+ hard-coded dirname.
+ * configure.in (AC_PREREQ): autoconf 2.5 or higher.
+ * configure: Rebuilt.
+
+Mon Jun 10 16:22:12 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * Makefile.in (install-binaries): Don't add version info to
+ installed wish.
+
+Tue Jun 4 17:57:46 1996 Gordon Irlam <gordoni@snuffle.cygnus.com>
+
+ * install-sh: Add MIT copyright.
+
+Thu May 9 10:01:48 1996 Tom Tromey <tromey@snuffle.cygnus.com>
+
+ * Makefile.in (CFLAGS): Set to @CFLAGS@.
+
+Wed May 8 08:57:06 1996 Tom Tromey <tromey@snuffle.cygnus.com>
+
+ * configure: Regenerated.
+ * configure.in: In Solaris case, must link against libX11 twice.
+
+Tue May 7 11:22:10 1996 Tom Tromey <tromey@snuffle.cygnus.com>
+
+ * configure: Regenerated.
+ * configure.in: Run AC_PROG_CC.
+
+ * mkLinks: Find man pages in section 3, not section n.
+
+ * Makefile.in (install-man): Install man pages in section 3, not
+ section n.
+
+ * mkLinks: Use cp, not ln.
+
+Tue Apr 23 13:13:59 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * Makefile.in (CC_SWITCHES): Define TK_LIB_TRAILER.
+ (TK_LIB_TRAILER): New macro.
+
+ * tkUnixInit.c (TkPlatformInit): Handle location independence.
+
+Fri Mar 29 08:23:15 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * mkLinks: Exit with status 0.
+
+Fri Mar 1 11:49:57 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * configure: Regenerated.
+ * configure.in: Use AC_CANONICAL_SYSTEM. Look in Cygnus build
+ tree for config.sub and config.guess.
+
+Wed Jan 24 12:39:28 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * Makefile.in: Use maintainer-clean, not realclean.
+
+Thu Jan 11 09:13:11 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * configure.in: Look in ../../tcl, not ../../tcl7.5a.
+
+Wed Jan 10 12:09:58 1996 Tom Tromey <tromey@creche.cygnus.com>
+
+ * configure.in: Use AC_CHECK_HEADERS, not AC_HAVE_HEADERS.
+
+ * Makefile.in (TCL_DIR): Look in tcl, not tcl7.5a2.
+ (TCL_BIN_DIR): Ditto.
+ (TCLDIR): Ditto.
+
diff --git a/tk/unix/Makefile.in b/tk/unix/Makefile.in
new file mode 100644
index 00000000000..d18075684a9
--- /dev/null
+++ b/tk/unix/Makefile.in
@@ -0,0 +1,1061 @@
+#
+# 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@
+
+#----------------------------------------------------------------
+# Things you can change to personalize the Makefile for your own
+# site (you can make these changes in either Makefile.in or
+# Makefile, but changes to Makefile will get lost if you re-run
+# the configuration script).
+#----------------------------------------------------------------
+
+# Default top-level directories in which to install architecture-
+# specific files (exec_prefix) and machine-independent files such
+# as scripts (prefix). The values specified here may be overridden
+# at configure-time with the --exec-prefix and --prefix options
+# to the "configure" script.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+
+# The following definition can be set to non-null for special systems
+# like AFS with replication. It allows the pathnames used for installation
+# to be different than those used for actually reference files at
+# run-time. INSTALL_ROOT is prepended to $prefix and $exec_prefix
+# when installing files.
+INSTALL_ROOT =
+
+# Directory from which applications will reference the library of Tcl
+# scripts (note: you can set the TK_LIBRARY environment variable at
+# run-time to override the compiled-in location):
+TK_LIBRARY = @datadir@/tk$(VERSION)
+
+# CYGNUS LOCAL location independence
+# What is appended to the prefix to get the library name. Note that
+# this MUST begin with a "/".
+TK_LIB_TRAILER = /lib/tk$(VERSION)
+# END CYGNUS LOCAL
+
+# Path name to use when installing library scripts:
+SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TK_LIBRARY)
+
+# Directory in which to install the .a or .so binary for the Tk library:
+LIB_INSTALL_DIR = $(INSTALL_ROOT)@libdir@
+
+# Path to use at runtime to refer to LIB_INSTALL_DIR:
+LIB_RUNTIME_DIR = @libdir@
+
+# Directory in which to install the program wish:
+BIN_INSTALL_DIR = $(INSTALL_ROOT)@bindir@
+
+# Directory from which the program wish should be referenced by scripts:
+BIN_DIR = @bindir@
+
+# Directory in which to install the include file tk.h:
+INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)@includedir@
+
+# Top-level directory for manual entries:
+MAN_INSTALL_DIR = $(INSTALL_ROOT)@mandir@
+
+# Directory in which to install manual entry for wish:
+MAN1_INSTALL_DIR = $(MAN_INSTALL_DIR)/man1
+
+# Directory in which to install manual entries for Tk's C library
+# procedures:
+MAN3_INSTALL_DIR = $(MAN_INSTALL_DIR)/man3
+
+# Directory in which to install manual entries for the built-in
+# 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 = @CFLAGS@
+
+# 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
+
+# To disable ANSI-C procedure prototypes reverse the comment characters
+# on the following lines:
+PROTO_FLAGS =
+#PROTO_FLAGS = -DNO_PROTOTYPE
+
+# To enable memory debugging reverse the comment characters on the following
+# lines. Warning: if you enable memory debugging, you must do it
+# *everywhere*, including all the code that calls Tcl, and you must use
+# ckalloc and ckfree everywhere instead of malloc and free.
+MEM_DEBUG_FLAGS =
+#MEM_DEBUG_FLAGS = -DTCL_MEM_DEBUG
+
+# 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 = @SHELL@
+
+# 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
+# with the distribution, which is slower but guaranteed to work.
+
+INSTALL = @srcdir@/install-sh -c
+INSTALL_PROGRAM = ${INSTALL}
+INSTALL_DATA = ${INSTALL} -m 644
+
+
+# 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
+
+TK_LIB_FLAG = @TK_LIB_FLAG@
+#TK_LIB_FLAG = -ltk
+
+TCL_LIB_FLAG = @TCL_LIB_FLAG@
+#TCL_LIB_FLAG = -ltcl
+
+# 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@
+
+# CYGNUS LOCAL
+# Defines for building libtk
+SHLIB_SUFFIX = @SHLIB_SUFFIX@
+TCL_SHARED_LIB_SUFFIX = @TCL_SHARED_LIB_SUFFIX@
+TCL_UNSHARED_LIB_SUFFIX = @TCL_UNSHARED_LIB_SUFFIX@
+TK_SHARED_LIB_FILE = @TK_SHARED_LIB_FILE@
+TK_UNSHARED_LIB_FILE = @TK_UNSHARED_LIB_FILE@
+
+# 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} ${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}
+
+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
+
+# CYGNUS LOCAL
+
+# The shared- and unshared-library cases are separate, so that RANLIB
+# can unconditionally work.
+
+${TK_SHARED_LIB_FILE}: ${OBJS}
+ rm -f @TK_LIB_FILE@
+ @MAKE_LIB@
+
+${TK_UNSHARED_LIB_FILE}: ${OBJS}
+ rm -f @TK_LIB_FILE@
+ @MAKE_LIB@
+ $(RANLIB) ${TK_LIB_FILE}
+
+# END CYGNUS LOCAL
+
+# 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; \
+ SHLIB_PATH=`pwd`:${TCL_BIN_DIR}:${SHLIB_PATH}; \
+ export SHLIB_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; \
+ SHLIB_PATH=`pwd`:${TCL_BIN_DIR}:${SHLIB_PATH}; \
+ export SHLIB_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
+ @echo "Installing tkConfig.sh"
+ @$(INSTALL_DATA) tkConfig.sh $(LIB_INSTALL_DIR)/tkConfig.sh
+
+install-libraries:
+ @for i in $(INSTALL_ROOT)@datadir@ $(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 \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/images; \
+ fi; \
+ done;
+
+# CYGNUS LOCAL: install-minimal target.
+install-minimal:
+ @for i in $(INSTALL_ROOT)@datadir@ $(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 $(SRC_DIR)/library/*.tcl $(SRC_DIR)/library/tclIndex $(SRC_DIR)/library/prolog.ps; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
+ done;
+
+install-demos:
+ @for i in $(INSTALL_ROOT)@datadir@ $(SCRIPT_INSTALL_DIR) \
+ $(SCRIPT_INSTALL_DIR)/demos \
+ $(SCRIPT_INSTALL_DIR)/demos/images ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @for i in $(SRC_DIR)/library/demos/*; \
+ do \
+ if [ -f $$i ] ; then \
+ echo "Installing $$i"; \
+ sed -e '3 s|exec wish|exec wish$(VERSION)|' \
+ $$i > $(SCRIPT_INSTALL_DIR)/demos/`basename $$i`; \
+ fi; \
+ done;
+ @for i in $(DEMOPROGS); \
+ do \
+ chmod 755 $(SCRIPT_INSTALL_DIR)/demos/$$i; \
+ done;
+ @for i in $(SRC_DIR)/library/demos/images/*; \
+ do \
+ if [ -f $$i ] ; then \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/demos/images; \
+ fi; \
+ done;
+
+install-man:
+ @for i in $(MAN_INSTALL_DIR) $(MAN1_INSTALL_DIR) $(MAN3_INSTALL_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @cd $(SRC_DIR)/doc; for i in *.1; \
+ do \
+ echo "Installing doc/$$i"; \
+ rm -f $(MAN1_INSTALL_DIR)/$$i; \
+ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+ $$i > $(MAN1_INSTALL_DIR)/$$i; \
+ chmod 644 $(MAN1_INSTALL_DIR)/$$i; \
+ done;
+ $(UNIX_DIR)/mkLinks $(MAN1_INSTALL_DIR)
+ @cd $(SRC_DIR)/doc; for i in *.3; \
+ do \
+ echo "Installing doc/$$i"; \
+ rm -f $(MAN3_INSTALL_DIR)/$$i; \
+ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+ $$i > $(MAN3_INSTALL_DIR)/$$i; \
+ chmod 644 $(MAN3_INSTALL_DIR)/$$i; \
+ done;
+ @cd $(SRC_DIR)/doc; for i in *.n; \
+ do \
+ echo "Installing doc/$$i"; \
+ rm -f $(MAN3_INSTALL_DIR)/$$i; \
+ name=`echo $$i | sed -e 's/n$$/3/'`; \
+ sed -e '/man\.macros/r man.macros' -e '/man\.macros/d' \
+ $$i > $(MAN3_INSTALL_DIR)/$$name; \
+ chmod 644 $(MAN3_INSTALL_DIR)/$$name; \
+ done;
+ $(UNIX_DIR)/mkLinks $(MAN3_INSTALL_DIR)
+
+Makefile: $(UNIX_DIR)/Makefile.in config.status
+ $(SHELL) config.status
+
+config.status: $(UNIX_DIR)/configure
+ ./config.status --recheck
+
+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
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkBind.c
+
+tkBitmap.o: $(GENERIC_DIR)/tkBitmap.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkBitmap.c
+
+tkClipboard.o: $(GENERIC_DIR)/tkClipboard.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkClipboard.c
+
+tkCmds.o: $(GENERIC_DIR)/tkCmds.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCmds.c
+
+tkColor.o: $(GENERIC_DIR)/tkColor.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkColor.c
+
+tkConfig.o: $(GENERIC_DIR)/tkConfig.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkConfig.c
+
+tkCursor.o: $(GENERIC_DIR)/tkCursor.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCursor.c
+
+tkError.o: $(GENERIC_DIR)/tkError.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkError.c
+
+tkEvent.o: $(GENERIC_DIR)/tkEvent.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkEvent.c
+
+tkFocus.o: $(GENERIC_DIR)/tkFocus.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkFocus.c
+
+tkFont.o: $(GENERIC_DIR)/tkFont.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkFont.c
+
+tkGet.o: $(GENERIC_DIR)/tkGet.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkGet.c
+
+tkGC.o: $(GENERIC_DIR)/tkGC.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkGC.c
+
+tkGeometry.o: $(GENERIC_DIR)/tkGeometry.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkGeometry.c
+
+tkGrab.o: $(GENERIC_DIR)/tkGrab.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkGrab.c
+
+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
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkPlace.c
+
+tkSelect.o: $(GENERIC_DIR)/tkSelect.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkSelect.c
+
+tkUtil.o: $(GENERIC_DIR)/tkUtil.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkUtil.c
+
+tkVisual.o: $(GENERIC_DIR)/tkVisual.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkVisual.c
+
+tkWindow.o: $(GENERIC_DIR)/tkWindow.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkWindow.c
+
+tkButton.o: $(GENERIC_DIR)/tkButton.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkButton.c
+
+tkEntry.o: $(GENERIC_DIR)/tkEntry.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkEntry.c
+
+tkFrame.o: $(GENERIC_DIR)/tkFrame.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkFrame.c
+
+tkListbox.o: $(GENERIC_DIR)/tkListbox.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkListbox.c
+
+tkMenu.o: $(GENERIC_DIR)/tkMenu.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMenu.c
+
+tkMenubutton.o: $(GENERIC_DIR)/tkMenubutton.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMenubutton.c
+
+tkMenuDraw.o: $(GENERIC_DIR)/tkMenuDraw.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMenuDraw.c
+
+tkMessage.o: $(GENERIC_DIR)/tkMessage.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkMessage.c
+
+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
+
+tkCanvBmap.o: $(GENERIC_DIR)/tkCanvBmap.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvBmap.c
+
+tkCanvImg.o: $(GENERIC_DIR)/tkCanvImg.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvImg.c
+
+tkCanvLine.o: $(GENERIC_DIR)/tkCanvLine.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvLine.c
+
+tkCanvPoly.o: $(GENERIC_DIR)/tkCanvPoly.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvPoly.c
+
+tkCanvPs.o: $(GENERIC_DIR)/tkCanvPs.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvPs.c
+
+tkCanvText.o: $(GENERIC_DIR)/tkCanvText.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvText.c
+
+tkCanvUtil.o: $(GENERIC_DIR)/tkCanvUtil.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvUtil.c
+
+tkCanvWind.o: $(GENERIC_DIR)/tkCanvWind.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkCanvWind.c
+
+tkRectOval.o: $(GENERIC_DIR)/tkRectOval.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkRectOval.c
+
+tkTrig.o: $(GENERIC_DIR)/tkTrig.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTrig.c
+
+tkImage.o: $(GENERIC_DIR)/tkImage.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImage.c
+
+tkImgBmap.o: $(GENERIC_DIR)/tkImgBmap.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgBmap.c
+
+tkImgGIF.o: $(GENERIC_DIR)/tkImgGIF.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkImgGIF.c
+
+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
+
+tkTextDisp.o: $(GENERIC_DIR)/tkTextDisp.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextDisp.c
+
+tkTextImage.o: $(GENERIC_DIR)/tkTextImage.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextImage.c
+
+tkTextIndex.o: $(GENERIC_DIR)/tkTextIndex.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextIndex.c
+
+tkTextMark.o: $(GENERIC_DIR)/tkTextMark.c
+ $(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tkTextMark.c
+
+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
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixScale.c
+
+tkUnixScrlbr.o: $(UNIX_DIR)/tkUnixScrlbr.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixScrlbr.c
+
+tkUnixSelect.o: $(UNIX_DIR)/tkUnixSelect.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixSelect.c
+
+tkUnixSend.o: $(UNIX_DIR)/tkUnixSend.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixSend.c
+
+tkUnixWm.o: $(UNIX_DIR)/tkUnixWm.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixWm.c
+
+tkUnixXId.o: $(UNIX_DIR)/tkUnixXId.c
+ $(CC) -c $(CC_SWITCHES) $(UNIX_DIR)/tkUnixXId.c
+
+.c.o:
+ $(CC) -c $(CC_SWITCHES) $<
+
+#
+# Target to check for proper usage of UCHAR macro.
+#
+
+checkuchar:
+ -egrep isalnum\|isalpha\|iscntrl\|isdigit\|islower\|isprint\|ispunct\|isspace\|isupper\|isxdigit\|toupper\|tolower $(SRCS) | grep -v UCHAR
+
+#
+# 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.
+#
+
+DISTROOT = /tmp/dist
+DISTNAME = tk@TK_VERSION@@TK_PATCH_LEVEL@
+ZIPNAME = tk@TK_MAJOR_VERSION@@TK_MINOR_VERSION@@TK_PATCH_LEVEL@.zip
+DISTDIR = $(DISTROOT)/$(DISTNAME)
+TCLDIR = @TCL_SRC_DIR@
+$(UNIX_DIR)/configure:
+ autoconf $(UNIX_DIR)/configure.in > $(UNIX_DIR)/configure
+
+dist: $(UNIX_DIR)/configure
+ rm -rf $(DISTDIR)
+ mkdir $(DISTDIR)
+ mkdir $(DISTDIR)/unix
+ cp -p $(UNIX_DIR)/*.c $(UNIX_DIR)/*.h $(DISTDIR)/unix
+ cp $(TOP_DIR)/license.terms $(UNIX_DIR)/Makefile.in $(DISTDIR)/unix
+ chmod 664 $(DISTDIR)/unix/Makefile.in
+ cp $(UNIX_DIR)/configure $(UNIX_DIR)/configure.in \
+ $(UNIX_DIR)/tkConfig.sh.in $(TCLDIR)/unix/install-sh \
+ $(UNIX_DIR)/porting.notes $(UNIX_DIR)/porting.old \
+ $(UNIX_DIR)/README $(DISTDIR)/unix
+ chmod 775 $(DISTDIR)/unix/configure $(DISTDIR)/unix/configure.in
+ chmod +x $(DISTDIR)/unix/install-sh
+ tclsh $(TCLDIR)/unix/mkLinks.tcl $(TOP_DIR)/doc/*.[13n] \
+ > $(DISTDIR)/unix/mkLinks
+ chmod +x $(DISTDIR)/unix/mkLinks
+ mkdir $(DISTDIR)/bitmaps
+ @(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/*.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
+ sccs edit -s $(TOP_DIR)/mac/tkMacProjects.sea.hqx
+ cp -p tkMacProjects.sea.hqx $(DISTDIR)/mac
+ sccs unedit $(TOP_DIR)/mac/tkMacProjects.sea.hqx
+ rm -f tkMacProjects.sea.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;)
+ mkdir $(DISTDIR)/library/demos
+ cp -pr $(TOP_DIR)/library/demos/*.tcl \
+ $(TOP_DIR)/library/demos/tclIndex \
+ $(TOP_DIR)/library/demos/browse \
+ $(TOP_DIR)/library/demos/hello $(TOP_DIR)/library/demos/ixset \
+ $(TOP_DIR)/library/demos/rmt $(TOP_DIR)/library/demos/rolodex \
+ $(TOP_DIR)/library/demos/square \
+ $(TOP_DIR)/library/demos/tcolor \
+ $(TOP_DIR)/library/demos/timer \
+ $(TOP_DIR)/library/demos/widget \
+ $(TOP_DIR)/library/demos/README \
+ $(TOP_DIR)/license.terms $(DISTDIR)/library/demos
+ mkdir $(DISTDIR)/library/demos/images
+ @(cd $(TOP_DIR); for i in library/demos/images/* ; do \
+ 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/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 $(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 -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 $(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.
+#
+package-config:
+ mkdir -p $(DISTDIR)/unix/`arch`
+ cd $(DISTDIR)/unix/`arch`; \
+ ../configure --prefix=/opt/SUNWtcl/$(TCLVERSION) \
+ --exec_prefix=/opt/SUNWtcl/$(TCLVERSION)/`arch` \
+ --with-tcl=$(DISTDIR)/../tcl$(TCLVERSION)/unix/`arch` \
+ --enable-shared
+ mkdir -p $(DISTDIR)/SUNWtcl/$(TCLVERSION)
+ mkdir -p $(DISTDIR)/SUNWtcl/$(TCLVERSION)/`arch`
+
+#
+# Build and install the architecture independent files in the dist directory.
+#
+
+package-common:
+ cd $(DISTDIR)/unix/`arch`;\
+ $(MAKE); \
+ $(MAKE) install-libraries install-man \
+ prefix=$(DISTDIR)/SUNWtcl/$(TCLVERSION) \
+ exec_prefix=$(DISTDIR)/SUNWtcl/$(TCLVERSION)/`arch`
+ mkdir -p $(DISTDIR)/SUNWtcl/$(TCLVERSION)/bin
+ sed -e "s/TCLVERSION/$(TCLVERSION)/g" \
+ -e "s/TKVERSION/$(VERSION)/g" < $(UNIX_DIR)/wish.sh \
+ > $(DISTDIR)/SUNWtcl/$(TCLVERSION)/bin/wish$(VERSION)
+ chmod 755 $(DISTDIR)/SUNWtcl/$(TCLVERSION)/bin/wish$(VERSION)
+
+#
+# Build and install the architecture specific files in the dist directory.
+#
+
+package-binaries:
+ cd $(DISTDIR)/unix/`arch`; \
+ $(MAKE); \
+ $(MAKE) install-binaries prefix=$(DISTDIR)/SUNWtcl/$(TCLVERSION) \
+ exec_prefix=$(DISTDIR)/SUNWtcl/$(TCLVERSION)/`arch`
+
+#
+# Generate a package from the installed files in the dist directory for the
+# current architecture.
+#
+
+package-generate:
+ pkgproto $(DISTDIR)/SUNWtcl/$(TCLVERSION)/bin=bin \
+ $(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.
diff --git a/tk/unix/README b/tk/unix/README
new file mode 100644
index 00000000000..2ee3d41173e
--- /dev/null
+++ b/tk/unix/README
@@ -0,0 +1,125 @@
+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$
+
+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
+ discard all the configuration information computed previously.
+
+(d) Type "./configure". This runs a configuration script created by GNU
+ autoconf, which configures Tcl for your system and creates a
+ Makefile. The configure script allows you to customize the Tcl
+ configuration for your site; for details on how you can do this,
+ type "./configure -help" or refer to the autoconf documentation (not
+ included here). Tk's "configure" script supports the following
+ special switches in addition to the standard ones:
+ --enable-gcc If this switch is set, Tk will configure
+ itself to use gcc if it is available on your
+ system. Note: it is not safe to modify the
+ Makefile to use gcc after configure is run.
+ --with-tcl=DIR Specifies the directory containing the Tcl
+ binaries and Tcl's platform-dependent
+ configuration information. By default
+ the Tcl directory is assumed to be in the
+ location given by (a) above.
+ --enable-shared If this switch is specified, Tk will compile
+ itself as a shared library if it can figure
+ out how to do that on this platform.
+ Note: be sure to use only absolute path names (those starting with "/")
+ in the --prefix and --exec_prefix options.
+
+(e) Type "make". This will create a library archive called "libtk.a"
+ or "libtk.so" and an interpreter application called "wish" that
+ allows you to type Tcl commands interactively or execute script files.
+
+(f) If the make fails then you'll have to personalize the Makefile
+ for your site or possibly modify the distribution in other ways.
+ First check the file "porting.notes" to see if there are hints
+ for compiling on your system. Then look at the porting Web page
+ described later in this file. If you need to modify Makefile,
+ there are comments at the beginning of it that describe the things
+ you might want to change and how to change them.
+
+(g) Type "make install" to install Tk's binaries and script files in
+ standard places. You'll need write permission on the installation
+ directoryies to do this. The installation directories are
+ determined by the "configure" script and may be specified with
+ the --prefix and --exec_prefix options to "configure". See the
+ Makefile for information on what directories were chosen; you
+ can override these choices by modifying the "prefix" and
+ "exec_prefix" variables in the Makefile.
+
+(h) At this point you can play with Tk by invoking the "wish"
+ 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
+processed. If any errors occur, you'll see a much more substantial
+printout for each error. In order to avoid false error reports, be sure
+to run the tests with an empty resource database (e.g., remove your
+.Xdefaults file or delete any entries starting with *). Also, don't
+try to do anything else with your display or keyboard whlie the tests
+are running, or you may get false violations. See the README file in
+the "tests" directory for more information on the test suite.
+
+If the test suite generates errors, most likely they are due to non-
+portable tests that are interacting badly with your system configuration.
+We are gradually eliminating the non-portable tests, but this release
+includes many new tests so there will probably be some portability
+problems. As long as the test suite doesn't core dump, it's probably
+safe to conclude that any errors represent portability problems in the
+test suite and not fundamental flaws with Tk.
+
+There are also a number of visual tests for things such as screen layout,
+Postscript generation, etc. These tests all have to be run manually and
+the results have to be verified visually. To run the tests, cd to the
+"tests" directory and run the script "visual". It will present a main
+window with a bunch of menus, which you can use to select various tests.
diff --git a/tk/unix/configure b/tk/unix/configure
new file mode 100755
index 00000000000..2b0b092e086
--- /dev/null
+++ b/tk/unix/configure
@@ -0,0 +1,3335 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.13
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+ac_help="$ac_help
+ --enable-gcc allow use of gcc if available"
+ac_help="$ac_help
+ --with-tcl=DIR use Tcl 8.0 binaries from DIR"
+ac_help="$ac_help
+ --with-x use the X Window System"
+ac_help="$ac_help
+ --enable-shared build libtk as a shared library"
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.13"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=../generic/tk.h
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+# SCCS: @(#) configure.in 1.90 97/11/20 12:45:45
+
+# CYGNUS LOCAL tromey - find config.guess/config.sub in our tree
+ac_aux_dir=
+for ac_dir in $srcdir/../.. $srcdir/$srcdir/../..; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in $srcdir/../.. $srcdir/$srcdir/../.." 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+
+# Do some error checking and defaulting for the host and target type.
+# The inputs are:
+# configure --host=HOST --target=TARGET --build=BUILD NONOPT
+#
+# The rules are:
+# 1. You are not allowed to specify --host, --target, and nonopt at the
+# same time.
+# 2. Host defaults to nonopt.
+# 3. If nonopt is not specified, then host defaults to the current host,
+# as determined by config.guess.
+# 4. Target and build default to nonopt.
+# 5. If nonopt is not specified, then target and build default to host.
+
+# The aliases save the names the user supplied, while $host etc.
+# will get canonicalized.
+case $host---$target---$nonopt in
+NONE---*---* | *---NONE---* | *---*---NONE) ;;
+*) { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; } ;;
+esac
+
+
+# Make sure we can run config.sub.
+if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then :
+else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking host system type""... $ac_c" 1>&6
+echo "configure:583: checking host system type" >&5
+
+host_alias=$host
+case "$host_alias" in
+NONE)
+ case $nonopt in
+ NONE)
+ if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then :
+ else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; }
+ fi ;;
+ *) host_alias=$nonopt ;;
+ esac ;;
+esac
+
+host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias`
+host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+echo "$ac_t""$host" 1>&6
+
+echo $ac_n "checking target system type""... $ac_c" 1>&6
+echo "configure:604: checking target system type" >&5
+
+target_alias=$target
+case "$target_alias" in
+NONE)
+ case $nonopt in
+ NONE) target_alias=$host_alias ;;
+ *) target_alias=$nonopt ;;
+ esac ;;
+esac
+
+target=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $target_alias`
+target_cpu=`echo $target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+target_vendor=`echo $target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+target_os=`echo $target | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+echo "$ac_t""$target" 1>&6
+
+echo $ac_n "checking build system type""... $ac_c" 1>&6
+echo "configure:622: checking build system type" >&5
+
+build_alias=$build
+case "$build_alias" in
+NONE)
+ case $nonopt in
+ NONE) build_alias=$host_alias ;;
+ *) build_alias=$nonopt ;;
+ esac ;;
+esac
+
+build=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $build_alias`
+build_cpu=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+build_vendor=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+build_os=`echo $build | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+echo "$ac_t""$build" 1>&6
+
+test "$host_alias" != "$target_alias" &&
+ test "$program_prefix$program_suffix$program_transform_name" = \
+ NONENONEs,x,x, &&
+ program_prefix=${target_alias}-
+
+# Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:647: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:677: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_prog_rejected=no
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -z "$CC"; then
+ case "`uname -s`" in
+ *win32* | *WIN32*)
+ # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:728: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="cl"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+ ;;
+ esac
+ fi
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:760: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 771 "configure"
+#include "confdefs.h"
+
+main(){return(0);}
+EOF
+if { (eval echo configure:776: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cc_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:802: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:807: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:816: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gcc=yes
+else
+ ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+else
+ GCC=
+fi
+
+ac_test_CFLAGS="${CFLAGS+set}"
+ac_save_CFLAGS="$CFLAGS"
+CFLAGS=
+echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:835: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:878: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ # Account for people who put trailing slashes in PATH elements.
+ case "$ac_dir/" in
+ /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ if test -f $ac_dir/$ac_prog; then
+ if test $ac_prog = install &&
+ grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ else
+ ac_cv_path_install="$ac_dir/$ac_prog -c"
+ break 2
+ fi
+ fi
+ done
+ ;;
+ esac
+ done
+ IFS="$ac_save_IFS"
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL="$ac_cv_path_install"
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL="$ac_install_sh"
+ fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_SCRIPT" && INSTALL_SCRIPT='${INSTALL_PROGRAM}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+# END CYGNUS LOCAL
+
+TK_VERSION=8.0
+TK_MAJOR_VERSION=8
+TK_MINOR_VERSION=0
+TK_PATCH_LEVEL=".4"
+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`
+
+# Extract the first word of "ranlib", so it can be a program name with args.
+set dummy ranlib; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:949: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_RANLIB'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$RANLIB"; then
+ ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_RANLIB="ranlib"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+ test -z "$ac_cv_prog_RANLIB" && ac_cv_prog_RANLIB=":"
+fi
+fi
+RANLIB="$ac_cv_prog_RANLIB"
+if test -n "$RANLIB"; then
+ echo "$ac_t""$RANLIB" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+# Check whether --enable-gcc or --disable-gcc was given.
+if test "${enable_gcc+set}" = set; then
+ enableval="$enable_gcc"
+ tk_ok=$enableval
+else
+ tkl_ok=no
+fi
+
+if test "$tk_ok" = "yes"; then
+ # Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:988: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1018: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_prog_rejected=no
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -z "$CC"; then
+ case "`uname -s`" in
+ *win32* | *WIN32*)
+ # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:1069: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_dummy="$PATH"
+ for ac_dir in $ac_dummy; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="cl"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+ ;;
+ esac
+ fi
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:1101: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext << EOF
+
+#line 1112 "configure"
+#include "confdefs.h"
+
+main(){return(0);}
+EOF
+if { (eval echo configure:1117: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cc_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:1143: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:1148: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:1157: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gcc=yes
+else
+ ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+else
+ GCC=
+fi
+
+ac_test_CFLAGS="${CFLAGS+set}"
+ac_save_CFLAGS="$CFLAGS"
+CFLAGS=
+echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:1176: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+
+else
+ CC=${CC-cc}
+
+fi
+echo $ac_n "checking how to run the C preprocessor""... $ac_c" 1>&6
+echo "configure:1212: checking how to run the C preprocessor" >&5
+# On Suns, sometimes $CPP names a directory.
+if test -n "$CPP" && test -d "$CPP"; then
+ CPP=
+fi
+if test -z "$CPP"; then
+if eval "test \"`echo '$''{'ac_cv_prog_CPP'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # This must be in double quotes, not single quotes, because CPP may get
+ # substituted into the Makefile and "${CC-cc}" will confuse make.
+ CPP="${CC-cc} -E"
+ # On the NeXT, cc -E runs the code through the compiler's parser,
+ # not just through cpp.
+ cat > conftest.$ac_ext <<EOF
+#line 1227 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1233: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -E -traditional-cpp"
+ cat > conftest.$ac_ext <<EOF
+#line 1244 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1250: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP="${CC-cc} -nologo -E"
+ cat > conftest.$ac_ext <<EOF
+#line 1261 "configure"
+#include "confdefs.h"
+#include <assert.h>
+Syntax Error
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1267: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ CPP=/lib/cpp
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+fi
+rm -f conftest*
+ ac_cv_prog_CPP="$CPP"
+fi
+ CPP="$ac_cv_prog_CPP"
+else
+ ac_cv_prog_CPP="$CPP"
+fi
+echo "$ac_t""$CPP" 1>&6
+
+for ac_hdr in unistd.h limits.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:1295: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1300 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1305: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+
+# 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
+
+#--------------------------------------------------------------------
+# 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.
+#--------------------------------------------------------------------
+
+# Check whether --with-tcl or --without-tcl was given.
+if test "${with_tcl+set}" = set; then
+ withval="$with_tcl"
+ TCL_BIN_DIR=$withval
+else
+ TCL_BIN_DIR=`cd ../../tcl/unix; pwd`
+fi
+
+if test -z "$TCL_BIN_DIR"; then
+ { echo "configure: error: couldn't find Tcl build directory in ../../tcl/unix" 1>&2; exit 1; }
+fi
+if test ! -d $TCL_BIN_DIR; then
+ { echo "configure: error: Tcl directory $TCL_BIN_DIR doesn't exist" 1>&2; exit 1; }
+fi
+if test ! -f $TCL_BIN_DIR/Makefile; then
+ { echo "configure: 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?" 1>&2; exit 1; }
+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).
+#--------------------------------------------------------------------
+
+echo $ac_n "checking stdlib.h""... $ac_c" 1>&6
+echo "configure:1396: checking stdlib.h" >&5
+cat > conftest.$ac_ext <<EOF
+#line 1398 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "strtol" >/dev/null 2>&1; then
+ rm -rf conftest*
+ tk_ok=yes
+else
+ rm -rf conftest*
+ tk_ok=no
+fi
+rm -f conftest*
+
+cat > conftest.$ac_ext <<EOF
+#line 1413 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "strtoul" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ tk_ok=no
+fi
+rm -f conftest*
+
+cat > conftest.$ac_ext <<EOF
+#line 1427 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "strtod" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ tk_ok=no
+fi
+rm -f conftest*
+
+if test $tk_ok = no; then
+ cat >> confdefs.h <<\EOF
+#define NO_STDLIB_H 1
+EOF
+
+fi
+echo "$ac_t""$tk_ok" 1>&6
+
+#--------------------------------------------------------------------
+# Include sys/select.h if it exists and if it supplies things
+# that appear to be useful and aren't already in sys/types.h.
+# This appears to be true only on the RS/6000 under AIX. Some
+# systems like OSF/1 have a sys/select.h that's of no use, and
+# other systems like SCO UNIX have a sys/select.h that's
+# pernicious. If "fd_set" isn't defined anywhere then set a
+# special flag.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking fd_set and sys/select""... $ac_c" 1>&6
+echo "configure:1459: checking fd_set and sys/select" >&5
+cat > conftest.$ac_ext <<EOF
+#line 1461 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+int main() {
+fd_set readMask, writeMask;
+; return 0; }
+EOF
+if { (eval echo configure:1468: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ tk_ok=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ tk_ok=no
+fi
+rm -f conftest*
+if test $tk_ok = no; then
+ cat > conftest.$ac_ext <<EOF
+#line 1480 "configure"
+#include "confdefs.h"
+#include <sys/select.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "fd_mask" >/dev/null 2>&1; then
+ rm -rf conftest*
+ tk_ok=yes
+fi
+rm -f conftest*
+
+ if test $tk_ok = yes; then
+ cat >> confdefs.h <<\EOF
+#define HAVE_SYS_SELECT_H 1
+EOF
+
+ fi
+fi
+echo "$ac_t""$tk_ok" 1>&6
+if test $tk_ok = no; then
+ cat >> confdefs.h <<\EOF
+#define NO_FD_SET 1
+EOF
+
+fi
+
+#--------------------------------------------------------------------
+# Check for various typedefs and provide substitutes if
+# they don't exist.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for ANSI C header files""... $ac_c" 1>&6
+echo "configure:1512: checking for ANSI C header files" >&5
+if eval "test \"`echo '$''{'ac_cv_header_stdc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1517 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+#include <stdarg.h>
+#include <string.h>
+#include <float.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1525: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ ac_cv_header_stdc=yes
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+if test $ac_cv_header_stdc = yes; then
+ # SunOS 4.x string.h does not declare mem*, contrary to ANSI.
+cat > conftest.$ac_ext <<EOF
+#line 1542 "configure"
+#include "confdefs.h"
+#include <string.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "memchr" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+ # ISC 2.0.2 stdlib.h does not declare free, contrary to ANSI.
+cat > conftest.$ac_ext <<EOF
+#line 1560 "configure"
+#include "confdefs.h"
+#include <stdlib.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "free" >/dev/null 2>&1; then
+ :
+else
+ rm -rf conftest*
+ ac_cv_header_stdc=no
+fi
+rm -f conftest*
+
+fi
+
+if test $ac_cv_header_stdc = yes; then
+ # /bin/cc in Irix-4.0.5 gets non-ANSI ctype macros unless using -ansi.
+if test "$cross_compiling" = yes; then
+ :
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1581 "configure"
+#include "confdefs.h"
+#include <ctype.h>
+#define ISLOWER(c) ('a' <= (c) && (c) <= 'z')
+#define TOUPPER(c) (ISLOWER(c) ? 'A' + ((c) - 'a') : (c))
+#define XOR(e, f) (((e) && !(f)) || (!(e) && (f)))
+int main () { int i; for (i = 0; i < 256; i++)
+if (XOR (islower (i), ISLOWER (i)) || toupper (i) != TOUPPER (i)) exit(2);
+exit (0); }
+
+EOF
+if { (eval echo configure:1592: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ :
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_header_stdc=no
+fi
+rm -fr conftest*
+fi
+
+fi
+fi
+
+echo "$ac_t""$ac_cv_header_stdc" 1>&6
+if test $ac_cv_header_stdc = yes; then
+ cat >> confdefs.h <<\EOF
+#define STDC_HEADERS 1
+EOF
+
+fi
+
+echo $ac_n "checking for mode_t""... $ac_c" 1>&6
+echo "configure:1616: checking for mode_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_mode_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1621 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "(^|[^a-zA-Z_0-9])mode_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_mode_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_mode_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_mode_t" 1>&6
+if test $ac_cv_type_mode_t = no; then
+ cat >> confdefs.h <<\EOF
+#define mode_t int
+EOF
+
+fi
+
+echo $ac_n "checking for pid_t""... $ac_c" 1>&6
+echo "configure:1649: checking for pid_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_pid_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1654 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "(^|[^a-zA-Z_0-9])pid_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_pid_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_pid_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_pid_t" 1>&6
+if test $ac_cv_type_pid_t = no; then
+ cat >> confdefs.h <<\EOF
+#define pid_t int
+EOF
+
+fi
+
+echo $ac_n "checking for size_t""... $ac_c" 1>&6
+echo "configure:1682: checking for size_t" >&5
+if eval "test \"`echo '$''{'ac_cv_type_size_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1687 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#if STDC_HEADERS
+#include <stdlib.h>
+#include <stddef.h>
+#endif
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "(^|[^a-zA-Z_0-9])size_t[^a-zA-Z_0-9]" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_size_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_size_t=no
+fi
+rm -f conftest*
+
+fi
+echo "$ac_t""$ac_cv_type_size_t" 1>&6
+if test $ac_cv_type_size_t = no; then
+ cat >> confdefs.h <<\EOF
+#define size_t unsigned
+EOF
+
+fi
+
+echo $ac_n "checking for uid_t in sys/types.h""... $ac_c" 1>&6
+echo "configure:1715: checking for uid_t in sys/types.h" >&5
+if eval "test \"`echo '$''{'ac_cv_type_uid_t'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1720 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "uid_t" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_type_uid_t=yes
+else
+ rm -rf conftest*
+ ac_cv_type_uid_t=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_type_uid_t" 1>&6
+if test $ac_cv_type_uid_t = no; then
+ cat >> confdefs.h <<\EOF
+#define uid_t int
+EOF
+
+ cat >> confdefs.h <<\EOF
+#define gid_t int
+EOF
+
+fi
+
+
+#------------------------------------------------------------------------------
+# Find out about time handling differences.
+#------------------------------------------------------------------------------
+
+for ac_hdr in sys/time.h
+do
+ac_safe=`echo "$ac_hdr" | sed 'y%./+-%__p_%'`
+echo $ac_n "checking for $ac_hdr""... $ac_c" 1>&6
+echo "configure:1757: checking for $ac_hdr" >&5
+if eval "test \"`echo '$''{'ac_cv_header_$ac_safe'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1762 "configure"
+#include "confdefs.h"
+#include <$ac_hdr>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1767: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=yes"
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_header_$ac_safe=no"
+fi
+rm -f conftest*
+fi
+if eval "test \"`echo '$ac_cv_header_'$ac_safe`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ ac_tr_hdr=HAVE_`echo $ac_hdr | sed 'y%abcdefghijklmnopqrstuvwxyz./-%ABCDEFGHIJKLMNOPQRSTUVWXYZ___%'`
+ cat >> confdefs.h <<EOF
+#define $ac_tr_hdr 1
+EOF
+
+else
+ echo "$ac_t""no" 1>&6
+fi
+done
+
+echo $ac_n "checking whether time.h and sys/time.h may both be included""... $ac_c" 1>&6
+echo "configure:1794: checking whether time.h and sys/time.h may both be included" >&5
+if eval "test \"`echo '$''{'ac_cv_header_time'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 1799 "configure"
+#include "confdefs.h"
+#include <sys/types.h>
+#include <sys/time.h>
+#include <time.h>
+int main() {
+struct tm *tp;
+; return 0; }
+EOF
+if { (eval echo configure:1808: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ rm -rf conftest*
+ ac_cv_header_time=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ ac_cv_header_time=no
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_header_time" 1>&6
+if test $ac_cv_header_time = yes; then
+ cat >> confdefs.h <<\EOF
+#define TIME_WITH_SYS_TIME 1
+EOF
+
+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
+# no include files, so double-check its result just to be safe.
+#--------------------------------------------------------------------
+
+# If we find X, set shell vars x_includes and x_libraries to the
+# paths, otherwise set no_x=yes.
+# Uses ac_ vars as temps to allow command line to override cache and checks.
+# --without-x overrides everything else, but does not touch the cache.
+echo $ac_n "checking for X""... $ac_c" 1>&6
+echo "configure:1843: checking for X" >&5
+
+# Check whether --with-x or --without-x was given.
+if test "${with_x+set}" = set; then
+ withval="$with_x"
+ :
+fi
+
+# $have_x is `yes', `no', `disabled', or empty when we do not yet know.
+if test "x$with_x" = xno; then
+ # The user explicitly disabled X.
+ have_x=disabled
+else
+ if test "x$x_includes" != xNONE && test "x$x_libraries" != xNONE; then
+ # Both variables are already set.
+ have_x=yes
+ else
+if eval "test \"`echo '$''{'ac_cv_have_x'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ # One or both of the vars are not set, and there is no cached value.
+ac_x_includes=NO ac_x_libraries=NO
+rm -fr conftestdir
+if mkdir conftestdir; then
+ cd conftestdir
+ # Make sure to not put "make" in the Imakefile rules, since we grep it out.
+ cat > Imakefile <<'EOF'
+acfindx:
+ @echo 'ac_im_incroot="${INCROOT}"; ac_im_usrlibdir="${USRLIBDIR}"; ac_im_libdir="${LIBDIR}"'
+EOF
+ if (xmkmf) >/dev/null 2>/dev/null && test -f Makefile; then
+ # GNU make sometimes prints "make[1]: Entering...", which would confuse us.
+ eval `${MAKE-make} acfindx 2>/dev/null | grep -v make`
+ # Open Windows xmkmf reportedly sets LIBDIR instead of USRLIBDIR.
+ for ac_extension in a so sl; do
+ if test ! -f $ac_im_usrlibdir/libX11.$ac_extension &&
+ test -f $ac_im_libdir/libX11.$ac_extension; then
+ ac_im_usrlibdir=$ac_im_libdir; break
+ fi
+ done
+ # Screen out bogus values from the imake configuration. They are
+ # bogus both because they are the default anyway, and because
+ # using them would break gcc on systems where it needs fixed includes.
+ case "$ac_im_incroot" in
+ /usr/include) ;;
+ *) test -f "$ac_im_incroot/X11/Xos.h" && ac_x_includes="$ac_im_incroot" ;;
+ esac
+ case "$ac_im_usrlibdir" in
+ /usr/lib | /lib) ;;
+ *) test -d "$ac_im_usrlibdir" && ac_x_libraries="$ac_im_usrlibdir" ;;
+ esac
+ fi
+ cd ..
+ rm -fr conftestdir
+fi
+
+if test "$ac_x_includes" = NO; then
+ # Guess where to find include files, by looking for this one X11 .h file.
+ test -z "$x_direct_test_include" && x_direct_test_include=X11/Intrinsic.h
+
+ # First, try using that file with no special directory specified.
+cat > conftest.$ac_ext <<EOF
+#line 1905 "configure"
+#include "confdefs.h"
+#include <$x_direct_test_include>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:1910: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ rm -rf conftest*
+ # We can compile using X headers with no special include directory.
+ac_x_includes=
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ # Look for the header file in a standard set of common directories.
+# Check X11 before X11Rn because it is often a symlink to the current release.
+ for ac_dir in \
+ /usr/X11/include \
+ /usr/X11R6/include \
+ /usr/X11R5/include \
+ /usr/X11R4/include \
+ \
+ /usr/include/X11 \
+ /usr/include/X11R6 \
+ /usr/include/X11R5 \
+ /usr/include/X11R4 \
+ \
+ /usr/local/X11/include \
+ /usr/local/X11R6/include \
+ /usr/local/X11R5/include \
+ /usr/local/X11R4/include \
+ \
+ /usr/local/include/X11 \
+ /usr/local/include/X11R6 \
+ /usr/local/include/X11R5 \
+ /usr/local/include/X11R4 \
+ \
+ /usr/X386/include \
+ /usr/x386/include \
+ /usr/XFree86/include/X11 \
+ \
+ /usr/include \
+ /usr/local/include \
+ /usr/unsupported/include \
+ /usr/athena/include \
+ /usr/local/x11r5/include \
+ /usr/lpp/Xamples/include \
+ \
+ /usr/openwin/include \
+ /usr/openwin/share/include \
+ ; \
+ do
+ if test -r "$ac_dir/$x_direct_test_include"; then
+ ac_x_includes=$ac_dir
+ break
+ fi
+ done
+fi
+rm -f conftest*
+fi # $ac_x_includes = NO
+
+if test "$ac_x_libraries" = NO; then
+ # Check for the libraries.
+
+ test -z "$x_direct_test_library" && x_direct_test_library=Xt
+ test -z "$x_direct_test_function" && x_direct_test_function=XtMalloc
+
+ # See if we find them without any special options.
+ # Don't add to $LIBS permanently.
+ ac_save_LIBS="$LIBS"
+ LIBS="-l$x_direct_test_library $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 1979 "configure"
+#include "confdefs.h"
+
+int main() {
+${x_direct_test_function}()
+; return 0; }
+EOF
+if { (eval echo configure:1986: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ LIBS="$ac_save_LIBS"
+# We can link X programs with no special library path.
+ac_x_libraries=
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ LIBS="$ac_save_LIBS"
+# First see if replacing the include by lib works.
+# Check X11 before X11Rn because it is often a symlink to the current release.
+for ac_dir in `echo "$ac_x_includes" | sed s/include/lib/` \
+ /usr/X11/lib \
+ /usr/X11R6/lib \
+ /usr/X11R5/lib \
+ /usr/X11R4/lib \
+ \
+ /usr/lib/X11 \
+ /usr/lib/X11R6 \
+ /usr/lib/X11R5 \
+ /usr/lib/X11R4 \
+ \
+ /usr/local/X11/lib \
+ /usr/local/X11R6/lib \
+ /usr/local/X11R5/lib \
+ /usr/local/X11R4/lib \
+ \
+ /usr/local/lib/X11 \
+ /usr/local/lib/X11R6 \
+ /usr/local/lib/X11R5 \
+ /usr/local/lib/X11R4 \
+ \
+ /usr/X386/lib \
+ /usr/x386/lib \
+ /usr/XFree86/lib/X11 \
+ \
+ /usr/lib \
+ /usr/local/lib \
+ /usr/unsupported/lib \
+ /usr/athena/lib \
+ /usr/local/x11r5/lib \
+ /usr/lpp/Xamples/lib \
+ /lib/usr/lib/X11 \
+ \
+ /usr/openwin/lib \
+ /usr/openwin/share/lib \
+ ; \
+do
+ for ac_extension in a so sl; do
+ if test -r $ac_dir/lib${x_direct_test_library}.$ac_extension; then
+ ac_x_libraries=$ac_dir
+ break 2
+ fi
+ done
+done
+fi
+rm -f conftest*
+fi # $ac_x_libraries = NO
+
+if test "$ac_x_includes" = NO || test "$ac_x_libraries" = NO; then
+ # Didn't find X anywhere. Cache the known absence of X.
+ ac_cv_have_x="have_x=no"
+else
+ # Record where we found X for the cache.
+ ac_cv_have_x="have_x=yes \
+ ac_x_includes=$ac_x_includes ac_x_libraries=$ac_x_libraries"
+fi
+fi
+ fi
+ eval "$ac_cv_have_x"
+fi # $with_x != no
+
+if test "$have_x" != yes; then
+ echo "$ac_t""$have_x" 1>&6
+ no_x=yes
+else
+ # If each of the values was on the command line, it overrides each guess.
+ test "x$x_includes" = xNONE && x_includes=$ac_x_includes
+ test "x$x_libraries" = xNONE && x_libraries=$ac_x_libraries
+ # Update the cache value to reflect the command line values.
+ ac_cv_have_x="have_x=yes \
+ ac_x_includes=$x_includes ac_x_libraries=$x_libraries"
+ echo "$ac_t""libraries $x_libraries, headers $x_includes" 1>&6
+fi
+
+not_really_there=""
+if test "$no_x" = ""; then
+ if test "$x_includes" = ""; then
+ cat > conftest.$ac_ext <<EOF
+#line 2076 "configure"
+#include "confdefs.h"
+#include <X11/XIntrinsic.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2081: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ not_really_there="yes"
+fi
+rm -f conftest*
+ else
+ if test ! -r $x_includes/X11/Intrinsic.h; then
+ not_really_there="yes"
+ fi
+ fi
+fi
+if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then
+ echo $ac_n "checking for X11 header files""... $ac_c" 1>&6
+echo "configure:2101: checking for X11 header files" >&5
+ XINCLUDES="# no special path needed"
+ cat > conftest.$ac_ext <<EOF
+#line 2104 "configure"
+#include "confdefs.h"
+#include <X11/Intrinsic.h>
+EOF
+ac_try="$ac_cpp conftest.$ac_ext >/dev/null 2>conftest.out"
+{ (eval echo configure:2109: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }
+ac_err=`grep -v '^ *+' conftest.out | grep -v "^conftest.${ac_ext}\$"`
+if test -z "$ac_err"; then
+ :
+else
+ echo "$ac_err" >&5
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ XINCLUDES="nope"
+fi
+rm -f conftest*
+ if test "$XINCLUDES" = nope; then
+ dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/X11R6/include /usr/X11R5/include /usr/include/X11R5 /usr/include/X11R4 /usr/openwin/include /usr/X11/include /usr/sww/include"
+ for i in $dirs ; do
+ if test -r $i/X11/Intrinsic.h; then
+ echo "$ac_t""$i" 1>&6
+ XINCLUDES=" -I$i"
+ break
+ fi
+ done
+ fi
+else
+ if test "$x_includes" != ""; then
+ XINCLUDES=-I$x_includes
+ else
+ XINCLUDES="# no special path needed"
+ fi
+fi
+if test "$XINCLUDES" = nope; then
+ echo "$ac_t""couldn't find any!" 1>&6
+ XINCLUDES="# no include files found"
+fi
+
+if test "$no_x" = yes; then
+ echo $ac_n "checking for X11 libraries""... $ac_c" 1>&6
+echo "configure:2145: checking for X11 libraries" >&5
+ XLIBSW=nope
+ dirs="/usr/unsupported/lib /usr/local/lib /usr/X386/lib /usr/X11R6/lib /usr/X11R5/lib /usr/lib/X11R5 /usr/lib/X11R4 /usr/openwin/lib /usr/X11/lib /usr/sww/X11/lib"
+ for i in $dirs ; do
+ if test -r $i/libX11.a -o -r $i/libX11.so -o -r $i/libX11.sl; then
+ echo "$ac_t""$i" 1>&6
+ XLIBSW="-L$i -lX11"
+ x_libraries="$i"
+ break
+ fi
+ done
+else
+ if test "$x_libraries" = ""; then
+ XLIBSW=-lX11
+ else
+ XLIBSW="-L$x_libraries -lX11"
+ fi
+fi
+if test "$XLIBSW" = nope ; then
+ echo $ac_n "checking for XCreateWindow in -lXwindow""... $ac_c" 1>&6
+echo "configure:2165: checking for XCreateWindow in -lXwindow" >&5
+ac_lib_var=`echo Xwindow'_'XCreateWindow | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lXwindow $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2173 "configure"
+#include "confdefs.h"
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char XCreateWindow();
+
+int main() {
+XCreateWindow()
+; return 0; }
+EOF
+if { (eval echo configure:2184: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ XLIBSW=-lXwindow
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+fi
+if test "$XLIBSW" = nope ; then
+ echo "$ac_t""couldn't find any! Using -lX11." 1>&6
+ XLIBSW=-lX11
+fi
+
+#--------------------------------------------------------------------
+# Various manipulations on the search path used at runtime to
+# find shared libraries:
+# 1. If the X library binaries are in a non-standard directory,
+# add the X library location into that search path.
+# 2. On systems such as AIX and Ultrix that use "-L" as the
+# search path option, colons cannot be used to separate
+# directories from each other. Change colons to " -L".
+# 3. Create two sets of search flags, one for use in cc lines
+# and the other for when the linker is invoked directly. In
+# the second case, '-Wl,' must be stripped off and commas must
+# be replaced by spaces.
+#--------------------------------------------------------------------
+
+if test "x${x_libraries}" != "x"; then
+ LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${x_libraries}"
+fi
+if test "${TCL_LD_SEARCH_FLAGS}" = '-L${LIB_RUNTIME_DIR}'; then
+ LIB_RUNTIME_DIR=`echo ${LIB_RUNTIME_DIR} |sed -e 's/:/ -L/g'`
+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"`
+
+# CYGNUS LOCAL: Don't hack TK_LD_SEARCH_FLAGS if SHLIB_LD is gcc.
+case "${SHLIB_LD}" in
+ *gcc*) TK_LD_SEARCH_FLAGS="${TK_CC_SEARCH_FLAGS}" ;;
+esac
+
+#
+# CYGNUS LOCAL: statically link on Solaris, HPUX & SunOS so that
+# we don't have problems with people not having libraries
+# installed or not having LD_LIBRARY_PATH set.
+#
+
+ case "$host" in
+#
+# gdb linked statically w/ Solaris iff GCC and GNU ld are used,
+# otherwise dynamic
+#
+ sparc-sun-solaris2*)
+ sol_xlibsw=
+ if test "x$GCC" = "xyes" ; then
+ # This is probably the simplest way to test for GNU ld.
+ # It only works with relatively recent versions of GNU
+ # ld.
+ gld_text=`$CC -Wl,--version 2>&1 | sed 1q`
+ case "$gld_text" in
+ GNU* | *BFD*)
+ # sol2.* has libX*.so files in /usr/lib,
+ # but not libX*.a files, so we need to force a
+ # -L/usr/openwin/lib option, sometimes.
+ # FIXME: this won't work right if someone has
+ # their own X libraries in say /usr/local/lib.
+ case "$XLIBSW" in
+ *-L*) ;;
+ *) if test ! -f /usr/lib/libXt.a; then
+ XLIBSW="-L/usr/openwin/lib $XLIBSW"
+ fi
+ ;;
+ esac
+
+ # Why do we link against libX11 twice? Because the
+ # Openwin X11 and Xext libraries are seriously broken.
+ sol_xlibsw="-Wl,-Bstatic $XLIBSW -lXext -lX11 -Wl,-Bdynamic"
+ ;;
+ esac
+ fi
+ if test -z "$sol_xlibsw"; then
+ if test "x$x_libraries" != "x"; then
+ XLIBSW="$XLIBSW -R$x_libraries"
+ fi
+ else
+ XLIBSW=$sol_xlibsw
+ suppress_enable_shared=yes
+ fi
+ ;;
+#
+# gdb linked statically w/ SunOS or HPUX, but not hpux11 wide
+#
+ hppa*w-hp-hpux*)
+ ;;
+
+ m68k-hp-hpux*|hppa*-hp-hpux*|sparc-sun-sunos*)
+ if test "x$x_libraries" != "x" ;
+ then
+ XLIBSW="$x_libraries/libX11.a"
+ else
+ XLIBSW="/usr/lib/libX11.a"
+ fi
+ suppress_enable_shared=yes
+ ;;
+#
+# default is to link dynamically
+#
+ *)
+ ;;
+ esac
+#
+# END CYGNUS LOCAL
+
+#--------------------------------------------------------------------
+# 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
+# "gethostbyname" to check for -lnsl.
+# 2. Use each function name only once: can't redo a check because
+# autoconf caches the results of the last check and won't redo it.
+# 3. Use -lnsl and -lsocket only if they supply procedures that
+# aren't already present in the normal libraries. This is because
+# IRIX 5.2 has libraries, but they aren't needed and they're
+# bogus: they goof up name resolution if used.
+# 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+# To get around this problem, check for both libraries together
+# if -lsocket doesn't work by itself.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for main in -lXbsd""... $ac_c" 1>&6
+echo "configure:2334: checking for main in -lXbsd" >&5
+ac_lib_var=`echo Xbsd'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lXbsd $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2342 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:2349: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ LIBS="$LIBS -lXbsd"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+# CYGNUS LOCAL: Store any socket library(ies) in the cache, and don't
+# mess up the cache values of the functions we check for.
+echo $ac_n "checking for socket libraries""... $ac_c" 1>&6
+echo "configure:2373: checking for socket libraries" >&5
+if eval "test \"`echo '$''{'tcl_cv_lib_sockets'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ tcl_cv_lib_sockets=
+ tk_checkBoth=0
+ unset ac_cv_func_connect
+ echo $ac_n "checking for connect""... $ac_c" 1>&6
+echo "configure:2381: checking for connect" >&5
+if eval "test \"`echo '$''{'ac_cv_func_connect'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2386 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char connect(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char connect();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_connect) || defined (__stub___connect)
+choke me
+#else
+connect();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2409: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_connect=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_connect=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'connect`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tk_checkSocket=0
+else
+ echo "$ac_t""no" 1>&6
+tk_checkSocket=1
+fi
+
+ if test "$tk_checkSocket" = 1; then
+ unset ac_cv_func_connect
+ echo $ac_n "checking for main in -lsocket""... $ac_c" 1>&6
+echo "configure:2432: checking for main in -lsocket" >&5
+ac_lib_var=`echo socket'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lsocket $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2440 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:2447: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_cv_lib_sockets="-lsocket"
+else
+ echo "$ac_t""no" 1>&6
+tk_checkBoth=1
+fi
+
+ fi
+ if test "$tk_checkBoth" = 1; then
+ tk_oldLibs=$LIBS
+ LIBS="$LIBS -lsocket -lnsl"
+ unset ac_cv_func_accept
+ echo $ac_n "checking for accept""... $ac_c" 1>&6
+echo "configure:2474: checking for accept" >&5
+if eval "test \"`echo '$''{'ac_cv_func_accept'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2479 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char accept(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char accept();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_accept) || defined (__stub___accept)
+choke me
+#else
+accept();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2502: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_accept=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_accept=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'accept`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_checkNsl=0
+ tcl_cv_lib_sockets="-lsocket -lnsl"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ unset ac_cv_func_accept
+ LIBS=$tk_oldLibs
+ fi
+ unset ac_cv_func_gethostbyname
+ tk_oldLibs=$LIBS
+ LIBS="$LIBS $tk_cv_lib_sockets"
+ echo $ac_n "checking for gethostbyname""... $ac_c" 1>&6
+echo "configure:2529: checking for gethostbyname" >&5
+if eval "test \"`echo '$''{'ac_cv_func_gethostbyname'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2534 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char gethostbyname(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char gethostbyname();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_gethostbyname) || defined (__stub___gethostbyname)
+choke me
+#else
+gethostbyname();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2557: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_gethostbyname=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_gethostbyname=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'gethostbyname`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+echo $ac_n "checking for main in -lnsl""... $ac_c" 1>&6
+echo "configure:2575: checking for main in -lnsl" >&5
+ac_lib_var=`echo nsl'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lnsl $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2583 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:2590: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tcl_cv_lib_sockets="$tcl_cv_lib_sockets -lnsl"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+fi
+
+ unset ac_cv_func_gethostbyname
+ LIBS=$tcl_oldLIBS
+
+fi
+
+echo "$ac_t""$tcl_cv_lib_sockets" 1>&6
+test -z "$tcl_cv_lib_sockets" || LIBS="$LIBS $tcl_cv_lib_sockets"
+
+#--------------------------------------------------------------------
+# 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.
+#
+# Note: can't use ac_check_lib macro (at least, not in Autoconf 2.1)
+# because it can't deal with the "-" in the library name.
+#--------------------------------------------------------------------
+
+if test -d /usr/include/mit ; then
+ echo $ac_n "checking MIT X libraries""... $ac_c" 1>&6
+echo "configure:2633: checking MIT X libraries" >&5
+ tk_oldCFlags=$CFLAGS
+ CFLAGS="$CFLAGS -I/usr/include/mit"
+ tk_oldLibs=$LIBS
+ LIBS="$LIBS -lX11-mit"
+ cat > conftest.$ac_ext <<EOF
+#line 2639 "configure"
+#include "confdefs.h"
+
+ #include <X11/Xlib.h>
+
+int main() {
+
+ XOpenDisplay(0);
+
+; return 0; }
+EOF
+if { (eval echo configure:2650: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+
+ echo "$ac_t""yes" 1>&6
+ XLIBSW="-lX11-mit"
+ XINCLUDES="-I/usr/include/mit"
+
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ echo "$ac_t""no" 1>&6
+fi
+rm -f conftest*
+ CFLAGS=$tk_oldCFlags
+ LIBS=$tk_oldLibs
+fi
+
+#--------------------------------------------------------------------
+# On a few very rare systems, all of the libm.a stuff is
+# already in libc.a. Set compiler flags accordingly.
+# Also, Linux requires the "ieee" library for math to
+# work right (and it must appear before "-lm").
+#--------------------------------------------------------------------
+
+MATH_LIBS=""
+echo $ac_n "checking for sin""... $ac_c" 1>&6
+echo "configure:2677: checking for sin" >&5
+if eval "test \"`echo '$''{'ac_cv_func_sin'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2682 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char sin(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char sin();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_sin) || defined (__stub___sin)
+choke me
+#else
+sin();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2705: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_sin=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_sin=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'sin`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ :
+else
+ echo "$ac_t""no" 1>&6
+MATH_LIBS="-lm"
+fi
+
+echo $ac_n "checking for main in -lieee""... $ac_c" 1>&6
+echo "configure:2726: checking for main in -lieee" >&5
+ac_lib_var=`echo ieee'_'main | sed 'y%./+-%__p_%'`
+if eval "test \"`echo '$''{'ac_cv_lib_$ac_lib_var'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ ac_save_LIBS="$LIBS"
+LIBS="-lieee $LIBS"
+cat > conftest.$ac_ext <<EOF
+#line 2734 "configure"
+#include "confdefs.h"
+
+int main() {
+main()
+; return 0; }
+EOF
+if { (eval echo configure:2741: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_lib_$ac_lib_var=no"
+fi
+rm -f conftest*
+LIBS="$ac_save_LIBS"
+
+fi
+if eval "test \"`echo '$ac_cv_lib_'$ac_lib_var`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ MATH_LIBS="-lieee $MATH_LIBS"
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+
+#--------------------------------------------------------------------
+# Figure out whether "char" is unsigned. If so, set a
+# #define for __CHAR_UNSIGNED__.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking whether char is unsigned""... $ac_c" 1>&6
+echo "configure:2768: checking whether char is unsigned" >&5
+if eval "test \"`echo '$''{'ac_cv_c_char_unsigned'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test "$GCC" = yes; then
+ # GCC predefines this symbol on systems where it applies.
+cat > conftest.$ac_ext <<EOF
+#line 2775 "configure"
+#include "confdefs.h"
+#ifdef __CHAR_UNSIGNED__
+ yes
+#endif
+
+EOF
+if (eval "$ac_cpp conftest.$ac_ext") 2>&5 |
+ egrep "yes" >/dev/null 2>&1; then
+ rm -rf conftest*
+ ac_cv_c_char_unsigned=yes
+else
+ rm -rf conftest*
+ ac_cv_c_char_unsigned=no
+fi
+rm -f conftest*
+
+else
+if test "$cross_compiling" = yes; then
+ { echo "configure: error: can not run test program while cross compiling" 1>&2; exit 1; }
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2797 "configure"
+#include "confdefs.h"
+/* volatile prevents gcc2 from optimizing the test away on sparcs. */
+#if !defined(__STDC__) || __STDC__ != 1
+#define volatile
+#endif
+main() {
+ volatile char c = 255; exit(c < 0);
+}
+EOF
+if { (eval echo configure:2807: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ ac_cv_c_char_unsigned=yes
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ ac_cv_c_char_unsigned=no
+fi
+rm -fr conftest*
+fi
+
+fi
+fi
+
+echo "$ac_t""$ac_cv_c_char_unsigned" 1>&6
+if test $ac_cv_c_char_unsigned = yes && test "$GCC" != yes; then
+ cat >> confdefs.h <<\EOF
+#define __CHAR_UNSIGNED__ 1
+EOF
+
+fi
+
+
+#--------------------------------------------------------------------
+# Under Solaris 2.4, strtod returns the wrong value for the
+# terminating character under some conditions. Check for this
+# and if the problem exists use a substitute procedure
+# "fixstrtod" (provided by Tcl) that corrects the error.
+#--------------------------------------------------------------------
+
+echo $ac_n "checking for strtod""... $ac_c" 1>&6
+echo "configure:2839: checking for strtod" >&5
+if eval "test \"`echo '$''{'ac_cv_func_strtod'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2844 "configure"
+#include "confdefs.h"
+/* System header to define __stub macros and hopefully few prototypes,
+ which can conflict with char strtod(); below. */
+#include <assert.h>
+/* Override any gcc2 internal prototype to avoid an error. */
+/* We use char because int might match the return type of a gcc2
+ builtin and then its argument prototype would still apply. */
+char strtod();
+
+int main() {
+
+/* The GNU C library defines this for functions which it implements
+ to always fail with ENOSYS. Some functions are actually named
+ something starting with __ and the normal name is an alias. */
+#if defined (__stub_strtod) || defined (__stub___strtod)
+choke me
+#else
+strtod();
+#endif
+
+; return 0; }
+EOF
+if { (eval echo configure:2867: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ rm -rf conftest*
+ eval "ac_cv_func_strtod=yes"
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -rf conftest*
+ eval "ac_cv_func_strtod=no"
+fi
+rm -f conftest*
+fi
+
+if eval "test \"`echo '$ac_cv_func_'strtod`\" = yes"; then
+ echo "$ac_t""yes" 1>&6
+ tk_strtod=1
+else
+ echo "$ac_t""no" 1>&6
+tk_strtod=0
+fi
+
+if test "$tk_strtod" = 1; then
+ echo $ac_n "checking for Solaris 2.4 strtod bug""... $ac_c" 1>&6
+echo "configure:2889: checking for Solaris 2.4 strtod bug" >&5
+ if test "$cross_compiling" = yes; then
+ tk_ok=0
+else
+ cat > conftest.$ac_ext <<EOF
+#line 2894 "configure"
+#include "confdefs.h"
+
+ extern double strtod();
+ int main()
+ {
+ char *string = "NaN";
+ char *term;
+ strtod(string, &term);
+ if ((term != string) && (term[-1] == 0)) {
+ exit(1);
+ }
+ exit(0);
+ }
+EOF
+if { (eval echo configure:2909: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext} && (./conftest; exit) 2>/dev/null
+then
+ tk_ok=1
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ rm -fr conftest*
+ tk_ok=0
+fi
+rm -fr conftest*
+fi
+
+ if test "$tk_ok" = 1; then
+ echo "$ac_t""ok" 1>&6
+ else
+ echo "$ac_t""buggy" 1>&6
+ cat >> confdefs.h <<\EOF
+#define strtod fixstrtod
+EOF
+
+ fi
+fi
+
+#--------------------------------------------------------------------
+# The statements below define a collection of symbols related to
+# building libtk as a shared library instead of a static library.
+#--------------------------------------------------------------------
+
+# Check whether --enable-shared or --disable-shared was given.
+if test "${enable_shared+set}" = set; then
+ enableval="$enable_shared"
+ ok=$enableval
+else
+ ok=no
+fi
+
+
+# CYGNUS LOCAL: on machines where static linking of libX11 is important,
+# it is also important to build a static libtk.
+if test -n "$suppress_enable_shared"; then
+ ok=no
+fi
+# END CYGNUS LOCAL
+
+TK_SHARED_LIB_FILE=
+TK_UNSHARED_LIB_FILE=
+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}"
+ TK_SHARED_LIB_FILE="$TK_LIB_FILE"
+ 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}"
+ TK_UNSHARED_LIB_FILE="$TK_LIB_FILE"
+ MAKE_LIB="ar cr ${TK_LIB_FILE} \${OBJS}"
+fi
+
+TK_BUILD_INCLUDES="-I`cd $srcdir/../generic; pwd`"
+
+# 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_FLAG="-ltk${VERSION}\${TK_DBGX}"
+else
+ TK_BUILD_LIB_SPEC="-L`pwd` -ltk`echo ${VERSION} | tr -d .`"
+ TK_LIB_FLAG="-ltk`echo ${VERSION} | tr -d .`\${TK_DBGX}"
+fi
+
+TK_LIB_FULL_PATH="`pwd`/${TK_LIB_FILE}"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+# CYGNUS LOCAL
+# Need more variables to keep shared/static linking separate.
+
+
+
+
+# END CYGNUS LOCAL
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set | grep ac_space) 2>&1` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.13"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "Makefile tkConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@FFLAGS@%$FFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@host@%$host%g
+s%@host_alias@%$host_alias%g
+s%@host_cpu@%$host_cpu%g
+s%@host_vendor@%$host_vendor%g
+s%@host_os@%$host_os%g
+s%@target@%$target%g
+s%@target_alias@%$target_alias%g
+s%@target_cpu@%$target_cpu%g
+s%@target_vendor@%$target_vendor%g
+s%@target_os@%$target_os%g
+s%@build@%$build%g
+s%@build_alias@%$build_alias%g
+s%@build_cpu@%$build_cpu%g
+s%@build_vendor@%$build_vendor%g
+s%@build_os@%$build_os%g
+s%@CC@%$CC%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_SCRIPT@%$INSTALL_SCRIPT%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@RANLIB@%$RANLIB%g
+s%@CPP@%$CPP%g
+s%@DL_LIBS@%$DL_LIBS%g
+s%@LD_FLAGS@%$LD_FLAGS%g
+s%@MATH_LIBS@%$MATH_LIBS%g
+s%@MAKE_LIB@%$MAKE_LIB%g
+s%@SHLIB_CFLAGS@%$SHLIB_CFLAGS%g
+s%@SHLIB_LD@%$SHLIB_LD%g
+s%@SHLIB_LD_LIBS@%$SHLIB_LD_LIBS%g
+s%@SHLIB_SUFFIX@%$SHLIB_SUFFIX%g
+s%@SHLIB_VERSION@%$SHLIB_VERSION%g
+s%@TCL_BIN_DIR@%$TCL_BIN_DIR%g
+s%@TCL_BUILD_LIB_SPEC@%$TCL_BUILD_LIB_SPEC%g
+s%@TCL_SRC_DIR@%$TCL_SRC_DIR%g
+s%@TCL_VERSION@%$TCL_VERSION%g
+s%@TK_BUILD_INCLUDES@%$TK_BUILD_INCLUDES%g
+s%@TK_BUILD_LIB_SPEC@%$TK_BUILD_LIB_SPEC%g
+s%@TK_CC_SEARCH_FLAGS@%$TK_CC_SEARCH_FLAGS%g
+s%@TK_LD_SEARCH_FLAGS@%$TK_LD_SEARCH_FLAGS%g
+s%@TK_LIB_FULL_PATH@%$TK_LIB_FULL_PATH%g
+s%@TK_LIB_FILE@%$TK_LIB_FILE%g
+s%@TK_LIB_FLAG@%$TK_LIB_FLAG%g
+s%@TK_LIB_SPEC@%$TK_LIB_SPEC%g
+s%@TK_MAJOR_VERSION@%$TK_MAJOR_VERSION%g
+s%@TK_MINOR_VERSION@%$TK_MINOR_VERSION%g
+s%@TK_PATCH_LEVEL@%$TK_PATCH_LEVEL%g
+s%@TK_SHLIB_CFLAGS@%$TK_SHLIB_CFLAGS%g
+s%@TK_SRC_DIR@%$TK_SRC_DIR%g
+s%@TK_VERSION@%$TK_VERSION%g
+s%@XINCLUDES@%$XINCLUDES%g
+s%@XLIBSW@%$XLIBSW%g
+s%@TK_SHARED_BUILD@%$TK_SHARED_BUILD%g
+s%@TCL_SHARED_LIB_SUFFIX@%$TCL_SHARED_LIB_SUFFIX%g
+s%@TCL_UNSHARED_LIB_SUFFIX@%$TCL_UNSHARED_LIB_SUFFIX%g
+s%@TK_SHARED_LIB_FILE@%$TK_SHARED_LIB_FILE%g
+s%@TK_UNSHARED_LIB_FILE@%$TK_UNSHARED_LIB_FILE%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile tkConfig.sh"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+ case "$ac_given_INSTALL" in
+ [/$]*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ esac
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
diff --git a/tk/unix/configure.in b/tk/unix/configure.in
new file mode 100755
index 00000000000..49f3f2d4e6a
--- /dev/null
+++ b/tk/unix/configure.in
@@ -0,0 +1,553 @@
+! /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.
+
+# CYGNUS LOCAL, autoconf 2.5 or higher to get --bindir et al
+AC_PREREQ(2.5)
+# END CYGNUS LOCAL
+
+AC_INIT(../generic/tk.h)
+# SCCS: @(#) configure.in 1.90 97/11/20 12:45:45
+
+# CYGNUS LOCAL tromey - find config.guess/config.sub in our tree
+AC_CONFIG_AUX_DIR($srcdir/../..)
+AC_CANONICAL_SYSTEM
+AC_PROG_CC
+AC_PROG_INSTALL
+# END CYGNUS LOCAL
+
+TK_VERSION=8.0
+TK_MAJOR_VERSION=8
+TK_MINOR_VERSION=0
+TK_PATCH_LEVEL=".4"
+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_HAVE_HEADERS(unistd.h limits.h)
+
+# 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
+
+#--------------------------------------------------------------------
+# 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 ../../tcl/unix; pwd`)
+if test -z "$TCL_BIN_DIR"; then
+ AC_MSG_ERROR(couldn't find Tcl build directory in ../../tcl/unix)
+fi
+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).
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING(stdlib.h)
+AC_HEADER_EGREP(strtol, stdlib.h, tk_ok=yes, tk_ok=no)
+AC_HEADER_EGREP(strtoul, stdlib.h, , tk_ok=no)
+AC_HEADER_EGREP(strtod, stdlib.h, , tk_ok=no)
+if test $tk_ok = no; then
+ AC_DEFINE(NO_STDLIB_H)
+fi
+AC_MSG_RESULT($tk_ok)
+
+#--------------------------------------------------------------------
+# Include sys/select.h if it exists and if it supplies things
+# that appear to be useful and aren't already in sys/types.h.
+# This appears to be true only on the RS/6000 under AIX. Some
+# systems like OSF/1 have a sys/select.h that's of no use, and
+# other systems like SCO UNIX have a sys/select.h that's
+# pernicious. If "fd_set" isn't defined anywhere then set a
+# special flag.
+#--------------------------------------------------------------------
+
+AC_MSG_CHECKING([fd_set and sys/select])
+AC_TRY_COMPILE([#include <sys/types.h>],
+ [fd_set readMask, writeMask;], tk_ok=yes, tk_ok=no)
+if test $tk_ok = no; then
+ AC_HEADER_EGREP(fd_mask, sys/select.h, tk_ok=yes)
+ if test $tk_ok = yes; then
+ AC_DEFINE(HAVE_SYS_SELECT_H)
+ fi
+fi
+AC_MSG_RESULT($tk_ok)
+if test $tk_ok = no; then
+ AC_DEFINE(NO_FD_SET)
+fi
+
+#--------------------------------------------------------------------
+# Check for various typedefs and provide substitutes if
+# they don't exist.
+#--------------------------------------------------------------------
+
+AC_MODE_T
+AC_PID_T
+AC_SIZE_T
+AC_UID_T
+
+#------------------------------------------------------------------------------
+# 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
+# no include files, so double-check its result just to be safe.
+#--------------------------------------------------------------------
+
+AC_PATH_X
+not_really_there=""
+if test "$no_x" = ""; then
+ if test "$x_includes" = ""; then
+ AC_TRY_CPP([#include <X11/XIntrinsic.h>], , not_really_there="yes")
+ else
+ if test ! -r $x_includes/X11/Intrinsic.h; then
+ not_really_there="yes"
+ fi
+ fi
+fi
+if test "$no_x" = "yes" -o "$not_really_there" = "yes"; then
+ AC_MSG_CHECKING(for X11 header files)
+ XINCLUDES="# no special path needed"
+ AC_TRY_CPP([#include <X11/Intrinsic.h>], , XINCLUDES="nope")
+ if test "$XINCLUDES" = nope; then
+ dirs="/usr/unsupported/include /usr/local/include /usr/X386/include /usr/X11R6/include /usr/X11R5/include /usr/include/X11R5 /usr/include/X11R4 /usr/openwin/include /usr/X11/include /usr/sww/include"
+ for i in $dirs ; do
+ if test -r $i/X11/Intrinsic.h; then
+ AC_MSG_RESULT($i)
+ XINCLUDES=" -I$i"
+ break
+ fi
+ done
+ fi
+else
+ if test "$x_includes" != ""; then
+ XINCLUDES=-I$x_includes
+ else
+ XINCLUDES="# no special path needed"
+ fi
+fi
+if test "$XINCLUDES" = nope; then
+ AC_MSG_RESULT(couldn't find any!)
+ XINCLUDES="# no include files found"
+fi
+
+if test "$no_x" = yes; then
+ AC_MSG_CHECKING(for X11 libraries)
+ XLIBSW=nope
+ dirs="/usr/unsupported/lib /usr/local/lib /usr/X386/lib /usr/X11R6/lib /usr/X11R5/lib /usr/lib/X11R5 /usr/lib/X11R4 /usr/openwin/lib /usr/X11/lib /usr/sww/X11/lib"
+ for i in $dirs ; do
+ if test -r $i/libX11.a -o -r $i/libX11.so -o -r $i/libX11.sl; then
+ AC_MSG_RESULT($i)
+ XLIBSW="-L$i -lX11"
+ x_libraries="$i"
+ break
+ fi
+ done
+else
+ if test "$x_libraries" = ""; then
+ XLIBSW=-lX11
+ else
+ XLIBSW="-L$x_libraries -lX11"
+ fi
+fi
+if test "$XLIBSW" = nope ; then
+ AC_CHECK_LIB(Xwindow, XCreateWindow, XLIBSW=-lXwindow)
+fi
+if test "$XLIBSW" = nope ; then
+ AC_MSG_RESULT(couldn't find any! Using -lX11.)
+ XLIBSW=-lX11
+fi
+
+#--------------------------------------------------------------------
+# Various manipulations on the search path used at runtime to
+# find shared libraries:
+# 1. If the X library binaries are in a non-standard directory,
+# add the X library location into that search path.
+# 2. On systems such as AIX and Ultrix that use "-L" as the
+# search path option, colons cannot be used to separate
+# directories from each other. Change colons to " -L".
+# 3. Create two sets of search flags, one for use in cc lines
+# and the other for when the linker is invoked directly. In
+# the second case, '-Wl,' must be stripped off and commas must
+# be replaced by spaces.
+#--------------------------------------------------------------------
+
+if test "x${x_libraries}" != "x"; then
+ LIB_RUNTIME_DIR="${LIB_RUNTIME_DIR}:${x_libraries}"
+fi
+if test "${TCL_LD_SEARCH_FLAGS}" = '-L${LIB_RUNTIME_DIR}'; then
+ LIB_RUNTIME_DIR=`echo ${LIB_RUNTIME_DIR} |sed -e 's/:/ -L/g'`
+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"`
+
+# CYGNUS LOCAL: Don't hack TK_LD_SEARCH_FLAGS if SHLIB_LD is gcc.
+case "${SHLIB_LD}" in
+ *gcc*) TK_LD_SEARCH_FLAGS="${TK_CC_SEARCH_FLAGS}" ;;
+esac
+
+#
+# CYGNUS LOCAL: statically link on Solaris, HPUX & SunOS so that
+# we don't have problems with people not having libraries
+# installed or not having LD_LIBRARY_PATH set.
+#
+
+ case "$host" in
+#
+# gdb linked statically w/ Solaris iff GCC and GNU ld are used,
+# otherwise dynamic
+#
+ sparc-sun-solaris2*)
+ sol_xlibsw=
+ if test "x$GCC" = "xyes" ; then
+ # This is probably the simplest way to test for GNU ld.
+ # It only works with relatively recent versions of GNU
+ # ld.
+ gld_text=`$CC -Wl,--version 2>&1 | sed 1q`
+ case "$gld_text" in
+ GNU* | *BFD*)
+ # sol2.* has libX*.so files in /usr/lib,
+ # but not libX*.a files, so we need to force a
+ # -L/usr/openwin/lib option, sometimes.
+ # FIXME: this won't work right if someone has
+ # their own X libraries in say /usr/local/lib.
+ case "$XLIBSW" in
+ *-L*) ;;
+ *) if test ! -f /usr/lib/libXt.a; then
+ XLIBSW="-L/usr/openwin/lib $XLIBSW"
+ fi
+ ;;
+ esac
+
+ # Why do we link against libX11 twice? Because the
+ # Openwin X11 and Xext libraries are seriously broken.
+ sol_xlibsw="-Wl,-Bstatic $XLIBSW -lXext -lX11 -Wl,-Bdynamic"
+ ;;
+ esac
+ fi
+ if test -z "$sol_xlibsw"; then
+ if test "x$x_libraries" != "x"; then
+ XLIBSW="$XLIBSW -R$x_libraries"
+ fi
+ else
+ XLIBSW=$sol_xlibsw
+ suppress_enable_shared=yes
+ fi
+ ;;
+#
+# gdb linked statically w/ SunOS or HPUX, but not hpux11 wide
+#
+ hppa*w-hp-hpux*)
+ ;;
+
+ m68k-hp-hpux*|hppa*-hp-hpux*|sparc-sun-sunos*)
+ if test "x$x_libraries" != "x" ;
+ then
+ XLIBSW="$x_libraries/libX11.a"
+ else
+ XLIBSW="/usr/lib/libX11.a"
+ fi
+ suppress_enable_shared=yes
+ ;;
+#
+# default is to link dynamically
+#
+ *)
+ ;;
+ esac
+#
+# END CYGNUS LOCAL
+
+#--------------------------------------------------------------------
+# 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
+# "gethostbyname" to check for -lnsl.
+# 2. Use each function name only once: can't redo a check because
+# autoconf caches the results of the last check and won't redo it.
+# 3. Use -lnsl and -lsocket only if they supply procedures that
+# aren't already present in the normal libraries. This is because
+# IRIX 5.2 has libraries, but they aren't needed and they're
+# bogus: they goof up name resolution if used.
+# 4. On some SVR4 systems, can't use -lsocket without -lnsl too.
+# To get around this problem, check for both libraries together
+# if -lsocket doesn't work by itself.
+#--------------------------------------------------------------------
+
+AC_CHECK_LIB(Xbsd, main, [LIBS="$LIBS -lXbsd"])
+
+# CYGNUS LOCAL: Store any socket library(ies) in the cache, and don't
+# mess up the cache values of the functions we check for.
+AC_CACHE_CHECK([for socket libraries], tcl_cv_lib_sockets,
+ [tcl_cv_lib_sockets=
+ tk_checkBoth=0
+ unset ac_cv_func_connect
+ AC_CHECK_FUNC(connect, tk_checkSocket=0, tk_checkSocket=1)
+ if test "$tk_checkSocket" = 1; then
+ unset ac_cv_func_connect
+ AC_CHECK_LIB(socket, main, tcl_cv_lib_sockets="-lsocket",
+ tk_checkBoth=1)
+ fi
+ if test "$tk_checkBoth" = 1; then
+ tk_oldLibs=$LIBS
+ LIBS="$LIBS -lsocket -lnsl"
+ unset ac_cv_func_accept
+ AC_CHECK_FUNC(accept,
+ [tcl_checkNsl=0
+ tcl_cv_lib_sockets="-lsocket -lnsl"])
+ unset ac_cv_func_accept
+ LIBS=$tk_oldLibs
+ fi
+ unset ac_cv_func_gethostbyname
+ tk_oldLibs=$LIBS
+ LIBS="$LIBS $tk_cv_lib_sockets"
+ AC_CHECK_FUNC(gethostbyname, ,
+ [AC_CHECK_LIB(nsl, main,
+ [tcl_cv_lib_sockets="$tcl_cv_lib_sockets -lnsl"])])
+ unset ac_cv_func_gethostbyname
+ LIBS=$tcl_oldLIBS
+])
+test -z "$tcl_cv_lib_sockets" || LIBS="$LIBS $tcl_cv_lib_sockets"
+
+#--------------------------------------------------------------------
+# 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.
+#
+# Note: can't use ac_check_lib macro (at least, not in Autoconf 2.1)
+# because it can't deal with the "-" in the library name.
+#--------------------------------------------------------------------
+
+if test -d /usr/include/mit ; then
+ AC_MSG_CHECKING([MIT X libraries])
+ tk_oldCFlags=$CFLAGS
+ CFLAGS="$CFLAGS -I/usr/include/mit"
+ tk_oldLibs=$LIBS
+ LIBS="$LIBS -lX11-mit"
+ AC_TRY_LINK([
+ #include <X11/Xlib.h>
+ ], [
+ XOpenDisplay(0);
+ ], [
+ AC_MSG_RESULT(yes)
+ XLIBSW="-lX11-mit"
+ XINCLUDES="-I/usr/include/mit"
+ ], AC_MSG_RESULT(no))
+ CFLAGS=$tk_oldCFlags
+ LIBS=$tk_oldLibs
+fi
+
+#--------------------------------------------------------------------
+# On a few very rare systems, all of the libm.a stuff is
+# already in libc.a. Set compiler flags accordingly.
+# Also, Linux requires the "ieee" library for math to
+# 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
+
+#--------------------------------------------------------------------
+# Under Solaris 2.4, strtod returns the wrong value for the
+# terminating character under some conditions. Check for this
+# and if the problem exists use a substitute procedure
+# "fixstrtod" (provided by Tcl) that corrects the error.
+#--------------------------------------------------------------------
+
+AC_CHECK_FUNC(strtod, tk_strtod=1, tk_strtod=0)
+if test "$tk_strtod" = 1; then
+ AC_MSG_CHECKING([for Solaris 2.4 strtod bug])
+ AC_TRY_RUN([
+ extern double strtod();
+ int main()
+ {
+ char *string = "NaN";
+ char *term;
+ strtod(string, &term);
+ if ((term != string) && (term[-1] == 0)) {
+ exit(1);
+ }
+ exit(0);
+ }], tk_ok=1, tk_ok=0, tk_ok=0)
+ if test "$tk_ok" = 1; then
+ AC_MSG_RESULT(ok)
+ else
+ AC_MSG_RESULT(buggy)
+ AC_DEFINE(strtod, fixstrtod)
+ fi
+fi
+
+#--------------------------------------------------------------------
+# 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])
+
+# CYGNUS LOCAL: on machines where static linking of libX11 is important,
+# it is also important to build a static libtk.
+if test -n "$suppress_enable_shared"; then
+ ok=no
+fi
+# END CYGNUS LOCAL
+
+TK_SHARED_LIB_FILE=
+TK_UNSHARED_LIB_FILE=
+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}"
+ TK_SHARED_LIB_FILE="$TK_LIB_FILE"
+ 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}"
+ TK_UNSHARED_LIB_FILE="$TK_LIB_FILE"
+ MAKE_LIB="ar cr ${TK_LIB_FILE} \${OBJS}"
+fi
+
+dnl CYGNUS LOCAL
+TK_BUILD_INCLUDES="-I`cd $srcdir/../generic; pwd`"
+dnl END CYGNUS LOCAL
+
+# 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_FLAG="-ltk${VERSION}\${TK_DBGX}"
+else
+ TK_BUILD_LIB_SPEC="-L`pwd` -ltk`echo ${VERSION} | tr -d .`"
+ TK_LIB_FLAG="-ltk`echo ${VERSION} | tr -d .`\${TK_DBGX}"
+fi
+
+TK_LIB_FULL_PATH="`pwd`/${TK_LIB_FILE}"
+
+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)
+dnl CYGNUS LOCAL
+AC_SUBST(TK_BUILD_INCLUDES)
+dnl END CYGNUS LOCAL
+AC_SUBST(TK_BUILD_LIB_SPEC)
+AC_SUBST(TK_CC_SEARCH_FLAGS)
+AC_SUBST(TK_LD_SEARCH_FLAGS)
+AC_SUBST(TK_LIB_FULL_PATH)
+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)
+# CYGNUS LOCAL
+# Need more variables to keep shared/static linking separate.
+AC_SUBST(TCL_SHARED_LIB_SUFFIX)
+AC_SUBST(TCL_UNSHARED_LIB_SUFFIX)
+AC_SUBST(TK_SHARED_LIB_FILE)
+AC_SUBST(TK_UNSHARED_LIB_FILE)
+# END CYGNUS LOCAL
+
+AC_OUTPUT(Makefile tkConfig.sh)
diff --git a/tk/unix/install-sh b/tk/unix/install-sh
new file mode 100755
index 00000000000..32efb2cc882
--- /dev/null
+++ b/tk/unix/install-sh
@@ -0,0 +1,128 @@
+#!/bin/sh
+#
+# install - install a program, script, or datafile
+# This comes from X11R5 (mit/util/scripts/install.sh).
+#
+# Copyright 1991 by the Massachusetts Institute of Technology
+#
+# Permission to use, copy, modify, distribute, and sell this software and its
+# documentation for any purpose is hereby granted without fee, provided that
+# the above copyright notice appear in all copies and that both that
+# copyright notice and this permission notice appear in supporting
+# documentation, and that the name of M.I.T. not be used in advertising or
+# publicity pertaining to distribution of the software without specific,
+# written prior permission. M.I.T. makes no representations about the
+# suitability of this software for any purpose. It is provided "as is"
+# without express or implied warranty.
+#
+# This script is compatible with the BSD install script, but was written
+# from scratch.
+#
+
+
+# set DOITPROG to echo to test this script
+
+# Don't use :- since 4.3BSD and earlier shells don't like it.
+doit="${DOITPROG-}"
+
+
+# put in absolute paths if you don't have them in your path; or use env. vars.
+
+mvprog="${MVPROG-mv}"
+cpprog="${CPPROG-cp}"
+chmodprog="${CHMODPROG-chmod}"
+chownprog="${CHOWNPROG-chown}"
+chgrpprog="${CHGRPPROG-chgrp}"
+stripprog="${STRIPPROG-strip}"
+rmprog="${RMPROG-rm}"
+
+instcmd="$mvprog"
+chmodcmd=""
+chowncmd=""
+chgrpcmd=""
+stripcmd=""
+rmcmd="$rmprog -f"
+mvcmd="$mvprog"
+src=""
+dst=""
+
+while [ x"$1" != x ]; do
+ case $1 in
+ -c) instcmd="$cpprog"
+ shift
+ continue;;
+
+ -m) chmodcmd="$chmodprog $2"
+ shift
+ shift
+ continue;;
+
+ -o) chowncmd="$chownprog $2"
+ shift
+ shift
+ continue;;
+
+ -g) chgrpcmd="$chgrpprog $2"
+ shift
+ shift
+ continue;;
+
+ -s) stripcmd="$stripprog"
+ shift
+ continue;;
+
+ *) if [ x"$src" = x ]
+ then
+ src=$1
+ else
+ dst=$1
+ fi
+ shift
+ continue;;
+ esac
+done
+
+if [ x"$src" = x ]
+then
+ echo "install: no input file specified"
+ exit 1
+fi
+
+if [ x"$dst" = x ]
+then
+ echo "install: no destination specified"
+ exit 1
+fi
+
+
+# If destination is a directory, append the input filename; if your system
+# does not like double slashes in filenames, you may need to add some logic
+
+if [ -d $dst ]
+then
+ dst="$dst"/`basename $src`
+fi
+
+# Make a temp file name in the proper directory.
+
+dstdir=`dirname $dst`
+dsttmp=$dstdir/#inst.$$#
+
+# Move or copy the file name to the temp name
+
+$doit $instcmd $src $dsttmp
+
+# and set any options; do chmod last to preserve setuid bits
+
+if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; fi
+if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; fi
+if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; fi
+if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; fi
+
+# Now rename the file to the real destination.
+
+$doit $rmcmd $dst
+$doit $mvcmd $dsttmp $dst
+
+
+exit 0
diff --git a/tk/unix/license.terms b/tk/unix/license.terms
new file mode 100644
index 00000000000..03ca6fcb319
--- /dev/null
+++ b/tk/unix/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., and other parties. The following
+terms apply to all files associated with the software unless explicitly
+disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
diff --git a/tk/unix/mkLinks b/tk/unix/mkLinks
new file mode 100755
index 00000000000..0bbeb5d05b3
--- /dev/null
+++ b/tk/unix/mkLinks
@@ -0,0 +1,878 @@
+#!/bin/sh
+# This script is invoked when installing manual entries. It generates
+# additional links to manual entries, corresponding to the procedure
+# and command names described by the manual entry. For example, the
+# Tcl manual entry Hash.3 describes procedures Tcl_InitHashTable,
+# Tcl_CreateHashEntry, and many more. This script will make hard
+# links so that Tcl_InitHashTable.3, Tcl_CreateHashEntry.3, and so
+# on all refer to Hash.3 in the installed directory.
+#
+# Because of the length of command and procedure names, this mechanism
+# only works on machines that support file names longer than 14 characters.
+# This script checks to see if long file names are supported, and it
+# doesn't make any links if they are not.
+#
+# The script takes one argument, which is the name of the directory
+# where the manual entries have been installed.
+
+if test $# != 1; then
+ echo "Usage: mkLinks dir"
+ exit 1
+fi
+
+cd $1
+echo foo > xyzzyTestingAVeryLongFileName.foo
+x=`echo xyzzyTe*`
+rm xyzzyTe*
+if test "$x" != "xyzzyTestingAVeryLongFileName.foo"; then
+ exit
+fi
+if test -r 3DBorder.3; then
+ rm -f Tk_3DBorderColor.3
+ cp 3DBorder.3 Tk_3DBorderColor.3
+fi
+if test -r 3DBorder.3; then
+ rm -f Tk_3DBorderGC.3
+ cp 3DBorder.3 Tk_3DBorderGC.3
+fi
+if test -r 3DBorder.3; then
+ rm -f Tk_3DHorizontalBevel.3
+ cp 3DBorder.3 Tk_3DHorizontalBevel.3
+fi
+if test -r 3DBorder.3; then
+ rm -f Tk_3DVerticalBevel.3
+ cp 3DBorder.3 Tk_3DVerticalBevel.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_Attributes.3
+ cp WindowId.3 Tk_Attributes.3
+fi
+if test -r BindTable.3; then
+ rm -f Tk_BindEvent.3
+ cp BindTable.3 Tk_BindEvent.3
+fi
+if test -r CanvTkwin.3; then
+ rm -f Tk_CanvasDrawableCoords.3
+ cp CanvTkwin.3 Tk_CanvasDrawableCoords.3
+fi
+if test -r CanvTkwin.3; then
+ rm -f Tk_CanvasEventuallyRedraw.3
+ cp CanvTkwin.3 Tk_CanvasEventuallyRedraw.3
+fi
+if test -r CanvTkwin.3; then
+ rm -f Tk_CanvasGetCoord.3
+ cp CanvTkwin.3 Tk_CanvasGetCoord.3
+fi
+if test -r CanvPsY.3; then
+ rm -f Tk_CanvasPsBitmap.3
+ cp CanvPsY.3 Tk_CanvasPsBitmap.3
+fi
+if test -r CanvPsY.3; then
+ rm -f Tk_CanvasPsColor.3
+ cp CanvPsY.3 Tk_CanvasPsColor.3
+fi
+if test -r CanvPsY.3; then
+ rm -f Tk_CanvasPsFont.3
+ cp CanvPsY.3 Tk_CanvasPsFont.3
+fi
+if test -r CanvPsY.3; then
+ rm -f Tk_CanvasPsPath.3
+ cp CanvPsY.3 Tk_CanvasPsPath.3
+fi
+if test -r CanvPsY.3; then
+ rm -f Tk_CanvasPsStipple.3
+ cp CanvPsY.3 Tk_CanvasPsStipple.3
+fi
+if test -r CanvPsY.3; then
+ rm -f Tk_CanvasPsY.3
+ cp CanvPsY.3 Tk_CanvasPsY.3
+fi
+if test -r CanvTkwin.3; then
+ rm -f Tk_CanvasSetStippleOrigin.3
+ cp CanvTkwin.3 Tk_CanvasSetStippleOrigin.3
+fi
+if test -r CanvTkwin.3; then
+ rm -f Tk_CanvasTagsOption.3
+ cp CanvTkwin.3 Tk_CanvasTagsOption.3
+fi
+if test -r CanvTxtInfo.3; then
+ rm -f Tk_CanvasTextInfo.3
+ cp CanvTxtInfo.3 Tk_CanvasTextInfo.3
+fi
+if test -r CanvTkwin.3; then
+ rm -f Tk_CanvasTkwin.3
+ cp CanvTkwin.3 Tk_CanvasTkwin.3
+fi
+if test -r CanvTkwin.3; then
+ rm -f Tk_CanvasWindowCoords.3
+ cp CanvTkwin.3 Tk_CanvasWindowCoords.3
+fi
+if test -r ConfigWind.3; then
+ rm -f Tk_ChangeWindowAttributes.3
+ cp ConfigWind.3 Tk_ChangeWindowAttributes.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_Changes.3
+ cp WindowId.3 Tk_Changes.3
+fi
+if test -r TextLayout.3; then
+ rm -f Tk_CharBbox.3
+ cp TextLayout.3 Tk_CharBbox.3
+fi
+if test -r SetClass.3; then
+ rm -f Tk_Class.3
+ cp SetClass.3 Tk_Class.3
+fi
+if test -r ClrSelect.3; then
+ rm -f Tk_ClearSelection.3
+ cp ClrSelect.3 Tk_ClearSelection.3
+fi
+if test -r Clipboard.3; then
+ rm -f Tk_ClipboardAppend.3
+ cp Clipboard.3 Tk_ClipboardAppend.3
+fi
+if test -r Clipboard.3; then
+ rm -f Tk_ClipboardClear.3
+ cp Clipboard.3 Tk_ClipboardClear.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_Colormap.3
+ cp WindowId.3 Tk_Colormap.3
+fi
+if test -r TextLayout.3; then
+ rm -f Tk_ComputeTextLayout.3
+ cp TextLayout.3 Tk_ComputeTextLayout.3
+fi
+if test -r ConfigWidg.3; then
+ rm -f Tk_ConfigureInfo.3
+ cp ConfigWidg.3 Tk_ConfigureInfo.3
+fi
+if test -r ConfigWidg.3; then
+ rm -f Tk_ConfigureValue.3
+ cp ConfigWidg.3 Tk_ConfigureValue.3
+fi
+if test -r ConfigWidg.3; then
+ rm -f Tk_ConfigureWidget.3
+ cp ConfigWidg.3 Tk_ConfigureWidget.3
+fi
+if test -r ConfigWind.3; then
+ rm -f Tk_ConfigureWindow.3
+ cp ConfigWind.3 Tk_ConfigureWindow.3
+fi
+if test -r CoordToWin.3; then
+ rm -f Tk_CoordsToWindow.3
+ cp CoordToWin.3 Tk_CoordsToWindow.3
+fi
+if test -r BindTable.3; then
+ rm -f Tk_CreateBinding.3
+ cp BindTable.3 Tk_CreateBinding.3
+fi
+if test -r BindTable.3; then
+ rm -f Tk_CreateBindingTable.3
+ cp BindTable.3 Tk_CreateBindingTable.3
+fi
+if test -r CrtErrHdlr.3; then
+ rm -f Tk_CreateErrorHandler.3
+ cp CrtErrHdlr.3 Tk_CreateErrorHandler.3
+fi
+if test -r EventHndlr.3; then
+ rm -f Tk_CreateEventHandler.3
+ cp EventHndlr.3 Tk_CreateEventHandler.3
+fi
+if test -r CrtGenHdlr.3; then
+ rm -f Tk_CreateGenericHandler.3
+ cp CrtGenHdlr.3 Tk_CreateGenericHandler.3
+fi
+if test -r CrtImgType.3; then
+ rm -f Tk_CreateImageType.3
+ cp CrtImgType.3 Tk_CreateImageType.3
+fi
+if test -r CrtItemType.3; then
+ rm -f Tk_CreateItemType.3
+ cp CrtItemType.3 Tk_CreateItemType.3
+fi
+if test -r CrtPhImgFmt.3; then
+ rm -f Tk_CreatePhotoImageFormat.3
+ cp CrtPhImgFmt.3 Tk_CreatePhotoImageFormat.3
+fi
+if test -r CrtSelHdlr.3; then
+ rm -f Tk_CreateSelHandler.3
+ cp CrtSelHdlr.3 Tk_CreateSelHandler.3
+fi
+if test -r CrtWindow.3; then
+ rm -f Tk_CreateWindow.3
+ cp CrtWindow.3 Tk_CreateWindow.3
+fi
+if test -r CrtWindow.3; then
+ rm -f Tk_CreateWindowFromPath.3
+ cp CrtWindow.3 Tk_CreateWindowFromPath.3
+fi
+if test -r GetBitmap.3; then
+ rm -f Tk_DefineBitmap.3
+ cp GetBitmap.3 Tk_DefineBitmap.3
+fi
+if test -r ConfigWind.3; then
+ rm -f Tk_DefineCursor.3
+ cp ConfigWind.3 Tk_DefineCursor.3
+fi
+if test -r BindTable.3; then
+ rm -f Tk_DeleteAllBindings.3
+ cp BindTable.3 Tk_DeleteAllBindings.3
+fi
+if test -r BindTable.3; then
+ rm -f Tk_DeleteBinding.3
+ cp BindTable.3 Tk_DeleteBinding.3
+fi
+if test -r BindTable.3; then
+ rm -f Tk_DeleteBindingTable.3
+ cp BindTable.3 Tk_DeleteBindingTable.3
+fi
+if test -r CrtErrHdlr.3; then
+ rm -f Tk_DeleteErrorHandler.3
+ cp CrtErrHdlr.3 Tk_DeleteErrorHandler.3
+fi
+if test -r EventHndlr.3; then
+ rm -f Tk_DeleteEventHandler.3
+ cp EventHndlr.3 Tk_DeleteEventHandler.3
+fi
+if test -r CrtGenHdlr.3; then
+ rm -f Tk_DeleteGenericHandler.3
+ cp CrtGenHdlr.3 Tk_DeleteGenericHandler.3
+fi
+if test -r DeleteImg.3; then
+ rm -f Tk_DeleteImage.3
+ cp DeleteImg.3 Tk_DeleteImage.3
+fi
+if test -r CrtSelHdlr.3; then
+ rm -f Tk_DeleteSelHandler.3
+ cp CrtSelHdlr.3 Tk_DeleteSelHandler.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_Depth.3
+ cp WindowId.3 Tk_Depth.3
+fi
+if test -r CrtWindow.3; then
+ rm -f Tk_DestroyWindow.3
+ cp CrtWindow.3 Tk_DestroyWindow.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_Display.3
+ cp WindowId.3 Tk_Display.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_DisplayName.3
+ cp WindowId.3 Tk_DisplayName.3
+fi
+if test -r TextLayout.3; then
+ rm -f Tk_DistanceToTextLayout.3
+ cp TextLayout.3 Tk_DistanceToTextLayout.3
+fi
+if test -r 3DBorder.3; then
+ rm -f Tk_Draw3DPolygon.3
+ cp 3DBorder.3 Tk_Draw3DPolygon.3
+fi
+if test -r 3DBorder.3; then
+ rm -f Tk_Draw3DRectangle.3
+ cp 3DBorder.3 Tk_Draw3DRectangle.3
+fi
+if test -r MeasureChar.3; then
+ rm -f Tk_DrawChars.3
+ cp MeasureChar.3 Tk_DrawChars.3
+fi
+if test -r DrawFocHlt.3; then
+ rm -f Tk_DrawFocusHighlight.3
+ cp DrawFocHlt.3 Tk_DrawFocusHighlight.3
+fi
+if test -r TextLayout.3; then
+ rm -f Tk_DrawTextLayout.3
+ cp TextLayout.3 Tk_DrawTextLayout.3
+fi
+if test -r 3DBorder.3; then
+ rm -f Tk_Fill3DPolygon.3
+ cp 3DBorder.3 Tk_Fill3DPolygon.3
+fi
+if test -r 3DBorder.3; then
+ rm -f Tk_Fill3DRectangle.3
+ cp 3DBorder.3 Tk_Fill3DRectangle.3
+fi
+if test -r FindPhoto.3; then
+ rm -f Tk_FindPhoto.3
+ cp FindPhoto.3 Tk_FindPhoto.3
+fi
+if test -r FontId.3; then
+ rm -f Tk_FontId.3
+ cp FontId.3 Tk_FontId.3
+fi
+if test -r FontId.3; then
+ rm -f Tk_FontMetrics.3
+ cp FontId.3 Tk_FontMetrics.3
+fi
+if test -r 3DBorder.3; then
+ rm -f Tk_Free3DBorder.3
+ cp 3DBorder.3 Tk_Free3DBorder.3
+fi
+if test -r GetBitmap.3; then
+ rm -f Tk_FreeBitmap.3
+ cp GetBitmap.3 Tk_FreeBitmap.3
+fi
+if test -r GetColor.3; then
+ rm -f Tk_FreeColor.3
+ cp GetColor.3 Tk_FreeColor.3
+fi
+if test -r GetClrmap.3; then
+ rm -f Tk_FreeColormap.3
+ cp GetClrmap.3 Tk_FreeColormap.3
+fi
+if test -r GetCursor.3; then
+ rm -f Tk_FreeCursor.3
+ cp GetCursor.3 Tk_FreeCursor.3
+fi
+if test -r GetFont.3; then
+ rm -f Tk_FreeFont.3
+ cp GetFont.3 Tk_FreeFont.3
+fi
+if test -r GetGC.3; then
+ rm -f Tk_FreeGC.3
+ cp GetGC.3 Tk_FreeGC.3
+fi
+if test -r GetImage.3; then
+ rm -f Tk_FreeImage.3
+ cp GetImage.3 Tk_FreeImage.3
+fi
+if test -r ConfigWidg.3; then
+ rm -f Tk_FreeOptions.3
+ cp ConfigWidg.3 Tk_FreeOptions.3
+fi
+if test -r GetPixmap.3; then
+ rm -f Tk_FreePixmap.3
+ cp GetPixmap.3 Tk_FreePixmap.3
+fi
+if test -r TextLayout.3; then
+ rm -f Tk_FreeTextLayout.3
+ cp TextLayout.3 Tk_FreeTextLayout.3
+fi
+if test -r FreeXId.3; then
+ rm -f Tk_FreeXId.3
+ cp FreeXId.3 Tk_FreeXId.3
+fi
+if test -r GeomReq.3; then
+ rm -f Tk_GeometryRequest.3
+ cp GeomReq.3 Tk_GeometryRequest.3
+fi
+if test -r 3DBorder.3; then
+ rm -f Tk_Get3DBorder.3
+ cp 3DBorder.3 Tk_Get3DBorder.3
+fi
+if test -r BindTable.3; then
+ rm -f Tk_GetAllBindings.3
+ cp BindTable.3 Tk_GetAllBindings.3
+fi
+if test -r GetAnchor.3; then
+ rm -f Tk_GetAnchor.3
+ cp GetAnchor.3 Tk_GetAnchor.3
+fi
+if test -r InternAtom.3; then
+ rm -f Tk_GetAtomName.3
+ cp InternAtom.3 Tk_GetAtomName.3
+fi
+if test -r BindTable.3; then
+ rm -f Tk_GetBinding.3
+ cp BindTable.3 Tk_GetBinding.3
+fi
+if test -r GetBitmap.3; then
+ rm -f Tk_GetBitmap.3
+ cp GetBitmap.3 Tk_GetBitmap.3
+fi
+if test -r GetBitmap.3; then
+ rm -f Tk_GetBitmapFromData.3
+ cp GetBitmap.3 Tk_GetBitmapFromData.3
+fi
+if test -r GetCapStyl.3; then
+ rm -f Tk_GetCapStyle.3
+ cp GetCapStyl.3 Tk_GetCapStyle.3
+fi
+if test -r GetColor.3; then
+ rm -f Tk_GetColor.3
+ cp GetColor.3 Tk_GetColor.3
+fi
+if test -r GetColor.3; then
+ rm -f Tk_GetColorByValue.3
+ cp GetColor.3 Tk_GetColorByValue.3
+fi
+if test -r GetClrmap.3; then
+ rm -f Tk_GetColormap.3
+ cp GetClrmap.3 Tk_GetColormap.3
+fi
+if test -r GetCursor.3; then
+ rm -f Tk_GetCursor.3
+ cp GetCursor.3 Tk_GetCursor.3
+fi
+if test -r GetCursor.3; then
+ rm -f Tk_GetCursorFromData.3
+ cp GetCursor.3 Tk_GetCursorFromData.3
+fi
+if test -r GetFont.3; then
+ rm -f Tk_GetFont.3
+ cp GetFont.3 Tk_GetFont.3
+fi
+if test -r GetGC.3; then
+ rm -f Tk_GetGC.3
+ cp GetGC.3 Tk_GetGC.3
+fi
+if test -r GetImage.3; then
+ rm -f Tk_GetImage.3
+ cp GetImage.3 Tk_GetImage.3
+fi
+if test -r CrtImgType.3; then
+ rm -f Tk_GetImageMasterData.3
+ cp CrtImgType.3 Tk_GetImageMasterData.3
+fi
+if test -r CrtItemType.3; then
+ rm -f Tk_GetItemTypes.3
+ cp CrtItemType.3 Tk_GetItemTypes.3
+fi
+if test -r GetJoinStl.3; then
+ rm -f Tk_GetJoinStyle.3
+ cp GetJoinStl.3 Tk_GetJoinStyle.3
+fi
+if test -r GetJustify.3; then
+ rm -f Tk_GetJustify.3
+ cp GetJustify.3 Tk_GetJustify.3
+fi
+if test -r GetOption.3; then
+ rm -f Tk_GetOption.3
+ cp GetOption.3 Tk_GetOption.3
+fi
+if test -r GetPixels.3; then
+ rm -f Tk_GetPixels.3
+ cp GetPixels.3 Tk_GetPixels.3
+fi
+if test -r GetPixmap.3; then
+ rm -f Tk_GetPixmap.3
+ cp GetPixmap.3 Tk_GetPixmap.3
+fi
+if test -r GetRelief.3; then
+ rm -f Tk_GetRelief.3
+ cp GetRelief.3 Tk_GetRelief.3
+fi
+if test -r GetRootCrd.3; then
+ rm -f Tk_GetRootCoords.3
+ cp GetRootCrd.3 Tk_GetRootCoords.3
+fi
+if test -r GetPixels.3; then
+ rm -f Tk_GetScreenMM.3
+ cp GetPixels.3 Tk_GetScreenMM.3
+fi
+if test -r GetScroll.3; then
+ rm -f Tk_GetScrollInfo.3
+ cp GetScroll.3 Tk_GetScrollInfo.3
+fi
+if test -r GetSelect.3; then
+ rm -f Tk_GetSelection.3
+ cp GetSelect.3 Tk_GetSelection.3
+fi
+if test -r GetUid.3; then
+ rm -f Tk_GetUid.3
+ cp GetUid.3 Tk_GetUid.3
+fi
+if test -r GetVRoot.3; then
+ rm -f Tk_GetVRootGeometry.3
+ cp GetVRoot.3 Tk_GetVRootGeometry.3
+fi
+if test -r GetVisual.3; then
+ rm -f Tk_GetVisual.3
+ cp GetVisual.3 Tk_GetVisual.3
+fi
+if test -r HandleEvent.3; then
+ rm -f Tk_HandleEvent.3
+ cp HandleEvent.3 Tk_HandleEvent.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_Height.3
+ cp WindowId.3 Tk_Height.3
+fi
+if test -r IdToWindow.3; then
+ rm -f Tk_IdToWindow.3
+ cp IdToWindow.3 Tk_IdToWindow.3
+fi
+if test -r ImgChanged.3; then
+ rm -f Tk_ImageChanged.3
+ cp ImgChanged.3 Tk_ImageChanged.3
+fi
+if test -r InternAtom.3; then
+ rm -f Tk_InternAtom.3
+ cp InternAtom.3 Tk_InternAtom.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_InternalBorderWidth.3
+ cp WindowId.3 Tk_InternalBorderWidth.3
+fi
+if test -r TextLayout.3; then
+ rm -f Tk_IntersectTextLayout.3
+ cp TextLayout.3 Tk_IntersectTextLayout.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_IsMapped.3
+ cp WindowId.3 Tk_IsMapped.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_IsTopLevel.3
+ cp WindowId.3 Tk_IsTopLevel.3
+fi
+if test -r MainLoop.3; then
+ rm -f Tk_MainLoop.3
+ cp MainLoop.3 Tk_MainLoop.3
+fi
+if test -r MainWin.3; then
+ rm -f Tk_MainWindow.3
+ cp MainWin.3 Tk_MainWindow.3
+fi
+if test -r MaintGeom.3; then
+ rm -f Tk_MaintainGeometry.3
+ cp MaintGeom.3 Tk_MaintainGeometry.3
+fi
+if test -r CrtWindow.3; then
+ rm -f Tk_MakeWindowExist.3
+ cp CrtWindow.3 Tk_MakeWindowExist.3
+fi
+if test -r ManageGeom.3; then
+ rm -f Tk_ManageGeometry.3
+ cp ManageGeom.3 Tk_ManageGeometry.3
+fi
+if test -r MapWindow.3; then
+ rm -f Tk_MapWindow.3
+ cp MapWindow.3 Tk_MapWindow.3
+fi
+if test -r MeasureChar.3; then
+ rm -f Tk_MeasureChars.3
+ cp MeasureChar.3 Tk_MeasureChars.3
+fi
+if test -r ConfigWind.3; then
+ rm -f Tk_MoveResizeWindow.3
+ cp ConfigWind.3 Tk_MoveResizeWindow.3
+fi
+if test -r MoveToplev.3; then
+ rm -f Tk_MoveToplevelWindow.3
+ cp MoveToplev.3 Tk_MoveToplevelWindow.3
+fi
+if test -r ConfigWind.3; then
+ rm -f Tk_MoveWindow.3
+ cp ConfigWind.3 Tk_MoveWindow.3
+fi
+if test -r Name.3; then
+ rm -f Tk_Name.3
+ cp Name.3 Tk_Name.3
+fi
+if test -r 3DBorder.3; then
+ rm -f Tk_NameOf3DBorder.3
+ cp 3DBorder.3 Tk_NameOf3DBorder.3
+fi
+if test -r GetAnchor.3; then
+ rm -f Tk_NameOfAnchor.3
+ cp GetAnchor.3 Tk_NameOfAnchor.3
+fi
+if test -r GetBitmap.3; then
+ rm -f Tk_NameOfBitmap.3
+ cp GetBitmap.3 Tk_NameOfBitmap.3
+fi
+if test -r GetCapStyl.3; then
+ rm -f Tk_NameOfCapStyle.3
+ cp GetCapStyl.3 Tk_NameOfCapStyle.3
+fi
+if test -r GetColor.3; then
+ rm -f Tk_NameOfColor.3
+ cp GetColor.3 Tk_NameOfColor.3
+fi
+if test -r GetCursor.3; then
+ rm -f Tk_NameOfCursor.3
+ cp GetCursor.3 Tk_NameOfCursor.3
+fi
+if test -r GetFont.3; then
+ rm -f Tk_NameOfFont.3
+ cp GetFont.3 Tk_NameOfFont.3
+fi
+if test -r NameOfImg.3; then
+ rm -f Tk_NameOfImage.3
+ cp NameOfImg.3 Tk_NameOfImage.3
+fi
+if test -r GetJoinStl.3; then
+ rm -f Tk_NameOfJoinStyle.3
+ cp GetJoinStl.3 Tk_NameOfJoinStyle.3
+fi
+if test -r GetJustify.3; then
+ rm -f Tk_NameOfJustify.3
+ cp GetJustify.3 Tk_NameOfJustify.3
+fi
+if test -r GetRelief.3; then
+ rm -f Tk_NameOfRelief.3
+ cp GetRelief.3 Tk_NameOfRelief.3
+fi
+if test -r Name.3; then
+ rm -f Tk_NameToWindow.3
+ cp Name.3 Tk_NameToWindow.3
+fi
+if test -r ConfigWidg.3; then
+ rm -f Tk_Offset.3
+ cp ConfigWidg.3 Tk_Offset.3
+fi
+if test -r OwnSelect.3; then
+ rm -f Tk_OwnSelection.3
+ cp OwnSelect.3 Tk_OwnSelection.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_Parent.3
+ cp WindowId.3 Tk_Parent.3
+fi
+if test -r ParseArgv.3; then
+ rm -f Tk_ParseArgv.3
+ cp ParseArgv.3 Tk_ParseArgv.3
+fi
+if test -r Name.3; then
+ rm -f Tk_PathName.3
+ cp Name.3 Tk_PathName.3
+fi
+if test -r FindPhoto.3; then
+ rm -f Tk_PhotoBlank.3
+ cp FindPhoto.3 Tk_PhotoBlank.3
+fi
+if test -r FindPhoto.3; then
+ rm -f Tk_PhotoExpand.3
+ cp FindPhoto.3 Tk_PhotoExpand.3
+fi
+if test -r FindPhoto.3; then
+ rm -f Tk_PhotoGetImage.3
+ cp FindPhoto.3 Tk_PhotoGetImage.3
+fi
+if test -r FindPhoto.3; then
+ rm -f Tk_PhotoGetSize.3
+ cp FindPhoto.3 Tk_PhotoGetSize.3
+fi
+if test -r FindPhoto.3; then
+ rm -f Tk_PhotoPutBlock.3
+ cp FindPhoto.3 Tk_PhotoPutBlock.3
+fi
+if test -r FindPhoto.3; then
+ rm -f Tk_PhotoPutZoomedBlock.3
+ cp FindPhoto.3 Tk_PhotoPutZoomedBlock.3
+fi
+if test -r FindPhoto.3; then
+ rm -f Tk_PhotoSetSize.3
+ cp FindPhoto.3 Tk_PhotoSetSize.3
+fi
+if test -r TextLayout.3; then
+ rm -f Tk_PointToChar.3
+ cp TextLayout.3 Tk_PointToChar.3
+fi
+if test -r FontId.3; then
+ rm -f Tk_PostscriptFontName.3
+ cp FontId.3 Tk_PostscriptFontName.3
+fi
+if test -r QWinEvent.3; then
+ rm -f Tk_QueueWindowEvent.3
+ cp QWinEvent.3 Tk_QueueWindowEvent.3
+fi
+if test -r GetImage.3; then
+ rm -f Tk_RedrawImage.3
+ cp GetImage.3 Tk_RedrawImage.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_ReqHeight.3
+ cp WindowId.3 Tk_ReqHeight.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_ReqWidth.3
+ cp WindowId.3 Tk_ReqWidth.3
+fi
+if test -r ConfigWind.3; then
+ rm -f Tk_ResizeWindow.3
+ cp ConfigWind.3 Tk_ResizeWindow.3
+fi
+if test -r Restack.3; then
+ rm -f Tk_RestackWindow.3
+ cp Restack.3 Tk_RestackWindow.3
+fi
+if test -r RestrictEv.3; then
+ rm -f Tk_RestrictEvents.3
+ cp RestrictEv.3 Tk_RestrictEvents.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_Screen.3
+ cp WindowId.3 Tk_Screen.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_ScreenNumber.3
+ cp WindowId.3 Tk_ScreenNumber.3
+fi
+if test -r SetAppName.3; then
+ rm -f Tk_SetAppName.3
+ cp SetAppName.3 Tk_SetAppName.3
+fi
+if test -r 3DBorder.3; then
+ rm -f Tk_SetBackgroundFromBorder.3
+ cp 3DBorder.3 Tk_SetBackgroundFromBorder.3
+fi
+if test -r SetClass.3; then
+ rm -f Tk_SetClass.3
+ cp SetClass.3 Tk_SetClass.3
+fi
+if test -r SetGrid.3; then
+ rm -f Tk_SetGrid.3
+ cp SetGrid.3 Tk_SetGrid.3
+fi
+if test -r GeomReq.3; then
+ rm -f Tk_SetInternalBorder.3
+ cp GeomReq.3 Tk_SetInternalBorder.3
+fi
+if test -r ConfigWind.3; then
+ rm -f Tk_SetWindowBackground.3
+ cp ConfigWind.3 Tk_SetWindowBackground.3
+fi
+if test -r ConfigWind.3; then
+ rm -f Tk_SetWindowBackgroundPixmap.3
+ cp ConfigWind.3 Tk_SetWindowBackgroundPixmap.3
+fi
+if test -r ConfigWind.3; then
+ rm -f Tk_SetWindowBorder.3
+ cp ConfigWind.3 Tk_SetWindowBorder.3
+fi
+if test -r ConfigWind.3; then
+ rm -f Tk_SetWindowBorderPixmap.3
+ cp ConfigWind.3 Tk_SetWindowBorderPixmap.3
+fi
+if test -r ConfigWind.3; then
+ rm -f Tk_SetWindowBorderWidth.3
+ cp ConfigWind.3 Tk_SetWindowBorderWidth.3
+fi
+if test -r ConfigWind.3; then
+ rm -f Tk_SetWindowColormap.3
+ cp ConfigWind.3 Tk_SetWindowColormap.3
+fi
+if test -r SetVisual.3; then
+ rm -f Tk_SetWindowVisual.3
+ cp SetVisual.3 Tk_SetWindowVisual.3
+fi
+if test -r GetBitmap.3; then
+ rm -f Tk_SizeOfBitmap.3
+ cp GetBitmap.3 Tk_SizeOfBitmap.3
+fi
+if test -r GetImage.3; then
+ rm -f Tk_SizeOfImage.3
+ cp GetImage.3 Tk_SizeOfImage.3
+fi
+if test -r StrictMotif.3; then
+ rm -f Tk_StrictMotif.3
+ cp StrictMotif.3 Tk_StrictMotif.3
+fi
+if test -r TextLayout.3; then
+ rm -f Tk_TextLayoutToPostscript.3
+ cp TextLayout.3 Tk_TextLayoutToPostscript.3
+fi
+if test -r MeasureChar.3; then
+ rm -f Tk_TextWidth.3
+ cp MeasureChar.3 Tk_TextWidth.3
+fi
+if test -r GetUid.3; then
+ rm -f Tk_Uid.3
+ cp GetUid.3 Tk_Uid.3
+fi
+if test -r ConfigWind.3; then
+ rm -f Tk_UndefineCursor.3
+ cp ConfigWind.3 Tk_UndefineCursor.3
+fi
+if test -r MeasureChar.3; then
+ rm -f Tk_UnderlineChars.3
+ cp MeasureChar.3 Tk_UnderlineChars.3
+fi
+if test -r TextLayout.3; then
+ rm -f Tk_UnderlineTextLayout.3
+ cp TextLayout.3 Tk_UnderlineTextLayout.3
+fi
+if test -r MaintGeom.3; then
+ rm -f Tk_UnmaintainGeometry.3
+ cp MaintGeom.3 Tk_UnmaintainGeometry.3
+fi
+if test -r MapWindow.3; then
+ rm -f Tk_UnmapWindow.3
+ cp MapWindow.3 Tk_UnmapWindow.3
+fi
+if test -r SetGrid.3; then
+ rm -f Tk_UnsetGrid.3
+ cp SetGrid.3 Tk_UnsetGrid.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_Visual.3
+ cp WindowId.3 Tk_Visual.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_Width.3
+ cp WindowId.3 Tk_Width.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_WindowId.3
+ cp WindowId.3 Tk_WindowId.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_X.3
+ cp WindowId.3 Tk_X.3
+fi
+if test -r WindowId.3; then
+ rm -f Tk_Y.3
+ cp WindowId.3 Tk_Y.3
+fi
+if test -r menubar.n; then
+ rm -f tk_bindForTraversal.n
+ cp menubar.n tk_bindForTraversal.n
+fi
+if test -r palette.n; then
+ rm -f tk_bisque.n
+ cp palette.n tk_bisque.n
+fi
+if test -r chooseColor.n; then
+ rm -f tk_chooseColor.n
+ cp chooseColor.n tk_chooseColor.n
+fi
+if test -r dialog.n; then
+ rm -f tk_dialog.n
+ cp dialog.n tk_dialog.n
+fi
+if test -r focusNext.n; then
+ rm -f tk_focusFollowsMouse.n
+ cp focusNext.n tk_focusFollowsMouse.n
+fi
+if test -r focusNext.n; then
+ rm -f tk_focusNext.n
+ cp focusNext.n tk_focusNext.n
+fi
+if test -r focusNext.n; then
+ rm -f tk_focusPrev.n
+ cp focusNext.n tk_focusPrev.n
+fi
+if test -r getOpenFile.n; then
+ rm -f tk_getOpenFile.n
+ cp getOpenFile.n tk_getOpenFile.n
+fi
+if test -r getOpenFile.n; then
+ rm -f tk_getSaveFile.n
+ cp getOpenFile.n tk_getSaveFile.n
+fi
+if test -r menubar.n; then
+ rm -f tk_menuBar.n
+ cp menubar.n tk_menuBar.n
+fi
+if test -r messageBox.n; then
+ rm -f tk_messageBox.n
+ cp messageBox.n tk_messageBox.n
+fi
+if test -r optionMenu.n; then
+ rm -f tk_optionMenu.n
+ cp optionMenu.n tk_optionMenu.n
+fi
+if test -r popup.n; then
+ rm -f tk_popup.n
+ cp popup.n tk_popup.n
+fi
+if test -r palette.n; then
+ rm -f tk_setPalette.n
+ cp palette.n tk_setPalette.n
+fi
+exit 0
diff --git a/tk/unix/tkAppInit.c b/tk/unix/tkAppInit.c
new file mode 100644
index 00000000000..19fcd974fbc
--- /dev/null
+++ b/tk/unix/tkAppInit.c
@@ -0,0 +1,120 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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 --
+ *
+ * This is the main program for the application.
+ *
+ * Results:
+ * None: Tk_Main never returns here, so this procedure never
+ * returns either.
+ *
+ * Side effects:
+ * Whatever the application does.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+main(argc, argv)
+ int argc; /* Number of command-line arguments. */
+ char **argv; /* Values of command-line arguments. */
+{
+ Tk_Main(argc, argv, Tcl_AppInit);
+ return 0; /* Needed only to prevent compiler warning. */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 */
+
+
+ /*
+ * Call the init procedures for included packages. Each call should
+ * look like this:
+ *
+ * if (Mod_Init(interp) == TCL_ERROR) {
+ * return TCL_ERROR;
+ * }
+ *
+ * where "Mod" is the name of the module.
+ */
+
+ /*
+ * Call Tcl_CreateCommand for application-specific commands, if
+ * they weren't already created by the init procedures called above.
+ */
+
+ /*
+ * Specify a user-specific startup file to invoke if the application
+ * is run interactively. Typically the startup file is "~/.apprc"
+ * where "app" is the name of the application. If this line is deleted
+ * then no user-specific startup file will be run under any conditions.
+ */
+
+ Tcl_SetVar(interp, "tcl_rcFileName", "~/.wishrc", TCL_GLOBAL_ONLY);
+ return TCL_OK;
+}
diff --git a/tk/unix/tkConfig.sh.in b/tk/unix/tkConfig.sh.in
new file mode 100644
index 00000000000..1caab785751
--- /dev/null
+++ b/tk/unix/tkConfig.sh.in
@@ -0,0 +1,77 @@
+# 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$
+
+# 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@'
+
+# The full path to the Tk library for dependency tracking
+TK_LIB_FULL_PATH='@TK_LIB_FULL_PATH@'
+
+# 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@'
+
+# CYGNUS LOCAL
+# -I switch(es) to pick up the tk.h header file from its build
+# directory.
+TK_BUILD_INCLUDES='@TK_BUILD_INCLUDES@'
+# END CYGNUS LOCAL
+
+# -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.
+TK_LIB_SPEC='@TK_LIB_SPEC@'
+
+# Location of the top-level source directory from which Tk was built.
+# This is the directory that contains a README file as well as
+# subdirectories such as generic, unix, etc. If Tk was compiled in a
+# different place than the directory containing the source files, this
+# points to the location of the sources, not the location where Tk was
+# compiled.
+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@'
+
diff --git a/tk/unix/tkUnix.c b/tk/unix/tkUnix.c
new file mode 100644
index 00000000000..097b1b27828
--- /dev/null
+++ b/tk/unix/tkUnix.c
@@ -0,0 +1,79 @@
+/*
+ * 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$
+ */
+
+#include <tkInt.h>
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetServerInfo --
+ *
+ * Given a window, this procedure returns information about
+ * the window server for that window. This procedure provides
+ * the guts of the "winfo server" command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetDefaultScreenName --
+ *
+ * Returns the name of the screen that Tk should use during
+ * initialization.
+ *
+ * Results:
+ * Returns the argument or a string that should not be freed by
+ * the caller.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkGetDefaultScreenName(interp, screenName)
+ Tcl_Interp *interp; /* Interp used to find environment variables. */
+ 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;
+}
diff --git a/tk/unix/tkUnix3d.c b/tk/unix/tkUnix3d.c
new file mode 100644
index 00000000000..b3493a79f28
--- /dev/null
+++ b/tk/unix/tkUnix3d.c
@@ -0,0 +1,448 @@
+/*
+ * 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$
+ */
+
+#include <tk3d.h>
+
+/*
+ * This structure is used to keep track of the extra colors used
+ * by Unix 3d borders.
+ */
+
+typedef struct {
+ TkBorder info;
+ GC solidGC; /* Used to draw solid relief. */
+} UnixBorder;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetBorder --
+ *
+ * This function allocates a new TkBorder structure.
+ *
+ * Results:
+ * Returns a newly allocated TkBorder.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkBorder *
+TkpGetBorder()
+{
+ UnixBorder *borderPtr = (UnixBorder *) ckalloc(sizeof(UnixBorder));
+ borderPtr->solidGC = None;
+ return (TkBorder *) borderPtr;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpFreeBorder --
+ *
+ * This function frees any colors allocated by the platform
+ * specific part of this module.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May deallocate some colors.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpFreeBorder(borderPtr)
+ TkBorder *borderPtr;
+{
+ UnixBorder *unixBorderPtr = (UnixBorder *) borderPtr;
+ Display *display = DisplayOfScreen(borderPtr->screen);
+
+ if (unixBorderPtr->solidGC != None) {
+ Tk_FreeGC(display, unixBorderPtr->solidGC);
+ }
+}
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_3DVerticalBevel --
+ *
+ * This procedure draws a vertical bevel along one side of
+ * an object. The bevel is always rectangular in shape:
+ * |||
+ * |||
+ * |||
+ * |||
+ * |||
+ * |||
+ * An appropriate shadow color is chosen for the bevel based
+ * on the leftBevel and relief arguments. Normally this
+ * procedure is called first, then Tk_3DHorizontalBevel is
+ * called next to draw neat corners.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Graphics are drawn in drawable.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_3DVerticalBevel(tkwin, drawable, border, x, y, width, height,
+ leftBevel, relief)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Drawable drawable; /* X window or pixmap in which to draw. */
+ Tk_3DBorder border; /* Token for border to draw. */
+ int x, y, width, height; /* Area of vertical bevel. */
+ int leftBevel; /* Non-zero means this bevel forms the
+ * left side of the object; 0 means it
+ * forms the right side. */
+ int relief; /* Kind of bevel to draw. For example,
+ * TK_RELIEF_RAISED means interior of
+ * object should appear higher than
+ * exterior. */
+{
+ TkBorder *borderPtr = (TkBorder *) border;
+ GC left, right;
+ Display *display = Tk_Display(tkwin);
+
+ if ((borderPtr->lightGC == None) && (relief != TK_RELIEF_FLAT)) {
+ TkpGetShadows(borderPtr, tkwin);
+ }
+
+ if (relief == TK_RELIEF_RAISED) {
+ XFillRectangle(display, drawable,
+ (leftBevel) ? borderPtr->lightGC : borderPtr->darkGC,
+ x, y, (unsigned) width, (unsigned) height);
+ } else if (relief == TK_RELIEF_SUNKEN) {
+ XFillRectangle(display, drawable,
+ (leftBevel) ? borderPtr->darkGC : borderPtr->lightGC,
+ x, y, (unsigned) width, (unsigned) height);
+ } else if (relief == TK_RELIEF_RIDGE) {
+ int half;
+
+ left = borderPtr->lightGC;
+ right = borderPtr->darkGC;
+ ridgeGroove:
+ half = width/2;
+ if (!leftBevel && (width & 1)) {
+ half++;
+ }
+ XFillRectangle(display, drawable, left, x, y, (unsigned) half,
+ (unsigned) height);
+ XFillRectangle(display, drawable, right, x+half, y,
+ (unsigned) (width-half), (unsigned) height);
+ } else if (relief == TK_RELIEF_GROOVE) {
+ left = borderPtr->darkGC;
+ right = borderPtr->lightGC;
+ goto ridgeGroove;
+ } else if (relief == TK_RELIEF_FLAT) {
+ XFillRectangle(display, drawable, borderPtr->bgGC, x, y,
+ (unsigned) width, (unsigned) height);
+ } else if (relief == TK_RELIEF_SOLID) {
+ UnixBorder *unixBorderPtr = (UnixBorder *) borderPtr;
+ if (unixBorderPtr->solidGC == None) {
+ XGCValues gcValues;
+
+ gcValues.foreground = BlackPixelOfScreen(borderPtr->screen);
+ unixBorderPtr->solidGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ }
+ XFillRectangle(display, drawable, unixBorderPtr->solidGC, x, y,
+ (unsigned) width, (unsigned) height);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_3DHorizontalBevel --
+ *
+ * This procedure draws a horizontal bevel along one side of
+ * an object. The bevel has mitered corners (depending on
+ * leftIn and rightIn arguments).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_3DHorizontalBevel(tkwin, drawable, border, x, y, width, height,
+ leftIn, rightIn, topBevel, relief)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Drawable drawable; /* X window or pixmap in which to draw. */
+ Tk_3DBorder border; /* Token for border to draw. */
+ int x, y, width, height; /* Bounding box of area of bevel. Height
+ * gives width of border. */
+ int leftIn, rightIn; /* Describes whether the left and right
+ * edges of the bevel angle in or out as
+ * they go down. For example, if "leftIn"
+ * is true, the left side of the bevel
+ * looks like this:
+ * ___________
+ * __________
+ * _________
+ * ________
+ */
+ int topBevel; /* Non-zero means this bevel forms the
+ * top side of the object; 0 means it
+ * forms the bottom side. */
+ int relief; /* Kind of bevel to draw. For example,
+ * TK_RELIEF_RAISED means interior of
+ * object should appear higher than
+ * exterior. */
+{
+ TkBorder *borderPtr = (TkBorder *) border;
+ Display *display = Tk_Display(tkwin);
+ int bottom, halfway, x1, x2, x1Delta, x2Delta;
+ UnixBorder *unixBorderPtr = (UnixBorder *) borderPtr;
+ GC topGC = None, bottomGC = None;
+ /* Initializations needed only to prevent
+ * compiler warnings. */
+
+ if ((borderPtr->lightGC == None) && (relief != TK_RELIEF_FLAT) &&
+ (relief != TK_RELIEF_SOLID)) {
+ TkpGetShadows(borderPtr, tkwin);
+ }
+
+ /*
+ * Compute a GC for the top half of the bevel and a GC for the
+ * bottom half (they're the same in many cases).
+ */
+
+ switch (relief) {
+ case TK_RELIEF_FLAT:
+ topGC = bottomGC = borderPtr->bgGC;
+ break;
+ case TK_RELIEF_GROOVE:
+ topGC = borderPtr->darkGC;
+ bottomGC = borderPtr->lightGC;
+ break;
+ case TK_RELIEF_RAISED:
+ topGC = bottomGC =
+ (topBevel) ? borderPtr->lightGC : borderPtr->darkGC;
+ break;
+ case TK_RELIEF_RIDGE:
+ topGC = borderPtr->lightGC;
+ bottomGC = borderPtr->darkGC;
+ break;
+ case TK_RELIEF_SOLID:
+ if (unixBorderPtr->solidGC == None) {
+ XGCValues gcValues;
+
+ gcValues.foreground = BlackPixelOfScreen(borderPtr->screen);
+ unixBorderPtr->solidGC = Tk_GetGC(tkwin, GCForeground,
+ &gcValues);
+ }
+ XFillRectangle(display, drawable, unixBorderPtr->solidGC, x, y,
+ (unsigned) width, (unsigned) height);
+ return;
+ case TK_RELIEF_SUNKEN:
+ topGC = bottomGC =
+ (topBevel) ? borderPtr->darkGC : borderPtr->lightGC;
+ break;
+ }
+
+ /*
+ * Compute various other geometry-related stuff.
+ */
+
+ x1 = x;
+ if (!leftIn) {
+ x1 += height;
+ }
+ x2 = x+width;
+ if (!rightIn) {
+ x2 -= height;
+ }
+ x1Delta = (leftIn) ? 1 : -1;
+ x2Delta = (rightIn) ? -1 : 1;
+ halfway = y + height/2;
+ if (!topBevel && (height & 1)) {
+ halfway++;
+ }
+ bottom = y + height;
+
+ /*
+ * Draw one line for each y-coordinate covered by the bevel.
+ */
+
+ for ( ; y < bottom; y++) {
+ /*
+ * In some weird cases (such as large border widths for skinny
+ * rectangles) x1 can be >= x2. Don't draw the lines
+ * in these cases.
+ */
+
+ if (x1 < x2) {
+ XFillRectangle(display, drawable,
+ (y < halfway) ? topGC : bottomGC, x1, y,
+ (unsigned) (x2-x1), (unsigned) 1);
+ }
+ x1 += x1Delta;
+ x2 += x2Delta;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetShadows --
+ *
+ * This procedure computes the shadow colors for a 3-D border
+ * and fills in the corresponding fields of the Border structure.
+ * It's called lazily, so that the colors aren't allocated until
+ * something is actually drawn with them. That way, if a border
+ * is only used for flat backgrounds the shadow colors will
+ * never be allocated.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The lightGC and darkGC fields in borderPtr get filled in,
+ * if they weren't already.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpGetShadows(borderPtr, tkwin)
+ TkBorder *borderPtr; /* Information about border. */
+ Tk_Window tkwin; /* Window where border will be used for
+ * drawing. */
+{
+ XColor lightColor, darkColor;
+ int stressed, tmp1, tmp2;
+ XGCValues gcValues;
+
+ if (borderPtr->lightGC != None) {
+ return;
+ }
+ stressed = TkpCmapStressed(tkwin, borderPtr->colormap);
+
+ /*
+ * First, handle the case of a color display with lots of colors.
+ * The shadow colors get computed using whichever formula results
+ * in the greatest change in color:
+ * 1. Lighter shadow is half-way to white, darker shadow is half
+ * way to dark.
+ * 2. Lighter shadow is 40% brighter than background, darker shadow
+ * is 40% darker than background.
+ */
+
+ if (!stressed && (Tk_Depth(tkwin) >= 6)) {
+ /*
+ * This is a color display with lots of colors. For the dark
+ * shadow, cut 40% from each of the background color components.
+ * For the light shadow, boost each component by 40% or half-way
+ * to white, whichever is greater (the first approach works
+ * better for unsaturated colors, the second for saturated ones).
+ */
+
+ darkColor.red = (60 * (int) borderPtr->bgColorPtr->red)/100;
+ darkColor.green = (60 * (int) borderPtr->bgColorPtr->green)/100;
+ darkColor.blue = (60 * (int) borderPtr->bgColorPtr->blue)/100;
+ borderPtr->darkColorPtr = Tk_GetColorByValue(tkwin, &darkColor);
+ gcValues.foreground = borderPtr->darkColorPtr->pixel;
+ borderPtr->darkGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+
+ /*
+ * Compute the colors using integers, not using lightColor.red
+ * etc.: these are shorts and may have problems with integer
+ * overflow.
+ */
+
+ tmp1 = (14 * (int) borderPtr->bgColorPtr->red)/10;
+ if (tmp1 > MAX_INTENSITY) {
+ tmp1 = MAX_INTENSITY;
+ }
+ tmp2 = (MAX_INTENSITY + (int) borderPtr->bgColorPtr->red)/2;
+ lightColor.red = (tmp1 > tmp2) ? tmp1 : tmp2;
+ tmp1 = (14 * (int) borderPtr->bgColorPtr->green)/10;
+ if (tmp1 > MAX_INTENSITY) {
+ tmp1 = MAX_INTENSITY;
+ }
+ tmp2 = (MAX_INTENSITY + (int) borderPtr->bgColorPtr->green)/2;
+ lightColor.green = (tmp1 > tmp2) ? tmp1 : tmp2;
+ tmp1 = (14 * (int) borderPtr->bgColorPtr->blue)/10;
+ if (tmp1 > MAX_INTENSITY) {
+ tmp1 = MAX_INTENSITY;
+ }
+ tmp2 = (MAX_INTENSITY + (int) borderPtr->bgColorPtr->blue)/2;
+ lightColor.blue = (tmp1 > tmp2) ? tmp1 : tmp2;
+ borderPtr->lightColorPtr = Tk_GetColorByValue(tkwin, &lightColor);
+ gcValues.foreground = borderPtr->lightColorPtr->pixel;
+ borderPtr->lightGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ return;
+ }
+
+ if (borderPtr->shadow == None) {
+ borderPtr->shadow = Tk_GetBitmap((Tcl_Interp *) NULL, tkwin,
+ Tk_GetUid("gray50"));
+ if (borderPtr->shadow == None) {
+ panic("TkpGetShadows couldn't allocate bitmap for border");
+ }
+ }
+ if (borderPtr->visual->map_entries > 2) {
+ /*
+ * This isn't a monochrome display, but the colormap either
+ * ran out of entries or didn't have very many to begin with.
+ * Generate the light shadows with a white stipple and the
+ * dark shadows with a black stipple.
+ */
+
+ gcValues.foreground = borderPtr->bgColorPtr->pixel;
+ gcValues.background = BlackPixelOfScreen(borderPtr->screen);
+ gcValues.stipple = borderPtr->shadow;
+ gcValues.fill_style = FillOpaqueStippled;
+ borderPtr->darkGC = Tk_GetGC(tkwin,
+ GCForeground|GCBackground|GCStipple|GCFillStyle, &gcValues);
+ gcValues.background = WhitePixelOfScreen(borderPtr->screen);
+ borderPtr->lightGC = Tk_GetGC(tkwin,
+ GCForeground|GCBackground|GCStipple|GCFillStyle, &gcValues);
+ return;
+ }
+
+ /*
+ * This is just a measly monochrome display, hardly even worth its
+ * existence on this earth. Make one shadow a 50% stipple and the
+ * other the opposite of the background.
+ */
+
+ gcValues.foreground = WhitePixelOfScreen(borderPtr->screen);
+ gcValues.background = BlackPixelOfScreen(borderPtr->screen);
+ gcValues.stipple = borderPtr->shadow;
+ gcValues.fill_style = FillOpaqueStippled;
+ borderPtr->lightGC = Tk_GetGC(tkwin,
+ GCForeground|GCBackground|GCStipple|GCFillStyle, &gcValues);
+ if (borderPtr->bgColorPtr->pixel
+ == WhitePixelOfScreen(borderPtr->screen)) {
+ gcValues.foreground = BlackPixelOfScreen(borderPtr->screen);
+ borderPtr->darkGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ } else {
+ borderPtr->darkGC = borderPtr->lightGC;
+ borderPtr->lightGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ }
+}
diff --git a/tk/unix/tkUnixButton.c b/tk/unix/tkUnixButton.c
new file mode 100644
index 00000000000..5a8acc03671
--- /dev/null
+++ b/tk/unix/tkUnixButton.c
@@ -0,0 +1,478 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkButton.h"
+
+/*
+ * Declaration of Unix specific button structure.
+ */
+
+typedef struct UnixButton {
+ TkButton info; /* Generic button info. */
+} UnixButton;
+
+/*
+ * The class procedure table for the button widgets.
+ */
+
+TkClassProcs tkpButtonProcs = {
+ NULL, /* createProc. */
+ TkButtonWorldChanged, /* geometryProc. */
+ NULL /* modalProc. */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCreateButton --
+ *
+ * Allocate a new TkButton structure.
+ *
+ * Results:
+ * Returns a newly allocated TkButton structure.
+ *
+ * Side effects:
+ * Registers an event handler for the widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkButton *
+TkpCreateButton(tkwin)
+ Tk_Window tkwin;
+{
+ UnixButton *butPtr = (UnixButton *)ckalloc(sizeof(UnixButton));
+ return (TkButton *) butPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDisplayButton --
+ *
+ * This procedure is invoked to display a button widget. It is
+ * normally invoked as an idle handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the button in its
+ * current mode. The REDRAW_PENDING flag is cleared.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDisplayButton(clientData)
+ ClientData clientData; /* Information about widget. */
+{
+ 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.
+ */
+
+ 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) && !Tk_StrictMotif(butPtr->tkwin);
+
+ /*
+ * 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, 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;
+
+ x += offset;
+ y += offset;
+ if (relief == TK_RELIEF_RAISED) {
+ x -= offset;
+ y -= offset;
+ } else if (relief == TK_RELIEF_SUNKEN) {
+ x += offset;
+ y += offset;
+ }
+ if (butPtr->image != NULL) {
+ if ((butPtr->selectImage != NULL) && (butPtr->flags & SELECTED)) {
+ Tk_RedrawImage(butPtr->selectImage, 0, 0, width, height, pixmap,
+ x, y);
+ } else {
+ Tk_RedrawImage(butPtr->image, 0, 0, width, height, pixmap,
+ x, y);
+ }
+ } else {
+ XSetClipOrigin(butPtr->display, gc, x, y);
+ XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, gc, 0, 0,
+ (unsigned int) width, (unsigned int) height, x, y, 1);
+ XSetClipOrigin(butPtr->display, gc, 0, 0);
+ }
+ y += height/2;
+ } else if (butPtr->bitmap != None) {
+ Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
+ goto imageOrBitmap;
+ } else {
+ TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX, butPtr->padY,
+ butPtr->indicatorSpace + butPtr->textWidth, butPtr->textHeight,
+ &x, &y);
+
+ x += butPtr->indicatorSpace;
+
+ x += offset;
+ y += offset;
+ if (relief == TK_RELIEF_RAISED) {
+ x -= offset;
+ y -= offset;
+ } else if (relief == TK_RELIEF_SUNKEN) {
+ x += offset;
+ y += offset;
+ }
+ Tk_DrawTextLayout(butPtr->display, pixmap, gc, butPtr->textLayout,
+ x, y, 0, -1);
+ Tk_UnderlineTextLayout(butPtr->display, pixmap, gc,
+ butPtr->textLayout, x, y, butPtr->underline);
+ y += butPtr->textHeight/2;
+ }
+
+ /*
+ * 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) {
+ 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);
+ }
+ }
+ } else if ((butPtr->type == TYPE_RADIO_BUTTON) && butPtr->indicatorOn) {
+ XPoint points[4];
+ int radius;
+
+ radius = butPtr->indicatorDiameter/2;
+ points[0].x = x - butPtr->indicatorSpace;
+ points[0].y = y;
+ 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 (butPtr->flags & SELECTED) {
+ GC gc;
+
+ gc = Tk_3DBorderGC(tkwin, (butPtr->selectBorder != NULL)
+ ? butPtr->selectBorder : butPtr->normalBorder,
+ TK_3D_FLAT_GC);
+ XFillPolygon(butPtr->display, pixmap, gc, points, 4, Convex,
+ CoordModeOrigin);
+ } else {
+ Tk_Fill3DPolygon(tkwin, pixmap, butPtr->normalBorder, points,
+ 4, butPtr->borderWidth, TK_RELIEF_FLAT);
+ }
+ Tk_Draw3DPolygon(tkwin, pixmap, border, points, 4, butPtr->borderWidth,
+ (butPtr->flags & SELECTED) ? TK_RELIEF_SUNKEN :
+ TK_RELIEF_RAISED);
+ }
+
+ /*
+ * 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,
+ butPtr->inset, butPtr->inset,
+ (unsigned) (Tk_Width(tkwin) - 2*butPtr->inset),
+ (unsigned) (Tk_Height(tkwin) - 2*butPtr->inset));
+ if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
+ && (butPtr->selectBorder != NULL)) {
+ XSetForeground(butPtr->display, butPtr->disabledGC,
+ Tk_3DBorderColor(butPtr->normalBorder)->pixel);
+ }
+ }
+
+ /*
+ * Draw the border and traversal highlight last. This way, if the
+ * button's contents overflow they'll be covered up by the border.
+ * 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.
+ */
+
+ Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, inset,
+ inset, Tk_Width(tkwin) - 2*inset,
+ Tk_Height(tkwin) - 2*inset, 2, TK_RELIEF_FLAT);
+ inset += 2;
+ Tk_Draw3DRectangle(tkwin, pixmap, butPtr->highlightBorder, inset,
+ inset, Tk_Width(tkwin) - 2*inset,
+ 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);
+ }
+ }
+
+ /*
+ * Copy the information from the off-screen pixmap onto the screen,
+ * then delete the pixmap.
+ */
+
+ XCopyArea(butPtr->display, pixmap, Tk_WindowId(tkwin),
+ butPtr->copyGC, 0, 0, (unsigned) Tk_Width(tkwin),
+ (unsigned) Tk_Height(tkwin), 0, 0);
+ Tk_FreePixmap(butPtr->display, pixmap);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpComputeButtonGeometry --
+ *
+ * After changes in a button's text or bitmap, this procedure
+ * recomputes the button's geometry and passes this information
+ * along to the geometry manager for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The button's window may change size.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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) {
+ width = butPtr->width;
+ }
+ if (butPtr->height > 0) {
+ height = butPtr->height;
+ }
+ if ((butPtr->type >= TYPE_CHECK_BUTTON) && butPtr->indicatorOn) {
+ butPtr->indicatorSpace = height;
+ if (butPtr->type == TYPE_CHECK_BUTTON) {
+ butPtr->indicatorDiameter = (65*height)/100;
+ } else {
+ butPtr->indicatorDiameter = (75*height)/100;
+ }
+ }
+ } 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 = fm.linespace;
+ if (butPtr->type == TYPE_CHECK_BUTTON) {
+ 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 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) && !Tk_StrictMotif(butPtr->tkwin)) {
+ 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);
+}
diff --git a/tk/unix/tkUnixColor.c b/tk/unix/tkUnixColor.c
new file mode 100644
index 00000000000..d927351833b
--- /dev/null
+++ b/tk/unix/tkUnixColor.c
@@ -0,0 +1,424 @@
+/*
+ * 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$
+ */
+
+#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
+ * closest color from those that are available in the colormap.
+ * One of the following structures will be created for each "stressed"
+ * colormap to keep track of the colors that are available in the
+ * colormap (otherwise we would have to re-query from the server on
+ * each allocation, which would be very slow). These entries are
+ * flushed after a few seconds, since other clients may release or
+ * reallocate colors over time.
+ */
+
+struct TkStressedCmap {
+ Colormap colormap; /* X's token for the colormap. */
+ int numColors; /* Number of entries currently active
+ * at *colorPtr. */
+ XColor *colorPtr; /* Pointer to malloc'ed array of all
+ * colors that seem to be available in
+ * the colormap. Some may not actually
+ * be available, e.g. because they are
+ * read-write for another client; when
+ * we find this out, we remove them
+ * from the array. */
+ struct TkStressedCmap *nextPtr; /* Next in list of all stressed
+ * colormaps for the display. */
+};
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void DeleteStressedCmap _ANSI_ARGS_((Display *display,
+ Colormap colormap));
+static void FindClosestColor _ANSI_ARGS_((Tk_Window tkwin,
+ XColor *desiredColorPtr, XColor *actualColorPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpFreeColor --
+ *
+ * Release the specified color back to the system.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Invalidates the colormap cache for the colormap associated with
+ * the given color.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpFreeColor(tkColPtr)
+ TkColor *tkColPtr; /* Color to be released. Must have been
+ * allocated by TkpGetColor or
+ * TkpGetColorByValue. */
+{
+ Visual *visual;
+ Screen *screen = tkColPtr->screen;
+
+ /*
+ * Careful! Don't free black or white, since this will
+ * make some servers very unhappy. Also, there is a bug in
+ * some servers (such Sun's X11/NeWS server) where reference
+ * counting is performed incorrectly, so that if a color is
+ * allocated twice in different places and then freed twice,
+ * the second free generates an error (this bug existed as of
+ * 10/1/92). To get around this problem, ignore errors that
+ * occur during the free operation.
+ */
+
+ visual = tkColPtr->visual;
+ if ((visual->class != StaticGray) && (visual->class != StaticColor)
+ && (tkColPtr->color.pixel != BlackPixelOfScreen(screen))
+ && (tkColPtr->color.pixel != WhitePixelOfScreen(screen))) {
+ Tk_ErrorHandler handler;
+
+ handler = Tk_CreateErrorHandler(DisplayOfScreen(screen),
+ -1, -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ XFreeColors(DisplayOfScreen(screen), tkColPtr->colormap,
+ &tkColPtr->color.pixel, 1, 0L);
+ Tk_DeleteErrorHandler(handler);
+ }
+ DeleteStressedCmap(DisplayOfScreen(screen), tkColPtr->colormap);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetColor --
+ *
+ * Allocate a new TkColor for the color with the given name.
+ *
+ * Results:
+ * Returns a newly allocated TkColor, or NULL on failure.
+ *
+ * Side effects:
+ * May invalidate the colormap cache associated with tkwin upon
+ * allocating a new colormap entry. Allocates a new TkColor
+ * structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkColor *
+TkpGetColor(tkwin, name)
+ 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). */
+{
+ Display *display = Tk_Display(tkwin);
+ Colormap colormap = Tk_Colormap(tkwin);
+ XColor color;
+ TkColor *tkColPtr;
+
+ /*
+ * Map from the name to a pixel value. Call XAllocNamedColor rather than
+ * XParseColor for non-# names: this saves a server round-trip for those
+ * names.
+ */
+
+ if (*name != '#') {
+ XColor screen;
+
+ if (XAllocNamedColor(display, colormap, name, &screen,
+ &color) != 0) {
+ DeleteStressedCmap(display, colormap);
+ } else {
+ /*
+ * Couldn't allocate the color. Try translating the name to
+ * a color value, to see whether the problem is a bad color
+ * name or a full colormap. If the colormap is full, then
+ * pick an approximation to the desired color.
+ */
+
+ if (XLookupColor(display, colormap, name, &color,
+ &screen) == 0) {
+ return (TkColor *) NULL;
+ }
+ FindClosestColor(tkwin, &screen, &color);
+ }
+ } else {
+ if (XParseColor(display, colormap, name, &color) == 0) {
+ return (TkColor *) NULL;
+ }
+ if (XAllocColor(display, colormap, &color) != 0) {
+ DeleteStressedCmap(display, colormap);
+ } else {
+ FindClosestColor(tkwin, &color, &color);
+ }
+ }
+
+ tkColPtr = (TkColor *) ckalloc(sizeof(TkColor));
+ tkColPtr->color = color;
+
+ return tkColPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetColorByValue --
+ *
+ * Given a desired set of red-green-blue intensities for a color,
+ * locate a pixel value to use to draw that color in a given
+ * window.
+ *
+ * Results:
+ * The return value is a pointer to an TkColor structure that
+ * indicates the closest red, blue, and green intensities available
+ * to those specified in colorPtr, and also specifies a pixel
+ * value to use to draw in that color.
+ *
+ * Side effects:
+ * May invalidate the colormap cache for the specified window.
+ * Allocates a new TkColor structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkColor *
+TkpGetColorByValue(tkwin, colorPtr)
+ Tk_Window tkwin; /* Window in which color will be used. */
+ XColor *colorPtr; /* Red, green, and blue fields indicate
+ * desired color. */
+{
+ Display *display = Tk_Display(tkwin);
+ Colormap colormap = Tk_Colormap(tkwin);
+ TkColor *tkColPtr = (TkColor *) ckalloc(sizeof(TkColor));
+
+ tkColPtr->color.red = colorPtr->red;
+ tkColPtr->color.green = colorPtr->green;
+ tkColPtr->color.blue = colorPtr->blue;
+ if (XAllocColor(display, colormap, &tkColPtr->color) != 0) {
+ DeleteStressedCmap(display, colormap);
+ } else {
+ FindClosestColor(tkwin, &tkColPtr->color, &tkColPtr->color);
+ }
+
+ return tkColPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindClosestColor --
+ *
+ * When Tk can't allocate a color because a colormap has filled
+ * up, this procedure is called to find and allocate the closest
+ * available color in the colormap.
+ *
+ * Results:
+ * There is no return value, but *actualColorPtr is filled in
+ * with information about the closest available color in tkwin's
+ * colormap. This color has been allocated via X, so it must
+ * be released by the caller when the caller is done with it.
+ *
+ * Side effects:
+ * A color is allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FindClosestColor(tkwin, desiredColorPtr, actualColorPtr)
+ Tk_Window tkwin; /* Window where color will be used. */
+ XColor *desiredColorPtr; /* RGB values of color that was
+ * wanted (but unavailable). */
+ XColor *actualColorPtr; /* Structure to fill in with RGB and
+ * pixel for closest available
+ * color. */
+{
+ TkStressedCmap *stressPtr;
+ double tmp, distance, closestDistance;
+ int i, closest, numFound;
+ XColor *colorPtr;
+ TkDisplay *dispPtr = ((TkWindow *) tkwin)->dispPtr;
+ Colormap colormap = Tk_Colormap(tkwin);
+ XVisualInfo template, *visInfoPtr;
+
+ /*
+ * Find the TkStressedCmap structure for this colormap, or create
+ * a new one if needed.
+ */
+
+ for (stressPtr = dispPtr->stressPtr; ; stressPtr = stressPtr->nextPtr) {
+ if (stressPtr == NULL) {
+ stressPtr = (TkStressedCmap *) ckalloc(sizeof(TkStressedCmap));
+ stressPtr->colormap = colormap;
+ template.visualid = XVisualIDFromVisual(Tk_Visual(tkwin));
+ visInfoPtr = XGetVisualInfo(Tk_Display(tkwin),
+ VisualIDMask, &template, &numFound);
+ if (numFound < 1) {
+ panic("FindClosestColor couldn't lookup visual");
+ }
+ stressPtr->numColors = visInfoPtr->colormap_size;
+ XFree((char *) visInfoPtr);
+ stressPtr->colorPtr = (XColor *) ckalloc((unsigned)
+ (stressPtr->numColors * sizeof(XColor)));
+ for (i = 0; i < stressPtr->numColors; i++) {
+ stressPtr->colorPtr[i].pixel = (unsigned long) i;
+ }
+ XQueryColors(dispPtr->display, colormap, stressPtr->colorPtr,
+ stressPtr->numColors);
+ stressPtr->nextPtr = dispPtr->stressPtr;
+ dispPtr->stressPtr = stressPtr;
+ break;
+ }
+ if (stressPtr->colormap == colormap) {
+ break;
+ }
+ }
+
+ /*
+ * Find the color that best approximates the desired one, then
+ * try to allocate that color. If that fails, it must mean that
+ * the color was read-write (so we can't use it, since it's owner
+ * might change it) or else it was already freed. Try again,
+ * over and over again, until something succeeds.
+ */
+
+ while (1) {
+ if (stressPtr->numColors == 0) {
+ panic("FindClosestColor ran out of colors");
+ }
+ closestDistance = 1e30;
+ closest = 0;
+ for (colorPtr = stressPtr->colorPtr, i = 0; i < stressPtr->numColors;
+ colorPtr++, i++) {
+ /*
+ * Use Euclidean distance in RGB space, weighted by Y (of YIQ)
+ * as the objective function; this accounts for differences
+ * in the color sensitivity of the eye.
+ */
+
+ tmp = .30*(((int) desiredColorPtr->red) - (int) colorPtr->red);
+ distance = tmp*tmp;
+ tmp = .61*(((int) desiredColorPtr->green) - (int) colorPtr->green);
+ distance += tmp*tmp;
+ tmp = .11*(((int) desiredColorPtr->blue) - (int) colorPtr->blue);
+ distance += tmp*tmp;
+ if (distance < closestDistance) {
+ closest = i;
+ closestDistance = distance;
+ }
+ }
+ if (XAllocColor(dispPtr->display, colormap,
+ &stressPtr->colorPtr[closest]) != 0) {
+ *actualColorPtr = stressPtr->colorPtr[closest];
+ return;
+ }
+
+ /*
+ * Couldn't allocate the color. Remove it from the table and
+ * go back to look for the next best color.
+ */
+
+ stressPtr->colorPtr[closest] =
+ stressPtr->colorPtr[stressPtr->numColors-1];
+ stressPtr->numColors -= 1;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DeleteStressedCmap --
+ *
+ * This procedure releases the information cached for "colormap"
+ * so that it will be refetched from the X server the next time
+ * it is needed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The TkStressedCmap structure for colormap is deleted; the
+ * colormap is no longer considered to be "stressed".
+ *
+ * Note:
+ * This procedure is invoked whenever a color in a colormap is
+ * freed, and whenever a color allocation in a colormap succeeds.
+ * This guarantees that TkStressedCmap structures are always
+ * deleted before the corresponding Colormap is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DeleteStressedCmap(display, colormap)
+ Display *display; /* Xlib's handle for the display
+ * containing the colormap. */
+ Colormap colormap; /* Colormap to flush. */
+{
+ TkStressedCmap *prevPtr, *stressPtr;
+ TkDisplay *dispPtr = TkGetDisplay(display);
+
+ for (prevPtr = NULL, stressPtr = dispPtr->stressPtr; stressPtr != NULL;
+ prevPtr = stressPtr, stressPtr = stressPtr->nextPtr) {
+ if (stressPtr->colormap == colormap) {
+ if (prevPtr == NULL) {
+ dispPtr->stressPtr = stressPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = stressPtr->nextPtr;
+ }
+ ckfree((char *) stressPtr->colorPtr);
+ ckfree((char *) stressPtr);
+ return;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCmapStressed --
+ *
+ * Check to see whether a given colormap is known to be out
+ * of entries.
+ *
+ * Results:
+ * 1 is returned if "colormap" is stressed (i.e. it has run out
+ * of entries recently), 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpCmapStressed(tkwin, colormap)
+ Tk_Window tkwin; /* Window that identifies the display
+ * containing the colormap. */
+ Colormap colormap; /* Colormap to check for stress. */
+{
+ TkStressedCmap *stressPtr;
+
+ for (stressPtr = ((TkWindow *) tkwin)->dispPtr->stressPtr;
+ stressPtr != NULL; stressPtr = stressPtr->nextPtr) {
+ if (stressPtr->colormap == colormap) {
+ return 1;
+ }
+ }
+ return 0;
+}
diff --git a/tk/unix/tkUnixCursor.c b/tk/unix/tkUnixCursor.c
new file mode 100644
index 00000000000..eb6e46030b5
--- /dev/null
+++ b/tk/unix/tkUnixCursor.c
@@ -0,0 +1,407 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The following data structure is a superset of the TkCursor structure
+ * defined in tkCursor.c. Each system specific cursor module will define
+ * a different cursor structure. All of these structures must have the
+ * same header consisting of the fields in TkCursor.
+ */
+
+
+
+typedef struct {
+ TkCursor info; /* Generic cursor info used by tkCursor.c */
+ Display *display; /* Display for which cursor is valid. */
+} TkUnixCursor;
+
+/*
+ * The table below is used to map from the name of a cursor to its
+ * index in the official cursor font:
+ */
+
+static struct CursorName {
+ char *name;
+ unsigned int shape;
+} cursorNames[] = {
+ {"X_cursor", XC_X_cursor},
+ {"arrow", XC_arrow},
+ {"based_arrow_down", XC_based_arrow_down},
+ {"based_arrow_up", XC_based_arrow_up},
+ {"boat", XC_boat},
+ {"bogosity", XC_bogosity},
+ {"bottom_left_corner", XC_bottom_left_corner},
+ {"bottom_right_corner", XC_bottom_right_corner},
+ {"bottom_side", XC_bottom_side},
+ {"bottom_tee", XC_bottom_tee},
+ {"box_spiral", XC_box_spiral},
+ {"center_ptr", XC_center_ptr},
+ {"circle", XC_circle},
+ {"clock", XC_clock},
+ {"coffee_mug", XC_coffee_mug},
+ {"cross", XC_cross},
+ {"cross_reverse", XC_cross_reverse},
+ {"crosshair", XC_crosshair},
+ {"diamond_cross", XC_diamond_cross},
+ {"dot", XC_dot},
+ {"dotbox", XC_dotbox},
+ {"double_arrow", XC_double_arrow},
+ {"draft_large", XC_draft_large},
+ {"draft_small", XC_draft_small},
+ {"draped_box", XC_draped_box},
+ {"exchange", XC_exchange},
+ {"fleur", XC_fleur},
+ {"gobbler", XC_gobbler},
+ {"gumby", XC_gumby},
+ {"hand1", XC_hand1},
+ {"hand2", XC_hand2},
+ {"heart", XC_heart},
+ {"icon", XC_icon},
+ {"iron_cross", XC_iron_cross},
+ {"left_ptr", XC_left_ptr},
+ {"left_side", XC_left_side},
+ {"left_tee", XC_left_tee},
+ {"leftbutton", XC_leftbutton},
+ {"ll_angle", XC_ll_angle},
+ {"lr_angle", XC_lr_angle},
+ {"man", XC_man},
+ {"middlebutton", XC_middlebutton},
+ {"mouse", XC_mouse},
+ {"pencil", XC_pencil},
+ {"pirate", XC_pirate},
+ {"plus", XC_plus},
+ {"question_arrow", XC_question_arrow},
+ {"right_ptr", XC_right_ptr},
+ {"right_side", XC_right_side},
+ {"right_tee", XC_right_tee},
+ {"rightbutton", XC_rightbutton},
+ {"rtl_logo", XC_rtl_logo},
+ {"sailboat", XC_sailboat},
+ {"sb_down_arrow", XC_sb_down_arrow},
+ {"sb_h_double_arrow", XC_sb_h_double_arrow},
+ {"sb_left_arrow", XC_sb_left_arrow},
+ {"sb_right_arrow", XC_sb_right_arrow},
+ {"sb_up_arrow", XC_sb_up_arrow},
+ {"sb_v_double_arrow", XC_sb_v_double_arrow},
+ {"shuttle", XC_shuttle},
+ {"sizing", XC_sizing},
+ {"spider", XC_spider},
+ {"spraycan", XC_spraycan},
+ {"star", XC_star},
+ {"target", XC_target},
+ {"tcross", XC_tcross},
+ {"top_left_arrow", XC_top_left_arrow},
+ {"top_left_corner", XC_top_left_corner},
+ {"top_right_corner", XC_top_right_corner},
+ {"top_side", XC_top_side},
+ {"top_tee", XC_top_tee},
+ {"trek", XC_trek},
+ {"ul_angle", XC_ul_angle},
+ {"umbrella", XC_umbrella},
+ {"ur_angle", XC_ur_angle},
+ {"watch", XC_watch},
+ {"xterm", XC_xterm},
+ {NULL, 0}
+};
+
+/*
+ * Font to use for cursors:
+ */
+
+#ifndef CURSORFONT
+#define CURSORFONT "cursor"
+#endif
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetCursorByName --
+ *
+ * Retrieve a cursor by name. Parse the cursor name into fields
+ * and create a cursor, either from the standard cursor font or
+ * from bitmap files.
+ *
+ * Results:
+ * Returns a new cursor, or NULL on errors.
+ *
+ * Side effects:
+ * Allocates a new cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkCursor *
+TkGetCursorByName(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. */
+{
+ TkUnixCursor *cursorPtr = NULL;
+ Cursor cursor = None;
+ int argc;
+ char **argv = NULL;
+ Pixmap source = None;
+ Pixmap mask = None;
+ Display *display = Tk_Display(tkwin);
+
+ if (Tcl_SplitList(interp, string, &argc, &argv) != TCL_OK) {
+ return NULL;
+ }
+ if (argc == 0) {
+ goto badString;
+ }
+ if (argv[0][0] != '@') {
+ XColor fg, bg;
+ unsigned int maskIndex;
+ register struct CursorName *namePtr;
+ TkDisplay *dispPtr;
+
+ /*
+ * The cursor is to come from the standard cursor font. If one
+ * arg, it is cursor name (use black and white for fg and bg).
+ * If two args, they are name and fg color (ignore mask). If
+ * three args, they are name, fg, bg. Some of the code below
+ * is stolen from the XCreateFontCursor Xlib procedure.
+ */
+
+ if (argc > 3) {
+ goto badString;
+ }
+ for (namePtr = cursorNames; ; namePtr++) {
+ if (namePtr->name == NULL) {
+ goto badString;
+ }
+ if ((namePtr->name[0] == argv[0][0])
+ && (strcmp(namePtr->name, argv[0]) == 0)) {
+ break;
+ }
+ }
+ maskIndex = namePtr->shape + 1;
+ if (argc == 1) {
+ fg.red = fg.green = fg.blue = 0;
+ bg.red = bg.green = bg.blue = 65535;
+ } else {
+ if (XParseColor(display, Tk_Colormap(tkwin), argv[1],
+ &fg) == 0) {
+ Tcl_AppendResult(interp, "invalid color name \"", argv[1],
+ "\"", (char *) NULL);
+ goto cleanup;
+ }
+ if (argc == 2) {
+ bg.red = bg.green = bg.blue = 0;
+ maskIndex = namePtr->shape;
+ } else {
+ if (XParseColor(display, Tk_Colormap(tkwin), argv[2],
+ &bg) == 0) {
+ Tcl_AppendResult(interp, "invalid color name \"", argv[2],
+ "\"", (char *) NULL);
+ goto cleanup;
+ }
+ }
+ }
+ 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 {
+ int width, height, maskWidth, maskHeight;
+ int xHot, yHot, dummy1, dummy2;
+ XColor fg, bg;
+
+ /*
+ * Prevent file system access in safe interpreters.
+ */
+
+ if (Tcl_IsSafe(interp)) {
+ Tcl_AppendResult(interp, "can't get cursor from a file in",
+ " a safe interpreter", (char *) NULL);
+ cursorPtr = NULL;
+ goto cleanup;
+ }
+
+ /*
+ * The cursor is to be created by reading bitmap files. There
+ * 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;
+ }
+ if ((xHot < 0) || (yHot < 0) || (xHot >= width) || (yHot >= height)) {
+ Tcl_AppendResult(interp, "bad hot spot in bitmap file \"",
+ &argv[0][1], "\"", (char *) NULL);
+ goto cleanup;
+ }
+ if (argc == 2) {
+ if (XParseColor(display, Tk_Colormap(tkwin), argv[1],
+ &fg) == 0) {
+ 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)) {
+ 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;
+ }
+ if (XParseColor(display, Tk_Colormap(tkwin), argv[3],
+ &bg) == 0) {
+ Tcl_AppendResult(interp, "invalid color name \"", argv[3],
+ "\"", (char *) NULL);
+ goto cleanup;
+ }
+ cursor = XCreatePixmapCursor(display, source, mask,
+ &fg, &bg, (unsigned) xHot, (unsigned) yHot);
+ }
+ }
+
+ if (cursor != None) {
+ cursorPtr = (TkUnixCursor *) ckalloc(sizeof(TkUnixCursor));
+ cursorPtr->info.cursor = (Tk_Cursor) cursor;
+ cursorPtr->display = display;
+ }
+
+ cleanup:
+ if (argv != NULL) {
+ ckfree((char *) argv);
+ }
+ if (source != None) {
+ Tk_FreePixmap(display, source);
+ }
+ if (mask != None) {
+ Tk_FreePixmap(display, mask);
+ }
+ return (TkCursor *) cursorPtr;
+
+
+ badString:
+ Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"",
+ (char *) NULL);
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCreateCursorFromData --
+ *
+ * Creates a cursor from the source and mask bits.
+ *
+ * Results:
+ * Returns a new cursor, or NULL on errors.
+ *
+ * Side effects:
+ * Allocates a new cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkCursor *
+TkCreateCursorFromData(tkwin, source, mask, width, height, xHot, yHot,
+ fgColor, bgColor)
+ Tk_Window tkwin; /* Window in which cursor will be used. */
+ char *source; /* Bitmap data for cursor shape. */
+ char *mask; /* Bitmap data for cursor mask. */
+ int width, height; /* Dimensions of cursor. */
+ int xHot, yHot; /* Location of hot-spot in cursor. */
+ XColor fgColor; /* Foreground color for cursor. */
+ XColor bgColor; /* Background color for cursor. */
+{
+ Cursor cursor;
+ Pixmap sourcePixmap, maskPixmap;
+ TkUnixCursor *cursorPtr = NULL;
+ Display *display = Tk_Display(tkwin);
+
+ sourcePixmap = XCreateBitmapFromData(display,
+ RootWindowOfScreen(Tk_Screen(tkwin)), source, (unsigned) width,
+ (unsigned) height);
+ maskPixmap = XCreateBitmapFromData(display,
+ RootWindowOfScreen(Tk_Screen(tkwin)), mask, (unsigned) width,
+ (unsigned) height);
+ cursor = XCreatePixmapCursor(display, sourcePixmap,
+ maskPixmap, &fgColor, &bgColor, (unsigned) xHot, (unsigned) yHot);
+ Tk_FreePixmap(display, sourcePixmap);
+ Tk_FreePixmap(display, maskPixmap);
+
+ if (cursor != None) {
+ cursorPtr = (TkUnixCursor *) ckalloc(sizeof(TkUnixCursor));
+ cursorPtr->info.cursor = (Tk_Cursor) cursor;
+ cursorPtr->display = display;
+ }
+ 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);
+}
diff --git a/tk/unix/tkUnixDefault.h b/tk/unix/tkUnixDefault.h
new file mode 100644
index 00000000000..bc9e0ac8ea8
--- /dev/null
+++ b/tk/unix/tkUnixDefault.h
@@ -0,0 +1,451 @@
+/*
+ * 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$
+ */
+
+#ifndef _TKUNIXDEFAULT
+#define _TKUNIXDEFAULT
+
+/*
+ * The definitions below provide symbolic names for the default colors.
+ * NORMAL_BG - Normal background color.
+ * ACTIVE_BG - Background color when widget is active.
+ * SELECT_BG - Background color for selected text.
+ * TROUGH - Background color for troughs in scales and scrollbars.
+ * INDICATOR - Color for indicator when button is selected.
+ * DISABLED - Foreground color when widget is disabled.
+ */
+
+#define BLACK "Black"
+#define WHITE "White"
+
+#define NORMAL_BG "#d9d9d9"
+#define ACTIVE_BG "#ececec"
+#define SELECT_BG "#c3c3c3"
+#define TROUGH "#c3c3c3"
+#define INDICATOR "#b03060"
+#define DISABLED "#a3a3a3"
+
+/*
+ * Defaults for labels, buttons, checkbuttons, and radiobuttons:
+ */
+
+#define DEF_BUTTON_ANCHOR "center"
+#define DEF_BUTTON_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_BUTTON_ACTIVE_BG_MONO BLACK
+#define DEF_BUTTON_ACTIVE_FG_COLOR BLACK
+#define DEF_CHKRAD_ACTIVE_FG_COLOR DEF_BUTTON_ACTIVE_FG_COLOR
+#define DEF_BUTTON_ACTIVE_FG_MONO WHITE
+#define DEF_BUTTON_BG_COLOR NORMAL_BG
+#define DEF_BUTTON_BG_MONO WHITE
+#define DEF_BUTTON_BITMAP ""
+#define DEF_BUTTON_BORDER_WIDTH "2"
+#define DEF_BUTTON_CURSOR ""
+#define DEF_BUTTON_COMMAND ""
+#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"
+#define DEF_BUTTON_ON_VALUE "1"
+#define DEF_BUTTON_PADX "3m"
+#define DEF_LABCHKRAD_PADX "1"
+#define DEF_BUTTON_PADY "1m"
+#define DEF_LABCHKRAD_PADY "1"
+#define DEF_BUTTON_RELIEF "raised"
+#define DEF_LABCHKRAD_RELIEF "flat"
+#define DEF_BUTTON_SELECT_COLOR INDICATOR
+#define DEF_BUTTON_SELECT_MONO BLACK
+#define DEF_BUTTON_SELECT_IMAGE (char *) NULL
+#define DEF_BUTTON_STATE "normal"
+#define DEF_LABEL_TAKE_FOCUS "0"
+#define DEF_BUTTON_TAKE_FOCUS (char *) NULL
+#define DEF_BUTTON_TEXT ""
+#define DEF_BUTTON_TEXT_VARIABLE ""
+#define DEF_BUTTON_UNDERLINE "-1"
+#define DEF_BUTTON_VALUE ""
+#define DEF_BUTTON_WIDTH "0"
+#define DEF_BUTTON_WRAP_LENGTH "0"
+#define DEF_RADIOBUTTON_VARIABLE "selectedButton"
+#define DEF_CHECKBUTTON_VARIABLE ""
+
+/*
+ * Defaults for canvases:
+ */
+
+#define DEF_CANVAS_BG_COLOR NORMAL_BG
+#define DEF_CANVAS_BG_MONO WHITE
+#define DEF_CANVAS_BORDER_WIDTH "0"
+#define DEF_CANVAS_CLOSE_ENOUGH "1"
+#define DEF_CANVAS_CONFINE "1"
+#define DEF_CANVAS_CURSOR ""
+#define DEF_CANVAS_HEIGHT "7c"
+#define DEF_CANVAS_HIGHLIGHT_BG NORMAL_BG
+#define DEF_CANVAS_HIGHLIGHT BLACK
+#define DEF_CANVAS_HIGHLIGHT_WIDTH "1"
+#define DEF_CANVAS_INSERT_BG BLACK
+#define DEF_CANVAS_INSERT_BD_COLOR "0"
+#define DEF_CANVAS_INSERT_BD_MONO "0"
+#define DEF_CANVAS_INSERT_OFF_TIME "300"
+#define DEF_CANVAS_INSERT_ON_TIME "600"
+#define DEF_CANVAS_INSERT_WIDTH "2"
+#define DEF_CANVAS_RELIEF "flat"
+#define DEF_CANVAS_SCROLL_REGION ""
+#define DEF_CANVAS_SELECT_COLOR SELECT_BG
+#define DEF_CANVAS_SELECT_MONO BLACK
+#define DEF_CANVAS_SELECT_BD_COLOR "1"
+#define DEF_CANVAS_SELECT_BD_MONO "0"
+#define DEF_CANVAS_SELECT_FG_COLOR BLACK
+#define DEF_CANVAS_SELECT_FG_MONO WHITE
+#define DEF_CANVAS_TAKE_FOCUS (char *) NULL
+#define DEF_CANVAS_WIDTH "10c"
+#define DEF_CANVAS_X_SCROLL_CMD ""
+#define DEF_CANVAS_X_SCROLL_INCREMENT "0"
+#define DEF_CANVAS_Y_SCROLL_CMD ""
+#define DEF_CANVAS_Y_SCROLL_INCREMENT "0"
+
+/*
+ * Defaults for entries:
+ */
+
+#define DEF_ENTRY_BG_COLOR NORMAL_BG
+#define DEF_ENTRY_BG_MONO WHITE
+#define DEF_ENTRY_BORDER_WIDTH "2"
+#define DEF_ENTRY_CURSOR "xterm"
+#define DEF_ENTRY_EXPORT_SELECTION "1"
+#define DEF_ENTRY_FONT "Helvetica -12"
+#define DEF_ENTRY_FG BLACK
+#define DEF_ENTRY_HIGHLIGHT_BG NORMAL_BG
+#define DEF_ENTRY_HIGHLIGHT BLACK
+#define DEF_ENTRY_HIGHLIGHT_WIDTH "1"
+#define DEF_ENTRY_INSERT_BG BLACK
+#define DEF_ENTRY_INSERT_BD_COLOR "0"
+#define DEF_ENTRY_INSERT_BD_MONO "0"
+#define DEF_ENTRY_INSERT_OFF_TIME "300"
+#define DEF_ENTRY_INSERT_ON_TIME "600"
+#define DEF_ENTRY_INSERT_WIDTH "2"
+#define DEF_ENTRY_JUSTIFY "left"
+#define DEF_ENTRY_RELIEF "sunken"
+#define DEF_ENTRY_SCROLL_COMMAND ""
+#define DEF_ENTRY_SELECT_COLOR SELECT_BG
+#define DEF_ENTRY_SELECT_MONO BLACK
+#define DEF_ENTRY_SELECT_BD_COLOR "1"
+#define DEF_ENTRY_SELECT_BD_MONO "0"
+#define DEF_ENTRY_SELECT_FG_COLOR BLACK
+#define DEF_ENTRY_SELECT_FG_MONO WHITE
+#define DEF_ENTRY_SHOW (char *) NULL
+#define DEF_ENTRY_STATE "normal"
+#define DEF_ENTRY_TAKE_FOCUS (char *) NULL
+#define DEF_ENTRY_TEXT_VARIABLE ""
+#define DEF_ENTRY_WIDTH "20"
+
+/*
+ * Defaults for frames:
+ */
+
+#define DEF_FRAME_BG_COLOR NORMAL_BG
+#define DEF_FRAME_BG_MONO WHITE
+#define DEF_FRAME_BORDER_WIDTH "0"
+#define DEF_FRAME_CLASS "Frame"
+#define DEF_FRAME_COLORMAP ""
+#define DEF_FRAME_CONTAINER "0"
+#define DEF_FRAME_CURSOR ""
+#define DEF_FRAME_HEIGHT "0"
+#define DEF_FRAME_HIGHLIGHT_BG NORMAL_BG
+#define DEF_FRAME_HIGHLIGHT BLACK
+#define DEF_FRAME_HIGHLIGHT_WIDTH "0"
+#define DEF_FRAME_RELIEF "flat"
+#define DEF_FRAME_TAKE_FOCUS "0"
+#define DEF_FRAME_USE ""
+#define DEF_FRAME_VISUAL ""
+#define DEF_FRAME_WIDTH "0"
+
+/*
+ * Defaults for listboxes:
+ */
+
+#define DEF_LISTBOX_BG_COLOR NORMAL_BG
+#define DEF_LISTBOX_BG_MONO WHITE
+#define DEF_LISTBOX_BORDER_WIDTH "2"
+#define DEF_LISTBOX_CURSOR ""
+#define DEF_LISTBOX_EXPORT_SELECTION "1"
+#define DEF_LISTBOX_FONT "Helvetica -12 bold"
+#define DEF_LISTBOX_FG BLACK
+#define DEF_LISTBOX_HEIGHT "10"
+#define DEF_LISTBOX_HIGHLIGHT_BG NORMAL_BG
+#define DEF_LISTBOX_HIGHLIGHT BLACK
+#define DEF_LISTBOX_HIGHLIGHT_WIDTH "1"
+#define DEF_LISTBOX_RELIEF "sunken"
+#define DEF_LISTBOX_SCROLL_COMMAND ""
+#define DEF_LISTBOX_SELECT_COLOR SELECT_BG
+#define DEF_LISTBOX_SELECT_MONO BLACK
+#define DEF_LISTBOX_SELECT_BD "1"
+#define DEF_LISTBOX_SELECT_FG_COLOR BLACK
+#define DEF_LISTBOX_SELECT_FG_MONO WHITE
+#define DEF_LISTBOX_SELECT_MODE "browse"
+#define DEF_LISTBOX_SET_GRID "0"
+#define DEF_LISTBOX_TAKE_FOCUS (char *) NULL
+#define DEF_LISTBOX_WIDTH "20"
+
+/*
+ * Defaults for individual entries of menus:
+ */
+
+#define DEF_MENU_ENTRY_ACTIVE_BG (char *) NULL
+#define DEF_MENU_ENTRY_ACTIVE_FG (char *) NULL
+#define DEF_MENU_ENTRY_ACCELERATOR (char *) NULL
+#define DEF_MENU_ENTRY_BG (char *) NULL
+#define DEF_MENU_ENTRY_BITMAP None
+#define DEF_MENU_ENTRY_COLUMN_BREAK "0"
+#define DEF_MENU_ENTRY_COMMAND (char *) NULL
+#define DEF_MENU_ENTRY_FG (char *) NULL
+#define DEF_MENU_ENTRY_FONT (char *) NULL
+#define DEF_MENU_ENTRY_HIDE_MARGIN "0"
+#define DEF_MENU_ENTRY_IMAGE (char *) NULL
+#define DEF_MENU_ENTRY_INDICATOR "1"
+#define DEF_MENU_ENTRY_LABEL (char *) NULL
+#define DEF_MENU_ENTRY_MENU (char *) NULL
+#define DEF_MENU_ENTRY_OFF_VALUE "0"
+#define DEF_MENU_ENTRY_ON_VALUE "1"
+#define DEF_MENU_ENTRY_SELECT_IMAGE (char *) NULL
+#define DEF_MENU_ENTRY_STATE "normal"
+#define DEF_MENU_ENTRY_VALUE (char *) NULL
+#define DEF_MENU_ENTRY_CHECK_VARIABLE (char *) NULL
+#define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton"
+#define DEF_MENU_ENTRY_SELECT (char *) NULL
+#define DEF_MENU_ENTRY_UNDERLINE "-1"
+
+/*
+ * Defaults for menus overall:
+ */
+
+#define DEF_MENU_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_MENU_ACTIVE_BG_MONO BLACK
+#define DEF_MENU_ACTIVE_BORDER_WIDTH "2"
+#define DEF_MENU_ACTIVE_FG_COLOR BLACK
+#define DEF_MENU_ACTIVE_FG_MONO WHITE
+#define DEF_MENU_BG_COLOR NORMAL_BG
+#define DEF_MENU_BG_MONO WHITE
+#define DEF_MENU_BORDER_WIDTH "2"
+#define DEF_MENU_CURSOR "arrow"
+#define DEF_MENU_DISABLED_FG_COLOR DISABLED
+#define DEF_MENU_DISABLED_FG_MONO ""
+#define DEF_MENU_FONT "Helvetica -12 bold"
+#define DEF_MENU_FG BLACK
+#define DEF_MENU_POST_COMMAND ""
+#define DEF_MENU_RELIEF "raised"
+#define DEF_MENU_SELECT_COLOR INDICATOR
+#define DEF_MENU_SELECT_MONO BLACK
+#define DEF_MENU_TAKE_FOCUS "0"
+#define DEF_MENU_TEAROFF "1"
+#define DEF_MENU_TEAROFF_CMD (char *) NULL
+#define DEF_MENU_TITLE ""
+#define DEF_MENU_TYPE "normal"
+
+/*
+ * Defaults for menubuttons:
+ */
+
+#define DEF_MENUBUTTON_ANCHOR "center"
+#define DEF_MENUBUTTON_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_MENUBUTTON_ACTIVE_BG_MONO BLACK
+#define DEF_MENUBUTTON_ACTIVE_FG_COLOR BLACK
+#define DEF_MENUBUTTON_ACTIVE_FG_MONO WHITE
+#define DEF_MENUBUTTON_BG_COLOR NORMAL_BG
+#define DEF_MENUBUTTON_BG_MONO WHITE
+#define DEF_MENUBUTTON_BITMAP ""
+#define DEF_MENUBUTTON_BORDER_WIDTH "2"
+#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"
+#define DEF_MENUBUTTON_PADY "3p"
+#define DEF_MENUBUTTON_RELIEF "flat"
+#define DEF_MENUBUTTON_STATE "normal"
+#define DEF_MENUBUTTON_TAKE_FOCUS "0"
+#define DEF_MENUBUTTON_TEXT ""
+#define DEF_MENUBUTTON_TEXT_VARIABLE ""
+#define DEF_MENUBUTTON_UNDERLINE "-1"
+#define DEF_MENUBUTTON_WIDTH "0"
+#define DEF_MENUBUTTON_WRAP_LENGTH "0"
+
+/*
+ * Defaults for messages:
+ */
+
+#define DEF_MESSAGE_ANCHOR "center"
+#define DEF_MESSAGE_ASPECT "150"
+#define DEF_MESSAGE_BG_COLOR NORMAL_BG
+#define DEF_MESSAGE_BG_MONO WHITE
+#define DEF_MESSAGE_BORDER_WIDTH "2"
+#define DEF_MESSAGE_CURSOR ""
+#define DEF_MESSAGE_FG BLACK
+#define DEF_MESSAGE_FONT "Helvetica -12 bold"
+#define DEF_MESSAGE_HIGHLIGHT_BG NORMAL_BG
+#define DEF_MESSAGE_HIGHLIGHT BLACK
+#define DEF_MESSAGE_HIGHLIGHT_WIDTH "0"
+#define DEF_MESSAGE_JUSTIFY "left"
+#define DEF_MESSAGE_PADX "-1"
+#define DEF_MESSAGE_PADY "-1"
+#define DEF_MESSAGE_RELIEF "flat"
+#define DEF_MESSAGE_TAKE_FOCUS "0"
+#define DEF_MESSAGE_TEXT ""
+#define DEF_MESSAGE_TEXT_VARIABLE ""
+#define DEF_MESSAGE_WIDTH "0"
+
+/*
+ * Defaults for scales:
+ */
+
+#define DEF_SCALE_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_SCALE_ACTIVE_BG_MONO BLACK
+#define DEF_SCALE_BG_COLOR NORMAL_BG
+#define DEF_SCALE_BG_MONO WHITE
+#define DEF_SCALE_BIG_INCREMENT "0"
+#define DEF_SCALE_BORDER_WIDTH "2"
+#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"
+#define DEF_SCALE_STATE "normal"
+#define DEF_SCALE_TAKE_FOCUS (char *) NULL
+#define DEF_SCALE_TICK_INTERVAL "0"
+#define DEF_SCALE_TO "100"
+#define DEF_SCALE_VARIABLE ""
+#define DEF_SCALE_WIDTH "15"
+
+/*
+ * Defaults for scrollbars:
+ */
+
+#define DEF_SCROLLBAR_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_SCROLLBAR_ACTIVE_BG_MONO BLACK
+#define DEF_SCROLLBAR_ACTIVE_RELIEF "raised"
+#define DEF_SCROLLBAR_BG_COLOR NORMAL_BG
+#define DEF_SCROLLBAR_BG_MONO WHITE
+#define DEF_SCROLLBAR_BORDER_WIDTH "2"
+#define DEF_SCROLLBAR_COMMAND ""
+#define DEF_SCROLLBAR_CURSOR ""
+#define DEF_SCROLLBAR_EL_BORDER_WIDTH "-1"
+#define DEF_SCROLLBAR_HIGHLIGHT_BG NORMAL_BG
+#define DEF_SCROLLBAR_HIGHLIGHT BLACK
+#define DEF_SCROLLBAR_HIGHLIGHT_WIDTH "1"
+#define DEF_SCROLLBAR_JUMP "0"
+#define DEF_SCROLLBAR_ORIENT "vertical"
+#define DEF_SCROLLBAR_RELIEF "sunken"
+#define DEF_SCROLLBAR_REPEAT_DELAY "300"
+#define DEF_SCROLLBAR_REPEAT_INTERVAL "100"
+#define DEF_SCROLLBAR_TAKE_FOCUS (char *) NULL
+#define DEF_SCROLLBAR_TROUGH_COLOR TROUGH
+#define DEF_SCROLLBAR_TROUGH_MONO WHITE
+#define DEF_SCROLLBAR_WIDTH "15"
+
+/*
+ * Defaults for texts:
+ */
+
+#define DEF_TEXT_BG_COLOR NORMAL_BG
+#define DEF_TEXT_BG_MONO WHITE
+#define DEF_TEXT_BORDER_WIDTH "2"
+#define DEF_TEXT_CURSOR "xterm"
+#define DEF_TEXT_FG BLACK
+#define DEF_TEXT_EXPORT_SELECTION "1"
+#define DEF_TEXT_FONT "Courier -12"
+#define DEF_TEXT_HEIGHT "24"
+#define DEF_TEXT_HIGHLIGHT_BG NORMAL_BG
+#define DEF_TEXT_HIGHLIGHT BLACK
+#define DEF_TEXT_HIGHLIGHT_WIDTH "1"
+#define DEF_TEXT_INSERT_BG BLACK
+#define DEF_TEXT_INSERT_BD_COLOR "0"
+#define DEF_TEXT_INSERT_BD_MONO "0"
+#define DEF_TEXT_INSERT_OFF_TIME "300"
+#define DEF_TEXT_INSERT_ON_TIME "600"
+#define DEF_TEXT_INSERT_WIDTH "2"
+#define DEF_TEXT_PADX "1"
+#define DEF_TEXT_PADY "1"
+#define DEF_TEXT_RELIEF "sunken"
+#define DEF_TEXT_SELECT_COLOR SELECT_BG
+#define DEF_TEXT_SELECT_MONO BLACK
+#define DEF_TEXT_SELECT_BD_COLOR "1"
+#define DEF_TEXT_SELECT_BD_MONO "0"
+#define DEF_TEXT_SELECT_FG_COLOR BLACK
+#define DEF_TEXT_SELECT_FG_MONO WHITE
+#define DEF_TEXT_SELECT_RELIEF "raised"
+#define DEF_TEXT_SET_GRID "0"
+#define DEF_TEXT_SPACING1 "0"
+#define DEF_TEXT_SPACING2 "0"
+#define DEF_TEXT_SPACING3 "0"
+#define DEF_TEXT_STATE "normal"
+#define DEF_TEXT_TABS ""
+#define DEF_TEXT_TAKE_FOCUS (char *) NULL
+#define DEF_TEXT_WIDTH "80"
+#define DEF_TEXT_WRAP "char"
+#define DEF_TEXT_XSCROLL_COMMAND ""
+#define DEF_TEXT_YSCROLL_COMMAND ""
+#define DEF_TEXT_TAB_SIZE "8"
+
+/*
+ * Defaults for canvas text:
+ */
+
+#define DEF_CANVTEXT_FONT "Helvetica -12"
+
+/*
+ * Defaults for toplevels (most of the defaults for frames also apply
+ * to toplevels):
+ */
+
+#define DEF_TOPLEVEL_CLASS "Toplevel"
+#define DEF_TOPLEVEL_MENU ""
+#define DEF_TOPLEVEL_SCREEN ""
+
+#endif /* _TKUNIXDEFAULT */
diff --git a/tk/unix/tkUnixDialog.c b/tk/unix/tkUnixDialog.c
new file mode 100644
index 00000000000..81bcb840759
--- /dev/null
+++ b/tk/unix/tkUnixDialog.c
@@ -0,0 +1,210 @@
+/*
+ * 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$
+ *
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkUnixInt.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 Unix
+ * 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. */
+{
+ return EvalArgv(interp, "tkColorDialog", argc, argv);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetOpenFileCmd --
+ *
+ * This procedure implements the "open file" dialog box for the
+ * Unix 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 SN_donot_call_motif_filedialog_box = 0;
+
+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. */
+{
+ Tk_Window tkwin = (Tk_Window)clientData;
+
+ /* Don't use motif dialog box */
+ if (SN_donot_call_motif_filedialog_box == 0 && Tk_StrictMotif(tkwin)) {
+ return EvalArgv(interp, "tkMotifFDialog", argc, argv);
+ } else {
+ return EvalArgv(interp, "tkFDialog", argc, argv);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. */
+{
+ Tk_Window tkwin = (Tk_Window)clientData;
+
+ /* Don't use motif dialog box */
+ if (SN_donot_call_motif_filedialog_box == 0 && Tk_StrictMotif(tkwin)) {
+ return EvalArgv(interp, "tkMotifFDialog", argc, argv);
+ } else {
+ return EvalArgv(interp, "tkFDialog", argc, argv);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MessageBoxCmd --
+ *
+ * This procedure implements the MessageBox window for the
+ * Unix 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. */
+{
+ return EvalArgv(interp, "tkMessageBox", argc, argv);
+}
+
diff --git a/tk/unix/tkUnixDraw.c b/tk/unix/tkUnixDraw.c
new file mode 100644
index 00000000000..42aa3560b88
--- /dev/null
+++ b/tk/unix/tkUnixDraw.c
@@ -0,0 +1,171 @@
+/*
+ * 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$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+/*
+ * The following structure is used to pass information to
+ * ScrollRestrictProc from TkScrollWindow.
+ */
+
+typedef struct ScrollInfo {
+ int done; /* Flag is 0 until filtering is done. */
+ Display *display; /* Display to filter. */
+ Window window; /* Window to filter. */
+ TkRegion region; /* Region into which damage is accumulated. */
+ int dx, dy; /* Amount by which window was shifted. */
+} ScrollInfo;
+
+/*
+ * Forward declarations for procedures declared later in this file:
+ */
+
+static Tk_RestrictAction ScrollRestrictProc _ANSI_ARGS_((
+ ClientData arg, XEvent *eventPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkScrollWindow --
+ *
+ * Scroll a rectangle of the specified window and accumulate
+ * damage information in the specified Region.
+ *
+ * Results:
+ * Returns 0 if no damage additional damage was generated. Sets
+ * damageRgn to contain the damaged areas and returns 1 if
+ * GraphicsExpose events were detected.
+ *
+ * Side effects:
+ * Scrolls the bits in the window and enters the event loop
+ * looking for damage events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkScrollWindow(tkwin, gc, x, y, width, height, dx, dy, damageRgn)
+ Tk_Window tkwin; /* The window to be scrolled. */
+ GC gc; /* GC for window to be scrolled. */
+ int x, y, width, height; /* Position rectangle to be scrolled. */
+ int dx, dy; /* Distance rectangle should be moved. */
+ TkRegion damageRgn; /* Region to accumulate damage in. */
+{
+ Tk_RestrictProc *oldProc;
+ ClientData oldArg, dummy;
+ ScrollInfo info;
+
+ XCopyArea(Tk_Display(tkwin), Tk_WindowId(tkwin), Tk_WindowId(tkwin), gc,
+ x, y, (unsigned int) width, (unsigned int) height, x + dx, y + dy);
+
+ info.done = 0;
+ info.window = Tk_WindowId(tkwin);
+ info.display = Tk_Display(tkwin);
+ info.region = damageRgn;
+ info.dx = dx;
+ info.dy = dy;
+
+ /*
+ * Sync the event stream so all of the expose events will be on the
+ * Tk event queue before we start filtering. This avoids busy waiting
+ * while we filter events.
+ */
+
+ TkpSync(info.display);
+ oldProc = Tk_RestrictEvents(ScrollRestrictProc, (ClientData) &info,
+ &oldArg);
+ while (!info.done) {
+ Tcl_ServiceEvent(TCL_WINDOW_EVENTS);
+ }
+ Tk_RestrictEvents(oldProc, oldArg, &dummy);
+
+ return XEmptyRegion((Region) damageRgn) ? 0 : 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScrollRestrictProc --
+ *
+ * A Tk_RestrictProc used by TkScrollWindow to gather up Expose
+ * information into a single damage region. It accumulates damage
+ * events on the specified window until a NoExpose or the last
+ * GraphicsExpose event is detected.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Discards Expose events after accumulating damage information
+ * for a particular window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_RestrictAction
+ScrollRestrictProc(arg, eventPtr)
+ ClientData arg;
+ XEvent *eventPtr;
+{
+ ScrollInfo *info = (ScrollInfo *) arg;
+ XRectangle rect;
+
+ /*
+ * Defer events which aren't for the specified window.
+ */
+
+ if (info->done || (eventPtr->xany.display != info->display)
+ || (eventPtr->xany.window != info->window)) {
+ return TK_DEFER_EVENT;
+ }
+
+ if (eventPtr->type == NoExpose) {
+ info->done = 1;
+ } else if (eventPtr->type == GraphicsExpose) {
+ rect.x = eventPtr->xgraphicsexpose.x;
+ rect.y = eventPtr->xgraphicsexpose.y;
+ rect.width = eventPtr->xgraphicsexpose.width;
+ rect.height = eventPtr->xgraphicsexpose.height;
+ XUnionRectWithRegion(&rect, (Region) info->region,
+ (Region) info->region);
+
+ if (eventPtr->xgraphicsexpose.count == 0) {
+ info->done = 1;
+ }
+ } else if (eventPtr->type == Expose) {
+
+ /*
+ * This case is tricky. This event was already queued before
+ * the XCopyArea was issued. If this area overlaps the area
+ * being copied, then some of the copied area may be invalid.
+ * The easiest way to handle this case is to mark both the
+ * original area and the shifted area as damaged.
+ */
+
+ rect.x = eventPtr->xexpose.x;
+ rect.y = eventPtr->xexpose.y;
+ rect.width = eventPtr->xexpose.width;
+ rect.height = eventPtr->xexpose.height;
+ XUnionRectWithRegion(&rect, (Region) info->region,
+ (Region) info->region);
+ rect.x += info->dx;
+ rect.y += info->dy;
+ XUnionRectWithRegion(&rect, (Region) info->region,
+ (Region) info->region);
+ } else {
+ return TK_DEFER_EVENT;
+ }
+ return TK_DISCARD_EVENT;
+}
+
diff --git a/tk/unix/tkUnixEmbed.c b/tk/unix/tkUnixEmbed.c
new file mode 100644
index 00000000000..fb8fe3f5679
--- /dev/null
+++ b/tk/unix/tkUnixEmbed.c
@@ -0,0 +1,1001 @@
+/*
+ * 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$
+ */
+
+#include "tkInt.h"
+#include "tkUnixInt.h"
+
+/*
+ * One of the following structures exists for each container in this
+ * application. It keeps track of the container window and its
+ * associated embedded window.
+ */
+
+typedef struct Container {
+ Window parent; /* X's window id for the parent of
+ * the pair (the container). */
+ Window parentRoot; /* Id for the root window of parent's
+ * screen. */
+ TkWindow *parentPtr; /* Tk's information about the container,
+ * or NULL if the container isn't
+ * in this process. */
+ Window wrapper; /* X's window id for the wrapper
+ * window for the embedded window.
+ * Starts off as None, but gets
+ * filled in when the window is
+ * eventually created. */
+ TkWindow *embeddedPtr; /* Tk's information about the embedded
+ * window, or NULL if the embedded
+ * application isn't in this process.
+ * 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));
+static void EmbeddedEventProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static int EmbedErrorProc _ANSI_ARGS_((ClientData clientData,
+ XErrorEvent *errEventPtr));
+static void EmbedFocusProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void EmbedGeometryRequest _ANSI_ARGS_((
+ 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));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpUseWindow --
+ *
+ * This procedure causes a Tk window to use a given X window as
+ * 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".
+ *
+ *----------------------------------------------------------------------
+ */
+
+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, 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;
+ }
+ parent = (Window) id;
+
+ /*
+ * Tk sets the window colormap to the screen default colormap in
+ * tkWindow.c:AllocWindow. This doesn't work well for embedded
+ * windows. So we override the colormap and visual settings to be
+ * the same as the parent window (which is in the container app).
+ */
+
+ anyError = 0;
+ handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1,
+ EmbedErrorProc, (ClientData) &anyError);
+ if (!XGetWindowAttributes(winPtr->display, parent, &parentAtts)) {
+ anyError = 1;
+ }
+ XSync(winPtr->display, False);
+ Tk_DeleteErrorHandler(handler);
+ if (anyError) {
+ if (interp != NULL) {
+ Tcl_AppendResult(interp, "couldn't create child of window \"",
+ string, "\"", (char *) NULL);
+ }
+ return TCL_ERROR;
+ }
+ Tk_SetWindowVisual(tkwin, parentAtts.visual, parentAtts.depth,
+ parentAtts.colormap);
+
+ /*
+ * Create an event handler to clean up the Container structure when
+ * tkwin is eventually deleted.
+ */
+
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask, EmbeddedEventProc,
+ (ClientData) winPtr);
+
+ /*
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMakeWindow --
+ *
+ * Create an actual window system window object based on the
+ * current attributes of the specified TkWindow.
+ *
+ * Results:
+ * Returns the handle to the new window, or None on failure.
+ *
+ * Side effects:
+ * Creates a new X window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Window
+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;
+ }
+ }
+ parent = containerPtr->parentRoot;
+ }
+
+ return XCreateWindow(winPtr->display, parent, winPtr->changes.x,
+ winPtr->changes.y, (unsigned) winPtr->changes.width,
+ (unsigned) winPtr->changes.height,
+ (unsigned) winPtr->changes.border_width, winPtr->depth,
+ InputOutput, winPtr->visual, winPtr->dirtyAtts,
+ &winPtr->atts);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMakeContainer --
+ *
+ * This procedure is called to indicate that a particular window
+ * will be a container for an embedded application. This changes
+ * certain aspects of the window's behavior, such as whether it
+ * will receive events anymore.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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.
+ */
+
+ winPtr->atts.event_mask |= SubstructureRedirectMask|SubstructureNotifyMask;
+ XSelectInput(winPtr->display, winPtr->window, winPtr->atts.event_mask);
+ Tk_CreateEventHandler(tkwin,
+ SubstructureNotifyMask|SubstructureRedirectMask,
+ ContainerEventProc, (ClientData) winPtr);
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask, EmbedStructureProc,
+ (ClientData) containerPtr);
+ Tk_CreateEventHandler(tkwin, FocusChangeMask, EmbedFocusProc,
+ (ClientData) containerPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedErrorProc --
+ *
+ * This procedure is invoked if an error occurs while creating
+ * an embedded window.
+ *
+ * Results:
+ * Always returns 0 to indicate that the error has been properly
+ * handled.
+ *
+ * Side effects:
+ * The integer pointed to by the clientData argument is set to 1.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+EmbedErrorProc(clientData, errEventPtr)
+ ClientData clientData; /* Points to integer to set. */
+ XErrorEvent *errEventPtr; /* Points to information about error
+ * (not used). */
+{
+ int *iPtr = (int *) clientData;
+
+ *iPtr = 1;
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbeddedEventProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher when various
+ * useful events are received for a window that is embedded in
+ * another application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Our internal state gets cleaned up when an embedded window is
+ * destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EmbeddedEventProc(clientData, eventPtr)
+ ClientData clientData; /* Token for container window. */
+ XEvent *eventPtr; /* ResizeRequest event. */
+{
+ TkWindow *winPtr = (TkWindow *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ EmbedWindowDeleted(winPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ContainerEventProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher when various
+ * useful events are received for the children of a container
+ * window. It forwards relevant information, such as geometry
+ * requests, from the events into the container's application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the event. For example, when ConfigureRequest events
+ * occur, geometry information gets set for the container window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+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");
+ }
+ }
+
+ if (eventPtr->type == CreateNotify) {
+ /*
+ * A new child window has been created in the container. Record
+ * its id in the Container structure (if more than one child is
+ * created, just remember the last one and ignore the earlier
+ * ones). Also set the child's size to match the container.
+ */
+
+ containerPtr->wrapper = eventPtr->xcreatewindow.window;
+ XMoveResizeWindow(eventPtr->xcreatewindow.display,
+ containerPtr->wrapper, 0, 0,
+ (unsigned int) Tk_Width(
+ (Tk_Window) containerPtr->parentPtr),
+ (unsigned int) Tk_Height(
+ (Tk_Window) containerPtr->parentPtr));
+ } else if (eventPtr->type == ConfigureRequest) {
+ if ((eventPtr->xconfigurerequest.x != 0)
+ || (eventPtr->xconfigurerequest.y != 0)) {
+ /*
+ * The embedded application is trying to move itself, which
+ * isn't legal. At this point, the window hasn't actually
+ * moved, but we need to send it a ConfigureNotify event to
+ * let it know that its request has been denied. If the
+ * embedded application was also trying to resize itself, a
+ * ConfigureNotify will be sent by the geometry management
+ * code below, so we don't need to do anything. Otherwise,
+ * generate a synthetic event.
+ */
+
+ if ((eventPtr->xconfigurerequest.width == winPtr->changes.width)
+ && (eventPtr->xconfigurerequest.height
+ == winPtr->changes.height)) {
+ EmbedSendConfigure(containerPtr);
+ }
+ }
+ EmbedGeometryRequest(containerPtr,
+ eventPtr->xconfigurerequest.width,
+ eventPtr->xconfigurerequest.height);
+ } else if (eventPtr->type == MapRequest) {
+ /*
+ * The embedded application's map request was ignored and simply
+ * passed on to us, so we have to map the window for it to appear
+ * on the screen.
+ */
+
+ XMapWindow(eventPtr->xmaprequest.display,
+ eventPtr->xmaprequest.window);
+ } else if (eventPtr->type == DestroyNotify) {
+ /*
+ * The embedded application is gone. Destroy the container window.
+ */
+
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ }
+ Tk_DeleteErrorHandler(errHandler);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedStructureProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher when
+ * a container window owned by this application gets resized
+ * (and also at several other times that we don't care about).
+ * This procedure reflects the size change in the embedded
+ * window that corresponds to the container.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The embedded window gets resized to match the container.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EmbedStructureProc(clientData, eventPtr)
+ ClientData clientData; /* Token for container window. */
+ XEvent *eventPtr; /* ResizeRequest event. */
+{
+ Container *containerPtr = (Container *) clientData;
+ Tk_ErrorHandler errHandler;
+
+ if (eventPtr->type == ConfigureNotify) {
+ if (containerPtr->wrapper != None) {
+ /*
+ * Ignore errors, since the embedded application could have
+ * deleted its window.
+ */
+
+ errHandler = Tk_CreateErrorHandler(eventPtr->xfocus.display, -1,
+ -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ XMoveResizeWindow(eventPtr->xconfigure.display,
+ containerPtr->wrapper, 0, 0,
+ (unsigned int) Tk_Width(
+ (Tk_Window) containerPtr->parentPtr),
+ (unsigned int) Tk_Height(
+ (Tk_Window) containerPtr->parentPtr));
+ Tk_DeleteErrorHandler(errHandler);
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ EmbedWindowDeleted(containerPtr->parentPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedFocusProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher when
+ * FocusIn and FocusOut events occur for a container window owned
+ * by this application. It is responsible for moving the focus
+ * back and forth between a container application and an embedded
+ * application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The X focus may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EmbedFocusProc(clientData, eventPtr)
+ ClientData clientData; /* Token for container window. */
+ XEvent *eventPtr; /* ResizeRequest event. */
+{
+ Container *containerPtr = (Container *) clientData;
+ Tk_ErrorHandler errHandler;
+ Display *display;
+
+ display = Tk_Display(containerPtr->parentPtr);
+ 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).
+ */
+
+ if (containerPtr->wrapper != None) {
+ errHandler = Tk_CreateErrorHandler(eventPtr->xfocus.display, -1,
+ -1, -1, (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ XSetInputFocus(display, containerPtr->wrapper, RevertToParent,
+ CurrentTime);
+ Tk_DeleteErrorHandler(errHandler);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedGeometryRequest --
+ *
+ * This procedure is invoked when an embedded application requests
+ * a particular size. It processes the request (which may or may
+ * not actually honor the request) and reflects the results back
+ * to the embedded application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If we deny the child's size change request, a Configure event
+ * is synthesized to let the child know how big it ought to be.
+ * Events get processed while we're waiting for the geometry
+ * managers to do their thing.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EmbedGeometryRequest(containerPtr, width, height)
+ Container *containerPtr; /* Information about the embedding. */
+ int width, height; /* Size that the child has requested. */
+{
+ TkWindow *winPtr = containerPtr->parentPtr;
+
+ /*
+ * Forward the requested size into our geometry management hierarchy
+ * via the container window. We need to send a Configure event back
+ * to the embedded application if we decide not to honor its
+ * request; to make this happen, process all idle event handlers
+ * synchronously here (so that the geometry managers have had a
+ * chance to do whatever they want to do), and if the window's size
+ * didn't change then generate a configure event.
+ */
+
+ Tk_GeometryRequest((Tk_Window) winPtr, width, height);
+ while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)) {
+ /* Empty loop body. */
+ }
+ if ((winPtr->changes.width != width)
+ || (winPtr->changes.height != height)) {
+ EmbedSendConfigure(containerPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedSendConfigure --
+ *
+ * This procedure synthesizes a ConfigureNotify event to notify an
+ * embedded application of its current size and location. This
+ * procedure is called when the embedded application made a
+ * geometry request that we did not grant, so that the embedded
+ * application knows that its geometry didn't change after all.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EmbedSendConfigure(containerPtr)
+ Container *containerPtr; /* Information about the embedding. */
+{
+ TkWindow *winPtr = containerPtr->parentPtr;
+ XEvent event;
+
+ event.xconfigure.type = ConfigureNotify;
+ event.xconfigure.serial =
+ LastKnownRequestProcessed(winPtr->display);
+ event.xconfigure.send_event = True;
+ event.xconfigure.display = winPtr->display;
+ event.xconfigure.event = containerPtr->wrapper;
+ event.xconfigure.window = containerPtr->wrapper;
+ event.xconfigure.x = 0;
+ event.xconfigure.y = 0;
+ event.xconfigure.width = winPtr->changes.width;
+ event.xconfigure.height = winPtr->changes.height;
+ event.xconfigure.above = None;
+ event.xconfigure.override_redirect = False;
+
+ /*
+ * Note: when sending the event below, the ButtonPressMask
+ * causes the event to be sent only to applications that have
+ * selected for ButtonPress events, which should be just the
+ * embedded application.
+ */
+
+ XSendEvent(winPtr->display, containerPtr->wrapper, False,
+ 0, &event);
+
+ /*
+ * The following needs to be done if the embedded window is
+ * not in the same application as the container window.
+ */
+
+ if (containerPtr->embeddedPtr == NULL) {
+ XMoveResizeWindow(winPtr->display, containerPtr->wrapper, 0, 0,
+ (unsigned int) winPtr->changes.width,
+ (unsigned int) winPtr->changes.height);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetOtherWindow --
+ *
+ * If both the container and embedded window are in the same
+ * process, this procedure will return either one, given the other.
+ *
+ * Results:
+ * If winPtr is a container, the return value is the token for the
+ * embedded window, and vice versa. If the "other" window isn't in
+ * this process, NULL is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ }
+ }
+ panic("TkpGetOtherWindow couldn't find window");
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpRedirectKeyEvent --
+ *
+ * This procedure is invoked when a key press or release event
+ * arrives for an application that does not believe it owns the
+ * input focus. This can happen because of embedding; for example,
+ * X can send an event to an embedded application when the real
+ * focus window is in the container application and is an ancestor
+ * of the container. This procedure's job is to forward the event
+ * back to the application where it really belongs.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The event may get sent to a different application.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpRedirectKeyEvent(winPtr, eventPtr)
+ 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) {
+ /*
+ * This window is being deleted. This is too confusing a
+ * case to handle so discard the event.
+ */
+
+ return;
+ }
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ break;
+ }
+ winPtr = winPtr->parentPtr;
+ }
+
+ if (winPtr->flags & TK_EMBEDDED) {
+ /*
+ * 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,
+ KeyPressMask|KeyReleaseMask, eventPtr);
+ eventPtr->xkey.window = saved;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpClaimFocus --
+ *
+ * This procedure is invoked when someone asks or the input focus
+ * to be put on a window in an embedded application, but the
+ * application doesn't currently have the focus. It requests the
+ * input focus from the container application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The input focus may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpClaimFocus(topLevelPtr, force)
+ TkWindow *topLevelPtr; /* Top-level window containing desired
+ * 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);
+ event.xfocus.send_event = 1;
+ event.xfocus.display = topLevelPtr->display;
+ event.xfocus.window = containerPtr->parent;
+ event.xfocus.mode = EMBEDDED_APP_WANTS_FOCUS;
+ event.xfocus.detail = force;
+ XSendEvent(event.xfocus.display, event.xfocus.window, False, 0, &event);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpTestembedCmd --
+ *
+ * This procedure implements the "testembed" command. It returns
+ * some or all of the information in the list pointed to by
+ * firstContainerPtr.
+ *
+ * Results:
+ * A standard Tcl result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpTestembedCmd(clientData, interp, argc, argv)
+ ClientData clientData; /* Main window for application. */
+ Tcl_Interp *interp; /* Current interpreter. */
+ 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);
+ Tcl_DStringAppendElement(&dString, buffer);
+ } else {
+ Tcl_DStringAppendElement(&dString, "XXX");
+ }
+ }
+ if (containerPtr->parentPtr == NULL) {
+ Tcl_DStringAppendElement(&dString, "");
+ } else {
+ Tcl_DStringAppendElement(&dString,
+ containerPtr->parentPtr->pathName);
+ }
+ if (containerPtr->wrapper == None) {
+ Tcl_DStringAppendElement(&dString, "");
+ } else {
+ if (all) {
+ sprintf(buffer, "0x%x", (int) containerPtr->wrapper);
+ Tcl_DStringAppendElement(&dString, buffer);
+ } else {
+ Tcl_DStringAppendElement(&dString, "XXX");
+ }
+ }
+ if (containerPtr->embeddedPtr == NULL) {
+ Tcl_DStringAppendElement(&dString, "");
+ } else {
+ Tcl_DStringAppendElement(&dString,
+ containerPtr->embeddedPtr->pathName);
+ }
+ Tcl_DStringEndSublist(&dString);
+ }
+ Tcl_DStringResult(interp, &dString);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedWindowDeleted --
+ *
+ * This procedure is invoked when a window involved in embedding
+ * (as either the container or the embedded application) is
+ * destroyed. It cleans up the Container structure for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Container structure may be freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUnixContainerId --
+ *
+ * Given an embedded window, this procedure returns the X window
+ * identifier for the associated container window.
+ *
+ * Results:
+ * The return value is the X window identifier for winPtr's
+ * container window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+}
diff --git a/tk/unix/tkUnixEvent.c b/tk/unix/tkUnixEvent.c
new file mode 100644
index 00000000000..fbb99cd1598
--- /dev/null
+++ b/tk/unix/tkUnixEvent.c
@@ -0,0 +1,498 @@
+/*
+ * 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$
+ */
+
+#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
+ * the event source for X Window events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new event source is created.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkCreateXEventSource()
+{
+ if (!initialized) {
+ initialized = 1;
+ Tcl_CreateEventSource(DisplaySetupProc, DisplayCheckProc, NULL);
+ Tcl_CreateExitHandler(DisplayExitHandler, NULL);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplayExitHandler --
+ *
+ * This function is called during finalization to clean up the
+ * display module.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayExitHandler(clientData)
+ ClientData clientData; /* Not used. */
+{
+ Tcl_DeleteEventSource(DisplaySetupProc, DisplayCheckProc, NULL);
+ initialized = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpOpenDisplay --
+ *
+ * Allocates a new TkDisplay, opens the X display, and establishes
+ * the file handler for the connection.
+ *
+ * Results:
+ * A pointer to a Tk display structure.
+ *
+ * Side effects:
+ * Opens a display.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkDisplay *
+TkpOpenDisplay(display_name)
+ char *display_name;
+{
+ TkDisplay *dispPtr;
+ Display *display = XOpenDisplay(display_name);
+
+ if (display == NULL) {
+ return NULL;
+ }
+ dispPtr = (TkDisplay *) ckalloc(sizeof(TkDisplay));
+ dispPtr->display = display;
+ Tcl_CreateFileHandler(ConnectionNumber(display), TCL_READABLE,
+ DisplayFileProc, (ClientData) dispPtr);
+ return dispPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCloseDisplay --
+ *
+ * Cancels notifier callbacks and closes a display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Deallocates the displayPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpCloseDisplay(displayPtr)
+ TkDisplay *displayPtr;
+{
+ TkDisplay *dispPtr = (TkDisplay *) displayPtr;
+
+ if (dispPtr->display != 0) {
+ Tcl_DeleteFileHandler(ConnectionNumber(dispPtr->display));
+
+ (void) XSync(dispPtr->display, False);
+ (void) XCloseDisplay(dispPtr->display);
+ }
+
+ ckfree((char *) dispPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DisplaySetupProc --
+ *
+ * This procedure implements the setup part of the UNIX X display
+ * event source. It is invoked by Tcl_DoOneEvent before entering
+ * the notifier to check for events on all displays.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If data is queued on a display inside Xlib, then the maximum
+ * block time will be set to 0 to ensure that the notifier returns
+ * control to Tcl even if there is no more data on the X connection.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplaySetupProc(clientData, flags)
+ ClientData clientData; /* Not used. */
+ int flags;
+{
+ 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
+ * queue.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Moves queued events onto the Tcl event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Makes entries on the Tcl event queue for all the events available
+ * from all the displays.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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) {
+
+ /*
+ * Things are very tricky if there aren't any events readable
+ * at this point (after all, there was supposedly data
+ * available on the connection). A couple of things could
+ * have occurred:
+ *
+ * One possibility is that there were only error events in the
+ * input from the server. If this happens, we should return
+ * (we don't want to go to sleep in XNextEvent below, since
+ * this would block out other sources of input to the
+ * process).
+ *
+ * Another possibility is that our connection to the server
+ * has been closed. This will not necessarily be detected in
+ * XEventsQueued (!!), so if we just return then there will be
+ * an infinite loop. To detect such an error, generate a NoOp
+ * protocol request to exercise the connection to the server,
+ * then return. However, must disable SIGPIPE while sending
+ * the request, or else the process will die from the signal
+ * and won't invoke the X error function to print a nice (?!)
+ * message.
+ */
+
+ void (*oldHandler)();
+
+ 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 --
+ *
+ * This routine waits for an X event to be processed or for
+ * a timeout to occur. The timeout is specified as an absolute
+ * time. This routine is called when Tk needs to wait for a
+ * particular X event without letting arbitrary events be
+ * processed. The caller will typically call Tk_RestrictEvents
+ * to set up an event filter before calling this routine. This
+ * routine will service at most one event per invocation.
+ *
+ * Results:
+ * Returns 0 if the timeout has expired, otherwise returns 1.
+ *
+ * Side effects:
+ * Can invoke arbitrary Tcl scripts.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkUnixDoOneXEvent(timePtr)
+ Tcl_Time *timePtr; /* Specifies the absolute time when the
+ * call should time out. */
+{
+ TkDisplay *dispPtr;
+ static fd_mask readMask[MASK_SIZE];
+ struct timeval blockTime, *timeoutPtr;
+ Tcl_Time now;
+ int fd, index, bit, numFound, numFdBits = 0;
+
+ /*
+ * Look for queued events first.
+ */
+
+ if (Tcl_ServiceEvent(TCL_WINDOW_EVENTS)) {
+ return 1;
+ }
+
+ /*
+ * Compute the next block time and check to see if we have timed out.
+ * Note that HP-UX defines tv_sec to be unsigned so we have to be
+ * careful in our arithmetic.
+ */
+
+ if (timePtr) {
+ TclpGetTime(&now);
+ blockTime.tv_sec = timePtr->sec;
+ blockTime.tv_usec = timePtr->usec - now.usec;
+ if (blockTime.tv_usec < 0) {
+ now.sec += 1;
+ blockTime.tv_usec += 1000000;
+ }
+ if (blockTime.tv_sec < now.sec) {
+ blockTime.tv_sec = 0;
+ blockTime.tv_usec = 0;
+ } else {
+ blockTime.tv_sec -= now.sec;
+ }
+ timeoutPtr = &blockTime;
+ } else {
+ timeoutPtr = NULL;
+ }
+
+ /*
+ * 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;
+ if (numFdBits <= fd) {
+ numFdBits = fd+1;
+ }
+ }
+
+ numFound = select(numFdBits, (SELECT_MASK *) &readMask[0], NULL, NULL,
+ timeoutPtr);
+ if (numFound <= 0) {
+ /*
+ * Some systems don't clear the masks after an error, so
+ * we have to do it here.
+ */
+
+ 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;
+ }
+
+ /*
+ * Check to see if we timed out.
+ */
+
+ if (timePtr) {
+ TclpGetTime(&now);
+ if ((now.sec > timePtr->sec) || ((now.sec == timePtr->sec)
+ && (now.usec > timePtr->usec))) {
+ return 0;
+ }
+ }
+
+ /*
+ * We had an event but we did not generate a Tcl event from it. Behave
+ * as though we dealt with it. (JYL&SS)
+ */
+
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpSync --
+ *
+ * This routine ensures that all pending X requests have been
+ * seen by the server, and that any pending X events have been
+ * moved onto the Tk event queue.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Places new events on the Tk event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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--;
+ }
+}
diff --git a/tk/unix/tkUnixFocus.c b/tk/unix/tkUnixFocus.c
new file mode 100644
index 00000000000..c6d11a7cb6f
--- /dev/null
+++ b/tk/unix/tkUnixFocus.c
@@ -0,0 +1,149 @@
+/*
+ * 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$
+ */
+
+#include "tkInt.h"
+#include "tkPort.h"
+#include "tkUnixInt.h"
+
+extern int tclFocusDebug;
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpChangeFocus --
+ *
+ * This procedure is invoked to move the official X focus from
+ * one window to another.
+ *
+ * Results:
+ * The return value is the serial number of the command that
+ * changed the focus. It may be needed by the caller to filter
+ * out focus change events that were queued before the command.
+ * If the procedure doesn't actually change the focus then
+ * it returns 0.
+ *
+ * Side effects:
+ * The official X focus window changes; the application's focus
+ * window isn't changed by this procedure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpChangeFocus(winPtr, force)
+ TkWindow *winPtr; /* Window that is to receive the X focus. */
+ int force; /* Non-zero means claim the focus even
+ * if it didn't originally belong to
+ * topLevelPtr's application. */
+{
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ Tk_ErrorHandler errHandler;
+ Window window, root, parent, *children;
+ unsigned int numChildren, serial;
+ TkWindow *winPtr2;
+ int dummy;
+
+ /*
+ * Don't set the X focus to a window that's marked
+ * override-redirect. This is a hack to avoid problems with menus
+ * under olvwm: if we move the focus then the focus can get lost
+ * during keyboard traversal. Fortunately, we don't really need to
+ * move the focus for menus: events will still find their way to the
+ * focus window, and menus aren't decorated anyway so the window
+ * manager doesn't need to hear about the focus change in order to
+ * redecorate the menu.
+ */
+
+ serial = 0;
+ if (winPtr->atts.override_redirect) {
+ return serial;
+ }
+
+ /*
+ * Check to make sure that the focus is still in one of the windows
+ * of this application or one of their descendants. Furthermore,
+ * grab the server to make sure that the focus doesn't change in the
+ * middle of this operation.
+ */
+
+ XGrabServer(dispPtr->display);
+ if (!force) {
+ /*
+ * Find the focus window, then see if it or one of its ancestors
+ * is a window in our application (it's possible that the focus
+ * window is in an embedded application, which may or may not be
+ * in the same process.
+ */
+
+ XGetInputFocus(dispPtr->display, &window, &dummy);
+ while (1) {
+ winPtr2 = (TkWindow *) Tk_IdToWindow(dispPtr->display, window);
+ if ((winPtr2 != NULL) && (winPtr2->mainPtr == winPtr->mainPtr)) {
+ break;
+ }
+ if ((window == PointerRoot) || (window == None)) {
+ goto done;
+ }
+ XQueryTree(dispPtr->display, window, &root, &parent, &children,
+ &numChildren);
+ if (children != NULL) {
+ XFree((void *) children);
+ }
+ if (parent == root) {
+ goto done;
+ }
+ window = parent;
+ }
+ }
+
+ /*
+ * Tell X to change the focus. Ignore errors that occur when changing
+ * the focus: it is still possible that the window we're focussing
+ * to could have gotten unmapped, which will generate an error.
+ */
+
+ errHandler = Tk_CreateErrorHandler(dispPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ if (winPtr->window == None) {
+ panic("ChangeXFocus got null X window");
+ }
+ XSetInputFocus(dispPtr->display, winPtr->window, RevertToParent,
+ CurrentTime);
+ Tk_DeleteErrorHandler(errHandler);
+
+ /*
+ * 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
+ * events on either side of the mark.
+ */
+
+ serial = NextRequest(winPtr->display);
+ XNoOp(winPtr->display);
+
+ done:
+ XUngrabServer(dispPtr->display);
+
+ /*
+ * After ungrabbing the server, it's important to flush the output
+ * immediately so that the server sees the ungrab command. Otherwise
+ * we might do something else that needs to communicate with the
+ * server (such as invoking a subprocess that needs to do I/O to
+ * the screen); if the ungrab command is still sitting in our
+ * output buffer, we could deadlock.
+ */
+
+ XFlush(dispPtr->display);
+ return serial;
+}
diff --git a/tk/unix/tkUnixFont.c b/tk/unix/tkUnixFont.c
new file mode 100644
index 00000000000..7f48de28ea3
--- /dev/null
+++ b/tk/unix/tkUnixFont.c
@@ -0,0 +1,998 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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.
+ *
+ * Results:
+ * The return value is a pointer to a TkFont that represents the
+ * native font. If a native font by the given name could not be
+ * found, the return value is NULL.
+ *
+ * Every call to this procedure returns a new TkFont structure,
+ * even if the name has already been seen before. The caller should
+ * 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 --
+ *
+ * Given a desired set of attributes for a font, find a font with
+ * the closest matching attributes.
+ *
+ * Results:
+ * The return value is a pointer to a TkFont that represents the
+ * font with the desired attributes. If a font with the desired
+ * attributes could not be constructed, some other font will be
+ * substituted automatically.
+ *
+ * Every call to this procedure returns a new TkFont structure,
+ * even if the specified attributes have already been seen before.
+ * The caller should call TkpDeleteFont() to free the platform-
+ * 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
+ * TkpGetFontFromAttributes(). The caller should have already
+ * released the fields of the TkFont that are used exclusively by
+ * the generic TkFont code.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * TkFont is deallocated.
+ *
+ *---------------------------------------------------------------------------
+ */
+
+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. */
+{
+ /*
+ * Perform a quick sanity check to ensure we won't overflow the X
+ * coordinate space.
+ */
+
+ if ((x + (fontPtr->fontStructPtr->max_bounds.width * numChars) > 0x7fff)) {
+ int length;
+
+ /*
+ * The string we are being asked to draw is too big and would overflow
+ * the X coordinate space. Unfortunatley X servers aren't too bright
+ * and so they won't deal with this case cleanly. We need to truncate
+ * the string before sending it to X.
+ */
+
+ numChars = Tk_MeasureChars((Tk_Font) fontPtr, source, numChars,
+ 0x7fff - x, 0, &length);
+ }
+
+ 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,
+ * so guess and use 1/3 the width of a capital I.
+ */
+
+ fontPtr->barHeight = fontPtr->widths['I'] / 3;
+ if (fontPtr->barHeight == 0) {
+ fontPtr->barHeight = 1;
+ }
+ }
+ if (fontPtr->underlinePos + fontPtr->barHeight > fontStructPtr->descent) {
+ /*
+ * If this set of cobbled together 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->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;
+ }
+}
diff --git a/tk/unix/tkUnixInit.c b/tk/unix/tkUnixInit.c
new file mode 100644
index 00000000000..a566f0fba1b
--- /dev/null
+++ b/tk/unix/tkUnixInit.c
@@ -0,0 +1,117 @@
+/*
+ * 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$
+ */
+
+#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 interp->result.
+ *
+ * Side effects:
+ * Sets "tk_library" Tcl variable, runs "tk.tcl" script.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpInit(interp)
+ Tcl_Interp *interp;
+{
+ TkCreateXEventSource();
+ return Tcl_Eval(interp, initScript);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetAppName --
+ *
+ * Retrieves the name of the current application from a platform
+ * specific location. For Unix, the application name is the tail
+ * of the path contained in the tcl variable argv0.
+ *
+ * Results:
+ * Returns the application name in the given Tcl_DString.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpGetAppName(interp, namePtr)
+ Tcl_Interp *interp;
+ Tcl_DString *namePtr; /* A previously initialized Tcl_DString. */
+{
+ char *p, *name;
+
+ name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
+ if ((name == NULL) || (*name == 0)) {
+ name = "tk";
+ } else {
+ p = strrchr(name, '/');
+ if (p != NULL) {
+ name = p+1;
+ }
+ }
+ Tcl_DStringAppend(namePtr, name, -1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDisplayWarning --
+ *
+ * This routines is called from Tk_Main to display warning
+ * messages that occur during startup.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates messages on stdout.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+ }
+}
diff --git a/tk/unix/tkUnixInt.h b/tk/unix/tkUnixInt.h
new file mode 100644
index 00000000000..00b9d14a978
--- /dev/null
+++ b/tk/unix/tkUnixInt.h
@@ -0,0 +1,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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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 */
diff --git a/tk/unix/tkUnixMenu.c b/tk/unix/tkUnixMenu.c
new file mode 100644
index 00000000000..1b53d8b61a9
--- /dev/null
+++ b/tk/unix/tkUnixMenu.c
@@ -0,0 +1,1603 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "default.h"
+#include "tkInt.h"
+#include "tkUnixInt.h"
+#include "tkMenu.h"
+
+/*
+ * Constants used for menu drawing.
+ */
+
+#define MENU_MARGIN_WIDTH 2
+#define MENU_DIVIDER_HEIGHT 2
+
+/*
+ * Platform specific flags for Unix.
+ */
+
+#define ENTRY_HELP_MENU ENTRY_PLATFORM_FLAG1
+
+/*
+ * Procedures used internally.
+ */
+
+static void SetHelpMenu _ANSI_ARGS_((TkMenu *menuPtr));
+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_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr,
+ Drawable d, Tk_3DBorder activeBorder,
+ Tk_3DBorder bgBorder, int x, int y,
+ int width, int heigth));
+static void DrawMenuEntryIndicator _ANSI_ARGS_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr,
+ Drawable d, GC gc, GC indicatorGC,
+ Tk_Font tkfont,
+ CONST Tk_FontMetrics *fmPtr, int x, int y,
+ int width, int height));
+static void DrawMenuEntryLabel _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 DrawMenuSeparator _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 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 DrawMenuUnderline _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 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));
+static void GetMenuIndicatorGeometry _ANSI_ARGS_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr,
+ Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr,
+ int *widthPtr, int *heightPtr));
+static void GetMenuSeparatorGeometry _ANSI_ARGS_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr,
+ Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr,
+ int *widthPtr, int *heightPtr));
+static void GetTearoffEntryGeometry _ANSI_ARGS_((TkMenu *menuPtr,
+ TkMenuEntry *mePtr, Tk_Font tkfont,
+ CONST Tk_FontMetrics *fmPtr, int *widthPtr,
+ int *heightPtr));
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpNewMenu --
+ *
+ * Gets the platform-specific piece of the menu. Invoked during idle
+ * after the generic part of the menu has been created.
+ *
+ * Results:
+ * Standard TCL error.
+ *
+ * Side effects:
+ * Allocates any platform specific allocations and places them
+ * in the platformData field of the menuPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpNewMenu(menuPtr)
+ TkMenu *menuPtr;
+{
+ SetHelpMenu(menuPtr);
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyMenu --
+ *
+ * Destroys platform-specific menu structures. Called when the
+ * generic menu structure is destroyed for the menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All platform-specific allocations are freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyMenu(menuPtr)
+ TkMenu *menuPtr;
+{
+ /*
+ * Nothing to do.
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyMenuEntry --
+ *
+ * Cleans up platform-specific menu entry items. Called when entry
+ * is destroyed in the generic code.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All platform specific allocations are freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyMenuEntry(mEntryPtr)
+ TkMenuEntry *mEntryPtr;
+{
+ /*
+ * Nothing to do.
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuNewEntry --
+ *
+ * Called when a new entry is created in a menu. Fills in platform
+ * specific data for the entry. The platformEntryData field
+ * is used to store the indicator diameter for radio button
+ * and check box entries.
+ *
+ * Results:
+ * Standard TCL error.
+ *
+ * Side effects:
+ * None on Unix.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpMenuNewEntry(mePtr)
+ TkMenuEntry *mePtr;
+{
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpSetWindowMenuBar --
+ *
+ * Sets up the menu as a menubar in the given window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Recomputes geometry of given window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpSetWindowMenuBar(tkwin, menuPtr)
+ Tk_Window tkwin; /* The window we are setting */
+ TkMenu *menuPtr; /* The menu we are setting */
+{
+ if (menuPtr == NULL) {
+ TkUnixSetMenubar(tkwin, NULL);
+ } else {
+ TkUnixSetMenubar(tkwin, menuPtr->tkwin);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpSetMainMenuBar --
+ *
+ * Called when a toplevel widget is brought to front. On the
+ * Macintosh, sets up the menubar that goes accross the top
+ * of the main monitor. On other platforms, nothing is necessary.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Recompute geometry of given window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpSetMainMenubar(interp, tkwin, menuName)
+ Tcl_Interp *interp;
+ Tk_Window tkwin;
+ char *menuName;
+{
+ /*
+ * Nothing to do.
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMenuIndicatorGeometry --
+ *
+ * Fills out the geometry of the indicator in a menu item. Note
+ * that the mePtr->height field must have already been filled in
+ * by GetMenuLabelGeometry since this height depends on the label
+ * height.
+ *
+ * Results:
+ * widthPtr and heightPtr point to the new geometry values.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMenuIndicatorGeometry(menuPtr, mePtr, tkfont, fmPtr, widthPtr, heightPtr)
+ 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;
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMenuAccelGeometry --
+ *
+ * Get the geometry of the accelerator area of a menu item.
+ *
+ * Results:
+ * heightPtr and widthPtr are set.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMenuAccelGeometry(menuPtr, mePtr, tkfont, fmPtr, widthPtr, heightPtr)
+ TkMenu *menuPtr; /* The menu was are drawing */
+ TkMenuEntry *mePtr; /* The entry we are getting the geometry for */
+ Tk_Font tkfont; /* The precalculated font */
+ 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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawMenuEntryBackground(menuPtr, mePtr, d, activeBorder, bgBorder, x, y,
+ width, height)
+ TkMenu *menuPtr; /* The menu we are drawing */
+ TkMenuEntry *mePtr; /* The entry we are drawing. */
+ Drawable d; /* The drawable we are drawing into */
+ 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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuEntryAccelerator --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr, activeBorder,
+ x, y, width, height, drawArrow)
+ TkMenu *menuPtr; /* The menu we are drawing */
+ TkMenuEntry *mePtr; /* The entry we are drawing */
+ Drawable d; /* The drawable we are drawing into */
+ GC gc; /* The precalculated gc to draw with */
+ Tk_Font tkfont; /* The precalculated font */
+ CONST Tk_FontMetrics *fmPtr; /* The precalculated metrics */
+ Tk_3DBorder activeBorder; /* The border for an active item */
+ 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));
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuEntryIndicator --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawMenuEntryIndicator(menuPtr, mePtr, d, gc, indicatorGC, tkfont, fmPtr,
+ x, y, width, height)
+ TkMenu *menuPtr; /* The menu we are drawing */
+ TkMenuEntry *mePtr; /* The entry we are drawing */
+ Drawable d; /* The drawable to draw into */
+ GC gc; /* The gc to draw with */
+ GC indicatorGC; /* The gc that indicators draw with */
+ 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 --
+ *
+ * This procedure draws a separator menu item.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawMenuSeparator(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; /* The drawable we are using */
+ GC gc; /* The gc to draw into */
+ Tk_Font tkfont; /* The font to draw with */
+ CONST Tk_FontMetrics *fmPtr; /* The font metrics from the font */
+ 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 --
+ *
+ * This procedure draws the label part of a menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * 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.
+ */
+
+ 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),
+ (unsigned) imageWidth, (unsigned) imageHeight);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuUnderline --
+ *
+ * On appropriate platforms, draw the underline character for the
+ * menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawMenuUnderline(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, y, width, height)
+ TkMenu *menuPtr; /* The menu to draw into */
+ TkMenuEntry *mePtr; /* The entry we are drawing */
+ Drawable d; /* What we are drawing into */
+ GC gc; /* The gc to draw into */
+ Tk_Font tkfont; /* The precalculated font */
+ 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 --
+ *
+ * Posts a menu on the screen
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The menu is posted and handled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpPostMenu(interp, menuPtr, x, y)
+ Tcl_Interp *interp;
+ TkMenu *menuPtr;
+ int x;
+ int y;
+{
+ return TkPostTearoffMenu(interp, menuPtr, x, y);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMenuSeparatorGeometry --
+ *
+ * Gets the width and height of the indicator area of a menu.
+ *
+ * Results:
+ * widthPtr and heightPtr are set.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMenuSeparatorGeometry(menuPtr, mePtr, tkfont, fmPtr, widthPtr,
+ heightPtr)
+ TkMenu *menuPtr; /* The menu we are measuring */
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetTearoffEntryGeometry --
+ *
+ * Gets the width and height of the indicator area of a menu.
+ *
+ * Results:
+ * widthPtr and heightPtr are set.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetTearoffEntryGeometry(menuPtr, mePtr, tkfont, fmPtr, widthPtr, heightPtr)
+ 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 precalculated font metrics */
+ int *widthPtr; /* The resulting width */
+ 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 --
+ *
+ * This procedure is invoked to recompute the size and
+ * layout of a menu that is a menubar clone.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Fields of menu entries are changed to reflect their
+ * current positions, and the size of the menu window
+ * itself may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpComputeMenubarGeometry(menuPtr)
+ TkMenu *menuPtr; /* Structure describing menu. */
+{
+ Tk_Font tkfont;
+ Tk_FontMetrics menuMetrics, entryMetrics, *fmPtr;
+ int width, height;
+ 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).
+ */
+
+ if (width <= 0) {
+ width = 1;
+ }
+ if (height <= 0) {
+ height = 1;
+ }
+ menuPtr->totalWidth = maxWidth;
+ menuPtr->totalHeight = height;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawTearoffEntry --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawTearoffEntry(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; /* The drawable we are drawing into */
+ GC gc; /* The gc we are drawing with */
+ Tk_Font tkfont; /* The font we are drawing with */
+ CONST Tk_FontMetrics *fmPtr; /* The metrics we are drawing with */
+ 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 --
+ *
+ * For every interp, initializes the bindings for Windows
+ * menus. Does nothing on Mac or XWindows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * C-level bindings are setup for the interp which will
+ * handle Alt-key sequences for menus without beeping
+ * or interfering with user-defined Alt-key bindings.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpInitializeMenuBindings(interp, bindingTable)
+ Tcl_Interp *interp; /* The interpreter to set. */
+ Tk_BindingTable bindingTable; /* The table to add to. */
+{
+ /*
+ * Nothing to do.
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetHelpMenu --
+ *
+ * Given a menu, check to see whether or not it is a help menu
+ * cascade in a menubar. If it is, the entry that points to
+ * this menu will be marked.
+ *
+ * RESULTS:
+ * None.
+ *
+ * Side effects:
+ * Will set the ENTRY_HELP_MENU flag appropriately.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SetHelpMenu(menuPtr)
+ TkMenu *menuPtr; /* The menu we are checking */
+{
+ TkMenuEntry *cascadeEntryPtr;
+
+ for (cascadeEntryPtr = menuPtr->menuRefPtr->parentEntryPtr;
+ cascadeEntryPtr != NULL;
+ cascadeEntryPtr = cascadeEntryPtr->nextCascadePtr) {
+ if ((cascadeEntryPtr->menuPtr->menuType == MENUBAR)
+ && (cascadeEntryPtr->menuPtr->masterMenuPtr->tkwin != NULL)
+ && (menuPtr->masterMenuPtr->tkwin != NULL)) {
+ TkMenu *masterMenuPtr = cascadeEntryPtr->menuPtr->masterMenuPtr;
+ char *helpMenuName = ckalloc(strlen(Tk_PathName(
+ masterMenuPtr->tkwin)) + strlen(".help") + 1);
+
+ strcpy(helpMenuName, Tk_PathName(masterMenuPtr->tkwin));
+ strcat(helpMenuName, ".help");
+ if (strcmp(helpMenuName,
+ Tk_PathName(menuPtr->masterMenuPtr->tkwin)) == 0) {
+ cascadeEntryPtr->entryFlags |= ENTRY_HELP_MENU;
+ } else {
+ cascadeEntryPtr->entryFlags &= ~ENTRY_HELP_MENU;
+ }
+ ckfree(helpMenuName);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDrawMenuEntry --
+ *
+ * Draws the given menu entry at the given coordinates with the
+ * given attributes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * X Server commands are executed to display the menu entry.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height,
+ strictMotif, drawArrow)
+ TkMenuEntry *mePtr; /* The entry to draw */
+ Drawable d; /* What to draw into */
+ Tk_Font tkfont; /* Precalculated font for menu */
+ CONST Tk_FontMetrics *menuMetricsPtr;
+ /* Precalculated metrics for menu */
+ int x; /* X-coordinate of topleft of entry */
+ int y; /* Y-coordinate of topleft of entry */
+ int width; /* Width of the entry rectangle */
+ int height; /* Height of the current rectangle */
+ int strictMotif; /* Boolean flag */
+ int drawArrow; /* Whether or not to draw the cascade
+ * arrow for cascade items. Only applies
+ * to Windows. */
+{
+ GC gc, indicatorGC;
+ 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
+ * into account the padding.
+ */
+
+ DrawMenuEntryBackground(menuPtr, mePtr, d, activeBorder,
+ bgBorder, x, y, width, height);
+
+ if (mePtr->type == SEPARATOR_ENTRY) {
+ DrawMenuSeparator(menuPtr, mePtr, d, gc, tkfont,
+ fmPtr, x, adjustedY, width, adjustedHeight);
+ } else if (mePtr->type == TEAROFF_ENTRY) {
+ DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, adjustedY,
+ width, adjustedHeight);
+ } else {
+ DrawMenuEntryLabel(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, 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);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMenuLabelGeometry --
+ *
+ * Figures out the size of the label portion of a menu item.
+ *
+ * Results:
+ * widthPtr and heightPtr are filled in with the correct geometry
+ * information.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMenuLabelGeometry(mePtr, tkfont, fmPtr, widthPtr, heightPtr)
+ TkMenuEntry *mePtr; /* The entry we are computing */
+ Tk_Font tkfont; /* The precalculated font */
+ CONST Tk_FontMetrics *fmPtr; /* The precalculated metrics */
+ int *widthPtr; /* The resulting width of the label
+ * portion */
+ 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpComputeStandardMenuGeometry --
+ *
+ * This procedure is invoked to recompute the size and
+ * layout of a menu that is not a menubar clone.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Fields of menu entries are changed to reflect their
+ * current positions, and the size of the menu window
+ * itself may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+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) {
+ GetTearoffEntryGeometry(menuPtr, mePtr, tkfont,
+ fmPtr, &width, &height);
+ mePtr->height = height;
+ labelWidth = width;
+ } 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, &width,
+ &height);
+ mePtr->height = height;
+ if (!mePtr->hideMargin) {
+ width += MENU_MARGIN_WIDTH;
+ }
+ if (width > labelWidth) {
+ labelWidth = width;
+ }
+
+ GetMenuAccelGeometry(menuPtr, mePtr, tkfont,
+ fmPtr, &width, &height);
+ if (height > mePtr->height) {
+ mePtr->height = height;
+ }
+ if (!mePtr->hideMargin) {
+ width += MENU_MARGIN_WIDTH;
+ }
+ if (width > accelWidth) {
+ accelWidth = width;
+ }
+
+ GetMenuIndicatorGeometry(menuPtr, mePtr, tkfont,
+ fmPtr, &width, &height);
+ if (height > mePtr->height) {
+ mePtr->height = height;
+ }
+ 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) {
+ windowWidth = 1;
+ }
+ if (windowHeight <= 0) {
+ windowHeight = 1;
+ }
+ menuPtr->totalWidth = windowWidth;
+ menuPtr->totalHeight = windowHeight;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuNotifyToplevelCreate --
+ *
+ * This routine reconfigures the menu and the clones indicated by
+ * menuName becuase a toplevel has been created and any system
+ * menus need to be created. Not applicable to UNIX.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * An idle handler is set up to do the reconfiguration.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMenuNotifyToplevelCreate(interp, menuName)
+ Tcl_Interp *interp; /* The interp the menu lives in. */
+ char *menuName; /* The name of the menu to
+ * reconfigure. */
+{
+ /*
+ * Nothing to do.
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuInit --
+ *
+ * Does platform-specific initialization of menus.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMenuInit()
+{
+ /*
+ * Nothing to do.
+ */
+}
diff --git a/tk/unix/tkUnixMenubu.c b/tk/unix/tkUnixMenubu.c
new file mode 100644
index 00000000000..ac7c8796ceb
--- /dev/null
+++ b/tk/unix/tkUnixMenubu.c
@@ -0,0 +1,307 @@
+/*
+ * 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$
+ */
+
+#include "tkMenubutton.h"
+
+/*
+ * The structure below defines menubutton class behavior by means of
+ * procedures that can be invoked from generic window code.
+ */
+
+TkClassProcs tkpMenubuttonClass = {
+ NULL, /* createProc. */
+ TkMenuButtonWorldChanged, /* geometryProc. */
+ NULL /* modalProc. */
+};
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCreateMenuButton --
+ *
+ * Allocate a new TkMenuButton structure.
+ *
+ * Results:
+ * Returns a newly allocated TkMenuButton structure.
+ *
+ * Side effects:
+ * Registers an event handler for the widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkMenuButton *
+TkpCreateMenuButton(tkwin)
+ Tk_Window tkwin;
+{
+ return (TkMenuButton *)ckalloc(sizeof(TkMenuButton));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDisplayMenuButton --
+ *
+ * This procedure is invoked to display a menubutton widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menubutton in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDisplayMenuButton(clientData)
+ ClientData clientData; /* Information about widget. */
+{
+ register TkMenuButton *mbPtr = (TkMenuButton *) clientData;
+ GC gc;
+ Tk_3DBorder border;
+ Pixmap pixmap;
+ int x = 0; /* Initialization needed only to stop
+ * compiler warning. */
+ int y;
+ register Tk_Window tkwin = mbPtr->tkwin;
+ 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;
+ }
+
+ /*
+ * In order to avoid screen flashes, this procedure redraws
+ * the menu 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(mbPtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+ 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 (mbPtr->image != None) {
+ Tk_SizeOfImage(mbPtr->image, &width, &height);
+
+ imageOrBitmap:
+ TkComputeAnchor(mbPtr->anchor, tkwin, 0, 0,
+ width + mbPtr->indicatorWidth, height, &x, &y);
+ if (mbPtr->image != NULL) {
+ Tk_RedrawImage(mbPtr->image, 0, 0, width, height, pixmap,
+ x, y);
+ } else {
+ XCopyPlane(mbPtr->display, mbPtr->bitmap, pixmap,
+ gc, 0, 0, (unsigned) width, (unsigned) height, x, y, 1);
+ }
+ } else if (mbPtr->bitmap != None) {
+ Tk_SizeOfBitmap(mbPtr->display, mbPtr->bitmap, &width, &height);
+ goto imageOrBitmap;
+ } else {
+ TkComputeAnchor(mbPtr->anchor, tkwin, mbPtr->padX, mbPtr->padY,
+ mbPtr->textWidth + mbPtr->indicatorWidth,
+ mbPtr->textHeight, &x, &y);
+ Tk_DrawTextLayout(mbPtr->display, pixmap, gc, mbPtr->textLayout, x, y,
+ 0, -1);
+ Tk_UnderlineTextLayout(mbPtr->display, pixmap, gc, mbPtr->textLayout,
+ x, y, mbPtr->underline);
+ }
+
+ /*
+ * 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));
+ }
+
+ /*
+ * Draw the cascade indicator for the menu button on the
+ * right side of the window, if desired.
+ */
+
+ if (mbPtr->indicatorOn) {
+ int borderWidth;
+
+ borderWidth = (mbPtr->indicatorHeight+1)/3;
+ if (borderWidth < 1) {
+ borderWidth = 1;
+ }
+ /*y += mbPtr->textHeight / 2;*/
+ Tk_Fill3DRectangle(tkwin, pixmap, border,
+ Tk_Width(tkwin) - mbPtr->inset - mbPtr->indicatorWidth
+ + mbPtr->indicatorHeight,
+ ((int) (Tk_Height(tkwin) - mbPtr->indicatorHeight))/2,
+ mbPtr->indicatorWidth - 2*mbPtr->indicatorHeight,
+ mbPtr->indicatorHeight, borderWidth, TK_RELIEF_RAISED);
+ }
+
+ /*
+ * Draw the border and traversal highlight last. This way, if the
+ * menu button's contents overflow onto the border they'll be covered
+ * up by the border.
+ */
+
+ if (mbPtr->relief != TK_RELIEF_FLAT) {
+ Tk_Draw3DRectangle(tkwin, pixmap, border,
+ mbPtr->highlightWidth, mbPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*mbPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*mbPtr->highlightWidth,
+ mbPtr->borderWidth, mbPtr->relief);
+ }
+ if (mbPtr->highlightWidth != 0) {
+ GC gc;
+
+ if (mbPtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(mbPtr->highlightColorPtr, pixmap);
+ } else {
+ gc = Tk_GCForColor(mbPtr->highlightBgColorPtr, pixmap);
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, mbPtr->highlightWidth, pixmap);
+ }
+
+ /*
+ * Copy the information from the off-screen pixmap onto the screen,
+ * then delete the pixmap.
+ */
+
+ XCopyArea(mbPtr->display, pixmap, Tk_WindowId(tkwin),
+ mbPtr->normalTextGC, 0, 0, (unsigned) Tk_Width(tkwin),
+ (unsigned) Tk_Height(tkwin), 0, 0);
+ Tk_FreePixmap(mbPtr->display, pixmap);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyMenuButton --
+ *
+ * Free data structures associated with the menubutton control.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Restores the default control state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyMenuButton(mbPtr)
+ TkMenuButton *mbPtr;
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpComputeMenuButtonGeometry --
+ *
+ * After changes in a menu button's text or bitmap, this procedure
+ * recomputes the menu button's geometry and passes this information
+ * along to the geometry manager for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * 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) {
+ width = mbPtr->width;
+ }
+ if (mbPtr->height > 0) {
+ height = mbPtr->height;
+ }
+ } else if (mbPtr->bitmap != None) {
+ Tk_SizeOfBitmap(mbPtr->display, mbPtr->bitmap, &width, &height);
+ if (mbPtr->width > 0) {
+ width = mbPtr->width;
+ }
+ if (mbPtr->height > 0) {
+ height = mbPtr->height;
+ }
+ } else {
+ Tk_FreeTextLayout(mbPtr->textLayout);
+ mbPtr->textLayout = Tk_ComputeTextLayout(mbPtr->tkfont, mbPtr->text,
+ -1, mbPtr->wrapLength, mbPtr->justify, 0, &mbPtr->textWidth,
+ &mbPtr->textHeight);
+ width = mbPtr->textWidth;
+ height = mbPtr->textHeight;
+ if (mbPtr->width > 0) {
+ width = mbPtr->width * Tk_TextWidth(mbPtr->tkfont, "0", 1);
+ }
+ if (mbPtr->height > 0) {
+ Tk_FontMetrics fm;
+
+ Tk_GetFontMetrics(mbPtr->tkfont, &fm);
+ height = mbPtr->height * fm.linespace;
+ }
+ width += 2*mbPtr->padX;
+ height += 2*mbPtr->padY;
+ }
+
+ if (mbPtr->indicatorOn) {
+ mm = WidthMMOfScreen(Tk_Screen(mbPtr->tkwin));
+ pixels = WidthOfScreen(Tk_Screen(mbPtr->tkwin));
+ mbPtr->indicatorHeight= (INDICATOR_HEIGHT * pixels)/(10*mm);
+ mbPtr->indicatorWidth = (INDICATOR_WIDTH * pixels)/(10*mm)
+ + 2*mbPtr->indicatorHeight;
+ width += mbPtr->indicatorWidth;
+ } else {
+ mbPtr->indicatorHeight = 0;
+ mbPtr->indicatorWidth = 0;
+ }
+
+ Tk_GeometryRequest(mbPtr->tkwin, (int) (width + 2*mbPtr->inset),
+ (int) (height + 2*mbPtr->inset));
+ Tk_SetInternalBorder(mbPtr->tkwin, mbPtr->inset);
+}
diff --git a/tk/unix/tkUnixPort.h b/tk/unix/tkUnixPort.h
new file mode 100644
index 00000000000..1b3fcbe2132
--- /dev/null
+++ b/tk/unix/tkUnixPort.h
@@ -0,0 +1,236 @@
+/*
+ * 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.
+ * 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$
+ */
+
+#ifndef _UNIXPORT
+#define _UNIXPORT
+
+#define __UNIX__ 1
+
+/*
+ * Macro to use instead of "void" for arguments that must have
+ * type "void *" in ANSI C; maps them to type "char *" in
+ * non-ANSI systems. This macro may be used in some of the include
+ * files below, which is why it is defined here.
+ */
+
+#ifndef VOID
+# ifdef __STDC__
+# define VOID void
+# else
+# define VOID char
+# endif
+#endif
+
+#include <stdio.h>
+#include <ctype.h>
+#include <fcntl.h>
+#ifdef HAVE_LIMITS_H
+# include <limits.h>
+#else
+# include "../compat/limits.h"
+#endif
+#include <math.h>
+#include <pwd.h>
+#ifdef NO_STDLIB_H
+# include "../compat/stdlib.h"
+#else
+# include <stdlib.h>
+#endif
+/* CYGNUS LOCAL: Don't include the system string.h if we've already
+ included tcl/compat/string.h. Otherwise you can't include both
+ tclInt.h and tkInt.h (not that you should anyhow, but some SN code
+ does). */
+#ifndef _STRING
+# include <string.h>
+#endif
+#include <sys/types.h>
+#include <sys/file.h>
+#ifdef HAVE_SYS_SELECT_H
+# include <sys/select.h>
+#endif
+#include <sys/stat.h>
+#ifndef _TCL
+# include <tcl.h>
+#endif
+#if TIME_WITH_SYS_TIME
+# include <sys/time.h>
+# include <time.h>
+#else
+# if HAVE_SYS_TIME_H
+# include <sys/time.h>
+# else
+# include <time.h>
+# endif
+#endif
+#ifdef HAVE_UNISTD_H
+# include <unistd.h>
+#else
+# include "../compat/unistd.h"
+#endif
+#include <X11/Xlib.h>
+#include <X11/cursorfont.h>
+#include <X11/keysym.h>
+#include <X11/Xatom.h>
+#include <X11/Xproto.h>
+#include <X11/Xresource.h>
+#include <X11/Xutil.h>
+
+/*
+ * The following macro defines the type of the mask arguments to
+ * select:
+ */
+
+#ifndef NO_FD_SET
+# define SELECT_MASK fd_set
+#else
+# ifndef _AIX
+ typedef long fd_mask;
+# endif
+# if defined(_IBMR2)
+# define SELECT_MASK void
+# else
+# define SELECT_MASK int
+# endif
+#endif
+
+/*
+ * The following macro defines the number of fd_masks in an fd_set:
+ */
+
+#ifndef FD_SETSIZE
+# ifdef OPEN_MAX
+# define FD_SETSIZE OPEN_MAX
+# else
+# define FD_SETSIZE 256
+# endif
+#endif
+#if !defined(howmany)
+# define howmany(x, y) (((x)+((y)-1))/(y))
+#endif
+#ifndef NFDBITS
+# define NFDBITS NBBY*sizeof(fd_mask)
+#endif
+#define MASK_SIZE howmany(FD_SETSIZE, NFDBITS)
+
+/*
+ * Not all systems declare the errno variable in errno.h. so this
+ * file does it explicitly.
+ */
+
+extern int errno;
+
+/*
+ * Define "NBBY" (number of bits per byte) if it's not already defined.
+ */
+
+#ifndef NBBY
+# define NBBY 8
+#endif
+
+/*
+ * These macros are just wrappers for the equivalent X Region calls.
+ */
+
+#define TkClipBox(rgn, rect) XClipBox((Region) rgn, rect)
+#define TkCreateRegion() (TkRegion) XCreateRegion()
+#define TkDestroyRegion(rgn) XDestroyRegion((Region) rgn)
+#define TkIntersectRegion(a, b, r) XIntersectRegion((Region) a, \
+ (Region) b, (Region) r)
+#define TkRectInRegion(r, x, y, w, h) XRectInRegion((Region) r, x, y, w, h)
+#define TkSetRegion(d, gc, rgn) XSetRegion(d, gc, (Region) rgn)
+#define TkUnionRectWithRegion(rect, src, ret) XUnionRectWithRegion(rect, \
+ (Region) src, (Region) ret)
+
+/*
+ * The TkPutImage macro strips off the color table information, which isn't
+ * 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
+#endif
+
+#ifndef SEEK_CUR
+# define SEEK_CUR 1
+#endif
+
+#ifndef SEEK_END
+# define SEEK_END 2
+#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.
+ */
+
+#define TkpDefineNativeBitmaps()
+#define TkpCreateNativeBitmap(display, source) None
+#define TkpGetNativeAppBitmap(display, name, w, h) None
+
+/*
+ * This macro stores a representation of the window handle in a string.
+ */
+
+#define TkpPrintWindowId(buf,w) \
+ sprintf((buf), "0x%x", (unsigned int) (w))
+
+/*
+ * TkpScanWindowId is just an alias for Tcl_GetInt on Unix.
+ */
+
+#define TkpScanWindowId(i,s,wp) \
+ Tcl_GetInt((i),(s),(wp))
+
+/*
+ * This macro indicates that entry and text widgets should display
+ * the selection highlight regardless of which window has the focus.
+ */
+
+#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 */
diff --git a/tk/unix/tkUnixScale.c b/tk/unix/tkUnixScale.c
new file mode 100644
index 00000000000..6378c03b70e
--- /dev/null
+++ b/tk/unix/tkUnixScale.c
@@ -0,0 +1,828 @@
+/*
+ * 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$
+ */
+
+#include "tkScale.h"
+#include "tkInt.h"
+
+/*
+ * Forward declarations for procedures defined later in this file:
+ */
+
+static void DisplayHorizontalScale _ANSI_ARGS_((TkScale *scalePtr,
+ Drawable drawable, XRectangle *drawnAreaPtr));
+static void DisplayHorizontalValue _ANSI_ARGS_((TkScale *scalePtr,
+ Drawable drawable, double value, int top));
+static void DisplayVerticalScale _ANSI_ARGS_((TkScale *scalePtr,
+ Drawable drawable, XRectangle *drawnAreaPtr));
+static void DisplayVerticalValue _ANSI_ARGS_((TkScale *scalePtr,
+ Drawable drawable, double value, int rightEdge));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCreateScale --
+ *
+ * Allocate a new TkScale structure.
+ *
+ * Results:
+ * Returns a newly allocated TkScale structure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkScale *
+TkpCreateScale(tkwin)
+ Tk_Window tkwin;
+{
+ return (TkScale *) ckalloc(sizeof(TkScale));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyScale --
+ *
+ * Destroy a TkScale structure.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Memory is freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyScale(scalePtr)
+ TkScale *scalePtr;
+{
+ ckfree((char *) scalePtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayVerticalScale --
+ *
+ * This procedure redraws the contents of a vertical scale
+ * window. It is invoked as a do-when-idle handler, so it only
+ * runs when there's nothing else for the application to do.
+ *
+ * Results:
+ * There is no return value. If only a part of the scale needs
+ * to be redrawn, then drawnAreaPtr is modified to reflect the
+ * area that was actually modified.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayVerticalScale(scalePtr, drawable, drawnAreaPtr)
+ TkScale *scalePtr; /* Widget record for scale. */
+ Drawable drawable; /* Where to display scale (window
+ * or pixmap). */
+ XRectangle *drawnAreaPtr; /* Initally contains area of window;
+ * if only a part of the scale is
+ * redrawn, gets modified to reflect
+ * the part of the window that was
+ * redrawn. */
+{
+ Tk_Window tkwin = scalePtr->tkwin;
+ int x, y, width, height, shadowWidth;
+ double tickValue;
+ Tk_3DBorder sliderBorder;
+
+ /*
+ * Display the information from left to right across the window.
+ */
+
+ if (!(scalePtr->flags & REDRAW_OTHER)) {
+ drawnAreaPtr->x = scalePtr->vertTickRightX;
+ drawnAreaPtr->y = scalePtr->inset;
+ drawnAreaPtr->width = scalePtr->vertTroughX + scalePtr->width
+ + 2*scalePtr->borderWidth - scalePtr->vertTickRightX;
+ drawnAreaPtr->height -= 2*scalePtr->inset;
+ }
+ Tk_Fill3DRectangle(tkwin, drawable, scalePtr->bgBorder,
+ drawnAreaPtr->x, drawnAreaPtr->y, drawnAreaPtr->width,
+ drawnAreaPtr->height, 0, TK_RELIEF_FLAT);
+ if (scalePtr->flags & REDRAW_OTHER) {
+ /*
+ * Display the tick marks.
+ */
+
+ if (scalePtr->tickInterval != 0) {
+ for (tickValue = scalePtr->fromValue; ;
+ tickValue += scalePtr->tickInterval) {
+ /*
+ * The TkRoundToResolution call gets rid of accumulated
+ * round-off errors, if any.
+ */
+
+ tickValue = TkRoundToResolution(scalePtr, tickValue);
+ if (scalePtr->toValue >= scalePtr->fromValue) {
+ if (tickValue > scalePtr->toValue) {
+ break;
+ }
+ } else {
+ if (tickValue < scalePtr->toValue) {
+ break;
+ }
+ }
+ DisplayVerticalValue(scalePtr, drawable, tickValue,
+ scalePtr->vertTickRightX);
+ }
+ }
+ }
+
+ /*
+ * Display the value, if it is desired.
+ */
+
+ if (scalePtr->showValue) {
+ DisplayVerticalValue(scalePtr, drawable, scalePtr->value,
+ scalePtr->vertValueRightX);
+ }
+
+ /*
+ * Display the trough and the slider.
+ */
+
+ Tk_Draw3DRectangle(tkwin, drawable,
+ scalePtr->bgBorder, scalePtr->vertTroughX, scalePtr->inset,
+ scalePtr->width + 2*scalePtr->borderWidth,
+ Tk_Height(tkwin) - 2*scalePtr->inset, scalePtr->borderWidth,
+ 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;
+ y = TkpValueToPixel(scalePtr, scalePtr->value) - height;
+ shadowWidth = scalePtr->borderWidth/2;
+ if (shadowWidth == 0) {
+ shadowWidth = 1;
+ }
+ Tk_Draw3DRectangle(tkwin, drawable, sliderBorder, x, y, width,
+ 2*height, shadowWidth, scalePtr->sliderRelief);
+ x += shadowWidth;
+ y += shadowWidth;
+ width -= 2*shadowWidth;
+ height -= shadowWidth;
+ Tk_Fill3DRectangle(tkwin, drawable, sliderBorder, x, y, width,
+ height, shadowWidth, scalePtr->sliderRelief);
+ Tk_Fill3DRectangle(tkwin, drawable, sliderBorder, x, y+height,
+ width, height, shadowWidth, scalePtr->sliderRelief);
+
+ /*
+ * Draw the label to the right of the scale.
+ */
+
+ 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 --
+ *
+ * This procedure is called to display values (scale readings)
+ * for vertically-oriented scales.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The numerical value corresponding to value is displayed with
+ * its right edge at "rightEdge", and at a vertical position in
+ * the scale that corresponds to "value".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayVerticalValue(scalePtr, drawable, value, rightEdge)
+ register TkScale *scalePtr; /* Information about widget in which to
+ * display value. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * the value. */
+ double value; /* Y-coordinate of number to display,
+ * specified in application coords, not
+ * in pixels (we'll compute pixels). */
+ int rightEdge; /* X-coordinate of right edge of text,
+ * specified in pixels. */
+{
+ register Tk_Window tkwin = scalePtr->tkwin;
+ int y, width, length;
+ char valueString[PRINT_CHARS];
+ Tk_FontMetrics fm;
+
+ Tk_GetFontMetrics(scalePtr->tkfont, &fm);
+ y = TkpValueToPixel(scalePtr, value) + fm.ascent/2;
+ sprintf(valueString, scalePtr->format, value);
+ length = strlen(valueString);
+ width = Tk_TextWidth(scalePtr->tkfont, valueString, length);
+
+ /*
+ * Adjust the y-coordinate if necessary to keep the text entirely
+ * inside the window.
+ */
+
+ if ((y - fm.ascent) < (scalePtr->inset + SPACING)) {
+ y = scalePtr->inset + SPACING + fm.ascent;
+ }
+ if ((y + fm.descent) > (Tk_Height(tkwin) - scalePtr->inset - SPACING)) {
+ y = Tk_Height(tkwin) - scalePtr->inset - SPACING - fm.descent;
+ }
+ Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC,
+ scalePtr->tkfont, valueString, length, rightEdge - width, y);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DisplayHorizontalScale --
+ *
+ * This procedure redraws the contents of a horizontal scale
+ * window. It is invoked as a do-when-idle handler, so it only
+ * runs when there's nothing else for the application to do.
+ *
+ * Results:
+ * There is no return value. If only a part of the scale needs
+ * to be redrawn, then drawnAreaPtr is modified to reflect the
+ * area that was actually modified.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+DisplayHorizontalScale(scalePtr, drawable, drawnAreaPtr)
+ TkScale *scalePtr; /* Widget record for scale. */
+ Drawable drawable; /* Where to display scale (window
+ * or pixmap). */
+ XRectangle *drawnAreaPtr; /* Initally contains area of window;
+ * if only a part of the scale is
+ * redrawn, gets modified to reflect
+ * the part of the window that was
+ * redrawn. */
+{
+ register Tk_Window tkwin = scalePtr->tkwin;
+ int x, y, width, height, shadowWidth;
+ double tickValue;
+ Tk_3DBorder sliderBorder;
+
+ /*
+ * Display the information from bottom to top across the window.
+ */
+
+ if (!(scalePtr->flags & REDRAW_OTHER)) {
+ drawnAreaPtr->x = scalePtr->inset;
+ drawnAreaPtr->y = scalePtr->horizValueY;
+ drawnAreaPtr->width -= 2*scalePtr->inset;
+ drawnAreaPtr->height = scalePtr->horizTroughY + scalePtr->width
+ + 2*scalePtr->borderWidth - scalePtr->horizValueY;
+ }
+ Tk_Fill3DRectangle(tkwin, drawable, scalePtr->bgBorder,
+ drawnAreaPtr->x, drawnAreaPtr->y, drawnAreaPtr->width,
+ drawnAreaPtr->height, 0, TK_RELIEF_FLAT);
+ if (scalePtr->flags & REDRAW_OTHER) {
+ /*
+ * Display the tick marks.
+ */
+
+ if (scalePtr->tickInterval != 0) {
+ for (tickValue = scalePtr->fromValue; ;
+ tickValue += scalePtr->tickInterval) {
+ /*
+ * The TkRoundToResolution call gets rid of accumulated
+ * round-off errors, if any.
+ */
+
+ tickValue = TkRoundToResolution(scalePtr, tickValue);
+ if (scalePtr->toValue >= scalePtr->fromValue) {
+ if (tickValue > scalePtr->toValue) {
+ break;
+ }
+ } else {
+ if (tickValue < scalePtr->toValue) {
+ break;
+ }
+ }
+ DisplayHorizontalValue(scalePtr, drawable, tickValue,
+ scalePtr->horizTickY);
+ }
+ }
+ }
+
+ /*
+ * Display the value, if it is desired.
+ */
+
+ if (scalePtr->showValue) {
+ DisplayHorizontalValue(scalePtr, drawable, scalePtr->value,
+ scalePtr->horizValueY);
+ }
+
+ /*
+ * Display the trough and the slider.
+ */
+
+ y = scalePtr->horizTroughY;
+ Tk_Draw3DRectangle(tkwin, drawable,
+ scalePtr->bgBorder, scalePtr->inset, y,
+ Tk_Width(tkwin) - 2*scalePtr->inset,
+ scalePtr->width + 2*scalePtr->borderWidth,
+ 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;
+ y += scalePtr->borderWidth;
+ shadowWidth = scalePtr->borderWidth/2;
+ if (shadowWidth == 0) {
+ shadowWidth = 1;
+ }
+ Tk_Draw3DRectangle(tkwin, drawable, sliderBorder,
+ x, y, 2*width, height, shadowWidth, scalePtr->sliderRelief);
+ x += shadowWidth;
+ y += shadowWidth;
+ width -= shadowWidth;
+ height -= 2*shadowWidth;
+ Tk_Fill3DRectangle(tkwin, drawable, sliderBorder, x, y, width, height,
+ shadowWidth, scalePtr->sliderRelief);
+ Tk_Fill3DRectangle(tkwin, drawable, sliderBorder, x+width, y,
+ width, height, shadowWidth, scalePtr->sliderRelief);
+
+ /*
+ * Draw the label at the top of the scale.
+ */
+
+ 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 --
+ *
+ * This procedure is called to display values (scale readings)
+ * for horizontally-oriented scales.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The numerical value corresponding to value is displayed with
+ * its bottom edge at "bottom", and at a horizontal position in
+ * the scale that corresponds to "value".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DisplayHorizontalValue(scalePtr, drawable, value, top)
+ register TkScale *scalePtr; /* Information about widget in which to
+ * display value. */
+ Drawable drawable; /* Pixmap or window in which to draw
+ * the value. */
+ double value; /* X-coordinate of number to display,
+ * specified in application coords, not
+ * in pixels (we'll compute pixels). */
+ int top; /* Y-coordinate of top edge of text,
+ * specified in pixels. */
+{
+ register Tk_Window tkwin = scalePtr->tkwin;
+ int x, y, length, width;
+ char valueString[PRINT_CHARS];
+ Tk_FontMetrics fm;
+
+ x = TkpValueToPixel(scalePtr, value);
+ Tk_GetFontMetrics(scalePtr->tkfont, &fm);
+ y = top + fm.ascent;
+ sprintf(valueString, scalePtr->format, value);
+ length = strlen(valueString);
+ width = Tk_TextWidth(scalePtr->tkfont, valueString, length);
+
+ /*
+ * Adjust the x-coordinate if necessary to keep the text entirely
+ * inside the window.
+ */
+
+ x -= (width)/2;
+ if (x < (scalePtr->inset + SPACING)) {
+ x = scalePtr->inset + SPACING;
+ }
+ if (x > (Tk_Width(tkwin) - scalePtr->inset)) {
+ x = Tk_Width(tkwin) - scalePtr->inset - SPACING - width;
+ }
+ Tk_DrawChars(scalePtr->display, drawable, scalePtr->textGC,
+ scalePtr->tkfont, valueString, length, x, y);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDisplayScale --
+ *
+ * This procedure is invoked as an idle handler to redisplay
+ * the contents of a scale widget.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The scale gets redisplayed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDisplayScale(clientData)
+ ClientData clientData; /* Widget record for scale. */
+{
+ TkScale *scalePtr = (TkScale *) clientData;
+ Tk_Window tkwin = scalePtr->tkwin;
+ Tcl_Interp *interp = scalePtr->interp;
+ Pixmap pixmap;
+ int result;
+ char string[PRINT_CHARS];
+ XRectangle drawnArea;
+
+ if ((scalePtr->tkwin == NULL) || !Tk_IsMapped(scalePtr->tkwin)) {
+ goto done;
+ }
+
+ /*
+ * 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;
+ if (scalePtr->tkwin == NULL) {
+ Tcl_Release((ClientData) scalePtr);
+ return;
+ }
+ Tcl_Release((ClientData) scalePtr);
+
+ /*
+ * In order to avoid screen flashes, this procedure redraws
+ * the scale 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(scalePtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+ drawnArea.x = 0;
+ drawnArea.y = 0;
+ drawnArea.width = Tk_Width(tkwin);
+ drawnArea.height = Tk_Height(tkwin);
+
+ /*
+ * 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
+ * horizontal and vertical scales: border and traversal
+ * highlight.
+ */
+
+ if (scalePtr->flags & REDRAW_OTHER) {
+ if (scalePtr->relief != TK_RELIEF_FLAT) {
+ Tk_Draw3DRectangle(tkwin, pixmap, scalePtr->bgBorder,
+ scalePtr->highlightWidth, scalePtr->highlightWidth,
+ Tk_Width(tkwin) - 2*scalePtr->highlightWidth,
+ Tk_Height(tkwin) - 2*scalePtr->highlightWidth,
+ scalePtr->borderWidth, scalePtr->relief);
+ }
+ 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,
+ * then delete the pixmap.
+ */
+
+ XCopyArea(scalePtr->display, pixmap, Tk_WindowId(tkwin),
+ scalePtr->copyGC, drawnArea.x, drawnArea.y, drawnArea.width,
+ drawnArea.height, drawnArea.x, drawnArea.y);
+ Tk_FreePixmap(scalePtr->display, pixmap);
+
+ done:
+ scalePtr->flags &= ~REDRAW_ALL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpScaleElement --
+ *
+ * Determine which part of a scale widget lies under a given
+ * point.
+ *
+ * Results:
+ * The return value is either TROUGH1, SLIDER, TROUGH2, or
+ * OTHER, depending on which of the scale's active elements
+ * (if any) is under the point at (x,y).
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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))) {
+ return OTHER;
+ }
+ sliderFirst = TkpValueToPixel(scalePtr, scalePtr->value)
+ - scalePtr->sliderLength/2;
+ if (y < sliderFirst) {
+ return TROUGH1;
+ }
+ if (y < (sliderFirst+scalePtr->sliderLength)) {
+ return SLIDER;
+ }
+ return TROUGH2;
+ }
+
+ if ((y < scalePtr->horizTroughY)
+ || (y >= (scalePtr->horizTroughY + 2*scalePtr->borderWidth +
+ scalePtr->width))) {
+ return OTHER;
+ }
+ if ((x < scalePtr->inset)
+ || (x >= (Tk_Width(scalePtr->tkwin) - scalePtr->inset))) {
+ return OTHER;
+ }
+ sliderFirst = TkpValueToPixel(scalePtr, scalePtr->value)
+ - scalePtr->sliderLength/2;
+ if (x < sliderFirst) {
+ return TROUGH1;
+ }
+ if (x < (sliderFirst+scalePtr->sliderLength)) {
+ return SLIDER;
+ }
+ return TROUGH2;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpSetScaleValue --
+ *
+ * This procedure changes the value of a scale and invokes
+ * a Tcl command to reflect the current position of a scale
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Tcl command is invoked, and an additional error-processing
+ * command may also be invoked. The scale's slider is redrawn.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpSetScaleValue(scalePtr, value, setVar, invokeCommand)
+ register TkScale *scalePtr; /* Info about widget. */
+ double value; /* New value for scale. Gets adjusted
+ * if it's off the scale. */
+ int setVar; /* Non-zero means reflect new value through
+ * to associated variable, if any. */
+ int invokeCommand; /* Non-zero means invoked -command option
+ * to notify of new value, 0 means don't. */
+{
+ char string[PRINT_CHARS];
+
+ value = TkRoundToResolution(scalePtr, value);
+ if ((value < scalePtr->fromValue)
+ ^ (scalePtr->toValue < scalePtr->fromValue)) {
+ value = scalePtr->fromValue;
+ }
+ if ((value > scalePtr->toValue)
+ ^ (scalePtr->toValue < scalePtr->fromValue)) {
+ value = scalePtr->toValue;
+ }
+ if (scalePtr->flags & NEVER_SET) {
+ scalePtr->flags &= ~NEVER_SET;
+ } else if (scalePtr->value == value) {
+ return;
+ }
+ 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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpPixelToValue --
+ *
+ * Given a pixel within a scale window, return the scale
+ * reading corresponding to that pixel.
+ *
+ * Results:
+ * A double-precision scale reading. If the value is outside
+ * the legal range for the scale then it's rounded to the nearest
+ * end of the scale.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+double
+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;
+ }
+
+ if (pixelRange <= 0) {
+ /*
+ * Not enough room for the slider to actually slide: just return
+ * the scale's current value.
+ */
+
+ return scalePtr->value;
+ }
+ value -= scalePtr->sliderLength/2 + scalePtr->inset
+ + scalePtr->borderWidth;
+ value /= pixelRange;
+ if (value < 0) {
+ value = 0;
+ }
+ if (value > 1) {
+ value = 1;
+ }
+ value = scalePtr->fromValue +
+ value * (scalePtr->toValue - scalePtr->fromValue);
+ return TkRoundToResolution(scalePtr, value);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpValueToPixel --
+ *
+ * Given a reading of the scale, return the x-coordinate or
+ * y-coordinate corresponding to that reading, depending on
+ * whether the scale is vertical or horizontal, respectively.
+ *
+ * Results:
+ * An integer value giving the pixel location corresponding
+ * to reading. The value is restricted to lie within the
+ * defined range for the scale.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpValueToPixel(scalePtr, value)
+ 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);
+ if (y < 0) {
+ y = 0;
+ } else if (y > pixelRange) {
+ y = pixelRange;
+ }
+ }
+ y += scalePtr->sliderLength/2 + scalePtr->inset + scalePtr->borderWidth;
+ return y;
+}
diff --git a/tk/unix/tkUnixScrlbr.c b/tk/unix/tkUnixScrlbr.c
new file mode 100644
index 00000000000..6861ed33da2
--- /dev/null
+++ b/tk/unix/tkUnixScrlbr.c
@@ -0,0 +1,476 @@
+/*
+ * 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$
+ */
+
+#include "tkScrollbar.h"
+
+/*
+ * Minimum slider length, in pixels (designed to make sure that the slider
+ * is always easy to grab with the mouse).
+ */
+
+#define MIN_SLIDER_LENGTH 5
+
+/*
+ * Declaration of Unix specific scrollbar structure.
+ */
+
+typedef struct UnixScrollbar {
+ TkScrollbar info; /* Generic scrollbar info. */
+ GC troughGC; /* For drawing trough. */
+ GC copyGC; /* Used for copying from pixmap onto screen. */
+} UnixScrollbar;
+
+/*
+ * The class procedure table for the scrollbar widget.
+ */
+
+TkClassProcs tkpScrollbarProcs = {
+ NULL, /* createProc. */
+ NULL, /* geometryProc. */
+ NULL /* modalProc. */
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCreateScrollbar --
+ *
+ * Allocate a new TkScrollbar structure.
+ *
+ * Results:
+ * Returns a newly allocated TkScrollbar structure.
+ *
+ * Side effects:
+ * Registers an event handler for the widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkScrollbar *
+TkpCreateScrollbar(tkwin)
+ Tk_Window tkwin;
+{
+ UnixScrollbar *scrollPtr = (UnixScrollbar *)ckalloc(sizeof(UnixScrollbar));
+ scrollPtr->troughGC = None;
+ scrollPtr->copyGC = None;
+
+ Tk_CreateEventHandler(tkwin,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ TkScrollbarEventProc, (ClientData) scrollPtr);
+
+ return (TkScrollbar *) scrollPtr;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpDisplayScrollbar --
+ *
+ * This procedure redraws the contents of a scrollbar window.
+ * It is invoked as a do-when-idle handler, so it only runs
+ * when there's nothing else for the application to do.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpDisplayScrollbar(clientData)
+ ClientData clientData; /* Information about window. */
+{
+ register TkScrollbar *scrollPtr = (TkScrollbar *) clientData;
+ register Tk_Window tkwin = scrollPtr->tkwin;
+ XPoint points[7];
+ Tk_3DBorder border;
+ int relief, width, elementBorderWidth;
+ Pixmap pixmap;
+
+ if ((scrollPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ goto done;
+ }
+
+ if (scrollPtr->vertical) {
+ width = Tk_Width(tkwin) - 2*scrollPtr->inset;
+ } else {
+ width = Tk_Height(tkwin) - 2*scrollPtr->inset;
+ }
+ elementBorderWidth = scrollPtr->elementBorderWidth;
+ if (elementBorderWidth < 0) {
+ elementBorderWidth = scrollPtr->borderWidth;
+ }
+
+ /*
+ * In order to avoid screen flashes, this procedure redraws
+ * the scrollbar 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(scrollPtr->display, Tk_WindowId(tkwin),
+ Tk_Width(tkwin), Tk_Height(tkwin), Tk_Depth(tkwin));
+
+ if (scrollPtr->highlightWidth != 0) {
+ GC gc;
+
+ if (scrollPtr->flags & GOT_FOCUS) {
+ gc = Tk_GCForColor(scrollPtr->highlightColorPtr, pixmap);
+ } else {
+ gc = Tk_GCForColor(scrollPtr->highlightBgColorPtr, pixmap);
+ }
+ Tk_DrawFocusHighlight(tkwin, gc, scrollPtr->highlightWidth, pixmap);
+ }
+ Tk_Draw3DRectangle(tkwin, pixmap, scrollPtr->bgBorder,
+ scrollPtr->highlightWidth, scrollPtr->highlightWidth,
+ Tk_Width(tkwin) - 2*scrollPtr->highlightWidth,
+ Tk_Height(tkwin) - 2*scrollPtr->highlightWidth,
+ scrollPtr->borderWidth, scrollPtr->relief);
+ XFillRectangle(scrollPtr->display, pixmap,
+ ((UnixScrollbar*)scrollPtr)->troughGC,
+ scrollPtr->inset, scrollPtr->inset,
+ (unsigned) (Tk_Width(tkwin) - 2*scrollPtr->inset),
+ (unsigned) (Tk_Height(tkwin) - 2*scrollPtr->inset));
+
+ /*
+ * Draw the top or left arrow. The coordinates of the polygon
+ * points probably seem odd, but they were carefully chosen with
+ * respect to X's rules for filling polygons. These point choices
+ * cause the arrows to just fill the narrow dimension of the
+ * scrollbar and be properly centered.
+ */
+
+ if (scrollPtr->activeField == TOP_ARROW) {
+ border = scrollPtr->activeBorder;
+ relief = scrollPtr->activeField == TOP_ARROW ? scrollPtr->activeRelief
+ : TK_RELIEF_RAISED;
+ } else {
+ border = scrollPtr->bgBorder;
+ relief = TK_RELIEF_RAISED;
+ }
+ if (scrollPtr->vertical) {
+ points[0].x = scrollPtr->inset - 1;
+ points[0].y = scrollPtr->arrowLength + scrollPtr->inset - 1;
+ points[1].x = width + scrollPtr->inset;
+ points[1].y = points[0].y;
+ points[2].x = width/2 + scrollPtr->inset;
+ points[2].y = scrollPtr->inset - 1;
+ Tk_Fill3DPolygon(tkwin, pixmap, border, points, 3,
+ elementBorderWidth, relief);
+ } else {
+ points[0].x = scrollPtr->arrowLength + scrollPtr->inset - 1;
+ points[0].y = scrollPtr->inset - 1;
+ points[1].x = scrollPtr->inset;
+ points[1].y = width/2 + scrollPtr->inset;
+ points[2].x = points[0].x;
+ points[2].y = width + scrollPtr->inset;
+ Tk_Fill3DPolygon(tkwin, pixmap, border, points, 3,
+ elementBorderWidth, relief);
+ }
+
+ /*
+ * Display the bottom or right arrow.
+ */
+
+ if (scrollPtr->activeField == BOTTOM_ARROW) {
+ border = scrollPtr->activeBorder;
+ relief = scrollPtr->activeField == BOTTOM_ARROW
+ ? scrollPtr->activeRelief : TK_RELIEF_RAISED;
+ } else {
+ border = scrollPtr->bgBorder;
+ relief = TK_RELIEF_RAISED;
+ }
+ if (scrollPtr->vertical) {
+ points[0].x = scrollPtr->inset;
+ points[0].y = Tk_Height(tkwin) - scrollPtr->arrowLength
+ - scrollPtr->inset + 1;
+ points[1].x = width/2 + scrollPtr->inset;
+ points[1].y = Tk_Height(tkwin) - scrollPtr->inset;
+ points[2].x = width + scrollPtr->inset;
+ points[2].y = points[0].y;
+ Tk_Fill3DPolygon(tkwin, pixmap, border,
+ points, 3, elementBorderWidth, relief);
+ } else {
+ points[0].x = Tk_Width(tkwin) - scrollPtr->arrowLength
+ - scrollPtr->inset + 1;
+ points[0].y = scrollPtr->inset - 1;
+ points[1].x = points[0].x;
+ points[1].y = width + scrollPtr->inset;
+ points[2].x = Tk_Width(tkwin) - scrollPtr->inset;
+ points[2].y = width/2 + scrollPtr->inset;
+ Tk_Fill3DPolygon(tkwin, pixmap, border,
+ points, 3, elementBorderWidth, relief);
+ }
+
+ /*
+ * Display the slider.
+ */
+
+ if (scrollPtr->activeField == SLIDER) {
+ border = scrollPtr->activeBorder;
+ relief = scrollPtr->activeField == SLIDER ? scrollPtr->activeRelief
+ : TK_RELIEF_RAISED;
+ } else {
+ border = scrollPtr->bgBorder;
+ relief = TK_RELIEF_RAISED;
+ }
+ if (scrollPtr->vertical) {
+ Tk_Fill3DRectangle(tkwin, pixmap, border,
+ scrollPtr->inset, scrollPtr->sliderFirst,
+ width, scrollPtr->sliderLast - scrollPtr->sliderFirst,
+ elementBorderWidth, relief);
+ } else {
+ Tk_Fill3DRectangle(tkwin, pixmap, border,
+ scrollPtr->sliderFirst, scrollPtr->inset,
+ scrollPtr->sliderLast - scrollPtr->sliderFirst, width,
+ elementBorderWidth, relief);
+ }
+
+ /*
+ * Copy the information from the off-screen pixmap onto the screen,
+ * then delete the pixmap.
+ */
+
+ XCopyArea(scrollPtr->display, pixmap, Tk_WindowId(tkwin),
+ ((UnixScrollbar*)scrollPtr)->copyGC, 0, 0,
+ (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin), 0, 0);
+ Tk_FreePixmap(scrollPtr->display, pixmap);
+
+ done:
+ scrollPtr->flags &= ~REDRAW_PENDING;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpComputeScrollbarGeometry --
+ *
+ * After changes in a scrollbar's size or configuration, this
+ * procedure recomputes various geometry information used in
+ * displaying the scrollbar.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The scrollbar will be displayed differently.
+ *
+ *----------------------------------------------------------------------
+ */
+
+extern void
+TkpComputeScrollbarGeometry(scrollPtr)
+ register TkScrollbar *scrollPtr; /* Scrollbar whose geometry may
+ * have changed. */
+{
+ int width, fieldLength;
+
+ if (scrollPtr->highlightWidth < 0) {
+ scrollPtr->highlightWidth = 0;
+ }
+ scrollPtr->inset = scrollPtr->highlightWidth + scrollPtr->borderWidth;
+ width = (scrollPtr->vertical) ? Tk_Width(scrollPtr->tkwin)
+ : Tk_Height(scrollPtr->tkwin);
+ scrollPtr->arrowLength = width - 2*scrollPtr->inset + 1;
+ fieldLength = (scrollPtr->vertical ? Tk_Height(scrollPtr->tkwin)
+ : Tk_Width(scrollPtr->tkwin))
+ - 2*(scrollPtr->arrowLength + scrollPtr->inset);
+ if (fieldLength < 0) {
+ fieldLength = 0;
+ }
+ scrollPtr->sliderFirst = fieldLength*scrollPtr->firstFraction;
+ scrollPtr->sliderLast = fieldLength*scrollPtr->lastFraction;
+
+ /*
+ * Adjust the slider so that some piece of it is always
+ * displayed in the scrollbar and so that it has at least
+ * a minimal width (so it can be grabbed with the mouse).
+ */
+
+ if (scrollPtr->sliderFirst > (fieldLength - 2*scrollPtr->borderWidth)) {
+ scrollPtr->sliderFirst = fieldLength - 2*scrollPtr->borderWidth;
+ }
+ if (scrollPtr->sliderFirst < 0) {
+ scrollPtr->sliderFirst = 0;
+ }
+ if (scrollPtr->sliderLast < (scrollPtr->sliderFirst
+ + MIN_SLIDER_LENGTH)) {
+ scrollPtr->sliderLast = scrollPtr->sliderFirst + MIN_SLIDER_LENGTH;
+ }
+ if (scrollPtr->sliderLast > fieldLength) {
+ scrollPtr->sliderLast = fieldLength;
+ }
+ scrollPtr->sliderFirst += scrollPtr->arrowLength + scrollPtr->inset;
+ scrollPtr->sliderLast += scrollPtr->arrowLength + scrollPtr->inset;
+
+ /*
+ * Register the desired geometry for the window (leave enough space
+ * for the two arrows plus a minimum-size slider, plus border around
+ * the whole window, if any). Then arrange for the window to be
+ * redisplayed.
+ */
+
+ if (scrollPtr->vertical) {
+ Tk_GeometryRequest(scrollPtr->tkwin,
+ scrollPtr->width + 2*scrollPtr->inset,
+ 2*(scrollPtr->arrowLength + scrollPtr->borderWidth
+ + scrollPtr->inset));
+ } else {
+ Tk_GeometryRequest(scrollPtr->tkwin,
+ 2*(scrollPtr->arrowLength + scrollPtr->borderWidth
+ + scrollPtr->inset), scrollPtr->width + 2*scrollPtr->inset);
+ }
+ Tk_SetInternalBorder(scrollPtr->tkwin, scrollPtr->inset);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyScrollbar --
+ *
+ * Free data structures associated with the scrollbar control.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees the GCs associated with the scrollbar.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyScrollbar(scrollPtr)
+ TkScrollbar *scrollPtr;
+{
+ UnixScrollbar *unixScrollPtr = (UnixScrollbar *)scrollPtr;
+
+ if (unixScrollPtr->troughGC != None) {
+ Tk_FreeGC(scrollPtr->display, unixScrollPtr->troughGC);
+ }
+ if (unixScrollPtr->copyGC != None) {
+ Tk_FreeGC(scrollPtr->display, unixScrollPtr->copyGC);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpConfigureScrollbar --
+ *
+ * This procedure is called after the generic code has finished
+ * processing configuration options, in order to configure
+ * platform specific options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Configuration info may get changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpConfigureScrollbar(scrollPtr)
+ register TkScrollbar *scrollPtr; /* Information about widget; may or
+ * may not already have values for
+ * some fields. */
+{
+ XGCValues gcValues;
+ GC new;
+ UnixScrollbar *unixScrollPtr = (UnixScrollbar *) scrollPtr;
+
+ Tk_SetBackgroundFromBorder(scrollPtr->tkwin, scrollPtr->bgBorder);
+
+ gcValues.foreground = scrollPtr->troughColorPtr->pixel;
+ new = Tk_GetGC(scrollPtr->tkwin, GCForeground, &gcValues);
+ if (unixScrollPtr->troughGC != None) {
+ Tk_FreeGC(scrollPtr->display, unixScrollPtr->troughGC);
+ }
+ unixScrollPtr->troughGC = new;
+ if (unixScrollPtr->copyGC == None) {
+ gcValues.graphics_exposures = False;
+ unixScrollPtr->copyGC = Tk_GetGC(scrollPtr->tkwin, GCGraphicsExposures,
+ &gcValues);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpScrollbarPosition --
+ *
+ * Determine the scrollbar element corresponding to a
+ * given position.
+ *
+ * Results:
+ * One of TOP_ARROW, TOP_GAP, etc., indicating which element
+ * of the scrollbar covers the position given by (x, y). If
+ * (x,y) is outside the scrollbar entirely, then OUTSIDE is
+ * returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkpScrollbarPosition(scrollPtr, x, y)
+ register TkScrollbar *scrollPtr; /* Scrollbar widget record. */
+ int x, y; /* Coordinates within scrollPtr's
+ * window. */
+{
+ int length, width, tmp;
+
+ if (scrollPtr->vertical) {
+ length = Tk_Height(scrollPtr->tkwin);
+ width = Tk_Width(scrollPtr->tkwin);
+ } else {
+ tmp = x;
+ x = y;
+ y = tmp;
+ length = Tk_Width(scrollPtr->tkwin);
+ width = Tk_Height(scrollPtr->tkwin);
+ }
+
+ if ((x < scrollPtr->inset) || (x >= (width - scrollPtr->inset))
+ || (y < scrollPtr->inset) || (y >= (length - scrollPtr->inset))) {
+ return OUTSIDE;
+ }
+
+ /*
+ * All of the calculations in this procedure mirror those in
+ * TkpDisplayScrollbar. Be sure to keep the two consistent.
+ */
+
+ if (y < (scrollPtr->inset + scrollPtr->arrowLength)) {
+ return TOP_ARROW;
+ }
+ if (y < scrollPtr->sliderFirst) {
+ return TOP_GAP;
+ }
+ if (y < scrollPtr->sliderLast) {
+ return SLIDER;
+ }
+ if (y >= (length - (scrollPtr->arrowLength + scrollPtr->inset))) {
+ return BOTTOM_ARROW;
+ }
+ return BOTTOM_GAP;
+}
diff --git a/tk/unix/tkUnixSelect.c b/tk/unix/tkUnixSelect.c
new file mode 100644
index 00000000000..e42da31d91c
--- /dev/null
+++ b/tk/unix/tkUnixSelect.c
@@ -0,0 +1,1189 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkInt.h"
+#include "tkSelect.h"
+
+/*
+ * When handling INCR-style selection retrievals, the selection owner
+ * uses the following data structure to communicate between the
+ * ConvertSelection procedure and TkSelPropProc.
+ */
+
+typedef struct IncrInfo {
+ TkWindow *winPtr; /* Window that owns selection. */
+ Atom selection; /* Selection that is being retrieved. */
+ Atom *multAtoms; /* Information about conversions to
+ * perform: one or more pairs of
+ * (target, property). This either
+ * points to a retrieved property (for
+ * MULTIPLE retrievals) or to a static
+ * array. */
+ unsigned long numConversions;
+ /* Number of entries in offsets (same as
+ * # of pairs in multAtoms). */
+ int *offsets; /* One entry for each pair in
+ * multAtoms; -1 means all data has
+ * been transferred for this
+ * conversion. -2 means only the
+ * final zero-length transfer still
+ * has to be done. Otherwise it is the
+ * offset of the next chunk of data
+ * to transfer. This array is malloc-ed. */
+ int numIncrs; /* Number of entries in offsets that
+ * aren't -1 (i.e. # of INCR-mode transfers
+ * not yet completed). */
+ Tcl_TimerToken timeout; /* Token for timer procedure. */
+ int idleTime; /* Number of seconds since we heard
+ * anything from the selection
+ * requestor. */
+ Window reqWindow; /* Requestor's window id. */
+ Time time; /* Timestamp corresponding to
+ * 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
+
+static TkSelRetrievalInfo *pendingRetrievals = NULL;
+ /* List of all retrievals currently
+ * being waited for. */
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static void ConvertSelection _ANSI_ARGS_((TkWindow *winPtr,
+ XSelectionRequestEvent *eventPtr));
+static void IncrTimeoutProc _ANSI_ARGS_((ClientData clientData));
+static char * SelCvtFromX _ANSI_ARGS_((long *propPtr, int numValues,
+ Atom type, Tk_Window tkwin));
+static long * SelCvtToX _ANSI_ARGS_((char *string, Atom type,
+ Tk_Window tkwin, int *numLongsPtr));
+static int SelectionSize _ANSI_ARGS_((TkSelHandler *selPtr));
+static void SelRcvIncrProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void SelTimeoutProc _ANSI_ARGS_((ClientData clientData));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkSelGetSelection(interp, tkwin, selection, target, proc, clientData)
+ Tcl_Interp *interp; /* Interpreter to use for reporting
+ * errors. */
+ Tk_Window tkwin; /* Window on whose behalf to retrieve
+ * the selection (determines display
+ * from which to retrieve). */
+ Atom selection; /* Selection to retrieve. */
+ 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. */
+{
+ TkSelRetrievalInfo retr;
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+
+ /*
+ * The selection is owned by some other process. To
+ * retrieve it, first record information about the retrieval
+ * in progress. Use an internal window as the requestor.
+ */
+
+ retr.interp = interp;
+ if (dispPtr->clipWindow == NULL) {
+ int result;
+
+ result = TkClipInit(interp, dispPtr);
+ if (result != TCL_OK) {
+ return result;
+ }
+ }
+ retr.winPtr = (TkWindow *) dispPtr->clipWindow;
+ retr.selection = selection;
+ retr.property = selection;
+ retr.target = target;
+ retr.proc = proc;
+ retr.clientData = clientData;
+ retr.result = -1;
+ retr.idleTime = 0;
+ retr.nextPtr = pendingRetrievals;
+ pendingRetrievals = &retr;
+
+ /*
+ * Initiate the request for the selection. Note: can't use
+ * TkCurrentTime for the time. If we do, and this application hasn't
+ * received any X events in a long time, the current time will be way
+ * in the past and could even predate the time when the selection was
+ * made; if this happens, the request will be rejected.
+ */
+
+ XConvertSelection(winPtr->display, retr.selection, retr.target,
+ retr.property, retr.winPtr->window, CurrentTime);
+
+ /*
+ * Enter a loop processing X events until the selection
+ * has been retrieved and processed. If no response is
+ * received within a few seconds, then timeout.
+ */
+
+ retr.timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc,
+ (ClientData) &retr);
+ while (retr.result == -1) {
+ Tcl_DoOneEvent(0);
+ }
+ Tcl_DeleteTimerHandler(retr.timeout);
+
+ /*
+ * Unregister the information about the selection retrieval
+ * in progress.
+ */
+
+ if (pendingRetrievals == &retr) {
+ pendingRetrievals = retr.nextPtr;
+ } else {
+ TkSelRetrievalInfo *retrPtr;
+
+ for (retrPtr = pendingRetrievals; retrPtr != NULL;
+ retrPtr = retrPtr->nextPtr) {
+ if (retrPtr->nextPtr == &retr) {
+ retrPtr->nextPtr = retr.nextPtr;
+ break;
+ }
+ }
+ }
+ return retr.result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelPropProc --
+ *
+ * This procedure is invoked when property-change events
+ * occur on windows not known to the toolkit. Its function
+ * is to implement the sending side of the INCR selection
+ * retrieval protocol when the selection requestor deletes
+ * the property containing a part of the selection.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If the property that is receiving the selection was just
+ * deleted, then a new piece of the selection is fetched and
+ * placed in the property, until eventually there's no more
+ * selection to fetch.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSelPropProc(eventPtr)
+ register XEvent *eventPtr; /* X PropertyChange event. */
+{
+ register IncrInfo *incrPtr;
+ 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)){
+ continue;
+ }
+ target = incrPtr->multAtoms[2*i];
+ incrPtr->idleTime = 0;
+ for (selPtr = incrPtr->winPtr->selHandlerList; ;
+ selPtr = selPtr->nextPtr) {
+ if (selPtr == NULL) {
+ incrPtr->multAtoms[2*i + 1] = None;
+ incrPtr->offsets[i] = -1;
+ incrPtr->numIncrs --;
+ return;
+ }
+ if ((selPtr->target == target)
+ && (selPtr->selection == incrPtr->selection)) {
+ 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;
+ }
+ if (numItems > TK_SEL_BYTES_AT_ONCE) {
+ panic("selection handler returned too many bytes");
+ } else {
+ if (numItems < 0) {
+ numItems = 0;
+ }
+ }
+ ((char *) buffer)[numItems] = '\0';
+ }
+ if (numItems < TK_SEL_BYTES_AT_ONCE) {
+ if (numItems <= 0) {
+ incrPtr->offsets[i] = -1;
+ incrPtr->numIncrs--;
+ } else {
+ incrPtr->offsets[i] = -2;
+ }
+ } else {
+ incrPtr->offsets[i] += numItems;
+ }
+ if (formatType == XA_STRING) {
+ propPtr = (char *) buffer;
+ format = 8;
+ } else {
+ propPtr = (char *) SelCvtToX((char *) buffer,
+ formatType, (Tk_Window) incrPtr->winPtr,
+ &numItems);
+ format = 32;
+ }
+ errorHandler = Tk_CreateErrorHandler(
+ eventPtr->xproperty.display, -1, -1, -1,
+ (int (*)()) NULL, (ClientData) NULL);
+ XChangeProperty(eventPtr->xproperty.display,
+ eventPtr->xproperty.window,
+ eventPtr->xproperty.atom, formatType,
+ format, PropModeReplace,
+ (unsigned char *) propPtr, numItems);
+ Tk_DeleteErrorHandler(errorHandler);
+ if (propPtr != (char *) buffer) {
+ ckfree(propPtr);
+ }
+ return;
+ }
+ }
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkSelEventProc --
+ *
+ * This procedure is invoked whenever a selection-related
+ * event occurs. It does the lion's share of the work
+ * in implementing the selection protocol.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Lots: depends on the type of event.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkSelEventProc(tkwin, eventPtr)
+ Tk_Window tkwin; /* Window for which event was
+ * targeted. */
+ register XEvent *eventPtr; /* X event: either SelectionClear,
+ * SelectionRequest, or
+ * SelectionNotify. */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ Tcl_Interp *interp;
+
+ /*
+ * Case #1: SelectionClear events.
+ */
+
+ if (eventPtr->type == SelectionClear) {
+ TkSelClearSelection(tkwin, eventPtr);
+ }
+
+ /*
+ * Case #2: SelectionNotify events. Call the relevant procedure
+ * to handle the incoming selection.
+ */
+
+ if (eventPtr->type == SelectionNotify) {
+ register TkSelRetrievalInfo *retrPtr;
+ char *propInfo;
+ Atom type;
+ int format, result;
+ unsigned long numItems, bytesAfter;
+
+ for (retrPtr = pendingRetrievals; ; retrPtr = retrPtr->nextPtr) {
+ if (retrPtr == NULL) {
+ return;
+ }
+ if ((retrPtr->winPtr == winPtr)
+ && (retrPtr->selection == eventPtr->xselection.selection)
+ && (retrPtr->target == eventPtr->xselection.target)
+ && (retrPtr->result == -1)) {
+ if (retrPtr->property == eventPtr->xselection.property) {
+ break;
+ }
+ if (eventPtr->xselection.property == None) {
+ Tcl_SetResult(retrPtr->interp, (char *) NULL, TCL_STATIC);
+ Tcl_AppendResult(retrPtr->interp,
+ Tk_GetAtomName(tkwin, retrPtr->selection),
+ " selection doesn't exist or form \"",
+ Tk_GetAtomName(tkwin, retrPtr->target),
+ "\" not defined", (char *) NULL);
+ retrPtr->result = TCL_ERROR;
+ return;
+ }
+ }
+ }
+
+ propInfo = NULL;
+ result = XGetWindowProperty(eventPtr->xselection.display,
+ eventPtr->xselection.requestor, retrPtr->property,
+ 0, MAX_PROP_WORDS, False, (Atom) AnyPropertyType,
+ &type, &format, &numItems, &bytesAfter,
+ (unsigned char **) &propInfo);
+ if ((result != Success) || (type == None)) {
+ return;
+ }
+ if (bytesAfter != 0) {
+ Tcl_SetResult(retrPtr->interp, "selection property too large",
+ TCL_STATIC);
+ 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);
+ Tcl_Release((ClientData) interp);
+ } else if (type == dispPtr->incrAtom) {
+
+ /*
+ * It's a !?#@!?!! INCR-style reception. Arrange to receive
+ * the selection in pieces, using the ICCCM protocol, then
+ * hang around until either the selection is all here or a
+ * timeout occurs.
+ */
+
+ retrPtr->idleTime = 0;
+ Tk_CreateEventHandler(tkwin, PropertyChangeMask, SelRcvIncrProc,
+ (ClientData) retrPtr);
+ XDeleteProperty(Tk_Display(tkwin), Tk_WindowId(tkwin),
+ retrPtr->property);
+ while (retrPtr->result == -1) {
+ Tcl_DoOneEvent(0);
+ }
+ 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);
+ retrPtr->result = (*retrPtr->proc)(retrPtr->clientData,
+ interp, string);
+ Tcl_Release((ClientData) interp);
+ ckfree(string);
+ }
+ XFree(propInfo);
+ return;
+ }
+
+ /*
+ * Case #3: SelectionRequest events. Call ConvertSelection to
+ * do the dirty work.
+ */
+
+ if (eventPtr->type == SelectionRequest) {
+ ConvertSelection(winPtr, &eventPtr->xselectionrequest);
+ return;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SelTimeoutProc --
+ *
+ * This procedure is invoked once every second while waiting for
+ * the selection to be returned. After a while it gives up and
+ * aborts the selection retrieval.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new timer callback is created to call us again in another
+ * second, unless time has expired, in which case an error is
+ * recorded for the retrieval.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SelTimeoutProc(clientData)
+ ClientData clientData; /* Information about retrieval
+ * in progress. */
+{
+ register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData;
+
+ /*
+ * Make sure that the retrieval is still in progress. Then
+ * see how long it's been since any sort of response was received
+ * from the other side.
+ */
+
+ if (retrPtr->result != -1) {
+ return;
+ }
+ retrPtr->idleTime++;
+ if (retrPtr->idleTime >= 5) {
+
+ /*
+ * Use a careful procedure to store the error message, because
+ * the result could already be partially filled in with a partial
+ * selection return.
+ */
+
+ Tcl_SetResult(retrPtr->interp, "selection owner didn't respond",
+ TCL_STATIC);
+ retrPtr->result = TCL_ERROR;
+ } else {
+ retrPtr->timeout = Tcl_CreateTimerHandler(1000, SelTimeoutProc,
+ (ClientData) retrPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertSelection --
+ *
+ * This procedure is invoked to handle SelectionRequest events.
+ * It responds to the requests, obeying the ICCCM protocols.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Properties are created for the selection requestor, and a
+ * SelectionNotify event is generated for the selection
+ * requestor. In the event of long selections, this procedure
+ * implements INCR-mode transfers, using the ICCCM protocol.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConvertSelection(winPtr, eventPtr)
+ TkWindow *winPtr; /* Window that received the
+ * conversion request; may not be
+ * selection's current owner, be we
+ * set it to the current owner. */
+ register XSelectionRequestEvent *eventPtr;
+ /* Event describing request. */
+{
+ XSelectionEvent reply; /* Used to notify requestor that
+ * selection info is ready. */
+ int multiple; /* Non-zero means a MULTIPLE request
+ * is being handled. */
+ 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.
+ */
+
+ reply.type = SelectionNotify;
+ reply.serial = 0;
+ reply.send_event = True;
+ reply.display = eventPtr->display;
+ reply.requestor = eventPtr->requestor;
+ reply.selection = eventPtr->selection;
+ reply.target = eventPtr->target;
+ reply.property = eventPtr->property;
+ if (reply.property == None) {
+ reply.property = reply.target;
+ }
+ reply.time = eventPtr->time;
+
+ for (infoPtr = winPtr->dispPtr->selectionInfoPtr; infoPtr != NULL;
+ infoPtr = infoPtr->nextPtr) {
+ if (infoPtr->selection == eventPtr->selection)
+ break;
+ }
+ if (infoPtr == NULL) {
+ goto refuse;
+ }
+ winPtr = (TkWindow *) infoPtr->owner;
+
+ /*
+ * Figure out which kind(s) of conversion to perform. If handling
+ * a MULTIPLE conversion, then read the property describing which
+ * conversions to perform.
+ */
+
+ incr.winPtr = winPtr;
+ incr.selection = eventPtr->selection;
+ if (eventPtr->target != winPtr->dispPtr->multipleAtom) {
+ multiple = 0;
+ singleInfo[0] = reply.target;
+ singleInfo[1] = reply.property;
+ incr.multAtoms = singleInfo;
+ incr.numConversions = 1;
+ } else {
+ Atom type;
+ int format, result;
+ unsigned long bytesAfter;
+
+ multiple = 1;
+ incr.multAtoms = NULL;
+ if (eventPtr->property == None) {
+ goto refuse;
+ }
+ result = XGetWindowProperty(eventPtr->display,
+ eventPtr->requestor, eventPtr->property,
+ 0, MAX_PROP_WORDS, False, XA_ATOM,
+ &type, &format, &incr.numConversions, &bytesAfter,
+ (unsigned char **) &incr.multAtoms);
+ if ((result != Success) || (bytesAfter != 0) || (format != 32)
+ || (type == None)) {
+ if (incr.multAtoms != NULL) {
+ XFree((char *) incr.multAtoms);
+ }
+ goto refuse;
+ }
+ incr.numConversions /= 2; /* Two atoms per conversion. */
+ }
+
+ /*
+ * Loop through all of the requested conversions, and either return
+ * the entire converted selection, if it can be returned in a single
+ * bunch, or return INCR information only (the actual selection will
+ * be returned below).
+ */
+
+ incr.offsets = (int *) ckalloc((unsigned)
+ (incr.numConversions*sizeof(int)));
+ incr.numIncrs = 0;
+ for (i = 0; i < incr.numConversions; i++) {
+ Atom target, property, type;
+ long buffer[TK_SEL_WORDS_AT_ONCE];
+ register TkSelHandler *selPtr;
+ int numItems, format;
+ char *propPtr;
+
+ target = incr.multAtoms[2*i];
+ property = incr.multAtoms[2*i + 1];
+ incr.offsets[i] = -1;
+
+ for (selPtr = winPtr->selHandlerList; selPtr != NULL;
+ selPtr = selPtr->nextPtr) {
+ if ((selPtr->target == target)
+ && (selPtr->selection == eventPtr->selection)) {
+ break;
+ }
+ }
+
+ if (selPtr == NULL) {
+ /*
+ * Nobody seems to know about this kind of request. If
+ * it's of a sort that we can handle without any help, do
+ * it. Otherwise mark the request as an errror.
+ */
+
+ numItems = TkSelDefaultSelection(infoPtr, target, (char *) buffer,
+ 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");
+ }
+ ((char *) buffer)[numItems] = '\0';
+ }
+
+ /*
+ * Got the selection; store it back on the requestor's property.
+ */
+
+ if (numItems == TK_SEL_BYTES_AT_ONCE) {
+ /*
+ * Selection is too big to send at once; start an
+ * INCR-mode transfer.
+ */
+
+ incr.numIncrs++;
+ type = winPtr->dispPtr->incrAtom;
+ buffer[0] = SelectionSize(selPtr);
+ if (buffer[0] == 0) {
+ incr.multAtoms[2*i + 1] = None;
+ continue;
+ }
+ numItems = 1;
+ propPtr = (char *) buffer;
+ format = 32;
+ incr.offsets[i] = 0;
+ } else if (type == XA_STRING) {
+ propPtr = (char *) buffer;
+ format = 8;
+ } else {
+ propPtr = (char *) SelCvtToX((char *) buffer,
+ type, (Tk_Window) winPtr, &numItems);
+ format = 32;
+ }
+ XChangeProperty(reply.display, reply.requestor,
+ property, type, format, PropModeReplace,
+ (unsigned char *) propPtr, numItems);
+ if (propPtr != (char *) buffer) {
+ ckfree(propPtr);
+ }
+ }
+
+ /*
+ * Send an event back to the requestor to indicate that the
+ * first stage of conversion is complete (everything is done
+ * except for long conversions that have to be done in INCR
+ * mode).
+ */
+
+ 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 {
+
+ /*
+ * Not a MULTIPLE request. The first property in "multAtoms"
+ * got set to None if there was an error in conversion.
+ */
+
+ reply.property = incr.multAtoms[1];
+ }
+ XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply);
+ Tk_DeleteErrorHandler(errorHandler);
+
+ /*
+ * Handle any remaining INCR-mode transfers. This all happens
+ * in callbacks to TkSelPropProc, so just wait until the number
+ * of uncompleted INCR transfers drops to zero.
+ */
+
+ if (incr.numIncrs > 0) {
+ IncrInfo *incrPtr2;
+
+ while (incr.numIncrs > 0) {
+ 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;
+ }
+ }
+ }
+ }
+
+ /*
+ * All done. Cleanup and return.
+ */
+
+ ckfree((char *) incr.offsets);
+ if (multiple) {
+ XFree((char *) incr.multAtoms);
+ }
+ return;
+
+ /*
+ * An error occurred. Send back a refusal message.
+ */
+
+ refuse:
+ reply.property = None;
+ XSendEvent(reply.display, reply.requestor, False, 0, (XEvent *) &reply);
+ Tk_DeleteErrorHandler(errorHandler);
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SelRcvIncrProc --
+ *
+ * This procedure handles the INCR protocol on the receiving
+ * side. It is invoked in response to property changes on
+ * the requestor's window (which hopefully are because a new
+ * chunk of the selection arrived).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If a new piece of selection has arrived, a procedure is
+ * invoked to deal with that piece. When the whole selection
+ * is here, a flag is left for the higher-level procedure that
+ * initiated the selection retrieval.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SelRcvIncrProc(clientData, eventPtr)
+ ClientData clientData; /* Information about retrieval. */
+ register XEvent *eventPtr; /* X PropertyChange event. */
+{
+ register TkSelRetrievalInfo *retrPtr = (TkSelRetrievalInfo *) clientData;
+ char *propInfo;
+ Atom type;
+ int format, result;
+ unsigned long numItems, bytesAfter;
+ Tcl_Interp *interp;
+
+ if ((eventPtr->xproperty.atom != retrPtr->property)
+ || (eventPtr->xproperty.state != PropertyNewValue)
+ || (retrPtr->result != -1)) {
+ return;
+ }
+ propInfo = NULL;
+ result = XGetWindowProperty(eventPtr->xproperty.display,
+ eventPtr->xproperty.window, retrPtr->property, 0, MAX_PROP_WORDS,
+ True, (Atom) AnyPropertyType, &type, &format, &numItems,
+ &bytesAfter, (unsigned char **) &propInfo);
+ if ((result != Success) || (type == None)) {
+ return;
+ }
+ if (bytesAfter != 0) {
+ Tcl_SetResult(retrPtr->interp, "selection property too large",
+ TCL_STATIC);
+ retrPtr->result = TCL_ERROR;
+ goto done;
+ }
+ 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);
+ result = (*retrPtr->proc)(retrPtr->clientData, interp, string);
+ Tcl_Release((ClientData) interp);
+ if (result != TCL_OK) {
+ retrPtr->result = result;
+ }
+ ckfree(string);
+ }
+
+ done:
+ XFree(propInfo);
+ retrPtr->idleTime = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SelectionSize --
+ *
+ * This procedure is called when the selection is too large to
+ * send in a single buffer; it computes the total length of
+ * the selection in bytes.
+ *
+ * Results:
+ * The return value is the number of bytes in the selection
+ * given by selPtr.
+ *
+ * Side effects:
+ * The selection is retrieved from its current owner (this is
+ * the only way to compute its size).
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+SelectionSize(selPtr)
+ TkSelHandler *selPtr; /* Information about how to retrieve
+ * the selection whose size is wanted. */
+{
+ 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 --
+ *
+ * This procedure is invoked once a second while sending the
+ * selection to a requestor in INCR mode. After a while it
+ * gives up and aborts the selection operation.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A new timeout gets registered so that this procedure gets
+ * called again in another second, unless too many seconds
+ * have elapsed, in which case incrPtr is marked as "all done".
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+IncrTimeoutProc(clientData)
+ ClientData clientData; /* Information about INCR-mode
+ * selection retrieval for which
+ * we are selection owner. */
+{
+ register IncrInfo *incrPtr = (IncrInfo *) clientData;
+
+ incrPtr->idleTime++;
+ if (incrPtr->idleTime >= 5) {
+ incrPtr->numIncrs = 0;
+ } else {
+ incrPtr->timeout = Tcl_CreateTimerHandler(1000, IncrTimeoutProc,
+ (ClientData) incrPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SelCvtToX --
+ *
+ * Given a selection represented as a string (the normal Tcl form),
+ * convert it to the ICCCM-mandated format for X, depending on
+ * the type argument. This procedure and SelCvtFromX are inverses.
+ *
+ * Results:
+ * The return value is a malloc'ed buffer holding a value
+ * equivalent to "string", but formatted as for "type". It is
+ * the caller's responsibility to free the string when done with
+ * it. The word at *numLongsPtr is filled in with the number of
+ * 32-bit words returned in the result.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static long *
+SelCvtToX(string, type, tkwin, numLongsPtr)
+ char *string; /* String representation of selection. */
+ Atom type; /* Atom specifying the X format that is
+ * desired for the selection. Should not
+ * be XA_STRING (if so, don't bother calling
+ * this procedure at all). */
+ Tk_Window tkwin; /* Window that governs atom conversion. */
+ int *numLongsPtr; /* Number of 32-bit words contained in the
+ * result. */
+{
+ register char *p;
+ char *field;
+ int numFields;
+ long *propPtr, *longPtr;
+#define MAX_ATOM_NAME_LENGTH 100
+ char atomName[MAX_ATOM_NAME_LENGTH+1];
+
+ /*
+ * The string is assumed to consist of fields separated by spaces.
+ * The property gets generated by converting each field to an
+ * integer number, in one of two ways:
+ * 1. If type is XA_ATOM, convert each field to its corresponding
+ * atom.
+ * 2. If type is anything else, convert each field from an ASCII number
+ * to a 32-bit binary number.
+ */
+
+ numFields = 1;
+ for (p = string; *p != 0; p++) {
+ if (isspace(UCHAR(*p))) {
+ numFields++;
+ }
+ }
+ propPtr = (long *) ckalloc((unsigned) numFields*sizeof(long));
+
+ /*
+ * Convert the fields one-by-one.
+ */
+
+ for (longPtr = propPtr, *numLongsPtr = 0, p = string;
+ ; longPtr++, (*numLongsPtr)++) {
+ while (isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (*p == 0) {
+ break;
+ }
+ field = p;
+ while ((*p != 0) && !isspace(UCHAR(*p))) {
+ p++;
+ }
+ if (type == XA_ATOM) {
+ int length;
+
+ length = p - field;
+ if (length > MAX_ATOM_NAME_LENGTH) {
+ length = MAX_ATOM_NAME_LENGTH;
+ }
+ strncpy(atomName, field, (unsigned) length);
+ atomName[length] = 0;
+ *longPtr = (long) Tk_InternAtom(tkwin, atomName);
+ } else {
+ char *dummy;
+
+ *longPtr = strtol(field, &dummy, 0);
+ }
+ }
+ return propPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SelCvtFromX --
+ *
+ * Given an X property value, formatted as a collection of 32-bit
+ * values according to "type" and the ICCCM conventions, convert
+ * the value to a string suitable for manipulation by Tcl. This
+ * procedure is the inverse of SelCvtToX.
+ *
+ * Results:
+ * The return value is the string equivalent of "property". It is
+ * malloc-ed and should be freed by the caller when no longer
+ * needed.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+SelCvtFromX(propPtr, numValues, type, tkwin)
+ register long *propPtr; /* Property value from X. */
+ int numValues; /* Number of 32-bit values in property. */
+ Atom type; /* Type of property Should not be
+ * XA_STRING (if so, don't bother calling
+ * this procedure at all). */
+ Tk_Window tkwin; /* Window to use for atom conversion. */
+{
+ char *result;
+ int resultSpace, curSize, fieldSize;
+ char *atomName;
+
+ /*
+ * Convert each long in the property to a string value, which is
+ * either the name of an atom (if type is XA_ATOM) or a hexadecimal
+ * string. Make an initial guess about the size of the result, but
+ * be prepared to enlarge the result if necessary.
+ */
+
+ resultSpace = 12*numValues+1;
+ curSize = 0;
+ atomName = ""; /* Not needed, but eliminates compiler warning. */
+ result = (char *) ckalloc((unsigned) resultSpace);
+ *result = '\0';
+ for ( ; numValues > 0; propPtr++, numValues--) {
+ if (type == XA_ATOM) {
+ atomName = Tk_GetAtomName(tkwin, (Atom) *propPtr);
+ fieldSize = strlen(atomName) + 1;
+ } else {
+ fieldSize = 12;
+ }
+ if (curSize+fieldSize >= resultSpace) {
+ char *newResult;
+
+ resultSpace *= 2;
+ if (curSize+fieldSize >= resultSpace) {
+ resultSpace = curSize + fieldSize + 1;
+ }
+ newResult = (char *) ckalloc((unsigned) resultSpace);
+ strncpy(newResult, result, (unsigned) curSize);
+ ckfree(result);
+ result = newResult;
+ }
+ if (curSize != 0) {
+ result[curSize] = ' ';
+ curSize++;
+ }
+ if (type == XA_ATOM) {
+ strcpy(result+curSize, atomName);
+ } else {
+ sprintf(result+curSize, "0x%x", (unsigned int) *propPtr);
+ }
+ curSize += strlen(result+curSize);
+ }
+ return result;
+}
diff --git a/tk/unix/tkUnixSend.c b/tk/unix/tkUnixSend.c
new file mode 100644
index 00000000000..f9ce316a106
--- /dev/null
+++ b/tk/unix/tkUnixSend.c
@@ -0,0 +1,1851 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkUnixInt.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. NULL
+ * means that the application was unregistered
+ * or deleted while a send was in progress
+ * to it. */
+ TkDisplay *dispPtr; /* Display for the application. Needed
+ * because we may need to unregister the
+ * interpreter after its main window has
+ * 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
+ * to an interpreter named "name".
+ *
+ * When the registry is being manipulated by an application (e.g. to
+ * add or remove an entry), it is loaded into memory using a structure
+ * of the following type:
+ */
+
+typedef struct NameRegistry {
+ TkDisplay *dispPtr; /* Display from which the registry was
+ * 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;
+
+/*
+ * 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. */
+ 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,
+ * when a result is returned from a sent command, it is also appended
+ * to the comm property.
+ *
+ * Each command and each result takes the form of ASCII text. For a
+ * command, the text consists of a zero character followed by several
+ * null-terminated ASCII strings. The first string consists of the
+ * single letter "c". Subsequent strings have the form "option value"
+ * where the following options are supported:
+ *
+ * -r commWindow serial
+ *
+ * This option means that a response should be sent to the window
+ * whose X identifier is "commWindow" (in hex), and the response should
+ * be identified with the serial number given by "serial" (in decimal).
+ * If this option isn't specified then the send is asynchronous and
+ * no response is sent.
+ *
+ * -n name
+ * "Name" gives the name of the application for which the command is
+ * intended. This option must be present.
+ *
+ * -s script
+ *
+ * "Script" is the script to be executed. This option must be present.
+ *
+ * The options may appear in any order. The -n and -s options must be
+ * present, but -r may be omitted for asynchronous RPCs. For compatibility
+ * with future releases that may add new features, there may be additional
+ * options present; as long as they start with a "-" character, they will
+ * be ignored.
+ *
+ * A result also consists of a zero character followed by several null-
+ * terminated ASCII strings. The first string consists of the single
+ * letter "r". Subsequent strings have the form "option value" where
+ * the following options are supported:
+ *
+ * -s serial
+ *
+ * Identifies the command for which this is the result. It is the
+ * same as the "serial" field from the -s option in the command. This
+ * option must be present.
+ *
+ * -c code
+ *
+ * "Code" is the completion code for the script, in decimal. If the
+ * code is omitted it defaults to TCL_OK.
+ *
+ * -r result
+ *
+ * "Result" is the result string for the script, which may be either
+ * a result or an error message. If this field is omitted then it
+ * defaults to an empty string.
+ *
+ * -i errorInfo
+ *
+ * "ErrorInfo" gives a string with which to initialize the errorInfo
+ * variable. This option may be omitted; it is ignored unless the
+ * completion code is TCL_ERROR.
+ *
+ * -e errorCode
+ *
+ * "ErrorCode" gives a string with with to initialize the errorCode
+ * variable. This option may be omitted; it is ignored unless the
+ * completion code is TCL_ERROR.
+ *
+ * Options may appear in any order, and only the -s option must be
+ * present. As with commands, there may be additional options besides
+ * these; unknown options are ignored.
+ */
+
+/*
+ * The following variable is the serial number that was used in the
+ * last "send" command. It is exported only for testing purposes.
+ */
+
+int tkSendSerial = 0;
+
+/*
+ * Maximum size property that can be read at one time by
+ * this module:
+ */
+
+#define MAX_PROP_WORDS 100000
+
+/*
+ * The following variable can be set while debugging to do things like
+ * skip locking the server.
+ */
+
+static int sendDebug = 0;
+
+/*
+ * 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,
+ TkDisplay *dispPtr, int lock));
+static void SendEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int SendInit _ANSI_ARGS_((Tcl_Interp *interp,
+ TkDisplay *dispPtr));
+static Tk_RestrictAction SendRestrictProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static int ServerSecure _ANSI_ARGS_((TkDisplay *dispPtr));
+static void UpdateCommWindow _ANSI_ARGS_((TkDisplay *dispPtr));
+static int ValidateName _ANSI_ARGS_((TkDisplay *dispPtr,
+ char *name, Window commWindow, int oldOK));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RegOpen --
+ *
+ * This procedure loads the name registry for a display into
+ * memory so that it can be manipulated.
+ *
+ * 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
+ * (errors cause a panic so in fact no
+ * error is ever returned, but the interpreter
+ * is needed anyway). */
+ TkDisplay *dispPtr; /* Display whose name registry is to be
+ * opened. */
+ int lock; /* Non-zero means lock the window server
+ * when opening the registry, so no-one
+ * else can use the registry until we
+ * close it. */
+{
+ NameRegistry *regPtr;
+ int result, actualFormat;
+ unsigned long bytesAfter;
+ Atom actualType;
+
+ if (dispPtr->commTkwin == NULL) {
+ SendInit(interp, dispPtr);
+ }
+
+ regPtr = (NameRegistry *) ckalloc(sizeof(NameRegistry));
+ regPtr->dispPtr = dispPtr;
+ regPtr->locked = 0;
+ regPtr->modified = 0;
+ regPtr->allocedByX = 1;
+
+ if (lock && !sendDebug) {
+ XGrabServer(dispPtr->display);
+ regPtr->locked = 1;
+ }
+
+ /*
+ * Read the registry property.
+ */
+
+ result = XGetWindowProperty(dispPtr->display,
+ RootWindow(dispPtr->display, 0),
+ dispPtr->registryProperty, 0, MAX_PROP_WORDS,
+ False, XA_STRING, &actualType, &actualFormat,
+ &regPtr->propLength, &bytesAfter,
+ (unsigned char **) &regPtr->property);
+
+ if (actualType == None) {
+ regPtr->propLength = 0;
+ regPtr->property = NULL;
+ } else if ((result != Success) || (actualFormat != 8)
+ || (actualType != XA_STRING)) {
+ /*
+ * The property is improperly formed; delete it.
+ */
+
+ if (regPtr->property != NULL) {
+ XFree(regPtr->property);
+ regPtr->propLength = 0;
+ regPtr->property = NULL;
+ }
+ XDeleteProperty(dispPtr->display,
+ RootWindow(dispPtr->display, 0),
+ dispPtr->registryProperty);
+ }
+
+ /*
+ * Xlib placed an extra null byte after the end of the property, just
+ * to make sure that it is always NULL-terminated. Be sure to include
+ * this byte in our count if it's needed to ensure null termination
+ * (note: as of 8/95 I'm no longer sure why this code is needed; seems
+ * like it shouldn't be).
+ */
+
+ if ((regPtr->propLength > 0)
+ && (regPtr->property[regPtr->propLength-1] != 0)) {
+ regPtr->propLength++;
+ }
+ return regPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RegFindName --
+ *
+ * Given an open name registry, this procedure finds an entry
+ * with a given name, if there is one, and returns information
+ * about that entry.
+ *
+ * Results:
+ * The return value is the X identifier for the comm window for
+ * the application named "name", or None if there is no such
+ * entry in the registry.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Window
+RegFindName(regPtr, name)
+ NameRegistry *regPtr; /* Pointer to a registry opened with a
+ * previous call to RegOpen. */
+ char *name; /* Name of an application. */
+{
+ char *p, *entry;
+ unsigned int id;
+
+ for (p = regPtr->property; (p-regPtr->property) < (int) regPtr->propLength; ) {
+ entry = p;
+ while ((*p != 0) && (!isspace(UCHAR(*p)))) {
+ p++;
+ }
+ if ((*p != 0) && (strcmp(name, p+1) == 0)) {
+ if (sscanf(entry, "%x", &id) == 1) {
+ /*
+ * Must cast from an unsigned int to a Window in case we
+ * are on a 64-bit architecture.
+ */
+
+ return (Window) id;
+ }
+ }
+ while (*p != 0) {
+ p++;
+ }
+ p++;
+ }
+ return None;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RegDeleteName --
+ *
+ * This procedure deletes the entry for a given name from
+ * an open registry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there used to be an entry named "name" in the registry,
+ * then it is deleted and the registry is marked as modified
+ * so it will be written back when closed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RegDeleteName(regPtr, name)
+ NameRegistry *regPtr; /* Pointer to a registry opened with a
+ * previous call to RegOpen. */
+ char *name; /* Name of an application. */
+{
+ char *p, *entry, *entryName;
+ int count;
+
+ for (p = regPtr->property; (p-regPtr->property) < (int) regPtr->propLength; ) {
+ entry = p;
+ while ((*p != 0) && (!isspace(UCHAR(*p)))) {
+ p++;
+ }
+ if (*p != 0) {
+ p++;
+ }
+ entryName = p;
+ while (*p != 0) {
+ p++;
+ }
+ p++;
+ if ((strcmp(name, entryName) == 0)) {
+ /*
+ * Found the matching entry. Copy everything after it
+ * down on top of it.
+ */
+
+ count = regPtr->propLength - (p - regPtr->property);
+ if (count > 0) {
+ char *src, *dst;
+
+ for (src = p, dst = entry; count > 0; src++, dst++, count--) {
+ *dst = *src;
+ }
+ }
+ regPtr->propLength -= p - entry;
+ regPtr->modified = 1;
+ return;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RegAddName --
+ *
+ * Add a new entry to an open registry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The open registry is expanded; it is marked as modified so that
+ * it will be written back when closed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RegAddName(regPtr, name, commWindow)
+ NameRegistry *regPtr; /* Pointer to a registry opened with a
+ * previous call to RegOpen. */
+ char *name; /* Name of an application. The caller
+ * must ensure that this name isn't
+ * already registered. */
+ Window commWindow; /* X identifier for comm. window of
+ * application. */
+{
+ char id[30];
+ char *newProp;
+ int idLength, newBytes;
+
+ sprintf(id, "%x ", (unsigned int) commWindow);
+ idLength = strlen(id);
+ newBytes = idLength + strlen(name) + 1;
+ newProp = (char *) ckalloc((unsigned) (regPtr->propLength + newBytes));
+ strcpy(newProp, id);
+ strcpy(newProp+idLength, name);
+ if (regPtr->property != NULL) {
+ memcpy((VOID *) (newProp + newBytes), (VOID *) regPtr->property,
+ regPtr->propLength);
+ if (regPtr->allocedByX) {
+ XFree(regPtr->property);
+ } else {
+ ckfree(regPtr->property);
+ }
+ }
+ regPtr->modified = 1;
+ regPtr->propLength += newBytes;
+ regPtr->property = newProp;
+ regPtr->allocedByX = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RegClose --
+ *
+ * This procedure is called to end a series of operations on
+ * a name registry.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The registry is written back if it has been modified, and the
+ * X server is unlocked if it was locked. Memory for the
+ * registry is freed, so the caller should never use regPtr
+ * again.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RegClose(regPtr)
+ NameRegistry *regPtr; /* Pointer to a registry opened with a
+ * previous call to RegOpen. */
+{
+ if (regPtr->modified) {
+ if (!regPtr->locked && !sendDebug) {
+ panic("The name registry was modified without being locked!");
+ }
+ XChangeProperty(regPtr->dispPtr->display,
+ RootWindow(regPtr->dispPtr->display, 0),
+ regPtr->dispPtr->registryProperty, XA_STRING, 8,
+ PropModeReplace, (unsigned char *) regPtr->property,
+ (int) regPtr->propLength);
+ }
+
+ if (regPtr->locked) {
+ XUngrabServer(regPtr->dispPtr->display);
+ }
+
+ /*
+ * After ungrabbing the server, it's important to flush the output
+ * immediately so that the server sees the ungrab command. Otherwise
+ * we might do something else that needs to communicate with the
+ * server (such as invoking a subprocess that needs to do I/O to
+ * the screen); if the ungrab command is still sitting in our
+ * output buffer, we could deadlock.
+ */
+
+ XFlush(regPtr->dispPtr->display);
+
+ if (regPtr->property != NULL) {
+ if (regPtr->allocedByX) {
+ XFree(regPtr->property);
+ } else {
+ ckfree(regPtr->property);
+ }
+ }
+ ckfree((char *) regPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ValidateName --
+ *
+ * This procedure checks to see if an entry in the registry
+ * is still valid.
+ *
+ * Results:
+ * The return value is 1 if the given commWindow exists and its
+ * name is "name". Otherwise 0 is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ValidateName(dispPtr, name, commWindow, oldOK)
+ TkDisplay *dispPtr; /* Display for which to perform the
+ * validation. */
+ char *name; /* The name of an application. */
+ Window commWindow; /* X identifier for the application's
+ * comm. window. */
+ int oldOK; /* Non-zero means that we should consider
+ * an application to be valid even if it
+ * looks like an old-style (pre-4.0) one;
+ * 0 means consider these invalid. */
+{
+ int result, actualFormat, argc, i;
+ unsigned long length, bytesAfter;
+ Atom actualType;
+ char *property;
+ Tk_ErrorHandler handler;
+ char **argv;
+
+ property = NULL;
+
+ /*
+ * Ignore X errors when reading the property (e.g., the window
+ * might not exist). If an error occurs, result will be some
+ * value other than Success.
+ */
+
+ handler = Tk_CreateErrorHandler(dispPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ result = XGetWindowProperty(dispPtr->display, commWindow,
+ dispPtr->appNameProperty, 0, MAX_PROP_WORDS,
+ False, XA_STRING, &actualType, &actualFormat,
+ &length, &bytesAfter, (unsigned char **) &property);
+
+ if ((result == Success) && (actualType == None)) {
+ XWindowAttributes atts;
+
+ /*
+ * The comm. window exists but the property we're looking for
+ * doesn't exist. This probably means that the application
+ * comes from an older version of Tk (< 4.0) that didn't set the
+ * property; if this is the case, then assume for compatibility's
+ * sake that everything's OK. However, it's also possible that
+ * some random application has re-used the window id for something
+ * totally unrelated. Check a few characteristics of the window,
+ * such as its dimensions and mapped state, to be sure that it
+ * still "smells" like a commWindow.
+ */
+
+ if (!oldOK
+ || !XGetWindowAttributes(dispPtr->display, commWindow, &atts)
+ || (atts.width != 1) || (atts.height != 1)
+ || (atts.map_state != IsUnmapped)) {
+ result = 0;
+ } else {
+ result = 1;
+ }
+ } else if ((result == Success) && (actualFormat == 8)
+ && (actualType == XA_STRING)) {
+ result = 0;
+ if (Tcl_SplitList((Tcl_Interp *) NULL, property, &argc, &argv)
+ == TCL_OK) {
+ for (i = 0; i < argc; i++) {
+ if (strcmp(argv[i], name) == 0) {
+ result = 1;
+ break;
+ }
+ }
+ ckfree((char *) argv);
+ }
+ } else {
+ result = 0;
+ }
+ Tk_DeleteErrorHandler(handler);
+ if (property != NULL) {
+ XFree(property);
+ }
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ServerSecure --
+ *
+ * Check whether a server is secure enough for us to trust
+ * Tcl scripts arriving via that server.
+ *
+ * Results:
+ * The return value is 1 if the server is secure, which means
+ * that host-style authentication is turned on but there are
+ * no hosts in the enabled list. This means that some other
+ * form of authorization (presumably more secure, such as xauth)
+ * is in use.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ServerSecure(dispPtr)
+ TkDisplay *dispPtr; /* Display to check. */
+{
+#ifdef TK_NO_SECURITY
+ return 1;
+#else
+ XHostAddress *addrPtr;
+ int numHosts, secure;
+ Bool enabled;
+
+ secure = 0;
+ addrPtr = XListHosts(dispPtr->display, &numHosts, &enabled);
+ if (enabled && (numHosts == 0)) {
+ secure = 1;
+ }
+ if (addrPtr != NULL) {
+ XFree((char *) addrPtr);
+ }
+ return secure;
+#endif /* TK_NO_SECURITY */
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SetAppName --
+ *
+ * This procedure is called to associate an ASCII name with a Tk
+ * application. If the application has already been named, the
+ * name replaces the old one.
+ *
+ * Results:
+ * The return value is the name actually given to the application.
+ * This will normally be the same as name, but if name was already
+ * in use for an application then a name of the form "name #2" will
+ * be chosen, with a high enough number to make the name unique.
+ *
+ * Side effects:
+ * Registration info is saved, thereby allowing the "send" command
+ * to be used later to invoke commands in the application. In
+ * addition, the "send" command is created in the application's
+ * interpreter. The registration will be removed automatically
+ * if the interpreter is deleted or the "send" command is removed.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_SetAppName(tkwin, name)
+ Tk_Window tkwin; /* Token for any window in the application
+ * 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. */
+{
+ 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
+ * larger and larger numbers until we eventually find one that is
+ * unique.
+ */
+
+ actualName = name;
+ offset = 0; /* Needed only to avoid "used before
+ * set" compiler warnings. */
+ for (i = 1; ; i++) {
+ if (i > 1) {
+ if (i == 2) {
+ Tcl_DStringInit(&dString);
+ Tcl_DStringAppend(&dString, name, -1);
+ Tcl_DStringAppend(&dString, " #", 2);
+ offset = Tcl_DStringLength(&dString);
+ Tcl_DStringSetLength(&dString, offset+10);
+ actualName = Tcl_DStringValue(&dString);
+ }
+ sprintf(actualName + offset, "%d", i);
+ }
+ w = RegFindName(regPtr, actualName);
+ if (w == None) {
+ break;
+ }
+
+ /*
+ * 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;
+ } else if (!ValidateName(winPtr->dispPtr, actualName, w, 1)) {
+ RegDeleteName(regPtr, actualName);
+ break;
+ }
+ nextSuffix:
+ continue;
+ }
+
+ /*
+ * We've now got a name to use. Store it in the name registry and
+ * in the local entry for this application, plus put it in a property
+ * on the commWindow.
+ */
+
+ RegAddName(regPtr, actualName, Tk_WindowId(dispPtr->commTkwin));
+ RegClose(regPtr);
+ riPtr->name = (char *) ckalloc((unsigned) (strlen(actualName) + 1));
+ strcpy(riPtr->name, actualName);
+ if (actualName != name) {
+ Tcl_DStringFree(&dString);
+ }
+ UpdateCommWindow(dispPtr);
+
+ return riPtr->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, interp, argc, argv)
+ ClientData clientData; /* Information about sender (only
+ * dispPtr field is used). */
+ Tcl_Interp *interp; /* Current interpreter. */
+ 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.
+ */
+
+ async = 0;
+ winPtr = (TkWindow *) Tk_MainWindow(interp);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ for (i = 1; i < (argc-1); ) {
+ if (argv[i][0] != '-') {
+ break;
+ }
+ c = argv[i][1];
+ length = strlen(argv[i]);
+ if ((c == 'a') && (strncmp(argv[i], "-async", length) == 0)) {
+ async = 1;
+ i++;
+ } else if ((c == 'd') && (strncmp(argv[i], "-displayof",
+ length) == 0)) {
+ winPtr = (TkWindow *) Tk_NameToWindow(interp, argv[i+1],
+ (Tk_Window) winPtr);
+ if (winPtr == NULL) {
+ return TCL_ERROR;
+ }
+ i += 2;
+ } else if (strcmp(argv[i], "--") == 0) {
+ i++;
+ break;
+ } else {
+ Tcl_AppendResult(interp, "bad option \"", argv[i],
+ "\": must be -async, -displayof, or --", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+
+ if (argc < (i+2)) {
+ Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
+ " ?options? interpName arg ?arg ...?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ destName = argv[i];
+ firstArg = i+1;
+
+ dispPtr = winPtr->dispPtr;
+ if (dispPtr->commTkwin == NULL) {
+ SendInit(interp, winPtr->dispPtr);
+ }
+
+ /*
+ * 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);
+ if (firstArg == (argc-1)) {
+ result = Tcl_GlobalEval(localInterp, argv[firstArg]);
+ } else {
+ Tcl_DStringInit(&request);
+ Tcl_DStringAppend(&request, argv[firstArg], -1);
+ for (i = firstArg+1; i < argc; i++) {
+ Tcl_DStringAppend(&request, " ", 1);
+ 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;
+ }
+
+ /*
+ * Bind the interpreter name to a communication window.
+ */
+
+ regPtr = RegOpen(interp, winPtr->dispPtr, 0);
+ commWindow = RegFindName(regPtr, destName);
+ RegClose(regPtr);
+ if (commWindow == None) {
+ Tcl_AppendResult(interp, "no application named \"",
+ destName, "\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+
+ /*
+ * Send the command to the target interpreter by appending it to the
+ * comm window in the communication window.
+ */
+
+ 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);
+ Tcl_DStringAppend(&request, argv[firstArg], -1);
+ for (i = firstArg+1; i < argc; i++) {
+ Tcl_DStringAppend(&request, " ", 1);
+ Tcl_DStringAppend(&request, argv[i], -1);
+ }
+ (void) AppendPropCarefully(dispPtr->display, commWindow,
+ dispPtr->commProperty, Tcl_DStringValue(&request),
+ Tcl_DStringLength(&request) + 1,
+ (async) ? (PendingCommand *) NULL : &pending);
+ Tcl_DStringFree(&request);
+ if (async) {
+ /*
+ * This is an asynchronous send: return immediately without
+ * waiting for a response.
+ */
+
+ return TCL_OK;
+ }
+
+ /*
+ * Register the fact that we're waiting for a command to complete
+ * (this is needed by SendEventProc and by AppendErrorProc to pass
+ * back the command's results). Set up a timeout handler so that
+ * we can check during long sends to make sure that the destination
+ * application is still alive.
+ */
+
+ pending.serial = tkSendSerial;
+ pending.dispPtr = dispPtr;
+ 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.
+ */
+
+ prevRestrictProc = Tk_RestrictEvents(SendRestrictProc,
+ (ClientData) NULL, &prevArg);
+ TclpGetTime(&timeout);
+ timeout.sec += 2;
+ while (!pending.gotResponse) {
+ if (!TkUnixDoOneXEvent(&timeout)) {
+ /*
+ * An unusually long amount of time has elapsed during the
+ * processing of a sent command. Check to make sure that the
+ * target application still exists. If it does, reset the timeout.
+ */
+
+ if (!ValidateName(pending.dispPtr, pending.target,
+ pending.commWindow, 0)) {
+ char *msg;
+ if (ValidateName(pending.dispPtr, pending.target,
+ pending.commWindow, 1)) {
+ msg = "target application died or uses a Tk version before 4.0";
+ } else {
+ msg = "target application died";
+ }
+ pending.code = TCL_ERROR;
+ pending.result = (char *) ckalloc((unsigned) (strlen(msg) + 1));
+ strcpy(pending.result, msg);
+ pending.gotResponse = 1;
+ } else {
+ TclpGetTime(&timeout);
+ timeout.sec += 2;
+ }
+ }
+ }
+ (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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkGetInterpNames(interp, tkwin)
+ Tcl_Interp *interp; /* Interpreter for returning a result. */
+ Tk_Window tkwin; /* Window whose display is to be used
+ * for the lookup. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ char *p, *entry, *entryName;
+ NameRegistry *regPtr;
+ Window commWindow;
+ int count;
+ unsigned int id;
+
+ /*
+ * Read the registry property, then scan through all of its entries.
+ * Validate each entry to be sure that its application still exists.
+ */
+
+ regPtr = RegOpen(interp, winPtr->dispPtr, 1);
+ for (p = regPtr->property; (p-regPtr->property) < (int) regPtr->propLength; ) {
+ entry = p;
+ if (sscanf(p, "%x",(unsigned int *) &id) != 1) {
+ commWindow = None;
+ } else {
+ commWindow = id;
+ }
+ while ((*p != 0) && (!isspace(UCHAR(*p)))) {
+ p++;
+ }
+ if (*p != 0) {
+ p++;
+ }
+ entryName = p;
+ while (*p != 0) {
+ p++;
+ }
+ p++;
+ if (ValidateName(winPtr->dispPtr, entryName, commWindow, 1)) {
+ /*
+ * The application still exists; add its name to the result.
+ */
+
+ Tcl_AppendElement(interp, entryName);
+ } else {
+ /*
+ * This name is bogus (perhaps the application died without
+ * cleaning up its entry in the registry?). Delete the name.
+ */
+
+ count = regPtr->propLength - (p - regPtr->property);
+ if (count > 0) {
+ char *src, *dst;
+
+ for (src = p, dst = entry; count > 0; src++, dst++, count--) {
+ *dst = *src;
+ }
+ }
+ regPtr->propLength -= p - entry;
+ regPtr->modified = 1;
+ p = entry;
+ }
+ }
+ RegClose(regPtr);
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SendInit --
+ *
+ * This procedure is called to initialize the
+ * communication channels for sending commands and
+ * receiving results.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets up various data structures and windows.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+SendInit(interp, dispPtr)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting
+ * (no errors are ever returned, but the
+ * interpreter is needed anyway). */
+ TkDisplay *dispPtr; /* Display to initialize. */
+{
+ XSetWindowAttributes atts;
+
+ /*
+ * Create the window used for communication, and set up an
+ * event handler for it.
+ */
+
+ dispPtr->commTkwin = Tk_CreateWindow(interp, (Tk_Window) NULL,
+ "_comm", DisplayString(dispPtr->display));
+ if (dispPtr->commTkwin == NULL) {
+ panic("Tk_CreateWindow failed in SendInit!");
+ }
+ atts.override_redirect = True;
+ Tk_ChangeWindowAttributes(dispPtr->commTkwin,
+ CWOverrideRedirect, &atts);
+ Tk_CreateEventHandler(dispPtr->commTkwin, PropertyChangeMask,
+ SendEventProc, (ClientData) dispPtr);
+ Tk_MakeWindowExist(dispPtr->commTkwin);
+
+ /*
+ * Get atoms used as property names.
+ */
+
+ dispPtr->commProperty = Tk_InternAtom(dispPtr->commTkwin, "Comm");
+ dispPtr->registryProperty = Tk_InternAtom(dispPtr->commTkwin,
+ "InterpRegistry");
+ dispPtr->appNameProperty = Tk_InternAtom(dispPtr->commTkwin,
+ "TK_APPLICATION");
+
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * SendEventProc --
+ *
+ * This procedure is invoked automatically by the toolkit
+ * event manager when a property changes on the communication
+ * window. This procedure reads the property and handles
+ * command requests and responses.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If there are command requests in the property, they
+ * are executed. If there are responses in the property,
+ * their information is saved for the (ostensibly waiting)
+ * "send" commands. The property is deleted.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+SendEventProc(clientData, eventPtr)
+ ClientData clientData; /* Display information. */
+ XEvent *eventPtr; /* Information about event. */
+{
+ 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;
+ }
+
+ /*
+ * Read the comm property and delete it.
+ */
+
+ propInfo = NULL;
+ result = XGetWindowProperty(dispPtr->display,
+ Tk_WindowId(dispPtr->commTkwin),
+ dispPtr->commProperty, 0, MAX_PROP_WORDS, True,
+ XA_STRING, &actualType, &actualFormat,
+ &numItems, &bytesAfter, (unsigned char **) &propInfo);
+
+ /*
+ * If the property doesn't exist or is improperly formed
+ * then ignore it.
+ */
+
+ if ((result != Success) || (actualType != XA_STRING)
+ || (actualFormat != 8)) {
+ if (propInfo != NULL) {
+ XFree(propInfo);
+ }
+ return;
+ }
+
+ /*
+ * Several commands and results could arrive in the property at
+ * one time; each iteration through the outer loop handles a
+ * single command or result.
+ */
+
+ for (p = propInfo; (p-propInfo) < (int) numItems; ) {
+ /*
+ * Ignore leading NULLs; each command or result starts with a
+ * NULL so that no matter how badly formed a preceding command
+ * is, we'll be able to tell that a new command/result is
+ * starting.
+ */
+
+ if (*p == 0) {
+ p++;
+ continue;
+ }
+
+ if ((*p == 'c') && (p[1] == 0)) {
+ Window commWindow;
+ char *interpName, *script, *serial, *end;
+ Tcl_DString reply;
+ RegisteredInterp *riPtr;
+
+ /*
+ *----------------------------------------------------------
+ * This is an incoming command from some other application.
+ * Iterate over all of its options. Stop when we reach
+ * the end of the property or something that doesn't look
+ * like an option.
+ *----------------------------------------------------------
+ */
+
+ p += 2;
+ interpName = NULL;
+ commWindow = None;
+ serial = "";
+ script = NULL;
+ while (((p-propInfo) < (int) numItems) && (*p == '-')) {
+ switch (p[1]) {
+ case 'r':
+ commWindow = (Window) strtoul(p+2, &end, 16);
+ if ((end == p+2) || (*end != ' ')) {
+ commWindow = None;
+ } else {
+ p = serial = end+1;
+ }
+ break;
+ case 'n':
+ if (p[2] == ' ') {
+ interpName = p+3;
+ }
+ break;
+ case 's':
+ if (p[2] == ' ') {
+ script = p+3;
+ }
+ break;
+ }
+ while (*p != 0) {
+ p++;
+ }
+ p++;
+ }
+
+ if ((script == NULL) || (interpName == NULL)) {
+ continue;
+ }
+
+ /*
+ * Initialize the result property, so that we're ready at any
+ * time if we need to return an error.
+ */
+
+ if (commWindow != None) {
+ Tcl_DStringInit(&reply);
+ Tcl_DStringAppend(&reply, "\0r\0-s ", 6);
+ Tcl_DStringAppend(&reply, serial, -1);
+ Tcl_DStringAppend(&reply, "\0-r ", 4);
+ }
+
+ if (!ServerSecure(dispPtr)) {
+ if (commWindow != None) {
+ Tcl_DStringAppend(&reply, "X server insecure (must use xauth-style authorization); command ignored", -1);
+ }
+ result = TCL_ERROR;
+ 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);
+ }
+ result = TCL_ERROR;
+ goto returnResult;
+ }
+ if (strcmp(riPtr->name, interpName) == 0) {
+ break;
+ }
+ }
+ Tcl_Preserve((ClientData) riPtr);
+
+ /*
+ * We must protect the interpreter because the script may
+ * enter another event loop, which might call Tcl_DeleteInterp.
+ */
+
+ remoteInterp = riPtr->interp;
+ Tcl_Preserve((ClientData) remoteInterp);
+
+ result = Tcl_GlobalEval(remoteInterp, script);
+
+ /*
+ * 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);
+ Tcl_DStringAppend(&reply, varValue, -1);
+ }
+ varValue = Tcl_GetVar2(remoteInterp, "errorCode",
+ (char *) NULL, TCL_GLOBAL_ONLY);
+ if (varValue != NULL) {
+ Tcl_DStringAppend(&reply, "\0-e ", 4);
+ Tcl_DStringAppend(&reply, varValue, -1);
+ }
+ }
+ }
+ Tcl_Release((ClientData) remoteInterp);
+ Tcl_Release((ClientData) riPtr);
+
+ /*
+ * Return the result to the sender if a commWindow was
+ * specified (if none was specified then this is an asynchronous
+ * 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),
+ Tcl_DStringLength(&reply) + 1,
+ (PendingCommand *) NULL);
+ XFlush(dispPtr->display);
+ Tcl_DStringFree(&reply);
+ }
+ } else if ((*p == 'r') && (p[1] == 0)) {
+ int serial, code, gotSerial;
+ char *errorInfo, *errorCode, *resultString;
+ PendingCommand *pcPtr;
+
+ /*
+ *----------------------------------------------------------
+ * This is a reply to some command that we sent out. Iterate
+ * over all of its options. Stop when we reach the end of the
+ * property or something that doesn't look like an option.
+ *----------------------------------------------------------
+ */
+
+ p += 2;
+ code = TCL_OK;
+ gotSerial = 0;
+ errorInfo = NULL;
+ errorCode = NULL;
+ resultString = "";
+ while (((p-propInfo) < (int) numItems) && (*p == '-')) {
+ switch (p[1]) {
+ case 'c':
+ if (sscanf(p+2, " %d", &code) != 1) {
+ code = TCL_OK;
+ }
+ break;
+ case 'e':
+ if (p[2] == ' ') {
+ errorCode = p+3;
+ }
+ break;
+ case 'i':
+ if (p[2] == ' ') {
+ errorInfo = p+3;
+ }
+ break;
+ case 'r':
+ if (p[2] == ' ') {
+ resultString = p+3;
+ }
+ break;
+ case 's':
+ if (sscanf(p+2, " %d", &serial) == 1) {
+ gotSerial = 1;
+ }
+ break;
+ }
+ while (*p != 0) {
+ p++;
+ }
+ p++;
+ }
+
+ if (!gotSerial) {
+ continue;
+ }
+
+ /*
+ * 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)
+ (strlen(resultString) + 1));
+ strcpy(pcPtr->result, resultString);
+ }
+ if (code == TCL_ERROR) {
+ if (errorInfo != NULL) {
+ pcPtr->errorInfo = (char *) ckalloc((unsigned)
+ (strlen(errorInfo) + 1));
+ strcpy(pcPtr->errorInfo, errorInfo);
+ }
+ if (errorCode != NULL) {
+ pcPtr->errorCode = (char *) ckalloc((unsigned)
+ (strlen(errorCode) + 1));
+ strcpy(pcPtr->errorCode, errorCode);
+ }
+ }
+ pcPtr->gotResponse = 1;
+ break;
+ }
+ } else {
+ /*
+ * Didn't recognize this thing. Just skip through the next
+ * null character and try again.
+ */
+
+ while (*p != 0) {
+ p++;
+ }
+ p++;
+ }
+ }
+ XFree(propInfo);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * AppendPropCarefully --
+ *
+ * Append a given property to a given window, but set up
+ * an X error handler so that if the append fails this
+ * procedure can return an error code rather than having
+ * Xlib panic.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The given property on the given window is appended to.
+ * If this operation fails and if pendingPtr is non-NULL,
+ * then the pending operation is marked as complete with
+ * an error.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+AppendPropCarefully(display, window, property, value, length, pendingPtr)
+ Display *display; /* Display on which to operate. */
+ Window window; /* Window whose property is to
+ * be modified. */
+ Atom property; /* Name of property. */
+ char *value; /* Characters to append to property. */
+ int length; /* Number of bytes to append. */
+ PendingCommand *pendingPtr; /* Pending command to mark complete
+ * if an error occurs during the
+ * property op. NULL means just
+ * ignore the error. */
+{
+ Tk_ErrorHandler handler;
+
+ handler = Tk_CreateErrorHandler(display, -1, -1, -1, AppendErrorProc,
+ (ClientData) pendingPtr);
+ XChangeProperty(display, window, property, XA_STRING, 8,
+ PropModeAppend, (unsigned char *) value, length);
+ Tk_DeleteErrorHandler(handler);
+}
+
+/*
+ * The procedure below is invoked if an error occurs during
+ * the XChangeProperty operation above.
+ */
+
+ /* ARGSUSED */
+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;
+ pcPtr->gotResponse = 1;
+ break;
+ }
+ }
+ return 0;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * DeleteProc --
+ *
+ * This procedure is invoked by Tcl when the "send" command
+ * is deleted in an interpreter. It unregisters the interpreter.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The interpreter given by riPtr is unregistered.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+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;
+ }
+ }
+ }
+ ckfree((char *) riPtr->name);
+ riPtr->interp = NULL;
+ UpdateCommWindow(riPtr->dispPtr);
+ Tcl_EventuallyFree((ClientData) riPtr, TCL_DYNAMIC);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SendRestrictProc --
+ *
+ * This procedure filters incoming events when a "send" command
+ * is outstanding. It defers all events except those containing
+ * send commands and results.
+ *
+ * Results:
+ * False is returned except for property-change events on a
+ * commWindow.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static Tk_RestrictAction
+SendRestrictProc(clientData, eventPtr)
+ ClientData clientData; /* Not used. */
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateCommWindow --
+ *
+ * This procedure updates the list of application names stored
+ * on our commWindow. It is typically called when interpreters
+ * are registered and unregistered.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The TK_APPLICATION property on the comm window is updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+}
diff --git a/tk/unix/tkUnixWm.c b/tk/unix/tkUnixWm.c
new file mode 100644
index 00000000000..4251c52ab23
--- /dev/null
+++ b/tk/unix/tkUnixWm.c
@@ -0,0 +1,4820 @@
+/*
+ * tkUnixWm.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) 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$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+#include "tkUnixInt.h"
+#include <errno.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.
+ */
+
+typedef struct ProtocolHandler {
+ Atom protocol; /* Identifies the protocol. */
+ struct ProtocolHandler *nextPtr;
+ /* Next in list of protocol handlers for
+ * the same top-level window, or NULL for
+ * end of list. */
+ Tcl_Interp *interp; /* Interpreter in which to invoke command. */
+ char command[4]; /* Tcl command to invoke when a client
+ * message for this protocol arrives.
+ * The actual size of the structure varies
+ * to accommodate the needs of the actual
+ * command. THIS MUST BE THE LAST FIELD OF
+ * THE STRUCTURE. */
+} ProtocolHandler;
+
+#define HANDLER_SIZE(cmdLength) \
+ ((unsigned) (sizeof(ProtocolHandler) - 3 + cmdLength))
+
+/*
+ * A data structure of the following type holds window-manager-related
+ * information for each top-level window in an application.
+ */
+
+typedef struct TkWmInfo {
+ TkWindow *winPtr; /* Pointer to main Tk information for
+ * this window. */
+ Window reparent; /* If the window has been reparented, this
+ * gives the ID of the ancestor of the window
+ * that is a child of the root window (may
+ * not be window's immediate parent). If
+ * the window isn't reparented, this has the
+ * value None. */
+ char *title; /* Title to display in window caption. If
+ * NULL, use name of widget. Malloced. */
+ char *iconName; /* Name to display in icon. Malloced. */
+ Window master; /* Master window for TRANSIENT_FOR property,
+ * or None. */
+ XWMHints hints; /* Various pieces of information for
+ * window manager. */
+ char *leaderName; /* Path name of leader of window group
+ * (corresponds to hints.window_group).
+ * Malloc-ed. Note: this field doesn't
+ * get updated if leader is destroyed. */
+ char *masterWindowName; /* Path name of window specified as master
+ * in "wm transient" command, or NULL.
+ * Malloc-ed. Note: this field doesn't
+ * get updated if masterWindowName is
+ * destroyed. */
+ Tk_Window icon; /* Window to use as icon for this window,
+ * or NULL. */
+ Tk_Window iconFor; /* Window for which this window is icon, or
+ * NULL if this isn't an icon for anyone. */
+ int withdrawn; /* Non-zero means window has been withdrawn. */
+
+ /*
+ * In order to support menubars transparently under X, each toplevel
+ * window is encased in an additional window, called the wrapper,
+ * that holds the toplevel and the menubar, if any. The information
+ * below is used to keep track of the wrapper and the menubar.
+ */
+
+ TkWindow *wrapperPtr; /* Pointer to information about the wrapper.
+ * This is the "real" toplevel window as
+ * seen by the window manager. Although
+ * this is an official Tk window, it
+ * doesn't appear in the application's
+ * window hierarchy. NULL means that
+ * the wrapper hasn't been created yet. */
+ Tk_Window menubar; /* Pointer to information about the
+ * menubar, or NULL if there is no
+ * menubar for this toplevel. */
+ int menuHeight; /* Amount of vertical space needed for
+ * menubar, measured in pixels. If
+ * menubar is non-NULL, this is >= 1 (X
+ * servers don't like dimensions of 0). */
+
+ /*
+ * Information used to construct an XSizeHints structure for
+ * the window manager:
+ */
+
+ int sizeHintsFlags; /* Flags word for XSizeHints structure.
+ * If the PBaseSize flag is set then the
+ * window is gridded; otherwise it isn't
+ * gridded. */
+ int minWidth, minHeight; /* Minimum dimensions of window, in
+ * grid units, not pixels. */
+ int maxWidth, maxHeight; /* Maximum dimensions of window, in
+ * grid units, not pixels. */
+ Tk_Window gridWin; /* Identifies the window that controls
+ * gridding for this top-level, or NULL if
+ * the top-level isn't currently gridded. */
+ int widthInc, heightInc; /* Increments for size changes (# pixels
+ * per step). */
+ struct {
+ int x; /* numerator */
+ int y; /* denominator */
+ } minAspect, maxAspect; /* Min/max aspect ratios for window. */
+ int reqGridWidth, reqGridHeight;
+ /* The dimensions of the window (in
+ * grid units) requested through
+ * the geometry manager. */
+ int gravity; /* Desired window gravity. */
+
+ /*
+ * Information used to manage the size and location of a window.
+ */
+
+ int width, height; /* Desired dimensions of window, specified
+ * in grid units. These values are
+ * set by the "wm geometry" command and by
+ * ConfigureNotify events (for when wm
+ * resizes window). -1 means user hasn't
+ * requested dimensions. */
+ int x, y; /* Desired X and Y coordinates for window.
+ * These values are set by "wm geometry",
+ * plus by ConfigureNotify events (when wm
+ * moves window). These numbers are
+ * different than the numbers stored in
+ * winPtr->changes because (a) they could be
+ * measured from the right or bottom edge
+ * of the screen (see WM_NEGATIVE_X and
+ * WM_NEGATIVE_Y flags) and (b) if the window
+ * has been reparented then they refer to the
+ * parent rather than the window itself. */
+ int parentWidth, parentHeight;
+ /* Width and height of reparent, in pixels
+ * *including border*. If window hasn't been
+ * reparented then these will be the outer
+ * dimensions of the window, including
+ * border. */
+ int xInParent, yInParent; /* Offset of wrapperPtr within reparent,
+ * measured in pixels from upper-left outer
+ * corner of reparent's border to upper-left
+ * outer corner of wrapperPtr's border. If
+ * not reparented then these are zero. */
+ int configWidth, configHeight;
+ /* Dimensions passed to last request that we
+ * issued to change geometry of the wrapper.
+ * Used to eliminate redundant resize
+ * operations. */
+
+ /*
+ * Information about the virtual root window for this top-level,
+ * if there is one.
+ */
+
+ Window vRoot; /* Virtual root window for this top-level,
+ * or None if there is no virtual root
+ * window (i.e. just use the screen's root). */
+ int vRootX, vRootY; /* Position of the virtual root inside the
+ * root window. If the WM_VROOT_OFFSET_STALE
+ * flag is set then this information may be
+ * incorrect and needs to be refreshed from
+ * the X server. If vRoot is None then these
+ * values are both 0. */
+ int vRootWidth, vRootHeight;/* Dimensions of the virtual root window.
+ * If vRoot is None, gives the dimensions
+ * of the containing screen. This information
+ * is never stale, even though vRootX and
+ * vRootY can be. */
+
+ /*
+ * Miscellaneous information.
+ */
+
+ ProtocolHandler *protPtr; /* First in list of protocol handlers for
+ * this window (NULL means none). */
+ int cmdArgc; /* Number of elements in cmdArgv below. */
+ char **cmdArgv; /* Array of strings to store in the
+ * WM_COMMAND property. NULL means nothing
+ * available. */
+ char *clientMachine; /* String to store in WM_CLIENT_MACHINE
+ * property, or NULL. */
+ int flags; /* Miscellaneous flags, defined below. */
+ struct TkWmInfo *nextPtr; /* Next in list of all top-level windows. */
+} WmInfo;
+
+/*
+ * Flag values for WmInfo structures:
+ *
+ * WM_NEVER_MAPPED - non-zero means window has never been
+ * mapped; need to update all info when
+ * window is first mapped.
+ * WM_UPDATE_PENDING - non-zero means a call to UpdateGeometryInfo
+ * has already been scheduled for this
+ * window; no need to schedule another one.
+ * WM_NEGATIVE_X - non-zero means x-coordinate is measured in
+ * pixels from right edge of screen, rather
+ * than from left edge.
+ * WM_NEGATIVE_Y - non-zero means y-coordinate is measured in
+ * pixels up from bottom of screen, rather than
+ * down from top.
+ * WM_UPDATE_SIZE_HINTS - non-zero means that new size hints need to be
+ * propagated to window manager.
+ * WM_SYNC_PENDING - set to non-zero while waiting for the window
+ * manager to respond to some state change.
+ * WM_VROOT_OFFSET_STALE - non-zero means that (x,y) offset information
+ * about the virtual root window is stale and
+ * needs to be fetched fresh from the X server.
+ * WM_ABOUT_TO_MAP - non-zero means that the window is about to
+ * be mapped by TkWmMapWindow. This is used
+ * by UpdateGeometryInfo to modify its behavior.
+ * WM_MOVE_PENDING - non-zero means the application has requested
+ * a new position for the window, but it hasn't
+ * been reflected through the window manager
+ * yet.
+ * WM_COLORMAPS_EXPLICIT - non-zero means the colormap windows were
+ * set explicitly via "wm colormapwindows".
+ * WM_ADDED_TOPLEVEL_COLORMAP - non-zero means that when "wm colormapwindows"
+ * was called the top-level itself wasn't
+ * specified, so we added it implicitly at
+ * the end of the list.
+ * WM_WIDTH_NOT_RESIZABLE - non-zero means that we're not supposed to
+ * allow the user to change the width of the
+ * window (controlled by "wm resizable"
+ * command).
+ * WM_HEIGHT_NOT_RESIZABLE - non-zero means that we're not supposed to
+ * allow the user to change the height of the
+ * window (controlled by "wm resizable"
+ * command).
+ */
+
+#define WM_NEVER_MAPPED 1
+#define WM_UPDATE_PENDING 2
+#define WM_NEGATIVE_X 4
+#define WM_NEGATIVE_Y 8
+#define WM_UPDATE_SIZE_HINTS 0x10
+#define WM_SYNC_PENDING 0x20
+#define WM_VROOT_OFFSET_STALE 0x40
+#define WM_ABOUT_TO_MAP 0x100
+#define WM_MOVE_PENDING 0x200
+#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,
+ Tk_Window tkwin));
+
+static Tk_GeomMgr wmMgrType = {
+ "wm", /* name */
+ TopLevelReqProc, /* requestProc */
+ (Tk_GeomLostSlaveProc *) NULL, /* lostSlaveProc */
+};
+
+static void MenubarReqProc _ANSI_ARGS_((ClientData clientData,
+ Tk_Window tkwin));
+
+static Tk_GeomMgr menubarMgrType = {
+ "menubar", /* name */
+ MenubarReqProc, /* requestProc */
+ (Tk_GeomLostSlaveProc *) NULL, /* lostSlaveProc */
+};
+
+/*
+ * Structures of the following type are used for communication between
+ * WaitForEvent, WaitRestrictProc, and WaitTimeoutProc.
+ */
+
+typedef struct WaitRestrictInfo {
+ Display *display; /* Window belongs to this display. */
+ Window window; /* We're waiting for events on this window. */
+ int type; /* We only care about this type of event. */
+ XEvent *eventPtr; /* Where to store the event when it's found. */
+ int foundEvent; /* Non-zero means that an event of the
+ * desired type has been found. */
+} WaitRestrictInfo;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static int ComputeReparentGeometry _ANSI_ARGS_((WmInfo *wmPtr));
+static void ConfigureEvent _ANSI_ARGS_((WmInfo *wmPtr,
+ XConfigureEvent *eventPtr));
+static void CreateWrapper _ANSI_ARGS_((WmInfo *wmPtr));
+static void GetMaxSize _ANSI_ARGS_((WmInfo *wmPtr,
+ int *maxWidthPtr, int *maxHeightPtr));
+static void MenubarDestroyProc _ANSI_ARGS_((ClientData clientData,
+ 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,
+ unsigned long serial));
+static int WaitForEvent _ANSI_ARGS_((Display *display,
+ Window window, int type, XEvent *eventPtr));
+static void WaitForMapNotify _ANSI_ARGS_((TkWindow *winPtr,
+ int mapped));
+static Tk_RestrictAction
+ WaitRestrictProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+static void WrapperEventProc _ANSI_ARGS_((ClientData clientData,
+ XEvent *eventPtr));
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmNewWindow --
+ *
+ * This procedure is invoked whenever a new top-level
+ * window is created. Its job is to initialize the WmInfo
+ * structure for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A WmInfo structure gets allocated and initialized.
+ *
+ *--------------------------------------------------------------
+ */
+
+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;
+ wmPtr->hints.flags = InputHint | StateHint;
+ wmPtr->hints.input = True;
+ wmPtr->hints.initial_state = NormalState;
+ wmPtr->hints.icon_pixmap = None;
+ wmPtr->hints.icon_window = None;
+ wmPtr->hints.icon_x = wmPtr->hints.icon_y = 0;
+ wmPtr->hints.icon_mask = None;
+ wmPtr->hints.window_group = None;
+ wmPtr->leaderName = NULL;
+ wmPtr->masterWindowName = NULL;
+ wmPtr->icon = NULL;
+ wmPtr->iconFor = NULL;
+ wmPtr->withdrawn = 0;
+ wmPtr->wrapperPtr = NULL;
+ wmPtr->menubar = NULL;
+ wmPtr->menuHeight = 0;
+ wmPtr->sizeHintsFlags = 0;
+ wmPtr->minWidth = wmPtr->minHeight = 1;
+
+ /*
+ * Default the maximum dimensions to the size of the display, minus
+ * a guess about how space is needed for window manager decorations.
+ */
+
+ wmPtr->maxWidth = 0;
+ wmPtr->maxHeight = 0;
+ wmPtr->gridWin = NULL;
+ wmPtr->widthInc = wmPtr->heightInc = 1;
+ wmPtr->minAspect.x = wmPtr->minAspect.y = 1;
+ wmPtr->maxAspect.x = wmPtr->maxAspect.y = 1;
+ wmPtr->reqGridWidth = wmPtr->reqGridHeight = -1;
+ wmPtr->gravity = NorthWestGravity;
+ wmPtr->width = -1;
+ wmPtr->height = -1;
+ wmPtr->x = winPtr->changes.x;
+ wmPtr->y = winPtr->changes.y;
+ wmPtr->parentWidth = winPtr->changes.width
+ + 2*winPtr->changes.border_width;
+ wmPtr->parentHeight = winPtr->changes.height
+ + 2*winPtr->changes.border_width;
+ wmPtr->xInParent = wmPtr->yInParent = 0;
+ 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.
+ */
+
+ Tk_ManageGeometry((Tk_Window) winPtr, &wmMgrType, (ClientData) 0);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmMapWindow --
+ *
+ * This procedure is invoked to map a top-level window. This
+ * module gets a chance to update all window-manager-related
+ * information in properties before the window manager sees
+ * the map event and checks the properties. It also gets to
+ * decide whether or not to even map the window after all.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Properties of winPtr may get updated to provide up-to-date
+ * information to the window manager. The window may also get
+ * mapped, but it may not be if this procedure decides that
+ * isn't appropriate (e.g. because the window is withdrawn).
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkWmMapWindow(winPtr)
+ TkWindow *winPtr; /* Top-level window that's about to
+ * 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) {
+ /*
+ * This window is an icon for somebody else. Make sure that
+ * the geometry is up-to-date, then return without mapping
+ * the window.
+ */
+
+ if (wmPtr->flags & WM_UPDATE_PENDING) {
+ Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr);
+ }
+ UpdateGeometryInfo((ClientData) winPtr);
+ return;
+ }
+ wmPtr->flags |= WM_ABOUT_TO_MAP;
+ if (wmPtr->flags & WM_UPDATE_PENDING) {
+ Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr);
+ }
+ UpdateGeometryInfo((ClientData) winPtr);
+ wmPtr->flags &= ~WM_ABOUT_TO_MAP;
+
+ /*
+ * Map the window, then wait to be sure that the window manager has
+ * processed the map operation.
+ */
+
+ XMapWindow(winPtr->display, wmPtr->wrapperPtr->window);
+ if (wmPtr->hints.initial_state == NormalState) {
+ WaitForMapNotify(winPtr, 1);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmUnmapWindow --
+ *
+ * This procedure is invoked to unmap a top-level window. The
+ * only thing it does special is to wait for the window actually
+ * to be unmapped.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Unmaps the window.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkWmUnmapWindow(winPtr)
+ TkWindow *winPtr; /* Top-level window that's about to
+ * be mapped. */
+{
+ /*
+ * It seems to be important to wait after unmapping a top-level
+ * window until the window really gets unmapped. I don't completely
+ * understand all the interactions with the window manager, but if
+ * we go on without waiting, and if the window is then mapped again
+ * quickly, events seem to get lost so that we think the window isn't
+ * mapped when in fact it is mapped. I suspect that this has something
+ * to do with the window manager filtering Map events (and possily not
+ * filtering Unmap events?).
+ */
+ XUnmapWindow(winPtr->display, winPtr->wmInfoPtr->wrapperPtr->window);
+ WaitForMapNotify(winPtr, 0);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmDeadWindow --
+ *
+ * This procedure is invoked when a top-level window is
+ * about to be deleted. It cleans up the wm-related data
+ * structures for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The WmInfo structure for winPtr gets freed up.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkWmDeadWindow(winPtr)
+ TkWindow *winPtr; /* Top-level window that's being deleted. */
+{
+ 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;
+ }
+ }
+ }
+ if (wmPtr->title != NULL) {
+ ckfree(wmPtr->title);
+ }
+ if (wmPtr->iconName != NULL) {
+ ckfree(wmPtr->iconName);
+ }
+ if (wmPtr->hints.flags & IconPixmapHint) {
+ Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap);
+ }
+ if (wmPtr->hints.flags & IconMaskHint) {
+ Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask);
+ }
+ if (wmPtr->leaderName != NULL) {
+ ckfree(wmPtr->leaderName);
+ }
+ if (wmPtr->masterWindowName != NULL) {
+ ckfree(wmPtr->masterWindowName);
+ }
+ if (wmPtr->icon != NULL) {
+ wmPtr2 = ((TkWindow *) wmPtr->icon)->wmInfoPtr;
+ wmPtr2->iconFor = NULL;
+ wmPtr2->withdrawn = 1;
+ }
+ if (wmPtr->iconFor != NULL) {
+ wmPtr2 = ((TkWindow *) wmPtr->iconFor)->wmInfoPtr;
+ wmPtr2->icon = NULL;
+ wmPtr2->hints.flags &= ~IconWindowHint;
+ UpdateHints((TkWindow *) wmPtr->iconFor);
+ }
+ if (wmPtr->menubar != NULL) {
+ Tk_DestroyWindow(wmPtr->menubar);
+ }
+ if (wmPtr->wrapperPtr != NULL) {
+ /*
+ * The rest of Tk doesn't know that we reparent the toplevel
+ * inside the wrapper, so reparent it back out again before
+ * deleting the wrapper; otherwise the toplevel will get deleted
+ * twice (once implicitly by the deletion of the wrapper).
+ */
+
+ XUnmapWindow(winPtr->display, winPtr->window);
+ XReparentWindow(winPtr->display, winPtr->window,
+ XRootWindow(winPtr->display, winPtr->screenNum), 0, 0);
+ Tk_DestroyWindow((Tk_Window) wmPtr->wrapperPtr);
+ }
+ while (wmPtr->protPtr != NULL) {
+ ProtocolHandler *protPtr;
+
+ protPtr = wmPtr->protPtr;
+ wmPtr->protPtr = protPtr->nextPtr;
+ Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC);
+ }
+ if (wmPtr->cmdArgv != NULL) {
+ ckfree((char *) wmPtr->cmdArgv);
+ }
+ if (wmPtr->clientMachine != NULL) {
+ ckfree((char *) wmPtr->clientMachine);
+ }
+ if (wmPtr->flags & WM_UPDATE_PENDING) {
+ Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr);
+ }
+ ckfree((char *) wmPtr);
+ winPtr->wmInfoPtr = NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmSetClass --
+ *
+ * This procedure is invoked whenever a top-level window's
+ * class is changed. If the window has been mapped then this
+ * procedure updates the window manager property for the
+ * class. If the window hasn't been mapped, the update is
+ * deferred until just before the first mapping.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A window property may get updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkWmSetClass(winPtr)
+ TkWindow *winPtr; /* Newly-created top-level window. */
+{
+ 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 --
+ *
+ * This procedure is invoked to process the "wm" 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_WmCmd(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;
+ 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) {
+ return TCL_ERROR;
+ }
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ Tcl_AppendResult(interp, "window \"", winPtr->pathName,
+ "\" isn't a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ wmPtr = winPtr->wmInfoPtr;
+ if ((c == 'a') && (strncmp(argv[1], "aspect", length) == 0)) {
+ int numer1, denom1, numer2, denom2;
+
+ if ((argc != 3) && (argc != 7)) {
+ 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;
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ XDeleteProperty(winPtr->display, wmPtr->wrapperPtr->window,
+ Tk_InternAtom((Tk_Window) winPtr,
+ "WM_CLIENT_MACHINE"));
+ }
+ }
+ return TCL_OK;
+ }
+ if (wmPtr->clientMachine != NULL) {
+ 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;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # arguments: must be \"",
+ argv[0], " colormapwindows window ?windowList?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ Tk_MakeWindowExist((Tk_Window) winPtr);
+ if (wmPtr->wrapperPtr == NULL) {
+ CreateWrapper(wmPtr);
+ }
+ if (argc == 3) {
+ if (XGetWMColormapWindows(winPtr->display,
+ wmPtr->wrapperPtr->window, &cmapList, &count) == 0) {
+ return TCL_OK;
+ }
+ for (i = 0; i < count; i++) {
+ if ((i == (count-1))
+ && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) {
+ break;
+ }
+ winPtr2 = (TkWindow *) Tk_IdToWindow(winPtr->display,
+ cmapList[i]);
+ if (winPtr2 == NULL) {
+ sprintf(buffer, "0x%lx", cmapList[i]);
+ Tcl_AppendElement(interp, buffer);
+ } else {
+ Tcl_AppendElement(interp, winPtr2->pathName);
+ }
+ }
+ XFree((char *) cmapList);
+ return TCL_OK;
+ }
+ if (Tcl_SplitList(interp, argv[3], &windowArgc, &windowArgv)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ cmapList = (Window *) ckalloc((unsigned)
+ ((windowArgc+1)*sizeof(Window)));
+ gotToplevel = 0;
+ for (i = 0; i < windowArgc; i++) {
+ winPtr2 = (TkWindow *) Tk_NameToWindow(interp, windowArgv[i],
+ tkwin);
+ if (winPtr2 == NULL) {
+ ckfree((char *) cmapList);
+ ckfree((char *) windowArgv);
+ return TCL_ERROR;
+ }
+ if (winPtr2 == winPtr) {
+ gotToplevel = 1;
+ }
+ if (winPtr2->window == None) {
+ Tk_MakeWindowExist((Tk_Window) winPtr2);
+ }
+ cmapList[i] = winPtr2->window;
+ }
+ if (!gotToplevel) {
+ wmPtr->flags |= WM_ADDED_TOPLEVEL_COLORMAP;
+ cmapList[windowArgc] = wmPtr->wrapperPtr->window;
+ windowArgc++;
+ } else {
+ wmPtr->flags &= ~WM_ADDED_TOPLEVEL_COLORMAP;
+ }
+ wmPtr->flags |= WM_COLORMAPS_EXPLICIT;
+ XSetWMColormapWindows(winPtr->display, wmPtr->wrapperPtr->window,
+ cmapList, windowArgc);
+ ckfree((char *) cmapList);
+ ckfree((char *) windowArgv);
+ 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;
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ XDeleteProperty(winPtr->display, wmPtr->wrapperPtr->window,
+ Tk_InternAtom((Tk_Window) winPtr, "WM_COMMAND"));
+ }
+ }
+ return TCL_OK;
+ }
+ if (Tcl_SplitList(interp, argv[3], &cmdArgc, &cmdArgv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ 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;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't deiconify ", argv[2],
+ ": it is an icon for ", Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ wmPtr->hints.initial_state = NormalState;
+ wmPtr->withdrawn = 0;
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ return TCL_OK;
+ }
+ UpdateHints(winPtr);
+ Tk_MapWindow((Tk_Window) winPtr);
+ } else if ((c == 'f') && (strncmp(argv[1], "focusmodel", length) == 0)
+ && (length >= 2)) {
+ 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.
+ */
+
+ wmPtr->sizeHintsFlags &= ~(PBaseSize|PResizeInc);
+ if (wmPtr->width != -1) {
+ wmPtr->width = winPtr->reqWidth + (wmPtr->width
+ - wmPtr->reqGridWidth)*wmPtr->widthInc;
+ wmPtr->height = winPtr->reqHeight + (wmPtr->height
+ - wmPtr->reqGridHeight)*wmPtr->heightInc;
+ }
+ wmPtr->widthInc = 1;
+ wmPtr->heightInc = 1;
+ } else {
+ 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);
+ }
+ wmPtr->leaderName = NULL;
+ } else {
+ tkwin2 = Tk_NameToWindow(interp, argv[3], tkwin);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ while (!Tk_IsTopLevel(tkwin2)) {
+ /*
+ * Ensure that the group leader is actually a Tk toplevel.
+ */
+
+ tkwin2 = Tk_Parent(tkwin2);
+ }
+ Tk_MakeWindowExist(tkwin2);
+ wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr;
+ if (wmPtr2->wrapperPtr == NULL) {
+ CreateWrapper(wmPtr2);
+ }
+ wmPtr->hints.window_group = Tk_WindowId(wmPtr2->wrapperPtr);
+ wmPtr->hints.flags |= WindowGroupHint;
+ wmPtr->leaderName = ckalloc((unsigned) (strlen(argv[3])+1));
+ strcpy(wmPtr->leaderName, argv[3]);
+ }
+ UpdateHints(winPtr);
+ } else if ((c == 'i') && (strncmp(argv[1], "iconbitmap", length) == 0)
+ && (length >= 5)) {
+ Pixmap pixmap;
+
+ if ((argc != 3) && (argc != 4)) {
+ 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;
+ }
+ wmPtr->hints.flags &= ~IconPixmapHint;
+ } else {
+ pixmap = Tk_GetBitmap(interp, (Tk_Window) winPtr,
+ Tk_GetUid(argv[3]));
+ if (pixmap == None) {
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_pixmap = pixmap;
+ wmPtr->hints.flags |= IconPixmapHint;
+ }
+ UpdateHints(winPtr);
+ } else if ((c == 'i') && (strncmp(argv[1], "iconify", length) == 0)
+ && (length >= 5)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # arguments: must be \"",
+ argv[0], " iconify window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
+ Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName,
+ "\": override-redirect flag is set", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->master != None) {
+ Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName,
+ "\": it is a transient", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't iconify ", argv[2],
+ ": it is an icon for ", Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ wmPtr->hints.initial_state = IconicState;
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ return TCL_OK;
+ }
+ 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);
+ }
+ wmPtr->hints.flags &= ~IconMaskHint;
+ } else {
+ pixmap = Tk_GetBitmap(interp, tkwin, Tk_GetUid(argv[3]));
+ if (pixmap == None) {
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_mask = pixmap;
+ wmPtr->hints.flags |= IconMaskHint;
+ }
+ UpdateHints(winPtr);
+ } else if ((c == 'i') && (strncmp(argv[1], "iconname", length) == 0)
+ && (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 {
+ if (wmPtr->iconName != NULL) {
+ ckfree(wmPtr->iconName);
+ }
+ 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)
+ || (Tcl_GetInt(interp, argv[4], &y) != TCL_OK)){
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_x = x;
+ wmPtr->hints.icon_y = y;
+ wmPtr->hints.flags |= IconPositionHint;
+ }
+ UpdateHints(winPtr);
+ } else if ((c == 'i') && (strncmp(argv[1], "iconwindow", length) == 0)
+ && (length >= 5)) {
+ Tk_Window tkwin2;
+ WmInfo *wmPtr2;
+ XSetWindowAttributes atts;
+
+ if ((argc != 3) && (argc != 4)) {
+ 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) {
+ /*
+ * Remove the icon window relationship. In principle we
+ * should also re-enable button events for the window, but
+ * this doesn't work in general because the window manager
+ * is probably selecting on them (we'll get an error if
+ * we try to re-enable the events). So, just leave the
+ * icon window event-challenged; the user will have to
+ * recreate it if they want button events.
+ */
+
+ wmPtr2 = ((TkWindow *) wmPtr->icon)->wmInfoPtr;
+ wmPtr2->iconFor = NULL;
+ wmPtr2->withdrawn = 1;
+ wmPtr2->hints.initial_state = WithdrawnState;
+ }
+ wmPtr->icon = NULL;
+ } else {
+ tkwin2 = Tk_NameToWindow(interp, argv[3], tkwin);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ if (!Tk_IsTopLevel(tkwin2)) {
+ Tcl_AppendResult(interp, "can't use ", argv[3],
+ " as icon window: not at top level", (char *) NULL);
+ return TCL_ERROR;
+ }
+ wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr;
+ if (wmPtr2->iconFor != NULL) {
+ Tcl_AppendResult(interp, argv[3], " is already an icon for ",
+ Tk_PathName(wmPtr2->iconFor), (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->icon != NULL) {
+ WmInfo *wmPtr3 = ((TkWindow *) wmPtr->icon)->wmInfoPtr;
+ wmPtr3->iconFor = NULL;
+ wmPtr3->withdrawn = 1;
+ wmPtr3->hints.initial_state = WithdrawnState;
+ }
+
+ /*
+ * Disable button events in the icon window: some window
+ * managers (like olvwm) want to get the events themselves,
+ * but X only allows one application at a time to receive
+ * button events for a window.
+ */
+
+ atts.event_mask = Tk_Attributes(tkwin2)->event_mask
+ & ~ButtonPressMask;
+ Tk_ChangeWindowAttributes(tkwin2, CWEventMask, &atts);
+ Tk_MakeWindowExist(tkwin2);
+ if (wmPtr2->wrapperPtr == NULL) {
+ CreateWrapper(wmPtr2);
+ }
+ wmPtr->hints.icon_window = Tk_WindowId(wmPtr2->wrapperPtr);
+ wmPtr->hints.flags |= IconWindowHint;
+ 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;
+ wmPtr->minHeight = height;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ goto updateGeom;
+ } else if ((c == 'o')
+ && (strncmp(argv[1], "overrideredirect", length) == 0)) {
+ int boolean;
+ XSetWindowAttributes atts;
+
+ if ((argc != 3) && (argc != 4)) {
+ 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);
+ if (winPtr->wmInfoPtr->wrapperPtr != NULL) {
+ Tk_ChangeWindowAttributes(
+ (Tk_Window) winPtr->wmInfoPtr->wrapperPtr,
+ CWOverrideRedirect, &atts);
+ }
+ } 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];
+ length = strlen(argv[3]);
+ if ((c == 'u') && (strncmp(argv[3], "user", length) == 0)) {
+ wmPtr->sizeHintsFlags &= ~PPosition;
+ wmPtr->sizeHintsFlags |= USPosition;
+ } else if ((c == 'p') && (strncmp(argv[3], "program", length) == 0)) {
+ wmPtr->sizeHintsFlags &= ~USPosition;
+ wmPtr->sizeHintsFlags |= PPosition;
+ } else {
+ Tcl_AppendResult(interp, "bad argument \"", argv[3],
+ "\": must be program or user", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ goto updateGeom;
+ } else if ((c == 'p') && (strncmp(argv[1], "protocol", length) == 0)
+ && (length >= 2)) {
+ register ProtocolHandler *protPtr, *prevPtr;
+ Atom protocol;
+ int cmdLength;
+
+ if ((argc < 3) || (argc > 5)) {
+ Tcl_AppendResult(interp, "wrong # arguments: must be \"",
+ argv[0], " protocol window ?name? ?command?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 3) {
+ /*
+ * Return a list of all defined protocols for the window.
+ */
+ for (protPtr = wmPtr->protPtr; protPtr != NULL;
+ protPtr = protPtr->nextPtr) {
+ Tcl_AppendElement(interp,
+ Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol));
+ }
+ return TCL_OK;
+ }
+ protocol = Tk_InternAtom((Tk_Window) winPtr, argv[3]);
+ 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;
+ }
+
+ /*
+ * Delete any current protocol handler, then create a new
+ * one with the specified command, unless the command is
+ * empty.
+ */
+
+ for (protPtr = wmPtr->protPtr, prevPtr = NULL; protPtr != NULL;
+ prevPtr = protPtr, protPtr = protPtr->nextPtr) {
+ if (protPtr->protocol == protocol) {
+ if (prevPtr == NULL) {
+ wmPtr->protPtr = protPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = protPtr->nextPtr;
+ }
+ Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC);
+ break;
+ }
+ }
+ cmdLength = strlen(argv[4]);
+ if (cmdLength > 0) {
+ protPtr = (ProtocolHandler *) ckalloc(HANDLER_SIZE(cmdLength));
+ protPtr->protocol = protocol;
+ protPtr->nextPtr = wmPtr->protPtr;
+ wmPtr->protPtr = protPtr;
+ protPtr->interp = interp;
+ strcpy(protPtr->command, argv[4]);
+ }
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ UpdateWmProtocols(wmPtr);
+ }
+ } else if ((c == 'r') && (strncmp(argv[1], "resizable", length) == 0)) {
+ int width, height;
+
+ 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) {
+ wmPtr->flags &= ~WM_WIDTH_NOT_RESIZABLE;
+ } else {
+ wmPtr->flags |= WM_WIDTH_NOT_RESIZABLE;
+ }
+ if (height) {
+ wmPtr->flags &= ~WM_HEIGHT_NOT_RESIZABLE;
+ } else {
+ wmPtr->flags |= WM_HEIGHT_NOT_RESIZABLE;
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ goto updateGeom;
+ } else if ((c == 's') && (strncmp(argv[1], "sizefrom", length) == 0)
+ && (length >= 2)) {
+ if ((argc != 3) && (argc != 4)) {
+ 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];
+ length = strlen(argv[3]);
+ if ((c == 'u') && (strncmp(argv[3], "user", length) == 0)) {
+ wmPtr->sizeHintsFlags &= ~PSize;
+ wmPtr->sizeHintsFlags |= USSize;
+ } else if ((c == 'p')
+ && (strncmp(argv[3], "program", length) == 0)) {
+ wmPtr->sizeHintsFlags &= ~USSize;
+ wmPtr->sizeHintsFlags |= PSize;
+ } else {
+ Tcl_AppendResult(interp, "bad argument \"", argv[3],
+ "\": must be program or user", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ goto updateGeom;
+ } else if ((c == 's') && (strncmp(argv[1], "state", length) == 0)
+ && (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 {
+ if (wmPtr->title != NULL) {
+ ckfree(wmPtr->title);
+ }
+ 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);
+ }
+ wmPtr->masterWindowName = NULL;
+ } else {
+ master = Tk_NameToWindow(interp, argv[3], tkwin);
+ if (master == NULL) {
+ return TCL_ERROR;
+ }
+ while (!Tk_IsTopLevel(master)) {
+ /*
+ * Ensure that the master window is actually a Tk toplevel.
+ */
+
+ master = Tk_Parent(master);
+ }
+ Tk_MakeWindowExist(master);
+ wmPtr2 = ((TkWindow *) master)->wmInfoPtr;
+ if (wmPtr2->wrapperPtr == NULL) {
+ CreateWrapper(wmPtr2);
+ }
+ wmPtr->master = Tk_WindowId(wmPtr2->wrapperPtr);
+ wmPtr->masterWindowName = ckalloc((unsigned) (strlen(argv[3])+1));
+ strcpy(wmPtr->masterWindowName, argv[3]);
+ }
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ XSetTransientForHint(winPtr->display, wmPtr->wrapperPtr->window,
+ wmPtr->master);
+ }
+ } else if ((c == 'w') && (strncmp(argv[1], "withdraw", length) == 0)
+ && (length >= 2)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # arguments: must be \"",
+ argv[0], " withdraw window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't withdraw ", argv[2],
+ ": it is an icon for ", Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ 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, ",
+ "iconify, iconmask, iconname, iconposition, ",
+ "iconwindow, maxsize, minsize, overrideredirect, ",
+ "positionfrom, protocol, resizable, sizefrom, state, title, ",
+ "transient, or withdraw",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+
+ updateGeom:
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetGrid --
+ *
+ * This procedure is invoked by a widget when it wishes to set a grid
+ * coordinate system that controls the size of a top-level window.
+ * It provides a C interface equivalent to the "wm grid" command and
+ * is usually asscoiated with the -setgrid option.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Grid-related information will be passed to the window manager, so
+ * that the top-level window associated with tkwin will resize on
+ * even grid units. If some other window already controls gridding
+ * for the top-level window then this procedure call has no effect.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetGrid(tkwin, reqWidth, reqHeight, widthInc, heightInc)
+ Tk_Window tkwin; /* Token for window. New window mgr info
+ * will be posted for the top-level window
+ * associated with this window. */
+ int reqWidth; /* Width (in grid units) corresponding to
+ * the requested geometry for tkwin. */
+ int reqHeight; /* Height (in grid units) corresponding to
+ * the requested geometry for tkwin. */
+ int widthInc, heightInc; /* Pixel increments corresponding to a
+ * change of one grid unit. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ register WmInfo *wmPtr;
+
+ /*
+ * Find the top-level window for tkwin, plus the window manager
+ * information.
+ */
+
+ while (!(winPtr->flags & TK_TOP_LEVEL)) {
+ winPtr = winPtr->parentPtr;
+ if (winPtr == NULL) {
+ /*
+ * The window is being deleted... just skip this operation.
+ */
+
+ return;
+ }
+ }
+ wmPtr = winPtr->wmInfoPtr;
+
+ if ((wmPtr->gridWin != NULL) && (wmPtr->gridWin != tkwin)) {
+ return;
+ }
+
+ 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
+ * grid units since the new requested size of the top-level window in
+ * pixels may not yet have been registered yet (it may filter up
+ * the hierarchy in DoWhenIdle handlers). However, if the window
+ * has never been mapped yet then just leave the window size alone:
+ * assume that it is intended to be in grid units but just happened
+ * to have been specified before this procedure was called.
+ */
+
+ if ((wmPtr->gridWin == NULL) && !(wmPtr->flags & WM_NEVER_MAPPED)) {
+ wmPtr->width = -1;
+ wmPtr->height = -1;
+ }
+
+ /*
+ * Set the new gridding information, and start the process of passing
+ * all of this information to the window manager.
+ */
+
+ wmPtr->gridWin = tkwin;
+ wmPtr->reqGridWidth = reqWidth;
+ wmPtr->reqGridHeight = reqHeight;
+ wmPtr->widthInc = widthInc;
+ wmPtr->heightInc = heightInc;
+ wmPtr->sizeHintsFlags |= PBaseSize|PResizeInc;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_UnsetGrid --
+ *
+ * This procedure cancels the effect of a previous call
+ * to Tk_SetGrid.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If tkwin currently controls gridding for its top-level window,
+ * gridding is cancelled for that top-level window; if some other
+ * window controls gridding then this procedure has no effect.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_UnsetGrid(tkwin)
+ Tk_Window tkwin; /* Token for window that is currently
+ * controlling gridding. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ register WmInfo *wmPtr;
+
+ /*
+ * Find the top-level window for tkwin, plus the window manager
+ * information.
+ */
+
+ while (!(winPtr->flags & TK_TOP_LEVEL)) {
+ winPtr = winPtr->parentPtr;
+ if (winPtr == NULL) {
+ /*
+ * The window is being deleted... just skip this operation.
+ */
+
+ return;
+ }
+ }
+ wmPtr = winPtr->wmInfoPtr;
+ if (tkwin != wmPtr->gridWin) {
+ return;
+ }
+
+ wmPtr->gridWin = NULL;
+ wmPtr->sizeHintsFlags &= ~(PBaseSize|PResizeInc);
+ if (wmPtr->width != -1) {
+ wmPtr->width = winPtr->reqWidth + (wmPtr->width
+ - wmPtr->reqGridWidth)*wmPtr->widthInc;
+ wmPtr->height = winPtr->reqHeight + (wmPtr->height
+ - wmPtr->reqGridHeight)*wmPtr->heightInc;
+ }
+ wmPtr->widthInc = 1;
+ wmPtr->heightInc = 1;
+
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureEvent --
+ *
+ * This procedure is called to handle ConfigureNotify events on
+ * wrapper windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets updated in the WmInfo structure for the window
+ * and the toplevel itself gets repositioned within the wrapper.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+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)) {
+ /*
+ * Don't set external width, since the user didn't change it
+ * from what the widgets asked for.
+ */
+ } else {
+ /*
+ * Note: if this window is embedded then don't set the external
+ * size, since it came from the containing application, not the
+ * user. In this case we want to keep sending our size requests
+ * to the containing application; if the user fixes the size
+ * of that application then it will still percolate down to us
+ * in the right way.
+ */
+
+ if (!(winPtr->flags & TK_EMBEDDED)) {
+ if (wmPtr->gridWin != NULL) {
+ wmPtr->width = wmPtr->reqGridWidth
+ + (configEventPtr->width
+ - winPtr->reqWidth)/wmPtr->widthInc;
+ if (wmPtr->width < 0) {
+ wmPtr->width = 0;
+ }
+ } else {
+ wmPtr->width = configEventPtr->width;
+ }
+ }
+ }
+ if ((wmPtr->height == -1)
+ && (configEventPtr->height ==
+ (winPtr->reqHeight + wmPtr->menuHeight))) {
+ /*
+ * Don't set external height, since the user didn't change it
+ * from what the widgets asked for.
+ */
+ } else {
+ /*
+ * See note for wmPtr->width about not setting external size
+ * for embedded windows.
+ */
+
+ if (!(winPtr->flags & TK_EMBEDDED)) {
+ if (wmPtr->gridWin != NULL) {
+ wmPtr->height = wmPtr->reqGridHeight
+ + (configEventPtr->height - wmPtr->menuHeight
+ - winPtr->reqHeight)/wmPtr->heightInc;
+ if (wmPtr->height < 0) {
+ wmPtr->height = 0;
+ }
+ } else {
+ wmPtr->height = configEventPtr->height - wmPtr->menuHeight;
+ }
+ }
+ }
+ 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;
+ wrapperPtr->changes.height = configEventPtr->height;
+ wrapperPtr->changes.border_width = configEventPtr->border_width;
+ wrapperPtr->changes.sibling = configEventPtr->above;
+ wrapperPtr->changes.stack_mode = Above;
+
+ /*
+ * Reparenting window managers make life difficult. If the
+ * window manager reparents a top-level window then the x and y
+ * information that comes in events for the window is wrong:
+ * it gives the location of the window inside its decorative
+ * parent, rather than the location of the window in root
+ * coordinates, which is what we want. Window managers
+ * are supposed to send synthetic events with the correct
+ * information, but ICCCM doesn't require them to do this
+ * under all conditions, and the information provided doesn't
+ * include everything we need here. So, the code below
+ * maintains a bunch of information about the parent window.
+ * If the window hasn't been reparented, we pretend that
+ * there is a parent shrink-wrapped around the window.
+ */
+
+ if ((wmPtr->reparent == None) || !ComputeReparentGeometry(wmPtr)) {
+ wmPtr->parentWidth = configEventPtr->width
+ + 2*configEventPtr->border_width;
+ wmPtr->parentHeight = configEventPtr->height
+ + 2*configEventPtr->border_width;
+ wrapperPtr->changes.x = wmPtr->x = configEventPtr->x;
+ wrapperPtr->changes.y = wmPtr->y = configEventPtr->y;
+ if (wmPtr->flags & WM_NEGATIVE_X) {
+ wmPtr->x = wmPtr->vRootWidth - (wmPtr->x + wmPtr->parentWidth);
+ }
+ if (wmPtr->flags & WM_NEGATIVE_Y) {
+ wmPtr->y = wmPtr->vRootHeight - (wmPtr->y + wmPtr->parentHeight);
+ }
+ }
+
+ /*
+ * Make sure that the toplevel and menubar are properly positioned within
+ * the wrapper.
+ */
+
+ XMoveResizeWindow(winPtr->display, winPtr->window, 0,
+ wmPtr->menuHeight, (unsigned) wrapperPtr->changes.width,
+ (unsigned) (wrapperPtr->changes.height - wmPtr->menuHeight));
+ if ((wmPtr->menubar != NULL)
+ && ((Tk_Width(wmPtr->menubar) != wrapperPtr->changes.width)
+ || (Tk_Height(wmPtr->menubar) != wmPtr->menuHeight))) {
+ Tk_MoveResizeWindow(wmPtr->menubar, 0, 0, wrapperPtr->changes.width,
+ wmPtr->menuHeight);
+ }
+
+ /*
+ * Update the coordinates in the toplevel (they should refer to the
+ * position in root window coordinates, not the coordinates of the
+ * wrapper window). Then synthesize a ConfigureNotify event to tell
+ * the application about the change.
+ */
+
+ winPtr->changes.x = wrapperPtr->changes.x;
+ winPtr->changes.y = wrapperPtr->changes.y + wmPtr->menuHeight;
+ winPtr->changes.width = wrapperPtr->changes.width;
+ winPtr->changes.height = wrapperPtr->changes.height - wmPtr->menuHeight;
+ TkDoConfigureNotify(winPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReparentEvent --
+ *
+ * This procedure is called to handle ReparentNotify events on
+ * wrapper windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information gets updated in the WmInfo structure for the window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ReparentEvent(wmPtr, reparentEventPtr)
+ WmInfo *wmPtr; /* Information about toplevel window. */
+ XReparentEvent *reparentEventPtr; /* Event that just occurred for
+ * wmPtr->wrapperPtr. */
+{
+ 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.
+ */
+
+ vRoot = RootWindow(wrapperPtr->display, wrapperPtr->screenNum);
+ wmPtr->vRoot = None;
+ handler = Tk_CreateErrorHandler(wrapperPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ if (((XGetWindowProperty(wrapperPtr->display, wrapperPtr->window,
+ Tk_InternAtom((Tk_Window) wrapperPtr, "__WM_ROOT"), 0, (long) 1,
+ False, XA_WINDOW, &actualType, &actualFormat, &numItems,
+ &bytesAfter, (unsigned char **) &virtualRootPtr) == Success)
+ && (actualType == XA_WINDOW))
+ || ((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.
+ */
+
+ UpdateVRootGeometry(wmPtr);
+
+ /*
+ * If the window's new parent is the root window, then mark it as
+ * no longer reparented.
+ */
+
+ if (reparentEventPtr->parent == vRoot) {
+ noReparent:
+ wmPtr->reparent = None;
+ wmPtr->parentWidth = wrapperPtr->changes.width;
+ wmPtr->parentHeight = wrapperPtr->changes.height;
+ wmPtr->xInParent = wmPtr->yInParent = 0;
+ wrapperPtr->changes.x = reparentEventPtr->x;
+ wrapperPtr->changes.y = reparentEventPtr->y;
+ return;
+ }
+
+ /*
+ * Search up the window hierarchy to find the ancestor of this
+ * window that is just below the (virtual) root. This is tricky
+ * because it's possible that things have changed since the event
+ * was generated so that the ancestry indicated by the event no
+ * longer exists. If this happens then an error will occur and
+ * we just discard the event (there will be a more up-to-date
+ * ReparentNotify event coming later).
+ */
+
+ handler = Tk_CreateErrorHandler(wrapperPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ wmPtr->reparent = reparentEventPtr->parent;
+ while (1) {
+ if (XQueryTree(wrapperPtr->display, wmPtr->reparent, &dummy2, &ancestor,
+ &children, &dummy) == 0) {
+ Tk_DeleteErrorHandler(handler);
+ goto noReparent;
+ }
+ XFree((char *) children);
+ if ((ancestor == vRoot) ||
+ (ancestor == RootWindow(wrapperPtr->display,
+ wrapperPtr->screenNum))) {
+ break;
+ }
+ wmPtr->reparent = ancestor;
+ }
+ Tk_DeleteErrorHandler(handler);
+
+ if (!ComputeReparentGeometry(wmPtr)) {
+ goto noReparent;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ComputeReparentGeometry --
+ *
+ * This procedure is invoked to recompute geometry information
+ * related to a reparented top-level window, such as the position
+ * and total size of the parent and the position within it of
+ * the top-level window.
+ *
+ * Results:
+ * The return value is 1 if everything completed successfully
+ * and 0 if an error occurred while querying information about
+ * winPtr's parents. In this case winPtr is marked as no longer
+ * being reparented.
+ *
+ * Side effects:
+ * Geometry information in wmPtr, wmPtr->winPtr, and
+ * wmPtr->wrapperPtr gets updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+ComputeReparentGeometry(wmPtr)
+ WmInfo *wmPtr; /* Information about toplevel window
+ * whose reparent info is to be recomputed. */
+{
+ 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,
+ (unsigned int *) &height, (unsigned int *) &bd, &dummy);
+ Tk_DeleteErrorHandler(handler);
+ if (status == 0) {
+ /*
+ * It appears that the reparented parent went away and
+ * no-one told us. Reset the window to indicate that
+ * it's not reparented.
+ */
+ wmPtr->reparent = None;
+ wmPtr->xInParent = wmPtr->yInParent = 0;
+ return 0;
+ }
+ wmPtr->xInParent = xOffset + bd;
+ wmPtr->yInParent = yOffset + bd;
+ wmPtr->parentWidth = width + 2*bd;
+ wmPtr->parentHeight = height + 2*bd;
+
+ /*
+ * Some tricky issues in updating wmPtr->x and wmPtr->y:
+ *
+ * 1. Don't update them if the event occurred because of something
+ * we did (i.e. WM_SYNC_PENDING and WM_MOVE_PENDING are both set).
+ * This is because window managers treat coords differently than Tk,
+ * and no two window managers are alike. If the window manager moved
+ * the window because we told it to, remember the coordinates we told
+ * it, not the ones it actually moved it to. This allows us to move
+ * the window back to the same coordinates later and get the same
+ * result. Without this check, windows can "walk" across the screen
+ * under some conditions.
+ *
+ * 2. Don't update wmPtr->x and wmPtr->y unless wrapperPtr->changes.x
+ * or wrapperPtr->changes.y has changed (otherwise a size change can
+ * spoof us into thinking that the position changed too and defeat
+ * the intent of (1) above.
+ *
+ * (As of 9/96 the above 2 comments appear to be stale. They're
+ * being left in place as a reminder of what was once true (and
+ * perhaps should still be true?)).
+ *
+ * 3. Ignore size changes coming from the window system if we're
+ * about to change the size ourselves but haven't seen the event for
+ * it yet: our size change is supposed to take priority.
+ */
+
+ if (!(wmPtr->flags & WM_MOVE_PENDING)
+ && ((wmPtr->wrapperPtr->changes.x != (x + wmPtr->xInParent))
+ || (wmPtr->wrapperPtr->changes.y != (y + wmPtr->yInParent)))) {
+ wmPtr->x = x;
+ if (wmPtr->flags & WM_NEGATIVE_X) {
+ wmPtr->x = wmPtr->vRootWidth - (wmPtr->x + wmPtr->parentWidth);
+ }
+ wmPtr->y = y;
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WrapperEventProc --
+ *
+ * This procedure is invoked by the event loop when a wrapper window
+ * is restructured.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Tk's internal data structures for the window get modified to
+ * reflect the structural change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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
+ * in a synthetic Configure event. These events are not relevant
+ * to us, and if we process them confusion may result (e.g. we
+ * may conclude erroneously that the user repositioned or resized
+ * the window).
+ */
+
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ ConfigureEvent(wmPtr, &eventPtr->xconfigure);
+ }
+ } else if (eventPtr->type == MapNotify) {
+ wmPtr->wrapperPtr->flags |= TK_MAPPED;
+ wmPtr->winPtr->flags |= TK_MAPPED;
+ XMapWindow(wmPtr->winPtr->display, wmPtr->winPtr->window);
+ goto doMapEvent;
+ } else if (eventPtr->type == UnmapNotify) {
+ wmPtr->wrapperPtr->flags &= ~TK_MAPPED;
+ wmPtr->winPtr->flags &= ~TK_MAPPED;
+ XUnmapWindow(wmPtr->winPtr->display, wmPtr->winPtr->window);
+ goto doMapEvent;
+ } else if (eventPtr->type == ReparentNotify) {
+ ReparentEvent(wmPtr, &eventPtr->xreparent);
+ }
+ return;
+
+ doMapEvent:
+ mapEvent = *eventPtr;
+ mapEvent.xmap.event = wmPtr->winPtr->window;
+ mapEvent.xmap.window = wmPtr->winPtr->window;
+ Tk_HandleEvent(&mapEvent);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TopLevelReqProc --
+ *
+ * This procedure is invoked by the geometry manager whenever
+ * the requested size for a top-level window is changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arrange for the window to be resized to satisfy the request
+ * (this happens as a when-idle action).
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+TopLevelReqProc(dummy, tkwin)
+ ClientData dummy; /* Not used. */
+ Tk_Window tkwin; /* Information about window. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ WmInfo *wmPtr;
+
+ wmPtr = winPtr->wmInfoPtr;
+
+ if ((wmPtr->width >= 0) && (wmPtr->height >= 0)) {
+ /*
+ * Explicit dimensions have been set for this window, so we
+ * should ignore the geometry request. It's actually important
+ * to ignore the geometry request because, due to quirks in
+ * window managers, invoking UpdateGeometryInfo may cause the
+ * window to move. For example, if "wm geometry -10-20" was
+ * invoked, the window may be positioned incorrectly the first
+ * time it appears (because we didn't know the proper width of
+ * the window manager borders); if we invoke UpdateGeometryInfo
+ * again, the window will be positioned correctly, which may
+ * cause it to jump on the screen.
+ */
+
+ return;
+ }
+
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+
+ /*
+ * If the window isn't being positioned by its upper left corner
+ * then we have to move it as well.
+ */
+
+ if (wmPtr->flags & (WM_NEGATIVE_X | WM_NEGATIVE_Y)) {
+ wmPtr->flags |= WM_MOVE_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateGeometryInfo --
+ *
+ * This procedure is invoked when a top-level window is first
+ * mapped, and also as a when-idle procedure, to bring the
+ * geometry and/or position of a top-level window back into
+ * line with what has been requested by the user and/or widgets.
+ * This procedure doesn't return until the window manager has
+ * responded to the geometry change.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The size and location of both the toplevel window and its wrapper
+ * may change, unless the WM prevents that from happening.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateGeometryInfo(clientData)
+ ClientData clientData; /* Pointer to the window's record. */
+{
+ register TkWindow *winPtr = (TkWindow *) clientData;
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int x, y, width, height;
+ unsigned long serial;
+
+ wmPtr->flags &= ~WM_UPDATE_PENDING;
+
+ /*
+ * Compute the new size for the top-level window. See the
+ * user documentation for details on this, but the size
+ * requested depends on (a) the size requested internally
+ * by the window's widgets, (b) the size requested by the
+ * user in a "wm geometry" command or via wm-based interactive
+ * resizing (if any), and (c) whether or not the window is
+ * gridded. Don't permit sizes <= 0 because this upsets
+ * the X server.
+ */
+
+ if (wmPtr->width == -1) {
+ width = winPtr->reqWidth;
+ } else if (wmPtr->gridWin != NULL) {
+ width = winPtr->reqWidth
+ + (wmPtr->width - wmPtr->reqGridWidth)*wmPtr->widthInc;
+ } else {
+ width = wmPtr->width;
+ }
+ if (width <= 0) {
+ width = 1;
+ }
+ if (wmPtr->height == -1) {
+ height = winPtr->reqHeight;
+ } else if (wmPtr->gridWin != NULL) {
+ height = winPtr->reqHeight
+ + (wmPtr->height - wmPtr->reqGridHeight)*wmPtr->heightInc;
+ } else {
+ height = wmPtr->height;
+ }
+ if (height <= 0) {
+ height = 1;
+ }
+
+ /*
+ * Compute the new position for the upper-left pixel of the window's
+ * decorative frame. This is tricky, because we need to include the
+ * border widths supplied by a reparented parent in this calculation,
+ * but can't use the parent's current overall size since that may
+ * change as a result of this code.
+ */
+
+ if (wmPtr->flags & WM_NEGATIVE_X) {
+ x = wmPtr->vRootWidth - wmPtr->x
+ - (width + (wmPtr->parentWidth - winPtr->changes.width));
+ } else {
+ x = wmPtr->x;
+ }
+ if (wmPtr->flags & WM_NEGATIVE_Y) {
+ y = wmPtr->vRootHeight - wmPtr->y
+ - (height + (wmPtr->parentHeight - winPtr->changes.height));
+ } else {
+ y = wmPtr->y;
+ }
+
+ /*
+ * If the window's size is going to change and the window is
+ * supposed to not be resizable by the user, then we have to
+ * update the size hints. There may also be a size-hint-update
+ * request pending from somewhere else, too.
+ */
+
+ if (((width != winPtr->changes.width)
+ || (height != winPtr->changes.height))
+ && (wmPtr->gridWin == NULL)
+ && ((wmPtr->sizeHintsFlags & (PMinSize|PMaxSize)) == 0)) {
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ }
+ if (wmPtr->flags & WM_UPDATE_SIZE_HINTS) {
+ UpdateSizeHints(winPtr);
+ }
+
+ /*
+ * Reconfigure the wrapper if it isn't already configured correctly.
+ * A few tricky points:
+ *
+ * 1. If the window is embeddedand the container is also in this
+ * process, don't actually reconfigure the window; just pass the
+ * desired size on to the container. Also, zero out any position
+ * information, since embedded windows are not allowed to move.
+ * 2. Sometimes the window manager will give us a different size
+ * than we asked for (e.g. mwm has a minimum size for windows), so
+ * base the size check on what we *asked for* last time, not what we
+ * got.
+ * 3. Can't just reconfigure always, because we may not get a
+ * ConfigureNotify event back if nothing changed, so
+ * WaitForConfigureNotify will hang a long time.
+ * 4. Don't move window unless a new position has been requested for
+ * it. This is because of "features" in some window managers (e.g.
+ * twm, as of 4/24/91) where they don't interpret coordinates
+ * according to ICCCM. Moving a window to its current location may
+ * cause it to shift position on the screen.
+ */
+
+ if ((winPtr->flags & (TK_EMBEDDED|TK_BOTH_HALVES))
+ == (TK_EMBEDDED|TK_BOTH_HALVES)) {
+ /*
+ * This window is embedded and the container is also in this
+ * process, so we don't need to do anything special about the
+ * geometry, except to make sure that the desired size is known
+ * by the container. Also, zero out any position information,
+ * since embedded windows are not allowed to move.
+ */
+
+ wmPtr->x = wmPtr->y = 0;
+ wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y);
+ height += wmPtr->menuHeight;
+ Tk_GeometryRequest((Tk_Window) TkpGetOtherWindow(winPtr),
+ width, height);
+ return;
+ }
+ serial = NextRequest(winPtr->display);
+ height += wmPtr->menuHeight;
+ if (wmPtr->flags & WM_MOVE_PENDING) {
+ if ((x == winPtr->changes.x) && (y == winPtr->changes.y)
+ && (width == wmPtr->wrapperPtr->changes.width)
+ && (height == wmPtr->wrapperPtr->changes.height)) {
+ /*
+ * The window already has the correct geometry, 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.
+ */
+
+ 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))) {
+ /*
+ * It is possible that the window's overall size has not changed
+ * but the menu size has.
+ */
+
+ Tk_MoveResizeWindow(wmPtr->menubar, 0, 0,
+ wmPtr->wrapperPtr->changes.width, wmPtr->menuHeight);
+ XResizeWindow(winPtr->display, wmPtr->wrapperPtr->window,
+ (unsigned) width, (unsigned) height);
+ } else {
+ return;
+ }
+
+ /*
+ * Wait for the configure operation to complete. Don't need to do
+ * this, however, if the window is about to be mapped: it will be
+ * taken care of elsewhere.
+ */
+
+ if (!(wmPtr->flags & WM_ABOUT_TO_MAP)) {
+ WaitForConfigureNotify(winPtr, serial);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * UpdateSizeHints --
+ *
+ * This procedure is called to update the window manager's
+ * size hints information from the information in a WmInfo
+ * structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Properties get changed for winPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+UpdateSizeHints(winPtr)
+ TkWindow *winPtr;
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ XSizeHints *hintsPtr;
+ int maxWidth, maxHeight;
+
+ wmPtr->flags &= ~WM_UPDATE_SIZE_HINTS;
+
+ hintsPtr = XAllocSizeHints();
+ if (hintsPtr == NULL) {
+ return;
+ }
+
+ /*
+ * Compute the pixel-based sizes for the various fields in the
+ * size hints structure, based on the grid-based sizes in
+ * our structure.
+ */
+
+ GetMaxSize(wmPtr, &maxWidth, &maxHeight);
+ if (wmPtr->gridWin != NULL) {
+ hintsPtr->base_width = winPtr->reqWidth
+ - (wmPtr->reqGridWidth * wmPtr->widthInc);
+ if (hintsPtr->base_width < 0) {
+ hintsPtr->base_width = 0;
+ }
+ hintsPtr->base_height = winPtr->reqHeight + wmPtr->menuHeight
+ - (wmPtr->reqGridHeight * wmPtr->heightInc);
+ if (hintsPtr->base_height < 0) {
+ hintsPtr->base_height = 0;
+ }
+ hintsPtr->min_width = hintsPtr->base_width
+ + (wmPtr->minWidth * wmPtr->widthInc);
+ hintsPtr->min_height = hintsPtr->base_height
+ + (wmPtr->minHeight * wmPtr->heightInc);
+ hintsPtr->max_width = hintsPtr->base_width
+ + (maxWidth * wmPtr->widthInc);
+ hintsPtr->max_height = hintsPtr->base_height
+ + (maxHeight * wmPtr->heightInc);
+ } else {
+ hintsPtr->min_width = wmPtr->minWidth;
+ hintsPtr->min_height = wmPtr->minHeight;
+ hintsPtr->max_width = maxWidth;
+ hintsPtr->max_height = maxHeight;
+ hintsPtr->base_width = 0;
+ hintsPtr->base_height = 0;
+ }
+ hintsPtr->width_inc = wmPtr->widthInc;
+ hintsPtr->height_inc = wmPtr->heightInc;
+ hintsPtr->min_aspect.x = wmPtr->minAspect.x;
+ hintsPtr->min_aspect.y = wmPtr->minAspect.y;
+ hintsPtr->max_aspect.x = wmPtr->maxAspect.x;
+ hintsPtr->max_aspect.y = wmPtr->maxAspect.y;
+ hintsPtr->win_gravity = wmPtr->gravity;
+ hintsPtr->flags = wmPtr->sizeHintsFlags | PMinSize | PMaxSize;
+
+ /*
+ * If the window isn't supposed to be resizable, then set the
+ * minimum and maximum dimensions to be the same.
+ */
+
+ if (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) {
+ if (wmPtr->width >= 0) {
+ hintsPtr->min_width = wmPtr->width;
+ } else {
+ hintsPtr->min_width = winPtr->reqWidth;
+ }
+ hintsPtr->max_width = hintsPtr->min_width;
+ }
+ if (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) {
+ if (wmPtr->height >= 0) {
+ hintsPtr->min_height = wmPtr->height;
+ } else {
+ hintsPtr->min_height = winPtr->reqHeight + wmPtr->menuHeight;
+ }
+ hintsPtr->max_height = hintsPtr->min_height;
+ }
+
+ XSetWMNormalHints(winPtr->display, wmPtr->wrapperPtr->window, hintsPtr);
+
+ XFree((char *) hintsPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitForConfigureNotify --
+ *
+ * This procedure is invoked in order to synchronize with the
+ * window manager. It waits for a ConfigureNotify event to
+ * arrive, signalling that the window manager has seen an attempt
+ * on our part to move or resize a top-level window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Delays the execution of the process until a ConfigureNotify event
+ * arrives with serial number at least as great as serial. This
+ * is useful for two reasons:
+ *
+ * 1. It's important to distinguish ConfigureNotify events that are
+ * coming in response to a request we've made from those generated
+ * spontaneously by the user. The reason for this is that if the
+ * user resizes the window we take that as an order to ignore
+ * geometry requests coming from inside the window hierarchy. If
+ * we accidentally interpret a response to our request as a
+ * user-initiated action, the window will stop responding to
+ * new geometry requests. To make this distinction, (a) this
+ * procedure sets a flag for TopLevelEventProc to indicate that
+ * we're waiting to sync with the wm, and (b) all changes to
+ * the size of a top-level window are followed by calls to this
+ * procedure.
+ * 2. Races and confusion can come about if there are multiple
+ * operations outstanding at a time (e.g. two different resizes
+ * of the top-level window: it's hard to tell which of the
+ * ConfigureNotify events coming back is for which request).
+ * While waiting, all events covered by StructureNotifyMask are
+ * processed and all others are deferred.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+WaitForConfigureNotify(winPtr, serial)
+ TkWindow *winPtr; /* Top-level window for which we want
+ * to see a ConfigureNotify. */
+ unsigned long serial; /* Serial number of resize request. Want to
+ * be sure wm has seen this. */
+{
+ WmInfo *wmPtr = winPtr->wmInfoPtr;
+ XEvent event;
+ int diff, code;
+ int gotConfig = 0;
+
+ /*
+ * One more tricky detail about this procedure. In some cases the
+ * window manager will decide to ignore a configure request (e.g.
+ * because it thinks the window is already in the right place).
+ * To avoid hanging in this situation, only wait for a few seconds,
+ * then give up.
+ */
+
+ 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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitForEvent --
+ *
+ * This procedure is used by WaitForConfigureNotify and
+ * WaitForMapNotify to wait for an event of a certain type
+ * to arrive.
+ *
+ * Results:
+ * Under normal conditions, TCL_OK is returned and an event for
+ * display and window that matches "mask" is stored in *eventPtr.
+ * This event has already been processed by Tk before this procedure
+ * returns. If a long time goes by with no event of the right type
+ * arriving, or if an error occurs while waiting for the event to
+ * arrive, then TCL_ERROR is returned.
+ *
+ * Side effects:
+ * While waiting for the desired event to occur, Configurenotify
+ * events for window are processed, as are all ReparentNotify events,
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+WaitForEvent(display, window, type, eventPtr)
+ Display *display; /* Display event is coming from. */
+ Window window; /* Window for which event is desired. */
+ int type; /* Type of event that is wanted. */
+ XEvent *eventPtr; /* Place to store event. */
+{
+ WaitRestrictInfo info;
+ Tk_RestrictProc *oldRestrictProc;
+ ClientData oldRestrictData;
+ Tcl_Time timeout;
+
+ /*
+ * Set up an event filter to select just the events we want, and
+ * a timer handler, then wait for events until we get the event
+ * we want or a timeout happens.
+ */
+
+ info.display = display;
+ info.window = window;
+ info.type = type;
+ info.eventPtr = eventPtr;
+ info.foundEvent = 0;
+ oldRestrictProc = Tk_RestrictEvents(WaitRestrictProc, (ClientData) &info,
+ &oldRestrictData);
+
+ TclpGetTime(&timeout);
+ timeout.sec += 2;
+
+ while (!info.foundEvent) {
+ if (!TkUnixDoOneXEvent(&timeout)) {
+ break;
+ }
+ }
+ (void) Tk_RestrictEvents(oldRestrictProc, oldRestrictData,
+ &oldRestrictData);
+ if (info.foundEvent) {
+ return TCL_OK;
+ }
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitRestrictProc --
+ *
+ * This procedure is a Tk_RestrictProc that is used to filter
+ * events while WaitForEvent is active.
+ *
+ * Results:
+ * Returns TK_PROCESS_EVENT if the right event is found. Also
+ * returns TK_PROCESS_EVENT if any ReparentNotify event is found
+ * for window or if the event is a ConfigureNotify for window.
+ * Otherwise returns TK_DEFER_EVENT.
+ *
+ * Side effects:
+ * An event may get stored in the area indicated by the caller
+ * of WaitForEvent.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_RestrictAction
+WaitRestrictProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to WaitRestrictInfo structure. */
+ XEvent *eventPtr; /* Event that is about to be handled. */
+{
+ WaitRestrictInfo *infoPtr = (WaitRestrictInfo *) clientData;
+
+ if (eventPtr->type == ReparentNotify) {
+ return TK_PROCESS_EVENT;
+ }
+ if ((eventPtr->xany.window != infoPtr->window)
+ || (eventPtr->xany.display != infoPtr->display)) {
+ return TK_DEFER_EVENT;
+ }
+ if (eventPtr->type == infoPtr->type) {
+ *infoPtr->eventPtr = *eventPtr;
+ infoPtr->foundEvent = 1;
+ return TK_PROCESS_EVENT;
+ }
+ if (eventPtr->type == ConfigureNotify) {
+ return TK_PROCESS_EVENT;
+ }
+ return TK_DEFER_EVENT;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WaitForMapNotify --
+ *
+ * This procedure is invoked in order to synchronize with the
+ * window manager. It waits for the window's mapped state to
+ * reach the value given by mapped.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Delays the execution of the process until winPtr becomes mapped
+ * or unmapped, depending on the "mapped" argument. This allows us
+ * to synchronize with the window manager, and allows us to
+ * identify changes in window size that come about when the window
+ * manager first starts managing the window (as opposed to those
+ * requested interactively by the user later). See the comments
+ * for WaitForConfigureNotify and WM_SYNC_PENDING. While waiting,
+ * all events covered by StructureNotifyMask are processed and all
+ * others are deferred.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+WaitForMapNotify(winPtr, mapped)
+ TkWindow *winPtr; /* Top-level window for which we want
+ * to see a particular mapping state. */
+ int mapped; /* If non-zero, wait for window to become
+ * mapped, otherwise wait for it to become
+ * unmapped. */
+{
+ WmInfo *wmPtr = winPtr->wmInfoPtr;
+ XEvent event;
+ int code;
+
+ while (1) {
+ if (mapped) {
+ if (winPtr->flags & TK_MAPPED) {
+ break;
+ }
+ } else if (!(winPtr->flags & TK_MAPPED)) {
+ break;
+ }
+ wmPtr->flags |= WM_SYNC_PENDING;
+ code = WaitForEvent(winPtr->display, wmPtr->wrapperPtr->window,
+ mapped ? MapNotify : UnmapNotify, &event);
+ wmPtr->flags &= ~WM_SYNC_PENDING;
+ if (code != TCL_OK) {
+ /*
+ * 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);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * UpdateHints --
+ *
+ * This procedure is called to update the window manager's
+ * hints information from the information in a WmInfo
+ * structure.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Properties get changed for winPtr.
+ *
+ *--------------------------------------------------------------
+ */
+
+static void
+UpdateHints(winPtr)
+ TkWindow *winPtr;
+{
+ WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (wmPtr->flags & WM_NEVER_MAPPED) {
+ return;
+ }
+ XSetWMHints(winPtr->display, wmPtr->wrapperPtr->window, &wmPtr->hints);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ParseGeometry --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ParseGeometry(interp, string, winPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ char *string; /* String containing new geometry. Has the
+ * standard form "=wxh+x+y". */
+ TkWindow *winPtr; /* Pointer to top-level window whose
+ * geometry is to be changed. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int x, y, width, height, flags;
+ char *end;
+ register char *p = string;
+
+ /*
+ * The leading "=" is optional.
+ */
+
+ if (*p == '=') {
+ p++;
+ }
+
+ /*
+ * Parse the width and height, if they are present. Don't
+ * actually update any of the fields of wmPtr until we've
+ * successfully parsed the entire geometry string.
+ */
+
+ width = wmPtr->width;
+ height = wmPtr->height;
+ x = wmPtr->x;
+ y = wmPtr->y;
+ flags = wmPtr->flags;
+ if (isdigit(UCHAR(*p))) {
+ width = strtoul(p, &end, 10);
+ p = end;
+ if (*p != 'x') {
+ goto error;
+ }
+ p++;
+ if (!isdigit(UCHAR(*p))) {
+ goto error;
+ }
+ height = strtoul(p, &end, 10);
+ p = end;
+ }
+
+ /*
+ * Parse the X and Y coordinates, if they are present.
+ */
+
+ if (*p != '\0') {
+ flags &= ~(WM_NEGATIVE_X | WM_NEGATIVE_Y);
+ if (*p == '-') {
+ flags |= WM_NEGATIVE_X;
+ } else if (*p != '+') {
+ goto error;
+ }
+ p++;
+ if (!isdigit(UCHAR(*p)) && (*p != '-')) {
+ goto error;
+ }
+ x = strtol(p, &end, 10);
+ p = end;
+ if (*p == '-') {
+ flags |= WM_NEGATIVE_Y;
+ } else if (*p != '+') {
+ goto error;
+ }
+ p++;
+ if (!isdigit(UCHAR(*p)) && (*p != '-')) {
+ goto error;
+ }
+ y = strtol(p, &end, 10);
+ if (*end != '\0') {
+ goto error;
+ }
+
+ /*
+ * Assume that the geometry information came from the user,
+ * unless an explicit source has been specified. Otherwise
+ * most window managers assume that the size hints were
+ * program-specified and they ignore them.
+ */
+
+ if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) {
+ wmPtr->sizeHintsFlags |= USPosition;
+ flags |= WM_UPDATE_SIZE_HINTS;
+ }
+ }
+
+ /*
+ * Everything was parsed OK. Update the fields of *wmPtr and
+ * arrange for the appropriate information to be percolated out
+ * to the window manager at the next idle moment.
+ */
+
+ wmPtr->width = width;
+ wmPtr->height = height;
+ wmPtr->x = x;
+ wmPtr->y = y;
+ flags |= WM_MOVE_PENDING;
+ wmPtr->flags = flags;
+
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+ return TCL_OK;
+
+ error:
+ Tcl_AppendResult(interp, "bad geometry specifier \"",
+ string, "\"", (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetRootCoords --
+ *
+ * Given a token for a window, this procedure traces through the
+ * window's lineage to find the (virtual) root-window coordinates
+ * corresponding to point (0,0) in the window.
+ *
+ * Results:
+ * The locations pointed to by xPtr and yPtr are filled in with
+ * the root coordinates of the (0,0) point in tkwin. If a virtual
+ * root window is in effect for the window, then the coordinates
+ * in the virtual root are returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_GetRootCoords(tkwin, xPtr, yPtr)
+ Tk_Window tkwin; /* Token for window. */
+ int *xPtr; /* Where to store x-displacement of (0,0). */
+ int *yPtr; /* Where to store y-displacement of (0,0). */
+{
+ int x, y;
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ /*
+ * Search back through this window's parents all the way to a
+ * top-level window, combining the offsets of each window within
+ * its parent.
+ */
+
+ x = y = 0;
+ while (1) {
+ x += winPtr->changes.x + winPtr->changes.border_width;
+ y += winPtr->changes.y + winPtr->changes.border_width;
+ if ((winPtr->wmInfoPtr != NULL)
+ && (winPtr->wmInfoPtr->menubar == (Tk_Window) winPtr)) {
+ /*
+ * This window is a special menubar; switch over to its
+ * associated toplevel, compensate for their differences in
+ * y coordinates, then continue with the toplevel (in case
+ * it's embedded).
+ */
+
+ y -= winPtr->wmInfoPtr->menuHeight;
+ winPtr = winPtr->wmInfoPtr->winPtr;
+ continue;
+ }
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ TkWindow *otherPtr;
+
+ if (!(winPtr->flags & TK_EMBEDDED)) {
+ break;
+ }
+ otherPtr = TkpGetOtherWindow(winPtr);
+ if (otherPtr == NULL) {
+ /*
+ * The container window is not in the same application.
+ * Query the X server.
+ */
+
+ Window root, dummyChild;
+ int rootX, rootY;
+
+ root = winPtr->wmInfoPtr->vRoot;
+ if (root == None) {
+ root = RootWindowOfScreen(Tk_Screen((Tk_Window)winPtr));
+ }
+ XTranslateCoordinates(winPtr->display, winPtr->window,
+ root, 0, 0, &rootX, &rootY, &dummyChild);
+ x += rootX;
+ y += rootY;
+ break;
+ } else {
+ /*
+ * The container window is in the same application.
+ * Let's query its coordinates.
+ */
+
+ winPtr = otherPtr;
+ continue;
+ }
+ }
+ winPtr = winPtr->parentPtr;
+ if (winPtr == NULL) {
+ break;
+ }
+ }
+ *xPtr = x;
+ *yPtr = y;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CoordsToWindow --
+ *
+ * Given the (virtual) root coordinates of a point, this procedure
+ * returns the token for the top-most window covering that point,
+ * if there exists such a window in this application.
+ *
+ * Results:
+ * The return result is either a token for the window corresponding
+ * to rootX and rootY, or else NULL to indicate that there is no such
+ * window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_CoordsToWindow(rootX, rootY, tkwin)
+ int rootX, rootY; /* Coordinates of point in root window. If
+ * a virtual-root window manager is in use,
+ * these coordinates refer to the virtual
+ * root, not the real root. */
+ 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);
+ parent = wmPtr->vRoot;
+ break;
+ }
+
+ /*
+ * Step 2: work down through the window hierarchy starting at the
+ * root. For each window, find the child that contains the given
+ * point and then see if this child is either a wrapper for one of
+ * our toplevel windows or a window manager decoration window for
+ * one of our toplevels. This approach handles several tricky
+ * cases:
+ *
+ * 1. There may be a virtual root window between the root and one of
+ * our toplevels.
+ * 2. If a toplevel is embedded, we may have to search through the
+ * windows of the container application(s) before getting to
+ * the toplevel.
+ */
+
+ while (1) {
+ 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;
+ }
+ } else if (child == wmPtr->winPtr->window) {
+ goto gotToplevel;
+ }
+ }
+ x = childX;
+ y = childY;
+ parent = window;
+ window = child;
+ }
+
+ gotToplevel:
+ winPtr = wmPtr->winPtr;
+ if (winPtr->mainPtr != ((TkWindow *) tkwin)->mainPtr) {
+ return NULL;
+ }
+
+ /*
+ * Step 3: at this point winPtr and wmPtr refer to the toplevel that
+ * contains the given coordinates, and childX and childY give the
+ * translated coordinates in the *parent* of the toplevel. Now
+ * decide whether the coordinates are in the menubar or the actual
+ * toplevel, and translate the coordinates into the coordinate
+ * system of that window.
+ */
+
+ x = childX - winPtr->changes.x;
+ y = childY - winPtr->changes.y;
+ if ((x < 0) || (x >= winPtr->changes.width)
+ || (y >= winPtr->changes.height)) {
+ return NULL;
+ }
+ if (y < 0) {
+ winPtr = (TkWindow *) wmPtr->menubar;
+ if (winPtr == NULL) {
+ return NULL;
+ }
+ y += wmPtr->menuHeight;
+ if (y < 0) {
+ return NULL;
+ }
+ }
+
+ /*
+ * Step 4: work down through the hierarchy underneath the current
+ * window. At each level, scan through all the children to find the
+ * highest one in the stacking order that contains the point. Then
+ * repeat the whole process on that child.
+ */
+
+ while (1) {
+ nextPtr = NULL;
+ for (childPtr = winPtr->childList; childPtr != NULL;
+ childPtr = childPtr->nextPtr) {
+ if (!Tk_IsMapped(childPtr) || (childPtr->flags & TK_TOP_LEVEL)) {
+ continue;
+ }
+ if (childPtr->flags & TK_REPARENTED) {
+ continue;
+ }
+ tmpx = x - childPtr->changes.x;
+ tmpy = y - childPtr->changes.y;
+ bd = childPtr->changes.border_width;
+ if ((tmpx >= -bd) && (tmpy >= -bd)
+ && (tmpx < (childPtr->changes.width + bd))
+ && (tmpy < (childPtr->changes.height + bd))) {
+ nextPtr = childPtr;
+ }
+ }
+ if (nextPtr == NULL) {
+ break;
+ }
+ winPtr = nextPtr;
+ x -= winPtr->changes.x;
+ y -= winPtr->changes.y;
+ if ((winPtr->flags & TK_CONTAINER)
+ && (winPtr->flags & TK_BOTH_HALVES)) {
+ /*
+ * The window containing the point is a container, and the
+ * embedded application is in this same process. Switch
+ * over to the toplevel for the embedded application and
+ * start processing that toplevel from scratch.
+ */
+
+ winPtr = TkpGetOtherWindow(winPtr);
+ wmPtr = winPtr->wmInfoPtr;
+ childX = x;
+ childY = y;
+ goto gotToplevel;
+ }
+ }
+ return (Tk_Window) winPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateVRootGeometry --
+ *
+ * This procedure is called to update all the virtual root
+ * geometry information in wmPtr.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The vRootX, vRootY, vRootWidth, and vRootHeight fields in
+ * wmPtr are filled with the most up-to-date information.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateVRootGeometry(wmPtr)
+ WmInfo *wmPtr; /* Window manager information to be
+ * updated. The wmPtr->vRoot field must
+ * be valid. */
+{
+ TkWindow *winPtr = wmPtr->winPtr;
+ int bd;
+ unsigned int dummy;
+ Window dummy2;
+ Status status;
+ Tk_ErrorHandler handler;
+
+ /*
+ * If this isn't a virtual-root window manager, just return information
+ * about the screen.
+ */
+
+ wmPtr->flags &= ~WM_VROOT_OFFSET_STALE;
+ if (wmPtr->vRoot == None) {
+ noVRoot:
+ wmPtr->vRootX = wmPtr->vRootY = 0;
+ wmPtr->vRootWidth = DisplayWidth(winPtr->display, winPtr->screenNum);
+ wmPtr->vRootHeight = DisplayHeight(winPtr->display, winPtr->screenNum);
+ return;
+ }
+
+ /*
+ * Refresh the virtual root information if it's out of date.
+ */
+
+ 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) {
+ /*
+ * The virtual root is gone! Pretend that it never existed.
+ */
+
+ wmPtr->vRoot = None;
+ goto noVRoot;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetVRootGeometry --
+ *
+ * This procedure returns information about the virtual root
+ * window corresponding to a particular Tk window.
+ *
+ * Results:
+ * The values at xPtr, yPtr, widthPtr, and heightPtr are set
+ * with the offset and dimensions of the root window corresponding
+ * to tkwin. If tkwin is being managed by a virtual root window
+ * manager these values correspond to the virtual root window being
+ * used for tkwin; otherwise the offsets will be 0 and the
+ * dimensions will be those of the screen.
+ *
+ * Side effects:
+ * Vroot window information is refreshed if it is out of date.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_GetVRootGeometry(tkwin, xPtr, yPtr, widthPtr, heightPtr)
+ Tk_Window tkwin; /* Window whose virtual root is to be
+ * queried. */
+ int *xPtr, *yPtr; /* Store x and y offsets of virtual root
+ * here. */
+ int *widthPtr, *heightPtr; /* Store dimensions of virtual root here. */
+{
+ WmInfo *wmPtr;
+ TkWindow *winPtr = (TkWindow *) tkwin;
+
+ /*
+ * Find the top-level window for tkwin, and locate the window manager
+ * information for that window.
+ */
+
+ while (!(winPtr->flags & TK_TOP_LEVEL) && (winPtr->parentPtr != NULL)) {
+ winPtr = winPtr->parentPtr;
+ }
+ wmPtr = winPtr->wmInfoPtr;
+
+ /*
+ * Make sure that the geometry information is up-to-date, then copy
+ * it out to the caller.
+ */
+
+ if (wmPtr->flags & WM_VROOT_OFFSET_STALE) {
+ UpdateVRootGeometry(wmPtr);
+ }
+ *xPtr = wmPtr->vRootX;
+ *yPtr = wmPtr->vRootY;
+ *widthPtr = wmPtr->vRootWidth;
+ *heightPtr = wmPtr->vRootHeight;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MoveToplevelWindow --
+ *
+ * This procedure is called instead of Tk_MoveWindow to adjust
+ * the x-y location of a top-level window. It delays the actual
+ * move to a later time and keeps window-manager information
+ * up-to-date with the move
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is eventually moved so that its upper-left corner
+ * (actually, the upper-left corner of the window's decorative
+ * frame, if there is one) is at (x,y).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_MoveToplevelWindow(tkwin, x, y)
+ Tk_Window tkwin; /* Window to move. */
+ int x, y; /* New location for window (within
+ * parent). */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ panic("Tk_MoveToplevelWindow called with non-toplevel window");
+ }
+ wmPtr->x = x;
+ wmPtr->y = y;
+ wmPtr->flags |= WM_MOVE_PENDING;
+ wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y);
+ if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) {
+ wmPtr->sizeHintsFlags |= USPosition;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ }
+
+ /*
+ * If the window has already been mapped, must bring its geometry
+ * up-to-date immediately, otherwise an event might arrive from the
+ * server that would overwrite wmPtr->x and wmPtr->y and lose the
+ * new position.
+ */
+
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ if (wmPtr->flags & WM_UPDATE_PENDING) {
+ Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr);
+ }
+ UpdateGeometryInfo((ClientData) winPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateWmProtocols --
+ *
+ * This procedure transfers the most up-to-date information about
+ * window manager protocols from the WmInfo structure to the actual
+ * property on the top-level window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The WM_PROTOCOLS property gets changed for wmPtr's window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateWmProtocols(wmPtr)
+ register WmInfo *wmPtr; /* Information about top-level window. */
+{
+ register ProtocolHandler *protPtr;
+ Atom deleteWindowAtom;
+ int count;
+ Atom *arrayPtr, *atomPtr;
+
+ /*
+ * There are only two tricky parts here. First, there could be any
+ * number of atoms for the window, so count them and malloc an array
+ * to hold all of their atoms. Second, we *always* want to respond
+ * to the WM_DELETE_WINDOW protocol, even if no-one's officially asked.
+ */
+
+ for (protPtr = wmPtr->protPtr, count = 1; protPtr != NULL;
+ protPtr = protPtr->nextPtr, count++) {
+ /* Empty loop body; we're just counting the handlers. */
+ }
+ arrayPtr = (Atom *) ckalloc((unsigned) (count * sizeof(Atom)));
+ deleteWindowAtom = Tk_InternAtom((Tk_Window) wmPtr->winPtr,
+ "WM_DELETE_WINDOW");
+ arrayPtr[0] = deleteWindowAtom;
+ for (protPtr = wmPtr->protPtr, atomPtr = &arrayPtr[1];
+ protPtr != NULL; protPtr = protPtr->nextPtr) {
+ if (protPtr->protocol != deleteWindowAtom) {
+ *atomPtr = protPtr->protocol;
+ atomPtr++;
+ }
+ }
+ XChangeProperty(wmPtr->winPtr->display, wmPtr->wrapperPtr->window,
+ Tk_InternAtom((Tk_Window) wmPtr->winPtr, "WM_PROTOCOLS"),
+ XA_ATOM, 32, PropModeReplace, (unsigned char *) arrayPtr,
+ atomPtr-arrayPtr);
+ ckfree((char *) arrayPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmProtocolEventProc --
+ *
+ * This procedure is called by the Tk_HandleEvent whenever a
+ * ClientMessage event arrives whose type is "WM_PROTOCOLS".
+ * This procedure handles the message from the window manager
+ * in an appropriate fashion.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on what sort of handler, if any, was set up for the
+ * protocol.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWmProtocolEventProc(winPtr, eventPtr)
+ TkWindow *winPtr; /* Window to which the event was sent. */
+ XEvent *eventPtr; /* X event. */
+{
+ WmInfo *wmPtr;
+ register ProtocolHandler *protPtr;
+ Atom protocol;
+ int result;
+ char *protocolName;
+ Tcl_Interp *interp;
+
+ wmPtr = winPtr->wmInfoPtr;
+ if (wmPtr == NULL) {
+ return;
+ }
+ protocol = (Atom) eventPtr->xclient.data.l[0];
+
+ /*
+ * Note: it's very important to retrieve the protocol name now,
+ * before invoking the command, even though the name won't be used
+ * until after the command returns. This is because the command
+ * could delete winPtr, making it impossible for us to use it
+ * later in the call to Tk_GetAtomName.
+ */
+
+ protocolName = Tk_GetAtomName((Tk_Window) winPtr, protocol);
+ for (protPtr = wmPtr->protPtr; protPtr != NULL;
+ protPtr = protPtr->nextPtr) {
+ if (protocol == protPtr->protocol) {
+ Tcl_Preserve((ClientData) protPtr);
+ interp = protPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ result = Tcl_GlobalEval(interp, protPtr->command);
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(interp, "\n (command for \"");
+ Tcl_AddErrorInfo(interp, protocolName);
+ Tcl_AddErrorInfo(interp,
+ "\" window manager protocol)");
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_Release((ClientData) interp);
+ Tcl_Release((ClientData) protPtr);
+ return;
+ }
+ }
+
+ /*
+ * No handler was present for this protocol. If this is a
+ * WM_DELETE_WINDOW message then just destroy the window.
+ */
+
+ if (protocol == Tk_InternAtom((Tk_Window) winPtr, "WM_DELETE_WINDOW")) {
+ Tk_DestroyWindow((Tk_Window) wmPtr->winPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmRestackToplevel --
+ *
+ * This procedure restacks a top-level window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * WinPtr gets restacked as specified by aboveBelow and otherPtr.
+ * This procedure doesn't return until the restack has taken
+ * effect and the ConfigureNotify event for it has been received.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWmRestackToplevel(winPtr, aboveBelow, otherPtr)
+ TkWindow *winPtr; /* Window to restack. */
+ int aboveBelow; /* Gives relative position for restacking;
+ * must be Above or Below. */
+ TkWindow *otherPtr; /* Window relative to which to restack;
+ * if NULL, then winPtr gets restacked
+ * above or below *all* siblings. */
+{
+ XWindowChanges changes;
+ XWindowAttributes atts;
+ unsigned int mask;
+ Window window, dummy1, dummy2, vRoot;
+ Window *children;
+ unsigned int numChildren;
+ int i;
+ int desiredIndex = 0; /* Initialized to stop gcc warnings. */
+ int ourIndex = 0; /* Initialized to stop gcc warnings. */
+ unsigned long serial;
+ XEvent event;
+ int diff;
+ Tk_ErrorHandler handler;
+ TkWindow *wrapperPtr;
+
+ changes.stack_mode = aboveBelow;
+ changes.sibling = None;
+ mask = CWStackMode;
+ if (winPtr->window == None) {
+ Tk_MakeWindowExist((Tk_Window) winPtr);
+ }
+ if (winPtr->wmInfoPtr->flags & WM_NEVER_MAPPED) {
+ /*
+ * Can't set stacking order properly until the window is on the
+ * screen (mapping it may give it a reparent window), so make sure
+ * it's on the screen.
+ */
+
+ TkWmMapWindow(winPtr);
+ }
+ wrapperPtr = winPtr->wmInfoPtr->wrapperPtr;
+ window = (winPtr->wmInfoPtr->reparent != None)
+ ? winPtr->wmInfoPtr->reparent : wrapperPtr->window;
+ if (otherPtr != NULL) {
+ if (otherPtr->window == None) {
+ Tk_MakeWindowExist((Tk_Window) otherPtr);
+ }
+ if (otherPtr->wmInfoPtr->flags & WM_NEVER_MAPPED) {
+ TkWmMapWindow(otherPtr);
+ }
+ changes.sibling = (otherPtr->wmInfoPtr->reparent != None)
+ ? otherPtr->wmInfoPtr->reparent
+ : otherPtr->wmInfoPtr->wrapperPtr->window;
+ mask = CWStackMode|CWSibling;
+ }
+
+ /*
+ * Before actually reconfiguring the window, see if it's already
+ * in the right place. If so then don't reconfigure it. The
+ * reason for this extra work is that some window managers will
+ * ignore the reconfigure request if the window is already in
+ * the right place, causing a long delay in WaitForConfigureNotify
+ * while it times out. Special note: if the window is almost in
+ * the right place, and the only windows between it and the right
+ * place aren't mapped, then we don't reconfigure it either, for
+ * the same reason.
+ */
+
+ vRoot = winPtr->wmInfoPtr->vRoot;
+ if (vRoot == None) {
+ vRoot = RootWindowOfScreen(Tk_Screen((Tk_Window) winPtr));
+ }
+ if (XQueryTree(winPtr->display, vRoot, &dummy1, &dummy2,
+ &children, &numChildren) != 0) {
+ /*
+ * Find where our window is in the stacking order, and
+ * compute the desired location in the stacking order.
+ */
+
+ for (i = 0; i < numChildren; i++) {
+ if (children[i] == window) {
+ ourIndex = i;
+ }
+ if (children[i] == changes.sibling) {
+ desiredIndex = i;
+ }
+ }
+ if (mask & CWSibling) {
+ if (aboveBelow == Above) {
+ if (desiredIndex < ourIndex) {
+ desiredIndex += 1;
+ }
+ } else {
+ if (desiredIndex > ourIndex) {
+ desiredIndex -= 1;
+ }
+ }
+ } else {
+ if (aboveBelow == Above) {
+ desiredIndex = numChildren-1;
+ } else {
+ desiredIndex = 0;
+ }
+ }
+
+ /*
+ * See if there are any mapped windows between where we are
+ * and where we want to be.
+ */
+
+ handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ while (desiredIndex != ourIndex) {
+ if ((XGetWindowAttributes(winPtr->display, children[desiredIndex],
+ &atts) != 0) && (atts.map_state != IsUnmapped)) {
+ break;
+ }
+ if (desiredIndex < ourIndex) {
+ desiredIndex++;
+ } else {
+ desiredIndex--;
+ }
+ }
+ Tk_DeleteErrorHandler(handler);
+ XFree((char *) children);
+ if (ourIndex == desiredIndex) {
+ return;
+ }
+ }
+
+ /*
+ * Reconfigure the window. This tricky because of two things:
+ * (a) Some window managers, like olvwm, insist that we raise
+ * or lower the toplevel window itself, as opposed to its
+ * decorative frame. Attempts to raise or lower the frame
+ * are ignored.
+ * (b) If the raise or lower is relative to a sibling, X will
+ * generate an error unless we work with the frames (the
+ * toplevels themselves aren't siblings).
+ * Fortunately, the procedure XReconfigureWMWindow is supposed
+ * to handle all of this stuff, so be careful to use it instead
+ * of XConfigureWindow.
+ */
+
+ serial = NextRequest(winPtr->display);
+ if (window != wrapperPtr->window) {
+ /*
+ * We're going to have to wait for events on a window that
+ * Tk doesn't own, so we have to tell X specially that we
+ * want to get events on that window. To make matters worse,
+ * it's possible that the window doesn't exist anymore (e.g.
+ * the toplevel could have been withdrawn) so ignore events
+ * occurring during the request.
+ */
+
+ handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ XSelectInput(winPtr->display, window, StructureNotifyMask);
+ Tk_DeleteErrorHandler(handler);
+ }
+ XReconfigureWMWindow(winPtr->display, wrapperPtr->window,
+ Tk_ScreenNumber((Tk_Window) winPtr), mask, &changes);
+
+ /*
+ * Wait for the reconfiguration to complete. If we don't wait, then
+ * the window may not restack for a while and the application might
+ * observe it before it has restacked. Waiting for the reconfiguration
+ * is tricky if winPtr has been reparented, since the window getting
+ * the event isn't one that Tk owns.
+ */
+
+ if (window == wrapperPtr->window) {
+ WaitForConfigureNotify(winPtr, serial);
+ } else {
+ while (1) {
+ if (WaitForEvent(winPtr->display, window, ConfigureNotify,
+ &event) != TCL_OK) {
+ break;
+ }
+ diff = event.xconfigure.serial - serial;
+ if (diff >= 0) {
+ break;
+ }
+ }
+
+ /*
+ * Ignore errors that occur when we are de-selecting events on
+ * window, since it's possible that the window doesn't exist
+ * anymore (see comment above previous call to XSelectInput).
+ */
+
+ handler = Tk_CreateErrorHandler(winPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ XSelectInput(winPtr->display, window, (long) 0);
+ Tk_DeleteErrorHandler(handler);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmAddToColormapWindows --
+ *
+ * This procedure is called to add a given window to the
+ * WM_COLORMAP_WINDOWS property for its top-level, if it
+ * isn't already there. It is invoked by the Tk code that
+ * creates a new colormap, in order to make sure that colormap
+ * information is propagated to the window manager by default.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * WinPtr's window gets added to the WM_COLORMAP_WINDOWS
+ * property of its nearest top-level ancestor, unless the
+ * colormaps have been set explicitly with the
+ * "wm colormapwindows" command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWmAddToColormapWindows(winPtr)
+ TkWindow *winPtr; /* Window with a non-default colormap.
+ * Should not be a top-level window. */
+{
+ TkWindow *wrapperPtr;
+ TkWindow *topPtr;
+ Window *oldPtr, *newPtr;
+ int count, i;
+
+ if (winPtr->window == None) {
+ return;
+ }
+
+ for (topPtr = winPtr->parentPtr; ; topPtr = topPtr->parentPtr) {
+ if (topPtr == NULL) {
+ /*
+ * Window is being deleted. Skip the whole operation.
+ */
+
+ return;
+ }
+ if (topPtr->flags & TK_TOP_LEVEL) {
+ break;
+ }
+ }
+ if (topPtr->wmInfoPtr->flags & WM_COLORMAPS_EXPLICIT) {
+ return;
+ }
+ if (topPtr->wmInfoPtr->wrapperPtr == NULL) {
+ CreateWrapper(topPtr->wmInfoPtr);
+ }
+ wrapperPtr = topPtr->wmInfoPtr->wrapperPtr;
+
+ /*
+ * Fetch the old value of the property.
+ */
+
+ if (XGetWMColormapWindows(topPtr->display, wrapperPtr->window,
+ &oldPtr, &count) == 0) {
+ oldPtr = NULL;
+ count = 0;
+ }
+
+ /*
+ * Make sure that the window isn't already in the list.
+ */
+
+ for (i = 0; i < count; i++) {
+ if (oldPtr[i] == winPtr->window) {
+ return;
+ }
+ }
+
+ /*
+ * Make a new bigger array and use it to reset the property.
+ * Automatically add the toplevel itself as the last element
+ * of the list.
+ */
+
+ newPtr = (Window *) ckalloc((unsigned) ((count+2)*sizeof(Window)));
+ for (i = 0; i < count; i++) {
+ newPtr[i] = oldPtr[i];
+ }
+ if (count == 0) {
+ count++;
+ }
+ newPtr[count-1] = winPtr->window;
+ newPtr[count] = topPtr->window;
+ XSetWMColormapWindows(topPtr->display, wrapperPtr->window, newPtr,
+ count+1);
+ ckfree((char *) newPtr);
+ if (oldPtr != NULL) {
+ XFree((char *) oldPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmRemoveFromColormapWindows --
+ *
+ * This procedure is called to remove a given window from the
+ * WM_COLORMAP_WINDOWS property for its top-level. It is invoked
+ * when windows are deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * WinPtr's window gets removed from the WM_COLORMAP_WINDOWS
+ * property of its nearest top-level ancestor, unless the
+ * top-level itself is being deleted too.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWmRemoveFromColormapWindows(winPtr)
+ TkWindow *winPtr; /* Window that may be present in
+ * WM_COLORMAP_WINDOWS property for its
+ * top-level. Should not be a top-level
+ * window. */
+{
+ TkWindow *wrapperPtr;
+ TkWindow *topPtr;
+ Window *oldPtr;
+ int count, i, j;
+
+ if (winPtr->window == None) {
+ return;
+ }
+
+ for (topPtr = winPtr->parentPtr; ; topPtr = topPtr->parentPtr) {
+ if (topPtr == NULL) {
+ /*
+ * Ancestors have been deleted, so skip the whole operation.
+ * Seems like this can't ever happen?
+ */
+
+ return;
+ }
+ if (topPtr->flags & TK_TOP_LEVEL) {
+ break;
+ }
+ }
+ if (topPtr->flags & TK_ALREADY_DEAD) {
+ /*
+ * Top-level is being deleted, so there's no need to cleanup
+ * the WM_COLORMAP_WINDOWS property.
+ */
+
+ return;
+ }
+ if (topPtr->wmInfoPtr->wrapperPtr == NULL) {
+ CreateWrapper(topPtr->wmInfoPtr);
+ }
+ wrapperPtr = topPtr->wmInfoPtr->wrapperPtr;
+ if (wrapperPtr == NULL) {
+ return;
+ }
+
+ /*
+ * Fetch the old value of the property.
+ */
+
+ if (XGetWMColormapWindows(topPtr->display, wrapperPtr->window,
+ &oldPtr, &count) == 0) {
+ return;
+ }
+
+ /*
+ * Find the window and slide the following ones down to cover
+ * it up.
+ */
+
+ for (i = 0; i < count; i++) {
+ if (oldPtr[i] == winPtr->window) {
+ for (j = i ; j < count-1; j++) {
+ oldPtr[j] = oldPtr[j+1];
+ }
+ XSetWMColormapWindows(topPtr->display, wrapperPtr->window,
+ oldPtr, count-1);
+ break;
+ }
+ }
+ XFree((char *) oldPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetPointerCoords --
+ *
+ * Fetch the position of the mouse pointer.
+ *
+ * Results:
+ * *xPtr and *yPtr are filled in with the (virtual) root coordinates
+ * of the mouse pointer for tkwin's display. If the pointer isn't
+ * on tkwin's screen, then -1 values are returned for both
+ * coordinates. The argument tkwin must be a toplevel window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkGetPointerCoords(tkwin, xPtr, yPtr)
+ Tk_Window tkwin; /* Toplevel window that identifies screen
+ * on which lookup is to be done. */
+ int *xPtr, *yPtr; /* Store pointer coordinates here. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ WmInfo *wmPtr;
+ Window w, root, child;
+ int rootX, rootY;
+ unsigned int mask;
+
+ wmPtr = winPtr->wmInfoPtr;
+
+ w = wmPtr->vRoot;
+ if (w == None) {
+ w = RootWindow(winPtr->display, winPtr->screenNum);
+ }
+ if (XQueryPointer(winPtr->display, w, &root, &child, &rootX, &rootY,
+ xPtr, yPtr, &mask) != True) {
+ *xPtr = -1;
+ *yPtr = -1;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMaxSize --
+ *
+ * This procedure computes the current maxWidth and maxHeight
+ * values for a window, taking into account the possibility
+ * that they may be defaulted.
+ *
+ * Results:
+ * The values at *maxWidthPtr and *maxHeightPtr are filled
+ * in with the maximum allowable dimensions of wmPtr's window,
+ * in grid units. If no maximum has been specified for the
+ * window, then this procedure computes the largest sizes that
+ * will fit on the screen.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMaxSize(wmPtr, maxWidthPtr, maxHeightPtr)
+ WmInfo *wmPtr; /* Window manager information for the
+ * window. */
+ int *maxWidthPtr; /* Where to store the current maximum
+ * width of the window. */
+ int *maxHeightPtr; /* Where to store the current maximum
+ * height of the window. */
+{
+ int tmp;
+
+ if (wmPtr->maxWidth > 0) {
+ *maxWidthPtr = wmPtr->maxWidth;
+ } else {
+ /*
+ * Must compute a default width. Fill up the display, leaving a
+ * bit of extra space for the window manager's borders.
+ */
+
+ tmp = DisplayWidth(wmPtr->winPtr->display, wmPtr->winPtr->screenNum)
+ - 15;
+ if (wmPtr->gridWin != NULL) {
+ /*
+ * Gridding is turned on; convert from pixels to grid units.
+ */
+
+ tmp = wmPtr->reqGridWidth
+ + (tmp - wmPtr->winPtr->reqWidth)/wmPtr->widthInc;
+ }
+ *maxWidthPtr = tmp;
+ }
+ if (wmPtr->maxHeight > 0) {
+ *maxHeightPtr = wmPtr->maxHeight;
+ } else {
+ tmp = DisplayHeight(wmPtr->winPtr->display, wmPtr->winPtr->screenNum)
+ - 30;
+ if (wmPtr->gridWin != NULL) {
+ tmp = wmPtr->reqGridHeight
+ + (tmp - wmPtr->winPtr->reqHeight)/wmPtr->heightInc;
+ }
+ *maxHeightPtr = tmp;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMakeMenuWindow --
+ *
+ * Configure the window to be either a pull-down (or pop-up)
+ * menu, or as a toplevel (torn-off) menu or palette.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the style bit used to create a new Mac toplevel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMakeMenuWindow(tkwin, transient)
+ Tk_Window tkwin; /* New window. */
+ int transient; /* 1 means menu is only posted briefly as
+ * a popup or pulldown or cascade. 0 means
+ * menu is always visible, e.g. as a torn-off
+ * menu. Determines whether save_under and
+ * override_redirect should be set. */
+{
+ WmInfo *wmPtr;
+ XSetWindowAttributes atts;
+ TkWindow *wrapperPtr;
+
+ if (!Tk_IsTopLevel(tkwin)) {
+ return;
+ }
+ wmPtr = ((TkWindow *) tkwin)->wmInfoPtr;
+ if (wmPtr->wrapperPtr == NULL) {
+ CreateWrapper(wmPtr);
+ }
+ wrapperPtr = wmPtr->wrapperPtr;
+ if (transient) {
+ atts.override_redirect = True;
+ atts.save_under = True;
+ } else {
+ atts.override_redirect = False;
+ atts.save_under = False;
+ }
+
+ /*
+ * The override-redirect and save-under bits must be set on the
+ * wrapper window in order to have the desired effect. However,
+ * also set the override-redirect bit on the window itself, so
+ * that the "wm overrideredirect" command will see it.
+ */
+
+ if ((atts.override_redirect != Tk_Attributes(wrapperPtr)->override_redirect)
+ || (atts.save_under != Tk_Attributes(wrapperPtr)->save_under)) {
+ Tk_ChangeWindowAttributes((Tk_Window) wrapperPtr,
+ CWOverrideRedirect|CWSaveUnder, &atts);
+ }
+ if (atts.override_redirect != Tk_Attributes(tkwin)->override_redirect) {
+ Tk_ChangeWindowAttributes(tkwin, CWOverrideRedirect, &atts);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateWrapper --
+ *
+ * This procedure is invoked to create the wrapper window for a
+ * toplevel window. It is called just before a toplevel is mapped
+ * for the first time.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The wrapper is created and the toplevel is reparented inside it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+CreateWrapper(wmPtr)
+ WmInfo *wmPtr; /* Window manager information for the
+ * window. */
+{
+ TkWindow *winPtr, *wrapperPtr;
+ Window parent;
+ Tcl_HashEntry *hPtr;
+ int new;
+
+ winPtr = wmPtr->winPtr;
+ if (winPtr->window == None) {
+ Tk_MakeWindowExist((Tk_Window) winPtr);
+ }
+
+ /*
+ * The code below is copied from CreateTopLevelWindow,
+ * Tk_MakeWindowExist, and TkpMakeWindow; The idea is to create an
+ * "official" Tk window (so that we can get events on it), but to
+ * hide the window outside the official Tk hierarchy so that it
+ * isn't visible to the application. See the comments for the other
+ * procedures if you have questions about this code.
+ */
+
+ wmPtr->wrapperPtr = wrapperPtr = TkAllocWindow(winPtr->dispPtr,
+ Tk_ScreenNumber((Tk_Window) winPtr), winPtr);
+ wrapperPtr->dirtyAtts |= CWBorderPixel;
+
+ /*
+ * Tk doesn't normally select for StructureNotifyMask events because
+ * the events are synthesized internally. However, for wrapper
+ * windows we need to know when the window manager modifies the
+ * window configuration. We also need to select on focus change
+ * events; these are the only windows for which we care about focus
+ * changes.
+ */
+
+ wrapperPtr->flags |= TK_WRAPPER;
+ wrapperPtr->atts.event_mask |= StructureNotifyMask|FocusChangeMask;
+ wrapperPtr->atts.override_redirect = winPtr->atts.override_redirect;
+ if (winPtr->flags & TK_EMBEDDED) {
+ parent = TkUnixContainerId(winPtr);
+ } else {
+ parent = XRootWindow(wrapperPtr->display, wrapperPtr->screenNum);
+ }
+ wrapperPtr->window = XCreateWindow(wrapperPtr->display,
+ parent, wrapperPtr->changes.x, wrapperPtr->changes.y,
+ (unsigned) wrapperPtr->changes.width,
+ (unsigned) wrapperPtr->changes.height,
+ (unsigned) wrapperPtr->changes.border_width, wrapperPtr->depth,
+ InputOutput, wrapperPtr->visual,
+ wrapperPtr->dirtyAtts|CWOverrideRedirect, &wrapperPtr->atts);
+ hPtr = Tcl_CreateHashEntry(&wrapperPtr->dispPtr->winTable,
+ (char *) wrapperPtr->window, &new);
+ Tcl_SetHashValue(hPtr, wrapperPtr);
+ wrapperPtr->mainPtr = winPtr->mainPtr;
+ wrapperPtr->mainPtr->refCount++;
+ wrapperPtr->dirtyAtts = 0;
+ wrapperPtr->dirtyChanges = 0;
+#ifdef TK_USE_INPUT_METHODS
+ wrapperPtr->inputContext = NULL;
+#endif /* TK_USE_INPUT_METHODS */
+ wrapperPtr->wmInfoPtr = wmPtr;
+
+ /*
+ * Reparent the toplevel window inside the wrapper.
+ */
+
+ XReparentWindow(wrapperPtr->display, winPtr->window, wrapperPtr->window,
+ 0, 0);
+
+ /*
+ * Tk must monitor structure events for wrapper windows in order
+ * to detect changes made by window managers such as resizing,
+ * mapping, unmapping, etc..
+ */
+
+ Tk_CreateEventHandler((Tk_Window) wmPtr->wrapperPtr, StructureNotifyMask,
+ WrapperEventProc, (ClientData) wmPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmFocusToplevel --
+ *
+ * This is a utility procedure invoked by focus-management code.
+ * The focus code responds to externally generated focus-related
+ * events on wrapper windows but ignores those events for any other
+ * windows. This procedure determines whether a given window is a
+ * wrapper window and, if so, returns the toplevel window
+ * corresponding to the wrapper.
+ *
+ * Results:
+ * If winPtr is a wrapper window, returns a pointer to the
+ * corresponding toplevel window; otherwise returns NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkWmFocusToplevel(winPtr)
+ TkWindow *winPtr; /* Window that received a focus-related
+ * event. */
+{
+ if (!(winPtr->flags & TK_WRAPPER)) {
+ return NULL;
+ }
+ return winPtr->wmInfoPtr->winPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUnixSetMenubar --
+ *
+ * This procedure is invoked by menu management code to specify the
+ * window to use as a menubar for a given toplevel window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window given by menubar will be mapped and positioned inside
+ * the wrapper for tkwin and above tkwin. Menubar will
+ * automatically be resized to maintain the height specified by
+ * TkUnixSetMenuHeight the same width as tkwin. Any previous
+ * menubar specified for tkwin will be unmapped and ignored from
+ * now on.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkUnixSetMenubar(tkwin, menubar)
+ Tk_Window tkwin; /* Token for toplevel window. */
+ Tk_Window menubar; /* Token for window that is to serve as
+ * menubar for tkwin. Must not be a
+ * toplevel window. If NULL, any
+ * existing menubar is canceled and the
+ * menu height is reset to 0. */
+{
+ WmInfo *wmPtr = ((TkWindow *) tkwin)->wmInfoPtr;
+ Tk_Window parent;
+ TkWindow *menubarPtr = (TkWindow *) menubar;
+
+ if (wmPtr->menubar != NULL) {
+ /*
+ * There's already a menubar for this toplevel. If it isn't the
+ * same as the new menubar, unmap it so that it is out of the
+ * way, and reparent it back to its original parent.
+ */
+
+ if (wmPtr->menubar == menubar) {
+ return;
+ }
+ ((TkWindow *) wmPtr->menubar)->wmInfoPtr = NULL;
+ ((TkWindow *) wmPtr->menubar)->flags &= ~TK_REPARENTED;
+ Tk_UnmapWindow(wmPtr->menubar);
+ parent = Tk_Parent(wmPtr->menubar);
+ if (parent != NULL) {
+ Tk_MakeWindowExist(parent);
+ XReparentWindow(Tk_Display(wmPtr->menubar),
+ Tk_WindowId(wmPtr->menubar), Tk_WindowId(parent), 0, 0);
+ }
+ Tk_DeleteEventHandler(wmPtr->menubar, StructureNotifyMask,
+ MenubarDestroyProc, (ClientData) wmPtr->menubar);
+ Tk_ManageGeometry(wmPtr->menubar, NULL, (ClientData) NULL);
+ }
+
+ wmPtr->menubar = menubar;
+ if (menubar == NULL) {
+ wmPtr->menuHeight = 0;
+ } else {
+ if ((menubarPtr->flags & TK_TOP_LEVEL)
+ || (Tk_Screen(menubar) != Tk_Screen(tkwin))) {
+ panic("TkUnixSetMenubar got bad menubar");
+ }
+ wmPtr->menuHeight = Tk_ReqHeight(menubar);
+ if (wmPtr->menuHeight == 0) {
+ wmPtr->menuHeight = 1;
+ }
+ Tk_MakeWindowExist(tkwin);
+ Tk_MakeWindowExist(menubar);
+ if (wmPtr->wrapperPtr == NULL) {
+ CreateWrapper(wmPtr);
+ }
+ XReparentWindow(Tk_Display(menubar), Tk_WindowId(menubar),
+ wmPtr->wrapperPtr->window, 0, 0);
+ menubarPtr->wmInfoPtr = wmPtr;
+ Tk_MoveResizeWindow(menubar, 0, 0, Tk_Width(tkwin), wmPtr->menuHeight);
+ Tk_MapWindow(menubar);
+ Tk_CreateEventHandler(menubar, StructureNotifyMask, MenubarDestroyProc,
+ (ClientData) menubar);
+ Tk_ManageGeometry(menubar, &menubarMgrType, (ClientData) wmPtr);
+ menubarPtr->flags |= TK_REPARENTED;
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) tkwin);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenubarDestroyProc --
+ *
+ * This procedure is invoked by the event dispatcher whenever a
+ * menubar window is destroyed (it's also invoked for a few other
+ * kinds of events, but we ignore those).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The association between the window and its toplevel is broken,
+ * so that the window is no longer considered to be a menubar.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MenubarDestroyProc(clientData, eventPtr)
+ ClientData clientData; /* TkWindow pointer for menubar. */
+ XEvent *eventPtr; /* Describes what just happened. */
+{
+ WmInfo *wmPtr;
+
+ if (eventPtr->type != DestroyNotify) {
+ return;
+ }
+ wmPtr = ((TkWindow *) clientData)->wmInfoPtr;
+ wmPtr->menubar = NULL;
+ wmPtr->menuHeight = 0;
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) wmPtr->winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenubarReqProc --
+ *
+ * This procedure is invoked by the Tk geometry management code
+ * whenever a menubar calls Tk_GeometryRequest to request a new
+ * size.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MenubarReqProc(clientData, tkwin)
+ ClientData clientData; /* Pointer to the window manager
+ * information for tkwin's toplevel. */
+ Tk_Window tkwin; /* Handle for menubar window. */
+{
+ WmInfo *wmPtr = (WmInfo *) clientData;
+
+ wmPtr->menuHeight = Tk_ReqHeight(tkwin);
+ if (wmPtr->menuHeight <= 0) {
+ wmPtr->menuHeight = 1;
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) wmPtr->winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetWrapperWindow --
+ *
+ * Given a toplevel window return the hidden wrapper window for
+ * the toplevel window if available.
+ *
+ * Results:
+ * The wrapper window. NULL is we were not passed a toplevel
+ * window or the wrapper has yet to be created.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkpGetWrapperWindow(winPtr)
+ TkWindow *winPtr; /* A toplevel window pointer. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if ((winPtr == NULL) || (wmPtr == NULL)) {
+ return NULL;
+ }
+
+ return wmPtr->wrapperPtr;
+}
diff --git a/tk/unix/tkUnixXId.c b/tk/unix/tkUnixXId.c
new file mode 100644
index 00000000000..dfe8b1935f8
--- /dev/null
+++ b/tk/unix/tkUnixXId.c
@@ -0,0 +1,537 @@
+/*
+ * tkUnixXId.c --
+ *
+ * This file provides a replacement function for the default X
+ * resource allocator (_XAllocID). The problem with the default
+ * allocator is that it never re-uses ids, which causes long-lived
+ * applications to crash when X resource identifiers wrap around.
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+/*
+ * 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.
+ */
+
+#define IDS_PER_STACK 10
+typedef struct TkIdStack {
+ XID ids[IDS_PER_STACK]; /* Array of free identifiers. */
+ int numUsed; /* Indicates how many of the entries
+ * in ids are currently in use. */
+ TkDisplay *dispPtr; /* Display to which ids belong. */
+ struct TkIdStack *nextPtr; /* Next bunch of free identifiers
+ * for the same display. */
+} TkIdStack;
+
+/*
+ * Forward declarations for procedures defined in this file:
+ */
+
+static XID AllocXId _ANSI_ARGS_((Display *display));
+static Tk_RestrictAction CheckRestrictProc _ANSI_ARGS_((
+ ClientData clientData, XEvent *eventPtr));
+static void WindowIdCleanup _ANSI_ARGS_((ClientData clientData));
+static void WindowIdCleanup2 _ANSI_ARGS_((ClientData clientData));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkInitXId --
+ *
+ * This procedure is called to initialize the id allocator for
+ * a given display.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The official allocator for the display is set up to be Tk_AllocXID.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkInitXId(dispPtr)
+ TkDisplay *dispPtr; /* Tk's information about the
+ * display. */
+{
+ dispPtr->idStackPtr = NULL;
+ dispPtr->defaultAllocProc = (XID (*) _ANSI_ARGS_((Display *display)))
+ dispPtr->display->resource_alloc;
+ dispPtr->display->resource_alloc = AllocXId;
+ dispPtr->windowStackPtr = NULL;
+ dispPtr->idCleanupScheduled = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AllocXId --
+ *
+ * This procedure is invoked by Xlib as the resource allocator
+ * for a display.
+ *
+ * Results:
+ * The return value is an X resource identifier that isn't currently
+ * in use.
+ *
+ * Side effects:
+ * The identifier is removed from the stack of free identifiers,
+ * if it was previously on the stack.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static XID
+AllocXId(display)
+ Display *display; /* Display for which to allocate. */
+{
+ TkDisplay *dispPtr;
+ TkIdStack *stackPtr;
+
+ /*
+ * Find Tk's information about the display.
+ */
+
+ dispPtr = TkGetDisplay(display);
+
+ /*
+ * If the topmost chunk on the stack is empty then free it. Then
+ * check for a free id on the stack and return it if it exists.
+ */
+
+ stackPtr = dispPtr->idStackPtr;
+ if (stackPtr != NULL) {
+ while (stackPtr->numUsed == 0) {
+ dispPtr->idStackPtr = stackPtr->nextPtr;
+ ckfree((char *) stackPtr);
+ stackPtr = dispPtr->idStackPtr;
+ if (stackPtr == NULL) {
+ goto defAlloc;
+ }
+ }
+ stackPtr->numUsed--;
+ return stackPtr->ids[stackPtr->numUsed];
+ }
+
+ /*
+ * No free ids in the stack: just get one from the default
+ * allocator.
+ */
+
+ defAlloc:
+ return (*dispPtr->defaultAllocProc)(display);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeXId --
+ *
+ * This procedure is called to indicate that an X resource identifier
+ * is now free.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The identifier is added to the stack of free identifiers for its
+ * display, so that it can be re-used.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeXId(display, xid)
+ Display *display; /* Display for which xid was
+ * allocated. */
+ XID xid; /* Identifier that is no longer
+ * in use. */
+{
+ TkDisplay *dispPtr;
+ TkIdStack *stackPtr;
+
+ /*
+ * Find Tk's information about the display.
+ */
+
+ dispPtr = TkGetDisplay(display);
+
+ /*
+ * Add a new chunk to the stack if the current chunk is full.
+ */
+
+ stackPtr = dispPtr->idStackPtr;
+ if ((stackPtr == NULL) || (stackPtr->numUsed >= IDS_PER_STACK)) {
+ stackPtr = (TkIdStack *) ckalloc(sizeof(TkIdStack));
+ stackPtr->numUsed = 0;
+ stackPtr->dispPtr = dispPtr;
+ stackPtr->nextPtr = dispPtr->idStackPtr;
+ dispPtr->idStackPtr = stackPtr;
+ }
+
+ /*
+ * Add the id to the current chunk.
+ */
+
+ stackPtr->ids[stackPtr->numUsed] = xid;
+ stackPtr->numUsed++;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkFreeWindowId --
+ *
+ * This procedure is invoked instead of TkFreeXId for window ids.
+ * See below for the reason why.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The id given by w will eventually be freed, so that it can be
+ * reused for other resources.
+ *
+ * Design:
+ * Freeing window ids is very tricky because there could still be
+ * events pending for a window in the event queue (or even in the
+ * server) at the time the window is destroyed. If the window
+ * id were to get reused immediately for another window, old
+ * events could "drop in" on the new window, causing unexpected
+ * behavior.
+ *
+ * Thus we have to wait to re-use a window id until we know that
+ * there are no events left for it. Right now this is done in
+ * two steps. First, we wait until we know that the server
+ * has seen the XDestroyWindow request, so we can be sure that
+ * it won't generate more events for the window and that any
+ * existing events are in our queue. Second, we make sure that
+ * there are no events whatsoever in our queue (this is conservative
+ * but safe).
+ *
+ * The first step is done by remembering the request id of the
+ * XDestroyWindow request and using LastKnownRequestProcessed to
+ * see what events the server has processed. If multiple windows
+ * get destroyed at about the same time, we just remember the
+ * most recent request number for any of them (again, conservative
+ * but safe).
+ *
+ * There are a few other complications as well. When Tk destroys a
+ * sub-tree of windows, it only issues a single XDestroyWindow call,
+ * at the very end for the root of the subtree. We can't free any of
+ * the window ids until the final XDestroyWindow call. To make sure
+ * that this happens, we have to keep track of deletions in progress,
+ * hence the need for the "destroyCount" field of the display.
+ *
+ * One final problem. Some servers, like Sun X11/News servers still
+ * seem to have problems with ids getting reused too quickly. I'm
+ * not completely sure why this is a problem, but delaying the
+ * recycling of ids appears to eliminate it. Therefore, we wait
+ * an additional few seconds, even after "the coast is clear"
+ * before reusing the ids.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkFreeWindowId(dispPtr, w)
+ TkDisplay *dispPtr; /* Display that w belongs to. */
+ Window w; /* X identifier for window on dispPtr. */
+{
+ TkIdStack *stackPtr;
+
+ /*
+ * Put the window id on a separate stack of window ids, rather
+ * than the main stack, so it won't get reused right away. Add
+ * a new chunk to the stack if the current chunk is full.
+ */
+
+ stackPtr = dispPtr->windowStackPtr;
+ if ((stackPtr == NULL) || (stackPtr->numUsed >= IDS_PER_STACK)) {
+ stackPtr = (TkIdStack *) ckalloc(sizeof(TkIdStack));
+ stackPtr->numUsed = 0;
+ stackPtr->dispPtr = dispPtr;
+ stackPtr->nextPtr = dispPtr->windowStackPtr;
+ dispPtr->windowStackPtr = stackPtr;
+ }
+
+ /*
+ * Add the id to the current chunk.
+ */
+
+ stackPtr->ids[stackPtr->numUsed] = w;
+ stackPtr->numUsed++;
+
+ /*
+ * Schedule a call to WindowIdCleanup if one isn't already
+ * scheduled.
+ */
+
+ if (!dispPtr->idCleanupScheduled) {
+ dispPtr->idCleanupScheduled = 1;
+ Tcl_CreateTimerHandler(100, WindowIdCleanup, (ClientData) dispPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WindowIdCleanup --
+ *
+ * See if we can now free up all the accumulated ids of
+ * deleted windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If it's safe to move the window ids back to the main free
+ * list, we schedule this to happen after a few mores seconds
+ * of delay. If it's not safe to move them yet, a timer handler
+ * gets invoked to try again later.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+WindowIdCleanup(clientData)
+ ClientData clientData; /* Pointer to TkDisplay for display */
+{
+ TkDisplay *dispPtr = (TkDisplay *) clientData;
+ int anyEvents, delta;
+ Tk_RestrictProc *oldProc;
+ ClientData oldData;
+ static Tcl_Time timeout = {0, 0};
+
+ dispPtr->idCleanupScheduled = 0;
+
+ /*
+ * See if it's safe to recycle the window ids. It's safe if:
+ * (a) no deletions are in progress.
+ * (b) the server has seen all of the requests up to the last
+ * XDestroyWindow request.
+ * (c) there are no events in the event queue; the only way to
+ * test for this right now is to create a restrict proc that
+ * will filter the events, then call Tcl_DoOneEvent to see if
+ * the procedure gets invoked.
+ */
+
+ if (dispPtr->destroyCount > 0) {
+ goto tryAgain;
+ }
+ delta = LastKnownRequestProcessed(dispPtr->display)
+ - dispPtr->lastDestroyRequest;
+ if (delta < 0) {
+ XSync(dispPtr->display, False);
+ }
+ anyEvents = 0;
+ oldProc = Tk_RestrictEvents(CheckRestrictProc, (ClientData) &anyEvents,
+ &oldData);
+ TkUnixDoOneXEvent(&timeout);
+ Tk_RestrictEvents(oldProc, oldData, &oldData);
+ if (anyEvents) {
+ goto tryAgain;
+ }
+
+ /*
+ * These ids look safe to recycle, but we still need to delay a bit
+ * more (see comments for TkFreeWindowId). Schedule the final freeing.
+ */
+
+ if (dispPtr->windowStackPtr != NULL) {
+ Tcl_CreateTimerHandler(5000, WindowIdCleanup2,
+ (ClientData) dispPtr->windowStackPtr);
+ dispPtr->windowStackPtr = NULL;
+ }
+ return;
+
+ /*
+ * It's still not safe to free up the ids. Try again a bit later.
+ */
+
+ tryAgain:
+ dispPtr->idCleanupScheduled = 1;
+ Tcl_CreateTimerHandler(500, WindowIdCleanup, (ClientData) dispPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WindowIdCleanup2 --
+ *
+ * This procedure is the last one in the chain that recycles
+ * window ids. It takes all of the ids indicated by its
+ * argument and adds them back to the main id free list.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Window ids get added to the main free list for their display.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+WindowIdCleanup2(clientData)
+ ClientData clientData; /* Pointer to TkIdStack list. */
+{
+ TkIdStack *stackPtr = (TkIdStack *) clientData;
+ TkIdStack *lastPtr;
+
+ lastPtr = stackPtr;
+ while (lastPtr->nextPtr != NULL) {
+ lastPtr = lastPtr->nextPtr;
+ }
+ lastPtr->nextPtr = stackPtr->dispPtr->idStackPtr;
+ stackPtr->dispPtr->idStackPtr = stackPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CheckRestrictProc --
+ *
+ * This procedure is a restrict procedure, called by Tcl_DoOneEvent
+ * to filter X events. All it does is to set a flag to indicate
+ * that there are X events present.
+ *
+ * Results:
+ * Sets the integer pointed to by the argument, then returns
+ * TK_DEFER_EVENT.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tk_RestrictAction
+CheckRestrictProc(clientData, eventPtr)
+ ClientData clientData; /* Pointer to flag to set. */
+ XEvent *eventPtr; /* Event to filter; not used. */
+{
+ int *flag = (int *) clientData;
+ *flag = 1;
+ return TK_DEFER_EVENT;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetPixmap --
+ *
+ * Same as the XCreatePixmap procedure except that it manages
+ * resource identifiers better.
+ *
+ * Results:
+ * Returns a new pixmap.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+Tk_GetPixmap(display, d, width, height, depth)
+ Display *display; /* Display for new pixmap. */
+ Drawable d; /* Drawable where pixmap will be used. */
+ int width, height; /* Dimensions of pixmap. */
+ int depth; /* Bits per pixel for pixmap. */
+{
+ return XCreatePixmap(display, d, (unsigned) width, (unsigned) height,
+ (unsigned) depth);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreePixmap --
+ *
+ * Same as the XFreePixmap procedure except that it also marks
+ * the resource identifier as free.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The pixmap is freed in the X server and its resource identifier
+ * is saved for re-use.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreePixmap(display, pixmap)
+ Display *display; /* Display for which pixmap was allocated. */
+ Pixmap pixmap; /* Identifier for pixmap. */
+{
+ XFreePixmap(display, pixmap);
+ Tk_FreeXId(display, (XID) pixmap);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpWindowWasRecentlyDeleted --
+ *
+ * Checks whether the window was recently deleted. This is called
+ * by the generic error handler to detect asynchronous notification
+ * of errors due to operations by Tk on a window that was already
+ * deleted by the server.
+ *
+ * Results:
+ * 1 if the window was deleted recently, 0 otherwise.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpWindowWasRecentlyDeleted(win, dispPtr)
+ Window win; /* The window to check for. */
+ TkDisplay *dispPtr; /* The window belongs to this display. */
+{
+ TkIdStack *stackPtr;
+ int i;
+
+ for (stackPtr = dispPtr->windowStackPtr;
+ stackPtr != NULL;
+ stackPtr = stackPtr->nextPtr) {
+ for (i = 0; i < stackPtr->numUsed; i++) {
+ if ((Window) stackPtr->ids[i] == win) {
+ return 1;
+ }
+ }
+ }
+ return 0;
+}
diff --git a/tk/win/Makefile.in b/tk/win/Makefile.in
new file mode 100644
index 00000000000..272627eeeb9
--- /dev/null
+++ b/tk/win/Makefile.in
@@ -0,0 +1,646 @@
+# 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.63 97/08/13 13:33:32
+
+# 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.
+
+# This file is CYGNUS LOCAL. It is a copy of makefile.vc from the
+# standard tk distribution, modified to work with cygwin and an
+# autoconf configure script. I have chosen to minimize the number of
+# changes, so the comments continue to refer to Visual C++ and the
+# like. This should make it easier to merge in a new version if that
+# is necessary.
+
+prefix = @prefix@
+exec_prefix = @exec_prefix@
+VPATH = @srcdir@:@srcdir@/../xlib:@srcdir@/../generic:@srcdir@/../unix:@srcdir@/../win/rc
+srcdir = @srcdir@
+
+INSTALL = @INSTALL@
+INSTALL_PROGRAM = @INSTALL_PROGRAM@
+INSTALL_DATA = @INSTALL_DATA@
+
+CC = @CC@
+CFLAGS = @CFLAGS@
+NM = @NM@
+AS = @AS@
+LD = @LD@
+DLLTOOL = @DLLTOOL@
+WINDRES = @WINDRES@
+
+OBJEXT=@OBJEXT@
+
+DLL_LDFLAGS = @DLL_LDFLAGS@
+DLL_LDLIBS = @DLL_LDLIBS@
+
+# Current Tk version; used in various names.
+
+DIRVERSION = @TK_VERSION@
+
+# The following definition can be set to non-null for special systems
+# like AFS with replication. It allows the pathnames used for installation
+# to be different than those used for actually reference files at
+# run-time. INSTALL_ROOT is prepended to $prefix and $exec_prefix
+# when installing files.
+INSTALL_ROOT =
+
+# Directory from which applications will reference the library of Tcl
+# scripts (note: you can set the TK_LIBRARY environment variable at
+# run-time to override the compiled-in location):
+TK_LIBRARY = @datadir@/tk$(DIRVERSION)
+
+# Path name to use when installing library scripts:
+SCRIPT_INSTALL_DIR = $(INSTALL_ROOT)$(TK_LIBRARY)
+
+# Directory in which to install the .a or .so binary for the Tk library:
+LIB_INSTALL_DIR = $(INSTALL_ROOT)@libdir@
+
+# Directory in which to install the program wish:
+BIN_INSTALL_DIR = $(INSTALL_ROOT)@bindir@
+
+# Directory in which to install the include file tk.h:
+INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)@includedir@
+
+# Directory in which to install the X11 header files. These files are
+# not machine independent, so they should not go in includedir.
+X11_INCLUDE_INSTALL_DIR = $(INSTALL_ROOT)@exec_prefix@/@host_alias@/include/X11
+
+DEMOPROGS = browse hello ixset rmt rolodex square tcolor timer widget
+
+#
+# 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 = $(srcdir)/..
+TMPDIR = .
+TOOLS32 = c:\msdev
+TCLDIR = $(srcdir)/../../tcl
+
+# 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 = cygtcl$(VERSION).dll
+TCLLIB = libtcl$(VERSION).a
+TCLPLUGINDLL = cygtcl$(VERSION)p.dll
+TCLPLUGINLIB = libtcl$(VERSION)p.a
+TKDLL = cygtk$(VERSION).dll
+TKLIB = libtk$(VERSION).a
+TKPLUGINDLL = cygtk$(VERSION)p.dll
+TKPLUGINLIB = libtk$(VERSION)p.a
+
+WISH = cygwish$(VERSION).exe
+WISHP = cygwishp$(VERSION).exe
+TKTEST = tktest.exe
+DUMPEXTS = $(TMPDIR)/dumpexts.exe
+
+WISHOBJS = \
+ $(TMPDIR)/tkConsole.$(OBJEXT) \
+ $(TMPDIR)/winMain.$(OBJEXT)
+
+TKTESTOBJS = \
+ $(TMPDIR)/tkConsole.$(OBJEXT) \
+ $(TMPDIR)/tkTest.$(OBJEXT) \
+ $(TMPDIR)/tkSquare.$(OBJEXT) \
+ $(TMPDIR)/testMain.$(OBJEXT)
+
+XLIBOBJS = \
+ $(TMPDIR)/xcolors.$(OBJEXT) \
+ $(TMPDIR)/xdraw.$(OBJEXT) \
+ $(TMPDIR)/xgc.$(OBJEXT) \
+ $(TMPDIR)/ximage.$(OBJEXT) \
+ $(TMPDIR)/xutil.$(OBJEXT)
+
+TKOBJS = \
+ $(TMPDIR)/tkUnixMenubu.$(OBJEXT) \
+ $(TMPDIR)/tkUnixScale.$(OBJEXT) \
+ $(XLIBOBJS) \
+ $(TMPDIR)/tkWin3d.$(OBJEXT) \
+ $(TMPDIR)/tkWin32Dll.$(OBJEXT) \
+ $(TMPDIR)/tkWinButton.$(OBJEXT) \
+ $(TMPDIR)/tkWinClipboard.$(OBJEXT) \
+ $(TMPDIR)/tkWinColor.$(OBJEXT) \
+ $(TMPDIR)/tkWinCursor.$(OBJEXT) \
+ $(TMPDIR)/tkWinDialog.$(OBJEXT) \
+ $(TMPDIR)/tkWinDraw.$(OBJEXT) \
+ $(TMPDIR)/tkWinEmbed.$(OBJEXT) \
+ $(TMPDIR)/tkWinFont.$(OBJEXT) \
+ $(TMPDIR)/tkWinImage.$(OBJEXT) \
+ $(TMPDIR)/tkWinInit.$(OBJEXT) \
+ $(TMPDIR)/tkWinKey.$(OBJEXT) \
+ $(TMPDIR)/tkWinMenu.$(OBJEXT) \
+ $(TMPDIR)/tkWinPixmap.$(OBJEXT) \
+ $(TMPDIR)/tkWinPointer.$(OBJEXT) \
+ $(TMPDIR)/tkWinRegion.$(OBJEXT) \
+ $(TMPDIR)/tkWinScrlbr.$(OBJEXT) \
+ $(TMPDIR)/tkWinSend.$(OBJEXT) \
+ $(TMPDIR)/tkWinWindow.$(OBJEXT) \
+ $(TMPDIR)/tkWinWm.$(OBJEXT) \
+ $(TMPDIR)/tkWinX.$(OBJEXT) \
+ $(TMPDIR)/stubs.$(OBJEXT) \
+ $(TMPDIR)/tk3d.$(OBJEXT) \
+ $(TMPDIR)/tkArgv.$(OBJEXT) \
+ $(TMPDIR)/tkAtom.$(OBJEXT) \
+ $(TMPDIR)/tkBind.$(OBJEXT) \
+ $(TMPDIR)/tkBitmap.$(OBJEXT) \
+ $(TMPDIR)/tkButton.$(OBJEXT) \
+ $(TMPDIR)/tkCanvArc.$(OBJEXT) \
+ $(TMPDIR)/tkCanvBmap.$(OBJEXT) \
+ $(TMPDIR)/tkCanvImg.$(OBJEXT) \
+ $(TMPDIR)/tkCanvLine.$(OBJEXT) \
+ $(TMPDIR)/tkCanvPoly.$(OBJEXT) \
+ $(TMPDIR)/tkCanvPs.$(OBJEXT) \
+ $(TMPDIR)/tkCanvText.$(OBJEXT) \
+ $(TMPDIR)/tkCanvUtil.$(OBJEXT) \
+ $(TMPDIR)/tkCanvWind.$(OBJEXT) \
+ $(TMPDIR)/tkCanvas.$(OBJEXT) \
+ $(TMPDIR)/tkClipboard.$(OBJEXT) \
+ $(TMPDIR)/tkCmds.$(OBJEXT) \
+ $(TMPDIR)/tkColor.$(OBJEXT) \
+ $(TMPDIR)/tkConfig.$(OBJEXT) \
+ $(TMPDIR)/tkCursor.$(OBJEXT) \
+ $(TMPDIR)/tkEntry.$(OBJEXT) \
+ $(TMPDIR)/tkError.$(OBJEXT) \
+ $(TMPDIR)/tkEvent.$(OBJEXT) \
+ $(TMPDIR)/tkFileFilter.$(OBJEXT) \
+ $(TMPDIR)/tkFocus.$(OBJEXT) \
+ $(TMPDIR)/tkFont.$(OBJEXT) \
+ $(TMPDIR)/tkFrame.$(OBJEXT) \
+ $(TMPDIR)/tkGC.$(OBJEXT) \
+ $(TMPDIR)/tkGeometry.$(OBJEXT) \
+ $(TMPDIR)/tkGet.$(OBJEXT) \
+ $(TMPDIR)/tkGrab.$(OBJEXT) \
+ $(TMPDIR)/tkGrid.$(OBJEXT) \
+ $(TMPDIR)/tkImage.$(OBJEXT) \
+ $(TMPDIR)/tkImgBmap.$(OBJEXT) \
+ $(TMPDIR)/tkImgGIF.$(OBJEXT) \
+ $(TMPDIR)/tkImgPPM.$(OBJEXT) \
+ $(TMPDIR)/tkImgPhoto.$(OBJEXT) \
+ $(TMPDIR)/tkImgUtil.$(OBJEXT) \
+ $(TMPDIR)/tkListbox.$(OBJEXT) \
+ $(TMPDIR)/tkMacWinMenu.$(OBJEXT) \
+ $(TMPDIR)/tkMain.$(OBJEXT) \
+ $(TMPDIR)/tkMenu.$(OBJEXT) \
+ $(TMPDIR)/tkMenubutton.$(OBJEXT) \
+ $(TMPDIR)/tkMenuDraw.$(OBJEXT) \
+ $(TMPDIR)/tkMessage.$(OBJEXT) \
+ $(TMPDIR)/tkOption.$(OBJEXT) \
+ $(TMPDIR)/tkPack.$(OBJEXT) \
+ $(TMPDIR)/tkPlace.$(OBJEXT) \
+ $(TMPDIR)/tkPointer.$(OBJEXT) \
+ $(TMPDIR)/tkRectOval.$(OBJEXT) \
+ $(TMPDIR)/tkScale.$(OBJEXT) \
+ $(TMPDIR)/tkScrollbar.$(OBJEXT) \
+ $(TMPDIR)/tkSelect.$(OBJEXT) \
+ $(TMPDIR)/tkText.$(OBJEXT) \
+ $(TMPDIR)/tkTextBTree.$(OBJEXT) \
+ $(TMPDIR)/tkTextDisp.$(OBJEXT) \
+ $(TMPDIR)/tkTextImage.$(OBJEXT) \
+ $(TMPDIR)/tkTextIndex.$(OBJEXT) \
+ $(TMPDIR)/tkTextMark.$(OBJEXT) \
+ $(TMPDIR)/tkTextTag.$(OBJEXT) \
+ $(TMPDIR)/tkTextWind.$(OBJEXT) \
+ $(TMPDIR)/tkTrig.$(OBJEXT) \
+ $(TMPDIR)/tkUtil.$(OBJEXT) \
+ $(TMPDIR)/tkVisual.$(OBJEXT) \
+ $(TMPDIR)/tkWindow.$(OBJEXT)
+
+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 = ../../tcl/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) \
+ $(TK_INCLUDES) $(TK_DEFINES) $(CFLAGS)
+
+######################################################################
+# 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
+
+ifeq ($(OBJEXT),obj)
+
+lcommon = /NODEFAULTLIB /RELEASE /NOLOGO
+lflags = $(lcommon) -align:0x1000 /MACHINE:$(MACHINE)
+conlflags = $(lflags) -subsystem:console -entry:mainCRTStartup
+guilflags = $(lflags) -subsystem:windows -entry:WinMainCRTStartup
+dlllflags = $(lflags) -entry:_DllMainCRTStartup@12 -dll
+
+else
+
+conlflags = $(lflags) -Wl,--subsystem,console -mwindows
+guilflags = $(lflags) -mwindows
+dlllflags = $(lflags)
+
+endif
+
+#!IF "$(MACHINE)" == "PPC"
+#libc = libc.lib
+#libcdll = crtdll.lib
+#!ELSE
+#libc = libc.lib oldnames.lib
+#libcdll = msvcrt.lib oldnames.lib
+#!ENDIF
+
+ifeq ($(OBJEXT),o)
+
+baselibs = -lkernel32 $(optlibs) -ladvapi32
+winlibs = $(baselibs) -luser32 -lgdi32 -lcomdlg32 -lwinspool
+
+else
+
+baselibs = kernel32.lib $(optlibs) advapi32.lib
+winlibs = $(baselibs) user32.lib gdi32.lib comdlg32.lib winspool.lib
+libcdll = msvcrt.lib oldnames.lib
+
+endif
+
+guilibs = $(libc) $(winlibs)
+
+guilibsdll = $(libcdll) $(winlibs)
+
+######################################################################
+# Compile flags
+######################################################################
+
+#!IFDEF NODEBUG
+#cdebug = -Ox
+#!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: $(TKDLL) $(TKLIB) $(WISH)
+test: $(TKTEST)
+plugin: $(TKPLUGINDLL) $(WISHP)
+
+install: install-binaries install-libraries install-demos
+
+install-binaries: $(TKDLL) $(TKLIB) $(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 $(TKLIB)"
+ @$(INSTALL_DATA) $(TKLIB) $(LIB_INSTALL_DIR)/$(TKLIB)
+ @chmod 555 $(LIB_INSTALL_DIR)/$(TKLIB)
+ @echo "Installing wish"
+ @$(INSTALL_PROGRAM) $(WISH) $(BIN_INSTALL_DIR)/$(WISH)
+ @echo "Installing tkConfig.sh"
+ @$(INSTALL_DATA) ../unix/tkConfig.sh $(LIB_INSTALL_DIR)/tkConfig.sh
+
+install-libraries:
+ @echo "Installing DLL"
+ @$(INSTALL_DATA) $(TKDLL) $(BIN_INSTALL_DIR)/$(TKDLL)
+ @for i in $(INSTALL_ROOT)@datadir@ $(INCLUDE_INSTALL_DIR) \
+ $(SCRIPT_INSTALL_DIR) $(INSTALL_ROOT)@exec_prefix@ \
+ $(INSTALL_ROOT)@exec_prefix@/@host_alias@ \
+ $(INSTALL_ROOT)@exec_prefix@/@host_alias@/include \
+ $(X11_INCLUDE_INSTALL_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @echo "Installing tk.h"
+ @$(INSTALL_DATA) $(GENERICDIR)/tk.h $(INCLUDE_INSTALL_DIR)/tk.h
+ for i in $(XLIBDIR)/X11/*.h; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(X11_INCLUDE_INSTALL_DIR); \
+ done;
+ for i in $(ROOT)/library/*.tcl $(ROOT)/library/tclIndex $(ROOT)/library/prolog.ps $(ROOT)/unix/tkAppInit.c; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
+ done;
+
+install-minimal:
+ @echo "Installing DLL"
+ @$(INSTALL_DATA) $(TKDLL) $(BIN_INSTALL_DIR)/$(TKDLL)
+ @for i in $(INSTALL_ROOT)@datadir@ $(SCRIPT_INSTALL_DIR) ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ for i in $(ROOT)/library/*.tcl $(ROOT)/library/tclIndex $(ROOT)/library/prolog.ps; \
+ do \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR); \
+ done;
+
+install-demos:
+ @for i in $(INSTALL_ROOT)@datadir@ $(SCRIPT_INSTALL_DIR) \
+ $(SCRIPT_INSTALL_DIR)/demos \
+ $(SCRIPT_INSTALL_DIR)/demos/images ; \
+ do \
+ if [ ! -d $$i ] ; then \
+ echo "Making directory $$i"; \
+ mkdir $$i; \
+ chmod 755 $$i; \
+ else true; \
+ fi; \
+ done;
+ @for i in $(ROOT)/library/demos/*; \
+ do \
+ if [ -f $$i ] ; then \
+ echo "Installing $$i"; \
+ sed -e '3 s|exec wish|exec $(WISH)|' \
+ $$i > $(SCRIPT_INSTALL_DIR)/demos/`basename $$i`; \
+ fi; \
+ done;
+ @for i in $(DEMOPROGS); \
+ do \
+ chmod 755 $(SCRIPT_INSTALL_DIR)/demos/$$i; \
+ done;
+ @for i in $(ROOT)/library/demos/images/*; \
+ do \
+ if [ -f $$i ] ; then \
+ echo "Installing $$i"; \
+ $(INSTALL_DATA) $$i $(SCRIPT_INSTALL_DIR)/demos/images; \
+ fi; \
+ done;
+
+ifeq ($(OBJEXT),o)
+
+$(TKDLL): $(TKOBJS) tkres.$(OBJEXT) tkcyg.def
+ $(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,tk.base -o $(TKDLL) $(TKOBJS) tkres.$(OBJEXT) $(TCLLIBDIR)/$(TCLLIB) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66300000
+ $(DLLTOOL) --as=$(AS) --dllname $(TKDLL) --def $(TMPDIR)/tkcyg.def --base-file tk.base --output-exp tk.exp
+ $(CC) -s $(DLL_LDFLAGS) -Wl,--base-file,tk.base tk.exp -o $(TKDLL) $(TKOBJS) tkres.$(OBJEXT) $(TCLLIBDIR)/$(TCLLIB) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66300000
+ $(DLLTOOL) --as=$(AS) --dllname $(TKDLL) --def $(TMPDIR)/tkcyg.def --base-file tk.base --output-exp tk.exp
+ $(CC) $(DLL_LDFLAGS) tk.exp -o $(TKDLL) $(TKOBJS) tkres.$(OBJEXT) $(TCLLIBDIR)/$(TCLLIB) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66300000
+
+else
+
+$(TKDLL): $(TKOBJS) tkres.$(OBJEXT) tkcyg.def
+ link $(ldebug) $(dlllflags) -def:tkcyg.def \
+ -out:$@ tkres.$(OBJEXT) $(TCLLIBDIR)/$(TCLLIB) \
+ $(guilibsdll) $(TKOBJS)
+ mv cygtk80.lib libtk80.a
+endif
+
+ifeq ($(OBJEXT),o)
+
+$(TKLIB): $(TMPDIR)/tkcyg.def
+ $(DLLTOOL) --as=$(AS) --dllname $(TKDLL) --def $(TMPDIR)/tkcyg.def --output-lib $(TKLIB)
+
+else
+
+$(TKLIB): $(TKDLL)
+
+endif
+
+$(TKPLUGINLIB): $(TMPDIR)/plugin.def
+ $(DLLTOOL) --as=$(AS) --dllname $(TKPLUGINDLL) --def $(TMPDIR)/plugin.def --output-lib $(TKPLUGINLIB)
+
+$(TKPLUGINDLL): $(TKOBJS) tkres.$(OBJEXT) $(TMPDIR)/plugin.def
+ $(CC) $(DLL_LDFLAGS) -Wl,--base-file,tkplugin.base -o $(TKPLUGINDLL) $(TKOBJS) tkres.$(OBJEXT) $(TCLLIBDIR)/$(TCLLIB) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66800000
+ $(DLLTOOL) --as=$(AS) --dllname $(TKPLUGINDLL) --def $(TMPDIR)/plugin.def --base-file tkplugin.base --output-exp tk.exp
+ $(CC) $(DLL_LDFLAGS) -Wl,--base-file,tkplugin.base tk.exp -o $(TKPLUGINDLL) $(TKOBJS) tkres.$(OBJEXT) $(TCLLIBDIR)/$(TCLLIB) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66800000
+ $(DLLTOOL) --as=$(AS) --dllname $(TKPLUGINDLL) --def $(TMPDIR)/plugin.def --base-file tkplugin.base --output-exp tk.exp
+ $(CC) $(DLL_LDFLAGS) tk.exp -o $(TKPLUGINDLL) $(TKOBJS) tkres.$(OBJEXT) $(TCLLIBDIR)/$(TCLLIB) $(DLL_LDLIBS) -mwindows -Wl,-e,_DllMain@12 -Wl,--image-base,0x66800000
+
+ifeq ($(OBJEXT),o)
+
+$(WISH): $(WISHOBJS) wishres.$(OBJEXT) $(TKLIB)
+ $(CC) $(ldebug) $(guilflags) $(WISHOBJS) wishres.$(OBJEXT) -o $@ \
+ $(TKLIB) $(TCLLIBDIR)/$(TCLLIB) $(guilibsdll)
+
+else
+
+$(WISH): $(WISHOBJS) wishres.$(OBJEXT) $(TKLIB)
+ link $(ldebug) $(guilflags) $(WISHOBJS) wishres.$(OBJEXT) -OUT:$@ \
+ $(TKLIB) $(TCLLIBDIR)/$(TCLLIB) $(guilibsdll)
+endif
+
+$(WISHP): $(WISHOBJS) $(TKPLUGINLIB) wishres.$(OBJEXT)
+ $(CC) $(ldebug) $(guilflags) $(WISHOBJS) wishres.$(OBJEXT) -o $@ \
+ $(TKPLUGINLIB) $(TCLLIBDIR)/$(TCLPLUGINLIB) $(guilibsdll)
+
+$(TKTEST): $(TKTESTOBJS) wishres.$(OBJEXT) $(TKLIB)
+ $(CC) $(ldebug) $(guilflags) $(TKTESTOBJS) wishres.$(OBJEXT) -o $@ \
+ $(TKLIB) $(TCLLIBDIR)/$(TCLLIB) $(guilibsdll)
+
+ifeq ($(OBJEXT),o)
+tkcyg.def: $(TKOBJS)
+ echo 'EXPORTS' > tmp.def
+ for o in $(TKOBJS); do \
+ $(NM) --extern-only --defined-only $$o | sed -e 's/[^ ]* [^ ]* //' -e 's/^_//' | fgrep -v DllEntryPoint | fgrep -v DllMain | fgrep -v impure_ptr >> tmp.def; \
+ done
+ mv tmp.def $(TMPDIR)/tkcyg.def
+
+plugin.def: $(TKOBJS)
+ echo 'EXPORTS' > tmp.def
+ for o in $(TKOBJS); do \
+ $(NM) --extern-only --defined-only $$o | sed -e 's/[^ ]* [^ ]* //' -e 's/^_//' | fgrep -v DllEntryPoint | fgrep -v DllMain | fgrep -v impure_ptr >> tmp.def; \
+ done
+ mv tmp.def $(TMPDIR)/plugin.def
+
+else
+
+# Source-Navigator need the extra Symbols.
+
+tkcyg.def: $(TKOBJS) $(DUMPEXTS)
+ $(DUMPEXTS) -o tkcyg.def $(TKDLL) $(TKOBJS)
+ echo " tkWindowType" >> tkcyg.def
+ echo " tkArcType" >> tkcyg.def
+ echo " tkBitmapType" >> tkcyg.def
+ echo " tkOvalType" >> tkcyg.def
+ echo " tkImageType" >> tkcyg.def
+ echo " tkPolygonType" >> tkcyg.def
+ echo " tkLineType" >> tkcyg.def
+ echo " tkTextType" >> tkcyg.def
+ echo " tkRectangleType" >> tkcyg.def
+ echo " tkTextCharType" >> tkcyg.def
+
+plugin.def: $(TKOBJS) $(DUMPEXTS)
+ $(DUMPEXTS) -o tkcyg.def $(TKDLL) $(TKOBJS)
+
+
+$(DUMPEXTS): $(TCLDIR)/win/winDumpExts.c
+ $(CC) $(TCLDIR)/win/winDumpExts.c user32.lib -link -OUT:$(DUMPEXTS)
+
+endif
+
+#$(DUMPEXTS): $(TCLDIR)\win\winDumpExts.c
+# $(cc32) $(CON_CFLAGS) -Fo$(TMPDIR)\ $?
+# set LIB=$(TOOLS32)\lib
+# $(link32) $(ldebug) $(conlflags) $(guilibs) -out:$@ \
+# $(TMPDIR)\winDumpExts.$(OBJEXT)bj
+
+#
+# Special case object file targets
+#
+
+$(TMPDIR)/testMain.$(OBJEXT): $(ROOT)/win/winMain.c
+ $(CC) -c $(TK_CFLAGS) -DTK_TEST -o $@ $?
+
+#
+# Implicit rules
+#
+.SUFFIXES: .S .c .o .obj .s
+.c.$(OBJEXT):
+ $(CC) -c $(TK_CFLAGS) $<
+
+ifeq ($(OBJEXT),o)
+
+tkres.$(OBJEXT): $(ROOT)/win/rc/tk.rc
+ $(WINDRES) --include $(ROOT)/win/rc --include $(ROOT)/generic --define VS_VERSION_INFO=1 $(ROOT)/win/rc/tk.rc tkres.$(OBJEXT)
+
+wishres.$(OBJEXT): $(ROOT)/win/rc/wish.rc
+ $(WINDRES) --include $(ROOT)/win/rc --include $(ROOT)/generic --define VS_VERSION_INFO=1 $(ROOT)/win/rc/wish.rc wishres.$(OBJEXT)
+
+else
+
+tkres.$(OBJEXT): $(ROOT)/win/rc/tk.rc
+ rc -i$(ROOT)/win/rc -i$(ROOT)/generic -dVS_VERSION_INFO=1 -fotkres.$(OBJEXT) $(ROOT)/win/rc/tk.rc
+
+wishres.$(OBJEXT): $(ROOT)/win/rc/wish.rc
+ rc -i$(ROOT)/win/rc -i$(ROOT)/generic -dVS_VERSION_INFO=1 -fowishres.$(OBJEXT) $(ROOT)/win/rc/wish.rc
+
+endif
+
+#{$(ROOT)\win\rc}.rc{$(TMPDIR)}.res:
+# $(rc32) -fo $@ -r -i $(ROOT)\generic $<
+
+clean:
+ rm -f *.exp *.a *.dll *.exe $(TMPDIR)/*.$(OBJEXT) *.res *.def
+ rm -f tk.base tkplugin.base
+
+# dependencies
+
+$(TMPDIR)/tk.res: \
+ $(RCDIR)/buttons.bmp \
+ $(RCDIR)/cursor*.cur \
+ $(RCDIR)/tk.ico
+
+$(GENERICDIR)/default.h: $(WINDIR)/tkWinDefault.h
+$(GENERICDIR)/tkButton.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkCanvas.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkEntry.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkFrame.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkListbox.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkMenu.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkMenubutton.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkMessage.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkScale.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkScrollbar.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkText.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkTextIndex.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkTextTag.c: $(GENERICDIR)/default.h
+
+$(GENERICDIR)/tkText.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextBTree.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextDisp.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextDisp.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextImage.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextIndex.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextMark.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextTag.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextWind.c: $(GENERICDIR)/tkText.h
+
+$(GENERICDIR)/tkMacWinMenu.c: $(GENERICDIR)/tkMenu.h
+$(GENERICDIR)/tkMenu.c: $(GENERICDIR)/tkMenu.h
+$(GENERICDIR)/tkMenuDraw.c: $(GENERICDIR)/tkMenu.h
+$(WINDIR)/tkWinMenu.c: $(GENERICDIR)/tkMenu.h
+
+Makefile: $(WINDIR)/Makefile.in config.status
+ $(SHELL) config.status
+
+config.status: $(WINDIR)/configure
+ ./config.status --recheck
diff --git a/tk/win/README b/tk/win/README
new file mode 100644
index 00000000000..f0206a6f2f5
--- /dev/null
+++ b/tk/win/README
@@ -0,0 +1,122 @@
+Tk 8.0.4 for Windows
+
+by Scott Stanton
+Scriptics Corporation
+scott.stanton@scriptics.com
+
+RCS: @(#) $Id$
+
+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.scriptics.com:/pub/tcl/tcl8_0 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 practice, 8.0.4 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.0 directory under the Tcl installation directory
+ as specified in the registry:
+
+ For Windows NT & 95:
+ HKEY_LOCAL_MACHINE\SOFTWARE\Scriptics\Tcl\8.0
+ Value Name is "Root"
+
+ For Win32s:
+ HKEY_CLASSES_ROOT\SOFTWARE\Scriptics\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
+problems with "exec". We will be working to develop a more general
+test suite for Tk under Windows, but for now, you will not be able to
+pass many of the tests.
+
+5. Known Bugs
+-------------
+
+Here is the current list of known bugs/missing features for the
+Windows beta version of Tk:
+
+- 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.
+- 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.
+- 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:
+
+<bugs@scriptics.com>
+
+or post them to the newsgroup comp.lang.tcl.
diff --git a/tk/win/configure b/tk/win/configure
new file mode 100755
index 00000000000..20cf223f653
--- /dev/null
+++ b/tk/win/configure
@@ -0,0 +1,1258 @@
+#! /bin/sh
+
+# Guess values for system-dependent variables and create Makefiles.
+# Generated automatically using autoconf version 2.12.2
+# Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
+#
+# This configure script is free software; the Free Software Foundation
+# gives unlimited permission to copy, distribute and modify it.
+
+# Defaults:
+ac_help=
+ac_default_prefix=/usr/local
+# Any additions from configure.in:
+ac_help="$ac_help
+ --with-tcl=DIR use Tcl 8.0 binaries from DIR"
+
+# Initialize some variables set by options.
+# The variables have the same names as the options, with
+# dashes changed to underlines.
+build=NONE
+cache_file=./config.cache
+exec_prefix=NONE
+host=NONE
+no_create=
+nonopt=NONE
+no_recursion=
+prefix=NONE
+program_prefix=NONE
+program_suffix=NONE
+program_transform_name=s,x,x,
+silent=
+site=
+srcdir=
+target=NONE
+verbose=
+x_includes=NONE
+x_libraries=NONE
+bindir='${exec_prefix}/bin'
+sbindir='${exec_prefix}/sbin'
+libexecdir='${exec_prefix}/libexec'
+datadir='${prefix}/share'
+sysconfdir='${prefix}/etc'
+sharedstatedir='${prefix}/com'
+localstatedir='${prefix}/var'
+libdir='${exec_prefix}/lib'
+includedir='${prefix}/include'
+oldincludedir='/usr/include'
+infodir='${prefix}/info'
+mandir='${prefix}/man'
+
+# Initialize some other variables.
+subdirs=
+MFLAGS= MAKEFLAGS=
+SHELL=${CONFIG_SHELL-/bin/sh}
+# Maximum number of lines to put in a shell here document.
+ac_max_here_lines=12
+
+ac_prev=
+for ac_option
+do
+
+ # If the previous option needs an argument, assign it.
+ if test -n "$ac_prev"; then
+ eval "$ac_prev=\$ac_option"
+ ac_prev=
+ continue
+ fi
+
+ case "$ac_option" in
+ -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
+ *) ac_optarg= ;;
+ esac
+
+ # Accept the important Cygnus configure options, so we can diagnose typos.
+
+ case "$ac_option" in
+
+ -bindir | --bindir | --bindi | --bind | --bin | --bi)
+ ac_prev=bindir ;;
+ -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*)
+ bindir="$ac_optarg" ;;
+
+ -build | --build | --buil | --bui | --bu)
+ ac_prev=build ;;
+ -build=* | --build=* | --buil=* | --bui=* | --bu=*)
+ build="$ac_optarg" ;;
+
+ -cache-file | --cache-file | --cache-fil | --cache-fi \
+ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
+ ac_prev=cache_file ;;
+ -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
+ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
+ cache_file="$ac_optarg" ;;
+
+ -datadir | --datadir | --datadi | --datad | --data | --dat | --da)
+ ac_prev=datadir ;;
+ -datadir=* | --datadir=* | --datadi=* | --datad=* | --data=* | --dat=* \
+ | --da=*)
+ datadir="$ac_optarg" ;;
+
+ -disable-* | --disable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ eval "enable_${ac_feature}=no" ;;
+
+ -enable-* | --enable-*)
+ ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
+ fi
+ ac_feature=`echo $ac_feature| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "enable_${ac_feature}='$ac_optarg'" ;;
+
+ -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
+ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
+ | --exec | --exe | --ex)
+ ac_prev=exec_prefix ;;
+ -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
+ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
+ | --exec=* | --exe=* | --ex=*)
+ exec_prefix="$ac_optarg" ;;
+
+ -gas | --gas | --ga | --g)
+ # Obsolete; use --with-gas.
+ with_gas=yes ;;
+
+ -help | --help | --hel | --he)
+ # Omit some internal or obsolete options to make the list less imposing.
+ # This message is too long to be a string in the A/UX 3.1 sh.
+ cat << EOF
+Usage: configure [options] [host]
+Options: [defaults in brackets after descriptions]
+Configuration:
+ --cache-file=FILE cache test results in FILE
+ --help print this message
+ --no-create do not create output files
+ --quiet, --silent do not print \`checking...' messages
+ --version print the version of autoconf that created configure
+Directory and file names:
+ --prefix=PREFIX install architecture-independent files in PREFIX
+ [$ac_default_prefix]
+ --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX
+ [same as prefix]
+ --bindir=DIR user executables in DIR [EPREFIX/bin]
+ --sbindir=DIR system admin executables in DIR [EPREFIX/sbin]
+ --libexecdir=DIR program executables in DIR [EPREFIX/libexec]
+ --datadir=DIR read-only architecture-independent data in DIR
+ [PREFIX/share]
+ --sysconfdir=DIR read-only single-machine data in DIR [PREFIX/etc]
+ --sharedstatedir=DIR modifiable architecture-independent data in DIR
+ [PREFIX/com]
+ --localstatedir=DIR modifiable single-machine data in DIR [PREFIX/var]
+ --libdir=DIR object code libraries in DIR [EPREFIX/lib]
+ --includedir=DIR C header files in DIR [PREFIX/include]
+ --oldincludedir=DIR C header files for non-gcc in DIR [/usr/include]
+ --infodir=DIR info documentation in DIR [PREFIX/info]
+ --mandir=DIR man documentation in DIR [PREFIX/man]
+ --srcdir=DIR find the sources in DIR [configure dir or ..]
+ --program-prefix=PREFIX prepend PREFIX to installed program names
+ --program-suffix=SUFFIX append SUFFIX to installed program names
+ --program-transform-name=PROGRAM
+ run sed PROGRAM on installed program names
+EOF
+ cat << EOF
+Host type:
+ --build=BUILD configure for building on BUILD [BUILD=HOST]
+ --host=HOST configure for HOST [guessed]
+ --target=TARGET configure for TARGET [TARGET=HOST]
+Features and packages:
+ --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
+ --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
+ --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
+ --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
+ --x-includes=DIR X include files are in DIR
+ --x-libraries=DIR X library files are in DIR
+EOF
+ if test -n "$ac_help"; then
+ echo "--enable and --with options recognized:$ac_help"
+ fi
+ exit 0 ;;
+
+ -host | --host | --hos | --ho)
+ ac_prev=host ;;
+ -host=* | --host=* | --hos=* | --ho=*)
+ host="$ac_optarg" ;;
+
+ -includedir | --includedir | --includedi | --included | --include \
+ | --includ | --inclu | --incl | --inc)
+ ac_prev=includedir ;;
+ -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \
+ | --includ=* | --inclu=* | --incl=* | --inc=*)
+ includedir="$ac_optarg" ;;
+
+ -infodir | --infodir | --infodi | --infod | --info | --inf)
+ ac_prev=infodir ;;
+ -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*)
+ infodir="$ac_optarg" ;;
+
+ -libdir | --libdir | --libdi | --libd)
+ ac_prev=libdir ;;
+ -libdir=* | --libdir=* | --libdi=* | --libd=*)
+ libdir="$ac_optarg" ;;
+
+ -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \
+ | --libexe | --libex | --libe)
+ ac_prev=libexecdir ;;
+ -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \
+ | --libexe=* | --libex=* | --libe=*)
+ libexecdir="$ac_optarg" ;;
+
+ -localstatedir | --localstatedir | --localstatedi | --localstated \
+ | --localstate | --localstat | --localsta | --localst \
+ | --locals | --local | --loca | --loc | --lo)
+ ac_prev=localstatedir ;;
+ -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \
+ | --localstate=* | --localstat=* | --localsta=* | --localst=* \
+ | --locals=* | --local=* | --loca=* | --loc=* | --lo=*)
+ localstatedir="$ac_optarg" ;;
+
+ -mandir | --mandir | --mandi | --mand | --man | --ma | --m)
+ ac_prev=mandir ;;
+ -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*)
+ mandir="$ac_optarg" ;;
+
+ -nfp | --nfp | --nf)
+ # Obsolete; use --without-fp.
+ with_fp=no ;;
+
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c)
+ no_create=yes ;;
+
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
+ no_recursion=yes ;;
+
+ -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \
+ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \
+ | --oldin | --oldi | --old | --ol | --o)
+ ac_prev=oldincludedir ;;
+ -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \
+ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \
+ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*)
+ oldincludedir="$ac_optarg" ;;
+
+ -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
+ ac_prev=prefix ;;
+ -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
+ prefix="$ac_optarg" ;;
+
+ -program-prefix | --program-prefix | --program-prefi | --program-pref \
+ | --program-pre | --program-pr | --program-p)
+ ac_prev=program_prefix ;;
+ -program-prefix=* | --program-prefix=* | --program-prefi=* \
+ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
+ program_prefix="$ac_optarg" ;;
+
+ -program-suffix | --program-suffix | --program-suffi | --program-suff \
+ | --program-suf | --program-su | --program-s)
+ ac_prev=program_suffix ;;
+ -program-suffix=* | --program-suffix=* | --program-suffi=* \
+ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
+ program_suffix="$ac_optarg" ;;
+
+ -program-transform-name | --program-transform-name \
+ | --program-transform-nam | --program-transform-na \
+ | --program-transform-n | --program-transform- \
+ | --program-transform | --program-transfor \
+ | --program-transfo | --program-transf \
+ | --program-trans | --program-tran \
+ | --progr-tra | --program-tr | --program-t)
+ ac_prev=program_transform_name ;;
+ -program-transform-name=* | --program-transform-name=* \
+ | --program-transform-nam=* | --program-transform-na=* \
+ | --program-transform-n=* | --program-transform-=* \
+ | --program-transform=* | --program-transfor=* \
+ | --program-transfo=* | --program-transf=* \
+ | --program-trans=* | --program-tran=* \
+ | --progr-tra=* | --program-tr=* | --program-t=*)
+ program_transform_name="$ac_optarg" ;;
+
+ -q | -quiet | --quiet | --quie | --qui | --qu | --q \
+ | -silent | --silent | --silen | --sile | --sil)
+ silent=yes ;;
+
+ -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb)
+ ac_prev=sbindir ;;
+ -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \
+ | --sbi=* | --sb=*)
+ sbindir="$ac_optarg" ;;
+
+ -sharedstatedir | --sharedstatedir | --sharedstatedi \
+ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \
+ | --sharedst | --shareds | --shared | --share | --shar \
+ | --sha | --sh)
+ ac_prev=sharedstatedir ;;
+ -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \
+ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \
+ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \
+ | --sha=* | --sh=*)
+ sharedstatedir="$ac_optarg" ;;
+
+ -site | --site | --sit)
+ ac_prev=site ;;
+ -site=* | --site=* | --sit=*)
+ site="$ac_optarg" ;;
+
+ -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
+ ac_prev=srcdir ;;
+ -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
+ srcdir="$ac_optarg" ;;
+
+ -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \
+ | --syscon | --sysco | --sysc | --sys | --sy)
+ ac_prev=sysconfdir ;;
+ -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \
+ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*)
+ sysconfdir="$ac_optarg" ;;
+
+ -target | --target | --targe | --targ | --tar | --ta | --t)
+ ac_prev=target ;;
+ -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
+ target="$ac_optarg" ;;
+
+ -v | -verbose | --verbose | --verbos | --verbo | --verb)
+ verbose=yes ;;
+
+ -version | --version | --versio | --versi | --vers)
+ echo "configure generated by autoconf version 2.12.2"
+ exit 0 ;;
+
+ -with-* | --with-*)
+ ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ case "$ac_option" in
+ *=*) ;;
+ *) ac_optarg=yes ;;
+ esac
+ eval "with_${ac_package}='$ac_optarg'" ;;
+
+ -without-* | --without-*)
+ ac_package=`echo $ac_option|sed -e 's/-*without-//'`
+ # Reject names that are not valid shell variable names.
+ if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
+ { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
+ fi
+ ac_package=`echo $ac_package| sed 's/-/_/g'`
+ eval "with_${ac_package}=no" ;;
+
+ --x)
+ # Obsolete; use --with-x.
+ with_x=yes ;;
+
+ -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
+ | --x-incl | --x-inc | --x-in | --x-i)
+ ac_prev=x_includes ;;
+ -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
+ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
+ x_includes="$ac_optarg" ;;
+
+ -x-libraries | --x-libraries | --x-librarie | --x-librari \
+ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
+ ac_prev=x_libraries ;;
+ -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
+ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
+ x_libraries="$ac_optarg" ;;
+
+ -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
+ ;;
+
+ *)
+ if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
+ echo "configure: warning: $ac_option: invalid host type" 1>&2
+ fi
+ if test "x$nonopt" != xNONE; then
+ { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
+ fi
+ nonopt="$ac_option"
+ ;;
+
+ esac
+done
+
+if test -n "$ac_prev"; then
+ { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
+fi
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+# File descriptor usage:
+# 0 standard input
+# 1 file creation
+# 2 errors and warnings
+# 3 some systems may open it to /dev/tty
+# 4 used on the Kubota Titan
+# 6 checking for... messages and results
+# 5 compiler messages saved in config.log
+if test "$silent" = yes; then
+ exec 6>/dev/null
+else
+ exec 6>&1
+fi
+exec 5>./config.log
+
+echo "\
+This file contains any messages produced by compilers while
+running configure, to aid debugging if configure makes a mistake.
+" 1>&5
+
+# Strip out --no-create and --no-recursion so they do not pile up.
+# Also quote any args containing shell metacharacters.
+ac_configure_args=
+for ac_arg
+do
+ case "$ac_arg" in
+ -no-create | --no-create | --no-creat | --no-crea | --no-cre \
+ | --no-cr | --no-c) ;;
+ -no-recursion | --no-recursion | --no-recursio | --no-recursi \
+ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
+ *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
+ ac_configure_args="$ac_configure_args '$ac_arg'" ;;
+ *) ac_configure_args="$ac_configure_args $ac_arg" ;;
+ esac
+done
+
+# NLS nuisances.
+# Only set these to C if already set. These must not be set unconditionally
+# because not all systems understand e.g. LANG=C (notably SCO).
+# Fixing LC_MESSAGES prevents Solaris sh from translating var values in `set'!
+# Non-C LC_CTYPE values break the ctype check.
+if test "${LANG+set}" = set; then LANG=C; export LANG; fi
+if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
+if test "${LC_MESSAGES+set}" = set; then LC_MESSAGES=C; export LC_MESSAGES; fi
+if test "${LC_CTYPE+set}" = set; then LC_CTYPE=C; export LC_CTYPE; fi
+
+# confdefs.h avoids OS command line length limits that DEFS can exceed.
+rm -rf conftest* confdefs.h
+# AIX cpp loses on an empty file, so make sure it contains at least a newline.
+echo > confdefs.h
+
+# A filename unique to this package, relative to the directory that
+# configure is in, which we can look for to find out if srcdir is correct.
+ac_unique_file=../generic/tk.h
+
+# Find the source files, if location was not specified.
+if test -z "$srcdir"; then
+ ac_srcdir_defaulted=yes
+ # Try the directory containing this script, then its parent.
+ ac_prog=$0
+ ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
+ test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
+ srcdir=$ac_confdir
+ if test ! -r $srcdir/$ac_unique_file; then
+ srcdir=..
+ fi
+else
+ ac_srcdir_defaulted=no
+fi
+if test ! -r $srcdir/$ac_unique_file; then
+ if test "$ac_srcdir_defaulted" = yes; then
+ { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
+ else
+ { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
+ fi
+fi
+srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
+
+# Prefer explicitly selected file to automatically selected ones.
+if test -z "$CONFIG_SITE"; then
+ if test "x$prefix" != xNONE; then
+ CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
+ else
+ CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
+ fi
+fi
+for ac_site_file in $CONFIG_SITE; do
+ if test -r "$ac_site_file"; then
+ echo "loading site script $ac_site_file"
+ . "$ac_site_file"
+ fi
+done
+
+if test -r "$cache_file"; then
+ echo "loading cache $cache_file"
+ . $cache_file
+else
+ echo "creating cache $cache_file"
+ > $cache_file
+fi
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+ac_exeext=
+ac_objext=o
+if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
+ # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
+ if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
+ ac_n= ac_c='
+' ac_t=' '
+ else
+ ac_n=-n ac_c= ac_t=
+ fi
+else
+ ac_n= ac_c='\c' ac_t=
+fi
+
+
+
+if test "${prefix}" = "NONE"; then
+ prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+ exec_prefix=$prefix
+fi
+
+ac_aux_dir=
+for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
+ if test -f $ac_dir/install-sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install-sh -c"
+ break
+ elif test -f $ac_dir/install.sh; then
+ ac_aux_dir=$ac_dir
+ ac_install_sh="$ac_aux_dir/install.sh -c"
+ break
+ fi
+done
+if test -z "$ac_aux_dir"; then
+ { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
+fi
+ac_config_guess=$ac_aux_dir/config.guess
+ac_config_sub=$ac_aux_dir/config.sub
+ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
+
+
+# Make sure we can run config.sub.
+if ${CONFIG_SHELL-/bin/sh} $ac_config_sub sun4 >/dev/null 2>&1; then :
+else { echo "configure: error: can not run $ac_config_sub" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking host system type""... $ac_c" 1>&6
+echo "configure:561: checking host system type" >&5
+
+host_alias=$host
+case "$host_alias" in
+NONE)
+ case $nonopt in
+ NONE)
+ if host_alias=`${CONFIG_SHELL-/bin/sh} $ac_config_guess`; then :
+ else { echo "configure: error: can not guess host type; you must specify one" 1>&2; exit 1; }
+ fi ;;
+ *) host_alias=$nonopt ;;
+ esac ;;
+esac
+
+host=`${CONFIG_SHELL-/bin/sh} $ac_config_sub $host_alias`
+host_cpu=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\1/'`
+host_vendor=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\2/'`
+host_os=`echo $host | sed 's/^\([^-]*\)-\([^-]*\)-\(.*\)$/\3/'`
+echo "$ac_t""$host" 1>&6
+
+
+# Extract the first word of "gcc", so it can be a program name with args.
+set dummy gcc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:585: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="gcc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+if test -z "$CC"; then
+ # Extract the first word of "cc", so it can be a program name with args.
+set dummy cc; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:614: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ ac_prog_rejected=no
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ if test "$ac_dir/$ac_word" = "/usr/ucb/cc"; then
+ ac_prog_rejected=yes
+ continue
+ fi
+ ac_cv_prog_CC="cc"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+if test $ac_prog_rejected = yes; then
+ # We found a bogon in the path, so make sure we never use it.
+ set dummy $ac_cv_prog_CC
+ shift
+ if test $# -gt 0; then
+ # We chose a different compiler from the bogus one.
+ # However, it has the same basename, so the bogon will be chosen
+ # first if we set CC to just the basename; use the full file name.
+ shift
+ set dummy "$ac_dir/$ac_word" "$@"
+ shift
+ ac_cv_prog_CC="$@"
+ fi
+fi
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+
+ if test -z "$CC"; then
+ case "`uname -s`" in
+ *win32* | *WIN32*)
+ # Extract the first word of "cl", so it can be a program name with args.
+set dummy cl; ac_word=$2
+echo $ac_n "checking for $ac_word""... $ac_c" 1>&6
+echo "configure:664: checking for $ac_word" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_CC'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ if test -n "$CC"; then
+ ac_cv_prog_CC="$CC" # Let the user override the test.
+else
+ IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ test -z "$ac_dir" && ac_dir=.
+ if test -f $ac_dir/$ac_word; then
+ ac_cv_prog_CC="cl"
+ break
+ fi
+ done
+ IFS="$ac_save_ifs"
+fi
+fi
+CC="$ac_cv_prog_CC"
+if test -n "$CC"; then
+ echo "$ac_t""$CC" 1>&6
+else
+ echo "$ac_t""no" 1>&6
+fi
+ ;;
+ esac
+ fi
+ test -z "$CC" && { echo "configure: error: no acceptable cc found in \$PATH" 1>&2; exit 1; }
+fi
+
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works""... $ac_c" 1>&6
+echo "configure:695: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) works" >&5
+
+ac_ext=c
+# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
+ac_cpp='$CPP $CPPFLAGS'
+ac_compile='${CC-cc} -c $CFLAGS $CPPFLAGS conftest.$ac_ext 1>&5'
+ac_link='${CC-cc} -o conftest${ac_exeext} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS 1>&5'
+cross_compiling=$ac_cv_prog_cc_cross
+
+cat > conftest.$ac_ext <<EOF
+#line 705 "configure"
+#include "confdefs.h"
+main(){return(0);}
+EOF
+if { (eval echo configure:709: \"$ac_link\") 1>&5; (eval $ac_link) 2>&5; } && test -s conftest${ac_exeext}; then
+ ac_cv_prog_cc_works=yes
+ # If we can't run a trivial program, we are probably using a cross compiler.
+ if (./conftest; exit) 2>/dev/null; then
+ ac_cv_prog_cc_cross=no
+ else
+ ac_cv_prog_cc_cross=yes
+ fi
+else
+ echo "configure: failed program was:" >&5
+ cat conftest.$ac_ext >&5
+ ac_cv_prog_cc_works=no
+fi
+rm -fr conftest*
+
+echo "$ac_t""$ac_cv_prog_cc_works" 1>&6
+if test $ac_cv_prog_cc_works = no; then
+ { echo "configure: error: installation or configuration problem: C compiler cannot create executables." 1>&2; exit 1; }
+fi
+echo $ac_n "checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler""... $ac_c" 1>&6
+echo "configure:729: checking whether the C compiler ($CC $CFLAGS $LDFLAGS) is a cross-compiler" >&5
+echo "$ac_t""$ac_cv_prog_cc_cross" 1>&6
+cross_compiling=$ac_cv_prog_cc_cross
+
+echo $ac_n "checking whether we are using GNU C""... $ac_c" 1>&6
+echo "configure:734: checking whether we are using GNU C" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_gcc'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ cat > conftest.c <<EOF
+#ifdef __GNUC__
+ yes;
+#endif
+EOF
+if { ac_try='${CC-cc} -E conftest.c'; { (eval echo configure:743: \"$ac_try\") 1>&5; (eval $ac_try) 2>&5; }; } | egrep yes >/dev/null 2>&1; then
+ ac_cv_prog_gcc=yes
+else
+ ac_cv_prog_gcc=no
+fi
+fi
+
+echo "$ac_t""$ac_cv_prog_gcc" 1>&6
+
+if test $ac_cv_prog_gcc = yes; then
+ GCC=yes
+else
+ GCC=
+fi
+
+ac_test_CFLAGS="${CFLAGS+set}"
+ac_save_CFLAGS="$CFLAGS"
+CFLAGS=
+echo $ac_n "checking whether ${CC-cc} accepts -g""... $ac_c" 1>&6
+echo "configure:762: checking whether ${CC-cc} accepts -g" >&5
+if eval "test \"`echo '$''{'ac_cv_prog_cc_g'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ echo 'void f(){}' > conftest.c
+if test -z "`${CC-cc} -g -c conftest.c 2>&1`"; then
+ ac_cv_prog_cc_g=yes
+else
+ ac_cv_prog_cc_g=no
+fi
+rm -f conftest*
+
+fi
+
+echo "$ac_t""$ac_cv_prog_cc_g" 1>&6
+if test "$ac_test_CFLAGS" = set; then
+ CFLAGS="$ac_save_CFLAGS"
+elif test $ac_cv_prog_cc_g = yes; then
+ if test "$GCC" = yes; then
+ CFLAGS="-g -O2"
+ else
+ CFLAGS="-g"
+ fi
+else
+ if test "$GCC" = yes; then
+ CFLAGS="-O2"
+ else
+ CFLAGS=
+ fi
+fi
+
+echo $ac_n "checking for object suffix""... $ac_c" 1>&6
+echo "configure:794: checking for object suffix" >&5
+if eval "test \"`echo '$''{'ac_cv_objext'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ rm -f conftest*
+echo 'int i = 1;' > conftest.$ac_ext
+if { (eval echo configure:800: \"$ac_compile\") 1>&5; (eval $ac_compile) 2>&5; }; then
+ for ac_file in conftest.*; do
+ case $ac_file in
+ *.c) ;;
+ *) ac_cv_objext=`echo $ac_file | sed -e s/conftest.//` ;;
+ esac
+ done
+else
+ { echo "configure: error: installation or configuration problem; compiler does not work" 1>&2; exit 1; }
+fi
+rm -f conftest*
+fi
+
+echo "$ac_t""$ac_cv_objext" 1>&6
+OBJEXT=$ac_cv_objext
+ac_objext=$ac_cv_objext
+
+NM=${NM-nm}
+
+AS=${AS-as}
+
+LD=${LD-ld}
+
+DLLTOOL=${DLLTOOL-dlltool}
+
+WINDRES=${WINDRES-windres}
+
+# Find a good install program. We prefer a C program (faster),
+# so one script is as good as another. But avoid the broken or
+# incompatible versions:
+# SysV /etc/install, /usr/sbin/install
+# SunOS /usr/etc/install
+# IRIX /sbin/install
+# AIX /bin/install
+# AIX 4 /usr/bin/installbsd, which doesn't work without a -g flag
+# AFS /usr/afsws/bin/install, which mishandles nonexistent args
+# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
+# ./install, which can be erroneously created by make from ./install.sh.
+echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&6
+echo "configure:839: checking for a BSD compatible install" >&5
+if test -z "$INSTALL"; then
+if eval "test \"`echo '$''{'ac_cv_path_install'+set}'`\" = set"; then
+ echo $ac_n "(cached) $ac_c" 1>&6
+else
+ IFS="${IFS= }"; ac_save_IFS="$IFS"; IFS=":"
+ for ac_dir in $PATH; do
+ # Account for people who put trailing slashes in PATH elements.
+ case "$ac_dir/" in
+ /|./|.//|/etc/*|/usr/sbin/*|/usr/etc/*|/sbin/*|/usr/afsws/bin/*|/usr/ucb/*) ;;
+ *)
+ # OSF1 and SCO ODT 3.0 have their own names for install.
+ # Don't use installbsd from OSF since it installs stuff as root
+ # by default.
+ for ac_prog in ginstall scoinst install; do
+ if test -f $ac_dir/$ac_prog; then
+ if test $ac_prog = install &&
+ grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
+ # AIX install. It has an incompatible calling convention.
+ :
+ else
+ ac_cv_path_install="$ac_dir/$ac_prog -c"
+ break 2
+ fi
+ fi
+ done
+ ;;
+ esac
+ done
+ IFS="$ac_save_IFS"
+
+fi
+ if test "${ac_cv_path_install+set}" = set; then
+ INSTALL="$ac_cv_path_install"
+ else
+ # As a last resort, use the slow shell script. We don't cache a
+ # path for INSTALL within a source directory, because that will
+ # break other packages using the cache if that directory is
+ # removed, or if the path is relative.
+ INSTALL="$ac_install_sh"
+ fi
+fi
+echo "$ac_t""$INSTALL" 1>&6
+
+# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
+# It thinks the first close brace ends the variable substitution.
+test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
+
+test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
+
+
+# needed for the subtle differences between cygwin and mingw32
+case "${host}" in
+*-*-cygwin*)
+ DLL_LDLIBS=-lcygwin
+ DLL_LDFLAGS='-nostartfiles -Wl,--dll'
+ ;;
+*-*-mingw32*)
+ DLL_LDLIBS=
+ DLL_LDFLAGS='-mdll'
+ ;;
+esac
+
+
+
+
+
+# The following stuff is just for tkConfig.sh, not for Makefile.
+
+# Check whether --with-tcl or --without-tcl was given.
+if test "${with_tcl+set}" = set; then
+ withval="$with_tcl"
+ TCL_BIN_DIR=$withval
+else
+ TCL_BIN_DIR=`cd ../../tcl/unix; pwd`
+fi
+
+if test ! -d $TCL_BIN_DIR; then
+ { echo "configure: error: Tcl directory $TCL_BIN_DIR doesn't exist" 1>&2; exit 1; }
+fi
+if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
+ { echo "configure: error: There's no tclConfig.sh in $TCL_BIN_DIR; perhaps you didn't specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?" 1>&2; exit 1; }
+fi
+
+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
+TK_LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
+
+LIBOBJS=
+
+TK_VERSION=8.0
+TK_MAJOR_VERSION=8
+TK_MINOR_VERSION=0
+TK_PATCH_LEVEL=p2
+VERSION=${TK_VERSION}
+
+MATH_LIBS=-lm
+LIBOBJS=
+
+TK_SHLIB_CFLAGS=""
+eval "TK_LIB_FILE=libtk${TCL_UNSHARED_LIB_SUFFIX}"
+
+TK_UNSHARED_LIB_FILE="$TK_LIB_FILE"
+TK_SRC_DIR=`cd $srcdir/..; pwd`
+
+XINCLUDES="-I`cd $srcdir/../xlib; pwd`"
+XLIBSW=
+TK_BUILD_INCLUDES="-I`cd $srcdir/../generic; pwd` -I`cd $srcdir/../xlib; pwd`"
+TK_BUILD_LIB_SPEC="-L`pwd` -ltk`echo ${VERSION} | tr -d .`"
+TK_LIB_SPEC="-L${exec_prefix}/lib -ltk`echo ${VERSION} | tr -d .`"
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+trap '' 1 2 15
+cat > confcache <<\EOF
+# This file is a shell script that caches the results of configure
+# tests run on this system so they can be shared between configure
+# scripts and configure runs. It is not useful on other systems.
+# If it contains results you don't want to keep, you may remove or edit it.
+#
+# By default, configure uses ./config.cache as the cache file,
+# creating it if it does not exist already. You can give configure
+# the --cache-file=FILE option to use a different cache file; that is
+# what configure does when it calls configure scripts in
+# subdirectories, so they share the cache.
+# Giving --cache-file=/dev/null disables caching, for debugging configure.
+# config.status only pays attention to the cache file if you give it the
+# --recheck option to rerun configure.
+#
+EOF
+# The following way of writing the cache mishandles newlines in values,
+# but we know of no workaround that is simple, portable, and efficient.
+# So, don't put newlines in cache variables' values.
+# Ultrix sh set writes to stderr and can't be redirected directly,
+# and sets the high bit in the cache file unless we assign to the vars.
+(set) 2>&1 |
+ case `(ac_space=' '; set) 2>&1 | grep ac_space` in
+ *ac_space=\ *)
+ # `set' does not quote correctly, so add quotes (double-quote substitution
+ # turns \\\\ into \\, and sed turns \\ into \).
+ sed -n \
+ -e "s/'/'\\\\''/g" \
+ -e "s/^\\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\\)=\\(.*\\)/\\1=\${\\1='\\2'}/p"
+ ;;
+ *)
+ # `set' quotes correctly as required by POSIX, so do not add quotes.
+ sed -n -e 's/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/\1=${\1=\2}/p'
+ ;;
+ esac >> confcache
+if cmp -s $cache_file confcache; then
+ :
+else
+ if test -w $cache_file; then
+ echo "updating cache $cache_file"
+ cat confcache > $cache_file
+ else
+ echo "not updating unwritable cache $cache_file"
+ fi
+fi
+rm -f confcache
+
+trap 'rm -fr conftest* confdefs* core core.* *.core $ac_clean_files; exit 1' 1 2 15
+
+test "x$prefix" = xNONE && prefix=$ac_default_prefix
+# Let make expand exec_prefix.
+test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
+
+# Any assignment to VPATH causes Sun make to only execute
+# the first set of double-colon rules, so remove it if not needed.
+# If there is a colon in the path, we need to keep it.
+if test "x$srcdir" = x.; then
+ ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
+fi
+
+trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
+
+# Transform confdefs.h into DEFS.
+# Protect against shell expansion while executing Makefile rules.
+# Protect against Makefile macro expansion.
+cat > conftest.defs <<\EOF
+s%#define \([A-Za-z_][A-Za-z0-9_]*\) *\(.*\)%-D\1=\2%g
+s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
+s%\[%\\&%g
+s%\]%\\&%g
+s%\$%$$%g
+EOF
+DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
+rm -f conftest.defs
+
+
+# Without the "./", some shells look in PATH for config.status.
+: ${CONFIG_STATUS=./config.status}
+
+echo creating $CONFIG_STATUS
+rm -f $CONFIG_STATUS
+cat > $CONFIG_STATUS <<EOF
+#! /bin/sh
+# Generated automatically by configure.
+# Run this file to recreate the current configuration.
+# This directory was configured as follows,
+# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
+#
+# $0 $ac_configure_args
+#
+# Compiler output produced by configure, useful for debugging
+# configure, is in ./config.log if it exists.
+
+ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
+for ac_option
+do
+ case "\$ac_option" in
+ -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
+ echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
+ exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
+ -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
+ echo "$CONFIG_STATUS generated by autoconf version 2.12.2"
+ exit 0 ;;
+ -help | --help | --hel | --he | --h)
+ echo "\$ac_cs_usage"; exit 0 ;;
+ *) echo "\$ac_cs_usage"; exit 1 ;;
+ esac
+done
+
+ac_given_srcdir=$srcdir
+ac_given_INSTALL="$INSTALL"
+
+trap 'rm -fr `echo "Makefile ../unix/tkConfig.sh" | sed "s/:[^ ]*//g"` conftest*; exit 1' 1 2 15
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+# Protect against being on the right side of a sed subst in config.status.
+sed 's/%@/@@/; s/@%/@@/; s/%g\$/@g/; /@g\$/s/[\\\\&%]/\\\\&/g;
+ s/@@/%@/; s/@@/@%/; s/@g\$/%g/' > conftest.subs <<\\CEOF
+$ac_vpsub
+$extrasub
+s%@SHELL@%$SHELL%g
+s%@CFLAGS@%$CFLAGS%g
+s%@CPPFLAGS@%$CPPFLAGS%g
+s%@CXXFLAGS@%$CXXFLAGS%g
+s%@DEFS@%$DEFS%g
+s%@LDFLAGS@%$LDFLAGS%g
+s%@LIBS@%$LIBS%g
+s%@exec_prefix@%$exec_prefix%g
+s%@prefix@%$prefix%g
+s%@program_transform_name@%$program_transform_name%g
+s%@bindir@%$bindir%g
+s%@sbindir@%$sbindir%g
+s%@libexecdir@%$libexecdir%g
+s%@datadir@%$datadir%g
+s%@sysconfdir@%$sysconfdir%g
+s%@sharedstatedir@%$sharedstatedir%g
+s%@localstatedir@%$localstatedir%g
+s%@libdir@%$libdir%g
+s%@includedir@%$includedir%g
+s%@oldincludedir@%$oldincludedir%g
+s%@infodir@%$infodir%g
+s%@mandir@%$mandir%g
+s%@host@%$host%g
+s%@host_alias@%$host_alias%g
+s%@host_cpu@%$host_cpu%g
+s%@host_vendor@%$host_vendor%g
+s%@host_os@%$host_os%g
+s%@CC@%$CC%g
+s%@OBJEXT@%$OBJEXT%g
+s%@NM@%$NM%g
+s%@AS@%$AS%g
+s%@LD@%$LD%g
+s%@DLLTOOL@%$DLLTOOL%g
+s%@WINDRES@%$WINDRES%g
+s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
+s%@INSTALL_DATA@%$INSTALL_DATA%g
+s%@TCL_ALLOC_OBJ@%$TCL_ALLOC_OBJ%g
+s%@DLL_LDFLAGS@%$DLL_LDFLAGS%g
+s%@DLL_LDLIBS@%$DLL_LDLIBS%g
+s%@LIBOBJS@%$LIBOBJS%g
+s%@DL_LIBS@%$DL_LIBS%g
+s%@LD_FLAGS@%$LD_FLAGS%g
+s%@MATH_LIBS@%$MATH_LIBS%g
+s%@TK_BUILD_INCLUDES@%$TK_BUILD_INCLUDES%g
+s%@TK_BUILD_LIB_SPEC@%$TK_BUILD_LIB_SPEC%g
+s%@TK_LIB_FILE@%$TK_LIB_FILE%g
+s%@TK_LIB_SPEC@%$TK_LIB_SPEC%g
+s%@TK_MAJOR_VERSION@%$TK_MAJOR_VERSION%g
+s%@TK_MINOR_VERSION@%$TK_MINOR_VERSION%g
+s%@TK_PATCH_LEVEL@%$TK_PATCH_LEVEL%g
+s%@TK_SRC_DIR@%$TK_SRC_DIR%g
+s%@TK_VERSION@%$TK_VERSION%g
+s%@XINCLUDES@%$XINCLUDES%g
+s%@XLIBSW@%$XLIBSW%g
+
+CEOF
+EOF
+
+cat >> $CONFIG_STATUS <<\EOF
+
+# Split the substitutions into bite-sized pieces for seds with
+# small command number limits, like on Digital OSF/1 and HP-UX.
+ac_max_sed_cmds=90 # Maximum number of lines to put in a sed script.
+ac_file=1 # Number of current file.
+ac_beg=1 # First line for current file.
+ac_end=$ac_max_sed_cmds # Line after last line for current file.
+ac_more_lines=:
+ac_sed_cmds=""
+while $ac_more_lines; do
+ if test $ac_beg -gt 1; then
+ sed "1,${ac_beg}d; ${ac_end}q" conftest.subs > conftest.s$ac_file
+ else
+ sed "${ac_end}q" conftest.subs > conftest.s$ac_file
+ fi
+ if test ! -s conftest.s$ac_file; then
+ ac_more_lines=false
+ rm -f conftest.s$ac_file
+ else
+ if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds="sed -f conftest.s$ac_file"
+ else
+ ac_sed_cmds="$ac_sed_cmds | sed -f conftest.s$ac_file"
+ fi
+ ac_file=`expr $ac_file + 1`
+ ac_beg=$ac_end
+ ac_end=`expr $ac_end + $ac_max_sed_cmds`
+ fi
+done
+if test -z "$ac_sed_cmds"; then
+ ac_sed_cmds=cat
+fi
+EOF
+
+cat >> $CONFIG_STATUS <<EOF
+
+CONFIG_FILES=\${CONFIG_FILES-"Makefile ../unix/tkConfig.sh"}
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
+ # Support "outfile[:infile[:infile...]]", defaulting infile="outfile.in".
+ case "$ac_file" in
+ *:*) ac_file_in=`echo "$ac_file"|sed 's%[^:]*:%%'`
+ ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
+ *) ac_file_in="${ac_file}.in" ;;
+ esac
+
+ # Adjust a relative srcdir, top_srcdir, and INSTALL for subdirectories.
+
+ # Remove last slash and all that follows it. Not all systems have dirname.
+ ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
+ if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
+ # The file is in a subdirectory.
+ test ! -d "$ac_dir" && mkdir "$ac_dir"
+ ac_dir_suffix="/`echo $ac_dir|sed 's%^\./%%'`"
+ # A "../" for each directory in $ac_dir_suffix.
+ ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
+ else
+ ac_dir_suffix= ac_dots=
+ fi
+
+ case "$ac_given_srcdir" in
+ .) srcdir=.
+ if test -z "$ac_dots"; then top_srcdir=.
+ else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
+ /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
+ *) # Relative path.
+ srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
+ top_srcdir="$ac_dots$ac_given_srcdir" ;;
+ esac
+
+ case "$ac_given_INSTALL" in
+ [/$]*) INSTALL="$ac_given_INSTALL" ;;
+ *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
+ esac
+
+ echo creating "$ac_file"
+ rm -f "$ac_file"
+ configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
+ case "$ac_file" in
+ *Makefile*) ac_comsub="1i\\
+# $configure_input" ;;
+ *) ac_comsub= ;;
+ esac
+
+ ac_file_inputs=`echo $ac_file_in|sed -e "s%^%$ac_given_srcdir/%" -e "s%:% $ac_given_srcdir/%g"`
+ sed -e "$ac_comsub
+s%@configure_input@%$configure_input%g
+s%@srcdir@%$srcdir%g
+s%@top_srcdir@%$top_srcdir%g
+s%@INSTALL@%$INSTALL%g
+" $ac_file_inputs | (eval "$ac_sed_cmds") > $ac_file
+fi; done
+rm -f conftest.s*
+
+EOF
+cat >> $CONFIG_STATUS <<EOF
+
+EOF
+cat >> $CONFIG_STATUS <<\EOF
+
+exit 0
+EOF
+chmod +x $CONFIG_STATUS
+rm -fr confdefs* $ac_clean_files
+test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS || exit 1
+
diff --git a/tk/win/configure.in b/tk/win/configure.in
new file mode 100755
index 00000000000..d9c6949ef9e
--- /dev/null
+++ b/tk/win/configure.in
@@ -0,0 +1,110 @@
+nl The file is CYGNUS LOCAL. It is used for cygwin.
+
+dnl This file is an input file used by the GNU "autoconf" program to
+dnl generate the file "configure", which is run during Tcl installation
+dnl to configure the system for the local environment.
+
+AC_PREREQ(2.5)
+
+AC_INIT(../generic/tk.h)
+
+if test "${prefix}" = "NONE"; then
+ prefix=/usr/local
+fi
+if test "${exec_prefix}" = "NONE"; then
+ exec_prefix=$prefix
+fi
+
+AC_CANONICAL_HOST
+
+AC_PROG_CC
+AC_OBJEXT
+NM=${NM-nm}
+AC_SUBST(NM)
+AS=${AS-as}
+AC_SUBST(AS)
+LD=${LD-ld}
+AC_SUBST(LD)
+DLLTOOL=${DLLTOOL-dlltool}
+AC_SUBST(DLLTOOL)
+WINDRES=${WINDRES-windres}
+AC_SUBST(WINDRES)
+AC_PROG_INSTALL
+
+# needed for the subtle differences between cygwin and mingw32
+case "${host}" in
+*-*-cygwin*)
+ DLL_LDLIBS=-lcygwin
+ DLL_LDFLAGS='-nostartfiles -Wl,--dll'
+ ;;
+*-*-mingw32*)
+ DLL_LDLIBS=
+ DLL_LDFLAGS='-mdll'
+ ;;
+esac
+
+AC_SUBST(TCL_ALLOC_OBJ)
+AC_SUBST(DLL_LDFLAGS)
+AC_SUBST(DLL_LDLIBS)
+
+# The following stuff is just for tkConfig.sh, not for Makefile.
+
+AC_ARG_WITH(tcl, [ --with-tcl=DIR use Tcl 8.0 binaries from DIR],
+ TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd ../../tcl/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/tclConfig.sh; then
+ AC_MSG_ERROR(There's no tclConfig.sh 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
+
+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
+TK_LD_SEARCH_FLAGS=$TCL_LD_SEARCH_FLAGS
+
+LIBOBJS=
+AC_SUBST(LIBOBJS)
+TK_VERSION=8.0
+TK_MAJOR_VERSION=8
+TK_MINOR_VERSION=0
+TK_PATCH_LEVEL=p2
+VERSION=${TK_VERSION}
+
+MATH_LIBS=-lm
+LIBOBJS=
+
+TK_SHLIB_CFLAGS=""
+eval "TK_LIB_FILE=libtk${TCL_UNSHARED_LIB_SUFFIX}"
+
+TK_UNSHARED_LIB_FILE="$TK_LIB_FILE"
+TK_SRC_DIR=`cd $srcdir/..; pwd`
+
+XINCLUDES="-I`cd $srcdir/../xlib; pwd`"
+XLIBSW=
+TK_BUILD_INCLUDES="-I`cd $srcdir/../generic; pwd` -I`cd $srcdir/../xlib; pwd`"
+TK_BUILD_LIB_SPEC="-L`pwd` -ltk`echo ${VERSION} | tr -d .`"
+TK_LIB_SPEC="-L${exec_prefix}/lib -ltk`echo ${VERSION} | tr -d .`"
+
+AC_SUBST(DL_LIBS)
+AC_SUBST(LD_FLAGS)
+AC_SUBST(MATH_LIBS)
+AC_SUBST(TK_BUILD_INCLUDES)
+AC_SUBST(TK_BUILD_LIB_SPEC)
+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_SRC_DIR)
+AC_SUBST(TK_VERSION)
+AC_SUBST(XINCLUDES)
+AC_SUBST(XLIBSW)
+
+AC_OUTPUT(Makefile ../unix/tkConfig.sh)
diff --git a/tk/win/license.terms b/tk/win/license.terms
new file mode 100644
index 00000000000..03ca6fcb319
--- /dev/null
+++ b/tk/win/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., and other parties. The following
+terms apply to all files associated with the software unless explicitly
+disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
diff --git a/tk/win/makefile.bc b/tk/win/makefile.bc
new file mode 100644
index 00000000000..050d0127c2c
--- /dev/null
+++ b/tk/win/makefile.bc
@@ -0,0 +1,340 @@
+# 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
+
+#
+# Borland C++ tools
+#
+
+BORLAND = $(TOOLS)
+IMPLIB = $(BORLAND)\bin\Implib
+BCC32 = $(BORLAND)\bin\Bcc32
+TLINK32 = $(BORLAND)\bin\tlink32
+RC = $(BORLAND)\bin\brcc32
+CP = copy
+RM = del
+
+INCLUDES = $(BORLAND)\include;$(ROOT)\generic;$(ROOT)\bitmaps;$(ROOT)\xlib;$(ROOT)\win;$(TCLDIR)\generic
+LIBDIRS = $(BORLAND)\lib;$(ROOT)\win
+TCLLIBDIR = $(TCLDIR)\win
+
+
+!ifndef DEBUG
+
+# these macros cause maximum optimization and no symbols
+DEBUGLDFLAGS =
+DEBUGCCFLAGS = -v- -vi- -O2
+
+!else
+
+# these macros enable debugging
+DEBUGLDFLAGS = -v
+DEBUGCCFLAGS = -k -Od -v
+
+!endif
+
+DEFINES = MT;_RTLDLL;STRICT;$(DEBUGDEFINES)
+PROJECTCCFLAGS= $(DEBUGCCFLAGS) -w-par -w-stu
+
+LNFLAGS_exe = -Tpe -aa -c $(DEBUGLDFLAGS) $(BORLAND)\lib\c0w32
+LNFLAGS_dll = -Tpd -aa -c $(DEBUGLDFLAGS) $(BORLAND)\lib\c0d32
+
+LNLIBS_exe = $(TKLIB) $(TCLLIBDIR)\$(TCLLIB) import32 cw32mti
+LNLIBS_dll = $(TCLLIBDIR)\$(TCLLIB) import32 cw32mti
+
+#
+# Global makefile settings
+#
+
+.AUTODEPEND
+.CACHEAUTODEPEND
+
+.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)\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 \
+ $(TMPDIR)\tkBind.obj \
+ $(TMPDIR)\tkBitmap.obj \
+ $(TMPDIR)\tkButton.obj \
+ $(TMPDIR)\tkCanvArc.obj \
+ $(TMPDIR)\tkCanvBmap.obj \
+ $(TMPDIR)\tkCanvImg.obj \
+ $(TMPDIR)\tkCanvLine.obj \
+ $(TMPDIR)\tkCanvPoly.obj \
+ $(TMPDIR)\tkCanvPs.obj \
+ $(TMPDIR)\tkCanvText.obj \
+ $(TMPDIR)\tkCanvUtil.obj \
+ $(TMPDIR)\tkCanvWind.obj \
+ $(TMPDIR)\tkCanvas.obj \
+ $(TMPDIR)\tkClipboard.obj \
+ $(TMPDIR)\tkCmds.obj \
+ $(TMPDIR)\tkColor.obj \
+ $(TMPDIR)\tkConfig.obj \
+ $(TMPDIR)\tkCursor.obj \
+ $(TMPDIR)\tkEntry.obj \
+ $(TMPDIR)\tkError.obj \
+ $(TMPDIR)\tkEvent.obj \
+ $(TMPDIR)\tkFileFilter.obj \
+ $(TMPDIR)\tkFocus.obj \
+ $(TMPDIR)\tkFont.obj \
+ $(TMPDIR)\tkFrame.obj \
+ $(TMPDIR)\tkGC.obj \
+ $(TMPDIR)\tkGeometry.obj \
+ $(TMPDIR)\tkGet.obj \
+ $(TMPDIR)\tkGrab.obj \
+ $(TMPDIR)\tkGrid.obj \
+ $(TMPDIR)\tkImage.obj \
+ $(TMPDIR)\tkImgBmap.obj \
+ $(TMPDIR)\tkImgGIF.obj \
+ $(TMPDIR)\tkImgPPM.obj \
+ $(TMPDIR)\tkImgPhoto.obj \
+ $(TMPDIR)\tkImgUtil.obj \
+ $(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
+
+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
+tktest: cfgdll $(TKDLL) cfgtest $(TKTEST) cfgcln
+
+test: tktest
+ $(TKTEST) &&|
+ cd ../tests
+ console show
+ update
+ source all
+|
+
+# Implicit Targets
+
+.c.obj:
+ @$(BCC32) {$< }
+
+.dll.lib:
+ $(IMPLIB) -c $@ $<
+
+.rc.res:
+ $(RC) -i$(INCLUDES) $<
+
+#
+# Special case object file targets
+#
+
+$(TMPDIR)\testMain.obj : $(ROOT)\win\winMain.c
+ $(BCC32) -c -o$@ $(ROOT)\win\winMain.c
+
+#
+# Configuration file targets - these files are implicitly used by the compiler
+#
+
+cfgdll:
+ @$(CP) &&|
+ -n$(TMPDIR) -I$(INCLUDES) -c -WM
+ -D$(DEFINES) -3 -d $(PROJECTCCFLAGS)
+| bcc32.cfg >NUL
+
+cfgexe:
+ @$(CP) &&|
+ -n$(TMPDIR) -I$(INCLUDES) -c -W
+ -D$(DEFINES) -3 -d $(PROJECTCCFLAGS)
+| bcc32.cfg >NUL
+
+cfgtest:
+ @$(CP) &&|
+ -n$(TMPDIR) -I$(INCLUDES) -c -W
+ -D$(DEFINES);TK_TEST -3 -d $(PROJECTCCFLAGS)
+| bcc32.cfg >NUL
+
+cfgcln:
+ @$(RM) bcc32.cfg
+
+#
+# Executable targets
+#
+
+$(TKDLL): $(TKOBJS) tk.def rc\tk.res
+ $(TLINK32) @&&|
+$(LNFLAGS_dll) $(TKOBJS)
+$@
+-x
+$(LNLIBS_dll)
+tk.def
+rc\tk.res
+|
+
+$(WISH): $(WISHOBJS) $(TKLIB) rc\wish.res
+ $(TLINK32) @&&|
+$(LNFLAGS_exe) $(WISHOBJS)
+$@
+-x
+$(LNLIBS_exe)
+|, &&|
+EXETYPE WINDOWS
+CODE PRELOAD MOVEABLE DISCARDABLE
+DATA PRELOAD MOVEABLE MULTIPLE
+|, rc\wish.res
+
+$(TKTEST): $(TKTESTOBJS) $(TKLIB)
+ $(TLINK32) $(LNFLAGS_exe) @&&|
+$(TKTESTOBJS)
+$@
+-x
+$(LNLIBS_exe)
+|, &&|
+EXETYPE WINDOWS
+CODE PRELOAD MOVEABLE DISCARDABLE
+DATA PRELOAD MOVEABLE MULTIPLE
+|,
+
+#
+# Other dependencies
+#
+
+rc\wish.res: rc\wish.ico
+rc\tk.res: rc\tk.ico rc\*.cur
+
+# The following rule automatically generates a tk.def file containing
+# an export entry for every public symbol in the $(TKDLL) library.
+
+tk.def: $(TKOBJS)
+ $(TCLLIBDIR)\dumpexts.exe -o $@ $(TKDLL) @&&|
+ $(TKOBJS)
+|
+
+# rule to build library object files
+
+# debugging rules, the .dll and .exe files must be in the same
+# directory as the object files for debugging purposes
+
+$(TMPDIR)\$(TKDLL): $(TKDLL)
+ $(CP) $(TKDLL) $(TMPDIR)
+
+$(TMPDIR)\$(TCLDLL): $(TCLLIBDIR)\$(TCLDLL)
+ $(CP) $(TCLLIBDIR)\$(TCLDLL) $(TMPDIR)
+
+$(TMPDIR)\$(WISH): $(WISH)
+ $(CP) $(WISH) $(TMPDIR)
+
+$(TMPDIR)\$(TKTEST): $(TKTEST)
+ $(CP) $(TKTEST) $(TMPDIR)
+
+debug: $(TMPDIR)\$(TKDLL) $(TMPDIR)\$(TCLDLL) $(TMPDIR)\$(TKTEST)
+
+
+# remove all generated files
+
+clean:
+ $(RM) $(WISH)
+ $(RM) $(TKTEST)
+ $(RM) $(TKLIB)
+ $(RM) $(TKDLL)
+ $(RM) rc\*.res
+ $(RM) tk.def
+ $(RM) $(TMPDIR)\*.obj
+ $(RM) *.cfg
diff --git a/tk/win/makefile.vc b/tk/win/makefile.vc
new file mode 100644
index 00000000000..62a43056aa2
--- /dev/null
+++ b/tk/win/makefile.vc
@@ -0,0 +1,440 @@
+# 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.12 98/08/12 18:41:59
+
+# 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:\progra~1\devstudio\vc
+TOOLS32_rc = c:\progra~1\devstudio\sharedide
+TCLDIR = ..\..\tcl8.0
+
+# Set this to the appropriate value of /MACHINE: for your platform
+MACHINE = IX86
+
+# 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 = 80
+
+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
+TKDLLNAME = $(TKNAMEPREFIX)$(VERSION)$(DBGX).dll
+TKDLL = $(OUTDIR)\$(TKDLLNAME)
+TKLIB = $(OUTDIR)\$(TKNAMEPREFIX)$(VERSION)$(DBGX).lib
+TKPLUGINDLLNAME = $(TKNAMEPREFIX)$(VERSION)p$(DBG).dll
+TKPLUGINDLL = $(OUTDIR)\$(TKPLUGINDLLNAME)
+TKPLUGINLIB = $(OUTDIR)\$(TKNAMEPREFIX)$(VERSION)p$(DBGX).lib
+
+WISH = $(OUTDIR)\$(WISHNAMEPREFIX)$(VERSION)$(DBGX).exe
+WISHP = $(OUTDIR)\$(WISHNAMEPREFIX)p$(VERSION)$(DBGX).exe
+TKTEST = $(OUTDIR)\$(TKNAMEPREFIX)test.exe
+DUMPEXTS = $(TMPDIR)\dumpexts.exe
+
+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)\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 \
+ $(TMPDIR)\tkBind.obj \
+ $(TMPDIR)\tkBitmap.obj \
+ $(TMPDIR)\tkButton.obj \
+ $(TMPDIR)\tkCanvArc.obj \
+ $(TMPDIR)\tkCanvBmap.obj \
+ $(TMPDIR)\tkCanvImg.obj \
+ $(TMPDIR)\tkCanvLine.obj \
+ $(TMPDIR)\tkCanvPoly.obj \
+ $(TMPDIR)\tkCanvPs.obj \
+ $(TMPDIR)\tkCanvText.obj \
+ $(TMPDIR)\tkCanvUtil.obj \
+ $(TMPDIR)\tkCanvWind.obj \
+ $(TMPDIR)\tkCanvas.obj \
+ $(TMPDIR)\tkClipboard.obj \
+ $(TMPDIR)\tkCmds.obj \
+ $(TMPDIR)\tkColor.obj \
+ $(TMPDIR)\tkConfig.obj \
+ $(TMPDIR)\tkCursor.obj \
+ $(TMPDIR)\tkEntry.obj \
+ $(TMPDIR)\tkError.obj \
+ $(TMPDIR)\tkEvent.obj \
+ $(TMPDIR)\tkFileFilter.obj \
+ $(TMPDIR)\tkFocus.obj \
+ $(TMPDIR)\tkFont.obj \
+ $(TMPDIR)\tkFrame.obj \
+ $(TMPDIR)\tkGC.obj \
+ $(TMPDIR)\tkGeometry.obj \
+ $(TMPDIR)\tkGet.obj \
+ $(TMPDIR)\tkGrab.obj \
+ $(TMPDIR)\tkGrid.obj \
+ $(TMPDIR)\tkImage.obj \
+ $(TMPDIR)\tkImgBmap.obj \
+ $(TMPDIR)\tkImgGIF.obj \
+ $(TMPDIR)\tkImgPPM.obj \
+ $(TMPDIR)\tkImgPhoto.obj \
+ $(TMPDIR)\tkImgUtil.obj \
+ $(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_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)
+
+######################################################################
+# 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) -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
+######################################################################
+
+!IF "$(NODEBUG)" == "1"
+!IF "$(MACHINE)" == "ALPHA"
+# MSVC on Alpha doesn't understand -Ot
+cdebug = -O2i -Gs -GD
+!ELSE
+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)
+test: setup $(TKTEST)
+plugin: setup $(TKPLUGINDLL) $(WISHP)
+
+setup:
+ @mkd $(TMPDIR)
+ @mkd $(OUTDIR)
+
+$(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 $@ $(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
+
+#
+# Special case object file targets
+#
+
+$(TMPDIR)\testMain.obj: $(ROOT)\win\winMain.c
+ $(cc32) $(TK_CFLAGS) -DSTATIC_BUILD -DTK_TEST -Fo$@ $?
+
+$(TMPDIR)\tkTest.obj: $(ROOT)\generic\tkTest.c
+ $(cc32) $(TK_CFLAGS) -DSTATIC_BUILD -Fo$@ $?
+
+$(TMPDIR)\tkSquare.obj: $(ROOT)\generic\tkSquare.c
+ $(cc32) $(TK_CFLAGS) -Fo$@ $?
+
+$(TMPDIR)\winMain.obj: $(ROOT)\win\winMain.c
+ $(cc32) $(TK_CFLAGS) -DSTATIC_BUILD -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) $<
+
+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
+
+$(GENERICDIR)/default.h: $(WINDIR)/tkWinDefault.h
+$(GENERICDIR)/tkButton.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkCanvas.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkEntry.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkFrame.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkListbox.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkMenu.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkMenubutton.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkMessage.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkScale.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkScrollbar.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkText.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkTextIndex.c: $(GENERICDIR)/default.h
+$(GENERICDIR)/tkTextTag.c: $(GENERICDIR)/default.h
+
+$(GENERICDIR)/tkText.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextBTree.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextDisp.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextDisp.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextImage.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextIndex.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextMark.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextTag.c: $(GENERICDIR)/tkText.h
+$(GENERICDIR)/tkTextWind.c: $(GENERICDIR)/tkText.h
+
+$(GENERICDIR)/tkMacWinMenu.c: $(GENERICDIR)/tkMenu.h
+$(GENERICDIR)/tkMenu.c: $(GENERICDIR)/tkMenu.h
+$(GENERICDIR)/tkMenuDraw.c: $(GENERICDIR)/tkMenu.h
+$(WINDIR)/tkWinMenu.c: $(GENERICDIR)/tkMenu.h
+
diff --git a/tk/win/mkd.bat b/tk/win/mkd.bat
new file mode 100644
index 00000000000..2bd2388394f
--- /dev/null
+++ b/tk/win/mkd.bat
@@ -0,0 +1,21 @@
+@echo off
+rem RCS: @(#) $Id$
+
+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
diff --git a/tk/win/rc/buttons.bmp b/tk/win/rc/buttons.bmp
new file mode 100644
index 00000000000..f37a4c9d7c9
--- /dev/null
+++ b/tk/win/rc/buttons.bmp
Binary files differ
diff --git a/tk/win/rc/cursor00.cur b/tk/win/rc/cursor00.cur
new file mode 100644
index 00000000000..337e6d4e901
--- /dev/null
+++ b/tk/win/rc/cursor00.cur
Binary files differ
diff --git a/tk/win/rc/cursor02.cur b/tk/win/rc/cursor02.cur
new file mode 100644
index 00000000000..fbc47749fd4
--- /dev/null
+++ b/tk/win/rc/cursor02.cur
Binary files differ
diff --git a/tk/win/rc/cursor04.cur b/tk/win/rc/cursor04.cur
new file mode 100644
index 00000000000..9634c42f3b5
--- /dev/null
+++ b/tk/win/rc/cursor04.cur
Binary files differ
diff --git a/tk/win/rc/cursor06.cur b/tk/win/rc/cursor06.cur
new file mode 100644
index 00000000000..f7188b22c2f
--- /dev/null
+++ b/tk/win/rc/cursor06.cur
Binary files differ
diff --git a/tk/win/rc/cursor08.cur b/tk/win/rc/cursor08.cur
new file mode 100644
index 00000000000..d9f15f77562
--- /dev/null
+++ b/tk/win/rc/cursor08.cur
Binary files differ
diff --git a/tk/win/rc/cursor0a.cur b/tk/win/rc/cursor0a.cur
new file mode 100644
index 00000000000..3f8ef45620a
--- /dev/null
+++ b/tk/win/rc/cursor0a.cur
Binary files differ
diff --git a/tk/win/rc/cursor0c.cur b/tk/win/rc/cursor0c.cur
new file mode 100644
index 00000000000..1014eddca2e
--- /dev/null
+++ b/tk/win/rc/cursor0c.cur
Binary files differ
diff --git a/tk/win/rc/cursor0e.cur b/tk/win/rc/cursor0e.cur
new file mode 100644
index 00000000000..964058d9ade
--- /dev/null
+++ b/tk/win/rc/cursor0e.cur
Binary files differ
diff --git a/tk/win/rc/cursor10.cur b/tk/win/rc/cursor10.cur
new file mode 100644
index 00000000000..c4f78096f3b
--- /dev/null
+++ b/tk/win/rc/cursor10.cur
Binary files differ
diff --git a/tk/win/rc/cursor12.cur b/tk/win/rc/cursor12.cur
new file mode 100644
index 00000000000..920c936ae04
--- /dev/null
+++ b/tk/win/rc/cursor12.cur
Binary files differ
diff --git a/tk/win/rc/cursor14.cur b/tk/win/rc/cursor14.cur
new file mode 100644
index 00000000000..c7de122e01f
--- /dev/null
+++ b/tk/win/rc/cursor14.cur
Binary files differ
diff --git a/tk/win/rc/cursor16.cur b/tk/win/rc/cursor16.cur
new file mode 100644
index 00000000000..cfc08f23f96
--- /dev/null
+++ b/tk/win/rc/cursor16.cur
Binary files differ
diff --git a/tk/win/rc/cursor18.cur b/tk/win/rc/cursor18.cur
new file mode 100644
index 00000000000..95ed2ee9623
--- /dev/null
+++ b/tk/win/rc/cursor18.cur
Binary files differ
diff --git a/tk/win/rc/cursor1a.cur b/tk/win/rc/cursor1a.cur
new file mode 100644
index 00000000000..ea51361200c
--- /dev/null
+++ b/tk/win/rc/cursor1a.cur
Binary files differ
diff --git a/tk/win/rc/cursor1c.cur b/tk/win/rc/cursor1c.cur
new file mode 100644
index 00000000000..6f10bfbee82
--- /dev/null
+++ b/tk/win/rc/cursor1c.cur
Binary files differ
diff --git a/tk/win/rc/cursor1e.cur b/tk/win/rc/cursor1e.cur
new file mode 100644
index 00000000000..49fa7f70ddb
--- /dev/null
+++ b/tk/win/rc/cursor1e.cur
Binary files differ
diff --git a/tk/win/rc/cursor20.cur b/tk/win/rc/cursor20.cur
new file mode 100644
index 00000000000..cf177a16c4f
--- /dev/null
+++ b/tk/win/rc/cursor20.cur
Binary files differ
diff --git a/tk/win/rc/cursor22.cur b/tk/win/rc/cursor22.cur
new file mode 100644
index 00000000000..2f8e91247f8
--- /dev/null
+++ b/tk/win/rc/cursor22.cur
Binary files differ
diff --git a/tk/win/rc/cursor24.cur b/tk/win/rc/cursor24.cur
new file mode 100644
index 00000000000..87ba5b4db19
--- /dev/null
+++ b/tk/win/rc/cursor24.cur
Binary files differ
diff --git a/tk/win/rc/cursor26.cur b/tk/win/rc/cursor26.cur
new file mode 100644
index 00000000000..0b2dbd2578e
--- /dev/null
+++ b/tk/win/rc/cursor26.cur
Binary files differ
diff --git a/tk/win/rc/cursor28.cur b/tk/win/rc/cursor28.cur
new file mode 100644
index 00000000000..30550f95613
--- /dev/null
+++ b/tk/win/rc/cursor28.cur
Binary files differ
diff --git a/tk/win/rc/cursor2a.cur b/tk/win/rc/cursor2a.cur
new file mode 100644
index 00000000000..8dca4321fa3
--- /dev/null
+++ b/tk/win/rc/cursor2a.cur
Binary files differ
diff --git a/tk/win/rc/cursor2c.cur b/tk/win/rc/cursor2c.cur
new file mode 100644
index 00000000000..7be349469a3
--- /dev/null
+++ b/tk/win/rc/cursor2c.cur
Binary files differ
diff --git a/tk/win/rc/cursor2e.cur b/tk/win/rc/cursor2e.cur
new file mode 100644
index 00000000000..7a0bc694bd1
--- /dev/null
+++ b/tk/win/rc/cursor2e.cur
Binary files differ
diff --git a/tk/win/rc/cursor30.cur b/tk/win/rc/cursor30.cur
new file mode 100644
index 00000000000..70ef4fd23f8
--- /dev/null
+++ b/tk/win/rc/cursor30.cur
Binary files differ
diff --git a/tk/win/rc/cursor32.cur b/tk/win/rc/cursor32.cur
new file mode 100644
index 00000000000..93b5c4759c2
--- /dev/null
+++ b/tk/win/rc/cursor32.cur
Binary files differ
diff --git a/tk/win/rc/cursor34.cur b/tk/win/rc/cursor34.cur
new file mode 100644
index 00000000000..0fad3f1cfb3
--- /dev/null
+++ b/tk/win/rc/cursor34.cur
Binary files differ
diff --git a/tk/win/rc/cursor36.cur b/tk/win/rc/cursor36.cur
new file mode 100644
index 00000000000..fc8d4f6d4e5
--- /dev/null
+++ b/tk/win/rc/cursor36.cur
Binary files differ
diff --git a/tk/win/rc/cursor38.cur b/tk/win/rc/cursor38.cur
new file mode 100644
index 00000000000..4447d7d0bab
--- /dev/null
+++ b/tk/win/rc/cursor38.cur
Binary files differ
diff --git a/tk/win/rc/cursor3a.cur b/tk/win/rc/cursor3a.cur
new file mode 100644
index 00000000000..8176d1da6ad
--- /dev/null
+++ b/tk/win/rc/cursor3a.cur
Binary files differ
diff --git a/tk/win/rc/cursor3c.cur b/tk/win/rc/cursor3c.cur
new file mode 100644
index 00000000000..6a3111d7fb6
--- /dev/null
+++ b/tk/win/rc/cursor3c.cur
Binary files differ
diff --git a/tk/win/rc/cursor3e.cur b/tk/win/rc/cursor3e.cur
new file mode 100644
index 00000000000..fa6fe5b694b
--- /dev/null
+++ b/tk/win/rc/cursor3e.cur
Binary files differ
diff --git a/tk/win/rc/cursor40.cur b/tk/win/rc/cursor40.cur
new file mode 100644
index 00000000000..f07bf4f5c47
--- /dev/null
+++ b/tk/win/rc/cursor40.cur
Binary files differ
diff --git a/tk/win/rc/cursor42.cur b/tk/win/rc/cursor42.cur
new file mode 100644
index 00000000000..387d5f0bef9
--- /dev/null
+++ b/tk/win/rc/cursor42.cur
Binary files differ
diff --git a/tk/win/rc/cursor44.cur b/tk/win/rc/cursor44.cur
new file mode 100644
index 00000000000..190320cbad6
--- /dev/null
+++ b/tk/win/rc/cursor44.cur
Binary files differ
diff --git a/tk/win/rc/cursor46.cur b/tk/win/rc/cursor46.cur
new file mode 100644
index 00000000000..3e97094d931
--- /dev/null
+++ b/tk/win/rc/cursor46.cur
Binary files differ
diff --git a/tk/win/rc/cursor48.cur b/tk/win/rc/cursor48.cur
new file mode 100644
index 00000000000..2a5689731ed
--- /dev/null
+++ b/tk/win/rc/cursor48.cur
Binary files differ
diff --git a/tk/win/rc/cursor4a.cur b/tk/win/rc/cursor4a.cur
new file mode 100644
index 00000000000..30febfa2d45
--- /dev/null
+++ b/tk/win/rc/cursor4a.cur
Binary files differ
diff --git a/tk/win/rc/cursor4c.cur b/tk/win/rc/cursor4c.cur
new file mode 100644
index 00000000000..0407d77a21c
--- /dev/null
+++ b/tk/win/rc/cursor4c.cur
Binary files differ
diff --git a/tk/win/rc/cursor4e.cur b/tk/win/rc/cursor4e.cur
new file mode 100644
index 00000000000..a58e3dba5e2
--- /dev/null
+++ b/tk/win/rc/cursor4e.cur
Binary files differ
diff --git a/tk/win/rc/cursor50.cur b/tk/win/rc/cursor50.cur
new file mode 100644
index 00000000000..7352420db49
--- /dev/null
+++ b/tk/win/rc/cursor50.cur
Binary files differ
diff --git a/tk/win/rc/cursor52.cur b/tk/win/rc/cursor52.cur
new file mode 100644
index 00000000000..435f99f46bb
--- /dev/null
+++ b/tk/win/rc/cursor52.cur
Binary files differ
diff --git a/tk/win/rc/cursor54.cur b/tk/win/rc/cursor54.cur
new file mode 100644
index 00000000000..54eb4f2ce07
--- /dev/null
+++ b/tk/win/rc/cursor54.cur
Binary files differ
diff --git a/tk/win/rc/cursor56.cur b/tk/win/rc/cursor56.cur
new file mode 100644
index 00000000000..c808bd4ea1d
--- /dev/null
+++ b/tk/win/rc/cursor56.cur
Binary files differ
diff --git a/tk/win/rc/cursor58.cur b/tk/win/rc/cursor58.cur
new file mode 100644
index 00000000000..98b6a2fb592
--- /dev/null
+++ b/tk/win/rc/cursor58.cur
Binary files differ
diff --git a/tk/win/rc/cursor5a.cur b/tk/win/rc/cursor5a.cur
new file mode 100644
index 00000000000..b00070e5c57
--- /dev/null
+++ b/tk/win/rc/cursor5a.cur
Binary files differ
diff --git a/tk/win/rc/cursor5c.cur b/tk/win/rc/cursor5c.cur
new file mode 100644
index 00000000000..a407b55fb2d
--- /dev/null
+++ b/tk/win/rc/cursor5c.cur
Binary files differ
diff --git a/tk/win/rc/cursor5e.cur b/tk/win/rc/cursor5e.cur
new file mode 100644
index 00000000000..ab3449f7a9d
--- /dev/null
+++ b/tk/win/rc/cursor5e.cur
Binary files differ
diff --git a/tk/win/rc/cursor60.cur b/tk/win/rc/cursor60.cur
new file mode 100644
index 00000000000..847969d261c
--- /dev/null
+++ b/tk/win/rc/cursor60.cur
Binary files differ
diff --git a/tk/win/rc/cursor62.cur b/tk/win/rc/cursor62.cur
new file mode 100644
index 00000000000..36404a50b00
--- /dev/null
+++ b/tk/win/rc/cursor62.cur
Binary files differ
diff --git a/tk/win/rc/cursor64.cur b/tk/win/rc/cursor64.cur
new file mode 100644
index 00000000000..a6bdd0efc93
--- /dev/null
+++ b/tk/win/rc/cursor64.cur
Binary files differ
diff --git a/tk/win/rc/cursor66.cur b/tk/win/rc/cursor66.cur
new file mode 100644
index 00000000000..81d53b42696
--- /dev/null
+++ b/tk/win/rc/cursor66.cur
Binary files differ
diff --git a/tk/win/rc/cursor68.cur b/tk/win/rc/cursor68.cur
new file mode 100644
index 00000000000..27cfaf07796
--- /dev/null
+++ b/tk/win/rc/cursor68.cur
Binary files differ
diff --git a/tk/win/rc/cursor6a.cur b/tk/win/rc/cursor6a.cur
new file mode 100644
index 00000000000..20f138e45d8
--- /dev/null
+++ b/tk/win/rc/cursor6a.cur
Binary files differ
diff --git a/tk/win/rc/cursor6c.cur b/tk/win/rc/cursor6c.cur
new file mode 100644
index 00000000000..1e8d6d82e3f
--- /dev/null
+++ b/tk/win/rc/cursor6c.cur
Binary files differ
diff --git a/tk/win/rc/cursor6e.cur b/tk/win/rc/cursor6e.cur
new file mode 100644
index 00000000000..3a9b6b0ff1e
--- /dev/null
+++ b/tk/win/rc/cursor6e.cur
Binary files differ
diff --git a/tk/win/rc/cursor70.cur b/tk/win/rc/cursor70.cur
new file mode 100644
index 00000000000..e2d76732afc
--- /dev/null
+++ b/tk/win/rc/cursor70.cur
Binary files differ
diff --git a/tk/win/rc/cursor72.cur b/tk/win/rc/cursor72.cur
new file mode 100644
index 00000000000..4994c6e7a26
--- /dev/null
+++ b/tk/win/rc/cursor72.cur
Binary files differ
diff --git a/tk/win/rc/cursor74.cur b/tk/win/rc/cursor74.cur
new file mode 100644
index 00000000000..d5e43613d34
--- /dev/null
+++ b/tk/win/rc/cursor74.cur
Binary files differ
diff --git a/tk/win/rc/cursor76.cur b/tk/win/rc/cursor76.cur
new file mode 100644
index 00000000000..34f402aaca5
--- /dev/null
+++ b/tk/win/rc/cursor76.cur
Binary files differ
diff --git a/tk/win/rc/cursor78.cur b/tk/win/rc/cursor78.cur
new file mode 100644
index 00000000000..70e25dd1c67
--- /dev/null
+++ b/tk/win/rc/cursor78.cur
Binary files differ
diff --git a/tk/win/rc/cursor7a.cur b/tk/win/rc/cursor7a.cur
new file mode 100644
index 00000000000..5ea95c4c674
--- /dev/null
+++ b/tk/win/rc/cursor7a.cur
Binary files differ
diff --git a/tk/win/rc/cursor7c.cur b/tk/win/rc/cursor7c.cur
new file mode 100644
index 00000000000..38036ab36c4
--- /dev/null
+++ b/tk/win/rc/cursor7c.cur
Binary files differ
diff --git a/tk/win/rc/cursor7e.cur b/tk/win/rc/cursor7e.cur
new file mode 100644
index 00000000000..4b24e50885a
--- /dev/null
+++ b/tk/win/rc/cursor7e.cur
Binary files differ
diff --git a/tk/win/rc/cursor80.cur b/tk/win/rc/cursor80.cur
new file mode 100644
index 00000000000..a3955a5f7e7
--- /dev/null
+++ b/tk/win/rc/cursor80.cur
Binary files differ
diff --git a/tk/win/rc/cursor82.cur b/tk/win/rc/cursor82.cur
new file mode 100644
index 00000000000..984cfbaac8e
--- /dev/null
+++ b/tk/win/rc/cursor82.cur
Binary files differ
diff --git a/tk/win/rc/cursor84.cur b/tk/win/rc/cursor84.cur
new file mode 100644
index 00000000000..cd6807ec40c
--- /dev/null
+++ b/tk/win/rc/cursor84.cur
Binary files differ
diff --git a/tk/win/rc/cursor86.cur b/tk/win/rc/cursor86.cur
new file mode 100644
index 00000000000..2d38c0351f1
--- /dev/null
+++ b/tk/win/rc/cursor86.cur
Binary files differ
diff --git a/tk/win/rc/cursor88.cur b/tk/win/rc/cursor88.cur
new file mode 100644
index 00000000000..62b80615f85
--- /dev/null
+++ b/tk/win/rc/cursor88.cur
Binary files differ
diff --git a/tk/win/rc/cursor8a.cur b/tk/win/rc/cursor8a.cur
new file mode 100644
index 00000000000..6c5358d69a8
--- /dev/null
+++ b/tk/win/rc/cursor8a.cur
Binary files differ
diff --git a/tk/win/rc/cursor8c.cur b/tk/win/rc/cursor8c.cur
new file mode 100644
index 00000000000..103010b645c
--- /dev/null
+++ b/tk/win/rc/cursor8c.cur
Binary files differ
diff --git a/tk/win/rc/cursor8e.cur b/tk/win/rc/cursor8e.cur
new file mode 100644
index 00000000000..a500a38dffe
--- /dev/null
+++ b/tk/win/rc/cursor8e.cur
Binary files differ
diff --git a/tk/win/rc/cursor90.cur b/tk/win/rc/cursor90.cur
new file mode 100644
index 00000000000..08731f8236a
--- /dev/null
+++ b/tk/win/rc/cursor90.cur
Binary files differ
diff --git a/tk/win/rc/cursor92.cur b/tk/win/rc/cursor92.cur
new file mode 100644
index 00000000000..4364b5df1ce
--- /dev/null
+++ b/tk/win/rc/cursor92.cur
Binary files differ
diff --git a/tk/win/rc/cursor94.cur b/tk/win/rc/cursor94.cur
new file mode 100644
index 00000000000..7777d5380a7
--- /dev/null
+++ b/tk/win/rc/cursor94.cur
Binary files differ
diff --git a/tk/win/rc/cursor96.cur b/tk/win/rc/cursor96.cur
new file mode 100644
index 00000000000..cecaea39b5a
--- /dev/null
+++ b/tk/win/rc/cursor96.cur
Binary files differ
diff --git a/tk/win/rc/cursor98.cur b/tk/win/rc/cursor98.cur
new file mode 100644
index 00000000000..5cab68ebace
--- /dev/null
+++ b/tk/win/rc/cursor98.cur
Binary files differ
diff --git a/tk/win/rc/cygnus.ico b/tk/win/rc/cygnus.ico
new file mode 100644
index 00000000000..c8b451c869a
--- /dev/null
+++ b/tk/win/rc/cygnus.ico
Binary files differ
diff --git a/tk/win/rc/tk.ico b/tk/win/rc/tk.ico
new file mode 100644
index 00000000000..5fdb9a79d5f
--- /dev/null
+++ b/tk/win/rc/tk.ico
Binary files differ
diff --git a/tk/win/rc/tk.rc b/tk/win/rc/tk.rc
new file mode 100644
index 00000000000..67f3e1422be
--- /dev/null
+++ b/tk/win/rc/tk.rc
@@ -0,0 +1,132 @@
+// 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
+ FILEVERSION TK_MAJOR_VERSION,TK_MINOR_VERSION,TK_RELEASE_LEVEL,TK_RELEASE_SERIAL
+ PRODUCTVERSION TK_MAJOR_VERSION,TK_MINOR_VERSION,TK_RELEASE_LEVEL,TK_RELEASE_SERIAL
+ FILEFLAGSMASK 0x3fL
+ FILEFLAGS 0x0L
+ FILEOS 0x4L
+ FILETYPE 0x2L
+ FILESUBTYPE 0x0L
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904b0"
+ BEGIN
+ VALUE "FileDescription", "Tk DLL\0"
+ VALUE "OriginalFilename", "tk" STRINGIFY(TK_MAJOR_VERSION) STRINGIFY(TK_MINOR_VERSION) ".dll\0"
+ VALUE "CompanyName", "Sun Microsystems, Inc.\0"
+ VALUE "FileVersion", TK_PATCH_LEVEL
+ VALUE "LegalCopyright", "Copyright \251 1995-1996\0"
+ VALUE "ProductName", "Tk " TK_VERSION " for Windows\0"
+ VALUE "ProductVersion", TK_PATCH_LEVEL
+ END
+ END
+ BLOCK "VarFileInfo"
+ BEGIN
+ VALUE "Translation", 0x409, 1200
+ END
+END
+
+//
+// Icons
+//
+
+tk ICON DISCARDABLE "cygnus.ico"
+
+//
+// Bitmaps
+//
+
+buttons BITMAP DISCARDABLE "buttons.bmp"
+
+//
+// Cursors
+//
+
+X_cursor CURSOR DISCARDABLE "cursor00.cur"
+arrow CURSOR DISCARDABLE "cursor02.cur"
+based_arrow_down CURSOR DISCARDABLE "cursor04.cur"
+based_arrow_up CURSOR DISCARDABLE "cursor06.cur"
+boat CURSOR DISCARDABLE "cursor08.cur"
+bogosity CURSOR DISCARDABLE "cursor0a.cur"
+bottom_left_corner CURSOR DISCARDABLE "cursor0c.cur"
+bottom_right_corner CURSOR DISCARDABLE "cursor0e.cur"
+bottom_side CURSOR DISCARDABLE "cursor10.cur"
+bottom_tee CURSOR DISCARDABLE "cursor12.cur"
+box_spiral CURSOR DISCARDABLE "cursor14.cur"
+center_ptr CURSOR DISCARDABLE "cursor16.cur"
+circle CURSOR DISCARDABLE "cursor18.cur"
+clock CURSOR DISCARDABLE "cursor1a.cur"
+coffee_mug CURSOR DISCARDABLE "cursor1c.cur"
+cross CURSOR DISCARDABLE "cursor1e.cur"
+cross_reverse CURSOR DISCARDABLE "cursor20.cur"
+crosshair CURSOR DISCARDABLE "cursor22.cur"
+diamond_cross CURSOR DISCARDABLE "cursor24.cur"
+dot CURSOR DISCARDABLE "cursor26.cur"
+dotbox CURSOR DISCARDABLE "cursor28.cur"
+double_arrow CURSOR DISCARDABLE "cursor2a.cur"
+draft_large CURSOR DISCARDABLE "cursor2c.cur"
+draft_small CURSOR DISCARDABLE "cursor2e.cur"
+draped_box CURSOR DISCARDABLE "cursor30.cur"
+exchange CURSOR DISCARDABLE "cursor32.cur"
+fleur CURSOR DISCARDABLE "cursor34.cur"
+gobbler CURSOR DISCARDABLE "cursor36.cur"
+gumby CURSOR DISCARDABLE "cursor38.cur"
+hand1 CURSOR DISCARDABLE "cursor3a.cur"
+hand2 CURSOR DISCARDABLE "cursor3c.cur"
+heart CURSOR DISCARDABLE "cursor3e.cur"
+icon CURSOR DISCARDABLE "cursor40.cur"
+iron_cross CURSOR DISCARDABLE "cursor42.cur"
+left_ptr CURSOR DISCARDABLE "cursor44.cur"
+left_side CURSOR DISCARDABLE "cursor46.cur"
+left_tee CURSOR DISCARDABLE "cursor48.cur"
+leftbutton CURSOR DISCARDABLE "cursor4a.cur"
+ll_angle CURSOR DISCARDABLE "cursor4c.cur"
+lr_angle CURSOR DISCARDABLE "cursor4e.cur"
+man CURSOR DISCARDABLE "cursor50.cur"
+middlebutton CURSOR DISCARDABLE "cursor52.cur"
+mouse CURSOR DISCARDABLE "cursor54.cur"
+pencil CURSOR DISCARDABLE "cursor56.cur"
+pirate CURSOR DISCARDABLE "cursor58.cur"
+plus CURSOR DISCARDABLE "cursor5a.cur"
+question_arrow CURSOR DISCARDABLE "cursor5c.cur"
+right_ptr CURSOR DISCARDABLE "cursor5e.cur"
+right_side CURSOR DISCARDABLE "cursor60.cur"
+right_tee CURSOR DISCARDABLE "cursor62.cur"
+rightbutton CURSOR DISCARDABLE "cursor64.cur"
+rtl_logo CURSOR DISCARDABLE "cursor66.cur"
+sailboat CURSOR DISCARDABLE "cursor68.cur"
+sb_down_arrow CURSOR DISCARDABLE "cursor6a.cur"
+sb_h_double_arrow CURSOR DISCARDABLE "cursor6c.cur"
+sb_left_arrow CURSOR DISCARDABLE "cursor6e.cur"
+sb_right_arrow CURSOR DISCARDABLE "cursor70.cur"
+sb_up_arrow CURSOR DISCARDABLE "cursor72.cur"
+sb_v_double_arrow CURSOR DISCARDABLE "cursor74.cur"
+shuttle CURSOR DISCARDABLE "cursor76.cur"
+sizing CURSOR DISCARDABLE "cursor78.cur"
+spider CURSOR DISCARDABLE "cursor7a.cur"
+spraycan CURSOR DISCARDABLE "cursor7c.cur"
+star CURSOR DISCARDABLE "cursor7e.cur"
+target CURSOR DISCARDABLE "cursor80.cur"
+tcross CURSOR DISCARDABLE "cursor82.cur"
+top_left_arrow CURSOR DISCARDABLE "cursor84.cur"
+top_left_corner CURSOR DISCARDABLE "cursor86.cur"
+top_right_corner CURSOR DISCARDABLE "cursor88.cur"
+top_side CURSOR DISCARDABLE "cursor8a.cur"
+top_tee CURSOR DISCARDABLE "cursor8c.cur"
+trek CURSOR DISCARDABLE "cursor8e.cur"
+ul_angle CURSOR DISCARDABLE "cursor90.cur"
+umbrella CURSOR DISCARDABLE "cursor92.cur"
+ur_angle CURSOR DISCARDABLE "cursor94.cur"
+watch CURSOR DISCARDABLE "cursor96.cur"
+xterm CURSOR DISCARDABLE "cursor98.cur"
diff --git a/tk/win/rc/wish.ico b/tk/win/rc/wish.ico
new file mode 100644
index 00000000000..a32e749fd55
--- /dev/null
+++ b/tk/win/rc/wish.ico
Binary files differ
diff --git a/tk/win/rc/wish.rc b/tk/win/rc/wish.rc
new file mode 100644
index 00000000000..76cf1240372
--- /dev/null
+++ b/tk/win/rc/wish.rc
@@ -0,0 +1,44 @@
+// SCCS: @(#) wish.rc 1.15 96/09/17 13:24:11
+//
+// Version
+//
+
+#define RESOURCE_INCLUDED
+#include <tk.h>
+
+#define STRINGIFY1(x) #x
+#define STRINGIFY(x) STRINGIFY1(x)
+
+VS_VERSION_INFO VERSIONINFO
+ FILEVERSION TK_MAJOR_VERSION,TK_MINOR_VERSION,TK_RELEASE_LEVEL,TK_RELEASE_SERIAL
+ PRODUCTVERSION TK_MAJOR_VERSION,TK_MINOR_VERSION,TK_RELEASE_LEVEL,TK_RELEASE_SERIAL
+ FILEFLAGSMASK 0x3fL
+ FILEFLAGS 0x0L
+ FILEOS 0x4L
+ FILETYPE 0x1L
+ FILESUBTYPE 0x0L
+BEGIN
+ BLOCK "StringFileInfo"
+ BEGIN
+ BLOCK "040904b0"
+ BEGIN
+ VALUE "FileDescription", "Wish Application\0"
+ VALUE "OriginalFilename", "wish" STRINGIFY(TK_MAJOR_VERSION) STRINGIFY(TK_MINOR_VERSION) ".exe\0"
+ VALUE "CompanyName", "Sun Microsystems, Inc.\0"
+ VALUE "FileVersion", TK_PATCH_LEVEL
+ VALUE "LegalCopyright", "Copyright \251 1995-1996\0"
+ VALUE "ProductName", "Tk " TK_VERSION " for Windows\0"
+ VALUE "ProductVersion", TK_PATCH_LEVEL
+ END
+ END
+ BLOCK "VarFileInfo"
+ BEGIN
+ VALUE "Translation", 0x409, 1200
+ END
+END
+
+//
+// Icon
+//
+
+wish ICON DISCARDABLE "wish.ico"
diff --git a/tk/win/rmd.bat b/tk/win/rmd.bat
new file mode 100644
index 00000000000..15fd8c1fabc
--- /dev/null
+++ b/tk/win/rmd.bat
@@ -0,0 +1,25 @@
+@echo off
+rem RCS: @(#) $Id$
+
+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
diff --git a/tk/win/stubs.c b/tk/win/stubs.c
new file mode 100644
index 00000000000..c9b97f5550c
--- /dev/null
+++ b/tk/win/stubs.c
@@ -0,0 +1,397 @@
+#include <X11/X.h>
+#include <X11/Xlib.h>
+#include <stdio.h>
+#include <tkInt.h>
+#include <tkPort.h>
+
+/*
+ * Undocumented Xlib internal function
+ */
+
+_XInitImageFuncPtrs(XImage *image)
+{
+ return 0;
+}
+
+/*
+ * From Xutil.h
+ */
+
+void
+XSetWMClientMachine(display, w, text_prop)
+ Display* display;
+ Window w;
+ XTextProperty* text_prop;
+{
+}
+
+Status
+XStringListToTextProperty(list, count, text_prop_return)
+ char** list;
+ int count;
+ XTextProperty* text_prop_return;
+{
+ return (Status) NULL;
+}
+
+/*
+ * From Xlib.h
+ */
+
+void
+XChangeProperty(display, w, property, type, format, mode, data, nelements)
+ Display* display;
+ Window w;
+ Atom property;
+ Atom type;
+ int format;
+ int mode;
+ _Xconst unsigned char* data;
+ int nelements;
+{
+}
+
+Cursor
+XCreateGlyphCursor(display, source_font, mask_font, source_char, mask_char,
+ foreground_color, background_color)
+ Display* display;
+ Font source_font;
+ Font mask_font;
+ unsigned int source_char;
+ unsigned int mask_char;
+ XColor* foreground_color;
+ XColor* background_color;
+{
+ return 1;
+}
+
+XIC
+XCreateIC()
+{
+ return NULL;
+}
+
+Cursor
+XCreatePixmapCursor(display, source, mask, foreground_color,
+ background_color, x, y)
+ Display* display;
+ Pixmap source;
+ Pixmap mask;
+ XColor* foreground_color;
+ XColor* background_color;
+ unsigned int x;
+ unsigned int y;
+{
+ return (Cursor) NULL;
+}
+
+void
+XDeleteProperty(display, w, property)
+ Display* display;
+ Window w;
+ Atom property;
+{
+}
+
+void
+XDestroyIC(ic)
+ XIC ic;
+{
+}
+
+Bool
+XFilterEvent(event, window)
+ XEvent* event;
+ Window window;
+{
+ return 0;
+}
+
+extern void XForceScreenSaver(display, mode)
+ Display* display;
+ int mode;
+{
+}
+
+void
+XFreeCursor(display, cursor)
+ Display* display;
+ Cursor cursor;
+{
+}
+
+GContext
+XGContextFromGC(gc)
+ GC gc;
+{
+ return (GContext) NULL;
+}
+
+char *
+XGetAtomName(display, atom)
+ Display* display;
+ Atom atom;
+{
+ return NULL;
+}
+
+int
+XGetWindowAttributes(display, w, window_attributes_return)
+ Display* display;
+ Window w;
+ XWindowAttributes* window_attributes_return;
+{
+ return 0;
+}
+
+Status
+XGetWMColormapWindows(display, w, windows_return, count_return)
+ Display* display;
+ Window w;
+ Window** windows_return;
+ int* count_return;
+{
+ return (Status) NULL;
+}
+
+int
+XIconifyWindow(display, w, screen_number)
+ Display* display;
+ Window w;
+ int screen_number;
+{
+ return 0;
+}
+
+XHostAddress *
+XListHosts(display, nhosts_return, state_return)
+ Display* display;
+ int* nhosts_return;
+ Bool* state_return;
+{
+ return NULL;
+}
+
+int
+XLookupColor(display, colormap, color_name, exact_def_return,
+ screen_def_return)
+ Display* display;
+ Colormap colormap;
+ _Xconst char* color_name;
+ XColor* exact_def_return;
+ XColor* screen_def_return;
+{
+ return 0;
+}
+
+void
+XNextEvent(display, event_return)
+ Display* display;
+ XEvent* event_return;
+{
+}
+
+void
+XPutBackEvent(display, event)
+ Display* display;
+ XEvent* event;
+{
+}
+
+void
+XQueryColors(display, colormap, defs_in_out, ncolors)
+ Display* display;
+ Colormap colormap;
+ XColor* defs_in_out;
+ int ncolors;
+{
+}
+
+int
+XQueryTree(display, w, root_return, parent_return, children_return,
+ nchildren_return)
+ Display* display;
+ Window w;
+ Window* root_return;
+ Window* parent_return;
+ Window** children_return;
+ unsigned int* nchildren_return;
+{
+ return 0;
+}
+
+void
+XRefreshKeyboardMapping(event_map)
+ XMappingEvent* event_map;
+{
+}
+
+Window
+XRootWindow(display, screen_number)
+ Display* display;
+ int screen_number;
+{
+ return (Window) NULL;
+}
+
+void
+XSelectInput(display, w, event_mask)
+ Display* display;
+ Window w;
+ long event_mask;
+{
+}
+
+int
+XSendEvent(display, w, propagate, event_mask, event_send)
+ Display* display;
+ Window w;
+ Bool propagate;
+ long event_mask;
+ XEvent* event_send;
+{
+ return 0;
+}
+
+void
+XSetCommand(display, w, argv, argc)
+ Display* display;
+ Window w;
+ char** argv;
+ int argc;
+{
+}
+
+XErrorHandler
+XSetErrorHandler (handler)
+ XErrorHandler handler;
+{
+ return NULL;
+}
+
+void
+XSetIconName(display, w, icon_name)
+ Display* display;
+ Window w;
+ _Xconst char* icon_name;
+{
+}
+
+void
+XSetWindowBackground(display, w, background_pixel)
+ Display* display;
+ Window w;
+ unsigned long background_pixel;
+{
+}
+
+void
+XSetWindowBackgroundPixmap(display, w, background_pixmap)
+ Display* display;
+ Window w;
+ Pixmap background_pixmap;
+{
+}
+
+void
+XSetWindowBorder(display, w, border_pixel)
+ Display* display;
+ Window w;
+ unsigned long border_pixel;
+{
+}
+
+void
+XSetWindowBorderPixmap(display, w, border_pixmap)
+ Display* display;
+ Window w;
+ Pixmap border_pixmap;
+{
+}
+
+void
+XSetWindowBorderWidth(display, w, width)
+ Display* display;
+ Window w;
+ unsigned int width;
+{
+}
+
+void
+XSetWindowColormap(display, w, colormap)
+ Display* display;
+ Window w;
+ Colormap colormap;
+{
+}
+
+Bool
+XTranslateCoordinates(display, src_w, dest_w, src_x, src_y, dest_x_return,
+ dest_y_return, child_return)
+ 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;
+{
+ return 0;
+}
+
+void
+XWindowEvent(display, w, event_mask, event_return)
+ Display* display;
+ Window w;
+ long event_mask;
+ XEvent* event_return;
+{
+}
+
+int
+XWithdrawWindow(display, w, screen_number)
+ Display* display;
+ Window w;
+ int screen_number;
+{
+ return 0;
+}
+
+int
+XmbLookupString(ic, event, buffer_return, bytes_buffer, keysym_return,
+ status_return)
+ XIC ic;
+ XKeyPressedEvent* event;
+ char* buffer_return;
+ int bytes_buffer;
+ KeySym* keysym_return;
+ Status* status_return;
+{
+ return 0;
+}
+
+int
+XGetWindowProperty(display, w, property, long_offset, long_length, delete,
+ req_type, actual_type_return, actual_format_return, nitems_return,
+ bytes_after_return, prop_return)
+ 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;
+{
+ *actual_type_return = None;
+ *actual_format_return = 0;
+ *nitems_return = 0;
+ *bytes_after_return = 0;
+ *prop_return = NULL;
+ return BadValue;
+}
diff --git a/tk/win/tk.def b/tk/win/tk.def
new file mode 100644
index 00000000000..49839af3248
--- /dev/null
+++ b/tk/win/tk.def
@@ -0,0 +1,1056 @@
+LIBRARY tk42
+EXPORTS
+_XDrawLine
+XDrawLine
+_XFillRectangle
+XFillRectangle
+_XCreateGC
+XCreateGC
+_XChangeGC
+XChangeGC
+_XFreeGC
+XFreeGC
+_XSetArcMode
+XSetArcMode
+_XSetBackground
+XSetBackground
+_XSetClipMask
+XSetClipMask
+_XSetClipOrigin
+XSetClipOrigin
+_XSetFillRule
+XSetFillRule
+_XSetFillStyle
+XSetFillStyle
+_XSetFont
+XSetFont
+_XSetForeground
+XSetForeground
+_XSetFunction
+XSetFunction
+_XSetLineAttributes
+XSetLineAttributes
+_XSetStipple
+XSetStipple
+_XSetTSOrigin
+XSetTSOrigin
+_TkSetRegion
+TkSetRegion
+_XCreateBitmapFromData
+XCreateBitmapFromData
+_XReadBitmapFile
+XReadBitmapFile
+_XInternAtom
+XInternAtom
+_XGetVisualInfo
+XGetVisualInfo
+_XSetSelectionOwner
+XSetSelectionOwner
+_TkSelEventProc
+TkSelEventProc
+_TkSelPropProc
+TkSelPropProc
+_TkWinClipboardRender
+TkWinClipboardRender
+_TkSelGetSelection
+TkSelGetSelection
+_TkSelUpdateClipboard
+TkSelUpdateClipboard
+_XCreateColormap
+XCreateColormap
+_XAllocColor
+XAllocColor
+_XAllocNamedColor
+XAllocNamedColor
+_XFreeColormap
+XFreeColormap
+_XFreeColors
+XFreeColors
+_XParseColor
+XParseColor
+_TkWinSelectPalette
+TkWinSelectPalette
+_TkCreateCursorFromData
+TkCreateCursorFromData
+_TkFreeCursor
+TkFreeCursor
+_TkGetCursorByName
+TkGetCursorByName
+_TkWinUpdateCursor
+TkWinUpdateCursor
+_Tk_ChooseColorCmd
+Tk_ChooseColorCmd
+_Tk_GetOpenFileCmd
+Tk_GetOpenFileCmd
+_Tk_GetSaveFileCmd
+Tk_GetSaveFileCmd
+_Tk_MessageBoxCmd
+Tk_MessageBoxCmd
+_XCopyArea
+XCopyArea
+_XCopyPlane
+XCopyPlane
+_XDrawArc
+XDrawArc
+_XDrawLines
+XDrawLines
+_XDrawRectangle
+XDrawRectangle
+_XDrawString
+XDrawString
+_XFillArc
+XFillArc
+_XFillPolygon
+XFillPolygon
+_XFillRectangles
+XFillRectangles
+_TkPutImage
+TkPutImage
+_TkScrollWindow
+TkScrollWindow
+_TkWinGetDrawableDC
+TkWinGetDrawableDC
+_TkWinReleaseDrawableDC
+TkWinReleaseDrawableDC
+_XLoadQueryFont
+XLoadQueryFont
+_XQueryFont
+XQueryFont
+_XLoadFont
+XLoadFont
+_XFreeFont
+XFreeFont
+_XGetFontProperty
+XGetFontProperty
+_XTextExtents
+XTextExtents
+_XTextWidth
+XTextWidth
+_XCreateImage
+XCreateImage
+_TkPlatformInit
+TkPlatformInit
+_XGetModifierMapping
+XGetModifierMapping
+_XKeysymToString
+XKeysymToString
+_XKeycodeToKeysym
+XKeycodeToKeysym
+_XStringToKeysym
+XStringToKeysym
+_XFreeModifiermap
+XFreeModifiermap
+_XKeysymToKeycode
+XKeysymToKeycode
+_XLookupString
+XLookupString
+_Tk_FreePixmap
+Tk_FreePixmap
+_Tk_GetPixmap
+Tk_GetPixmap
+_TkSetPixmapColormap
+TkSetPixmapColormap
+_XDefineCursor
+XDefineCursor
+_XGetInputFocus
+XGetInputFocus
+_XGrabKeyboard
+XGrabKeyboard
+_XGrabPointer
+XGrabPointer
+_XQueryPointer
+XQueryPointer
+_XSetInputFocus
+XSetInputFocus
+_XUngrabKeyboard
+XUngrabKeyboard
+_XUngrabPointer
+XUngrabPointer
+_TkGetPointerCoords
+TkGetPointerCoords
+_TkWinPointerDeadWindow
+TkWinPointerDeadWindow
+_TkWinPointerEvent
+TkWinPointerEvent
+_TkWinPointerInit
+TkWinPointerInit
+_TkClipBox
+TkClipBox
+_TkCreateRegion
+TkCreateRegion
+_TkDestroyRegion
+TkDestroyRegion
+_TkIntersectRegion
+TkIntersectRegion
+_TkRectInRegion
+TkRectInRegion
+_TkUnionRectWithRegion
+TkUnionRectWithRegion
+_XChangeWindowAttributes
+XChangeWindowAttributes
+_XClearWindow
+XClearWindow
+_XConfigureWindow
+XConfigureWindow
+_XDestroyWindow
+XDestroyWindow
+_XMapWindow
+XMapWindow
+_XMoveResizeWindow
+XMoveResizeWindow
+_XMoveWindow
+XMoveWindow
+_XRaiseWindow
+XRaiseWindow
+_XResizeWindow
+XResizeWindow
+_XUnmapWindow
+XUnmapWindow
+_TkMakeWindow
+TkMakeWindow
+_Tk_CoordsToWindow
+Tk_CoordsToWindow
+_Tk_GetRootCoords
+Tk_GetRootCoords
+_Tk_GetVRootGeometry
+Tk_GetVRootGeometry
+_Tk_MoveToplevelWindow
+Tk_MoveToplevelWindow
+_Tk_SetGrid
+Tk_SetGrid
+_Tk_UnsetGrid
+Tk_UnsetGrid
+_Tk_WmCmd
+Tk_WmCmd
+_TkWmAddToColormapWindows
+TkWmAddToColormapWindows
+_TkWmDeadWindow
+TkWmDeadWindow
+_TkWmMapWindow
+TkWmMapWindow
+_TkWmNewWindow
+TkWmNewWindow
+_TkWmProtocolEventProc
+TkWmProtocolEventProc
+_TkWmRemoveFromColormapWindows
+TkWmRemoveFromColormapWindows
+_TkWmRestackToplevel
+TkWmRestackToplevel
+_TkWmSetClass
+TkWmSetClass
+_TkWmUnmapWindow
+TkWmUnmapWindow
+_TkWinGetSystemPalette
+TkWinGetSystemPalette
+_TkWinWmConfigure
+TkWinWmConfigure
+_TkWinWmInstallColormaps
+TkWinWmInstallColormaps
+_TkWinWmSetLimits
+TkWinWmSetLimits
+_XOpenDisplay
+XOpenDisplay
+_XBell
+XBell
+_Tk_FreeXId
+Tk_FreeXId
+_TkGetDefaultScreenName
+TkGetDefaultScreenName
+_TkGetServerInfo
+TkGetServerInfo
+TkWinChildProc
+_TkWinEnterModalLoop
+TkWinEnterModalLoop
+_TkWinGetAppInstance
+TkWinGetAppInstance
+_TkWinGetDrawableFromHandle
+TkWinGetDrawableFromHandle
+_TkWinGetModifierState
+TkWinGetModifierState
+_TkWinGetTkModule
+TkWinGetTkModule
+_TkWinLeaveModalLoop
+TkWinLeaveModalLoop
+TkWinTopLevelProc
+_TkWinXInit
+TkWinXInit
+_XGetImage
+XGetImage
+_XGetAtomName
+XGetAtomName
+_XCreatePixmapCursor
+XCreatePixmapCursor
+_XCreateGlyphCursor
+XCreateGlyphCursor
+_XGContextFromGC
+XGContextFromGC
+_XListHosts
+XListHosts
+_XRootWindow
+XRootWindow
+_XSetErrorHandler
+XSetErrorHandler
+_XIconifyWindow
+XIconifyWindow
+_XWithdrawWindow
+XWithdrawWindow
+_XGetWMColormapWindows
+XGetWMColormapWindows
+_XSetWMColormapWindows
+XSetWMColormapWindows
+_XSetTransientForHint
+XSetTransientForHint
+_XChangeProperty
+XChangeProperty
+_XDeleteProperty
+XDeleteProperty
+_XForceScreenSaver
+XForceScreenSaver
+_XFreeCursor
+XFreeCursor
+_XGetGeometry
+XGetGeometry
+_XGetWindowProperty
+XGetWindowProperty
+_XGetWindowAttributes
+XGetWindowAttributes
+_XLookupColor
+XLookupColor
+_XNextEvent
+XNextEvent
+_XPutBackEvent
+XPutBackEvent
+_XQueryColors
+XQueryColors
+_XQueryTree
+XQueryTree
+_XRefreshKeyboardMapping
+XRefreshKeyboardMapping
+_XSelectInput
+XSelectInput
+_XSendEvent
+XSendEvent
+_XSetCommand
+XSetCommand
+_XSetIconName
+XSetIconName
+_XSetWindowBackground
+XSetWindowBackground
+_XSetWindowBackgroundPixmap
+XSetWindowBackgroundPixmap
+_XSetWindowBorder
+XSetWindowBorder
+_XSetWindowBorderPixmap
+XSetWindowBorderPixmap
+_XSetWindowBorderWidth
+XSetWindowBorderWidth
+_XSetWindowColormap
+XSetWindowColormap
+_XTranslateCoordinates
+XTranslateCoordinates
+_XWindowEvent
+XWindowEvent
+_XCreateIC
+XCreateIC
+_XDestroyIC
+XDestroyIC
+_XFilterEvent
+XFilterEvent
+_XmbLookupString
+XmbLookupString
+_XSetWMClientMachine
+XSetWMClientMachine
+_XStringListToTextProperty
+XStringListToTextProperty
+__XInitImageFuncPtrs
+_XInitImageFuncPtrs
+_Tk_3DBorderColor
+Tk_3DBorderColor
+_Tk_3DBorderGC
+Tk_3DBorderGC
+_Tk_3DHorizontalBevel
+Tk_3DHorizontalBevel
+_Tk_3DVerticalBevel
+Tk_3DVerticalBevel
+_Tk_Draw3DPolygon
+Tk_Draw3DPolygon
+_Tk_Draw3DRectangle
+Tk_Draw3DRectangle
+_Tk_Fill3DPolygon
+Tk_Fill3DPolygon
+_Tk_Fill3DRectangle
+Tk_Fill3DRectangle
+_Tk_Free3DBorder
+Tk_Free3DBorder
+_Tk_Get3DBorder
+Tk_Get3DBorder
+_Tk_GetRelief
+Tk_GetRelief
+_Tk_NameOf3DBorder
+Tk_NameOf3DBorder
+_Tk_NameOfRelief
+Tk_NameOfRelief
+_Tk_SetBackgroundFromBorder
+Tk_SetBackgroundFromBorder
+_Tk_ParseArgv
+Tk_ParseArgv
+_Tk_GetAtomName
+Tk_GetAtomName
+_Tk_InternAtom
+Tk_InternAtom
+_Tk_BindEvent
+Tk_BindEvent
+_Tk_CreateBinding
+Tk_CreateBinding
+_Tk_CreateBindingTable
+Tk_CreateBindingTable
+_Tk_DeleteAllBindings
+Tk_DeleteAllBindings
+_Tk_DeleteBinding
+Tk_DeleteBinding
+_Tk_DeleteBindingTable
+Tk_DeleteBindingTable
+_Tk_GetAllBindings
+Tk_GetAllBindings
+_Tk_GetBinding
+Tk_GetBinding
+_Tk_EventCmd
+Tk_EventCmd
+_TkBindFree
+TkBindFree
+_TkBindInit
+TkBindInit
+_TkCopyAndGlobalEval
+TkCopyAndGlobalEval
+_TkKeysymToString
+TkKeysymToString
+_TkStringToKeysym
+TkStringToKeysym
+_Tk_DefineBitmap
+Tk_DefineBitmap
+_Tk_FreeBitmap
+Tk_FreeBitmap
+_Tk_GetBitmap
+Tk_GetBitmap
+_Tk_GetBitmapFromData
+Tk_GetBitmapFromData
+_Tk_NameOfBitmap
+Tk_NameOfBitmap
+_Tk_SizeOfBitmap
+Tk_SizeOfBitmap
+_Tk_ButtonCmd
+Tk_ButtonCmd
+_Tk_CheckbuttonCmd
+Tk_CheckbuttonCmd
+_Tk_LabelCmd
+Tk_LabelCmd
+_Tk_RadiobuttonCmd
+Tk_RadiobuttonCmd
+_tkArcType
+tkArcType
+_tkBitmapType
+tkBitmapType
+_tkImageType
+tkImageType
+_tkLineType
+tkLineType
+_TkFillPolygon
+TkFillPolygon
+_tkPolygonType
+tkPolygonType
+_Tk_CanvasPsBitmap
+Tk_CanvasPsBitmap
+_Tk_CanvasPsColor
+Tk_CanvasPsColor
+_Tk_CanvasPsFont
+Tk_CanvasPsFont
+_Tk_CanvasPsPath
+Tk_CanvasPsPath
+_Tk_CanvasPsStipple
+Tk_CanvasPsStipple
+_Tk_CanvasPsY
+Tk_CanvasPsY
+_TkGetProlog
+TkGetProlog
+_TkCanvPostscriptCmd
+TkCanvPostscriptCmd
+_tkTextType
+tkTextType
+_Tk_CanvasDrawableCoords
+Tk_CanvasDrawableCoords
+_Tk_CanvasGetCoord
+Tk_CanvasGetCoord
+_Tk_CanvasGetTextInfo
+Tk_CanvasGetTextInfo
+_Tk_CanvasSetStippleOrigin
+Tk_CanvasSetStippleOrigin
+_Tk_CanvasTagsParseProc
+Tk_CanvasTagsParseProc
+_Tk_CanvasTagsPrintProc
+Tk_CanvasTagsPrintProc
+_Tk_CanvasTkwin
+Tk_CanvasTkwin
+_Tk_CanvasWindowCoords
+Tk_CanvasWindowCoords
+_tkWindowType
+tkWindowType
+_Tk_CanvasEventuallyRedraw
+Tk_CanvasEventuallyRedraw
+_Tk_CreateItemType
+Tk_CreateItemType
+_Tk_GetItemTypes
+Tk_GetItemTypes
+_Tk_CanvasCmd
+Tk_CanvasCmd
+_Tk_ClipboardAppend
+Tk_ClipboardAppend
+_Tk_ClipboardClear
+Tk_ClipboardClear
+_Tk_ClipboardCmd
+Tk_ClipboardCmd
+_TkClipInit
+TkClipInit
+_Tk_BellCmd
+Tk_BellCmd
+_Tk_BindCmd
+Tk_BindCmd
+_Tk_BindtagsCmd
+Tk_BindtagsCmd
+_Tk_DestroyCmd
+Tk_DestroyCmd
+_Tk_LowerCmd
+Tk_LowerCmd
+_Tk_RaiseCmd
+Tk_RaiseCmd
+_Tk_TkCmd
+Tk_TkCmd
+_Tk_TkwaitCmd
+Tk_TkwaitCmd
+_Tk_UpdateCmd
+Tk_UpdateCmd
+_Tk_WinfoCmd
+Tk_WinfoCmd
+_TkBindEventProc
+TkBindEventProc
+_TkDeadAppCmd
+TkDeadAppCmd
+_TkFreeBindingTags
+TkFreeBindingTags
+_Tk_FreeColor
+Tk_FreeColor
+_Tk_GCForColor
+Tk_GCForColor
+_Tk_GetColor
+Tk_GetColor
+_Tk_GetColorByValue
+Tk_GetColorByValue
+_Tk_NameOfColor
+Tk_NameOfColor
+_TkCmapStressed
+TkCmapStressed
+_Tk_ConfigureInfo
+Tk_ConfigureInfo
+_Tk_ConfigureValue
+Tk_ConfigureValue
+_Tk_ConfigureWidget
+Tk_ConfigureWidget
+_Tk_FreeOptions
+Tk_FreeOptions
+_Tk_FreeCursor
+Tk_FreeCursor
+_Tk_GetCursor
+Tk_GetCursor
+_Tk_GetCursorFromData
+Tk_GetCursorFromData
+_Tk_NameOfCursor
+Tk_NameOfCursor
+_Tk_EntryCmd
+Tk_EntryCmd
+_Tk_CreateErrorHandler
+Tk_CreateErrorHandler
+_Tk_DeleteErrorHandler
+Tk_DeleteErrorHandler
+_Tk_CreateEventHandler
+Tk_CreateEventHandler
+_Tk_CreateGenericHandler
+Tk_CreateGenericHandler
+_Tk_DeleteEventHandler
+Tk_DeleteEventHandler
+_Tk_DeleteGenericHandler
+Tk_DeleteGenericHandler
+_Tk_HandleEvent
+Tk_HandleEvent
+_Tk_MainLoop
+Tk_MainLoop
+_Tk_QueueWindowEvent
+Tk_QueueWindowEvent
+_Tk_RestrictEvents
+Tk_RestrictEvents
+_TkCurrentTime
+TkCurrentTime
+_TkEventDeadWindow
+TkEventDeadWindow
+_TkQueueEventForAllChildren
+TkQueueEventForAllChildren
+_TkFreeFileFilters
+TkFreeFileFilters
+_TkInitFileFilters
+TkInitFileFilters
+_TkGetFileFilters
+TkGetFileFilters
+_Tk_FocusCmd
+Tk_FocusCmd
+_TkFocusDeadWindow
+TkFocusDeadWindow
+_TkFocusFilterEvent
+TkFocusFilterEvent
+_TkGetFocus
+TkGetFocus
+_Tk_FreeFontStruct
+Tk_FreeFontStruct
+_Tk_GetFontStruct
+Tk_GetFontStruct
+_Tk_NameOfFontStruct
+Tk_NameOfFontStruct
+_TkComputeTextGeometry
+TkComputeTextGeometry
+_TkDisplayChars
+TkDisplayChars
+_TkDisplayText
+TkDisplayText
+_TkMeasureChars
+TkMeasureChars
+_TkUnderlineChars
+TkUnderlineChars
+_Tk_FrameCmd
+Tk_FrameCmd
+_Tk_ToplevelCmd
+Tk_ToplevelCmd
+_TkCreateFrame
+TkCreateFrame
+_Tk_FreeGC
+Tk_FreeGC
+_Tk_GetGC
+Tk_GetGC
+_Tk_GeometryRequest
+Tk_GeometryRequest
+_Tk_MaintainGeometry
+Tk_MaintainGeometry
+_Tk_ManageGeometry
+Tk_ManageGeometry
+_Tk_SetInternalBorder
+Tk_SetInternalBorder
+_Tk_UnmaintainGeometry
+Tk_UnmaintainGeometry
+_Tk_GetAnchor
+Tk_GetAnchor
+_Tk_GetCapStyle
+Tk_GetCapStyle
+_Tk_GetJoinStyle
+Tk_GetJoinStyle
+_Tk_GetJustify
+Tk_GetJustify
+_Tk_GetPixels
+Tk_GetPixels
+_Tk_GetScreenMM
+Tk_GetScreenMM
+_Tk_GetUid
+Tk_GetUid
+_Tk_NameOfAnchor
+Tk_NameOfAnchor
+_Tk_NameOfCapStyle
+Tk_NameOfCapStyle
+_Tk_NameOfJoinStyle
+Tk_NameOfJoinStyle
+_Tk_NameOfJustify
+Tk_NameOfJustify
+_Tk_Grab
+Tk_Grab
+_Tk_Ungrab
+Tk_Ungrab
+_Tk_GrabCmd
+Tk_GrabCmd
+_TkChangeEventWindow
+TkChangeEventWindow
+_TkGrabDeadWindow
+TkGrabDeadWindow
+_TkGrabState
+TkGrabState
+_TkInOutEvents
+TkInOutEvents
+_TkPointerEvent
+TkPointerEvent
+_TkPositionInTree
+TkPositionInTree
+_Tk_GridCmd
+Tk_GridCmd
+_Tk_CreateImageType
+Tk_CreateImageType
+_Tk_DeleteImage
+Tk_DeleteImage
+_Tk_FreeImage
+Tk_FreeImage
+_Tk_GetImage
+Tk_GetImage
+_Tk_ImageChanged
+Tk_ImageChanged
+_Tk_NameOfImage
+Tk_NameOfImage
+_Tk_RedrawImage
+Tk_RedrawImage
+_Tk_SizeOfImage
+Tk_SizeOfImage
+_Tk_ImageCmd
+Tk_ImageCmd
+_TkDeleteAllImages
+TkDeleteAllImages
+_tkBitmapImageType
+tkBitmapImageType
+_TkGetBitmapData
+TkGetBitmapData
+_tkImgFmtGIF
+tkImgFmtGIF
+_tkImgFmtPPM
+tkImgFmtPPM
+_Tk_CreatePhotoImageFormat
+Tk_CreatePhotoImageFormat
+_Tk_FindPhoto
+Tk_FindPhoto
+_Tk_PhotoPutBlock
+Tk_PhotoPutBlock
+_Tk_PhotoPutZoomedBlock
+Tk_PhotoPutZoomedBlock
+_Tk_PhotoGetImage
+Tk_PhotoGetImage
+_Tk_PhotoBlank
+Tk_PhotoBlank
+_Tk_PhotoExpand
+Tk_PhotoExpand
+_Tk_PhotoGetSize
+Tk_PhotoGetSize
+_Tk_PhotoSetSize
+Tk_PhotoSetSize
+_tkPhotoImageType
+tkPhotoImageType
+_TkAlignImageData
+TkAlignImageData
+_Tk_ListboxCmd
+Tk_ListboxCmd
+_Tk_Main
+Tk_Main
+_Tk_MenuCmd
+Tk_MenuCmd
+_Tk_MenubuttonCmd
+Tk_MenubuttonCmd
+_Tk_MessageCmd
+Tk_MessageCmd
+_Tk_AddOption
+Tk_AddOption
+_Tk_GetOption
+Tk_GetOption
+_Tk_OptionCmd
+Tk_OptionCmd
+_TkOptionClassChanged
+TkOptionClassChanged
+_TkOptionDeadWindow
+TkOptionDeadWindow
+_Tk_PackCmd
+Tk_PackCmd
+_Tk_PlaceCmd
+Tk_PlaceCmd
+_tkRectangleType
+tkRectangleType
+_tkOvalType
+tkOvalType
+_Tk_ScaleCmd
+Tk_ScaleCmd
+_Tk_ScrollbarCmd
+Tk_ScrollbarCmd
+_Tk_ClearSelection
+Tk_ClearSelection
+_Tk_CreateSelHandler
+Tk_CreateSelHandler
+_Tk_DeleteSelHandler
+Tk_DeleteSelHandler
+_Tk_GetSelection
+Tk_GetSelection
+_Tk_OwnSelection
+Tk_OwnSelection
+_Tk_SelectionCmd
+Tk_SelectionCmd
+_TkSelDeadWindow
+TkSelDeadWindow
+_TkSelInit
+TkSelInit
+_pendingPtr
+pendingPtr
+_TkSelClearSelection
+TkSelClearSelection
+_TkSelDefaultSelection
+TkSelDefaultSelection
+_Tk_SetAppName
+Tk_SetAppName
+_Tk_SendCmd
+Tk_SendCmd
+_tkSendSerial
+tkSendSerial
+_TkGetInterpNames
+TkGetInterpNames
+_Tk_TextCmd
+Tk_TextCmd
+_tkTextDebug
+tkTextDebug
+_tkTextCharUid
+tkTextCharUid
+_tkTextDisabledUid
+tkTextDisabledUid
+_tkTextNoneUid
+tkTextNoneUid
+_tkTextNormalUid
+tkTextNormalUid
+_tkTextWordUid
+tkTextWordUid
+_TkTextGetTabs
+TkTextGetTabs
+_TkTextLostSelection
+TkTextLostSelection
+_tkBTreeDebug
+tkBTreeDebug
+_tkTextCharType
+tkTextCharType
+_tkTextToggleOnType
+tkTextToggleOnType
+_tkTextToggleOffType
+tkTextToggleOffType
+_TkBTreeCharTagged
+TkBTreeCharTagged
+_TkBTreeCheck
+TkBTreeCheck
+_TkBTreeCharsInLine
+TkBTreeCharsInLine
+_TkBTreeCreate
+TkBTreeCreate
+_TkBTreeDestroy
+TkBTreeDestroy
+_TkBTreeDeleteChars
+TkBTreeDeleteChars
+_TkBTreeFindLine
+TkBTreeFindLine
+_TkBTreeGetTags
+TkBTreeGetTags
+_TkBTreeInsertChars
+TkBTreeInsertChars
+_TkBTreeLineIndex
+TkBTreeLineIndex
+_TkBTreeLinkSegment
+TkBTreeLinkSegment
+_TkBTreeNextLine
+TkBTreeNextLine
+_TkBTreeNextTag
+TkBTreeNextTag
+_TkBTreeNumLines
+TkBTreeNumLines
+_TkBTreePreviousLine
+TkBTreePreviousLine
+_TkBTreePrevTag
+TkBTreePrevTag
+_TkBTreeStartSearch
+TkBTreeStartSearch
+_TkBTreeStartSearchBack
+TkBTreeStartSearchBack
+_TkBTreeTag
+TkBTreeTag
+_TkBTreeUnlinkSegment
+TkBTreeUnlinkSegment
+_TkTextChanged
+TkTextChanged
+_TkTextCharBbox
+TkTextCharBbox
+_TkTextCharLayoutProc
+TkTextCharLayoutProc
+_TkTextCreateDInfo
+TkTextCreateDInfo
+_TkTextDLineInfo
+TkTextDLineInfo
+_TkTextFreeDInfo
+TkTextFreeDInfo
+_TkTextEventuallyRepick
+TkTextEventuallyRepick
+_TkTextPixelIndex
+TkTextPixelIndex
+_TkTextRedrawRegion
+TkTextRedrawRegion
+_TkTextRedrawTag
+TkTextRedrawTag
+_TkTextRelayoutWindow
+TkTextRelayoutWindow
+_TkTextScanCmd
+TkTextScanCmd
+_TkTextSeeCmd
+TkTextSeeCmd
+_TkTextSetYView
+TkTextSetYView
+_TkTextXviewCmd
+TkTextXviewCmd
+_TkTextYviewCmd
+TkTextYviewCmd
+_TkTextGetIndex
+TkTextGetIndex
+_TkTextIndexBackChars
+TkTextIndexBackChars
+_TkTextIndexCmp
+TkTextIndexCmp
+_TkTextIndexForwChars
+TkTextIndexForwChars
+_TkTextIndexToSeg
+TkTextIndexToSeg
+_TkTextMakeIndex
+TkTextMakeIndex
+_TkTextPrintIndex
+TkTextPrintIndex
+_TkTextSegToOffset
+TkTextSegToOffset
+_tkTextLeftMarkType
+tkTextLeftMarkType
+_tkTextRightMarkType
+tkTextRightMarkType
+_TkTextInsertDisplayProc
+TkTextInsertDisplayProc
+_TkTextMarkCmd
+TkTextMarkCmd
+_TkTextMarkNameToIndex
+TkTextMarkNameToIndex
+_TkTextMarkSegToIndex
+TkTextMarkSegToIndex
+_TkTextSetMark
+TkTextSetMark
+_TkTextBindProc
+TkTextBindProc
+_TkTextCreateTag
+TkTextCreateTag
+_TkTextFreeTag
+TkTextFreeTag
+_TkTextPickCurrent
+TkTextPickCurrent
+_TkTextTagCmd
+TkTextTagCmd
+_TkTextWindowCmd
+TkTextWindowCmd
+_TkTextWindowIndex
+TkTextWindowIndex
+_TkBezierPoints
+TkBezierPoints
+_TkBezierScreenPoints
+TkBezierScreenPoints
+_TkGetButtPoints
+TkGetButtPoints
+_TkGetMiterPoints
+TkGetMiterPoints
+_TkIncludePoint
+TkIncludePoint
+_TkLineToArea
+TkLineToArea
+_TkLineToPoint
+TkLineToPoint
+_TkMakeBezierCurve
+TkMakeBezierCurve
+_TkMakeBezierPostscript
+TkMakeBezierPostscript
+_TkOvalToArea
+TkOvalToArea
+_TkOvalToPoint
+TkOvalToPoint
+_TkPolygonToArea
+TkPolygonToArea
+_TkPolygonToPoint
+TkPolygonToPoint
+_TkThickPolyLineToArea
+TkThickPolyLineToArea
+_Tk_DrawFocusHighlight
+Tk_DrawFocusHighlight
+_Tk_GetScrollInfo
+Tk_GetScrollInfo
+_TkFindStateNum
+TkFindStateNum
+_TkFindStateString
+TkFindStateString
+_Tk_FreeColormap
+Tk_FreeColormap
+_Tk_GetColormap
+Tk_GetColormap
+_Tk_GetVisual
+Tk_GetVisual
+_Tk_PreserveColormap
+Tk_PreserveColormap
+_Tk_ChangeWindowAttributes
+Tk_ChangeWindowAttributes
+_Tk_ConfigureWindow
+Tk_ConfigureWindow
+_Tk_CreateWindow
+Tk_CreateWindow
+_Tk_CreateWindowFromPath
+Tk_CreateWindowFromPath
+_Tk_DefineCursor
+Tk_DefineCursor
+_Tk_DestroyWindow
+Tk_DestroyWindow
+_Tk_DisplayName
+Tk_DisplayName
+_Tk_GetNumMainWindows
+Tk_GetNumMainWindows
+_Tk_IdToWindow
+Tk_IdToWindow
+_Tk_Init
+Tk_Init
+_Tk_MainWindow
+Tk_MainWindow
+_Tk_MakeWindowExist
+Tk_MakeWindowExist
+_Tk_MapWindow
+Tk_MapWindow
+_Tk_MoveResizeWindow
+Tk_MoveResizeWindow
+_Tk_MoveWindow
+Tk_MoveWindow
+_Tk_NameToWindow
+Tk_NameToWindow
+_Tk_ResizeWindow
+Tk_ResizeWindow
+_Tk_RestackWindow
+Tk_RestackWindow
+_Tk_SetClass
+Tk_SetClass
+_Tk_SetWindowBackground
+Tk_SetWindowBackground
+_Tk_SetWindowBackgroundPixmap
+Tk_SetWindowBackgroundPixmap
+_Tk_SetWindowBorder
+Tk_SetWindowBorder
+_Tk_SetWindowBorderWidth
+Tk_SetWindowBorderWidth
+_Tk_SetWindowBorderPixmap
+Tk_SetWindowBorderPixmap
+_Tk_SetWindowColormap
+Tk_SetWindowColormap
+_Tk_SetWindowVisual
+Tk_SetWindowVisual
+_Tk_StrictMotif
+Tk_StrictMotif
+_Tk_UndefineCursor
+Tk_UndefineCursor
+_Tk_UnmapWindow
+Tk_UnmapWindow
+_tkDisplayList
+tkDisplayList
+_tkActiveUid
+tkActiveUid
+_tkDisabledUid
+tkDisabledUid
+_tkMainWindowList
+tkMainWindowList
+_tkNormalUid
+tkNormalUid
+_TkCreateMainWindow
+TkCreateMainWindow
+_TkGetDisplay
+TkGetDisplay
diff --git a/tk/win/tkWin.h b/tk/win/tkWin.h
new file mode 100644
index 00000000000..40e7a24bb9d
--- /dev/null
+++ b/tk/win/tkWin.h
@@ -0,0 +1,64 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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.
+ *
+ *--------------------------------------------------------------
+ */
+
+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));
+
+# undef TCL_STORAGE_CLASS
+# define TCL_STORAGE_CLASS DLLIMPORT
+
+#endif /* _TKWIN */
diff --git a/tk/win/tkWin32Dll.c b/tk/win/tkWin32Dll.c
new file mode 100644
index 00000000000..7c2fec7c3b4
--- /dev/null
+++ b/tk/win/tkWin32Dll.c
@@ -0,0 +1,101 @@
+/*
+ * 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$
+ */
+
+#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));
+/* CYGNUS LOCAL */
+#ifdef __CYGWIN32__
+/* cygwin32 requires an impure pointer variable, which must be
+ explicitly initialized when the DLL starts up. */
+struct _reent *_impure_ptr;
+extern struct _reent *_imp__reent_data;
+#endif
+/* END CYGNUS LOCAL */
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DllEntryPoint --
+ *
+ * This wrapper function is used by Borland to invoke the
+ * initialization code for Tk. It simply calls the DllMain
+ * routine.
+ *
+ * Results:
+ * See DllMain.
+ *
+ * Side effects:
+ * See DllMain.
+ *
+ *----------------------------------------------------------------------
+ */
+
+BOOL APIENTRY
+DllEntryPoint(hInst, reason, reserved)
+ HINSTANCE hInst; /* Library instance handle. */
+ DWORD reason; /* Reason this function is being called. */
+ LPVOID reserved; /* Not used. */
+{
+ return DllMain(hInst, reason, reserved);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DllMain --
+ *
+ * DLL entry point.
+ *
+ * Results:
+ * TRUE on sucess, FALSE on failure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+BOOL APIENTRY
+DllMain(hInstance, reason, reserved)
+ HINSTANCE hInstance;
+ DWORD reason;
+ LPVOID reserved;
+{
+ /* CYGNUS LOCAL */
+#ifdef __CYGWIN32__
+ /* cygwin32 requires the impure data pointer to be initialized
+ when the DLL starts up. */
+ _impure_ptr = _imp__reent_data;
+#endif
+ /* END CYGNUS LOCAL */
+
+ /*
+ * 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);
+}
diff --git a/tk/win/tkWin3d.c b/tk/win/tkWin3d.c
new file mode 100644
index 00000000000..9e0bd586530
--- /dev/null
+++ b/tk/win/tkWin3d.c
@@ -0,0 +1,535 @@
+/*
+ * 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$
+ */
+
+#include <tk3d.h>
+#include <tkWinInt.h>
+
+/*
+ * This structure is used to keep track of the extra colors used by
+ * Windows 3d borders.
+ */
+
+typedef struct {
+ TkBorder info;
+ XColor *light2ColorPtr; /* System3dLight */
+ XColor *dark2ColorPtr; /* System3dDarkShadow */
+} WinBorder;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetBorder --
+ *
+ * This function allocates a new TkBorder structure.
+ *
+ * Results:
+ * Returns a newly allocated TkBorder.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkBorder *
+TkpGetBorder()
+{
+ WinBorder *borderPtr = (WinBorder *) ckalloc(sizeof(WinBorder));
+ borderPtr->light2ColorPtr = NULL;
+ borderPtr->dark2ColorPtr = NULL;
+ return (TkBorder *) borderPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpFreeBorder --
+ *
+ * This function frees any colors allocated by the platform
+ * specific part of this module.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May deallocate some colors.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpFreeBorder(borderPtr)
+ TkBorder *borderPtr;
+{
+ WinBorder *winBorderPtr = (WinBorder *) borderPtr;
+ if (winBorderPtr->light2ColorPtr) {
+ Tk_FreeColor(winBorderPtr->light2ColorPtr);
+ }
+ if (winBorderPtr->dark2ColorPtr) {
+ Tk_FreeColor(winBorderPtr->dark2ColorPtr);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_3DVerticalBevel --
+ *
+ * This procedure draws a vertical bevel along one side of
+ * an object. The bevel is always rectangular in shape:
+ * |||
+ * |||
+ * |||
+ * |||
+ * |||
+ * |||
+ * An appropriate shadow color is chosen for the bevel based
+ * on the leftBevel and relief arguments. Normally this
+ * procedure is called first, then Tk_3DHorizontalBevel is
+ * called next to draw neat corners.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Graphics are drawn in drawable.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_3DVerticalBevel(tkwin, drawable, border, x, y, width, height,
+ leftBevel, relief)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Drawable drawable; /* X window or pixmap in which to draw. */
+ Tk_3DBorder border; /* Token for border to draw. */
+ int x, y, width, height; /* Area of vertical bevel. */
+ int leftBevel; /* Non-zero means this bevel forms the
+ * left side of the object; 0 means it
+ * forms the right side. */
+ int relief; /* Kind of bevel to draw. For example,
+ * TK_RELIEF_RAISED means interior of
+ * object should appear higher than
+ * exterior. */
+{
+ TkBorder *borderPtr = (TkBorder *) border;
+ int left, right;
+ Display *display = Tk_Display(tkwin);
+ TkWinDCState state;
+ HDC dc = TkWinGetDrawableDC(display, drawable, &state);
+ int half;
+
+ if ((borderPtr->lightGC == None) && (relief != TK_RELIEF_FLAT)) {
+ TkpGetShadows(borderPtr, tkwin);
+ }
+
+ switch (relief) {
+ case TK_RELIEF_RAISED:
+ left = (leftBevel)
+ ? borderPtr->lightGC->foreground
+ : borderPtr->darkGC->foreground;
+ right = (leftBevel)
+ ? ((WinBorder *)borderPtr)->light2ColorPtr->pixel
+ : ((WinBorder *)borderPtr)->dark2ColorPtr->pixel;
+ break;
+ case TK_RELIEF_SUNKEN:
+ left = (leftBevel)
+ ? borderPtr->darkGC->foreground
+ : ((WinBorder *)borderPtr)->light2ColorPtr->pixel;
+ right = (leftBevel)
+ ? ((WinBorder *)borderPtr)->dark2ColorPtr->pixel
+ : borderPtr->lightGC->foreground;
+ break;
+ case TK_RELIEF_RIDGE:
+ left = borderPtr->lightGC->foreground;
+ right = borderPtr->darkGC->foreground;
+ break;
+ case TK_RELIEF_GROOVE:
+ left = borderPtr->darkGC->foreground;
+ right = borderPtr->lightGC->foreground;
+ break;
+ case TK_RELIEF_FLAT:
+ left = right = borderPtr->bgGC->foreground;
+ break;
+ case TK_RELIEF_SOLID:
+ left = right = RGB(0,0,0);
+ break;
+ }
+ half = width/2;
+ if (leftBevel && (width & 1)) {
+ half++;
+ }
+ TkWinFillRect(dc, x, y, half, height, left);
+ TkWinFillRect(dc, x+half, y, width-half, height, right);
+ TkWinReleaseDrawableDC(drawable, dc, &state);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_3DHorizontalBevel --
+ *
+ * This procedure draws a horizontal bevel along one side of
+ * an object. The bevel has mitered corners (depending on
+ * leftIn and rightIn arguments).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+Tk_3DHorizontalBevel(tkwin, drawable, border, x, y, width, height,
+ leftIn, rightIn, topBevel, relief)
+ Tk_Window tkwin; /* Window for which border was allocated. */
+ Drawable drawable; /* X window or pixmap in which to draw. */
+ Tk_3DBorder border; /* Token for border to draw. */
+ int x, y, width, height; /* Bounding box of area of bevel. Height
+ * gives width of border. */
+ int leftIn, rightIn; /* Describes whether the left and right
+ * edges of the bevel angle in or out as
+ * they go down. For example, if "leftIn"
+ * is true, the left side of the bevel
+ * looks like this:
+ * ___________
+ * __________
+ * _________
+ * ________
+ */
+ int topBevel; /* Non-zero means this bevel forms the
+ * top side of the object; 0 means it
+ * forms the bottom side. */
+ int relief; /* Kind of bevel to draw. For example,
+ * TK_RELIEF_RAISED means interior of
+ * object should appear higher than
+ * exterior. */
+{
+ TkBorder *borderPtr = (TkBorder *) border;
+ Display *display = Tk_Display(tkwin);
+ int bottom, halfway, x1, x2, x1Delta, x2Delta;
+ TkWinDCState state;
+ HDC dc = TkWinGetDrawableDC(display, drawable, &state);
+ int topColor, bottomColor;
+
+ if ((borderPtr->lightGC == None) && (relief != TK_RELIEF_FLAT)) {
+ TkpGetShadows(borderPtr, tkwin);
+ }
+
+ /*
+ * Compute a GC for the top half of the bevel and a GC for the
+ * bottom half (they're the same in many cases).
+ */
+
+ switch (relief) {
+ case TK_RELIEF_RAISED:
+ topColor = (topBevel)
+ ? borderPtr->lightGC->foreground
+ : borderPtr->darkGC->foreground;
+ bottomColor = (topBevel)
+ ? ((WinBorder *)borderPtr)->light2ColorPtr->pixel
+ : ((WinBorder *)borderPtr)->dark2ColorPtr->pixel;
+ break;
+ case TK_RELIEF_SUNKEN:
+ topColor = (topBevel)
+ ? borderPtr->darkGC->foreground
+ : ((WinBorder *)borderPtr)->light2ColorPtr->pixel;
+ bottomColor = (topBevel)
+ ? ((WinBorder *)borderPtr)->dark2ColorPtr->pixel
+ : borderPtr->lightGC->foreground;
+ break;
+ case TK_RELIEF_RIDGE:
+ topColor = borderPtr->lightGC->foreground;
+ bottomColor = borderPtr->darkGC->foreground;
+ break;
+ case TK_RELIEF_GROOVE:
+ topColor = borderPtr->darkGC->foreground;
+ bottomColor = borderPtr->lightGC->foreground;
+ break;
+ case TK_RELIEF_FLAT:
+ topColor = bottomColor = borderPtr->bgGC->foreground;
+ break;
+ case TK_RELIEF_SOLID:
+ topColor = bottomColor = RGB(0,0,0);
+ }
+
+ /*
+ * Compute various other geometry-related stuff.
+ */
+
+ if (leftIn) {
+ x1 = x+1;
+ } else {
+ x1 = x+height-1;
+ }
+ x2 = x+width;
+ if (rightIn) {
+ x2--;
+ } else {
+ x2 -= height;
+ }
+ x1Delta = (leftIn) ? 1 : -1;
+ x2Delta = (rightIn) ? -1 : 1;
+ halfway = y + height/2;
+ if (topBevel && (height & 1)) {
+ halfway++;
+ }
+ bottom = y + height;
+
+ /*
+ * Draw one line for each y-coordinate covered by the bevel.
+ */
+
+ for ( ; y < bottom; y++) {
+ /*
+ * In some weird cases (such as large border widths for skinny
+ * rectangles) x1 can be >= x2. Don't draw the lines
+ * in these cases.
+ */
+
+ if (x1 < x2) {
+ TkWinFillRect(dc, x1, y, x2-x1, 1,
+ (y < halfway) ? topColor : bottomColor);
+ }
+ x1 += x1Delta;
+ x2 += x2Delta;
+ }
+ TkWinReleaseDrawableDC(drawable, dc, &state);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetShadows --
+ *
+ * This procedure computes the shadow colors for a 3-D border
+ * and fills in the corresponding fields of the Border structure.
+ * It's called lazily, so that the colors aren't allocated until
+ * something is actually drawn with them. That way, if a border
+ * is only used for flat backgrounds the shadow colors will
+ * never be allocated.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The lightGC and darkGC fields in borderPtr get filled in,
+ * if they weren't already.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpGetShadows(borderPtr, tkwin)
+ TkBorder *borderPtr; /* Information about border. */
+ Tk_Window tkwin; /* Window where border will be used for
+ * drawing. */
+{
+ XColor lightColor, darkColor;
+ int tmp1, tmp2;
+ XGCValues gcValues;
+
+ if (borderPtr->lightGC != None) {
+ return;
+ }
+
+ /*
+ * Handle the special case of the default system colors.
+ */
+
+ if ((TkWinIndexOfColor(borderPtr->bgColorPtr) == COLOR_3DFACE)
+ || (TkWinIndexOfColor(borderPtr->bgColorPtr) == COLOR_WINDOW)) {
+ borderPtr->darkColorPtr = Tk_GetColor(NULL, tkwin,
+ Tk_GetUid("SystemButtonShadow"));
+ gcValues.foreground = borderPtr->darkColorPtr->pixel;
+ borderPtr->darkGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ borderPtr->lightColorPtr = Tk_GetColor(NULL, tkwin,
+ Tk_GetUid("SystemButtonHighlight"));
+ gcValues.foreground = borderPtr->lightColorPtr->pixel;
+ borderPtr->lightGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ ((WinBorder*)borderPtr)->dark2ColorPtr = Tk_GetColor(NULL, tkwin,
+ Tk_GetUid("System3dDarkShadow"));
+ ((WinBorder*)borderPtr)->light2ColorPtr = Tk_GetColor(NULL, tkwin,
+ Tk_GetUid("System3dLight"));
+ return;
+ } else {
+ darkColor.red = 0;
+ darkColor.green = 0;
+ darkColor.blue = 0;
+ ((WinBorder*)borderPtr)->dark2ColorPtr = Tk_GetColorByValue(tkwin,
+ &darkColor);
+ lightColor = *(borderPtr->bgColorPtr);
+ ((WinBorder*)borderPtr)->light2ColorPtr = Tk_GetColorByValue(tkwin,
+ &lightColor);
+ }
+
+ /*
+ * First, handle the case of a color display with lots of colors.
+ * The shadow colors get computed using whichever formula results
+ * in the greatest change in color:
+ * 1. Lighter shadow is half-way to white, darker shadow is half
+ * way to dark.
+ * 2. Lighter shadow is 40% brighter than background, darker shadow
+ * is 40% darker than background.
+ */
+
+ if (Tk_Depth(tkwin) >= 6) {
+ /*
+ * This is a color display with lots of colors. For the dark
+ * shadow, cut 40% from each of the background color components.
+ * For the light shadow, boost each component by 40% or half-way
+ * to white, whichever is greater (the first approach works
+ * better for unsaturated colors, the second for saturated ones).
+ */
+
+ darkColor.red = (60 * (int) borderPtr->bgColorPtr->red)/100;
+ darkColor.green = (60 * (int) borderPtr->bgColorPtr->green)/100;
+ darkColor.blue = (60 * (int) borderPtr->bgColorPtr->blue)/100;
+ borderPtr->darkColorPtr = Tk_GetColorByValue(tkwin, &darkColor);
+ gcValues.foreground = borderPtr->darkColorPtr->pixel;
+ borderPtr->darkGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+
+ /*
+ * Compute the colors using integers, not using lightColor.red
+ * etc.: these are shorts and may have problems with integer
+ * overflow.
+ */
+
+ tmp1 = (14 * (int) borderPtr->bgColorPtr->red)/10;
+ if (tmp1 > MAX_INTENSITY) {
+ tmp1 = MAX_INTENSITY;
+ }
+ tmp2 = (MAX_INTENSITY + (int) borderPtr->bgColorPtr->red)/2;
+ lightColor.red = (tmp1 > tmp2) ? tmp1 : tmp2;
+ tmp1 = (14 * (int) borderPtr->bgColorPtr->green)/10;
+ if (tmp1 > MAX_INTENSITY) {
+ tmp1 = MAX_INTENSITY;
+ }
+ tmp2 = (MAX_INTENSITY + (int) borderPtr->bgColorPtr->green)/2;
+ lightColor.green = (tmp1 > tmp2) ? tmp1 : tmp2;
+ tmp1 = (14 * (int) borderPtr->bgColorPtr->blue)/10;
+ if (tmp1 > MAX_INTENSITY) {
+ tmp1 = MAX_INTENSITY;
+ }
+ tmp2 = (MAX_INTENSITY + (int) borderPtr->bgColorPtr->blue)/2;
+ lightColor.blue = (tmp1 > tmp2) ? tmp1 : tmp2;
+ borderPtr->lightColorPtr = Tk_GetColorByValue(tkwin, &lightColor);
+ gcValues.foreground = borderPtr->lightColorPtr->pixel;
+ borderPtr->lightGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ return;
+ }
+
+ if (borderPtr->shadow == None) {
+ borderPtr->shadow = Tk_GetBitmap((Tcl_Interp *) NULL, tkwin,
+ Tk_GetUid("gray50"));
+ if (borderPtr->shadow == None) {
+ panic("TkpGetShadows couldn't allocate bitmap for border");
+ }
+ }
+ if (borderPtr->visual->map_entries > 2) {
+ /*
+ * This isn't a monochrome display, but the colormap either
+ * ran out of entries or didn't have very many to begin with.
+ * Generate the light shadows with a white stipple and the
+ * dark shadows with a black stipple.
+ */
+
+ gcValues.foreground = borderPtr->bgColorPtr->pixel;
+ gcValues.background = BlackPixelOfScreen(borderPtr->screen);
+ gcValues.stipple = borderPtr->shadow;
+ gcValues.fill_style = FillOpaqueStippled;
+ borderPtr->darkGC = Tk_GetGC(tkwin,
+ GCForeground|GCBackground|GCStipple|GCFillStyle, &gcValues);
+ gcValues.foreground = WhitePixelOfScreen(borderPtr->screen);
+ gcValues.background = borderPtr->bgColorPtr->pixel;
+ borderPtr->lightGC = Tk_GetGC(tkwin,
+ GCForeground|GCBackground|GCStipple|GCFillStyle, &gcValues);
+ return;
+ }
+
+ /*
+ * This is just a measly monochrome display, hardly even worth its
+ * existence on this earth. Make one shadow a 50% stipple and the
+ * other the opposite of the background.
+ */
+
+ gcValues.foreground = WhitePixelOfScreen(borderPtr->screen);
+ gcValues.background = BlackPixelOfScreen(borderPtr->screen);
+ gcValues.stipple = borderPtr->shadow;
+ gcValues.fill_style = FillOpaqueStippled;
+ borderPtr->lightGC = Tk_GetGC(tkwin,
+ GCForeground|GCBackground|GCStipple|GCFillStyle, &gcValues);
+ if (borderPtr->bgColorPtr->pixel
+ == WhitePixelOfScreen(borderPtr->screen)) {
+ gcValues.foreground = BlackPixelOfScreen(borderPtr->screen);
+ borderPtr->darkGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ } else {
+ borderPtr->darkGC = borderPtr->lightGC;
+ borderPtr->lightGC = Tk_GetGC(tkwin, GCForeground, &gcValues);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinGetBorderPixels --
+ *
+ * This routine returns the 5 COLORREFs used to draw a given
+ * 3d border.
+ *
+ * Results:
+ * Returns the colors in the specified array.
+ *
+ * Side effects:
+ * May cause the remaining colors to be allocated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+COLORREF
+TkWinGetBorderPixels(tkwin, border, which)
+ Tk_Window tkwin;
+ Tk_3DBorder border;
+ int which; /* One of TK_3D_FLAT_GC, TK_3D_LIGHT_GC,
+ * TK_3D_DARK_GC, TK_3D_LIGHT2, TK_3D_DARK2 */
+{
+ WinBorder *borderPtr = (WinBorder *) border;
+
+ if (borderPtr->info.lightGC == None) {
+ TkpGetShadows(&borderPtr->info, tkwin);
+ }
+ switch (which) {
+ case TK_3D_FLAT_GC:
+ return borderPtr->info.bgColorPtr->pixel;
+ case TK_3D_LIGHT_GC:
+ if (borderPtr->info.lightColorPtr == NULL) {
+ return WhitePixelOfScreen(borderPtr->info.screen);
+ }
+ return borderPtr->info.lightColorPtr->pixel;
+ case TK_3D_DARK_GC:
+ if (borderPtr->info.darkColorPtr == NULL) {
+ return BlackPixelOfScreen(borderPtr->info.screen);
+ }
+ return borderPtr->info.darkColorPtr->pixel;
+ case TK_3D_LIGHT2:
+ return borderPtr->light2ColorPtr->pixel;
+ case TK_3D_DARK2:
+ return borderPtr->dark2ColorPtr->pixel;
+ }
+ return 0;
+}
diff --git a/tk/win/tkWinButton.c b/tk/win/tkWinButton.c
new file mode 100644
index 00000000000..3335d66d88b
--- /dev/null
+++ b/tk/win/tkWinButton.c
@@ -0,0 +1,870 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#define OEMRESOURCE
+#include "tkWinInt.h"
+#include "tkButton.h"
+
+/*
+ * These macros define the base style flags for the different button types.
+ */
+
+#define LABEL_STYLE (BS_OWNERDRAW | WS_CHILD | WS_VISIBLE | WS_CLIPSIBLINGS)
+#define PUSH_STYLE (BS_OWNERDRAW | BS_PUSHBUTTON | WS_CHILD | WS_VISIBLE | WS_CLIPSIBLINGS)
+#define CHECK_STYLE (BS_OWNERDRAW | BS_CHECKBOX | WS_CHILD | WS_VISIBLE | WS_CLIPSIBLINGS)
+#define RADIO_STYLE (BS_OWNERDRAW | BS_RADIOBUTTON | WS_CHILD | WS_VISIBLE | WS_CLIPSIBLINGS)
+
+static DWORD buttonStyles[] = {
+ LABEL_STYLE, PUSH_STYLE, CHECK_STYLE, RADIO_STYLE
+};
+
+/*
+ * Declaration of Windows specific button structure.
+ */
+
+typedef struct WinButton {
+ TkButton info; /* Generic button info. */
+ WNDPROC oldProc; /* Old window procedure. */
+ HWND hwnd; /* Current window handle. */
+ Pixmap pixmap; /* Bitmap for rendering the button. */
+ int pixFlags; /* Button flags for pixmap field. */
+ DWORD style; /* Window style flags. */
+} WinButton;
+
+
+/*
+ * The following macro reverses the order of RGB bytes to convert
+ * between RGBQUAD and COLORREF values.
+ */
+
+#define FlipColor(rgb) (RGB(GetBValue(rgb),GetGValue(rgb),GetRValue(rgb)))
+
+/*
+ * The following enumeration defines the meaning of the palette entries
+ * in the "buttons" image used to draw checkbox and radiobutton indicators.
+ */
+
+enum {
+ PAL_CHECK = 0,
+ PAL_TOP_OUTER = 1,
+ PAL_BOTTOM_OUTER = 2,
+ 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));
+
+/* CYGNUS LOCAL. */
+static void TkpRealDisplayButton _ANSI_ARGS_((ClientData, int));
+
+/*
+ * The class procedure table for the button widgets.
+ */
+
+TkClassProcs tkpButtonProcs = {
+ CreateProc, /* createProc. */
+ TkButtonWorldChanged, /* geometryProc. */
+ NULL /* modalProc. */
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitBoxes --
+ *
+ * This function load the Tk 3d button bitmap. "buttons" is a 16
+ * color bitmap that is laid out such that the top row contains
+ * the 4 checkbox images, and the bottom row contains the radio
+ * button images. Note that the bitmap is stored in bottom-up
+ * format. Also, the first seven palette entries are used to
+ * identify the different parts of the bitmaps so we can do the
+ * appropriate color mappings based on the current button colors.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Loads the "buttons" resource.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitBoxes()
+{
+ /*
+ * For DLLs like Tk, the HINSTANCE is the same as the HMODULE.
+ */
+
+ 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;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCreateButton --
+ *
+ * Allocate a new TkButton structure.
+ *
+ * Results:
+ * Returns a newly allocated TkButton structure.
+ *
+ * Side effects:
+ * Registers an event handler for the widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkButton *
+TkpCreateButton(tkwin)
+ Tk_Window tkwin;
+{
+ WinButton *butPtr;
+
+ if (!initialized) {
+ UpdateButtonDefaults();
+ initialized = 1;
+ }
+
+ butPtr = (WinButton *)ckalloc(sizeof(WinButton));
+ butPtr->hwnd = NULL;
+ /* CYGNUS LOCAL: Use the pixmap field. */
+ butPtr->pixmap = 0;
+ butPtr->pixFlags = 0;
+ return (TkButton *) butPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateProc --
+ *
+ * This function creates a new Button control, subclasses
+ * the instance, and generates a new Window object.
+ *
+ * Results:
+ * Returns the newly allocated Window object, or None on failure.
+ *
+ * Side effects:
+ * Causes a new Button control to come into existence.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Window
+CreateProc(tkwin, parentWin, instanceData)
+ Tk_Window tkwin; /* Token for window. */
+ Window parentWin; /* Parent of new window. */
+ ClientData instanceData; /* Button instance data. */
+{
+ Window window;
+ HWND parent;
+ char *class;
+ WinButton *butPtr = (WinButton *)instanceData;
+
+ parent = Tk_GetHWND(parentWin);
+ if (butPtr->info.type == TYPE_LABEL) {
+ class = "STATIC";
+ butPtr->style = SS_OWNERDRAW | WS_CHILD | WS_VISIBLE | WS_CLIPSIBLINGS;
+ } else {
+ class = "BUTTON";
+ butPtr->style = BS_OWNERDRAW | WS_CHILD | WS_VISIBLE | WS_CLIPSIBLINGS;
+ }
+ butPtr->hwnd = CreateWindow(class, NULL, butPtr->style,
+ Tk_X(tkwin), Tk_Y(tkwin), Tk_Width(tkwin), Tk_Height(tkwin),
+ parent, NULL, Tk_GetHINSTANCE(), NULL);
+ SetWindowPos(butPtr->hwnd, HWND_TOP, 0, 0, 0, 0,
+ SWP_NOACTIVATE | SWP_NOMOVE | SWP_NOSIZE);
+ butPtr->oldProc = (WNDPROC)SetWindowLong(butPtr->hwnd, GWL_WNDPROC,
+ (DWORD) ButtonProc);
+
+ window = Tk_AttachHWND(tkwin, butPtr->hwnd);
+ return window;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyButton --
+ *
+ * Free data structures associated with the button control.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Restores the default control state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyButton(butPtr)
+ TkButton *butPtr;
+{
+ WinButton *winButPtr = (WinButton *)butPtr;
+ HWND hwnd = winButPtr->hwnd;
+ if (hwnd) {
+ SetWindowLong(hwnd, GWL_WNDPROC, (DWORD) winButPtr->oldProc);
+ }
+ /* CYGNUS LOCAL: Free the pixmap. */
+ if (winButPtr->pixmap != 0) {
+ Tk_FreePixmap(butPtr->display, winButPtr->pixmap);
+ winButPtr->pixmap = 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDisplayButton --
+ *
+ * This procedure is invoked to display a button widget. It is
+ * normally invoked as an idle handler.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen. The REDRAW_PENDING flag
+ * is cleared.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDisplayButton(clientData)
+ ClientData clientData; /* Information about widget. */
+{
+ /* CYGNUS LOCAL: Use a subroutine. */
+ TkpRealDisplayButton(clientData, 1);
+}
+
+/* CYGNUS LOCAL: This is the old TkpDisplayButton, with a force
+ argument added. The idea is to speed up redrawing a button due to
+ a WM_PAINT event by saving a pixmap of the image. */
+
+static void
+TkpRealDisplayButton(clientData, force)
+ ClientData clientData;
+ int force;
+{
+ TkWinDCState state;
+ HDC dc;
+ 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 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. */
+
+ /* CYGNUS LOCAL: If the generic code has asked us to draw
+ ourselves, force a full refresh. */
+ if ((butPtr->flags & REDRAW_PENDING) != 0) {
+ force = 1;
+ }
+
+ butPtr->flags &= ~REDRAW_PENDING;
+ if ((butPtr->tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ /* CYGNUS LOCAL: Use the saved pixmap if we can. */
+ if (! force && ((WinButton *)butPtr)->pixmap != 0
+ && ((WinButton *)butPtr)->pixFlags == butPtr->flags) {
+ XCopyArea(butPtr->display, ((WinButton *)butPtr)->pixmap,
+ Tk_WindowId(tkwin), butPtr->copyGC, 0, 0,
+ (unsigned) Tk_Width(tkwin), (unsigned) Tk_Height(tkwin),
+ 0, 0);
+ return;
+ }
+
+ if (((WinButton *)butPtr)->pixmap != 0) {
+ Tk_FreePixmap(butPtr->display, ((WinButton*)butPtr)->pixmap);
+ ((WinButton*)butPtr)->pixmap = 0;
+ }
+
+ 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 {
+ offset = 0;
+ }
+ }
+
+ /*
+ * 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, 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;
+
+ if (relief == TK_RELIEF_SUNKEN) {
+ x += offset;
+ y += offset;
+ }
+ if (butPtr->image != NULL) {
+ if ((butPtr->selectImage != NULL) && (butPtr->flags & SELECTED)) {
+ Tk_RedrawImage(butPtr->selectImage, 0, 0, width, height,
+ pixmap, x, y);
+ } else {
+ Tk_RedrawImage(butPtr->image, 0, 0, width, height, pixmap,
+ x, y);
+ }
+ } else {
+ XSetClipOrigin(butPtr->display, gc, x, y);
+ XCopyPlane(butPtr->display, butPtr->bitmap, pixmap, gc, 0, 0,
+ (unsigned int) width, (unsigned int) height, x, y, 1);
+ XSetClipOrigin(butPtr->display, gc, 0, 0);
+ }
+ y += height/2;
+ } else if (butPtr->bitmap != None) {
+ Tk_SizeOfBitmap(butPtr->display, butPtr->bitmap, &width, &height);
+ goto imageOrBitmap;
+ } else {
+ RECT rect;
+ TkComputeAnchor(butPtr->anchor, tkwin, butPtr->padX, butPtr->padY,
+ butPtr->indicatorSpace + butPtr->textWidth, butPtr->textHeight,
+ &x, &y);
+
+ x += butPtr->indicatorSpace;
+
+ if (relief == TK_RELIEF_SUNKEN) {
+ x += offset;
+ y += offset;
+ }
+ Tk_DrawTextLayout(butPtr->display, pixmap, gc, butPtr->textLayout,
+ x, y, 0, -1);
+ Tk_UnderlineTextLayout(butPtr->display, pixmap, gc,
+ butPtr->textLayout, x, y, butPtr->underline);
+
+ /*
+ * Draw the focus ring. If this is a push button then we need to put
+ * it around the inner edge of the border, otherwise we put it around
+ * the text.
+ */
+
+ if (butPtr->flags & GOT_FOCUS && butPtr->type != TYPE_LABEL) {
+ dc = TkWinGetDrawableDC(butPtr->display, pixmap, &state);
+ if (butPtr->type == TYPE_BUTTON || !butPtr->indicatorOn) {
+ rect.top = butPtr->borderWidth + 1 + defaultWidth;
+ rect.left = rect.top;
+ rect.right = Tk_Width(tkwin) - rect.left;
+ rect.bottom = Tk_Height(tkwin) - rect.top;
+ } else {
+ rect.top = y-2;
+ rect.left = x-2;
+ rect.right = x+butPtr->textWidth + 1;
+ rect.bottom = y+butPtr->textHeight + 1;
+ }
+ SetTextColor(dc, gc->foreground);
+ SetBkColor(dc, gc->background);
+ DrawFocusRect(dc, &rect);
+ TkWinReleaseDrawableDC(pixmap, dc, &state);
+ }
+ y += butPtr->textHeight/2;
+ }
+
+ /*
+ * 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,
+ butPtr->inset, butPtr->inset,
+ (unsigned) (Tk_Width(tkwin) - 2*butPtr->inset),
+ (unsigned) (Tk_Height(tkwin) - 2*butPtr->inset));
+ if ((butPtr->flags & SELECTED) && !butPtr->indicatorOn
+ && (butPtr->selectBorder != NULL)) {
+ XSetForeground(butPtr->display, butPtr->disabledGC,
+ Tk_3DBorderColor(butPtr->normalBorder)->pixel);
+ }
+ }
+
+ /*
+ * Draw the border and traversal highlight last. This way, if the
+ * button's contents overflow they'll be covered up by the border.
+ */
+
+ if (relief != TK_RELIEF_FLAT) {
+ Tk_Draw3DRectangle(tkwin, pixmap, border,
+ defaultWidth, defaultWidth,
+ Tk_Width(tkwin) - 2*defaultWidth,
+ Tk_Height(tkwin) - 2*defaultWidth,
+ butPtr->borderWidth, relief);
+ }
+ if (defaultWidth != 0) {
+ dc = TkWinGetDrawableDC(butPtr->display, pixmap, &state);
+ TkWinFillRect(dc, 0, 0, Tk_Width(tkwin), defaultWidth,
+ butPtr->highlightColorPtr->pixel);
+ TkWinFillRect(dc, 0, 0, defaultWidth, Tk_Height(tkwin),
+ butPtr->highlightColorPtr->pixel);
+ TkWinFillRect(dc, 0, Tk_Height(tkwin) - defaultWidth,
+ Tk_Width(tkwin), defaultWidth,
+ butPtr->highlightColorPtr->pixel);
+ TkWinFillRect(dc, Tk_Width(tkwin) - defaultWidth, 0,
+ defaultWidth, Tk_Height(tkwin),
+ butPtr->highlightColorPtr->pixel);
+ TkWinReleaseDrawableDC(pixmap, dc, &state);
+ }
+
+ /*
+ * Copy the information from the off-screen pixmap onto the screen,
+ * then delete the pixmap.
+ */
+
+ XCopyArea(butPtr->display, pixmap, Tk_WindowId(tkwin),
+ butPtr->copyGC, 0, 0, (unsigned) Tk_Width(tkwin),
+ (unsigned) Tk_Height(tkwin), 0, 0);
+
+ /* CYGNUS LOCAL: Don't free the pixmap; save it for the next
+ redisplay.
+ Tk_FreePixmap(butPtr->display, pixmap);
+ */
+ ((WinButton*)butPtr)->pixmap = pixmap;
+ ((WinButton*)butPtr)->pixFlags = butPtr->flags;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpComputeButtonGeometry --
+ *
+ * After changes in a button's text or bitmap, this procedure
+ * recomputes the button's geometry and passes this information
+ * along to the geometry manager for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The button's window may change size.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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.
+ */
+
+ if (butPtr->type != TYPE_LABEL) {
+ butPtr->inset += 3;
+ }
+ }
+
+ /*
+ * When issuing the geometry request, add extra space for the indicator,
+ * if any, and for the border and padding, plus an extra pixel 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->type >= TYPE_CHECK_BUTTON) && !butPtr->indicatorOn)) {
+ width += 1;
+ height += 1;
+ }
+ Tk_GeometryRequest(butPtr->tkwin, (int) (width + butPtr->indicatorSpace
+ + 2*butPtr->inset), (int) (height + 2*butPtr->inset));
+ Tk_SetInternalBorder(butPtr->tkwin, butPtr->inset);
+
+ /* CYGNUS LOCAL: Discard any saved pixmap. */
+ if (((WinButton*)butPtr)->pixmap != 0) {
+ Tk_FreePixmap(butPtr->display, ((WinButton*)butPtr)->pixmap);
+ ((WinButton*)butPtr)->pixmap = 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ButtonProc --
+ *
+ * This function is call by Windows whenever an event occurs on
+ * a button control created by Tk.
+ *
+ * Results:
+ * Standard Windows return value.
+ *
+ * Side effects:
+ * May generate events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static LRESULT CALLBACK
+ButtonProc(hwnd, message, wParam, lParam)
+ HWND hwnd;
+ UINT message;
+ WPARAM wParam;
+ LPARAM lParam;
+{
+ LRESULT result;
+ WinButton *butPtr;
+ Tk_Window tkwin = Tk_HWNDToWindow(hwnd);
+
+ if (tkwin == NULL) {
+ panic("ButtonProc called on an invalid HWND");
+ }
+ butPtr = (WinButton *)((TkWindow*)tkwin)->instanceData;
+
+ switch(message) {
+ case WM_ERASEBKGND:
+ return 0;
+
+ case BM_GETCHECK:
+ if (((butPtr->info.type == TYPE_CHECK_BUTTON)
+ || (butPtr->info.type == TYPE_RADIO_BUTTON))
+ && butPtr->info.indicatorOn) {
+ return (butPtr->info.flags & SELECTED)
+ ? BST_CHECKED : BST_UNCHECKED;
+ }
+ return 0;
+
+ case BM_GETSTATE: {
+ DWORD state = 0;
+ if (((butPtr->info.type == TYPE_CHECK_BUTTON)
+ || (butPtr->info.type == TYPE_RADIO_BUTTON))
+ && butPtr->info.indicatorOn) {
+ state = (butPtr->info.flags & SELECTED)
+ ? BST_CHECKED : BST_UNCHECKED;
+ }
+ if (butPtr->info.flags & GOT_FOCUS) {
+ state |= BST_FOCUS;
+ }
+ return state;
+ }
+ case WM_ENABLE:
+ break;
+
+ case WM_PAINT: {
+ PAINTSTRUCT ps;
+ BeginPaint(hwnd, &ps);
+ EndPaint(hwnd, &ps);
+ /* CYGNUS LOCAL: Don't force the button to be recomputed. */
+ TkpRealDisplayButton((ClientData)butPtr, 0);
+ 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);
+ }
+ Tcl_Release((ClientData)interp);
+ }
+ Tcl_ServiceAll();
+ return 0;
+ }
+
+ default:
+ if (Tk_TranslateWinEvent(hwnd, message, wParam, lParam, &result)) {
+ return result;
+ }
+ }
+ return DefWindowProc(hwnd, message, wParam, lParam);
+}
diff --git a/tk/win/tkWinClipboard.c b/tk/win/tkWinClipboard.c
new file mode 100644
index 00000000000..d7d73d71995
--- /dev/null
+++ b/tk/win/tkWinClipboard.c
@@ -0,0 +1,291 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkSelGetSelection(interp, tkwin, selection, target, proc, clientData)
+ Tcl_Interp *interp; /* Interpreter to use for reporting
+ * errors. */
+ Tk_Window tkwin; /* Window on whose behalf to retrieve
+ * the selection (determines display
+ * from which to retrieve). */
+ Atom selection; /* Selection to retrieve. */
+ 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);
+ if (handle != NULL) {
+ data = GlobalLock(handle);
+ length = strlen(data);
+ buffer = ckalloc(length+1);
+ destPtr = buffer;
+ while (*data != '\0') {
+ if (*data != '\r') {
+ *destPtr = *data;
+ destPtr++;
+ }
+ data++;
+ }
+ *destPtr = '\0';
+ GlobalUnlock(handle);
+ CloseClipboard();
+ result = (*proc)(clientData, interp, buffer);
+ ckfree(buffer);
+ return result;
+ }
+ CloseClipboard();
+ }
+ }
+
+ Tcl_AppendResult(interp, Tk_GetAtomName(tkwin, selection),
+ " selection doesn't exist or form \"", Tk_GetAtomName(tkwin, target),
+ "\" not defined", (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSetSelectionOwner --
+ *
+ * This function claims ownership of the specified selection.
+ * If the selection is CLIPBOARD, then we empty the system
+ * clipboard.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Empties the system clipboard, and claims ownership.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XSetSelectionOwner(display, selection, owner, time)
+ Display* display;
+ Atom selection;
+ Window owner;
+ Time time;
+{
+ HWND hwnd = owner ? TkWinGetHWND(owner) : NULL;
+ 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.
+ */
+
+ if (GetClipboardOwner() != hwnd) {
+ OpenClipboard(hwnd);
+ EmptyClipboard();
+ SetClipboardData(CF_TEXT, NULL);
+ CloseClipboard();
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinClipboardRender --
+ *
+ * This function supplies the contents of the clipboard in
+ * response to a WM_RENDERFORMAT message.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets the contents of the clipboard.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelUpdateClipboard --
+ *
+ * This function is called to force the clipboard to be updated
+ * after new data is added.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Clears the current contents of the clipboard.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSelUpdateClipboard(winPtr, targetPtr)
+ TkWindow *winPtr;
+ TkClipboardTarget *targetPtr;
+{
+ HWND hwnd = TkWinGetHWND(winPtr->window);
+
+ OpenClipboard(hwnd);
+ EmptyClipboard();
+ SetClipboardData(CF_TEXT, NULL);
+ CloseClipboard();
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkSelEventProc --
+ *
+ * This procedure is invoked whenever a selection-related
+ * event occurs.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Lots: depends on the type of event.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkSelEventProc(tkwin, eventPtr)
+ Tk_Window tkwin; /* Window for which event was
+ * targeted. */
+ register XEvent *eventPtr; /* X event: either SelectionClear,
+ * SelectionRequest, or
+ * SelectionNotify. */
+{
+ if (eventPtr->type == SelectionClear) {
+ TkSelClearSelection(tkwin, eventPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSelPropProc --
+ *
+ * This procedure is invoked when property-change events
+ * occur on windows not known to the toolkit. This is a stub
+ * function under Windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSelPropProc(eventPtr)
+ register XEvent *eventPtr; /* X PropertyChange event. */
+{
+}
diff --git a/tk/win/tkWinColor.c b/tk/win/tkWinColor.c
new file mode 100644
index 00000000000..20dd3ed13a0
--- /dev/null
+++ b/tk/win/tkWinColor.c
@@ -0,0 +1,643 @@
+/*
+ * 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$
+ */
+
+#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.
+ */
+
+typedef struct {
+ char *name;
+ int index;
+} SystemColorEntry;
+
+
+static SystemColorEntry sysColors[] = {
+ "3dDarkShadow", COLOR_3DDKSHADOW,
+ "3dLight", COLOR_3DLIGHT,
+ "ActiveBorder", COLOR_ACTIVEBORDER,
+ "ActiveCaption", COLOR_ACTIVECAPTION,
+ "AppWorkspace", COLOR_APPWORKSPACE,
+ "Background", COLOR_BACKGROUND,
+ "ButtonFace", COLOR_BTNFACE,
+ "ButtonHighlight", COLOR_BTNHIGHLIGHT,
+ "ButtonShadow", COLOR_BTNSHADOW,
+ "ButtonText", COLOR_BTNTEXT,
+ "CaptionText", COLOR_CAPTIONTEXT,
+ "DisabledText", COLOR_GRAYTEXT,
+ "GrayText", COLOR_GRAYTEXT,
+ "Highlight", COLOR_HIGHLIGHT,
+ "HighlightText", COLOR_HIGHLIGHTTEXT,
+ "InactiveBorder", COLOR_INACTIVEBORDER,
+ "InactiveCaption", COLOR_INACTIVECAPTION,
+ "InactiveCaptionText", COLOR_INACTIVECAPTIONTEXT,
+ "InfoBackground", COLOR_INFOBK,
+ "InfoText", COLOR_INFOTEXT,
+ "Menu", COLOR_MENU,
+ "MenuText", COLOR_MENUTEXT,
+ "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));
+static int GetColorByName _ANSI_ARGS_((char *name, XColor *color));
+static int GetColorByValue _ANSI_ARGS_((char *value, XColor *color));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindSystemColor --
+ *
+ * This routine finds the color entry that corresponds to the
+ * specified color.
+ *
+ * Results:
+ * Returns non-zero on success. The RGB values of the XColor
+ * will be initialized to the proper values on success.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ } else {
+ l = i+1;
+ }
+ }
+ if (l > u) {
+ return 0;
+ }
+
+ *indexPtr = sysColors[i].index;
+ colorPtr->pixel = GetSysColor(sysColors[i].index);
+ colorPtr->red = GetRValue(colorPtr->pixel) << 8;
+ colorPtr->green = GetGValue(colorPtr->pixel) << 8;
+ colorPtr->blue = GetBValue(colorPtr->pixel) << 8;
+ colorPtr->flags = DoRed|DoGreen|DoBlue;
+ colorPtr->pad = 0;
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetColor --
+ *
+ * Allocate a new TkColor for the color with the given name.
+ *
+ * Results:
+ * Returns a newly allocated TkColor, or NULL on failure.
+ *
+ * Side effects:
+ * May invalidate the colormap cache associated with tkwin upon
+ * allocating a new colormap entry. Allocates a new TkColor
+ * structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkColor *
+TkpGetColor(tkwin, name)
+ 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). */
+{
+ WinColor *winColPtr;
+ XColor color;
+ int index = -1; /* -1 indicates that this is not an indirect
+ * sytem color. */
+
+ /*
+ * Check to see if it is a system color or an X color string. If the
+ * color is found, allocate a new WinColor and store the XColor and the
+ * system color index.
+ */
+
+ if (((strncasecmp(name, "system", 6) == 0)
+ && FindSystemColor(name+6, &color, &index))
+ || XParseColor(Tk_Display(tkwin), Tk_Colormap(tkwin), name,
+ &color)) {
+ winColPtr = (WinColor *) ckalloc(sizeof(WinColor));
+ winColPtr->info.color = color;
+ winColPtr->index = index;
+
+ XAllocColor(Tk_Display(tkwin), Tk_Colormap(tkwin),
+ &winColPtr->info.color);
+ return (TkColor *) winColPtr;
+ }
+ return (TkColor *) NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetColorByValue --
+ *
+ * Given a desired set of red-green-blue intensities for a color,
+ * locate a pixel value to use to draw that color in a given
+ * window.
+ *
+ * Results:
+ * The return value is a pointer to an TkColor structure that
+ * indicates the closest red, blue, and green intensities available
+ * to those specified in colorPtr, and also specifies a pixel
+ * value to use to draw in that color.
+ *
+ * Side effects:
+ * May invalidate the colormap cache for the specified window.
+ * Allocates a new TkColor structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkColor *
+TkpGetColorByValue(tkwin, colorPtr)
+ Tk_Window tkwin; /* Window in which color will be used. */
+ XColor *colorPtr; /* Red, green, and blue fields indicate
+ * desired color. */
+{
+ WinColor *tkColPtr = (WinColor *) ckalloc(sizeof(WinColor));
+
+ tkColPtr->info.color.red = colorPtr->red;
+ tkColPtr->info.color.green = colorPtr->green;
+ tkColPtr->info.color.blue = colorPtr->blue;
+ tkColPtr->info.color.pixel = 0;
+ tkColPtr->index = -1;
+ XAllocColor(Tk_Display(tkwin), Tk_Colormap(tkwin), &tkColPtr->info.color);
+ return (TkColor *) tkColPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpFreeColor --
+ *
+ * Release the specified color back to the system.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Invalidates the colormap cache for the colormap associated with
+ * the given color.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpFreeColor(tkColPtr)
+ TkColor *tkColPtr; /* Color to be released. Must have been
+ * allocated by TkpGetColor or
+ * TkpGetColorByValue. */
+{
+ Screen *screen = tkColPtr->screen;
+
+ XFreeColors(DisplayOfScreen(screen), tkColPtr->colormap,
+ &tkColPtr->color.pixel, 1, 0L);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinIndexOfColor --
+ *
+ * Given a color, return the system color index that was used
+ * to create the color.
+ *
+ * Results:
+ * If the color was allocated using a system indirect color name,
+ * then the corresponding GetSysColor() index is returned.
+ * Otherwise, -1 is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkWinIndexOfColor(colorPtr)
+ XColor *colorPtr;
+{
+ register WinColor *winColPtr = (WinColor *) colorPtr;
+ if (winColPtr->info.magic == COLOR_MAGIC) {
+ return winColPtr->index;
+ }
+ return -1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XAllocColor --
+ *
+ * Find the closest available color to the specified XColor.
+ *
+ * Results:
+ * Updates the color argument and returns 1 on success. Otherwise
+ * returns 0.
+ *
+ * Side effects:
+ * Allocates a new color in the palette.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+XAllocColor(display, colormap, color)
+ Display* display;
+ Colormap colormap;
+ XColor* color;
+{
+ TkWinColormap *cmap = (TkWinColormap *) colormap;
+ PALETTEENTRY entry, closeEntry;
+ HDC dc = GetDC(NULL);
+
+ entry.peRed = (color->red) >> 8;
+ entry.peGreen = (color->green) >> 8;
+ entry.peBlue = (color->blue) >> 8;
+ entry.peFlags = 0;
+
+ if (GetDeviceCaps(dc, RASTERCAPS) & RC_PALETTE) {
+ unsigned long sizePalette = GetDeviceCaps(dc, SIZEPALETTE);
+ UINT newPixel, closePixel;
+ int new, refCount;
+ Tcl_HashEntry *entryPtr;
+ UINT index;
+
+ /*
+ * Find the nearest existing palette entry.
+ */
+
+ newPixel = RGB(entry.peRed, entry.peGreen, entry.peBlue);
+ index = GetNearestPaletteIndex(cmap->palette, newPixel);
+ GetPaletteEntries(cmap->palette, index, 1, &closeEntry);
+ closePixel = RGB(closeEntry.peRed, closeEntry.peGreen,
+ closeEntry.peBlue);
+
+ /*
+ * If this is not a duplicate, allocate a new entry. Note that
+ * we may get values for index that are above the current size
+ * of the palette. This happens because we don't shrink the size of
+ * the palette object when we deallocate colors so there may be
+ * stale values that match in the upper slots. We should ignore
+ * those values and just put the new color in as if the colors
+ * had not matched.
+ */
+
+ if ((index >= cmap->size) || (newPixel != closePixel)) {
+ if (cmap->size == sizePalette) {
+ color->red = closeEntry.peRed << 8;
+ color->green = closeEntry.peGreen << 8;
+ color->blue = closeEntry.peBlue << 8;
+ entry = closeEntry;
+ if (index >= cmap->size) {
+ OutputDebugString("XAllocColor: Colormap is bigger than we thought");
+ }
+ } else {
+ cmap->size++;
+ ResizePalette(cmap->palette, cmap->size);
+ SetPaletteEntries(cmap->palette, cmap->size - 1, 1, &entry);
+ }
+ }
+
+ color->pixel = PALETTERGB(entry.peRed, entry.peGreen, entry.peBlue);
+ entryPtr = Tcl_CreateHashEntry(&cmap->refCounts,
+ (char *) color->pixel, &new);
+ if (new) {
+ refCount = 1;
+ } else {
+ refCount = ((int) Tcl_GetHashValue(entryPtr)) + 1;
+ }
+ Tcl_SetHashValue(entryPtr, (ClientData)refCount);
+ } else {
+
+ /*
+ * Determine what color will actually be used on non-colormap systems.
+ */
+
+ color->pixel = GetNearestColor(dc,
+ RGB(entry.peRed, entry.peGreen, entry.peBlue));
+ color->red = (GetRValue(color->pixel) << 8);
+ color->green = (GetGValue(color->pixel) << 8);
+ color->blue = (GetBValue(color->pixel) << 8);
+ }
+
+ ReleaseDC(NULL, dc);
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XFreeColors --
+ *
+ * Deallocate a block of colors.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Removes entries for the current palette and compacts the
+ * remaining set.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XFreeColors(display, colormap, pixels, npixels, planes)
+ Display* display;
+ Colormap colormap;
+ unsigned long* pixels;
+ int npixels;
+ unsigned long planes;
+{
+ TkWinColormap *cmap = (TkWinColormap *) colormap;
+ COLORREF cref;
+ UINT count, index, refCount;
+ int i;
+ PALETTEENTRY entry, *entries;
+ Tcl_HashEntry *entryPtr;
+ HDC dc = GetDC(NULL);
+
+ /*
+ * We don't have to do anything for non-palette devices.
+ */
+
+ if (GetDeviceCaps(dc, RASTERCAPS) & RC_PALETTE) {
+
+ /*
+ * This is really slow for large values of npixels.
+ */
+
+ for (i = 0; i < npixels; i++) {
+ entryPtr = Tcl_FindHashEntry(&cmap->refCounts,
+ (char *) pixels[i]);
+ if (!entryPtr) {
+ panic("Tried to free a color that isn't allocated.");
+ }
+ refCount = (int) Tcl_GetHashValue(entryPtr) - 1;
+ if (refCount == 0) {
+ cref = pixels[i] & 0x00ffffff;
+ index = GetNearestPaletteIndex(cmap->palette, cref);
+ GetPaletteEntries(cmap->palette, index, 1, &entry);
+ if (cref == RGB(entry.peRed, entry.peGreen, entry.peBlue)) {
+ count = cmap->size - index;
+ entries = (PALETTEENTRY *) ckalloc(sizeof(PALETTEENTRY)
+ * count);
+ GetPaletteEntries(cmap->palette, index+1, count, entries);
+ SetPaletteEntries(cmap->palette, index, count, entries);
+ ckfree((char *) entries);
+ cmap->size--;
+ } else {
+ panic("Tried to free a color that isn't allocated.");
+ }
+ Tcl_DeleteHashEntry(entryPtr);
+ } else {
+ Tcl_SetHashValue(entryPtr, (ClientData)refCount);
+ }
+ }
+ }
+ ReleaseDC(NULL, dc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XCreateColormap --
+ *
+ * Allocate a new colormap.
+ *
+ * Results:
+ * Returns a newly allocated colormap.
+ *
+ * Side effects:
+ * Allocates an empty palette and color list.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Colormap
+XCreateColormap(display, w, visual, alloc)
+ Display* display;
+ Window w;
+ Visual* visual;
+ int alloc;
+{
+ char logPalBuf[sizeof(LOGPALETTE) + 256 * sizeof(PALETTEENTRY)];
+ LOGPALETTE *logPalettePtr;
+ PALETTEENTRY *entryPtr;
+ TkWinColormap *cmap;
+ Tcl_HashEntry *hashPtr;
+ int new;
+ UINT i;
+ HPALETTE sysPal;
+
+ /*
+ * Allocate a starting palette with all of the reserved colors.
+ */
+
+ logPalettePtr = (LOGPALETTE *) logPalBuf;
+ logPalettePtr->palVersion = 0x300;
+ sysPal = (HPALETTE) GetStockObject(DEFAULT_PALETTE);
+ logPalettePtr->palNumEntries = GetPaletteEntries(sysPal, 0, 256,
+ logPalettePtr->palPalEntry);
+
+ cmap = (TkWinColormap *) ckalloc(sizeof(TkWinColormap));
+ cmap->size = logPalettePtr->palNumEntries;
+ cmap->stale = 0;
+ cmap->palette = CreatePalette(logPalettePtr);
+
+ /*
+ * Add hash entries for each of the static colors.
+ */
+
+ Tcl_InitHashTable(&cmap->refCounts, TCL_ONE_WORD_KEYS);
+ for (i = 0; i < logPalettePtr->palNumEntries; i++) {
+ entryPtr = logPalettePtr->palPalEntry + i;
+ hashPtr = Tcl_CreateHashEntry(&cmap->refCounts, (char*) PALETTERGB(
+ entryPtr->peRed, entryPtr->peGreen, entryPtr->peBlue), &new);
+ Tcl_SetHashValue(hashPtr, (ClientData)1);
+ }
+
+ return (Colormap)cmap;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XFreeColormap --
+ *
+ * Frees the resources associated with the given colormap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Deletes the palette associated with the colormap. Note that
+ * the palette must not be selected into a device context when
+ * this occurs.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XFreeColormap(display, colormap)
+ Display* display;
+ Colormap colormap;
+{
+ TkWinColormap *cmap = (TkWinColormap *) colormap;
+ if (!DeleteObject(cmap->palette)) {
+ panic("Unable to free colormap, palette is still selected.");
+ }
+ Tcl_DeleteHashTable(&cmap->refCounts);
+ ckfree((char *) cmap);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinSelectPalette --
+ *
+ * This function sets up the specified device context with a
+ * given palette. If the palette is stale, it realizes it in
+ * the background unless the palette is the current global
+ * palette.
+ *
+ * Results:
+ * Returns the previous palette selected into the device context.
+ *
+ * Side effects:
+ * May change the system palette.
+ *
+ *----------------------------------------------------------------------
+ */
+
+HPALETTE
+TkWinSelectPalette(dc, colormap)
+ HDC dc;
+ Colormap colormap;
+{
+ TkWinColormap *cmap = (TkWinColormap *) colormap;
+ HPALETTE oldPalette;
+
+ oldPalette = SelectPalette(dc, cmap->palette,
+ (cmap->palette == TkWinGetSystemPalette()) ? FALSE : TRUE);
+ RealizePalette(dc);
+ return oldPalette;
+}
+
+/* CYGNUS LOCAL: The system colors have changed. Update them. */
+
+static void
+ChangeColor(tkColPtr)
+ TkColor *tkColPtr;
+{
+ WinColor *winColPtr = (WinColor *) tkColPtr;
+
+ if (winColPtr->index != -1) {
+ unsigned long pixel;
+
+ pixel = GetSysColor(winColPtr->index);
+ if (pixel != winColPtr->info.color.pixel) {
+ winColPtr->info.color.pixel = pixel;
+ winColPtr->info.color.red = GetRValue(pixel) << 8;
+ winColPtr->info.color.green = GetGValue(pixel) << 8;
+ winColPtr->info.color.blue = GetBValue(pixel) << 8;
+ TkColorChanged((TkColor *) winColPtr);
+ }
+ }
+}
+
+void
+TkWinSysColorChange()
+{
+ TkMapOverColors(ChangeColor);
+}
diff --git a/tk/win/tkWinCursor.c b/tk/win/tkWinCursor.c
new file mode 100644
index 00000000000..33c5ef9c213
--- /dev/null
+++ b/tk/win/tkWinCursor.c
@@ -0,0 +1,210 @@
+/*
+ * 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$
+ */
+
+#include "tkWinInt.h"
+
+/*
+ * The following data structure contains the system specific data
+ * necessary to control Windows cursors.
+ */
+
+typedef struct {
+ TkCursor info; /* Generic cursor info used by tkCursor.c */
+ HCURSOR winCursor; /* Win32 cursor handle. */
+ int system; /* 1 if cursor is a system cursor, else 0. */
+} TkWinCursor;
+
+/*
+ * The table below is used to map from the name of a predefined cursor
+ * to its resource identifier.
+ */
+
+static struct CursorName {
+ char *name;
+ LPCTSTR id;
+} cursorNames[] = {
+ {"starting", IDC_APPSTARTING},
+ {"arrow", IDC_ARROW},
+ {"ibeam", IDC_IBEAM},
+ {"icon", IDC_ICON},
+ {"no", IDC_NO},
+ {"size", IDC_SIZE},
+ {"size_ne_sw", IDC_SIZENESW},
+ {"size_ns", IDC_SIZENS},
+ {"size_nw_se", IDC_SIZENWSE},
+ {"size_we", IDC_SIZEWE},
+ {"uparrow", IDC_UPARROW},
+ {"wait", IDC_WAIT},
+ {"crosshair", IDC_CROSS},
+ {"fleur", IDC_SIZE},
+ {"sb_v_double_arrow", IDC_SIZENS},
+ {"sb_h_double_arrow", IDC_SIZEWE},
+ {"center_ptr", IDC_UPARROW},
+ {"watch", IDC_WAIT},
+ {"xterm", IDC_IBEAM},
+ {NULL, 0}
+};
+
+/*
+ * The default cursor is used whenever no other cursor has been specified.
+ */
+
+#define TK_DEFAULT_CURSOR IDC_ARROW
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetCursorByName --
+ *
+ * Retrieve a system cursor by name.
+ *
+ * Results:
+ * Returns a new cursor, or NULL on errors.
+ *
+ * Side effects:
+ * Allocates a new cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkCursor *
+TkGetCursorByName(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. */
+{
+ struct CursorName *namePtr;
+ TkWinCursor *cursorPtr;
+
+ /*
+ * Check for the cursor in the system cursor set.
+ */
+
+ for (namePtr = cursorNames; namePtr->name != NULL; namePtr++) {
+ if (strcmp(namePtr->name, string) == 0) {
+ break;
+ }
+ }
+
+ cursorPtr = (TkWinCursor *) ckalloc(sizeof(TkWinCursor));
+ cursorPtr->info.cursor = (Tk_Cursor) cursorPtr;
+ cursorPtr->winCursor = NULL;
+ if (namePtr->name != NULL) {
+ cursorPtr->winCursor = LoadCursor(NULL, namePtr->id);
+ cursorPtr->system = 1;
+ }
+ if (cursorPtr->winCursor == NULL) {
+ cursorPtr->winCursor = LoadCursor(Tk_GetHINSTANCE(), string);
+ cursorPtr->system = 0;
+ }
+ if (cursorPtr->winCursor == NULL) {
+ ckfree((char *)cursorPtr);
+ Tcl_AppendResult(interp, "bad cursor spec \"", string, "\"",
+ (char *) NULL);
+ return NULL;
+ } else {
+ return (TkCursor *) cursorPtr;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCreateCursorFromData --
+ *
+ * Creates a cursor from the source and mask bits.
+ *
+ * Results:
+ * Returns a new cursor, or NULL on errors.
+ *
+ * Side effects:
+ * Allocates a new cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkCursor *
+TkCreateCursorFromData(tkwin, source, mask, width, height, xHot, yHot,
+ fgColor, bgColor)
+ Tk_Window tkwin; /* Window in which cursor will be used. */
+ char *source; /* Bitmap data for cursor shape. */
+ char *mask; /* Bitmap data for cursor mask. */
+ int width, height; /* Dimensions of cursor. */
+ int xHot, yHot; /* Location of hot-spot in cursor. */
+ XColor fgColor; /* Foreground color for cursor. */
+ XColor bgColor; /* Background color for cursor. */
+{
+ 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 --
+ *
+ * Set the global cursor. If the cursor is None, then use the
+ * default Tk cursor.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the mouse cursor.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpSetCursor(cursor)
+ TkpCursor cursor;
+{
+ HCURSOR hcursor;
+ TkWinCursor *winCursor = (TkWinCursor *) cursor;
+
+ if (winCursor == NULL || winCursor->winCursor == NULL) {
+ hcursor = LoadCursor(NULL, TK_DEFAULT_CURSOR);
+ } else {
+ hcursor = winCursor->winCursor;
+ }
+
+ if (hcursor != NULL) {
+ SetCursor(hcursor);
+ }
+}
diff --git a/tk/win/tkWinDefault.h b/tk/win/tkWinDefault.h
new file mode 100644
index 00000000000..65ea546d659
--- /dev/null
+++ b/tk/win/tkWinDefault.h
@@ -0,0 +1,457 @@
+/*
+ * 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$
+ */
+
+#ifndef _TKWINDEFAULT
+#define _TKWINDEFAULT
+
+/*
+ * The definitions below provide symbolic names for the default colors.
+ * NORMAL_BG - Normal background color.
+ * ACTIVE_BG - Background color when widget is active.
+ * SELECT_BG - Background color for selected text.
+ * TROUGH - Background color for troughs in scales and scrollbars.
+ * INDICATOR - Color for indicator when button is selected.
+ * DISABLED - Foreground color when widget is disabled.
+ */
+
+#define BLACK "Black"
+#define WHITE "White"
+
+#define CTL_FONT "{MS Sans Serif} 8"
+#define NORMAL_BG "SystemButtonFace"
+#define NORMAL_FG "SystemButtonText"
+#define ACTIVE_BG NORMAL_BG
+#define TEXT_FG "SystemWindowText"
+#define SELECT_BG "SystemHighlight"
+#define SELECT_FG "SystemHighlightText"
+#define TROUGH "SystemScrollbar"
+#define INDICATOR "SystemWindow"
+#define DISABLED "SystemDisabledText"
+#define MENU_BG "SystemMenu"
+#define MENU_FG "SystemMenuText"
+#define HIGHLIGHT "SystemWindowFrame"
+
+/*
+ * Defaults for labels, buttons, checkbuttons, and radiobuttons:
+ */
+
+#define DEF_BUTTON_ANCHOR "center"
+#define DEF_BUTTON_ACTIVE_BG_COLOR NORMAL_BG
+#define DEF_BUTTON_ACTIVE_BG_MONO BLACK
+#define DEF_BUTTON_ACTIVE_FG_COLOR NORMAL_FG
+#define DEF_CHKRAD_ACTIVE_FG_COLOR TEXT_FG
+#define DEF_BUTTON_ACTIVE_FG_MONO WHITE
+#define DEF_BUTTON_BG_COLOR NORMAL_BG
+#define DEF_BUTTON_BG_MONO WHITE
+#define DEF_BUTTON_BITMAP ""
+#define DEF_BUTTON_BORDER_WIDTH "2"
+#define DEF_BUTTON_CURSOR ""
+#define DEF_BUTTON_COMMAND ""
+#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"
+#define DEF_BUTTON_ON_VALUE "1"
+#define DEF_BUTTON_PADX "1"
+#define DEF_LABCHKRAD_PADX "1"
+#define DEF_BUTTON_PADY "1"
+#define DEF_LABCHKRAD_PADY "1"
+#define DEF_BUTTON_RELIEF "raised"
+#define DEF_LABCHKRAD_RELIEF "flat"
+#define DEF_BUTTON_SELECT_COLOR INDICATOR
+#define DEF_BUTTON_SELECT_MONO BLACK
+#define DEF_BUTTON_SELECT_IMAGE (char *) NULL
+#define DEF_BUTTON_STATE "normal"
+#define DEF_LABEL_TAKE_FOCUS "0"
+#define DEF_BUTTON_TAKE_FOCUS (char *) NULL
+#define DEF_BUTTON_TEXT ""
+#define DEF_BUTTON_TEXT_VARIABLE ""
+#define DEF_BUTTON_UNDERLINE "-1"
+#define DEF_BUTTON_VALUE ""
+#define DEF_BUTTON_WIDTH "0"
+#define DEF_BUTTON_WRAP_LENGTH "0"
+#define DEF_RADIOBUTTON_VARIABLE "selectedButton"
+#define DEF_CHECKBUTTON_VARIABLE ""
+
+/*
+ * Defaults for canvases:
+ */
+
+#define DEF_CANVAS_BG_COLOR NORMAL_BG
+#define DEF_CANVAS_BG_MONO WHITE
+#define DEF_CANVAS_BORDER_WIDTH "0"
+#define DEF_CANVAS_CLOSE_ENOUGH "1"
+#define DEF_CANVAS_CONFINE "1"
+#define DEF_CANVAS_CURSOR ""
+#define DEF_CANVAS_HEIGHT "7c"
+#define DEF_CANVAS_HIGHLIGHT_BG NORMAL_BG
+#define DEF_CANVAS_HIGHLIGHT HIGHLIGHT
+#define DEF_CANVAS_HIGHLIGHT_WIDTH "2"
+#define DEF_CANVAS_INSERT_BG NORMAL_FG
+#define DEF_CANVAS_INSERT_BD_COLOR "0"
+#define DEF_CANVAS_INSERT_BD_MONO "0"
+#define DEF_CANVAS_INSERT_OFF_TIME "300"
+#define DEF_CANVAS_INSERT_ON_TIME "600"
+#define DEF_CANVAS_INSERT_WIDTH "2"
+#define DEF_CANVAS_RELIEF "flat"
+#define DEF_CANVAS_SCROLL_REGION ""
+#define DEF_CANVAS_SELECT_COLOR SELECT_BG
+#define DEF_CANVAS_SELECT_MONO BLACK
+#define DEF_CANVAS_SELECT_BD_COLOR "1"
+#define DEF_CANVAS_SELECT_BD_MONO "0"
+#define DEF_CANVAS_SELECT_FG_COLOR SELECT_FG
+#define DEF_CANVAS_SELECT_FG_MONO WHITE
+#define DEF_CANVAS_TAKE_FOCUS (char *) NULL
+#define DEF_CANVAS_WIDTH "10c"
+#define DEF_CANVAS_X_SCROLL_CMD ""
+#define DEF_CANVAS_X_SCROLL_INCREMENT "0"
+#define DEF_CANVAS_Y_SCROLL_CMD ""
+#define DEF_CANVAS_Y_SCROLL_INCREMENT "0"
+
+/*
+ * Defaults for entries:
+ */
+
+#define DEF_ENTRY_BG_COLOR "SystemWindow"
+#define DEF_ENTRY_BG_MONO WHITE
+#define DEF_ENTRY_BORDER_WIDTH "2"
+#define DEF_ENTRY_CURSOR "xterm"
+#define DEF_ENTRY_EXPORT_SELECTION "1"
+#define DEF_ENTRY_FONT CTL_FONT
+#define DEF_ENTRY_FG TEXT_FG
+#define DEF_ENTRY_HIGHLIGHT_BG NORMAL_BG
+#define DEF_ENTRY_HIGHLIGHT HIGHLIGHT
+#define DEF_ENTRY_HIGHLIGHT_WIDTH "0"
+#define DEF_ENTRY_INSERT_BG TEXT_FG
+#define DEF_ENTRY_INSERT_BD_COLOR "0"
+#define DEF_ENTRY_INSERT_BD_MONO "0"
+#define DEF_ENTRY_INSERT_OFF_TIME "300"
+#define DEF_ENTRY_INSERT_ON_TIME "600"
+#define DEF_ENTRY_INSERT_WIDTH "2"
+#define DEF_ENTRY_JUSTIFY "left"
+#define DEF_ENTRY_RELIEF "sunken"
+#define DEF_ENTRY_SCROLL_COMMAND ""
+#define DEF_ENTRY_SELECT_COLOR SELECT_BG
+#define DEF_ENTRY_SELECT_MONO BLACK
+#define DEF_ENTRY_SELECT_BD_COLOR "0"
+#define DEF_ENTRY_SELECT_BD_MONO "0"
+#define DEF_ENTRY_SELECT_FG_COLOR SELECT_FG
+#define DEF_ENTRY_SELECT_FG_MONO WHITE
+#define DEF_ENTRY_SHOW (char *) NULL
+#define DEF_ENTRY_STATE "normal"
+#define DEF_ENTRY_TAKE_FOCUS (char *) NULL
+#define DEF_ENTRY_TEXT_VARIABLE ""
+#define DEF_ENTRY_WIDTH "20"
+
+/*
+ * Defaults for frames:
+ */
+
+#define DEF_FRAME_BG_COLOR NORMAL_BG
+#define DEF_FRAME_BG_MONO WHITE
+#define DEF_FRAME_BORDER_WIDTH "0"
+#define DEF_FRAME_CLASS "Frame"
+#define DEF_FRAME_COLORMAP ""
+#define DEF_FRAME_CONTAINER "0"
+#define DEF_FRAME_CURSOR ""
+#define DEF_FRAME_HEIGHT "0"
+#define DEF_FRAME_HIGHLIGHT_BG NORMAL_BG
+#define DEF_FRAME_HIGHLIGHT HIGHLIGHT
+#define DEF_FRAME_HIGHLIGHT_WIDTH "0"
+#define DEF_FRAME_RELIEF "flat"
+#define DEF_FRAME_TAKE_FOCUS "0"
+#define DEF_FRAME_USE ""
+#define DEF_FRAME_VISUAL ""
+#define DEF_FRAME_WIDTH "0"
+
+/*
+ * Defaults for listboxes:
+ */
+
+#define DEF_LISTBOX_BG_COLOR NORMAL_BG
+#define DEF_LISTBOX_BG_MONO WHITE
+#define DEF_LISTBOX_BORDER_WIDTH "2"
+#define DEF_LISTBOX_CURSOR ""
+#define DEF_LISTBOX_EXPORT_SELECTION "1"
+#define DEF_LISTBOX_FONT CTL_FONT
+#define DEF_LISTBOX_FG NORMAL_FG
+#define DEF_LISTBOX_HEIGHT "10"
+#define DEF_LISTBOX_HIGHLIGHT_BG NORMAL_BG
+#define DEF_LISTBOX_HIGHLIGHT HIGHLIGHT
+#define DEF_LISTBOX_HIGHLIGHT_WIDTH "1"
+#define DEF_LISTBOX_RELIEF "sunken"
+#define DEF_LISTBOX_SCROLL_COMMAND ""
+#define DEF_LISTBOX_SELECT_COLOR SELECT_BG
+#define DEF_LISTBOX_SELECT_MONO BLACK
+#define DEF_LISTBOX_SELECT_BD "1"
+#define DEF_LISTBOX_SELECT_FG_COLOR SELECT_FG
+#define DEF_LISTBOX_SELECT_FG_MONO WHITE
+#define DEF_LISTBOX_SELECT_MODE "browse"
+#define DEF_LISTBOX_SET_GRID "0"
+#define DEF_LISTBOX_TAKE_FOCUS (char *) NULL
+#define DEF_LISTBOX_WIDTH "20"
+
+/*
+ * Defaults for individual entries of menus:
+ */
+
+#define DEF_MENU_ENTRY_ACTIVE_BG (char *) NULL
+#define DEF_MENU_ENTRY_ACTIVE_FG (char *) NULL
+#define DEF_MENU_ENTRY_ACCELERATOR (char *) NULL
+#define DEF_MENU_ENTRY_BG (char *) NULL
+#define DEF_MENU_ENTRY_BITMAP None
+#define DEF_MENU_ENTRY_COLUMN_BREAK "0"
+#define DEF_MENU_ENTRY_COMMAND (char *) NULL
+#define DEF_MENU_ENTRY_FG (char *) NULL
+#define DEF_MENU_ENTRY_FONT (char *) NULL
+#define DEF_MENU_ENTRY_HIDE_MARGIN "0"
+#define DEF_MENU_ENTRY_IMAGE (char *) NULL
+#define DEF_MENU_ENTRY_INDICATOR "1"
+#define DEF_MENU_ENTRY_LABEL (char *) NULL
+#define DEF_MENU_ENTRY_MENU (char *) NULL
+#define DEF_MENU_ENTRY_OFF_VALUE "0"
+#define DEF_MENU_ENTRY_ON_VALUE "1"
+#define DEF_MENU_ENTRY_SELECT_IMAGE (char *) NULL
+#define DEF_MENU_ENTRY_STATE "normal"
+#define DEF_MENU_ENTRY_VALUE (char *) NULL
+#define DEF_MENU_ENTRY_CHECK_VARIABLE (char *) NULL
+#define DEF_MENU_ENTRY_RADIO_VARIABLE "selectedButton"
+#define DEF_MENU_ENTRY_SELECT (char *) NULL
+#define DEF_MENU_ENTRY_UNDERLINE "-1"
+
+/*
+ * Defaults for menus overall:
+ */
+
+#define DEF_MENU_ACTIVE_BG_COLOR SELECT_BG
+#define DEF_MENU_ACTIVE_BG_MONO BLACK
+#define DEF_MENU_ACTIVE_BORDER_WIDTH "0"
+#define DEF_MENU_ACTIVE_FG_COLOR SELECT_FG
+#define DEF_MENU_ACTIVE_FG_MONO WHITE
+#define DEF_MENU_BG_COLOR MENU_BG
+#define DEF_MENU_BG_MONO WHITE
+#define DEF_MENU_BORDER_WIDTH "0"
+#define DEF_MENU_CURSOR "arrow"
+#define DEF_MENU_DISABLED_FG_COLOR DISABLED
+#define DEF_MENU_DISABLED_FG_MONO ""
+#define DEF_MENU_FONT CTL_FONT
+#define DEF_MENU_FG MENU_FG
+#define DEF_MENU_POST_COMMAND ""
+#define DEF_MENU_RELIEF "flat"
+#define DEF_MENU_SELECT_COLOR MENU_FG
+#define DEF_MENU_SELECT_MONO BLACK
+#define DEF_MENU_TAKE_FOCUS "0"
+#define DEF_MENU_TEAROFF "1"
+#define DEF_MENU_TEAROFF_CMD (char *) NULL
+#define DEF_MENU_TITLE ""
+#define DEF_MENU_TYPE "normal"
+
+/*
+ * Defaults for menubuttons:
+ */
+
+#define DEF_MENUBUTTON_ANCHOR "center"
+#define DEF_MENUBUTTON_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_MENUBUTTON_ACTIVE_BG_MONO BLACK
+#define DEF_MENUBUTTON_ACTIVE_FG_COLOR NORMAL_FG
+#define DEF_MENUBUTTON_ACTIVE_FG_MONO WHITE
+#define DEF_MENUBUTTON_BG_COLOR NORMAL_BG
+#define DEF_MENUBUTTON_BG_MONO WHITE
+#define DEF_MENUBUTTON_BITMAP ""
+#define DEF_MENUBUTTON_BORDER_WIDTH "2"
+#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"
+#define DEF_MENUBUTTON_PADY "3p"
+#define DEF_MENUBUTTON_RELIEF "flat"
+#define DEF_MENUBUTTON_STATE "normal"
+#define DEF_MENUBUTTON_TAKE_FOCUS "0"
+#define DEF_MENUBUTTON_TEXT ""
+#define DEF_MENUBUTTON_TEXT_VARIABLE ""
+#define DEF_MENUBUTTON_UNDERLINE "-1"
+#define DEF_MENUBUTTON_WIDTH "0"
+#define DEF_MENUBUTTON_WRAP_LENGTH "0"
+
+/*
+ * Defaults for messages:
+ */
+
+#define DEF_MESSAGE_ANCHOR "center"
+#define DEF_MESSAGE_ASPECT "150"
+#define DEF_MESSAGE_BG_COLOR NORMAL_BG
+#define DEF_MESSAGE_BG_MONO WHITE
+#define DEF_MESSAGE_BORDER_WIDTH "2"
+#define DEF_MESSAGE_CURSOR ""
+#define DEF_MESSAGE_FG NORMAL_FG
+#define DEF_MESSAGE_FONT CTL_FONT
+#define DEF_MESSAGE_HIGHLIGHT_BG NORMAL_BG
+#define DEF_MESSAGE_HIGHLIGHT HIGHLIGHT
+#define DEF_MESSAGE_HIGHLIGHT_WIDTH "0"
+#define DEF_MESSAGE_JUSTIFY "left"
+#define DEF_MESSAGE_PADX "-1"
+#define DEF_MESSAGE_PADY "-1"
+#define DEF_MESSAGE_RELIEF "flat"
+#define DEF_MESSAGE_TAKE_FOCUS "0"
+#define DEF_MESSAGE_TEXT ""
+#define DEF_MESSAGE_TEXT_VARIABLE ""
+#define DEF_MESSAGE_WIDTH "0"
+
+/*
+ * Defaults for scales:
+ */
+
+#define DEF_SCALE_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_SCALE_ACTIVE_BG_MONO BLACK
+#define DEF_SCALE_BG_COLOR NORMAL_BG
+#define DEF_SCALE_BG_MONO WHITE
+#define DEF_SCALE_BIG_INCREMENT "0"
+#define DEF_SCALE_BORDER_WIDTH "2"
+#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"
+#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"
+#define DEF_SCALE_STATE "normal"
+#define DEF_SCALE_TAKE_FOCUS (char *) NULL
+#define DEF_SCALE_TICK_INTERVAL "0"
+#define DEF_SCALE_TO "100"
+#define DEF_SCALE_VARIABLE ""
+#define DEF_SCALE_WIDTH "15"
+
+/*
+ * Defaults for scrollbars:
+ */
+
+#define DEF_SCROLLBAR_ACTIVE_BG_COLOR ACTIVE_BG
+#define DEF_SCROLLBAR_ACTIVE_BG_MONO BLACK
+#define DEF_SCROLLBAR_ACTIVE_RELIEF "raised"
+#define DEF_SCROLLBAR_BG_COLOR NORMAL_BG
+#define DEF_SCROLLBAR_BG_MONO WHITE
+#define DEF_SCROLLBAR_BORDER_WIDTH "0"
+#define DEF_SCROLLBAR_COMMAND ""
+#define DEF_SCROLLBAR_CURSOR ""
+#define DEF_SCROLLBAR_EL_BORDER_WIDTH "-1"
+#define DEF_SCROLLBAR_HIGHLIGHT_BG NORMAL_BG
+#define DEF_SCROLLBAR_HIGHLIGHT HIGHLIGHT
+#define DEF_SCROLLBAR_HIGHLIGHT_WIDTH "0"
+#define DEF_SCROLLBAR_JUMP "0"
+#define DEF_SCROLLBAR_ORIENT "vertical"
+#define DEF_SCROLLBAR_RELIEF "sunken"
+#define DEF_SCROLLBAR_REPEAT_DELAY "300"
+#define DEF_SCROLLBAR_REPEAT_INTERVAL "100"
+#define DEF_SCROLLBAR_TAKE_FOCUS (char *) NULL
+#define DEF_SCROLLBAR_TROUGH_COLOR TROUGH
+#define DEF_SCROLLBAR_TROUGH_MONO WHITE
+#define DEF_SCROLLBAR_WIDTH "10"
+
+/*
+ * Defaults for texts:
+ */
+
+#define DEF_TEXT_BG_COLOR "SystemWindow"
+#define DEF_TEXT_BG_MONO WHITE
+#define DEF_TEXT_BORDER_WIDTH "2"
+#define DEF_TEXT_CURSOR "xterm"
+#define DEF_TEXT_FG TEXT_FG
+#define DEF_TEXT_EXPORT_SELECTION "1"
+#define DEF_TEXT_FONT CTL_FONT
+#define DEF_TEXT_HEIGHT "24"
+#define DEF_TEXT_HIGHLIGHT_BG NORMAL_BG
+#define DEF_TEXT_HIGHLIGHT HIGHLIGHT
+#define DEF_TEXT_HIGHLIGHT_WIDTH "0"
+#define DEF_TEXT_INSERT_BG TEXT_FG
+#define DEF_TEXT_INSERT_BD_COLOR "0"
+#define DEF_TEXT_INSERT_BD_MONO "0"
+#define DEF_TEXT_INSERT_OFF_TIME "300"
+#define DEF_TEXT_INSERT_ON_TIME "600"
+#define DEF_TEXT_INSERT_WIDTH "2"
+#define DEF_TEXT_PADX "1"
+#define DEF_TEXT_PADY "1"
+#define DEF_TEXT_RELIEF "sunken"
+#define DEF_TEXT_SELECT_COLOR SELECT_BG
+#define DEF_TEXT_SELECT_MONO BLACK
+#define DEF_TEXT_SELECT_BD_COLOR "0"
+#define DEF_TEXT_SELECT_BD_MONO "0"
+#define DEF_TEXT_SELECT_FG_COLOR SELECT_FG
+#define DEF_TEXT_SELECT_FG_MONO WHITE
+#define DEF_TEXT_SELECT_RELIEF "flat"
+#define DEF_TEXT_SET_GRID "0"
+#define DEF_TEXT_SPACING1 "0"
+#define DEF_TEXT_SPACING2 "0"
+#define DEF_TEXT_SPACING3 "0"
+#define DEF_TEXT_STATE "normal"
+#define DEF_TEXT_TABS ""
+#define DEF_TEXT_TAKE_FOCUS (char *) NULL
+#define DEF_TEXT_WIDTH "80"
+#define DEF_TEXT_WRAP "char"
+#define DEF_TEXT_XSCROLL_COMMAND ""
+#define DEF_TEXT_YSCROLL_COMMAND ""
+#define DEF_TEXT_TAB_SIZE "8"
+
+/*
+ * Defaults for canvas text:
+ */
+
+#define DEF_CANVTEXT_FONT CTL_FONT
+
+/*
+ * Defaults for toplevels (most of the defaults for frames also apply
+ * to toplevels):
+ */
+
+#define DEF_TOPLEVEL_CLASS "Toplevel"
+#define DEF_TOPLEVEL_MENU ""
+#define DEF_TOPLEVEL_SCREEN ""
+
+#endif /* _TKWINDEFAULT */
diff --git a/tk/win/tkWinDialog.c b/tk/win/tkWinDialog.c
new file mode 100644
index 00000000000..d2229d6bf56
--- /dev/null
+++ b/tk/win/tkWinDialog.c
@@ -0,0 +1,1136 @@
+/*
+ * 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$
+ *
+ */
+
+#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[(256*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) {
+ if (ofnPtr->Flags & OFN_ALLOWMULTISELECT) {
+ /* The result in custData->szFile contains many items,
+ separated with null characters. It is terminated with
+ two nulls in a row. The first element is the directory
+ path. */
+ char *dir;
+ int dirlen;
+ char *p;
+ Tcl_DString fullname;
+ Tcl_ResetResult(interp);
+
+ /* Get directory */
+ dir = custData->szFile;
+ 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 = '/';
+ }
+ }
+
+ if (p[1] == '\0') {
+ /* Only one file was returned. */
+ Tcl_AppendElement(interp, dir);
+ } else {
+ while (*(++p)) {
+ char *filname = p;
+ for (; p && *p; p++) {
+ if (*p == '\\') { *p = '/'; }
+ }
+ Tcl_DStringInit(&fullname);
+ /* Add "dir/fname" to list */
+ Tcl_DStringAppend(&fullname, dir, -1);
+ Tcl_DStringAppend(&fullname, "/", -1);
+ Tcl_DStringAppend(&fullname, filname, -1);
+ /* Add to result string */
+ Tcl_AppendElement(interp, Tcl_DStringValue(&fullname));
+ /* Reset dynamic string */
+ Tcl_DStringFree(&fullname);
+ }
+ }
+ tclCode = TCL_OK;
+ } else {
+ /* Not a multiple-selection box; just treat it as a single
+ element. */
+ 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 if (strncmp(argv[i], "-multiple", len)==0) {
+ int tmp;
+ if (v==argc) {goto arg_missing;}
+
+ if (Tcl_GetBoolean(interp, argv[i+1], &tmp) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (tmp) {
+ ofnPtr->Flags |= OFN_ALLOWMULTISELECT;
+ }
+ }
+ 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);
+
+ *p++ = '\0';
+ *p++ = '*';
+ *p++ = '.';
+ *p++ = '*';
+ *p++ = '\0';
+ *p++ = '\0';
+ *p = '\0';
+
+ } else {
+ /* We format the filetype into a string understood by Windows:
+ * {"Text Documents" {.doc .txt} {TEXT}} becomes
+ * "Text Documents (*.doc,*.txt)\0*.doc;*.txt\0"
+ *
+ * See the Windows OPENFILENAME manual page for details on the filter
+ * string format.
+ */
+
+ /*
+ * Since we may only add asterisks (*) to the filter, we need at most
+ * twice the size of the string to format the filter
+ */
+ filterStr = ckalloc(strlen(string) * 3);
+
+ for (filterPtr = flist.filters, p = filterStr; filterPtr;
+ filterPtr = filterPtr->next) {
+ char *sep;
+ FileFilterClause *clausePtr;
+
+ /*
+ * First, put in the name of the file type
+ */
+ strcpy(p, filterPtr->name);
+ p+= strlen(filterPtr->name);
+ *p++ = ' ';
+ *p++ = '(';
+
+ for (pass = 1; pass <= 2; pass++) {
+ /*
+ * In the first pass, we format the extensions in the
+ * name field. In the second pass, we format the extensions in
+ * the filter pattern field
+ */
+ sep = "";
+ for (clausePtr=filterPtr->clauses;clausePtr;
+ clausePtr=clausePtr->next) {
+ GlobPattern *globPtr;
+
+
+ for (globPtr=clausePtr->patterns; globPtr;
+ globPtr=globPtr->next) {
+ strcpy(p, sep);
+ p+= strlen(sep);
+ strcpy(p, globPtr->pattern);
+ p+= strlen(globPtr->pattern);
+
+ if (pass==1) {
+ sep = ",";
+ } else {
+ sep = ";";
+ }
+ }
+ }
+ if (pass == 1) {
+ if (pass == 1) {
+ *p ++ = ')';
+ }
+ }
+ *p ++ = '\0';
+ }
+ }
+
+ /*
+ * 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 = NULL;
+ HWND hWnd;
+ char *message = "";
+ char *title = "";
+ int icon = MB_ICONINFORMATION;
+ int type = MB_OK;
+ int modal = MB_SYSTEMMODAL;
+ 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 if (strncmp (argv[i], "-modal", len) == 0) {
+ if (v==argc) {goto arg_missing;}
+
+ if (strcmp(argv[v], "system") == 0) {
+ modal = MB_SYSTEMMODAL;
+ }
+ else if (strcmp(argv[v], "task") == 0) {
+ modal = MB_TASKMODAL;
+ }
+ else if (strcmp(argv[v], "owner") == 0) {
+ modal = MB_APPLMODAL;
+ }
+ else {
+ Tcl_AppendResult(interp, "invalid modality \"", argv[v],
+ "\", must be system, task or owner", 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 (parent == NULL && modal == MB_TASKMODAL) {
+ hWnd = NULL;
+ }
+ else {
+ if (parent == NULL) {
+ parent = Tk_MainWindow(interp);
+ }
+ 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|modal);
+ (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;
+}
diff --git a/tk/win/tkWinDraw.c b/tk/win/tkWinDraw.c
new file mode 100644
index 00000000000..445166705d8
--- /dev/null
+++ b/tk/win/tkWinDraw.c
@@ -0,0 +1,1264 @@
+/*
+ * 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$
+ */
+
+#include "tkWinInt.h"
+
+/*
+ * These macros convert between X's bizarre angle units to radians.
+ */
+
+#define PI 3.14159265358979
+#define XAngleToRadians(a) ((double)(a) / 64 * PI / 180);
+
+/*
+ * Translation table between X gc functions and Win32 raster op modes.
+ */
+
+int tkpWinRopModes[] = {
+ R2_BLACK, /* GXclear */
+ R2_MASKPEN, /* GXand */
+ R2_MASKPENNOT, /* GXandReverse */
+ R2_COPYPEN, /* GXcopy */
+ R2_MASKNOTPEN, /* GXandInverted */
+ R2_NOT, /* GXnoop */
+ R2_XORPEN, /* GXxor */
+ R2_MERGEPEN, /* GXor */
+ R2_NOTMERGEPEN, /* GXnor */
+ R2_NOTXORPEN, /* GXequiv */
+ R2_NOT, /* GXinvert */
+ R2_MERGEPENNOT, /* GXorReverse */
+ R2_NOTCOPYPEN, /* GXcopyInverted */
+ R2_MERGENOTPEN, /* GXorInverted */
+ R2_NOTMASKPEN, /* GXnand */
+ R2_WHITE /* GXset */
+};
+
+/*
+ * Translation table between X gc functions and Win32 BitBlt op modes. Some
+ * of the operations defined in X don't have names, so we have to construct
+ * new opcodes for those functions. This is arcane and probably not all that
+ * useful, but at least it's accurate.
+ */
+
+#define NOTSRCAND (DWORD)0x00220326 /* dest = (NOT source) AND dest */
+#define NOTSRCINVERT (DWORD)0x00990066 /* dest = (NOT source) XOR dest */
+#define SRCORREVERSE (DWORD)0x00DD0228 /* dest = source OR (NOT dest) */
+#define SRCNAND (DWORD)0x007700E6 /* dest = NOT (source AND dest) */
+
+static int bltModes[] = {
+ BLACKNESS, /* GXclear */
+ SRCAND, /* GXand */
+ SRCERASE, /* GXandReverse */
+ SRCCOPY, /* GXcopy */
+ NOTSRCAND, /* GXandInverted */
+ PATCOPY, /* GXnoop */
+ SRCINVERT, /* GXxor */
+ SRCPAINT, /* GXor */
+ NOTSRCERASE, /* GXnor */
+ NOTSRCINVERT, /* GXequiv */
+ DSTINVERT, /* GXinvert */
+ SRCORREVERSE, /* GXorReverse */
+ NOTSRCCOPY, /* GXcopyInverted */
+ MERGEPAINT, /* GXorInverted */
+ SRCNAND, /* GXnand */
+ WHITENESS /* GXset */
+};
+
+/*
+ * The following raster op uses the source bitmap as a mask for the
+ * pattern. This is used to draw in a foreground color but leave the
+ * background color transparent.
+ */
+
+#define MASKPAT 0x00E20746 /* dest = (src & pat) | (!src & dst) */
+
+/*
+ * The following two raster ops are used to copy the foreground and background
+ * bits of a source pattern as defined by a stipple used as the pattern.
+ */
+
+#define COPYFG 0x00CA0749 /* dest = (pat & src) | (!pat & dst) */
+#define COPYBG 0x00AC0744 /* dest = (!pat & src) | (pat & dst) */
+
+/*
+ * Macros used later in the file.
+ */
+
+#define MIN(a,b) ((a>b) ? b : a)
+#define MAX(a,b) ((a<b) ? b : a)
+
+/*
+ * 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));
+static void DrawOrFillArc _ANSI_ARGS_((Display *display,
+ Drawable d, GC gc, int x, int y,
+ unsigned int width, unsigned int height,
+ int start, int extent, int fill));
+static void RenderObject _ANSI_ARGS_((HDC dc, GC gc,
+ XPoint* points, int npoints, int mode, HPEN pen,
+ WinDrawFunc func));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinGetDrawableDC --
+ *
+ * Retrieve the DC from a drawable.
+ *
+ * Results:
+ * Returns the window DC for windows. Returns a new memory DC
+ * for pixmaps.
+ *
+ * Side effects:
+ * Sets up the palette for the device context, and saves the old
+ * device context state in the passed in TkWinDCState structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+HDC
+TkWinGetDrawableDC(display, d, state)
+ Display *display;
+ Drawable d;
+ TkWinDCState* state;
+{
+ HDC dc;
+ TkWinDrawable *twdPtr = (TkWinDrawable *)d;
+ Colormap cmap;
+
+ if (twdPtr->type == TWD_WINDOW) {
+ TkWindow *winPtr = twdPtr->window.winPtr;
+
+ dc = GetDC(twdPtr->window.handle);
+ if (winPtr == NULL) {
+ cmap = DefaultColormap(display, DefaultScreen(display));
+ } else {
+ cmap = winPtr->atts.colormap;
+ }
+ } else if (twdPtr->type == TWD_WINDC) {
+ dc = twdPtr->winDC.hdc;
+ cmap = DefaultColormap(display, DefaultScreen(display));
+ } else {
+ dc = CreateCompatibleDC(NULL);
+ SelectObject(dc, twdPtr->bitmap.handle);
+ cmap = twdPtr->bitmap.colormap;
+ }
+ state->palette = TkWinSelectPalette(dc, cmap);
+ return dc;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinReleaseDrawableDC --
+ *
+ * Frees the resources associated with a drawable's DC.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Restores the old bitmap handle to the memory DC for pixmaps.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWinReleaseDrawableDC(d, dc, state)
+ Drawable d;
+ HDC dc;
+ TkWinDCState *state;
+{
+ TkWinDrawable *twdPtr = (TkWinDrawable *)d;
+ SelectPalette(dc, state->palette, TRUE);
+ RealizePalette(dc);
+ if (twdPtr->type == TWD_WINDOW) {
+ ReleaseDC(TkWinGetHWND(d), dc);
+ } else if (twdPtr->type == TWD_BITMAP) {
+ DeleteDC(dc);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConvertPoints --
+ *
+ * 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 --
+ *
+ * Copies data from one drawable to another using block transfer
+ * routines.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Data is moved from a window or bitmap to a second window or
+ * bitmap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XCopyArea(display, src, dest, gc, src_x, src_y, width, height, dest_x, dest_y)
+ Display* display;
+ Drawable src;
+ Drawable dest;
+ GC gc;
+ int src_x, src_y;
+ unsigned int width, height;
+ int dest_x, dest_y;
+{
+ HDC srcDC, destDC;
+ TkWinDCState srcState, destState;
+ TkpClipMask *clipPtr = (TkpClipMask*)gc->clip_mask;
+
+ srcDC = TkWinGetDrawableDC(display, src, &srcState);
+
+ if (src != dest) {
+ destDC = TkWinGetDrawableDC(display, dest, &destState);
+ } else {
+ destDC = srcDC;
+ }
+
+ if (clipPtr && clipPtr->type == TKP_CLIP_REGION) {
+ SelectClipRgn(destDC, (HRGN) clipPtr->value.region);
+ OffsetClipRgn(destDC, gc->clip_x_origin, gc->clip_y_origin);
+ }
+
+ BitBlt(destDC, dest_x, dest_y, width, height, srcDC, src_x, src_y,
+ bltModes[gc->function]);
+
+ SelectClipRgn(destDC, NULL);
+
+ if (src != dest) {
+ TkWinReleaseDrawableDC(dest, destDC, &destState);
+ }
+ TkWinReleaseDrawableDC(src, srcDC, &srcState);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XCopyPlane --
+ *
+ * Copies a bitmap from a source drawable to a destination
+ * drawable. The plane argument specifies which bit plane of
+ * the source contains the bitmap. Note that this implementation
+ * ignores the gc->function.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the destination drawable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XCopyPlane(display, src, dest, gc, src_x, src_y, width, height, dest_x,
+ dest_y, plane)
+ Display* display;
+ Drawable src;
+ Drawable dest;
+ GC gc;
+ int src_x, src_y;
+ unsigned int width, height;
+ int dest_x, dest_y;
+ unsigned long plane;
+{
+ HDC srcDC, destDC;
+ TkWinDCState srcState, destState;
+ HBRUSH bgBrush, fgBrush, oldBrush;
+ TkpClipMask *clipPtr = (TkpClipMask*)gc->clip_mask;
+
+ display->request++;
+
+ if (plane != 1) {
+ panic("Unexpected plane specified for XCopyPlane");
+ }
+
+ srcDC = TkWinGetDrawableDC(display, src, &srcState);
+
+ if (src != dest) {
+ destDC = TkWinGetDrawableDC(display, dest, &destState);
+ } else {
+ destDC = srcDC;
+ }
+
+ if (clipPtr == NULL || clipPtr->type == TKP_CLIP_REGION) {
+
+ /*
+ * Case 1: opaque bitmaps. Windows handles the conversion
+ * from one bit to multiple bits by setting 0 to the
+ * foreground color, and 1 to the background color (seems
+ * backwards, but there you are).
+ */
+
+ if (clipPtr && clipPtr->type == TKP_CLIP_REGION) {
+ SelectClipRgn(destDC, (HRGN) clipPtr->value.region);
+ OffsetClipRgn(destDC, gc->clip_x_origin, gc->clip_y_origin);
+ }
+
+ SetBkMode(destDC, OPAQUE);
+ SetBkColor(destDC, gc->foreground);
+ SetTextColor(destDC, gc->background);
+ BitBlt(destDC, dest_x, dest_y, width, height, srcDC, src_x, src_y,
+ SRCCOPY);
+
+ SelectClipRgn(destDC, NULL);
+ } else if (clipPtr->type == TKP_CLIP_PIXMAP) {
+ if (clipPtr->value.pixmap == src) {
+
+ /*
+ * Case 2: transparent bitmaps are handled by setting the
+ * destination to the foreground color whenever the source
+ * pixel is set.
+ */
+
+ fgBrush = CreateSolidBrush(gc->foreground);
+ oldBrush = SelectObject(destDC, fgBrush);
+ BitBlt(destDC, dest_x, dest_y, width, height, srcDC, src_x, src_y,
+ MASKPAT);
+ SelectObject(destDC, oldBrush);
+ DeleteObject(fgBrush);
+ } else {
+
+ /*
+ * Case 3: two arbitrary bitmaps. Copy the source rectangle
+ * into a color pixmap. Use the result as a brush when
+ * copying the clip mask into the destination.
+ */
+
+ HDC memDC, maskDC;
+ HBITMAP bitmap;
+ TkWinDCState maskState;
+
+ fgBrush = CreateSolidBrush(gc->foreground);
+ bgBrush = CreateSolidBrush(gc->background);
+ maskDC = TkWinGetDrawableDC(display, clipPtr->value.pixmap,
+ &maskState);
+ memDC = CreateCompatibleDC(destDC);
+ bitmap = CreateBitmap(width, height, 1, 1, NULL);
+ SelectObject(memDC, bitmap);
+
+ /*
+ * Set foreground bits. We create a new bitmap containing
+ * (source AND mask), then use it to set the foreground color
+ * into the destination.
+ */
+
+ BitBlt(memDC, 0, 0, width, height, srcDC, src_x, src_y, SRCCOPY);
+ BitBlt(memDC, 0, 0, width, height, maskDC,
+ dest_x - gc->clip_x_origin, dest_y - gc->clip_y_origin,
+ SRCAND);
+ oldBrush = SelectObject(destDC, fgBrush);
+ BitBlt(destDC, dest_x, dest_y, width, height, memDC, 0, 0,
+ MASKPAT);
+
+ /*
+ * Set background bits. Same as foreground, except we use
+ * ((NOT source) AND mask) and the background brush.
+ */
+
+ BitBlt(memDC, 0, 0, width, height, srcDC, src_x, src_y,
+ NOTSRCCOPY);
+ BitBlt(memDC, 0, 0, width, height, maskDC,
+ dest_x - gc->clip_x_origin, dest_y - gc->clip_y_origin,
+ SRCAND);
+ SelectObject(destDC, bgBrush);
+ BitBlt(destDC, dest_x, dest_y, width, height, memDC, 0, 0,
+ MASKPAT);
+
+ TkWinReleaseDrawableDC(clipPtr->value.pixmap, maskDC, &maskState);
+ SelectObject(destDC, oldBrush);
+ DeleteDC(memDC);
+ DeleteObject(bitmap);
+ DeleteObject(fgBrush);
+ DeleteObject(bgBrush);
+ }
+ }
+ if (src != dest) {
+ TkWinReleaseDrawableDC(dest, destDC, &destState);
+ }
+ TkWinReleaseDrawableDC(src, srcDC, &srcState);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkPutImage --
+ *
+ * Copies a subimage from an in-memory image to a rectangle of
+ * of the specified drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Draws the image on the specified drawable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkPutImage(colors, ncolors, display, d, gc, image, src_x, src_y, dest_x,
+ dest_y, width, height)
+ unsigned long *colors; /* Array of pixel values used by this
+ * image. May be NULL. */
+ int ncolors; /* Number of colors used, or 0. */
+ Display* display;
+ Drawable d; /* Destination drawable. */
+ GC gc;
+ XImage* image; /* Source image. */
+ int src_x, src_y; /* Offset of subimage. */
+ int dest_x, dest_y; /* Position of subimage origin in
+ * drawable. */
+ unsigned int width, height; /* Dimensions of subimage. */
+{
+ HDC dc, dcMem;
+ TkWinDCState state;
+ BITMAPINFO *infoPtr;
+ HBITMAP bitmap;
+ char *data;
+
+ display->request++;
+
+ dc = TkWinGetDrawableDC(display, d, &state);
+ SetROP2(dc, tkpWinRopModes[gc->function]);
+ dcMem = CreateCompatibleDC(dc);
+
+ if (image->bits_per_pixel == 1) {
+ /*
+ * If the image isn't in the right format, we have to copy
+ * it into a new buffer in MSBFirst and word-aligned format.
+ */
+
+ if ((image->bitmap_bit_order != MSBFirst)
+ || (image->bitmap_pad != sizeof(WORD))) {
+ data = TkAlignImageData(image, sizeof(WORD), MSBFirst);
+ bitmap = CreateBitmap(image->width, image->height, 1, 1, data);
+ ckfree(data);
+ } else {
+ bitmap = CreateBitmap(image->width, image->height, 1, 1,
+ image->data);
+ }
+ SetTextColor(dc, gc->foreground);
+ SetBkColor(dc, gc->background);
+ } else {
+ int i, usePalette;
+
+ /*
+ * Do not use a palette for TrueColor images.
+ */
+
+ usePalette = (image->bits_per_pixel < 16);
+
+ if (usePalette) {
+ infoPtr = (BITMAPINFO*) ckalloc(sizeof(BITMAPINFOHEADER)
+ + sizeof(RGBQUAD)*ncolors);
+ } else {
+ infoPtr = (BITMAPINFO*) ckalloc(sizeof(BITMAPINFOHEADER));
+ }
+
+ infoPtr->bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
+ infoPtr->bmiHeader.biWidth = image->width;
+
+ /*
+ * The following code works around a bug in Win32s. CreateDIBitmap
+ * fails under Win32s for top-down images. So we have to reverse the
+ * order of the scanlines. If we are not running under Win32s, we can
+ * just declare the image to be top-down.
+ */
+
+ if (tkpIsWin32s) {
+ int y;
+ char *srcPtr, *dstPtr, *temp;
+
+ temp = ckalloc((unsigned) image->bytes_per_line);
+ srcPtr = image->data;
+ dstPtr = image->data+(image->bytes_per_line * (image->height - 1));
+ for (y = 0; y < (image->height/2); y++) {
+ memcpy(temp, srcPtr, image->bytes_per_line);
+ memcpy(srcPtr, dstPtr, image->bytes_per_line);
+ memcpy(dstPtr, temp, image->bytes_per_line);
+ srcPtr += image->bytes_per_line;
+ dstPtr -= image->bytes_per_line;
+ }
+ ckfree(temp);
+ infoPtr->bmiHeader.biHeight = image->height; /* Bottom-up order */
+ } else {
+ infoPtr->bmiHeader.biHeight = -image->height; /* Top-down order */
+ }
+ infoPtr->bmiHeader.biPlanes = 1;
+ infoPtr->bmiHeader.biBitCount = image->bits_per_pixel;
+ infoPtr->bmiHeader.biCompression = BI_RGB;
+ infoPtr->bmiHeader.biSizeImage = 0;
+ infoPtr->bmiHeader.biXPelsPerMeter = 0;
+ infoPtr->bmiHeader.biYPelsPerMeter = 0;
+ infoPtr->bmiHeader.biClrImportant = 0;
+
+ if (usePalette) {
+ infoPtr->bmiHeader.biClrUsed = ncolors;
+ for (i = 0; i < ncolors; i++) {
+ infoPtr->bmiColors[i].rgbBlue = GetBValue(colors[i]);
+ infoPtr->bmiColors[i].rgbGreen = GetGValue(colors[i]);
+ infoPtr->bmiColors[i].rgbRed = GetRValue(colors[i]);
+ infoPtr->bmiColors[i].rgbReserved = 0;
+ }
+ } else {
+ infoPtr->bmiHeader.biClrUsed = 0;
+ }
+ bitmap = CreateDIBitmap(dc, &infoPtr->bmiHeader, CBM_INIT,
+ image->data, infoPtr, DIB_RGB_COLORS);
+ ckfree((char *) infoPtr);
+ }
+ bitmap = SelectObject(dcMem, bitmap);
+ BitBlt(dc, dest_x, dest_y, width, height, dcMem, src_x, src_y, SRCCOPY);
+ DeleteObject(SelectObject(dcMem, bitmap));
+ DeleteDC(dcMem);
+ TkWinReleaseDrawableDC(d, dc, &state);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XFillRectangles --
+ *
+ * Fill multiple rectangular areas in the given drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Draws onto the specified drawable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XFillRectangles(display, d, gc, rectangles, nrectangles)
+ Display* display;
+ Drawable d;
+ GC gc;
+ XRectangle* rectangles;
+ int nrectangles;
+{
+ HDC dc;
+ int i;
+ RECT rect;
+ TkWinDCState state;
+ HBRUSH brush;
+
+ if (d == None) {
+ return;
+ }
+
+ dc = TkWinGetDrawableDC(display, d, &state);
+ SetROP2(dc, tkpWinRopModes[gc->function]);
+ brush = CreateSolidBrush(gc->foreground);
+
+ if ((gc->fill_style == FillStippled
+ || gc->fill_style == FillOpaqueStippled)
+ && gc->stipple != None) {
+ TkWinDrawable *twdPtr = (TkWinDrawable *)gc->stipple;
+ HBRUSH oldBrush, stipple;
+ HBITMAP oldBitmap, bitmap;
+ HDC dcMem;
+ HBRUSH bgBrush = CreateSolidBrush(gc->background);
+
+ if (twdPtr->type != TWD_BITMAP) {
+ panic("unexpected drawable type in stipple");
+ }
+
+ /*
+ * Select stipple pattern into destination dc.
+ */
+
+ stipple = CreatePatternBrush(twdPtr->bitmap.handle);
+ SetBrushOrgEx(dc, gc->ts_x_origin, gc->ts_y_origin, NULL);
+ oldBrush = SelectObject(dc, stipple);
+ dcMem = CreateCompatibleDC(dc);
+
+ /*
+ * For each rectangle, create a drawing surface which is the size of
+ * the rectangle and fill it with the background color. Then merge the
+ * result with the stipple pattern.
+ */
+
+ for (i = 0; i < nrectangles; i++) {
+ bitmap = CreateCompatibleBitmap(dc, rectangles[i].width,
+ rectangles[i].height);
+ oldBitmap = SelectObject(dcMem, bitmap);
+ rect.left = 0;
+ rect.top = 0;
+ rect.right = rectangles[i].width;
+ rect.bottom = rectangles[i].height;
+ FillRect(dcMem, &rect, brush);
+ BitBlt(dc, rectangles[i].x, rectangles[i].y, rectangles[i].width,
+ rectangles[i].height, dcMem, 0, 0, COPYFG);
+ if (gc->fill_style == FillOpaqueStippled) {
+ FillRect(dcMem, &rect, bgBrush);
+ BitBlt(dc, rectangles[i].x, rectangles[i].y,
+ rectangles[i].width, rectangles[i].height, dcMem,
+ 0, 0, COPYBG);
+ }
+ SelectObject(dcMem, oldBitmap);
+ DeleteObject(bitmap);
+ }
+
+ DeleteDC(dcMem);
+ SelectObject(dc, oldBrush);
+ DeleteObject(stipple);
+ DeleteObject(bgBrush);
+ } else {
+ for (i = 0; i < nrectangles; i++) {
+ TkWinFillRect(dc, rectangles[i].x, rectangles[i].y,
+ rectangles[i].width, rectangles[i].height, gc->foreground);
+ }
+ }
+ DeleteObject(brush);
+ TkWinReleaseDrawableDC(d, dc, &state);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RenderObject --
+ *
+ * This function draws a shape using a list of points, a
+ * stipple pattern, and the specified drawing function.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+RenderObject(dc, gc, points, npoints, mode, pen, func)
+ HDC dc;
+ GC gc;
+ XPoint* points;
+ int npoints;
+ int mode;
+ HPEN pen;
+ WinDrawFunc func;
+{
+ RECT rect;
+ HPEN oldPen;
+ HBRUSH oldBrush;
+ POINT *winPoints = ConvertPoints(points, npoints, mode, &rect);
+
+ if ((gc->fill_style == FillStippled
+ || gc->fill_style == FillOpaqueStippled)
+ && gc->stipple != None) {
+
+ TkWinDrawable *twdPtr = (TkWinDrawable *)gc->stipple;
+ HDC dcMem;
+ LONG width, height;
+ HBITMAP oldBitmap;
+ int i;
+ HBRUSH oldMemBrush;
+
+ if (twdPtr->type != TWD_BITMAP) {
+ panic("unexpected drawable type in stipple");
+ }
+
+ /*
+ * Grow the bounding box enough to account for wide lines.
+ */
+
+ if (gc->line_width > 1) {
+ rect.left -= gc->line_width;
+ rect.top -= gc->line_width;
+ rect.right += gc->line_width;
+ rect.bottom += gc->line_width;
+ }
+
+ width = rect.right - rect.left;
+ height = rect.bottom - rect.top;
+
+ /*
+ * Select stipple pattern into destination dc.
+ */
+
+ SetBrushOrgEx(dc, gc->ts_x_origin, gc->ts_y_origin, NULL);
+ oldBrush = SelectObject(dc, CreatePatternBrush(twdPtr->bitmap.handle));
+
+ /*
+ * Create temporary drawing surface containing a copy of the
+ * destination equal in size to the bounding box of the object.
+ */
+
+ dcMem = CreateCompatibleDC(dc);
+ oldBitmap = SelectObject(dcMem, CreateCompatibleBitmap(dc, width,
+ height));
+ oldPen = SelectObject(dcMem, pen);
+ BitBlt(dcMem, 0, 0, width, height, dc, rect.left, rect.top, SRCCOPY);
+
+ /*
+ * Translate the object for rendering in the temporary drawing
+ * surface.
+ */
+
+ for (i = 0; i < npoints; i++) {
+ winPoints[i].x -= rect.left;
+ winPoints[i].y -= rect.top;
+ }
+
+ /*
+ * Draw the object in the foreground color and copy it to the
+ * destination wherever the pattern is set.
+ */
+
+ SetPolyFillMode(dcMem, (gc->fill_rule == EvenOddRule) ? ALTERNATE
+ : WINDING);
+ oldMemBrush = SelectObject(dcMem, CreateSolidBrush(gc->foreground));
+ (*func)(dcMem, winPoints, npoints);
+ BitBlt(dc, rect.left, rect.top, width, height, dcMem, 0, 0, COPYFG);
+
+ /*
+ * If we are rendering an opaque stipple, then draw the polygon in the
+ * background color and copy it to the destination wherever the pattern
+ * is clear.
+ */
+
+ if (gc->fill_style == FillOpaqueStippled) {
+ DeleteObject(SelectObject(dcMem,
+ CreateSolidBrush(gc->background)));
+ (*func)(dcMem, winPoints, npoints);
+ BitBlt(dc, rect.left, rect.top, width, height, dcMem, 0, 0,
+ COPYBG);
+ }
+
+ SelectObject(dcMem, oldPen);
+ DeleteObject(SelectObject(dcMem, oldMemBrush));
+ DeleteObject(SelectObject(dcMem, oldBitmap));
+ DeleteDC(dcMem);
+ } else {
+ oldPen = SelectObject(dc, pen);
+ oldBrush = SelectObject(dc, CreateSolidBrush(gc->foreground));
+ SetROP2(dc, tkpWinRopModes[gc->function]);
+
+ SetPolyFillMode(dc, (gc->fill_rule == EvenOddRule) ? ALTERNATE
+ : WINDING);
+
+ (*func)(dc, winPoints, npoints);
+
+ SelectObject(dc, oldPen);
+ }
+ DeleteObject(SelectObject(dc, oldBrush));
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XDrawLines --
+ *
+ * Draw connected lines.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Renders a series of connected lines.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XDrawLines(display, d, gc, points, npoints, mode)
+ Display* display;
+ Drawable d;
+ GC gc;
+ XPoint* points;
+ int npoints;
+ int mode;
+{
+ HPEN pen;
+ TkWinDCState state;
+ HDC dc;
+
+ if (d == None) {
+ return;
+ }
+
+ dc = TkWinGetDrawableDC(display, d, &state);
+
+ if (!tkpIsWin32s && (gc->line_width > 1)) {
+ LOGBRUSH lb;
+ DWORD style;
+
+ lb.lbStyle = BS_SOLID;
+ lb.lbColor = gc->foreground;
+ lb.lbHatch = 0;
+
+ style = PS_GEOMETRIC|PS_COSMETIC;
+ switch (gc->cap_style) {
+ case CapNotLast:
+ case CapButt:
+ style |= PS_ENDCAP_FLAT;
+ break;
+ case CapRound:
+ style |= PS_ENDCAP_ROUND;
+ break;
+ default:
+ style |= PS_ENDCAP_SQUARE;
+ break;
+ }
+ switch (gc->join_style) {
+ case JoinMiter:
+ style |= PS_JOIN_MITER;
+ break;
+ case JoinRound:
+ style |= PS_JOIN_ROUND;
+ break;
+ default:
+ style |= PS_JOIN_BEVEL;
+ break;
+ }
+ pen = ExtCreatePen(style, gc->line_width, &lb, 0, NULL);
+ } else {
+ pen = CreatePen(PS_SOLID, gc->line_width, gc->foreground);
+ }
+ RenderObject(dc, gc, points, npoints, mode, pen, Polyline);
+ DeleteObject(pen);
+
+ TkWinReleaseDrawableDC(d, dc, &state);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XFillPolygon --
+ *
+ * Draws a filled polygon.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Draws a filled polygon on the specified drawable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XFillPolygon(display, d, gc, points, npoints, shape, mode)
+ Display* display;
+ Drawable d;
+ GC gc;
+ XPoint* points;
+ int npoints;
+ int shape;
+ int mode;
+{
+ HPEN pen;
+ TkWinDCState state;
+ HDC dc;
+
+ if (d == None) {
+ return;
+ }
+
+ dc = TkWinGetDrawableDC(display, d, &state);
+
+ pen = GetStockObject(NULL_PEN);
+ RenderObject(dc, gc, points, npoints, mode, pen, Polygon);
+
+ TkWinReleaseDrawableDC(d, dc, &state);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XDrawRectangle --
+ *
+ * Draws a rectangle.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Draws a rectangle on the specified drawable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XDrawRectangle(display, d, gc, x, y, width, height)
+ Display* display;
+ Drawable d;
+ GC gc;
+ int x;
+ int y;
+ unsigned int width;
+ unsigned int height;
+{
+ HPEN pen, oldPen;
+ TkWinDCState state;
+ HBRUSH oldBrush;
+ HDC dc;
+
+ if (d == None) {
+ return;
+ }
+
+ dc = TkWinGetDrawableDC(display, d, &state);
+
+ pen = CreatePen(PS_SOLID, gc->line_width, gc->foreground);
+ oldPen = SelectObject(dc, pen);
+ oldBrush = SelectObject(dc, GetStockObject(NULL_BRUSH));
+ SetROP2(dc, tkpWinRopModes[gc->function]);
+
+ Rectangle(dc, x, y, x+width+1, y+height+1);
+
+ DeleteObject(SelectObject(dc, oldPen));
+ SelectObject(dc, oldBrush);
+ TkWinReleaseDrawableDC(d, dc, &state);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XDrawArc --
+ *
+ * Draw an arc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Draws an arc on the specified drawable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XDrawArc(display, d, gc, x, y, width, height, start, extent)
+ Display* display;
+ Drawable d;
+ GC gc;
+ int x;
+ int y;
+ unsigned int width;
+ unsigned int height;
+ int start;
+ int extent;
+{
+ display->request++;
+
+ DrawOrFillArc(display, d, gc, x, y, width, height, start, extent, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XFillArc --
+ *
+ * Draw a filled arc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Draws a filled arc on the specified drawable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XFillArc(display, d, gc, x, y, width, height, start, extent)
+ Display* display;
+ Drawable d;
+ GC gc;
+ int x;
+ int y;
+ unsigned int width;
+ unsigned int height;
+ int start;
+ int extent;
+{
+ display->request++;
+
+ DrawOrFillArc(display, d, gc, x, y, width, height, start, extent, 1);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawOrFillArc --
+ *
+ * This procedure handles the rendering of drawn or filled
+ * arcs and chords.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Renders the requested arc.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawOrFillArc(display, d, gc, x, y, width, height, start, extent, fill)
+ Display *display;
+ Drawable d;
+ GC gc;
+ int x, y; /* left top */
+ unsigned int width, height;
+ int start; /* start: three-o'clock (deg*64) */
+ int extent; /* extent: relative (deg*64) */
+ int fill; /* ==0 draw, !=0 fill */
+{
+ HDC dc;
+ HBRUSH brush, oldBrush;
+ HPEN pen, oldPen;
+ TkWinDCState state;
+ int clockwise = (extent < 0); /* non-zero if clockwise */
+ int xstart, ystart, xend, yend;
+ double radian_start, radian_end, xr, yr;
+
+ if (d == None) {
+ return;
+ }
+
+ dc = TkWinGetDrawableDC(display, d, &state);
+
+ SetROP2(dc, tkpWinRopModes[gc->function]);
+
+ /*
+ * Compute the absolute starting and ending angles in normalized radians.
+ * Swap the start and end if drawing clockwise.
+ */
+
+ start = start % (64*360);
+ if (start < 0) {
+ start += (64*360);
+ }
+ extent = (start+extent) % (64*360);
+ if (extent < 0) {
+ extent += (64*360);
+ }
+ if (clockwise) {
+ int tmp = start;
+ start = extent;
+ extent = tmp;
+ }
+ radian_start = XAngleToRadians(start);
+ radian_end = XAngleToRadians(extent);
+
+ /*
+ * Now compute points on the radial lines that define the starting and
+ * ending angles. Be sure to take into account that the y-coordinate
+ * system is inverted.
+ */
+
+ xr = x + width / 2.0;
+ yr = y + height / 2.0;
+ xstart = (int)((xr + cos(radian_start)*width/2.0) + 0.5);
+ ystart = (int)((yr + sin(-radian_start)*height/2.0) + 0.5);
+ xend = (int)((xr + cos(radian_end)*width/2.0) + 0.5);
+ yend = (int)((yr + sin(-radian_end)*height/2.0) + 0.5);
+
+ /*
+ * Now draw a filled or open figure. Note that we have to
+ * increase the size of the bounding box by one to account for the
+ * difference in pixel definitions between X and Windows.
+ */
+
+ pen = CreatePen(PS_SOLID, gc->line_width, gc->foreground);
+ oldPen = SelectObject(dc, pen);
+ if (!fill) {
+ /*
+ * Note that this call will leave a gap of one pixel at the
+ * end of the arc for thin arcs. We can't use ArcTo because
+ * it's only supported under Windows NT.
+ */
+
+ Arc(dc, x, y, x+width+1, y+height+1, xstart, ystart, xend, yend);
+ } else {
+ brush = CreateSolidBrush(gc->foreground);
+ oldBrush = SelectObject(dc, brush);
+ if (gc->arc_mode == ArcChord) {
+ Chord(dc, x, y, x+width+1, y+height+1, xstart, ystart, xend, yend);
+ } else if ( gc->arc_mode == ArcPieSlice ) {
+ Pie(dc, x, y, x+width+1, y+height+1, xstart, ystart, xend, yend);
+ }
+ DeleteObject(SelectObject(dc, oldBrush));
+ }
+ DeleteObject(SelectObject(dc, oldPen));
+ TkWinReleaseDrawableDC(d, dc, &state);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkScrollWindow --
+ *
+ * Scroll a rectangle of the specified window and accumulate
+ * a damage region.
+ *
+ * Results:
+ * Returns 0 if the scroll genereated no additional damage.
+ * Otherwise, sets the region that needs to be repainted after
+ * scrolling and returns 1.
+ *
+ * Side effects:
+ * Scrolls the bits in the window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkScrollWindow(tkwin, gc, x, y, width, height, dx, dy, damageRgn)
+ Tk_Window tkwin; /* The window to be scrolled. */
+ GC gc; /* GC for window to be scrolled. */
+ int x, y, width, height; /* Position rectangle to be scrolled. */
+ int dx, dy; /* Distance rectangle should be moved. */
+ TkRegion damageRgn; /* Region to accumulate damage in. */
+{
+ HWND hwnd = TkWinGetHWND(Tk_WindowId(tkwin));
+ RECT scrollRect;
+
+ scrollRect.left = x;
+ scrollRect.top = y;
+ scrollRect.right = x + width;
+ scrollRect.bottom = y + height;
+ return (ScrollWindowEx(hwnd, dx, dy, &scrollRect, NULL, (HRGN) damageRgn,
+ NULL, 0) == NULLREGION) ? 0 : 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinFillRect --
+ *
+ * This routine fills a rectangle with the foreground color
+ * from the specified GC ignoring all other GC values. This
+ * is the fastest way to fill a drawable with a solid color.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Modifies the contents of the DC drawing surface.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWinFillRect(dc, x, y, width, height, pixel)
+ HDC dc;
+ int x, y, width, height;
+ int pixel;
+{
+ RECT rect;
+ COLORREF oldColor;
+
+ rect.left = x;
+ rect.top = y;
+ rect.right = x + width;
+ rect.bottom = y + height;
+ oldColor = SetBkColor(dc, (COLORREF)pixel);
+ SetBkMode(dc, OPAQUE);
+ ExtTextOut(dc, 0, 0, ETO_OPAQUE, &rect, NULL, 0, NULL);
+ SetBkColor(dc, oldColor);
+}
diff --git a/tk/win/tkWinEmbed.c b/tk/win/tkWinEmbed.c
new file mode 100644
index 00000000000..d30a8663628
--- /dev/null
+++ b/tk/win/tkWinEmbed.c
@@ -0,0 +1,645 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkWinInt.h"
+
+
+/*
+ * One of the following structures exists for each container in this
+ * application. It keeps track of the container window and its
+ * associated embedded window.
+ */
+
+typedef struct Container {
+ HWND parentHWnd; /* Windows HWND to the parent window */
+ TkWindow *parentPtr; /* Tk's information about the container
+ * or NULL if the container isn't
+ * in this process. */
+ HWND embeddedHWnd; /* Windows HWND to the embedded window
+ */
+ TkWindow *embeddedPtr; /* Tk's information about the embedded
+ * 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));
+static void EmbedGeometryRequest _ANSI_ARGS_((
+ Container*containerPtr, int width, int height));
+static void EmbedWindowDeleted _ANSI_ARGS_((TkWindow *winPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CleanupContainerList --
+ *
+ * Finalizes the list of containers.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Releases memory occupied by containers of embedded windows.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* 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 --
+ *
+ * Test command for the embedding facility.
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * Currently it does not do anything.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+int
+TkpTestembedCmd(clientData, interp, argc, argv)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ int argc;
+ char **argv;
+{
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpUseWindow --
+ *
+ * This procedure causes a Tk window to use a given Windows handle
+ * for a window as its underlying window, rather than a new Windows
+ * window being created automatically. It is invoked by an embedded
+ * 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);
+ }
+ return TCL_ERROR;
+ }
+
+ /*
+ * Store the parent window in the platform private data slot so
+ * TkWmMapWindow can use it when creating the wrapper window.
+ */
+
+ winPtr->privatePtr = (struct TkWindowPrivate*) hwnd;
+
+ /*
+ * Create an event handler to clean up the Container structure when
+ * tkwin is eventually deleted.
+ */
+
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask, EmbeddedEventProc,
+ (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
+ */
+
+ containerPtr->embeddedPtr = winPtr;
+ containerPtr->embeddedHWnd = NULL;
+
+ winPtr->flags |= TK_EMBEDDED;
+ winPtr->flags &= (~(TK_MAPPED));
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMakeContainer --
+ *
+ * This procedure is called to indicate that a particular window will
+ * be a container for an embedded application. This changes certain
+ * aspects of the window's behavior, such as whether it will receive
+ * events anymore.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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
+ * container window a WM_USER message, which will be intercepted
+ * by TkWinContainerProc.
+ *
+ * We need to get structure events of the container itself, though.
+ */
+
+ Tk_CreateEventHandler(tkwin, StructureNotifyMask,
+ ContainerEventProc, (ClientData) containerPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbeddedEventProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher when various
+ * useful events are received for a window that is embedded in
+ * another application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Our internal state gets cleaned up when an embedded window is
+ * destroyed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+EmbeddedEventProc(clientData, eventPtr)
+ ClientData clientData; /* Token for container window. */
+ XEvent *eventPtr; /* ResizeRequest event. */
+{
+ TkWindow *winPtr = (TkWindow *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ EmbedWindowDeleted(winPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinEmbeddedEventProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher when
+ * various useful events are received for the *children* of a
+ * container window. It forwards relevant information, such as
+ * geometry requests, from the events into the container's
+ * application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the event. For example, when ConfigureRequest events
+ * occur, geometry information gets set for the container window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+LRESULT
+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");
+ }
+ }
+
+ switch (message) {
+ case TK_ATTACHWINDOW:
+ /* An embedded window (either from this application or from
+ * another application) is trying to attach to this container.
+ * We attach it only if this container is not yet containing any
+ * window.
+ */
+ if (containerPtr->embeddedHWnd == NULL) {
+ containerPtr->embeddedHWnd = (HWND)wParam;
+ } else {
+ return 0;
+ }
+
+ break;
+ case TK_GEOMETRYREQ:
+ EmbedGeometryRequest(containerPtr, wParam, lParam);
+ break;
+ }
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedGeometryRequest --
+ *
+ * This procedure is invoked when an embedded application requests
+ * a particular size. It processes the request (which may or may
+ * not actually resize the window) and reflects the results back
+ * to the embedded application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If we deny the child's size change request, a Configure event
+ * is synthesized to let the child know that the size is the same
+ * as it used to be. Events get processed while we're waiting for
+ * the geometry managers to do their thing.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+EmbedGeometryRequest(containerPtr, width, height)
+ Container *containerPtr; /* Information about the container window. */
+ int width, height; /* Size that the child has requested. */
+{
+ TkWindow * winPtr = containerPtr->parentPtr;
+
+ /*
+ * Forward the requested size into our geometry management hierarchy
+ * via the container window. We need to send a Configure event back
+ * to the embedded application even if we decide not to resize
+ * the window; to make this happen, process all idle event handlers
+ * synchronously here (so that the geometry managers have had a
+ * chance to do whatever they want to do), and if the window's size
+ * didn't change then generate a configure event.
+ */
+ Tk_GeometryRequest((Tk_Window)winPtr, width, height);
+
+ if (containerPtr->embeddedHWnd != NULL) {
+ while (Tcl_DoOneEvent(TCL_IDLE_EVENTS)) {
+ /* Empty loop body. */
+ }
+
+ SetWindowPos(containerPtr->embeddedHWnd, NULL,
+ 0, 0, winPtr->changes.width, winPtr->changes.height, SWP_NOZORDER);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ContainerEventProc --
+ *
+ * This procedure is invoked by the Tk event dispatcher when
+ * various useful events are received for the container window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on the event. For example, when ConfigureRequest events
+ * occur, geometry information gets set for the container window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ContainerEventProc(clientData, eventPtr)
+ ClientData clientData; /* Token for container window. */
+ XEvent *eventPtr; /* ResizeRequest event. */
+{
+ Container *containerPtr = (Container *)clientData;
+ Tk_Window tkwin = (Tk_Window)containerPtr->parentPtr;
+
+ if (eventPtr->type == ConfigureNotify) {
+ if (containerPtr->embeddedPtr == NULL) {
+ return;
+ }
+ /* Resize the embedded window, if there is any */
+ if (containerPtr->embeddedHWnd) {
+ SetWindowPos(containerPtr->embeddedHWnd, NULL,
+ 0, 0, Tk_Width(tkwin), Tk_Height(tkwin), SWP_NOZORDER);
+ }
+ } else if (eventPtr->type == DestroyNotify) {
+ /* The container is gone, remove it from the list */
+ EmbedWindowDeleted(containerPtr->parentPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetOtherWindow --
+ *
+ * If both the container and embedded window are in the same
+ * process, this procedure will return either one, given the other.
+ *
+ * Results:
+ * If winPtr is a container, the return value is the token for the
+ * embedded window, and vice versa. If the "other" window isn't in
+ * this process, NULL is returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ }
+ }
+ panic("TkpGetOtherWindow couldn't find window");
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpClaimFocus --
+ *
+ * This procedure is invoked when someone asks or the input focus
+ * to be put on a window in an embedded application, but the
+ * application doesn't currently have the focus. It requests the
+ * input focus from the container application.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The input focus may change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpClaimFocus(topLevelPtr, force)
+ TkWindow *topLevelPtr; /* Top-level window containing desired
+ * focus window; should be embedded. */
+ int force; /* One means that the container should
+ * claim the focus if it doesn't
+ * currently have it. */
+{
+ HWND hwnd = GetParent(Tk_GetHWND(topLevelPtr->window));
+ SendMessage(hwnd, TK_CLAIMFOCUS, (WPARAM) force, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpRedirectKeyEvent --
+ *
+ * This procedure is invoked when a key press or release event
+ * arrives for an application that does not believe it owns the
+ * input focus. This can happen because of embedding; for example,
+ * X can send an event to an embedded application when the real
+ * focus window is in the container application and is an ancestor
+ * of the container. This procedure's job is to forward the event
+ * back to the application where it really belongs.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The event may get sent to a different application.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpRedirectKeyEvent(winPtr, eventPtr)
+ TkWindow *winPtr; /* Window to which the event was originally
+ * reported. */
+ XEvent *eventPtr; /* X event to redirect (should be KeyPress
+ * or KeyRelease). */
+{
+ /* not implemented */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * EmbedWindowDeleted --
+ *
+ * This procedure is invoked when a window involved in embedding
+ * (as either the container or the embedded application) is
+ * destroyed. It cleans up the Container structure for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A Container structure may be freed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+ }
+}
diff --git a/tk/win/tkWinFont.c b/tk/win/tkWinFont.c
new file mode 100644
index 00000000000..4f7a8095065
--- /dev/null
+++ b/tk/win/tkWinFont.c
@@ -0,0 +1,689 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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. */
+} 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}
+};
+
+/* CYGNUS LOCAL: Map magic windows font names into offsets into a
+ NONCLIENTMETRICS structure. */
+
+static TkStateMap nonClientMap[] = {
+ {Tk_Offset(NONCLIENTMETRICS, lfCaptionFont), "caption"},
+ {Tk_Offset(NONCLIENTMETRICS, lfSmCaptionFont), "smcaption"},
+ {Tk_Offset(NONCLIENTMETRICS, lfMenuFont), "menu"},
+ {Tk_Offset(NONCLIENTMETRICS, lfStatusFont), "status"},
+ {Tk_Offset(NONCLIENTMETRICS, lfMessageFont), "message"},
+ {-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));
+
+/* CYGNUS LOCAL: New static function. */
+static int FontChanged _ANSI_ARGS_((TkFontAttributes *faPtr));
+
+/*
+ *---------------------------------------------------------------------------
+ *
+ * TkpGetNativeFont --
+ *
+ * Map a platform-specific native font name to a TkFont.
+ *
+ * Results:
+ * The return value is a pointer to a TkFont that represents the
+ * native font. If a native font by the given name could not be
+ * found, the return value is NULL.
+ *
+ * Every call to this procedure returns a new TkFont structure,
+ * even if the name has already been seen before. The caller should
+ * 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 --
+ *
+ * Given a desired set of attributes for a font, find a font with
+ * the closest matching attributes.
+ *
+ * Results:
+ * The return value is a pointer to a TkFont that represents the
+ * font with the desired attributes. If a font with the desired
+ * attributes could not be constructed, some other font will be
+ * substituted automatically. NULL is never returned.
+ *
+ * Every call to this procedure returns a new TkFont structure,
+ * even if the specified attributes have already been seen before.
+ * The caller should call TkpDeleteFont() to free the platform-
+ * 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 offset;
+ LOGFONT lf;
+ HFONT hFont;
+ Window window;
+ HWND hwnd;
+ HDC hdc;
+
+ /* CYGNUS LOCAL: Magic handling for fonts in the windows-* family. */
+ if (faPtr->family != NULL
+ && strncmp(faPtr->family, "windows-", 8) == 0
+ && (offset = TkFindStateNum(NULL, NULL, nonClientMap,
+ faPtr->family + 8)) >= 0) {
+ NONCLIENTMETRICS ncm;
+
+ ncm.cbSize = sizeof(ncm);
+ if (! SystemParametersInfo(SPI_GETNONCLIENTMETRICS, sizeof(ncm),
+ (void *) &ncm, 0)) {
+ panic("TkpGetFontFromAttributes: SystemParametersInfo failed");
+ }
+
+ lf = *(LOGFONT *)((char *) &ncm + offset);
+ } else {
+ 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 --
+ *
+ * Called to release a font allocated by TkpGetNativeFont() or
+ * TkpGetFontFromAttributes(). The caller should have already
+ * released the fields of the TkFont that are used exclusively by
+ * the generic TkFont code.
+ *
+ * Results:
+ * None.
+ *
+ * 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;
+
+ 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;
+
+ GetTextExtentPoint32(hdc, source, numChars, &size);
+ curX = size.cx;
+ curIdx = numChars;
+ } else {
+ int max;
+ int *partials;
+ SIZE size;
+
+ partials = (int *) ckalloc(numChars * sizeof (int));
+ GetTextExtentExPoint(hdc, source, numChars, maxLength, &max,
+ partials, &size);
+
+ if ((flags & TK_WHOLE_WORDS) && max < numChars) {
+ int sawSpace;
+ int i;
+
+ sawSpace = 0;
+ i = max;
+ while (i >= 0 && !isspace(source[i])) {
+ --i;
+ }
+ while (i >= 0 && isspace(source[i])) {
+ sawSpace = 1;
+ --i;
+ }
+
+ /*
+ * If a space char was not found, and the flag for forcing
+ * at least on (or more) chars to be drawn is false, then
+ * set MAX to zero so no text is drawn. Otherwise, if a
+ * space was found, set max to be one char past the space.
+ */
+
+ if ((i < 0) && !(flags & TK_AT_LEAST_ONE)) {
+ max = 0;
+ } else if (sawSpace) {
+ max = i + 1;
+ }
+
+ }
+
+ if (max == 0) {
+ curX = 0;
+ } else {
+ curX = partials[max - 1];
+ }
+
+ if (((flags & TK_PARTIAL_OK) && max < numChars && curX < maxLength)
+ || ((flags & TK_AT_LEAST_ONE) && max == 0 && numChars > 0)) {
+ /* CYGNUS LOCAL - BUG ALERT - We have to pass the bogus length, and
+ the dummyMax parameter, because without them the call crashes on
+ NT/J Service Pack 3 and less. This is documented in the
+ Microsoft Knowledge Base. */
+
+ int dummyMax;
+
+ /*
+ * We want to include the first character that didn't
+ * quite fit. Call the function again to include the
+ * width of the extra character.
+ */
+
+ GetTextExtentExPoint(hdc, source, max + 1, INT_MAX, &dummyMax,
+ partials, &size);
+ curX = partials[max];
+ ++max;
+
+ }
+
+ ckfree((char *) partials);
+ curIdx = max;
+ }
+
+ 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;
+ }
+
+ dc = TkWinGetDrawableDC(display, drawable, &state);
+
+ SetROP2(dc, tkpWinRopModes[gc->function]);
+
+ if ((gc->fill_style == FillStippled
+ || gc->fill_style == FillOpaqueStippled)
+ && gc->stipple != None) {
+ TkWinDrawable *twdPtr = (TkWinDrawable *)gc->stipple;
+ HBRUSH oldBrush, stipple;
+ HBITMAP oldBitmap, bitmap;
+ HDC dcMem;
+ TEXTMETRIC tm;
+ SIZE size;
+
+ if (twdPtr->type != TWD_BITMAP) {
+ panic("unexpected drawable type in stipple");
+ }
+
+ /*
+ * Select stipple pattern into destination dc.
+ */
+
+ 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);
+
+ 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;
+}
+
+/* CYGNUS LOCAL: This function is called when one of the non client
+ metrics changes. We don't expect this to happen very often, so we
+ always try to update all the known fonts. */
+
+void
+TkWinNCMetricsChanged(tkwin)
+ Tk_Window tkwin;
+{
+ TkUpdateFonts(tkwin, FontChanged);
+}
+
+/* This function returns non-zero when passed a font in a magic
+ Windows non client font. */
+
+static int
+FontChanged(faPtr)
+ TkFontAttributes *faPtr;
+{
+ return (faPtr->family != NULL
+ && strncmp(faPtr->family, "windows-", 8) == 0
+ && TkFindStateNum(NULL, NULL, nonClientMap,
+ faPtr->family + 8) >= 0);
+}
diff --git a/tk/win/tkWinImage.c b/tk/win/tkWinImage.c
new file mode 100644
index 00000000000..dca6583b669
--- /dev/null
+++ b/tk/win/tkWinImage.c
@@ -0,0 +1,329 @@
+/*
+ * 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$
+ */
+
+#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,
+ unsigned long pixel));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DestroyImage --
+ *
+ * This is a trivial wrapper around ckfree to make it possible to
+ * pass ckfree as a pointer.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Deallocates the image.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+DestroyImage(imagePtr)
+ XImage *imagePtr; /* image to free */
+{
+ if (imagePtr) {
+ if (imagePtr->data) {
+ ckfree((char*)imagePtr->data);
+ }
+ ckfree((char*)imagePtr);
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ImageGetPixel --
+ *
+ * Get a single pixel from an image.
+ *
+ * Results:
+ * Returns the 32 bit pixel value.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+unsigned long
+ImageGetPixel(image, x, y)
+ XImage *image;
+ int x, y;
+{
+ unsigned long pixel = 0;
+ unsigned char *srcPtr = &(image->data[(y * image->bytes_per_line)
+ + ((x * image->bits_per_pixel) / NBBY)]);
+
+ switch (image->bits_per_pixel) {
+ case 32:
+ case 24:
+ pixel = RGB(srcPtr[2], srcPtr[1], srcPtr[0]);
+ break;
+ case 16:
+ pixel = RGB(((((WORD*)srcPtr)[0]) >> 7) & 0xf8,
+ ((((WORD*)srcPtr)[0]) >> 2) & 0xf8,
+ ((((WORD*)srcPtr)[0]) << 3) & 0xf8);
+ break;
+ case 8:
+ pixel = srcPtr[0];
+ break;
+ case 4:
+ pixel = ((x%2) ? (*srcPtr) : ((*srcPtr) >> 4)) & 0x0f;
+ break;
+ case 1:
+ pixel = ((*srcPtr) & (0x80 >> (x%8))) ? 1 : 0;
+ break;
+ }
+ return pixel;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * PutPixel --
+ *
+ * Set a single pixel in an image.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+PutPixel(image, x, y, pixel)
+ XImage *image;
+ int x, y;
+ unsigned long pixel;
+{
+ unsigned char *destPtr = &(image->data[(y * image->bytes_per_line)
+ + ((x * image->bits_per_pixel) / NBBY)]);
+
+ switch (image->bits_per_pixel) {
+ case 32:
+ /*
+ * Pixel is DWORD: 0x00BBGGRR
+ */
+
+ destPtr[3] = 0;
+ case 24:
+ /*
+ * Pixel is triplet: 0xBBGGRR.
+ */
+
+ destPtr[0] = (unsigned char) GetBValue(pixel);
+ destPtr[1] = (unsigned char) GetGValue(pixel);
+ destPtr[2] = (unsigned char) GetRValue(pixel);
+ break;
+ case 16:
+ /*
+ * Pixel is WORD: 5-5-5 (R-G-B)
+ */
+
+ (*(WORD*)destPtr) =
+ ((GetRValue(pixel) & 0xf8) << 7)
+ | ((GetGValue(pixel) & 0xf8) <<2)
+ | ((GetBValue(pixel) & 0xf8) >> 3);
+ break;
+ case 8:
+ /*
+ * Pixel is 8-bit index into color table.
+ */
+
+ (*destPtr) = (unsigned char) pixel;
+ break;
+ case 4:
+ /*
+ * Pixel is 4-bit index in MSBFirst order.
+ */
+ if (x%2) {
+ (*destPtr) = (unsigned char) (((*destPtr) & 0xf0)
+ | (pixel & 0x0f));
+ } else {
+ (*destPtr) = (unsigned char) (((*destPtr) & 0x0f)
+ | ((pixel << 4) & 0xf0));
+ }
+ break;
+ case 1: {
+ /*
+ * Pixel is bit in MSBFirst order.
+ */
+
+ int mask = (0x80 >> (x%8));
+ if (pixel) {
+ (*destPtr) |= mask;
+ } else {
+ (*destPtr) &= ~mask;
+ }
+ }
+ break;
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XCreateImage --
+ *
+ * Allocates storage for a new XImage.
+ *
+ * Results:
+ * Returns a newly allocated XImage.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XImage *
+XCreateImage(display, visual, depth, format, offset, data, width, height,
+ bitmap_pad, bytes_per_line)
+ 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;
+{
+ XImage* imagePtr = (XImage *) ckalloc(sizeof(XImage));
+ imagePtr->width = width;
+ imagePtr->height = height;
+ imagePtr->xoffset = offset;
+ imagePtr->format = format;
+ imagePtr->data = data;
+ imagePtr->byte_order = LSBFirst;
+ imagePtr->bitmap_unit = 8;
+ imagePtr->bitmap_bit_order = MSBFirst;
+ imagePtr->bitmap_pad = bitmap_pad;
+ imagePtr->bits_per_pixel = depth;
+ imagePtr->depth = depth;
+
+ /*
+ * Under Windows, bitmap_pad must be on an LONG data-type boundary.
+ */
+
+#define LONGBITS (sizeof(LONG) * 8)
+
+ bitmap_pad = (bitmap_pad + LONGBITS - 1) / LONGBITS * LONGBITS;
+
+ /*
+ * Round to the nearest bitmap_pad boundary.
+ */
+
+ if (bytes_per_line) {
+ imagePtr->bytes_per_line = bytes_per_line;
+ } else {
+ imagePtr->bytes_per_line = (((depth * width)
+ + (bitmap_pad - 1)) >> 3) & ~((bitmap_pad >> 3) - 1);
+ }
+
+ imagePtr->red_mask = 0;
+ imagePtr->green_mask = 0;
+ imagePtr->blue_mask = 0;
+
+ imagePtr->f.put_pixel = PutPixel;
+ imagePtr->f.get_pixel = ImageGetPixel;
+ imagePtr->f.destroy_image = DestroyImage;
+ imagePtr->f.create_image = NULL;
+ imagePtr->f.sub_image = NULL;
+ imagePtr->f.add_pixel = NULL;
+
+ return imagePtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XGetImage --
+ *
+ * This function copies data from a pixmap or window into an
+ * XImage.
+ *
+ * Results:
+ * Returns a newly allocated image containing the data from the
+ * given rectangle of the given drawable.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XImage *
+XGetImage(display, d, x, y, width, height, plane_mask, format)
+ Display* display;
+ Drawable d;
+ int x;
+ int y;
+ unsigned int width;
+ unsigned int height;
+ unsigned long plane_mask;
+ int format;
+{
+ TkWinDrawable *twdPtr = (TkWinDrawable *)d;
+ XImage *imagePtr;
+ HDC dc;
+ char infoBuf[sizeof(BITMAPINFO) + sizeof(RGBQUAD)];
+ BITMAPINFO *infoPtr = (BITMAPINFO*)infoBuf;
+
+ if ((twdPtr->type != TWD_BITMAP) || (twdPtr->bitmap.handle == NULL)
+ || (format != XYPixmap) || (plane_mask != 1)) {
+ panic("XGetImage: not implemented");
+ }
+
+
+ imagePtr = XCreateImage(display, NULL, 1, XYBitmap, 0, NULL,
+ width, height, 32, 0);
+ imagePtr->data = ckalloc(imagePtr->bytes_per_line * imagePtr->height);
+
+ dc = GetDC(NULL);
+
+ GetDIBits(dc, twdPtr->bitmap.handle, 0, height, NULL,
+ infoPtr, DIB_RGB_COLORS);
+
+ infoPtr->bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
+ infoPtr->bmiHeader.biWidth = width;
+ infoPtr->bmiHeader.biHeight = -(LONG)height;
+ infoPtr->bmiHeader.biPlanes = 1;
+ infoPtr->bmiHeader.biBitCount = 1;
+ infoPtr->bmiHeader.biCompression = BI_RGB;
+ infoPtr->bmiHeader.biCompression = 0;
+ infoPtr->bmiHeader.biXPelsPerMeter = 0;
+ infoPtr->bmiHeader.biYPelsPerMeter = 0;
+ infoPtr->bmiHeader.biClrUsed = 0;
+ infoPtr->bmiHeader.biClrImportant = 0;
+
+ GetDIBits(dc, twdPtr->bitmap.handle, 0, height, imagePtr->data,
+ infoPtr, DIB_RGB_COLORS);
+ ReleaseDC(NULL, dc);
+
+ return imagePtr;
+}
diff --git a/tk/win/tkWinInit.c b/tk/win/tkWinInit.c
new file mode 100644
index 00000000000..4ddfd56cb4e
--- /dev/null
+++ b/tk/win/tkWinInit.c
@@ -0,0 +1,121 @@
+/*
+ * 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$
+ */
+
+#include "tkWinInt.h"
+
+/*
+ * The Init script (common to Windows and Unix platforms) is
+ * defined in tkInitScript.h
+ */
+#include "tkInitScript.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpInit(interp)
+ Tcl_Interp *interp;
+{
+ return Tcl_Eval(interp, initScript);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetAppName --
+ *
+ * Retrieves the name of the current application from a platform
+ * specific location. For Windows, the application name is the
+ * root of the tail of the path contained in the tcl variable argv0.
+ *
+ * Results:
+ * Returns the application name in the given Tcl_DString.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpGetAppName(interp, namePtr)
+ Tcl_Interp *interp;
+ Tcl_DString *namePtr; /* A previously initialized Tcl_DString. */
+{
+ int argc;
+ char **argv = NULL, *name, *p;
+
+ name = Tcl_GetVar(interp, "argv0", TCL_GLOBAL_ONLY);
+ if (name != NULL) {
+ Tcl_SplitPath(name, &argc, &argv);
+ if (argc > 0) {
+ name = argv[argc-1];
+ p = strrchr(name, '.');
+ if (p != NULL) {
+ *p = '\0';
+ }
+ } else {
+ name = NULL;
+ }
+ }
+ if ((name == NULL) || (*name == 0)) {
+ name = "tk";
+ }
+ Tcl_DStringAppend(namePtr, name, -1);
+ if (argv != NULL) {
+ ckfree((char *)argv);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDisplayWarning --
+ *
+ * This routines is called from Tk_Main to display warning
+ * messages that occur during startup.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Displays a message box.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDisplayWarning(msg, title)
+ char *msg; /* Message to be displayed. */
+ char *title; /* Title of warning. */
+{
+ MessageBox(NULL, msg, title, MB_OK | MB_ICONEXCLAMATION | MB_SYSTEMMODAL
+ | MB_SETFOREGROUND | MB_TOPMOST);
+}
diff --git a/tk/win/tkWinInt.h b/tk/win/tkWinInt.h
new file mode 100644
index 00000000000..853709861d3
--- /dev/null
+++ b/tk/win/tkWinInt.h
@@ -0,0 +1,202 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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
+#endif
+
+#ifndef __GNUC__
+/* gcc won't let us do this--it causes a conflict with the typedef in
+ tkFont.h (as it should). */
+typedef struct TkFontAttributes TkFontAttributes;
+#endif
+
+/*
+ * The TkWinDCState is used to save the state of a device context
+ * so that it can be restored later.
+ */
+
+typedef struct TkWinDCState {
+ HPALETTE palette;
+} TkWinDCState;
+
+/*
+ * The TkWinDrawable is the internal implementation of an X Drawable (either
+ * a Window or a Pixmap). The following constants define the valid Drawable
+ * types.
+ */
+
+#define TWD_BITMAP 1
+#define TWD_WINDOW 2
+#define TWD_WINDC 3
+
+typedef struct {
+ int type;
+ HWND handle;
+ TkWindow *winPtr;
+} TkWinWindow;
+
+typedef struct {
+ int type;
+ HBITMAP handle;
+ Colormap colormap;
+ int depth;
+} TkWinBitmap;
+
+typedef struct {
+ int type;
+ HDC hdc;
+}TkWinDC;
+
+typedef union {
+ int type;
+ TkWinWindow window;
+ TkWinBitmap bitmap;
+ TkWinDC winDC;
+} TkWinDrawable;
+
+/*
+ * The following macros are used to retrieve internal values from a Drawable.
+ */
+
+#define TkWinGetHWND(w) (((TkWinDrawable *) w)->window.handle)
+#define TkWinGetWinPtr(w) (((TkWinDrawable*)w)->window.winPtr)
+#define TkWinGetHBITMAP(w) (((TkWinDrawable*)w)->bitmap.handle)
+#define TkWinGetColormap(w) (((TkWinDrawable*)w)->bitmap.colormap)
+#define TkWinGetHDC(w) (((TkWinDrawable *) w)->winDC.hdc)
+
+/*
+ * The following structure is used to encapsulate palette information.
+ */
+
+typedef struct {
+ HPALETTE palette; /* Palette handle used when drawing. */
+ UINT size; /* Number of entries in the palette. */
+ int stale; /* 1 if palette needs to be realized,
+ * otherwise 0. If the palette is stale,
+ * then an idle handler is scheduled to
+ * realize the palette. */
+ Tcl_HashTable refCounts; /* Hash table of palette entry reference counts
+ * indexed by pixel value. */
+} TkWinColormap;
+
+/*
+ * The following macro retrieves the Win32 palette from a colormap.
+ */
+
+#define TkWinGetPalette(colormap) (((TkWinColormap *) colormap)->palette)
+
+/*
+ * The following macros define the class names for Tk Window types.
+ */
+
+#define TK_WIN_TOPLEVEL_CLASS_NAME "TkTopLevel"
+#define TK_WIN_CHILD_CLASS_NAME "TkChild"
+
+/*
+ * The following variable indicates whether we are restricted to Win32s
+ * GDI calls.
+ */
+
+extern int tkpIsWin32s;
+
+/*
+ * The following variable is a translation table between X gc functions and
+ * Win32 raster op modes.
+ */
+
+extern int tkpWinRopModes[];
+
+/*
+ * The following defines are used with TkWinGetBorderPixels to get the
+ * extra 2 border colors from a Tk_3DBorder.
+ */
+
+#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));
+
+/* CYGNUS LOCAL. */
+extern void TkWinNCMetricsChanged _ANSI_ARGS_((Tk_Window tkwin));
+extern void TkWinSysColorChange _ANSI_ARGS_((void));
+
+#endif /* _TKWININT */
+
diff --git a/tk/win/tkWinKey.c b/tk/win/tkWinKey.c
new file mode 100644
index 00000000000..02d984e8119
--- /dev/null
+++ b/tk/win/tkWinKey.c
@@ -0,0 +1,381 @@
+/*
+ * 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$
+ */
+
+#include "tkWinInt.h"
+
+/*
+ * FIXME - these are in i386-cygwin32/includes/Windows32/Defines.h
+ * but not in the current Progressive release...
+ */
+
+#ifdef __CYGWIN32__
+#define VK_LWIN (91)
+#define VK_RWIN (92)
+#define VK_APPS (93)
+#endif
+
+typedef struct {
+ unsigned int keycode;
+ KeySym keysym;
+} Keys;
+
+static Keys keymap[] = {
+ VK_CANCEL, XK_Cancel,
+ VK_BACK, XK_BackSpace,
+ VK_TAB, XK_Tab,
+ VK_CLEAR, XK_Clear,
+ VK_RETURN, XK_Return,
+ VK_SHIFT, XK_Shift_L,
+ VK_CONTROL, XK_Control_L,
+ VK_MENU, XK_Alt_L,
+ VK_PAUSE, XK_Pause,
+ VK_CAPITAL, XK_Caps_Lock,
+ VK_ESCAPE, XK_Escape,
+ VK_SPACE, XK_space,
+ VK_PRIOR, XK_Prior,
+ VK_NEXT, XK_Next,
+ VK_END, XK_End,
+ VK_HOME, XK_Home,
+ VK_LEFT, XK_Left,
+ VK_UP, XK_Up,
+ VK_RIGHT, XK_Right,
+ VK_DOWN, XK_Down,
+ VK_SELECT, XK_Select,
+ VK_PRINT, XK_Print,
+ VK_EXECUTE, XK_Execute,
+ VK_INSERT, XK_Insert,
+ VK_DELETE, XK_Delete,
+ VK_HELP, XK_Help,
+ VK_F1, XK_F1,
+ VK_F2, XK_F2,
+ VK_F3, XK_F3,
+ VK_F4, XK_F4,
+ VK_F5, XK_F5,
+ VK_F6, XK_F6,
+ VK_F7, XK_F7,
+ VK_F8, XK_F8,
+ VK_F9, XK_F9,
+ VK_F10, XK_F10,
+ VK_F11, XK_F11,
+ VK_F12, XK_F12,
+ VK_F13, XK_F13,
+ VK_F14, XK_F14,
+ VK_F15, XK_F15,
+ VK_F16, XK_F16,
+ VK_F17, XK_F17,
+ VK_F18, XK_F18,
+ VK_F19, XK_F19,
+ 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
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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 --
+ *
+ * Translate from a system-dependent keycode to a
+ * system-independent keysym.
+ *
+ * Results:
+ * Returns the translated keysym, or NoSymbol on failure.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+KeySym
+XKeycodeToKeysym(display, keycode, index)
+ Display* display;
+ unsigned int keycode;
+ int index;
+{
+ Keys* key;
+ BYTE keys[256];
+ int result;
+ char buf[4];
+ unsigned int scancode = MapVirtualKey(keycode, 0);
+
+ memset(keys, 0, 256);
+ if (index & 0x02) {
+ keys[VK_NUMLOCK] = 1;
+ }
+ if (index & 0x01) {
+ keys[VK_SHIFT] = 0x80;
+ }
+ 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++) {
+ if (key->keycode == keycode) {
+ return key->keysym;
+ }
+ }
+
+ return NoSymbol;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XKeysymToKeycode --
+ *
+ * Translate a keysym back into a keycode.
+ *
+ * Results:
+ * Returns the keycode that would generate the specified keysym.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+KeyCode
+XKeysymToKeycode(display, keysym)
+ Display* display;
+ KeySym keysym;
+{
+ Keys* key;
+ SHORT result;
+
+ if (keysym >= 0x20) {
+ result = VkKeyScan((char) keysym);
+ if (result != -1) {
+ return (KeyCode) (result & 0xff);
+ }
+ }
+
+ /*
+ * Couldn't map the character to a virtual keycode, so do a
+ * table lookup.
+ */
+
+ for (key = keymap; key->keycode != 0; key++) {
+ if (key->keysym == keysym) {
+ return key->keycode;
+ }
+ }
+ return 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XGetModifierMapping --
+ *
+ * Fetch the current keycodes used as modifiers.
+ *
+ * Results:
+ * Returns a new modifier map.
+ *
+ * Side effects:
+ * Allocates a new modifier map data structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XModifierKeymap *
+XGetModifierMapping(display)
+ Display* display;
+{
+ XModifierKeymap *map = (XModifierKeymap *)ckalloc(sizeof(XModifierKeymap));
+
+ map->max_keypermod = 1;
+ map->modifiermap = (KeyCode *) ckalloc(sizeof(KeyCode)*8);
+ map->modifiermap[ShiftMapIndex] = VK_SHIFT;
+ map->modifiermap[LockMapIndex] = VK_CAPITAL;
+ map->modifiermap[ControlMapIndex] = VK_CONTROL;
+ map->modifiermap[Mod1MapIndex] = VK_NUMLOCK;
+ map->modifiermap[Mod2MapIndex] = VK_MENU;
+ map->modifiermap[Mod3MapIndex] = VK_SCROLL;
+ map->modifiermap[Mod4MapIndex] = 0;
+ map->modifiermap[Mod5MapIndex] = 0;
+ return map;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XFreeModifiermap --
+ *
+ * Deallocate a modifier map that was created by
+ * XGetModifierMapping.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees the datastructure referenced by modmap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XFreeModifiermap(modmap)
+ XModifierKeymap* modmap;
+{
+ ckfree((char *) modmap->modifiermap);
+ ckfree((char *) modmap);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XStringToKeysym --
+ *
+ * Translate a keysym name to the matching keysym.
+ *
+ * Results:
+ * Returns the keysym. Since this is already handled by
+ * Tk's StringToKeysym function, we just return NoSymbol.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+KeySym
+XStringToKeysym(string)
+ _Xconst char *string;
+{
+ return NoSymbol;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XKeysymToString --
+ *
+ * Convert a keysym to character form.
+ *
+ * Results:
+ * Returns NULL, since Tk will have handled this already.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+XKeysymToString(keysym)
+ KeySym keysym;
+{
+ return NULL;
+}
+
+
diff --git a/tk/win/tkWinMenu.c b/tk/win/tkWinMenu.c
new file mode 100644
index 00000000000..8baefb25bdc
--- /dev/null
+++ b/tk/win/tkWinMenu.c
@@ -0,0 +1,2699 @@
+/*
+ * tkWinMenu.c --
+ *
+ * This module implements the Windows 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$
+ */
+
+#define OEMRESOURCE
+#include <string.h>
+#include "tkMenu.h"
+#include "tkWinInt.h"
+
+/*
+ * The class of the window for popup menus.
+ */
+
+#define MENU_CLASS_NAME "MenuWindowClass"
+
+/*
+ * Used to align a windows bitmap inside a rectangle
+ */
+
+#define ALIGN_BITMAP_LEFT 0x00000001
+#define ALIGN_BITMAP_RIGHT 0x00000002
+#define ALIGN_BITMAP_TOP 0x00000004
+#define ALIGN_BITMAP_BOTTOM 0x00000008
+
+/*
+ * Platform-specific menu flags:
+ *
+ * MENU_SYSTEM_MENU Non-zero means that the Windows menu handle
+ * was retrieved with GetSystemMenu and needs
+ * to be disposed of specially.
+ * MENU_RECONFIGURE_PENDING
+ * Non-zero means that an idle handler has
+ * been set up to reconfigure the Windows menu
+ * handle for this menu.
+ */
+
+#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,
+ 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_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr,
+ Drawable d, Tk_3DBorder activeBorder,
+ Tk_3DBorder bgBorder, int x, int y,
+ int width, int heigth));
+static void DrawMenuEntryIndicator _ANSI_ARGS_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr,
+ Drawable d, GC gc, GC indicatorGC,
+ Tk_Font tkfont,
+ CONST Tk_FontMetrics *fmPtr, int x, int y,
+ int width, int height));
+static void DrawMenuEntryLabel _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 DrawMenuSeparator _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 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 DrawMenuUnderline _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 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));
+static void GetMenuIndicatorGeometry _ANSI_ARGS_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr,
+ Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr,
+ int *widthPtr, int *heightPtr));
+static void GetMenuSeparatorGeometry _ANSI_ARGS_((
+ TkMenu *menuPtr, TkMenuEntry *mePtr,
+ Tk_Font tkfont, CONST Tk_FontMetrics *fmPtr,
+ int *widthPtr, int *heightPtr));
+static void GetTearoffEntryGeometry _ANSI_ARGS_((TkMenu *menuPtr,
+ TkMenuEntry *mePtr, Tk_Font tkfont,
+ CONST Tk_FontMetrics *fmPtr, int *widthPtr,
+ int *heightPtr));
+static int GetNewID _ANSI_ARGS_((TkMenuEntry *mePtr,
+ int *menuIDPtr));
+static void MenuExitProc _ANSI_ARGS_((ClientData clientData));
+static int MenuKeyBindProc _ANSI_ARGS_((
+ ClientData clientData,
+ 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));
+
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetNewID --
+ *
+ * Allocates a new menu id and marks it in use.
+ *
+ * Results:
+ * Returns TCL_OK if succesful; TCL_ERROR if there are no more
+ * ids of the appropriate type to allocate. menuIDPtr contains
+ * the new id if succesful.
+ *
+ * Side effects:
+ * An entry is created for the menu in the command hash table,
+ * and the hash entry is stored in the appropriate field in the
+ * menu data structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+GetNewID(mePtr, menuIDPtr)
+ 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;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FreeID --
+ *
+ * Marks the itemID as free.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The hash table entry for the ID is cleared.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+FreeID(commandID)
+ int commandID;
+{
+ Tcl_HashEntry *entryPtr = Tcl_FindHashEntry(&commandTable,
+ (char *) commandID);
+
+ if (entryPtr != NULL) {
+ Tcl_DeleteHashEntry(entryPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpNewMenu --
+ *
+ * Gets a new blank menu. Only the platform specific options are filled
+ * in.
+ *
+ * Results:
+ * Standard TCL error.
+ *
+ * Side effects:
+ * Allocates a Windows menu handle and places it in the platformData
+ * field of the menuPtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyMenu --
+ *
+ * Destroys platform-specific menu structures.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * All platform-specific allocations are freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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 (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) {
+ if (strcmp(searchEntryPtr->name, 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(&winMenuTable, (char *) winMenuHdl);
+ if (hashEntryPtr != NULL) {
+ Tcl_DeleteHashEntry(hashEntryPtr);
+ }
+ DestroyMenu(winMenuHdl);
+ }
+ menuPtr->platformData = NULL;
+
+ if (menuPtr == modalMenuPtr) {
+ modalMenuPtr = NULL;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyMenuEntry --
+ *
+ * Cleans up platform-specific menu entry items.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * All platform-specific allocations are freed up.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyMenuEntry(mePtr)
+ TkMenuEntry *mePtr; /* The entry to destroy */
+{
+ TkMenu *menuPtr = mePtr->menuPtr;
+ HMENU winMenuHdl = (HMENU) menuPtr->platformData;
+
+ if (NULL != winMenuHdl) {
+ if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) {
+ menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
+ Tcl_DoWhenIdle(ReconfigureWindowsMenu, (ClientData) menuPtr);
+ }
+ }
+ FreeID((int) mePtr->platformEntryData);
+ mePtr->platformEntryData = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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. Allocates the memory with alloc. The caller
+ * should free the memory.
+ *
+ * Results:
+ * itemText points to the new text for the item.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static char *
+GetEntryText(mePtr)
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ReconfigureWindowsMenu --
+ *
+ * Tears down and rebuilds the platform-specific part of this menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Configuration information get set for mePtr; old resources
+ * get freed, if any need it.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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_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;
+
+ 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)
+ && (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;
+ }
+ }
+
+
+ if ((menuPtr->menuType == MENUBAR)
+ && (menuPtr->parentTopLevelPtr != NULL)) {
+ DrawMenuBar(TkWinGetWrapperWindow(menuPtr->parentTopLevelPtr));
+ Tk_GeometryRequest(menuPtr->parentTopLevelPtr, width, height);
+ }
+
+ menuPtr->menuFlags &= ~(MENU_RECONFIGURE_PENDING);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpPostMenu --
+ *
+ * Posts a menu on the screen
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The menu is posted and handled.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpPostMenu(interp, menuPtr, x, y)
+ Tcl_Interp *interp;
+ TkMenu *menuPtr;
+ int x;
+ int y;
+{
+ 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;
+ noGoawayRect.right = x + 50;
+ } else {
+ int left, top;
+ Tk_GetRootCoords(parentWindow, &left, &top);
+ noGoawayRect.left = left;
+ noGoawayRect.top = top;
+ noGoawayRect.bottom = noGoawayRect.top + Tk_Height(parentWindow);
+ noGoawayRect.right = noGoawayRect.left + Tk_Width(parentWindow);
+ }
+
+ Tcl_SetServiceMode(TCL_SERVICE_NONE);
+
+ /*
+ * Make an assumption here. If the right button is down,
+ * then we want to track it. Otherwise, track the left mouse button.
+ */
+
+ flags = TPM_LEFTALIGN;
+ if (GetSystemMetrics(SM_SWAPBUTTON)) {
+ if (GetAsyncKeyState(VK_LBUTTON) < 0) {
+ flags |= TPM_RIGHTBUTTON;
+ } else {
+ flags |= TPM_LEFTBUTTON;
+ }
+ } else {
+ if (GetAsyncKeyState(VK_RBUTTON) < 0) {
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuNewEntry --
+ *
+ * Adds a pointer to a new menu entry structure with the platform-
+ * specific fields filled in.
+ *
+ * Results:
+ * Standard TCL error.
+ *
+ * Side effects:
+ * A new command ID is allocated and stored in the platformEntryData
+ * field of mePtr.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpMenuNewEntry(mePtr)
+ TkMenuEntry *mePtr;
+{
+ int commandID;
+ TkMenu *menuPtr = mePtr->menuPtr;
+
+ if (GetNewID(mePtr, &commandID) != TCL_OK) {
+ return TCL_ERROR;
+ }
+
+ if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) {
+ menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
+ Tcl_DoWhenIdle(ReconfigureWindowsMenu, (ClientData) menuPtr);
+ }
+
+ mePtr->platformEntryData = (TkMenuPlatformEntryData) commandID;
+
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinMenuProc --
+ *
+ * The window proc for the dummy window we put popups in. This allows
+ * is to post a popup whether or not we know what the parent window
+ * is.
+ *
+ * Results:
+ * Returns whatever is appropriate for the message in question.
+ *
+ * Side effects:
+ * Normal side-effect for windows messages.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static LRESULT CALLBACK
+TkWinMenuProc(hwnd, message, wParam, lParam)
+ HWND hwnd;
+ UINT message;
+ WPARAM wParam;
+ LPARAM lParam;
+{
+ LRESULT lResult;
+
+ if (!TkWinHandleMenuEvent(&hwnd, &message, &wParam, &lParam, &lResult)) {
+ lResult = DefWindowProc(hwnd, message, wParam, lParam);
+ }
+ return lResult;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinHandleMenuEvent --
+ *
+ * Filters out menu messages from messages passed to a top-level.
+ * Will respond appropriately to WM_COMMAND, WM_MENUSELECT,
+ * WM_MEASUREITEM, WM_DRAWITEM
+ *
+ * Result:
+ * Returns 1 if this handled the message; 0 if it did not.
+ *
+ * Side effects:
+ * All of the parameters may be modified so that the caller can
+ * think it is getting a different message. plResult points to
+ * the result that should be returned to windows from this message.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkWinHandleMenuEvent(phwnd, pMessage, pwParam, plParam, plResult)
+ HWND *phwnd;
+ UINT *pMessage;
+ WPARAM *pwParam;
+ 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) {
+ 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 {
+ modalMenuPtr = NULL;
+ }
+ break;
+
+#if 0
+ /* CYGNUS LOCAL: WM_SYSCOMMAND is not the same as WM_COMMAND. */
+ case WM_SYSCOMMAND:
+#endif
+ case WM_COMMAND: {
+ TkMenuInit();
+ if (HIWORD(*pwParam) != 0) {
+ break;
+ }
+ hashEntryPtr = Tcl_FindHashEntry(&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)) {
+ 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);
+ }
+ }
+
+ 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(&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;
+ 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 {
+ 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();
+ }
+ }
+ }
+ }
+ return returnResult;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RecursivelyClearActiveMenu --
+ *
+ * Recursively clears the active entry in the menu's cascade hierarchy.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates <<MenuSelect>> virtual events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+RecursivelyClearActiveMenu(
+ TkMenu *menuPtr) /* The menu to reset. */
+{
+ int i;
+ TkMenuEntry *mePtr;
+
+ TkActivateMenuEntry(menuPtr, -1);
+ MenuSelectEvent(menuPtr);
+ for (i = 0; i < menuPtr->numEntries; i++) {
+ mePtr = menuPtr->entries[i];
+ if (mePtr->type == CASCADE_ENTRY) {
+ if ((mePtr->childMenuRefPtr != NULL)
+ && (mePtr->childMenuRefPtr->menuPtr != NULL)) {
+ RecursivelyClearActiveMenu(mePtr->childMenuRefPtr->menuPtr);
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpSetWindowMenuBar --
+ *
+ * Associates a given menu with a window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * On Windows and UNIX, associates the platform menu with the
+ * platform window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ }
+ } else {
+ TkWinSetMenu(tkwin, NULL);
+ }
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpSetMainMenubar --
+ *
+ * Puts the menu associated with a window into the menubar. Should
+ * only be called when the window is in front.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The menubar is changed.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+TkpSetMainMenubar(
+ Tcl_Interp *interp, /* The interpreter of the application */
+ Tk_Window tkwin, /* The frame we are setting up */
+ char *menuName) /* The name of the menu to put in front.
+ * If NULL, use the default menu bar.
+ */
+{
+ /*
+ * Nothing to do.
+ */
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMenuIndicatorGeometry --
+ *
+ * Gets the width and height of the indicator area of a menu.
+ *
+ * Results:
+ * widthPtr and heightPtr are set.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+GetMenuIndicatorGeometry (
+ TkMenu *menuPtr, /* The menu we are measuring */
+ TkMenuEntry *mePtr, /* The entry we are measuring */
+ Tk_Font tkfont, /* Precalculated font */
+ CONST Tk_FontMetrics *fmPtr, /* Precalculated font metrics */
+ 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 --
+ *
+ * Gets the width and height of the indicator area of a menu.
+ *
+ * Results:
+ * widthPtr and heightPtr are set.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+GetMenuAccelGeometry (
+ TkMenu *menuPtr, /* The menu we are measuring */
+ TkMenuEntry *mePtr, /* The entry we are measuring */
+ Tk_Font tkfont, /* The precalculated font */
+ 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 --
+ *
+ * Gets the width and height of the indicator area of a menu.
+ *
+ * Results:
+ * widthPtr and heightPtr are set.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+GetTearoffEntryGeometry (
+ TkMenu *menuPtr, /* The menu we are measuring */
+ TkMenuEntry *mePtr, /* The entry we are measuring */
+ Tk_Font tkfont, /* The precalculated font */
+ CONST Tk_FontMetrics *fmPtr, /* The precalculated font metrics */
+ int *widthPtr, /* The resulting width */
+ int *heightPtr) /* The resulting height */
+{
+ if (menuPtr->menuType != MASTER_MENU) {
+ *heightPtr = 0;
+ } else {
+ *heightPtr = fmPtr->linespace;
+ }
+ *widthPtr = 0;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMenuSeparatorGeometry --
+ *
+ * Gets the width and height of the indicator area of a menu.
+ *
+ * Results:
+ * widthPtr and heightPtr are set.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+GetMenuSeparatorGeometry (
+ TkMenu *menuPtr, /* The menu we are measuring */
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawWindowsSystemBitmap --
+ *
+ * Draws the windows system bitmap given by bitmapID into the rect
+ * given by rectPtr in the drawable. The bitmap is centered in the
+ * rectangle. It is not clipped, so if the bitmap is bigger than
+ * the rect it will bleed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Drawing occurs. Some storage is allocated and released.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+ HDC scratchDC;
+ HBITMAP bitmap;
+ BITMAP bm;
+ POINT ptSize;
+ POINT ptOrg;
+ int topOffset, leftOffset;
+
+ SetBkColor(hdc, gc->background);
+ SetTextColor(hdc, gc->foreground);
+
+ scratchDC = CreateCompatibleDC(hdc);
+ bitmap = LoadBitmap(NULL, MAKEINTRESOURCE(bitmapID));
+
+ SelectObject(scratchDC, bitmap);
+ SetMapMode(scratchDC, GetMapMode(hdc));
+ GetObject(bitmap, sizeof(BITMAP), &bm);
+ ptSize.x = bm.bmWidth;
+ ptSize.y = bm.bmHeight;
+ DPtoLP(hdc, &ptSize, 1);
+
+ ptOrg.y = ptOrg.x = 0;
+ DPtoLP(hdc, &ptOrg, 1);
+
+ if (alignFlags & ALIGN_BITMAP_TOP) {
+ topOffset = 0;
+ } else if (alignFlags & ALIGN_BITMAP_BOTTOM) {
+ topOffset = (rectPtr->bottom - rectPtr->top) - ptSize.y;
+ } else {
+ topOffset = (rectPtr->bottom - rectPtr->top) / 2 - (ptSize.y / 2);
+ }
+
+ if (alignFlags & ALIGN_BITMAP_LEFT) {
+ leftOffset = 0;
+ } else if (alignFlags & ALIGN_BITMAP_RIGHT) {
+ leftOffset = (rectPtr->right - rectPtr->left) - ptSize.x;
+ } else {
+ leftOffset = (rectPtr->right - rectPtr->left) / 2 - (ptSize.x / 2);
+ }
+
+ BitBlt(hdc, rectPtr->left + leftOffset, rectPtr->top + topOffset, ptSize.x,
+ ptSize.y, scratchDC, ptOrg.x, ptOrg.y, SRCCOPY);
+ DeleteDC(scratchDC);
+ DeleteObject(bitmap);
+
+ TkWinReleaseDrawableDC(drawable, hdc, &state);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuEntryIndicator --
+ *
+ * This procedure draws the indicator part of a menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+DrawMenuEntryIndicator(menuPtr, mePtr, d, gc, indicatorGC, 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 with */
+ GC indicatorGC; /* The gc for indicator objects */
+ 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);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuEntryAccelerator --
+ *
+ * This procedure draws the accelerator part of a menu. We
+ * need to decide what to draw here. Should we replace strings
+ * like "Control", "Command", etc?
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+DrawMenuEntryAccelerator(menuPtr, mePtr, d, gc, tkfont, fmPtr,
+ activeBorder, x, y, width, height, drawArrow)
+ 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 with */
+ Tk_Font tkfont; /* The precalculated font */
+ CONST Tk_FontMetrics *fmPtr; /* The precalculated font metrics */
+ Tk_3DBorder activeBorder; /* The border when an item is active */
+ int x; /* left edge */
+ int y; /* top edge */
+ int width; /* Width of menu entry */
+ int height; /* Height of menu entry */
+ 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);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuSeparator --
+ *
+ * The menu separator is drawn.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+void
+DrawMenuSeparator(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 with */
+ 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 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 --
+ *
+ * On appropriate platforms, draw the underline character for the
+ * menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+static void
+DrawMenuUnderline(
+ TkMenu *menuPtr, /* The menu to draw into */
+ TkMenuEntry *mePtr, /* The entry we are drawing */
+ Drawable d, /* What we are drawing into */
+ GC gc, /* The gc to draw 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 */
+{
+ 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 --
+ *
+ * This procedure is invoked when keys related to pulling
+ * down menus is pressed. The corresponding Windows events
+ * are generated and passed to DefWindowProc if appropriate.
+ *
+ * Results:
+ * Always returns TCL_OK.
+ *
+ * Side effects:
+ * The menu system may take over and process user events
+ * for menu input.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+MenuKeyBindProc(clientData, interp, eventPtr, tkwin, keySym)
+ ClientData clientData; /* not used in this proc */
+ Tcl_Interp *interp; /* The interpreter of the receiving window. */
+ 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)
+ | (1 << 29));
+ break;
+ case XK_Alt_R:
+ scanCode = MapVirtualKey(VK_RMENU, 0);
+ CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
+ WM_SYSKEYDOWN, VK_MENU, (scanCode << 16)
+ | (1 << 29) | (1 << 24));
+ break;
+ case XK_F10:
+ scanCode = MapVirtualKey(VK_F10, 0);
+ CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
+ WM_SYSKEYDOWN, VK_F10, (scanCode << 16));
+ break;
+ 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.nchars > 0) {
+ for (i = 0; i < eventPtr->xkey.nchars; 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)),
+ WM_SYSKEYUP, VK_MENU, (scanCode << 16)
+ | (1 << 29) | (1 << 30) | (1 << 31));
+ break;
+ case XK_Alt_R:
+ scanCode = MapVirtualKey(VK_RMENU, 0);
+ CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
+ WM_SYSKEYUP, VK_MENU, (scanCode << 16) | (1 << 24)
+ | (0x111 << 29) | (1 << 30) | (1 << 31));
+ break;
+ case XK_F10:
+ scanCode = MapVirtualKey(VK_F10, 0);
+ CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
+ WM_SYSKEYUP, VK_F10, (scanCode << 16)
+ | (1 << 30) | (1 << 31));
+ break;
+ default:
+ virtualKey = XKeysymToKeycode(winPtr->display, keySym);
+ scanCode = MapVirtualKey(virtualKey, 0);
+ if (0 != scanCode) {
+ CallWindowProc(DefWindowProc, Tk_GetHWND(Tk_WindowId(tkwin)),
+ WM_SYSKEYUP, virtualKey, ((scanCode << 16)
+ | (1 << 29) | (1 << 30) | (1 << 31)));
+ }
+ }
+ }
+ return TCL_OK;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpInitializeMenuBindings --
+ *
+ * For every interp, initializes the bindings for Windows
+ * menus. Does nothing on Mac or XWindows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * C-level bindings are setup for the interp which will
+ * handle Alt-key sequences for menus without beeping
+ * or interfering with user-defined Alt-key bindings.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpInitializeMenuBindings(interp, bindingTable)
+ Tcl_Interp *interp; /* The interpreter to set. */
+ Tk_BindingTable bindingTable; /* The table to add to. */
+{
+ Tk_Uid uid = Tk_GetUid("all");
+
+ /*
+ * We need to set up the bindings for menubars. These have to
+ * recreate windows events, so we need to have a C-level
+ * binding for this. We have to generate the WM_SYSKEYDOWNS
+ * and WM_SYSKEYUPs appropriately.
+ */
+
+ TkCreateBindingProcedure(interp, bindingTable, (ClientData)uid,
+ "<Alt_L>", MenuKeyBindProc, NULL, NULL);
+ TkCreateBindingProcedure(interp, bindingTable, (ClientData)uid,
+ "<KeyRelease-Alt_L>", MenuKeyBindProc, NULL, NULL);
+ TkCreateBindingProcedure(interp, bindingTable, (ClientData)uid,
+ "<Alt_R>", MenuKeyBindProc, NULL, NULL);
+ TkCreateBindingProcedure(interp, bindingTable, (ClientData)uid,
+ "<KeyRelease-Alt_R>", MenuKeyBindProc, NULL, NULL);
+ TkCreateBindingProcedure(interp, bindingTable, (ClientData)uid,
+ "<Alt-KeyPress>", MenuKeyBindProc, NULL, NULL);
+ TkCreateBindingProcedure(interp, bindingTable, (ClientData)uid,
+ "<Alt-KeyRelease>", MenuKeyBindProc, NULL, NULL);
+ TkCreateBindingProcedure(interp, bindingTable, (ClientData)uid,
+ "<KeyPress-F10>", MenuKeyBindProc, NULL, NULL);
+ TkCreateBindingProcedure(interp, bindingTable, (ClientData)uid,
+ "<KeyRelease-F10>", MenuKeyBindProc, NULL, NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawMenuEntryLabel --
+ *
+ * This procedure draws the label part of a menu.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Commands are output to X to display the menu in its
+ * current mode.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawMenuEntryLabel(
+ 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, /* 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),
+ (unsigned) imageWidth, (unsigned) imageHeight);
+ }
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpComputeMenubarGeometry --
+ *
+ * This procedure is invoked to recompute the size and
+ * layout of a menu that is a menubar clone.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Fields of menu entries are changed to reflect their
+ * current positions, and the size of the menu window
+ * itself may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpComputeMenubarGeometry(menuPtr)
+ TkMenu *menuPtr; /* Structure describing menu. */
+{
+ TkpComputeStandardMenuGeometry(menuPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * DrawTearoffEntry --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+DrawTearoffEntry(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; /* The drawable we are drawing into */
+ GC gc; /* The gc we are drawing with */
+ Tk_Font tkfont; /* The font we are drawing with */
+ CONST Tk_FontMetrics *fmPtr; /* The metrics we are drawing with */
+ 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpConfigureMenuEntry(mePtr)
+ register TkMenuEntry *mePtr; /* Information about menu entry; may
+ * or may not already have values for
+ * some fields. */
+{
+ TkMenu *menuPtr = mePtr->menuPtr;
+
+ if (!(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) {
+ menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
+ Tcl_DoWhenIdle(ReconfigureWindowsMenu, (ClientData) menuPtr);
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDrawMenuEntry --
+ *
+ * Draws the given menu entry at the given coordinates with the
+ * given attributes.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * X Server commands are executed to display the menu entry.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDrawMenuEntry(mePtr, d, tkfont, menuMetricsPtr, x, y, width, height,
+ strictMotif, drawArrow)
+ TkMenuEntry *mePtr; /* The entry to draw */
+ Drawable d; /* What to draw into */
+ Tk_Font tkfont; /* Precalculated font for menu */
+ CONST Tk_FontMetrics *menuMetricsPtr;
+ /* Precalculated metrics for menu */
+ int x; /* X-coordinate of topleft of entry */
+ int y; /* Y-coordinate of topleft of entry */
+ int width; /* Width of the entry rectangle */
+ int height; /* Height of the current rectangle */
+ int strictMotif; /* Boolean flag */
+ int drawArrow; /* Whether or not to draw the cascade
+ * arrow for cascade items. Only applies
+ * to Windows. */
+{
+ GC gc, indicatorGC;
+ 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
+ * into account the padding.
+ */
+
+ DrawMenuEntryBackground(menuPtr, mePtr, d, activeBorder,
+ bgBorder, x, y, width, height);
+
+ if (mePtr->type == SEPARATOR_ENTRY) {
+ DrawMenuSeparator(menuPtr, mePtr, d, gc, tkfont,
+ fmPtr, x, adjustedY, width, adjustedHeight);
+ } else if (mePtr->type == TEAROFF_ENTRY) {
+ DrawTearoffEntry(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, adjustedY,
+ width, adjustedHeight);
+ } else {
+ DrawMenuEntryLabel(menuPtr, mePtr, d, gc, tkfont, fmPtr, x, 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);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMenuLabelGeometry --
+ *
+ * Figures out the size of the label portion of a menu item.
+ *
+ * Results:
+ * widthPtr and heightPtr are filled in with the correct geometry
+ * information.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMenuLabelGeometry(mePtr, tkfont, fmPtr, widthPtr, heightPtr)
+ TkMenuEntry *mePtr; /* The entry we are computing */
+ Tk_Font tkfont; /* The precalculated font */
+ CONST Tk_FontMetrics *fmPtr; /* The precalculated metrics */
+ int *widthPtr; /* The resulting width of the label
+ * portion */
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+DrawMenuEntryBackground(
+ TkMenu *menuPtr, /* The menu we are drawing. */
+ TkMenuEntry *mePtr, /* The entry we are drawing. */
+ Drawable d, /* What we are drawing into */
+ 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);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpComputeStandardMenuGeometry --
+ *
+ * This procedure is invoked to recompute the size and
+ * layout of a menu that is not a menubar clone.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Fields of menu entries are changed to reflect their
+ * current positions, and the size of the menu window
+ * itself may be changed.
+ *
+ *--------------------------------------------------------------
+ */
+
+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) {
+ GetTearoffEntryGeometry(menuPtr, menuPtr->entries[i], tkfont,
+ fmPtr, &width, &height);
+ menuPtr->entries[i]->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(menuPtr->entries[i], tkfont, fmPtr, &width,
+ &height);
+ menuPtr->entries[i]->height = height;
+ if (width > labelWidth) {
+ labelWidth = width;
+ }
+
+ GetMenuAccelGeometry(menuPtr, menuPtr->entries[i], tkfont,
+ fmPtr, &width, &height);
+ if (height > menuPtr->entries[i]->height) {
+ menuPtr->entries[i]->height = height;
+ }
+ if (width > accelWidth) {
+ accelWidth = width;
+ }
+
+ GetMenuIndicatorGeometry(menuPtr, menuPtr->entries[i], tkfont,
+ fmPtr, &width, &height);
+ 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) {
+ windowWidth = 1;
+ }
+ if (windowHeight <= 0) {
+ windowHeight = 1;
+ }
+ menuPtr->totalWidth = windowWidth;
+ menuPtr->totalHeight = windowHeight;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuSelectEvent --
+ *
+ * Generates a "MenuSelect" virtual event. This can be used to
+ * do context-sensitive menu help.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Places a virtual event on the event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+MenuSelectEvent(
+ TkMenu *menuPtr) /* the menu we have selected. */
+{
+ XVirtualEvent event;
+ POINTS rootPoint;
+ DWORD msgPos;
+
+ event.type = VirtualEvent;
+ event.serial = menuPtr->display->request;
+ event.send_event = 0;
+ event.display = menuPtr->display;
+ Tk_MakeWindowExist(menuPtr->tkwin);
+ event.event = Tk_WindowId(menuPtr->tkwin);
+ event.root = XRootWindow(menuPtr->display, 0);
+ event.subwindow = None;
+ event.time = TkpGetMS();
+
+ msgPos = GetMessagePos();
+ rootPoint = MAKEPOINTS(msgPos);
+ event.x_root = rootPoint.x;
+ event.y_root = rootPoint.y;
+ event.state = TkWinGetModifierState();
+ event.same_screen = 1;
+ event.name = Tk_GetUid("MenuSelect");
+ Tk_QueueWindowEvent((XEvent *) &event, TCL_QUEUE_TAIL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMenuNotifyToplevelCreate --
+ *
+ * This routine reconfigures the menu and the clones indicated by
+ * menuName becuase a toplevel has been created and any system
+ * menus need to be created.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * An idle handler is set up to do the reconfiguration.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMenuNotifyToplevelCreate(
+ Tcl_Interp *interp, /* The interp the menu lives in. */
+ char *menuName) /* The name of the menu to
+ * reconfigure. */
+{
+ TkMenuReferences *menuRefPtr;
+ TkMenu *menuPtr;
+
+ if ((menuName != NULL) && (menuName[0] != '\0')) {
+ menuRefPtr = TkFindMenuReferences(interp, menuName);
+ if ((menuRefPtr != NULL) && (menuRefPtr->menuPtr != NULL)) {
+ for (menuPtr = menuRefPtr->menuPtr->masterMenuPtr; menuPtr != NULL;
+ menuPtr = menuPtr->nextInstancePtr) {
+ if ((menuPtr->menuType == MENUBAR)
+ && !(menuPtr->menuFlags & MENU_RECONFIGURE_PENDING)) {
+ menuPtr->menuFlags |= MENU_RECONFIGURE_PENDING;
+ Tcl_DoWhenIdle(ReconfigureWindowsMenu,
+ (ClientData) menuPtr);
+ }
+ }
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MenuExitHandler --
+ *
+ * Throws away the utility window needed for menus and unregisters
+ * the class.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Menus have to be reinitialized next time.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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.
+ *
+ * The code below was given to me by Microsoft over the phone. It
+ * is the only way to insure menu items lining up, and is not
+ * documented.
+ */
+
+ if (versionInfo.dwPlatformId == VER_PLATFORM_WIN32_WINDOWS) {
+ indicatorDimensions[0] = GetSystemMetrics(SM_CYMENUCHECK);
+ indicatorDimensions[1] = ((GetSystemMetrics(SM_CXFIXEDFRAME) +
+ GetSystemMetrics(SM_CXBORDER)
+ + GetSystemMetrics(SM_CXMENUCHECK) + 7) & 0xFFF8)
+ - GetSystemMetrics(SM_CXFIXEDFRAME);
+ } else {
+ DWORD dimensions = GetMenuCheckMarkDimensions();
+ indicatorDimensions[0] = HIWORD(dimensions);
+ indicatorDimensions[1] = LOWORD(dimensions);
+ }
+
+}
diff --git a/tk/win/tkWinPixmap.c b/tk/win/tkWinPixmap.c
new file mode 100644
index 00000000000..7dae990623a
--- /dev/null
+++ b/tk/win/tkWinPixmap.c
@@ -0,0 +1,184 @@
+/*
+ * 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$
+ */
+
+#include "tkWinInt.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetPixmap --
+ *
+ * Creates an in memory drawing surface.
+ *
+ * Results:
+ * Returns a handle to a new pixmap.
+ *
+ * Side effects:
+ * Allocates a new Win32 bitmap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+Tk_GetPixmap(display, d, width, height, depth)
+ Display* display;
+ Drawable d;
+ int width;
+ int height;
+ int depth;
+{
+ TkWinDrawable *newTwdPtr, *twdPtr;
+ int planes;
+ Screen *screen;
+
+ display->request++;
+
+ newTwdPtr = (TkWinDrawable*) ckalloc(sizeof(TkWinDrawable));
+ newTwdPtr->type = TWD_BITMAP;
+ newTwdPtr->bitmap.depth = depth;
+ twdPtr = (TkWinDrawable *)d;
+ if (twdPtr->type != TWD_BITMAP) {
+ if (twdPtr->window.winPtr == NULL) {
+ newTwdPtr->bitmap.colormap = DefaultColormap(display,
+ DefaultScreen(display));
+ } else {
+ newTwdPtr->bitmap.colormap = twdPtr->window.winPtr->atts.colormap;
+ }
+ } else {
+ newTwdPtr->bitmap.colormap = twdPtr->bitmap.colormap;
+ }
+ screen = &display->screens[0];
+ planes = 1;
+ if (depth == screen->root_depth) {
+ planes = (int) screen->ext_data;
+ depth /= planes;
+ }
+ newTwdPtr->bitmap.handle = CreateBitmap(width, height, planes, depth, NULL);
+
+ if (newTwdPtr->bitmap.handle == NULL) {
+ ckfree((char *) newTwdPtr);
+ return None;
+ }
+
+ return (Pixmap)newTwdPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreePixmap --
+ *
+ * Release the resources associated with a pixmap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Deletes the bitmap created by Tk_GetPixmap.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreePixmap(display, pixmap)
+ Display* display;
+ Pixmap pixmap;
+{
+ TkWinDrawable *twdPtr = (TkWinDrawable *) pixmap;
+
+ display->request++;
+ if (twdPtr != NULL) {
+ DeleteObject(twdPtr->bitmap.handle);
+ ckfree((char *)twdPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSetPixmapColormap --
+ *
+ * The following function is a hack used by the photo widget to
+ * explicitly set the colormap slot of a Pixmap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSetPixmapColormap(pixmap, colormap)
+ Pixmap pixmap;
+ Colormap colormap;
+{
+ TkWinDrawable *twdPtr = (TkWinDrawable *)pixmap;
+ twdPtr->bitmap.colormap = colormap;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XGetGeometry --
+ *
+ * Retrieve the geometry of the given drawable. Note that
+ * this is a degenerate implementation that only returns the
+ * size of a pixmap.
+ *
+ * Results:
+ * Returns 0.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+XGetGeometry(display, d, root_return, x_return, y_return, width_return,
+ height_return, border_width_return, depth_return)
+ 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;
+{
+ TkWinDrawable *twdPtr = (TkWinDrawable *)d;
+ HDC dc;
+ BITMAPINFO info;
+
+ if ((twdPtr->type != TWD_BITMAP) || (twdPtr->bitmap.handle == NULL)) {
+ panic("XGetGeometry: invalid pixmap");
+ }
+ dc = GetDC(NULL);
+ info.bmiHeader.biSize = sizeof(BITMAPINFOHEADER);
+ info.bmiHeader.biBitCount = 0;
+ if (!GetDIBits(dc, twdPtr->bitmap.handle, 0, 0, NULL, &info,
+ DIB_RGB_COLORS)) {
+ panic("XGetGeometry: unable to get bitmap size");
+ }
+ ReleaseDC(NULL, dc);
+
+ *width_return = info.bmiHeader.biWidth;
+ *height_return = info.bmiHeader.biHeight;
+ return 1;
+}
diff --git a/tk/win/tkWinPointer.c b/tk/win/tkWinPointer.c
new file mode 100644
index 00000000000..dd747abfc60
--- /dev/null
+++ b/tk/win/tkWinPointer.c
@@ -0,0 +1,477 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#include "tkWinInt.h"
+
+/*
+ * Check for enter/leave events every MOUSE_TIMER_INTERVAL milliseconds.
+ */
+
+#define MOUSE_TIMER_INTERVAL 250
+
+/*
+ * Declarations of static variables used in this file.
+ */
+
+static int captured = 0; /* 1 if mouse is currently captured. */
+static TkWindow *keyboardWinPtr = NULL; /* Current keyboard grab window. */
+static Tcl_TimerToken mouseTimer; /* Handle to the latest mouse timer. */
+static int mouseTimerSet = 0; /* 1 if the mouse timer is active. */
+
+/*
+ * Forward declarations of procedures used in this file.
+ */
+
+static void MouseTimerProc _ANSI_ARGS_((ClientData clientData));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinGetModifierState --
+ *
+ * Return the modifier state as of the last message.
+ *
+ * Results:
+ * Returns the X modifier mask.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkWinGetModifierState()
+{
+ int state = 0;
+
+ if (GetKeyState(VK_SHIFT) & 0x8000) {
+ state |= ShiftMask;
+ }
+ if (GetKeyState(VK_CONTROL) & 0x8000) {
+ state |= ControlMask;
+ }
+ if (GetKeyState(VK_MENU) & 0x8000) {
+ state |= Mod2Mask;
+ }
+ if (GetKeyState(VK_CAPITAL) & 0x0001) {
+ state |= LockMask;
+ }
+ if (GetKeyState(VK_NUMLOCK) & 0x0001) {
+ state |= Mod1Mask;
+ }
+ if (GetKeyState(VK_SCROLL) & 0x0001) {
+ state |= Mod3Mask;
+ }
+ if (GetKeyState(VK_LBUTTON) & 0x8000) {
+ state |= Button1Mask;
+ }
+ if (GetKeyState(VK_MBUTTON) & 0x8000) {
+ state |= Button2Mask;
+ }
+ if (GetKeyState(VK_RBUTTON) & 0x8000) {
+ state |= Button3Mask;
+ }
+ return state;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_PointerEvent --
+ *
+ * This procedure is called for each pointer-related event.
+ * It converts the position to root coords and updates the
+ * global pointer state machine. It also ensures that the
+ * mouse timer is scheduled.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May queue events and change the grab state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_PointerEvent(hwnd, x, y)
+ HWND hwnd; /* Window for coords, or NULL for
+ * the root window. */
+ int x, y; /* Coords relative to hwnd, or screen
+ * if hwnd is NULL. */
+{
+ POINT pos;
+ int state;
+ Tk_Window tkwin;
+
+ pos.x = x;
+ pos.y = y;
+
+ /*
+ * Convert client coords to root coords if we were given a window.
+ */
+
+ if (hwnd) {
+ ClientToScreen(hwnd, &pos);
+ }
+
+ /*
+ * If the mouse is captured, Windows will report all pointer
+ * events to the capture window. So, we need to determine which
+ * window the mouse is really over and change the event. Note
+ * that the computed hwnd may point to a window not owned by Tk,
+ * or a toplevel decorative frame, so tkwin can be NULL.
+ */
+
+ if (captured || hwnd == NULL) {
+ hwnd = WindowFromPoint(pos);
+ }
+ tkwin = Tk_HWNDToWindow(hwnd);
+
+ state = TkWinGetModifierState();
+
+ Tk_UpdatePointer(tkwin, pos.x, pos.y, state);
+
+ if ((captured || tkwin) && !mouseTimerSet) {
+ mouseTimerSet = 1;
+ mouseTimer = Tcl_CreateTimerHandler(MOUSE_TIMER_INTERVAL,
+ MouseTimerProc, NULL);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XGrabKeyboard --
+ *
+ * Simulates a keyboard grab by setting the focus.
+ *
+ * Results:
+ * Always returns GrabSuccess.
+ *
+ * Side effects:
+ * Sets the keyboard focus to the specified window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+XGrabKeyboard(display, grab_window, owner_events, pointer_mode,
+ keyboard_mode, time)
+ Display* display;
+ Window grab_window;
+ Bool owner_events;
+ int pointer_mode;
+ int keyboard_mode;
+ Time time;
+{
+ keyboardWinPtr = TkWinGetWinPtr(grab_window);
+ return GrabSuccess;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XUngrabKeyboard --
+ *
+ * Releases the simulated keyboard grab.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets the keyboard focus back to the value before the grab.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XUngrabKeyboard(display, time)
+ Display* display;
+ Time time;
+{
+ keyboardWinPtr = NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * MouseTimerProc --
+ *
+ * Check the current mouse position and look for enter/leave
+ * events.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May schedule a new timer and/or generate enter/leave events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+MouseTimerProc(clientData)
+ ClientData clientData;
+{
+ POINT pos;
+
+ mouseTimerSet = 0;
+
+ /*
+ * Get the current mouse position and window. Don't do anything
+ * if the mouse hasn't moved since the last time we looked.
+ */
+
+ GetCursorPos(&pos);
+ Tk_PointerEvent(NULL, pos.x, pos.y);
+}
+
+/* CYGNUS LOCAL: Cancel any current 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.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkGetPointerCoords(tkwin, xPtr, yPtr)
+ Tk_Window tkwin; /* Window that identifies screen on which
+ * lookup is to be done. */
+ int *xPtr, *yPtr; /* Store pointer coordinates here. */
+{
+ POINT point;
+
+ GetCursorPos(&point);
+ *xPtr = point.x;
+ *yPtr = point.y;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XQueryPointer --
+ *
+ * Check the current state of the mouse. This is not a complete
+ * implementation of this function. It only computes the root
+ * coordinates and the current mask.
+ *
+ * Results:
+ * Sets root_x_return, root_y_return, and mask_return. Returns
+ * true on success.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Bool
+XQueryPointer(display, w, root_return, child_return, root_x_return,
+ root_y_return, win_x_return, win_y_return, mask_return)
+ 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;
+{
+ display->request++;
+ TkGetPointerCoords(NULL, root_x_return, root_y_return);
+ *mask_return = TkWinGetModifierState();
+ return True;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XGetInputFocus --
+ *
+ * Retrieves the current keyboard focus window.
+ *
+ * Results:
+ * Returns the current focus window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XGetInputFocus(display, focus_return, revert_to_return)
+ Display *display;
+ Window *focus_return;
+ int *revert_to_return;
+{
+ Tk_Window tkwin = Tk_HWNDToWindow(GetFocus());
+ *focus_return = tkwin ? Tk_WindowId(tkwin) : None;
+ *revert_to_return = RevertToParent;
+ display->request++;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XSetInputFocus --
+ *
+ * Set the current focus window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the keyboard focus and causes the selected window to
+ * be activated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XSetInputFocus(display, focus, revert_to, time)
+ Display* display;
+ Window focus;
+ int revert_to;
+ Time time;
+{
+ display->request++;
+ if (focus != None) {
+ SetFocus(Tk_GetHWND(focus));
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpChangeFocus --
+ *
+ * This procedure is invoked to move the system focus from
+ * one window to another.
+ *
+ * Results:
+ * The return value is the serial number of the command that
+ * changed the focus. It may be needed by the caller to filter
+ * out focus change events that were queued before the command.
+ * If the procedure doesn't actually change the focus then
+ * it returns 0.
+ *
+ * Side effects:
+ * The official Windows focus window changes; the application's focus
+ * window isn't changed by this procedure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpChangeFocus(winPtr, force)
+ TkWindow *winPtr; /* Window that is to receive the X focus. */
+ int force; /* Non-zero means claim the focus even
+ * if it didn't originally belong to
+ * topLevelPtr's application. */
+{
+ TkDisplay *dispPtr = winPtr->dispPtr;
+ Window focusWindow;
+ int dummy, serial;
+ TkWindow *winPtr2;
+
+ if (!force) {
+ XGetInputFocus(dispPtr->display, &focusWindow, &dummy);
+ winPtr2 = (TkWindow *) Tk_IdToWindow(dispPtr->display, focusWindow);
+ if ((winPtr2 == NULL) || (winPtr2->mainPtr != winPtr->mainPtr)) {
+ 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) {
+ SetForegroundWindow(Tk_GetHWND(winPtr->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
+ * events on either side of the mark.
+ */
+
+ serial = NextRequest(winPtr->display);
+ XNoOp(winPtr->display);
+ return serial;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpSetCapture --
+ *
+ * This function captures the mouse so that all future events
+ * will be reported to this window, even if the mouse is outside
+ * the window. If the specified window is NULL, then the mouse
+ * is released.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets the capture flag and captures the mouse.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpSetCapture(winPtr)
+ TkWindow *winPtr; /* Capture window, or NULL. */
+{
+ if (winPtr) {
+ SetCapture(Tk_GetHWND(Tk_WindowId(winPtr)));
+ captured = 1;
+ } else {
+ captured = 0;
+ ReleaseCapture();
+ }
+}
diff --git a/tk/win/tkWinPort.h b/tk/win/tkWinPort.h
new file mode 100644
index 00000000000..532c9d1200b
--- /dev/null
+++ b/tk/win/tkWinPort.h
@@ -0,0 +1,135 @@
+/*
+ * 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.
+ * 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$
+ */
+
+#ifndef _WINPORT
+#define _WINPORT
+
+#include <X11/Xlib.h>
+#include <X11/cursorfont.h>
+#include <X11/keysym.h>
+#include <X11/Xatom.h>
+#include <X11/Xutil.h>
+
+#include <malloc.h>
+#include <errno.h>
+#include <ctype.h>
+#include <math.h>
+#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 */
+
+#ifdef __CYGWIN32__
+#define strnicmp strncasecmp
+#define stricmp strcasecmp
+#else
+#define strncasecmp strnicmp
+#define strcasecmp stricmp
+#endif
+
+#define NBBY 8
+
+#define OPEN_MAX 32
+
+/*
+ * The following define causes Tk to use its internal keysym hash table
+ */
+
+#define REDO_KEYSYM_LOOKUP
+
+/*
+ * The following macro checks to see whether there is buffered
+ * input data available for a stdio FILE.
+ */
+
+#if defined (_MSC_VER) || defined (__MINGW32__)
+# define TK_READ_DATA_PENDING(f) ((f)->_cnt > 0)
+#else /* _MSC_VER || __MINGW32__ */
+# define TK_READ_DATA_PENDING(f) ((f)->level > 0)
+#endif /* _MSC_VER || __MINGW32__ */
+
+/*
+ * The following stubs implement various calls that don't do anything
+ * under Windows.
+ */
+
+#define TkFreeWindowId(dispPtr,w)
+#define TkInitXId(dispPtr)
+#define TkpCmapStressed(tkwin,colormap) (0)
+#define XFlush(display)
+#define XGrabServer(display)
+#define XUngrabServer(display)
+#define TkpSync(display)
+
+/*
+ * The following functions are implemented as macros under Windows.
+ */
+
+#define XFree(data) {if ((data) != NULL) ckfree((char *) (data));}
+#define XNoOp(display) {display->request++;}
+#define XSynchronize(display, bool) {display->request++;}
+#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.
+ */
+
+#define TkpDefineNativeBitmaps()
+#define TkpCreateNativeBitmap(display, source) None
+#define TkpGetNativeAppBitmap(display, name, w, h) None
+
+/*
+ * timezone et al are already defined in Windows32api headers used by
+ * GNU mingw32 port.
+ */
+
+#ifndef __MINGW32__
+
+/*
+ * Define timezone for gettimeofday.
+ */
+
+struct timezone {
+ int tz_minuteswest;
+ int tz_dsttime;
+};
+
+
+struct timeval;
+
+extern int gettimeofday(struct timeval *, struct timezone *);
+
+#endif /* ! __MINGW32__ */
+
+EXTERN void panic _ANSI_ARGS_(TCL_VARARGS(char *,format));
+
+#endif /* _WINPORT */
diff --git a/tk/win/tkWinRegion.c b/tk/win/tkWinRegion.c
new file mode 100644
index 00000000000..1866971864b
--- /dev/null
+++ b/tk/win/tkWinRegion.c
@@ -0,0 +1,179 @@
+/*
+ * 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$
+ */
+
+#include "tkWinInt.h"
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkCreateRegion --
+ *
+ * Construct an empty region.
+ *
+ * Results:
+ * Returns a new region handle.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkRegion
+TkCreateRegion()
+{
+ RECT rect;
+ memset(&rect, 0, sizeof(RECT));
+ return (TkRegion) CreateRectRgnIndirect(&rect);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkDestroyRegion --
+ *
+ * Destroy the specified region.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees the storage associated with the specified region.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkDestroyRegion(r)
+ TkRegion r;
+{
+ DeleteObject((HRGN) r);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkClipBox --
+ *
+ * Computes the bounding box of a region.
+ *
+ * Results:
+ * Sets rect_return to the bounding box of the region.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkClipBox(r, rect_return)
+ TkRegion r;
+ XRectangle* rect_return;
+{
+ RECT rect;
+ GetRgnBox((HRGN)r, &rect);
+ rect_return->x = (short) rect.left;
+ rect_return->y = (short) rect.top;
+ rect_return->width = (short) (rect.right - rect.left);
+ rect_return->height = (short) (rect.bottom - rect.top);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkIntersectRegion --
+ *
+ * Compute the intersection of two regions.
+ *
+ * Results:
+ * Returns the result in the dr_return region.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkIntersectRegion(sra, srb, dr_return)
+ TkRegion sra;
+ TkRegion srb;
+ TkRegion dr_return;
+{
+ CombineRgn((HRGN) dr_return, (HRGN) sra, (HRGN) srb, RGN_AND);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkUnionRectWithRegion --
+ *
+ * Create the union of a source region and a rectangle.
+ *
+ * Results:
+ * Returns the result in the dr_return region.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkUnionRectWithRegion(rectangle, src_region, dest_region_return)
+ XRectangle* rectangle;
+ TkRegion src_region;
+ TkRegion dest_region_return;
+{
+ HRGN rectRgn = CreateRectRgn(rectangle->x, rectangle->y,
+ rectangle->x + rectangle->width, rectangle->y + rectangle->height);
+ CombineRgn((HRGN) dest_region_return, (HRGN) src_region,
+ (HRGN) rectRgn, RGN_OR);
+ DeleteObject(rectRgn);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkRectInRegion --
+ *
+ * Test whether a given rectangle overlaps with a region.
+ *
+ * Results:
+ * Returns RectanglePart or RectangleOut. Note that this is
+ * not a complete implementation since it doesn't test for
+ * RectangleIn.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkRectInRegion(r, x, y, width, height)
+ TkRegion r;
+ int x;
+ int y;
+ unsigned int width;
+ unsigned int height;
+{
+ RECT rect;
+ rect.top = y;
+ rect.left = x;
+ rect.bottom = y+height;
+ rect.right = x+width;
+ return RectInRegion((HRGN)r, &rect) ? RectanglePart : RectangleOut;
+}
diff --git a/tk/win/tkWinScrlbr.c b/tk/win/tkWinScrlbr.c
new file mode 100644
index 00000000000..12f4ea212eb
--- /dev/null
+++ b/tk/win/tkWinScrlbr.c
@@ -0,0 +1,745 @@
+/*
+ * 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$
+ */
+
+#include "tkWinInt.h"
+#include "tkScrollbar.h"
+
+
+/*
+ * The following constant is used to specify the maximum scroll position.
+ * This value is limited by the Win32 API to either 16-bits or 32-bits,
+ * depending on the context. For now we'll just use a value small
+ * enough to fit in 16-bits, but which gives us 4-digits of precision.
+ */
+
+#define MAX_SCROLL 10000
+
+/*
+ * Declaration of Windows specific scrollbar structure.
+ */
+
+typedef struct WinScrollbar {
+ TkScrollbar info; /* Generic scrollbar info. */
+ WNDPROC oldProc; /* Old window procedure. */
+ int lastVertical; /* 1 if was vertical at last refresh. */
+ HWND hwnd; /* Current window handle. */
+ int winFlags; /* Various flags; see below. */
+} WinScrollbar;
+
+/*
+ * Flag bits for native scrollbars:
+ *
+ * IN_MODAL_LOOP: Non-zero means this scrollbar is in the middle
+ * of a modal loop.
+ * ALREADY_DEAD: Non-zero means this scrollbar has been
+ * destroyed, but has not been cleaned up.
+ */
+
+#define IN_MODAL_LOOP 1
+#define ALREADY_DEAD 2
+
+/*
+ * 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));
+static void ModalLoopProc _ANSI_ARGS_((Tk_Window tkwin,
+ XEvent *eventPtr));
+static int ScrollbarBindProc _ANSI_ARGS_((ClientData clientData,
+ Tcl_Interp *interp, XEvent *eventPtr,
+ Tk_Window tkwin, KeySym keySym));
+static LRESULT CALLBACK ScrollbarProc _ANSI_ARGS_((HWND hwnd, UINT message,
+ WPARAM wParam, LPARAM lParam));
+static void UpdateScrollbar _ANSI_ARGS_((
+ WinScrollbar *scrollPtr));
+static void UpdateScrollbarMetrics _ANSI_ARGS_((void));
+
+/*
+ * The class procedure table for the scrollbar widget.
+ */
+
+TkClassProcs tkpScrollbarProcs = {
+ CreateProc, /* createProc */
+ NULL, /* geometryProc */
+ ModalLoopProc, /* modalProc */
+};
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpCreateScrollbar --
+ *
+ * Allocate a new TkScrollbar structure.
+ *
+ * Results:
+ * Returns a newly allocated TkScrollbar structure.
+ *
+ * Side effects:
+ * Registers an event handler for the widget.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkScrollbar *
+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,
+ ExposureMask|StructureNotifyMask|FocusChangeMask,
+ TkScrollbarEventProc, (ClientData) scrollPtr);
+
+ if (!Tcl_GetAssocData(winPtr->mainPtr->interp, "TkScrollbar", NULL)) {
+ Tcl_SetAssocData(winPtr->mainPtr->interp, "TkScrollbar", NULL,
+ (ClientData)1);
+ TkCreateBindingProcedure(winPtr->mainPtr->interp,
+ winPtr->mainPtr->bindingTable,
+ (ClientData)Tk_GetUid("Scrollbar"), "<ButtonPress>",
+ ScrollbarBindProc, NULL, NULL);
+ }
+
+ return (TkScrollbar*) scrollPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateScrollbar --
+ *
+ * This function updates the position and size of the scrollbar
+ * thumb based on the current settings.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Moves the thumb.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateScrollbar(scrollPtr)
+ WinScrollbar *scrollPtr;
+{
+ SCROLLINFO scrollInfo;
+ double thumbSize;
+
+ /*
+ * Update the current scrollbar position and shape.
+ */
+
+ scrollInfo.fMask = SIF_PAGE | SIF_POS | SIF_RANGE;
+ scrollInfo.cbSize = sizeof(scrollInfo);
+ scrollInfo.nMin = 0;
+ scrollInfo.nMax = MAX_SCROLL;
+ thumbSize = (scrollPtr->info.lastFraction - scrollPtr->info.firstFraction);
+ if (tkpIsWin32s) {
+ scrollInfo.nPage = 0;
+ } else {
+ scrollInfo.nPage = ((UINT) (thumbSize * (double) MAX_SCROLL)) + 1;
+ }
+ if (thumbSize < 1.0) {
+ scrollInfo.nPos = (int)
+ ((scrollPtr->info.firstFraction / (1.0-thumbSize))
+ * (MAX_SCROLL - (scrollInfo.nPage - 1)));
+ } else {
+ scrollInfo.nPos = 0;
+ }
+ SetScrollInfo(scrollPtr->hwnd, SB_CTL, &scrollInfo, TRUE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * CreateProc --
+ *
+ * This function creates a new Scrollbar control, subclasses
+ * the instance, and generates a new Window object.
+ *
+ * Results:
+ * Returns the newly allocated Window object, or None on failure.
+ *
+ * Side effects:
+ * Causes a new Scrollbar control to come into existence.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Window
+CreateProc(tkwin, parentWin, instanceData)
+ Tk_Window tkwin; /* Token for window. */
+ Window parentWin; /* Parent of new window. */
+ ClientData instanceData; /* Scrollbar instance data. */
+{
+ DWORD style;
+ Window window;
+ HWND parent;
+ TkWindow *winPtr;
+ WinScrollbar *scrollPtr = (WinScrollbar *)instanceData;
+
+ parent = Tk_GetHWND(parentWin);
+
+ if (scrollPtr->info.vertical) {
+ style = WS_CHILD | WS_VISIBLE | WS_CLIPCHILDREN | WS_CLIPSIBLINGS
+ | SBS_VERT | SBS_RIGHTALIGN;
+ } else {
+ style = WS_CHILD | WS_VISIBLE | WS_CLIPCHILDREN | WS_CLIPSIBLINGS
+ | SBS_HORZ | SBS_BOTTOMALIGN;
+ }
+
+ scrollPtr->hwnd = CreateWindow("SCROLLBAR", NULL, style,
+ Tk_X(tkwin), Tk_Y(tkwin), Tk_Width(tkwin), Tk_Height(tkwin),
+ parent, NULL, Tk_GetHINSTANCE(), NULL);
+
+ /*
+ * Ensure new window is inserted into the stacking order at the correct
+ * place.
+ */
+
+ SetWindowPos(scrollPtr->hwnd, HWND_TOP, 0, 0, 0, 0,
+ SWP_NOACTIVATE | SWP_NOMOVE | SWP_NOSIZE);
+
+ for (winPtr = ((TkWindow*)tkwin)->nextPtr; winPtr != NULL;
+ winPtr = winPtr->nextPtr) {
+ if ((winPtr->window != None) && !(winPtr->flags & TK_TOP_LEVEL)) {
+ TkWinSetWindowPos(scrollPtr->hwnd, Tk_GetHWND(winPtr->window),
+ Below);
+ break;
+ }
+ }
+
+ scrollPtr->lastVertical = scrollPtr->info.vertical;
+ scrollPtr->oldProc = (WNDPROC)SetWindowLong(scrollPtr->hwnd, GWL_WNDPROC,
+ (DWORD) ScrollbarProc);
+ window = Tk_AttachHWND(tkwin, scrollPtr->hwnd);
+
+ UpdateScrollbar(scrollPtr);
+ return window;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpDisplayScrollbar --
+ *
+ * This procedure redraws the contents of a scrollbar window.
+ * It is invoked as a do-when-idle handler, so it only runs
+ * when there's nothing else for the application to do.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Information appears on the screen.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkpDisplayScrollbar(clientData)
+ ClientData clientData; /* Information about window. */
+{
+ WinScrollbar *scrollPtr = (WinScrollbar *) clientData;
+ Tk_Window tkwin = scrollPtr->info.tkwin;
+
+ scrollPtr->info.flags &= ~REDRAW_PENDING;
+ if ((tkwin == NULL) || !Tk_IsMapped(tkwin)) {
+ return;
+ }
+
+ /*
+ * Destroy and recreate the scrollbar control if the orientation
+ * has changed.
+ */
+
+ if (scrollPtr->lastVertical != scrollPtr->info.vertical) {
+ HWND hwnd = Tk_GetHWND(Tk_WindowId(tkwin));
+
+ SetWindowLong(hwnd, GWL_WNDPROC, (DWORD) scrollPtr->oldProc);
+ DestroyWindow(hwnd);
+
+ CreateProc(tkwin, Tk_WindowId(Tk_Parent(tkwin)),
+ (ClientData) scrollPtr);
+ } else {
+ UpdateScrollbar(scrollPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpDestroyScrollbar --
+ *
+ * Free data structures associated with the scrollbar control.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Restores the default control state.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpDestroyScrollbar(scrollPtr)
+ TkScrollbar *scrollPtr;
+{
+ WinScrollbar *winScrollPtr = (WinScrollbar *)scrollPtr;
+ HWND hwnd = winScrollPtr->hwnd;
+ if (hwnd) {
+ SetWindowLong(hwnd, GWL_WNDPROC, (DWORD) winScrollPtr->oldProc);
+ if (winScrollPtr->winFlags & IN_MODAL_LOOP) {
+ ((TkWindow *)scrollPtr->tkwin)->flags |= TK_DONT_DESTROY_WINDOW;
+ SetParent(hwnd, NULL);
+ }
+ }
+ winScrollPtr->winFlags |= ALREADY_DEAD;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateScrollbarMetrics --
+ *
+ * This function retrieves the current system metrics for a
+ * scrollbar.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Updates the geometry cache info for all scrollbars.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+UpdateScrollbarMetrics()
+{
+ Tk_ConfigSpec *specPtr;
+
+ hArrowWidth = GetSystemMetrics(SM_CXHSCROLL);
+ hThumb = GetSystemMetrics(SM_CXHTHUMB);
+ vArrowWidth = GetSystemMetrics(SM_CXVSCROLL);
+ vArrowHeight = GetSystemMetrics(SM_CYVSCROLL);
+ vThumb = GetSystemMetrics(SM_CYVTHUMB);
+
+ sprintf(defWidth, "%d", vArrowWidth);
+ for (specPtr = tkpScrollbarConfigSpecs; specPtr->type != TK_CONFIG_END;
+ specPtr++) {
+ if (specPtr->offset == Tk_Offset(TkScrollbar, width)) {
+ specPtr->defValue = defWidth;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpComputeScrollbarGeometry --
+ *
+ * After changes in a scrollbar's size or configuration, this
+ * procedure recomputes various geometry information used in
+ * displaying the scrollbar.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The scrollbar will be displayed differently.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpComputeScrollbarGeometry(scrollPtr)
+ register TkScrollbar *scrollPtr; /* Scrollbar whose geometry may
+ * have changed. */
+{
+ int fieldLength, minThumbSize;
+
+ /*
+ * Windows doesn't use focus rings on scrollbars, but we still
+ * perform basic sanity checks to appease backwards compatibility.
+ */
+
+ if (scrollPtr->highlightWidth < 0) {
+ scrollPtr->highlightWidth = 0;
+ }
+
+ if (scrollPtr->vertical) {
+ scrollPtr->arrowLength = vArrowHeight;
+ fieldLength = Tk_Height(scrollPtr->tkwin);
+ minThumbSize = vThumb;
+ } else {
+ scrollPtr->arrowLength = hArrowWidth;
+ fieldLength = Tk_Width(scrollPtr->tkwin);
+ minThumbSize = hThumb;
+ }
+ fieldLength -= 2*scrollPtr->arrowLength;
+ if (fieldLength < 0) {
+ fieldLength = 0;
+ }
+ scrollPtr->sliderFirst = (int) ((double)fieldLength
+ * scrollPtr->firstFraction);
+ scrollPtr->sliderLast = (int) ((double)fieldLength
+ * scrollPtr->lastFraction);
+
+ /*
+ * Adjust the slider so that some piece of it is always
+ * displayed in the scrollbar and so that it has at least
+ * a minimal width (so it can be grabbed with the mouse).
+ */
+
+ if (scrollPtr->sliderFirst > fieldLength) {
+ scrollPtr->sliderFirst = fieldLength;
+ }
+ if (scrollPtr->sliderFirst < 0) {
+ scrollPtr->sliderFirst = 0;
+ }
+ if (scrollPtr->sliderLast < (scrollPtr->sliderFirst
+ + minThumbSize)) {
+ scrollPtr->sliderLast = scrollPtr->sliderFirst + minThumbSize;
+ }
+ if (scrollPtr->sliderLast > fieldLength) {
+ scrollPtr->sliderLast = fieldLength;
+ }
+ scrollPtr->sliderFirst += scrollPtr->arrowLength;
+ scrollPtr->sliderLast += scrollPtr->arrowLength;
+
+ /*
+ * Register the desired geometry for the window (leave enough space
+ * for the two arrows plus a minimum-size slider, plus border around
+ * the whole window, if any). Then arrange for the window to be
+ * redisplayed.
+ */
+
+ if (scrollPtr->vertical) {
+ Tk_GeometryRequest(scrollPtr->tkwin,
+ scrollPtr->width, 2*scrollPtr->arrowLength + minThumbSize);
+ } else {
+ Tk_GeometryRequest(scrollPtr->tkwin,
+ 2*scrollPtr->arrowLength + minThumbSize, scrollPtr->width);
+ }
+ Tk_SetInternalBorder(scrollPtr->tkwin, 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ScrollbarProc --
+ *
+ * This function is call by Windows whenever an event occurs on
+ * a scrollbar control created by Tk.
+ *
+ * Results:
+ * Standard Windows return value.
+ *
+ * Side effects:
+ * May generate events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static LRESULT CALLBACK
+ScrollbarProc(hwnd, message, wParam, lParam)
+ HWND hwnd;
+ UINT message;
+ WPARAM wParam;
+ LPARAM lParam;
+{
+ LRESULT result;
+ POINT point;
+ WinScrollbar *scrollPtr;
+ Tk_Window tkwin = Tk_HWNDToWindow(hwnd);
+
+ if (tkwin == NULL) {
+ panic("ScrollbarProc called on an invalid HWND");
+ }
+ scrollPtr = (WinScrollbar *)((TkWindow*)tkwin)->instanceData;
+
+ switch(message) {
+ case WM_HSCROLL:
+ case WM_VSCROLL: {
+ Tcl_Interp *interp;
+ Tcl_DString cmdString;
+ int command = LOWORD(wParam);
+ int code;
+
+ GetCursorPos(&point);
+ Tk_TranslateWinEvent(NULL, WM_MOUSEMOVE, 0,
+ MAKELPARAM(point.x, point.y), &result);
+
+ if (command == SB_ENDSCROLL) {
+ return 0;
+ }
+
+ /*
+ * Bail out immediately if there isn't a command to invoke.
+ */
+
+ if (scrollPtr->info.commandSize == 0) {
+ Tcl_ServiceAll();
+ return 0;
+ }
+
+ Tcl_DStringInit(&cmdString);
+ Tcl_DStringAppend(&cmdString, scrollPtr->info.command,
+ scrollPtr->info.commandSize);
+
+ if (command == SB_LINELEFT || command == SB_LINERIGHT) {
+ Tcl_DStringAppendElement(&cmdString, "scroll");
+ Tcl_DStringAppendElement(&cmdString,
+ (command == SB_LINELEFT ) ? "-1" : "1");
+ Tcl_DStringAppendElement(&cmdString, "units");
+ } else if (command == SB_PAGELEFT || command == SB_PAGERIGHT) {
+ Tcl_DStringAppendElement(&cmdString, "scroll");
+ Tcl_DStringAppendElement(&cmdString,
+ (command == SB_PAGELEFT ) ? "-1" : "1");
+ Tcl_DStringAppendElement(&cmdString, "pages");
+ } else {
+ char valueString[TCL_DOUBLE_SPACE];
+ double pos = 0.0;
+ switch (command) {
+ case SB_THUMBPOSITION:
+ pos = ((double)HIWORD(wParam)) / MAX_SCROLL;
+ break;
+
+ case SB_THUMBTRACK:
+ pos = ((double)HIWORD(wParam)) / MAX_SCROLL;
+ break;
+
+ case SB_TOP:
+ pos = 0.0;
+ break;
+
+ case SB_BOTTOM:
+ pos = 1.0;
+ break;
+ }
+ sprintf(valueString, "%g", pos);
+ Tcl_DStringAppendElement(&cmdString, "moveto");
+ Tcl_DStringAppendElement(&cmdString, valueString);
+ }
+
+ interp = scrollPtr->info.interp;
+ code = Tcl_GlobalEval(interp, cmdString.string);
+ if (code != TCL_OK && code != TCL_CONTINUE && code != TCL_BREAK) {
+ Tcl_AddErrorInfo(interp, "\n (scrollbar command)");
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_DStringFree(&cmdString);
+
+ Tcl_ServiceAll();
+ return 0;
+ }
+
+ default:
+ if (Tk_TranslateWinEvent(hwnd, message, wParam, lParam, &result)) {
+ return result;
+ }
+ }
+ return CallWindowProc(scrollPtr->oldProc, hwnd, message, wParam, lParam);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpConfigureScrollbar --
+ *
+ * This procedure is called after the generic code has finished
+ * processing configuration options, in order to configure
+ * platform specific options.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpConfigureScrollbar(scrollPtr)
+ register TkScrollbar *scrollPtr; /* Information about widget; may or
+ * may not already have values for
+ * some fields. */
+{
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ScrollbarBindProc --
+ *
+ * This procedure is invoked when the default <ButtonPress>
+ * binding on the Scrollbar bind tag fires.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The event enters a modal loop.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ScrollbarBindProc(clientData, interp, eventPtr, tkwin, keySym)
+ ClientData clientData;
+ Tcl_Interp *interp;
+ XEvent *eventPtr;
+ Tk_Window tkwin;
+ KeySym keySym;
+{
+ TkWindow *winPtr = (TkWindow*)tkwin;
+ if (eventPtr->type == ButtonPress) {
+ winPtr->flags |= TK_DEFER_MODAL;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ModalLoopProc --
+ *
+ * This function is invoked at the end of the event processing
+ * whenever the ScrollbarBindProc has been invoked for a ButtonPress
+ * event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Enters a modal loop.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ModalLoopProc(tkwin, eventPtr)
+ Tk_Window tkwin;
+ XEvent *eventPtr;
+{
+ TkWindow *winPtr = (TkWindow*)tkwin;
+ WinScrollbar *scrollPtr = (WinScrollbar *) winPtr->instanceData;
+ int oldMode;
+
+ Tcl_Preserve((ClientData)scrollPtr);
+ scrollPtr->winFlags |= IN_MODAL_LOOP;
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ TkWinResendEvent(scrollPtr->oldProc, scrollPtr->hwnd, eventPtr);
+ (void) Tcl_SetServiceMode(oldMode);
+ scrollPtr->winFlags &= ~IN_MODAL_LOOP;
+ if (scrollPtr->hwnd && scrollPtr->winFlags & ALREADY_DEAD) {
+ DestroyWindow(scrollPtr->hwnd);
+ }
+ Tcl_Release((ClientData)scrollPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkpScrollbarPosition --
+ *
+ * Determine the scrollbar element corresponding to a
+ * given position.
+ *
+ * Results:
+ * One of TOP_ARROW, TOP_GAP, etc., indicating which element
+ * of the scrollbar covers the position given by (x, y). If
+ * (x,y) is outside the scrollbar entirely, then OUTSIDE is
+ * returned.
+ *
+ * Side effects:
+ * None.
+ *
+ *--------------------------------------------------------------
+ */
+
+int
+TkpScrollbarPosition(scrollPtr, x, y)
+ register TkScrollbar *scrollPtr; /* Scrollbar widget record. */
+ int x, y; /* Coordinates within scrollPtr's
+ * window. */
+{
+ int length, width, tmp;
+
+ if (scrollPtr->vertical) {
+ length = Tk_Height(scrollPtr->tkwin);
+ width = Tk_Width(scrollPtr->tkwin);
+ } else {
+ tmp = x;
+ x = y;
+ y = tmp;
+ length = Tk_Width(scrollPtr->tkwin);
+ width = Tk_Height(scrollPtr->tkwin);
+ }
+
+ if ((x < scrollPtr->inset) || (x >= (width - scrollPtr->inset))
+ || (y < scrollPtr->inset) || (y >= (length - scrollPtr->inset))) {
+ return OUTSIDE;
+ }
+
+ /*
+ * All of the calculations in this procedure mirror those in
+ * TkpDisplayScrollbar. Be sure to keep the two consistent.
+ */
+
+ if (y < (scrollPtr->inset + scrollPtr->arrowLength)) {
+ return TOP_ARROW;
+ }
+ if (y < scrollPtr->sliderFirst) {
+ return TOP_GAP;
+ }
+ if (y < scrollPtr->sliderLast) {
+ return SLIDER;
+ }
+ if (y >= (length - (scrollPtr->arrowLength + scrollPtr->inset))) {
+ return BOTTOM_ARROW;
+ }
+ return BOTTOM_GAP;
+}
diff --git a/tk/win/tkWinSend.c b/tk/win/tkWinSend.c
new file mode 100644
index 00000000000..a9219a07f91
--- /dev/null
+++ b/tk/win/tkWinSend.c
@@ -0,0 +1,86 @@
+/*
+ * 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$
+ */
+
+#include "tkPort.h"
+#include "tkInt.h"
+
+
+/*
+ *--------------------------------------------------------------
+ *
+ * Tk_SetAppName --
+ *
+ * This procedure is called to associate an ASCII name with a Tk
+ * application. If the application has already been named, the
+ * name replaces the old one.
+ *
+ * Results:
+ * The return value is the name actually given to the application.
+ * This will normally be the same as name, but if name was already
+ * in use for an application then a name of the form "name #2" will
+ * be chosen, with a high enough number to make the name unique.
+ *
+ * Side effects:
+ * Registration info is saved, thereby allowing the "send" command
+ * to be used later to invoke commands in the application. In
+ * addition, the "send" command is created in the application's
+ * interpreter. The registration will be removed automatically
+ * if the interpreter is deleted or the "send" command is removed.
+ *
+ *--------------------------------------------------------------
+ */
+
+char *
+Tk_SetAppName(tkwin, name)
+ Tk_Window tkwin; /* Token for any window in the application
+ * 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkGetInterpNames(interp, tkwin)
+ Tcl_Interp *interp; /* Interpreter for returning a result. */
+ Tk_Window tkwin; /* Window whose display is to be used
+ * for the lookup. */
+{
+ return TCL_OK;
+}
diff --git a/tk/win/tkWinWindow.c b/tk/win/tkWinWindow.c
new file mode 100644
index 00000000000..f78dd0b9c74
--- /dev/null
+++ b/tk/win/tkWinWindow.c
@@ -0,0 +1,801 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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));
+static void StackWindow _ANSI_ARGS_((Window w, Window sibling,
+ int stack_mode));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_AttachHWND --
+ *
+ * This function binds an HWND and a reflection procedure to
+ * the specified Tk_Window.
+ *
+ * Results:
+ * Returns an X Window that encapsulates the HWND.
+ *
+ * Side effects:
+ * May allocate a new X Window. Also enters the HWND into the
+ * global window table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Window
+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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_HWNDToWindow --
+ *
+ * This function retrieves a Tk_Window from the window table
+ * given an HWND.
+ *
+ * Results:
+ * Returns the matching Tk_Window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_HWNDToWindow(hwnd)
+ HWND hwnd;
+{
+ Tcl_HashEntry *entryPtr;
+ if (!initialized) {
+ Tcl_InitHashTable(&windowTable, TCL_ONE_WORD_KEYS);
+ initialized = 1;
+ }
+ entryPtr = Tcl_FindHashEntry(&windowTable, (char*)hwnd);
+ if (entryPtr != NULL) {
+ return (Tk_Window) Tcl_GetHashValue(entryPtr);
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetHWND --
+ *
+ * This function extracts the HWND from an X Window.
+ *
+ * Results:
+ * Returns the HWND associated with the Window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+HWND
+Tk_GetHWND(window)
+ Window window;
+{
+ TkWinDrawable *twdPtr = (TkWinDrawable *) window;
+ return twdPtr->window.handle;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpPrintWindowId --
+ *
+ * This routine stores the string representation of the
+ * platform dependent window handle for an X Window in the
+ * given buffer.
+ *
+ * Results:
+ * Returns the result in the specified buffer.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpPrintWindowId(buf, window)
+ char *buf; /* Pointer to string large enough to hold
+ * the hex representation of a pointer. */
+ Window window; /* Window to be printed into buffer. */
+{
+ HWND hwnd = (window) ? Tk_GetHWND(window) : 0;
+ sprintf(buf, "0x%x", (unsigned int) hwnd);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpScanWindowId --
+ *
+ * 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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpScanWindowId(interp, string, idPtr)
+ Tcl_Interp *interp; /* Interpreter to use for error reporting. */
+ char *string; /* String containing a (possibly signed)
+ * integer in a form acceptable to strtol. */
+ int *idPtr; /* Place to store converted result. */
+{
+ int number;
+ Tk_Window tkwin;
+
+ if (Tcl_GetInt(interp, string, &number) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ tkwin = Tk_HWNDToWindow((HWND)number);
+ if (tkwin) {
+ *idPtr = Tk_WindowId(tkwin);
+ } else {
+ *idPtr = None;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMakeWindow --
+ *
+ * Creates a Windows window object based on the current attributes
+ * of the specified TkWindow.
+ *
+ * Results:
+ * Returns a pointer to a new TkWinDrawable cast to a Window.
+ *
+ * Side effects:
+ * Creates a new window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Window
+TkpMakeWindow(winPtr, parent)
+ TkWindow *winPtr;
+ Window parent;
+{
+ HWND parentWin;
+ int style;
+ HWND hwnd;
+
+ if (parent != None) {
+ parentWin = Tk_GetHWND(parent);
+ style = WS_CHILD | WS_CLIPCHILDREN | WS_CLIPSIBLINGS;
+ } else {
+ parentWin = NULL;
+ style = WS_POPUP | WS_CLIPCHILDREN;
+ }
+
+ /*
+ * 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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XDestroyWindow --
+ *
+ * Destroys the given window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sends the WM_DESTROY message to the window and then destroys
+ * it the Win32 resources associated with the window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XDestroyWindow(display, w)
+ 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);
+
+ /*
+ * Don't bother destroying the window if we are going to destroy
+ * the parent later.
+ */
+
+ if (hwnd != NULL && !(winPtr->flags & TK_DONT_DESTROY_WINDOW)) {
+ DestroyWindow(hwnd);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XMapWindow --
+ *
+ * Cause the given window to become visible.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Causes the window state to change, and generates a MapNotify
+ * event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XMapWindow(display, w)
+ Display* display;
+ Window w;
+{
+ XEvent event;
+ TkWindow *parentPtr;
+ TkWindow *winPtr = TkWinGetWinPtr(w);
+
+ display->request++;
+
+ ShowWindow(TkWinGetHWND(w), SW_SHOWNORMAL);
+ winPtr->flags |= TK_MAPPED;
+
+ /*
+ * Check to see if this window is visible now. If all of the parent
+ * windows up to the first toplevel are mapped, then this window and
+ * its mapped children have just become visible.
+ */
+
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ for (parentPtr = winPtr->parentPtr; ;
+ parentPtr = parentPtr->parentPtr) {
+ if ((parentPtr == NULL) || !(parentPtr->flags & TK_MAPPED)) {
+ return;
+ }
+ if (parentPtr->flags & TK_TOP_LEVEL) {
+ break;
+ }
+ }
+ } else {
+ event.type = MapNotify;
+ event.xmap.serial = display->request;
+ event.xmap.send_event = False;
+ event.xmap.display = display;
+ event.xmap.event = winPtr->window;
+ event.xmap.window = winPtr->window;
+ event.xmap.override_redirect = winPtr->atts.override_redirect;
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+ }
+
+ /*
+ * Generate VisibilityNotify events for this window and its mapped
+ * children.
+ */
+
+ event.type = VisibilityNotify;
+ event.xvisibility.serial = display->request;
+ event.xvisibility.send_event = False;
+ event.xvisibility.display = display;
+ event.xvisibility.window = winPtr->window;
+ event.xvisibility.state = VisibilityUnobscured;
+ NotifyVisibility(&event, winPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * NotifyVisibility --
+ *
+ * This function recursively notifies the mapped children of the
+ * specified window of a change in visibility. Note that we don't
+ * properly report the visibility state, since Windows does not
+ * provide that info. The eventPtr argument must point to an event
+ * that has been completely initialized except for the window slot.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates lots of events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+NotifyVisibility(eventPtr, winPtr)
+ XEvent *eventPtr; /* Initialized VisibilityNotify event. */
+ TkWindow *winPtr; /* Window to notify. */
+{
+ if (winPtr->atts.event_mask & VisibilityChangeMask) {
+ eventPtr->xvisibility.window = winPtr->window;
+ Tk_QueueWindowEvent(eventPtr, TCL_QUEUE_TAIL);
+ }
+ for (winPtr = winPtr->childList; winPtr != NULL;
+ winPtr = winPtr->nextPtr) {
+ if (winPtr->flags & TK_MAPPED) {
+ NotifyVisibility(eventPtr, winPtr);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XUnmapWindow --
+ *
+ * Cause the given window to become invisible.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Causes the window state to change, and generates an UnmapNotify
+ * event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XUnmapWindow(display, w)
+ Display* display;
+ Window w;
+{
+ XEvent event;
+ TkWindow *winPtr = TkWinGetWinPtr(w);
+
+ display->request++;
+
+ /*
+ * Bug fix: Don't short circuit this routine based on TK_MAPPED because
+ * it will be cleared before XUnmapWindow is called.
+ */
+
+ ShowWindow(TkWinGetHWND(w), SW_HIDE);
+ winPtr->flags &= ~TK_MAPPED;
+
+ if (winPtr->flags & TK_TOP_LEVEL) {
+ event.type = UnmapNotify;
+ event.xunmap.serial = display->request;
+ event.xunmap.send_event = False;
+ event.xunmap.display = display;
+ event.xunmap.event = winPtr->window;
+ event.xunmap.window = winPtr->window;
+ event.xunmap.from_configure = False;
+ Tk_HandleEvent(&event);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XMoveResizeWindow --
+ *
+ * Move and resize a window relative to its parent.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Repositions and resizes the specified window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XMoveResizeWindow(display, w, x, y, width, height)
+ Display* display;
+ Window w;
+ int x; /* Position relative to parent. */
+ int y;
+ unsigned int width;
+ unsigned int height;
+{
+ display->request++;
+ MoveWindow(TkWinGetHWND(w), x, y, width, height, TRUE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XMoveWindow --
+ *
+ * Move a window relative to its parent.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Repositions the specified window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XMoveWindow(display, w, x, y)
+ Display* display;
+ Window w;
+ int x;
+ int y;
+{
+ TkWindow *winPtr = TkWinGetWinPtr(w);
+
+ display->request++;
+
+ MoveWindow(TkWinGetHWND(w), x, y, winPtr->changes.width,
+ winPtr->changes.height, TRUE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XResizeWindow --
+ *
+ * Resize a window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Resizes the specified window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XResizeWindow(display, w, width, height)
+ Display* display;
+ Window w;
+ unsigned int width;
+ unsigned int height;
+{
+ TkWindow *winPtr = TkWinGetWinPtr(w);
+
+ display->request++;
+
+ MoveWindow(TkWinGetHWND(w), winPtr->changes.x, winPtr->changes.y, width,
+ height, TRUE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XRaiseWindow --
+ *
+ * Change the stacking order of a window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the stacking order of the specified window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XRaiseWindow(display, w)
+ Display* display;
+ Window w;
+{
+ HWND window = TkWinGetHWND(w);
+
+ display->request++;
+ SetWindowPos(window, HWND_TOPMOST, 0, 0, 0, 0,
+ SWP_NOMOVE | SWP_NOSIZE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XConfigureWindow --
+ *
+ * Change the size, position, stacking, or border of the specified
+ * window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the attributes of the specified window. Note that we
+ * ignore the passed in values and use the values stored in the
+ * TkWindow data structure.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XConfigureWindow(display, w, value_mask, values)
+ Display* display;
+ Window w;
+ unsigned int value_mask;
+ XWindowChanges* values;
+{
+ TkWindow *winPtr = TkWinGetWinPtr(w);
+ HWND hwnd = TkWinGetHWND(w);
+
+ display->request++;
+
+ /*
+ * Change the shape and/or position of the window.
+ */
+
+ if (value_mask & (CWX|CWY|CWWidth|CWHeight)) {
+ MoveWindow(hwnd, winPtr->changes.x, winPtr->changes.y,
+ winPtr->changes.width, winPtr->changes.height, TRUE);
+ }
+
+ /*
+ * Change the stacking order of the window.
+ */
+
+ if (value_mask & CWStackMode) {
+ HWND sibling;
+ if ((value_mask & CWSibling) && (values->sibling != None)) {
+ sibling = Tk_GetHWND(values->sibling);
+ } else {
+ sibling = NULL;
+ }
+ TkWinSetWindowPos(hwnd, sibling, values->stack_mode);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XClearWindow --
+ *
+ * Clears the entire window to the current background color.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Erases the current contents of the window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XClearWindow(display, w)
+ Display* display;
+ Window w;
+{
+ RECT rc;
+ HBRUSH brush;
+ HPALETTE oldPalette, palette;
+ TkWindow *winPtr;
+ HWND hwnd = TkWinGetHWND(w);
+ HDC dc = GetDC(hwnd);
+
+ palette = TkWinGetPalette(display->screens[0].cmap);
+ oldPalette = SelectPalette(dc, palette, FALSE);
+
+ display->request++;
+
+ winPtr = TkWinGetWinPtr(w);
+ brush = CreateSolidBrush(winPtr->atts.background_pixel);
+ GetWindowRect(hwnd, &rc);
+ rc.right = rc.right - rc.left;
+ rc.bottom = rc.bottom - rc.top;
+ rc.left = rc.top = 0;
+ FillRect(dc, &rc, brush);
+
+ DeleteObject(brush);
+ SelectPalette(dc, oldPalette, TRUE);
+ ReleaseDC(hwnd, dc);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XChangeWindowAttributes --
+ *
+ * This function is called when the attributes on a window are
+ * updated. Since Tk maintains all of the window state, the only
+ * relevant value is the cursor.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May cause the mouse position to be updated.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XChangeWindowAttributes(display, w, valueMask, attributes)
+ Display* display;
+ Window w;
+ unsigned long valueMask;
+ XSetWindowAttributes* attributes;
+{
+ if (valueMask & CWCursor) {
+ XDefineCursor(display, w, attributes->cursor);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinSetWindowPos --
+ *
+ * Adjust the stacking order of a window relative to a second
+ * window (or NULL).
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Moves the specified window in the stacking order.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWinSetWindowPos(hwnd, siblingHwnd, pos)
+ HWND hwnd; /* Window to restack. */
+ HWND siblingHwnd; /* Sibling window. */
+ int pos; /* One of Above or Below. */
+{
+ HWND temp;
+
+ /*
+ * Since Windows does not support Above mode, we place the
+ * specified window below the sibling and then swap them.
+ */
+
+ if (siblingHwnd) {
+ if (pos == Above) {
+ SetWindowPos(hwnd, siblingHwnd, 0, 0, 0, 0,
+ SWP_NOACTIVATE | SWP_NOMOVE | SWP_NOSIZE);
+ temp = hwnd;
+ hwnd = siblingHwnd;
+ siblingHwnd = temp;
+ }
+ } else {
+ siblingHwnd = (pos == Above) ? HWND_TOP : HWND_BOTTOM;
+ }
+
+ SetWindowPos(hwnd, siblingHwnd, 0, 0, 0, 0,
+ SWP_NOACTIVATE | SWP_NOMOVE | SWP_NOSIZE);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpWindowWasRecentlyDeleted --
+ *
+ * Determines whether we know if the window given as argument was
+ * recently deleted. Called by the generic code error handler to
+ * handle BadWindow events.
+ *
+ * Results:
+ * Always 0. We do not keep this information on Windows.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TkpWindowWasRecentlyDeleted(win, dispPtr)
+ Window win;
+ TkDisplay *dispPtr;
+{
+ return 0;
+}
diff --git a/tk/win/tkWinWm.c b/tk/win/tkWinWm.c
new file mode 100644
index 00000000000..c8b17d8dcd0
--- /dev/null
+++ b/tk/win/tkWinWm.c
@@ -0,0 +1,4260 @@
+/*
+ * 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 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$
+ */
+
+#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.
+ */
+
+typedef struct ProtocolHandler {
+ Atom protocol; /* Identifies the protocol. */
+ struct ProtocolHandler *nextPtr;
+ /* Next in list of protocol handlers for
+ * the same top-level window, or NULL for
+ * end of list. */
+ Tcl_Interp *interp; /* Interpreter in which to invoke command. */
+ char command[4]; /* Tcl command to invoke when a client
+ * message for this protocol arrives.
+ * The actual size of the structure varies
+ * to accommodate the needs of the actual
+ * command. THIS MUST BE THE LAST FIELD OF
+ * THE STRUCTURE. */
+} ProtocolHandler;
+
+#define HANDLER_SIZE(cmdLength) \
+ ((unsigned) (sizeof(ProtocolHandler) - 3 + cmdLength))
+
+/*
+ * A data structure of the following type holds window-manager-related
+ * information for each top-level window in an application.
+ */
+
+typedef struct TkWmInfo {
+ TkWindow *winPtr; /* Pointer to main Tk information for
+ * this window. */
+ HWND wrapper; /* This is the decorative frame window
+ * created by the window manager to wrap
+ * a toplevel window. This window is
+ * a direct child of the root window. */
+ Tk_Uid titleUid; /* Title to display in window caption. If
+ * NULL, use name of widget. */
+ Tk_Uid iconName; /* Name to display in icon. */
+ TkWindow *masterPtr; /* Master window for TRANSIENT_FOR property,
+ * or NULL. */
+ XWMHints hints; /* Various pieces of information for
+ * window manager. */
+ char *leaderName; /* Path name of leader of window group
+ * (corresponds to hints.window_group).
+ * Malloc-ed. Note: this field doesn't
+ * get updated if leader is destroyed. */
+ Tk_Window icon; /* Window to use as icon for this window,
+ * or NULL. */
+ Tk_Window iconFor; /* Window for which this window is icon, or
+ * NULL if this isn't an icon for anyone. */
+
+ /*
+ * Information used to construct an XSizeHints structure for
+ * the window manager:
+ */
+
+ int defMinWidth, defMinHeight, defMaxWidth, defMaxHeight;
+ /* Default resize limits given by system. */
+ int sizeHintsFlags; /* Flags word for XSizeHints structure.
+ * If the PBaseSize flag is set then the
+ * window is gridded; otherwise it isn't
+ * gridded. */
+ int minWidth, minHeight; /* Minimum dimensions of window, in
+ * grid units, not pixels. */
+ int maxWidth, maxHeight; /* Maximum dimensions of window, in
+ * grid units, not pixels, or 0 to default. */
+ Tk_Window gridWin; /* Identifies the window that controls
+ * gridding for this top-level, or NULL if
+ * the top-level isn't currently gridded. */
+ int widthInc, heightInc; /* Increments for size changes (# pixels
+ * per step). */
+ struct {
+ int x; /* numerator */
+ int y; /* denominator */
+ } minAspect, maxAspect; /* Min/max aspect ratios for window. */
+ int reqGridWidth, reqGridHeight;
+ /* The dimensions of the window (in
+ * grid units) requested through
+ * the geometry manager. */
+ int gravity; /* Desired window gravity. */
+
+ /*
+ * Information used to manage the size and location of a window.
+ */
+
+ int width, height; /* Desired dimensions of window, specified
+ * in grid units. These values are
+ * set by the "wm geometry" command and by
+ * ConfigureNotify events (for when wm
+ * resizes window). -1 means user hasn't
+ * requested dimensions. */
+ int x, y; /* Desired X and Y coordinates for window.
+ * These values are set by "wm geometry",
+ * plus by ConfigureNotify events (when wm
+ * moves window). These numbers are
+ * different than the numbers stored in
+ * winPtr->changes because (a) they could be
+ * measured from the right or bottom edge
+ * of the screen (see WM_NEGATIVE_X and
+ * WM_NEGATIVE_Y flags) and (b) if the window
+ * has been reparented then they refer to the
+ * parent rather than the window itself. */
+ int borderWidth, borderHeight;
+ /* Width and height of window dressing, in
+ * pixels for the current style/exStyle. This
+ * includes the border on both sides of the
+ * window. */
+ int configWidth, configHeight;
+ /* Dimensions passed to last request that we
+ * issued to change geometry of window. Used
+ * to eliminate redundant resize operations. */
+ HMENU hMenu; /* the hMenu associated with this menu */
+ DWORD style, exStyle; /* Style flags for the wrapper window. */
+
+ /*
+ * List of children of the toplevel which have private colormaps.
+ */
+
+ TkWindow **cmapList; /* Array of window with private colormaps. */
+ int cmapCount; /* Number of windows in array. */
+
+ /*
+ * Miscellaneous information.
+ */
+
+ ProtocolHandler *protPtr; /* First in list of protocol handlers for
+ * this window (NULL means none). */
+ int cmdArgc; /* Number of elements in cmdArgv below. */
+ char **cmdArgv; /* Array of strings to store in the
+ * WM_COMMAND property. NULL means nothing
+ * available. */
+ char *clientMachine; /* String to store in WM_CLIENT_MACHINE
+ * property, or NULL. */
+ int flags; /* Miscellaneous flags, defined below. */
+ struct TkWmInfo *nextPtr; /* Next in list of all top-level windows. */
+} WmInfo;
+
+/*
+ * Flag values for WmInfo structures:
+ *
+ * WM_NEVER_MAPPED - non-zero means window has never been
+ * mapped; need to update all info when
+ * window is first mapped.
+ * WM_UPDATE_PENDING - non-zero means a call to UpdateGeometryInfo
+ * has already been scheduled for this
+ * window; no need to schedule another one.
+ * WM_NEGATIVE_X - non-zero means x-coordinate is measured in
+ * pixels from right edge of screen, rather
+ * than from left edge.
+ * WM_NEGATIVE_Y - non-zero means y-coordinate is measured in
+ * pixels up from bottom of screen, rather than
+ * down from top.
+ * WM_UPDATE_SIZE_HINTS - non-zero means that new size hints need to be
+ * propagated to window manager.
+ * WM_SYNC_PENDING - set to non-zero while waiting for the window
+ * manager to respond to some state change.
+ * WM_MOVE_PENDING - non-zero means the application has requested
+ * a new position for the window, but it hasn't
+ * been reflected through the window manager
+ * yet.
+ * WM_COLORAMPS_EXPLICIT - non-zero means the colormap windows were
+ * set explicitly via "wm colormapwindows".
+ * WM_ADDED_TOPLEVEL_COLORMAP - non-zero means that when "wm colormapwindows"
+ * was called the top-level itself wasn't
+ * specified, so we added it implicitly at
+ * the end of the list.
+ */
+
+#define WM_NEVER_MAPPED (1<<0)
+#define WM_UPDATE_PENDING (1<<1)
+#define WM_NEGATIVE_X (1<<2)
+#define WM_NEGATIVE_Y (1<<3)
+#define WM_UPDATE_SIZE_HINTS (1<<4)
+#define WM_SYNC_PENDING (1<<5)
+#define WM_CREATE_PENDING (1<<6)
+#define WM_MOVE_PENDING (1<<7)
+#define WM_COLORMAPS_EXPLICIT (1<<8)
+#define WM_ADDED_TOPLEVEL_COLORMAP (1<<9)
+#define WM_WIDTH_NOT_RESIZABLE (1<<10)
+#define WM_HEIGHT_NOT_RESIZABLE (1<<11)
+
+/*
+ * Window styles for various types of toplevel windows.
+ */
+
+#define WM_OVERRIDE_STYLE (WS_POPUP|WS_CLIPCHILDREN|CS_DBLCLKS)
+#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)
+/* CYGNUS LOCAL: We don't want WS_EX_TOOLWINDOW for most of our
+ transient windows. If necessary, we can add some option to set
+ this.
+ #define EX_TRANSIENT_STYLE (WS_EX_TOOLWINDOW | WS_EX_DLGMODALFRAME)
+ We also don't use WS_EX_DLGMODALFRAME. Using this doesn't give any
+ obvious benefit. However, it does have a drawback: if the window
+ is marked as not resizable, then use of WS_EX_DLGMODALFRAME will
+ cause the resize items on the window's system menu to remain
+ active. No, I don't understand.
+ */
+#define EX_TRANSIENT_STYLE (0)
+
+/*
+ * 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 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));
+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));
+static void UpdateGeometryInfo _ANSI_ARGS_((
+ ClientData clientData));
+static void UpdateWrapper _ANSI_ARGS_((TkWindow *winPtr));
+static LRESULT CALLBACK WmProc _ANSI_ARGS_((HWND hwnd, UINT message,
+ WPARAM wParam, LPARAM lParam));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InitWm --
+ *
+ * This routine creates the Wm toplevel decorative frame class.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Registers a new window class.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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;
+ /* CYGNUS LOCAL: First try the application's resource file. If
+ that fails, then try the Tk DLL. */
+ toplevelClass.hIcon = LoadIcon (GetModuleHandle (NULL), "tk");
+ if (toplevelClass.hIcon == NULL)
+ toplevelClass.hIcon = LoadIcon(Tk_GetHINSTANCE(), "tk");
+ toplevelClass.hCursor = LoadCursor(NULL, IDC_ARROW);
+
+ if (!RegisterClass(&toplevelClass)) {
+ panic("Unable to register TkTopLevel class");
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetTopLevel --
+ *
+ * This function retrieves the TkWindow associated with the
+ * given HWND.
+ *
+ * Results:
+ * Returns the matching TkWindow.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * SetLimits --
+ *
+ * Updates the minimum and maximum window size constraints.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the values of the info pointer to reflect the current
+ * minimum and maximum size values.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+SetLimits(hwnd, info)
+ HWND hwnd;
+ MINMAXINFO *info;
+{
+ register WmInfo *wmPtr;
+ int maxWidth, maxHeight;
+ int minWidth, minHeight;
+ int base;
+ TkWindow *winPtr = GetTopLevel(hwnd);
+
+ if (winPtr == NULL) {
+ return;
+ }
+
+ wmPtr = winPtr->wmInfoPtr;
+
+ /*
+ * Copy latest constraint info.
+ */
+
+ wmPtr->defMinWidth = info->ptMinTrackSize.x;
+ wmPtr->defMinHeight = info->ptMinTrackSize.y;
+ wmPtr->defMaxWidth = info->ptMaxTrackSize.x;
+ wmPtr->defMaxHeight = info->ptMaxTrackSize.y;
+
+ GetMaxSize(wmPtr, &maxWidth, &maxHeight);
+ GetMinSize(wmPtr, &minWidth, &minHeight);
+
+ if (wmPtr->gridWin != NULL) {
+ base = winPtr->reqWidth - (wmPtr->reqGridWidth * wmPtr->widthInc);
+ if (base < 0) {
+ base = 0;
+ }
+ base += wmPtr->borderWidth;
+ info->ptMinTrackSize.x = base + (minWidth * wmPtr->widthInc);
+ info->ptMaxTrackSize.x = base + (maxWidth * wmPtr->widthInc);
+
+ base = winPtr->reqHeight - (wmPtr->reqGridHeight * wmPtr->heightInc);
+ if (base < 0) {
+ base = 0;
+ }
+ base += wmPtr->borderHeight;
+ info->ptMinTrackSize.y = base + (minHeight * wmPtr->heightInc);
+ info->ptMaxTrackSize.y = base + (maxHeight * wmPtr->heightInc);
+ } else {
+ info->ptMaxTrackSize.x = maxWidth + wmPtr->borderWidth;
+ info->ptMaxTrackSize.y = maxHeight + wmPtr->borderHeight;
+ info->ptMinTrackSize.x = minWidth + wmPtr->borderWidth;
+ info->ptMinTrackSize.y = minHeight + wmPtr->borderHeight;
+ }
+
+ /*
+ * If the window isn't supposed to be resizable, then set the
+ * minimum and maximum dimensions to be the same as the current size.
+ */
+
+ if (!(wmPtr->flags & WM_SYNC_PENDING)) {
+ if (wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) {
+ info->ptMinTrackSize.x = winPtr->changes.width
+ + wmPtr->borderWidth;
+ info->ptMaxTrackSize.x = info->ptMinTrackSize.x;
+ }
+ if (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE) {
+ info->ptMinTrackSize.y = winPtr->changes.height
+ + wmPtr->borderHeight;
+ info->ptMaxTrackSize.y = info->ptMinTrackSize.y;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinWmCleanup --
+ *
+ * Unregisters classes registered by the window manager. This is
+ * called from the DLL main entry point when the DLL is unloaded.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window classes are discarded.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWinWmCleanup(hInstance)
+ HINSTANCE hInstance;
+{
+ if (!initialized) {
+ return;
+ }
+ initialized = 0;
+
+ UnregisterClass(TK_WIN_TOPLEVEL_CLASS_NAME, hInstance);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmNewWindow --
+ *
+ * This procedure is invoked whenever a new top-level
+ * window is created. Its job is to initialize the WmInfo
+ * structure for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A WmInfo structure gets allocated and initialized.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkWmNewWindow(winPtr)
+ TkWindow *winPtr; /* Newly-created top-level window. */
+{
+ register WmInfo *wmPtr;
+
+ wmPtr = (WmInfo *) ckalloc(sizeof(WmInfo));
+ winPtr->wmInfoPtr = wmPtr;
+ wmPtr->winPtr = winPtr;
+ wmPtr->wrapper = NULL;
+ wmPtr->titleUid = NULL;
+ wmPtr->iconName = NULL;
+ wmPtr->masterPtr = NULL;
+ wmPtr->hints.flags = InputHint | StateHint;
+ wmPtr->hints.input = True;
+ wmPtr->hints.initial_state = NormalState;
+ wmPtr->hints.icon_pixmap = None;
+ wmPtr->hints.icon_window = None;
+ wmPtr->hints.icon_x = wmPtr->hints.icon_y = 0;
+ wmPtr->hints.icon_mask = None;
+ wmPtr->hints.window_group = None;
+ wmPtr->leaderName = NULL;
+ wmPtr->icon = NULL;
+ wmPtr->iconFor = NULL;
+ wmPtr->sizeHintsFlags = 0;
+
+ /*
+ * Default the maximum dimensions to the size of the display.
+ */
+
+ wmPtr->defMinWidth = wmPtr->defMinHeight = 0;
+ wmPtr->defMaxWidth = DisplayWidth(winPtr->display,
+ winPtr->screenNum);
+ wmPtr->defMaxHeight = DisplayHeight(winPtr->display,
+ winPtr->screenNum);
+ wmPtr->minWidth = wmPtr->minHeight = 1;
+ wmPtr->maxWidth = wmPtr->maxHeight = 0;
+ wmPtr->gridWin = NULL;
+ wmPtr->widthInc = wmPtr->heightInc = 1;
+ wmPtr->minAspect.x = wmPtr->minAspect.y = 1;
+ wmPtr->maxAspect.x = wmPtr->maxAspect.y = 1;
+ wmPtr->reqGridWidth = wmPtr->reqGridHeight = -1;
+ wmPtr->gravity = NorthWestGravity;
+ wmPtr->width = -1;
+ wmPtr->height = -1;
+ wmPtr->hMenu = NULL;
+ wmPtr->x = winPtr->changes.x;
+ wmPtr->y = winPtr->changes.y;
+ wmPtr->borderWidth = 0;
+ wmPtr->borderHeight = 0;
+
+ wmPtr->cmapList = NULL;
+ wmPtr->cmapCount = 0;
+
+ 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,
+ TopLevelEventProc, (ClientData) winPtr);
+
+ /*
+ * Arrange for geometry requests to be reflected from the window
+ * to the window manager.
+ */
+
+ Tk_ManageGeometry((Tk_Window) winPtr, &wmMgrType, (ClientData) 0);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateWrapper --
+ *
+ * This function creates the wrapper window that contains the
+ * window decorations and menus for a toplevel. This function
+ * may be called after a window is mapped to change the window
+ * style.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Destroys any old wrapper window and replaces it with a newly
+ * created wrapper.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateWrapper(winPtr)
+ 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) {
+ panic("TkWmMapWindow: Cannot find container window");
+ }
+ if (!IsWindow(wmPtr->wrapper)) {
+ panic("TkWmMapWindow: Container was destroyed");
+ }
+
+ } else {
+ /*
+ * Pick the decorative frame style. Override redirect windows get
+ * created as undecorated popups. Transient windows get a modal
+ * dialog frame. Neither override, nor transient windows appear in
+ * the Win95 taskbar. Note that a transient window does not resize
+ * by default, so we need to explicitly add the WS_THICKFRAME style
+ * if we want it to be resizeable.
+ */
+
+ if (winPtr->atts.override_redirect) {
+ wmPtr->style = WM_OVERRIDE_STYLE;
+ wmPtr->exStyle = EX_OVERRIDE_STYLE;
+ } else if (wmPtr->masterPtr) {
+ wmPtr->style = WM_TRANSIENT_STYLE;
+ wmPtr->exStyle = EX_TRANSIENT_STYLE;
+ parentHWND = Tk_GetHWND(Tk_WindowId(wmPtr->masterPtr));
+ if (! ((wmPtr->flags & WM_WIDTH_NOT_RESIZABLE) &&
+ (wmPtr->flags & WM_HEIGHT_NOT_RESIZABLE))) {
+ wmPtr->style |= WS_THICKFRAME;
+ }
+ } else {
+ wmPtr->style = WM_TOPLEVEL_STYLE;
+ wmPtr->exStyle = EX_TOPLEVEL_STYLE;
+ }
+
+ /* CYGNUS LOCAL: nonresizable windows have no maximize box,
+ and no "sizebox". */
+ 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);
+ wmPtr->flags &= ~(WM_CREATE_PENDING|WM_MOVE_PENDING);
+
+ width = wmPtr->borderWidth + winPtr->changes.width;
+ height = wmPtr->borderHeight + winPtr->changes.height;
+
+ /*
+ * Set the initial position from the user or program specified
+ * location. If nothing has been specified, then let the system
+ * pick a location.
+ */
+
+
+ if (!(wmPtr->sizeHintsFlags & (USPosition | PPosition))
+ && (wmPtr->flags & WM_NEVER_MAPPED)) {
+ x = CW_USEDEFAULT;
+ y = CW_USEDEFAULT;
+ } else {
+ x = winPtr->changes.x;
+ y = winPtr->changes.y;
+ }
+
+ /*
+ * 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);
+ }
+
+ /*
+ * Now we need to reparent the contained window and set its
+ * style appropriately. Be sure to update the style first so that
+ * Windows doesn't try to set the focus to the child window.
+ */
+
+ SetWindowLong(child, GWL_STYLE,
+ WS_CHILD | WS_CLIPCHILDREN | WS_CLIPSIBLINGS);
+ 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
+ * initial state.
+ */
+
+ state = wmPtr->hints.initial_state;
+ wmPtr->hints.initial_state = WithdrawnState;
+ TkpWmSetState(winPtr, state);
+
+ /*
+ * If we are embedded then force a mapping of the window now,
+ * because we do not necessarily own the wrapper and may not
+ * get another opportunity to map ourselves. We should not be
+ * in either iconified or zoomed states when we get here, so
+ * it is safe to just check for TK_EMBEDDED without checking
+ * what state we are supposed to be in (default to NormalState).
+ */
+
+ if (winPtr->flags & TK_EMBEDDED) {
+ XMapWindow(winPtr->display, winPtr->window);
+ }
+
+ /*
+ * Set up menus on the wrapper if required.
+ */
+
+ if (wmPtr->hMenu != NULL) {
+ wmPtr->flags = WM_SYNC_PENDING;
+ SetMenu(wmPtr->wrapper, wmPtr->hMenu);
+ wmPtr->flags &= ~WM_SYNC_PENDING;
+ }
+
+ /*
+ * If this is the first window created by the application, then
+ * we should activate the initial window.
+ */
+
+ if (firstWindow) {
+ firstWindow = 0;
+ SetActiveWindow(wmPtr->wrapper);
+ }
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmMapWindow --
+ *
+ * This procedure is invoked to map a top-level window. This
+ * module gets a chance to update all window-manager-related
+ * information in properties before the window manager sees
+ * the map event and checks the properties. It also gets to
+ * decide whether or not to even map the window after all.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Properties of winPtr may get updated to provide up-to-date
+ * information to the window manager. The window may also get
+ * mapped, but it may not be if this procedure decides that
+ * isn't appropriate (e.g. because the window is withdrawn).
+ *
+ *--------------------------------------------------------------
+ */
+
+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;
+ }
+
+ /*
+ * Map the window in either the iconified or normal state. Note that
+ * we only send a map event if the window is in the normal state.
+ */
+
+ TkpWmSetState(winPtr, wmPtr->hints.initial_state);
+ }
+
+ /*
+ * This is the first time this window has ever been mapped.
+ * Store all the window-manager-related information for the
+ * window.
+ */
+
+ if (wmPtr->titleUid == NULL) {
+ wmPtr->titleUid = winPtr->nameUid;
+ }
+ UpdateWrapper(winPtr);
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmUnmapWindow --
+ *
+ * This procedure is invoked to unmap a top-level window. The
+ * only thing it does special is unmap the decorative frame before
+ * unmapping the toplevel window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Unmaps the decorative frame and the window.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkWmUnmapWindow(winPtr)
+ TkWindow *winPtr; /* Top-level window that's about to
+ * be unmapped. */
+{
+ TkpWmSetState(winPtr, WithdrawnState);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpWmSetState --
+ *
+ * Sets the window manager state for the wrapper window of a
+ * given toplevel window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May maximize, minimize, restore, or withdraw a window.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpWmSetState(winPtr, state)
+ 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;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmDeadWindow --
+ *
+ * This procedure is invoked when a top-level window is
+ * about to be deleted. It cleans up the wm-related data
+ * structures for the window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The WmInfo structure for winPtr gets freed up.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkWmDeadWindow(winPtr)
+ TkWindow *winPtr; /* Top-level window that's being deleted. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ WmInfo *wmPtr2;
+
+ if (wmPtr == NULL) {
+ 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);
+ }
+ }
+ }
+
+ if (wmPtr->hints.flags & IconPixmapHint) {
+ Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_pixmap);
+ }
+ if (wmPtr->hints.flags & IconMaskHint) {
+ Tk_FreeBitmap(winPtr->display, wmPtr->hints.icon_mask);
+ }
+ if (wmPtr->leaderName != NULL) {
+ ckfree(wmPtr->leaderName);
+ }
+ if (wmPtr->icon != NULL) {
+ wmPtr2 = ((TkWindow *) wmPtr->icon)->wmInfoPtr;
+ wmPtr2->iconFor = NULL;
+ }
+ if (wmPtr->iconFor != NULL) {
+ wmPtr2 = ((TkWindow *) wmPtr->iconFor)->wmInfoPtr;
+ wmPtr2->icon = NULL;
+ wmPtr2->hints.flags &= ~IconWindowHint;
+ }
+ while (wmPtr->protPtr != NULL) {
+ ProtocolHandler *protPtr;
+
+ protPtr = wmPtr->protPtr;
+ wmPtr->protPtr = protPtr->nextPtr;
+ Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC);
+ }
+ if (wmPtr->cmdArgv != NULL) {
+ ckfree((char *) wmPtr->cmdArgv);
+ }
+ if (wmPtr->clientMachine != NULL) {
+ ckfree((char *) wmPtr->clientMachine);
+ }
+ if (wmPtr->flags & WM_UPDATE_PENDING) {
+ Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr);
+ }
+
+ /*
+ * Destroy the decorative frame window.
+ */
+
+ if (!(winPtr->flags & TK_EMBEDDED)) {
+ if (wmPtr->wrapper != NULL) {
+ DestroyWindow(wmPtr->wrapper);
+ } else {
+ DestroyWindow(Tk_GetHWND(winPtr->window));
+ }
+ }
+ ckfree((char *) wmPtr);
+ winPtr->wmInfoPtr = NULL;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * TkWmSetClass --
+ *
+ * This procedure is invoked whenever a top-level window's
+ * class is changed. If the window has been mapped then this
+ * procedure updates the window manager property for the
+ * class. If the window hasn't been mapped, the update is
+ * deferred until just before the first mapping.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * A window property may get updated.
+ *
+ *--------------------------------------------------------------
+ */
+
+void
+TkWmSetClass(winPtr)
+ TkWindow *winPtr; /* Newly-created top-level window. */
+{
+ return;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_WmCmd --
+ *
+ * This procedure is invoked to process the "wm" 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_WmCmd(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;
+ 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) {
+ return TCL_ERROR;
+ }
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ Tcl_AppendResult(interp, "window \"", winPtr->pathName,
+ "\" isn't a top-level window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ wmPtr = winPtr->wmInfoPtr;
+ if ((c == 'a') && (strncmp(argv[1], "aspect", length) == 0)) {
+ int numer1, denom1, numer2, denom2;
+
+ if ((argc != 3) && (argc != 7)) {
+ 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;
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ XDeleteProperty(winPtr->display, winPtr->window,
+ Tk_InternAtom((Tk_Window) winPtr,
+ "WM_CLIENT_MACHINE"));
+ }
+ }
+ return TCL_OK;
+ }
+ if (wmPtr->clientMachine != NULL) {
+ 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, winPtr->window,
+ &textProp);
+ XFree((char *) textProp.value);
+ }
+ }
+ } else if ((c == 'c') && (strncmp(argv[1], "colormapwindows", length) == 0)
+ && (length >= 3)) {
+ TkWindow **cmapList;
+ TkWindow *winPtr2;
+ int i, windowArgc, gotToplevel;
+ char **windowArgv;
+
+ if ((argc != 3) && (argc != 4)) {
+ Tcl_AppendResult(interp, "wrong # arguments: must be \"",
+ argv[0], " colormapwindows window ?windowList?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 3) {
+ Tk_MakeWindowExist((Tk_Window) winPtr);
+ for (i = 0; i < wmPtr->cmapCount; i++) {
+ if ((i == (wmPtr->cmapCount-1))
+ && (wmPtr->flags & WM_ADDED_TOPLEVEL_COLORMAP)) {
+ break;
+ }
+ Tcl_AppendElement(interp, wmPtr->cmapList[i]->pathName);
+ }
+ return TCL_OK;
+ }
+ if (Tcl_SplitList(interp, argv[3], &windowArgc, &windowArgv)
+ != TCL_OK) {
+ return TCL_ERROR;
+ }
+ cmapList = (TkWindow **) ckalloc((unsigned)
+ ((windowArgc+1)*sizeof(TkWindow*)));
+ for (i = 0; i < windowArgc; i++) {
+ winPtr2 = (TkWindow *) Tk_NameToWindow(interp, windowArgv[i],
+ tkwin);
+ if (winPtr2 == NULL) {
+ ckfree((char *) cmapList);
+ ckfree((char *) windowArgv);
+ return TCL_ERROR;
+ }
+ if (winPtr2 == winPtr) {
+ gotToplevel = 1;
+ }
+ if (winPtr2->window == None) {
+ Tk_MakeWindowExist((Tk_Window) winPtr2);
+ }
+ cmapList[i] = winPtr2;
+ }
+ if (!gotToplevel) {
+ wmPtr->flags |= WM_ADDED_TOPLEVEL_COLORMAP;
+ cmapList[windowArgc] = winPtr;
+ windowArgc++;
+ } else {
+ wmPtr->flags &= ~WM_ADDED_TOPLEVEL_COLORMAP;
+ }
+ wmPtr->flags |= WM_COLORMAPS_EXPLICIT;
+ if (wmPtr->cmapList != NULL) {
+ ckfree((char *)wmPtr->cmapList);
+ }
+ wmPtr->cmapList = cmapList;
+ 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;
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ XDeleteProperty(winPtr->display, winPtr->window,
+ Tk_InternAtom((Tk_Window) winPtr, "WM_COMMAND"));
+ }
+ }
+ return TCL_OK;
+ }
+ if (Tcl_SplitList(interp, argv[3], &cmdArgc, &cmdArgv) != TCL_OK) {
+ return TCL_ERROR;
+ }
+ if (wmPtr->cmdArgv != NULL) {
+ ckfree((char *) wmPtr->cmdArgv);
+ }
+ wmPtr->cmdArgc = cmdArgc;
+ wmPtr->cmdArgv = cmdArgv;
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ XSetCommand(winPtr->display, winPtr->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;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't deiconify ", argv[2],
+ ": it is an icon for ", winPtr->pathName, (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (winPtr->flags & TK_EMBEDDED) {
+ Tcl_AppendResult(interp, "can't deiconify ", winPtr->pathName,
+ ": it is an embedded window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ TkpWmSetState(winPtr, NormalState);
+ } else if ((c == 'f') && (strncmp(argv[1], "focusmodel", length) == 0)
+ && (length >= 2)) {
+ 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;
+ }
+ 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(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.
+ */
+
+ wmPtr->sizeHintsFlags &= ~(PBaseSize|PResizeInc);
+ if (wmPtr->width != -1) {
+ wmPtr->width = winPtr->reqWidth + (wmPtr->width
+ - wmPtr->reqGridWidth)*wmPtr->widthInc;
+ wmPtr->height = winPtr->reqHeight + (wmPtr->height
+ - wmPtr->reqGridHeight)*wmPtr->heightInc;
+ }
+ wmPtr->widthInc = 1;
+ wmPtr->heightInc = 1;
+ } else {
+ 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);
+ }
+ wmPtr->leaderName = NULL;
+ } else {
+ tkwin2 = Tk_NameToWindow(interp, argv[3], tkwin);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ Tk_MakeWindowExist(tkwin2);
+ wmPtr->hints.window_group = Tk_WindowId(tkwin2);
+ wmPtr->hints.flags |= WindowGroupHint;
+ wmPtr->leaderName = ckalloc((unsigned) (strlen(argv[3])+1));
+ strcpy(wmPtr->leaderName, argv[3]);
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "iconbitmap", length) == 0)
+ && (length >= 5)) {
+ Pixmap pixmap;
+
+ if ((argc != 3) && (argc != 4)) {
+ 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.flags &= ~IconPixmapHint;
+ } else {
+ pixmap = Tk_GetBitmap(interp, (Tk_Window) winPtr,
+ Tk_GetUid(argv[3]));
+ if (pixmap == None) {
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_pixmap = pixmap;
+ wmPtr->hints.flags |= IconPixmapHint;
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "iconify", length) == 0)
+ && (length >= 5)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # arguments: must be \"",
+ argv[0], " iconify window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (Tk_Attributes((Tk_Window) winPtr)->override_redirect) {
+ Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName,
+ "\": override-redirect flag is set", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->masterPtr != NULL) {
+ Tcl_AppendResult(interp, "can't iconify \"", winPtr->pathName,
+ "\": it is a transient", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't iconify ", argv[2],
+ ": it is an icon for ", winPtr->pathName, (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (winPtr->flags & TK_EMBEDDED) {
+ Tcl_AppendResult(interp, "can't iconify ", winPtr->pathName,
+ ": it is an embedded window", (char *) NULL);
+ return TCL_ERROR;
+ }
+ TkpWmSetState(winPtr, IconicState);
+ } 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);
+ }
+ wmPtr->hints.flags &= ~IconMaskHint;
+ } else {
+ pixmap = Tk_GetBitmap(interp, tkwin, Tk_GetUid(argv[3]));
+ if (pixmap == None) {
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_mask = pixmap;
+ wmPtr->hints.flags |= IconMaskHint;
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "iconname", length) == 0)
+ && (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)
+ || (Tcl_GetInt(interp, argv[4], &y) != TCL_OK)){
+ return TCL_ERROR;
+ }
+ wmPtr->hints.icon_x = x;
+ wmPtr->hints.icon_y = y;
+ wmPtr->hints.flags |= IconPositionHint;
+ }
+ } else if ((c == 'i') && (strncmp(argv[1], "iconwindow", length) == 0)
+ && (length >= 5)) {
+ Tk_Window tkwin2;
+ WmInfo *wmPtr2;
+ XSetWindowAttributes atts;
+
+ if ((argc != 3) && (argc != 4)) {
+ 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) {
+ /*
+ * Let the window use button events again, then remove
+ * it as icon window.
+ */
+
+ atts.event_mask = Tk_Attributes(wmPtr->icon)->event_mask
+ | ButtonPressMask;
+ Tk_ChangeWindowAttributes(wmPtr->icon, CWEventMask, &atts);
+ wmPtr2 = ((TkWindow *) wmPtr->icon)->wmInfoPtr;
+ wmPtr2->iconFor = NULL;
+ wmPtr2->hints.initial_state = WithdrawnState;
+ }
+ wmPtr->icon = NULL;
+ } else {
+ tkwin2 = Tk_NameToWindow(interp, argv[3], tkwin);
+ if (tkwin2 == NULL) {
+ return TCL_ERROR;
+ }
+ if (!Tk_IsTopLevel(tkwin2)) {
+ Tcl_AppendResult(interp, "can't use ", argv[3],
+ " as icon window: not at top level", (char *) NULL);
+ return TCL_ERROR;
+ }
+ wmPtr2 = ((TkWindow *) tkwin2)->wmInfoPtr;
+ if (wmPtr2->iconFor != NULL) {
+ Tcl_AppendResult(interp, argv[3], " is already an icon for ",
+ Tk_PathName(wmPtr2->iconFor), (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->icon != NULL) {
+ WmInfo *wmPtr3 = ((TkWindow *) wmPtr->icon)->wmInfoPtr;
+ wmPtr3->iconFor = NULL;
+
+ /*
+ * Let the window use button events again.
+ */
+
+ atts.event_mask = Tk_Attributes(wmPtr->icon)->event_mask
+ | ButtonPressMask;
+ Tk_ChangeWindowAttributes(wmPtr->icon, CWEventMask, &atts);
+ }
+
+ /*
+ * Disable button events in the icon window: some window
+ * managers (like olvwm) want to get the events themselves,
+ * but X only allows one application at a time to receive
+ * button events for a window.
+ */
+
+ atts.event_mask = Tk_Attributes(tkwin2)->event_mask
+ & ~ButtonPressMask;
+ Tk_ChangeWindowAttributes(tkwin2, CWEventMask, &atts);
+ Tk_MakeWindowExist(tkwin2);
+ 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;
+ wmPtr->minHeight = height;
+ goto updateGeom;
+ } else if ((c == 'o')
+ && (strncmp(argv[1], "overrideredirect", length) == 0)) {
+ int boolean;
+ XSetWindowAttributes atts;
+
+ if ((argc != 3) && (argc != 4)) {
+ 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);
+ if (!(wmPtr->flags & (WM_NEVER_MAPPED)
+ && !(winPtr->flags & TK_EMBEDDED))) {
+ UpdateWrapper(winPtr);
+ }
+ } 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];
+ length = strlen(argv[3]);
+ if ((c == 'u') && (strncmp(argv[3], "user", length) == 0)) {
+ wmPtr->sizeHintsFlags &= ~PPosition;
+ wmPtr->sizeHintsFlags |= USPosition;
+ } else if ((c == 'p')
+ && (strncmp(argv[3], "program", length) == 0)) {
+ wmPtr->sizeHintsFlags &= ~USPosition;
+ wmPtr->sizeHintsFlags |= PPosition;
+ } else {
+ Tcl_AppendResult(interp, "bad argument \"", argv[3],
+ "\": must be program or user", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ goto updateGeom;
+ } else if ((c == 'p') && (strncmp(argv[1], "protocol", length) == 0)
+ && (length >= 2)) {
+ register ProtocolHandler *protPtr, *prevPtr;
+ Atom protocol;
+ int cmdLength;
+
+ if ((argc < 3) || (argc > 5)) {
+ Tcl_AppendResult(interp, "wrong # arguments: must be \"",
+ argv[0], " protocol window ?name? ?command?\"",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 3) {
+ /*
+ * Return a list of all defined protocols for the window.
+ */
+ for (protPtr = wmPtr->protPtr; protPtr != NULL;
+ protPtr = protPtr->nextPtr) {
+ Tcl_AppendElement(interp,
+ Tk_GetAtomName((Tk_Window) winPtr, protPtr->protocol));
+ }
+ return TCL_OK;
+ }
+ protocol = Tk_InternAtom((Tk_Window) winPtr, argv[3]);
+ 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;
+ }
+
+ /*
+ * Delete any current protocol handler, then create a new
+ * one with the specified command, unless the command is
+ * empty.
+ */
+
+ for (protPtr = wmPtr->protPtr, prevPtr = NULL; protPtr != NULL;
+ prevPtr = protPtr, protPtr = protPtr->nextPtr) {
+ if (protPtr->protocol == protocol) {
+ if (prevPtr == NULL) {
+ wmPtr->protPtr = protPtr->nextPtr;
+ } else {
+ prevPtr->nextPtr = protPtr->nextPtr;
+ }
+ Tcl_EventuallyFree((ClientData) protPtr, TCL_DYNAMIC);
+ break;
+ }
+ }
+ cmdLength = strlen(argv[4]);
+ if (cmdLength > 0) {
+ protPtr = (ProtocolHandler *) ckalloc(HANDLER_SIZE(cmdLength));
+ protPtr->protocol = protocol;
+ protPtr->nextPtr = wmPtr->protPtr;
+ wmPtr->protPtr = protPtr;
+ protPtr->interp = interp;
+ strcpy(protPtr->command, argv[4]);
+ }
+ } else if ((c == 'r') && (strncmp(argv[1], "resizable", length) == 0)) {
+ int width, height;
+
+ 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) {
+ wmPtr->flags &= ~WM_WIDTH_NOT_RESIZABLE;
+ } else {
+ wmPtr->flags |= WM_WIDTH_NOT_RESIZABLE;
+ }
+ if (height) {
+ wmPtr->flags &= ~WM_HEIGHT_NOT_RESIZABLE;
+ } else {
+ wmPtr->flags |= WM_HEIGHT_NOT_RESIZABLE;
+ }
+ wmPtr->flags |= WM_UPDATE_SIZE_HINTS;
+ goto updateGeom;
+ } else if ((c == 's') && (strncmp(argv[1], "sizefrom", length) == 0)
+ && (length >= 2)) {
+ if ((argc != 3) && (argc != 4)) {
+ 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];
+ length = strlen(argv[3]);
+ if ((c == 'u') && (strncmp(argv[3], "user", length) == 0)) {
+ wmPtr->sizeHintsFlags &= ~PSize;
+ wmPtr->sizeHintsFlags |= USSize;
+ } else if ((c == 'p')
+ && (strncmp(argv[3], "program", length) == 0)) {
+ wmPtr->sizeHintsFlags &= ~USSize;
+ wmPtr->sizeHintsFlags |= PSize;
+ } else {
+ Tcl_AppendResult(interp, "bad argument \"", argv[3],
+ "\": must be program or user", (char *) NULL);
+ return TCL_ERROR;
+ }
+ }
+ goto updateGeom;
+ } else if ((c == 's') && (strncmp(argv[1], "state", length) == 0)
+ && (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)) {
+ Tcl_AppendResult(interp, "wrong # arguments: must be \"",
+ argv[0], " transient window ?master?\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (argc == 3) {
+ if (wmPtr->masterPtr != NULL) {
+ Tcl_SetResult(interp, Tk_PathName(wmPtr->masterPtr),
+ TCL_STATIC);
+ }
+ return TCL_OK;
+ }
+ if (argv[3][0] == '\0') {
+ wmPtr->masterPtr = NULL;
+ } else {
+ masterPtr = (TkWindow*) Tk_NameToWindow(interp, argv[3], tkwin);
+ if (masterPtr == NULL) {
+ return TCL_ERROR;
+ }
+ if (masterPtr == winPtr) {
+ wmPtr->masterPtr = NULL;
+ } else {
+ Tk_MakeWindowExist((Tk_Window)masterPtr);
+
+ /*
+ * Ensure that the master window is actually a Tk toplevel.
+ */
+
+ while (!(masterPtr->flags & TK_TOP_LEVEL)) {
+ masterPtr = masterPtr->parentPtr;
+ }
+ wmPtr->masterPtr = masterPtr;
+
+ /*
+ * Ensure that the transient window is either mapped or
+ * unmapped like its master.
+ */
+
+ TkpWmSetState(winPtr, NormalState);
+ }
+ }
+ if (!(wmPtr->flags & (WM_NEVER_MAPPED)
+ && !(winPtr->flags & TK_EMBEDDED))) {
+ UpdateWrapper(winPtr);
+ }
+ } else if ((c == 'w') && (strncmp(argv[1], "withdraw", length) == 0)) {
+ if (argc != 3) {
+ Tcl_AppendResult(interp, "wrong # arguments: must be \"",
+ argv[0], " withdraw window\"", (char *) NULL);
+ return TCL_ERROR;
+ }
+ if (wmPtr->iconFor != NULL) {
+ Tcl_AppendResult(interp, "can't withdraw ", argv[2],
+ ": it is an icon for ", Tk_PathName(wmPtr->iconFor),
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ TkpWmSetState(winPtr, WithdrawnState);
+ } else {
+ Tcl_AppendResult(interp, "unknown or ambiguous option \"", argv[1],
+ "\": must be aspect, client, command, deiconify, ",
+ "focusmodel, frame, geometry, grid, group, iconbitmap, ",
+ "iconify, iconmask, iconname, iconposition, ",
+ "iconwindow, maxsize, minsize, overrideredirect, ",
+ "positionfrom, protocol, resizable, sizefrom, state, title, ",
+ "transient, or withdraw",
+ (char *) NULL);
+ return TCL_ERROR;
+ }
+ return TCL_OK;
+
+ updateGeom:
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+ return TCL_OK;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_SetGrid --
+ *
+ * This procedure is invoked by a widget when it wishes to set a grid
+ * coordinate system that controls the size of a top-level window.
+ * It provides a C interface equivalent to the "wm grid" command and
+ * is usually asscoiated with the -setgrid option.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Grid-related information will be passed to the window manager, so
+ * that the top-level window associated with tkwin will resize on
+ * even grid units. If some other window already controls gridding
+ * for the top-level window then this procedure call has no effect.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_SetGrid(tkwin, reqWidth, reqHeight, widthInc, heightInc)
+ Tk_Window tkwin; /* Token for window. New window mgr info
+ * will be posted for the top-level window
+ * associated with this window. */
+ int reqWidth; /* Width (in grid units) corresponding to
+ * the requested geometry for tkwin. */
+ int reqHeight; /* Height (in grid units) corresponding to
+ * the requested geometry for tkwin. */
+ int widthInc, heightInc; /* Pixel increments corresponding to a
+ * change of one grid unit. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ register WmInfo *wmPtr;
+
+ /*
+ * Find the top-level window for tkwin, plus the window manager
+ * information.
+ */
+
+ while (!(winPtr->flags & TK_TOP_LEVEL)) {
+ winPtr = winPtr->parentPtr;
+ }
+ wmPtr = winPtr->wmInfoPtr;
+
+ if ((wmPtr->gridWin != NULL) && (wmPtr->gridWin != tkwin)) {
+ return;
+ }
+
+ 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
+ * grid units since the new requested size of the top-level window in
+ * pixels may not yet have been registered yet (it may filter up
+ * the hierarchy in DoWhenIdle handlers). However, if the window
+ * has never been mapped yet then just leave the window size alone:
+ * assume that it is intended to be in grid units but just happened
+ * to have been specified before this procedure was called.
+ */
+
+ if ((wmPtr->gridWin == NULL) && !(wmPtr->flags & WM_NEVER_MAPPED)) {
+ wmPtr->width = -1;
+ wmPtr->height = -1;
+ }
+
+ /*
+ * Set the new gridding information, and start the process of passing
+ * all of this information to the window manager.
+ */
+
+ wmPtr->gridWin = tkwin;
+ wmPtr->reqGridWidth = reqWidth;
+ wmPtr->reqGridHeight = reqHeight;
+ wmPtr->widthInc = widthInc;
+ wmPtr->heightInc = heightInc;
+ wmPtr->sizeHintsFlags |= PBaseSize|PResizeInc;
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_UnsetGrid --
+ *
+ * This procedure cancels the effect of a previous call
+ * to Tk_SetGrid.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * If tkwin currently controls gridding for its top-level window,
+ * gridding is cancelled for that top-level window; if some other
+ * window controls gridding then this procedure has no effect.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_UnsetGrid(tkwin)
+ Tk_Window tkwin; /* Token for window that is currently
+ * controlling gridding. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ register WmInfo *wmPtr;
+
+ /*
+ * Find the top-level window for tkwin, plus the window manager
+ * information.
+ */
+
+ while (!(winPtr->flags & TK_TOP_LEVEL)) {
+ winPtr = winPtr->parentPtr;
+ }
+ wmPtr = winPtr->wmInfoPtr;
+ if (tkwin != wmPtr->gridWin) {
+ return;
+ }
+
+ wmPtr->gridWin = NULL;
+ wmPtr->sizeHintsFlags &= ~(PBaseSize|PResizeInc);
+ if (wmPtr->width != -1) {
+ wmPtr->width = winPtr->reqWidth + (wmPtr->width
+ - wmPtr->reqGridWidth)*wmPtr->widthInc;
+ wmPtr->height = winPtr->reqHeight + (wmPtr->height
+ - wmPtr->reqGridHeight)*wmPtr->heightInc;
+ }
+ wmPtr->widthInc = 1;
+ wmPtr->heightInc = 1;
+
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TopLevelEventProc --
+ *
+ * This procedure is invoked when a top-level (or other externally-
+ * managed window) is restructured in any way.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Tk's internal data structures for the window get modified to
+ * reflect the structural change.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+TopLevelEventProc(clientData, eventPtr)
+ ClientData clientData; /* Window for which event occurred. */
+ XEvent *eventPtr; /* Event that just happened. */
+{
+ register TkWindow *winPtr = (TkWindow *) clientData;
+
+ if (eventPtr->type == DestroyNotify) {
+ Tk_ErrorHandler handler;
+
+ if (!(winPtr->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(winPtr->display, -1, -1, -1,
+ (Tk_ErrorProc *) NULL, (ClientData) NULL);
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ Tk_DeleteErrorHandler(handler);
+ }
+ }
+ else if (eventPtr->type == ConfigureNotify) {
+ WmInfo *wmPtr;
+ wmPtr = winPtr->wmInfoPtr;
+
+ if (winPtr->flags & TK_EMBEDDED) {
+ Tk_Window tkwin = (Tk_Window)winPtr;
+ SendMessage(wmPtr->wrapper, TK_GEOMETRYREQ, Tk_ReqWidth(tkwin),
+ Tk_ReqHeight(tkwin));
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TopLevelReqProc --
+ *
+ * This procedure is invoked by the geometry manager whenever
+ * the requested size for a top-level window is changed.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Arrange for the window to be resized to satisfy the request
+ * (this happens as a when-idle action).
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* ARGSUSED */
+static void
+TopLevelReqProc(dummy, tkwin)
+ ClientData dummy; /* Not used. */
+ Tk_Window tkwin; /* Information about window. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ WmInfo *wmPtr;
+
+ wmPtr = winPtr->wmInfoPtr;
+ if (winPtr->flags & TK_EMBEDDED) {
+ SendMessage(wmPtr->wrapper, TK_GEOMETRYREQ, Tk_ReqWidth(tkwin),
+ Tk_ReqHeight(tkwin));
+ }
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * UpdateGeometryInfo --
+ *
+ * This procedure is invoked when a top-level window is first
+ * mapped, and also as a when-idle procedure, to bring the
+ * geometry and/or position of a top-level window back into
+ * line with what has been requested by the user and/or widgets.
+ * This procedure doesn't return until the system has
+ * responded to the geometry change.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window's size and location may change, unless the WM prevents
+ * that from happening.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+UpdateGeometryInfo(clientData)
+ ClientData clientData; /* Pointer to the window's record. */
+{
+ int x, y; /* Position of border on desktop. */
+ int width, height; /* Size of client area. */
+ RECT rect;
+ register TkWindow *winPtr = (TkWindow *) clientData;
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ wmPtr->flags &= ~WM_UPDATE_PENDING;
+
+ /*
+ * If the window is minimized or maximized, we should not update
+ * our geometry since it will end up with the wrong values.
+ * ConfigureToplevel will reschedule UpdateGeometryInfo when the
+ * 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.
+ */
+
+ rect.left = rect.right = rect.top = rect.bottom = 0;
+ AdjustWindowRectEx(&rect, wmPtr->style, wmPtr->hMenu != NULL,
+ wmPtr->exStyle);
+ wmPtr->borderWidth = rect.right - rect.left;
+ wmPtr->borderHeight = rect.bottom - rect.top;
+
+ /*
+ * Compute the new size for the top-level window. See the
+ * user documentation for details on this, but the size
+ * requested depends on (a) the size requested internally
+ * by the window's widgets, (b) the size requested by the
+ * user in a "wm geometry" command or via wm-based interactive
+ * resizing (if any), and (c) whether or not the window is
+ * gridded. Don't permit sizes <= 0 because this upsets
+ * the X server.
+ */
+
+ if (wmPtr->width == -1) {
+ width = winPtr->reqWidth;
+ } else if (wmPtr->gridWin != NULL) {
+ width = winPtr->reqWidth
+ + (wmPtr->width - wmPtr->reqGridWidth)*wmPtr->widthInc;
+ } else {
+ width = wmPtr->width;
+ }
+ if (width <= 0) {
+ width = 1;
+ }
+ if (wmPtr->height == -1) {
+ height = winPtr->reqHeight;
+ } else if (wmPtr->gridWin != NULL) {
+ height = winPtr->reqHeight
+ + (wmPtr->height - wmPtr->reqGridHeight)*wmPtr->heightInc;
+ } else {
+ height = wmPtr->height;
+ }
+ if (height <= 0) {
+ height = 1;
+ }
+
+ /*
+ * Compute the new position for the upper-left pixel of the window's
+ * decorative frame. This is tricky, because we need to include the
+ * border widths supplied by a reparented parent in this calculation,
+ * but can't use the parent's current overall size since that may
+ * change as a result of this code.
+ */
+
+ if (wmPtr->flags & WM_NEGATIVE_X) {
+ x = DisplayWidth(winPtr->display, winPtr->screenNum) - wmPtr->x
+ - (width + wmPtr->borderWidth);
+ } else {
+ x = wmPtr->x;
+ }
+ if (wmPtr->flags & WM_NEGATIVE_Y) {
+ y = DisplayHeight(winPtr->display, winPtr->screenNum) - wmPtr->y
+ - (height + wmPtr->borderHeight);
+ } else {
+ y = wmPtr->y;
+ }
+
+ /*
+ * If this window is embedded and the container is also in this
+ * process, we don't need to do anything special about the
+ * geometry, except to make sure that the desired size is known
+ * by the container. Also, zero out any position information,
+ * since embedded windows are not allowed to move.
+ */
+
+ if (winPtr->flags & TK_BOTH_HALVES) {
+ wmPtr->x = wmPtr->y = 0;
+ wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y);
+ Tk_GeometryRequest((Tk_Window) TkpGetOtherWindow(winPtr),
+ width, height);
+ return;
+ }
+
+ /*
+ * Reconfigure the window if it isn't already configured correctly. Base
+ * the size check on what we *asked for* last time, not what we got.
+ * Return immediately if there have been no changes in the requested
+ * geometry of the toplevel.
+ */
+ /* TODO: need to add flag for possible menu size change */
+
+ if (!((wmPtr->flags & WM_MOVE_PENDING)
+ || (width != wmPtr->configWidth)
+ || (height != wmPtr->configHeight))) {
+ return;
+ }
+ wmPtr->flags &= ~WM_MOVE_PENDING;
+
+ wmPtr->configWidth = width;
+ wmPtr->configHeight = height;
+
+ /*
+ * Don't bother moving the window if we are in the process of
+ * creating it. Just update the geometry info based on what
+ * we asked for.
+ */
+
+ if (wmPtr->flags & WM_CREATE_PENDING) {
+ winPtr->changes.x = x;
+ winPtr->changes.y = y;
+ winPtr->changes.width = width;
+ winPtr->changes.height = height;
+ return;
+ }
+
+ wmPtr->flags |= WM_SYNC_PENDING;
+ if (winPtr->flags & TK_EMBEDDED) {
+ /*
+ * The wrapper window is in a different process, so we need
+ * to send it a geometry request. This protocol assumes that
+ * the other process understands this Tk message, otherwise
+ * our requested geometry will be ignored.
+ */
+
+ SendMessage(wmPtr->wrapper, TK_GEOMETRYREQ, width, height);
+ } else {
+ int reqHeight, reqWidth;
+ RECT windowRect;
+ int menuInc = GetSystemMetrics(SM_CYMENU);
+ int newHeight;
+
+ /*
+ * We have to keep resizing the window until we get the
+ * requested height in the client area. If the client
+ * area has zero height, then the window rect is too
+ * small by definition. Try increasing the border height
+ * and try again. Once we have a positive size, then
+ * we can adjust the height exactly. If the window
+ * rect comes back smaller than we requested, we have
+ * hit the maximum constraints that Windows imposes.
+ * Once we find a positive client size, the next size
+ * is the one we try no matter what.
+ */
+
+ reqHeight = height + wmPtr->borderHeight;
+ reqWidth = width + wmPtr->borderWidth;
+
+ while (1) {
+ MoveWindow(wmPtr->wrapper, x, y, reqWidth, reqHeight, TRUE);
+ GetWindowRect(wmPtr->wrapper, &windowRect);
+ newHeight = windowRect.bottom - windowRect.top;
+
+ /*
+ * If the request wasn't satisfied, we have hit an external
+ * constraint and must stop.
+ */
+
+ if (newHeight < reqHeight) {
+ break;
+ }
+
+ /*
+ * Now check the size of the client area against our ideal.
+ */
+
+ GetClientRect(wmPtr->wrapper, &windowRect);
+ newHeight = windowRect.bottom - windowRect.top;
+
+ if (newHeight == height) {
+ /*
+ * We're done.
+ */
+ break;
+ } else if (newHeight > height) {
+ /*
+ * One last resize to get rid of the extra space.
+ */
+ menuInc = newHeight - height;
+ reqHeight -= menuInc;
+ if (wmPtr->flags & WM_NEGATIVE_Y) {
+ y += menuInc;
+ }
+ MoveWindow(wmPtr->wrapper, x, y, reqWidth, reqHeight, TRUE);
+ break;
+ }
+
+ /*
+ * We didn't get enough space to satisfy our requested
+ * height, so the menu must have wrapped. Increase the
+ * size of the window by one menu height and move the
+ * window if it is positioned relative to the lower right
+ * corner of the screen.
+ */
+
+ reqHeight += menuInc;
+ if (wmPtr->flags & WM_NEGATIVE_Y) {
+ y -= menuInc;
+ }
+ }
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ DrawMenuBar(wmPtr->wrapper);
+ }
+ }
+ wmPtr->flags &= ~WM_SYNC_PENDING;
+}
+
+/*
+ *--------------------------------------------------------------
+ *
+ * ParseGeometry --
+ *
+ * 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.
+ *
+ *--------------------------------------------------------------
+ */
+
+static int
+ParseGeometry(interp, string, winPtr)
+ Tcl_Interp *interp; /* Used for error reporting. */
+ char *string; /* String containing new geometry. Has the
+ * standard form "=wxh+x+y". */
+ TkWindow *winPtr; /* Pointer to top-level window whose
+ * geometry is to be changed. */
+{
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+ int x, y, width, height, flags;
+ char *end;
+ register char *p = string;
+
+ /*
+ * The leading "=" is optional.
+ */
+
+ if (*p == '=') {
+ p++;
+ }
+
+ /*
+ * Parse the width and height, if they are present. Don't
+ * actually update any of the fields of wmPtr until we've
+ * successfully parsed the entire geometry string.
+ */
+
+ width = wmPtr->width;
+ height = wmPtr->height;
+ x = wmPtr->x;
+ y = wmPtr->y;
+ flags = wmPtr->flags;
+ if (isdigit(UCHAR(*p))) {
+ width = strtoul(p, &end, 10);
+ p = end;
+ if (*p != 'x') {
+ goto error;
+ }
+ p++;
+ if (!isdigit(UCHAR(*p))) {
+ goto error;
+ }
+ height = strtoul(p, &end, 10);
+ p = end;
+ }
+
+ /*
+ * Parse the X and Y coordinates, if they are present.
+ */
+
+ if (*p != '\0') {
+ flags &= ~(WM_NEGATIVE_X | WM_NEGATIVE_Y);
+ if (*p == '-') {
+ flags |= WM_NEGATIVE_X;
+ } else if (*p != '+') {
+ goto error;
+ }
+ p++;
+ if (!isdigit(UCHAR(*p)) && (*p != '-')) {
+ goto error;
+ }
+ x = strtol(p, &end, 10);
+ p = end;
+ if (*p == '-') {
+ flags |= WM_NEGATIVE_Y;
+ } else if (*p != '+') {
+ goto error;
+ }
+ p++;
+ if (!isdigit(UCHAR(*p)) && (*p != '-')) {
+ goto error;
+ }
+ y = strtol(p, &end, 10);
+ if (*end != '\0') {
+ goto error;
+ }
+
+ /*
+ * Assume that the geometry information came from the user,
+ * unless an explicit source has been specified. Otherwise
+ * most window managers assume that the size hints were
+ * program-specified and they ignore them.
+ */
+
+ if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) {
+ wmPtr->sizeHintsFlags |= USPosition;
+ }
+ }
+
+ /*
+ * Everything was parsed OK. Update the fields of *wmPtr and
+ * arrange for the appropriate information to be percolated out
+ * to the window manager at the next idle moment.
+ */
+
+ wmPtr->width = width;
+ wmPtr->height = height;
+ wmPtr->x = x;
+ wmPtr->y = y;
+ flags |= WM_MOVE_PENDING;
+ wmPtr->flags = flags;
+
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+ return TCL_OK;
+
+ error:
+ Tcl_AppendResult(interp, "bad geometry specifier \"",
+ string, "\"", (char *) NULL);
+ return TCL_ERROR;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetRootCoords --
+ *
+ * Given a token for a window, this procedure traces through the
+ * window's lineage to find the (virtual) root-window coordinates
+ * corresponding to point (0,0) in the window.
+ *
+ * Results:
+ * The locations pointed to by xPtr and yPtr are filled in with
+ * the root coordinates of the (0,0) point in tkwin.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_GetRootCoords(tkwin, xPtr, yPtr)
+ Tk_Window tkwin; /* Token for window. */
+ int *xPtr; /* Where to store x-displacement of (0,0). */
+ int *yPtr; /* Where to store y-displacement of (0,0). */
+{
+ register TkWindow *winPtr = (TkWindow *) tkwin;
+
+ /*
+ * If the window is mapped, let Windows figure out the translation.
+ */
+
+ if (winPtr->window != None) {
+ HWND hwnd = Tk_GetHWND(winPtr->window);
+ POINT point;
+
+ point.x = 0;
+ point.y = 0;
+
+ ClientToScreen(hwnd, &point);
+
+ *xPtr = point.x;
+ *yPtr = point.y;
+ } else {
+ *xPtr = 0;
+ *yPtr = 0;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_CoordsToWindow --
+ *
+ * Given the (virtual) root coordinates of a point, this procedure
+ * returns the token for the top-most window covering that point,
+ * if there exists such a window in this application.
+ *
+ * Results:
+ * The return result is either a token for the window corresponding
+ * to rootX and rootY, or else NULL to indicate that there is no such
+ * window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Tk_Window
+Tk_CoordsToWindow(rootX, rootY, tkwin)
+ int rootX, rootY; /* Coordinates of point in root window. If
+ * a virtual-root window manager is in use,
+ * these coordinates refer to the virtual
+ * root, not the real root. */
+ Tk_Window tkwin; /* Token for any window in application;
+ * used to identify the display. */
+{
+ POINT pos;
+ HWND hwnd;
+ TkWindow *winPtr;
+
+ pos.x = rootX;
+ pos.y = rootY;
+ hwnd = WindowFromPoint(pos);
+
+ winPtr = (TkWindow *) Tk_HWNDToWindow(hwnd);
+ if (winPtr && (winPtr->mainPtr == ((TkWindow *) tkwin)->mainPtr)) {
+ return (Tk_Window) winPtr;
+ }
+ return NULL;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetVRootGeometry --
+ *
+ * This procedure returns information about the virtual root
+ * window corresponding to a particular Tk window.
+ *
+ * Results:
+ * The values at xPtr, yPtr, widthPtr, and heightPtr are set
+ * with the offset and dimensions of the root window corresponding
+ * to tkwin. If tkwin is being managed by a virtual root window
+ * manager these values correspond to the virtual root window being
+ * used for tkwin; otherwise the offsets will be 0 and the
+ * dimensions will be those of the screen.
+ *
+ * Side effects:
+ * Vroot window information is refreshed if it is out of date.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_GetVRootGeometry(tkwin, xPtr, yPtr, widthPtr, heightPtr)
+ Tk_Window tkwin; /* Window whose virtual root is to be
+ * queried. */
+ int *xPtr, *yPtr; /* Store x and y offsets of virtual root
+ * here. */
+ int *widthPtr, *heightPtr; /* Store dimensions of virtual root here. */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+
+ *xPtr = 0;
+ *yPtr = 0;
+ *widthPtr = DisplayWidth(winPtr->display, winPtr->screenNum);
+ *heightPtr = DisplayHeight(winPtr->display, winPtr->screenNum);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_MoveToplevelWindow --
+ *
+ * This procedure is called instead of Tk_MoveWindow to adjust
+ * the x-y location of a top-level window. It delays the actual
+ * move to a later time and keeps window-manager information
+ * up-to-date with the move
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The window is eventually moved so that its upper-left corner
+ * (actually, the upper-left corner of the window's decorative
+ * frame, if there is one) is at (x,y).
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_MoveToplevelWindow(tkwin, x, y)
+ Tk_Window tkwin; /* Window to move. */
+ int x, y; /* New location for window (within
+ * parent). */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ register WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ panic("Tk_MoveToplevelWindow called with non-toplevel window");
+ }
+ wmPtr->x = x;
+ wmPtr->y = y;
+ wmPtr->flags |= WM_MOVE_PENDING;
+ wmPtr->flags &= ~(WM_NEGATIVE_X|WM_NEGATIVE_Y);
+ if ((wmPtr->sizeHintsFlags & (USPosition|PPosition)) == 0) {
+ wmPtr->sizeHintsFlags |= USPosition;
+ }
+
+ /*
+ * If the window has already been mapped, must bring its geometry
+ * up-to-date immediately, otherwise an event might arrive from the
+ * server that would overwrite wmPtr->x and wmPtr->y and lose the
+ * new position.
+ */
+
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ if (wmPtr->flags & WM_UPDATE_PENDING) {
+ Tcl_CancelIdleCall(UpdateGeometryInfo, (ClientData) winPtr);
+ }
+ UpdateGeometryInfo((ClientData) winPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmProtocolEventProc --
+ *
+ * This procedure is called by the Tk_HandleEvent whenever a
+ * ClientMessage event arrives whose type is "WM_PROTOCOLS".
+ * This procedure handles the message from the window manager
+ * in an appropriate fashion.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Depends on what sort of handler, if any, was set up for the
+ * protocol.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWmProtocolEventProc(winPtr, eventPtr)
+ TkWindow *winPtr; /* Window to which the event was sent. */
+ XEvent *eventPtr; /* X event. */
+{
+ WmInfo *wmPtr;
+ register ProtocolHandler *protPtr;
+ Atom protocol;
+ int result;
+ Tcl_Interp *interp;
+
+ wmPtr = winPtr->wmInfoPtr;
+ if (wmPtr == NULL) {
+ return;
+ }
+ protocol = (Atom) eventPtr->xclient.data.l[0];
+ for (protPtr = wmPtr->protPtr; protPtr != NULL;
+ protPtr = protPtr->nextPtr) {
+ if (protocol == protPtr->protocol) {
+ Tcl_Preserve((ClientData) protPtr);
+ interp = protPtr->interp;
+ Tcl_Preserve((ClientData) interp);
+ result = Tcl_GlobalEval(interp, protPtr->command);
+ if (result != TCL_OK) {
+ Tcl_AddErrorInfo(interp, "\n (command for \"");
+ Tcl_AddErrorInfo(interp,
+ Tk_GetAtomName((Tk_Window) winPtr, protocol));
+ Tcl_AddErrorInfo(interp, "\" window manager protocol)");
+ Tcl_BackgroundError(interp);
+ }
+ Tcl_Release((ClientData) interp);
+ Tcl_Release((ClientData) protPtr);
+ return;
+ }
+ }
+
+ /*
+ * No handler was present for this protocol. If this is a
+ * WM_DELETE_WINDOW message then just destroy the window.
+ */
+
+ if (protocol == Tk_InternAtom((Tk_Window) winPtr, "WM_DELETE_WINDOW")) {
+ Tk_DestroyWindow((Tk_Window) winPtr);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmRestackToplevel --
+ *
+ * This procedure restacks a top-level window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * WinPtr gets restacked as specified by aboveBelow and otherPtr.
+ * This procedure doesn't return until the restack has taken
+ * effect and the ConfigureNotify event for it has been received.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWmRestackToplevel(winPtr, aboveBelow, otherPtr)
+ TkWindow *winPtr; /* Window to restack. */
+ int aboveBelow; /* Gives relative position for restacking;
+ * must be Above or Below. */
+ TkWindow *otherPtr; /* Window relative to which to restack;
+ * if NULL, then winPtr gets restacked
+ * above or below *all* siblings. */
+{
+ HWND hwnd, insertAfter;
+
+ /*
+ * Can't set stacking order properly until the window is on the
+ * screen (mapping it may give it a reparent window).
+ */
+
+ if (winPtr->window == None) {
+ Tk_MakeWindowExist((Tk_Window) winPtr);
+ }
+ if (winPtr->wmInfoPtr->flags & WM_NEVER_MAPPED) {
+ TkWmMapWindow(winPtr);
+ }
+ hwnd = (winPtr->wmInfoPtr->wrapper != NULL)
+ ? winPtr->wmInfoPtr->wrapper : Tk_GetHWND(winPtr->window);
+
+
+ if (otherPtr != NULL) {
+ if (otherPtr->window == None) {
+ Tk_MakeWindowExist((Tk_Window) otherPtr);
+ }
+ if (otherPtr->wmInfoPtr->flags & WM_NEVER_MAPPED) {
+ TkWmMapWindow(otherPtr);
+ }
+ insertAfter = (otherPtr->wmInfoPtr->wrapper != NULL)
+ ? otherPtr->wmInfoPtr->wrapper : Tk_GetHWND(otherPtr->window);
+ } else {
+ insertAfter = NULL;
+ }
+
+ TkWinSetWindowPos(hwnd, insertAfter, aboveBelow);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmAddToColormapWindows --
+ *
+ * This procedure is called to add a given window to the
+ * WM_COLORMAP_WINDOWS property for its top-level, if it
+ * isn't already there. It is invoked by the Tk code that
+ * creates a new colormap, in order to make sure that colormap
+ * information is propagated to the window manager by default.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * WinPtr's window gets added to the WM_COLORMAP_WINDOWS
+ * property of its nearest top-level ancestor, unless the
+ * colormaps have been set explicitly with the
+ * "wm colormapwindows" command.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWmAddToColormapWindows(winPtr)
+ TkWindow *winPtr; /* Window with a non-default colormap.
+ * Should not be a top-level window. */
+{
+ TkWindow *topPtr;
+ TkWindow **oldPtr, **newPtr;
+ int count, i;
+
+ if (winPtr->window == None) {
+ return;
+ }
+
+ for (topPtr = winPtr->parentPtr; ; topPtr = topPtr->parentPtr) {
+ if (topPtr == NULL) {
+ /*
+ * Window is being deleted. Skip the whole operation.
+ */
+
+ return;
+ }
+ if (topPtr->flags & TK_TOP_LEVEL) {
+ break;
+ }
+ }
+ if (topPtr->wmInfoPtr->flags & WM_COLORMAPS_EXPLICIT) {
+ return;
+ }
+
+ /*
+ * Make sure that the window isn't already in the list.
+ */
+
+ count = topPtr->wmInfoPtr->cmapCount;
+ oldPtr = topPtr->wmInfoPtr->cmapList;
+
+ for (i = 0; i < count; i++) {
+ if (oldPtr[i] == winPtr) {
+ return;
+ }
+ }
+
+ /*
+ * Make a new bigger array and use it to reset the property.
+ * Automatically add the toplevel itself as the last element
+ * of the list.
+ */
+
+ newPtr = (TkWindow **) ckalloc((unsigned) ((count+2)*sizeof(TkWindow*)));
+ if (count > 0) {
+ memcpy(newPtr, oldPtr, count * sizeof(TkWindow*));
+ }
+ if (count == 0) {
+ count++;
+ }
+ newPtr[count-1] = winPtr;
+ newPtr[count] = topPtr;
+ if (oldPtr != NULL) {
+ ckfree((char *) oldPtr);
+ }
+
+ 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);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmRemoveFromColormapWindows --
+ *
+ * This procedure is called to remove a given window from the
+ * WM_COLORMAP_WINDOWS property for its top-level. It is invoked
+ * when windows are deleted.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * WinPtr's window gets removed from the WM_COLORMAP_WINDOWS
+ * property of its nearest top-level ancestor, unless the
+ * top-level itself is being deleted too.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWmRemoveFromColormapWindows(winPtr)
+ TkWindow *winPtr; /* Window that may be present in
+ * WM_COLORMAP_WINDOWS property for its
+ * top-level. Should not be a top-level
+ * window. */
+{
+ TkWindow *topPtr;
+ TkWindow **oldPtr;
+ int count, i, j;
+
+ for (topPtr = winPtr->parentPtr; ; topPtr = topPtr->parentPtr) {
+ if (topPtr == NULL) {
+ /*
+ * Ancestors have been deleted, so skip the whole operation.
+ * Seems like this can't ever happen?
+ */
+
+ return;
+ }
+ if (topPtr->flags & TK_TOP_LEVEL) {
+ break;
+ }
+ }
+ if (topPtr->flags & TK_ALREADY_DEAD) {
+ /*
+ * Top-level is being deleted, so there's no need to cleanup
+ * the WM_COLORMAP_WINDOWS property.
+ */
+
+ return;
+ }
+
+ /*
+ * Find the window and slide the following ones down to cover
+ * it up.
+ */
+
+ count = topPtr->wmInfoPtr->cmapCount;
+ oldPtr = topPtr->wmInfoPtr->cmapList;
+ for (i = 0; i < count; i++) {
+ if (oldPtr[i] == winPtr) {
+ for (j = i ; j < count-1; j++) {
+ oldPtr[j] = oldPtr[j+1];
+ }
+ topPtr->wmInfoPtr->cmapCount = count-1;
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinSetMenu--
+ *
+ * Associcates a given HMENU to a window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The menu will end up being drawn in the window, and the geometry
+ * of the window will have to be changed.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWinSetMenu(tkwin, hMenu)
+ Tk_Window tkwin; /* the window to put the menu in */
+ HMENU hMenu; /* the menu to set */
+{
+ TkWindow *winPtr = (TkWindow *) tkwin;
+ WmInfo *wmPtr = winPtr->wmInfoPtr;
+
+ wmPtr->hMenu = hMenu;
+
+ if (!(wmPtr->flags & TK_EMBEDDED)) {
+ if (!(wmPtr->flags & WM_NEVER_MAPPED)) {
+ int syncPending = wmPtr->flags & WM_SYNC_PENDING;
+
+ wmPtr->flags |= WM_SYNC_PENDING;
+ SetMenu(wmPtr->wrapper, hMenu);
+ if (!syncPending) {
+ wmPtr->flags &= ~WM_SYNC_PENDING;
+ }
+ }
+ if (!(wmPtr->flags & (WM_UPDATE_PENDING|WM_NEVER_MAPPED))) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo, (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING|WM_MOVE_PENDING;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * ConfigureTopLevel --
+ *
+ * Generate a ConfigureNotify event based on the current position
+ * information. This procedure is called by TopLevelProc.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Queues a new event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+ConfigureTopLevel(pos)
+ WINDOWPOS *pos;
+{
+ TkWindow *winPtr = GetTopLevel(pos->hwnd);
+ WmInfo *wmPtr;
+ int state; /* Current window state. */
+ RECT rect;
+ WINDOWPLACEMENT windowPos;
+
+ if (winPtr == NULL) {
+ return;
+ }
+
+ wmPtr = winPtr->wmInfoPtr;
+
+ /*
+ * Determine the current window state.
+ */
+
+ if (!IsWindowVisible(wmPtr->wrapper)) {
+ state = WithdrawnState;
+ } else {
+ windowPos.length = sizeof(WINDOWPLACEMENT);
+ GetWindowPlacement(wmPtr->wrapper, &windowPos);
+ switch (windowPos.showCmd) {
+ case SW_SHOWMAXIMIZED:
+ state = ZoomState;
+ break;
+ case SW_SHOWMINIMIZED:
+ state = IconicState;
+ break;
+ case SW_SHOWNORMAL:
+ state = NormalState;
+ break;
+ }
+ }
+
+ /*
+ * If the state of the window just changed, be sure to update the
+ * child window information.
+ */
+
+ if (wmPtr->hints.initial_state != state) {
+ wmPtr->hints.initial_state = state;
+ switch (state) {
+ case WithdrawnState:
+ case IconicState:
+ XUnmapWindow(winPtr->display, winPtr->window);
+ break;
+
+ case NormalState:
+ /*
+ * Schedule a geometry update. Since we ignore geometry
+ * requests while in any other state, the geometry info
+ * may be stale.
+ */
+
+ if (!(wmPtr->flags & WM_UPDATE_PENDING)) {
+ Tcl_DoWhenIdle(UpdateGeometryInfo,
+ (ClientData) winPtr);
+ wmPtr->flags |= WM_UPDATE_PENDING;
+ }
+ /* fall through */
+ case ZoomState:
+ XMapWindow(winPtr->display, winPtr->window);
+ pos->flags |= SWP_NOMOVE | SWP_NOSIZE;
+ break;
+ }
+ }
+
+ /*
+ * Don't report geometry changes in the Iconic or Withdrawn states.
+ */
+
+ if (state == WithdrawnState || state == IconicState) {
+ return;
+ }
+
+
+ /*
+ * Compute the current geometry of the client area, reshape the
+ * Tk window and generate a ConfigureNotify event.
+ */
+
+ GetClientRect(wmPtr->wrapper, &rect);
+ winPtr->changes.x = pos->x;
+ winPtr->changes.y = pos->y;
+ winPtr->changes.width = rect.right - rect.left;
+ winPtr->changes.height = rect.bottom - rect.top;
+ wmPtr->borderHeight = pos->cy - winPtr->changes.height;
+ MoveWindow(Tk_GetHWND(winPtr->window), 0, 0,
+ winPtr->changes.width, winPtr->changes.height, TRUE);
+ GenerateConfigureNotify(winPtr);
+
+ /*
+ * Update window manager geometry info if needed.
+ */
+
+ if (state == NormalState) {
+
+ /*
+ * 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 (sync is set), then don't set
+ * wmPtr->width or wmPtr->height (otherwise the window will stop
+ * tracking geometry manager requests).
+ */
+
+ if (!(wmPtr->flags & WM_SYNC_PENDING)) {
+ if (!(pos->flags & SWP_NOSIZE)) {
+ if ((wmPtr->width == -1)
+ && (winPtr->changes.width == winPtr->reqWidth)) {
+ /*
+ * Don't set external width, since the user didn't
+ * change it from what the widgets asked for.
+ */
+ } else {
+ if (wmPtr->gridWin != NULL) {
+ wmPtr->width = wmPtr->reqGridWidth
+ + (winPtr->changes.width - winPtr->reqWidth)
+ / wmPtr->widthInc;
+ if (wmPtr->width < 0) {
+ wmPtr->width = 0;
+ }
+ } else {
+ wmPtr->width = winPtr->changes.width;
+ }
+ }
+ if ((wmPtr->height == -1)
+ && (winPtr->changes.height == winPtr->reqHeight)) {
+ /*
+ * Don't set external height, since the user didn't change
+ * it from what the widgets asked for.
+ */
+ } else {
+ if (wmPtr->gridWin != NULL) {
+ wmPtr->height = wmPtr->reqGridHeight
+ + (winPtr->changes.height - winPtr->reqHeight)
+ / wmPtr->heightInc;
+ if (wmPtr->height < 0) {
+ wmPtr->height = 0;
+ }
+ } else {
+ wmPtr->height = winPtr->changes.height;
+ }
+ }
+ wmPtr->configWidth = winPtr->changes.width;
+ wmPtr->configHeight = winPtr->changes.height;
+ }
+ /*
+ * If the user moved the window, we should switch back
+ * to normal coordinates.
+ */
+
+ if (!(pos->flags & SWP_NOMOVE)) {
+ wmPtr->flags &= ~(WM_NEGATIVE_X | WM_NEGATIVE_Y);
+ }
+ }
+
+ /*
+ * Update the wrapper window location information.
+ */
+
+ if (wmPtr->flags & WM_NEGATIVE_X) {
+ wmPtr->x = DisplayWidth(winPtr->display, winPtr->screenNum)
+ - winPtr->changes.x - (winPtr->changes.width
+ + wmPtr->borderWidth);
+ } else {
+ wmPtr->x = winPtr->changes.x;
+ }
+ if (wmPtr->flags & WM_NEGATIVE_Y) {
+ wmPtr->y = DisplayHeight(winPtr->display, winPtr->screenNum)
+ - winPtr->changes.y - (winPtr->changes.height
+ + wmPtr->borderHeight);
+ } else {
+ wmPtr->y = winPtr->changes.y;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateConfigureNotify --
+ *
+ * Generate a ConfigureNotify event from the current geometry
+ * information for the specified toplevel window.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sends an X event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GenerateConfigureNotify(winPtr)
+ TkWindow *winPtr;
+{
+ XEvent event;
+
+ /*
+ * Generate a ConfigureNotify event.
+ */
+
+ event.type = ConfigureNotify;
+ event.xconfigure.serial = winPtr->display->request;
+ event.xconfigure.send_event = False;
+ event.xconfigure.display = winPtr->display;
+ event.xconfigure.event = winPtr->window;
+ event.xconfigure.window = winPtr->window;
+ event.xconfigure.border_width = winPtr->changes.border_width;
+ event.xconfigure.override_redirect = winPtr->atts.override_redirect;
+ event.xconfigure.x = winPtr->changes.x;
+ event.xconfigure.y = winPtr->changes.y;
+ event.xconfigure.width = winPtr->changes.width;
+ event.xconfigure.height = winPtr->changes.height;
+ event.xconfigure.above = None;
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InstallColormaps --
+ *
+ * Installs the colormaps associated with the toplevel which is
+ * currently active.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * May change the system palette and generate damage.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+InstallColormaps(hwnd, message, isForemost)
+ HWND hwnd; /* Toplevel wrapper window whose colormaps
+ * should be installed. */
+ int message; /* Either WM_PALETTECHANGED or
+ * WM_QUERYNEWPALETTE */
+ 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;
+ }
+
+ } else {
+ /*
+ * Window is being notified of a change in the system palette.
+ * If this window is the foreground window, then we should only
+ * install the secondary palettes, since the primary was installed
+ * in response to the WM_QUERYPALETTE message. Otherwise, install
+ * all of the palettes.
+ */
+
+
+ if (!isForemost) {
+ if (wmPtr->cmapCount > 0) {
+ winPtr = wmPtr->cmapList[0];
+ }
+ i = 1;
+ } else {
+ if (wmPtr->cmapCount <= 1) {
+ return TRUE;
+ }
+ 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);
+ return TRUE;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * RefreshColormap --
+ *
+ * This function is called to force all of the windows that use
+ * a given colormap to redraw themselves. The quickest way to
+ * do this is to iterate over the toplevels, looking in the
+ * cmapList for matches. This will quickly eliminate subtrees
+ * that don't use a given colormap.
+ *
+ * Results:
+ * None.
+ *
+ * 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);
+ }
+ }
+ } else if ((wmPtr->winPtr->atts.colormap == colormap)
+ && Tk_IsMapped(wmPtr->winPtr)) {
+ InvalidateSubTree(wmPtr->winPtr, colormap);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * InvalidateSubTree --
+ *
+ * This function recursively generates damage for a window and
+ * all of its mapped children that belong to the same toplevel and
+ * are using the specified colormap.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Generates damage for the specified subtree.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InvalidateSubTree(winPtr, colormap)
+ TkWindow *winPtr;
+ Colormap colormap;
+{
+ TkWindow *childPtr;
+
+ /*
+ * Generate damage for the current window if it is using the
+ * specified colormap.
+ */
+
+ if (winPtr->atts.colormap == colormap) {
+ InvalidateRect(Tk_GetHWND(winPtr->window), NULL, FALSE);
+ }
+
+ for (childPtr = winPtr->childList; childPtr != NULL;
+ childPtr = childPtr->nextPtr) {
+ /*
+ * We can stop the descent when we hit an unmapped or
+ * toplevel window.
+ */
+
+ if (!Tk_IsTopLevel(childPtr) && Tk_IsMapped(childPtr)) {
+ InvalidateSubTree(childPtr, colormap);
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinGetSystemPalette --
+ *
+ * Retrieves the currently installed foreground palette.
+ *
+ * Results:
+ * Returns the global foreground palette, if there is one.
+ * Otherwise, returns NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+HPALETTE
+TkWinGetSystemPalette()
+{
+ return systemPalette;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMinSize --
+ *
+ * This procedure computes the current minWidth and minHeight
+ * values for a window, taking into account the possibility
+ * that they may be defaulted.
+ *
+ * Results:
+ * The values at *minWidthPtr and *minHeightPtr are filled
+ * in with the minimum allowable dimensions of wmPtr's window,
+ * in grid units. If the requested minimum is smaller than the
+ * system required minimum, then this procedure computes the
+ * smallest size that will satisfy both the system and the
+ * grid constraints.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMinSize(wmPtr, minWidthPtr, minHeightPtr)
+ WmInfo *wmPtr; /* Window manager information for the
+ * window. */
+ int *minWidthPtr; /* Where to store the current minimum
+ * width of the window. */
+ int *minHeightPtr; /* Where to store the current minimum
+ * height of the window. */
+{
+ int tmp, base;
+ TkWindow *winPtr = wmPtr->winPtr;
+
+ /*
+ * Compute the minimum width by taking the default client size
+ * and rounding it up to the nearest grid unit. Return the greater
+ * of the default minimum and the specified minimum.
+ */
+
+ tmp = wmPtr->defMinWidth - wmPtr->borderWidth;
+ if (tmp < 0) {
+ tmp = 0;
+ }
+ if (wmPtr->gridWin != NULL) {
+ base = winPtr->reqWidth - (wmPtr->reqGridWidth * wmPtr->widthInc);
+ if (base < 0) {
+ base = 0;
+ }
+ tmp = ((tmp - base) + wmPtr->widthInc - 1)/wmPtr->widthInc;
+ }
+ if (tmp < wmPtr->minWidth) {
+ tmp = wmPtr->minWidth;
+ }
+ *minWidthPtr = tmp;
+
+ /*
+ * Compute the minimum height in a similar fashion.
+ */
+
+ tmp = wmPtr->defMinHeight - wmPtr->borderHeight;
+ if (tmp < 0) {
+ tmp = 0;
+ }
+ if (wmPtr->gridWin != NULL) {
+ base = winPtr->reqHeight - (wmPtr->reqGridHeight * wmPtr->heightInc);
+ if (base < 0) {
+ base = 0;
+ }
+ tmp = ((tmp - base) + wmPtr->heightInc - 1)/wmPtr->heightInc;
+ }
+ if (tmp < wmPtr->minHeight) {
+ tmp = wmPtr->minHeight;
+ }
+ *minHeightPtr = tmp;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetMaxSize --
+ *
+ * This procedure computes the current maxWidth and maxHeight
+ * values for a window, taking into account the possibility
+ * that they may be defaulted.
+ *
+ * Results:
+ * The values at *maxWidthPtr and *maxHeightPtr are filled
+ * in with the maximum allowable dimensions of wmPtr's window,
+ * in grid units. If no maximum has been specified for the
+ * window, then this procedure computes the largest sizes that
+ * will fit on the screen.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GetMaxSize(wmPtr, maxWidthPtr, maxHeightPtr)
+ WmInfo *wmPtr; /* Window manager information for the
+ * window. */
+ int *maxWidthPtr; /* Where to store the current maximum
+ * width of the window. */
+ int *maxHeightPtr; /* Where to store the current maximum
+ * height of the window. */
+{
+ int tmp;
+
+ if (wmPtr->maxWidth > 0) {
+ *maxWidthPtr = wmPtr->maxWidth;
+ } else {
+ /*
+ * Must compute a default width. Fill up the display, leaving a
+ * bit of extra space for the window manager's borders.
+ */
+
+ tmp = wmPtr->defMaxWidth - wmPtr->borderWidth;
+ if (wmPtr->gridWin != NULL) {
+ /*
+ * Gridding is turned on; convert from pixels to grid units.
+ */
+
+ tmp = wmPtr->reqGridWidth
+ + (tmp - wmPtr->winPtr->reqWidth)/wmPtr->widthInc;
+ }
+ *maxWidthPtr = tmp;
+ }
+ if (wmPtr->maxHeight > 0) {
+ *maxHeightPtr = wmPtr->maxHeight;
+ } else {
+ tmp = wmPtr->defMaxHeight - wmPtr->borderHeight;
+ if (wmPtr->gridWin != NULL) {
+ tmp = wmPtr->reqGridHeight
+ + (tmp - wmPtr->winPtr->reqHeight)/wmPtr->heightInc;
+ }
+ *maxHeightPtr = tmp;
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TopLevelProc --
+ *
+ * Callback from Windows whenever an event occurs on a top level
+ * window.
+ *
+ * Results:
+ * Standard Windows return value.
+ *
+ * Side effects:
+ * Default window behavior.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static LRESULT CALLBACK
+TopLevelProc(hwnd, message, wParam, lParam)
+ HWND hwnd;
+ UINT message;
+ WPARAM wParam;
+ LPARAM lParam;
+{
+ if (message == WM_WINDOWPOSCHANGED) {
+ WINDOWPOS *pos = (WINDOWPOS *) lParam;
+ TkWindow *winPtr = (TkWindow *) Tk_HWNDToWindow(pos->hwnd);
+
+ if (winPtr == NULL) {
+ return 0;
+ }
+
+ /*
+ * Update the shape of the contained window.
+ */
+
+ if (!(pos->flags & SWP_NOSIZE)) {
+ winPtr->changes.width = pos->cx;
+ winPtr->changes.height = pos->cy;
+ }
+ if (!(pos->flags & SWP_NOMOVE)) {
+ winPtr->changes.x = pos->x;
+ winPtr->changes.y = pos->y;
+ }
+
+ GenerateConfigureNotify(winPtr);
+
+ Tcl_ServiceAll();
+ return 0;
+ }
+ return TkWinChildProc(hwnd, message, wParam, lParam);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * WmProc --
+ *
+ * Callback from Windows whenever an event occurs on the decorative
+ * frame.
+ *
+ * Results:
+ * Standard Windows return value.
+ *
+ * Side effects:
+ * Default window behavior.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static LRESULT CALLBACK
+WmProc(hwnd, message, wParam, lParam)
+ HWND hwnd;
+ UINT message;
+ WPARAM wParam;
+ LPARAM lParam;
+{
+ 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;
+
+ /* CYGNUS LOCAL: Cancel any current mouse timer before we
+ start looking for events. If the mouse timer fires, it
+ will release the size/move mouse capture, which is
+ wrong. */
+ TkWinCancelMouseTimer();
+
+ oldMode = Tcl_SetServiceMode(TCL_SERVICE_ALL);
+ break;
+
+ case WM_ACTIVATE:
+ case WM_EXITSIZEMOVE:
+ if (inMoveSize) {
+ inMoveSize = 0;
+ Tcl_SetServiceMode(oldMode);
+ }
+ break;
+
+ case WM_GETMINMAXINFO:
+ SetLimits(hwnd, (MINMAXINFO *) lParam);
+ result = 0;
+ goto done;
+
+ case WM_PALETTECHANGED:
+ result = InstallColormaps(hwnd, WM_PALETTECHANGED,
+ hwnd == (HWND)wParam);
+ goto done;
+
+ case WM_QUERYNEWPALETTE:
+ 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;
+ }
+
+ /* CYGNUS LOCAL. */
+ case WM_SETTINGCHANGE:
+ if (wParam == SPI_SETNONCLIENTMETRICS) {
+ winPtr = GetTopLevel(hwnd);
+ if (winPtr != NULL) {
+ TkWinNCMetricsChanged((Tk_Window) winPtr);
+ }
+ }
+ break;
+
+ /* CYGNUS LOCAL. */
+ case WM_SYSCOLORCHANGE:
+ TkWinSysColorChange();
+ break;
+
+ default:
+ break;
+ }
+
+ winPtr = GetTopLevel(hwnd);
+ if (winPtr && winPtr->window) {
+ HWND child = Tk_GetHWND(winPtr->window);
+ if (message == WM_SETFOCUS) {
+ SetFocus(child);
+ result = 0;
+ } else if (!Tk_TranslateWinEvent(child, message, wParam, lParam,
+ &result)) {
+ result = DefWindowProc(hwnd, message, wParam, lParam);
+ }
+ } else {
+ result = DefWindowProc(hwnd, message, wParam, lParam);
+ }
+
+ done:
+ Tcl_ServiceAll();
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpMakeMenuWindow --
+ *
+ * Configure the window to be either a pull-down (or pop-up)
+ * menu, or as a toplevel (torn-off) menu or palette.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Changes the style bit used to create a new Mac toplevel.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkpMakeMenuWindow(tkwin, transient)
+ Tk_Window tkwin; /* New window. */
+ int transient; /* 1 means menu is only posted briefly as
+ * a popup or pulldown or cascade. 0 means
+ * menu is always visible, e.g. as a torn-off
+ * menu. Determines whether save_under and
+ * override_redirect should be set. */
+{
+ XSetWindowAttributes atts;
+
+ if (transient) {
+ atts.override_redirect = True;
+ atts.save_under = True;
+ } else {
+ atts.override_redirect = False;
+ atts.save_under = False;
+ }
+
+ if ((atts.override_redirect != Tk_Attributes(tkwin)->override_redirect)
+ || (atts.save_under != Tk_Attributes(tkwin)->save_under)) {
+ Tk_ChangeWindowAttributes(tkwin,
+ CWOverrideRedirect|CWSaveUnder, &atts);
+ }
+
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinGetWrapperWindow --
+ *
+ * Gets the Windows HWND for a given window.
+ *
+ * Results:
+ * Returns the wrapper window for a Tk window.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+HWND
+TkWinGetWrapperWindow(
+ Tk_Window tkwin) /* The window we need the wrapper from */
+{
+ TkWindow *winPtr = (TkWindow *)tkwin;
+ return (winPtr->wmInfoPtr->wrapper);
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWmFocusToplevel --
+ *
+ * This is a utility procedure invoked by focus-management code. It
+ * exists because of the extra wrapper windows that exist under
+ * Unix; its job is to map from wrapper windows to the
+ * corresponding toplevel windows. On PCs and Macs there are no
+ * wrapper windows so no mapping is necessary; this procedure just
+ * determines whether a window is a toplevel or not.
+ *
+ * Results:
+ * If winPtr is a toplevel window, returns the pointer to the
+ * window; otherwise returns NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkWmFocusToplevel(winPtr)
+ TkWindow *winPtr; /* Window that received a focus-related
+ * event. */
+{
+ if (!(winPtr->flags & TK_TOP_LEVEL)) {
+ return NULL;
+ }
+ return winPtr;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetWrapperWindow --
+ *
+ * This is a utility procedure invoked by focus-management code. It
+ * maps to the wrapper for a top-level, which is just the same
+ * as the top-level on Macs and PCs.
+ *
+ * Results:
+ * If winPtr is a toplevel window, returns the pointer to the
+ * window; otherwise returns NULL.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+TkWindow *
+TkpGetWrapperWindow(
+ TkWindow *winPtr) /* Window that received a focus-related
+ * 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;
+}
diff --git a/tk/win/tkWinX.c b/tk/win/tkWinX.c
new file mode 100644
index 00000000000..3a5bbe9d1ee
--- /dev/null
+++ b/tk/win/tkWinX.c
@@ -0,0 +1,1088 @@
+/*
+ * 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$
+ */
+
+#include "tkInt.h"
+#include "tkWinInt.h"
+
+#if defined (__CYGWIN32__) || defined (__MINGW32__)
+/* GCC ports that use Windows32api headers don't provide
+ GetCurrentTime, and the function is obsolete anyhow. */
+#define GetCurrentTime GetTickCount
+#endif
+
+/*
+ * CYGNUS LOCAL:
+ * We don't have a zmouse.h, AND as of gnupro 98r2, the WM_MOUSEWHEEL
+ * message is not added to any of the Cygwin defines. So we include
+ * it here.
+ * FIXME -- remove the define when it gets into the Cygwin header files
+ */
+
+#ifdef __CYGWIN32__
+#define WM_MOUSEWHEEL 0x020A
+#else
+/*
+ * The zmouse.h file includes the definition for WM_MOUSEWHEEL.
+ */
+
+#include <zmouse.h>
+#endif
+
+/*
+ * 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));
+static unsigned int GetState _ANSI_ARGS_((UINT message, WPARAM wParam,
+ LPARAM lParam));
+static void GetTranslatedKey _ANSI_ARGS_((XKeyEvent *xkey));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetServerInfo --
+ *
+ * Given a window, this procedure returns information about
+ * the window server for that window. This procedure provides
+ * the guts of the "winfo server" command.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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];
+ OSVERSIONINFO info;
+
+ info.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
+ GetVersionEx(&info);
+ sprintf(buffer, "Windows %d.%d %d ", info.dwMajorVersion,
+ info.dwMinorVersion, info.dwBuildNumber);
+ Tcl_AppendResult(interp, buffer,
+ (info.dwPlatformId == VER_PLATFORM_WIN32s) ? "Win32s" : "Win32",
+ (char *) NULL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_GetHINSTANCE --
+ *
+ * Retrieves the global instance handle used by the Tk library.
+ *
+ * Results:
+ * Returns the global instance handle.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+HINSTANCE
+Tk_GetHINSTANCE()
+{
+ return tkInstance;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinXInit --
+ *
+ * Initialize Xlib emulation layer.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets up various data structures.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWinXInit(hInstance)
+ HINSTANCE hInstance;
+{
+ OSVERSIONINFO info;
+
+ info.dwOSVersionInfoSize = sizeof(OSVERSIONINFO);
+ GetVersionEx(&info);
+ tkpIsWin32s = (info.dwPlatformId == VER_PLATFORM_WIN32s);
+
+ 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;
+
+ /*
+ * Register the Child window class.
+ */
+
+ childClass.lpszClassName = TK_WIN_CHILD_CLASS_NAME;
+ childClass.lpfnWndProc = TkWinChildProc;
+ childClass.hIcon = NULL;
+ childClass.hCursor = NULL;
+
+ if (!RegisterClass(&childClass)) {
+ panic("Unable to register TkChild class");
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinXCleanup --
+ *
+ * Removes the registered classes for Tk.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Removes window classes from the system.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkWinXCleanup(hInstance)
+ HINSTANCE hInstance;
+{
+ /*
+ * Clean up our own class.
+ */
+
+ if (childClassInitialized) {
+ childClassInitialized = 0;
+ UnregisterClass(TK_WIN_CHILD_CLASS_NAME, hInstance);
+ }
+
+ /*
+ * And let the window manager clean up its own class(es).
+ */
+
+ TkWinWmCleanup(hInstance);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkGetDefaultScreenName --
+ *
+ * Returns the name of the screen that Tk should use during
+ * initialization.
+ *
+ * Results:
+ * Returns a statically allocated string.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+char *
+TkGetDefaultScreenName(interp, screenName)
+ Tcl_Interp *interp; /* Not used. */
+ char *screenName; /* If NULL, use default string. */
+{
+ if ((screenName == NULL) || (screenName[0] == '\0')) {
+ screenName = winScreenName;
+ }
+ return screenName;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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);
+ strcpy(display->display_name, display_name);
+
+ display->cursor_font = 1;
+ display->nscreens = 1;
+ display->request = 1;
+ display->qlen = 0;
+
+ screen = (Screen *) ckalloc(sizeof(Screen));
+ screen->display = display;
+
+ dc = GetDC(NULL);
+ screen->width = GetDeviceCaps(dc, HORZRES);
+ screen->height = GetDeviceCaps(dc, VERTRES);
+ screen->mwidth = MulDiv(screen->width, 254,
+ GetDeviceCaps(dc, LOGPIXELSX) * 10);
+ screen->mheight = MulDiv(screen->height, 254,
+ GetDeviceCaps(dc, LOGPIXELSY) * 10);
+
+ /*
+ * Set up the root window.
+ */
+
+ twdPtr = (TkWinDrawable*) ckalloc(sizeof(TkWinDrawable));
+ if (twdPtr == NULL) {
+ return None;
+ }
+ twdPtr->type = TWD_WINDOW;
+ twdPtr->window.winPtr = NULL;
+ twdPtr->window.handle = NULL;
+ screen->root = (Window)twdPtr;
+
+ /*
+ * On windows, when creating a color bitmap, need two pieces of
+ * information: the number of color planes and the number of
+ * pixels per plane. Need to remember both quantities so that
+ * when constructing an HBITMAP for offscreen rendering, we can
+ * specify the correct value for the number of planes. Otherwise
+ * the HBITMAP won't be compatible with the HWND and we'll just
+ * get blank spots copied onto the screen.
+ */
+
+ screen->ext_data = (XExtData *) GetDeviceCaps(dc, PLANES);
+ screen->root_depth = GetDeviceCaps(dc, BITSPIXEL) * (int) screen->ext_data;
+
+ screen->root_visual = (Visual *) ckalloc(sizeof(Visual));
+ screen->root_visual->visualid = 0;
+ if (GetDeviceCaps(dc, RASTERCAPS) & RC_PALETTE) {
+ screen->root_visual->map_entries = GetDeviceCaps(dc, SIZEPALETTE);
+ screen->root_visual->class = PseudoColor;
+ screen->root_visual->red_mask = 0x0;
+ screen->root_visual->green_mask = 0x0;
+ screen->root_visual->blue_mask = 0x0;
+ } else {
+ if (screen->root_depth == 4) {
+ screen->root_visual->class = StaticColor;
+ screen->root_visual->map_entries = 16;
+ } else if (screen->root_depth == 8) {
+ screen->root_visual->class = StaticColor;
+ screen->root_visual->map_entries = 256;
+ } else if (screen->root_depth == 12) {
+ screen->root_visual->class = TrueColor;
+ screen->root_visual->map_entries = 32;
+ screen->root_visual->red_mask = 0xf0;
+ screen->root_visual->green_mask = 0xf000;
+ screen->root_visual->blue_mask = 0xf00000;
+ } else if (screen->root_depth == 16) {
+ screen->root_visual->class = TrueColor;
+ screen->root_visual->map_entries = 64;
+ screen->root_visual->red_mask = 0xf8;
+ screen->root_visual->green_mask = 0xfc00;
+ screen->root_visual->blue_mask = 0xf80000;
+ } else if (screen->root_depth >= 24) {
+ screen->root_visual->class = TrueColor;
+ screen->root_visual->map_entries = 256;
+ screen->root_visual->red_mask = 0xff;
+ screen->root_visual->green_mask = 0xff00;
+ screen->root_visual->blue_mask = 0xff0000;
+ }
+ }
+ screen->root_visual->bits_per_rgb = screen->root_depth;
+ ReleaseDC(NULL, dc);
+
+ /*
+ * Note that these pixel values are not palette relative.
+ */
+
+ screen->white_pixel = RGB(255, 255, 255);
+ 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 --
+ *
+ * Closes and deallocates a Display structure created with the
+ * TkpOpenDisplay function.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Frees up memory.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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);
+ }
+ if (display->screens->root != None) {
+ ckfree((char *) display->screens->root);
+ }
+ if (display->screens->cmap != None) {
+ XFreeColormap(display, display->screens->cmap);
+ }
+ ckfree((char *) display->screens);
+ }
+ ckfree((char *) display);
+ ckfree((char *) dispPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XBell --
+ *
+ * Generate a beep.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Plays a sounds out the system speakers.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XBell(display, percent)
+ Display* display;
+ int percent;
+{
+ MessageBeep(MB_OK);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinChildProc --
+ *
+ * Callback from Windows whenever an event occurs on a child
+ * window.
+ *
+ * Results:
+ * Standard Windows return value.
+ *
+ * Side effects:
+ * May process events off the Tk event queue.
+ *
+ *----------------------------------------------------------------------
+ */
+
+LRESULT CALLBACK
+TkWinChildProc(hwnd, message, wParam, lParam)
+ HWND hwnd;
+ UINT message;
+ WPARAM wParam;
+ LPARAM lParam;
+{
+ LRESULT result;
+
+ switch (message) {
+ case WM_SETCURSOR:
+ /*
+ * Short circuit the WM_SETCURSOR message since we set
+ * the cursor elsewhere.
+ */
+
+ result = TRUE;
+ break;
+
+ case WM_CREATE:
+ case WM_ERASEBKGND:
+ case WM_WINDOWPOSCHANGED:
+ result = 0;
+ break;
+
+ case WM_PAINT:
+ GenerateXEvent(hwnd, message, wParam, lParam);
+ result = DefWindowProc(hwnd, message, wParam, lParam);
+ break;
+
+ case TK_CLAIMFOCUS:
+ case TK_GEOMETRYREQ:
+ case TK_ATTACHWINDOW:
+ case TK_DETACHWINDOW:
+ result = TkWinEmbeddedEventProc(hwnd, message, wParam, lParam);
+ break;
+
+ default:
+ if (!Tk_TranslateWinEvent(hwnd, message, wParam, lParam,
+ &result)) {
+ result = DefWindowProc(hwnd, message, wParam, lParam);
+ }
+ break;
+ }
+
+ /*
+ * Handle any newly queued events before returning control to Windows.
+ */
+
+ Tcl_ServiceAll();
+ return result;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_TranslateWinEvent --
+ *
+ * This function is called by widget window procedures to handle
+ * the translation from Win32 events to Tk events.
+ *
+ * Results:
+ * Returns 1 if the event was handled, else 0.
+ *
+ * Side effects:
+ * Depends on the event.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tk_TranslateWinEvent(hwnd, message, wParam, lParam, resultPtr)
+ HWND hwnd;
+ UINT message;
+ WPARAM wParam;
+ LPARAM lParam;
+ LRESULT *resultPtr;
+{
+ *resultPtr = 0;
+ switch (message) {
+ case WM_RENDERFORMAT: {
+ TkWindow *winPtr = (TkWindow *) Tk_HWNDToWindow(hwnd);
+ if (winPtr) {
+ TkWinClipboardRender(winPtr->dispPtr, wParam);
+ }
+ return 1;
+ }
+
+ case WM_COMMAND:
+ case WM_NOTIFY:
+ case WM_VSCROLL:
+ case WM_HSCROLL: {
+ /*
+ * Reflect these messages back to the sender so that they
+ * can be handled by the window proc for the control. Note
+ * that we need to be careful not to reflect a message that
+ * is targeted to this window, or we will loop.
+ */
+
+ HWND target = (message == WM_NOTIFY)
+ ? ((NMHDR*)lParam)->hwndFrom : (HWND) lParam;
+ if (target && target != hwnd) {
+ *resultPtr = SendMessage(target, message, wParam, lParam);
+ return 1;
+ }
+ break;
+ }
+
+ case WM_LBUTTONDOWN:
+ case WM_LBUTTONDBLCLK:
+ case WM_MBUTTONDOWN:
+ case WM_MBUTTONDBLCLK:
+ case WM_RBUTTONDOWN:
+ case WM_RBUTTONDBLCLK:
+ case WM_LBUTTONUP:
+ case WM_MBUTTONUP:
+ case WM_RBUTTONUP:
+ case WM_MOUSEMOVE:
+ Tk_PointerEvent(hwnd, (short) LOWORD(lParam),
+ (short) HIWORD(lParam));
+ return 1;
+
+ case WM_CLOSE:
+ case WM_SETFOCUS:
+ 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;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GenerateXEvent --
+ *
+ * This routine generates an X event from the corresponding
+ * Windows event.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Queues one or more X events.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+GenerateXEvent(hwnd, message, wParam, lParam)
+ HWND hwnd;
+ UINT message;
+ WPARAM wParam;
+ LPARAM lParam;
+{
+ XEvent event;
+ TkWindow *winPtr = (TkWindow *)Tk_HWNDToWindow(hwnd);
+
+ if (!winPtr || winPtr->window == None) {
+ return;
+ }
+
+ event.xany.serial = winPtr->display->request++;
+ event.xany.send_event = False;
+ event.xany.display = winPtr->display;
+ event.xany.window = winPtr->window;
+
+ switch (message) {
+ case WM_PAINT: {
+ PAINTSTRUCT ps;
+
+ event.type = Expose;
+ BeginPaint(hwnd, &ps);
+ event.xexpose.x = ps.rcPaint.left;
+ event.xexpose.y = ps.rcPaint.top;
+ event.xexpose.width = ps.rcPaint.right - ps.rcPaint.left;
+ event.xexpose.height = ps.rcPaint.bottom - ps.rcPaint.top;
+ EndPaint(hwnd, &ps);
+ event.xexpose.count = 0;
+ break;
+ }
+
+ case WM_CLOSE:
+ event.type = ClientMessage;
+ event.xclient.message_type =
+ Tk_InternAtom((Tk_Window) winPtr, "WM_PROTOCOLS");
+ event.xclient.format = 32;
+ event.xclient.data.l[0] =
+ Tk_InternAtom((Tk_Window) winPtr, "WM_DELETE_WINDOW");
+ break;
+
+ case WM_SETFOCUS:
+ case WM_KILLFOCUS: {
+ TkWindow *otherWinPtr = (TkWindow *)Tk_HWNDToWindow((HWND) wParam);
+
+ /*
+ * Compare toplevel windows to avoid reporting focus
+ * changes within the same toplevel.
+ */
+
+ while (!(winPtr->flags & TK_TOP_LEVEL)) {
+ winPtr = winPtr->parentPtr;
+ if (winPtr == NULL) {
+ return;
+ }
+ }
+ while (otherWinPtr && !(otherWinPtr->flags & TK_TOP_LEVEL)) {
+ otherWinPtr = otherWinPtr->parentPtr;
+ }
+ if (otherWinPtr == winPtr) {
+ return;
+ }
+
+ event.xany.window = winPtr->window;
+ event.type = (message == WM_SETFOCUS) ? FocusIn : FocusOut;
+ event.xfocus.mode = NotifyNormal;
+ event.xfocus.detail = NotifyNonlinear;
+ break;
+ }
+
+ case WM_DESTROYCLIPBOARD:
+ event.type = SelectionClear;
+ event.xselectionclear.selection =
+ Tk_InternAtom((Tk_Window)winPtr, "CLIPBOARD");
+ event.xselectionclear.time = TkpGetMS();
+ break;
+
+ /* CYGNUS LOCAL: Handle WM_MENUCHAR. */
+ case WM_MENUCHAR:
+ 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);
+ Time time = TkpGetMS();
+ POINT clientPoint;
+ POINTS rootPoint; /* Note: POINT and POINTS are different */
+ DWORD msgPos;
+
+ /*
+ * Compute the screen and window coordinates of the event.
+ */
+
+ msgPos = GetMessagePos();
+ rootPoint = MAKEPOINTS(msgPos);
+ clientPoint.x = rootPoint.x;
+ clientPoint.y = rootPoint.y;
+ ScreenToClient(hwnd, &clientPoint);
+
+ /*
+ * Set up the common event fields.
+ */
+
+ event.xbutton.root = RootWindow(winPtr->display,
+ winPtr->screenNum);
+ event.xbutton.subwindow = None;
+ event.xbutton.x = clientPoint.x;
+ event.xbutton.y = clientPoint.y;
+ event.xbutton.x_root = rootPoint.x;
+ event.xbutton.y_root = rootPoint.y;
+ event.xbutton.state = state;
+ event.xbutton.time = time;
+ 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
+ * extension xkey.trans_chars is filled with the
+ * characters that came from the TranslateMessage
+ * call. If it is not -1, xkey.keycode is the
+ * virtual key being sent programmatically by generic
+ * code.
+ */
+
+ event.type = KeyPress;
+ event.xany.send_event = -1;
+ event.xkey.keycode = wParam;
+ GetTranslatedKey(&event.xkey);
+ break;
+
+ case WM_SYSKEYUP:
+ case WM_KEYUP:
+ /*
+ * 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;
+
+ /* CYGNUS LOCAL: Handle WM_MENUCHAR. */
+ case WM_MENUCHAR:
+ /* For a WM_MENUCHAR message, the character code is
+ only the low word. */
+ wParam = LOWORD (wParam);
+ /* Fall through. */
+
+ 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;
+ }
+
+ default:
+ return;
+ }
+ Tk_QueueWindowEvent(&event, TCL_QUEUE_TAIL);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * GetState --
+ *
+ * This function constructs a state mask for the mouse buttons
+ * and modifier keys as they were before the event occured.
+ *
+ * Results:
+ * Returns a composite value of all the modifier and button state
+ * flags that were set at the time the event occurred.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static unsigned int
+GetState(message, wParam, lParam)
+ UINT message; /* Win32 message type */
+ WPARAM wParam; /* wParam of message, used if key message */
+ LPARAM lParam; /* lParam of message, used if key message */
+{
+ int mask;
+ int prevState; /* 1 if key was previously down */
+ unsigned int state = TkWinGetModifierState();
+
+ /*
+ * If the event is a key press or release, we check for modifier
+ * keys so we can report the state of the world before the event.
+ */
+
+ if (message == WM_SYSKEYDOWN || message == WM_KEYDOWN
+ || message == WM_SYSKEYUP || message == WM_KEYUP) {
+ mask = 0;
+ prevState = HIWORD(lParam) & KF_REPEAT;
+ switch(wParam) {
+ case VK_SHIFT:
+ mask = ShiftMask;
+ break;
+ case VK_CONTROL:
+ mask = ControlMask;
+ break;
+ case VK_MENU:
+ mask = Mod2Mask;
+ break;
+ case VK_CAPITAL:
+ if (message == WM_SYSKEYDOWN || message == WM_KEYDOWN) {
+ mask = LockMask;
+ prevState = ((state & mask) ^ prevState) ? 0 : 1;
+ }
+ break;
+ case VK_NUMLOCK:
+ if (message == WM_SYSKEYDOWN || message == WM_KEYDOWN) {
+ mask = Mod1Mask;
+ prevState = ((state & mask) ^ prevState) ? 0 : 1;
+ }
+ break;
+ case VK_SCROLL:
+ if (message == WM_SYSKEYDOWN || message == WM_KEYDOWN) {
+ mask = Mod3Mask;
+ prevState = ((state & mask) ^ prevState) ? 0 : 1;
+ }
+ break;
+ }
+ if (prevState) {
+ state |= mask;
+ } else {
+ state &= ~mask;
+ }
+ }
+ return state;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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) || (msg.message == WM_SYSCHAR)) {
+ xkey->trans_chars[xkey->nchars] = (char) msg.wParam;
+ xkey->nchars++;
+ 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;
+ }
+ } else {
+ break;
+ }
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tk_FreeXId --
+ *
+ * This inteface is not needed under Windows.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tk_FreeXId(display, xid)
+ Display *display;
+ XID xid;
+{
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkWinResendEvent --
+ *
+ * This function converts an X event into a Windows event and
+ * invokes the specified windo procedure.
+ *
+ * Results:
+ * A standard Windows result.
+ *
+ * Side effects:
+ * Invokes the window procedure
+ *
+ *----------------------------------------------------------------------
+ */
+
+LRESULT
+TkWinResendEvent(wndproc, hwnd, eventPtr)
+ WNDPROC wndproc;
+ HWND hwnd;
+ XEvent *eventPtr;
+{
+ UINT msg;
+ WPARAM wparam;
+ LPARAM lparam;
+
+ if (eventPtr->type == ButtonPress) {
+ switch (eventPtr->xbutton.button) {
+ case Button1:
+ msg = WM_LBUTTONDOWN;
+ wparam = MK_LBUTTON;
+ break;
+ case Button2:
+ msg = WM_MBUTTONDOWN;
+ wparam = MK_MBUTTON;
+ break;
+ case Button3:
+ msg = WM_RBUTTONDOWN;
+ wparam = MK_RBUTTON;
+ break;
+ default:
+ return 0;
+ }
+ if (eventPtr->xbutton.state & Button1Mask) {
+ wparam |= MK_LBUTTON;
+ }
+ if (eventPtr->xbutton.state & Button2Mask) {
+ wparam |= MK_MBUTTON;
+ }
+ if (eventPtr->xbutton.state & Button3Mask) {
+ wparam |= MK_RBUTTON;
+ }
+ if (eventPtr->xbutton.state & ShiftMask) {
+ wparam |= MK_SHIFT;
+ }
+ if (eventPtr->xbutton.state & ControlMask) {
+ wparam |= MK_CONTROL;
+ }
+ lparam = MAKELPARAM((short) eventPtr->xbutton.x,
+ (short) eventPtr->xbutton.y);
+ } else {
+ return 0;
+ }
+ return CallWindowProc(wndproc, hwnd, msg, wparam, lparam);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkpGetMS --
+ *
+ * Return a relative time in milliseconds. It doesn't matter
+ * when the epoch was.
+ *
+ * Results:
+ * Number of milliseconds.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+unsigned long
+TkpGetMS()
+{
+ return GetCurrentTime();
+}
diff --git a/tk/win/winMain.c b/tk/win/winMain.c
new file mode 100644
index 00000000000..af989d50948
--- /dev/null
+++ b/tk/win/winMain.c
@@ -0,0 +1,321 @@
+/*
+ * 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.
+ *
+ * RCS: @(#) $Id$
+ */
+
+#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.
+ *
+ * Results:
+ * Returns false if initialization fails, otherwise it never
+ * returns.
+ *
+ * Side effects:
+ * Just about anything, since from here we call arbitrary Tcl code.
+ *
+ *----------------------------------------------------------------------
+ */
+
+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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+Tcl_AppInit(interp)
+ Tcl_Interp *interp; /* Interpreter for application. */
+{
+ if (Tcl_Init(interp) == TCL_ERROR) {
+ goto error;
+ }
+ if (Tk_Init(interp) == TCL_ERROR) {
+ goto error;
+ }
+ 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 --
+ *
+ * Display a message and exit.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Exits the program.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+WishPanic TCL_VARARGS_DEF(char *,arg1)
+{
+ va_list argList;
+ char buf[1024];
+ char *format;
+
+ 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 --
+ *
+ * Parse the Windows command line string into argc/argv. Done here
+ * because we don't trust the builtin argument parser in crt0.
+ * Windows applications are responsible for breaking their command
+ * line into arguments.
+ *
+ * 2N backslashes + quote -> N backslashes + begin quoted string
+ * 2N + 1 backslashes + quote -> literal
+ * N backslashes + non-quote -> literal
+ * quote + quote in a quoted string -> single quote
+ * quote + quote not in quoted string -> empty string
+ * quote -> begin quoted string
+ *
+ * Results:
+ * Fills argcPtr with the number of arguments and argvPtr with the
+ * array of arguments.
+ *
+ * Side effects:
+ * Memory allocated.
+ *
+ *--------------------------------------------------------------------------
+ */
+
+static void
+setargv(argcPtr, argvPtr)
+ 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;
+ slashes = 0;
+ while (1) {
+ copy = 1;
+ while (*p == '\\') {
+ slashes++;
+ p++;
+ }
+ if (*p == '"') {
+ if ((slashes & 1) == 0) {
+ copy = 0;
+ if ((inquote) && (p[1] == '"')) {
+ p++;
+ copy = 1;
+ } else {
+ inquote = !inquote;
+ }
+ }
+ slashes >>= 1;
+ }
+
+ 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;
+}
+
diff --git a/tk/xlib/X11/X.h b/tk/xlib/X11/X.h
new file mode 100644
index 00000000000..55a31335488
--- /dev/null
+++ b/tk/xlib/X11/X.h
@@ -0,0 +1,669 @@
+/*
+ * $XConsortium: X.h,v 1.66 88/09/06 15:55:56 jim Exp $
+ */
+
+/* Definitions for the X window system likely to be used by applications */
+
+#ifndef X_H
+#define X_H
+
+/***********************************************************
+Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts,
+and the Massachusetts Institute of Technology, Cambridge, Massachusetts.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Digital or MIT not be
+used in advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL
+DIGITAL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+SOFTWARE.
+
+******************************************************************/
+#define X_PROTOCOL 11 /* current protocol version */
+#define X_PROTOCOL_REVISION 0 /* current minor version */
+
+#ifdef MAC_TCL
+# define Cursor XCursor
+# define Region XRegion
+#endif
+
+/* Resources */
+
+typedef unsigned long XID;
+
+typedef XID Window;
+typedef XID Drawable;
+typedef XID Font;
+typedef XID Pixmap;
+typedef XID Cursor;
+typedef XID Colormap;
+typedef XID GContext;
+typedef XID KeySym;
+
+typedef unsigned long Mask;
+
+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 */
+
+#define ParentRelative 1L /* background pixmap in CreateWindow
+ and ChangeWindowAttributes */
+
+#define CopyFromParent 0L /* border pixmap in CreateWindow
+ and ChangeWindowAttributes
+ special VisualID and special window
+ class passed to CreateWindow */
+
+#define PointerWindow 0L /* destination window in SendEvent */
+#define InputFocus 1L /* destination window in SendEvent */
+
+#define PointerRoot 1L /* focus window in SetInputFocus */
+
+#define AnyPropertyType 0L /* special Atom, passed to GetProperty */
+
+#define AnyKey 0L /* special Key Code, passed to GrabKey */
+
+#define AnyButton 0L /* special Button Code, passed to GrabButton */
+
+#define AllTemporary 0L /* special Resource ID passed to KillClient */
+
+#define CurrentTime 0L /* special Time */
+
+#define NoSymbol 0L /* special KeySym */
+
+/*****************************************************************
+ * EVENT DEFINITIONS
+ *****************************************************************/
+
+/* Input Event Masks. Used as event-mask window attribute and as arguments
+ to Grab requests. Not to be confused with event names. */
+
+#define NoEventMask 0L
+#define KeyPressMask (1L<<0)
+#define KeyReleaseMask (1L<<1)
+#define ButtonPressMask (1L<<2)
+#define ButtonReleaseMask (1L<<3)
+#define EnterWindowMask (1L<<4)
+#define LeaveWindowMask (1L<<5)
+#define PointerMotionMask (1L<<6)
+#define PointerMotionHintMask (1L<<7)
+#define Button1MotionMask (1L<<8)
+#define Button2MotionMask (1L<<9)
+#define Button3MotionMask (1L<<10)
+#define Button4MotionMask (1L<<11)
+#define Button5MotionMask (1L<<12)
+#define ButtonMotionMask (1L<<13)
+#define KeymapStateMask (1L<<14)
+#define ExposureMask (1L<<15)
+#define VisibilityChangeMask (1L<<16)
+#define StructureNotifyMask (1L<<17)
+#define ResizeRedirectMask (1L<<18)
+#define SubstructureNotifyMask (1L<<19)
+#define SubstructureRedirectMask (1L<<20)
+#define FocusChangeMask (1L<<21)
+#define PropertyChangeMask (1L<<22)
+#define ColormapChangeMask (1L<<23)
+#define OwnerGrabButtonMask (1L<<24)
+
+/* Event names. Used in "type" field in XEvent structures. Not to be
+confused with event masks above. They start from 2 because 0 and 1
+are reserved in the protocol for errors and replies. */
+
+#define KeyPress 2
+#define KeyRelease 3
+#define ButtonPress 4
+#define ButtonRelease 5
+#define MotionNotify 6
+#define EnterNotify 7
+#define LeaveNotify 8
+#define FocusIn 9
+#define FocusOut 10
+#define KeymapNotify 11
+#define Expose 12
+#define GraphicsExpose 13
+#define NoExpose 14
+#define VisibilityNotify 15
+#define CreateNotify 16
+#define DestroyNotify 17
+#define UnmapNotify 18
+#define MapNotify 19
+#define MapRequest 20
+#define ReparentNotify 21
+#define ConfigureNotify 22
+#define ConfigureRequest 23
+#define GravityNotify 24
+#define ResizeRequest 25
+#define CirculateNotify 26
+#define CirculateRequest 27
+#define PropertyNotify 28
+#define SelectionClear 29
+#define SelectionRequest 30
+#define SelectionNotify 31
+#define ColormapNotify 32
+#define ClientMessage 33
+#define MappingNotify 34
+#define LASTEvent 35 /* must be bigger than any event # */
+
+
+/* Key masks. Used as modifiers to GrabButton and GrabKey, results of QueryPointer,
+ state in various key-, mouse-, and button-related events. */
+
+#define ShiftMask (1<<0)
+#define LockMask (1<<1)
+#define ControlMask (1<<2)
+#define Mod1Mask (1<<3)
+#define Mod2Mask (1<<4)
+#define Mod3Mask (1<<5)
+#define Mod4Mask (1<<6)
+#define Mod5Mask (1<<7)
+
+/* modifier names. Used to build a SetModifierMapping request or
+ to read a GetModifierMapping request. These correspond to the
+ masks defined above. */
+#define ShiftMapIndex 0
+#define LockMapIndex 1
+#define ControlMapIndex 2
+#define Mod1MapIndex 3
+#define Mod2MapIndex 4
+#define Mod3MapIndex 5
+#define Mod4MapIndex 6
+#define Mod5MapIndex 7
+
+
+/* button masks. Used in same manner as Key masks above. Not to be confused
+ with button names below. */
+
+#define Button1Mask (1<<8)
+#define Button2Mask (1<<9)
+#define Button3Mask (1<<10)
+#define Button4Mask (1<<11)
+#define Button5Mask (1<<12)
+
+#define AnyModifier (1<<15) /* used in GrabButton, GrabKey */
+
+
+/* button names. Used as arguments to GrabButton and as detail in ButtonPress
+ and ButtonRelease events. Not to be confused with button masks above.
+ Note that 0 is already defined above as "AnyButton". */
+
+#define Button1 1
+#define Button2 2
+#define Button3 3
+#define Button4 4
+#define Button5 5
+
+/* Notify modes */
+
+#define NotifyNormal 0
+#define NotifyGrab 1
+#define NotifyUngrab 2
+#define NotifyWhileGrabbed 3
+
+#define NotifyHint 1 /* for MotionNotify events */
+
+/* Notify detail */
+
+#define NotifyAncestor 0
+#define NotifyVirtual 1
+#define NotifyInferior 2
+#define NotifyNonlinear 3
+#define NotifyNonlinearVirtual 4
+#define NotifyPointer 5
+#define NotifyPointerRoot 6
+#define NotifyDetailNone 7
+
+/* Visibility notify */
+
+#define VisibilityUnobscured 0
+#define VisibilityPartiallyObscured 1
+#define VisibilityFullyObscured 2
+
+/* Circulation request */
+
+#define PlaceOnTop 0
+#define PlaceOnBottom 1
+
+/* protocol families */
+
+#define FamilyInternet 0
+#define FamilyDECnet 1
+#define FamilyChaos 2
+
+/* Property notification */
+
+#define PropertyNewValue 0
+#define PropertyDelete 1
+
+/* Color Map notification */
+
+#define ColormapUninstalled 0
+#define ColormapInstalled 1
+
+/* GrabPointer, GrabButton, GrabKeyboard, GrabKey Modes */
+
+#define GrabModeSync 0
+#define GrabModeAsync 1
+
+/* GrabPointer, GrabKeyboard reply status */
+
+#define GrabSuccess 0
+#define AlreadyGrabbed 1
+#define GrabInvalidTime 2
+#define GrabNotViewable 3
+#define GrabFrozen 4
+
+/* AllowEvents modes */
+
+#define AsyncPointer 0
+#define SyncPointer 1
+#define ReplayPointer 2
+#define AsyncKeyboard 3
+#define SyncKeyboard 4
+#define ReplayKeyboard 5
+#define AsyncBoth 6
+#define SyncBoth 7
+
+/* Used in SetInputFocus, GetInputFocus */
+
+#define RevertToNone (int)None
+#define RevertToPointerRoot (int)PointerRoot
+#define RevertToParent 2
+
+/*****************************************************************
+ * ERROR CODES
+ *****************************************************************/
+
+#define Success 0 /* everything's okay */
+#define BadRequest 1 /* bad request code */
+#define BadValue 2 /* int parameter out of range */
+#define BadWindow 3 /* parameter not a Window */
+#define BadPixmap 4 /* parameter not a Pixmap */
+#define BadAtom 5 /* parameter not an Atom */
+#define BadCursor 6 /* parameter not a Cursor */
+#define BadFont 7 /* parameter not a Font */
+#define BadMatch 8 /* parameter mismatch */
+#define BadDrawable 9 /* parameter not a Pixmap or Window */
+#define BadAccess 10 /* depending on context:
+ - key/button already grabbed
+ - attempt to free an illegal
+ cmap entry
+ - attempt to store into a read-only
+ color map entry.
+ - attempt to modify the access control
+ list from other than the local host.
+ */
+#define BadAlloc 11 /* insufficient resources */
+#define BadColor 12 /* no such colormap */
+#define BadGC 13 /* parameter not a GC */
+#define BadIDChoice 14 /* choice not in range or already used */
+#define BadName 15 /* font or color name doesn't exist */
+#define BadLength 16 /* Request length incorrect */
+#define BadImplementation 17 /* server is defective */
+
+#define FirstExtensionError 128
+#define LastExtensionError 255
+
+/*****************************************************************
+ * WINDOW DEFINITIONS
+ *****************************************************************/
+
+/* Window classes used by CreateWindow */
+/* Note that CopyFromParent is already defined as 0 above */
+
+#define InputOutput 1
+#define InputOnly 2
+
+/* Window attributes for CreateWindow and ChangeWindowAttributes */
+
+#define CWBackPixmap (1L<<0)
+#define CWBackPixel (1L<<1)
+#define CWBorderPixmap (1L<<2)
+#define CWBorderPixel (1L<<3)
+#define CWBitGravity (1L<<4)
+#define CWWinGravity (1L<<5)
+#define CWBackingStore (1L<<6)
+#define CWBackingPlanes (1L<<7)
+#define CWBackingPixel (1L<<8)
+#define CWOverrideRedirect (1L<<9)
+#define CWSaveUnder (1L<<10)
+#define CWEventMask (1L<<11)
+#define CWDontPropagate (1L<<12)
+#define CWColormap (1L<<13)
+#define CWCursor (1L<<14)
+
+/* ConfigureWindow structure */
+
+#define CWX (1<<0)
+#define CWY (1<<1)
+#define CWWidth (1<<2)
+#define CWHeight (1<<3)
+#define CWBorderWidth (1<<4)
+#define CWSibling (1<<5)
+#define CWStackMode (1<<6)
+
+
+/* Bit Gravity */
+
+#define ForgetGravity 0
+#define NorthWestGravity 1
+#define NorthGravity 2
+#define NorthEastGravity 3
+#define WestGravity 4
+#define CenterGravity 5
+#define EastGravity 6
+#define SouthWestGravity 7
+#define SouthGravity 8
+#define SouthEastGravity 9
+#define StaticGravity 10
+
+/* Window gravity + bit gravity above */
+
+#define UnmapGravity 0
+
+/* Used in CreateWindow for backing-store hint */
+
+#define NotUseful 0
+#define WhenMapped 1
+#define Always 2
+
+/* Used in GetWindowAttributes reply */
+
+#define IsUnmapped 0
+#define IsUnviewable 1
+#define IsViewable 2
+
+/* Used in ChangeSaveSet */
+
+#define SetModeInsert 0
+#define SetModeDelete 1
+
+/* Used in ChangeCloseDownMode */
+
+#define DestroyAll 0
+#define RetainPermanent 1
+#define RetainTemporary 2
+
+/* Window stacking method (in configureWindow) */
+
+#define Above 0
+#define Below 1
+#define TopIf 2
+#define BottomIf 3
+#define Opposite 4
+
+/* Circulation direction */
+
+#define RaiseLowest 0
+#define LowerHighest 1
+
+/* Property modes */
+
+#define PropModeReplace 0
+#define PropModePrepend 1
+#define PropModeAppend 2
+
+/*****************************************************************
+ * GRAPHICS DEFINITIONS
+ *****************************************************************/
+
+/* graphics functions, as in GC.alu */
+
+#define GXclear 0x0 /* 0 */
+#define GXand 0x1 /* src AND dst */
+#define GXandReverse 0x2 /* src AND NOT dst */
+#define GXcopy 0x3 /* src */
+#define GXandInverted 0x4 /* NOT src AND dst */
+#define GXnoop 0x5 /* dst */
+#define GXxor 0x6 /* src XOR dst */
+#define GXor 0x7 /* src OR dst */
+#define GXnor 0x8 /* NOT src AND NOT dst */
+#define GXequiv 0x9 /* NOT src XOR dst */
+#define GXinvert 0xa /* NOT dst */
+#define GXorReverse 0xb /* src OR NOT dst */
+#define GXcopyInverted 0xc /* NOT src */
+#define GXorInverted 0xd /* NOT src OR dst */
+#define GXnand 0xe /* NOT src OR NOT dst */
+#define GXset 0xf /* 1 */
+
+/* LineStyle */
+
+#define LineSolid 0
+#define LineOnOffDash 1
+#define LineDoubleDash 2
+
+/* capStyle */
+
+#define CapNotLast 0
+#define CapButt 1
+#define CapRound 2
+#define CapProjecting 3
+
+/* joinStyle */
+
+#define JoinMiter 0
+#define JoinRound 1
+#define JoinBevel 2
+
+/* fillStyle */
+
+#define FillSolid 0
+#define FillTiled 1
+#define FillStippled 2
+#define FillOpaqueStippled 3
+
+/* fillRule */
+
+#define EvenOddRule 0
+#define WindingRule 1
+
+/* subwindow mode */
+
+#define ClipByChildren 0
+#define IncludeInferiors 1
+
+/* SetClipRectangles ordering */
+
+#define Unsorted 0
+#define YSorted 1
+#define YXSorted 2
+#define YXBanded 3
+
+/* CoordinateMode for drawing routines */
+
+#define CoordModeOrigin 0 /* relative to the origin */
+#define CoordModePrevious 1 /* relative to previous point */
+
+/* Polygon shapes */
+
+#define Complex 0 /* paths may intersect */
+#define Nonconvex 1 /* no paths intersect, but not convex */
+#define Convex 2 /* wholly convex */
+
+/* Arc modes for PolyFillArc */
+
+#define ArcChord 0 /* join endpoints of arc */
+#define ArcPieSlice 1 /* join endpoints to center of arc */
+
+/* GC components: masks used in CreateGC, CopyGC, ChangeGC, OR'ed into
+ GC.stateChanges */
+
+#define GCFunction (1L<<0)
+#define GCPlaneMask (1L<<1)
+#define GCForeground (1L<<2)
+#define GCBackground (1L<<3)
+#define GCLineWidth (1L<<4)
+#define GCLineStyle (1L<<5)
+#define GCCapStyle (1L<<6)
+#define GCJoinStyle (1L<<7)
+#define GCFillStyle (1L<<8)
+#define GCFillRule (1L<<9)
+#define GCTile (1L<<10)
+#define GCStipple (1L<<11)
+#define GCTileStipXOrigin (1L<<12)
+#define GCTileStipYOrigin (1L<<13)
+#define GCFont (1L<<14)
+#define GCSubwindowMode (1L<<15)
+#define GCGraphicsExposures (1L<<16)
+#define GCClipXOrigin (1L<<17)
+#define GCClipYOrigin (1L<<18)
+#define GCClipMask (1L<<19)
+#define GCDashOffset (1L<<20)
+#define GCDashList (1L<<21)
+#define GCArcMode (1L<<22)
+
+#define GCLastBit 22
+/*****************************************************************
+ * FONTS
+ *****************************************************************/
+
+/* used in QueryFont -- draw direction */
+
+#define FontLeftToRight 0
+#define FontRightToLeft 1
+
+#define FontChange 255
+
+/*****************************************************************
+ * IMAGING
+ *****************************************************************/
+
+/* ImageFormat -- PutImage, GetImage */
+
+#define XYBitmap 0 /* depth 1, XYFormat */
+#define XYPixmap 1 /* depth == drawable depth */
+#define ZPixmap 2 /* depth == drawable depth */
+
+/*****************************************************************
+ * COLOR MAP STUFF
+ *****************************************************************/
+
+/* For CreateColormap */
+
+#define AllocNone 0 /* create map with no entries */
+#define AllocAll 1 /* allocate entire map writeable */
+
+
+/* Flags used in StoreNamedColor, StoreColors */
+
+#define DoRed (1<<0)
+#define DoGreen (1<<1)
+#define DoBlue (1<<2)
+
+/*****************************************************************
+ * CURSOR STUFF
+ *****************************************************************/
+
+/* QueryBestSize Class */
+
+#define CursorShape 0 /* largest size that can be displayed */
+#define TileShape 1 /* size tiled fastest */
+#define StippleShape 2 /* size stippled fastest */
+
+/*****************************************************************
+ * KEYBOARD/POINTER STUFF
+ *****************************************************************/
+
+#define AutoRepeatModeOff 0
+#define AutoRepeatModeOn 1
+#define AutoRepeatModeDefault 2
+
+#define LedModeOff 0
+#define LedModeOn 1
+
+/* masks for ChangeKeyboardControl */
+
+#define KBKeyClickPercent (1L<<0)
+#define KBBellPercent (1L<<1)
+#define KBBellPitch (1L<<2)
+#define KBBellDuration (1L<<3)
+#define KBLed (1L<<4)
+#define KBLedMode (1L<<5)
+#define KBKey (1L<<6)
+#define KBAutoRepeatMode (1L<<7)
+
+#define MappingSuccess 0
+#define MappingBusy 1
+#define MappingFailed 2
+
+#define MappingModifier 0
+#define MappingKeyboard 1
+#define MappingPointer 2
+
+/*****************************************************************
+ * SCREEN SAVER STUFF
+ *****************************************************************/
+
+#define DontPreferBlanking 0
+#define PreferBlanking 1
+#define DefaultBlanking 2
+
+#define DisableScreenSaver 0
+#define DisableScreenInterval 0
+
+#define DontAllowExposures 0
+#define AllowExposures 1
+#define DefaultExposures 2
+
+/* for ForceScreenSaver */
+
+#define ScreenSaverReset 0
+#define ScreenSaverActive 1
+
+/*****************************************************************
+ * HOSTS AND CONNECTIONS
+ *****************************************************************/
+
+/* for ChangeHosts */
+
+#define HostInsert 0
+#define HostDelete 1
+
+/* for ChangeAccessControl */
+
+#define EnableAccess 1
+#define DisableAccess 0
+
+/* Display classes used in opening the connection
+ * Note that the statically allocated ones are even numbered and the
+ * dynamically changeable ones are odd numbered */
+
+#define StaticGray 0
+#define GrayScale 1
+#define StaticColor 2
+#define PseudoColor 3
+#define TrueColor 4
+#define DirectColor 5
+
+
+/* Byte order used in imageByteOrder and bitmapBitOrder */
+
+#define LSBFirst 0
+#define MSBFirst 1
+
+#ifdef MAC_TCL
+# undef Cursor
+# undef Region
+#endif
+
+#endif /* X_H */
diff --git a/tk/xlib/X11/Xatom.h b/tk/xlib/X11/Xatom.h
new file mode 100644
index 00000000000..485a4236db8
--- /dev/null
+++ b/tk/xlib/X11/Xatom.h
@@ -0,0 +1,79 @@
+#ifndef XATOM_H
+#define XATOM_H 1
+
+/* THIS IS A GENERATED FILE
+ *
+ * Do not change! Changing this file implies a protocol change!
+ */
+
+#define XA_PRIMARY ((Atom) 1)
+#define XA_SECONDARY ((Atom) 2)
+#define XA_ARC ((Atom) 3)
+#define XA_ATOM ((Atom) 4)
+#define XA_BITMAP ((Atom) 5)
+#define XA_CARDINAL ((Atom) 6)
+#define XA_COLORMAP ((Atom) 7)
+#define XA_CURSOR ((Atom) 8)
+#define XA_CUT_BUFFER0 ((Atom) 9)
+#define XA_CUT_BUFFER1 ((Atom) 10)
+#define XA_CUT_BUFFER2 ((Atom) 11)
+#define XA_CUT_BUFFER3 ((Atom) 12)
+#define XA_CUT_BUFFER4 ((Atom) 13)
+#define XA_CUT_BUFFER5 ((Atom) 14)
+#define XA_CUT_BUFFER6 ((Atom) 15)
+#define XA_CUT_BUFFER7 ((Atom) 16)
+#define XA_DRAWABLE ((Atom) 17)
+#define XA_FONT ((Atom) 18)
+#define XA_INTEGER ((Atom) 19)
+#define XA_PIXMAP ((Atom) 20)
+#define XA_POINT ((Atom) 21)
+#define XA_RECTANGLE ((Atom) 22)
+#define XA_RESOURCE_MANAGER ((Atom) 23)
+#define XA_RGB_COLOR_MAP ((Atom) 24)
+#define XA_RGB_BEST_MAP ((Atom) 25)
+#define XA_RGB_BLUE_MAP ((Atom) 26)
+#define XA_RGB_DEFAULT_MAP ((Atom) 27)
+#define XA_RGB_GRAY_MAP ((Atom) 28)
+#define XA_RGB_GREEN_MAP ((Atom) 29)
+#define XA_RGB_RED_MAP ((Atom) 30)
+#define XA_STRING ((Atom) 31)
+#define XA_VISUALID ((Atom) 32)
+#define XA_WINDOW ((Atom) 33)
+#define XA_WM_COMMAND ((Atom) 34)
+#define XA_WM_HINTS ((Atom) 35)
+#define XA_WM_CLIENT_MACHINE ((Atom) 36)
+#define XA_WM_ICON_NAME ((Atom) 37)
+#define XA_WM_ICON_SIZE ((Atom) 38)
+#define XA_WM_NAME ((Atom) 39)
+#define XA_WM_NORMAL_HINTS ((Atom) 40)
+#define XA_WM_SIZE_HINTS ((Atom) 41)
+#define XA_WM_ZOOM_HINTS ((Atom) 42)
+#define XA_MIN_SPACE ((Atom) 43)
+#define XA_NORM_SPACE ((Atom) 44)
+#define XA_MAX_SPACE ((Atom) 45)
+#define XA_END_SPACE ((Atom) 46)
+#define XA_SUPERSCRIPT_X ((Atom) 47)
+#define XA_SUPERSCRIPT_Y ((Atom) 48)
+#define XA_SUBSCRIPT_X ((Atom) 49)
+#define XA_SUBSCRIPT_Y ((Atom) 50)
+#define XA_UNDERLINE_POSITION ((Atom) 51)
+#define XA_UNDERLINE_THICKNESS ((Atom) 52)
+#define XA_STRIKEOUT_ASCENT ((Atom) 53)
+#define XA_STRIKEOUT_DESCENT ((Atom) 54)
+#define XA_ITALIC_ANGLE ((Atom) 55)
+#define XA_X_HEIGHT ((Atom) 56)
+#define XA_QUAD_WIDTH ((Atom) 57)
+#define XA_WEIGHT ((Atom) 58)
+#define XA_POINT_SIZE ((Atom) 59)
+#define XA_RESOLUTION ((Atom) 60)
+#define XA_COPYRIGHT ((Atom) 61)
+#define XA_NOTICE ((Atom) 62)
+#define XA_FONT_NAME ((Atom) 63)
+#define XA_FAMILY_NAME ((Atom) 64)
+#define XA_FULL_NAME ((Atom) 65)
+#define XA_CAP_HEIGHT ((Atom) 66)
+#define XA_WM_CLASS ((Atom) 67)
+#define XA_WM_TRANSIENT_FOR ((Atom) 68)
+
+#define XA_LAST_PREDEFINED ((Atom) 68)
+#endif /* XATOM_H */
diff --git a/tk/xlib/X11/Xfuncproto.h b/tk/xlib/X11/Xfuncproto.h
new file mode 100644
index 00000000000..a59379b3b65
--- /dev/null
+++ b/tk/xlib/X11/Xfuncproto.h
@@ -0,0 +1,60 @@
+/* $XConsortium: Xfuncproto.h,v 1.7 91/05/13 20:49:21 rws Exp $ */
+/*
+ * Copyright 1989, 1991 by the Massachusetts Institute of Technology
+ *
+ * Permission to use, copy, modify, and distribute this software and its
+ * documentation for any purpose and without fee is hereby granted, provided
+ * that the above copyright notice appear in all copies and that both that
+ * copyright notice and this permission notice appear in supporting
+ * documentation, and that the name of M.I.T. not be used in advertising
+ * or publicity pertaining to distribution of the software without specific,
+ * written prior permission. M.I.T. makes no representations about the
+ * suitability of this software for any purpose. It is provided "as is"
+ * without express or implied warranty.
+ *
+ */
+
+/* Definitions to make function prototypes manageable */
+
+#ifndef _XFUNCPROTO_H_
+#define _XFUNCPROTO_H_
+
+#ifndef NeedFunctionPrototypes
+#define NeedFunctionPrototypes 1
+#endif /* NeedFunctionPrototypes */
+
+#ifndef NeedVarargsPrototypes
+#define NeedVarargsPrototypes 0
+#endif /* NeedVarargsPrototypes */
+
+#if NeedFunctionPrototypes
+
+#ifndef NeedNestedPrototypes
+#define NeedNestedPrototypes 1
+#endif /* NeedNestedPrototypes */
+
+#ifndef _Xconst
+#define _Xconst const
+#endif /* _Xconst */
+
+#ifndef NeedWidePrototypes
+#ifdef NARROWPROTO
+#define NeedWidePrototypes 0
+#else
+#define NeedWidePrototypes 1 /* default to make interropt. easier */
+#endif
+#endif /* NeedWidePrototypes */
+
+#endif /* NeedFunctionPrototypes */
+
+#ifdef __cplusplus
+#define _XFUNCPROTOBEGIN extern "C" {
+#define _XFUNCPROTOEND }
+#endif
+
+#ifndef _XFUNCPROTOBEGIN
+#define _XFUNCPROTOBEGIN
+#define _XFUNCPROTOEND
+#endif /* _XFUNCPROTOBEGIN */
+
+#endif /* _XFUNCPROTO_H_ */
diff --git a/tk/xlib/X11/Xlib.h b/tk/xlib/X11/Xlib.h
new file mode 100644
index 00000000000..fdf8c2fef99
--- /dev/null
+++ b/tk/xlib/X11/Xlib.h
@@ -0,0 +1,4317 @@
+/* $XConsortium: Xlib.h,v 11.221 93/07/02 14:13:28 gildea Exp $ */
+/*
+ * Copyright 1985, 1986, 1987, 1991 by the Massachusetts Institute of Technology
+ *
+ * Permission to use, copy, modify, and distribute this software and its
+ * documentation for any purpose and without fee is hereby granted, provided
+ * that the above copyright notice appear in all copies and that both that
+ * copyright notice and this permission notice appear in supporting
+ * documentation, and that the name of M.I.T. not be used in advertising
+ * or publicity pertaining to distribution of the software without specific,
+ * written prior permission. M.I.T. makes no representations about the
+ * suitability of this software for any purpose. It is provided "as is"
+ * without express or implied warranty.
+ *
+ * X Window System is a Trademark of MIT.
+ *
+ */
+
+
+/*
+ * Xlib.h - Header definition and support file for the C subroutine
+ * interface library (Xlib) to the X Window System Protocol (V11).
+ * Structures and symbols starting with "_" are private to the library.
+ */
+#ifndef _XLIB_H_
+#define _XLIB_H_
+
+#define XlibSpecificationRelease 5
+
+#ifdef MAC_TCL
+# include <X.h>
+# define Cursor XCursor
+# define Region XRegion
+#else
+# include <X11/X.h>
+#endif
+
+/* applications should not depend on these two headers being included! */
+#ifdef MAC_TCL
+#include <Xfuncproto.h>
+#else
+#include <X11/Xfuncproto.h>
+#endif
+
+#ifndef X_WCHAR
+#ifdef X_NOT_STDC_ENV
+#define X_WCHAR
+#endif
+#endif
+
+#ifndef X_WCHAR
+#include <stddef.h>
+#else
+/* replace this with #include or typedef appropriate for your system */
+typedef unsigned long wchar_t;
+#endif
+
+typedef char *XPointer;
+
+#define Bool int
+/* The Status define conflicts with some Cygwin headers. So on
+ Windows we use a typedef instead. */
+#if defined(__WIN32__) || defined(_WIN32)
+typedef int Status;
+#else
+#define Status int
+#endif
+#define True 1
+#define False 0
+
+#define QueuedAlready 0
+#define QueuedAfterReading 1
+#define QueuedAfterFlush 2
+
+#define ConnectionNumber(dpy) ((dpy)->fd)
+#define RootWindow(dpy, scr) (((dpy)->screens[(scr)]).root)
+#define DefaultScreen(dpy) ((dpy)->default_screen)
+#define DefaultRootWindow(dpy) (((dpy)->screens[(dpy)->default_screen]).root)
+#define DefaultVisual(dpy, scr) (((dpy)->screens[(scr)]).root_visual)
+#define DefaultGC(dpy, scr) (((dpy)->screens[(scr)]).default_gc)
+#define BlackPixel(dpy, scr) (((dpy)->screens[(scr)]).black_pixel)
+#define WhitePixel(dpy, scr) (((dpy)->screens[(scr)]).white_pixel)
+#define AllPlanes ((unsigned long)~0L)
+#define QLength(dpy) ((dpy)->qlen)
+#define DisplayWidth(dpy, scr) (((dpy)->screens[(scr)]).width)
+#define DisplayHeight(dpy, scr) (((dpy)->screens[(scr)]).height)
+#define DisplayWidthMM(dpy, scr)(((dpy)->screens[(scr)]).mwidth)
+#define DisplayHeightMM(dpy, scr)(((dpy)->screens[(scr)]).mheight)
+#define DisplayPlanes(dpy, scr) (((dpy)->screens[(scr)]).root_depth)
+#define DisplayCells(dpy, scr) (DefaultVisual((dpy), (scr))->map_entries)
+#define ScreenCount(dpy) ((dpy)->nscreens)
+#define ServerVendor(dpy) ((dpy)->vendor)
+#define ProtocolVersion(dpy) ((dpy)->proto_major_version)
+#define ProtocolRevision(dpy) ((dpy)->proto_minor_version)
+#define VendorRelease(dpy) ((dpy)->release)
+#define DisplayString(dpy) ((dpy)->display_name)
+#define DefaultDepth(dpy, scr) (((dpy)->screens[(scr)]).root_depth)
+#define DefaultColormap(dpy, scr)(((dpy)->screens[(scr)]).cmap)
+#define BitmapUnit(dpy) ((dpy)->bitmap_unit)
+#define BitmapBitOrder(dpy) ((dpy)->bitmap_bit_order)
+#define BitmapPad(dpy) ((dpy)->bitmap_pad)
+#define ImageByteOrder(dpy) ((dpy)->byte_order)
+#define NextRequest(dpy) ((dpy)->request + 1)
+#define LastKnownRequestProcessed(dpy) ((dpy)->request)
+
+/* macros for screen oriented applications (toolkit) */
+#define ScreenOfDisplay(dpy, scr)(&((dpy)->screens[(scr)]))
+#define DefaultScreenOfDisplay(dpy) (&((dpy)->screens[(dpy)->default_screen]))
+#define DisplayOfScreen(s) ((s)->display)
+#define RootWindowOfScreen(s) ((s)->root)
+#define BlackPixelOfScreen(s) ((s)->black_pixel)
+#define WhitePixelOfScreen(s) ((s)->white_pixel)
+#define DefaultColormapOfScreen(s)((s)->cmap)
+#define DefaultDepthOfScreen(s) ((s)->root_depth)
+#define DefaultGCOfScreen(s) ((s)->default_gc)
+#define DefaultVisualOfScreen(s)((s)->root_visual)
+#define WidthOfScreen(s) ((s)->width)
+#define HeightOfScreen(s) ((s)->height)
+#define WidthMMOfScreen(s) ((s)->mwidth)
+#define HeightMMOfScreen(s) ((s)->mheight)
+#define PlanesOfScreen(s) ((s)->root_depth)
+#define CellsOfScreen(s) (DefaultVisualOfScreen((s))->map_entries)
+#define MinCmapsOfScreen(s) ((s)->min_maps)
+#define MaxCmapsOfScreen(s) ((s)->max_maps)
+#define DoesSaveUnders(s) ((s)->save_unders)
+#define DoesBackingStore(s) ((s)->backing_store)
+#define EventMaskOfScreen(s) ((s)->root_input_mask)
+
+/*
+ * Extensions need a way to hang private data on some structures.
+ */
+typedef struct _XExtData {
+ int number; /* number returned by XRegisterExtension */
+ struct _XExtData *next; /* next item on list of data for structure */
+ int (*free_private)(); /* called to free private storage */
+ XPointer private_data; /* data private to this extension. */
+} XExtData;
+
+/*
+ * This file contains structures used by the extension mechanism.
+ */
+typedef struct { /* public to extension, cannot be changed */
+ int extension; /* extension number */
+ int major_opcode; /* major op-code assigned by server */
+ int first_event; /* first event number for the extension */
+ int first_error; /* first error number for the extension */
+} XExtCodes;
+
+/*
+ * Data structure for retrieving info about pixmap formats.
+ */
+
+typedef struct {
+ int depth;
+ int bits_per_pixel;
+ int scanline_pad;
+} XPixmapFormatValues;
+
+
+/*
+ * Data structure for setting graphics context.
+ */
+typedef struct {
+ int function; /* logical operation */
+ unsigned long plane_mask;/* plane mask */
+ unsigned long foreground;/* foreground pixel */
+ unsigned long background;/* background pixel */
+ int line_width; /* line width */
+ int line_style; /* LineSolid, LineOnOffDash, LineDoubleDash */
+ int cap_style; /* CapNotLast, CapButt,
+ CapRound, CapProjecting */
+ int join_style; /* JoinMiter, JoinRound, JoinBevel */
+ int fill_style; /* FillSolid, FillTiled,
+ FillStippled, FillOpaeueStippled */
+ int fill_rule; /* EvenOddRule, WindingRule */
+ int arc_mode; /* ArcChord, ArcPieSlice */
+ Pixmap tile; /* tile pixmap for tiling operations */
+ Pixmap stipple; /* stipple 1 plane pixmap for stipping */
+ int ts_x_origin; /* offset for tile or stipple operations */
+ int ts_y_origin;
+ Font font; /* default text font for text operations */
+ int subwindow_mode; /* ClipByChildren, IncludeInferiors */
+ Bool graphics_exposures;/* boolean, should exposures be generated */
+ int clip_x_origin; /* origin for clipping */
+ int clip_y_origin;
+ Pixmap clip_mask; /* bitmap clipping; other calls for rects */
+ int dash_offset; /* patterned/dashed line information */
+ char dashes;
+} XGCValues;
+
+/*
+ * Graphics context. The contents of this structure are implementation
+ * dependent. A GC should be treated as opaque by application code.
+ */
+
+typedef XGCValues *GC;
+
+/*
+ * Visual structure; contains information about colormapping possible.
+ */
+typedef struct {
+ XExtData *ext_data; /* hook for extension to hang data */
+ VisualID visualid; /* visual id of this visual */
+#if defined(__cplusplus) || defined(c_plusplus)
+ int c_class; /* C++ class of screen (monochrome, etc.) */
+#else
+ int class; /* class of screen (monochrome, etc.) */
+#endif
+ unsigned long red_mask, green_mask, blue_mask; /* mask values */
+ int bits_per_rgb; /* log base 2 of distinct color values */
+ int map_entries; /* color map entries */
+} Visual;
+
+/*
+ * Depth structure; contains information for each possible depth.
+ */
+typedef struct {
+ int depth; /* this depth (Z) of the depth */
+ int nvisuals; /* number of Visual types at this depth */
+ Visual *visuals; /* list of visuals possible at this depth */
+} Depth;
+
+/*
+ * Information about the screen. The contents of this structure are
+ * implementation dependent. A Screen should be treated as opaque
+ * by application code.
+ */
+typedef struct {
+ XExtData *ext_data; /* hook for extension to hang data */
+ struct _XDisplay *display;/* back pointer to display structure */
+ Window root; /* Root window id. */
+ int width, height; /* width and height of screen */
+ int mwidth, mheight; /* width and height of in millimeters */
+ int ndepths; /* number of depths possible */
+ Depth *depths; /* list of allowable depths on the screen */
+ int root_depth; /* bits per pixel */
+ Visual *root_visual; /* root visual */
+ GC default_gc; /* GC for the root root visual */
+ Colormap cmap; /* default color map */
+ unsigned long white_pixel;
+ unsigned long black_pixel; /* White and Black pixel values */
+ int max_maps, min_maps; /* max and min color maps */
+ int backing_store; /* Never, WhenMapped, Always */
+ Bool save_unders;
+ long root_input_mask; /* initial root input mask */
+} Screen;
+
+/*
+ * Format structure; describes ZFormat data the screen will understand.
+ */
+typedef struct {
+ XExtData *ext_data; /* hook for extension to hang data */
+ int depth; /* depth of this image format */
+ int bits_per_pixel; /* bits/pixel at this depth */
+ int scanline_pad; /* scanline must padded to this multiple */
+} ScreenFormat;
+
+/*
+ * Data structure for setting window attributes.
+ */
+typedef struct {
+ Pixmap background_pixmap; /* background or None or ParentRelative */
+ unsigned long background_pixel; /* background pixel */
+ Pixmap border_pixmap; /* border of the window */
+ unsigned long border_pixel; /* border pixel value */
+ int bit_gravity; /* one of bit gravity values */
+ int win_gravity; /* one of the window gravity values */
+ int backing_store; /* NotUseful, WhenMapped, Always */
+ unsigned long backing_planes;/* planes to be preseved if possible */
+ unsigned long backing_pixel;/* value to use in restoring planes */
+ Bool save_under; /* should bits under be saved? (popups) */
+ long event_mask; /* set of events that should be saved */
+ long do_not_propagate_mask; /* set of events that should not propagate */
+ Bool override_redirect; /* boolean value for override-redirect */
+ Colormap colormap; /* color map to be associated with window */
+ Cursor cursor; /* cursor to be displayed (or None) */
+} XSetWindowAttributes;
+
+typedef struct {
+ int x, y; /* location of window */
+ int width, height; /* width and height of window */
+ int border_width; /* border width of window */
+ int depth; /* depth of window */
+ Visual *visual; /* the associated visual structure */
+ Window root; /* root of screen containing window */
+#if defined(__cplusplus) || defined(c_plusplus)
+ int c_class; /* C++ InputOutput, InputOnly*/
+#else
+ int class; /* InputOutput, InputOnly*/
+#endif
+ int bit_gravity; /* one of bit gravity values */
+ int win_gravity; /* one of the window gravity values */
+ int backing_store; /* NotUseful, WhenMapped, Always */
+ unsigned long backing_planes;/* planes to be preserved if possible */
+ unsigned long backing_pixel;/* value to be used when restoring planes */
+ Bool save_under; /* boolean, should bits under be saved? */
+ Colormap colormap; /* color map to be associated with window */
+ Bool map_installed; /* boolean, is color map currently installed*/
+ int map_state; /* IsUnmapped, IsUnviewable, IsViewable */
+ long all_event_masks; /* set of events all people have interest in*/
+ long your_event_mask; /* my event mask */
+ long do_not_propagate_mask; /* set of events that should not propagate */
+ Bool override_redirect; /* boolean value for override-redirect */
+ Screen *screen; /* back pointer to correct screen */
+} XWindowAttributes;
+
+/*
+ * Data structure for host setting; getting routines.
+ *
+ */
+
+typedef struct {
+ int family; /* for example FamilyInternet */
+ int length; /* length of address, in bytes */
+ char *address; /* pointer to where to find the bytes */
+} XHostAddress;
+
+/*
+ * Data structure for "image" data, used by image manipulation routines.
+ */
+typedef struct _XImage {
+ int width, height; /* size of image */
+ int xoffset; /* number of pixels offset in X direction */
+ int format; /* XYBitmap, XYPixmap, ZPixmap */
+ char *data; /* pointer to image data */
+ int byte_order; /* data byte order, LSBFirst, MSBFirst */
+ int bitmap_unit; /* quant. of scanline 8, 16, 32 */
+ int bitmap_bit_order; /* LSBFirst, MSBFirst */
+ int bitmap_pad; /* 8, 16, 32 either XY or ZPixmap */
+ int depth; /* depth of image */
+ int bytes_per_line; /* accelarator to next line */
+ int bits_per_pixel; /* bits per pixel (ZPixmap) */
+ unsigned long red_mask; /* bits in z arrangment */
+ unsigned long green_mask;
+ unsigned long blue_mask;
+ XPointer obdata; /* hook for the object routines to hang on */
+ struct funcs { /* image manipulation routines */
+ struct _XImage *(*create_image)();
+#if NeedFunctionPrototypes
+ int (*destroy_image) (struct _XImage *);
+ unsigned long (*get_pixel) (struct _XImage *, int, int);
+ int (*put_pixel) (struct _XImage *, int, int, unsigned long);
+ struct _XImage *(*sub_image)(struct _XImage *, int, int, unsigned int, unsigned int);
+ int (*add_pixel) (struct _XImage *, long);
+#else
+ int (*destroy_image)();
+ unsigned long (*get_pixel)();
+ int (*put_pixel)();
+ struct _XImage *(*sub_image)();
+ int (*add_pixel)();
+#endif
+ } f;
+} XImage;
+
+/*
+ * Data structure for XReconfigureWindow
+ */
+typedef struct {
+ int x, y;
+ int width, height;
+ int border_width;
+ Window sibling;
+ int stack_mode;
+} XWindowChanges;
+
+/*
+ * Data structure used by color operations
+ */
+typedef struct {
+ unsigned long pixel;
+ unsigned short red, green, blue;
+ char flags; /* do_red, do_green, do_blue */
+ char pad;
+} XColor;
+
+/*
+ * Data structures for graphics operations. On most machines, these are
+ * congruent with the wire protocol structures, so reformatting the data
+ * can be avoided on these architectures.
+ */
+typedef struct {
+ short x1, y1, x2, y2;
+} XSegment;
+
+typedef struct {
+ short x, y;
+} XPoint;
+
+typedef struct {
+ short x, y;
+ unsigned short width, height;
+} XRectangle;
+
+typedef struct {
+ short x, y;
+ unsigned short width, height;
+ short angle1, angle2;
+} XArc;
+
+
+/* Data structure for XChangeKeyboardControl */
+
+typedef struct {
+ int key_click_percent;
+ int bell_percent;
+ int bell_pitch;
+ int bell_duration;
+ int led;
+ int led_mode;
+ int key;
+ int auto_repeat_mode; /* On, Off, Default */
+} XKeyboardControl;
+
+/* Data structure for XGetKeyboardControl */
+
+typedef struct {
+ int key_click_percent;
+ int bell_percent;
+ unsigned int bell_pitch, bell_duration;
+ unsigned long led_mask;
+ int global_auto_repeat;
+ char auto_repeats[32];
+} XKeyboardState;
+
+/* Data structure for XGetMotionEvents. */
+
+typedef struct {
+ Time time;
+ short x, y;
+} XTimeCoord;
+
+/* Data structure for X{Set,Get}ModifierMapping */
+
+typedef struct {
+ int max_keypermod; /* The server's max # of keys per modifier */
+ KeyCode *modifiermap; /* An 8 by max_keypermod array of modifiers */
+} XModifierKeymap;
+
+
+/*
+ * Display datatype maintaining display specific data.
+ * The contents of this structure are implementation dependent.
+ * A Display should be treated as opaque by application code.
+ */
+typedef struct _XDisplay {
+ XExtData *ext_data; /* hook for extension to hang data */
+ struct _XFreeFuncs *free_funcs; /* internal free functions */
+ int fd; /* Network socket. */
+ int conn_checker; /* ugly thing used by _XEventsQueued */
+ int proto_major_version;/* maj. version of server's X protocol */
+ int proto_minor_version;/* minor version of servers X protocol */
+ char *vendor; /* vendor of the server hardware */
+ XID resource_base; /* resource ID base */
+ XID resource_mask; /* resource ID mask bits */
+ XID resource_id; /* allocator current ID */
+ int resource_shift; /* allocator shift to correct bits */
+ XID (*resource_alloc)(); /* allocator function */
+ int byte_order; /* screen byte order, LSBFirst, MSBFirst */
+ int bitmap_unit; /* padding and data requirements */
+ int bitmap_pad; /* padding requirements on bitmaps */
+ int bitmap_bit_order; /* LeastSignificant or MostSignificant */
+ int nformats; /* number of pixmap formats in list */
+ ScreenFormat *pixmap_format; /* pixmap format list */
+ int vnumber; /* Xlib's X protocol version number. */
+ int release; /* release of the server */
+ struct _XSQEvent *head, *tail; /* Input event queue. */
+ int qlen; /* Length of input event queue */
+ unsigned long request; /* sequence number of last request. */
+ char *last_req; /* beginning of last request, or dummy */
+ char *buffer; /* Output buffer starting address. */
+ char *bufptr; /* Output buffer index pointer. */
+ char *bufmax; /* Output buffer maximum+1 address. */
+ unsigned max_request_size; /* maximum number 32 bit words in request*/
+ struct _XrmHashBucketRec *db;
+ int (*synchandler)(); /* Synchronization handler */
+ char *display_name; /* "host:display" string used on this connect*/
+ int default_screen; /* default screen for operations */
+ int nscreens; /* number of screens on this server*/
+ Screen *screens; /* pointer to list of screens */
+ unsigned long motion_buffer; /* size of motion buffer */
+ unsigned long flags; /* internal connection flags */
+ int min_keycode; /* minimum defined keycode */
+ int max_keycode; /* maximum defined keycode */
+ KeySym *keysyms; /* This server's keysyms */
+ XModifierKeymap *modifiermap; /* This server's modifier keymap */
+ int keysyms_per_keycode;/* number of rows */
+ char *xdefaults; /* contents of defaults from server */
+ char *scratch_buffer; /* place to hang scratch buffer */
+ unsigned long scratch_length; /* length of scratch buffer */
+ int ext_number; /* extension number on this display */
+ struct _XExten *ext_procs; /* extensions initialized on this display */
+ /*
+ * the following can be fixed size, as the protocol defines how
+ * much address space is available.
+ * While this could be done using the extension vector, there
+ * may be MANY events processed, so a search through the extension
+ * list to find the right procedure for each event might be
+ * expensive if many extensions are being used.
+ */
+ Bool (*event_vec[128])(); /* vector for wire to event */
+ Status (*wire_vec[128])(); /* vector for event to wire */
+ KeySym lock_meaning; /* for XLookupString */
+ struct _XLockInfo *lock; /* multi-thread state, display lock */
+ struct _XInternalAsync *async_handlers; /* for internal async */
+ unsigned long bigreq_size; /* max size of big requests */
+ struct _XLockPtrs *lock_fns; /* pointers to threads functions */
+ /* things above this line should not move, for binary compatibility */
+ struct _XKeytrans *key_bindings; /* for XLookupString */
+ Font cursor_font; /* for XCreateFontCursor */
+ struct _XDisplayAtoms *atoms; /* for XInternAtom */
+ unsigned int mode_switch; /* keyboard group modifiers */
+ struct _XContextDB *context_db; /* context database */
+ Bool (**error_vec)(); /* vector for wire to error */
+ /*
+ * Xcms information
+ */
+ struct {
+ XPointer defaultCCCs; /* pointer to an array of default XcmsCCC */
+ XPointer clientCmaps; /* pointer to linked list of XcmsCmapRec */
+ XPointer perVisualIntensityMaps;
+ /* linked list of XcmsIntensityMap */
+ } cms;
+ struct _XIMFilter *im_filters;
+ struct _XSQEvent *qfree; /* unallocated event queue elements */
+ unsigned long next_event_serial_num; /* inserted into next queue elt */
+ int (*savedsynchandler)(); /* user synchandler when Xlib usurps */
+} Display;
+
+#if NeedFunctionPrototypes /* prototypes require event type definitions */
+#undef _XEVENT_
+#endif
+#ifndef _XEVENT_
+
+#define XMaxTransChars 4
+
+/*
+ * Definitions of specific events.
+ */
+typedef struct {
+ int type; /* of event */
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window window; /* "event" window it is reported relative to */
+ Window root; /* root window that the event occured on */
+ Window subwindow; /* child window */
+ Time time; /* milliseconds */
+ 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 */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window window; /* "event" window it is reported relative to */
+ Window root; /* root window that the event occured on */
+ Window subwindow; /* child window */
+ Time time; /* milliseconds */
+ 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 button; /* detail */
+ Bool same_screen; /* same screen flag */
+} XButtonEvent;
+typedef XButtonEvent XButtonPressedEvent;
+typedef XButtonEvent XButtonReleasedEvent;
+
+typedef struct {
+ int type; /* of event */
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window window; /* "event" window reported relative to */
+ Window root; /* root window that the event occured on */
+ Window subwindow; /* child window */
+ Time time; /* milliseconds */
+ 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 */
+ char is_hint; /* detail */
+ Bool same_screen; /* same screen flag */
+} XMotionEvent;
+typedef XMotionEvent XPointerMovedEvent;
+
+typedef struct {
+ int type; /* of event */
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window window; /* "event" window reported relative to */
+ Window root; /* root window that the event occured on */
+ Window subwindow; /* child window */
+ Time time; /* milliseconds */
+ int x, y; /* pointer x, y coordinates in event window */
+ int x_root, y_root; /* coordinates relative to root */
+ int mode; /* NotifyNormal, NotifyGrab, NotifyUngrab */
+ int detail;
+ /*
+ * NotifyAncestor, NotifyVirtual, NotifyInferior,
+ * NotifyNonlinear,NotifyNonlinearVirtual
+ */
+ Bool same_screen; /* same screen flag */
+ Bool focus; /* boolean focus */
+ unsigned int state; /* key or button mask */
+} XCrossingEvent;
+typedef XCrossingEvent XEnterWindowEvent;
+typedef XCrossingEvent XLeaveWindowEvent;
+
+typedef struct {
+ int type; /* FocusIn or FocusOut */
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window window; /* window of event */
+ int mode; /* NotifyNormal, NotifyGrab, NotifyUngrab */
+ int detail;
+ /*
+ * NotifyAncestor, NotifyVirtual, NotifyInferior,
+ * NotifyNonlinear,NotifyNonlinearVirtual, NotifyPointer,
+ * NotifyPointerRoot, NotifyDetailNone
+ */
+} XFocusChangeEvent;
+typedef XFocusChangeEvent XFocusInEvent;
+typedef XFocusChangeEvent XFocusOutEvent;
+
+/* generated on EnterWindow and FocusIn when KeyMapState selected */
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window window;
+ char key_vector[32];
+} XKeymapEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window window;
+ int x, y;
+ int width, height;
+ int count; /* if non-zero, at least this many more */
+} XExposeEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Drawable drawable;
+ int x, y;
+ int width, height;
+ int count; /* if non-zero, at least this many more */
+ int major_code; /* core is CopyArea or CopyPlane */
+ int minor_code; /* not defined in the core */
+} XGraphicsExposeEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Drawable drawable;
+ int major_code; /* core is CopyArea or CopyPlane */
+ int minor_code; /* not defined in the core */
+} XNoExposeEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window window;
+ int state; /* Visibility state */
+} XVisibilityEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window parent; /* parent of the window */
+ Window window; /* window id of window created */
+ int x, y; /* window location */
+ int width, height; /* size of window */
+ int border_width; /* border width */
+ Bool override_redirect; /* creation should be overridden */
+} XCreateWindowEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window event;
+ Window window;
+} XDestroyWindowEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window event;
+ Window window;
+ Bool from_configure;
+} XUnmapEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window event;
+ Window window;
+ Bool override_redirect; /* boolean, is override set... */
+} XMapEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window parent;
+ Window window;
+} XMapRequestEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window event;
+ Window window;
+ Window parent;
+ int x, y;
+ Bool override_redirect;
+} XReparentEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window event;
+ Window window;
+ int x, y;
+ int width, height;
+ int border_width;
+ Window above;
+ Bool override_redirect;
+} XConfigureEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window event;
+ Window window;
+ int x, y;
+} XGravityEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window window;
+ int width, height;
+} XResizeRequestEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window parent;
+ Window window;
+ int x, y;
+ int width, height;
+ int border_width;
+ Window above;
+ int detail; /* Above, Below, TopIf, BottomIf, Opposite */
+ unsigned long value_mask;
+} XConfigureRequestEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window event;
+ Window window;
+ int place; /* PlaceOnTop, PlaceOnBottom */
+} XCirculateEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window parent;
+ Window window;
+ int place; /* PlaceOnTop, PlaceOnBottom */
+} XCirculateRequestEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window window;
+ Atom atom;
+ Time time;
+ int state; /* NewValue, Deleted */
+} XPropertyEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window window;
+ Atom selection;
+ Time time;
+} XSelectionClearEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window owner;
+ Window requestor;
+ Atom selection;
+ Atom target;
+ Atom property;
+ Time time;
+} XSelectionRequestEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window requestor;
+ Atom selection;
+ Atom target;
+ Atom property; /* ATOM or None */
+ Time time;
+} XSelectionEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window window;
+ Colormap colormap; /* COLORMAP or None */
+#if defined(__cplusplus) || defined(c_plusplus)
+ Bool c_new; /* C++ */
+#else
+ Bool new;
+#endif
+ int state; /* ColormapInstalled, ColormapUninstalled */
+} XColormapEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window window;
+ Atom message_type;
+ int format;
+ union {
+ char b[20];
+ short s[10];
+ long l[5];
+ } data;
+} XClientMessageEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display; /* Display the event was read from */
+ Window window; /* unused */
+ int request; /* one of MappingModifier, MappingKeyboard,
+ MappingPointer */
+ int first_keycode; /* first keycode */
+ int count; /* defines range of change w. first_keycode*/
+} XMappingEvent;
+
+typedef struct {
+ int type;
+ Display *display; /* Display the event was read from */
+ XID resourceid; /* resource id */
+ unsigned long serial; /* serial number of failed request */
+ unsigned char error_code; /* error code of failed request */
+ unsigned char request_code; /* Major op-code of failed request */
+ unsigned char minor_code; /* Minor op-code of failed request */
+} XErrorEvent;
+
+typedef struct {
+ int type;
+ unsigned long serial; /* # of last request processed by server */
+ Bool send_event; /* true if this came from a SendEvent request */
+ Display *display;/* Display the event was read from */
+ Window window; /* window on which event was requested in event mask */
+} XAnyEvent;
+
+/*
+ * this union is defined so Xlib can always use the same sized
+ * event structure internally, to avoid memory fragmentation.
+ */
+typedef union _XEvent {
+ int type; /* must not be changed; first element */
+ XAnyEvent xany;
+ XKeyEvent xkey;
+ XButtonEvent xbutton;
+ XMotionEvent xmotion;
+ XCrossingEvent xcrossing;
+ XFocusChangeEvent xfocus;
+ XExposeEvent xexpose;
+ XGraphicsExposeEvent xgraphicsexpose;
+ XNoExposeEvent xnoexpose;
+ XVisibilityEvent xvisibility;
+ XCreateWindowEvent xcreatewindow;
+ XDestroyWindowEvent xdestroywindow;
+ XUnmapEvent xunmap;
+ XMapEvent xmap;
+ XMapRequestEvent xmaprequest;
+ XReparentEvent xreparent;
+ XConfigureEvent xconfigure;
+ XGravityEvent xgravity;
+ XResizeRequestEvent xresizerequest;
+ XConfigureRequestEvent xconfigurerequest;
+ XCirculateEvent xcirculate;
+ XCirculateRequestEvent xcirculaterequest;
+ XPropertyEvent xproperty;
+ XSelectionClearEvent xselectionclear;
+ XSelectionRequestEvent xselectionrequest;
+ XSelectionEvent xselection;
+ XColormapEvent xcolormap;
+ XClientMessageEvent xclient;
+ XMappingEvent xmapping;
+ XErrorEvent xerror;
+ XKeymapEvent xkeymap;
+ long pad[24];
+} XEvent;
+#endif
+
+#define XAllocID(dpy) ((*(dpy)->resource_alloc)((dpy)))
+
+/*
+ * per character font metric information.
+ */
+typedef struct {
+ short lbearing; /* origin to left edge of raster */
+ short rbearing; /* origin to right edge of raster */
+ short width; /* advance to next char's origin */
+ short ascent; /* baseline to top edge of raster */
+ short descent; /* baseline to bottom edge of raster */
+ unsigned short attributes; /* per char flags (not predefined) */
+} XCharStruct;
+
+/*
+ * To allow arbitrary information with fonts, there are additional properties
+ * returned.
+ */
+typedef struct {
+ Atom name;
+ unsigned long card32;
+} XFontProp;
+
+typedef struct {
+ XExtData *ext_data; /* hook for extension to hang data */
+ Font fid; /* Font id for this font */
+ unsigned direction; /* hint about direction the font is painted */
+ unsigned min_char_or_byte2;/* first character */
+ unsigned max_char_or_byte2;/* last character */
+ unsigned min_byte1; /* first row that exists */
+ unsigned max_byte1; /* last row that exists */
+ Bool all_chars_exist;/* flag if all characters have non-zero size*/
+ unsigned default_char; /* char to print for undefined character */
+ int n_properties; /* how many properties there are */
+ XFontProp *properties; /* pointer to array of additional properties*/
+ XCharStruct min_bounds; /* minimum bounds over all existing char*/
+ XCharStruct max_bounds; /* maximum bounds over all existing char*/
+ XCharStruct *per_char; /* first_char to last_char information */
+ int ascent; /* log. extent above baseline for spacing */
+ int descent; /* log. descent below baseline for spacing */
+} XFontStruct;
+
+/*
+ * PolyText routines take these as arguments.
+ */
+typedef struct {
+ char *chars; /* pointer to string */
+ int nchars; /* number of characters */
+ int delta; /* delta between strings */
+ Font font; /* font to print it in, None don't change */
+} XTextItem;
+
+typedef struct { /* normal 16 bit characters are two bytes */
+ unsigned char byte1;
+ unsigned char byte2;
+} XChar2b;
+
+typedef struct {
+ XChar2b *chars; /* two byte characters */
+ int nchars; /* number of characters */
+ int delta; /* delta between strings */
+ Font font; /* font to print it in, None don't change */
+} XTextItem16;
+
+
+typedef union { Display *display;
+ GC gc;
+ Visual *visual;
+ Screen *screen;
+ ScreenFormat *pixmap_format;
+ XFontStruct *font; } XEDataObject;
+
+typedef struct {
+ XRectangle max_ink_extent;
+ XRectangle max_logical_extent;
+} XFontSetExtents;
+
+typedef struct _XFontSet *XFontSet;
+
+typedef struct {
+ char *chars;
+ int nchars;
+ int delta;
+ XFontSet font_set;
+} XmbTextItem;
+
+typedef struct {
+ wchar_t *chars;
+ int nchars;
+ int delta;
+ XFontSet font_set;
+} XwcTextItem;
+
+typedef void (*XIMProc)();
+
+typedef struct _XIM *XIM;
+typedef struct _XIC *XIC;
+
+typedef unsigned long XIMStyle;
+
+typedef struct {
+ unsigned short count_styles;
+ XIMStyle *supported_styles;
+} XIMStyles;
+
+#define XIMPreeditArea 0x0001L
+#define XIMPreeditCallbacks 0x0002L
+#define XIMPreeditPosition 0x0004L
+#define XIMPreeditNothing 0x0008L
+#define XIMPreeditNone 0x0010L
+#define XIMStatusArea 0x0100L
+#define XIMStatusCallbacks 0x0200L
+#define XIMStatusNothing 0x0400L
+#define XIMStatusNone 0x0800L
+
+#define XNVaNestedList "XNVaNestedList"
+#define XNClientWindow "clientWindow"
+#define XNInputStyle "inputStyle"
+#define XNFocusWindow "focusWindow"
+#define XNResourceName "resourceName"
+#define XNResourceClass "resourceClass"
+#define XNGeometryCallback "geometryCallback"
+#define XNFilterEvents "filterEvents"
+#define XNPreeditStartCallback "preeditStartCallback"
+#define XNPreeditDoneCallback "preeditDoneCallback"
+#define XNPreeditDrawCallback "preeditDrawCallback"
+#define XNPreeditCaretCallback "preeditCaretCallback"
+#define XNPreeditAttributes "preeditAttributes"
+#define XNStatusStartCallback "statusStartCallback"
+#define XNStatusDoneCallback "statusDoneCallback"
+#define XNStatusDrawCallback "statusDrawCallback"
+#define XNStatusAttributes "statusAttributes"
+#define XNArea "area"
+#define XNAreaNeeded "areaNeeded"
+#define XNSpotLocation "spotLocation"
+#define XNColormap "colorMap"
+#define XNStdColormap "stdColorMap"
+#define XNForeground "foreground"
+#define XNBackground "background"
+#define XNBackgroundPixmap "backgroundPixmap"
+#define XNFontSet "fontSet"
+#define XNLineSpace "lineSpace"
+#define XNCursor "cursor"
+
+#define XBufferOverflow -1
+#define XLookupNone 1
+#define XLookupChars 2
+#define XLookupKeySym 3
+#define XLookupBoth 4
+
+#if NeedFunctionPrototypes
+typedef void *XVaNestedList;
+#else
+typedef XPointer XVaNestedList;
+#endif
+
+typedef struct {
+ XPointer client_data;
+ XIMProc callback;
+} XIMCallback;
+
+typedef unsigned long XIMFeedback;
+
+#define XIMReverse 1
+#define XIMUnderline (1<<1)
+#define XIMHighlight (1<<2)
+#define XIMPrimary (1<<5)
+#define XIMSecondary (1<<6)
+#define XIMTertiary (1<<7)
+
+typedef struct _XIMText {
+ unsigned short length;
+ XIMFeedback *feedback;
+ Bool encoding_is_wchar;
+ union {
+ char *multi_byte;
+ wchar_t *wide_char;
+ } string;
+} XIMText;
+
+typedef struct _XIMPreeditDrawCallbackStruct {
+ int caret; /* Cursor offset within pre-edit string */
+ int chg_first; /* Starting change position */
+ int chg_length; /* Length of the change in character count */
+ XIMText *text;
+} XIMPreeditDrawCallbackStruct;
+
+typedef enum {
+ XIMForwardChar, XIMBackwardChar,
+ XIMForwardWord, XIMBackwardWord,
+ XIMCaretUp, XIMCaretDown,
+ XIMNextLine, XIMPreviousLine,
+ XIMLineStart, XIMLineEnd,
+ XIMAbsolutePosition,
+ XIMDontChange
+} XIMCaretDirection;
+
+typedef enum {
+ XIMIsInvisible, /* Disable caret feedback */
+ XIMIsPrimary, /* UI defined caret feedback */
+ XIMIsSecondary /* UI defined caret feedback */
+} XIMCaretStyle;
+
+typedef struct _XIMPreeditCaretCallbackStruct {
+ int position; /* Caret offset within pre-edit string */
+ XIMCaretDirection direction; /* Caret moves direction */
+ XIMCaretStyle style; /* Feedback of the caret */
+} XIMPreeditCaretCallbackStruct;
+
+typedef enum {
+ XIMTextType,
+ XIMBitmapType
+} XIMStatusDataType;
+
+typedef struct _XIMStatusDrawCallbackStruct {
+ 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_ */
diff --git a/tk/xlib/X11/Xutil.h b/tk/xlib/X11/Xutil.h
new file mode 100644
index 00000000000..63328509c69
--- /dev/null
+++ b/tk/xlib/X11/Xutil.h
@@ -0,0 +1,879 @@
+/* $XConsortium: Xutil.h,v 11.73 91/07/30 16:21:37 rws Exp $ */
+
+/***********************************************************
+Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts,
+and the Massachusetts Institute of Technology, Cambridge, Massachusetts.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Digital or MIT not be
+used in advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL
+DIGITAL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+SOFTWARE.
+
+******************************************************************/
+
+#ifndef _XUTIL_H_
+#define _XUTIL_H_
+
+/* You must include <X11/Xlib.h> before including this file */
+
+#ifdef MAC_TCL
+# define Region XRegion
+#endif
+
+/*
+ * Bitmask returned by XParseGeometry(). Each bit tells if the corresponding
+ * value (x, y, width, height) was found in the parsed string.
+ */
+#define NoValue 0x0000
+#define XValue 0x0001
+#define YValue 0x0002
+#define WidthValue 0x0004
+#define HeightValue 0x0008
+#define AllValues 0x000F
+#define XNegative 0x0010
+#define YNegative 0x0020
+
+/*
+ * new version containing base_width, base_height, and win_gravity fields;
+ * used with WM_NORMAL_HINTS.
+ */
+typedef struct {
+ long flags; /* marks which fields in this structure are defined */
+ int x, y; /* obsolete for new window mgrs, but clients */
+ int width, height; /* should set so old wm's don't mess up */
+ int min_width, min_height;
+ int max_width, max_height;
+ int width_inc, height_inc;
+ struct {
+ int x; /* numerator */
+ int y; /* denominator */
+ } min_aspect, max_aspect;
+ int base_width, base_height; /* added by ICCCM version 1 */
+ int win_gravity; /* added by ICCCM version 1 */
+} XSizeHints;
+
+/*
+ * The next block of definitions are for window manager properties that
+ * clients and applications use for communication.
+ */
+
+/* flags argument in size hints */
+#define USPosition (1L << 0) /* user specified x, y */
+#define USSize (1L << 1) /* user specified width, height */
+
+#define PPosition (1L << 2) /* program specified position */
+#define PSize (1L << 3) /* program specified size */
+#define PMinSize (1L << 4) /* program specified minimum size */
+#define PMaxSize (1L << 5) /* program specified maximum size */
+#define PResizeInc (1L << 6) /* program specified resize increments */
+#define PAspect (1L << 7) /* program specified min and max aspect ratios */
+#define PBaseSize (1L << 8) /* program specified base for incrementing */
+#define PWinGravity (1L << 9) /* program specified window gravity */
+
+/* obsolete */
+#define PAllHints (PPosition|PSize|PMinSize|PMaxSize|PResizeInc|PAspect)
+
+
+
+typedef struct {
+ long flags; /* marks which fields in this structure are defined */
+ Bool input; /* does this application rely on the window manager to
+ get keyboard input? */
+ int initial_state; /* see below */
+ Pixmap icon_pixmap; /* pixmap to be used as icon */
+ Window icon_window; /* window to be used as icon */
+ int icon_x, icon_y; /* initial position of icon */
+ Pixmap icon_mask; /* icon mask bitmap */
+ XID window_group; /* id of related window group */
+ /* this structure may be extended in the future */
+} XWMHints;
+
+/* definition for flags of XWMHints */
+
+#define InputHint (1L << 0)
+#define StateHint (1L << 1)
+#define IconPixmapHint (1L << 2)
+#define IconWindowHint (1L << 3)
+#define IconPositionHint (1L << 4)
+#define IconMaskHint (1L << 5)
+#define WindowGroupHint (1L << 6)
+#define AllHints (InputHint|StateHint|IconPixmapHint|IconWindowHint| \
+IconPositionHint|IconMaskHint|WindowGroupHint)
+
+/* definitions for initial window state */
+#define WithdrawnState 0 /* for windows that are not mapped */
+#define NormalState 1 /* most applications want to start this way */
+#define IconicState 3 /* application wants to start as an icon */
+
+/*
+ * Obsolete states no longer defined by ICCCM
+ */
+#define DontCareState 0 /* don't know or care */
+#define ZoomState 2 /* application wants to start zoomed */
+#define InactiveState 4 /* application believes it is seldom used; */
+ /* some wm's may put it on inactive menu */
+
+
+/*
+ * new structure for manipulating TEXT properties; used with WM_NAME,
+ * WM_ICON_NAME, WM_CLIENT_MACHINE, and WM_COMMAND.
+ */
+typedef struct {
+ unsigned char *value; /* same as Property routines */
+ Atom encoding; /* prop type */
+ int format; /* prop data format: 8, 16, or 32 */
+ unsigned long nitems; /* number of data items in value */
+} XTextProperty;
+
+#define XNoMemory -1
+#define XLocaleNotSupported -2
+#define XConverterNotFound -3
+
+typedef enum {
+ XStringStyle, /* STRING */
+ XCompoundTextStyle, /* COMPOUND_TEXT */
+ XTextStyle, /* text in owner's encoding (current locale)*/
+ XStdICCTextStyle /* STRING, else COMPOUND_TEXT */
+} XICCEncodingStyle;
+
+typedef struct {
+ int min_width, min_height;
+ int max_width, max_height;
+ int width_inc, height_inc;
+} XIconSize;
+
+typedef struct {
+ char *res_name;
+ char *res_class;
+} XClassHint;
+
+/*
+ * These macros are used to give some sugar to the image routines so that
+ * naive people are more comfortable with them.
+ */
+#define XDestroyImage(ximage) \
+ ((*((ximage)->f.destroy_image))((ximage)))
+#define XGetPixel(ximage, x, y) \
+ ((*((ximage)->f.get_pixel))((ximage), (x), (y)))
+#define XPutPixel(ximage, x, y, pixel) \
+ ((*((ximage)->f.put_pixel))((ximage), (x), (y), (pixel)))
+#define XSubImage(ximage, x, y, width, height) \
+ ((*((ximage)->f.sub_image))((ximage), (x), (y), (width), (height)))
+#define XAddPixel(ximage, value) \
+ ((*((ximage)->f.add_pixel))((ximage), (value)))
+
+/*
+ * Compose sequence status structure, used in calling XLookupString.
+ */
+typedef struct _XComposeStatus {
+ XPointer compose_ptr; /* state table pointer */
+ int chars_matched; /* match state */
+} XComposeStatus;
+
+/*
+ * Keysym macros, used on Keysyms to test for classes of symbols
+ */
+#define IsKeypadKey(keysym) \
+ (((unsigned)(keysym) >= XK_KP_Space) && ((unsigned)(keysym) <= XK_KP_Equal))
+
+#define IsCursorKey(keysym) \
+ (((unsigned)(keysym) >= XK_Home) && ((unsigned)(keysym) < XK_Select))
+
+#define IsPFKey(keysym) \
+ (((unsigned)(keysym) >= XK_KP_F1) && ((unsigned)(keysym) <= XK_KP_F4))
+
+#define IsFunctionKey(keysym) \
+ (((unsigned)(keysym) >= XK_F1) && ((unsigned)(keysym) <= XK_F35))
+
+#define IsMiscFunctionKey(keysym) \
+ (((unsigned)(keysym) >= XK_Select) && ((unsigned)(keysym) <= XK_Break))
+
+#define IsModifierKey(keysym) \
+ ((((unsigned)(keysym) >= XK_Shift_L) && ((unsigned)(keysym) <= XK_Hyper_R)) \
+ || ((unsigned)(keysym) == XK_Mode_switch) \
+ || ((unsigned)(keysym) == XK_Num_Lock))
+/*
+ * opaque reference to Region data type
+ */
+typedef struct _XRegion *Region;
+
+/* Return values from XRectInRegion() */
+
+#define RectangleOut 0
+#define RectangleIn 1
+#define RectanglePart 2
+
+
+/*
+ * Information used by the visual utility routines to find desired visual
+ * type from the many visuals a display may support.
+ */
+
+typedef struct {
+ Visual *visual;
+ VisualID visualid;
+ int screen;
+ int depth;
+#if defined(__cplusplus) || defined(c_plusplus)
+ int c_class; /* C++ */
+#else
+ int class;
+#endif
+ unsigned long red_mask;
+ unsigned long green_mask;
+ unsigned long blue_mask;
+ int colormap_size;
+ int bits_per_rgb;
+} XVisualInfo;
+
+#define VisualNoMask 0x0
+#define VisualIDMask 0x1
+#define VisualScreenMask 0x2
+#define VisualDepthMask 0x4
+#define VisualClassMask 0x8
+#define VisualRedMaskMask 0x10
+#define VisualGreenMaskMask 0x20
+#define VisualBlueMaskMask 0x40
+#define VisualColormapSizeMask 0x80
+#define VisualBitsPerRGBMask 0x100
+#define VisualAllMask 0x1FF
+
+/*
+ * This defines a window manager property that clients may use to
+ * share standard color maps of type RGB_COLOR_MAP:
+ */
+typedef struct {
+ Colormap colormap;
+ unsigned long red_max;
+ unsigned long red_mult;
+ unsigned long green_max;
+ unsigned long green_mult;
+ unsigned long blue_max;
+ unsigned long blue_mult;
+ unsigned long base_pixel;
+ VisualID visualid; /* added by ICCCM version 1 */
+ XID killid; /* added by ICCCM version 1 */
+} XStandardColormap;
+
+#define ReleaseByFreeingColormap ((XID) 1L) /* for killid field above */
+
+
+/*
+ * return codes for XReadBitmapFile and XWriteBitmapFile
+ */
+#define BitmapSuccess 0
+#define BitmapOpenFailed 1
+#define BitmapFileInvalid 2
+#define BitmapNoMemory 3
+
+/****************************************************************
+ *
+ * Context Management
+ *
+ ****************************************************************/
+
+
+/* Associative lookup table return codes */
+
+#define XCSUCCESS 0 /* No error. */
+#define XCNOMEM 1 /* Out of memory */
+#define XCNOENT 2 /* No entry in table */
+
+typedef int XContext;
+
+#define XUniqueContext() ((XContext) XrmUniqueQuark())
+#define XStringToContext(string) ((XContext) XrmStringToQuark(string))
+
+_XFUNCPROTOBEGIN
+
+/* The following declarations are alphabetized. */
+
+extern XClassHint *XAllocClassHint (
+#if NeedFunctionPrototypes
+ void
+#endif
+);
+
+extern XIconSize *XAllocIconSize (
+#if NeedFunctionPrototypes
+ void
+#endif
+);
+
+extern XSizeHints *XAllocSizeHints (
+#if NeedFunctionPrototypes
+ void
+#endif
+);
+
+extern XStandardColormap *XAllocStandardColormap (
+#if NeedFunctionPrototypes
+ void
+#endif
+);
+
+extern XWMHints *XAllocWMHints (
+#if NeedFunctionPrototypes
+ void
+#endif
+);
+
+extern void XClipBox(
+#if NeedFunctionPrototypes
+ Region /* r */,
+ XRectangle* /* rect_return */
+#endif
+);
+
+extern Region XCreateRegion(
+#if NeedFunctionPrototypes
+ void
+#endif
+);
+
+extern char *XDefaultString(
+#if NeedFunctionPrototypes
+ void
+#endif
+);
+
+extern int XDeleteContext(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ XID /* rid */,
+ XContext /* context */
+#endif
+);
+
+extern void XDestroyRegion(
+#if NeedFunctionPrototypes
+ Region /* r */
+#endif
+);
+
+extern void XEmptyRegion(
+#if NeedFunctionPrototypes
+ Region /* r */
+#endif
+);
+
+extern void XEqualRegion(
+#if NeedFunctionPrototypes
+ Region /* r1 */,
+ Region /* r2 */
+#endif
+);
+
+extern int XFindContext(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ XID /* rid */,
+ XContext /* context */,
+ XPointer* /* data_return */
+#endif
+);
+
+extern Status XGetClassHint(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XClassHint* /* class_hints_return */
+#endif
+);
+
+extern Status XGetIconSizes(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XIconSize** /* size_list_return */,
+ int* /* count_return */
+#endif
+);
+
+extern Status XGetNormalHints(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XSizeHints* /* hints_return */
+#endif
+);
+
+extern Status XGetRGBColormaps(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XStandardColormap** /* stdcmap_return */,
+ int* /* count_return */,
+ Atom /* property */
+#endif
+);
+
+extern Status XGetSizeHints(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XSizeHints* /* hints_return */,
+ Atom /* property */
+#endif
+);
+
+extern Status XGetStandardColormap(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XStandardColormap* /* colormap_return */,
+ Atom /* property */
+#endif
+);
+
+extern Status XGetTextProperty(
+#if NeedFunctionPrototypes
+ 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
+);
+
+extern XWMHints *XGetWMHints(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */
+#endif
+);
+
+extern Status XGetWMIconName(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XTextProperty* /* text_prop_return */
+#endif
+);
+
+extern Status XGetWMName(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XTextProperty* /* text_prop_return */
+#endif
+);
+
+extern Status XGetWMNormalHints(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XSizeHints* /* hints_return */,
+ long* /* supplied_return */
+#endif
+);
+
+extern Status XGetWMSizeHints(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XSizeHints* /* hints_return */,
+ long* /* supplied_return */,
+ Atom /* property */
+#endif
+);
+
+extern Status XGetZoomHints(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XSizeHints* /* zhints_return */
+#endif
+);
+
+extern void XIntersectRegion(
+#if NeedFunctionPrototypes
+ Region /* sra */,
+ Region /* srb */,
+ Region /* dr_return */
+#endif
+);
+
+extern int XLookupString(
+#if NeedFunctionPrototypes
+ XKeyEvent* /* event_struct */,
+ char* /* buffer_return */,
+ int /* bytes_buffer */,
+ KeySym* /* keysym_return */,
+ XComposeStatus* /* status_in_out */
+#endif
+);
+
+extern Status XMatchVisualInfo(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ int /* screen */,
+ int /* depth */,
+ int /* class */,
+ XVisualInfo* /* vinfo_return */
+#endif
+);
+
+extern void XOffsetRegion(
+#if NeedFunctionPrototypes
+ Region /* r */,
+ int /* dx */,
+ int /* dy */
+#endif
+);
+
+extern Bool XPointInRegion(
+#if NeedFunctionPrototypes
+ Region /* r */,
+ int /* x */,
+ int /* y */
+#endif
+);
+
+extern Region XPolygonRegion(
+#if NeedFunctionPrototypes
+ XPoint* /* points */,
+ int /* n */,
+ int /* fill_rule */
+#endif
+);
+
+extern int XRectInRegion(
+#if NeedFunctionPrototypes
+ Region /* r */,
+ int /* x */,
+ int /* y */,
+ unsigned int /* width */,
+ unsigned int /* height */
+#endif
+);
+
+extern int XSaveContext(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ XID /* rid */,
+ XContext /* context */,
+ _Xconst char* /* data */
+#endif
+);
+
+extern void XSetClassHint(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XClassHint* /* class_hints */
+#endif
+);
+
+extern void XSetIconSizes(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XIconSize* /* size_list */,
+ int /* count */
+#endif
+);
+
+extern void XSetNormalHints(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XSizeHints* /* hints */
+#endif
+);
+
+extern void XSetRGBColormaps(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XStandardColormap* /* stdcmaps */,
+ int /* count */,
+ Atom /* property */
+#endif
+);
+
+extern void XSetSizeHints(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XSizeHints* /* hints */,
+ Atom /* property */
+#endif
+);
+
+extern void XSetStandardProperties(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ _Xconst char* /* window_name */,
+ _Xconst char* /* icon_name */,
+ Pixmap /* icon_pixmap */,
+ char** /* argv */,
+ int /* argc */,
+ XSizeHints* /* hints */
+#endif
+);
+
+extern void XSetTextProperty(
+#if NeedFunctionPrototypes
+ 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
+);
+
+extern void XSetWMIconName(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XTextProperty* /* text_prop */
+#endif
+);
+
+extern void XSetWMName(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XTextProperty* /* text_prop */
+#endif
+);
+
+extern void XSetWMNormalHints(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XSizeHints* /* hints */
+#endif
+);
+
+extern void XSetWMProperties(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XTextProperty* /* window_name */,
+ XTextProperty* /* icon_name */,
+ char** /* argv */,
+ int /* argc */,
+ XSizeHints* /* normal_hints */,
+ XWMHints* /* wm_hints */,
+ XClassHint* /* class_hints */
+#endif
+);
+
+extern void XmbSetWMProperties(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ _Xconst char* /* window_name */,
+ _Xconst char* /* icon_name */,
+ char** /* argv */,
+ int /* argc */,
+ XSizeHints* /* normal_hints */,
+ XWMHints* /* wm_hints */,
+ XClassHint* /* class_hints */
+#endif
+);
+
+extern void XSetWMSizeHints(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XSizeHints* /* hints */,
+ Atom /* property */
+#endif
+);
+
+extern void XSetRegion(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ GC /* gc */,
+ Region /* r */
+#endif
+);
+
+extern void XSetStandardColormap(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XStandardColormap* /* colormap */,
+ Atom /* property */
+#endif
+);
+
+extern void XSetZoomHints(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ Window /* w */,
+ XSizeHints* /* zhints */
+#endif
+);
+
+extern void XShrinkRegion(
+#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
+);
+
+extern int XmbTextListToTextProperty(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ char** /* list */,
+ int /* count */,
+ XICCEncodingStyle /* style */,
+ XTextProperty* /* text_prop_return */
+#endif
+);
+
+extern int XwcTextListToTextProperty(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ wchar_t** /* list */,
+ int /* count */,
+ XICCEncodingStyle /* style */,
+ XTextProperty* /* text_prop_return */
+#endif
+);
+
+extern void XwcFreeStringList(
+#if NeedFunctionPrototypes
+ wchar_t** /* list */
+#endif
+);
+
+extern Status XTextPropertyToStringList(
+#if NeedFunctionPrototypes
+ XTextProperty* /* text_prop */,
+ char*** /* list_return */,
+ int* /* count_return */
+#endif
+);
+
+extern int XmbTextPropertyToTextList(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ XTextProperty* /* text_prop */,
+ char*** /* list_return */,
+ int* /* count_return */
+#endif
+);
+
+extern int XwcTextPropertyToTextList(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ XTextProperty* /* text_prop */,
+ wchar_t*** /* list_return */,
+ int* /* count_return */
+#endif
+);
+
+extern void XUnionRectWithRegion(
+#if NeedFunctionPrototypes
+ XRectangle* /* rectangle */,
+ Region /* src_region */,
+ Region /* dest_region_return */
+#endif
+);
+
+extern void XUnionRegion(
+#if NeedFunctionPrototypes
+ Region /* sra */,
+ Region /* srb */,
+ Region /* dr_return */
+#endif
+);
+
+extern int XWMGeometry(
+#if NeedFunctionPrototypes
+ Display* /* display */,
+ int /* screen_number */,
+ _Xconst char* /* user_geometry */,
+ _Xconst char* /* default_geometry */,
+ unsigned int /* border_width */,
+ XSizeHints* /* hints */,
+ int* /* x_return */,
+ int* /* y_return */,
+ int* /* width_return */,
+ int* /* height_return */,
+ int* /* gravity_return */
+#endif
+);
+
+extern void XXorRegion(
+#if NeedFunctionPrototypes
+ Region /* sra */,
+ Region /* srb */,
+ Region /* dr_return */
+#endif
+);
+
+_XFUNCPROTOEND
+
+#ifdef MAC_TCL
+# undef Region
+#endif
+
+#endif /* _XUTIL_H_ */
diff --git a/tk/xlib/X11/cursorfont.h b/tk/xlib/X11/cursorfont.h
new file mode 100644
index 00000000000..617274fa806
--- /dev/null
+++ b/tk/xlib/X11/cursorfont.h
@@ -0,0 +1,79 @@
+/* $XConsortium: cursorfont.h,v 1.2 88/09/06 16:44:27 jim Exp $ */
+#define XC_num_glyphs 154
+#define XC_X_cursor 0
+#define XC_arrow 2
+#define XC_based_arrow_down 4
+#define XC_based_arrow_up 6
+#define XC_boat 8
+#define XC_bogosity 10
+#define XC_bottom_left_corner 12
+#define XC_bottom_right_corner 14
+#define XC_bottom_side 16
+#define XC_bottom_tee 18
+#define XC_box_spiral 20
+#define XC_center_ptr 22
+#define XC_circle 24
+#define XC_clock 26
+#define XC_coffee_mug 28
+#define XC_cross 30
+#define XC_cross_reverse 32
+#define XC_crosshair 34
+#define XC_diamond_cross 36
+#define XC_dot 38
+#define XC_dotbox 40
+#define XC_double_arrow 42
+#define XC_draft_large 44
+#define XC_draft_small 46
+#define XC_draped_box 48
+#define XC_exchange 50
+#define XC_fleur 52
+#define XC_gobbler 54
+#define XC_gumby 56
+#define XC_hand1 58
+#define XC_hand2 60
+#define XC_heart 62
+#define XC_icon 64
+#define XC_iron_cross 66
+#define XC_left_ptr 68
+#define XC_left_side 70
+#define XC_left_tee 72
+#define XC_leftbutton 74
+#define XC_ll_angle 76
+#define XC_lr_angle 78
+#define XC_man 80
+#define XC_middlebutton 82
+#define XC_mouse 84
+#define XC_pencil 86
+#define XC_pirate 88
+#define XC_plus 90
+#define XC_question_arrow 92
+#define XC_right_ptr 94
+#define XC_right_side 96
+#define XC_right_tee 98
+#define XC_rightbutton 100
+#define XC_rtl_logo 102
+#define XC_sailboat 104
+#define XC_sb_down_arrow 106
+#define XC_sb_h_double_arrow 108
+#define XC_sb_left_arrow 110
+#define XC_sb_right_arrow 112
+#define XC_sb_up_arrow 114
+#define XC_sb_v_double_arrow 116
+#define XC_shuttle 118
+#define XC_sizing 120
+#define XC_spider 122
+#define XC_spraycan 124
+#define XC_star 126
+#define XC_target 128
+#define XC_tcross 130
+#define XC_top_left_arrow 132
+#define XC_top_left_corner 134
+#define XC_top_right_corner 136
+#define XC_top_side 138
+#define XC_top_tee 140
+#define XC_trek 142
+#define XC_ul_angle 144
+#define XC_umbrella 146
+#define XC_ur_angle 148
+#define XC_watch 150
+#define XC_xterm 152
diff --git a/tk/xlib/X11/keysym.h b/tk/xlib/X11/keysym.h
new file mode 100644
index 00000000000..027afe08d5f
--- /dev/null
+++ b/tk/xlib/X11/keysym.h
@@ -0,0 +1,39 @@
+/* $XConsortium: keysym.h,v 1.13 91/03/13 20:09:49 rws Exp $ */
+
+/***********************************************************
+Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts,
+and the Massachusetts Institute of Technology, Cambridge, Massachusetts.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Digital or MIT not be
+used in advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL
+DIGITAL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+SOFTWARE.
+
+******************************************************************/
+
+/* default keysyms */
+#define XK_MISCELLANY
+#define XK_LATIN1
+#define XK_LATIN2
+#define XK_LATIN3
+#define XK_LATIN4
+#define XK_GREEK
+
+#ifdef MAC_TCL
+#include <keysymdef.h>
+#else
+#include <X11/keysymdef.h>
+#endif
diff --git a/tk/xlib/X11/keysymdef.h b/tk/xlib/X11/keysymdef.h
new file mode 100644
index 00000000000..b22d41b3385
--- /dev/null
+++ b/tk/xlib/X11/keysymdef.h
@@ -0,0 +1,1169 @@
+/* $XConsortium: keysymdef.h,v 1.15 93/04/02 10:57:36 rws Exp $ */
+
+/***********************************************************
+Copyright 1987 by Digital Equipment Corporation, Maynard, Massachusetts,
+and the Massachusetts Institute of Technology, Cambridge, Massachusetts.
+
+ All Rights Reserved
+
+Permission to use, copy, modify, and distribute this software and its
+documentation for any purpose and without fee is hereby granted,
+provided that the above copyright notice appear in all copies and that
+both that copyright notice and this permission notice appear in
+supporting documentation, and that the names of Digital or MIT not be
+used in advertising or publicity pertaining to distribution of the
+software without specific, written prior permission.
+
+DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING
+ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, IN NO EVENT SHALL
+DIGITAL BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR
+ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS,
+WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION,
+ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS
+SOFTWARE.
+
+******************************************************************/
+
+#define XK_VoidSymbol 0xFFFFFF /* void symbol */
+
+#ifdef XK_MISCELLANY
+/*
+ * TTY Functions, cleverly chosen to map to ascii, for convenience of
+ * programming, but could have been arbitrary (at the cost of lookup
+ * tables in client code.
+ */
+
+#define XK_BackSpace 0xFF08 /* back space, back char */
+#define XK_Tab 0xFF09
+#define XK_Linefeed 0xFF0A /* Linefeed, LF */
+#define XK_Clear 0xFF0B
+#define XK_Return 0xFF0D /* Return, enter */
+#define XK_Pause 0xFF13 /* Pause, hold */
+#define XK_Scroll_Lock 0xFF14
+#define XK_Sys_Req 0xFF15
+#define XK_Escape 0xFF1B
+#define XK_Delete 0xFFFF /* Delete, rubout */
+
+
+
+/* International & multi-key character composition */
+
+#define XK_Multi_key 0xFF20 /* Multi-key character compose */
+
+/* Japanese keyboard support */
+
+#define XK_Kanji 0xFF21 /* Kanji, Kanji convert */
+#define XK_Muhenkan 0xFF22 /* Cancel Conversion */
+#define XK_Henkan_Mode 0xFF23 /* Start/Stop Conversion */
+#define XK_Henkan 0xFF23 /* Alias for Henkan_Mode */
+#define XK_Romaji 0xFF24 /* to Romaji */
+#define XK_Hiragana 0xFF25 /* to Hiragana */
+#define XK_Katakana 0xFF26 /* to Katakana */
+#define XK_Hiragana_Katakana 0xFF27 /* Hiragana/Katakana toggle */
+#define XK_Zenkaku 0xFF28 /* to Zenkaku */
+#define XK_Hankaku 0xFF29 /* to Hankaku */
+#define XK_Zenkaku_Hankaku 0xFF2A /* Zenkaku/Hankaku toggle */
+#define XK_Touroku 0xFF2B /* Add to Dictionary */
+#define XK_Massyo 0xFF2C /* Delete from Dictionary */
+#define XK_Kana_Lock 0xFF2D /* Kana Lock */
+#define XK_Kana_Shift 0xFF2E /* Kana Shift */
+#define XK_Eisu_Shift 0xFF2F /* Alphanumeric Shift */
+#define XK_Eisu_toggle 0xFF30 /* Alphanumeric toggle */
+
+/* Cursor control & motion */
+
+#define XK_Home 0xFF50
+#define XK_Left 0xFF51 /* Move left, left arrow */
+#define XK_Up 0xFF52 /* Move up, up arrow */
+#define XK_Right 0xFF53 /* Move right, right arrow */
+#define XK_Down 0xFF54 /* Move down, down arrow */
+#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 */
+#define XK_Undo 0xFF65 /* Undo, oops */
+#define XK_Redo 0xFF66 /* redo, again */
+#define XK_Menu 0xFF67
+#define XK_Find 0xFF68 /* Find, search */
+#define XK_Cancel 0xFF69 /* Cancel, stop, abort, exit */
+#define XK_Help 0xFF6A /* Help, ? */
+#define XK_Break 0xFF6B
+#define XK_Mode_switch 0xFF7E /* Character set switch */
+#define XK_script_switch 0xFF7E /* Alias for mode_switch */
+#define XK_Num_Lock 0xFF7F
+
+/* Keypad Functions, keypad numbers cleverly chosen to map to ascii */
+
+#define XK_KP_Space 0xFF80 /* space */
+#define XK_KP_Tab 0xFF89
+#define XK_KP_Enter 0xFF8D /* enter */
+#define XK_KP_F1 0xFF91 /* PF1, KP_A, ... */
+#define XK_KP_F2 0xFF92
+#define XK_KP_F3 0xFF93
+#define XK_KP_F4 0xFF94
+#define XK_KP_Home 0xFF95
+#define XK_KP_Left 0xFF96
+#define XK_KP_Up 0xFF97
+#define XK_KP_Right 0xFF98
+#define XK_KP_Down 0xFF99
+#define XK_KP_Prior 0xFF9A
+#define XK_KP_Page_Up 0xFF9A
+#define XK_KP_Next 0xFF9B
+#define XK_KP_Page_Down 0xFF9B
+#define XK_KP_End 0xFF9C
+#define XK_KP_Begin 0xFF9D
+#define XK_KP_Insert 0xFF9E
+#define XK_KP_Delete 0xFF9F
+#define XK_KP_Equal 0xFFBD /* equals */
+#define XK_KP_Multiply 0xFFAA
+#define XK_KP_Add 0xFFAB
+#define XK_KP_Separator 0xFFAC /* separator, often comma */
+#define XK_KP_Subtract 0xFFAD
+#define XK_KP_Decimal 0xFFAE
+#define XK_KP_Divide 0xFFAF
+
+#define XK_KP_0 0xFFB0
+#define XK_KP_1 0xFFB1
+#define XK_KP_2 0xFFB2
+#define XK_KP_3 0xFFB3
+#define XK_KP_4 0xFFB4
+#define XK_KP_5 0xFFB5
+#define XK_KP_6 0xFFB6
+#define XK_KP_7 0xFFB7
+#define XK_KP_8 0xFFB8
+#define XK_KP_9 0xFFB9
+
+
+
+/*
+ * Auxilliary Functions; note the duplicate definitions for left and right
+ * function keys; Sun keyboards and a few other manufactures have such
+ * function key groups on the left and/or right sides of the keyboard.
+ * We've not found a keyboard with more than 35 function keys total.
+ */
+
+#define XK_F1 0xFFBE
+#define XK_F2 0xFFBF
+#define XK_F3 0xFFC0
+#define XK_F4 0xFFC1
+#define XK_F5 0xFFC2
+#define XK_F6 0xFFC3
+#define XK_F7 0xFFC4
+#define XK_F8 0xFFC5
+#define XK_F9 0xFFC6
+#define XK_F10 0xFFC7
+#define XK_F11 0xFFC8
+#define XK_L1 0xFFC8
+#define XK_F12 0xFFC9
+#define XK_L2 0xFFC9
+#define XK_F13 0xFFCA
+#define XK_L3 0xFFCA
+#define XK_F14 0xFFCB
+#define XK_L4 0xFFCB
+#define XK_F15 0xFFCC
+#define XK_L5 0xFFCC
+#define XK_F16 0xFFCD
+#define XK_L6 0xFFCD
+#define XK_F17 0xFFCE
+#define XK_L7 0xFFCE
+#define XK_F18 0xFFCF
+#define XK_L8 0xFFCF
+#define XK_F19 0xFFD0
+#define XK_L9 0xFFD0
+#define XK_F20 0xFFD1
+#define XK_L10 0xFFD1
+#define XK_F21 0xFFD2
+#define XK_R1 0xFFD2
+#define XK_F22 0xFFD3
+#define XK_R2 0xFFD3
+#define XK_F23 0xFFD4
+#define XK_R3 0xFFD4
+#define XK_F24 0xFFD5
+#define XK_R4 0xFFD5
+#define XK_F25 0xFFD6
+#define XK_R5 0xFFD6
+#define XK_F26 0xFFD7
+#define XK_R6 0xFFD7
+#define XK_F27 0xFFD8
+#define XK_R7 0xFFD8
+#define XK_F28 0xFFD9
+#define XK_R8 0xFFD9
+#define XK_F29 0xFFDA
+#define XK_R9 0xFFDA
+#define XK_F30 0xFFDB
+#define XK_R10 0xFFDB
+#define XK_F31 0xFFDC
+#define XK_R11 0xFFDC
+#define XK_F32 0xFFDD
+#define XK_R12 0xFFDD
+#define XK_F33 0xFFDE
+#define XK_R13 0xFFDE
+#define XK_F34 0xFFDF
+#define XK_R14 0xFFDF
+#define XK_F35 0xFFE0
+#define XK_R15 0xFFE0
+
+/* Modifiers */
+
+#define XK_Shift_L 0xFFE1 /* Left shift */
+#define XK_Shift_R 0xFFE2 /* Right shift */
+#define XK_Control_L 0xFFE3 /* Left control */
+#define XK_Control_R 0xFFE4 /* Right control */
+#define XK_Caps_Lock 0xFFE5 /* Caps lock */
+#define XK_Shift_Lock 0xFFE6 /* Shift lock */
+
+#define XK_Meta_L 0xFFE7 /* Left meta */
+#define XK_Meta_R 0xFFE8 /* Right meta */
+#define XK_Alt_L 0xFFE9 /* Left alt */
+#define XK_Alt_R 0xFFEA /* Right alt */
+#define XK_Super_L 0xFFEB /* Left super */
+#define XK_Super_R 0xFFEC /* Right super */
+#define XK_Hyper_L 0xFFED /* Left hyper */
+#define XK_Hyper_R 0xFFEE /* Right hyper */
+#endif /* XK_MISCELLANY */
+
+/*
+ * Latin 1
+ * Byte 3 = 0
+ */
+#ifdef XK_LATIN1
+#define XK_space 0x020
+#define XK_exclam 0x021
+#define XK_quotedbl 0x022
+#define XK_numbersign 0x023
+#define XK_dollar 0x024
+#define XK_percent 0x025
+#define XK_ampersand 0x026
+#define XK_apostrophe 0x027
+#define XK_quoteright 0x027 /* deprecated */
+#define XK_parenleft 0x028
+#define XK_parenright 0x029
+#define XK_asterisk 0x02a
+#define XK_plus 0x02b
+#define XK_comma 0x02c
+#define XK_minus 0x02d
+#define XK_period 0x02e
+#define XK_slash 0x02f
+#define XK_0 0x030
+#define XK_1 0x031
+#define XK_2 0x032
+#define XK_3 0x033
+#define XK_4 0x034
+#define XK_5 0x035
+#define XK_6 0x036
+#define XK_7 0x037
+#define XK_8 0x038
+#define XK_9 0x039
+#define XK_colon 0x03a
+#define XK_semicolon 0x03b
+#define XK_less 0x03c
+#define XK_equal 0x03d
+#define XK_greater 0x03e
+#define XK_question 0x03f
+#define XK_at 0x040
+#define XK_A 0x041
+#define XK_B 0x042
+#define XK_C 0x043
+#define XK_D 0x044
+#define XK_E 0x045
+#define XK_F 0x046
+#define XK_G 0x047
+#define XK_H 0x048
+#define XK_I 0x049
+#define XK_J 0x04a
+#define XK_K 0x04b
+#define XK_L 0x04c
+#define XK_M 0x04d
+#define XK_N 0x04e
+#define XK_O 0x04f
+#define XK_P 0x050
+#define XK_Q 0x051
+#define XK_R 0x052
+#define XK_S 0x053
+#define XK_T 0x054
+#define XK_U 0x055
+#define XK_V 0x056
+#define XK_W 0x057
+#define XK_X 0x058
+#define XK_Y 0x059
+#define XK_Z 0x05a
+#define XK_bracketleft 0x05b
+#define XK_backslash 0x05c
+#define XK_bracketright 0x05d
+#define XK_asciicircum 0x05e
+#define XK_underscore 0x05f
+#define XK_grave 0x060
+#define XK_quoteleft 0x060 /* deprecated */
+#define XK_a 0x061
+#define XK_b 0x062
+#define XK_c 0x063
+#define XK_d 0x064
+#define XK_e 0x065
+#define XK_f 0x066
+#define XK_g 0x067
+#define XK_h 0x068
+#define XK_i 0x069
+#define XK_j 0x06a
+#define XK_k 0x06b
+#define XK_l 0x06c
+#define XK_m 0x06d
+#define XK_n 0x06e
+#define XK_o 0x06f
+#define XK_p 0x070
+#define XK_q 0x071
+#define XK_r 0x072
+#define XK_s 0x073
+#define XK_t 0x074
+#define XK_u 0x075
+#define XK_v 0x076
+#define XK_w 0x077
+#define XK_x 0x078
+#define XK_y 0x079
+#define XK_z 0x07a
+#define XK_braceleft 0x07b
+#define XK_bar 0x07c
+#define XK_braceright 0x07d
+#define XK_asciitilde 0x07e
+
+#define XK_nobreakspace 0x0a0
+#define XK_exclamdown 0x0a1
+#define XK_cent 0x0a2
+#define XK_sterling 0x0a3
+#define XK_currency 0x0a4
+#define XK_yen 0x0a5
+#define XK_brokenbar 0x0a6
+#define XK_section 0x0a7
+#define XK_diaeresis 0x0a8
+#define XK_copyright 0x0a9
+#define XK_ordfeminine 0x0aa
+#define XK_guillemotleft 0x0ab /* left angle quotation mark */
+#define XK_notsign 0x0ac
+#define XK_hyphen 0x0ad
+#define XK_registered 0x0ae
+#define XK_macron 0x0af
+#define XK_degree 0x0b0
+#define XK_plusminus 0x0b1
+#define XK_twosuperior 0x0b2
+#define XK_threesuperior 0x0b3
+#define XK_acute 0x0b4
+#define XK_mu 0x0b5
+#define XK_paragraph 0x0b6
+#define XK_periodcentered 0x0b7
+#define XK_cedilla 0x0b8
+#define XK_onesuperior 0x0b9
+#define XK_masculine 0x0ba
+#define XK_guillemotright 0x0bb /* right angle quotation mark */
+#define XK_onequarter 0x0bc
+#define XK_onehalf 0x0bd
+#define XK_threequarters 0x0be
+#define XK_questiondown 0x0bf
+#define XK_Agrave 0x0c0
+#define XK_Aacute 0x0c1
+#define XK_Acircumflex 0x0c2
+#define XK_Atilde 0x0c3
+#define XK_Adiaeresis 0x0c4
+#define XK_Aring 0x0c5
+#define XK_AE 0x0c6
+#define XK_Ccedilla 0x0c7
+#define XK_Egrave 0x0c8
+#define XK_Eacute 0x0c9
+#define XK_Ecircumflex 0x0ca
+#define XK_Ediaeresis 0x0cb
+#define XK_Igrave 0x0cc
+#define XK_Iacute 0x0cd
+#define XK_Icircumflex 0x0ce
+#define XK_Idiaeresis 0x0cf
+#define XK_ETH 0x0d0
+#define XK_Eth 0x0d0 /* deprecated */
+#define XK_Ntilde 0x0d1
+#define XK_Ograve 0x0d2
+#define XK_Oacute 0x0d3
+#define XK_Ocircumflex 0x0d4
+#define XK_Otilde 0x0d5
+#define XK_Odiaeresis 0x0d6
+#define XK_multiply 0x0d7
+#define XK_Ooblique 0x0d8
+#define XK_Ugrave 0x0d9
+#define XK_Uacute 0x0da
+#define XK_Ucircumflex 0x0db
+#define XK_Udiaeresis 0x0dc
+#define XK_Yacute 0x0dd
+#define XK_THORN 0x0de
+#define XK_Thorn 0x0de /* deprecated */
+#define XK_ssharp 0x0df
+#define XK_agrave 0x0e0
+#define XK_aacute 0x0e1
+#define XK_acircumflex 0x0e2
+#define XK_atilde 0x0e3
+#define XK_adiaeresis 0x0e4
+#define XK_aring 0x0e5
+#define XK_ae 0x0e6
+#define XK_ccedilla 0x0e7
+#define XK_egrave 0x0e8
+#define XK_eacute 0x0e9
+#define XK_ecircumflex 0x0ea
+#define XK_ediaeresis 0x0eb
+#define XK_igrave 0x0ec
+#define XK_iacute 0x0ed
+#define XK_icircumflex 0x0ee
+#define XK_idiaeresis 0x0ef
+#define XK_eth 0x0f0
+#define XK_ntilde 0x0f1
+#define XK_ograve 0x0f2
+#define XK_oacute 0x0f3
+#define XK_ocircumflex 0x0f4
+#define XK_otilde 0x0f5
+#define XK_odiaeresis 0x0f6
+#define XK_division 0x0f7
+#define XK_oslash 0x0f8
+#define XK_ugrave 0x0f9
+#define XK_uacute 0x0fa
+#define XK_ucircumflex 0x0fb
+#define XK_udiaeresis 0x0fc
+#define XK_yacute 0x0fd
+#define XK_thorn 0x0fe
+#define XK_ydiaeresis 0x0ff
+#endif /* XK_LATIN1 */
+
+/*
+ * Latin 2
+ * Byte 3 = 1
+ */
+
+#ifdef XK_LATIN2
+#define XK_Aogonek 0x1a1
+#define XK_breve 0x1a2
+#define XK_Lstroke 0x1a3
+#define XK_Lcaron 0x1a5
+#define XK_Sacute 0x1a6
+#define XK_Scaron 0x1a9
+#define XK_Scedilla 0x1aa
+#define XK_Tcaron 0x1ab
+#define XK_Zacute 0x1ac
+#define XK_Zcaron 0x1ae
+#define XK_Zabovedot 0x1af
+#define XK_aogonek 0x1b1
+#define XK_ogonek 0x1b2
+#define XK_lstroke 0x1b3
+#define XK_lcaron 0x1b5
+#define XK_sacute 0x1b6
+#define XK_caron 0x1b7
+#define XK_scaron 0x1b9
+#define XK_scedilla 0x1ba
+#define XK_tcaron 0x1bb
+#define XK_zacute 0x1bc
+#define XK_doubleacute 0x1bd
+#define XK_zcaron 0x1be
+#define XK_zabovedot 0x1bf
+#define XK_Racute 0x1c0
+#define XK_Abreve 0x1c3
+#define XK_Lacute 0x1c5
+#define XK_Cacute 0x1c6
+#define XK_Ccaron 0x1c8
+#define XK_Eogonek 0x1ca
+#define XK_Ecaron 0x1cc
+#define XK_Dcaron 0x1cf
+#define XK_Dstroke 0x1d0
+#define XK_Nacute 0x1d1
+#define XK_Ncaron 0x1d2
+#define XK_Odoubleacute 0x1d5
+#define XK_Rcaron 0x1d8
+#define XK_Uring 0x1d9
+#define XK_Udoubleacute 0x1db
+#define XK_Tcedilla 0x1de
+#define XK_racute 0x1e0
+#define XK_abreve 0x1e3
+#define XK_lacute 0x1e5
+#define XK_cacute 0x1e6
+#define XK_ccaron 0x1e8
+#define XK_eogonek 0x1ea
+#define XK_ecaron 0x1ec
+#define XK_dcaron 0x1ef
+#define XK_dstroke 0x1f0
+#define XK_nacute 0x1f1
+#define XK_ncaron 0x1f2
+#define XK_odoubleacute 0x1f5
+#define XK_udoubleacute 0x1fb
+#define XK_rcaron 0x1f8
+#define XK_uring 0x1f9
+#define XK_tcedilla 0x1fe
+#define XK_abovedot 0x1ff
+#endif /* XK_LATIN2 */
+
+/*
+ * Latin 3
+ * Byte 3 = 2
+ */
+
+#ifdef XK_LATIN3
+#define XK_Hstroke 0x2a1
+#define XK_Hcircumflex 0x2a6
+#define XK_Iabovedot 0x2a9
+#define XK_Gbreve 0x2ab
+#define XK_Jcircumflex 0x2ac
+#define XK_hstroke 0x2b1
+#define XK_hcircumflex 0x2b6
+#define XK_idotless 0x2b9
+#define XK_gbreve 0x2bb
+#define XK_jcircumflex 0x2bc
+#define XK_Cabovedot 0x2c5
+#define XK_Ccircumflex 0x2c6
+#define XK_Gabovedot 0x2d5
+#define XK_Gcircumflex 0x2d8
+#define XK_Ubreve 0x2dd
+#define XK_Scircumflex 0x2de
+#define XK_cabovedot 0x2e5
+#define XK_ccircumflex 0x2e6
+#define XK_gabovedot 0x2f5
+#define XK_gcircumflex 0x2f8
+#define XK_ubreve 0x2fd
+#define XK_scircumflex 0x2fe
+#endif /* XK_LATIN3 */
+
+
+/*
+ * Latin 4
+ * Byte 3 = 3
+ */
+
+#ifdef XK_LATIN4
+#define XK_kra 0x3a2
+#define XK_kappa 0x3a2 /* deprecated */
+#define XK_Rcedilla 0x3a3
+#define XK_Itilde 0x3a5
+#define XK_Lcedilla 0x3a6
+#define XK_Emacron 0x3aa
+#define XK_Gcedilla 0x3ab
+#define XK_Tslash 0x3ac
+#define XK_rcedilla 0x3b3
+#define XK_itilde 0x3b5
+#define XK_lcedilla 0x3b6
+#define XK_emacron 0x3ba
+#define XK_gcedilla 0x3bb
+#define XK_tslash 0x3bc
+#define XK_ENG 0x3bd
+#define XK_eng 0x3bf
+#define XK_Amacron 0x3c0
+#define XK_Iogonek 0x3c7
+#define XK_Eabovedot 0x3cc
+#define XK_Imacron 0x3cf
+#define XK_Ncedilla 0x3d1
+#define XK_Omacron 0x3d2
+#define XK_Kcedilla 0x3d3
+#define XK_Uogonek 0x3d9
+#define XK_Utilde 0x3dd
+#define XK_Umacron 0x3de
+#define XK_amacron 0x3e0
+#define XK_iogonek 0x3e7
+#define XK_eabovedot 0x3ec
+#define XK_imacron 0x3ef
+#define XK_ncedilla 0x3f1
+#define XK_omacron 0x3f2
+#define XK_kcedilla 0x3f3
+#define XK_uogonek 0x3f9
+#define XK_utilde 0x3fd
+#define XK_umacron 0x3fe
+#endif /* XK_LATIN4 */
+
+/*
+ * Katakana
+ * Byte 3 = 4
+ */
+
+#ifdef XK_KATAKANA
+#define XK_overline 0x47e
+#define XK_kana_fullstop 0x4a1
+#define XK_kana_openingbracket 0x4a2
+#define XK_kana_closingbracket 0x4a3
+#define XK_kana_comma 0x4a4
+#define XK_kana_conjunctive 0x4a5
+#define XK_kana_middledot 0x4a5 /* deprecated */
+#define XK_kana_WO 0x4a6
+#define XK_kana_a 0x4a7
+#define XK_kana_i 0x4a8
+#define XK_kana_u 0x4a9
+#define XK_kana_e 0x4aa
+#define XK_kana_o 0x4ab
+#define XK_kana_ya 0x4ac
+#define XK_kana_yu 0x4ad
+#define XK_kana_yo 0x4ae
+#define XK_kana_tsu 0x4af
+#define XK_kana_tu 0x4af /* deprecated */
+#define XK_prolongedsound 0x4b0
+#define XK_kana_A 0x4b1
+#define XK_kana_I 0x4b2
+#define XK_kana_U 0x4b3
+#define XK_kana_E 0x4b4
+#define XK_kana_O 0x4b5
+#define XK_kana_KA 0x4b6
+#define XK_kana_KI 0x4b7
+#define XK_kana_KU 0x4b8
+#define XK_kana_KE 0x4b9
+#define XK_kana_KO 0x4ba
+#define XK_kana_SA 0x4bb
+#define XK_kana_SHI 0x4bc
+#define XK_kana_SU 0x4bd
+#define XK_kana_SE 0x4be
+#define XK_kana_SO 0x4bf
+#define XK_kana_TA 0x4c0
+#define XK_kana_CHI 0x4c1
+#define XK_kana_TI 0x4c1 /* deprecated */
+#define XK_kana_TSU 0x4c2
+#define XK_kana_TU 0x4c2 /* deprecated */
+#define XK_kana_TE 0x4c3
+#define XK_kana_TO 0x4c4
+#define XK_kana_NA 0x4c5
+#define XK_kana_NI 0x4c6
+#define XK_kana_NU 0x4c7
+#define XK_kana_NE 0x4c8
+#define XK_kana_NO 0x4c9
+#define XK_kana_HA 0x4ca
+#define XK_kana_HI 0x4cb
+#define XK_kana_FU 0x4cc
+#define XK_kana_HU 0x4cc /* deprecated */
+#define XK_kana_HE 0x4cd
+#define XK_kana_HO 0x4ce
+#define XK_kana_MA 0x4cf
+#define XK_kana_MI 0x4d0
+#define XK_kana_MU 0x4d1
+#define XK_kana_ME 0x4d2
+#define XK_kana_MO 0x4d3
+#define XK_kana_YA 0x4d4
+#define XK_kana_YU 0x4d5
+#define XK_kana_YO 0x4d6
+#define XK_kana_RA 0x4d7
+#define XK_kana_RI 0x4d8
+#define XK_kana_RU 0x4d9
+#define XK_kana_RE 0x4da
+#define XK_kana_RO 0x4db
+#define XK_kana_WA 0x4dc
+#define XK_kana_N 0x4dd
+#define XK_voicedsound 0x4de
+#define XK_semivoicedsound 0x4df
+#define XK_kana_switch 0xFF7E /* Alias for mode_switch */
+#endif /* XK_KATAKANA */
+
+/*
+ * Arabic
+ * Byte 3 = 5
+ */
+
+#ifdef XK_ARABIC
+#define XK_Arabic_comma 0x5ac
+#define XK_Arabic_semicolon 0x5bb
+#define XK_Arabic_question_mark 0x5bf
+#define XK_Arabic_hamza 0x5c1
+#define XK_Arabic_maddaonalef 0x5c2
+#define XK_Arabic_hamzaonalef 0x5c3
+#define XK_Arabic_hamzaonwaw 0x5c4
+#define XK_Arabic_hamzaunderalef 0x5c5
+#define XK_Arabic_hamzaonyeh 0x5c6
+#define XK_Arabic_alef 0x5c7
+#define XK_Arabic_beh 0x5c8
+#define XK_Arabic_tehmarbuta 0x5c9
+#define XK_Arabic_teh 0x5ca
+#define XK_Arabic_theh 0x5cb
+#define XK_Arabic_jeem 0x5cc
+#define XK_Arabic_hah 0x5cd
+#define XK_Arabic_khah 0x5ce
+#define XK_Arabic_dal 0x5cf
+#define XK_Arabic_thal 0x5d0
+#define XK_Arabic_ra 0x5d1
+#define XK_Arabic_zain 0x5d2
+#define XK_Arabic_seen 0x5d3
+#define XK_Arabic_sheen 0x5d4
+#define XK_Arabic_sad 0x5d5
+#define XK_Arabic_dad 0x5d6
+#define XK_Arabic_tah 0x5d7
+#define XK_Arabic_zah 0x5d8
+#define XK_Arabic_ain 0x5d9
+#define XK_Arabic_ghain 0x5da
+#define XK_Arabic_tatweel 0x5e0
+#define XK_Arabic_feh 0x5e1
+#define XK_Arabic_qaf 0x5e2
+#define XK_Arabic_kaf 0x5e3
+#define XK_Arabic_lam 0x5e4
+#define XK_Arabic_meem 0x5e5
+#define XK_Arabic_noon 0x5e6
+#define XK_Arabic_ha 0x5e7
+#define XK_Arabic_heh 0x5e7 /* deprecated */
+#define XK_Arabic_waw 0x5e8
+#define XK_Arabic_alefmaksura 0x5e9
+#define XK_Arabic_yeh 0x5ea
+#define XK_Arabic_fathatan 0x5eb
+#define XK_Arabic_dammatan 0x5ec
+#define XK_Arabic_kasratan 0x5ed
+#define XK_Arabic_fatha 0x5ee
+#define XK_Arabic_damma 0x5ef
+#define XK_Arabic_kasra 0x5f0
+#define XK_Arabic_shadda 0x5f1
+#define XK_Arabic_sukun 0x5f2
+#define XK_Arabic_switch 0xFF7E /* Alias for mode_switch */
+#endif /* XK_ARABIC */
+
+/*
+ * Cyrillic
+ * Byte 3 = 6
+ */
+#ifdef XK_CYRILLIC
+#define XK_Serbian_dje 0x6a1
+#define XK_Macedonia_gje 0x6a2
+#define XK_Cyrillic_io 0x6a3
+#define XK_Ukrainian_ie 0x6a4
+#define XK_Ukranian_je 0x6a4 /* deprecated */
+#define XK_Macedonia_dse 0x6a5
+#define XK_Ukrainian_i 0x6a6
+#define XK_Ukranian_i 0x6a6 /* deprecated */
+#define XK_Ukrainian_yi 0x6a7
+#define XK_Ukranian_yi 0x6a7 /* deprecated */
+#define XK_Cyrillic_je 0x6a8
+#define XK_Serbian_je 0x6a8 /* deprecated */
+#define XK_Cyrillic_lje 0x6a9
+#define XK_Serbian_lje 0x6a9 /* deprecated */
+#define XK_Cyrillic_nje 0x6aa
+#define XK_Serbian_nje 0x6aa /* deprecated */
+#define XK_Serbian_tshe 0x6ab
+#define XK_Macedonia_kje 0x6ac
+#define XK_Byelorussian_shortu 0x6ae
+#define XK_Cyrillic_dzhe 0x6af
+#define XK_Serbian_dze 0x6af /* deprecated */
+#define XK_numerosign 0x6b0
+#define XK_Serbian_DJE 0x6b1
+#define XK_Macedonia_GJE 0x6b2
+#define XK_Cyrillic_IO 0x6b3
+#define XK_Ukrainian_IE 0x6b4
+#define XK_Ukranian_JE 0x6b4 /* deprecated */
+#define XK_Macedonia_DSE 0x6b5
+#define XK_Ukrainian_I 0x6b6
+#define XK_Ukranian_I 0x6b6 /* deprecated */
+#define XK_Ukrainian_YI 0x6b7
+#define XK_Ukranian_YI 0x6b7 /* deprecated */
+#define XK_Cyrillic_JE 0x6b8
+#define XK_Serbian_JE 0x6b8 /* deprecated */
+#define XK_Cyrillic_LJE 0x6b9
+#define XK_Serbian_LJE 0x6b9 /* deprecated */
+#define XK_Cyrillic_NJE 0x6ba
+#define XK_Serbian_NJE 0x6ba /* deprecated */
+#define XK_Serbian_TSHE 0x6bb
+#define XK_Macedonia_KJE 0x6bc
+#define XK_Byelorussian_SHORTU 0x6be
+#define XK_Cyrillic_DZHE 0x6bf
+#define XK_Serbian_DZE 0x6bf /* deprecated */
+#define XK_Cyrillic_yu 0x6c0
+#define XK_Cyrillic_a 0x6c1
+#define XK_Cyrillic_be 0x6c2
+#define XK_Cyrillic_tse 0x6c3
+#define XK_Cyrillic_de 0x6c4
+#define XK_Cyrillic_ie 0x6c5
+#define XK_Cyrillic_ef 0x6c6
+#define XK_Cyrillic_ghe 0x6c7
+#define XK_Cyrillic_ha 0x6c8
+#define XK_Cyrillic_i 0x6c9
+#define XK_Cyrillic_shorti 0x6ca
+#define XK_Cyrillic_ka 0x6cb
+#define XK_Cyrillic_el 0x6cc
+#define XK_Cyrillic_em 0x6cd
+#define XK_Cyrillic_en 0x6ce
+#define XK_Cyrillic_o 0x6cf
+#define XK_Cyrillic_pe 0x6d0
+#define XK_Cyrillic_ya 0x6d1
+#define XK_Cyrillic_er 0x6d2
+#define XK_Cyrillic_es 0x6d3
+#define XK_Cyrillic_te 0x6d4
+#define XK_Cyrillic_u 0x6d5
+#define XK_Cyrillic_zhe 0x6d6
+#define XK_Cyrillic_ve 0x6d7
+#define XK_Cyrillic_softsign 0x6d8
+#define XK_Cyrillic_yeru 0x6d9
+#define XK_Cyrillic_ze 0x6da
+#define XK_Cyrillic_sha 0x6db
+#define XK_Cyrillic_e 0x6dc
+#define XK_Cyrillic_shcha 0x6dd
+#define XK_Cyrillic_che 0x6de
+#define XK_Cyrillic_hardsign 0x6df
+#define XK_Cyrillic_YU 0x6e0
+#define XK_Cyrillic_A 0x6e1
+#define XK_Cyrillic_BE 0x6e2
+#define XK_Cyrillic_TSE 0x6e3
+#define XK_Cyrillic_DE 0x6e4
+#define XK_Cyrillic_IE 0x6e5
+#define XK_Cyrillic_EF 0x6e6
+#define XK_Cyrillic_GHE 0x6e7
+#define XK_Cyrillic_HA 0x6e8
+#define XK_Cyrillic_I 0x6e9
+#define XK_Cyrillic_SHORTI 0x6ea
+#define XK_Cyrillic_KA 0x6eb
+#define XK_Cyrillic_EL 0x6ec
+#define XK_Cyrillic_EM 0x6ed
+#define XK_Cyrillic_EN 0x6ee
+#define XK_Cyrillic_O 0x6ef
+#define XK_Cyrillic_PE 0x6f0
+#define XK_Cyrillic_YA 0x6f1
+#define XK_Cyrillic_ER 0x6f2
+#define XK_Cyrillic_ES 0x6f3
+#define XK_Cyrillic_TE 0x6f4
+#define XK_Cyrillic_U 0x6f5
+#define XK_Cyrillic_ZHE 0x6f6
+#define XK_Cyrillic_VE 0x6f7
+#define XK_Cyrillic_SOFTSIGN 0x6f8
+#define XK_Cyrillic_YERU 0x6f9
+#define XK_Cyrillic_ZE 0x6fa
+#define XK_Cyrillic_SHA 0x6fb
+#define XK_Cyrillic_E 0x6fc
+#define XK_Cyrillic_SHCHA 0x6fd
+#define XK_Cyrillic_CHE 0x6fe
+#define XK_Cyrillic_HARDSIGN 0x6ff
+#endif /* XK_CYRILLIC */
+
+/*
+ * Greek
+ * Byte 3 = 7
+ */
+
+#ifdef XK_GREEK
+#define XK_Greek_ALPHAaccent 0x7a1
+#define XK_Greek_EPSILONaccent 0x7a2
+#define XK_Greek_ETAaccent 0x7a3
+#define XK_Greek_IOTAaccent 0x7a4
+#define XK_Greek_IOTAdiaeresis 0x7a5
+#define XK_Greek_OMICRONaccent 0x7a7
+#define XK_Greek_UPSILONaccent 0x7a8
+#define XK_Greek_UPSILONdieresis 0x7a9
+#define XK_Greek_OMEGAaccent 0x7ab
+#define XK_Greek_accentdieresis 0x7ae
+#define XK_Greek_horizbar 0x7af
+#define XK_Greek_alphaaccent 0x7b1
+#define XK_Greek_epsilonaccent 0x7b2
+#define XK_Greek_etaaccent 0x7b3
+#define XK_Greek_iotaaccent 0x7b4
+#define XK_Greek_iotadieresis 0x7b5
+#define XK_Greek_iotaaccentdieresis 0x7b6
+#define XK_Greek_omicronaccent 0x7b7
+#define XK_Greek_upsilonaccent 0x7b8
+#define XK_Greek_upsilondieresis 0x7b9
+#define XK_Greek_upsilonaccentdieresis 0x7ba
+#define XK_Greek_omegaaccent 0x7bb
+#define XK_Greek_ALPHA 0x7c1
+#define XK_Greek_BETA 0x7c2
+#define XK_Greek_GAMMA 0x7c3
+#define XK_Greek_DELTA 0x7c4
+#define XK_Greek_EPSILON 0x7c5
+#define XK_Greek_ZETA 0x7c6
+#define XK_Greek_ETA 0x7c7
+#define XK_Greek_THETA 0x7c8
+#define XK_Greek_IOTA 0x7c9
+#define XK_Greek_KAPPA 0x7ca
+#define XK_Greek_LAMDA 0x7cb
+#define XK_Greek_LAMBDA 0x7cb
+#define XK_Greek_MU 0x7cc
+#define XK_Greek_NU 0x7cd
+#define XK_Greek_XI 0x7ce
+#define XK_Greek_OMICRON 0x7cf
+#define XK_Greek_PI 0x7d0
+#define XK_Greek_RHO 0x7d1
+#define XK_Greek_SIGMA 0x7d2
+#define XK_Greek_TAU 0x7d4
+#define XK_Greek_UPSILON 0x7d5
+#define XK_Greek_PHI 0x7d6
+#define XK_Greek_CHI 0x7d7
+#define XK_Greek_PSI 0x7d8
+#define XK_Greek_OMEGA 0x7d9
+#define XK_Greek_alpha 0x7e1
+#define XK_Greek_beta 0x7e2
+#define XK_Greek_gamma 0x7e3
+#define XK_Greek_delta 0x7e4
+#define XK_Greek_epsilon 0x7e5
+#define XK_Greek_zeta 0x7e6
+#define XK_Greek_eta 0x7e7
+#define XK_Greek_theta 0x7e8
+#define XK_Greek_iota 0x7e9
+#define XK_Greek_kappa 0x7ea
+#define XK_Greek_lamda 0x7eb
+#define XK_Greek_lambda 0x7eb
+#define XK_Greek_mu 0x7ec
+#define XK_Greek_nu 0x7ed
+#define XK_Greek_xi 0x7ee
+#define XK_Greek_omicron 0x7ef
+#define XK_Greek_pi 0x7f0
+#define XK_Greek_rho 0x7f1
+#define XK_Greek_sigma 0x7f2
+#define XK_Greek_finalsmallsigma 0x7f3
+#define XK_Greek_tau 0x7f4
+#define XK_Greek_upsilon 0x7f5
+#define XK_Greek_phi 0x7f6
+#define XK_Greek_chi 0x7f7
+#define XK_Greek_psi 0x7f8
+#define XK_Greek_omega 0x7f9
+#define XK_Greek_switch 0xFF7E /* Alias for mode_switch */
+#endif /* XK_GREEK */
+
+/*
+ * Technical
+ * Byte 3 = 8
+ */
+
+#ifdef XK_TECHNICAL
+#define XK_leftradical 0x8a1
+#define XK_topleftradical 0x8a2
+#define XK_horizconnector 0x8a3
+#define XK_topintegral 0x8a4
+#define XK_botintegral 0x8a5
+#define XK_vertconnector 0x8a6
+#define XK_topleftsqbracket 0x8a7
+#define XK_botleftsqbracket 0x8a8
+#define XK_toprightsqbracket 0x8a9
+#define XK_botrightsqbracket 0x8aa
+#define XK_topleftparens 0x8ab
+#define XK_botleftparens 0x8ac
+#define XK_toprightparens 0x8ad
+#define XK_botrightparens 0x8ae
+#define XK_leftmiddlecurlybrace 0x8af
+#define XK_rightmiddlecurlybrace 0x8b0
+#define XK_topleftsummation 0x8b1
+#define XK_botleftsummation 0x8b2
+#define XK_topvertsummationconnector 0x8b3
+#define XK_botvertsummationconnector 0x8b4
+#define XK_toprightsummation 0x8b5
+#define XK_botrightsummation 0x8b6
+#define XK_rightmiddlesummation 0x8b7
+#define XK_lessthanequal 0x8bc
+#define XK_notequal 0x8bd
+#define XK_greaterthanequal 0x8be
+#define XK_integral 0x8bf
+#define XK_therefore 0x8c0
+#define XK_variation 0x8c1
+#define XK_infinity 0x8c2
+#define XK_nabla 0x8c5
+#define XK_approximate 0x8c8
+#define XK_similarequal 0x8c9
+#define XK_ifonlyif 0x8cd
+#define XK_implies 0x8ce
+#define XK_identical 0x8cf
+#define XK_radical 0x8d6
+#define XK_includedin 0x8da
+#define XK_includes 0x8db
+#define XK_intersection 0x8dc
+#define XK_union 0x8dd
+#define XK_logicaland 0x8de
+#define XK_logicalor 0x8df
+#define XK_partialderivative 0x8ef
+#define XK_function 0x8f6
+#define XK_leftarrow 0x8fb
+#define XK_uparrow 0x8fc
+#define XK_rightarrow 0x8fd
+#define XK_downarrow 0x8fe
+#endif /* XK_TECHNICAL */
+
+/*
+ * Special
+ * Byte 3 = 9
+ */
+
+#ifdef XK_SPECIAL
+#define XK_blank 0x9df
+#define XK_soliddiamond 0x9e0
+#define XK_checkerboard 0x9e1
+#define XK_ht 0x9e2
+#define XK_ff 0x9e3
+#define XK_cr 0x9e4
+#define XK_lf 0x9e5
+#define XK_nl 0x9e8
+#define XK_vt 0x9e9
+#define XK_lowrightcorner 0x9ea
+#define XK_uprightcorner 0x9eb
+#define XK_upleftcorner 0x9ec
+#define XK_lowleftcorner 0x9ed
+#define XK_crossinglines 0x9ee
+#define XK_horizlinescan1 0x9ef
+#define XK_horizlinescan3 0x9f0
+#define XK_horizlinescan5 0x9f1
+#define XK_horizlinescan7 0x9f2
+#define XK_horizlinescan9 0x9f3
+#define XK_leftt 0x9f4
+#define XK_rightt 0x9f5
+#define XK_bott 0x9f6
+#define XK_topt 0x9f7
+#define XK_vertbar 0x9f8
+#endif /* XK_SPECIAL */
+
+/*
+ * Publishing
+ * Byte 3 = a
+ */
+
+#ifdef XK_PUBLISHING
+#define XK_emspace 0xaa1
+#define XK_enspace 0xaa2
+#define XK_em3space 0xaa3
+#define XK_em4space 0xaa4
+#define XK_digitspace 0xaa5
+#define XK_punctspace 0xaa6
+#define XK_thinspace 0xaa7
+#define XK_hairspace 0xaa8
+#define XK_emdash 0xaa9
+#define XK_endash 0xaaa
+#define XK_signifblank 0xaac
+#define XK_ellipsis 0xaae
+#define XK_doubbaselinedot 0xaaf
+#define XK_onethird 0xab0
+#define XK_twothirds 0xab1
+#define XK_onefifth 0xab2
+#define XK_twofifths 0xab3
+#define XK_threefifths 0xab4
+#define XK_fourfifths 0xab5
+#define XK_onesixth 0xab6
+#define XK_fivesixths 0xab7
+#define XK_careof 0xab8
+#define XK_figdash 0xabb
+#define XK_leftanglebracket 0xabc
+#define XK_decimalpoint 0xabd
+#define XK_rightanglebracket 0xabe
+#define XK_marker 0xabf
+#define XK_oneeighth 0xac3
+#define XK_threeeighths 0xac4
+#define XK_fiveeighths 0xac5
+#define XK_seveneighths 0xac6
+#define XK_trademark 0xac9
+#define XK_signaturemark 0xaca
+#define XK_trademarkincircle 0xacb
+#define XK_leftopentriangle 0xacc
+#define XK_rightopentriangle 0xacd
+#define XK_emopencircle 0xace
+#define XK_emopenrectangle 0xacf
+#define XK_leftsinglequotemark 0xad0
+#define XK_rightsinglequotemark 0xad1
+#define XK_leftdoublequotemark 0xad2
+#define XK_rightdoublequotemark 0xad3
+#define XK_prescription 0xad4
+#define XK_minutes 0xad6
+#define XK_seconds 0xad7
+#define XK_latincross 0xad9
+#define XK_hexagram 0xada
+#define XK_filledrectbullet 0xadb
+#define XK_filledlefttribullet 0xadc
+#define XK_filledrighttribullet 0xadd
+#define XK_emfilledcircle 0xade
+#define XK_emfilledrect 0xadf
+#define XK_enopencircbullet 0xae0
+#define XK_enopensquarebullet 0xae1
+#define XK_openrectbullet 0xae2
+#define XK_opentribulletup 0xae3
+#define XK_opentribulletdown 0xae4
+#define XK_openstar 0xae5
+#define XK_enfilledcircbullet 0xae6
+#define XK_enfilledsqbullet 0xae7
+#define XK_filledtribulletup 0xae8
+#define XK_filledtribulletdown 0xae9
+#define XK_leftpointer 0xaea
+#define XK_rightpointer 0xaeb
+#define XK_club 0xaec
+#define XK_diamond 0xaed
+#define XK_heart 0xaee
+#define XK_maltesecross 0xaf0
+#define XK_dagger 0xaf1
+#define XK_doubledagger 0xaf2
+#define XK_checkmark 0xaf3
+#define XK_ballotcross 0xaf4
+#define XK_musicalsharp 0xaf5
+#define XK_musicalflat 0xaf6
+#define XK_malesymbol 0xaf7
+#define XK_femalesymbol 0xaf8
+#define XK_telephone 0xaf9
+#define XK_telephonerecorder 0xafa
+#define XK_phonographcopyright 0xafb
+#define XK_caret 0xafc
+#define XK_singlelowquotemark 0xafd
+#define XK_doublelowquotemark 0xafe
+#define XK_cursor 0xaff
+#endif /* XK_PUBLISHING */
+
+/*
+ * APL
+ * Byte 3 = b
+ */
+
+#ifdef XK_APL
+#define XK_leftcaret 0xba3
+#define XK_rightcaret 0xba6
+#define XK_downcaret 0xba8
+#define XK_upcaret 0xba9
+#define XK_overbar 0xbc0
+#define XK_downtack 0xbc2
+#define XK_upshoe 0xbc3
+#define XK_downstile 0xbc4
+#define XK_underbar 0xbc6
+#define XK_jot 0xbca
+#define XK_quad 0xbcc
+#define XK_uptack 0xbce
+#define XK_circle 0xbcf
+#define XK_upstile 0xbd3
+#define XK_downshoe 0xbd6
+#define XK_rightshoe 0xbd8
+#define XK_leftshoe 0xbda
+#define XK_lefttack 0xbdc
+#define XK_righttack 0xbfc
+#endif /* XK_APL */
+
+/*
+ * Hebrew
+ * Byte 3 = c
+ */
+
+#ifdef XK_HEBREW
+#define XK_hebrew_doublelowline 0xcdf
+#define XK_hebrew_aleph 0xce0
+#define XK_hebrew_bet 0xce1
+#define XK_hebrew_beth 0xce1 /* deprecated */
+#define XK_hebrew_gimel 0xce2
+#define XK_hebrew_gimmel 0xce2 /* deprecated */
+#define XK_hebrew_dalet 0xce3
+#define XK_hebrew_daleth 0xce3 /* deprecated */
+#define XK_hebrew_he 0xce4
+#define XK_hebrew_waw 0xce5
+#define XK_hebrew_zain 0xce6
+#define XK_hebrew_zayin 0xce6 /* deprecated */
+#define XK_hebrew_chet 0xce7
+#define XK_hebrew_het 0xce7 /* deprecated */
+#define XK_hebrew_tet 0xce8
+#define XK_hebrew_teth 0xce8 /* deprecated */
+#define XK_hebrew_yod 0xce9
+#define XK_hebrew_finalkaph 0xcea
+#define XK_hebrew_kaph 0xceb
+#define XK_hebrew_lamed 0xcec
+#define XK_hebrew_finalmem 0xced
+#define XK_hebrew_mem 0xcee
+#define XK_hebrew_finalnun 0xcef
+#define XK_hebrew_nun 0xcf0
+#define XK_hebrew_samech 0xcf1
+#define XK_hebrew_samekh 0xcf1 /* deprecated */
+#define XK_hebrew_ayin 0xcf2
+#define XK_hebrew_finalpe 0xcf3
+#define XK_hebrew_pe 0xcf4
+#define XK_hebrew_finalzade 0xcf5
+#define XK_hebrew_finalzadi 0xcf5 /* deprecated */
+#define XK_hebrew_zade 0xcf6
+#define XK_hebrew_zadi 0xcf6 /* deprecated */
+#define XK_hebrew_qoph 0xcf7
+#define XK_hebrew_kuf 0xcf7 /* deprecated */
+#define XK_hebrew_resh 0xcf8
+#define XK_hebrew_shin 0xcf9
+#define XK_hebrew_taw 0xcfa
+#define XK_hebrew_taf 0xcfa /* deprecated */
+#define XK_Hebrew_switch 0xFF7E /* Alias for mode_switch */
+#endif /* XK_HEBREW */
+
diff --git a/tk/xlib/X11/license.terms b/tk/xlib/X11/license.terms
new file mode 100644
index 00000000000..03ca6fcb319
--- /dev/null
+++ b/tk/xlib/X11/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., and other parties. The following
+terms apply to all files associated with the software unless explicitly
+disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
diff --git a/tk/xlib/license.terms b/tk/xlib/license.terms
new file mode 100644
index 00000000000..03ca6fcb319
--- /dev/null
+++ b/tk/xlib/license.terms
@@ -0,0 +1,39 @@
+This software is copyrighted by the Regents of the University of
+California, Sun Microsystems, Inc., and other parties. The following
+terms apply to all files associated with the software unless explicitly
+disclaimed in individual files.
+
+The authors hereby grant permission to use, copy, modify, distribute,
+and license this software and its documentation for any purpose, provided
+that existing copyright notices are retained in all copies and that this
+notice is included verbatim in any distributions. No written agreement,
+license, or royalty fee is required for any of the authorized uses.
+Modifications to this software may be copyrighted by their authors
+and need not follow the licensing terms described here, provided that
+the new terms are clearly indicated on the first page of each file where
+they apply.
+
+IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
+FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
+ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
+DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
+POSSIBILITY OF SUCH DAMAGE.
+
+THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
+INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
+IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
+NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
+MODIFICATIONS.
+
+GOVERNMENT USE: If you are acquiring this software on behalf of the
+U.S. government, the Government shall have only "Restricted Rights"
+in the software and related documentation as defined in the Federal
+Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you
+are acquiring the software on behalf of the Department of Defense, the
+software shall be classified as "Commercial Computer Software" and the
+Government shall have only "Restricted Rights" as defined in Clause
+252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the
+authors grant the U.S. Government and others acting in its behalf
+permission to use and distribute the software in accordance with the
+terms specified in this license.
diff --git a/tk/xlib/xbytes.h b/tk/xlib/xbytes.h
new file mode 100644
index 00000000000..fb2ee851c43
--- /dev/null
+++ b/tk/xlib/xbytes.h
@@ -0,0 +1,58 @@
+/*
+ * 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$
+ */
+
+#ifndef _XBYTES
+#define _XBYTES
+
+/*
+ * The bits in a byte can be reversed so the least significant becomes
+ * the most significant by indexing xBitReverseTable with the byte
+ * to be reversed.
+ */
+
+static unsigned char xBitReverseTable[256] = {
+ 0x00, 0x80, 0x40, 0xc0, 0x20, 0xa0, 0x60, 0xe0,
+ 0x10, 0x90, 0x50, 0xd0, 0x30, 0xb0, 0x70, 0xf0,
+ 0x08, 0x88, 0x48, 0xc8, 0x28, 0xa8, 0x68, 0xe8,
+ 0x18, 0x98, 0x58, 0xd8, 0x38, 0xb8, 0x78, 0xf8,
+ 0x04, 0x84, 0x44, 0xc4, 0x24, 0xa4, 0x64, 0xe4,
+ 0x14, 0x94, 0x54, 0xd4, 0x34, 0xb4, 0x74, 0xf4,
+ 0x0c, 0x8c, 0x4c, 0xcc, 0x2c, 0xac, 0x6c, 0xec,
+ 0x1c, 0x9c, 0x5c, 0xdc, 0x3c, 0xbc, 0x7c, 0xfc,
+ 0x02, 0x82, 0x42, 0xc2, 0x22, 0xa2, 0x62, 0xe2,
+ 0x12, 0x92, 0x52, 0xd2, 0x32, 0xb2, 0x72, 0xf2,
+ 0x0a, 0x8a, 0x4a, 0xca, 0x2a, 0xaa, 0x6a, 0xea,
+ 0x1a, 0x9a, 0x5a, 0xda, 0x3a, 0xba, 0x7a, 0xfa,
+ 0x06, 0x86, 0x46, 0xc6, 0x26, 0xa6, 0x66, 0xe6,
+ 0x16, 0x96, 0x56, 0xd6, 0x36, 0xb6, 0x76, 0xf6,
+ 0x0e, 0x8e, 0x4e, 0xce, 0x2e, 0xae, 0x6e, 0xee,
+ 0x1e, 0x9e, 0x5e, 0xde, 0x3e, 0xbe, 0x7e, 0xfe,
+ 0x01, 0x81, 0x41, 0xc1, 0x21, 0xa1, 0x61, 0xe1,
+ 0x11, 0x91, 0x51, 0xd1, 0x31, 0xb1, 0x71, 0xf1,
+ 0x09, 0x89, 0x49, 0xc9, 0x29, 0xa9, 0x69, 0xe9,
+ 0x19, 0x99, 0x59, 0xd9, 0x39, 0xb9, 0x79, 0xf9,
+ 0x05, 0x85, 0x45, 0xc5, 0x25, 0xa5, 0x65, 0xe5,
+ 0x15, 0x95, 0x55, 0xd5, 0x35, 0xb5, 0x75, 0xf5,
+ 0x0d, 0x8d, 0x4d, 0xcd, 0x2d, 0xad, 0x6d, 0xed,
+ 0x1d, 0x9d, 0x5d, 0xdd, 0x3d, 0xbd, 0x7d, 0xfd,
+ 0x03, 0x83, 0x43, 0xc3, 0x23, 0xa3, 0x63, 0xe3,
+ 0x13, 0x93, 0x53, 0xd3, 0x33, 0xb3, 0x73, 0xf3,
+ 0x0b, 0x8b, 0x4b, 0xcb, 0x2b, 0xab, 0x6b, 0xeb,
+ 0x1b, 0x9b, 0x5b, 0xdb, 0x3b, 0xbb, 0x7b, 0xfb,
+ 0x07, 0x87, 0x47, 0xc7, 0x27, 0xa7, 0x67, 0xe7,
+ 0x17, 0x97, 0x57, 0xd7, 0x37, 0xb7, 0x77, 0xf7,
+ 0x0f, 0x8f, 0x4f, 0xcf, 0x2f, 0xaf, 0x6f, 0xef,
+ 0x1f, 0x9f, 0x5f, 0xdf, 0x3f, 0xbf, 0x7f, 0xff,
+};
+
+#endif /* _XBYTES */
diff --git a/tk/xlib/xcolors.c b/tk/xlib/xcolors.c
new file mode 100644
index 00000000000..5335c54cfdb
--- /dev/null
+++ b/tk/xlib/xcolors.c
@@ -0,0 +1,911 @@
+/*
+ * 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$
+ */
+
+#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
+ * binary search used in XParseColor will succeed.
+ */
+
+typedef struct {
+ char *name;
+ unsigned char red;
+ unsigned char green;
+ unsigned char blue;
+} XColorEntry;
+
+static XColorEntry xColors[] = {
+ "alice blue", 240, 248, 255,
+ "AliceBlue", 240, 248, 255,
+ "antique white", 250, 235, 215,
+ "AntiqueWhite", 250, 235, 215,
+ "AntiqueWhite1", 255, 239, 219,
+ "AntiqueWhite2", 238, 223, 204,
+ "AntiqueWhite3", 205, 192, 176,
+ "AntiqueWhite4", 139, 131, 120,
+ "aquamarine", 127, 255, 212,
+ "aquamarine1", 127, 255, 212,
+ "aquamarine2", 118, 238, 198,
+ "aquamarine3", 102, 205, 170,
+ "aquamarine4", 69, 139, 116,
+ "azure", 240, 255, 255,
+ "azure1", 240, 255, 255,
+ "azure2", 224, 238, 238,
+ "azure3", 193, 205, 205,
+ "azure4", 131, 139, 139,
+ "beige", 245, 245, 220,
+ "bisque", 255, 228, 196,
+ "bisque1", 255, 228, 196,
+ "bisque2", 238, 213, 183,
+ "bisque3", 205, 183, 158,
+ "bisque4", 139, 125, 107,
+ "black", 0, 0, 0,
+ "blanched almond", 255, 235, 205,
+ "BlanchedAlmond", 255, 235, 205,
+ "blue", 0, 0, 255,
+ "blue violet", 138, 43, 226,
+ "blue1", 0, 0, 255,
+ "blue2", 0, 0, 238,
+ "blue3", 0, 0, 205,
+ "blue4", 0, 0, 139,
+ "BlueViolet", 138, 43, 226,
+ "brown", 165, 42, 42,
+ "brown1", 255, 64, 64,
+ "brown2", 238, 59, 59,
+ "brown3", 205, 51, 51,
+ "brown4", 139, 35, 35,
+ "burlywood", 222, 184, 135,
+ "burlywood1", 255, 211, 155,
+ "burlywood2", 238, 197, 145,
+ "burlywood3", 205, 170, 125,
+ "burlywood4", 139, 115, 85,
+ "cadet blue", 95, 158, 160,
+ "CadetBlue", 95, 158, 160,
+ "CadetBlue1", 152, 245, 255,
+ "CadetBlue2", 142, 229, 238,
+ "CadetBlue3", 122, 197, 205,
+ "CadetBlue4", 83, 134, 139,
+ "chartreuse", 127, 255, 0,
+ "chartreuse1", 127, 255, 0,
+ "chartreuse2", 118, 238, 0,
+ "chartreuse3", 102, 205, 0,
+ "chartreuse4", 69, 139, 0,
+ "chocolate", 210, 105, 30,
+ "chocolate1", 255, 127, 36,
+ "chocolate2", 238, 118, 33,
+ "chocolate3", 205, 102, 29,
+ "chocolate4", 139, 69, 19,
+ "coral", 255, 127, 80,
+ "coral1", 255, 114, 86,
+ "coral2", 238, 106, 80,
+ "coral3", 205, 91, 69,
+ "coral4", 139, 62, 47,
+ "cornflower blue", 100, 149, 237,
+ "CornflowerBlue", 100, 149, 237,
+ "cornsilk", 255, 248, 220,
+ "cornsilk1", 255, 248, 220,
+ "cornsilk2", 238, 232, 205,
+ "cornsilk3", 205, 200, 177,
+ "cornsilk4", 139, 136, 120,
+ "cyan", 0, 255, 255,
+ "cyan1", 0, 255, 255,
+ "cyan2", 0, 238, 238,
+ "cyan3", 0, 205, 205,
+ "cyan4", 0, 139, 139,
+ "dark blue", 0, 0, 139,
+ "dark cyan", 0, 139, 139,
+ "dark goldenrod", 184, 134, 11,
+ "dark gray", 169, 169, 169,
+ "dark green", 0, 100, 0,
+ "dark grey", 169, 169, 169,
+ "dark khaki", 189, 183, 107,
+ "dark magenta", 139, 0, 139,
+ "dark olive green", 85, 107, 47,
+ "dark orange", 255, 140, 0,
+ "dark orchid", 153, 50, 204,
+ "dark red", 139, 0, 0,
+ "dark salmon", 233, 150, 122,
+ "dark sea green", 143, 188, 143,
+ "dark slate blue", 72, 61, 139,
+ "dark slate gray", 47, 79, 79,
+ "dark slate grey", 47, 79, 79,
+ "dark turquoise", 0, 206, 209,
+ "dark violet", 148, 0, 211,
+ "DarkBlue", 0, 0, 139,
+ "DarkCyan", 0, 139, 139,
+ "DarkGoldenrod", 184, 134, 11,
+ "DarkGoldenrod1", 255, 185, 15,
+ "DarkGoldenrod2", 238, 173, 14,
+ "DarkGoldenrod3", 205, 149, 12,
+ "DarkGoldenrod4", 139, 101, 8,
+ "DarkGray", 169, 169, 169,
+ "DarkGreen", 0, 100, 0,
+ "DarkGrey", 169, 169, 169,
+ "DarkKhaki", 189, 183, 107,
+ "DarkMagenta", 139, 0, 139,
+ "DarkOliveGreen", 85, 107, 47,
+ "DarkOliveGreen1", 202, 255, 112,
+ "DarkOliveGreen2", 188, 238, 104,
+ "DarkOliveGreen3", 162, 205, 90,
+ "DarkOliveGreen4", 110, 139, 61,
+ "DarkOrange", 255, 140, 0,
+ "DarkOrange1", 255, 127, 0,
+ "DarkOrange2", 238, 118, 0,
+ "DarkOrange3", 205, 102, 0,
+ "DarkOrange4", 139, 69, 0,
+ "DarkOrchid", 153, 50, 204,
+ "DarkOrchid1", 191, 62, 255,
+ "DarkOrchid2", 178, 58, 238,
+ "DarkOrchid3", 154, 50, 205,
+ "DarkOrchid4", 104, 34, 139,
+ "DarkRed", 139, 0, 0,
+ "DarkSalmon", 233, 150, 122,
+ "DarkSeaGreen", 143, 188, 143,
+ "DarkSeaGreen1", 193, 255, 193,
+ "DarkSeaGreen2", 180, 238, 180,
+ "DarkSeaGreen3", 155, 205, 155,
+ "DarkSeaGreen4", 105, 139, 105,
+ "DarkSlateBlue", 72, 61, 139,
+ "DarkSlateGray", 47, 79, 79,
+ "DarkSlateGray1", 151, 255, 255,
+ "DarkSlateGray2", 141, 238, 238,
+ "DarkSlateGray3", 121, 205, 205,
+ "DarkSlateGray4", 82, 139, 139,
+ "DarkSlateGrey", 47, 79, 79,
+ "DarkTurquoise", 0, 206, 209,
+ "DarkViolet", 148, 0, 211,
+ "deep pink", 255, 20, 147,
+ "deep sky blue", 0, 191, 255,
+ "DeepPink", 255, 20, 147,
+ "DeepPink1", 255, 20, 147,
+ "DeepPink2", 238, 18, 137,
+ "DeepPink3", 205, 16, 118,
+ "DeepPink4", 139, 10, 80,
+ "DeepSkyBlue", 0, 191, 255,
+ "DeepSkyBlue1", 0, 191, 255,
+ "DeepSkyBlue2", 0, 178, 238,
+ "DeepSkyBlue3", 0, 154, 205,
+ "DeepSkyBlue4", 0, 104, 139,
+ "dim gray", 105, 105, 105,
+ "dim grey", 105, 105, 105,
+ "DimGray", 105, 105, 105,
+ "DimGrey", 105, 105, 105,
+ "dodger blue", 30, 144, 255,
+ "DodgerBlue", 30, 144, 255,
+ "DodgerBlue1", 30, 144, 255,
+ "DodgerBlue2", 28, 134, 238,
+ "DodgerBlue3", 24, 116, 205,
+ "DodgerBlue4", 16, 78, 139,
+ "firebrick", 178, 34, 34,
+ "firebrick1", 255, 48, 48,
+ "firebrick2", 238, 44, 44,
+ "firebrick3", 205, 38, 38,
+ "firebrick4", 139, 26, 26,
+ "floral white", 255, 250, 240,
+ "FloralWhite", 255, 250, 240,
+ "forest green", 34, 139, 34,
+ "ForestGreen", 34, 139, 34,
+ "gainsboro", 220, 220, 220,
+ "ghost white", 248, 248, 255,
+ "GhostWhite", 248, 248, 255,
+ "gold", 255, 215, 0,
+ "gold1", 255, 215, 0,
+ "gold2", 238, 201, 0,
+ "gold3", 205, 173, 0,
+ "gold4", 139, 117, 0,
+ "goldenrod", 218, 165, 32,
+ "goldenrod1", 255, 193, 37,
+ "goldenrod2", 238, 180, 34,
+ "goldenrod3", 205, 155, 29,
+ "goldenrod4", 139, 105, 20,
+ "gray", 190, 190, 190,
+ "gray0", 0, 0, 0,
+ "gray1", 3, 3, 3,
+ "gray10", 26, 26, 26,
+ "gray100", 255, 255, 255,
+ "gray11", 28, 28, 28,
+ "gray12", 31, 31, 31,
+ "gray13", 33, 33, 33,
+ "gray14", 36, 36, 36,
+ "gray15", 38, 38, 38,
+ "gray16", 41, 41, 41,
+ "gray17", 43, 43, 43,
+ "gray18", 46, 46, 46,
+ "gray19", 48, 48, 48,
+ "gray2", 5, 5, 5,
+ "gray20", 51, 51, 51,
+ "gray21", 54, 54, 54,
+ "gray22", 56, 56, 56,
+ "gray23", 59, 59, 59,
+ "gray24", 61, 61, 61,
+ "gray25", 64, 64, 64,
+ "gray26", 66, 66, 66,
+ "gray27", 69, 69, 69,
+ "gray28", 71, 71, 71,
+ "gray29", 74, 74, 74,
+ "gray3", 8, 8, 8,
+ "gray30", 77, 77, 77,
+ "gray31", 79, 79, 79,
+ "gray32", 82, 82, 82,
+ "gray33", 84, 84, 84,
+ "gray34", 87, 87, 87,
+ "gray35", 89, 89, 89,
+ "gray36", 92, 92, 92,
+ "gray37", 94, 94, 94,
+ "gray38", 97, 97, 97,
+ "gray39", 99, 99, 99,
+ "gray4", 10, 10, 10,
+ "gray40", 102, 102, 102,
+ "gray41", 105, 105, 105,
+ "gray42", 107, 107, 107,
+ "gray43", 110, 110, 110,
+ "gray44", 112, 112, 112,
+ "gray45", 115, 115, 115,
+ "gray46", 117, 117, 117,
+ "gray47", 120, 120, 120,
+ "gray48", 122, 122, 122,
+ "gray49", 125, 125, 125,
+ "gray5", 13, 13, 13,
+ "gray50", 127, 127, 127,
+ "gray51", 130, 130, 130,
+ "gray52", 133, 133, 133,
+ "gray53", 135, 135, 135,
+ "gray54", 138, 138, 138,
+ "gray55", 140, 140, 140,
+ "gray56", 143, 143, 143,
+ "gray57", 145, 145, 145,
+ "gray58", 148, 148, 148,
+ "gray59", 150, 150, 150,
+ "gray6", 15, 15, 15,
+ "gray60", 153, 153, 153,
+ "gray61", 156, 156, 156,
+ "gray62", 158, 158, 158,
+ "gray63", 161, 161, 161,
+ "gray64", 163, 163, 163,
+ "gray65", 166, 166, 166,
+ "gray66", 168, 168, 168,
+ "gray67", 171, 171, 171,
+ "gray68", 173, 173, 173,
+ "gray69", 176, 176, 176,
+ "gray7", 18, 18, 18,
+ "gray70", 179, 179, 179,
+ "gray71", 181, 181, 181,
+ "gray72", 184, 184, 184,
+ "gray73", 186, 186, 186,
+ "gray74", 189, 189, 189,
+ "gray75", 191, 191, 191,
+ "gray76", 194, 194, 194,
+ "gray77", 196, 196, 196,
+ "gray78", 199, 199, 199,
+ "gray79", 201, 201, 201,
+ "gray8", 20, 20, 20,
+ "gray80", 204, 204, 204,
+ "gray81", 207, 207, 207,
+ "gray82", 209, 209, 209,
+ "gray83", 212, 212, 212,
+ "gray84", 214, 214, 214,
+ "gray85", 217, 217, 217,
+ "gray86", 219, 219, 219,
+ "gray87", 222, 222, 222,
+ "gray88", 224, 224, 224,
+ "gray89", 227, 227, 227,
+ "gray9", 23, 23, 23,
+ "gray90", 229, 229, 229,
+ "gray91", 232, 232, 232,
+ "gray92", 235, 235, 235,
+ "gray93", 237, 237, 237,
+ "gray94", 240, 240, 240,
+ "gray95", 242, 242, 242,
+ "gray96", 245, 245, 245,
+ "gray97", 247, 247, 247,
+ "gray98", 250, 250, 250,
+ "gray99", 252, 252, 252,
+ "green", 0, 255, 0,
+ "green yellow", 173, 255, 47,
+ "green1", 0, 255, 0,
+ "green2", 0, 238, 0,
+ "green3", 0, 205, 0,
+ "green4", 0, 139, 0,
+ "GreenYellow", 173, 255, 47,
+ "grey", 190, 190, 190,
+ "grey0", 0, 0, 0,
+ "grey1", 3, 3, 3,
+ "grey10", 26, 26, 26,
+ "grey100", 255, 255, 255,
+ "grey11", 28, 28, 28,
+ "grey12", 31, 31, 31,
+ "grey13", 33, 33, 33,
+ "grey14", 36, 36, 36,
+ "grey15", 38, 38, 38,
+ "grey16", 41, 41, 41,
+ "grey17", 43, 43, 43,
+ "grey18", 46, 46, 46,
+ "grey19", 48, 48, 48,
+ "grey2", 5, 5, 5,
+ "grey20", 51, 51, 51,
+ "grey21", 54, 54, 54,
+ "grey22", 56, 56, 56,
+ "grey23", 59, 59, 59,
+ "grey24", 61, 61, 61,
+ "grey25", 64, 64, 64,
+ "grey26", 66, 66, 66,
+ "grey27", 69, 69, 69,
+ "grey28", 71, 71, 71,
+ "grey29", 74, 74, 74,
+ "grey3", 8, 8, 8,
+ "grey30", 77, 77, 77,
+ "grey31", 79, 79, 79,
+ "grey32", 82, 82, 82,
+ "grey33", 84, 84, 84,
+ "grey34", 87, 87, 87,
+ "grey35", 89, 89, 89,
+ "grey36", 92, 92, 92,
+ "grey37", 94, 94, 94,
+ "grey38", 97, 97, 97,
+ "grey39", 99, 99, 99,
+ "grey4", 10, 10, 10,
+ "grey40", 102, 102, 102,
+ "grey41", 105, 105, 105,
+ "grey42", 107, 107, 107,
+ "grey43", 110, 110, 110,
+ "grey44", 112, 112, 112,
+ "grey45", 115, 115, 115,
+ "grey46", 117, 117, 117,
+ "grey47", 120, 120, 120,
+ "grey48", 122, 122, 122,
+ "grey49", 125, 125, 125,
+ "grey5", 13, 13, 13,
+ "grey50", 127, 127, 127,
+ "grey51", 130, 130, 130,
+ "grey52", 133, 133, 133,
+ "grey53", 135, 135, 135,
+ "grey54", 138, 138, 138,
+ "grey55", 140, 140, 140,
+ "grey56", 143, 143, 143,
+ "grey57", 145, 145, 145,
+ "grey58", 148, 148, 148,
+ "grey59", 150, 150, 150,
+ "grey6", 15, 15, 15,
+ "grey60", 153, 153, 153,
+ "grey61", 156, 156, 156,
+ "grey62", 158, 158, 158,
+ "grey63", 161, 161, 161,
+ "grey64", 163, 163, 163,
+ "grey65", 166, 166, 166,
+ "grey66", 168, 168, 168,
+ "grey67", 171, 171, 171,
+ "grey68", 173, 173, 173,
+ "grey69", 176, 176, 176,
+ "grey7", 18, 18, 18,
+ "grey70", 179, 179, 179,
+ "grey71", 181, 181, 181,
+ "grey72", 184, 184, 184,
+ "grey73", 186, 186, 186,
+ "grey74", 189, 189, 189,
+ "grey75", 191, 191, 191,
+ "grey76", 194, 194, 194,
+ "grey77", 196, 196, 196,
+ "grey78", 199, 199, 199,
+ "grey79", 201, 201, 201,
+ "grey8", 20, 20, 20,
+ "grey80", 204, 204, 204,
+ "grey81", 207, 207, 207,
+ "grey82", 209, 209, 209,
+ "grey83", 212, 212, 212,
+ "grey84", 214, 214, 214,
+ "grey85", 217, 217, 217,
+ "grey86", 219, 219, 219,
+ "grey87", 222, 222, 222,
+ "grey88", 224, 224, 224,
+ "grey89", 227, 227, 227,
+ "grey9", 23, 23, 23,
+ "grey90", 229, 229, 229,
+ "grey91", 232, 232, 232,
+ "grey92", 235, 235, 235,
+ "grey93", 237, 237, 237,
+ "grey94", 240, 240, 240,
+ "grey95", 242, 242, 242,
+ "grey96", 245, 245, 245,
+ "grey97", 247, 247, 247,
+ "grey98", 250, 250, 250,
+ "grey99", 252, 252, 252,
+ "honeydew", 240, 255, 240,
+ "honeydew1", 240, 255, 240,
+ "honeydew2", 224, 238, 224,
+ "honeydew3", 193, 205, 193,
+ "honeydew4", 131, 139, 131,
+ "hot pink", 255, 105, 180,
+ "HotPink", 255, 105, 180,
+ "HotPink1", 255, 110, 180,
+ "HotPink2", 238, 106, 167,
+ "HotPink3", 205, 96, 144,
+ "HotPink4", 139, 58, 98,
+ "indian red", 205, 92, 92,
+ "IndianRed", 205, 92, 92,
+ "IndianRed1", 255, 106, 106,
+ "IndianRed2", 238, 99, 99,
+ "IndianRed3", 205, 85, 85,
+ "IndianRed4", 139, 58, 58,
+ "ivory", 255, 255, 240,
+ "ivory1", 255, 255, 240,
+ "ivory2", 238, 238, 224,
+ "ivory3", 205, 205, 193,
+ "ivory4", 139, 139, 131,
+ "khaki", 240, 230, 140,
+ "khaki1", 255, 246, 143,
+ "khaki2", 238, 230, 133,
+ "khaki3", 205, 198, 115,
+ "khaki4", 139, 134, 78,
+ "lavender", 230, 230, 250,
+ "lavender blush", 255, 240, 245,
+ "LavenderBlush", 255, 240, 245,
+ "LavenderBlush1", 255, 240, 245,
+ "LavenderBlush2", 238, 224, 229,
+ "LavenderBlush3", 205, 193, 197,
+ "LavenderBlush4", 139, 131, 134,
+ "lawn green", 124, 252, 0,
+ "LawnGreen", 124, 252, 0,
+ "lemon chiffon", 255, 250, 205,
+ "LemonChiffon", 255, 250, 205,
+ "LemonChiffon1", 255, 250, 205,
+ "LemonChiffon2", 238, 233, 191,
+ "LemonChiffon3", 205, 201, 165,
+ "LemonChiffon4", 139, 137, 112,
+ "light blue", 173, 216, 230,
+ "light coral", 240, 128, 128,
+ "light cyan", 224, 255, 255,
+ "light goldenrod", 238, 221, 130,
+ "light goldenrod yellow", 250, 250, 210,
+ "light gray", 211, 211, 211,
+ "light green", 144, 238, 144,
+ "light grey", 211, 211, 211,
+ "light pink", 255, 182, 193,
+ "light salmon", 255, 160, 122,
+ "light sea green", 32, 178, 170,
+ "light sky blue", 135, 206, 250,
+ "light slate blue", 132, 112, 255,
+ "light slate gray", 119, 136, 153,
+ "light slate grey", 119, 136, 153,
+ "light steel blue", 176, 196, 222,
+ "light yellow", 255, 255, 224,
+ "LightBlue", 173, 216, 230,
+ "LightBlue1", 191, 239, 255,
+ "LightBlue2", 178, 223, 238,
+ "LightBlue3", 154, 192, 205,
+ "LightBlue4", 104, 131, 139,
+ "LightCoral", 240, 128, 128,
+ "LightCyan", 224, 255, 255,
+ "LightCyan1", 224, 255, 255,
+ "LightCyan2", 209, 238, 238,
+ "LightCyan3", 180, 205, 205,
+ "LightCyan4", 122, 139, 139,
+ "LightGoldenrod", 238, 221, 130,
+ "LightGoldenrod1", 255, 236, 139,
+ "LightGoldenrod2", 238, 220, 130,
+ "LightGoldenrod3", 205, 190, 112,
+ "LightGoldenrod4", 139, 129, 76,
+ "LightGoldenrodYellow", 250, 250, 210,
+ "LightGray", 211, 211, 211,
+ "LightGreen", 144, 238, 144,
+ "LightGrey", 211, 211, 211,
+ "LightPink", 255, 182, 193,
+ "LightPink1", 255, 174, 185,
+ "LightPink2", 238, 162, 173,
+ "LightPink3", 205, 140, 149,
+ "LightPink4", 139, 95, 101,
+ "LightSalmon", 255, 160, 122,
+ "LightSalmon1", 255, 160, 122,
+ "LightSalmon2", 238, 149, 114,
+ "LightSalmon3", 205, 129, 98,
+ "LightSalmon4", 139, 87, 66,
+ "LightSeaGreen", 32, 178, 170,
+ "LightSkyBlue", 135, 206, 250,
+ "LightSkyBlue1", 176, 226, 255,
+ "LightSkyBlue2", 164, 211, 238,
+ "LightSkyBlue3", 141, 182, 205,
+ "LightSkyBlue4", 96, 123, 139,
+ "LightSlateBlue", 132, 112, 255,
+ "LightSlateGray", 119, 136, 153,
+ "LightSlateGrey", 119, 136, 153,
+ "LightSteelBlue", 176, 196, 222,
+ "LightSteelBlue1", 202, 225, 255,
+ "LightSteelBlue2", 188, 210, 238,
+ "LightSteelBlue3", 162, 181, 205,
+ "LightSteelBlue4", 110, 123, 139,
+ "LightYellow", 255, 255, 224,
+ "LightYellow1", 255, 255, 224,
+ "LightYellow2", 238, 238, 209,
+ "LightYellow3", 205, 205, 180,
+ "LightYellow4", 139, 139, 122,
+ "lime green", 50, 205, 50,
+ "LimeGreen", 50, 205, 50,
+ "linen", 250, 240, 230,
+ "magenta", 255, 0, 255,
+ "magenta1", 255, 0, 255,
+ "magenta2", 238, 0, 238,
+ "magenta3", 205, 0, 205,
+ "magenta4", 139, 0, 139,
+ "maroon", 176, 48, 96,
+ "maroon1", 255, 52, 179,
+ "maroon2", 238, 48, 167,
+ "maroon3", 205, 41, 144,
+ "maroon4", 139, 28, 98,
+ "medium aquamarine", 102, 205, 170,
+ "medium blue", 0, 0, 205,
+ "medium orchid", 186, 85, 211,
+ "medium purple", 147, 112, 219,
+ "medium sea green", 60, 179, 113,
+ "medium slate blue", 123, 104, 238,
+ "medium spring green", 0, 250, 154,
+ "medium turquoise", 72, 209, 204,
+ "medium violet red", 199, 21, 133,
+ "MediumAquamarine", 102, 205, 170,
+ "MediumBlue", 0, 0, 205,
+ "MediumOrchid", 186, 85, 211,
+ "MediumOrchid1", 224, 102, 255,
+ "MediumOrchid2", 209, 95, 238,
+ "MediumOrchid3", 180, 82, 205,
+ "MediumOrchid4", 122, 55, 139,
+ "MediumPurple", 147, 112, 219,
+ "MediumPurple1", 171, 130, 255,
+ "MediumPurple2", 159, 121, 238,
+ "MediumPurple3", 137, 104, 205,
+ "MediumPurple4", 93, 71, 139,
+ "MediumSeaGreen", 60, 179, 113,
+ "MediumSlateBlue", 123, 104, 238,
+ "MediumSpringGreen", 0, 250, 154,
+ "MediumTurquoise", 72, 209, 204,
+ "MediumVioletRed", 199, 21, 133,
+ "midnight blue", 25, 25, 112,
+ "MidnightBlue", 25, 25, 112,
+ "mint cream", 245, 255, 250,
+ "MintCream", 245, 255, 250,
+ "misty rose", 255, 228, 225,
+ "MistyRose", 255, 228, 225,
+ "MistyRose1", 255, 228, 225,
+ "MistyRose2", 238, 213, 210,
+ "MistyRose3", 205, 183, 181,
+ "MistyRose4", 139, 125, 123,
+ "moccasin", 255, 228, 181,
+ "navajo white", 255, 222, 173,
+ "NavajoWhite", 255, 222, 173,
+ "NavajoWhite1", 255, 222, 173,
+ "NavajoWhite2", 238, 207, 161,
+ "NavajoWhite3", 205, 179, 139,
+ "NavajoWhite4", 139, 121, 94,
+ "navy", 0, 0, 128,
+ "navy blue", 0, 0, 128,
+ "NavyBlue", 0, 0, 128,
+ "old lace", 253, 245, 230,
+ "OldLace", 253, 245, 230,
+ "olive drab", 107, 142, 35,
+ "OliveDrab", 107, 142, 35,
+ "OliveDrab1", 192, 255, 62,
+ "OliveDrab2", 179, 238, 58,
+ "OliveDrab3", 154, 205, 50,
+ "OliveDrab4", 105, 139, 34,
+ "orange", 255, 165, 0,
+ "orange red", 255, 69, 0,
+ "orange1", 255, 165, 0,
+ "orange2", 238, 154, 0,
+ "orange3", 205, 133, 0,
+ "orange4", 139, 90, 0,
+ "OrangeRed", 255, 69, 0,
+ "OrangeRed1", 255, 69, 0,
+ "OrangeRed2", 238, 64, 0,
+ "OrangeRed3", 205, 55, 0,
+ "OrangeRed4", 139, 37, 0,
+ "orchid", 218, 112, 214,
+ "orchid1", 255, 131, 250,
+ "orchid2", 238, 122, 233,
+ "orchid3", 205, 105, 201,
+ "orchid4", 139, 71, 137,
+ "pale goldenrod", 238, 232, 170,
+ "pale green", 152, 251, 152,
+ "pale turquoise", 175, 238, 238,
+ "pale violet red", 219, 112, 147,
+ "PaleGoldenrod", 238, 232, 170,
+ "PaleGreen", 152, 251, 152,
+ "PaleGreen1", 154, 255, 154,
+ "PaleGreen2", 144, 238, 144,
+ "PaleGreen3", 124, 205, 124,
+ "PaleGreen4", 84, 139, 84,
+ "PaleTurquoise", 175, 238, 238,
+ "PaleTurquoise1", 187, 255, 255,
+ "PaleTurquoise2", 174, 238, 238,
+ "PaleTurquoise3", 150, 205, 205,
+ "PaleTurquoise4", 102, 139, 139,
+ "PaleVioletRed", 219, 112, 147,
+ "PaleVioletRed1", 255, 130, 171,
+ "PaleVioletRed2", 238, 121, 159,
+ "PaleVioletRed3", 205, 104, 137,
+ "PaleVioletRed4", 139, 71, 93,
+ "papaya whip", 255, 239, 213,
+ "PapayaWhip", 255, 239, 213,
+ "peach puff", 255, 218, 185,
+ "PeachPuff", 255, 218, 185,
+ "PeachPuff1", 255, 218, 185,
+ "PeachPuff2", 238, 203, 173,
+ "PeachPuff3", 205, 175, 149,
+ "PeachPuff4", 139, 119, 101,
+ "peru", 205, 133, 63,
+ "pink", 255, 192, 203,
+ "pink1", 255, 181, 197,
+ "pink2", 238, 169, 184,
+ "pink3", 205, 145, 158,
+ "pink4", 139, 99, 108,
+ "plum", 221, 160, 221,
+ "plum1", 255, 187, 255,
+ "plum2", 238, 174, 238,
+ "plum3", 205, 150, 205,
+ "plum4", 139, 102, 139,
+ "powder blue", 176, 224, 230,
+ "PowderBlue", 176, 224, 230,
+ "purple", 160, 32, 240,
+ "purple1", 155, 48, 255,
+ "purple2", 145, 44, 238,
+ "purple3", 125, 38, 205,
+ "purple4", 85, 26, 139,
+ "red", 255, 0, 0,
+ "red1", 255, 0, 0,
+ "red2", 238, 0, 0,
+ "red3", 205, 0, 0,
+ "red4", 139, 0, 0,
+ "rosy brown", 188, 143, 143,
+ "RosyBrown", 188, 143, 143,
+ "RosyBrown1", 255, 193, 193,
+ "RosyBrown2", 238, 180, 180,
+ "RosyBrown3", 205, 155, 155,
+ "RosyBrown4", 139, 105, 105,
+ "royal blue", 65, 105, 225,
+ "RoyalBlue", 65, 105, 225,
+ "RoyalBlue1", 72, 118, 255,
+ "RoyalBlue2", 67, 110, 238,
+ "RoyalBlue3", 58, 95, 205,
+ "RoyalBlue4", 39, 64, 139,
+ "saddle brown", 139, 69, 19,
+ "SaddleBrown", 139, 69, 19,
+ "salmon", 250, 128, 114,
+ "salmon1", 255, 140, 105,
+ "salmon2", 238, 130, 98,
+ "salmon3", 205, 112, 84,
+ "salmon4", 139, 76, 57,
+ "sandy brown", 244, 164, 96,
+ "SandyBrown", 244, 164, 96,
+ "sea green", 46, 139, 87,
+ "SeaGreen", 46, 139, 87,
+ "SeaGreen1", 84, 255, 159,
+ "SeaGreen2", 78, 238, 148,
+ "SeaGreen3", 67, 205, 128,
+ "SeaGreen4", 46, 139, 87,
+ "seashell", 255, 245, 238,
+ "seashell1", 255, 245, 238,
+ "seashell2", 238, 229, 222,
+ "seashell3", 205, 197, 191,
+ "seashell4", 139, 134, 130,
+ "sienna", 160, 82, 45,
+ "sienna1", 255, 130, 71,
+ "sienna2", 238, 121, 66,
+ "sienna3", 205, 104, 57,
+ "sienna4", 139, 71, 38,
+ "sky blue", 135, 206, 235,
+ "SkyBlue", 135, 206, 235,
+ "SkyBlue1", 135, 206, 255,
+ "SkyBlue2", 126, 192, 238,
+ "SkyBlue3", 108, 166, 205,
+ "SkyBlue4", 74, 112, 139,
+ "slate blue", 106, 90, 205,
+ "slate gray", 112, 128, 144,
+ "slate grey", 112, 128, 144,
+ "SlateBlue", 106, 90, 205,
+ "SlateBlue1", 131, 111, 255,
+ "SlateBlue2", 122, 103, 238,
+ "SlateBlue3", 105, 89, 205,
+ "SlateBlue4", 71, 60, 139,
+ "SlateGray", 112, 128, 144,
+ "SlateGray1", 198, 226, 255,
+ "SlateGray2", 185, 211, 238,
+ "SlateGray3", 159, 182, 205,
+ "SlateGray4", 108, 123, 139,
+ "SlateGrey", 112, 128, 144,
+ "snow", 255, 250, 250,
+ "snow1", 255, 250, 250,
+ "snow2", 238, 233, 233,
+ "snow3", 205, 201, 201,
+ "snow4", 139, 137, 137,
+ "spring green", 0, 255, 127,
+ "SpringGreen", 0, 255, 127,
+ "SpringGreen1", 0, 255, 127,
+ "SpringGreen2", 0, 238, 118,
+ "SpringGreen3", 0, 205, 102,
+ "SpringGreen4", 0, 139, 69,
+ "steel blue", 70, 130, 180,
+ "SteelBlue", 70, 130, 180,
+ "SteelBlue1", 99, 184, 255,
+ "SteelBlue2", 92, 172, 238,
+ "SteelBlue3", 79, 148, 205,
+ "SteelBlue4", 54, 100, 139,
+ "tan", 210, 180, 140,
+ "tan1", 255, 165, 79,
+ "tan2", 238, 154, 73,
+ "tan3", 205, 133, 63,
+ "tan4", 139, 90, 43,
+ "thistle", 216, 191, 216,
+ "thistle1", 255, 225, 255,
+ "thistle2", 238, 210, 238,
+ "thistle3", 205, 181, 205,
+ "thistle4", 139, 123, 139,
+ "tomato", 255, 99, 71,
+ "tomato1", 255, 99, 71,
+ "tomato2", 238, 92, 66,
+ "tomato3", 205, 79, 57,
+ "tomato4", 139, 54, 38,
+ "turquoise", 64, 224, 208,
+ "turquoise1", 0, 245, 255,
+ "turquoise2", 0, 229, 238,
+ "turquoise3", 0, 197, 205,
+ "turquoise4", 0, 134, 139,
+ "violet", 238, 130, 238,
+ "violet red", 208, 32, 144,
+ "VioletRed", 208, 32, 144,
+ "VioletRed1", 255, 62, 150,
+ "VioletRed2", 238, 58, 140,
+ "VioletRed3", 205, 50, 120,
+ "VioletRed4", 139, 34, 82,
+ "wheat", 245, 222, 179,
+ "wheat1", 255, 231, 186,
+ "wheat2", 238, 216, 174,
+ "wheat3", 205, 186, 150,
+ "wheat4", 139, 126, 102,
+ "white", 255, 255, 255,
+ "white smoke", 245, 245, 245,
+ "WhiteSmoke", 245, 245, 245,
+ "yellow", 255, 255, 0,
+ "yellow green", 154, 205, 50,
+ "yellow1", 255, 255, 0,
+ "yellow2", 238, 238, 0,
+ "yellow3", 205, 205, 0,
+ "yellow4", 139, 139, 0,
+ "YellowGreen", 154, 205, 50,
+ NULL, 0, 0, 0
+};
+
+
+/*
+ * This value will be set to the number of colors in the color table
+ * the first time it is needed.
+ */
+
+static int numXColors = 0;
+
+/*
+ * Forward declarations for functions used only in this file.
+ */
+
+static int FindColor _ANSI_ARGS_((const char *name, XColor *colorPtr));
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * FindColor --
+ *
+ * This routine finds the color entry that corresponds to the
+ * specified color.
+ *
+ * Results:
+ * Returns non-zero on success. The RGB values of the XColor
+ * will be initialized to the proper values on success.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+FindColor(name, colorPtr)
+ const char *name;
+ XColor *colorPtr;
+{
+ int l, u, r, i;
+
+ /*
+ * Count the number of elements in the color array if we haven't
+ * done so yet.
+ */
+
+ if (numXColors == 0) {
+ XColorEntry *ePtr;
+ for (ePtr = xColors; ePtr->name != NULL; ePtr++) {
+ numXColors++;
+ }
+ }
+
+ /*
+ * Perform a binary search on the sorted array of colors.
+ */
+
+ l = 0;
+ u = numXColors - 1;
+ while (l <= u) {
+ i = (l + u) / 2;
+ r = strcasecmp(name, xColors[i].name);
+ if (r == 0) {
+ break;
+ } else if (r < 0) {
+ u = i-1;
+ } else {
+ l = i+1;
+ }
+ }
+ if (l > u) {
+ return 0;
+ }
+ colorPtr->red = xColors[i].red << 8;
+ colorPtr->green = xColors[i].green << 8;
+ colorPtr->blue = xColors[i].blue << 8;
+ return 1;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XParseColor --
+ *
+ * Partial implementation of X color name parsing interface.
+ *
+ * Results:
+ * Returns non-zero on success.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Status
+XParseColor(display, map, spec, colorPtr)
+ Display *display;
+ Colormap map;
+ const char* spec;
+ XColor *colorPtr;
+{
+ if (spec[0] == '#') {
+ char fmt[16];
+ int i, red, green, blue;
+
+ if ((i = strlen(spec+1))%3) {
+ return 0;
+ }
+ i /= 3;
+
+ sprintf(fmt, "%%%dx%%%dx%%%dx", i, i, i);
+ if (sscanf(spec+1, fmt, &red, &green, &blue) != 3) {
+ return 0;
+ }
+ colorPtr->red = ((unsigned short) red) << (4 * (4 - i));
+ colorPtr->green = ((unsigned short) green) << (4 * (4 - i));
+ colorPtr->blue = ((unsigned short) blue) << (4 * (4 - i));
+ } else {
+ if (!FindColor(spec, colorPtr)) {
+ return 0;
+ }
+ }
+ colorPtr->pixel = TkpGetPixel(colorPtr);
+ colorPtr->flags = DoRed|DoGreen|DoBlue;
+ colorPtr->pad = 0;
+ return 1;
+}
diff --git a/tk/xlib/xdraw.c b/tk/xlib/xdraw.c
new file mode 100644
index 00000000000..2655915b3c2
--- /dev/null
+++ b/tk/xlib/xdraw.c
@@ -0,0 +1,82 @@
+/*
+ * 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$
+ */
+
+#include "tk.h"
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XDrawLine --
+ *
+ * Draw a single line between two points in a given drawable.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Draws a single line segment.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XDrawLine(display, d, gc, x1, y1, x2, y2)
+ Display* display;
+ Drawable d;
+ GC gc;
+ int x1, y1, x2, y2; /* Coordinates of line segment. */
+{
+ XPoint points[2];
+
+ points[0].x = x1;
+ points[0].y = y1;
+ points[1].x = x2;
+ points[1].y = y2;
+ XDrawLines(display, d, gc, points, 2, CoordModeOrigin);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XFillRectangle --
+ *
+ * Fills a rectangular area in the given drawable. This procedure
+ * is implemented as a call to XFillRectangles.
+ *
+ * Results:
+ * None
+ *
+ * Side effects:
+ * Fills the specified rectangle.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XFillRectangle(display, d, gc, x, y, width, height)
+ Display* display;
+ Drawable d;
+ GC gc;
+ int x;
+ int y;
+ unsigned int width;
+ unsigned int height;
+{
+ XRectangle rectangle;
+ rectangle.x = x;
+ rectangle.y = y;
+ rectangle.width = width;
+ rectangle.height = height;
+ XFillRectangles(display, d, gc, &rectangle, 1);
+}
diff --git a/tk/xlib/xgc.c b/tk/xlib/xgc.c
new file mode 100644
index 00000000000..90c44e1ead1
--- /dev/null
+++ b/tk/xlib/xgc.c
@@ -0,0 +1,353 @@
+/*
+ * 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$
+ */
+
+#include <tkInt.h>
+
+#ifdef MAC_TCL
+# include <Xlib.h>
+#else
+# include <X11/Xlib.h>
+#endif
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XCreateGC --
+ *
+ * Allocate a new GC, and initialize the specified fields.
+ *
+ * Results:
+ * Returns a newly allocated GC.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+GC
+XCreateGC(display, d, mask, values)
+ Display* display;
+ Drawable d;
+ unsigned long mask;
+ XGCValues* values;
+{
+ GC gp;
+
+ gp = (XGCValues *)ckalloc(sizeof(XGCValues));
+ if (!gp) {
+ return None;
+ }
+
+ gp->function = (mask & GCFunction) ?values->function :GXcopy;
+ gp->plane_mask = (mask & GCPlaneMask) ?values->plane_mask :~0;
+ gp->foreground = (mask & GCForeground) ?values->foreground :0;
+ gp->background = (mask & GCBackground) ?values->background :0xffffff;
+ gp->line_width = (mask & GCLineWidth) ?values->line_width :0;
+ gp->line_style = (mask & GCLineStyle) ?values->line_style :LineSolid;
+ gp->cap_style = (mask & GCCapStyle) ?values->cap_style :0;
+ gp->join_style = (mask & GCJoinStyle) ?values->join_style :0;
+ gp->fill_style = (mask & GCFillStyle) ?values->fill_style :FillSolid;
+ gp->fill_rule = (mask & GCFillRule) ?values->fill_rule :WindingRule;
+ gp->arc_mode = (mask & GCArcMode) ?values->arc_mode :ArcPieSlice;
+ gp->tile = (mask & GCTile) ?values->tile :None;
+ gp->stipple = (mask & GCStipple) ?values->stipple :None;
+ gp->ts_x_origin = (mask & GCTileStipXOrigin) ?values->ts_x_origin:0;
+ gp->ts_y_origin = (mask & GCTileStipYOrigin) ?values->ts_y_origin:0;
+ gp->font = (mask & GCFont) ?values->font :None;
+ gp->subwindow_mode = (mask & GCSubwindowMode)?values->subwindow_mode:ClipByChildren;
+ gp->graphics_exposures = (mask & GCGraphicsExposures)?values->graphics_exposures:True;
+ gp->clip_x_origin = (mask & GCClipXOrigin) ?values->clip_x_origin :0;
+ gp->clip_y_origin = (mask & GCClipYOrigin) ?values->clip_y_origin :0;
+ gp->dash_offset = (mask & GCDashOffset) ?values->dash_offset :0;
+ gp->dashes = (mask & GCDashList) ?values->dashes :4;
+
+ if (mask & GCClipMask) {
+ gp->clip_mask = (Pixmap)ckalloc(sizeof(TkpClipMask));
+ ((TkpClipMask*)gp->clip_mask)->type = TKP_CLIP_PIXMAP;
+ ((TkpClipMask*)gp->clip_mask)->value.pixmap = values->clip_mask;
+ } else {
+ gp->clip_mask = None;
+ }
+
+ return gp;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XChangeGC --
+ *
+ * Changes the GC components specified by valuemask for the
+ * specified GC.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Updates the specified GC.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XChangeGC(d, gc, mask, values)
+ Display * d;
+ GC gc;
+ unsigned long mask;
+ XGCValues *values;
+{
+ if (mask & GCFunction) { gc->function = values->function; }
+ if (mask & GCPlaneMask) { gc->plane_mask = values->plane_mask; }
+ if (mask & GCForeground) { gc->foreground = values->foreground; }
+ if (mask & GCBackground) { gc->background = values->background; }
+ if (mask & GCLineWidth) { gc->line_width = values->line_width; }
+ if (mask & GCLineStyle) { gc->line_style = values->line_style; }
+ if (mask & GCCapStyle) { gc->cap_style = values->cap_style; }
+ if (mask & GCJoinStyle) { gc->join_style = values->join_style; }
+ if (mask & GCFillStyle) { gc->fill_style = values->fill_style; }
+ if (mask & GCFillRule) { gc->fill_rule = values->fill_rule; }
+ if (mask & GCArcMode) { gc->arc_mode = values->arc_mode; }
+ if (mask & GCTile) { gc->tile = values->tile; }
+ if (mask & GCStipple) { gc->stipple = values->stipple; }
+ if (mask & GCTileStipXOrigin) { gc->ts_x_origin = values->ts_x_origin; }
+ if (mask & GCTileStipYOrigin) { gc->ts_y_origin = values->ts_y_origin; }
+ if (mask & GCFont) { gc->font = values->font; }
+ if (mask & GCSubwindowMode) { gc->subwindow_mode = values->subwindow_mode; }
+ if (mask & GCGraphicsExposures) { gc->graphics_exposures = values->graphics_exposures; }
+ if (mask & GCClipXOrigin) { gc->clip_x_origin = values->clip_x_origin; }
+ if (mask & GCClipYOrigin) { gc->clip_y_origin = values->clip_y_origin; }
+ if (mask & GCClipMask) { XSetClipMask(d, gc, values->clip_mask); }
+ if (mask & GCDashOffset) { gc->dash_offset = values->dash_offset; }
+ if (mask & GCDashList) { gc->dashes = values->dashes; }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XFreeGC --
+ *
+ * Deallocates the specified graphics context.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XFreeGC(d, gc)
+ Display * d;
+ GC gc;
+{
+ if (gc != None) {
+ if (gc->clip_mask != None) {
+ ckfree((char*) gc->clip_mask);
+ }
+ ckfree((char *) gc);
+ }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XSetForeground, etc. --
+ *
+ * The following functions are simply accessor functions for
+ * the GC slots.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Each function sets some slot in the GC.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+XSetForeground(display, gc, foreground)
+ Display *display;
+ GC gc;
+ unsigned long foreground;
+{
+ gc->foreground = foreground;
+}
+
+void
+XSetBackground(display, gc, background)
+ Display *display;
+ GC gc;
+ unsigned long background;
+{
+ gc->background = background;
+}
+
+void
+XSetFunction(display, gc, function)
+ Display *display;
+ GC gc;
+ int function;
+{
+ gc->function = function;
+}
+
+void
+XSetFillRule(display, gc, fill_rule)
+ Display *display;
+ GC gc;
+ int fill_rule;
+{
+ gc->fill_rule = fill_rule;
+}
+
+void
+XSetFillStyle(display, gc, fill_style)
+ Display *display;
+ GC gc;
+ int fill_style;
+{
+ gc->fill_style = fill_style;
+}
+
+void
+XSetTSOrigin(display, gc, x, y)
+ Display *display;
+ GC gc;
+ int x, y;
+{
+ gc->ts_x_origin = x;
+ gc->ts_y_origin = y;
+}
+
+void
+XSetFont(display, gc, font)
+ Display *display;
+ GC gc;
+ Font font;
+{
+ gc->font = font;
+}
+
+void
+XSetArcMode(display, gc, arc_mode)
+ Display *display;
+ GC gc;
+ int arc_mode;
+{
+ gc->arc_mode = arc_mode;
+}
+
+void
+XSetStipple(display, gc, stipple)
+ Display *display;
+ GC gc;
+ Pixmap stipple;
+{
+ gc->stipple = stipple;
+}
+
+void
+XSetLineAttributes(display, gc, line_width, line_style, cap_style,
+ join_style)
+ Display *display;
+ GC gc;
+ unsigned int line_width;
+ int line_style;
+ int cap_style;
+ int join_style;
+{
+ gc->line_width = line_width;
+ gc->line_style = line_style;
+ gc->cap_style = cap_style;
+ gc->join_style = join_style;
+}
+
+void
+XSetClipOrigin(display, gc, clip_x_origin, clip_y_origin)
+ Display* display;
+ GC gc;
+ int clip_x_origin;
+ int clip_y_origin;
+{
+ gc->clip_x_origin = clip_x_origin;
+ gc->clip_y_origin = clip_y_origin;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TkSetRegion, XSetClipMask --
+ *
+ * Sets the clipping region/pixmap for a GC.
+ *
+ * Note that unlike the Xlib equivalent, it is not safe to delete
+ * the region after setting it into the GC. The only use of
+ * TkSetRegion is currently in ImgPhotoDisplay, which uses the GC
+ * immediately.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Allocates or dealloates a TkpClipMask.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TkSetRegion(display, gc, r)
+ Display* display;
+ GC gc;
+ TkRegion r;
+{
+ if (r == None) {
+ if (gc->clip_mask) {
+ ckfree((char*) gc->clip_mask);
+ gc->clip_mask = None;
+ }
+ return;
+ }
+
+ if (gc->clip_mask == None) {
+ gc->clip_mask = (Pixmap)ckalloc(sizeof(TkpClipMask));
+ }
+ ((TkpClipMask*)gc->clip_mask)->type = TKP_CLIP_REGION;
+ ((TkpClipMask*)gc->clip_mask)->value.region = r;
+}
+
+void
+XSetClipMask(display, gc, pixmap)
+ Display* display;
+ GC gc;
+ Pixmap pixmap;
+{
+ if (pixmap == None) {
+ if (gc->clip_mask) {
+ ckfree((char*) gc->clip_mask);
+ gc->clip_mask = None;
+ }
+ return;
+ }
+
+ if (gc->clip_mask == None) {
+ gc->clip_mask = (Pixmap)ckalloc(sizeof(TkpClipMask));
+ }
+ ((TkpClipMask*)gc->clip_mask)->type = TKP_CLIP_PIXMAP;
+ ((TkpClipMask*)gc->clip_mask)->value.pixmap = pixmap;
+}
diff --git a/tk/xlib/ximage.c b/tk/xlib/ximage.c
new file mode 100644
index 00000000000..2b0d588b800
--- /dev/null
+++ b/tk/xlib/ximage.c
@@ -0,0 +1,71 @@
+/*
+ * 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$
+ */
+
+#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.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Pixmap
+XCreateBitmapFromData(display, d, data, width, height)
+ Display* display;
+ Drawable d;
+ _Xconst char* data;
+ unsigned int width;
+ unsigned int height;
+{
+ XImage ximage;
+ GC gc;
+ Pixmap pix;
+
+ pix = Tk_GetPixmap(display, d, width, height, 1);
+ gc = XCreateGC(display, pix, 0, NULL);
+ if (gc == NULL) {
+ return None;
+ }
+ ximage.height = height;
+ ximage.width = width;
+ ximage.depth = 1;
+ ximage.bits_per_pixel = 1;
+ ximage.xoffset = 0;
+ ximage.format = XYBitmap;
+ ximage.data = (char *)data;
+ ximage.byte_order = LSBFirst;
+ ximage.bitmap_unit = 8;
+ ximage.bitmap_bit_order = LSBFirst;
+ 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;
+}
diff --git a/tk/xlib/xutil.c b/tk/xlib/xutil.c
new file mode 100644
index 00000000000..b98a6fdd48c
--- /dev/null
+++ b/tk/xlib/xutil.c
@@ -0,0 +1,116 @@
+/*
+ * 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$
+ */
+
+#include <stdlib.h>
+#include <tk.h>
+
+#ifdef MAC_TCL
+# include <Xutil.h>
+# include <Xatom.h>
+#else
+# include <X11/Xutil.h>
+# include <X11/Xatom.h>
+#endif
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XInternAtom --
+ *
+ * This procedure simulates the XInternAtom function by calling
+ * Tk_Uid to get a unique id for every atom. This is only a
+ * partial implementation, since it doesn't work across
+ * applications.
+ *
+ * Results:
+ * A new Atom.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+Atom
+XInternAtom(display, atom_name, only_if_exists)
+ Display* display;
+ _Xconst char* atom_name;
+ Bool only_if_exists;
+{
+ static Atom atom = XA_LAST_PREDEFINED;
+
+ display->request++;
+ return ++atom;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * XGetVisualInfo --
+ *
+ * Returns information about the specified visual.
+ *
+ * Results:
+ * Returns a newly allocated XVisualInfo structure.
+ *
+ * Side effects:
+ * Allocates storage.
+ *
+ *----------------------------------------------------------------------
+ */
+
+XVisualInfo *
+XGetVisualInfo(display, vinfo_mask, vinfo_template, nitems_return)
+ Display* display;
+ long vinfo_mask;
+ XVisualInfo* vinfo_template;
+ int* nitems_return;
+{
+ XVisualInfo *info = (XVisualInfo *)ckalloc(sizeof(XVisualInfo));
+ info->visual = DefaultVisual(display, 0);
+ info->visualid = info->visual->visualid;
+ info->screen = 0;
+ info->depth = info->visual->bits_per_rgb;
+ info->class = info->visual->class;
+ info->colormap_size = info->visual->map_entries;
+ info->bits_per_rgb = info->visual->bits_per_rgb;
+ info->red_mask = info->visual->red_mask;
+ info->green_mask = info->visual->green_mask;
+ info->blue_mask = info->visual->blue_mask;
+
+ if (((vinfo_mask & VisualIDMask)
+ && (vinfo_template->visualid != info->visualid))
+ || ((vinfo_mask & VisualScreenMask)
+ && (vinfo_template->screen != info->screen))
+ || ((vinfo_mask & VisualDepthMask)
+ && (vinfo_template->depth != info->depth))
+ || ((vinfo_mask & VisualClassMask)
+ && (vinfo_template->class != info->class))
+ || ((vinfo_mask & VisualColormapSizeMask)
+ && (vinfo_template->colormap_size != info->colormap_size))
+ || ((vinfo_mask & VisualBitsPerRGBMask)
+ && (vinfo_template->bits_per_rgb != info->bits_per_rgb))
+ || ((vinfo_mask & VisualRedMaskMask)
+ && (vinfo_template->red_mask != info->red_mask))
+ || ((vinfo_mask & VisualGreenMaskMask)
+ && (vinfo_template->green_mask != info->green_mask))
+ || ((vinfo_mask & VisualBlueMaskMask)
+ && (vinfo_template->blue_mask != info->blue_mask))
+ ) {
+ ckfree((char *) info);
+ return NULL;
+ }
+
+ *nitems_return = 1;
+ return info;
+}